1486 files changed, 0 insertions, 424506 deletions

diff --git a/ghc/ANNOUNCE b/ghc/ANNOUNCE
deleted file mode 100644
index c5cbae687f..0000000000
--- a/ghc/ANNOUNCE
+++ /dev/null
@@ -1,116 +0,0 @@
-
-   =============================================================
-    The (Interactive) Glasgow Haskell Compiler -- version 6.4
-   =============================================================
-
-The GHC Team is pleased to announce a new major release of GHC.  It
-has been a long time since the last major release (Dec 2003!), and a
-lot has happened:
-
-  - GADTs (Generalised Abstract Datatypes) are supported  
-
-  - STM (Software Transactional Memory) is implemented
-
-  - Full support for Cabal and a much improved package framework
-
-  - Better support for mutually-recursive modules
-
-  - A complete rewrite of the back end
-
-  - Accurate source locations in error messages
-
-  - Lots of new libraries
-
-The full release notes are here:
-
-  http://haskell.org/ghc/docs/6.4/html/users_guide/release-6-4.html
-
-How to get it
-~~~~~~~~~~~~~
-The easy way is to go to the WWW page, which should be self-explanatory:
-
-        http://www.haskell.org/ghc/
-
-We supply binary builds in the native package format for various
-flavours of Linux and BSD, and in Windows Installer (MSI) form
-for Windows folks.  Binary builds for other platforms are available
-as a .tar.gz which can be installed wherever you want.  The source
-distribution is also available from the same place.
-
-Packages will appear as they are built - if the package for your
-system isn't available yet, please try again later.
-
-
-
-Background
-~~~~~~~~~~
-Haskell is a standard lazy functional programming language; the
-current language version is Haskell 98, agreed in December 1998 and
-revised December 2002.
-
-GHC is a state-of-the-art programming suite for Haskell.  Included is
-an optimising compiler generating good code for a variety of
-platforms, together with an interactive system for convenient, quick
-development.  The distribution includes space and time profiling
-facilities, a large collection of libraries, and support for various
-language extensions, including concurrency, exceptions, and foreign
-language interfaces (C, whatever).  GHC is distributed under a
-BSD-style open source license.
-
-A wide variety of Haskell related resources (tutorials, libraries,
-specifications, documentation, compilers, interpreters, references,
-contact information, links to research groups) are available from the
-Haskell home page (see below).
-
-
-On-line GHC-related resources
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Relevant URLs on the World-Wide Web:
-
-GHC home page             http://www.haskell.org/ghc/
-Haskell home page         http://www.haskell.org/
-comp.lang.functional FAQ  http://www.cs.nott.ac.uk/~gmh/faq.html
-
-
-
-System requirements
-~~~~~~~~~~~~~~~~~~~
-To compile programs with GHC, you need a machine with 64+MB memory, GCC
-and perl. This release is known to work on the following platforms:
-
-  * i386-unknown-{linux,*bsd,mingw32}
-  * sparc-sun-solaris2
-  * powerpc-apple-darwin (MacOS X)
-  * powerpc-apple-linux
-
-Ports to other platforms are possible with varying degrees of
-difficulty.  The builder's guide on the web site gives a complete
-run-down of what ports work and how to go about porting to a new
-platform; it can be found at
-
-   http://www.haskell.org/ghc/docs/latest/html/building/
-
-
-Mailing lists
-~~~~~~~~~~~~~
-We run mailing lists for GHC users and bug reports; to subscribe, use
-the web interfaces at
-
-	http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
-	http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
-
-There are several other haskell and ghc-related mailing lists on
-www.haskell.org; for the full list, see
-
-	http://www.haskell.org/mailman/listinfo/
-
-Please report bugs using our SourceForge page at
-	
-	http://sourceforge.net/projects/ghc/
-
-or send them to glasgow-haskell-bugs@haskell.org.
-
-GHC users hang out on glasgow-haskell-users@haskell.org.  Bleeding
-edge CVS users party on cvs-ghc@haskell.org.
-
diff --git a/ghc/HACKING b/ghc/HACKING
deleted file mode 100644
index 8b26ef40a1..0000000000
--- a/ghc/HACKING
+++ /dev/null
@@ -1,201 +0,0 @@
-Getting started with hacking on GHC
------------------------------------
-
-So you've decided to hack on GHC, congratulations!  We hope you have a
-rewarding experience.  This file contains a few nuggets of information
-that will help get you started right away, and point you in the
-direction of more comprehensive documentation for later.
-
-
-Setting up your build
----------------------
-
-The GHC build tree is set up so that, by default, it builds a compiler
-ready for installing and using.  That means full optimisation, and the
-build can take a *long* time.  If you unpack your source tree and
-right away say "./configure; make", expect to have to wait a while.
-
-For hacking, you want the build to be quick - quick to build in the
-first place, and quick to rebuild after making changes.  Tuning your
-build setup can make the difference between several hours to build
-GHC, and less than an hour.  Here's how to do it.
-
-mk/build.mk is a GNU makefile that contains all your build settings.
-By default, this file doesn't exist, and all the parameters are set to
-their defaults in mk/config.mk (mk/config.mk is the place to look for
-*all* the things you might want to tune).
-
-A good mk/build.mk to start hacking on GHC is:
-
-------
-SRC_HC_OPTS     = -H32m -O -fasm -Rghc-timing
-GhcStage1HcOpts = -O0 -DDEBUG
-GhcLibHcOpts    = -O -fgenerics
-GhcLibWays      =
-SplitObjs       = NO
-------
-
-What do these options do?
-
-SRC_HC_OPTS = -H32m -O -fasm -Rghc-timing
-
-  These options are added to the command line for all Haskell
-  compilations.  We turn on -fasm, because that halves compilation
-  time at the expense of a few percent performance.  -Rghc-timing
-  prints out a line of timing info about each compilation.  It's handy
-  to keep an eye on.
-
-GhcStage1HcOpts = -O0 -DDEBUG
-
-  The options for building the stage1 compiler (these come after
-  SRC_HC_OPTS, so you can override settings from there).  We turn off
-  optimisation here, assuming you'll be modifying and testing stage1.
-  With optimisation off, rebuilding GHC after modifying it will be
-  *much* quicker, not only because the individual compilations will be
-  quicker, but also there will be fewer dependencies between modules,
-  so less stuff needs to be rebuilt after each modification.
-
-  Also we turn on -DDEBUG, because that enables assertions and
-  debugging code in the compiler itself.  Turning on DEBUG makes
-  the compiler about 30% slower.
-
-GhcLibHcOpts = -O -fgenerics
-
-  You almost certainly want optimisation *on* when building
-  libraries, otherwise the code you build with this compiler
-  goes really slowly.  -fgenerics add generics support to the
-  libraries - you can turn this off if you like (it'll make the
-  libraries a bit smaller), but you won't be able to use Generics in
-  the code you build against these libraries.
-
-GhcLibWays =
-
-  Normally the profiled libs are built.  Setting GhcLibWays to
-  empty disables this, so you only build the normal libs.
-
-SplitObjs = NO
-
-  Object splitting causes each module to be split into smaller
-  pieces in the final library, to reduce executable sizes when
-  linking against the library.  It can be quite time and
-  memory-consuming, so turn it off when you're hacking.
-
-
-Actually building the bits
---------------------------
-
-To just build everything, from the top level:
-
-  $ autoreconf
-  $ ./configure
-  $ make
-  $ make install
-
-
-Building individual parts of the tree
--------------------------------------
-
-The first thing to understand is that the source tree is built in two
-passes.  First 'make boot' builds dependencies and any other tools
-required as part of the build itself.  For example,
-ghc/utils/genprimopcode is built as part of 'make boot', because it is
-required to preprocess ghc/compiler/prelude/primops.txt.pp.
-
-After 'make boot', 'make' will build everything.
-
-If you say 'make' from the very top-level, the build system will
-arrange to do the appropriate 'make boot' steps for you.  If you just
-want to build in a subdirectory (eg. ghc), you have to do 'make boot'
-yourself.  You don't need to 'make boot' after every single change,
-but you might want to do it to update dependencies, for example.
-
-
-Refining the setup
-------------------
-
-If you will be hacking mostly on libraries, then you probably want to
-build stage1 with optimisation, because you're only building it once
-but using it many times.
-
-  GhcStage1HcOpts = -O
-
-If you are working on GHCi or Template Haskell, then you will be
-building and modifying the stage 2 compiler.  Hence, you want to build
-stage 1 with, and stage 2 without, optimisation.
-
-  GhcStage1HcOpts = -O
-  GhcStage2HcOpts = -O0 -DDEBUG
-
-Take a look through mk/config.mk for more settings you might want to
-override in build.mk.  Remember: don't modify config.mk directly (it
-gets overwritten when you run ./configure).
-
-
-Full optimisation
------------------
-
-To turn up everything to the max, for running performance tests for
-example, try theses:
-
-  SRC_HC_OPTS  = -H64m -O2 
-  GhcLibHcOpts = -O2
-  SplitObjs    = YES
-
-You can even add some more aggresive options, such as
--fliberate-case-threshold50, -funfolding-use-threshold50.
-
-
-Roadmap
--------
-
-A rough roadmap to the source tree:
-
- distrib        materials for building distributions
-
- docs           build system documentation
-
- ghc            The GHC Compiler
-   rts          the runtime system and storage manager
-   lib          libraries used in GHC and its tools
-   utils	tools that come with GHC, and tools used in the build
-   compiler     the compiler itself
-   driver       various scripts, and package databases
-   docs         compiler documentation
-   includes     header files shipped with GHC
-
- glafp-utils    tools for the build system
-
- libraries	The hierarchical libraries
-
- nofib          A benchmark suite
-
- testsuite      The regression test suite
-
-
-Resources
----------
-
-The Building Guide
-
-   Full documentation on the build system.
-   http://www.haskell.org/ghc/docs/latest/html/building/index.html
-
-
-The GHC Commentary
-
-   Notes on the internals and architecture of GHC.  Much of this isn't
-   up to date, but there is still lots of useful stuff in there.  Read
-   in conjunction with the source code.
-   http://www.cse.unsw.edu.au/~chak/haskell/ghc/comm/
-
-
-Mailing lists
-
-   Ask on glasgow-haskell-users@haskell.org if you have difficulties.
-   If you're working with the current CVS sources of GHC, then
-   cvs-ghc@haskell.org might be a more appropriate (developers hang
-   out here).  See http://www.haskell.org/mailman/listinfo for
-   subscription.
-
-
-Happy Hacking!  --The GHC Team
diff --git a/ghc/InstallShield/Component Definitions/Default.cdf b/ghc/InstallShield/Component Definitions/Default.cdf
deleted file mode 100644
index 011554a913..0000000000
--- a/ghc/InstallShield/Component Definitions/Default.cdf
+++ /dev/null
@@ -1,178 +0,0 @@
-[Info]
-Name=
-Type=CompDef
-Version=2.10.000
-
-[HTML Help Files]
-OBJECT=No
-DESCRIPTION=
-STATUS=
-VISIBLE=Yes
-DISK=ANYDISK
-FILENEED=STANDARD
-INCLUDEINBUILD=Yes
-PASSWORD=
-ENCRYPT=No
-COMPRESSIFSEPARATE=No
-UNINSTALLABLE=Yes
-COMMENT=
-DEFSELECTION=Yes
-SELECTED=Yes
-IMAGE=
-TARGETDIRCDROM=
-DISPLAYTEXT=
-HTTPLOCATION=
-FTPLOCATION=
-MISC=
-GUID=b949531f-1f21-4183-a2a6-fa687ebd44c6
-_SPLIT_BEFORE=
-_SPLIT_AFTER=
-_DATAASFILES=
-_NO_SPLIT=
-_NO_SPLIT_BEFORE=
-VOLATILE=
-filegroup0=HTML Help Files
-HANDLERONInstalling=
-HANDLERONInstalled=
-HANDLERONUnInstalling=
-HANDLERONUnInstalled=
-
-[Components]
-component0=HTML Help Files
-component1=Program Files
-component2=Profiling Libraries
-component3=PDF Help Files
-
-[Program Files]
-OBJECT=No
-DESCRIPTION=
-STATUS=
-VISIBLE=Yes
-DISK=ANYDISK
-FILENEED=STANDARD
-INCLUDEINBUILD=Yes
-PASSWORD=
-ENCRYPT=No
-COMPRESSIFSEPARATE=No
-UNINSTALLABLE=Yes
-COMMENT=
-DEFSELECTION=Yes
-SELECTED=Yes
-IMAGE=
-TARGETDIRCDROM=
-DISPLAYTEXT=
-HTTPLOCATION=
-FTPLOCATION=
-MISC=
-GUID=dd5fef6d-14fb-4b93-a8a8-8de303e79c40
-_SPLIT_BEFORE=
-_SPLIT_AFTER=
-_DATAASFILES=
-_NO_SPLIT=
-_NO_SPLIT_BEFORE=
-VOLATILE=
-filegroup0=Program Executable Files
-HANDLERONInstalling=
-HANDLERONInstalled=
-HANDLERONUnInstalling=
-HANDLERONUnInstalled=
-
-[Profiling Libraries]
-OBJECT=No
-DESCRIPTION=
-STATUS=
-VISIBLE=Yes
-DISK=ANYDISK
-FILENEED=STANDARD
-INCLUDEINBUILD=Yes
-PASSWORD=
-ENCRYPT=No
-COMPRESSIFSEPARATE=No
-UNINSTALLABLE=Yes
-COMMENT=
-DEFSELECTION=Yes
-SELECTED=Yes
-IMAGE=
-TARGETDIRCDROM=
-DISPLAYTEXT=
-HTTPLOCATION=
-FTPLOCATION=
-MISC=
-GUID=6b59e9c4-d87a-4587-9836-7d0b73dcfd4d
-_SPLIT_BEFORE=
-_SPLIT_AFTER=
-_DATAASFILES=
-_NO_SPLIT=
-_NO_SPLIT_BEFORE=
-VOLATILE=
-filegroup0=Profiling Libraries
-HANDLERONInstalling=
-HANDLERONInstalled=
-HANDLERONUnInstalling=
-HANDLERONUnInstalled=
-
-[PDF Help Files]
-OBJECT=No
-DESCRIPTION=
-STATUS=
-VISIBLE=Yes
-DISK=ANYDISK
-FILENEED=STANDARD
-INCLUDEINBUILD=Yes
-PASSWORD=
-ENCRYPT=No
-COMPRESSIFSEPARATE=No
-UNINSTALLABLE=Yes
-COMMENT=
-DEFSELECTION=Yes
-SELECTED=Yes
-IMAGE=
-TARGETDIRCDROM=
-DISPLAYTEXT=
-HTTPLOCATION=
-FTPLOCATION=
-MISC=
-GUID=3778b9f0-b9bc-4e6e-956d-add64a73f290
-_SPLIT_BEFORE=
-_SPLIT_AFTER=
-_DATAASFILES=
-_NO_SPLIT=
-_NO_SPLIT_BEFORE=
-VOLATILE=
-filegroup0=PDF Help Files
-HANDLERONInstalling=
-HANDLERONInstalled=
-HANDLERONUnInstalling=
-HANDLERONUnInstalled=
-
-[TopComponents]
-component0=Program Files
-component1=HTML Help Files
-component2=PDF Help Files
-component3=Profiling Libraries
-
-[SetupType]
-setuptype0=Compact
-setuptype1=Typical
-setuptype2=Custom
-
-[SetupTypeItem-Compact]
-Comment=
-Descrip=
-DisplayText=
-item0=Program Files
-
-[SetupTypeItem-Typical]
-Comment=
-Descrip=
-DisplayText=
-item0=HTML Help Files
-item1=Program Files
-
-[SetupTypeItem-Custom]
-Comment=
-Descrip=
-DisplayText=
-item0=HTML Help Files
-item1=Program Files
-
diff --git a/ghc/InstallShield/Component Definitions/Default.fgl b/ghc/InstallShield/Component Definitions/Default.fgl
deleted file mode 100644
index 5b73147452..0000000000
--- a/ghc/InstallShield/Component Definitions/Default.fgl
+++ /dev/null
@@ -1,48 +0,0 @@
-[General]
-Type=FILELIST
-Version=1.10.000
-
-[TopDir]
-SubDir0=<WINDIR>
-SubDir1=<PROGRAMFILES>
-SubDir2=<TARGETDIR>
-SubDir3=USERDEFINED
-
-[<WINDIR>]
-fulldirectory=
-SubDir0=<WINDIR>\<WINSYSDIR>
-DISPLAYTEXT=Windows Operating System
-TYPE=TEXTSUBFIXED
-
-[<WINDIR>\<WINSYSDIR>]
-fulldirectory=
-DISPLAYTEXT=Windows System Folder
-TYPE=TEXTSUBFIXED
-
-[<PROGRAMFILES>]
-fulldirectory=
-SubDir0=<PROGRAMFILES>\<COMMONFILES>
-DISPLAYTEXT=Program Files Folder
-TYPE=TEXTSUBFIXED
-
-[<PROGRAMFILES>\<COMMONFILES>]
-fulldirectory=
-DISPLAYTEXT=Common Files Folder
-TYPE=TEXTSUBFIXED
-
-[<TARGETDIR>]
-fulldirectory=
-DISPLAYTEXT=General Application Destination
-TYPE=TEXTSUBFIXED
-
-[USERDEFINED]
-fulldirectory=
-SubDir0=USERDEFINED\<DOCDIR>
-DISPLAYTEXT=Script-defined Folders
-TYPE=USERSTART
-
-[USERDEFINED\<DOCDIR>]
-fulldirectory=
-DISPLAYTEXT=
-TYPE=TEXTSUB
-
diff --git a/ghc/InstallShield/File Groups/Default.fdf b/ghc/InstallShield/File Groups/Default.fdf
deleted file mode 100644
index eddf00ec71..0000000000
--- a/ghc/InstallShield/File Groups/Default.fdf
+++ /dev/null
@@ -1,87 +0,0 @@
-[Info]
-Name=
-Type=FileGrp
-Version=2.10.000
-
-[HTML Help Files]
-LINKTYPE=Static Link
-INFOTYPE=Standard
-UNINSTALLABLE=Yes
-FILETYPE=No
-SELFREGISTERING=No
-POTENTIALLY=No
-COMPRESS=Yes
-OPERATINGSYSTEM=
-LANGUAGE=
-COMMENT=
-COMPRESSDLL=
-HTTPLOCATION=
-FTPLOCATION=
-MISC=
-INSTALLATION=ALWAYSOVERWRITE
-TARGET=<DOCDIR>
-TARGETHIDDEN=Script-defined Folders\<DOCDIR>
-
-[FileGroups]
-group0=HTML Help Files
-group1=Program Executable Files
-group2=Profiling Libraries
-group3=PDF Help Files
-
-[Program Executable Files]
-LINKTYPE=Static Link
-INFOTYPE=Standard
-UNINSTALLABLE=Yes
-FILETYPE=No
-SELFREGISTERING=No
-POTENTIALLY=No
-COMPRESS=Yes
-OPERATINGSYSTEM=
-LANGUAGE=
-COMMENT=
-COMPRESSDLL=
-HTTPLOCATION=
-FTPLOCATION=
-MISC=
-INSTALLATION=ALWAYSOVERWRITE
-TARGET=<TARGETDIR>
-TARGETHIDDEN=General Application Destination
-
-[Profiling Libraries]
-LINKTYPE=Static Link
-INFOTYPE=Standard
-UNINSTALLABLE=Yes
-FILETYPE=No
-SELFREGISTERING=No
-POTENTIALLY=No
-COMPRESS=Yes
-OPERATINGSYSTEM=
-LANGUAGE=
-COMMENT=
-COMPRESSDLL=
-HTTPLOCATION=
-FTPLOCATION=
-MISC=
-INSTALLATION=ALWAYSOVERWRITE
-TARGET=<TARGETDIR>
-TARGETHIDDEN=General Application Destination
-
-[PDF Help Files]
-LINKTYPE=Static Link
-INFOTYPE=Standard
-UNINSTALLABLE=Yes
-FILETYPE=No
-SELFREGISTERING=No
-POTENTIALLY=No
-COMPRESS=Yes
-OPERATINGSYSTEM=
-LANGUAGE=
-COMMENT=
-COMPRESSDLL=
-HTTPLOCATION=
-FTPLOCATION=
-MISC=
-INSTALLATION=ALWAYSOVERWRITE
-TARGET=<DOCDIR>
-TARGETHIDDEN=Script-defined Folders\<DOCDIR>
-
diff --git a/ghc/InstallShield/File Groups/HTML Help Files.fgl b/ghc/InstallShield/File Groups/HTML Help Files.fgl
deleted file mode 100644
index bf792474d5..0000000000
--- a/ghc/InstallShield/File Groups/HTML Help Files.fgl
+++ /dev/null
@@ -1,187 +0,0 @@
-[General]
-Type=FILELIST
-Version=1.10.000
-
-[TopDir]
-file0=C:\TEMP\fptools\ghc\ANNOUNCE
-SubDir0=doc
-
-[doc]
-fulldirectory=C:\usr\fptools-3.03\fptools\html\ghc-3.03
-SubDir0=doc\building-guide
-SubDir1=doc\user-guide
-
-[doc\building-guide]
-fulldirectory=
-file0=C:\TEMP\fptools\docs\building\winbuild.html
-file1=C:\TEMP\fptools\docs\building\docbook.css
-file2=C:\TEMP\fptools\docs\building\sec-booting-from-c.html
-file3=C:\TEMP\fptools\docs\building\sec-build-checks.html
-file4=C:\TEMP\fptools\docs\building\sec-building-from-source.html
-file5=C:\TEMP\fptools\docs\building\sec-build-pitfalls.html
-file6=C:\TEMP\fptools\docs\building\sec-makefile-arch.html
-file7=C:\TEMP\fptools\docs\building\sec-port-info.html
-file8=C:\TEMP\fptools\docs\building\sec-pre-supposed.html
-file9=C:\TEMP\fptools\docs\building\building-guide.html
-SubDir0=doc\building-guide\stylesheet-images
-
-[doc\building-guide\stylesheet-images]
-fulldirectory=
-file0=C:\TEMP\fptools\docs\building\stylesheet-images\warning.gif
-file1=C:\TEMP\fptools\docs\building\stylesheet-images\home.gif
-file2=C:\TEMP\fptools\docs\building\stylesheet-images\important.gif
-file3=C:\TEMP\fptools\docs\building\stylesheet-images\next.gif
-file4=C:\TEMP\fptools\docs\building\stylesheet-images\note.gif
-file5=C:\TEMP\fptools\docs\building\stylesheet-images\prev.gif
-file6=C:\TEMP\fptools\docs\building\stylesheet-images\tip.gif
-file7=C:\TEMP\fptools\docs\building\stylesheet-images\toc-blank.gif
-file8=C:\TEMP\fptools\docs\building\stylesheet-images\toc-minus.gif
-file9=C:\TEMP\fptools\docs\building\stylesheet-images\toc-plus.gif
-file10=C:\TEMP\fptools\docs\building\stylesheet-images\up.gif
-file11=C:\TEMP\fptools\docs\building\stylesheet-images\caution.gif
-
-[doc\user-guide]
-fulldirectory=
-file0=C:\TEMP\fptools\ghc\docs\set\set\wrong-compilee.html
-file1=C:\TEMP\fptools\ghc\docs\set\set\book-users-guide.html
-file2=C:\TEMP\fptools\ghc\docs\set\set\bug-reports.html
-file3=C:\TEMP\fptools\ghc\docs\set\set\building-docs.html
-file4=C:\TEMP\fptools\ghc\docs\set\set\compile-what-really-happens.html
-file5=C:\TEMP\fptools\ghc\docs\set\set\concurrent-and-parallel.html
-file6=C:\TEMP\fptools\ghc\docs\set\set\device-specific-functions.html
-file7=C:\TEMP\fptools\ghc\docs\set\set\docbook.css
-file8=C:\TEMP\fptools\ghc\docs\set\set\error-reporting-and-handling.html
-file9=C:\TEMP\fptools\ghc\docs\set\set\existential-quantification.html
-file10=C:\TEMP\fptools\ghc\docs\set\set\faster.html
-file11=C:\TEMP\fptools\ghc\docs\set\set\ffi.html
-file12=C:\TEMP\fptools\ghc\docs\set\set\files-and-directories.html
-file13=C:\TEMP\fptools\ghc\docs\set\set\file-suffixes.html
-file14=C:\TEMP\fptools\ghc\docs\set\set\finitemap.html
-file15=C:\TEMP\fptools\ghc\docs\set\set\ghc-language-features.html
-file16=C:\TEMP\fptools\ghc\docs\set\set\glasgow-prim-arrays.html
-file17=C:\TEMP\fptools\ghc\docs\set\set\glasgow-st-monad.html
-file18=C:\TEMP\fptools\ghc\docs\set\set\happy.html
-file19=C:\TEMP\fptools\ghc\docs\set\set\hard-core-debug.html
-file20=C:\TEMP\fptools\ghc\docs\set\set\hp2ps.html
-file21=C:\TEMP\fptools\ghc\docs\set\set\hslibs-intro.html
-file22=C:\TEMP\fptools\ghc\docs\set\set\input-output.html
-file23=C:\TEMP\fptools\ghc\docs\set\set\introduction-ghc.html
-file24=C:\TEMP\fptools\ghc\docs\set\set\license.html
-file25=C:\TEMP\fptools\ghc\docs\set\set\mailing-lists-ghc.html
-file26=C:\TEMP\fptools\ghc\docs\set\set\matchps.html
-file27=C:\TEMP\fptools\ghc\docs\set\set\memo-library.html
-file28=C:\TEMP\fptools\ghc\docs\set\set\multi-param-type-classes.html
-file29=C:\TEMP\fptools\ghc\docs\set\set\mutablearray.html
-file30=C:\TEMP\fptools\ghc\docs\set\set\options-debugging.html
-file31=C:\TEMP\fptools\ghc\docs\set\set\options-help.html
-file32=C:\TEMP\fptools\ghc\docs\set\set\options-optimise.html
-file33=C:\TEMP\fptools\ghc\docs\set\set\options-order.html
-file34=C:\TEMP\fptools\ghc\docs\set\set\options-output.html
-file35=C:\TEMP\fptools\ghc\docs\set\set\options-phases.html
-file36=C:\TEMP\fptools\ghc\docs\set\set\options-sanity.html
-file37=C:\TEMP\fptools\ghc\docs\set\set\packedstring.html
-file38=C:\TEMP\fptools\ghc\docs\set\set\pattern-guards.html
-file39=C:\TEMP\fptools\ghc\docs\set\set\pphs.html
-file40=C:\TEMP\fptools\ghc\docs\set\set\pragmas.html
-file41=C:\TEMP\fptools\ghc\docs\set\set\process-environment.html
-file42=C:\TEMP\fptools\ghc\docs\set\set\process-primitives.html
-file43=C:\TEMP\fptools\ghc\docs\set\set\prof-compiler-options.html
-file44=C:\TEMP\fptools\ghc\docs\set\set\prof-heap.html
-file45=C:\TEMP\fptools\ghc\docs\set\set\profiling.html
-file46=C:\TEMP\fptools\ghc\docs\set\set\prof-rts-options.html
-file47=C:\TEMP\fptools\ghc\docs\set\set\prof-xml-tool.html
-file48=C:\TEMP\fptools\ghc\docs\set\set\readline.html
-file49=C:\TEMP\fptools\ghc\docs\set\set\regex.html
-file50=C:\TEMP\fptools\ghc\docs\set\set\regexstring.html
-file51=C:\TEMP\fptools\ghc\docs\set\set\release-4-08.html
-file52=C:\TEMP\fptools\ghc\docs\set\set\rewrite-rules.html
-file53=C:\TEMP\fptools\ghc\docs\set\set\runtime-control.html
-file54=C:\TEMP\fptools\ghc\docs\set\set\scoped-type-variables.html
-file55=C:\TEMP\fptools\ghc\docs\set\set\sec-assertions.html
-file56=C:\TEMP\fptools\ghc\docs\set\set\sec-bits.html
-file57=C:\TEMP\fptools\ghc\docs\set\set\sec-byte-array.html
-file58=C:\TEMP\fptools\ghc\docs\set\set\sec-ccall.html
-file59=C:\TEMP\fptools\ghc\docs\set\set\sec-concurrency-abstractions.html
-file60=C:\TEMP\fptools\ghc\docs\set\set\sec-concurrency-basics.html
-file61=C:\TEMP\fptools\ghc\docs\set\set\sec-concurrent.html
-file62=C:\TEMP\fptools\ghc\docs\set\set\sec-concurrent-libiface.html
-file63=C:\TEMP\fptools\ghc\docs\set\set\sec-ctypes.html
-file64=C:\TEMP\fptools\ghc\docs\set\set\sec-ctypesiso.html
-file65=C:\TEMP\fptools\ghc\docs\set\set\sec-data.html
-file66=C:\TEMP\fptools\ghc\docs\set\set\sec-dynamic.html
-file67=C:\TEMP\fptools\ghc\docs\set\set\sec-entry.html
-file68=C:\TEMP\fptools\ghc\docs\set\set\sec-exception.html
-file69=C:\TEMP\fptools\ghc\docs\set\set\sec-ffi.html
-file70=C:\TEMP\fptools\ghc\docs\set\set\sec-foreign.html
-file71=C:\TEMP\fptools\ghc\docs\set\set\sec-foreignobj.html
-file72=C:\TEMP\fptools\ghc\docs\set\set\sec-ghc-concurrency.html
-file73=C:\TEMP\fptools\ghc\docs\set\set\sec-glaexts.html
-file74=C:\TEMP\fptools\ghc\docs\set\set\sec-iarray.html
-file75=C:\TEMP\fptools\ghc\docs\set\set\sec-installing-bin-distrib.html
-file76=C:\TEMP\fptools\ghc\docs\set\set\sec-install-windows.html
-file77=C:\TEMP\fptools\ghc\docs\set\set\sec-int.html
-file78=C:\TEMP\fptools\ghc\docs\set\set\sec-ioexts.html
-file79=C:\TEMP\fptools\ghc\docs\set\set\sec-lang.html
-file80=C:\TEMP\fptools\ghc\docs\set\set\sec-lazyst.html
-file81=C:\TEMP\fptools\ghc\docs\set\set\sec-marray.html
-file82=C:\TEMP\fptools\ghc\docs\set\set\sec-net.html
-file83=C:\TEMP\fptools\ghc\docs\set\set\sec-num.html
-file84=C:\TEMP\fptools\ghc\docs\set\set\sec-numexts.html
-file85=C:\TEMP\fptools\ghc\docs\set\set\sec-parsec.html
-file86=C:\TEMP\fptools\ghc\docs\set\set\sec-posix.html
-file87=C:\TEMP\fptools\ghc\docs\set\set\sec-pretty.html
-file88=C:\TEMP\fptools\ghc\docs\set\set\sec-prim-dynamic.html
-file89=C:\TEMP\fptools\ghc\docs\set\set\sec-primitive.html
-file90=C:\TEMP\fptools\ghc\docs\set\set\sec-quickcheck.html
-file91=C:\TEMP\fptools\ghc\docs\set\set\sec-scheduling.html
-file92=C:\TEMP\fptools\ghc\docs\set\set\sec-showfunctions.html
-file93=C:\TEMP\fptools\ghc\docs\set\set\sec-st.html
-file94=C:\TEMP\fptools\ghc\docs\set\set\sec-stable.html
-file95=C:\TEMP\fptools\ghc\docs\set\set\sec-stable-names.html
-file96=C:\TEMP\fptools\ghc\docs\set\set\sec-stable-pointers.html
-file97=C:\TEMP\fptools\ghc\docs\set\set\sec-storable.html
-file98=C:\TEMP\fptools\ghc\docs\set\set\sec-text.html
-file99=C:\TEMP\fptools\ghc\docs\set\set\sec-uri.html
-file100=C:\TEMP\fptools\ghc\docs\set\set\sec-using-concurrent.html
-file101=C:\TEMP\fptools\ghc\docs\set\set\sec-using-parallel.html
-file102=C:\TEMP\fptools\ghc\docs\set\set\sec-util.html
-file103=C:\TEMP\fptools\ghc\docs\set\set\sec-weak.html
-file104=C:\TEMP\fptools\ghc\docs\set\set\sec-win32.html
-file105=C:\TEMP\fptools\ghc\docs\set\set\sec-word.html
-file106=C:\TEMP\fptools\ghc\docs\set\set\select.html
-file107=C:\TEMP\fptools\ghc\docs\set\set\separate-compilation.html
-file108=C:\TEMP\fptools\ghc\docs\set\set\set.html
-file109=C:\TEMP\fptools\ghc\docs\set\set\set1.html
-file110=C:\TEMP\fptools\ghc\docs\set\set\smaller.html
-file111=C:\TEMP\fptools\ghc\docs\set\set\socket.html
-file112=C:\TEMP\fptools\ghc\docs\set\set\socketprim.html
-file113=C:\TEMP\fptools\ghc\docs\set\set\sooner-faster-quicker.html
-file114=C:\TEMP\fptools\ghc\docs\set\set\stingier.html
-file115=C:\TEMP\fptools\ghc\docs\set\set\system-database.html
-file116=C:\TEMP\fptools\ghc\docs\set\set\ticky-ticky.html
-file117=C:\TEMP\fptools\ghc\docs\set\set\universal-quantification.html
-file118=C:\TEMP\fptools\ghc\docs\set\set\using-ghc.html
-file119=C:\TEMP\fptools\ghc\docs\set\set\utils.html
-file120=C:\TEMP\fptools\ghc\docs\set\set\vs-haskell-defn.html
-file121=C:\TEMP\fptools\ghc\docs\set\set\win32-dlls.html
-file122=C:\TEMP\fptools\ghc\docs\set\set\win32-dlls-create.html
-file123=C:\TEMP\fptools\ghc\docs\set\set\win32-dlls-linking-static.html
-file124=C:\TEMP\fptools\ghc\docs\set\set\wrong.html
-file125=C:\TEMP\fptools\ghc\docs\set\set\book-hslibs.html
-SubDir0=doc\user-guide\stylesheet-images
-
-[doc\user-guide\stylesheet-images]
-fulldirectory=
-file0=C:\TEMP\fptools\ghc\docs\set\set\stylesheet-images\warning.gif
-file1=C:\TEMP\fptools\ghc\docs\set\set\stylesheet-images\home.gif
-file2=C:\TEMP\fptools\ghc\docs\set\set\stylesheet-images\important.gif
-file3=C:\TEMP\fptools\ghc\docs\set\set\stylesheet-images\next.gif
-file4=C:\TEMP\fptools\ghc\docs\set\set\stylesheet-images\note.gif
-file5=C:\TEMP\fptools\ghc\docs\set\set\stylesheet-images\prev.gif
-file6=C:\TEMP\fptools\ghc\docs\set\set\stylesheet-images\tip.gif
-file7=C:\TEMP\fptools\ghc\docs\set\set\stylesheet-images\toc-blank.gif
-file8=C:\TEMP\fptools\ghc\docs\set\set\stylesheet-images\toc-minus.gif
-file9=C:\TEMP\fptools\ghc\docs\set\set\stylesheet-images\toc-plus.gif
-file10=C:\TEMP\fptools\ghc\docs\set\set\stylesheet-images\up.gif
-file11=C:\TEMP\fptools\ghc\docs\set\set\stylesheet-images\caution.gif
-
diff --git a/ghc/InstallShield/File Groups/PDF Help Files.fgl b/ghc/InstallShield/File Groups/PDF Help Files.fgl
deleted file mode 100644
index 32199b630f..0000000000
--- a/ghc/InstallShield/File Groups/PDF Help Files.fgl
+++ /dev/null
@@ -1,8 +0,0 @@
-[General]
-Type=FILELIST
-Version=1.10.000
-
-[TopDir]
-file0=C:\TEMP\fptools\docs\building.pdf
-file1=C:\TEMP\fptools\ghc\docs\set\set.pdf
-
diff --git a/ghc/InstallShield/File Groups/Profiling Libraries.fgl b/ghc/InstallShield/File Groups/Profiling Libraries.fgl
deleted file mode 100644
index 8614722c73..0000000000
--- a/ghc/InstallShield/File Groups/Profiling Libraries.fgl
+++ /dev/null
@@ -1,258 +0,0 @@
-[General]
-Type=FILELIST
-Version=1.10.000
-
-[TopDir]
-SubDir0=lib
-
-[lib]
-fulldirectory=
-file0=C:\TEMP\fptools\ghc\lib\std\libHSstd_p.a
-file1=C:\TEMP\fptools\ghc\rts\libHSrts_p.a
-file2=C:\TEMP\fptools\hslibs\concurrent\libHSconcurrent_p.a
-file3=C:\TEMP\fptools\hslibs\data\libHSdata_p.a
-file4=C:\TEMP\fptools\hslibs\lang\libHSlang_p.a
-file5=C:\TEMP\fptools\hslibs\net\libHSnet_p.a
-file6=C:\TEMP\fptools\hslibs\text\libHStext_p.a
-file7=C:\TEMP\fptools\hslibs\util\libHSutil_p.a
-file8=C:\TEMP\fptools\hslibs\win32\src\libHSwin32_p.a
-file9=C:\TEMP\fptools\greencard\lib\ghc\libHSgreencard_p.a
-SubDir0=lib\imports
-
-[lib\imports]
-fulldirectory=
-SubDir0=lib\imports\concurrent
-SubDir1=lib\imports\data
-SubDir2=lib\imports\greencard
-SubDir3=lib\imports\lang
-SubDir4=lib\imports\net
-SubDir5=lib\imports\num
-SubDir6=lib\imports\std
-SubDir7=lib\imports\text
-SubDir8=lib\imports\util
-SubDir9=lib\imports\win32
-
-[lib\imports\concurrent]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\concurrent\Strategies.p_hi
-file1=C:\TEMP\fptools\hslibs\concurrent\Channel.p_hi
-file2=C:\TEMP\fptools\hslibs\concurrent\ChannelVar.p_hi
-file3=C:\TEMP\fptools\hslibs\concurrent\Concurrent.p_hi
-file4=C:\TEMP\fptools\hslibs\concurrent\CVar.p_hi
-file5=C:\TEMP\fptools\hslibs\concurrent\Merge.p_hi
-file6=C:\TEMP\fptools\hslibs\concurrent\MVar.p_hi
-file7=C:\TEMP\fptools\hslibs\concurrent\Parallel.p_hi
-file8=C:\TEMP\fptools\hslibs\concurrent\QSem.p_hi
-file9=C:\TEMP\fptools\hslibs\concurrent\QSemN.p_hi
-file10=C:\TEMP\fptools\hslibs\concurrent\SampleVar.p_hi
-file11=C:\TEMP\fptools\hslibs\concurrent\Semaphore.p_hi
-file12=C:\TEMP\fptools\hslibs\concurrent\Chan.p_hi
-
-[lib\imports\data]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\data\Set.p_hi
-file1=C:\TEMP\fptools\hslibs\data\FiniteMap.p_hi
-file2=C:\TEMP\fptools\hslibs\data\edison\EdisonPrelude.p_hi
-file3=C:\TEMP\fptools\hslibs\data\edison\Assoc\Assoc.p_hi
-file4=C:\TEMP\fptools\hslibs\data\edison\Assoc\AssocDefaults.p_hi
-file5=C:\TEMP\fptools\hslibs\data\edison\Assoc\AssocList.p_hi
-file6=C:\TEMP\fptools\hslibs\data\edison\Assoc\PatriciaLoMap.p_hi
-file7=C:\TEMP\fptools\hslibs\data\edison\Coll\UnbalancedSet.p_hi
-file8=C:\TEMP\fptools\hslibs\data\edison\Coll\CollectionDefaults.p_hi
-file9=C:\TEMP\fptools\hslibs\data\edison\Coll\CollectionUtils.p_hi
-file10=C:\TEMP\fptools\hslibs\data\edison\Coll\LazyPairingHeap.p_hi
-file11=C:\TEMP\fptools\hslibs\data\edison\Coll\LeftistHeap.p_hi
-file12=C:\TEMP\fptools\hslibs\data\edison\Coll\MinHeap.p_hi
-file13=C:\TEMP\fptools\hslibs\data\edison\Coll\SkewHeap.p_hi
-file14=C:\TEMP\fptools\hslibs\data\edison\Coll\SplayHeap.p_hi
-file15=C:\TEMP\fptools\hslibs\data\edison\Coll\TestOrdBag.p_hi
-file16=C:\TEMP\fptools\hslibs\data\edison\Coll\TestOrdSet.p_hi
-file17=C:\TEMP\fptools\hslibs\data\edison\Coll\Collection.p_hi
-file18=C:\TEMP\fptools\hslibs\data\edison\Seq\TestSeq.p_hi
-file19=C:\TEMP\fptools\hslibs\data\edison\Seq\BinaryRandList.p_hi
-file20=C:\TEMP\fptools\hslibs\data\edison\Seq\BraunSeq.p_hi
-file21=C:\TEMP\fptools\hslibs\data\edison\Seq\JoinList.p_hi
-file22=C:\TEMP\fptools\hslibs\data\edison\Seq\ListSeq.p_hi
-file23=C:\TEMP\fptools\hslibs\data\edison\Seq\MyersStack.p_hi
-file24=C:\TEMP\fptools\hslibs\data\edison\Seq\RandList.p_hi
-file25=C:\TEMP\fptools\hslibs\data\edison\Seq\RevSeq.p_hi
-file26=C:\TEMP\fptools\hslibs\data\edison\Seq\Sequence.p_hi
-file27=C:\TEMP\fptools\hslibs\data\edison\Seq\SequenceDefaults.p_hi
-file28=C:\TEMP\fptools\hslibs\data\edison\Seq\SimpleQueue.p_hi
-file29=C:\TEMP\fptools\hslibs\data\edison\Seq\SizedSeq.p_hi
-file30=C:\TEMP\fptools\hslibs\data\edison\Seq\BankersQueue.p_hi
-
-[lib\imports\greencard]
-fulldirectory=
-file0=C:\TEMP\fptools\greencard\lib\ghc\StdDIS.p_hi
-
-[lib\imports\lang]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\lang\Word.p_hi
-file1=C:\TEMP\fptools\hslibs\lang\ArrayBase.p_hi
-file2=C:\TEMP\fptools\hslibs\lang\Bits.p_hi
-file3=C:\TEMP\fptools\hslibs\lang\ByteArray.p_hi
-file4=C:\TEMP\fptools\hslibs\lang\CCall.p_hi
-file5=C:\TEMP\fptools\hslibs\lang\CString.p_hi
-file6=C:\TEMP\fptools\hslibs\lang\CTypes.p_hi
-file7=C:\TEMP\fptools\hslibs\lang\CTypesISO.p_hi
-file8=C:\TEMP\fptools\hslibs\lang\Dynamic.p_hi
-file9=C:\TEMP\fptools\hslibs\lang\Exception.p_hi
-file10=C:\TEMP\fptools\hslibs\lang\Foreign.p_hi
-file11=C:\TEMP\fptools\hslibs\lang\ForeignObj.p_hi
-file12=C:\TEMP\fptools\hslibs\lang\GlaExts.p_hi
-file13=C:\TEMP\fptools\hslibs\lang\IArray.p_hi
-file14=C:\TEMP\fptools\hslibs\lang\Int.p_hi
-file15=C:\TEMP\fptools\hslibs\lang\IOExts.p_hi
-file16=C:\TEMP\fptools\hslibs\lang\LazyST.p_hi
-file17=C:\TEMP\fptools\hslibs\lang\MutableArray.p_hi
-file18=C:\TEMP\fptools\hslibs\lang\NativeInfo.p_hi
-file19=C:\TEMP\fptools\hslibs\lang\NumExts.p_hi
-file20=C:\TEMP\fptools\hslibs\lang\PackedString.p_hi
-file21=C:\TEMP\fptools\hslibs\lang\ShowFunctions.p_hi
-file22=C:\TEMP\fptools\hslibs\lang\ST.p_hi
-file23=C:\TEMP\fptools\hslibs\lang\Stable.p_hi
-file24=C:\TEMP\fptools\hslibs\lang\StableName.p_hi
-file25=C:\TEMP\fptools\hslibs\lang\StablePtr.p_hi
-file26=C:\TEMP\fptools\hslibs\lang\Storable.p_hi
-file27=C:\TEMP\fptools\hslibs\lang\TimeExts.p_hi
-file28=C:\TEMP\fptools\hslibs\lang\Weak.p_hi
-file29=C:\TEMP\fptools\hslibs\lang\Addr.p_hi
-file30=C:\TEMP\fptools\hslibs\lang\monads\Monoid.p_hi
-file31=C:\TEMP\fptools\hslibs\lang\monads\MonadError.p_hi
-file32=C:\TEMP\fptools\hslibs\lang\monads\MonadFix.p_hi
-file33=C:\TEMP\fptools\hslibs\lang\monads\MonadIdentity.p_hi
-file34=C:\TEMP\fptools\hslibs\lang\monads\MonadReader.p_hi
-file35=C:\TEMP\fptools\hslibs\lang\monads\MonadRWS.p_hi
-file36=C:\TEMP\fptools\hslibs\lang\monads\MonadState.p_hi
-file37=C:\TEMP\fptools\hslibs\lang\monads\MonadTrans.p_hi
-file38=C:\TEMP\fptools\hslibs\lang\monads\MonadWriter.p_hi
-file39=C:\TEMP\fptools\hslibs\lang\monads\MonadEither.p_hi
-file40=C:\TEMP\fptools\hslibs\lang\MArray.p_hi
-
-[lib\imports\net]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\net\URI.p_hi
-file1=C:\TEMP\fptools\hslibs\net\Socket.p_hi
-file2=C:\TEMP\fptools\hslibs\net\SocketPrim.p_hi
-file3=C:\TEMP\fptools\hslibs\net\BSD.p_hi
-
-[lib\imports\num]
-fulldirectory=
-
-[lib\imports\std]
-fulldirectory=
-file0=C:\TEMP\fptools\ghc\lib\std\Array.p_hi
-file1=C:\TEMP\fptools\ghc\lib\std\Char.p_hi
-file2=C:\TEMP\fptools\ghc\lib\std\Complex.p_hi
-file3=C:\TEMP\fptools\ghc\lib\std\CPUTime.p_hi
-file4=C:\TEMP\fptools\ghc\lib\std\Directory.p_hi
-file5=C:\TEMP\fptools\ghc\lib\std\IO.p_hi
-file6=C:\TEMP\fptools\ghc\lib\std\Ix.p_hi
-file7=C:\TEMP\fptools\ghc\lib\std\List.p_hi
-file8=C:\TEMP\fptools\ghc\lib\std\Locale.p_hi
-file9=C:\TEMP\fptools\ghc\lib\std\Maybe.p_hi
-file10=C:\TEMP\fptools\ghc\lib\std\Monad.p_hi
-file11=C:\TEMP\fptools\ghc\lib\std\Numeric.p_hi
-file12=C:\TEMP\fptools\ghc\lib\std\PrelAddr.p_hi
-file13=C:\TEMP\fptools\ghc\lib\std\PrelArr.p_hi
-file14=C:\TEMP\fptools\ghc\lib\std\PrelArrExtra.p_hi
-file15=C:\TEMP\fptools\ghc\lib\std\PrelBase.p_hi
-file16=C:\TEMP\fptools\ghc\lib\std\PrelByteArr.p_hi
-file17=C:\TEMP\fptools\ghc\lib\std\PrelConc.p_hi
-file18=C:\TEMP\fptools\ghc\lib\std\PrelDynamic.p_hi
-file19=C:\TEMP\fptools\ghc\lib\std\PrelEnum.p_hi
-file20=C:\TEMP\fptools\ghc\lib\std\PrelErr.p_hi
-file21=C:\TEMP\fptools\ghc\lib\std\PrelException.p_hi
-file22=C:\TEMP\fptools\ghc\lib\std\PrelFloat.p_hi
-file23=C:\TEMP\fptools\ghc\lib\std\PrelForeign.p_hi
-file24=C:\TEMP\fptools\ghc\lib\std\PrelHandle.p_hi
-file25=C:\TEMP\fptools\ghc\lib\std\PrelIO.p_hi
-file26=C:\TEMP\fptools\ghc\lib\std\PrelIOBase.p_hi
-file27=C:\TEMP\fptools\ghc\lib\std\PrelList.p_hi
-file28=C:\TEMP\fptools\ghc\lib\std\PrelMain.p_hi
-file29=C:\TEMP\fptools\ghc\lib\std\PrelMaybe.p_hi
-file30=C:\TEMP\fptools\ghc\lib\std\PrelNum.p_hi
-file31=C:\TEMP\fptools\ghc\lib\std\PrelPack.p_hi
-file32=C:\TEMP\fptools\ghc\lib\std\PrelRead.p_hi
-file33=C:\TEMP\fptools\ghc\lib\std\PrelReal.p_hi
-file34=C:\TEMP\fptools\ghc\lib\std\PrelShow.p_hi
-file35=C:\TEMP\fptools\ghc\lib\std\PrelST.p_hi
-file36=C:\TEMP\fptools\ghc\lib\std\PrelStable.p_hi
-file37=C:\TEMP\fptools\ghc\lib\std\PrelTup.p_hi
-file38=C:\TEMP\fptools\ghc\lib\std\Prelude.p_hi
-file39=C:\TEMP\fptools\ghc\lib\std\PrelWeak.p_hi
-file40=C:\TEMP\fptools\ghc\lib\std\Random.p_hi
-file41=C:\TEMP\fptools\ghc\lib\std\Ratio.p_hi
-file42=C:\TEMP\fptools\ghc\lib\std\System.p_hi
-file43=C:\TEMP\fptools\ghc\lib\std\Time.p_hi
-file44=C:\TEMP\fptools\ghc\lib\std\PrelGHC.p_hi
-
-[lib\imports\text]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\text\RegexString.p_hi
-file1=C:\TEMP\fptools\hslibs\text\Pretty.p_hi
-file2=C:\TEMP\fptools\hslibs\text\Regex.p_hi
-file3=C:\TEMP\fptools\hslibs\text\MatchPS.p_hi
-file4=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlTypes.p_hi
-file5=C:\TEMP\fptools\hslibs\text\haxml\lib\ParseSTLib.p_hi
-file6=C:\TEMP\fptools\hslibs\text\haxml\lib\Xml2Haskell.p_hi
-file7=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlCombinators.p_hi
-file8=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlHtmlGen.p_hi
-file9=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlHtmlParse.p_hi
-file10=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlHtmlPP.p_hi
-file11=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlLex.p_hi
-file12=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlLib.p_hi
-file13=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlParse.p_hi
-file14=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlPP.p_hi
-file15=C:\TEMP\fptools\hslibs\text\haxml\lib\Haskell2Xml.p_hi
-file16=C:\TEMP\fptools\hslibs\text\html\HtmlBlockTable.p_hi
-file17=C:\TEMP\fptools\hslibs\text\html\Html.p_hi
-file18=C:\TEMP\fptools\hslibs\text\parsec\ParsecToken.p_hi
-file19=C:\TEMP\fptools\hslibs\text\parsec\ParsecExpr.p_hi
-file20=C:\TEMP\fptools\hslibs\text\parsec\ParsecLanguage.p_hi
-file21=C:\TEMP\fptools\hslibs\text\parsec\ParsecError.p_hi
-file22=C:\TEMP\fptools\hslibs\text\parsec\Parsec.p_hi
-
-[lib\imports\util]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\util\Memo.p_hi
-file1=C:\TEMP\fptools\hslibs\util\MD5.p_hi
-file2=C:\TEMP\fptools\hslibs\util\GetOpt.p_hi
-file3=C:\TEMP\fptools\hslibs\util\check\QuickCheckUtils.p_hi
-file4=C:\TEMP\fptools\hslibs\util\check\QuickCheckBatch.p_hi
-file5=C:\TEMP\fptools\hslibs\util\check\QuickCheckPoly.p_hi
-file6=C:\TEMP\fptools\hslibs\util\check\QuickCheck.p_hi
-
-[lib\imports\win32]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\win32\src\Win32Window.p_hi
-file1=C:\TEMP\fptools\hslibs\win32\src\Win32.p_hi
-file2=C:\TEMP\fptools\hslibs\win32\src\Win32Bitmap.p_hi
-file3=C:\TEMP\fptools\hslibs\win32\src\Win32Brush.p_hi
-file4=C:\TEMP\fptools\hslibs\win32\src\Win32Clip.p_hi
-file5=C:\TEMP\fptools\hslibs\win32\src\Win32Control.p_hi
-file6=C:\TEMP\fptools\hslibs\win32\src\Win32Dialogue.p_hi
-file7=C:\TEMP\fptools\hslibs\win32\src\Win32DLL.p_hi
-file8=C:\TEMP\fptools\hslibs\win32\src\Win32File.p_hi
-file9=C:\TEMP\fptools\hslibs\win32\src\Win32Font.p_hi
-file10=C:\TEMP\fptools\hslibs\win32\src\Win32Graphics2D.p_hi
-file11=C:\TEMP\fptools\hslibs\win32\src\Win32HDC.p_hi
-file12=C:\TEMP\fptools\hslibs\win32\src\Win32Icon.p_hi
-file13=C:\TEMP\fptools\hslibs\win32\src\Win32Key.p_hi
-file14=C:\TEMP\fptools\hslibs\win32\src\Win32Menu.p_hi
-file15=C:\TEMP\fptools\hslibs\win32\src\Win32Misc.p_hi
-file16=C:\TEMP\fptools\hslibs\win32\src\Win32MM.p_hi
-file17=C:\TEMP\fptools\hslibs\win32\src\Win32NLS.p_hi
-file18=C:\TEMP\fptools\hslibs\win32\src\Win32Palette.p_hi
-file19=C:\TEMP\fptools\hslibs\win32\src\Win32Path.p_hi
-file20=C:\TEMP\fptools\hslibs\win32\src\Win32Pen.p_hi
-file21=C:\TEMP\fptools\hslibs\win32\src\Win32Process.p_hi
-file22=C:\TEMP\fptools\hslibs\win32\src\Win32Region.p_hi
-file23=C:\TEMP\fptools\hslibs\win32\src\Win32Registry.p_hi
-file24=C:\TEMP\fptools\hslibs\win32\src\Win32Resource.p_hi
-file25=C:\TEMP\fptools\hslibs\win32\src\Win32SystemInfo.p_hi
-file26=C:\TEMP\fptools\hslibs\win32\src\Win32Types.p_hi
-file27=C:\TEMP\fptools\hslibs\win32\src\GDITypes.p_hi
-file28=C:\TEMP\fptools\hslibs\win32\src\Win32WinMessage.p_hi
-
diff --git a/ghc/InstallShield/File Groups/Program Executable Files.fgl b/ghc/InstallShield/File Groups/Program Executable Files.fgl
deleted file mode 100644
index 14790cd555..0000000000
--- a/ghc/InstallShield/File Groups/Program Executable Files.fgl
+++ /dev/null
@@ -1,370 +0,0 @@
-[General]
-Type=FILELIST
-Version=1.10.000
-
-[TopDir]
-file0=C:\TEMP\fptools\glafp-utils\mkdirhier\mkdirhier
-file1=C:\TEMP\fptools\ghc\ANNOUNCE
-file2=C:\TEMP\fptools\aclocal.m4
-file3=C:\TEMP\fptools\configure.ac
-file4=C:\TEMP\fptools\config.status
-file5=C:\TEMP\fptools\configure
-file6=C:\TEMP\fptools\config.guess
-file7=C:\TEMP\fptools\install-sh
-file8=C:\TEMP\fptools\config.sub
-file9=C:\TEMP\fptools\distrib\INSTALL
-file10=C:\TEMP\fptools\distrib\Makefile-bin.in
-SubDir0=bin
-SubDir1=lib
-
-[bin]
-fulldirectory=C:\ISRelease\fptools\bin
-file0=C:\bin\perl.exe
-file1=C:\TEMP\fptools\ghc\utils\hp2ps\hp2ps.exe
-file2=C:\TEMP\fptools\hslibs\win32\src\HSwin32.dll
-file3=C:\TEMP\fptools\ghc\utils\stat2resid\stat2resid
-file4=C:\TEMP\fptools\dll\HSutil_cbits.dll
-file5=C:\TEMP\fptools\dll\HSconcurrent.dll
-file6=C:\TEMP\fptools\dll\HSdata.dll
-file7=C:\TEMP\fptools\dll\HSlang.dll
-file8=C:\TEMP\fptools\dll\HSlang_cbits.dll
-file9=C:\TEMP\fptools\dll\HSnet.dll
-file10=C:\TEMP\fptools\dll\HSnet_cbits.dll
-file11=C:\TEMP\fptools\dll\HSrts.dll
-file12=C:\TEMP\fptools\dll\HSstd.dll
-file13=C:\TEMP\fptools\dll\HSstd_cbits.dll
-file14=C:\TEMP\fptools\dll\HStext.dll
-file15=C:\TEMP\fptools\dll\HStext_cbits.dll
-file16=C:\TEMP\fptools\dll\HSutil.dll
-file17=C:\TEMP\fptools\dll\gmp.dll
-file18=C:\TEMP\fptools\dll\HSgreencard.dll
-file19=C:\TEMP\fptools\ghc\driver\ghc-4.08.1
-
-[lib]
-fulldirectory=C:\ISRelease\fptools\lib
-file0=C:\TEMP\fptools\hslibs\util\cbits\libHSutil_cbits.a
-file1=C:\TEMP\fptools\hslibs\util\cbits\libHSutil_cbits_imp.a
-file2=C:\TEMP\fptools\hslibs\util\libHSutil.a
-file3=C:\TEMP\fptools\hslibs\util\libHSutil_imp.a
-file4=C:\TEMP\fptools\hslibs\text\cbits\libHStext_cbits.a
-file5=C:\TEMP\fptools\hslibs\text\cbits\libHStext_cbits_imp.a
-file6=C:\TEMP\fptools\hslibs\text\libHStext.a
-file7=C:\TEMP\fptools\hslibs\text\libHStext_imp.a
-file8=C:\TEMP\fptools\hslibs\net\cbits\libHSnet_cbits.a
-file9=C:\TEMP\fptools\hslibs\net\cbits\libHSnet_cbits_imp.a
-file10=C:\TEMP\fptools\hslibs\lang\cbits\libHSlang_cbits.a
-file11=C:\TEMP\fptools\hslibs\lang\cbits\libHSlang_cbits_imp.a
-file12=C:\TEMP\fptools\hslibs\lang\libHSlang.a
-file13=C:\TEMP\fptools\hslibs\lang\libHSlang_imp.a
-file14=C:\TEMP\fptools\hslibs\data\libHSdata_imp.a
-file15=C:\TEMP\fptools\hslibs\data\libHSdata.a
-file16=C:\TEMP\fptools\hslibs\concurrent\libHSconcurrent.a
-file17=C:\TEMP\fptools\hslibs\concurrent\libHSconcurrent_imp.a
-file18=C:\TEMP\fptools\ghc\rts\gmp\libgmp.a
-file19=C:\TEMP\fptools\ghc\rts\gmp\libgmp_imp.a
-file20=C:\TEMP\fptools\ghc\rts\libHSrts.a
-file21=C:\TEMP\fptools\ghc\rts\libHSrts_imp.a
-file22=C:\TEMP\fptools\ghc\driver\ghc-asm.prl
-file23=C:\TEMP\fptools\ghc\driver\ghc-consist.prl
-file24=C:\TEMP\fptools\ghc\driver\ghc-iface.prl
-file25=C:\TEMP\fptools\ghc\driver\ghc-split.prl
-file26=C:\TEMP\fptools\ghc\utils\stat2resid\parse-gcstats.prl
-file27=C:\TEMP\fptools\ghc\utils\stat2resid\process-gcstats.prl
-file28=C:\TEMP\fptools\ghc\compiler\hsc.exe
-file29=C:\TEMP\fptools\ghc\utils\unlit\unlit.exe
-file30=C:\TEMP\fptools\ghc\rts\Main.dll_o
-file31=C:\TEMP\fptools\ghc\lib\std\PrelMain.dll_o
-file32=C:\TEMP\fptools\ghc\lib\std\libHSstd.a
-file33=C:\TEMP\fptools\ghc\lib\std\libHSstd_imp.a
-file34=C:\TEMP\fptools\ghc\lib\std\cbits\libHSstd_cbits.a
-file35=C:\TEMP\fptools\ghc\lib\std\cbits\libHSstd_cbits_imp.a
-file36=C:\TEMP\fptools\hslibs\win32\src\libHSwin32_imp.a
-file37=C:\TEMP\fptools\hslibs\win32\src\libHSwin32.a
-file38=C:\TEMP\fptools\greencard\lib\ghc\libHSgreencard_imp.a
-file39=C:\TEMP\fptools\greencard\lib\ghc\libHSgreencard.a
-file40=C:\TEMP\fptools\ghc\utils\hscpp\hscpp
-file41=C:\TEMP\fptools\ghc\utils\mkdependHS\mkdependHS
-file42=C:\TEMP\fptools\hslibs\net\libHSnet_imp.a
-file43=C:\TEMP\fptools\hslibs\net\libHSnet.a
-SubDir0=lib\imports
-SubDir1=lib\includes
-
-[lib\imports]
-fulldirectory=C:\usr\fptools-BUILDS\new-rts-20\ghc-4.03\lib\i386-unknown-mingw32\ghc-4.03\imports
-SubDir0=lib\imports\std
-SubDir1=lib\imports\win32
-SubDir2=lib\imports\data
-SubDir3=lib\imports\lang
-SubDir4=lib\imports\net
-SubDir5=lib\imports\util
-SubDir6=lib\imports\num
-SubDir7=lib\imports\text
-SubDir8=lib\imports\greencard
-SubDir9=lib\imports\concurrent
-
-[lib\imports\std]
-fulldirectory=C:\usr\fptools-BUILDS\new-rts-20\ghc-4.03\lib\i386-unknown-mingw32\ghc-4.03\imports\std
-file0=C:\TEMP\fptools\ghc\lib\std\Array.hi
-file1=C:\TEMP\fptools\ghc\lib\std\Char.hi
-file2=C:\TEMP\fptools\ghc\lib\std\Complex.hi
-file3=C:\TEMP\fptools\ghc\lib\std\CPUTime.hi
-file4=C:\TEMP\fptools\ghc\lib\std\Locale.hi
-file5=C:\TEMP\fptools\ghc\lib\std\IO.hi
-file6=C:\TEMP\fptools\ghc\lib\std\Ix.hi
-file7=C:\TEMP\fptools\ghc\lib\std\List.hi
-file8=C:\TEMP\fptools\ghc\lib\std\Directory.hi
-file9=C:\TEMP\fptools\ghc\lib\std\PrelDynamic.hi
-file10=C:\TEMP\fptools\ghc\lib\std\Monad.hi
-file11=C:\TEMP\fptools\ghc\lib\std\Numeric.hi
-file12=C:\TEMP\fptools\ghc\lib\std\PrelAddr.hi
-file13=C:\TEMP\fptools\ghc\lib\std\PrelArr.hi
-file14=C:\TEMP\fptools\ghc\lib\std\PrelArrExtra.hi
-file15=C:\TEMP\fptools\ghc\lib\std\PrelBase.hi
-file16=C:\TEMP\fptools\ghc\lib\std\PrelByteArr.hi
-file17=C:\TEMP\fptools\ghc\lib\std\PrelConc.hi
-file18=C:\TEMP\fptools\ghc\lib\std\Maybe.hi
-file19=C:\TEMP\fptools\ghc\lib\std\PrelMain.hi
-file20=C:\TEMP\fptools\ghc\lib\std\PrelErr.hi
-file21=C:\TEMP\fptools\ghc\lib\std\PrelException.hi
-file22=C:\TEMP\fptools\ghc\lib\std\PrelFloat.hi
-file23=C:\TEMP\fptools\ghc\lib\std\PrelForeign.hi
-file24=C:\TEMP\fptools\ghc\lib\std\PrelGHC.hi
-file25=C:\TEMP\fptools\ghc\lib\std\PrelHandle.hi
-file26=C:\TEMP\fptools\ghc\lib\std\PrelIOBase.hi
-file27=C:\TEMP\fptools\ghc\lib\std\PrelList.hi
-file28=C:\TEMP\fptools\ghc\lib\std\PrelEnum.hi
-file29=C:\TEMP\fptools\ghc\lib\std\PrelNum.hi
-file30=C:\TEMP\fptools\ghc\lib\std\PrelPack.hi
-file31=C:\TEMP\fptools\ghc\lib\std\PrelRead.hi
-file32=C:\TEMP\fptools\ghc\lib\std\PrelReal.hi
-file33=C:\TEMP\fptools\ghc\lib\std\PrelShow.hi
-file34=C:\TEMP\fptools\ghc\lib\std\PrelST.hi
-file35=C:\TEMP\fptools\ghc\lib\std\PrelStable.hi
-file36=C:\TEMP\fptools\ghc\lib\std\PrelTup.hi
-file37=C:\TEMP\fptools\ghc\lib\std\Prelude.hi
-file38=C:\TEMP\fptools\ghc\lib\std\PrelWeak.hi
-file39=C:\TEMP\fptools\ghc\lib\std\Random.hi
-file40=C:\TEMP\fptools\ghc\lib\std\Ratio.hi
-file41=C:\TEMP\fptools\ghc\lib\std\System.hi
-file42=C:\TEMP\fptools\ghc\lib\std\Time.hi
-file43=C:\TEMP\fptools\ghc\lib\std\PrelMaybe.hi
-file44=C:\TEMP\fptools\ghc\lib\std\PrelIO.hi
-
-[lib\imports\win32]
-fulldirectory=C:\usr\fptools-BUILDS\new-rts-20\ghc-4.03\lib\i386-unknown-mingw32\ghc-4.03\imports\win32
-file0=C:\TEMP\fptools\hslibs\win32\src\Win32Types.hi
-file1=C:\TEMP\fptools\hslibs\win32\src\Win32Bitmap.hi
-file2=C:\TEMP\fptools\hslibs\win32\src\Win32Brush.hi
-file3=C:\TEMP\fptools\hslibs\win32\src\Win32Clip.hi
-file4=C:\TEMP\fptools\hslibs\win32\src\Win32Control.hi
-file5=C:\TEMP\fptools\hslibs\win32\src\Win32Dialogue.hi
-file6=C:\TEMP\fptools\hslibs\win32\src\GDITypes.hi
-file7=C:\TEMP\fptools\hslibs\win32\src\Win32Window.hi
-file8=C:\TEMP\fptools\hslibs\win32\src\Win32WinMessage.hi
-file9=C:\TEMP\fptools\hslibs\win32\src\Win32DLL.hi
-file10=C:\TEMP\fptools\hslibs\win32\src\Win32File.hi
-file11=C:\TEMP\fptools\hslibs\win32\src\Win32Font.hi
-file12=C:\TEMP\fptools\hslibs\win32\src\Win32Graphics2D.hi
-file13=C:\TEMP\fptools\hslibs\win32\src\Win32Menu.hi
-file14=C:\TEMP\fptools\hslibs\win32\src\Win32Key.hi
-file15=C:\TEMP\fptools\hslibs\win32\src\Win32SystemInfo.hi
-file16=C:\TEMP\fptools\hslibs\win32\src\Win32HDC.hi
-file17=C:\TEMP\fptools\hslibs\win32\src\Win32Icon.hi
-file18=C:\TEMP\fptools\hslibs\win32\src\Win32Misc.hi
-file19=C:\TEMP\fptools\hslibs\win32\src\Win32MM.hi
-file20=C:\TEMP\fptools\hslibs\win32\src\Win32Palette.hi
-file21=C:\TEMP\fptools\hslibs\win32\src\Win32Path.hi
-file22=C:\TEMP\fptools\hslibs\win32\src\Win32Pen.hi
-file23=C:\TEMP\fptools\hslibs\win32\src\Win32Process.hi
-file24=C:\TEMP\fptools\hslibs\win32\src\Win32Region.hi
-file25=C:\TEMP\fptools\hslibs\win32\src\Win32Registry.hi
-file26=C:\TEMP\fptools\hslibs\win32\src\Win32Resource.hi
-file27=C:\TEMP\fptools\hslibs\win32\src\Win32.hi
-file28=C:\TEMP\fptools\hslibs\win32\src\Win32NLS.hi
-
-[lib\imports\data]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\data\FiniteMap.hi
-file1=C:\TEMP\fptools\hslibs\data\Set.hi
-file2=C:\TEMP\fptools\hslibs\data\edison\Assoc\Assoc.hi
-file3=C:\TEMP\fptools\hslibs\data\edison\Assoc\AssocDefaults.hi
-file4=C:\TEMP\fptools\hslibs\data\edison\Assoc\AssocList.hi
-file5=C:\TEMP\fptools\hslibs\data\edison\Assoc\PatriciaLoMap.hi
-file6=C:\TEMP\fptools\hslibs\data\edison\EdisonPrelude.hi
-file7=C:\TEMP\fptools\hslibs\data\edison\Coll\Collection.hi
-file8=C:\TEMP\fptools\hslibs\data\edison\Coll\CollectionDefaults.hi
-file9=C:\TEMP\fptools\hslibs\data\edison\Coll\CollectionUtils.hi
-file10=C:\TEMP\fptools\hslibs\data\edison\Coll\LazyPairingHeap.hi
-file11=C:\TEMP\fptools\hslibs\data\edison\Coll\LeftistHeap.hi
-file12=C:\TEMP\fptools\hslibs\data\edison\Coll\MinHeap.hi
-file13=C:\TEMP\fptools\hslibs\data\edison\Coll\SkewHeap.hi
-file14=C:\TEMP\fptools\hslibs\data\edison\Coll\SplayHeap.hi
-file15=C:\TEMP\fptools\hslibs\data\edison\Coll\TestOrdBag.hi
-file16=C:\TEMP\fptools\hslibs\data\edison\Coll\TestOrdSet.hi
-file17=C:\TEMP\fptools\hslibs\data\edison\Coll\UnbalancedSet.hi
-file18=C:\TEMP\fptools\hslibs\data\edison\Seq\BankersQueue.hi
-file19=C:\TEMP\fptools\hslibs\data\edison\Seq\BinaryRandList.hi
-file20=C:\TEMP\fptools\hslibs\data\edison\Seq\BraunSeq.hi
-file21=C:\TEMP\fptools\hslibs\data\edison\Seq\JoinList.hi
-file22=C:\TEMP\fptools\hslibs\data\edison\Seq\ListSeq.hi
-file23=C:\TEMP\fptools\hslibs\data\edison\Seq\MyersStack.hi
-file24=C:\TEMP\fptools\hslibs\data\edison\Seq\RandList.hi
-file25=C:\TEMP\fptools\hslibs\data\edison\Seq\RevSeq.hi
-file26=C:\TEMP\fptools\hslibs\data\edison\Seq\Sequence.hi
-file27=C:\TEMP\fptools\hslibs\data\edison\Seq\SequenceDefaults.hi
-file28=C:\TEMP\fptools\hslibs\data\edison\Seq\SimpleQueue.hi
-file29=C:\TEMP\fptools\hslibs\data\edison\Seq\SizedSeq.hi
-file30=C:\TEMP\fptools\hslibs\data\edison\Seq\TestSeq.hi
-
-[lib\imports\lang]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\lang\Bits.hi
-file1=C:\TEMP\fptools\hslibs\lang\CCall.hi
-file2=C:\TEMP\fptools\hslibs\lang\Weak.hi
-file3=C:\TEMP\fptools\hslibs\lang\Word.hi
-file4=C:\TEMP\fptools\hslibs\lang\ArrayBase.hi
-file5=C:\TEMP\fptools\hslibs\lang\ByteArray.hi
-file6=C:\TEMP\fptools\hslibs\lang\CString.hi
-file7=C:\TEMP\fptools\hslibs\lang\CTypes.hi
-file8=C:\TEMP\fptools\hslibs\lang\CTypesISO.hi
-file9=C:\TEMP\fptools\hslibs\lang\Dynamic.hi
-file10=C:\TEMP\fptools\hslibs\lang\Exception.hi
-file11=C:\TEMP\fptools\hslibs\lang\Foreign.hi
-file12=C:\TEMP\fptools\hslibs\lang\ForeignObj.hi
-file13=C:\TEMP\fptools\hslibs\lang\GlaExts.hi
-file14=C:\TEMP\fptools\hslibs\lang\IArray.hi
-file15=C:\TEMP\fptools\hslibs\lang\Int.hi
-file16=C:\TEMP\fptools\hslibs\lang\IOExts.hi
-file17=C:\TEMP\fptools\hslibs\lang\LazyST.hi
-file18=C:\TEMP\fptools\hslibs\lang\MArray.hi
-file19=C:\TEMP\fptools\hslibs\lang\MutableArray.hi
-file20=C:\TEMP\fptools\hslibs\lang\NativeInfo.hi
-file21=C:\TEMP\fptools\hslibs\lang\NumExts.hi
-file22=C:\TEMP\fptools\hslibs\lang\PackedString.hi
-file23=C:\TEMP\fptools\hslibs\lang\ShowFunctions.hi
-file24=C:\TEMP\fptools\hslibs\lang\ST.hi
-file25=C:\TEMP\fptools\hslibs\lang\Stable.hi
-file26=C:\TEMP\fptools\hslibs\lang\StableName.hi
-file27=C:\TEMP\fptools\hslibs\lang\StablePtr.hi
-file28=C:\TEMP\fptools\hslibs\lang\Storable.hi
-file29=C:\TEMP\fptools\hslibs\lang\TimeExts.hi
-file30=C:\TEMP\fptools\hslibs\lang\Addr.hi
-file31=C:\TEMP\fptools\hslibs\lang\monads\Monoid.hi
-file32=C:\TEMP\fptools\hslibs\lang\monads\MonadError.hi
-file33=C:\TEMP\fptools\hslibs\lang\monads\MonadFix.hi
-file34=C:\TEMP\fptools\hslibs\lang\monads\MonadIdentity.hi
-file35=C:\TEMP\fptools\hslibs\lang\monads\MonadReader.hi
-file36=C:\TEMP\fptools\hslibs\lang\monads\MonadRWS.hi
-file37=C:\TEMP\fptools\hslibs\lang\monads\MonadState.hi
-file38=C:\TEMP\fptools\hslibs\lang\monads\MonadTrans.hi
-file39=C:\TEMP\fptools\hslibs\lang\monads\MonadWriter.hi
-file40=C:\TEMP\fptools\hslibs\lang\monads\MonadEither.hi
-
-[lib\imports\net]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\net\SocketPrim.hi
-file1=C:\TEMP\fptools\hslibs\net\Socket.hi
-file2=C:\TEMP\fptools\hslibs\net\BSD.hi
-file3=C:\TEMP\fptools\hslibs\net\URI.hi
-
-[lib\imports\util]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\util\GetOpt.hi
-file1=C:\TEMP\fptools\hslibs\util\MD5.hi
-file2=C:\TEMP\fptools\hslibs\util\Memo.hi
-file3=C:\TEMP\fptools\hslibs\util\check\QuickCheckUtils.hi
-file4=C:\TEMP\fptools\hslibs\util\check\QuickCheckBatch.hi
-file5=C:\TEMP\fptools\hslibs\util\check\QuickCheckPoly.hi
-file6=C:\TEMP\fptools\hslibs\util\check\QuickCheck.hi
-
-[lib\imports\num]
-fulldirectory=
-
-[lib\imports\text]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\text\RegexString.hi
-file1=C:\TEMP\fptools\hslibs\text\MatchPS.hi
-file2=C:\TEMP\fptools\hslibs\text\Pretty.hi
-file3=C:\TEMP\fptools\hslibs\text\Regex.hi
-file4=C:\TEMP\fptools\hslibs\text\html\Html.hi
-file5=C:\TEMP\fptools\hslibs\text\html\HtmlBlockTable.hi
-file6=C:\TEMP\fptools\hslibs\text\parsec\Parsec.hi
-file7=C:\TEMP\fptools\hslibs\text\parsec\ParsecError.hi
-file8=C:\TEMP\fptools\hslibs\text\parsec\ParsecExpr.hi
-file9=C:\TEMP\fptools\hslibs\text\parsec\ParsecLanguage.hi
-file10=C:\TEMP\fptools\hslibs\text\parsec\ParsecToken.hi
-file11=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlTypes.hi
-file12=C:\TEMP\fptools\hslibs\text\haxml\lib\ParseSTLib.hi
-file13=C:\TEMP\fptools\hslibs\text\haxml\lib\Xml2Haskell.hi
-file14=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlCombinators.hi
-file15=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlHtmlGen.hi
-file16=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlHtmlParse.hi
-file17=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlHtmlPP.hi
-file18=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlLex.hi
-file19=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlLib.hi
-file20=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlParse.hi
-file21=C:\TEMP\fptools\hslibs\text\haxml\lib\XmlPP.hi
-file22=C:\TEMP\fptools\hslibs\text\haxml\lib\Haskell2Xml.hi
-
-[lib\imports\greencard]
-fulldirectory=
-file0=C:\TEMP\fptools\greencard\lib\ghc\StdDIS.hi
-
-[lib\imports\concurrent]
-fulldirectory=
-file0=C:\TEMP\fptools\hslibs\concurrent\Strategies.hi
-file1=C:\TEMP\fptools\hslibs\concurrent\Channel.hi
-file2=C:\TEMP\fptools\hslibs\concurrent\ChannelVar.hi
-file3=C:\TEMP\fptools\hslibs\concurrent\Concurrent.hi
-file4=C:\TEMP\fptools\hslibs\concurrent\CVar.hi
-file5=C:\TEMP\fptools\hslibs\concurrent\Merge.hi
-file6=C:\TEMP\fptools\hslibs\concurrent\MVar.hi
-file7=C:\TEMP\fptools\hslibs\concurrent\Parallel.hi
-file8=C:\TEMP\fptools\hslibs\concurrent\QSem.hi
-file9=C:\TEMP\fptools\hslibs\concurrent\QSemN.hi
-file10=C:\TEMP\fptools\hslibs\concurrent\SampleVar.hi
-file11=C:\TEMP\fptools\hslibs\concurrent\Semaphore.hi
-file12=C:\TEMP\fptools\hslibs\concurrent\Chan.hi
-
-[lib\includes]
-fulldirectory=C:\usr\fptools-BUILDS\new-rts-20\ghc-4.03\lib\i386-unknown-mingw32\ghc-4.03\includes
-file0=C:\TEMP\fptools\ghc\includes\StgStorage.h
-file1=C:\TEMP\fptools\ghc\includes\Block.h
-file2=C:\TEMP\fptools\ghc\includes\CCall.h
-file3=C:\TEMP\fptools\ghc\includes\ClosureMacros.h
-file4=C:\TEMP\fptools\ghc\includes\Closures.h
-file5=C:\TEMP\fptools\ghc\includes\ClosureTypes.h
-file6=C:\TEMP\fptools\ghc\includes\config.h
-file7=C:\TEMP\fptools\ghc\includes\Constants.h
-file8=C:\TEMP\fptools\ghc\includes\gmp.h
-file9=C:\TEMP\fptools\ghc\includes\GranSim.h
-file10=C:\TEMP\fptools\ghc\includes\Hooks.h
-file11=C:\TEMP\fptools\ghc\includes\HsFFI.h
-file12=C:\TEMP\fptools\ghc\includes\ieee-flpt.h
-file13=C:\TEMP\fptools\ghc\includes\InfoMacros.h
-file14=C:\TEMP\fptools\ghc\includes\InfoTables.h
-file15=C:\TEMP\fptools\ghc\includes\MachDeps.h
-file16=C:\TEMP\fptools\ghc\includes\MachRegs.h
-file17=C:\TEMP\fptools\ghc\includes\NativeDefs.h
-file18=C:\TEMP\fptools\ghc\includes\options.h
-file19=C:\TEMP\fptools\ghc\includes\Parallel.h
-file20=C:\TEMP\fptools\ghc\includes\PrimOps.h
-file21=C:\TEMP\fptools\ghc\includes\Regs.h
-file22=C:\TEMP\fptools\ghc\includes\Rts.h
-file23=C:\TEMP\fptools\ghc\includes\RtsAPI.h
-file24=C:\TEMP\fptools\ghc\includes\RtsTypes.h
-file25=C:\TEMP\fptools\ghc\includes\SchedAPI.h
-file26=C:\TEMP\fptools\ghc\includes\SMP.h
-file27=C:\TEMP\fptools\ghc\includes\Stable.h
-file28=C:\TEMP\fptools\ghc\includes\Stg.h
-file39=C:\TEMP\fptools\ghc\includes\StgDLL.h
-file30=C:\TEMP\fptools\ghc\includes\StgMacros.h
-file31=C:\TEMP\fptools\ghc\includes\StgMiscClosures.h
-file32=C:\TEMP\fptools\ghc\includes\StgProf.h
-file33=C:\TEMP\fptools\ghc\includes\Assembler.h
-file34=C:\TEMP\fptools\ghc\includes\StgTicky.h
-file35=C:\TEMP\fptools\ghc\includes\StgTypes.h
-file36=C:\TEMP\fptools\ghc\includes\TailCalls.h
-file37=C:\TEMP\fptools\ghc\includes\TSO.h
-file38=C:\TEMP\fptools\ghc\includes\Updates.h
-
diff --git a/ghc/InstallShield/Glasgow Haskell Compiler.ipr b/ghc/InstallShield/Glasgow Haskell Compiler.ipr
deleted file mode 100644
index e9412ec8fb..0000000000
--- a/ghc/InstallShield/Glasgow Haskell Compiler.ipr
+++ /dev/null
@@ -1,58 +0,0 @@
-[Language]
-LanguageSupport0=0009
-
-[OperatingSystem]
-OSSupport=0000000000011010
-
-[Data]
-CurrentMedia=rel
-set_mifserial=
-ProductName=Glasgow Haskell Compiler
-CurrentComponentDef=Default.cdf
-set_dlldebug=No
-AppExe=ghc
-DevEnvironment=Microsoft Visual C++ 6
-set_mif=No
-set_testmode=No
-Instructions=Instructions.txt
-EmailAddresss=glasgow-haskell-users@haskell.org
-SummaryText=
-Department=
-Type=Software Development Application
-Author=
-HomeURL=http://www.haskell.org/ghc/
-InstallRoot=C:\TEMP\fptools-head\fptools\ghc\InstallShield
-set_level=Level 3
-InstallationGUID=6db5bb92-3160-48f2-92d1-f9141c99d48a
-Version=4.08.1
-set_miffile=Status.mif
-set_args=
-set_maxerr=50
-Notes=Notes.txt
-CurrentFileGroupDef=Default.fdf
-set_dllcmdline=
-set_warnaserr=No
-Copyright=See LICENSE
-set_preproc=
-Category=
-CurrentPlatform=
-set_compileb4build=No
-set_crc=Yes
-set_maxwarn=50
-Description=Description.txt
-CompanyName=University of Glasgow
-CurrentLanguage=English
-set_libraries=isrt.obl ifx.obl
-set_linkpath=
-
-[MediaInfo]
-mediadata0=release/Media\release
-mediadata1=New Media/Media\New Media
-mediadata2=rel/Media\rel
-
-[General]
-Type=INSTALLMAIN
-Version=2.20.000
-ReadOnly=N
-PassData=
-
diff --git a/ghc/InstallShield/README b/ghc/InstallShield/README
deleted file mode 100644
index 81a1c70357..0000000000
--- a/ghc/InstallShield/README
+++ /dev/null
@@ -1,30 +0,0 @@
-This is the InstallShield setup for GHC; it can be used as a model for other
-IS setups.
-
-Notes:
-
-1. This IS setup is for the full version of IS, *not* the one that
-   comes with MS Visual Studio.
-
-2. Merely checking out this tree will not give you a functioning IS
-   setup, unfortunately. This is because there are various empty
-   directories (which CVS doesn't like). I've not done the usual trick
-   of putting spurious files in them in case InstallShield takes
-   exception to that.
-
-3. The InstallShield script generates some files entirely by
-   itself. These are:
-
-     a. the specs file for gcc
-     b. the "front-end" to autoconf (so that it can find its library
-        files).
-
-It might be useful to record for posterity why some of the less
-obvious binaries are in ghc/extra-bin:
-
-uname: for config.guess (used in gmp's configure script)
-
-basename: to find the basename of binaries such as gzip in the main
-configure script
-
-uniq: somewhere...
\ No newline at end of file
diff --git a/ghc/InstallShield/Registry Entries/Default.rge b/ghc/InstallShield/Registry Entries/Default.rge
deleted file mode 100644
index f73a93c2a4..0000000000
--- a/ghc/InstallShield/Registry Entries/Default.rge
+++ /dev/null
@@ -1,6 +0,0 @@
-[Data]
-
-[General]
-Type=REGISTRYDATA
-Version=2.10.000
-
diff --git a/ghc/InstallShield/Script Files/Setup.Inx b/ghc/InstallShield/Script Files/Setup.Inx
deleted file mode 100644
index 4aef7fa618..0000000000
--- a/ghc/InstallShield/Script Files/Setup.Inx
+++ /dev/null
diff --git a/ghc/InstallShield/Script Files/Setup.Obs b/ghc/InstallShield/Script Files/Setup.Obs
deleted file mode 100644
index 53425bdaea..0000000000
--- a/ghc/InstallShield/Script Files/Setup.Obs
+++ /dev/null
diff --git a/ghc/InstallShield/Script Files/Setup.dbg b/ghc/InstallShield/Script Files/Setup.dbg
deleted file mode 100644
index 7c86870878..0000000000
--- a/ghc/InstallShield/Script Files/Setup.dbg
+++ /dev/null
diff --git a/ghc/InstallShield/Script Files/Setup.ino b/ghc/InstallShield/Script Files/Setup.ino
deleted file mode 100644
index 421984ed6b..0000000000
--- a/ghc/InstallShield/Script Files/Setup.ino
+++ /dev/null
diff --git a/ghc/InstallShield/Script Files/Setup.ins b/ghc/InstallShield/Script Files/Setup.ins
deleted file mode 100644
index 156a8eecdc..0000000000
--- a/ghc/InstallShield/Script Files/Setup.ins
+++ /dev/null
diff --git a/ghc/InstallShield/Script Files/Setup.map b/ghc/InstallShield/Script Files/Setup.map
deleted file mode 100644
index 3039284bcd..0000000000
--- a/ghc/InstallShield/Script Files/Setup.map
+++ /dev/null
@@ -1,574 +0,0 @@
-***** External Functions *****
-1    CloseFile                                          isrt.obl(Files.obs)
-2    CmdGetHwndDlg                                      isrt.obl(CustomDlg.obs)
-3    CommitSharedFiles                                  isrt.obl(Misc.obs)
-4    ComponentCompareSizeRequired                       isrt.obl(component.obs)
-5    ComponentError                                     isrt.obl(component.obs)
-6    ComponentErrorInfo                                 isrt.obl(component.obs)
-7    ComponentFilterLanguage                            isrt.obl(component.obs)
-8    ComponentFilterOS                                  isrt.obl(component.obs)
-9    ComponentGetData                                   isrt.obl(component.obs)
-10   ComponentGetTotalCost                              isrt.obl(component.obs)
-11   ComponentIsItemSelected                            isrt.obl(component.obs)
-12   ComponentListItems                                 isrt.obl(component.obs)
-13   ComponentMoveData                                  isrt.obl(component.obs)
-14   ComponentReinstall                                 isrt.obl(component.obs)
-15   ComponentRemoveAll                                 isrt.obl(component.obs)
-16   ComponentSaveTarget                                isrt.obl(component.obs)
-17   ComponentSelectItem                                isrt.obl(component.obs)
-18   ComponentSetTarget                                 isrt.obl(component.obs)
-19   ComponentSetupTypeSet                              isrt.obl(component.obs)
-20   ComponentTransferData                              isrt.obl(component.obs)
-21   ComponentTreeInit                                  isrt.obl(Dialogs.obs)
-22   ComponentViewCreate                                isrt.obl(CmptView.obs)
-23   CopyFile                                           isrt.obl(Files.obs)
-24   CreateDir                                          isrt.obl(Files.obs)
-25   CreateFile                                         isrt.obl(Files.obs)
-26   CreateInstallationInfo                             isrt.obl(Registry.obs)
-27   CreateRegistrySet                                  isrt.obl(component.obs)
-28   CreateShellObjects                                 isrt.obl(component.obs)
-29   CtrlGetCurSel                                      isrt.obl(CustomDlg.obs)
-30   CtrlGetNotificationCode                            isrt.obl(CustomDlg.obs)
-31   CtrlGetState                                       isrt.obl(CustomDlg.obs)
-32   CtrlGetText                                        isrt.obl(CustomDlg.obs)
-33   CtrlPGroups                                        isrt.obl(CustomDlg.obs)
-34   CtrlSelectText                                     isrt.obl(CustomDlg.obs)
-35   CtrlSetCurSel                                      isrt.obl(CustomDlg.obs)
-36   CtrlSetList                                        isrt.obl(CustomDlg.obs)
-37   CtrlSetMLEText                                     isrt.obl(CustomDlg.obs)
-38   CtrlSetState                                       isrt.obl(CustomDlg.obs)
-39   CtrlSetText                                        isrt.obl(CustomDlg.obs)
-40   DefineDialog                                       isrt.obl(CustomDlg.obs)
-41   DeinstallStart                                     isrt.obl(Registry.obs)
-42   Delay                                              isrt.obl(Misc.obs)
-43   DeleteFile                                         isrt.obl(Files.obs)
-44   DialogSetDefaultFont                               isrt.obl(Dialogs.obs)
-45   DialogSetFont                                      isrt.obl(Dialogs.obs)
-46   DialogSetInfo                                      isrt.obl(Dialogs.obs)
-47   Disable                                            isrt.obl(Enable.obs)
-48   DiskSizeToStr                                      isrt.obl(SDINT.obs)
-49   Divide                                             isrt.obl(Misc.obs)
-50   DllSizeOf                                          isrt.obl(Str.obs)
-51   Do                                                 isrt.obl(Misc.obs)
-52   Enable                                             isrt.obl(Enable.obs)
-53   EndDialog                                          isrt.obl(CustomDlg.obs)
-54   EnterDisk                                          isrt.obl(EnterDisk.obs)
-55   ExistsDir                                          isrt.obl(Files.obs)
-56   ExistsDisk                                         isrt.obl(Files.obs)
-57   EzDefineDialog                                     isrt.obl(CustomDlg.obs)
-58   FinalConstruct                                     ifx.obl(Events.obs)
-59   FinalRelease                                       ifx.obl(Events.obs)
-60   FindFile                                           isrt.obl(Files.obs)
-61   FormatMessage                                      isrt.obl(Misc.obs)
-62   GDI32.CreateRectRgn                                isrt.obl(AskDestPath.obs)
-63   GDI32.GetDeviceCaps                                isrt.obl(AskDestPath.obs)
-64   GetBillboard                                       isrt.obl(SysVars.obs)
-65   GetDialogTitle                                     isrt.obl(Dialogs.obs)
-66   GetDir                                             isrt.obl(Str.obs)
-67   GetDisk                                            isrt.obl(Str.obs)
-68   GetDiskSpace                                       isrt.obl(GSI.obs)
-69   GetDiskSpaceEx                                     isrt.obl(GSI.obs)
-70   GetErrorMsg                                        isrt.obl(Dialogs.obs)
-71   GetErrorTitle                                      isrt.obl(Dialogs.obs)
-72   GetExtents                                         isrt.obl(GSI.obs)
-73   GetFolderNameList                                  isrt.obl(Shell.obs)
-74   GetFolderPrograms                                  isrt.obl(SysVars.obs)
-75   GetISRes                                           isrt.obl(SysVars.obs)
-76   GetLine                                            isrt.obl(Files.obs)
-77   GetLog                                             isrt.obl(SysVars.obs)
-78   GetMaintenance                                     isrt.obl(SysVars.obs)
-79   GetOpenFileMode                                    isrt.obl(Files.obs)
-80   GetProductGUID                                     isrt.obl(SysVars.obs)
-81   GetProfString                                      isrt.obl(Profile.obs)
-82   GetProgramFiles                                    isrt.obl(SysVars.obs)
-83   GetSelectedLanguage                                isrt.obl(SysVars.obs)
-84   GetSelectedTreeComponent                           isrt.obl(CmptView.obs)
-85   GetSupportDir                                      isrt.obl(SysVars.obs)
-86   GetSystemInfo                                      isrt.obl(GSI.obs)
-87   GetWinDir                                          isrt.obl(SysVars.obs)
-88   GetWinSysDir                                       isrt.obl(SysVars.obs)
-89   GetWindowHandle                                    isrt.obl(Misc.obs)
-90   HIWORD                                             isrt.obl(Misc.obs)
-91   HexStrToNum                                        isrt.obl(Str.obs)
-92   ISDeterminePlatform                                isrt.obl(OsInfo.obs)
-93   ISMIF32.InstallStatusMIF                           isrt.obl(MIF.obs)
-94   ISRT.ComponentViewCreateWindow                     isrt.obl(CmptView.obs)
-95   ISRT.ComponentViewDestroy                          isrt.obl(CmptView.obs)
-96   ISRT.ComponentViewRefresh                          isrt.obl(CmptView.obs)
-97   ISRT.ComponentViewSetInfo                          isrt.obl(CmptView.obs)
-98   ISRT.ComponentViewSetInfoEx                        isrt.obl(Dialogs.obs)
-99   ISRT.EnableHourGlass                               isrt.obl(Enable.obs)
-100  ISRT.EnumFoldersItems                              isrt.obl(Shell.obs)
-101  ISRT.GetCPUType                                    isrt.obl(GSI.obs)
-102  ISRT.GetFontSub                                    isrt.obl(Dialogs.obs)
-103  ISRT.GetHandle                                     Setup.Obs
-104  ISRT.GetPorts                                      isrt.obl(GSI.obs)
-105  ISRT.IsEmpty                                       Setup.Obs
-106  ISRT.IsNTAdmin                                     isrt.obl(Is.obs)
-107  ISRT.IsObject                                      Setup.Obs
-108  ISRT.LangLoadString                                isrt.obl(SDINT.obs)
-109  ISRT.MessageBeepP                                  Setup.Obs
-110  ISRT.PathCompactPathPixel                          isrt.obl(CustomDlg.obs)
-111  ISRT.PathGetDir                                    isrt.obl(Str.obs)
-112  ISRT.PathGetDrive                                  isrt.obl(Str.obs)
-113  ISRT.PathGetFile                                   isrt.obl(Str.obs)
-114  ISRT.PathGetFileExt                                isrt.obl(Str.obs)
-115  ISRT.PathGetFileName                               isrt.obl(Str.obs)
-116  ISRT.PathGetPath                                   isrt.obl(Str.obs)
-117  ISRT.PathGetSpecialFolder                          isrt.obl(SysVars.obs)
-118  ISRT.PathIsValidSyntax                             isrt.obl(Is.obs)
-119  ISRT._BrowseForFolder                              isrt.obl(SelectDir.obs)
-120  ISRT._CleanupInet                                  isrt.obl(MIO.obs)
-121  ISRT._CloseFile                                    isrt.obl(Files.obs)
-122  ISRT._CmdGetHwndDlg                                isrt.obl(CustomDlg.obs)
-123  ISRT._ComponentCompareSizeRequired                 isrt.obl(component.obs)
-124  ISRT._ComponentError                               isrt.obl(component.obs)
-125  ISRT._ComponentErrorInfo                           isrt.obl(component.obs)
-126  ISRT._ComponentFilterLanguage                      isrt.obl(component.obs)
-127  ISRT._ComponentFilterOS                            isrt.obl(component.obs)
-128  ISRT._ComponentGetData                             isrt.obl(component.obs)
-129  ISRT._ComponentGetTotalCost                        isrt.obl(component.obs)
-130  ISRT._ComponentIsItemSelected                      isrt.obl(component.obs)
-131  ISRT._ComponentListItems                           isrt.obl(component.obs)
-132  ISRT._ComponentMoveData                            isrt.obl(component.obs)
-133  ISRT._ComponentReinstall                           isrt.obl(component.obs)
-134  ISRT._ComponentRemoveAll                           isrt.obl(component.obs)
-135  ISRT._ComponentSaveTarget                          isrt.obl(component.obs)
-136  ISRT._ComponentSelectItem                          isrt.obl(component.obs)
-137  ISRT._ComponentSetupTypeSet                        isrt.obl(component.obs)
-138  ISRT._ComponentTransferData                        isrt.obl(component.obs)
-139  ISRT._ComponentViewCreate                          isrt.obl(CmptView.obs)
-140  ISRT._CreateDir                                    isrt.obl(Files.obs)
-141  ISRT._CreateRegistrySet                            isrt.obl(component.obs)
-142  ISRT._CreateShellObjects                           isrt.obl(component.obs)
-143  ISRT._CtrlGetNotificationCode                      isrt.obl(CustomDlg.obs)
-144  ISRT._DefineDialog                                 isrt.obl(CustomDlg.obs)
-145  ISRT._DialogSetFont                                isrt.obl(Dialogs.obs)
-146  ISRT._DisableStatus                                isrt.obl(Enable.obs)
-147  ISRT._Divide                                       isrt.obl(Misc.obs)
-148  ISRT._DoSprintf                                    isrt.obl(MsgBox.obs)
-149  ISRT._EnableDialogCache                            isrt.obl(Enable.obs)
-150  ISRT._EnablePrevDialog                             isrt.obl(AskDestPath.obs)
-151  ISRT._EnableStatus                                 isrt.obl(Enable.obs)
-152  ISRT._EndDialog                                    isrt.obl(CustomDlg.obs)
-153  ISRT._ExistsDir                                    isrt.obl(Files.obs)
-154  ISRT._ExistsDisk                                   isrt.obl(Files.obs)
-155  ISRT._ExistsFile                                   isrt.obl(Files.obs)
-156  ISRT._FileCopy                                     isrt.obl(Files.obs)
-157  ISRT._GetDiskSpaceEx                               isrt.obl(GSI.obs)
-158  ISRT._GetLine                                      isrt.obl(Files.obs)
-159  ISRT._GetSelectedTreeComponent                     isrt.obl(CmptView.obs)
-160  ISRT._GetSupportDir                                isrt.obl(SysVars.obs)
-161  ISRT._InetEndofTransfer                            isrt.obl(iftw.obs)
-162  ISRT._InetGetLastError                             isrt.obl(iftw.obs)
-163  ISRT._InetGetNextDisk                              isrt.obl(iftw.obs)
-164  ISRT._ListAddItem                                  isrt.obl(scrlist.obs)
-165  ISRT._ListAddString                                isrt.obl(scrlist.obs)
-166  ISRT._ListCount                                    isrt.obl(scrlist.obs)
-167  ISRT._ListCreate                                   isrt.obl(scrlist.obs)
-168  ISRT._ListCurrentString                            isrt.obl(scrlist.obs)
-169  ISRT._ListDeleteString                             isrt.obl(scrlist.obs)
-170  ISRT._ListDestroy                                  isrt.obl(scrlist.obs)
-171  ISRT._ListFindString                               isrt.obl(scrlist.obs)
-172  ISRT._ListGetFirstItem                             isrt.obl(scrlist.obs)
-173  ISRT._ListGetFirstString                           isrt.obl(scrlist.obs)
-174  ISRT._ListGetNextItem                              isrt.obl(scrlist.obs)
-175  ISRT._ListGetNextString                            isrt.obl(scrlist.obs)
-176  ISRT._ListGetType                                  isrt.obl(scrlist.obs)
-177  ISRT._ListReadFromFile                             isrt.obl(scrlist.obs)
-178  ISRT._ListSetIndex                                 isrt.obl(scrlist.obs)
-179  ISRT._OpenFile                                     isrt.obl(Files.obs)
-180  ISRT._Rebooted                                     Setup.Obs
-181  ISRT._RegCreateKey                                 isrt.obl(Registry.obs)
-182  ISRT._RegExistsKey                                 isrt.obl(Registry.obs)
-183  ISRT._RegQueryKeyBinaryValue                       isrt.obl(Registry.obs)
-184  ISRT._RegQueryKeyValue                             isrt.obl(Registry.obs)
-185  ISRT._RegSetKeyBinaryValue                         isrt.obl(Registry.obs)
-186  ISRT._RegSetKeyValue                               isrt.obl(Registry.obs)
-187  ISRT._ReleaseDialog                                isrt.obl(CustomDlg.obs)
-188  ISRT._SetAltMainImage                              isrt.obl(Dialogs.obs)
-189  ISRT._SetColor                                     isrt.obl(ui.obs)
-190  ISRT._SetDisplayEffect                             isrt.obl(ui.obs)
-191  ISRT._SetPaletteFile                               isrt.obl(MIO.obs)
-192  ISRT._SetTitle                                     isrt.obl(ui.obs)
-193  ISRT._SetupInet                                    isrt.obl(MIO.obs)
-194  ISRT._ShowObjWizardPages                           isrt.obl(Objects.obs)
-195  ISRT._StatusUpdate                                 isrt.obl(ui.obs)
-196  ISRT._TreeViewCreate                               isrt.obl(CmptView.obs)
-197  ISRT._WaitOnDialog                                 isrt.obl(CustomDlg.obs)
-198  ISRT._WriteLine                                    isrt.obl(Files.obs)
-199  ISRT.__CreateObjectContext                         isrt.obl(ISRTInit.obs)
-200  ISRT.__GetCmdLineOptions                           isrt.obl(ISRTInit.obs)
-201  ISRT.__GetContextGUID                              isrt.obl(ISRTInit.obs)
-202  ISRT.__GetFileRegistrar                            isrt.obl(ISRTInit.obs)
-203  ISRT.__GetInfo                                     isrt.obl(ISRTInit.obs)
-204  ISRT.__GetLog                                      isrt.obl(SysVars.obs)
-205  ISRT.__GetLogDB                                    isrt.obl(ISRTInit.obs)
-206  ISRT.__GetMainWindow                               Setup.Obs
-207  ISRT.__GetMaintenanceMode                          isrt.obl(SysVars.obs)
-208  ISRT.__GetProductGuid                              isrt.obl(SysVars.obs)
-209  ISRT.__GetProgress                                 Setup.Obs
-210  ISRT.__GetReboot                                   isrt.obl(ISRTInit.obs)
-211  ISRT.__GetTextSub                                  isrt.obl(ISRTInit.obs)
-212  ISRT.__GetUser                                     isrt.obl(MIO.obs)
-213  ISRT.__ISRTGetPropertyBag                          ifx.obl(PersistPropertyBag.obs)
-214  ISRT.__ISRTReleasePropertyBag                      ifx.obl(PersistPropertyBag.obs)
-215  ISRT.__LoadString                                  isrt.obl(LoadStr.obs)
-216  ISRT.__ReleaseObjectContext                        isrt.obl(ISRTInit.obs)
-217  ISRT.__RestoreMainLog                              isrt.obl(ISRTInit.obs)
-218  ISRT.__SetComponentLog                             isrt.obl(ISRTInit.obs)
-219  IfxFilterComponents                                ifx.obl(MoveData.obs)
-220  IfxFinalConstruct                                  ifx.obl(EventsMIO.obs)
-221  IfxFinalRelease                                    ifx.obl(EventsMIO.obs)
-222  IfxInitProperties                                  ifx.obl(PersistPropertyBag.obs)
-223  IfxMoveFileData                                    ifx.obl(MoveData.obs)
-224  IfxOnAbortInstall                                  ifx.obl(Events.obs)
-225  IfxOnAppSearch                                     ifx.obl(Events.obs)
-226  IfxOnCCPSearch                                     ifx.obl(Events.obs)
-227  IfxOnCanceling                                     ifx.obl(Events.obs)
-228  IfxOnDisk1Installed                                ifx.obl(EventsMIO.obs)
-229  IfxOnDisk1Installing                               ifx.obl(EventsMIO.obs)
-230  IfxOnExitInstall                                   ifx.obl(EventsMIO.obs)
-231  IfxOnFileError                                     ifx.obl(Exceptions.obs)
-232  IfxOnFileLocked                                    ifx.obl(Exceptions.obs)
-233  IfxOnFileReadOnly                                  ifx.obl(Exceptions.obs)
-234  IfxOnHelp                                          ifx.obl(Events.obs)
-235  IfxOnInitInstall                                   ifx.obl(EventsMIO.obs)
-236  IfxOnInternetError                                 ifx.obl(Exceptions.obs)
-237  IfxOnMD5Error                                      ifx.obl(Exceptions.obs)
-238  IfxOnNextDisk                                      ifx.obl(Exceptions.obs)
-239  IfxOnRebooted                                      ifx.obl(Events.obs)
-240  IfxOnRemovingSharedFile                            ifx.obl(Exceptions.obs)
-241  IfxOnShowWizardPages                               ifx.obl(UserInterfaceMIO.obs)
-242  IfxOnTransferred                                   ifx.obl(Events.obs)
-243  IfxOnTransferring                                  ifx.obl(EventsMIO.obs)
-244  IfxOnUnhandledException                            ifx.obl(Events.obs)
-245  IfxReadProperties                                  ifx.obl(PersistPropertyBag.obs)
-246  IfxRunAfterReboot                                  ifx.obl(Driver.obs)
-247  IfxWriteProperties                                 ifx.obl(PersistPropertyBag.obs)
-248  InetEndofTransfer                                  isrt.obl(iftw.obs)
-249  InetErrorDisplayMode                               isrt.obl(iftw.obs)
-250  InetGetLastError                                   isrt.obl(iftw.obs)
-251  InetNextDisk                                       isrt.obl(iftw.obs)
-252  InitProperties                                     ifx.obl(PersistPropertyBag.obs)
-253  InstallationInfo                                   isrt.obl(Registry.obs)
-254  Is                                                 isrt.obl(Is.obs)
-255  IsInetInstall                                      isrt.obl(iftw.obs)
-256  KERNEL.GetModuleHandle                             Setup.Obs
-257  KERNEL32.CloseHandle                               isrt.obl(AskDestPath.obs)
-258  KERNEL32.CreateFileA                               isrt.obl(AskDestPath.obs)
-259  KERNEL32.DeleteFileA                               isrt.obl(AskDestPath.obs)
-260  KERNEL32.FileTimeToLocalFileTime                   isrt.obl(AskDestPath.obs)
-261  KERNEL32.FileTimeToSystemTime                      isrt.obl(AskDestPath.obs)
-262  KERNEL32.FindClose                                 isrt.obl(AskDestPath.obs)
-263  KERNEL32.FindFirstFileA                            isrt.obl(AskDestPath.obs)
-264  KERNEL32.FindNextFileA                             isrt.obl(AskDestPath.obs)
-265  KERNEL32.FormatMessageA                            isrt.obl(AskDestPath.obs)
-266  KERNEL32.GetDriveType                              isrt.obl(AskDestPath.obs)
-267  KERNEL32.GetFileAttributesA                        isrt.obl(AskDestPath.obs)
-268  KERNEL32.GetFileTime                               isrt.obl(AskDestPath.obs)
-269  KERNEL32.GetLocalTime                              isrt.obl(AskDestPath.obs)
-270  KERNEL32.GetLocaleInfo                             isrt.obl(AskDestPath.obs)
-271  KERNEL32.GetPrivateProfileString                   isrt.obl(AskDestPath.obs)
-272  KERNEL32.GetPrivateProfileStringA                  isrt.obl(AskDestPath.obs)
-273  KERNEL32.GetProfileStringA                         isrt.obl(AskDestPath.obs)
-274  KERNEL32.GetSystemDefaultLCID                      isrt.obl(AskDestPath.obs)
-275  KERNEL32.GetUserDefaultLangID                      isrt.obl(AskDestPath.obs)
-276  KERNEL32.GetVersion                                isrt.obl(AskDestPath.obs)
-277  KERNEL32.GetVersionEx                              isrt.obl(AskDestPath.obs)
-278  KERNEL32.GetVolumeInformation                      isrt.obl(AskDestPath.obs)
-279  KERNEL32.GetWindowsDirectory                       isrt.obl(AskDestPath.obs)
-280  KERNEL32.GlobalMemoryStatus                        isrt.obl(AskDestPath.obs)
-281  KERNEL32.LocalFileTimeToFileTime                   isrt.obl(AskDestPath.obs)
-282  KERNEL32.MoveFileA                                 isrt.obl(AskDestPath.obs)
-283  KERNEL32.SetFileAttributesA                        isrt.obl(AskDestPath.obs)
-284  KERNEL32.SetFileTime                               isrt.obl(AskDestPath.obs)
-285  KERNEL32.Sleep                                     isrt.obl(AskDestPath.obs)
-286  KERNEL32.SystemTimeToFileTime                      isrt.obl(AskDestPath.obs)
-287  KERNEL32.WritePrivateProfileString                 isrt.obl(AskDestPath.obs)
-288  KERNEL32.WritePrivateProfileStringA                isrt.obl(AskDestPath.obs)
-289  KERNEL32.WriteProfileStringA                       isrt.obl(AskDestPath.obs)
-290  KERNEL32.lstrlen                                   isrt.obl(AskDestPath.obs)
-291  LOWORD                                             isrt.obl(Misc.obs)
-292  ListAddItem                                        isrt.obl(scrlist.obs)
-293  ListAddString                                      isrt.obl(scrlist.obs)
-294  ListCount                                          isrt.obl(scrlist.obs)
-295  ListCreate                                         isrt.obl(scrlist.obs)
-296  ListCurrentString                                  isrt.obl(scrlist.obs)
-297  ListDeleteString                                   isrt.obl(scrlist.obs)
-298  ListDestroy                                        isrt.obl(scrlist.obs)
-299  ListFindString                                     isrt.obl(scrlist.obs)
-300  ListGetFirstItem                                   isrt.obl(scrlist.obs)
-301  ListGetFirstString                                 isrt.obl(scrlist.obs)
-302  ListGetNextItem                                    isrt.obl(scrlist.obs)
-303  ListGetNextString                                  isrt.obl(scrlist.obs)
-304  ListGetType                                        isrt.obl(scrlist.obs)
-305  ListReadFromFile                                   isrt.obl(scrlist.obs)
-306  ListSetIndex                                       isrt.obl(scrlist.obs)
-307  LongPathToQuote                                    isrt.obl(Str.obs)
-308  MAKELONG                                           isrt.obl(Misc.obs)
-309  MIFCreateMIFFile                                   isrt.obl(MIF.obs)
-310  MIFDeleteMIFFile                                   isrt.obl(MIF.obs)
-311  MIFInitialize                                      isrt.obl(MIF.obs)
-312  MIFSetInformation                                  isrt.obl(MIF.obs)
-313  MIFUnInitialize                                    isrt.obl(MIF.obs)
-314  MIFWasSetInformationCalled                         isrt.obl(MIF.obs)
-315  MIOShutdown                                        isrt.obl(MIO.obs)
-316  MIOStartup                                         isrt.obl(MIO.obs)
-317  MaintenanceStart                                   isrt.obl(Registry.obs)
-318  MessageBeep                                        isrt.obl(Misc.obs)
-319  MessageBox                                         isrt.obl(MsgBox.obs)
-320  OnAbort                                            ifx.obl(Events.obs)
-321  OnAppSearch                                        ifx.obl(Events.obs)
-322  OnBegin                                            ifx.obl(Events.obs)
-323  OnCCPSearch                                        ifx.obl(Events.obs)
-324  OnCanceling                                        ifx.obl(EventsMIO.obs)
-325  OnComponentError                                   ifx.obl(Exceptions.obs)
-326  OnEnd                                              ifx.obl(Events.obs)
-327  OnFileError                                        ifx.obl(Exceptions.obs)
-328  OnFileLocked                                       ifx.obl(Exceptions.obs)
-329  OnFileReadOnly                                     ifx.obl(Exceptions.obs)
-330  OnFirstUIAfter                                     ifx.obl(UserInterfaceMIO.obs)
-331  OnFirstUIBefore                                    ifx.obl(UserInterfaceMIO.obs)
-332  OnHelp                                             ifx.obl(Events.obs)
-333  OnInternetError                                    ifx.obl(Exceptions.obs)
-334  OnMD5Error                                         ifx.obl(Exceptions.obs)
-335  OnMaintUIAfter                                     ifx.obl(UserInterfaceMIO.obs)
-336  OnMaintUIBefore                                    ifx.obl(UserInterfaceMIO.obs)
-337  OnMoved                                            ifx.obl(Events.obs)
-338  OnMoving                                           ifx.obl(Events.obs)
-339  OnNextDisk                                         ifx.obl(Exceptions.obs)
-340  OnRebooted                                         ifx.obl(Events.obs)
-341  OnRemovingSharedFile                               ifx.obl(Exceptions.obs)
-342  OnSelfRegistrationError                            ifx.obl(Events.obs)
-343  OnUnhandledException                               ifx.obl(Events.obs)
-344  OpenFile                                           isrt.obl(Files.obs)
-345  OpenFileMode                                       isrt.obl(Files.obs)
-346  ParsePath                                          isrt.obl(Str.obs)
-347  ProgDefGroupType                                   isrt.obl(Shell.obs)
-348  ProgGetGroupType                                   isrt.obl(Shell.obs)
-349  PthFixPath                                         isrt.obl(Pth.obs)
-350  PthIsAbsPath                                       isrt.obl(Pth.obs)
-351  ReadProperties                                     ifx.obl(PersistPropertyBag.obs)
-352  Rebooted                                           isrt.obl(Driver.obs)
-353  RegDBCreateKeyEx                                   isrt.obl(Registry.obs)
-354  RegDBGetKeyValueEx                                 isrt.obl(Registry.obs)
-355  RegDBInit                                          isrt.obl(Registry.obs)
-356  RegDBKeyExist                                      isrt.obl(Registry.obs)
-357  RegDBQueryValue                                    isrt.obl(Registry.obs)
-358  RegDBSetDefaultRoot                                isrt.obl(Registry.obs)
-359  RegDBSetItem                                       isrt.obl(Registry.obs)
-360  RegDBSetKeyValueEx                                 isrt.obl(Registry.obs)
-361  RegDBSetValue                                      isrt.obl(Registry.obs)
-362  ReleaseDialog                                      isrt.obl(CustomDlg.obs)
-363  RenameFile                                         isrt.obl(Files.obs)
-364  SdAskDestPath                                      isrt.obl(SDADPATH.obs)
-365  SdCloseDlg                                         isrt.obl(SDINT.obs)
-366  SdComponentDialog2                                 isrt.obl(SDCOMDL2.obs)
-367  SdComponentDlgCheckSpace                           isrt.obl(SDINT.obs)
-368  SdComponentTree                                    isrt.obl(SDCOMTREE.obs)
-369  SdCreateComponentView                              isrt.obl(SDINT.obs)
-370  SdDlgToTop                                         isrt.obl(SDINT.obs)
-371  SdDoStdButton                                      isrt.obl(SDINT.obs)
-372  SdEnablement                                       isrt.obl(SDINT.obs)
-373  SdError                                            isrt.obl(SDINT.obs)
-374  SdExceptions                                       isrt.obl(SdExceptions.obs)
-375  SdFinish                                           isrt.obl(SDFINISH.obs)
-376  SdFinishEx                                         isrt.obl(SdFinishEx.obs)
-377  SdFinishReboot                                     isrt.obl(SDFINBOT.obs)
-378  SdGeneralInit                                      isrt.obl(SDINT.obs)
-379  SdInit                                             isrt.obl(SDINT.obs)
-380  SdIsShellExplorer                                  isrt.obl(SDINT.obs)
-381  SdIsStdButton                                      isrt.obl(SDINT.obs)
-382  SdLoadString                                       isrt.obl(SDINT.obs)
-383  SdMakeName                                         isrt.obl(SDINT.obs)
-384  SdPlugInProductName                                isrt.obl(SDINT.obs)
-385  SdProductName                                      isrt.obl(SDPRODCT.obs)
-386  SdRemoveEndSpace                                   isrt.obl(SDINT.obs)
-387  SdSelectFolder                                     isrt.obl(SDSFDR.obs)
-388  SdSetDlgTitle                                      isrt.obl(SDINT.obs)
-389  SdSetStatic                                        isrt.obl(SDINT.obs)
-390  SdShowInfoList                                     isrt.obl(SDSINFOL.obs)
-391  SdStartCopy                                        isrt.obl(SDSCOPY.obs)
-392  SdUnInit                                           isrt.obl(SDINT.obs)
-393  SdVerifyFolder                                     isrt.obl(SDINT.obs)
-394  SdWelcome                                          isrt.obl(SDWEL.obs)
-395  SdWelcomeMaint                                     isrt.obl(SdWelcomeMaint.obs)
-396  SelectDir                                          isrt.obl(SelectDir.obs)
-397  SelectDirNoLog                                     isrt.obl(SelectDir.obs)
-398  SendMessage                                        isrt.obl(Misc.obs)
-399  SetCmdLine                                         isrt.obl(SysVars.obs)
-400  SetColor                                           isrt.obl(ui.obs)
-401  SetDialogTitle                                     isrt.obl(Dialogs.obs)
-402  SetDisplayEffect                                   isrt.obl(ui.obs)
-403  SetFileInfo                                        isrt.obl(Files.obs)
-404  SetFolderDesktop                                   isrt.obl(SysVars.obs)
-405  SetFolderPrograms                                  isrt.obl(SysVars.obs)
-406  SetFolderStartMenu                                 isrt.obl(SysVars.obs)
-407  SetFolderStartup                                   isrt.obl(SysVars.obs)
-408  SetInstallationInfo                                isrt.obl(Registry.obs)
-409  SetStatusWindow                                    isrt.obl(ui.obs)
-410  SetTitle                                           isrt.obl(ui.obs)
-411  SetupType                                          isrt.obl(SetupType.obs)
-412  ShowObjWizardPages                                 isrt.obl(Objects.obs)
-413  SilentCreateFile                                   isrt.obl(Silent.obs)
-414  SilentDoGeneralInfo                                isrt.obl(Silent.obs)
-415  SilentFailed                                       isrt.obl(Silent.obs)
-416  SilentFinish                                       isrt.obl(Silent.obs)
-417  SilentGetMode                                      isrt.obl(Silent.obs)
-418  SilentInit                                         isrt.obl(Silent.obs)
-419  SilentLogWriteData                                 isrt.obl(Silent.obs)
-420  SilentReadData                                     isrt.obl(Silent.obs)
-421  SilentSetInfo                                      isrt.obl(Silent.obs)
-422  SilentSetMode                                      isrt.obl(Silent.obs)
-423  SilentWriteData                                    isrt.obl(Silent.obs)
-424  Sprintf                                            isrt.obl(Str.obs)
-425  SprintfBox                                         isrt.obl(MsgBox.obs)
-426  StatusUpdate                                       isrt.obl(ui.obs)
-427  StrGetTokens                                       isrt.obl(Str.obs)
-428  StrLength                                          isrt.obl(Str.obs)
-429  StrRemoveLastSlash                                 isrt.obl(Str.obs)
-430  StrRemoveSpaces                                    isrt.obl(Str.obs)
-431  StrToUpper                                         isrt.obl(Str.obs)
-432  SysVarsInit                                        isrt.obl(SysVars.obs)
-433  SysVarsUnInit                                      isrt.obl(SysVars.obs)
-434  System                                             isrt.obl(Misc.obs)
-435  TreeViewCreate                                     isrt.obl(CmptView.obs)
-436  USER.EnableWindow                                  Setup.Obs
-437  USER.GetClassName                                  Setup.Obs
-438  USER.GetClientRect                                 Setup.Obs
-439  USER.GetDC                                         Setup.Obs
-440  USER.GetDlgItem                                    Setup.Obs
-441  USER.GetFocus                                      Setup.Obs
-442  USER.GetWindowLong                                 Setup.Obs
-443  USER.GetWindowRect                                 Setup.Obs
-444  USER.IsIconic                                      Setup.Obs
-445  USER.IsWindow                                      Setup.Obs
-446  USER.IsWindowVisible                               isrt.obl(AskDestPath.obs)
-447  USER.MoveWindow                                    Setup.Obs
-448  USER.ReleaseDC                                     Setup.Obs
-449  USER.SendMessageA                                  isrt.obl(AskDestPath.obs)
-450  USER.SetFocus                                      Setup.Obs
-451  USER.SetForegroundWindow                           isrt.obl(AskDestPath.obs)
-452  USER.SetWindowPos                                  Setup.Obs
-453  USER.SetWindowText                                 Setup.Obs
-454  USER.ShowWindow                                    Setup.Obs
-455  USER32.CharUpperBuffA                              isrt.obl(AskDestPath.obs)
-456  USER32.DrawText                                    isrt.obl(AskDestPath.obs)
-457  USER32.GetDesktopWindow                            isrt.obl(AskDestPath.obs)
-458  USER32.GetSystemMetrics                            isrt.obl(AskDestPath.obs)
-459  USER32.GetWindowText                               isrt.obl(AskDestPath.obs)
-460  USER32.GetWindowTextLength                         isrt.obl(AskDestPath.obs)
-461  USER32.MessageBoxA                                 isrt.obl(AskDestPath.obs)
-462  USER32.ScreenToClient                              isrt.obl(AskDestPath.obs)
-463  USER32.SendMessageA                                isrt.obl(AskDestPath.obs)
-464  USER32.SetWindowLong                               isrt.obl(AskDestPath.obs)
-465  USER32.SetWindowRgn                                isrt.obl(AskDestPath.obs)
-466  VarRestore                                         isrt.obl(SysVars.obs)
-467  VarSave                                            isrt.obl(SysVars.obs)
-468  WaitOnDialog                                       isrt.obl(CustomDlg.obs)
-469  WriteLine                                          isrt.obl(Files.obs)
-470  WriteProfString                                    isrt.obl(Profile.obs)
-471  WriteProperties                                    ifx.obl(PersistPropertyBag.obs)
-472  _HandleException                                   isrt.obl(exceptions.obs)
-473  _WinSubEnableControl                               isrt.obl(WINSUB.obs)
-474  _WinSubEnableWindow                                isrt.obl(WINSUB.obs)
-475  _WinSubGetChildWindow                              isrt.obl(WINSUB.obs)
-476  _WinSubIsWindow                                    isrt.obl(WINSUB.obs)
-477  __DefaultExitHandler                               isrt.obl(handlers.obs)
-478  __ISRTDoExit                                       isrt.obl(Misc.obs)
-479  __ISRTInit                                         isrt.obl(ISRTInit.obs)
-480  __ISRTRestoreMainLog                               isrt.obl(ISRTInit.obs)
-481  __ISRTSetComponentLog                              isrt.obl(ISRTInit.obs)
-482  __ISRTUnInit                                       isrt.obl(ISRTInit.obs)
-483  __LoadIScriptString                                isrt.obl(LoadStr.obs)
-484  program                                            Setup.Obs
-485  sfc.SRSetRestorePoint                              Setup.Obs
-
-
-***** External Variables *****
-1    BATCH_INSTALL                                      Setup.Obs
-2    CMDLINE                                            isrt.obl(DebugSymbols.obs)
-3    COMMONFILES                                        isrt.obl(DebugSymbols.obs)
-4    DISK1TARGET                                        Setup.Obs
-5    ERRORFILENAME                                      Setup.Obs
-6    Err                                                Setup.Obs
-7    FILETIME                                           isrt.obl(AskDestPath.obs)
-8    FIND_DATA                                          isrt.obl(AskDestPath.obs)
-9    FOLDER_DESKTOP                                     isrt.obl(DebugSymbols.obs)
-10   FOLDER_PROGRAMS                                    isrt.obl(DebugSymbols.obs)
-11   FOLDER_STARTMENU                                   isrt.obl(DebugSymbols.obs)
-12   FOLDER_STARTUP                                     isrt.obl(DebugSymbols.obs)
-13   FileRegistrar                                      Setup.Obs
-14   ISRES                                              isrt.obl(DebugSymbols.obs)
-15   ISUSER                                             isrt.obl(DebugSymbols.obs)
-16   ISVERSION                                          isrt.obl(DebugSymbols.obs)
-17   InetSRCDIR                                         Setup.Obs
-18   LAST_RESULT                                        Setup.Obs
-19   LogDB                                              Setup.Obs
-20   MAINTENANCE                                        isrt.obl(DebugSymbols.obs)
-21   MEDIA                                              Setup.Obs
-22   MEMORYSTATUS                                       isrt.obl(AskDestPath.obs)
-23   MODE                                               isrt.obl(DebugSymbols.obs)
-24   NOTHING                                            Setup.Obs
-25   OSINFO_PLATFORM_INFO                               Setup.Obs
-26   OSVERSIONINFO                                      isrt.obl(AskDestPath.obs)
-27   PRODUCT_GUID                                       isrt.obl(DebugSymbols.obs)
-28   PROGRAMFILES                                       isrt.obl(DebugSymbols.obs)
-29   RECT                                               isrt.obl(AskDestPath.obs)
-30   Reboot                                             Setup.Obs
-31   SELECTED_LANGUAGE                                  isrt.obl(DebugSymbols.obs)
-32   SHELL_OBJECT_FOLDER                                Setup.Obs
-33   SRCDIR                                             Setup.Obs
-34   SRCDISK                                            isrt.obl(DebugSymbols.obs)
-35   SUPPORTDIR                                         isrt.obl(DebugSymbols.obs)
-36   SYSTEMTIME                                         isrt.obl(AskDestPath.obs)
-37   SetupInfo                                          Setup.Obs
-38   StatusDlg                                          Setup.Obs
-39   TARGETDIR                                          Setup.Obs
-40   TARGETDISK                                         isrt.obl(DebugSymbols.obs)
-41   TextSub                                            Setup.Obs
-42   UNINST                                             Setup.Obs
-43   UNINSTALL_STRING                                   Setup.Obs
-44   WINDIR                                             isrt.obl(DebugSymbols.obs)
-45   WINDISK                                            isrt.obl(DebugSymbols.obs)
-46   WINSYSDIR                                          isrt.obl(DebugSymbols.obs)
-47   WINSYSDISK                                         isrt.obl(DebugSymbols.obs)
-48   _INT64                                             Setup.Obs
-49   _RESTOREINFO_                                      Setup.Obs
-50   _RESTOREPTINFO                                     Setup.Obs
-51   _SMGRSTATUS                                        Setup.Obs
-52   _SMGSTATUS_                                        Setup.Obs
-53   _WIN9X                                             Setup.Obs
-54   _WINNT                                             Setup.Obs
-55   __SYSTEMINFORMATION                                Setup.Obs
-56   __hContext                                         isrt.obl(AskYesNo.obs)
-57   __objGlobalTextSub                                 Setup.Obs
-58   __szGUID                                           isrt.obl(ISRTInit.obs)
-59   bBackButton                                        Setup.Obs
-60   bCancelButton                                      Setup.Obs
-61   bEnterDiskBeep                                     isrt.obl(AskDestPath.obs)
-62   bFinishButton                                      Setup.Obs
-63   bIFXLFNoToAll                                      Setup.Obs
-64   bIFXLFOnRebootToAll                                Setup.Obs
-65   bIFXLFYesToAll                                     Setup.Obs
-66   bIFXMD5IgnoreToAll                                 Setup.Obs
-67   bIFXRONoToAll                                      Setup.Obs
-68   bIFXROYesToAll                                     Setup.Obs
-69   bIFXSFNoToAll                                      Setup.Obs
-70   bIFXSFYesToAll                                     Setup.Obs
-71   bIfxPCHInitialized                                 Setup.Obs
-72   bIfxPCHOn                                          Setup.Obs
-73   bInstall16                                         Setup.Obs
-74   bNextButton                                        Setup.Obs
-75   bSdInit                                            Setup.Obs
-76   bViewCmptKunits                                    Setup.Obs
-77   bViewCmptUseDecimal                                Setup.Obs
-78   g_bSuppressMissingStringWarning                    isrt.obl(Enable.obs)
-79   nIFXROKey                                          ifx.obl(EventsMIO.obs)
-80   nIFXSFKey                                          ifx.obl(EventsMIO.obs)
-81   nIfxPCHType                                        Setup.Obs
-82   szAppKey                                           Setup.Obs
-83   szInstallDeinstKey                                 Setup.Obs
-84   szSdProduct                                        Setup.Obs
-85   szSdStr_NotEnoughSpace                             Setup.Obs
diff --git a/ghc/InstallShield/Script Files/setup.rul b/ghc/InstallShield/Script Files/setup.rul
deleted file mode 100644
index 28fc24aa2e..0000000000
--- a/ghc/InstallShield/Script Files/setup.rul
+++ /dev/null
@@ -1,950 +0,0 @@
-////////////////////////////////////////////////////////////////////////////////
-//
-//  IIIIIII SSSSSS
-//    II    SS                          InstallShield (R)
-//    II    SSSSSS      (c) 1996-1997, InstallShield Software Corporation
-//    II        SS      (c) 1990-1996, InstallShield Corporation
-//  IIIIIII SSSSSS                     All Rights Reserved.
-//
-//
-//  This code is generated as a starting setup template.  You should
-//  modify it to provide all necessary steps for your setup.
-//
-//
-//    File Name:  Setup.rul
-//
-//  Description:  InstallShield script
-//
-//     Comments:  This template script performs a basic setup on a
-//                Windows 95 or Windows NT 4.0 platform. With minor
-//                modifications, this template can be adapted to create
-//                new, customized setups.
-//
-////////////////////////////////////////////////////////////////////////////////
-
-
-  // Include header file
-#include "ifx.h"
-
-////////////////////// string defines ////////////////////////////
-
-#define UNINST_LOGFILE_NAME      "Uninst.isu"
-
-//////////////////// installation declarations ///////////////////
-
-  // ----- DLL prototypes -----
-
-
-     // your DLL prototypes
-
-
-  // ---- script prototypes -----
-
-     // generated
-     prototype ShowDialogs();
-     prototype MoveFileData();
-     prototype HandleMoveDataError( NUMBER );
-     prototype ProcessBeforeDataMove();
-     prototype ProcessAfterDataMove();
-     prototype SetupRegistry();
-     prototype SetupFolders();
-     prototype CleanUpInstall();
-     prototype SetupInstall();
-     prototype SetupScreen();
-     prototype CheckListScreen();
-     prototype CheckRequirements();
-     prototype DialogShowSdWelcome();
-     prototype DialogShowSdShowInfoList();
-     prototype DialogShowSdAskDestPath();
-     prototype DialogShowSdSetupType();
-     prototype DialogShowSdComponentDialog2();
-     prototype DialogShowSdSelectFolder();
-     prototype DialogShowSdFinishReboot();
-
-     // your prototypes
-     prototype MyParsePath ( STRING );
-     prototype ForwardSlashify ( STRING, BYREF STRING );
-     prototype CreateExecPerlScript ( STRING, STRING );
-     prototype DropSuffix ( STRING, BYREF STRING );
-     prototype BaseName   ( STRING, BYREF STRING );
-
-  // ----- global variables ------
-
-     // generated
-     BOOL        bWinNT, bIsShellExplorer, bInstallAborted, bIs32BitSetup;
-     STRING      svDir;
-     STRING      svName, svCompany, svSerial;
-     STRING      szAppPath;
-     STRING      svSetupType;
-     LIST        listPath;
-
-
-     // your global variables
-     //STRING      szRawCpp
-     STRING      szPerlPath;
-     STRING      szBinDir, szBinDirUnslashed,
-                 szLibDir, szLibDirUnslashed,
-                 szDataDir, szLibExecDir;
-
-
-///////////////////////////////////////////////////////////////////////////////
-//
-//   MAIN PROGRAM
-//
-//      The setup begins here by hiding the visible setup
-//      window.  This is done to allow all the titles, images, etc. to
-//      be established before showing the main window.  The following
-//      logic then performs the setup in a series of steps.
-//
-///////////////////////////////////////////////////////////////////////////////
-program
-    Disable( BACKGROUND );
-
-    CheckRequirements();
-
-    SetupInstall();
-
-    SetupScreen();
-
-    if (ShowDialogs()<0) goto end_install;
-
-    if (ProcessBeforeDataMove()<0) goto end_install;
-
-    if (MoveFileData()<0) goto end_install;
-
-    if (ProcessAfterDataMove()<0) goto end_install;
-
-    if (SetupRegistry()<0) goto end_install;
-
-    if (SetupFolders()<0) goto end_install;
-
-    CheckListScreen();
-    
-  end_install:
-
-    CleanUpInstall();
-
-     // If an unrecoverable error occurred, clean up the partial installation.
-     // Otherwise, exit normally.
-
-    if (bInstallAborted) then
-        abort;
-    endif;
-
-endprogram
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function:  ShowDialogs                                                    //
-//                                                                           //
-//  Purpose:  This function manages the display and navigation               //
-//            the standard dialogs that exist in a setup.                    //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function ShowDialogs()
-    NUMBER  nResult;
- begin
-
-    Dlg_Start:
-        // beginning of dialogs label
-
-    Dlg_SdWelcome:
-        nResult = DialogShowSdWelcome();
-        if (nResult = BACK) goto Dlg_Start;
-
-    Dlg_SdShowInfoList:
-        nResult = DialogShowSdShowInfoList();
-        if (nResult = BACK) goto Dlg_SdWelcome;
-
-    Dlg_SdAskDestPath:
-        nResult = DialogShowSdAskDestPath();
-        if (nResult = BACK) goto Dlg_SdShowInfoList;
-
-    Dlg_SdSetupType:
-        nResult = DialogShowSdSetupType();
-        if (nResult = BACK) goto Dlg_SdAskDestPath;
-
-    Dlg_SdComponentDialog2:
-        if ((nResult = BACK) && (svSetupType != "Custom") && (svSetupType != "")) then
-           goto Dlg_SdSetupType;
-        endif;
-        nResult = DialogShowSdComponentDialog2();
-        if (nResult = BACK) goto Dlg_SdSetupType;
-
-    Dlg_SdSelectFolder:
-        //nResult = DialogShowSdSelectFolder();
-        //if (nResult = BACK) goto Dlg_SdComponentDialog2;
-
-    return 0;
-
- end;
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: ProcessBeforeDataMove                                           //
-//                                                                           //
-//  Purpose: This function performs any necessary operations prior to the    //
-//           actual data move operation.                                     //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function ProcessBeforeDataMove()
-    STRING svLogFile;
-    NUMBER nResult;
- begin
-
-  InstallationInfo( @COMPANY_NAME, @PRODUCT_NAME, @PRODUCT_VERSION, @PRODUCT_KEY );
-
-  svLogFile = UNINST_LOGFILE_NAME;
-
-  nResult = DeinstallStart( svDir, svLogFile, @UNINST_KEY, 0 );
-  if (nResult < 0) then
-      MessageBox( @ERROR_UNINSTSETUP, WARNING );
-  endif;
-
-  szAppPath = TARGETDIR; // TODO : if your application .exe is in a subdir of TARGETDIR then add subdir
-
-  if ((bIs32BitSetup) && (bIsShellExplorer)) then
-      RegDBSetItem( REGDB_APPPATH, szAppPath );
-      RegDBSetItem( REGDB_APPPATH_DEFAULT, szAppPath ^ @PRODUCT_KEY );
-      RegDBSetItem( REGDB_UNINSTALL_NAME, @UNINST_DISPLAY_NAME );
-  endif;
-  // TODO : update any items you want to process before moving the data
-  //
-
-  ComponentSetTarget( MEDIA, "<DOCDIR>", TARGETDIR ^ "\\doc" );
-
-  return 0;
- end;
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function:  MoveFileData                                                   //
-//                                                                           //
-//  Purpose:  This function handles the data movement for                    //
-//            the setup.                                                     //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function MoveFileData()
-    NUMBER nResult, nDisk;
- begin
-
-  nDisk = 1;
-  SetStatusWindow( 0, "" );
-  Disable( DIALOGCACHE );
-  Enable( STATUS );
-  StatusUpdate( ON, 100 );
-  nResult = ComponentMoveData( MEDIA, nDisk, 0 );
-
-  HandleMoveDataError( nResult );
-
-  Disable( STATUS );
-
-  return nResult;
-
- end;
-
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: HandleMoveDataError                                             //
-//                                                                           //
-//  Purpose: This function handles the error (if any) during the move data   //
-//           operation.                                                      //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function HandleMoveDataError( nResult )
-    STRING szErrMsg, svComponent , svFileGroup , svFile;
- begin
-
-  svComponent = "";
-  svFileGroup = "";
-  svFile = "";
-
-  switch (nResult)
-  case 0:
-       return 0;
-  default:
-       ComponentError ( MEDIA , svComponent , svFileGroup , svFile , nResult );
-       szErrMsg = @ERROR_MOVEDATA  + "\n\n" +
-                  @ERROR_COMPONENT + " " + svComponent + "\n" +
-                  @ERROR_FILEGROUP + " " + svFileGroup + "\n" +
-                  @ERROR_FILE      + " " + svFile;
-       SprintfBox( SEVERE, @TITLE_CAPTIONBAR, szErrMsg, nResult );
-       bInstallAborted = TRUE;
-       return nResult;
-  endswitch;
-
- end;
-
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: ProcessAfterDataMove                                            //
-//                                                                           //
-//  Purpose: This function performs any necessary operations needed after    //
-//           all data has been moved.                                        //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function ProcessAfterDataMove()
-  STRING szPath, szGcc, szGccDir;
-  STRING szTemp, szRes, szPathEntry, szDrive;
-  NUMBER nvSize,nvType, nResult, nPos, nSuccess;
-  LIST   listDirs;
- begin
-
-  RegDBSetDefaultRoot ( HKEY_LOCAL_MACHINE );
-  RegDBGetKeyValueEx ( "SYSTEM\\CurrentControlSet\\Control\\Session Manager\\Environment" ,
-                       "path" , nvType, szPath , nvSize );
-
-  // Spin through path looking for perl.exe.
-  // Our task is made considerably harder since the
-  // the free version of InstallShield doesn't support
-  // functions such as StrGetTokens() or ParsePath().
-  // TODO: Convert this back to IS Prof Edn
-
-  MyParsePath ( szPath );
-  nResult = ListGetFirstString ( listPath, szPathEntry);
-  szPathEntry = ""; szPerlPath="";
-  while ( nResult != END_OF_LIST )
-     if ( FindFile (szPathEntry, "perl.exe", szRes ) = 0 ) then
-       szPerlPath = szPathEntry + "/" + szRes;
-       nResult = END_OF_LIST;
-     else
-       nResult = ListGetNextString ( listPath, szPathEntry );
-     endif;
-  endwhile;
-  if ( StrCompare ( szPerlPath, "" ) = 0 ) then
-    // If not found in global env. block, look in the
-    // user-specific part.
-    RegDBSetDefaultRoot ( HKEY_CURRENT_USER );
-    RegDBGetKeyValueEx ( "Environment", "path", nvType, szPath, nvSize);
-    MyParsePath ( szPath );
-    nResult = ListGetFirstString ( listPath, szPathEntry);
-    szPathEntry = ""; szPerlPath="";
-    while ( nResult != END_OF_LIST )
-      if ( FindFile (szPathEntry, "perl.exe", szRes ) = 0 ) then
-        szPerlPath = szPathEntry + "/" + szRes;
-        nResult = END_OF_LIST;
-      else
-        nResult = ListGetNextString ( listPath, szPathEntry );
-      endif;
-    endwhile;
-  endif;
-
-  if ( StrCompare ( szPerlPath, "" ) = 0 ) then
-     // Default it to /bin/perl
-     MessageBox ("Unable to find perl in your PATH. Not to worry, this installer includes a version that should be useable." +
-                 "When the installer has finished, please copy it from the bin/ directory of the ghc installation to /bin/perl",
-                 INFORMATION);
-     szPerlPath = "/bin/perl.exe";
-  else
-     // strip initial drive spec.
-     GetDir ( szPerlPath, szTemp);
-     ForwardSlashify ( szTemp, szPerlPath );
-  endif;
-  DropSuffix (szPerlPath, szTemp);
-  szPerlPath = szTemp;
-
-  ListDestroy (listPath);
-
-  return 0;
- end;
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: SetupRegistry                                                   //
-//                                                                           //
-//  Purpose: This function makes the registry entries for this setup.        //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function SetupRegistry()
- NUMBER nResult,nWays,i;
- STRING szProjectDir, szProjectVersionDir, szTargetDir;
- STRING szSyslib, szWay, szSyslibsDir;
- STRING szLib, szSyslibsKey;
- //LIST   syslib_list, way_list;
- begin
-
-  // TODO : Add all your registry entry keys here
-  //
-  //
-
-  nResult = CreateRegistrySet( "" );
-
-  // By now, we will have had the following Registry
-  // entries generated (see ProcessBeforeDataMove() ):
-  //
-  // HK_L_M\Software\Glasgow University\GHC\<version no.>
-  //
-  // For GHC, we store and use the install info inside
-  //  HK_L_M\Software\Haskell\GHC (== %ROOT%)
-
-  // So, we perform the following tasks here:
-  //
-  //  * Checks to see if %ROOT% is defined.
-  //    If not, creates it.
-  //  * Checks for %ROOT%\Version is defined.
-  //  * Create %ROOT%\<version>.
-  //  * Create %ROOT%\<version>\libdir
-  //    (This key will be given a value later.)
-  //  * Create %ROOT%\syslib\  and fill it in
-  //    with the syslibs that has been installed.
-  //  * %ROOT%\syslib\name\<way>
-  //    is added for each kind (e.g., seq, conc)
-  //    syslib we're installing.
-
-  // When we eventually reach the end, the registry
-  // should be ready for use by the installed app.
-
-  // Check to see if we've already installed
-  // a version of GHC on this box..
-  RegDBSetDefaultRoot ( HKEY_LOCAL_MACHINE );
-
-  szProjectDir = @HASKELL_REG_ROOT ^ @PRODUCT_NAME;
-
-  // check whether we've already got the Registry sub-tree we're
-  // about to add to. If not, then we create it
-  // level-by-level, so as to ensure that the uninstaller
-  // can clean up after us.
-  if ( RegDBKeyExist ( @HASKELL_REG_ROOT ) < 0) then
-     RegDBCreateKeyEx (@HASKELL_REG_ROOT, "");
-  endif;
-  if ( RegDBKeyExist  ( szProjectDir ) < 0 ) then
-     RegDBCreateKeyEx ( szProjectDir, "");
-  endif;
-
-  // Note: we overwrite any existing value.
-  RegDBSetKeyValueEx( szProjectDir, "Version", REGDB_STRING,
-                       @PRODUCT_KEY, -1);
-
-  szProjectVersionDir = szProjectDir ^ @PRODUCT_KEY;
-
-  if ( RegDBKeyExist ( szProjectVersionDir ) < 0) then
-     RegDBCreateKeyEx ( szProjectVersionDir, "");
-  endif;
-
-  // Here starts the GHC specific part
-
-  ForwardSlashify (TARGETDIR, szTargetDir);
-  // fill in the all-important path to where the archives
-  // and interface files have been parked.
-  szLibDir = szTargetDir + "/lib";
-  szLibDirUnslashed = TARGETDIR ^ "\\lib";
-  RegDBSetKeyValueEx ( szProjectVersionDir, "libdir", REGDB_STRING,
-                       szLibDir , -1);
-  // libexecdir
-  szLibExecDir = szTargetDir + "/lib";
-  RegDBSetKeyValueEx ( szProjectVersionDir, "libexecdir", REGDB_STRING,
-                       szLibExecDir , -1);
-  // bindir
-  szBinDir = szTargetDir + "/bin";
-  szBinDirUnslashed = TARGETDIR ^ "\\bin";
-  RegDBSetKeyValueEx ( szProjectVersionDir, "bindir", REGDB_STRING,
-                       szBinDir , -1);
-  
-  return 0;
- end;
-
-
-///////////////////////////////////////////////////////////////////////////////
-//
-// Function: SetupFolders
-//
-//  Purpose: This function creates all the folders and shortcuts for the
-//           setup.  This includes program groups and items for Windows 3.1.
-//
-///////////////////////////////////////////////////////////////////////////////
-function SetupFolders()
- NUMBER nResult;
- begin
-
-
-  // TODO : Add all your folder (program group) along with shortcuts (program items)
-  //
-  //
-  //    CreateProgramFolder, AddFolderIcon....
-  //
-
-  CreateExecPerlScript ( szBinDirUnslashed, "ghc-" + @PRODUCT_VERSION );
-  CreateExecPerlScript ( szBinDirUnslashed, "stat2resid" );
-  CreateExecPerlScript ( szLibDirUnslashed, "hscpp" );
-  CreateExecPerlScript ( szLibDirUnslashed, "mkdependHS" );
-
-  VarSave (SRCTARGETDIR);
-  SRCDIR = szBinDirUnslashed;
-  TARGETDIR = szBinDirUnslashed;
-  CopyFile( "ghc-" + @PRODUCT_VERSION, "ghc");
-  VarRestore (SRCTARGETDIR);
-
-  nResult = CreateShellObjects( "" );
-
-  return nResult;
- end;
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: CleanUpInstall                                                  //
-//                                                                           //
-//  Purpose: This cleans up the setup.  Anything that should                 //
-//           be released or deleted at the end of the setup should           //
-//           be done here.                                                   //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function CleanUpInstall()
- begin
-
-
-  if (bInstallAborted) then
-      return 0;
-  endif;
-
-  DialogShowSdFinishReboot();
-
-  if (BATCH_INSTALL) then // ensure locked files are properly written
-      CommitSharedFiles(0);
-  endif;
-
-  return 0;
- end;
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: SetupInstall                                                    //
-//                                                                           //
-//  Purpose: This will setup the installation.  Any general initialization   //
-//           needed for the installation should be performed here.           //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function SetupInstall()
-
- begin
-
-  Enable( CORECOMPONENTHANDLING );
-
-  bInstallAborted = FALSE;
-
-  GetDisk(WINDIR, svDir);
-
-  if (bIs32BitSetup) then
-      svDir = svDir + "\\" ^ @PRODUCT_NAME_SHORT ^ @PRODUCT_KEY;
-  else
-      // We're (=>ghc) 32 through and through, but for the sake of
-      // completenes.
-      svDir = svDir + "\\" ^ @PRODUCT_NAME_SHORT ^ @PRODUCT_NAME16;
-  endif;
-
-  TARGETDIR  = svDir;
-
-  SdProductName( @PRODUCT_NAME );
-
-  Enable( DIALOGCACHE );
-
-  return 0;
- end;
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function:  SetupScreen                                                    //
-//                                                                           //
-//  Purpose:  This function establishes  the screen look.  This includes     //
-//            colors, fonts, and text to be displayed.                       //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function SetupScreen()
- begin
-
-  SetColor ( BACKGROUND, BLUE );
-  Enable( FULLWINDOWMODE );
-  Enable( INDVFILESTATUS );
-
-  SetTitle( @TITLE_MAIN, 24, WHITE );
-
-  SetTitle( @TITLE_CAPTIONBAR, 0, BACKGROUNDCAPTION ); // Caption bar text.
-
-  Enable( BACKGROUND );
-
-  Delay( 1 );
- end;
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function:  CheckRequirements                                              //
-//                                                                           //
-//  Purpose:  This function checks all minimum requirements for the          //
-//            application being installed.  If any fail, then the user       //
-//            is informed and the setup is terminated.                       //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function CheckRequirements()
-    NUMBER  nvDx, nvDy, nvResult;
-    STRING  svResult;
-
- begin
-
-  bWinNT           = FALSE;
-  bIsShellExplorer = FALSE;
-
-  // Check screen resolution.
-  GetExtents( nvDx, nvDy );
-
-  if (nvDy < 480) then
-      MessageBox( @ERROR_VGARESOLUTION, WARNING );
-      abort;
-  endif;
-
-  // set 'setup' operation mode
-  bIs32BitSetup = TRUE;
-  GetSystemInfo( ISTYPE, nvResult, svResult );
-  if (nvResult = 16) then
-      bIs32BitSetup = FALSE; // running 16-bit setup
-      return 0; // no additional information required
-  endif;
-
-  // --- 32-bit testing after this point ---
-
-  // Determine the target system's operating system.
-  GetSystemInfo( OS, nvResult, svResult );
-
-  if (nvResult =  IS_WINDOWSNT) then
-      // Running Windows NT.
-      bWinNT = TRUE;
-
-      // Check to see if the shell being used is EXPLORER shell.
-      if (GetSystemInfo( OSMAJOR, nvResult, svResult ) = 0) then
-          if (nvResult >= 4) then
-              bIsShellExplorer = TRUE;
-          endif;
-      endif;
-
-  elseif (nvResult = IS_WINDOWS95 ) then
-      bIsShellExplorer = TRUE;
-
-  endif;
-
-end;
-
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: DialogShowSdWelcome                                             //
-//                                                                           //
-//  Purpose: This function handles the standard welcome dialog.              //
-//                                                                           //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function DialogShowSdWelcome()
-    NUMBER nResult;
-    STRING szTitle, szMsg;
- begin
-
-  szTitle = "";
-  szMsg   = "";
-  nResult = SdWelcome( szTitle, szMsg );
-
-  return nResult;
- end;
-                         
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: DialogShowSdShowInfoList                                        //
-//                                                                           //
-//  Purpose: This function displays the general information list dialog.     //
-//                                                                           //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function DialogShowSdShowInfoList()
-    NUMBER nResult;
-    LIST   list;
-    STRING szTitle, szMsg, szFile;
- begin
-
-  szFile = SUPPORTDIR ^ "announce";
-
-  list = ListCreate( STRINGLIST );
-  ListReadFromFile( list, szFile );
-  szTitle  = "";
-  szMsg    = " ";
-  nResult  = SdShowInfoList( szTitle, szMsg, list );
-
-  ListDestroy( list );
-
-  return nResult;
- end;
-
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: DialogShowSdAskDestPath                                         //
-//                                                                           //
-//  Purpose: This function asks the user for the destination directory.      //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function DialogShowSdAskDestPath()
-    NUMBER nResult;
-    STRING szTitle, szMsg;
- begin
-
-  szTitle = "";
-  szMsg   = "WARNING! The path must not contain spaces.";
-  nResult = SdAskDestPath( szTitle, szMsg, svDir, 0 );
-
-  TARGETDIR = svDir;
-
-  return nResult;
- end;
-
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: DialogShowSdSetupType                                           //
-//                                                                           //
-//  Purpose: This function displays the standard setup type dialog.          //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function DialogShowSdSetupType()
-    NUMBER nResult, nType;
-    STRING szTitle, szMsg;
- begin
-
-  switch (svSetupType)
-  case "Typical":
-       nType = TYPICAL;
-  case "Custom":
-       nType = CUSTOM;
-  case "Compact":
-       nType = COMPACT;
-  case "":
-       svSetupType = "Typical";
-       nType = TYPICAL;
-  endswitch;
-
-  szTitle = "";
-  szMsg   = "";
-  nResult = SetupType( szTitle, szMsg, "", nType, 0 );
-
-  switch (nResult)
-  case COMPACT:
-       svSetupType = "Compact";
-  case TYPICAL:
-       svSetupType = "Typical";
-  case CUSTOM:
-       svSetupType = "Custom";
-  endswitch;
-
-  return nResult;
- end;
-
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: DialogShowSdComponentDialog2                                    //
-//                                                                           //
-//  Purpose: This function displays the custom component dialog.             //
-//                                                                           //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function DialogShowSdComponentDialog2()
-    NUMBER nResult;
-    STRING szTitle, szMsg;
- begin
-
-  if ((svSetupType != "Custom") && (svSetupType != "")) then
-      return 0;
-  endif;
-
-  szTitle  = "";
-  szMsg    = "";
-  nResult  = SdComponentDialog2( szTitle, szMsg, svDir, "" );
-
-  return nResult;
- end;
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: CheckListScreen                                                 //
-//                                                                           //
-//  Purpose: Show a check-list of post-install user actions.                 //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function CheckListScreen()   
-	BOOL bDone;
-	NUMBER nCmdValue;
- begin   
- 	EzDefineDialog("CHECKLIST", "", "", 30001);
-
-    bDone = FALSE;   
-    while (bDone=FALSE)   
-       nCmdValue = WaitOnDialog("CHECKLIST");   
-          switch (nCmdValue)      
-              case DLG_INIT:               
-              // Process the Next button.         
-              case SD_PBUT_CONTINUE:         
-                  bDone = TRUE;           
-              // Process the Cancel button.         
-              case SD_PBUT_EXITSETUP:
-                  bDone = TRUE;            
-              // Process the close dialog box button.
-              case DLG_CLOSE:         
-                  bDone = TRUE;         
-              // Process dialog box errors.            
-              case DLG_ERR:
-                  MessageBox("Internal dialog box error", SEVERE);         
-                  bDone = TRUE;         
-          endswitch;            
-    endwhile;           
-    // Identify the end of dialog box processing.  
-    EndDialog("CHECKLIST");   
-    // Free the dialog box and list from memory.
-    ReleaseDialog("CHECKLIST");   
- end;                    
-
-///////////////////////////////////////////////////////////////////////////////
-//                                                                           //
-// Function: DialogShowSdFinishReboot                                        //
-//                                                                           //
-//  Purpose: This function will show the last dialog of the product.         //
-//           It will allow the user to reboot and/or show some readme text.  //
-//                                                                           //
-///////////////////////////////////////////////////////////////////////////////
-function DialogShowSdFinishReboot()
-    NUMBER nResult, nDefOptions;
-    STRING szTitle, szMsg1, szMsg2, szOption1, szOption2;
-    NUMBER bOpt1, bOpt2;
- begin
-
-  if (!BATCH_INSTALL) then
-      bOpt1 = FALSE;
-      bOpt2 = FALSE;
-      szMsg1 = "";
-      szMsg2 = "";
-      szOption1 = "";
-      szOption2 = "";
-      szTitle = "Installation is now complete.";
-      nResult = SdFinish( szTitle, szMsg1, szMsg2, szOption1, szOption2, bOpt1, bOpt2 );
-      return 0;
-  else
-      nDefOptions = SYS_BOOTMACHINE;
-      szTitle     = "";
-      szMsg1      = "";
-      szMsg2      = "";
-      nResult     = SdFinishReboot( szTitle, szMsg1, nDefOptions, szMsg2, 0 );
-      return nResult;
-  endif;
- end;
-
-function MyParsePath(szPath)
-  STRING szTmp,szPth;
-  NUMBER nPos;
- begin
-   szPth = szPath;
-   listPath = ListCreate( STRINGLIST );
-
-   // Man, all I want is map. Please? :-)
-   nPos = StrFind ( szPth, ";");
-   while ( nPos > 0 )
-    StrSub ( szTmp, szPth, 0, nPos);
-    ListAddString ( listPath, szTmp, AFTER );
-    StrSub ( szTmp, szPth, nPos + 1, StrLength ( szPth) - nPos );
-    szPth = szTmp;
-    nPos = StrFind ( szPth, ";" );
-   endwhile;
-
-  return 0;
- end;
-
- function ForwardSlashify ( szStr , theRes )
-   NUMBER nPos;
-   STRING szTemp, szRes;
- begin
-  // Tortuous piece of code to convert backslashes into
-  // forward ones.
-  nPos = StrFind ( szStr, "\\");
-  szRes="";
-  while ( nPos >= 0 )
-    StrSub ( szTemp, szStr, 0, nPos);
-    szRes = szRes + szTemp + "/";
-    StrSub ( szTemp, szStr, nPos + 1, StrLength ( szStr) - nPos );
-    szStr = szTemp;
-    nPos = StrFind ( szStr, "\\" );
-  endwhile;
-  StrSub ( szTemp, szStr, 0, StrLength (szStr));
-  szRes = szRes + szTemp;
-  theRes = szRes;
-  return 0;
- end;
-
- function CreateExecPerlScript ( szPath, szFileName )
-    NUMBER nResult, writeHandle, readHandle;
-    STRING szLine;
- begin
-   VarSave (SRCTARGETDIR);
-   SRCDIR = szPath;
-   TARGETDIR = szPath;
-   DeleteFile ( szFileName + ".bak");
-   RenameFile ( szFileName, szFileName + ".bak");
-   VarRestore (SRCTARGETDIR);
-
-   OpenFileMode (FILE_MODE_APPEND);
-   if ( CreateFile ( writeHandle, szPath, szFileName ) < 0 ) then
-      MessageBox ("CreateFile " + szPath ^ szFileName + " failed", INFORMATION);
-   endif;
-   // append
-   WriteLine (writeHandle, "#!" + szPerlPath );
-   WriteLine (writeHandle, "$libdir='" + szLibDir + "';");
-   WriteLine (writeHandle, "$bindir='" + szBinDir + "';");
-   WriteLine (writeHandle, "$libexecdir='" + szLibExecDir + "';");
-   WriteLine (writeHandle, "$datadir='" + szDataDir + "';");
-   WriteLine (writeHandle, "$SED='sed';");
-   WriteLine (writeHandle, "$TMPDIR='C:/TEMP';");
-   WriteLine (writeHandle, "$RAWCPP='gcc -E';");
-   // For the benefit of mkdependHS, which doesn't get this prepended
-   WriteLine (writeHandle, "$INSTALLING=1;");
-
-   OpenFileMode (FILE_MODE_NORMAL);
-   if ( OpenFile ( readHandle, szPath, szFileName + ".bak") < 0 ) then
-      MessageBox ("OpenFile " + szPath ^ szFileName + ".bak failed", INFORMATION);
-   endif;
-
-   // copy the template over.
-   nResult = GetLine ( readHandle, szLine);
-   while ( nResult >= 0 )
-     WriteLine ( writeHandle, szLine);
-     nResult = GetLine ( readHandle, szLine);
-   endwhile;
-   if ( CloseFile( readHandle ) < 0 ) then
-       MessageBox ( "CloseFile " + szPath ^ szFileName + ".bak failed",
-                    INFORMATION);
-   endif;
-   if ( CloseFile( writeHandle ) < 0 ) then
-       MessageBox ( "CloseFile " + szPath ^ szFileName + " failed",
-                    INFORMATION);
-   endif;
-   // There's no way to set the 'x' bit using
-   // SetFileInfo(), but luckily it is not needed to run #! scripts
-   // under cygwin.
-   SetFileInfo ( szPath ^ szFileName, FILE_ATTRIBUTE, FILE_ATTR_NORMAL, "");     
-   // Delete the .bak file
-   DeleteFile ( szPath ^ szFileName + ".bak");
-   
-   return 0;
- end;
-
- function DropSuffix ( szInp, szOut )
-   NUMBER nResult, nLen;
-   STRING szTemp, szTemp2;
- begin
-    nLen = 0;
-    szTemp2 = szInp;
-    nResult = StrFind ( szTemp2 , ".");
-    while ( nResult >= 0 )
-       nLen = nLen + nResult;
-       StrSub ( szTemp, szTemp2, nResult + 1, StrLength ( szTemp2) - nResult );
-       szTemp2 = szTemp;
-       nResult = StrFind ( szTemp2, "." );
-       if ( nResult >= 0 ) then
-          nLen = nLen + 1;  // incl the previous . if there's more.
-       endif;
-    endwhile;
-    StrSub ( szOut, szInp, 0, nLen);
-    return 0;
- end;
\ No newline at end of file
diff --git a/ghc/InstallShield/Setup Files/Compressed Files/Language Independent/OS Independent/ANNOUNCE b/ghc/InstallShield/Setup Files/Compressed Files/Language Independent/OS Independent/ANNOUNCE
deleted file mode 100644
index 87417db348..0000000000
--- a/ghc/InstallShield/Setup Files/Compressed Files/Language Independent/OS Independent/ANNOUNCE
+++ /dev/null
@@ -1,116 +0,0 @@
-	     The Glasgow Haskell Compiler -- version 4.08
-	    ==============================================
-
-We are pleased to announce a new release of the Glasgow Haskell
-Compiler (GHC), version 4.08.  The source distribution is freely
-available via the World-Wide Web and through anon. FTP; details below.
-
-Haskell is "the" standard lazy functional programming language; the
-current language version is Haskell 98, agreed in December 1998.
-Haskell related information is available from the Haskell home page at
-
-	http://www.haskell.org/
-
-GHC's Web page lives at
-
-	http://www.haskell.org/ghc/
-
-+ What's new
-=============
-
-This should be a stable release.  There have been many enhancements
-since 4.06, and shed-loads of bug-fixes (one shed (imperial) ~ one ton
-(US)).
-
-There are the following changes
-
-   - New profiling subsystem, based on cost-centre stacks.
-
-   - Working x86 native code generator: now it works properly, runs
-     about twice as fast as compiling via C, and is on a par for
-     run-time speed (except in FP-intensive programs).
-
-   - Implicit parameters (i.e. dynamic scoping without the pain).
-
-   - DEPRECATED pragma for marking obsolescent interfaces.
-
-   - In the wake of hslibs, a new package system for
-     libraries. -package should now be used instead of -syslib.
-
-   - Result type signatures work.
-
-   - Many tiresome long-standing bugs and problems (e.g. the trace
-     problem) have been fixed.
-
-   - Many error messages have been made more helpful and/or
-     accurate.
-
-For full details see the release notes:
-
-	http://www.haskell.org/ghc/docs/4.08/users_guide/release-4-08.html
-
-
-+ Mailing lists
-================
-
-We run mailing lists for GHC users and bug reports; to subscribe, send
-mail to majordomo@haskell.org; the msg body should be:
-
-    subscribe glasgow-haskell-{users,bugs} Your Name <you@where.soever>
-
-or
-
-    subscribe cvs-ghc Your Name <you@where.soever>
-
-Please send bug reports about GHC to glasgow-haskell-bugs@haskell.org;
-GHC users hang out on glasgow-haskell-users@haskell.org.  Bleeding
-edge CVS users party on cvs-ghc@haskell.org.
-
-
-+ On-line GHC-related resources
-================================
-
-Relevant URLs on the World-Wide Web:
-
-GHC home page    	  http://www.haskell.org/ghc/
-Haskell home page	  http://www.haskell.org/
-comp.lang.functional FAQ  http://www.cs.nott.ac.uk/~gmh/faq.html
-
-
-+ How to get it
-================
-
-The easy way is to go to the WWW page, which should be
-self-explanatory:
-
-	http://www.haskell.org/ghc/
-
-Once you have the distribution, please follow the pointers in the
-README file to find all of the documentation about this release.  NB:
-preserve modification times when un-tarring the files (no `m' option
-for tar, please)!
-
-
-+ System requirements
-======================
-
-To compile the sources, you need a machine with 32+MB memory, GNU C
-(`gcc'), `perl' plus a version of GHC installed (3.02 at least).  This
-release is known to work on the following platforms:
-
-  * i386-unknown-{linux,freebsd,netbsd,cygwin32,mingw32}
-  * sparc-sun-{sunos4,solaris2}
-  * hppa1.1-hp-hpux{9,10}
-
-Ports to the following platforms should be relatively easy (for a
-wunderhacker), but haven't been tested due to lack of time/hardware:
-
-  * i386-unknown-solaris2
-  * alpha-dec-osf{2,3}
-  * mips-sgi-irix{5,6}
-  * {rs6000,powerpc}-ibm-aix
-
-The builder's guide included in distribution gives a complete
-run-down of what ports work; an on-line version can be found at
-
-   http://www.haskell.org/ghc/docs/4.08/building/building-guide.html
diff --git a/ghc/InstallShield/Setup Files/Compressed Files/Language Independent/OS Independent/_IsUser.dll b/ghc/InstallShield/Setup Files/Compressed Files/Language Independent/OS Independent/_IsUser.dll
deleted file mode 100644
index 836275022b..0000000000
--- a/ghc/InstallShield/Setup Files/Compressed Files/Language Independent/OS Independent/_IsUser.dll
+++ /dev/null
diff --git a/ghc/InstallShield/Setup Files/Uncompressed Files/Language Independent/OS Independent/setup.bmp b/ghc/InstallShield/Setup Files/Uncompressed Files/Language Independent/OS Independent/setup.bmp
deleted file mode 100644
index 82459b0a38..0000000000
--- a/ghc/InstallShield/Setup Files/Uncompressed Files/Language Independent/OS Independent/setup.bmp
+++ /dev/null
diff --git a/ghc/InstallShield/Shell Objects/Default.shl b/ghc/InstallShield/Shell Objects/Default.shl
deleted file mode 100644
index 8ba3176785..0000000000
--- a/ghc/InstallShield/Shell Objects/Default.shl
+++ /dev/null
@@ -1,12 +0,0 @@
-[Data]
-Folder3=<FOLDER_STARTUP>
-Group0=Main
-Group1=Startup
-Folder0=<FOLDER_DESKTOP>
-Folder1=<FOLDER_STARTMENU>
-Folder2=<FOLDER_PROGRAMS>
-
-[Info]
-Type=ShellObject
-Version=2.10.000
-
diff --git a/ghc/InstallShield/String Tables/0009-English/value.shl b/ghc/InstallShield/String Tables/0009-English/value.shl
deleted file mode 100644
index 17ffc5217b..0000000000
--- a/ghc/InstallShield/String Tables/0009-English/value.shl
+++ /dev/null
@@ -1,28 +0,0 @@
-[Data]
-TITLE_MAIN=Glasgow Haskell Compiler - version 4.08.1 (September '00)
-HASKELL_REG_ROOT=Software\\Haskell
-GHC_SYSLIBS_WAYS=seq
-COMPANY_NAME=University of Glasgow
-ERROR_COMPONENT=Component:
-COMPANY_NAME16=University of Glasgow
-GHC_SYSLIBS=std lang data num util text net greencard win32
-PRODUCT_VERSION=4.08.1
-ERROR_MOVEDATA=An error occurred during the move data process: %d
-ERROR_FILEGROUP=File Group:
-PRODUCT_NAME_SHORT=ghc
-UNINST_KEY=Glasgow Haskell Compiler
-TITLE_CAPTIONBAR=Glasgow Haskell Compiler Setup
-PRODUCT_NAME16=Glasgow Haskell Compiler
-ERROR_VGARESOLUTION=This program requires VGA or better resolution.
-ERROR_FILE=File:
-FOLDER_NAME=GHC
-UNINST_DISPLAY_NAME=Glasgow Haskell Compiler - version 4.08.1 (September '00)
-PRODUCT_KEY=ghc-4.08.1
-PRODUCT_NAME=Glasgow Haskell Compiler
-ERROR_UNINSTSETUP=unInstaller setup failed to initialize.  You may not be able to uninstall this product.
-
-[General]
-Language=0009
-Type=STRINGTABLESPECIFIC
-Version=1.00.000
-
diff --git a/ghc/InstallShield/String Tables/Default.shl b/ghc/InstallShield/String Tables/Default.shl
deleted file mode 100644
index 2d5860379b..0000000000
--- a/ghc/InstallShield/String Tables/Default.shl
+++ /dev/null
@@ -1,94 +0,0 @@
-[TITLE_MAIN]
-Comment=
-
-[HASKELL_REG_ROOT]
-Comment=
-
-[GHC_SYSLIBS_WAYS]
-Comment=
-
-[COMPANY_NAME]
-Comment=
-
-[ERROR_COMPONENT]
-Comment=
-
-[COMPANY_NAME16]
-Comment=
-
-[GHC_SYSLIBS]
-Comment=
-
-[PRODUCT_VERSION]
-Comment=
-
-[ERROR_MOVEDATA]
-Comment=
-
-[ERROR_FILEGROUP]
-Comment=
-
-[PRODUCT_NAME_SHORT]
-Comment=
-
-[Language]
-Lang0=0009
-CurrentLang=0
-
-[UNINST_KEY]
-Comment=
-
-[TITLE_CAPTIONBAR]
-Comment=
-
-[Data]
-Entry0=ERROR_VGARESOLUTION
-Entry18=GHC_SYSLIBS_WAYS
-Entry1=TITLE_MAIN
-Entry19=FOLDER_NAME
-Entry2=TITLE_CAPTIONBAR
-Entry3=UNINST_KEY
-Entry4=UNINST_DISPLAY_NAME
-Entry5=COMPANY_NAME
-Entry6=PRODUCT_NAME
-Entry7=PRODUCT_VERSION
-Entry8=PRODUCT_KEY
-Entry20=PRODUCT_NAME_SHORT
-Entry9=ERROR_MOVEDATA
-Entry10=ERROR_UNINSTSETUP
-Entry11=COMPANY_NAME16
-Entry12=PRODUCT_NAME16
-Entry13=ERROR_COMPONENT
-Entry14=ERROR_FILEGROUP
-Entry15=ERROR_FILE
-Entry16=HASKELL_REG_ROOT
-Entry17=GHC_SYSLIBS
-
-[PRODUCT_NAME16]
-Comment=
-
-[ERROR_VGARESOLUTION]
-Comment=
-
-[ERROR_FILE]
-Comment=
-
-[FOLDER_NAME]
-Comment=
-
-[General]
-Type=STRINGTABLE
-Version=1.00.000
-
-[UNINST_DISPLAY_NAME]
-Comment=
-
-[PRODUCT_KEY]
-Comment=
-
-[PRODUCT_NAME]
-Comment=
-
-[ERROR_UNINSTSETUP]
-Comment=
-
diff --git a/ghc/InstallShield/Text Substitutions/Build.tsb b/ghc/InstallShield/Text Substitutions/Build.tsb
deleted file mode 100644
index 786d796baf..0000000000
--- a/ghc/InstallShield/Text Substitutions/Build.tsb
+++ /dev/null
@@ -1,31 +0,0 @@
-[<PROGRAMFILES>]
-Value=
-KeyType=4
-
-[<WINSYSDIR>]
-Value=
-KeyType=4
-
-[<COMMONFILES>]
-Value=
-KeyType=4
-
-[<WINDIR>]
-Value=
-KeyType=4
-
-[Data]
-Key0=<PROGRAMFILES>
-Key1=<COMMONFILES>
-Key2=<WINDIR>
-Key3=<WINSYSDIR>
-Key4=<ISPROJECTDIR>
-
-[<ISPROJECTDIR>]
-Value=
-KeyType=4
-
-[General]
-Type=TEXTSUB
-Version=1.20.000
-
diff --git a/ghc/InstallShield/Text Substitutions/Setup.tsb b/ghc/InstallShield/Text Substitutions/Setup.tsb
deleted file mode 100644
index 41ab3803c7..0000000000
--- a/ghc/InstallShield/Text Substitutions/Setup.tsb
+++ /dev/null
@@ -1,86 +0,0 @@
-[<SRCDIR>]
-Value=
-KeyType=4
-
-[<HKUS>]
-Value=
-KeyType=4
-
-[<HKCR>]
-Value=
-KeyType=4
-
-[<PROGRAMFILES>]
-Value=
-KeyType=4
-
-[<TARGETDIR>]
-Value=
-KeyType=4
-
-[<WINSYSDIR>]
-Value=
-KeyType=4
-
-[<COMMONFILES>]
-Value=
-KeyType=4
-
-[<WINDIR>]
-Value=
-KeyType=4
-
-[Data]
-Key0=<PROGRAMFILES>
-Key1=<COMMONFILES>
-Key2=<WINDIR>
-Key3=<WINSYSDIR>
-Key4=<TARGETDIR>
-Key5=<SUPPORTDIR>
-Key10=<HKDD>
-Key6=<SRCDIR>
-Key11=<HKUS>
-Key7=<HKLM>
-Key12=<HKCR>
-Key8=<HKCU>
-Key13=<SHELL_OBJECT_FOLDER>
-Key9=<HKCC>
-Key14=<DOCDIR>
-Key15=<UNINST>
-
-[<DOCDIR>]
-Value=
-KeyType=3
-
-[<SUPPORTDIR>]
-Value=
-KeyType=4
-
-[<SHELL_OBJECT_FOLDER>]
-Value=
-KeyType=4
-
-[General]
-Type=TEXTSUB
-Version=1.10.000
-
-[<HKLM>]
-Value=
-KeyType=4
-
-[<HKCU>]
-Value=
-KeyType=4
-
-[<HKCC>]
-Value=
-KeyType=4
-
-[<HKDD>]
-Value=
-KeyType=4
-
-[<UNINST>]
-Value=
-KeyType=4
-
diff --git a/ghc/InstallShield/decyg.pl b/ghc/InstallShield/decyg.pl
deleted file mode 100644
index 7bcfd7e285..0000000000
--- a/ghc/InstallShield/decyg.pl
+++ /dev/null
@@ -1,21 +0,0 @@
-#!/usr/bin/perl
-# Patch a DLL or EXE to change the name of the Cygwin DLL it uses or is, so that we can
-# include our own Cygwin DLL that doesn't interfere with the rest of the system, for great justice
-
-@ARGV = ('-') unless @ARGV;
-@FILES = @ARGV;
-while ($ARGV = shift) {
-  $out = $ARGV . ".new";
-  open(IN, $ARGV) or warn "Can't open $ARGV: $!\n";
-  open(OUT, ">$out") or warn "Can't open $out: $!\n";
-  binmode IN;
-  while (<IN>) {
-    s/cygwin1/aybabtu/g;
-    s/c\000y\000g\000w\000i\000n\0001/a\000y\000b\000a\000b\000t\000u/g;
-    print OUT;
-  }
-  close IN;
-  close OUT;
-  unlink $ARGV;
-  rename $out, $ARGV;
-}
diff --git a/ghc/InstallShield/runexe.c b/ghc/InstallShield/runexe.c
deleted file mode 100644
index c1becfbcaa..0000000000
--- a/ghc/InstallShield/runexe.c
+++ /dev/null
@@ -1,59 +0,0 @@
-#include <stdarg.h>
-#include <stdio.h>
-#include <windows.h>
-
-const char *prog = "runexe";
-
-#define BUFLEN 65537
-
-void die(char *fmt, ...)
-{
-  va_list ap = va_start(ap, fmt);
-
-  fprintf(stderr, "%s: ", prog);
-  vfprintf(stderr, fmt, ap);
-  fprintf(stderr, "\n");
-  va_end(ap);
-  exit(1);
-}
-
-void warn(char *fmt, ...)
-{
-  va_list ap = va_start(ap, fmt);
-
-  fprintf(stderr, "%s: ", prog);
-  vfprintf(stderr, fmt, ap);
-  fprintf(stderr, "\n");
-  va_end(ap);
-}
-
-int APIENTRY WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpszCmdParam, int nCmdShow)
-{
-  STARTUPINFO sInfo;
-  PROCESS_INFORMATION pInfo;
-  TCHAR buf[BUFLEN];
-  DWORD retCode;
-
-  sInfo.cb              = sizeof(STARTUPINFO);
-  sInfo.lpReserved      = NULL;
-  sInfo.lpReserved2     = NULL;
-  sInfo.cbReserved2     = 0;
-  sInfo.lpDesktop       = NULL;
-  sInfo.lpTitle         = NULL;
-  sInfo.dwFlags         = 0;
-
-  if (GetCurrentDirectory(BUFLEN, buf) == 0) die("couldn't get current directory");
-  if (strlen(lpszCmdParam) == 0) die("no parameters given");
-  warn("cwd: %s\n", buf);
-  warn("runexing >>>%s<<<\n", lpszCmdParam);
-  if (!CreateProcess(NULL, lpszCmdParam, NULL, NULL, TRUE, 0, NULL, NULL, &sInfo, &pInfo))
-    die("could not create process");
-
-  WaitForSingleObject(pInfo.hProcess, INFINITE);
-  if (GetExitCodeProcess(pInfo.hProcess, &retCode) == 0) retCode = -1;
-  CloseHandle(pInfo.hProcess);
-  CloseHandle(pInfo.hThread);
-  printf("return code %ld\n", retCode);
-
-  return retCode;
-}
diff --git a/ghc/LICENSE b/ghc/LICENSE
deleted file mode 100644
index b5059b71f6..0000000000
--- a/ghc/LICENSE
+++ /dev/null
@@ -1,31 +0,0 @@
-The Glasgow Haskell Compiler License
-
-Copyright 2002, The University Court of the University of Glasgow. 
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-- Redistributions of source code must retain the above copyright notice,
-this list of conditions and the following disclaimer.
- 
-- Redistributions in binary form must reproduce the above copyright notice,
-this list of conditions and the following disclaimer in the documentation
-and/or other materials provided with the distribution.
- 
-- Neither name of the University nor the names of its contributors may be
-used to endorse or promote products derived from this software without
-specific prior written permission. 
-
-THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
-GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
-INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
-DAMAGE.
diff --git a/ghc/Makefile b/ghc/Makefile
index afdb50a0ca..cacc3f7c8e 100644
--- a/ghc/Makefile
+++ b/ghc/Makefile
@@ -32,10 +32,6 @@ SUBDIRS = includes lib utils driver docs compiler
 endif
 endif
 
-ifeq ($(IncludeTestDirsInBuild),YES)
-SUBDIRS += tests
-endif
-
 SRC_DIST_FILES += configure
 
 # Clean everything created by configure:
diff --git a/ghc/README b/ghc/README
deleted file mode 100644
index e5a9a6960d..0000000000
--- a/ghc/README
+++ /dev/null
@@ -1,53 +0,0 @@
-The Glasgow Haskell Compiler
-============================
-
-(this file is fptools/ghc/README in a source distribution, and
-fptools/README in a binary distribution).
-
-GHC is a batch compiler for Haskell 98.  See the file ANNOUNCE for
-information on the current version.
-
-Haskell is "the" standard lazy functional programming language.
-Haskell 98 is the current version of the language, released in
-December 1998.  The language definition is on the Web at
-http://www.haskell.org/definition/.
-
-More information on GHC can be found on its web page
-
-	http://www.haskell.org/ghc/
-
-Documentation
-=============
-
-In a binary distribution, pre-formatted documentation can be found in
-the html and ps directories.  Pre-formatted HTML documentation is also
-available on the GHC web page.
-
-In a source distribution, the unformatted (DocBook XML) documentation
-is in the following places:
-
-  * fptools/ghc/docs/users_guide  Users' Guide.
-  * fptools/hslibs/doc/hslibs	  Library documentation.
-  * fptools/docs  		  Build System Guide.
-
-We welcome your comments and suggestions about this software!  Please
-do not suffer or grumble in silence.  The "bug reports" section of the
-User's Guide says what we would like to know when you report a
-problem.
-
-Mailing Lists
-=============
-
-    glasgow-haskell-bugs@haskell.org	 (bug reports mailing list)
-    glasgow-haskell-users@haskell.org	 (users' mailing list)
-    cvs-ghc@haskell.org			 (developers & bleeding-edge users list)
-
-    subscribe at http://www.haskell.org/mailman/listinfo/
-
-Contributors
-=============
-
-Please see
-  
-   http://www.haskell.org/ghc/contributors.html
-
diff --git a/ghc/VERSION.in b/ghc/VERSION.in
deleted file mode 100644
index 7bb6a43389..0000000000
--- a/ghc/VERSION.in
+++ /dev/null
@@ -1 +0,0 @@
-@ProjectName@, version @ProjectVersion@
diff --git a/ghc/WindowsInstaller/Glasgow Haskell Compiler.ism b/ghc/WindowsInstaller/Glasgow Haskell Compiler.ism
deleted file mode 100644
index 97d6ea3293..0000000000
--- a/ghc/WindowsInstaller/Glasgow Haskell Compiler.ism
+++ /dev/null
diff --git a/ghc/WindowsInstaller/License.rtf b/ghc/WindowsInstaller/License.rtf
deleted file mode 100644
index e8b159a9c7..0000000000
--- a/ghc/WindowsInstaller/License.rtf
+++ /dev/null
@@ -1,60 +0,0 @@
-{\rtf1\ansi\ansicpg1252\uc1 \deff0\deflang1033\deflangfe1033{\fonttbl{\f0\froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f1\fswiss\fcharset0\fprq2{\*\panose 020b0604020202020204}Arial;}
-{\f2\fmodern\fcharset0\fprq1{\*\panose 02070309020205020404}Courier New;}{\f3\froman\fcharset2\fprq2{\*\panose 05050102010706020507}Symbol;}{\f6\fmodern\fcharset0\fprq1{\*\panose 00000000000000000000}Courier;}
-{\f23\fmodern\fcharset128\fprq1{\*\panose 02020609040205080304}MS Mincho{\*\falt MS ??};}{\f27\fswiss\fcharset0\fprq2{\*\panose 020b0604030504040204}Tahoma;}{\f28\fmodern\fcharset128\fprq1{\*\panose 02020609040205080304}@MS Mincho;}
-{\f37\froman\fcharset238\fprq2 Times New Roman CE;}{\f38\froman\fcharset204\fprq2 Times New Roman Cyr;}{\f40\froman\fcharset161\fprq2 Times New Roman Greek;}{\f41\froman\fcharset162\fprq2 Times New Roman Tur;}
-{\f42\froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\f43\froman\fcharset178\fprq2 Times New Roman (Arabic);}{\f44\froman\fcharset186\fprq2 Times New Roman Baltic;}{\f45\fswiss\fcharset238\fprq2 Arial CE;}{\f46\fswiss\fcharset204\fprq2 Arial Cyr;}
-{\f48\fswiss\fcharset161\fprq2 Arial Greek;}{\f49\fswiss\fcharset162\fprq2 Arial Tur;}{\f50\fswiss\fcharset177\fprq2 Arial (Hebrew);}{\f51\fswiss\fcharset178\fprq2 Arial (Arabic);}{\f52\fswiss\fcharset186\fprq2 Arial Baltic;}
-{\f53\fmodern\fcharset238\fprq1 Courier New CE;}{\f54\fmodern\fcharset204\fprq1 Courier New Cyr;}{\f56\fmodern\fcharset161\fprq1 Courier New Greek;}{\f57\fmodern\fcharset162\fprq1 Courier New Tur;}{\f58\fmodern\fcharset177\fprq1 Courier New (Hebrew);}
-{\f59\fmodern\fcharset178\fprq1 Courier New (Arabic);}{\f60\fmodern\fcharset186\fprq1 Courier New Baltic;}{\f223\fmodern\fcharset0\fprq1 MS Mincho Western{\*\falt MS ??};}{\f221\fmodern\fcharset238\fprq1 MS Mincho CE{\*\falt MS ??};}
-{\f222\fmodern\fcharset204\fprq1 MS Mincho Cyr{\*\falt MS ??};}{\f224\fmodern\fcharset161\fprq1 MS Mincho Greek{\*\falt MS ??};}{\f225\fmodern\fcharset162\fprq1 MS Mincho Tur{\*\falt MS ??};}
-{\f228\fmodern\fcharset186\fprq1 MS Mincho Baltic{\*\falt MS ??};}{\f253\fswiss\fcharset238\fprq2 Tahoma CE;}{\f254\fswiss\fcharset204\fprq2 Tahoma Cyr;}{\f256\fswiss\fcharset161\fprq2 Tahoma Greek;}{\f257\fswiss\fcharset162\fprq2 Tahoma Tur;}
-{\f258\fswiss\fcharset177\fprq2 Tahoma (Hebrew);}{\f259\fswiss\fcharset178\fprq2 Tahoma (Arabic);}{\f260\fswiss\fcharset186\fprq2 Tahoma Baltic;}{\f263\fmodern\fcharset0\fprq1 @MS Mincho Western;}{\f261\fmodern\fcharset238\fprq1 @MS Mincho CE;}
-{\f262\fmodern\fcharset204\fprq1 @MS Mincho Cyr;}{\f264\fmodern\fcharset161\fprq1 @MS Mincho Greek;}{\f265\fmodern\fcharset162\fprq1 @MS Mincho Tur;}{\f268\fmodern\fcharset186\fprq1 @MS Mincho Baltic;}}{\colortbl;\red0\green0\blue0;\red0\green0\blue255;
-\red0\green255\blue255;\red0\green255\blue0;\red255\green0\blue255;\red255\green0\blue0;\red255\green255\blue0;\red255\green255\blue255;\red0\green0\blue128;\red0\green128\blue128;\red0\green128\blue0;\red128\green0\blue128;\red128\green0\blue0;
-\red128\green128\blue0;\red128\green128\blue128;\red192\green192\blue192;}{\stylesheet{\ql \li0\ri0\widctlpar\faauto\adjustright\rin0\lin0\itap0 \fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 \snext0 Normal;}{
-\s1\ql \li0\ri0\keepn\nowidctlpar\faauto\outlinelevel0\adjustright\rin0\lin0\itap0 \b\f1\fs16\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext0 heading 1;}{\*\cs10 \additive Default Paragraph Font;}{
-\s15\ql \li0\ri0\nowidctlpar\faauto\adjustright\rin0\lin0\itap0 \f6\fs16\cf6\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext15 Body Text;}{\s16\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 
-\f2\fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext16 Plain Text;}}{\*\listtable{\list\listtemplateid67698689\listsimple{\listlevel\levelnfc23\levelnfcn23\leveljc0\leveljcn0\levelfollow0\levelstartat1\levelspace0\levelindent0
-{\leveltext\'01\u-3913 ?;}{\levelnumbers;}\f3\chbrdr\brdrnone\brdrcf1 \chshdng0\chcfpat1\chcbpat1\fbias0 \fi-360\li360\jclisttab\tx360 }{\listname ;}\listid143089650}{\list\listtemplateid67698689\listsimple{\listlevel\levelnfc23\levelnfcn23\leveljc0
-\leveljcn0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext\'01\u-3913 ?;}{\levelnumbers;}\f3\chbrdr\brdrnone\brdrcf1 \chshdng0\chcfpat1\chcbpat1\fbias0 \fi-360\li360\jclisttab\tx360 }{\listname ;}\listid777650178}
-{\list\listtemplateid67698689\listsimple{\listlevel\levelnfc23\levelnfcn23\leveljc0\leveljcn0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext\'01\u-3913 ?;}{\levelnumbers;}\f3\chbrdr\brdrnone\brdrcf1 \chshdng0\chcfpat1\chcbpat1\fbias0 
-\fi-360\li360\jclisttab\tx360 }{\listname ;}\listid1040588003}{\list\listtemplateid67698689\listsimple{\listlevel\levelnfc23\levelnfcn23\leveljc0\leveljcn0\levelfollow0\levelstartat1\levelspace0\levelindent0{\leveltext\'01\u-3913 ?;}{\levelnumbers;}\f3
-\chbrdr\brdrnone\brdrcf1 \chshdng0\chcfpat1\chcbpat1\fbias0 \fi-360\li360\jclisttab\tx360 }{\listname ;}\listid1838302842}}{\*\listoverridetable{\listoverride\listid1040588003\listoverridecount0\ls1}{\listoverride\listid1838302842\listoverridecount0\ls2}
-{\listoverride\listid777650178\listoverridecount0\ls3}{\listoverride\listid143089650\listoverridecount0\ls4}}{\info{\title The Glasgow Haskell Compiler License}{\author Tom Tokarski}{\operator Reuben Thomas}{\creatim\yr2001\mo8\dy23\hr12}
-{\revtim\yr2001\mo9\dy17\hr12\min21}{\version3}{\edmins4}{\nofpages1}{\nofwords322}{\nofchars1838}{\*\company InstallShield Software Corporation}{\nofcharsws0}{\vern8279}}
-\widowctrl\ftnbj\aenddoc\noxlattoyen\expshrtn\noultrlspc\dntblnsbdb\nospaceforul\hyphcaps0\horzdoc\dghspace120\dgvspace120\dghorigin1701\dgvorigin1984\dghshow0\dgvshow3\jcompress\viewkind4\viewscale100\nolnhtadjtbl \fet0\sectd \linex0\sectdefaultcl 
-{\*\pnseclvl1\pnucrm\pnstart1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl2\pnucltr\pnstart1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl3\pndec\pnstart1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl4\pnlcltr\pnstart1\pnindent720\pnhang{\pntxta )}}{\*\pnseclvl5
-\pndec\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl6\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl7\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl8\pnlcltr\pnstart1\pnindent720\pnhang
-{\pntxtb (}{\pntxta )}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}\pard\plain \s15\ql \li0\ri0\nowidctlpar\faauto\adjustright\rin0\lin0\itap0 \f6\fs16\cf6\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {
-\cf1\loch\af27\hich\af27\dbch\af23 \hich\af27\dbch\af23\loch\f27 The Glasgow Haskell Compiler License
-\par 
-\par \hich\af27\dbch\af23\loch\f27 Copyright 1999, The University Court of the University of Glasgow. 
-\par \hich\af27\dbch\af23\loch\f27 All rights reserved.
-\par 
-\par \hich\af27\dbch\af23\loch\f27 Redistribution and use in source and binary forms, with or without
-\par \hich\af27\dbch\af23\loch\f27 modification, are permitted provided that the following conditions are met:
-\par 
-\par \hich\af27\dbch\af23\loch\f27 - Redistributions of source code must retain the above copyright notice,
-\par \hich\af27\dbch\af23\loch\f27 this list of conditions and the followi\hich\af27\dbch\af23\loch\f27 ng disclaimer.
-\par \hich\af27\dbch\af23\loch\f27  
-\par \hich\af27\dbch\af23\loch\f27 - Redistributions in binary form must reproduce the above copyright notice,
-\par \hich\af27\dbch\af23\loch\f27 this list of conditions and the following disclaimer in the documentation
-\par \hich\af27\dbch\af23\loch\f27 and/or other materials provided with the distribution.
-\par \hich\af27\dbch\af23\loch\f27  
-\par \hich\af27\dbch\af23\loch\f27 - Neither name of the University\hich\af27\dbch\af23\loch\f27  nor the names of its contributors may be
-\par \hich\af27\dbch\af23\loch\f27 used to endorse or promote products derived from this software without
-\par \hich\af27\dbch\af23\loch\f27 specific prior written permission. 
-\par 
-\par \hich\af27\dbch\af23\loch\f27 THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
-\par \hich\af27\dbch\af23\loch\f27 GLASGOW AND THE CONTRIBUTORS "AS IS\hich\af27\dbch\af23\loch\f27 " AND ANY EXPRESS OR IMPLIED WARRANTIES,
-\par \hich\af27\dbch\af23\loch\f27 INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-\par \hich\af27\dbch\af23\loch\f27 FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-\par \hich\af27\dbch\af23\loch\f27 UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS B\hich\af27\dbch\af23\loch\f27 E LIABLE
-\par \hich\af27\dbch\af23\loch\f27 FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-\par \hich\af27\dbch\af23\loch\f27 DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-\par \hich\af27\dbch\af23\loch\f27 SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-\par \hich\af27\dbch\af23\loch\f27 CAUSED AND ON ANY THEO\hich\af27\dbch\af23\loch\f27 RY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-\par \hich\af27\dbch\af23\loch\f27 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-\par \hich\af27\dbch\af23\loch\f27 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
-\par \hich\af27\dbch\af23\loch\f27 DAMAGE.}{\f27\cgrid0 
-\par }}
\ No newline at end of file
diff --git a/ghc/WindowsInstaller/MakeInstaller.txt b/ghc/WindowsInstaller/MakeInstaller.txt
deleted file mode 100644
index 6347ed4350..0000000000
--- a/ghc/WindowsInstaller/MakeInstaller.txt
+++ /dev/null
@@ -1,82 +0,0 @@
-How to make an InstallShield in 357 frustrating steps
------------------------------------------------------
-
-The recipe below is correct in theory, but unfortunately some bits
-don't work in practice. These are noted below.
-
-0. Build a stage 1 tree.
-1. Set "XMLDocWays=html pdf" in stage 2's build.mk.
-2. Build stage 2.
-3. Convert ANNOUNCE and LICENSE (if it has changed) to RTF (use Word),
-and put them in the WindowsInstaller directory.
-4. Iff the layout of the directory tree has changed since last time
-(the addition or removal of files in existing directories doesn't
-matter):
-
-  a. Set Project->Path Variables->Project->SourceFiles to point to
-  the installed tree.
-  b. Make sure GHCBITS (in the same place) points to the tree
-  containing gcc, perl &c.
-  c. Delete all the DLS_TopLevelFiles_x components.
-  d. Add the entire install tree to TopLevelFiles as a dynamic link.
-  e. Re-add the Start menu shortcuts for
-      i. GHCi
-     ii. PDF manual
-    iii. HTML User's Guide
-     iv. HTML Libraries Guide
-
-     For each one, find the right DLS_TopLevelFiles_xx directory, go
-     to Shortcuts, add a folder Program Files->Glasgow Haskell
-     Compiler, and preferably copy the exact name for the file from an
-     installed compiler. Add the file name, which is relative to the
-     *installed* tree (i.e. <InstallDir>).
-  f. Re-add the registry keys (under Registry Data for the
-     TopLevelFiles component): HKEY_LOCAL_MACHINE->SOFTWARE->Glasgow
-     Haskell Compiler->x.yy->{Path,Version}, where Path is set to
-     <INSTALLDIR> and Version to the current version.
-
-5. Build the InstallShield.
-7-356. Deal with the awkward points mentioned below.
-357. Freeze & sell.
-
-
-Documentation
--------------
-
-  jadetex
-  -------
-
-I couldn't work out how to set the config parameters of MikTeX 2.1 to
-make jadetex compile the user guide and libraries book without falling
-over owing to running out of hash_size.
-
-Since MikTeX 1.2 seemed to work fine, the suggested workaround is to
-use that.
-
-Hopefully at some point Cygwin's tetex package will come with jadetex,
-and there won't be any need to install MikTeX.
-
-  ghostscript
-  -----------
-
-I couldn't get Cygwin's ps2pdf to work; hopefully it will in the
-future (or even more likely, I was just being useless). I have used
-AFPL's Ghostscript 6.50 for Windows happily; note that whatever
-version is used should be at least 6.50; earlier versions put
-low-quality bitmap fonts in PDFs.
-
-
-Tweaking the UI
----------------
-
-The only dialog that has so far been changed is SetupCompleteSuccess
-(under User Interface). Note that this dialog is used for both install
-(string IDS__IsExitDialog_5) and uninstall (string
-IDS__IsExitDialog_6).
-
-
-Version number and other strings
---------------------------------
-
-Most of the useful string resources are under the top-most entries in
-the tree on the Project View.
\ No newline at end of file
diff --git a/ghc/WindowsInstaller/announce.rtf b/ghc/WindowsInstaller/announce.rtf
deleted file mode 100644
index b44a9fbae9..0000000000
--- a/ghc/WindowsInstaller/announce.rtf
+++ /dev/null
@@ -1,160 +0,0 @@
-{\rtf1\ansi\ansicpg1252\uc1 \deff0\deflang1033\deflangfe1033{\fonttbl{\f0\froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f1\fswiss\fcharset0\fprq2{\*\panose 020b0604020202020204}Arial;}
-{\f2\fmodern\fcharset0\fprq1{\*\panose 02070309020205020404}Courier New;}{\f23\fmodern\fcharset128\fprq1{\*\panose 02020609040205080304}MS Mincho{\*\falt MS ??};}{\f27\fswiss\fcharset0\fprq2{\*\panose 020b0604030504040204}Tahoma;}
-{\f28\fmodern\fcharset128\fprq1{\*\panose 02020609040205080304}@MS Mincho;}{\f144\froman\fcharset238\fprq2 Times New Roman CE;}{\f145\froman\fcharset204\fprq2 Times New Roman Cyr;}{\f147\froman\fcharset161\fprq2 Times New Roman Greek;}
-{\f148\froman\fcharset162\fprq2 Times New Roman Tur;}{\f149\froman\fcharset177\fprq2 Times New Roman (Hebrew);}{\f150\froman\fcharset178\fprq2 Times New Roman (Arabic);}{\f151\froman\fcharset186\fprq2 Times New Roman Baltic;}
-{\f152\fswiss\fcharset238\fprq2 Arial CE;}{\f153\fswiss\fcharset204\fprq2 Arial Cyr;}{\f155\fswiss\fcharset161\fprq2 Arial Greek;}{\f156\fswiss\fcharset162\fprq2 Arial Tur;}{\f157\fswiss\fcharset177\fprq2 Arial (Hebrew);}
-{\f158\fswiss\fcharset178\fprq2 Arial (Arabic);}{\f159\fswiss\fcharset186\fprq2 Arial Baltic;}{\f160\fmodern\fcharset238\fprq1 Courier New CE;}{\f161\fmodern\fcharset204\fprq1 Courier New Cyr;}{\f163\fmodern\fcharset161\fprq1 Courier New Greek;}
-{\f164\fmodern\fcharset162\fprq1 Courier New Tur;}{\f165\fmodern\fcharset177\fprq1 Courier New (Hebrew);}{\f166\fmodern\fcharset178\fprq1 Courier New (Arabic);}{\f167\fmodern\fcharset186\fprq1 Courier New Baltic;}
-{\f330\fmodern\fcharset0\fprq1 MS Mincho Western{\*\falt MS ??};}{\f328\fmodern\fcharset238\fprq1 MS Mincho CE{\*\falt MS ??};}{\f329\fmodern\fcharset204\fprq1 MS Mincho Cyr{\*\falt MS ??};}{\f331\fmodern\fcharset161\fprq1 MS Mincho Greek{\*\falt MS ??};}
-{\f332\fmodern\fcharset162\fprq1 MS Mincho Tur{\*\falt MS ??};}{\f335\fmodern\fcharset186\fprq1 MS Mincho Baltic{\*\falt MS ??};}{\f360\fswiss\fcharset238\fprq2 Tahoma CE;}{\f361\fswiss\fcharset204\fprq2 Tahoma Cyr;}
-{\f363\fswiss\fcharset161\fprq2 Tahoma Greek;}{\f364\fswiss\fcharset162\fprq2 Tahoma Tur;}{\f365\fswiss\fcharset177\fprq2 Tahoma (Hebrew);}{\f366\fswiss\fcharset178\fprq2 Tahoma (Arabic);}{\f367\fswiss\fcharset186\fprq2 Tahoma Baltic;}
-{\f370\fmodern\fcharset0\fprq1 @MS Mincho Western;}{\f368\fmodern\fcharset238\fprq1 @MS Mincho CE;}{\f369\fmodern\fcharset204\fprq1 @MS Mincho Cyr;}{\f371\fmodern\fcharset161\fprq1 @MS Mincho Greek;}{\f372\fmodern\fcharset162\fprq1 @MS Mincho Tur;}
-{\f375\fmodern\fcharset186\fprq1 @MS Mincho Baltic;}}{\colortbl;\red0\green0\blue0;\red0\green0\blue255;\red0\green255\blue255;\red0\green255\blue0;\red255\green0\blue255;\red255\green0\blue0;\red255\green255\blue0;\red255\green255\blue255;
-\red0\green0\blue128;\red0\green128\blue128;\red0\green128\blue0;\red128\green0\blue128;\red128\green0\blue0;\red128\green128\blue0;\red128\green128\blue128;\red192\green192\blue192;}{\stylesheet{
-\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 \snext0 Normal;}{\s1\ql \li0\ri0\sb240\sa60\keepn\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 
-\b\f1\fs32\lang1033\langfe1033\kerning32\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext0 heading 1;}{\s2\ql \li0\ri0\sb240\sa60\keepn\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 
-\b\i\f1\fs28\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext0 heading 2;}{\*\cs10 \additive Default Paragraph Font;}{\s15\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 
-\f2\fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 \sbasedon0 \snext15 Plain Text;}}{\info{\title The (Interactive) Glasgow Haskell Compiler -- version 5}{\author Reuben Thomas}{\operator Reuben Thomas}{\creatim\yr2001\mo9\dy24\hr14\min57}
-{\revtim\yr2001\mo9\dy24\hr14\min57}{\version2}{\edmins0}{\nofpages3}{\nofwords706}{\nofchars4026}{\*\company Microsoft Internal (EMEA)}{\nofcharsws4944}{\vern8279}}\margl1320\margr1320 
-\widowctrl\ftnbj\aenddoc\noxlattoyen\expshrtn\noultrlspc\dntblnsbdb\nospaceforul\formshade\horzdoc\dghspace180\dgvspace180\dghorigin1701\dgvorigin1984\dghshow0\dgvshow0\jexpand\viewkind4\viewscale100\pgbrdrhead\pgbrdrfoot\nolnhtadjtbl \fet0\sectd 
-\linex0\endnhere\sectdefaultcl {\*\pnseclvl1\pnucrm\pnstart1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl2\pnucltr\pnstart1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl3\pndec\pnstart1\pnindent720\pnhang{\pntxta .}}{\*\pnseclvl4
-\pnlcltr\pnstart1\pnindent720\pnhang{\pntxta )}}{\*\pnseclvl5\pndec\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl6\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl7\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}
-{\pntxta )}}{\*\pnseclvl8\pnlcltr\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}{\*\pnseclvl9\pnlcrm\pnstart1\pnindent720\pnhang{\pntxtb (}{\pntxta )}}\pard\plain 
-\s1\ql \li0\ri0\sb240\sa60\keepn\widctlpar\aspalpha\aspnum\faauto\outlinelevel0\adjustright\rin0\lin0\itap0 \b\f1\fs32\lang1033\langfe1033\kerning32\cgrid\langnp1033\langfenp1033 {\dbch\af23 \hich\af1\dbch\af23\loch\f1 
-The (Interactive) Glasgow Haskell Compiler -- version 5.02
-\par }\pard\plain \s15\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \f2\fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\dbch\af23 
-\par }\pard\plain \ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\f27 We are pleased to announce a new major release of the Glasgow Haskell
-\par Compiler (GHC), version 5.02.  The source distribution is freely
-\par available via the World-Wide Web, under a BSD-style license.  See
-\par below for download details.  Pre-built packages for Linux, FreeBSD,
-\par Solaris and Win32 are also available.
-\par 
-\par Haskell is a standard lazy functional programming language; the
-\par current language version is Haskell 98, agreed in December 1998.
-\par 
-\par GHC is a state-of-the-art programming suite for Haskell.  Included is
-\par an optimising compiler generating good code for a variety of
-\par platforms, together with an interactive system for convenient, quick
-\par development.  The distribution includes space and time profiling
-\par facilities, a large collection of libraries, and support for various
-\par language extensions, including concurrency, exceptions, and foreign
-\par language interfaces (C, C++, whatever).
-\par 
-\par A wide variety of Haskell related resources (tutorials, libraries,
-\par specifications, documentation, compilers, interpreters, references,
-\par contact information, links to research groups) are available from the
-\par Haskell home page at
-\par 
-\par         http://www.haskell.org/
-\par 
-\par GHC's Web page lives at
-\par 
-\par         http://www.haskell.org/ghc/
-\par }\pard\plain \s15\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \f2\fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\dbch\af23 
-\par }\pard\plain \s2\ql \li0\ri0\sb240\sa60\keepn\widctlpar\aspalpha\aspnum\faauto\outlinelevel1\adjustright\rin0\lin0\itap0 \b\i\f1\fs28\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\dbch\af23 \hich\af1\dbch\af23\loch\f1 What's 
-\hich\af1\dbch\af23\loch\f1 new
-\par }\pard\plain \s15\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \f2\fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\dbch\af23 
-\par }\pard\plain \ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\loch\af27\hich\af27\dbch\af23 \hich\af27\dbch\af23\loch\f27 
-5.02 incorporates many small refinements and bug fixes over the previous 
-\par \hich\af27\dbch\af23\loch\f27 stable release (5.00.2).  There are no major changes.  
-\par 
-\par \hich\af27\dbch\af23\loch\f27    - \hich\af27\dbch\af23\loch\f27 Much improved support for Windows platforms.  Binary builds are
-\par \hich\af27\dbch\af23\loch\f27      now entirely freestanding.  There's no need to install Cygwin or
-\par \hich\af27\dbch\af23\loch\f27      Mingwin to use it.  It's a one-click-install-and-off-you-go story now.
-\par 
-\par \hich\af27\dbch\af23\loch\f27    - Several small changes to bring GHC i\hich\af27\dbch\af23\loch\f27 nto line with the newest Haskell 98 
-\par \hich\af27\dbch\af23\loch\f27      report.
-\par 
-\par \hich\af27\dbch\af23\loch\f27    - GHCi (the interactive system) now works on Windows.
-\par 
-\par \hich\af27\dbch\af23\loch\f27    - Partial FFI support in GHCi.  At the moment, foreign import (both
-\par \hich\af27\dbch\af23\loch\f27      static and dynamic) is supported on x86 and sparc platforms.
-\par 
-\par \hich\af27\dbch\af23\loch\f27  \hich\af27\dbch\af23\loch\f27   - A compacting garbage collector, to try and reduce space use.
-\par 
-\par \hich\af27\dbch\af23\loch\f27    - Experimental: partial support for hierarchical module names.
-\par 
-\par \hich\af27\dbch\af23\loch\f27    - Experimental: following heroic hacking by Ken Shan, 5.02 now
-\par \hich\af27\dbch\af23\loch\f27      works on Alpha (Tru64 only).  Many 64-bit bugs \hich\af27\dbch\af23\loch\f27 have been shaken
-\par \hich\af27\dbch\af23\loch\f27      out.  At the moment only the batch-mode compiler works -- no GHCi
-\par \hich\af27\dbch\af23\loch\f27      or native code generator yet.
-\par 
-\par \hich\af27\dbch\af23\loch\f27 We've found and fixed more bugs than you could possibly imagine.  A
-\par \hich\af27\dbch\af23\loch\f27 big thank-you to all those who reported bugs in the 5.00.X \hich\af27\dbch\af23\loch\f27 series.  We
-\par \hich\af27\dbch\af23\loch\f27 claim to have fixed almost all reported bugs.  In general we've spent
-\par \hich\af27\dbch\af23\loch\f27 a large amount of effort trying to improve the stability of the
-\par \hich\af27\dbch\af23\loch\f27 system relative to 5.00.X.  (Famous last words ...)
-\par 
-\par \hich\af27\dbch\af23\loch\f27 For full details see the release notes:
-\par 
-\par \hich\af27\dbch\af23\loch\f27         h\hich\af27\dbch\af23\loch\f27 ttp://www.haskell.org/ghc/docs/5.02/set/release-5-02.html
-\par 
-\par }\pard\plain \s2\ql \li0\ri0\sb240\sa60\keepn\widctlpar\aspalpha\aspnum\faauto\outlinelevel1\adjustright\rin0\lin0\itap0 \b\i\f1\fs28\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\dbch\af23 \hich\af1\dbch\af23\loch\f1 How to get it
-\par }\pard\plain \s15\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \f2\fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\dbch\af23 
-\par }{\loch\af27\hich\af27\dbch\af23 \hich\af27\dbch\af23\loch\f27 The easy way is to go to the WWW page, which should be
-\par \hich\af27\dbch\af23\loch\f27 self-explanatory:
-\par 
-\par \hich\af27\dbch\af23\loch\f27         http://www.haskell.org/ghc/
-\par 
-\par \hich\af27\dbch\af23\loch\f27 We supply binary builds in the native pa\hich\af27\dbch\af23\loch\f27 ckage format for various
-\par \hich\af27\dbch\af23\loch\f27 flavours of Linux and BSD, and in InstallShield form for Windows
-\par \hich\af27\dbch\af23\loch\f27 folks.  Everybody else gets a .tar.gz which can be installed where you
-\par \hich\af27\dbch\af23\loch\f27 want.
-\par 
-\par \hich\af27\dbch\af23\loch\f27 Once you have the distribution, please follow the pointers in the
-\par \hich\af27\dbch\af23\loch\f27 README file to f\hich\af27\dbch\af23\loch\f27 ind all of the documentation about this release.
-\par }{\dbch\af23 
-\par }\pard\plain \s2\ql \li0\ri0\sb240\sa60\keepn\widctlpar\aspalpha\aspnum\faauto\outlinelevel1\adjustright\rin0\lin0\itap0 \b\i\f1\fs28\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\dbch\af23 \hich\af1\dbch\af23\loch\f1 On-line GHC-related resources
-
-\par }\pard\plain \s15\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \f2\fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\dbch\af23 
-\par }{\loch\af27\hich\af27\dbch\af23 \hich\af27\dbch\af23\loch\f27 Relevant URLs on the World-Wide Web:
-\par 
-\par \hich\af27\dbch\af23\loch\f27 GHC home page             http://www.haskell.org/ghc/
-\par \hich\af27\dbch\af23\loch\f27 Haskell home page         http://www.h\hich\af27\dbch\af23\loch\f27 askell.org/
-\par \hich\af27\dbch\af23\loch\f27 comp.lang.functional FAQ  http://www.cs.nott.ac.uk/~gmh/faq.html
-\par }{\dbch\af23 
-\par }\pard\plain \s2\ql \li0\ri0\sb240\sa60\keepn\widctlpar\aspalpha\aspnum\faauto\outlinelevel1\adjustright\rin0\lin0\itap0 \b\i\f1\fs28\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\dbch\af23 \hich\af1\dbch\af23\loch\f1 System requirements
-\par }\pard\plain \ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\loch\af27\hich\af27\dbch\af23 
-\par \hich\af27\dbch\af23\loch\f27 To compile programs with GHC, you need a machine with 64+MB memory, GNU C
-\par \hich\af27\dbch\af23\loch\f27 and perl. This release is known to work on the fo\hich\af27\dbch\af23\loch\f27 llowing platforms:
-\par 
-\par \hich\af27\dbch\af23\loch\f27   * i386-unknown-\{linux,freebsd,mingw32\}
-\par \hich\af27\dbch\af23\loch\f27   }{\lang1036\langfe1033\loch\af27\hich\af27\dbch\af23\langnp1036 \hich\af27\dbch\af23\loch\f27 * sparc-sun-solaris2
-\par 
-\par }{\loch\af27\hich\af27\dbch\af23 \hich\af27\dbch\af23\loch\f27 Ports to the following platforms should be relatively easy (for a
-\par \hich\af27\dbch\af23\loch\f27 wunderhacker), but haven't been tested due to lack of time/hardware:
-\par 
-\par \hich\af27\dbch\af23\loch\f27   * hppa1.1-hp-hpux\{9,10\}
-\par \hich\af27\dbch\af23\loch\f27   * i386-unknown-solaris2
-\par \hich\af27\dbch\af23\loch\f27   * alpha-dec-osf\{2,3\}
-\par \hich\af27\dbch\af23\loch\f27   * mips-sgi-irix\{5,6\}
-\par \hich\af27\dbch\af23\loch\f27   * \{rs6000,powerpc\}-ibm-aix
-\par 
-\par \hich\af27\dbch\af23\loch\f27 The builder's guide included in distribution gives a complete
-\par \hich\af27\dbch\af23\loch\f27 run-down of what ports work; an on-line version can be found at
-\par 
-\par \hich\af27\dbch\af23\loch\f27    http://www.haske\hich\af27\dbch\af23\loch\f27 ll.org/ghc/docs/5.02/building/building-guide.html
-\par }\pard\plain \s15\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \f2\fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\dbch\af23 
-\par }\pard\plain \s2\ql \li0\ri0\sb240\sa60\keepn\widctlpar\aspalpha\aspnum\faauto\outlinelevel1\adjustright\rin0\lin0\itap0 \b\i\f1\fs28\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\dbch\af23 \hich\af1\dbch\af23\loch\f1 Mailing lists
-\par }\pard\plain \s15\ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \f2\fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\dbch\af23 
-\par }\pard\plain \ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 \fs20\lang1033\langfe1033\cgrid\langnp1033\langfenp1033 {\loch\af27\hich\af27\dbch\af23 \hich\af27\dbch\af23\loch\f27 
-We run mailing lists for GHC users and bug reports; to subscribe, use
-\par \hich\af27\dbch\af23\loch\f27 the web interfaces at
-\par 
-\par \tab \hich\af27\dbch\af23\loch\f27 http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
-\par \tab \hich\af27\dbch\af23\loch\f27 htt\hich\af27\dbch\af23\loch\f27 p://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs
-\par 
-\par \hich\af27\dbch\af23\loch\f27 There are several other haskell and ghc-related mailing lists on
-\par \hich\af27\dbch\af23\loch\f27 www.haskell.org; for the full list, see
-\par 
-\par \tab \hich\af27\dbch\af23\loch\f27 http://www.haskell.org/mailman/listinfo/
-\par 
-\par \hich\af27\dbch\af23\loch\f27 Please report bugs using our SourceForge \hich\af27\dbch\af23\loch\f27 page at
-\par \tab 
-\par \tab \hich\af27\dbch\af23\loch\f27 http://sourceforge.net/projects/ghc/
-\par 
-\par \hich\af27\dbch\af23\loch\f27 or send them to glasgow-haskell-bugs@haskell.org.
-\par 
-\par \hich\af27\dbch\af23\loch\f27 GHC users hang out on glasgow-haskell-users@haskell.org.  Bleeding
-\par }\pard \ql \li0\ri0\widctlpar\aspalpha\aspnum\faauto\adjustright\rin0\lin0\itap0 {\loch\af27\hich\af27\dbch\af23 \hich\af27\dbch\af23\loch\f27 edge CVS users party on cvs-ghc@haskell.org.
-\par }}
\ No newline at end of file
diff --git a/ghc/aclocal.m4 b/ghc/aclocal.m4
deleted file mode 100644
index 3a4a6f734d..0000000000
--- a/ghc/aclocal.m4
+++ /dev/null
@@ -1,131 +0,0 @@
-# FP_SETUP_PROJECT_INFO
-# ---------------------
-AC_DEFUN([FP_SETUP_PROJECT_INFO],
-[# Some renamings
-AC_SUBST([ProjectName], [$PACKAGE_NAME])
-AC_SUBST([ProjectNameShort], [$PACKAGE_TARNAME])
-AC_SUBST([ProjectVersion], [$PACKAGE_VERSION])
-
-# Split PACKAGE_VERSION into (possibly empty) parts
-VERSION_MAJOR=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/`
-VERSION_TMP=`echo $PACKAGE_VERSION | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/`
-VERSION_MINOR=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\1'/`
-ProjectPatchLevel=`echo $VERSION_TMP | sed 's/^\(@<:@^.@:>@*\)\(\.\{0,1\}\(.*\)\)$/\3'/`
-
-# Calculate project version as an integer, using 2 digits for minor version
-case $VERSION_MINOR in
-  ?) ProjectVersionInt=${VERSION_MAJOR}0${VERSION_MINOR} ;;
-  ??) ProjectVersionInt=${VERSION_MAJOR}${VERSION_MINOR} ;;
-  *) AC_MSG_ERROR([bad minor version in $PACKAGE_VERSION]) ;;
-esac
-AC_SUBST([ProjectVersionInt])
-
-# The project patchlevel is zero unless stated otherwise
-test -z "$ProjectPatchLevel" && ProjectPatchLevel=0
-
-# Remove dots from the patch level; this allows us to have versions like 6.4.1.20050508
-ProjectPatchLevel=`echo $ProjectPatchLevel | sed 's/\.//'`
-
-AC_SUBST([ProjectPatchLevel])
-])# FP_SETUP_PROJECT_INFO
-
-
-# FP_PROG_GHC_PKG
-# ----------------
-# Try to find a ghc-pkg matching the ghc mentioned in the environment variable
-# WithGhc. If the latter is unset or no matching ghc-pkg can be found, try to
-# find a plain ghc-pkg. Sets the output variable GhcPkgCmd.
-AC_DEFUN([FP_PROG_GHC_PKG],
-[AC_CACHE_CHECK([for ghc-pkg matching $WithGhc], fp_cv_matching_ghc_pkg,
-[fp_ghc_pkg_guess=`echo $WithGhc | sed 's,ghc\(@<:@^/\\@:>@*\)$,ghc-pkg\1,'`
-if "$fp_ghc_pkg_guess" -l > /dev/null 2>&1; then
-  fp_cv_matching_ghc_pkg=$fp_ghc_pkg_guess
-else
-  fp_cv_matching_ghc_pkg=no
-fi])
-if test x"$fp_cv_matching_ghc_pkg" = xno; then
-  AC_PATH_PROG([GhcPkgCmd], [ghc-pkg])
-else
-  GhcPkgCmd=$fp_cv_matching_ghc_pkg
-fi])# FP_PROG_GHC_PKG
-
-
-# FP_GHC_HAS_READLINE
-# -------------------
-AC_DEFUN([FP_GHC_HAS_READLINE],
-[AC_REQUIRE([FP_PROG_GHC_PKG])
-AC_CACHE_CHECK([whether ghc has readline package], [fp_cv_ghc_has_readline],
-[if "${GhcPkgCmd-ghc-pkg}" --show-package readline >/dev/null 2>&1; then
-  fp_cv_ghc_has_readline=yes
-else
-  fp_cv_ghc_has_readline=no
- fi])
-AC_SUBST([GhcHasReadline], [`echo $fp_cv_ghc_has_readline | sed 'y/yesno/YESNO/'`])
-])# FP_GHC_HAS_READLINE
-
-
-# FP_COMPARE_VERSIONS(VERSION1, TEST, VERSION2, [ACTION-IF-TRUE], [ACTION-IF-FALSE])
-# ----------------------------------------------------------------------------------
-# Compare dotted version numbers VERSION1 and VERSION2 lexicographically according
-# to TEST (one of -eq, -ne, -lt, -le, -gt, or -ge).
-AC_DEFUN([FP_COMPARE_VERSIONS],
-[fp_version1=$1; fp_version2=$3
-fp_save_IFS=$IFS; IFS='.'
-while test x"$fp_version1" != x || test x"$fp_version2" != x
-do
-
-  set dummy $fp_version1; shift
-  fp_num1=""
-  test $[@%:@] = 0 || { fp_num1="[$]1"; shift; }
-  test x"$fp_num1" = x && fp_num1="0"
-  fp_version1="[$]*"
-
-  set dummy $fp_version2; shift
-  fp_num2=""
-  test $[@%:@] = 0 || { fp_num2="[$]1"; shift; }
-  test x"$fp_num2" = x && fp_num2="0"
-  fp_version2="[$]*"
-
-  test "$fp_num1" = "$fp_num2" || break;
-done
-IFS=$fp_save_IFS
-AS_IF([test "$fp_num1" $2 "$fp_num2"], [$4], [$5])[]dnl
-])# FP_COMPARE_VERSIONS
-
-
-# FP_HAVE_GCC
-# -----------
-# Extra testing of the result AC_PROG_CC, testing the gcc version no. Sets the
-# output variables HaveGcc and GccVersion.
-AC_DEFUN([FP_HAVE_GCC],
-[AC_REQUIRE([AC_PROG_CC])
-AC_CACHE_CHECK([whether your gcc is OK], [fp_cv_have_gcc],
-[if test -z "$GCC"; then
-  fp_cv_have_gcc='no'
-  AC_MSG_WARN([You would be better off with gcc, perhaps it is already installed, but not in your PATH?])
-else
-  fp_cv_have_gcc='yes'
-  gcc_version_str="`$CC -v 2>&1 | grep 'version ' | sed -e 's/.*version [[^0-9]]*\([[0-9]][[0-9]]*\)\.\([[0-9]][[0-9]]*\).*/\1\.\2/g' `"
-  FP_COMPARE_VERSIONS([$gcc_version_str], [-lt], [2.0],
-    [AC_MSG_ERROR([Need at least gcc version 2.0 (2.95.3 recommend)])])
-fi])
-AC_SUBST([HaveGcc], [`echo $fp_cv_have_gcc | sed 'y/yesno/YESNO/'`])
-AC_SUBST([GccVersion], [`gcc --version | grep mingw | cut -f 3 -d ' '`])
-])# FP_HAVE_GCC
-
-
-# FP_GCC_NEEDS_NO_OMIT_LFPTR
-# --------------------------
-# Some OSs (Mandrake Linux, in particular) configure GCC with
-# -momit-leaf-frame-pointer on by default. If this is the case, we need to turn
-# it off for mangling to work. The test is currently a bit crude, using only the
-# version number of gcc. Defines HAVE_GCC_MNO_OMIT_LFPTR.
-AC_DEFUN([FP_GCC_NEEDS_NO_OMIT_LFPTR],
-[AC_REQUIRE([FP_HAVE_GCC])
-AC_CACHE_CHECK([whether gcc needs -mno-omit-leaf-frame-pointer], [fp_cv_gcc_needs_no_omit_lfptr],
-[FP_COMPARE_VERSIONS([$gcc_version_str], [-ge], [3.2],
-  [fp_cv_gcc_needs_no_omit_lfptr=yes],
-  [fp_cv_gcc_needs_no_omit_lfptr=no])])
-if test "$fp_cv_gcc_needs_no_omit_lfptr" = "yes"; then
-   AC_DEFINE([HAVE_GCC_MNO_OMIT_LFPTR], [1], [Define to 1 if gcc supports -mno-omit-leaf-frame-pointer.])
-fi])# FP_GCC_NEEDS_NO_OMIT_LFPTR
diff --git a/ghc/compiler/DEPEND-NOTES b/ghc/compiler/DEPEND-NOTES
deleted file mode 100644
index f2ba244315..0000000000
--- a/ghc/compiler/DEPEND-NOTES
+++ /dev/null
@@ -1,4 +0,0 @@
-Module dependency information is now given in the GHC commentary
-
-	ghc/docs/comm/genesis/modules.html
-
diff --git a/ghc/compiler/DLL-NOTES b/ghc/compiler/DLL-NOTES
deleted file mode 100644
index c710b14251..0000000000
--- a/ghc/compiler/DLL-NOTES
+++ /dev/null
@@ -1,58 +0,0 @@
-                              The DLL story
-                              -------------
-
-***
-
-This file is intended to be a focal point for notes on how DLLs work. Please
-add cross-references to source and other docs, especially when you don't
-find something here that you need.
-
-***
-
-
-Introduction
-------------
-
-On Windows, DLLs are synonymous with packages (since 4.07; this change
-simplified a rather horrible mess). Hence whenever a module is to be
-compiled to go in a DLL, it must be compiled with -package-name dll-name.
-Typically, failing to do this gives Windows error message boxes of the form
-"The instruction at address <x> tried to read memory at address <x>".
-
-
-Dependencies
-------------
-
-Because references in DLLs must be fully resolved when the DLL is compiled
-(except for references to other DLLs), it is not possible for DLLs to call
-the main program. This means that the parts of the RTS and standard package
-which call the main program cannot be compiled into the relevant DLLs, and
-must instead be compiled as standalone object files and linked in to each
-executable. This gives the following picture of dependencies within a program:
-
-            ___________         ___________
-           |           |------>|           |   GHC-land  |  Application-land
-DLL-land   | HSrts.dll |       | HSstd.dll |             |
-           |___________|<------|___________|             |
-                 |                   ^                   |
------------------|-------------------|-------------------|
-            _____v_____         _____|______             |
-.o-land    |           |       |            |            |
-           |  Main.o   |       | PrelMain.o |-----------------------
-	   |___________|       |____________|            |          |
-                 |                                       |    ______v______
-                 |                                       |   |             |
-                  ------------------------------------------>|   Main.o    |
-                                                         |   |_____________|
-
-(The application's dependencies are not shown.)
-
-
-Bits of the compiler that deal with DLLs
-----------------------------------------
-
-basicTypes/Module.lhs is the most important place, as it deals with which
-modules identifiers are in.
-
-basicTypes/name.lhs, other bits of basicTypes/, nativeGen/, codeGen/,
-abcCSyn/, and even profiling/ have other references.
diff --git a/ghc/compiler/HsVersions.h b/ghc/compiler/HsVersions.h
deleted file mode 100644
index dd80922e0b..0000000000
--- a/ghc/compiler/HsVersions.h
+++ /dev/null
@@ -1,108 +0,0 @@
-#ifndef HSVERSIONS_H
-#define HSVERSIONS_H
-
-#if 0
-
-IMPORTANT!  If you put extra tabs/spaces in these macro definitions,
-you will screw up the layout where they are used in case expressions!
-
-(This is cpp-dependent, of course)
-
-#endif
-
-/* Useful in the headers that we share with the RTS */
-#define COMPILING_GHC 1
-
-/* Pull in all the platform defines for this build (foo_TARGET_ARCH etc.) */
-#include "ghc_boot_platform.h"
-
-/* Pull in the autoconf defines (HAVE_FOO), but don't include
- * ghcconfig.h, because that will include ghcplatform.h which has the
- * wrong platform settings for the compiler (it has the platform
- * settings for the target plat instead). */
-#include "../includes/ghcautoconf.h"
-
-#if __GLASGOW_HASKELL__ >= 504
-
-#define CONCURRENT  Control.Concurrent
-#define EXCEPTION   Control.Exception
-     /* If you want Control.Exception.try, get it as Panic.try, which
-        deals with the shift from 'tryAllIO' to 'try'.  */
-#define DYNAMIC     Data.Dynamic
-#define GLAEXTS     GHC.Exts
-#define DATA_BITS   Data.Bits
-#define DATA_INT    Data.Int
-#define DATA_WORD   Data.Word
-#define UNSAFE_IO   System.IO.Unsafe
-#define TRACE       Debug.Trace
-#define DATA_IOREF  Data.IORef
-#define FIX_IO      System.IO
-#define MONAD_ST    Control.Monad.ST
-#define ST_ARRAY    Data.Array.ST
-
-#else
-
-#define CONCURRENT  Concurrent
-#define EXCEPTION   Exception
-#define DYNAMIC     Dynamic
-#define GLAEXTS     GlaExts
-#define DATA_BITS   Bits
-#define DATA_INT    Int
-#define DATA_WORD   Word
-#define UNSAFE_IO   IOExts
-#define TRACE       IOExts
-#define DATA_IOREF  IOExts
-#define FIX_IO      IOExts
-#define MONAD_ST    ST
-#define ST_ARRAY    ST
-
-#endif
-
-#ifdef __GLASGOW_HASKELL__
-#define GLOBAL_VAR(name,value,ty)  \
-name = Util.global (value) :: IORef (ty); \
-{-# NOINLINE name #-}
-#endif
-
-#if __GLASGOW_HASKELL__ >= 620
-#define UNBOX_FIELD !!
-#else
-#define UNBOX_FIELD !
-#endif
-
-#define COMMA ,
-
-#ifdef DEBUG
-#define ASSERT(e) if (not (e)) then (assertPanic __FILE__ __LINE__) else
-#define ASSERT2(e,msg) if (not (e)) then (assertPprPanic __FILE__ __LINE__ (msg)) else
-#define WARN( e, msg ) (warnPprTrace (e) __FILE__ __LINE__ (msg))
-#define ASSERTM(mbool) do { bool <- mbool; ASSERT(bool) return () }
-#define ASSERTM2(mbool,msg) do { bool <- mbool; ASSERT2(bool,msg) return () }
-#else
-#define ASSERT(e)      if False then error "ASSERT"  else
-#define ASSERT2(e,msg) if False then error "ASSERT2" else
-#define ASSERTM(e)
-#define ASSERTM2(e,msg)
-#define WARN(e,msg)    if False then error "WARN"    else
-#endif
-
--- This #ifndef lets us switch off the "import FastString"
--- when compiling FastString itself
-#ifndef COMPILING_FAST_STRING
--- 
-import qualified FastString as FS 
-#endif
-
-#define SLIT(x)	 (FS.mkLitString# (x#))
-#define FSLIT(x) (FS.mkFastString# (x#))
-
--- Useful for declaring arguments to be strict
-#define STRICT1(f) f a b c | a `seq` False = undefined
-#define STRICT2(f) f a b | a `seq` b `seq` False = undefined
-#define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined
-#define STRICT4(f) f a b c d | a `seq` b `seq` c `seq` d `seq` False = undefined
-#define STRICT5(f) f a b c d e | a `seq` b `seq` c `seq` d `seq` e `seq` False = undefined
-#define STRICT6(f) f a b c d e f | a `seq` b `seq` c `seq` d `seq` e `seq` f `seq` False = undefined
-
-#endif /* HsVersions.h */
-
diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile
deleted file mode 100644
index c1819f2cd2..0000000000
--- a/ghc/compiler/Makefile
+++ /dev/null
@@ -1,835 +0,0 @@
-# -----------------------------------------------------------------------------
-# Main ghc/compiler Makefile
-
-# Targets:
-#
-#	all	builds stage1 compiler
-#
-#	boot stage=N   generate build dirs and dependencies for stage N.
-#		       NB. Must be done before 'make stageN'.
-#		       NB. Cannot 'make boot stage=2' until stage1 has
-#		           been built (similarly for stage3).
-#
-#	stage1  (or stage=1) builds stage1 compiler
-#	stage2  (or stage=2) builds stage2 compiler
-#	stage3  (or stage=3) builds stage3 compiler
-#
-
-TOP = ..
-
-# Use GHC for compiling C bits (NB. must be before boilerplate include)
-#
-UseGhcForCc = YES
-
-include $(TOP)/mk/boilerplate.mk
-
-#-----------------------------------------------------------------------------
-# Counting source code lines
-
-USER_SRCS = $(filter-out $(DERIVED_SRCS),$(SRCS))
-count :
-	./count_lines $(USER_SRCS)
-
-#-----------------------------------------------------------------------------
-# Building ghc different ways (default is just `normal' sequential)
-
-WAYS=$(GhcCompilerWays)
-
-# -----------------------------------------------------------------------------
-# Bootstrapping
-
-# The stage1/stage2/stage3 business is quite delicate.  Here's how it works:
-# 
-#  - the variable $(stage) holds the current stage number.  To build a 
-#    particular stage, you say 'make stage=N' where N is 1, 2, or 3.
-#    N defaults to 1.
-#
-#  - for stage N, object files and .hi files are placed inside 
-#    the directory stageN, in subdirectories as per the sources.
-#
-#  - .hi-boot files are *linked* into the stageN tree, because in GHC 5.05+
-#    the .hi-boot file must reside in the same place as the .hi file.
-#
-#  - we use explicit -o and -ohi options to direct the output from C & 
-#    Haskell compilations.
-#
-#  - we generate a different .depend file for each build.  They need to be
-#    different, because each stage might include different files: stage1
-#    might not include GHCi, for example.  For each stage, a normal .depend
-#    file is generated, and then post-processed to add the correct stageN/
-#    prefix to each object and .hi filename.  The resulting .depend file
-#    is named .depend-$(stage).  See the end of this Makefile for details.
-#
-#  - normal implicit rules don't work any more, because they're of the form
-#
-#        %.o : %.hs 
-#
-#    whereas we really need 
-#
-#	 stageN/%.o : %.hs
-#
-#    so suffix.mk now defines the appropriate suffix rules when
-#    $(odir) is set to a non-empty value.  Here we set $(odir) to
-#    stage1, stage2, or stage3.
-#
-#  There are other plausible designs that might work, but each has different
-#  problems:
-#
-#  - using -odir and -hidir: GHC <= 4.08 doesn't support -hidir, and
-#    anyway -odir puts all the objects in one directory (strips off the
-#    subdirectory part), which eventually forces us to use VPATH to find
-#    the sources.  I have a really bad feeling about VPATH.
-#
-#  - invoke make in the stageN subdirectory.  This probably requires VPATH
-#    too.
-#
-#  - create a link tree.  The problem with requiring link trees is that 
-#    Windows doesn't support symbolic links.
-
-ifeq "$(stage)" ""
-stage=1
-endif
-
-.DUMMY: stage_dir
-stage_dirs :
-	$(MKDIRHIER) stage$(stage)
-	for i in $(ALL_DIRS); do \
-	    $(MKDIRHIER) stage$(stage)/$$i; \
-	done
-
-ifeq "$(stage) $(ghc_ge_603)" "1 YES"
-UsingHsBoot = YES
-else
-ifneq "$(findstring $(stage), 2 3)" ""
-UsingHsBoot = YES
-else
-UsingHsBoot = NO
-endif
-endif
-
-boot :: stage_dirs
-# On Windows, we can't use symbolic links for the -hi-boot files
-# because GHC itself is a Mingw program and does not understand
-# symbolic links.  So we have to copy the files instead of link them.
-# That means that if you modify a .hi-boot file in Windows, you
-# have to to say 'make boot' again.
-#
-# PS: 'ln -s foo baz' takes 'foo' relative to the path to 'baz'
-#     whereas 'cp foo baz' treats the two paths independently.
-#     Hence the "../.." in the ln command line
-ifeq "$(UsingHsBoot)" "NO"
-ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-	for i in */*hi-boot*; do \
-	    cp -u -f $$i stage$(stage)/$$i; \
-	done
-else
-	for i in */*hi-boot*; do \
-	    $(LN_S) -f ../../$$i stage$(stage)/$$i || true ; \
-	done
-endif
-endif
-
-ifeq "$(stage)" "1"
-HC=$(GHC)
-endif
-
-ifeq "$(stage)" "2"
-HC=$(GHC_STAGE1)
-endif
-
-ifeq "$(stage)" "3"
-HC=$(GHC_STAGE2)
-endif
-
-stage1 ::
-	$(MAKE) stage=1
-
-stage2 ::
-	$(MAKE) stage=2
-
-stage3 ::
-	$(MAKE) stage=3
-
-odir=stage$(stage)
-
-SRC_HC_OPTS += $(patsubst %, -i$(odir)/%, $(ALL_DIRS))
-
-HS_OBJS = $(patsubst %, $(odir)/%, $(addsuffix .$(way_)o,$(basename $(HS_SRCS))))
-C_OBJS = $(patsubst %, $(odir)/%, $(addsuffix .$(way_)o,$(basename $(C_SRCS))))
-
-# Our standard cleaning rules don't know that we're doing our output
-# into $(odir), so we have to augment CLEAN_FILES appropriateliy.
-
-CLEAN_FILES += $(odir)/*/*.hi $(odir)/*/*.hi-boot $(odir)/*/*.o-boot
-
-ifeq "$(UsingHsBoot)" "YES"
-CLEAN_FILES += $(odir)/*/*.hi-boot $(odir)/*/*.o-boot
-endif
-
-ifeq "$(stage)" "1"
-mostlyclean clean distclean maintainer-clean ::
-	$(MAKE) $@ stage=2
-	$(MAKE) $@ stage=3
-endif
-
-# -----------------------------------------------------------------------------
-#		Set HS_PROG
-
-# Note: there have been reports of people running up against the ARG_MAX limit
-# when linking ghc with all its constituent object files. The likely source of 
-# the problem is that the environment is a bit too big, so a workaround could
-# be to do `env PATH=$(PATH) make ghc' to minimise the environment. (or the
-# equivalent of `env' if it doesn't exist locally).
-#
-ifneq "$(way)" "dll"
-ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-HS_PROG=$(odir)/ghc$(_way)-$(ProjectVersion)
-else
-HS_PROG=$(odir)/ghc$(_way)
-endif
-else
-HS_PROG=$(odir)/ghc-$(ProjectVersion)
-endif
-
-# -----------------------------------------------------------------------------
-# Create compiler configuration
-#
-# The 'echo' commands simply spit the values of various make variables
-# into Config.hs, whence they can be compiled and used by GHC itself
-
-CONFIG_HS 	= main/Config.hs
-boot :: $(CONFIG_HS)
-
-$(CONFIG_HS) : $(FPTOOLS_TOP)/mk/config.mk Makefile
-	@$(RM) -f $(CONFIG_HS)
-	@echo "Creating $(CONFIG_HS) ... "
-	@echo "module Config where" >>$(CONFIG_HS)
-	@echo "cProjectName          = \"$(ProjectName)\"" >> $(CONFIG_HS)
-	@echo "cProjectVersion       = \"$(ProjectVersion)\"" >> $(CONFIG_HS)
-	@echo "cProjectVersionInt    = \"$(ProjectVersionInt)\"" >> $(CONFIG_HS)
-	@echo "cProjectPatchLevel    = \"$(ProjectPatchLevel)\"" >> $(CONFIG_HS)
-	@echo "cBooterVersion        = \"$(GhcVersion)\"" >> $(CONFIG_HS)
-	@echo "cHscIfaceFileVersion  = \"$(HscIfaceFileVersion)\"" >> $(CONFIG_HS)
-	@echo "cGhcWithNativeCodeGen = \"$(GhcWithNativeCodeGen)\"" >> $(CONFIG_HS)
-	@echo "cGhcUnregisterised    = \"$(GhcUnregisterised)\"" >> $(CONFIG_HS)
-	@echo "cLeadingUnderscore    = \"$(LeadingUnderscore)\"" >> $(CONFIG_HS)
-	@echo "cRAWCPP_FLAGS         = \"$(RAWCPP_FLAGS)\"" >> $(CONFIG_HS)
-	@echo "cGCC                  = \"$(WhatGccIsCalled)\"" >> $(CONFIG_HS)
-	@echo "cMKDLL                = \"$(BLD_DLL)\"" >> $(CONFIG_HS)
-	@echo "cLdIsGNULd            = \"$(LdIsGNULd)\"" >> $(CONFIG_HS)
-	@echo "cLD_X		     = \"$(LD_X)\"" >> $(CONFIG_HS)
-	@echo "cPROJECT_DIR          = \"$(PROJECT_DIR)\"" >> $(CONFIG_HS)
-	@echo "cGHC_DRIVER_DIR_REL   = \"$(GHC_DRIVER_DIR_REL)\"" >> $(CONFIG_HS)
-	@echo "cGHC_TOUCHY_PGM       = \"$(GHC_TOUCHY_PGM)\"" >> $(CONFIG_HS)
-	@echo "cGHC_TOUCHY_DIR_REL   = \"$(GHC_TOUCHY_DIR_REL)\"" >> $(CONFIG_HS)
-	@echo "cGHC_UNLIT_PGM        = \"$(GHC_UNLIT_PGM)\"" >> $(CONFIG_HS)
-	@echo "cGHC_UNLIT_DIR_REL    = \"$(GHC_UNLIT_DIR_REL)\"" >> $(CONFIG_HS)
-	@echo "cGHC_MANGLER_PGM      = \"$(GHC_MANGLER_PGM)\"" >> $(CONFIG_HS)
-	@echo "cGHC_MANGLER_DIR_REL  = \"$(GHC_MANGLER_DIR_REL)\"" >> $(CONFIG_HS)
-	@echo "cGHC_SPLIT_PGM        = \"$(GHC_SPLIT_PGM)\"" >> $(CONFIG_HS)
-	@echo "cGHC_SPLIT_DIR_REL    = \"$(GHC_SPLIT_DIR_REL)\"" >> $(CONFIG_HS)
-	@echo "cGHC_SYSMAN_PGM       = \"$(GHC_SYSMAN)\"" >> $(CONFIG_HS)
-	@echo "cGHC_SYSMAN_DIR_REL   = \"$(GHC_SYSMAN_DIR)\"" >> $(CONFIG_HS)
-	@echo "cGHC_CP               = \"$(GHC_CP)\"" >> $(CONFIG_HS)
-	@echo "cGHC_PERL             = \"$(GHC_PERL)\"" >> $(CONFIG_HS)
-ifeq ($(GhcWithIlx),YES)
-	@echo "cILX2IL               = \"$(ILX2IL)\"" >> $(CONFIG_HS)
-	@echo "cILASM                = \"$(ILASM)\"" >> $(CONFIG_HS)
-endif
-	@echo "cEnableWin32DLLs      = \"$(EnableWin32DLLs)\"" >> $(CONFIG_HS)
-	@echo "cCONTEXT_DIFF         = \"$(CONTEXT_DIFF)\"" >> $(CONFIG_HS)
-	@echo "cUSER_WAY_NAMES       = \"$(USER_WAY_NAMES)\"" >> $(CONFIG_HS)
-	@echo "cUSER_WAY_OPTS        = \"$(USER_WAY_OPTS)\"" >> $(CONFIG_HS)
-	@echo "cDEFAULT_TMPDIR       = \"$(DEFAULT_TMPDIR)\"" >> $(CONFIG_HS)
-	@echo done.
-
-CLEAN_FILES += $(CONFIG_HS)
-
-# -----------------------------------------------------------------------------
-# Create platform includes
-
-# Here we generate a little header file containing CPP symbols that GHC
-# uses to determine which platform it is building on/for.  The platforms
-# can differ between stage1 and stage2 if we're cross-compiling, so we
-# need one of these header files per stage.
-
-PLATFORM_H = ghc_boot_platform.h
-
-stage1/$(PLATFORM_H) : stage_dirs $(FPTOOLS_TOP)/mk/config.mk Makefile
-	@echo "Creating $@..."
-	@$(RM) $@
-	@echo "#ifndef __PLATFORM_H__"  >$@
-	@echo "#define __PLATFORM_H__" >>$@
-	@echo >> $@
-	@echo "#define BuildPlatform_NAME  \"$(BUILDPLATFORM)\"" >> $@
-	@echo "#define HostPlatform_NAME   \"$(HOSTPLATFORM)\"" >> $@
-	@echo "#define TargetPlatform_NAME \"$(TARGETPLATFORM)\"" >> $@
-	@echo >> $@
-	@echo "#define $(BuildPlatform_CPP)_BUILD  	1" >> $@
-	@echo "#define $(HostPlatform_CPP)_HOST		1" >> $@
-	@echo "#define $(TargetPlatform_CPP)_TARGET	1" >> $@
-	@echo >> $@
-	@echo "#define $(BuildArch_CPP)_BUILD_ARCH  	1" >> $@
-	@echo "#define $(HostArch_CPP)_HOST_ARCH	1" >> $@
-	@echo "#define $(TargetArch_CPP)_TARGET_ARCH	1" >> $@
-	@echo "#define BUILD_ARCH \"$(BuildArch_CPP)\"" >> $@
-	@echo "#define HOST_ARCH \"$(HostArch_CPP)\"" >> $@
-	@echo "#define TARGET_ARCH \"$(TargetArch_CPP)\"" >> $@
-	@echo >> $@
-	@echo "#define $(BuildOS_CPP)_BUILD_OS 		1" >> $@
-	@echo "#define $(HostOS_CPP)_HOST_OS		1" >> $@
-	@echo "#define $(TargetOS_CPP)_TARGET_OS	1" >> $@  
-	@echo "#define BUILD_OS \"$(BuildOS_CPP)\"" >> $@
-	@echo "#define HOST_OS \"$(HostOS_CPP)\"" >> $@
-	@echo "#define TARGET_OS \"$(TargetOS_CPP)\"" >> $@
-ifeq "$(HostOS_CPP)" "irix"
-	@echo "#ifndef $(IRIX_MAJOR)_TARGET_OS		 " >> $@  
-	@echo "#define $(IRIX_MAJOR)_TARGET_OS		1" >> $@  
-	@echo "#endif					 " >> $@  
-endif
-	@echo >> $@
-	@echo "#define $(BuildVendor_CPP)_BUILD_VENDOR 	1" >> $@
-	@echo "#define $(HostVendor_CPP)_HOST_VENDOR	1" >> $@
-	@echo "#define $(TargetVendor_CPP)_TARGET_VENDOR  1" >> $@
-	@echo "#define BUILD_VENDOR \"$(BuildVendor_CPP)\"" >> $@
-	@echo "#define HOST_VENDOR \"$(HostVendor_CPP)\"" >> $@
-	@echo "#define TARGET_VENDOR \"$(TargetVendor_CPP)\"" >> $@
-	@echo >> $@
-	@echo "#endif /* __PLATFORM_H__ */"          >> $@
-	@echo "Done."
-
-# For stage2 and above, the BUILD platform is the HOST of stage1, and
-# the HOST platform is the TARGET of stage1.  The TARGET remains the same
-# (stage1 is the cross-compiler, not stage2).
-stage2/$(PLATFORM_H) : stage_dirs $(FPTOOLS_TOP)/mk/config.mk Makefile
-	@echo "Creating $@..."
-	@$(RM) $@
-	@echo "#ifndef __PLATFORM_H__"  >$@
-	@echo "#define __PLATFORM_H__" >>$@
-	@echo >> $@
-	@echo "#define BuildPlatform_NAME  \"$(HOSTPLATFORM)\"" >> $@
-	@echo "#define HostPlatform_NAME   \"$(TARGETPLATFORM)\"" >> $@
-	@echo "#define TargetPlatform_NAME \"$(TARGETPLATFORM)\"" >> $@
-	@echo >> $@
-	@echo "#define $(HostPlatform_CPP)_BUILD  	1" >> $@
-	@echo "#define $(TargetPlatform_CPP)_HOST		1" >> $@
-	@echo "#define $(TargetPlatform_CPP)_TARGET	1" >> $@
-	@echo >> $@
-	@echo "#define $(HostArch_CPP)_BUILD_ARCH  	1" >> $@
-	@echo "#define $(TargetArch_CPP)_HOST_ARCH	1" >> $@
-	@echo "#define $(TargetArch_CPP)_TARGET_ARCH	1" >> $@
-	@echo "#define BUILD_ARCH \"$(HostArch_CPP)\"" >> $@
-	@echo "#define HOST_ARCH \"$(TargetArch_CPP)\"" >> $@
-	@echo "#define TARGET_ARCH \"$(TargetArch_CPP)\"" >> $@
-	@echo >> $@
-	@echo "#define $(HostOS_CPP)_BUILD_OS 		1" >> $@
-	@echo "#define $(TargetOS_CPP)_HOST_OS		1" >> $@
-	@echo "#define $(TargetOS_CPP)_TARGET_OS	1" >> $@  
-	@echo "#define BUILD_OS \"$(HostOS_CPP)\"" >> $@
-	@echo "#define HOST_OS \"$(TargetOS_CPP)\"" >> $@
-	@echo "#define TARGET_OS \"$(TargetOS_CPP)\"" >> $@
-ifeq "$(HostOS_CPP)" "irix"
-	@echo "#ifndef $(IRIX_MAJOR)_TARGET_OS		 " >> $@  
-	@echo "#define $(IRIX_MAJOR)_TARGET_OS		1" >> $@  
-	@echo "#endif					 " >> $@  
-endif
-	@echo >> $@
-	@echo "#define $(HostVendor_CPP)_BUILD_VENDOR 	1" >> $@
-	@echo "#define $(TargetVendor_CPP)_HOST_VENDOR	1" >> $@
-	@echo "#define $(TargetVendor_CPP)_TARGET_VENDOR  1" >> $@
-	@echo "#define BUILD_VENDOR \"$(HostVendor_CPP)\"" >> $@
-	@echo "#define HOST_VENDOR \"$(TargetVendor_CPP)\"" >> $@
-	@echo "#define TARGET_VENDOR \"$(TargetVendor_CPP)\"" >> $@
-	@echo >> $@
-	@echo "#endif /* __PLATFORM_H__ */"          >> $@
-	@echo "Done."
-
-stage3/$(PLATFORM_H) : stage_dirs stage2/$(PLATFORM_H)
-	$(CP) stage2/$(PLATFORM_H) stage3/$(PLATFORM_H)
-
-STAGE_PLATFORM_H = stage$(stage)/$(PLATFORM_H)
-
-boot :: $(STAGE_PLATFORM_H)
-
-SRC_HC_OPTS += -Istage$(stage)
-
-# -----------------------------------------------------------------------------
-# Set SRCS etc.
-#
-# First figure out ALL_DIRS, the source sub-directories
-
-ALL_DIRS = \
-  utils basicTypes types hsSyn prelude rename typecheck deSugar coreSyn \
-  specialise simplCore stranal stgSyn simplStg codeGen main \
-  profiling parser cprAnalysis ndpFlatten iface cmm
-
-# Make sure we include Config.hs even if it doesn't exist yet...
-ALL_SRCS += $(CONFIG_HS)
-
-# HsGeneric.hs is not used just now
-EXCLUDED_SRCS += hsSyn/HsGeneric.hs
-
-ifeq ($(GhcWithNativeCodeGen),YES)
-ALL_DIRS += nativeGen
-else
-SRC_HC_OPTS += -DOMIT_NATIVE_CODEGEN
-endif
-
-ifeq ($(GhcWithIlx),YES)
-ALL_DIRS += ilxGen
-SRC_HC_OPTS += -DILX
-endif
-
-ifeq ($(GhcWithJavaGen),YES)
-ALL_DIRS += javaGen
-SRC_HC_OPTS += -DJAVA
-endif
-
-ifeq "$(BootingFromHc)" "YES"
-# HC files are always from a self-booted compiler
-bootstrapped = YES
-else
-ifneq "$(findstring $(stage), 2 3)" ""
-bootstrapped = YES
-else
-bootstrapped = $(shell if (test $(GhcCanonVersion) -eq $(ProjectVersionInt) -a $(GhcPatchLevel) -eq $(ProjectPatchLevel)); then echo YES; else echo NO; fi)
-endif
-endif
-
-# -----------------------------------------------------------------------------
-# Building a compiler with interpreter support
-#
-# The interpreter, GHCi interface, and Template Haskell are only
-# enabled when we are bootstrapping with the same version of GHC, and
-# the interpreter is supported on this platform.
-
-ifeq "$(GhcWithInterpreter) $(bootstrapped)" "YES YES"
-
-# Yes, include the interepreter, readline, and Template Haskell extensions
-SRC_HC_OPTS += -DGHCI -package template-haskell
-PKG_DEPENDS += template-haskell
-
-# Use threaded RTS with GHCi, so threads don't get blocked at the prompt.
-SRC_HC_OPTS += -threaded
-
-ALL_DIRS += ghci
-
-# If we are going to use dynamic libraries instead of .o files for ghci,
-# we will need to always retain CAFs in the compiler.
-# ghci/keepCAFsForGHCi contains a GNU C __attribute__((constructor))
-# function which sets the keepCAFs flag for the RTS before any Haskell
-# code is run.
-ifeq "$(GhcBuildDylibs)" "YES"
-else
-EXCLUDED_SRCS += ghci/keepCAFsForGHCi.c
-endif
-
-# Enable readline if either:
-#   - we're building stage 1 and $(GhcHasReadline)="YES"
-#   - we're building stage 2/3, and we have built the readline package
-#
-# But we don't enable readline on Windows, because readline is fairly
-# broken there.
-#
-ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-ifeq "$(stage)" "1"
-ifeq "$(GhcHasReadline)" "YES"
-SRC_HC_OPTS += -package readline -DUSE_READLINE
-PKG_DEPENDS += readline
-endif
-else
-ifeq "$(GhcLibsWithReadline)" "YES"
-SRC_HC_OPTS += -package readline -DUSE_READLINE
-PKG_DEPENDS += readline
-endif
-endif # stage=1
-endif # not windows
-
-else
-
-# No interpreter, so exclude Template Haskell modules
-EXCLUDED_SRCS += deSugar/DsMeta.hs typecheck/TcSplice.lhs hsSyn/Convert.lhs
-
-endif # bootstrapped with interpreter
-
-# -----------------------------------------------
-# mkdependC stuff
-#
-# Big Fudge to get around inherent problem that Makefile setup
-# has got with 'mkdependC'.
-# 
-SRC_MKDEPENDC_OPTS += -D__GLASGOW_HASKELL__=$(ProjectVersionInt)
-
-# XXX not really correct, hschooks.c actually gets include files like
-# RtsFlags.c from the installed GHC, but we can't tell mkdependC about that.
-SRC_MKDEPENDC_OPTS += -I$(GHC_INCLUDE_DIR)
-
-# -----------------------------------------------------------------------------
-# 		Haskell compilations
-
-SRC_HC_OPTS += \
-  -cpp -fglasgow-exts -fno-generics -Rghc-timing \
-  -I. -IcodeGen -InativeGen -Iparser
-
-# Omitted: 	-I$(GHC_INCLUDE_DIR)
-# We should have -I$(GHC_INCLUDE_DIR) in SRC_HC_OPTS, 
-# to avoid the use of an explicit path in GHC source files
-#	(include "../includes/config.h"
-# But alas GHC 4.08 (and others for all I know) uses this very
-# same include path when compiling the .hc files it generates.
-# Disaster!  Then the hc file sees the GHC 5.02 (or whatever)
-# include files.   For the moment we've reverted to using
-# an explicit path in the .hs sources
-#
-# For the benefit of <5.00 compilers, do include GHC_INCLUDE_DIR
-# when generating dependencies. (=> it gets passed onto mkdependHS,
-# which needs it).
-SRC_MKDEPENDHS_OPTS += -I$(GHC_INCLUDE_DIR)
-
-# We need System.Posix (or Posix when ghc < 6.2)
-ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-ifeq "$(bootstrapped) $(ghc_ge_601)" "NO NO"
-SRC_HC_OPTS += -package posix
-else
-SRC_HC_OPTS += -package unix
-PKG_DEPENDS += unix
-endif
-endif
-
-# We use the Cabal package in stages 2/3 only; in stage 1 we're using
-# the libcompat library which provides the Cabal modules.
-ifneq "$(stage)" "1"
-SRC_HC_OPTS += -package Cabal
-PKG_DEPENDS += Cabal
-endif
-
-ifeq "$(ghc_ge_603)" "YES"
-# Ignore lang, to avoid potential clash with the Generics module if
-# lang happens to be a dependency of some exposed package in the local
-# GHC installation (eg. wxHaskell did this around 6.4).
-SRC_HC_OPTS += -ignore-package lang
-endif
-
-SRC_CC_OPTS += -Iparser -I. -O
-SRC_HC_OPTS += -recomp $(GhcHcOpts) $(GhcStage$(stage)HcOpts)
-SRC_HC_OPTS += -H16M
-
-ifeq "$(BootingFromHc)" "YES"
-SRC_CC_OPTS += -D__GLASGOW_HASKELL__=$(ProjectVersionInt)
-endif
-
-# 	Special flags for particular modules
-#	The standard suffix rule for compiling a Haskell file
-#	adds these flags to the command line
-
-# There used to be a -no-recomp flag on PrimOp, but why?
-# It's an expensive module to recompile!
-prelude/PrimOp_HC_OPTS 		= -H80m
-
-
-main/ParsePkgConf_HC_OPTS	+= -fno-warn-incomplete-patterns
-parser/Parser_HC_OPTS 		+= -fno-warn-incomplete-patterns
-
-ifeq "$(ghc_ge_603)" "NO"
-# Use -fvia-C since the NCG can't handle the narrow16Int# (and intToInt16#?)
-# primops on all platforms.
-parser/Parser_HC_OPTS		+= -fvia-C
-# because the NCG can't handle the 64-bit math in here
-prelude/PrelRules_HC_OPTS	+= -fvia-C
-# ByteCodeItbls uses primops that the NCG doesn't support.
-ghci/ByteCodeItbls_HC_OPTS	+= -fvia-C
-ghci/ByteCodeLink_HC_OPTS	+= -fvia-C -monly-3-regs
-endif
-
-# Careful optimisation of the parser: we don't want to throw everything
-# at it, because that takes too long and doesn't buy much, but we do want
-# to inline certain key external functions, so we instruct GHC not to
-# throw away inlinings as it would normally do in -Onot mode:
-parser/Parser_HC_OPTS		+= -Onot -fno-ignore-interface-pragmas
-
-ifeq "$(HOSTPLATFORM)" "hppa1.1-hp-hpux9"
-rename/RnMonad_HC_OPTS 		=  -O2 -O2-for-C
-endif
-
-utils/Digraph_HC_OPTS		= -fglasgow-exts 
-
-basicTypes/SrcLoc_HC_OPTS	= -funbox-strict-fields
-
-ifeq "$(bootstrapped)" "YES"
-utils/Binary_HC_OPTS		= -funbox-strict-fields
-endif
-
-# We always optimise some low-level modules, otherwise performance of
-# a non-optimised compiler is severely affected.
-main/BinIface_HC_OPTS		+= -O
-utils/Binary_HC_OPTS		+= -O
-utils/FastMutInt_HC_OPTS	+= -O
-utils/Encoding_HC_OPTS		+= -O
-utils/StringBuffer_HC_OPTS	+= -O
-utils/FastString_HC_OPTS	+= -O
-
-# ---- Profiling ----
-#simplCore/Simplify_HC_OPTS = -auto-all
-#simplCore/SimplEnv_HC_OPTS = -auto-all
-#simplCore/SimplUtils_HC_OPTS = -auto-all
-
-# CSE interacts badly with top-level IORefs (reportedly in DriverState and
-# DriverMkDepend), causing some of them to be commoned up.  We have a fix for
-# this in 5.00+, but earlier versions of the compiler will need CSE turned off.
-# To be on the safe side, we disable CSE in *all* modules with top-level IORefs.
-ghci/InteractiveUI_HC_OPTS	= -fno-cse
-main/CmdLineOpts_HC_OPTS	= -fno-cse
-main/DriverMkDepend_HC_OPTS	= -fno-cse
-main/DriverPipeline_HC_OPTS	= -fno-cse
-main/Finder_HC_OPTS		= -fno-cse
-main/SysTools_HC_OPTS		= -fno-cse
-main/StaticFlags_HC_OPTS	= -fno-cse
-
-# The #include is vital for the via-C route, else the C
-# compiler doesn't realise that the stcall foreign imports are indeed
-# stdcall, and doesn't generate the Foo@8 name for them
-ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-main/SysTools_HC_OPTS		+= '-\#include <windows.h>' '-\#include <process.h>'
-endif
-
-parser/Lexer_HC_OPTS += -funbox-strict-fields
-
-# ghc_strlen percolates through so many modules that it is easier to get its
-# prototype via a global option instead of a myriad of per-file OPTIONS
-SRC_HC_OPTS += '-\#include "hschooks.h"'
-
-# ----------------------------------------------------------------------------
-#		Generate supporting stuff for prelude/PrimOp.lhs 
-#		from prelude/primops.txt
-
-GENPOC=$(TOP)/utils/genprimopcode/genprimopcode
-
-PRIMOP_BITS=primop-data-decl.hs-incl \
-            primop-tag.hs-incl  \
-            primop-list.hs-incl  \
-            primop-has-side-effects.hs-incl  \
-            primop-out-of-line.hs-incl  \
-            primop-commutable.hs-incl  \
-            primop-needs-wrapper.hs-incl  \
-            primop-can-fail.hs-incl  \
-            primop-strictness.hs-incl  \
-            primop-primop-info.hs-incl
-
-CLEAN_FILES += prelude/primops.txt
-CLEAN_FILES += $(PRIMOP_BITS)
-
-SRC_CPP_OPTS += -I$(GHC_INCLUDE_DIR)
-SRC_CPP_OPTS += ${GhcCppOpts}
-
-ifneq "$(BootingFromHc)" "YES"
-prelude/PrimOp.lhs $(odir)/prelude/PrimOp.o: $(PRIMOP_BITS)
-endif
-
-ifneq "$(BootingFromHc)" "YES"
-depend :: $(PRIMOP_BITS)
-endif
-
-primop-data-decl.hs-incl: prelude/primops.txt
-	$(GENPOC) --data-decl          < $< > $@
-primop-tag.hs-incl: prelude/primops.txt
-	$(GENPOC) --primop-tag         < $< > $@
-primop-list.hs-incl: prelude/primops.txt
-	$(GENPOC) --primop-list        < $< > $@
-primop-has-side-effects.hs-incl: prelude/primops.txt
-	$(GENPOC) --has-side-effects   < $< > $@
-primop-out-of-line.hs-incl: prelude/primops.txt
-	$(GENPOC) --out-of-line        < $< > $@
-primop-commutable.hs-incl: prelude/primops.txt
-	$(GENPOC) --commutable         < $< > $@
-primop-needs-wrapper.hs-incl: prelude/primops.txt
-	$(GENPOC) --needs-wrapper      < $< > $@
-primop-can-fail.hs-incl: prelude/primops.txt
-	$(GENPOC) --can-fail           < $< > $@
-primop-strictness.hs-incl: prelude/primops.txt
-	$(GENPOC) --strictness         < $< > $@
-primop-primop-info.hs-incl: prelude/primops.txt
-	$(GENPOC) --primop-primop-info < $< > $@
-
-# Usages aren't used any more; but the generator 
-# can still generate them if we want them back
-primop-usage.hs-incl: prelude/primops.txt
-	$(GENPOC) --usage              < $< > $@
-
-
-#-----------------------------------------------------------------------------
-# 		Linking
-
-# Include libghccompat in stage1 only.  In stage2 onwards, all these
-# libraries will be available from the main libraries.
-
-ifeq "$(stage)" "1"
-include $(GHC_LIB_COMPAT_DIR)/compat.mk
-endif
-
-SRC_LD_OPTS += -no-link-chk
-
-# -----------------------------------------------------------------------------
-# create ghc-inplace, a convenient way to run ghc from the build tree...
-
-all :: $(odir)/ghc-inplace ghc-inplace
-
-$(odir)/ghc-inplace : $(HS_PROG)
-	@$(RM) $@
-	echo '#!/bin/sh' >>$@
-	echo exec $(FPTOOLS_TOP_ABS)/ghc/compiler/$(HS_PROG) '-B$(subst \,\\,$(FPTOOLS_TOP_ABS_PLATFORM))' '"$$@"' >>$@
-	chmod 755 $@
-
-ghc-inplace : stage1/ghc-inplace
-	$(LN_S) -f $< $@
-
-ifeq "$(stage)" "1"
-CLEAN_FILES += ghc-inplace
-endif
-
-CLEAN_FILES += $(odir)/ghc-inplace
-
-#-----------------------------------------------------------------------------
-# 		install
-
-# We don't want ghc treated as an ordinary executable,
-# but put it together with the libraries.
-# Also don't want any interface files installed
-
-DESTDIR = $(INSTALL_LIBRARY_DIR_GHC)
-
-ifneq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-INSTALL_LIBEXECS += $(HS_PROG)
-else
-INSTALL_PROGS += $(HS_PROG)
-endif
-
-# ----------------------------------------------------------------------------
-# profiling.
-
-# rename/RnBinds_HC_OPTS += -auto-all
-# rename/RnEnv_HC_OPTS += -auto-all
-# rename/RnExpr_HC_OPTS += -auto-all
-# rename/RnHiFiles_HC_OPTS += -auto-all
-# rename/RnHsSyn_HC_OPTS += -auto-all
-# rename/Rename_HC_OPTS += -auto-all
-# rename/RnIfaces_HC_OPTS += -auto-all
-# rename/RnNames_HC_OPTS += -auto-all
-# rename/RnSource_HC_OPTS += -auto-all
-# rename/RnTypes_HC_OPTS += -auto-all
-# 
-# typecheck/Inst_HC_OPTS += -auto-all
-# typecheck/TcBinds_HC_OPTS += -auto-all
-# typecheck/TcClassDcl_HC_OPTS += -auto-all
-# typecheck/TcDefaults_HC_OPTS += -auto-all
-# typecheck/TcDeriv_HC_OPTS += -auto-all
-# typecheck/TcEnv_HC_OPTS += -auto-all
-# typecheck/TcExpr_HC_OPTS += -auto-all
-# typecheck/TcForeign_HC_OPTS += -auto-all
-# typecheck/TcGenDeriv_HC_OPTS += -auto-all
-# typecheck/TcHsSyn_HC_OPTS += -auto-all
-# typecheck/TcIfaceSig_HC_OPTS += -auto-all
-# typecheck/TcInstDcls_HC_OPTS += -auto-all
-# typecheck/TcMatches_HC_OPTS += -auto-all
-# typecheck/TcMonoType_HC_OPTS += -auto-all
-# typecheck/TcMType_HC_OPTS += -auto-all
-# typecheck/TcPat_HC_OPTS += -auto-all
-# typecheck/TcRnDriver_HC_OPTS += -auto-all
-# #typecheck/TcRnMonad_HC_OPTS += -auto-all
-# #typecheck/TcRnTypes_HC_OPTS += -auto-all
-# typecheck/TcRules_HC_OPTS += -auto-all
-# typecheck/TcSimplify_HC_OPTS += -auto-all
-# typecheck/TcSplice_HC_OPTS += -auto-all
-# typecheck/TcTyClsDecls_HC_OPTS += -auto-all
-# typecheck/TcTyDecls_HC_OPTS += -auto-all
-# typecheck/TcType_HC_OPTS += -auto-all
-# typecheck/TcUnify_HC_OPTS += -auto-all
-
-coreSyn/CorePrep_HC_OPTS += -auto-all
-# parser/Parser_HC_OPTS += -fasm
-
-#-----------------------------------------------------------------------------
-# Building the GHC package
-
-# The GHC package is made from the stage 2 build.  Fortunately the
-# package build system framework more or less does the right thing for
-# us here.
-
-ifeq "$(stage)" "2"
-PACKAGE = ghc
-HIERARCHICAL_LIB = NO
-VERSION = $(ProjectVersion)
-PKG_DEPENDS += base haskell98
-PACKAGE_CPP_OPTS += -DPKG_DEPENDS='$(PKG_DEPENDS)'
-
-# Omit Main from the library, the client will want to plug their own Main in
-LIBOBJS = $(filter-out $(odir)/main/Main.o $(odir)/parser/hschooks.o, $(OBJS))
-
-# disable splitting: it won't really help with GHC, and the specialised
-# build system for ghc/compiler isn't set up to handle it.
-SplitObjs = NO
-
-# the package build system likes to set WAYS=$(GhcLibWays), but we don't 
-# really want to build the whole of GHC multiple ways... if you do,
-# set GhcCompilerWays instead.
-GhcLibWays = $(GhcCompilerWays)
-
-# override $(GhcLibHcOpts): we want GhcStage2HcOpts to take precedence
-GhcLibHcOpts =
-
-# override default definition of HS_IFACES so we can add $(odir)
-HS_IFACES   = $(addsuffix .$(way_)hi,$(basename $(HS_OBJS)))
-
-# Haddock can't handle recursive modules currently, so we disable it for now.
-NO_HADDOCK_DOCS = YES
-endif
-
-#-----------------------------------------------------------------------------
-# 		clean
-
-MAINTAINER_CLEAN_FILES += parser/Parser.info main/ParsePkgConf.info
-
-#-----------------------------------------------------------------------------
-# 		Include target-rule boilerplate
-
-# Don't use the default MKDEPENDHS stuff... we'll do our own, below
-MKDEPENDHS_SRCS =
-MKDEPENDC_SRCS =
-
-# Make doesn't work this out for itself, it seems
-parser/Parser.y : parser/Parser.y.pp
-EXTRA_SRCS += parser/Parser.y
-
-
-#-----------------------------------------------------------------------------
-# 		Source files for tags file generation
-#
-# We want to excluded derived sources, because they won't be in the source
-# tree, which is where we are going to move the TAGS file to.a
-
-TAGS_HS_SRCS = parser/Parser.y.pp $(filter-out $(DERIVED_SRCS) main/Config.hs parser/Parser.y, $(sort $(SRCS)))
-
-
-include $(TOP)/mk/target.mk
-
-# -----------------------------------------------------------------------------
-# Dependencies
-
-MKDEPENDHS_HC_OPTS = $(patsubst -i$(odir)/%, -i%, $(HC_OPTS))
-
-MKDEPENDHS=$(HC)
-
-# Must do this *after* including target.mk, because $(HS_SRCS) isn't set yet.
-depend :: $(STAGE_PLATFORM_H) $(HS_SRCS) $(C_SRCS)
-	touch .depend-BASE
-ifneq "$(BootingFromHc)" "YES"
-	$(MKDEPENDHS) -M -optdep-f -optdep.depend-BASE $(foreach way,$(WAYS),-optdep-s -optdep$(way)) $(foreach obj,$(MKDEPENDHS_OBJ_SUFFICES),-osuf $(obj)) $(MKDEPENDHS_OPTS) $(filter-out -split-objs, $(MKDEPENDHS_HC_OPTS)) $(HS_SRCS)
-endif
-	$(MKDEPENDC) -f .depend-BASE $(MKDEPENDC_OPTS) $(foreach way,$(WAYS),-s $(way)) -- $(CC_OPTS) -- $(C_SRCS) 
-	$(PERL) -pe 'binmode(stdin); binmode(stdout); s@^(\S*\.o)@stage$(stage)/$$1@g; s@(\S*\.hi)@stage$(stage)/$$1@g; s@^.*/lib/compat.*$$@@g;' <.depend-BASE >.depend-$(stage)
-# The binmode stuff tells perl not to add stupid ^M's to the output
-#
-# The /lib/compat replacement is to workaround a bug in the
-# -optdep--exclude-module flag in GHC 6.4.  It is not required for any
-# other version of GHC, but doesn't do any harm.
-
--include .depend-$(stage)
diff --git a/ghc/compiler/NOTES b/ghc/compiler/NOTES
deleted file mode 100644
index 8c62750008..0000000000
--- a/ghc/compiler/NOTES
+++ /dev/null
@@ -1,171 +0,0 @@
-
--------------------------
-*** unexpected failure for jtod_circint(opt)
-
-
-	New back end thoughts
-
------------------------------------------------------------------------------
-Codegen notes
-
-* jumps to ImpossibleBranch should be removed.
-
-* Profiling:
-	- when updating a closure with an indirection to a function,
-	  we should make a permanent indirection.
-
-	- check that we're bumping the scc count appropriately
-
-* check perf & binary sizes against the HEAD
-
------------------------------------------------------------------------------
-C backend notes
-
-* use STGCALL macros for foreign calls (doesn't look like volatile regs
-  are handled properly at the mo).
-
------------------------------------------------------------------------------
-Cmm parser notes
-
-* switches
-
-* need to cater for unexported procedures/info tables?
-
-* We should be able to get rid of entry labels, use info labels only.
-  - we need a %ENTRY_LBL(info_lbl) macro, so that instead of
-     JMP_(foo_entry) we can write jump %ENTRY_LBL(foo_info).
-
------------------------------------------------------------------------------
-
-* Move arg-descr from LFInfo to ClosureInfo? 
-  But: only needed for functions
-
-* Move all of CgClosure.link_caf into NewCaf, and newDynCaf
-
-* If the case binder is dead, and the constr is nullary,
-  do we need to assign to Node?
-
-
--------------------------
-* Relation between separate type sigs and pattern type sigs
-f :: forall a. a->a
-f :: b->b = e   -- No: monomorphic
-
-f :: forall a. a->a
-f :: forall a. a->a  -- OK
-
-f :: forall a. [a] -> [a]
-f :: forall b. b->b = e  ???
-
-
--------------------------------
-NB: all floats are let-binds, but some non-rec lets
-    may be unlifted (with RHS ok-for-speculation)
-
-
-simplArg:  [use strictness]
-	   [used for non-top-lvl non-rec RHS or function arg]
-  if strict-type || demanded
-	simplStrictExpr
-  else
-	simplExpr ---> (floats,expr)
-	float all the floats if exposes constr app, return expr
-
-simpl (applied lambda)	    ==> simplNonRecBind
-simpl (Let (NonRec ...) ..) ==> simplNonRecBind
-
-simpl (Let (Rec ...)    ..) ==> simplRecBind
-
-simplRecBind:
-  simplify binders (but not its IdInfo)
-  simplify the pairs one at a time
-	using simplRecPair
-
-simplNonRecBind:	[was simplBeta]
-	[used for non-top-lvl non-rec bindings]
-  - check for PreInlineUnconditionally
-  - simplify binder, including its IdInfo
-  - simplArg
-  - if strict-type 
-	addCaseBind [which makes a let if ok-for-spec]
-    else
-	completeLazyBind
-
-simplLazyBind:	[binder already simplified, but not its IdInfo]
-	  	[used for both rec and top-lvl non-rec]
-		[must not be strict/unboxed; case not allowed]
-  - check for PreInlineUnconditionally
-  - substituteIdInfo and add result to in-scope 
-	[so that rules are available in rec rhs]
-  - simplExpr --> (floats,expr)
-  - float: lifted floats only
-	if exposes constructor or pap (even if non-triv args)
-	or if top level
-  - completeLazyBind
-  
-
-completeLazyBind: 	[given a simplified RHS]
-	[used for both rec and non-rec bindings, top level and not]
-  - try discarding dead
-  - try PostInlineUnconditionally
-  - let-bind coerce arg and repeat
-  - try rhs tylam (float)
-  - try eta expand (float)    [not if any float is unlifted && (non-spec || top_lvl || rec)]
-  - let-bind constructor args [not if any float is ..as above..]
-
-  - add unfolding [this is the only place we add an unfolding]
-    add arity
-
-
-
-Right hand sides and arguments
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In many ways we want to treat 
-	(a) the right hand side of a let(rec), and 
-	(b) a function argument
-in the same way.  But not always!  In particular, we would
-like to leave these arguments exactly as they are, so they
-will match a RULE more easily.
-	
-	f (g x, h x)	
-	g (+ x)
-
-It's harder to make the rule match if we ANF-ise the constructor,
-or eta-expand the PAP:
-
-	f (let { a = g x; b = h x } in (a,b))
-	g (\y. + x y)
-
-On the other hand if we see the let-defns
-
-	p = (g x, h x)
-	q = + x
-
-then we *do* want to ANF-ise and eta-expand, so that p and q
-can be safely inlined.   
-
-Even floating lets out is a bit dubious.  For let RHS's we float lets
-out if that exposes a value, so that the value can be inlined more vigorously.
-For example
-
-	r = let x = e in (x,x)
-
-Here, if we float the let out we'll expose a nice constructor. We did experiments
-that showed this to be a generally good thing.  But it was a bad thing to float
-lets out unconditionally, because that meant they got allocated more often.
-
-For function arguments, there's less reason to expose a constructor (it won't
-get inlined).  Just possibly it might make a rule match, but I'm pretty skeptical.
-So for the moment we don't float lets out of function arguments either.
-
-
-Eta expansion
-~~~~~~~~~~~~~~
-For eta expansion, we want to catch things like
-
-	case e of (a,b) -> \x -> case a of (p,q) -> \y -> r
-
-If the \x was on the RHS of a let, we'd eta expand to bring the two
-lambdas together.  And in general that's a good thing to do.  Perhaps
-we should eta expand wherever we find a (value) lambda?  Then the eta
-expansion at a let RHS can concentrate solely on the PAP case.
diff --git a/ghc/compiler/README b/ghc/compiler/README
deleted file mode 100644
index ca619cdde0..0000000000
--- a/ghc/compiler/README
+++ /dev/null
@@ -1,11 +0,0 @@
-This directory contains the source for Glorious Glasgow Haskell
-compiler proper, normally a binary called "hsc".  The source is
-organized into _one_ level of directories, and the literate Haskell
-source files sit in those directories (i.e., */*.lhs).
-
-The only "real" subdirectory is the tests/ directory [NB: not
-distributed normally, but available to gluttons for punishment], which
-includes some tests that we use to make sure we're not going
-backwards.  The subdirs of the test directory "match" the subdirs of
-the main source directory; e.g., the desugarer is in subdir deSugar/,
-and the tests for the desugarer are in tests/deSugar/.
diff --git a/ghc/compiler/Simon-log b/ghc/compiler/Simon-log
deleted file mode 100644
index 9d60ccc6eb..0000000000
--- a/ghc/compiler/Simon-log
+++ /dev/null
@@ -1,1260 +0,0 @@
-	------------------------------------
-	   GHCI hacking
-	------------------------------------
-
-* Don't forget to put deferred-type-decls back into RnIfaces
-
-* Do we want to record a package name in a .hi file?
-  Does pi_mod have a ModuleName or a Module?
-
-	------------------------------------
-	   Mainly FunDeps (23 Jan 01)
-	------------------------------------
-
-This commit re-engineers the handling of functional dependencies.
-A functional dependency is no longer an Inst; instead, the necessary
-dependencies are snaffled out of their Class when necessary.
-
-As part of this exercise I found that I had to re-work how to do generalisation
-in a binding group.  There is rather exhaustive documentation on the new Plan
-at the top of TcSimplify.
-
-	******************
-	WARNING: I have compiled all the libraries with this new compiler
-		 and all looks well, but I have not run many programs.
-		 Things may break.  Let me know if so.
-	******************
-
-The main changes are these:
-
-1.  typecheck/TcBinds and TcSimplify have a lot of changes due to the 
-    new generalisation and context reduction story.  There are extensive
-    comments at the start of TcSimplify
-
-2.  typecheck/TcImprove is removed altogether.  Instead, improvement is 
-    interleaved with context reduction (until a fixpoint is reached).
-    All this is done in TcSimplify.
-
-3.  types/FunDeps has new exports
-	* 'improve' does improvement, returning a list of equations
-	* 'grow' and 'oclose' close a list of type variables wrt a set of
-	  PredTypes, but in slightly different ways.  Comments in file.
-
-4.  I improved the way in which we check that main::IO t.  It's tidier now.
-
-In addition
-
-*   typecheck/TcMatches: 
-	a) Tidy up, introducing a common function tcCheckExistentialPat
-
-	b) Improve the typechecking of parallel list comprehensions,
-	   which wasn't quite right before.  (see comments with tcStmts)
-
-	WARNING: (b) is untested!  Jeff, you might want to check.
-
-*   Numerous other incidental changes in the typechecker
-
-*   Manuel found that rules don't fire well when you have partial applications
-    from overloading.  For example, we may get
-
-	f a (d::Ord a) = let m_g = g a d
-			 in
-			 \y :: a -> ...(m_g (h y))...
-
-    The 'method' m_g doesn't get inlined because (g a d) might be a redex.
-    Yet a rule that looks like 
-		g a d (h y) = ...
-    won't fire because that doesn't show up.  One way out would be to make
-    the rule matcher a bit less paranoid about duplicating work, but instead
-    I've added a flag
-			-fno-method-sharing
-    which controls whether we generate things like m_g in the first place.
-    It's not clear that they are a win in the first place.
-
-    The flag is actually consulted in Inst.tcInstId
-
-
-
-	------------------------------------
-	   Mainly PredTypes (28 Sept 00)
-	------------------------------------
-
-Three things in this commit:
-
-	1.  Main thing: tidy up PredTypes
-	2.  Move all Keys into PrelNames
-	3.  Check for unboxed tuples in function args
-
-1. Tidy up PredTypes
-~~~~~~~~~~~~~~~~~~~~
-The main thing in this commit is to modify the representation of Types
-so that they are a (much) better for the qualified-type world.  This
-should simplify Jeff's life as he proceeds with implicit parameters
-and functional dependencies.  In particular, PredType, introduced by
-Jeff, is now blessed and dignified with a place in TypeRep.lhs:
-
-	data PredType  = Class  Class [Type]
-		       | IParam Name  Type
-
-Consider these examples:
-	f :: (Eq a) => a -> Int
-	g :: (?x :: Int -> Int) => a -> Int
-	h :: (r\l) => {r} => {l::Int | r}
-
-Here the "Eq a" and "?x :: Int -> Int" and "r\l" are all called
-*predicates*, and are represented by a PredType.  (We don't support
-TREX records yet, but the setup is designed to expand to allow them.)
-
-In addition, Type gains an extra constructor:
-
-	data Type = .... | PredTy PredType
-
-so that PredType is injected directly into Type.  So the type
-	p => t
-is represented by
-	PredType p `FunTy` t
-
-I have deleted the hackish IPNote stuff; predicates are dealt with entirely
-through PredTys, not through NoteTy at all.
-
-
-2.  Move Keys into PrelNames
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-This is just a housekeeping operation. I've moved all the pre-assigned Uniques 
-(aka Keys) from Unique.lhs into PrelNames.lhs.  I've also moved knowKeyRdrNames
-from PrelInfo down into PrelNames.  This localises in PrelNames lots of stuff
-about predefined names.  Previously one had to alter three files to add one,
-now only one.
-
-3.  Unboxed tuples
-~~~~~~~~~~~~~~~~~~
-Add a static check for unboxed tuple arguments.  E.g.
-	data T = T (# Int, Int #)
-is illegal
-
-
-
-	---------------------------------------
-	Update in place
-	---------------------------------------
-
--funfolding-update-in-place
-Switching it on doesn't affect many programs, except these
-sphere is because it makes a critical function (vecsub) more inlinable
-
-         sphere               66465k         -20.61%
-          infer               13390k          +1.27%
-        parstof                1461k          +1.18%
-          fluid                3442k          +1.61%
-           atom              177163k         +13.20%
-           bspt                4837k          +4.85%
-       cichelli               33546k          +2.69%
-      typecheck              146023k          +1.47%
-
-
-	---------------------------------------
-	Simon's tuning changes: early Sept 2000
-	---------------------------------------
-
-Library changes
-~~~~~~~~~~~~~~~
-* Eta expand PrelShow.showLitChar.  It's impossible to compile this well,
-  and it makes a big difference to some programs (e.g. gen_regexps)
-
-* Make PrelList.concat into a good producer (in the foldr/build sense)
-
-
-Flag changes
-~~~~~~~~~~~~
-* Add -ddump-hi-diffs to print out changes in interface files.  Useful
-  when watching what the compiler is doing
-
-* Add -funfolding-update-in-place to enable the experimental optimisation
-  that makes the inliner a bit keener to inline if it's in the RHS of
-  a thunk that might be updated in place.  Sometimes this is a bad idea
-  (one example is in spectral/sphere; see notes in nofib/Simon-nofib-notes)
-
-
-Tuning things
-~~~~~~~~~~~~~
-* Fix a bug in SetLevels.lvlMFE.  (change ctxt_lvl to dest_level)
-  I don't think this has any performance effect, but it saves making
-  a redundant let-binding that is later eliminated.
-
-* Desugar.dsProgram and DsForeign
-  Glom together all the bindings into a single Rec.  Previously the
-  bindings generated by 'foreign' declarations were not glommed together, but
-  this led to an infelicity (i.e. poorer code than necessary) in the modules
-  that actually declare Float and Double (explained a bit more in Desugar.dsProgram)
-
-* OccurAnal.shortMeOut and IdInfo.shortableIdInfo
-  Don't do the occurrence analyser's shorting out stuff for things which
-  have rules.  Comments near IdInfo.shortableIdInfo.
-  This is deeply boring, and mainly to do with making rules work well.
-  Maybe rules should have phases attached too....
-
-* CprAnalyse.addIdCprInfo
-  Be a bit more willing to add CPR information to thunks; 
-  in particular, if the strictness analyser has just discovered that this
-  is a strict let, then the let-to-case transform will happen, and CPR is fine.
-  This made a big difference to PrelBase.modInt, which had something like
-	modInt = \ x -> let r = ... -> I# v in
-			...body strict in r...
-  r's RHS isn't a value yet; but modInt returns r in various branches, so
-  if r doesn't have the CPR property then neither does modInt
-
-* MkId.mkDataConWrapId
-  Arrange that vanilla constructors, like (:) and I#, get unfoldings that are
-  just a simple variable $w:, $wI#.  This ensures they'll be inlined even into
-  rules etc, which makes matching a bit more reliable.  The downside is that in
-  situations like (map (:) xs), we'll end up with (map (\y ys. $w: y ys) xs.
-  Which is tiresome but it doesn't happen much.
-
-* SaAbsInt.findStrictness 
-  Deal with the case where a thing with no arguments is bottom.  This is Good.
-  E.g.   module M where { foo = error "help" }
-  Suppose we have in another module
-	case M.foo of ...
-  Then we'd like to do the case-of-error transform, without inlining foo.
-
-
-Tidying up things
-~~~~~~~~~~~~~~~~~
-* Reorganised Simplify.completeBinding (again).
-
-* Removed the is_bot field in CoreUnfolding (is_cheap is true if is_bot is!)
-  This is just a tidy up
-
-* HsDecls and others
-  Remove the NewCon constructor from ConDecl.  It just added code, and nothing else.
-  And it led to a bug in MkIface, which though that a newtype decl was always changing!
-
-* IdInfo and many others
-  Remove all vestiges of UpdateInfo (hasn't been used for years)
-
-		------------------------------
-		Join points 	Sept 2000
-		------------------------------
-
-With Andrew Kennedy, I found out why a few of the join points introduced by
-the simplifier end up as *not* let-no-escpaed.  Here's an example:
-
-f x y = case (pwr x b) == 1 of
-	 False -> False
-	 True -> pwr x c == 1
-
-This compiles to:
-  f = \ @ t w :: Integer ->
-	  let {
-	    $j :: (State# RealWorld -> Bool)
-	    P
-	    $j
-	      = \ w1 :: (State# RealWorld) ->
-		    case pwr w c of wild {
-			S# i -> case i of wild1 { 1 -> $wTrue; __DEFAULT -> $wFalse };
-			J# s d1 ->
-			    case cmpIntegerInt# s d1 1 of wild2 {
-				0 -> $wTrue; __DEFAULT -> $wFalse
-			    }
-		    }
-	  } in 
-	    case pwr w b of wild {
-		S# i ->
-		    case i of wild1 { 1 -> $j realWorld#; __DEFAULT -> $wFalse };
-		J# s d1 ->
-		    case cmpIntegerInt# s d1 1 of wild2 {
-			0 -> $j realWorld#; __DEFAULT -> $wFalse
-		    }
-	    }
-
-Now consider
-
-	case (f x) of
-	  True  -> False
-	  False -> True
-
-Suppose f is inlined into this case.   No new join points are introduced,
-because the alternatives are both small.  But the consumer
-	case [.] of {True -> False; False -> True}
-will move into the body of f, be duplicated 4 ways, and end up consuming
-the result of the four outcomes at the body of f.  This yields:
-	    $j :: (State# RealWorld -> Bool)
-	    P
-	    $j
-	      = \ w1 :: (State# RealWorld) ->
-		    case pwr w c of wild {
-			S# i -> case i of wild1 { 1 -> $wTrue; __DEFAULT -> $wFalse };
-			J# s d1 ->
-			    case cmpIntegerInt# s d1 1 of wild2 {
-				0 -> $wTrue; __DEFAULT -> $wFalse
-			    }
-		    }
-	  } in 
-	    case pwr w b of wild {
-		S# i ->
-		    case i of wild1 { 1 -> case $j realWorld# of {T->F; F->T}
-				    ; __DEFAULT -> $wTrue };
-		J# s d1 ->
-		    case cmpIntegerInt# s d1 1 of wild2 {
-			0 -> case $j realWorld# of {T->F; F->T}
-			; __DEFAULT -> $wTrue
-		    }
-	    }
-
-And, voila, the join point $j isn't let-no-escaped any more.  
-The point is that the consuming context can't "see inside" the join point.
-It's a phase ordering thing.  If f is inlined before the join points 
-are built in the first place, then all is well.
-
-
-
-	-----------------------------
-	Sept 7 2000
-	-----------------------------
-
-* Make the simplifier's Stop continuation record whether the expression being
-  simplified is the RHS of a thunk, or (say) the body of a lambda or case RHS.
-  In the thunk case we want to be a bit keener about inlining if the type of
-  the thunk is amenable to update in place.
-
-* SetLevels was being a bit too eager to float things to the top 
-  level; e.g. _inline_me_ (\a -> e); here e got floated...
-  Easily fixed by a change to ltMajLvl
-
-* Make CoreUnfold.calcUnfoldingGuidance a bit less keen to make case expressions
-  seem small.  The original idea was to make inlined wrappers look small, so that
-  when we inline a wrapper it doesn't make call site (much) bigger
-  Otherwise we get nasty phase ordering stuff: 
-		--	f x = g x x
-		--	h y = ...(f e)...
-  If we inline g's wrapper, f looks big, and doesn't get inlined
-  into h; if we inline f first, while it looks small, then g's 
-  wrapper will get inlined later anyway.  To avoid this nasty
-  ordering difference, we make (case a of (x,y) -> ...), 
-  *where a is one of the arguments* look free.
-
-  BUT	(a) It's too eager.  We don't want to inline a wrapper into a
-	    context with no benefit.  
-	    E.g.  \ x. f (x+x)   	o point in inlining (+) here!
-
-	(b) It's ineffective. Once g's wrapper is inlined, its case-expressions 
-	    aren't scrutinising arguments any more
-
-  So I've rescinded this idea for now.  cases still look fairly small.
-
-* Fix interestingArg, which was being too liberal, and hence doing
-  too much inlining.
-
-* Extended CoreUtils.exprIsCheap to make two more things cheap:
-    - 	case (coerce x) of ...
-    -   let x = y +# z
-  This makes a bit more eta expansion happen.  It was provoked by
-  a program of Marcin's.
-  
-* The simplifier used to glom together all the top-level bindings into
-  a single Rec every time it was invoked.  The reason for this is explained
-  in SimplCore.lhs, but for at least one simple program it meant that the
-  simplifier never got around to unravelling the recursive group into 
-  non-recursive pieces.  So I've put the glomming under explicit flag
-  control with a -fglom-binds simplifier pass.   A side benefit is
-  that because it happens less often, the (expensive) SCC algorithm
-  runs less often.
-  
-* MkIface.ifaceBinds.   Make sure that we emit rules for things
-  (like class operations) that don't get a top-level binding in the
-  interface file.  Previously such rules were silently forgotten.
-
-* Move transformRhs to *after* simplification, which makes it a
-  little easier to do, and means that the arity it computes is 
-  readily available to completeBinding.  This gets much better
-  arities.
-
-* Do coerce splitting in completeBinding. This gets good code for
-	newtype CInt = CInt Int
-
-	test:: CInt -> Int
-	test x = case x of
-	      	   1 -> 2
-	      	   2 -> 4
-	      	   3 -> 8
-	      	   4 -> 16
-	      	   _ -> 0
-
-* Modify the meaning of "arity" so that during compilation it means
-  "if you apply this function to fewer args, it will do virtually 
-  no work".   So, for example 
-	f = coerce t (\x -> e)
-  has arity at least 1.  When a function is exported, it's arity becomes
-  the number of exposed, top-level lambdas, which is subtly different.
-  But that's ok.  
-
-  I removed CoreUtils.exprArity altogether: it looked only at the exposed
-  lambdas.  Instead, we use exprEtaExpandArity exclusively.
-
-  All of this makes I/O programs work much better.
-
-
-	-----------------------------
-	Sept 4 2000
-	-----------------------------
-
-* PrimRep, TysPrim.  Add PrimPtrRep as the representation for
-  MVars and MutVars.  Previously they were given PtrRep, but that
-  crashed dataReturnConvPrim!  Here's the program the killed it:
-     data STRef s a = STRef (MutVar# s a)
-     from (STRef x) = x
-  
-* Make the desugarer use string equality for string literal
-  patterns longer than 1 character.  And put a specialised
-  eqString into PrelBase, with a suitable specialisation rule.
-  This makes a huge difference to the size of the code generated
-  by deriving(Read) notably in Time.lhs
-
-	-----------------------------
-	Marktoberdorf Commits (Aug 2000)
-	-----------------------------
-
-1.  Tidy up the renaming story for "system binders", such as
-dictionary functions, default methods, constructor workers etc.  These
-are now documented in HsDecls.  The main effect of the change, apart
-from tidying up, is to make the *type-checker* (instead of the
-renamer) generate names for dict-funs and default-methods.  This is
-good because Sergei's generic-class stuff generates new classes at
-typecheck time.
-
-
-2.  Fix the CSE pass so it does not require the no-shadowing invariant.
-Keith discovered that the simplifier occasionally returns a result
-with shadowing.  After much fiddling around (which has improved the
-code in the simplifier a bit) I found that it is nearly impossible to
-arrange that it really does do no-shadowing.  So I gave up and fixed
-the CSE pass (which is the only one to rely on it) instead.
-
-
-3. Fix a performance bug in the simplifier.  The change is in
-SimplUtils.interestingArg.  It computes whether an argment should 
-be considered "interesting"; if a function is applied to an interesting
-argument, we are more likely to inline that function.
-Consider this case
-	let x = 3 in f x
-The 'x' argument was considered "uninteresting" for a silly reason.
-Since x only occurs once, it was unconditionally substituted, but
-interestingArg didn't take account of that case.  Now it does.
-
-I also made interestingArg a bit more liberal.  Let's see if we
-get too much inlining now.
-
-
-4.  In the occurrence analyser, we were choosing a bad loop breaker.
-Here's the comment that's now in OccurAnal.reOrderRec
-
-    score ((bndr, rhs), _, _)
-	| exprIsTrivial rhs 	   = 3	-- Practically certain to be inlined
-		-- Used to have also: && not (isExportedId bndr)
-		-- But I found this sometimes cost an extra iteration when we have
-		--	rec { d = (a,b); a = ...df...; b = ...df...; df = d }
-		-- where df is the exported dictionary. Then df makes a really
-		-- bad choice for loop breaker
-
-I also increased the score for bindings with a non-functional type, so that
-dictionaries have a better chance of getting inlined early
-
-
-5. Add a hash code to the InScopeSet (and make it properly abstract)
-This should make uniqAway a lot more robust.  Simple experiments suggest
-that uniqAway no longer gets into the long iteration chains that it used
-to.
-
-
-6.  Fix a bug in the inliner that made the simplifier tend to get into
-a loop where it would keep iterating ("4 iterations, bailing out" message).
-In SimplUtils.mkRhsTyLam we float bindings out past a big lambda, thus:
-	x = /\ b -> let g = \x -> f x x
-		    in E
-becomes
-	g* = /\a -> \x -> f x x
-	x = /\ b -> let g = g* b in E
-	
-It's essential that we don't simply inling g* back into the RHS of g,
-else we will be back to square 1.  The inliner is meant not to do this
-because there's no benefit to the inlining, but the size calculation
-was a little off in CoreUnfold.
-
-
-7.  In SetLevels we were bogus-ly building a Subst with an empty in-scope
-set, so a WARNING popped up when compiling some modules.  (knights/ChessSetList
-was the example that tickled it.)  Now in fact the warning wasn't an error,
-but the Right Thing to do is to carry down a proper Subst in SetLevels, so
-that is what I have now done.  It is very little more expensive.
-
-
-
-		~~~~~~~~~~~~
-		Apr/May 2000
-		~~~~~~~~~~~~
-
-This is a pretty big commit!  It adds stuff I've been working on
-over the last month or so.  DO NOT MERGE IT WITH 4.07!
-
-Recompilation checking
-~~~~~~~~~~~~~~~~~~~~~~
-Substantial improvement in recompilation checking.  The version management
-is now entirely internal to GHC.  ghc-iface.lprl is dead!
-
-The trick is to generate the new interface file in two steps:
-  - first convert Types etc to HsTypes etc, and thereby 
-	build a new ParsedIface
-  - then compare against the parsed (but not renamed) version of the old
-	interface file
-Doing this meant adding code to convert *to* HsSyn things, and to 
-compare HsSyn things for equality.  That is the main tedious bit.
-
-Another improvement is that we now track version info for 
-fixities and rules, which was missing before.
-
-
-Interface file reading
-~~~~~~~~~~~~~~~~~~~~~~
-Make interface files reading more robust.  
-  * If the old interface file is unreadable, don't fail. [bug fix]
-
-  * If the old interface file mentions interfaces 
-    that are unreadable, don't fail. [bug fix]
-
-  * When we can't find the interface file, 
-    print the directories we are looking in.  [feature]
-
-
-Type signatures
-~~~~~~~~~~~~~~~
-  * New flag -ddump-types to print type signatures
-
-
-Type pruning
-~~~~~~~~~~~~
-When importing 
-	data T = T1 A | T2 B | T3 C
-it seems excessive to import the types A, B, C as well, unless
-the constructors T1, T2 etc are used.  A,B,C might be more types,
-and importing them may mean reading more interfaces, and so on.
- So the idea is that the renamer will just import the decl 
-	data T
-unless one of the constructors is used.  This turns out to be quite
-easy to implement.  The downside is that we must make sure the
-constructors are always available if they are really needed, so
-I regard this as an experimental feature.
-
-
-Elimininate ThinAir names
-~~~~~~~~~~~~~~~~~~~~~~~~~
-Eliminate ThinAir.lhs and all its works.  It was always a hack, and now
-the desugarer carries around an environment I think we can nuke ThinAir 
-altogether.
-
-As part of this, I had to move all the Prelude RdrName defns from PrelInfo
-to PrelMods --- so I renamed PrelMods as PrelNames.
-
-I also had to move the builtinRules so that they are injected by the renamer
-(rather than appearing out of the blue in SimplCore).  This is if anything simpler.
-
-Miscellaneous
-~~~~~~~~~~~~~
-* Tidy up the data types involved in Rules
-
-* Eliminate RnEnv.better_provenance; use Name.hasBetterProv instead
-
-* Add Unique.hasKey :: Uniquable a => a -> Unique -> Bool
-  It's useful in a lot of places
-
-* Fix a bug in interface file parsing for __U[!]
-
-
-=======================================
-To-do
-~~~~~
-* Try the effect of enhancing update in place with the CPR 
-  idea in CoreUnfold.calcUnfoldingGuidance
-
-* Check with Simon M re srt on Lit
-
-* Make all primops return a data type so that we can't over-apply a primop
-  This makes code gen simpler. Currently the only primops with a polymorphic
-  return type are:
-	raise# :: a -> b
-	catch# :: a -> (b->a) -> a
-	tagToEnum# :: Int -> a
-
-  Very strange code for PrelException.catchException!  What has STret got
-  to do with it?
-
-* Liberate case
-
-* Missing w/w for coerce in go2 functions of fibToList' in fibheaps
-
-* Watch out for re-boxing in workers; sometimes it happens
-  and then w/w is a Bad Thing
-
-* Only two uses of mkCompulsoryUnfolding -- try to nuke it
-
-* Note that mkDupAlt makes alts that have binders that
-  are guaranteed to appear just once or not at all
-	(a,b) -> j a
-  Same for case binder, but that's harder to take into account.
-
-* max :: Int -> Int -> Int could be CPRd but isn't.
-
-* In mandel2 we do a little less well than 4.04 because we aren't 
-  inlining point_colour, and that means we have to box up an argument
-  before calling it.  [This was due to a bug in 4.04]
-  There's also a great opportunity for liberateCase
-  in check_radius, where it loops around with two lazy F# built each time
-
-* In PrelShow.itos' we find a thunk like:
-	  tpl = case chrzh {(zpzh {(remIntzh {x{-aMf-} 10}) 48})}
-		of tpl{-X1j-} __D P { __DEFAULT ->
-		      PrelBase.Czh{-62,s-} {tpl{-X1j-}}
-		}
-  This is a pity.  The remInt# can't fail because the divisor isn't 0,
-  so we could do the sum eagerly and allocate a charcter instead of a thunk.
-
-* It's good to do let-to-case before we wrap up.  Consider
-  f b xs = let ys = partition isUpper xs
-	       zs = case ys of (a,b) -> a
-           in case b of
-		True -> case ys of
-			  (a,b) -> (zs,[])
-		False -> case ys of
-			  (a,b) -> (zs ++ xs,[])
-  If we don't do let-to-case at all, we get 3 redundant case ys left.
-  On the other hand we don't want to do it too early, because it
-  prevents inlining into strict arg positions, which is important for 
-  rules to work.
-
-* Strict dictionaries.  
-
-* INLINE functions are not always INLINEd, so it's sad to leave
-  stuff in their bodies like constructors that havn't been inlined.
-
-* If let x = e in b is strict, then CPR can use the CPR info from x
-  This bites in the mod method of Integral Int
-
-* Inline wrappers if they are the RHS of a let, so that update in place
-  can happen?
-
-* Consider doing unboxing on strict constr args in a pattern match,
-  as part of w/w.  
-
-* In spectral/expert/Search.ask there's a statically visible CSE. Catching this 
-  depends almost entirely on chance, which is a pity.
-
-* Think about exprEtaExpandArity in WwLib.  Perhaps eliminate eta expand in simplify?
-  Perhaps use even if no coerces etc, just eta expansion. (e.g. PrelArr.done)
-
-* In knights/KnightHeuristic, we don't find that possibleMoves is strict
-  (with important knock-on effects) unless we apply rules before floating
-  out the literal list [A,B,C...].
-  Similarly, in f_se (F_Cmp ...) in listcompr (but a smaller effect)
-
-* Floating can float the entire body of an INLINE thing out.
-  e.g. PrelArr.done 
-  This is sad, and a bit stupid.
-
-* In spectral/multiplier, we have 
-    xor = lift21 forceBit f
-      where f :: Bit -> Bit -> Bit
-	    f 0 0 = 0
-	    f 0 1 = 1
-	    f 1 0 = 1
-	    f 1 1 = 0
-  Trouble is, f is CPR'd, and that means that instead of returning
-  the constants I# 0, I# 1, it returns 0,1 and then boxes them.
-  So allocation goes up.  I don't see a way around this.
-
-* spectral/hartel/parstof ends up saying
-	case (unpackCString "x") of { c:cs -> ... }
-  quite a bit.   We should spot these and behave accordingly.
-
-* Try a different hashing algorithms in hashUFM.  This might reduce long CSE lists
-  as well as making uniqAway faster.
-
-* [I'm not sure this is really important in the end.]
-  Don't float out partial applications in lvlMFE.  E.g. (in hPutStr defn of shoveString)
-	\x -> case .. of 
-		[] -> setBufWPtr a b
-		...
-  setBufWPtr has arity 3.  Floating it out is plain silly.  And in this particular
-  case it's harmful, because it ends up preventing eta expansion on the \x.
-  That in turn leads to a big extra cost in hPutStr.
-
-  *** Try not doing lvlMFE on the body of a lambda and case alternative ***
-
-* PrelNumExtra.lhs we get three copies of dropTrailing0s.  Too much inlining!
-  drop0 has cost 21, but gets a discount of 6 (3 * #constrs) for its arg.
-  With a keen-neess factor of 2, that makes a discount of 12.  Add two for
-  the arguments and we get 21-12-2, which is just small enough to inline.
-  But that is plainly stupid.
-
-  Add one for cases; and decrease discount for constructors.
-
-* IO.hGetContents still doesn't see that it is strict in the handle.
-  Coerces still getting in the way.
-
-* Try not having really_interesting_cont (subsumed by changes in the 
-	way guidance is calculated for inline things?)
-
-* Enumeration types in worker/wrapper for strictness analysis
-
-* This should be reported as an error:
-	data T k = MkT (k Int#)
-
-* Bogus report of overlapped pattern for
-	f (R {field = [c]}) = 1
-  	f (R {})	      = 2
-  This shows up for TyCon.maybeTyConSingleCon
-
-*  > module Main( main ) where
-
-   > f :: String -> Int
-   > f "=<" = 0
-   > f "="  = 0
-   
-   > g :: [Char] -> Int
-   > g ['=','<'] = 0
-   > g ['=']     = 0
-   
-   > main = return ()
-   
-   For ``f'' the following is reported.
-   
-   tmp.lhs:4: 
-    Pattern match(es) are overlapped in the definition of function `f'
-            "=" = ...
-
-   There are no complaints for definition for ``g''.
-
-* Without -O I don't think we need change the module version
-  if the usages change; I forget why it changes even with -O
-
-* Record selectors for existential type; no good!  What to do?
-  Record update doesn't make sense either.
-
-  Need to be careful when figuring out strictness, and when generating
-  worker-wrapper split.
-
-  Also when deriving.
-
-
-		Jan 2000
-		~~~~~~~~ 
-
-A fairly big pile of work originally aimed at
-removing the Con form of Core expression, and replacing it with simple
-Lit form.  However, I wanted to make sure that the resulting thing
-performed better than the original, so I ended up making an absolute
-raft of other changes.
-
-Removing the Con form of Core expressions
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The big thing is that
-
-  For every constructor C there are now *two* Ids:
-
-	C is the constructor's *wrapper*. It evaluates and unboxes arguments
-	before calling $wC.  It has a perfectly ordinary top-level defn 
-	in the module defining the data type.
-
-	$wC is the constructor's *worker*.  It is like a primop that simply
-	allocates and builds the constructor value.  Its arguments are the
-	actual representation arguments of the constructor.
-
-  For every primop P there is *one* Id, its (curried) Id
-
-  Neither contructor worker Id nor the primop Id have a defminition anywhere.
-  Instead they are saturated during the core-to-STG pass, and the code generator
-  generates code for them directly. The STG language still has saturated 
-  primops and constructor applications.
-
-* The Const type disappears, along with Const.lhs.  The literal part
-  of Const.lhs reappears as Literal.lhs.  Much tidying up in here,
-  to bring all the range checking into this one module.
-
-* I got rid of NoRep literals entirely.  They just seem to be too much trouble.
-
-* Because Con's don't exist any more, the funny C { args } syntax
-  disappears from inteface files.
-
-* Every constructor, C, comes with a 
-
-  *wrapper*, called C, whose type is exactly what it looks like
-	in the source program. It is an ordinary function,
-	and it gets a top-level binding like any other function
-
-  *worker*, called $wC, which is the actual data constructor.
-	Its type may be different to C, because:
-		- useless dict args are dropped
-		- strict args may be flattened
-	It does not have a binding.
-
-  The worker is very like a primop, in that it has no binding,
-
-
-Parsing
-~~~~~~~
-* Result type signatures now work
-	f :: Int -> Int = \x -> x
-	-- The Int->Int is the type of f
-
-	g x y :: Int = x+y	
-	-- The Int is the type of the result of (g x y)
-
-
-Recompilation checking and make
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-* The .hi file for a modules is not touched if it doesn't change.  (It used to
-  be touched regardless, forcing a chain of recompilations.)  The penalty for this
-  is that we record exported things just as if they were mentioned in the body of
-  the module.  And the penalty for that is that we may recompile a module when
-  the only things that have changed are the things it is passing on without using.
-  But it seems like a good trade.
-
-* -recomp is on by default
-
-Foreign declarations
-~~~~~~~~~~~~~~~~~~~~
-* If you say
-	foreign export zoo :: Int -> IO Int
-  then you get a C produre called 'zoo', not 'zzoo' as before.
-  I've also added a check that complains if you export (or import) a C
-  procedure whose name isn't legal C.
-
-
-Code generation and labels
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-* Now that constructor workers and wrappers have distinct names, there's
-  no need to have a Foo_static_closure and a Foo_closure for constructor Foo.
-  I nuked the entire StaticClosure story.  This has effects in some of
-  the RTS headers (i.e. s/static_closure/closure/g)
-
-
-Rules, constant folding
-~~~~~~~~~~~~~~~~~~~~~~~
-* Constant folding becomes just another rewrite rule, attached to the Id for the
-  PrimOp.   To achieve this, there's a new form of Rule, a BuiltinRule (see CoreSyn.lhs).
-  The prelude rules are in prelude/PrelRules.lhs, while simplCore/ConFold.lhs has gone.
-
-* Appending of constant strings now works, using fold/build fusion, plus
-  the rewrite rule
-	unpack "foo" c (unpack "baz" c n)  =  unpack "foobaz" c n
-  Implemented in PrelRules.lhs
-
-* The CCall primop is tidied up quite a bit.  There is now a data type CCall,
-  defined in PrimOp, that packages up the info needed for a particular CCall.
-  There is a new Id for each new ccall, with an big "occurrence name"
-	{__ccall "foo" gc Int# -> Int#}
-  In interface files, this is parsed as a single Id, which is what it is, really.
-
-Miscellaneous
-~~~~~~~~~~~~~
-* There were numerous places where the host compiler's 
-  minInt/maxInt was being used as the target machine's minInt/maxInt.
-  I nuked all of these; everything is localised to inIntRange and inWordRange,
-  in Literal.lhs
-
-* Desugaring record updates was broken: it didn't generate correct matches when
-  used withe records with fancy unboxing etc.  It now uses matchWrapper.
-
-* Significant tidying up in codeGen/SMRep.lhs
-
-* Add __word, __word64, __int64 terminals to signal the obvious types 
-  in interface files.  Add the ability to print word values in hex into 
-  C code.
-
-* PrimOp.lhs is no longer part of a loop.  Remove PrimOp.hi-boot*
-
-
-Types
-~~~~~
-* isProductTyCon no longer returns False for recursive products, nor
-  for unboxed products; you have to test for these separately.  
-  There's no reason not to do CPR for recursive product types, for example.
-  Ditto splitProductType_maybe.
-
-Simplification
-~~~~~~~~~~~~~~~
-* New -fno-case-of-case flag for the simplifier.  We use this in the first run
-  of the simplifier, where it helps to stop messing up expressions that 
-  the (subsequent) full laziness pass would otherwise find float out.
-  It's much more effective than previous half-baked hacks in inlining.
-
-  Actually, it turned out that there were three places in Simplify.lhs that
-  needed to know use this flag.
-
-* Make the float-in pass push duplicatable bindings into the branches of
-  a case expression, in the hope that we never have to allocate them.
-  (see FloatIn.sepBindsByDropPoint)
-
-* Arrange that top-level bottoming Ids get a NOINLINE pragma
-  This reduced gratuitous inlining of error messages.
-  But arrange that such things still get w/w'd.
-
-* Arrange that a strict argument position is regarded as an 'interesting'
-  context, so that if we see 
-	foldr k z (g x)
-  then we'll be inclined to inline g; this can expose a build.
-
-* There was a missing case in CoreUtils.exprEtaExpandArity that meant
-  we were missing some obvious cases for eta expansion
-  Also improve the code when handling applications.
-
-* Make record selectors (identifiable by their IdFlavour) into "cheap" operations.
-	  [The change is a 2-liner in CoreUtils.exprIsCheap]
-  This means that record selection may be inlined into function bodies, which
-  greatly improves the arities of overloaded functions.
-
-* Make a cleaner job of inlining "lone variables".  There was some distributed
-  cunning, but I've centralised it all now in SimplUtils.analyseCont, which
-  analyses the context of a call to decide whether it is "interesting".
-
-* Don't specialise very small functions in Specialise.specDefn
-  It's better to inline it.  Rather like the worker/wrapper case.
-
-* Be just a little more aggressive when floating out of let rhss.
-  See comments with Simplify.wantToExpose
-  A small change with an occasional big effect.
-
-* Make the inline-size computation think that 
-	case x of I# x -> ...
-  is *free*.  
-
-
-CPR analysis
-~~~~~~~~~~~~
-* Fix what was essentially a bug in CPR analysis.  Consider
-
-	letrec f x = let g y = let ... in f e1
-		     in
-		     if ... then (a,b) else g x
-
-  g has the CPR property if f does; so when generating the final annotated
-  RHS for f, we must use an envt in which f is bound to its final abstract
-  value.  This wasn't happening.  Instead, f was given the CPR tag but g
-  wasn't; but of course the w/w pass gives rotten results in that case!!
-  (Because f's CPR-ness relied on g's.)
-
-  On they way I tidied up the code in CprAnalyse.  It's quite a bit shorter.
-
-  The fact that some data constructors return a constructed product shows
-  up in their CPR info (MkId.mkDataConId) not in CprAnalyse.lhs
-
-
-
-Strictness analysis and worker/wrapper
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-* BIG THING: pass in the demand to StrictAnal.saExpr.  This affects situations
-  like
-	f (let x = e1 in (x,x))
-  where f turns out to have strictness u(SS), say.  In this case we can
-  mark x as demanded, and use a case expression for it.
-
-  The situation before is that we didn't "know" that there is the u(SS) 
-  demand on the argument, so we simply computed that the body of the let 
-  expression is lazy in x, and marked x as lazily-demanded.  Then even after
-  f was w/w'd we got
-
-	let x = e1 in case (x,x) of (a,b) -> $wf a b
-
-  and hence
-
-	let x = e1 in $wf a b
-
-  I found a much more complicated situation in spectral/sphere/Main.shade,
-  which improved quite a bit with this change.
- 
-* Moved the StrictnessInfo type from IdInfo to Demand.  It's the logical
-  place for it, and helps avoid module loops
-
-* Do worker/wrapper for coerces even if the arity is zero.  Thus:
-	stdout = coerce Handle (..blurg..)
-  ==>
-	wibble = (...blurg...)
-	stdout = coerce Handle wibble
-  This is good because I found places where we were saying 
-	case coerce t stdout of { MVar a ->
-	...
-	case coerce t stdout of { MVar b -> 
-	...
-  and the redundant case wasn't getting eliminated because of the coerce.
-
-
-
-End December
-~~~~~~~~~~~~
-* Fix a few renamer bugs
-
-* Substantially reorganise the Prelude to eliminate all orphan declarations.
-  Details in PrelBase.lhs
-
-* Do a much better job of appending literal strings
-   - remove NoRepStr
-   - move unpackCString stuff to PrelBase
-   - add BuiltinRules to the Rule type
-   - add fold/build rules for literal strings
-
-  
-
-Week of Mon 25 Oct
-~~~~~~~~~~~~~~~~~~
-* Fix a terrible bug in Simplify.mkDupableAlt; we were duplicating a small
-  *InAlt*, but doing so invalidated occurrence info, which could lead to
-  substantial code duplication.
-
-* Fix a bug in WwLib.mkWWcpr; I was generating CPR wrappers like
-	I# (case x of ...)
-  which is utterly wrong.  It should be 
-	case x of ...(I# r)
-  (The effect was to make functions stricter than they really are.)
-
-* Try doing no inlining at all in phase 0.  This noticeably improved
-  spectral/fish (esp Main.hs I think), by improving floating.
-  This single change has quite a large effect on some programs (allocation)
-
-  			Don't inline 	  Don't inline
-			wrappers 	  anything  
-			in phase 0	  in phase 0
-         awards                 113k          -7.08%
-       cichelli               28962k          -3.12%
-      wave4main               88089k        +130.45%
-       fibheaps               31731k         +19.01%
-           fish                8273k          -1.64%
-      typecheck              148713k          +4.91%
-
-  But I found that fish worked much better if we inline *local* things
-  in phase 0, but not *imported* things.  
-
-* Fix a terrible bug in Simplify.mkLamBndrZapper.  It was counting
-  type args in one place, but not type binders, so it was sometimes
-  inlining into unsaturated lambdas!
-
-* I found that there were some very bad loss-of-arity cases in PrelShow.  
-  In particular, we had:
-
-	showl ""       = showChar '"' s
-	showl ('"':xs) = showString "\\\"" . showl xs
-	showl (x:xs)   = showLitChar x . showl xs
-
-  Trouble is, we get
-	showl = \xs -> case xs of
-			  ...
-			  (x:xs) -> let f = showLitChar x
-					g = showl xs
-				    in \s -> f (g x)
-  which is TERRIBLE.  We can't spot that showLitChar has arity 2 because
-  it looks like this:
-
-	...other eqns...
-        showLitChar c = showString ('\\' : asciiTab!!ord c)
-
-  notice that the (asciiTab!!orc c) is outside the \s, so GHC can't rewrite it to
-
-	showLitChar c =  \s -> showString ('\\' : asciiTab!!ord c) s
-
-  So I've changed PrelShow.showLitChar to use explicit \s.  Even then, showl
-  doesn't work, because GHC can't see that showl xs can be pushed inside the \s.
-  So I've put an explict \s there too.  
-
-	showl ""       s = showChar '"' s
-	showl ('"':xs) s = showString "\\\"" (showl xs s)
-	showl (x:xs)   s = showLitChar x (showl xs s)
-
-  Net result: imaginary/gen_regexps more than halves in allocation!
-
-  Turns out that the mkLamBndrZapper bug (above) meant that showl was
-  erroneously inlining showLitChar x and showl xs, which is why this
-  problem hasn't shown up before.
-  
-* Improve CSE a bit.  In ptic
-	case h x of y -> ...(h x)...
-  replaces (h x) by y.
-
-* Inline INLINE things very agressively, even though we get code duplication 
-  thereby.  Reason: otherwise we sometimes call the original un-inlined INLINE
-  defns, which have constructors etc still un-inlined in their RHSs.  The 
-  improvement is dramatic for a few programs:
-
-      typecheck              150865k          -1.43%
-      wave4main              114216k         -22.87%
-          boyer               28793k          -7.86%
-       cichelli               33786k         -14.28%
-            ida               59505k          -1.79%
-        rewrite               14665k          -4.91%
-          sched               17641k          -4.22%
-
-  Code size increases by 10% which is not so good.  There must be a better way.
-  Another bad thing showed up in fish/Main.hs.  Here we have
-	(x1,y1) `vec_add` (x2,y2) = (x1+x2, y1+y2)
-  which tends to get inlined.  But if we first inline (+), it looks big,
-  so we don't inline it.  Sigh.
-
-
-* Don't inline constructors in INLINE RHSs.  Ever.  Otherwise rules don't match.
-  E.g. build
-
-* In ebnf2ps/Lexer.uncommentString, it would be a good idea to inline a constructor
-  that occurs once in each branch of a case.  That way it doesn't get allocated
-  in the branches that don't use it.  And in fact in this particular case
-  something else good happens.  So CoreUnfold now does that.
-
-* Reverted to n_val_binders+2 in calcUnfoldingGuidance
-  Otherwise wrappers are inlined even if there's no benefit.
-
-
-Week of Mon 18 Oct
-~~~~~~~~~~
-* Arrange that simplConArgs works in one less pass than before.
-  This exposed a bug: a bogus call to completeBeta.
-
-* Add a top-level flag in CoreUnfolding, used in callSiteInline
-
-* Extend w/w to use etaExpandArity, so it does eta/coerce expansion
-
-* Don't float anything out of an INLINE.
-  Don't float things to top level unless they also escape a value lambda.
-	[see comments with SetLevels.lvlMFE
-  Without at least one of these changes, I found that 
-	{-# INLINE concat #-}
-	concat = __inline (/\a -> foldr (++) [])
-  was getting floated to
-	concat = __inline( /\a -> lvl a )
-	lvl = ...inlined version of foldr...
-
-  Subsequently I found that not floating constants out of an INLINE
-  gave really bad code like
-	__inline (let x = e in \y -> ...)
-  so I now let things float out of INLINE
-
-* Implement inline phases.   The meaning of the inline pragmas is
-  described in CoreUnfold.lhs
-
-* Implement the "reverse-mapping" idea for CSE; actually it turned out to be easier
-  to implement it in SetLevels, and may benefit full laziness too.
-
-Thurs 14 Oct
-~~~~~~~~~~~~
-* It's a good idea to inline inRange. Consider
-
-	index (l,h) i = case inRange (l,h) i of
-		  	  True ->  l+i
-			  False -> error 
-  inRange itself isn't strict in h, but if it't inlined then 'index'
-  *does* become strict in h.  Interesting!
-
-* Big change to the way unfoldings and occurrence info is propagated in the simplifier
-  The plan is described in Subst.lhs with the Subst type
-  Occurrence info is now in a separate IdInfo field than user pragmas
-
-* I found that
-	(coerce T (coerce S (\x.e))) y
-  didn't simplify in one round. First we get to
-	(\x.e) y
-  and only then do the beta. Solution: cancel the coerces in the continuation
-
-* Amazingly, CoreUnfold wasn't counting the cost of a function an application.
-
-Early Oct
-~~~~~~~~~
-* No commas between for-alls in RULES
-
-* Disable rules in initial simplifier run.  Otherwise full laziness
-  doesn't get a chance to lift out a MFE before a rule (e.g. fusion)
-  zaps it.  queens is a case in point
-
-* Improve float-out stuff significantly.  The big change is that if we have
-
-	\x -> ... /\a -> ...let p = ..a.. in let q = ...p...
-
-  where p's rhs doesn't x, we abstract a from p, so that we can get p past x.
-  (We did that before.)  But we also substitute (p a) for p in q, and then
-  we can do the same thing for q.  (We didn't do that, so q got stuck.)
-  This is much better.  It involves doing a substitution "as we go" in SetLevels,
-  though.
-
-
-Weds 15 Sept
-~~~~~~~~~~~~
-* exprIsDupable for an application (f e1 .. en) wasn't calling exprIsDupable
-  on the arguments!!  So applications with few, but large, args were being dupliated.
-
-* sizeExpr on an application wasn't doing a nukeScrutDiscount on the arg of
-  an application!!  So bogus discounts could accumulate from arguments!
-
-* Improve handling of INLINE pragmas in calcUnfoldingGuidance.  It was really
-  wrong before
-
-* Substantially improve handling of coerces in worker/wrapper
-
-Tuesday 6 June
-~~~~~~~~~~~~~~
-* Fix Kevin Atkinson's cant-find-instance bug.  Turns out that Rename.slurpSourceRefs
-  needs to repeatedly call getImportedInstDecls, and then go back to slurping
-  source-refs.  Comments with Rename.slurpSourceRefs.
-
-* Add a case to Simplify.mkDupableAlt for the quite-common case where there's
-  a very simple alternative, in which case there's no point in creating a 
-  join-point binding.
-
-* Fix CoreUtils.exprOkForSpeculation so that it returns True of (==# a# b#).
-  This lack meant that 
-	case ==# a# b# of { True -> x; False -> x }
-  was not simplifying
-
-* Make float-out dump bindings at the top of a function argument, as
-  at the top of a let(rec) rhs.  See notes with FloatOut.floatRhs
-
-* Make the ArgOf case of mkDupableAlt generate a OneShot lambda.
-  This gave a noticeable boost to spectral/boyer2
-
-
-Monday 5 June
-~~~~~~~~~~~~~
-Work, using IO.hPutStr as an example, to reduce the number of coerces.
-The main idea is in WwLib.mkWWcoerce.  The gloss is that we must do
-the w/w split even for small non-recursive things.  See notes with
-WorkWrap.tryWw.
-
-
-Friday 2 June
-~~~~~~~~~~~~~
-Study why gen_regexps is slower than before.  Problem is in IO.writeLines,
-in particular the local defn shoveString.  Two things are getting
-in the way of arity expansion, which means we build far more function
-closures than we should:
-	shove = \ x -> let lvl = \s -> ...
-		       in \s -> ... lvl ...
-
-The two things are:
-	a) coerces
-	b) full laziness floats
-
-
-Solution to (a): add coerces to the worker/wrapper stuff.
-See notes with WwLib.mkWWcoerce.
-
-This further complicated getWorkerId, so I finally bit the bullet and
-make the workerInfo field of the IdInfo work properly, including
-under substitutions.  Death to getWorkerId.
-
-
-
-Solution to (b): make all lambdas over realWorldStatePrimTy
-into one-shot lambdas.  This is a GROSS HACK.
-
-* Also make the occurrence analyser aware of one-shot lambdas.
-
-
-Thurs 1 June
-~~~~~~~~~~~~
-Fix SetLevels so that it does not clone top-level bindings, but it
-*does* clone bindings that are destined for the top level.
-
-The global invariant is that the top level bindings are always
-unique, and never cloned.
diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs
deleted file mode 100644
index 6b662bd6a6..0000000000
--- a/ghc/compiler/basicTypes/BasicTypes.lhs
+++ /dev/null
@@ -1,508 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
-%
-\section[BasicTypes]{Miscellanous types}
-
-This module defines a miscellaneously collection of very simple
-types that
-
-\begin{itemize}
-\item have no other obvious home
-\item don't depend on any other complicated types
-\item are used in more than one "part" of the compiler
-\end{itemize}
-
-\begin{code}
-module BasicTypes(
-	Version, bumpVersion, initialVersion,
-
-	Arity, 
-	
-	DeprecTxt,
-
-	Fixity(..), FixityDirection(..),
-	defaultFixity, maxPrecedence, 
-	negateFixity, funTyFixity,
-	compareFixity,
-
-	IPName(..), ipNameName, mapIPName,
-
-	RecFlag(..), isRec, isNonRec, boolToRecFlag,
-
-	TopLevelFlag(..), isTopLevel, isNotTopLevel,
-
-	Boxity(..), isBoxed, 
-
-	TupCon(..), tupleParens,
-
-	OccInfo(..), seqOccInfo, isFragileOcc, isOneOcc, 
-	isDeadOcc, isLoopBreaker, isNoOcc,
-
-	InsideLam, insideLam, notInsideLam,
-	OneBranch, oneBranch, notOneBranch,
-	InterestingCxt,
-
-        EP(..),
-
-	StrictnessMark(..), isMarkedUnboxed, isMarkedStrict,
-
-	CompilerPhase, 
-	Activation(..), isActive, isNeverActive, isAlwaysActive,
-	InlineSpec(..), defaultInlineSpec, alwaysInlineSpec, neverInlineSpec,
-
-	SuccessFlag(..), succeeded, failed, successIf
-   ) where
-
-#include "HsVersions.h"
-
-import FastString( FastString )
-import Outputable
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Arity]{Arity}
-%*									*
-%************************************************************************
-
-\begin{code}
-type Arity = Int
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Version]{Module and identifier version numbers}
-%*									*
-%************************************************************************
-
-\begin{code}
-type Version = Int
-
-bumpVersion :: Version -> Version 
-bumpVersion v = v+1
-
-initialVersion :: Version
-initialVersion = 1
-\end{code}
-
-%************************************************************************
-%*									*
-		Deprecations
-%*									*
-%************************************************************************
-
-
-\begin{code}
-type DeprecTxt = FastString	-- reason/explanation for deprecation
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Implicit parameter identity}
-%*									*
-%************************************************************************
-
-The @IPName@ type is here because it is used in TypeRep (i.e. very
-early in the hierarchy), but also in HsSyn.
-
-\begin{code}
-data IPName name
-  = Dupable   name	-- ?x: you can freely duplicate this implicit parameter
-  | Linear name		-- %x: you must use the splitting function to duplicate it
-  deriving( Eq, Ord )	-- Ord is used in the IP name cache finite map
-			--	(used in HscTypes.OrigIParamCache)
-
-
-ipNameName :: IPName name -> name
-ipNameName (Dupable n) = n
-ipNameName (Linear  n) = n
-
-mapIPName :: (a->b) -> IPName a -> IPName b
-mapIPName f (Dupable n) = Dupable (f n)
-mapIPName f (Linear  n) = Linear  (f n)
-
-instance Outputable name => Outputable (IPName name) where
-    ppr (Dupable n) = char '?' <> ppr n -- Ordinary implicit parameters
-    ppr (Linear  n) = char '%' <> ppr n -- Splittable implicit parameters
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Fixity]{Fixity info}
-%*									*
-%************************************************************************
-
-\begin{code}
-------------------------
-data Fixity = Fixity Int FixityDirection
-
-instance Outputable Fixity where
-    ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
-
-instance Eq Fixity where		-- Used to determine if two fixities conflict
-  (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
-
-------------------------
-data FixityDirection = InfixL | InfixR | InfixN 
-		     deriving(Eq)
-
-instance Outputable FixityDirection where
-    ppr InfixL = ptext SLIT("infixl")
-    ppr InfixR = ptext SLIT("infixr")
-    ppr InfixN = ptext SLIT("infix")
-
-------------------------
-maxPrecedence = (9::Int)
-defaultFixity = Fixity maxPrecedence InfixL
-
-negateFixity, funTyFixity :: Fixity
--- Wired-in fixities
-negateFixity = Fixity 6 InfixL 	-- Fixity of unary negate
-funTyFixity  = Fixity 0	InfixR	-- Fixity of '->'
-\end{code}
-
-Consider
-
-\begin{verbatim}
-	a `op1` b `op2` c
-\end{verbatim}
-@(compareFixity op1 op2)@ tells which way to arrange appication, or
-whether there's an error.
-
-\begin{code}
-compareFixity :: Fixity -> Fixity
-	      -> (Bool,		-- Error please
-		  Bool)		-- Associate to the right: a op1 (b op2 c)
-compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
-  = case prec1 `compare` prec2 of
-	GT -> left
-	LT -> right
-	EQ -> case (dir1, dir2) of
-			(InfixR, InfixR) -> right
-			(InfixL, InfixL) -> left
-			_		 -> error_please
-  where
-    right	 = (False, True)
-    left         = (False, False)
-    error_please = (True,  False)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Top-level/local]{Top-level/not-top level flag}
-%*									*
-%************************************************************************
-
-\begin{code}
-data TopLevelFlag
-  = TopLevel
-  | NotTopLevel
-
-isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
-
-isNotTopLevel NotTopLevel = True
-isNotTopLevel TopLevel    = False
-
-isTopLevel TopLevel	= True
-isTopLevel NotTopLevel  = False
-
-instance Outputable TopLevelFlag where
-  ppr TopLevel    = ptext SLIT("<TopLevel>")
-  ppr NotTopLevel = ptext SLIT("<NotTopLevel>")
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Top-level/local]{Top-level/not-top level flag}
-%*									*
-%************************************************************************
-
-\begin{code}
-data Boxity
-  = Boxed
-  | Unboxed
-  deriving( Eq )
-
-isBoxed :: Boxity -> Bool
-isBoxed Boxed   = True
-isBoxed Unboxed = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Recursive/Non-Recursive]{Recursive/Non-Recursive flag}
-%*									*
-%************************************************************************
-
-\begin{code} 
-data RecFlag = Recursive 
-	     | NonRecursive
-	     deriving( Eq )
-
-isRec :: RecFlag -> Bool
-isRec Recursive    = True
-isRec NonRecursive = False
-
-isNonRec :: RecFlag -> Bool
-isNonRec Recursive    = False
-isNonRec NonRecursive = True
-
-boolToRecFlag :: Bool -> RecFlag
-boolToRecFlag True  = Recursive
-boolToRecFlag False = NonRecursive
-
-instance Outputable RecFlag where
-  ppr Recursive    = ptext SLIT("Recursive")
-  ppr NonRecursive = ptext SLIT("NonRecursive")
-\end{code}
-
-%************************************************************************
-%*									*
-		Tuples
-%*									*
-%************************************************************************
-
-\begin{code}
-data TupCon = TupCon Boxity Arity
-
-instance Eq TupCon where
-  (TupCon b1 a1) == (TupCon b2 a2) = b1==b2 && a1==a2
-   
-tupleParens :: Boxity -> SDoc -> SDoc
-tupleParens Boxed   p = parens p
-tupleParens Unboxed p = ptext SLIT("(#") <+> p <+> ptext SLIT("#)")
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Generic]{Generic flag}
-%*									*
-%************************************************************************
-
-This is the "Embedding-Projection pair" datatype, it contains 
-two pieces of code (normally either RenamedExpr's or Id's)
-If we have a such a pair (EP from to), the idea is that 'from' and 'to'
-represents functions of type 
-
-	from :: T -> Tring
-	to   :: Tring -> T
-
-And we should have 
-
-	to (from x) = x
-
-T and Tring are arbitrary, but typically T is the 'main' type while
-Tring is the 'representation' type.  (This just helps us remember 
-whether to use 'from' or 'to'.
-
-\begin{code}
-data EP a = EP { fromEP :: a,	-- :: T -> Tring
-		 toEP   :: a }	-- :: Tring -> T
-\end{code}
-
-Embedding-projection pairs are used in several places:
-
-First of all, each type constructor has an EP associated with it, the
-code in EP converts (datatype T) from T to Tring and back again.
-
-Secondly, when we are filling in Generic methods (in the typechecker, 
-tcMethodBinds), we are constructing bimaps by induction on the structure
-of the type of the method signature.
-
-
-%************************************************************************
-%*									*
-\subsection{Occurrence information}
-%*									*
-%************************************************************************
-
-This data type is used exclusively by the simplifier, but it appears in a
-SubstResult, which is currently defined in VarEnv, which is pretty near
-the base of the module hierarchy.  So it seemed simpler to put the
-defn of OccInfo here, safely at the bottom
-
-\begin{code}
-data OccInfo 
-  = NoOccInfo
-
-  | IAmDead		-- Marks unused variables.  Sometimes useful for
-			-- lambda and case-bound variables.
-
-  | OneOcc !InsideLam
- 	   !OneBranch
-	   !InterestingCxt
-
-  | IAmALoopBreaker	-- Used by the occurrence analyser to mark loop-breakers
-			-- in a group of recursive definitions
-
-isNoOcc :: OccInfo -> Bool
-isNoOcc NoOccInfo = True
-isNoOcc other     = False
-
-seqOccInfo :: OccInfo -> ()
-seqOccInfo occ = occ `seq` ()
-
------------------
-type InterestingCxt = Bool	-- True <=> Function: is applied
-				--	    Data value: scrutinised by a case with
-				--			at least one non-DEFAULT branch
-
------------------
-type InsideLam = Bool	-- True <=> Occurs inside a non-linear lambda
-			-- Substituting a redex for this occurrence is
-			-- dangerous because it might duplicate work.
-insideLam    = True
-notInsideLam = False
-
------------------
-type OneBranch = Bool	-- True <=> Occurs in only one case branch
-			--	so no code-duplication issue to worry about
-oneBranch    = True
-notOneBranch = False
-
-isLoopBreaker :: OccInfo -> Bool
-isLoopBreaker IAmALoopBreaker = True
-isLoopBreaker other	      = False
-
-isDeadOcc :: OccInfo -> Bool
-isDeadOcc IAmDead = True
-isDeadOcc other	  = False
-
-isOneOcc (OneOcc _ _ _) = True
-isOneOcc other	        = False
-
-isFragileOcc :: OccInfo -> Bool
-isFragileOcc (OneOcc _ _ _) = True
-isFragileOcc other	    = False
-\end{code}
-
-\begin{code}
-instance Outputable OccInfo where
-  -- only used for debugging; never parsed.  KSW 1999-07
-  ppr NoOccInfo  			  	  = empty
-  ppr IAmALoopBreaker 				  = ptext SLIT("LoopBreaker")
-  ppr IAmDead					  = ptext SLIT("Dead")
-  ppr (OneOcc inside_lam one_branch int_cxt)
-	= ptext SLIT("Once") <> pp_lam <> pp_br <> pp_args
-	where
-	  pp_lam | inside_lam = char 'L'
-		 | otherwise  = empty
-	  pp_br  | one_branch = empty
-		 | otherwise  = char '*'
-	  pp_args | int_cxt   = char '!'
-		  | otherwise = empty
-
-instance Show OccInfo where
-  showsPrec p occ = showsPrecSDoc p (ppr occ)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Strictness indication}
-%*									*
-%************************************************************************
-
-The strictness annotations on types in data type declarations
-e.g. 	data T = MkT !Int !(Bool,Bool)
-
-\begin{code}
-data StrictnessMark	-- Used in interface decls only
-   = MarkedStrict	
-   | MarkedUnboxed	
-   | NotMarkedStrict	
-   deriving( Eq )
-
-isMarkedUnboxed MarkedUnboxed = True
-isMarkedUnboxed other	      = False
-
-isMarkedStrict NotMarkedStrict = False
-isMarkedStrict other	       = True	-- All others are strict
-
-instance Outputable StrictnessMark where
-  ppr MarkedStrict     = ptext SLIT("!")
-  ppr MarkedUnboxed    = ptext SLIT("!!")
-  ppr NotMarkedStrict  = ptext SLIT("_")
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Success flag}
-%*									*
-%************************************************************************
-
-\begin{code}
-data SuccessFlag = Succeeded | Failed
-
-successIf :: Bool -> SuccessFlag
-successIf True  = Succeeded
-successIf False = Failed
-
-succeeded, failed :: SuccessFlag -> Bool
-succeeded Succeeded = True
-succeeded Failed    = False
-
-failed Succeeded = False
-failed Failed    = True
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Activation}
-%*									*
-%************************************************************************
-
-When a rule or inlining is active
-
-\begin{code}
-type CompilerPhase = Int	-- Compilation phase
-				-- Phases decrease towards zero
-				-- Zero is the last phase
-
-data Activation = NeverActive
-		| AlwaysActive
-		| ActiveBefore CompilerPhase	-- Active only *before* this phase
-		| ActiveAfter CompilerPhase	-- Active in this phase and later
-		deriving( Eq )			-- Eq used in comparing rules in HsDecls
-
-data InlineSpec
-  = Inline 
-	Activation	-- Says during which phases inlining is allowed
-	Bool 		-- True <=> make the RHS look small, so that when inlining
-			--	    is enabled, it will definitely actually happen
-  deriving( Eq )
-
-defaultInlineSpec = Inline AlwaysActive False	-- Inlining is OK, but not forced
-alwaysInlineSpec  = Inline AlwaysActive True	-- INLINE always
-neverInlineSpec   = Inline NeverActive  False	-- NOINLINE 
-
-instance Outputable Activation where
-   ppr AlwaysActive     = empty		-- The default
-   ppr (ActiveBefore n) = brackets (char '~' <> int n)
-   ppr (ActiveAfter n)  = brackets (int n)
-   ppr NeverActive      = ptext SLIT("NEVER")
-    
-instance Outputable InlineSpec where
-   ppr (Inline act True)  = ptext SLIT("INLINE") <> ppr act
-   ppr (Inline act False) = ptext SLIT("NOINLINE") <> ppr act
-
-isActive :: CompilerPhase -> Activation -> Bool
-isActive p NeverActive      = False
-isActive p AlwaysActive     = True
-isActive p (ActiveAfter n)  = p <= n
-isActive p (ActiveBefore n) = p >  n
-
-isNeverActive, isAlwaysActive :: Activation -> Bool
-isNeverActive NeverActive = True
-isNeverActive act	  = False
-
-isAlwaysActive AlwaysActive = True
-isAlwaysActive other	    = False
-\end{code}
-
diff --git a/ghc/compiler/basicTypes/DataCon.hi-boot-5 b/ghc/compiler/basicTypes/DataCon.hi-boot-5
deleted file mode 100644
index f5a8a2d6a8..0000000000
--- a/ghc/compiler/basicTypes/DataCon.hi-boot-5
+++ /dev/null
@@ -1,5 +0,0 @@
-__interface DataCon 1 0 where
-__export DataCon DataCon isExistentialDataCon dataConName ;
-1 data DataCon ;
-1 isExistentialDataCon :: DataCon -> PrelBase.Bool ;
-1 dataConName :: DataCon -> Name.Name ;
diff --git a/ghc/compiler/basicTypes/DataCon.hi-boot-6 b/ghc/compiler/basicTypes/DataCon.hi-boot-6
deleted file mode 100644
index 7882469bce..0000000000
--- a/ghc/compiler/basicTypes/DataCon.hi-boot-6
+++ /dev/null
@@ -1,5 +0,0 @@
-module DataCon where
-
-data DataCon
-dataConName :: DataCon -> Name.Name
-isVanillaDataCon :: DataCon -> GHC.Base.Bool
diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs
deleted file mode 100644
index 805ef73c59..0000000000
--- a/ghc/compiler/basicTypes/DataCon.lhs
+++ /dev/null
@@ -1,632 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-\section[DataCon]{@DataCon@: Data Constructors}
-
-\begin{code}
-module DataCon (
-	DataCon, DataConIds(..),
-	ConTag, fIRST_TAG,
-	mkDataCon,
-	dataConRepType, dataConSig, dataConName, dataConTag, dataConTyCon,
-	dataConTyVars, dataConResTys,
-	dataConStupidTheta, 
-	dataConInstArgTys, dataConOrigArgTys, dataConInstResTy,
-	dataConInstOrigArgTys, dataConRepArgTys, 
-	dataConFieldLabels, dataConFieldType,
-	dataConStrictMarks, dataConExStricts,
-	dataConSourceArity, dataConRepArity,
-	dataConIsInfix,
-	dataConWorkId, dataConWrapId, dataConWrapId_maybe, dataConImplicitIds,
-	dataConRepStrictness,
-	isNullarySrcDataCon, isNullaryRepDataCon, isTupleCon, isUnboxedTupleCon,
-	isVanillaDataCon, classDataCon, 
-
-	splitProductType_maybe, splitProductType,
-    ) where
-
-#include "HsVersions.h"
-
-import Type		( Type, ThetaType, substTyWith, substTy, zipOpenTvSubst,
-			  mkForAllTys, mkFunTys, mkTyConApp,
-			  splitTyConApp_maybe, 
-			  mkPredTys, isStrictPred, pprType
-			)
-import TyCon		( TyCon, FieldLabel, tyConDataCons, 
-			  isProductTyCon, isTupleTyCon, isUnboxedTupleTyCon )
-import Class		( Class, classTyCon )
-import Name		( Name, NamedThing(..), nameUnique )
-import Var		( TyVar, Id )
-import BasicTypes	( Arity, StrictnessMark(..) )
-import Outputable
-import Unique		( Unique, Uniquable(..) )
-import ListSetOps	( assoc )
-import Util		( zipEqual, zipWithEqual )
-import Maybes           ( expectJust )
-\end{code}
-
-
-Data constructor representation
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider the following Haskell data type declaration
-
-	data T = T !Int ![Int]
-
-Using the strictness annotations, GHC will represent this as
-
-	data T = T Int# [Int]
-
-That is, the Int has been unboxed.  Furthermore, the Haskell source construction
-
-	T e1 e2
-
-is translated to
-
-	case e1 of { I# x -> 
-	case e2 of { r ->
-	T x r }}
-
-That is, the first argument is unboxed, and the second is evaluated.  Finally,
-pattern matching is translated too:
-
-	case e of { T a b -> ... }
-
-becomes
-
-	case e of { T a' b -> let a = I# a' in ... }
-
-To keep ourselves sane, we name the different versions of the data constructor
-differently, as follows.
-
-
-Note [Data Constructor Naming]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Each data constructor C has two, and possibly three, Names associated with it:
-
-			     OccName	Name space	Used for
-  ---------------------------------------------------------------------------
-  * The "source data con" 	C	DataName	The DataCon itself
-  * The "real data con"		C	VarName		Its worker Id
-  * The "wrapper data con"	$WC	VarName		Wrapper Id (optional)
-
-Each of these three has a distinct Unique.  The "source data con" name
-appears in the output of the renamer, and names the Haskell-source
-data constructor.  The type checker translates it into either the wrapper Id
-(if it exists) or worker Id (otherwise).
-
-The data con has one or two Ids associated with it:
-
-  The "worker Id", is the actual data constructor.
-	Its type may be different to the Haskell source constructor
-	because:
-		- useless dict args are dropped
-		- strict args may be flattened
-	The worker is very like a primop, in that it has no binding.
-
-	Newtypes have no worker Id
-
-
-  The "wrapper Id", $WC, whose type is exactly what it looks like
-	in the source program. It is an ordinary function,
-	and it gets a top-level binding like any other function.
-
-	The wrapper Id isn't generated for a data type if the worker
-	and wrapper are identical.  It's always generated for a newtype.
-
-
-
-A note about the stupid context
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Data types can have a context:
-	
-	data (Eq a, Ord b) => T a b = T1 a b | T2 a
-
-and that makes the constructors have a context too
-(notice that T2's context is "thinned"):
-
-	T1 :: (Eq a, Ord b) => a -> b -> T a b
-	T2 :: (Eq a) => a -> T a b
-
-Furthermore, this context pops up when pattern matching
-(though GHC hasn't implemented this, but it is in H98, and
-I've fixed GHC so that it now does):
-
-	f (T2 x) = x
-gets inferred type
-	f :: Eq a => T a b -> a
-
-I say the context is "stupid" because the dictionaries passed
-are immediately discarded -- they do nothing and have no benefit.
-It's a flaw in the language.
-
-	Up to now [March 2002] I have put this stupid context into the
-	type of the "wrapper" constructors functions, T1 and T2, but
-	that turned out to be jolly inconvenient for generics, and
-	record update, and other functions that build values of type T
-	(because they don't have suitable dictionaries available).
-
-	So now I've taken the stupid context out.  I simply deal with
-	it separately in the type checker on occurrences of a
-	constructor, either in an expression or in a pattern.
-
-	[May 2003: actually I think this decision could evasily be
-	reversed now, and probably should be.  Generics could be
-	disabled for types with a stupid context; record updates now
-	(H98) needs the context too; etc.  It's an unforced change, so
-	I'm leaving it for now --- but it does seem odd that the
-	wrapper doesn't include the stupid context.]
-
-[July 04] With the advent of generalised data types, it's less obvious
-what the "stupid context" is.  Consider
-	C :: forall a. Ord a => a -> a -> T (Foo a)
-Does the C constructor in Core contain the Ord dictionary?  Yes, it must:
-
-	f :: T b -> Ordering
-	f = /\b. \x:T b. 
-	    case x of
-		C a (d:Ord a) (p:a) (q:a) -> compare d p q
-
-Note that (Foo a) might not be an instance of Ord.
-
-%************************************************************************
-%*									*
-\subsection{Data constructors}
-%*									*
-%************************************************************************
-
-\begin{code}
-data DataCon
-  = MkData {
-	dcName    :: Name,	-- This is the name of the *source data con*
-				-- (see "Note [Data Constructor Naming]" above)
-	dcUnique :: Unique, 	-- Cached from Name
-	dcTag    :: ConTag,
-
-	-- Running example:
-	--
-	--	data Eq a => T a = forall b. Ord b => MkT a [b]
-
-	-- The next six fields express the type of the constructor, in pieces
-	-- e.g.
-	--
-	--	dcTyVars      = [a,b]
-	-- 	dcStupidTheta = [Eq a]
-	--	dcTheta       = [Ord b]
-	--	dcOrigArgTys  = [a,List b]
-	--	dcTyCon       = T
-	--	dcTyArgs      = [a,b]
-
-	dcVanilla :: Bool,	-- True <=> This is a vanilla Haskell 98 data constructor
-				--	    Its type is of form
-				--	        forall a1..an . t1 -> ... tm -> T a1..an
-				-- 	    No existentials, no GADTs, nothing.
-				--
-				-- NB1: the order of the forall'd variables does matter;
-				--	for a vanilla constructor, we assume that if the result
-				--	type is (T t1 ... tn) then we can instantiate the constr
-				--	at types [t1, ..., tn]
-				--
-				-- NB2: a vanilla constructor can still be declared in GADT-style 
-				--	syntax, provided its type looks like the above.
-
-	dcTyVars :: [TyVar],	-- Universally-quantified type vars 
-				-- for the data constructor.
-		-- See NB1 on dcVanilla for the conneciton between dcTyVars and dcResTys
-		-- 
-		-- In general, the dcTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
-		-- FOR THE PARENT TyCon. With GADTs the data con might not even have 
-		-- the same number of type variables.
-		-- [This is a change (Oct05): previously, vanilla datacons guaranteed to
-		--  have the same type variables as their parent TyCon, but that seems ugly.]
-
-	dcStupidTheta  ::  ThetaType,	-- This is a "thinned" version of 
-					-- the context of the data decl.  
-		-- "Thinned", because the Report says
-		-- to eliminate any constraints that don't mention
-		-- tyvars free in the arg types for this constructor
-		--
-		-- "Stupid", because the dictionaries aren't used for anything.  
-		-- 
-		-- Indeed, [as of March 02] they are no 
-		-- longer in the type of the wrapper Id, because
-		-- that makes it harder to use the wrap-id to rebuild
-		-- values after record selection or in generics.
-		--
-		-- Fact: the free tyvars of dcStupidTheta are a subset of
-		--	 the free tyvars of dcResTys
-		-- Reason: dcStupidTeta is gotten by instantiating the 
-		--	   stupid theta from the tycon (see BuildTyCl.mkDataConStupidTheta)
-
-	dcTheta  :: ThetaType,		-- The existentially quantified stuff
-					
-	dcOrigArgTys :: [Type],		-- Original argument types
-					-- (before unboxing and flattening of
-					--  strict fields)
-
-	-- Result type of constructor is T t1..tn
-	dcTyCon  :: TyCon,		-- Result tycon, T
-	dcResTys :: [Type],		-- Result type args, t1..tn
-
-	-- Now the strictness annotations and field labels of the constructor
-	dcStrictMarks :: [StrictnessMark],
-		-- Strictness annotations as decided by the compiler.  
-		-- Does *not* include the existential dictionaries
-		-- length = dataConSourceArity dataCon
-
-	dcFields  :: [FieldLabel],
-		-- Field labels for this constructor, in the
-		-- same order as the argument types; 
-		-- length = 0 (if not a record) or dataConSourceArity.
-
-	-- Constructor representation
-	dcRepArgTys :: [Type],		-- Final, representation argument types, 
-					-- after unboxing and flattening,
-					-- and *including* existential dictionaries
-
-	dcRepStrictness :: [StrictnessMark],	-- One for each *representation* argument	
-
-	dcRepType   :: Type,	-- Type of the constructor
-				-- 	forall a b . Ord b => a -> [b] -> MkT a
-				-- (this is *not* of the constructor wrapper Id:
-				--  see notes after this data type declaration)
-				--
-	-- Notice that the existential type parameters come *second*.  
-	-- Reason: in a case expression we may find:
-	--	case (e :: T t) of { MkT b (d:Ord b) (x:t) (xs:[b]) -> ... }
-	-- It's convenient to apply the rep-type of MkT to 't', to get
-	--	forall b. Ord b => ...
-	-- and use that to check the pattern.  Mind you, this is really only
-	-- use in CoreLint.
-
-
-	-- Finally, the curried worker function that corresponds to the constructor
-	-- It doesn't have an unfolding; the code generator saturates these Ids
-	-- and allocates a real constructor when it finds one.
-	--
-	-- An entirely separate wrapper function is built in TcTyDecls
-	dcIds :: DataConIds,
-
-	dcInfix :: Bool		-- True <=> declared infix
-				-- Used for Template Haskell and 'deriving' only
-				-- The actual fixity is stored elsewhere
-  }
-
-data DataConIds
-  = NewDC Id			-- Newtypes have only a wrapper, but no worker
-  | AlgDC (Maybe Id) Id 	-- Algebraic data types always have a worker, and
-				-- may or may not have a wrapper, depending on whether
-				-- the wrapper does anything.
-
-	-- _Neither_ the worker _nor_ the wrapper take the dcStupidTheta dicts as arguments
-
-	-- The wrapper takes dcOrigArgTys as its arguments
-	-- The worker takes dcRepArgTys as its arguments
-	-- If the worker is absent, dcRepArgTys is the same as dcOrigArgTys
-
-	-- The 'Nothing' case of AlgDC is important
-	-- Not only is this efficient,
-	-- but it also ensures that the wrapper is replaced
-	-- by the worker (becuase it *is* the wroker)
-	-- even when there are no args. E.g. in
-	-- 		f (:) x
-	-- the (:) *is* the worker.
-	-- This is really important in rule matching,
-	-- (We could match on the wrappers,
-	-- but that makes it less likely that rules will match
-	-- when we bring bits of unfoldings together.)
-
-type ConTag = Int
-
-fIRST_TAG :: ConTag
-fIRST_TAG =  1	-- Tags allocated from here for real constructors
-\end{code}
-
-The dcRepType field contains the type of the representation of a contructor
-This may differ from the type of the contructor *Id* (built
-by MkId.mkDataConId) for two reasons:
-	a) the constructor Id may be overloaded, but the dictionary isn't stored
-	   e.g.    data Eq a => T a = MkT a a
-
-	b) the constructor may store an unboxed version of a strict field.
-
-Here's an example illustrating both:
-	data Ord a => T a = MkT Int! a
-Here
-	T :: Ord a => Int -> a -> T a
-but the rep type is
-	Trep :: Int# -> a -> T a
-Actually, the unboxed part isn't implemented yet!
-
-
-%************************************************************************
-%*									*
-\subsection{Instances}
-%*									*
-%************************************************************************
-
-\begin{code}
-instance Eq DataCon where
-    a == b = getUnique a == getUnique b
-    a /= b = getUnique a /= getUnique b
-
-instance Ord DataCon where
-    a <= b = getUnique a <= getUnique b
-    a <	 b = getUnique a <  getUnique b
-    a >= b = getUnique a >= getUnique b
-    a >	 b = getUnique a > getUnique b
-    compare a b = getUnique a `compare` getUnique b
-
-instance Uniquable DataCon where
-    getUnique = dcUnique
-
-instance NamedThing DataCon where
-    getName = dcName
-
-instance Outputable DataCon where
-    ppr con = ppr (dataConName con)
-
-instance Show DataCon where
-    showsPrec p con = showsPrecSDoc p (ppr con)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Construction}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkDataCon :: Name 
-	  -> Bool	-- Declared infix
-	  -> Bool	-- Vanilla (see notes with dcVanilla)
-	  -> [StrictnessMark] -> [FieldLabel]
-	  -> [TyVar] -> ThetaType -> ThetaType
-	  -> [Type] -> TyCon -> [Type]
-	  -> DataConIds
-	  -> DataCon
-  -- Can get the tag from the TyCon
-
-mkDataCon name declared_infix vanilla
-	  arg_stricts	-- Must match orig_arg_tys 1-1
-	  fields
-	  tyvars stupid_theta theta orig_arg_tys tycon res_tys
-	  ids
-  = con
-  where
-    con = MkData {dcName = name, 
-		  dcUnique = nameUnique name, dcVanilla = vanilla,
-	  	  dcTyVars = tyvars, dcStupidTheta = stupid_theta, dcTheta = theta,
-		  dcOrigArgTys = orig_arg_tys, dcTyCon = tycon, dcResTys = res_tys,
-		  dcRepArgTys = rep_arg_tys,
-		  dcStrictMarks = arg_stricts, dcRepStrictness = rep_arg_stricts,
-		  dcFields = fields, dcTag = tag, dcRepType = ty,
-		  dcIds = ids, dcInfix = declared_infix}
-
-	-- Strictness marks for source-args
-	--	*after unboxing choices*, 
-	-- but  *including existential dictionaries*
-	-- 
-	-- The 'arg_stricts' passed to mkDataCon are simply those for the
-	-- source-language arguments.  We add extra ones for the
-	-- dictionary arguments right here.
-    dict_tys     = mkPredTys theta
-    real_arg_tys = dict_tys                      ++ orig_arg_tys
-    real_stricts = map mk_dict_strict_mark theta ++ arg_stricts
-
-	-- Representation arguments and demands
-    (rep_arg_stricts, rep_arg_tys) = computeRep real_stricts real_arg_tys
-
-    tag = assoc "mkDataCon" (tyConDataCons tycon `zip` [fIRST_TAG..]) con
-    ty  = mkForAllTys tyvars (mkFunTys rep_arg_tys result_ty)
-		-- NB: the existential dict args are already in rep_arg_tys
-
-    result_ty = mkTyConApp tycon res_tys
-
-mk_dict_strict_mark pred | isStrictPred pred = MarkedStrict
-		         | otherwise	     = NotMarkedStrict
-\end{code}
-
-\begin{code}
-dataConName :: DataCon -> Name
-dataConName = dcName
-
-dataConTag :: DataCon -> ConTag
-dataConTag  = dcTag
-
-dataConTyCon :: DataCon -> TyCon
-dataConTyCon = dcTyCon
-
-dataConRepType :: DataCon -> Type
-dataConRepType = dcRepType
-
-dataConIsInfix :: DataCon -> Bool
-dataConIsInfix = dcInfix
-
-dataConTyVars :: DataCon -> [TyVar]
-dataConTyVars = dcTyVars
-
-dataConWorkId :: DataCon -> Id
-dataConWorkId dc = case dcIds dc of
-			AlgDC _ wrk_id -> wrk_id
-			NewDC _ -> pprPanic "dataConWorkId" (ppr dc)
-
-dataConWrapId_maybe :: DataCon -> Maybe Id
-dataConWrapId_maybe dc = case dcIds dc of
-				AlgDC mb_wrap _ -> mb_wrap
-				NewDC wrap	-> Just wrap
-
-dataConWrapId :: DataCon -> Id
--- Returns an Id which looks like the Haskell-source constructor
-dataConWrapId dc = case dcIds dc of
-			AlgDC (Just wrap) _   -> wrap
-			AlgDC Nothing     wrk -> wrk	    -- worker=wrapper
-			NewDC wrap	      -> wrap
-
-dataConImplicitIds :: DataCon -> [Id]
-dataConImplicitIds dc = case dcIds dc of
-			  AlgDC (Just wrap) work -> [wrap,work]
-			  AlgDC Nothing     work -> [work]
-			  NewDC wrap		 -> [wrap]
-
-dataConFieldLabels :: DataCon -> [FieldLabel]
-dataConFieldLabels = dcFields
-
-dataConFieldType :: DataCon -> FieldLabel -> Type
-dataConFieldType con label = expectJust "unexpected label" $
-    lookup label (dcFields con `zip` dcOrigArgTys con)
-
-dataConStrictMarks :: DataCon -> [StrictnessMark]
-dataConStrictMarks = dcStrictMarks
-
-dataConExStricts :: DataCon -> [StrictnessMark]
--- Strictness of *existential* arguments only
--- Usually empty, so we don't bother to cache this
-dataConExStricts dc = map mk_dict_strict_mark (dcTheta dc)
-
-dataConSourceArity :: DataCon -> Arity
-	-- Source-level arity of the data constructor
-dataConSourceArity dc = length (dcOrigArgTys dc)
-
--- dataConRepArity gives the number of actual fields in the
--- {\em representation} of the data constructor.  This may be more than appear
--- in the source code; the extra ones are the existentially quantified
--- dictionaries
-dataConRepArity (MkData {dcRepArgTys = arg_tys}) = length arg_tys
-
-isNullarySrcDataCon, isNullaryRepDataCon :: DataCon -> Bool
-isNullarySrcDataCon dc = null (dcOrigArgTys dc)
-isNullaryRepDataCon dc = null (dcRepArgTys dc)
-
-dataConRepStrictness :: DataCon -> [StrictnessMark]
-	-- Give the demands on the arguments of a
-	-- Core constructor application (Con dc args)
-dataConRepStrictness dc = dcRepStrictness dc
-
-dataConSig :: DataCon -> ([TyVar], ThetaType,
-			  [Type], TyCon, [Type])
-
-dataConSig (MkData {dcTyVars = tyvars, dcTheta  = theta,
-		    dcOrigArgTys = arg_tys, dcTyCon = tycon, dcResTys = res_tys})
-  = (tyvars, theta, arg_tys, tycon, res_tys)
-
-dataConStupidTheta :: DataCon -> ThetaType
-dataConStupidTheta dc = dcStupidTheta dc
-
-dataConResTys :: DataCon -> [Type]
-dataConResTys dc = dcResTys dc
-
-dataConInstArgTys :: DataCon
-	      	  -> [Type] 	-- Instantiated at these types
-	      	  		-- NB: these INCLUDE the existentially quantified arg types
-	      	  -> [Type]	-- Needs arguments of these types
-				-- NB: these INCLUDE the existentially quantified dict args
-				--     but EXCLUDE the data-decl context which is discarded
-				-- It's all post-flattening etc; this is a representation type
-dataConInstArgTys (MkData {dcRepArgTys = arg_tys, dcTyVars = tyvars}) inst_tys
- = ASSERT( length tyvars == length inst_tys )
-   map (substTyWith tyvars inst_tys) arg_tys
-
-dataConInstResTy :: DataCon -> [Type] -> Type
-dataConInstResTy (MkData {dcTyVars = tyvars, dcTyCon = tc, dcResTys = res_tys}) inst_tys
- = ASSERT( length tyvars == length inst_tys )
-   substTy (zipOpenTvSubst tyvars inst_tys) (mkTyConApp tc res_tys)
-	-- res_tys can't currently contain any foralls,
-	-- but might in future; hence zipOpenTvSubst
-
--- And the same deal for the original arg tys
-dataConInstOrigArgTys :: DataCon -> [Type] -> [Type]
-dataConInstOrigArgTys (MkData {dcOrigArgTys = arg_tys, dcTyVars = tyvars}) inst_tys
- = ASSERT( length tyvars == length inst_tys )
-   map (substTyWith tyvars inst_tys) arg_tys
-\end{code}
-
-These two functions get the real argument types of the constructor,
-without substituting for any type variables.
-
-dataConOrigArgTys returns the arg types of the wrapper, excluding all dictionary args.
-
-dataConRepArgTys retuns the arg types of the worker, including all dictionaries, and
-after any flattening has been done.
-
-\begin{code}
-dataConOrigArgTys :: DataCon -> [Type]
-dataConOrigArgTys dc = dcOrigArgTys dc
-
-dataConRepArgTys :: DataCon -> [Type]
-dataConRepArgTys dc = dcRepArgTys dc
-\end{code}
-
-
-\begin{code}
-isTupleCon :: DataCon -> Bool
-isTupleCon (MkData {dcTyCon = tc}) = isTupleTyCon tc
-	
-isUnboxedTupleCon :: DataCon -> Bool
-isUnboxedTupleCon (MkData {dcTyCon = tc}) = isUnboxedTupleTyCon tc
-
-isVanillaDataCon :: DataCon -> Bool
-isVanillaDataCon dc = dcVanilla dc
-\end{code}
-
-
-\begin{code}
-classDataCon :: Class -> DataCon
-classDataCon clas = case tyConDataCons (classTyCon clas) of
-		      (dict_constr:no_more) -> ASSERT( null no_more ) dict_constr 
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Splitting products}
-%*									*
-%************************************************************************
-
-\begin{code}
-splitProductType_maybe
-	:: Type 			-- A product type, perhaps
-	-> Maybe (TyCon, 		-- The type constructor
-		  [Type],		-- Type args of the tycon
-		  DataCon,		-- The data constructor
-		  [Type])		-- Its *representation* arg types
-
-	-- Returns (Just ...) for any
-	--	concrete (i.e. constructors visible)
-	--	single-constructor
-	--	not existentially quantified
-	-- type whether a data type or a new type
-	--
-	-- Rejecing existentials is conservative.  Maybe some things
-	-- could be made to work with them, but I'm not going to sweat
-	-- it through till someone finds it's important.
-
-splitProductType_maybe ty
-  = case splitTyConApp_maybe ty of
-	Just (tycon,ty_args)
-	   | isProductTyCon tycon  	-- Includes check for non-existential,
-					-- and for constructors visible
-	   -> Just (tycon, ty_args, data_con, dataConInstArgTys data_con ty_args)
-	   where
-	      data_con = head (tyConDataCons tycon)
-	other -> Nothing
-
-splitProductType str ty
-  = case splitProductType_maybe ty of
-	Just stuff -> stuff
-	Nothing    -> pprPanic (str ++ ": not a product") (pprType ty)
-
-
-computeRep :: [StrictnessMark]		-- Original arg strictness
-	   -> [Type]			-- and types
-	   -> ([StrictnessMark],	-- Representation arg strictness
-	       [Type])			-- And type
-
-computeRep stricts tys
-  = unzip $ concat $ zipWithEqual "computeRep" unbox stricts tys
-  where
-    unbox NotMarkedStrict ty = [(NotMarkedStrict, ty)]
-    unbox MarkedStrict    ty = [(MarkedStrict,    ty)]
-    unbox MarkedUnboxed   ty = zipEqual "computeRep" (dataConRepStrictness arg_dc) arg_tys
-			     where
-			       (_, _, arg_dc, arg_tys) = splitProductType "unbox_strict_arg_ty" ty
-\end{code}
diff --git a/ghc/compiler/basicTypes/DataCon.lhs-boot b/ghc/compiler/basicTypes/DataCon.lhs-boot
deleted file mode 100644
index c5e05c9ecd..0000000000
--- a/ghc/compiler/basicTypes/DataCon.lhs-boot
+++ /dev/null
@@ -1,8 +0,0 @@
-\begin{code}
-module DataCon where
-import Name( Name )
-
-data DataCon
-dataConName      :: DataCon -> Name
-isVanillaDataCon :: DataCon -> Bool
-\end{code}
diff --git a/ghc/compiler/basicTypes/Demand.lhs b/ghc/compiler/basicTypes/Demand.lhs
deleted file mode 100644
index 50bb0c6ffa..0000000000
--- a/ghc/compiler/basicTypes/Demand.lhs
+++ /dev/null
@@ -1,208 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Demand]{@Demand@: the amount of demand on a value}
-
-\begin{code}
-#ifndef OLD_STRICTNESS
-module Demand () where
-#else
-
-module Demand(
-	Demand(..),
-
-	wwLazy, wwStrict, wwUnpack, wwPrim, wwEnum, 
-	isStrict, isLazy, isPrim,
-
-	pprDemands, seqDemand, seqDemands,
-
-	StrictnessInfo(..),	
-	mkStrictnessInfo,
-	noStrictnessInfo,
-	ppStrictnessInfo, seqStrictnessInfo,
-	isBottomingStrictness, appIsBottom,
-
-     ) where
-
-#include "HsVersions.h"
-
-import Outputable
-import Util ( listLengthCmp )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The @Demand@ data type}
-%*									*
-%************************************************************************
-
-\begin{code}
-data Demand
-  = WwLazy		-- Argument is lazy as far as we know
-	MaybeAbsent	-- (does not imply worker's existence [etc]).
-			-- If MaybeAbsent == True, then it is
-			--  *definitely* lazy.  (NB: Absence implies
-			-- a worker...)
-
-  | WwStrict		-- Argument is strict but that's all we know
-			-- (does not imply worker's existence or any
-			-- calling-convention magic)
-
-  | WwUnpack		-- Argument is strict & a single-constructor type
-	Bool		-- True <=> wrapper unpacks it; False <=> doesn't
-	[Demand]	-- Its constituent parts (whose StrictInfos
-			-- are in the list) should be passed
-			-- as arguments to the worker.
-
-  | WwPrim		-- Argument is of primitive type, therefore
-			-- strict; doesn't imply existence of a worker;
-			-- argument should be passed as is to worker.
-
-  | WwEnum		-- Argument is strict & an enumeration type;
-			-- an Int# representing the tag (start counting
-			-- at zero) should be passed to the worker.
-  deriving( Eq )
-
-type MaybeAbsent = Bool -- True <=> not even used
-
--- versions that don't worry about Absence:
-wwLazy	    = WwLazy 	  False
-wwStrict    = WwStrict
-wwUnpack xs = WwUnpack False xs
-wwPrim	    = WwPrim
-wwEnum	    = WwEnum
-
-seqDemand :: Demand -> ()
-seqDemand (WwLazy a)      = a `seq` ()
-seqDemand (WwUnpack b ds) = b `seq` seqDemands ds
-seqDemand other		  = ()
-
-seqDemands [] = ()
-seqDemands (d:ds) = seqDemand d `seq` seqDemands ds
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Functions over @Demand@}
-%*									*
-%************************************************************************
-
-\begin{code}
-isLazy :: Demand -> Bool
-isLazy (WwLazy _) = True
-isLazy _	  = False
-
-isStrict :: Demand -> Bool
-isStrict d = not (isLazy d)
-
-isPrim :: Demand -> Bool
-isPrim WwPrim = True
-isPrim other  = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Instances}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
-		       where
-			 pp_bot | bot       = ptext SLIT("B")
-				| otherwise = empty
-
-
-pprDemand (WwLazy False)  	 = char 'L'
-pprDemand (WwLazy True)   	 = char 'A'
-pprDemand WwStrict	      	 = char 'S'
-pprDemand WwPrim	      	 = char 'P'
-pprDemand WwEnum	      	 = char 'E'
-pprDemand (WwUnpack wu args)     = char ch <> parens (hcat (map pprDemand args))
-				      where
-					ch = if wu then 'U' else 'u'
-
-instance Outputable Demand where
-    ppr (WwLazy False) = empty
-    ppr other_demand   = ptext SLIT("__D") <+> pprDemand other_demand
-
-instance Show Demand where
-    showsPrec p d = showsPrecSDoc p (ppr d)
-
--- Reading demands is done in Lex.lhs
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[strictness-IdInfo]{Strictness info about an @Id@}
-%*									*
-%************************************************************************
-
-We specify the strictness of a function by giving information about
-each of the ``wrapper's'' arguments (see the description about
-worker/wrapper-style transformations in the PJ/Launchbury paper on
-unboxed types).
-
-The list of @Demands@ specifies: (a)~the strictness properties of a
-function's arguments; and (b)~the type signature of that worker (if it
-exists); i.e. its calling convention.
-
-Note that the existence of a worker function is now denoted by the Id's
-workerInfo field.
-
-\begin{code}
-data StrictnessInfo
-  = NoStrictnessInfo
-
-  | StrictnessInfo [Demand] 	-- Demands on the arguments.
-
-		   Bool		-- True <=> the function diverges regardless of its arguments
-				-- Useful for "error" and other disguised variants thereof.  
-				-- BUT NB: f = \x y. error "urk"
-				-- 	   will have info  SI [SS] True
-				-- but still (f) and (f 2) are not bot; only (f 3 2) is bot
-  deriving( Eq )
-
-	-- NOTA BENE: if the arg demands are, say, [S,L], this means that
-	-- 	(f bot) is not necy bot, only (f bot x) is bot
-	-- We simply cannot express accurately the strictness of a function
-	-- like		f = \x -> case x of (a,b) -> \y -> ...
-	-- The up-side is that we don't need to restrict the strictness info
-	-- to the visible arity of the function.
-
-seqStrictnessInfo :: StrictnessInfo -> ()
-seqStrictnessInfo (StrictnessInfo ds b) = b `seq` seqDemands ds
-seqStrictnessInfo other		        = ()
-\end{code}
-
-\begin{code}
-mkStrictnessInfo :: ([Demand], Bool) -> StrictnessInfo
-
-mkStrictnessInfo (xs, is_bot)
-  | all totally_boring xs && not is_bot	= NoStrictnessInfo		-- Uninteresting
-  | otherwise		    	        = StrictnessInfo xs is_bot
-  where
-    totally_boring (WwLazy False) = True
-    totally_boring other	  = False
-
-noStrictnessInfo = NoStrictnessInfo
-
-isBottomingStrictness (StrictnessInfo _ bot) = bot
-isBottomingStrictness NoStrictnessInfo       = False
-
--- appIsBottom returns true if an application to n args would diverge
-appIsBottom (StrictnessInfo ds bot)   n = bot && (listLengthCmp ds n /=GT) -- not more than 'n' elts in 'ds'.
-appIsBottom  NoStrictnessInfo	      n	= False
-
-ppStrictnessInfo NoStrictnessInfo		   = empty
-ppStrictnessInfo (StrictnessInfo wrapper_args bot) = hsep [pprDemands wrapper_args bot]
-\end{code}
-
-\begin{code}
-#endif /* OLD_STRICTNESS */
-\end{code}
diff --git a/ghc/compiler/basicTypes/FieldLabel.lhs b/ghc/compiler/basicTypes/FieldLabel.lhs
deleted file mode 100644
index b388d378d7..0000000000
--- a/ghc/compiler/basicTypes/FieldLabel.lhs
+++ /dev/null
@@ -1,71 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1996-1998
-%
-\section[FieldLabel]{The @FieldLabel@ type}
-
-\begin{code}
-module FieldLabel(
-	FieldLabel,	-- Abstract
-
-	mkFieldLabel, 
-	fieldLabelName,	fieldLabelTyCon, fieldLabelType, fieldLabelTag,
-
-	FieldLabelTag,
-	firstFieldLabelTag, allFieldLabelTags
-  ) where
-
-#include "HsVersions.h"
-
-import Type( Type )
-import TyCon( TyCon )
-import Name		( Name{-instance Eq/Outputable-}, NamedThing(..), nameUnique )
-import Outputable
-import Unique           ( Uniquable(..) )
-\end{code}
-
-\begin{code}
-data FieldLabel
-  = FieldLabel	Name	        -- Also used as the Name of the field selector Id
-
-		TyCon		-- Parent type constructor
-
-		Type		-- Type of the field; may have free type variables that
-				-- are the tyvars of its parent *data* constructor, and
-				-- those will be the same as the tyvars of its parent *type* constructor
-				-- e.g.  data T a = MkT { op1 :: a -> a, op2 :: a -> Int }
-				-- The type in the FieldLabel for op1 will be simply (a->a).
-
-		FieldLabelTag	-- Indicates position within constructor
-				-- (starting with firstFieldLabelTag)
-				--
-				-- If the same field occurs in more than one constructor
-				-- then it'll have a separate FieldLabel on each occasion,
-				-- but with a single name (and presumably the same type!)
-
-type FieldLabelTag = Int
-
-mkFieldLabel = FieldLabel
-
-firstFieldLabelTag :: FieldLabelTag
-firstFieldLabelTag = 1
-
-allFieldLabelTags :: [FieldLabelTag]
-allFieldLabelTags = [firstFieldLabelTag..]
-
-fieldLabelName  (FieldLabel n _ _  _)   = n
-fieldLabelTyCon (FieldLabel _ tc _ _)   = tc
-fieldLabelType  (FieldLabel _ _ ty _)   = ty
-fieldLabelTag   (FieldLabel _ _ _  tag) = tag
-
-instance Eq FieldLabel where
-    fl1 == fl2 = fieldLabelName fl1 == fieldLabelName fl2
-
-instance Outputable FieldLabel where
-    ppr fl = ppr (fieldLabelName fl)
-
-instance NamedThing FieldLabel where
-    getName = fieldLabelName
-
-instance Uniquable FieldLabel where
-    getUnique fl = nameUnique (fieldLabelName fl)
-\end{code}
diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
deleted file mode 100644
index c7ce818adb..0000000000
--- a/ghc/compiler/basicTypes/Id.lhs
+++ /dev/null
@@ -1,529 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Id]{@Ids@: Value and constructor identifiers}
-
-\begin{code}
-module Id (
-	Id, DictId,
-
-	-- Simple construction
-	mkGlobalId, mkLocalId, mkLocalIdWithInfo, 
-	mkSysLocal, mkUserLocal, mkVanillaGlobal,
-	mkTemplateLocals, mkTemplateLocalsNum, mkWildId, mkTemplateLocal,
-	mkWorkerId, mkExportedLocalId,
-
-	-- Taking an Id apart
-	idName, idType, idUnique, idInfo,
-	isId, globalIdDetails, idPrimRep,
-	recordSelectorFieldLabel,
-
-	-- Modifying an Id
-	setIdName, setIdUnique, Id.setIdType, setIdExported, setIdNotExported, 
-	setIdInfo, lazySetIdInfo, modifyIdInfo, maybeModifyIdInfo,
-	zapLamIdInfo, zapDemandIdInfo, 
-
-	-- Predicates
-	isImplicitId, isDeadBinder, isDictId,
-	isExportedId, isLocalId, isGlobalId,
-	isRecordSelector, isNaughtyRecordSelector,
-	isClassOpId_maybe,
-	isPrimOpId, isPrimOpId_maybe, 
-	isFCallId, isFCallId_maybe,
-	isDataConWorkId, isDataConWorkId_maybe, isDataConId_maybe, idDataCon,
-	isBottomingId, idIsFrom,
-	hasNoBinding, 
-
-	-- Inline pragma stuff
-	idInlinePragma, setInlinePragma, modifyInlinePragma, 
-
-
-	-- One shot lambda stuff
-	isOneShotBndr, isOneShotLambda, isStateHackType,
-	setOneShotLambda, clearOneShotLambda,
-
-	-- IdInfo stuff
-	setIdUnfolding,
-	setIdArity,
-	setIdNewDemandInfo, 
-	setIdNewStrictness, zapIdNewStrictness,
-	setIdWorkerInfo,
-	setIdSpecialisation,
-	setIdCafInfo,
-	setIdOccInfo,
-
-#ifdef OLD_STRICTNESS
-	idDemandInfo, 
-	idStrictness, 
-	idCprInfo,
-	setIdStrictness, 
-	setIdDemandInfo, 
-	setIdCprInfo,
-#endif
-
-	idArity, 
-	idNewDemandInfo, idNewDemandInfo_maybe,
-	idNewStrictness, idNewStrictness_maybe, 
-	idWorkerInfo,
-	idUnfolding,
-	idSpecialisation, idCoreRules,
-	idCafInfo,
-	idLBVarInfo,
-	idOccInfo,
-
-#ifdef OLD_STRICTNESS
-	newStrictnessFromOld 	-- Temporary
-#endif
-
-    ) where
-
-#include "HsVersions.h"
-
-
-import CoreSyn		( Unfolding, CoreRule )
-import BasicTypes	( Arity )
-import Var		( Id, DictId,
-			  isId, isExportedId, isLocalId,
-			  idName, idType, idUnique, idInfo, isGlobalId,
-			  setIdName, setIdType, setIdUnique, 
-			  setIdExported, setIdNotExported,
-			  setIdInfo, lazySetIdInfo, modifyIdInfo, 
-			  maybeModifyIdInfo,
-			  globalIdDetails
-			)
-import qualified Var	( mkLocalId, mkGlobalId, mkExportedLocalId )
-import TyCon		( FieldLabel, TyCon )
-import Type		( Type, typePrimRep, addFreeTyVars, seqType, 
-			  splitTyConApp_maybe, PrimRep )
-import TcType		( isDictTy )
-import TysPrim		( statePrimTyCon )
-import IdInfo 
-
-#ifdef OLD_STRICTNESS
-import qualified Demand	( Demand )
-#endif
-import DataCon		( DataCon, isUnboxedTupleCon )
-import NewDemand	( Demand, StrictSig, topDmd, topSig, isBottomingSig )
-import Name	 	( Name, OccName, nameIsLocalOrFrom, 
-			  mkSystemVarName, mkInternalName, getOccName,
-			  getSrcLoc ) 
-import Module		( Module )
-import OccName		( mkWorkerOcc )
-import Maybes		( orElse )
-import SrcLoc		( SrcLoc )
-import Outputable
-import Unique		( Unique, mkBuiltinUnique )
-import FastString	( FastString )
-import StaticFlags	( opt_NoStateHack )
-
--- infixl so you can say (id `set` a `set` b)
-infixl 	1 `setIdUnfolding`,
-	  `setIdArity`,
-	  `setIdNewDemandInfo`,
-	  `setIdNewStrictness`,
-	  `setIdWorkerInfo`,
-	  `setIdSpecialisation`,
-	  `setInlinePragma`,
-	  `idCafInfo`
-#ifdef OLD_STRICTNESS
-	  ,`idCprInfo`
-	  ,`setIdStrictness`
-	  ,`setIdDemandInfo`
-#endif
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Simple Id construction}
-%*									*
-%************************************************************************
-
-Absolutely all Ids are made by mkId.  It is just like Var.mkId,
-but in addition it pins free-tyvar-info onto the Id's type, 
-where it can easily be found.
-
-\begin{code}
-mkLocalIdWithInfo :: Name -> Type -> IdInfo -> Id
-mkLocalIdWithInfo name ty info = Var.mkLocalId name (addFreeTyVars ty) info
-
-mkExportedLocalId :: Name -> Type -> Id
-mkExportedLocalId name ty = Var.mkExportedLocalId name (addFreeTyVars ty) vanillaIdInfo
-
-mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
-mkGlobalId details name ty info = Var.mkGlobalId details name (addFreeTyVars ty) info
-\end{code}
-
-\begin{code}
-mkLocalId :: Name -> Type -> Id
-mkLocalId name ty = mkLocalIdWithInfo name ty vanillaIdInfo
-
--- SysLocal: for an Id being created by the compiler out of thin air...
--- UserLocal: an Id with a name the user might recognize...
-mkUserLocal :: OccName -> Unique -> Type -> SrcLoc -> Id
-mkSysLocal  :: FastString  -> Unique -> Type -> Id
-mkVanillaGlobal :: Name -> Type -> IdInfo -> Id
-
-mkSysLocal fs uniq ty = mkLocalId (mkSystemVarName uniq fs) ty
-
-mkUserLocal occ uniq ty loc = mkLocalId (mkInternalName    uniq occ loc) ty
-mkVanillaGlobal 	    = mkGlobalId VanillaGlobal
-\end{code}
-
-Make some local @Ids@ for a template @CoreExpr@.  These have bogus
-@Uniques@, but that's OK because the templates are supposed to be
-instantiated before use.
- 
-\begin{code}
--- "Wild Id" typically used when you need a binder that you don't expect to use
-mkWildId :: Type -> Id
-mkWildId ty = mkSysLocal FSLIT("wild") (mkBuiltinUnique 1) ty
-
-mkWorkerId :: Unique -> Id -> Type -> Id
--- A worker gets a local name.  CoreTidy will externalise it if necessary.
-mkWorkerId uniq unwrkr ty
-  = mkLocalId wkr_name ty
-  where
-    wkr_name = mkInternalName uniq (mkWorkerOcc (getOccName unwrkr)) (getSrcLoc unwrkr)
-
--- "Template locals" typically used in unfoldings
-mkTemplateLocals :: [Type] -> [Id]
-mkTemplateLocals tys = zipWith mkTemplateLocal [1..] tys
-
-mkTemplateLocalsNum :: Int -> [Type] -> [Id]
--- The Int gives the starting point for unique allocation
-mkTemplateLocalsNum n tys = zipWith mkTemplateLocal [n..] tys
-
-mkTemplateLocal :: Int -> Type -> Id
-mkTemplateLocal i ty = mkSysLocal FSLIT("tpl") (mkBuiltinUnique i) ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Id-general-funs]{General @Id@-related functions}
-%*									*
-%************************************************************************
-
-\begin{code}
-setIdType :: Id -> Type -> Id
-	-- Add free tyvar info to the type
-setIdType id ty = seqType ty `seq` Var.setIdType id (addFreeTyVars ty)
-
-idPrimRep :: Id -> PrimRep
-idPrimRep id = typePrimRep (idType id)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Special Ids}
-%*									*
-%************************************************************************
-
-\begin{code}
-recordSelectorFieldLabel :: Id -> (TyCon, FieldLabel)
-recordSelectorFieldLabel id = case globalIdDetails id of
-				 RecordSelId tycon lbl _ -> (tycon,lbl)
-				 other -> panic "recordSelectorFieldLabel"
-
-isRecordSelector id = case globalIdDetails id of
-			RecordSelId {}  -> True
-			other	  	-> False
-
-isNaughtyRecordSelector id = case globalIdDetails id of
-			RecordSelId { sel_naughty = n } -> n
-			other	  	  	        -> False
-
-isClassOpId_maybe id = case globalIdDetails id of
-			ClassOpId cls -> Just cls
-			_other        -> Nothing
-
-isPrimOpId id = case globalIdDetails id of
-		    PrimOpId op -> True
-		    other	-> False
-
-isPrimOpId_maybe id = case globalIdDetails id of
-			    PrimOpId op -> Just op
-			    other	-> Nothing
-
-isFCallId id = case globalIdDetails id of
-		    FCallId call -> True
-		    other	 -> False
-
-isFCallId_maybe id = case globalIdDetails id of
-			    FCallId call -> Just call
-			    other	 -> Nothing
-
-isDataConWorkId id = case globalIdDetails id of
-			DataConWorkId _ -> True
-			other	        -> False
-
-isDataConWorkId_maybe id = case globalIdDetails id of
-			  DataConWorkId con -> Just con
-			  other	            -> Nothing
-
-isDataConId_maybe :: Id -> Maybe DataCon
-isDataConId_maybe id = case globalIdDetails id of
-		 	 DataConWorkId con -> Just con
-			 DataConWrapId con -> Just con
-			 other		    -> Nothing
-
-idDataCon :: Id -> DataCon
--- Get from either the worker or the wrapper to the DataCon
--- Currently used only in the desugarer
---	 INVARIANT: idDataCon (dataConWrapId d) = d
--- (Remember, dataConWrapId can return either the wrapper or the worker.)
-idDataCon id = case globalIdDetails id of
-		  DataConWorkId con -> con
-		  DataConWrapId con -> con
-		  other		    -> pprPanic "idDataCon" (ppr id)
-
-
-isDictId :: Id -> Bool
-isDictId id = isDictTy (idType id)
-
--- hasNoBinding returns True of an Id which may not have a
--- binding, even though it is defined in this module.  
--- Data constructor workers used to be things of this kind, but
--- they aren't any more.  Instead, we inject a binding for 
--- them at the CorePrep stage. 
--- EXCEPT: unboxed tuples, which definitely have no binding
-hasNoBinding id = case globalIdDetails id of
-			PrimOpId _  	 -> True
-			FCallId _   	 -> True
-			DataConWorkId dc -> isUnboxedTupleCon dc
-			other	         -> False
-
-isImplicitId :: Id -> Bool
-	-- isImplicitId tells whether an Id's info is implied by other
-	-- declarations, so we don't need to put its signature in an interface
-	-- file, even if it's mentioned in some other interface unfolding.
-isImplicitId id
-  = case globalIdDetails id of
-	RecordSelId {}  -> True
-        FCallId _       -> True
-        PrimOpId _      -> True
-	ClassOpId _	-> True
-        DataConWorkId _ -> True
-	DataConWrapId _ -> True
-		-- These are are implied by their type or class decl;
-		-- remember that all type and class decls appear in the interface file.
-		-- The dfun id is not an implicit Id; it must *not* be omitted, because 
-		-- it carries version info for the instance decl
-	other		-> False
-
-idIsFrom :: Module -> Id -> Bool
-idIsFrom mod id = nameIsLocalOrFrom mod (idName id)
-\end{code}
-
-\begin{code}
-isDeadBinder :: Id -> Bool
-isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)
-		  | otherwise = False	-- TyVars count as not dead
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{IdInfo stuff}
-%*									*
-%************************************************************************
-
-\begin{code}
-	---------------------------------
-	-- ARITY
-idArity :: Id -> Arity
-idArity id = arityInfo (idInfo id)
-
-setIdArity :: Id -> Arity -> Id
-setIdArity id arity = modifyIdInfo (`setArityInfo` arity) id
-
-#ifdef OLD_STRICTNESS
-	---------------------------------
-	-- (OLD) STRICTNESS 
-idStrictness :: Id -> StrictnessInfo
-idStrictness id = strictnessInfo (idInfo id)
-
-setIdStrictness :: Id -> StrictnessInfo -> Id
-setIdStrictness id strict_info = modifyIdInfo (`setStrictnessInfo` strict_info) id
-#endif
-
--- isBottomingId returns true if an application to n args would diverge
-isBottomingId :: Id -> Bool
-isBottomingId id = isBottomingSig (idNewStrictness id)
-
-idNewStrictness_maybe :: Id -> Maybe StrictSig
-idNewStrictness :: Id -> StrictSig
-
-idNewStrictness_maybe id = newStrictnessInfo (idInfo id)
-idNewStrictness       id = idNewStrictness_maybe id `orElse` topSig
-
-setIdNewStrictness :: Id -> StrictSig -> Id
-setIdNewStrictness id sig = modifyIdInfo (`setNewStrictnessInfo` Just sig) id
-
-zapIdNewStrictness :: Id -> Id
-zapIdNewStrictness id = modifyIdInfo (`setNewStrictnessInfo` Nothing) id
-
-	---------------------------------
-	-- WORKER ID
-idWorkerInfo :: Id -> WorkerInfo
-idWorkerInfo id = workerInfo (idInfo id)
-
-setIdWorkerInfo :: Id -> WorkerInfo -> Id
-setIdWorkerInfo id work_info = modifyIdInfo (`setWorkerInfo` work_info) id
-
-	---------------------------------
-	-- UNFOLDING
-idUnfolding :: Id -> Unfolding
-idUnfolding id = unfoldingInfo (idInfo id)
-
-setIdUnfolding :: Id -> Unfolding -> Id
-setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id
-
-#ifdef OLD_STRICTNESS
-	---------------------------------
-	-- (OLD) DEMAND
-idDemandInfo :: Id -> Demand.Demand
-idDemandInfo id = demandInfo (idInfo id)
-
-setIdDemandInfo :: Id -> Demand.Demand -> Id
-setIdDemandInfo id demand_info = modifyIdInfo (`setDemandInfo` demand_info) id
-#endif
-
-idNewDemandInfo_maybe :: Id -> Maybe NewDemand.Demand
-idNewDemandInfo       :: Id -> NewDemand.Demand
-
-idNewDemandInfo_maybe id = newDemandInfo (idInfo id)
-idNewDemandInfo       id = newDemandInfo (idInfo id) `orElse` NewDemand.topDmd
-
-setIdNewDemandInfo :: Id -> NewDemand.Demand -> Id
-setIdNewDemandInfo id dmd = modifyIdInfo (`setNewDemandInfo` Just dmd) id
-
-	---------------------------------
-	-- SPECIALISATION
-idSpecialisation :: Id -> SpecInfo
-idSpecialisation id = specInfo (idInfo id)
-
-idCoreRules :: Id -> [CoreRule]
-idCoreRules id = specInfoRules (idSpecialisation id)
-
-setIdSpecialisation :: Id -> SpecInfo -> Id
-setIdSpecialisation id spec_info = modifyIdInfo (`setSpecInfo` spec_info) id
-
-	---------------------------------
-	-- CAF INFO
-idCafInfo :: Id -> CafInfo
-#ifdef OLD_STRICTNESS
-idCafInfo id = case cgInfo (idInfo id) of
-		  NoCgInfo -> pprPanic "idCafInfo" (ppr id)
-		  info     -> cgCafInfo info
-#else
-idCafInfo id = cafInfo (idInfo id)
-#endif
-
-setIdCafInfo :: Id -> CafInfo -> Id
-setIdCafInfo id caf_info = modifyIdInfo (`setCafInfo` caf_info) id
-
-	---------------------------------
-	-- CPR INFO
-#ifdef OLD_STRICTNESS
-idCprInfo :: Id -> CprInfo
-idCprInfo id = cprInfo (idInfo id)
-
-setIdCprInfo :: Id -> CprInfo -> Id
-setIdCprInfo id cpr_info = modifyIdInfo (`setCprInfo` cpr_info) id
-#endif
-
-	---------------------------------
-	-- Occcurrence INFO
-idOccInfo :: Id -> OccInfo
-idOccInfo id = occInfo (idInfo id)
-
-setIdOccInfo :: Id -> OccInfo -> Id
-setIdOccInfo id occ_info = modifyIdInfo (`setOccInfo` occ_info) id
-\end{code}
-
-
-	---------------------------------
-	-- INLINING
-The inline pragma tells us to be very keen to inline this Id, but it's still
-OK not to if optimisation is switched off.
-
-\begin{code}
-idInlinePragma :: Id -> InlinePragInfo
-idInlinePragma id = inlinePragInfo (idInfo id)
-
-setInlinePragma :: Id -> InlinePragInfo -> Id
-setInlinePragma id prag = modifyIdInfo (`setInlinePragInfo` prag) id
-
-modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
-modifyInlinePragma id fn = modifyIdInfo (\info -> info `setInlinePragInfo` (fn (inlinePragInfo info))) id
-\end{code}
-
-
-	---------------------------------
-	-- ONE-SHOT LAMBDAS
-\begin{code}
-idLBVarInfo :: Id -> LBVarInfo
-idLBVarInfo id = lbvarInfo (idInfo id)
-
-isOneShotBndr :: Id -> Bool
--- This one is the "business end", called externally.
--- Its main purpose is to encapsulate the Horrible State Hack
-isOneShotBndr id = isOneShotLambda id || (isStateHackType (idType id))
-
-isStateHackType :: Type -> Bool
-isStateHackType ty
-  | opt_NoStateHack 
-  = False
-  | otherwise
-  = case splitTyConApp_maybe ty of
-	Just (tycon,_) -> tycon == statePrimTyCon
-        other          -> False
-	-- This is a gross hack.  It claims that 
-	-- every function over realWorldStatePrimTy is a one-shot
-	-- function.  This is pretty true in practice, and makes a big
-	-- difference.  For example, consider
-	--	a `thenST` \ r -> ...E...
-	-- The early full laziness pass, if it doesn't know that r is one-shot
-	-- will pull out E (let's say it doesn't mention r) to give
-	--	let lvl = E in a `thenST` \ r -> ...lvl...
-	-- When `thenST` gets inlined, we end up with
-	--	let lvl = E in \s -> case a s of (r, s') -> ...lvl...
-	-- and we don't re-inline E.
-	--
-	-- It would be better to spot that r was one-shot to start with, but
-	-- I don't want to rely on that.
-	--
-	-- Another good example is in fill_in in PrelPack.lhs.  We should be able to
-	-- spot that fill_in has arity 2 (and when Keith is done, we will) but we can't yet.
-
-
--- The OneShotLambda functions simply fiddle with the IdInfo flag
-isOneShotLambda :: Id -> Bool
-isOneShotLambda id = case idLBVarInfo id of
-                       IsOneShotLambda  -> True
-                       NoLBVarInfo      -> False
-
-setOneShotLambda :: Id -> Id
-setOneShotLambda id = modifyIdInfo (`setLBVarInfo` IsOneShotLambda) id
-
-clearOneShotLambda :: Id -> Id
-clearOneShotLambda id 
-  | isOneShotLambda id = modifyIdInfo (`setLBVarInfo` NoLBVarInfo) id
-  | otherwise	       = id			
-
--- But watch out: this may change the type of something else
---	f = \x -> e
--- If we change the one-shot-ness of x, f's type changes
-\end{code}
-
-\begin{code}
-zapLamIdInfo :: Id -> Id
-zapLamIdInfo id = maybeModifyIdInfo zapLamInfo id
-
-zapDemandIdInfo id = maybeModifyIdInfo zapDemandInfo id
-\end{code}
-
diff --git a/ghc/compiler/basicTypes/IdInfo.hi-boot-5 b/ghc/compiler/basicTypes/IdInfo.hi-boot-5
deleted file mode 100644
index 4a326cad6f..0000000000
--- a/ghc/compiler/basicTypes/IdInfo.hi-boot-5
+++ /dev/null
@@ -1,8 +0,0 @@
-__interface IdInfo 1 0 where
-__export IdInfo IdInfo GlobalIdDetails notGlobalId seqIdInfo vanillaIdInfo ;
-1 data IdInfo ;
-1 data GlobalIdDetails ;
-1 notGlobalId :: GlobalIdDetails ;
-1 seqIdInfo :: IdInfo -> PrelBase.Z0T ;
-1 vanillaIdInfo :: IdInfo ;
-
diff --git a/ghc/compiler/basicTypes/IdInfo.hi-boot-6 b/ghc/compiler/basicTypes/IdInfo.hi-boot-6
deleted file mode 100644
index e090800d61..0000000000
--- a/ghc/compiler/basicTypes/IdInfo.hi-boot-6
+++ /dev/null
@@ -1,8 +0,0 @@
-module IdInfo where
-
-data IdInfo
-data GlobalIdDetails
-
-notGlobalId :: GlobalIdDetails
-seqIdInfo :: IdInfo -> ()
-vanillaIdInfo :: IdInfo
diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
deleted file mode 100644
index d53bf5627d..0000000000
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ /dev/null
@@ -1,699 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[IdInfo]{@IdInfos@: Non-essential information about @Ids@}
-
-(And a pretty good illustration of quite a few things wrong with
-Haskell. [WDP 94/11])
-
-\begin{code}
-module IdInfo (
-	GlobalIdDetails(..), notGlobalId, 	-- Not abstract
-
-	IdInfo,		-- Abstract
-	vanillaIdInfo, noCafIdInfo,
-	seqIdInfo, megaSeqIdInfo,
-
-	-- Zapping
-	zapLamInfo, zapDemandInfo,
-
-	-- Arity
-	ArityInfo,
-	unknownArity, 
-	arityInfo, setArityInfo, ppArityInfo, 
-
-	-- New demand and strictness info
- 	newStrictnessInfo, setNewStrictnessInfo, 
-  	newDemandInfo, setNewDemandInfo, pprNewStrictness,
-	setAllStrictnessInfo,
-
-#ifdef OLD_STRICTNESS
-	-- Strictness; imported from Demand
-	StrictnessInfo(..),
-	mkStrictnessInfo, noStrictnessInfo,
-	ppStrictnessInfo,isBottomingStrictness, 
-#endif
-
-        -- Worker
-        WorkerInfo(..), workerExists, wrapperArity, workerId,
-        workerInfo, setWorkerInfo, ppWorkerInfo,
-
-	-- Unfolding
-	unfoldingInfo, setUnfoldingInfo, setUnfoldingInfoLazily,
-
-#ifdef OLD_STRICTNESS
-	-- Old DemandInfo and StrictnessInfo
-	demandInfo, setDemandInfo, 
-	strictnessInfo, setStrictnessInfo,
-        cprInfoFromNewStrictness,
-	oldStrictnessFromNew, newStrictnessFromOld,
-	oldDemand, newDemand,
-
-        -- Constructed Product Result Info
-        CprInfo(..), cprInfo, setCprInfo, ppCprInfo, noCprInfo,
-#endif
-
-	-- Inline prags
-	InlinePragInfo, 
-	inlinePragInfo, setInlinePragInfo, 
-
-	-- Occurrence info
-	OccInfo(..), isFragileOcc, isDeadOcc, isLoopBreaker,
-	InsideLam, OneBranch, insideLam, notInsideLam, oneBranch, notOneBranch,
-	occInfo, setOccInfo, 
-
-	-- Specialisation
-	SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo, 
-	specInfoFreeVars, specInfoRules, seqSpecInfo,
-
-	-- CAF info
-	CafInfo(..), cafInfo, ppCafInfo, setCafInfo, mayHaveCafRefs,
-
-        -- Lambda-bound variable info
-        LBVarInfo(..), lbvarInfo, setLBVarInfo, noLBVarInfo, hasNoLBVarInfo
-    ) where
-
-#include "HsVersions.h"
-
-
-import CoreSyn
-import Class		( Class )
-import PrimOp	 	( PrimOp )
-import Var              ( Id )
-import VarSet		( VarSet, emptyVarSet, seqVarSet )
-import BasicTypes	( OccInfo(..), isFragileOcc, isDeadOcc, seqOccInfo, isLoopBreaker,
-			  InsideLam, insideLam, notInsideLam, 
-			  OneBranch, oneBranch, notOneBranch,
-			  Arity,
-			  Activation(..)
-			)
-import DataCon		( DataCon )
-import TyCon		( TyCon, FieldLabel )
-import ForeignCall	( ForeignCall )
-import NewDemand
-import Outputable	
-import Maybe		( isJust )
-
-#ifdef OLD_STRICTNESS
-import Name		( Name )
-import Demand		hiding( Demand, seqDemand )
-import qualified Demand
-import Util		( listLengthCmp )
-import List		( replicate )
-#endif
-
--- infixl so you can say (id `set` a `set` b)
-infixl 	1 `setSpecInfo`,
-	  `setArityInfo`,
-	  `setInlinePragInfo`,
-	  `setUnfoldingInfo`,
-	  `setWorkerInfo`,
-	  `setLBVarInfo`,
-	  `setOccInfo`,
-	  `setCafInfo`,
-	  `setNewStrictnessInfo`,
-	  `setAllStrictnessInfo`,
-	  `setNewDemandInfo`
-#ifdef OLD_STRICTNESS
-	  , `setCprInfo`
-	  , `setDemandInfo`
-	  , `setStrictnessInfo`
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{New strictness info}
-%*									*
-%************************************************************************
-
-To be removed later
-
-\begin{code}
--- setAllStrictnessInfo :: IdInfo -> Maybe StrictSig -> IdInfo
--- Set old and new strictness info
-setAllStrictnessInfo info Nothing
-  = info { newStrictnessInfo = Nothing
-#ifdef OLD_STRICTNESS
-         , strictnessInfo = NoStrictnessInfo
-         , cprInfo = NoCPRInfo
-#endif
-         }
-
-setAllStrictnessInfo info (Just sig)
-  = info { newStrictnessInfo = Just sig
-#ifdef OLD_STRICTNESS
-         , strictnessInfo = oldStrictnessFromNew sig
-         , cprInfo = cprInfoFromNewStrictness sig
-#endif
-         }
-
-seqNewStrictnessInfo Nothing = ()
-seqNewStrictnessInfo (Just ty) = seqStrictSig ty
-
-pprNewStrictness Nothing = empty
-pprNewStrictness (Just sig) = ftext FSLIT("Str:") <+> ppr sig
-
-#ifdef OLD_STRICTNESS
-oldStrictnessFromNew :: StrictSig -> Demand.StrictnessInfo
-oldStrictnessFromNew sig = mkStrictnessInfo (map oldDemand dmds, isBotRes res_info)
-			 where
-			   (dmds, res_info) = splitStrictSig sig
-
-cprInfoFromNewStrictness :: StrictSig -> CprInfo
-cprInfoFromNewStrictness sig = case strictSigResInfo sig of
-				  RetCPR -> ReturnsCPR
-				  other  -> NoCPRInfo
-
-newStrictnessFromOld :: Name -> Arity -> Demand.StrictnessInfo -> CprInfo -> StrictSig
-newStrictnessFromOld name arity (Demand.StrictnessInfo ds res) cpr
-  | listLengthCmp ds arity /= GT -- length ds <= arity
-	-- Sometimes the old strictness analyser has more
-	-- demands than the arity justifies
-  = mk_strict_sig name arity $
-    mkTopDmdType (map newDemand ds) (newRes res cpr)
-
-newStrictnessFromOld name arity other cpr
-  =	-- Either no strictness info, or arity is too small
-	-- In either case we can't say anything useful
-    mk_strict_sig name arity $
-    mkTopDmdType (replicate arity lazyDmd) (newRes False cpr)
-
-mk_strict_sig name arity dmd_ty
-  = WARN( arity /= dmdTypeDepth dmd_ty, ppr name <+> (ppr arity $$ ppr dmd_ty) )
-    mkStrictSig dmd_ty
-
-newRes True  _ 	        = BotRes
-newRes False ReturnsCPR = retCPR
-newRes False NoCPRInfo  = TopRes
-
-newDemand :: Demand.Demand -> NewDemand.Demand
-newDemand (WwLazy True)      = Abs
-newDemand (WwLazy False)     = lazyDmd
-newDemand WwStrict	     = evalDmd
-newDemand (WwUnpack unpk ds) = Eval (Prod (map newDemand ds))
-newDemand WwPrim	     = lazyDmd
-newDemand WwEnum	     = evalDmd
-
-oldDemand :: NewDemand.Demand -> Demand.Demand
-oldDemand Abs	     	   = WwLazy True
-oldDemand Top	     	   = WwLazy False
-oldDemand Bot	     	   = WwStrict
-oldDemand (Box Bot)	   = WwStrict
-oldDemand (Box Abs)	   = WwLazy False
-oldDemand (Box (Eval _))   = WwStrict	-- Pass box only
-oldDemand (Defer d)        = WwLazy False
-oldDemand (Eval (Prod ds)) = WwUnpack True (map oldDemand ds)
-oldDemand (Eval (Poly _))  = WwStrict
-oldDemand (Call _)         = WwStrict
-
-#endif /* OLD_STRICTNESS */
-\end{code}
-
-
-\begin{code}
-seqNewDemandInfo Nothing    = ()
-seqNewDemandInfo (Just dmd) = seqDemand dmd
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{GlobalIdDetails
-%*									*
-%************************************************************************
-
-This type is here (rather than in Id.lhs) mainly because there's 
-an IdInfo.hi-boot, but no Id.hi-boot, and GlobalIdDetails is imported
-(recursively) by Var.lhs.
-
-\begin{code}
-data GlobalIdDetails
-  = VanillaGlobal		-- Imported from elsewhere, a default method Id.
-
-  | RecordSelId                 -- The Id for a record selector
-    { sel_tycon   :: TyCon
-    , sel_label   :: FieldLabel
-    , sel_naughty :: Bool       -- True <=> naughty
-    }				-- See Note [Naughty record selectors]
-				-- with MkId.mkRecordSelectorId
-
-  | DataConWorkId DataCon	-- The Id for a data constructor *worker*
-  | DataConWrapId DataCon	-- The Id for a data constructor *wrapper*
-				-- [the only reasons we need to know is so that
-				--  a) to support isImplicitId
-				--  b) when desugaring a RecordCon we can get 
-				--     from the Id back to the data con]
-
-  | ClassOpId Class		-- An operation of a class
-
-  | PrimOpId PrimOp		-- The Id for a primitive operator
-  | FCallId ForeignCall		-- The Id for a foreign call
-
-  | NotGlobalId			-- Used as a convenient extra return value from globalIdDetails
-    
-notGlobalId = NotGlobalId
-
-instance Outputable GlobalIdDetails where
-    ppr NotGlobalId       = ptext SLIT("[***NotGlobalId***]")
-    ppr VanillaGlobal     = ptext SLIT("[GlobalId]")
-    ppr (DataConWorkId _) = ptext SLIT("[DataCon]")
-    ppr (DataConWrapId _) = ptext SLIT("[DataConWrapper]")
-    ppr (ClassOpId _)     = ptext SLIT("[ClassOp]")
-    ppr (PrimOpId _)      = ptext SLIT("[PrimOp]")
-    ppr (FCallId _)       = ptext SLIT("[ForeignCall]")
-    ppr (RecordSelId {})  = ptext SLIT("[RecSel]")
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The main IdInfo type}
-%*									*
-%************************************************************************
-
-An @IdInfo@ gives {\em optional} information about an @Id@.  If
-present it never lies, but it may not be present, in which case there
-is always a conservative assumption which can be made.
-
-Two @Id@s may have different info even though they have the same
-@Unique@ (and are hence the same @Id@); for example, one might lack
-the properties attached to the other.
-
-The @IdInfo@ gives information about the value, or definition, of the
-@Id@.  It does {\em not} contain information about the @Id@'s usage
-(except for @DemandInfo@? ToDo). (@lbvarInfo@ is also a marginal
-case.  KSW 1999-04).
-
-\begin{code}
-data IdInfo
-  = IdInfo {
-	arityInfo 	:: !ArityInfo,		-- Its arity
-	specInfo 	:: SpecInfo,		-- Specialisations of this function which exist
-#ifdef OLD_STRICTNESS
-	cprInfo 	:: CprInfo,             -- Function always constructs a product result
-	demandInfo 	:: Demand.Demand,	-- Whether or not it is definitely demanded
-	strictnessInfo	:: StrictnessInfo,	-- Strictness properties
-#endif
-        workerInfo      :: WorkerInfo,          -- Pointer to Worker Function
-						-- Within one module this is irrelevant; the 
-						-- inlining of a worker is handled via the Unfolding
-						-- WorkerInfo is used *only* to indicate the form of
-						-- the RHS, so that interface files don't actually 
-						-- need to contain the RHS; it can be derived from
-						-- the strictness info
-
-	unfoldingInfo	:: Unfolding,		-- Its unfolding
-	cafInfo		:: CafInfo,		-- CAF info
-        lbvarInfo	:: LBVarInfo,		-- Info about a lambda-bound variable
-	inlinePragInfo	:: InlinePragInfo,	-- Inline pragma
-	occInfo		:: OccInfo,		-- How it occurs
-
-	newStrictnessInfo :: Maybe StrictSig,	-- Reason for Maybe: the DmdAnal phase needs to
-						-- know whether whether this is the first visit,
-						-- so it can assign botSig.  Other customers want
-						-- topSig.  So Nothing is good.
-
-	newDemandInfo	  :: Maybe Demand	-- Similarly we want to know if there's no
-						-- known demand yet, for when we are looking for
-						-- CPR info
-    }
-
-seqIdInfo :: IdInfo -> ()
-seqIdInfo (IdInfo {}) = ()
-
-megaSeqIdInfo :: IdInfo -> ()
-megaSeqIdInfo info
-  = seqSpecInfo (specInfo info)			`seq`
-    seqWorker (workerInfo info)			`seq`
-
--- Omitting this improves runtimes a little, presumably because
--- some unfoldings are not calculated at all
---    seqUnfolding (unfoldingInfo info)		`seq`
-
-    seqNewDemandInfo (newDemandInfo info)	`seq`
-    seqNewStrictnessInfo (newStrictnessInfo info) `seq`
-
-#ifdef OLD_STRICTNESS
-    Demand.seqDemand (demandInfo info)		`seq`
-    seqStrictnessInfo (strictnessInfo info)	`seq`
-    seqCpr (cprInfo info)			`seq`
-#endif
-
-    seqCaf (cafInfo info)			`seq`
-    seqLBVar (lbvarInfo info)			`seq`
-    seqOccInfo (occInfo info) 
-\end{code}
-
-Setters
-
-\begin{code}
-setWorkerInfo     info wk = wk `seq` info { workerInfo = wk }
-setSpecInfo 	  info sp = sp `seq` info { specInfo = sp }
-setInlinePragInfo info pr = pr `seq` info { inlinePragInfo = pr }
-setOccInfo	  info oc = oc `seq` info { occInfo = oc }
-#ifdef OLD_STRICTNESS
-setStrictnessInfo info st = st `seq` info { strictnessInfo = st }
-#endif
-	-- Try to avoid spack leaks by seq'ing
-
-setUnfoldingInfoLazily info uf 	-- Lazy variant to avoid looking at the
-  =				-- unfolding of an imported Id unless necessary
-    info { unfoldingInfo = uf }	-- (In this case the demand-zapping is redundant.)
-
-setUnfoldingInfo info uf 
-	-- We do *not* seq on the unfolding info, For some reason, doing so 
-	-- actually increases residency significantly. 
-  = info { unfoldingInfo = uf }
-
-#ifdef OLD_STRICTNESS
-setDemandInfo	  info dd = info { demandInfo = dd }
-setCprInfo        info cp = info { cprInfo = cp }
-#endif
-
-setArityInfo	  info ar  = info { arityInfo = ar  }
-setCafInfo        info caf = info { cafInfo = caf }
-
-setLBVarInfo      info lb = {-lb `seq`-} info { lbvarInfo = lb }
-
-setNewDemandInfo     info dd = dd `seq` info { newDemandInfo = dd }
-setNewStrictnessInfo info dd = dd `seq` info { newStrictnessInfo = dd }
-\end{code}
-
-
-\begin{code}
-vanillaIdInfo :: IdInfo
-vanillaIdInfo 
-  = IdInfo {
-	    cafInfo		= vanillaCafInfo,
-	    arityInfo		= unknownArity,
-#ifdef OLD_STRICTNESS
-	    cprInfo		= NoCPRInfo,
-	    demandInfo		= wwLazy,
-	    strictnessInfo	= NoStrictnessInfo,
-#endif
-	    specInfo		= emptySpecInfo,
-	    workerInfo		= NoWorker,
-	    unfoldingInfo	= noUnfolding,
-	    lbvarInfo		= NoLBVarInfo,
-	    inlinePragInfo 	= AlwaysActive,
-	    occInfo		= NoOccInfo,
-	    newDemandInfo	= Nothing,
-	    newStrictnessInfo   = Nothing
-	   }
-
-noCafIdInfo  = vanillaIdInfo `setCafInfo`    NoCafRefs
-	-- Used for built-in type Ids in MkId.
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[arity-IdInfo]{Arity info about an @Id@}
-%*									*
-%************************************************************************
-
-For locally-defined Ids, the code generator maintains its own notion
-of their arities; so it should not be asking...	 (but other things
-besides the code-generator need arity info!)
-
-\begin{code}
-type ArityInfo = Arity
-  	-- A partial application of this Id to up to n-1 value arguments
-	-- does essentially no work.  That is not necessarily the
-	-- same as saying that it has n leading lambdas, because coerces
-	-- may get in the way.
-
-	-- The arity might increase later in the compilation process, if
-	-- an extra lambda floats up to the binding site.
-
-unknownArity = 0 :: Arity
-
-ppArityInfo 0 = empty
-ppArityInfo n = hsep [ptext SLIT("Arity"), int n]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Inline-pragma information}
-%*									*
-%************************************************************************
-
-\begin{code}
-type InlinePragInfo = Activation
-	-- Tells when the inlining is active
-	-- When it is active the thing may be inlined, depending on how
-	-- big it is.
-	--
-	-- If there was an INLINE pragma, then as a separate matter, the
-	-- RHS will have been made to look small with a CoreSyn Inline Note
-
-	-- The default InlinePragInfo is AlwaysActive, so the info serves
-	-- entirely as a way to inhibit inlining until we want it
-\end{code}
-
-
-%************************************************************************
-%*									*
-	SpecInfo
-%*									*
-%************************************************************************
-
-\begin{code}
--- CoreRules is used only in an idSpecialisation (move to IdInfo?)
-data SpecInfo 
-  = SpecInfo [CoreRule] VarSet	-- Locally-defined free vars of RHSs
-
-emptySpecInfo :: SpecInfo
-emptySpecInfo = SpecInfo [] emptyVarSet
-
-isEmptySpecInfo :: SpecInfo -> Bool
-isEmptySpecInfo (SpecInfo rs _) = null rs
-
-specInfoFreeVars :: SpecInfo -> VarSet
-specInfoFreeVars (SpecInfo _ fvs) = fvs
-
-specInfoRules :: SpecInfo -> [CoreRule]
-specInfoRules (SpecInfo rules _) = rules
-
-seqSpecInfo (SpecInfo rules fvs) = seqRules rules `seq` seqVarSet fvs
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[worker-IdInfo]{Worker info about an @Id@}
-%*									*
-%************************************************************************
-
-If this Id has a worker then we store a reference to it. Worker
-functions are generated by the worker/wrapper pass.  This uses
-information from strictness analysis.
-
-There might not be a worker, even for a strict function, because:
-(a) the function might be small enough to inline, so no need 
-    for w/w split
-(b) the strictness info might be "SSS" or something, so no w/w split.
-
-Sometimes the arity of a wrapper changes from the original arity from
-which it was generated, so we always emit the "original" arity into
-the interface file, as part of the worker info.
-
-How can this happen?  Sometimes we get
-	f = coerce t (\x y -> $wf x y)
-at the moment of w/w split; but the eta reducer turns it into
-	f = coerce t $wf
-which is perfectly fine except that the exposed arity so far as
-the code generator is concerned (zero) differs from the arity
-when we did the split (2).  
-
-All this arises because we use 'arity' to mean "exactly how many
-top level lambdas are there" in interface files; but during the
-compilation of this module it means "how many things can I apply
-this to".
-
-\begin{code}
-
-data WorkerInfo = NoWorker
-		| HasWorker Id Arity
-	-- The Arity is the arity of the *wrapper* at the moment of the
-	-- w/w split.  See notes above.
-
-seqWorker :: WorkerInfo -> ()
-seqWorker (HasWorker id a) = id `seq` a `seq` ()
-seqWorker NoWorker	   = ()
-
-ppWorkerInfo NoWorker            = empty
-ppWorkerInfo (HasWorker wk_id _) = ptext SLIT("Worker") <+> ppr wk_id
-
-workerExists :: WorkerInfo -> Bool
-workerExists NoWorker        = False
-workerExists (HasWorker _ _) = True
-
-workerId :: WorkerInfo -> Id
-workerId (HasWorker id _) = id
-
-wrapperArity :: WorkerInfo -> Arity
-wrapperArity (HasWorker _ a) = a
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[CG-IdInfo]{Code generator-related information}
-%*									*
-%************************************************************************
-
-\begin{code}
--- CafInfo is used to build Static Reference Tables (see simplStg/SRT.lhs).
-
-data CafInfo 
-	= MayHaveCafRefs		-- either:
-					-- (1) A function or static constructor
-					--     that refers to one or more CAFs,
-					-- (2) A real live CAF
-
-	| NoCafRefs			-- A function or static constructor
-				        -- that refers to no CAFs.
-
-vanillaCafInfo = MayHaveCafRefs		-- Definitely safe
-
-mayHaveCafRefs  MayHaveCafRefs = True
-mayHaveCafRefs _	       = False
-
-seqCaf c = c `seq` ()
-
-ppCafInfo NoCafRefs = ptext SLIT("NoCafRefs")
-ppCafInfo MayHaveCafRefs = empty
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[cpr-IdInfo]{Constructed Product Result info about an @Id@}
-%*									*
-%************************************************************************
-
-If the @Id@ is a function then it may have CPR info. A CPR analysis
-phase detects whether:
-
-\begin{enumerate}
-\item
-The function's return value has a product type, i.e. an algebraic  type 
-with a single constructor. Examples of such types are tuples and boxed
-primitive values.
-\item
-The function always 'constructs' the value that it is returning.  It
-must do this on every path through,  and it's OK if it calls another
-function which constructs the result.
-\end{enumerate}
-
-If this is the case then we store a template which tells us the
-function has the CPR property and which components of the result are
-also CPRs.   
-
-\begin{code}
-#ifdef OLD_STRICTNESS
-data CprInfo
-  = NoCPRInfo
-  | ReturnsCPR	-- Yes, this function returns a constructed product
-		-- Implicitly, this means "after the function has been applied
-		-- to all its arguments", so the worker/wrapper builder in 
-		-- WwLib.mkWWcpr checks that that it is indeed saturated before
-		-- making use of the CPR info
-
-	-- We used to keep nested info about sub-components, but
-	-- we never used it so I threw it away
-
-seqCpr :: CprInfo -> ()
-seqCpr ReturnsCPR = ()
-seqCpr NoCPRInfo  = ()
-
-noCprInfo       = NoCPRInfo
-
-ppCprInfo NoCPRInfo  = empty
-ppCprInfo ReturnsCPR = ptext SLIT("__M")
-
-instance Outputable CprInfo where
-    ppr = ppCprInfo
-
-instance Show CprInfo where
-    showsPrec p c = showsPrecSDoc p (ppr c)
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[lbvar-IdInfo]{Lambda-bound var info about an @Id@}
-%*									*
-%************************************************************************
-
-If the @Id@ is a lambda-bound variable then it may have lambda-bound
-var info.  Sometimes we know whether the lambda binding this var is a
-``one-shot'' lambda; that is, whether it is applied at most once.
-
-This information may be useful in optimisation, as computations may
-safely be floated inside such a lambda without risk of duplicating
-work.
-
-\begin{code}
-data LBVarInfo = NoLBVarInfo 
-	       | IsOneShotLambda	-- The lambda is applied at most once).
-
-seqLBVar l = l `seq` ()
-\end{code}
-
-\begin{code}
-hasNoLBVarInfo NoLBVarInfo     = True
-hasNoLBVarInfo IsOneShotLambda = False
-
-noLBVarInfo = NoLBVarInfo
-
-pprLBVarInfo NoLBVarInfo     = empty
-pprLBVarInfo IsOneShotLambda = ptext SLIT("OneShot")
-
-instance Outputable LBVarInfo where
-    ppr = pprLBVarInfo
-
-instance Show LBVarInfo where
-    showsPrec p c = showsPrecSDoc p (ppr c)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Bulk operations on IdInfo}
-%*									*
-%************************************************************************
-
-@zapLamInfo@ is used for lambda binders that turn out to to be
-part of an unsaturated lambda
-
-\begin{code}
-zapLamInfo :: IdInfo -> Maybe IdInfo
-zapLamInfo info@(IdInfo {occInfo = occ, newDemandInfo = demand})
-  | is_safe_occ occ && is_safe_dmd demand
-  = Nothing
-  | otherwise
-  = Just (info {occInfo = safe_occ, newDemandInfo = Nothing})
-  where
-	-- The "unsafe" occ info is the ones that say I'm not in a lambda
-	-- because that might not be true for an unsaturated lambda
-    is_safe_occ (OneOcc in_lam _ _) = in_lam
-    is_safe_occ other		    = True
-
-    safe_occ = case occ of
-		 OneOcc _ once int_cxt -> OneOcc insideLam once int_cxt
-		 other	       	       -> occ
-
-    is_safe_dmd Nothing    = True
-    is_safe_dmd (Just dmd) = not (isStrictDmd dmd)
-\end{code}
-
-\begin{code}
-zapDemandInfo :: IdInfo -> Maybe IdInfo
-zapDemandInfo info@(IdInfo {newDemandInfo = dmd})
-  | isJust dmd = Just (info {newDemandInfo = Nothing})
-  | otherwise  = Nothing
-\end{code}
-
diff --git a/ghc/compiler/basicTypes/IdInfo.lhs-boot b/ghc/compiler/basicTypes/IdInfo.lhs-boot
deleted file mode 100644
index 90cf36f90b..0000000000
--- a/ghc/compiler/basicTypes/IdInfo.lhs-boot
+++ /dev/null
@@ -1,9 +0,0 @@
-\begin{code}
-module IdInfo where
-
-data IdInfo
-data GlobalIdDetails
-
-notGlobalId :: GlobalIdDetails
-seqIdInfo   :: IdInfo -> ()
-\end{code}
\ No newline at end of file
diff --git a/ghc/compiler/basicTypes/Literal.lhs b/ghc/compiler/basicTypes/Literal.lhs
deleted file mode 100644
index e83ea9db74..0000000000
--- a/ghc/compiler/basicTypes/Literal.lhs
+++ /dev/null
@@ -1,405 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-\section[Literal]{@Literal@: Machine literals (unboxed, of course)}
-
-\begin{code}
-module Literal
-	( Literal(..)		-- Exported to ParseIface
-	, mkMachInt, mkMachWord
-	, mkMachInt64, mkMachWord64, mkStringLit
-	, litSize
-	, litIsDupable, litIsTrivial
-	, literalType
-	, hashLiteral
-
-	, inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
-	, isZeroLit
-
-	, word2IntLit, int2WordLit
-	, narrow8IntLit, narrow16IntLit, narrow32IntLit
-	, narrow8WordLit, narrow16WordLit, narrow32WordLit
-	, char2IntLit, int2CharLit
-	, float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
-	, nullAddrLit, float2DoubleLit, double2FloatLit
-	) where
-
-#include "HsVersions.h"
-
-import TysPrim		( charPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
-			  intPrimTy, wordPrimTy, int64PrimTy, word64PrimTy
-			)
-import Type		( Type )
-import Outputable
-import FastTypes
-import FastString
-import Binary
-
-import Ratio 		( numerator )
-import FastString	( uniqueOfFS, lengthFS )
-import DATA_INT		( Int8,  Int16,  Int32 )
-import DATA_WORD	( Word8, Word16, Word32 )
-import Char		( ord, chr )
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Sizes}
-%*									*
-%************************************************************************
-
-If we're compiling with GHC (and we're not cross-compiling), then we
-know that minBound and maxBound :: Int are the right values for the
-target architecture.  Otherwise, we assume -2^31 and 2^31-1
-respectively (which will be wrong on a 64-bit machine).
-
-\begin{code}
-tARGET_MIN_INT, tARGET_MAX_INT, tARGET_MAX_WORD :: Integer
-#if __GLASGOW_HASKELL__
-tARGET_MIN_INT  = toInteger (minBound :: Int)
-tARGET_MAX_INT  = toInteger (maxBound :: Int)
-#else
-tARGET_MIN_INT = -2147483648
-tARGET_MAX_INT =  2147483647
-#endif
-tARGET_MAX_WORD = (tARGET_MAX_INT * 2) + 1
-
-tARGET_MAX_CHAR :: Int
-tARGET_MAX_CHAR = 0x10ffff
-\end{code}
- 
-
-%************************************************************************
-%*									*
-\subsection{Literals}
-%*									*
-%************************************************************************
-
-So-called @Literals@ are {\em either}:
-\begin{itemize}
-\item
-An unboxed (``machine'') literal (type: @IntPrim@, @FloatPrim@, etc.),
-which is presumed to be surrounded by appropriate constructors
-(@mKINT@, etc.), so that the overall thing makes sense.
-\item
-An Integer, Rational, or String literal whose representation we are
-{\em uncommitted} about; i.e., the surrounding with constructors,
-function applications, etc., etc., has not yet been done.
-\end{itemize}
-
-\begin{code}
-data Literal
-  =	------------------
-	-- First the primitive guys
-    MachChar	Char             -- Char#        At least 31 bits
-
-  | MachStr	FastString	-- A string-literal: stored and emitted
-				-- UTF-8 encoded, we'll arrange to decode it
-				-- at runtime.  Also emitted with a '\0'
-				-- terminator.
-
-  | MachNullAddr                -- the NULL pointer, the only pointer value
-                                -- that can be represented as a Literal.
-
-  | MachInt	Integer		-- Int#		At least WORD_SIZE_IN_BITS bits
-  | MachInt64	Integer		-- Int64#	At least 64 bits
-  | MachWord	Integer		-- Word#	At least WORD_SIZE_IN_BITS bits
-  | MachWord64	Integer		-- Word64#	At least 64 bits
-
-  | MachFloat	Rational
-  | MachDouble	Rational
-
-        -- MachLabel is used (only) for the literal derived from a 
-	-- "foreign label" declaration.
-	-- string argument is the name of a symbol.  This literal
-	-- refers to the *address* of the label.
-  | MachLabel   FastString		-- always an Addr#
-  		(Maybe Int)             -- the size (in bytes) of the arguments
-					-- the label expects. Only applicable with
-					-- 'stdcall' labels.
-					-- Just x => "@<x>" will be appended to label
-					--           name when emitting asm.
-\end{code}
-
-Binary instance
-
-\begin{code}
-instance Binary Literal where
-    put_ bh (MachChar aa)     = do putByte bh 0; put_ bh aa
-    put_ bh (MachStr ab)      = do putByte bh 1; put_ bh ab
-    put_ bh (MachNullAddr)    = do putByte bh 2
-    put_ bh (MachInt ad)      = do putByte bh 3; put_ bh ad
-    put_ bh (MachInt64 ae)    = do putByte bh 4; put_ bh ae
-    put_ bh (MachWord af)     = do putByte bh 5; put_ bh af
-    put_ bh (MachWord64 ag)   = do putByte bh 6; put_ bh ag
-    put_ bh (MachFloat ah)    = do putByte bh 7; put_ bh ah
-    put_ bh (MachDouble ai)   = do putByte bh 8; put_ bh ai
-    put_ bh (MachLabel aj mb) = do putByte bh 9; put_ bh aj ; put_ bh mb
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do
-		    aa <- get bh
-		    return (MachChar aa)
-	      1 -> do
-		    ab <- get bh
-		    return (MachStr ab)
-	      2 -> do
-		    return (MachNullAddr)
-	      3 -> do
-		    ad <- get bh
-		    return (MachInt ad)
-	      4 -> do
-		    ae <- get bh
-		    return (MachInt64 ae)
-	      5 -> do
-		    af <- get bh
-		    return (MachWord af)
-	      6 -> do
-		    ag <- get bh
-		    return (MachWord64 ag)
-	      7 -> do
-		    ah <- get bh
-		    return (MachFloat ah)
-	      8 -> do
-		    ai <- get bh
-		    return (MachDouble ai)
-	      9 -> do
-		    aj <- get bh
-		    mb <- get bh
-		    return (MachLabel aj mb)
-\end{code}
-
-\begin{code}
-instance Outputable Literal where
-    ppr lit = pprLit lit
-
-instance Show Literal where
-    showsPrec p lit = showsPrecSDoc p (ppr lit)
-
-instance Eq Literal where
-    a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
-    a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
-
-instance Ord Literal where
-    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
-    a <	 b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
-    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
-    a >	 b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
-    compare a b = cmpLit a b
-\end{code}
-
-
-	Construction
-	~~~~~~~~~~~~
-\begin{code}
-mkMachInt, mkMachWord, mkMachInt64, mkMachWord64 :: Integer -> Literal
-
-mkMachInt  x   = -- ASSERT2( inIntRange x,  integer x ) 
-	 	 -- Not true: you can write out of range Int# literals
-		 -- For example, one can write (intToWord# 0xffff0000) to
-		 -- get a particular Word bit-pattern, and there's no other
-		 -- convenient way to write such literals, which is why we allow it.
-		 MachInt x
-mkMachWord x   = -- ASSERT2( inWordRange x, integer x ) 
-		 MachWord x
-mkMachInt64  x = MachInt64 x
-mkMachWord64 x = MachWord64 x
-
-mkStringLit :: String -> Literal
-mkStringLit s = MachStr (mkFastString s) -- stored UTF-8 encoded
-
-inIntRange, inWordRange :: Integer -> Bool
-inIntRange  x = x >= tARGET_MIN_INT && x <= tARGET_MAX_INT
-inWordRange x = x >= 0		    && x <= tARGET_MAX_WORD
-
-inCharRange :: Char -> Bool
-inCharRange c =  c >= '\0' && c <= chr tARGET_MAX_CHAR
-
-isZeroLit :: Literal -> Bool
-isZeroLit (MachInt    0) = True
-isZeroLit (MachInt64  0) = True
-isZeroLit (MachWord   0) = True
-isZeroLit (MachWord64 0) = True
-isZeroLit (MachFloat  0) = True
-isZeroLit (MachDouble 0) = True
-isZeroLit other		 = False
-\end{code}
-
-	Coercions
-	~~~~~~~~~
-\begin{code}
-word2IntLit, int2WordLit,
-  narrow8IntLit, narrow16IntLit, narrow32IntLit,
-  narrow8WordLit, narrow16WordLit, narrow32WordLit,
-  char2IntLit, int2CharLit,
-  float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit,
-  float2DoubleLit, double2FloatLit
-  :: Literal -> Literal
-
-word2IntLit (MachWord w) 
-  | w > tARGET_MAX_INT = MachInt (w - tARGET_MAX_WORD - 1)
-  | otherwise	       = MachInt w
-
-int2WordLit (MachInt i)
-  | i < 0     = MachWord (1 + tARGET_MAX_WORD + i)	-- (-1)  --->  tARGET_MAX_WORD
-  | otherwise = MachWord i
-
-narrow8IntLit    (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int8))
-narrow16IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int16))
-narrow32IntLit   (MachInt  i) = MachInt  (toInteger (fromInteger i :: Int32))
-narrow8WordLit   (MachWord w) = MachWord (toInteger (fromInteger w :: Word8))
-narrow16WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word16))
-narrow32WordLit  (MachWord w) = MachWord (toInteger (fromInteger w :: Word32))
-
-char2IntLit (MachChar c) = MachInt  (toInteger (ord c))
-int2CharLit (MachInt  i) = MachChar (chr (fromInteger i))
-
-float2IntLit (MachFloat f) = MachInt   (truncate    f)
-int2FloatLit (MachInt   i) = MachFloat (fromInteger i)
-
-double2IntLit (MachDouble f) = MachInt    (truncate    f)
-int2DoubleLit (MachInt   i) = MachDouble (fromInteger i)
-
-float2DoubleLit (MachFloat  f) = MachDouble f
-double2FloatLit (MachDouble d) = MachFloat  d
-
-nullAddrLit :: Literal
-nullAddrLit = MachNullAddr
-\end{code}
-
-	Predicates
-	~~~~~~~~~~
-\begin{code}
-litIsTrivial :: Literal -> Bool
--- True if there is absolutely no penalty to duplicating the literal
---	c.f. CoreUtils.exprIsTrivial
--- False principally of strings
-litIsTrivial (MachStr _) = False
-litIsTrivial other	 = True
-
-litIsDupable :: Literal -> Bool
--- True if code space does not go bad if we duplicate this literal
---	c.f. CoreUtils.exprIsDupable
--- Currently we treat it just like litIsTrivial
-litIsDupable (MachStr _) = False
-litIsDupable other	 = True
-
-litSize :: Literal -> Int
--- Used by CoreUnfold.sizeExpr
-litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
-	-- Every literal has size at least 1, otherwise
-	-- 	f "x" 
-	-- might be too small
-	-- [Sept03: make literal strings a bit bigger to avoid fruitless 
-	--  duplication of little strings]
-litSize _other	      = 1
-\end{code}
-
-	Types
-	~~~~~
-\begin{code}
-literalType :: Literal -> Type
-literalType MachNullAddr    = addrPrimTy
-literalType (MachChar _)    = charPrimTy
-literalType (MachStr  _)    = addrPrimTy
-literalType (MachInt  _)    = intPrimTy
-literalType (MachWord  _)   = wordPrimTy
-literalType (MachInt64  _)  = int64PrimTy
-literalType (MachWord64  _) = word64PrimTy
-literalType (MachFloat _)   = floatPrimTy
-literalType (MachDouble _)  = doublePrimTy
-literalType (MachLabel _ _) = addrPrimTy
-\end{code}
-
-
-	Comparison
-	~~~~~~~~~~
-\begin{code}
-cmpLit (MachChar      a)   (MachChar	   b)   = a `compare` b
-cmpLit (MachStr       a)   (MachStr	   b)   = a `compare` b
-cmpLit (MachNullAddr)      (MachNullAddr)       = EQ
-cmpLit (MachInt       a)   (MachInt	   b)   = a `compare` b
-cmpLit (MachWord      a)   (MachWord	   b)   = a `compare` b
-cmpLit (MachInt64     a)   (MachInt64	   b)   = a `compare` b
-cmpLit (MachWord64    a)   (MachWord64	   b)   = a `compare` b
-cmpLit (MachFloat     a)   (MachFloat	   b)   = a `compare` b
-cmpLit (MachDouble    a)   (MachDouble	   b)   = a `compare` b
-cmpLit (MachLabel     a _) (MachLabel      b _) = a `compare` b
-cmpLit lit1		   lit2		        | litTag lit1 <# litTag lit2 = LT
-					        | otherwise  		     = GT
-
-litTag (MachChar      _)   = _ILIT(1)
-litTag (MachStr       _)   = _ILIT(2)
-litTag (MachNullAddr)      = _ILIT(3)
-litTag (MachInt       _)   = _ILIT(4)
-litTag (MachWord      _)   = _ILIT(5)
-litTag (MachInt64     _)   = _ILIT(6)
-litTag (MachWord64    _)   = _ILIT(7)
-litTag (MachFloat     _)   = _ILIT(8)
-litTag (MachDouble    _)   = _ILIT(9)
-litTag (MachLabel   _ _)   = _ILIT(10)
-\end{code}
-
-	Printing
-	~~~~~~~~
-* MachX (i.e. unboxed) things are printed unadornded (e.g. 3, 'a', "foo")
-  exceptions: MachFloat gets an initial keyword prefix.
-
-\begin{code}
-pprLit (MachChar ch)  	= pprHsChar ch
-pprLit (MachStr s)    	= pprHsString s
-pprLit (MachInt i)    	= pprIntVal i
-pprLit (MachInt64 i)  	= ptext SLIT("__int64") <+> integer i
-pprLit (MachWord w)   	= ptext SLIT("__word") <+> integer w
-pprLit (MachWord64 w) 	= ptext SLIT("__word64") <+> integer w
-pprLit (MachFloat f)  	= ptext SLIT("__float") <+> rational f
-pprLit (MachDouble d) 	= rational d
-pprLit (MachNullAddr) 	= ptext SLIT("__NULL")
-pprLit (MachLabel l mb) = ptext SLIT("__label") <+> 
-			     case mb of
-			       Nothing -> pprHsString l
-			       Just x  -> doubleQuotes (text (unpackFS l ++ '@':show x))
-
-pprIntVal :: Integer -> SDoc
--- Print negative integers with parens to be sure it's unambiguous
-pprIntVal i | i < 0     = parens (integer i)
-	    | otherwise = integer i
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Hashing}
-%*									*
-%************************************************************************
-
-Hash values should be zero or a positive integer.  No negatives please.
-(They mess up the UniqFM for some reason.)
-
-\begin{code}
-hashLiteral :: Literal -> Int
-hashLiteral (MachChar c)    	= ord c + 1000	-- Keep it out of range of common ints
-hashLiteral (MachStr s)     	= hashFS s
-hashLiteral (MachNullAddr)    	= 0
-hashLiteral (MachInt i)   	= hashInteger i
-hashLiteral (MachInt64 i) 	= hashInteger i
-hashLiteral (MachWord i)   	= hashInteger i
-hashLiteral (MachWord64 i) 	= hashInteger i
-hashLiteral (MachFloat r)   	= hashRational r
-hashLiteral (MachDouble r)  	= hashRational r
-hashLiteral (MachLabel s _)     = hashFS s
-
-hashRational :: Rational -> Int
-hashRational r = hashInteger (numerator r)
-
-hashInteger :: Integer -> Int
-hashInteger i = 1 + abs (fromInteger (i `rem` 10000))
-		-- The 1+ is to avoid zero, which is a Bad Number
-		-- since we use * to combine hash values
-
-hashFS :: FastString -> Int
-hashFS s = iBox (uniqueOfFS s)
-\end{code}
diff --git a/ghc/compiler/basicTypes/MkId.hi-boot-5 b/ghc/compiler/basicTypes/MkId.hi-boot-5
deleted file mode 100644
index ff901a5840..0000000000
--- a/ghc/compiler/basicTypes/MkId.hi-boot-5
+++ /dev/null
@@ -1,3 +0,0 @@
-__interface MkId 1 0 where
-__export MkId mkDataConIds ;
-1 mkDataConIds :: Name.Name -> Name.Name -> DataCon.DataCon -> DataCon.DataConIds ;
diff --git a/ghc/compiler/basicTypes/MkId.hi-boot-6 b/ghc/compiler/basicTypes/MkId.hi-boot-6
deleted file mode 100644
index d3f22527f3..0000000000
--- a/ghc/compiler/basicTypes/MkId.hi-boot-6
+++ /dev/null
@@ -1,5 +0,0 @@
-module MkId where
-
-mkDataConIds :: Name.Name -> Name.Name -> DataCon.DataCon -> DataCon.DataConIds
-
-
diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
deleted file mode 100644
index 84b3546e62..0000000000
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ /dev/null
@@ -1,1044 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1998
-%
-\section[StdIdInfo]{Standard unfoldings}
-
-This module contains definitions for the IdInfo for things that
-have a standard form, namely:
-
-	* data constructors
-	* record selectors
-	* method and superclass selectors
-	* primitive operations
-
-\begin{code}
-module MkId (
-	mkDictFunId, mkDefaultMethodId,
-	mkDictSelId, 
-
-	mkDataConIds,
-	mkRecordSelId, 
-	mkPrimOpId, mkFCallId,
-
-	mkReboxingAlt, mkNewTypeBody,
-
-	-- And some particular Ids; see below for why they are wired in
-	wiredInIds, ghcPrimIds,
-	unsafeCoerceId, realWorldPrimId, voidArgId, nullAddrId, seqId,
-	lazyId, lazyIdUnfolding, lazyIdKey,
-
-	mkRuntimeErrorApp,
-	rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID, rUNTIME_ERROR_ID,
-	nON_EXHAUSTIVE_GUARDS_ERROR_ID,	nO_METHOD_BINDING_ERROR_ID,
-	pAT_ERROR_ID, eRROR_ID,
-
-        unsafeCoerceName
-    ) where
-
-#include "HsVersions.h"
-
-
-import BasicTypes	( Arity, StrictnessMark(..), isMarkedUnboxed, isMarkedStrict )
-import Rules		( mkSpecInfo )
-import TysPrim		( openAlphaTyVars, alphaTyVar, alphaTy, 
-			  realWorldStatePrimTy, addrPrimTy
-			)
-import TysWiredIn	( charTy, mkListTy )
-import PrelRules	( primOpRules )
-import Type		( TyThing(..), mkForAllTy, tyVarsOfTypes )
-import TcType		( Type, ThetaType, mkDictTy, mkPredTys, mkPredTy, 
-			  mkTyConApp, mkTyVarTys, mkClassPred, 
-			  mkFunTys, mkFunTy, mkSigmaTy, tcSplitSigmaTy, 
-			  isUnLiftedType, mkForAllTys, mkTyVarTy, tyVarsOfType,
-			  tcSplitFunTys, tcSplitForAllTys, dataConsStupidTheta
-			)
-import CoreUtils	( exprType )
-import CoreUnfold 	( mkTopUnfolding, mkCompulsoryUnfolding )
-import Literal		( nullAddrLit, mkStringLit )
-import TyCon		( TyCon, isNewTyCon, tyConDataCons, FieldLabel,
-                          tyConStupidTheta, isProductTyCon, isDataTyCon, isRecursiveTyCon )
-import Class		( Class, classTyCon, classSelIds )
-import Var		( Id, TyVar, Var )
-import VarSet		( isEmptyVarSet, subVarSet, varSetElems )
-import Name		( mkFCallName, mkWiredInName, Name, BuiltInSyntax(..) )
-import OccName		( mkOccNameFS, varName )
-import PrimOp		( PrimOp, primOpSig, primOpOcc, primOpTag )
-import ForeignCall	( ForeignCall )
-import DataCon		( DataCon, DataConIds(..), dataConTyVars,
-			  dataConFieldLabels, dataConRepArity, dataConResTys,
-			  dataConRepArgTys, dataConRepType, 
-			  dataConSig, dataConStrictMarks, dataConExStricts, 
-			  splitProductType, isVanillaDataCon, dataConFieldType,
-			  dataConInstOrigArgTys
-			)
-import Id		( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal, 
-			  mkTemplateLocals, mkTemplateLocalsNum, mkExportedLocalId,
-			  mkTemplateLocal, idName
-			)
-import IdInfo		( IdInfo, noCafIdInfo,  setUnfoldingInfo, 
-			  setArityInfo, setSpecInfo, setCafInfo,
-			  setAllStrictnessInfo, vanillaIdInfo,
-			  GlobalIdDetails(..), CafInfo(..)
-			)
-import NewDemand	( mkStrictSig, DmdResult(..),
-			  mkTopDmdType, topDmd, evalDmd, lazyDmd, retCPR,
-			  Demand(..), Demands(..) )
-import DmdAnal		( dmdAnalTopRhs )
-import CoreSyn
-import Unique		( mkBuiltinUnique, mkPrimOpIdUnique )
-import Maybes
-import PrelNames
-import Util             ( dropList, isSingleton )
-import Outputable
-import FastString
-import ListSetOps	( assoc )
-\end{code}		
-
-%************************************************************************
-%*									*
-\subsection{Wired in Ids}
-%*									*
-%************************************************************************
-
-\begin{code}
-wiredInIds
-  = [ 	-- These error-y things are wired in because we don't yet have
-	-- a way to express in an interface file that the result type variable
-	-- is 'open'; that is can be unified with an unboxed type
-	-- 
-	-- [The interface file format now carry such information, but there's
-	-- no way yet of expressing at the definition site for these 
-	-- error-reporting functions that they have an 'open' 
-	-- result type. -- sof 1/99]
-
-    eRROR_ID,	-- This one isn't used anywhere else in the compiler
-		-- But we still need it in wiredInIds so that when GHC
-		-- compiles a program that mentions 'error' we don't
-		-- import its type from the interface file; we just get
-		-- the Id defined here.  Which has an 'open-tyvar' type.
-
-    rUNTIME_ERROR_ID,
-    iRREFUT_PAT_ERROR_ID,
-    nON_EXHAUSTIVE_GUARDS_ERROR_ID,
-    nO_METHOD_BINDING_ERROR_ID,
-    pAT_ERROR_ID,
-    rEC_CON_ERROR_ID,
-
-    lazyId
-    ] ++ ghcPrimIds
-
--- These Ids are exported from GHC.Prim
-ghcPrimIds
-  = [ 	-- These can't be defined in Haskell, but they have
-	-- perfectly reasonable unfoldings in Core
-    realWorldPrimId,
-    unsafeCoerceId,
-    nullAddrId,
-    seqId
-    ]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Data constructors}
-%*									*
-%************************************************************************
-
-The wrapper for a constructor is an ordinary top-level binding that evaluates
-any strict args, unboxes any args that are going to be flattened, and calls
-the worker.
-
-We're going to build a constructor that looks like:
-
-	data (Data a, C b) =>  T a b = T1 !a !Int b
-
-	T1 = /\ a b -> 
-	     \d1::Data a, d2::C b ->
-	     \p q r -> case p of { p ->
-		       case q of { q ->
-		       Con T1 [a,b] [p,q,r]}}
-
-Notice that
-
-* d2 is thrown away --- a context in a data decl is used to make sure
-  one *could* construct dictionaries at the site the constructor
-  is used, but the dictionary isn't actually used.
-
-* We have to check that we can construct Data dictionaries for
-  the types a and Int.  Once we've done that we can throw d1 away too.
-
-* We use (case p of q -> ...) to evaluate p, rather than "seq" because
-  all that matters is that the arguments are evaluated.  "seq" is 
-  very careful to preserve evaluation order, which we don't need
-  to be here.
-
-  You might think that we could simply give constructors some strictness
-  info, like PrimOps, and let CoreToStg do the let-to-case transformation.
-  But we don't do that because in the case of primops and functions strictness
-  is a *property* not a *requirement*.  In the case of constructors we need to
-  do something active to evaluate the argument.
-
-  Making an explicit case expression allows the simplifier to eliminate
-  it in the (common) case where the constructor arg is already evaluated.
-
-
-\begin{code}
-mkDataConIds :: Name -> Name -> DataCon -> DataConIds
-	-- Makes the *worker* for the data constructor; that is, the function
-	-- that takes the reprsentation arguments and builds the constructor.
-mkDataConIds wrap_name wkr_name data_con
-  | isNewTyCon tycon
-  = NewDC nt_wrap_id
-
-  | any isMarkedStrict all_strict_marks		-- Algebraic, needs wrapper
-  = AlgDC (Just alg_wrap_id) wrk_id
-
-  | otherwise					-- Algebraic, no wrapper
-  = AlgDC Nothing wrk_id
-  where
-    (tyvars, theta, orig_arg_tys, tycon, res_tys) = dataConSig data_con
-
-    dict_tys    = mkPredTys theta
-    all_arg_tys = dict_tys ++ orig_arg_tys
-    result_ty   = mkTyConApp tycon res_tys
-
-    wrap_ty = mkForAllTys tyvars (mkFunTys all_arg_tys result_ty)
-	-- We used to include the stupid theta in the wrapper's args
-	-- but now we don't.  Instead the type checker just injects these
-	-- extra constraints where necessary.
-
-	----------- Worker (algebraic data types only) --------------
-    wrk_id = mkGlobalId (DataConWorkId data_con) wkr_name
-	 		(dataConRepType data_con) wkr_info
-
-    wkr_arity = dataConRepArity data_con
-    wkr_info  = noCafIdInfo
-	        `setArityInfo`		wkr_arity
-	        `setAllStrictnessInfo`	Just wkr_sig
-		`setUnfoldingInfo`      evaldUnfolding	-- Record that it's evaluated,
-							-- even if arity = 0
-
-    wkr_sig = mkStrictSig (mkTopDmdType (replicate wkr_arity topDmd) cpr_info)
-	-- Notice that we do *not* say the worker is strict
-	-- even if the data constructor is declared strict
-	--	e.g. 	data T = MkT !(Int,Int)
-	-- Why?  Because the *wrapper* is strict (and its unfolding has case
-	-- expresssions that do the evals) but the *worker* itself is not.
-	-- If we pretend it is strict then when we see
-	--	case x of y -> $wMkT y
-	-- the simplifier thinks that y is "sure to be evaluated" (because
-	--  $wMkT is strict) and drops the case.  No, $wMkT is not strict.
-	--
-	-- When the simplifer sees a pattern 
-	--	case e of MkT x -> ...
-	-- it uses the dataConRepStrictness of MkT to mark x as evaluated;
-	-- but that's fine... dataConRepStrictness comes from the data con
-	-- not from the worker Id.
-
-    cpr_info | isProductTyCon tycon && 
-	       isDataTyCon tycon    &&
-	       wkr_arity > 0 	    &&
-	       wkr_arity <= mAX_CPR_SIZE	= retCPR
-	     | otherwise 			= TopRes
-	-- RetCPR is only true for products that are real data types;
-	-- that is, not unboxed tuples or [non-recursive] newtypes
-
-	----------- Wrappers for newtypes --------------
-    nt_wrap_id   = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty nt_wrap_info
-    nt_wrap_info = noCafIdInfo		-- The NoCaf-ness is set by noCafIdInfo
-		  `setArityInfo` 1	-- Arity 1
-		  `setUnfoldingInfo`     newtype_unf
-    newtype_unf  = ASSERT( isVanillaDataCon data_con &&
-			   isSingleton orig_arg_tys )
-	  	   -- No existentials on a newtype, but it can have a context
-	  	   -- e.g. 	newtype Eq a => T a = MkT (...)
-	  	   mkTopUnfolding $ Note InlineMe $
-	  	   mkLams tyvars $ Lam id_arg1 $ 
-	  	   mkNewTypeBody tycon result_ty (Var id_arg1)
-
-    id_arg1 = mkTemplateLocal 1 (head orig_arg_tys)
-
-	----------- Wrappers for algebraic data types -------------- 
-    alg_wrap_id = mkGlobalId (DataConWrapId data_con) wrap_name wrap_ty alg_wrap_info
-    alg_wrap_info = noCafIdInfo		-- The NoCaf-ness is set by noCafIdInfo
-		    `setArityInfo` 	   alg_arity
-			-- It's important to specify the arity, so that partial
-			-- applications are treated as values
-		    `setUnfoldingInfo`     alg_unf
-		    `setAllStrictnessInfo` Just wrap_sig
-
-    all_strict_marks = dataConExStricts data_con ++ dataConStrictMarks data_con
-    wrap_sig = mkStrictSig (mkTopDmdType arg_dmds cpr_info)
-    arg_dmds = map mk_dmd all_strict_marks
-    mk_dmd str | isMarkedStrict str = evalDmd
-	       | otherwise	    = lazyDmd
-	-- The Cpr info can be important inside INLINE rhss, where the
-	-- wrapper constructor isn't inlined.
-	-- And the argument strictness can be important too; we
-	-- may not inline a contructor when it is partially applied.
-	-- For example:
-	--	data W = C !Int !Int !Int
-	--	...(let w = C x in ...(w p q)...)...
-	-- we want to see that w is strict in its two arguments
-
-    alg_unf = mkTopUnfolding $ Note InlineMe $
-	      mkLams tyvars $ 
-	      mkLams dict_args $ mkLams id_args $
-	      foldr mk_case con_app 
-		    (zip (dict_args ++ id_args) all_strict_marks)
-		    i3 []
-
-    con_app i rep_ids = mkApps (Var wrk_id)
-			       (map varToCoreExpr (tyvars ++ reverse rep_ids))
-
-    (dict_args,i2) = mkLocals 1  dict_tys
-    (id_args,i3)   = mkLocals i2 orig_arg_tys
-    alg_arity	   = i3-1
-
-    mk_case 
-	   :: (Id, StrictnessMark)	-- Arg, strictness
-	   -> (Int -> [Id] -> CoreExpr) -- Body
-	   -> Int			-- Next rep arg id
-	   -> [Id]			-- Rep args so far, reversed
-	   -> CoreExpr
-    mk_case (arg,strict) body i rep_args
-  	  = case strict of
-		NotMarkedStrict -> body i (arg:rep_args)
-		MarkedStrict 
-		   | isUnLiftedType (idType arg) -> body i (arg:rep_args)
-		   | otherwise ->
-			Case (Var arg) arg result_ty [(DEFAULT,[], body i (arg:rep_args))]
-
-		MarkedUnboxed
-		   -> case splitProductType "do_unbox" (idType arg) of
-			   (tycon, tycon_args, con, tys) ->
-				   Case (Var arg) arg result_ty  
-					[(DataAlt con, 
-					  con_args,
-					  body i' (reverse con_args ++ rep_args))]
-			      where 
-				(con_args, i') = mkLocals i tys
-
-mAX_CPR_SIZE :: Arity
-mAX_CPR_SIZE = 10
--- We do not treat very big tuples as CPR-ish:
---	a) for a start we get into trouble because there aren't 
---	   "enough" unboxed tuple types (a tiresome restriction, 
---	   but hard to fix), 
---	b) more importantly, big unboxed tuples get returned mainly
---	   on the stack, and are often then allocated in the heap
---	   by the caller.  So doing CPR for them may in fact make
---	   things worse.
-
-mkLocals i tys = (zipWith mkTemplateLocal [i..i+n-1] tys, i+n)
-	       where
-		 n = length tys
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Record selectors}
-%*									*
-%************************************************************************
-
-We're going to build a record selector unfolding that looks like this:
-
-	data T a b c = T1 { ..., op :: a, ...}
-		     | T2 { ..., op :: a, ...}
-		     | T3
-
-	sel = /\ a b c -> \ d -> case d of
-				    T1 ... x ... -> x
-				    T2 ... x ... -> x
-				    other	 -> error "..."
-
-Similarly for newtypes
-
-	newtype N a = MkN { unN :: a->a }
-
-	unN :: N a -> a -> a
-	unN n = coerce (a->a) n
-	
-We need to take a little care if the field has a polymorphic type:
-
-	data R = R { f :: forall a. a->a }
-
-Then we want
-
-	f :: forall a. R -> a -> a
-	f = /\ a \ r = case r of
-			  R f -> f a
-
-(not f :: R -> forall a. a->a, which gives the type inference mechanism 
-problems at call sites)
-
-Similarly for (recursive) newtypes
-
-	newtype N = MkN { unN :: forall a. a->a }
-
-	unN :: forall b. N -> b -> b
-	unN = /\b -> \n:N -> (coerce (forall a. a->a) n)
-
-
-Note [Naughty record selectors]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-A "naughty" field is one for which we can't define a record 
-selector, because an existential type variable would escape.  For example:
-	data T = forall a. MkT { x,y::a }
-We obviously can't define	
-	x (MkT v _) = v
-Nevertheless we *do* put a RecordSelId into the type environment
-so that if the user tries to use 'x' as a selector we can bleat
-helpfully, rather than saying unhelpfully that 'x' is not in scope.
-Hence the sel_naughty flag, to identify record selcectors that don't really exist.
-
-In general, a field is naughty if its type mentions a type variable that
-isn't in the result type of the constructor.
-
-For GADTs, we require that all constructors with a common field 'f' have the same
-result type (modulo alpha conversion).  [Checked in TcTyClsDecls.checkValidTyCon]
-E.g. 
-	data T where
-	  T1 { f :: a } :: T [a]
-	  T2 { f :: a, y :: b  } :: T [a]
-and now the selector takes that type as its argument:
-	f :: forall a. T [a] -> a
-	f t = case t of
-		T1 { f = v } -> v
-		T2 { f = v } -> v
-Note the forall'd tyvars of the selector are just the free tyvars
-of the result type; there may be other tyvars in the constructor's
-type (e.g. 'b' in T2).
-
-\begin{code}
-
--- XXX - autrijus -
--- Plan: 1. Determine naughtiness by comparing field type vs result type
---       2. Install naughty ones with selector_ty of type _|_ and fill in mzero for info
---       3. If it's not naughty, do the normal plan.
-
-mkRecordSelId :: TyCon -> FieldLabel -> Id
-mkRecordSelId tycon field_label
-	-- Assumes that all fields with the same field label have the same type
-  | is_naughty = naughty_id
-  | otherwise  = sel_id
-  where
-    is_naughty = not (tyVarsOfType field_ty `subVarSet` tyvar_set)
-    sel_id_details = RecordSelId tycon field_label is_naughty
-
-    -- Escapist case here for naughty construcotrs
-    -- We give it no IdInfo, and a type of forall a.a (never looked at)
-    naughty_id = mkGlobalId sel_id_details field_label forall_a_a noCafIdInfo
-    forall_a_a = mkForAllTy alphaTyVar (mkTyVarTy alphaTyVar)
-
-    -- Normal case starts here
-    sel_id = mkGlobalId sel_id_details field_label selector_ty info
-    data_cons  	      = tyConDataCons tycon	
-    data_cons_w_field = filter has_field data_cons	-- Can't be empty!
-    has_field con     = field_label `elem` dataConFieldLabels con
-
-    con1	= head data_cons_w_field
-    res_tys	= dataConResTys con1
-    tyvar_set	= tyVarsOfTypes res_tys
-    tyvars	= varSetElems tyvar_set
-    data_ty	= mkTyConApp tycon res_tys
-    field_ty	= dataConFieldType con1 field_label
-    
-	-- *Very* tiresomely, the selectors are (unnecessarily!) overloaded over
-	-- just the dictionaries in the types of the constructors that contain
-	-- the relevant field.  [The Report says that pattern matching on a
-	-- constructor gives the same constraints as applying it.]  Urgh.  
-	--
-	-- However, not all data cons have all constraints (because of
-	-- BuildTyCl.mkDataConStupidTheta).  So we need to find all the data cons 
-	-- involved in the pattern match and take the union of their constraints.
-    stupid_dict_tys = mkPredTys (dataConsStupidTheta data_cons_w_field)
-    n_stupid_dicts  = length stupid_dict_tys
-
-    (field_tyvars,field_theta,field_tau) = tcSplitSigmaTy field_ty
-    field_dict_tys			 = mkPredTys field_theta
-    n_field_dict_tys			 = length field_dict_tys
-	-- If the field has a universally quantified type we have to 
-	-- be a bit careful.  Suppose we have
-	--	data R = R { op :: forall a. Foo a => a -> a }
-	-- Then we can't give op the type
-	--	op :: R -> forall a. Foo a => a -> a
-	-- because the typechecker doesn't understand foralls to the
-	-- right of an arrow.  The "right" type to give it is
-	--	op :: forall a. Foo a => R -> a -> a
-	-- But then we must generate the right unfolding too:
-	--	op = /\a -> \dfoo -> \ r ->
-	--	     case r of
-	--		R op -> op a dfoo
-	-- Note that this is exactly the type we'd infer from a user defn
-	--	op (R op) = op
-
-    selector_ty :: Type
-    selector_ty  = mkForAllTys tyvars $ mkForAllTys field_tyvars $
-		   mkFunTys stupid_dict_tys  $  mkFunTys field_dict_tys $
-		   mkFunTy data_ty field_tau
-      
-    arity = 1 + n_stupid_dicts + n_field_dict_tys
-
-    (strict_sig, rhs_w_str) = dmdAnalTopRhs sel_rhs
-	-- Use the demand analyser to work out strictness.
-	-- With all this unpackery it's not easy!
-
-    info = noCafIdInfo
-	   `setCafInfo`		  caf_info
-	   `setArityInfo`	  arity
-	   `setUnfoldingInfo`     mkTopUnfolding rhs_w_str
-	   `setAllStrictnessInfo` Just strict_sig
-
-	-- Allocate Ids.  We do it a funny way round because field_dict_tys is
-	-- almost always empty.  Also note that we use max_dict_tys
- 	-- rather than n_dict_tys, because the latter gives an infinite loop:
-	-- n_dict tys depends on the_alts, which depens on arg_ids, which depends
-	-- on arity, which depends on n_dict tys.  Sigh!  Mega sigh!
-    stupid_dict_ids  = mkTemplateLocalsNum 1 stupid_dict_tys
-    max_stupid_dicts = length (tyConStupidTheta tycon)
-    field_dict_base  = max_stupid_dicts + 1
-    field_dict_ids   = mkTemplateLocalsNum field_dict_base field_dict_tys
-    dict_id_base     = field_dict_base + n_field_dict_tys
-    data_id	     = mkTemplateLocal dict_id_base data_ty
-    arg_base	     = dict_id_base + 1
-
-    the_alts :: [CoreAlt]
-    the_alts   = map mk_alt data_cons_w_field	-- Already sorted by data-con
-    no_default = length data_cons == length data_cons_w_field	-- No default needed
-
-    default_alt | no_default = []
-		| otherwise  = [(DEFAULT, [], error_expr)]
-
-	-- The default branch may have CAF refs, because it calls recSelError etc.
-    caf_info    | no_default = NoCafRefs
-	        | otherwise  = MayHaveCafRefs
-
-    sel_rhs = mkLams tyvars   $ mkLams field_tyvars $ 
-	      mkLams stupid_dict_ids $ mkLams field_dict_ids $
-	      Lam data_id     $ sel_body
-
-    sel_body | isNewTyCon tycon = mk_result (mkNewTypeBody tycon field_ty (Var data_id))
-	     | otherwise	= Case (Var data_id) data_id field_tau (default_alt ++ the_alts)
-
-    mk_result poly_result = mkVarApps (mkVarApps poly_result field_tyvars) field_dict_ids
-	-- We pull the field lambdas to the top, so we need to 
-	-- apply them in the body.  For example:
-	--	data T = MkT { foo :: forall a. a->a }
-	--
-	--	foo :: forall a. T -> a -> a
-	--	foo = /\a. \t:T. case t of { MkT f -> f a }
-
-    mk_alt data_con 
-      = 	-- In the non-vanilla case, the pattern must bind type variables and
-		-- the context stuff; hence the arg_prefix binding below
-	  mkReboxingAlt uniqs data_con (arg_prefix ++ arg_ids)
-			(mk_result (Var the_arg_id))
-      where
-	(arg_prefix, arg_ids)
-	   | isVanillaDataCon data_con	 	-- Instantiate from commmon base
-	   = ([], mkTemplateLocalsNum arg_base (dataConInstOrigArgTys data_con res_tys))
-	   | otherwise		-- The case pattern binds type variables, which are used
-				-- in the types of the arguments of the pattern
-	   = (dc_tyvars ++ mkTemplateLocalsNum arg_base (mkPredTys dc_theta),
-	      mkTemplateLocalsNum arg_base' dc_arg_tys)
-
-	(dc_tyvars, dc_theta, dc_arg_tys, _, _) = dataConSig data_con
-	arg_base' = arg_base + length dc_theta
-
-	unpack_base = arg_base' + length dc_arg_tys
-	uniqs = map mkBuiltinUnique [unpack_base..]
-
-    	the_arg_id  = assoc "mkRecordSelId:mk_alt" (field_lbls `zip` arg_ids) field_label
-    	field_lbls  = dataConFieldLabels data_con
-
-    error_expr = mkRuntimeErrorApp rEC_SEL_ERROR_ID field_tau full_msg
-    full_msg   = showSDoc (sep [text "No match in record selector", ppr sel_id]) 
-
-
--- (mkReboxingAlt us con xs rhs) basically constructs the case
--- alternative	(con, xs, rhs)
--- but it does the reboxing necessary to construct the *source* 
--- arguments, xs, from the representation arguments ys.
--- For example:
---	data T = MkT !(Int,Int) Bool
---
--- mkReboxingAlt MkT [x,b] r 
---	= (DataAlt MkT, [y::Int,z::Int,b], let x = (y,z) in r)
---
--- mkDataAlt should really be in DataCon, but it can't because
--- it manipulates CoreSyn.
-
-mkReboxingAlt
-  :: [Unique]			-- Uniques for the new Ids
-  -> DataCon
-  -> [Var]			-- Source-level args, including existential dicts
-  -> CoreExpr			-- RHS
-  -> CoreAlt
-
-mkReboxingAlt us con args rhs
-  | not (any isMarkedUnboxed stricts)
-  = (DataAlt con, args, rhs)
-
-  | otherwise
-  = let
-	(binds, args') = go args stricts us
-    in
-    (DataAlt con, args', mkLets binds rhs)
-
-  where
-    stricts = dataConExStricts con ++ dataConStrictMarks con
-
-    go [] stricts us = ([], [])
-
-	-- Type variable case
-    go (arg:args) stricts us 
-      | isTyVar arg
-      = let (binds, args') = go args stricts us
-	in  (binds, arg:args')
-
-	-- Term variable case
-    go (arg:args) (str:stricts) us
-      | isMarkedUnboxed str
-      = let
-	  (_, tycon_args, pack_con, con_arg_tys)
-	 	 = splitProductType "mkReboxingAlt" (idType arg)
-
-	  unpacked_args  = zipWith (mkSysLocal FSLIT("rb")) us con_arg_tys
-	  (binds, args') = go args stricts (dropList con_arg_tys us)
-	  con_app	 = mkConApp pack_con (map Type tycon_args ++ map Var unpacked_args)
-	in
-	(NonRec arg con_app : binds, unpacked_args ++ args')
-
-      | otherwise
-      = let (binds, args') = go args stricts us
-        in  (binds, arg:args')
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Dictionary selectors}
-%*									*
-%************************************************************************
-
-Selecting a field for a dictionary.  If there is just one field, then
-there's nothing to do.  
-
-Dictionary selectors may get nested forall-types.  Thus:
-
-	class Foo a where
-	  op :: forall b. Ord b => a -> b -> b
-
-Then the top-level type for op is
-
-	op :: forall a. Foo a => 
-	      forall b. Ord b => 
-	      a -> b -> b
-
-This is unlike ordinary record selectors, which have all the for-alls
-at the outside.  When dealing with classes it's very convenient to
-recover the original type signature from the class op selector.
-
-\begin{code}
-mkDictSelId :: Name -> Class -> Id
-mkDictSelId name clas
-  = mkGlobalId (ClassOpId clas) name sel_ty info
-  where
-    sel_ty = mkForAllTys tyvars (mkFunTy (idType dict_id) (idType the_arg_id))
-	-- We can't just say (exprType rhs), because that would give a type
-	--	C a -> C a
-	-- for a single-op class (after all, the selector is the identity)
-	-- But it's type must expose the representation of the dictionary
-	-- to gat (say)		C a -> (a -> a)
-
-    info = noCafIdInfo
-		`setArityInfo`	    	1
-		`setUnfoldingInfo`  	mkTopUnfolding rhs
-		`setAllStrictnessInfo`	Just strict_sig
-
-	-- We no longer use 'must-inline' on record selectors.  They'll
-	-- inline like crazy if they scrutinise a constructor
-
-	-- The strictness signature is of the form U(AAAVAAAA) -> T
- 	-- where the V depends on which item we are selecting
-	-- It's worth giving one, so that absence info etc is generated
-	-- even if the selector isn't inlined
-    strict_sig = mkStrictSig (mkTopDmdType [arg_dmd] TopRes)
-    arg_dmd | isNewTyCon tycon = evalDmd
-	    | otherwise	       = Eval (Prod [ if the_arg_id == id then evalDmd else Abs
-					    | id <- arg_ids ])
-
-    tycon      = classTyCon clas
-    [data_con] = tyConDataCons tycon
-    tyvars     = dataConTyVars data_con
-    arg_tys    = dataConRepArgTys data_con
-    the_arg_id = assoc "MkId.mkDictSelId" (map idName (classSelIds clas) `zip` arg_ids) name
-
-    pred	      = mkClassPred clas (mkTyVarTys tyvars)
-    (dict_id:arg_ids) = mkTemplateLocals (mkPredTy pred : arg_tys)
-
-    rhs | isNewTyCon tycon = mkLams tyvars $ Lam dict_id $ 
-			     mkNewTypeBody tycon (head arg_tys) (Var dict_id)
-	| otherwise	   = mkLams tyvars $ Lam dict_id $
-			     Case (Var dict_id) dict_id (idType the_arg_id)
-			     	  [(DataAlt data_con, arg_ids, Var the_arg_id)]
-
-mkNewTypeBody tycon result_ty result_expr
-	-- Adds a coerce where necessary
-	-- Used for both wrapping and unwrapping
-  | isRecursiveTyCon tycon	-- Recursive case; use a coerce
-  = Note (Coerce result_ty (exprType result_expr)) result_expr
-  | otherwise			-- Normal case
-  = result_expr
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Primitive operations
-%*									*
-%************************************************************************
-
-\begin{code}
-mkPrimOpId :: PrimOp -> Id
-mkPrimOpId prim_op 
-  = id
-  where
-    (tyvars,arg_tys,res_ty, arity, strict_sig) = primOpSig prim_op
-    ty   = mkForAllTys tyvars (mkFunTys arg_tys res_ty)
-    name = mkWiredInName gHC_PRIM (primOpOcc prim_op) 
-			 (mkPrimOpIdUnique (primOpTag prim_op))
-			 Nothing (AnId id) UserSyntax
-    id   = mkGlobalId (PrimOpId prim_op) name ty info
-		
-    info = noCafIdInfo
-	   `setSpecInfo`	  mkSpecInfo (primOpRules prim_op name)
-	   `setArityInfo` 	  arity
-	   `setAllStrictnessInfo` Just strict_sig
-
--- For each ccall we manufacture a separate CCallOpId, giving it
--- a fresh unique, a type that is correct for this particular ccall,
--- and a CCall structure that gives the correct details about calling
--- convention etc.  
---
--- The *name* of this Id is a local name whose OccName gives the full
--- details of the ccall, type and all.  This means that the interface 
--- file reader can reconstruct a suitable Id
-
-mkFCallId :: Unique -> ForeignCall -> Type -> Id
-mkFCallId uniq fcall ty
-  = ASSERT( isEmptyVarSet (tyVarsOfType ty) )
-	-- A CCallOpId should have no free type variables; 
-	-- when doing substitutions won't substitute over it
-    mkGlobalId (FCallId fcall) name ty info
-  where
-    occ_str = showSDoc (braces (ppr fcall <+> ppr ty))
-	-- The "occurrence name" of a ccall is the full info about the
-	-- ccall; it is encoded, but may have embedded spaces etc!
-
-    name = mkFCallName uniq occ_str
-
-    info = noCafIdInfo
-	   `setArityInfo` 		arity
-	   `setAllStrictnessInfo`	Just strict_sig
-
-    (_, tau) 	 = tcSplitForAllTys ty
-    (arg_tys, _) = tcSplitFunTys tau
-    arity	 = length arg_tys
-    strict_sig   = mkStrictSig (mkTopDmdType (replicate arity evalDmd) TopRes)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{DictFuns and default methods}
-%*									*
-%************************************************************************
-
-Important notes about dict funs and default methods
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Dict funs and default methods are *not* ImplicitIds.  Their definition
-involves user-written code, so we can't figure out their strictness etc
-based on fixed info, as we can for constructors and record selectors (say).
-
-We build them as LocalIds, but with External Names.  This ensures that
-they are taken to account by free-variable finding and dependency
-analysis (e.g. CoreFVs.exprFreeVars).
-
-Why shouldn't they be bound as GlobalIds?  Because, in particular, if
-they are globals, the specialiser floats dict uses above their defns,
-which prevents good simplifications happening.  Also the strictness
-analyser treats a occurrence of a GlobalId as imported and assumes it
-contains strictness in its IdInfo, which isn't true if the thing is
-bound in the same module as the occurrence.
-
-It's OK for dfuns to be LocalIds, because we form the instance-env to
-pass on to the next module (md_insts) in CoreTidy, afer tidying
-and globalising the top-level Ids.
-
-BUT make sure they are *exported* LocalIds (mkExportedLocalId) so 
-that they aren't discarded by the occurrence analyser.
-
-\begin{code}
-mkDefaultMethodId dm_name ty = mkExportedLocalId dm_name ty
-
-mkDictFunId :: Name		-- Name to use for the dict fun;
-	    -> [TyVar]
-	    -> ThetaType
-	    -> Class 
-	    -> [Type]
-	    -> Id
-
-mkDictFunId dfun_name inst_tyvars dfun_theta clas inst_tys
-  = mkExportedLocalId dfun_name dfun_ty
-  where
-    dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
-
-{-  1 dec 99: disable the Mark Jones optimisation for the sake
-    of compatibility with Hugs.
-    See `types/InstEnv' for a discussion related to this.
-
-    (class_tyvars, sc_theta, _, _) = classBigSig clas
-    not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
-    sc_theta' = substClasses (zipTopTvSubst class_tyvars inst_tys) sc_theta
-    dfun_theta = case inst_decl_theta of
-		   []    -> []	-- If inst_decl_theta is empty, then we don't
-				-- want to have any dict arguments, so that we can
-				-- expose the constant methods.
-
-		   other -> nub (inst_decl_theta ++ filter not_const sc_theta')
-				-- Otherwise we pass the superclass dictionaries to
-				-- the dictionary function; the Mark Jones optimisation.
-				--
-				-- NOTE the "nub".  I got caught by this one:
-				--   class Monad m => MonadT t m where ...
-				--   instance Monad m => MonadT (EnvT env) m where ...
-				-- Here, the inst_decl_theta has (Monad m); but so
-				-- does the sc_theta'!
-				--
-				-- NOTE the "not_const".  I got caught by this one too:
-				--   class Foo a => Baz a b where ...
-				--   instance Wob b => Baz T b where..
-				-- Now sc_theta' has Foo T
--}
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Un-definable}
-%*									*
-%************************************************************************
-
-These Ids can't be defined in Haskell.  They could be defined in
-unfoldings in the wired-in GHC.Prim interface file, but we'd have to
-ensure that they were definitely, definitely inlined, because there is
-no curried identifier for them.  That's what mkCompulsoryUnfolding
-does.  If we had a way to get a compulsory unfolding from an interface
-file, we could do that, but we don't right now.
-
-unsafeCoerce# isn't so much a PrimOp as a phantom identifier, that
-just gets expanded into a type coercion wherever it occurs.  Hence we
-add it as a built-in Id with an unfolding here.
-
-The type variables we use here are "open" type variables: this means
-they can unify with both unlifted and lifted types.  Hence we provide
-another gun with which to shoot yourself in the foot.
-
-\begin{code}
-mkWiredInIdName mod fs uniq id
- = mkWiredInName mod (mkOccNameFS varName fs) uniq Nothing (AnId id) UserSyntax
-
-unsafeCoerceName = mkWiredInIdName gHC_PRIM FSLIT("unsafeCoerce#") unsafeCoerceIdKey  unsafeCoerceId
-nullAddrName     = mkWiredInIdName gHC_PRIM FSLIT("nullAddr#")	   nullAddrIdKey      nullAddrId
-seqName		 = mkWiredInIdName gHC_PRIM FSLIT("seq")	   seqIdKey	      seqId
-realWorldName	 = mkWiredInIdName gHC_PRIM FSLIT("realWorld#")	   realWorldPrimIdKey realWorldPrimId
-lazyIdName	 = mkWiredInIdName pREL_BASE FSLIT("lazy")         lazyIdKey	      lazyId
-
-errorName		 = mkWiredInIdName pREL_ERR FSLIT("error")	     errorIdKey eRROR_ID
-recSelErrorName		 = mkWiredInIdName pREL_ERR FSLIT("recSelError")     recSelErrorIdKey rEC_SEL_ERROR_ID
-runtimeErrorName	 = mkWiredInIdName pREL_ERR FSLIT("runtimeError")    runtimeErrorIdKey rUNTIME_ERROR_ID
-irrefutPatErrorName	 = mkWiredInIdName pREL_ERR FSLIT("irrefutPatError") irrefutPatErrorIdKey iRREFUT_PAT_ERROR_ID
-recConErrorName		 = mkWiredInIdName pREL_ERR FSLIT("recConError")     recConErrorIdKey rEC_CON_ERROR_ID
-patErrorName 		 = mkWiredInIdName pREL_ERR FSLIT("patError") 	     patErrorIdKey pAT_ERROR_ID
-noMethodBindingErrorName = mkWiredInIdName pREL_ERR FSLIT("noMethodBindingError")
-					   noMethodBindingErrorIdKey nO_METHOD_BINDING_ERROR_ID
-nonExhaustiveGuardsErrorName 
-  = mkWiredInIdName pREL_ERR FSLIT("nonExhaustiveGuardsError") 
-		    nonExhaustiveGuardsErrorIdKey nON_EXHAUSTIVE_GUARDS_ERROR_ID
-\end{code}
-
-\begin{code}
--- unsafeCoerce# :: forall a b. a -> b
-unsafeCoerceId
-  = pcMiscPrelId unsafeCoerceName ty info
-  where
-    info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
-	   
-
-    ty  = mkForAllTys [openAlphaTyVar,openBetaTyVar]
-		      (mkFunTy openAlphaTy openBetaTy)
-    [x] = mkTemplateLocals [openAlphaTy]
-    rhs = mkLams [openAlphaTyVar,openBetaTyVar,x] $
-	  Note (Coerce openBetaTy openAlphaTy) (Var x)
-
--- nullAddr# :: Addr#
--- The reason is is here is because we don't provide 
--- a way to write this literal in Haskell.
-nullAddrId 
-  = pcMiscPrelId nullAddrName addrPrimTy info
-  where
-    info = noCafIdInfo `setUnfoldingInfo` 
-	   mkCompulsoryUnfolding (Lit nullAddrLit)
-
-seqId
-  = pcMiscPrelId seqName ty info
-  where
-    info = noCafIdInfo `setUnfoldingInfo` mkCompulsoryUnfolding rhs
-	   
-
-    ty  = mkForAllTys [alphaTyVar,openBetaTyVar]
-		      (mkFunTy alphaTy (mkFunTy openBetaTy openBetaTy))
-    [x,y] = mkTemplateLocals [alphaTy, openBetaTy]
--- gaw 2004
-    rhs = mkLams [alphaTyVar,openBetaTyVar,x,y] (Case (Var x) x openBetaTy [(DEFAULT, [], Var y)])
-
--- lazy :: forall a?. a? -> a?	 (i.e. works for unboxed types too)
--- Used to lazify pseq:		pseq a b = a `seq` lazy b
--- No unfolding: it gets "inlined" by the worker/wrapper pass
--- Also, no strictness: by being a built-in Id, it overrides all
--- the info in PrelBase.hi.  This is important, because the strictness
--- analyser will spot it as strict!
-lazyId
-  = pcMiscPrelId lazyIdName ty info
-  where
-    info = noCafIdInfo
-    ty  = mkForAllTys [alphaTyVar] (mkFunTy alphaTy alphaTy)
-
-lazyIdUnfolding :: CoreExpr	-- Used to expand LazyOp after strictness anal
-lazyIdUnfolding = mkLams [openAlphaTyVar,x] (Var x)
-		where
-		  [x] = mkTemplateLocals [openAlphaTy]
-\end{code}
-
-@realWorld#@ used to be a magic literal, \tr{void#}.  If things get
-nasty as-is, change it back to a literal (@Literal@).
-
-voidArgId is a Local Id used simply as an argument in functions
-where we just want an arg to avoid having a thunk of unlifted type.
-E.g.
-	x = \ void :: State# RealWorld -> (# p, q #)
-
-This comes up in strictness analysis
-
-\begin{code}
-realWorldPrimId	-- :: State# RealWorld
-  = pcMiscPrelId realWorldName realWorldStatePrimTy
-		 (noCafIdInfo `setUnfoldingInfo` evaldUnfolding)
-	-- The evaldUnfolding makes it look that realWorld# is evaluated
-	-- which in turn makes Simplify.interestingArg return True,
-	-- which in turn makes INLINE things applied to realWorld# likely
-	-- to be inlined
-
-voidArgId 	-- :: State# RealWorld
-  = mkSysLocal FSLIT("void") voidArgIdKey realWorldStatePrimTy
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[PrelVals-error-related]{@error@ and friends; @trace@}
-%*									*
-%************************************************************************
-
-GHC randomly injects these into the code.
-
-@patError@ is just a version of @error@ for pattern-matching
-failures.  It knows various ``codes'' which expand to longer
-strings---this saves space!
-
-@absentErr@ is a thing we put in for ``absent'' arguments.  They jolly
-well shouldn't be yanked on, but if one is, then you will get a
-friendly message from @absentErr@ (rather than a totally random
-crash).
-
-@parError@ is a special version of @error@ which the compiler does
-not know to be a bottoming Id.  It is used in the @_par_@ and @_seq_@
-templates, but we don't ever expect to generate code for it.
-
-\begin{code}
-mkRuntimeErrorApp 
-	:: Id 		-- Should be of type (forall a. Addr# -> a)
-			-- 	where Addr# points to a UTF8 encoded string
-	-> Type 	-- The type to instantiate 'a'
-	-> String	-- The string to print
-	-> CoreExpr
-
-mkRuntimeErrorApp err_id res_ty err_msg 
-  = mkApps (Var err_id) [Type res_ty, err_string]
-  where
-    err_string = Lit (mkStringLit err_msg)
-
-rEC_SEL_ERROR_ID		= mkRuntimeErrorId recSelErrorName
-rUNTIME_ERROR_ID	 	= mkRuntimeErrorId runtimeErrorName
-iRREFUT_PAT_ERROR_ID		= mkRuntimeErrorId irrefutPatErrorName
-rEC_CON_ERROR_ID		= mkRuntimeErrorId recConErrorName
-pAT_ERROR_ID			= mkRuntimeErrorId patErrorName
-nO_METHOD_BINDING_ERROR_ID      = mkRuntimeErrorId noMethodBindingErrorName
-nON_EXHAUSTIVE_GUARDS_ERROR_ID	= mkRuntimeErrorId nonExhaustiveGuardsErrorName
-
--- The runtime error Ids take a UTF8-encoded string as argument
-mkRuntimeErrorId name = pc_bottoming_Id name runtimeErrorTy
-runtimeErrorTy 	      = mkSigmaTy [openAlphaTyVar] [] (mkFunTy addrPrimTy openAlphaTy)
-\end{code}
-
-\begin{code}
-eRROR_ID = pc_bottoming_Id errorName errorTy
-
-errorTy  :: Type
-errorTy  = mkSigmaTy [openAlphaTyVar] [] (mkFunTys [mkListTy charTy] openAlphaTy)
-    -- Notice the openAlphaTyVar.  It says that "error" can be applied
-    -- to unboxed as well as boxed types.  This is OK because it never
-    -- returns, so the return type is irrelevant.
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Utilities}
-%*									*
-%************************************************************************
-
-\begin{code}
-pcMiscPrelId :: Name -> Type -> IdInfo -> Id
-pcMiscPrelId name ty info
-  = mkVanillaGlobal name ty info
-    -- We lie and say the thing is imported; otherwise, we get into
-    -- a mess with dependency analysis; e.g., core2stg may heave in
-    -- random calls to GHCbase.unpackPS__.  If GHCbase is the module
-    -- being compiled, then it's just a matter of luck if the definition
-    -- will be in "the right place" to be in scope.
-
-pc_bottoming_Id name ty
- = pcMiscPrelId name ty bottoming_info
- where
-    bottoming_info = vanillaIdInfo `setAllStrictnessInfo` Just strict_sig
-	-- Do *not* mark them as NoCafRefs, because they can indeed have
-	-- CAF refs.  For example, pAT_ERROR_ID calls GHC.Err.untangle,
-	-- which has some CAFs
-	-- In due course we may arrange that these error-y things are
-	-- regarded by the GC as permanently live, in which case we
-	-- can give them NoCaf info.  As it is, any function that calls
-	-- any pc_bottoming_Id will itself have CafRefs, which bloats
-	-- SRTs.
-
-    strict_sig	   = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
-	-- These "bottom" out, no matter what their arguments
-
-(openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
-openAlphaTy  = mkTyVarTy openAlphaTyVar
-openBetaTy   = mkTyVarTy openBetaTyVar
-\end{code}
-
diff --git a/ghc/compiler/basicTypes/MkId.lhs-boot b/ghc/compiler/basicTypes/MkId.lhs-boot
deleted file mode 100644
index 4f9615a061..0000000000
--- a/ghc/compiler/basicTypes/MkId.lhs-boot
+++ /dev/null
@@ -1,9 +0,0 @@
-\begin{code}
-module MkId where
-import Name( Name )
-import DataCon( DataCon, DataConIds )
-
-mkDataConIds :: Name -> Name -> DataCon -> DataConIds
-\end{code}
-
-
diff --git a/ghc/compiler/basicTypes/Module.hi-boot-5 b/ghc/compiler/basicTypes/Module.hi-boot-5
deleted file mode 100644
index cdc5fbf581..0000000000
--- a/ghc/compiler/basicTypes/Module.hi-boot-5
+++ /dev/null
@@ -1,4 +0,0 @@
-__interface Module 1 0 where
-__export Module Module ;
-1 data Module ;
-
diff --git a/ghc/compiler/basicTypes/Module.hi-boot-6 b/ghc/compiler/basicTypes/Module.hi-boot-6
deleted file mode 100644
index c4d4b5d474..0000000000
--- a/ghc/compiler/basicTypes/Module.hi-boot-6
+++ /dev/null
@@ -1,3 +0,0 @@
-module Module where
-data Module
-
diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs
deleted file mode 100644
index 69521625b0..0000000000
--- a/ghc/compiler/basicTypes/Module.lhs
+++ /dev/null
@@ -1,216 +0,0 @@
-%
-% (c) The University of Glasgow, 2004
-%
-
-Module
-~~~~~~~~~~
-Simply the name of a module, represented as a FastString.
-These are Uniquable, hence we can build FiniteMaps with ModuleNames as
-the keys.
-
-\begin{code}
-module Module 
-    (
-      Module 		   	-- Abstract, instance of Eq, Ord, Outputable
-    , pprModule			-- :: ModuleName -> SDoc
-
-    , ModLocation(..)
-    , addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn
-
-    , moduleString		-- :: ModuleName -> String
-    , moduleFS			-- :: ModuleName -> FastString
-
-    , mkModule			-- :: String -> ModuleName
-    , mkModuleFS		-- :: FastString -> ModuleName
- 
-    , ModuleEnv
-    , elemModuleEnv, extendModuleEnv, extendModuleEnvList, plusModuleEnv_C
-    , delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv
-    , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv
-    , moduleEnvElts, unitModuleEnv, isEmptyModuleEnv, foldModuleEnv
-    , extendModuleEnv_C, filterModuleEnv
-
-    , ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
-
-    ) where
-
-#include "HsVersions.h"
-import Outputable
-import Unique		( Uniquable(..) )
-import UniqFM
-import UniqSet
-import Binary
-import FastString
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Module locations}
-%*									*
-%************************************************************************
-
-\begin{code}
-data ModLocation
-   = ModLocation {
-        ml_hs_file   :: Maybe FilePath,
-		-- The source file, if we have one.  Package modules
-		-- probably don't have source files.
-
-        ml_hi_file   :: FilePath,
-		-- Where the .hi file is, whether or not it exists
-		-- yet.  Always of form foo.hi, even if there is an
-		-- hi-boot file (we add the -boot suffix later)
-
-        ml_obj_file  :: FilePath
-		-- Where the .o file is, whether or not it exists yet.
-		-- (might not exist either because the module hasn't
-		-- been compiled yet, or because it is part of a
-		-- package with a .a file)
-  } deriving Show
-
-instance Outputable ModLocation where
-   ppr = text . show
-\end{code}
-
-For a module in another package, the hs_file and obj_file
-components of ModLocation are undefined.  
-
-The locations specified by a ModLocation may or may not
-correspond to actual files yet: for example, even if the object
-file doesn't exist, the ModLocation still contains the path to
-where the object file will reside if/when it is created.
-
-\begin{code}
-addBootSuffix :: FilePath -> FilePath
--- Add the "-boot" suffix to .hs, .hi and .o files
-addBootSuffix path = path ++ "-boot"
-
-addBootSuffix_maybe :: Bool -> FilePath -> FilePath
-addBootSuffix_maybe is_boot path
- | is_boot   = addBootSuffix path
- | otherwise = path
-
-addBootSuffixLocn :: ModLocation -> ModLocation
-addBootSuffixLocn locn
-  = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)
-	 , ml_hi_file  = addBootSuffix (ml_hi_file locn)
-	 , ml_obj_file = addBootSuffix (ml_obj_file locn) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The name of a module}
-%*									*
-%************************************************************************
-
-\begin{code}
-newtype Module = Module FastString
-	-- Haskell module names can include the quote character ',
-	-- so the module names have the z-encoding applied to them
-
-instance Binary Module where
-   put_ bh (Module m) = put_ bh m
-   get bh = do m <- get bh; return (Module m)
-
-instance Uniquable Module where
-  getUnique (Module nm) = getUnique nm
-
-instance Eq Module where
-  nm1 == nm2 = getUnique nm1 == getUnique nm2
-
--- Warning: gives an ordering relation based on the uniques of the
--- FastStrings which are the (encoded) module names.  This is _not_
--- a lexicographical ordering.
-instance Ord Module where
-  nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
-
-instance Outputable Module where
-  ppr = pprModule
-
-pprModule :: Module -> SDoc
-pprModule (Module nm) = 
-    getPprStyle $ \ sty ->
-    if codeStyle sty 
-	then ftext (zEncodeFS nm)
-	else ftext nm
-
-moduleFS :: Module -> FastString
-moduleFS (Module mod) = mod
-
-moduleString :: Module -> String
-moduleString (Module mod) = unpackFS mod
-
--- used to be called mkSrcModule
-mkModule :: String -> Module
-mkModule s = Module (mkFastString s)
-
--- used to be called mkSrcModuleFS
-mkModuleFS :: FastString -> Module
-mkModuleFS s = Module s
-\end{code}
-
-%************************************************************************
-%*                                                                      *
-\subsection{@ModuleEnv@s}
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
-type ModuleEnv elt = UniqFM elt
-
-emptyModuleEnv       :: ModuleEnv a
-mkModuleEnv          :: [(Module, a)] -> ModuleEnv a
-unitModuleEnv        :: Module -> a -> ModuleEnv a
-extendModuleEnv      :: ModuleEnv a -> Module -> a -> ModuleEnv a
-extendModuleEnv_C    :: (a->a->a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
-plusModuleEnv        :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
-extendModuleEnvList  :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
-                  
-delModuleEnvList     :: ModuleEnv a -> [Module] -> ModuleEnv a
-delModuleEnv         :: ModuleEnv a -> Module -> ModuleEnv a
-plusModuleEnv_C      :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
-mapModuleEnv         :: (a -> b) -> ModuleEnv a -> ModuleEnv b
-moduleEnvElts        :: ModuleEnv a -> [a]
-                  
-isEmptyModuleEnv     :: ModuleEnv a -> Bool
-lookupModuleEnv      :: ModuleEnv a -> Module     -> Maybe a
-lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
-elemModuleEnv        :: Module -> ModuleEnv a -> Bool
-foldModuleEnv        :: (a -> b -> b) -> b -> ModuleEnv a -> b
-filterModuleEnv      :: (a -> Bool) -> ModuleEnv a -> ModuleEnv a
-
-filterModuleEnv	    = filterUFM
-elemModuleEnv       = elemUFM
-extendModuleEnv     = addToUFM
-extendModuleEnv_C   = addToUFM_C
-extendModuleEnvList = addListToUFM
-plusModuleEnv_C     = plusUFM_C
-delModuleEnvList    = delListFromUFM
-delModuleEnv        = delFromUFM
-plusModuleEnv       = plusUFM
-lookupModuleEnv     = lookupUFM
-lookupWithDefaultModuleEnv = lookupWithDefaultUFM
-mapModuleEnv        = mapUFM
-mkModuleEnv         = listToUFM
-emptyModuleEnv      = emptyUFM
-moduleEnvElts       = eltsUFM
-unitModuleEnv       = unitUFM
-isEmptyModuleEnv    = isNullUFM
-foldModuleEnv       = foldUFM
-\end{code}
-
-\begin{code}
-type ModuleSet = UniqSet Module
-mkModuleSet	:: [Module] -> ModuleSet
-extendModuleSet :: ModuleSet -> Module -> ModuleSet
-emptyModuleSet  :: ModuleSet
-moduleSetElts   :: ModuleSet -> [Module]
-elemModuleSet   :: Module -> ModuleSet -> Bool
-
-emptyModuleSet  = emptyUniqSet
-mkModuleSet     = mkUniqSet
-extendModuleSet = addOneToUniqSet
-moduleSetElts   = uniqSetToList
-elemModuleSet   = elementOfUniqSet
-\end{code}
diff --git a/ghc/compiler/basicTypes/Module.lhs-boot b/ghc/compiler/basicTypes/Module.lhs-boot
deleted file mode 100644
index d75c032d45..0000000000
--- a/ghc/compiler/basicTypes/Module.lhs-boot
+++ /dev/null
@@ -1,6 +0,0 @@
-\begin{code}
-module Module where
-
-data Module
-\end{code}
-
diff --git a/ghc/compiler/basicTypes/Name.hi-boot-5 b/ghc/compiler/basicTypes/Name.hi-boot-5
deleted file mode 100644
index 634d95433c..0000000000
--- a/ghc/compiler/basicTypes/Name.hi-boot-5
+++ /dev/null
@@ -1,3 +0,0 @@
-__interface Name 1 0 where
-__export Name Name;
-1 data Name ;
diff --git a/ghc/compiler/basicTypes/Name.hi-boot-6 b/ghc/compiler/basicTypes/Name.hi-boot-6
deleted file mode 100644
index c4eeca4d68..0000000000
--- a/ghc/compiler/basicTypes/Name.hi-boot-6
+++ /dev/null
@@ -1,3 +0,0 @@
-module Name where
-
-data Name
diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
deleted file mode 100644
index 1e1fb31f84..0000000000
--- a/ghc/compiler/basicTypes/Name.lhs
+++ /dev/null
@@ -1,384 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Name]{@Name@: to transmit name info from renamer to typechecker}
-
-\begin{code}
-module Name (
-	-- Re-export the OccName stuff
-	module OccName,
-
-	-- The Name type
-	Name,					-- Abstract
-	BuiltInSyntax(..), 
-	mkInternalName, mkSystemName,
-	mkSystemVarName, mkSysTvName, 
-	mkFCallName, mkIPName,
-	mkExternalName, mkWiredInName,
-
-	nameUnique, setNameUnique,
-	nameOccName, nameModule, nameModule_maybe,
-	tidyNameOcc, 
-	hashName, localiseName,
-
-	nameSrcLoc, nameParent, nameParent_maybe, isImplicitName, 
-
-	isSystemName, isInternalName, isExternalName,
-	isTyVarName, isWiredInName, isBuiltInSyntax,
-	wiredInNameTyThing_maybe, 
-	nameIsLocalOrFrom,
-	
-	-- Class NamedThing and overloaded friends
-	NamedThing(..),
-	getSrcLoc, getOccString
-    ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TypeRep( TyThing )
-
-import OccName		-- All of it
-import Module		( Module, moduleFS )
-import SrcLoc		( noSrcLoc, wiredInSrcLoc, SrcLoc )
-import Unique		( Unique, Uniquable(..), getKey, pprUnique )
-import Maybes		( orElse, isJust )
-import FastString	( FastString, zEncodeFS )
-import Outputable
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Name-datatype]{The @Name@ datatype, and name construction}
-%*									*
-%************************************************************************
- 
-\begin{code}
-data Name = Name {
-		n_sort :: NameSort,	-- What sort of name it is
-		n_occ  :: !OccName,	-- Its occurrence name
-		n_uniq :: Unique,
-		n_loc  :: !SrcLoc	-- Definition site
-	    }
-
--- NOTE: we make the n_loc field strict to eliminate some potential
--- (and real!) space leaks, due to the fact that we don't look at
--- the SrcLoc in a Name all that often.
-
-data NameSort
-  = External Module (Maybe Name)
-	-- (Just parent) => this Name is a subordinate name of 'parent'
-	-- e.g. data constructor of a data type, method of a class
-	-- Nothing => not a subordinate
- 
-  | WiredIn Module (Maybe Name) TyThing BuiltInSyntax
-	-- A variant of External, for wired-in things
-
-  | Internal		-- A user-defined Id or TyVar
-			-- defined in the module being compiled
-
-  | System		-- A system-defined Id or TyVar.  Typically the
-			-- OccName is very uninformative (like 's')
-
-data BuiltInSyntax = BuiltInSyntax | UserSyntax
--- BuiltInSyntax is for things like (:), [], tuples etc, 
--- which have special syntactic forms.  They aren't "in scope"
--- as such.
-\end{code}
-
-Notes about the NameSorts:
-
-1.  Initially, top-level Ids (including locally-defined ones) get External names, 
-    and all other local Ids get Internal names
-
-2.  Things with a External name are given C static labels, so they finally
-    appear in the .o file's symbol table.  They appear in the symbol table
-    in the form M.n.  If originally-local things have this property they
-    must be made @External@ first.
-
-3.  In the tidy-core phase, a External that is not visible to an importer
-    is changed to Internal, and a Internal that is visible is changed to External
-
-4.  A System Name differs in the following ways:
-	a) has unique attached when printing dumps
-	b) unifier eliminates sys tyvars in favour of user provs where possible
-
-    Before anything gets printed in interface files or output code, it's
-    fed through a 'tidy' processor, which zaps the OccNames to have
-    unique names; and converts all sys-locals to user locals
-    If any desugarer sys-locals have survived that far, they get changed to
-    "ds1", "ds2", etc.
-
-Built-in syntax => It's a syntactic form, not "in scope" (e.g. [])
-
-Wired-in thing  => The thing (Id, TyCon) is fully known to the compiler, 
-		   not read from an interface file. 
-		   E.g. Bool, True, Int, Float, and many others
-
-All built-in syntax is for wired-in things.
-
-\begin{code}
-nameUnique		:: Name -> Unique
-nameOccName		:: Name -> OccName 
-nameModule		:: Name -> Module
-nameSrcLoc		:: Name -> SrcLoc
-
-nameUnique  name = n_uniq name
-nameOccName name = n_occ  name
-nameSrcLoc  name = n_loc  name
-\end{code}
-
-\begin{code}
-nameIsLocalOrFrom :: Module -> Name -> Bool
-isInternalName	  :: Name -> Bool
-isExternalName	  :: Name -> Bool
-isSystemName	  :: Name -> Bool
-isWiredInName	  :: Name -> Bool
-
-isWiredInName (Name {n_sort = WiredIn _ _ _ _}) = True
-isWiredInName other			        = False
-
-wiredInNameTyThing_maybe :: Name -> Maybe TyThing
-wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ _ thing _}) = Just thing
-wiredInNameTyThing_maybe other				       = Nothing
-
-isBuiltInSyntax (Name {n_sort = WiredIn _ _ _ BuiltInSyntax}) = True
-isBuiltInSyntax other			 		      = False
-
-isExternalName (Name {n_sort = External _ _})    = True
-isExternalName (Name {n_sort = WiredIn _ _ _ _}) = True
-isExternalName other	                         = False
-
-isInternalName name = not (isExternalName name)
-
-nameParent_maybe :: Name -> Maybe Name
-nameParent_maybe (Name {n_sort = External _ p})    = p
-nameParent_maybe (Name {n_sort = WiredIn _ p _ _}) = p
-nameParent_maybe other	                           = Nothing
-
-nameParent :: Name -> Name
-nameParent name = case nameParent_maybe name of
-			Just parent -> parent
-			Nothing     -> name
-
-isImplicitName :: Name -> Bool
--- An Implicit Name is one has a parent; that is, one whose definition
--- derives from the parent thing
-isImplicitName name = isJust (nameParent_maybe name)
-
-nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
-nameModule_maybe (Name { n_sort = External mod _})    = Just mod
-nameModule_maybe (Name { n_sort = WiredIn mod _ _ _}) = Just mod
-nameModule_maybe name				      = Nothing
-
-nameIsLocalOrFrom from name
-  | isExternalName name = from == nameModule name
-  | otherwise		= True
-
-isTyVarName :: Name -> Bool
-isTyVarName name = isTvOcc (nameOccName name)
-
-isSystemName (Name {n_sort = System}) = True
-isSystemName other		      = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Making names}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkInternalName :: Unique -> OccName -> SrcLoc -> Name
-mkInternalName uniq occ loc = Name { n_uniq = uniq, n_sort = Internal, n_occ = occ, n_loc = loc }
-	-- NB: You might worry that after lots of huffing and
-	-- puffing we might end up with two local names with distinct
-	-- uniques, but the same OccName.  Indeed we can, but that's ok
-	--	* the insides of the compiler don't care: they use the Unique
-	--	* when printing for -ddump-xxx you can switch on -dppr-debug to get the
-	--	  uniques if you get confused
-	--	* for interface files we tidyCore first, which puts the uniques
-	--	  into the print name (see setNameVisibility below)
-
-mkExternalName :: Unique -> Module -> OccName -> Maybe Name -> SrcLoc -> Name
-mkExternalName uniq mod occ mb_parent loc 
-  = Name { n_uniq = uniq, n_sort = External mod mb_parent,
-           n_occ = occ, n_loc = loc }
-
-mkWiredInName :: Module -> OccName -> Unique 
-	      -> Maybe Name -> TyThing -> BuiltInSyntax -> Name
-mkWiredInName mod occ uniq mb_parent thing built_in
-  = Name { n_uniq = uniq,
-	   n_sort = WiredIn mod mb_parent thing built_in,
-	   n_occ = occ, n_loc = wiredInSrcLoc }
-
-mkSystemName :: Unique -> OccName -> Name
-mkSystemName uniq occ = Name { n_uniq = uniq, n_sort = System, 
-			       n_occ = occ, n_loc = noSrcLoc }
-
-mkSystemVarName :: Unique -> FastString -> Name
-mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs)
-
-mkSysTvName :: Unique -> FastString -> Name
-mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs) 
-
-mkFCallName :: Unique -> String -> Name
-	-- The encoded string completely describes the ccall
-mkFCallName uniq str =  Name { n_uniq = uniq, n_sort = Internal, 
-			       n_occ = mkVarOcc str, n_loc = noSrcLoc }
-
-mkIPName :: Unique -> OccName -> Name
-mkIPName uniq occ
-  = Name { n_uniq = uniq,
-	   n_sort = Internal,
-	   n_occ  = occ,
-	   n_loc = noSrcLoc }
-\end{code}
-
-\begin{code}
--- When we renumber/rename things, we need to be
--- able to change a Name's Unique to match the cached
--- one in the thing it's the name of.  If you know what I mean.
-setNameUnique name uniq = name {n_uniq = uniq}
-
-tidyNameOcc :: Name -> OccName -> Name
--- We set the OccName of a Name when tidying
--- In doing so, we change System --> Internal, so that when we print
--- it we don't get the unique by default.  It's tidy now!
-tidyNameOcc name@(Name { n_sort = System }) occ = name { n_occ = occ, n_sort = Internal}
-tidyNameOcc name 			    occ = name { n_occ = occ }
-
-localiseName :: Name -> Name
-localiseName n = n { n_sort = Internal }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Predicates and selectors}
-%*									*
-%************************************************************************
-
-\begin{code}
-hashName :: Name -> Int
-hashName name = getKey (nameUnique name)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Name-instances]{Instance declarations}
-%*									*
-%************************************************************************
-
-\begin{code}
-cmpName n1 n2 = n_uniq n1 `compare` n_uniq n2
-\end{code}
-
-\begin{code}
-instance Eq Name where
-    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
-    a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
-
-instance Ord Name where
-    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
-    a <	 b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
-    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
-    a >	 b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
-    compare a b = cmpName a b
-
-instance Uniquable Name where
-    getUnique = nameUnique
-
-instance NamedThing Name where
-    getName n = n
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Pretty printing}
-%*									*
-%************************************************************************
-
-\begin{code}
-instance Outputable Name where
-    ppr name = pprName name
-
-instance OutputableBndr Name where
-    pprBndr _ name = pprName name
-
-pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
-  = getPprStyle $ \ sty ->
-    case sort of
-      WiredIn mod _ _ builtin -> pprExternal sty uniq mod occ True  builtin
-      External mod _  	      -> pprExternal sty uniq mod occ False UserSyntax
-      System   		      -> pprSystem sty uniq occ
-      Internal    	      -> pprInternal sty uniq occ
-
-pprExternal sty uniq mod occ is_wired is_builtin
-  | codeStyle sty        = ppr_z_module mod <> char '_' <> ppr_z_occ_name occ
-	-- In code style, always qualify
-	-- ToDo: maybe we could print all wired-in things unqualified
-	-- 	 in code style, to reduce symbol table bloat?
-  | debugStyle sty       = ppr mod <> dot <> ppr_occ_name occ
-			   <> braces (hsep [if is_wired then ptext SLIT("(w)") else empty,
-					    pprNameSpaceBrief (occNameSpace occ), 
-		 			    pprUnique uniq])
-  | BuiltInSyntax <- is_builtin  = ppr_occ_name occ
-	-- never qualify builtin syntax
-  | unqualStyle sty mod occ = ppr_occ_name occ
-  | otherwise		    = ppr mod <> dot <> ppr_occ_name occ
-
-pprInternal sty uniq occ
-  | codeStyle sty  = pprUnique uniq
-  | debugStyle sty = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ), 
-				 		       pprUnique uniq])
-  | dumpStyle sty  = ppr_occ_name occ <> char '_' <> pprUnique uniq
-			-- For debug dumps, we're not necessarily dumping
-			-- tidied code, so we need to print the uniques.
-  | otherwise      = ppr_occ_name occ	-- User style
-
--- Like Internal, except that we only omit the unique in Iface style
-pprSystem sty uniq occ
-  | codeStyle sty  = pprUnique uniq
-  | debugStyle sty = ppr_occ_name occ <> char '_' <> pprUnique uniq
-		     <> braces (pprNameSpaceBrief (occNameSpace occ))
-  | otherwise	   = ppr_occ_name occ <> char '_' <> pprUnique uniq
-				-- If the tidy phase hasn't run, the OccName
-				-- is unlikely to be informative (like 's'),
-				-- so print the unique
-
-ppr_occ_name occ = ftext (occNameFS occ)
-	-- Don't use pprOccName; instead, just print the string of the OccName; 
-	-- we print the namespace in the debug stuff above
-
--- In code style, we Z-encode the strings.  The results of Z-encoding each FastString are
--- cached behind the scenes in the FastString implementation.
-ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ))
-ppr_z_module   mod = ftext (zEncodeFS (moduleFS mod))
-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Overloaded functions related to Names}
-%*									*
-%************************************************************************
-
-\begin{code}
-class NamedThing a where
-    getOccName :: a -> OccName
-    getName    :: a -> Name
-
-    getOccName n = nameOccName (getName n)	-- Default method
-\end{code}
-
-\begin{code}
-getSrcLoc	    :: NamedThing a => a -> SrcLoc
-getOccString	    :: NamedThing a => a -> String
-
-getSrcLoc	    = nameSrcLoc	   . getName
-getOccString 	    = occNameString	   . getOccName
-\end{code}
-
diff --git a/ghc/compiler/basicTypes/Name.lhs-boot b/ghc/compiler/basicTypes/Name.lhs-boot
deleted file mode 100644
index 167ce4242d..0000000000
--- a/ghc/compiler/basicTypes/Name.lhs-boot
+++ /dev/null
@@ -1,5 +0,0 @@
-\begin{code}
-module Name where
-
-data Name
-\end{code}
diff --git a/ghc/compiler/basicTypes/NameEnv.lhs b/ghc/compiler/basicTypes/NameEnv.lhs
deleted file mode 100644
index ff637010aa..0000000000
--- a/ghc/compiler/basicTypes/NameEnv.lhs
+++ /dev/null
@@ -1,72 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[NameEnv]{@NameEnv@: name environments}
-
-\begin{code}
-module NameEnv (
-	NameEnv, mkNameEnv,
-	emptyNameEnv, unitNameEnv, nameEnvElts, 
-	extendNameEnv_C, extendNameEnv_Acc, extendNameEnv, extendNameEnvList, 
-	foldNameEnv, filterNameEnv,
-	plusNameEnv, plusNameEnv_C, 
-	lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
-	elemNameEnv, mapNameEnv
-    ) where
-
-#include "HsVersions.h"
-
-import Name	( Name )
-import UniqFM
-import Maybes	( expectJust )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Name environment}
-%*									*
-%************************************************************************
-
-\begin{code}
-type NameEnv a = UniqFM a	-- Domain is Name
-
-emptyNameEnv   	   :: NameEnv a
-mkNameEnv	   :: [(Name,a)] -> NameEnv a
-nameEnvElts    	   :: NameEnv a -> [a]
-extendNameEnv_C    :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
-extendNameEnv_Acc  :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
-extendNameEnv  	   :: NameEnv a -> Name -> a -> NameEnv a
-plusNameEnv    	   :: NameEnv a -> NameEnv a -> NameEnv a
-plusNameEnv_C  	   :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
-extendNameEnvList  :: NameEnv a -> [(Name,a)] -> NameEnv a
-delFromNameEnv 	   :: NameEnv a -> Name -> NameEnv a
-delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
-elemNameEnv    	   :: Name -> NameEnv a -> Bool
-unitNameEnv    	   :: Name -> a -> NameEnv a
-lookupNameEnv  	   :: NameEnv a -> Name -> Maybe a
-lookupNameEnv_NF   :: NameEnv a -> Name -> a
-foldNameEnv	   :: (a -> b -> b) -> b -> NameEnv a -> b
-filterNameEnv	   :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
-mapNameEnv	   :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
-
-emptyNameEnv   	    = emptyUFM
-foldNameEnv	    = foldUFM
-mkNameEnv	    = listToUFM
-nameEnvElts    	    = eltsUFM
-extendNameEnv_C     = addToUFM_C
-extendNameEnv_Acc   = addToUFM_Acc
-extendNameEnv  	    = addToUFM
-plusNameEnv    	    = plusUFM
-plusNameEnv_C  	    = plusUFM_C
-extendNameEnvList   = addListToUFM
-delFromNameEnv 	    = delFromUFM
-delListFromNameEnv  = delListFromUFM
-elemNameEnv    	    = elemUFM
-unitNameEnv    	    = unitUFM
-filterNameEnv	    = filterUFM
-mapNameEnv	    = mapUFM
-
-lookupNameEnv  	       = lookupUFM
-lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupUFM env n)
-\end{code}
-
diff --git a/ghc/compiler/basicTypes/NameSet.lhs b/ghc/compiler/basicTypes/NameSet.lhs
deleted file mode 100644
index d0e55dec68..0000000000
--- a/ghc/compiler/basicTypes/NameSet.lhs
+++ /dev/null
@@ -1,190 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-\section[NameSet]{@NameSets@} 
-
-\begin{code}
-module NameSet (
-	-- Sets of Names
-	NameSet,
-	emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets,
-	minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet, 
-	delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
-	intersectsNameSet, intersectNameSet,
-	
-	-- Free variables
-	FreeVars, isEmptyFVs, emptyFVs, plusFVs, plusFV, 
-	mkFVs, addOneFV, unitFV, delFV, delFVs,
-
-	-- Defs and uses
-	Defs, Uses, DefUse, DefUses,
-	emptyDUs, usesOnly, mkDUs, plusDU, 
-	findUses, duDefs, duUses, allUses
-    ) where
-
-#include "HsVersions.h"
-
-import Name
-import UniqSet
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Sets of names}
-%*									*
-%************************************************************************
-
-\begin{code}
-type NameSet = UniqSet Name
-emptyNameSet	   :: NameSet
-unitNameSet	   :: Name -> NameSet
-addListToNameSet   :: NameSet -> [Name] -> NameSet
-addOneToNameSet    :: NameSet -> Name -> NameSet
-mkNameSet          :: [Name] -> NameSet
-unionNameSets	   :: NameSet -> NameSet -> NameSet
-unionManyNameSets  :: [NameSet] -> NameSet
-minusNameSet 	   :: NameSet -> NameSet -> NameSet
-elemNameSet	   :: Name -> NameSet -> Bool
-nameSetToList	   :: NameSet -> [Name]
-isEmptyNameSet	   :: NameSet -> Bool
-delFromNameSet	   :: NameSet -> Name -> NameSet
-delListFromNameSet :: NameSet -> [Name] -> NameSet
-foldNameSet	   :: (Name -> b -> b) -> b -> NameSet -> b
-filterNameSet	   :: (Name -> Bool) -> NameSet -> NameSet
-intersectNameSet   :: NameSet -> NameSet -> NameSet
-intersectsNameSet  :: NameSet -> NameSet -> Bool 	-- True if non-empty intersection
-	-- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty
-
-isEmptyNameSet    = isEmptyUniqSet
-emptyNameSet	  = emptyUniqSet
-unitNameSet	  = unitUniqSet
-mkNameSet         = mkUniqSet
-addListToNameSet  = addListToUniqSet
-addOneToNameSet	  = addOneToUniqSet
-unionNameSets     = unionUniqSets
-unionManyNameSets = unionManyUniqSets
-minusNameSet	  = minusUniqSet
-elemNameSet       = elementOfUniqSet
-nameSetToList     = uniqSetToList
-delFromNameSet    = delOneFromUniqSet
-foldNameSet	  = foldUniqSet
-filterNameSet	  = filterUniqSet
-intersectNameSet  = intersectUniqSets
-
-delListFromNameSet set ns = foldl delFromNameSet set ns
-
-intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Free variables}
-%*									*
-%************************************************************************
-
-These synonyms are useful when we are thinking of free variables
-
-\begin{code}
-type FreeVars	= NameSet
-
-plusFV   :: FreeVars -> FreeVars -> FreeVars
-addOneFV :: FreeVars -> Name -> FreeVars
-unitFV   :: Name -> FreeVars
-emptyFVs :: FreeVars
-plusFVs  :: [FreeVars] -> FreeVars
-mkFVs	 :: [Name] -> FreeVars
-delFV    :: Name -> FreeVars -> FreeVars
-delFVs   :: [Name] -> FreeVars -> FreeVars
-
-isEmptyFVs  = isEmptyNameSet
-emptyFVs    = emptyNameSet
-plusFVs     = unionManyNameSets
-plusFV      = unionNameSets
-mkFVs	    = mkNameSet
-addOneFV    = addOneToNameSet
-unitFV      = unitNameSet
-delFV n s   = delFromNameSet s n
-delFVs ns s = delListFromNameSet s ns
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Defs and uses
-%*									*
-%************************************************************************
-
-\begin{code}
-type Defs = NameSet
-type Uses = NameSet
-
-type DefUses = [DefUse]
-	-- In dependency order: earlier Defs scope over later Uses
-
-type DefUse  = (Maybe Defs, Uses)
-	-- For items (Just ds, us), the use of any member 
-	-- of the ds implies that all the us are used too
-	--
-	-- Also, us may mention ds
-	--
-	-- Nothing => Nothing defined in this group, but
-	-- 	      nevertheless all the uses are essential.
-	--	      Used for instance declarations, for example
-
-emptyDUs :: DefUses
-emptyDUs = []
-
-usesOnly :: Uses -> DefUses
-usesOnly uses = [(Nothing, uses)]
-
-mkDUs :: [(Defs,Uses)] -> DefUses
-mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]
-
-plusDU :: DefUses -> DefUses -> DefUses
-plusDU = (++)
-
-duDefs :: DefUses -> Defs
-duDefs dus = foldr get emptyNameSet dus
-  where
-    get (Nothing, u1) d2 = d2
-    get (Just d1, u1) d2 = d1 `unionNameSets` d2
-
-duUses :: DefUses -> Uses
--- Just like allUses, but defs are not eliminated
-duUses dus = foldr get emptyNameSet dus
-  where
-    get (d1, u1) u2 = u1 `unionNameSets` u2
-
-allUses :: DefUses -> Uses
--- Collect all uses, regardless of
--- whether the group is itself used,
--- but remove defs on the way
-allUses dus
-  = foldr get emptyNameSet dus
-  where
-    get (Nothing,   rhs_uses) uses = rhs_uses `unionNameSets` uses
-    get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSets` uses)
-				     `minusNameSet` defs
-
-findUses :: DefUses -> Uses -> Uses
--- Given some DefUses and some Uses, 
--- find all the uses, transitively. 
--- The result is a superset of the input uses;
--- and includes things defined in the input DefUses
--- (but only if they are used)
-findUses dus uses 
-  = foldr get uses dus
-  where
-    get (Nothing, rhs_uses) uses
-	= rhs_uses `unionNameSets` uses
-    get (Just defs, rhs_uses) uses
-	| defs `intersectsNameSet` uses 	-- Used
-	|| not (all (reportIfUnused . nameOccName) (nameSetToList defs))
-		-- At least one starts with an "_", 
-		-- so treat the group as used
-	= rhs_uses `unionNameSets` uses
-	| otherwise	-- No def is used
-	= uses
-\end{code}
\ No newline at end of file
diff --git a/ghc/compiler/basicTypes/NewDemand.lhs b/ghc/compiler/basicTypes/NewDemand.lhs
deleted file mode 100644
index 8e68fd87d2..0000000000
--- a/ghc/compiler/basicTypes/NewDemand.lhs
+++ /dev/null
@@ -1,318 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Demand]{@Demand@: the amount of demand on a value}
-
-\begin{code}
-module NewDemand(
-	Demand(..), 
-	topDmd, lazyDmd, seqDmd, evalDmd, errDmd, isStrictDmd, 
-	isTop, isAbsent, seqDemand,
-
-	DmdType(..), topDmdType, botDmdType, mkDmdType, mkTopDmdType, 
-		dmdTypeDepth, seqDmdType,
-	DmdEnv, emptyDmdEnv,
-	DmdResult(..), retCPR, isBotRes, returnsCPR, resTypeArgDmd,
-	
-	Demands(..), mapDmds, zipWithDmds, allTop, seqDemands,
-
-	StrictSig(..), mkStrictSig, topSig, botSig, cprSig,
-        isTopSig,
-	splitStrictSig,
-	pprIfaceStrictSig, appIsBottom, isBottomingSig, seqStrictSig,
-     ) where
-
-#include "HsVersions.h"
-
-import StaticFlags	( opt_CprOff )
-import BasicTypes	( Arity )
-import VarEnv		( VarEnv, emptyVarEnv, isEmptyVarEnv )
-import UniqFM		( ufmToList )
-import Util             ( listLengthCmp, zipWithEqual )
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Demands}
-%*									*
-%************************************************************************
-
-\begin{code}
-data Demand
-  = Top			-- T; used for unlifted types too, so that
-			--	A `lub` T = T
-  | Abs			-- A
-
-  | Call Demand		-- C(d)
-
-  | Eval Demands	-- U(ds)
-
-  | Defer Demands	-- D(ds)
-
-  | Box Demand		-- B(d)
-
-  | Bot			-- B
-  deriving( Eq )
-	-- Equality needed for fixpoints in DmdAnal
-
-data Demands = Poly Demand	-- Polymorphic case
-	     | Prod [Demand]	-- Product case
-	     deriving( Eq )
-
-allTop (Poly d)  = isTop d
-allTop (Prod ds) = all isTop ds
-
-isTop Top = True
-isTop d   = False 
-
-isAbsent Abs = True
-isAbsent d   = False 
-
-mapDmds :: (Demand -> Demand) -> Demands -> Demands
-mapDmds f (Poly d)  = Poly (f d)
-mapDmds f (Prod ds) = Prod (map f ds)
-
-zipWithDmds :: (Demand -> Demand -> Demand)
-	    -> Demands -> Demands -> Demands
-zipWithDmds f (Poly d1)  (Poly d2)  = Poly (d1 `f` d2)
-zipWithDmds f (Prod ds1) (Poly d2)  = Prod [d1 `f` d2 | d1 <- ds1]
-zipWithDmds f (Poly d1)  (Prod ds2) = Prod [d1 `f` d2 | d2 <- ds2]
-zipWithDmds f (Prod ds1) (Prod ds2) = Prod (zipWithEqual "zipWithDmds" f ds1 ds2)
-
-topDmd, lazyDmd, seqDmd :: Demand
-topDmd  = Top			-- The most uninformative demand
-lazyDmd = Box Abs
-seqDmd  = Eval (Poly Abs)	-- Polymorphic seq demand
-evalDmd = Box seqDmd		-- Evaluate and return
-errDmd  = Box Bot		-- This used to be called X
-
-isStrictDmd :: Demand -> Bool
-isStrictDmd Bot      = True
-isStrictDmd (Eval _) = True
-isStrictDmd (Call _) = True
-isStrictDmd (Box d)  = isStrictDmd d
-isStrictDmd other    = False
-
-seqDemand :: Demand -> ()
-seqDemand (Call d)   = seqDemand d
-seqDemand (Eval ds)  = seqDemands ds
-seqDemand (Defer ds) = seqDemands ds
-seqDemand (Box d)    = seqDemand d
-seqDemand _          = ()
-
-seqDemands :: Demands -> ()
-seqDemands (Poly d)  = seqDemand d
-seqDemands (Prod ds) = seqDemandList ds
-
-seqDemandList :: [Demand] -> ()
-seqDemandList [] = ()
-seqDemandList (d:ds) = seqDemand d `seq` seqDemandList ds
-
-instance Outputable Demand where
-    ppr Top  = char 'T'
-    ppr Abs  = char 'A'
-    ppr Bot  = char 'B'
-
-    ppr (Defer ds)      = char 'D' <> ppr ds
-    ppr (Eval ds)       = char 'U' <> ppr ds
-				      
-    ppr (Box (Eval ds)) = char 'S' <> ppr ds
-    ppr (Box Abs)	= char 'L'
-    ppr (Box Bot)	= char 'X'
-
-    ppr (Call d)	= char 'C' <> parens (ppr d)
-
-
-instance Outputable Demands where
-    ppr (Poly Abs) = empty
-    ppr (Poly d)   = parens (ppr d <> char '*')
-    ppr (Prod ds)  = parens (hcat (map ppr ds))
-	-- At one time I printed U(AAA) as U, but that
-	-- confuses (Poly Abs) with (Prod AAA), and the
-	-- worker/wrapper generation differs slightly for these two
-	-- [Reason: in the latter case we can avoid passing the arg;
-	--  see notes with WwLib.mkWWstr_one.]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Demand types}
-%*									*
-%************************************************************************
-
-\begin{code}
-data DmdType = DmdType 
-		    DmdEnv	-- Demand on explicitly-mentioned 
-				--	free variables
-		    [Demand]	-- Demand on arguments
-		    DmdResult	-- Nature of result
-
-	-- 		IMPORTANT INVARIANT
-	-- The default demand on free variables not in the DmdEnv is:
-	-- DmdResult = BotRes        <=>  Bot
-	-- DmdResult = TopRes/ResCPR <=>  Abs
-
-	-- 		ANOTHER IMPORTANT INVARIANT
-	-- The Demands in the argument list are never
-	--	Bot, Defer d
-	-- Handwavey reason: these don't correspond to calling conventions
-	-- See DmdAnal.funArgDemand for details
-
-
--- This guy lets us switch off CPR analysis
--- by making sure that everything uses TopRes instead of RetCPR
--- Assuming, of course, that they don't mention RetCPR by name.
--- They should onlyu use retCPR
-retCPR | opt_CprOff = TopRes
-       | otherwise  = RetCPR
-
-seqDmdType (DmdType env ds res) = 
-  {- ??? env `seq` -} seqDemandList ds `seq` res `seq` ()
-
-type DmdEnv = VarEnv Demand
-
-data DmdResult = TopRes	-- Nothing known	
-	       | RetCPR	-- Returns a constructed product
-	       | BotRes	-- Diverges or errors
-	       deriving( Eq, Show )
-	-- Equality for fixpoints
-	-- Show needed for Show in Lex.Token (sigh)
-
--- Equality needed for fixpoints in DmdAnal
-instance Eq DmdType where
-  (==) (DmdType fv1 ds1 res1)
-       (DmdType fv2 ds2 res2) =  ufmToList fv1 == ufmToList fv2
-			      && ds1 == ds2 && res1 == res2
-
-instance Outputable DmdType where
-  ppr (DmdType fv ds res) 
-    = hsep [text "DmdType",
-	    hcat (map ppr ds) <> ppr res,
-	    if null fv_elts then empty
-	    else braces (fsep (map pp_elt fv_elts))]
-    where
-      pp_elt (uniq, dmd) = ppr uniq <> text "->" <> ppr dmd
-      fv_elts = ufmToList fv
-
-instance Outputable DmdResult where
-  ppr TopRes = empty	  -- Keep these distinct from Demand letters
-  ppr RetCPR = char 'm'	  -- so that we can print strictness sigs as
-  ppr BotRes = char 'b'   --    dddr
-			  -- without ambiguity
-
-emptyDmdEnv = emptyVarEnv
-
-topDmdType = DmdType emptyDmdEnv [] TopRes
-botDmdType = DmdType emptyDmdEnv [] BotRes
-cprDmdType = DmdType emptyVarEnv [] retCPR
-
-isTopDmdType :: DmdType -> Bool
--- Only used on top-level types, hence the assert
-isTopDmdType (DmdType env [] TopRes) = ASSERT( isEmptyVarEnv env) True	
-isTopDmdType other		     = False
-
-isBotRes :: DmdResult -> Bool
-isBotRes BotRes = True
-isBotRes other  = False
-
-resTypeArgDmd :: DmdResult -> Demand
--- TopRes and BotRes are polymorphic, so that
---	BotRes = Bot -> BotRes
---	TopRes = Top -> TopRes
--- This function makes that concrete
--- We can get a RetCPR, because of the way in which we are (now)
--- giving CPR info to strict arguments.  On the first pass, when
--- nothing has demand info, we optimistically give CPR info or RetCPR to all args
-resTypeArgDmd TopRes = Top
-resTypeArgDmd RetCPR = Top
-resTypeArgDmd BotRes = Bot
-
-returnsCPR :: DmdResult -> Bool
-returnsCPR RetCPR = True
-returnsCPR other  = False
-
-mkDmdType :: DmdEnv -> [Demand] -> DmdResult -> DmdType
-mkDmdType fv ds res = DmdType fv ds res
-
-mkTopDmdType :: [Demand] -> DmdResult -> DmdType
-mkTopDmdType ds res = DmdType emptyDmdEnv ds res
-
-dmdTypeDepth :: DmdType -> Arity
-dmdTypeDepth (DmdType _ ds _) = length ds
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Strictness signature
-%*									*
-%************************************************************************
-
-In a let-bound Id we record its strictness info.  
-In principle, this strictness info is a demand transformer, mapping
-a demand on the Id into a DmdType, which gives
-	a) the free vars of the Id's value
-	b) the Id's arguments
-	c) an indication of the result of applying 
-	   the Id to its arguments
-
-However, in fact we store in the Id an extremely emascuated demand transfomer,
-namely 
-		a single DmdType
-(Nevertheless we dignify StrictSig as a distinct type.)
-
-This DmdType gives the demands unleashed by the Id when it is applied
-to as many arguments as are given in by the arg demands in the DmdType.
-
-For example, the demand transformer described by the DmdType
-		DmdType {x -> U(LL)} [V,A] Top
-says that when the function is applied to two arguments, it
-unleashes demand U(LL) on the free var x, V on the first arg,
-and A on the second.  
-
-If this same function is applied to one arg, all we can say is
-that it uses x with U*(LL), and its arg with demand L.
-
-\begin{code}
-newtype StrictSig = StrictSig DmdType
-		  deriving( Eq )
-
-instance Outputable StrictSig where
-   ppr (StrictSig ty) = ppr ty
-
-instance Show StrictSig where
-   show (StrictSig ty) = showSDoc (ppr ty)
-
-mkStrictSig :: DmdType -> StrictSig
-mkStrictSig dmd_ty = StrictSig dmd_ty
-
-splitStrictSig :: StrictSig -> ([Demand], DmdResult)
-splitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res)
-
-isTopSig (StrictSig ty) = isTopDmdType ty
-
-topSig, botSig, cprSig :: StrictSig
-topSig = StrictSig topDmdType
-botSig = StrictSig botDmdType
-cprSig = StrictSig cprDmdType
-	
-
--- appIsBottom returns true if an application to n args would diverge
-appIsBottom (StrictSig (DmdType _ ds BotRes)) n = listLengthCmp ds n /= GT
-appIsBottom _				      _ = False
-
-isBottomingSig (StrictSig (DmdType _ _ BotRes)) = True
-isBottomingSig _				= False
-
-seqStrictSig (StrictSig ty) = seqDmdType ty
-
-pprIfaceStrictSig :: StrictSig -> SDoc
--- Used for printing top-level strictness pragmas in interface files
-pprIfaceStrictSig (StrictSig (DmdType _ dmds res))
-  = hcat (map ppr dmds) <> ppr res
-\end{code}
-    
-
diff --git a/ghc/compiler/basicTypes/OccName.hi-boot-6 b/ghc/compiler/basicTypes/OccName.hi-boot-6
deleted file mode 100644
index 705f9b1bd0..0000000000
--- a/ghc/compiler/basicTypes/OccName.hi-boot-6
+++ /dev/null
@@ -1,4 +0,0 @@
-module OccName where
-
-data OccName
-
diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
deleted file mode 100644
index a3661a9ab0..0000000000
--- a/ghc/compiler/basicTypes/OccName.lhs
+++ /dev/null
@@ -1,676 +0,0 @@
-{-% DrIFT (Automatic class derivations for Haskell) v1.1 %-}
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-
-\section[OccName]{@OccName@}
-
-\begin{code}
-module OccName (
-	-- * The NameSpace type; abstact
-	NameSpace, tcName, clsName, tcClsName, dataName, varName, 
-	tvName, srcDataName,
-
-	-- ** Printing
-	pprNameSpace, pprNonVarNameSpace, pprNameSpaceBrief,
-
-	-- * The OccName type
-	OccName, 	-- Abstract, instance of Outputable
-	pprOccName, 
-
-	-- ** Construction	
-	mkOccName, mkOccNameFS, 
-	mkVarOcc, mkVarOccFS,
-	mkTyVarOcc,
-	mkDFunOcc,
-	mkTupleOcc, 
-	setOccNameSpace,
-
-	-- ** Derived OccNames
-	mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
-  	mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, 
- 	mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
-	mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc,
-	mkSuperDictSelOcc, mkLocalOcc, mkMethodOcc,
-
-	-- ** Deconstruction
-	occNameFS, occNameString, occNameSpace, 
-
-	isVarOcc, isTvOcc, isTcOcc, isDataOcc, isDataSymOcc, isSymOcc, isValOcc,
-	parenSymOcc, reportIfUnused, isTcClsName, isVarName,
-
-	isTupleOcc_maybe,
-
-	-- The OccEnv type
-	OccEnv, emptyOccEnv, unitOccEnv, extendOccEnv, mapOccEnv,
-	lookupOccEnv, mkOccEnv, extendOccEnvList, elemOccEnv,
-	occEnvElts, foldOccEnv, plusOccEnv, plusOccEnv_C, extendOccEnv_C,
-
-	-- The OccSet type
-	OccSet, emptyOccSet, unitOccSet, mkOccSet, extendOccSet, 
-	extendOccSetList,
-	unionOccSets, unionManyOccSets, minusOccSet, elemOccSet, occSetElts, 
-	foldOccSet, isEmptyOccSet, intersectOccSet, intersectsOccSet,
-
-	-- Tidying up
-	TidyOccEnv, emptyTidyOccEnv, tidyOccName, initTidyOccEnv,
-
-	-- The basic form of names
-	isLexCon, isLexVar, isLexId, isLexSym,
-	isLexConId, isLexConSym, isLexVarId, isLexVarSym,
-	startsVarSym, startsVarId, startsConSym, startsConId
-    ) where
-
-#include "HsVersions.h"
-
-import Util		( thenCmp )
-import Unique		( Unique, mkUnique, Uniquable(..) )
-import BasicTypes 	( Boxity(..), Arity )
-import StaticFlags 	( opt_PprStyle_Debug )
-import UniqFM
-import UniqSet
-import FastString
-import Outputable
-import Binary
-
-import GLAEXTS
-
-import Data.Char	( isUpper, isLower, ord )
-
--- Unicode TODO: put isSymbol in libcompat
-#if __GLASGOW_HASKELL__ > 604
-import Data.Char	( isSymbol )
-#else
-isSymbol = const False
-#endif
-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Name space}
-%*									*
-%************************************************************************
-
-\begin{code}
-data NameSpace = VarName	-- Variables, including "source" data constructors
-	       | DataName	-- "Real" data constructors 
-	       | TvName		-- Type variables
-	       | TcClsName	-- Type constructors and classes; Haskell has them
-				-- in the same name space for now.
-	       deriving( Eq, Ord )
-   {-! derive: Binary !-}
-
--- Note [Data Constructors]  
--- see also: Note [Data Constructor Naming] in DataCon.lhs
--- 
---	"Source" data constructors are the data constructors mentioned
---	in Haskell source code
---
---	"Real" data constructors are the data constructors of the
---	representation type, which may not be the same as the source
---	type
-
--- Example:
---	data T = T !(Int,Int)
---
--- The source datacon has type (Int,Int) -> T
--- The real   datacon has type Int -> Int -> T
--- GHC chooses a representation based on the strictness etc.
-
-
--- Though type constructors and classes are in the same name space now,
--- the NameSpace type is abstract, so we can easily separate them later
-tcName    = TcClsName		-- Type constructors
-clsName   = TcClsName		-- Classes
-tcClsName = TcClsName		-- Not sure which!
-
-dataName    = DataName
-srcDataName = DataName	-- Haskell-source data constructors should be
-			-- in the Data name space
-
-tvName      = TvName
-varName     = VarName
-
-isTcClsName :: NameSpace -> Bool
-isTcClsName TcClsName = True
-isTcClsName _	      = False
-
-isVarName :: NameSpace -> Bool	-- Variables or type variables, but not constructors
-isVarName TvName  = True
-isVarName VarName = True
-isVarName other   = False
-
-pprNameSpace :: NameSpace -> SDoc
-pprNameSpace DataName  = ptext SLIT("data constructor")
-pprNameSpace VarName   = ptext SLIT("variable")
-pprNameSpace TvName    = ptext SLIT("type variable")
-pprNameSpace TcClsName = ptext SLIT("type constructor or class")
-
-pprNonVarNameSpace :: NameSpace -> SDoc
-pprNonVarNameSpace VarName = empty
-pprNonVarNameSpace ns = pprNameSpace ns
-
-pprNameSpaceBrief DataName  = char 'd'
-pprNameSpaceBrief VarName   = char 'v'
-pprNameSpaceBrief TvName    = ptext SLIT("tv")
-pprNameSpaceBrief TcClsName = ptext SLIT("tc")
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
-%*									*
-%************************************************************************
-
-\begin{code}
-data OccName = OccName 
-    { occNameSpace  :: !NameSpace
-    , occNameFS     :: !FastString
-    }
-\end{code}
-
-
-\begin{code}
-instance Eq OccName where
-    (OccName sp1 s1) == (OccName sp2 s2) = s1 == s2 && sp1 == sp2
-
-instance Ord OccName where
-    compare (OccName sp1 s1) (OccName sp2 s2) = (s1  `compare` s2) `thenCmp`
-						(sp1 `compare` sp2)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Printing}
-%*									*
-%************************************************************************
- 
-\begin{code}
-instance Outputable OccName where
-    ppr = pprOccName
-
-pprOccName :: OccName -> SDoc
-pprOccName (OccName sp occ) 
-  = getPprStyle $ \ sty ->
-    if codeStyle sty 
-	then ftext (zEncodeFS occ)
-	else ftext occ <> if debugStyle sty 
-			    then braces (pprNameSpaceBrief sp)
-			    else empty
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Construction}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkOccName :: NameSpace -> String -> OccName
-mkOccName occ_sp str = OccName occ_sp (mkFastString str)
-
-mkOccNameFS :: NameSpace -> FastString -> OccName
-mkOccNameFS occ_sp fs = OccName occ_sp fs
-
-mkVarOcc :: String -> OccName
-mkVarOcc s = mkOccName varName s
-
-mkVarOccFS :: FastString -> OccName
-mkVarOccFS fs = mkOccNameFS varName fs
-
-mkTyVarOcc :: FastString -> OccName
-mkTyVarOcc fs = mkOccNameFS tvName fs
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Environments
-%*									*
-%************************************************************************
-
-OccEnvs are used mainly for the envts in ModIfaces.
-
-They are efficient, because FastStrings have unique Int# keys.  We assume
-this key is less than 2^24, so we can make a Unique using
-	mkUnique ns key  :: Unique
-where 'ns' is a Char reprsenting the name space.  This in turn makes it
-easy to build an OccEnv.
-
-\begin{code}
-instance Uniquable OccName where
-  getUnique (OccName ns fs)
-      = mkUnique char (I# (uniqueOfFS fs))
-      where	-- See notes above about this getUnique function
-        char = case ns of
-		VarName   -> 'i'
-		DataName  -> 'd'
-		TvName    -> 'v'
-		TcClsName -> 't'
-
-type OccEnv a = UniqFM a
-
-emptyOccEnv :: OccEnv a
-unitOccEnv  :: OccName -> a -> OccEnv a
-extendOccEnv :: OccEnv a -> OccName -> a -> OccEnv a
-extendOccEnvList :: OccEnv a -> [(OccName, a)] -> OccEnv a
-lookupOccEnv :: OccEnv a -> OccName -> Maybe a
-mkOccEnv     :: [(OccName,a)] -> OccEnv a
-elemOccEnv   :: OccName -> OccEnv a -> Bool
-foldOccEnv   :: (a -> b -> b) -> b -> OccEnv a -> b
-occEnvElts   :: OccEnv a -> [a]
-extendOccEnv_C :: (a->a->a) -> OccEnv a -> OccName -> a -> OccEnv a
-plusOccEnv     :: OccEnv a -> OccEnv a -> OccEnv a
-plusOccEnv_C   :: (a->a->a) -> OccEnv a -> OccEnv a -> OccEnv a
-mapOccEnv      :: (a->b) -> OccEnv a -> OccEnv b
-
-emptyOccEnv  	 = emptyUFM
-unitOccEnv   	 = unitUFM
-extendOccEnv 	 = addToUFM
-extendOccEnvList = addListToUFM
-lookupOccEnv 	 = lookupUFM
-mkOccEnv         = listToUFM
-elemOccEnv	 = elemUFM
-foldOccEnv	 = foldUFM
-occEnvElts 	 = eltsUFM
-plusOccEnv	 = plusUFM
-plusOccEnv_C	 = plusUFM_C
-extendOccEnv_C   = addToUFM_C
-mapOccEnv	 = mapUFM
-
-type OccSet = UniqFM OccName
-
-emptyOccSet	  :: OccSet
-unitOccSet	  :: OccName -> OccSet
-mkOccSet          :: [OccName] -> OccSet
-extendOccSet      :: OccSet -> OccName -> OccSet
-extendOccSetList  :: OccSet -> [OccName] -> OccSet
-unionOccSets	  :: OccSet -> OccSet -> OccSet
-unionManyOccSets  :: [OccSet] -> OccSet
-minusOccSet 	  :: OccSet -> OccSet -> OccSet
-elemOccSet	  :: OccName -> OccSet -> Bool
-occSetElts	  :: OccSet -> [OccName]
-foldOccSet	  :: (OccName -> b -> b) -> b -> OccSet -> b
-isEmptyOccSet	  :: OccSet -> Bool
-intersectOccSet   :: OccSet -> OccSet -> OccSet
-intersectsOccSet  :: OccSet -> OccSet -> Bool
-
-emptyOccSet	  = emptyUniqSet
-unitOccSet	  = unitUniqSet
-mkOccSet          = mkUniqSet
-extendOccSet	  = addOneToUniqSet
-extendOccSetList  = addListToUniqSet
-unionOccSets      = unionUniqSets
-unionManyOccSets  = unionManyUniqSets
-minusOccSet	  = minusUniqSet
-elemOccSet        = elementOfUniqSet
-occSetElts        = uniqSetToList
-foldOccSet	  = foldUniqSet
-isEmptyOccSet     = isEmptyUniqSet
-intersectOccSet   = intersectUniqSets
-intersectsOccSet s1 s2 = not (isEmptyOccSet (s1 `intersectOccSet` s2))
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Predicates and taking them apart}
-%*									*
-%************************************************************************
-
-\begin{code}
-occNameString :: OccName -> String
-occNameString (OccName _ s) = unpackFS s
-
-setOccNameSpace :: NameSpace -> OccName -> OccName
-setOccNameSpace sp (OccName _ occ) = OccName sp occ
-
-isVarOcc, isTvOcc, isDataSymOcc, isSymOcc, isTcOcc :: OccName -> Bool
-
-isVarOcc (OccName VarName _) = True
-isVarOcc other               = False
-
-isTvOcc (OccName TvName _) = True
-isTvOcc other              = False
-
-isTcOcc (OccName TcClsName _) = True
-isTcOcc other                 = False
-
-isValOcc (OccName VarName  _) = True
-isValOcc (OccName DataName _) = True
-isValOcc other		      = False
-
--- Data constructor operator (starts with ':', or '[]')
--- Pretty inefficient!
-isDataSymOcc (OccName DataName s) = isLexConSym s
-isDataSymOcc (OccName VarName s)  
-  | isLexConSym s = pprPanic "isDataSymOcc: check me" (ppr s)
-		-- Jan06: I don't think this should happen
-isDataSymOcc other		  = False
-
-isDataOcc (OccName DataName _) = True
-isDataOcc (OccName VarName s)  
-  | isLexCon s = pprPanic "isDataOcc: check me" (ppr s)
-		-- Jan06: I don't think this should happen
-isDataOcc other		       = False
-
--- Any operator (data constructor or variable)
--- Pretty inefficient!
-isSymOcc (OccName DataName s)  = isLexConSym s
-isSymOcc (OccName TcClsName s) = isLexConSym s
-isSymOcc (OccName VarName s)   = isLexSym s
-isSymOcc other		       = False
-
-parenSymOcc :: OccName -> SDoc -> SDoc
--- Wrap parens around an operator
-parenSymOcc occ doc | isSymOcc occ = parens doc
-		    | otherwise    = doc
-\end{code}
-
-
-\begin{code}
-reportIfUnused :: OccName -> Bool
-  -- Haskell 98 encourages compilers to suppress warnings about
-  -- unused names in a pattern if they start with "_".
-reportIfUnused occ = case occNameString occ of
-			('_' : _) -> False
-			_other    -> True
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Making system names}
-%*									*
-%************************************************************************
-
-Here's our convention for splitting up the interface file name space:
-
-	d...		dictionary identifiers
-			(local variables, so no name-clash worries)
-
-	$f...		dict-fun identifiers (from inst decls)
-	$dm...		default methods
-	$p...		superclass selectors
-	$w...		workers
-	:T...		compiler-generated tycons for dictionaries
-	:D...		...ditto data cons
-	$sf..		specialised version of f
-
-	in encoded form these appear as Zdfxxx etc
-
-	:...		keywords (export:, letrec: etc.)
---- I THINK THIS IS WRONG!
-
-This knowledge is encoded in the following functions.
-
-
-@mk_deriv@ generates an @OccName@ from the prefix and a string.
-NB: The string must already be encoded!
-
-\begin{code}
-mk_deriv :: NameSpace 
-	 -> String		-- Distinguishes one sort of derived name from another
-	 -> String
-	 -> OccName
-
-mk_deriv occ_sp sys_prefix str = mkOccName occ_sp (sys_prefix ++ str)
-\end{code}
-
-\begin{code}
-mkDataConWrapperOcc, mkWorkerOcc, mkDefaultMethodOcc, mkDerivedTyConOcc,
-  	mkClassTyConOcc, mkClassDataConOcc, mkDictOcc, mkIPOcc, 
- 	mkSpecOcc, mkForeignExportOcc, mkGenOcc1, mkGenOcc2,
-	mkDataTOcc, mkDataCOcc, mkDataConWorkerOcc
-   :: OccName -> OccName
-
--- These derived variables have a prefix that no Haskell value could have
-mkDataConWrapperOcc = mk_simple_deriv varName  "$W"
-mkWorkerOcc         = mk_simple_deriv varName  "$w"
-mkDefaultMethodOcc  = mk_simple_deriv varName  "$dm"
-mkDerivedTyConOcc   = mk_simple_deriv tcName   ":"	-- The : prefix makes sure it classifies
-mkClassTyConOcc     = mk_simple_deriv tcName   ":T"	-- as a tycon/datacon
-mkClassDataConOcc   = mk_simple_deriv dataName ":D"	-- We go straight to the "real" data con
-							-- for datacons from classes
-mkDictOcc	    = mk_simple_deriv varName  "$d"
-mkIPOcc		    = mk_simple_deriv varName  "$i"
-mkSpecOcc	    = mk_simple_deriv varName  "$s"
-mkForeignExportOcc  = mk_simple_deriv varName  "$f"
-
--- Generic derivable classes
-mkGenOcc1           = mk_simple_deriv varName  "$gfrom"
-mkGenOcc2           = mk_simple_deriv varName  "$gto" 
-
--- data T = MkT ... deriving( Data ) needs defintions for 
---	$tT   :: Data.Generics.Basics.DataType
---	$cMkT :: Data.Generics.Basics.Constr
-mkDataTOcc = mk_simple_deriv varName  "$t"
-mkDataCOcc = mk_simple_deriv varName  "$c"
-
-mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
-
--- Data constructor workers are made by setting the name space
--- of the data constructor OccName (which should be a DataName)
--- to VarName
-mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ 
-\end{code}
-
-\begin{code}
-mkSuperDictSelOcc :: Int 	-- Index of superclass, eg 3
-		  -> OccName 	-- Class, eg "Ord"
-		  -> OccName	-- eg "$p3Ord"
-mkSuperDictSelOcc index cls_occ
-  = mk_deriv varName "$p" (show index ++ occNameString cls_occ)
-
-mkLocalOcc :: Unique 		-- Unique
-	   -> OccName		-- Local name (e.g. "sat")
-	   -> OccName		-- Nice unique version ("$L23sat")
-mkLocalOcc uniq occ
-   = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
-	-- The Unique might print with characters 
-	-- that need encoding (e.g. 'z'!)
-\end{code}
-
-
-\begin{code}
-mkDFunOcc :: String		-- Typically the class and type glommed together e.g. "OrdMaybe"
-				-- Only used in debug mode, for extra clarity
-	  -> Bool		-- True <=> hs-boot instance dfun
-	  -> Int		-- Unique index
-	  -> OccName		-- "$f3OrdMaybe"
-
--- In hs-boot files we make dict funs like $fx7ClsTy, which get bound to the real
--- thing when we compile the mother module. Reason: we don't know exactly
--- what the  mother module will call it.
-
-mkDFunOcc info_str is_boot index 
-  = mk_deriv VarName prefix string
-  where
-    prefix | is_boot   = "$fx"
-	   | otherwise = "$f"
-    string | opt_PprStyle_Debug = show index ++ info_str
-	   | otherwise		= show index
-\end{code}
-
-We used to add a '$m' to indicate a method, but that gives rise to bad
-error messages from the type checker when we print the function name or pattern
-of an instance-decl binding.  Why? Because the binding is zapped
-to use the method name in place of the selector name.
-(See TcClassDcl.tcMethodBind)
-
-The way it is now, -ddump-xx output may look confusing, but
-you can always say -dppr-debug to get the uniques.
-
-However, we *do* have to zap the first character to be lower case,
-because overloaded constructors (blarg) generate methods too.
-And convert to VarName space
-
-e.g. a call to constructor MkFoo where
-	data (Ord a) => Foo a = MkFoo a
-
-If this is necessary, we do it by prefixing '$m'.  These 
-guys never show up in error messages.  What a hack.
-
-\begin{code}
-mkMethodOcc :: OccName -> OccName
-mkMethodOcc occ@(OccName VarName fs) = occ
-mkMethodOcc occ			     = mk_simple_deriv varName "$m" occ
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Tidying them up}
-%*									*
-%************************************************************************
-
-Before we print chunks of code we like to rename it so that
-we don't have to print lots of silly uniques in it.  But we mustn't
-accidentally introduce name clashes!  So the idea is that we leave the
-OccName alone unless it accidentally clashes with one that is already
-in scope; if so, we tack on '1' at the end and try again, then '2', and
-so on till we find a unique one.
-
-There's a wrinkle for operators.  Consider '>>='.  We can't use '>>=1' 
-because that isn't a single lexeme.  So we encode it to 'lle' and *then*
-tack on the '1', if necessary.
-
-\begin{code}
-type TidyOccEnv = OccEnv Int	-- The in-scope OccNames
-	-- Range gives a plausible starting point for new guesses
-
-emptyTidyOccEnv = emptyOccEnv
-
-initTidyOccEnv :: [OccName] -> TidyOccEnv	-- Initialise with names to avoid!
-initTidyOccEnv = foldl (\env occ -> extendOccEnv env occ 1) emptyTidyOccEnv
-
-tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
-
-tidyOccName in_scope occ@(OccName occ_sp fs)
-  = case lookupOccEnv in_scope occ of
-	Nothing -> 	-- Not already used: make it used
-		   (extendOccEnv in_scope occ 1, occ)
-
-	Just n  -> 	-- Already used: make a new guess, 
-			-- change the guess base, and try again
-		   tidyOccName  (extendOccEnv in_scope occ (n+1))
-				(mkOccName occ_sp (unpackFS fs ++ show n))
-\end{code}
-
-%************************************************************************
-%*									*
-		Stuff for dealing with tuples
-%*									*
-%************************************************************************
-
-\begin{code}
-mkTupleOcc :: NameSpace -> Boxity -> Arity -> OccName
-mkTupleOcc ns bx ar = OccName ns (mkFastString str)
-  where
- 	-- no need to cache these, the caching is done in the caller
-	-- (TysWiredIn.mk_tuple)
-    str = case bx of
-		Boxed   -> '(' : commas ++ ")"
-		Unboxed -> '(' : '#' : commas ++ "#)"
-
-    commas = take (ar-1) (repeat ',')
-
-isTupleOcc_maybe :: OccName -> Maybe (NameSpace, Boxity, Arity)
--- Tuples are special, because there are so many of them!
-isTupleOcc_maybe (OccName ns fs)
-  = case unpackFS fs of
-	'(':'#':',':rest -> Just (ns, Unboxed, 2 + count_commas rest)
-	'(':',':rest     -> Just (ns, Boxed,   2 + count_commas rest)
-	_other           -> Nothing
-  where
-    count_commas (',':rest) = 1 + count_commas rest
-    count_commas _          = 0
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Lexical categories}
-%*									*
-%************************************************************************
-
-These functions test strings to see if they fit the lexical categories
-defined in the Haskell report.
-
-\begin{code}
-isLexCon,   isLexVar,    isLexId,    isLexSym    :: FastString -> Bool
-isLexConId, isLexConSym, isLexVarId, isLexVarSym :: FastString -> Bool
-
-isLexCon cs = isLexConId  cs || isLexConSym cs
-isLexVar cs = isLexVarId  cs || isLexVarSym cs
-
-isLexId  cs = isLexConId  cs || isLexVarId  cs
-isLexSym cs = isLexConSym cs || isLexVarSym cs
-
--------------
-
-isLexConId cs				-- Prefix type or data constructors
-  | nullFS cs	      = False		-- 	e.g. "Foo", "[]", "(,)" 
-  | cs == FSLIT("[]") = True
-  | otherwise	      = startsConId (headFS cs)
-
-isLexVarId cs				-- Ordinary prefix identifiers
-  | nullFS cs	      = False		-- 	e.g. "x", "_x"
-  | otherwise         = startsVarId (headFS cs)
-
-isLexConSym cs				-- Infix type or data constructors
-  | nullFS cs	      = False		--	e.g. ":-:", ":", "->"
-  | cs == FSLIT("->") = True
-  | otherwise	      = startsConSym (headFS cs)
-
-isLexVarSym cs				-- Infix identifiers
-  | nullFS cs	      = False		-- 	e.g. "+"
-  | otherwise         = startsVarSym (headFS cs)
-
--------------
-startsVarSym, startsVarId, startsConSym, startsConId :: Char -> Bool
-startsVarSym c = isSymbolASCII c || (ord c > 0x7f && isSymbol c) -- Infix Ids
-startsConSym c = c == ':'				-- Infix data constructors
-startsVarId c  = isLower c || c == '_'	-- Ordinary Ids
-startsConId c  = isUpper c || c == '('	-- Ordinary type constructors and data constructors
-
-isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
-\end{code}
-
-%************************************************************************
-%*									*
-		Binary instance
-    Here rather than BinIface because OccName is abstract
-%*									*
-%************************************************************************
-
-\begin{code}
-instance Binary NameSpace where
-    put_ bh VarName = do
-	    putByte bh 0
-    put_ bh DataName = do
-	    putByte bh 1
-    put_ bh TvName = do
-	    putByte bh 2
-    put_ bh TcClsName = do
-	    putByte bh 3
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return VarName
-	      1 -> do return DataName
-	      2 -> do return TvName
-	      _ -> do return TcClsName
-
-instance Binary OccName where
-    put_ bh (OccName aa ab) = do
-	    put_ bh aa
-	    put_ bh ab
-    get bh = do
-	  aa <- get bh
-	  ab <- get bh
-	  return (OccName aa ab)
-\end{code}
diff --git a/ghc/compiler/basicTypes/OccName.lhs-boot b/ghc/compiler/basicTypes/OccName.lhs-boot
deleted file mode 100644
index d9c7fcd141..0000000000
--- a/ghc/compiler/basicTypes/OccName.lhs-boot
+++ /dev/null
@@ -1,5 +0,0 @@
-\begin{code}
-module OccName where
-
-data OccName
-\end{code}
diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs
deleted file mode 100644
index 030aa1f609..0000000000
--- a/ghc/compiler/basicTypes/RdrName.lhs
+++ /dev/null
@@ -1,540 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-
-\section[RdrName]{@RdrName@}
-
-\begin{code}
-module RdrName (
-	RdrName(..),	-- Constructors exported only to BinIface
-
-	-- Construction
-	mkRdrUnqual, mkRdrQual, 
-	mkUnqual, mkVarUnqual, mkQual, mkOrig,
-	nameRdrName, getRdrName, 
-	mkDerivedRdrName, 
-
-	-- Destruction
-	rdrNameModule, rdrNameOcc, setRdrNameSpace,
-	isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isUnqual, 
-	isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
-
-	-- Printing;	instance Outputable RdrName
-
-	-- LocalRdrEnv
-	LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv,
-	lookupLocalRdrEnv, elemLocalRdrEnv,
-
-	-- GlobalRdrEnv
-	GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv, 
-	lookupGlobalRdrEnv, extendGlobalRdrEnv,
-	pprGlobalRdrEnv, globalRdrEnvElts,
-	lookupGRE_RdrName, lookupGRE_Name,
-
-	-- GlobalRdrElt, Provenance, ImportSpec
-	GlobalRdrElt(..), isLocalGRE, unQualOK, 
-	Provenance(..), pprNameProvenance,
-	ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), 
-	importSpecLoc, importSpecModule
-  ) where 
-
-#include "HsVersions.h"
-
-import OccName
-import Module   ( Module, mkModuleFS )
-import Name	( Name, NamedThing(getName), nameModule, nameParent_maybe,
-		  nameOccName, isExternalName, nameSrcLoc )
-import Maybes	( mapCatMaybes )
-import SrcLoc	( isGoodSrcLoc, SrcSpan )
-import FastString ( FastString )
-import Outputable
-import Util	( thenCmp )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The main data type}
-%*									*
-%************************************************************************
-
-\begin{code}
-data RdrName 
-  = Unqual OccName
-	-- Used for ordinary, unqualified occurrences 
-
-  | Qual Module OccName
-	-- A qualified name written by the user in 
-	--  *source* code.  The module isn't necessarily 
-	-- the module where the thing is defined; 
-	-- just the one from which it is imported
-
-  | Orig Module OccName
-	-- An original name; the module is the *defining* module.
-	-- This is used when GHC generates code that will be fed
-	-- into the renamer (e.g. from deriving clauses), but where
-	-- we want to say "Use Prelude.map dammit".  
- 
-  | Exact Name
-	-- We know exactly the Name. This is used 
-	--  (a) when the parser parses built-in syntax like "[]" 
-	--	and "(,)", but wants a RdrName from it
-	--  (b) when converting names to the RdrNames in IfaceTypes
-	--	Here an Exact RdrName always contains an External Name
-	--	(Internal Names are converted to simple Unquals)
-	--  (c) by Template Haskell, when TH has generated a unique name
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Simple functions}
-%*									*
-%************************************************************************
-
-\begin{code}
-rdrNameModule :: RdrName -> Module
-rdrNameModule (Qual m _) = m
-rdrNameModule (Orig m _) = m
-rdrNameModule (Exact n)  = nameModule n
-rdrNameModule (Unqual n) = pprPanic "rdrNameModule" (ppr n)
-
-rdrNameOcc :: RdrName -> OccName
-rdrNameOcc (Qual _ occ) = occ
-rdrNameOcc (Unqual occ) = occ
-rdrNameOcc (Orig _ occ) = occ
-rdrNameOcc (Exact name) = nameOccName name
-
-setRdrNameSpace :: RdrName -> NameSpace -> RdrName
--- This rather gruesome function is used mainly by the parser
--- When parsing		data T a = T | T1 Int
--- we parse the data constructors as *types* because of parser ambiguities,
--- so then we need to change the *type constr* to a *data constr*
---
--- The original-name case *can* occur when parsing
--- 		data [] a = [] | a : [a]
--- For the orig-name case we return an unqualified name.
-setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
-setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
-setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
-setRdrNameSpace (Exact n)    ns = Orig (nameModule n)
-				       (setOccNameSpace ns (nameOccName n))
-\end{code}
-
-\begin{code}
-	-- These two are the basic constructors
-mkRdrUnqual :: OccName -> RdrName
-mkRdrUnqual occ = Unqual occ
-
-mkRdrQual :: Module -> OccName -> RdrName
-mkRdrQual mod occ = Qual mod occ
-
-mkOrig :: Module -> OccName -> RdrName
-mkOrig mod occ = Orig mod occ
-
----------------
-mkDerivedRdrName :: Name -> (OccName -> OccName) -> (RdrName)
-mkDerivedRdrName parent mk_occ
-  = mkOrig (nameModule parent) (mk_occ (nameOccName parent))
-
----------------
-	-- These two are used when parsing source files
-	-- They do encode the module and occurrence names
-mkUnqual :: NameSpace -> FastString -> RdrName
-mkUnqual sp n = Unqual (mkOccNameFS sp n)
-
-mkVarUnqual :: FastString -> RdrName
-mkVarUnqual n = Unqual (mkVarOccFS n)
-
-mkQual :: NameSpace -> (FastString, FastString) -> RdrName
-mkQual sp (m, n) = Qual (mkModuleFS m) (mkOccNameFS sp n)
-
-getRdrName :: NamedThing thing => thing -> RdrName
-getRdrName name = nameRdrName (getName name)
-
-nameRdrName :: Name -> RdrName
-nameRdrName name = Exact name
--- Keep the Name even for Internal names, so that the
--- unique is still there for debug printing, particularly
--- of Types (which are converted to IfaceTypes before printing)
-
-nukeExact :: Name -> RdrName
-nukeExact n 
-  | isExternalName n = Orig (nameModule n) (nameOccName n)
-  | otherwise	     = Unqual (nameOccName n)
-\end{code}
-
-\begin{code}
-isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
-isRdrTyVar   rn = isTvOcc   (rdrNameOcc rn)
-isRdrTc      rn = isTcOcc   (rdrNameOcc rn)
-
-isSrcRdrName (Unqual _) = True
-isSrcRdrName (Qual _ _) = True
-isSrcRdrName _		= False
-
-isUnqual (Unqual _) = True
-isUnqual other	    = False
-
-isQual (Qual _ _) = True
-isQual _	  = False
-
-isOrig (Orig _ _) = True
-isOrig _	  = False
-
-isOrig_maybe (Orig m n) = Just (m,n)
-isOrig_maybe _		= Nothing
-
-isExact (Exact _) = True
-isExact other	= False
-
-isExact_maybe (Exact n) = Just n
-isExact_maybe other	= Nothing
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Instances}
-%*									*
-%************************************************************************
-
-\begin{code}
-instance Outputable RdrName where
-    ppr (Exact name)   = ppr name
-    ppr (Unqual occ)   = ppr occ <+> ppr_name_space occ
-    ppr (Qual mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
-    ppr (Orig mod occ) = ppr mod <> dot <> ppr occ <+> ppr_name_space occ
-
-ppr_name_space occ = ifPprDebug (parens (pprNonVarNameSpace (occNameSpace occ)))
-
-instance OutputableBndr RdrName where
-    pprBndr _ n 
-	| isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
-	| otherwise		 = ppr n
-
-instance Eq RdrName where
-    (Exact n1) 	  == (Exact n2)    = n1==n2
-	-- Convert exact to orig
-    (Exact n1) 	  == r2@(Orig _ _) = nukeExact n1 == r2
-    r1@(Orig _ _) == (Exact n2)    = r1 == nukeExact n2
-
-    (Orig m1 o1)  == (Orig m2 o2)  = m1==m2 && o1==o2
-    (Qual m1 o1)  == (Qual m2 o2)  = m1==m2 && o1==o2
-    (Unqual o1)   == (Unqual o2)   = o1==o2
-    r1 == r2 = False
-
-instance Ord RdrName where
-    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
-    a <	 b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
-    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
-    a >	 b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
-
-	-- Exact < Unqual < Qual < Orig
-	-- [Note: Apr 2004] We used to use nukeExact to convert Exact to Orig 
-	-- 	before comparing so that Prelude.map == the exact Prelude.map, but 
-	--	that meant that we reported duplicates when renaming bindings 
-	--	generated by Template Haskell; e.g 
-	--	do { n1 <- newName "foo"; n2 <- newName "foo"; 
-	--	     <decl involving n1,n2> }
-	--	I think we can do without this conversion
-    compare (Exact n1) (Exact n2) = n1 `compare` n2
-    compare (Exact n1) n2	  = LT
-
-    compare (Unqual _)   (Exact _)    = GT
-    compare (Unqual o1)  (Unqual  o2) = o1 `compare` o2
-    compare (Unqual _)   _ 	      = LT
-
-    compare (Qual _ _)   (Exact _)    = GT
-    compare (Qual _ _)   (Unqual _)   = GT
-    compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2) 
-    compare (Qual _ _)   (Orig _ _)   = LT
-
-    compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2) 
-    compare (Orig _ _)   _	      = GT
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-			LocalRdrEnv
-%*									*
-%************************************************************************
-
-A LocalRdrEnv is used for local bindings (let, where, lambda, case)
-It is keyed by OccName, because we never use it for qualified names.
-
-\begin{code}
-type LocalRdrEnv = OccEnv Name
-
-emptyLocalRdrEnv = emptyOccEnv
-
-extendLocalRdrEnv :: LocalRdrEnv -> [Name] -> LocalRdrEnv
-extendLocalRdrEnv env names
-  = extendOccEnvList env [(nameOccName n, n) | n <- names]
-
-lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
-lookupLocalRdrEnv env (Exact name) = Just name
-lookupLocalRdrEnv env (Unqual occ) = lookupOccEnv env occ
-lookupLocalRdrEnv env other	   = Nothing
-
-elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
-elemLocalRdrEnv rdr_name env 
-  | isUnqual rdr_name = rdrNameOcc rdr_name `elemOccEnv` env
-  | otherwise	      = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-			GlobalRdrEnv
-%*									*
-%************************************************************************
-
-\begin{code}
-type GlobalRdrEnv = OccEnv [GlobalRdrElt]
-	-- Keyed by OccName; when looking up a qualified name
-	-- we look up the OccName part, and then check the Provenance
-	-- to see if the appropriate qualification is valid.  This
-	-- saves routinely doubling the size of the env by adding both
-	-- qualified and unqualified names to the domain.
-	--
-	-- The list in the range is reqd because there may be name clashes
-	-- These only get reported on lookup, not on construction
-
-	-- INVARIANT: All the members of the list have distinct 
-	--	      gre_name fields; that is, no duplicate Names
-
-emptyGlobalRdrEnv = emptyOccEnv
-
-globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
-globalRdrEnvElts env = foldOccEnv (++) [] env
-
-data GlobalRdrElt 
-  = GRE { gre_name   :: Name,
-	  gre_prov   :: Provenance	-- Why it's in scope
-    }
-
-instance Outputable GlobalRdrElt where
-  ppr gre = ppr name <+> pp_parent (nameParent_maybe name)
-		<+> parens (pprNameProvenance gre)
-	  where
-	    name = gre_name gre
-	    pp_parent (Just p) = brackets (text "parent:" <+> ppr p)
-	    pp_parent Nothing  = empty
-
-pprGlobalRdrEnv :: GlobalRdrEnv -> SDoc
-pprGlobalRdrEnv env
-  = vcat (map pp (occEnvElts env))
-  where
-    pp gres = ppr (nameOccName (gre_name (head gres))) <> colon <+> 
-	      vcat [ ppr (gre_name gre) <+> pprNameProvenance gre
-		   | gre <- gres]
-\end{code}
-
-\begin{code}
-lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
-lookupGlobalRdrEnv env rdr_name = case lookupOccEnv env rdr_name of
-					Nothing   -> []
-					Just gres -> gres
-
-extendGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrElt -> GlobalRdrEnv
-extendGlobalRdrEnv env gre = extendOccEnv_C add env occ [gre]
-  where
-    occ = nameOccName (gre_name gre)
-    add gres _ = gre:gres
-
-lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
-lookupGRE_RdrName rdr_name env
-  = case lookupOccEnv env (rdrNameOcc rdr_name) of
-	Nothing   -> []
-	Just gres -> pickGREs rdr_name gres
-
-lookupGRE_Name :: GlobalRdrEnv -> Name -> [GlobalRdrElt]
-lookupGRE_Name env name
-  = [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name),
-	    gre_name gre == name ]
-
-
-pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
--- Take a list of GREs which have the right OccName
--- Pick those GREs that are suitable for this RdrName
--- And for those, keep only only the Provenances that are suitable
--- 
--- Consider
---	 module A ( f ) where
---	 import qualified Foo( f )
---	 import Baz( f )
---	 f = undefined
--- Let's suppose that Foo.f and Baz.f are the same entity really.
--- The export of f is ambiguous because it's in scope from the local def
--- and the import.  The lookup of (Unqual f) should return a GRE for
--- the locally-defined f, and a GRE for the imported f, with a *single* 
--- provenance, namely the one for Baz(f).
-pickGREs rdr_name gres
-  = mapCatMaybes pick gres
-  where
-    is_unqual = isUnqual rdr_name
-    mod	      = rdrNameModule rdr_name
-
-    pick :: GlobalRdrElt -> Maybe GlobalRdrElt
-    pick gre@(GRE {gre_prov = LocalDef, gre_name = n}) 	-- Local def
-	| is_unqual || nameModule n == mod = Just gre
-	| otherwise			   = Nothing
-    pick gre@(GRE {gre_prov = Imported [is]})	-- Single import (efficiency)
-	| is_unqual     = if not (is_qual (is_decl is)) then Just gre
-						        else Nothing
-	| otherwise     = if mod == is_as (is_decl is)  then Just gre
-						        else Nothing
-    pick gre@(GRE {gre_prov = Imported is})	-- Multiple import
-	| null filtered_is = Nothing
-	| otherwise	   = Just (gre {gre_prov = Imported filtered_is})
-	where
-	  filtered_is | is_unqual = filter (not . is_qual    . is_decl) is
-		      | otherwise = filter ((== mod) . is_as . is_decl) is
-
-isLocalGRE :: GlobalRdrElt -> Bool
-isLocalGRE (GRE {gre_prov = LocalDef}) = True
-isLocalGRE other    		       = False
-
-unQualOK :: GlobalRdrElt -> Bool
--- An unqualifed version of this thing is in scope
-unQualOK (GRE {gre_prov = LocalDef})    = True
-unQualOK (GRE {gre_prov = Imported is}) = not (all (is_qual . is_decl) is)
-
-plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
-plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
-
-mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
-mkGlobalRdrEnv gres
-  = foldr add emptyGlobalRdrEnv gres
-  where
-    add gre env = extendOccEnv_C (foldr insertGRE) env 
-				 (nameOccName (gre_name gre)) 
-				 [gre]
-
-insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
-insertGRE new_g [] = [new_g]
-insertGRE new_g (old_g : old_gs)
-	| gre_name new_g == gre_name old_g
-	= new_g `plusGRE` old_g : old_gs
-	| otherwise
-	= old_g : insertGRE new_g old_gs
-
-plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
--- Used when the gre_name fields match
-plusGRE g1 g2
-  = GRE { gre_name = gre_name g1,
-	  gre_prov = gre_prov g1 `plusProv` gre_prov g2 }
-\end{code}
-
-
-%************************************************************************
-%*									*
-			Provenance
-%*									*
-%************************************************************************
-
-The "provenance" of something says how it came to be in scope.
-It's quite elaborate so that we can give accurate unused-name warnings.
-
-\begin{code}
-data Provenance
-  = LocalDef		-- Defined locally
-  | Imported 		-- Imported
-	[ImportSpec]	-- INVARIANT: non-empty
-
-data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
-			    is_item ::  ImpItemSpec }
-		deriving( Eq, Ord )
-
-data ImpDeclSpec	-- Describes a particular import declaration
-			-- Shared among all the Provenaces for that decl
-  = ImpDeclSpec {
-	is_mod      :: Module,	-- 'import Muggle'
-				-- Note the Muggle may well not be 
-				-- the defining module for this thing!
-	is_as       :: Module,	-- 'as M' (or 'Muggle' if there is no 'as' clause)
-	is_qual     :: Bool,	-- True <=> qualified (only)
-	is_dloc     :: SrcSpan	-- Location of import declaration
-    }
-
-data ImpItemSpec  -- Describes import info a particular Name
-  = ImpAll		-- The import had no import list, 
-			-- or  had a hiding list
-
-  | ImpSome {		-- The import had an import list
-	is_explicit :: Bool,
-	is_iloc     :: SrcSpan	-- Location of the import item
-    }
-	-- The is_explicit field is True iff the thing was named 
-	-- *explicitly* in the import specs rather 
-	-- than being imported as part of a "..." group 
-	-- e.g.		import C( T(..) )
-	-- Here the constructors of T are not named explicitly; 
-	-- only T is named explicitly.
-
-importSpecLoc :: ImportSpec -> SrcSpan
-importSpecLoc (ImpSpec decl ImpAll) = is_dloc decl
-importSpecLoc (ImpSpec _    item)   = is_iloc item
-
-importSpecModule :: ImportSpec -> Module
-importSpecModule is = is_mod (is_decl is)
-
--- Note [Comparing provenance]
--- Comparison of provenance is just used for grouping 
--- error messages (in RnEnv.warnUnusedBinds)
-instance Eq Provenance where
-  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
-
-instance Eq ImpDeclSpec where
-  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
-
-instance Eq ImpItemSpec where
-  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
-
-instance Ord Provenance where
-   compare LocalDef      LocalDef   	 = EQ
-   compare LocalDef      (Imported _) 	 = LT
-   compare (Imported _ ) LocalDef	 = GT
-   compare (Imported is1) (Imported is2) = compare (head is1) 
-	{- See Note [Comparing provenance] -}	   (head is2)
-
-instance Ord ImpDeclSpec where
-   compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp` 
-		     (is_dloc is1 `compare` is_dloc is2)
-
-instance Ord ImpItemSpec where
-   compare is1 is2 = is_iloc is1 `compare` is_iloc is2
-\end{code}
-
-\begin{code}
-plusProv :: Provenance -> Provenance -> Provenance
--- Choose LocalDef over Imported
--- There is an obscure bug lurking here; in the presence
--- of recursive modules, something can be imported *and* locally
--- defined, and one might refer to it with a qualified name from
--- the import -- but I'm going to ignore that because it makes
--- the isLocalGRE predicate so much nicer this way
-plusProv LocalDef 	 LocalDef        = panic "plusProv"
-plusProv LocalDef	 p2		 = LocalDef
-plusProv p1 		 LocalDef 	 = LocalDef
-plusProv (Imported is1)  (Imported is2)  = Imported (is1++is2)
-
-pprNameProvenance :: GlobalRdrElt -> SDoc
--- Print out the place where the name was imported
-pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef})
-  = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
-pprNameProvenance (GRE {gre_name = name, gre_prov = Imported (why:whys)})
-  = sep [ppr why, nest 2 (ppr_defn (nameSrcLoc name))]
-
--- If we know the exact definition point (which we may do with GHCi)
--- then show that too.  But not if it's just "imported from X".
-ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc)
-	     | otherwise	= empty
-
-instance Outputable ImportSpec where
-   ppr imp_spec@(ImpSpec imp_decl _)
-     = ptext SLIT("imported from") <+> ppr (is_mod imp_decl) 
-	<+> ptext SLIT("at") <+> ppr (importSpecLoc imp_spec)
-\end{code}
diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs
deleted file mode 100644
index 51d4318b0b..0000000000
--- a/ghc/compiler/basicTypes/SrcLoc.lhs
+++ /dev/null
@@ -1,386 +0,0 @@
-%
-% (c) The University of Glasgow, 1992-2003
-%
-%************************************************************************
-%*									*
-\section[SrcLoc]{The @SrcLoc@ type}
-%*									*
-%************************************************************************
-
-\begin{code}
-module SrcLoc (
-	SrcLoc,			-- Abstract
-
-	mkSrcLoc, isGoodSrcLoc,	mkGeneralSrcLoc,
-	noSrcLoc, 		-- "I'm sorry, I haven't a clue"
-	advanceSrcLoc,
-
-	importedSrcLoc,		-- Unknown place in an interface
-	wiredInSrcLoc,		-- Something wired into the compiler
-	generatedSrcLoc,	-- Code generated within the compiler
-	interactiveSrcLoc,	-- Code from an interactive session
-
-	srcLocFile,		-- return the file name part
-	srcLocLine,		-- return the line part
-	srcLocCol,		-- return the column part
-	pprDefnLoc,
-
-	SrcSpan,		-- Abstract
-	noSrcSpan,
-	mkGeneralSrcSpan, 
-	isGoodSrcSpan,
-	mkSrcSpan, srcLocSpan,
-	combineSrcSpans,
-	srcSpanFile,
-	srcSpanStartLine, srcSpanEndLine,
-	srcSpanStartCol, srcSpanEndCol,
-	srcSpanStart, srcSpanEnd,
-
-	Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc
-    ) where
-
-#include "HsVersions.h"
-
-import Util		( thenCmp )
-import Outputable
-import FastString
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[SrcLoc-SrcLocations]{Source-location information}
-%*									*
-%************************************************************************
-
-We keep information about the {\em definition} point for each entity;
-this is the obvious stuff:
-\begin{code}
-data SrcLoc
-  = SrcLoc	FastString	-- A precise location (file name)
-		!Int		-- line number, begins at 1
-		!Int		-- column number, begins at 0
-		-- Don't ask me why lines start at 1 and columns start at
-		-- zero.  That's just the way it is, so there.  --SDM
-
-  | ImportedLoc	String		-- Module name
-
-  | UnhelpfulLoc FastString	-- Just a general indication
-\end{code}
-
-Note that an entity might be imported via more than one route, and
-there could be more than one ``definition point'' --- in two or more
-\tr{.hi} files.	 We deemed it probably-unworthwhile to cater for this
-rare case.
-
-%************************************************************************
-%*									*
-\subsection[SrcLoc-access-fns]{Access functions for names}
-%*									*
-%************************************************************************
-
-Things to make 'em:
-\begin{code}
-mkSrcLoc x line col = SrcLoc x line col
-noSrcLoc	  = UnhelpfulLoc FSLIT("<no location info>")
-generatedSrcLoc   = UnhelpfulLoc FSLIT("<compiler-generated code>")
-wiredInSrcLoc     = UnhelpfulLoc FSLIT("<wired into compiler>")
-interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
-
-mkGeneralSrcLoc :: FastString -> SrcLoc
-mkGeneralSrcLoc = UnhelpfulLoc 
-
-importedSrcLoc :: String -> SrcLoc
-importedSrcLoc mod_name = ImportedLoc mod_name
-
-isGoodSrcLoc (SrcLoc _ _ _) = True
-isGoodSrcLoc other          = False
-
-srcLocFile :: SrcLoc -> FastString
-srcLocFile (SrcLoc fname _ _) = fname
-srcLocFile other	      = FSLIT("<unknown file")
-
-srcLocLine :: SrcLoc -> Int
-srcLocLine (SrcLoc _ l c) = l
-srcLocLine other	  = panic "srcLocLine: unknown line"
-
-srcLocCol :: SrcLoc -> Int
-srcLocCol (SrcLoc _ l c) = c
-srcLocCol other	  = panic "srcLocCol: unknown col"
-
-advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
-advanceSrcLoc (SrcLoc f l c) '\n' = SrcLoc f  (l + 1) 0
-advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
-advanceSrcLoc loc	     _	  = loc	-- Better than nothing
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[SrcLoc-instances]{Instance declarations for various names}
-%*									*
-%************************************************************************
-
-\begin{code}
--- SrcLoc is an instance of Ord so that we can sort error messages easily
-instance Eq SrcLoc where
-  loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
-		   EQ    -> True
-		   other -> False
-
-instance Ord SrcLoc where
-  compare = cmpSrcLoc
-
-cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
-cmpSrcLoc (UnhelpfulLoc _)  other      	      = LT
-
-cmpSrcLoc (ImportedLoc _)  (UnhelpfulLoc _)  = GT
-cmpSrcLoc (ImportedLoc m1) (ImportedLoc m2)  = m1 `compare` m2
-cmpSrcLoc (ImportedLoc _)  other	     = LT
-
-cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)      
-  = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2) `thenCmp` (c1 `cmpline` c2)
-  where
-	l1 `cmpline` l2 | l1 <  l2 = LT
-			| l1 == l2 = EQ
-			| otherwise = GT 
-cmpSrcLoc (SrcLoc _ _ _) other = GT
-
-instance Outputable SrcLoc where
-    ppr (SrcLoc src_path src_line src_col)
-      = getPprStyle $ \ sty ->
-        if userStyle sty || debugStyle sty then
-	   hcat [ ftext src_path, char ':', 
-		  int src_line,
-		  char ':', int src_col
-		]
-	else
-	   hcat [text "{-# LINE ", int src_line, space,
-		 char '\"', ftext src_path, text " #-}"]
-
-    ppr (ImportedLoc mod) = ptext SLIT("Imported from") <+> text mod
-    ppr (UnhelpfulLoc s)  = ftext s
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[SrcSpan]{Source Spans}
-%*									*
-%************************************************************************
-
-\begin{code}
-{- |
-A SrcSpan delimits a portion of a text file.  It could be represented
-by a pair of (line,column) coordinates, but in fact we optimise
-slightly by using more compact representations for single-line and
-zero-length spans, both of which are quite common.
-
-The end position is defined to be the column *after* the end of the
-span.  That is, a span of (1,1)-(1,2) is one character long, and a
-span of (1,1)-(1,1) is zero characters long.
--}
-data SrcSpan
-  = SrcSpanOneLine 		-- a common case: a single line
-	{ srcSpanFile     :: FastString,
-	  srcSpanLine     :: !Int,
-	  srcSpanSCol     :: !Int,
-	  srcSpanECol     :: !Int
-	}
-
-  | SrcSpanMultiLine
-	{ srcSpanFile	  :: FastString,
-	  srcSpanSLine    :: !Int,
-	  srcSpanSCol	  :: !Int,
-	  srcSpanELine    :: !Int,
-	  srcSpanECol     :: !Int
-	}
-
-  | SrcSpanPoint
-	{ srcSpanFile	  :: FastString,
-	  srcSpanLine	  :: !Int,
-	  srcSpanCol      :: !Int
-	}
-
-  | ImportedSpan String		-- Module name
-
-  | UnhelpfulSpan FastString	-- Just a general indication
-				-- also used to indicate an empty span
-
-  deriving Eq
-
--- We want to order SrcSpans first by the start point, then by the end point.
-instance Ord SrcSpan where
-  a `compare` b = 
-     (srcSpanStart a `compare` srcSpanStart b) `thenCmp` 
-     (srcSpanEnd   a `compare` srcSpanEnd   b)
-
-noSrcSpan  = UnhelpfulSpan FSLIT("<no location info>")
-
-mkGeneralSrcSpan :: FastString -> SrcSpan
-mkGeneralSrcSpan = UnhelpfulSpan
-
-isGoodSrcSpan SrcSpanOneLine{} = True
-isGoodSrcSpan SrcSpanMultiLine{} = True
-isGoodSrcSpan SrcSpanPoint{} = True
-isGoodSrcSpan _ = False
-
-srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
-srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
-srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
-srcSpanStartLine _ = panic "SrcLoc.srcSpanStartLine"
-
-srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
-srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
-srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
-srcSpanEndLine _ = panic "SrcLoc.srcSpanEndLine"
-
-srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
-srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
-srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
-srcSpanStartCol _ = panic "SrcLoc.srcSpanStartCol"
-
-srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
-srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
-srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
-srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol"
-
-srcSpanStart (ImportedSpan str) = ImportedLoc str
-srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
-srcSpanStart s = 
-  mkSrcLoc (srcSpanFile s) 
-	   (srcSpanStartLine s)
- 	   (srcSpanStartCol s)
-
-srcSpanEnd (ImportedSpan str) = ImportedLoc str
-srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
-srcSpanEnd s = 
-  mkSrcLoc (srcSpanFile s) 
-	   (srcSpanEndLine s)
- 	   (srcSpanEndCol s)
-
-srcLocSpan :: SrcLoc -> SrcSpan
-srcLocSpan (ImportedLoc str)  = ImportedSpan str
-srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
-srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
-
-mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
-mkSrcSpan (ImportedLoc str) _  = ImportedSpan str
-mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
-mkSrcSpan _ (ImportedLoc str)  = ImportedSpan str
-mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
-mkSrcSpan loc1 loc2
-  | line1 == line2 = if col1 == col2
-			then SrcSpanPoint file line1 col1
-			else SrcSpanOneLine file line1 col1 col2
-  | otherwise      = SrcSpanMultiLine file line1 col1 line2 col2
-  where
-	line1 = srcLocLine loc1
-	line2 = srcLocLine loc2
-	col1 = srcLocCol loc1
-	col2 = srcLocCol loc2
-	file = srcLocFile loc1
-
-combineSrcSpans	:: SrcSpan -> SrcSpan -> SrcSpan
--- Assumes the 'file' part is the same in both
-combineSrcSpans	(ImportedSpan str) _  = ImportedSpan str
-combineSrcSpans	(UnhelpfulSpan str) r = r -- this seems more useful
-combineSrcSpans	_ (ImportedSpan str)  = ImportedSpan str
-combineSrcSpans	l (UnhelpfulSpan str) = l
-combineSrcSpans	start end 
- = case line1 `compare` line2 of
-     EQ -> case col1 `compare` col2 of
-		EQ -> SrcSpanPoint file line1 col1
-		LT -> SrcSpanOneLine file line1 col1 col2
-		GT -> SrcSpanOneLine file line1 col2 col1
-     LT -> SrcSpanMultiLine file line1 col1 line2 col2
-     GT -> SrcSpanMultiLine file line2 col2 line1 col1
-  where
-	line1 = srcSpanStartLine start
-	col1  = srcSpanStartCol start
-	line2 = srcSpanEndLine end
-	col2  = srcSpanEndCol end
-	file  = srcSpanFile start
-
-pprDefnLoc :: SrcLoc -> SDoc
--- "defined at ..." or "imported from ..."
-pprDefnLoc loc
-  | isGoodSrcLoc loc = ptext SLIT("Defined at") <+> ppr loc
-  | otherwise	     = ppr loc
-
-instance Outputable SrcSpan where
-    ppr span
-      = getPprStyle $ \ sty ->
-        if userStyle sty || debugStyle sty then
-	   pprUserSpan span
-	else
-	   hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
-		 char '\"', ftext (srcSpanFile span), text " #-}"]
-
-
-pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
-  = hcat [ ftext src_path, char ':', 
-	   int line,
-	   char ':', int start_col
-	 ]
-    <> if end_col - start_col <= 1 
-	  then empty 
-	    -- for single-character or point spans, we just output the starting
-	    -- column number
-	  else  char '-' <> int (end_col-1)
-
-pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
-  = hcat [ ftext src_path, char ':', 
-		  parens (int sline <> char ',' <>  int scol),
-		  char '-',
-		  parens (int eline <> char ',' <>  
-			   if ecol == 0 then int ecol else int (ecol-1))
-		]
-
-pprUserSpan (SrcSpanPoint src_path line col)
-  = hcat [ ftext src_path, char ':', 
-	   int line,
-	   char ':', int col
-	 ]
-
-pprUserSpan (ImportedSpan mod) = ptext SLIT("Imported from") <+> quotes (text mod)
-pprUserSpan (UnhelpfulSpan s)  = ftext s
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Located]{Attaching SrcSpans to things}
-%*									*
-%************************************************************************
-
-\begin{code}
--- | We attach SrcSpans to lots of things, so let's have a datatype for it.
-data Located e = L SrcSpan e
-
-unLoc :: Located e -> e
-unLoc (L _ e) = e
-
-getLoc :: Located e -> SrcSpan
-getLoc (L l _) = l
-
-noLoc :: e -> Located e
-noLoc e = L noSrcSpan e
-
-combineLocs :: Located a -> Located b -> SrcSpan
-combineLocs a b = combineSrcSpans (getLoc a) (getLoc b)
-
-addCLoc :: Located a -> Located b -> c -> Located c
-addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c
-
--- not clear whether to add a general Eq instance, but this is useful sometimes:
-eqLocated :: Eq a => Located a -> Located a -> Bool
-eqLocated a b = unLoc a == unLoc b
-
--- not clear whether to add a general Eq instance, but this is useful sometimes:
-cmpLocated :: Ord a => Located a -> Located a -> Ordering
-cmpLocated a b = unLoc a `compare` unLoc b
-
-instance Functor Located where
-  fmap f (L l e) = L l (f e)
-
-instance Outputable e => Outputable (Located e) where
-  ppr (L span e) =  ppr e
-	-- do we want to dump the span in debugSty mode?    
-\end{code}
diff --git a/ghc/compiler/basicTypes/UniqSupply.lhs b/ghc/compiler/basicTypes/UniqSupply.lhs
deleted file mode 100644
index 41ad5c0f60..0000000000
--- a/ghc/compiler/basicTypes/UniqSupply.lhs
+++ /dev/null
@@ -1,203 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[UniqSupply]{The @UniqueSupply@ data type and a (monadic) supply thereof}
-
-\begin{code}
-module UniqSupply (
-
-	UniqSupply,		-- Abstractly
-
-	uniqFromSupply, uniqsFromSupply,	-- basic ops
-
-	UniqSM,		-- type: unique supply monad
-	initUs, initUs_, thenUs, thenUs_, returnUs, fixUs, getUs, withUs,
-	getUniqueUs, getUniquesUs,
-	mapUs, mapAndUnzipUs, mapAndUnzip3Us,
-	thenMaybeUs, mapAccumLUs,
-	lazyThenUs, lazyMapUs,
-
-	mkSplitUniqSupply,
-	splitUniqSupply
-  ) where
-
-#include "HsVersions.h"
-
-import Unique
-
-import GLAEXTS
-import UNSAFE_IO	( unsafeInterleaveIO )
-
-w2i x = word2Int# x
-i2w x = int2Word# x
-i2w_s x = (x :: Int#)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Splittable Unique supply: @UniqSupply@}
-%*									*
-%************************************************************************
-
-A value of type @UniqSupply@ is unique, and it can
-supply {\em one} distinct @Unique@.  Also, from the supply, one can
-also manufacture an arbitrary number of further @UniqueSupplies@,
-which will be distinct from the first and from all others.
-
-\begin{code}
-data UniqSupply
-  = MkSplitUniqSupply Int	-- make the Unique with this
-		   UniqSupply UniqSupply
-				-- when split => these two supplies
-\end{code}
-
-\begin{code}
-mkSplitUniqSupply :: Char -> IO UniqSupply
-
-splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply)
-uniqFromSupply  :: UniqSupply -> Unique
-uniqsFromSupply :: UniqSupply -> [Unique]	-- Infinite
-\end{code}
-
-\begin{code}
-mkSplitUniqSupply (C# c#)
-  = let
-#if __GLASGOW_HASKELL__ >= 503
-	mask# = (i2w (ord# c#)) `uncheckedShiftL#` (i2w_s 24#)
-#else
-	mask# = (i2w (ord# c#)) `shiftL#` (i2w_s 24#)
-#endif
-	-- here comes THE MAGIC:
-
-	-- This is one of the most hammered bits in the whole compiler
-	mk_supply#
-	  = unsafeInterleaveIO (
-		mk_unique   >>= \ uniq ->
-		mk_supply#  >>= \ s1 ->
-		mk_supply#  >>= \ s2 ->
-		return (MkSplitUniqSupply uniq s1 s2)
-	    )
-
-	mk_unique = genSymZh		>>= \ (W# u#) ->
-		    return (I# (w2i (mask# `or#` u#)))
-    in
-    mk_supply#
-
-foreign import ccall unsafe "genSymZh" genSymZh :: IO Word
-
-splitUniqSupply (MkSplitUniqSupply _ s1 s2) = (s1, s2)
-\end{code}
-
-\begin{code}
-uniqFromSupply  (MkSplitUniqSupply n _ _)  = mkUniqueGrimily n
-uniqsFromSupply (MkSplitUniqSupply n _ s2) = mkUniqueGrimily n : uniqsFromSupply s2
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection[UniqSupply-monad]{@UniqSupply@ monad: @UniqSM@}
-%*									*
-%************************************************************************
-
-\begin{code}
-type UniqSM result = UniqSupply -> (result, UniqSupply)
-
--- the initUs function also returns the final UniqSupply; initUs_ drops it
-initUs :: UniqSupply -> UniqSM a -> (a,UniqSupply)
-initUs init_us m = case m init_us of { (r,us) -> (r,us) }
-
-initUs_ :: UniqSupply -> UniqSM a -> a
-initUs_ init_us m = case m init_us of { (r,us) -> r }
-
-{-# INLINE thenUs #-}
-{-# INLINE lazyThenUs #-}
-{-# INLINE returnUs #-}
-{-# INLINE splitUniqSupply #-}
-\end{code}
-
-@thenUs@ is where we split the @UniqSupply@.
-\begin{code}
-fixUs :: (a -> UniqSM a) -> UniqSM a
-fixUs m us
-  = (r,us')  where  (r,us') = m r us
-
-thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b
-thenUs expr cont us
-  = case (expr us) of { (result, us') -> cont result us' }
-
-lazyThenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b
-lazyThenUs expr cont us
-  = let (result, us') = expr us in cont result us'
-
-thenUs_ :: UniqSM a -> UniqSM b -> UniqSM b
-thenUs_ expr cont us
-  = case (expr us) of { (_, us') -> cont us' }
-
-
-returnUs :: a -> UniqSM a
-returnUs result us = (result, us)
-
-withUs :: (UniqSupply -> (a, UniqSupply)) -> UniqSM a
-withUs f us = f us	-- Ha ha!
-		
-getUs :: UniqSM UniqSupply
-getUs us = splitUniqSupply us
-
-getUniqueUs :: UniqSM Unique
-getUniqueUs us = case splitUniqSupply us of
-		   (us1,us2) -> (uniqFromSupply us1, us2)
-
-getUniquesUs :: UniqSM [Unique]
-getUniquesUs us = case splitUniqSupply us of
-		      (us1,us2) -> (uniqsFromSupply us1, us2)
-\end{code}
-
-\begin{code}
-mapUs :: (a -> UniqSM b) -> [a] -> UniqSM [b]
-mapUs f []     = returnUs []
-mapUs f (x:xs)
-  = f x         `thenUs` \ r  ->
-    mapUs f xs  `thenUs` \ rs ->
-    returnUs (r:rs)
-
-lazyMapUs :: (a -> UniqSM b) -> [a] -> UniqSM [b]
-lazyMapUs f []     = returnUs []
-lazyMapUs f (x:xs)
-  = f x             `lazyThenUs` \ r  ->
-    lazyMapUs f xs  `lazyThenUs` \ rs ->
-    returnUs (r:rs)
-
-mapAndUnzipUs  :: (a -> UniqSM (b,c))   -> [a] -> UniqSM ([b],[c])
-mapAndUnzip3Us :: (a -> UniqSM (b,c,d)) -> [a] -> UniqSM ([b],[c],[d])
-
-mapAndUnzipUs f [] = returnUs ([],[])
-mapAndUnzipUs f (x:xs)
-  = f x		    	`thenUs` \ (r1,  r2)  ->
-    mapAndUnzipUs f xs	`thenUs` \ (rs1, rs2) ->
-    returnUs (r1:rs1, r2:rs2)
-
-mapAndUnzip3Us f [] = returnUs ([],[],[])
-mapAndUnzip3Us f (x:xs)
-  = f x		    	`thenUs` \ (r1,  r2,  r3)  ->
-    mapAndUnzip3Us f xs	`thenUs` \ (rs1, rs2, rs3) ->
-    returnUs (r1:rs1, r2:rs2, r3:rs3)
-
-thenMaybeUs :: UniqSM (Maybe a) -> (a -> UniqSM (Maybe b)) -> UniqSM (Maybe b)
-thenMaybeUs m k
-  = m	`thenUs` \ result ->
-    case result of
-      Nothing -> returnUs Nothing
-      Just x  -> k x
-
-mapAccumLUs :: (acc -> x -> UniqSM (acc, y))
-	    -> acc
-	    -> [x]
-	    -> UniqSM (acc, [y])
-
-mapAccumLUs f b []     = returnUs (b, [])
-mapAccumLUs f b (x:xs)
-  = f b x   	        	    `thenUs` \ (b__2, x__2) ->
-    mapAccumLUs f b__2 xs   	    `thenUs` \ (b__3, xs__2) ->
-    returnUs (b__3, x__2:xs__2)
-\end{code}
diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs
deleted file mode 100644
index 874328863e..0000000000
--- a/ghc/compiler/basicTypes/Unique.lhs
+++ /dev/null
@@ -1,330 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-
-@Uniques@ are used to distinguish entities in the compiler (@Ids@,
-@Classes@, etc.) from each other.  Thus, @Uniques@ are the basic
-comparison key in the compiler.
-
-If there is any single operation that needs to be fast, it is @Unique@
-comparison.  Unsurprisingly, there is quite a bit of huff-and-puff
-directed to that end.
-
-Some of the other hair in this code is to be able to use a
-``splittable @UniqueSupply@'' if requested/possible (not standard
-Haskell).
-
-\begin{code}
-module Unique (
-	Unique, Uniquable(..), hasKey,
-
-	pprUnique, 
-
-	mkUnique,			-- Used in UniqSupply
-	mkUniqueGrimily,		-- Used in UniqSupply only!
-	getKey, getKey#,		-- Used in Var, UniqFM, Name only!
-
-	incrUnique,			-- Used for renumbering
-	deriveUnique,			-- Ditto
-	newTagUnique,			-- Used in CgCase
-	initTyVarUnique,
-
-	isTupleKey, 
-
-	-- now all the built-in Uniques (and functions to make them)
-	-- [the Oh-So-Wonderful Haskell module system wins again...]
-	mkAlphaTyVarUnique,
-	mkPrimOpIdUnique,
-	mkTupleTyConUnique, mkTupleDataConUnique,
-	mkPreludeMiscIdUnique, mkPreludeDataConUnique,
-	mkPreludeTyConUnique, mkPreludeClassUnique,
-	mkPArrDataConUnique,
-
-	mkBuiltinUnique,
-	mkPseudoUniqueC,
-	mkPseudoUniqueD,
-	mkPseudoUniqueE,
-	mkPseudoUniqueH
-    ) where
-
-#include "HsVersions.h"
-
-import BasicTypes	( Boxity(..) )
-import PackageConfig	( PackageId, packageIdFS )
-import FastString	( FastString, uniqueOfFS )
-import Outputable
-import FastTypes
-
-import GLAEXTS
-
-import Char		( chr, ord )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Unique-type]{@Unique@ type and operations}
-%*									*
-%************************************************************************
-
-The @Chars@ are ``tag letters'' that identify the @UniqueSupply@.
-Fast comparison is everything on @Uniques@:
-
-\begin{code}
-data Unique = MkUnique Int#
-\end{code}
-
-Now come the functions which construct uniques from their pieces, and vice versa.
-The stuff about unique *supplies* is handled further down this module.
-
-\begin{code}
-mkUnique	:: Char -> Int -> Unique	-- Builds a unique from pieces
-unpkUnique	:: Unique -> (Char, Int)	-- The reverse
-
-mkUniqueGrimily :: Int -> Unique		-- A trap-door for UniqSupply
-getKey		:: Unique -> Int		-- for Var
-getKey#		:: Unique -> Int#		-- for Var
-
-incrUnique	:: Unique -> Unique
-deriveUnique	:: Unique -> Int -> Unique
-newTagUnique	:: Unique -> Char -> Unique
-
-isTupleKey	:: Unique -> Bool
-\end{code}
-
-
-\begin{code}
-mkUniqueGrimily (I# x) = MkUnique x
-
-{-# INLINE getKey #-}
-getKey (MkUnique x) = I# x
-{-# INLINE getKey# #-}
-getKey# (MkUnique x) = x
-
-incrUnique (MkUnique i) = MkUnique (i +# 1#)
-
--- deriveUnique uses an 'X' tag so that it won't clash with
--- any of the uniques produced any other way
-deriveUnique (MkUnique i) delta = mkUnique 'X' (I# i + delta)
-
--- newTagUnique changes the "domain" of a unique to a different char
-newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u
-
--- pop the Char in the top 8 bits of the Unique(Supply)
-
--- No 64-bit bugs here, as long as we have at least 32 bits. --JSM
-
-w2i x = word2Int# x
-i2w x = int2Word# x
-i2w_s x = (x::Int#)
-
-mkUnique (C# c) (I# i)
-  = MkUnique (w2i (tag `or#` bits))
-  where
-#if __GLASGOW_HASKELL__ >= 503
-    tag  = i2w (ord# c) `uncheckedShiftL#` i2w_s 24#
-#else
-    tag  = i2w (ord# c) `shiftL#` i2w_s 24#
-#endif
-    bits = i2w i `and#` (i2w 16777215#){-``0x00ffffff''-}
-
-unpkUnique (MkUnique u)
-  = let
-	tag = C# (chr# (w2i ((i2w u) `shiftr` (i2w_s 24#))))
-	i   = I# (w2i ((i2w u) `and#` (i2w 16777215#){-``0x00ffffff''-}))
-    in
-    (tag, i)
-  where
-#if __GLASGOW_HASKELL__ >= 503
-    shiftr x y = uncheckedShiftRL# x y
-#else
-    shiftr x y = shiftRL# x y
-#endif
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection[Uniquable-class]{The @Uniquable@ class}
-%*									*
-%************************************************************************
-
-\begin{code}
-class Uniquable a where
-    getUnique :: a -> Unique
-
-hasKey		:: Uniquable a => a -> Unique -> Bool
-x `hasKey` k	= getUnique x == k
-
-instance Uniquable FastString where
- getUnique fs = mkUniqueGrimily (I# (uniqueOfFS fs))
-
-instance Uniquable PackageId where
- getUnique pid = getUnique (packageIdFS pid)
-
-instance Uniquable Int where
- getUnique i = mkUniqueGrimily i
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Unique-instances]{Instance declarations for @Unique@}
-%*									*
-%************************************************************************
-
-And the whole point (besides uniqueness) is fast equality.  We don't
-use `deriving' because we want {\em precise} control of ordering
-(equality on @Uniques@ is v common).
-
-\begin{code}
-eqUnique (MkUnique u1) (MkUnique u2) = u1 ==# u2
-ltUnique (MkUnique u1) (MkUnique u2) = u1 <#  u2
-leUnique (MkUnique u1) (MkUnique u2) = u1 <=# u2
-
-cmpUnique (MkUnique u1) (MkUnique u2)
-  = if u1 ==# u2 then EQ else if u1 <# u2 then LT else GT
-
-instance Eq Unique where
-    a == b = eqUnique a b
-    a /= b = not (eqUnique a b)
-
-instance Ord Unique where
-    a  < b = ltUnique a b
-    a <= b = leUnique a b
-    a  > b = not (leUnique a b)
-    a >= b = not (ltUnique a b)
-    compare a b = cmpUnique a b
-
------------------
-instance Uniquable Unique where
-    getUnique u = u
-\end{code}
-
-We do sometimes make strings with @Uniques@ in them:
-\begin{code}
-pprUnique :: Unique -> SDoc
-pprUnique uniq
-  = case unpkUnique uniq of
-      (tag, u) -> finish_ppr tag u (text (iToBase62 u))
-
-#ifdef UNUSED
-pprUnique10 :: Unique -> SDoc
-pprUnique10 uniq	-- in base-10, dudes
-  = case unpkUnique uniq of
-      (tag, u) -> finish_ppr tag u (int u)
-#endif
-
-finish_ppr 't' u pp_u | u < 26
-  =	-- Special case to make v common tyvars, t1, t2, ...
-	-- come out as a, b, ... (shorter, easier to read)
-    char (chr (ord 'a' + u))
-finish_ppr tag u pp_u = char tag <> pp_u
-
-instance Outputable Unique where
-    ppr u = pprUnique u
-
-instance Show Unique where
-    showsPrec p uniq = showsPrecSDoc p (pprUnique uniq)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Utils-base62]{Base-62 numbers}
-%*									*
-%************************************************************************
-
-A character-stingy way to read/write numbers (notably Uniques).
-The ``62-its'' are \tr{[0-9a-zA-Z]}.  We don't handle negative Ints.
-Code stolen from Lennart.
-
-\begin{code}
-iToBase62 :: Int -> String
-iToBase62 n@(I# n#) 
-  = ASSERT(n >= 0) go n# ""
-  where
-    go n# cs | n# <# 62# 
-	     = case (indexCharOffAddr# chars62# n#) of { c# -> C# c# : cs }
-	     | otherwise
-	     =	case (quotRem (I# n#) 62)	     of { (I# q#, I# r#) ->
-		case (indexCharOffAddr# chars62# r#) of { c#  ->
-		go q# (C# c# : cs) }}
-
-    chars62# = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Uniques-prelude]{@Uniques@ for wired-in Prelude things}
-%*									*
-%************************************************************************
-
-Allocation of unique supply characters:
-	v,t,u : for renumbering value-, type- and usage- vars.
-	B:   builtin
-	C-E: pseudo uniques	(used in native-code generator)
-	X:   uniques derived by deriveUnique
-	_:   unifiable tyvars   (above)
-	0-9: prelude things below
-
-	other a-z: lower case chars for unique supplies.  Used so far:
-
-	d	desugarer
-	f	AbsC flattener
-	g	SimplStg
-	l	ndpFlatten
-	n	Native codegen
-	r	Hsc name cache
-	s	simplifier
-
-\begin{code}
-mkAlphaTyVarUnique i            = mkUnique '1' i
-
-mkPreludeClassUnique i		= mkUnique '2' i
-
--- Prelude type constructors occupy *three* slots.
--- The first is for the tycon itself; the latter two
--- are for the generic to/from Ids.  See TysWiredIn.mk_tc_gen_info.
-
-mkPreludeTyConUnique i		= mkUnique '3' (3*i)
-mkTupleTyConUnique Boxed   a	= mkUnique '4' (3*a)
-mkTupleTyConUnique Unboxed a	= mkUnique '5' (3*a)
-
--- Data constructor keys occupy *two* slots.  The first is used for the
--- data constructor itself and its wrapper function (the function that
--- evaluates arguments as necessary and calls the worker). The second is
--- used for the worker function (the function that builds the constructor
--- representation).
-
-mkPreludeDataConUnique i	= mkUnique '6' (2*i)	-- Must be alphabetic
-mkTupleDataConUnique Boxed a	= mkUnique '7' (2*a)	-- ditto (*may* be used in C labels)
-mkTupleDataConUnique Unboxed a	= mkUnique '8' (2*a)
-
--- This one is used for a tiresome reason
--- to improve a consistency-checking error check in the renamer
-isTupleKey u = case unpkUnique u of
-		(tag,_) -> tag == '4' || tag == '5' || tag == '7' || tag == '8'
-
-mkPrimOpIdUnique op		= mkUnique '9' op
-mkPreludeMiscIdUnique i		= mkUnique '0' i
-
--- No numbers left anymore, so I pick something different for the character
--- tag 
-mkPArrDataConUnique a	        = mkUnique ':' (2*a)
-
--- The "tyvar uniques" print specially nicely: a, b, c, etc.
--- See pprUnique for details
-
-initTyVarUnique :: Unique
-initTyVarUnique = mkUnique 't' 0
-
-mkPseudoUniqueC, mkPseudoUniqueD, mkPseudoUniqueE, mkPseudoUniqueH,
-   mkBuiltinUnique :: Int -> Unique
-
-mkBuiltinUnique i = mkUnique 'B' i
-mkPseudoUniqueC i = mkUnique 'C' i -- used for getUnique on Regs
-mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs
-mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
-mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs
-\end{code}
-
diff --git a/ghc/compiler/basicTypes/Var.lhs b/ghc/compiler/basicTypes/Var.lhs
deleted file mode 100644
index 60fdf3831c..0000000000
--- a/ghc/compiler/basicTypes/Var.lhs
+++ /dev/null
@@ -1,337 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section{@Vars@: Variables}
-
-\begin{code}
-module Var (
-	Var, 
-	varName, varUnique, 
-	setVarName, setVarUnique, 
-
-	-- TyVars
-	TyVar, mkTyVar, mkTcTyVar,
-	tyVarName, tyVarKind,
-	setTyVarName, setTyVarUnique,
-	tcTyVarDetails,
-
-	-- Ids
-	Id, DictId,
-	idName, idType, idUnique, idInfo, modifyIdInfo, maybeModifyIdInfo,
-	setIdName, setIdUnique, setIdType, setIdInfo, lazySetIdInfo, 
-	setIdExported, setIdNotExported, 
-
-	globalIdDetails, globaliseId, 
-
-	mkLocalId, mkExportedLocalId, mkGlobalId, 
-
-	isTyVar, isTcTyVar, isId, isLocalVar, isLocalId,
-	isGlobalId, isExportedId, 
-	mustHaveLocalBinding
-    ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-}	TypeRep( Type )
-import {-# SOURCE #-}	TcType( TcTyVarDetails, pprTcTyVarDetails )
-import {-# SOURCE #-}	IdInfo( GlobalIdDetails, notGlobalId, IdInfo, seqIdInfo )
-
-import Name		( Name, NamedThing(..),
-			  setNameUnique, nameUnique
-			)
-import Kind		( Kind )
-import Unique		( Unique, Uniquable(..), mkUniqueGrimily, getKey# )
-import FastTypes
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The main data type declarations}
-%*									*
-%************************************************************************
-
-
-Every @Var@ has a @Unique@, to uniquify it and for fast comparison, a
-@Type@, and an @IdInfo@ (non-essential info about it, e.g.,
-strictness).  The essential info about different kinds of @Vars@ is
-in its @VarDetails@.
-
-\begin{code}
-data Var
-  = TyVar {
-	varName    :: !Name,
-	realUnique :: FastInt,		-- Key for fast comparison
-					-- Identical to the Unique in the name,
-					-- cached here for speed
-	tyVarKind :: Kind }
-
-  | TcTyVar { 				-- Used only during type inference
-	varName        :: !Name,
-	realUnique     :: FastInt,
-	tyVarKind      :: Kind,
-	tcTyVarDetails :: TcTyVarDetails }
-
-  | GlobalId { 			-- Used for imported Ids, dict selectors etc
-	varName    :: !Name,
-	realUnique :: FastInt,
-   	idType     :: Type,
-	idInfo     :: IdInfo,
-	gblDetails :: GlobalIdDetails }
-
-  | LocalId { 			-- Used for locally-defined Ids (see NOTE below)
-	varName    :: !Name,
-	realUnique :: FastInt,
-   	idType     :: Type,
-	idInfo     :: IdInfo,
-	lclDetails :: LocalIdDetails }
-
-data LocalIdDetails 
-  = NotExported	-- Not exported
-  | Exported	-- Exported
-  -- Exported Ids are kept alive; 
-  -- NotExported things may be discarded as dead code.
-\end{code}
-
-LocalId and GlobalId
-~~~~~~~~~~~~~~~~~~~~
-A GlobalId is
-  * always a constant (top-level)
-  * imported, or data constructor, or primop, or record selector
-  * has a Unique that is globally unique across the whole
-    GHC invocation (a single invocation may compile multiple modules)
-
-A LocalId is 
-  * bound within an expression (lambda, case, local let(rec))
-  * or defined at top level in the module being compiled
-
-After CoreTidy, top-level LocalIds are turned into GlobalIds
- 
-
-\begin{code}
-instance Outputable Var where
-  ppr var = ppr (varName var) <+> ifPprDebug (brackets extra)
-	where
-	  extra = case var of
-			GlobalId {} -> ptext SLIT("gid")
-			LocalId  {} -> ptext SLIT("lid")
-			TyVar    {} -> ptext SLIT("tv")
-			TcTyVar {tcTyVarDetails = details} -> pprTcTyVarDetails details
-
-instance Show Var where
-  showsPrec p var = showsPrecSDoc p (ppr var)
-
-instance NamedThing Var where
-  getName = varName
-
-instance Uniquable Var where
-  getUnique = varUnique
-
-instance Eq Var where
-    a == b = realUnique a ==# realUnique b
-
-instance Ord Var where
-    a <= b = realUnique a <=# realUnique b
-    a <	 b = realUnique a <#  realUnique b
-    a >= b = realUnique a >=# realUnique b
-    a >	 b = realUnique a >#  realUnique b
-    a `compare` b = varUnique a `compare` varUnique b
-\end{code}
-
-
-\begin{code}
-varUnique :: Var -> Unique
-varUnique var = mkUniqueGrimily (iBox (realUnique var))
-
-setVarUnique :: Var -> Unique -> Var
-setVarUnique var uniq 
-  = var { realUnique = getKey# uniq, 
-	  varName = setNameUnique (varName var) uniq }
-
-setVarName :: Var -> Name -> Var
-setVarName var new_name
-  = var { realUnique = getKey# (getUnique new_name), 
-   	  varName = new_name }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Type variables}
-%*									*
-%************************************************************************
-
-\begin{code}
-type TyVar = Var
-
-tyVarName = varName
-
-setTyVarUnique = setVarUnique
-setTyVarName   = setVarName
-\end{code}
-
-\begin{code}
-mkTyVar :: Name -> Kind -> TyVar
-mkTyVar name kind = TyVar { varName    = name
-			  , realUnique = getKey# (nameUnique name)
-			  , tyVarKind  = kind
-			}
-
-mkTcTyVar :: Name -> Kind -> TcTyVarDetails -> TyVar
-mkTcTyVar name kind details
-  = TcTyVar {	varName    = name,
-		realUnique = getKey# (nameUnique name),
-		tyVarKind  = kind,
-		tcTyVarDetails = details
-	}
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Id Construction}
-%*									*
-%************************************************************************
-
-Most Id-related functions are in Id.lhs and MkId.lhs
-
-\begin{code}
-type Id     = Var
-type DictId = Id
-\end{code}
-
-\begin{code}
-idName    = varName
-idUnique  = varUnique
-
-setIdUnique :: Id -> Unique -> Id
-setIdUnique = setVarUnique
-
-setIdName :: Id -> Name -> Id
-setIdName = setVarName
-
-setIdType :: Id -> Type -> Id
-setIdType id ty = id {idType = ty}
-
-setIdExported :: Id -> Id
--- Can be called on GlobalIds, such as data cons and class ops,
--- which are "born" as GlobalIds and automatically exported
-setIdExported id@(LocalId {}) = id { lclDetails = Exported }
-setIdExported other_id	      = ASSERT( isId other_id ) other_id
-
-setIdNotExported :: Id -> Id
--- We can only do this to LocalIds
-setIdNotExported id = ASSERT( isLocalId id ) id { lclDetails = NotExported }
-
-globaliseId :: GlobalIdDetails -> Id -> Id
--- If it's a local, make it global
-globaliseId details id = GlobalId { varName    = varName id,
-				    realUnique = realUnique id,
-			   	    idType     = idType id,
-				    idInfo     = idInfo id,
-				    gblDetails = details }
-
-lazySetIdInfo :: Id -> IdInfo -> Id
-lazySetIdInfo id info = id {idInfo = info}
-
-setIdInfo :: Id -> IdInfo -> Id
-setIdInfo id info = seqIdInfo info `seq` id {idInfo = info}
-	-- Try to avoid spack leaks by seq'ing
-
-modifyIdInfo :: (IdInfo -> IdInfo) -> Id -> Id
-modifyIdInfo fn id
-  = seqIdInfo new_info `seq` id {idInfo = new_info}
-  where
-    new_info = fn (idInfo id)
-
--- maybeModifyIdInfo tries to avoid unnecesary thrashing
-maybeModifyIdInfo :: (IdInfo -> Maybe IdInfo) -> Id -> Id
-maybeModifyIdInfo fn id
-  = case fn (idInfo id) of
-	Nothing       -> id
-	Just new_info -> id {idInfo = new_info}
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Predicates over variables
-%*									*
-%************************************************************************
-
-\begin{code}
-mkGlobalId :: GlobalIdDetails -> Name -> Type -> IdInfo -> Id
-mkGlobalId details name ty info 
-  = GlobalId {	varName    = name, 
-		realUnique = getKey# (nameUnique name), 	-- Cache the unique
-		idType     = ty,	
-		gblDetails = details,
-		idInfo     = info }
-
-mk_local_id :: Name -> Type -> LocalIdDetails -> IdInfo -> Id
-mk_local_id name ty details info
-  = LocalId {	varName    = name, 
-		realUnique = getKey# (nameUnique name), 	-- Cache the unique
-		idType     = ty,	
-		lclDetails = details,
-		idInfo     = info }
-
-mkLocalId :: Name -> Type -> IdInfo -> Id
-mkLocalId name ty info = mk_local_id name ty NotExported info
-
-mkExportedLocalId :: Name -> Type -> IdInfo -> Id
-mkExportedLocalId name ty info = mk_local_id name ty Exported info
-\end{code}
-
-\begin{code}
-isTyVar, isTcTyVar	    :: Var -> Bool
-isId, isLocalVar, isLocalId :: Var -> Bool
-isGlobalId, isExportedId    :: Var -> Bool
-mustHaveLocalBinding	    :: Var -> Bool
-
-isTyVar (TyVar {})   = True
-isTyVar (TcTyVar {}) = True
-isTyVar other	     = False
-
-isTcTyVar (TcTyVar {}) = True
-isTcTyVar other	       = False
-
-isId (LocalId {})  = True
-isId (GlobalId {}) = True
-isId other	   = False
-
-isLocalId (LocalId {}) = True
-isLocalId other	       = False
-
--- isLocalVar returns True for type variables as well as local Ids
--- These are the variables that we need to pay attention to when finding free
--- variables, or doing dependency analysis.
-isLocalVar (GlobalId {}) = False 
-isLocalVar other	 = True
-
--- mustHaveLocalBinding returns True of Ids and TyVars
--- that must have a binding in this module.  The converse
--- is not quite right: there are some GlobalIds that must have
--- bindings, such as record selectors.  But that doesn't matter,
--- because it's only used for assertions
-mustHaveLocalBinding var = isLocalVar var
-
-isGlobalId (GlobalId {}) = True
-isGlobalId other	 = False
-
--- isExportedId means "don't throw this away"
-isExportedId (GlobalId {}) = True
-isExportedId (LocalId {lclDetails = details}) 
-  = case details of
-	Exported   -> True
-	other	   -> False
-isExportedId other = False
-\end{code}
-
-\begin{code}
-globalIdDetails :: Var -> GlobalIdDetails
--- Works OK on local Ids too, returning notGlobalId
-globalIdDetails (GlobalId {gblDetails = details}) = details
-globalIdDetails other				  = notGlobalId
-\end{code}
-
diff --git a/ghc/compiler/basicTypes/VarEnv.lhs b/ghc/compiler/basicTypes/VarEnv.lhs
deleted file mode 100644
index bfeecdc923..0000000000
--- a/ghc/compiler/basicTypes/VarEnv.lhs
+++ /dev/null
@@ -1,344 +0,0 @@
-
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section{@VarEnvs@: Variable environments}
-
-\begin{code}
-module VarEnv (
-	VarEnv, IdEnv, TyVarEnv,
-	emptyVarEnv, unitVarEnv, mkVarEnv,
-	elemVarEnv, varEnvElts, varEnvKeys,
-	extendVarEnv, extendVarEnv_C, extendVarEnvList,
-	plusVarEnv, plusVarEnv_C,
-	delVarEnvList, delVarEnv,
-	lookupVarEnv, lookupVarEnv_NF, lookupWithDefaultVarEnv,
-	mapVarEnv, zipVarEnv,
-	modifyVarEnv, modifyVarEnv_Directly,
-	isEmptyVarEnv, foldVarEnv, 
-	elemVarEnvByKey, lookupVarEnv_Directly,
-	filterVarEnv_Directly,
-
-	-- InScopeSet
-	InScopeSet, emptyInScopeSet, mkInScopeSet, delInScopeSet,
-	extendInScopeSet, extendInScopeSetList, modifyInScopeSet,
-	getInScopeVars, lookupInScope, elemInScopeSet, uniqAway, 
-	mapInScopeSet,
-
-	-- RnEnv2 and its operations
-	RnEnv2, mkRnEnv2, rnBndr2, rnBndrs2, rnOccL, rnOccR, inRnEnvL, inRnEnvR,
-		rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR,
-
-	-- TidyEnvs
-	TidyEnv, emptyTidyEnv
-    ) where
-
-#include "HsVersions.h"
-
-import OccName	  ( TidyOccEnv, emptyTidyOccEnv )
-import Var	  ( Var, setVarUnique )
-import VarSet
-import UniqFM  
-import Unique	  ( Unique, deriveUnique, getUnique )
-import Util	  ( zipEqual, foldl2 )
-import Maybes	  ( orElse, isJust )
-import StaticFlags( opt_PprStyle_Debug )
-import Outputable
-import FastTypes
-\end{code}
-
-
-%************************************************************************
-%*									*
-		In-scope sets
-%*									*
-%************************************************************************
-
-\begin{code}
-data InScopeSet = InScope (VarEnv Var) FastInt
-	-- The Int# is a kind of hash-value used by uniqAway
-	-- For example, it might be the size of the set
-	-- INVARIANT: it's not zero; we use it as a multiplier in uniqAway
-
-instance Outputable InScopeSet where
-  ppr (InScope s i) = ptext SLIT("InScope") <+> ppr s
-
-emptyInScopeSet :: InScopeSet
-emptyInScopeSet = InScope emptyVarSet 1#
-
-getInScopeVars ::  InScopeSet -> VarEnv Var
-getInScopeVars (InScope vs _) = vs
-
-mkInScopeSet :: VarEnv Var -> InScopeSet
-mkInScopeSet in_scope = InScope in_scope 1#
-
-extendInScopeSet :: InScopeSet -> Var -> InScopeSet
-extendInScopeSet (InScope in_scope n) v = InScope (extendVarEnv in_scope v v) (n +# 1#)
-
-extendInScopeSetList :: InScopeSet -> [Var] -> InScopeSet
-extendInScopeSetList (InScope in_scope n) vs
-   = InScope (foldl (\s v -> extendVarEnv s v v) in_scope vs)
-		    (n +# iUnbox (length vs))
-
-modifyInScopeSet :: InScopeSet -> Var -> Var -> InScopeSet
--- Exploit the fact that the in-scope "set" is really a map
--- 	Make old_v map to new_v
-modifyInScopeSet (InScope in_scope n) old_v new_v = InScope (extendVarEnv in_scope old_v new_v) (n +# 1#)
-
-delInScopeSet :: InScopeSet -> Var -> InScopeSet
-delInScopeSet (InScope in_scope n) v = InScope (in_scope `delVarEnv` v) n
-
-mapInScopeSet :: (Var -> Var) -> InScopeSet -> InScopeSet
-mapInScopeSet f (InScope in_scope n) = InScope (mapVarEnv f in_scope) n
-
-elemInScopeSet :: Var -> InScopeSet -> Bool
-elemInScopeSet v (InScope in_scope n) = v `elemVarEnv` in_scope
-
-lookupInScope :: InScopeSet -> Var -> Maybe Var
--- It's important to look for a fixed point
--- When we see (case x of y { I# v -> ... })
--- we add  [x -> y] to the in-scope set (Simplify.simplCaseBinder).
--- When we lookup up an occurrence of x, we map to y, but then
--- we want to look up y in case it has acquired more evaluation information by now.
-lookupInScope (InScope in_scope n) v 
-  = go v
-  where
-    go v = case lookupVarEnv in_scope v of
-		Just v' | v == v'   -> Just v'	-- Reached a fixed point
-			| otherwise -> go v'
-		Nothing		    -> Nothing
-\end{code}
-
-\begin{code}
-uniqAway :: InScopeSet -> Var -> Var
--- (uniqAway in_scope v) finds a unique that is not used in the
--- in-scope set, and gives that to v.  It starts with v's current unique, of course,
--- in the hope that it won't have to change it, and thereafter uses a combination
--- of that and the hash-code found in the in-scope set
-uniqAway in_scope var
-  | var `elemInScopeSet` in_scope = uniqAway' in_scope var	-- Make a new one
-  | otherwise 			  = var				-- Nothing to do
-
-uniqAway' :: InScopeSet -> Var -> Var
--- This one *always* makes up a new variable
-uniqAway' (InScope set n) var
-  = try 1#
-  where
-    orig_unique = getUnique var
-    try k 
-#ifdef DEBUG
-	  | k ># 1000#
-	  = pprPanic "uniqAway loop:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n)) 
-#endif			    
-	  | uniq `elemVarSetByKey` set = try (k +# 1#)
-#ifdef DEBUG
-	  | opt_PprStyle_Debug && k ># 3#
-	  = pprTrace "uniqAway:" (ppr (iBox k) <+> text "tries" <+> ppr var <+> int (iBox n)) 
-	    setVarUnique var uniq
-#endif			    
-	  | otherwise = setVarUnique var uniq
-	  where
-	    uniq = deriveUnique orig_unique (iBox (n *# k))
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Dual renaming
-%*									*
-%************************************************************************
-
-When we are comparing (or matching) types or terms, we are faced with 
-"going under" corresponding binders.  E.g. when comparing
-	\x. e1	~   \y. e2
-
-Basically we want to rename [x->y] or [y->x], but there are lots of 
-things we must be careful of.  In particular, x might be free in e2, or
-y in e1.  So the idea is that we come up with a fresh binder that is free
-in neither, and rename x and y respectively.  That means we must maintain
-	a) a renaming for the left-hand expression
-	b) a renaming for the right-hand expressions
-	c) an in-scope set
-
-Furthermore, when matching, we want to be able to have an 'occurs check',
-to prevent
-	\x. f   ~   \y. y
-matching with f->y.  So for each expression we want to know that set of
-locally-bound variables. That is precisely the domain of the mappings (a)
-and (b), but we must ensure that we always extend the mappings as we go in.
-
-
-\begin{code}
-data RnEnv2 
-  = RV2 { envL 	   :: VarEnv Var	-- Renaming for Left term
-	, envR 	   :: VarEnv Var	-- Renaming for Right term
-	, in_scope :: InScopeSet }	-- In scope in left or right terms
-
--- The renamings envL and envR are *guaranteed* to contain a binding
--- for every variable bound as we go into the term, even if it is not
--- renamed.  That way we can ask what variables are locally bound
--- (inRnEnvL, inRnEnvR)
-
-mkRnEnv2 :: InScopeSet -> RnEnv2
-mkRnEnv2 vars = RV2	{ envL 	   = emptyVarEnv 
-			, envR 	   = emptyVarEnv
-			, in_scope = vars }
-
-rnBndrs2 :: RnEnv2 -> [Var] -> [Var] -> RnEnv2
--- Arg lists must be of equal length
-rnBndrs2 env bsL bsR = foldl2 rnBndr2 env bsL bsR 
-
-rnBndr2 :: RnEnv2 -> Var -> Var -> RnEnv2
--- (rnBndr2 env bL bR) go under a binder bL in the Left term 1, 
--- 		       and binder bR in the Right term
--- It finds a new binder, new_b,
--- and returns an environment mapping bL->new_b and bR->new_b resp.
-rnBndr2 (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL bR
-  = RV2 { envL 	   = extendVarEnv envL bL new_b	  -- See Note
-	, envR 	   = extendVarEnv envR bR new_b	  -- [Rebinding]
-	, in_scope = extendInScopeSet in_scope new_b }
-  where
-	-- Find a new binder not in scope in either term
-    new_b | not (bL `elemInScopeSet` in_scope) = bL
-      	  | not (bR `elemInScopeSet` in_scope) = bR
-      	  | otherwise			       = uniqAway' in_scope bL
-
-	-- Note [Rebinding]
-	-- If the new var is the same as the old one, note that
-	-- the extendVarEnv *deletes* any current renaming
-	-- E.g.	  (\x. \x. ...)	 ~  (\y. \z. ...)
-	--
-	--   Inside \x  \y	{ [x->y], [y->y],       {y} }
-	-- 	 \x  \z	  	{ [x->x], [y->y, z->x], {y,x} }
-
-rnBndrL, rnBndrR :: RnEnv2 -> Var -> (RnEnv2, Var)
--- Used when there's a binder on one side or the other only
--- Useful when eta-expanding
-rnBndrL (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bL
-  = (RV2 { envL     = extendVarEnv envL bL new_b
-	 , envR     = envR
-	 , in_scope = extendInScopeSet in_scope new_b }, new_b)
-  where
-    new_b | not (bL `elemInScopeSet` in_scope) = bL
-      	  | otherwise			       = uniqAway' in_scope bL
-
-rnBndrR (RV2 { envL = envL, envR = envR, in_scope = in_scope }) bR
-  = (RV2 { envL     = envL
-	 , envR     = extendVarEnv envR bR new_b
-	 , in_scope = extendInScopeSet in_scope new_b }, new_b)
-  where
-    new_b | not (bR `elemInScopeSet` in_scope) = bR
-      	  | otherwise			       = uniqAway' in_scope bR
-
-rnOccL, rnOccR :: RnEnv2 -> Var -> Var
--- Look up the renaming of an occurrence in the left or right term
-rnOccL (RV2 { envL = env }) v = lookupVarEnv env v `orElse` v
-rnOccR (RV2 { envR = env }) v = lookupVarEnv env v `orElse` v
-
-inRnEnvL, inRnEnvR :: RnEnv2 -> Var -> Bool
--- Tells whether a variable is locally bound
-inRnEnvL (RV2 { envL = env }) v = isJust (lookupVarEnv env v)
-inRnEnvR (RV2 { envR = env }) v = isJust (lookupVarEnv env v)
-
-nukeRnEnvL, nukeRnEnvR :: RnEnv2 -> RnEnv2
-nukeRnEnvL env = env { envL = emptyVarEnv }
-nukeRnEnvR env = env { envR = emptyVarEnv }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Tidying
-%*									*
-%************************************************************************
-
-When tidying up print names, we keep a mapping of in-scope occ-names
-(the TidyOccEnv) and a Var-to-Var of the current renamings.
-
-\begin{code}
-type TidyEnv = (TidyOccEnv, VarEnv Var)
-
-emptyTidyEnv :: TidyEnv
-emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{@VarEnv@s}
-%*									*
-%************************************************************************
-
-\begin{code}
-type VarEnv elt   = UniqFM elt
-type IdEnv elt    = VarEnv elt
-type TyVarEnv elt = VarEnv elt
-
-emptyVarEnv	  :: VarEnv a
-mkVarEnv	  :: [(Var, a)] -> VarEnv a
-zipVarEnv	  :: [Var] -> [a] -> VarEnv a
-unitVarEnv	  :: Var -> a -> VarEnv a
-extendVarEnv	  :: VarEnv a -> Var -> a -> VarEnv a
-extendVarEnv_C	  :: (a->a->a) -> VarEnv a -> Var -> a -> VarEnv a
-plusVarEnv	  :: VarEnv a -> VarEnv a -> VarEnv a
-extendVarEnvList  :: VarEnv a -> [(Var, a)] -> VarEnv a
-		  
-lookupVarEnv_Directly :: VarEnv a -> Unique -> Maybe a
-filterVarEnv_Directly :: (Unique -> a -> Bool) -> VarEnv a -> VarEnv a
-delVarEnvList     :: VarEnv a -> [Var] -> VarEnv a
-delVarEnv	  :: VarEnv a -> Var -> VarEnv a
-plusVarEnv_C	  :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
-mapVarEnv	  :: (a -> b) -> VarEnv a -> VarEnv b
-modifyVarEnv	  :: (a -> a) -> VarEnv a -> Var -> VarEnv a
-varEnvElts	  :: VarEnv a -> [a]
-varEnvKeys	  :: VarEnv a -> [Unique]
-		  
-isEmptyVarEnv	  :: VarEnv a -> Bool
-lookupVarEnv	  :: VarEnv a -> Var -> Maybe a
-lookupVarEnv_NF   :: VarEnv a -> Var -> a
-lookupWithDefaultVarEnv :: VarEnv a -> a -> Var -> a
-elemVarEnv	  :: Var -> VarEnv a -> Bool
-elemVarEnvByKey   :: Unique -> VarEnv a -> Bool
-foldVarEnv	  :: (a -> b -> b) -> b -> VarEnv a -> b
-\end{code}
-
-\begin{code}
-elemVarEnv       = elemUFM
-elemVarEnvByKey  = elemUFM_Directly
-extendVarEnv	 = addToUFM
-extendVarEnv_C	 = addToUFM_C
-extendVarEnvList = addListToUFM
-plusVarEnv_C	 = plusUFM_C
-delVarEnvList	 = delListFromUFM
-delVarEnv	 = delFromUFM
-plusVarEnv	 = plusUFM
-lookupVarEnv	 = lookupUFM
-lookupWithDefaultVarEnv = lookupWithDefaultUFM
-mapVarEnv	 = mapUFM
-mkVarEnv	 = listToUFM
-emptyVarEnv	 = emptyUFM
-varEnvElts	 = eltsUFM
-varEnvKeys	 = keysUFM
-unitVarEnv	 = unitUFM
-isEmptyVarEnv	 = isNullUFM
-foldVarEnv	 = foldUFM
-lookupVarEnv_Directly = lookupUFM_Directly
-filterVarEnv_Directly = filterUFM_Directly
-
-zipVarEnv tyvars tys   = mkVarEnv (zipEqual "zipVarEnv" tyvars tys)
-lookupVarEnv_NF env id = case (lookupVarEnv env id) of { Just xx -> xx }
-\end{code}
-
-@modifyVarEnv@: Look up a thing in the VarEnv, 
-then mash it with the modify function, and put it back.
-
-\begin{code}
-modifyVarEnv mangle_fn env key
-  = case (lookupVarEnv env key) of
-      Nothing -> env
-      Just xx -> extendVarEnv env key (mangle_fn xx)
-
-modifyVarEnv_Directly mangle_fn env key
-  = case (lookupUFM_Directly env key) of
-      Nothing -> env
-      Just xx -> addToUFM_Directly env key (mangle_fn xx)
-\end{code}
diff --git a/ghc/compiler/basicTypes/VarSet.lhs b/ghc/compiler/basicTypes/VarSet.lhs
deleted file mode 100644
index 55e82a8515..0000000000
--- a/ghc/compiler/basicTypes/VarSet.lhs
+++ /dev/null
@@ -1,105 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section{@VarSet@: Variable sets}
-
-\begin{code}
-module VarSet (
-	VarSet, IdSet, TyVarSet,
-	emptyVarSet, unitVarSet, mkVarSet,
-	extendVarSet, extendVarSetList, extendVarSet_C,
-	elemVarSet, varSetElems, subVarSet,
-	unionVarSet, unionVarSets,
-	intersectVarSet, intersectsVarSet,
-	isEmptyVarSet, delVarSet, delVarSetList, delVarSetByKey,
-	minusVarSet, foldVarSet, filterVarSet,
-	lookupVarSet, mapVarSet, sizeVarSet, seqVarSet,
-	elemVarSetByKey
-    ) where
-
-#include "HsVersions.h"
-
-import Var		( Var, Id, TyVar )
-import Unique		( Unique )
-import UniqSet
-import UniqFM		( delFromUFM_Directly, addToUFM_C )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{@VarSet@s}
-%*									*
-%************************************************************************
-
-\begin{code}
-type VarSet       = UniqSet Var
-type IdSet 	  = UniqSet Id
-type TyVarSet	  = UniqSet TyVar
-
-emptyVarSet	:: VarSet
-intersectVarSet	:: VarSet -> VarSet -> VarSet
-unionVarSet	:: VarSet -> VarSet -> VarSet
-unionVarSets	:: [VarSet] -> VarSet
-varSetElems	:: VarSet -> [Var]
-unitVarSet	:: Var -> VarSet
-extendVarSet	:: VarSet -> Var -> VarSet
-extendVarSetList:: VarSet -> [Var] -> VarSet
-elemVarSet	:: Var -> VarSet -> Bool
-delVarSet	:: VarSet -> Var -> VarSet
-delVarSetList	:: VarSet -> [Var] -> VarSet
-minusVarSet	:: VarSet -> VarSet -> VarSet
-isEmptyVarSet	:: VarSet -> Bool
-mkVarSet	:: [Var] -> VarSet
-foldVarSet	:: (Var -> a -> a) -> a -> VarSet -> a
-lookupVarSet	:: VarSet -> Var -> Maybe Var
-			-- Returns the set element, which may be
-			-- (==) to the argument, but not the same as
-mapVarSet 	:: (Var -> Var) -> VarSet -> VarSet
-sizeVarSet	:: VarSet -> Int
-filterVarSet	:: (Var -> Bool) -> VarSet -> VarSet
-extendVarSet_C  :: (Var->Var->Var) -> VarSet -> Var -> VarSet
-
-delVarSetByKey	:: VarSet -> Unique -> VarSet
-elemVarSetByKey :: Unique -> VarSet -> Bool
-
-emptyVarSet	= emptyUniqSet
-unitVarSet	= unitUniqSet
-extendVarSet	= addOneToUniqSet
-extendVarSetList= addListToUniqSet
-intersectVarSet	= intersectUniqSets
-
-intersectsVarSet:: VarSet -> VarSet -> Bool 	-- True if non-empty intersection
-	-- (s1 `intersectsVarSet` s2) doesn't compute s2 if s1 is empty
-subVarSet	:: VarSet -> VarSet -> Bool	-- True if first arg is subset of second
- 	-- (s1 `subVarSet` s2) doesn't compute s2 if s1 is empty
-
-unionVarSet	= unionUniqSets
-unionVarSets	= unionManyUniqSets
-varSetElems	= uniqSetToList
-elemVarSet	= elementOfUniqSet
-minusVarSet	= minusUniqSet
-delVarSet	= delOneFromUniqSet
-delVarSetList	= delListFromUniqSet
-isEmptyVarSet	= isEmptyUniqSet
-mkVarSet	= mkUniqSet
-foldVarSet	= foldUniqSet
-lookupVarSet	= lookupUniqSet
-mapVarSet	= mapUniqSet
-sizeVarSet	= sizeUniqSet
-filterVarSet	= filterUniqSet
-extendVarSet_C combine s x = addToUFM_C combine s x x
-delVarSetByKey	= delFromUFM_Directly	-- Can't be bothered to add this to UniqSet
-elemVarSetByKey	= elemUniqSet_Directly
-\end{code}
-
-\begin{code}
--- See comments with type signatures
-intersectsVarSet s1 s2 = not (isEmptyVarSet (s1 `intersectVarSet` s2))
-a `subVarSet` b = isEmptyVarSet (a `minusVarSet` b)
-\end{code}
-
-\begin{code}
-seqVarSet :: VarSet -> ()
-seqVarSet s = sizeVarSet s `seq` ()
-\end{code}
-
diff --git a/ghc/compiler/cbits/rawSystem.c b/ghc/compiler/cbits/rawSystem.c
deleted file mode 100644
index d103f4808b..0000000000
--- a/ghc/compiler/cbits/rawSystem.c
+++ /dev/null
@@ -1,6 +0,0 @@
-/* Grab rawSystem from the library sources iff we're bootstrapping with an
- * old version of GHC.
- */
-#if __GLASGOW_HASKELL__ < 601
-#include "../../libraries/base/cbits/rawSystem.c"
-#endif
diff --git a/ghc/compiler/cmm/CLabel.hs b/ghc/compiler/cmm/CLabel.hs
deleted file mode 100644
index e42b92db5a..0000000000
--- a/ghc/compiler/cmm/CLabel.hs
+++ /dev/null
@@ -1,831 +0,0 @@
------------------------------------------------------------------------------
---
--- Object-file symbols (called CLabel for histerical raisins).
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
-module CLabel (
-	CLabel,	-- abstract type
-
-	mkClosureLabel,
-	mkSRTLabel,
-	mkSRTDescLabel,
-	mkInfoTableLabel,
-	mkEntryLabel,
-	mkSlowEntryLabel,
-	mkConEntryLabel,
-	mkStaticConEntryLabel,
-	mkRednCountsLabel,
-	mkConInfoTableLabel,
-	mkStaticInfoTableLabel,
-	mkApEntryLabel,
-	mkApInfoTableLabel,
-	mkClosureTableLabel,
-
-	mkLocalClosureLabel,
-	mkLocalInfoTableLabel,
-	mkLocalEntryLabel,
-	mkLocalConEntryLabel,
-	mkLocalStaticConEntryLabel,
-	mkLocalConInfoTableLabel,
-	mkLocalStaticInfoTableLabel,
-	mkLocalClosureTableLabel,
-
-	mkReturnPtLabel,
-	mkReturnInfoLabel,
-	mkAltLabel,
-	mkDefaultLabel,
-	mkBitmapLabel,
-	mkStringLitLabel,
-
-	mkAsmTempLabel,
-
-	mkModuleInitLabel,
-	mkPlainModuleInitLabel,
-
-	mkSplitMarkerLabel,
-	mkDirty_MUT_VAR_Label,
-	mkUpdInfoLabel,
-	mkSeqInfoLabel,
-	mkIndStaticInfoLabel,
-        mkMainCapabilityLabel,
-	mkMAP_FROZEN_infoLabel,
-	mkMAP_DIRTY_infoLabel,
-        mkEMPTY_MVAR_infoLabel,
-
-	mkTopTickyCtrLabel,
-        mkCAFBlackHoleInfoTableLabel,
-        mkSECAFBlackHoleInfoTableLabel,
-	mkRtsPrimOpLabel,
-	mkRtsSlowTickyCtrLabel,
-
-	moduleRegdLabel,
-
-	mkSelectorInfoLabel,
-	mkSelectorEntryLabel,
-
-	mkRtsInfoLabel,
-	mkRtsEntryLabel,
-	mkRtsRetInfoLabel,
-	mkRtsRetLabel,
-	mkRtsCodeLabel,
-	mkRtsDataLabel,
-
-	mkRtsInfoLabelFS,
-	mkRtsEntryLabelFS,
-	mkRtsRetInfoLabelFS,
-	mkRtsRetLabelFS,
-	mkRtsCodeLabelFS,
-	mkRtsDataLabelFS,
-
-	mkRtsApFastLabel,
-
-	mkForeignLabel,
-
-	mkCCLabel, mkCCSLabel,
-
-        DynamicLinkerLabelInfo(..),
-        mkDynamicLinkerLabel,
-        dynamicLinkerLabelInfo,
-        
-        mkPicBaseLabel,
-        mkDeadStripPreventer,
-
-	infoLblToEntryLbl, entryLblToInfoLbl,
-	needsCDecl, isAsmTemp, externallyVisibleCLabel,
-	CLabelType(..), labelType, labelDynamic,
-
-	pprCLabel
-    ) where
-
-
-#include "HsVersions.h"
-
-import Packages		( HomeModules )
-import StaticFlags	( opt_Static, opt_DoTickyProfiling )
-import Packages		( isHomeModule, isDllName )
-import DataCon		( ConTag )
-import Module		( moduleFS, Module )
-import Name		( Name, isExternalName )
-import Unique		( pprUnique, Unique )
-import PrimOp		( PrimOp )
-import Config		( cLeadingUnderscore )
-import CostCentre	( CostCentre, CostCentreStack )
-import Outputable
-import FastString
-
--- -----------------------------------------------------------------------------
--- The CLabel type
-
-{-
-CLabel is an abstract type that supports the following operations:
-
-  - Pretty printing
-
-  - In a C file, does it need to be declared before use?  (i.e. is it
-    guaranteed to be already in scope in the places we need to refer to it?)
-
-  - If it needs to be declared, what type (code or data) should it be
-    declared to have?
-
-  - Is it visible outside this object file or not?
-
-  - Is it "dynamic" (see details below)
-
-  - Eq and Ord, so that we can make sets of CLabels (currently only
-    used in outputting C as far as I can tell, to avoid generating
-    more than one declaration for any given label).
-
-  - Converting an info table label into an entry label.
--}
-
-data CLabel
-  = IdLabel	    		-- A family of labels related to the
-	Name			-- definition of a particular Id or Con
-	IdLabelInfo
-
-  | DynIdLabel			-- like IdLabel, but in a separate package,
-	Name			-- and might therefore need a dynamic
-	IdLabelInfo		-- reference.
-
-  | CaseLabel			-- A family of labels related to a particular
-				-- case expression.
-	{-# UNPACK #-} !Unique	-- Unique says which case expression
-	CaseLabelInfo
-
-  | AsmTempLabel 
-	{-# UNPACK #-} !Unique
-
-  | StringLitLabel
-	{-# UNPACK #-} !Unique
-
-  | ModuleInitLabel 
-	Module			-- the module name
-	String			-- its "way"
-	Bool			-- True <=> is in a different package
-	-- at some point we might want some kind of version number in
-	-- the module init label, to guard against compiling modules in
-	-- the wrong order.  We can't use the interface file version however,
-	-- because we don't always recompile modules which depend on a module
-	-- whose version has changed.
-
-  | PlainModuleInitLabel	-- without the vesrion & way info
-	Module
-	Bool			-- True <=> is in a different package
-
-  | ModuleRegdLabel
-
-  | RtsLabel RtsLabelInfo
-
-  | ForeignLabel FastString	-- a 'C' (or otherwise foreign) label
-	(Maybe Int) 		-- possible '@n' suffix for stdcall functions
-		-- When generating C, the '@n' suffix is omitted, but when
-		-- generating assembler we must add it to the label.
-	Bool			-- True <=> is dynamic
-
-  | CC_Label  CostCentre
-  | CCS_Label CostCentreStack
-
-      -- Dynamic Linking in the NCG:
-      -- generated and used inside the NCG only,
-      -- see module PositionIndependentCode for details.
-      
-  | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
-        -- special variants of a label used for dynamic linking
-
-  | PicBaseLabel                -- a label used as a base for PIC calculations
-                                -- on some platforms.
-                                -- It takes the form of a local numeric
-                                -- assembler label '1'; it is pretty-printed
-                                -- as 1b, referring to the previous definition
-                                -- of 1: in the assembler source file.
-
-  | DeadStripPreventer CLabel
-    -- label before an info table to prevent excessive dead-stripping on darwin
-
-  deriving (Eq, Ord)
-
-data IdLabelInfo
-  = Closure		-- Label for closure
-  | SRT                 -- Static reference table
-  | SRTDesc             -- Static reference table descriptor
-  | InfoTable		-- Info tables for closures; always read-only
-  | Entry		-- entry point
-  | Slow		-- slow entry point
-
-  | RednCounts		-- Label of place to keep Ticky-ticky  info for 
-			-- this Id
-
-  | Bitmap		-- A bitmap (function or case return)
-
-  | ConEntry	  	-- constructor entry point
-  | ConInfoTable 		-- corresponding info table
-  | StaticConEntry  	-- static constructor entry point
-  | StaticInfoTable   	-- corresponding info table
-
-  | ClosureTable	-- table of closures for Enum tycons
-
-  deriving (Eq, Ord)
-
-
-data CaseLabelInfo
-  = CaseReturnPt
-  | CaseReturnInfo
-  | CaseAlt ConTag
-  | CaseDefault
-  deriving (Eq, Ord)
-
-
-data RtsLabelInfo
-  = RtsSelectorInfoTable Bool{-updatable-} Int{-offset-}	-- Selector thunks
-  | RtsSelectorEntry   Bool{-updatable-} Int{-offset-}
-
-  | RtsApInfoTable Bool{-updatable-} Int{-arity-}	        -- AP thunks
-  | RtsApEntry   Bool{-updatable-} Int{-arity-}
-
-  | RtsPrimOp PrimOp
-
-  | RtsInfo       LitString	-- misc rts info tables
-  | RtsEntry      LitString	-- misc rts entry points
-  | RtsRetInfo    LitString	-- misc rts ret info tables
-  | RtsRet        LitString	-- misc rts return points
-  | RtsData       LitString	-- misc rts data bits, eg CHARLIKE_closure
-  | RtsCode       LitString	-- misc rts code
-
-  | RtsInfoFS     FastString	-- misc rts info tables
-  | RtsEntryFS    FastString	-- misc rts entry points
-  | RtsRetInfoFS  FastString	-- misc rts ret info tables
-  | RtsRetFS      FastString	-- misc rts return points
-  | RtsDataFS     FastString	-- misc rts data bits, eg CHARLIKE_closure
-  | RtsCodeFS     FastString	-- misc rts code
-
-  | RtsApFast	LitString	-- _fast versions of generic apply
-
-  | RtsSlowTickyCtr String
-
-  deriving (Eq, Ord)
-	-- NOTE: Eq on LitString compares the pointer only, so this isn't
-	-- a real equality.
-
-data DynamicLinkerLabelInfo
-  = CodeStub            -- MachO: Lfoo$stub, ELF: foo@plt
-  | SymbolPtr           -- MachO: Lfoo$non_lazy_ptr, Windows: __imp_foo
-  | GotSymbolPtr        -- ELF: foo@got
-  | GotSymbolOffset     -- ELF: foo@gotoff
-  
-  deriving (Eq, Ord)
-  
--- -----------------------------------------------------------------------------
--- Constructing CLabels
-
--- These are always local:
-mkSRTLabel		name 	= IdLabel name  SRT
-mkSRTDescLabel		name 	= IdLabel name  SRTDesc
-mkSlowEntryLabel      	name 	= IdLabel name  Slow
-mkBitmapLabel   	name 	= IdLabel name  Bitmap
-mkRednCountsLabel     	name 	= IdLabel name  RednCounts
-
--- These have local & (possibly) external variants:
-mkLocalClosureLabel	name 	= IdLabel name  Closure
-mkLocalInfoTableLabel  	name 	= IdLabel name  InfoTable
-mkLocalEntryLabel	name 	= IdLabel name  Entry
-mkLocalClosureTableLabel name	= IdLabel name ClosureTable
-
-mkClosureLabel hmods name
-  | isDllName hmods name = DynIdLabel    name Closure
-  | otherwise             = IdLabel name Closure
-
-mkInfoTableLabel hmods name
-  | isDllName hmods name = DynIdLabel    name InfoTable
-  | otherwise		 = IdLabel name InfoTable
-
-mkEntryLabel hmods name
-  | isDllName hmods name = DynIdLabel    name Entry
-  | otherwise             = IdLabel name Entry
-
-mkClosureTableLabel hmods name
-  | isDllName hmods name = DynIdLabel    name ClosureTable
-  | otherwise             = IdLabel name ClosureTable
-
-mkLocalConInfoTableLabel     con = IdLabel con ConInfoTable
-mkLocalConEntryLabel	     con = IdLabel con ConEntry
-mkLocalStaticInfoTableLabel  con = IdLabel con StaticInfoTable
-mkLocalStaticConEntryLabel   con = IdLabel con StaticConEntry
-
-mkConInfoTableLabel name False = IdLabel    name ConInfoTable
-mkConInfoTableLabel name True  = DynIdLabel name ConInfoTable
-
-mkStaticInfoTableLabel name False = IdLabel    name StaticInfoTable
-mkStaticInfoTableLabel name True  = DynIdLabel name StaticInfoTable
-
-mkConEntryLabel hmods name
-  | isDllName hmods name = DynIdLabel    name ConEntry
-  | otherwise             = IdLabel name ConEntry
-
-mkStaticConEntryLabel hmods name
-  | isDllName hmods name = DynIdLabel    name StaticConEntry
-  | otherwise             = IdLabel name StaticConEntry
-
-
-mkReturnPtLabel uniq		= CaseLabel uniq CaseReturnPt
-mkReturnInfoLabel uniq		= CaseLabel uniq CaseReturnInfo
-mkAltLabel      uniq tag	= CaseLabel uniq (CaseAlt tag)
-mkDefaultLabel  uniq 		= CaseLabel uniq CaseDefault
-
-mkStringLitLabel		= StringLitLabel
-mkAsmTempLabel 			= AsmTempLabel
-
-mkModuleInitLabel :: HomeModules -> Module -> String -> CLabel
-mkModuleInitLabel hmods mod way
-  = ModuleInitLabel mod way $! (not (isHomeModule hmods mod))
-
-mkPlainModuleInitLabel :: HomeModules -> Module -> CLabel
-mkPlainModuleInitLabel hmods mod
-  = PlainModuleInitLabel mod $! (not (isHomeModule hmods mod))
-
-	-- Some fixed runtime system labels
-
-mkSplitMarkerLabel		= RtsLabel (RtsCode SLIT("__stg_split_marker"))
-mkDirty_MUT_VAR_Label		= RtsLabel (RtsCode SLIT("dirty_MUT_VAR"))
-mkUpdInfoLabel			= RtsLabel (RtsInfo SLIT("stg_upd_frame"))
-mkSeqInfoLabel			= RtsLabel (RtsInfo SLIT("stg_seq_frame"))
-mkIndStaticInfoLabel		= RtsLabel (RtsInfo SLIT("stg_IND_STATIC"))
-mkMainCapabilityLabel		= RtsLabel (RtsData SLIT("MainCapability"))
-mkMAP_FROZEN_infoLabel		= RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_FROZEN0"))
-mkMAP_DIRTY_infoLabel		= RtsLabel (RtsInfo SLIT("stg_MUT_ARR_PTRS_DIRTY"))
-mkEMPTY_MVAR_infoLabel		= RtsLabel (RtsInfo SLIT("stg_EMPTY_MVAR"))
-
-mkTopTickyCtrLabel		= RtsLabel (RtsData SLIT("top_ct"))
-mkCAFBlackHoleInfoTableLabel	= RtsLabel (RtsInfo SLIT("stg_CAF_BLACKHOLE"))
-mkSECAFBlackHoleInfoTableLabel	= if opt_DoTickyProfiling then
-                                    RtsLabel (RtsInfo SLIT("stg_SE_CAF_BLACKHOLE"))
-                                  else  -- RTS won't have info table unless -ticky is on
-                                    panic "mkSECAFBlackHoleInfoTableLabel requires -ticky"
-mkRtsPrimOpLabel primop		= RtsLabel (RtsPrimOp primop)
-
-moduleRegdLabel			= ModuleRegdLabel
-
-mkSelectorInfoLabel  upd off	= RtsLabel (RtsSelectorInfoTable upd off)
-mkSelectorEntryLabel upd off	= RtsLabel (RtsSelectorEntry   upd off)
-
-mkApInfoTableLabel  upd off	= RtsLabel (RtsApInfoTable upd off)
-mkApEntryLabel upd off		= RtsLabel (RtsApEntry   upd off)
-
-	-- Foreign labels
-
-mkForeignLabel :: FastString -> Maybe Int -> Bool -> CLabel
-mkForeignLabel str mb_sz  is_dynamic = ForeignLabel str mb_sz is_dynamic
-
-	-- Cost centres etc.
-
-mkCCLabel	cc		= CC_Label cc
-mkCCSLabel	ccs		= CCS_Label ccs
-
-mkRtsInfoLabel      str = RtsLabel (RtsInfo      str)
-mkRtsEntryLabel     str = RtsLabel (RtsEntry     str)
-mkRtsRetInfoLabel   str = RtsLabel (RtsRetInfo   str)
-mkRtsRetLabel       str = RtsLabel (RtsRet       str)
-mkRtsCodeLabel      str = RtsLabel (RtsCode      str)
-mkRtsDataLabel      str = RtsLabel (RtsData      str)
-
-mkRtsInfoLabelFS    str = RtsLabel (RtsInfoFS    str)
-mkRtsEntryLabelFS   str = RtsLabel (RtsEntryFS   str)
-mkRtsRetInfoLabelFS str = RtsLabel (RtsRetInfoFS str)
-mkRtsRetLabelFS     str = RtsLabel (RtsRetFS     str)
-mkRtsCodeLabelFS    str = RtsLabel (RtsCodeFS    str)
-mkRtsDataLabelFS    str = RtsLabel (RtsDataFS    str)
-
-mkRtsApFastLabel str = RtsLabel (RtsApFast str)
-
-mkRtsSlowTickyCtrLabel :: String -> CLabel
-mkRtsSlowTickyCtrLabel pat = RtsLabel (RtsSlowTickyCtr pat)
-
-        -- Dynamic linking
-        
-mkDynamicLinkerLabel :: DynamicLinkerLabelInfo -> CLabel -> CLabel
-mkDynamicLinkerLabel = DynamicLinkerLabel
-
-dynamicLinkerLabelInfo :: CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
-dynamicLinkerLabelInfo (DynamicLinkerLabel info lbl) = Just (info, lbl)
-dynamicLinkerLabelInfo _ = Nothing
-
-        -- Position independent code
-        
-mkPicBaseLabel :: CLabel
-mkPicBaseLabel = PicBaseLabel
-
-mkDeadStripPreventer :: CLabel -> CLabel
-mkDeadStripPreventer lbl = DeadStripPreventer lbl
-
--- -----------------------------------------------------------------------------
--- Converting info labels to entry labels.
-
-infoLblToEntryLbl :: CLabel -> CLabel 
-infoLblToEntryLbl (IdLabel n InfoTable) = IdLabel n Entry
-infoLblToEntryLbl (IdLabel n ConInfoTable) = IdLabel n ConEntry
-infoLblToEntryLbl (IdLabel n StaticInfoTable) = IdLabel n StaticConEntry
-infoLblToEntryLbl (DynIdLabel n InfoTable) = DynIdLabel n Entry
-infoLblToEntryLbl (DynIdLabel n ConInfoTable) = DynIdLabel n ConEntry
-infoLblToEntryLbl (DynIdLabel n StaticInfoTable) = DynIdLabel n StaticConEntry
-infoLblToEntryLbl (CaseLabel n CaseReturnInfo) = CaseLabel n CaseReturnPt
-infoLblToEntryLbl (RtsLabel (RtsInfo s)) = RtsLabel (RtsEntry s)
-infoLblToEntryLbl (RtsLabel (RtsRetInfo s)) = RtsLabel (RtsRet s)
-infoLblToEntryLbl (RtsLabel (RtsInfoFS s)) = RtsLabel (RtsEntryFS s)
-infoLblToEntryLbl (RtsLabel (RtsRetInfoFS s)) = RtsLabel (RtsRetFS s)
-infoLblToEntryLbl _ = panic "CLabel.infoLblToEntryLbl"
-
-entryLblToInfoLbl :: CLabel -> CLabel 
-entryLblToInfoLbl (IdLabel n Entry) = IdLabel n InfoTable
-entryLblToInfoLbl (IdLabel n ConEntry) = IdLabel n ConInfoTable
-entryLblToInfoLbl (IdLabel n StaticConEntry) = IdLabel n StaticInfoTable
-entryLblToInfoLbl (DynIdLabel n Entry) = DynIdLabel n InfoTable
-entryLblToInfoLbl (DynIdLabel n ConEntry) = DynIdLabel n ConInfoTable
-entryLblToInfoLbl (DynIdLabel n StaticConEntry) = DynIdLabel n StaticInfoTable
-entryLblToInfoLbl (CaseLabel n CaseReturnPt) = CaseLabel n CaseReturnInfo
-entryLblToInfoLbl (RtsLabel (RtsEntry s)) = RtsLabel (RtsInfo s)
-entryLblToInfoLbl (RtsLabel (RtsRet s)) = RtsLabel (RtsRetInfo s)
-entryLblToInfoLbl (RtsLabel (RtsEntryFS s)) = RtsLabel (RtsInfoFS s)
-entryLblToInfoLbl (RtsLabel (RtsRetFS s)) = RtsLabel (RtsRetInfoFS s)
-entryLblToInfoLbl l = pprPanic "CLabel.entryLblToInfoLbl" (pprCLabel l)
-
--- -----------------------------------------------------------------------------
--- Does a CLabel need declaring before use or not?
-
-needsCDecl :: CLabel -> Bool
-  -- False <=> it's pre-declared; don't bother
-  -- don't bother declaring SRT & Bitmap labels, we always make sure
-  -- they are defined before use.
-needsCDecl (IdLabel _ SRT)		= False
-needsCDecl (IdLabel _ SRTDesc)		= False
-needsCDecl (IdLabel _ Bitmap)		= False
-needsCDecl (IdLabel _ _)		= True
-needsCDecl (DynIdLabel _ _)		= True
-needsCDecl (CaseLabel _ _)	        = True
-needsCDecl (ModuleInitLabel _ _ _)	= True
-needsCDecl (PlainModuleInitLabel _ _)	= True
-needsCDecl ModuleRegdLabel		= False
-
-needsCDecl (StringLitLabel _)		= False
-needsCDecl (AsmTempLabel _)		= False
-needsCDecl (RtsLabel _)			= False
-needsCDecl (ForeignLabel _ _ _)		= False
-needsCDecl (CC_Label _)			= True
-needsCDecl (CCS_Label _)		= True
-
--- Whether the label is an assembler temporary:
-
-isAsmTemp  :: CLabel -> Bool    -- is a local temporary for native code generation
-isAsmTemp (AsmTempLabel _) = True
-isAsmTemp _ 	    	   = False
-
--- -----------------------------------------------------------------------------
--- Is a CLabel visible outside this object file or not?
-
--- From the point of view of the code generator, a name is
--- externally visible if it has to be declared as exported
--- in the .o file's symbol table; that is, made non-static.
-
-externallyVisibleCLabel :: CLabel -> Bool -- not C "static"
-externallyVisibleCLabel (CaseLabel _ _)	   = False
-externallyVisibleCLabel (StringLitLabel _) = False
-externallyVisibleCLabel (AsmTempLabel _)   = False
-externallyVisibleCLabel (ModuleInitLabel _ _ _)= True
-externallyVisibleCLabel (PlainModuleInitLabel _ _)= True
-externallyVisibleCLabel ModuleRegdLabel    = False
-externallyVisibleCLabel (RtsLabel _)	   = True
-externallyVisibleCLabel (ForeignLabel _ _ _) = True
-externallyVisibleCLabel (IdLabel name _)     = isExternalName name
-externallyVisibleCLabel (DynIdLabel name _)  = isExternalName name
-externallyVisibleCLabel (CC_Label _)	   = True
-externallyVisibleCLabel (CCS_Label _)	   = True
-externallyVisibleCLabel (DynamicLinkerLabel _ _)  = False
-
--- -----------------------------------------------------------------------------
--- Finding the "type" of a CLabel 
-
--- For generating correct types in label declarations:
-
-data CLabelType
-  = CodeLabel
-  | DataLabel
-
-labelType :: CLabel -> CLabelType
-labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel
-labelType (RtsLabel (RtsApInfoTable _ _))       = DataLabel
-labelType (RtsLabel (RtsData _))              = DataLabel
-labelType (RtsLabel (RtsCode _))              = CodeLabel
-labelType (RtsLabel (RtsInfo _))              = DataLabel
-labelType (RtsLabel (RtsEntry _))             = CodeLabel
-labelType (RtsLabel (RtsRetInfo _))           = DataLabel
-labelType (RtsLabel (RtsRet _))               = CodeLabel
-labelType (RtsLabel (RtsDataFS _))            = DataLabel
-labelType (RtsLabel (RtsCodeFS _))            = CodeLabel
-labelType (RtsLabel (RtsInfoFS _))            = DataLabel
-labelType (RtsLabel (RtsEntryFS _))           = CodeLabel
-labelType (RtsLabel (RtsRetInfoFS _))         = DataLabel
-labelType (RtsLabel (RtsRetFS _))             = CodeLabel
-labelType (RtsLabel (RtsApFast _))            = CodeLabel
-labelType (CaseLabel _ CaseReturnInfo)        = DataLabel
-labelType (CaseLabel _ _)	              = CodeLabel
-labelType (ModuleInitLabel _ _ _)             = CodeLabel
-labelType (PlainModuleInitLabel _ _)          = CodeLabel
-
-labelType (IdLabel _ info) = idInfoLabelType info
-labelType (DynIdLabel _ info) = idInfoLabelType info
-labelType _        = DataLabel
-
-idInfoLabelType info =
-  case info of
-    InfoTable  	  -> DataLabel
-    Closure    	  -> DataLabel
-    Bitmap     	  -> DataLabel
-    ConInfoTable  -> DataLabel
-    StaticInfoTable -> DataLabel
-    ClosureTable  -> DataLabel
-    _	          -> CodeLabel
-
-
--- -----------------------------------------------------------------------------
--- Does a CLabel need dynamic linkage?
-
--- When referring to data in code, we need to know whether
--- that data resides in a DLL or not. [Win32 only.]
--- @labelDynamic@ returns @True@ if the label is located
--- in a DLL, be it a data reference or not.
-
-labelDynamic :: CLabel -> Bool
-labelDynamic lbl = 
-  case lbl of
-   RtsLabel _  	     -> not opt_Static  -- i.e., is the RTS in a DLL or not?
-   IdLabel n k       -> False
-   DynIdLabel n k    -> True
-#if mingw32_TARGET_OS
-   ForeignLabel _ _ d  -> d
-#else
-   -- On Mac OS X and on ELF platforms, false positives are OK,
-   -- so we claim that all foreign imports come from dynamic libraries
-   ForeignLabel _ _ _ -> True
-#endif
-   ModuleInitLabel m _ dyn    -> not opt_Static && dyn
-   PlainModuleInitLabel m dyn -> not opt_Static && dyn
-   
-   -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
-   _ 		     -> False
-
-{-
-OLD?: These GRAN functions are needed for spitting out GRAN_FETCH() at the
-right places. It is used to detect when the abstractC statement of an
-CCodeBlock actually contains the code for a slow entry point.  -- HWL
-
-We need at least @Eq@ for @CLabels@, because we want to avoid
-duplicate declarations in generating C (see @labelSeenTE@ in
-@PprAbsC@).
--}
-
------------------------------------------------------------------------------
--- Printing out CLabels.
-
-{-
-Convention:
-
-      <name>_<type>
-
-where <name> is <Module>_<name> for external names and <unique> for
-internal names. <type> is one of the following:
-
-	 info			Info table
-	 srt			Static reference table
-	 srtd			Static reference table descriptor
-	 entry			Entry code (function, closure)
-	 slow			Slow entry code (if any)
-	 ret			Direct return address	 
-	 vtbl			Vector table
-	 <n>_alt		Case alternative (tag n)
-	 dflt			Default case alternative
-	 btm			Large bitmap vector
-	 closure		Static closure
-	 con_entry		Dynamic Constructor entry code
-	 con_info		Dynamic Constructor info table
-	 static_entry		Static Constructor entry code
-	 static_info		Static Constructor info table
-	 sel_info		Selector info table
-	 sel_entry		Selector entry code
-	 cc			Cost centre
-	 ccs			Cost centre stack
-
-Many of these distinctions are only for documentation reasons.  For
-example, _ret is only distinguished from _entry to make it easy to
-tell whether a code fragment is a return point or a closure/function
-entry.
--}
-
-instance Outputable CLabel where
-  ppr = pprCLabel
-
-pprCLabel :: CLabel -> SDoc
-
-#if ! OMIT_NATIVE_CODEGEN
-pprCLabel (AsmTempLabel u)
-  =  getPprStyle $ \ sty ->
-     if asmStyle sty then 
-	ptext asmTempLabelPrefix <> pprUnique u
-     else
-	char '_' <> pprUnique u
-
-pprCLabel (DynamicLinkerLabel info lbl)
-   = pprDynamicLinkerAsmLabel info lbl
-   
-pprCLabel PicBaseLabel
-   = ptext SLIT("1b")
-   
-pprCLabel (DeadStripPreventer lbl)
-   = pprCLabel lbl <> ptext SLIT("_dsp")
-#endif
-
-pprCLabel lbl = 
-#if ! OMIT_NATIVE_CODEGEN
-    getPprStyle $ \ sty ->
-    if asmStyle sty then 
-	maybe_underscore (pprAsmCLbl lbl)
-    else
-#endif
-       pprCLbl lbl
-
-maybe_underscore doc
-  | underscorePrefix = pp_cSEP <> doc
-  | otherwise        = doc
-
-#ifdef mingw32_TARGET_OS
--- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
--- (The C compiler does this itself).
-pprAsmCLbl (ForeignLabel fs (Just sz) _)
-   = ftext fs <> char '@' <> int sz
-#endif
-pprAsmCLbl lbl
-   = pprCLbl lbl
-
-pprCLbl (StringLitLabel u)
-  = pprUnique u <> ptext SLIT("_str")
-
-pprCLbl (CaseLabel u CaseReturnPt)
-  = hcat [pprUnique u, ptext SLIT("_ret")]
-pprCLbl (CaseLabel u CaseReturnInfo)
-  = hcat [pprUnique u, ptext SLIT("_info")]
-pprCLbl (CaseLabel u (CaseAlt tag))
-  = hcat [pprUnique u, pp_cSEP, int tag, ptext SLIT("_alt")]
-pprCLbl (CaseLabel u CaseDefault)
-  = hcat [pprUnique u, ptext SLIT("_dflt")]
-
-pprCLbl (RtsLabel (RtsCode str))   = ptext str
-pprCLbl (RtsLabel (RtsData str))   = ptext str
-pprCLbl (RtsLabel (RtsCodeFS str)) = ftext str
-pprCLbl (RtsLabel (RtsDataFS str)) = ftext str
-
-pprCLbl (RtsLabel (RtsApFast str)) = ptext str <> ptext SLIT("_fast")
-
-pprCLbl (RtsLabel (RtsSelectorInfoTable upd_reqd offset))
-  = hcat [ptext SLIT("stg_sel_"), text (show offset),
-		ptext (if upd_reqd 
-			then SLIT("_upd_info") 
-			else SLIT("_noupd_info"))
-	]
-
-pprCLbl (RtsLabel (RtsSelectorEntry upd_reqd offset))
-  = hcat [ptext SLIT("stg_sel_"), text (show offset),
-		ptext (if upd_reqd 
-			then SLIT("_upd_entry") 
-			else SLIT("_noupd_entry"))
-	]
-
-pprCLbl (RtsLabel (RtsApInfoTable upd_reqd arity))
-  = hcat [ptext SLIT("stg_ap_"), text (show arity),
-		ptext (if upd_reqd 
-			then SLIT("_upd_info") 
-			else SLIT("_noupd_info"))
-	]
-
-pprCLbl (RtsLabel (RtsApEntry upd_reqd arity))
-  = hcat [ptext SLIT("stg_ap_"), text (show arity),
-		ptext (if upd_reqd 
-			then SLIT("_upd_entry") 
-			else SLIT("_noupd_entry"))
-	]
-
-pprCLbl (RtsLabel (RtsInfo fs))
-  = ptext fs <> ptext SLIT("_info")
-
-pprCLbl (RtsLabel (RtsEntry fs))
-  = ptext fs <> ptext SLIT("_entry")
-
-pprCLbl (RtsLabel (RtsRetInfo fs))
-  = ptext fs <> ptext SLIT("_info")
-
-pprCLbl (RtsLabel (RtsRet fs))
-  = ptext fs <> ptext SLIT("_ret")
-
-pprCLbl (RtsLabel (RtsInfoFS fs))
-  = ftext fs <> ptext SLIT("_info")
-
-pprCLbl (RtsLabel (RtsEntryFS fs))
-  = ftext fs <> ptext SLIT("_entry")
-
-pprCLbl (RtsLabel (RtsRetInfoFS fs))
-  = ftext fs <> ptext SLIT("_info")
-
-pprCLbl (RtsLabel (RtsRetFS fs))
-  = ftext fs <> ptext SLIT("_ret")
-
-pprCLbl (RtsLabel (RtsPrimOp primop)) 
-  = ppr primop <> ptext SLIT("_fast")
-
-pprCLbl (RtsLabel (RtsSlowTickyCtr pat)) 
-  = ptext SLIT("SLOW_CALL_") <> text pat <> ptext SLIT("_ctr")
-
-pprCLbl ModuleRegdLabel
-  = ptext SLIT("_module_registered")
-
-pprCLbl (ForeignLabel str _ _)
-  = ftext str
-
-pprCLbl (IdLabel name  flavor) = ppr name <> ppIdFlavor flavor
-pprCLbl (DynIdLabel name  flavor) = ppr name <> ppIdFlavor flavor
-
-pprCLbl (CC_Label cc) 		= ppr cc
-pprCLbl (CCS_Label ccs) 	= ppr ccs
-
-pprCLbl (ModuleInitLabel mod way _)	
-   = ptext SLIT("__stginit_") <> ppr mod
-	<> char '_' <> text way
-pprCLbl (PlainModuleInitLabel mod _)	
-   = ptext SLIT("__stginit_") <> ppr mod
-
-ppIdFlavor :: IdLabelInfo -> SDoc
-ppIdFlavor x = pp_cSEP <>
-	       (case x of
-		       Closure	    	-> ptext SLIT("closure")
-		       SRT		-> ptext SLIT("srt")
-		       SRTDesc		-> ptext SLIT("srtd")
-		       InfoTable    	-> ptext SLIT("info")
-		       Entry	    	-> ptext SLIT("entry")
-		       Slow	    	-> ptext SLIT("slow")
-		       RednCounts	-> ptext SLIT("ct")
-		       Bitmap		-> ptext SLIT("btm")
-		       ConEntry	    	-> ptext SLIT("con_entry")
-		       ConInfoTable    	-> ptext SLIT("con_info")
-		       StaticConEntry  	-> ptext SLIT("static_entry")
-		       StaticInfoTable 	-> ptext SLIT("static_info")
-		       ClosureTable     -> ptext SLIT("closure_tbl")
-		      )
-
-
-pp_cSEP = char '_'
-
--- -----------------------------------------------------------------------------
--- Machine-dependent knowledge about labels.
-
-underscorePrefix :: Bool   -- leading underscore on assembler labels?
-underscorePrefix = (cLeadingUnderscore == "YES")
-
-asmTempLabelPrefix :: LitString  -- for formatting labels
-asmTempLabelPrefix =
-#if alpha_TARGET_OS
-     {- The alpha assembler likes temporary labels to look like $L123
-	instead of L123.  (Don't toss the L, because then Lf28
-	turns into $f28.)
-     -}
-     SLIT("$")
-#elif darwin_TARGET_OS
-     SLIT("L")
-#else
-     SLIT(".L")
-#endif
-
-pprDynamicLinkerAsmLabel :: DynamicLinkerLabelInfo -> CLabel -> SDoc
-
-#if darwin_TARGET_OS
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = char 'L' <> pprCLabel lbl <> text "$non_lazy_ptr"
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = char 'L' <> pprCLabel lbl <> text "$stub"
-#elif powerpc_TARGET_ARCH && linux_TARGET_OS
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = pprCLabel lbl <> text "@plt"
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = text ".LC_" <> pprCLabel lbl
-#elif linux_TARGET_OS
-pprDynamicLinkerAsmLabel CodeStub lbl
-  = pprCLabel lbl <> text "@plt"
-pprDynamicLinkerAsmLabel GotSymbolPtr lbl
-  = pprCLabel lbl <> text "@got"
-pprDynamicLinkerAsmLabel GotSymbolOffset lbl
-  = pprCLabel lbl <> text "@gotoff"
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = text ".LC_" <> pprCLabel lbl
-#elif mingw32_TARGET_OS
-pprDynamicLinkerAsmLabel SymbolPtr lbl
-  = text "__imp_" <> pprCLabel lbl
-#endif
-pprDynamicLinkerAsmLabel _ _
-  = panic "pprDynamicLinkerAsmLabel"
diff --git a/ghc/compiler/cmm/Cmm.hs b/ghc/compiler/cmm/Cmm.hs
deleted file mode 100644
index 13961c15d3..0000000000
--- a/ghc/compiler/cmm/Cmm.hs
+++ /dev/null
@@ -1,322 +0,0 @@
------------------------------------------------------------------------------
---
--- Cmm data types
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
-module Cmm ( 
-	GenCmm(..), Cmm,
-	GenCmmTop(..), CmmTop,
-	GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts,
-	CmmStmt(..),  
-	CmmCallTarget(..),
-	CmmStatic(..), Section(..),
-	CmmExpr(..), cmmExprRep, 
-	CmmReg(..), cmmRegRep,
-	CmmLit(..), cmmLitRep,
-	LocalReg(..), localRegRep,
-	BlockId(..),
-	GlobalReg(..), globalRegRep,
-
-	node, nodeReg, spReg, hpReg,
-  ) where
-
-#include "HsVersions.h"
-
-import MachOp
-import CLabel		( CLabel )
-import ForeignCall	( CCallConv )
-import Unique		( Unique, Uniquable(..) )
-import FastString	( FastString )
-import DATA_WORD	( Word8 )
-
------------------------------------------------------------------------------
---		Cmm, CmmTop, CmmBasicBlock
------------------------------------------------------------------------------
-
--- A file is a list of top-level chunks.  These may be arbitrarily
--- re-orderd during code generation.
-
--- GenCmm is abstracted over
---   (a) the type of static data elements
---   (b) the contents of a basic block.
--- We expect there to be two main instances of this type:
---   (a) Plain C--, i.e. populated with CmmLit and CmmExpr respectively,
---   (b) Native code, populated with instructions
---
-newtype GenCmm d i = Cmm [GenCmmTop d i]
-
-type Cmm = GenCmm CmmStatic CmmStmt
-
--- A top-level chunk, abstracted over the type of the contents of
--- the basic blocks (Cmm or instructions are the likely instantiations).
-data GenCmmTop d i
-  = CmmProc
-     [d]	       -- Info table, may be empty
-     CLabel            -- Used to generate both info & entry labels
-     [LocalReg]        -- Argument locals live on entry (C-- procedure params)
-     [GenBasicBlock i] -- Code, may be empty.  The first block is
-                       -- the entry point.  The order is otherwise initially 
-                       -- unimportant, but at some point the code gen will
-                       -- fix the order.
-
-		       -- the BlockId of the first block does not give rise
-		       -- to a label.  To jump to the first block in a Proc,
-		       -- use the appropriate CLabel.
-
-  -- some static data.
-  | CmmData Section [d]	-- constant values only
-
-type CmmTop = GenCmmTop CmmStatic CmmStmt
-
--- A basic block containing a single label, at the beginning.
--- The list of basic blocks in a top-level code block may be re-ordered.
--- Fall-through is not allowed: there must be an explicit jump at the
--- end of each basic block, but the code generator might rearrange basic
--- blocks in order to turn some jumps into fallthroughs.
-
-data GenBasicBlock i = BasicBlock BlockId [i]
-  -- ToDo: Julian suggests that we might need to annotate this type
-  -- with the out & in edges in the graph, i.e. two * [BlockId].  This
-  -- information can be derived from the contents, but it might be
-  -- helpful to cache it here.
-
-type CmmBasicBlock = GenBasicBlock CmmStmt
-
-blockId :: GenBasicBlock i -> BlockId
--- The branch block id is that of the first block in 
--- the branch, which is that branch's entry point
-blockId (BasicBlock blk_id _ ) = blk_id
-
-blockStmts :: GenBasicBlock i -> [i]
-blockStmts (BasicBlock _ stmts) = stmts
-
-
------------------------------------------------------------------------------
---		CmmStmt
--- A "statement".  Note that all branches are explicit: there are no
--- control transfers to computed addresses, except when transfering
--- control to a new function.
------------------------------------------------------------------------------
-
-data CmmStmt
-  = CmmNop
-  | CmmComment FastString
-
-  | CmmAssign CmmReg CmmExpr	 -- Assign to register
-
-  | CmmStore CmmExpr CmmExpr     -- Assign to memory location.  Size is
-                                 -- given by cmmExprRep of the rhs.
-
-  | CmmCall	 		 -- A foreign call, with 
-     CmmCallTarget
-     [(CmmReg,MachHint)]	 -- zero or more results
-     [(CmmExpr,MachHint)]	 -- zero or more arguments
-     (Maybe [GlobalReg])	 -- Global regs that may need to be saved
-				 -- if they will be clobbered by the call.
-				 -- Nothing <=> save *all* globals that
-				 -- might be clobbered.
-
-  | CmmBranch BlockId             -- branch to another BB in this fn
-
-  | CmmCondBranch CmmExpr BlockId -- conditional branch
-
-  | CmmSwitch CmmExpr [Maybe BlockId]   -- Table branch
-	-- The scrutinee is zero-based; 
-	--	zero -> first block
-	--	one  -> second block etc
-	-- Undefined outside range, and when there's a Nothing
-
-  | CmmJump CmmExpr [LocalReg]    -- Jump to another function, with these 
-				  -- parameters.
-
------------------------------------------------------------------------------
---		CmmCallTarget
---
--- The target of a CmmCall.
------------------------------------------------------------------------------
-
-data CmmCallTarget
-  = CmmForeignCall		-- Call to a foreign function
-	CmmExpr 		-- literal label <=> static call
-				-- other expression <=> dynamic call
-	CCallConv		-- The calling convention
-
-  | CmmPrim			-- Call to a "primitive" (eg. sin, cos)
-	CallishMachOp		-- These might be implemented as inline
-				-- code by the backend.
-
------------------------------------------------------------------------------
---		CmmExpr
--- An expression.  Expressions have no side effects.
------------------------------------------------------------------------------
-
-data CmmExpr
-  = CmmLit CmmLit               -- Literal
-  | CmmLoad CmmExpr MachRep     -- Read memory location
-  | CmmReg CmmReg		-- Contents of register
-  | CmmMachOp MachOp [CmmExpr]  -- Machine operation (+, -, *, etc.)
-  | CmmRegOff CmmReg Int	
-	-- CmmRegOff reg i
-	--        ** is shorthand only, meaning **
-	-- CmmMachOp (MO_S_Add rep (CmmReg reg) (CmmLit (CmmInt i rep)))
-	--	where rep = cmmRegRep reg
-
-cmmExprRep :: CmmExpr -> MachRep
-cmmExprRep (CmmLit lit)      = cmmLitRep lit
-cmmExprRep (CmmLoad _ rep)   = rep
-cmmExprRep (CmmReg reg)      = cmmRegRep reg
-cmmExprRep (CmmMachOp op _)  = resultRepOfMachOp op
-cmmExprRep (CmmRegOff reg _) = cmmRegRep reg
-
-data CmmReg 
-  = CmmLocal  LocalReg
-  | CmmGlobal GlobalReg
-  deriving( Eq )
-
-cmmRegRep :: CmmReg -> MachRep
-cmmRegRep (CmmLocal  reg) 	= localRegRep reg
-cmmRegRep (CmmGlobal reg)	= globalRegRep reg
-
-data LocalReg
-  = LocalReg !Unique MachRep
-
-instance Eq LocalReg where
-  (LocalReg u1 _) == (LocalReg u2 _) = u1 == u2
-
-instance Uniquable LocalReg where
-  getUnique (LocalReg uniq _) = uniq
-
-localRegRep :: LocalReg -> MachRep
-localRegRep (LocalReg _ rep) = rep
-
-data CmmLit
-  = CmmInt Integer  MachRep
-	-- Interpretation: the 2's complement representation of the value
-	-- is truncated to the specified size.  This is easier than trying
-	-- to keep the value within range, because we don't know whether
-	-- it will be used as a signed or unsigned value (the MachRep doesn't
-	-- distinguish between signed & unsigned).
-  | CmmFloat  Rational MachRep
-  | CmmLabel    CLabel			-- Address of label
-  | CmmLabelOff CLabel Int		-- Address of label + byte offset
-  
-        -- Due to limitations in the C backend, the following
-        -- MUST ONLY be used inside the info table indicated by label2
-        -- (label2 must be the info label), and label1 must be an
-        -- SRT, a slow entrypoint or a large bitmap (see the Mangler)
-        -- Don't use it at all unless tablesNextToCode.
-        -- It is also used inside the NCG during when generating
-        -- position-independent code. 
-  | CmmLabelDiffOff CLabel CLabel Int   -- label1 - label2 + offset
-
-cmmLitRep :: CmmLit -> MachRep
-cmmLitRep (CmmInt _ rep)    = rep
-cmmLitRep (CmmFloat _ rep)  = rep
-cmmLitRep (CmmLabel _)      = wordRep
-cmmLitRep (CmmLabelOff _ _) = wordRep
-cmmLitRep (CmmLabelDiffOff _ _ _) = wordRep
-
------------------------------------------------------------------------------
--- A local label.
-
--- Local labels must be unique within a single compilation unit.
-
-newtype BlockId = BlockId Unique
-  deriving (Eq,Ord)
-
-instance Uniquable BlockId where
-  getUnique (BlockId u) = u
-
------------------------------------------------------------------------------
---		Static Data
------------------------------------------------------------------------------
-
-data Section
-  = Text
-  | Data
-  | ReadOnlyData
-  | RelocatableReadOnlyData
-  | UninitialisedData
-  | ReadOnlyData16	-- .rodata.cst16 on x86_64, 16-byte aligned
-  | OtherSection String
-
-data CmmStatic
-  = CmmStaticLit CmmLit	
-	-- a literal value, size given by cmmLitRep of the literal.
-  | CmmUninitialised Int
-	-- uninitialised data, N bytes long
-  | CmmAlign Int
-	-- align to next N-byte boundary (N must be a power of 2).
-  | CmmDataLabel CLabel
-	-- label the current position in this section.
-  | CmmString [Word8]
-	-- string of 8-bit values only, not zero terminated.
-
------------------------------------------------------------------------------
---		Global STG registers
------------------------------------------------------------------------------
-
-data GlobalReg
-  -- Argument and return registers
-  = VanillaReg			-- pointers, unboxed ints and chars
-	{-# UNPACK #-} !Int	-- its number
-
-  | FloatReg		-- single-precision floating-point registers
-	{-# UNPACK #-} !Int	-- its number
-
-  | DoubleReg		-- double-precision floating-point registers
-	{-# UNPACK #-} !Int	-- its number
-
-  | LongReg	        -- long int registers (64-bit, really)
-	{-# UNPACK #-} !Int	-- its number
-
-  -- STG registers
-  | Sp			-- Stack ptr; points to last occupied stack location.
-  | SpLim		-- Stack limit
-  | Hp			-- Heap ptr; points to last occupied heap location.
-  | HpLim		-- Heap limit register
-  | CurrentTSO		-- pointer to current thread's TSO
-  | CurrentNursery	-- pointer to allocation area
-  | HpAlloc		-- allocation count for heap check failure
-
-		-- We keep the address of some commonly-called 
-		-- functions in the register table, to keep code
-		-- size down:
-  | GCEnter1		-- stg_gc_enter_1
-  | GCFun		-- stg_gc_fun
-
-  -- Base offset for the register table, used for accessing registers
-  -- which do not have real registers assigned to them.  This register
-  -- will only appear after we have expanded GlobalReg into memory accesses
-  -- (where necessary) in the native code generator.
-  | BaseReg
-
-  -- Base Register for PIC (position-independent code) calculations
-  -- Only used inside the native code generator. It's exact meaning differs
-  -- from platform to platform (see module PositionIndependentCode).
-  | PicBaseReg
-
-  deriving( Eq
-#ifdef DEBUG
-	, Show
-#endif
-	 )
-
--- convenient aliases
-spReg, hpReg, nodeReg :: CmmReg
-spReg = CmmGlobal Sp
-hpReg = CmmGlobal Hp
-nodeReg = CmmGlobal node
-
-node :: GlobalReg
-node = VanillaReg 1
-
-globalRegRep :: GlobalReg -> MachRep
-globalRegRep (VanillaReg _) 	= wordRep
-globalRegRep (FloatReg _) 	= F32
-globalRegRep (DoubleReg _) 	= F64
-globalRegRep (LongReg _) 	= I64
-globalRegRep _			= wordRep
diff --git a/ghc/compiler/cmm/CmmLex.x b/ghc/compiler/cmm/CmmLex.x
deleted file mode 100644
index c2efd17710..0000000000
--- a/ghc/compiler/cmm/CmmLex.x
+++ /dev/null
@@ -1,311 +0,0 @@
------------------------------------------------------------------------------
--- (c) The University of Glasgow, 2004
---
--- Lexer for concrete Cmm.  We try to stay close to the C-- spec, but there
--- are a few minor differences:
---
---   * extra keywords for our macros, and float32/float64 types
---   * global registers (Sp,Hp, etc.)
---
------------------------------------------------------------------------------
-
-{
-module CmmLex (
-   CmmToken(..), cmmlex,
-  ) where
-
-#include "HsVersions.h"
-
-import Cmm
-import Lexer
-
-import SrcLoc
-import UniqFM
-import StringBuffer
-import FastString
-import Ctype
-import Util		( readRational )
---import TRACE
-}
-
-$whitechar   = [\ \t\n\r\f\v\xa0]
-$white_no_nl = $whitechar # \n
-
-$ascdigit  = 0-9
-$unidigit  = \x01
-$digit     = [$ascdigit $unidigit]
-$octit	   = 0-7
-$hexit     = [$digit A-F a-f]
-
-$unilarge  = \x03
-$asclarge  = [A-Z \xc0-\xd6 \xd8-\xde]
-$large     = [$asclarge $unilarge]
-
-$unismall  = \x04
-$ascsmall  = [a-z \xdf-\xf6 \xf8-\xff]
-$small     = [$ascsmall $unismall \_]
-
-$namebegin = [$large $small \_ \. \$ \@]
-$namechar  = [$namebegin $digit]
-
-@decimal     = $digit+
-@octal       = $octit+
-@hexadecimal = $hexit+
-@exponent    = [eE] [\-\+]? @decimal
-
-@floating_point = @decimal \. @decimal @exponent? | @decimal @exponent
-
-@escape      = \\ ([abfnrt\\\'\"\?] | x @hexadecimal | @octal)
-@strchar     = ($printable # [\"\\]) | @escape
-
-cmm :-
-
-$white_no_nl+		;
-^\# pragma .* \n        ; -- Apple GCC 3.3 CPP generates pragmas in its output
-
-^\# (line)? 		{ begin line_prag }
-
--- single-line line pragmas, of the form
---    # <line> "<file>" <extra-stuff> \n
-<line_prag> $digit+			{ setLine line_prag1 }
-<line_prag1> \" ($printable # \")* \"	{ setFile line_prag2 }
-<line_prag2> .*				{ pop }
-
-<0> {
-  \n			;
-
-  [\:\;\{\}\[\]\(\)\=\`\~\/\*\%\-\+\&\^\|\>\<\,\!]	{ special_char }
-  
-  ".." 			{ kw CmmT_DotDot }
-  "::" 			{ kw CmmT_DoubleColon }
-  ">>"			{ kw CmmT_Shr }
-  "<<"			{ kw CmmT_Shl }
-  ">="			{ kw CmmT_Ge }
-  "<="			{ kw CmmT_Le }
-  "=="			{ kw CmmT_Eq }
-  "!="			{ kw CmmT_Ne }
-  "&&"			{ kw CmmT_BoolAnd }
-  "||"			{ kw CmmT_BoolOr }
-  
-  R@decimal		{ global_regN VanillaReg }
-  F@decimal		{ global_regN FloatReg }
-  D@decimal		{ global_regN DoubleReg }
-  L@decimal		{ global_regN LongReg }
-  Sp			{ global_reg Sp }
-  SpLim			{ global_reg SpLim }
-  Hp			{ global_reg Hp }
-  HpLim			{ global_reg HpLim }
-  CurrentTSO		{ global_reg CurrentTSO }
-  CurrentNursery	{ global_reg CurrentNursery }
-  HpAlloc		{ global_reg HpAlloc }
-  BaseReg		{ global_reg BaseReg }
-  
-  $namebegin $namechar*	{ name }
-  
-  0 @octal		{ tok_octal }
-  @decimal		{ tok_decimal }
-  0[xX] @hexadecimal	{ tok_hexadecimal }
-  @floating_point	{ strtoken tok_float }
-  
-  \" @strchar* \"	{ strtoken tok_string }
-}
-
-{
-data CmmToken
-  = CmmT_SpecChar  Char
-  | CmmT_DotDot
-  | CmmT_DoubleColon
-  | CmmT_Shr
-  | CmmT_Shl
-  | CmmT_Ge
-  | CmmT_Le
-  | CmmT_Eq
-  | CmmT_Ne
-  | CmmT_BoolAnd
-  | CmmT_BoolOr
-  | CmmT_CLOSURE
-  | CmmT_INFO_TABLE
-  | CmmT_INFO_TABLE_RET
-  | CmmT_INFO_TABLE_FUN
-  | CmmT_INFO_TABLE_CONSTR
-  | CmmT_INFO_TABLE_SELECTOR
-  | CmmT_else
-  | CmmT_export
-  | CmmT_section
-  | CmmT_align
-  | CmmT_goto
-  | CmmT_if
-  | CmmT_jump
-  | CmmT_foreign
-  | CmmT_import
-  | CmmT_switch
-  | CmmT_case
-  | CmmT_default
-  | CmmT_bits8
-  | CmmT_bits16
-  | CmmT_bits32
-  | CmmT_bits64
-  | CmmT_float32
-  | CmmT_float64
-  | CmmT_GlobalReg GlobalReg
-  | CmmT_Name	   FastString
-  | CmmT_String	   String
-  | CmmT_Int	   Integer
-  | CmmT_Float     Rational
-  | CmmT_EOF
-#ifdef DEBUG
-  deriving (Show)
-#endif
-
--- -----------------------------------------------------------------------------
--- Lexer actions
-
-type Action = SrcSpan -> StringBuffer -> Int -> P (Located CmmToken)
-
-begin :: Int -> Action
-begin code _span _str _len = do pushLexState code; lexToken
-
-pop :: Action
-pop _span _buf _len = do popLexState; lexToken
-
-special_char :: Action
-special_char span buf len = return (L span (CmmT_SpecChar (currentChar buf)))
-
-kw :: CmmToken -> Action
-kw tok span buf len = return (L span tok)
-
-global_regN :: (Int -> GlobalReg) -> Action
-global_regN con span buf len 
-  = return (L span (CmmT_GlobalReg (con (fromIntegral n))))
-  where buf' = stepOn buf
-	n = parseInteger buf' (len-1) 10 octDecDigit
-
-global_reg :: GlobalReg -> Action
-global_reg r span buf len = return (L span (CmmT_GlobalReg r))
-
-strtoken :: (String -> CmmToken) -> Action
-strtoken f span buf len = 
-  return (L span $! (f $! lexemeToString buf len))
-
-name :: Action
-name span buf len = 
-  case lookupUFM reservedWordsFM fs of
-	Just tok -> return (L span tok)
-	Nothing  -> return (L span (CmmT_Name fs))
-  where
-	fs = lexemeToFastString buf len
-
-reservedWordsFM = listToUFM $
-	map (\(x, y) -> (mkFastString x, y)) [
-	( "CLOSURE",		CmmT_CLOSURE ),
-	( "INFO_TABLE",		CmmT_INFO_TABLE ),
-	( "INFO_TABLE_RET",	CmmT_INFO_TABLE_RET ),
-	( "INFO_TABLE_FUN",	CmmT_INFO_TABLE_FUN ),
-	( "INFO_TABLE_CONSTR",	CmmT_INFO_TABLE_CONSTR ),
-	( "INFO_TABLE_SELECTOR",CmmT_INFO_TABLE_SELECTOR ),
-	( "else",		CmmT_else ),
-	( "export",		CmmT_export ),
-	( "section",		CmmT_section ),
-	( "align",		CmmT_align ),
-	( "goto",		CmmT_goto ),
-	( "if",			CmmT_if ),
-	( "jump",		CmmT_jump ),
-	( "foreign",		CmmT_foreign ),
-	( "import",		CmmT_import ),
-	( "switch",		CmmT_switch ),
-	( "case",		CmmT_case ),
-	( "default",		CmmT_default ),
-	( "bits8",		CmmT_bits8 ),
-	( "bits16",		CmmT_bits16 ),
-	( "bits32",		CmmT_bits32 ),
-	( "bits64",		CmmT_bits64 ),
-	( "float32",		CmmT_float32 ),
-	( "float64",		CmmT_float64 )
-	]
-
-tok_decimal span buf len 
-  = return (L span (CmmT_Int  $! parseInteger buf len 10 octDecDigit))
-
-tok_octal span buf len 
-  = return (L span (CmmT_Int  $! parseInteger (offsetBytes 1 buf) (len-1) 8 octDecDigit))
-
-tok_hexadecimal span buf len 
-  = return (L span (CmmT_Int  $! parseInteger (offsetBytes 2 buf) (len-2) 16 hexDigit))
-
-tok_float str = CmmT_Float $! readRational str
-
-tok_string str = CmmT_String (read str)
-		 -- urk, not quite right, but it'll do for now
-
--- -----------------------------------------------------------------------------
--- Line pragmas
-
-setLine :: Int -> Action
-setLine code span buf len = do
-  let line = parseInteger buf len 10 octDecDigit
-  setSrcLoc (mkSrcLoc (srcSpanFile span) (fromIntegral line - 1) 0)
-	-- subtract one: the line number refers to the *following* line
-  -- trace ("setLine "  ++ show line) $ do
-  popLexState
-  pushLexState code
-  lexToken
-
-setFile :: Int -> Action
-setFile code span buf len = do
-  let file = lexemeToFastString (stepOn buf) (len-2)
-  setSrcLoc (mkSrcLoc file (srcSpanEndLine span) (srcSpanEndCol span))
-  popLexState
-  pushLexState code
-  lexToken
-
--- -----------------------------------------------------------------------------
--- This is the top-level function: called from the parser each time a
--- new token is to be read from the input.
-
-cmmlex :: (Located CmmToken -> P a) -> P a
-cmmlex cont = do
-  tok@(L _ tok__) <- lexToken
-  --trace ("token: " ++ show tok__) $ do
-  cont tok
-
-lexToken :: P (Located CmmToken)
-lexToken = do
-  inp@(loc1,buf) <- getInput
-  sc <- getLexState
-  case alexScan inp sc of
-    AlexEOF -> do let span = mkSrcSpan loc1 loc1
-		  setLastToken span 0
-		  return (L span CmmT_EOF)
-    AlexError (loc2,_) -> do failLocMsgP loc1 loc2 "lexical error"
-    AlexSkip inp2 _ -> do
-	setInput inp2
-	lexToken
-    AlexToken inp2@(end,buf2) len t -> do
-	setInput inp2
-	let span = mkSrcSpan loc1 end
-	span `seq` setLastToken span len
-	t span buf len
-
--- -----------------------------------------------------------------------------
--- Monad stuff
-
--- Stuff that Alex needs to know about our input type:
-type AlexInput = (SrcLoc,StringBuffer)
-
-alexInputPrevChar :: AlexInput -> Char
-alexInputPrevChar (_,s) = prevChar s '\n'
-
-alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
-alexGetChar (loc,s) 
-  | atEnd s   = Nothing
-  | otherwise = c `seq` loc' `seq` s' `seq` Just (c, (loc', s'))
-  where c = currentChar s
-        loc' = advanceSrcLoc loc c
-	s'   = stepOn s
-
-getInput :: P AlexInput
-getInput = P $ \s@PState{ loc=l, buffer=b } -> POk s (l,b)
-
-setInput :: AlexInput -> P ()
-setInput (l,b) = P $ \s -> POk s{ loc=l, buffer=b } ()
-}
diff --git a/ghc/compiler/cmm/CmmLint.hs b/ghc/compiler/cmm/CmmLint.hs
deleted file mode 100644
index fbfb14c165..0000000000
--- a/ghc/compiler/cmm/CmmLint.hs
+++ /dev/null
@@ -1,159 +0,0 @@
------------------------------------------------------------------------------
---
--- CmmLint: checking the correctness of Cmm statements and expressions
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
-module CmmLint (
-  cmmLint, cmmLintTop
-  ) where
-
-#include "HsVersions.h"
-
-import Cmm
-import CLabel		( pprCLabel )
-import MachOp
-import Outputable
-import PprCmm
-import Unique		( getUnique )
-import Constants	( wORD_SIZE )
-
-import Monad		( when )
-
--- -----------------------------------------------------------------------------
--- Exported entry points:
-
-cmmLint :: Cmm -> Maybe SDoc
-cmmLint (Cmm tops) = runCmmLint $ mapM_ lintCmmTop tops
-
-cmmLintTop :: CmmTop -> Maybe SDoc
-cmmLintTop top = runCmmLint $ lintCmmTop top
-
-runCmmLint :: CmmLint a -> Maybe SDoc
-runCmmLint l = 
-   case unCL l of
-	Left err -> Just (ptext SLIT("Cmm lint error:") $$ nest 2 err)
-	Right _  -> Nothing
-
-lintCmmTop (CmmProc _info lbl _args blocks)
-  = addLintInfo (text "in proc " <> pprCLabel lbl) $
-	mapM_ lintCmmBlock blocks
-lintCmmTop _other
-  = return ()
-
-lintCmmBlock (BasicBlock id stmts)
-  = addLintInfo (text "in basic block " <> ppr (getUnique id)) $
-	mapM_ lintCmmStmt stmts
-
--- -----------------------------------------------------------------------------
--- lintCmmExpr
-
--- Checks whether a CmmExpr is "type-correct", and check for obvious-looking
--- byte/word mismatches.
-
-lintCmmExpr :: CmmExpr -> CmmLint MachRep
-lintCmmExpr (CmmLoad expr rep) = do
-  lintCmmExpr expr
-  when (machRepByteWidth rep >= wORD_SIZE) $
-     cmmCheckWordAddress expr
-  return rep
-lintCmmExpr expr@(CmmMachOp op args) = do
-  mapM_ lintCmmExpr args
-  if map cmmExprRep args == machOpArgReps op
-  	then cmmCheckMachOp op args
-	else cmmLintMachOpErr expr
-lintCmmExpr (CmmRegOff reg offset)
-  = lintCmmExpr (CmmMachOp (MO_Add rep) 
-		[CmmReg reg, CmmLit (CmmInt (fromIntegral offset) rep)])
-  where rep = cmmRegRep reg
-lintCmmExpr lit@(CmmLit (CmmInt _ rep))
-  | isFloatingRep rep
-  = cmmLintErr (text "integer literal with floating MachRep: " <> ppr lit)
-lintCmmExpr expr = 
-  return (cmmExprRep expr)
-
--- Check for some common byte/word mismatches (eg. Sp + 1)
-cmmCheckMachOp  op args@[CmmReg reg, CmmLit (CmmInt i _)]
-  | isWordOffsetReg reg && isOffsetOp op && i `rem` fromIntegral wORD_SIZE /= 0
-  = cmmLintDubiousWordOffset (CmmMachOp op args)
-cmmCheckMachOp op [lit@(CmmLit (CmmInt i _)), reg@(CmmReg _)]
-  = cmmCheckMachOp op [reg, lit]
-cmmCheckMachOp op@(MO_U_Conv from to) args
-  | isFloatingRep from || isFloatingRep to
-  = cmmLintErr (text "unsigned conversion from/to floating rep: " 
-		<> ppr (CmmMachOp op args))
-cmmCheckMachOp op args
-  = return (resultRepOfMachOp op)
-
-isWordOffsetReg (CmmGlobal Sp) = True
-isWordOffsetReg (CmmGlobal Hp) = True
-isWordOffsetReg _ = False
-
-isOffsetOp (MO_Add _) = True
-isOffsetOp (MO_Sub _) = True
-isOffsetOp _ = False
-
--- This expression should be an address from which a word can be loaded:
--- check for funny-looking sub-word offsets.
-cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
-  | isOffsetOp op && i `rem` fromIntegral wORD_SIZE /= 0
-  = cmmLintDubiousWordOffset e
-cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
-  | isOffsetOp op && i `rem` fromIntegral wORD_SIZE /= 0
-  = cmmLintDubiousWordOffset e
-cmmCheckWordAddress _
-  = return ()
-
-
-lintCmmStmt :: CmmStmt -> CmmLint ()
-lintCmmStmt stmt@(CmmAssign reg expr) = do
-  erep <- lintCmmExpr expr
-  if (erep == cmmRegRep reg)
-	then return ()
-	else cmmLintAssignErr stmt
-lintCmmStmt (CmmStore l r) = do
-  lintCmmExpr l
-  lintCmmExpr r
-  return ()
-lintCmmStmt (CmmCall _target _res args _vols) = mapM_ (lintCmmExpr.fst) args
-lintCmmStmt (CmmCondBranch e _id)   = lintCmmExpr e >> return ()
-lintCmmStmt (CmmSwitch e _branches) = lintCmmExpr e >> return ()
-lintCmmStmt (CmmJump e _args)       = lintCmmExpr e >> return ()
-lintCmmStmt _other 		    = return ()
-
--- -----------------------------------------------------------------------------
--- CmmLint monad
-
--- just a basic error monad:
-
-newtype CmmLint a = CmmLint { unCL :: Either SDoc a }
-
-instance Monad CmmLint where
-  CmmLint m >>= k = CmmLint $ case m of 
-				Left e -> Left e
-				Right a -> unCL (k a)
-  return a = CmmLint (Right a)
-
-cmmLintErr :: SDoc -> CmmLint a
-cmmLintErr msg = CmmLint (Left msg)
-
-addLintInfo :: SDoc -> CmmLint a -> CmmLint a
-addLintInfo info thing = CmmLint $ 
-   case unCL thing of
-	Left err -> Left (hang info 2 err)
-	Right a  -> Right a
-
-cmmLintMachOpErr :: CmmExpr -> CmmLint a
-cmmLintMachOpErr expr = cmmLintErr (text "in MachOp application: " $$ 
-					nest 2 (pprExpr expr))
-
-cmmLintAssignErr :: CmmStmt -> CmmLint a
-cmmLintAssignErr stmt = cmmLintErr (text "in assignment: " $$ 
-					nest 2 (pprStmt stmt))
-
-cmmLintDubiousWordOffset :: CmmExpr -> CmmLint a
-cmmLintDubiousWordOffset expr
-   = cmmLintErr (text "offset is not a multiple of words: " $$
-			nest 2 (pprExpr expr))
diff --git a/ghc/compiler/cmm/CmmOpt.hs b/ghc/compiler/cmm/CmmOpt.hs
deleted file mode 100644
index c454ff4c6a..0000000000
--- a/ghc/compiler/cmm/CmmOpt.hs
+++ /dev/null
@@ -1,507 +0,0 @@
------------------------------------------------------------------------------
---
--- Cmm optimisation
---
--- (c) The University of Glasgow 2006
---
------------------------------------------------------------------------------
-
-module CmmOpt (
-	cmmMiniInline,
-	cmmMachOpFold,
-	cmmLoopifyForC,
- ) where
-
-#include "HsVersions.h"
-
-import Cmm
-import CmmUtils	( hasNoGlobalRegs )
-import CLabel	( entryLblToInfoLbl )
-import MachOp
-import SMRep	( tablesNextToCode )
-
-import UniqFM
-import Unique	( Unique )
-import Panic	( panic )
-
-import Outputable
-
-import Bits
-import Word
-import Int
-import GLAEXTS
-
-
--- -----------------------------------------------------------------------------
--- The mini-inliner
-
-{-
-This pass inlines assignments to temporaries that are used just
-once.  It works as follows:
-
-  - count uses of each temporary
-  - for each temporary that occurs just once:
-	- attempt to push it forward to the statement that uses it
-        - only push forward past assignments to other temporaries
-	  (assumes that temporaries are single-assignment)
-	- if we reach the statement that uses it, inline the rhs
-	  and delete the original assignment.
-
-Possible generalisations: here is an example from factorial
-
-Fac_zdwfac_entry:
-    cmG:
-        _smi = R2;
-        if (_smi != 0) goto cmK;
-        R1 = R3;
-        jump I64[Sp];
-    cmK:
-        _smn = _smi * R3;
-        R2 = _smi + (-1);
-        R3 = _smn;
-        jump Fac_zdwfac_info;
-
-We want to inline _smi and _smn.  To inline _smn:
-
-   - we must be able to push forward past assignments to global regs.
-     We can do this if the rhs of the assignment we are pushing
-     forward doesn't refer to the global reg being assigned to; easy
-     to test.
-
-To inline _smi:
-
-   - It is a trivial replacement, reg for reg, but it occurs more than
-     once.
-   - We can inline trivial assignments even if the temporary occurs
-     more than once, as long as we don't eliminate the original assignment
-     (this doesn't help much on its own).
-   - We need to be able to propagate the assignment forward through jumps;
-     if we did this, we would find that it can be inlined safely in all
-     its occurrences.
--}
-
-cmmMiniInline :: [CmmBasicBlock] -> [CmmBasicBlock]
-cmmMiniInline blocks = map do_inline blocks 
-  where 
-	blockUses (BasicBlock _ stmts)
-	 = foldr (plusUFM_C (+)) emptyUFM (map getStmtUses stmts)
-
-	uses = foldr (plusUFM_C (+)) emptyUFM (map blockUses blocks)
-
-	do_inline (BasicBlock id stmts)
-	 = BasicBlock id (cmmMiniInlineStmts uses stmts)
-
-
-cmmMiniInlineStmts :: UniqFM Int -> [CmmStmt] -> [CmmStmt]
-cmmMiniInlineStmts uses [] = []
-cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts)
-  | Just 1 <- lookupUFM uses u,
-    Just stmts' <- lookForInline u expr stmts
-  = 
-#ifdef NCG_DEBUG
-     trace ("nativeGen: inlining " ++ showSDoc (pprStmt stmt)) $
-#endif
-     cmmMiniInlineStmts uses stmts'
-
-cmmMiniInlineStmts uses (stmt:stmts)
-  = stmt : cmmMiniInlineStmts uses stmts
-
-
--- Try to inline a temporary assignment.  We can skip over assignments to
--- other tempoararies, because we know that expressions aren't side-effecting
--- and temporaries are single-assignment.
-lookForInline u expr (stmt@(CmmAssign (CmmLocal (LocalReg u' _)) rhs) : rest)
-  | u /= u' 
-  = case lookupUFM (getExprUses rhs) u of
-	Just 1 -> Just (inlineStmt u expr stmt : rest)
-	_other -> case lookForInline u expr rest of
-		     Nothing    -> Nothing
-		     Just stmts -> Just (stmt:stmts)
-
-lookForInline u expr (CmmNop : rest)
-  = lookForInline u expr rest
-
-lookForInline u expr (stmt:stmts)
-  = case lookupUFM (getStmtUses stmt) u of
-	Just 1 | ok_to_inline -> Just (inlineStmt u expr stmt : stmts)
-	_other -> Nothing
-  where
-	-- we don't inline into CmmCall if the expression refers to global
-	-- registers.  This is a HACK to avoid global registers clashing with
-	-- C argument-passing registers, really the back-end ought to be able
-	-- to handle it properly, but currently neither PprC nor the NCG can
-	-- do it.  See also CgForeignCall:load_args_into_temps.
-    ok_to_inline = case stmt of
-		     CmmCall{} -> hasNoGlobalRegs expr
-		     _ -> True
-
--- -----------------------------------------------------------------------------
--- Boring Cmm traversals for collecting usage info and substitutions.
-
-getStmtUses :: CmmStmt -> UniqFM Int
-getStmtUses (CmmAssign _ e) = getExprUses e
-getStmtUses (CmmStore e1 e2) = plusUFM_C (+) (getExprUses e1) (getExprUses e2)
-getStmtUses (CmmCall target _ es _)
-   = plusUFM_C (+) (uses target) (getExprsUses (map fst es))
-   where uses (CmmForeignCall e _) = getExprUses e
-	 uses _ = emptyUFM
-getStmtUses (CmmCondBranch e _) = getExprUses e
-getStmtUses (CmmSwitch e _) = getExprUses e
-getStmtUses (CmmJump e _) = getExprUses e
-getStmtUses _ = emptyUFM
-
-getExprUses :: CmmExpr -> UniqFM Int
-getExprUses (CmmReg (CmmLocal (LocalReg u _))) = unitUFM u 1
-getExprUses (CmmRegOff (CmmLocal (LocalReg u _)) _) = unitUFM u 1
-getExprUses (CmmLoad e _) = getExprUses e
-getExprUses (CmmMachOp _ es) = getExprsUses es
-getExprUses _other = emptyUFM
-
-getExprsUses es = foldr (plusUFM_C (+)) emptyUFM (map getExprUses es)
-
-inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt
-inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
-inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
-inlineStmt u a (CmmCall target regs es vols)
-   = CmmCall (infn target) regs es' vols
-   where infn (CmmForeignCall fn cconv) = CmmForeignCall fn cconv
-	 infn (CmmPrim p) = CmmPrim p
-	 es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ]
-inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
-inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
-inlineStmt u a (CmmJump e d) = CmmJump (inlineExpr u a e) d
-inlineStmt u a other_stmt = other_stmt
-
-inlineExpr :: Unique -> CmmExpr -> CmmExpr -> CmmExpr
-inlineExpr u a e@(CmmReg (CmmLocal (LocalReg u' _)))
-  | u == u' = a
-  | otherwise = e
-inlineExpr u a e@(CmmRegOff (CmmLocal (LocalReg u' rep)) off)
-  | u == u' = CmmMachOp (MO_Add rep) [a, CmmLit (CmmInt (fromIntegral off) rep)]
-  | otherwise = e
-inlineExpr u a (CmmLoad e rep) = CmmLoad (inlineExpr u a e) rep
-inlineExpr u a (CmmMachOp op es) = CmmMachOp op (map (inlineExpr u a) es)
-inlineExpr u a other_expr = other_expr
-
--- -----------------------------------------------------------------------------
--- MachOp constant folder
-
--- Now, try to constant-fold the MachOps.  The arguments have already
--- been optimized and folded.
-
-cmmMachOpFold
-    :: MachOp	    	-- The operation from an CmmMachOp
-    -> [CmmExpr]   	-- The optimized arguments
-    -> CmmExpr
-
-cmmMachOpFold op arg@[CmmLit (CmmInt x rep)]
-  = case op of
-      MO_S_Neg r -> CmmLit (CmmInt (-x) rep)
-      MO_Not r   -> CmmLit (CmmInt (complement x) rep)
-
-	-- these are interesting: we must first narrow to the 
-	-- "from" type, in order to truncate to the correct size.
-	-- The final narrow/widen to the destination type
-	-- is implicit in the CmmLit.
-      MO_S_Conv from to
-	   | isFloatingRep to -> CmmLit (CmmFloat (fromInteger x) to)
-	   | otherwise        -> CmmLit (CmmInt (narrowS from x) to)
-      MO_U_Conv from to -> CmmLit (CmmInt (narrowU from x) to)
-
-      _ -> panic "cmmMachOpFold: unknown unary op"
-
-
--- Eliminate conversion NOPs
-cmmMachOpFold (MO_S_Conv rep1 rep2) [x] | rep1 == rep2 = x
-cmmMachOpFold (MO_U_Conv rep1 rep2) [x] | rep1 == rep2 = x
-
--- Eliminate nested conversions where possible
-cmmMachOpFold conv_outer args@[CmmMachOp conv_inner [x]]
-  | Just (rep1,rep2,signed1) <- isIntConversion conv_inner,
-    Just (_,   rep3,signed2) <- isIntConversion conv_outer
-  = case () of
-	-- widen then narrow to the same size is a nop
-      _ | rep1 < rep2 && rep1 == rep3 -> x
-	-- Widen then narrow to different size: collapse to single conversion
-	-- but remember to use the signedness from the widening, just in case
-	-- the final conversion is a widen.
-	| rep1 < rep2 && rep2 > rep3 ->
-	    cmmMachOpFold (intconv signed1 rep1 rep3) [x]
-	-- Nested widenings: collapse if the signedness is the same
-	| rep1 < rep2 && rep2 < rep3 && signed1 == signed2 ->
-	    cmmMachOpFold (intconv signed1 rep1 rep3) [x]
-	-- Nested narrowings: collapse
-	| rep1 > rep2 && rep2 > rep3 ->
-	    cmmMachOpFold (MO_U_Conv rep1 rep3) [x]
-	| otherwise ->
-	    CmmMachOp conv_outer args
-  where
-	isIntConversion (MO_U_Conv rep1 rep2) 
-	  | not (isFloatingRep rep1) && not (isFloatingRep rep2) 
-	  = Just (rep1,rep2,False)
-	isIntConversion (MO_S_Conv rep1 rep2)
-	  | not (isFloatingRep rep1) && not (isFloatingRep rep2) 
-	  = Just (rep1,rep2,True)
-	isIntConversion _ = Nothing
-
-	intconv True  = MO_S_Conv
-	intconv False = MO_U_Conv
-
--- ToDo: a narrow of a load can be collapsed into a narrow load, right?
--- but what if the architecture only supports word-sized loads, should
--- we do the transformation anyway?
-
-cmmMachOpFold mop args@[CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
-  = case mop of
-	-- for comparisons: don't forget to narrow the arguments before
-	-- comparing, since they might be out of range.
-    	MO_Eq r   -> CmmLit (CmmInt (if x_u == y_u then 1 else 0) wordRep)
-    	MO_Ne r   -> CmmLit (CmmInt (if x_u /= y_u then 1 else 0) wordRep)
-
-    	MO_U_Gt r -> CmmLit (CmmInt (if x_u >  y_u then 1 else 0) wordRep)
-    	MO_U_Ge r -> CmmLit (CmmInt (if x_u >= y_u then 1 else 0) wordRep)
-    	MO_U_Lt r -> CmmLit (CmmInt (if x_u <  y_u then 1 else 0) wordRep)
-    	MO_U_Le r -> CmmLit (CmmInt (if x_u <= y_u then 1 else 0) wordRep)
-
-    	MO_S_Gt r -> CmmLit (CmmInt (if x_s >  y_s then 1 else 0) wordRep) 
-    	MO_S_Ge r -> CmmLit (CmmInt (if x_s >= y_s then 1 else 0) wordRep)
-    	MO_S_Lt r -> CmmLit (CmmInt (if x_s <  y_s then 1 else 0) wordRep)
-    	MO_S_Le r -> CmmLit (CmmInt (if x_s <= y_s then 1 else 0) wordRep)
-
-    	MO_Add r -> CmmLit (CmmInt (x + y) r)
-    	MO_Sub r -> CmmLit (CmmInt (x - y) r)
-    	MO_Mul r -> CmmLit (CmmInt (x * y) r)
-    	MO_S_Quot r | y /= 0 -> CmmLit (CmmInt (x `quot` y) r)
-    	MO_S_Rem  r | y /= 0 -> CmmLit (CmmInt (x `rem` y) r)
-
-	MO_And   r -> CmmLit (CmmInt (x .&. y) r)
-	MO_Or    r -> CmmLit (CmmInt (x .|. y) r)
-	MO_Xor   r -> CmmLit (CmmInt (x `xor` y) r)
-
-        MO_Shl   r -> CmmLit (CmmInt (x `shiftL` fromIntegral y) r)
-        MO_U_Shr r -> CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
-        MO_S_Shr r -> CmmLit (CmmInt (x `shiftR` fromIntegral y) r)
-
-	other      -> CmmMachOp mop args
-
-   where
-	x_u = narrowU xrep x
-	y_u = narrowU xrep y
-	x_s = narrowS xrep x
-	y_s = narrowS xrep y
-	
-
--- When possible, shift the constants to the right-hand side, so that we
--- can match for strength reductions.  Note that the code generator will
--- also assume that constants have been shifted to the right when
--- possible.
-
-cmmMachOpFold op [x@(CmmLit _), y]
-   | not (isLit y) && isCommutableMachOp op 
-   = cmmMachOpFold op [y, x]
-
--- Turn (a+b)+c into a+(b+c) where possible.  Because literals are
--- moved to the right, it is more likely that we will find
--- opportunities for constant folding when the expression is
--- right-associated.
---
--- ToDo: this appears to introduce a quadratic behaviour due to the
--- nested cmmMachOpFold.  Can we fix this?
---
--- Why do we check isLit arg1?  If arg1 is a lit, it means that arg2
--- is also a lit (otherwise arg1 would be on the right).  If we
--- put arg1 on the left of the rearranged expression, we'll get into a
--- loop:  (x1+x2)+x3 => x1+(x2+x3)  => (x2+x3)+x1 => x2+(x3+x1) ...
---
-cmmMachOpFold mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
-   | mop1 == mop2 && isAssociativeMachOp mop1 && not (isLit arg1)
-   = cmmMachOpFold mop1 [arg1, cmmMachOpFold mop2 [arg2,arg3]]
-
--- Make a RegOff if we can
-cmmMachOpFold (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
-  = CmmRegOff reg (fromIntegral (narrowS rep n))
-cmmMachOpFold (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
-  = CmmRegOff reg (off + fromIntegral (narrowS rep n))
-cmmMachOpFold (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]
-  = CmmRegOff reg (- fromIntegral (narrowS rep n))
-cmmMachOpFold (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
-  = CmmRegOff reg (off - fromIntegral (narrowS rep n))
-
--- Fold label(+/-)offset into a CmmLit where possible
-
-cmmMachOpFold (MO_Add _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
-  = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
-cmmMachOpFold (MO_Add _) [CmmLit (CmmInt i rep), CmmLit (CmmLabel lbl)]
-  = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
-cmmMachOpFold (MO_Sub _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
-  = CmmLit (CmmLabelOff lbl (fromIntegral (negate (narrowU rep i))))
-
--- We can often do something with constants of 0 and 1 ...
-
-cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 0 _))]
-  = case mop of
-    	MO_Add   r -> x
-    	MO_Sub   r -> x
-    	MO_Mul   r -> y
-    	MO_And   r -> y
-    	MO_Or    r -> x
-    	MO_Xor   r -> x
-    	MO_Shl   r -> x
-    	MO_S_Shr r -> x
-    	MO_U_Shr r -> x
-        MO_Ne    r | isComparisonExpr x -> x
-	MO_Eq    r | Just x' <- maybeInvertConditionalExpr x -> x'
-	MO_U_Gt  r | isComparisonExpr x -> x
-	MO_S_Gt  r | isComparisonExpr x -> x
-	MO_U_Lt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
-	MO_S_Lt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
-	MO_U_Ge  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
-	MO_S_Ge  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
-	MO_U_Le  r | Just x' <- maybeInvertConditionalExpr x -> x'
-	MO_S_Le  r | Just x' <- maybeInvertConditionalExpr x -> x'
-    	other    -> CmmMachOp mop args
-
-cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 1 rep))]
-  = case mop of
-    	MO_Mul    r -> x
-    	MO_S_Quot r -> x
-    	MO_U_Quot r -> x
-    	MO_S_Rem  r -> CmmLit (CmmInt 0 rep)
-    	MO_U_Rem  r -> CmmLit (CmmInt 0 rep)
-        MO_Ne    r | Just x' <- maybeInvertConditionalExpr x -> x'
-	MO_Eq    r | isComparisonExpr x -> x
-	MO_U_Lt  r | Just x' <- maybeInvertConditionalExpr x -> x'
-	MO_S_Lt  r | Just x' <- maybeInvertConditionalExpr x -> x'
-	MO_U_Gt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
-	MO_S_Gt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
-	MO_U_Le  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
-	MO_S_Le  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
-	MO_U_Ge  r | isComparisonExpr x -> x
-	MO_S_Ge  r | isComparisonExpr x -> x
-    	other       -> CmmMachOp mop args
-
--- Now look for multiplication/division by powers of 2 (integers).
-
-cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))]
-  = case mop of
-    	MO_Mul rep
-           -> case exactLog2 n of
-                 Nothing -> unchanged
-                 Just p  -> CmmMachOp (MO_Shl rep) [x, CmmLit (CmmInt p rep)]
-    	MO_S_Quot rep
-           -> case exactLog2 n of
-                 Nothing -> unchanged
-                 Just p  -> CmmMachOp (MO_S_Shr rep) [x, CmmLit (CmmInt p rep)]
-    	other 
-           -> unchanged
-    where
-       unchanged = CmmMachOp mop args
-
--- Anything else is just too hard.
-
-cmmMachOpFold mop args = CmmMachOp mop args
-
--- -----------------------------------------------------------------------------
--- exactLog2
-
--- This algorithm for determining the $\log_2$ of exact powers of 2 comes
--- from GCC.  It requires bit manipulation primitives, and we use GHC
--- extensions.  Tough.
--- 
--- Used to be in MachInstrs --SDM.
--- ToDo: remove use of unboxery --SDM.
-
-w2i x = word2Int# x
-i2w x = int2Word# x
-
-exactLog2 :: Integer -> Maybe Integer
-exactLog2 x
-  = if (x <= 0 || x >= 2147483648) then
-       Nothing
-    else
-       case fromInteger x of { I# x# ->
-       if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
-	  Nothing
-       else
-	  Just (toInteger (I# (pow2 x#)))
-       }
-  where
-    pow2 x# | x# ==# 1# = 0#
-            | otherwise = 1# +# pow2 (w2i (i2w x# `shiftRL#` 1#))
-
-
--- -----------------------------------------------------------------------------
--- widening / narrowing
-
-narrowU :: MachRep -> Integer -> Integer
-narrowU I8  x = fromIntegral (fromIntegral x :: Word8)
-narrowU I16 x = fromIntegral (fromIntegral x :: Word16)
-narrowU I32 x = fromIntegral (fromIntegral x :: Word32)
-narrowU I64 x = fromIntegral (fromIntegral x :: Word64)
-narrowU _ _ = panic "narrowTo"
-
-narrowS :: MachRep -> Integer -> Integer
-narrowS I8  x = fromIntegral (fromIntegral x :: Int8)
-narrowS I16 x = fromIntegral (fromIntegral x :: Int16)
-narrowS I32 x = fromIntegral (fromIntegral x :: Int32)
-narrowS I64 x = fromIntegral (fromIntegral x :: Int64)
-narrowS _ _ = panic "narrowTo"
-
--- -----------------------------------------------------------------------------
--- Loopify for C
-
-{-
- This is a simple pass that replaces tail-recursive functions like this:
-
-   fac() {
-     ...
-     jump fac();
-   }
-
- with this:
-
-  fac() {
-   L:
-     ...
-     goto L;
-  }
-
-  the latter generates better C code, because the C compiler treats it
-  like a loop, and brings full loop optimisation to bear.
-
-  In my measurements this makes little or no difference to anything
-  except factorial, but what the hell.
--}
-
-cmmLoopifyForC :: CmmTop -> CmmTop
-cmmLoopifyForC p@(CmmProc info entry_lbl [] blocks@(BasicBlock top_id _ : _))
-  | null info = p  -- only if there's an info table, ignore case alts
-  | otherwise =  
---  pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
-  CmmProc info entry_lbl [] blocks' 
-  where blocks' = [ BasicBlock id (map do_stmt stmts)
-		  | BasicBlock id stmts <- blocks ]
-
-        do_stmt (CmmJump (CmmLit (CmmLabel lbl)) _) | lbl == jump_lbl
-		= CmmBranch top_id
-	do_stmt stmt = stmt
-
-	jump_lbl | tablesNextToCode = entryLblToInfoLbl entry_lbl
-		 | otherwise        = entry_lbl
-
-cmmLoopifyForC top = top
-
--- -----------------------------------------------------------------------------
--- Utils
-
-isLit (CmmLit _) = True
-isLit _          = False
-
-isComparisonExpr :: CmmExpr -> Bool
-isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
-isComparisonExpr _other 	    = False
-
-maybeInvertConditionalExpr :: CmmExpr -> Maybe CmmExpr
-maybeInvertConditionalExpr (CmmMachOp op args) 
-  | Just op' <- maybeInvertComparison op = Just (CmmMachOp op' args)
-maybeInvertConditionalExpr _ = Nothing
diff --git a/ghc/compiler/cmm/CmmParse.y b/ghc/compiler/cmm/CmmParse.y
deleted file mode 100644
index 73618bc35b..0000000000
--- a/ghc/compiler/cmm/CmmParse.y
+++ /dev/null
@@ -1,890 +0,0 @@
------------------------------------------------------------------------------
---
--- (c) The University of Glasgow, 2004
---
--- Parser for concrete Cmm.
---
------------------------------------------------------------------------------
-
-{
-module CmmParse ( parseCmmFile ) where
-
-import CgMonad
-import CgHeapery
-import CgUtils
-import CgProf
-import CgTicky
-import CgInfoTbls
-import CgForeignCall
-import CgTailCall	( pushUnboxedTuple )
-import CgStackery	( emitPushUpdateFrame )
-import ClosureInfo	( C_SRT(..) )
-import CgCallConv	( smallLiveness )
-import CgClosure	( emitBlackHoleCode )
-import CostCentre	( dontCareCCS )
-
-import Cmm
-import PprCmm
-import CmmUtils		( mkIntCLit )
-import CmmLex
-import CLabel
-import MachOp
-import SMRep		( fixedHdrSize, CgRep(..) )
-import Lexer
-
-import ForeignCall	( CCallConv(..), Safety(..) )
-import Literal		( mkMachInt )
-import Unique
-import UniqFM
-import SrcLoc
-import DynFlags		( DynFlags, DynFlag(..) )
-import Packages		( HomeModules )
-import StaticFlags	( opt_SccProfilingOn )
-import ErrUtils		( printError, dumpIfSet_dyn, showPass )
-import StringBuffer	( hGetStringBuffer )
-import FastString
-import Panic		( panic )
-import Constants	( wORD_SIZE )
-import Outputable
-
-import Monad		( when )
-import Data.Char	( ord )
-
-#include "HsVersions.h"
-}
-
-%token
-	':'	{ L _ (CmmT_SpecChar ':') }
-	';'	{ L _ (CmmT_SpecChar ';') }
-	'{'	{ L _ (CmmT_SpecChar '{') }
-	'}'	{ L _ (CmmT_SpecChar '}') }
-	'['	{ L _ (CmmT_SpecChar '[') }
-	']'	{ L _ (CmmT_SpecChar ']') }
-	'('	{ L _ (CmmT_SpecChar '(') }
-	')'	{ L _ (CmmT_SpecChar ')') }
-	'='	{ L _ (CmmT_SpecChar '=') }
-	'`'	{ L _ (CmmT_SpecChar '`') }
-	'~'	{ L _ (CmmT_SpecChar '~') }
-	'/'	{ L _ (CmmT_SpecChar '/') }
-	'*'	{ L _ (CmmT_SpecChar '*') }
-	'%'	{ L _ (CmmT_SpecChar '%') }
-	'-'	{ L _ (CmmT_SpecChar '-') }
-	'+'	{ L _ (CmmT_SpecChar '+') }
-	'&'	{ L _ (CmmT_SpecChar '&') }
-	'^'	{ L _ (CmmT_SpecChar '^') }
-	'|'	{ L _ (CmmT_SpecChar '|') }
-	'>'	{ L _ (CmmT_SpecChar '>') }
-	'<'	{ L _ (CmmT_SpecChar '<') }
-	','	{ L _ (CmmT_SpecChar ',') }
-	'!'	{ L _ (CmmT_SpecChar '!') }
-
- 	'..'	{ L _ (CmmT_DotDot) }
- 	'::'	{ L _ (CmmT_DoubleColon) }
-	'>>'	{ L _ (CmmT_Shr) }
-	'<<'	{ L _ (CmmT_Shl) }
-	'>='	{ L _ (CmmT_Ge) }
-	'<='	{ L _ (CmmT_Le) }
-	'=='	{ L _ (CmmT_Eq) }
-	'!='	{ L _ (CmmT_Ne) }
-        '&&'    { L _ (CmmT_BoolAnd) }
-        '||'    { L _ (CmmT_BoolOr) }
-
-	'CLOSURE'	{ L _ (CmmT_CLOSURE) }
-	'INFO_TABLE'	{ L _ (CmmT_INFO_TABLE) }
-	'INFO_TABLE_RET'{ L _ (CmmT_INFO_TABLE_RET) }
-	'INFO_TABLE_FUN'{ L _ (CmmT_INFO_TABLE_FUN) }
-	'INFO_TABLE_CONSTR'{ L _ (CmmT_INFO_TABLE_CONSTR) }
-	'INFO_TABLE_SELECTOR'{ L _ (CmmT_INFO_TABLE_SELECTOR) }
-	'else'		{ L _ (CmmT_else) }
-	'export'	{ L _ (CmmT_export) }
-	'section'	{ L _ (CmmT_section) }
-	'align'		{ L _ (CmmT_align) }
-	'goto'		{ L _ (CmmT_goto) }
-	'if'		{ L _ (CmmT_if) }
-	'jump'		{ L _ (CmmT_jump) }
-	'foreign'	{ L _ (CmmT_foreign) }
-	'import'	{ L _ (CmmT_import) }
-	'switch'	{ L _ (CmmT_switch) }
-	'case'		{ L _ (CmmT_case) }
-	'default'	{ L _ (CmmT_default) }
-	'bits8'		{ L _ (CmmT_bits8) }
-	'bits16'	{ L _ (CmmT_bits16) }
-	'bits32'	{ L _ (CmmT_bits32) }
-	'bits64'	{ L _ (CmmT_bits64) }
-	'float32'	{ L _ (CmmT_float32) }
-	'float64'	{ L _ (CmmT_float64) }
-
-	GLOBALREG	{ L _ (CmmT_GlobalReg   $$) }
-  	NAME		{ L _ (CmmT_Name	$$) }
-	STRING		{ L _ (CmmT_String	$$) }
-	INT		{ L _ (CmmT_Int		$$) }
-	FLOAT		{ L _ (CmmT_Float	$$) }
-
-%monad { P } { >>= } { return }
-%lexer { cmmlex } { L _ CmmT_EOF }
-%name cmmParse cmm
-%tokentype { Located CmmToken }
-
--- C-- operator precedences, taken from the C-- spec
-%right '||'	-- non-std extension, called %disjoin in C--
-%right '&&'	-- non-std extension, called %conjoin in C--
-%right '!'
-%nonassoc '>=' '>' '<=' '<' '!=' '=='
-%left '|'
-%left '^'
-%left '&'
-%left '>>' '<<'
-%left '-' '+'
-%left '/' '*' '%'
-%right '~'
-
-%%
-
-cmm	:: { ExtCode }
-	: {- empty -}			{ return () }
-	| cmmtop cmm			{ do $1; $2 }
-
-cmmtop	:: { ExtCode }
-	: cmmproc			{ $1 }
-	| cmmdata			{ $1 }
-	| decl				{ $1 } 
-	| 'CLOSURE' '(' NAME ',' NAME lits ')' ';'  
-		{ do lits <- sequence $6;
-		     staticClosure $3 $5 (map getLit lits) }
-
--- The only static closures in the RTS are dummy closures like
--- stg_END_TSO_QUEUE_closure and stg_dummy_ret.  We don't need
--- to provide the full generality of static closures here.
--- In particular:
--- 	* CCS can always be CCS_DONT_CARE
--- 	* closure is always extern
--- 	* payload is always empty
---	* we can derive closure and info table labels from a single NAME
-
-cmmdata :: { ExtCode }
-	: 'section' STRING '{' statics '}' 
-		{ do ss <- sequence $4;
-		     code (emitData (section $2) (concat ss)) }
-
-statics	:: { [ExtFCode [CmmStatic]] }
-	: {- empty -}			{ [] }
-	| static statics		{ $1 : $2 }
-
--- Strings aren't used much in the RTS HC code, so it doesn't seem
--- worth allowing inline strings.  C-- doesn't allow them anyway.
-static 	:: { ExtFCode [CmmStatic] }
-	: NAME ':'	{ return [CmmDataLabel (mkRtsDataLabelFS $1)] }
-	| type expr ';'	{ do e <- $2;
-			     return [CmmStaticLit (getLit e)] }
-	| type ';'			{ return [CmmUninitialised
-							(machRepByteWidth $1)] }
-        | 'bits8' '[' ']' STRING ';'	{ return [mkString $4] }
-        | 'bits8' '[' INT ']' ';'	{ return [CmmUninitialised 
-							(fromIntegral $3)] }
-        | typenot8 '[' INT ']' ';'	{ return [CmmUninitialised 
-						(machRepByteWidth $1 * 
-							fromIntegral $3)] }
-	| 'align' INT ';'		{ return [CmmAlign (fromIntegral $2)] }
-	| 'CLOSURE' '(' NAME lits ')'
-		{ do lits <- sequence $4;
-		     return $ map CmmStaticLit $
-		       mkStaticClosure (mkRtsInfoLabelFS $3) 
-			 dontCareCCS (map getLit lits) [] [] [] }
-	-- arrays of closures required for the CHARLIKE & INTLIKE arrays
-
-lits	:: { [ExtFCode CmmExpr] }
-	: {- empty -}		{ [] }
-	| ',' expr lits		{ $2 : $3 }
-
-cmmproc :: { ExtCode }
-	: info '{' body '}'
-		{ do  (info_lbl, info1, info2) <- $1;
-		      stmts <- getCgStmtsEC (loopDecls $3)
-		      blks <- code (cgStmtsToBlocks stmts)
-		      code (emitInfoTableAndCode info_lbl info1 info2 [] blks) }
-
-	| info ';'
-		{ do (info_lbl, info1, info2) <- $1;
-		     code (emitInfoTableAndCode info_lbl info1 info2 [] []) }
-
-	| NAME '{' body '}'
-		{ do stmts <- getCgStmtsEC (loopDecls $3);
-		     blks <- code (cgStmtsToBlocks stmts)
-		     code (emitProc [] (mkRtsCodeLabelFS $1) [] blks) }
-
-info	:: { ExtFCode (CLabel, [CmmLit],[CmmLit]) }
-	: 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
-		-- ptrs, nptrs, closure type, description, type
-		{ stdInfo $3 $5 $7 0 $9 $11 $13 }
-	
-	| 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
-		-- ptrs, nptrs, closure type, description, type, fun type
-		{ funInfo $3 $5 $7 $9 $11 $13 $15 }
-	
-	| 'INFO_TABLE_CONSTR' '(' NAME ',' INT ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
-		-- ptrs, nptrs, tag, closure type, description, type
-		{ stdInfo $3 $5 $7 $9 $11 $13 $15 }
-	
-	| 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')'
-		-- selector, closure type, description, type
-		{ basicInfo $3 (mkIntCLit (fromIntegral $5)) 0 $7 $9 $11 }
-
-	| 'INFO_TABLE_RET' '(' NAME ',' INT ',' INT ',' INT maybe_vec ')'
-		{ retInfo $3 $5 $7 $9 $10 }
-
-maybe_vec :: { [CmmLit] }
-	: {- empty -}			{ [] }
-	| ',' NAME maybe_vec		{ CmmLabel (mkRtsCodeLabelFS $2) : $3 }
-
-body	:: { ExtCode }
-	: {- empty -}			{ return () }
-	| decl body			{ do $1; $2 }
-	| stmt body			{ do $1; $2 }
-
-decl	:: { ExtCode }
-	: type names ';'		{ mapM_ (newLocal $1) $2 }
-	| 'import' names ';'		{ return () }  -- ignore imports
-	| 'export' names ';'		{ return () }  -- ignore exports
-
-names 	:: { [FastString] }
-	: NAME			{ [$1] }
-	| NAME ',' names	{ $1 : $3 }
-
-stmt	:: { ExtCode }
-	: ';'					{ nopEC }
-
-	| block_id ':'				{ code (labelC $1) }
-
-	| lreg '=' expr ';'			
-		{ do reg <- $1; e <- $3; stmtEC (CmmAssign reg e) }
-	| type '[' expr ']' '=' expr ';'
-		{ doStore $1 $3 $6 }
-	| 'foreign' STRING expr '(' hint_exprs0 ')' vols ';'
-		{% foreignCall $2 [] $3 $5 $7 }
-	| lreg '=' 'foreign' STRING expr '(' hint_exprs0 ')' vols ';'
-		{% let result = do r <- $1; return (r,NoHint) in
-		   foreignCall $4 [result] $5 $7 $9 }
-	| STRING lreg '=' 'foreign' STRING expr '(' hint_exprs0 ')' vols ';'
-		{% do h <- parseHint $1;
-		      let result = do r <- $2; return (r,h) in
-		      foreignCall $5 [result] $6 $8 $10 }
-	-- stmt-level macros, stealing syntax from ordinary C-- function calls.
-	-- Perhaps we ought to use the %%-form?
-	| NAME '(' exprs0 ')' ';'
-		{% stmtMacro $1 $3  }
-	| 'switch' maybe_range expr '{' arms default '}'
-		{ doSwitch $2 $3 $5 $6 }
-	| 'goto' block_id ';'
-		{ stmtEC (CmmBranch $2) }
-	| 'jump' expr {-maybe_actuals-} ';'
-		{ do e <- $2; stmtEC (CmmJump e []) }
-	| 'if' bool_expr '{' body '}' else 	
-		{ ifThenElse $2 $4 $6 }
-
-bool_expr :: { ExtFCode BoolExpr }
-	: bool_op			{ $1 }
-	| expr				{ do e <- $1; return (BoolTest e) }
-
-bool_op :: { ExtFCode BoolExpr }
-	: bool_expr '&&' bool_expr 	{ do e1 <- $1; e2 <- $3; 
-					  return (BoolAnd e1 e2) }
-	| bool_expr '||' bool_expr	{ do e1 <- $1; e2 <- $3; 
-					  return (BoolOr e1 e2)  }
-	| '!' bool_expr			{ do e <- $2; return (BoolNot e) }
-	| '(' bool_op ')'		{ $2 }
-
--- This is not C-- syntax.  What to do?
-vols 	:: { Maybe [GlobalReg] }
-	: {- empty -}			{ Nothing }
-	| '[' ']'		        { Just [] }
-	| '[' globals ']'		{ Just $2 }
-
-globals :: { [GlobalReg] }
-	: GLOBALREG			{ [$1] }
-	| GLOBALREG ',' globals		{ $1 : $3 }
-
-maybe_range :: { Maybe (Int,Int) }
-	: '[' INT '..' INT ']'	{ Just (fromIntegral $2, fromIntegral $4) }
-	| {- empty -}		{ Nothing }
-
-arms	:: { [([Int],ExtCode)] }
-	: {- empty -}			{ [] }
-	| arm arms			{ $1 : $2 }
-
-arm	:: { ([Int],ExtCode) }
-	: 'case' ints ':' '{' body '}'	{ ($2, $5) }
-
-ints	:: { [Int] }
-	: INT				{ [ fromIntegral $1 ] }
-	| INT ',' ints			{ fromIntegral $1 : $3 }
-
-default :: { Maybe ExtCode }
-	: 'default' ':' '{' body '}'	{ Just $4 }
-	-- taking a few liberties with the C-- syntax here; C-- doesn't have
-	-- 'default' branches
-	| {- empty -}			{ Nothing }
-
-else 	:: { ExtCode }
-	: {- empty -}			{ nopEC }
-	| 'else' '{' body '}'		{ $3 }
-
--- we have to write this out longhand so that Happy's precedence rules
--- can kick in.
-expr	:: { ExtFCode CmmExpr } 
-	: expr '/' expr			{ mkMachOp MO_U_Quot [$1,$3] }
-	| expr '*' expr			{ mkMachOp MO_Mul [$1,$3] }
-	| expr '%' expr			{ mkMachOp MO_U_Rem [$1,$3] }
-	| expr '-' expr			{ mkMachOp MO_Sub [$1,$3] }
-	| expr '+' expr			{ mkMachOp MO_Add [$1,$3] }
-	| expr '>>' expr		{ mkMachOp MO_U_Shr [$1,$3] }
-	| expr '<<' expr		{ mkMachOp MO_Shl [$1,$3] }
-	| expr '&' expr			{ mkMachOp MO_And [$1,$3] }
-	| expr '^' expr			{ mkMachOp MO_Xor [$1,$3] }
-	| expr '|' expr			{ mkMachOp MO_Or [$1,$3] }
-	| expr '>=' expr		{ mkMachOp MO_U_Ge [$1,$3] }
-	| expr '>' expr			{ mkMachOp MO_U_Gt [$1,$3] }
-	| expr '<=' expr		{ mkMachOp MO_U_Le [$1,$3] }
-	| expr '<' expr			{ mkMachOp MO_U_Lt [$1,$3] }
-	| expr '!=' expr		{ mkMachOp MO_Ne [$1,$3] }
-	| expr '==' expr		{ mkMachOp MO_Eq [$1,$3] }
-	| '~' expr			{ mkMachOp MO_Not [$2] }
-	| '-' expr			{ mkMachOp MO_S_Neg [$2] }
-	| expr0 '`' NAME '`' expr0  	{% do { mo <- nameToMachOp $3 ;
-					        return (mkMachOp mo [$1,$5]) } }
-	| expr0				{ $1 }
-
-expr0	:: { ExtFCode CmmExpr }
-	: INT   maybe_ty	 { return (CmmLit (CmmInt $1 $2)) }
-	| FLOAT maybe_ty	 { return (CmmLit (CmmFloat $1 $2)) }
-	| STRING		 { do s <- code (mkStringCLit $1); 
-				      return (CmmLit s) }
-	| reg			 { $1 }
-	| type '[' expr ']'	 { do e <- $3; return (CmmLoad e $1) }
-	| '%' NAME '(' exprs0 ')' {% exprOp $2 $4 }
-	| '(' expr ')'		 { $2 }
-
-
--- leaving out the type of a literal gives you the native word size in C--
-maybe_ty :: { MachRep }
-	: {- empty -}			{ wordRep }
-	| '::' type			{ $2 }
-
-hint_exprs0 :: { [ExtFCode (CmmExpr, MachHint)] }
-	: {- empty -}			{ [] }
-	| hint_exprs			{ $1 }
-
-hint_exprs :: { [ExtFCode (CmmExpr, MachHint)] }
-	: hint_expr			{ [$1] }
-	| hint_expr ',' hint_exprs	{ $1 : $3 }
-
-hint_expr :: { ExtFCode (CmmExpr, MachHint) }
-	: expr				{ do e <- $1; return (e, inferHint e) }
-	| expr STRING			{% do h <- parseHint $2;
-					      return $ do
-						e <- $1; return (e,h) }
-
-exprs0  :: { [ExtFCode CmmExpr] }
-	: {- empty -}			{ [] }
-	| exprs				{ $1 }
-
-exprs	:: { [ExtFCode CmmExpr] }
-	: expr				{ [ $1 ] }
-	| expr ',' exprs		{ $1 : $3 }
-
-reg	:: { ExtFCode CmmExpr }
-	: NAME			{ lookupName $1 }
-	| GLOBALREG		{ return (CmmReg (CmmGlobal $1)) }
-
-lreg	:: { ExtFCode CmmReg }
-	: NAME			{ do e <- lookupName $1;
-				     return $
-				       case e of 
-					CmmReg r -> r
-					other -> pprPanic "CmmParse:" (ftext $1 <> text " not a register") }
-	| GLOBALREG		{ return (CmmGlobal $1) }
-
-block_id :: { BlockId }
-	: NAME			{ BlockId (newTagUnique (getUnique $1) 'L') }
-			-- TODO: ugh.  The unique of a FastString has a null
-			-- tag, so we have to put our own tag on.  We should
-			-- really make a new unique for every label, and keep
-			-- them in an environment.
-
-type	:: { MachRep }
-	: 'bits8'		{ I8 }
-	| typenot8		{ $1 }
-
-typenot8 :: { MachRep }
-	: 'bits16'		{ I16 }
-	| 'bits32'		{ I32 }
-	| 'bits64'		{ I64 }
-	| 'float32'		{ F32 }
-	| 'float64'		{ F64 }
-{
-section :: String -> Section
-section "text"	 = Text
-section "data" 	 = Data
-section "rodata" = ReadOnlyData
-section "bss"	 = UninitialisedData
-section s	 = OtherSection s
-
-mkString :: String -> CmmStatic
-mkString s = CmmString (map (fromIntegral.ord) s)
-
--- mkMachOp infers the type of the MachOp from the type of its first
--- argument.  We assume that this is correct: for MachOps that don't have
--- symmetrical args (e.g. shift ops), the first arg determines the type of
--- the op.
-mkMachOp :: (MachRep -> MachOp) -> [ExtFCode CmmExpr] -> ExtFCode CmmExpr
-mkMachOp fn args = do
-  arg_exprs <- sequence args
-  return (CmmMachOp (fn (cmmExprRep (head arg_exprs))) arg_exprs)
-
-getLit :: CmmExpr -> CmmLit
-getLit (CmmLit l) = l
-getLit (CmmMachOp (MO_S_Neg _) [CmmLit (CmmInt i r)])  = CmmInt (negate i) r
-getLit _ = panic "invalid literal" -- TODO messy failure
-
-nameToMachOp :: FastString -> P (MachRep -> MachOp)
-nameToMachOp name = 
-  case lookupUFM machOps name of
-	Nothing -> fail ("unknown primitive " ++ unpackFS name)
-	Just m  -> return m
-
-exprOp :: FastString -> [ExtFCode CmmExpr] -> P (ExtFCode CmmExpr)
-exprOp name args_code =
-  case lookupUFM exprMacros name of
-     Just f  -> return $ do
-        args <- sequence args_code
-	return (f args)
-     Nothing -> do
-	mo <- nameToMachOp name
-	return $ mkMachOp mo args_code
-
-exprMacros :: UniqFM ([CmmExpr] -> CmmExpr)
-exprMacros = listToUFM [
-  ( FSLIT("ENTRY_CODE"),   \ [x] -> entryCode x ),
-  ( FSLIT("INFO_PTR"),     \ [x] -> closureInfoPtr x ),
-  ( FSLIT("STD_INFO"),     \ [x] -> infoTable x ),
-  ( FSLIT("FUN_INFO"),     \ [x] -> funInfoTable x ),
-  ( FSLIT("GET_ENTRY"),    \ [x] -> entryCode (closureInfoPtr x) ),
-  ( FSLIT("GET_STD_INFO"), \ [x] -> infoTable (closureInfoPtr x) ),
-  ( FSLIT("GET_FUN_INFO"), \ [x] -> funInfoTable (closureInfoPtr x) ),
-  ( FSLIT("INFO_TYPE"),    \ [x] -> infoTableClosureType x ),
-  ( FSLIT("INFO_PTRS"),    \ [x] -> infoTablePtrs x ),
-  ( FSLIT("INFO_NPTRS"),   \ [x] -> infoTableNonPtrs x ),
-  ( FSLIT("RET_VEC"),      \ [info, conZ] -> retVec info conZ )
-  ]
-
--- we understand a subset of C-- primitives:
-machOps = listToUFM $
-	map (\(x, y) -> (mkFastString x, y)) [
-	( "add",	MO_Add ),
-	( "sub",	MO_Sub ),
-	( "eq",		MO_Eq ),
-	( "ne",		MO_Ne ),
-	( "mul",	MO_Mul ),
-	( "neg",	MO_S_Neg ),
-	( "quot",	MO_S_Quot ),
-	( "rem",	MO_S_Rem ),
-	( "divu",	MO_U_Quot ),
-	( "modu",	MO_U_Rem ),
-
-	( "ge",		MO_S_Ge ),
-	( "le",		MO_S_Le ),
-	( "gt",		MO_S_Gt ),
-	( "lt",		MO_S_Lt ),
-
-	( "geu",	MO_U_Ge ),
-	( "leu",	MO_U_Le ),
-	( "gtu",	MO_U_Gt ),
-	( "ltu",	MO_U_Lt ),
-
-	( "flt",	MO_S_Lt ),
-	( "fle",	MO_S_Le ),
-	( "feq",	MO_Eq ),
-	( "fne",	MO_Ne ),
-	( "fgt",	MO_S_Gt ),
-	( "fge",	MO_S_Ge ),
-	( "fneg",	MO_S_Neg ),
-
-	( "and",	MO_And ),
-	( "or",		MO_Or ),
-	( "xor",	MO_Xor ),
-	( "com",	MO_Not ),
-	( "shl",	MO_Shl ),
-	( "shrl",	MO_U_Shr ),
-	( "shra",	MO_S_Shr ),
-
-	( "lobits8",  flip MO_U_Conv I8  ),
-	( "lobits16", flip MO_U_Conv I16 ),
-	( "lobits32", flip MO_U_Conv I32 ),
-	( "lobits64", flip MO_U_Conv I64 ),
-	( "sx16",     flip MO_S_Conv I16 ),
-	( "sx32",     flip MO_S_Conv I32 ),
-	( "sx64",     flip MO_S_Conv I64 ),
-	( "zx16",     flip MO_U_Conv I16 ),
-	( "zx32",     flip MO_U_Conv I32 ),
-	( "zx64",     flip MO_U_Conv I64 ),
-	( "f2f32",    flip MO_S_Conv F32 ),  -- TODO; rounding mode
-	( "f2f64",    flip MO_S_Conv F64 ),  -- TODO; rounding mode
-	( "f2i8",     flip MO_S_Conv I8 ),
-	( "f2i16",    flip MO_S_Conv I8 ),
-	( "f2i32",    flip MO_S_Conv I8 ),
-	( "f2i64",    flip MO_S_Conv I8 ),
-	( "i2f32",    flip MO_S_Conv F32 ),
-	( "i2f64",    flip MO_S_Conv F64 )
-	]
-
-parseHint :: String -> P MachHint
-parseHint "ptr"    = return PtrHint
-parseHint "signed" = return SignedHint
-parseHint "float"  = return FloatHint
-parseHint str      = fail ("unrecognised hint: " ++ str)
-
--- labels are always pointers, so we might as well infer the hint
-inferHint :: CmmExpr -> MachHint
-inferHint (CmmLit (CmmLabel _)) = PtrHint
-inferHint (CmmReg (CmmGlobal g)) | isPtrGlobalReg g = PtrHint
-inferHint _ = NoHint
-
-isPtrGlobalReg Sp		= True
-isPtrGlobalReg SpLim		= True
-isPtrGlobalReg Hp		= True
-isPtrGlobalReg HpLim		= True
-isPtrGlobalReg CurrentTSO	= True
-isPtrGlobalReg CurrentNursery	= True
-isPtrGlobalReg _		= False
-
-happyError :: P a
-happyError = srcParseFail
-
--- -----------------------------------------------------------------------------
--- Statement-level macros
-
-stmtMacro :: FastString -> [ExtFCode CmmExpr] -> P ExtCode
-stmtMacro fun args_code = do
-  case lookupUFM stmtMacros fun of
-    Nothing -> fail ("unknown macro: " ++ unpackFS fun)
-    Just fcode -> return $ do
-	args <- sequence args_code
-	code (fcode args)
-
-stmtMacros :: UniqFM ([CmmExpr] -> Code)
-stmtMacros = listToUFM [
-  ( FSLIT("CCS_ALLOC"),		   \[words,ccs]  -> profAlloc words ccs ),
-  ( FSLIT("CLOSE_NURSERY"),	   \[]  -> emitCloseNursery ),
-  ( FSLIT("ENTER_CCS_PAP_CL"),     \[e] -> enterCostCentrePAP e ),
-  ( FSLIT("ENTER_CCS_THUNK"),      \[e] -> enterCostCentreThunk e ),
-  ( FSLIT("HP_CHK_GEN"),           \[words,liveness,reentry] -> 
-                                      hpChkGen words liveness reentry ),
-  ( FSLIT("HP_CHK_NP_ASSIGN_SP0"), \[e,f] -> hpChkNodePointsAssignSp0 e f ),
-  ( FSLIT("LOAD_THREAD_STATE"),    \[] -> emitLoadThreadState ),
-  ( FSLIT("LDV_ENTER"),            \[e] -> ldvEnter e ),
-  ( FSLIT("LDV_RECORD_CREATE"),    \[e] -> ldvRecordCreate e ),
-  ( FSLIT("OPEN_NURSERY"),	   \[]  -> emitOpenNursery ),
-  ( FSLIT("PUSH_UPD_FRAME"),	   \[sp,e] -> emitPushUpdateFrame sp e ),
-  ( FSLIT("SAVE_THREAD_STATE"),    \[] -> emitSaveThreadState ),
-  ( FSLIT("SET_HDR"),		   \[ptr,info,ccs] -> 
-					emitSetDynHdr ptr info ccs ),
-  ( FSLIT("STK_CHK_GEN"),          \[words,liveness,reentry] -> 
-                                      stkChkGen words liveness reentry ),
-  ( FSLIT("STK_CHK_NP"),	   \[e] -> stkChkNodePoints e ),
-  ( FSLIT("TICK_ALLOC_PRIM"), 	   \[hdr,goods,slop] -> 
-					tickyAllocPrim hdr goods slop ),
-  ( FSLIT("TICK_ALLOC_PAP"),       \[goods,slop] -> 
-					tickyAllocPAP goods slop ),
-  ( FSLIT("TICK_ALLOC_UP_THK"),    \[goods,slop] -> 
-					tickyAllocThunk goods slop ),
-  ( FSLIT("UPD_BH_UPDATABLE"),       \[] -> emitBlackHoleCode False ),
-  ( FSLIT("UPD_BH_SINGLE_ENTRY"),    \[] -> emitBlackHoleCode True ),
-
-  ( FSLIT("RET_P"),	\[a] ->       emitRetUT [(PtrArg,a)]),
-  ( FSLIT("RET_N"),	\[a] ->       emitRetUT [(NonPtrArg,a)]),
-  ( FSLIT("RET_PP"),	\[a,b] ->     emitRetUT [(PtrArg,a),(PtrArg,b)]),
-  ( FSLIT("RET_NN"),	\[a,b] ->     emitRetUT [(NonPtrArg,a),(NonPtrArg,b)]),
-  ( FSLIT("RET_NP"),	\[a,b] ->     emitRetUT [(NonPtrArg,a),(PtrArg,b)]),
-  ( FSLIT("RET_PPP"),	\[a,b,c] ->   emitRetUT [(PtrArg,a),(PtrArg,b),(PtrArg,c)]),
-  ( FSLIT("RET_NNP"),	\[a,b,c] ->   emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(PtrArg,c)]),
-  ( FSLIT("RET_NNNP"),	\[a,b,c,d] -> emitRetUT [(NonPtrArg,a),(NonPtrArg,b),(NonPtrArg,c),(PtrArg,d)]),
-  ( FSLIT("RET_NPNP"),	\[a,b,c,d] -> emitRetUT [(NonPtrArg,a),(PtrArg,b),(NonPtrArg,c),(PtrArg,d)])
-
- ]
-
--- -----------------------------------------------------------------------------
--- Our extended FCode monad.
-
--- We add a mapping from names to CmmExpr, to support local variable names in
--- the concrete C-- code.  The unique supply of the underlying FCode monad
--- is used to grab a new unique for each local variable.
-
--- In C--, a local variable can be declared anywhere within a proc,
--- and it scopes from the beginning of the proc to the end.  Hence, we have
--- to collect declarations as we parse the proc, and feed the environment
--- back in circularly (to avoid a two-pass algorithm).
-
-type Decls = [(FastString,CmmExpr)]
-type Env   = UniqFM CmmExpr
-
-newtype ExtFCode a = EC { unEC :: Env -> Decls -> FCode (Decls, a) }
-
-type ExtCode = ExtFCode ()
-
-returnExtFC a = EC $ \e s -> return (s, a)
-thenExtFC (EC m) k = EC $ \e s -> do (s',r) <- m e s; unEC (k r) e s'
-
-instance Monad ExtFCode where
-  (>>=) = thenExtFC
-  return = returnExtFC
-
--- This function takes the variable decarations and imports and makes 
--- an environment, which is looped back into the computation.  In this
--- way, we can have embedded declarations that scope over the whole
--- procedure, and imports that scope over the entire module.
-loopDecls :: ExtFCode a -> ExtFCode a
-loopDecls (EC fcode) = 
-   EC $ \e s -> fixC (\ ~(decls,a) -> fcode (addListToUFM e decls) [])
-
-getEnv :: ExtFCode Env
-getEnv = EC $ \e s -> return (s, e)
-
-addVarDecl :: FastString -> CmmExpr -> ExtCode
-addVarDecl var expr = EC $ \e s -> return ((var,expr):s, ())
-
-newLocal :: MachRep -> FastString -> ExtCode
-newLocal ty name  = do
-   u <- code newUnique
-   addVarDecl name (CmmReg (CmmLocal (LocalReg u ty)))
-
--- Unknown names are treated as if they had been 'import'ed.
--- This saves us a lot of bother in the RTS sources, at the expense of
--- deferring some errors to link time.
-lookupName :: FastString -> ExtFCode CmmExpr
-lookupName name = do
-  env <- getEnv
-  return $ 
-     case lookupUFM env name of
-	Nothing -> CmmLit (CmmLabel (mkRtsCodeLabelFS name))
-	Just e  -> e
-
--- Lifting FCode computations into the ExtFCode monad:
-code :: FCode a -> ExtFCode a
-code fc = EC $ \e s -> do r <- fc; return (s, r)
-
-code2 :: (FCode (Decls,b) -> FCode ((Decls,b),c))
-	 -> ExtFCode b -> ExtFCode c
-code2 f (EC ec) = EC $ \e s -> do ((s',b),c) <- f (ec e s); return (s',c)
-
-nopEC = code nopC
-stmtEC stmt = code (stmtC stmt)
-stmtsEC stmts = code (stmtsC stmts)
-getCgStmtsEC = code2 getCgStmts'
-
-forkLabelledCodeEC ec = do
-  stmts <- getCgStmtsEC ec
-  code (forkCgStmts stmts)
-
-retInfo name size live_bits cl_type vector = do
-  let liveness = smallLiveness (fromIntegral size) (fromIntegral live_bits)
-      info_lbl = mkRtsRetInfoLabelFS name
-      (info1,info2) = mkRetInfoTable info_lbl liveness NoC_SRT 
-				(fromIntegral cl_type) vector
-  return (info_lbl, info1, info2)
-
-stdInfo name ptrs nptrs srt_bitmap cl_type desc_str ty_str =
-  basicInfo name (packHalfWordsCLit ptrs nptrs) 
-	srt_bitmap cl_type desc_str ty_str
-
-basicInfo name layout srt_bitmap cl_type desc_str ty_str = do
-  lit1 <- if opt_SccProfilingOn 
-		   then code $ mkStringCLit desc_str
-		   else return (mkIntCLit 0)
-  lit2 <- if opt_SccProfilingOn 
-		   then code $ mkStringCLit ty_str
-		   else return (mkIntCLit 0)
-  let info1 = mkStdInfoTable lit1 lit2 (fromIntegral cl_type) 
-			(fromIntegral srt_bitmap)
-			layout
-  return (mkRtsInfoLabelFS name, info1, [])
-
-funInfo name ptrs nptrs cl_type desc_str ty_str fun_type = do
-  (label,info1,_) <- stdInfo name ptrs nptrs 0{-srt_bitmap-}
-			 cl_type desc_str ty_str 
-  let info2 = mkFunGenInfoExtraBits (fromIntegral fun_type) 0 zero zero zero
-		-- we leave most of the fields zero here.  This is only used
-		-- to generate the BCO info table in the RTS at the moment.
-  return (label,info1,info2)
- where
-   zero = mkIntCLit 0
-
-
-staticClosure :: FastString -> FastString -> [CmmLit] -> ExtCode
-staticClosure cl_label info payload
-  = code $ emitDataLits (mkRtsDataLabelFS cl_label) lits
-  where  lits = mkStaticClosure (mkRtsInfoLabelFS info) dontCareCCS payload [] [] []
-
-foreignCall
-	:: String
-	-> [ExtFCode (CmmReg,MachHint)]
-	-> ExtFCode CmmExpr
-	-> [ExtFCode (CmmExpr,MachHint)]
-	-> Maybe [GlobalReg] -> P ExtCode
-foreignCall "C" results_code expr_code args_code vols
-  = return $ do
-	results <- sequence results_code
-	expr <- expr_code
-	args <- sequence args_code
-        code (emitForeignCall' PlayRisky results 
-                 (CmmForeignCall expr CCallConv) args vols)
-foreignCall conv _ _ _ _
-  = fail ("unknown calling convention: " ++ conv)
-
-doStore :: MachRep -> ExtFCode CmmExpr  -> ExtFCode CmmExpr -> ExtCode
-doStore rep addr_code val_code
-  = do addr <- addr_code
-       val <- val_code
-	-- if the specified store type does not match the type of the expr
-	-- on the rhs, then we insert a coercion that will cause the type
-	-- mismatch to be flagged by cmm-lint.  If we don't do this, then
-	-- the store will happen at the wrong type, and the error will not
-	-- be noticed.
-       let coerce_val 
-		| cmmExprRep val /= rep = CmmMachOp (MO_U_Conv rep rep) [val]
-		| otherwise             = val
-       stmtEC (CmmStore addr coerce_val)
-
--- Return an unboxed tuple.
-emitRetUT :: [(CgRep,CmmExpr)] -> Code
-emitRetUT args = do
-  tickyUnboxedTupleReturn (length args)  -- TICK
-  (sp, stmts) <- pushUnboxedTuple 0 args
-  emitStmts stmts
-  when (sp /= 0) $ stmtC (CmmAssign spReg (cmmRegOffW spReg (-sp)))
-  stmtC (CmmJump (entryCode (CmmLoad (cmmRegOffW spReg sp) wordRep)) [])
-
--- -----------------------------------------------------------------------------
--- If-then-else and boolean expressions
-
-data BoolExpr
-  = BoolExpr `BoolAnd` BoolExpr
-  | BoolExpr `BoolOr`  BoolExpr
-  | BoolNot BoolExpr
-  | BoolTest CmmExpr
-
--- ToDo: smart constructors which simplify the boolean expression.
-
-ifThenElse cond then_part else_part = do
-     then_id <- code newLabelC
-     join_id <- code newLabelC
-     c <- cond
-     emitCond c then_id
-     else_part
-     stmtEC (CmmBranch join_id)
-     code (labelC then_id)
-     then_part
-     -- fall through to join
-     code (labelC join_id)
-
--- 'emitCond cond true_id'  emits code to test whether the cond is true,
--- branching to true_id if so, and falling through otherwise.
-emitCond (BoolTest e) then_id = do
-  stmtEC (CmmCondBranch e then_id)
-emitCond (BoolNot (BoolTest (CmmMachOp op args))) then_id
-  | Just op' <- maybeInvertComparison op
-  = emitCond (BoolTest (CmmMachOp op' args)) then_id
-emitCond (BoolNot e) then_id = do
-  else_id <- code newLabelC
-  emitCond e else_id
-  stmtEC (CmmBranch then_id)
-  code (labelC else_id)
-emitCond (e1 `BoolOr` e2) then_id = do
-  emitCond e1 then_id
-  emitCond e2 then_id
-emitCond (e1 `BoolAnd` e2) then_id = do
-	-- we'd like to invert one of the conditionals here to avoid an
-	-- extra branch instruction, but we can't use maybeInvertComparison
-	-- here because we can't look too closely at the expression since
-	-- we're in a loop.
-  and_id <- code newLabelC
-  else_id <- code newLabelC
-  emitCond e1 and_id
-  stmtEC (CmmBranch else_id)
-  code (labelC and_id)
-  emitCond e2 then_id
-  code (labelC else_id)
-
-
--- -----------------------------------------------------------------------------
--- Table jumps
-
--- We use a simplified form of C-- switch statements for now.  A
--- switch statement always compiles to a table jump.  Each arm can
--- specify a list of values (not ranges), and there can be a single
--- default branch.  The range of the table is given either by the
--- optional range on the switch (eg. switch [0..7] {...}), or by
--- the minimum/maximum values from the branches.
-
-doSwitch :: Maybe (Int,Int) -> ExtFCode CmmExpr -> [([Int],ExtCode)]
-         -> Maybe ExtCode -> ExtCode
-doSwitch mb_range scrut arms deflt
-   = do 
-	-- Compile code for the default branch
-	dflt_entry <- 
-		case deflt of
-		  Nothing -> return Nothing
-		  Just e  -> do b <- forkLabelledCodeEC e; return (Just b)
-
-	-- Compile each case branch
-	table_entries <- mapM emitArm arms
-
-	-- Construct the table
-	let
-	    all_entries = concat table_entries
-	    ixs = map fst all_entries
-	    (min,max) 
-		| Just (l,u) <- mb_range = (l,u)
-		| otherwise              = (minimum ixs, maximum ixs)
-
-	    entries = elems (accumArray (\_ a -> Just a) dflt_entry (min,max)
-				all_entries)
-	expr <- scrut
-	-- ToDo: check for out of range and jump to default if necessary
-        stmtEC (CmmSwitch expr entries)
-   where
-	emitArm :: ([Int],ExtCode) -> ExtFCode [(Int,BlockId)]
-	emitArm (ints,code) = do
-	   blockid <- forkLabelledCodeEC code
-	   return [ (i,blockid) | i <- ints ]
-
-
--- -----------------------------------------------------------------------------
--- Putting it all together
-
--- The initial environment: we define some constants that the compiler
--- knows about here.
-initEnv :: Env
-initEnv = listToUFM [
-  ( FSLIT("SIZEOF_StgHeader"), 
-	CmmLit (CmmInt (fromIntegral (fixedHdrSize * wORD_SIZE)) wordRep) ),
-  ( FSLIT("SIZEOF_StgInfoTable"),
-        CmmLit (CmmInt (fromIntegral stdInfoTableSizeB) wordRep) )
-  ]
-
-parseCmmFile :: DynFlags -> HomeModules -> FilePath -> IO (Maybe Cmm)
-parseCmmFile dflags hmods filename = do
-  showPass dflags "ParseCmm"
-  buf <- hGetStringBuffer filename
-  let
-	init_loc = mkSrcLoc (mkFastString filename) 1 0
-	init_state = (mkPState buf init_loc dflags) { lex_state = [0] }
-		-- reset the lex_state: the Lexer monad leaves some stuff
-		-- in there we don't want.
-  case unP cmmParse init_state of
-    PFailed span err -> do printError span err; return Nothing
-    POk _ code -> do
-	cmm <- initC dflags hmods no_module (getCmm (unEC code initEnv [] >> return ()))
-	dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms [cmm])
-	return (Just cmm)
-  where
-	no_module = panic "parseCmmFile: no module"
-}
diff --git a/ghc/compiler/cmm/CmmUtils.hs b/ghc/compiler/cmm/CmmUtils.hs
deleted file mode 100644
index a04935b279..0000000000
--- a/ghc/compiler/cmm/CmmUtils.hs
+++ /dev/null
@@ -1,177 +0,0 @@
------------------------------------------------------------------------------
---
--- Cmm utilities.
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
-module CmmUtils( 
-	CmmStmts, noStmts, oneStmt, mkStmts, plusStmts, stmtList,
-	isNopStmt,
-
-	isTrivialCmmExpr, hasNoGlobalRegs,
-
-	cmmRegOff, cmmLabelOff, cmmOffset, cmmOffsetLit, cmmIndex,
-	cmmOffsetExpr, cmmIndexExpr, cmmLoadIndex,
-
- 	mkIntCLit, zeroCLit,
-
-	mkLblExpr,
-  ) where
-
-#include "HsVersions.h"
-
-import CLabel		( CLabel )
-import Cmm
-import MachOp
-import OrdList
-import Outputable
-
----------------------------------------------------
---
---	CmmStmts
---
----------------------------------------------------
-
-type CmmStmts = OrdList CmmStmt
-
-noStmts :: CmmStmts
-noStmts = nilOL
-
-oneStmt :: CmmStmt -> CmmStmts
-oneStmt = unitOL
-
-mkStmts :: [CmmStmt] -> CmmStmts
-mkStmts = toOL
-
-plusStmts :: CmmStmts -> CmmStmts -> CmmStmts
-plusStmts = appOL
-
-stmtList :: CmmStmts -> [CmmStmt]
-stmtList = fromOL
-
-
----------------------------------------------------
---
---	CmmStmt
---
----------------------------------------------------
-
-isNopStmt :: CmmStmt -> Bool
--- If isNopStmt returns True, the stmt is definitely a no-op;
--- but it might be a no-op even if isNopStmt returns False
-isNopStmt CmmNop 		       = True
-isNopStmt (CmmAssign r e) 	       = cheapEqReg r e
-isNopStmt (CmmStore e1 (CmmLoad e2 _)) = cheapEqExpr e1 e2
-isNopStmt s 			       = False
-
-cheapEqExpr :: CmmExpr -> CmmExpr -> Bool
-cheapEqExpr (CmmReg r)      e 		      = cheapEqReg r e
-cheapEqExpr (CmmRegOff r 0) e 		      = cheapEqReg r e
-cheapEqExpr (CmmRegOff r n) (CmmRegOff r' n') = r==r' && n==n'
-cheapEqExpr e1 		    e2		      = False
-
-cheapEqReg :: CmmReg -> CmmExpr -> Bool
-cheapEqReg r (CmmReg r')      = r==r'
-cheapEqReg r (CmmRegOff r' 0) = r==r'
-cheapEqReg r e		      = False
-
----------------------------------------------------
---
---	CmmExpr
---
----------------------------------------------------
-
-isTrivialCmmExpr :: CmmExpr -> Bool
-isTrivialCmmExpr (CmmLoad _ _)   = False
-isTrivialCmmExpr (CmmMachOp _ _) = False
-isTrivialCmmExpr (CmmLit _)      = True
-isTrivialCmmExpr (CmmReg _)      = True
-isTrivialCmmExpr (CmmRegOff _ _) = True
-
-hasNoGlobalRegs :: CmmExpr -> Bool
-hasNoGlobalRegs (CmmLoad e _)   	   = hasNoGlobalRegs e
-hasNoGlobalRegs (CmmMachOp _ es) 	   = all hasNoGlobalRegs es
-hasNoGlobalRegs (CmmLit _)      	   = True
-hasNoGlobalRegs (CmmReg (CmmLocal _))      = True
-hasNoGlobalRegs (CmmRegOff (CmmLocal _) _) = True
-hasNoGlobalRegs _ = False
-
----------------------------------------------------
---
---	Expr Construction helpers
---
----------------------------------------------------
-
-cmmOffsetExpr :: CmmExpr -> CmmExpr -> CmmExpr
--- assumes base and offset have the same MachRep
-cmmOffsetExpr e (CmmLit (CmmInt n _)) = cmmOffset e (fromInteger n)
-cmmOffsetExpr e byte_off = CmmMachOp (MO_Add (cmmExprRep e)) [e, byte_off]
-
--- NB. Do *not* inspect the value of the offset in these smart constructors!!!
---
--- because the offset is sometimes involved in a loop in the code generator
--- (we don't know the real Hp offset until we've generated code for the entire
--- basic block, for example).  So we cannot eliminate zero offsets at this
--- stage; they're eliminated later instead (either during printing or
--- a later optimisation step on Cmm).
---
-cmmOffset :: CmmExpr -> Int -> CmmExpr
-cmmOffset (CmmReg reg)      byte_off = cmmRegOff reg byte_off
-cmmOffset (CmmRegOff reg m) byte_off = cmmRegOff reg (m+byte_off)
-cmmOffset (CmmLit lit)      byte_off = CmmLit (cmmOffsetLit lit byte_off)
-cmmOffset (CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt byte_off1 _rep)]) byte_off2
-  = CmmMachOp (MO_Add rep) 
-	      [expr, CmmLit (CmmInt (byte_off1 + toInteger byte_off2) rep)]
-cmmOffset expr byte_off
-  = CmmMachOp (MO_Add rep) [expr, CmmLit (CmmInt (toInteger byte_off) rep)]
-  where
-    rep = cmmExprRep expr
-
--- Smart constructor for CmmRegOff.  Same caveats as cmmOffset above.
-cmmRegOff :: CmmReg -> Int -> CmmExpr
-cmmRegOff reg byte_off = CmmRegOff reg byte_off
-
-cmmOffsetLit :: CmmLit -> Int -> CmmLit
-cmmOffsetLit (CmmLabel l)      byte_off = cmmLabelOff	l byte_off
-cmmOffsetLit (CmmLabelOff l m) byte_off = cmmLabelOff	l (m+byte_off)
-cmmOffsetLit (CmmInt m rep)    byte_off = CmmInt (m + fromIntegral byte_off) rep
-cmmOffsetLit other	       byte_off = pprPanic "cmmOffsetLit" (ppr byte_off)
-
-cmmLabelOff :: CLabel -> Int -> CmmLit
--- Smart constructor for CmmLabelOff
-cmmLabelOff lbl 0        = CmmLabel lbl
-cmmLabelOff lbl byte_off = CmmLabelOff lbl byte_off
-
--- | Useful for creating an index into an array, with a staticaly known offset.
-cmmIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
-cmmIndex rep base idx = cmmOffset base (idx * machRepByteWidth rep)
-
--- | Useful for creating an index into an array, with an unknown offset.
-cmmIndexExpr :: MachRep -> CmmExpr -> CmmExpr -> CmmExpr
-cmmIndexExpr rep base (CmmLit (CmmInt n _)) = cmmIndex rep base (fromInteger n)
-cmmIndexExpr rep base idx =
-  cmmOffsetExpr base byte_off
-  where
-    idx_rep = cmmExprRep idx
-    byte_off = CmmMachOp (MO_Shl idx_rep) [
-		  idx, CmmLit (mkIntCLit (machRepLogWidth rep))]
-
-cmmLoadIndex :: MachRep -> CmmExpr -> Int -> CmmExpr
-cmmLoadIndex rep expr ix = CmmLoad (cmmIndex rep expr ix) rep
-
----------------------------------------------------
---
---	Literal construction functions
---
----------------------------------------------------
-
-mkIntCLit :: Int -> CmmLit
-mkIntCLit i = CmmInt (toInteger i) wordRep
-
-zeroCLit :: CmmLit
-zeroCLit = CmmInt 0 wordRep
-
-mkLblExpr :: CLabel -> CmmExpr
-mkLblExpr lbl = CmmLit (CmmLabel lbl)
diff --git a/ghc/compiler/cmm/MachOp.hs b/ghc/compiler/cmm/MachOp.hs
deleted file mode 100644
index 5bbff6de78..0000000000
--- a/ghc/compiler/cmm/MachOp.hs
+++ /dev/null
@@ -1,652 +0,0 @@
------------------------------------------------------------------------------
---
--- (c) The University of Glasgow 2002-2004
---
--- Low-level machine operations, used in the Cmm datatype.
---
------------------------------------------------------------------------------
-
-module MachOp 	( 
-	MachRep(..), 
-	machRepBitWidth,
-	machRepByteWidth,
-	machRepLogWidth,
-	isFloatingRep,
-
-	MachHint(..),
-
-	MachOp(..), 
-	pprMachOp,
-	isCommutableMachOp,
-	isAssociativeMachOp,
-	isComparisonMachOp,
-	resultRepOfMachOp,
-	machOpArgReps,
-	maybeInvertComparison,
-
-	CallishMachOp(..),
-	pprCallishMachOp,
-
-	wordRep,
-	halfWordRep,
-	cIntRep, cLongRep,
-
-	mo_wordAdd,
-	mo_wordSub,
-	mo_wordEq,
-	mo_wordNe,
-	mo_wordMul,
-	mo_wordSQuot,
-	mo_wordSRem,
-	mo_wordSNeg,
-	mo_wordUQuot,
-	mo_wordURem,
-
-	mo_wordSGe,
-	mo_wordSLe,
-	mo_wordSGt,
-	mo_wordSLt,
-
-	mo_wordUGe,
-	mo_wordULe,
-	mo_wordUGt,
-	mo_wordULt,
-
-	mo_wordAnd,
-	mo_wordOr,
-	mo_wordXor,
-	mo_wordNot,
-	mo_wordShl,
-	mo_wordSShr,
-	mo_wordUShr,
-
-	mo_u_8To32,
-	mo_s_8To32,
-	mo_u_16To32,
-	mo_s_16To32,
-
-	mo_u_8ToWord,
-	mo_s_8ToWord,
-	mo_u_16ToWord,
-	mo_s_16ToWord,
-	mo_u_32ToWord,
-	mo_s_32ToWord,
-
-	mo_32To8,
-	mo_32To16,
-	mo_WordTo8,
-	mo_WordTo16,
-	mo_WordTo32,
-  ) where
-
-#include "HsVersions.h"
-
-import Constants
-import Outputable
-
--- -----------------------------------------------------------------------------
--- MachRep
-
-{- |
-A MachRep is the "representation" of a value in Cmm.  It is used for
-resource allocation: eg. which kind of register a value should be
-stored in.  
-
-The primary requirement is that there exists a function
-
-  cmmExprRep :: CmmExpr -> MachRep
-
-This means that:
-
-  - a register has an implicit MachRep
-  - a literal has an implicit MachRep
-  - an operation (MachOp) has an implicit result MachRep
-
-It also means that we can check that the arguments to a MachOp have
-the correct MachRep, i.e. we can do a kind of lint-style type checking
-on Cmm.
--}
-
-data MachRep
-  = I8
-  | I16
-  | I32
-  | I64
-  | I128
-  | F32
-  | F64
-  | F80		-- extended double-precision, used in x86 native codegen only.
-  deriving (Eq, Ord, Show)
-
-mrStr I8   = SLIT("I8")
-mrStr I16  = SLIT("I16")
-mrStr I32  = SLIT("I32")
-mrStr I64  = SLIT("I64")
-mrStr I128 = SLIT("I128")
-mrStr F32  = SLIT("F32")
-mrStr F64  = SLIT("F64")
-mrStr F80  = SLIT("F80")
-
-instance Outputable MachRep where
-   ppr rep = ptext (mrStr rep)
-
-{- 
-Implementation notes:
-
-It might suffice to keep just a width, without distinguishing between
-floating and integer types.  However, keeping the distinction will
-help the native code generator to assign registers more easily.
--}
-
-{-
-Should a MachRep include a signed vs. unsigned distinction?
-
-This is very much like a "hint" in C-- terminology: it isn't necessary
-in order to generate correct code, but it might be useful in that the
-compiler can generate better code if it has access to higher-level
-hints about data.  This is important at call boundaries, because the
-definition of a function is not visible at all of its call sites, so
-the compiler cannot infer the hints.
-
-Here in Cmm, we're taking a slightly different approach.  We include
-the int vs. float hint in the MachRep, because (a) the majority of
-platforms have a strong distinction between float and int registers,
-and (b) we don't want to do any heavyweight hint-inference in the
-native code backend in order to get good code.  We're treating the
-hint more like a type: our Cmm is always completely consistent with
-respect to hints.  All coercions between float and int are explicit.
-
-What about the signed vs. unsigned hint?  This information might be
-useful if we want to keep sub-word-sized values in word-size
-registers, which we must do if we only have word-sized registers.
-
-On such a system, there are two straightforward conventions for
-representing sub-word-sized values:
-
-(a) Leave the upper bits undefined.  Comparison operations must
-    sign- or zero-extend both operands before comparing them,
-    depending on whether the comparison is signed or unsigned.
-
-(b) Always keep the values sign- or zero-extended as appropriate.
-    Arithmetic operations must narrow the result to the appropriate
-    size.
-
-A clever compiler might not use either (a) or (b) exclusively, instead
-it would attempt to minimize the coercions by analysis: the same kind
-of analysis that propagates hints around.  In Cmm we don't want to
-have to do this, so we plump for having richer types and keeping the
-type information consistent.
-
-If signed/unsigned hints are missing from MachRep, then the only
-choice we have is (a), because we don't know whether the result of an
-operation should be sign- or zero-extended.
-
-Many architectures have extending load operations, which work well
-with (b).  To make use of them with (a), you need to know whether the
-value is going to be sign- or zero-extended by an enclosing comparison
-(for example), which involves knowing above the context.  This is
-doable but more complex.
-
-Further complicating the issue is foreign calls: a foreign calling
-convention can specify that signed 8-bit quantities are passed as
-sign-extended 32 bit quantities, for example (this is the case on the
-PowerPC).  So we *do* need sign information on foreign call arguments.
-
-Pros for adding signed vs. unsigned to MachRep:
-
-  - It would let us use convention (b) above, and get easier
-    code generation for extending loads.
-
-  - Less information required on foreign calls.
-  
-  - MachOp type would be simpler
-
-Cons:
-
-  - More complexity
-
-  - What is the MachRep for a VanillaReg?  Currently it is
-    always wordRep, but now we have to decide whether it is
-    signed or unsigned.  The same VanillaReg can thus have
-    different MachReps in different parts of the program.
-
-  - Extra coercions cluttering up expressions.
-
-Currently for GHC, the foreign call point is moot, because we do our
-own promotion of sub-word-sized values to word-sized values.  The Int8
-type is represnted by an Int# which is kept sign-extended at all times
-(this is slightly naughty, because we're making assumptions about the
-C calling convention rather early on in the compiler).  However, given
-this, the cons outweigh the pros.
-
--}
-
-
-machRepBitWidth :: MachRep -> Int
-machRepBitWidth I8   = 8
-machRepBitWidth I16  = 16
-machRepBitWidth I32  = 32
-machRepBitWidth I64  = 64
-machRepBitWidth I128 = 128
-machRepBitWidth F32  = 32
-machRepBitWidth F64  = 64
-machRepBitWidth F80  = 80
-
-machRepByteWidth :: MachRep -> Int
-machRepByteWidth I8   = 1
-machRepByteWidth I16  = 2
-machRepByteWidth I32  = 4
-machRepByteWidth I64  = 8
-machRepByteWidth I128 = 16
-machRepByteWidth F32  = 4
-machRepByteWidth F64  = 8
-machRepByteWidth F80  = 10
-
--- log_2 of the width in bytes, useful for generating shifts.
-machRepLogWidth :: MachRep -> Int
-machRepLogWidth I8   = 0
-machRepLogWidth I16  = 1
-machRepLogWidth I32  = 2
-machRepLogWidth I64  = 3
-machRepLogWidth I128 = 4
-machRepLogWidth F32  = 2
-machRepLogWidth F64  = 3
-machRepLogWidth F80  = panic "machRepLogWidth: F80"
-
-isFloatingRep :: MachRep -> Bool
-isFloatingRep F32 = True
-isFloatingRep F64 = True
-isFloatingRep F80 = True
-isFloatingRep _   = False
-
--- -----------------------------------------------------------------------------
--- Hints
-
-{-
-A hint gives a little more information about a data value.  Hints are
-used on the arguments to a foreign call, where the code generator needs
-to know some extra information on top of the MachRep of each argument in
-order to generate a correct call.
--}
-
-data MachHint
-  = NoHint
-  | PtrHint
-  | SignedHint
-  | FloatHint
-  deriving Eq
-
-mhStr NoHint     = SLIT("NoHint")
-mhStr PtrHint    = SLIT("PtrHint")
-mhStr SignedHint = SLIT("SignedHint")
-mhStr FloatHint  = SLIT("FloatHint")
-
-instance Outputable MachHint where
-   ppr hint = ptext (mhStr hint)
-
--- -----------------------------------------------------------------------------
--- MachOp
-
-{- |
-Machine-level primops; ones which we can reasonably delegate to the
-native code generators to handle.  Basically contains C's primops
-and no others.
-
-Nomenclature: all ops indicate width and signedness, where
-appropriate.  Widths: 8\/16\/32\/64 means the given size, obviously.
-Nat means the operation works on STG word sized objects.
-Signedness: S means signed, U means unsigned.  For operations where
-signedness is irrelevant or makes no difference (for example
-integer add), the signedness component is omitted.
-
-An exception: NatP is a ptr-typed native word.  From the point of
-view of the native code generators this distinction is irrelevant,
-but the C code generator sometimes needs this info to emit the
-right casts.  
--}
-
-data MachOp
-
-  -- Integer operations
-  = MO_Add    MachRep
-  | MO_Sub    MachRep
-  | MO_Eq     MachRep
-  | MO_Ne     MachRep
-  | MO_Mul    MachRep		-- low word of multiply
-  | MO_S_MulMayOflo MachRep 	-- nonzero if signed multiply overflows
-  | MO_S_Quot MachRep		-- signed / (same semantics as IntQuotOp)
-  | MO_S_Rem  MachRep		-- signed % (same semantics as IntRemOp)
-  | MO_S_Neg  MachRep		-- unary -
-  | MO_U_MulMayOflo MachRep	-- nonzero if unsigned multiply overflows
-  | MO_U_Quot MachRep		-- unsigned / (same semantics as WordQuotOp)
-  | MO_U_Rem  MachRep		-- unsigned % (same semantics as WordRemOp)
-
-  -- Signed comparisons (floating-point comparisons also use these)
-  | MO_S_Ge MachRep
-  | MO_S_Le MachRep
-  | MO_S_Gt MachRep
-  | MO_S_Lt MachRep
-
-  -- Unsigned comparisons
-  | MO_U_Ge MachRep
-  | MO_U_Le MachRep
-  | MO_U_Gt MachRep
-  | MO_U_Lt MachRep
-
-  -- Bitwise operations.  Not all of these may be supported at all sizes,
-  -- and only integral MachReps are valid.
-  | MO_And   MachRep
-  | MO_Or    MachRep
-  | MO_Xor   MachRep
-  | MO_Not   MachRep
-  | MO_Shl   MachRep
-  | MO_U_Shr MachRep	-- unsigned shift right
-  | MO_S_Shr MachRep	-- signed shift right
-
-  -- Conversions.  Some of these will be NOPs.
-  -- Floating-point conversions use the signed variant.
-  | MO_S_Conv MachRep{-from-} MachRep{-to-}	-- signed conversion
-  | MO_U_Conv MachRep{-from-} MachRep{-to-}	-- unsigned conversion
-
-  deriving (Eq, Show)
-
-pprMachOp :: MachOp -> SDoc
-pprMachOp mo = text (show mo)
-
-
--- These MachOps tend to be implemented by foreign calls in some backends,
--- so we separate them out.  In Cmm, these can only occur in a
--- statement position, in contrast to an ordinary MachOp which can occur
--- anywhere in an expression.
-data CallishMachOp
-  = MO_F64_Pwr
-  | MO_F64_Sin
-  | MO_F64_Cos
-  | MO_F64_Tan
-  | MO_F64_Sinh
-  | MO_F64_Cosh
-  | MO_F64_Tanh
-  | MO_F64_Asin
-  | MO_F64_Acos
-  | MO_F64_Atan
-  | MO_F64_Log
-  | MO_F64_Exp
-  | MO_F64_Sqrt
-  | MO_F32_Pwr
-  | MO_F32_Sin
-  | MO_F32_Cos
-  | MO_F32_Tan
-  | MO_F32_Sinh
-  | MO_F32_Cosh
-  | MO_F32_Tanh
-  | MO_F32_Asin
-  | MO_F32_Acos
-  | MO_F32_Atan
-  | MO_F32_Log
-  | MO_F32_Exp
-  | MO_F32_Sqrt
-  deriving (Eq, Show)
-
-pprCallishMachOp :: CallishMachOp -> SDoc
-pprCallishMachOp mo = text (show mo)
-
--- -----------------------------------------------------------------------------
--- Some common MachReps
-
--- A 'wordRep' is a machine word on the target architecture
--- Specifically, it is the size of an Int#, Word#, Addr# 
--- and the unit of allocation on the stack and the heap
--- Any pointer is also guaranteed to be a wordRep.
-
-wordRep | wORD_SIZE == 4 = I32
-	| wORD_SIZE == 8 = I64
-	| otherwise      = panic "MachOp.wordRep: Unknown word size"
-
-halfWordRep | wORD_SIZE == 4 = I16
-	    | wORD_SIZE == 8 = I32
-	    | otherwise      = panic "MachOp.halfWordRep: Unknown word size"
-
-mo_wordAdd	= MO_Add wordRep
-mo_wordSub	= MO_Sub wordRep
-mo_wordEq 	= MO_Eq  wordRep
-mo_wordNe 	= MO_Ne  wordRep
-mo_wordMul	= MO_Mul wordRep
-mo_wordSQuot	= MO_S_Quot wordRep
-mo_wordSRem	= MO_S_Rem wordRep
-mo_wordSNeg	= MO_S_Neg wordRep
-mo_wordUQuot	= MO_U_Quot wordRep
-mo_wordURem	= MO_U_Rem wordRep
-
-mo_wordSGe	= MO_S_Ge  wordRep
-mo_wordSLe	= MO_S_Le  wordRep
-mo_wordSGt	= MO_S_Gt  wordRep
-mo_wordSLt	= MO_S_Lt  wordRep
-
-mo_wordUGe	= MO_U_Ge  wordRep
-mo_wordULe	= MO_U_Le  wordRep
-mo_wordUGt	= MO_U_Gt  wordRep
-mo_wordULt	= MO_U_Lt  wordRep
-
-mo_wordAnd	= MO_And wordRep
-mo_wordOr 	= MO_Or	 wordRep
-mo_wordXor	= MO_Xor wordRep
-mo_wordNot	= MO_Not wordRep
-mo_wordShl	= MO_Shl wordRep
-mo_wordSShr	= MO_S_Shr wordRep 
-mo_wordUShr	= MO_U_Shr wordRep 
-
-mo_u_8To32	= MO_U_Conv I8 I32
-mo_s_8To32	= MO_S_Conv I8 I32
-mo_u_16To32	= MO_U_Conv I16 I32
-mo_s_16To32	= MO_S_Conv I16 I32
-
-mo_u_8ToWord	= MO_U_Conv I8  wordRep
-mo_s_8ToWord	= MO_S_Conv I8  wordRep
-mo_u_16ToWord	= MO_U_Conv I16 wordRep
-mo_s_16ToWord	= MO_S_Conv I16 wordRep
-mo_s_32ToWord	= MO_S_Conv I32 wordRep
-mo_u_32ToWord	= MO_U_Conv I32 wordRep
-
-mo_WordTo8	= MO_U_Conv wordRep I8
-mo_WordTo16	= MO_U_Conv wordRep I16
-mo_WordTo32	= MO_U_Conv wordRep I32
-
-mo_32To8	= MO_U_Conv I32 I8
-mo_32To16	= MO_U_Conv I32 I16
-
--- cIntRep is the MachRep for a C-language 'int'
-#if SIZEOF_INT == 4
-cIntRep = I32
-#elif  SIZEOF_INT == 8
-cIntRep = I64
-#endif
-
-#if SIZEOF_LONG == 4
-cLongRep = I32
-#elif  SIZEOF_LONG == 8
-cLongRep = I64
-#endif
-
--- ----------------------------------------------------------------------------
--- isCommutableMachOp
-
-{- |
-Returns 'True' if the MachOp has commutable arguments.  This is used
-in the platform-independent Cmm optimisations.
-
-If in doubt, return 'False'.  This generates worse code on the
-native routes, but is otherwise harmless.
--}
-isCommutableMachOp :: MachOp -> Bool
-isCommutableMachOp mop = 
-  case mop of
-	MO_Add _ 		-> True
-	MO_Eq _			-> True
-	MO_Ne _			-> True
-	MO_Mul _		-> True
-	MO_S_MulMayOflo _	-> True
-	MO_U_MulMayOflo _	-> True
-	MO_And _		-> True
-	MO_Or _			-> True
-	MO_Xor _		-> True
-	_other			-> False
-
--- ----------------------------------------------------------------------------
--- isAssociativeMachOp
-
-{- |
-Returns 'True' if the MachOp is associative (i.e. @(x+y)+z == x+(y+z)@)
-This is used in the platform-independent Cmm optimisations.
-
-If in doubt, return 'False'.  This generates worse code on the
-native routes, but is otherwise harmless.
--}
-isAssociativeMachOp :: MachOp -> Bool
-isAssociativeMachOp mop = 
-  case mop of
-	MO_Add r 	-> not (isFloatingRep r)
-	MO_Mul r	-> not (isFloatingRep r)
-	MO_And _	-> True
-	MO_Or _		-> True
-	MO_Xor _	-> True
-	_other		-> False
-
--- ----------------------------------------------------------------------------
--- isComparisonMachOp
-
-{- | 
-Returns 'True' if the MachOp is a comparison.
-
-If in doubt, return False.  This generates worse code on the
-native routes, but is otherwise harmless.
--}
-isComparisonMachOp :: MachOp -> Bool
-isComparisonMachOp mop = 
-  case mop of
-    MO_Eq   _  -> True
-    MO_Ne   _  -> True
-    MO_S_Ge _  -> True
-    MO_S_Le _  -> True
-    MO_S_Gt _  -> True
-    MO_S_Lt _  -> True
-    MO_U_Ge _  -> True
-    MO_U_Le _  -> True
-    MO_U_Gt _  -> True
-    MO_U_Lt _  -> True
-    _other     -> False
-
--- -----------------------------------------------------------------------------
--- Inverting conditions
-
--- Sometimes it's useful to be able to invert the sense of a
--- condition.  Not all conditional tests are invertible: in
--- particular, floating point conditionals cannot be inverted, because
--- there exist floating-point values which return False for both senses
--- of a condition (eg. !(NaN > NaN) && !(NaN /<= NaN)).
-
-maybeInvertComparison :: MachOp -> Maybe MachOp
-maybeInvertComparison op
-  = case op of
-	MO_Eq r    | not (isFloatingRep r) -> Just (MO_Ne r)
-	MO_Ne r	   | not (isFloatingRep r) -> Just (MO_Eq r)
-	MO_U_Lt r  | not (isFloatingRep r) -> Just (MO_U_Ge r)
-	MO_U_Gt r  | not (isFloatingRep r) -> Just (MO_U_Le r)
-	MO_U_Le r  | not (isFloatingRep r) -> Just (MO_U_Gt r)
-	MO_U_Ge r  | not (isFloatingRep r) -> Just (MO_U_Lt r)
-	MO_S_Lt r  | not (isFloatingRep r) -> Just (MO_S_Ge r)
-	MO_S_Gt r  | not (isFloatingRep r) -> Just (MO_S_Le r)
-	MO_S_Le r  | not (isFloatingRep r) -> Just (MO_S_Gt r)
-	MO_S_Ge r  | not (isFloatingRep r) -> Just (MO_S_Lt r)
-	_other  -> Nothing
-
--- ----------------------------------------------------------------------------
--- resultRepOfMachOp
-
-{- |
-Returns the MachRep of the result of a MachOp.
--}
-resultRepOfMachOp :: MachOp -> MachRep
-resultRepOfMachOp mop =
-  case mop of
-    MO_Add    r		-> r
-    MO_Sub    r		-> r
-    MO_Eq     r		-> comparisonResultRep
-    MO_Ne     r		-> comparisonResultRep
-    MO_Mul    r		-> r
-    MO_S_MulMayOflo r	-> r
-    MO_S_Quot r		-> r
-    MO_S_Rem  r		-> r
-    MO_S_Neg  r		-> r
-    MO_U_MulMayOflo r	-> r
-    MO_U_Quot r		-> r
-    MO_U_Rem  r		-> r
-
-    MO_S_Ge r		-> comparisonResultRep
-    MO_S_Le r		-> comparisonResultRep
-    MO_S_Gt r		-> comparisonResultRep
-    MO_S_Lt r		-> comparisonResultRep
-
-    MO_U_Ge r		-> comparisonResultRep
-    MO_U_Le r		-> comparisonResultRep
-    MO_U_Gt r		-> comparisonResultRep
-    MO_U_Lt r		-> comparisonResultRep
-
-    MO_And   r		-> r
-    MO_Or    r		-> r
-    MO_Xor   r		-> r
-    MO_Not   r		-> r
-    MO_Shl   r		-> r
-    MO_U_Shr r		-> r
-    MO_S_Shr r		-> r
-
-    MO_S_Conv from to	-> to
-    MO_U_Conv from to	-> to
-
-
-comparisonResultRep = wordRep  -- is it?
-
-
--- -----------------------------------------------------------------------------
--- machOpArgReps
-
--- | This function is used for debugging only: we can check whether an
--- application of a MachOp is "type-correct" by checking that the MachReps of
--- its arguments are the same as the MachOp expects.  This is used when 
--- linting a CmmExpr.
-
-machOpArgReps :: MachOp -> [MachRep]
-machOpArgReps op = 
-  case op of
-    MO_Add    r		-> [r,r]
-    MO_Sub    r		-> [r,r]
-    MO_Eq     r		-> [r,r]
-    MO_Ne     r		-> [r,r]
-    MO_Mul    r		-> [r,r]
-    MO_S_MulMayOflo r	-> [r,r]
-    MO_S_Quot r		-> [r,r]
-    MO_S_Rem  r		-> [r,r]
-    MO_S_Neg  r		-> [r]
-    MO_U_MulMayOflo r	-> [r,r]
-    MO_U_Quot r		-> [r,r]
-    MO_U_Rem  r		-> [r,r]
-
-    MO_S_Ge r		-> [r,r]
-    MO_S_Le r		-> [r,r]
-    MO_S_Gt r		-> [r,r]
-    MO_S_Lt r		-> [r,r]
-
-    MO_U_Ge r		-> [r,r]
-    MO_U_Le r		-> [r,r]
-    MO_U_Gt r		-> [r,r]
-    MO_U_Lt r		-> [r,r]
-
-    MO_And   r		-> [r,r]
-    MO_Or    r		-> [r,r]
-    MO_Xor   r		-> [r,r]
-    MO_Not   r		-> [r]
-    MO_Shl   r		-> [r,wordRep]
-    MO_U_Shr r		-> [r,wordRep]
-    MO_S_Shr r		-> [r,wordRep]
-
-    MO_S_Conv from to	-> [from]
-    MO_U_Conv from to	-> [from]
diff --git a/ghc/compiler/cmm/PprC.hs b/ghc/compiler/cmm/PprC.hs
deleted file mode 100644
index a8d30668b7..0000000000
--- a/ghc/compiler/cmm/PprC.hs
+++ /dev/null
@@ -1,1028 +0,0 @@
------------------------------------------------------------------------------
---
--- Pretty-printing of Cmm as C, suitable for feeding gcc
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
---
--- Print Cmm as real C, for -fvia-C
---
--- This is simpler than the old PprAbsC, because Cmm is "macro-expanded"
--- relative to the old AbstractC, and many oddities/decorations have
--- disappeared from the data type.
---
-
--- ToDo: save/restore volatile registers around calls.
-
-module PprC (
-        writeCs,
-        pprStringInCStyle 
-  ) where
-
-#include "HsVersions.h"
-
--- Cmm stuff
-import Cmm
-import CLabel
-import MachOp
-import ForeignCall
-
--- Utils
-import DynFlags		( DynFlags, DynFlag(..), dopt )
-import Unique           ( getUnique )
-import UniqSet
-import FiniteMap
-import UniqFM		( eltsUFM )
-import FastString
-import Outputable
-import Constants
-import StaticFlags 	( opt_Unregisterised )
-
--- The rest
-import Data.List        ( intersperse, groupBy )
-import Data.Bits        ( shiftR )
-import Char             ( ord, chr )
-import IO               ( Handle )
-import DATA_BITS
-import Data.Word	( Word8 )
-
-#ifdef DEBUG
-import PprCmm		() -- instances only
--- import Debug.Trace
-#endif
-
-#if __GLASGOW_HASKELL__ >= 504
-import Data.Array.ST
-#endif
-import MONAD_ST
-
--- --------------------------------------------------------------------------
--- Top level
-
-pprCs :: DynFlags -> [Cmm] -> SDoc
-pprCs dflags cmms
- = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC c) cmms)
- where
-   split_marker
-     | dopt Opt_SplitObjs dflags = ptext SLIT("__STG_SPLIT_MARKER")
-     | otherwise     	         = empty
-
-writeCs :: DynFlags -> Handle -> [Cmm] -> IO ()
-writeCs dflags handle cmms 
-  = printForC handle (pprCs dflags cmms)
-
--- --------------------------------------------------------------------------
--- Now do some real work
---
--- for fun, we could call cmmToCmm over the tops...
---
-
-pprC :: Cmm -> SDoc
-pprC (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
-
---
--- top level procs
--- 
-pprTop :: CmmTop -> SDoc
-pprTop (CmmProc info clbl _params blocks) =
-    (if not (null info)
-        then pprDataExterns info $$
-             pprWordArray (entryLblToInfoLbl clbl) info
-        else empty) $$
-    (case blocks of
-        [] -> empty
-         -- the first block doesn't get a label:
-        (BasicBlock _ stmts : rest) -> vcat [
-	   text "",
-	   extern_decls,
-           (if (externallyVisibleCLabel clbl)
-                    then mkFN_ else mkIF_) (pprCLabel clbl) <+> lbrace,
-           nest 8 temp_decls,
-           nest 8 mkFB_,
-           nest 8 (vcat (map pprStmt stmts)) $$
-              vcat (map pprBBlock rest),
-           nest 8 mkFE_,
-           rbrace ]
-    )
-  where
-	(temp_decls, extern_decls) = pprTempAndExternDecls blocks 
-
-
--- Chunks of static data.
-
--- We only handle (a) arrays of word-sized things and (b) strings.
-
-pprTop (CmmData _section _ds@[CmmDataLabel lbl, CmmString str]) = 
-  hcat [
-    pprLocalness lbl, ptext SLIT("char "), pprCLabel lbl,
-    ptext SLIT("[] = "), pprStringInCStyle str, semi
-  ]
-
-pprTop (CmmData _section _ds@[CmmDataLabel lbl, CmmUninitialised size]) = 
-  hcat [
-    pprLocalness lbl, ptext SLIT("char "), pprCLabel lbl,
-    brackets (int size), semi
-  ]
-
-pprTop top@(CmmData _section (CmmDataLabel lbl : lits)) = 
-  pprDataExterns lits $$
-  pprWordArray lbl lits  
-
--- these shouldn't appear?
-pprTop (CmmData _ _) = panic "PprC.pprTop: can't handle this data"
-
-
--- --------------------------------------------------------------------------
--- BasicBlocks are self-contained entities: they always end in a jump.
---
--- Like nativeGen/AsmCodeGen, we could probably reorder blocks to turn
--- as many jumps as possible into fall throughs.
---
-
-pprBBlock :: CmmBasicBlock -> SDoc
-pprBBlock (BasicBlock lbl stmts) = 
-    if null stmts then
-        pprTrace "pprC.pprBBlock: curious empty code block for" 
-                        (pprBlockId lbl) empty
-    else 
-        nest 4 (pprBlockId lbl <> colon) $$
-        nest 8 (vcat (map pprStmt stmts))
-
--- --------------------------------------------------------------------------
--- Info tables. Just arrays of words. 
--- See codeGen/ClosureInfo, and nativeGen/PprMach
-
-pprWordArray :: CLabel -> [CmmStatic] -> SDoc
-pprWordArray lbl ds
-  = hcat [ pprLocalness lbl, ptext SLIT("StgWord")
-         , space, pprCLabel lbl, ptext SLIT("[] = {") ] 
-    $$ nest 8 (commafy (pprStatics ds))
-    $$ ptext SLIT("};")
-
---
--- has to be static, if it isn't globally visible
---
-pprLocalness :: CLabel -> SDoc
-pprLocalness lbl | not $ externallyVisibleCLabel lbl = ptext SLIT("static ")
-                 | otherwise = empty
-
--- --------------------------------------------------------------------------
--- Statements.
---
-
-pprStmt :: CmmStmt -> SDoc
-
-pprStmt stmt = case stmt of
-    CmmNop       -> empty
-    CmmComment s -> (hang (ptext SLIT("/*")) 3 (ftext s)) $$ ptext SLIT("*/")
-
-    CmmAssign dest src -> pprAssign dest src
-
-    CmmStore  dest src
-	| rep == I64 && wordRep /= I64
-	-> ptext SLIT("ASSIGN_Word64") <> 
-		parens (mkP_ <> pprExpr1 dest <> comma <> pprExpr src) <> semi
-
-	| rep == F64 && wordRep /= I64
-	-> ptext SLIT("ASSIGN_DBL") <> 
-		parens (mkP_ <> pprExpr1 dest <> comma <> pprExpr src) <> semi
-
- 	| otherwise
-	-> hsep [ pprExpr (CmmLoad dest rep), equals, pprExpr src <> semi ]
-	where
-	  rep = cmmExprRep src
-
-    CmmCall (CmmForeignCall fn cconv) results args volatile -> 
-	-- Controversial: leave this out for now.
-	-- pprUndef fn $$
-
-	pprCall ppr_fn cconv results args volatile
-	where
-    	ppr_fn = case fn of
-		   CmmLit (CmmLabel lbl) -> pprCLabel lbl
-		   _other -> parens (cCast (pprCFunType cconv results args) fn)
-			-- for a dynamic call, cast the expression to
-			-- a function of the right type (we hope).
-
-	-- we #undef a function before calling it: the FFI is supposed to be
-	-- an interface specifically to C, not to C+CPP.  For one thing, this
-	-- makes the via-C route more compatible with the NCG.  If macros
-	-- are being used for optimisation, then inline functions are probably
-	-- better anyway.
-	pprUndef (CmmLit (CmmLabel lbl)) = 
-	   ptext SLIT("#undef") <+> pprCLabel lbl
-	pprUndef _ = empty
-
-    CmmCall (CmmPrim op) results args volatile -> 
-	pprCall ppr_fn CCallConv results args volatile
-	where
-    	ppr_fn = pprCallishMachOp_for_C op
-
-    CmmBranch ident          -> pprBranch ident
-    CmmCondBranch expr ident -> pprCondBranch expr ident
-    CmmJump lbl _params      -> mkJMP_(pprExpr lbl) <> semi
-    CmmSwitch arg ids        -> pprSwitch arg ids
-
-pprCFunType :: CCallConv -> [(CmmReg,MachHint)] -> [(CmmExpr,MachHint)] -> SDoc
-pprCFunType cconv ress args
-  = hcat [
-	res_type ress,
-	parens (text (ccallConvAttribute cconv) <>  char '*'),
-	parens (commafy (map arg_type args))
-   ]
-  where
-	res_type [] = ptext SLIT("void")
-	res_type [(one,hint)] = machRepHintCType (cmmRegRep one) hint
-
-	arg_type (expr,hint) = machRepHintCType (cmmExprRep expr) hint
-
--- ---------------------------------------------------------------------
--- unconditional branches
-pprBranch :: BlockId -> SDoc
-pprBranch ident = ptext SLIT("goto") <+> pprBlockId ident <> semi
-
-
--- ---------------------------------------------------------------------
--- conditional branches to local labels
-pprCondBranch :: CmmExpr -> BlockId -> SDoc
-pprCondBranch expr ident 
-        = hsep [ ptext SLIT("if") , parens(pprExpr expr) ,
-                        ptext SLIT("goto") , (pprBlockId ident) <> semi ]
-
-
--- ---------------------------------------------------------------------
--- a local table branch
---
--- we find the fall-through cases
---
--- N.B. we remove Nothing's from the list of branches, as they are
--- 'undefined'. However, they may be defined one day, so we better
--- document this behaviour.
---
-pprSwitch :: CmmExpr -> [ Maybe BlockId ] -> SDoc
-pprSwitch e maybe_ids 
-  = let pairs  = [ (ix, ident) | (ix,Just ident) <- zip [0..] maybe_ids ]
-	pairs2 = [ (map fst as, snd (head as)) | as <- groupBy sndEq pairs ]
-    in 
-        (hang (ptext SLIT("switch") <+> parens ( pprExpr e ) <+> lbrace)
-                4 (vcat ( map caseify pairs2 )))
-        $$ rbrace
-
-  where
-    sndEq (_,x) (_,y) = x == y
-
-    -- fall through case
-    caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix
-	where 
-	do_fallthrough ix =
-                 hsep [ ptext SLIT("case") , pprHexVal ix wordRep <> colon ,
-                        ptext SLIT("/* fall through */") ]
-
-	final_branch ix = 
-	        hsep [ ptext SLIT("case") , pprHexVal ix wordRep <> colon ,
-                       ptext SLIT("goto") , (pprBlockId ident) <> semi ]
-
--- ---------------------------------------------------------------------
--- Expressions.
---
-
--- C Types: the invariant is that the C expression generated by
---
---	pprExpr e
---
--- has a type in C which is also given by
---
---	machRepCType (cmmExprRep e)
---
--- (similar invariants apply to the rest of the pretty printer).
-
-pprExpr :: CmmExpr -> SDoc
-pprExpr e = case e of
-    CmmLit lit -> pprLit lit
-
-    CmmLoad e I64 | wordRep /= I64
-	-> ptext SLIT("PK_Word64") <> parens (mkP_ <> pprExpr1 e)
-
-    CmmLoad e F64 | wordRep /= I64
-	-> ptext SLIT("PK_DBL") <> parens (mkP_ <> pprExpr1 e)
-
-    CmmLoad (CmmReg r) rep 
-	| isPtrReg r && rep == wordRep
-	-> char '*' <> pprAsPtrReg r
-
-    CmmLoad (CmmRegOff r 0) rep 
-	| isPtrReg r && rep == wordRep
-	-> char '*' <> pprAsPtrReg r
-
-    CmmLoad (CmmRegOff r off) rep
-	| isPtrReg r && rep == wordRep 
-	-- ToDo: check that the offset is a word multiple?
-	-> pprAsPtrReg r <> brackets (ppr (off `shiftR` wordShift))
-
-    CmmLoad expr rep ->
-	-- the general case:
-	char '*' <> parens (cCast (machRepPtrCType rep) expr)
-
-    CmmReg reg      -> pprCastReg reg
-    CmmRegOff reg 0 -> pprCastReg reg
-
-    CmmRegOff reg i
-	| i >  0    -> pprRegOff (char '+') i
-	| otherwise -> pprRegOff (char '-') (-i)
-      where
-	pprRegOff op i' = pprCastReg reg <> op <> int i'
-
-    CmmMachOp mop args -> pprMachOpApp mop args
-
-pprExpr1 :: CmmExpr -> SDoc
-pprExpr1 (CmmLit lit) 	  = pprLit1 lit
-pprExpr1 e@(CmmReg _reg)  = pprExpr e
-pprExpr1 other            = parens (pprExpr other)
-
--- --------------------------------------------------------------------------
--- MachOp applications
-
-pprMachOpApp :: MachOp -> [CmmExpr] -> SDoc
-
-pprMachOpApp op args
-  | isMulMayOfloOp op
-  = ptext SLIT("mulIntMayOflo") <> parens (commafy (map pprExpr args))
-  where isMulMayOfloOp (MO_U_MulMayOflo _) = True
-	isMulMayOfloOp (MO_S_MulMayOflo _) = True
-	isMulMayOfloOp _ = False
-
-pprMachOpApp mop args
- = case args of
-    -- dyadic
-    [x,y] -> pprArg x <+> pprMachOp_for_C mop <+> pprArg y
-
-    -- unary
-    [x]   -> pprMachOp_for_C mop <> parens (pprArg x)
-
-    _     -> panic "PprC.pprMachOp : machop with wrong number of args"
-
-  where
-    pprArg e | signedOp mop = cCast (machRepSignedCType (cmmExprRep e)) e
- 	     | otherwise    = pprExpr1 e
-
--- --------------------------------------------------------------------------
--- Literals
-
-pprLit :: CmmLit -> SDoc
-pprLit lit = case lit of
-    CmmInt i rep      -> pprHexVal i rep
-    CmmFloat f rep     -> parens (machRepCType rep) <> (rational f)
-    CmmLabel clbl      -> mkW_ <> pprCLabelAddr clbl
-    CmmLabelOff clbl i -> mkW_ <> pprCLabelAddr clbl <> char '+' <> int i
-    CmmLabelDiffOff clbl1 clbl2 i
-        -- WARNING:
-        --  * the lit must occur in the info table clbl2
-        --  * clbl1 must be an SRT, a slow entry point or a large bitmap
-        -- The Mangler is expected to convert any reference to an SRT,
-        -- a slow entry point or a large bitmap
-        -- from an info table to an offset.
-        -> mkW_ <> pprCLabelAddr clbl1 <> char '+' <> int i
-
-pprCLabelAddr lbl = char '&' <> pprCLabel lbl
-
-pprLit1 :: CmmLit -> SDoc
-pprLit1 lit@(CmmLabelOff _ _) = parens (pprLit lit)
-pprLit1 lit@(CmmLabelDiffOff _ _ _) = parens (pprLit lit)
-pprLit1 lit@(CmmFloat _ _)    = parens (pprLit lit)
-pprLit1 other = pprLit other
-
--- ---------------------------------------------------------------------------
--- Static data
-
-pprStatics :: [CmmStatic] -> [SDoc]
-pprStatics [] = []
-pprStatics (CmmStaticLit (CmmFloat f F32) : rest) 
-  = pprLit1 (floatToWord f) : pprStatics rest
-pprStatics (CmmStaticLit (CmmFloat f F64) : rest)
-  = map pprLit1 (doubleToWords f) ++ pprStatics rest
-pprStatics (CmmStaticLit (CmmInt i I64) : rest)
-  | machRepByteWidth I32 == wORD_SIZE
-#ifdef WORDS_BIGENDIAN
-  = pprStatics (CmmStaticLit (CmmInt q I32) : 
-		CmmStaticLit (CmmInt r I32) : rest)
-#else
-  = pprStatics (CmmStaticLit (CmmInt r I32) : 
-		CmmStaticLit (CmmInt q I32) : rest)
-#endif
-  where r = i .&. 0xffffffff
-	q = i `shiftR` 32
-pprStatics (CmmStaticLit lit : rest)
-  = pprLit1 lit : pprStatics rest
-pprStatics (other : rest)
-  = pprPanic "pprWord" (pprStatic other)
-
-pprStatic :: CmmStatic -> SDoc
-pprStatic s = case s of
-
-    CmmStaticLit lit   -> nest 4 (pprLit lit)
-    CmmAlign i         -> nest 4 (ptext SLIT("/* align */") <+> int i)
-    CmmDataLabel clbl  -> pprCLabel clbl <> colon
-    CmmUninitialised i -> nest 4 (mkC_ <> brackets (int i))
-
-    -- these should be inlined, like the old .hc
-    CmmString s'       -> nest 4 (mkW_ <> parens(pprStringInCStyle s'))
-
-
--- ---------------------------------------------------------------------------
--- Block Ids
-
-pprBlockId :: BlockId -> SDoc
-pprBlockId b = char '_' <> ppr (getUnique b)
-
--- --------------------------------------------------------------------------
--- Print a MachOp in a way suitable for emitting via C.
---
-
-pprMachOp_for_C :: MachOp -> SDoc
-
-pprMachOp_for_C mop = case mop of 
-
-        -- Integer operations
-        MO_Add          _ -> char '+'
-        MO_Sub          _ -> char '-'
-        MO_Eq           _ -> ptext SLIT("==")
-        MO_Ne           _ -> ptext SLIT("!=")
-        MO_Mul          _ -> char '*'
-
-        MO_S_Quot       _ -> char '/'
-        MO_S_Rem        _ -> char '%'
-        MO_S_Neg        _ -> char '-'
-
-        MO_U_Quot       _ -> char '/'
-        MO_U_Rem        _ -> char '%'
-
-        -- Signed comparisons (floating-point comparisons also use these)
-        -- & Unsigned comparisons
-        MO_S_Ge         _ -> ptext SLIT(">=")
-        MO_S_Le         _ -> ptext SLIT("<=")
-        MO_S_Gt         _ -> char '>'
-        MO_S_Lt         _ -> char '<'
-
-        MO_U_Ge         _ -> ptext SLIT(">=")
-        MO_U_Le         _ -> ptext SLIT("<=")
-        MO_U_Gt         _ -> char '>'
-        MO_U_Lt         _ -> char '<'
-
-        -- Bitwise operations.  Not all of these may be supported at all
-        -- sizes, and only integral MachReps are valid.
-        MO_And          _ -> char '&'
-        MO_Or           _ -> char '|'
-        MO_Xor          _ -> char '^'
-        MO_Not          _ -> char '~'
-        MO_Shl          _ -> ptext SLIT("<<")
-        MO_U_Shr        _ -> ptext SLIT(">>") -- unsigned shift right
-        MO_S_Shr        _ -> ptext SLIT(">>") -- signed shift right
-
--- Conversions.  Some of these will be NOPs.
--- Floating-point conversions use the signed variant.
--- We won't know to generate (void*) casts here, but maybe from
--- context elsewhere
-
--- noop casts
-        MO_U_Conv I8 I8     -> empty
-        MO_U_Conv I16 I16   -> empty
-        MO_U_Conv I32 I32   -> empty
-        MO_U_Conv I64 I64   -> empty
-        MO_U_Conv I128 I128 -> empty
-        MO_S_Conv I8 I8     -> empty
-        MO_S_Conv I16 I16   -> empty
-        MO_S_Conv I32 I32   -> empty
-        MO_S_Conv I64 I64   -> empty
-        MO_S_Conv I128 I128 -> empty
-
-	MO_U_Conv _from to  -> parens (machRepCType to)
-	MO_S_Conv _from to  -> parens (machRepSignedCType to)
-
-        _ -> panic "PprC.pprMachOp_for_C: unknown machop"
-
-signedOp :: MachOp -> Bool
-signedOp (MO_S_Quot _)	 = True
-signedOp (MO_S_Rem  _)	 = True
-signedOp (MO_S_Neg  _)	 = True
-signedOp (MO_S_Ge   _)	 = True
-signedOp (MO_S_Le   _)	 = True
-signedOp (MO_S_Gt   _)	 = True
-signedOp (MO_S_Lt   _)	 = True
-signedOp (MO_S_Shr  _)	 = True
-signedOp (MO_S_Conv _ _) = True
-signedOp _ = False
-
--- ---------------------------------------------------------------------
--- tend to be implemented by foreign calls
-
-pprCallishMachOp_for_C :: CallishMachOp -> SDoc
-
-pprCallishMachOp_for_C mop 
-    = case mop of
-        MO_F64_Pwr  -> ptext SLIT("pow")
-        MO_F64_Sin  -> ptext SLIT("sin")
-        MO_F64_Cos  -> ptext SLIT("cos")
-        MO_F64_Tan  -> ptext SLIT("tan")
-        MO_F64_Sinh -> ptext SLIT("sinh")
-        MO_F64_Cosh -> ptext SLIT("cosh")
-        MO_F64_Tanh -> ptext SLIT("tanh")
-        MO_F64_Asin -> ptext SLIT("asin")
-        MO_F64_Acos -> ptext SLIT("acos")
-        MO_F64_Atan -> ptext SLIT("atan")
-        MO_F64_Log  -> ptext SLIT("log")
-        MO_F64_Exp  -> ptext SLIT("exp")
-        MO_F64_Sqrt -> ptext SLIT("sqrt")
-        MO_F32_Pwr  -> ptext SLIT("powf")
-        MO_F32_Sin  -> ptext SLIT("sinf")
-        MO_F32_Cos  -> ptext SLIT("cosf")
-        MO_F32_Tan  -> ptext SLIT("tanf")
-        MO_F32_Sinh -> ptext SLIT("sinhf")
-        MO_F32_Cosh -> ptext SLIT("coshf")
-        MO_F32_Tanh -> ptext SLIT("tanhf")
-        MO_F32_Asin -> ptext SLIT("asinf")
-        MO_F32_Acos -> ptext SLIT("acosf")
-        MO_F32_Atan -> ptext SLIT("atanf")
-        MO_F32_Log  -> ptext SLIT("logf")
-        MO_F32_Exp  -> ptext SLIT("expf")
-        MO_F32_Sqrt -> ptext SLIT("sqrtf")
-
--- ---------------------------------------------------------------------
--- Useful #defines
---
-
-mkJMP_, mkFN_, mkIF_ :: SDoc -> SDoc
-
-mkJMP_ i = ptext SLIT("JMP_") <> parens i
-mkFN_  i = ptext SLIT("FN_")  <> parens i -- externally visible function
-mkIF_  i = ptext SLIT("IF_")  <> parens i -- locally visible
-
-
-mkFB_, mkFE_ :: SDoc
-mkFB_ = ptext SLIT("FB_") -- function code begin
-mkFE_ = ptext SLIT("FE_") -- function code end
-
--- from includes/Stg.h
---
-mkC_,mkW_,mkP_,mkPP_,mkI_,mkA_,mkD_,mkF_,mkB_,mkL_,mkLI_,mkLW_ :: SDoc
-
-mkC_  = ptext SLIT("(C_)")        -- StgChar
-mkW_  = ptext SLIT("(W_)")        -- StgWord
-mkP_  = ptext SLIT("(P_)")        -- StgWord*
-mkPP_ = ptext SLIT("(PP_)")       -- P_*
-mkI_  = ptext SLIT("(I_)")        -- StgInt
-mkA_  = ptext SLIT("(A_)")        -- StgAddr
-mkD_  = ptext SLIT("(D_)")        -- const StgWord*
-mkF_  = ptext SLIT("(F_)")        -- StgFunPtr
-mkB_  = ptext SLIT("(B_)")        -- StgByteArray
-mkL_  = ptext SLIT("(L_)")        -- StgClosurePtr
-
-mkLI_ = ptext SLIT("(LI_)")       -- StgInt64
-mkLW_ = ptext SLIT("(LW_)")       -- StgWord64
-
-
--- ---------------------------------------------------------------------
---
--- Assignments
---
--- Generating assignments is what we're all about, here
---
-pprAssign :: CmmReg -> CmmExpr -> SDoc
-
--- dest is a reg, rhs is a reg
-pprAssign r1 (CmmReg r2)
-   | not (isStrangeTypeReg r1) && not (isStrangeTypeReg r2)
-   || isPtrReg r1 && isPtrReg r2
-   = hcat [ pprAsPtrReg r1, equals, pprAsPtrReg r2, semi ]
-
--- dest is a reg, rhs is a CmmRegOff
-pprAssign r1 (CmmRegOff r2 off)
-   | not (isStrangeTypeReg r1) && not (isStrangeTypeReg r2)
-   || isPtrReg r1 && isPtrReg r2
-   = hcat [ pprAsPtrReg r1, equals, pprAsPtrReg r2, op, int off', semi ]
-  where
-	off1 | isPtrReg r2 = off `shiftR` wordShift
-	     | otherwise   = off
-
-	(op,off') | off >= 0  = (char '+', off1)
-		  | otherwise = (char '-', -off1)
-
--- dest is a reg, rhs is anything.
--- We can't cast the lvalue, so we have to cast the rhs if necessary.  Casting
--- the lvalue elicits a warning from new GCC versions (3.4+).
-pprAssign r1 r2
-  | isPtrReg r1
-  = pprAsPtrReg r1 <> ptext SLIT(" = ") <> mkP_ <> pprExpr1 r2 <> semi
-  | Just ty <- strangeRegType r1
-  = pprReg r1 <> ptext SLIT(" = ") <> parens ty <> pprExpr1 r2 <> semi
-  | otherwise
-  = pprReg r1 <> ptext SLIT(" = ") <> pprExpr r2 <> semi
-
--- ---------------------------------------------------------------------
--- Registers
-
-pprCastReg reg
-   | isStrangeTypeReg reg = mkW_ <> pprReg reg
-   | otherwise            = pprReg reg
-
--- True if the register has type StgPtr in C, otherwise it has an
--- integer type.  We need to take care with pointer arithmetic on registers
--- with type StgPtr.
-isPtrReg :: CmmReg -> Bool
-isPtrReg (CmmLocal _) = False
-isPtrReg (CmmGlobal r) = isPtrGlobalReg r
-
-isPtrGlobalReg :: GlobalReg -> Bool
-isPtrGlobalReg (VanillaReg n) 	= True
-isPtrGlobalReg Sp 		= True
-isPtrGlobalReg Hp 		= True
-isPtrGlobalReg HpLim 		= True
-isPtrGlobalReg SpLim 		= True
-isPtrGlobalReg _ 		= False
-
--- True if in C this register doesn't have the type given by 
--- (machRepCType (cmmRegRep reg)), so it has to be cast.
-isStrangeTypeReg :: CmmReg -> Bool
-isStrangeTypeReg (CmmLocal _) 	= False
-isStrangeTypeReg (CmmGlobal g) 	= isStrangeTypeGlobal g
-
-isStrangeTypeGlobal :: GlobalReg -> Bool
-isStrangeTypeGlobal CurrentTSO		= True
-isStrangeTypeGlobal CurrentNursery 	= True
-isStrangeTypeGlobal BaseReg	 	= True
-isStrangeTypeGlobal r 			= isPtrGlobalReg r
-
-strangeRegType :: CmmReg -> Maybe SDoc
-strangeRegType (CmmGlobal CurrentTSO) = Just (ptext SLIT("struct StgTSO_ *"))
-strangeRegType (CmmGlobal CurrentNursery) = Just (ptext SLIT("struct bdescr_ *"))
-strangeRegType (CmmGlobal BaseReg) = Just (ptext SLIT("struct StgRegTable_ *"))
-strangeRegType _ = Nothing
-
--- pprReg just prints the register name.
---
-pprReg :: CmmReg -> SDoc
-pprReg r = case r of
-        CmmLocal  local  -> pprLocalReg local
-        CmmGlobal global -> pprGlobalReg global
-		
-pprAsPtrReg :: CmmReg -> SDoc
-pprAsPtrReg (CmmGlobal (VanillaReg n)) = char 'R' <> int n <> ptext SLIT(".p")
-pprAsPtrReg other_reg = pprReg other_reg
-
-pprGlobalReg :: GlobalReg -> SDoc
-pprGlobalReg gr = case gr of
-    VanillaReg n   -> char 'R' <> int n  <> ptext SLIT(".w")
-    FloatReg   n   -> char 'F' <> int n
-    DoubleReg  n   -> char 'D' <> int n
-    LongReg    n   -> char 'L' <> int n
-    Sp             -> ptext SLIT("Sp")
-    SpLim          -> ptext SLIT("SpLim")
-    Hp             -> ptext SLIT("Hp")
-    HpLim          -> ptext SLIT("HpLim")
-    CurrentTSO     -> ptext SLIT("CurrentTSO")
-    CurrentNursery -> ptext SLIT("CurrentNursery")
-    HpAlloc        -> ptext SLIT("HpAlloc")
-    BaseReg        -> ptext SLIT("BaseReg")
-    GCEnter1       -> ptext SLIT("stg_gc_enter_1")
-    GCFun          -> ptext SLIT("stg_gc_fun")
-
-pprLocalReg :: LocalReg -> SDoc
-pprLocalReg (LocalReg uniq _rep) = char '_' <> ppr uniq
-
--- -----------------------------------------------------------------------------
--- Foreign Calls
-
-pprCall :: SDoc -> CCallConv -> [(CmmReg,MachHint)] -> [(CmmExpr,MachHint)]
-	-> Maybe [GlobalReg] -> SDoc
-
-pprCall ppr_fn cconv results args vols
-  | not (is_cish cconv)
-  = panic "pprCall: unknown calling convention"
-
-  | otherwise
-  = save vols $$
-    ptext SLIT("CALLER_SAVE_SYSTEM") $$
-#if x86_64_TARGET_ARCH
-	-- HACK around gcc optimisations.
-	-- x86_64 needs a __DISCARD__() here, to create a barrier between
-	-- putting the arguments into temporaries and passing the arguments
-	-- to the callee, because the argument expressions may refer to
-	-- machine registers that are also used for passing arguments in the
-	-- C calling convention.
-    (if (not opt_Unregisterised) 
-	then ptext SLIT("__DISCARD__();") 
-	else empty) $$
-#endif
-    ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi $$
-    ptext SLIT("CALLER_RESTORE_SYSTEM") $$
-    restore vols
-  where 
-     ppr_assign []           rhs = rhs
-     ppr_assign [(reg@(CmmGlobal BaseReg), hint)] rhs
-	 | Just ty <- strangeRegType reg
-	 = ptext SLIT("ASSIGN_BaseReg") <> parens (parens ty <> rhs)
-	 -- BaseReg is special, sometimes it isn't an lvalue and we
-	 -- can't assign to it.
-     ppr_assign [(one,hint)] rhs
-	 | Just ty <- strangeRegType one
-	 = pprReg one <> ptext SLIT(" = ") <> parens ty <> rhs
-	 | otherwise
-	 = pprReg one <> ptext SLIT(" = ")
-		 <> pprUnHint hint (cmmRegRep one) <> rhs
-     ppr_assign _other _rhs = panic "pprCall: multiple results"
-
-     pprArg (expr, PtrHint)
-   	= cCast (ptext SLIT("void *")) expr
-	-- see comment by machRepHintCType below
-     pprArg (expr, SignedHint)
-	= cCast (machRepSignedCType (cmmExprRep expr)) expr
-     pprArg (expr, _other)
-	= pprExpr expr
-
-     pprUnHint PtrHint    rep = parens (machRepCType rep)
-     pprUnHint SignedHint rep = parens (machRepCType rep)
-     pprUnHint _          _   = empty
-
-     save    = save_restore SLIT("CALLER_SAVE")
-     restore = save_restore SLIT("CALLER_RESTORE")
-
-	-- Nothing says "I don't know what's live; save everything"
-	-- CALLER_SAVE_USER is defined in ghc/includes/Regs.h
-     save_restore txt Nothing     = ptext txt <> ptext SLIT("_USER")
-     save_restore txt (Just these) = vcat (map saveRestoreGlobal these)
-	where saveRestoreGlobal r = ptext txt <> char '_' <> pprGlobalRegName r
-
-pprGlobalRegName :: GlobalReg -> SDoc
-pprGlobalRegName gr = case gr of
-    VanillaReg n   -> char 'R' <> int n  -- without the .w suffix
-    _              -> pprGlobalReg gr
-
--- Currently we only have these two calling conventions, but this might
--- change in the future...
-is_cish CCallConv   = True
-is_cish StdCallConv = True
-
--- ---------------------------------------------------------------------
--- Find and print local and external declarations for a list of
--- Cmm statements.
--- 
-pprTempAndExternDecls :: [CmmBasicBlock] -> (SDoc{-temps-}, SDoc{-externs-})
-pprTempAndExternDecls stmts 
-  = (vcat (map pprTempDecl (eltsUFM temps)), 
-     vcat (map (pprExternDecl False{-ToDo-}) (keysFM lbls)))
-  where (temps, lbls) = runTE (mapM_ te_BB stmts)
-
-pprDataExterns :: [CmmStatic] -> SDoc
-pprDataExterns statics
-  = vcat (map (pprExternDecl False{-ToDo-}) (keysFM lbls))
-  where (_, lbls) = runTE (mapM_ te_Static statics)
-
-pprTempDecl :: LocalReg -> SDoc
-pprTempDecl l@(LocalReg _uniq rep)
-  = hcat [ machRepCType rep, space, pprLocalReg l, semi ]
-
-pprExternDecl :: Bool -> CLabel -> SDoc
-pprExternDecl in_srt lbl
-  -- do not print anything for "known external" things
-  | not (needsCDecl lbl) = empty
-  | otherwise		    = 
-	hcat [ visibility, label_type (labelType lbl), 
-	       lparen, dyn_wrapper (pprCLabel lbl), text ");" ]
- where
-  dyn_wrapper d
-    | in_srt && labelDynamic lbl = text "DLL_IMPORT_DATA_VAR" <> parens d
-    | otherwise			 = d
-
-  label_type CodeLabel = ptext SLIT("F_")
-  label_type DataLabel = ptext SLIT("I_")
-
-  visibility
-     | externallyVisibleCLabel lbl = char 'E'
-     | otherwise		   = char 'I'
-
-
-type TEState = (UniqSet LocalReg, FiniteMap CLabel ())
-newtype TE a = TE { unTE :: TEState -> (a, TEState) }
-
-instance Monad TE where
-   TE m >>= k  = TE $ \s -> case m s of (a, s') -> unTE (k a) s'
-   return a    = TE $ \s -> (a, s)
-
-te_lbl :: CLabel -> TE ()
-te_lbl lbl = TE $ \(temps,lbls) -> ((), (temps, addToFM lbls lbl ()))
-
-te_temp :: LocalReg -> TE ()
-te_temp r = TE $ \(temps,lbls) -> ((), (addOneToUniqSet temps r, lbls))
-
-runTE :: TE () -> TEState
-runTE (TE m) = snd (m (emptyUniqSet, emptyFM))
-
-te_Static :: CmmStatic -> TE ()
-te_Static (CmmStaticLit lit) = te_Lit lit
-te_Static _ = return ()
-
-te_BB :: CmmBasicBlock -> TE ()
-te_BB (BasicBlock _ ss)		= mapM_ te_Stmt ss
-
-te_Lit :: CmmLit -> TE ()
-te_Lit (CmmLabel l) = te_lbl l
-te_Lit (CmmLabelOff l _) = te_lbl l
-te_Lit (CmmLabelDiffOff l1 l2 _) = te_lbl l1
-te_Lit _ = return ()
-
-te_Stmt :: CmmStmt -> TE ()
-te_Stmt (CmmAssign r e)		= te_Reg r >> te_Expr e
-te_Stmt (CmmStore l r)		= te_Expr l >> te_Expr r
-te_Stmt (CmmCall _ rs es _)	= mapM_ (te_Reg.fst) rs >>
-				  mapM_ (te_Expr.fst) es
-te_Stmt (CmmCondBranch e _)	= te_Expr e
-te_Stmt (CmmSwitch e _)		= te_Expr e
-te_Stmt (CmmJump e _)		= te_Expr e
-te_Stmt _			= return ()
-
-te_Expr :: CmmExpr -> TE ()
-te_Expr (CmmLit lit)		= te_Lit lit
-te_Expr (CmmLoad e _)		= te_Expr e
-te_Expr (CmmReg r)		= te_Reg r
-te_Expr (CmmMachOp _ es) 	= mapM_ te_Expr es
-te_Expr (CmmRegOff r _) 	= te_Reg r
-
-te_Reg :: CmmReg -> TE ()
-te_Reg (CmmLocal l) = te_temp l
-te_Reg _            = return ()
-
-
--- ---------------------------------------------------------------------
--- C types for MachReps
-
-cCast :: SDoc -> CmmExpr -> SDoc
-cCast ty expr = parens ty <> pprExpr1 expr
-
--- This is for finding the types of foreign call arguments.  For a pointer
--- argument, we always cast the argument to (void *), to avoid warnings from
--- the C compiler.
-machRepHintCType :: MachRep -> MachHint -> SDoc
-machRepHintCType rep PtrHint    = ptext SLIT("void *")
-machRepHintCType rep SignedHint = machRepSignedCType rep
-machRepHintCType rep _other     = machRepCType rep
-
-machRepPtrCType :: MachRep -> SDoc
-machRepPtrCType r | r == wordRep = ptext SLIT("P_")
-	          | otherwise    = machRepCType r <> char '*'
-
-machRepCType :: MachRep -> SDoc
-machRepCType r | r == wordRep = ptext SLIT("W_")
-	       | otherwise    = sized_type
-  where sized_type = case r of
-			I8	-> ptext SLIT("StgWord8")
-			I16	-> ptext SLIT("StgWord16")
-			I32	-> ptext SLIT("StgWord32")
-			I64	-> ptext SLIT("StgWord64")
-			F32	-> ptext SLIT("StgFloat") -- ToDo: correct?
-			F64	-> ptext SLIT("StgDouble")
-			_  -> panic "machRepCType"
-
-machRepSignedCType :: MachRep -> SDoc
-machRepSignedCType r | r == wordRep = ptext SLIT("I_")
-                     | otherwise    = sized_type
-  where sized_type = case r of
-			I8	-> ptext SLIT("StgInt8")
-			I16	-> ptext SLIT("StgInt16")
-			I32	-> ptext SLIT("StgInt32")
-			I64	-> ptext SLIT("StgInt64")
-			F32	-> ptext SLIT("StgFloat") -- ToDo: correct?
-			F64	-> ptext SLIT("StgDouble")
-			_ -> panic "machRepCType"
-
--- ---------------------------------------------------------------------
--- print strings as valid C strings
-
-pprStringInCStyle :: [Word8] -> SDoc
-pprStringInCStyle s = doubleQuotes (text (concatMap charToC s))
-
-charToC :: Word8 -> String
-charToC w = 
-  case chr (fromIntegral w) of
-	'\"' -> "\\\""
-	'\'' -> "\\\'"
-	'\\' -> "\\\\"
-	c | c >= ' ' && c <= '~' -> [c]
-          | otherwise -> ['\\',
-                         chr (ord '0' + ord c `div` 64),
-                         chr (ord '0' + ord c `div` 8 `mod` 8),
-                         chr (ord '0' + ord c         `mod` 8)]
-
--- ---------------------------------------------------------------------------
--- Initialising static objects with floating-point numbers.  We can't
--- just emit the floating point number, because C will cast it to an int
--- by rounding it.  We want the actual bit-representation of the float.
-
--- This is a hack to turn the floating point numbers into ints that we
--- can safely initialise to static locations.
-
-big_doubles 
-  | machRepByteWidth F64 == 2 * wORD_SIZE  = True
-  | machRepByteWidth F64 == wORD_SIZE      = False
-  | otherwise = panic "big_doubles"
-
-#if __GLASGOW_HASKELL__ >= 504
-newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
-newFloatArray = newArray_
-
-newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
-newDoubleArray = newArray_
-
-castFloatToIntArray :: STUArray s Int Float -> ST s (STUArray s Int Int)
-castFloatToIntArray = castSTUArray
-
-castDoubleToIntArray :: STUArray s Int Double -> ST s (STUArray s Int Int)
-castDoubleToIntArray = castSTUArray
-
-writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
-writeFloatArray = writeArray
-
-writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
-writeDoubleArray = writeArray
-
-readIntArray :: STUArray s Int Int -> Int -> ST s Int
-readIntArray = readArray
-
-#else
-
-castFloatToIntArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
-castFloatToIntArray = return
-
-castDoubleToIntArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
-castDoubleToIntArray = return
-
-#endif
-
--- floats are always 1 word
-floatToWord :: Rational -> CmmLit
-floatToWord r
-  = runST (do
-	arr <- newFloatArray ((0::Int),0)
-	writeFloatArray arr 0 (fromRational r)
-	arr' <- castFloatToIntArray arr
-	i <- readIntArray arr' 0
-	return (CmmInt (toInteger i) wordRep)
-    )
-
-doubleToWords :: Rational -> [CmmLit]
-doubleToWords r
-  | big_doubles				-- doubles are 2 words
-  = runST (do
-	arr <- newDoubleArray ((0::Int),1)
-	writeDoubleArray arr 0 (fromRational r)
-	arr' <- castDoubleToIntArray arr
-	i1 <- readIntArray arr' 0
-	i2 <- readIntArray arr' 1
-	return [ CmmInt (toInteger i1) wordRep
-	       , CmmInt (toInteger i2) wordRep
-	       ]
-    )
-  | otherwise				-- doubles are 1 word
-  = runST (do
-	arr <- newDoubleArray ((0::Int),0)
-	writeDoubleArray arr 0 (fromRational r)
-	arr' <- castDoubleToIntArray arr
-	i <- readIntArray arr' 0
-	return [ CmmInt (toInteger i) wordRep ]
-    )
-
--- ---------------------------------------------------------------------------
--- Utils
-
-wordShift :: Int
-wordShift = machRepLogWidth wordRep
-
-commafy :: [SDoc] -> SDoc
-commafy xs = hsep $ punctuate comma xs
-
--- Print in C hex format: 0x13fa
-pprHexVal :: Integer -> MachRep -> SDoc
-pprHexVal 0 _ = ptext SLIT("0x0")
-pprHexVal w rep
-  | w < 0     = parens (char '-' <> ptext SLIT("0x") <> go (-w) <> repsuffix rep)
-  | otherwise = ptext SLIT("0x") <> go w <> repsuffix rep
-  where
-  	-- type suffix for literals:
-	-- Integer literals are unsigned in Cmm/C.  We explicitly cast to
-	-- signed values for doing signed operations, but at all other
-	-- times values are unsigned.  This also helps eliminate occasional
-	-- warnings about integer overflow from gcc.
-
-	-- on 32-bit platforms, add "ULL" to 64-bit literals
-      repsuffix I64 | wORD_SIZE == 4 = ptext SLIT("ULL")
-      	-- on 64-bit platforms with 32-bit int, add "L" to 64-bit literals
-      repsuffix I64 | cINT_SIZE == 4 = ptext SLIT("UL")
-      repsuffix _ = char 'U'
-      
-      go 0 = empty
-      go w' = go q <> dig
-           where
-             (q,r) = w' `quotRem` 16
-             dig | r < 10    = char (chr (fromInteger r + ord '0'))
-                 | otherwise = char (chr (fromInteger r - 10 + ord 'a'))
-
diff --git a/ghc/compiler/cmm/PprCmm.hs b/ghc/compiler/cmm/PprCmm.hs
deleted file mode 100644
index 6e8367d662..0000000000
--- a/ghc/compiler/cmm/PprCmm.hs
+++ /dev/null
@@ -1,462 +0,0 @@
-----------------------------------------------------------------------------
---
--- Pretty-printing of Cmm as (a superset of) C--
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
---
--- This is where we walk over Cmm emitting an external representation,
--- suitable for parsing, in a syntax strongly reminiscent of C--. This
--- is the "External Core" for the Cmm layer.
---
--- As such, this should be a well-defined syntax: we want it to look nice.
--- Thus, we try wherever possible to use syntax defined in [1],
--- "The C-- Reference Manual", http://www.cminusminus.org/. We differ
--- slightly, in some cases. For one, we use I8 .. I64 for types, rather
--- than C--'s bits8 .. bits64.
---
--- We try to ensure that all information available in the abstract
--- syntax is reproduced, or reproducible, in the concrete syntax.
--- Data that is not in printed out can be reconstructed according to
--- conventions used in the pretty printer. There are at least two such
--- cases:
---      1) if a value has wordRep type, the type is not appended in the
---      output.
---      2) MachOps that operate over wordRep type are printed in a
---      C-style, rather than as their internal MachRep name.
---
--- These conventions produce much more readable Cmm output.
---
--- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
---
-
-module PprCmm ( 	
-	writeCmms, pprCmms, pprCmm, pprStmt, pprExpr
-  ) where
-
-#include "HsVersions.h"
-
-import Cmm
-import CmmUtils     ( isTrivialCmmExpr )
-import MachOp       ( MachOp(..), pprMachOp, MachRep(..), wordRep )
-import CLabel       ( pprCLabel, mkForeignLabel, entryLblToInfoLbl )
-
-import ForeignCall  ( CCallConv(..) )
-import Unique       ( getUnique )
-import Outputable
-import FastString   ( mkFastString )
-
-import Data.List    ( intersperse, groupBy )
-import IO           ( Handle )
-import Maybe	    ( isJust )
-import Data.Char    ( chr )
-
-pprCmms :: [Cmm] -> SDoc
-pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
-        where
-          separator = space $$ ptext SLIT("-------------------") $$ space
-
-writeCmms :: Handle -> [Cmm] -> IO ()
-writeCmms handle cmms = printForC handle (pprCmms cmms)
-
------------------------------------------------------------------------------
-
-instance Outputable Cmm where
-    ppr c = pprCmm c
-
-instance Outputable CmmTop where
-    ppr t = pprTop t
-
-instance Outputable CmmBasicBlock where
-    ppr b = pprBBlock b
-
-instance Outputable CmmStmt where
-    ppr s = pprStmt s
-
-instance Outputable CmmExpr where
-    ppr e = pprExpr e
-
-instance Outputable CmmReg where
-    ppr e = pprReg e
-
-instance Outputable GlobalReg where
-    ppr e = pprGlobalReg e
-
------------------------------------------------------------------------------
-
-pprCmm :: Cmm -> SDoc
-pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
-
--- --------------------------------------------------------------------------
--- Top level `procedure' blocks. The info tables, if not null, are
--- printed in the style of C--'s 'stackdata' declaration, just inside
--- the proc body, and are labelled with the procedure name ++ "_info".
---
-pprTop :: CmmTop -> SDoc
-pprTop (CmmProc info lbl params blocks )
-
-  = vcat [ pprCLabel lbl <> parens (commafy $ map pprLocalReg params) <+> lbrace
-         , nest 8 $ pprInfo info lbl
-         , nest 4 $ vcat (map ppr blocks)
-         , rbrace ]
-
-  where
-    pprInfo [] _  = empty
-    pprInfo i label = 
-        (hang (pprCLabel (entryLblToInfoLbl label) <+> lbrace )
-            4 $ vcat (map pprStatic i))
-        $$ rbrace
-
--- --------------------------------------------------------------------------
--- We follow [1], 4.5
---
---      section "data" { ... }
---
-pprTop (CmmData section ds) = 
-    (hang (pprSection section <+> lbrace) 4 (vcat (map pprStatic ds)))
-    $$ rbrace
-
-
--- --------------------------------------------------------------------------
--- Basic blocks look like assembly blocks.
---      lbl: stmt ; stmt ; .. 
-pprBBlock :: CmmBasicBlock -> SDoc
-pprBBlock (BasicBlock ident stmts) =
-    hang (pprBlockId ident <> colon) 4 (vcat (map ppr stmts))
-
--- --------------------------------------------------------------------------
--- Statements. C-- usually, exceptions to this should be obvious.
---
-pprStmt :: CmmStmt -> SDoc    
-pprStmt stmt = case stmt of
-
-    -- ;
-    CmmNop -> semi
-
-    --  // text
-    CmmComment s -> text "//" <+> ftext s
-
-    -- reg = expr;
-    CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
-
-    -- rep[lv] = expr;
-    CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
-        where
-          rep = ppr ( cmmExprRep expr )
-
-    -- call "ccall" foo(x, y)[r1, r2];
-    -- ToDo ppr volatile
-    CmmCall (CmmForeignCall fn cconv) results args _volatile ->
-        hcat [ ptext SLIT("call"), space, 
-               doubleQuotes(ppr cconv), space,
-               target fn, parens  ( commafy $ map ppr args ),
-               (if null results
-                    then empty
-                    else brackets( commafy $ map ppr results)), semi ]
-        where
-            target (CmmLit lit) = pprLit lit
-            target fn'          = parens (ppr fn')
-
-    CmmCall (CmmPrim op) results args volatile ->
-        pprStmt (CmmCall (CmmForeignCall (CmmLit lbl) CCallConv)
-                        results args volatile)
-        where
-          lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False)
-
-    CmmBranch ident          -> genBranch ident
-    CmmCondBranch expr ident -> genCondBranch expr ident
-    CmmJump expr params      -> genJump expr params
-    CmmSwitch arg ids        -> genSwitch arg ids
-
--- --------------------------------------------------------------------------
--- goto local label. [1], section 6.6
---
---     goto lbl;
---
-genBranch :: BlockId -> SDoc
-genBranch ident = 
-    ptext SLIT("goto") <+> pprBlockId ident <> semi
-
--- --------------------------------------------------------------------------
--- Conditional. [1], section 6.4
---
---     if (expr) { goto lbl; } 
---
-genCondBranch :: CmmExpr -> BlockId -> SDoc
-genCondBranch expr ident =
-    hsep [ ptext SLIT("if")
-         , parens(ppr expr)
-         , ptext SLIT("goto")
-         , pprBlockId ident <> semi ]
-
--- --------------------------------------------------------------------------
--- A tail call. [1], Section 6.9
---
---     jump foo(a, b, c);
---
-genJump :: CmmExpr -> [LocalReg] -> SDoc
-genJump expr actuals = 
-
-    hcat [ ptext SLIT("jump")
-         , space
-         , if isTrivialCmmExpr expr
-                then pprExpr expr
-                else case expr of
-                    CmmLoad (CmmReg _) _ -> pprExpr expr 
-                    _ -> parens (pprExpr expr)
-         , pprActuals actuals
-         , semi ]
-
-  where
-    pprActuals [] = empty
-    pprActuals as = parens ( commafy $ map pprLocalReg as ) 
-
--- --------------------------------------------------------------------------
--- Tabled jump to local label
---
--- The syntax is from [1], section 6.5
---
---      switch [0 .. n] (expr) { case ... ; }
---
-genSwitch :: CmmExpr -> [Maybe BlockId] -> SDoc
-genSwitch expr maybe_ids 
-
-    = let pairs = groupBy snds (zip [0 .. ] maybe_ids )
-
-      in hang (hcat [ ptext SLIT("switch [0 .. ") 
-                    , int (length maybe_ids - 1)
-                    , ptext SLIT("] ")
-                    , if isTrivialCmmExpr expr
-                        then pprExpr expr
-                        else parens (pprExpr expr)
-                    , ptext SLIT(" {") 
-                    ]) 
-            4 (vcat ( map caseify pairs )) $$ rbrace
-
-    where
-      snds a b = (snd a) == (snd b)
-
-      caseify :: [(Int,Maybe BlockId)] -> SDoc
-      caseify ixs@((i,Nothing):_)
-        = ptext SLIT("/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs))
-		<> ptext SLIT(" */")
-      caseify as 
-        = let (is,ids) = unzip as 
-          in hsep [ ptext SLIT("case")
-                  , hcat (punctuate comma (map int is))
-                  , ptext SLIT(": goto")
-                  , pprBlockId (head [ id | Just id <- ids]) <> semi ]
-
--- --------------------------------------------------------------------------
--- Expressions
---
-
-pprExpr :: CmmExpr -> SDoc
-pprExpr e 
-    = case e of
-        CmmRegOff reg i -> 
-		pprExpr (CmmMachOp (MO_Add rep)
-			   [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)])
-		where rep = cmmRegRep reg	
-	CmmLit lit -> pprLit lit
-	_other     -> pprExpr1 e
-
--- Here's the precedence table from CmmParse.y:
--- %nonassoc '>=' '>' '<=' '<' '!=' '=='
--- %left '|'
--- %left '^'
--- %left '&'
--- %left '>>' '<<'
--- %left '-' '+'
--- %left '/' '*' '%'
--- %right '~'
-
--- We just cope with the common operators for now, the rest will get
--- a default conservative behaviour.
-
--- %nonassoc '>=' '>' '<=' '<' '!=' '=='
-pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op
-   = pprExpr7 x <+> doc <+> pprExpr7 y
-pprExpr1 e = pprExpr7 e
-
-infixMachOp1 (MO_Eq     _) = Just (ptext SLIT("=="))
-infixMachOp1 (MO_Ne     _) = Just (ptext SLIT("!="))
-infixMachOp1 (MO_Shl    _) = Just (ptext SLIT("<<"))
-infixMachOp1 (MO_U_Shr  _) = Just (ptext SLIT(">>"))
-infixMachOp1 (MO_U_Ge   _) = Just (ptext SLIT(">="))
-infixMachOp1 (MO_U_Le   _) = Just (ptext SLIT("<="))
-infixMachOp1 (MO_U_Gt   _) = Just (char '>')
-infixMachOp1 (MO_U_Lt   _) = Just (char '<')
-infixMachOp1 _             = Nothing
-
--- %left '-' '+'
-pprExpr7 (CmmMachOp op [x,y]) | Just doc <- infixMachOp7 op
-   = pprExpr7 x <+> doc <+> pprExpr8 y
-pprExpr7 e = pprExpr8 e
-
-infixMachOp7 (MO_Add _)  = Just (char '+')
-infixMachOp7 (MO_Sub _)  = Just (char '-')
-infixMachOp7 _           = Nothing
-
--- %left '/' '*' '%'
-pprExpr8 (CmmMachOp op [x,y]) | Just doc <- infixMachOp8 op
-   = pprExpr8 x <+> doc <+> pprExpr9 y
-pprExpr8 e = pprExpr9 e
-
-infixMachOp8 (MO_U_Quot _) = Just (char '/')
-infixMachOp8 (MO_Mul _)    = Just (char '*')
-infixMachOp8 (MO_U_Rem _)  = Just (char '%')
-infixMachOp8 _             = Nothing
-
-pprExpr9 :: CmmExpr -> SDoc
-pprExpr9 e = 
-   case e of
-        CmmLit    lit       -> pprLit1 lit
-        CmmLoad   expr rep  -> ppr rep <> brackets( ppr expr )
-        CmmReg    reg       -> ppr reg
-        CmmRegOff reg off   -> parens (ppr reg <+> char '+' <+> int off)
-	CmmMachOp mop args  -> genMachOp mop args
-
-genMachOp :: MachOp -> [CmmExpr] -> SDoc
-genMachOp mop args
-   | Just doc <- infixMachOp mop = case args of
-        -- dyadic
-        [x,y] -> pprExpr9 x <+> doc <+> pprExpr9 y
-
-        -- unary
-        [x]   -> doc <> pprExpr9 x
-
-        _     -> pprTrace "PprCmm.genMachOp: machop with strange number of args"
-                          (pprMachOp mop <+>
-                            parens (hcat $ punctuate comma (map pprExpr args)))
-                          empty
-
-   | isJust (infixMachOp1 mop)
-   || isJust (infixMachOp7 mop)
-   || isJust (infixMachOp8 mop)	 = parens (pprExpr (CmmMachOp mop args))
-
-   | otherwise = char '%' <> pprMachOp mop <> parens (commafy (map pprExpr args))
-
---
--- Unsigned ops on the word size of the machine get nice symbols.
--- All else get dumped in their ugly format.
---
-infixMachOp :: MachOp -> Maybe SDoc
-infixMachOp mop
-	= case mop of
-            MO_And    _ -> Just $ char '&'
-            MO_Or     _ -> Just $ char '|'
-            MO_Xor    _ -> Just $ char '^'
-            MO_Not    _ -> Just $ char '~'
-            MO_S_Neg  _ -> Just $ char '-' -- there is no unsigned neg :)
-            _ -> Nothing
-
--- --------------------------------------------------------------------------
--- Literals.
---  To minimise line noise we adopt the convention that if the literal
---  has the natural machine word size, we do not append the type
---
-pprLit :: CmmLit -> SDoc
-pprLit lit = case lit of
-    CmmInt i rep ->
-        hcat [ (if i < 0 then parens else id)(integer i)
-             , (if rep == wordRep 
-                    then empty 
-                    else space <> dcolon <+> ppr rep) ]
-
-    CmmFloat f rep     -> hsep [ rational f, dcolon, ppr rep ]
-    CmmLabel clbl      -> pprCLabel clbl
-    CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i
-    CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-'  
-                                  <> pprCLabel clbl2 <> ppr_offset i
-
-pprLit1 lit@(CmmLabelOff clbl i) = parens (pprLit lit)
-pprLit1 lit                      = pprLit lit
-
-ppr_offset :: Int -> SDoc
-ppr_offset i
-    | i==0      = empty
-    | i>=0      = char '+' <> int i
-    | otherwise = char '-' <> int (-i)
-
--- --------------------------------------------------------------------------
--- Static data.
---      Strings are printed as C strings, and we print them as I8[],
---      following C--
---
-pprStatic :: CmmStatic -> SDoc
-pprStatic s = case s of
-    CmmStaticLit lit   -> nest 4 $ ptext SLIT("const") <+> pprLit lit <> semi
-    CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i)
-    CmmAlign i         -> nest 4 $ text "align" <+> int i
-    CmmDataLabel clbl  -> pprCLabel clbl <> colon
-    CmmString s'       -> nest 4 $ text "I8[]" <+> 
-			   doubleQuotes (text (map (chr.fromIntegral) s'))
-
--- --------------------------------------------------------------------------
--- Registers, whether local (temps) or global
---
-pprReg :: CmmReg -> SDoc
-pprReg r 
-    = case r of
-        CmmLocal  local  -> pprLocalReg local
-        CmmGlobal global -> pprGlobalReg global
-
---
--- We only print the type of the local reg if it isn't wordRep
---
-pprLocalReg :: LocalReg -> SDoc
-pprLocalReg (LocalReg uniq rep) 
-    = hcat [ char '_', ppr uniq, 
-            (if rep == wordRep 
-                then empty else dcolon <> ppr rep) ]
-
--- needs to be kept in syn with Cmm.hs.GlobalReg
---
-pprGlobalReg :: GlobalReg -> SDoc
-pprGlobalReg gr 
-    = case gr of
-        VanillaReg n   -> char 'R' <> int n
-        FloatReg   n   -> char 'F' <> int n
-        DoubleReg  n   -> char 'D' <> int n
-        LongReg    n   -> char 'L' <> int n
-        Sp             -> ptext SLIT("Sp")
-        SpLim          -> ptext SLIT("SpLim")
-        Hp             -> ptext SLIT("Hp")
-        HpLim          -> ptext SLIT("HpLim")
-        CurrentTSO     -> ptext SLIT("CurrentTSO")
-        CurrentNursery -> ptext SLIT("CurrentNursery")
-        HpAlloc        -> ptext SLIT("HpAlloc")
-        GCEnter1       -> ptext SLIT("stg_gc_enter_1")
-        GCFun          -> ptext SLIT("stg_gc_fun")
-        BaseReg        -> ptext SLIT("BaseReg")
-        PicBaseReg     -> ptext SLIT("PicBaseReg")
-
--- --------------------------------------------------------------------------
--- data sections
---
-pprSection :: Section -> SDoc
-pprSection s = case s of
-    Text              -> section <+> doubleQuotes (ptext SLIT("text"))
-    Data              -> section <+> doubleQuotes (ptext SLIT("data"))
-    ReadOnlyData      -> section <+> doubleQuotes (ptext SLIT("readonly"))
-    RelocatableReadOnlyData
-                      -> section <+> doubleQuotes (ptext SLIT("relreadonly"))
-    UninitialisedData -> section <+> doubleQuotes (ptext SLIT("uninitialised"))
-    OtherSection s'   -> section <+> doubleQuotes (text s')
- where
-    section = ptext SLIT("section")
-       
--- --------------------------------------------------------------------------
--- Basic block ids
---
-pprBlockId :: BlockId -> SDoc
-pprBlockId b = ppr $ getUnique b
-
------------------------------------------------------------------------------
-
-commafy :: [SDoc] -> SDoc
-commafy xs = hsep $ punctuate comma xs
-
diff --git a/ghc/compiler/codeGen/Bitmap.hs b/ghc/compiler/codeGen/Bitmap.hs
deleted file mode 100644
index c0b490978c..0000000000
--- a/ghc/compiler/codeGen/Bitmap.hs
+++ /dev/null
@@ -1,79 +0,0 @@
---
--- (c) The University of Glasgow 2003
--- 
-
--- Functions for constructing bitmaps, which are used in various
--- places in generated code (stack frame liveness masks, function
--- argument liveness masks, SRT bitmaps).
-
-module Bitmap ( 
-	Bitmap, mkBitmap,
-	intsToBitmap, intsToReverseBitmap,
-	mAX_SMALL_BITMAP_SIZE
-  ) where
-
-#include "HsVersions.h"
-#include "../includes/MachDeps.h"
-
-import SMRep
-import Constants
-import DATA_BITS
-
-{-|
-A bitmap represented by a sequence of 'StgWord's on the /target/
-architecture.  These are used for bitmaps in info tables and other
-generated code which need to be emitted as sequences of StgWords.
--}
-type Bitmap = [StgWord]
-
--- | Make a bitmap from a sequence of bits
-mkBitmap :: [Bool] -> Bitmap
-mkBitmap [] = []
-mkBitmap stuff = chunkToBitmap chunk : mkBitmap rest
-  where (chunk, rest) = splitAt wORD_SIZE_IN_BITS stuff
-
-chunkToBitmap :: [Bool] -> StgWord
-chunkToBitmap chunk = 
-  foldr (.|.) 0 [ 1 `shiftL` n | (True,n) <- zip chunk [0..] ]
-
--- | Make a bitmap where the slots specified are the /ones/ in the bitmap.
--- eg. @[1,2,4], size 4 ==> 0xb@.
---
--- The list of @Int@s /must/ be already sorted.
-intsToBitmap :: Int -> [Int] -> Bitmap
-intsToBitmap size slots{- must be sorted -}
-  | size <= 0 = []
-  | otherwise = 
-    (foldr (.|.) 0 (map (1 `shiftL`) these)) : 
-	intsToBitmap (size - wORD_SIZE_IN_BITS) 
-	     (map (\x -> x - wORD_SIZE_IN_BITS) rest)
-   where (these,rest) = span (<wORD_SIZE_IN_BITS) slots
-
--- | Make a bitmap where the slots specified are the /zeros/ in the bitmap.
--- eg. @[1,2,4], size 4 ==> 0x8@  (we leave any bits outside the size as zero,
--- just to make the bitmap easier to read).
---
--- The list of @Int@s /must/ be already sorted.
-intsToReverseBitmap :: Int -> [Int] -> Bitmap
-intsToReverseBitmap size slots{- must be sorted -}
-  | size <= 0 = []
-  | otherwise = 
-    (foldr xor init (map (1 `shiftL`) these)) : 
-	intsToReverseBitmap (size - wORD_SIZE_IN_BITS) 
-	     (map (\x -> x - wORD_SIZE_IN_BITS) rest)
-   where (these,rest) = span (<wORD_SIZE_IN_BITS) slots
-	 init
-	   | size >= wORD_SIZE_IN_BITS = complement 0
-	   | otherwise                 = (1 `shiftL` size) - 1
-
-{- |
-Magic number, must agree with @BITMAP_BITS_SHIFT@ in InfoTables.h.
-Some kinds of bitmap pack a size\/bitmap into a single word if
-possible, or fall back to an external pointer when the bitmap is too
-large.  This value represents the largest size of bitmap that can be
-packed into a single word.
--}
-mAX_SMALL_BITMAP_SIZE :: Int
-mAX_SMALL_BITMAP_SIZE  | wORD_SIZE == 4 = 27
-		       | otherwise      = 58
-
diff --git a/ghc/compiler/codeGen/CgBindery.hi-boot-5 b/ghc/compiler/codeGen/CgBindery.hi-boot-5
deleted file mode 100644
index f375fcc6e1..0000000000
--- a/ghc/compiler/codeGen/CgBindery.hi-boot-5
+++ /dev/null
@@ -1,7 +0,0 @@
-__interface CgBindery 1 0 where
-__export CgBindery CgBindings CgIdInfo VolatileLoc StableLoc nukeVolatileBinds;
-1 type CgBindings = VarEnv.IdEnv CgIdInfo;
-1 data CgIdInfo;
-1 data VolatileLoc;
-1 data StableLoc;
-1 nukeVolatileBinds :: CgBindings -> CgBindings ;
diff --git a/ghc/compiler/codeGen/CgBindery.hi-boot-6 b/ghc/compiler/codeGen/CgBindery.hi-boot-6
deleted file mode 100644
index 7d1f300a86..0000000000
--- a/ghc/compiler/codeGen/CgBindery.hi-boot-6
+++ /dev/null
@@ -1,8 +0,0 @@
-module CgBindery where
-
-type CgBindings = VarEnv.IdEnv CgIdInfo
-data CgIdInfo
-data VolatileLoc
-data StableLoc
-
-nukeVolatileBinds :: CgBindings -> CgBindings
diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs
deleted file mode 100644
index f78edda655..0000000000
--- a/ghc/compiler/codeGen/CgBindery.lhs
+++ /dev/null
@@ -1,494 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[CgBindery]{Utility functions related to doing @CgBindings@}
-
-\begin{code}
-module CgBindery (
-	CgBindings, CgIdInfo,
-	StableLoc, VolatileLoc,
-
-	cgIdInfoId, cgIdInfoArgRep, cgIdInfoLF,
-
-	stableIdInfo, heapIdInfo, 
-	letNoEscapeIdInfo, idInfoToAmode,
-
-	addBindC, addBindsC,
-
-	nukeVolatileBinds,
-	nukeDeadBindings,
-	getLiveStackSlots,
-
-	bindArgsToStack,  rebindToStack,
-	bindNewToNode, bindNewToReg, bindArgsToRegs,
-	bindNewToTemp, 
-	getArgAmode, getArgAmodes, 
-	getCgIdInfo, 
-	getCAddrModeIfVolatile, getVolatileRegs,
-	maybeLetNoEscape, 
-    ) where
-
-#include "HsVersions.h"
-
-import CgMonad
-import CgHeapery	( getHpRelOffset )
-import CgStackery	( freeStackSlots, getSpRelOffset )
-import CgUtils		( cgLit, cmmOffsetW )
-import CLabel		( mkClosureLabel, pprCLabel )
-import ClosureInfo	( mkLFImported, mkLFArgument, LambdaFormInfo )
-
-import Cmm
-import PprCmm		( {- instance Outputable -} )
-import SMRep		( CgRep(..), WordOff, isFollowableArg, 
-			  isVoidArg, cgRepSizeW, argMachRep, 
-			  idCgRep, typeCgRep )
-import Id		( Id, idName )
-import VarEnv
-import VarSet		( varSetElems )
-import Literal		( literalType )
-import Maybes		( catMaybes )
-import Name		( isExternalName )
-import StgSyn		( StgArg, StgLiveVars, GenStgArg(..), isStgTypeArg )
-import Unique           ( Uniquable(..) )
-import UniqSet		( elementOfUniqSet )
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Bindery-datatypes]{Data types}
-%*									*
-%************************************************************************
-
-@(CgBinding a b)@ is a type of finite maps from a to b.
-
-The assumption used to be that @lookupCgBind@ must get exactly one
-match.  This is {\em completely wrong} in the case of compiling
-letrecs (where knot-tying is used).  An initial binding is fed in (and
-never evaluated); eventually, a correct binding is put into the
-environment.  So there can be two bindings for a given name.
-
-\begin{code}
-type CgBindings = IdEnv CgIdInfo
-
-data CgIdInfo
-  = CgIdInfo	
-	{ cg_id :: Id	-- Id that this is the info for
-			-- Can differ from the Id at occurrence sites by 
-			-- virtue of being externalised, for splittable C
-	, cg_rep :: CgRep
-	, cg_vol :: VolatileLoc
-	, cg_stb :: StableLoc
-	, cg_lf  :: LambdaFormInfo }
-
-mkCgIdInfo id vol stb lf
-  = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb, 
-	       cg_lf = lf, cg_rep = idCgRep id }
-
-voidIdInfo id = CgIdInfo { cg_id = id, cg_vol = NoVolatileLoc
-			 , cg_stb = VoidLoc, cg_lf = mkLFArgument id
-			 , cg_rep = VoidArg }
-	-- Used just for VoidRep things
-
-data VolatileLoc	-- These locations die across a call
-  = NoVolatileLoc
-  | RegLoc	CmmReg		   -- In one of the registers (global or local)
-  | VirHpLoc	VirtualHpOffset  -- Hp+offset (address of closure)
-  | VirNodeLoc	VirtualHpOffset  -- Cts of offset indirect from Node
-				   -- ie *(Node+offset)
-\end{code}
-
-@StableLoc@ encodes where an Id can be found, used by
-the @CgBindings@ environment in @CgBindery@.
-
-\begin{code}
-data StableLoc
-  = NoStableLoc
-
-  | VirStkLoc	VirtualSpOffset		-- The thing is held in this
-					-- stack slot
-
-  | VirStkLNE	VirtualSpOffset		-- A let-no-escape thing; the
-					-- value is this stack pointer
-					-- (as opposed to the contents of the slot)
-
-  | StableLoc	CmmExpr
-  | VoidLoc	-- Used only for VoidRep variables.  They never need to
-		-- be saved, so it makes sense to treat treat them as
-		-- having a stable location
-\end{code}
-
-\begin{code}
-instance Outputable CgIdInfo where
-  ppr (CgIdInfo id rep vol stb lf)
-    = ppr id <+> ptext SLIT("-->") <+> vcat [ppr vol, ppr stb]
-
-instance Outputable VolatileLoc where
-  ppr NoVolatileLoc = empty
-  ppr (RegLoc r)     = ptext SLIT("reg") <+> ppr r
-  ppr (VirHpLoc v)   = ptext SLIT("vh")  <+> ppr v
-  ppr (VirNodeLoc v) = ptext SLIT("vn")  <+> ppr v
-
-instance Outputable StableLoc where
-  ppr NoStableLoc   = empty
-  ppr VoidLoc       = ptext SLIT("void")
-  ppr (VirStkLoc v) = ptext SLIT("vs")    <+> ppr v
-  ppr (VirStkLNE v) = ptext SLIT("lne")    <+> ppr v
-  ppr (StableLoc a) = ptext SLIT("amode") <+> ppr a
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Bindery-idInfo]{Manipulating IdInfo}
-%*									*
-%************************************************************************
-
-\begin{code}
-stableIdInfo id amode   lf_info = mkCgIdInfo id NoVolatileLoc (StableLoc amode) lf_info
-heapIdInfo id offset    lf_info = mkCgIdInfo id (VirHpLoc offset) NoStableLoc lf_info
-letNoEscapeIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLNE sp) lf_info
-stackIdInfo id sp	lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info
-nodeIdInfo id offset    lf_info = mkCgIdInfo id (VirNodeLoc offset) NoStableLoc lf_info
-regIdInfo id reg        lf_info = mkCgIdInfo id (RegLoc reg) NoStableLoc lf_info
-
-idInfoToAmode :: CgIdInfo -> FCode CmmExpr
-idInfoToAmode info
-  = case cg_vol info of {
-      RegLoc reg 	-> returnFC (CmmReg reg) ;
-      VirNodeLoc nd_off -> returnFC (CmmLoad (cmmOffsetW (CmmReg nodeReg) nd_off) mach_rep) ;
-      VirHpLoc hp_off   -> getHpRelOffset hp_off ;
-      NoVolatileLoc -> 
-
-    case cg_stb info of
-      StableLoc amode  -> returnFC amode
-      VirStkLoc sp_off -> do { sp_rel <- getSpRelOffset sp_off
-			     ; return (CmmLoad sp_rel mach_rep) }
-
-      VirStkLNE sp_off -> getSpRelOffset sp_off
-
-      VoidLoc -> return $ pprPanic "idInfoToAmode: void" (ppr (cg_id info))
-		-- We return a 'bottom' amode, rather than panicing now
-		-- In this way getArgAmode returns a pair of (VoidArg, bottom)
-		-- and that's exactly what we want
-
-      NoStableLoc -> pprPanic "idInfoToAmode: no loc" (ppr (cg_id info))
-    }
-  where
-    mach_rep = argMachRep (cg_rep info)
-
-cgIdInfoId :: CgIdInfo -> Id
-cgIdInfoId = cg_id 
-
-cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
-cgIdInfoLF = cg_lf
-
-cgIdInfoArgRep :: CgIdInfo -> CgRep
-cgIdInfoArgRep = cg_rep
-
-maybeLetNoEscape (CgIdInfo { cg_stb = VirStkLNE sp_off }) = Just sp_off
-maybeLetNoEscape other   				  = Nothing
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
-%*									*
-%************************************************************************
-
-.There are three basic routines, for adding (@addBindC@), modifying
-(@modifyBindC@) and looking up (@getCgIdInfo@) bindings.
-
-A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
-The name should not already be bound. (nice ASSERT, eh?)
-
-\begin{code}
-addBindC :: Id -> CgIdInfo -> Code
-addBindC name stuff_to_bind = do
-	binds <- getBinds
-	setBinds $ extendVarEnv binds name stuff_to_bind
-
-addBindsC :: [(Id, CgIdInfo)] -> Code
-addBindsC new_bindings = do
-	binds <- getBinds
-	let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
-			      binds
-			      new_bindings
-	setBinds new_binds
-
-modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
-modifyBindC name mangle_fn = do
-	binds <- getBinds
-	setBinds $ modifyVarEnv mangle_fn binds name
-
-getCgIdInfo :: Id -> FCode CgIdInfo
-getCgIdInfo id
-  = do	{ 	-- Try local bindings first
-	; local_binds  <- getBinds
-	; case lookupVarEnv local_binds id of {
-	    Just info -> return info ;
-	    Nothing   -> do
-
-	{ 	-- Try top-level bindings
-	  static_binds <- getStaticBinds
-	; case lookupVarEnv static_binds id of {
-	    Just info -> return info ;
-	    Nothing   ->
-
-		-- Should be imported; make up a CgIdInfo for it
-	let 
-	    name = idName id
-	in
-	if isExternalName name then do
-	    hmods <- getHomeModules 
-	    let ext_lbl = CmmLit (CmmLabel (mkClosureLabel hmods name))
-	    return (stableIdInfo id ext_lbl (mkLFImported id))
-	else
-	if isVoidArg (idCgRep id) then
-		-- Void things are never in the environment
-	    return (voidIdInfo id)
-	else
-	-- Bug	
-	cgLookupPanic id
-	}}}}
-    
-			
-cgLookupPanic :: Id -> FCode a
-cgLookupPanic id
-  = do	static_binds <- getStaticBinds
-	local_binds <- getBinds
-	srt <- getSRTLabel
-	pprPanic "cgPanic"
-		(vcat [ppr id,
-		ptext SLIT("static binds for:"),
-		vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
-		ptext SLIT("local binds for:"),
-		vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ],
-	        ptext SLIT("SRT label") <+> pprCLabel srt
-	      ])
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
-%*									*
-%************************************************************************
-
-We sometimes want to nuke all the volatile bindings; we must be sure
-we don't leave any (NoVolatile, NoStable) binds around...
-
-\begin{code}
-nukeVolatileBinds :: CgBindings -> CgBindings
-nukeVolatileBinds binds
-  = mkVarEnv (foldr keep_if_stable [] (varEnvElts binds))
-  where
-    keep_if_stable (CgIdInfo { cg_stb = NoStableLoc }) acc = acc
-    keep_if_stable info acc
-      = (cg_id info, info { cg_vol = NoVolatileLoc }) : acc
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[lookup-interface]{Interface functions to looking up bindings}
-%*									*
-%************************************************************************
-
-\begin{code}
-getCAddrModeIfVolatile :: Id -> FCode (Maybe CmmExpr)
-getCAddrModeIfVolatile id
-  = do	{ info <- getCgIdInfo id
-	; case cg_stb info of
-		NoStableLoc -> do -- Aha!  So it is volatile!
-			amode <- idInfoToAmode info
-			return $ Just amode
-		a_stable_loc -> return Nothing }
-\end{code}
-
-@getVolatileRegs@ gets a set of live variables, and returns a list of
-all registers on which these variables depend.  These are the regs
-which must be saved and restored across any C calls.  If a variable is
-both in a volatile location (depending on a register) {\em and} a
-stable one (notably, on the stack), we modify the current bindings to
-forget the volatile one.
-
-\begin{code}
-getVolatileRegs :: StgLiveVars -> FCode [GlobalReg]
-
-getVolatileRegs vars = do
-  do 	{ stuff <- mapFCs snaffle_it (varSetElems vars)
-	; returnFC $ catMaybes stuff }
-  where
-    snaffle_it var = do
-	{ info <- getCgIdInfo var 
-	; let
-		-- commoned-up code...
-	     consider_reg reg
-		=	-- We assume that all regs can die across C calls
-			-- We leave it to the save-macros to decide which
-			-- regs *really* need to be saved.
-		  case cg_stb info of
-			NoStableLoc     -> returnFC (Just reg) -- got one!
-			is_a_stable_loc -> do
-				{ -- has both volatile & stable locations;
-				  -- force it to rely on the stable location
-				  modifyBindC var nuke_vol_bind 
-				; return Nothing }
-
-	; case cg_vol info of
-	    RegLoc (CmmGlobal reg) -> consider_reg reg
-	    VirNodeLoc _ 	   -> consider_reg node
-	    other_loc 	 	   -> returnFC Nothing	-- Local registers
-	}
-
-    nuke_vol_bind info = info { cg_vol = NoVolatileLoc }
-\end{code}
-
-\begin{code}
-getArgAmode :: StgArg -> FCode (CgRep, CmmExpr)
-getArgAmode (StgVarArg var) 
-  = do	{ info <- getCgIdInfo var
-	; amode <- idInfoToAmode info
-	; return (cgIdInfoArgRep info, amode ) }
-
-getArgAmode (StgLitArg lit) 
-  = do	{ cmm_lit <- cgLit lit
-	; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
-
-getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg"
-
-getArgAmodes :: [StgArg] -> FCode [(CgRep, CmmExpr)]
-getArgAmodes [] = returnFC []
-getArgAmodes (atom:atoms)
-  | isStgTypeArg atom = getArgAmodes atoms
-  | otherwise 	      = do { amode  <- getArgAmode  atom 
-	 		   ; amodes <- getArgAmodes atoms
-	 		   ; return ( amode : amodes ) }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
-%*									*
-%************************************************************************
-
-\begin{code}
-bindArgsToStack :: [(Id, VirtualSpOffset)] -> Code
-bindArgsToStack args
-  = mapCs bind args
-  where
-    bind(id, offset) = addBindC id (stackIdInfo id offset (mkLFArgument id))
-
-bindArgsToRegs :: [(Id, GlobalReg)] -> Code
-bindArgsToRegs args
-  = mapCs bind args
-  where
-    bind (arg, reg) = bindNewToReg arg (CmmGlobal reg) (mkLFArgument arg)
-
-bindNewToNode :: Id -> VirtualHpOffset -> LambdaFormInfo -> Code
-bindNewToNode id offset lf_info
-  = addBindC id (nodeIdInfo id offset lf_info)
-
--- Create a new temporary whose unique is that in the id,
--- bind the id to it, and return the addressing mode for the
--- temporary.
-bindNewToTemp :: Id -> FCode CmmReg
-bindNewToTemp id
-  = do	addBindC id (regIdInfo id temp_reg lf_info)
-	return temp_reg
-  where
-    uniq     = getUnique id
-    temp_reg = CmmLocal (LocalReg uniq (argMachRep (idCgRep id)))
-    lf_info  = mkLFArgument id	-- Always used of things we
-				-- know nothing about
-
-bindNewToReg :: Id -> CmmReg -> LambdaFormInfo -> Code
-bindNewToReg name reg lf_info
-  = addBindC name info
-  where
-    info = mkCgIdInfo name (RegLoc reg) NoStableLoc lf_info
-\end{code}
-
-\begin{code}
-rebindToStack :: Id -> VirtualSpOffset -> Code
-rebindToStack name offset
-  = modifyBindC name replace_stable_fn
-  where
-    replace_stable_fn info = info { cg_stb = VirStkLoc offset }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[CgMonad-deadslots]{Finding dead stack slots}
-%*									*
-%************************************************************************
-
-nukeDeadBindings does the following:
-
-      -	Removes all bindings from the environment other than those
-	for variables in the argument to nukeDeadBindings.
-      -	Collects any stack slots so freed, and returns them to the  stack free
-	list.
-      -	Moves the virtual stack pointer to point to the topmost used
-	stack locations.
-
-You can have multi-word slots on the stack (where a Double# used to
-be, for instance); if dead, such a slot will be reported as *several*
-offsets (one per word).
-
-Probably *naughty* to look inside monad...
-
-\begin{code}
-nukeDeadBindings :: StgLiveVars  -- All the *live* variables
-		 -> Code
-nukeDeadBindings live_vars = do
-	binds <- getBinds
-	let (dead_stk_slots, bs') =
-		dead_slots live_vars 
-			[] []
-			[ (cg_id b, b) | b <- varEnvElts binds ]
-	setBinds $ mkVarEnv bs'
-	freeStackSlots dead_stk_slots
-\end{code}
-
-Several boring auxiliary functions to do the dirty work.
-
-\begin{code}
-dead_slots :: StgLiveVars
-	   -> [(Id,CgIdInfo)]
-	   -> [VirtualSpOffset]
-	   -> [(Id,CgIdInfo)]
-	   -> ([VirtualSpOffset], [(Id,CgIdInfo)])
-
--- dead_slots carries accumulating parameters for
---	filtered bindings, dead slots
-dead_slots live_vars fbs ds []
-  = (ds, reverse fbs) -- Finished; rm the dups, if any
-
-dead_slots live_vars fbs ds ((v,i):bs)
-  | v `elementOfUniqSet` live_vars
-    = dead_slots live_vars ((v,i):fbs) ds bs
-	  -- Live, so don't record it in dead slots
-	  -- Instead keep it in the filtered bindings
-
-  | otherwise
-    = case cg_stb i of
-	VirStkLoc offset
-	 | size > 0
-	 -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
-
-	_ -> dead_slots live_vars fbs ds bs
-  where
-    size :: WordOff
-    size = cgRepSizeW (cg_rep i)
-\end{code}
-
-\begin{code}
-getLiveStackSlots :: FCode [VirtualSpOffset]
--- Return the offsets of slots in stack containig live pointers
-getLiveStackSlots 
-  = do 	{ binds <- getBinds
-	; return [off | CgIdInfo { cg_stb = VirStkLoc off, 
-				   cg_rep = rep } <- varEnvElts binds, 
-		        isFollowableArg rep] }
-\end{code}
diff --git a/ghc/compiler/codeGen/CgBindery.lhs-boot b/ghc/compiler/codeGen/CgBindery.lhs-boot
deleted file mode 100644
index e504a6a9ba..0000000000
--- a/ghc/compiler/codeGen/CgBindery.lhs-boot
+++ /dev/null
@@ -1,11 +0,0 @@
-\begin{code}
-module CgBindery where
-import VarEnv( IdEnv )
-
-data CgIdInfo
-data VolatileLoc
-data StableLoc
-type CgBindings = IdEnv CgIdInfo
-
-nukeVolatileBinds :: CgBindings -> CgBindings
-\end{code}
\ No newline at end of file
diff --git a/ghc/compiler/codeGen/CgCallConv.hs b/ghc/compiler/codeGen/CgCallConv.hs
deleted file mode 100644
index f463255807..0000000000
--- a/ghc/compiler/codeGen/CgCallConv.hs
+++ /dev/null
@@ -1,512 +0,0 @@
------------------------------------------------------------------------------
---
---		CgCallConv
---
--- The datatypes and functions here encapsulate the 
--- calling and return conventions used by the code generator.
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
-
-module CgCallConv (
-	-- Argument descriptors
-	mkArgDescr, argDescrType,
-
-	-- Liveness
-	isBigLiveness, buildContLiveness, mkRegLiveness, 
-	smallLiveness, mkLivenessCLit,
-
-	-- Register assignment
-	assignCallRegs, assignReturnRegs, assignPrimOpCallRegs,
-
-	-- Calls
-	constructSlowCall, slowArgs, slowCallPattern,
-
-	-- Returns
-	CtrlReturnConvention(..),
-	ctrlReturnConvAlg,
-	dataReturnConvPrim,
-	getSequelAmode
-    ) where
-
-#include "HsVersions.h"
-
-import CgUtils		( emitRODataLits, mkWordCLit )
-import CgMonad
-
-import Constants	( mAX_FAMILY_SIZE_FOR_VEC_RETURNS,
-			  mAX_Vanilla_REG, mAX_Float_REG,
-			  mAX_Double_REG, mAX_Long_REG,
-			  mAX_Real_Vanilla_REG, mAX_Real_Float_REG,
-			  mAX_Real_Double_REG, mAX_Real_Long_REG,
-			  bITMAP_BITS_SHIFT
-			)
-
-import ClosureInfo	( ArgDescr(..), Liveness(..) )
-import CgStackery	( getSpRelOffset )
-import SMRep
-import MachOp		( wordRep )
-import Cmm		( CmmExpr(..), GlobalReg(..), CmmLit(..), CmmReg(..), node )
-import CmmUtils		( mkLblExpr )
-import CLabel
-import Maybes		( mapCatMaybes )
-import Id		( Id )
-import Name		( Name )
-import TyCon		( TyCon, tyConFamilySize )
-import Bitmap		( Bitmap, mAX_SMALL_BITMAP_SIZE, 
-			  mkBitmap, intsToReverseBitmap )
-import Util		( isn'tIn, sortLe )
-import StaticFlags	( opt_Unregisterised )
-import FastString	( LitString )
-import Outputable
-import DATA_BITS
-
-
--------------------------------------------------------------------------
---
---	Making argument descriptors
---
---  An argument descriptor describes the layout of args on the stack,
---  both for 	* GC (stack-layout) purposes, and 
---		* saving/restoring registers when a heap-check fails
---
--- Void arguments aren't important, therefore (contrast constructSlowCall)
---
--------------------------------------------------------------------------
-
--- bring in ARG_P, ARG_N, etc.
-#include "../includes/StgFun.h"
-
--------------------------
-argDescrType :: ArgDescr -> Int
--- The "argument type" RTS field type
-argDescrType (ArgSpec n) = n
-argDescrType (ArgGen liveness)
-  | isBigLiveness liveness = ARG_GEN_BIG
-  | otherwise		   = ARG_GEN
-
-
-mkArgDescr :: Name -> [Id] -> FCode ArgDescr
-mkArgDescr nm args 
-  = case stdPattern arg_reps of
-	Just spec_id -> return (ArgSpec spec_id)
-	Nothing      -> do { liveness <- mkLiveness nm size bitmap
-			   ; return (ArgGen liveness) }
-  where
-    arg_reps = filter nonVoidArg (map idCgRep args)
-	-- Getting rid of voids eases matching of standard patterns
-
-    bitmap   = mkBitmap arg_bits
-    arg_bits = argBits arg_reps
-    size     = length arg_bits
-
-argBits :: [CgRep] -> [Bool]	-- True for non-ptr, False for ptr
-argBits [] 		= []
-argBits (PtrArg : args) = False : argBits args
-argBits (arg    : args) = take (cgRepSizeW arg) (repeat True) ++ argBits args
-
-stdPattern :: [CgRep] -> Maybe Int
-stdPattern []          = Just ARG_NONE	-- just void args, probably
-
-stdPattern [PtrArg]    = Just ARG_P
-stdPattern [FloatArg]  = Just ARG_F
-stdPattern [DoubleArg] = Just ARG_D
-stdPattern [LongArg]   = Just ARG_L
-stdPattern [NonPtrArg] = Just ARG_N
-	 
-stdPattern [NonPtrArg,NonPtrArg] = Just ARG_NN
-stdPattern [NonPtrArg,PtrArg]    = Just ARG_NP
-stdPattern [PtrArg,NonPtrArg]    = Just ARG_PN
-stdPattern [PtrArg,PtrArg]       = Just ARG_PP
-
-stdPattern [NonPtrArg,NonPtrArg,NonPtrArg] = Just ARG_NNN
-stdPattern [NonPtrArg,NonPtrArg,PtrArg]    = Just ARG_NNP
-stdPattern [NonPtrArg,PtrArg,NonPtrArg]    = Just ARG_NPN
-stdPattern [NonPtrArg,PtrArg,PtrArg]	   = Just ARG_NPP
-stdPattern [PtrArg,NonPtrArg,NonPtrArg]    = Just ARG_PNN
-stdPattern [PtrArg,NonPtrArg,PtrArg]	   = Just ARG_PNP
-stdPattern [PtrArg,PtrArg,NonPtrArg]	   = Just ARG_PPN
-stdPattern [PtrArg,PtrArg,PtrArg]	   = Just ARG_PPP
-	 
-stdPattern [PtrArg,PtrArg,PtrArg,PtrArg]	       = Just ARG_PPPP
-stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg]        = Just ARG_PPPPP
-stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPPPP
-stdPattern other = Nothing
-
-
--------------------------------------------------------------------------
---
---	Liveness info
---
--------------------------------------------------------------------------
-
-mkLiveness :: Name -> Int -> Bitmap -> FCode Liveness
-mkLiveness name size bits
-  | size > mAX_SMALL_BITMAP_SIZE		-- Bitmap does not fit in one word
-  = do	{ let lbl = mkBitmapLabel name
-	; emitRODataLits lbl ( mkWordCLit (fromIntegral size)
-		             : map mkWordCLit bits)
-	; return (BigLiveness lbl) }
-  
-  | otherwise		-- Bitmap fits in one word
-  = let
-        small_bits = case bits of 
-			[]  -> 0
-			[b] -> fromIntegral b
-			_   -> panic "livenessToAddrMode"
-    in
-    return (smallLiveness size small_bits)
-
-smallLiveness :: Int -> StgWord -> Liveness
-smallLiveness size small_bits = SmallLiveness bits
-  where bits = fromIntegral size .|. (small_bits `shiftL` bITMAP_BITS_SHIFT)
-
--------------------
-isBigLiveness :: Liveness -> Bool
-isBigLiveness (BigLiveness _)   = True
-isBigLiveness (SmallLiveness _) = False
-
--------------------
-mkLivenessCLit :: Liveness -> CmmLit
-mkLivenessCLit (BigLiveness lbl)    = CmmLabel lbl
-mkLivenessCLit (SmallLiveness bits) = mkWordCLit bits
-
-
--------------------------------------------------------------------------
---
---		Bitmap describing register liveness
---		across GC when doing a "generic" heap check
---		(a RET_DYN stack frame).
---
--- NB. Must agree with these macros (currently in StgMacros.h): 
--- GET_NON_PTRS(), GET_PTRS(), GET_LIVENESS().
--------------------------------------------------------------------------
-
-mkRegLiveness :: [(Id, GlobalReg)] -> Int -> Int -> StgWord
-mkRegLiveness regs ptrs nptrs
-  = (fromIntegral nptrs `shiftL` 16) .|. 
-    (fromIntegral ptrs  `shiftL` 24) .|.
-    all_non_ptrs `xor` reg_bits regs
-  where
-    all_non_ptrs = 0xff
-
-    reg_bits [] = 0
-    reg_bits ((id, VanillaReg i) : regs) | isFollowableArg (idCgRep id)
-  	= (1 `shiftL` (i - 1)) .|. reg_bits regs
-    reg_bits (_ : regs)
-	= reg_bits regs
-  
--------------------------------------------------------------------------
---
---		Pushing the arguments for a slow call
---
--------------------------------------------------------------------------
-
--- For a slow call, we must take a bunch of arguments and intersperse
--- some stg_ap_<pattern>_ret_info return addresses.
-constructSlowCall
-	:: [(CgRep,CmmExpr)]
-	-> (CLabel,		-- RTS entry point for call
-	   [(CgRep,CmmExpr)],	-- args to pass to the entry point
-	   [(CgRep,CmmExpr)])	-- stuff to save on the stack
-
-   -- don't forget the zero case
-constructSlowCall [] 
-  = (mkRtsApFastLabel SLIT("stg_ap_0"), [], [])
-
-constructSlowCall amodes
-  = (stg_ap_pat, these, rest)
-  where 
-    stg_ap_pat = mkRtsApFastLabel arg_pat
-    (arg_pat, these, rest) = matchSlowPattern amodes
-
-enterRtsRetLabel arg_pat
-  | tablesNextToCode = mkRtsRetInfoLabel arg_pat
-  | otherwise        = mkRtsRetLabel arg_pat
-
--- | 'slowArgs' takes a list of function arguments and prepares them for
--- pushing on the stack for "extra" arguments to a function which requires
--- fewer arguments than we currently have.
-slowArgs :: [(CgRep,CmmExpr)] -> [(CgRep,CmmExpr)]
-slowArgs [] = []
-slowArgs amodes = (NonPtrArg, mkLblExpr stg_ap_pat) : args ++ slowArgs rest
-  where	(arg_pat, args, rest) = matchSlowPattern amodes
-	stg_ap_pat = mkRtsRetInfoLabel arg_pat
-  
-matchSlowPattern :: [(CgRep,CmmExpr)] 
-		 -> (LitString, [(CgRep,CmmExpr)], [(CgRep,CmmExpr)])
-matchSlowPattern amodes = (arg_pat, these, rest)
-  where (arg_pat, n)  = slowCallPattern (map fst amodes)
-	(these, rest) = splitAt n amodes
-
--- These cases were found to cover about 99% of all slow calls:
-slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) = (SLIT("stg_ap_pppppp"), 6)
-slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: _) 	= (SLIT("stg_ap_ppppp"), 5)
-slowCallPattern (PtrArg: PtrArg: PtrArg: PtrArg: _) 	= (SLIT("stg_ap_pppp"), 4)
-slowCallPattern (PtrArg: PtrArg: PtrArg: VoidArg: _) 	= (SLIT("stg_ap_pppv"), 4)
-slowCallPattern (PtrArg: PtrArg: PtrArg: _)       	= (SLIT("stg_ap_ppp"), 3)
-slowCallPattern (PtrArg: PtrArg: VoidArg: _)       	= (SLIT("stg_ap_ppv"), 3)
-slowCallPattern (PtrArg: PtrArg: _)			= (SLIT("stg_ap_pp"), 2)
-slowCallPattern (PtrArg: VoidArg: _)			= (SLIT("stg_ap_pv"), 2)
-slowCallPattern (PtrArg: _)				= (SLIT("stg_ap_p"), 1)
-slowCallPattern (VoidArg: _)				= (SLIT("stg_ap_v"), 1)
-slowCallPattern (NonPtrArg: _)				= (SLIT("stg_ap_n"), 1)
-slowCallPattern (FloatArg: _)				= (SLIT("stg_ap_f"), 1)
-slowCallPattern (DoubleArg: _)				= (SLIT("stg_ap_d"), 1)
-slowCallPattern (LongArg: _)				= (SLIT("stg_ap_l"), 1)
-slowCallPattern _  = panic "CgStackery.slowCallPattern"
-
--------------------------------------------------------------------------
---
---		Return conventions
---
--------------------------------------------------------------------------
-
--- A @CtrlReturnConvention@ says how {\em control} is returned.
-
-data CtrlReturnConvention
-  = VectoredReturn	Int	-- size of the vector table (family size)
-  | UnvectoredReturn    Int 	-- family size
-
-ctrlReturnConvAlg :: TyCon -> CtrlReturnConvention
-ctrlReturnConvAlg tycon
-  = case (tyConFamilySize tycon) of
-      size -> -- we're supposed to know...
-	if (size > (1::Int) && size <= mAX_FAMILY_SIZE_FOR_VEC_RETURNS) then
-	    VectoredReturn size
-	else
-	    UnvectoredReturn size	
-  -- NB: unvectored returns Include size 0 (no constructors), so that
-  --     the following perverse code compiles (it crashed GHC in 5.02)
-  -- 	    data T1
-  --	    data T2 = T2 !T1 Int
-  --     The only value of type T1 is bottom, which never returns anyway.
-
-dataReturnConvPrim :: CgRep -> CmmReg
-dataReturnConvPrim PtrArg    = CmmGlobal (VanillaReg 1)
-dataReturnConvPrim NonPtrArg = CmmGlobal (VanillaReg 1)
-dataReturnConvPrim LongArg   = CmmGlobal (LongReg 1)
-dataReturnConvPrim FloatArg  = CmmGlobal (FloatReg 1)
-dataReturnConvPrim DoubleArg = CmmGlobal (DoubleReg 1)
-dataReturnConvPrim VoidArg   = panic "dataReturnConvPrim: void"
-
-
--- getSequelAmode returns an amode which refers to an info table.  The info
--- table will always be of the RET(_VEC)?_(BIG|SMALL) kind.  We're careful
--- not to handle real code pointers, just in case we're compiling for 
--- an unregisterised/untailcallish architecture, where info pointers and
--- code pointers aren't the same.
--- DIRE WARNING.
--- The OnStack case of sequelToAmode delivers an Amode which is only
--- valid just before the final control transfer, because it assumes
--- that Sp is pointing to the top word of the return address.  This
--- seems unclean but there you go.
-
-getSequelAmode :: FCode CmmExpr
-getSequelAmode
-  = do	{ EndOfBlockInfo virt_sp sequel <- getEndOfBlockInfo
-	; case sequel of
-	    OnStack -> do { sp_rel <- getSpRelOffset virt_sp
-			  ; returnFC (CmmLoad sp_rel wordRep) }
-
-	    UpdateCode 	           -> returnFC (CmmLit (CmmLabel mkUpdInfoLabel))
-	    CaseAlts lbl _ _ True  -> returnFC (CmmLit (CmmLabel mkSeqInfoLabel))
-	    CaseAlts lbl _ _ False -> returnFC (CmmLit (CmmLabel lbl))
-	}
-
--------------------------------------------------------------------------
---
---		Build a liveness mask for the current stack
---
--------------------------------------------------------------------------
-
--- There are four kinds of things on the stack:
---
---	- pointer variables (bound in the environment)
--- 	- non-pointer variables (boudn in the environment)
--- 	- free slots (recorded in the stack free list)
--- 	- non-pointer data slots (recorded in the stack free list)
--- 
--- We build up a bitmap of non-pointer slots by searching the environment
--- for all the pointer variables, and subtracting these from a bitmap
--- with initially all bits set (up to the size of the stack frame).
-
-buildContLiveness :: Name		-- Basis for label (only)
-		  -> [VirtualSpOffset] 	-- Live stack slots
-		  -> FCode Liveness
-buildContLiveness name live_slots
- = do	{ stk_usg    <- getStkUsage
-	; let	StackUsage { realSp = real_sp, 
-			     frameSp = frame_sp } = stk_usg
-
-		start_sp :: VirtualSpOffset
-		start_sp = real_sp - retAddrSizeW
-		-- In a continuation, we want a liveness mask that 
-		-- starts from just after the return address, which is 
-		-- on the stack at real_sp.
-
-		frame_size :: WordOff
-		frame_size = start_sp - frame_sp
-		-- real_sp points to the frame-header for the current
-		-- stack frame, and the end of this frame is frame_sp.
-		-- The size is therefore real_sp - frame_sp - retAddrSizeW
-		-- (subtract one for the frame-header = return address).
-	
-		rel_slots :: [WordOff]
-	 	rel_slots = sortLe (<=) 
-	    	    [ start_sp - ofs  -- Get slots relative to top of frame
-	    	    | ofs <- live_slots ]
-
-		bitmap = intsToReverseBitmap frame_size rel_slots
-
-	; WARN( not (all (>=0) rel_slots), 
-		ppr name $$ ppr live_slots $$ ppr frame_size $$ ppr start_sp $$ ppr rel_slots )
-	  mkLiveness name frame_size bitmap }
-
-
--------------------------------------------------------------------------
---
---		Register assignment
---
--------------------------------------------------------------------------
-
---  How to assign registers for 
---
---	1) Calling a fast entry point.
---	2) Returning an unboxed tuple.
---	3) Invoking an out-of-line PrimOp.
---
--- Registers are assigned in order.
--- 
--- If we run out, we don't attempt to assign any further registers (even
--- though we might have run out of only one kind of register); we just
--- return immediately with the left-overs specified.
--- 
--- The alternative version @assignAllRegs@ uses the complete set of
--- registers, including those that aren't mapped to real machine
--- registers.  This is used for calling special RTS functions and PrimOps
--- which expect their arguments to always be in the same registers.
-
-assignCallRegs, assignPrimOpCallRegs, assignReturnRegs
-	:: [(CgRep,a)]		-- Arg or result values to assign
-	-> ([(a, GlobalReg)],	-- Register assignment in same order
-				-- for *initial segment of* input list
-				--   (but reversed; doesn't matter)
-				-- VoidRep args do not appear here
-	    [(CgRep,a)])	-- Leftover arg or result values
-
-assignCallRegs args
-  = assign_regs args (mkRegTbl [node])
-	-- The entry convention for a function closure
-	-- never uses Node for argument passing; instead
-	-- Node points to the function closure itself
-
-assignPrimOpCallRegs args
- = assign_regs args (mkRegTbl_allRegs [])
-	-- For primops, *all* arguments must be passed in registers
-
-assignReturnRegs args
- = assign_regs args (mkRegTbl [])
-	-- For returning unboxed tuples etc, 
-	-- we use all regs
-
-assign_regs :: [(CgRep,a)]     	-- Arg or result values to assign
-	    -> AvailRegs	-- Regs still avail: Vanilla, Float, Double, Longs
-	    -> ([(a, GlobalReg)], [(CgRep, a)])
-assign_regs args supply
-  = go args [] supply
-  where
-    go [] acc supply = (acc, [])	-- Return the results reversed (doesn't matter)
-    go ((VoidArg,_) : args) acc supply 	-- Skip void arguments; they aren't passed, and
-	= go args acc supply		-- there's nothign to bind them to
-    go ((rep,arg) : args) acc supply 
-	= case assign_reg rep supply of
-		Just (reg, supply') -> go args ((arg,reg):acc) supply'
-		Nothing	   	    -> (acc, (rep,arg):args) 	-- No more regs
-
-assign_reg :: CgRep -> AvailRegs -> Maybe (GlobalReg, AvailRegs)
-assign_reg FloatArg  (vs, f:fs, ds, ls) = Just (FloatReg f,   (vs, fs, ds, ls))
-assign_reg DoubleArg (vs, fs, d:ds, ls) = Just (DoubleReg d,  (vs, fs, ds, ls))
-assign_reg LongArg   (vs, fs, ds, l:ls) = Just (LongReg l,    (vs, fs, ds, ls))
-assign_reg PtrArg    (v:vs, fs, ds, ls) = Just (VanillaReg v, (vs, fs, ds, ls))
-assign_reg NonPtrArg (v:vs, fs, ds, ls) = Just (VanillaReg v, (vs, fs, ds, ls))
-    -- PtrArg and NonPtrArg both go in a vanilla register
-assign_reg other     not_enough_regs    = Nothing
-
-
--------------------------------------------------------------------------
---
---		Register supplies
---
--------------------------------------------------------------------------
-
--- Vanilla registers can contain pointers, Ints, Chars.
--- Floats and doubles have separate register supplies.
---
--- We take these register supplies from the *real* registers, i.e. those
--- that are guaranteed to map to machine registers.
-
-useVanillaRegs | opt_Unregisterised = 0
-	       | otherwise          = mAX_Real_Vanilla_REG
-useFloatRegs   | opt_Unregisterised = 0
-	       | otherwise          = mAX_Real_Float_REG
-useDoubleRegs  | opt_Unregisterised = 0
-	       | otherwise          = mAX_Real_Double_REG
-useLongRegs    | opt_Unregisterised = 0
-	       | otherwise          = mAX_Real_Long_REG
-
-vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: [Int]
-vanillaRegNos	 = regList useVanillaRegs
-floatRegNos	 = regList useFloatRegs
-doubleRegNos	 = regList useDoubleRegs
-longRegNos       = regList useLongRegs
-
-allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
-allVanillaRegNos = regList mAX_Vanilla_REG
-allFloatRegNos	 = regList mAX_Float_REG
-allDoubleRegNos	 = regList mAX_Double_REG
-allLongRegNos	 = regList mAX_Long_REG
-
-regList 0 = []
-regList n = [1 .. n]
-
-type AvailRegs = ( [Int]   -- available vanilla regs.
-		 , [Int]   -- floats
-		 , [Int]   -- doubles
-		 , [Int]   -- longs (int64 and word64)
-		 )
-
-mkRegTbl :: [GlobalReg] -> AvailRegs
-mkRegTbl regs_in_use
-  = mkRegTbl' regs_in_use vanillaRegNos floatRegNos doubleRegNos longRegNos
-
-mkRegTbl_allRegs :: [GlobalReg] -> AvailRegs
-mkRegTbl_allRegs regs_in_use
-  = mkRegTbl' regs_in_use allVanillaRegNos allFloatRegNos allDoubleRegNos allLongRegNos
-
-mkRegTbl' regs_in_use vanillas floats doubles longs
-  = (ok_vanilla, ok_float, ok_double, ok_long)
-  where
-    ok_vanilla = mapCatMaybes (select VanillaReg) vanillas
-    ok_float   = mapCatMaybes (select FloatReg)	  floats
-    ok_double  = mapCatMaybes (select DoubleReg)  doubles
-    ok_long    = mapCatMaybes (select LongReg)    longs   
-				    -- rep isn't looked at, hence we can use any old rep.
-
-    select :: (Int -> GlobalReg) -> Int{-cand-} -> Maybe Int
-	-- one we've unboxed the Int, we make a GlobalReg
-	-- and see if it is already in use; if not, return its number.
-
-    select mk_reg_fun cand
-      = let
-	    reg = mk_reg_fun cand
-	in
-	if reg `not_elem` regs_in_use
-	then Just cand
-	else Nothing
-      where
-	not_elem = isn'tIn "mkRegTbl"
-
-
diff --git a/ghc/compiler/codeGen/CgCase.lhs b/ghc/compiler/codeGen/CgCase.lhs
deleted file mode 100644
index e7c08940c5..0000000000
--- a/ghc/compiler/codeGen/CgCase.lhs
+++ /dev/null
@@ -1,634 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-% $Id: CgCase.lhs,v 1.75 2005/06/21 10:44:41 simonmar Exp $
-%
-%********************************************************
-%*							*
-\section[CgCase]{Converting @StgCase@ expressions}
-%*							*
-%********************************************************
-
-\begin{code}
-module CgCase (	cgCase, saveVolatileVarsAndRegs, 
-		restoreCurrentCostCentre
-	) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} CgExpr  ( cgExpr )
-
-import CgMonad
-import StgSyn
-import CgBindery	( getArgAmodes,
-			  bindNewToReg, bindNewToTemp,
-			  getCgIdInfo, getArgAmode,
-			  rebindToStack, getCAddrModeIfVolatile,
-			  nukeDeadBindings, idInfoToAmode
-			)
-import CgCon		( bindConArgs, bindUnboxedTupleComponents )
-import CgHeapery	( altHeapCheck, unbxTupleHeapCheck )
-import CgCallConv	( dataReturnConvPrim, ctrlReturnConvAlg,
-			  CtrlReturnConvention(..)
-			)
-import CgStackery	( allocPrimStack, allocStackTop, getSpRelOffset,
-			  deAllocStackTop, freeStackSlots
-			)
-import CgTailCall	( performTailCall )
-import CgPrimOp		( cgPrimOp )
-import CgForeignCall	( cgForeignCall )
-import CgUtils		( newTemp, cgLit, emitLitSwitch, emitSwitch,
-			  tagToClosure )
-import CgProf		( curCCS, curCCSAddr )
-import CgInfoTbls	( emitDirectReturnTarget, emitAlgReturnTarget, 
-			  dataConTagZ )
-import SMRep		( CgRep(..), retAddrSizeW, nonVoidArg, isVoidArg,
-			  idCgRep, tyConCgRep, typeHint )
-import CmmUtils		( CmmStmts, noStmts, oneStmt, plusStmts )
-import Cmm
-import MachOp		( wordRep )
-import ClosureInfo	( mkLFArgument )
-import StaticFlags	( opt_SccProfilingOn )
-import Id		( Id, idName, isDeadBinder, idType )
-import ForeignCall	( ForeignCall(..), CCallSpec(..), playSafe )
-import VarSet		( varSetElems )
-import CoreSyn		( AltCon(..) )
-import PrimOp		( PrimOp(..), primOpOutOfLine )
-import TyCon		( isEnumerationTyCon, tyConFamilySize )
-import Util		( isSingleton )
-import Outputable
-\end{code}
-
-\begin{code}
-data GCFlag
-  = GCMayHappen	-- The scrutinee may involve GC, so everything must be
-		-- tidy before the code for the scrutinee.
-
-  | NoGC	-- The scrutinee is a primitive value, or a call to a
-		-- primitive op which does no GC.  Hence the case can
-		-- be done inline, without tidying up first.
-\end{code}
-
-It is quite interesting to decide whether to put a heap-check
-at the start of each alternative.  Of course we certainly have
-to do so if the case forces an evaluation, or if there is a primitive
-op which can trigger GC.
-
-A more interesting situation is this:
-
- \begin{verbatim}
-	!A!;
-	...A...
-	case x# of
-	  0#      -> !B!; ...B...
-	  default -> !C!; ...C...
- \end{verbatim}
-
-where \tr{!x!} indicates a possible heap-check point. The heap checks
-in the alternatives {\em can} be omitted, in which case the topmost
-heapcheck will take their worst case into account.
-
-In favour of omitting \tr{!B!}, \tr{!C!}:
-
- - {\em May} save a heap overflow test,
-	if ...A... allocates anything.  The other advantage
-	of this is that we can use relative addressing
-	from a single Hp to get at all the closures so allocated.
-
- - No need to save volatile vars etc across the case
-
-Against:
-
-  - May do more allocation than reqd.  This sometimes bites us
-	badly.  For example, nfib (ha!)  allocates about 30\% more space if the
-	worst-casing is done, because many many calls to nfib are leaf calls
-	which don't need to allocate anything.
-
-	This never hurts us if there is only one alternative.
-
-\begin{code}
-cgCase	:: StgExpr
-	-> StgLiveVars
-	-> StgLiveVars
-	-> Id
-	-> SRT
-	-> AltType
-	-> [StgAlt]
-	-> Code
-\end{code}
-
-Special case #1: case of literal.
-
-\begin{code}
-cgCase (StgLit lit) live_in_whole_case live_in_alts bndr srt 
-       alt_type@(PrimAlt tycon) alts
-  = do	{ tmp_reg <- bindNewToTemp bndr
-	; cm_lit <- cgLit lit
-	; stmtC (CmmAssign tmp_reg (CmmLit cm_lit))
-	; cgPrimAlts NoGC alt_type tmp_reg alts }
-\end{code}
-
-Special case #2: scrutinising a primitive-typed variable.	No
-evaluation required.  We don't save volatile variables, nor do we do a
-heap-check in the alternatives.	 Instead, the heap usage of the
-alternatives is worst-cased and passed upstream.  This can result in
-allocating more heap than strictly necessary, but it will sometimes
-eliminate a heap check altogether.
-
-\begin{code}
-cgCase (StgApp v []) live_in_whole_case live_in_alts bndr srt
-       alt_type@(PrimAlt tycon) alts
-  = do	{ -- Careful! we can't just bind the default binder to the same thing
-	  -- as the scrutinee, since it might be a stack location, and having
-	  -- two bindings pointing at the same stack locn doesn't work (it
-	  -- confuses nukeDeadBindings).  Hence, use a new temp.
-	  v_info <- getCgIdInfo v
-	; amode <- idInfoToAmode v_info
-	; tmp_reg <- bindNewToTemp bndr
-	; stmtC (CmmAssign tmp_reg amode)
-	; cgPrimAlts NoGC alt_type tmp_reg alts }
-\end{code}
-
-Special case #3: inline PrimOps and foreign calls.
-
-\begin{code}
-cgCase (StgOpApp op@(StgPrimOp primop) args _) 
-       live_in_whole_case live_in_alts bndr srt alt_type alts
-  | not (primOpOutOfLine primop)
-  = cgInlinePrimOp primop args bndr alt_type live_in_alts alts
-\end{code}
-
-TODO: Case-of-case of primop can probably be done inline too (but
-maybe better to translate it out beforehand).  See
-ghc/lib/misc/PackedString.lhs for examples where this crops up (with
-4.02).
-
-Special case #4: inline foreign calls: an unsafe foreign call can be done
-right here, just like an inline primop.
-
-\begin{code}
-cgCase (StgOpApp op@(StgFCallOp fcall _) args _) 
-       live_in_whole_case live_in_alts bndr srt alt_type alts
-  | unsafe_foreign_call
-  = ASSERT( isSingleton alts )
-    do	--  *must* be an unboxed tuple alt.
-	-- exactly like the cgInlinePrimOp case for unboxed tuple alts..
-	{ res_tmps <- mapFCs bindNewToTemp non_void_res_ids
-	; let res_hints = map (typeHint.idType) non_void_res_ids
-	; cgForeignCall (zip res_tmps res_hints) fcall args live_in_alts
-	; cgExpr rhs }
-  where
-   (_, res_ids, _, rhs) = head alts
-   non_void_res_ids = filter (nonVoidArg . idCgRep) res_ids
-
-   unsafe_foreign_call
-	 = case fcall of
-	 	CCall (CCallSpec _ _ s) -> not (playSafe s)
-		_other			-> False				
-\end{code}
-
-Special case: scrutinising a non-primitive variable.
-This can be done a little better than the general case, because
-we can reuse/trim the stack slot holding the variable (if it is in one).
-
-\begin{code}
-cgCase (StgApp fun args)
-	live_in_whole_case live_in_alts bndr srt alt_type alts
-  = do	{ fun_info <- getCgIdInfo fun
-	; arg_amodes <- getArgAmodes args
-
-	-- Nuking dead bindings *before* calculating the saves is the
-	-- value-add here.  We might end up freeing up some slots currently
-	-- occupied by variables only required for the call.
-	-- NOTE: we need to look up the variables used in the call before
-	-- doing this, because some of them may not be in the environment
-	-- afterward.
-	; nukeDeadBindings live_in_alts	
-	; (save_assts, alts_eob_info, maybe_cc_slot)
-		<- saveVolatileVarsAndRegs live_in_alts
-
-	; scrut_eob_info
-	    <- forkEval alts_eob_info 
-			(allocStackTop retAddrSizeW >> nopC)
-			(do { deAllocStackTop retAddrSizeW
-			    ; cgEvalAlts maybe_cc_slot bndr srt alt_type alts })
-
-	; setEndOfBlockInfo (maybeReserveSeqFrame alt_type scrut_eob_info)
-			    (performTailCall fun_info arg_amodes save_assts) }
-\end{code}
-
-Note about return addresses: we *always* push a return address, even
-if because of an optimisation we end up jumping direct to the return
-code (not through the address itself).  The alternatives always assume
-that the return address is on the stack.  The return address is
-required in case the alternative performs a heap check, since it
-encodes the liveness of the slots in the activation record.
-
-On entry to the case alternative, we can re-use the slot containing
-the return address immediately after the heap check.  That's what the
-deAllocStackTop call is doing above.
-
-Finally, here is the general case.
-
-\begin{code}
-cgCase expr live_in_whole_case live_in_alts bndr srt alt_type alts
-  = do	{	-- Figure out what volatile variables to save
-	  nukeDeadBindings live_in_whole_case
-    
-	; (save_assts, alts_eob_info, maybe_cc_slot)
-		<- saveVolatileVarsAndRegs live_in_alts
-
-	     -- Save those variables right now!
-	; emitStmts save_assts
-
-	    -- generate code for the alts
-	; scrut_eob_info
-	       <- forkEval alts_eob_info
-		      	   (do 	{ nukeDeadBindings live_in_alts
-				; allocStackTop retAddrSizeW   -- space for retn address 
-				; nopC })
-			   (do	{ deAllocStackTop retAddrSizeW
-				; cgEvalAlts maybe_cc_slot bndr srt alt_type alts })
-
-	; setEndOfBlockInfo (maybeReserveSeqFrame alt_type scrut_eob_info)
-			    (cgExpr expr)
-    }
-\end{code}
-
-There's a lot of machinery going on behind the scenes to manage the
-stack pointer here.  forkEval takes the virtual Sp and free list from
-the first argument, and turns that into the *real* Sp for the second
-argument.  It also uses this virtual Sp as the args-Sp in the EOB info
-returned, so that the scrutinee will trim the real Sp back to the
-right place before doing whatever it does.  
-  --SDM (who just spent an hour figuring this out, and didn't want to 
-	 forget it).
-
-Why don't we push the return address just before evaluating the
-scrutinee?  Because the slot reserved for the return address might
-contain something useful, so we wait until performing a tail call or
-return before pushing the return address (see
-CgTailCall.pushReturnAddress).  
-
-This also means that the environment doesn't need to know about the
-free stack slot for the return address (for generating bitmaps),
-because we don't reserve it until just before the eval.
-
-TODO!!  Problem: however, we have to save the current cost centre
-stack somewhere, because at the eval point the current CCS might be
-different.  So we pick a free stack slot and save CCCS in it.  One
-consequence of this is that activation records on the stack don't
-follow the layout of closures when we're profiling.  The CCS could be
-anywhere within the record).
-
-\begin{code}
-maybeReserveSeqFrame PolyAlt (EndOfBlockInfo args_sp (CaseAlts amode stuff bndr _))
-   = EndOfBlockInfo (args_sp + retAddrSizeW) (CaseAlts amode stuff bndr True)
-maybeReserveSeqFrame other scrut_eob_info = scrut_eob_info
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Inline primops
-%*									*
-%************************************************************************
-
-\begin{code}
-cgInlinePrimOp primop args bndr (PrimAlt tycon) live_in_alts alts
-  | isVoidArg (idCgRep bndr)
-  = ASSERT( con == DEFAULT && isSingleton alts && null bs )
-    do	{ 	-- VOID RESULT; just sequencing, 
-		-- so get in there and do it
-	  cgPrimOp [] primop args live_in_alts
-	; cgExpr rhs }
-  where
-    (con,bs,_,rhs) = head alts
-
-cgInlinePrimOp primop args bndr (PrimAlt tycon) live_in_alts alts
-  = do	{ 	-- PRIMITIVE ALTS, with non-void result
-	  tmp_reg <- bindNewToTemp bndr
-	; cgPrimOp [tmp_reg] primop args live_in_alts
-	; cgPrimAlts NoGC (PrimAlt tycon) tmp_reg alts }
-
-cgInlinePrimOp primop args bndr (UbxTupAlt tycon) live_in_alts alts
-  = ASSERT( isSingleton alts )
-    do	{  	-- UNBOXED TUPLE ALTS
-	 	-- No heap check, no yield, just get in there and do it.
-		-- NB: the case binder isn't bound to anything; 
-		--     it has a unboxed tuple type
-	  
-	  res_tmps <- mapFCs bindNewToTemp non_void_res_ids
-	; cgPrimOp res_tmps primop args live_in_alts
-	; cgExpr rhs }
-  where
-   (_, res_ids, _, rhs) = head alts
-   non_void_res_ids = filter (nonVoidArg . idCgRep) res_ids
-
-cgInlinePrimOp primop args bndr (AlgAlt tycon) live_in_alts alts
-  = do 	{ 	-- ENUMERATION TYPE RETURN
-		-- Typical: case a ># b of { True -> ..; False -> .. }
-		-- The primop itself returns an index into the table of
-		-- closures for the enumeration type.
-	   tag_amode <- ASSERT( isEnumerationTyCon tycon )
-			do_enum_primop primop
-
-	 	-- Bind the default binder if necessary
-		-- (avoiding it avoids the assignment)
-		-- The deadness info is set by StgVarInfo
-	; hmods <- getHomeModules
-	; whenC (not (isDeadBinder bndr))
-		(do { tmp_reg <- bindNewToTemp bndr
-		    ; stmtC (CmmAssign tmp_reg (tagToClosure hmods tycon tag_amode)) })
-
-		-- Compile the alts
-	; (branches, mb_deflt) <- cgAlgAlts NoGC Nothing{-cc_slot-}
-				   	    (AlgAlt tycon) alts
-
-		-- Do the switch
-	; emitSwitch tag_amode branches mb_deflt 0 (tyConFamilySize tycon - 1)
-	}
-  where
-
-    do_enum_primop :: PrimOp -> FCode CmmExpr	-- Returns amode for result
-    do_enum_primop TagToEnumOp	-- No code!
-       | [arg] <- args = do
-         (_,e) <- getArgAmode arg
-	 return e
-    do_enum_primop primop
-      = do tmp <- newTemp wordRep
-	   cgPrimOp [tmp] primop args live_in_alts
-    	   returnFC (CmmReg tmp)
-
-cgInlinePrimOp primop arg_amodes bndr PolyAlt live_in_alts alts
-  = pprPanic "cgCase: case of primop has polymorphic type" (ppr bndr)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[CgCase-alts]{Alternatives}
-%*									*
-%************************************************************************
-
-@cgEvalAlts@ returns an addressing mode for a continuation for the
-alternatives of a @case@, used in a context when there
-is some evaluation to be done.
-
-\begin{code}
-cgEvalAlts :: Maybe VirtualSpOffset	-- Offset of cost-centre to be restored, if any
-	   -> Id
-	   -> SRT			-- SRT for the continuation
-	   -> AltType
-	   -> [StgAlt]
-	   -> FCode Sequel	-- Any addr modes inside are guaranteed
-				-- to be a label so that we can duplicate it 
-				-- without risk of duplicating code
-
-cgEvalAlts cc_slot bndr srt alt_type@(PrimAlt tycon) alts
-  = do	{ let   rep = tyConCgRep tycon
-		reg = dataReturnConvPrim rep	-- Bottom for voidRep
-
-	; abs_c <- forkProc $ do
-		{ 	-- Bind the case binder, except if it's void
-			-- (reg is bottom in that case)
-		  whenC (nonVoidArg rep) $
-		  bindNewToReg bndr reg (mkLFArgument bndr)
-		; restoreCurrentCostCentre cc_slot True
-		; cgPrimAlts GCMayHappen alt_type reg alts }
-
-	; lbl <- emitDirectReturnTarget (idName bndr) abs_c srt
-	; returnFC (CaseAlts lbl Nothing bndr False) }
-
-cgEvalAlts cc_slot bndr srt (UbxTupAlt _) [(con,args,_,rhs)]
-  =	-- Unboxed tuple case
-	-- By now, the simplifier should have have turned it
-	-- into 	case e of (# a,b #) -> e
-	-- There shouldn't be a 
-	--		case e of DEFAULT -> e
-    ASSERT2( case con of { DataAlt _ -> True; other -> False },
-	     text "cgEvalAlts: dodgy case of unboxed tuple type" )
-    do	{ 	-- forkAbsC for the RHS, so that the envt is
-		-- not changed for the emitDirectReturn call
-	  abs_c <- forkProc $ do 
-		{ (live_regs, ptrs, nptrs, _) <- bindUnboxedTupleComponents args
-			-- Restore the CC *after* binding the tuple components, 
-			-- so that we get the stack offset of the saved CC right.
-		; restoreCurrentCostCentre cc_slot True
-			-- Generate a heap check if necessary
-			-- and finally the code for the alternative
-		; unbxTupleHeapCheck live_regs ptrs nptrs noStmts
-				     (cgExpr rhs) }
-	; lbl <- emitDirectReturnTarget (idName bndr) abs_c srt
-	; returnFC (CaseAlts lbl Nothing bndr False) }
-
-cgEvalAlts cc_slot bndr srt alt_type alts
-  = 	-- Algebraic and polymorphic case
-    do	{	-- Bind the default binder
-	  bindNewToReg bndr nodeReg (mkLFArgument bndr)
-
-	-- Generate sequel info for use downstream
-	-- At the moment, we only do it if the type is vector-returnable.
-	-- Reason: if not, then it costs extra to label the
-	-- alternatives, because we'd get return code like:
-	--
-	--	switch TagReg { 0 : JMP(alt_1); 1 : JMP(alt_2) ..etc }
-	--
-	-- which is worse than having the alt code in the switch statement
-
-	; (alts, mb_deflt) <- cgAlgAlts GCMayHappen cc_slot alt_type alts
-
-	; (lbl, branches) <- emitAlgReturnTarget (idName bndr) 
-				alts mb_deflt srt ret_conv
-
-	; returnFC (CaseAlts lbl branches bndr False) }
-  where
-    ret_conv = case alt_type of
-    		AlgAlt tc -> ctrlReturnConvAlg tc
-    		PolyAlt   -> UnvectoredReturn 0
-\end{code}
-
-
-HWL comment on {\em GrAnSim\/}  (adding GRAN_YIELDs for context switch): If
-we  do  an inlining of the  case  no separate  functions  for returning are
-created, so we don't have to generate a GRAN_YIELD in that case.  This info
-must be  propagated  to cgAlgAltRhs (where the  GRAN_YIELD  macro might  be
-emitted). Hence, the new Bool arg to cgAlgAltRhs.
-
-%************************************************************************
-%*									*
-\subsection[CgCase-alg-alts]{Algebraic alternatives}
-%*									*
-%************************************************************************
-
-In @cgAlgAlts@, none of the binders in the alternatives are
-assumed to be yet bound.
-
-HWL comment on {\em GrAnSim\/} (adding GRAN_YIELDs for context switch): The
-last   arg of  cgAlgAlts  indicates  if we  want  a context   switch at the
-beginning of  each alternative. Normally we  want that. The  only exception
-are inlined alternatives.
-
-\begin{code}
-cgAlgAlts :: GCFlag
-       -> Maybe VirtualSpOffset
-       -> AltType				--  ** AlgAlt or PolyAlt only **
-       -> [StgAlt]				-- The alternatives
-       -> FCode ( [(ConTagZ, CgStmts)], -- The branches
-		  Maybe CgStmts )	-- The default case
-
-cgAlgAlts gc_flag cc_slot alt_type alts
-  = do alts <- forkAlts [ cgAlgAlt gc_flag cc_slot alt_type alt | alt <- alts]
-       let
-	    mb_deflt = case alts of -- DEFAULT is always first, if present
-			 ((DEFAULT,blks) : _) -> Just blks
-			 other		      -> Nothing
-
-	    branches = [(dataConTagZ con, blks) 
-	   	       | (DataAlt con, blks) <- alts]
-       -- in
-       return (branches, mb_deflt)
-
-
-cgAlgAlt :: GCFlag
-      	 -> Maybe VirtualSpOffset	-- Turgid state
-      	 -> AltType			--  ** AlgAlt or PolyAlt only **
-      	 -> StgAlt
-      	 -> FCode (AltCon, CgStmts)
-
-cgAlgAlt gc_flag cc_slot alt_type (con, args, use_mask, rhs)
-  = do	{ abs_c <- getCgStmts $ do
-		{ bind_con_args con args
-		; restoreCurrentCostCentre cc_slot True
-		; maybeAltHeapCheck gc_flag alt_type (cgExpr rhs) }
-	; return (con, abs_c) }
-  where
-    bind_con_args DEFAULT      args = nopC
-    bind_con_args (DataAlt dc) args = bindConArgs dc args
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[CgCase-prim-alts]{Primitive alternatives}
-%*									*
-%************************************************************************
-
-@cgPrimAlts@ generates suitable a @CSwitch@
-for dealing with the alternatives of a primitive @case@, given an
-addressing mode for the thing to scrutinise.  It also keeps track of
-the maximum stack depth encountered down any branch.
-
-As usual, no binders in the alternatives are yet bound.
-
-\begin{code}
-cgPrimAlts :: GCFlag
-	   -> AltType	-- Always PrimAlt, but passed to maybeAltHeapCheck
-	   -> CmmReg	-- Scrutinee
-	   -> [StgAlt]	-- Alternatives
-	   -> Code
--- NB: cgPrimAlts emits code that does the case analysis.
--- It's often used in inline situations, rather than to genearte
--- a labelled return point.  That's why its interface is a little
--- different to cgAlgAlts
---
--- INVARIANT: the default binder is already bound
-cgPrimAlts gc_flag alt_type scrutinee alts
-  = do	{ tagged_absCs <- forkAlts (map (cgPrimAlt gc_flag alt_type) alts)
-	; let ((DEFAULT, deflt_absC) : others) = tagged_absCs	-- There is always a default
-	      alt_absCs = [(lit,rhs) | (LitAlt lit, rhs) <- others]
- 	; emitLitSwitch (CmmReg scrutinee) alt_absCs deflt_absC }
-
-cgPrimAlt :: GCFlag
-	  -> AltType
-	  -> StgAlt				-- The alternative
-	  -> FCode (AltCon, CgStmts)	-- Its compiled form
-
-cgPrimAlt gc_flag alt_type (con, [], [], rhs)
-  = ASSERT( case con of { DEFAULT -> True; LitAlt _ -> True; other -> False } )
-    do	{ abs_c <- getCgStmts (maybeAltHeapCheck gc_flag alt_type (cgExpr rhs)) 
-	; returnFC (con, abs_c) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[CgCase-tidy]{Code for tidying up prior to an eval}
-%*									*
-%************************************************************************
-
-\begin{code}
-maybeAltHeapCheck 
-	:: GCFlag 
-	-> AltType	-- PolyAlt, PrimAlt, AlgAlt, but *not* UbxTupAlt
-	-> Code		-- Continuation
-	-> Code
-maybeAltHeapCheck NoGC	      _        code = code
-maybeAltHeapCheck GCMayHappen alt_type code = altHeapCheck alt_type code
-
-saveVolatileVarsAndRegs
-    :: StgLiveVars                    -- Vars which should be made safe
-    -> FCode (CmmStmts,  	      -- Assignments to do the saves
-	      EndOfBlockInfo,	      -- sequel for the alts
-              Maybe VirtualSpOffset)  -- Slot for current cost centre
-
-saveVolatileVarsAndRegs vars
-  = do	{ var_saves <- saveVolatileVars vars
-	; (maybe_cc_slot, cc_save) <- saveCurrentCostCentre
-	; eob_info <- getEndOfBlockInfo
-	; returnFC (var_saves `plusStmts` cc_save,
-		    eob_info,
-		    maybe_cc_slot) }
-
-
-saveVolatileVars :: StgLiveVars		-- Vars which should be made safe
-		 -> FCode CmmStmts	-- Assignments to to the saves
-
-saveVolatileVars vars
-  = do	{ stmts_s <- mapFCs save_it (varSetElems vars)
-	; return (foldr plusStmts noStmts stmts_s) }
-  where
-    save_it var
-      = do { v <- getCAddrModeIfVolatile var
-	   ; case v of
-		Nothing	        -> return noStmts 	   -- Non-volatile
-		Just vol_amode  -> save_var var vol_amode  -- Aha! It's volatile
-	}
-
-    save_var var vol_amode
-      = do { slot <- allocPrimStack (idCgRep var)
-	   ; rebindToStack var slot
-	   ; sp_rel <- getSpRelOffset slot
-	   ; returnFC (oneStmt (CmmStore sp_rel vol_amode)) }
-\end{code}
-
----------------------------------------------------------------------------
-
-When we save the current cost centre (which is done for lexical
-scoping), we allocate a free stack location, and return (a)~the
-virtual offset of the location, to pass on to the alternatives, and
-(b)~the assignment to do the save (just as for @saveVolatileVars@).
-
-\begin{code}
-saveCurrentCostCentre ::
-	FCode (Maybe VirtualSpOffset,	-- Where we decide to store it
-	       CmmStmts)		-- Assignment to save it
-
-saveCurrentCostCentre
-  | not opt_SccProfilingOn 
-  = returnFC (Nothing, noStmts)
-  | otherwise
-  = do	{ slot <- allocPrimStack PtrArg
-	; sp_rel <- getSpRelOffset slot
-	; returnFC (Just slot,
-		    oneStmt (CmmStore sp_rel curCCS)) }
-
--- Sometimes we don't free the slot containing the cost centre after restoring it
--- (see CgLetNoEscape.cgLetNoEscapeBody).
-restoreCurrentCostCentre :: Maybe VirtualSpOffset -> Bool -> Code
-restoreCurrentCostCentre Nothing     _freeit = nopC
-restoreCurrentCostCentre (Just slot) freeit
- = do 	{ sp_rel <- getSpRelOffset slot
-	; whenC freeit (freeStackSlots [slot])
-	; stmtC (CmmStore curCCSAddr (CmmLoad sp_rel wordRep)) }
-\end{code}
-
diff --git a/ghc/compiler/codeGen/CgClosure.lhs b/ghc/compiler/codeGen/CgClosure.lhs
deleted file mode 100644
index 1a2cbc5202..0000000000
--- a/ghc/compiler/codeGen/CgClosure.lhs
+++ /dev/null
@@ -1,599 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-% $Id: CgClosure.lhs,v 1.72 2005/05/18 12:06:51 simonmar Exp $
-%
-\section[CgClosure]{Code generation for closures}
-
-This module provides the support code for @StgToAbstractC@ to deal
-with {\em closures} on the RHSs of let(rec)s.  See also
-@CgCon@, which deals with constructors.
-
-\begin{code}
-module CgClosure ( cgTopRhsClosure, 
-		   cgStdRhsClosure, 
-		   cgRhsClosure,
-		   emitBlackHoleCode,
-		   ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} CgExpr ( cgExpr )
-
-import CgMonad
-import CgBindery
-import CgHeapery
-import CgStackery	( mkVirtStkOffsets, pushUpdateFrame, getVirtSp,
-			  setRealAndVirtualSp )
-import CgProf		( chooseDynCostCentres, ldvEnter, enterCostCentre,
-			  costCentreFrom )
-import CgTicky
-import CgParallel	( granYield, granFetchAndReschedule )
-import CgInfoTbls	( emitClosureCodeAndInfoTable, getSRTInfo )
-import CgCallConv	( assignCallRegs, mkArgDescr )
-import CgUtils		( emitDataLits, addIdReps, cmmRegOffW, 
-			  emitRtsCallWithVols )
-import ClosureInfo	-- lots and lots of stuff
-import SMRep		( CgRep, cgRepSizeW, argMachRep, fixedHdrSize, WordOff,
-			  idCgRep )
-import MachOp		( MachHint(..) )
-import Cmm
-import CmmUtils		( CmmStmts, mkStmts, oneStmt, plusStmts, noStmts,
-			  mkLblExpr )
-import CLabel
-import StgSyn
-import StaticFlags	( opt_DoTickyProfiling )
-import CostCentre	
-import Id		( Id, idName, idType )
-import Name		( Name, isExternalName )
-import Module		( Module, pprModule )
-import ListSetOps	( minusList )
-import Util		( isIn, mapAccumL, zipWithEqual )
-import BasicTypes	( TopLevelFlag(..) )
-import Constants	( oFFSET_StgInd_indirectee, wORD_SIZE )
-import Outputable
-import FastString
-\end{code}
-
-%********************************************************
-%*							*
-\subsection[closures-no-free-vars]{Top-level closures}
-%*							*
-%********************************************************
-
-For closures bound at top level, allocate in static space.
-They should have no free variables.
-
-\begin{code}
-cgTopRhsClosure :: Id
-		-> CostCentreStack	-- Optional cost centre annotation
-		-> StgBinderInfo
-		-> SRT
-		-> UpdateFlag
-		-> [Id]		-- Args
-		-> StgExpr
-		-> FCode (Id, CgIdInfo)
-
-cgTopRhsClosure id ccs binder_info srt upd_flag args body = do
-  {	-- LAY OUT THE OBJECT
-    let name = idName id
-  ; lf_info  <- mkClosureLFInfo id TopLevel [] upd_flag args
-  ; srt_info <- getSRTInfo name srt
-  ; mod_name <- moduleName
-  ; let descr         = closureDescription mod_name name
-	closure_info  = mkClosureInfo True id lf_info 0 0 srt_info descr
-	closure_label = mkLocalClosureLabel name
-    	cg_id_info    = stableIdInfo id (mkLblExpr closure_label) lf_info
-	closure_rep   = mkStaticClosureFields closure_info ccs True []
-
-  	 -- BUILD THE OBJECT, AND GENERATE INFO TABLE (IF NECESSARY)
-  ; emitDataLits closure_label closure_rep
-  ; forkClosureBody (closureCodeBody binder_info closure_info
-				     ccs args body)
-
-  ; returnFC (id, cg_id_info) }
-\end{code}
-
-%********************************************************
-%*							*
-\subsection[non-top-level-closures]{Non top-level closures}
-%*							*
-%********************************************************
-
-For closures with free vars, allocate in heap.
-
-\begin{code}
-cgStdRhsClosure
-	:: Id
-	-> CostCentreStack	-- Optional cost centre annotation
-	-> StgBinderInfo
-	-> [Id]			-- Free vars
-	-> [Id]			-- Args
-	-> StgExpr
-	-> LambdaFormInfo
-	-> [StgArg]		-- payload
-	-> FCode (Id, CgIdInfo)
-
-cgStdRhsClosure bndr cc bndr_info fvs args body lf_info payload 
-  = do	-- AHA!  A STANDARD-FORM THUNK
-  {	-- LAY OUT THE OBJECT
-    amodes <- getArgAmodes payload
-  ; mod_name <- moduleName
-  ; let (tot_wds, ptr_wds, amodes_w_offsets) 
-	    = mkVirtHeapOffsets (isLFThunk lf_info) amodes
-
-	descr	     = closureDescription mod_name (idName bndr)
-	closure_info = mkClosureInfo False 	-- Not static
-				     bndr lf_info tot_wds ptr_wds 
-				     NoC_SRT	-- No SRT for a std-form closure
-				     descr
-		
-  ; (use_cc, blame_cc) <- chooseDynCostCentres cc args body
-
-	-- BUILD THE OBJECT
-  ; heap_offset <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
-
-	-- RETURN
-  ; returnFC (bndr, heapIdInfo bndr heap_offset lf_info) }
-\end{code}
-
-Here's the general case.
-
-\begin{code}
-cgRhsClosure	:: Id
-		-> CostCentreStack	-- Optional cost centre annotation
-		-> StgBinderInfo
-		-> SRT
-		-> [Id]			-- Free vars
-		-> UpdateFlag
-		-> [Id]			-- Args
-		-> StgExpr
-		-> FCode (Id, CgIdInfo)
-
-cgRhsClosure bndr cc bndr_info srt fvs upd_flag args body = do
-  { 	-- LAY OUT THE OBJECT
-	-- If the binder is itself a free variable, then don't store
-	-- it in the closure.  Instead, just bind it to Node on entry.
-	-- NB we can be sure that Node will point to it, because we
-	-- havn't told mkClosureLFInfo about this; so if the binder
-	-- _was_ a free var of its RHS, mkClosureLFInfo thinks it *is*
-	-- stored in the closure itself, so it will make sure that
-	-- Node points to it...
-    let
-	name 	     = idName bndr
-	is_elem	     = isIn "cgRhsClosure"
-	bndr_is_a_fv = bndr `is_elem` fvs
-	reduced_fvs | bndr_is_a_fv = fvs `minusList` [bndr]
-		    | otherwise	   = fvs
-
-  ; lf_info <- mkClosureLFInfo bndr NotTopLevel fvs upd_flag args
-  ; fv_infos <- mapFCs getCgIdInfo reduced_fvs
-  ; srt_info <- getSRTInfo name srt
-  ; mod_name <- moduleName
-  ; let	bind_details :: [(CgIdInfo, VirtualHpOffset)]
-	(tot_wds, ptr_wds, bind_details) 
-	   = mkVirtHeapOffsets (isLFThunk lf_info) (map add_rep fv_infos)
-
-	add_rep info = (cgIdInfoArgRep info, info)
-
-	descr	     = closureDescription mod_name name
-	closure_info = mkClosureInfo False	-- Not static
-				     bndr lf_info tot_wds ptr_wds
-				     srt_info descr
-
-	-- BUILD ITS INFO TABLE AND CODE
-  ; forkClosureBody (do
-	{	-- Bind the fvs
-	  let bind_fv (info, offset) 
-		= bindNewToNode (cgIdInfoId info) offset (cgIdInfoLF info)
-	; mapCs bind_fv bind_details
-
-	  	-- Bind the binder itself, if it is a free var
-	; whenC bndr_is_a_fv (bindNewToReg bndr nodeReg lf_info)
-	
-		-- Compile the body
-	; closureCodeBody bndr_info closure_info cc args body })
-
-	-- BUILD THE OBJECT
-  ; let
-	to_amode (info, offset) = do { amode <- idInfoToAmode info
-				     ; return (amode, offset) }
-  ; (use_cc, blame_cc) <- chooseDynCostCentres cc args body
-  ; amodes_w_offsets <- mapFCs to_amode bind_details
-  ; heap_offset <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
-
-	-- RETURN
-  ; returnFC (bndr, heapIdInfo bndr heap_offset lf_info) }
-
-
-mkClosureLFInfo :: Id		-- The binder
-		-> TopLevelFlag	-- True of top level
-		-> [Id]		-- Free vars
-		-> UpdateFlag 	-- Update flag
-		-> [Id] 	-- Args
-		-> FCode LambdaFormInfo
-mkClosureLFInfo bndr top fvs upd_flag args
-  | null args = return (mkLFThunk (idType bndr) top fvs upd_flag)
-  | otherwise = do { arg_descr <- mkArgDescr (idName bndr) args
-		   ; return (mkLFReEntrant top fvs args arg_descr) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[code-for-closures]{The code for closures}
-%*									*
-%************************************************************************
-
-\begin{code}
-closureCodeBody :: StgBinderInfo
-		-> ClosureInfo	   -- Lots of information about this closure
-		-> CostCentreStack -- Optional cost centre attached to closure
-		-> [Id]
-		-> StgExpr
-		-> Code
-\end{code}
-
-There are two main cases for the code for closures.  If there are {\em
-no arguments}, then the closure is a thunk, and not in normal form.
-So it should set up an update frame (if it is shared).
-NB: Thunks cannot have a primitive type!
-
-\begin{code}
-closureCodeBody binder_info cl_info cc [{- No args i.e. thunk -}] body = do
-  { body_absC <- getCgStmts $ do
-	{ tickyEnterThunk cl_info
-	; ldvEnter (CmmReg nodeReg)  -- NB: Node always points when profiling
-	; thunkWrapper cl_info $ do
-		-- We only enter cc after setting up update so
-		-- that cc of enclosing scope will be recorded
-		-- in update frame CAF/DICT functions will be
-		-- subsumed by this enclosing cc
-	    { enterCostCentre cl_info cc body
-	    ; cgExpr body }
-	}
-    
-  ; emitClosureCodeAndInfoTable cl_info [] body_absC }
-\end{code}
-
-If there is /at least one argument/, then this closure is in
-normal form, so there is no need to set up an update frame.
-
-The Macros for GrAnSim are produced at the beginning of the
-argSatisfactionCheck (by calling fetchAndReschedule).  There info if
-Node points to closure is available. -- HWL
-
-\begin{code}
-closureCodeBody binder_info cl_info cc args body 
-  = ASSERT( length args > 0 )
-  do { 	-- Get the current virtual Sp (it might not be zero, 
-	-- eg. if we're compiling a let-no-escape).
-    vSp <- getVirtSp
-  ; let (reg_args, other_args) = assignCallRegs (addIdReps args)
-	(sp_top, stk_args)     = mkVirtStkOffsets vSp other_args
-
-	-- Allocate the global ticky counter
-  ; let ticky_ctr_lbl = mkRednCountsLabel (closureName cl_info)
-  ; emitTickyCounter cl_info args sp_top
-
-   	-- ...and establish the ticky-counter 
-	-- label for this block
-  ; setTickyCtrLabel ticky_ctr_lbl $ do
-
-    	-- Emit the slow-entry code
-  { reg_save_code <- mkSlowEntryCode cl_info reg_args
-
-	-- Emit the main entry code
-  ; blks <- forkProc $
-	    mkFunEntryCode cl_info cc reg_args stk_args
-			   sp_top reg_save_code body
-  ; emitClosureCodeAndInfoTable cl_info [] blks
-  }}
-
-
-
-mkFunEntryCode :: ClosureInfo
-	       -> CostCentreStack
-	       -> [(Id,GlobalReg)] 	  -- Args in regs
-	       -> [(Id,VirtualSpOffset)]  -- Args on stack
-	       -> VirtualSpOffset	  -- Last allocated word on stack
-	       -> CmmStmts 		  -- Register-save code in case of GC
-	       -> StgExpr
-	       -> Code
--- The main entry code for the closure
-mkFunEntryCode cl_info cc reg_args stk_args sp_top reg_save_code body = do
-  { 	-- Bind args to regs/stack as appropriate,
-	-- and record expected position of sps
-  ; bindArgsToRegs  reg_args
-  ; bindArgsToStack stk_args
-  ; setRealAndVirtualSp sp_top
-
-	-- Enter the cost-centre, if required
-	-- ToDo: It's not clear why this is outside the funWrapper,
-	--	 but the tickyEnterFun is inside. Perhaps we can put
-	--	 them together?
-  ; enterCostCentre cl_info cc body
-
-	-- Do the business
-  ; funWrapper cl_info reg_args reg_save_code $ do
-	{ tickyEnterFun cl_info
-	; cgExpr body }
-  }
-\end{code}
-
-The "slow entry" code for a function.  This entry point takes its
-arguments on the stack.  It loads the arguments into registers
-according to the calling convention, and jumps to the function's
-normal entry point.  The function's closure is assumed to be in
-R1/node.
-
-The slow entry point is used in two places:
-
- (a) unknown calls: eg. stg_PAP_entry 
- (b) returning from a heap-check failure
-
-\begin{code}
-mkSlowEntryCode :: ClosureInfo -> [(Id,GlobalReg)] -> FCode CmmStmts
--- If this function doesn't have a specialised ArgDescr, we need
--- to generate the function's arg bitmap, slow-entry code, and
--- register-save code for the heap-check failure
--- Here, we emit the slow-entry code, and 
--- return the register-save assignments
-mkSlowEntryCode cl_info reg_args
-  | Just (_, ArgGen _) <- closureFunInfo cl_info
-  = do 	{ emitSimpleProc slow_lbl (emitStmts load_stmts)
-	; return save_stmts }
-  | otherwise = return noStmts
-  where
-     name = closureName cl_info
-     slow_lbl = mkSlowEntryLabel name
-
-     load_stmts = mkStmts load_assts `plusStmts` mkStmts [stk_adj_pop, jump_to_entry]
-     save_stmts = oneStmt stk_adj_push `plusStmts`  mkStmts save_assts
-
-     reps_w_regs :: [(CgRep,GlobalReg)]
-     reps_w_regs = [(idCgRep id, reg) | (id,reg) <- reverse reg_args]
-     (final_stk_offset, stk_offsets)
-	= mapAccumL (\off (rep,_) -> (off + cgRepSizeW rep, off))
-		    0 reps_w_regs
-
-     load_assts = zipWithEqual "mk_load" mk_load reps_w_regs stk_offsets
-     mk_load (rep,reg) offset = CmmAssign (CmmGlobal reg) 
-					  (CmmLoad (cmmRegOffW spReg offset)
-						   (argMachRep rep))
-
-     save_assts = zipWithEqual "mk_save" mk_save reps_w_regs stk_offsets
-     mk_save (rep,reg) offset = ASSERT( argMachRep rep == globalRegRep reg )
-				CmmStore (cmmRegOffW spReg offset) 
-					 (CmmReg (CmmGlobal reg))
-
-     stk_adj_pop   = CmmAssign spReg (cmmRegOffW spReg final_stk_offset)
-     stk_adj_push  = CmmAssign spReg (cmmRegOffW spReg (- final_stk_offset))
-     jump_to_entry = CmmJump (mkLblExpr (enterLocalIdLabel name)) []
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection[closure-code-wrappers]{Wrappers around closure code}
-%*									*
-%************************************************************************
-
-\begin{code}
-thunkWrapper:: ClosureInfo -> Code -> Code
-thunkWrapper closure_info thunk_code = do
-  { let node_points = nodeMustPointToIt (closureLFInfo closure_info)
-
-    -- HWL: insert macros for GrAnSim; 2 versions depending on liveness of node
-    -- (we prefer fetchAndReschedule-style context switches to yield ones)
-  ; if node_points 
-    then granFetchAndReschedule [] node_points 
-    else granYield 		[] node_points
-
-        -- Stack and/or heap checks
-  ; thunkEntryChecks closure_info $ do
-      	{	-- Overwrite with black hole if necessary
-	  whenC (blackHoleOnEntry closure_info && node_points)
- 	        (blackHoleIt closure_info)
-	; setupUpdate closure_info thunk_code }
-		-- setupUpdate *encloses* the thunk_code
-  }
-
-funWrapper :: ClosureInfo 	-- Closure whose code body this is
-	   -> [(Id,GlobalReg)] 	-- List of argument registers (if any)
-	   -> CmmStmts		-- reg saves for the heap check failure
-	   -> Code		-- Body of function being compiled
-	   -> Code
-funWrapper closure_info arg_regs reg_save_code fun_body = do
-  { let node_points = nodeMustPointToIt (closureLFInfo closure_info)
-
-   	-- Enter for Ldv profiling
-  ; whenC node_points (ldvEnter (CmmReg nodeReg))
-
-	-- GranSim yeild poin
-  ; granYield arg_regs node_points
-
-        -- Heap and/or stack checks wrap the function body
-  ; funEntryChecks closure_info reg_save_code 
-		   fun_body
-  }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsubsection[update-and-BHs]{Update and black-hole wrappers}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-blackHoleIt :: ClosureInfo -> Code
--- Only called for closures with no args
--- Node points to the closure
-blackHoleIt closure_info = emitBlackHoleCode (closureSingleEntry closure_info)
-
-emitBlackHoleCode :: Bool -> Code
-emitBlackHoleCode is_single_entry 
-  | eager_blackholing = do 
-	tickyBlackHole (not is_single_entry)
-	stmtC (CmmStore (CmmReg nodeReg) (CmmLit (CmmLabel bh_lbl)))
-  | otherwise = 
-	nopC
-  where
-    bh_lbl | is_single_entry = mkRtsDataLabel SLIT("stg_SE_BLACKHOLE_info")
-	   | otherwise	     = mkRtsDataLabel SLIT("stg_BLACKHOLE_info")
-
-	-- If we wanted to do eager blackholing with slop filling,
-	-- we'd need to do it at the *end* of a basic block, otherwise
-	-- we overwrite the free variables in the thunk that we still
-	-- need.  We have a patch for this from Andy Cheadle, but not
-	-- incorporated yet. --SDM [6/2004]
-	--
-	-- Profiling needs slop filling (to support LDV profiling), so
-	-- currently eager blackholing doesn't work with profiling.
-	--
-	-- TICKY_TICKY needs EAGER_BLACKHOLING to verify no double-entries of
-	-- single-entry thunks.
-    eager_blackholing 
-	| opt_DoTickyProfiling = True
-	| otherwise            = False
-
-\end{code}
-
-\begin{code}
-setupUpdate :: ClosureInfo -> Code -> Code	-- Only called for closures with no args
-	-- Nota Bene: this function does not change Node (even if it's a CAF),
-	-- so that the cost centre in the original closure can still be
-	-- extracted by a subsequent enterCostCentre
-setupUpdate closure_info code
-  | closureReEntrant closure_info
-  = code
-
-  | not (isStaticClosure closure_info)
-  = if closureUpdReqd closure_info
-    then do { tickyPushUpdateFrame;  pushUpdateFrame (CmmReg nodeReg) code }
-    else do { tickyUpdateFrameOmitted; code }
- 
-  | otherwise	-- A static closure
-  = do 	{ tickyUpdateBhCaf closure_info
-
-	; if closureUpdReqd closure_info
-	  then do	-- Blackhole the (updatable) CAF:
-		{ upd_closure <- link_caf closure_info True
-	 	; pushUpdateFrame upd_closure code }
-	  else do
-		{ 	-- No update reqd, you'd think we don't need to 
-			-- black-hole it. But when ticky-ticky is on, we 
-			-- black-hole it regardless, to catch errors in which
-			-- an allegedly single-entry closure is entered twice
-			--
-			-- We discard the pointer returned by link_caf, because
-			-- we don't push an update frame
-		  whenC opt_DoTickyProfiling -- Blackhole even a SE CAF
-			(link_caf closure_info False >> nopC)
-		; tickyUpdateFrameOmitted
-		; code }
-    }
-
-
------------------------------------------------------------------------------
--- Entering a CAF
---
--- When a CAF is first entered, it creates a black hole in the heap,
--- and updates itself with an indirection to this new black hole.
---
--- We update the CAF with an indirection to a newly-allocated black
--- hole in the heap.  We also set the blocking queue on the newly
--- allocated black hole to be empty.
---
--- Why do we make a black hole in the heap when we enter a CAF?
---    
---     - for a  generational garbage collector, which needs a fast
---       test for whether an updatee is in an old generation or not
---
---     - for the parallel system, which can implement updates more
---       easily if the updatee is always in the heap. (allegedly).
---
--- When debugging, we maintain a separate CAF list so we can tell when
--- a CAF has been garbage collected.
-
--- newCAF must be called before the itbl ptr is overwritten, since
--- newCAF records the old itbl ptr in order to do CAF reverting
--- (which Hugs needs to do in order that combined mode works right.)
---
-
--- ToDo [Feb 04]  This entire link_caf nonsense could all be moved
--- into the "newCAF" RTS procedure, which we call anyway, including
--- the allocation of the black-hole indirection closure.
--- That way, code size would fall, the CAF-handling code would 
--- be closer together, and the compiler wouldn't need to know
--- about off_indirectee etc.
-
-link_caf :: ClosureInfo
-	 -> Bool		-- True <=> updatable, False <=> single-entry
-         -> FCode CmmExpr       -- Returns amode for closure to be updated
--- To update a CAF we must allocate a black hole, link the CAF onto the
--- CAF list, then update the CAF to point to the fresh black hole.
--- This function returns the address of the black hole, so it can be
--- updated with the new value when available.  The reason for all of this
--- is that we only want to update dynamic heap objects, not static ones,
--- so that generational GC is easier.
-link_caf cl_info is_upd = do
-  { 	-- Alloc black hole specifying CC_HDR(Node) as the cost centre
-  ; let	use_cc   = costCentreFrom (CmmReg nodeReg)
-        blame_cc = use_cc
-  ; hp_offset <- allocDynClosure bh_cl_info use_cc blame_cc []
-  ; hp_rel    <- getHpRelOffset hp_offset
-
-	-- Call the RTS function newCAF to add the CAF to the CafList
-	-- so that the garbage collector can find them
-	-- This must be done *before* the info table pointer is overwritten, 
-	-- because the old info table ptr is needed for reversion
-  ; emitRtsCallWithVols SLIT("newCAF") [(CmmReg nodeReg,PtrHint)] [node]
-	-- node is live, so save it.
-
-	-- Overwrite the closure with a (static) indirection 
-	-- to the newly-allocated black hole
-  ; stmtsC [ CmmStore (cmmRegOffW nodeReg off_indirectee) hp_rel
-	   , CmmStore (CmmReg nodeReg) ind_static_info ]
-
-  ; returnFC hp_rel }
-  where
-    bh_cl_info :: ClosureInfo
-    bh_cl_info | is_upd    = cafBlackHoleClosureInfo   cl_info
-	       | otherwise = seCafBlackHoleClosureInfo cl_info
-
-    ind_static_info :: CmmExpr
-    ind_static_info = mkLblExpr mkIndStaticInfoLabel
-
-    off_indirectee :: WordOff
-    off_indirectee = fixedHdrSize + oFFSET_StgInd_indirectee*wORD_SIZE
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[CgClosure-Description]{Profiling Closure Description.}
-%*									*
-%************************************************************************
-
-For "global" data constructors the description is simply occurrence
-name of the data constructor itself.  Otherwise it is determined by
-@closureDescription@ from the let binding information.
-
-\begin{code}
-closureDescription :: Module		-- Module
-		   -> Name		-- Id of closure binding
-		   -> String
-	-- Not called for StgRhsCon which have global info tables built in
-	-- CgConTbls.lhs with a description generated from the data constructor
-closureDescription mod_name name
-  = showSDocDump (char '<' <>
-		    (if isExternalName name
-		      then ppr name -- ppr will include the module name prefix
-		      else pprModule mod_name <> char '.' <> ppr name) <>
-		    char '>')
-   -- showSDocDump, because we want to see the unique on the Name.
-\end{code}
-  
diff --git a/ghc/compiler/codeGen/CgCon.lhs b/ghc/compiler/codeGen/CgCon.lhs
deleted file mode 100644
index bfb55bf46e..0000000000
--- a/ghc/compiler/codeGen/CgCon.lhs
+++ /dev/null
@@ -1,457 +0,0 @@
-%
-% (c) The GRASP Project, Glasgow University, 1992-1998
-%
-\section[CgCon]{Code generation for constructors}
-
-This module provides the support code for @StgToAbstractC@ to deal
-with {\em constructors} on the RHSs of let(rec)s.  See also
-@CgClosure@, which deals with closures.
-
-\begin{code}
-module CgCon (
-	cgTopRhsCon, buildDynCon,
-	bindConArgs, bindUnboxedTupleComponents,
-	cgReturnDataCon,
-	cgTyCon
-    ) where
-
-#include "HsVersions.h"
-
-import CgMonad
-import StgSyn
-
-import CgBindery	( getArgAmodes, bindNewToNode,
-			  bindArgsToRegs, idInfoToAmode, stableIdInfo,
-			  heapIdInfo, CgIdInfo, bindArgsToStack
-			)
-import CgStackery	( mkVirtStkOffsets, freeStackSlots,
-			  getRealSp, getVirtSp, setRealAndVirtualSp )
-import CgUtils		( addIdReps, cmmLabelOffW, emitRODataLits, emitDataLits )
-import CgCallConv	( assignReturnRegs )
-import Constants	( mAX_INTLIKE, mIN_INTLIKE, mAX_CHARLIKE, mIN_CHARLIKE )
-import CgHeapery	( allocDynClosure, layOutDynConstr, 
-			  layOutStaticConstr, mkStaticClosureFields )
-import CgTailCall	( performReturn, emitKnownConReturnCode, returnUnboxedTuple )
-import CgProf		( mkCCostCentreStack, ldvEnter, curCCS )
-import CgTicky
-import CgInfoTbls	( emitClosureCodeAndInfoTable, dataConTagZ )
-import CLabel
-import ClosureInfo	( mkConLFInfo, mkLFArgument )
-import CmmUtils		( mkLblExpr )
-import Cmm
-import SMRep		( WordOff, CgRep, separateByPtrFollowness,
-			  fixedHdrSize, typeCgRep )
-import CostCentre	( currentOrSubsumedCCS, dontCareCCS, CostCentreStack,
-			  currentCCS )
-import Constants	( mIN_INTLIKE, mAX_INTLIKE, mIN_CHARLIKE, mAX_CHARLIKE )
-import TyCon		( TyCon, tyConDataCons, isEnumerationTyCon, tyConName )
-import DataCon		( DataCon, dataConRepArgTys, isNullaryRepDataCon,
-			  isUnboxedTupleCon, dataConWorkId, 
-			  dataConName, dataConRepArity
-			)
-import Id		( Id, idName, isDeadBinder )
-import Type		( Type )
-import PrelInfo		( maybeCharLikeCon, maybeIntLikeCon )
-import Outputable
-import Util		( lengthIs )
-import ListSetOps	( assocMaybe )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[toplevel-constructors]{Top-level constructors}
-%*									*
-%************************************************************************
-
-\begin{code}
-cgTopRhsCon :: Id		-- Name of thing bound to this RHS
-	    -> DataCon		-- Id
-	    -> [StgArg]		-- Args
-	    -> FCode (Id, CgIdInfo)
-cgTopRhsCon id con args
-  = do { 
-	; hmods <- getHomeModules
-#if mingw32_TARGET_OS
-        -- Windows DLLs have a problem with static cross-DLL refs.
-        ; ASSERT( not (isDllConApp hmods con args) ) return ()
-#endif
-	; ASSERT( args `lengthIs` dataConRepArity con ) return ()
-
-	-- LAY IT OUT
-	; amodes <- getArgAmodes args
-
-	; let
-	    name          = idName id
-	    lf_info	  = mkConLFInfo con
-    	    closure_label = mkClosureLabel hmods name
-	    caffy         = any stgArgHasCafRefs args
-	    (closure_info, amodes_w_offsets) = layOutStaticConstr hmods con amodes
-	    closure_rep = mkStaticClosureFields
-	    		     closure_info
-	    		     dontCareCCS		-- Because it's static data
-	    		     caffy			-- Has CAF refs
-			     payload
-
-	    payload = map get_lit amodes_w_offsets	
-	    get_lit (CmmLit lit, _offset) = lit
-	    get_lit other = pprPanic "CgCon.get_lit" (ppr other)
-		-- NB1: amodes_w_offsets is sorted into ptrs first, then non-ptrs
-		-- NB2: all the amodes should be Lits!
-
-		-- BUILD THE OBJECT
-	; emitDataLits closure_label closure_rep
-
-		-- RETURN
-	; returnFC (id, stableIdInfo id (mkLblExpr closure_label) lf_info) }
-\end{code}
-
-%************************************************************************
-%*									*
-%* non-top-level constructors						*
-%*									*
-%************************************************************************
-\subsection[code-for-constructors]{The code for constructors}
-
-\begin{code}
-buildDynCon :: Id		  -- Name of the thing to which this constr will
-				  -- be bound
-	    -> CostCentreStack	  -- Where to grab cost centre from;
-				  -- current CCS if currentOrSubsumedCCS
-	    -> DataCon		  -- The data constructor
-	    -> [(CgRep,CmmExpr)] -- Its args
-	    -> FCode CgIdInfo	  -- Return details about how to find it
-
--- We used to pass a boolean indicating whether all the
--- args were of size zero, so we could use a static
--- construtor; but I concluded that it just isn't worth it.
--- Now I/O uses unboxed tuples there just aren't any constructors
--- with all size-zero args.
---
--- The reason for having a separate argument, rather than looking at
--- the addr modes of the args is that we may be in a "knot", and
--- premature looking at the args will cause the compiler to black-hole!
-\end{code}
-
-First we deal with the case of zero-arity constructors.  Now, they
-will probably be unfolded, so we don't expect to see this case much,
-if at all, but it does no harm, and sets the scene for characters.
-
-In the case of zero-arity constructors, or, more accurately, those
-which have exclusively size-zero (VoidRep) args, we generate no code
-at all.
-
-\begin{code}
-buildDynCon binder cc con []
-  = do hmods <- getHomeModules
-       returnFC (stableIdInfo binder
-			   (mkLblExpr (mkClosureLabel hmods (dataConName con)))
-    			   (mkConLFInfo con))
-\end{code}
-
-The following three paragraphs about @Char@-like and @Int@-like
-closures are obsolete, but I don't understand the details well enough
-to properly word them, sorry. I've changed the treatment of @Char@s to
-be analogous to @Int@s: only a subset is preallocated, because @Char@
-has now 31 bits. Only literals are handled here. -- Qrczak
-
-Now for @Char@-like closures.  We generate an assignment of the
-address of the closure to a temporary.  It would be possible simply to
-generate no code, and record the addressing mode in the environment,
-but we'd have to be careful if the argument wasn't a constant --- so
-for simplicity we just always asssign to a temporary.
-
-Last special case: @Int@-like closures.  We only special-case the
-situation in which the argument is a literal in the range
-@mIN_INTLIKE@..@mAX_INTLILKE@.  NB: for @Char@-like closures we can
-work with any old argument, but for @Int@-like ones the argument has
-to be a literal.  Reason: @Char@ like closures have an argument type
-which is guaranteed in range.
-
-Because of this, we use can safely return an addressing mode.
-
-\begin{code}
-buildDynCon binder cc con [arg_amode]
-  | maybeIntLikeCon con 
-  , (_, CmmLit (CmmInt val _)) <- arg_amode
-  , let val_int = (fromIntegral val) :: Int
-  , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
-  = do 	{ let intlike_lbl   = mkRtsDataLabel SLIT("stg_INTLIKE_closure")
-	      offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize + 1)
-		-- INTLIKE closures consist of a header and one word payload
-	      intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
-	; returnFC (stableIdInfo binder intlike_amode (mkConLFInfo con)) }
-
-buildDynCon binder cc con [arg_amode]
-  | maybeCharLikeCon con 
-  , (_, CmmLit (CmmInt val _)) <- arg_amode
-  , let val_int = (fromIntegral val) :: Int
-  , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
-  = do 	{ let charlike_lbl   = mkRtsDataLabel SLIT("stg_CHARLIKE_closure")
-	      offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize + 1)
-		-- CHARLIKE closures consist of a header and one word payload
-	      charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
-	; returnFC (stableIdInfo binder charlike_amode (mkConLFInfo con)) }
-\end{code}
-
-Now the general case.
-
-\begin{code}
-buildDynCon binder ccs con args
-  = do	{ 
-	; hmods <- getHomeModules
-	; let
-	    (closure_info, amodes_w_offsets) = layOutDynConstr hmods con args
-
-	; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
- 	; returnFC (heapIdInfo binder hp_off lf_info) }
-  where
-    lf_info = mkConLFInfo con
-
-    use_cc	-- cost-centre to stick in the object
-      | currentOrSubsumedCCS ccs = curCCS
-      | otherwise		 = CmmLit (mkCCostCentreStack ccs)
-
-    blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
-\end{code}
-
-
-%************************************************************************
-%*									*
-%* constructor-related utility function:				*
-%*		bindConArgs is called from cgAlt of a case		*
-%*									*
-%************************************************************************
-\subsection[constructor-utilities]{@bindConArgs@: constructor-related utility}
-
-@bindConArgs@ $con args$ augments the environment with bindings for the
-binders $args$, assuming that we have just returned from a @case@ which
-found a $con$.
-
-\begin{code}
-bindConArgs :: DataCon -> [Id] -> Code
-bindConArgs con args
-  = do hmods <- getHomeModules
-       let
-	  bind_arg (arg, offset) = bindNewToNode arg offset (mkLFArgument arg)
-	  (_, args_w_offsets)    = layOutDynConstr hmods con (addIdReps args)
-	--
-       ASSERT(not (isUnboxedTupleCon con)) return ()
-       mapCs bind_arg args_w_offsets
-\end{code}
-
-Unboxed tuples are handled slightly differently - the object is
-returned in registers and on the stack instead of the heap.
-
-\begin{code}
-bindUnboxedTupleComponents
-	:: [Id]				-- Args
-	-> FCode ([(Id,GlobalReg)],	-- Regs assigned
-		  WordOff,		-- Number of pointer stack slots
-		  WordOff,		-- Number of non-pointer stack slots
-		  VirtualSpOffset)	-- Offset of return address slot
-					-- (= realSP on entry)
-
-bindUnboxedTupleComponents args
- =  do	{   
-	  vsp <- getVirtSp
-	; rsp <- getRealSp
-
-	   -- Assign as many components as possible to registers
-	; let (reg_args, stk_args) = assignReturnRegs (addIdReps args)
-
-		-- Separate the rest of the args into pointers and non-pointers
-	      (ptr_args, nptr_args) = separateByPtrFollowness stk_args
-  
-		-- Allocate the rest on the stack
-		-- The real SP points to the return address, above which any 
-	 	-- leftover unboxed-tuple components will be allocated
-	      (ptr_sp,  ptr_offsets)  = mkVirtStkOffsets rsp    ptr_args
-	      (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args
-              ptrs  = ptr_sp  - rsp
-	      nptrs = nptr_sp - ptr_sp
-
-	    -- The stack pointer points to the last stack-allocated component
-    	; setRealAndVirtualSp nptr_sp
-
-	    -- We have just allocated slots starting at real SP + 1, and set the new
-	    -- virtual SP to the topmost allocated slot.  
-	    -- If the virtual SP started *below* the real SP, we've just jumped over
-	    -- some slots that won't be in the free-list, so put them there
-	    -- This commonly happens because we've freed the return-address slot
-	    -- (trimming back the virtual SP), but the real SP still points to that slot
-	; freeStackSlots [vsp+1,vsp+2 .. rsp]
-
-	; bindArgsToRegs reg_args
-	; bindArgsToStack ptr_offsets
-	; bindArgsToStack nptr_offsets
-
-	; returnFC (reg_args, ptrs, nptrs, rsp) }
-\end{code}
-
-%************************************************************************
-%*									*
-	Actually generate code for a constructor return
-%*									*
-%************************************************************************
-
-
-Note: it's the responsibility of the @cgReturnDataCon@ caller to be
-sure the @amodes@ passed don't conflict with each other.
-\begin{code}
-cgReturnDataCon :: DataCon -> [(CgRep, CmmExpr)] -> Code
-
-cgReturnDataCon con amodes
-  = ASSERT( amodes `lengthIs` dataConRepArity con )
-    do	{ EndOfBlockInfo _ sequel <- getEndOfBlockInfo
-	; case sequel of
-	    CaseAlts _ (Just (alts, deflt_lbl)) bndr _ 
-	      ->    -- Ho! We know the constructor so we can
-		    -- go straight to the right alternative
-		 case assocMaybe alts (dataConTagZ con) of {
-		    Just join_lbl -> build_it_then (jump_to join_lbl);
-		    Nothing
-			-- Special case!  We're returning a constructor to the default case
-			-- of an enclosing case.  For example:
-			--
-			--	case (case e of (a,b) -> C a b) of
-			--	  D x -> ...
-			--	  y   -> ...<returning here!>...
-			--
-			-- In this case,
-			--	if the default is a non-bind-default (ie does not use y),
-			--  	then we should simply jump to the default join point;
-    
-			| isDeadBinder bndr -> performReturn (jump_to deflt_lbl)
-			| otherwise	    -> build_it_then (jump_to deflt_lbl) }
-    
-	    other_sequel	-- The usual case
-	      | isUnboxedTupleCon con -> returnUnboxedTuple amodes
-              | otherwise -> build_it_then (emitKnownConReturnCode con)
-	}
-  where
-    jump_to lbl = stmtC (CmmJump (CmmLit lbl) [])
-    build_it_then return_code
-      = do { 	-- BUILD THE OBJECT IN THE HEAP
-	   	-- The first "con" says that the name bound to this
-		-- closure is "con", which is a bit of a fudge, but it only
-		-- affects profiling
-
-		-- This Id is also used to get a unique for a
-		-- temporary variable, if the closure is a CHARLIKE.
-		-- funnily enough, this makes the unique always come
-		-- out as '54' :-)
-	     tickyReturnNewCon (length amodes)
-	   ; idinfo <- buildDynCon (dataConWorkId con) currentCCS con amodes
-	   ; amode <- idInfoToAmode idinfo
-	   ; checkedAbsC (CmmAssign nodeReg amode)
-	   ; performReturn return_code }
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Generating static stuff for algebraic data types
-%*									*
-%************************************************************************
-
-	[These comments are rather out of date]
-
-\begin{tabular}{lll}
-Info tbls &	 Macro  &     	     Kind of constructor \\
-\hline
-info & @CONST_INFO_TABLE@&    Zero arity (no info -- compiler uses static closure)\\
-info & @CHARLIKE_INFO_TABLE@& Charlike   (no info -- compiler indexes fixed array)\\
-info & @INTLIKE_INFO_TABLE@&  Intlike; the one macro generates both info tbls\\
-info & @SPEC_INFO_TABLE@&     SPECish, and bigger than or equal to @MIN_UPD_SIZE@\\
-info & @GEN_INFO_TABLE@&      GENish (hence bigger than or equal to @MIN_UPD_SIZE@)\\
-\end{tabular}
-
-Possible info tables for constructor con:
-
-\begin{description}
-\item[@_con_info@:]
-Used for dynamically let(rec)-bound occurrences of
-the constructor, and for updates.  For constructors
-which are int-like, char-like or nullary, when GC occurs,
-the closure tries to get rid of itself.
-
-\item[@_static_info@:]
-Static occurrences of the constructor
-macro: @STATIC_INFO_TABLE@.
-\end{description}
-
-For zero-arity constructors, \tr{con}, we NO LONGER generate a static closure;
-it's place is taken by the top level defn of the constructor.
-
-For charlike and intlike closures there is a fixed array of static
-closures predeclared.
-
-\begin{code}
-cgTyCon :: TyCon -> FCode [Cmm]  -- each constructor gets a separate Cmm
-cgTyCon tycon
-  = do	{ constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
-
-	    -- Generate a table of static closures for an enumeration type
-	    -- Put the table after the data constructor decls, because the
-	    -- datatype closure table (for enumeration types)
-	    -- to (say) PrelBase_$wTrue_closure, which is defined in code_stuff
-	; extra <- 
-	   if isEnumerationTyCon tycon then do
-	        tbl <- getCmm (emitRODataLits (mkLocalClosureTableLabel 
-						(tyConName tycon))
-			   [ CmmLabel (mkLocalClosureLabel (dataConName con))
-    			   | con <- tyConDataCons tycon])
-		return [tbl]
-	   else
-		return []
-
-	; return (extra ++ constrs)
-    }
-\end{code}
-
-Generate the entry code, info tables, and (for niladic constructor) the
-static closure, for a constructor.
-
-\begin{code}
-cgDataCon :: DataCon -> Code
-cgDataCon data_con
-  = do	{     -- Don't need any dynamic closure code for zero-arity constructors
-	  hmods <- getHomeModules
-
-	; let
-	    -- To allow the debuggers, interpreters, etc to cope with
-	    -- static data structures (ie those built at compile
-	    -- time), we take care that info-table contains the
-	    -- information we need.
-	    (static_cl_info, _) = 
-		layOutStaticConstr hmods data_con arg_reps
-
-	    (dyn_cl_info, arg_things) = 
-		layOutDynConstr    hmods data_con arg_reps
-
-	    emit_info cl_info ticky_code
-		= do { code_blks <- getCgStmts the_code
-		     ; emitClosureCodeAndInfoTable cl_info [] code_blks }
-		where
-		  the_code = do	{ ticky_code
-				; ldvEnter (CmmReg nodeReg)
-				; body_code }
-
-	    arg_reps :: [(CgRep, Type)]
-	    arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
-
-	    body_code = do { 	
-			-- NB: We don't set CC when entering data (WDP 94/06)
-			     tickyReturnOldCon (length arg_things)
-			   ; performReturn (emitKnownConReturnCode data_con) }
-				-- noStmts: Ptr to thing already in Node
-
-	; whenC (not (isNullaryRepDataCon data_con))
-	 	(emit_info dyn_cl_info tickyEnterDynCon)
-
-		-- Dynamic-Closure first, to reduce forward references
-	; emit_info static_cl_info tickyEnterStaticCon }
-
-  where
-\end{code}
diff --git a/ghc/compiler/codeGen/CgExpr.hi-boot-5 b/ghc/compiler/codeGen/CgExpr.hi-boot-5
deleted file mode 100644
index 588e63f8f1..0000000000
--- a/ghc/compiler/codeGen/CgExpr.hi-boot-5
+++ /dev/null
@@ -1,3 +0,0 @@
-__interface CgExpr 1 0 where
-__export CgExpr cgExpr;
-1 cgExpr :: StgSyn.StgExpr -> CgMonad.Code ;
diff --git a/ghc/compiler/codeGen/CgExpr.hi-boot-6 b/ghc/compiler/codeGen/CgExpr.hi-boot-6
deleted file mode 100644
index dc2d75cefe..0000000000
--- a/ghc/compiler/codeGen/CgExpr.hi-boot-6
+++ /dev/null
@@ -1,3 +0,0 @@
-module CgExpr where
-
-cgExpr :: StgSyn.StgExpr -> CgMonad.Code
diff --git a/ghc/compiler/codeGen/CgExpr.lhs b/ghc/compiler/codeGen/CgExpr.lhs
deleted file mode 100644
index 33d72f1608..0000000000
--- a/ghc/compiler/codeGen/CgExpr.lhs
+++ /dev/null
@@ -1,454 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-% $Id: CgExpr.lhs,v 1.62 2005/06/21 10:44:41 simonmar Exp $
-%
-%********************************************************
-%*							*
-\section[CgExpr]{Converting @StgExpr@s}
-%*							*
-%********************************************************
-
-\begin{code}
-module CgExpr ( cgExpr ) where
-
-#include "HsVersions.h"
-
-import Constants	( mAX_SPEC_SELECTEE_SIZE, mAX_SPEC_AP_SIZE )
-import StgSyn
-import CgMonad
-
-import SMRep		( fixedHdrSize, isFollowableArg, CgRep(..), argMachRep,
-			  nonVoidArg, idCgRep, typeCgRep, typeHint,
-			  primRepToCgRep )
-import CoreSyn		( AltCon(..) )
-import CgProf		( emitSetCCC )
-import CgHeapery	( layOutDynConstr )
-import CgBindery	( getArgAmodes, getArgAmode, CgIdInfo, 
-			  nukeDeadBindings, addBindC, addBindsC )
-import CgCase		( cgCase, saveVolatileVarsAndRegs )
-import CgClosure	( cgRhsClosure, cgStdRhsClosure )
-import CgCon		( buildDynCon, cgReturnDataCon )
-import CgLetNoEscape	( cgLetNoEscapeClosure )
-import CgCallConv	( dataReturnConvPrim )
-import CgTailCall
-import CgInfoTbls	( emitDirectReturnInstr )
-import CgForeignCall	( emitForeignCall, shimForeignCallArg )
-import CgPrimOp		( cgPrimOp )
-import CgUtils		( addIdReps, newTemp, assignTemp, cgLit, tagToClosure )
-import ClosureInfo	( mkSelectorLFInfo, mkApLFInfo )
-import Cmm		( CmmExpr(..), CmmStmt(..), CmmReg, nodeReg )
-import MachOp		( wordRep, MachHint )
-import VarSet
-import Literal		( literalType )
-import PrimOp		( primOpOutOfLine, getPrimOpResultInfo, 
-			  PrimOp(..), PrimOpResultInfo(..) )
-import Id		( Id )
-import TyCon		( isUnboxedTupleTyCon, isEnumerationTyCon )
-import Type		( Type, tyConAppArgs, tyConAppTyCon, repType,
-			  PrimRep(VoidRep) )
-import Maybes		( maybeToBool )
-import ListSetOps	( assocMaybe )
-import BasicTypes	( RecFlag(..) )
-import Util             ( lengthIs )
-import Outputable
-\end{code}
-
-This module provides the support code for @StgToAbstractC@ to deal
-with STG {\em expressions}.  See also @CgClosure@, which deals
-with closures, and @CgCon@, which deals with constructors.
-
-\begin{code}
-cgExpr	:: StgExpr		-- input
-	-> Code			-- output
-\end{code}
-
-%********************************************************
-%*							*
-%*		Tail calls				*
-%*							*
-%********************************************************
-
-``Applications'' mean {\em tail calls}, a service provided by module
-@CgTailCall@.  This includes literals, which show up as
-@(STGApp (StgLitArg 42) [])@.
-
-\begin{code}
-cgExpr (StgApp fun args) = cgTailCall fun args
-\end{code}
-
-%********************************************************
-%*							*
-%*		STG ConApps  (for inline versions)	*
-%*							*
-%********************************************************
-
-\begin{code}
-cgExpr (StgConApp con args)
-  = do	{ amodes <- getArgAmodes args
-	; cgReturnDataCon con amodes }
-\end{code}
-
-Literals are similar to constructors; they return by putting
-themselves in an appropriate register and returning to the address on
-top of the stack.
-
-\begin{code}
-cgExpr (StgLit lit)
-  = do  { cmm_lit <- cgLit lit
-	; performPrimReturn rep (CmmLit cmm_lit) }
-  where
-    rep = typeCgRep (literalType lit)
-\end{code}
-
-
-%********************************************************
-%*							*
-%* 	PrimOps and foreign calls.
-%*							*
-%********************************************************
-
-NOTE about "safe" foreign calls: a safe foreign call is never compiled
-inline in a case expression.  When we see
-
-	case (ccall ...) of { ... }
-
-We generate a proper return address for the alternatives and push the
-stack frame before doing the call, so that in the event that the call
-re-enters the RTS the stack is in a sane state.
-
-\begin{code}
-cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
-    {-
-	First, copy the args into temporaries.  We're going to push
-	a return address right before doing the call, so the args
-	must be out of the way.
-    -}
-    reps_n_amodes <- getArgAmodes stg_args
-    let 
-	-- Get the *non-void* args, and jiggle them with shimForeignCall
-	arg_exprs = [ shimForeignCallArg stg_arg expr 
-		    | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes, 
-		      nonVoidArg rep]
-
-    -- in
-    arg_tmps <- mapM assignTemp arg_exprs
-    let
-	arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
-    -- in
-    {-
-	Now, allocate some result regs.
-    -}
-    (res_reps,res_regs,res_hints)  <- newUnboxedTupleRegs res_ty
-    ccallReturnUnboxedTuple (zip res_reps (map CmmReg res_regs)) $
-	emitForeignCall (zip res_regs res_hints) fcall 
-	   arg_hints emptyVarSet{-no live vars-}
-      
--- tagToEnum# is special: we need to pull the constructor out of the table,
--- and perform an appropriate return.
-
-cgExpr (StgOpApp (StgPrimOp TagToEnumOp) [arg] res_ty) 
-  = ASSERT(isEnumerationTyCon tycon)
-    do	{ (_,amode) <- getArgAmode arg
-	; amode' <- assignTemp amode	-- We're going to use it twice,
-					-- so save in a temp if non-trivial
-	; hmods <- getHomeModules
-	; stmtC (CmmAssign nodeReg (tagToClosure hmods tycon amode'))
-	; performReturn (emitAlgReturnCode tycon amode') }
-   where
-	  -- If you're reading this code in the attempt to figure
-	  -- out why the compiler panic'ed here, it is probably because
-	  -- you used tagToEnum# in a non-monomorphic setting, e.g., 
-	  --         intToTg :: Enum a => Int -> a ; intToTg (I# x#) = tagToEnum# x#
-	  -- That won't work.
-	tycon = tyConAppTyCon res_ty
-
-
-cgExpr x@(StgOpApp op@(StgPrimOp primop) args res_ty)
-  | primOpOutOfLine primop
-	= tailCallPrimOp primop args
-
-  | ReturnsPrim VoidRep <- result_info
-	= do cgPrimOp [] primop args emptyVarSet
-	     performReturn emitDirectReturnInstr
-
-  | ReturnsPrim rep <- result_info
-	= do cgPrimOp [dataReturnConvPrim (primRepToCgRep rep)] 
-			primop args emptyVarSet
-	     performReturn emitDirectReturnInstr
-
-  | ReturnsAlg tycon <- result_info, isUnboxedTupleTyCon tycon
-	= do (reps, regs, _hints) <- newUnboxedTupleRegs res_ty
-	     cgPrimOp regs primop args emptyVarSet{-no live vars-}
-	     returnUnboxedTuple (zip reps (map CmmReg regs))
-
-  | ReturnsAlg tycon <- result_info, isEnumerationTyCon tycon
-	-- c.f. cgExpr (...TagToEnumOp...)
-	= do tag_reg <- newTemp wordRep
-	     hmods <- getHomeModules
-	     cgPrimOp [tag_reg] primop args emptyVarSet
-	     stmtC (CmmAssign nodeReg (tagToClosure hmods tycon (CmmReg tag_reg)))
-	     performReturn (emitAlgReturnCode tycon (CmmReg tag_reg))
-  where
-	result_info = getPrimOpResultInfo primop
-\end{code}
-
-%********************************************************
-%*							*
-%*		Case expressions			*
-%*							*
-%********************************************************
-Case-expression conversion is complicated enough to have its own
-module, @CgCase@.
-\begin{code}
-
-cgExpr (StgCase expr live_vars save_vars bndr srt alt_type alts)
-  = cgCase expr live_vars save_vars bndr srt alt_type alts
-\end{code}
-
-
-%********************************************************
-%*							*
-%* 		Let and letrec				*
-%*							*
-%********************************************************
-\subsection[let-and-letrec-codegen]{Converting @StgLet@ and @StgLetrec@}
-
-\begin{code}
-cgExpr (StgLet (StgNonRec name rhs) expr)
-  = cgRhs name rhs	`thenFC` \ (name, info) ->
-    addBindC name info 	`thenC`
-    cgExpr expr
-
-cgExpr (StgLet (StgRec pairs) expr)
-  = fixC (\ new_bindings -> addBindsC new_bindings `thenC`
-			    listFCs [ cgRhs b e | (b,e) <- pairs ]
-    ) `thenFC` \ new_bindings ->
-
-    addBindsC new_bindings `thenC`
-    cgExpr expr
-\end{code}
-
-\begin{code}
-cgExpr (StgLetNoEscape live_in_whole_let live_in_rhss bindings body)
-  = do	{  	-- Figure out what volatile variables to save
-	; nukeDeadBindings live_in_whole_let
-	; (save_assts, rhs_eob_info, maybe_cc_slot) 
-		<- saveVolatileVarsAndRegs live_in_rhss
-
-	-- Save those variables right now!
-	; emitStmts save_assts
-
-	-- Produce code for the rhss
-	-- and add suitable bindings to the environment
-	; cgLetNoEscapeBindings live_in_rhss rhs_eob_info 
-			 	maybe_cc_slot bindings
-
-	-- Do the body
-	; setEndOfBlockInfo rhs_eob_info (cgExpr body) }
-\end{code}
-
-
-%********************************************************
-%*							*
-%*		SCC Expressions				*
-%*							*
-%********************************************************
-
-SCC expressions are treated specially. They set the current cost
-centre.
-
-\begin{code}
-cgExpr (StgSCC cc expr) = do emitSetCCC cc; cgExpr expr
-\end{code}
-
-%********************************************************
-%*							*
-%*		Non-top-level bindings			*
-%*							*
-%********************************************************
-\subsection[non-top-level-bindings]{Converting non-top-level bindings}
-
-We rely on the support code in @CgCon@ (to do constructors) and
-in @CgClosure@ (to do closures).
-
-\begin{code}
-cgRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
-	-- the Id is passed along so a binding can be set up
-
-cgRhs name (StgRhsCon maybe_cc con args)
-  = do	{ amodes <- getArgAmodes args
-	; idinfo <- buildDynCon name maybe_cc con amodes
-	; returnFC (name, idinfo) }
-
-cgRhs name (StgRhsClosure cc bi fvs upd_flag srt args body)
-  = do hmods <- getHomeModules
-       mkRhsClosure hmods name cc bi srt fvs upd_flag args body
-\end{code}
-
-mkRhsClosure looks for two special forms of the right-hand side:
-	a) selector thunks.
-	b) AP thunks
-
-If neither happens, it just calls mkClosureLFInfo.  You might think
-that mkClosureLFInfo should do all this, but it seems wrong for the
-latter to look at the structure of an expression
-
-Selectors
-~~~~~~~~~
-We look at the body of the closure to see if it's a selector---turgid,
-but nothing deep.  We are looking for a closure of {\em exactly} the
-form:
-
-...  = [the_fv] \ u [] ->
-	 case the_fv of
-	   con a_1 ... a_n -> a_i
-
-
-\begin{code}
-mkRhsClosure	hmods bndr cc bi srt
-		[the_fv]   		-- Just one free var
-		upd_flag		-- Updatable thunk
-		[]			-- A thunk
-		body@(StgCase (StgApp scrutinee [{-no args-}])
-		      _ _ _ _   -- ignore uniq, etc.
-		      (AlgAlt tycon)
-		      [(DataAlt con, params, use_mask,
-			    (StgApp selectee [{-no args-}]))])
-  |  the_fv == scrutinee		-- Scrutinee is the only free variable
-  && maybeToBool maybe_offset		-- Selectee is a component of the tuple
-  && offset_into_int <= mAX_SPEC_SELECTEE_SIZE	-- Offset is small enough
-  = -- NOT TRUE: ASSERT(is_single_constructor)
-    -- The simplifier may have statically determined that the single alternative
-    -- is the only possible case and eliminated the others, even if there are
-    -- other constructors in the datatype.  It's still ok to make a selector
-    -- thunk in this case, because we *know* which constructor the scrutinee
-    -- will evaluate to.
-    cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
-  where
-    lf_info 		  = mkSelectorLFInfo bndr offset_into_int
-				 (isUpdatable upd_flag)
-    (_, params_w_offsets) = layOutDynConstr hmods con (addIdReps params)
-			-- Just want the layout
-    maybe_offset	  = assocMaybe params_w_offsets selectee
-    Just the_offset 	  = maybe_offset
-    offset_into_int       = the_offset - fixedHdrSize
-\end{code}
-
-Ap thunks
-~~~~~~~~~
-
-A more generic AP thunk of the form
-
-	x = [ x_1...x_n ] \.. [] -> x_1 ... x_n
-
-A set of these is compiled statically into the RTS, so we just use
-those.  We could extend the idea to thunks where some of the x_i are
-global ids (and hence not free variables), but this would entail
-generating a larger thunk.  It might be an option for non-optimising
-compilation, though.
-
-We only generate an Ap thunk if all the free variables are pointers,
-for semi-obvious reasons.
-
-\begin{code}
-mkRhsClosure 	hmods bndr cc bi srt
-		fvs
-		upd_flag
-		[]			-- No args; a thunk
-		body@(StgApp fun_id args)
-
-  | args `lengthIs` (arity-1)
- 	&& all isFollowableArg (map idCgRep fvs) 
- 	&& isUpdatable upd_flag
- 	&& arity <= mAX_SPEC_AP_SIZE 
-
- 		   -- Ha! an Ap thunk
-	= cgStdRhsClosure bndr cc bi fvs [] body lf_info payload
-
-   where
-	lf_info = mkApLFInfo bndr upd_flag arity
-	-- the payload has to be in the correct order, hence we can't
- 	-- just use the fvs.
-	payload = StgVarArg fun_id : args
-	arity 	= length fvs
-\end{code}
-
-The default case
-~~~~~~~~~~~~~~~~
-\begin{code}
-mkRhsClosure hmods bndr cc bi srt fvs upd_flag args body
-  = cgRhsClosure bndr cc bi srt fvs upd_flag args body
-\end{code}
-
-
-%********************************************************
-%*							*
-%*		Let-no-escape bindings
-%*							*
-%********************************************************
-\begin{code}
-cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot 
-	(StgNonRec binder rhs)
-  = do	{ (binder,info) <- cgLetNoEscapeRhs live_in_rhss rhs_eob_info 
-					    maybe_cc_slot 	
-					    NonRecursive binder rhs 
-	; addBindC binder info }
-
-cgLetNoEscapeBindings live_in_rhss rhs_eob_info maybe_cc_slot (StgRec pairs)
-  = do	{ new_bindings <- fixC (\ new_bindings -> do
-		{ addBindsC new_bindings
-		; listFCs [ cgLetNoEscapeRhs full_live_in_rhss 
-				rhs_eob_info maybe_cc_slot Recursive b e 
-			  | (b,e) <- pairs ] })
-
-	; addBindsC new_bindings }
-  where
-    -- We add the binders to the live-in-rhss set so that we don't
-    -- delete the bindings for the binder from the environment!
-    full_live_in_rhss = live_in_rhss `unionVarSet` (mkVarSet [b | (b,r) <- pairs])
-
-cgLetNoEscapeRhs
-    :: StgLiveVars	-- Live in rhss
-    -> EndOfBlockInfo
-    -> Maybe VirtualSpOffset
-    -> RecFlag
-    -> Id
-    -> StgRhs
-    -> FCode (Id, CgIdInfo)
-
-cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
-		 (StgRhsClosure cc bi _ upd_flag srt args body)
-  = -- We could check the update flag, but currently we don't switch it off
-    -- for let-no-escaped things, so we omit the check too!
-    -- case upd_flag of
-    --     Updatable -> panic "cgLetNoEscapeRhs"	-- Nothing to update!
-    --     other     -> cgLetNoEscapeClosure binder cc bi live_in_whole_let live_in_rhss args body
-    cgLetNoEscapeClosure binder cc bi srt full_live_in_rhss rhs_eob_info
-	maybe_cc_slot rec args body
-
--- For a constructor RHS we want to generate a single chunk of code which
--- can be jumped to from many places, which will return the constructor.
--- It's easy; just behave as if it was an StgRhsClosure with a ConApp inside!
-cgLetNoEscapeRhs full_live_in_rhss rhs_eob_info maybe_cc_slot rec binder
-    	    	 (StgRhsCon cc con args)
-  = cgLetNoEscapeClosure binder cc noBinderInfo{-safe-} NoSRT
-			 full_live_in_rhss rhs_eob_info maybe_cc_slot rec
-	[] 	--No args; the binder is data structure, not a function
-	(StgConApp con args)
-\end{code}
-
-Little helper for primitives that return unboxed tuples.
-
-\begin{code}
-newUnboxedTupleRegs :: Type -> FCode ([CgRep], [CmmReg], [MachHint])
-newUnboxedTupleRegs res_ty =
-   let
-	ty_args = tyConAppArgs (repType res_ty)
-	(reps,hints) = unzip [ (rep, typeHint ty) | ty <- ty_args, 
-					   	    let rep = typeCgRep ty,
-					 	    nonVoidArg rep ]
-   in do
-   regs <- mapM (newTemp . argMachRep) reps
-   return (reps,regs,hints)
-\end{code}
diff --git a/ghc/compiler/codeGen/CgExpr.lhs-boot b/ghc/compiler/codeGen/CgExpr.lhs-boot
deleted file mode 100644
index 29cdc3a605..0000000000
--- a/ghc/compiler/codeGen/CgExpr.lhs-boot
+++ /dev/null
@@ -1,7 +0,0 @@
-\begin{code}
-module CgExpr where
-import StgSyn( StgExpr )
-import CgMonad( Code )
-
-cgExpr :: StgExpr -> Code
-\end{code}
diff --git a/ghc/compiler/codeGen/CgForeignCall.hs b/ghc/compiler/codeGen/CgForeignCall.hs
deleted file mode 100644
index 10f41bdf8b..0000000000
--- a/ghc/compiler/codeGen/CgForeignCall.hs
+++ /dev/null
@@ -1,256 +0,0 @@
------------------------------------------------------------------------------
---
--- Code generation for foreign calls.
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
-module CgForeignCall (
-  cgForeignCall,
-  emitForeignCall,
-  emitForeignCall',
-  shimForeignCallArg,
-  emitSaveThreadState, -- will be needed by the Cmm parser
-  emitLoadThreadState, -- ditto
-  emitCloseNursery,
-  emitOpenNursery,
- ) where
-
-#include "HsVersions.h"
-
-import StgSyn		( StgLiveVars, StgArg, stgArgType )
-import CgProf		( curCCS, curCCSAddr )
-import CgBindery	( getVolatileRegs, getArgAmodes )
-import CgMonad
-import CgUtils		( cmmOffsetW, cmmOffsetB, cmmLoadIndexW, newTemp,
-			  assignTemp )
-import Type		( tyConAppTyCon, repType )
-import TysPrim
-import CLabel		( mkForeignLabel, mkRtsCodeLabel )
-import Cmm
-import CmmUtils
-import MachOp
-import SMRep
-import ForeignCall
-import Constants
-import StaticFlags	( opt_SccProfilingOn )
-import Outputable
-
-import Monad		( when )
-
--- -----------------------------------------------------------------------------
--- Code generation for Foreign Calls
-
-cgForeignCall
-	:: [(CmmReg,MachHint)]	-- where to put the results
-	-> ForeignCall		-- the op
-	-> [StgArg]		-- arguments
-	-> StgLiveVars	-- live vars, in case we need to save them
-	-> Code
-cgForeignCall results fcall stg_args live
-  = do 
-  reps_n_amodes <- getArgAmodes stg_args
-  let
-	-- Get the *non-void* args, and jiggle them with shimForeignCall
-	arg_exprs = [ shimForeignCallArg stg_arg expr 
-	  	    | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes, 
-	               nonVoidArg rep]
-
-	arg_hints = zip arg_exprs (map (typeHint.stgArgType) stg_args)
-  -- in
-  emitForeignCall results fcall arg_hints live
-
-
-emitForeignCall
-	:: [(CmmReg,MachHint)]	-- where to put the results
-	-> ForeignCall		-- the op
-	-> [(CmmExpr,MachHint)] -- arguments
-	-> StgLiveVars	-- live vars, in case we need to save them
-	-> Code
-
-emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
-  = do vols <- getVolatileRegs live
-       emitForeignCall' safety results
-		(CmmForeignCall cmm_target cconv) call_args (Just vols)
-  where
-      (call_args, cmm_target)
-	= case target of
-	   StaticTarget lbl -> (args, CmmLit (CmmLabel 
-					(mkForeignLabel lbl call_size False)))
-	   DynamicTarget    ->  case args of (fn,_):rest -> (rest, fn)
-
-	-- in the stdcall calling convention, the symbol needs @size appended
-	-- to it, where size is the total number of bytes of arguments.  We
-	-- attach this info to the CLabel here, and the CLabel pretty printer
-	-- will generate the suffix when the label is printed.
-      call_size
-	| StdCallConv <- cconv = Just (sum (map (arg_size.cmmExprRep.fst) args))
-	| otherwise            = Nothing
-
-	-- ToDo: this might not be correct for 64-bit API
-      arg_size rep = max (machRepByteWidth rep) wORD_SIZE
-
-emitForeignCall results (DNCall _) args live
-  = panic "emitForeignCall: DNCall"
-
-
--- alternative entry point, used by CmmParse
-emitForeignCall'
-	:: Safety
-	-> [(CmmReg,MachHint)]	-- where to put the results
-	-> CmmCallTarget	-- the op
-	-> [(CmmExpr,MachHint)] -- arguments
-	-> Maybe [GlobalReg]	-- live vars, in case we need to save them
-	-> Code
-emitForeignCall' safety results target args vols 
-  | not (playSafe safety) = do
-    temp_args <- load_args_into_temps args
-    stmtC (CmmCall target results temp_args vols)
-
-  | otherwise = do
-    id <- newTemp wordRep
-    temp_args <- load_args_into_temps args
-    emitSaveThreadState
-    stmtC (CmmCall (CmmForeignCall suspendThread CCallConv) 
-			[(id,PtrHint)]
-			[ (CmmReg (CmmGlobal BaseReg), PtrHint) ] 
-			vols
-			)
-    stmtC (CmmCall target results temp_args vols)
-    stmtC (CmmCall (CmmForeignCall resumeThread CCallConv) 
-			[ (CmmGlobal BaseReg, PtrHint) ]
-				-- Assign the result to BaseReg: we
-				-- might now have a different
-				-- Capability!
-			[ (CmmReg id, PtrHint) ]
-			vols
-			)
-    emitLoadThreadState
-
-
-suspendThread = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("suspendThread")))
-resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("resumeThread")))
-
-
--- we might need to load arguments into temporaries before
--- making the call, because certain global registers might
--- overlap with registers that the C calling convention uses
--- for passing arguments.
---
--- This is a HACK; really it should be done in the back end, but
--- it's easier to generate the temporaries here.
-load_args_into_temps args = mapM maybe_assignTemp args
-	
-maybe_assignTemp (e, hint)
-  | hasNoGlobalRegs e = return (e, hint)
-  | otherwise          = do 
-	-- don't use assignTemp, it uses its own notion of "trivial"
-	-- expressions, which are wrong here
-	reg <- newTemp (cmmExprRep e)
-	stmtC (CmmAssign reg e)
-	return (CmmReg reg, hint)
-
--- -----------------------------------------------------------------------------
--- Save/restore the thread state in the TSO
-
--- This stuff can't be done in suspendThread/resumeThread, because it
--- refers to global registers which aren't available in the C world.
-
-emitSaveThreadState = do
-  -- CurrentTSO->sp = Sp;
-  stmtC $ CmmStore (cmmOffset stgCurrentTSO tso_SP) stgSp
-  emitCloseNursery
-  -- and save the current cost centre stack in the TSO when profiling:
-  when opt_SccProfilingOn $
-	stmtC (CmmStore (cmmOffset stgCurrentTSO tso_CCCS) curCCS)
-
-   -- CurrentNursery->free = Hp+1;
-emitCloseNursery = stmtC $ CmmStore nursery_bdescr_free (cmmOffsetW stgHp 1)
-
-emitLoadThreadState = do
-  tso <- newTemp wordRep
-  stmtsC [
-	-- tso = CurrentTSO;
-  	CmmAssign tso stgCurrentTSO,
-	-- Sp = tso->sp;
-	CmmAssign sp (CmmLoad (cmmOffset (CmmReg tso) tso_SP)
-	                      wordRep),
-	-- SpLim = tso->stack + RESERVED_STACK_WORDS;
-	CmmAssign spLim (cmmOffsetW (cmmOffset (CmmReg tso) tso_STACK)
-			            rESERVED_STACK_WORDS)
-    ]
-  emitOpenNursery
-  -- and load the current cost centre stack from the TSO when profiling:
-  when opt_SccProfilingOn $
-	stmtC (CmmStore curCCSAddr 
-		(CmmLoad (cmmOffset (CmmReg tso) tso_CCCS) wordRep))
-
-emitOpenNursery = stmtsC [
-        -- Hp = CurrentNursery->free - 1;
-	CmmAssign hp (cmmOffsetW (CmmLoad nursery_bdescr_free wordRep) (-1)),
-
-        -- HpLim = CurrentNursery->start + 
-	--		CurrentNursery->blocks*BLOCK_SIZE_W - 1;
-	CmmAssign hpLim
-	    (cmmOffsetExpr
-		(CmmLoad nursery_bdescr_start wordRep)
-		(cmmOffset
-		  (CmmMachOp mo_wordMul [
-		    CmmMachOp (MO_S_Conv I32 wordRep)
-		      [CmmLoad nursery_bdescr_blocks I32],
-		    CmmLit (mkIntCLit bLOCK_SIZE)
-		   ])
-		  (-1)
-		)
-	    )
-   ]
-
-
-nursery_bdescr_free   = cmmOffset stgCurrentNursery oFFSET_bdescr_free
-nursery_bdescr_start  = cmmOffset stgCurrentNursery oFFSET_bdescr_start
-nursery_bdescr_blocks = cmmOffset stgCurrentNursery oFFSET_bdescr_blocks
-
-tso_SP    = tsoFieldB     oFFSET_StgTSO_sp
-tso_STACK = tsoFieldB     oFFSET_StgTSO_stack
-tso_CCCS  = tsoProfFieldB oFFSET_StgTSO_CCCS
-
--- The TSO struct has a variable header, and an optional StgTSOProfInfo in
--- the middle.  The fields we're interested in are after the StgTSOProfInfo.
-tsoFieldB :: ByteOff -> ByteOff
-tsoFieldB off
-  | opt_SccProfilingOn = off + sIZEOF_StgTSOProfInfo + fixedHdrSize * wORD_SIZE
-  | otherwise          = off + fixedHdrSize * wORD_SIZE
-
-tsoProfFieldB :: ByteOff -> ByteOff
-tsoProfFieldB off = off + fixedHdrSize * wORD_SIZE
-
-stgSp		  = CmmReg sp
-stgHp		  = CmmReg hp
-stgCurrentTSO	  = CmmReg currentTSO
-stgCurrentNursery = CmmReg currentNursery
-
-sp		  = CmmGlobal Sp
-spLim		  = CmmGlobal SpLim
-hp		  = CmmGlobal Hp
-hpLim		  = CmmGlobal HpLim
-currentTSO	  = CmmGlobal CurrentTSO
-currentNursery 	  = CmmGlobal CurrentNursery
-
--- -----------------------------------------------------------------------------
--- For certain types passed to foreign calls, we adjust the actual
--- value passed to the call.  For ByteArray#/Array# we pass the
--- address of the actual array, not the address of the heap object.
-
-shimForeignCallArg :: StgArg -> CmmExpr -> CmmExpr
-shimForeignCallArg arg expr
-  | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon
-	= cmmOffsetB expr arrPtrsHdrSize
-
-  | tycon == byteArrayPrimTyCon || tycon == mutableByteArrayPrimTyCon
-	= cmmOffsetB expr arrWordsHdrSize
-
-  | otherwise = expr
-  where	
-	-- should be a tycon app, since this is a foreign call
-	tycon = tyConAppTyCon (repType (stgArgType arg))
diff --git a/ghc/compiler/codeGen/CgHeapery.lhs b/ghc/compiler/codeGen/CgHeapery.lhs
deleted file mode 100644
index 184af904df..0000000000
--- a/ghc/compiler/codeGen/CgHeapery.lhs
+++ /dev/null
@@ -1,588 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-% $Id: CgHeapery.lhs,v 1.47 2005/06/21 10:44:41 simonmar Exp $
-%
-\section[CgHeapery]{Heap management functions}
-
-\begin{code}
-module CgHeapery (
-	initHeapUsage, getVirtHp, setVirtHp, setRealHp, 
-	getHpRelOffset,	hpRel,
-
-	funEntryChecks, thunkEntryChecks, 
-	altHeapCheck, unbxTupleHeapCheck, 
-	hpChkGen, hpChkNodePointsAssignSp0,
-	stkChkGen, stkChkNodePoints,
-
-	layOutDynConstr, layOutStaticConstr,
-	mkVirtHeapOffsets, mkStaticClosureFields, mkStaticClosure,
-
-	allocDynClosure, emitSetDynHdr
-    ) where
-
-#include "HsVersions.h"
-
-import StgSyn		( AltType(..) )
-import CLabel		( CLabel, mkRtsCodeLabel )
-import CgUtils		( mkWordCLit, cmmRegOffW, cmmOffsetW,
-			  cmmOffsetExprB )
-import CgMonad
-import CgProf		( staticProfHdr, profDynAlloc, dynProfHdr )
-import CgTicky		( staticTickyHdr, tickyDynAlloc, tickyAllocHeap )
-import CgParallel	( staticGranHdr, staticParHdr, doGranAllocate )
-import CgStackery	( getFinalStackHW, getRealSp )
-import CgCallConv	( mkRegLiveness )
-import ClosureInfo	( closureSize, staticClosureNeedsLink, 
-			  mkConInfo,  closureNeedsUpdSpace,
-			  infoTableLabelFromCI, closureLabelFromCI,
-			  nodeMustPointToIt, closureLFInfo, 			
-			  ClosureInfo )
-import SMRep		( CgRep(..), cgRepSizeW, separateByPtrFollowness,
-			  WordOff, fixedHdrSize, thunkHdrSize,
-			  isVoidArg, primRepToCgRep )
-
-import Cmm		( CmmLit(..), CmmStmt(..), CmmExpr(..), GlobalReg(..),
-			  CmmReg(..), hpReg, nodeReg, spReg )
-import MachOp		( mo_wordULt, mo_wordUGt, mo_wordSub )
-import CmmUtils		( mkIntCLit, CmmStmts, noStmts, oneStmt, plusStmts,
-			  mkStmts )
-import Id		( Id )
-import DataCon		( DataCon )
-import TyCon		( tyConPrimRep )
-import CostCentre	( CostCentreStack )
-import Util		( mapAccumL, filterOut )
-import Constants	( wORD_SIZE )
-import Packages		( HomeModules )
-import Outputable
-
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[CgUsages-heapery]{Monad things for fiddling with heap usage}
-%*									*
-%************************************************************************
-
-The heap always grows upwards, so hpRel is easy
-
-\begin{code}
-hpRel :: VirtualHpOffset 	-- virtual offset of Hp
-      -> VirtualHpOffset 	-- virtual offset of The Thing
-      -> WordOff			-- integer word offset
-hpRel hp off = off - hp
-\end{code}
-
-@initHeapUsage@ applies a function to the amount of heap that it uses.
-It initialises the heap usage to zeros, and passes on an unchanged
-heap usage.
-
-It is usually a prelude to performing a GC check, so everything must
-be in a tidy and consistent state.
-
-rje: Note the slightly suble fixed point behaviour needed here
-
-\begin{code}
-initHeapUsage :: (VirtualHpOffset -> Code) -> Code
-initHeapUsage fcode
-  = do	{ orig_hp_usage <- getHpUsage
-	; setHpUsage initHpUsage
-	; fixC (\heap_usage2 -> do
-		{ fcode (heapHWM heap_usage2)
-		; getHpUsage })
-	; setHpUsage orig_hp_usage }
-
-setVirtHp :: VirtualHpOffset -> Code
-setVirtHp new_virtHp
-  = do	{ hp_usage <- getHpUsage
-	; setHpUsage (hp_usage {virtHp = new_virtHp}) }
-
-getVirtHp :: FCode VirtualHpOffset
-getVirtHp 
-  = do	{ hp_usage <- getHpUsage
-	; return (virtHp hp_usage) }
-
-setRealHp ::  VirtualHpOffset -> Code
-setRealHp new_realHp
-  = do	{ hp_usage <- getHpUsage
-	; setHpUsage (hp_usage {realHp = new_realHp}) }
-
-getHpRelOffset :: VirtualHpOffset -> FCode CmmExpr
-getHpRelOffset virtual_offset
-  = do	{ hp_usg <- getHpUsage
-	; return (cmmRegOffW hpReg (hpRel (realHp hp_usg) virtual_offset)) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Layout of heap objects
-%*									*
-%************************************************************************
-
-\begin{code}
-layOutDynConstr, layOutStaticConstr
-	:: HomeModules
-	-> DataCon 	
-	-> [(CgRep,a)]
-	-> (ClosureInfo,
-	    [(a,VirtualHpOffset)])
-
-layOutDynConstr    = layOutConstr False
-layOutStaticConstr = layOutConstr True
-
-layOutConstr  is_static hmods data_con args
-   = (mkConInfo hmods is_static data_con tot_wds ptr_wds,
-      things_w_offsets)
-  where
-    (tot_wds,		 --  #ptr_wds + #nonptr_wds
-     ptr_wds,		 --  #ptr_wds
-     things_w_offsets) = mkVirtHeapOffsets False{-not a thunk-} args
-\end{code}
-
-@mkVirtHeapOffsets@ always returns boxed things with smaller offsets
-than the unboxed things, and furthermore, the offsets in the result
-list
-
-\begin{code}
-mkVirtHeapOffsets
-	  :: Bool		-- True <=> is a thunk
-	  -> [(CgRep,a)]	-- Things to make offsets for
-	  -> (WordOff,		-- _Total_ number of words allocated
-	      WordOff,		-- Number of words allocated for *pointers*
-	      [(a, VirtualHpOffset)])
-				-- Things with their offsets from start of 
-				--  object in order of increasing offset
-
--- First in list gets lowest offset, which is initial offset + 1.
-
-mkVirtHeapOffsets is_thunk things
-  = let non_void_things		      = filterOut (isVoidArg . fst) things
-	(ptrs, non_ptrs)    	      = separateByPtrFollowness non_void_things
-    	(wds_of_ptrs, ptrs_w_offsets) = mapAccumL computeOffset 0 ptrs
-	(tot_wds, non_ptrs_w_offsets) = mapAccumL computeOffset wds_of_ptrs non_ptrs
-    in
-    (tot_wds, wds_of_ptrs, ptrs_w_offsets ++ non_ptrs_w_offsets)
-  where
-    hdr_size 	| is_thunk   = thunkHdrSize
-		| otherwise  = fixedHdrSize
-
-    computeOffset wds_so_far (rep, thing)
-      = (wds_so_far + cgRepSizeW rep, (thing, hdr_size + wds_so_far))
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Lay out a static closure
-%*									*
-%************************************************************************
-
-Make a static closure, adding on any extra padding needed for CAFs,
-and adding a static link field if necessary.
-
-\begin{code}
-mkStaticClosureFields 
-	:: ClosureInfo 
-	-> CostCentreStack 
-	-> Bool 		-- Has CAF refs
-	-> [CmmLit]		-- Payload
-	-> [CmmLit]		-- The full closure
-mkStaticClosureFields cl_info ccs caf_refs payload
-  = mkStaticClosure info_lbl ccs payload padding_wds 
-	static_link_field saved_info_field
-  where
-    info_lbl = infoTableLabelFromCI cl_info
-
-    -- CAFs must have consistent layout, regardless of whether they
-    -- are actually updatable or not.  The layout of a CAF is:
-    --
-    --        3 saved_info
-    --        2 static_link
-    --        1 indirectee
-    --        0 info ptr
-    --
-    -- the static_link and saved_info fields must always be in the same
-    -- place.  So we use closureNeedsUpdSpace rather than
-    -- closureUpdReqd here:
-
-    is_caf = closureNeedsUpdSpace cl_info
-
-    padding_wds
-	| not is_caf = []
-	| otherwise  = ASSERT(null payload) [mkIntCLit 0]
-
-    static_link_field
-	| is_caf || staticClosureNeedsLink cl_info = [static_link_value]
-	| otherwise				   = []
-
-    saved_info_field
-	| is_caf     = [mkIntCLit 0]
-	| otherwise  = []
-
-	-- for a static constructor which has NoCafRefs, we set the
-	-- static link field to a non-zero value so the garbage
-	-- collector will ignore it.
-    static_link_value
-	| caf_refs	= mkIntCLit 0
-	| otherwise	= mkIntCLit 1
-
-
-mkStaticClosure :: CLabel -> CostCentreStack -> [CmmLit]
-  -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]
-mkStaticClosure info_lbl ccs payload padding_wds static_link_field saved_info_field
-  =  [CmmLabel info_lbl]
-  ++ variable_header_words
-  ++ payload
-  ++ padding_wds
-  ++ static_link_field
-  ++ saved_info_field
-  where
-    variable_header_words
-	=  staticGranHdr
-	++ staticParHdr
-	++ staticProfHdr ccs
-	++ staticTickyHdr
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[CgHeapery-heap-overflow]{Heap overflow checking}
-%*									*
-%************************************************************************
-
-The new code  for heapChecks. For GrAnSim the code for doing a heap check
-and doing a context switch has been separated. Especially, the HEAP_CHK
-macro only performs a heap check. THREAD_CONTEXT_SWITCH should be used for
-doing a context switch. GRAN_FETCH_AND_RESCHEDULE must be put at the
-beginning of every slow entry code in order to simulate the fetching of
-closures. If fetching is necessary (i.e. current closure is not local) then
-an automatic context switch is done.
-
---------------------------------------------------------------
-A heap/stack check at a function or thunk entry point.
-
-\begin{code}
-funEntryChecks :: ClosureInfo -> CmmStmts -> Code -> Code
-funEntryChecks cl_info reg_save_code code 
-  = hpStkCheck cl_info True reg_save_code code
-
-thunkEntryChecks :: ClosureInfo -> Code -> Code
-thunkEntryChecks cl_info code 
-  = hpStkCheck cl_info False noStmts code
-
-hpStkCheck :: ClosureInfo	-- Function closure
-	   -> Bool 		-- Is a function? (not a thunk)
-	   -> CmmStmts		-- Register saves
-	   -> Code
-	   -> Code
-
-hpStkCheck cl_info is_fun reg_save_code code
-  =  getFinalStackHW	$ \ spHw -> do
-	{ sp <- getRealSp
-	; let stk_words = spHw - sp
-	; initHeapUsage	$ \ hpHw  -> do
-	    {	-- Emit heap checks, but be sure to do it lazily so 
-		-- that the conditionals on hpHw don't cause a black hole
-	      codeOnly $ do
-		{ do_checks stk_words hpHw full_save_code rts_label
-		; tickyAllocHeap hpHw }
-	    ; setRealHp hpHw
-	    ; code }
-	}
-  where
-    node_asst 
-	| nodeMustPointToIt (closureLFInfo cl_info)
-	= noStmts
-	| otherwise
-	= oneStmt (CmmAssign nodeReg (CmmLit (CmmLabel closure_lbl)))
-    closure_lbl = closureLabelFromCI cl_info
-
-    full_save_code = node_asst `plusStmts` reg_save_code
-
-    rts_label | is_fun    = CmmReg (CmmGlobal GCFun)
-				-- Function entry point
-	      | otherwise = CmmReg (CmmGlobal GCEnter1)
-				-- Thunk or case return
-	-- In the thunk/case-return case, R1 points to a closure
-	-- which should be (re)-entered after GC
-\end{code}
-
-Heap checks in a case alternative are nice and easy, provided this is
-a bog-standard algebraic case.  We have in our hand:
-
-       * one return address, on the stack,
-       * one return value, in Node.
-
-the canned code for this heap check failure just pushes Node on the
-stack, saying 'EnterGHC' to return.  The scheduler will return by
-entering the top value on the stack, which in turn will return through
-the return address, getting us back to where we were.  This is
-therefore only valid if the return value is *lifted* (just being
-boxed isn't good enough).
-
-For primitive returns, we have an unlifted value in some register
-(either R1 or FloatReg1 or DblReg1).  This means using specialised
-heap-check code for these cases.
-
-\begin{code}
-altHeapCheck 
-    :: AltType	-- PolyAlt, PrimAlt, AlgAlt, but *not* UbxTupAlt
-		--	(Unboxed tuples are dealt with by ubxTupleHeapCheck)
-    -> Code	-- Continuation
-    -> Code
-altHeapCheck alt_type code
-  = initHeapUsage $ \ hpHw -> do
-	{ codeOnly $ do
-	     { do_checks 0 {- no stack chk -} hpHw
-			 noStmts {- nothign to save -}
-			 (rts_label alt_type)
-	     ; tickyAllocHeap hpHw }
-	; setRealHp hpHw
-	; code }
-  where
-    rts_label PolyAlt = CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "stg_gc_unpt_r1")))
-      	-- Do *not* enter R1 after a heap check in
-	-- a polymorphic case.  It might be a function
-	-- and the entry code for a function (currently)
-	-- applies it
-	--
-	-- However R1 is guaranteed to be a pointer
-
-    rts_label (AlgAlt tc) = stg_gc_enter1
-	-- Enter R1 after the heap check; it's a pointer
- 	
-    rts_label (PrimAlt tc)
-      = CmmLit $ CmmLabel $ 
-	case primRepToCgRep (tyConPrimRep tc) of
-	  VoidArg   -> mkRtsCodeLabel SLIT( "stg_gc_noregs")
-	  FloatArg  -> mkRtsCodeLabel SLIT( "stg_gc_f1")
-	  DoubleArg -> mkRtsCodeLabel SLIT( "stg_gc_d1")
-	  LongArg   -> mkRtsCodeLabel SLIT( "stg_gc_l1")
-				-- R1 is boxed but unlifted: 
-	  PtrArg    -> mkRtsCodeLabel SLIT( "stg_gc_unpt_r1")
-				-- R1 is unboxed:
-	  NonPtrArg -> mkRtsCodeLabel SLIT( "stg_gc_unbx_r1")
-
-    rts_label (UbxTupAlt _) = panic "altHeapCheck"
-\end{code}
-
-
-Unboxed tuple alternatives and let-no-escapes (the two most annoying
-constructs to generate code for!)  For unboxed tuple returns, there
-are an arbitrary number of possibly unboxed return values, some of
-which will be in registers, and the others will be on the stack.  We
-always organise the stack-resident fields into pointers &
-non-pointers, and pass the number of each to the heap check code.
-
-\begin{code}
-unbxTupleHeapCheck 
-	:: [(Id, GlobalReg)]	-- Live registers
-	-> WordOff	-- no. of stack slots containing ptrs
-	-> WordOff	-- no. of stack slots containing nonptrs
-	-> CmmStmts	-- code to insert in the failure path
-	-> Code
-	-> Code
-
-unbxTupleHeapCheck regs ptrs nptrs fail_code code
-  -- We can't manage more than 255 pointers/non-pointers 
-  -- in a generic heap check.
-  | ptrs > 255 || nptrs > 255 = panic "altHeapCheck"
-  | otherwise 
-  = initHeapUsage $ \ hpHw -> do
-	{ codeOnly $ do { do_checks 0 {- no stack check -} hpHw
-				    full_fail_code rts_label
-			; tickyAllocHeap hpHw }
-	; setRealHp hpHw
-	; code }
-  where
-    full_fail_code  = fail_code `plusStmts` oneStmt assign_liveness
-    assign_liveness = CmmAssign (CmmGlobal (VanillaReg 9)) 	-- Ho ho ho!
-				(CmmLit (mkWordCLit liveness))
-    liveness 	    = mkRegLiveness regs ptrs nptrs
-    rts_label	    = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("stg_gc_ut")))
-
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Heap/Stack Checks.
-%*									*
-%************************************************************************
-
-When failing a check, we save a return address on the stack and
-jump to a pre-compiled code fragment that saves the live registers
-and returns to the scheduler.
-
-The return address in most cases will be the beginning of the basic
-block in which the check resides, since we need to perform the check
-again on re-entry because someone else might have stolen the resource
-in the meantime.
-
-\begin{code}
-do_checks :: WordOff	-- Stack headroom
-	  -> WordOff	-- Heap  headroom
-	  -> CmmStmts	-- Assignments to perform on failure
-	  -> CmmExpr	-- Rts address to jump to on failure
-	  -> Code
-do_checks 0 0 _ _   = nopC
-do_checks stk hp reg_save_code rts_lbl
-  = do_checks' (CmmLit (mkIntCLit (stk*wORD_SIZE))) 
-	       (CmmLit (mkIntCLit (hp*wORD_SIZE)))
-	 (stk /= 0) (hp /= 0) reg_save_code rts_lbl
-
--- The offsets are now in *bytes*
-do_checks' stk_expr hp_expr stk_nonzero hp_nonzero reg_save_code rts_lbl
-  = do	{ doGranAllocate hp_expr
-
-	-- Emit a block for the heap-check-failure code
-	; blk_id <- forkLabelledCode $ do
-			{ whenC hp_nonzero $
-				stmtC (CmmAssign (CmmGlobal HpAlloc) hp_expr)
-			; emitStmts reg_save_code
-			; stmtC (CmmJump rts_lbl []) }
-
-	-- Check for stack overflow *FIRST*; otherwise
-	-- we might bumping Hp and then failing stack oflo
-	; whenC stk_nonzero
-		(stmtC (CmmCondBranch stk_oflo blk_id))
-
-	; whenC hp_nonzero
-		(stmtsC [CmmAssign hpReg 
-				(cmmOffsetExprB (CmmReg hpReg) hp_expr),
-		        CmmCondBranch hp_oflo blk_id]) 
-		-- Bump heap pointer, and test for heap exhaustion
-		-- Note that we don't move the heap pointer unless the 
-		-- stack check succeeds.  Otherwise we might end up
-		-- with slop at the end of the current block, which can 
-		-- confuse the LDV profiler.
-    }
-  where
-	-- Stk overflow if (Sp - stk_bytes < SpLim)
-    stk_oflo = CmmMachOp mo_wordULt 
-		  [CmmMachOp mo_wordSub [CmmReg spReg, stk_expr],
-		   CmmReg (CmmGlobal SpLim)]
-
-	-- Hp overflow if (Hpp > HpLim)
-	-- (Hp has been incremented by now)
-	-- HpLim points to the LAST WORD of valid allocation space.
-    hp_oflo = CmmMachOp mo_wordUGt 
-		  [CmmReg hpReg, CmmReg (CmmGlobal HpLim)]
-\end{code}
-
-%************************************************************************
-%*									*
-     Generic Heap/Stack Checks - used in the RTS
-%*									*
-%************************************************************************
-
-\begin{code}
-hpChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
-hpChkGen bytes liveness reentry
-  = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assigns stg_gc_gen
-  where
-    assigns = mkStmts [
-    		CmmAssign (CmmGlobal (VanillaReg 9))  liveness,
-    		CmmAssign (CmmGlobal (VanillaReg 10)) reentry
-		]
-
--- a heap check where R1 points to the closure to enter on return, and
--- we want to assign to Sp[0] on failure (used in AutoApply.cmm:BUILD_PAP).
-hpChkNodePointsAssignSp0 :: CmmExpr -> CmmExpr -> Code
-hpChkNodePointsAssignSp0 bytes sp0
-  = do_checks' (CmmLit (mkIntCLit 0)) bytes False True assign stg_gc_enter1
-  where assign = oneStmt (CmmStore (CmmReg spReg) sp0)
-
-stkChkGen :: CmmExpr -> CmmExpr -> CmmExpr -> Code
-stkChkGen bytes liveness reentry
-  = do_checks' bytes (CmmLit (mkIntCLit 0)) True False assigns stg_gc_gen
-  where
-    assigns = mkStmts [
-    		CmmAssign (CmmGlobal (VanillaReg 9))  liveness,
-    		CmmAssign (CmmGlobal (VanillaReg 10)) reentry
-		]
-
-stkChkNodePoints :: CmmExpr -> Code
-stkChkNodePoints bytes
-  = do_checks' bytes (CmmLit (mkIntCLit 0)) True False noStmts stg_gc_enter1
-
-stg_gc_gen = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("stg_gc_gen")))
-stg_gc_enter1 = CmmReg (CmmGlobal GCEnter1)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[initClosure]{Initialise a dynamic closure}
-%*									*
-%************************************************************************
-
-@allocDynClosure@ puts the thing in the heap, and modifies the virtual Hp
-to account for this.
-
-\begin{code}
-allocDynClosure
-	:: ClosureInfo
-	-> CmmExpr 		-- Cost Centre to stick in the object
-	-> CmmExpr 		-- Cost Centre to blame for this alloc
-				-- (usually the same; sometimes "OVERHEAD")
-
-	-> [(CmmExpr, VirtualHpOffset)]	-- Offsets from start of the object
-					-- ie Info ptr has offset zero.
-	-> FCode VirtualHpOffset	-- Returns virt offset of object
-
-allocDynClosure cl_info use_cc blame_cc amodes_with_offsets
-  = do	{ virt_hp <- getVirtHp
-
-	-- FIND THE OFFSET OF THE INFO-PTR WORD
-	; let	info_offset = virt_hp + 1
-		-- info_offset is the VirtualHpOffset of the first
-		-- word of the new object
-		-- Remember, virtHp points to last allocated word, 
-		-- ie 1 *before* the info-ptr word of new object.
-
-		info_ptr = CmmLit (CmmLabel (infoTableLabelFromCI cl_info))
-		hdr_w_offsets = initDynHdr info_ptr use_cc `zip` [0..]
-
-	-- SAY WHAT WE ARE ABOUT TO DO
-	; profDynAlloc cl_info use_cc	
-		-- ToDo: This is almost certainly wrong
-		-- We're ignoring blame_cc. But until we've
-		-- fixed the boxing hack in chooseDynCostCentres etc,
-		-- we're worried about making things worse by "fixing"
-		-- this part to use blame_cc!
-
-	; tickyDynAlloc cl_info
-
-	-- ALLOCATE THE OBJECT
-	; base <- getHpRelOffset info_offset
-	; hpStore base (hdr_w_offsets ++ amodes_with_offsets)
-
-	-- BUMP THE VIRTUAL HEAP POINTER
-	; setVirtHp (virt_hp + closureSize cl_info)
-	
-	-- RETURN PTR TO START OF OBJECT
-	; returnFC info_offset }
-
-
-initDynHdr :: CmmExpr 
-	   -> CmmExpr		-- Cost centre to put in object
-	   -> [CmmExpr]
-initDynHdr info_ptr cc
-  =  [info_ptr]
-     	-- ToDo: Gransim stuff
-	-- ToDo: Parallel stuff
-  ++ dynProfHdr cc
-	-- No ticky header
-
-hpStore :: CmmExpr -> [(CmmExpr, VirtualHpOffset)] -> Code
--- Store the item (expr,off) in base[off]
-hpStore base es
-  = stmtsC [ CmmStore (cmmOffsetW base off) val 
-	   | (val, off) <- es ]
-
-emitSetDynHdr :: CmmExpr -> CmmExpr -> CmmExpr -> Code
-emitSetDynHdr base info_ptr ccs 
-  = hpStore base (zip (initDynHdr info_ptr ccs) [0..])
-\end{code}
diff --git a/ghc/compiler/codeGen/CgInfoTbls.hs b/ghc/compiler/codeGen/CgInfoTbls.hs
deleted file mode 100644
index b769950d87..0000000000
--- a/ghc/compiler/codeGen/CgInfoTbls.hs
+++ /dev/null
@@ -1,591 +0,0 @@
------------------------------------------------------------------------------
---
--- Building info tables.
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
-module CgInfoTbls (
-	emitClosureCodeAndInfoTable,
-	emitInfoTableAndCode,
-	dataConTagZ,
-	getSRTInfo,
-	emitDirectReturnTarget, emitAlgReturnTarget,
-	emitDirectReturnInstr, emitVectoredReturnInstr,
-	mkRetInfoTable,
-	mkStdInfoTable,
-	stdInfoTableSizeB,
-	mkFunGenInfoExtraBits,
-	entryCode, closureInfoPtr,
-	getConstrTag,
-	infoTable, infoTableClosureType,
-	infoTablePtrs, infoTableNonPtrs,
-	funInfoTable,
-	retVec
-  ) where
-
-
-#include "HsVersions.h"
-
-import ClosureInfo	( ClosureInfo, closureTypeDescr, closureName,
-			  infoTableLabelFromCI, Liveness,
-			  closureValDescr, closureSRT, closureSMRep,
-			  closurePtrsSize, closureNonHdrSize, closureFunInfo,
-			  C_SRT(..), needsSRT, isConstrClosure_maybe,
-			  ArgDescr(..) )
-import SMRep		( StgHalfWord, hALF_WORD_SIZE_IN_BITS, hALF_WORD_SIZE,
-			  WordOff, ByteOff,
-			  smRepClosureTypeInt, tablesNextToCode,
-			  rET_BIG, rET_SMALL, rET_VEC_BIG, rET_VEC_SMALL )
-import CgBindery	( getLiveStackSlots )
-import CgCallConv	( isBigLiveness, mkLivenessCLit, buildContLiveness,
-			  argDescrType, getSequelAmode,
-			  CtrlReturnConvention(..) )
-import CgUtils		( mkStringCLit, packHalfWordsCLit, mkWordCLit, 
-			  cmmOffsetB, cmmOffsetExprW, cmmLabelOffW, cmmOffsetW,
-			  emitDataLits, emitRODataLits, emitSwitch, cmmNegate,
-			  newTemp )
-import CgMonad
-
-import CmmUtils		( mkIntCLit, zeroCLit )
-import Cmm		( CmmStmt(..), CmmExpr(..), CmmLit(..), LocalReg,
-			  CmmBasicBlock, nodeReg )
-import MachOp		( MachOp(..), wordRep, halfWordRep )
-import CLabel
-import StgSyn		( SRT(..) )
-import Name		( Name )
-import DataCon		( DataCon, dataConTag, fIRST_TAG )
-import Unique		( Uniquable(..) )
-import DynFlags		( DynFlags(..), HscTarget(..) )
-import StaticFlags	( opt_SccProfilingOn )
-import ListSetOps	( assocDefault )
-import Maybes		( isJust )
-import Constants	( wORD_SIZE, sIZEOF_StgFunInfoExtraRev )
-import Outputable
-
-
--------------------------------------------------------------------------
---
---	Generating the info table and code for a closure
---
--------------------------------------------------------------------------
-
--- Here we make a concrete info table, represented as a list of CmmAddr
--- (it can't be simply a list of Word, because the SRT field is
--- represented by a label+offset expression).
-
--- With tablesNextToCode, the layout is
---	<reversed variable part>
---	<normal forward StgInfoTable, but without 
---		an entry point at the front>
---	<code>
---
--- Without tablesNextToCode, the layout of an info table is
---	<entry label>
---	<normal forward rest of StgInfoTable>
---	<forward variable part>
---
---	See includes/InfoTables.h
-
-emitClosureCodeAndInfoTable :: ClosureInfo -> [LocalReg] -> CgStmts -> Code
-emitClosureCodeAndInfoTable cl_info args body
- = do	{ ty_descr_lit <- 
-		if opt_SccProfilingOn 
-		   then mkStringCLit (closureTypeDescr cl_info)
-		   else return (mkIntCLit 0)
-  	; cl_descr_lit <- 
-		if opt_SccProfilingOn 
-		   then mkStringCLit cl_descr_string
-		   else return (mkIntCLit 0)
-	; let std_info = mkStdInfoTable ty_descr_lit cl_descr_lit 
-					cl_type srt_len layout_lit
-
-	; blks <- cgStmtsToBlocks body
-	; emitInfoTableAndCode info_lbl std_info extra_bits args blks }
-  where
-    info_lbl  = infoTableLabelFromCI cl_info
-
-    cl_descr_string = closureValDescr cl_info
-    cl_type = smRepClosureTypeInt (closureSMRep cl_info)
-
-    srt = closureSRT cl_info	     
-    needs_srt = needsSRT srt
-
-    mb_con = isConstrClosure_maybe  cl_info
-    is_con = isJust mb_con
-
-    (srt_label,srt_len)
-	= case mb_con of
-	    Just con -> -- Constructors don't have an SRT
-			-- We keep the *zero-indexed* tag in the srt_len
-			-- field of the info table. 
-			(mkIntCLit 0, fromIntegral (dataConTagZ con)) 
-
-	    Nothing  -> -- Not a constructor
-			srtLabelAndLength srt info_lbl
-
-    ptrs       = closurePtrsSize cl_info
-    nptrs      = size - ptrs
-    size       = closureNonHdrSize cl_info
-    layout_lit = packHalfWordsCLit ptrs nptrs
-
-    extra_bits
-	| is_fun    = fun_extra_bits
-	| is_con    = []
-	| needs_srt = [srt_label]
- 	| otherwise = []
-
-    maybe_fun_stuff = closureFunInfo cl_info
-    is_fun = isJust maybe_fun_stuff
-    (Just (arity, arg_descr)) = maybe_fun_stuff
-
-    fun_extra_bits
-	| ArgGen liveness <- arg_descr
-	= [ fun_amode,
-	    srt_label,
-	    makeRelativeRefTo info_lbl $ mkLivenessCLit liveness, 
-	    slow_entry ]
-	| needs_srt = [fun_amode, srt_label]
-	| otherwise = [fun_amode]
-
-    slow_entry = makeRelativeRefTo info_lbl (CmmLabel slow_entry_label)
-    slow_entry_label = mkSlowEntryLabel (closureName cl_info)
-
-    fun_amode = packHalfWordsCLit fun_type arity
-    fun_type  = argDescrType arg_descr
-
--- We keep the *zero-indexed* tag in the srt_len field of the info
--- table of a data constructor.
-dataConTagZ :: DataCon -> ConTagZ
-dataConTagZ con = dataConTag con - fIRST_TAG
-
--- A low-level way to generate the variable part of a fun-style info table.
--- (must match fun_extra_bits above).  Used by the C-- parser.
-mkFunGenInfoExtraBits :: Int -> Int -> CmmLit -> CmmLit -> CmmLit -> [CmmLit]
-mkFunGenInfoExtraBits fun_type arity srt_label liveness slow_entry
-  = [ packHalfWordsCLit fun_type arity,
-      srt_label,
-      liveness,
-      slow_entry ]
-
--------------------------------------------------------------------------
---
---	Generating the info table and code for a return point
---
--------------------------------------------------------------------------
-
---	Here's the layout of a return-point info table
---
--- Tables next to code:
---
---			<reversed vector table>
---			<srt slot>
---			<standard info table>
---  	ret-addr -->	<entry code (if any)>
---
--- Not tables-next-to-code:
---
---	ret-addr -->	<ptr to entry code>
---			<standard info table>
---			<srt slot>
---			<forward vector table>
---
---  * The vector table is only present for vectored returns
---
---  * The SRT slot is only there if either
---	(a) there is SRT info to record, OR
---	(b) if the return is vectored
---   The latter (b) is necessary so that the vector is in a
---   predictable place
-
-vectorSlot :: CmmExpr -> CmmExpr -> CmmExpr
--- Get the vector slot from the info pointer
-vectorSlot info_amode zero_indexed_tag
-  | tablesNextToCode 
-  = cmmOffsetExprW (cmmOffsetW info_amode (- (stdInfoTableSizeW + 2)))
-		   (cmmNegate zero_indexed_tag)
-	-- The "2" is one for the SRT slot, and one more 
-	-- to get to the first word of the vector
-
-  | otherwise 
-  = cmmOffsetExprW (cmmOffsetW info_amode (stdInfoTableSizeW + 2))
-		   zero_indexed_tag
-	-- The "2" is one for the entry-code slot and one for the SRT slot
-
-retVec :: CmmExpr -> CmmExpr -> CmmExpr
--- Get a return vector from the info pointer
-retVec info_amode zero_indexed_tag
-  = let slot = vectorSlot info_amode zero_indexed_tag
-        tableEntry = CmmLoad slot wordRep
-    in if tablesNextToCode
-           then CmmMachOp (MO_Add wordRep) [tableEntry, info_amode]
-           else tableEntry
-           
-emitReturnTarget
-   :: Name
-   -> CgStmts			-- The direct-return code (if any)
-				--    	(empty for vectored returns)
-   -> [CmmLit]			-- Vector of return points 
-				-- 	(empty for non-vectored returns)
-   -> SRT
-   -> FCode CLabel
-emitReturnTarget name stmts vector srt
-  = do	{ live_slots <- getLiveStackSlots
-	; liveness   <- buildContLiveness name live_slots
-	; srt_info   <- getSRTInfo name srt
-
-	; let
-	      cl_type = case (null vector, isBigLiveness liveness) of
-	 		 (True,  True)  -> rET_BIG
- 			 (True,  False) -> rET_SMALL
- 			 (False, True)  -> rET_VEC_BIG
-	 		 (False, False) -> rET_VEC_SMALL
- 
-	      (std_info, extra_bits) = 
-		   mkRetInfoTable info_lbl liveness srt_info cl_type vector
-
-	; blks <- cgStmtsToBlocks stmts
-	; emitInfoTableAndCode info_lbl std_info extra_bits args blks
-	; return info_lbl }
-  where
-    args      = {- trace "emitReturnTarget: missing args" -} []
-    uniq      = getUnique name
-    info_lbl  = mkReturnInfoLabel uniq
-
-
-mkRetInfoTable
-  :: CLabel             -- info label
-  -> Liveness		-- liveness
-  -> C_SRT		-- SRT Info
-  -> Int		-- type (eg. rET_SMALL)
-  -> [CmmLit]		-- vector
-  -> ([CmmLit],[CmmLit])
-mkRetInfoTable info_lbl liveness srt_info cl_type vector
-  =  (std_info, extra_bits)
-  where
-	(srt_label, srt_len) = srtLabelAndLength srt_info info_lbl
- 
-	srt_slot | need_srt  = [srt_label]
-	         | otherwise = []
-
-	need_srt = needsSRT srt_info || not (null vector)
-		-- If there's a vector table then we must allocate
-		-- an SRT slot, so that the vector table is at a 
-		-- known offset from the info pointer
- 
-	liveness_lit = makeRelativeRefTo info_lbl $ mkLivenessCLit liveness
-	std_info = mkStdInfoTable zeroCLit zeroCLit cl_type srt_len liveness_lit
-        extra_bits = srt_slot ++ map (makeRelativeRefTo info_lbl) vector
-
-
-emitDirectReturnTarget
-   :: Name
-   -> CgStmts		-- The direct-return code
-   -> SRT
-   -> FCode CLabel
-emitDirectReturnTarget name code srt
-  = emitReturnTarget name code [] srt
-
-emitAlgReturnTarget
-	:: Name				-- Just for its unique
-	-> [(ConTagZ, CgStmts)]		-- Tagged branches
-	-> Maybe CgStmts		-- Default branch (if any)
-	-> SRT				-- Continuation's SRT
-	-> CtrlReturnConvention
-	-> FCode (CLabel, SemiTaggingStuff)
-
-emitAlgReturnTarget name branches mb_deflt srt ret_conv
-  = case ret_conv of
-      UnvectoredReturn fam_sz -> do	
-	{ blks <- getCgStmts $
-		    emitSwitch tag_expr branches mb_deflt 0 (fam_sz - 1)
-		-- NB: tag_expr is zero-based
-	; lbl <- emitDirectReturnTarget name blks srt 
-	; return (lbl, Nothing) }
-		-- Nothing: the internal branches in the switch don't have
-		-- global labels, so we can't use them at the 'call site'
-
-      VectoredReturn fam_sz -> do
-	{ let tagged_lbls = zip (map fst branches) $
-	                    map (CmmLabel . mkAltLabel uniq . fst) branches
-	      deflt_lbl | isJust mb_deflt = CmmLabel $ mkDefaultLabel uniq
-	                | otherwise       = mkIntCLit 0
-	; let vector = [ assocDefault deflt_lbl tagged_lbls i 
-		       | i <- [0..fam_sz-1]]
-	; lbl <- emitReturnTarget name noCgStmts vector srt 
-	; mapFCs emit_alt branches
-	; emit_deflt mb_deflt
-	; return (lbl, Just (tagged_lbls, deflt_lbl)) }
-  where
-    uniq = getUnique name 
-    tag_expr = getConstrTag (CmmReg nodeReg)
-
-    emit_alt :: (Int, CgStmts) -> FCode (Int, CmmLit)
-	-- Emit the code for the alternative as a top-level
-	-- code block returning a label for it
-    emit_alt (tag, stmts) = do	 { let lbl = mkAltLabel uniq tag
-				 ; blks <- cgStmtsToBlocks stmts
-				 ; emitProc [] lbl [] blks
-				 ; return (tag, CmmLabel lbl) }
-
-    emit_deflt (Just stmts) = do { let lbl = mkDefaultLabel uniq
-				 ; blks <- cgStmtsToBlocks stmts
-				 ; emitProc [] lbl [] blks
-				 ; return (CmmLabel lbl) }
-    emit_deflt Nothing = return (mkIntCLit 0)
-		-- Nothing case: the simplifier might have eliminated a case
-		-- 		 so we may have e.g. case xs of 
-		--					 [] -> e
-		-- In that situation the default should never be taken, 
-		-- so we just use a NULL pointer
-
---------------------------------
-emitDirectReturnInstr :: Code
-emitDirectReturnInstr 
-  = do 	{ info_amode <- getSequelAmode
-	; stmtC (CmmJump (entryCode info_amode) []) }
-
-emitVectoredReturnInstr :: CmmExpr	-- _Zero-indexed_ constructor tag
-			-> Code
-emitVectoredReturnInstr zero_indexed_tag
-  = do	{ info_amode <- getSequelAmode
-		-- HACK! assign info_amode to a temp, because retVec
-		-- uses it twice and the NCG doesn't have any CSE yet.
-		-- Only do this for the NCG, because gcc is too stupid
-		-- to optimise away the extra tmp (grrr).
-	; dflags <- getDynFlags
-	; x <- if hscTarget dflags == HscAsm
-		   then do z <- newTemp wordRep
-			   stmtC (CmmAssign z info_amode)
-			   return (CmmReg z)
-		   else
-			return info_amode
-	; let target = retVec x zero_indexed_tag
-	; stmtC (CmmJump target []) }
-
-
--------------------------------------------------------------------------
---
---	Generating a standard info table
---
--------------------------------------------------------------------------
-
--- The standard bits of an info table.  This part of the info table
--- corresponds to the StgInfoTable type defined in InfoTables.h.
---
--- Its shape varies with ticky/profiling/tables next to code etc
--- so we can't use constant offsets from Constants
-
-mkStdInfoTable
-   :: CmmLit		-- closure type descr (profiling)
-   -> CmmLit		-- closure descr (profiling)
-   -> Int		-- closure type
-   -> StgHalfWord	-- SRT length
-   -> CmmLit		-- layout field
-   -> [CmmLit]
-
-mkStdInfoTable type_descr closure_descr cl_type srt_len layout_lit
- = 	-- Parallel revertible-black hole field
-    prof_info
-	-- Ticky info (none at present)
-	-- Debug info (none at present)
- ++ [layout_lit, type_lit]
-
- where  
-    prof_info 
-	| opt_SccProfilingOn = [type_descr, closure_descr]
-	| otherwise	     = []
-
-    type_lit = packHalfWordsCLit cl_type srt_len
-	
-stdInfoTableSizeW :: WordOff
--- The size of a standard info table varies with profiling/ticky etc,
--- so we can't get it from Constants
--- It must vary in sync with mkStdInfoTable
-stdInfoTableSizeW
-  = size_fixed + size_prof
-  where
-    size_fixed = 2	-- layout, type
-    size_prof | opt_SccProfilingOn = 2
-	      | otherwise	   = 0
-
-stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE :: ByteOff
-
-stdSrtBitmapOffset :: ByteOff
--- Byte offset of the SRT bitmap half-word which is 
--- in the *higher-addressed* part of the type_lit
-stdSrtBitmapOffset = stdInfoTableSizeB - hALF_WORD_SIZE
-
-stdClosureTypeOffset :: ByteOff
--- Byte offset of the closure type half-word 
-stdClosureTypeOffset = stdInfoTableSizeB - wORD_SIZE
-
-stdPtrsOffset, stdNonPtrsOffset :: ByteOff
-stdPtrsOffset    = stdInfoTableSizeB - 2*wORD_SIZE
-stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
-
--------------------------------------------------------------------------
---
---	Accessing fields of an info table
---
--------------------------------------------------------------------------
-
-closureInfoPtr :: CmmExpr -> CmmExpr
--- Takes a closure pointer and returns the info table pointer
-closureInfoPtr e = CmmLoad e wordRep
-
-entryCode :: CmmExpr -> CmmExpr
--- Takes an info pointer (the first word of a closure)
--- and returns its entry code
-entryCode e | tablesNextToCode = e
-	    | otherwise	       = CmmLoad e wordRep
-
-getConstrTag :: CmmExpr -> CmmExpr
--- Takes a closure pointer, and return the *zero-indexed*
--- constructor tag obtained from the info table
--- This lives in the SRT field of the info table
--- (constructors don't need SRTs).
-getConstrTag closure_ptr 
-  = CmmMachOp (MO_U_Conv halfWordRep wordRep) [infoTableConstrTag info_table]
-  where
-    info_table = infoTable (closureInfoPtr closure_ptr)
-
-infoTable :: CmmExpr -> CmmExpr
--- Takes an info pointer (the first word of a closure)
--- and returns a pointer to the first word of the standard-form
--- info table, excluding the entry-code word (if present)
-infoTable info_ptr
-  | tablesNextToCode = cmmOffsetB info_ptr (- stdInfoTableSizeB)
-  | otherwise	     = cmmOffsetW info_ptr 1	-- Past the entry code pointer
-
-infoTableConstrTag :: CmmExpr -> CmmExpr
--- Takes an info table pointer (from infoTable) and returns the constr tag
--- field of the info table (same as the srt_bitmap field)
-infoTableConstrTag = infoTableSrtBitmap
-
-infoTableSrtBitmap :: CmmExpr -> CmmExpr
--- Takes an info table pointer (from infoTable) and returns the srt_bitmap
--- field of the info table
-infoTableSrtBitmap info_tbl
-  = CmmLoad (cmmOffsetB info_tbl stdSrtBitmapOffset) halfWordRep
-
-infoTableClosureType :: CmmExpr -> CmmExpr
--- Takes an info table pointer (from infoTable) and returns the closure type
--- field of the info table.
-infoTableClosureType info_tbl 
-  = CmmLoad (cmmOffsetB info_tbl stdClosureTypeOffset) halfWordRep
-
-infoTablePtrs :: CmmExpr -> CmmExpr
-infoTablePtrs info_tbl 
-  = CmmLoad (cmmOffsetB info_tbl stdPtrsOffset) halfWordRep
-
-infoTableNonPtrs :: CmmExpr -> CmmExpr
-infoTableNonPtrs info_tbl 
-  = CmmLoad (cmmOffsetB info_tbl stdNonPtrsOffset) halfWordRep
-
-funInfoTable :: CmmExpr -> CmmExpr
--- Takes the info pointer of a function,
--- and returns a pointer to the first word of the StgFunInfoExtra struct
--- in the info table.
-funInfoTable info_ptr
-  | tablesNextToCode
-  = cmmOffsetB info_ptr (- stdInfoTableSizeB - sIZEOF_StgFunInfoExtraRev)
-  | otherwise
-  = cmmOffsetW info_ptr (1 + stdInfoTableSizeW)
-				-- Past the entry code pointer
-
--------------------------------------------------------------------------
---
---	Emit the code for a closure (or return address)
---	and its associated info table
---
--------------------------------------------------------------------------
-
--- The complication here concerns whether or not we can
--- put the info table next to the code
-
-emitInfoTableAndCode 
-	:: CLabel 		-- Label of info table
-	-> [CmmLit]		-- ...its invariant part
-	-> [CmmLit] 		-- ...and its variant part
-	-> [LocalReg]		-- ...args
-	-> [CmmBasicBlock]	-- ...and body
-	-> Code
-
-emitInfoTableAndCode info_lbl std_info extra_bits args blocks
-  | tablesNextToCode 	-- Reverse the extra_bits; and emit the top-level proc
-  = emitProc (reverse extra_bits ++ std_info) 
-	     entry_lbl args blocks
-	-- NB: the info_lbl is discarded
-
-  | null blocks -- No actual code; only the info table is significant
-  =		-- Use a zero place-holder in place of the 
-		-- entry-label in the info table
-    emitRODataLits info_lbl (zeroCLit : std_info ++ extra_bits)
-
-  | otherwise	-- Separately emit info table (with the function entry 
-  =		-- point as first entry) and the entry code 
-    do	{ emitDataLits info_lbl (CmmLabel entry_lbl : std_info ++ extra_bits)
-	; emitProc [] entry_lbl args blocks }
-
-  where
-	entry_lbl = infoLblToEntryLbl info_lbl
-
--------------------------------------------------------------------------
---
---	Static reference tables
---
--------------------------------------------------------------------------
-
--- There is just one SRT for each top level binding; all the nested
--- bindings use sub-sections of this SRT.  The label is passed down to
--- the nested bindings via the monad.
-
-getSRTInfo :: Name -> SRT -> FCode C_SRT
-getSRTInfo id NoSRT = return NoC_SRT
-getSRTInfo id (SRT off len bmp)
-  | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
-  = do	{ srt_lbl <- getSRTLabel
-	; let srt_desc_lbl = mkSRTDescLabel id
-	; emitRODataLits srt_desc_lbl
-		   ( cmmLabelOffW srt_lbl off
-		   : mkWordCLit (fromIntegral len)
-		   : map mkWordCLit bmp)
-	; return (C_SRT srt_desc_lbl 0 srt_escape) }
-
-  | otherwise 
-  = do	{ srt_lbl <- getSRTLabel
-	; return (C_SRT srt_lbl off (fromIntegral (head bmp))) }
-		-- The fromIntegral converts to StgHalfWord
-
-srt_escape = (-1) :: StgHalfWord
-
-srtLabelAndLength :: C_SRT -> CLabel -> (CmmLit, StgHalfWord)
-srtLabelAndLength NoC_SRT _		
-  = (zeroCLit, 0)
-srtLabelAndLength (C_SRT lbl off bitmap) info_lbl
-  = (makeRelativeRefTo info_lbl $ cmmLabelOffW lbl off, bitmap)
-
--------------------------------------------------------------------------
---
---	Position independent code
---
--------------------------------------------------------------------------
--- In order to support position independent code, we mustn't put absolute
--- references into read-only space. Info tables in the tablesNextToCode
--- case must be in .text, which is read-only, so we doctor the CmmLits
--- to use relative offsets instead.
-
--- Note that this is done even when the -fPIC flag is not specified,
--- as we want to keep binary compatibility between PIC and non-PIC.
-
-makeRelativeRefTo :: CLabel -> CmmLit -> CmmLit
-        
-makeRelativeRefTo info_lbl (CmmLabel lbl)
-  | tablesNextToCode
-  = CmmLabelDiffOff lbl info_lbl 0
-makeRelativeRefTo info_lbl (CmmLabelOff lbl off)
-  | tablesNextToCode
-  = CmmLabelDiffOff lbl info_lbl off
-makeRelativeRefTo _ lit = lit
diff --git a/ghc/compiler/codeGen/CgLetNoEscape.lhs b/ghc/compiler/codeGen/CgLetNoEscape.lhs
deleted file mode 100644
index 39860f4ee0..0000000000
--- a/ghc/compiler/codeGen/CgLetNoEscape.lhs
+++ /dev/null
@@ -1,212 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-% $Id: CgLetNoEscape.lhs,v 1.26 2004/09/30 10:35:47 simonpj Exp $
-%
-%********************************************************
-%*							*
-\section[CgLetNoEscape]{Handling ``let-no-escapes''}
-%*							*
-%********************************************************
-
-\begin{code}
-module CgLetNoEscape ( cgLetNoEscapeClosure ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} CgExpr ( cgExpr )
-
-import StgSyn
-import CgMonad
-
-import CgBindery	( CgIdInfo, letNoEscapeIdInfo, nukeDeadBindings	)
-import CgCase		( restoreCurrentCostCentre )
-import CgCon		( bindUnboxedTupleComponents )
-import CgHeapery	( unbxTupleHeapCheck )
-import CgInfoTbls	( emitDirectReturnTarget )
-import CgStackery	( allocStackTop, deAllocStackTop, getSpRelOffset )
-import Cmm		( CmmStmt(..) )
-import CmmUtils		( mkLblExpr, oneStmt )
-import CLabel		( mkReturnInfoLabel )
-import ClosureInfo	( mkLFLetNoEscape )
-import CostCentre       ( CostCentreStack )
-import Id		( Id, idName )
-import Var		( idUnique )
-import SMRep		( retAddrSizeW )
-import BasicTypes	( RecFlag(..) )
-import Outputable
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[what-is-non-escaping]{What {\em is} a ``non-escaping let''?}
-%*									*
-%************************************************************************
-
-[The {\em code} that detects these things is elsewhere.]
-
-Consider:
-\begin{verbatim}
-	let x = fvs \ args -> e
-	in
-	 	if ... then x else
-		if ... then x else ...
-\end{verbatim}
-@x@ is used twice (so we probably can't unfold it), but when it is
-entered, the stack is deeper than it was when the definition of @x@
-happened.  Specifically, if instead of allocating a closure for @x@,
-we saved all @x@'s fvs on the stack, and remembered the stack depth at
-that moment, then whenever we enter @x@ we can simply set the stack
-pointer(s) to these remembered (compile-time-fixed) values, and jump
-to the code for @x@.
-
-All of this is provided x is:
-\begin{enumerate}
-\item
-non-updatable;
-\item
-guaranteed to be entered before the stack retreats -- ie x is not
-buried in a heap-allocated closure, or passed as an argument to something;
-\item
-all the enters have exactly the right number of arguments,
-no more no less;
-\item
-all the enters are tail calls; that is, they return to the
-caller enclosing the definition of @x@.
-\end{enumerate}
-
-Under these circumstances we say that @x@ is {\em non-escaping}.
-
-An example of when (4) does {\em not} hold:
-\begin{verbatim}
-	let x = ...
-	in case x of ...alts...
-\end{verbatim}
-
-Here, @x@ is certainly entered only when the stack is deeper than when
-@x@ is defined, but here it must return to \tr{...alts...} So we can't
-just adjust the stack down to @x@'s recalled points, because that
-would lost @alts@' context.
-
-Things can get a little more complicated.  Consider:
-\begin{verbatim}
-	let y = ...
-	in let x = fvs \ args -> ...y...
-	in ...x...
-\end{verbatim}
-
-Now, if @x@ is used in a non-escaping way in \tr{...x...}, {\em and}
-@y@ is used in a non-escaping way in \tr{...y...}, {\em then} @y@ is
-non-escaping.
-
-@x@ can even be recursive!  Eg:
-\begin{verbatim}
-	letrec x = [y] \ [v] -> if v then x True else ...
-	in
-		...(x b)...
-\end{verbatim}
-
-
-%************************************************************************
-%*									*
-\subsection[codeGen-for-non-escaping]{Generating code for a ``non-escaping let''}
-%*									*
-%************************************************************************
-
-
-Generating code for this is fun.  It is all very very similar to what
-we do for a case expression.  The duality is between
-\begin{verbatim}
-	let-no-escape x = b
-	in e
-\end{verbatim}
-and
-\begin{verbatim}
-	case e of ... -> b
-\end{verbatim}
-
-That is, the RHS of @x@ (ie @b@) will execute {\em later}, just like
-the alternative of the case; it needs to be compiled in an environment
-in which all volatile bindings are forgotten, and the free vars are
-bound only to stable things like stack locations..  The @e@ part will
-execute {\em next}, just like the scrutinee of a case.
-
-First, we need to save all @x@'s free vars
-on the stack, if they aren't there already.
-
-\begin{code}
-cgLetNoEscapeClosure
-	:: Id			-- binder
-	-> CostCentreStack   	-- NB: *** NOT USED *** ToDo (WDP 94/06)
-	-> StgBinderInfo	-- NB: ditto
-	-> SRT
-	-> StgLiveVars		-- variables live in RHS, including the binders
-				-- themselves in the case of a recursive group
-	-> EndOfBlockInfo       -- where are we going to?
-	-> Maybe VirtualSpOffset -- Slot for current cost centre
-	-> RecFlag		-- is the binding recursive?
-	-> [Id]			-- args (as in \ args -> body)
-    	-> StgExpr		-- body (as in above)
-	-> FCode (Id, CgIdInfo)
-
--- ToDo: deal with the cost-centre issues
-
-cgLetNoEscapeClosure 
-	bndr cc binder_info srt full_live_in_rhss 
-	rhs_eob_info cc_slot rec args body
-  = let
-	arity   = length args
-	lf_info = mkLFLetNoEscape arity
-    in
-    -- saveVolatileVarsAndRegs done earlier in cgExpr.
-
-    do  { (vSp, _) <- forkEvalHelp rhs_eob_info
-
-		(do { allocStackTop retAddrSizeW
-		    ; nukeDeadBindings full_live_in_rhss })
-
-		(do { deAllocStackTop retAddrSizeW
-		    ; abs_c <- forkProc $ cgLetNoEscapeBody bndr cc 
-						  cc_slot args body
-
-			-- Ignore the label that comes back from
-			-- mkRetDirectTarget.  It must be conjured up elswhere
-		    ; emitDirectReturnTarget (idName bndr) abs_c srt
-		    ; return () })
-
-	; returnFC (bndr, letNoEscapeIdInfo bndr vSp lf_info) }
-\end{code}
-
-\begin{code}
-cgLetNoEscapeBody :: Id		-- Name of the joint point
-		  -> CostCentreStack
-		  -> Maybe VirtualSpOffset
-		  -> [Id]	-- Args
-		  -> StgExpr	-- Body
-		  -> Code
-
-cgLetNoEscapeBody bndr cc cc_slot all_args body = do
-  { (arg_regs, ptrs, nptrs, ret_slot) <- bindUnboxedTupleComponents all_args
-
-     -- restore the saved cost centre.  BUT: we must not free the stack slot
-     -- containing the cost centre, because it might be needed for a
-     -- recursive call to this let-no-escape.
-  ; restoreCurrentCostCentre cc_slot False{-don't free-}
-
-	-- Enter the closures cc, if required
-  ; -- enterCostCentreCode closure_info cc IsFunction
-
- 	-- The "return address" slot doesn't have a return address in it;
-	-- but the heap-check needs it filled in if the heap-check fails.
-	-- So we pass code to fill it in to the heap-check macro
-  ; sp_rel <- getSpRelOffset ret_slot
-
-  ; let	lbl 	       = mkReturnInfoLabel (idUnique bndr)
-	frame_hdr_asst = oneStmt (CmmStore sp_rel (mkLblExpr lbl))
-
-	-- Do heap check [ToDo: omit for non-recursive case by recording in
-	--	in envt and absorbing at call site]
-  ; unbxTupleHeapCheck arg_regs ptrs nptrs frame_hdr_asst 
-			(cgExpr body)
-  }
-\end{code}
diff --git a/ghc/compiler/codeGen/CgMonad.lhs b/ghc/compiler/codeGen/CgMonad.lhs
deleted file mode 100644
index 4f95c9b36a..0000000000
--- a/ghc/compiler/codeGen/CgMonad.lhs
+++ /dev/null
@@ -1,853 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-% $Id: CgMonad.lhs,v 1.45 2005/06/21 10:44:41 simonmar Exp $
-%
-\section[CgMonad]{The code generation monad}
-
-See the beginning of the top-level @CodeGen@ module, to see how this
-monadic stuff fits into the Big Picture.
-
-\begin{code}
-module CgMonad (
-	Code,	-- type
-	FCode,	-- type
-
-	initC, thenC, thenFC, listCs, listFCs, mapCs, mapFCs,
-	returnFC, fixC, checkedAbsC, 
-	stmtC, stmtsC, labelC, emitStmts, nopC, whenC, newLabelC,
-	newUnique, newUniqSupply, 
-
-	CgStmts, emitCgStmts, forkCgStmts, cgStmtsToBlocks,
-	getCgStmts', getCgStmts,
-	noCgStmts, oneCgStmt, consCgStmt,
-
-	getCmm,
-	emitData, emitProc, emitSimpleProc,
-
-	forkLabelledCode,
-	forkClosureBody, forkStatics, forkAlts, forkEval,
-	forkEvalHelp, forkProc, codeOnly,
-	SemiTaggingStuff, ConTagZ,
-
-	EndOfBlockInfo(..),
-	setEndOfBlockInfo, getEndOfBlockInfo,
-
-	setSRTLabel, getSRTLabel, 
-	setTickyCtrLabel, getTickyCtrLabel,
-
-	StackUsage(..), HeapUsage(..),
-	VirtualSpOffset, VirtualHpOffset,
-	initStkUsage, initHpUsage,
-	getHpUsage,  setHpUsage,
-	heapHWM,
-
-	moduleName,
-
-	Sequel(..), -- ToDo: unabstract?
-
-	-- ideally we wouldn't export these, but some other modules access internal state
-	getState, setState, getInfoDown, getDynFlags, getHomeModules,
-
-	-- more localised access to monad state	
-	getStkUsage, setStkUsage,
-	getBinds, setBinds, getStaticBinds,
-
-	-- out of general friendliness, we also export ...
-	CgInfoDownwards(..), CgState(..)	-- non-abstract
-    ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} CgBindery ( CgBindings, nukeVolatileBinds )
-
-import DynFlags		( DynFlags )
-import Packages		( HomeModules )
-import Cmm
-import CmmUtils		( CmmStmts, isNopStmt )
-import CLabel
-import SMRep		( WordOff )
-import Module		( Module )
-import Id		( Id )
-import VarEnv
-import OrdList
-import Unique		( Unique )
-import Util		( mapAccumL )
-import UniqSupply	( UniqSupply, mkSplitUniqSupply, splitUniqSupply, uniqFromSupply )
-import FastString
-import Outputable
-
-import Control.Monad	( liftM )
-
-infixr 9 `thenC`	-- Right-associative!
-infixr 9 `thenFC`
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[CgMonad-environment]{Stuff for manipulating environments}
-%*									*
-%************************************************************************
-
-This monadery has some information that it only passes {\em
-downwards}, as well as some ``state'' which is modified as we go
-along.
-
-\begin{code}
-data CgInfoDownwards	-- information only passed *downwards* by the monad
-  = MkCgInfoDown {
-	cgd_dflags  :: DynFlags,
-	cgd_hmods   :: HomeModules,	-- Packages we depend on
-	cgd_mod     :: Module,		-- Module being compiled
-	cgd_statics :: CgBindings,	-- [Id -> info] : static environment
-	cgd_srt     :: CLabel,		-- label of the current SRT
-	cgd_ticky   :: CLabel,		-- current destination for ticky counts
-	cgd_eob     :: EndOfBlockInfo	-- Info for stuff to do at end of basic block:
-  }
-
-initCgInfoDown :: DynFlags -> HomeModules -> Module -> CgInfoDownwards
-initCgInfoDown dflags hmods mod
-  = MkCgInfoDown {	cgd_dflags  = dflags,
-			cgd_hmods   = hmods,
-			cgd_mod     = mod,
-			cgd_statics = emptyVarEnv,
-			cgd_srt     = error "initC: srt",
-			cgd_ticky   = mkTopTickyCtrLabel,
-			cgd_eob     = initEobInfo }
-
-data CgState
-  = MkCgState {
-     cgs_stmts :: OrdList CgStmt,	  -- Current proc
-     cgs_tops  :: OrdList CmmTop,
-	-- Other procedures and data blocks in this compilation unit
-	-- Both the latter two are ordered only so that we can 
-	-- reduce forward references, when it's easy to do so
-     
-     cgs_binds :: CgBindings,	-- [Id -> info] : *local* bindings environment
-     				-- Bindings for top-level things are given in
-				-- the info-down part
-     
-     cgs_stk_usg :: StackUsage,
-     cgs_hp_usg  :: HeapUsage,
-     
-     cgs_uniqs :: UniqSupply }
-
-initCgState :: UniqSupply -> CgState
-initCgState uniqs
-  = MkCgState { cgs_stmts = nilOL, cgs_tops = nilOL,
-		cgs_binds = emptyVarEnv, 
-		cgs_stk_usg = initStkUsage, 
-		cgs_hp_usg = initHpUsage,
-		cgs_uniqs = uniqs }
-\end{code}
-
-@EndOfBlockInfo@ tells what to do at the end of this block of code or,
-if the expression is a @case@, what to do at the end of each
-alternative.
-
-\begin{code}
-data EndOfBlockInfo
-  = EndOfBlockInfo
-	VirtualSpOffset   -- Args Sp: trim the stack to this point at a
-			  -- return; push arguments starting just
-			  -- above this point on a tail call.
-			  
-			  -- This is therefore the stk ptr as seen
-			  -- by a case alternative.
-	Sequel
-
-initEobInfo = EndOfBlockInfo 0 OnStack
-\end{code}
-
-Any addressing modes inside @Sequel@ must be ``robust,'' in the sense
-that it must survive stack pointer adjustments at the end of the
-block.
-
-\begin{code}
-data Sequel
-  = OnStack 		-- Continuation is on the stack
-  | UpdateCode		-- Continuation is update
-
-  | CaseAlts
-	  CLabel     -- Jump to this; if the continuation is for a vectored
-		     -- case this might be the label of a return vector
-	  SemiTaggingStuff
-	  Id	      -- The case binder, only used to see if it's dead
-	  Bool	      -- True <=> polymorphic, push a SEQ frame too
-
-type SemiTaggingStuff
-  = Maybe			-- Maybe[1] we don't have any semi-tagging stuff...
-     ([(ConTagZ, CmmLit)],	-- Alternatives
-      CmmLit)			-- Default (will be a can't happen RTS label if can't happen)
-
-type ConTagZ = Int	-- A *zero-indexed* contructor tag
-
--- The case branch is executed only from a successful semitagging
--- venture, when a case has looked at a variable, found that it's
--- evaluated, and wants to load up the contents and go to the join
--- point.
-\end{code}
-
-%************************************************************************
-%*									*
-		CgStmt type
-%*									*
-%************************************************************************
-
-The CgStmts type is what the code generator outputs: it is a tree of
-statements, including in-line labels.  The job of flattenCgStmts is to
-turn this into a list of basic blocks, each of which ends in a jump
-statement (either a local branch or a non-local jump).
-
-\begin{code}
-type CgStmts = OrdList CgStmt
-
-data CgStmt
-  = CgStmt  CmmStmt
-  | CgLabel BlockId
-  | CgFork  BlockId CgStmts
-
-flattenCgStmts :: BlockId -> CgStmts -> [CmmBasicBlock]
-flattenCgStmts id stmts = 
-	case flatten (fromOL stmts) of
-	  ([],blocks)    -> blocks
-	  (block,blocks) -> BasicBlock id block : blocks
- where
-  flatten [] = ([],[])
-
-  -- A label at the end of a function or fork: this label must not be reachable,
-  -- but it might be referred to from another BB that also isn't reachable.
-  -- Eliminating these has to be done with a dead-code analysis.  For now,
-  -- we just make it into a well-formed block by adding a recursive jump.
-  flatten [CgLabel id]
-    = ( [], [BasicBlock id [CmmBranch id]] )
-
-  -- A jump/branch: throw away all the code up to the next label, because
-  -- it is unreachable.  Be careful to keep forks that we find on the way.
-  flatten (CgStmt stmt : stmts)
-    | isJump stmt
-    = case dropWhile isOrdinaryStmt stmts of
-	[]                     -> ( [stmt], [] )
-	[CgLabel id]	       -> ( [stmt], [BasicBlock id [CmmBranch id]])
-	(CgLabel id : stmts)   -> ( [stmt], BasicBlock id block : blocks )
-	    where (block,blocks) = flatten stmts
-	(CgFork fork_id stmts : ss) -> 
-	   flatten (CgFork fork_id stmts : CgStmt stmt : ss)
-
-  flatten (s:ss) = 
-	case s of
-	  CgStmt stmt -> (stmt:block,blocks)
-	  CgLabel id  -> ([CmmBranch id],BasicBlock id block:blocks)
-	  CgFork fork_id stmts -> 
-		(block, BasicBlock fork_id fork_block : fork_blocks ++ blocks)
-		where (fork_block, fork_blocks) = flatten (fromOL stmts)
-    where (block,blocks) = flatten ss
-
-isJump (CmmJump _ _) = True
-isJump (CmmBranch _) = True
-isJump _ = False
-
-isOrdinaryStmt (CgStmt _) = True
-isOrdinaryStmt _ = False
-\end{code}
-
-%************************************************************************
-%*									*
-		Stack and heap models
-%*									*
-%************************************************************************
-
-\begin{code}
-type VirtualHpOffset = WordOff	-- Both are in
-type VirtualSpOffset = WordOff	-- units of words
-
-data StackUsage 
-  = StackUsage {
-	virtSp :: VirtualSpOffset,
-		-- Virtual offset of topmost allocated slot
-
-	frameSp :: VirtualSpOffset,
-		-- Virtual offset of the return address of the enclosing frame.
-		-- This RA describes the liveness/pointedness of
-		-- all the stack from frameSp downwards
-		-- INVARIANT: less than or equal to virtSp
-
-	 freeStk :: [VirtualSpOffset], 
-		-- List of free slots, in *increasing* order
-		-- INVARIANT: all <= virtSp
-		-- All slots <= virtSp are taken except these ones
-
-	 realSp :: VirtualSpOffset,	
-		-- Virtual offset of real stack pointer register
-
-	 hwSp :: VirtualSpOffset
-  }		   -- Highest value ever taken by virtSp
-
--- INVARIANT: The environment contains no Stable references to
--- 	      stack slots below (lower offset) frameSp
---	      It can contain volatile references to this area though.
-
-data HeapUsage =
-  HeapUsage {
-	virtHp :: VirtualHpOffset,	-- Virtual offset of highest-allocated word
-	realHp :: VirtualHpOffset	-- realHp: Virtual offset of real heap ptr
-  }
-\end{code}
-
-The heap high water mark is the larger of virtHp and hwHp.  The latter is
-only records the high water marks of forked-off branches, so to find the
-heap high water mark you have to take the max of virtHp and hwHp.  Remember,
-virtHp never retreats!
-
-Note Jan 04: ok, so why do we only look at the virtual Hp??
-
-\begin{code}
-heapHWM :: HeapUsage -> VirtualHpOffset
-heapHWM = virtHp
-\end{code}
-
-Initialisation.
-
-\begin{code}
-initStkUsage :: StackUsage
-initStkUsage = StackUsage {
-			virtSp = 0,
-			frameSp = 0,
-			freeStk = [],
-			realSp = 0,
-			hwSp = 0
-	       }
-		
-initHpUsage :: HeapUsage 
-initHpUsage = HeapUsage {
-	      	virtHp = 0,
-		realHp = 0
-	      }
-\end{code}
-
-@stateIncUsage@$~e_1~e_2$ incorporates in $e_1$ the stack and heap high water
-marks found in $e_2$.
-
-\begin{code}
-stateIncUsage :: CgState -> CgState -> CgState
-stateIncUsage s1 s2@(MkCgState { cgs_stk_usg = stk_usg, cgs_hp_usg = hp_usg })
-     = s1 { cgs_hp_usg  = cgs_hp_usg  s1 `maxHpHw`  virtHp hp_usg,
-	    cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp   stk_usg }
-       `addCodeBlocksFrom` s2
-		
-stateIncUsageEval :: CgState -> CgState -> CgState
-stateIncUsageEval s1 s2
-     = s1 { cgs_stk_usg = cgs_stk_usg s1 `maxStkHw` hwSp (cgs_stk_usg s2) }
-       `addCodeBlocksFrom` s2
-	-- We don't max the heap high-watermark because stateIncUsageEval is
-	-- used only in forkEval, which in turn is only used for blocks of code
-	-- which do their own heap-check.
-
-addCodeBlocksFrom :: CgState -> CgState -> CgState
--- Add code blocks from the latter to the former
--- (The cgs_stmts will often be empty, but not always; see codeOnly)
-s1 `addCodeBlocksFrom` s2
-  = s1 { cgs_stmts = cgs_stmts s1 `appOL` cgs_stmts s2,
-	 cgs_tops  = cgs_tops  s1 `appOL` cgs_tops  s2 }
-
-maxHpHw :: HeapUsage -> VirtualHpOffset -> HeapUsage
-hp_usg `maxHpHw` hw = hp_usg { virtHp = virtHp hp_usg `max` hw }
-
-maxStkHw :: StackUsage -> VirtualSpOffset -> StackUsage
-stk_usg `maxStkHw` hw = stk_usg { hwSp = hwSp stk_usg `max` hw }
-\end{code}
-
-%************************************************************************
-%*									*
-		The FCode monad
-%*									*
-%************************************************************************
-
-\begin{code}
-newtype FCode a = FCode (CgInfoDownwards -> CgState -> (a, CgState))
-type Code       = FCode ()
-
-instance Monad FCode where
-	(>>=) = thenFC
-	return = returnFC
-
-{-# INLINE thenC #-}
-{-# INLINE thenFC #-}
-{-# INLINE returnFC #-}
-\end{code}
-The Abstract~C is not in the environment so as to improve strictness.
-
-\begin{code}
-initC :: DynFlags -> HomeModules -> Module -> FCode a -> IO a
-
-initC dflags hmods mod (FCode code)
-  = do	{ uniqs <- mkSplitUniqSupply 'c'
-	; case code (initCgInfoDown dflags hmods mod) (initCgState uniqs) of
-	      (res, _) -> return res
-	}
-
-returnFC :: a -> FCode a
-returnFC val = FCode (\info_down state -> (val, state))
-\end{code}
-
-\begin{code}
-thenC :: Code -> FCode a -> FCode a
-thenC (FCode m) (FCode k) = 
-  	FCode (\info_down state -> let (_,new_state) = m info_down state in 
-  		k info_down new_state)
-
-listCs :: [Code] -> Code
-listCs [] = return ()
-listCs (fc:fcs) = do
-	fc
-	listCs fcs
-   	
-mapCs :: (a -> Code) -> [a] -> Code
-mapCs = mapM_
-\end{code}
-
-\begin{code}
-thenFC	:: FCode a -> (a -> FCode c) -> FCode c
-thenFC (FCode m) k = FCode (
-	\info_down state ->
-		let 
-			(m_result, new_state) = m info_down state
-			(FCode kcode) = k m_result
-		in 
-			kcode info_down new_state
-	)
-
-listFCs :: [FCode a] -> FCode [a]
-listFCs = sequence
-
-mapFCs :: (a -> FCode b) -> [a] -> FCode [b]
-mapFCs = mapM
-\end{code}
-
-And the knot-tying combinator:
-\begin{code}
-fixC :: (a -> FCode a) -> FCode a
-fixC fcode = FCode (
-	\info_down state -> 
-		let
-			FCode fc = fcode v
-			result@(v,_) = fc info_down state
-			--	    ^--------^
-		in
-			result
-	)
-\end{code}
-
-%************************************************************************
-%*									*
-	Operators for getting and setting the state and "info_down".
-
-%*									*
-%************************************************************************
-
-\begin{code}
-getState :: FCode CgState
-getState = FCode $ \info_down state -> (state,state)
-
-setState :: CgState -> FCode ()
-setState state = FCode $ \info_down _ -> ((),state)
-
-getStkUsage :: FCode StackUsage
-getStkUsage = do
-	state <- getState
-	return $ cgs_stk_usg state
-
-setStkUsage :: StackUsage -> Code
-setStkUsage new_stk_usg = do
-	state <- getState
-	setState $ state {cgs_stk_usg = new_stk_usg}
-
-getHpUsage :: FCode HeapUsage
-getHpUsage = do
-	state <- getState
-	return $ cgs_hp_usg state
-	
-setHpUsage :: HeapUsage -> Code
-setHpUsage new_hp_usg = do
-	state <- getState
-	setState $ state {cgs_hp_usg = new_hp_usg}
-
-getBinds :: FCode CgBindings
-getBinds = do
-	state <- getState
-	return $ cgs_binds state
-	
-setBinds :: CgBindings -> FCode ()
-setBinds new_binds = do
-	state <- getState
-	setState $ state {cgs_binds = new_binds}
-
-getStaticBinds :: FCode CgBindings
-getStaticBinds = do
-	info  <- getInfoDown
-	return (cgd_statics info)
-
-withState :: FCode a -> CgState -> FCode (a,CgState)
-withState (FCode fcode) newstate = FCode $ \info_down state -> 
-	let (retval, state2) = fcode info_down newstate in ((retval,state2), state)
-
-newUniqSupply :: FCode UniqSupply
-newUniqSupply = do
-	state <- getState
-	let (us1, us2) = splitUniqSupply (cgs_uniqs state)
-	setState $ state { cgs_uniqs = us1 }
-	return us2
-
-newUnique :: FCode Unique
-newUnique = do
-	us <- newUniqSupply
-	return (uniqFromSupply us)
-
-------------------
-getInfoDown :: FCode CgInfoDownwards
-getInfoDown = FCode $ \info_down state -> (info_down,state)
-
-getDynFlags :: FCode DynFlags
-getDynFlags = liftM cgd_dflags getInfoDown
-
-getHomeModules :: FCode HomeModules
-getHomeModules = liftM cgd_hmods getInfoDown
-
-withInfoDown :: FCode a -> CgInfoDownwards -> FCode a
-withInfoDown (FCode fcode) info_down = FCode $ \_ state -> fcode info_down state 
-
-doFCode :: FCode a -> CgInfoDownwards -> CgState -> (a,CgState)
-doFCode (FCode fcode) info_down state = fcode info_down state
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Forking
-%*									*
-%************************************************************************
-
-@forkClosureBody@ takes a code, $c$, and compiles it in a completely
-fresh environment, except that:
-	- compilation info and statics are passed in unchanged.
-The current environment is passed on completely unaltered, except that
-abstract C from the fork is incorporated.
-
-@forkProc@ takes a code and compiles it in the current environment,
-returning the basic blocks thus constructed.  The current environment
-is passed on completely unchanged.  It is pretty similar to
-@getBlocks@, except that the latter does affect the environment.
-
-@forkStatics@ $fc$ compiles $fc$ in an environment whose statics come
-from the current bindings, but which is otherwise freshly initialised.
-The Abstract~C returned is attached to the current state, but the
-bindings and usage information is otherwise unchanged.
-
-\begin{code}
-forkClosureBody :: Code -> Code
-forkClosureBody body_code
-  = do	{ info <- getInfoDown
-	; us   <- newUniqSupply
-	; state <- getState
-   	; let	body_info_down = info { cgd_eob = initEobInfo }
-		((),fork_state)	= doFCode body_code body_info_down 
-					  (initCgState us)
-	; ASSERT( isNilOL (cgs_stmts fork_state) )
-	  setState $ state `addCodeBlocksFrom` fork_state }
-	
-forkStatics :: FCode a -> FCode a
-forkStatics body_code
-  = do	{ info  <- getInfoDown
-	; us    <- newUniqSupply
-	; state <- getState
-	; let	rhs_info_down = info { cgd_statics = cgs_binds state,
-				       cgd_eob     = initEobInfo }
-		(result, fork_state_out) = doFCode body_code rhs_info_down 
-						   (initCgState us)
-	; ASSERT( isNilOL (cgs_stmts fork_state_out) )
-	  setState (state `addCodeBlocksFrom` fork_state_out)
-	; return result }
-
-forkProc :: Code -> FCode CgStmts
-forkProc body_code
-  = do	{ info_down <- getInfoDown
-	; us    <- newUniqSupply
-	; state <- getState
-	; let	fork_state_in = (initCgState us) 
-					{ cgs_binds   = cgs_binds state,
-					  cgs_stk_usg = cgs_stk_usg state,
-					  cgs_hp_usg  = cgs_hp_usg state }
-			-- ToDo: is the hp usage necesary?
-		(code_blks, fork_state_out) = doFCode (getCgStmts body_code) 
-						      info_down fork_state_in
-	; setState $ state `stateIncUsageEval` fork_state_out
-	; return code_blks }
-
-codeOnly :: Code -> Code
--- Emit any code from the inner thing into the outer thing
--- Do not affect anything else in the outer state
--- Used in almost-circular code to prevent false loop dependencies
-codeOnly body_code
-  = do	{ info_down <- getInfoDown
-	; us   <- newUniqSupply
-	; state <- getState
-	; let	fork_state_in = (initCgState us) { cgs_binds   = cgs_binds state,
-					           cgs_stk_usg = cgs_stk_usg state,
-					           cgs_hp_usg  = cgs_hp_usg state }
-		((), fork_state_out) = doFCode body_code info_down fork_state_in
-	; setState $ state `addCodeBlocksFrom` fork_state_out }
-\end{code}
-
-@forkAlts@ $bs~d$ takes fcodes $bs$ for the branches of a @case@, and
-an fcode for the default case $d$, and compiles each in the current
-environment.  The current environment is passed on unmodified, except
-that
-	- the worst stack high-water mark is incorporated
-	- the virtual Hp is moved on to the worst virtual Hp for the branches
-
-\begin{code}
-forkAlts :: [FCode a] -> FCode [a]
-
-forkAlts branch_fcodes
-  = do	{ info_down <- getInfoDown
-	; us <- newUniqSupply
-	; state <- getState
-	; let compile us branch 
-		= (us2, doFCode branch info_down branch_state)
-		where
-		  (us1,us2) = splitUniqSupply us
-	          branch_state = (initCgState us1) {
-					cgs_binds   = cgs_binds state,
-					cgs_stk_usg = cgs_stk_usg state,
-					cgs_hp_usg  = cgs_hp_usg state }
-
-	      (_us, results) = mapAccumL compile us branch_fcodes
-	      (branch_results, branch_out_states) = unzip results
-	; setState $ foldl stateIncUsage state branch_out_states
-		-- NB foldl.  state is the *left* argument to stateIncUsage
-	; return branch_results }
-\end{code}
-
-@forkEval@ takes two blocks of code.
-
-   -  The first meddles with the environment to set it up as expected by
-      the alternatives of a @case@ which does an eval (or gc-possible primop).
-   -  The second block is the code for the alternatives.
-      (plus info for semi-tagging purposes)
-
-@forkEval@ picks up the virtual stack pointer and returns a suitable
-@EndOfBlockInfo@ for the caller to use, together with whatever value
-is returned by the second block.
-
-It uses @initEnvForAlternatives@ to initialise the environment, and
-@stateIncUsageAlt@ to incorporate usage; the latter ignores the heap
-usage.
-
-\begin{code}
-forkEval :: EndOfBlockInfo              -- For the body
-    	 -> Code			-- Code to set environment
-	 -> FCode Sequel		-- Semi-tagging info to store
-	 -> FCode EndOfBlockInfo	-- The new end of block info
-
-forkEval body_eob_info env_code body_code
-  = do  { (v, sequel) <- forkEvalHelp body_eob_info env_code body_code
- 	; returnFC (EndOfBlockInfo v sequel) }
-
-forkEvalHelp :: EndOfBlockInfo  -- For the body
-    	     -> Code		-- Code to set environment
-	     -> FCode a		-- The code to do after the eval
-	     -> FCode (VirtualSpOffset,	-- Sp
-		       a)		-- Result of the FCode
-	-- A disturbingly complicated function
-forkEvalHelp body_eob_info env_code body_code
-  = do	{ info_down <- getInfoDown
-	; us   <- newUniqSupply
-	; state <- getState
-	; let { info_down_for_body = info_down {cgd_eob = body_eob_info}
-	      ; (_, env_state) = doFCode env_code info_down_for_body 
-					 (state {cgs_uniqs = us})
-	      ; state_for_body = (initCgState (cgs_uniqs env_state)) 
-					{ cgs_binds   = binds_for_body,
-	      				  cgs_stk_usg = stk_usg_for_body }
-	      ; binds_for_body   = nukeVolatileBinds (cgs_binds env_state)
-	      ; stk_usg_from_env = cgs_stk_usg env_state
-	      ; virtSp_from_env  = virtSp stk_usg_from_env
-	      ; stk_usg_for_body = stk_usg_from_env {realSp = virtSp_from_env,
-	      					     hwSp   = virtSp_from_env}
-	      ; (value_returned, state_at_end_return)
-	        	= doFCode body_code info_down_for_body state_for_body		
-	  } 
-	; ASSERT( isNilOL (cgs_stmts state_at_end_return) )
-		 -- The code coming back should consist only of nested declarations,
-		 -- notably of the return vector!
-	  setState $ state `stateIncUsageEval` state_at_end_return
-	; return (virtSp_from_env, value_returned) }
-
-
--- ----------------------------------------------------------------------------
--- Combinators for emitting code
-
-nopC :: Code
-nopC = return ()
-
-whenC :: Bool -> Code -> Code
-whenC True  code = code
-whenC False code = nopC
-
-stmtC :: CmmStmt -> Code
-stmtC stmt = emitCgStmt (CgStmt stmt)
-
-labelC :: BlockId -> Code
-labelC id = emitCgStmt (CgLabel id)
-
-newLabelC :: FCode BlockId
-newLabelC = do { id <- newUnique; return (BlockId id) }
-
-checkedAbsC :: CmmStmt -> Code
--- Emit code, eliminating no-ops
-checkedAbsC stmt = emitStmts (if isNopStmt stmt then nilOL
-	 		      else unitOL stmt)
-
-stmtsC :: [CmmStmt] -> Code
-stmtsC stmts = emitStmts (toOL stmts)
-
--- Emit code; no no-op checking
-emitStmts :: CmmStmts -> Code
-emitStmts stmts = emitCgStmts (fmap CgStmt stmts)
-
--- forkLabelledCode is for emitting a chunk of code with a label, outside
--- of the current instruction stream.
-forkLabelledCode :: Code -> FCode BlockId
-forkLabelledCode code = getCgStmts code >>= forkCgStmts
-
-emitCgStmt :: CgStmt -> Code
-emitCgStmt stmt
-  = do	{ state <- getState
-	; setState $ state { cgs_stmts = cgs_stmts state `snocOL` stmt }
-	}
-
-emitData :: Section -> [CmmStatic] -> Code
-emitData sect lits
-  = do 	{ state <- getState
-	; setState $ state { cgs_tops = cgs_tops state `snocOL` data_block } }
-  where
-    data_block = CmmData sect lits
-
-emitProc :: [CmmLit] -> CLabel -> [LocalReg] -> [CmmBasicBlock] -> Code
-emitProc lits lbl args blocks
-  = do  { let proc_block = CmmProc (map CmmStaticLit lits) lbl args blocks
-	; state <- getState
-	; setState $ state { cgs_tops = cgs_tops state `snocOL` proc_block } }
-
-emitSimpleProc :: CLabel -> Code -> Code
--- Emit a procedure whose body is the specified code; no info table
-emitSimpleProc lbl code
-  = do	{ stmts <- getCgStmts code
-	; blks <- cgStmtsToBlocks stmts
-	; emitProc [] lbl [] blks }
-
-getCmm :: Code -> FCode Cmm
--- Get all the CmmTops (there should be no stmts)
-getCmm code 
-  = do	{ state1 <- getState
-	; ((), state2) <- withState code (state1 { cgs_tops  = nilOL })
-	; setState $ state2 { cgs_tops = cgs_tops state1 } 
-	; return (Cmm (fromOL (cgs_tops state2))) }
-
--- ----------------------------------------------------------------------------
--- CgStmts
-
--- These functions deal in terms of CgStmts, which is an abstract type
--- representing the code in the current proc.
-
-
--- emit CgStmts into the current instruction stream
-emitCgStmts :: CgStmts -> Code
-emitCgStmts stmts
-  = do	{ state <- getState
-	; setState $ state { cgs_stmts = cgs_stmts state `appOL` stmts } }
-
--- emit CgStmts outside the current instruction stream, and return a label
-forkCgStmts :: CgStmts -> FCode BlockId
-forkCgStmts stmts
-  = do  { id <- newLabelC
-	; emitCgStmt (CgFork id stmts)
-	; return id
-	}
-
--- turn CgStmts into [CmmBasicBlock], for making a new proc.
-cgStmtsToBlocks :: CgStmts -> FCode [CmmBasicBlock]
-cgStmtsToBlocks stmts
-  = do  { id <- newLabelC
-	; return (flattenCgStmts id stmts)
-	}	
-
--- collect the code emitted by an FCode computation
-getCgStmts' :: FCode a -> FCode (a, CgStmts)
-getCgStmts' fcode
-  = do	{ state1 <- getState
-	; (a, state2) <- withState fcode (state1 { cgs_stmts = nilOL })
-	; setState $ state2 { cgs_stmts = cgs_stmts state1  }
-	; return (a, cgs_stmts state2) }
-
-getCgStmts :: FCode a -> FCode CgStmts
-getCgStmts fcode = do { (_,stmts) <- getCgStmts' fcode; return stmts }
-
--- Simple ways to construct CgStmts:
-noCgStmts :: CgStmts
-noCgStmts = nilOL
-
-oneCgStmt :: CmmStmt -> CgStmts
-oneCgStmt stmt = unitOL (CgStmt stmt)
-
-consCgStmt :: CmmStmt -> CgStmts -> CgStmts
-consCgStmt stmt stmts = CgStmt stmt `consOL` stmts
-
--- ----------------------------------------------------------------------------
--- Get the current module name
-
-moduleName :: FCode Module
-moduleName = do { info <- getInfoDown; return (cgd_mod info) }
-
--- ----------------------------------------------------------------------------
--- Get/set the end-of-block info
-
-setEndOfBlockInfo :: EndOfBlockInfo -> Code -> Code
-setEndOfBlockInfo eob_info code	= do
-	info  <- getInfoDown
-	withInfoDown code (info {cgd_eob = eob_info})
-
-getEndOfBlockInfo :: FCode EndOfBlockInfo
-getEndOfBlockInfo = do
-	info <- getInfoDown
-	return (cgd_eob info)
-
--- ----------------------------------------------------------------------------
--- Get/set the current SRT label
-
--- There is just one SRT for each top level binding; all the nested
--- bindings use sub-sections of this SRT.  The label is passed down to
--- the nested bindings via the monad.
-
-getSRTLabel :: FCode CLabel	-- Used only by cgPanic
-getSRTLabel = do info  <- getInfoDown
-		 return (cgd_srt info)
-
-setSRTLabel :: CLabel -> FCode a -> FCode a
-setSRTLabel srt_lbl code
-  = do  info <- getInfoDown
-	withInfoDown code (info { cgd_srt = srt_lbl})
-
--- ----------------------------------------------------------------------------
--- Get/set the current ticky counter label
-
-getTickyCtrLabel :: FCode CLabel
-getTickyCtrLabel = do
-	info <- getInfoDown
-	return (cgd_ticky info)
-
-setTickyCtrLabel :: CLabel -> Code -> Code
-setTickyCtrLabel ticky code = do
-	info <- getInfoDown
-	withInfoDown code (info {cgd_ticky = ticky})
-\end{code}
diff --git a/ghc/compiler/codeGen/CgParallel.hs b/ghc/compiler/codeGen/CgParallel.hs
deleted file mode 100644
index b826a33cba..0000000000
--- a/ghc/compiler/codeGen/CgParallel.hs
+++ /dev/null
@@ -1,90 +0,0 @@
--- Code generation relaed to GpH
--- 	(a) parallel
---	(b) GranSim
-
-module CgParallel(
-	staticGranHdr,staticParHdr,
-	granFetchAndReschedule, granYield,
-	doGranAllocate
-  ) where
-
-import CgMonad
-import CgCallConv	( mkRegLiveness )
-import Id		( Id )
-import Cmm		( CmmLit, GlobalReg(..), node, CmmExpr )
-import StaticFlags	( opt_GranMacros )
-import Outputable
-
-staticParHdr :: [CmmLit]
--- Parallel header words in a static closure
-staticParHdr = []
-
---------------------------------------------------------
---		GranSim stuff
---------------------------------------------------------
-
-staticGranHdr :: [CmmLit]
--- Gransim header words in a static closure
-staticGranHdr = []
-
-doGranAllocate :: CmmExpr -> Code	
--- macro DO_GRAN_ALLOCATE
-doGranAllocate hp 
-  | not opt_GranMacros = nopC
-  | otherwise	       = panic "doGranAllocate"
-
-
-
--------------------------
-granFetchAndReschedule :: [(Id,GlobalReg)]  -- Live registers
-		       -> Bool           	-- Node reqd?
-		       -> Code
--- Emit code for simulating a fetch and then reschedule.
-granFetchAndReschedule regs node_reqd
-  | opt_GranMacros && (node `elem` map snd regs || node_reqd)
-  = do { fetch
-       ; reschedule liveness node_reqd }
-  | otherwise
-  = nopC
-  where
-    liveness = mkRegLiveness regs 0 0
-
-fetch = panic "granFetch"
-	-- Was: absC (CMacroStmt GRAN_FETCH [])
-	--HWL: generate GRAN_FETCH macro for GrAnSim
- 	--     currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai
-
-reschedule liveness node_reqd = panic "granReschedule"
-	-- Was: absC  (CMacroStmt GRAN_RESCHEDULE [
-  	--                mkIntCLit (I# (word2Int# liveness_mask)), 
-    	--		  mkIntCLit (if node_reqd then 1 else 0)])
-    
-
--------------------------
--- The @GRAN_YIELD@ macro is taken from JSM's  code for Concurrent Haskell. It
--- allows to context-switch at  places where @node@ is  not alive (it uses the
--- @Continue@ rather  than the @EnterNodeCode@  function in the  RTS). We emit
--- this kind of macro at the beginning of the following kinds of basic bocks:
--- \begin{itemize}
---  \item Slow entry code where node is not alive (see @CgClosure.lhs@). Normally 
---        we use @fetchAndReschedule@ at a slow entry code.
---  \item Fast entry code (see @CgClosure.lhs@).
---  \item Alternatives in case expressions (@CLabelledCode@ structures), provided
---        that they are not inlined (see @CgCases.lhs@). These alternatives will 
---        be turned into separate functions.
-
-granYield :: [(Id,GlobalReg)]   -- Live registers
-          -> Bool               -- Node reqd?
-          -> Code 
-
-granYield regs node_reqd
-  | opt_GranMacros && node_reqd = yield liveness
-  | otherwise			= nopC
-  where
-     liveness = mkRegLiveness regs 0 0
-
-yield liveness = panic "granYield"
-	-- Was : absC (CMacroStmt GRAN_YIELD 
-        --                  [mkIntCLit (I# (word2Int# liveness_mask))])
-
-
diff --git a/ghc/compiler/codeGen/CgPrimOp.hs b/ghc/compiler/codeGen/CgPrimOp.hs
deleted file mode 100644
index bc7c9140ed..0000000000
--- a/ghc/compiler/codeGen/CgPrimOp.hs
+++ /dev/null
@@ -1,584 +0,0 @@
------------------------------------------------------------------------------
---
--- Code generation for PrimOps.
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
-module CgPrimOp (
-   cgPrimOp
- ) where
-
-#include "HsVersions.h"
-
-import ForeignCall	( CCallConv(CCallConv) )
-import StgSyn		( StgLiveVars, StgArg )
-import CgForeignCall	( emitForeignCall' )
-import CgBindery	( getVolatileRegs, getArgAmodes )
-import CgMonad
-import CgInfoTbls	( getConstrTag )
-import CgUtils		( cmmOffsetW, cmmOffsetB, cmmLoadIndexW )
-import ForeignCall
-import Cmm
-import CLabel		( mkMAP_FROZEN_infoLabel, mkMAP_DIRTY_infoLabel,
-			  mkDirty_MUT_VAR_Label, mkRtsCodeLabel )
-import CmmUtils
-import MachOp
-import SMRep
-import PrimOp		( PrimOp(..) )
-import SMRep		( tablesNextToCode )
-import Constants 	( wORD_SIZE, wORD_SIZE_IN_BITS )
-import StaticFlags	( opt_Parallel )
-import Outputable
-
--- ---------------------------------------------------------------------------
--- Code generation for PrimOps
-
-cgPrimOp   :: [CmmReg] 		-- where to put the results
-	   -> PrimOp		-- the op
-	   -> [StgArg]		-- arguments
-	   -> StgLiveVars	-- live vars, in case we need to save them
-	   -> Code
-
-cgPrimOp results op args live
-  = do arg_exprs <- getArgAmodes args
-       let non_void_args = [ e | (r,e) <- arg_exprs, nonVoidArg r ] 
-       emitPrimOp results op non_void_args live
-
-
-emitPrimOp :: [CmmReg] 		-- where to put the results
-	   -> PrimOp		-- the op
-	   -> [CmmExpr]		-- arguments
-	   -> StgLiveVars	-- live vars, in case we need to save them
-	   -> Code
-
---  First we handle various awkward cases specially.  The remaining
--- easy cases are then handled by translateOp, defined below.
-
-emitPrimOp [res_r,res_c] IntAddCOp [aa,bb] live
-{- 
-   With some bit-twiddling, we can define int{Add,Sub}Czh portably in
-   C, and without needing any comparisons.  This may not be the
-   fastest way to do it - if you have better code, please send it! --SDM
-  
-   Return : r = a + b,  c = 0 if no overflow, 1 on overflow.
-  
-   We currently don't make use of the r value if c is != 0 (i.e. 
-   overflow), we just convert to big integers and try again.  This
-   could be improved by making r and c the correct values for
-   plugging into a new J#.  
-   
-   { r = ((I_)(a)) + ((I_)(b));					\
-     c = ((StgWord)(~(((I_)(a))^((I_)(b))) & (((I_)(a))^r)))	\
-         >> (BITS_IN (I_) - 1);					\
-   } 
-   Wading through the mass of bracketry, it seems to reduce to:
-   c = ( (~(a^b)) & (a^r) ) >>unsigned (BITS_IN(I_)-1)
-
--}
-   = stmtsC [
-        CmmAssign res_r (CmmMachOp mo_wordAdd [aa,bb]),
-        CmmAssign res_c $
-	  CmmMachOp mo_wordUShr [
-		CmmMachOp mo_wordAnd [
-		    CmmMachOp mo_wordNot [CmmMachOp mo_wordXor [aa,bb]],
-		    CmmMachOp mo_wordXor [aa, CmmReg res_r]
-		], 
-	        CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
-	  ]
-     ]
-
-
-emitPrimOp [res_r,res_c] IntSubCOp [aa,bb] live
-{- Similarly:
-   #define subIntCzh(r,c,a,b)					\
-   { r = ((I_)(a)) - ((I_)(b));					\
-     c = ((StgWord)((((I_)(a))^((I_)(b))) & (((I_)(a))^r)))	\
-         >> (BITS_IN (I_) - 1);					\
-   }
-
-   c =  ((a^b) & (a^r)) >>unsigned (BITS_IN(I_)-1)
--}
-   = stmtsC [
-        CmmAssign res_r (CmmMachOp mo_wordSub [aa,bb]),
-        CmmAssign res_c $
-	  CmmMachOp mo_wordUShr [
-		CmmMachOp mo_wordAnd [
-		    CmmMachOp mo_wordXor [aa,bb],
-		    CmmMachOp mo_wordXor [aa, CmmReg res_r]
-		], 
-	        CmmLit (mkIntCLit (wORD_SIZE_IN_BITS - 1))
-	  ]
-     ]
-
-
-emitPrimOp [res] ParOp [arg] live
-  = do
-	-- for now, just implement this in a C function
-	-- later, we might want to inline it.
-    vols <- getVolatileRegs live
-    emitForeignCall' PlayRisky
-	[(res,NoHint)]
-    	(CmmForeignCall newspark CCallConv) 
-	[(CmmReg (CmmGlobal BaseReg), PtrHint), (arg,PtrHint)] 
-	(Just vols)
-  where
-	newspark = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("newSpark")))
-
-emitPrimOp [res] ReadMutVarOp [mutv] live
-   = stmtC (CmmAssign res (cmmLoadIndexW mutv fixedHdrSize))
-
-emitPrimOp [] WriteMutVarOp [mutv,var] live
-   = do
-	stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var)
-	vols <- getVolatileRegs live
-	emitForeignCall' PlayRisky
-		[{-no results-}]
-		(CmmForeignCall (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
-			 CCallConv)
-		[(CmmReg (CmmGlobal BaseReg), PtrHint), (mutv,PtrHint)]
-		(Just vols)
-
---  #define sizzeofByteArrayzh(r,a) \
---     r = (((StgArrWords *)(a))->words * sizeof(W_))
-emitPrimOp [res] SizeofByteArrayOp [arg] live
-   = stmtC $
-	CmmAssign res (CmmMachOp mo_wordMul [
-			  cmmLoadIndexW arg fixedHdrSize,
-			  CmmLit (mkIntCLit wORD_SIZE)
-			])
-
---  #define sizzeofMutableByteArrayzh(r,a) \
---      r = (((StgArrWords *)(a))->words * sizeof(W_))
-emitPrimOp [res] SizeofMutableByteArrayOp [arg] live
-   = emitPrimOp [res] SizeofByteArrayOp [arg] live
-
-
---  #define touchzh(o)                  /* nothing */
-emitPrimOp [] TouchOp [arg] live
-   = nopC
-
---  #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
-emitPrimOp [res] ByteArrayContents_Char [arg] live
-   = stmtC (CmmAssign res (cmmOffsetB arg arrWordsHdrSize))
-
---  #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
-emitPrimOp [res] StableNameToIntOp [arg] live
-   = stmtC (CmmAssign res (cmmLoadIndexW arg fixedHdrSize))
-
---  #define eqStableNamezh(r,sn1,sn2)					\
---    (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
-emitPrimOp [res] EqStableNameOp [arg1,arg2] live
-   = stmtC (CmmAssign res (CmmMachOp mo_wordEq [
-				cmmLoadIndexW arg1 fixedHdrSize,
-				cmmLoadIndexW arg2 fixedHdrSize
-			 ]))
-
-
-emitPrimOp [res] ReallyUnsafePtrEqualityOp [arg1,arg2] live
-   = stmtC (CmmAssign res (CmmMachOp mo_wordEq [arg1,arg2]))
-
---  #define addrToHValuezh(r,a) r=(P_)a
-emitPrimOp [res] AddrToHValueOp [arg] live
-   = stmtC (CmmAssign res arg)
-
---  #define dataToTagzh(r,a)  r=(GET_TAG(((StgClosure *)a)->header.info))
-emitPrimOp [res] DataToTagOp [arg] live
-   = stmtC (CmmAssign res (getConstrTag arg))
-
-{- Freezing arrays-of-ptrs requires changing an info table, for the
-   benefit of the generational collector.  It needs to scavenge mutable
-   objects, even if they are in old space.  When they become immutable,
-   they can be removed from this scavenge list.	 -}
-
---  #define unsafeFreezzeArrayzh(r,a)
---	{
---        SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN0_info);
---	  r = a;
---	}
-emitPrimOp [res] UnsafeFreezeArrayOp [arg] live
-   = stmtsC [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_infoLabel)),
-	     CmmAssign res arg ]
-
---  #define unsafeFreezzeByteArrayzh(r,a)	r=(a)
-emitPrimOp [res] UnsafeFreezeByteArrayOp [arg] live
-   = stmtC (CmmAssign res arg)
-
--- Reading/writing pointer arrays
-
-emitPrimOp [r] ReadArrayOp  [obj,ix]   live  = doReadPtrArrayOp r obj ix
-emitPrimOp [r] IndexArrayOp [obj,ix]   live  = doReadPtrArrayOp r obj ix
-emitPrimOp []  WriteArrayOp [obj,ix,v] live  = doWritePtrArrayOp obj ix v
-
--- IndexXXXoffAddr
-
-emitPrimOp res IndexOffAddrOp_Char      args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
-emitPrimOp res IndexOffAddrOp_WideChar  args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
-emitPrimOp res IndexOffAddrOp_Int       args live = doIndexOffAddrOp Nothing wordRep res args
-emitPrimOp res IndexOffAddrOp_Word      args live = doIndexOffAddrOp Nothing wordRep res args
-emitPrimOp res IndexOffAddrOp_Addr      args live = doIndexOffAddrOp Nothing wordRep res args
-emitPrimOp res IndexOffAddrOp_Float     args live = doIndexOffAddrOp Nothing F32 res args
-emitPrimOp res IndexOffAddrOp_Double    args live = doIndexOffAddrOp Nothing F64 res args
-emitPrimOp res IndexOffAddrOp_StablePtr args live = doIndexOffAddrOp Nothing wordRep res args
-emitPrimOp res IndexOffAddrOp_Int8      args live = doIndexOffAddrOp (Just mo_s_8ToWord) I8  res args
-emitPrimOp res IndexOffAddrOp_Int16     args live = doIndexOffAddrOp (Just mo_s_16ToWord) I16 res args
-emitPrimOp res IndexOffAddrOp_Int32     args live = doIndexOffAddrOp (Just mo_s_32ToWord) I32 res args
-emitPrimOp res IndexOffAddrOp_Int64     args live = doIndexOffAddrOp Nothing I64 res args
-emitPrimOp res IndexOffAddrOp_Word8     args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8  res args
-emitPrimOp res IndexOffAddrOp_Word16    args live = doIndexOffAddrOp (Just mo_u_16ToWord) I16 res args
-emitPrimOp res IndexOffAddrOp_Word32    args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
-emitPrimOp res IndexOffAddrOp_Word64    args live = doIndexOffAddrOp Nothing I64 res args
-
--- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
-
-emitPrimOp res ReadOffAddrOp_Char      args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args
-emitPrimOp res ReadOffAddrOp_WideChar  args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
-emitPrimOp res ReadOffAddrOp_Int       args live = doIndexOffAddrOp Nothing wordRep res args
-emitPrimOp res ReadOffAddrOp_Word      args live = doIndexOffAddrOp Nothing wordRep res args
-emitPrimOp res ReadOffAddrOp_Addr      args live = doIndexOffAddrOp Nothing wordRep res args
-emitPrimOp res ReadOffAddrOp_Float     args live = doIndexOffAddrOp Nothing F32 res args
-emitPrimOp res ReadOffAddrOp_Double    args live = doIndexOffAddrOp Nothing F64 res args
-emitPrimOp res ReadOffAddrOp_StablePtr args live = doIndexOffAddrOp Nothing wordRep res args
-emitPrimOp res ReadOffAddrOp_Int8      args live = doIndexOffAddrOp (Just mo_s_8ToWord) I8  res args
-emitPrimOp res ReadOffAddrOp_Int16     args live = doIndexOffAddrOp (Just mo_s_16ToWord) I16 res args
-emitPrimOp res ReadOffAddrOp_Int32     args live = doIndexOffAddrOp (Just mo_s_32ToWord) I32 res args
-emitPrimOp res ReadOffAddrOp_Int64     args live = doIndexOffAddrOp Nothing I64 res args
-emitPrimOp res ReadOffAddrOp_Word8     args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8  res args
-emitPrimOp res ReadOffAddrOp_Word16    args live = doIndexOffAddrOp (Just mo_u_16ToWord) I16 res args
-emitPrimOp res ReadOffAddrOp_Word32    args live = doIndexOffAddrOp (Just mo_u_32ToWord) I32 res args
-emitPrimOp res ReadOffAddrOp_Word64    args live = doIndexOffAddrOp Nothing I64 res args
-
--- IndexXXXArray
-
-emitPrimOp res IndexByteArrayOp_Char      args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8 res args
-emitPrimOp res IndexByteArrayOp_WideChar  args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32 res args
-emitPrimOp res IndexByteArrayOp_Int       args live = doIndexByteArrayOp Nothing wordRep res args
-emitPrimOp res IndexByteArrayOp_Word      args live = doIndexByteArrayOp Nothing wordRep res args
-emitPrimOp res IndexByteArrayOp_Addr      args live = doIndexByteArrayOp Nothing wordRep res args
-emitPrimOp res IndexByteArrayOp_Float     args live = doIndexByteArrayOp Nothing F32 res args
-emitPrimOp res IndexByteArrayOp_Double    args live = doIndexByteArrayOp Nothing F64 res args
-emitPrimOp res IndexByteArrayOp_StablePtr args live = doIndexByteArrayOp Nothing wordRep res args
-emitPrimOp res IndexByteArrayOp_Int8      args live = doIndexByteArrayOp (Just mo_s_8ToWord) I8  res args
-emitPrimOp res IndexByteArrayOp_Int16     args live = doIndexByteArrayOp (Just mo_s_16ToWord) I16  res args
-emitPrimOp res IndexByteArrayOp_Int32     args live = doIndexByteArrayOp (Just mo_s_32ToWord) I32  res args
-emitPrimOp res IndexByteArrayOp_Int64     args live = doIndexByteArrayOp Nothing I64  res args
-emitPrimOp res IndexByteArrayOp_Word8     args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8  res args
-emitPrimOp res IndexByteArrayOp_Word16    args live = doIndexByteArrayOp (Just mo_u_16ToWord) I16  res args
-emitPrimOp res IndexByteArrayOp_Word32    args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32  res args
-emitPrimOp res IndexByteArrayOp_Word64    args live = doIndexByteArrayOp Nothing I64  res args
-
--- ReadXXXArray, identical to IndexXXXArray.
-
-emitPrimOp res ReadByteArrayOp_Char       args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8 res args
-emitPrimOp res ReadByteArrayOp_WideChar   args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32 res args
-emitPrimOp res ReadByteArrayOp_Int        args live = doIndexByteArrayOp Nothing wordRep res args
-emitPrimOp res ReadByteArrayOp_Word       args live = doIndexByteArrayOp Nothing wordRep res args
-emitPrimOp res ReadByteArrayOp_Addr       args live = doIndexByteArrayOp Nothing wordRep res args
-emitPrimOp res ReadByteArrayOp_Float      args live = doIndexByteArrayOp Nothing F32 res args
-emitPrimOp res ReadByteArrayOp_Double     args live = doIndexByteArrayOp Nothing F64 res args
-emitPrimOp res ReadByteArrayOp_StablePtr  args live = doIndexByteArrayOp Nothing wordRep res args
-emitPrimOp res ReadByteArrayOp_Int8       args live = doIndexByteArrayOp (Just mo_s_8ToWord) I8  res args
-emitPrimOp res ReadByteArrayOp_Int16      args live = doIndexByteArrayOp (Just mo_s_16ToWord) I16  res args
-emitPrimOp res ReadByteArrayOp_Int32      args live = doIndexByteArrayOp (Just mo_s_32ToWord) I32  res args
-emitPrimOp res ReadByteArrayOp_Int64      args live = doIndexByteArrayOp Nothing I64  res args
-emitPrimOp res ReadByteArrayOp_Word8      args live = doIndexByteArrayOp (Just mo_u_8ToWord) I8  res args
-emitPrimOp res ReadByteArrayOp_Word16     args live = doIndexByteArrayOp (Just mo_u_16ToWord) I16  res args
-emitPrimOp res ReadByteArrayOp_Word32     args live = doIndexByteArrayOp (Just mo_u_32ToWord) I32  res args
-emitPrimOp res ReadByteArrayOp_Word64     args live = doIndexByteArrayOp Nothing I64  res args
-
--- WriteXXXoffAddr
-
-emitPrimOp res WriteOffAddrOp_Char       args live = doWriteOffAddrOp (Just mo_WordTo8) I8 res args
-emitPrimOp res WriteOffAddrOp_WideChar   args live = doWriteOffAddrOp (Just mo_WordTo32) I32 res args
-emitPrimOp res WriteOffAddrOp_Int        args live = doWriteOffAddrOp Nothing wordRep res args
-emitPrimOp res WriteOffAddrOp_Word       args live = doWriteOffAddrOp Nothing wordRep res args
-emitPrimOp res WriteOffAddrOp_Addr       args live = doWriteOffAddrOp Nothing wordRep res args
-emitPrimOp res WriteOffAddrOp_Float      args live = doWriteOffAddrOp Nothing F32 res args
-emitPrimOp res WriteOffAddrOp_Double     args live = doWriteOffAddrOp Nothing F64 res args
-emitPrimOp res WriteOffAddrOp_StablePtr  args live = doWriteOffAddrOp Nothing wordRep res args
-emitPrimOp res WriteOffAddrOp_Int8       args live = doWriteOffAddrOp (Just mo_WordTo8) I8  res args
-emitPrimOp res WriteOffAddrOp_Int16      args live = doWriteOffAddrOp (Just mo_WordTo16) I16 res args
-emitPrimOp res WriteOffAddrOp_Int32      args live = doWriteOffAddrOp (Just mo_WordTo32) I32 res args
-emitPrimOp res WriteOffAddrOp_Int64      args live = doWriteOffAddrOp Nothing I64 res args
-emitPrimOp res WriteOffAddrOp_Word8      args live = doWriteOffAddrOp (Just mo_WordTo8) I8  res args
-emitPrimOp res WriteOffAddrOp_Word16     args live = doWriteOffAddrOp (Just mo_WordTo16) I16 res args
-emitPrimOp res WriteOffAddrOp_Word32     args live = doWriteOffAddrOp (Just mo_WordTo32) I32 res args
-emitPrimOp res WriteOffAddrOp_Word64     args live = doWriteOffAddrOp Nothing I64 res args
-
--- WriteXXXArray
-
-emitPrimOp res WriteByteArrayOp_Char      args live = doWriteByteArrayOp (Just mo_WordTo8) I8 res args
-emitPrimOp res WriteByteArrayOp_WideChar  args live = doWriteByteArrayOp (Just mo_WordTo32) I32 res args
-emitPrimOp res WriteByteArrayOp_Int       args live = doWriteByteArrayOp Nothing wordRep res args
-emitPrimOp res WriteByteArrayOp_Word      args live = doWriteByteArrayOp Nothing wordRep res args
-emitPrimOp res WriteByteArrayOp_Addr      args live = doWriteByteArrayOp Nothing wordRep res args
-emitPrimOp res WriteByteArrayOp_Float     args live = doWriteByteArrayOp Nothing F32 res args
-emitPrimOp res WriteByteArrayOp_Double    args live = doWriteByteArrayOp Nothing F64 res args
-emitPrimOp res WriteByteArrayOp_StablePtr args live = doWriteByteArrayOp Nothing wordRep res args
-emitPrimOp res WriteByteArrayOp_Int8      args live = doWriteByteArrayOp (Just mo_WordTo8) I8  res args
-emitPrimOp res WriteByteArrayOp_Int16     args live = doWriteByteArrayOp (Just mo_WordTo16) I16  res args
-emitPrimOp res WriteByteArrayOp_Int32     args live = doWriteByteArrayOp (Just mo_WordTo32) I32  res args
-emitPrimOp res WriteByteArrayOp_Int64     args live = doWriteByteArrayOp Nothing I64  res args
-emitPrimOp res WriteByteArrayOp_Word8     args live = doWriteByteArrayOp (Just mo_WordTo8) I8  res args
-emitPrimOp res WriteByteArrayOp_Word16    args live = doWriteByteArrayOp (Just mo_WordTo16) I16  res args
-emitPrimOp res WriteByteArrayOp_Word32    args live = doWriteByteArrayOp (Just mo_WordTo32) I32  res args
-emitPrimOp res WriteByteArrayOp_Word64    args live = doWriteByteArrayOp Nothing I64  res args
-
-
--- The rest just translate straightforwardly
-emitPrimOp [res] op [arg] live
-   | nopOp op
-   = stmtC (CmmAssign res arg)
-
-   | Just (mop,rep) <- narrowOp op
-   = stmtC (CmmAssign res (CmmMachOp (mop rep wordRep) [
-			  CmmMachOp (mop wordRep rep) [arg]]))
-
-emitPrimOp [res] op args live
-   | Just prim <- callishOp op
-   = do vols <- getVolatileRegs live
-	emitForeignCall' PlayRisky
-	   [(res,NoHint)] 
-	   (CmmPrim prim) 
-	   [(a,NoHint) | a<-args]  -- ToDo: hints?
-	   (Just vols)
-
-   | Just mop <- translateOp op
-   = let stmt = CmmAssign res (CmmMachOp mop args) in
-     stmtC stmt
-
-emitPrimOp _ op _ _
- = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
-
-
--- These PrimOps are NOPs in Cmm
-
-nopOp Int2WordOp     = True
-nopOp Word2IntOp     = True
-nopOp Int2AddrOp     = True
-nopOp Addr2IntOp     = True
-nopOp ChrOp	     = True  -- Int# and Char# are rep'd the same
-nopOp OrdOp	     = True
-nopOp _		     = False
-
--- These PrimOps turn into double casts
-
-narrowOp Narrow8IntOp   = Just (MO_S_Conv, I8)
-narrowOp Narrow16IntOp  = Just (MO_S_Conv, I16)
-narrowOp Narrow32IntOp  = Just (MO_S_Conv, I32)
-narrowOp Narrow8WordOp  = Just (MO_U_Conv, I8)
-narrowOp Narrow16WordOp = Just (MO_U_Conv, I16)
-narrowOp Narrow32WordOp = Just (MO_U_Conv, I32)
-narrowOp _ 		= Nothing
-
--- Native word signless ops
-
-translateOp IntAddOp       = Just mo_wordAdd
-translateOp IntSubOp       = Just mo_wordSub
-translateOp WordAddOp      = Just mo_wordAdd
-translateOp WordSubOp      = Just mo_wordSub
-translateOp AddrAddOp      = Just mo_wordAdd
-translateOp AddrSubOp      = Just mo_wordSub
-
-translateOp IntEqOp        = Just mo_wordEq
-translateOp IntNeOp        = Just mo_wordNe
-translateOp WordEqOp       = Just mo_wordEq
-translateOp WordNeOp       = Just mo_wordNe
-translateOp AddrEqOp       = Just mo_wordEq
-translateOp AddrNeOp       = Just mo_wordNe
-
-translateOp AndOp          = Just mo_wordAnd
-translateOp OrOp           = Just mo_wordOr
-translateOp XorOp          = Just mo_wordXor
-translateOp NotOp          = Just mo_wordNot
-translateOp SllOp	   = Just mo_wordShl
-translateOp SrlOp	   = Just mo_wordUShr
-
-translateOp AddrRemOp	   = Just mo_wordURem
-
--- Native word signed ops
-
-translateOp IntMulOp        = Just mo_wordMul
-translateOp IntMulMayOfloOp = Just (MO_S_MulMayOflo wordRep)
-translateOp IntQuotOp       = Just mo_wordSQuot
-translateOp IntRemOp        = Just mo_wordSRem
-translateOp IntNegOp        = Just mo_wordSNeg
-
-
-translateOp IntGeOp        = Just mo_wordSGe
-translateOp IntLeOp        = Just mo_wordSLe
-translateOp IntGtOp        = Just mo_wordSGt
-translateOp IntLtOp        = Just mo_wordSLt
-
-translateOp ISllOp	   = Just mo_wordShl
-translateOp ISraOp	   = Just mo_wordSShr
-translateOp ISrlOp	   = Just mo_wordUShr
-
--- Native word unsigned ops
-
-translateOp WordGeOp       = Just mo_wordUGe
-translateOp WordLeOp       = Just mo_wordULe
-translateOp WordGtOp       = Just mo_wordUGt
-translateOp WordLtOp       = Just mo_wordULt
-
-translateOp WordMulOp      = Just mo_wordMul
-translateOp WordQuotOp     = Just mo_wordUQuot
-translateOp WordRemOp      = Just mo_wordURem
-
-translateOp AddrGeOp       = Just mo_wordUGe
-translateOp AddrLeOp       = Just mo_wordULe
-translateOp AddrGtOp       = Just mo_wordUGt
-translateOp AddrLtOp       = Just mo_wordULt
-
--- Char# ops
-
-translateOp CharEqOp       = Just (MO_Eq wordRep)
-translateOp CharNeOp       = Just (MO_Ne wordRep)
-translateOp CharGeOp       = Just (MO_U_Ge wordRep)
-translateOp CharLeOp       = Just (MO_U_Le wordRep)
-translateOp CharGtOp       = Just (MO_U_Gt wordRep)
-translateOp CharLtOp       = Just (MO_U_Lt wordRep)
-
--- Double ops
-
-translateOp DoubleEqOp     = Just (MO_Eq F64)
-translateOp DoubleNeOp     = Just (MO_Ne F64)
-translateOp DoubleGeOp     = Just (MO_S_Ge F64)
-translateOp DoubleLeOp     = Just (MO_S_Le F64)
-translateOp DoubleGtOp     = Just (MO_S_Gt F64)
-translateOp DoubleLtOp     = Just (MO_S_Lt F64)
-
-translateOp DoubleAddOp    = Just (MO_Add F64)
-translateOp DoubleSubOp    = Just (MO_Sub F64)
-translateOp DoubleMulOp    = Just (MO_Mul F64)
-translateOp DoubleDivOp    = Just (MO_S_Quot F64)
-translateOp DoubleNegOp    = Just (MO_S_Neg F64)
-
--- Float ops
-
-translateOp FloatEqOp     = Just (MO_Eq F32)
-translateOp FloatNeOp     = Just (MO_Ne F32)
-translateOp FloatGeOp     = Just (MO_S_Ge F32)
-translateOp FloatLeOp     = Just (MO_S_Le F32)
-translateOp FloatGtOp     = Just (MO_S_Gt F32)
-translateOp FloatLtOp     = Just (MO_S_Lt F32)
-
-translateOp FloatAddOp    = Just (MO_Add F32)
-translateOp FloatSubOp    = Just (MO_Sub F32)
-translateOp FloatMulOp    = Just (MO_Mul F32)
-translateOp FloatDivOp    = Just (MO_S_Quot F32)
-translateOp FloatNegOp    = Just (MO_S_Neg F32)
-
--- Conversions
-
-translateOp Int2DoubleOp   = Just (MO_S_Conv wordRep F64)
-translateOp Double2IntOp   = Just (MO_S_Conv F64 wordRep)
-
-translateOp Int2FloatOp    = Just (MO_S_Conv wordRep F32)
-translateOp Float2IntOp    = Just (MO_S_Conv F32 wordRep)
-
-translateOp Float2DoubleOp = Just (MO_S_Conv F32 F64)
-translateOp Double2FloatOp = Just (MO_S_Conv F64 F32)
-
--- Word comparisons masquerading as more exotic things.
-
-translateOp SameMutVarOp           = Just mo_wordEq
-translateOp SameMVarOp             = Just mo_wordEq
-translateOp SameMutableArrayOp     = Just mo_wordEq
-translateOp SameMutableByteArrayOp = Just mo_wordEq
-translateOp SameTVarOp             = Just mo_wordEq
-translateOp EqStablePtrOp          = Just mo_wordEq
-
-translateOp _ = Nothing
-
--- These primops are implemented by CallishMachOps, because they sometimes
--- turn into foreign calls depending on the backend.
-
-callishOp DoublePowerOp  = Just MO_F64_Pwr
-callishOp DoubleSinOp    = Just MO_F64_Sin
-callishOp DoubleCosOp    = Just MO_F64_Cos
-callishOp DoubleTanOp    = Just MO_F64_Tan
-callishOp DoubleSinhOp   = Just MO_F64_Sinh
-callishOp DoubleCoshOp   = Just MO_F64_Cosh
-callishOp DoubleTanhOp   = Just MO_F64_Tanh
-callishOp DoubleAsinOp   = Just MO_F64_Asin
-callishOp DoubleAcosOp   = Just MO_F64_Acos
-callishOp DoubleAtanOp   = Just MO_F64_Atan
-callishOp DoubleLogOp    = Just MO_F64_Log
-callishOp DoubleExpOp    = Just MO_F64_Exp
-callishOp DoubleSqrtOp   = Just MO_F64_Sqrt
-
-callishOp FloatPowerOp  = Just MO_F32_Pwr
-callishOp FloatSinOp    = Just MO_F32_Sin
-callishOp FloatCosOp    = Just MO_F32_Cos
-callishOp FloatTanOp    = Just MO_F32_Tan
-callishOp FloatSinhOp   = Just MO_F32_Sinh
-callishOp FloatCoshOp   = Just MO_F32_Cosh
-callishOp FloatTanhOp   = Just MO_F32_Tanh
-callishOp FloatAsinOp   = Just MO_F32_Asin
-callishOp FloatAcosOp   = Just MO_F32_Acos
-callishOp FloatAtanOp   = Just MO_F32_Atan
-callishOp FloatLogOp    = Just MO_F32_Log
-callishOp FloatExpOp    = Just MO_F32_Exp
-callishOp FloatSqrtOp   = Just MO_F32_Sqrt
-
-callishOp _ = Nothing
-
-------------------------------------------------------------------------------
--- Helpers for translating various minor variants of array indexing.
-
-doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx]
-   = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx
-doIndexOffAddrOp _ _ _ _
-   = panic "CgPrimOp: doIndexOffAddrOp"
-
-doIndexByteArrayOp maybe_post_read_cast rep [res] [addr,idx]
-   = mkBasicIndexedRead arrWordsHdrSize maybe_post_read_cast rep res addr idx
-doIndexByteArrayOp _ _ _ _ 
-   = panic "CgPrimOp: doIndexByteArrayOp"
-
-doReadPtrArrayOp res addr idx
-   = mkBasicIndexedRead arrPtrsHdrSize Nothing wordRep res addr idx
-
-
-doWriteOffAddrOp maybe_pre_write_cast rep [] [addr,idx,val]
-   = mkBasicIndexedWrite 0 maybe_pre_write_cast rep addr idx val
-doWriteOffAddrOp _ _ _ _
-   = panic "CgPrimOp: doWriteOffAddrOp"
-
-doWriteByteArrayOp maybe_pre_write_cast rep [] [addr,idx,val]
-   = mkBasicIndexedWrite arrWordsHdrSize maybe_pre_write_cast rep addr idx val
-doWriteByteArrayOp _ _ _ _ 
-   = panic "CgPrimOp: doWriteByteArrayOp"
-
-doWritePtrArrayOp addr idx val
-   = do stmtC (setInfo addr (CmmLit (CmmLabel mkMAP_DIRTY_infoLabel)))
-        mkBasicIndexedWrite arrPtrsHdrSize Nothing wordRep addr idx val
-
-
-mkBasicIndexedRead off Nothing read_rep res base idx
-   = stmtC (CmmAssign res (cmmLoadIndexOffExpr off read_rep base idx))
-mkBasicIndexedRead off (Just cast) read_rep res base idx
-   = stmtC (CmmAssign res (CmmMachOp cast [
-				cmmLoadIndexOffExpr off read_rep base idx]))
-
-mkBasicIndexedWrite off Nothing write_rep base idx val
-   = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) val)
-mkBasicIndexedWrite off (Just cast) write_rep base idx val
-   = stmtC (CmmStore (cmmIndexOffExpr off write_rep base idx) (CmmMachOp cast [val]))
-
--- ----------------------------------------------------------------------------
--- Misc utils
-
-cmmIndexOffExpr :: ByteOff -> MachRep -> CmmExpr -> CmmExpr -> CmmExpr
-cmmIndexOffExpr off rep base idx
-   = cmmIndexExpr rep (cmmOffsetB base off) idx
-
-cmmLoadIndexOffExpr :: ByteOff -> MachRep -> CmmExpr -> CmmExpr -> CmmExpr
-cmmLoadIndexOffExpr off rep base idx
-   = CmmLoad (cmmIndexOffExpr off rep base idx) rep
-
-setInfo :: CmmExpr -> CmmExpr -> CmmStmt
-setInfo closure_ptr info_ptr = CmmStore closure_ptr info_ptr
-
diff --git a/ghc/compiler/codeGen/CgProf.hs b/ghc/compiler/codeGen/CgProf.hs
deleted file mode 100644
index 1488e34956..0000000000
--- a/ghc/compiler/codeGen/CgProf.hs
+++ /dev/null
@@ -1,478 +0,0 @@
------------------------------------------------------------------------------
---
--- Code generation for profiling
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
-module CgProf (
-	mkCCostCentre, mkCCostCentreStack,
-
-	-- Cost-centre Profiling
-	dynProfHdr, profDynAlloc, profAlloc, staticProfHdr, initUpdFrameProf,
-	enterCostCentre, enterCostCentrePAP, enterCostCentreThunk, 
-	chooseDynCostCentres, 
-	costCentreFrom, 
-	curCCS, curCCSAddr,
-	emitCostCentreDecl, emitCostCentreStackDecl, 
-	emitRegisterCC, emitRegisterCCS,
-	emitSetCCC, emitCCS,
-
-	-- Lag/drag/void stuff
-	ldvEnter, ldvRecordCreate
-  ) where
-
-#include "HsVersions.h"
-#include "MachDeps.h"
- -- For WORD_SIZE_IN_BITS only.
-#include "../includes/Constants.h"
-	-- For LDV_CREATE_MASK, LDV_STATE_USE
-	-- which are StgWords
-#include "../includes/DerivedConstants.h"
-	-- For REP_xxx constants, which are MachReps
-
-import ClosureInfo	( ClosureInfo, closureSize,
-			  closureName, isToplevClosure, closureReEntrant, )
-import CgUtils
-import CgMonad
-import SMRep		( StgWord, profHdrSize )
-
-import Cmm
-import MachOp
-import CmmUtils		( zeroCLit, mkIntCLit, mkLblExpr )
-import CLabel		( mkCCLabel, mkCCSLabel, mkRtsDataLabel )
-
-import Module		( moduleString )
-import Id		( Id )
-import CostCentre
-import StgSyn		( GenStgExpr(..), StgExpr )
-import StaticFlags	( opt_SccProfilingOn )
-import FastString	( FastString, mkFastString, LitString )	
-import Constants	-- Lots of field offsets
-import Outputable
-
-import Maybe
-import Char		( ord )
-import Monad		( when )
-
------------------------------------------------------------------------------
---
--- Cost-centre-stack Profiling
---
------------------------------------------------------------------------------
-
--- Expression representing the current cost centre stack
-curCCS :: CmmExpr
-curCCS = CmmLoad curCCSAddr wordRep
-
--- Address of current CCS variable, for storing into
-curCCSAddr :: CmmExpr
-curCCSAddr = CmmLit (CmmLabel (mkRtsDataLabel SLIT("CCCS")))
-
-mkCCostCentre :: CostCentre -> CmmLit
-mkCCostCentre cc = CmmLabel (mkCCLabel cc)
-
-mkCCostCentreStack :: CostCentreStack -> CmmLit
-mkCCostCentreStack ccs = CmmLabel (mkCCSLabel ccs)
-
-costCentreFrom :: CmmExpr 	-- A closure pointer
-	       -> CmmExpr	-- The cost centre from that closure
-costCentreFrom cl = CmmLoad (cmmOffsetB cl oFFSET_StgHeader_ccs) wordRep
-
-staticProfHdr :: CostCentreStack -> [CmmLit]
--- The profiling header words in a static closure
--- Was SET_STATIC_PROF_HDR
-staticProfHdr ccs = ifProfilingL [mkCCostCentreStack ccs, 
-			  	  staticLdvInit]
-
-dynProfHdr :: CmmExpr -> [CmmExpr]
--- Profiling header words in a dynamic closure
-dynProfHdr ccs = ifProfilingL [ccs, dynLdvInit]
-
-initUpdFrameProf :: CmmExpr -> Code
--- Initialise the profiling field of an update frame
-initUpdFrameProf frame_amode 
-  = ifProfiling $	-- frame->header.prof.ccs = CCCS
-    stmtC (CmmStore (cmmOffsetB frame_amode oFFSET_StgHeader_ccs) curCCS)
-	-- frame->header.prof.hp.rs = NULL (or frame-header.prof.hp.ldvw = 0) 
-	-- is unnecessary because it is not used anyhow.
-
--- -----------------------------------------------------------------------------
--- Recording allocation in a cost centre
-
--- | Record the allocation of a closure.  The CmmExpr is the cost
--- centre stack to which to attribute the allocation.
-profDynAlloc :: ClosureInfo -> CmmExpr -> Code
-profDynAlloc cl_info ccs
-  = ifProfiling $
-    profAlloc (CmmLit (mkIntCLit (closureSize cl_info))) ccs
-
--- | Record the allocation of a closure (size is given by a CmmExpr)
--- The size must be in words, because the allocation counter in a CCS counts
--- in words.
-profAlloc :: CmmExpr -> CmmExpr -> Code
-profAlloc words ccs
-  = ifProfiling $
-    stmtC (addToMemE alloc_rep
-		(cmmOffsetB ccs oFFSET_CostCentreStack_mem_alloc)
-	  	(CmmMachOp (MO_U_Conv wordRep alloc_rep) $
-		  [CmmMachOp mo_wordSub [words, 
-					 CmmLit (mkIntCLit profHdrSize)]]))
-		-- subtract the "profiling overhead", which is the
-		-- profiling header in a closure.
- where 
-	alloc_rep =  REP_CostCentreStack_mem_alloc
-
--- ----------------------------------------------------------------------
--- Setting the cost centre in a new closure
-
-chooseDynCostCentres :: CostCentreStack
-		     -> [Id] 	 	-- Args
-		     -> StgExpr		-- Body
-		     -> FCode (CmmExpr, CmmExpr)
--- Called when alllcating a closure
--- Tells which cost centre to put in the object, and which
--- to blame the cost of allocation on
-chooseDynCostCentres ccs args body = do
-  -- Cost-centre we record in the object
-  use_ccs <- emitCCS ccs
-
-  -- Cost-centre on whom we blame the allocation
-  let blame_ccs
-	| null args && isBox body = CmmLit (mkCCostCentreStack overheadCCS)
-	| otherwise		  = use_ccs
-
-  return (use_ccs, blame_ccs)
-
-
--- Some CostCentreStacks are a sequence of pushes on top of CCCS.
--- These pushes must be performed before we can refer to the stack in
--- an expression.
-emitCCS :: CostCentreStack -> FCode CmmExpr
-emitCCS ccs = push_em (ccsExpr ccs') (reverse cc's)
-  where
-	(cc's, ccs') = decomposeCCS ccs
-
-	push_em ccs [] = return ccs
-	push_em ccs (cc:rest) = do
-  	  tmp <- newTemp wordRep
-	  pushCostCentre tmp ccs cc
-	  push_em (CmmReg tmp) rest
-
-ccsExpr :: CostCentreStack -> CmmExpr
-ccsExpr ccs
-  | isCurrentCCS ccs = curCCS
-  | otherwise        = CmmLit (mkCCostCentreStack ccs)
-
-
-isBox :: StgExpr -> Bool
--- If it's an utterly trivial RHS, then it must be
--- one introduced by boxHigherOrderArgs for profiling,
--- so we charge it to "OVERHEAD".
--- This looks like a GROSS HACK to me --SDM
-isBox (StgApp fun []) = True
-isBox other	      = False
-
-
--- -----------------------------------------------------------------------
--- Setting the current cost centre on entry to a closure
-
--- For lexically scoped profiling we have to load the cost centre from
--- the closure entered, if the costs are not supposed to be inherited.
--- This is done immediately on entering the fast entry point.
-
--- Load current cost centre from closure, if not inherited.
--- Node is guaranteed to point to it, if profiling and not inherited.
-
-enterCostCentre
-   :: ClosureInfo 
-   -> CostCentreStack
-   -> StgExpr	-- The RHS of the closure
-   -> Code
-
--- We used to have a special case for bindings of form
---	f = g True
--- where g has arity 2.  The RHS is a thunk, but we don't
--- need to update it; and we want to subsume costs.
--- We don't have these sort of PAPs any more, so the special
--- case has gone away.
-
-enterCostCentre closure_info ccs body
-  = ifProfiling $
-    ASSERT2(not (noCCSAttached ccs), ppr (closureName closure_info) <+> ppr ccs)
-    enter_cost_centre closure_info ccs body
-
-enter_cost_centre closure_info ccs body
-  | isSubsumedCCS ccs
-  = ASSERT(isToplevClosure closure_info)
-    ASSERT(re_entrant)
-    enter_ccs_fsub
-	
-  | isDerivedFromCurrentCCS ccs
-  = do {
-	if re_entrant && not is_box
-    	  then
-		enter_ccs_fun node_ccs
-    	  else
-	  	stmtC (CmmStore curCCSAddr node_ccs)
-
-	-- don't forget to bump the scc count.  This closure might have been
-	-- of the form   let x = _scc_ "x" e in ...x..., which the SCCfinal
-	-- pass has turned into simply  let x = e in ...x... and attached
-	-- the _scc_ as PushCostCentre(x,CCCS) on the x closure.  So that
-	-- we don't lose the scc counter, bump it in the entry code for x.
-	-- ToDo: for a multi-push we should really bump the counter for
-	-- each of the intervening CCSs, not just the top one.
-       ; when (not (isCurrentCCS ccs)) $
-		stmtC (bumpSccCount curCCS)
-       }
-
-  | isCafCCS ccs
-  = ASSERT(isToplevClosure closure_info)
-    ASSERT(not re_entrant)
-    do	{ 	-- This is just a special case of the isDerivedFromCurrentCCS
-		-- case above.  We could delete this, but it's a micro
-		-- optimisation and saves a bit of code.
-	  stmtC (CmmStore curCCSAddr enc_ccs)
-	; stmtC (bumpSccCount node_ccs)
-	}
-
-  | otherwise
-  = panic "enterCostCentre"
-  where
-    enc_ccs    = CmmLit (mkCCostCentreStack ccs)
-    re_entrant = closureReEntrant closure_info
-    node_ccs   = costCentreFrom (CmmReg nodeReg)
-    is_box     = isBox body
-
--- set the current CCS when entering a PAP
-enterCostCentrePAP :: CmmExpr -> Code
-enterCostCentrePAP closure = 
-  ifProfiling $ do 
-    enter_ccs_fun (costCentreFrom closure)
-    enteringPAP 1
-  
-enterCostCentreThunk :: CmmExpr -> Code
-enterCostCentreThunk closure = 
-  ifProfiling $ do 
-    stmtC $ CmmStore curCCSAddr (costCentreFrom closure)
-
-enter_ccs_fun stack = emitRtsCall SLIT("EnterFunCCS") [(stack,PtrHint)]
-			-- ToDo: vols
-
-enter_ccs_fsub = enteringPAP 0
-
--- When entering a PAP, EnterFunCCS is called by both the PAP entry
--- code and the function entry code; we don't want the function's
--- entry code to also update CCCS in the event that it was called via
--- a PAP, so we set the flag entering_PAP to indicate that we are
--- entering via a PAP.
-enteringPAP :: Integer -> Code
-enteringPAP n
-  = stmtC (CmmStore (CmmLit (CmmLabel (mkRtsDataLabel SLIT("entering_PAP"))))
-		(CmmLit (CmmInt n cIntRep)))
-
-ifProfiling :: Code -> Code
-ifProfiling code
-  | opt_SccProfilingOn = code
-  | otherwise	       = nopC
-
-ifProfilingL :: [a] -> [a]
-ifProfilingL xs
-  | opt_SccProfilingOn = xs
-  | otherwise	       = []
-
-
--- ---------------------------------------------------------------------------
--- Initialising Cost Centres & CCSs
-
-emitCostCentreDecl
-   :: CostCentre
-   -> Code
-emitCostCentreDecl cc = do 
-  { label <- mkStringCLit (costCentreUserName cc)
-  ; modl  <- mkStringCLit (moduleString (cc_mod cc))
-  ; let
-     lits = [ zero,   	-- StgInt ccID,
-	      label,	-- char *label,
-	      modl,	-- char *module,
-              zero,	-- StgWord time_ticks
-              zero64,	-- StgWord64 mem_alloc
-	      subsumed, -- StgInt is_caf
-	      zero	-- struct _CostCentre *link
-	    ] 
-  ; emitDataLits (mkCCLabel cc) lits
-  }
-  where
-	subsumed | isCafCC cc = mkIntCLit (ord 'c')  -- 'c' == is a CAF
-		 | otherwise  = mkIntCLit (ord 'B')  -- 'B' == is boring
-	    
-
-emitCostCentreStackDecl
-   :: CostCentreStack
-   -> Code
-emitCostCentreStackDecl ccs 
-  | Just cc <- maybeSingletonCCS ccs = do
-  { let
-	-- Note: to avoid making any assumptions about how the
-	-- C compiler (that compiles the RTS, in particular) does
-	-- layouts of structs containing long-longs, simply
-	-- pad out the struct with zero words until we hit the
-	-- size of the overall struct (which we get via DerivedConstants.h)
-	--
-     lits = zero : mkCCostCentre cc : replicate (sizeof_ccs_words - 2) zero
-  ; emitDataLits (mkCCSLabel ccs) lits
-  }
-  | otherwise = pprPanic "emitCostCentreStackDecl" (ppr ccs)
-
-zero = mkIntCLit 0
-zero64 = CmmInt 0 I64
-
-sizeof_ccs_words :: Int
-sizeof_ccs_words 
-    -- round up to the next word.
-  | ms == 0   = ws
-  | otherwise = ws + 1
-  where
-   (ws,ms) = SIZEOF_CostCentreStack `divMod` wORD_SIZE
-
--- ---------------------------------------------------------------------------
--- Registering CCs and CCSs
-
---   (cc)->link = CC_LIST;
---   CC_LIST = (cc);
---   (cc)->ccID = CC_ID++;
-
-emitRegisterCC :: CostCentre -> Code
-emitRegisterCC cc = do
-  { tmp <- newTemp cIntRep
-  ; stmtsC [
-     CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_link)
-		 (CmmLoad cC_LIST wordRep),
-     CmmStore cC_LIST cc_lit,
-     CmmAssign tmp (CmmLoad cC_ID cIntRep),
-     CmmStore (cmmOffsetB cc_lit oFFSET_CostCentre_ccID) (CmmReg tmp),
-     CmmStore cC_ID (cmmRegOffB tmp 1)
-   ]
-  }
-  where
-    cc_lit = CmmLit (CmmLabel (mkCCLabel cc))
-
---  (ccs)->prevStack = CCS_LIST;
---  CCS_LIST = (ccs);
---  (ccs)->ccsID = CCS_ID++;
-
-emitRegisterCCS :: CostCentreStack -> Code
-emitRegisterCCS ccs = do
-  { tmp <- newTemp cIntRep
-  ; stmtsC [
-     CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_prevStack) 
-			(CmmLoad cCS_LIST wordRep),
-     CmmStore cCS_LIST ccs_lit,
-     CmmAssign tmp (CmmLoad cCS_ID cIntRep),
-     CmmStore (cmmOffsetB ccs_lit oFFSET_CostCentreStack_ccsID) (CmmReg tmp),
-     CmmStore cCS_ID (cmmRegOffB tmp 1)
-   ]
-  }
-  where
-    ccs_lit = CmmLit (CmmLabel (mkCCSLabel ccs))
-
-
-cC_LIST = CmmLit (CmmLabel (mkRtsDataLabel SLIT("CC_LIST")))
-cC_ID   = CmmLit (CmmLabel (mkRtsDataLabel SLIT("CC_ID")))
-
-cCS_LIST = CmmLit (CmmLabel (mkRtsDataLabel SLIT("CCS_LIST")))
-cCS_ID   = CmmLit (CmmLabel (mkRtsDataLabel SLIT("CCS_ID")))
-
--- ---------------------------------------------------------------------------
--- Set the current cost centre stack
-
-emitSetCCC :: CostCentre -> Code
-emitSetCCC cc
-  | not opt_SccProfilingOn = nopC
-  | otherwise = do 
-    tmp <- newTemp wordRep
-    ASSERT( sccAbleCostCentre cc )
-      pushCostCentre tmp curCCS cc
-    stmtC (CmmStore curCCSAddr (CmmReg tmp))
-    when (isSccCountCostCentre cc) $ 
-	stmtC (bumpSccCount curCCS)
-
-pushCostCentre :: CmmReg -> CmmExpr -> CostCentre -> Code
-pushCostCentre result ccs cc
-  = emitRtsCallWithResult result PtrHint
-	SLIT("PushCostCentre") [(ccs,PtrHint), 
-				(CmmLit (mkCCostCentre cc), PtrHint)]
-
-bumpSccCount :: CmmExpr -> CmmStmt
-bumpSccCount ccs
-  = addToMem REP_CostCentreStack_scc_count
-	 (cmmOffsetB ccs oFFSET_CostCentreStack_scc_count) 1
-
------------------------------------------------------------------------------
---
---		Lag/drag/void stuff
---
------------------------------------------------------------------------------
-
---
--- Initial value for the LDV field in a static closure
---
-staticLdvInit :: CmmLit
-staticLdvInit = zeroCLit
-
---
--- Initial value of the LDV field in a dynamic closure
---
-dynLdvInit :: CmmExpr
-dynLdvInit =     -- (era << LDV_SHIFT) | LDV_STATE_CREATE  
-  CmmMachOp mo_wordOr [
-      CmmMachOp mo_wordShl [loadEra, CmmLit (mkIntCLit lDV_SHIFT) ],
-      CmmLit (mkWordCLit lDV_STATE_CREATE)
-  ]
-        
---
--- Initialise the LDV word of a new closure
---
-ldvRecordCreate :: CmmExpr -> Code
-ldvRecordCreate closure = stmtC $ CmmStore (ldvWord closure) dynLdvInit
-
---
--- Called when a closure is entered, marks the closure as having been "used".
--- The closure is not an 'inherently used' one.
--- The closure is not IND or IND_OLDGEN because neither is considered for LDV
--- profiling.
---
-ldvEnter :: CmmExpr -> Code
--- Argument is a closure pointer
-ldvEnter cl_ptr 
-  =  ifProfiling $
-     -- if (era > 0) {
-     --    LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) |
-     --                era | LDV_STATE_USE }
-    emitIf (CmmMachOp mo_wordUGt [loadEra, CmmLit zeroCLit])
-	   (stmtC (CmmStore ldv_wd new_ldv_wd))
-  where
-    ldv_wd = ldvWord cl_ptr
-    new_ldv_wd = cmmOrWord (cmmAndWord (CmmLoad ldv_wd wordRep)
-				       (CmmLit (mkWordCLit lDV_CREATE_MASK)))
-		 (cmmOrWord loadEra (CmmLit (mkWordCLit lDV_STATE_USE)))
-
-loadEra :: CmmExpr 
-loadEra = CmmMachOp (MO_U_Conv cIntRep wordRep)
-	  [CmmLoad (mkLblExpr (mkRtsDataLabel SLIT("era"))) cIntRep]
-
-ldvWord :: CmmExpr -> CmmExpr
--- Takes the address of a closure, and returns 
--- the address of the LDV word in the closure
-ldvWord closure_ptr = cmmOffsetB closure_ptr oFFSET_StgHeader_ldvw
-
--- LDV constants, from ghc/includes/Constants.h
-lDV_SHIFT	 = (LDV_SHIFT :: Int)
---lDV_STATE_MASK   = (LDV_STATE_MASK :: StgWord)
-lDV_CREATE_MASK  = (LDV_CREATE_MASK :: StgWord)
---lDV_LAST_MASK    = (LDV_LAST_MASK :: StgWord)
-lDV_STATE_CREATE = (LDV_STATE_CREATE :: StgWord)
-lDV_STATE_USE    = (LDV_STATE_USE :: StgWord)
-
diff --git a/ghc/compiler/codeGen/CgStackery.lhs b/ghc/compiler/codeGen/CgStackery.lhs
deleted file mode 100644
index 7cb310d521..0000000000
--- a/ghc/compiler/codeGen/CgStackery.lhs
+++ /dev/null
@@ -1,339 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-% $Id: CgStackery.lhs,v 1.27 2004/09/30 10:35:49 simonpj Exp $
-%
-\section[CgStackery]{Stack management functions}
-
-Stack-twiddling operations, which are pretty low-down and grimy.
-(This is the module that knows all about stack layouts, etc.)
-
-\begin{code}
-module CgStackery (
-	spRel, getVirtSp, getRealSp, setRealSp,
-	setRealAndVirtualSp, getSpRelOffset,
-
-	allocPrimStack, allocStackTop, deAllocStackTop,
-	adjustStackHW, getFinalStackHW, 
-	setStackFrame, getStackFrame,
-	mkVirtStkOffsets, mkStkAmodes,
-	freeStackSlots, 
-	pushUpdateFrame, emitPushUpdateFrame,
-    ) where
-
-#include "HsVersions.h"
-
-import CgMonad
-import CgUtils		( cmmOffsetB, cmmRegOffW )
-import CgProf		( initUpdFrameProf )
-import SMRep
-import Cmm
-import CmmUtils		( CmmStmts, mkLblExpr )
-import CLabel		( mkUpdInfoLabel )
-import Constants
-import Util		( sortLe )
-import FastString	( LitString )
-import OrdList		( toOL )
-import Outputable
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[CgUsages-stackery]{Monad things for fiddling with stack usage}
-%*									*
-%************************************************************************
-
-spRel is a little function that abstracts the stack direction.  Note that most
-of the code generator is dependent on the stack direction anyway, so
-changing this on its own spells certain doom.  ToDo: remove?
-
-	THIS IS DIRECTION SENSITIVE!
-
-Stack grows down, positive virtual offsets correspond to negative
-additions to the stack pointer.
-
-\begin{code}
-spRel :: VirtualSpOffset 	-- virtual offset of Sp
-      -> VirtualSpOffset 	-- virtual offset of The Thing
-      -> WordOff		-- integer offset
-spRel sp off = sp - off
-\end{code}
-
-@setRealAndVirtualSp@ sets into the environment the offsets of the
-current position of the real and virtual stack pointers in the current
-stack frame.  The high-water mark is set too.  It generates no code.
-It is used to initialise things at the beginning of a closure body.
-
-\begin{code}
-setRealAndVirtualSp :: VirtualSpOffset 	-- New real Sp
-		     -> Code
-
-setRealAndVirtualSp new_sp 
-  = do	{ stk_usg <- getStkUsage
-	; setStkUsage (stk_usg {virtSp = new_sp, 
-				realSp = new_sp, 
-				hwSp   = new_sp}) }
-
-getVirtSp :: FCode VirtualSpOffset
-getVirtSp
-  = do	{ stk_usg <- getStkUsage
-	; return (virtSp stk_usg) }
-
-getRealSp :: FCode VirtualSpOffset
-getRealSp
-  = do	{ stk_usg <- getStkUsage
-	; return (realSp stk_usg) }
-
-setRealSp :: VirtualSpOffset -> Code
-setRealSp new_real_sp
-  = do	{ stk_usg <- getStkUsage
-	; setStkUsage (stk_usg {realSp = new_real_sp}) }
-
-getSpRelOffset :: VirtualSpOffset -> FCode CmmExpr
-getSpRelOffset virtual_offset
-  = do	{ real_sp <- getRealSp
-	; return (cmmRegOffW spReg (spRel real_sp virtual_offset)) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[CgStackery-layout]{Laying out a stack frame}
-%*									*
-%************************************************************************
-
-'mkVirtStkOffsets' is given a list of arguments.  The first argument
-gets the /largest/ virtual stack offset (remember, virtual offsets
-increase towards the top of stack).
-
-\begin{code}
-mkVirtStkOffsets
-	  :: VirtualSpOffset 	-- Offset of the last allocated thing
-	  -> [(CgRep,a)]		-- things to make offsets for
-	  -> (VirtualSpOffset,		-- OUTPUTS: Topmost allocated word
-	      [(a, VirtualSpOffset)])	-- things with offsets (voids filtered out)
-
-mkVirtStkOffsets init_Sp_offset things
-    = loop init_Sp_offset [] (reverse things)
-  where
-    loop offset offs [] = (offset,offs)
-    loop offset offs ((VoidArg,t):things) = loop offset offs things
-	-- ignore Void arguments
-    loop offset offs ((rep,t):things)
-	= loop thing_slot ((t,thing_slot):offs) things
-	where
-	  thing_slot = offset + cgRepSizeW rep
-	    -- offset of thing is offset+size, because we're 
-	    -- growing the stack *downwards* as the offsets increase.
-
--- | 'mkStkAmodes' is a higher-level version of
--- 'mkVirtStkOffsets'.  It starts from the tail-call locations.
--- It returns a single list of addressing modes for the stack
--- locations, and therefore is in the monad.  It /doesn't/ adjust the
--- high water mark.
-
-mkStkAmodes 
-	:: VirtualSpOffset	    -- Tail call positions
-	-> [(CgRep,CmmExpr)]	    -- things to make offsets for
-	-> FCode (VirtualSpOffset,  -- OUTPUTS: Topmost allocated word
-	          CmmStmts)	    -- Assignments to appropriate stk slots
-
-mkStkAmodes tail_Sp things
-  = do	{ rSp <- getRealSp
-	; let (last_Sp_offset, offsets) = mkVirtStkOffsets tail_Sp things
-	      abs_cs = [ CmmStore (cmmRegOffW spReg (spRel rSp offset)) amode
-		       | (amode, offset) <- offsets
-		       ]
-	; returnFC (last_Sp_offset, toOL abs_cs) }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[CgStackery-monadery]{Inside-monad functions for stack manipulation}
-%*									*
-%************************************************************************
-
-Allocate a virtual offset for something.
-
-\begin{code}
-allocPrimStack :: CgRep -> FCode VirtualSpOffset
-allocPrimStack rep
-  = do	{ stk_usg <- getStkUsage
-	; let free_stk = freeStk stk_usg
-	; case find_block free_stk of
-	     Nothing -> do 
-		{ let push_virt_sp = virtSp stk_usg + size
-		; setStkUsage (stk_usg { virtSp = push_virt_sp,
-					 hwSp   = hwSp stk_usg `max` push_virt_sp })
-						-- Adjust high water mark
-		; return push_virt_sp }
-	     Just slot -> do
-		{ setStkUsage (stk_usg { freeStk = delete_block free_stk slot }) 
-		; return slot }
-	}
-  where
-    size :: WordOff
-    size = cgRepSizeW rep
-
-	-- Find_block looks for a contiguous chunk of free slots
-	-- returning the offset of its topmost word
-    find_block :: [VirtualSpOffset] -> Maybe VirtualSpOffset
-    find_block [] = Nothing
-    find_block (slot:slots)
-	| take size (slot:slots) == [slot..top_slot]
-	= Just top_slot
-	| otherwise
-	= find_block slots
-	where	-- The stack grows downwards, with increasing virtual offsets.
-		-- Therefore, the address of a multi-word object is the *highest*
-		-- virtual offset it occupies (top_slot below).
-	    top_slot = slot+size-1
-
-    delete_block free_stk slot = [ s | s <- free_stk, 
-				       (s<=slot-size) || (s>slot) ]
-		      -- Retain slots which are not in the range
-		      -- slot-size+1..slot
-\end{code}
-
-Allocate a chunk ON TOP OF the stack.  
-
-\begin{code}
-allocStackTop :: WordOff -> FCode VirtualSpOffset
-allocStackTop size
-  = do	{ stk_usg <- getStkUsage
-	; let push_virt_sp = virtSp stk_usg + size
-	; setStkUsage (stk_usg { virtSp = push_virt_sp,
-				 hwSp   = hwSp stk_usg `max` push_virt_sp })
-	; return push_virt_sp }
-\end{code}
-
-Pop some words from the current top of stack.  This is used for
-de-allocating the return address in a case alternative.
-
-\begin{code}
-deAllocStackTop :: WordOff -> FCode VirtualSpOffset
-deAllocStackTop size
-  = do	{ stk_usg <- getStkUsage
-	; let pop_virt_sp = virtSp stk_usg - size
-	; setStkUsage (stk_usg { virtSp = pop_virt_sp })
-	; return pop_virt_sp }
-\end{code}
-
-\begin{code}
-adjustStackHW :: VirtualSpOffset -> Code
-adjustStackHW offset
-  = do	{ stk_usg <- getStkUsage
-	; setStkUsage (stk_usg { hwSp = hwSp stk_usg `max` offset }) }
-\end{code}
-
-A knot-tying beast.
-
-\begin{code}
-getFinalStackHW :: (VirtualSpOffset -> Code) -> Code
-getFinalStackHW fcode
-  = do	{ fixC (\hw_sp -> do
-		{ fcode hw_sp
-		; stk_usg <- getStkUsage
-		; return (hwSp stk_usg) })
-	; return () }
-\end{code}
-
-\begin{code}
-setStackFrame :: VirtualSpOffset -> Code
-setStackFrame offset
-  = do	{ stk_usg <- getStkUsage
-	; setStkUsage (stk_usg { frameSp = offset }) }
-
-getStackFrame :: FCode VirtualSpOffset
-getStackFrame
-  = do	{ stk_usg <- getStkUsage
-	; return (frameSp stk_usg) }
-\end{code}
-
-
-%********************************************************
-%*							*
-%*		Setting up update frames		*
-%*							*
-%********************************************************
-
-@pushUpdateFrame@ $updatee$ pushes a general update frame which
-points to $updatee$ as the thing to be updated.  It is only used
-when a thunk has just been entered, so the (real) stack pointers
-are guaranteed to be nicely aligned with the top of stack.
-@pushUpdateFrame@ adjusts the virtual and tail stack pointers
-to reflect the frame pushed.
-
-\begin{code}
-pushUpdateFrame :: CmmExpr -> Code -> Code
-
-pushUpdateFrame updatee code
-  = do	{
-#ifdef DEBUG
-	  EndOfBlockInfo _ sequel <- getEndOfBlockInfo ;
-	  ASSERT(case sequel of { OnStack -> True; _ -> False})
-#endif
-
-	  allocStackTop (fixedHdrSize + 
-			   sIZEOF_StgUpdateFrame_NoHdr `quot` wORD_SIZE)
-	; vsp <- getVirtSp
-	; setStackFrame vsp
-	; frame_addr <- getSpRelOffset vsp
-		-- The location of the lowest-address
-		-- word of the update frame itself
-
-	; setEndOfBlockInfo (EndOfBlockInfo vsp UpdateCode) $
-	    do	{ emitPushUpdateFrame frame_addr updatee
-		; code }
-	}
-
-emitPushUpdateFrame :: CmmExpr -> CmmExpr -> Code
-emitPushUpdateFrame frame_addr updatee = do
-	stmtsC [  -- Set the info word
-		  CmmStore frame_addr (mkLblExpr mkUpdInfoLabel)
-		, -- And the updatee
-		  CmmStore (cmmOffsetB frame_addr off_updatee) updatee ]
-	initUpdFrameProf frame_addr
-
-off_updatee :: ByteOff
-off_updatee = fixedHdrSize*wORD_SIZE + oFFSET_StgUpdateFrame_updatee
-\end{code}			
-
-
-%************************************************************************
-%*									*
-\subsection[CgStackery-free]{Free stack slots}
-%*									*
-%************************************************************************
-
-Explicitly free some stack space.
-
-\begin{code}
-freeStackSlots :: [VirtualSpOffset] -> Code
-freeStackSlots extra_free
-  = do	{ stk_usg <- getStkUsage
-	; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
-	; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
-	; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
-
-addFreeSlots :: [VirtualSpOffset] -> [VirtualSpOffset] -> [VirtualSpOffset]
--- Merge the two, assuming both are in increasing order
-addFreeSlots cs [] = cs
-addFreeSlots [] ns = ns
-addFreeSlots (c:cs) (n:ns)
-  | c < n     = c : addFreeSlots cs (n:ns)
-  | otherwise = n : addFreeSlots (c:cs) ns
-
-trim :: VirtualSpOffset -> [VirtualSpOffset] -> (VirtualSpOffset, [VirtualSpOffset])
--- Try to trim back the virtual stack pointer, where there is a
--- continuous bunch of free slots at the end of the free list
-trim vsp [] = (vsp, [])
-trim vsp (slot:slots)
-  = case trim vsp slots of
-      (vsp', []) 
-	| vsp' < slot  -> pprTrace "trim: strange" (ppr vsp <+> ppr (slot:slots))
-			  (vsp',   [])
-	| vsp' == slot -> (vsp'-1, [])
-	| otherwise    -> (vsp',   [slot])
-      (vsp', slots')   -> (vsp',   slot:slots')
-\end{code}
diff --git a/ghc/compiler/codeGen/CgTailCall.lhs b/ghc/compiler/codeGen/CgTailCall.lhs
deleted file mode 100644
index dd7327b745..0000000000
--- a/ghc/compiler/codeGen/CgTailCall.lhs
+++ /dev/null
@@ -1,455 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-% $Id: CgTailCall.lhs,v 1.43 2005/06/21 10:44:41 simonmar Exp $
-%
-%********************************************************
-%*							*
-\section[CgTailCall]{Tail calls: converting @StgApps@}
-%*							*
-%********************************************************
-
-\begin{code}
-module CgTailCall (
-	cgTailCall, performTailCall,
-	performReturn, performPrimReturn,
-	emitKnownConReturnCode, emitAlgReturnCode,
-	returnUnboxedTuple, ccallReturnUnboxedTuple,
-	pushUnboxedTuple,
-	tailCallPrimOp,
-
-	pushReturnAddress
-    ) where
-
-#include "HsVersions.h"
-
-import CgMonad
-import CgBindery	( getArgAmodes, getCgIdInfo, CgIdInfo, maybeLetNoEscape,
-			  idInfoToAmode, cgIdInfoId, cgIdInfoLF,
-			  cgIdInfoArgRep )
-import CgInfoTbls	( entryCode, emitDirectReturnInstr, dataConTagZ,
-			  emitVectoredReturnInstr, closureInfoPtr )
-import CgCallConv
-import CgStackery	( setRealSp, mkStkAmodes, adjustStackHW,
-			  getSpRelOffset )
-import CgHeapery	( setRealHp, getHpRelOffset )
-import CgUtils		( emitSimultaneously )
-import CgTicky
-import ClosureInfo
-import SMRep		( CgRep, isVoidArg, separateByPtrFollowness )
-import Cmm	
-import CmmUtils
-import CLabel		( CLabel, mkRtsPrimOpLabel, mkSeqInfoLabel )
-import Type		( isUnLiftedType )
-import Id		( Id, idName, idUnique, idType )
-import DataCon		( DataCon, dataConTyCon )
-import StgSyn		( StgArg )
-import TyCon            ( TyCon )
-import PrimOp		( PrimOp )
-import Outputable
-
-import Monad		( when )
-
------------------------------------------------------------------------------
--- Tail Calls
-
-cgTailCall :: Id -> [StgArg] -> Code
-
--- Here's the code we generate for a tail call.  (NB there may be no
--- arguments, in which case this boils down to just entering a variable.)
--- 
---    *	Put args in the top locations of the stack.
---    *	Adjust the stack ptr
---    *	Make R1 point to the function closure if necessary.
---    *	Perform the call.
---
--- Things to be careful about:
---
---    *	Don't overwrite stack locations before you have finished with
--- 	them (remember you need the function and the as-yet-unmoved
--- 	arguments).
---    *	Preferably, generate no code to replace x by x on the stack (a
--- 	common situation in tail-recursion).
---    *	Adjust the stack high water mark appropriately.
--- 
--- Treat unboxed locals exactly like literals (above) except use the addr
--- mode for the local instead of (CLit lit) in the assignment.
-
-cgTailCall fun args
-  = do	{ fun_info <- getCgIdInfo fun
-
-	; if isUnLiftedType (idType fun)
-	  then 	-- Primitive return
-		ASSERT( null args )
-	    do	{ fun_amode <- idInfoToAmode fun_info
-		; performPrimReturn (cgIdInfoArgRep fun_info) fun_amode } 
-
-	  else -- Normal case, fun is boxed
-	    do  { arg_amodes <- getArgAmodes args
-		; performTailCall fun_info arg_amodes noStmts }
-	}
-		
-
--- -----------------------------------------------------------------------------
--- The guts of a tail-call
-
-performTailCall 
-	:: CgIdInfo		-- The function
-	-> [(CgRep,CmmExpr)]	-- Args
-	-> CmmStmts		-- Pending simultaneous assignments
-				--  *** GUARANTEED to contain only stack assignments.
-	-> Code
-
-performTailCall fun_info arg_amodes pending_assts
-  | Just join_sp <- maybeLetNoEscape fun_info
-  = 	   -- A let-no-escape is slightly different, because we
-	   -- arrange the stack arguments into pointers and non-pointers
-	   -- to make the heap check easier.  The tail-call sequence
-	   -- is very similar to returning an unboxed tuple, so we
-	   -- share some code.
-     do	{ (final_sp, arg_assts) <- pushUnboxedTuple join_sp arg_amodes
-	; emitSimultaneously (pending_assts `plusStmts` arg_assts)
-	; let lbl = enterReturnPtLabel (idUnique (cgIdInfoId fun_info))
-	; doFinalJump final_sp True {- Is LNE -} (jumpToLbl lbl) }
-
-  | otherwise
-  = do 	{ fun_amode <- idInfoToAmode fun_info
-	; let node_asst = oneStmt (CmmAssign nodeReg fun_amode)
-	      opt_node_asst | nodeMustPointToIt lf_info = node_asst
-			    | otherwise		        = noStmts
-	; EndOfBlockInfo sp _ <- getEndOfBlockInfo
-	; hmods <- getHomeModules
-
-	; case (getCallMethod hmods fun_name lf_info (length arg_amodes)) of
-
-	    -- Node must always point to things we enter
-	    EnterIt -> do
-		{ emitSimultaneously (node_asst `plusStmts` pending_assts) 
-		; let target = entryCode (closureInfoPtr (CmmReg nodeReg))
-		; doFinalJump sp False (stmtC (CmmJump target [])) }
-    
-	    -- A function, but we have zero arguments.  It is already in WHNF,
-	    -- so we can just return it.  
-	    -- As with any return, Node must point to it.
-	    ReturnIt -> do
-		{ emitSimultaneously (node_asst `plusStmts` pending_assts)
-		; doFinalJump sp False emitDirectReturnInstr }
-    
-	    -- A real constructor.  Don't bother entering it, 
-	    -- just do the right sort of return instead.
-	    -- As with any return, Node must point to it.
-	    ReturnCon con -> do
-		{ emitSimultaneously (node_asst `plusStmts` pending_assts)
-		; doFinalJump sp False (emitKnownConReturnCode con) }
-
-	    JumpToIt lbl -> do
-		{ emitSimultaneously (opt_node_asst `plusStmts` pending_assts)
-		; doFinalJump sp False (jumpToLbl lbl) }
-    
-	    -- A slow function call via the RTS apply routines
-	    -- Node must definitely point to the thing
-	    SlowCall -> do 
-		{  when (not (null arg_amodes)) $ do
-		   { if (isKnownFun lf_info) 
-			then tickyKnownCallTooFewArgs
-			else tickyUnknownCall
-		   ; tickySlowCallPat (map fst arg_amodes) 
-		   }
-
-		; let (apply_lbl, args, extra_args) 
-			= constructSlowCall arg_amodes
-
-		; directCall sp apply_lbl args extra_args 
-			(node_asst `plusStmts` pending_assts)
-		}
-    
-	    -- A direct function call (possibly with some left-over arguments)
-	    DirectEntry lbl arity -> do
-		{ if arity == length arg_amodes
-			then tickyKnownCallExact
-			else do tickyKnownCallExtraArgs
-				tickySlowCallPat (map fst (drop arity arg_amodes))
-
- 		; let
-		     -- The args beyond the arity go straight on the stack
-		     (arity_args, extra_args) = splitAt arity arg_amodes
-     
-		; directCall sp lbl arity_args extra_args
-			(opt_node_asst `plusStmts` pending_assts)
-	        }
-	}
-  where
-    fun_name  = idName (cgIdInfoId fun_info)
-    lf_info   = cgIdInfoLF fun_info
-
-
-
-directCall sp lbl args extra_args assts = do
-  let
-	-- First chunk of args go in registers
-	(reg_arg_amodes, stk_args) = assignCallRegs args
-     
-	-- Any "extra" arguments are placed in frames on the
-	-- stack after the other arguments.
-	slow_stk_args = slowArgs extra_args
-
-	reg_assts = assignToRegs reg_arg_amodes
-  --
-  (final_sp, stk_assts) <- mkStkAmodes sp (stk_args ++ slow_stk_args)
-
-  emitSimultaneously (reg_assts     `plusStmts`
-		      stk_assts     `plusStmts`
-		      assts)
-
-  doFinalJump final_sp False (jumpToLbl lbl)
-
--- -----------------------------------------------------------------------------
--- The final clean-up before we do a jump at the end of a basic block.
--- This code is shared by tail-calls and returns.
-
-doFinalJump :: VirtualSpOffset -> Bool -> Code -> Code 
-doFinalJump final_sp is_let_no_escape jump_code
-  = do	{ -- Adjust the high-water mark if necessary
-	  adjustStackHW final_sp
-
-	-- Push a return address if necessary (after the assignments
-	-- above, in case we clobber a live stack location)
-	--
-	-- DONT push the return address when we're about to jump to a
-	-- let-no-escape: the final tail call in the let-no-escape
-	-- will do this.
-	; eob <- getEndOfBlockInfo
-	; whenC (not is_let_no_escape) (pushReturnAddress eob)
-
-	    -- Final adjustment of Sp/Hp
-	; adjustSpAndHp final_sp
-
-	    -- and do the jump
-	; jump_code }
-
--- -----------------------------------------------------------------------------
--- A general return (just a special case of doFinalJump, above)
-
-performReturn :: Code		-- The code to execute to actually do the return
-	      -> Code
-
-performReturn finish_code
-  = do  { EndOfBlockInfo args_sp sequel <- getEndOfBlockInfo
-	; doFinalJump args_sp False{-not a LNE-} finish_code }
-
--- -----------------------------------------------------------------------------
--- Primitive Returns
--- Just load the return value into the right register, and return.
-
-performPrimReturn :: CgRep -> CmmExpr	-- The thing to return
-		  -> Code
-performPrimReturn rep amode
-  =  do { whenC (not (isVoidArg rep))
-		(stmtC (CmmAssign ret_reg amode))
-	; performReturn emitDirectReturnInstr }
-  where
-    ret_reg = dataReturnConvPrim rep
-
--- -----------------------------------------------------------------------------
--- Algebraic constructor returns
-
--- Constructor is built on the heap; Node is set.
--- All that remains is to do the right sort of jump.
-
-emitKnownConReturnCode :: DataCon -> Code
-emitKnownConReturnCode con
-  = emitAlgReturnCode (dataConTyCon con)
-		      (CmmLit (mkIntCLit (dataConTagZ con)))
-			-- emitAlgReturnCode requires zero-indexed tag
-
-emitAlgReturnCode :: TyCon -> CmmExpr -> Code
--- emitAlgReturnCode is used both by emitKnownConReturnCode,
--- and by by PrimOps that return enumerated types (i.e.
--- all the comparison operators).
-emitAlgReturnCode tycon tag
- =  do	{ case ctrlReturnConvAlg tycon of
-	    VectoredReturn fam_sz -> do { tickyVectoredReturn fam_sz
-	 			     	; emitVectoredReturnInstr tag }
-	    UnvectoredReturn _    -> emitDirectReturnInstr 
-	}
-
-
--- ---------------------------------------------------------------------------
--- Unboxed tuple returns
-
--- These are a bit like a normal tail call, except that:
---
---   - The tail-call target is an info table on the stack
---
---   - We separate stack arguments into pointers and non-pointers,
---     to make it easier to leave things in a sane state for a heap check.
---     This is OK because we can never partially-apply an unboxed tuple,
---     unlike a function.  The same technique is used when calling
---     let-no-escape functions, because they also can't be partially
---     applied.
-
-returnUnboxedTuple :: [(CgRep, CmmExpr)] -> Code
-returnUnboxedTuple amodes
-  = do 	{ eob@(EndOfBlockInfo args_sp sequel) <- getEndOfBlockInfo
-	; tickyUnboxedTupleReturn (length amodes)
-	; (final_sp, assts) <- pushUnboxedTuple args_sp amodes
-	; emitSimultaneously assts
-	; doFinalJump final_sp False{-not a LNE-} emitDirectReturnInstr }
-
-pushUnboxedTuple :: VirtualSpOffset		-- Sp at which to start pushing
-		 -> [(CgRep, CmmExpr)]		-- amodes of the components
-		 -> FCode (VirtualSpOffset,	-- final Sp
-			   CmmStmts)		-- assignments (regs+stack)
-
-pushUnboxedTuple sp [] 
-  = return (sp, noStmts)
-pushUnboxedTuple sp amodes
-  = do	{ let	(reg_arg_amodes, stk_arg_amodes) = assignReturnRegs amodes
-	
-		-- separate the rest of the args into pointers and non-pointers
-		(ptr_args, nptr_args) = separateByPtrFollowness stk_arg_amodes
-		reg_arg_assts = assignToRegs reg_arg_amodes
-		
-	    -- push ptrs, then nonptrs, on the stack
-	; (ptr_sp,   ptr_assts)  <- mkStkAmodes sp ptr_args
-	; (final_sp, nptr_assts) <- mkStkAmodes ptr_sp nptr_args
-
-	; returnFC (final_sp,
-	  	    reg_arg_assts `plusStmts` 
-		    ptr_assts `plusStmts` nptr_assts) }
-    
-		  
--- -----------------------------------------------------------------------------
--- Returning unboxed tuples.  This is mainly to support _ccall_GC_, where
--- we want to do things in a slightly different order to normal:
--- 
--- 		- push return address
--- 		- adjust stack pointer
--- 		- r = call(args...)
--- 		- assign regs for unboxed tuple (usually just R1 = r)
--- 		- return to continuation
--- 
--- The return address (i.e. stack frame) must be on the stack before
--- doing the call in case the call ends up in the garbage collector.
--- 
--- Sadly, the information about the continuation is lost after we push it
--- (in order to avoid pushing it again), so we end up doing a needless
--- indirect jump (ToDo).
-
-ccallReturnUnboxedTuple :: [(CgRep, CmmExpr)] -> Code -> Code
-ccallReturnUnboxedTuple amodes before_jump
-  = do 	{ eob@(EndOfBlockInfo args_sp _) <- getEndOfBlockInfo
-
-	-- Push a return address if necessary
-	; pushReturnAddress eob
-	; setEndOfBlockInfo (EndOfBlockInfo args_sp OnStack)
-	    (do	{ adjustSpAndHp args_sp
-		; before_jump
-  		; returnUnboxedTuple amodes })
-    }
-
--- -----------------------------------------------------------------------------
--- Calling an out-of-line primop
-
-tailCallPrimOp :: PrimOp -> [StgArg] -> Code
-tailCallPrimOp op args
- = do	{	-- We're going to perform a normal-looking tail call, 
-		-- except that *all* the arguments will be in registers.
-		-- Hence the ASSERT( null leftovers )
-	  arg_amodes <- getArgAmodes args
-	; let (arg_regs, leftovers) = assignPrimOpCallRegs arg_amodes
-	      jump_to_primop = jumpToLbl (mkRtsPrimOpLabel op)
-
-	; ASSERT(null leftovers) -- no stack-resident args
- 	  emitSimultaneously (assignToRegs arg_regs)
-
-	; EndOfBlockInfo args_sp _ <- getEndOfBlockInfo
-	; doFinalJump args_sp False{-not a LNE-} jump_to_primop }
-
--- -----------------------------------------------------------------------------
--- Return Addresses
-
--- We always push the return address just before performing a tail call
--- or return.  The reason we leave it until then is because the stack
--- slot that the return address is to go into might contain something
--- useful.
--- 
--- If the end of block info is 'CaseAlts', then we're in the scrutinee of a
--- case expression and the return address is still to be pushed.
--- 
--- There are cases where it doesn't look necessary to push the return
--- address: for example, just before doing a return to a known
--- continuation.  However, the continuation will expect to find the
--- return address on the stack in case it needs to do a heap check.
-
-pushReturnAddress :: EndOfBlockInfo -> Code
-
-pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts lbl _ _ False))
-  = do	{ sp_rel <- getSpRelOffset args_sp
-	; stmtC (CmmStore sp_rel (mkLblExpr lbl)) }
-
--- For a polymorphic case, we have two return addresses to push: the case
--- return, and stg_seq_frame_info which turns a possible vectored return
--- into a direct one.
-pushReturnAddress (EndOfBlockInfo args_sp sequel@(CaseAlts lbl _ _ True))
-  = do	{ sp_rel <- getSpRelOffset (args_sp-1)
-	; stmtC (CmmStore sp_rel (mkLblExpr lbl))
-	; sp_rel <- getSpRelOffset args_sp
-	; stmtC (CmmStore sp_rel (CmmLit (CmmLabel mkSeqInfoLabel))) }
-
-pushReturnAddress _ = nopC
-
--- -----------------------------------------------------------------------------
--- Misc.
-
-jumpToLbl :: CLabel -> Code
--- Passes no argument to the destination procedure
-jumpToLbl lbl = stmtC (CmmJump (CmmLit (CmmLabel lbl)) [{- No args -}])
-
-assignToRegs :: [(CmmExpr, GlobalReg)] -> CmmStmts
-assignToRegs reg_args 
-  = mkStmts [ CmmAssign (CmmGlobal reg_id) expr
-	    | (expr, reg_id) <- reg_args ] 
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[CgStackery-adjust]{Adjusting the stack pointers}
-%*									*
-%************************************************************************
-
-This function adjusts the stack and heap pointers just before a tail
-call or return.  The stack pointer is adjusted to its final position
-(i.e. to point to the last argument for a tail call, or the activation
-record for a return).  The heap pointer may be moved backwards, in
-cases where we overallocated at the beginning of the basic block (see
-CgCase.lhs for discussion).
-
-These functions {\em do not} deal with high-water-mark adjustment.
-That's done by functions which allocate stack space.
-
-\begin{code}
-adjustSpAndHp :: VirtualSpOffset 	-- New offset for Arg stack ptr
-	      -> Code
-adjustSpAndHp newRealSp 
-  = do	{ -- Adjust stack, if necessary.
-	  -- NB: the conditional on the monad-carried realSp
-	  --     is out of line (via codeOnly), to avoid a black hole
-	; new_sp <- getSpRelOffset newRealSp
-	; checkedAbsC (CmmAssign spReg new_sp)	-- Will generate no code in the case
-	; setRealSp newRealSp			-- where realSp==newRealSp
-
-	  -- Adjust heap.  The virtual heap pointer may be less than the real Hp
-	  -- because the latter was advanced to deal with the worst-case branch
-	  -- of the code, and we may be in a better-case branch.  In that case,
- 	  -- move the real Hp *back* and retract some ticky allocation count.
-	; hp_usg <- getHpUsage
-	; let rHp = realHp hp_usg
-	      vHp = virtHp hp_usg
-	; new_hp <- getHpRelOffset vHp
-	; checkedAbsC (CmmAssign hpReg new_hp)	-- Generates nothing when vHp==rHp
-	; tickyAllocHeap (vHp - rHp)		-- ...ditto
-	; setRealHp vHp
-	}
-\end{code}
diff --git a/ghc/compiler/codeGen/CgTicky.hs b/ghc/compiler/codeGen/CgTicky.hs
deleted file mode 100644
index 3e72981c50..0000000000
--- a/ghc/compiler/codeGen/CgTicky.hs
+++ /dev/null
@@ -1,370 +0,0 @@
------------------------------------------------------------------------------
---
--- Code generation for ticky-ticky profiling
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
-module CgTicky (
-	emitTickyCounter,
-
-	tickyDynAlloc,
-	tickyAllocHeap,
-	tickyAllocPrim,
-	tickyAllocThunk,
-	tickyAllocPAP,
-
-	tickyPushUpdateFrame,
-	tickyUpdateFrameOmitted,
-
-	tickyEnterDynCon,
-	tickyEnterStaticCon,
-	tickyEnterViaNode,
-
-	tickyEnterFun, 
-	tickyEnterThunk,
-
-	tickyUpdateBhCaf,
-	tickyBlackHole,
-	tickyUnboxedTupleReturn, tickyVectoredReturn,
-	tickyReturnOldCon, tickyReturnNewCon,
-
-	tickyKnownCallTooFewArgs, tickyKnownCallExact, tickyKnownCallExtraArgs,
-	tickyUnknownCall, tickySlowCallPat,
-
-	staticTickyHdr,
-  ) where
-
-#include "HsVersions.h"
-#include "../includes/DerivedConstants.h"
-	-- For REP_xxx constants, which are MachReps
-
-import ClosureInfo	( ClosureInfo, closureSize, slopSize, closureSMRep,
-			  closureUpdReqd, closureName, isStaticClosure )
-import CgUtils
-import CgMonad
-import SMRep		( ClosureType(..), smRepClosureType, CgRep )
-
-import Cmm
-import MachOp
-import CmmUtils		( zeroCLit, mkIntCLit, mkLblExpr, cmmIndexExpr )
-import CLabel		( CLabel, mkRtsDataLabel, mkRednCountsLabel )
-
-import Name		( isInternalName )
-import Id		( Id, idType )
-import StaticFlags	( opt_DoTickyProfiling )
-import BasicTypes	( Arity )
-import FastString	( FastString, mkFastString, LitString )	
-import Constants	-- Lots of field offsets
-import Outputable
-
--- Turgid imports for showTypeCategory
-import PrelNames
-import TcType		( Type, isDictTy, tcSplitTyConApp_maybe,
-			  tcSplitFunTy_maybe )
-import TyCon		( isPrimTyCon, isTupleTyCon, isEnumerationTyCon,
-			  maybeTyConSingleCon )
-import Maybe
-
------------------------------------------------------------------------------
---
---		Ticky-ticky profiling
---
------------------------------------------------------------------------------
-
-staticTickyHdr :: [CmmLit]
--- The ticky header words in a static closure
--- Was SET_STATIC_TICKY_HDR
-staticTickyHdr 
-  | not opt_DoTickyProfiling = []
-  | otherwise		     = [zeroCLit]
-
-emitTickyCounter :: ClosureInfo -> [Id] -> Int -> Code
-emitTickyCounter cl_info args on_stk
-  = ifTicky $
-    do	{ mod_name <- moduleName
-	; fun_descr_lit <- mkStringCLit (fun_descr mod_name)
-	; arg_descr_lit <- mkStringCLit arg_descr
-	; emitDataLits ticky_ctr_label 	-- Must match layout of StgEntCounter
-	    [ CmmInt 0 I16,
-	      CmmInt (fromIntegral (length args)) I16, 	-- Arity
-	      CmmInt (fromIntegral on_stk) I16,		-- Words passed on stack
-	      CmmInt 0 I16,				-- 2-byte gap
-	      fun_descr_lit,
-	      arg_descr_lit,
-	      zeroCLit, 		-- Entry count
-	      zeroCLit, 		-- Allocs
-	      zeroCLit 			-- Link
-	    ] }
-  where
-    name = closureName cl_info
-    ticky_ctr_label = mkRednCountsLabel name
-    arg_descr = map (showTypeCategory . idType) args
-    fun_descr mod_name = ppr_for_ticky_name mod_name name
-
--- When printing the name of a thing in a ticky file, we want to
--- give the module name even for *local* things.   We print
--- just "x (M)" rather that "M.x" to distinguish them from the global kind.
-ppr_for_ticky_name mod_name name
-  | isInternalName name = showSDocDebug (ppr name <+> (parens (ppr mod_name)))
-  | otherwise	        = showSDocDebug (ppr name)
-
--- -----------------------------------------------------------------------------
--- Ticky stack frames
-
-tickyPushUpdateFrame    = ifTicky $ bumpTickyCounter SLIT("UPDF_PUSHED_ctr")
-tickyUpdateFrameOmitted = ifTicky $ bumpTickyCounter SLIT("UPDF_OMITTED_ctr")
-
--- -----------------------------------------------------------------------------
--- Ticky entries
-
-tickyEnterDynCon      = ifTicky $ bumpTickyCounter SLIT("ENT_DYN_CON_ctr")
-tickyEnterDynThunk    = ifTicky $ bumpTickyCounter SLIT("ENT_DYN_THK_ctr")
-tickyEnterStaticCon   = ifTicky $ bumpTickyCounter SLIT("ENT_STATIC_CON_ctr")
-tickyEnterStaticThunk = ifTicky $ bumpTickyCounter SLIT("ENT_STATIC_THK_ctr")
-tickyEnterViaNode     = ifTicky $ bumpTickyCounter SLIT("ENT_VIA_NODE_ctr")
-
-tickyEnterThunk :: ClosureInfo -> Code
-tickyEnterThunk cl_info
-  | isStaticClosure cl_info = tickyEnterStaticThunk
-  | otherwise		    = tickyEnterDynThunk
-
-tickyBlackHole :: Bool{-updatable-} -> Code
-tickyBlackHole updatable
-  = ifTicky (bumpTickyCounter ctr)
-  where
-    ctr | updatable = SLIT("UPD_BH_SINGLE_ENTRY_ctr")
-	| otherwise = SLIT("UPD_BH_UPDATABLE_ctr")
-
-tickyUpdateBhCaf cl_info
-  = ifTicky (bumpTickyCounter ctr)
-  where
-    ctr | closureUpdReqd cl_info = SLIT("UPD_CAF_BH_SINGLE_ENTRY_ctr")
-	| otherwise	         = SLIT("UPD_CAF_BH_UPDATABLE_ctr")
-
-tickyEnterFun :: ClosureInfo -> Code
-tickyEnterFun cl_info
-  = ifTicky $ 
-    do 	{ bumpTickyCounter ctr
-	; fun_ctr_lbl <- getTickyCtrLabel
-	; registerTickyCtr fun_ctr_lbl
-	; bumpTickyCounter' fun_ctr_lbl }
-  where
-    ctr | isStaticClosure cl_info = SLIT("TICK_ENT_STATIC_FUN_DIRECT")
-	| otherwise		  = SLIT("TICK_ENT_DYN_FUN_DIRECT")
-
-registerTickyCtr :: CLabel -> Code
--- Register a ticky counter
---   if ( ! f_ct.registeredp ) {
---	    f_ct.link = ticky_entry_ctrs; 	/* hook this one onto the front of the list */
---	    ticky_entry_ctrs = & (f_ct);	/* mark it as "registered" */
---	    f_ct.registeredp = 1 }
-registerTickyCtr ctr_lbl
-  = emitIf test (stmtsC register_stmts)
-  where
-    test = CmmMachOp (MO_Not I16) 
-	    [CmmLoad (CmmLit (cmmLabelOffB ctr_lbl 
-				oFFSET_StgEntCounter_registeredp)) I16]
-    register_stmts
-      =	[ CmmStore (CmmLit (cmmLabelOffB ctr_lbl oFFSET_StgEntCounter_link))
-		   (CmmLoad ticky_entry_ctrs wordRep)
-	, CmmStore ticky_entry_ctrs (mkLblExpr ctr_lbl)
-	, CmmStore (CmmLit (cmmLabelOffB ctr_lbl 
-				oFFSET_StgEntCounter_registeredp))
-		   (CmmLit (mkIntCLit 1)) ]
-    ticky_entry_ctrs = mkLblExpr (mkRtsDataLabel SLIT("ticky_entry_ctrs"))
-
-tickyReturnOldCon, tickyReturnNewCon :: Arity -> Code
-tickyReturnOldCon arity 
-  = ifTicky $ do { bumpTickyCounter SLIT("RET_OLD_ctr")
-	         ; bumpHistogram SLIT("RET_OLD_hst") arity }
-tickyReturnNewCon arity 
-  | not opt_DoTickyProfiling = nopC
-  | otherwise
-  = ifTicky $ do { bumpTickyCounter SLIT("RET_NEW_ctr")
-	         ; bumpHistogram SLIT("RET_NEW_hst") arity }
-
-tickyUnboxedTupleReturn :: Int -> Code
-tickyUnboxedTupleReturn arity
-  = ifTicky $ do { bumpTickyCounter SLIT("RET_UNBOXED_TUP_ctr")
- 	         ; bumpHistogram SLIT("RET_UNBOXED_TUP_hst") arity }
-
-tickyVectoredReturn :: Int -> Code
-tickyVectoredReturn family_size 
-  = ifTicky $ do { bumpTickyCounter SLIT("VEC_RETURN_ctr")
-		 ; bumpHistogram SLIT("RET_VEC_RETURN_hst") family_size }
-
--- -----------------------------------------------------------------------------
--- Ticky calls
-
--- Ticks at a *call site*:
-tickyKnownCallTooFewArgs = ifTicky $ bumpTickyCounter SLIT("KNOWN_CALL_TOO_FEW_ARGS_ctr")
-tickyKnownCallExact = ifTicky $ bumpTickyCounter SLIT("KNOWN_CALL_ctr")
-tickyKnownCallExtraArgs = ifTicky $ bumpTickyCounter SLIT("KNOWN_CALL_EXTRA_ctr")
-tickyUnknownCall = ifTicky $ bumpTickyCounter SLIT("UNKNOWN_CALL_ctr")
-
--- Tick for the call pattern at slow call site (i.e. in addition to
--- tickyUnknownCall, tickyKnownCallExtraArgs, etc.)
-tickySlowCallPat :: [CgRep] -> Code
-tickySlowCallPat args = return ()
-{- LATER: (introduces recursive module dependency now).
-  case callPattern args of
-    (str, True)  -> bumpTickyCounter' (mkRtsSlowTickyCtrLabel pat)
-    (str, False) -> bumpTickyCounter  SLIT("TICK_SLOW_CALL_OTHER")
-
-callPattern :: [CgRep] -> (String,Bool)
-callPattern reps 
-  | match == length reps = (chars, True)
-  | otherwise            = (chars, False)
-  where (_,match) = findMatch reps
-	chars     = map argChar reps
-
-argChar VoidArg   = 'v'
-argChar PtrArg    = 'p'
-argChar NonPtrArg = 'n'
-argChar LongArg   = 'l'
-argChar FloatArg  = 'f'
-argChar DoubleArg = 'd'
--}
-
--- -----------------------------------------------------------------------------
--- Ticky allocation
-
-tickyDynAlloc :: ClosureInfo -> Code
--- Called when doing a dynamic heap allocation
-tickyDynAlloc cl_info
-  = ifTicky $
-    case smRepClosureType (closureSMRep cl_info) of
-	Constr        -> tick_alloc_con
-	ConstrNoCaf   -> tick_alloc_con
-	Fun	      -> tick_alloc_fun
-	Thunk 	      -> tick_alloc_thk
-	ThunkSelector -> tick_alloc_thk
-  where
-	-- will be needed when we fill in stubs
-    cl_size   =	closureSize cl_info
-    slop_size = slopSize cl_info
-
-    tick_alloc_thk 
-	| closureUpdReqd cl_info = tick_alloc_up_thk
-	| otherwise	         = tick_alloc_se_thk
-
-    tick_alloc_con = panic "ToDo: tick_alloc"
-    tick_alloc_fun = panic "ToDo: tick_alloc"
-    tick_alloc_up_thk = panic "ToDo: tick_alloc"
-    tick_alloc_se_thk = panic "ToDo: tick_alloc"
-
-tickyAllocPrim :: CmmExpr -> CmmExpr -> CmmExpr -> Code
-tickyAllocPrim hdr goods slop = ifTicky $ panic "ToDo: tickyAllocPrim"
-
-tickyAllocThunk :: CmmExpr -> CmmExpr -> Code
-tickyAllocThunk goods slop = ifTicky $ panic "ToDo: tickyAllocThunk"
-
-tickyAllocPAP :: CmmExpr -> CmmExpr -> Code
-tickyAllocPAP goods slop = ifTicky $ panic "ToDo: tickyAllocPAP"
-
-tickyAllocHeap :: VirtualHpOffset -> Code
--- Called when doing a heap check [TICK_ALLOC_HEAP]
-tickyAllocHeap hp
-  = ifTicky $
-    do	{ ticky_ctr <- getTickyCtrLabel
-	; stmtsC $
-	  if hp == 0 then [] 	-- Inside the stmtC to avoid control
-	  else [		-- dependency on the argument
-		-- Bump the allcoation count in the StgEntCounter
-	    addToMem REP_StgEntCounter_allocs 
-			(CmmLit (cmmLabelOffB ticky_ctr 
-				oFFSET_StgEntCounter_allocs)) hp,
-		-- Bump ALLOC_HEAP_ctr
-	    addToMemLbl cLongRep (mkRtsDataLabel SLIT("ALLOC_HEAP_ctr")) 1,
-		-- Bump ALLOC_HEAP_tot
-	    addToMemLbl cLongRep (mkRtsDataLabel SLIT("ALLOC_HEAP_tot")) hp] }
-
--- -----------------------------------------------------------------------------
--- Ticky utils
-
-ifTicky :: Code -> Code
-ifTicky code
-  | opt_DoTickyProfiling = code
-  | otherwise		 = nopC
-
-addToMemLbl :: MachRep -> CLabel -> Int -> CmmStmt
-addToMemLbl rep lbl n = addToMem rep (CmmLit (CmmLabel lbl)) n
-
--- All the ticky-ticky counters are declared "unsigned long" in C
-bumpTickyCounter :: LitString -> Code
-bumpTickyCounter lbl = bumpTickyCounter' (mkRtsDataLabel lbl)
-
-bumpTickyCounter' :: CLabel -> Code
-bumpTickyCounter' lbl = stmtC (addToMemLbl cLongRep lbl 1)
-
-addToMemLong = addToMem cLongRep
-
-bumpHistogram :: LitString -> Int -> Code
-bumpHistogram lbl n 
-  = bumpHistogramE lbl (CmmLit (CmmInt (fromIntegral n) cLongRep))
-
-bumpHistogramE :: LitString -> CmmExpr -> Code
-bumpHistogramE lbl n 
-  = do  t <- newTemp cLongRep
-	stmtC (CmmAssign t n)
-	emitIf (CmmMachOp (MO_U_Le cLongRep) [CmmReg t, eight]) $
-		stmtC (CmmAssign t eight)
-	stmtC (addToMemLong (cmmIndexExpr cLongRep 
-				(CmmLit (CmmLabel (mkRtsDataLabel lbl)))
-				(CmmReg t))
-			    1)
-  where 
-   eight = CmmLit (CmmInt 8 cLongRep)
-
-------------------------------------------------------------------
--- Showing the "type category" for ticky-ticky profiling
-
-showTypeCategory :: Type -> Char
-  {-	{C,I,F,D}   char, int, float, double
-	T	    tuple
-	S	    other single-constructor type
-	{c,i,f,d}   unboxed ditto
-	t	    *unpacked* tuple
-	s	    *unpacked" single-cons...
-
-	v	    void#
-	a	    primitive array
-
-	E	    enumeration type
-	+	    dictionary, unless it's a ...
-	L	    List
-	>	    function
-	M	    other (multi-constructor) data-con type
-	.	    other type
-	-	    reserved for others to mark as "uninteresting"
-    -}
-showTypeCategory ty
-  = if isDictTy ty
-    then '+'
-    else
-      case tcSplitTyConApp_maybe ty of
-	Nothing -> if isJust (tcSplitFunTy_maybe ty)
-		   then '>'
-		   else '.'
-
-	Just (tycon, _) ->
-          let utc = getUnique tycon in
-	  if	  utc == charDataConKey    then 'C'
-	  else if utc == intDataConKey     then 'I'
-	  else if utc == floatDataConKey   then 'F'
-	  else if utc == doubleDataConKey  then 'D'
-	  else if utc == smallIntegerDataConKey ||
-		  utc == largeIntegerDataConKey   then 'J'
-	  else if utc == charPrimTyConKey  then 'c'
-	  else if (utc == intPrimTyConKey || utc == wordPrimTyConKey
-		|| utc == addrPrimTyConKey)		   then 'i'
-	  else if utc  == floatPrimTyConKey		   then 'f'
-	  else if utc  == doublePrimTyConKey		   then 'd'
-	  else if isPrimTyCon tycon {- array, we hope -}   then 'A'	-- Bogus
-	  else if isEnumerationTyCon tycon		   then 'E'
-	  else if isTupleTyCon tycon			   then 'T'
-	  else if isJust (maybeTyConSingleCon tycon)       then 'S'
-	  else if utc == listTyConKey			   then 'L'
-	  else 'M' -- oh, well...
diff --git a/ghc/compiler/codeGen/CgUsages.hi-boot-5 b/ghc/compiler/codeGen/CgUsages.hi-boot-5
deleted file mode 100644
index abb98cec1a..0000000000
--- a/ghc/compiler/codeGen/CgUsages.hi-boot-5
+++ /dev/null
@@ -1,3 +0,0 @@
-__interface CgUsages 1 0 where
-__export CgUsages getSpRelOffset;
-1 getSpRelOffset :: AbsCSyn.VirtualSpOffset -> CgMonad.FCode AbsCSyn.RegRelative ;
diff --git a/ghc/compiler/codeGen/CgUsages.hi-boot-6 b/ghc/compiler/codeGen/CgUsages.hi-boot-6
deleted file mode 100644
index 9640603cfb..0000000000
--- a/ghc/compiler/codeGen/CgUsages.hi-boot-6
+++ /dev/null
@@ -1,3 +0,0 @@
-module CgUsages where
-
-getSpRelOffset :: AbsCSyn.VirtualSpOffset -> CgMonad.FCode AbsCSyn.RegRelative
diff --git a/ghc/compiler/codeGen/CgUtils.hs b/ghc/compiler/codeGen/CgUtils.hs
deleted file mode 100644
index 2f69927db0..0000000000
--- a/ghc/compiler/codeGen/CgUtils.hs
+++ /dev/null
@@ -1,688 +0,0 @@
------------------------------------------------------------------------------
---
--- Code generator utilities; mostly monadic
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
-module CgUtils (
-	addIdReps,
-	cgLit,
-	emitDataLits, emitRODataLits, emitIf, emitIfThenElse,
-	emitRtsCall, emitRtsCallWithVols, emitRtsCallWithResult,
-	assignTemp, newTemp,
-	emitSimultaneously,
-	emitSwitch, emitLitSwitch,
-	tagToClosure,
-
-	cmmAndWord, cmmOrWord, cmmNegate, cmmEqWord, cmmNeWord,
-	cmmOffsetExprW, cmmOffsetExprB,
-	cmmRegOffW, cmmRegOffB,
-	cmmLabelOffW, cmmLabelOffB,
-	cmmOffsetW, cmmOffsetB,
-	cmmOffsetLitW, cmmOffsetLitB,
-	cmmLoadIndexW,
-
-	addToMem, addToMemE,
-	mkWordCLit,
-	mkStringCLit,
-	packHalfWordsCLit,
-	blankWord
-  ) where
-
-#include "HsVersions.h"
-
-import CgMonad
-import TyCon		( TyCon, tyConName )
-import Id		( Id )
-import Constants	( wORD_SIZE )
-import SMRep		( CgRep, StgWord, hALF_WORD_SIZE_IN_BITS, ByteOff,
-			  WordOff, idCgRep )
-import PprCmm		( {- instances -} )
-import Cmm
-import CLabel
-import CmmUtils
-import MachOp		( MachRep(..), wordRep, MachOp(..),  MachHint(..),
-			  mo_wordOr, mo_wordAnd, mo_wordNe, mo_wordEq,
-			  mo_wordULt, mo_wordUGt, mo_wordUGe, machRepByteWidth )
-import ForeignCall	( CCallConv(..) )
-import Literal		( Literal(..) )
-import CLabel		( CLabel, mkStringLitLabel )
-import Digraph		( SCC(..), stronglyConnComp )
-import ListSetOps	( assocDefault )
-import Util		( filterOut, sortLe )
-import DynFlags		( DynFlags(..), HscTarget(..) )
-import Packages		( HomeModules )
-import FastString	( LitString, FastString, bytesFS )
-import Outputable
-
-import Char		( ord )
-import DATA_BITS
-import DATA_WORD	( Word8 )
-import Maybe		( isNothing )
-
--------------------------------------------------------------------------
---
---	Random small functions
---
--------------------------------------------------------------------------
-
-addIdReps :: [Id] -> [(CgRep, Id)]
-addIdReps ids = [(idCgRep id, id) | id <- ids]
-
--------------------------------------------------------------------------
---
---	Literals
---
--------------------------------------------------------------------------
-
-cgLit :: Literal -> FCode CmmLit
-cgLit (MachStr s) = mkByteStringCLit (bytesFS s)
- -- not unpackFS; we want the UTF-8 byte stream.
-cgLit other_lit   = return (mkSimpleLit other_lit)
-
-mkSimpleLit :: Literal -> CmmLit
-mkSimpleLit (MachChar	c)    = CmmInt (fromIntegral (ord c)) wordRep
-mkSimpleLit MachNullAddr      = zeroCLit
-mkSimpleLit (MachInt i)       = CmmInt i wordRep
-mkSimpleLit (MachInt64 i)     = CmmInt i I64
-mkSimpleLit (MachWord i)      = CmmInt i wordRep
-mkSimpleLit (MachWord64 i)    = CmmInt i I64
-mkSimpleLit (MachFloat r)     = CmmFloat r F32
-mkSimpleLit (MachDouble r)    = CmmFloat r F64
-mkSimpleLit (MachLabel fs ms) = CmmLabel (mkForeignLabel fs ms is_dyn)
-			      where
-				is_dyn = False	-- ToDo: fix me
-	
-mkLtOp :: Literal -> MachOp
--- On signed literals we must do a signed comparison
-mkLtOp (MachInt _)    = MO_S_Lt wordRep
-mkLtOp (MachFloat _)  = MO_S_Lt F32
-mkLtOp (MachDouble _) = MO_S_Lt F64
-mkLtOp lit	      = MO_U_Lt (cmmLitRep (mkSimpleLit lit))
-
-
----------------------------------------------------
---
---	Cmm data type functions
---
----------------------------------------------------
-
------------------------
--- The "B" variants take byte offsets
-cmmRegOffB :: CmmReg -> ByteOff -> CmmExpr
-cmmRegOffB = cmmRegOff
-
-cmmOffsetB :: CmmExpr -> ByteOff -> CmmExpr
-cmmOffsetB = cmmOffset
-
-cmmOffsetExprB :: CmmExpr -> CmmExpr -> CmmExpr
-cmmOffsetExprB = cmmOffsetExpr
-
-cmmLabelOffB :: CLabel -> ByteOff -> CmmLit
-cmmLabelOffB = cmmLabelOff
-
-cmmOffsetLitB :: CmmLit -> ByteOff -> CmmLit
-cmmOffsetLitB = cmmOffsetLit
-
------------------------
--- The "W" variants take word offsets
-cmmOffsetExprW :: CmmExpr -> CmmExpr -> CmmExpr
--- The second arg is a *word* offset; need to change it to bytes
-cmmOffsetExprW e (CmmLit (CmmInt n _)) = cmmOffsetW e (fromInteger n)
-cmmOffsetExprW e wd_off = cmmIndexExpr wordRep e wd_off
-
-cmmOffsetW :: CmmExpr -> WordOff -> CmmExpr
-cmmOffsetW e n = cmmOffsetB e (wORD_SIZE * n)
-
-cmmRegOffW :: CmmReg -> WordOff -> CmmExpr
-cmmRegOffW reg wd_off = cmmRegOffB reg (wd_off * wORD_SIZE)
-
-cmmOffsetLitW :: CmmLit -> WordOff -> CmmLit
-cmmOffsetLitW lit wd_off = cmmOffsetLitB lit (wORD_SIZE * wd_off)
-
-cmmLabelOffW :: CLabel -> WordOff -> CmmLit
-cmmLabelOffW lbl wd_off = cmmLabelOffB lbl (wORD_SIZE * wd_off)
-
-cmmLoadIndexW :: CmmExpr -> Int -> CmmExpr
-cmmLoadIndexW base off
-  = CmmLoad (cmmOffsetW base off) wordRep
-
------------------------
-cmmNeWord, cmmEqWord, cmmOrWord, cmmAndWord :: CmmExpr -> CmmExpr -> CmmExpr
-cmmOrWord  e1 e2 = CmmMachOp mo_wordOr  [e1, e2]
-cmmAndWord e1 e2 = CmmMachOp mo_wordAnd [e1, e2]
-cmmNeWord  e1 e2 = CmmMachOp mo_wordNe  [e1, e2]
-cmmEqWord  e1 e2 = CmmMachOp mo_wordEq  [e1, e2]
-cmmULtWord e1 e2 = CmmMachOp mo_wordULt [e1, e2]
-cmmUGeWord e1 e2 = CmmMachOp mo_wordUGe [e1, e2]
-cmmUGtWord e1 e2 = CmmMachOp mo_wordUGt [e1, e2]
-
-cmmNegate :: CmmExpr -> CmmExpr
-cmmNegate (CmmLit (CmmInt n rep)) = CmmLit (CmmInt (-n) rep)
-cmmNegate e			  = CmmMachOp (MO_S_Neg (cmmExprRep e)) [e]
-
-blankWord :: CmmStatic
-blankWord = CmmUninitialised wORD_SIZE
-
------------------------
---	Making literals
-
-mkWordCLit :: StgWord -> CmmLit
-mkWordCLit wd = CmmInt (fromIntegral wd) wordRep
-
-packHalfWordsCLit :: (Integral a, Integral b) => a -> b -> CmmLit
--- Make a single word literal in which the lower_half_word is
--- at the lower address, and the upper_half_word is at the 
--- higher address
--- ToDo: consider using half-word lits instead
--- 	 but be careful: that's vulnerable when reversed
-packHalfWordsCLit lower_half_word upper_half_word
-#ifdef WORDS_BIGENDIAN
-   = mkWordCLit ((fromIntegral lower_half_word `shiftL` hALF_WORD_SIZE_IN_BITS)
-		 .|. fromIntegral upper_half_word)
-#else 
-   = mkWordCLit ((fromIntegral lower_half_word) 
-		 .|. (fromIntegral upper_half_word `shiftL` hALF_WORD_SIZE_IN_BITS))
-#endif
-
---------------------------------------------------------------------------
---
--- Incrementing a memory location
---
---------------------------------------------------------------------------
-
-addToMem :: MachRep 	-- rep of the counter
-	 -> CmmExpr	-- Address
-	 -> Int		-- What to add (a word)
-	 -> CmmStmt
-addToMem rep ptr n = addToMemE rep ptr (CmmLit (CmmInt (toInteger n) rep))
-
-addToMemE :: MachRep 	-- rep of the counter
-	  -> CmmExpr	-- Address
-	  -> CmmExpr	-- What to add (a word-typed expression)
-	  -> CmmStmt
-addToMemE rep ptr n
-  = CmmStore ptr (CmmMachOp (MO_Add rep) [CmmLoad ptr rep, n])
-
--------------------------------------------------------------------------
---
---	Converting a closure tag to a closure for enumeration types
---      (this is the implementation of tagToEnum#).
---
--------------------------------------------------------------------------
-
-tagToClosure :: HomeModules -> TyCon -> CmmExpr -> CmmExpr
-tagToClosure hmods tycon tag
-  = CmmLoad (cmmOffsetExprW closure_tbl tag) wordRep
-  where closure_tbl = CmmLit (CmmLabel lbl)
-	lbl = mkClosureTableLabel hmods (tyConName tycon)
-
--------------------------------------------------------------------------
---
---	Conditionals and rts calls
---
--------------------------------------------------------------------------
-
-emitIf :: CmmExpr 	-- Boolean
-       -> Code		-- Then part
-       -> Code		
--- Emit (if e then x)
--- ToDo: reverse the condition to avoid the extra branch instruction if possible
--- (some conditionals aren't reversible. eg. floating point comparisons cannot
--- be inverted because there exist some values for which both comparisons
--- return False, such as NaN.)
-emitIf cond then_part
-  = do { then_id <- newLabelC
-       ; join_id <- newLabelC
-       ; stmtC (CmmCondBranch cond then_id)
-       ; stmtC (CmmBranch join_id)
-       ; labelC then_id
-       ; then_part
-       ; labelC join_id
-       }
-
-emitIfThenElse :: CmmExpr 	-- Boolean
-       		-> Code		-- Then part
-       		-> Code		-- Else part
-       		-> Code		
--- Emit (if e then x else y)
-emitIfThenElse cond then_part else_part
-  = do { then_id <- newLabelC
-       ; else_id <- newLabelC
-       ; join_id <- newLabelC
-       ; stmtC (CmmCondBranch cond then_id)
-       ; else_part
-       ; stmtC (CmmBranch join_id)
-       ; labelC then_id
-       ; then_part
-       ; labelC join_id
-       }
-
-emitRtsCall :: LitString -> [(CmmExpr,MachHint)] -> Code
-emitRtsCall fun args = emitRtsCall' [] fun args Nothing
-   -- The 'Nothing' says "save all global registers"
-
-emitRtsCallWithVols :: LitString -> [(CmmExpr,MachHint)] -> [GlobalReg] -> Code
-emitRtsCallWithVols fun args vols
-   = emitRtsCall' [] fun args (Just vols)
-
-emitRtsCallWithResult :: CmmReg -> MachHint -> LitString
-	-> [(CmmExpr,MachHint)] -> Code
-emitRtsCallWithResult res hint fun args
-   = emitRtsCall' [(res,hint)] fun args Nothing
-
--- Make a call to an RTS C procedure
-emitRtsCall'
-   :: [(CmmReg,MachHint)]
-   -> LitString
-   -> [(CmmExpr,MachHint)]
-   -> Maybe [GlobalReg]
-   -> Code
-emitRtsCall' res fun args vols = stmtC (CmmCall target res args vols)
-  where
-    target   = CmmForeignCall fun_expr CCallConv
-    fun_expr = mkLblExpr (mkRtsCodeLabel fun)
-
-
--------------------------------------------------------------------------
---
---	Strings gnerate a top-level data block
---
--------------------------------------------------------------------------
-
-emitDataLits :: CLabel -> [CmmLit] -> Code
--- Emit a data-segment data block
-emitDataLits lbl lits
-  = emitData Data (CmmDataLabel lbl : map CmmStaticLit lits)
-
-emitRODataLits :: CLabel -> [CmmLit] -> Code
--- Emit a read-only data block
-emitRODataLits lbl lits
-  = emitData section (CmmDataLabel lbl : map CmmStaticLit lits)
-  where section | any needsRelocation lits = RelocatableReadOnlyData
-                | otherwise                = ReadOnlyData
-        needsRelocation (CmmLabel _)      = True
-        needsRelocation (CmmLabelOff _ _) = True
-        needsRelocation _                 = False
-
-mkStringCLit :: String -> FCode CmmLit
--- Make a global definition for the string,
--- and return its label
-mkStringCLit str = mkByteStringCLit (map (fromIntegral.ord) str)
-
-mkByteStringCLit :: [Word8] -> FCode CmmLit
-mkByteStringCLit bytes
-  = do 	{ uniq <- newUnique
-	; let lbl = mkStringLitLabel uniq
-	; emitData ReadOnlyData [CmmDataLabel lbl, CmmString bytes]
-	; return (CmmLabel lbl) }
-
--------------------------------------------------------------------------
---
---	Assigning expressions to temporaries
---
--------------------------------------------------------------------------
-
-assignTemp :: CmmExpr -> FCode CmmExpr
--- For a non-trivial expression, e, create a local
--- variable and assign the expression to it
-assignTemp e 
-  | isTrivialCmmExpr e = return e
-  | otherwise 	       = do { reg <- newTemp (cmmExprRep e)
-			    ; stmtC (CmmAssign reg e)
-			    ; return (CmmReg reg) }
-
-
-newTemp :: MachRep -> FCode CmmReg
-newTemp rep = do { uniq <- newUnique; return (CmmLocal (LocalReg uniq rep)) }
-
-
--------------------------------------------------------------------------
---
---	Building case analysis
---
--------------------------------------------------------------------------
-
-emitSwitch
-	:: CmmExpr  		  -- Tag to switch on
-	-> [(ConTagZ, CgStmts)]	  -- Tagged branches
-	-> Maybe CgStmts	  -- Default branch (if any)
-	-> ConTagZ -> ConTagZ	  -- Min and Max possible values; behaviour
-				  -- 	outside this range is undefined
-	-> Code
-
--- ONLY A DEFAULT BRANCH: no case analysis to do
-emitSwitch tag_expr [] (Just stmts) _ _
-  = emitCgStmts stmts
-
--- Right, off we go
-emitSwitch tag_expr branches mb_deflt lo_tag hi_tag
-  = 	-- Just sort the branches before calling mk_sritch
-    do	{ mb_deflt_id <-
-		case mb_deflt of
-		  Nothing    -> return Nothing
-		  Just stmts -> do id <- forkCgStmts stmts; return (Just id)
-
-	; dflags <- getDynFlags
-	; let via_C | HscC <- hscTarget dflags = True
-		    | otherwise                = False
-
-	; stmts <- mk_switch tag_expr (sortLe le branches) 
-			mb_deflt_id lo_tag hi_tag via_C
-	; emitCgStmts stmts
-	}
-  where
-    (t1,_) `le` (t2,_) = t1 <= t2
-
-
-mk_switch :: CmmExpr -> [(ConTagZ, CgStmts)]
-	  -> Maybe BlockId -> ConTagZ -> ConTagZ -> Bool
-	  -> FCode CgStmts
-
--- SINGLETON TAG RANGE: no case analysis to do
-mk_switch tag_expr [(tag,stmts)] _ lo_tag hi_tag via_C
-  | lo_tag == hi_tag
-  = ASSERT( tag == lo_tag )
-    return stmts
-
--- SINGLETON BRANCH, NO DEFUALT: no case analysis to do
-mk_switch tag_expr [(tag,stmts)] Nothing lo_tag hi_tag via_C
-  = return stmts
-	-- The simplifier might have eliminated a case
-	-- 	 so we may have e.g. case xs of 
-	--				 [] -> e
-	-- In that situation we can be sure the (:) case 
-	-- can't happen, so no need to test
-
--- SINGLETON BRANCH: one equality check to do
-mk_switch tag_expr [(tag,stmts)] (Just deflt) lo_tag hi_tag via_C
-  = return (CmmCondBranch cond deflt `consCgStmt` stmts)
-  where
-    cond  =  cmmNeWord tag_expr (CmmLit (mkIntCLit tag))
-	-- We have lo_tag < hi_tag, but there's only one branch, 
-	-- so there must be a default
-
--- ToDo: we might want to check for the two branch case, where one of
--- the branches is the tag 0, because comparing '== 0' is likely to be
--- more efficient than other kinds of comparison.
-
--- DENSE TAG RANGE: use a switch statment.
---
--- We also use a switch uncoditionally when compiling via C, because
--- this will get emitted as a C switch statement and the C compiler
--- should do a good job of optimising it.  Also, older GCC versions
--- (2.95 in particular) have problems compiling the complicated
--- if-trees generated by this code, so compiling to a switch every
--- time works around that problem.
---
-mk_switch tag_expr branches mb_deflt lo_tag hi_tag via_C
-  | use_switch 	-- Use a switch
-  = do	{ branch_ids <- mapM forkCgStmts (map snd branches)
-	; let 
-		tagged_blk_ids = zip (map fst branches) (map Just branch_ids)
-
-		find_branch :: ConTagZ -> Maybe BlockId
-		find_branch i = assocDefault mb_deflt tagged_blk_ids i
-
-		-- NB. we have eliminated impossible branches at
-		-- either end of the range (see below), so the first
-		-- tag of a real branch is real_lo_tag (not lo_tag).
-		arms = [ find_branch i | i <- [real_lo_tag..real_hi_tag]]
-
-	        switch_stmt = CmmSwitch (cmmOffset tag_expr (- real_lo_tag)) arms
-
-	; ASSERT(not (all isNothing arms)) 
-	  return (oneCgStmt switch_stmt)
-	}
-
-  -- if we can knock off a bunch of default cases with one if, then do so
-  | Just deflt <- mb_deflt, (lowest_branch - lo_tag) >= n_branches
-  = do { (assign_tag, tag_expr') <- assignTemp' tag_expr
-       ; let cond = cmmULtWord tag_expr' (CmmLit (mkIntCLit lowest_branch))
-	     branch = CmmCondBranch cond deflt
-       ; stmts <- mk_switch tag_expr' branches mb_deflt 
-			lowest_branch hi_tag via_C
-       ; return (assign_tag `consCgStmt` (branch `consCgStmt` stmts))
-       }
-
-  | Just deflt <- mb_deflt, (hi_tag - highest_branch) >= n_branches
-  = do { (assign_tag, tag_expr') <- assignTemp' tag_expr
-       ; let cond = cmmUGtWord tag_expr' (CmmLit (mkIntCLit highest_branch))
-	     branch = CmmCondBranch cond deflt
-       ; stmts <- mk_switch tag_expr' branches mb_deflt 
-			lo_tag highest_branch via_C
-       ; return (assign_tag `consCgStmt` (branch `consCgStmt` stmts))
-       }
-
-  | otherwise	-- Use an if-tree
-  = do	{ (assign_tag, tag_expr') <- assignTemp' tag_expr
-		-- To avoid duplication
-	; lo_stmts <- mk_switch tag_expr' lo_branches mb_deflt 
-				lo_tag (mid_tag-1) via_C
-	; hi_stmts <- mk_switch tag_expr' hi_branches mb_deflt 
-				mid_tag hi_tag via_C
-	; hi_id <- forkCgStmts hi_stmts
-	; let cond = cmmUGeWord tag_expr' (CmmLit (mkIntCLit mid_tag))
-	      branch_stmt = CmmCondBranch cond hi_id
-	; return (assign_tag `consCgStmt` (branch_stmt `consCgStmt` lo_stmts)) 
-	}
-	-- we test (e >= mid_tag) rather than (e < mid_tag), because
-	-- the former works better when e is a comparison, and there
-	-- are two tags 0 & 1 (mid_tag == 1).  In this case, the code
-	-- generator can reduce the condition to e itself without
-	-- having to reverse the sense of the comparison: comparisons
-	-- can't always be easily reversed (eg. floating
-	-- pt. comparisons).
-  where
-    use_switch 	 = {- pprTrace "mk_switch" (
-			ppr tag_expr <+> text "n_tags:" <+> int n_tags <+>
-			text "n_branches:" <+> int n_branches <+>
-			text "lo_tag: " <+> int lo_tag <+>
-			text "hi_tag: " <+> int hi_tag <+>
-			text "real_lo_tag: " <+> int real_lo_tag <+>
-			text "real_hi_tag: " <+> int real_hi_tag) $ -}
-		   ASSERT( n_branches > 1 && n_tags > 1 ) 
-		   n_tags > 2 && (small || dense || via_C)
-		 -- a 2-branch switch always turns into an if.
-    small      	 = n_tags <= 4
-    dense      	 = n_branches > (n_tags `div` 2)
-    exhaustive   = n_tags == n_branches
-    n_branches   = length branches
-    
-    -- ignore default slots at each end of the range if there's 
-    -- no default branch defined.
-    lowest_branch  = fst (head branches)
-    highest_branch = fst (last branches)
-
-    real_lo_tag
-	| isNothing mb_deflt = lowest_branch
-	| otherwise          = lo_tag
-
-    real_hi_tag
-	| isNothing mb_deflt = highest_branch
-	| otherwise          = hi_tag
-
-    n_tags = real_hi_tag - real_lo_tag + 1
-
-	-- INVARIANT: Provided hi_tag > lo_tag (which is true)
-	--	lo_tag <= mid_tag < hi_tag
-	--	lo_branches have tags <  mid_tag
-	--	hi_branches have tags >= mid_tag
-
-    (mid_tag,_) = branches !! (n_branches `div` 2)
-	-- 2 branches => n_branches `div` 2 = 1
-	--	      => branches !! 1 give the *second* tag
-	-- There are always at least 2 branches here
-
-    (lo_branches, hi_branches) = span is_lo branches
-    is_lo (t,_) = t < mid_tag
-
-
-assignTemp' e
-  | isTrivialCmmExpr e = return (CmmNop, e)
-  | otherwise          = do { reg <- newTemp (cmmExprRep e)
-                            ; return (CmmAssign reg e, CmmReg reg) }
-
-
-emitLitSwitch :: CmmExpr			-- Tag to switch on
-	      -> [(Literal, CgStmts)]		-- Tagged branches
-	      -> CgStmts			-- Default branch (always)
-	      -> Code				-- Emit the code
--- Used for general literals, whose size might not be a word, 
--- where there is always a default case, and where we don't know
--- the range of values for certain.  For simplicity we always generate a tree.
---
--- ToDo: for integers we could do better here, perhaps by generalising
--- mk_switch and using that.  --SDM 15/09/2004
-emitLitSwitch scrut [] deflt 
-  = emitCgStmts deflt
-emitLitSwitch scrut branches deflt_blk
-  = do	{ scrut' <- assignTemp scrut
-	; deflt_blk_id <- forkCgStmts deflt_blk
-	; blk <- mk_lit_switch scrut' deflt_blk_id (sortLe le branches)
-	; emitCgStmts blk }
-  where
-    le (t1,_) (t2,_) = t1 <= t2
-
-mk_lit_switch :: CmmExpr -> BlockId 
- 	      -> [(Literal,CgStmts)]
-	      -> FCode CgStmts
-mk_lit_switch scrut deflt_blk_id [(lit,blk)] 
-  = return (consCgStmt if_stmt blk)
-  where
-    cmm_lit = mkSimpleLit lit
-    rep     = cmmLitRep cmm_lit
-    cond    = CmmMachOp (MO_Ne rep) [scrut, CmmLit cmm_lit]
-    if_stmt = CmmCondBranch cond deflt_blk_id
-
-mk_lit_switch scrut deflt_blk_id branches
-  = do	{ hi_blk <- mk_lit_switch scrut deflt_blk_id hi_branches
- 	; lo_blk <- mk_lit_switch scrut deflt_blk_id lo_branches
-	; lo_blk_id <- forkCgStmts lo_blk
-	; let if_stmt = CmmCondBranch cond lo_blk_id
-	; return (if_stmt `consCgStmt` hi_blk) }
-  where
-    n_branches = length branches
-    (mid_lit,_) = branches !! (n_branches `div` 2)
-	-- See notes above re mid_tag
-
-    (lo_branches, hi_branches) = span is_lo branches
-    is_lo (t,_) = t < mid_lit
-
-    cond    = CmmMachOp (mkLtOp mid_lit) 
-			[scrut, CmmLit (mkSimpleLit mid_lit)]
-
--------------------------------------------------------------------------
---
---	Simultaneous assignment
---
--------------------------------------------------------------------------
-
-
-emitSimultaneously :: CmmStmts -> Code
--- Emit code to perform the assignments in the
--- input simultaneously, using temporary variables when necessary.
---
--- The Stmts must be:
---	CmmNop, CmmComment, CmmAssign, CmmStore
--- and nothing else
-
-
--- We use the strongly-connected component algorithm, in which
---	* the vertices are the statements
---	* an edge goes from s1 to s2 iff
---		s1 assigns to something s2 uses
---	  that is, if s1 should *follow* s2 in the final order
-
-type CVertex = (Int, CmmStmt)	-- Give each vertex a unique number,
-				-- for fast comparison
-
-emitSimultaneously stmts
-  = codeOnly $
-    case filterOut isNopStmt (stmtList stmts) of 
-	-- Remove no-ops
-      []     	-> nopC
-      [stmt] 	-> stmtC stmt	-- It's often just one stmt
-      stmt_list -> doSimultaneously1 (zip [(1::Int)..] stmt_list)
-
-doSimultaneously1 :: [CVertex] -> Code
-doSimultaneously1 vertices
-  = let
-	edges = [ (vertex, key1, edges_from stmt1)
-		| vertex@(key1, stmt1) <- vertices
-		]
-	edges_from stmt1 = [ key2 | (key2, stmt2) <- vertices, 
-				    stmt1 `mustFollow` stmt2
-			   ]
-	components = stronglyConnComp edges
-
-	-- do_components deal with one strongly-connected component
-	-- Not cyclic, or singleton?  Just do it
-	do_component (AcyclicSCC (n,stmt))  = stmtC stmt
-	do_component (CyclicSCC [(n,stmt)]) = stmtC stmt
-
-		-- Cyclic?  Then go via temporaries.  Pick one to
-		-- break the loop and try again with the rest.
-	do_component (CyclicSCC ((n,first_stmt) : rest))
-	  = do	{ from_temp <- go_via_temp first_stmt
-		; doSimultaneously1 rest
-		; stmtC from_temp }
-
-	go_via_temp (CmmAssign dest src)
-	  = do	{ tmp <- newTemp (cmmRegRep dest)
-		; stmtC (CmmAssign tmp src)
-		; return (CmmAssign dest (CmmReg tmp)) }
-	go_via_temp (CmmStore dest src)
-	  = do	{ tmp <- newTemp (cmmExprRep src)
-		; stmtC (CmmAssign tmp src)
-		; return (CmmStore dest (CmmReg tmp)) }
-    in
-    mapCs do_component components
-
-mustFollow :: CmmStmt -> CmmStmt -> Bool
-CmmAssign reg _  `mustFollow` stmt = anySrc (reg `regUsedIn`) stmt
-CmmStore loc e   `mustFollow` stmt = anySrc (locUsedIn loc (cmmExprRep e)) stmt
-CmmNop           `mustFollow` stmt = False
-CmmComment _     `mustFollow` stmt = False
-
-
-anySrc :: (CmmExpr -> Bool) -> CmmStmt -> Bool
--- True if the fn is true of any input of the stmt
-anySrc p (CmmAssign _ e)    = p e
-anySrc p (CmmStore e1 e2)   = p e1 || p e2	-- Might be used in either side
-anySrc p (CmmComment _)	    = False
-anySrc p CmmNop		    = False
-anySrc p other		    = True		-- Conservative
-
-regUsedIn :: CmmReg -> CmmExpr -> Bool
-reg `regUsedIn` CmmLit _ 	 = False
-reg `regUsedIn` CmmLoad e  _ 	 = reg `regUsedIn` e
-reg `regUsedIn` CmmReg reg' 	 = reg == reg'
-reg `regUsedIn` CmmRegOff reg' _ = reg == reg'
-reg `regUsedIn` CmmMachOp _ es   = any (reg `regUsedIn`) es
-
-locUsedIn :: CmmExpr -> MachRep -> CmmExpr -> Bool
--- (locUsedIn a r e) checks whether writing to r[a] could affect the value of
--- 'e'.  Returns True if it's not sure.
-locUsedIn loc rep (CmmLit _) 	     = False
-locUsedIn loc rep (CmmLoad e ld_rep) = possiblySameLoc loc rep e ld_rep
-locUsedIn loc rep (CmmReg reg')      = False
-locUsedIn loc rep (CmmRegOff reg' _) = False
-locUsedIn loc rep (CmmMachOp _ es)   = any (locUsedIn loc rep) es
-
-possiblySameLoc :: CmmExpr -> MachRep -> CmmExpr -> MachRep -> Bool
--- Assumes that distinct registers (eg Hp, Sp) do not 
--- point to the same location, nor any offset thereof.
-possiblySameLoc (CmmReg r1)       rep1 (CmmReg r2)      rep2  = r1==r2
-possiblySameLoc (CmmReg r1)       rep1 (CmmRegOff r2 0) rep2  = r1==r2
-possiblySameLoc (CmmRegOff r1 0)  rep1 (CmmReg r2)      rep2  = r1==r2
-possiblySameLoc (CmmRegOff r1 start1) rep1 (CmmRegOff r2 start2) rep2 
-  = r1==r2 && end1 > start2 && end2 > start1
-  where
-    end1 = start1 + machRepByteWidth rep1
-    end2 = start2 + machRepByteWidth rep2
-
-possiblySameLoc l1 rep1 (CmmLit _) rep2 = False
-possiblySameLoc l1 rep1 l2	   rep2 = True	-- Conservative
diff --git a/ghc/compiler/codeGen/ClosureInfo.hi-boot-5 b/ghc/compiler/codeGen/ClosureInfo.hi-boot-5
deleted file mode 100644
index 2291f93cc6..0000000000
--- a/ghc/compiler/codeGen/ClosureInfo.hi-boot-5
+++ /dev/null
@@ -1,4 +0,0 @@
-__interface ClosureInfo 1 0 where
-__export ClosureInfo ClosureInfo LambdaFormInfo;
-1 data LambdaFormInfo;
-1 data ClosureInfo;
diff --git a/ghc/compiler/codeGen/ClosureInfo.hi-boot-6 b/ghc/compiler/codeGen/ClosureInfo.hi-boot-6
deleted file mode 100644
index d313ccde80..0000000000
--- a/ghc/compiler/codeGen/ClosureInfo.hi-boot-6
+++ /dev/null
@@ -1,4 +0,0 @@
-module ClosureInfo where
-
-data LambdaFormInfo
-data ClosureInfo
diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs b/ghc/compiler/codeGen/ClosureInfo.lhs
deleted file mode 100644
index 84d9dd95ef..0000000000
--- a/ghc/compiler/codeGen/ClosureInfo.lhs
+++ /dev/null
@@ -1,951 +0,0 @@
-%
-% (c) The Univserity of Glasgow 1992-2004
-%
-
-	Data structures which describe closures, and
-	operations over those data structures
-
-		Nothing monadic in here
-
-Much of the rationale for these things is in the ``details'' part of
-the STG paper.
-
-\begin{code}
-module ClosureInfo (
-	ClosureInfo, LambdaFormInfo, SMRep, 	-- all abstract
-	StandardFormInfo, 
-
-	ArgDescr(..), Liveness(..), 
-	C_SRT(..), needsSRT,
-
-	mkLFThunk, mkLFReEntrant, mkConLFInfo, mkSelectorLFInfo,
-	mkApLFInfo, mkLFImported, mkLFArgument, mkLFLetNoEscape,
-
-	mkClosureInfo, mkConInfo,
-
-	closureSize, closureNonHdrSize,
-	closureGoodStuffSize, closurePtrsSize,
-	slopSize, 
-
-	closureName, infoTableLabelFromCI,
-	closureLabelFromCI, closureSRT,
-	closureLFInfo, isLFThunk,closureSMRep, closureUpdReqd, 
-	closureNeedsUpdSpace, closureIsThunk,
-	closureSingleEntry, closureReEntrant, isConstrClosure_maybe,
-	closureFunInfo,	isStandardFormThunk, isKnownFun,
-
-	enterIdLabel, enterLocalIdLabel, enterReturnPtLabel,
-
-	nodeMustPointToIt, 
-	CallMethod(..), getCallMethod,
-
-	blackHoleOnEntry,
-
-	staticClosureRequired,
-	getClosureType,
-
-	isToplevClosure,
-	closureValDescr, closureTypeDescr,	-- profiling
-
-	isStaticClosure,
-	cafBlackHoleClosureInfo, seCafBlackHoleClosureInfo,
-
-	staticClosureNeedsLink,
-    ) where
-
-#include "../includes/MachDeps.h"
-#include "HsVersions.h"
-
-import StgSyn
-import SMRep		-- all of it
-
-import CLabel
-
-import Constants	( mIN_PAYLOAD_SIZE )
-import Packages		( isDllName, HomeModules )
-import StaticFlags	( opt_SccProfilingOn, opt_OmitBlackHoling,
-			  opt_Parallel, opt_DoTickyProfiling )
-import Id		( Id, idType, idArity, idName )
-import DataCon		( DataCon, dataConTyCon, isNullaryRepDataCon, dataConName )
-import Name		( Name, nameUnique, getOccName, getOccString )
-import OccName		( occNameString )
-import Type		( isUnLiftedType, Type, repType, splitTyConApp_maybe )
-import TcType		( tcSplitSigmaTy )
-import TyCon		( isFunTyCon, isAbstractTyCon )
-import BasicTypes	( TopLevelFlag(..), isNotTopLevel, isTopLevel, ipNameName )
-import FastString
-import Outputable
-import Constants
-
-import TypeRep	-- TEMP
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[ClosureInfo-datatypes]{Data types for closure information}
-%*									*
-%************************************************************************
-
-Information about a closure, from the code generator's point of view.
-
-A ClosureInfo decribes the info pointer of a closure.  It has
-enough information 
-  a) to construct the info table itself
-  b) to allocate a closure containing that info pointer (i.e.
-	it knows the info table label)
-
-We make a ClosureInfo for
-	- each let binding (both top level and not)
-	- each data constructor (for its shared static and
-		dynamic info tables)
-
-\begin{code}
-data ClosureInfo
-  = ClosureInfo {
-	closureName   :: !Name,		  -- The thing bound to this closure
-	closureLFInfo :: !LambdaFormInfo, -- NOTE: not an LFCon (see below)
-	closureSMRep  :: !SMRep,	  -- representation used by storage mgr
-	closureSRT    :: !C_SRT,	  -- What SRT applies to this closure
-	closureType   :: !Type,		  -- Type of closure (ToDo: remove)
-	closureDescr  :: !String	  -- closure description (for profiling)
-    }
-
-  -- Constructor closures don't have a unique info table label (they use
-  -- the constructor's info table), and they don't have an SRT.
-  | ConInfo {
-	closureCon       :: !DataCon,
-	closureSMRep     :: !SMRep,
-	closureDllCon	 :: !Bool	-- is in a separate DLL
-    }
-
--- C_SRT is what StgSyn.SRT gets translated to... 
--- we add a label for the table, and expect only the 'offset/length' form
-
-data C_SRT = NoC_SRT
-	   | C_SRT !CLabel !WordOff !StgHalfWord {-bitmap or escape-}
-
-needsSRT :: C_SRT -> Bool
-needsSRT NoC_SRT       = False
-needsSRT (C_SRT _ _ _) = True
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection[LambdaFormInfo-datatype]{@LambdaFormInfo@: source-derivable info}
-%*									*
-%************************************************************************
-
-Information about an identifier, from the code generator's point of
-view.  Every identifier is bound to a LambdaFormInfo in the
-environment, which gives the code generator enough info to be able to
-tail call or return that identifier.
-
-Note that a closure is usually bound to an identifier, so a
-ClosureInfo contains a LambdaFormInfo.
-
-\begin{code}
-data LambdaFormInfo
-  = LFReEntrant		-- Reentrant closure (a function)
-	TopLevelFlag	-- True if top level
-	!Int		-- Arity. Invariant: always > 0
-	!Bool		-- True <=> no fvs
-	ArgDescr	-- Argument descriptor (should reall be in ClosureInfo)
-
-  | LFCon		-- A saturated constructor application
-	DataCon		-- The constructor
-
-  | LFThunk		-- Thunk (zero arity)
-	TopLevelFlag
-	!Bool		-- True <=> no free vars
-	!Bool		-- True <=> updatable (i.e., *not* single-entry)
-	StandardFormInfo
-	!Bool		-- True <=> *might* be a function type
-
-  | LFUnknown		-- Used for function arguments and imported things.
-			--  We know nothing about  this closure.  Treat like
-			-- updatable "LFThunk"...
-			-- Imported things which we do know something about use
-			-- one of the other LF constructors (eg LFReEntrant for
-			-- known functions)
-	!Bool		-- True <=> *might* be a function type
-
-  | LFLetNoEscape	-- See LetNoEscape module for precise description of
-			-- these "lets".
-	!Int		-- arity;
-
-  | LFBlackHole		-- Used for the closures allocated to hold the result
-			-- of a CAF.  We want the target of the update frame to
-			-- be in the heap, so we make a black hole to hold it.
-        CLabel          -- Flavour (info label, eg CAF_BLACKHOLE_info).
-
-
--------------------------
--- An ArgDsecr describes the argument pattern of a function
-
-data ArgDescr
-  = ArgSpec		-- Fits one of the standard patterns
-	!Int		-- RTS type identifier ARG_P, ARG_N, ...
-
-  | ArgGen	 	-- General case
-	Liveness	-- Details about the arguments
-
-
--------------------------
--- We represent liveness bitmaps as a Bitmap (whose internal
--- representation really is a bitmap).  These are pinned onto case return
--- vectors to indicate the state of the stack for the garbage collector.
--- 
--- In the compiled program, liveness bitmaps that fit inside a single
--- word (StgWord) are stored as a single word, while larger bitmaps are
--- stored as a pointer to an array of words. 
-
-data Liveness
-  = SmallLiveness	-- Liveness info that fits in one word
-	StgWord		-- Here's the bitmap
-
-  | BigLiveness		-- Liveness info witha a multi-word bitmap
-	CLabel		-- Label for the bitmap
-
-
--------------------------
--- StandardFormInfo tells whether this thunk has one of 
--- a small number of standard forms
-
-data StandardFormInfo
-  = NonStandardThunk
-	-- Not of of the standard forms
-
-  | SelectorThunk
-	-- A SelectorThunk is of form
-	--      case x of
-	--	       con a1,..,an -> ak
-	-- and the constructor is from a single-constr type.
-       WordOff             	-- 0-origin offset of ak within the "goods" of 
-			-- constructor (Recall that the a1,...,an may be laid
-			-- out in the heap in a non-obvious order.)
-
-  | ApThunk 
-	-- An ApThunk is of form
-	--	x1 ... xn
-	-- The code for the thunk just pushes x2..xn on the stack and enters x1.
-	-- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
-	-- in the RTS to save space.
-	Int		-- Arity, n
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[ClosureInfo-construction]{Functions which build LFInfos}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkLFReEntrant :: TopLevelFlag	-- True of top level
-	      -> [Id]		-- Free vars
-	      -> [Id] 		-- Args
-	      -> ArgDescr	-- Argument descriptor
-	      -> LambdaFormInfo
-
-mkLFReEntrant top fvs args arg_descr 
-  = LFReEntrant top (length args) (null fvs) arg_descr
-
-mkLFThunk thunk_ty top fvs upd_flag
-  = ASSERT( not (isUpdatable upd_flag) || not (isUnLiftedType thunk_ty) )
-    LFThunk top (null fvs) 
-	    (isUpdatable upd_flag)
-	    NonStandardThunk 
-	    (might_be_a_function thunk_ty)
-
-might_be_a_function :: Type -> Bool
-might_be_a_function ty
-  | Just (tc,_) <- splitTyConApp_maybe (repType ty), 
-    not (isFunTyCon tc)  && not (isAbstractTyCon tc) = False
-	-- don't forget to check for abstract types, which might
-	-- be functions too.
-  | otherwise = True
-\end{code}
-
-@mkConLFInfo@ is similar, for constructors.
-
-\begin{code}
-mkConLFInfo :: DataCon -> LambdaFormInfo
-mkConLFInfo con = LFCon con
-
-mkSelectorLFInfo id offset updatable
-  = LFThunk NotTopLevel False updatable (SelectorThunk offset) 
-	(might_be_a_function (idType id))
-
-mkApLFInfo id upd_flag arity
-  = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
-	(might_be_a_function (idType id))
-\end{code}
-
-Miscellaneous LF-infos.
-
-\begin{code}
-mkLFArgument id = LFUnknown (might_be_a_function (idType id))
-
-mkLFLetNoEscape = LFLetNoEscape
-
-mkLFImported :: Id -> LambdaFormInfo
-mkLFImported id
-  = case idArity id of
-      n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr")  -- n > 0
-      other -> mkLFArgument id -- Not sure of exact arity
-\end{code}
-
-\begin{code}
-isLFThunk :: LambdaFormInfo -> Bool
-isLFThunk (LFThunk _ _ _ _ _)  = True
-isLFThunk (LFBlackHole _)      = True
-	-- return True for a blackhole: this function is used to determine
-	-- whether to use the thunk header in SMP mode, and a blackhole
-	-- must have one.
-isLFThunk _ = False
-\end{code}
-
-%************************************************************************
-%*									*
-	Building ClosureInfos
-%*									*
-%************************************************************************
-
-\begin{code}
-mkClosureInfo :: Bool		-- Is static
-	      -> Id
-	      -> LambdaFormInfo 
-	      -> Int -> Int	-- Total and pointer words
-	      -> C_SRT
-	      -> String		-- String descriptor
-	      -> ClosureInfo
-mkClosureInfo is_static id lf_info tot_wds ptr_wds srt_info descr
-  = ClosureInfo { closureName = name, 
-		  closureLFInfo = lf_info,
-		  closureSMRep = sm_rep, 
-		  closureSRT = srt_info,
-		  closureType = idType id,
-		  closureDescr = descr }
-  where
-    name   = idName id
-    sm_rep = chooseSMRep is_static lf_info tot_wds ptr_wds
-
-mkConInfo :: HomeModules
-	  -> Bool	-- Is static
-	  -> DataCon	
-	  -> Int -> Int	-- Total and pointer words
-	  -> ClosureInfo
-mkConInfo hmods is_static data_con tot_wds ptr_wds
-   = ConInfo {	closureSMRep = sm_rep,
-		closureCon = data_con,
-		closureDllCon = isDllName hmods (dataConName data_con) }
-  where
-    sm_rep = chooseSMRep is_static (mkConLFInfo data_con) tot_wds ptr_wds
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[ClosureInfo-sizes]{Functions about closure {\em sizes}}
-%*									*
-%************************************************************************
-
-\begin{code}
-closureSize :: ClosureInfo -> WordOff
-closureSize cl_info = hdr_size + closureNonHdrSize cl_info
-  where hdr_size  | closureIsThunk cl_info = thunkHdrSize
-  		  | otherwise      	   = fixedHdrSize
-	-- All thunks use thunkHdrSize, even if they are non-updatable.
-	-- this is because we don't have separate closure types for
-	-- updatable vs. non-updatable thunks, so the GC can't tell the
-	-- difference.  If we ever have significant numbers of non-
-	-- updatable thunks, it might be worth fixing this.
-
-closureNonHdrSize :: ClosureInfo -> WordOff
-closureNonHdrSize cl_info
-  = tot_wds + computeSlopSize tot_wds cl_info
-  where
-    tot_wds = closureGoodStuffSize cl_info
-
-closureGoodStuffSize :: ClosureInfo -> WordOff
-closureGoodStuffSize cl_info
-  = let (ptrs, nonptrs) = sizes_from_SMRep (closureSMRep cl_info)
-    in	ptrs + nonptrs
-
-closurePtrsSize :: ClosureInfo -> WordOff
-closurePtrsSize cl_info
-  = let (ptrs, _) = sizes_from_SMRep (closureSMRep cl_info)
-    in	ptrs
-
--- not exported:
-sizes_from_SMRep :: SMRep -> (WordOff,WordOff)
-sizes_from_SMRep (GenericRep _ ptrs nonptrs _)   = (ptrs, nonptrs)
-sizes_from_SMRep BlackHoleRep			 = (0, 0)
-\end{code}
-
-Computing slop size.  WARNING: this looks dodgy --- it has deep
-knowledge of what the storage manager does with the various
-representations...
-
-Slop Requirements: every thunk gets an extra padding word in the
-header, which takes the the updated value.
-
-\begin{code}
-slopSize cl_info = computeSlopSize payload_size cl_info
-  where payload_size = closureGoodStuffSize cl_info
-
-computeSlopSize :: WordOff -> ClosureInfo -> WordOff
-computeSlopSize payload_size cl_info
-  = max 0 (minPayloadSize smrep updatable - payload_size)
-  where
-	smrep        = closureSMRep cl_info
-	updatable    = closureNeedsUpdSpace cl_info
-
--- we leave space for an update if either (a) the closure is updatable
--- or (b) it is a static thunk.  This is because a static thunk needs
--- a static link field in a predictable place (after the slop), regardless
--- of whether it is updatable or not.
-closureNeedsUpdSpace (ClosureInfo { closureLFInfo = 
-					LFThunk TopLevel _ _ _ _ }) = True
-closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
-
-minPayloadSize :: SMRep -> Bool -> WordOff
-minPayloadSize smrep updatable
-  = case smrep of
-	BlackHoleRep		 		-> min_upd_size
-	GenericRep _ _ _ _      | updatable     -> min_upd_size
-	GenericRep True _ _ _                   -> 0 -- static
-	GenericRep False _ _ _                  -> mIN_PAYLOAD_SIZE
-          --       ^^^^^___ dynamic
-  where
-   min_upd_size =
-	ASSERT(mIN_PAYLOAD_SIZE <= sIZEOF_StgSMPThunkHeader)
-	0 	-- check that we already have enough
-		-- room for mIN_SIZE_NonUpdHeapObject,
-		-- due to the extra header word in SMP
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[SMreps]{Choosing SM reps}
-%*									*
-%************************************************************************
-
-\begin{code}
-chooseSMRep
-	:: Bool			-- True <=> static closure
-	-> LambdaFormInfo
-	-> WordOff -> WordOff	-- Tot wds, ptr wds
-	-> SMRep
-
-chooseSMRep is_static lf_info tot_wds ptr_wds
-  = let
-	 nonptr_wds   = tot_wds - ptr_wds
-	 closure_type = getClosureType is_static ptr_wds lf_info
-    in
-    GenericRep is_static ptr_wds nonptr_wds closure_type	
-
--- We *do* get non-updatable top-level thunks sometimes.  eg. f = g
--- gets compiled to a jump to g (if g has non-zero arity), instead of
--- messing around with update frames and PAPs.  We set the closure type
--- to FUN_STATIC in this case.
-
-getClosureType :: Bool -> WordOff -> LambdaFormInfo -> ClosureType
-getClosureType is_static ptr_wds lf_info
-  = case lf_info of
-	LFCon con | is_static && ptr_wds == 0	-> ConstrNoCaf
-		  | otherwise			-> Constr
-  	LFReEntrant _ _ _ _ 			-> Fun
-	LFThunk _ _ _ (SelectorThunk _) _ 	-> ThunkSelector
-	LFThunk _ _ _ _ _ 			-> Thunk
-	_ -> panic "getClosureType"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[ClosureInfo-4-questions]{Four major questions about @ClosureInfo@}
-%*									*
-%************************************************************************
-
-Be sure to see the stg-details notes about these...
-
-\begin{code}
-nodeMustPointToIt :: LambdaFormInfo -> Bool
-nodeMustPointToIt (LFReEntrant top _ no_fvs _)
-  = not no_fvs ||   -- Certainly if it has fvs we need to point to it
-    isNotTopLevel top
-		    -- If it is not top level we will point to it
-		    --   We can have a \r closure with no_fvs which
-		    --   is not top level as special case cgRhsClosure
-		    --   has been dissabled in favour of let floating
-
-		-- For lex_profiling we also access the cost centre for a
-		-- non-inherited function i.e. not top level
-		-- the  not top  case above ensures this is ok.
-
-nodeMustPointToIt (LFCon _) = True
-
-	-- Strictly speaking, the above two don't need Node to point
-	-- to it if the arity = 0.  But this is a *really* unlikely
-	-- situation.  If we know it's nil (say) and we are entering
-	-- it. Eg: let x = [] in x then we will certainly have inlined
-	-- x, since nil is a simple atom.  So we gain little by not
-	-- having Node point to known zero-arity things.  On the other
-	-- hand, we do lose something; Patrick's code for figuring out
-	-- when something has been updated but not entered relies on
-	-- having Node point to the result of an update.  SLPJ
-	-- 27/11/92.
-
-nodeMustPointToIt (LFThunk _ no_fvs updatable NonStandardThunk _)
-  = updatable || not no_fvs || opt_SccProfilingOn
-	  -- For the non-updatable (single-entry case):
-	  --
-	  -- True if has fvs (in which case we need access to them, and we
-	  --		    should black-hole it)
-	  -- or profiling (in which case we need to recover the cost centre
-	  --		 from inside it)
-
-nodeMustPointToIt (LFThunk _ no_fvs updatable some_standard_form_thunk _)
-  = True  -- Node must point to any standard-form thunk
-
-nodeMustPointToIt (LFUnknown _)     = True
-nodeMustPointToIt (LFBlackHole _)   = True    -- BH entry may require Node to point
-nodeMustPointToIt (LFLetNoEscape _) = False 
-\end{code}
-
-The entry conventions depend on the type of closure being entered,
-whether or not it has free variables, and whether we're running
-sequentially or in parallel.
-
-\begin{tabular}{lllll}
-Closure Characteristics & Parallel & Node Req'd & Argument Passing & Enter Via \\
-Unknown 			& no & yes & stack	& node \\
-Known fun ($\ge$ 1 arg), no fvs 	& no & no  & registers 	& fast entry (enough args) \\
-\ & \ & \ & \ 						& slow entry (otherwise) \\
-Known fun ($\ge$ 1 arg), fvs	& no & yes & registers 	& fast entry (enough args) \\
-0 arg, no fvs @\r,\s@ 		& no & no  & n/a 	& direct entry \\
-0 arg, no fvs @\u@ 		& no & yes & n/a 	& node \\
-0 arg, fvs @\r,\s@ 		& no & yes & n/a 	& direct entry \\
-0 arg, fvs @\u@ 		& no & yes & n/a 	& node \\
-
-Unknown 			& yes & yes & stack	& node \\
-Known fun ($\ge$ 1 arg), no fvs 	& yes & no  & registers & fast entry (enough args) \\
-\ & \ & \ & \ 						& slow entry (otherwise) \\
-Known fun ($\ge$ 1 arg), fvs	& yes & yes & registers & node \\
-0 arg, no fvs @\r,\s@ 		& yes & no  & n/a 	& direct entry \\
-0 arg, no fvs @\u@ 		& yes & yes & n/a 	& node \\
-0 arg, fvs @\r,\s@ 		& yes & yes & n/a 	& node \\
-0 arg, fvs @\u@ 		& yes & yes & n/a 	& node\\
-\end{tabular}
-
-When black-holing, single-entry closures could also be entered via node
-(rather than directly) to catch double-entry.
-
-\begin{code}
-data CallMethod
-  = EnterIt				-- no args, not a function
-
-  | JumpToIt CLabel			-- no args, not a function, but we
-					-- know what its entry code is
-
-  | ReturnIt				-- it's a function, but we have
-					-- zero args to apply to it, so just
-					-- return it.
-
-  | ReturnCon DataCon			-- It's a data constructor, just return it
-
-  | SlowCall				-- Unknown fun, or known fun with
-					-- too few args.
-
-  | DirectEntry 			-- Jump directly, with args in regs
-	CLabel 				--   The code label
-	Int 				--   Its arity
-
-getCallMethod :: HomeModules
-	      -> Name		-- Function being applied
-	      -> LambdaFormInfo	-- Its info
-	      -> Int		-- Number of available arguments
-	      -> CallMethod
-
-getCallMethod hmods name lf_info n_args
-  | nodeMustPointToIt lf_info && opt_Parallel
-  =	-- If we're parallel, then we must always enter via node.  
-	-- The reason is that the closure may have been 	
-	-- fetched since we allocated it.
-    EnterIt
-
-getCallMethod hmods name (LFReEntrant _ arity _ _) n_args
-  | n_args == 0    = ASSERT( arity /= 0 )
-		     ReturnIt	-- No args at all
-  | n_args < arity = SlowCall	-- Not enough args
-  | otherwise      = DirectEntry (enterIdLabel hmods name) arity
-
-getCallMethod hmods name (LFCon con) n_args
-  = ASSERT( n_args == 0 )
-    ReturnCon con
-
-getCallMethod hmods name (LFThunk _ _ updatable std_form_info is_fun) n_args
-  | is_fun 	-- Must always "call" a function-typed 
-  = SlowCall	-- thing, cannot just enter it [in eval/apply, the entry code
-		-- is the fast-entry code]
-
-  | updatable || opt_DoTickyProfiling  -- to catch double entry
-      {- OLD: || opt_SMP
-	 I decided to remove this, because in SMP mode it doesn't matter
-	 if we enter the same thunk multiple times, so the optimisation
-	 of jumping directly to the entry code is still valid.  --SDM
-	-}
-  = ASSERT( n_args == 0 ) EnterIt
-
-  | otherwise	-- Jump direct to code for single-entry thunks
-  = ASSERT( n_args == 0 )
-    JumpToIt (thunkEntryLabel hmods name std_form_info updatable)
-
-getCallMethod hmods name (LFUnknown True) n_args
-  = SlowCall -- might be a function
-
-getCallMethod hmods name (LFUnknown False) n_args
-  = ASSERT2 ( n_args == 0, ppr name <+> ppr n_args ) 
-    EnterIt -- Not a function
-
-getCallMethod hmods name (LFBlackHole _) n_args
-  = SlowCall	-- Presumably the black hole has by now
-		-- been updated, but we don't know with
-		-- what, so we slow call it
-
-getCallMethod hmods name (LFLetNoEscape 0) n_args
-  = JumpToIt (enterReturnPtLabel (nameUnique name))
-
-getCallMethod hmods name (LFLetNoEscape arity) n_args
-  | n_args == arity = DirectEntry (enterReturnPtLabel (nameUnique name)) arity
-  | otherwise = pprPanic "let-no-escape: " (ppr name <+> ppr arity)
-
-blackHoleOnEntry :: ClosureInfo -> Bool
--- Static closures are never themselves black-holed.
--- Updatable ones will be overwritten with a CAFList cell, which points to a 
--- black hole;
--- Single-entry ones have no fvs to plug, and we trust they don't form part 
--- of a loop.
-
-blackHoleOnEntry ConInfo{} = False
-blackHoleOnEntry (ClosureInfo { closureLFInfo = lf_info, closureSMRep = rep })
-  | isStaticRep rep
-  = False	-- Never black-hole a static closure
-
-  | otherwise
-  = case lf_info of
-	LFReEntrant _ _ _ _	  -> False
-	LFLetNoEscape _		  -> False
-	LFThunk _ no_fvs updatable _ _
-	  -> if updatable
-	     then not opt_OmitBlackHoling
-	     else opt_DoTickyProfiling || not no_fvs
-                  -- the former to catch double entry,
-                  -- and the latter to plug space-leaks.  KSW/SDM 1999-04.
-
-	other -> panic "blackHoleOnEntry"	-- Should never happen
-
-isStandardFormThunk :: LambdaFormInfo -> Bool
-isStandardFormThunk (LFThunk _ _ _ (SelectorThunk _) _) = True
-isStandardFormThunk (LFThunk _ _ _ (ApThunk _) _)	= True
-isStandardFormThunk other_lf_info 			= False
-
-isKnownFun :: LambdaFormInfo -> Bool
-isKnownFun (LFReEntrant _ _ _ _) = True
-isKnownFun (LFLetNoEscape _) = True
-isKnownFun _ = False
-\end{code}
-
------------------------------------------------------------------------------
-SRT-related stuff
-
-\begin{code}
-staticClosureNeedsLink :: ClosureInfo -> Bool
--- A static closure needs a link field to aid the GC when traversing
--- the static closure graph.  But it only needs such a field if either
--- 	a) it has an SRT
---	b) it's a constructor with one or more pointer fields
--- In case (b), the constructor's fields themselves play the role
--- of the SRT.
-staticClosureNeedsLink (ClosureInfo { closureSRT = srt })
-  = needsSRT srt
-staticClosureNeedsLink (ConInfo { closureSMRep = sm_rep, closureCon = con })
-  = not (isNullaryRepDataCon con) && not_nocaf_constr
-  where
-    not_nocaf_constr = 
-	case sm_rep of 
-	   GenericRep _ _ _ ConstrNoCaf -> False
-	   _other			-> True
-\end{code}
-
-Avoiding generating entries and info tables
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-At present, for every function we generate all of the following,
-just in case.  But they aren't always all needed, as noted below:
-
-[NB1: all of this applies only to *functions*.  Thunks always
-have closure, info table, and entry code.]
-
-[NB2: All are needed if the function is *exported*, just to play safe.]
-
-
-* Fast-entry code  ALWAYS NEEDED
-
-* Slow-entry code
-	Needed iff (a) we have any un-saturated calls to the function
-	OR	   (b) the function is passed as an arg
-	OR	   (c) we're in the parallel world and the function has free vars
-			[Reason: in parallel world, we always enter functions
-			with free vars via the closure.]
-
-* The function closure
-	Needed iff (a) we have any un-saturated calls to the function
-	OR	   (b) the function is passed as an arg
-	OR	   (c) if the function has free vars (ie not top level)
-
-  Why case (a) here?  Because if the arg-satis check fails,
-  UpdatePAP stuffs a pointer to the function closure in the PAP.
-  [Could be changed; UpdatePAP could stuff in a code ptr instead,
-   but doesn't seem worth it.]
-
-  [NB: these conditions imply that we might need the closure
-  without the slow-entry code.  Here's how.
-
-	f x y = let g w = ...x..y..w...
-		in
-		...(g t)...
-
-  Here we need a closure for g which contains x and y,
-  but since the calls are all saturated we just jump to the
-  fast entry point for g, with R1 pointing to the closure for g.]
-
-
-* Standard info table
-	Needed iff (a) we have any un-saturated calls to the function
-	OR	   (b) the function is passed as an arg
-	OR 	   (c) the function has free vars (ie not top level)
-
-	NB.  In the sequential world, (c) is only required so that the function closure has
-	an info table to point to, to keep the storage manager happy.
-	If (c) alone is true we could fake up an info table by choosing
-	one of a standard family of info tables, whose entry code just
-	bombs out.
-
-	[NB In the parallel world (c) is needed regardless because
-	we enter functions with free vars via the closure.]
-
-	If (c) is retained, then we'll sometimes generate an info table
-	(for storage mgr purposes) without slow-entry code.  Then we need
-	to use an error label in the info table to substitute for the absent
-	slow entry code.
-
-\begin{code}
-staticClosureRequired
-	:: Name
-	-> StgBinderInfo
-	-> LambdaFormInfo
-	-> Bool
-staticClosureRequired binder bndr_info
-		      (LFReEntrant top_level _ _ _)	-- It's a function
-  = ASSERT( isTopLevel top_level )
-	-- Assumption: it's a top-level, no-free-var binding
-	not (satCallsOnly bndr_info)
-
-staticClosureRequired binder other_binder_info other_lf_info = True
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[ClosureInfo-misc-funs]{Misc functions about @ClosureInfo@, etc.}
-%*									*
-%************************************************************************
-
-\begin{code}
-
-isStaticClosure :: ClosureInfo -> Bool
-isStaticClosure cl_info = isStaticRep (closureSMRep cl_info)
-
-closureUpdReqd :: ClosureInfo -> Bool
-closureUpdReqd ClosureInfo{ closureLFInfo = lf_info } = lfUpdatable lf_info
-closureUpdReqd ConInfo{} = False
-
-lfUpdatable :: LambdaFormInfo -> Bool
-lfUpdatable (LFThunk _ _ upd _ _)  = upd
-lfUpdatable (LFBlackHole _)	   = True
-	-- Black-hole closures are allocated to receive the results of an
-	-- alg case with a named default... so they need to be updated.
-lfUpdatable _ = False
-
-closureIsThunk :: ClosureInfo -> Bool
-closureIsThunk ClosureInfo{ closureLFInfo = lf_info } = isLFThunk lf_info
-closureIsThunk ConInfo{} = False
-
-closureSingleEntry :: ClosureInfo -> Bool
-closureSingleEntry (ClosureInfo { closureLFInfo = LFThunk _ _ upd _ _}) = not upd
-closureSingleEntry other_closure = False
-
-closureReEntrant :: ClosureInfo -> Bool
-closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
-closureReEntrant other_closure = False
-
-isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
-isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
-isConstrClosure_maybe _ 				  = Nothing
-
-closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
-closureFunInfo (ClosureInfo { closureLFInfo = LFReEntrant _ arity _ arg_desc})
-  = Just (arity, arg_desc)
-closureFunInfo _
-  = Nothing
-\end{code}
-
-\begin{code}
-isToplevClosure :: ClosureInfo -> Bool
-isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
-  = case lf_info of
-      LFReEntrant TopLevel _ _ _ -> True
-      LFThunk TopLevel _ _ _ _   -> True
-      other -> False
-isToplevClosure _ = False
-\end{code}
-
-Label generation.
-
-\begin{code}
-infoTableLabelFromCI :: ClosureInfo -> CLabel
-infoTableLabelFromCI (ClosureInfo { closureName = name,
-				    closureLFInfo = lf_info, 
-				    closureSMRep = rep })
-  = case lf_info of
-	LFBlackHole info -> info
-
-	LFThunk _ _ upd_flag (SelectorThunk offset) _ -> 
-		mkSelectorInfoLabel upd_flag offset
-
-	LFThunk _ _ upd_flag (ApThunk arity) _ -> 
-		mkApInfoTableLabel upd_flag arity
-
-	LFThunk{}      -> mkLocalInfoTableLabel name
-
-	LFReEntrant _ _ _ _ -> mkLocalInfoTableLabel name
-
-	other -> panic "infoTableLabelFromCI"
-
-infoTableLabelFromCI (ConInfo { closureCon = con, 
-				closureSMRep = rep,
-				closureDllCon = dll })
-  | isStaticRep rep = mkStaticInfoTableLabel  name dll
-  | otherwise	    = mkConInfoTableLabel     name dll
-  where
-    name = dataConName con
-
--- ClosureInfo for a closure (as opposed to a constructor) is always local
-closureLabelFromCI (ClosureInfo { closureName = nm }) = mkLocalClosureLabel nm
-closureLabelFromCI _ = panic "closureLabelFromCI"
-
--- thunkEntryLabel is a local help function, not exported.  It's used from both
--- entryLabelFromCI and getCallMethod.
-
-thunkEntryLabel hmods thunk_id (ApThunk arity) is_updatable
-  = enterApLabel is_updatable arity
-thunkEntryLabel hmods thunk_id (SelectorThunk offset) upd_flag
-  = enterSelectorLabel upd_flag offset
-thunkEntryLabel hmods thunk_id _ is_updatable
-  = enterIdLabel hmods thunk_id
-
-enterApLabel is_updatable arity
-  | tablesNextToCode = mkApInfoTableLabel is_updatable arity
-  | otherwise        = mkApEntryLabel is_updatable arity
-
-enterSelectorLabel upd_flag offset
-  | tablesNextToCode = mkSelectorInfoLabel upd_flag offset
-  | otherwise        = mkSelectorEntryLabel upd_flag offset
-
-enterIdLabel hmods id
-  | tablesNextToCode = mkInfoTableLabel hmods id
-  | otherwise        = mkEntryLabel hmods id
-
-enterLocalIdLabel id
-  | tablesNextToCode = mkLocalInfoTableLabel id
-  | otherwise        = mkLocalEntryLabel id
-
-enterReturnPtLabel name
-  | tablesNextToCode = mkReturnInfoLabel name
-  | otherwise        = mkReturnPtLabel name
-\end{code}
-
-
-We need a black-hole closure info to pass to @allocDynClosure@ when we
-want to allocate the black hole on entry to a CAF.  These are the only
-ways to build an LFBlackHole, maintaining the invariant that it really
-is a black hole and not something else.
-
-\begin{code}
-cafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
-				       closureType = ty })
-  = ClosureInfo { closureName   = nm,
-		  closureLFInfo = LFBlackHole mkCAFBlackHoleInfoTableLabel,
-		  closureSMRep  = BlackHoleRep,
-		  closureSRT    = NoC_SRT,
-		  closureType   = ty,
-		  closureDescr  = "" }
-cafBlackHoleClosureInfo _ = panic "cafBlackHoleClosureInfo"
-
-seCafBlackHoleClosureInfo (ClosureInfo { closureName = nm,
-				         closureType = ty })
-  = ClosureInfo { closureName   = nm,
-		  closureLFInfo = LFBlackHole mkSECAFBlackHoleInfoTableLabel,
-		  closureSMRep  = BlackHoleRep,
-		  closureSRT    = NoC_SRT,
-		  closureType   = ty,
-		  closureDescr  = ""  }
-seCafBlackHoleClosureInfo _ = panic "seCafBlackHoleClosureInfo"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[ClosureInfo-Profiling-funs]{Misc functions about for profiling info.}
-%*									*
-%************************************************************************
-
-Profiling requires two pieces of information to be determined for
-each closure's info table --- description and type.
-
-The description is stored directly in the @CClosureInfoTable@ when the
-info table is built.
-
-The type is determined from the type information stored with the @Id@
-in the closure info using @closureTypeDescr@.
-
-\begin{code}
-closureValDescr, closureTypeDescr :: ClosureInfo -> String
-closureValDescr (ClosureInfo {closureDescr = descr}) 
-  = descr
-closureValDescr (ConInfo {closureCon = con})
-  = occNameString (getOccName con)
-
-closureTypeDescr (ClosureInfo { closureType = ty })
-  = getTyDescription ty
-closureTypeDescr (ConInfo { closureCon = data_con })
-  = occNameString (getOccName (dataConTyCon data_con))
-
-getTyDescription :: Type -> String
-getTyDescription ty
-  = case (tcSplitSigmaTy ty) of { (_, _, tau_ty) ->
-    case tau_ty of
-      TyVarTy _	       	     -> "*"
-      AppTy fun _      	     -> getTyDescription fun
-      FunTy _ res      	     -> '-' : '>' : fun_result res
-      TyConApp tycon _ 	     -> getOccString tycon
-      NoteTy (FTVNote _) ty  -> getTyDescription ty
-      PredTy sty	     -> getPredTyDescription sty
-      ForAllTy _ ty          -> getTyDescription ty
-    }
-  where
-    fun_result (FunTy _ res) = '>' : fun_result res
-    fun_result other	     = getTyDescription other
-
-getPredTyDescription (ClassP cl tys) = getOccString cl
-getPredTyDescription (IParam ip ty)  = getOccString (ipNameName ip)
-\end{code}
-
-
diff --git a/ghc/compiler/codeGen/ClosureInfo.lhs-boot b/ghc/compiler/codeGen/ClosureInfo.lhs-boot
deleted file mode 100644
index b069905d3e..0000000000
--- a/ghc/compiler/codeGen/ClosureInfo.lhs-boot
+++ /dev/null
@@ -1,6 +0,0 @@
-\begin{code}
-module ClosureInfo where
-
-data LambdaFormInfo
-data ClosureInfo
-\end{code}
\ No newline at end of file
diff --git a/ghc/compiler/codeGen/CodeGen.lhs b/ghc/compiler/codeGen/CodeGen.lhs
deleted file mode 100644
index e8d83a5a43..0000000000
--- a/ghc/compiler/codeGen/CodeGen.lhs
+++ /dev/null
@@ -1,343 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[CodeGen]{@CodeGen@: main module of the code generator}
-
-This module says how things get going at the top level.
-
-@codeGen@ is the interface to the outside world.  The \tr{cgTop*}
-functions drive the mangling of top-level bindings.
-
-%************************************************************************
-%*									*
-\subsection[codeGen-outside-interface]{The code generator's offering to the world}
-%*									*
-%************************************************************************
-
-\begin{code}
-module CodeGen ( codeGen ) where
-
-#include "HsVersions.h"
-
--- Kludge (??) so that CgExpr is reached via at least one non-SOURCE
--- import.  Before, that wasn't the case, and CM therefore didn't 
--- bother to compile it.
-import CgExpr           ( {-NOTHING!-} )	-- DO NOT DELETE THIS IMPORT
-import CgProf
-import CgMonad
-import CgBindery	( CgIdInfo, addBindC, addBindsC, getCgIdInfo,
-			  cgIdInfoId )
-import CgClosure	( cgTopRhsClosure )
-import CgCon		( cgTopRhsCon, cgTyCon )
-import CgUtils		( cmmRegOffW, emitRODataLits, cmmNeWord )
-
-import CLabel
-import Cmm
-import CmmUtils		( zeroCLit, mkIntCLit, mkLblExpr )
-import PprCmm		( pprCmms )
-import MachOp		( wordRep, MachHint(..) )
-
-import StgSyn
-import PrelNames	( gHC_PRIM, rOOT_MAIN, mAIN, pREL_TOP_HANDLER )
-import Packages		( HomeModules )
-import DynFlags		( DynFlags(..), DynFlag(..), dopt )
-import StaticFlags	( opt_SccProfilingOn )
-
-import HscTypes		( ForeignStubs(..), TypeEnv, typeEnvTyCons )
-import CostCentre       ( CollectedCCs )
-import Id               ( Id, idName, setIdName )
-import Name		( nameSrcLoc, nameOccName, nameUnique, isInternalName, mkExternalName )
-import OccName		( mkLocalOcc )
-import TyCon            ( TyCon )
-import Module		( Module, mkModule )
-import ErrUtils		( dumpIfSet_dyn, showPass )
-import Panic		( assertPanic )
-
-#ifdef DEBUG
-import Outputable
-#endif
-\end{code}
-
-\begin{code}
-codeGen :: DynFlags
-	-> HomeModules
-	-> Module
-	-> [TyCon]
-	-> ForeignStubs
-	-> [Module]		-- directly-imported modules
-	-> CollectedCCs		-- (Local/global) cost-centres needing declaring/registering.
-	-> [(StgBinding,[(Id,[Id])])]	-- Bindings to convert, with SRTs
-	-> IO [Cmm]		-- Output
-
-codeGen dflags hmods this_mod data_tycons foreign_stubs imported_mods 
-	cost_centre_info stg_binds
-  = do	
-  { showPass dflags "CodeGen"
-  ; let way = buildTag dflags
-        main_mod = mainModIs dflags
-
--- Why?
---   ; mapM_ (\x -> seq x (return ())) data_tycons
-
-  ; code_stuff <- initC dflags hmods this_mod $ do 
-		{ cmm_binds  <- mapM (getCmm . cgTopBinding dflags hmods) stg_binds
-		; cmm_tycons <- mapM cgTyCon data_tycons
-		; cmm_init   <- getCmm (mkModuleInit dflags hmods way cost_centre_info 
-					     this_mod main_mod
-				  	     foreign_stubs imported_mods)
-		; return (cmm_binds ++ concat cmm_tycons ++ [cmm_init])
-		}
-		-- Put datatype_stuff after code_stuff, because the
-		-- datatype closure table (for enumeration types) to
-		-- (say) PrelBase_True_closure, which is defined in
-		-- code_stuff
-
-  ; dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" (pprCmms code_stuff)
-
-  ; return code_stuff }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[codegen-init]{Module initialisation code}
-%*									*
-%************************************************************************
-
-/* -----------------------------------------------------------------------------
-   Module initialisation
-
-   The module initialisation code looks like this, roughly:
-
-	FN(__stginit_Foo) {
- 	  JMP_(__stginit_Foo_1_p)
-	}
-
-	FN(__stginit_Foo_1_p) {
-	...
-	}
-
-   We have one version of the init code with a module version and the
-   'way' attached to it.  The version number helps to catch cases
-   where modules are not compiled in dependency order before being
-   linked: if a module has been compiled since any modules which depend on
-   it, then the latter modules will refer to a different version in their
-   init blocks and a link error will ensue.
-
-   The 'way' suffix helps to catch cases where modules compiled in different
-   ways are linked together (eg. profiled and non-profiled).
-
-   We provide a plain, unadorned, version of the module init code
-   which just jumps to the version with the label and way attached.  The
-   reason for this is that when using foreign exports, the caller of
-   startupHaskell() must supply the name of the init function for the "top"
-   module in the program, and we don't want to require that this name
-   has the version and way info appended to it.
-   --------------------------------------------------------------------------  */
-
-We initialise the module tree by keeping a work-stack, 
-	* pointed to by Sp
-	* that grows downward
-	* Sp points to the last occupied slot
-
-
-\begin{code}
-mkModuleInit 
-	:: DynFlags
-	-> HomeModules
-	-> String		-- the "way"
-	-> CollectedCCs         -- cost centre info
-	-> Module
-	-> Module		-- name of the Main module
-	-> ForeignStubs
-	-> [Module]
-	-> Code
-mkModuleInit dflags hmods way cost_centre_info this_mod main_mod foreign_stubs imported_mods
-  = do	{ 	
-        if opt_SccProfilingOn
-            then do { -- Allocate the static boolean that records if this
-                      -- module has been registered already
-	              emitData Data [CmmDataLabel moduleRegdLabel, 
-		                     CmmStaticLit zeroCLit]
-
-                    ; emitSimpleProc real_init_lbl $ do
-                        { ret_blk <- forkLabelledCode ret_code
-
-                        ; init_blk <- forkLabelledCode $ do
-                                        { mod_init_code; stmtC (CmmBranch ret_blk) }
-                                    
-                        ; stmtC (CmmCondBranch (cmmNeWord (CmmLit zeroCLit) mod_reg_val)
-                                    ret_blk)
-                        ; stmtC (CmmBranch init_blk)	    
-                        }
-                    }
-            else emitSimpleProc real_init_lbl ret_code
-
- 	    -- Make the "plain" procedure jump to the "real" init procedure
-	; emitSimpleProc plain_init_lbl jump_to_init
-
-	-- When compiling the module in which the 'main' function lives,
-	-- (that is, this_mod == main_mod)
-	-- we inject an extra stg_init procedure for stg_init_ZCMain, for the 
-	-- RTS to invoke.  We must consult the -main-is flag in case the
-	-- user specified a different function to Main.main
-	; whenC (this_mod == main_mod)
-		(emitSimpleProc plain_main_init_lbl jump_to_init)
-    }
-  where
-    plain_init_lbl = mkPlainModuleInitLabel hmods this_mod
-    real_init_lbl  = mkModuleInitLabel hmods this_mod way
-    plain_main_init_lbl = mkPlainModuleInitLabel hmods rOOT_MAIN
-
-    jump_to_init = stmtC (CmmJump (mkLblExpr real_init_lbl) [])
-
-    mod_reg_val = CmmLoad (mkLblExpr moduleRegdLabel) wordRep
-
-    -- Main refers to GHC.TopHandler.runIO, so make sure we call the
-    -- init function for GHC.TopHandler.
-    extra_imported_mods
-	| this_mod == main_mod = [pREL_TOP_HANDLER]
-	| otherwise	       = []
-
-    mod_init_code = do
-	{ 	-- Set mod_reg to 1 to record that we've been here
-	  stmtC (CmmStore (mkLblExpr moduleRegdLabel) (CmmLit (mkIntCLit 1)))
-
-		-- Now do local stuff
-	; initCostCentres cost_centre_info
-	; mapCs (registerModuleImport hmods way) 
-		(imported_mods++extra_imported_mods)
-	} 
-
-                    -- The return-code pops the work stack by 
-                    -- incrementing Sp, and then jumpd to the popped item
-    ret_code = stmtsC [ CmmAssign spReg (cmmRegOffW spReg 1)
-                      , CmmJump (CmmLoad (cmmRegOffW spReg (-1)) wordRep) [] ]
-
------------------------
-registerModuleImport :: HomeModules -> String -> Module -> Code
-registerModuleImport hmods way mod 
-  | mod == gHC_PRIM
-  = nopC 
-  | otherwise 	-- Push the init procedure onto the work stack
-  = stmtsC [ CmmAssign spReg (cmmRegOffW spReg (-1))
-	   , CmmStore (CmmReg spReg) (mkLblExpr (mkModuleInitLabel hmods mod way)) ]
-\end{code}
-
-
-
-Cost-centre profiling: Besides the usual stuff, we must produce
-declarations for the cost-centres defined in this module;
-
-(The local cost-centres involved in this are passed into the
-code-generator.)
-
-\begin{code}
-initCostCentres :: CollectedCCs -> Code
--- Emit the declarations, and return code to register them
-initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs)
-  | not opt_SccProfilingOn = nopC
-  | otherwise
-  = do	{ mapM_ emitCostCentreDecl  	 local_CCs
-	; mapM_ emitCostCentreStackDecl  singleton_CCSs
-	; mapM_ emitRegisterCC           local_CCs
-	; mapM_ emitRegisterCCS          singleton_CCSs
-	}
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[codegen-top-bindings]{Converting top-level STG bindings}
-%*									*
-%************************************************************************
-
-@cgTopBinding@ is only used for top-level bindings, since they need
-to be allocated statically (not in the heap) and need to be labelled.
-No unboxed bindings can happen at top level.
-
-In the code below, the static bindings are accumulated in the
-@MkCgState@, and transferred into the ``statics'' slot by @forkStatics@.
-This is so that we can write the top level processing in a compositional
-style, with the increasing static environment being plumbed as a state
-variable.
-
-\begin{code}
-cgTopBinding :: DynFlags -> HomeModules -> (StgBinding,[(Id,[Id])]) -> Code
-cgTopBinding dflags hmods (StgNonRec id rhs, srts)
-  = do	{ id' <- maybeExternaliseId dflags id
-	; mapM_ (mkSRT hmods [id']) srts
-	; (id,info) <- cgTopRhs id' rhs
-	; addBindC id info 	-- Add the *un-externalised* Id to the envt,
-				-- so we find it when we look up occurrences
-	}
-
-cgTopBinding dflags hmods (StgRec pairs, srts)
-  = do	{ let (bndrs, rhss) = unzip pairs
-	; bndrs' <- mapFCs (maybeExternaliseId dflags) bndrs
-	; let pairs' = zip bndrs' rhss
-	; mapM_ (mkSRT hmods bndrs')  srts
-	; _new_binds <- fixC (\ new_binds -> do 
-		{ addBindsC new_binds
-		; mapFCs ( \ (b,e) -> cgTopRhs b e ) pairs' })
-	; nopC }
-
-mkSRT :: HomeModules -> [Id] -> (Id,[Id]) -> Code
-mkSRT hmods these (id,[])  = nopC
-mkSRT hmods these (id,ids)
-  = do	{ ids <- mapFCs remap ids
-	; id  <- remap id
-	; emitRODataLits (mkSRTLabel (idName id)) 
-		       (map (CmmLabel . mkClosureLabel hmods . idName) ids)
-	}
-  where
-	-- Sigh, better map all the ids against the environment in 
-	-- case they've been externalised (see maybeExternaliseId below).
-    remap id = case filter (==id) these of
-		(id':_) -> returnFC id'
-		[] -> do { info <- getCgIdInfo id; return (cgIdInfoId info) }
-
--- Urgh!  I tried moving the forkStatics call from the rhss of cgTopRhs
--- to enclose the listFCs in cgTopBinding, but that tickled the
--- statics "error" call in initC.  I DON'T UNDERSTAND WHY!
-
-cgTopRhs :: Id -> StgRhs -> FCode (Id, CgIdInfo)
-	-- The Id is passed along for setting up a binding...
-	-- It's already been externalised if necessary
-
-cgTopRhs bndr (StgRhsCon cc con args)
-  = forkStatics (cgTopRhsCon bndr con args)
-
-cgTopRhs bndr (StgRhsClosure cc bi fvs upd_flag srt args body)
-  = ASSERT(null fvs)    -- There should be no free variables
-    setSRTLabel (mkSRTLabel (idName bndr)) $ 
-    forkStatics (cgTopRhsClosure bndr cc bi srt upd_flag args body)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Stuff to support splitting}
-%*									*
-%************************************************************************
-
-If we're splitting the object, we need to externalise all the top-level names
-(and then make sure we only use the externalised one in any C label we use
-which refers to this name).
-
-\begin{code}
-maybeExternaliseId :: DynFlags -> Id -> FCode Id
-maybeExternaliseId dflags id
-  | dopt Opt_SplitObjs dflags, 	-- Externalise the name for -split-objs
-    isInternalName name = do { mod <- moduleName
-			     ; returnFC (setIdName id (externalise mod)) }
-  | otherwise		= returnFC id
-  where
-    externalise mod = mkExternalName uniq mod new_occ Nothing loc
-    name    = idName id
-    uniq    = nameUnique name
-    new_occ = mkLocalOcc uniq (nameOccName name)
-    loc     = nameSrcLoc name
-	-- We want to conjure up a name that can't clash with any
-	-- existing name.  So we generate
-	--	Mod_$L243foo
-	-- where 243 is the unique.
-\end{code}
diff --git a/ghc/compiler/codeGen/SMRep.lhs b/ghc/compiler/codeGen/SMRep.lhs
deleted file mode 100644
index c807703b13..0000000000
--- a/ghc/compiler/codeGen/SMRep.lhs
+++ /dev/null
@@ -1,361 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[SMRep]{Storage manager representations of closure}
-
-This is here, rather than in ClosureInfo, just to keep nhc happy.
-Other modules should access this info through ClosureInfo.
-
-\begin{code}
-module SMRep (
-	-- Words and bytes
-	StgWord, StgHalfWord, 
-	hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
-	WordOff, ByteOff,
-
-	-- Argument/return representations
-	CgRep(..), nonVoidArg,
-	argMachRep, primRepToCgRep, primRepHint,
-	isFollowableArg, isVoidArg, 
-	isFloatingArg, isNonPtrArg, is64BitArg,
-	separateByPtrFollowness,
-	cgRepSizeW, cgRepSizeB,
-	retAddrSizeW,
-
-	typeCgRep, idCgRep, tyConCgRep, typeHint,
-
-	-- Closure repesentation
-	SMRep(..), ClosureType(..),
-	isStaticRep,
-	fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize,
-	profHdrSize, thunkHdrSize,
-	tablesNextToCode,
-	smRepClosureType, smRepClosureTypeInt,
-
-	rET_SMALL, rET_VEC_SMALL, rET_BIG, rET_VEC_BIG
-    ) where
-
-#include "HsVersions.h"
-#include "../includes/MachDeps.h"
-
-import Id		( Id, idType )
-import Type		( Type, typePrimRep, PrimRep(..) )
-import TyCon		( TyCon, tyConPrimRep )
-import MachOp--		( MachRep(..), MachHint(..), wordRep )
-import StaticFlags	( opt_SccProfilingOn, opt_GranMacros,
-			  opt_Unregisterised )
-import Constants
-import Outputable
-
-import DATA_WORD
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Words and bytes
-%*									*
-%************************************************************************
-
-\begin{code}
-type WordOff = Int	-- Word offset, or word count
-type ByteOff = Int	-- Byte offset, or byte count
-\end{code}
-
-StgWord is a type representing an StgWord on the target platform.
-
-\begin{code}
-#if SIZEOF_HSWORD == 4
-type StgWord     = Word32
-type StgHalfWord = Word16
-hALF_WORD_SIZE = 2 :: ByteOff
-hALF_WORD_SIZE_IN_BITS = 16 :: Int
-#elif SIZEOF_HSWORD == 8
-type StgWord     = Word64
-type StgHalfWord = Word32
-hALF_WORD_SIZE = 4 :: ByteOff
-hALF_WORD_SIZE_IN_BITS = 32 :: Int
-#else
-#error unknown SIZEOF_HSWORD
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-			CgRep
-%*									*
-%************************************************************************
-
-An CgRep is an abstraction of a Type which tells the code generator
-all it needs to know about the calling convention for arguments (and
-results) of that type.  In particular, the ArgReps of a function's
-arguments are used to decide which of the RTS's generic apply
-functions to call when applying an unknown function.
-
-It contains more information than the back-end data type MachRep,
-so one can easily convert from CgRep -> MachRep.  (Except that
-there's no MachRep for a VoidRep.)
-
-It distinguishes 
-	pointers from non-pointers (we sort the pointers together
-	when building closures)
-
-	void from other types: a void argument is different from no argument
-
-All 64-bit types map to the same CgRep, because they're passed in the
-same register, but a PtrArg is still different from an NonPtrArg
-because the function's entry convention has to take into account the
-pointer-hood of arguments for the purposes of describing the stack on
-entry to the garbage collector.
-
-\begin{code}
-data CgRep 
-  = VoidArg 	-- Void
-  | PtrArg 	-- Word-sized Ptr
-  | NonPtrArg 	-- Word-sized non-pointer
-  | LongArg	-- 64-bit non-pointer
-  | FloatArg 	-- 32-bit float
-  | DoubleArg 	-- 64-bit float
-  deriving Eq
-
-instance Outputable CgRep where
-    ppr VoidArg   = ptext SLIT("V_")
-    ppr PtrArg    = ptext SLIT("P_")
-    ppr NonPtrArg = ptext SLIT("I_")
-    ppr LongArg   = ptext SLIT("L_")
-    ppr FloatArg  = ptext SLIT("F_")
-    ppr DoubleArg = ptext SLIT("D_")
-
-argMachRep :: CgRep -> MachRep
-argMachRep PtrArg    = wordRep
-argMachRep NonPtrArg = wordRep
-argMachRep LongArg   = I64
-argMachRep FloatArg  = F32
-argMachRep DoubleArg = F64
-argMachRep VoidArg   = panic "argMachRep:VoidRep"
-
-primRepToCgRep :: PrimRep -> CgRep
-primRepToCgRep VoidRep    = VoidArg
-primRepToCgRep PtrRep     = PtrArg
-primRepToCgRep IntRep	  = NonPtrArg
-primRepToCgRep WordRep	  = NonPtrArg
-primRepToCgRep Int64Rep   = LongArg
-primRepToCgRep Word64Rep  = LongArg
-primRepToCgRep AddrRep    = NonPtrArg
-primRepToCgRep FloatRep   = FloatArg
-primRepToCgRep DoubleRep  = DoubleArg
-
-primRepHint :: PrimRep -> MachHint
-primRepHint VoidRep	= panic "primRepHint:VoidRep"
-primRepHint PtrRep	= PtrHint
-primRepHint IntRep	= SignedHint
-primRepHint WordRep	= NoHint
-primRepHint Int64Rep	= SignedHint
-primRepHint Word64Rep	= NoHint
-primRepHint AddrRep     = PtrHint -- NB! PtrHint, but NonPtrArg
-primRepHint FloatRep	= FloatHint
-primRepHint DoubleRep	= FloatHint
-
-idCgRep :: Id -> CgRep
-idCgRep = typeCgRep . idType
-
-tyConCgRep :: TyCon -> CgRep
-tyConCgRep = primRepToCgRep . tyConPrimRep
-
-typeCgRep :: Type -> CgRep
-typeCgRep = primRepToCgRep . typePrimRep
-
-typeHint :: Type -> MachHint
-typeHint = primRepHint . typePrimRep
-\end{code}
-
-Whether or not the thing is a pointer that the garbage-collector
-should follow. Or, to put it another (less confusing) way, whether
-the object in question is a heap object. 
-
-Depending on the outcome, this predicate determines what stack
-the pointer/object possibly will have to be saved onto, and the
-computation of GC liveness info.
-
-\begin{code}
-isFollowableArg :: CgRep -> Bool  -- True <=> points to a heap object
-isFollowableArg PtrArg  = True
-isFollowableArg other = False
-
-isVoidArg :: CgRep -> Bool
-isVoidArg VoidArg = True
-isVoidArg other   = False
-
-nonVoidArg :: CgRep -> Bool
-nonVoidArg VoidArg = False
-nonVoidArg other   = True
-
--- isFloatingArg is used to distinguish @Double@ and @Float@ which
--- cause inadvertent numeric conversions if you aren't jolly careful.
--- See codeGen/CgCon:cgTopRhsCon.
-
-isFloatingArg :: CgRep -> Bool
-isFloatingArg DoubleArg = True
-isFloatingArg FloatArg  = True
-isFloatingArg _         = False
-
-isNonPtrArg :: CgRep -> Bool
--- Identify anything which is one word large and not a pointer.
-isNonPtrArg NonPtrArg = True
-isNonPtrArg other     = False
-
-is64BitArg :: CgRep -> Bool
-is64BitArg LongArg = True
-is64BitArg _       = False
-\end{code}
-
-\begin{code}
-separateByPtrFollowness :: [(CgRep,a)] -> ([(CgRep,a)], [(CgRep,a)])
--- Returns (ptrs, non-ptrs)
-separateByPtrFollowness things
-  = sep_things things [] []
-    -- accumulating params for follow-able and don't-follow things...
-  where
-    sep_things []    	       bs us = (reverse bs, reverse us)
-    sep_things ((PtrArg,a):ts) bs us = sep_things ts ((PtrArg,a):bs) us
-    sep_things (t         :ts) bs us = sep_things ts bs		     (t:us)
-\end{code}
-
-\begin{code}
-cgRepSizeB :: CgRep -> ByteOff
-cgRepSizeB DoubleArg = dOUBLE_SIZE
-cgRepSizeB LongArg   = wORD64_SIZE
-cgRepSizeB VoidArg   = 0
-cgRepSizeB _         = wORD_SIZE
-
-cgRepSizeW :: CgRep -> ByteOff
-cgRepSizeW DoubleArg = dOUBLE_SIZE `quot` wORD_SIZE
-cgRepSizeW LongArg   = wORD64_SIZE `quot` wORD_SIZE
-cgRepSizeW VoidArg   = 0
-cgRepSizeW _         = 1
-
-retAddrSizeW :: WordOff
-retAddrSizeW = 1	-- One word
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection[SMRep-datatype]{@SMRep@---storage manager representation}
-%*									*
-%************************************************************************
-
-\begin{code}
-data SMRep
-     -- static closure have an extra static link field at the end.
-  = GenericRep		-- GC routines consult sizes in info tbl
-	Bool		-- True <=> This is a static closure.  Affects how 
-			-- 	    we garbage-collect it
-	!Int		--  # ptr words
-	!Int		--  # non-ptr words
-	ClosureType	-- closure type
-
-  | BlackHoleRep
-
-data ClosureType	-- Corresponds 1-1 with the varieties of closures
-			-- implemented by the RTS.  Compare with ghc/includes/ClosureTypes.h
-    = Constr
-    | ConstrNoCaf
-    | Fun
-    | Thunk
-    | ThunkSelector
-\end{code}
-
-Size of a closure header.
-
-\begin{code}
-fixedHdrSize :: WordOff
-fixedHdrSize = sTD_HDR_SIZE + profHdrSize + granHdrSize
-
-profHdrSize  :: WordOff
-profHdrSize  | opt_SccProfilingOn   = pROF_HDR_SIZE
-	     | otherwise	    = 0
-
-granHdrSize  :: WordOff
-granHdrSize  | opt_GranMacros	    = gRAN_HDR_SIZE
-	     | otherwise	    = 0
-
-arrWordsHdrSize   :: ByteOff
-arrWordsHdrSize   = fixedHdrSize*wORD_SIZE + sIZEOF_StgArrWords_NoHdr
-
-arrPtrsHdrSize    :: ByteOff
-arrPtrsHdrSize    = fixedHdrSize*wORD_SIZE + sIZEOF_StgMutArrPtrs_NoHdr
-
--- Thunks have an extra header word on SMP, so the update doesn't 
--- splat the payload.
-thunkHdrSize :: WordOff
-thunkHdrSize = fixedHdrSize + smp_hdr
-	where smp_hdr = sIZEOF_StgSMPThunkHeader `quot` wORD_SIZE
-\end{code}
-
-\begin{code}
--- IA64 mangler doesn't place tables next to code
-tablesNextToCode :: Bool
-#if defined(ia64_TARGET_ARCH) || defined(powerpc64_TARGET_ARCH)
-tablesNextToCode = False
-#else
-tablesNextToCode = not opt_Unregisterised
-#endif
-\end{code}
-
-\begin{code}
-isStaticRep :: SMRep -> Bool
-isStaticRep (GenericRep is_static _ _ _) = is_static
-isStaticRep BlackHoleRep	         = False
-\end{code}
-
-\begin{code}
-#include "../includes/ClosureTypes.h"
--- Defines CONSTR, CONSTR_1_0 etc
-
-
-smRepClosureType :: SMRep -> ClosureType
-smRepClosureType (GenericRep _ _ _ ty) = ty
-smRepClosureType BlackHoleRep	       = panic "smRepClosureType: black hole"
-
-smRepClosureTypeInt :: SMRep -> Int
-smRepClosureTypeInt (GenericRep False 1 0 Constr) = CONSTR_1_0
-smRepClosureTypeInt (GenericRep False 0 1 Constr) = CONSTR_0_1
-smRepClosureTypeInt (GenericRep False 2 0 Constr) = CONSTR_2_0
-smRepClosureTypeInt (GenericRep False 1 1 Constr) = CONSTR_1_1
-smRepClosureTypeInt (GenericRep False 0 2 Constr) = CONSTR_0_2
-smRepClosureTypeInt (GenericRep False _ _ Constr) = CONSTR
-
-smRepClosureTypeInt (GenericRep False 1 0 Fun) = FUN_1_0
-smRepClosureTypeInt (GenericRep False 0 1 Fun) = FUN_0_1
-smRepClosureTypeInt (GenericRep False 2 0 Fun) = FUN_2_0
-smRepClosureTypeInt (GenericRep False 1 1 Fun) = FUN_1_1
-smRepClosureTypeInt (GenericRep False 0 2 Fun) = FUN_0_2
-smRepClosureTypeInt (GenericRep False _ _ Fun) = FUN
-
-smRepClosureTypeInt (GenericRep False 1 0 Thunk) = THUNK_1_0
-smRepClosureTypeInt (GenericRep False 0 1 Thunk) = THUNK_0_1
-smRepClosureTypeInt (GenericRep False 2 0 Thunk) = THUNK_2_0
-smRepClosureTypeInt (GenericRep False 1 1 Thunk) = THUNK_1_1
-smRepClosureTypeInt (GenericRep False 0 2 Thunk) = THUNK_0_2
-smRepClosureTypeInt (GenericRep False _ _ Thunk) = THUNK
-
-smRepClosureTypeInt (GenericRep False _ _ ThunkSelector) =  THUNK_SELECTOR
-
-smRepClosureTypeInt (GenericRep True _ _ Constr)      = CONSTR_STATIC
-smRepClosureTypeInt (GenericRep True _ _ ConstrNoCaf) = CONSTR_NOCAF_STATIC
-smRepClosureTypeInt (GenericRep True _ _ Fun)         = FUN_STATIC
-smRepClosureTypeInt (GenericRep True _ _ Thunk)       = THUNK_STATIC
-
-smRepClosureTypeInt BlackHoleRep = BLACKHOLE
-
-smRepClosureTypeInt rep = panic "smRepClosuretypeint"
-
-
--- We export these ones
-rET_SMALL     = (RET_SMALL     :: Int)
-rET_VEC_SMALL = (RET_VEC_SMALL :: Int)
-rET_BIG       = (RET_BIG       :: Int)
-rET_VEC_BIG   = (RET_VEC_BIG   :: Int)
-\end{code}
-
diff --git a/ghc/compiler/coreSyn/CoreFVs.lhs b/ghc/compiler/coreSyn/CoreFVs.lhs
deleted file mode 100644
index fb6017eabf..0000000000
--- a/ghc/compiler/coreSyn/CoreFVs.lhs
+++ /dev/null
@@ -1,415 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-Taken quite directly from the Peyton Jones/Lester paper.
-
-\begin{code}
-module CoreFVs (
-	exprFreeVars,	-- CoreExpr -> VarSet	-- Find all locally-defined free Ids or tyvars
-	exprsFreeVars,	-- [CoreExpr] -> VarSet
-
-	exprSomeFreeVars, exprsSomeFreeVars,
-	exprFreeNames, exprsFreeNames,
-
-	idRuleVars, idFreeVars, idFreeTyVars, 
-	ruleRhsFreeVars, rulesRhsFreeVars,
-	ruleLhsFreeNames, ruleLhsFreeIds, 
-
-	CoreExprWithFVs,	-- = AnnExpr Id VarSet
-	CoreBindWithFVs,	-- = AnnBind Id VarSet
-	freeVars,		-- CoreExpr -> CoreExprWithFVs
-	freeVarsOf		-- CoreExprWithFVs -> IdSet
-    ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-import Id		( Id, idType, idSpecialisation, isLocalId )
-import IdInfo		( specInfoFreeVars )
-import NameSet
-import UniqFM		( delFromUFM )
-import Name		( isExternalName )
-import VarSet
-import Var		( Var, isId, isLocalVar, varName )
-import Type		( tyVarsOfType )
-import TcType		( tyClsNamesOfType )
-import Util		( mapAndUnzip )
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-\section{Finding the free variables of an expression}
-%*									*
-%************************************************************************
-
-This function simply finds the free variables of an expression.
-So far as type variables are concerned, it only finds tyvars that are
-
-	* free in type arguments, 
-	* free in the type of a binder,
-
-but not those that are free in the type of variable occurrence.
-
-\begin{code}
-exprFreeVars :: CoreExpr -> VarSet	-- Find all locally-defined free Ids or tyvars
-exprFreeVars = exprSomeFreeVars isLocalVar
-
-exprsFreeVars :: [CoreExpr] -> VarSet
-exprsFreeVars = foldr (unionVarSet . exprFreeVars) emptyVarSet
-
-exprSomeFreeVars :: InterestingVarFun 	-- Says which Vars are interesting
-		 -> CoreExpr
-		 -> VarSet
-exprSomeFreeVars fv_cand e = expr_fvs e fv_cand emptyVarSet
-
-exprsSomeFreeVars :: InterestingVarFun 	-- Says which Vars are interesting
-		  -> [CoreExpr]
-		  -> VarSet
-exprsSomeFreeVars fv_cand = foldr (unionVarSet . exprSomeFreeVars fv_cand) emptyVarSet
-
-type InterestingVarFun = Var -> Bool	-- True <=> interesting
-\end{code}
-
-
-\begin{code}
-type FV = InterestingVarFun 
-	-> VarSet		-- In scope
-	-> VarSet		-- Free vars
-
-union :: FV -> FV -> FV
-union fv1 fv2 fv_cand in_scope = fv1 fv_cand in_scope `unionVarSet` fv2 fv_cand in_scope
-
-noVars :: FV
-noVars fv_cand in_scope = emptyVarSet
-
---	Comment about obselete code
--- We used to gather the free variables the RULES at a variable occurrence
--- with the following cryptic comment:
---     "At a variable occurrence, add in any free variables of its rule rhss
---     Curiously, we gather the Id's free *type* variables from its binding
---     site, but its free *rule-rhs* variables from its usage sites.  This
---     is a little weird.  The reason is that the former is more efficient,
---     but the latter is more fine grained, and a makes a difference when
---     a variable mentions itself one of its own rule RHSs"
--- Not only is this "weird", but it's also pretty bad because it can make
--- a function seem more recursive than it is.  Suppose
---	f  = ...g...
---	g  = ...
---         RULE g x = ...f...
--- Then f is not mentioned in its own RHS, and needn't be a loop breaker
--- (though g may be).  But if we collect the rule fvs from g's occurrence,
--- it looks as if f mentions itself.  (This bites in the eftInt/eftIntFB
--- code in GHC.Enum.)
--- 
--- Anyway, it seems plain wrong.  The RULE is like an extra RHS for the
--- function, so its free variables belong at the definition site.
---
--- Deleted code looked like
---     foldVarSet add_rule_var var_itself_set (idRuleVars var)
---     add_rule_var var set | keep_it fv_cand in_scope var = extendVarSet set var
---			    | otherwise			   = set
--- 	SLPJ Feb06
-
-oneVar :: Id -> FV
-oneVar var fv_cand in_scope
-  = ASSERT( isId var ) 
-    if keep_it fv_cand in_scope var 
-    then unitVarSet var
-    else emptyVarSet
-
-someVars :: VarSet -> FV
-someVars vars fv_cand in_scope
-  = filterVarSet (keep_it fv_cand in_scope) vars
-
-keep_it fv_cand in_scope var
-  | var `elemVarSet` in_scope = False
-  | fv_cand var		      = True
-  | otherwise		      = False
-
-
-addBndr :: CoreBndr -> FV -> FV
-addBndr bndr fv fv_cand in_scope
-  | isId bndr = inside_fvs `unionVarSet` someVars (idFreeTyVars bndr) fv_cand in_scope
-  | otherwise = inside_fvs
-  where
-    inside_fvs = fv fv_cand (in_scope `extendVarSet` bndr) 
-
-addBndrs :: [CoreBndr] -> FV -> FV
-addBndrs bndrs fv = foldr addBndr fv bndrs
-\end{code}
-
-
-\begin{code}
-expr_fvs :: CoreExpr -> FV
-
-expr_fvs (Type ty) 	 = someVars (tyVarsOfType ty)
-expr_fvs (Var var) 	 = oneVar var
-expr_fvs (Lit lit)	 = noVars
-expr_fvs (Note _ expr)   = expr_fvs expr
-expr_fvs (App fun arg)   = expr_fvs fun `union` expr_fvs arg
-expr_fvs (Lam bndr body) = addBndr bndr (expr_fvs body)
-
-expr_fvs (Case scrut bndr ty alts)
-  = expr_fvs scrut `union` someVars (tyVarsOfType ty) `union` addBndr bndr  
-      (foldr (union . alt_fvs) noVars alts)
-  where
-    alt_fvs (con, bndrs, rhs) = addBndrs bndrs (expr_fvs rhs)
-
-expr_fvs (Let (NonRec bndr rhs) body)
-  = rhs_fvs (bndr, rhs) `union` addBndr bndr (expr_fvs body)
-
-expr_fvs (Let (Rec pairs) body)
-  = addBndrs (map fst pairs) 
-	     (foldr (union . rhs_fvs) (expr_fvs body) pairs)
-
----------
-rhs_fvs (bndr, rhs) = expr_fvs rhs `union` someVars (idRuleVars bndr)
-	-- Treat any RULES as extra RHSs of the binding
-
----------
-exprs_fvs exprs = foldr (union . expr_fvs) noVars exprs
-\end{code}
-
-
-%************************************************************************
-%*									*
-\section{Free names}
-%*									*
-%************************************************************************
-
-exprFreeNames finds the free *external* *names* of an expression, notably
-including the names of type constructors (which of course do not show
-up in exprFreeVars).  Similarly ruleLhsFreeNames.  The latter is used
-when deciding whether a rule is an orphan.  In particular, suppose that
-T is defined in this module; we want to avoid declaring that a rule like
-	fromIntegral T = fromIntegral_T
-is an orphan.  Of course it isn't, an declaring it an orphan would
-make the whole module an orphan module, which is bad.
-
-There's no need to delete local binders, because they will all
-be *internal* names.
-
-\begin{code}
-ruleLhsFreeNames :: CoreRule -> NameSet
-ruleLhsFreeNames (BuiltinRule { ru_fn = fn }) = unitNameSet fn
-ruleLhsFreeNames (Rule { ru_fn = fn, ru_bndrs = tpl_vars, ru_args = tpl_args })
-  = addOneToNameSet (exprsFreeNames tpl_args) fn
-
-exprFreeNames :: CoreExpr -> NameSet
--- Find the free *external* names of an expression
-exprFreeNames e
-  = go e
-  where
-    go (Var v) 
-      | isExternalName n    = unitNameSet n
-      | otherwise	    = emptyNameSet
-      where n = varName v
-    go (Lit _) 	   	    = emptyNameSet
-    go (Type ty)   	    = tyClsNamesOfType ty	-- Don't need free tyvars
-    go (App e1 e2) 	    = go e1 `unionNameSets` go e2
-    go (Lam v e)   	    = go e `delFromNameSet` varName v
-    go (Note n e)  	    = go e   
-    go (Let (NonRec b r) e) = go e `unionNameSets` go r
-    go (Let (Rec prs) e)    = exprsFreeNames (map snd prs) `unionNameSets` go e
-    go (Case e b ty as)     = go e `unionNameSets` tyClsNamesOfType ty 
-                              `unionNameSets` unionManyNameSets (map go_alt as)
-
-    go_alt (_,_,r) = go r
-
-exprsFreeNames es = foldr (unionNameSets . exprFreeNames) emptyNameSet es
-\end{code}
-
-%************************************************************************
-%*									*
-\section[freevars-everywhere]{Attaching free variables to every sub-expression}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-ruleRhsFreeVars :: CoreRule -> VarSet
-ruleRhsFreeVars (BuiltinRule {}) = noFVs
-ruleRhsFreeVars (Rule { ru_fn = fn, ru_bndrs = bndrs, ru_rhs = rhs })
-  = delFromUFM fvs fn
-	-- Hack alert!
-	-- Don't include the Id in its own rhs free-var set.
-	-- Otherwise the occurrence analyser makes bindings recursive
-	-- that shoudn't be.  E.g.
-	--	RULE:  f (f x y) z  ==>  f x (f y z)
-  where
-    fvs = addBndrs bndrs (expr_fvs rhs) isLocalVar emptyVarSet
-
-rulesRhsFreeVars :: [CoreRule] -> VarSet
-rulesRhsFreeVars rules
-  = foldr (unionVarSet . ruleRhsFreeVars) emptyVarSet rules
-
-ruleLhsFreeIds :: CoreRule -> VarSet
--- This finds all locally-defined free Ids on the LHS of the rule
-ruleLhsFreeIds (BuiltinRule {}) = noFVs
-ruleLhsFreeIds (Rule { ru_bndrs = bndrs, ru_args = args })
-  = addBndrs bndrs (exprs_fvs args) isLocalId emptyVarSet
-\end{code}
-
-
-%************************************************************************
-%*									*
-\section[freevars-everywhere]{Attaching free variables to every sub-expression}
-%*									*
-%************************************************************************
-
-The free variable pass annotates every node in the expression with its
-NON-GLOBAL free variables and type variables.
-
-\begin{code}
-type CoreBindWithFVs = AnnBind Id VarSet
-type CoreExprWithFVs = AnnExpr Id VarSet
-	-- Every node annotated with its free variables,
-	-- both Ids and TyVars
-
-freeVarsOf :: CoreExprWithFVs -> IdSet
-freeVarsOf (free_vars, _) = free_vars
-
-noFVs    = emptyVarSet
-aFreeVar = unitVarSet
-unionFVs = unionVarSet
-
-delBindersFV :: [Var] -> VarSet -> VarSet
-delBindersFV bs fvs = foldr delBinderFV fvs bs
-
-delBinderFV :: Var -> VarSet -> VarSet
--- This way round, so we can do it multiple times using foldr
-
--- (b `delBinderFV` s) removes the binder b from the free variable set s,
--- but *adds* to s
---	(a) the free variables of b's type
---	(b) the idSpecVars of b
---
--- This is really important for some lambdas:
--- 	In (\x::a -> x) the only mention of "a" is in the binder.
---
--- Also in
---	let x::a = b in ...
--- we should really note that "a" is free in this expression.
--- It'll be pinned inside the /\a by the binding for b, but
--- it seems cleaner to make sure that a is in the free-var set 
--- when it is mentioned.
---
--- This also shows up in recursive bindings.  Consider:
---	/\a -> letrec x::a = x in E
--- Now, there are no explicit free type variables in the RHS of x,
--- but nevertheless "a" is free in its definition.  So we add in
--- the free tyvars of the types of the binders, and include these in the
--- free vars of the group, attached to the top level of each RHS.
---
--- This actually happened in the defn of errorIO in IOBase.lhs:
---	errorIO (ST io) = case (errorIO# io) of
---	    		    _ -> bottom
---			  where
---			    bottom = bottom -- Never evaluated
-
-delBinderFV b s | isId b    = (s `delVarSet` b) `unionFVs` idFreeVars b
-	        | otherwise = s `delVarSet` b
-
-idFreeVars :: Id -> VarSet
-idFreeVars id = ASSERT( isId id) idRuleVars id `unionVarSet` idFreeTyVars id
-
-idFreeTyVars :: Id -> TyVarSet
--- Only local Ids conjured up locally, can have free type variables.
--- (During type checking top-level Ids can have free tyvars)
-idFreeTyVars id = tyVarsOfType (idType id)
---  | isLocalId id = tyVarsOfType (idType id)
---  | otherwise    = emptyVarSet
-
-idRuleVars ::Id -> VarSet
-idRuleVars id = ASSERT( isId id) specInfoFreeVars (idSpecialisation id)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Free variables (and types)}
-%*									*
-%************************************************************************
-
-\begin{code}
-freeVars :: CoreExpr -> CoreExprWithFVs
-
-freeVars (Var v)
-  = (fvs, AnnVar v)
-  where
-	-- ToDo: insert motivating example for why we *need*
-	-- to include the idSpecVars in the FV list.
-	--	Actually [June 98] I don't think it's necessary
-	-- fvs = fvs_v `unionVarSet` idSpecVars v
-
-    fvs | isLocalVar v = aFreeVar v
-	| otherwise    = noFVs
-
-freeVars (Lit lit) = (noFVs, AnnLit lit)
-freeVars (Lam b body)
-  = (b `delBinderFV` freeVarsOf body', AnnLam b body')
-  where
-    body' = freeVars body
-
-freeVars (App fun arg)
-  = (freeVarsOf fun2 `unionFVs` freeVarsOf arg2, AnnApp fun2 arg2)
-  where
-    fun2 = freeVars fun
-    arg2 = freeVars arg
-
-freeVars (Case scrut bndr ty alts)
--- gaw 2004
-  = ((bndr `delBinderFV` alts_fvs) `unionFVs` freeVarsOf scrut2 `unionFVs` tyVarsOfType ty,
-     AnnCase scrut2 bndr ty alts2)
-  where
-    scrut2 = freeVars scrut
-
-    (alts_fvs_s, alts2) = mapAndUnzip fv_alt alts
-    alts_fvs 		= foldr1 unionFVs alts_fvs_s
-
-    fv_alt (con,args,rhs) = (delBindersFV args (freeVarsOf rhs2),
-			     (con, args, rhs2))
-		    	  where
-			     rhs2 = freeVars rhs
-
-freeVars (Let (NonRec binder rhs) body)
-  = (freeVarsOf rhs2 `unionFVs` body_fvs,
-     AnnLet (AnnNonRec binder rhs2) body2)
-  where
-    rhs2     = freeVars rhs
-    body2    = freeVars body
-    body_fvs = binder `delBinderFV` freeVarsOf body2
-
-freeVars (Let (Rec binds) body)
-  = (foldl delVarSet group_fvs binders,
-	-- The "delBinderFV" part may have added one of the binders
-	-- via the idSpecVars part, so we must delete it again
-     AnnLet (AnnRec (binders `zip` rhss2)) body2)
-  where
-    (binders, rhss) = unzip binds
-
-    rhss2     = map freeVars rhss
-    all_fvs   = foldr (unionFVs . fst) body_fvs rhss2
-    group_fvs = delBindersFV binders all_fvs
-
-    body2     = freeVars body
-    body_fvs  = freeVarsOf body2
-
-freeVars (Note (Coerce to_ty from_ty) expr)
-  = (freeVarsOf expr2 `unionFVs` tfvs1 `unionFVs` tfvs2,
-     AnnNote (Coerce to_ty from_ty) expr2)
-  where
-    expr2  = freeVars expr
-    tfvs1  = tyVarsOfType from_ty
-    tfvs2  = tyVarsOfType to_ty
-
-freeVars (Note other_note expr)
-  = (freeVarsOf expr2, AnnNote other_note expr2)
-  where
-    expr2 = freeVars expr
-
-freeVars (Type ty) = (tyVarsOfType ty, AnnType ty)
-\end{code}
-
diff --git a/ghc/compiler/coreSyn/CoreLint.lhs b/ghc/compiler/coreSyn/CoreLint.lhs
deleted file mode 100644
index dda8290bf4..0000000000
--- a/ghc/compiler/coreSyn/CoreLint.lhs
+++ /dev/null
@@ -1,785 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[CoreLint]{A ``lint'' pass to check for Core correctness}
-
-\begin{code}
-module CoreLint (
-	lintCoreBindings,
-	lintUnfolding, 
-	showPass, endPass
-    ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-import CoreFVs		( idFreeVars )
-import CoreUtils	( findDefault, exprOkForSpeculation, coreBindsSize )
-import Unify      	( coreRefineTys )
-import Bag
-import Literal		( literalType )
-import DataCon		( dataConRepType, isVanillaDataCon, dataConTyCon, dataConWorkId )
-import TysWiredIn	( tupleCon )
-import Var		( Var, Id, TyVar, idType, tyVarKind, mustHaveLocalBinding )
-import VarSet
-import Name		( getSrcLoc )
-import PprCore
-import ErrUtils		( dumpIfSet_core, ghcExit, Message, showPass,
-			  mkLocMessage, debugTraceMsg )
-import SrcLoc		( SrcLoc, noSrcLoc, mkSrcSpan )
-import Type		( Type, tyVarsOfType, coreEqType,
-			  splitFunTy_maybe, mkTyVarTys,
-			  splitForAllTy_maybe, splitTyConApp_maybe,
-			  isUnLiftedType, typeKind, mkForAllTy, mkFunTy,
-			  isUnboxedTupleType, isSubKind,
-			  substTyWith, emptyTvSubst, extendTvInScope, 
-			  TvSubst, TvSubstEnv, mkTvSubst, setTvSubstEnv, substTy,
-			  extendTvSubst, composeTvSubst, isInScope,
-			  getTvSubstEnv, getTvInScope )
-import TyCon		( isPrimTyCon )
-import BasicTypes	( RecFlag(..), Boxity(..), isNonRec )
-import StaticFlags	( opt_PprStyle_Debug )
-import DynFlags		( DynFlags, DynFlag(..), dopt )
-import Outputable
-
-#ifdef DEBUG
-import Util             ( notNull )
-#endif
-
-import Maybe
-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{End pass}
-%*									*
-%************************************************************************
-
-@showPass@ and @endPass@ don't really belong here, but it makes a convenient
-place for them.  They print out stuff before and after core passes,
-and do Core Lint when necessary.
-
-\begin{code}
-endPass :: DynFlags -> String -> DynFlag -> [CoreBind] -> IO [CoreBind]
-endPass dflags pass_name dump_flag binds
-  = do 
-	-- Report result size if required
-	-- This has the side effect of forcing the intermediate to be evaluated
-	debugTraceMsg dflags 2 $
-		(text "    Result size =" <+> int (coreBindsSize binds))
-
-	-- Report verbosely, if required
-	dumpIfSet_core dflags dump_flag pass_name (pprCoreBindings binds)
-
-	-- Type check
-	lintCoreBindings dflags pass_name binds
-
-	return binds
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[lintCoreBindings]{@lintCoreBindings@: Top-level interface}
-%*									*
-%************************************************************************
-
-Checks that a set of core bindings is well-formed.  The PprStyle and String
-just control what we print in the event of an error.  The Bool value
-indicates whether we have done any specialisation yet (in which case we do
-some extra checks).
-
-We check for
-	(a) type errors
-	(b) Out-of-scope type variables
-	(c) Out-of-scope local variables
-	(d) Ill-kinded types
-
-If we have done specialisation the we check that there are
-	(a) No top-level bindings of primitive (unboxed type)
-
-Outstanding issues:
-
-    --
-    -- Things are *not* OK if:
-    --
-    --  * Unsaturated type app before specialisation has been done;
-    --
-    --  * Oversaturated type app after specialisation (eta reduction
-    --   may well be happening...);
-
-\begin{code}
-lintCoreBindings :: DynFlags -> String -> [CoreBind] -> IO ()
-
-lintCoreBindings dflags whoDunnit binds
-  | not (dopt Opt_DoCoreLinting dflags)
-  = return ()
-
-lintCoreBindings dflags whoDunnit binds
-  = case (initL (lint_binds binds)) of
-      Nothing       -> showPass dflags ("Core Linted result of " ++ whoDunnit)
-      Just bad_news -> printDump (display bad_news)	>>
-		       ghcExit dflags 1
-  where
-	-- Put all the top-level binders in scope at the start
-	-- This is because transformation rules can bring something
-	-- into use 'unexpectedly'
-    lint_binds binds = addInScopeVars (bindersOfBinds binds) $
-		       mapM lint_bind binds 
-
-    lint_bind (Rec prs)		= mapM_ (lintSingleBinding Recursive) prs
-    lint_bind (NonRec bndr rhs) = lintSingleBinding NonRecursive (bndr,rhs)
-
-    display bad_news
-      = vcat [  text ("*** Core Lint Errors: in result of " ++ whoDunnit ++ " ***"),
-		bad_news,
-		ptext SLIT("*** Offending Program ***"),
-		pprCoreBindings binds,
-		ptext SLIT("*** End of Offense ***")
-	]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[lintUnfolding]{lintUnfolding}
-%*									*
-%************************************************************************
-
-We use this to check all unfoldings that come in from interfaces
-(it is very painful to catch errors otherwise):
-
-\begin{code}
-lintUnfolding :: SrcLoc
-	      -> [Var]		-- Treat these as in scope
-	      -> CoreExpr
-	      -> Maybe Message	-- Nothing => OK
-
-lintUnfolding locn vars expr
-  = initL (addLoc (ImportedUnfolding locn) $
-	   addInScopeVars vars	           $
-	   lintCoreExpr expr)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[lintCoreBinding]{lintCoreBinding}
-%*									*
-%************************************************************************
-
-Check a core binding, returning the list of variables bound.
-
-\begin{code}
-lintSingleBinding rec_flag (binder,rhs)
-  = addLoc (RhsOf binder) $
-         -- Check the rhs 
-    do { ty <- lintCoreExpr rhs	
-       ; lintBinder binder -- Check match to RHS type
-       ; binder_ty <- applySubst binder_ty
-       ; checkTys binder_ty ty (mkRhsMsg binder ty)
-        -- Check (not isUnLiftedType) (also checks for bogus unboxed tuples)
-       ; checkL (not (isUnLiftedType binder_ty)
-            || (isNonRec rec_flag && exprOkForSpeculation rhs))
- 	   (mkRhsPrimMsg binder rhs)
-        -- Check whether binder's specialisations contain any out-of-scope variables
-       ; mapM_ (checkBndrIdInScope binder) bndr_vars }
-	  
-	-- We should check the unfolding, if any, but this is tricky because
-	-- the unfolding is a SimplifiableCoreExpr. Give up for now.
-  where
-    binder_ty = idType binder
-    bndr_vars = varSetElems (idFreeVars binder)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[lintCoreExpr]{lintCoreExpr}
-%*									*
-%************************************************************************
-
-\begin{code}
-type InType  = Type	-- Substitution not yet applied
-type OutType = Type	-- Substitution has been applied to this
-
-lintCoreExpr :: CoreExpr -> LintM OutType
--- The returned type has the substitution from the monad 
--- already applied to it:
---	lintCoreExpr e subst = exprType (subst e)
-
-lintCoreExpr (Var var)
-  = do	{ checkIdInScope var 
- 	; applySubst (idType var) }
-
-lintCoreExpr (Lit lit)
-  = return (literalType lit)
-
-lintCoreExpr (Note (Coerce to_ty from_ty) expr)
-  = do	{ expr_ty <- lintCoreExpr expr
-	; to_ty <- lintTy to_ty
-	; from_ty <- lintTy from_ty	
-	; checkTys from_ty expr_ty (mkCoerceErr from_ty expr_ty)
-	; return to_ty }
-
-lintCoreExpr (Note other_note expr)
-  = lintCoreExpr expr
-
-lintCoreExpr (Let (NonRec bndr rhs) body)
-  = do	{ lintSingleBinding NonRecursive (bndr,rhs)
-	; addLoc (BodyOfLetRec [bndr])
-		 (addInScopeVars [bndr] (lintCoreExpr body)) }
-
-lintCoreExpr (Let (Rec pairs) body) 
-  = addInScopeVars bndrs	$
-    do	{ mapM (lintSingleBinding Recursive) pairs	
-	; addLoc (BodyOfLetRec bndrs) (lintCoreExpr body) }
-  where
-    bndrs = map fst pairs
-
-lintCoreExpr e@(App fun (Type ty))
--- This is like 'let' for types
--- It's needed when dealing with desugarer output for GADTs. Consider
---   data T = forall a. T a (a->Int) Bool
---    f :: T -> ... -> 
---    f (T x f True)  = <e1>
---    f (T y g False) = <e2>
--- After desugaring we get
---	f t b = case t of 
---		  T a (x::a) (f::a->Int) (b:Bool) ->
---		    case b of 
---			True -> <e1>
---			False -> (/\b. let y=x; g=f in <e2>) a
--- And for a reason I now forget, the ...<e2>... can mention a; so 
--- we want Lint to know that b=a.  Ugh.
---
--- I tried quite hard to make the necessity for this go away, by changing the 
--- desugarer, but the fundamental problem is this:
---	
---	T a (x::a) (y::Int) -> let fail::a = ...
---			       in (/\b. ...(case ... of       
---						True  -> x::b
---					 	False -> fail)
---				  ) a
--- Now the inner case look as though it has incompatible branches.
-  = addLoc (AnExpr e) $
-    go fun [ty]
-  where
-    go (App fun (Type ty)) tys
-	= do { go fun (ty:tys) }
-    go (Lam tv body) (ty:tys)
-	= do  { checkL (isTyVar tv) (mkKindErrMsg tv ty)	-- Not quite accurate
-	      ; ty' <- lintTy ty; 
-	      ; checkKinds tv ty'
-		-- Now extend the substitution so we 
-		-- take advantage of it in the body
-	      ; addInScopeVars [tv] $
-	        extendSubstL tv ty' $
-		go body tys }
-    go fun tys
-	= do  { fun_ty <- lintCoreExpr fun
-	      ; lintCoreArgs fun_ty (map Type tys) }
-
-lintCoreExpr e@(App fun arg)
-  = do	{ fun_ty <- lintCoreExpr fun
-	; addLoc (AnExpr e) $
-          lintCoreArg fun_ty arg }
-
-lintCoreExpr (Lam var expr)
-  = addLoc (LambdaBodyOf var) $
-    do	{ body_ty <- addInScopeVars [var] $
-                     lintCoreExpr expr
-	; if isId var then do
-		{ var_ty <- lintId var 	
-		; return (mkFunTy var_ty body_ty) }
-	  else
-		return (mkForAllTy var body_ty)
-	}
-	-- The applySubst is needed to apply the subst to var
-
-lintCoreExpr e@(Case scrut var alt_ty alts) =
-       -- Check the scrutinee
-  do { scrut_ty <- lintCoreExpr scrut
-     ; alt_ty   <- lintTy alt_ty  
-     ; var_ty   <- lintTy (idType var)	
-	-- Don't use lintId on var, because unboxed tuple is legitimate
-
-     ; checkTys var_ty scrut_ty (mkScrutMsg var scrut_ty)
-
-     -- If the binder is an unboxed tuple type, don't put it in scope
-     ; let vars = if (isUnboxedTupleType (idType var)) then [] else [var]
-     ; addInScopeVars vars $
-       do { -- Check the alternatives
-            checkCaseAlts e scrut_ty alts
-          ; mapM (lintCoreAlt scrut_ty alt_ty) alts
-          ; return alt_ty } }
-
-lintCoreExpr e@(Type ty)
-  = addErrL (mkStrangeTyMsg e)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[lintCoreArgs]{lintCoreArgs}
-%*									*
-%************************************************************************
-
-The basic version of these functions checks that the argument is a
-subtype of the required type, as one would expect.
-
-\begin{code}
-lintCoreArgs :: Type -> [CoreArg] -> LintM Type
-lintCoreArg  :: Type -> CoreArg   -> LintM Type
--- First argument has already had substitution applied to it
-\end{code}
-
-\begin{code}
-lintCoreArgs ty [] = return ty
-lintCoreArgs ty (a : args) = 
-  do { res <- lintCoreArg ty a
-     ; lintCoreArgs res args }
-
-lintCoreArg fun_ty a@(Type arg_ty) = 
-  do { arg_ty <- lintTy arg_ty	
-     ; lintTyApp fun_ty arg_ty }
-
-lintCoreArg fun_ty arg = 
-       -- Make sure function type matches argument
-  do { arg_ty <- lintCoreExpr arg
-     ; let err = mkAppMsg fun_ty arg_ty arg
-     ; case splitFunTy_maybe fun_ty of
-        Just (arg,res) -> 
-          do { checkTys arg arg_ty err 
-             ; return res }
-        _ -> addErrL err }
-\end{code}
-
-\begin{code}
--- Both args have had substitution applied
-lintTyApp ty arg_ty 
-  = case splitForAllTy_maybe ty of
-      Nothing -> addErrL (mkTyAppMsg ty arg_ty)
-
-      Just (tyvar,body)
-        -> do	{ checkL (isTyVar tyvar) (mkTyAppMsg ty arg_ty)
-		; checkKinds tyvar arg_ty
-		; return (substTyWith [tyvar] [arg_ty] body) }
-
-lintTyApps fun_ty [] = return fun_ty
-
-lintTyApps fun_ty (arg_ty : arg_tys) = 
-  do { fun_ty' <- lintTyApp fun_ty arg_ty
-     ; lintTyApps fun_ty' arg_tys }
-
-checkKinds tyvar arg_ty
-	-- Arg type might be boxed for a function with an uncommitted
-	-- tyvar; notably this is used so that we can give
-	-- 	error :: forall a:*. String -> a
-	-- and then apply it to both boxed and unboxed types.
-  = checkL (argty_kind `isSubKind` tyvar_kind)
-	   (mkKindErrMsg tyvar arg_ty)
-  where
-    tyvar_kind = tyVarKind tyvar
-    argty_kind = typeKind arg_ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[lintCoreAlts]{lintCoreAlts}
-%*									*
-%************************************************************************
-
-\begin{code}
-checkCaseAlts :: CoreExpr -> OutType -> [CoreAlt] -> LintM ()
--- a) Check that the alts are non-empty
--- b1) Check that the DEFAULT comes first, if it exists
--- b2) Check that the others are in increasing order
--- c) Check that there's a default for infinite types
--- NB: Algebraic cases are not necessarily exhaustive, because
---     the simplifer correctly eliminates case that can't 
---     possibly match.
-
-checkCaseAlts e ty [] 
-  = addErrL (mkNullAltsMsg e)
-
-checkCaseAlts e ty alts = 
-  do { checkL (all non_deflt con_alts) (mkNonDefltMsg e)
-     ; checkL (increasing_tag con_alts) (mkNonIncreasingAltsMsg e)
-     ; checkL (isJust maybe_deflt || not is_infinite_ty)
-	   (nonExhaustiveAltsMsg e) }
-  where
-    (con_alts, maybe_deflt) = findDefault alts
-
-	-- Check that successive alternatives have increasing tags 
-    increasing_tag (alt1 : rest@( alt2 : _)) = alt1 `ltAlt` alt2 && increasing_tag rest
-    increasing_tag other 		     = True
-
-    non_deflt (DEFAULT, _, _) = False
-    non_deflt alt	      = True
-
-    is_infinite_ty = case splitTyConApp_maybe ty of
-			Nothing			    -> False
-			Just (tycon, tycon_arg_tys) -> isPrimTyCon tycon
-\end{code}
-
-\begin{code}
-checkAltExpr :: CoreExpr -> OutType -> LintM ()
-checkAltExpr expr ann_ty
-  = do { actual_ty <- lintCoreExpr expr 
-       ; checkTys actual_ty ann_ty (mkCaseAltMsg expr actual_ty ann_ty) }
-
-lintCoreAlt :: OutType 		-- Type of scrutinee
-            -> OutType          -- Type of the alternative
-	    -> CoreAlt
-	    -> LintM ()
-
-lintCoreAlt scrut_ty alt_ty alt@(DEFAULT, args, rhs) = 
-  do { checkL (null args) (mkDefaultArgsMsg args)
-     ; checkAltExpr rhs alt_ty }
-
-lintCoreAlt scrut_ty alt_ty alt@(LitAlt lit, args, rhs) = 
-  do { checkL (null args) (mkDefaultArgsMsg args)
-     ; checkTys lit_ty scrut_ty (mkBadPatMsg lit_ty scrut_ty)	
-     ; checkAltExpr rhs alt_ty } 
-  where
-    lit_ty = literalType lit
-
-lintCoreAlt scrut_ty alt_ty alt@(DataAlt con, args, rhs)
-  | Just (tycon, tycon_arg_tys) <- splitTyConApp_maybe scrut_ty,
-    tycon == dataConTyCon con
-  = addLoc (CaseAlt alt) $
-    addInScopeVars args $	-- Put the args in scope before lintBinder,
-				-- because the Ids mention the type variables
-    if isVanillaDataCon con then
-    do	{ addLoc (CasePat alt) $ do
-	  { mapM lintBinder args 
-         	-- FIX! Add check that all args are Ids.
-		 -- Check the pattern
-		 -- Scrutinee type must be a tycon applicn; checked by caller
-		 -- This code is remarkably compact considering what it does!
-		 -- NB: args must be in scope here so that the lintCoreArgs line works.
-	         -- NB: relies on existential type args coming *after* ordinary type args
-
-	  ; con_type <- lintTyApps (dataConRepType con) tycon_arg_tys
-                 -- Can just map Var as we know that this is a vanilla datacon
-	  ; con_result_ty <- lintCoreArgs con_type (map Var args)
-	  ; checkTys con_result_ty scrut_ty (mkBadPatMsg con_result_ty scrut_ty) 
- 	  }
-	       -- Check the RHS
-	; checkAltExpr rhs alt_ty }
-
-    else 	-- GADT
-    do	{ let (tvs,ids) = span isTyVar args
-        ; subst <- getTvSubst 
-	; let in_scope  = getTvInScope subst
-	      subst_env = getTvSubstEnv subst
-        ; case coreRefineTys con tvs scrut_ty of {
-             Nothing          -> return () ;	-- Alternative is dead code
-             Just (refine, _) -> updateTvSubstEnv (composeTvSubst in_scope refine subst_env) $
-    do 	{ addLoc (CasePat alt) $ do
-	  { tvs'     <- mapM lintTy (mkTyVarTys tvs)
-	  ; con_type <- lintTyApps (dataConRepType con) tvs'
-	  ; mapM lintBinder ids	-- Lint Ids in the refined world
-	  ; lintCoreArgs con_type (map Var ids)
-	  }
-
-	; let refined_alt_ty = substTy (mkTvSubst in_scope refine) alt_ty
-		-- alt_ty is already an OutType, so don't re-apply 
-		-- the current substitution.  But we must apply the
-		-- refinement so that the check in checkAltExpr is ok
-	; checkAltExpr rhs refined_alt_ty
-    } } }
-
-  | otherwise	-- Scrut-ty is wrong shape
-  = addErrL (mkBadAltMsg scrut_ty alt)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[lint-types]{Types}
-%*									*
-%************************************************************************
-
-\begin{code}
-lintBinder :: Var -> LintM ()
-lintBinder var | isId var  = lintId var >> return ()
-	       | otherwise = return ()
-
-lintId :: Var -> LintM OutType
--- ToDo: lint its rules
-lintId id
-  = do 	{ checkL (not (isUnboxedTupleType (idType id))) 
-		 (mkUnboxedTupleMsg id)
-		-- No variable can be bound to an unboxed tuple.
-	; lintTy (idType id) }
-
-lintTy :: InType -> LintM OutType
--- Check the type, and apply the substitution to it
--- ToDo: check the kind structure of the type
-lintTy ty 
-  = do	{ ty' <- applySubst ty
-	; mapM_ checkIdInScope (varSetElems (tyVarsOfType ty'))
-	; return ty' }
-\end{code}
-
-    
-%************************************************************************
-%*									*
-\subsection[lint-monad]{The Lint monad}
-%*									*
-%************************************************************************
-
-\begin{code}
-newtype LintM a = 
-   LintM { unLintM :: 
-            [LintLocInfo] ->         -- Locations
-            TvSubst ->               -- Current type substitution; we also use this
-				     -- to keep track of all the variables in scope,
-				     -- both Ids and TyVars
-	    Bag Message ->           -- Error messages so far
-	    (Maybe a, Bag Message) } -- Result and error messages (if any)
-
-instance Monad LintM where
-  return x = LintM (\ loc subst errs -> (Just x, errs))
-  fail err = LintM (\ loc subst errs -> (Nothing, addErr subst errs (text err) loc))
-  m >>= k  = LintM (\ loc subst errs -> 
-                       let (res, errs') = unLintM m loc subst errs in
-                         case res of
-                           Just r -> unLintM (k r) loc subst errs'
-                           Nothing -> (Nothing, errs'))
-
-data LintLocInfo
-  = RhsOf Id		-- The variable bound
-  | LambdaBodyOf Id	-- The lambda-binder
-  | BodyOfLetRec [Id]	-- One of the binders
-  | CaseAlt CoreAlt	-- Case alternative
-  | CasePat CoreAlt	-- *Pattern* of the case alternative
-  | AnExpr CoreExpr	-- Some expression
-  | ImportedUnfolding SrcLoc -- Some imported unfolding (ToDo: say which)
-\end{code}
-
-                 
-\begin{code}
-initL :: LintM a -> Maybe Message {- errors -}
-initL m
-  = case unLintM m [] emptyTvSubst emptyBag of
-      (_, errs) | isEmptyBag errs -> Nothing
-		| otherwise	  -> Just (vcat (punctuate (text "") (bagToList errs)))
-\end{code}
-
-\begin{code}
-checkL :: Bool -> Message -> LintM ()
-checkL True  msg = return ()
-checkL False msg = addErrL msg
-
-addErrL :: Message -> LintM a
-addErrL msg = LintM (\ loc subst errs -> (Nothing, addErr subst errs msg loc))
-
-addErr :: TvSubst -> Bag Message -> Message -> [LintLocInfo] -> Bag Message
-addErr subst errs_so_far msg locs
-  = ASSERT( notNull locs )
-    errs_so_far `snocBag` mk_msg msg
-  where
-   (loc, cxt1) = dumpLoc (head locs)
-   cxts        = [snd (dumpLoc loc) | loc <- locs]   
-   context     | opt_PprStyle_Debug = vcat (reverse cxts) $$ cxt1 $$
-				      ptext SLIT("Substitution:") <+> ppr subst
-	       | otherwise	    = cxt1
- 
-   mk_msg msg = mkLocMessage (mkSrcSpan loc loc) (context $$ msg)
-
-addLoc :: LintLocInfo -> LintM a -> LintM a
-addLoc extra_loc m =
-  LintM (\ loc subst errs -> unLintM m (extra_loc:loc) subst errs)
-
-addInScopeVars :: [Var] -> LintM a -> LintM a
-addInScopeVars vars m = 
-  LintM (\ loc subst errs -> unLintM m loc (extendTvInScope subst vars) errs)
-
-updateTvSubstEnv :: TvSubstEnv -> LintM a -> LintM a
-updateTvSubstEnv substenv m = 
-  LintM (\ loc subst errs -> unLintM m loc (setTvSubstEnv subst substenv) errs)
-
-getTvSubst :: LintM TvSubst
-getTvSubst = LintM (\ loc subst errs -> (Just subst, errs))
-
-applySubst :: Type -> LintM Type
-applySubst ty = do { subst <- getTvSubst; return (substTy subst ty) }
-
-extendSubstL :: TyVar -> Type -> LintM a -> LintM a
-extendSubstL tv ty m
-  = LintM (\ loc subst errs -> unLintM m loc (extendTvSubst subst tv ty) errs)
-\end{code}
-
-\begin{code}
-checkIdInScope :: Var -> LintM ()
-checkIdInScope id 
-  = do { checkL (not (id == oneTupleDataConId))
-		(ptext SLIT("Illegal one-tuple"))
-       ; checkInScope (ptext SLIT("is out of scope")) id }
-
-oneTupleDataConId :: Id	-- Should not happen
-oneTupleDataConId = dataConWorkId (tupleCon Boxed 1)
-
-checkBndrIdInScope :: Var -> Var -> LintM ()
-checkBndrIdInScope binder id 
-  = checkInScope msg id
-    where
-     msg = ptext SLIT("is out of scope inside info for") <+> 
-	   ppr binder
-
-checkInScope :: SDoc -> Var -> LintM ()
-checkInScope loc_msg var =
- do { subst <- getTvSubst
-    ; checkL (not (mustHaveLocalBinding var) || (var `isInScope` subst))
-             (hsep [ppr var, loc_msg]) }
-
-checkTys :: Type -> Type -> Message -> LintM ()
--- check ty2 is subtype of ty1 (ie, has same structure but usage
--- annotations need only be consistent, not equal)
--- Assumes ty1,ty2 are have alrady had the substitution applied
-checkTys ty1 ty2 msg = checkL (ty1 `coreEqType` ty2) msg
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Error messages}
-%*									*
-%************************************************************************
-
-\begin{code}
-dumpLoc (RhsOf v)
-  = (getSrcLoc v, brackets (ptext SLIT("RHS of") <+> pp_binders [v]))
-
-dumpLoc (LambdaBodyOf b)
-  = (getSrcLoc b, brackets (ptext SLIT("in body of lambda with binder") <+> pp_binder b))
-
-dumpLoc (BodyOfLetRec [])
-  = (noSrcLoc, brackets (ptext SLIT("In body of a letrec with no binders")))
-
-dumpLoc (BodyOfLetRec bs@(_:_))
-  = ( getSrcLoc (head bs), brackets (ptext SLIT("in body of letrec with binders") <+> pp_binders bs))
-
-dumpLoc (AnExpr e)
-  = (noSrcLoc, text "In the expression:" <+> ppr e)
-
-dumpLoc (CaseAlt (con, args, rhs))
-  = (noSrcLoc, text "In a case alternative:" <+> parens (ppr con <+> pp_binders args))
-
-dumpLoc (CasePat (con, args, rhs))
-  = (noSrcLoc, text "In the pattern of a case alternative:" <+> parens (ppr con <+> pp_binders args))
-
-dumpLoc (ImportedUnfolding locn)
-  = (locn, brackets (ptext SLIT("in an imported unfolding")))
-
-pp_binders :: [Var] -> SDoc
-pp_binders bs = sep (punctuate comma (map pp_binder bs))
-
-pp_binder :: Var -> SDoc
-pp_binder b | isId b    = hsep [ppr b, dcolon, ppr (idType b)]
-            | isTyVar b = hsep [ppr b, dcolon, ppr (tyVarKind b)]
-\end{code}
-
-\begin{code}
-------------------------------------------------------
---	Messages for case expressions
-
-mkNullAltsMsg :: CoreExpr -> Message
-mkNullAltsMsg e 
-  = hang (text "Case expression with no alternatives:")
-	 4 (ppr e)
-
-mkDefaultArgsMsg :: [Var] -> Message
-mkDefaultArgsMsg args 
-  = hang (text "DEFAULT case with binders")
-	 4 (ppr args)
-
-mkCaseAltMsg :: CoreExpr -> Type -> Type -> Message
-mkCaseAltMsg e ty1 ty2
-  = hang (text "Type of case alternatives not the same as the annotation on case:")
-	 4 (vcat [ppr ty1, ppr ty2, ppr e])
-
-mkScrutMsg :: Id -> Type -> Message
-mkScrutMsg var scrut_ty
-  = vcat [text "Result binder in case doesn't match scrutinee:" <+> ppr var,
-	  text "Result binder type:" <+> ppr (idType var),
-	  text "Scrutinee type:" <+> ppr scrut_ty]
-
-
-mkNonDefltMsg e
-  = hang (text "Case expression with DEFAULT not at the beginnning") 4 (ppr e)
-mkNonIncreasingAltsMsg e
-  = hang (text "Case expression with badly-ordered alternatives") 4 (ppr e)
-
-nonExhaustiveAltsMsg :: CoreExpr -> Message
-nonExhaustiveAltsMsg e
-  = hang (text "Case expression with non-exhaustive alternatives") 4 (ppr e)
-
-mkBadPatMsg :: Type -> Type -> Message
-mkBadPatMsg con_result_ty scrut_ty
-  = vcat [
-	text "In a case alternative, pattern result type doesn't match scrutinee type:",
-	text "Pattern result type:" <+> ppr con_result_ty,
-	text "Scrutinee type:" <+> ppr scrut_ty
-    ]
-
-mkBadAltMsg :: Type -> CoreAlt -> Message
-mkBadAltMsg scrut_ty alt
-  = vcat [ text "Data alternative when scrutinee is not a tycon application",
-	   text "Scrutinee type:" <+> ppr scrut_ty,
-	   text "Alternative:" <+> pprCoreAlt alt ]
-
-------------------------------------------------------
---	Other error messages
-
-mkAppMsg :: Type -> Type -> CoreExpr -> Message
-mkAppMsg fun_ty arg_ty arg
-  = vcat [ptext SLIT("Argument value doesn't match argument type:"),
-	      hang (ptext SLIT("Fun type:")) 4 (ppr fun_ty),
-	      hang (ptext SLIT("Arg type:")) 4 (ppr arg_ty),
-	      hang (ptext SLIT("Arg:")) 4 (ppr arg)]
-
-mkKindErrMsg :: TyVar -> Type -> Message
-mkKindErrMsg tyvar arg_ty
-  = vcat [ptext SLIT("Kinds don't match in type application:"),
-	  hang (ptext SLIT("Type variable:"))
-		 4 (ppr tyvar <+> dcolon <+> ppr (tyVarKind tyvar)),
-	  hang (ptext SLIT("Arg type:"))   
-	         4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))]
-
-mkTyAppMsg :: Type -> Type -> Message
-mkTyAppMsg ty arg_ty
-  = vcat [text "Illegal type application:",
-	      hang (ptext SLIT("Exp type:"))
-		 4 (ppr ty <+> dcolon <+> ppr (typeKind ty)),
-	      hang (ptext SLIT("Arg type:"))   
-	         4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))]
-
-mkRhsMsg :: Id -> Type -> Message
-mkRhsMsg binder ty
-  = vcat
-    [hsep [ptext SLIT("The type of this binder doesn't match the type of its RHS:"),
-	    ppr binder],
-     hsep [ptext SLIT("Binder's type:"), ppr (idType binder)],
-     hsep [ptext SLIT("Rhs type:"), ppr ty]]
-
-mkRhsPrimMsg :: Id -> CoreExpr -> Message
-mkRhsPrimMsg binder rhs
-  = vcat [hsep [ptext SLIT("The type of this binder is primitive:"),
-		     ppr binder],
-	      hsep [ptext SLIT("Binder's type:"), ppr (idType binder)]
-	     ]
-
-mkUnboxedTupleMsg :: Id -> Message
-mkUnboxedTupleMsg binder
-  = vcat [hsep [ptext SLIT("A variable has unboxed tuple type:"), ppr binder],
-	  hsep [ptext SLIT("Binder's type:"), ppr (idType binder)]]
-
-mkCoerceErr from_ty expr_ty
-  = vcat [ptext SLIT("From-type of Coerce differs from type of enclosed expression"),
-	  ptext SLIT("From-type:") <+> ppr from_ty,
-	  ptext SLIT("Type of enclosed expr:") <+> ppr expr_ty
-    ]
-
-mkStrangeTyMsg e
-  = ptext SLIT("Type where expression expected:") <+> ppr e
-\end{code}
diff --git a/ghc/compiler/coreSyn/CorePrep.lhs b/ghc/compiler/coreSyn/CorePrep.lhs
deleted file mode 100644
index e5165f0ebe..0000000000
--- a/ghc/compiler/coreSyn/CorePrep.lhs
+++ /dev/null
@@ -1,859 +0,0 @@
-%
-% (c) The University of Glasgow, 1994-2000
-%
-\section{Core pass to saturate constructors and PrimOps}
-
-\begin{code}
-module CorePrep (
-      corePrepPgm, corePrepExpr
-  ) where
-
-#include "HsVersions.h"
-
-import CoreUtils( exprType, exprIsHNF, etaExpand, exprArity, exprOkForSpeculation )
-import CoreFVs	( exprFreeVars )
-import CoreLint	( endPass )
-import CoreSyn
-import Type	( Type, applyTy, splitFunTy_maybe, 
-		  isUnLiftedType, isUnboxedTupleType, seqType )
-import TyCon	( TyCon, tyConDataCons )
-import NewDemand  ( Demand, isStrictDmd, lazyDmd, StrictSig(..), DmdType(..) )
-import Var 	( Var, Id, setVarUnique )
-import VarSet
-import VarEnv
-import Id	( mkSysLocal, idType, idNewDemandInfo, idArity, setIdUnfolding, setIdType,
-		  isFCallId, isGlobalId, 
-		  isLocalId, hasNoBinding, idNewStrictness, 
-		  isPrimOpId_maybe
-		)
-import DataCon	  ( isVanillaDataCon, dataConWorkId )
-import PrimOp	  ( PrimOp( DataToTagOp ) )
-import BasicTypes ( TopLevelFlag(..), isTopLevel, isNotTopLevel,
-		    RecFlag(..), isNonRec
-		  )
-import UniqSupply
-import Maybes
-import OrdList
-import ErrUtils
-import DynFlags
-import Util       ( listLengthCmp )
-import Outputable
-\end{code}
-
--- ---------------------------------------------------------------------------
--- Overview
--- ---------------------------------------------------------------------------
-
-The goal of this pass is to prepare for code generation.
-
-1.  Saturate constructor and primop applications.
-
-2.  Convert to A-normal form:
-
-    * Use case for strict arguments:
-	f E ==> case E of x -> f x
-    	(where f is strict)
-
-    * Use let for non-trivial lazy arguments
-	f E ==> let x = E in f x
-	(were f is lazy and x is non-trivial)
-
-3.  Similarly, convert any unboxed lets into cases.
-    [I'm experimenting with leaving 'ok-for-speculation' 
-     rhss in let-form right up to this point.]
-
-4.  Ensure that lambdas only occur as the RHS of a binding
-    (The code generator can't deal with anything else.)
-
-5.  [Not any more; nuked Jun 2002] Do the seq/par munging.
-
-6.  Clone all local Ids.
-    This means that all such Ids are unique, rather than the 
-    weaker guarantee of no clashes which the simplifier provides.
-    And that is what the code generator needs.
-
-    We don't clone TyVars. The code gen doesn't need that, 
-    and doing so would be tiresome because then we'd need
-    to substitute in types.
-
-
-7.  Give each dynamic CCall occurrence a fresh unique; this is
-    rather like the cloning step above.
-
-8.  Inject bindings for the "implicit" Ids:
-	* Constructor wrappers
-	* Constructor workers
-	* Record selectors
-    We want curried definitions for all of these in case they
-    aren't inlined by some caller.
-	
-This is all done modulo type applications and abstractions, so that
-when type erasure is done for conversion to STG, we don't end up with
-any trivial or useless bindings.
-
-  
-
--- -----------------------------------------------------------------------------
--- Top level stuff
--- -----------------------------------------------------------------------------
-
-\begin{code}
-corePrepPgm :: DynFlags -> [CoreBind] -> [TyCon] -> IO [CoreBind]
-corePrepPgm dflags binds data_tycons
-  = do	showPass dflags "CorePrep"
-	us <- mkSplitUniqSupply 's'
-
-	let implicit_binds = mkDataConWorkers data_tycons
-		-- NB: we must feed mkImplicitBinds through corePrep too
-		-- so that they are suitably cloned and eta-expanded
-
-	    binds_out = initUs_ us (
-			  corePrepTopBinds binds	`thenUs` \ floats1 ->
-			  corePrepTopBinds implicit_binds	`thenUs` \ floats2 ->
-			  returnUs (deFloatTop (floats1 `appendFloats` floats2))
-			)
-	    
-        endPass dflags "CorePrep" Opt_D_dump_prep binds_out
-	return binds_out
-
-corePrepExpr :: DynFlags -> CoreExpr -> IO CoreExpr
-corePrepExpr dflags expr
-  = do showPass dflags "CorePrep"
-       us <- mkSplitUniqSupply 's'
-       let new_expr = initUs_ us (corePrepAnExpr emptyCorePrepEnv expr)
-       dumpIfSet_dyn dflags Opt_D_dump_prep "CorePrep" 
-		     (ppr new_expr)
-       return new_expr
-\end{code}
-
--- -----------------------------------------------------------------------------
--- Implicit bindings
--- -----------------------------------------------------------------------------
-
-Create any necessary "implicit" bindings for data con workers.  We
-create the rather strange (non-recursive!) binding
-
-	$wC = \x y -> $wC x y
-
-i.e. a curried constructor that allocates.  This means that we can
-treat the worker for a constructor like any other function in the rest
-of the compiler.  The point here is that CoreToStg will generate a
-StgConApp for the RHS, rather than a call to the worker (which would
-give a loop).  As Lennart says: the ice is thin here, but it works.
-
-Hmm.  Should we create bindings for dictionary constructors?  They are
-always fully applied, and the bindings are just there to support
-partial applications. But it's easier to let them through.
-
-\begin{code}
-mkDataConWorkers data_tycons
-  = [ NonRec id (Var id)	-- The ice is thin here, but it works
-    | tycon <- data_tycons, 	-- CorePrep will eta-expand it
-      data_con <- tyConDataCons tycon,
-      let id = dataConWorkId data_con ]
-\end{code}
-	
-
-\begin{code}
--- ---------------------------------------------------------------------------
--- Dealing with bindings
--- ---------------------------------------------------------------------------
-
-data FloatingBind = FloatLet CoreBind
-		  | FloatCase Id CoreExpr Bool
-			-- The bool indicates "ok-for-speculation"
-
-data Floats = Floats OkToSpec (OrdList FloatingBind)
-
--- Can we float these binds out of the rhs of a let?  We cache this decision
--- to avoid having to recompute it in a non-linear way when there are
--- deeply nested lets.
-data OkToSpec
-   = NotOkToSpec 	-- definitely not
-   | OkToSpec		-- yes
-   | IfUnboxedOk	-- only if floating an unboxed binding is ok
-
-emptyFloats :: Floats
-emptyFloats = Floats OkToSpec nilOL
-
-addFloat :: Floats -> FloatingBind -> Floats
-addFloat (Floats ok_to_spec floats) new_float
-  = Floats (combine ok_to_spec (check new_float)) (floats `snocOL` new_float)
-  where
-    check (FloatLet _)  	      = OkToSpec
-    check (FloatCase _ _ ok_for_spec) 
-	| ok_for_spec  =  IfUnboxedOk
-	| otherwise    =  NotOkToSpec
-	-- The ok-for-speculation flag says that it's safe to
-	-- float this Case out of a let, and thereby do it more eagerly
-	-- We need the top-level flag because it's never ok to float
-	-- an unboxed binding to the top level
-
-unitFloat :: FloatingBind -> Floats
-unitFloat = addFloat emptyFloats
-
-appendFloats :: Floats -> Floats -> Floats
-appendFloats (Floats spec1 floats1) (Floats spec2 floats2)
-  = Floats (combine spec1 spec2) (floats1 `appOL` floats2)
-
-concatFloats :: [Floats] -> Floats
-concatFloats = foldr appendFloats emptyFloats
-
-combine NotOkToSpec _ = NotOkToSpec
-combine _ NotOkToSpec = NotOkToSpec
-combine IfUnboxedOk _ = IfUnboxedOk
-combine _ IfUnboxedOk = IfUnboxedOk
-combine _ _           = OkToSpec
-    
-instance Outputable FloatingBind where
-  ppr (FloatLet bind)        = text "FloatLet" <+> ppr bind
-  ppr (FloatCase b rhs spec) = text "FloatCase" <+> ppr b <+> ppr spec <+> equals <+> ppr rhs
-
-deFloatTop :: Floats -> [CoreBind]
--- For top level only; we don't expect any FloatCases
-deFloatTop (Floats _ floats)
-  = foldrOL get [] floats
-  where
-    get (FloatLet b) bs = b:bs
-    get b	     bs = pprPanic "corePrepPgm" (ppr b)
-
-allLazy :: TopLevelFlag -> RecFlag -> Floats -> Bool
-allLazy top_lvl is_rec (Floats ok_to_spec _)
-  = case ok_to_spec of
-	OkToSpec    -> True
-	NotOkToSpec -> False
-	IfUnboxedOk -> isNotTopLevel top_lvl && isNonRec is_rec
-
--- ---------------------------------------------------------------------------
--- 			Bindings
--- ---------------------------------------------------------------------------
-
-corePrepTopBinds :: [CoreBind] -> UniqSM Floats
-corePrepTopBinds binds 
-  = go emptyCorePrepEnv binds
-  where
-    go env []		  = returnUs emptyFloats
-    go env (bind : binds) = corePrepTopBind env bind	`thenUs` \ (env', bind') ->
-			    go env' binds		`thenUs` \ binds' ->
-			    returnUs (bind' `appendFloats` binds')
-
--- NB: we do need to float out of top-level bindings
--- Consider	x = length [True,False]
--- We want to get
---		s1 = False : []
---		s2 = True  : s1
---		x  = length s2
-
--- We return a *list* of bindings, because we may start with
---	x* = f (g y)
--- where x is demanded, in which case we want to finish with
---	a = g y
---	x* = f a
--- And then x will actually end up case-bound
---
--- What happens to the CafInfo on the floated bindings?  By
--- default, all the CafInfos will be set to MayHaveCafRefs,
--- which is safe.
---
--- This might be pessimistic, because eg. s1 & s2
--- might not refer to any CAFs and the GC will end up doing
--- more traversal than is necessary, but it's still better
--- than not floating the bindings at all, because then
--- the GC would have to traverse the structure in the heap
--- instead.  Given this, we decided not to try to get
--- the CafInfo on the floated bindings correct, because
--- it looks difficult.
-
---------------------------------
-corePrepTopBind :: CorePrepEnv -> CoreBind -> UniqSM (CorePrepEnv, Floats)
-corePrepTopBind env (NonRec bndr rhs) 
-  = cloneBndr env bndr					`thenUs` \ (env', bndr') ->
-    corePrepRhs TopLevel NonRecursive env (bndr, rhs)	`thenUs` \ (floats, rhs') -> 
-    returnUs (env', addFloat floats (FloatLet (NonRec bndr' rhs')))
-
-corePrepTopBind env (Rec pairs) = corePrepRecPairs TopLevel env pairs
-
---------------------------------
-corePrepBind ::  CorePrepEnv -> CoreBind -> UniqSM (CorePrepEnv, Floats)
-	-- This one is used for *local* bindings
-corePrepBind env (NonRec bndr rhs)
-  = etaExpandRhs bndr rhs				`thenUs` \ rhs1 ->
-    corePrepExprFloat env rhs1				`thenUs` \ (floats, rhs2) ->
-    cloneBndr env bndr					`thenUs` \ (_, bndr') ->
-    mkLocalNonRec bndr' (bdrDem bndr) floats rhs2	`thenUs` \ (floats', bndr'') ->
-	-- We want bndr'' in the envt, because it records
-	-- the evaluated-ness of the binder
-    returnUs (extendCorePrepEnv env bndr bndr'', floats')
-
-corePrepBind env (Rec pairs) = corePrepRecPairs NotTopLevel env pairs
-
---------------------------------
-corePrepRecPairs :: TopLevelFlag -> CorePrepEnv
-		 -> [(Id,CoreExpr)]	-- Recursive bindings
-		 -> UniqSM (CorePrepEnv, Floats)
--- Used for all recursive bindings, top level and otherwise
-corePrepRecPairs lvl env pairs
-  = cloneBndrs env (map fst pairs)				`thenUs` \ (env', bndrs') ->
-    mapAndUnzipUs (corePrepRhs lvl Recursive env') pairs	`thenUs` \ (floats_s, rhss') ->
-    returnUs (env', unitFloat (FloatLet (Rec (flatten (concatFloats floats_s) bndrs' rhss'))))
-  where
-	-- Flatten all the floats, and the currrent
-	-- group into a single giant Rec
-    flatten (Floats _ floats) bndrs rhss = foldrOL get (bndrs `zip` rhss) floats
-
-    get (FloatLet (NonRec b r)) prs2 = (b,r) : prs2
-    get (FloatLet (Rec prs1))   prs2 = prs1 ++ prs2
-    get b			prs2 = pprPanic "corePrepRecPairs" (ppr b)
-
---------------------------------
-corePrepRhs :: TopLevelFlag -> RecFlag
-	    -> CorePrepEnv -> (Id, CoreExpr)
-	    -> UniqSM (Floats, CoreExpr)
--- Used for top-level bindings, and local recursive bindings
-corePrepRhs top_lvl is_rec env (bndr, rhs)
-  = etaExpandRhs bndr rhs	`thenUs` \ rhs' ->
-    corePrepExprFloat env rhs'	`thenUs` \ floats_w_rhs ->
-    floatRhs top_lvl is_rec bndr floats_w_rhs
-
-
--- ---------------------------------------------------------------------------
--- Making arguments atomic (function args & constructor args)
--- ---------------------------------------------------------------------------
-
--- This is where we arrange that a non-trivial argument is let-bound
-corePrepArg :: CorePrepEnv -> CoreArg -> RhsDemand
-	   -> UniqSM (Floats, CoreArg)
-corePrepArg env arg dem
-  = corePrepExprFloat env arg		`thenUs` \ (floats, arg') ->
-    if exprIsTrivial arg'
-    then returnUs (floats, arg')
-    else newVar (exprType arg')			`thenUs` \ v ->
-	 mkLocalNonRec v dem floats arg'	`thenUs` \ (floats', v') -> 
-	 returnUs (floats', Var v')
-
--- version that doesn't consider an scc annotation to be trivial.
-exprIsTrivial (Var v)		       = True
-exprIsTrivial (Type _)	      	       = True
-exprIsTrivial (Lit lit)       	       = True
-exprIsTrivial (App e arg)     	       = isTypeArg arg && exprIsTrivial e
-exprIsTrivial (Note (SCC _) e) 	       = False
-exprIsTrivial (Note _ e)      	       = exprIsTrivial e
-exprIsTrivial (Lam b body) | isTyVar b = exprIsTrivial body
-exprIsTrivial other	      	       = False
-
--- ---------------------------------------------------------------------------
--- Dealing with expressions
--- ---------------------------------------------------------------------------
-
-corePrepAnExpr :: CorePrepEnv -> CoreExpr -> UniqSM CoreExpr
-corePrepAnExpr env expr
-  = corePrepExprFloat env expr		`thenUs` \ (floats, expr) ->
-    mkBinds floats expr
-
-
-corePrepExprFloat :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CoreExpr)
--- If
---	e  ===>  (bs, e')
--- then	
---	e = let bs in e'	(semantically, that is!)
---
--- For example
---	f (g x)	  ===>   ([v = g x], f v)
-
-corePrepExprFloat env (Var v)
-  = fiddleCCall v				`thenUs` \ v1 ->
-    let 
-	v2 = lookupCorePrepEnv env v1
-    in
-    maybeSaturate v2 (Var v2) 0 emptyFloats (idType v2)
-
-corePrepExprFloat env expr@(Type _)
-  = returnUs (emptyFloats, expr)
-
-corePrepExprFloat env expr@(Lit lit)
-  = returnUs (emptyFloats, expr)
-
-corePrepExprFloat env (Let bind body)
-  = corePrepBind env bind		`thenUs` \ (env', new_binds) ->
-    corePrepExprFloat env' body		`thenUs` \ (floats, new_body) ->
-    returnUs (new_binds `appendFloats` floats, new_body)
-
-corePrepExprFloat env (Note n@(SCC _) expr)
-  = corePrepAnExpr env expr		`thenUs` \ expr1 ->
-    deLamFloat expr1			`thenUs` \ (floats, expr2) ->
-    returnUs (floats, Note n expr2)
-
-corePrepExprFloat env (Note other_note expr)
-  = corePrepExprFloat env expr		`thenUs` \ (floats, expr') ->
-    returnUs (floats, Note other_note expr')
-
-corePrepExprFloat env expr@(Lam _ _)
-  = cloneBndrs env bndrs		`thenUs` \ (env', bndrs') ->
-    corePrepAnExpr env' body		`thenUs` \ body' ->
-    returnUs (emptyFloats, mkLams bndrs' body')
-  where
-    (bndrs,body) = collectBinders expr
-
-corePrepExprFloat env (Case scrut bndr ty alts)
-  = corePrepExprFloat env scrut		`thenUs` \ (floats1, scrut1) ->
-    deLamFloat scrut1			`thenUs` \ (floats2, scrut2) ->
-    let
-	bndr1 = bndr `setIdUnfolding` evaldUnfolding
-	-- Record that the case binder is evaluated in the alternatives
-    in
-    cloneBndr env bndr1			`thenUs` \ (env', bndr2) ->
-    mapUs (sat_alt env') alts		`thenUs` \ alts' ->
-    returnUs (floats1 `appendFloats` floats2 , Case scrut2 bndr2 ty alts')
-  where
-    sat_alt env (con, bs, rhs)
-	  = let 
-		env1 = setGadt env con
-	    in
-	    cloneBndrs env1 bs		`thenUs` \ (env2, bs') ->
-	    corePrepAnExpr env2 rhs  	`thenUs` \ rhs1 ->
-	    deLam rhs1			`thenUs` \ rhs2 ->
-	    returnUs (con, bs', rhs2)
-
-corePrepExprFloat env expr@(App _ _)
-  = collect_args expr 0  `thenUs` \ (app, (head,depth), ty, floats, ss) ->
-    ASSERT(null ss)	-- make sure we used all the strictness info
-
-	-- Now deal with the function
-    case head of
-      Var fn_id -> maybeSaturate fn_id app depth floats ty
-      _other    -> returnUs (floats, app)
-
-  where
-
-    -- Deconstruct and rebuild the application, floating any non-atomic
-    -- arguments to the outside.  We collect the type of the expression,
-    -- the head of the application, and the number of actual value arguments,
-    -- all of which are used to possibly saturate this application if it
-    -- has a constructor or primop at the head.
-
-    collect_args
-	:: CoreExpr
-	-> Int				  -- current app depth
-	-> UniqSM (CoreExpr,		  -- the rebuilt expression
-		   (CoreExpr,Int),	  -- the head of the application,
-				          -- and no. of args it was applied to
-		   Type,		  -- type of the whole expr
-		   Floats, 		  -- any floats we pulled out
-		   [Demand])		  -- remaining argument demands
-
-    collect_args (App fun arg@(Type arg_ty)) depth
-        = collect_args fun depth   `thenUs` \ (fun',hd,fun_ty,floats,ss) ->
-	  returnUs (App fun' arg, hd, applyTy fun_ty arg_ty, floats, ss)
-
-    collect_args (App fun arg) depth
-        = collect_args fun (depth+1)   `thenUs` \ (fun',hd,fun_ty,floats,ss) ->
-	  let
-	      (ss1, ss_rest)   = case ss of
-				   (ss1:ss_rest) -> (ss1,     ss_rest)
-				   []	         -> (lazyDmd, [])
-              (arg_ty, res_ty) = expectJust "corePrepExprFloat:collect_args" $
-                                 splitFunTy_maybe fun_ty
-	  in
-	  corePrepArg env arg (mkDemTy ss1 arg_ty)	`thenUs` \ (fs, arg') ->
-	  returnUs (App fun' arg', hd, res_ty, fs `appendFloats` floats, ss_rest)
-
-    collect_args (Var v) depth
-	= fiddleCCall v `thenUs` \ v1 ->
-	  let 
-		v2 = lookupCorePrepEnv env v1
-	  in
-	  returnUs (Var v2, (Var v2, depth), idType v2, emptyFloats, stricts)
-	where
-	  stricts = case idNewStrictness v of
-			StrictSig (DmdType _ demands _)
-			    | listLengthCmp demands depth /= GT -> demands
-			            -- length demands <= depth
-			    | otherwise                         -> []
-		-- If depth < length demands, then we have too few args to 
-		-- satisfy strictness  info so we have to  ignore all the 
-		-- strictness info, e.g. + (error "urk")
-		-- Here, we can't evaluate the arg strictly, because this 
-		-- partial application might be seq'd
-
-
-    collect_args (Note (Coerce ty1 ty2) fun) depth
-        = collect_args fun depth  `thenUs` \ (fun', hd, fun_ty, floats, ss) ->
-	  returnUs (Note (Coerce ty1 ty2) fun', hd, ty1, floats, ss)
-
-    collect_args (Note note fun) depth
-	| ignore_note note 	-- Drop these notes altogether
-				-- They aren't used by the code generator
-        = collect_args fun depth   `thenUs` \ (fun', hd, fun_ty, floats, ss) ->
-	  returnUs (fun', hd, fun_ty, floats, ss)
-
-	-- N-variable fun, better let-bind it
-	-- ToDo: perhaps we can case-bind rather than let-bind this closure,
-	-- since it is sure to be evaluated.
-    collect_args fun depth
-	= corePrepExprFloat env fun			`thenUs` \ (fun_floats, fun') ->
-	  newVar ty			 		`thenUs` \ fn_id ->
-          mkLocalNonRec fn_id onceDem fun_floats fun'	`thenUs` \ (floats, fn_id') ->
-	  returnUs (Var fn_id', (Var fn_id', depth), ty, floats, [])
-        where
-	  ty = exprType fun
-
-    ignore_note	(CoreNote _) = True 
-    ignore_note	InlineCall   = True
-    ignore_note	InlineMe     = True
-    ignore_note	_other       = False
-	-- We don't ignore SCCs, since they require some code generation
-
-------------------------------------------------------------------------------
--- Building the saturated syntax
--- ---------------------------------------------------------------------------
-
--- maybeSaturate deals with saturating primops and constructors
--- The type is the type of the entire application
-maybeSaturate :: Id -> CoreExpr -> Int -> Floats -> Type -> UniqSM (Floats, CoreExpr)
-maybeSaturate fn expr n_args floats ty
-  | Just DataToTagOp <- isPrimOpId_maybe fn	-- DataToTag must have an evaluated arg
-						-- A gruesome special case
-  = saturate_it		`thenUs` \ sat_expr ->
-
-	-- OK, now ensure that the arg is evaluated.
-	-- But (sigh) take into account the lambdas we've now introduced
-    let 
-	(eta_bndrs, eta_body) = collectBinders sat_expr
-    in
-    eval_data2tag_arg eta_body	`thenUs` \ (eta_floats, eta_body') -> 
-    if null eta_bndrs then
-	returnUs (floats `appendFloats` eta_floats, eta_body')
-    else
-	mkBinds eta_floats eta_body'		`thenUs` \ eta_body'' ->
-	returnUs (floats, mkLams eta_bndrs eta_body'')
-
-  | hasNoBinding fn = saturate_it	`thenUs` \ sat_expr ->
-		      returnUs (floats, sat_expr)
-
-  | otherwise       = returnUs (floats, expr)
-
-  where
-    fn_arity	 = idArity fn
-    excess_arity = fn_arity - n_args
-
-    saturate_it :: UniqSM CoreExpr
-    saturate_it | excess_arity == 0 = returnUs expr
-		| otherwise	    = getUniquesUs		`thenUs` \ us ->
-				      returnUs (etaExpand excess_arity us expr ty)
-
-	-- Ensure that the argument of DataToTagOp is evaluated
-    eval_data2tag_arg :: CoreExpr -> UniqSM (Floats, CoreExpr)
-    eval_data2tag_arg app@(fun `App` arg)
-	| exprIsHNF arg		-- Includes nullary constructors
-	= returnUs (emptyFloats, app)	-- The arg is evaluated
-	| otherwise			-- Arg not evaluated, so evaluate it
-	= newVar (exprType arg)		`thenUs` \ arg_id ->
-	  let 
-	     arg_id1 = setIdUnfolding arg_id evaldUnfolding
-	  in
-	  returnUs (unitFloat (FloatCase arg_id1 arg False ),
-		    fun `App` Var arg_id1)
-
-    eval_data2tag_arg (Note note app)	-- Scc notes can appear
-	= eval_data2tag_arg app		`thenUs` \ (floats, app') ->
-	  returnUs (floats, Note note app')
-
-    eval_data2tag_arg other	-- Should not happen
-	= pprPanic "eval_data2tag" (ppr other)
-
-
--- ---------------------------------------------------------------------------
--- Precipitating the floating bindings
--- ---------------------------------------------------------------------------
-
-floatRhs :: TopLevelFlag -> RecFlag
-	 -> Id
-	 -> (Floats, CoreExpr)	-- Rhs: let binds in body
-	 -> UniqSM (Floats, 	-- Floats out of this bind
-		    CoreExpr)	-- Final Rhs
-
-floatRhs top_lvl is_rec bndr (floats, rhs)
-  | isTopLevel top_lvl || exprIsHNF rhs,	-- Float to expose value or 
-    allLazy top_lvl is_rec floats 		-- at top level
-  = 	-- Why the test for allLazy? 
-	--	v = f (x `divInt#` y)
-	-- we don't want to float the case, even if f has arity 2,
-	-- because floating the case would make it evaluated too early
-    returnUs (floats, rhs)
-    
-  | otherwise
-	-- Don't float; the RHS isn't a value
-  = mkBinds floats rhs		`thenUs` \ rhs' ->
-    returnUs (emptyFloats, rhs')
-
--- mkLocalNonRec is used only for *nested*, *non-recursive* bindings
-mkLocalNonRec :: Id  -> RhsDemand 	-- Lhs: id with demand
-	      -> Floats -> CoreExpr	-- Rhs: let binds in body
-	      -> UniqSM (Floats, Id)	-- The new Id may have an evaldUnfolding, 
-					-- to record that it's been evaluated
-
-mkLocalNonRec bndr dem floats rhs
-  | isUnLiftedType (idType bndr)
-	-- If this is an unlifted binding, we always make a case for it.
-  = ASSERT( not (isUnboxedTupleType (idType bndr)) )
-    let
-	float = FloatCase bndr rhs (exprOkForSpeculation rhs)
-    in
-    returnUs (addFloat floats float, evald_bndr)
-
-  | isStrict dem 
-	-- It's a strict let so we definitely float all the bindings
- = let		-- Don't make a case for a value binding,
-		-- even if it's strict.  Otherwise we get
-		-- 	case (\x -> e) of ...!
-	float | exprIsHNF rhs = FloatLet (NonRec bndr rhs)
-	      | otherwise	= FloatCase bndr rhs (exprOkForSpeculation rhs)
-    in
-    returnUs (addFloat floats float, evald_bndr)
-
-  | otherwise
-  = floatRhs NotTopLevel NonRecursive bndr (floats, rhs)	`thenUs` \ (floats', rhs') ->
-    returnUs (addFloat floats' (FloatLet (NonRec bndr rhs')),
-	      if exprIsHNF rhs' then evald_bndr else bndr)
-
-  where
-    evald_bndr = bndr `setIdUnfolding` evaldUnfolding
-	-- Record if the binder is evaluated
-
-
-mkBinds :: Floats -> CoreExpr -> UniqSM CoreExpr
-mkBinds (Floats _ binds) body 
-  | isNilOL binds = returnUs body
-  | otherwise	  = deLam body		`thenUs` \ body' ->
-			-- Lambdas are not allowed as the body of a 'let'
-		    returnUs (foldrOL mk_bind body' binds)
-  where
-    mk_bind (FloatCase bndr rhs _) body = Case rhs bndr (exprType body) [(DEFAULT, [], body)]
-    mk_bind (FloatLet bind)        body = Let bind body
-
-etaExpandRhs bndr rhs
-  = 	-- Eta expand to match the arity claimed by the binder
-	-- Remember, after CorePrep we must not change arity
-	--
-	-- Eta expansion might not have happened already, 
-	-- because it is done by the simplifier only when 
-	-- there at least one lambda already.
-	-- 
-	-- NB1:we could refrain when the RHS is trivial (which can happen
-	--     for exported things).  This would reduce the amount of code
-	--     generated (a little) and make things a little words for
-	--     code compiled without -O.  The case in point is data constructor
-	--     wrappers.
-	--
-	-- NB2: we have to be careful that the result of etaExpand doesn't
-	--    invalidate any of the assumptions that CorePrep is attempting
-	--    to establish.  One possible cause is eta expanding inside of
-	--    an SCC note - we're now careful in etaExpand to make sure the
-	--    SCC is pushed inside any new lambdas that are generated.
-	--
-	-- NB3: It's important to do eta expansion, and *then* ANF-ising
-	--		f = /\a -> g (h 3)	-- h has arity 2
-	-- If we ANF first we get
-	--		f = /\a -> let s = h 3 in g s
-	-- and now eta expansion gives
-	-- 		f = /\a -> \ y -> (let s = h 3 in g s) y
-	-- which is horrible.
-	-- Eta expanding first gives
-	--		f = /\a -> \y -> let s = h 3 in g s y
-	--
-    getUniquesUs		`thenUs` \ us ->
-    returnUs (etaExpand arity us rhs (idType bndr))
-  where
-	-- For a GlobalId, take the Arity from the Id.
-	-- It was set in CoreTidy and must not change
-	-- For all others, just expand at will
-    arity | isGlobalId bndr = idArity bndr
-	  | otherwise	    = exprArity rhs
-
--- ---------------------------------------------------------------------------
--- Eliminate Lam as a non-rhs (STG doesn't have such a thing)
--- We arrange that they only show up as the RHS of a let(rec)
--- ---------------------------------------------------------------------------
-
-deLam :: CoreExpr -> UniqSM CoreExpr
-deLam expr = 
-  deLamFloat expr   `thenUs` \ (floats, expr) ->
-  mkBinds floats expr
-
-
-deLamFloat :: CoreExpr -> UniqSM (Floats, CoreExpr)
--- Remove top level lambdas by let-bindinig
-
-deLamFloat (Note n expr)
-  =	-- You can get things like
-	-- 	case e of { p -> coerce t (\s -> ...) }
-    deLamFloat expr	`thenUs` \ (floats, expr') ->
-    returnUs (floats, Note n expr')
-
-deLamFloat expr 
-  | null bndrs = returnUs (emptyFloats, expr)
-  | otherwise 
-  = case tryEta bndrs body of
-      Just no_lam_result -> returnUs (emptyFloats, no_lam_result)
-      Nothing	         -> newVar (exprType expr)	`thenUs` \ fn ->
-			    returnUs (unitFloat (FloatLet (NonRec fn expr)), 
-				      Var fn)
-  where
-    (bndrs,body) = collectBinders expr
-
--- Why try eta reduction?  Hasn't the simplifier already done eta?
--- But the simplifier only eta reduces if that leaves something
--- trivial (like f, or f Int).  But for deLam it would be enough to
--- get to a partial application, like (map f).
-
-tryEta bndrs expr@(App _ _)
-  | ok_to_eta_reduce f &&
-    n_remaining >= 0 &&
-    and (zipWith ok bndrs last_args) &&
-    not (any (`elemVarSet` fvs_remaining) bndrs)
-  = Just remaining_expr
-  where
-    (f, args) = collectArgs expr
-    remaining_expr = mkApps f remaining_args
-    fvs_remaining = exprFreeVars remaining_expr
-    (remaining_args, last_args) = splitAt n_remaining args
-    n_remaining = length args - length bndrs
-
-    ok bndr (Var arg) = bndr == arg
-    ok bndr other     = False
-
-	  -- we can't eta reduce something which must be saturated.
-    ok_to_eta_reduce (Var f) = not (hasNoBinding f)
-    ok_to_eta_reduce _       = False --safe. ToDo: generalise
-
-tryEta bndrs (Let bind@(NonRec b r) body)
-  | not (any (`elemVarSet` fvs) bndrs)
-  = case tryEta bndrs body of
-	Just e -> Just (Let bind e)
-	Nothing -> Nothing
-  where
-    fvs = exprFreeVars r
-
-tryEta bndrs _ = Nothing
-\end{code}
-
-
--- -----------------------------------------------------------------------------
--- Demands
--- -----------------------------------------------------------------------------
-
-\begin{code}
-data RhsDemand
-     = RhsDemand { isStrict :: Bool,  -- True => used at least once
-                   isOnceDem   :: Bool   -- True => used at most once
-                 }
-
-mkDem :: Demand -> Bool -> RhsDemand
-mkDem strict once = RhsDemand (isStrictDmd strict) once
-
-mkDemTy :: Demand -> Type -> RhsDemand
-mkDemTy strict ty = RhsDemand (isStrictDmd strict) 
-			      False {- For now -}
-
-bdrDem :: Id -> RhsDemand
-bdrDem id = mkDem (idNewDemandInfo id)
-		  False {- For now -}
-
--- safeDem :: RhsDemand
--- safeDem = RhsDemand False False  -- always safe to use this
-
-onceDem :: RhsDemand
-onceDem = RhsDemand False True   -- used at most once
-\end{code}
-
-
-
-
-%************************************************************************
-%*									*
-\subsection{Cloning}
-%*									*
-%************************************************************************
-
-\begin{code}
--- ---------------------------------------------------------------------------
--- 			The environment
--- ---------------------------------------------------------------------------
-
-data CorePrepEnv = CPE (IdEnv Id)	-- Clone local Ids
-		       Bool		-- True <=> inside a GADT case; see Note [GADT]
-
--- Note [GADT]
---
--- Be careful with cloning inside GADTs.  For example, 
---	/\a. \f::a. \x::T a. case x of { T -> f True; ... }
--- The case on x may refine the type of f to be a function type.
--- Without this type refinement, exprType (f True) may simply fail,
--- which is bad.  
---
--- Solution: remember when we are inside a potentially-type-refining case,
--- 	     and in that situation use the type from the old occurrence
---	     when looking up occurrences
-
-emptyCorePrepEnv :: CorePrepEnv
-emptyCorePrepEnv = CPE emptyVarEnv False
-
-extendCorePrepEnv :: CorePrepEnv -> Id -> Id -> CorePrepEnv
-extendCorePrepEnv (CPE env gadt) id id' = CPE (extendVarEnv env id id') gadt
-
-lookupCorePrepEnv :: CorePrepEnv -> Id -> Id
--- See Note [GADT] above
-lookupCorePrepEnv (CPE env gadt) id
-  = case lookupVarEnv env id of
-	Nothing		     -> id
-	Just id' | gadt      -> setIdType id' (idType id)
-		 | otherwise -> id'
-
-setGadt :: CorePrepEnv -> AltCon -> CorePrepEnv
-setGadt env@(CPE id_env _) (DataAlt data_con) | not (isVanillaDataCon data_con) = CPE id_env True
-setGadt env 		   other 						= env
-
-
-------------------------------------------------------------------------------
--- Cloning binders
--- ---------------------------------------------------------------------------
-
-cloneBndrs :: CorePrepEnv -> [Var] -> UniqSM (CorePrepEnv, [Var])
-cloneBndrs env bs = mapAccumLUs cloneBndr env bs
-
-cloneBndr  :: CorePrepEnv -> Var -> UniqSM (CorePrepEnv, Var)
-cloneBndr env bndr
-  | isLocalId bndr
-  = getUniqueUs   `thenUs` \ uniq ->
-    let
-	bndr' = setVarUnique bndr uniq
-    in
-    returnUs (extendCorePrepEnv env bndr bndr', bndr')
-
-  | otherwise	-- Top level things, which we don't want
-		-- to clone, have become GlobalIds by now
-		-- And we don't clone tyvars
-  = returnUs (env, bndr)
-  
-
-------------------------------------------------------------------------------
--- Cloning ccall Ids; each must have a unique name,
--- to give the code generator a handle to hang it on
--- ---------------------------------------------------------------------------
-
-fiddleCCall :: Id -> UniqSM Id
-fiddleCCall id 
-  | isFCallId id = getUniqueUs   	`thenUs` \ uniq ->
-		   returnUs (id `setVarUnique` uniq)
-  | otherwise    = returnUs id
-
-------------------------------------------------------------------------------
--- Generating new binders
--- ---------------------------------------------------------------------------
-
-newVar :: Type -> UniqSM Id
-newVar ty
- = seqType ty			`seq`
-   getUniqueUs	 		`thenUs` \ uniq ->
-   returnUs (mkSysLocal FSLIT("sat") uniq ty)
-\end{code}
diff --git a/ghc/compiler/coreSyn/CoreSubst.lhs b/ghc/compiler/coreSyn/CoreSubst.lhs
deleted file mode 100644
index c432d55f94..0000000000
--- a/ghc/compiler/coreSyn/CoreSubst.lhs
+++ /dev/null
@@ -1,393 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[CoreUtils]{Utility functions on @Core@ syntax}
-
-\begin{code}
-module CoreSubst (
-	-- Substitution stuff
-	Subst, TvSubstEnv, IdSubstEnv, InScopeSet,
-
-	substTy, substExpr, substSpec, substWorker,
-	lookupIdSubst, lookupTvSubst, 
-
-	emptySubst, mkEmptySubst, mkSubst, substInScope, isEmptySubst, 
- 	extendIdSubst, extendIdSubstList, extendTvSubst, extendTvSubstList,
-	extendInScope, extendInScopeIds,
-	isInScope,
-
-	-- Binders
-	substBndr, substBndrs, substRecBndrs,
-	cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs
-    ) where
-
-#include "HsVersions.h"
-
-import CoreSyn		( Expr(..), Bind(..), Note(..), CoreExpr,
-			  CoreRule(..), hasUnfolding, noUnfolding
-			)
-import CoreFVs		( exprFreeVars )
-import CoreUtils	( exprIsTrivial )
-
-import qualified Type	( substTy, substTyVarBndr )
-import Type		( Type, tyVarsOfType, TvSubstEnv, TvSubst(..), mkTyVarTy )
-import VarSet
-import VarEnv
-import Var		( setVarUnique, isId )
-import Id		( idType, setIdType, maybeModifyIdInfo, isLocalId )
-import IdInfo		( IdInfo, SpecInfo(..), specInfo, setSpecInfo, isEmptySpecInfo,
-			  unfoldingInfo, setUnfoldingInfo, seqSpecInfo,
-			  WorkerInfo(..), workerExists, workerInfo, setWorkerInfo
-			)
-import Unique		( Unique )
-import UniqSupply	( UniqSupply, uniqFromSupply, uniqsFromSupply )
-import Var		( Var, Id, TyVar, isTyVar )
-import Maybes		( orElse )
-import Outputable
-import PprCore		()		-- Instances
-import Util		( mapAccumL )
-import FastTypes
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Substitutions}
-%*									*
-%************************************************************************
-
-\begin{code}
-data Subst 
-  = Subst InScopeSet	-- Variables in in scope (both Ids and TyVars)
-	  IdSubstEnv	-- Substitution for Ids
-	  TvSubstEnv	-- Substitution for TyVars
-
-	-- INVARIANT 1: The (domain of the) in-scope set is a superset
-	-- 	        of the free vars of the range of the substitution
-	--		that might possibly clash with locally-bound variables
-	--		in the thing being substituted in.
-	-- This is what lets us deal with name capture properly
-	-- It's a hard invariant to check...
-	-- There are various ways of causing it to happen:
-	--	- arrange that the in-scope set really is all the things in scope
-	--	- arrange that it's the free vars of the range of the substitution
-	--	- make it empty because all the free vars of the subst are fresh,
-	--		and hence can't possibly clash.a
-	--
-	-- INVARIANT 2: The substitution is apply-once; see notes with
-	--		Types.TvSubstEnv
-
-type IdSubstEnv = IdEnv CoreExpr
-
-----------------------------
-isEmptySubst :: Subst -> Bool
-isEmptySubst (Subst _ id_env tv_env) = isEmptyVarEnv id_env && isEmptyVarEnv tv_env
-
-emptySubst :: Subst
-emptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv
-
-mkEmptySubst :: InScopeSet -> Subst
-mkEmptySubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv
-
-mkSubst :: InScopeSet -> TvSubstEnv -> IdSubstEnv -> Subst
-mkSubst in_scope tvs ids = Subst in_scope ids tvs
-
--- getTvSubst :: Subst -> TvSubst
--- getTvSubst (Subst in_scope _ tv_env) = TvSubst in_scope tv_env
-
--- getTvSubstEnv :: Subst -> TvSubstEnv
--- getTvSubstEnv (Subst _ _ tv_env) = tv_env
--- 
--- setTvSubstEnv :: Subst -> TvSubstEnv -> Subst
--- setTvSubstEnv (Subst in_scope ids _) tvs = Subst in_scope ids tvs
-
-substInScope :: Subst -> InScopeSet
-substInScope (Subst in_scope _ _) = in_scope
-
--- zapSubstEnv :: Subst -> Subst
--- zapSubstEnv (Subst in_scope _ _) = Subst in_scope emptyVarEnv emptyVarEnv
-
--- ToDo: add an ASSERT that fvs(subst-result) is already in the in-scope set
-extendIdSubst :: Subst -> Id -> CoreExpr -> Subst
-extendIdSubst (Subst in_scope ids tvs) v r = Subst in_scope (extendVarEnv ids v r) tvs
-
-extendIdSubstList :: Subst -> [(Id, CoreExpr)] -> Subst
-extendIdSubstList (Subst in_scope ids tvs) prs = Subst in_scope (extendVarEnvList ids prs) tvs
-
-extendTvSubst :: Subst -> TyVar -> Type -> Subst
-extendTvSubst (Subst in_scope ids tvs) v r = Subst in_scope ids (extendVarEnv tvs v r) 
-
-extendTvSubstList :: Subst -> [(TyVar,Type)] -> Subst
-extendTvSubstList (Subst in_scope ids tvs) prs = Subst in_scope ids (extendVarEnvList tvs prs)
-
-lookupIdSubst :: Subst -> Id -> CoreExpr
-lookupIdSubst (Subst in_scope ids tvs) v 
-  | not (isLocalId v) = Var v
-  | otherwise
-  = case lookupVarEnv ids v of {
-	Just e  -> e ;
-	Nothing -> 	
-    case lookupInScope in_scope v of {
-	-- Watch out!  Must get the Id from the in-scope set,
-	-- because its type there may differ
-	Just v  -> Var v ;
-	Nothing -> WARN( True, ptext SLIT("CoreSubst.lookupIdSubst") <+> ppr v ) 
-		   Var v
-    }}
-
-lookupTvSubst :: Subst -> TyVar -> Type
-lookupTvSubst (Subst _ ids tvs) v = lookupVarEnv tvs v `orElse` mkTyVarTy v
-
-------------------------------
-isInScope :: Var -> Subst -> Bool
-isInScope v (Subst in_scope _ _) = v `elemInScopeSet` in_scope
-
-extendInScope :: Subst -> Var -> Subst
-extendInScope (Subst in_scope ids tvs) v
-  = Subst (in_scope `extendInScopeSet` v) 
-	  (ids `delVarEnv` v) (tvs `delVarEnv` v)
-
-extendInScopeIds :: Subst -> [Id] -> Subst
-extendInScopeIds (Subst in_scope ids tvs) vs 
-  = Subst (in_scope `extendInScopeSetList` vs) 
-	  (ids `delVarEnvList` vs) tvs
-\end{code}
-
-Pretty printing, for debugging only
-
-\begin{code}
-instance Outputable Subst where
-  ppr (Subst in_scope ids tvs) 
-	=  ptext SLIT("<InScope =") <+> braces (fsep (map ppr (varEnvElts (getInScopeVars in_scope))))
-	$$ ptext SLIT(" IdSubst   =") <+> ppr ids
-	$$ ptext SLIT(" TvSubst   =") <+> ppr tvs
- 	 <> char '>'
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Substituting expressions
-%*									*
-%************************************************************************
-
-\begin{code}
-substExpr :: Subst -> CoreExpr -> CoreExpr
-substExpr subst expr
-  = go expr
-  where
-    go (Var v)	       = lookupIdSubst subst v 
-    go (Type ty)       = Type (substTy subst ty)
-    go (Lit lit)       = Lit lit
-    go (App fun arg)   = App (go fun) (go arg)
-    go (Note note e)   = Note (go_note note) (go e)
-    go (Lam bndr body) = Lam bndr' (substExpr subst' body)
-		       where
-			 (subst', bndr') = substBndr subst bndr
-
-    go (Let (NonRec bndr rhs) body) = Let (NonRec bndr' (go rhs)) (substExpr subst' body)
-				    where
-				      (subst', bndr') = substBndr subst bndr
-
-    go (Let (Rec pairs) body) = Let (Rec pairs') (substExpr subst' body)
-			      where
-				(subst', bndrs') = substRecBndrs subst (map fst pairs)
-				pairs'	= bndrs' `zip` rhss'
-				rhss'	= map (substExpr subst' . snd) pairs
-
-    go (Case scrut bndr ty alts) = Case (go scrut) bndr' (substTy subst ty) (map (go_alt subst') alts)
-			         where
-			  	 (subst', bndr') = substBndr subst bndr
-
-    go_alt subst (con, bndrs, rhs) = (con, bndrs', substExpr subst' rhs)
-				 where
-				   (subst', bndrs') = substBndrs subst bndrs
-
-    go_note (Coerce ty1 ty2) = Coerce (substTy subst ty1) (substTy subst ty2)
-    go_note note	     = note
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Substituting binders
-%*									*
-%************************************************************************
-
-Remember that substBndr and friends are used when doing expression
-substitution only.  Their only business is substitution, so they
-preserve all IdInfo (suitably substituted).  For example, we *want* to
-preserve occ info in rules.
-
-\begin{code}
-substBndr :: Subst -> Var -> (Subst, Var)
-substBndr subst bndr
-  | isTyVar bndr  = substTyVarBndr subst bndr
-  | otherwise     = substIdBndr subst subst bndr
-
-substBndrs :: Subst -> [Var] -> (Subst, [Var])
-substBndrs subst bndrs = mapAccumL substBndr subst bndrs
-
-substRecBndrs :: Subst -> [Id] -> (Subst, [Id])
--- Substitute a mutually recursive group
-substRecBndrs subst bndrs 
-  = (new_subst, new_bndrs)
-  where		-- Here's the reason we need to pass rec_subst to subst_id
-    (new_subst, new_bndrs) = mapAccumL (substIdBndr new_subst) subst bndrs
-\end{code}
-
-
-\begin{code}
-substIdBndr :: Subst		-- Substitution to use for the IdInfo
-	    -> Subst -> Id 	-- Substitition and Id to transform
-	    -> (Subst, Id)	-- Transformed pair
-
-substIdBndr rec_subst subst@(Subst in_scope env tvs) old_id
-  = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
-  where
-    id1 = uniqAway in_scope old_id	-- id1 is cloned if necessary
-    id2 = substIdType subst id1		-- id2 has its type zapped
-
-	-- new_id has the right IdInfo
-	-- The lazy-set is because we're in a loop here, with 
-	-- rec_subst, when dealing with a mutually-recursive group
-    new_id = maybeModifyIdInfo (substIdInfo rec_subst) id2
-
-	-- Extend the substitution if the unique has changed
-	-- See the notes with substTyVarBndr for the delVarEnv
-    new_env | new_id /= old_id  = extendVarEnv env old_id (Var new_id)
-	    | otherwise         = delVarEnv env old_id
-\end{code}
-
-Now a variant that unconditionally allocates a new unique.
-It also unconditionally zaps the OccInfo.
-
-\begin{code}
-cloneIdBndr :: Subst -> UniqSupply -> Id -> (Subst, Id)
-cloneIdBndr subst us old_id
-  = clone_id subst subst (old_id, uniqFromSupply us)
-
-cloneIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
-cloneIdBndrs subst us ids
-  = mapAccumL (clone_id subst) subst (ids `zip` uniqsFromSupply us)
-
-cloneRecIdBndrs :: Subst -> UniqSupply -> [Id] -> (Subst, [Id])
-cloneRecIdBndrs subst us ids
-  = (subst', ids')
-  where
-    (subst', ids') = mapAccumL (clone_id subst') subst
-			       (ids `zip` uniqsFromSupply us)
-
--- Just like substIdBndr, except that it always makes a new unique
--- It is given the unique to use
-clone_id    :: Subst			-- Substitution for the IdInfo
-	    -> Subst -> (Id, Unique)	-- Substitition and Id to transform
-	    -> (Subst, Id)		-- Transformed pair
-
-clone_id rec_subst subst@(Subst in_scope env tvs) (old_id, uniq)
-  = (Subst (in_scope `extendInScopeSet` new_id) new_env tvs, new_id)
-  where
-    id1	    = setVarUnique old_id uniq
-    id2     = substIdType subst id1
-    new_id  = maybeModifyIdInfo (substIdInfo rec_subst) id2
-    new_env = extendVarEnv env old_id (Var new_id)
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Types
-%*									*
-%************************************************************************
-
-For types we just call the corresponding function in Type, but we have
-to repackage the substitution, from a Subst to a TvSubst
-
-\begin{code}
-substTyVarBndr :: Subst -> TyVar -> (Subst, TyVar)
-substTyVarBndr (Subst in_scope id_env tv_env) tv
-  = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
-	(TvSubst in_scope' tv_env', tv') 
-	   -> (Subst in_scope' id_env tv_env', tv')
-
-substTy :: Subst -> Type -> Type 
-substTy (Subst in_scope id_env tv_env) ty 
-  = Type.substTy (TvSubst in_scope tv_env) ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-\section{IdInfo substitution}
-%*									*
-%************************************************************************
-
-\begin{code}
-substIdType :: Subst -> Id -> Id
-substIdType subst@(Subst in_scope id_env tv_env) id
-  | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
-  | otherwise	= setIdType id (substTy subst old_ty)
-		-- The tyVarsOfType is cheaper than it looks
-		-- because we cache the free tyvars of the type
-		-- in a Note in the id's type itself
-  where
-    old_ty = idType id
-
-------------------
-substIdInfo :: Subst -> IdInfo -> Maybe IdInfo
--- Always zaps the unfolding, to save substitution work
-substIdInfo  subst info
-  | nothing_to_do = Nothing
-  | otherwise     = Just (info `setSpecInfo`   	  substSpec  subst old_rules
-			       `setWorkerInfo` 	  substWorker subst old_wrkr
-			       `setUnfoldingInfo` noUnfolding)
-  where
-    old_rules 	  = specInfo info
-    old_wrkr  	  = workerInfo info
-    nothing_to_do = isEmptySpecInfo old_rules &&
-		    not (workerExists old_wrkr) &&
-		    not (hasUnfolding (unfoldingInfo info))
-    
-
-------------------
-substWorker :: Subst -> WorkerInfo -> WorkerInfo
-	-- Seq'ing on the returned WorkerInfo is enough to cause all the 
-	-- substitutions to happen completely
-
-substWorker subst NoWorker
-  = NoWorker
-substWorker subst (HasWorker w a)
-  = case lookupIdSubst subst w of
-	Var w1 -> HasWorker w1 a
-	other  -> WARN( not (exprIsTrivial other), text "CoreSubst.substWorker:" <+> ppr w )
-		  NoWorker	-- Worker has got substituted away altogether
-				-- (This can happen if it's trivial, 
-				--  via postInlineUnconditionally, hence warning)
-
-------------------
-substSpec :: Subst -> SpecInfo -> SpecInfo
-
-substSpec subst spec@(SpecInfo rules rhs_fvs)
-  | isEmptySubst subst
-  = spec
-  | otherwise
-  = seqSpecInfo new_rules `seq` new_rules
-  where
-    new_rules = SpecInfo (map do_subst rules) (substVarSet subst rhs_fvs)
-
-    do_subst rule@(BuiltinRule {}) = rule
-    do_subst rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs })
-	= rule { ru_bndrs = bndrs',
-		 ru_args  = map (substExpr subst') args,
-		 ru_rhs   = substExpr subst' rhs }
-	where
-	  (subst', bndrs') = substBndrs subst bndrs
-
-------------------
-substVarSet subst fvs 
-  = foldVarSet (unionVarSet . subst_fv subst) emptyVarSet fvs
-  where
-    subst_fv subst fv 
-	| isId fv   = exprFreeVars (lookupIdSubst subst fv)
-	| otherwise = tyVarsOfType (lookupTvSubst subst fv)
-\end{code}
diff --git a/ghc/compiler/coreSyn/CoreSyn.hi-boot-5 b/ghc/compiler/coreSyn/CoreSyn.hi-boot-5
deleted file mode 100644
index 6031131f33..0000000000
--- a/ghc/compiler/coreSyn/CoreSyn.hi-boot-5
+++ /dev/null
@@ -1,6 +0,0 @@
-__interface CoreSyn 1 0 where
-__export CoreSyn CoreExpr ;
-
--- Needed by Var.lhs
-1 type CoreExpr = Expr Var.Var;
-1 data Expr b ;
diff --git a/ghc/compiler/coreSyn/CoreSyn.hi-boot-6 b/ghc/compiler/coreSyn/CoreSyn.hi-boot-6
deleted file mode 100644
index 38dc8c7f7e..0000000000
--- a/ghc/compiler/coreSyn/CoreSyn.hi-boot-6
+++ /dev/null
@@ -1,5 +0,0 @@
-module CoreSyn where
-
--- Needed by Var.lhs
-data Expr b
-type CoreExpr = Expr Var.Var
diff --git a/ghc/compiler/coreSyn/CoreSyn.lhs b/ghc/compiler/coreSyn/CoreSyn.lhs
deleted file mode 100644
index 201d866834..0000000000
--- a/ghc/compiler/coreSyn/CoreSyn.lhs
+++ /dev/null
@@ -1,695 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[CoreSyn]{A data type for the Haskell compiler midsection}
-
-\begin{code}
-module CoreSyn (
-	Expr(..), Alt, Bind(..), AltCon(..), Arg, Note(..),
-	CoreExpr, CoreAlt, CoreBind, CoreArg, CoreBndr,
-	TaggedExpr, TaggedAlt, TaggedBind, TaggedArg, TaggedBndr(..),
-
-	mkLets, mkLams, 
-	mkApps, mkTyApps, mkValApps, mkVarApps,
-	mkLit, mkIntLitInt, mkIntLit, 
-	mkConApp, 
-	varToCoreExpr,
-
-	isTyVar, isId, cmpAltCon, cmpAlt, ltAlt,
-	bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, 
-	collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
-	collectArgs, 
-	coreExprCc,
-	flattenBinds, 
-
-	isValArg, isTypeArg, valArgCount, valBndrCount, isRuntimeArg, isRuntimeVar,
-
-	-- Unfoldings
-	Unfolding(..),	UnfoldingGuidance(..), 	-- Both abstract everywhere but in CoreUnfold.lhs
-	noUnfolding, evaldUnfolding, mkOtherCon,
-	unfoldingTemplate, maybeUnfoldingTemplate, otherCons, 
-	isValueUnfolding, isEvaldUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
-	hasUnfolding, hasSomeUnfolding, neverUnfold,
-
-	-- Seq stuff
-	seqExpr, seqExprs, seqUnfolding, 
-
-	-- Annotated expressions
-	AnnExpr, AnnExpr'(..), AnnBind(..), AnnAlt, 
-	deAnnotate, deAnnotate', deAnnAlt, collectAnnBndrs,
-
-	-- Core rules
-	CoreRule(..),	-- CoreSubst, CoreTidy, CoreFVs, PprCore only
-	RuleName, seqRules, 
-	isBuiltinRule, ruleName, isLocalRule, ruleIdName
-    ) where
-
-#include "HsVersions.h"
-
-import StaticFlags	( opt_RuntimeTypes )
-import CostCentre	( CostCentre, noCostCentre )
-import Var		( Var, Id, TyVar, isTyVar, isId )
-import Type		( Type, mkTyVarTy, seqType )
-import Name		( Name )
-import OccName		( OccName )
-import Literal	        ( Literal, mkMachInt )
-import DataCon		( DataCon, dataConWorkId, dataConTag )
-import BasicTypes	( Activation )
-import FastString
-import Outputable
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The main data types}
-%*									*
-%************************************************************************
-
-These data types are the heart of the compiler
-
-\begin{code}
-infixl 8 `App`	-- App brackets to the left
-
-data Expr b	-- "b" for the type of binders, 
-  = Var	  Id
-  | Lit   Literal
-  | App   (Expr b) (Arg b)
-  | Lam   b (Expr b)
-  | Let   (Bind b) (Expr b)
-  | Case  (Expr b) b Type [Alt b]  	-- Binder gets bound to value of scrutinee
-	-- Invariant: The list of alternatives is ALWAYS EXHAUSTIVE,
-	--	      meaning that it covers all cases that can occur
-	--	      See the example below
-	--
-	-- Invariant: The DEFAULT case must be *first*, if it occurs at all
-	-- Invariant: The remaining cases are in order of increasing 
-	--		tag	(for DataAlts)
-	--		lit	(for LitAlts)
-	--	      This makes finding the relevant constructor easy,
-	--	      and makes comparison easier too
-  | Note  Note (Expr b)
-  | Type  Type			-- This should only show up at the top
-				-- level of an Arg
-
--- An "exhausive" case does not necessarily mention all constructors:
---	data Foo = Red | Green | Blue
---
---	...case x of 
---		Red   -> True
---		other -> f (case x of 
---				Green -> ...
---				Blue  -> ... )
--- The inner case does not need a Red alternative, because x can't be Red at
--- that program point.
-
-
-type Arg b = Expr b		-- Can be a Type
-
-type Alt b = (AltCon, [b], Expr b)	-- (DEFAULT, [], rhs) is the default alternative
-
-data AltCon = DataAlt DataCon
-	    | LitAlt  Literal
-	    | DEFAULT
-	 deriving (Eq, Ord)
-
-
-data Bind b = NonRec b (Expr b)
-	      | Rec [(b, (Expr b))]
-
-data Note
-  = SCC CostCentre
-
-  | Coerce	
-	Type		-- The to-type:   type of whole coerce expression
-	Type		-- The from-type: type of enclosed expression
-
-  | InlineCall		-- Instructs simplifier to inline
-			-- the enclosed call
-
-  | InlineMe		-- Instructs simplifer to treat the enclosed expression
-			-- as very small, and inline it at its call sites
-
-  | CoreNote String     -- A generic core annotation, propagated but not used by GHC
-
--- NOTE: we also treat expressions wrapped in InlineMe as
--- 'cheap' and 'dupable' (in the sense of exprIsCheap, exprIsDupable)
--- What this means is that we obediently inline even things that don't
--- look like valuse.  This is sometimes important:
---	{-# INLINE f #-}
---	f = g . h
--- Here, f looks like a redex, and we aren't going to inline (.) because it's
--- inside an INLINE, so it'll stay looking like a redex.  Nevertheless, we 
--- should inline f even inside lambdas.  In effect, we should trust the programmer.
-\end{code}
-
-INVARIANTS:
-
-* The RHS of a letrec, and the RHSs of all top-level lets,
-  must be of LIFTED type.
-
-* The RHS of a let, may be of UNLIFTED type, but only if the expression 
-  is ok-for-speculation.  This means that the let can be floated around 
-  without difficulty.  e.g.
-	y::Int# = x +# 1#	ok
-	y::Int# = fac 4#	not ok [use case instead]
-
-* The argument of an App can be of any type.
-
-* The simplifier tries to ensure that if the RHS of a let is a constructor
-  application, its arguments are trivial, so that the constructor can be
-  inlined vigorously.
-
-
-%************************************************************************
-%*									*
-\subsection{Transformation rules}
-%*									*
-%************************************************************************
-
-The CoreRule type and its friends are dealt with mainly in CoreRules,
-but CoreFVs, Subst, PprCore, CoreTidy also inspect the representation.
-
-A Rule is 
-
-  "local"  if the function it is a rule for is defined in the
-	   same module as the rule itself.
-
-  "orphan" if nothing on the LHS is defined in the same module
-	   as the rule itself
-
-\begin{code}
-type RuleName = FastString
-
-data CoreRule
-  = Rule { 
-	ru_name :: RuleName,
-	ru_act  :: Activation,	-- When the rule is active
-	
-	-- Rough-matching stuff
-	-- see comments with InstEnv.Instance( is_cls, is_rough )
-	ru_fn    :: Name,	-- Name of the Id at the head of this rule
-	ru_rough :: [Maybe Name],	-- Name at the head of each argument
-	
-	-- Proper-matching stuff
-	-- see comments with InstEnv.Instance( is_tvs, is_tys )
-	ru_bndrs :: [CoreBndr],	-- Forall'd variables
-	ru_args  :: [CoreExpr],	-- LHS args
-	
-	-- And the right-hand side
-	ru_rhs   :: CoreExpr,
-
-	-- Locality
-	ru_local :: Bool,	-- The fn at the head of the rule is
-				-- defined in the same module as the rule
-
-	-- Orphan-hood; see comments is InstEnv.Instance( is_orph )
-	ru_orph  :: Maybe OccName }
-
-  | BuiltinRule {		-- Built-in rules are used for constant folding
-	ru_name :: RuleName,	-- and suchlike.  It has no free variables.
-	ru_fn :: Name,		-- Name of the Id at 
-				-- the head of this rule
-	ru_try  :: [CoreExpr] -> Maybe CoreExpr }
-
-isBuiltinRule (BuiltinRule {}) = True
-isBuiltinRule _		       = False
-
-ruleName :: CoreRule -> RuleName
-ruleName = ru_name
-
-ruleIdName :: CoreRule -> Name
-ruleIdName = ru_fn
-
-isLocalRule :: CoreRule -> Bool
-isLocalRule = ru_local
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Unfoldings
-%*									*
-%************************************************************************
-
-The @Unfolding@ type is declared here to avoid numerous loops, but it
-should be abstract everywhere except in CoreUnfold.lhs
-
-\begin{code}
-data Unfolding
-  = NoUnfolding
-
-  | OtherCon [AltCon]		-- It ain't one of these
-				-- (OtherCon xs) also indicates that something has been evaluated
-				-- and hence there's no point in re-evaluating it.
-				-- OtherCon [] is used even for non-data-type values
-				-- to indicated evaluated-ness.  Notably:
-				--	data C = C !(Int -> Int)
-				-- 	case x of { C f -> ... }
-				-- Here, f gets an OtherCon [] unfolding.
-
-  | CompulsoryUnfolding CoreExpr	-- There is no "original" definition,
-					-- so you'd better unfold.
-
-  | CoreUnfolding			-- An unfolding with redundant cached information
-		CoreExpr		-- Template; binder-info is correct
-		Bool			-- True <=> top level binding
-		Bool			-- exprIsHNF template (cached); it is ok to discard a `seq` on
-					--	this variable
-		Bool			-- True <=> doesn't waste (much) work to expand inside an inlining
-					-- 	Basically it's exprIsCheap
-		UnfoldingGuidance	-- Tells about the *size* of the template.
-
-
-data UnfoldingGuidance
-  = UnfoldNever
-  | UnfoldIfGoodArgs	Int	-- and "n" value args
-
-			[Int]	-- Discount if the argument is evaluated.
-				-- (i.e., a simplification will definitely
-				-- be possible).  One elt of the list per *value* arg.
-
-			Int	-- The "size" of the unfolding; to be elaborated
-				-- later. ToDo
-
-			Int	-- Scrutinee discount: the discount to substract if the thing is in
-				-- a context (case (thing args) of ...),
-				-- (where there are the right number of arguments.)
-
-noUnfolding    = NoUnfolding
-evaldUnfolding = OtherCon []
-
-mkOtherCon = OtherCon
-
-seqUnfolding :: Unfolding -> ()
-seqUnfolding (CoreUnfolding e top b1 b2 g)
-  = seqExpr e `seq` top `seq` b1 `seq` b2 `seq` seqGuidance g
-seqUnfolding other = ()
-
-seqGuidance (UnfoldIfGoodArgs n ns a b) = n `seq` sum ns `seq` a `seq` b `seq` ()
-seqGuidance other			= ()
-\end{code}
-
-\begin{code}
-unfoldingTemplate :: Unfolding -> CoreExpr
-unfoldingTemplate (CoreUnfolding expr _ _ _ _) = expr
-unfoldingTemplate (CompulsoryUnfolding expr)   = expr
-unfoldingTemplate other = panic "getUnfoldingTemplate"
-
-maybeUnfoldingTemplate :: Unfolding -> Maybe CoreExpr
-maybeUnfoldingTemplate (CoreUnfolding expr _ _ _ _) = Just expr
-maybeUnfoldingTemplate (CompulsoryUnfolding expr)   = Just expr
-maybeUnfoldingTemplate other 			    = Nothing
-
-otherCons :: Unfolding -> [AltCon]
-otherCons (OtherCon cons) = cons
-otherCons other		  = []
-
-isValueUnfolding :: Unfolding -> Bool
-	-- Returns False for OtherCon
-isValueUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
-isValueUnfolding other			          = False
-
-isEvaldUnfolding :: Unfolding -> Bool
-	-- Returns True for OtherCon
-isEvaldUnfolding (OtherCon _)		          = True
-isEvaldUnfolding (CoreUnfolding _ _ is_evald _ _) = is_evald
-isEvaldUnfolding other			          = False
-
-isCheapUnfolding :: Unfolding -> Bool
-isCheapUnfolding (CoreUnfolding _ _ _ is_cheap _) = is_cheap
-isCheapUnfolding other			  	  = False
-
-isCompulsoryUnfolding :: Unfolding -> Bool
-isCompulsoryUnfolding (CompulsoryUnfolding _) = True
-isCompulsoryUnfolding other		      = False
-
-hasUnfolding :: Unfolding -> Bool
-hasUnfolding (CoreUnfolding _ _ _ _ _) = True
-hasUnfolding (CompulsoryUnfolding _)   = True
-hasUnfolding other 	 	       = False
-
-hasSomeUnfolding :: Unfolding -> Bool
-hasSomeUnfolding NoUnfolding = False
-hasSomeUnfolding other	     = True
-
-neverUnfold :: Unfolding -> Bool
-neverUnfold NoUnfolding				= True
-neverUnfold (OtherCon _)			= True
-neverUnfold (CoreUnfolding _ _ _ _ UnfoldNever) = True
-neverUnfold other 				= False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The main data type}
-%*									*
-%************************************************************************
-
-\begin{code}
--- The Ord is needed for the FiniteMap used in the lookForConstructor
--- in SimplEnv.  If you declared that lookForConstructor *ignores*
--- constructor-applications with LitArg args, then you could get
--- rid of this Ord.
-
-instance Outputable AltCon where
-  ppr (DataAlt dc) = ppr dc
-  ppr (LitAlt lit) = ppr lit
-  ppr DEFAULT      = ptext SLIT("__DEFAULT")
-
-instance Show AltCon where
-  showsPrec p con = showsPrecSDoc p (ppr con)
-
-cmpAlt :: Alt b -> Alt b -> Ordering
-cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
-
-ltAlt :: Alt b -> Alt b -> Bool
-ltAlt a1 a2 = case a1 `cmpAlt` a2 of { LT -> True; other -> False }
-
-cmpAltCon :: AltCon -> AltCon -> Ordering
--- Compares AltCons within a single list of alternatives
-cmpAltCon DEFAULT      DEFAULT	   = EQ
-cmpAltCon DEFAULT      con	   = LT
-
-cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
-cmpAltCon (DataAlt _)  DEFAULT      = GT
-cmpAltCon (LitAlt  l1) (LitAlt  l2) = l1 `compare` l2
-cmpAltCon (LitAlt _)   DEFAULT      = GT
-
-cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+> 
-			 	  ppr con1 <+> ppr con2 )
-		      LT
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Useful synonyms}
-%*									*
-%************************************************************************
-
-The common case
-
-\begin{code}
-type CoreBndr = Var
-type CoreExpr = Expr CoreBndr
-type CoreArg  = Arg  CoreBndr
-type CoreBind = Bind CoreBndr
-type CoreAlt  = Alt  CoreBndr
-\end{code}
-
-Binders are ``tagged'' with a \tr{t}:
-
-\begin{code}
-data TaggedBndr t = TB CoreBndr t	-- TB for "tagged binder"
-
-type TaggedBind t = Bind (TaggedBndr t)
-type TaggedExpr t = Expr (TaggedBndr t)
-type TaggedArg  t = Arg  (TaggedBndr t)
-type TaggedAlt  t = Alt  (TaggedBndr t)
-
-instance Outputable b => Outputable (TaggedBndr b) where
-  ppr (TB b l) = char '<' <> ppr b <> comma <> ppr l <> char '>'
-
-instance Outputable b => OutputableBndr (TaggedBndr b) where
-  pprBndr _ b = ppr b	-- Simple
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Core-constructing functions with checking}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkApps    :: Expr b -> [Arg b]  -> Expr b
-mkTyApps  :: Expr b -> [Type]   -> Expr b
-mkValApps :: Expr b -> [Expr b] -> Expr b
-mkVarApps :: Expr b -> [Var] -> Expr b
-
-mkApps    f args = foldl App		  	   f args
-mkTyApps  f args = foldl (\ e a -> App e (Type a)) f args
-mkValApps f args = foldl (\ e a -> App e a)	   f args
-mkVarApps f vars = foldl (\ e a -> App e (varToCoreExpr a)) f vars
-
-mkLit         :: Literal -> Expr b
-mkIntLit      :: Integer -> Expr b
-mkIntLitInt   :: Int     -> Expr b
-mkConApp      :: DataCon -> [Arg b] -> Expr b
-mkLets	      :: [Bind b] -> Expr b -> Expr b
-mkLams	      :: [b] -> Expr b -> Expr b
-
-mkLit lit	  = Lit lit
-mkConApp con args = mkApps (Var (dataConWorkId con)) args
-
-mkLams binders body = foldr Lam body binders
-mkLets binds body   = foldr Let body binds
-
-mkIntLit    n = Lit (mkMachInt n)
-mkIntLitInt n = Lit (mkMachInt (toInteger n))
-
-varToCoreExpr :: CoreBndr -> Expr b
-varToCoreExpr v | isId v    = Var v
-                | otherwise = Type (mkTyVarTy v)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Simple access functions}
-%*									*
-%************************************************************************
-
-\begin{code}
-bindersOf  :: Bind b -> [b]
-bindersOf (NonRec binder _) = [binder]
-bindersOf (Rec pairs)       = [binder | (binder, _) <- pairs]
-
-bindersOfBinds :: [Bind b] -> [b]
-bindersOfBinds binds = foldr ((++) . bindersOf) [] binds
-
-rhssOfBind :: Bind b -> [Expr b]
-rhssOfBind (NonRec _ rhs) = [rhs]
-rhssOfBind (Rec pairs)    = [rhs | (_,rhs) <- pairs]
-
-rhssOfAlts :: [Alt b] -> [Expr b]
-rhssOfAlts alts = [e | (_,_,e) <- alts]
-
-flattenBinds :: [Bind b] -> [(b, Expr b)]	-- Get all the lhs/rhs pairs
-flattenBinds (NonRec b r : binds) = (b,r) : flattenBinds binds
-flattenBinds (Rec prs1   : binds) = prs1 ++ flattenBinds binds
-flattenBinds []			  = []
-\end{code}
-
-We often want to strip off leading lambdas before getting down to
-business.  @collectBinders@ is your friend.
-
-We expect (by convention) type-, and value- lambdas in that
-order.
-
-\begin{code}
-collectBinders	             :: Expr b -> ([b],         Expr b)
-collectTyBinders       	     :: CoreExpr -> ([TyVar],     CoreExpr)
-collectValBinders      	     :: CoreExpr -> ([Id],        CoreExpr)
-collectTyAndValBinders 	     :: CoreExpr -> ([TyVar], [Id], CoreExpr)
-
-collectBinders expr
-  = go [] expr
-  where
-    go bs (Lam b e) = go (b:bs) e
-    go bs e	     = (reverse bs, e)
-
-collectTyAndValBinders expr
-  = (tvs, ids, body)
-  where
-    (tvs, body1) = collectTyBinders expr
-    (ids, body)  = collectValBinders body1
-
-collectTyBinders expr
-  = go [] expr
-  where
-    go tvs (Lam b e) | isTyVar b = go (b:tvs) e
-    go tvs e			 = (reverse tvs, e)
-
-collectValBinders expr
-  = go [] expr
-  where
-    go ids (Lam b e) | isId b = go (b:ids) e
-    go ids body		      = (reverse ids, body)
-\end{code}
-
-
-@collectArgs@ takes an application expression, returning the function
-and the arguments to which it is applied.
-
-\begin{code}
-collectArgs :: Expr b -> (Expr b, [Arg b])
-collectArgs expr
-  = go expr []
-  where
-    go (App f a) as = go f (a:as)
-    go e 	 as = (e, as)
-\end{code}
-
-coreExprCc gets the cost centre enclosing an expression, if any.
-It looks inside lambdas because (scc "foo" \x.e) = \x.scc "foo" e
-
-\begin{code}
-coreExprCc :: Expr b -> CostCentre
-coreExprCc (Note (SCC cc) e)   = cc
-coreExprCc (Note other_note e) = coreExprCc e
-coreExprCc (Lam _ e)           = coreExprCc e
-coreExprCc other               = noCostCentre
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Predicates}
-%*									*
-%************************************************************************
-
-@isRuntimeVar v@ returns if (Lam v _) really becomes a lambda at runtime,
-i.e. if type applications are actual lambdas because types are kept around
-at runtime.  
-
-Similarly isRuntimeArg.  
-
-\begin{code}
-isRuntimeVar :: Var -> Bool
-isRuntimeVar | opt_RuntimeTypes = \v -> True
-	     | otherwise	= \v -> isId v
-
-isRuntimeArg :: CoreExpr -> Bool
-isRuntimeArg | opt_RuntimeTypes = \e -> True
-	     | otherwise	= \e -> isValArg e
-\end{code}
-
-\begin{code}
-isValArg (Type _) = False
-isValArg other    = True
-
-isTypeArg (Type _) = True
-isTypeArg other    = False
-
-valBndrCount :: [CoreBndr] -> Int
-valBndrCount []		    	  = 0
-valBndrCount (b : bs) | isId b    = 1 + valBndrCount bs
-		      | otherwise = valBndrCount bs
-
-valArgCount :: [Arg b] -> Int
-valArgCount []		    = 0
-valArgCount (Type _ : args) = valArgCount args
-valArgCount (other  : args) = 1 + valArgCount args
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Seq stuff}
-%*									*
-%************************************************************************
-
-\begin{code}
-seqExpr :: CoreExpr -> ()
-seqExpr (Var v)         = v `seq` ()
-seqExpr (Lit lit)       = lit `seq` ()
-seqExpr (App f a)       = seqExpr f `seq` seqExpr a
-seqExpr (Lam b e)       = seqBndr b `seq` seqExpr e
-seqExpr (Let b e)       = seqBind b `seq` seqExpr e
--- gaw 2004
-seqExpr (Case e b t as) = seqExpr e `seq` seqBndr b `seq` seqType t `seq` seqAlts as
-seqExpr (Note n e)      = seqNote n `seq` seqExpr e
-seqExpr (Type t)        = seqType t
-
-seqExprs [] = ()
-seqExprs (e:es) = seqExpr e `seq` seqExprs es
-
-seqNote (Coerce t1 t2) = seqType t1 `seq` seqType t2
-seqNote (CoreNote s)   = s `seq` ()
-seqNote other	       = ()
-
-seqBndr b = b `seq` ()
-
-seqBndrs [] = ()
-seqBndrs (b:bs) = seqBndr b `seq` seqBndrs bs
-
-seqBind (NonRec b e) = seqBndr b `seq` seqExpr e
-seqBind (Rec prs)    = seqPairs prs
-
-seqPairs [] = ()
-seqPairs ((b,e):prs) = seqBndr b `seq` seqExpr e `seq` seqPairs prs
-
-seqAlts [] = ()
-seqAlts ((c,bs,e):alts) = seqBndrs bs `seq` seqExpr e `seq` seqAlts alts
-
-seqRules [] = ()
-seqRules (Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs } : rules) 
-  = seqBndrs bndrs `seq` seqExprs (rhs:args) `seq` seqRules rules
-seqRules (BuiltinRule {} : rules) = seqRules rules
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Annotated core; annotation at every node in the tree}
-%*									*
-%************************************************************************
-
-\begin{code}
-type AnnExpr bndr annot = (annot, AnnExpr' bndr annot)
-
-data AnnExpr' bndr annot
-  = AnnVar	Id
-  | AnnLit	Literal
-  | AnnLam	bndr (AnnExpr bndr annot)
-  | AnnApp	(AnnExpr bndr annot) (AnnExpr bndr annot)
--- gaw 2004
-  | AnnCase	(AnnExpr bndr annot) bndr Type [AnnAlt bndr annot]
-  | AnnLet	(AnnBind bndr annot) (AnnExpr bndr annot)
-  | AnnNote	Note (AnnExpr bndr annot)
-  | AnnType	Type
-
-type AnnAlt bndr annot = (AltCon, [bndr], AnnExpr bndr annot)
-
-data AnnBind bndr annot
-  = AnnNonRec bndr (AnnExpr bndr annot)
-  | AnnRec    [(bndr, AnnExpr bndr annot)]
-\end{code}
-
-\begin{code}
-deAnnotate :: AnnExpr bndr annot -> Expr bndr
-deAnnotate (_, e) = deAnnotate' e
-
-deAnnotate' (AnnType t)           = Type t
-deAnnotate' (AnnVar  v)           = Var v
-deAnnotate' (AnnLit  lit)         = Lit lit
-deAnnotate' (AnnLam  binder body) = Lam binder (deAnnotate body)
-deAnnotate' (AnnApp  fun arg)     = App (deAnnotate fun) (deAnnotate arg)
-deAnnotate' (AnnNote note body)   = Note note (deAnnotate body)
-
-deAnnotate' (AnnLet bind body)
-  = Let (deAnnBind bind) (deAnnotate body)
-  where
-    deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
-    deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
-
--- gaw 2004
-deAnnotate' (AnnCase scrut v t alts)
-  = Case (deAnnotate scrut) v t (map deAnnAlt alts)
-
-deAnnAlt :: AnnAlt bndr annot -> Alt bndr
-deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
-\end{code}
-
-\begin{code}
-collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
-collectAnnBndrs e
-  = collect [] e
-  where
-    collect bs (_, AnnLam b body) = collect (b:bs) body
-    collect bs body		  = (reverse bs, body)
-\end{code}
diff --git a/ghc/compiler/coreSyn/CoreTidy.lhs b/ghc/compiler/coreSyn/CoreTidy.lhs
deleted file mode 100644
index ba604667e7..0000000000
--- a/ghc/compiler/coreSyn/CoreTidy.lhs
+++ /dev/null
@@ -1,221 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1996-1998
-%
-
-\begin{code}
-module CoreTidy (
-	tidyExpr, tidyVarOcc, tidyRule, tidyRules 
-    ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-import CoreUtils	( exprArity )
-import Unify		( coreRefineTys )
-import DataCon		( DataCon, isVanillaDataCon )
-import Id		( Id, mkUserLocal, idInfo, setIdInfo, idUnique,
-			  idType, setIdType )
-import IdInfo		( setArityInfo, vanillaIdInfo,
-			  newStrictnessInfo, setAllStrictnessInfo,
-			  newDemandInfo, setNewDemandInfo )
-import Type		( Type, tidyType, tidyTyVarBndr, substTy, mkOpenTvSubst )
-import Var		( Var, TyVar, varName )
-import VarEnv
-import UniqFM		( lookupUFM )
-import Name		( Name, getOccName )
-import OccName		( tidyOccName )
-import SrcLoc		( noSrcLoc )
-import Maybes		( orElse )
-import Outputable
-import Util		( mapAccumL )
-\end{code}
-
-
-This module contains "tidying" code for *nested* expressions, bindings, rules.
-The code for *top-level* bindings is in TidyPgm.
-
-%************************************************************************
-%*									*
-\subsection{Tidying expressions, rules}
-%*									*
-%************************************************************************
-
-\begin{code}
-tidyBind :: TidyEnv
-	 -> CoreBind
-	 ->  (TidyEnv, CoreBind)
-
-tidyBind env (NonRec bndr rhs)
-  = tidyLetBndr env (bndr,rhs) =: \ (env', bndr') ->
-    (env', NonRec bndr' (tidyExpr env' rhs))
-
-tidyBind env (Rec prs)
-  = mapAccumL tidyLetBndr  env prs	=: \ (env', bndrs') ->
-    map (tidyExpr env') (map snd prs)	=: \ rhss' ->
-    (env', Rec (zip bndrs' rhss'))
-
-
-------------  Expressions  --------------
-tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
-tidyExpr env (Var v)   	=  Var (tidyVarOcc env v)
-tidyExpr env (Type ty) 	=  Type (tidyType env ty)
-tidyExpr env (Lit lit) 	=  Lit lit
-tidyExpr env (App f a) 	=  App (tidyExpr env f) (tidyExpr env a)
-tidyExpr env (Note n e) =  Note (tidyNote env n) (tidyExpr env e)
-
-tidyExpr env (Let b e) 
-  = tidyBind env b 	=: \ (env', b') ->
-    Let b' (tidyExpr env' e)
-
-tidyExpr env (Case e b ty alts)
-  = tidyBndr env b 	=: \ (env', b) ->
-    Case (tidyExpr env e) b (tidyType env ty) 
-	 (map (tidyAlt b env') alts)
-
-tidyExpr env (Lam b e)
-  = tidyBndr env b 	=: \ (env', b) ->
-    Lam b (tidyExpr env' e)
-
-------------  Case alternatives  --------------
-tidyAlt case_bndr env (DataAlt con, vs, rhs)
-  | not (isVanillaDataCon con)	-- GADT case
-  = tidyBndrs env tvs	 	=: \ (env1, tvs') ->
-    let 
-	env2 = refineTidyEnv env con tvs' scrut_ty
-    in
-    tidyBndrs env2 ids 	=: \ (env3, ids') ->
-    (DataAlt con, tvs' ++ ids', tidyExpr env3 rhs)
-  where 
-    (tvs, ids) = span isTyVar vs
-    scrut_ty = idType case_bndr
-
-tidyAlt case_bndr env (con, vs, rhs)
-  = tidyBndrs env vs 	=: \ (env', vs) ->
-    (con, vs, tidyExpr env' rhs)
-
-refineTidyEnv :: TidyEnv -> DataCon -> [TyVar] -> Type -> TidyEnv
--- Refine the TidyEnv in the light of the type refinement from coreRefineTys
-refineTidyEnv tidy_env@(occ_env, var_env)  con tvs scrut_ty
-  = case coreRefineTys con tvs scrut_ty of
-	Nothing -> tidy_env
-	Just (tv_subst, all_bound_here)
-	    | all_bound_here 	-- Local type refinement only
-	    -> tidy_env
-	    | otherwise  	-- Apply the refining subst to the tidy env
-				-- This ensures that occurences have the most refined type
-				-- And that means that exprType will work right everywhere
-	    -> (occ_env, mapVarEnv (refine subst) var_env)
-	    where
-	      subst = mkOpenTvSubst tv_subst
-  where
-    refine subst var | isId var  = setIdType var (substTy subst (idType var)) 
-		     | otherwise = var
-
-------------  Notes  --------------
-tidyNote env (Coerce t1 t2)  = Coerce (tidyType env t1) (tidyType env t2)
-tidyNote env note            = note
-
-------------  Rules  --------------
-tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
-tidyRules env [] = []
-tidyRules env (rule : rules)
-  = tidyRule env rule  		=: \ rule ->
-    tidyRules env rules 	=: \ rules ->
-    (rule : rules)
-
-tidyRule :: TidyEnv -> CoreRule -> CoreRule
-tidyRule env rule@(BuiltinRule {}) = rule
-tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
-			  ru_fn = fn, ru_rough = mb_ns })
-  = tidyBndrs env bndrs		=: \ (env', bndrs) ->
-    map (tidyExpr env') args  	=: \ args ->
-    rule { ru_bndrs = bndrs, ru_args = args, 
-	   ru_rhs   = tidyExpr env' rhs,
-	   ru_fn    = tidyNameOcc env fn, 
-	   ru_rough = map (fmap (tidyNameOcc env')) mb_ns }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Tidying non-top-level binders}
-%*									*
-%************************************************************************
-
-\begin{code}
-tidyNameOcc :: TidyEnv -> Name -> Name
--- In rules and instances, we have Names, and we must tidy them too
--- Fortunately, we can lookup in the VarEnv with a name
-tidyNameOcc (_, var_env) n = case lookupUFM var_env n of
-				Nothing -> n
-				Just v  -> varName v
-
-tidyVarOcc :: TidyEnv -> Var -> Var
-tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
-
--- tidyBndr is used for lambda and case binders
-tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
-tidyBndr env var
-  | isTyVar var = tidyTyVarBndr env var
-  | otherwise   = tidyIdBndr env var
-
-tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
-tidyBndrs env vars = mapAccumL tidyBndr env vars
-
-tidyLetBndr :: TidyEnv -> (Id, CoreExpr) -> (TidyEnv, Var)
--- Used for local (non-top-level) let(rec)s
-tidyLetBndr env (id,rhs) 
-  = ((tidy_env,new_var_env), final_id)
-  where
-    ((tidy_env,var_env), new_id) = tidyIdBndr env id
-
-	-- We need to keep around any interesting strictness and
-	-- demand info because later on we may need to use it when
-	-- converting to A-normal form.
-	-- eg.
-	--	f (g x),  where f is strict in its argument, will be converted
-	--	into  case (g x) of z -> f z  by CorePrep, but only if f still
-	-- 	has its strictness info.
-	--
-	-- Similarly for the demand info - on a let binder, this tells 
-	-- CorePrep to turn the let into a case.
-	--
-	-- Similarly arity info for eta expansion in CorePrep
-	--
-    final_id = new_id `setIdInfo` new_info
-    idinfo   = idInfo id
-    new_info = vanillaIdInfo
-		`setArityInfo`		exprArity rhs
-		`setAllStrictnessInfo`	newStrictnessInfo idinfo
-		`setNewDemandInfo`	newDemandInfo idinfo
-
-    -- Override the env we get back from tidyId with the new IdInfo
-    -- so it gets propagated to the usage sites.
-    new_var_env = extendVarEnv var_env id final_id
-
--- Non-top-level variables
-tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
-tidyIdBndr env@(tidy_env, var_env) id
-  = -- do this pattern match strictly, otherwise we end up holding on to
-    -- stuff in the OccName.
-    case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') -> 
-    let 
-	-- Give the Id a fresh print-name, *and* rename its type
-	-- The SrcLoc isn't important now, 
-	-- though we could extract it from the Id
-	-- 
-	-- All nested Ids now have the same IdInfo, namely vanillaIdInfo,
-	-- which should save some space.
-	-- But note that tidyLetBndr puts some of it back.
-        ty'          	  = tidyType env (idType id)
-	id'          	  = mkUserLocal occ' (idUnique id) ty' noSrcLoc
-				`setIdInfo` vanillaIdInfo
-	var_env'	  = extendVarEnv var_env id id'
-    in
-     ((tidy_env', var_env'), id')
-   }
-\end{code}
-
-\begin{code}
-m =: k = m `seq` k m
-\end{code}
diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
deleted file mode 100644
index d57f1886fc..0000000000
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ /dev/null
@@ -1,632 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1994-1998
-%
-\section[CoreUnfold]{Core-syntax unfoldings}
-
-Unfoldings (which can travel across module boundaries) are in Core
-syntax (namely @CoreExpr@s).
-
-The type @Unfolding@ sits ``above'' simply-Core-expressions
-unfoldings, capturing ``higher-level'' things we know about a binding,
-usually things that the simplifier found out (e.g., ``it's a
-literal'').  In the corner of a @CoreUnfolding@ unfolding, you will
-find, unsurprisingly, a Core expression.
-
-\begin{code}
-module CoreUnfold (
-	Unfolding, UnfoldingGuidance,	-- Abstract types
-
-	noUnfolding, mkTopUnfolding, mkUnfolding, mkCompulsoryUnfolding, seqUnfolding,
-	evaldUnfolding, mkOtherCon, otherCons,
-	unfoldingTemplate, maybeUnfoldingTemplate,
-	isEvaldUnfolding, isValueUnfolding, isCheapUnfolding, isCompulsoryUnfolding,
-	hasUnfolding, hasSomeUnfolding, neverUnfold,
-
-	couldBeSmallEnoughToInline, 
-	certainlyWillInline, smallEnoughToInline,
-
-	callSiteInline
-    ) where
-
-#include "HsVersions.h"
-
-import StaticFlags	( opt_UF_CreationThreshold, opt_UF_UseThreshold,
-			  opt_UF_FunAppDiscount, opt_UF_KeenessFactor,
-			  opt_UF_DearOp,
-			)
-import DynFlags		( DynFlags, DynFlag(..), dopt )
-import CoreSyn
-import PprCore		( pprCoreExpr )
-import OccurAnal	( occurAnalyseExpr )
-import CoreUtils	( exprIsHNF, exprIsCheap, exprIsTrivial )
-import Id		( Id, idType, isId,
-			  idUnfolding, globalIdDetails
-			)
-import DataCon		( isUnboxedTupleCon )
-import Literal		( litSize )
-import PrimOp		( primOpIsDupable, primOpOutOfLine )
-import IdInfo		( OccInfo(..), GlobalIdDetails(..) )
-import Type		( isUnLiftedType )
-import PrelNames	( hasKey, buildIdKey, augmentIdKey )
-import Bag
-import FastTypes
-import Outputable
-
-#if __GLASGOW_HASKELL__ >= 404
-import GLAEXTS		( Int# )
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Making unfoldings}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkTopUnfolding expr = mkUnfolding True {- Top level -} expr
-
-mkUnfolding top_lvl expr
-  = CoreUnfolding (occurAnalyseExpr expr)
-		  top_lvl
-
-		  (exprIsHNF expr)
-			-- Already evaluated
-
-		  (exprIsCheap expr)
-			-- OK to inline inside a lambda
-
-		  (calcUnfoldingGuidance opt_UF_CreationThreshold expr)
-	-- Sometimes during simplification, there's a large let-bound thing	
-	-- which has been substituted, and so is now dead; so 'expr' contains
-	-- two copies of the thing while the occurrence-analysed expression doesn't
-	-- Nevertheless, we don't occ-analyse before computing the size because the
-	-- size computation bales out after a while, whereas occurrence analysis does not.
-	--
-	-- This can occasionally mean that the guidance is very pessimistic;
-	-- it gets fixed up next round
-
-mkCompulsoryUnfolding expr	-- Used for things that absolutely must be unfolded
-  = CompulsoryUnfolding (occurAnalyseExpr expr)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The UnfoldingGuidance type}
-%*									*
-%************************************************************************
-
-\begin{code}
-instance Outputable UnfoldingGuidance where
-    ppr UnfoldNever	= ptext SLIT("NEVER")
-    ppr (UnfoldIfGoodArgs v cs size discount)
-      = hsep [ ptext SLIT("IF_ARGS"), int v,
-	       brackets (hsep (map int cs)),
-	       int size,
-	       int discount ]
-\end{code}
-
-
-\begin{code}
-calcUnfoldingGuidance
-	:: Int		    	-- bomb out if size gets bigger than this
-	-> CoreExpr    		-- expression to look at
-	-> UnfoldingGuidance
-calcUnfoldingGuidance bOMB_OUT_SIZE expr
-  = case collect_val_bndrs expr of { (inline, val_binders, body) ->
-    let
-	n_val_binders = length val_binders
-
-	max_inline_size = n_val_binders+2
-	-- The idea is that if there is an INLINE pragma (inline is True)
-	-- and there's a big body, we give a size of n_val_binders+2.  This
-	-- This is just enough to fail the no-size-increase test in callSiteInline,
-	--   so that INLINE things don't get inlined into entirely boring contexts,
-	--   but no more.
-
-    in
-    case (sizeExpr (iUnbox bOMB_OUT_SIZE) val_binders body) of
-
-      TooBig 
-	| not inline -> UnfoldNever
-		-- A big function with an INLINE pragma must
-		-- have an UnfoldIfGoodArgs guidance
-	| otherwise  -> UnfoldIfGoodArgs n_val_binders
-					 (map (const 0) val_binders)
-					 max_inline_size 0
-
-      SizeIs size cased_args scrut_discount
-	-> UnfoldIfGoodArgs
-			n_val_binders
-			(map discount_for val_binders)
-			final_size
-			(iBox scrut_discount)
-	where        
-	    boxed_size    = iBox size
-
-	    final_size | inline     = boxed_size `min` max_inline_size
-		       | otherwise  = boxed_size
-
-		-- Sometimes an INLINE thing is smaller than n_val_binders+2.
-		-- A particular case in point is a constructor, which has size 1.
-		-- We want to inline this regardless, hence the `min`
-
-	    discount_for b = foldlBag (\acc (b',n) -> if b==b' then acc+n else acc) 
-				      0 cased_args
-	}
-  where
-    collect_val_bndrs e = go False [] e
-	-- We need to be a bit careful about how we collect the
-	-- value binders.  In ptic, if we see 
-	--	__inline_me (\x y -> e)
-	-- We want to say "2 value binders".  Why?  So that 
-	-- we take account of information given for the arguments
-
-    go inline rev_vbs (Note InlineMe e)     = go True   rev_vbs     e
-    go inline rev_vbs (Lam b e) | isId b    = go inline (b:rev_vbs) e
-				| otherwise = go inline rev_vbs     e
-    go inline rev_vbs e			    = (inline, reverse rev_vbs, e)
-\end{code}
-
-\begin{code}
-sizeExpr :: Int# 	    -- Bomb out if it gets bigger than this
-	 -> [Id]	    -- Arguments; we're interested in which of these
-			    -- get case'd
-	 -> CoreExpr
-	 -> ExprSize
-
-sizeExpr bOMB_OUT_SIZE top_args expr
-  = size_up expr
-  where
-    size_up (Type t)	      = sizeZero	-- Types cost nothing
-    size_up (Var v)           = sizeOne
-
-    size_up (Note InlineMe body) = sizeOne	-- Inline notes make it look very small
-	-- This can be important.  If you have an instance decl like this:
-	-- 	instance Foo a => Foo [a] where
-	--	   {-# INLINE op1, op2 #-}
-	--	   op1 = ...
-	--	   op2 = ...
-	-- then we'll get a dfun which is a pair of two INLINE lambdas
-
-    size_up (Note _        body) = size_up body	-- Other notes cost nothing
-
-    size_up (App fun (Type t)) = size_up fun
-    size_up (App fun arg)      = size_up_app fun [arg]
-
-    size_up (Lit lit) 	       = sizeN (litSize lit)
-
-    size_up (Lam b e) | isId b    = lamScrutDiscount (size_up e `addSizeN` 1)
-		      | otherwise = size_up e
-
-    size_up (Let (NonRec binder rhs) body)
-      = nukeScrutDiscount (size_up rhs)		`addSize`
-	size_up body				`addSizeN`
-	(if isUnLiftedType (idType binder) then 0 else 1)
-		-- For the allocation
-		-- If the binder has an unlifted type there is no allocation
-
-    size_up (Let (Rec pairs) body)
-      = nukeScrutDiscount rhs_size		`addSize`
-	size_up body				`addSizeN`
-	length pairs		-- For the allocation
-      where
-	rhs_size = foldr (addSize . size_up . snd) sizeZero pairs
-
-    size_up (Case (Var v) _ _ alts) 
-	| v `elem` top_args		-- We are scrutinising an argument variable
-	= 
-{-	I'm nuking this special case; BUT see the comment with case alternatives.
-
-	(a) It's too eager.  We don't want to inline a wrapper into a
-	    context with no benefit.  
-	    E.g.  \ x. f (x+x)   	no point in inlining (+) here!
-
-	(b) It's ineffective. Once g's wrapper is inlined, its case-expressions 
-	    aren't scrutinising arguments any more
-
-	    case alts of
-
-		[alt] -> size_up_alt alt `addSize` SizeIs 0# (unitBag (v, 1)) 0#
-		-- We want to make wrapper-style evaluation look cheap, so that
-		-- when we inline a wrapper it doesn't make call site (much) bigger
-		-- Otherwise we get nasty phase ordering stuff: 
-		--	f x = g x x
-		--	h y = ...(f e)...
-		-- If we inline g's wrapper, f looks big, and doesn't get inlined
-		-- into h; if we inline f first, while it looks small, then g's 
-		-- wrapper will get inlined later anyway.  To avoid this nasty
-		-- ordering difference, we make (case a of (x,y) -> ...), 
-		--  *where a is one of the arguments* look free.
-
-		other -> 
--}
-			 alts_size (foldr addSize sizeOne alt_sizes)	-- The 1 is for the scrutinee
-				   (foldr1 maxSize alt_sizes)
-
-		-- Good to inline if an arg is scrutinised, because
-		-- that may eliminate allocation in the caller
-		-- And it eliminates the case itself
-
-	where
-	  alt_sizes = map size_up_alt alts
-
-		-- alts_size tries to compute a good discount for
-		-- the case when we are scrutinising an argument variable
-	  alts_size (SizeIs tot tot_disc tot_scrut)		-- Size of all alternatives
-		    (SizeIs max max_disc max_scrut)		-- Size of biggest alternative
-	 	= SizeIs tot (unitBag (v, iBox (_ILIT 1 +# tot -# max)) `unionBags` max_disc) max_scrut
-			-- If the variable is known, we produce a discount that
-			-- will take us back to 'max', the size of rh largest alternative
-			-- The 1+ is a little discount for reduced allocation in the caller
-	  alts_size tot_size _ = tot_size
-
--- gaw 2004
-    size_up (Case e _ _ alts) = nukeScrutDiscount (size_up e) `addSize` 
-			         foldr (addSize . size_up_alt) sizeZero alts
-	  	-- We don't charge for the case itself
-		-- It's a strict thing, and the price of the call
-		-- is paid by scrut.  Also consider
-		--	case f x of DEFAULT -> e
-		-- This is just ';'!  Don't charge for it.
-
-    ------------ 
-    size_up_app (App fun arg) args   
-	| isTypeArg arg		     = size_up_app fun args
-	| otherwise		     = size_up_app fun (arg:args)
-    size_up_app fun 	      args   = foldr (addSize . nukeScrutDiscount . size_up) 
-					     (size_up_fun fun args)
-					     args
-
-	-- A function application with at least one value argument
-	-- so if the function is an argument give it an arg-discount
-	--
-	-- Also behave specially if the function is a build
-	--
-	-- Also if the function is a constant Id (constr or primop)
-	-- compute discounts specially
-    size_up_fun (Var fun) args
-      | fun `hasKey` buildIdKey   = buildSize
-      | fun `hasKey` augmentIdKey = augmentSize
-      | otherwise 
-      = case globalIdDetails fun of
-	  DataConWorkId dc -> conSizeN dc (valArgCount args)
-
-	  FCallId fc   -> sizeN opt_UF_DearOp
-	  PrimOpId op  -> primOpSize op (valArgCount args)
-			  -- foldr addSize (primOpSize op) (map arg_discount args)
-			  -- At one time I tried giving an arg-discount if a primop 
-			  -- is applied to one of the function's arguments, but it's
-			  -- not good.  At the moment, any unlifted-type arg gets a
-			  -- 'True' for 'yes I'm evald', so we collect the discount even
-			  -- if we know nothing about it.  And just having it in a primop
-			  -- doesn't help at all if we don't know something more.
-
-	  other	       -> fun_discount fun `addSizeN` 
-			  (1 + length (filter (not . exprIsTrivial) args))
-				-- The 1+ is for the function itself
-				-- Add 1 for each non-trivial arg;
-				-- the allocation cost, as in let(rec)
-				-- Slight hack here: for constructors the args are almost always
-				--	trivial; and for primops they are almost always prim typed
-				-- 	We should really only count for non-prim-typed args in the
-				--	general case, but that seems too much like hard work
-
-    size_up_fun other args = size_up other
-
-    ------------ 
-    size_up_alt (con, bndrs, rhs) = size_up rhs
- 	-- Don't charge for args, so that wrappers look cheap
-	-- (See comments about wrappers with Case)
-
-    ------------
-	-- We want to record if we're case'ing, or applying, an argument
-    fun_discount v | v `elem` top_args = SizeIs 0# (unitBag (v, opt_UF_FunAppDiscount)) 0#
-    fun_discount other		       = sizeZero
-
-    ------------
-	-- These addSize things have to be here because
-	-- I don't want to give them bOMB_OUT_SIZE as an argument
-
-    addSizeN TooBig          _  = TooBig
-    addSizeN (SizeIs n xs d) m 	= mkSizeIs bOMB_OUT_SIZE (n +# iUnbox m) xs d
-    
-    addSize TooBig	      _			= TooBig
-    addSize _		      TooBig		= TooBig
-    addSize (SizeIs n1 xs d1) (SizeIs n2 ys d2) 
-	= mkSizeIs bOMB_OUT_SIZE (n1 +# n2) (xs `unionBags` ys) (d1 +# d2)
-\end{code}
-
-Code for manipulating sizes
-
-\begin{code}
-data ExprSize = TooBig
-	      | SizeIs FastInt		-- Size found
-		       (Bag (Id,Int))	-- Arguments cased herein, and discount for each such
-		       FastInt		-- Size to subtract if result is scrutinised 
-					-- by a case expression
-
--- subtract the discount before deciding whether to bale out. eg. we
--- want to inline a large constructor application into a selector:
---  	tup = (a_1, ..., a_99)
---  	x = case tup of ...
---
-mkSizeIs max n xs d | (n -# d) ># max = TooBig
-		    | otherwise	      = SizeIs n xs d
- 
-maxSize TooBig         _ 				  = TooBig
-maxSize _              TooBig				  = TooBig
-maxSize s1@(SizeIs n1 _ _) s2@(SizeIs n2 _ _) | n1 ># n2  = s1
-					      | otherwise = s2
-
-sizeZero     	= SizeIs (_ILIT 0)  emptyBag (_ILIT 0)
-sizeOne      	= SizeIs (_ILIT 1)  emptyBag (_ILIT 0)
-sizeN n 	= SizeIs (iUnbox n) emptyBag (_ILIT 0)
-conSizeN dc n   
-  | isUnboxedTupleCon dc = SizeIs (_ILIT 0) emptyBag (iUnbox n +# _ILIT 1)
-  | otherwise		 = SizeIs (_ILIT 1) emptyBag (iUnbox n +# _ILIT 1)
-	-- Treat constructors as size 1; we are keen to expose them
-	-- (and we charge separately for their args).  We can't treat
-	-- them as size zero, else we find that (iBox x) has size 1,
-	-- which is the same as a lone variable; and hence 'v' will 
-	-- always be replaced by (iBox x), where v is bound to iBox x.
-	--
-	-- However, unboxed tuples count as size zero
-	-- I found occasions where we had 
-	--	f x y z = case op# x y z of { s -> (# s, () #) }
-	-- and f wasn't getting inlined
-
-primOpSize op n_args
- | not (primOpIsDupable op) = sizeN opt_UF_DearOp
- | not (primOpOutOfLine op) = sizeN (2 - n_args)
-	-- Be very keen to inline simple primops.
-	-- We give a discount of 1 for each arg so that (op# x y z) costs 2.
-	-- We can't make it cost 1, else we'll inline let v = (op# x y z) 
-	-- at every use of v, which is excessive.
-	--
-	-- A good example is:
-	--	let x = +# p q in C {x}
-	-- Even though x get's an occurrence of 'many', its RHS looks cheap,
-	-- and there's a good chance it'll get inlined back into C's RHS. Urgh!
- | otherwise	      	    = sizeOne
-
-buildSize = SizeIs (-2#) emptyBag 4#
-	-- We really want to inline applications of build
-	-- build t (\cn -> e) should cost only the cost of e (because build will be inlined later)
-	-- Indeed, we should add a result_discount becuause build is 
-	-- very like a constructor.  We don't bother to check that the
-	-- build is saturated (it usually is).  The "-2" discounts for the \c n, 
-	-- The "4" is rather arbitrary.
-
-augmentSize = SizeIs (-2#) emptyBag 4#
-	-- Ditto (augment t (\cn -> e) ys) should cost only the cost of
-	-- e plus ys. The -2 accounts for the \cn 
-						
-nukeScrutDiscount (SizeIs n vs d) = SizeIs n vs 0#
-nukeScrutDiscount TooBig	  = TooBig
-
--- When we return a lambda, give a discount if it's used (applied)
-lamScrutDiscount  (SizeIs n vs d) = case opt_UF_FunAppDiscount of { d -> SizeIs n vs (iUnbox d) }
-lamScrutDiscount TooBig	 	  = TooBig
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[considerUnfolding]{Given all the info, do (not) do the unfolding}
-%*									*
-%************************************************************************
-
-We have very limited information about an unfolding expression: (1)~so
-many type arguments and so many value arguments expected---for our
-purposes here, we assume we've got those.  (2)~A ``size'' or ``cost,''
-a single integer.  (3)~An ``argument info'' vector.  For this, what we
-have at the moment is a Boolean per argument position that says, ``I
-will look with great favour on an explicit constructor in this
-position.'' (4)~The ``discount'' to subtract if the expression
-is being scrutinised. 
-
-Assuming we have enough type- and value arguments (if not, we give up
-immediately), then we see if the ``discounted size'' is below some
-(semi-arbitrary) threshold.  It works like this: for every argument
-position where we're looking for a constructor AND WE HAVE ONE in our
-hands, we get a (again, semi-arbitrary) discount [proportion to the
-number of constructors in the type being scrutinized].
-
-If we're in the context of a scrutinee ( \tr{(case <expr > of A .. -> ...;.. )})
-and the expression in question will evaluate to a constructor, we use
-the computed discount size *for the result only* rather than
-computing the argument discounts. Since we know the result of
-the expression is going to be taken apart, discounting its size
-is more accurate (see @sizeExpr@ above for how this discount size
-is computed).
-
-We use this one to avoid exporting inlinings that we ``couldn't possibly
-use'' on the other side.  Can be overridden w/ flaggery.
-Just the same as smallEnoughToInline, except that it has no actual arguments.
-
-\begin{code}
-couldBeSmallEnoughToInline :: Int -> CoreExpr -> Bool
-couldBeSmallEnoughToInline threshold rhs = case calcUnfoldingGuidance threshold rhs of
-						UnfoldNever -> False
-						other	    -> True
-
-certainlyWillInline :: Unfolding -> Bool
-  -- Sees if the unfolding is pretty certain to inline	
-certainlyWillInline (CoreUnfolding _ _ _ is_cheap (UnfoldIfGoodArgs n_vals _ size _))
-  = is_cheap && size - (n_vals +1) <= opt_UF_UseThreshold
-certainlyWillInline other
-  = False
-
-smallEnoughToInline :: Unfolding -> Bool
-smallEnoughToInline (CoreUnfolding _ _ _ _ (UnfoldIfGoodArgs _ _ size _))
-  = size <= opt_UF_UseThreshold
-smallEnoughToInline other
-  = False
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{callSiteInline}
-%*									*
-%************************************************************************
-
-This is the key function.  It decides whether to inline a variable at a call site
-
-callSiteInline is used at call sites, so it is a bit more generous.
-It's a very important function that embodies lots of heuristics.
-A non-WHNF can be inlined if it doesn't occur inside a lambda,
-and occurs exactly once or 
-    occurs once in each branch of a case and is small
-
-If the thing is in WHNF, there's no danger of duplicating work, 
-so we can inline if it occurs once, or is small
-
-NOTE: we don't want to inline top-level functions that always diverge.
-It just makes the code bigger.  Tt turns out that the convenient way to prevent
-them inlining is to give them a NOINLINE pragma, which we do in 
-StrictAnal.addStrictnessInfoToTopId
-
-\begin{code}
-callSiteInline :: DynFlags
-	       -> Bool			-- True <=> the Id can be inlined
-	       -> Bool			-- 'inline' note at call site
-	       -> OccInfo
-	       -> Id			-- The Id
-	       -> [Bool]		-- One for each value arg; True if it is interesting
-	       -> Bool			-- True <=> continuation is interesting
-	       -> Maybe CoreExpr	-- Unfolding, if any
-
-
-callSiteInline dflags active_inline inline_call occ id arg_infos interesting_cont
-  = case idUnfolding id of {
-	NoUnfolding -> Nothing ;
-	OtherCon cs -> Nothing ;
-
-	CompulsoryUnfolding unf_template -> Just unf_template ;
-		-- CompulsoryUnfolding => there is no top-level binding
-		-- for these things, so we must inline it.
-		-- Only a couple of primop-like things have 
-		-- compulsory unfoldings (see MkId.lhs).
-		-- We don't allow them to be inactive
-
-	CoreUnfolding unf_template is_top is_value is_cheap guidance ->
-
-    let
-	result | yes_or_no = Just unf_template
-	       | otherwise = Nothing
-
-	n_val_args  = length arg_infos
-
- 	yes_or_no 
-	  | not active_inline = False
-	  | otherwise = case occ of
-				IAmDead		     -> pprTrace "callSiteInline: dead" (ppr id) False
-				IAmALoopBreaker      -> False
-				--OneOcc in_lam _ _    -> (not in_lam || is_cheap) && consider_safe True
-				other		     -> is_cheap && consider_safe False
-		-- we consider even the once-in-one-branch
-		-- occurrences, because they won't all have been
-		-- caught by preInlineUnconditionally.  In particular,
-		-- if the occurrence is once inside a lambda, and the
-		-- rhs is cheap but not a manifest lambda, then
-		-- pre-inline will not have inlined it for fear of
-		-- invalidating the occurrence info in the rhs.
-
-	consider_safe once
-		-- consider_safe decides whether it's a good idea to
-		-- inline something, given that there's no
-		-- work-duplication issue (the caller checks that).
-	  | inline_call  = True
-
-	  | otherwise
-	  = case guidance of
-	      UnfoldNever  -> False
-	      UnfoldIfGoodArgs n_vals_wanted arg_discounts size res_discount
-
-		  | enough_args && size <= (n_vals_wanted + 1)
-			-- Inline unconditionally if there no size increase
-			-- Size of call is n_vals_wanted (+1 for the function)
-		  -> True
-
-	  	  | otherwise
-		  -> some_benefit && small_enough
-
-		  where
-		    some_benefit = or arg_infos || really_interesting_cont || 
-		    		   (not is_top && ({- once || -} (n_vals_wanted > 0 && enough_args)))
-				-- [was (once && not in_lam)]
-		-- If it occurs more than once, there must be
-		-- something interesting about some argument, or the
-		-- result context, to make it worth inlining
-		--
-		-- If a function has a nested defn we also record
-		-- some-benefit, on the grounds that we are often able
-		-- to eliminate the binding, and hence the allocation,
-		-- for the function altogether; this is good for join
-		-- points.  But this only makes sense for *functions*;
-		-- inlining a constructor doesn't help allocation
-		-- unless the result is scrutinised.  UNLESS the
-		-- constructor occurs just once, albeit possibly in
-		-- multiple case branches.  Then inlining it doesn't
-		-- increase allocation, but it does increase the
-		-- chance that the constructor won't be allocated at
-		-- all in the branches that don't use it.
-
-		    enough_args		  = n_val_args >= n_vals_wanted
-		    really_interesting_cont | n_val_args <  n_vals_wanted = False	-- Too few args
-		    			    | n_val_args == n_vals_wanted = interesting_cont
-		    			    | otherwise		          = True	-- Extra args
-		    	-- really_interesting_cont tells if the result of the
-		    	-- call is in an interesting context.
-
-		    small_enough = (size - discount) <= opt_UF_UseThreshold
-		    discount     = computeDiscount n_vals_wanted arg_discounts res_discount 
-						 arg_infos really_interesting_cont
-		
-    in    
-    if dopt Opt_D_dump_inlinings dflags then
-	pprTrace "Considering inlining"
-		 (ppr id <+> vcat [text "active:" <+> ppr active_inline,
-				   text "occ info:" <+> ppr occ,
-			  	   text "arg infos" <+> ppr arg_infos,
-				   text "interesting continuation" <+> ppr interesting_cont,
-				   text "is value:" <+> ppr is_value,
-				   text "is cheap:" <+> ppr is_cheap,
-				   text "guidance" <+> ppr guidance,
-				   text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"])
-		  result
-    else
-    result
-    }
-
-computeDiscount :: Int -> [Int] -> Int -> [Bool] -> Bool -> Int
-computeDiscount n_vals_wanted arg_discounts res_discount arg_infos result_used
- 	-- We multiple the raw discounts (args_discount and result_discount)
-	-- ty opt_UnfoldingKeenessFactor because the former have to do with
-	--  *size* whereas the discounts imply that there's some extra 
-	--  *efficiency* to be gained (e.g. beta reductions, case reductions) 
-	-- by inlining.
-
-	-- we also discount 1 for each argument passed, because these will
-	-- reduce with the lambdas in the function (we count 1 for a lambda
- 	-- in size_up).
-  = 1 +			-- Discount of 1 because the result replaces the call
-			-- so we count 1 for the function itself
-    length (take n_vals_wanted arg_infos) +
-			-- Discount of 1 for each arg supplied, because the 
-			-- result replaces the call
-    round (opt_UF_KeenessFactor * 
-	   fromIntegral (arg_discount + result_discount))
-  where
-    arg_discount = sum (zipWith mk_arg_discount arg_discounts arg_infos)
-
-    mk_arg_discount discount is_evald | is_evald  = discount
-				      | otherwise = 0
-
-	-- Don't give a result discount unless there are enough args
-    result_discount | result_used = res_discount	-- Over-applied, or case scrut
-	            | otherwise	  = 0
-\end{code}
diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs
deleted file mode 100644
index e358be4439..0000000000
--- a/ghc/compiler/coreSyn/CoreUtils.lhs
+++ /dev/null
@@ -1,1316 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[CoreUtils]{Utility functions on @Core@ syntax}
-
-\begin{code}
-module CoreUtils (
-	-- Construction
-	mkInlineMe, mkSCC, mkCoerce, mkCoerce2,
-	bindNonRec, needsCaseBinding,
-	mkIfThenElse, mkAltExpr, mkPiType, mkPiTypes,
-
-	-- Taking expressions apart
-	findDefault, findAlt, isDefaultAlt,
-
-	-- Properties of expressions
-	exprType, coreAltType,
-	exprIsDupable, exprIsTrivial, exprIsCheap, 
-	exprIsHNF,exprOkForSpeculation, exprIsBig, 
-	exprIsConApp_maybe, exprIsBottom,
-	rhsIsStatic,
-
-	-- Arity and eta expansion
-	manifestArity, exprArity, 
-	exprEtaExpandArity, etaExpand, 
-
-	-- Size
-	coreBindsSize,
-
-	-- Hashing
-	hashExpr,
-
-	-- Equality
-	cheapEqExpr, tcEqExpr, tcEqExprX, applyTypeToArgs, applyTypeToArg
-    ) where
-
-#include "HsVersions.h"
-
-
-import GLAEXTS		-- For `xori` 
-
-import CoreSyn
-import CoreFVs		( exprFreeVars )
-import PprCore		( pprCoreExpr )
-import Var		( Var )
-import VarSet		( unionVarSet )
-import VarEnv
-import Name		( hashName )
-import Packages		( HomeModules )
-#if mingw32_TARGET_OS
-import Packages		( isDllName )
-#endif
-import Literal		( hashLiteral, literalType, litIsDupable, 
-			  litIsTrivial, isZeroLit, Literal( MachLabel ) )
-import DataCon		( DataCon, dataConRepArity, dataConInstArgTys,
-			  isVanillaDataCon, dataConTyCon )
-import PrimOp		( PrimOp(..), primOpOkForSpeculation, primOpIsCheap )
-import Id		( Id, idType, globalIdDetails, idNewStrictness, 
-			  mkWildId, idArity, idName, idUnfolding, idInfo,
-			  isOneShotBndr, isStateHackType, isDataConWorkId_maybe, mkSysLocal,
-			  isDataConWorkId, isBottomingId
-			)
-import IdInfo		( GlobalIdDetails(..), megaSeqIdInfo )
-import NewDemand	( appIsBottom )
-import Type		( Type, mkFunTy, mkForAllTy, splitFunTy_maybe,
-			  splitFunTy, tcEqTypeX,
-			  applyTys, isUnLiftedType, seqType, mkTyVarTy,
-			  splitForAllTy_maybe, isForAllTy, splitRecNewType_maybe, 
-			  splitTyConApp_maybe, coreEqType, funResultTy, applyTy
-			)
-import TyCon		( tyConArity )
-import TysWiredIn	( boolTy, trueDataCon, falseDataCon )
-import CostCentre	( CostCentre )
-import BasicTypes	( Arity )
-import Unique		( Unique )
-import Outputable
-import TysPrim		( alphaTy )	-- Debugging only
-import Util             ( equalLength, lengthAtLeast, foldl2 )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Find the type of a Core atom/expression}
-%*									*
-%************************************************************************
-
-\begin{code}
-exprType :: CoreExpr -> Type
-
-exprType (Var var)		= idType var
-exprType (Lit lit)		= literalType lit
-exprType (Let _ body)	   	= exprType body
-exprType (Case _ _ ty alts)     = ty
-exprType (Note (Coerce ty _) e) = ty  --  **! should take usage from e
-exprType (Note other_note e)    = exprType e
-exprType (Lam binder expr)      = mkPiType binder (exprType expr)
-exprType e@(App _ _)
-  = case collectArgs e of
-	(fun, args) -> applyTypeToArgs e (exprType fun) args
-
-exprType other = pprTrace "exprType" (pprCoreExpr other) alphaTy
-
-coreAltType :: CoreAlt -> Type
-coreAltType (_,_,rhs) = exprType rhs
-\end{code}
-
-@mkPiType@ makes a (->) type or a forall type, depending on whether
-it is given a type variable or a term variable.  We cleverly use the
-lbvarinfo field to figure out the right annotation for the arrove in
-case of a term variable.
-
-\begin{code}
-mkPiType  :: Var   -> Type -> Type	-- The more polymorphic version
-mkPiTypes :: [Var] -> Type -> Type	--    doesn't work...
-
-mkPiTypes vs ty = foldr mkPiType ty vs
-
-mkPiType v ty
-   | isId v    = mkFunTy (idType v) ty
-   | otherwise = mkForAllTy v ty
-\end{code}
-
-\begin{code}
-applyTypeToArg :: Type -> CoreExpr -> Type
-applyTypeToArg fun_ty (Type arg_ty) = applyTy fun_ty arg_ty
-applyTypeToArg fun_ty other_arg     = funResultTy fun_ty
-
-applyTypeToArgs :: CoreExpr -> Type -> [CoreExpr] -> Type
--- A more efficient version of applyTypeToArg 
--- when we have several args
--- The first argument is just for debugging
-applyTypeToArgs e op_ty [] = op_ty
-
-applyTypeToArgs e op_ty (Type ty : args)
-  =	-- Accumulate type arguments so we can instantiate all at once
-    go [ty] args
-  where
-    go rev_tys (Type ty : args) = go (ty:rev_tys) args
-    go rev_tys rest_args        = applyTypeToArgs e op_ty' rest_args
-			 	where
-				  op_ty' = applyTys op_ty (reverse rev_tys)
-
-applyTypeToArgs e op_ty (other_arg : args)
-  = case (splitFunTy_maybe op_ty) of
-	Just (_, res_ty) -> applyTypeToArgs e res_ty args
-	Nothing -> pprPanic "applyTypeToArgs" (pprCoreExpr e)
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Attaching notes}
-%*									*
-%************************************************************************
-
-mkNote removes redundant coercions, and SCCs where possible
-
-\begin{code}
-#ifdef UNUSED
-mkNote :: Note -> CoreExpr -> CoreExpr
-mkNote (Coerce to_ty from_ty) expr = mkCoerce2 to_ty from_ty expr
-mkNote (SCC cc)	expr		   = mkSCC cc expr
-mkNote InlineMe expr		   = mkInlineMe expr
-mkNote note     expr		   = Note note expr
-#endif
-
--- Slide InlineCall in around the function
---	No longer necessary I think (SLPJ Apr 99)
--- mkNote InlineCall (App f a) = App (mkNote InlineCall f) a
--- mkNote InlineCall (Var v)   = Note InlineCall (Var v)
--- mkNote InlineCall expr      = expr
-\end{code}
-
-Drop trivial InlineMe's.  This is somewhat important, because if we have an unfolding
-that looks like	(Note InlineMe (Var v)), the InlineMe doesn't go away because it may
-not be *applied* to anything.
-
-We don't use exprIsTrivial here, though, because we sometimes generate worker/wrapper
-bindings like
-	fw = ...
-	f  = inline_me (coerce t fw)
-As usual, the inline_me prevents the worker from getting inlined back into the wrapper.
-We want the split, so that the coerces can cancel at the call site.  
-
-However, we can get left with tiresome type applications.  Notably, consider
-	f = /\ a -> let t = e in (t, w)
-Then lifting the let out of the big lambda gives
-	t' = /\a -> e
-	f = /\ a -> let t = inline_me (t' a) in (t, w)
-The inline_me is to stop the simplifier inlining t' right back
-into t's RHS.  In the next phase we'll substitute for t (since
-its rhs is trivial) and *then* we could get rid of the inline_me.
-But it hardly seems worth it, so I don't bother.
-
-\begin{code}
-mkInlineMe (Var v) = Var v
-mkInlineMe e	   = Note InlineMe e
-\end{code}
-
-
-
-\begin{code}
-mkCoerce :: Type -> CoreExpr -> CoreExpr
-mkCoerce to_ty expr = mkCoerce2 to_ty (exprType expr) expr
-
-mkCoerce2 :: Type -> Type -> CoreExpr -> CoreExpr
-mkCoerce2 to_ty from_ty (Note (Coerce to_ty2 from_ty2) expr)
-  = ASSERT( from_ty `coreEqType` to_ty2 )
-    mkCoerce2 to_ty from_ty2 expr
-
-mkCoerce2 to_ty from_ty expr
-  | to_ty `coreEqType` from_ty = expr
-  | otherwise	  	   = ASSERT( from_ty `coreEqType` exprType expr )
-			     Note (Coerce to_ty from_ty) expr
-\end{code}
-
-\begin{code}
-mkSCC :: CostCentre -> Expr b -> Expr b
-	-- Note: Nested SCC's *are* preserved for the benefit of
-	--       cost centre stack profiling
-mkSCC cc (Lit lit)  	    = Lit lit
-mkSCC cc (Lam x e)  	    = Lam x (mkSCC cc e)  -- Move _scc_ inside lambda
-mkSCC cc (Note (SCC cc') e) = Note (SCC cc) (Note (SCC cc') e)
-mkSCC cc (Note n e) 	    = Note n (mkSCC cc e) -- Move _scc_ inside notes
-mkSCC cc expr	    	    = Note (SCC cc) expr
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Other expression construction}
-%*									*
-%************************************************************************
-
-\begin{code}
-bindNonRec :: Id -> CoreExpr -> CoreExpr -> CoreExpr
--- (bindNonRec x r b) produces either
---	let x = r in b
--- or
---	case r of x { _DEFAULT_ -> b }
---
--- depending on whether x is unlifted or not
--- It's used by the desugarer to avoid building bindings
--- that give Core Lint a heart attack.  Actually the simplifier
--- deals with them perfectly well.
-
-bindNonRec bndr rhs body 
-  | needsCaseBinding (idType bndr) rhs = Case rhs bndr (exprType body) [(DEFAULT,[],body)]
-  | otherwise			       = Let (NonRec bndr rhs) body
-
-needsCaseBinding ty rhs = isUnLiftedType ty && not (exprOkForSpeculation rhs)
-	-- Make a case expression instead of a let
-	-- These can arise either from the desugarer,
-	-- or from beta reductions: (\x.e) (x +# y)
-\end{code}
-
-\begin{code}
-mkAltExpr :: AltCon -> [CoreBndr] -> [Type] -> CoreExpr
-	-- This guy constructs the value that the scrutinee must have
-	-- when you are in one particular branch of a case
-mkAltExpr (DataAlt con) args inst_tys
-  = mkConApp con (map Type inst_tys ++ map varToCoreExpr args)
-mkAltExpr (LitAlt lit) [] []
-  = Lit lit
-
-mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr
-mkIfThenElse guard then_expr else_expr
--- Not going to be refining, so okay to take the type of the "then" clause
-  = Case guard (mkWildId boolTy) (exprType then_expr) 
-	 [ (DataAlt falseDataCon, [], else_expr),	-- Increasing order of tag!
-    	   (DataAlt trueDataCon,  [], then_expr) ]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Taking expressions apart}
-%*									*
-%************************************************************************
-
-The default alternative must be first, if it exists at all.
-This makes it easy to find, though it makes matching marginally harder.
-
-\begin{code}
-findDefault :: [CoreAlt] -> ([CoreAlt], Maybe CoreExpr)
-findDefault ((DEFAULT,args,rhs) : alts) = ASSERT( null args ) (alts, Just rhs)
-findDefault alts			= 		      (alts, Nothing)
-
-findAlt :: AltCon -> [CoreAlt] -> CoreAlt
-findAlt con alts
-  = case alts of
-	(deflt@(DEFAULT,_,_):alts) -> go alts deflt
-	other			   -> go alts panic_deflt
-  where
-    panic_deflt = pprPanic "Missing alternative" (ppr con $$ vcat (map ppr alts))
-
-    go []	 	       deflt = deflt
-    go (alt@(con1,_,_) : alts) deflt
-      =	case con `cmpAltCon` con1 of
-	  LT -> deflt	-- Missed it already; the alts are in increasing order
-	  EQ -> alt
-	  GT -> ASSERT( not (con1 == DEFAULT) ) go alts deflt
-
-isDefaultAlt :: CoreAlt -> Bool
-isDefaultAlt (DEFAULT, _, _) = True
-isDefaultAlt other	     = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Figuring out things about expressions}
-%*									*
-%************************************************************************
-
-@exprIsTrivial@ is true of expressions we are unconditionally happy to
-		duplicate; simple variables and constants, and type
-		applications.  Note that primop Ids aren't considered
-		trivial unless 
-
-@exprIsBottom@	is true of expressions that are guaranteed to diverge
-
-
-There used to be a gruesome test for (hasNoBinding v) in the
-Var case:
-	exprIsTrivial (Var v) | hasNoBinding v = idArity v == 0
-The idea here is that a constructor worker, like $wJust, is
-really short for (\x -> $wJust x), becuase $wJust has no binding.
-So it should be treated like a lambda.  Ditto unsaturated primops.
-But now constructor workers are not "have-no-binding" Ids.  And
-completely un-applied primops and foreign-call Ids are sufficiently
-rare that I plan to allow them to be duplicated and put up with
-saturating them.
-
-SCC notes.  We do not treat (_scc_ "foo" x) as trivial, because 
-  a) it really generates code, (and a heap object when it's 
-     a function arg) to capture the cost centre
-  b) see the note [SCC-and-exprIsTrivial] in Simplify.simplLazyBind
-
-\begin{code}
-exprIsTrivial (Var v)	   = True	-- See notes above
-exprIsTrivial (Type _)	   = True
-exprIsTrivial (Lit lit)    = litIsTrivial lit
-exprIsTrivial (App e arg)  = not (isRuntimeArg arg) && exprIsTrivial e
-exprIsTrivial (Note (SCC _) e) = False		-- See notes above
-exprIsTrivial (Note _       e) = exprIsTrivial e
-exprIsTrivial (Lam b body) = not (isRuntimeVar b) && exprIsTrivial body
-exprIsTrivial other	   = False
-\end{code}
-
-
-@exprIsDupable@	is true of expressions that can be duplicated at a modest
-		cost in code size.  This will only happen in different case
-		branches, so there's no issue about duplicating work.
-
-		That is, exprIsDupable returns True of (f x) even if
-		f is very very expensive to call.
-
-		Its only purpose is to avoid fruitless let-binding
-		and then inlining of case join points
-
-
-\begin{code}
-exprIsDupable (Type _)	     	= True
-exprIsDupable (Var v)	     	= True
-exprIsDupable (Lit lit)      	= litIsDupable lit
-exprIsDupable (Note InlineMe e) = True
-exprIsDupable (Note _ e)        = exprIsDupable e
-exprIsDupable expr	     
-  = go expr 0
-  where
-    go (Var v)   n_args = True
-    go (App f a) n_args =  n_args < dupAppSize
-			&& exprIsDupable a
-			&& go f (n_args+1)
-    go other n_args 	= False
-
-dupAppSize :: Int
-dupAppSize = 4		-- Size of application we are prepared to duplicate
-\end{code}
-
-@exprIsCheap@ looks at a Core expression and returns \tr{True} if
-it is obviously in weak head normal form, or is cheap to get to WHNF.
-[Note that that's not the same as exprIsDupable; an expression might be
-big, and hence not dupable, but still cheap.]
-
-By ``cheap'' we mean a computation we're willing to:
-	push inside a lambda, or
-	inline at more than one place
-That might mean it gets evaluated more than once, instead of being
-shared.  The main examples of things which aren't WHNF but are
-``cheap'' are:
-
-  * 	case e of
-	  pi -> ei
-	(where e, and all the ei are cheap)
-
-  *	let x = e in b
-	(where e and b are cheap)
-
-  *	op x1 ... xn
-	(where op is a cheap primitive operator)
-
-  *	error "foo"
-	(because we are happy to substitute it inside a lambda)
-
-Notice that a variable is considered 'cheap': we can push it inside a lambda,
-because sharing will make sure it is only evaluated once.
-
-\begin{code}
-exprIsCheap :: CoreExpr -> Bool
-exprIsCheap (Lit lit) 		    = True
-exprIsCheap (Type _)        	    = True
-exprIsCheap (Var _)         	    = True
-exprIsCheap (Note InlineMe e)  	    = True
-exprIsCheap (Note _ e)      	    = exprIsCheap e
-exprIsCheap (Lam x e)               = isRuntimeVar x || exprIsCheap e
-exprIsCheap (Case e _ _ alts)       = exprIsCheap e && 
-				    and [exprIsCheap rhs | (_,_,rhs) <- alts]
-	-- Experimentally, treat (case x of ...) as cheap
-	-- (and case __coerce x etc.)
-	-- This improves arities of overloaded functions where
-	-- there is only dictionary selection (no construction) involved
-exprIsCheap (Let (NonRec x _) e)  
-      | isUnLiftedType (idType x) = exprIsCheap e
-      | otherwise		  = False
-	-- strict lets always have cheap right hand sides, and
-	-- do no allocation.
-
-exprIsCheap other_expr 
-  = go other_expr 0 True
-  where
-    go (Var f) n_args args_cheap 
-	= (idAppIsCheap f n_args && args_cheap)
-			-- A constructor, cheap primop, or partial application
-
-	  || idAppIsBottom f n_args 
-			-- Application of a function which
-			-- always gives bottom; we treat this as cheap
-			-- because it certainly doesn't need to be shared!
-	
-    go (App f a) n_args args_cheap 
-	| not (isRuntimeArg a) = go f n_args 	  args_cheap
-	| otherwise            = go f (n_args + 1) (exprIsCheap a && args_cheap)
-
-    go other   n_args args_cheap = False
-
-idAppIsCheap :: Id -> Int -> Bool
-idAppIsCheap id n_val_args 
-  | n_val_args == 0 = True	-- Just a type application of
-				-- a variable (f t1 t2 t3)
-				-- counts as WHNF
-  | otherwise 
-  = case globalIdDetails id of
-	DataConWorkId _ -> True
-	RecordSelId {}  -> n_val_args == 1 	-- I'm experimenting with making record selection
-	ClassOpId _     -> n_val_args == 1 	-- look cheap, so we will substitute it inside a
-						-- lambda.  Particularly for dictionary field selection.
-		-- BUT: Take care with (sel d x)!  The (sel d) might be cheap, but
-		--	there's no guarantee that (sel d x) will be too.  Hence (n_val_args == 1)
-
-	PrimOpId op   -> primOpIsCheap op	-- In principle we should worry about primops
-						-- that return a type variable, since the result
-						-- might be applied to something, but I'm not going
-						-- to bother to check the number of args
-	other	      -> n_val_args < idArity id
-\end{code}
-
-exprOkForSpeculation returns True of an expression that it is
-
-	* safe to evaluate even if normal order eval might not 
-	  evaluate the expression at all, or
-
-	* safe *not* to evaluate even if normal order would do so
-
-It returns True iff
-
-	the expression guarantees to terminate, 
-	soon, 
-	without raising an exception,
-	without causing a side effect (e.g. writing a mutable variable)
-
-E.G.
-	let x = case y# +# 1# of { r# -> I# r# }
-	in E
-==>
-	case y# +# 1# of { r# -> 
-	let x = I# r#
-	in E 
-	}
-
-We can only do this if the (y+1) is ok for speculation: it has no
-side effects, and can't diverge or raise an exception.
-
-\begin{code}
-exprOkForSpeculation :: CoreExpr -> Bool
-exprOkForSpeculation (Lit _)    = True
-exprOkForSpeculation (Type _)   = True
-exprOkForSpeculation (Var v)    = isUnLiftedType (idType v)
-exprOkForSpeculation (Note _ e) = exprOkForSpeculation e
-exprOkForSpeculation other_expr
-  = case collectArgs other_expr of
-	(Var f, args) -> spec_ok (globalIdDetails f) args
-	other	      -> False
- 
-  where
-    spec_ok (DataConWorkId _) args
-      = True	-- The strictness of the constructor has already
-		-- been expressed by its "wrapper", so we don't need
-		-- to take the arguments into account
-
-    spec_ok (PrimOpId op) args
-      | isDivOp op,		-- Special case for dividing operations that fail
-	[arg1, Lit lit] <- args	-- only if the divisor is zero
-      = not (isZeroLit lit) && exprOkForSpeculation arg1
-		-- Often there is a literal divisor, and this 
-		-- can get rid of a thunk in an inner looop
-
-      | otherwise
-      = primOpOkForSpeculation op && 
-	all exprOkForSpeculation args
-				-- A bit conservative: we don't really need
-				-- to care about lazy arguments, but this is easy
-
-    spec_ok other args = False
-
-isDivOp :: PrimOp -> Bool
--- True of dyadic operators that can fail 
--- only if the second arg is zero
--- This function probably belongs in PrimOp, or even in 
--- an automagically generated file.. but it's such a 
--- special case I thought I'd leave it here for now.
-isDivOp IntQuotOp	 = True
-isDivOp IntRemOp	 = True
-isDivOp WordQuotOp	 = True
-isDivOp WordRemOp	 = True
-isDivOp IntegerQuotRemOp = True
-isDivOp IntegerDivModOp  = True
-isDivOp FloatDivOp       = True
-isDivOp DoubleDivOp      = True
-isDivOp other		 = False
-\end{code}
-
-
-\begin{code}
-exprIsBottom :: CoreExpr -> Bool	-- True => definitely bottom
-exprIsBottom e = go 0 e
-	       where
-		-- n is the number of args
-		 go n (Note _ e)     = go n e
-		 go n (Let _ e)      = go n e
-		 go n (Case e _ _ _) = go 0 e	-- Just check the scrut
-		 go n (App e _)      = go (n+1) e
-		 go n (Var v)        = idAppIsBottom v n
-		 go n (Lit _)        = False
-		 go n (Lam _ _)	     = False
-		 go n (Type _)	     = False
-
-idAppIsBottom :: Id -> Int -> Bool
-idAppIsBottom id n_val_args = appIsBottom (idNewStrictness id) n_val_args
-\end{code}
-
-@exprIsHNF@ returns true for expressions that are certainly *already* 
-evaluated to *head* normal form.  This is used to decide whether it's ok 
-to change
-
-	case x of _ -> e   ===>   e
-
-and to decide whether it's safe to discard a `seq`
-
-So, it does *not* treat variables as evaluated, unless they say they are.
-
-But it *does* treat partial applications and constructor applications
-as values, even if their arguments are non-trivial, provided the argument
-type is lifted; 
-	e.g.  (:) (f x) (map f xs)	is a value
-	      map (...redex...)		is a value
-Because `seq` on such things completes immediately
-
-For unlifted argument types, we have to be careful:
-		C (f x :: Int#)
-Suppose (f x) diverges; then C (f x) is not a value.  True, but
-this form is illegal (see the invariants in CoreSyn).  Args of unboxed
-type must be ok-for-speculation (or trivial).
-
-\begin{code}
-exprIsHNF :: CoreExpr -> Bool		-- True => Value-lambda, constructor, PAP
-exprIsHNF (Var v) 	-- NB: There are no value args at this point
-  =  isDataConWorkId v 	-- Catches nullary constructors, 
-			--	so that [] and () are values, for example
-  || idArity v > 0 	-- Catches (e.g.) primops that don't have unfoldings
-  || isEvaldUnfolding (idUnfolding v)
-	-- Check the thing's unfolding; it might be bound to a value
-	-- A worry: what if an Id's unfolding is just itself: 
-	-- then we could get an infinite loop...
-
-exprIsHNF (Lit l)	     = True
-exprIsHNF (Type ty)	     = True	-- Types are honorary Values; 
-					-- we don't mind copying them
-exprIsHNF (Lam b e)  	     = isRuntimeVar b || exprIsHNF e
-exprIsHNF (Note _ e) 	     = exprIsHNF e
-exprIsHNF (App e (Type _)) = exprIsHNF e
-exprIsHNF (App e a)        = app_is_value e [a]
-exprIsHNF other	     = False
-
--- There is at least one value argument
-app_is_value (Var fun) args
-  |  isDataConWorkId fun 			-- Constructor apps are values
-  || idArity fun > valArgCount args	-- Under-applied function
-  = check_args (idType fun) args
-app_is_value (App f a) as = app_is_value f (a:as)
-app_is_value other     as = False
-
-	-- 'check_args' checks that unlifted-type args
-	-- are in fact guaranteed non-divergent
-check_args fun_ty []	          = True
-check_args fun_ty (Type _ : args) = case splitForAllTy_maybe fun_ty of
-				      Just (_, ty) -> check_args ty args
-check_args fun_ty (arg : args)
-  | isUnLiftedType arg_ty = exprOkForSpeculation arg
-  | otherwise		  = check_args res_ty args
-  where
-    (arg_ty, res_ty) = splitFunTy fun_ty
-\end{code}
-
-\begin{code}
-exprIsConApp_maybe :: CoreExpr -> Maybe (DataCon, [CoreExpr])
-exprIsConApp_maybe (Note (Coerce to_ty from_ty) expr)
-  = 	-- Maybe this is over the top, but here we try to turn
-	-- 	coerce (S,T) ( x, y )
-	-- effectively into 
-	--	( coerce S x, coerce T y )
-	-- This happens in anger in PrelArrExts which has a coerce
-	--	case coerce memcpy a b of
-	--	  (# r, s #) -> ...
-	-- where the memcpy is in the IO monad, but the call is in
-	-- the (ST s) monad
-    case exprIsConApp_maybe expr of {
-	Nothing 	  -> Nothing ;
-	Just (dc, args)   -> 
-  
-    case splitTyConApp_maybe to_ty of {
-	Nothing -> Nothing ;
-	Just (tc, tc_arg_tys) | tc /= dataConTyCon dc     -> Nothing
-			      | not (isVanillaDataCon dc) -> Nothing
-			      | otherwise	          ->
-		-- Type constructor must match
-		-- We knock out existentials to keep matters simple(r)
-    let
-	arity   	 = tyConArity tc
-	val_args	 = drop arity args
-	to_arg_tys 	 = dataConInstArgTys dc tc_arg_tys
-	mk_coerce ty arg = mkCoerce ty arg
-	new_val_args	 = zipWith mk_coerce to_arg_tys val_args
-    in
-    ASSERT( all isTypeArg (take arity args) )
-    ASSERT( equalLength val_args to_arg_tys )
-    Just (dc, map Type tc_arg_tys ++ new_val_args)
-    }}
-
-exprIsConApp_maybe (Note _ expr)
-  = exprIsConApp_maybe expr
-    -- We ignore InlineMe notes in case we have
-    --	x = __inline_me__ (a,b)
-    -- All part of making sure that INLINE pragmas never hurt
-    -- Marcin tripped on this one when making dictionaries more inlinable
-    --
-    -- In fact, we ignore all notes.  For example,
-    --  	case _scc_ "foo" (C a b) of
-    --			C a b -> e
-    -- should be optimised away, but it will be only if we look
-    -- through the SCC note.
-
-exprIsConApp_maybe expr = analyse (collectArgs expr)
-  where
-    analyse (Var fun, args)
-	| Just con <- isDataConWorkId_maybe fun,
-	  args `lengthAtLeast` dataConRepArity con
-		-- Might be > because the arity excludes type args
-	= Just (con,args)
-
-	-- Look through unfoldings, but only cheap ones, because
-	-- we are effectively duplicating the unfolding
-    analyse (Var fun, [])
-	| let unf = idUnfolding fun,
-	  isCheapUnfolding unf
-	= exprIsConApp_maybe (unfoldingTemplate unf)
-
-    analyse other = Nothing
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Eta reduction and expansion}
-%*									*
-%************************************************************************
-
-\begin{code}
-exprEtaExpandArity :: CoreExpr -> Arity
-{- The Arity returned is the number of value args the 
-   thing can be applied to without doing much work
-
-exprEtaExpandArity is used when eta expanding
-	e  ==>  \xy -> e x y
-
-It returns 1 (or more) to:
-	case x of p -> \s -> ...
-because for I/O ish things we really want to get that \s to the top.
-We are prepared to evaluate x each time round the loop in order to get that
-
-It's all a bit more subtle than it looks:
-
-1.  One-shot lambdas
-
-Consider one-shot lambdas
-		let x = expensive in \y z -> E
-We want this to have arity 2 if the \y-abstraction is a 1-shot lambda
-Hence the ArityType returned by arityType
-
-2.  The state-transformer hack
-
-The one-shot lambda special cause is particularly important/useful for
-IO state transformers, where we often get
-	let x = E in \ s -> ...
-
-and the \s is a real-world state token abstraction.  Such abstractions
-are almost invariably 1-shot, so we want to pull the \s out, past the
-let x=E, even if E is expensive.  So we treat state-token lambdas as 
-one-shot even if they aren't really.  The hack is in Id.isOneShotBndr.
-
-3.  Dealing with bottom
-
-Consider also 
-	f = \x -> error "foo"
-Here, arity 1 is fine.  But if it is
-	f = \x -> case x of 
-			True  -> error "foo"
-			False -> \y -> x+y
-then we want to get arity 2.  Tecnically, this isn't quite right, because
-	(f True) `seq` 1
-should diverge, but it'll converge if we eta-expand f.  Nevertheless, we
-do so; it improves some programs significantly, and increasing convergence
-isn't a bad thing.  Hence the ABot/ATop in ArityType.
-
-Actually, the situation is worse.  Consider
-	f = \x -> case x of
-			True  -> \y -> x+y
-			False -> \y -> x-y
-Can we eta-expand here?  At first the answer looks like "yes of course", but
-consider
-	(f bot) `seq` 1
-This should diverge!  But if we eta-expand, it won't.   Again, we ignore this
-"problem", because being scrupulous would lose an important transformation for
-many programs.
-
-
-4. Newtypes
-
-Non-recursive newtypes are transparent, and should not get in the way.
-We do (currently) eta-expand recursive newtypes too.  So if we have, say
-
-	newtype T = MkT ([T] -> Int)
-
-Suppose we have
-	e = coerce T f
-where f has arity 1.  Then: etaExpandArity e = 1; 
-that is, etaExpandArity looks through the coerce.
-
-When we eta-expand e to arity 1: eta_expand 1 e T
-we want to get: 		 coerce T (\x::[T] -> (coerce ([T]->Int) e) x)
-
-HOWEVER, note that if you use coerce bogusly you can ge
-	coerce Int negate
-And since negate has arity 2, you might try to eta expand.  But you can't
-decopose Int to a function type.   Hence the final case in eta_expand.
--}
-
-
-exprEtaExpandArity e = arityDepth (arityType e)
-
--- A limited sort of function type
-data ArityType = AFun Bool ArityType	-- True <=> one-shot
-	       | ATop			-- Know nothing
-	       | ABot			-- Diverges
-
-arityDepth :: ArityType -> Arity
-arityDepth (AFun _ ty) = 1 + arityDepth ty
-arityDepth ty	       = 0
-
-andArityType ABot	    at2		  = at2
-andArityType ATop	    at2		  = ATop
-andArityType (AFun t1 at1)  (AFun t2 at2) = AFun (t1 && t2) (andArityType at1 at2)
-andArityType at1	    at2		  = andArityType at2 at1
-
-arityType :: CoreExpr -> ArityType
-	-- (go1 e) = [b1,..,bn]
-	-- means expression can be rewritten \x_b1 -> ... \x_bn -> body
-	-- where bi is True <=> the lambda is one-shot
-
-arityType (Note n e) = arityType e
---	Not needed any more: etaExpand is cleverer
---  | ok_note n = arityType e
---  | otherwise = ATop
-
-arityType (Var v) 
-  = mk (idArity v) (arg_tys (idType v))
-  where
-    mk :: Arity -> [Type] -> ArityType
-	-- The argument types are only to steer the "state hack"
-	-- Consider case x of
-	--		True  -> foo
-	--		False -> \(s:RealWorld) -> e
-	-- where foo has arity 1.  Then we want the state hack to
-	-- apply to foo too, so we can eta expand the case.
-    mk 0 tys | isBottomingId v  = ABot
-             | otherwise	= ATop
-    mk n (ty:tys) = AFun (isStateHackType ty) (mk (n-1) tys)
-    mk n []       = AFun False		      (mk (n-1) [])
-
-    arg_tys :: Type -> [Type]	-- Ignore for-alls
-    arg_tys ty 
-	| Just (_, ty')  <- splitForAllTy_maybe ty = arg_tys ty'
-	| Just (arg,res) <- splitFunTy_maybe ty    = arg : arg_tys res
-	| otherwise				   = []
-
-	-- Lambdas; increase arity
-arityType (Lam x e) | isId x    = AFun (isOneShotBndr x) (arityType e)
-		    | otherwise	= arityType e
-
-	-- Applications; decrease arity
-arityType (App f (Type _)) = arityType f
-arityType (App f a)  	   = case arityType f of
-				AFun one_shot xs | exprIsCheap a -> xs
-				other				 -> ATop
-							   
-	-- Case/Let; keep arity if either the expression is cheap
-	-- or it's a 1-shot lambda
-	-- The former is not really right for Haskell
-	--	f x = case x of { (a,b) -> \y. e }
-	--  ===>
-	--	f x y = case x of { (a,b) -> e }
-	-- The difference is observable using 'seq'
-arityType (Case scrut _ _ alts) = case foldr1 andArityType [arityType rhs | (_,_,rhs) <- alts] of
-				  xs@(AFun one_shot _) | one_shot -> xs
-				  xs | exprIsCheap scrut	  -> xs
-				     | otherwise	 	  -> ATop
-
-arityType (Let b e) = case arityType e of
-		        xs@(AFun one_shot _) | one_shot			      -> xs
-		        xs		     | all exprIsCheap (rhssOfBind b) -> xs
-					     | otherwise		      -> ATop
-
-arityType other = ATop
-
-{- NOT NEEDED ANY MORE: etaExpand is cleverer
-ok_note InlineMe = False
-ok_note other    = True
-    -- Notice that we do not look through __inline_me__
-    -- This may seem surprising, but consider
-    --		f = _inline_me (\x -> e)
-    -- We DO NOT want to eta expand this to
-    --		f = \x -> (_inline_me (\x -> e)) x
-    -- because the _inline_me gets dropped now it is applied, 
-    -- giving just
-    --		f = \x -> e
-    -- A Bad Idea
--}
-\end{code}
-
-
-\begin{code}
-etaExpand :: Arity	  	-- Result should have this number of value args
-	  -> [Unique]
-	  -> CoreExpr -> Type	-- Expression and its type
-	  -> CoreExpr
--- (etaExpand n us e ty) returns an expression with 
--- the same meaning as 'e', but with arity 'n'.  
---
--- Given e' = etaExpand n us e ty
--- We should have
---	ty = exprType e = exprType e'
---
--- Note that SCCs are not treated specially.  If we have
---	etaExpand 2 (\x -> scc "foo" e)
---	= (\xy -> (scc "foo" e) y)
--- So the costs of evaluating 'e' (not 'e y') are attributed to "foo"
-
-etaExpand n us expr ty
-  | manifestArity expr >= n = expr		-- The no-op case
-  | otherwise 		    = eta_expand n us expr ty
-  where
-
--- manifestArity sees how many leading value lambdas there are
-manifestArity :: CoreExpr -> Arity
-manifestArity (Lam v e) | isId v    = 1 + manifestArity e
-			| otherwise = manifestArity e
-manifestArity (Note _ e)	    = manifestArity e
-manifestArity e			    = 0
-
--- etaExpand deals with for-alls. For example:
---		etaExpand 1 E
--- where  E :: forall a. a -> a
--- would return
---	(/\b. \y::a -> E b y)
---
--- It deals with coerces too, though they are now rare
--- so perhaps the extra code isn't worth it
-
-eta_expand n us expr ty
-  | n == 0 && 
-    -- The ILX code generator requires eta expansion for type arguments
-    -- too, but alas the 'n' doesn't tell us how many of them there 
-    -- may be.  So we eagerly eta expand any big lambdas, and just
-    -- cross our fingers about possible loss of sharing in the ILX case. 
-    -- The Right Thing is probably to make 'arity' include
-    -- type variables throughout the compiler.  (ToDo.)
-    not (isForAllTy ty)	
-    -- Saturated, so nothing to do
-  = expr
-
-	-- Short cut for the case where there already
-	-- is a lambda; no point in gratuitously adding more
-eta_expand n us (Lam v body) ty
-  | isTyVar v
-  = Lam v (eta_expand n us body (applyTy ty (mkTyVarTy v)))
-
-  | otherwise
-  = Lam v (eta_expand (n-1) us body (funResultTy ty))
-
--- We used to have a special case that stepped inside Coerces here,
--- thus:  eta_expand n us (Note note@(Coerce _ ty) e) _  
---		= Note note (eta_expand n us e ty)
--- BUT this led to an infinite loop
--- Example: 	newtype T = MkT (Int -> Int)
---	eta_expand 1 (coerce (Int->Int) e)
---	--> coerce (Int->Int) (eta_expand 1 T e)
---		by the bogus eqn
---	--> coerce (Int->Int) (coerce T 
---		(\x::Int -> eta_expand 1 (coerce (Int->Int) e)))
---		by the splitNewType_maybe case below
---	and round we go
-
-eta_expand n us expr ty
-  = case splitForAllTy_maybe ty of { 
- 	  Just (tv,ty') -> Lam tv (eta_expand n us (App expr (Type (mkTyVarTy tv))) ty')
-
- 	; Nothing ->
-  
-    	case splitFunTy_maybe ty of {
- 	  Just (arg_ty, res_ty) -> Lam arg1 (eta_expand (n-1) us2 (App expr (Var arg1)) res_ty)
-				where
-				   arg1	      = mkSysLocal FSLIT("eta") uniq arg_ty
- 				   (uniq:us2) = us
-				   
-	; Nothing ->
-
-		-- Given this:
-		-- 	newtype T = MkT ([T] -> Int)
-		-- Consider eta-expanding this
-		--  	eta_expand 1 e T
-		-- We want to get
-		--	coerce T (\x::[T] -> (coerce ([T]->Int) e) x)
-		-- Only try this for recursive newtypes; the non-recursive kind
-		-- are transparent anyway
-
-    	case splitRecNewType_maybe ty of {
- 	  Just ty' -> mkCoerce2 ty ty' (eta_expand n us (mkCoerce2 ty' ty expr) ty') ;
- 	  Nothing  -> 
-
-	-- We have an expression of arity > 0, but its type isn't a function
-	-- This *can* legitmately happen: e.g. 	coerce Int (\x. x)
-	-- Essentially the programmer is playing fast and loose with types
-	-- (Happy does this a lot).  So we simply decline to eta-expand.
-	expr
-    	}}}
-\end{code}
-
-exprArity is a cheap-and-cheerful version of exprEtaExpandArity.
-It tells how many things the expression can be applied to before doing
-any work.  It doesn't look inside cases, lets, etc.  The idea is that
-exprEtaExpandArity will do the hard work, leaving something that's easy
-for exprArity to grapple with.  In particular, Simplify uses exprArity to
-compute the ArityInfo for the Id. 
-
-Originally I thought that it was enough just to look for top-level lambdas, but
-it isn't.  I've seen this
-
-	foo = PrelBase.timesInt
-
-We want foo to get arity 2 even though the eta-expander will leave it
-unchanged, in the expectation that it'll be inlined.  But occasionally it
-isn't, because foo is blacklisted (used in a rule).  
-
-Similarly, see the ok_note check in exprEtaExpandArity.  So 
-	f = __inline_me (\x -> e)
-won't be eta-expanded.
-
-And in any case it seems more robust to have exprArity be a bit more intelligent.
-But note that 	(\x y z -> f x y z)
-should have arity 3, regardless of f's arity.
-
-\begin{code}
-exprArity :: CoreExpr -> Arity
-exprArity e = go e
-	    where
-	      go (Var v) 	       	   = idArity v
-	      go (Lam x e) | isId x    	   = go e + 1
-			   | otherwise 	   = go e
-	      go (Note n e) 		   = go e
-	      go (App e (Type t))      	   = go e
-	      go (App f a) | exprIsCheap a = (go f - 1) `max` 0
-		-- NB: exprIsCheap a!  
-		--	f (fac x) does not have arity 2, 
-		-- 	even if f has arity 3!
-		-- NB: `max 0`!  (\x y -> f x) has arity 2, even if f is
-		--		 unknown, hence arity 0
-	      go _		       	   = 0
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Equality}
-%*									*
-%************************************************************************
-
-@cheapEqExpr@ is a cheap equality test which bales out fast!
-	True  => definitely equal
-	False => may or may not be equal
-
-\begin{code}
-cheapEqExpr :: Expr b -> Expr b -> Bool
-
-cheapEqExpr (Var v1)   (Var v2)   = v1==v2
-cheapEqExpr (Lit lit1) (Lit lit2) = lit1 == lit2
-cheapEqExpr (Type t1)  (Type t2)  = t1 `coreEqType` t2
-
-cheapEqExpr (App f1 a1) (App f2 a2)
-  = f1 `cheapEqExpr` f2 && a1 `cheapEqExpr` a2
-
-cheapEqExpr _ _ = False
-
-exprIsBig :: Expr b -> Bool
--- Returns True of expressions that are too big to be compared by cheapEqExpr
-exprIsBig (Lit _)      = False
-exprIsBig (Var v)      = False
-exprIsBig (Type t)     = False
-exprIsBig (App f a)    = exprIsBig f || exprIsBig a
-exprIsBig other	       = True
-\end{code}
-
-
-\begin{code}
-tcEqExpr :: CoreExpr -> CoreExpr -> Bool
--- Used in rule matching, so does *not* look through 
--- newtypes, predicate types; hence tcEqExpr
-
-tcEqExpr e1 e2 = tcEqExprX rn_env e1 e2
-  where
-    rn_env = mkRnEnv2 (mkInScopeSet (exprFreeVars e1 `unionVarSet` exprFreeVars e2))
-
-tcEqExprX :: RnEnv2 -> CoreExpr -> CoreExpr -> Bool
-tcEqExprX env (Var v1)	   (Var v2)	= rnOccL env v1 == rnOccR env v2
-tcEqExprX env (Lit lit1)   (Lit lit2)   = lit1 == lit2
-tcEqExprX env (App f1 a1)  (App f2 a2)  = tcEqExprX env f1 f2 && tcEqExprX env a1 a2
-tcEqExprX env (Lam v1 e1)  (Lam v2 e2)  = tcEqExprX (rnBndr2 env v1 v2) e1 e2
-tcEqExprX env (Let (NonRec v1 r1) e1)
-	      (Let (NonRec v2 r2) e2)   = tcEqExprX env r1 r2 
-				       && tcEqExprX (rnBndr2 env v1 v2) e1 e2
-tcEqExprX env (Let (Rec ps1) e1)
-	      (Let (Rec ps2) e2)        =  equalLength ps1 ps2
-				        && and (zipWith eq_rhs ps1 ps2)
-				        && tcEqExprX env' e1 e2
-				     where
-				       env' = foldl2 rn_bndr2 env ps2 ps2
-				       rn_bndr2 env (b1,_) (b2,_) = rnBndr2 env b1 b2
-				       eq_rhs       (_,r1) (_,r2) = tcEqExprX env' r1 r2
-tcEqExprX env (Case e1 v1 t1 a1)
-	      (Case e2 v2 t2 a2)     =  tcEqExprX env e1 e2
-                                     && tcEqTypeX env t1 t2                      
-				     && equalLength a1 a2
-				     && and (zipWith (eq_alt env') a1 a2)
-				     where
-				       env' = rnBndr2 env v1 v2
-
-tcEqExprX env (Note n1 e1) (Note n2 e2) = eq_note env n1 n2 && tcEqExprX env e1 e2
-tcEqExprX env (Type t1)    (Type t2)    = tcEqTypeX env t1 t2
-tcEqExprX env e1		e2	= False
-				         
-eq_alt env (c1,vs1,r1) (c2,vs2,r2) = c1==c2 && tcEqExprX (rnBndrs2 env vs1  vs2) r1 r2
-
-eq_note env (SCC cc1)      (SCC cc2)      = cc1 == cc2
-eq_note env (Coerce t1 f1) (Coerce t2 f2) = tcEqTypeX env t1 t2 && tcEqTypeX env f1 f2
-eq_note env InlineCall     InlineCall     = True
-eq_note env (CoreNote s1)  (CoreNote s2)  = s1 == s2
-eq_note env other1	       other2	  = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The size of an expression}
-%*									*
-%************************************************************************
-
-\begin{code}
-coreBindsSize :: [CoreBind] -> Int
-coreBindsSize bs = foldr ((+) . bindSize) 0 bs
-
-exprSize :: CoreExpr -> Int
-	-- A measure of the size of the expressions
-	-- It also forces the expression pretty drastically as a side effect
-exprSize (Var v)         = v `seq` 1
-exprSize (Lit lit)       = lit `seq` 1
-exprSize (App f a)       = exprSize f + exprSize a
-exprSize (Lam b e)       = varSize b + exprSize e
-exprSize (Let b e)       = bindSize b + exprSize e
-exprSize (Case e b t as) = seqType t `seq` exprSize e + varSize b + 1 + foldr ((+) . altSize) 0 as
-exprSize (Note n e)      = noteSize n + exprSize e
-exprSize (Type t)        = seqType t `seq` 1
-
-noteSize (SCC cc)       = cc `seq` 1
-noteSize (Coerce t1 t2) = seqType t1 `seq` seqType t2 `seq` 1
-noteSize InlineCall     = 1
-noteSize InlineMe       = 1
-noteSize (CoreNote s)   = s `seq` 1  -- hdaume: core annotations
-
-varSize :: Var -> Int
-varSize b  | isTyVar b = 1
-	   | otherwise = seqType (idType b)		`seq`
-			 megaSeqIdInfo (idInfo b) 	`seq`
-			 1
-
-varsSize = foldr ((+) . varSize) 0
-
-bindSize (NonRec b e) = varSize b + exprSize e
-bindSize (Rec prs)    = foldr ((+) . pairSize) 0 prs
-
-pairSize (b,e) = varSize b + exprSize e
-
-altSize (c,bs,e) = c `seq` varsSize bs + exprSize e
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Hashing}
-%*									*
-%************************************************************************
-
-\begin{code}
-hashExpr :: CoreExpr -> Int
-hashExpr e | hash < 0  = 77	-- Just in case we hit -maxInt
-	   | otherwise = hash
-	   where
-	     hash = abs (hash_expr e)	-- Negative numbers kill UniqFM
-
-hash_expr (Note _ e)   		  = hash_expr e
-hash_expr (Let (NonRec b r) e)    = hashId b
-hash_expr (Let (Rec ((b,r):_)) e) = hashId b
-hash_expr (Case _ b _ _)	  = hashId b
-hash_expr (App f e)   		  = hash_expr f * fast_hash_expr e
-hash_expr (Var v)     		  = hashId v
-hash_expr (Lit lit)	   	  = hashLiteral lit
-hash_expr (Lam b _)	          = hashId b
-hash_expr (Type t)	          = trace "hash_expr: type" 1		-- Shouldn't happen
-
-fast_hash_expr (Var v)     	= hashId v
-fast_hash_expr (Lit lit)	= hashLiteral lit
-fast_hash_expr (App f (Type _)) = fast_hash_expr f
-fast_hash_expr (App f a)        = fast_hash_expr a
-fast_hash_expr (Lam b _)        = hashId b
-fast_hash_expr other	        = 1
-
-hashId :: Id -> Int
-hashId id = hashName (idName id)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Determining non-updatable right-hand-sides}
-%*									*
-%************************************************************************
-
-Top-level constructor applications can usually be allocated
-statically, but they can't if the constructor, or any of the
-arguments, come from another DLL (because we can't refer to static
-labels in other DLLs).
-
-If this happens we simply make the RHS into an updatable thunk, 
-and 'exectute' it rather than allocating it statically.
-
-\begin{code}
-rhsIsStatic :: HomeModules -> CoreExpr -> Bool
--- This function is called only on *top-level* right-hand sides
--- Returns True if the RHS can be allocated statically, with
--- no thunks involved at all.
---
--- It's called (i) in TidyPgm.hasCafRefs to decide if the rhs is, or
--- refers to, CAFs; and (ii) in CoreToStg to decide whether to put an
--- update flag on it.
---
--- The basic idea is that rhsIsStatic returns True only if the RHS is
---	(a) a value lambda
---	(b) a saturated constructor application with static args
---
--- BUT watch out for
---  (i)	Any cross-DLL references kill static-ness completely
---	because they must be 'executed' not statically allocated
---      ("DLL" here really only refers to Windows DLLs, on other platforms,
---      this is not necessary)
---
--- (ii) We treat partial applications as redexes, because in fact we 
---	make a thunk for them that runs and builds a PAP
--- 	at run-time.  The only appliations that are treated as 
---	static are *saturated* applications of constructors.
-
--- We used to try to be clever with nested structures like this:
---		ys = (:) w ((:) w [])
--- on the grounds that CorePrep will flatten ANF-ise it later.
--- But supporting this special case made the function much more 
--- complicated, because the special case only applies if there are no 
--- enclosing type lambdas:
---		ys = /\ a -> Foo (Baz ([] a))
--- Here the nested (Baz []) won't float out to top level in CorePrep.
---
--- But in fact, even without -O, nested structures at top level are 
--- flattened by the simplifier, so we don't need to be super-clever here.
---
--- Examples
---
---	f = \x::Int. x+7	TRUE
---	p = (True,False)	TRUE
---
---	d = (fst p, False)	FALSE because there's a redex inside
---				(this particular one doesn't happen but...)
---
---	h = D# (1.0## /## 2.0##)	FALSE (redex again)
---	n = /\a. Nil a			TRUE
---
---	t = /\a. (:) (case w a of ...) (Nil a)	FALSE (redex)
---
---
--- This is a bit like CoreUtils.exprIsHNF, with the following differences:
---    a) scc "foo" (\x -> ...) is updatable (so we catch the right SCC)
---
---    b) (C x xs), where C is a contructors is updatable if the application is
---	   dynamic
--- 
---    c) don't look through unfolding of f in (f x).
---
--- When opt_RuntimeTypes is on, we keep type lambdas and treat
--- them as making the RHS re-entrant (non-updatable).
-
-rhsIsStatic hmods rhs = is_static False rhs
-  where
-  is_static :: Bool	-- True <=> in a constructor argument; must be atomic
-  	  -> CoreExpr -> Bool
-  
-  is_static False (Lam b e) = isRuntimeVar b || is_static False e
-  
-  is_static in_arg (Note (SCC _) e) = False
-  is_static in_arg (Note _ e)       = is_static in_arg e
-  
-  is_static in_arg (Lit lit)
-    = case lit of
-  	MachLabel _ _ -> False
-  	other 	      -> True
-  	-- A MachLabel (foreign import "&foo") in an argument
-  	-- prevents a constructor application from being static.  The
-  	-- reason is that it might give rise to unresolvable symbols
-  	-- in the object file: under Linux, references to "weak"
-  	-- symbols from the data segment give rise to "unresolvable
-  	-- relocation" errors at link time This might be due to a bug
-  	-- in the linker, but we'll work around it here anyway. 
-  	-- SDM 24/2/2004
-  
-  is_static in_arg other_expr = go other_expr 0
-   where
-    go (Var f) n_val_args
-#if mingw32_TARGET_OS
-        | not (isDllName hmods (idName f))
-#endif
-	=  saturated_data_con f n_val_args
-	|| (in_arg && n_val_args == 0)	
-		-- A naked un-applied variable is *not* deemed a static RHS
-		-- E.g.		f = g
-		-- Reason: better to update so that the indirection gets shorted
-		-- 	   out, and the true value will be seen
-		-- NB: if you change this, you'll break the invariant that THUNK_STATICs
-		--     are always updatable.  If you do so, make sure that non-updatable
-		--     ones have enough space for their static link field!
-
-    go (App f a) n_val_args
-	| isTypeArg a 			 = go f n_val_args
-	| not in_arg && is_static True a = go f (n_val_args + 1)
-	-- The (not in_arg) checks that we aren't in a constructor argument;
-	-- if we are, we don't allow (value) applications of any sort
-	-- 
-        -- NB. In case you wonder, args are sometimes not atomic.  eg.
-        --   x = D# (1.0## /## 2.0##)
-        -- can't float because /## can fail.
-
-    go (Note (SCC _) f) n_val_args = False
-    go (Note _ f) n_val_args       = go f n_val_args
-
-    go other n_val_args = False
-
-    saturated_data_con f n_val_args
-	= case isDataConWorkId_maybe f of
-	    Just dc -> n_val_args == dataConRepArity dc
-	    Nothing -> False
-\end{code}
diff --git a/ghc/compiler/coreSyn/ExternalCore.lhs b/ghc/compiler/coreSyn/ExternalCore.lhs
deleted file mode 100644
index 09a6e7f7da..0000000000
--- a/ghc/compiler/coreSyn/ExternalCore.lhs
+++ /dev/null
@@ -1,89 +0,0 @@
-%
-% (c) The University of Glasgow 2001
-%
-\begin{code}
-
-module ExternalCore where
-
-
-data Module 
- = Module Mname [Tdef] [Vdefg]
-
-data Tdef 
-  = Data (Qual Tcon) [Tbind] [Cdef]
-  | Newtype (Qual Tcon) [Tbind] (Maybe Ty)
-
-data Cdef 
-  = Constr Dcon [Tbind] [Ty]
-  | GadtConstr Dcon Ty
-
-data Vdefg 
-  = Rec [Vdef]
-  | Nonrec Vdef
-
-type Vdef = (Var,Ty,Exp) 	-- Top level bindings are unqualified now
-
-data Exp 
-  = Var (Qual Var)
-  | Dcon (Qual Dcon)
-  | Lit Lit
-  | App Exp Exp
-  | Appt Exp Ty
-  | Lam Bind Exp 	  
-  | Let Vdefg Exp
-  | Case Exp Vbind Ty [Alt] {- non-empty list -}
-  | Coerce Ty Exp 
-  | Note String Exp
-  | External String Ty
-
-data Bind 
-  = Vb Vbind
-  | Tb Tbind
-
-data Alt 
-  = Acon (Qual Dcon) [Tbind] [Vbind] Exp
-  | Alit Lit Exp
-  | Adefault Exp
-
-type Vbind = (Var,Ty)
-type Tbind = (Tvar,Kind)
-
-data Ty 
-  = Tvar Tvar
-  | Tcon (Qual Tcon)
-  | Tapp Ty Ty
-  | Tforall Tbind Ty 
-
-data Kind 
-  = Klifted
-  | Kunlifted
-  | Kopen
-  | Karrow Kind Kind
-
-data Lit 
-  = Lint Integer Ty
-  | Lrational Rational Ty
-  | Lchar Char Ty
-  | Lstring String Ty
-  
-
-type Mname = Id
-type Var = Id
-type Tvar = Id
-type Tcon = Id
-type Dcon = Id
-
-type Qual t = (Mname,t)
-
-type Id = String
-
-primMname = "GHCziPrim"
-
-tcArrow :: Qual Tcon
-tcArrow = (primMname, "ZLzmzgZR")
-
-\end{code}
-
-
-
-
diff --git a/ghc/compiler/coreSyn/MkExternalCore.lhs b/ghc/compiler/coreSyn/MkExternalCore.lhs
deleted file mode 100644
index 291b16e823..0000000000
--- a/ghc/compiler/coreSyn/MkExternalCore.lhs
+++ /dev/null
@@ -1,222 +0,0 @@
-%
-% (c) The University of Glasgow 2001
-%
-\begin{code}
-
-module MkExternalCore (
-	emitExternalCore
-) where
-
-#include "HsVersions.h"
-
-import qualified ExternalCore as C
-import Char
-import Module
-import CoreSyn
-import HscTypes	
-import TyCon
-import TypeRep
-import Type
-import PprExternalCore	-- Instances
-import DataCon	( DataCon, dataConTyVars, dataConRepArgTys, 
-		  dataConName, dataConTyCon )
-import CoreSyn
-import Var
-import IdInfo
-import Kind
-import Literal
-import Name
-import Outputable
-import ForeignCall
-import DynFlags	( DynFlags(..) )
-import StaticFlags	( opt_EmitExternalCore )
-import IO
-import FastString
-
-emitExternalCore :: DynFlags -> CgGuts -> IO ()
-emitExternalCore dflags cg_guts
- | opt_EmitExternalCore 
- = (do handle <- openFile corename WriteMode
-       hPutStrLn handle (show (mkExternalCore cg_guts))      
-       hClose handle)
-   `catch` (\err -> pprPanic "Failed to open or write external core output file" 
-	                     (text corename))
-   where corename = extCoreName dflags
-emitExternalCore _ _
- | otherwise
- = return ()
-
-
-mkExternalCore :: CgGuts -> C.Module
--- The ModGuts has been tidied, but the implicit bindings have
--- not been injected, so we have to add them manually here
--- We don't include the strange data-con *workers* because they are
--- implicit in the data type declaration itself
-mkExternalCore (CgGuts {cg_module=this_mod, cg_tycons = tycons, cg_binds = binds})
-  = C.Module mname tdefs (map make_vdef binds)
-  where
-    mname  = make_mid this_mod
-    tdefs  = foldr collect_tdefs [] tycons
-
-collect_tdefs :: TyCon -> [C.Tdef] -> [C.Tdef]
-collect_tdefs tcon tdefs 
-  | isAlgTyCon tcon = tdef: tdefs
-  where
-    tdef | isNewTyCon tcon = 
-                C.Newtype (make_con_qid (tyConName tcon)) (map make_tbind tyvars) repclause 
-         | null (tyConDataCons tcon) = error "MkExternalCore died: can't handle datatype declarations with no data constructors"
-         | otherwise = 
-                C.Data (make_con_qid (tyConName tcon)) (map make_tbind tyvars) (map make_cdef (tyConDataCons tcon)) 
-         where repclause | isRecursiveTyCon tcon = Nothing
-		         | otherwise = Just (make_ty rep)
-                                           where (_, rep) = newTyConRep tcon
-    tyvars = tyConTyVars tcon
-
-collect_tdefs _ tdefs = tdefs
-
-
-make_cdef :: DataCon -> C.Cdef
-make_cdef dcon =  C.Constr dcon_name existentials tys
-  where 
-    dcon_name    = make_var_id (dataConName dcon)
-    existentials = map make_tbind ex_tyvars
-    ex_tyvars    = drop (tyConArity (dataConTyCon dcon)) (dataConTyVars dcon)
-    tys 	 = map make_ty (dataConRepArgTys dcon)
-
-make_tbind :: TyVar -> C.Tbind
-make_tbind tv = (make_var_id (tyVarName tv), make_kind (tyVarKind tv))
-    
-make_vbind :: Var -> C.Vbind
-make_vbind v = (make_var_id  (Var.varName v), make_ty (idType v))
-
-make_vdef :: CoreBind -> C.Vdefg
-make_vdef b = 
-  case b of
-    NonRec v e -> C.Nonrec (f (v,e))
-    Rec ves -> C.Rec (map f ves)
-  where f (v,e) = (make_var_id (Var.varName v), make_ty (idType v),make_exp e)
-	-- Top level bindings are unqualified now
-
-make_exp :: CoreExpr -> C.Exp
-make_exp (Var v) =  
-  case globalIdDetails v of
-     -- a DataConId represents the Id of a worker, which is a varName. -- sof 4/02
---    DataConId _ -> C.Dcon (make_con_qid (Var.varName v))
-    FCallId (CCall (CCallSpec (StaticTarget nm) _ _)) -> C.External (unpackFS nm) (make_ty (idType v))
-    FCallId _ -> error "MkExternalCore died: can't handle non-static-C foreign call"
-    _ -> C.Var (make_var_qid (Var.varName v))
-make_exp (Lit (l@(MachLabel s _))) = error "MkExternalCore died: can't handle \"foreign label\" declarations"
-make_exp (Lit l) = C.Lit (make_lit l)
-make_exp (App e (Type t)) = C.Appt (make_exp e) (make_ty t)
-make_exp (App e1 e2) = C.App (make_exp e1) (make_exp e2)
-make_exp (Lam v e) | isTyVar v = C.Lam (C.Tb (make_tbind v)) (make_exp e)
-make_exp (Lam v e) | otherwise = C.Lam (C.Vb (make_vbind v)) (make_exp e)
-make_exp (Let b e) = C.Let (make_vdef b) (make_exp e)
--- gaw 2004
-make_exp (Case e v ty alts) = C.Case (make_exp e) (make_vbind v) (make_ty ty) (map make_alt alts)
-make_exp (Note (SCC cc) e) = C.Note "SCC"  (make_exp e) -- temporary
-make_exp (Note (Coerce t_to t_from) e) = C.Coerce (make_ty t_to) (make_exp e)
-make_exp (Note InlineCall e) = C.Note "InlineCall" (make_exp e)
-make_exp (Note (CoreNote s) e) = C.Note s (make_exp e)  -- hdaume: core annotations
-make_exp (Note InlineMe e) = C.Note "InlineMe" (make_exp e)
-make_exp _ = error "MkExternalCore died: make_exp"
-
-make_alt :: CoreAlt -> C.Alt
-make_alt (DataAlt dcon, vs, e) = 
-    C.Acon (make_con_qid (dataConName dcon))
-           (map make_tbind tbs)
-           (map make_vbind vbs)
-	   (make_exp e)    
-	where (tbs,vbs) = span isTyVar vs
-make_alt (LitAlt l,_,e) = C.Alit (make_lit l) (make_exp e)
-make_alt (DEFAULT,[],e) = C.Adefault (make_exp e)
-
-make_lit :: Literal -> C.Lit
-make_lit l = 
-  case l of
-    MachChar i -> C.Lchar i t
-    MachStr s -> C.Lstring (unpackFS s) t
-    MachNullAddr -> C.Lint 0 t
-    MachInt i -> C.Lint i t
-    MachInt64 i -> C.Lint i t
-    MachWord i -> C.Lint i t
-    MachWord64 i -> C.Lint i t
-    MachFloat r -> C.Lrational r t
-    MachDouble r -> C.Lrational r t
-    _ -> error "MkExternalCore died: make_lit"
-  where 
-    t = make_ty (literalType l)
-
-make_ty :: Type -> C.Ty
-make_ty (TyVarTy tv)    	 = C.Tvar (make_var_id (tyVarName tv))
-make_ty (AppTy t1 t2) 		 = C.Tapp (make_ty t1) (make_ty t2)
-make_ty (FunTy t1 t2) 		 = make_ty (TyConApp funTyCon [t1,t2])
-make_ty (ForAllTy tv t) 	 = C.Tforall (make_tbind tv) (make_ty t)
-make_ty (TyConApp tc ts) 	 = foldl C.Tapp (C.Tcon (make_con_qid (tyConName tc))) 
-					 (map make_ty ts)
--- Newtypes are treated just like any other type constructor; not expanded
--- Reason: predTypeRep does substitution and, while substitution deals
--- 	   correctly with name capture, it's only correct if you see the uniques!
---	   If you just see occurrence names, name capture may occur.
--- Example: newtype A a = A (forall b. b -> a)
---	    test :: forall q b. q -> A b
---	    test _ = undefined
--- 	Here the 'a' gets substituted by 'b', which is captured.
--- Another solution would be to expand newtypes before tidying; but that would
--- expose the representation in interface files, which definitely isn't right.
--- Maybe CoreTidy should know whether to expand newtypes or not?
-
-make_ty (PredTy p)	= make_ty (predTypeRep p)
-make_ty (NoteTy _ t) 	= make_ty t
-
-
-
-make_kind :: Kind -> C.Kind
-make_kind (FunKind k1 k2)  = C.Karrow (make_kind k1) (make_kind k2)
-make_kind LiftedTypeKind   = C.Klifted
-make_kind UnliftedTypeKind = C.Kunlifted
-make_kind OpenTypeKind     = C.Kopen
-make_kind _ = error "MkExternalCore died: make_kind"
-
-{- Id generation. -}
-
-{- Use encoded strings.
-   Also, adjust casing to work around some badly-chosen internal names. -}
-make_id :: Bool -> Name -> C.Id
-make_id is_var nm = (occNameString . nameOccName) nm
-
-{-	SIMON thinks this stuff isn't necessary
-make_id is_var nm = 
-  case n of
-    'Z':cs | is_var -> 'z':cs 
-    'z':cs | not is_var -> 'Z':cs 
-    c:cs | isUpper c && is_var -> 'z':'d':n
-    c:cs | isLower c && (not is_var) -> 'Z':'d':n
-    _ -> n
-  where n = (occNameString . nameOccName) nm
--}
-
-make_var_id :: Name -> C.Id
-make_var_id = make_id True
-
-make_mid :: Module -> C.Id
-make_mid = moduleString
-
-make_qid :: Bool -> Name -> C.Qual C.Id
-make_qid is_var n = (mname,make_id is_var n)
-    where mname = 
-           case nameModule_maybe n of
-            Just m -> make_mid m
-            Nothing -> "" 
-
-make_var_qid :: Name -> C.Qual C.Id
-make_var_qid = make_qid True
-
-make_con_qid :: Name -> C.Qual C.Id
-make_con_qid = make_qid False
-
-\end{code}
-
-
-
-
diff --git a/ghc/compiler/coreSyn/PprCore.lhs b/ghc/compiler/coreSyn/PprCore.lhs
deleted file mode 100644
index 864f4bdcb0..0000000000
--- a/ghc/compiler/coreSyn/PprCore.lhs
+++ /dev/null
@@ -1,384 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1996-1998
-%
-%************************************************************************
-%*									*
-\section[PprCore]{Printing of Core syntax, including for interfaces}
-%*									*
-%************************************************************************
-
-\begin{code}
-module PprCore (
-	pprCoreExpr, pprParendExpr,
-	pprCoreBinding, pprCoreBindings, pprCoreAlt,
-	pprRules
-    ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-import CostCentre	( pprCostCentreCore )
-import Var		( Var )
-import Id		( Id, idType, isDataConWorkId_maybe, idArity,
-			  idInfo, globalIdDetails, isGlobalId, isExportedId 
-			)
-import Var		( TyVar, isTyVar, tyVarKind )
-import IdInfo		( IdInfo, megaSeqIdInfo, 
-			  inlinePragInfo, occInfo, newDemandInfo, 
-			  lbvarInfo, hasNoLBVarInfo,
-			  arityInfo, ppArityInfo, 
-			  specInfo, pprNewStrictness,
-			  workerInfo, ppWorkerInfo,
-			  newStrictnessInfo, cafInfo, ppCafInfo, specInfoRules
-			)
-import NewDemand	( isTop )
-#ifdef OLD_STRICTNESS
-import Id		( idDemandInfo )
-import IdInfo		( cprInfo, ppCprInfo, strictnessInfo, ppStrictnessInfo ) 
-#endif
-
-import DataCon		( dataConTyCon )
-import TyCon		( tupleTyConBoxity, isTupleTyCon )
-import Type		( pprParendType, pprType, pprParendKind )
-import BasicTypes	( tupleParens, isNoOcc, isAlwaysActive )
-import Util             ( lengthIs )
-import Outputable
-import FastString       ( mkFastString )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Public interfaces for Core printing (excluding instances)}
-%*									*
-%************************************************************************
-
-@pprParendCoreExpr@ puts parens around non-atomic Core expressions.
-
-\begin{code}
-pprCoreBindings :: OutputableBndr b => [Bind b] -> SDoc
-pprCoreBinding  :: OutputableBndr b => Bind b  -> SDoc
-pprCoreExpr     :: OutputableBndr b => Expr b  -> SDoc
-pprParendExpr   :: OutputableBndr b => Expr b  -> SDoc
-
-pprCoreBindings = pprTopBinds
-pprCoreBinding  = pprTopBind 
-
-instance OutputableBndr b => Outputable (Bind b) where
-    ppr bind = ppr_bind bind
-
-instance OutputableBndr b => Outputable (Expr b) where
-    ppr expr = pprCoreExpr expr
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The guts}
-%*									*
-%************************************************************************
-
-\begin{code}
-pprTopBinds binds = vcat (map pprTopBind binds)
-
-pprTopBind (NonRec binder expr)
- = ppr_binding (binder,expr) $$ text ""
-
-pprTopBind (Rec binds)
-  = vcat [ptext SLIT("Rec {"),
-	  vcat (map ppr_binding binds),
-	  ptext SLIT("end Rec }"),
-	  text ""]
-\end{code}
-
-\begin{code}
-ppr_bind :: OutputableBndr b => Bind b -> SDoc
-
-ppr_bind (NonRec val_bdr expr) = ppr_binding (val_bdr, expr)
-ppr_bind (Rec binds)  	       = vcat (map pp binds)
-			       where
-				 pp bind = ppr_binding bind <> semi
-
-ppr_binding :: OutputableBndr b => (b, Expr b) -> SDoc
-ppr_binding (val_bdr, expr)
-  = pprBndr LetBind val_bdr $$ 
-    hang (ppr val_bdr <+> equals) 2 (pprCoreExpr expr)
-\end{code}
-
-\begin{code}
-pprParendExpr   expr = ppr_expr parens expr
-pprCoreExpr expr = ppr_expr noParens expr
-
-noParens :: SDoc -> SDoc
-noParens pp = pp
-\end{code}
-
-\begin{code}
-ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
-	-- The function adds parens in context that need
-	-- an atomic value (e.g. function args)
-
-ppr_expr add_par (Type ty)  = add_par (ptext SLIT("TYPE") <+> ppr ty)	-- Wierd
-	           
-ppr_expr add_par (Var name) = ppr name
-ppr_expr add_par (Lit lit)  = ppr lit
-
-ppr_expr add_par expr@(Lam _ _)
-  = let
-	(bndrs, body) = collectBinders expr
-    in
-    add_par $
-    hang (ptext SLIT("\\") <+> sep (map (pprBndr LambdaBind) bndrs) <+> arrow)
-	 2 (pprCoreExpr body)
-
-ppr_expr add_par expr@(App fun arg)
-  = case collectArgs expr of { (fun, args) -> 
-    let
-	pp_args     = sep (map pprArg args)
-	val_args    = dropWhile isTypeArg args	 -- Drop the type arguments for tuples
-	pp_tup_args = sep (punctuate comma (map pprArg val_args))
-    in
-    case fun of
-	Var f -> case isDataConWorkId_maybe f of
-			-- Notice that we print the *worker*
-			-- for tuples in paren'd format.
-		   Just dc | saturated && isTupleTyCon tc
-			   -> tupleParens (tupleTyConBoxity tc) pp_tup_args
-			   where
-			     tc	       = dataConTyCon dc
-			     saturated = val_args `lengthIs` idArity f
-
-		   other -> add_par (hang (ppr f) 2 pp_args)
-
-	other -> add_par (hang (pprParendExpr fun) 2 pp_args)
-    }
-
-ppr_expr add_par (Case expr var ty [(con,args,rhs)])
-  = add_par $
-    sep [sep [ptext SLIT("case") <+> pprCoreExpr expr,
-	      ifPprDebug (braces (ppr ty)),
-	      hsep [ptext SLIT("of"),
-		    ppr_bndr var, 
-		    char '{',
-		    ppr_case_pat con args
-	  ]],
-	 pprCoreExpr rhs,
-	 char '}'
-    ]
-  where
-    ppr_bndr = pprBndr CaseBind
-
-ppr_expr add_par (Case expr var ty alts)
-  = add_par $
-    sep [sep [ptext SLIT("case")
-		<+> pprCoreExpr expr
-		<+> ifPprDebug (braces (ppr ty)),
-	      ptext SLIT("of") <+> ppr_bndr var <+> char '{'],
-	 nest 2 (sep (punctuate semi (map pprCoreAlt alts))),
-	 char '}'
-    ]
-  where
-    ppr_bndr = pprBndr CaseBind
- 
-
--- special cases: let ... in let ...
--- ("disgusting" SLPJ)
-
-{-
-ppr_expr add_par (Let bind@(NonRec val_bdr rhs@(Let _ _)) body)
-  = add_par $
-    vcat [
-      hsep [ptext SLIT("let {"), (pprBndr LetBind val_bdr $$ ppr val_bndr), equals],
-      nest 2 (pprCoreExpr rhs),
-      ptext SLIT("} in"),
-      pprCoreExpr body ]
--}
-
-ppr_expr add_par (Let bind@(NonRec val_bdr rhs) expr@(Let _ _))
-  = add_par
-    (hang (ptext SLIT("let {"))
-	  2 (hsep [ppr_binding (val_bdr,rhs),
-		   ptext SLIT("} in")])
-     $$
-     pprCoreExpr expr)
-
--- general case (recursive case, too)
-ppr_expr add_par (Let bind expr)
-  = add_par $
-    sep [hang (ptext keyword) 2 (ppr_bind bind),
-	 hang (ptext SLIT("} in ")) 2 (pprCoreExpr expr)]
-  where
-    keyword = case bind of
-		Rec _      -> SLIT("__letrec {")
-		NonRec _ _ -> SLIT("let {")
-
-ppr_expr add_par (Note (SCC cc) expr)
-  = add_par (sep [pprCostCentreCore cc, pprCoreExpr expr])
-
-#ifdef DEBUG
-ppr_expr add_par (Note (Coerce to_ty from_ty) expr)
- = add_par $
-   getPprStyle $ \ sty ->
-   if debugStyle sty then
-      sep [ptext SLIT("__coerce") <+> 
-		sep [pprParendType to_ty, pprParendType from_ty],
-	   pprParendExpr expr]
-   else
-      sep [hsep [ptext SLIT("__coerce"), pprParendType to_ty],
-	          pprParendExpr expr]
-#else
-ppr_expr add_par (Note (Coerce to_ty from_ty) expr)
-  = add_par $
-    sep [sep [ptext SLIT("__coerce"), nest 2 (pprParendType to_ty)],
-	 pprParendExpr expr]
-#endif
-
-ppr_expr add_par (Note InlineCall expr)
-  = add_par (ptext SLIT("__inline_call") <+> pprParendExpr expr)
-
-ppr_expr add_par (Note InlineMe expr)
-  = add_par $ ptext SLIT("__inline_me") <+> pprParendExpr expr
-
-ppr_expr add_par (Note (CoreNote s) expr)
-  = add_par $ 
-    sep [sep [ptext SLIT("__core_note"), pprHsString (mkFastString s)],
-         pprParendExpr expr]
-
-pprCoreAlt (con, args, rhs) 
-  = hang (ppr_case_pat con args) 2 (pprCoreExpr rhs)
-
-ppr_case_pat con@(DataAlt dc) args
-  | isTupleTyCon tc
-  = tupleParens (tupleTyConBoxity tc) (hsep (punctuate comma (map ppr_bndr args))) <+> arrow
-  where
-    ppr_bndr = pprBndr CaseBind
-    tc = dataConTyCon dc
-
-ppr_case_pat con args
-  = ppr con <+> hsep (map ppr_bndr args) <+> arrow
-  where
-    ppr_bndr = pprBndr CaseBind
-
-pprArg (Type ty) = ptext SLIT("@") <+> pprParendType ty
-pprArg expr      = pprParendExpr expr
-\end{code}
-
-Other printing bits-and-bobs used with the general @pprCoreBinding@
-and @pprCoreExpr@ functions.
-
-\begin{code}
-instance OutputableBndr Var where
-  pprBndr = pprCoreBinder
-
-pprCoreBinder :: BindingSite -> Var -> SDoc
-pprCoreBinder LetBind binder
-  = vcat [sig, pprIdDetails binder, pragmas]
-  where
-    sig     = pprTypedBinder binder
-    pragmas = ppIdInfo binder (idInfo binder)
-
--- Lambda bound type variables are preceded by "@"
-pprCoreBinder LambdaBind bndr = parens (pprTypedBinder bndr)
-
--- Case bound things don't get a signature or a herald
-pprCoreBinder CaseBind bndr = pprUntypedBinder bndr
-
-pprUntypedBinder binder
-  | isTyVar binder = ptext SLIT("@") <+> ppr binder	-- NB: don't print kind
-  | otherwise      = pprIdBndr binder
-
-pprTypedBinder binder
-  | isTyVar binder  = ptext SLIT("@") <+> pprTyVarBndr binder
-  | otherwise	    = pprIdBndr binder <+> dcolon <+> pprType (idType binder)
-
-pprTyVarBndr :: TyVar -> SDoc
-pprTyVarBndr tyvar
-  = getPprStyle $ \ sty ->
-    if debugStyle sty then
-        hsep [ppr tyvar, dcolon, pprParendKind kind]
-		-- See comments with ppDcolon in PprCore.lhs
-    else
-        ppr tyvar
-  where
-    kind = tyVarKind tyvar
-
--- pprIdBndr does *not* print the type
--- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness
-pprIdBndr id = ppr id <+> pprIdBndrInfo (idInfo id)
-
-pprIdBndrInfo info 
-  = megaSeqIdInfo `seq` doc -- The seq is useful for poking on black holes
-  where
-    prag_info = inlinePragInfo info
-    occ_info  = occInfo info
-    dmd_info  = newDemandInfo info
-    lbv_info  = lbvarInfo info
-
-    no_info = isAlwaysActive prag_info && isNoOcc occ_info && 
-	      (case dmd_info of { Nothing -> True; Just d -> isTop d }) &&
-	      hasNoLBVarInfo lbv_info
-
-    doc | no_info = empty
- 	| otherwise
-        = brackets $ hcat [ppr prag_info, ppr occ_info, 
-			   ppr dmd_info, ppr lbv_info
-#ifdef OLD_STRICTNESS
-			   , ppr (demandInfo id)
-#endif
-			  ]
-\end{code}
-
-
-\begin{code}
-pprIdDetails :: Id -> SDoc
-pprIdDetails id | isGlobalId id     = ppr (globalIdDetails id)
-		| isExportedId id   = ptext SLIT("[Exported]")
-		| otherwise	    = empty
-
-ppIdInfo :: Id -> IdInfo -> SDoc
-ppIdInfo b info
-  = brackets $
-    vcat [  ppArityInfo a,
-	    ppWorkerInfo (workerInfo info),
-	    ppCafInfo (cafInfo info),
-#ifdef OLD_STRICTNESS
-	    ppStrictnessInfo s,
-            ppCprInfo m,
-#endif
-	    pprNewStrictness (newStrictnessInfo info),
-	    if null rules then empty
-	    else ptext SLIT("RULES:") <+> vcat (map pprRule rules)
-	-- Inline pragma, occ, demand, lbvar info
-	-- printed out with all binders (when debug is on); 
-	-- see PprCore.pprIdBndr
-	]
-  where
-    a = arityInfo info
-#ifdef OLD_STRICTNESS
-    s = strictnessInfo info
-    m = cprInfo info
-#endif
-    rules = specInfoRules (specInfo info)
-\end{code}
-
-
-\begin{code}
-instance Outputable CoreRule where
-   ppr = pprRule
-
-pprRules :: [CoreRule] -> SDoc
-pprRules rules = vcat (map pprRule rules)
-
-pprRule :: CoreRule -> SDoc
-pprRule (BuiltinRule { ru_fn = fn, ru_name = name})
-  = ptext SLIT("Built in rule for") <+> ppr fn <> colon <+> doubleQuotes (ftext name)
-
-pprRule (Rule { ru_name = name, ru_act = act, ru_fn = fn,
-		ru_bndrs = tpl_vars, ru_args = tpl_args,
-		ru_rhs = rhs })
-  = doubleQuotes (ftext name) <+> ppr act <+>
-    sep [
-	  ptext SLIT("__forall") <+> braces (sep (map pprTypedBinder tpl_vars)),
-	  nest 2 (ppr fn <+> sep (map pprArg tpl_args)),
-	  nest 2 (ptext SLIT("=") <+> pprCoreExpr rhs)
-    ] <+> semi
-\end{code}
diff --git a/ghc/compiler/coreSyn/PprExternalCore.lhs b/ghc/compiler/coreSyn/PprExternalCore.lhs
deleted file mode 100644
index 26c89cce48..0000000000
--- a/ghc/compiler/coreSyn/PprExternalCore.lhs
+++ /dev/null
@@ -1,177 +0,0 @@
-%
-% (c) The University of Glasgow 2001
-%
-\begin{code}
-
-module PprExternalCore () where
-
-import Pretty
-import ExternalCore
-import Char
-
-instance Show Module where
-  showsPrec d m = shows (pmodule m)
-
-instance Show Tdef where
-  showsPrec d t = shows (ptdef t)
-
-instance Show Cdef where
-  showsPrec d c = shows (pcdef c)
-
-instance Show Vdefg where
-  showsPrec d v = shows (pvdefg v)
-
-instance Show Exp where
-  showsPrec d e = shows (pexp e)
-
-instance Show Alt where
-  showsPrec d a = shows (palt a)
-
-instance Show Ty where
-  showsPrec d t = shows (pty t)
-
-instance Show Kind where
-  showsPrec d k = shows (pkind k)
-
-instance Show Lit where
-  showsPrec d l = shows (plit l)
-
-
-indent = nest 2
-
-pmodule (Module mname tdefs vdefgs) =
-  (text "%module" <+> text mname)
-    $$ indent ((vcat (map ((<> char ';') . ptdef) tdefs))
-	       $$ (vcat (map ((<> char ';') . pvdefg) vdefgs)))
-
-ptdef (Data tcon tbinds cdefs) =
-  (text "%data" <+> pqname tcon <+> (hsep (map ptbind tbinds)) <+> char '=')
-  $$ indent (braces ((vcat (punctuate (char ';') (map pcdef cdefs)))))
-
-ptdef (Newtype tcon tbinds rep ) =
-  text "%newtype" <+> pqname tcon <+> (hsep (map ptbind tbinds)) <+> repclause
-       where repclause = case rep of
-                           Just ty -> char '=' <+> pty ty 
-			   Nothing -> empty
-
-pcdef (Constr dcon tbinds tys)  =
-  (pname dcon) <+> (sep [hsep (map pattbind tbinds),sep (map paty tys)])
-pcdef (GadtConstr dcon ty)  =
-  (pname dcon) <+> text "::" <+> pty ty
-
-pname id = text id
-
-pqname ("",id) = pname id
-pqname (m,id)  = pname m <> char '.' <> pname id
-
-ptbind (t,Klifted) = pname t
-ptbind (t,k) = parens (pname t <> text "::" <> pkind k)
-
-pattbind (t,k) = char '@' <> ptbind (t,k)
-
-pakind (Klifted) = char '*'
-pakind (Kunlifted) = char '#'
-pakind (Kopen) = char '?'
-pakind k = parens (pkind k)
-
-pkind (Karrow k1 k2) = parens (pakind k1 <> text "->" <> pkind k2)
-pkind k = pakind k
-
-paty (Tvar n) = pname n
-paty (Tcon c) = pqname c
-paty t = parens (pty t)
-
-pbty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = parens(fsep [pbty t1, text "->",pty t2])
-pbty (Tapp t1 t2) = pappty t1 [t2] 
-pbty t = paty t
-
-pty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = fsep [pbty t1, text "->",pty t2]
-pty (Tforall tb t) = text "%forall" <+> pforall [tb] t
-pty t = pbty t
-
-pappty (Tapp t1 t2) ts = pappty t1 (t2:ts)
-pappty t ts = sep (map paty (t:ts))
-
-pforall tbs (Tforall tb t) = pforall (tbs ++ [tb]) t
-pforall tbs t = hsep (map ptbind tbs) <+> char '.' <+> pty t
-
-pvdefg (Rec vtes) = text "%rec" $$ braces (indent (vcat (punctuate (char ';') (map pvte vtes))))
-pvdefg (Nonrec vte) = pvte vte
-
-pvte (v,t,e) = sep [pname v <+> text "::" <+> pty t <+> char '=',
-		    indent (pexp e)]
-
-paexp (Var x) = pqname x
-paexp (Dcon x) = pqname x
-paexp (Lit l) = plit l
-paexp e = parens(pexp e)
-
-plamexp bs (Lam b e) = plamexp (bs ++ [b]) e
-plamexp bs e = sep [sep (map pbind bs) <+> text "->",
-		    indent (pexp e)]
-
-pbind (Tb tb) = char '@' <+> ptbind tb
-pbind (Vb vb) = pvbind vb
-
-pfexp (App e1 e2) = pappexp e1 [Left e2]
-pfexp (Appt e t) = pappexp e [Right t]
-pfexp e = paexp e
-
-pappexp (App e1 e2) as = pappexp e1 (Left e2:as)
-pappexp (Appt e t) as = pappexp e (Right t:as)
-pappexp e as = fsep (paexp e : map pa as)
-           where pa (Left e) = paexp e
-		 pa (Right t) = char '@' <+> paty t
-
-pexp (Lam b e) = char '\\' <+> plamexp [b] e
-pexp (Let vd e) = (text "%let" <+> pvdefg vd) $$ (text "%in" <+> pexp e)
-pexp (Case e vb ty alts) = sep [text "%case" <+> parens (paty ty) <+> paexp e,
-			     text "%of" <+> pvbind vb]
-			$$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))
-pexp (Coerce t e) = (text "%coerce" <+> paty t) $$ pexp e
-pexp (Note s e) = (text "%note" <+> pstring s) $$ pexp e
-pexp (External n t) = (text "%external" <+> pstring n) $$ paty t
-pexp e = pfexp e
-
-
-pvbind (x,t) = parens(pname x <> text "::" <> pty t)
-
-palt (Acon c tbs vbs e) =
-	sep [pqname c, 
-	     sep (map pattbind tbs),
-	     sep (map pvbind vbs) <+> text "->"]
-        $$ indent (pexp e)
-palt (Alit l e) = 
-	(plit l <+>  text "->")
-	$$ indent (pexp e)
-palt (Adefault e) = 
-	(text "%_ ->")
-	$$ indent (pexp e)
-
-plit (Lint i t) = parens (integer i <> text "::" <> pty t)
-plit (Lrational r t) = parens (rational r <>  text "::" <> pty t)  -- might be better to print as two integers
-plit (Lchar c t) = parens (text ("\'" ++ escape [c] ++ "\'") <> text "::" <> pty t)
-plit (Lstring s t) = parens (pstring s <> text "::" <> pty t)
-
-pstring s = doubleQuotes(text (escape s))
-
-escape s = foldr f [] (map ord s)
-    where 
-     f cv rest
-	| cv > 0xFF = '\\':'x':hs ++ rest
-	| (cv < 0x20 || cv > 0x7e || cv == 0x22 || cv == 0x27 || cv == 0x5c) = 
-	 '\\':'x':h1:h0:rest
-           where (q1,r1) = quotRem cv 16
-		 h1 = intToDigit q1
-                 h0 = intToDigit r1
-		 hs = dropWhile (=='0') $ reverse $ mkHex cv
-		 mkHex 0 = ""
-		 mkHex cv = intToDigit r : mkHex q
-		    where (q,r) = quotRem cv 16
-     f cv rest = (chr cv):rest
-
-\end{code}
-
-
-
-
diff --git a/ghc/compiler/count_bytes b/ghc/compiler/count_bytes
deleted file mode 100644
index bf6240228f..0000000000
--- a/ghc/compiler/count_bytes
+++ /dev/null
@@ -1,43 +0,0 @@
-#! /usr/local/bin/perl
-#
-%DirCount = ();
-%ModCount = ();
-
-foreach $f ( @ARGV ) {
-    die "Not an .lhs file: $f\n" if $f !~ /\.lhs$/;
-    $f =~ s/\.lhs$/.o/;
-
-    $f_size = `size $f`;
-    die "Size failed?\n" if $? != 0;
-
-    if ( $f_size =~ /(\S+)\s*(\S+)\s*(\S+)\s*(\d+)\s*(\S+)/ ) {
-	$totsz = $4;
-
-	if ( $f =~ /(.*)\/(.*)/ ) {
-	    local($dir) = $1;
-	    local($mod) = $2;
-	    $DirCount{$dir} += $totsz;
-	    $ModCount{$mod} += $totsz;
-	} else {
-	    print STDERR "not counted in a directory: $f\n";
-	    $ModCount{$f} += $totsz;
-	}
-    } else {
-	die "Can't figure out size: $f_size\n";
-    }
-}
-
-# print the info
-$tot = 0;
-foreach $d (sort (keys %DirCount)) {
-    printf "%-20s %6d\n", $d, $DirCount{$d};
-    $tot += $DirCount{$d};
-}
-printf "\n%-20s %6d\n\n\n", 'TOTAL:', $tot;
-
-$tot = 0;
-foreach $m (sort (keys %ModCount)) {
-    printf "%-20s %6d\n", $m, $ModCount{$m};
-    $tot += $ModCount{$m};
-}
-printf "\n%-20s %6d\n", 'TOTAL:', $tot;
diff --git a/ghc/compiler/count_lines b/ghc/compiler/count_lines
deleted file mode 100644
index 43ca79e68a..0000000000
--- a/ghc/compiler/count_lines
+++ /dev/null
@@ -1,63 +0,0 @@
-#! /usr/bin/perl
-#
-%DirCount = ();
-%ModCount = ();
-%DirComments = ();
-%ModComments = ();
-
-foreach $f ( @ARGV ) {
-
-    if ( $f =~ /\.lhs$/ ) {
-	open(INF, "../utils/unlit/unlit $f - |") || die "Couldn't unlit $f!\n";
-    } else {
-	open(INF, "< $f") || die "Couldn't open $f!\n";
-    }
-    $cnt = 0;
-    while (<INF>) {
-	s/--.*//;
-	s/{-.*-}//;
-    	next if /^\s*$/;
-	$cnt++;
-    }
-    close(INF);
-
-    $f_wc = `wc $f`; die "wc failed: $f\n" if $? != 0;
-    if ( $f_wc =~ /\s*(\d+)\s*(\d+)\s*(\d+)/ ) {
-	$comments = $1 - $cnt;
-    } else {
-	die "Can't grok wc format: $f_wc";
-    }
-
-    if ( $f =~ /(.*)\/(.*)/ ) {
-	local($dir) = $1;
-	local($mod) = $2;
-	$DirCount{$dir} += $cnt;
-	$ModCount{$mod} += $cnt;
-	$DirComments{$dir} += $comments;
-	$ModComments{$mod} += $comments;
-    } else {
-	print STDERR "not counted in a directory: $f\n";
-	$ModCount{$f} += $cnt;
-	$ModComments{$f} += $comments;
-    }
-}
-
-# print the info
-$tot = 0;
-$totcmts = 0;
-foreach $d (sort (keys %DirCount)) {
-    printf "%-20s %6d %6d\n", $d, $DirCount{$d}, $DirComments{$d};
-    $tot     += $DirCount{$d};
-    $totcmts += $DirComments{$d};
-}
-printf "\n%-20s %6d %6d\n\n\n", 'TOTAL:', $tot, $totcmts;
-
-$tot = 0;
-$totcmts = 0;
-printf "\n                      Code  Comments\n";
-foreach $m (sort (keys %ModCount)) {
-    printf "%-20s %6d %6d\n", $m, $ModCount{$m}, $ModComments{$m};
-    $tot += $ModCount{$m};
-    $totcmts += $ModComments{$m};
-}
-printf "\n%-20s %6d %6d\n", 'TOTAL:', $tot, $totcmts;
diff --git a/ghc/compiler/cprAnalysis/CprAnalyse.lhs b/ghc/compiler/cprAnalysis/CprAnalyse.lhs
deleted file mode 100644
index dad6ccbaee..0000000000
--- a/ghc/compiler/cprAnalysis/CprAnalyse.lhs
+++ /dev/null
@@ -1,315 +0,0 @@
-\section[CprAnalyse]{Identify functions that always return a
-constructed product result}
-
-\begin{code}
-#ifndef OLD_STRICTNESS
-module CprAnalyse ( ) where
-
-#else
-
-module CprAnalyse ( cprAnalyse ) where
-
-#include "HsVersions.h"
-
-import DynFlags	( DynFlags, DynFlag(..) )
-import CoreLint		( showPass, endPass )
-import CoreSyn
-import CoreUtils	( exprIsHNF )
-import Id               ( Id, setIdCprInfo, idCprInfo, idArity,
-			  isBottomingId, idDemandInfo, isImplicitId )
-import IdInfo           ( CprInfo(..) )
-import Demand		( isStrict )
-import VarEnv
-import Util		( nTimes, mapAccumL )
-import Outputable
-
-import Maybe
-\end{code}
-
-This module performs an analysis of a set of Core Bindings for the
-Constructed Product Result (CPR) transformation.
-
-It detects functions that always explicitly (manifestly?) construct a
-result value with a product type.  A product type is a type which has
-only one constructor. For example, tuples and boxed primitive values
-have product type.
-
-We must also ensure that the function's body starts with sufficient
-manifest lambdas otherwise loss of sharing can occur.  See the comment
-in @StrictAnal.lhs@.
-
-The transformation of bindings to worker/wrapper pairs is done by the
-worker-wrapper pass.  The worker-wrapper pass splits bindings on the
-basis of both strictness and CPR info.  If an id has both then it can
-combine the transformations so that only one pair is produced.
-
-The analysis here detects nested CPR information.  For example, if a
-function returns a constructed pair, the first element of which is a
-constructed int, then the analysis will detect nested CPR information
-for the int as well.  Unfortunately, the current transformations can't
-take advantage of the nested CPR information.  They have (broken now,
-I think) code which will flatten out nested CPR components and rebuild
-them in the wrapper, but enabling this would lose laziness.  It is
-possible to make use of the nested info: if we knew that a caller was
-strict in that position then we could create a specialized version of
-the function which flattened/reconstructed that position.
-
-It is not known whether this optimisation would be worthwhile.
-
-So we generate and carry round nested CPR information, but before
-using this info to guide the creation of workers and wrappers we map
-all components of a CPRInfo to NoCprInfo.
-
-
-Data types
-~~~~~~~~~~
-
-Within this module Id's CPR information is represented by
-``AbsVal''. When adding this information to the Id's pragma info field 
-we convert the ``Absval'' to a ``CprInfo'' value.   
-
-Abstract domains consist of a `no information' value (Top), a function
-value (Fun) which when applied to an argument returns a new AbsVal
-(note the argument is not used in any way), , for product types, a
-corresponding length tuple (Tuple) of abstract values.  And finally,
-Bot.  Bot is not a proper abstract value but a generic bottom is
-useful for calculating fixpoints and representing divergent
-computations.  Note that we equate Bot and Fun^n Bot (n > 0), and
-likewise for Top.  This saves a lot of delving in types to keep
-everything exactly correct.
-
-Since functions abstract to constant functions we could just
-represent them by the abstract value of their result.  However,  it
-turns out (I know - I tried!) that this requires a lot of type
-manipulation and the code is more straightforward if we represent
-functions by an abstract constant function. 
-
-\begin{code}
-data AbsVal = Top                -- Not a constructed product
-
-	    | Fun AbsVal         -- A function that takes an argument 
-				 -- and gives AbsVal as result. 
-
-            | Tuple 		 -- A constructed product of values
-
-            | Bot                -- Bot'tom included for convenience
-                                 -- we could use appropriate Tuple Vals
-     deriving (Eq,Show)
-
--- For pretty debugging
-instance Outputable AbsVal where
-  ppr Top    	= ptext SLIT("Top")
-  ppr (Fun r)	= ptext SLIT("Fun->") <> (parens.ppr) r
-  ppr Tuple     = ptext SLIT("Tuple ")
-  ppr Bot       = ptext SLIT("Bot")
-
-
--- lub takes the lowest upper bound of two abstract values, standard.
-lub :: AbsVal -> AbsVal -> AbsVal
-lub Bot a = a
-lub a Bot = a
-lub Top a = Top
-lub a Top = Top
-lub Tuple Tuple 	= Tuple
-lub (Fun l) (Fun r)     = Fun (lub l r)
-lub l r = panic "CPR Analysis tried to take the lub of a function and a tuple"
-
-
-\end{code}
-
-The environment maps Ids to their abstract CPR value.
-
-\begin{code}
-
-type CPREnv = VarEnv AbsVal
-
-initCPREnv = emptyVarEnv
-
-\end{code}
-
-Programs
-~~~~~~~~
-
-Take a list of core bindings and return a new list with CPR function
-ids decorated with their CprInfo pragmas.
-
-\begin{code}
-
-cprAnalyse :: DynFlags -> [CoreBind] -> IO [CoreBind]
-cprAnalyse dflags binds
-  = do {
-	showPass dflags "Constructed Product analysis" ;
-	let { binds_plus_cpr = do_prog binds } ;
-	endPass dflags "Constructed Product analysis" 
-	 	Opt_D_dump_cpranal binds_plus_cpr
-    }
-  where
-    do_prog :: [CoreBind] -> [CoreBind]
-    do_prog binds = snd $ mapAccumL cprAnalBind initCPREnv binds
-\end{code}
-
-The cprAnal functions take binds/expressions and an environment which 
-gives CPR info for visible ids and returns a new bind/expression
-with ids decorated with their CPR info.
- 
-\begin{code}
--- Return environment extended with info from this binding 
-cprAnalBind :: CPREnv -> CoreBind -> (CPREnv, CoreBind)
-cprAnalBind rho (NonRec b e) 
-  | isImplicitId b	-- Don't touch the CPR info on constructors, selectors etc
-  = (rho, NonRec b e)	
-  | otherwise
-  = (extendVarEnv rho b absval, NonRec b' e')
-  where
-    (e', absval) = cprAnalExpr rho e
-    b' = addIdCprInfo b e' absval
-
-cprAnalBind rho (Rec prs)
-  = (final_rho, Rec (map do_pr prs))
-  where
-    do_pr (b,e) = (b', e') 
-		where
-		  b'           = addIdCprInfo b e' absval
-		  (e', absval) = cprAnalExpr final_rho e
-
-	-- When analyzing mutually recursive bindings the iterations to find
-	-- a fixpoint is bounded by the number of bindings in the group.
-	-- for simplicity we just iterate that number of times.      
-    final_rho = nTimes (length prs) do_one_pass init_rho
-    init_rho  = rho `extendVarEnvList` [(b,Bot) | (b,e) <- prs]
-
-    do_one_pass :: CPREnv -> CPREnv
-    do_one_pass rho = foldl (\ rho (b,e) -> extendVarEnv rho b (snd (cprAnalExpr rho e)))
-			    rho prs
-
-
-cprAnalExpr :: CPREnv -> CoreExpr -> (CoreExpr, AbsVal)
-
--- If Id will always diverge when given sufficient arguments then
--- we can just set its abs val to Bot.  Any other CPR info
--- from other paths will then dominate,  which is what we want.
--- Check in rho,  if not there it must be imported, so check 
--- the var's idinfo. 
-cprAnalExpr rho e@(Var v) 
-    | isBottomingId v = (e, Bot)
-    | otherwise       = (e, case lookupVarEnv rho v of
-                             Just a_val -> a_val
-			     Nothing    -> getCprAbsVal v)
-
--- Literals are unboxed
-cprAnalExpr rho (Lit l) = (Lit l, Top)
-
--- For apps we don't care about the argument's abs val.  This
--- app will return a constructed product if the function does. We strip
--- a Fun from the functions abs val, unless the argument is a type argument 
--- or it is already Top or Bot.
-cprAnalExpr rho (App fun arg@(Type _))
-    = (App fun_cpr arg, fun_res)  
-    where 
-      (fun_cpr, fun_res)  = cprAnalExpr rho fun 
-
-cprAnalExpr rho (App fun arg) 
-    = (App fun_cpr arg_cpr, res_res)
-    where 
-      (fun_cpr, fun_res)  = cprAnalExpr rho fun 
-      (arg_cpr, _)        = cprAnalExpr rho arg
-      res_res		  = case fun_res of
-				Fun res_res -> res_res
-				Top 	    -> Top
-				Bot	    -> Bot
-				Tuple	    -> WARN( True, ppr (App fun arg) ) Top
-						-- This really should not happen!
-
-
--- Map arguments to Top (we aren't constructing them)
--- Return the abstract value of the body, since functions 
--- are represented by the CPR value of their result, and 
--- add a Fun for this lambda..
-cprAnalExpr rho (Lam b body) | isTyVar b = (Lam b body_cpr, body_aval)
-                             | otherwise = (Lam b body_cpr, Fun body_aval)
-      where 
-      (body_cpr, body_aval) = cprAnalExpr (extendVarEnv rho b Top) body
-
-cprAnalExpr rho (Let bind body)
-    = (Let bind' body', body_aval)
-    where 
-      (rho', bind') = cprAnalBind rho bind
-      (body', body_aval) = cprAnalExpr rho' body
-
-cprAnalExpr rho (Case scrut bndr alts)
-    = (Case scrut_cpr bndr alts_cpr, alts_aval)
-      where 
-      (scrut_cpr, scrut_aval) = cprAnalExpr rho scrut
-      (alts_cpr, alts_aval) = cprAnalCaseAlts (extendVarEnv rho bndr scrut_aval) alts
-
-cprAnalExpr rho (Note n exp) 
-    = (Note n exp_cpr, expr_aval)
-      where
-      (exp_cpr, expr_aval) = cprAnalExpr rho exp
-
-cprAnalExpr rho (Type t) 
-    = (Type t, Top)
-
-cprAnalCaseAlts :: CPREnv -> [CoreAlt] -> ([CoreAlt], AbsVal)
-cprAnalCaseAlts rho alts
-    = foldr anal_alt ([], Bot) alts
-      where 
-      anal_alt :: CoreAlt -> ([CoreAlt], AbsVal) -> ([CoreAlt], AbsVal)
-      anal_alt (con, binds, exp)  (done, aval)
-	  = ((con,binds,exp_cpr) : done, exp_aval `lub` aval)
-	    where (exp_cpr, exp_aval) = cprAnalExpr rho' exp
-		  rho' = rho `extendVarEnvList` (zip binds (repeat Top))
-
-
-addIdCprInfo :: Id -> CoreExpr -> AbsVal -> Id
-addIdCprInfo bndr rhs absval
-  | useful_info && ok_to_add = setIdCprInfo bndr cpr_info
-  | otherwise		     = bndr
-  where
-    cpr_info    = absToCprInfo absval
-    useful_info = case cpr_info of { ReturnsCPR -> True; NoCPRInfo -> False }
-		
-    ok_to_add = case absval of
-                  Fun _ -> idArity bndr >= n_fun_tys absval
-		      -- Enough visible lambdas
-
-		  Tuple  -> exprIsHNF rhs || isStrict (idDemandInfo bndr)
-			-- If the rhs is a value, and returns a constructed product,
-			-- it will be inlined at usage sites, so we give it a Tuple absval
-			-- If it isn't a value, we won't inline it (code/work dup worries), so
-			-- we discard its absval.
-			-- 
-			-- Also, if the strictness analyser has figured out that it's strict,
-			-- the let-to-case transformation will happen, so again it's good.
-			-- (CPR analysis runs before the simplifier has had a chance to do
-			--  the let-to-case transform.)
-			-- This made a big difference to PrelBase.modInt, which had something like
-			--	modInt = \ x -> let r = ... -> I# v in
-		 	--			...body strict in r...
-			-- r's RHS isn't a value yet; but modInt returns r in various branches, so
-			-- if r doesn't have the CPR property then neither does modInt
-
-		  _ -> False
-
-    n_fun_tys :: AbsVal -> Int
-    n_fun_tys (Fun av) = 1 + n_fun_tys av
-    n_fun_tys other    = 0
-
-
-absToCprInfo :: AbsVal -> CprInfo
-absToCprInfo Tuple   = ReturnsCPR
-absToCprInfo (Fun r) = absToCprInfo r
-absToCprInfo _       = NoCPRInfo
-
-
--- Cpr Info doesn't store the number of arguments a function has,  so the caller
--- must take care to add the appropriate number of Funs.
-getCprAbsVal v = case idCprInfo v of
-			NoCPRInfo -> Top
-			ReturnsCPR -> nTimes arity Fun Tuple
-	       where
-		 arity = idArity v
-	-- Imported (non-nullary) constructors will have the CPR property
-	-- in their IdInfo, so no need to look at their unfolding
-#endif /* OLD_STRICTNESS */
-\end{code}
diff --git a/ghc/compiler/deSugar/Check.lhs b/ghc/compiler/deSugar/Check.lhs
deleted file mode 100644
index 9aac5ce777..0000000000
--- a/ghc/compiler/deSugar/Check.lhs
+++ /dev/null
@@ -1,698 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
-%
-% Author: Juan J. Quintela    <quintela@krilin.dc.fi.udc.es>
-\section{Module @Check@ in @deSugar@}
-
-\begin{code}
-
-
-module Check ( check , ExhaustivePat ) where
-
-
-import HsSyn		
-import TcHsSyn		( hsPatType, mkVanillaTuplePat )
-import TcType		( tcTyConAppTyCon )
-import DsUtils		( EquationInfo(..), MatchResult(..), 
-			  CanItFail(..), firstPat )
-import MatchLit		( tidyLitPat, tidyNPat )
-import Id		( Id, idType )
-import DataCon		( DataCon, dataConTyCon, dataConOrigArgTys, dataConFieldLabels )
-import Name             ( Name, mkInternalName, getOccName, isDataSymOcc,
-			  getName, mkVarOccFS )
-import TysWiredIn
-import PrelNames	( unboundKey )
-import TyCon            ( tyConDataCons, tupleTyConBoxity, isTupleTyCon )
-import BasicTypes	( Boxity(..) )
-import SrcLoc		( noSrcLoc, Located(..), unLoc, noLoc )
-import UniqSet
-import Util             ( takeList, splitAtList, notNull )
-import Outputable
-import FastString
-
-#include "HsVersions.h"
-\end{code}
-
-This module performs checks about if one list of equations are:
-\begin{itemize}
-\item Overlapped
-\item Non exhaustive
-\end{itemize}
-To discover that we go through the list of equations in a tree-like fashion.
-
-If you like theory, a similar algorithm is described in:
-\begin{quotation}
-	{\em Two Techniques for Compiling Lazy Pattern Matching},
-	Luc Maranguet,
-	INRIA Rocquencourt (RR-2385, 1994)
-\end{quotation}
-The algorithm is based on the first technique, but there are some differences:
-\begin{itemize}
-\item We don't generate code
-\item We have constructors and literals (not only literals as in the 
-	  article)
-\item We don't use directions, we must select the columns from 
-	  left-to-right
-\end{itemize}
-(By the way the second technique is really similar to the one used in 
- @Match.lhs@ to generate code)
-
-This function takes the equations of a pattern and returns:
-\begin{itemize}
-\item The patterns that are not recognized
-\item The equations that are not overlapped
-\end{itemize}
-It simplify the patterns and then call @check'@ (the same semantics), and it 
-needs to reconstruct the patterns again ....
-
-The problem appear with things like:
-\begin{verbatim}
-  f [x,y]   = ....
-  f (x:xs)  = .....
-\end{verbatim}
-We want to put the two patterns with the same syntax, (prefix form) and 
-then all the constructors are equal:
-\begin{verbatim}
-  f (: x (: y []))   = ....
-  f (: x xs)         = .....
-\end{verbatim}
-(more about that in @simplify_eqns@)
-
-We would prefer to have a @WarningPat@ of type @String@, but Strings and the 
-Pretty Printer are not friends.
-
-We use @InPat@ in @WarningPat@ instead of @OutPat@
-because we need to print the 
-warning messages in the same way they are introduced, i.e. if the user 
-wrote:
-\begin{verbatim}
-	f [x,y] = ..
-\end{verbatim}
-He don't want a warning message written:
-\begin{verbatim}
-        f (: x (: y [])) ........
-\end{verbatim}
-Then we need to use InPats.
-\begin{quotation}
-     Juan Quintela 5 JUL 1998\\
-	  User-friendliness and compiler writers are no friends.
-\end{quotation}
-
-\begin{code}
-type WarningPat = InPat Name
-type ExhaustivePat = ([WarningPat], [(Name, [HsLit])])
-type EqnNo  = Int
-type EqnSet = UniqSet EqnNo
-
-
-check :: [EquationInfo] -> ([ExhaustivePat], [EquationInfo])
-	-- Second result is the shadowed equations
-check qs = (untidy_warns, shadowed_eqns)
-      where
-	(warns, used_nos) = check' ([1..] `zip` map simplify_eqn qs)
-	untidy_warns = map untidy_exhaustive warns 
-	shadowed_eqns = [eqn | (eqn,i) <- qs `zip` [1..], 
-				not (i `elementOfUniqSet` used_nos)]
-
-untidy_exhaustive :: ExhaustivePat -> ExhaustivePat
-untidy_exhaustive ([pat], messages) = 
-		  ([untidy_no_pars pat], map untidy_message messages)
-untidy_exhaustive (pats, messages) = 
-		  (map untidy_pars pats, map untidy_message messages)
-
-untidy_message :: (Name, [HsLit]) -> (Name, [HsLit])
-untidy_message (string, lits) = (string, map untidy_lit lits)
-\end{code}
-
-The function @untidy@ does the reverse work of the @simplify_pat@ funcion.
-
-\begin{code}
-
-type NeedPars = Bool 
-
-untidy_no_pars :: WarningPat -> WarningPat
-untidy_no_pars p = untidy False p
-
-untidy_pars :: WarningPat -> WarningPat
-untidy_pars p = untidy True p
-
-untidy :: NeedPars -> WarningPat -> WarningPat
-untidy b (L loc p) = L loc (untidy' b p)
-  where
-    untidy' _ p@(WildPat _)   = p
-    untidy' _ p@(VarPat name) = p
-    untidy' _ (LitPat lit)    = LitPat (untidy_lit lit)
-    untidy' _ p@(ConPatIn name (PrefixCon [])) = p
-    untidy' b (ConPatIn name ps)     = pars b (L loc (ConPatIn name (untidy_con ps)))
-    untidy' _ (ListPat pats ty)      = ListPat (map untidy_no_pars pats) ty
-    untidy' _ (TuplePat pats box ty) = TuplePat (map untidy_no_pars pats) box ty
-    untidy' _ (PArrPat _ _)	     = panic "Check.untidy: Shouldn't get a parallel array here!"
-    untidy' _ (SigPatIn _ _) 	     = panic "Check.untidy: SigPat"
-
-untidy_con (PrefixCon pats) = PrefixCon (map untidy_pars pats) 
-untidy_con (InfixCon p1 p2) = InfixCon  (untidy_pars p1) (untidy_pars p2)
-untidy_con (RecCon bs)      = RecCon    [(f,untidy_pars p) | (f,p) <- bs]
-
-pars :: NeedPars -> WarningPat -> Pat Name
-pars True p = ParPat p
-pars _    p = unLoc p
-
-untidy_lit :: HsLit -> HsLit
-untidy_lit (HsCharPrim c) = HsChar c
-untidy_lit lit 		  = lit
-\end{code}
-
-This equation is the same that check, the only difference is that the
-boring work is done, that work needs to be done only once, this is
-the reason top have two functions, check is the external interface,
-@check'@ is called recursively.
-
-There are several cases:
-
-\begin{itemize} 
-\item There are no equations: Everything is OK. 
-\item There are only one equation, that can fail, and all the patterns are
-      variables. Then that equation is used and the same equation is 
-      non-exhaustive.
-\item All the patterns are variables, and the match can fail, there are 
-      more equations then the results is the result of the rest of equations 
-      and this equation is used also.
-
-\item The general case, if all the patterns are variables (here the match 
-      can't fail) then the result is that this equation is used and this 
-      equation doesn't generate non-exhaustive cases.
-
-\item In the general case, there can exist literals ,constructors or only 
-      vars in the first column, we actuate in consequence.
-
-\end{itemize}
-
-
-\begin{code}
-
-check' :: [(EqnNo, EquationInfo)] 
-	-> ([ExhaustivePat], 	-- Pattern scheme that might not be matched at all
-	    EqnSet)  		-- Eqns that are used (others are overlapped)
-
-check' [] = ([([],[])],emptyUniqSet)
-
-check' ((n, EqnInfo { eqn_pats = ps, eqn_rhs = MatchResult can_fail _ }) : rs) 
-   | first_eqn_all_vars && case can_fail of { CantFail -> True; CanFail -> False }
-   = ([], unitUniqSet n)	-- One eqn, which can't fail
-
-   | first_eqn_all_vars && null rs	-- One eqn, but it can fail
-   = ([(takeList ps (repeat nlWildPat),[])], unitUniqSet n)
-
-   | first_eqn_all_vars		-- Several eqns, first can fail
-   = (pats, addOneToUniqSet indexs n)
-  where
-    first_eqn_all_vars = all_vars ps
-    (pats,indexs) = check' rs
-
-check' qs
-   | literals     = split_by_literals qs
-   | constructors = split_by_constructor qs
-   | only_vars    = first_column_only_vars qs
-   | otherwise    = pprPanic "Check.check': Not implemented :-(" (ppr first_pats)
-  where
-     -- Note: RecPats will have been simplified to ConPats
-     --       at this stage.
-    first_pats   = ASSERT2( okGroup qs, pprGroup qs ) map firstPatN qs
-    constructors = any is_con first_pats
-    literals     = any is_lit first_pats
-    only_vars    = all is_var first_pats
-\end{code}
-
-Here begins the code to deal with literals, we need to split the matrix
-in different matrix beginning by each literal and a last matrix with the 
-rest of values.
-
-\begin{code}
-split_by_literals :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat], EqnSet)
-split_by_literals qs = process_literals used_lits qs
-           where
-             used_lits = get_used_lits qs
-\end{code}
-
-@process_explicit_literals@ is a function that process each literal that appears 
-in the column of the matrix. 
-
-\begin{code}
-process_explicit_literals :: [HsLit] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
-process_explicit_literals lits qs = (concat pats, unionManyUniqSets indexs)
-    where                  
-      pats_indexs   = map (\x -> construct_literal_matrix x qs) lits
-      (pats,indexs) = unzip pats_indexs 
-\end{code}
-
-
-@process_literals@ calls @process_explicit_literals@ to deal with the literals 
-that appears in the matrix and deal also with the rest of the cases. It 
-must be one Variable to be complete.
-
-\begin{code}
-
-process_literals :: [HsLit] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
-process_literals used_lits qs 
-  | null default_eqns  = ([make_row_vars used_lits (head qs)] ++ pats,indexs)
-  | otherwise          = (pats_default,indexs_default)
-     where
-       (pats,indexs)   = process_explicit_literals used_lits qs
-       default_eqns    = ASSERT2( okGroup qs, pprGroup qs ) 
-			 [remove_var q | q <- qs, is_var (firstPatN q)]
-       (pats',indexs') = check' default_eqns 
-       pats_default    = [(nlWildPat:ps,constraints) | (ps,constraints) <- (pats')] ++ pats 
-       indexs_default  = unionUniqSets indexs' indexs
-\end{code}
-
-Here we have selected the literal and we will select all the equations that 
-begins for that literal and create a new matrix.
-
-\begin{code}
-construct_literal_matrix :: HsLit -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
-construct_literal_matrix lit qs =
-    (map (\ (xs,ys) -> (new_lit:xs,ys)) pats,indexs) 
-  where
-    (pats,indexs) = (check' (remove_first_column_lit lit qs)) 
-    new_lit = nlLitPat lit
-
-remove_first_column_lit :: HsLit
-                        -> [(EqnNo, EquationInfo)] 
-                        -> [(EqnNo, EquationInfo)]
-remove_first_column_lit lit qs
-  = ASSERT2( okGroup qs, pprGroup qs ) 
-    [(n, shift_pat eqn) | q@(n,eqn) <- qs, is_var_lit lit (firstPatN q)]
-  where
-     shift_pat eqn@(EqnInfo { eqn_pats = _:ps}) = eqn { eqn_pats = ps }
-     shift_pat eqn@(EqnInfo { eqn_pats = []})   = panic "Check.shift_var: no patterns"
-\end{code}
-
-This function splits the equations @qs@ in groups that deal with the 
-same constructor.
-
-\begin{code}
-split_by_constructor :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat], EqnSet)
-split_by_constructor qs 
-  | notNull unused_cons = need_default_case used_cons unused_cons qs 
-  | otherwise           = no_need_default_case used_cons qs 
-                       where 
-                          used_cons   = get_used_cons qs 
-                          unused_cons = get_unused_cons used_cons 
-\end{code}
-
-The first column of the patterns matrix only have vars, then there is 
-nothing to do.
-
-\begin{code}
-first_column_only_vars :: [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
-first_column_only_vars qs = (map (\ (xs,ys) -> (nlWildPat:xs,ys)) pats,indexs)
-                          where
-                            (pats, indexs) = check' (map remove_var qs)
-\end{code}
-
-This equation takes a matrix of patterns and split the equations by 
-constructor, using all the constructors that appears in the first column 
-of the pattern matching.
-
-We can need a default clause or not ...., it depends if we used all the 
-constructors or not explicitly. The reasoning is similar to @process_literals@,
-the difference is that here the default case is not always needed.
-
-\begin{code}
-no_need_default_case :: [Pat Id] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
-no_need_default_case cons qs = (concat pats, unionManyUniqSets indexs)
-    where                  
-      pats_indexs   = map (\x -> construct_matrix x qs) cons
-      (pats,indexs) = unzip pats_indexs 
-
-need_default_case :: [Pat Id] -> [DataCon] -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
-need_default_case used_cons unused_cons qs 
-  | null default_eqns  = (pats_default_no_eqns,indexs)
-  | otherwise          = (pats_default,indexs_default)
-     where
-       (pats,indexs)   = no_need_default_case used_cons qs
-       default_eqns    = ASSERT2( okGroup qs, pprGroup qs ) 
-			 [remove_var q | q <- qs, is_var (firstPatN q)]
-       (pats',indexs') = check' default_eqns 
-       pats_default    = [(make_whole_con c:ps,constraints) | 
-                          c <- unused_cons, (ps,constraints) <- pats'] ++ pats
-       new_wilds       = make_row_vars_for_constructor (head qs)
-       pats_default_no_eqns =  [(make_whole_con c:new_wilds,[]) | c <- unused_cons] ++ pats
-       indexs_default  = unionUniqSets indexs' indexs
-
-construct_matrix :: Pat Id -> [(EqnNo, EquationInfo)] -> ([ExhaustivePat],EqnSet)
-construct_matrix con qs =
-    (map (make_con con) pats,indexs) 
-  where
-    (pats,indexs) = (check' (remove_first_column con qs)) 
-\end{code}
-
-Here remove first column is more difficult that with literals due to the fact 
-that constructors can have arguments.
-
-For instance, the matrix
-\begin{verbatim}
- (: x xs) y
- z        y
-\end{verbatim}
-is transformed in:
-\begin{verbatim}
- x xs y
- _ _  y
-\end{verbatim}
-
-\begin{code}
-remove_first_column :: Pat Id                -- Constructor 
-                    -> [(EqnNo, EquationInfo)] 
-                    -> [(EqnNo, EquationInfo)]
-remove_first_column (ConPatOut (L _ con) _ _ _ (PrefixCon con_pats) _) qs
-  = ASSERT2( okGroup qs, pprGroup qs ) 
-    [(n, shift_var eqn) | q@(n, eqn) <- qs, is_var_con con (firstPatN q)]
-  where
-     new_wilds = [WildPat (hsPatType arg_pat) | arg_pat <- con_pats]
-     shift_var eqn@(EqnInfo { eqn_pats = ConPatOut _ _ _ _ (PrefixCon ps') _ : ps}) 
- 	= eqn { eqn_pats = map unLoc ps' ++ ps }
-     shift_var eqn@(EqnInfo { eqn_pats = WildPat _ : ps })
-  	= eqn { eqn_pats = new_wilds ++ ps }
-     shift_var _ = panic "Check.Shift_var:No done"
-
-make_row_vars :: [HsLit] -> (EqnNo, EquationInfo) -> ExhaustivePat
-make_row_vars used_lits (_, EqnInfo { eqn_pats = pats})
-   = (nlVarPat new_var:takeList (tail pats) (repeat nlWildPat),[(new_var,used_lits)])
-  where 
-     new_var = hash_x
-
-hash_x = mkInternalName unboundKey {- doesn't matter much -}
-		     (mkVarOccFS FSLIT("#x"))
-		     noSrcLoc
-
-make_row_vars_for_constructor :: (EqnNo, EquationInfo) -> [WarningPat]
-make_row_vars_for_constructor (_, EqnInfo { eqn_pats = pats}) 
-  = takeList (tail pats) (repeat nlWildPat)
-
-compare_cons :: Pat Id -> Pat Id -> Bool
-compare_cons (ConPatOut (L _ id1) _ _ _ _ _) (ConPatOut (L _ id2) _ _ _ _ _) = id1 == id2  
-
-remove_dups :: [Pat Id] -> [Pat Id]
-remove_dups []     = []
-remove_dups (x:xs) | or (map (\y -> compare_cons x y) xs) = remove_dups  xs
-                   | otherwise                            = x : remove_dups xs
-
-get_used_cons :: [(EqnNo, EquationInfo)] -> [Pat Id]
-get_used_cons qs = remove_dups [pat | q <- qs, let pat = firstPatN q, 
-				      isConPatOut pat]
-
-isConPatOut (ConPatOut {}) = True
-isConPatOut other	   = False
-
-remove_dups' :: [HsLit] -> [HsLit] 
-remove_dups' []                   = []
-remove_dups' (x:xs) | x `elem` xs = remove_dups' xs
-                    | otherwise   = x : remove_dups' xs 
-
-
-get_used_lits :: [(EqnNo, EquationInfo)] -> [HsLit]
-get_used_lits qs = remove_dups' all_literals
-	         where
-	           all_literals = get_used_lits' qs
-
-get_used_lits' :: [(EqnNo, EquationInfo)] -> [HsLit]
-get_used_lits' [] = []
-get_used_lits' (q:qs) 
-  | Just lit <- get_lit (firstPatN q) = lit : get_used_lits' qs
-  | otherwise		              = get_used_lits qs
-
-get_lit :: Pat id -> Maybe HsLit 
--- Get a representative HsLit to stand for the OverLit
--- It doesn't matter which one, because they will only be compared
--- with other HsLits gotten in the same way
-get_lit (LitPat lit)			 = Just lit
-get_lit (NPat (HsIntegral i   _) mb _ _) = Just (HsIntPrim   (mb_neg mb i))
-get_lit (NPat (HsFractional f _) mb _ _) = Just (HsFloatPrim (mb_neg mb f))
-get_lit other_pat			 = Nothing
-
-mb_neg :: Num a => Maybe b -> a -> a
-mb_neg Nothing  v = v
-mb_neg (Just _) v = -v
-
-get_unused_cons :: [Pat Id] -> [DataCon]
-get_unused_cons used_cons = unused_cons
-     where
-       (ConPatOut _ _ _ _ _ ty) = head used_cons
-       ty_con 		      = tcTyConAppTyCon ty		-- Newtype observable
-       all_cons        	      = tyConDataCons ty_con
-       used_cons_as_id 	      = map (\ (ConPatOut (L _ d) _ _ _ _ _) -> d) used_cons
-       unused_cons     	      = uniqSetToList
-		 (mkUniqSet all_cons `minusUniqSet` mkUniqSet used_cons_as_id) 
-
-all_vars :: [Pat Id] -> Bool
-all_vars []             = True
-all_vars (WildPat _:ps) = all_vars ps
-all_vars _              = False
-
-remove_var :: (EqnNo, EquationInfo) -> (EqnNo, EquationInfo)
-remove_var (n, eqn@(EqnInfo { eqn_pats = WildPat _ : ps})) = (n, eqn { eqn_pats = ps })
-remove_var _  = panic "Check.remove_var: equation does not begin with a variable"
-
------------------------
-eqnPats :: (EqnNo, EquationInfo) -> [Pat Id]
-eqnPats (_, eqn) = eqn_pats eqn
-
-okGroup :: [(EqnNo, EquationInfo)] -> Bool
--- True if all equations have at least one pattern, and
--- all have the same number of patterns
-okGroup [] = True
-okGroup (e:es) = n_pats > 0 && and [length (eqnPats e) == n_pats | e <- es]
-	       where
-		 n_pats = length (eqnPats e)
-
--- Half-baked print
-pprGroup es = vcat (map pprEqnInfo es)
-pprEqnInfo e = ppr (eqnPats e)
-
-
-firstPatN :: (EqnNo, EquationInfo) -> Pat Id
-firstPatN (_, eqn) = firstPat eqn
-
-is_con :: Pat Id -> Bool
-is_con (ConPatOut _ _ _ _ _ _) = True
-is_con _                     = False
-
-is_lit :: Pat Id -> Bool
-is_lit (LitPat _)      = True
-is_lit (NPat _ _ _ _)  = True
-is_lit _               = False
-
-is_var :: Pat Id -> Bool
-is_var (WildPat _) = True
-is_var _           = False
-
-is_var_con :: DataCon -> Pat Id -> Bool
-is_var_con con (WildPat _)                          = True
-is_var_con con (ConPatOut (L _ id) _ _ _ _ _) | id == con = True
-is_var_con con _                                    = False
-
-is_var_lit :: HsLit -> Pat Id -> Bool
-is_var_lit lit (WildPat _)   = True
-is_var_lit lit pat 
-  | Just lit' <- get_lit pat = lit == lit'
-  | otherwise		     = False
-\end{code}
-
-The difference beteewn @make_con@ and @make_whole_con@ is that
-@make_wole_con@ creates a new constructor with all their arguments, and
-@make_con@ takes a list of argumntes, creates the contructor getting their
-arguments from the list. See where \fbox{\ ???\ } are used for details.
-
-We need to reconstruct the patterns (make the constructors infix and
-similar) at the same time that we create the constructors.
-
-You can tell tuple constructors using
-\begin{verbatim}
-        Id.isTupleCon
-\end{verbatim}
-You can see if one constructor is infix with this clearer code :-))))))))))
-\begin{verbatim}
-        Lex.isLexConSym (Name.occNameString (Name.getOccName con))
-\end{verbatim}
-
-       Rather clumsy but it works. (Simon Peyton Jones)
-
-
-We don't mind the @nilDataCon@ because it doesn't change the way to
-print the messsage, we are searching only for things like: @[1,2,3]@,
-not @x:xs@ ....
-
-In @reconstruct_pat@ we want to ``undo'' the work
-that we have done in @simplify_pat@.
-In particular:
-\begin{tabular}{lll}
-	@((,) x y)@   & returns to be & @(x, y)@
-\\      @((:) x xs)@  & returns to be & @(x:xs)@
-\\      @(x:(...:[])@ & returns to be & @[x,...]@
-\end{tabular}
-%
-The difficult case is the third one becouse we need to follow all the
-contructors until the @[]@ to know that we need to use the second case,
-not the second. \fbox{\ ???\ }
-%
-\begin{code}
-isInfixCon con = isDataSymOcc (getOccName con)
-
-is_nil (ConPatIn con (PrefixCon [])) = unLoc con == getName nilDataCon
-is_nil _               		     = False
-
-is_list (ListPat _ _) = True
-is_list _             = False
-
-return_list id q = id == consDataCon && (is_nil q || is_list q) 
-
-make_list p q | is_nil q    = ListPat [p] placeHolderType
-make_list p (ListPat ps ty) = ListPat (p:ps) ty
-make_list _ _               = panic "Check.make_list: Invalid argument"
-
-make_con :: Pat Id -> ExhaustivePat -> ExhaustivePat           
-make_con (ConPatOut (L _ id) _ _ _ _ _) (lp:lq:ps, constraints) 
-     | return_list id q = (noLoc (make_list lp q) : ps, constraints)
-     | isInfixCon id    = (nlInfixConPat (getName id) lp lq : ps, constraints) 
-   where q  = unLoc lq	
-
-make_con (ConPatOut (L _ id) _ _ _ (PrefixCon pats) ty) (ps, constraints) 
-      | isTupleTyCon tc  = (noLoc (TuplePat pats_con (tupleTyConBoxity tc) ty) : rest_pats, constraints) 
-      | isPArrFakeCon id = (noLoc (PArrPat pats_con placeHolderType)           : rest_pats, constraints) 
-      | otherwise        = (nlConPat name pats_con      : rest_pats, constraints)
-    where 
-	name     	      = getName id
-	(pats_con, rest_pats) = splitAtList pats ps
-	tc	    	      = dataConTyCon id
-
--- reconstruct parallel array pattern
---
---  * don't check for the type only; we need to make sure that we are really
---   dealing with one of the fake constructors and not with the real
---   representation 
-
-make_whole_con :: DataCon -> WarningPat
-make_whole_con con | isInfixCon con = nlInfixConPat name nlWildPat nlWildPat
-                   | otherwise      = nlConPat name pats
-                where 
-                  name   = getName con
-                  pats   = [nlWildPat | t <- dataConOrigArgTys con]
-\end{code}
-
-This equation makes the same thing as @tidy@ in @Match.lhs@, the
-difference is that here we can do all the tidy in one place and in the
-@Match@ tidy it must be done one column each time due to bookkeeping 
-constraints.
-
-\begin{code}
-
-simplify_eqn :: EquationInfo -> EquationInfo
-simplify_eqn eqn = eqn { eqn_pats = map simplify_pat (eqn_pats eqn), 
-		         eqn_rhs  = simplify_rhs (eqn_rhs eqn) }
-  where
-	-- Horrible hack.  The simplify_pat stuff converts NPlusK pats to WildPats
-	-- which of course loses the info that they can fail to match.  So we 
-	-- stick in a CanFail as if it were a guard.
-	-- The Right Thing to do is for the whole system to treat NPlusK pats properly
-    simplify_rhs (MatchResult can_fail body)
-	| any has_nplusk_pat (eqn_pats eqn) = MatchResult CanFail body
-	| otherwise			    = MatchResult can_fail body
-
-has_nplusk_lpat :: LPat Id -> Bool
-has_nplusk_lpat (L _ p) = has_nplusk_pat p
-
-has_nplusk_pat :: Pat Id -> Bool
-has_nplusk_pat (NPlusKPat _ _ _ _) 	 = True
-has_nplusk_pat (ParPat p)  	   	 = has_nplusk_lpat p
-has_nplusk_pat (AsPat _ p) 	   	 = has_nplusk_lpat p
-has_nplusk_pat (SigPatOut p _ )    	 = has_nplusk_lpat p
-has_nplusk_pat (ConPatOut _ _ _ _ ps ty) = any has_nplusk_lpat (hsConArgs ps)
-has_nplusk_pat (ListPat ps _)  		 = any has_nplusk_lpat ps
-has_nplusk_pat (TuplePat ps _ _) 	 = any has_nplusk_lpat ps
-has_nplusk_pat (PArrPat ps _)  		 = any has_nplusk_lpat ps
-has_nplusk_pat (LazyPat p)     		 = False	-- Why?
-has_nplusk_pat (BangPat p)     		 = has_nplusk_lpat p	-- I think
-has_nplusk_pat p = False 	-- VarPat, VarPatOut, WildPat, LitPat, NPat, TypePat, DictPat
-
-simplify_lpat :: LPat Id -> LPat Id  
-simplify_lpat p = fmap simplify_pat p
-
-simplify_pat :: Pat Id -> Pat Id
-simplify_pat pat@(WildPat gt) = pat
-simplify_pat (VarPat id)      = WildPat (idType id) 
-simplify_pat (VarPatOut id _) = WildPat (idType id) 	-- Ignore the bindings
-simplify_pat (ParPat p)       = unLoc (simplify_lpat p)
-simplify_pat (LazyPat p)      = unLoc (simplify_lpat p)
-simplify_pat (BangPat p)      = unLoc (simplify_lpat p)
-simplify_pat (AsPat id p)     = unLoc (simplify_lpat p)
-simplify_pat (SigPatOut p _)  = unLoc (simplify_lpat p)	-- I'm not sure this is right
-
-simplify_pat (ConPatOut (L loc id) tvs dicts binds ps ty) 
-  = ConPatOut (L loc id) tvs dicts binds (simplify_con id ps) ty
-
-simplify_pat (ListPat ps ty) = 
-  unLoc $ foldr (\ x y -> mkPrefixConPat consDataCon [x,y] list_ty)
-	                          (mkNilPat list_ty)
-	                          (map simplify_lpat ps)
-         where list_ty = mkListTy ty
-
--- introduce fake parallel array constructors to be able to handle parallel
--- arrays with the existing machinery for constructor pattern
---
-simplify_pat (PArrPat ps ty)
-  = mk_simple_con_pat (parrFakeCon (length ps))
-		      (PrefixCon (map simplify_lpat ps)) 
-		      (mkPArrTy ty)
-
-simplify_pat (TuplePat ps boxity ty)
-  = mk_simple_con_pat (tupleCon boxity arity)
-		      (PrefixCon (map simplify_lpat ps))
-		      ty
-  where
-    arity = length ps
-
--- unpack string patterns fully, so we can see when they overlap with
--- each other, or even explicit lists of Chars.
-simplify_pat pat@(LitPat (HsString s)) = 
-   foldr (\c pat -> mk_simple_con_pat consDataCon (PrefixCon [mk_char_lit c,noLoc pat]) stringTy)
-	 (mk_simple_con_pat nilDataCon (PrefixCon []) stringTy) (unpackFS s)
-  where
-    mk_char_lit c = noLoc (mk_simple_con_pat charDataCon (PrefixCon [nlLitPat (HsCharPrim c)]) charTy)
-
-simplify_pat pat@(LitPat lit) = unLoc (tidyLitPat lit (noLoc pat))
-
-simplify_pat pat@(NPat lit mb_neg _ lit_ty) = unLoc (tidyNPat lit mb_neg lit_ty (noLoc pat))
-
-simplify_pat (NPlusKPat id hslit hsexpr1 hsexpr2)
-   = WildPat (idType (unLoc id))
-
-simplify_pat (DictPat dicts methods)
-  = case num_of_d_and_ms of
-       0 -> simplify_pat (TuplePat [] Boxed unitTy) 
-       1 -> simplify_pat (head dict_and_method_pats) 
-       _ -> simplify_pat (mkVanillaTuplePat (map noLoc dict_and_method_pats) Boxed)
-    where
-       num_of_d_and_ms	 = length dicts + length methods
-       dict_and_method_pats = map VarPat (dicts ++ methods)
-
-mk_simple_con_pat con args ty = ConPatOut (noLoc con) [] [] emptyLHsBinds args ty
-
------------------
-simplify_con con (PrefixCon ps)   = PrefixCon (map simplify_lpat ps)
-simplify_con con (InfixCon p1 p2) = PrefixCon [simplify_lpat p1, simplify_lpat p2]
-simplify_con con (RecCon fs)      
-  | null fs   = PrefixCon [nlWildPat | t <- dataConOrigArgTys con]
-		-- Special case for null patterns; maybe not a record at all
-  | otherwise = PrefixCon (map (simplify_lpat.snd) all_pats)
-  where
-     -- pad out all the missing fields with WildPats.
-    field_pats = map (\ f -> (f, nlWildPat)) (dataConFieldLabels con)
-    all_pats = foldr (\ (id,p) acc -> insertNm (getName (unLoc id)) p acc)
-		     field_pats fs
-       
-    insertNm nm p [] = [(nm,p)]
-    insertNm nm p (x@(n,_):xs)
-      | nm == n    = (nm,p):xs
-      | otherwise  = x : insertNm nm p xs
-\end{code}
diff --git a/ghc/compiler/deSugar/Desugar.lhs b/ghc/compiler/deSugar/Desugar.lhs
deleted file mode 100644
index 45dc113cc1..0000000000
--- a/ghc/compiler/deSugar/Desugar.lhs
+++ /dev/null
@@ -1,298 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Desugar]{@deSugar@: the main function}
-
-\begin{code}
-module Desugar ( deSugar, deSugarExpr ) where
-
-#include "HsVersions.h"
-
-import DynFlags		( DynFlag(..), DynFlags(..), dopt, GhcMode(..) )
-import StaticFlags	( opt_SccProfilingOn )
-import DriverPhases	( isHsBoot )
-import HscTypes		( ModGuts(..), HscEnv(..), 
-			  Dependencies(..), ForeignStubs(..), TypeEnv, IsBootInterface )
-import HsSyn		( RuleDecl(..), RuleBndr(..), LHsExpr, LRuleDecl )
-import TcRnTypes	( TcGblEnv(..), ImportAvails(..) )
-import MkIface		( mkUsageInfo )
-import Id		( Id, setIdExported, idName )
-import Name		( Name, isExternalName, nameIsLocalOrFrom, nameOccName )
-import CoreSyn
-import PprCore		( pprRules, pprCoreExpr )
-import DsMonad
-import DsExpr		( dsLExpr )
-import DsBinds		( dsTopLHsBinds, decomposeRuleLhs, AutoScc(..) )
-import DsForeign	( dsForeigns )
-import DsExpr		()	-- Forces DsExpr to be compiled; DsBinds only
-				-- depends on DsExpr.hi-boot.
-import Module		( Module, moduleEnvElts, delModuleEnv, moduleFS )
-import RdrName	 	( GlobalRdrEnv )
-import NameSet
-import VarSet
-import Bag		( Bag, isEmptyBag, emptyBag )
-import Rules		( roughTopNames )
-import CoreLint		( showPass, endPass )
-import CoreFVs		( ruleRhsFreeVars, exprsFreeNames )
-import Packages	  	( PackageState(thPackageId), PackageIdH(..) )
-import ErrUtils		( doIfSet, dumpIfSet_dyn, printBagOfWarnings, 
-			  errorsFound, WarnMsg )
-import ListSetOps	( insertList )
-import Outputable
-import UniqSupply	( mkSplitUniqSupply )
-import SrcLoc		( Located(..) )
-import DATA_IOREF	( readIORef )
-import Maybes		( catMaybes )
-import FastString
-import Util		( sortLe )
-\end{code}
-
-%************************************************************************
-%*									*
-%* 		The main function: deSugar
-%*									*
-%************************************************************************
-
-\begin{code}
-deSugar :: HscEnv -> TcGblEnv -> IO (Bag WarnMsg, Maybe ModGuts)
--- Can modify PCS by faulting in more declarations
-
-deSugar hsc_env 
-        tcg_env@(TcGblEnv { tcg_mod       = mod,
-			    tcg_src	  = hsc_src,
-		    	    tcg_type_env  = type_env,
-		    	    tcg_imports   = imports,
-			    tcg_home_mods  = home_mods,
-		    	    tcg_exports   = exports,
-		    	    tcg_dus	  = dus, 
-		    	    tcg_inst_uses = dfun_uses_var,
-			    tcg_th_used   = th_var,
-			    tcg_keep	  = keep_var,
-		    	    tcg_rdr_env   = rdr_env,
-		    	    tcg_fix_env   = fix_env,
-	    	    	    tcg_deprecs   = deprecs,
-			    tcg_binds     = binds,
-			    tcg_fords     = fords,
-			    tcg_rules     = rules,
-		    	    tcg_insts     = insts })
-  = do	{ showPass dflags "Desugar"
-
-	-- Desugar the program
-	; ((all_prs, ds_rules, ds_fords), warns) 
-		<- case ghcMode (hsc_dflags hsc_env) of
-	             JustTypecheck -> return (([], [], NoStubs), emptyBag)
-	             _             -> initDs hsc_env mod rdr_env type_env $ do
-		                        { core_prs <- dsTopLHsBinds auto_scc binds
-		                        ; (ds_fords, foreign_prs) <- dsForeigns fords
-		                        ; let all_prs = foreign_prs ++ core_prs
-		                              local_bndrs = mkVarSet (map fst all_prs)
-		                        ; ds_rules <- mappM (dsRule mod local_bndrs) rules
-		                        ; return (all_prs, catMaybes ds_rules, ds_fords)
-		                        }
-
-	-- If warnings are considered errors, leave.
-	; if errorsFound dflags (warns, emptyBag)
-	   then return (warns, Nothing)
-	   else do
-
-	{ 	-- Add export flags to bindings
-	  keep_alive <- readIORef keep_var
-	; let final_prs = addExportFlags ghci_mode exports keep_alive 
-				   	 all_prs ds_rules
-	      ds_binds  = [Rec final_prs]
-	-- Notice that we put the whole lot in a big Rec, even the foreign binds
-	-- When compiling PrelFloat, which defines data Float = F# Float#
-	-- we want F# to be in scope in the foreign marshalling code!
-	-- You might think it doesn't matter, but the simplifier brings all top-level
-	-- things into the in-scope set before simplifying; so we get no unfolding for F#!
-
-	-- Lint result if necessary
-	; endPass dflags "Desugar" Opt_D_dump_ds ds_binds
-
-	-- Dump output
-	; doIfSet (dopt Opt_D_dump_ds dflags) 
-		  (printDump (ppr_ds_rules ds_rules))
-
-	; dfun_uses <- readIORef dfun_uses_var		-- What dfuns are used
-	; th_used   <- readIORef th_var			-- Whether TH is used
-	; let used_names = allUses dus `unionNameSets` dfun_uses
-	      thPackage = thPackageId (pkgState dflags)
-	      pkgs | ExtPackage th_id <- thPackage, th_used
-		   = insertList th_id  (imp_dep_pkgs imports)
-	      	   | otherwise
-		   = imp_dep_pkgs imports
-
-	      dep_mods = moduleEnvElts (delModuleEnv (imp_dep_mods imports) mod)
-		-- M.hi-boot can be in the imp_dep_mods, but we must remove
-		-- it before recording the modules on which this one depends!
-		-- (We want to retain M.hi-boot in imp_dep_mods so that 
-		--  loadHiBootInterface can see if M's direct imports depend 
-		--  on M.hi-boot, and hence that we should do the hi-boot consistency 
-		--  check.)
-
-	      dir_imp_mods = imp_mods imports
-
-	; usages <- mkUsageInfo hsc_env home_mods dir_imp_mods dep_mods used_names
-
-	; let 
-		-- Modules don't compare lexicographically usually, 
-		-- but we want them to do so here.
-	     le_mod :: Module -> Module -> Bool	 
-	     le_mod m1 m2 = moduleFS m1 <= moduleFS m2
-	     le_dep_mod :: (Module, IsBootInterface) -> (Module, IsBootInterface) -> Bool	 
-	     le_dep_mod (m1,_) (m2,_) = m1 `le_mod` m2
-
-	     deps = Deps { dep_mods  = sortLe le_dep_mod dep_mods,
-			   dep_pkgs  = sortLe (<=)   pkgs,	
-			   dep_orphs = sortLe le_mod (imp_orphs imports) }
-		-- sort to get into canonical order
-
-	     mod_guts = ModGuts {	
-		mg_module   = mod,
-		mg_boot	    = isHsBoot hsc_src,
-		mg_exports  = exports,
-		mg_deps	    = deps,
-		mg_home_mods = home_mods,
-		mg_usages   = usages,
-		mg_dir_imps = [m | (m,_,_) <- moduleEnvElts dir_imp_mods],
-	        mg_rdr_env  = rdr_env,
-		mg_fix_env  = fix_env,
-		mg_deprecs  = deprecs,
-		mg_types    = type_env,
-		mg_insts    = insts,
-	        mg_rules    = ds_rules,
-		mg_binds    = ds_binds,
-		mg_foreign  = ds_fords }
-	
-        ; return (warns, Just mod_guts)
-	}}
-
-  where
-    dflags       = hsc_dflags hsc_env
-    ghci_mode    = ghcMode (hsc_dflags hsc_env)
-    auto_scc | opt_SccProfilingOn = TopLevel
-	     | otherwise          = NoSccs
-
-deSugarExpr :: HscEnv
-	    -> Module -> GlobalRdrEnv -> TypeEnv 
- 	    -> LHsExpr Id
-	    -> IO CoreExpr
-deSugarExpr hsc_env this_mod rdr_env type_env tc_expr
-  = do	{ showPass dflags "Desugar"
-	; us <- mkSplitUniqSupply 'd'
-
-	-- Do desugaring
-	; (core_expr, ds_warns) <- initDs hsc_env this_mod rdr_env type_env $
-				   dsLExpr tc_expr
-
-	-- Display any warnings 
-	-- Note: if -Werror is used, we don't signal an error here.
-        ; doIfSet (not (isEmptyBag ds_warns))
-		  (printBagOfWarnings dflags ds_warns)
-
-	-- Dump output
-	; dumpIfSet_dyn dflags Opt_D_dump_ds "Desugared" (pprCoreExpr core_expr)
-
-        ; return core_expr
-	}
-  where
-    dflags       = hsc_dflags hsc_env
-
-
---		addExportFlags
--- Set the no-discard flag if either 
---	a) the Id is exported
---	b) it's mentioned in the RHS of an orphan rule
---	c) it's in the keep-alive set
---
--- It means that the binding won't be discarded EVEN if the binding
--- ends up being trivial (v = w) -- the simplifier would usually just 
--- substitute w for v throughout, but we don't apply the substitution to
--- the rules (maybe we should?), so this substitution would make the rule
--- bogus.
-
--- You might wonder why exported Ids aren't already marked as such;
--- it's just because the type checker is rather busy already and
--- I didn't want to pass in yet another mapping.
-
-addExportFlags ghci_mode exports keep_alive prs rules
-  = [(add_export bndr, rhs) | (bndr,rhs) <- prs]
-  where
-    add_export bndr
-	| dont_discard bndr = setIdExported bndr
-	| otherwise	    = bndr
-
-    orph_rhs_fvs = unionVarSets [ ruleRhsFreeVars rule
-			        | rule <- rules, 
-				  not (isLocalRule rule) ]
-	-- A non-local rule keeps alive the free vars of its right-hand side. 
-	-- (A "non-local" is one whose head function is not locally defined.)
-	-- Local rules are (later, after gentle simplification) 
-	-- attached to the Id, and that keeps the rhs free vars alive.
-
-    dont_discard bndr = is_exported name
-		     || name `elemNameSet` keep_alive
-		     || bndr `elemVarSet` orph_rhs_fvs 
-		     where
-			name = idName bndr
-
-    	-- In interactive mode, we don't want to discard any top-level
-    	-- entities at all (eg. do not inline them away during
-    	-- simplification), and retain them all in the TypeEnv so they are
-    	-- available from the command line.
-	--
-	-- isExternalName separates the user-defined top-level names from those
-	-- introduced by the type checker.
-    is_exported :: Name -> Bool
-    is_exported | ghci_mode == Interactive = isExternalName
-		| otherwise 		   = (`elemNameSet` exports)
-
-ppr_ds_rules [] = empty
-ppr_ds_rules rules
-  = text "" $$ text "-------------- DESUGARED RULES -----------------" $$
-    pprRules rules
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-%* 		Desugaring transformation rules
-%*									*
-%************************************************************************
-
-\begin{code}
-dsRule :: Module -> IdSet -> LRuleDecl Id -> DsM (Maybe CoreRule)
-dsRule mod in_scope (L loc (HsRule name act vars lhs tv_lhs rhs fv_rhs))
-  = putSrcSpanDs loc $ 
-    do	{ let bndrs     = [var | RuleBndr (L _ var) <- vars]
-	; lhs'  <- dsLExpr lhs
-	; rhs'  <- dsLExpr rhs
-
-	; case decomposeRuleLhs bndrs lhs' of {
-		Nothing -> do { dsWarn msg; return Nothing } ;
-		Just (bndrs', fn_id, args) -> do
-	
-	-- Substitute the dict bindings eagerly,
-	-- and take the body apart into a (f args) form
-	{ let local_rule = nameIsLocalOrFrom mod fn_name
-		-- NB we can't use isLocalId in the orphan test, 
-		-- because isLocalId isn't true of class methods
-	      fn_name   = idName fn_id
-	      lhs_names = fn_name : nameSetToList (exprsFreeNames args)
-		-- No need to delete bndrs, because
-		-- exprsFreeNames finds only External names
-	      orph = case filter (nameIsLocalOrFrom mod) lhs_names of
-			(n:ns) -> Just (nameOccName n)
-			[]     -> Nothing
-
-	      rule = Rule { ru_name = name, ru_fn = fn_name, ru_act = act,
-			    ru_bndrs = bndrs', ru_args = args, ru_rhs = rhs', 
-			    ru_rough = roughTopNames args, 
-			    ru_local = local_rule, ru_orph = orph }
-	; return (Just rule)
-	} } }
-  where
-    msg = hang (ptext SLIT("RULE left-hand side too complicated to desugar; ignored"))
-	     2 (ppr lhs)
-\end{code}
diff --git a/ghc/compiler/deSugar/DsArrows.lhs b/ghc/compiler/deSugar/DsArrows.lhs
deleted file mode 100644
index 111e0bccd0..0000000000
--- a/ghc/compiler/deSugar/DsArrows.lhs
+++ /dev/null
@@ -1,1055 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[DsArrows]{Desugaring arrow commands}
-
-\begin{code}
-module DsArrows ( dsProcExpr ) where
-
-#include "HsVersions.h"
-
-import Match		( matchSimply )
-import DsUtils		( mkErrorAppDs,
-			  mkCoreTupTy, mkCoreTup, selectSimpleMatchVarL,
-			  mkTupleCase, mkBigCoreTup, mkTupleType,
-			  mkTupleExpr, mkTupleSelector,
-			  dsSyntaxTable, lookupEvidence )
-import DsMonad
-
-import HsSyn
-import TcHsSyn		( hsPatType )
-
--- NB: The desugarer, which straddles the source and Core worlds, sometimes
---     needs to see source types (newtypes etc), and sometimes not
---     So WATCH OUT; check each use of split*Ty functions.
--- Sigh.  This is a pain.
-
-import {-# SOURCE #-} DsExpr ( dsExpr, dsLExpr, dsLocalBinds )
-
-import TcType		( Type, tcSplitAppTy, mkFunTy )
-import Type		( mkTyConApp, funArgTy )
-import CoreSyn
-import CoreFVs		( exprFreeVars )
-import CoreUtils	( mkIfThenElse, bindNonRec, exprType )
-
-import Id		( Id, idType )
-import Name		( Name )
-import PrelInfo		( pAT_ERROR_ID )
-import DataCon		( dataConWrapId )
-import TysWiredIn	( tupleCon )
-import BasicTypes	( Boxity(..) )
-import PrelNames	( eitherTyConName, leftDataConName, rightDataConName,
-			  arrAName, composeAName, firstAName,
-			  appAName, choiceAName, loopAName )
-import Util		( mapAccumL )
-import Outputable
-
-import HsUtils		( collectPatBinders, collectPatsBinders )
-import VarSet		( IdSet, mkVarSet, varSetElems,
-			  intersectVarSet, minusVarSet, extendVarSetList, 
-			  unionVarSet, unionVarSets, elemVarSet )
-import SrcLoc		( Located(..), unLoc, noLoc )
-\end{code}
-
-\begin{code}
-data DsCmdEnv = DsCmdEnv {
-	meth_binds :: [CoreBind],
-	arr_id, compose_id, first_id, app_id, choice_id, loop_id :: CoreExpr
-    }
-
-mkCmdEnv :: SyntaxTable Id -> DsM DsCmdEnv
-mkCmdEnv ids
-  = dsSyntaxTable ids			`thenDs` \ (meth_binds, ds_meths) ->
-    return $ DsCmdEnv {
-		meth_binds = meth_binds,
-		arr_id	   = Var (lookupEvidence ds_meths arrAName),
-		compose_id = Var (lookupEvidence ds_meths composeAName),
-		first_id   = Var (lookupEvidence ds_meths firstAName),
-		app_id	   = Var (lookupEvidence ds_meths appAName),
-		choice_id  = Var (lookupEvidence ds_meths choiceAName),
-		loop_id	   = Var (lookupEvidence ds_meths loopAName)
-	    }
-
-bindCmdEnv :: DsCmdEnv -> CoreExpr -> CoreExpr
-bindCmdEnv ids body = foldr Let body (meth_binds ids)
-
--- arr :: forall b c. (b -> c) -> a b c
-do_arr :: DsCmdEnv -> Type -> Type -> CoreExpr -> CoreExpr
-do_arr ids b_ty c_ty f = mkApps (arr_id ids) [Type b_ty, Type c_ty, f]
-
--- (>>>) :: forall b c d. a b c -> a c d -> a b d
-do_compose :: DsCmdEnv -> Type -> Type -> Type ->
-		CoreExpr -> CoreExpr -> CoreExpr
-do_compose ids b_ty c_ty d_ty f g
-  = mkApps (compose_id ids) [Type b_ty, Type c_ty, Type d_ty, f, g]
-
--- first :: forall b c d. a b c -> a (b,d) (c,d)
-do_first :: DsCmdEnv -> Type -> Type -> Type -> CoreExpr -> CoreExpr
-do_first ids b_ty c_ty d_ty f
-  = mkApps (first_id ids) [Type b_ty, Type c_ty, Type d_ty, f]
-
--- app :: forall b c. a (a b c, b) c
-do_app :: DsCmdEnv -> Type -> Type -> CoreExpr
-do_app ids b_ty c_ty = mkApps (app_id ids) [Type b_ty, Type c_ty]
-
--- (|||) :: forall b d c. a b d -> a c d -> a (Either b c) d
--- note the swapping of d and c
-do_choice :: DsCmdEnv -> Type -> Type -> Type ->
-		CoreExpr -> CoreExpr -> CoreExpr
-do_choice ids b_ty c_ty d_ty f g
-  = mkApps (choice_id ids) [Type b_ty, Type d_ty, Type c_ty, f, g]
-
--- loop :: forall b d c. a (b,d) (c,d) -> a b c
--- note the swapping of d and c
-do_loop :: DsCmdEnv -> Type -> Type -> Type -> CoreExpr -> CoreExpr
-do_loop ids b_ty c_ty d_ty f
-  = mkApps (loop_id ids) [Type b_ty, Type d_ty, Type c_ty, f]
-
--- map_arrow (f :: b -> c) (g :: a c d) = arr f >>> g :: a b d
-do_map_arrow :: DsCmdEnv -> Type -> Type -> Type ->
-		CoreExpr -> CoreExpr -> CoreExpr
-do_map_arrow ids b_ty c_ty d_ty f c
-  = do_compose ids b_ty c_ty d_ty (do_arr ids b_ty c_ty f) c
-
-mkFailExpr :: HsMatchContext Id -> Type -> DsM CoreExpr
-mkFailExpr ctxt ty
-  = mkErrorAppDs pAT_ERROR_ID ty (matchContextErrString ctxt)
-
--- construct CoreExpr for \ (a :: a_ty, b :: b_ty) -> b
-mkSndExpr :: Type -> Type -> DsM CoreExpr
-mkSndExpr a_ty b_ty
-  = newSysLocalDs a_ty			`thenDs` \ a_var ->
-    newSysLocalDs b_ty			`thenDs` \ b_var ->
-    newSysLocalDs (mkCorePairTy a_ty b_ty)	`thenDs` \ pair_var ->
-    returnDs (Lam pair_var
-		  (coreCasePair pair_var a_var b_var (Var b_var)))
-\end{code}
-
-Build case analysis of a tuple.  This cannot be done in the DsM monad,
-because the list of variables is typically not yet defined.
-
-\begin{code}
--- coreCaseTuple [u1..] v [x1..xn] body
---	= case v of v { (x1, .., xn) -> body }
--- But the matching may be nested if the tuple is very big
-
-coreCaseTuple :: UniqSupply -> Id -> [Id] -> CoreExpr -> CoreExpr
-coreCaseTuple uniqs scrut_var vars body
-  = mkTupleCase uniqs vars body scrut_var (Var scrut_var)
-
-coreCasePair :: Id -> Id -> Id -> CoreExpr -> CoreExpr
-coreCasePair scrut_var var1 var2 body
-  = Case (Var scrut_var) scrut_var (exprType body)
-         [(DataAlt (tupleCon Boxed 2), [var1, var2], body)]
-\end{code}
-
-\begin{code}
-mkCorePairTy :: Type -> Type -> Type
-mkCorePairTy t1 t2 = mkCoreTupTy [t1, t2]
-
-mkCorePairExpr :: CoreExpr -> CoreExpr -> CoreExpr
-mkCorePairExpr e1 e2 = mkCoreTup [e1, e2]
-\end{code}
-
-The input is divided into a local environment, which is a flat tuple
-(unless it's too big), and a stack, each element of which is paired
-with the stack in turn.  In general, the input has the form
-
-	(...((x1,...,xn),s1),...sk)
-
-where xi are the environment values, and si the ones on the stack,
-with s1 being the "top", the first one to be matched with a lambda.
-
-\begin{code}
-envStackType :: [Id] -> [Type] -> Type
-envStackType ids stack_tys = foldl mkCorePairTy (mkTupleType ids) stack_tys
-
-----------------------------------------------
---		buildEnvStack
---
---	(...((x1,...,xn),s1),...sk)
-
-buildEnvStack :: [Id] -> [Id] -> CoreExpr
-buildEnvStack env_ids stack_ids
-  = foldl mkCorePairExpr (mkTupleExpr env_ids) (map Var stack_ids)
-
-----------------------------------------------
--- 		matchEnvStack
---
---	\ (...((x1,...,xn),s1),...sk) -> e
---	=>
---	\ zk ->
---	case zk of (zk-1,sk) ->
---	...
---	case z1 of (z0,s1) ->
---	case z0 of (x1,...,xn) ->
---	e
-
-matchEnvStack	:: [Id] 	-- x1..xn
-		-> [Id] 	-- s1..sk
-		-> CoreExpr 	-- e
-		-> DsM CoreExpr
-matchEnvStack env_ids stack_ids body
-  = newUniqueSupply			`thenDs` \ uniqs ->
-    newSysLocalDs (mkTupleType env_ids)	`thenDs` \ tup_var ->
-    matchVarStack tup_var stack_ids 
-		  (coreCaseTuple uniqs tup_var env_ids body)
-
-
-----------------------------------------------
--- 		matchVarStack
---
---	\ (...(z0,s1),...sk) -> e
---	=>
---	\ zk ->
---	case zk of (zk-1,sk) ->
---	...
---	case z1 of (z0,s1) ->
---	e
-
-matchVarStack :: Id 		-- z0
-	      -> [Id] 		-- s1..sk
-	      -> CoreExpr 	-- e
-	      -> DsM CoreExpr
-matchVarStack env_id [] body
-  = returnDs (Lam env_id body)
-matchVarStack env_id (stack_id:stack_ids) body
-  = newSysLocalDs (mkCorePairTy (idType env_id) (idType stack_id))
-					`thenDs` \ pair_id ->
-    matchVarStack pair_id stack_ids 
-		  (coreCasePair pair_id env_id stack_id body)
-\end{code}
-
-\begin{code}
-mkHsTupleExpr :: [HsExpr Id] -> HsExpr Id
-mkHsTupleExpr [e] = e
-mkHsTupleExpr es = ExplicitTuple (map noLoc es) Boxed
-
-mkHsPairExpr :: HsExpr Id -> HsExpr Id -> HsExpr Id
-mkHsPairExpr e1 e2 = mkHsTupleExpr [e1, e2]
-
-mkHsEnvStackExpr :: [Id] -> [Id] -> HsExpr Id
-mkHsEnvStackExpr env_ids stack_ids
-  = foldl mkHsPairExpr (mkHsTupleExpr (map HsVar env_ids)) (map HsVar stack_ids)
-\end{code}
-
-Translation of arrow abstraction
-
-\begin{code}
-
---	A | xs |- c :: [] t'  	    ---> c'
---	--------------------------
---	A |- proc p -> c :: a t t'  ---> arr (\ p -> (xs)) >>> c'
---
---		where (xs) is the tuple of variables bound by p
-
-dsProcExpr
-	:: LPat Id
-	-> LHsCmdTop Id
-	-> DsM CoreExpr
-dsProcExpr pat (L _ (HsCmdTop cmd [] cmd_ty ids))
-  = mkCmdEnv ids			`thenDs` \ meth_ids ->
-    let
-	locals = mkVarSet (collectPatBinders pat)
-    in
-    dsfixCmd meth_ids locals [] cmd_ty cmd
-				`thenDs` \ (core_cmd, free_vars, env_ids) ->
-    let
-	env_ty = mkTupleType env_ids
-    in
-    mkFailExpr ProcExpr env_ty		`thenDs` \ fail_expr ->
-    selectSimpleMatchVarL pat		`thenDs` \ var ->
-    matchSimply (Var var) ProcExpr pat (mkTupleExpr env_ids) fail_expr
-					`thenDs` \ match_code ->
-    let
-	pat_ty = hsPatType pat
-	proc_code = do_map_arrow meth_ids pat_ty env_ty cmd_ty
-		(Lam var match_code)
-		core_cmd
-    in
-    returnDs (bindCmdEnv meth_ids proc_code)
-\end{code}
-
-Translation of command judgements of the form
-
-	A | xs |- c :: [ts] t
-
-\begin{code}
-dsLCmd ids local_vars env_ids stack res_ty cmd
-  = dsCmd ids local_vars env_ids stack res_ty (unLoc cmd)
-
-dsCmd   :: DsCmdEnv		-- arrow combinators
-	-> IdSet		-- set of local vars available to this command
-	-> [Id]			-- list of vars in the input to this command
-				-- This is typically fed back,
-				-- so don't pull on it too early
-	-> [Type]		-- type of the stack
-	-> Type			-- return type of the command
-	-> HsCmd Id		-- command to desugar
-	-> DsM (CoreExpr,	-- desugared expression
-		IdSet)		-- set of local vars that occur free
-
---	A |- f :: a (t*ts) t'
---	A, xs |- arg :: t
---	-----------------------------
---	A | xs |- f -< arg :: [ts] t'
---
---		---> arr (\ ((xs)*ts) -> (arg*ts)) >>> f
-
-dsCmd ids local_vars env_ids stack res_ty
-	(HsArrApp arrow arg arrow_ty HsFirstOrderApp _)
-  = let
-	(a_arg_ty, _res_ty') = tcSplitAppTy arrow_ty
-        (_a_ty, arg_ty) = tcSplitAppTy a_arg_ty
-	env_ty = mkTupleType env_ids
-    in
-    dsLExpr arrow			`thenDs` \ core_arrow ->
-    dsLExpr arg				`thenDs` \ core_arg ->
-    mappM newSysLocalDs stack		`thenDs` \ stack_ids ->
-    matchEnvStack env_ids stack_ids
-	(foldl mkCorePairExpr core_arg (map Var stack_ids))
-					`thenDs` \ core_make_arg ->
-    returnDs (do_map_arrow ids
-		(envStackType env_ids stack)
-		arg_ty
-		res_ty
-		core_make_arg
-		core_arrow,
-	      exprFreeVars core_arg `intersectVarSet` local_vars)
-
---	A, xs |- f :: a (t*ts) t'
---	A, xs |- arg :: t
---	------------------------------
---	A | xs |- f -<< arg :: [ts] t'
---
---		---> arr (\ ((xs)*ts) -> (f,(arg*ts))) >>> app
-
-dsCmd ids local_vars env_ids stack res_ty
-	(HsArrApp arrow arg arrow_ty HsHigherOrderApp _)
-  = let
-	(a_arg_ty, _res_ty') = tcSplitAppTy arrow_ty
-        (_a_ty, arg_ty) = tcSplitAppTy a_arg_ty
-	env_ty = mkTupleType env_ids
-    in
-    dsLExpr arrow			`thenDs` \ core_arrow ->
-    dsLExpr arg				`thenDs` \ core_arg ->
-    mappM newSysLocalDs stack		`thenDs` \ stack_ids ->
-    matchEnvStack env_ids stack_ids
-	(mkCorePairExpr core_arrow
-		(foldl mkCorePairExpr core_arg (map Var stack_ids)))
-					`thenDs` \ core_make_pair ->
-    returnDs (do_map_arrow ids
-		(envStackType env_ids stack)
-		(mkCorePairTy arrow_ty arg_ty)
-		res_ty
-		core_make_pair
-		(do_app ids arg_ty res_ty),
-	      (exprFreeVars core_arrow `unionVarSet` exprFreeVars core_arg)
-		`intersectVarSet` local_vars)
-
---	A | ys |- c :: [t:ts] t'
---	A, xs  |- e :: t
---	------------------------
---	A | xs |- c e :: [ts] t'
---
---		---> arr (\ ((xs)*ts) -> let z = e in (((ys),z)*ts)) >>> c
-
-dsCmd ids local_vars env_ids stack res_ty (HsApp cmd arg)
-  = dsLExpr arg			`thenDs` \ core_arg ->
-    let
-	arg_ty = exprType core_arg
-	stack' = arg_ty:stack
-    in
-    dsfixCmd ids local_vars stack' res_ty cmd
-				`thenDs` \ (core_cmd, free_vars, env_ids') ->
-    mappM newSysLocalDs stack	`thenDs` \ stack_ids ->
-    newSysLocalDs arg_ty	`thenDs` \ arg_id ->
-    -- push the argument expression onto the stack
-    let
-	core_body = bindNonRec arg_id core_arg
-			(buildEnvStack env_ids' (arg_id:stack_ids))
-    in
-    -- match the environment and stack against the input
-    matchEnvStack env_ids stack_ids core_body
-				`thenDs` \ core_map ->
-    returnDs (do_map_arrow ids
-			(envStackType env_ids stack)
-			(envStackType env_ids' stack')
-			res_ty
-			core_map
-			core_cmd,
-	(exprFreeVars core_arg `intersectVarSet` local_vars)
-		`unionVarSet` free_vars)
-
---	A | ys |- c :: [ts] t'
---	-----------------------------------------------
---	A | xs |- \ p1 ... pk -> c :: [t1:...:tk:ts] t'
---
---		---> arr (\ ((((xs), p1), ... pk)*ts) -> ((ys)*ts)) >>> c
-
-dsCmd ids local_vars env_ids stack res_ty
-    (HsLam (MatchGroup [L _ (Match pats _ (GRHSs [L _ (GRHS [] body)] _ ))] _))
-  = let
-	pat_vars = mkVarSet (collectPatsBinders pats)
-	local_vars' = local_vars `unionVarSet` pat_vars
-	stack' = drop (length pats) stack
-    in
-    dsfixCmd ids local_vars' stack' res_ty body
-				`thenDs` \ (core_body, free_vars, env_ids') ->
-    mappM newSysLocalDs stack	`thenDs` \ stack_ids ->
-
-    -- the expression is built from the inside out, so the actions
-    -- are presented in reverse order
-
-    let
-        (actual_ids, stack_ids') = splitAt (length pats) stack_ids
-	-- build a new environment, plus what's left of the stack
-	core_expr = buildEnvStack env_ids' stack_ids'
-	in_ty = envStackType env_ids stack
-	in_ty' = envStackType env_ids' stack'
-    in
-    mkFailExpr LambdaExpr in_ty'	`thenDs` \ fail_expr ->
-    -- match the patterns against the top of the old stack
-    matchSimplys (map Var actual_ids) LambdaExpr pats core_expr fail_expr
-					`thenDs` \ match_code ->
-    -- match the old environment and stack against the input
-    matchEnvStack env_ids stack_ids match_code
-					`thenDs` \ select_code ->
-    returnDs (do_map_arrow ids in_ty in_ty' res_ty select_code core_body,
-	     free_vars `minusVarSet` pat_vars)
-
-dsCmd ids local_vars env_ids stack res_ty (HsPar cmd)
-  = dsLCmd ids local_vars env_ids stack res_ty cmd
-
---	A, xs |- e :: Bool
---	A | xs1 |- c1 :: [ts] t
---	A | xs2 |- c2 :: [ts] t
---	----------------------------------------
---	A | xs |- if e then c1 else c2 :: [ts] t
---
---		---> arr (\ ((xs)*ts) ->
---			if e then Left ((xs1)*ts) else Right ((xs2)*ts)) >>>
---		     c1 ||| c2
-
-dsCmd ids local_vars env_ids stack res_ty (HsIf cond then_cmd else_cmd)
-  = dsLExpr cond			`thenDs` \ core_cond ->
-    dsfixCmd ids local_vars stack res_ty then_cmd
-				`thenDs` \ (core_then, fvs_then, then_ids) ->
-    dsfixCmd ids local_vars stack res_ty else_cmd
-				`thenDs` \ (core_else, fvs_else, else_ids) ->
-    mappM newSysLocalDs stack		`thenDs` \ stack_ids ->
-    dsLookupTyCon eitherTyConName	`thenDs` \ either_con ->
-    dsLookupDataCon leftDataConName	`thenDs` \ left_con ->
-    dsLookupDataCon rightDataConName	`thenDs` \ right_con ->
-    let
-	left_expr ty1 ty2 e = mkConApp left_con [Type ty1, Type ty2, e]
-	right_expr ty1 ty2 e = mkConApp right_con [Type ty1, Type ty2, e]
-
-	in_ty = envStackType env_ids stack
-	then_ty = envStackType then_ids stack
-	else_ty = envStackType else_ids stack
-	sum_ty = mkTyConApp either_con [then_ty, else_ty]
-	fvs_cond = exprFreeVars core_cond `intersectVarSet` local_vars
-    in
-    matchEnvStack env_ids stack_ids
-	(mkIfThenElse core_cond
-	    (left_expr then_ty else_ty (buildEnvStack then_ids stack_ids))
-	    (right_expr then_ty else_ty (buildEnvStack else_ids stack_ids)))
-					`thenDs` \ core_if ->
-    returnDs(do_map_arrow ids in_ty sum_ty res_ty
-		core_if
-		(do_choice ids then_ty else_ty res_ty core_then core_else),
-	fvs_cond `unionVarSet` fvs_then `unionVarSet` fvs_else)
-\end{code}
-
-Case commands are treated in much the same way as if commands
-(see above) except that there are more alternatives.  For example
-
-	case e of { p1 -> c1; p2 -> c2; p3 -> c3 }
-
-is translated to
-
-	arr (\ ((xs)*ts) -> case e of
-		p1 -> (Left (Left (xs1)*ts))
-		p2 -> Left ((Right (xs2)*ts))
-		p3 -> Right ((xs3)*ts)) >>>
-	(c1 ||| c2) ||| c3
-
-The idea is to extract the commands from the case, build a balanced tree
-of choices, and replace the commands with expressions that build tagged
-tuples, obtaining a case expression that can be desugared normally.
-To build all this, we use quadruples decribing segments of the list of
-case bodies, containing the following fields:
-1. an IdSet containing the environment variables free in the case bodies
-2. a list of expressions of the form (Left|Right)* ((xs)*ts), to be put
-   into the case replacing the commands
-3. a sum type that is the common type of these expressions, and also the
-   input type of the arrow
-4. a CoreExpr for an arrow built by combining the translated command
-   bodies with |||.
-
-\begin{code}
-dsCmd ids local_vars env_ids stack res_ty (HsCase exp (MatchGroup matches match_ty))
-  = dsLExpr exp				`thenDs` \ core_exp ->
-    mappM newSysLocalDs stack		`thenDs` \ stack_ids ->
-
-    -- Extract and desugar the leaf commands in the case, building tuple
-    -- expressions that will (after tagging) replace these leaves
-
-    let
-        leaves = concatMap leavesMatch matches
-	make_branch (leaf, bound_vars)
-	  = dsfixCmd ids (local_vars `unionVarSet` bound_vars) stack res_ty leaf
-			   `thenDs` \ (core_leaf, fvs, leaf_ids) ->
-	    returnDs (fvs `minusVarSet` bound_vars,
-		      [noLoc $ mkHsEnvStackExpr leaf_ids stack_ids],
-		      envStackType leaf_ids stack,
-		      core_leaf)
-    in
-    mappM make_branch leaves		`thenDs` \ branches ->
-    dsLookupTyCon eitherTyConName	`thenDs` \ either_con ->
-    dsLookupDataCon leftDataConName	`thenDs` \ left_con ->
-    dsLookupDataCon rightDataConName	`thenDs` \ right_con ->
-    let
-	left_id = nlHsVar (dataConWrapId left_con)
-	right_id = nlHsVar (dataConWrapId right_con)
-	left_expr ty1 ty2 e = noLoc $ HsApp (noLoc $ TyApp left_id [ty1, ty2]) e
-	right_expr ty1 ty2 e = noLoc $ HsApp (noLoc $ TyApp right_id [ty1, ty2]) e
-
-	-- Prefix each tuple with a distinct series of Left's and Right's,
-	-- in a balanced way, keeping track of the types.
-
-        merge_branches (fvs1, builds1, in_ty1, core_exp1)
-		       (fvs2, builds2, in_ty2, core_exp2) 
-	  = (fvs1 `unionVarSet` fvs2,
-	     map (left_expr in_ty1 in_ty2) builds1 ++
-		map (right_expr in_ty1 in_ty2) builds2,
-	     mkTyConApp either_con [in_ty1, in_ty2],
-	     do_choice ids in_ty1 in_ty2 res_ty core_exp1 core_exp2)
-	(fvs_alts, leaves', sum_ty, core_choices)
-	  = foldb merge_branches branches
-
-	-- Replace the commands in the case with these tagged tuples,
-	-- yielding a HsExpr Id we can feed to dsExpr.
-
-	(_, matches') = mapAccumL (replaceLeavesMatch res_ty) leaves' matches
-	in_ty = envStackType env_ids stack
-	fvs_exp = exprFreeVars core_exp `intersectVarSet` local_vars
-
-	pat_ty    = funArgTy match_ty
-	match_ty' = mkFunTy pat_ty sum_ty
-	-- Note that we replace the HsCase result type by sum_ty,
-	-- which is the type of matches'
-    in
-    dsExpr (HsCase exp (MatchGroup matches' match_ty')) `thenDs` \ core_body ->
-    matchEnvStack env_ids stack_ids core_body
-					`thenDs` \ core_matches ->
-    returnDs(do_map_arrow ids in_ty sum_ty res_ty core_matches core_choices,
-	     fvs_exp `unionVarSet` fvs_alts)
-
---	A | ys |- c :: [ts] t
---	----------------------------------
---	A | xs |- let binds in c :: [ts] t
---
---		---> arr (\ ((xs)*ts) -> let binds in ((ys)*ts)) >>> c
-
-dsCmd ids local_vars env_ids stack res_ty (HsLet binds body)
-  = let
-	defined_vars = mkVarSet (map unLoc (collectLocalBinders binds))
-	local_vars' = local_vars `unionVarSet` defined_vars
-    in
-    dsfixCmd ids local_vars' stack res_ty body
-				`thenDs` \ (core_body, free_vars, env_ids') ->
-    mappM newSysLocalDs stack		`thenDs` \ stack_ids ->
-    -- build a new environment, plus the stack, using the let bindings
-    dsLocalBinds binds (buildEnvStack env_ids' stack_ids)
-					`thenDs` \ core_binds ->
-    -- match the old environment and stack against the input
-    matchEnvStack env_ids stack_ids core_binds
-					`thenDs` \ core_map ->
-    returnDs (do_map_arrow ids
-			(envStackType env_ids stack)
-			(envStackType env_ids' stack)
-			res_ty
-			core_map
-			core_body,
-	exprFreeVars core_binds `intersectVarSet` local_vars)
-
-dsCmd ids local_vars env_ids [] res_ty (HsDo _ctxt stmts body _)
-  = dsCmdDo ids local_vars env_ids res_ty stmts body
-
---	A |- e :: forall e. a1 (e*ts1) t1 -> ... an (e*tsn) tn -> a (e*ts) t
---	A | xs |- ci :: [tsi] ti
---	-----------------------------------
---	A | xs |- (|e c1 ... cn|) :: [ts] t	---> e [t_xs] c1 ... cn
-
-dsCmd _ids local_vars env_ids _stack _res_ty (HsArrForm op _ args)
-  = let
-	env_ty = mkTupleType env_ids
-    in
-    dsLExpr op				`thenDs` \ core_op ->
-    mapAndUnzipDs (dsTrimCmdArg local_vars env_ids) args
-					`thenDs` \ (core_args, fv_sets) ->
-    returnDs (mkApps (App core_op (Type env_ty)) core_args,
-	      unionVarSets fv_sets)
-
---	A | ys |- c :: [ts] t	(ys <= xs)
---	---------------------
---	A | xs |- c :: [ts] t	---> arr_ts (\ (xs) -> (ys)) >>> c
-
-dsTrimCmdArg
-	:: IdSet		-- set of local vars available to this command
-	-> [Id]			-- list of vars in the input to this command
-	-> LHsCmdTop Id	-- command argument to desugar
-	-> DsM (CoreExpr,	-- desugared expression
-		IdSet)		-- set of local vars that occur free
-dsTrimCmdArg local_vars env_ids (L _ (HsCmdTop cmd stack cmd_ty ids))
-  = mkCmdEnv ids			`thenDs` \ meth_ids ->
-    dsfixCmd meth_ids local_vars stack cmd_ty cmd
-				`thenDs` \ (core_cmd, free_vars, env_ids') ->
-    mappM newSysLocalDs stack		`thenDs` \ stack_ids ->
-    matchEnvStack env_ids stack_ids (buildEnvStack env_ids' stack_ids)
-					`thenDs` \ trim_code ->
-    let
-	in_ty = envStackType env_ids stack
-	in_ty' = envStackType env_ids' stack
-	arg_code = if env_ids' == env_ids then core_cmd else
-		do_map_arrow meth_ids in_ty in_ty' cmd_ty trim_code core_cmd
-    in
-    returnDs (bindCmdEnv meth_ids arg_code, free_vars)
-
--- Given A | xs |- c :: [ts] t, builds c with xs fed back.
--- Typically needs to be prefixed with arr (\p -> ((xs)*ts))
-
-dsfixCmd
-	:: DsCmdEnv		-- arrow combinators
-	-> IdSet		-- set of local vars available to this command
-	-> [Type]		-- type of the stack
-	-> Type			-- return type of the command
-	-> LHsCmd Id		-- command to desugar
-	-> DsM (CoreExpr,	-- desugared expression
-		IdSet,		-- set of local vars that occur free
-		[Id])		-- set as a list, fed back
-dsfixCmd ids local_vars stack cmd_ty cmd
-  = fixDs (\ ~(_,_,env_ids') ->
-	dsLCmd ids local_vars env_ids' stack cmd_ty cmd
-					`thenDs` \ (core_cmd, free_vars) ->
-	returnDs (core_cmd, free_vars, varSetElems free_vars))
-
-\end{code}
-
-Translation of command judgements of the form
-
-	A | xs |- do { ss } :: [] t
-
-\begin{code}
-
-dsCmdDo :: DsCmdEnv		-- arrow combinators
-	-> IdSet		-- set of local vars available to this statement
-	-> [Id]			-- list of vars in the input to this statement
-				-- This is typically fed back,
-				-- so don't pull on it too early
-	-> Type			-- return type of the statement
-	-> [LStmt Id]		-- statements to desugar
-	-> LHsExpr Id		-- body
-	-> DsM (CoreExpr,	-- desugared expression
-		IdSet)		-- set of local vars that occur free
-
---	A | xs |- c :: [] t
---	--------------------------
---	A | xs |- do { c } :: [] t
-
-dsCmdDo ids local_vars env_ids res_ty [] body
-  = dsLCmd ids local_vars env_ids [] res_ty body
-
-dsCmdDo ids local_vars env_ids res_ty (stmt:stmts) body
-  = let
-	bound_vars = mkVarSet (map unLoc (collectLStmtBinders stmt))
-	local_vars' = local_vars `unionVarSet` bound_vars
-    in
-    fixDs (\ ~(_,_,env_ids') ->
-	dsCmdDo ids local_vars' env_ids' res_ty stmts body
-					`thenDs` \ (core_stmts, fv_stmts) ->
-	returnDs (core_stmts, fv_stmts, varSetElems fv_stmts))
-				`thenDs` \ (core_stmts, fv_stmts, env_ids') ->
-    dsCmdLStmt ids local_vars env_ids env_ids' stmt
-				`thenDs` \ (core_stmt, fv_stmt) ->
-    returnDs (do_compose ids
-		(mkTupleType env_ids)
-		(mkTupleType env_ids')
-		res_ty
-		core_stmt
-		core_stmts,
-	      fv_stmt)
-
-\end{code}
-A statement maps one local environment to another, and is represented
-as an arrow from one tuple type to another.  A statement sequence is
-translated to a composition of such arrows.
-\begin{code}
-dsCmdLStmt ids local_vars env_ids out_ids cmd
-  = dsCmdStmt ids local_vars env_ids out_ids (unLoc cmd)
-
-dsCmdStmt
-	:: DsCmdEnv		-- arrow combinators
-	-> IdSet		-- set of local vars available to this statement
-	-> [Id]			-- list of vars in the input to this statement
-				-- This is typically fed back,
-				-- so don't pull on it too early
-	-> [Id]			-- list of vars in the output of this statement
-	-> Stmt Id	-- statement to desugar
-	-> DsM (CoreExpr,	-- desugared expression
-		IdSet)		-- set of local vars that occur free
-
---	A | xs1 |- c :: [] t
---	A | xs' |- do { ss } :: [] t'
---	------------------------------
---	A | xs |- do { c; ss } :: [] t'
---
---		---> arr (\ (xs) -> ((xs1),(xs'))) >>> first c >>>
---			arr snd >>> ss
-
-dsCmdStmt ids local_vars env_ids out_ids (ExprStmt cmd _ c_ty)
-  = dsfixCmd ids local_vars [] c_ty cmd
-				`thenDs` \ (core_cmd, fv_cmd, env_ids1) ->
-    matchEnvStack env_ids []
-	(mkCorePairExpr (mkTupleExpr env_ids1) (mkTupleExpr out_ids))
-					`thenDs` \ core_mux ->
-    let
-	in_ty = mkTupleType env_ids
-	in_ty1 = mkTupleType env_ids1
-	out_ty = mkTupleType out_ids
-	before_c_ty = mkCorePairTy in_ty1 out_ty
-	after_c_ty = mkCorePairTy c_ty out_ty
-    in
-    mkSndExpr c_ty out_ty		`thenDs` \ snd_fn ->
-    returnDs (do_map_arrow ids in_ty before_c_ty out_ty core_mux $
-		do_compose ids before_c_ty after_c_ty out_ty
-			(do_first ids in_ty1 c_ty out_ty core_cmd) $
-		do_arr ids after_c_ty out_ty snd_fn,
-	      extendVarSetList fv_cmd out_ids)
-  where
-
---	A | xs1 |- c :: [] t
---	A | xs' |- do { ss } :: [] t'		xs2 = xs' - defs(p)
---	-----------------------------------
---	A | xs |- do { p <- c; ss } :: [] t'
---
---		---> arr (\ (xs) -> ((xs1),(xs2))) >>> first c >>>
---			arr (\ (p, (xs2)) -> (xs')) >>> ss
---
--- It would be simpler and more consistent to do this using second,
--- but that's likely to be defined in terms of first.
-
-dsCmdStmt ids local_vars env_ids out_ids (BindStmt pat cmd _ _)
-  = dsfixCmd ids local_vars [] (hsPatType pat) cmd
-				`thenDs` \ (core_cmd, fv_cmd, env_ids1) ->
-    let
-	pat_ty = hsPatType pat
-	pat_vars = mkVarSet (collectPatBinders pat)
-	env_ids2 = varSetElems (mkVarSet out_ids `minusVarSet` pat_vars)
-	env_ty2 = mkTupleType env_ids2
-    in
-
-    -- multiplexing function
-    --		\ (xs) -> ((xs1),(xs2))
-
-    matchEnvStack env_ids []
-	(mkCorePairExpr (mkTupleExpr env_ids1) (mkTupleExpr env_ids2))
-					`thenDs` \ core_mux ->
-
-    -- projection function
-    --		\ (p, (xs2)) -> (zs)
-
-    newSysLocalDs env_ty2		`thenDs` \ env_id ->
-    newUniqueSupply			`thenDs` \ uniqs ->
-    let
-	after_c_ty = mkCorePairTy pat_ty env_ty2
-	out_ty = mkTupleType out_ids
-	body_expr = coreCaseTuple uniqs env_id env_ids2 (mkTupleExpr out_ids)
-    in
-    mkFailExpr (StmtCtxt DoExpr) out_ty	`thenDs` \ fail_expr ->
-    selectSimpleMatchVarL pat		`thenDs` \ pat_id ->
-    matchSimply (Var pat_id) (StmtCtxt DoExpr) pat body_expr fail_expr
-					`thenDs` \ match_code ->
-    newSysLocalDs after_c_ty		`thenDs` \ pair_id ->
-    let
-	proj_expr = Lam pair_id (coreCasePair pair_id pat_id env_id match_code)
-    in
-
-    -- put it all together
-    let
-	in_ty = mkTupleType env_ids
-	in_ty1 = mkTupleType env_ids1
-	in_ty2 = mkTupleType env_ids2
-	before_c_ty = mkCorePairTy in_ty1 in_ty2
-    in
-    returnDs (do_map_arrow ids in_ty before_c_ty out_ty core_mux $
-		do_compose ids before_c_ty after_c_ty out_ty
-			(do_first ids in_ty1 pat_ty in_ty2 core_cmd) $
-		do_arr ids after_c_ty out_ty proj_expr,
-	      fv_cmd `unionVarSet` (mkVarSet out_ids `minusVarSet` pat_vars))
-
---	A | xs' |- do { ss } :: [] t
---	--------------------------------------
---	A | xs |- do { let binds; ss } :: [] t
---
---		---> arr (\ (xs) -> let binds in (xs')) >>> ss
-
-dsCmdStmt ids local_vars env_ids out_ids (LetStmt binds)
-    -- build a new environment using the let bindings
-  = dsLocalBinds binds (mkTupleExpr out_ids)	`thenDs` \ core_binds ->
-    -- match the old environment against the input
-    matchEnvStack env_ids [] core_binds	`thenDs` \ core_map ->
-    returnDs (do_arr ids
-			(mkTupleType env_ids)
-			(mkTupleType out_ids)
-			core_map,
-	exprFreeVars core_binds `intersectVarSet` local_vars)
-
---	A | ys |- do { ss; returnA -< ((xs1), (ys2)) } :: [] ...
---	A | xs' |- do { ss' } :: [] t
---	------------------------------------
---	A | xs |- do { rec ss; ss' } :: [] t
---
---			xs1 = xs' /\ defs(ss)
---			xs2 = xs' - defs(ss)
---			ys1 = ys - defs(ss)
---			ys2 = ys /\ defs(ss)
---
---		---> arr (\(xs) -> ((ys1),(xs2))) >>>
---			first (loop (arr (\((ys1),~(ys2)) -> (ys)) >>> ss)) >>>
---			arr (\((xs1),(xs2)) -> (xs')) >>> ss'
-
-dsCmdStmt ids local_vars env_ids out_ids (RecStmt stmts later_ids rec_ids rhss binds)
-  = let		-- ToDo: ****** binds not desugared; ROSS PLEASE FIX ********
-	env2_id_set = mkVarSet out_ids `minusVarSet` mkVarSet later_ids
-	env2_ids = varSetElems env2_id_set
-	env2_ty = mkTupleType env2_ids
-    in
-
-    -- post_loop_fn = \((later_ids),(env2_ids)) -> (out_ids)
-
-    newUniqueSupply		`thenDs` \ uniqs ->
-    newSysLocalDs env2_ty	`thenDs` \ env2_id ->
-    let
-	later_ty = mkTupleType later_ids
-	post_pair_ty = mkCorePairTy later_ty env2_ty
-	post_loop_body = coreCaseTuple uniqs env2_id env2_ids (mkTupleExpr out_ids)
-    in
-    matchEnvStack later_ids [env2_id] post_loop_body
-				`thenDs` \ post_loop_fn ->
-
-    --- loop (...)
-
-    dsRecCmd ids local_vars stmts later_ids rec_ids rhss
-				`thenDs` \ (core_loop, env1_id_set, env1_ids) ->
-
-    -- pre_loop_fn = \(env_ids) -> ((env1_ids),(env2_ids))
-
-    let
-	env1_ty = mkTupleType env1_ids
-	pre_pair_ty = mkCorePairTy env1_ty env2_ty
-	pre_loop_body = mkCorePairExpr (mkTupleExpr env1_ids)
-					(mkTupleExpr env2_ids)
-
-    in
-    matchEnvStack env_ids [] pre_loop_body
-				`thenDs` \ pre_loop_fn ->
-
-    -- arr pre_loop_fn >>> first (loop (...)) >>> arr post_loop_fn
-
-    let
-	env_ty = mkTupleType env_ids
-	out_ty = mkTupleType out_ids
-	core_body = do_map_arrow ids env_ty pre_pair_ty out_ty
-		pre_loop_fn
-		(do_compose ids pre_pair_ty post_pair_ty out_ty
-			(do_first ids env1_ty later_ty env2_ty
-				core_loop)
-			(do_arr ids post_pair_ty out_ty
-				post_loop_fn))
-    in
-    returnDs (core_body, env1_id_set `unionVarSet` env2_id_set)
-
---	loop (arr (\ ((env1_ids), ~(rec_ids)) -> (env_ids)) >>>
---	      ss >>>
---	      arr (\ (out_ids) -> ((later_ids),(rhss))) >>>
-
-dsRecCmd ids local_vars stmts later_ids rec_ids rhss
-  = let
-	rec_id_set = mkVarSet rec_ids
-	out_ids = varSetElems (mkVarSet later_ids `unionVarSet` rec_id_set)
-	out_ty = mkTupleType out_ids
-	local_vars' = local_vars `unionVarSet` rec_id_set
-    in
-
-    -- mk_pair_fn = \ (out_ids) -> ((later_ids),(rhss))
-
-    mappM dsExpr rhss		`thenDs` \ core_rhss ->
-    let
-	later_tuple = mkTupleExpr later_ids
-	later_ty = mkTupleType later_ids
-	rec_tuple = mkBigCoreTup core_rhss
-	rec_ty = mkTupleType rec_ids
-	out_pair = mkCorePairExpr later_tuple rec_tuple
-	out_pair_ty = mkCorePairTy later_ty rec_ty
-    in
-	matchEnvStack out_ids [] out_pair
-				`thenDs` \ mk_pair_fn ->
-
-    -- ss
-
-    dsfixCmdStmts ids local_vars' out_ids stmts
-				`thenDs` \ (core_stmts, fv_stmts, env_ids) ->
-
-    -- squash_pair_fn = \ ((env1_ids), ~(rec_ids)) -> (env_ids)
-
-    newSysLocalDs rec_ty	`thenDs` \ rec_id ->
-    let
-	env1_id_set = fv_stmts `minusVarSet` rec_id_set
-	env1_ids = varSetElems env1_id_set
-	env1_ty = mkTupleType env1_ids
-	in_pair_ty = mkCorePairTy env1_ty rec_ty
-	core_body = mkBigCoreTup (map selectVar env_ids)
-	  where
-	    selectVar v
-		| v `elemVarSet` rec_id_set
-		  = mkTupleSelector rec_ids v rec_id (Var rec_id)
-		| otherwise = Var v
-    in
-    matchEnvStack env1_ids [rec_id] core_body
-				`thenDs` \ squash_pair_fn ->
-
-    -- loop (arr squash_pair_fn >>> ss >>> arr mk_pair_fn)
-
-    let
-	env_ty = mkTupleType env_ids
-	core_loop = do_loop ids env1_ty later_ty rec_ty
-		(do_map_arrow ids in_pair_ty env_ty out_pair_ty
-			squash_pair_fn
-			(do_compose ids env_ty out_ty out_pair_ty
-				core_stmts
-				(do_arr ids out_ty out_pair_ty mk_pair_fn)))
-    in
-    returnDs (core_loop, env1_id_set, env1_ids)
-
-\end{code}
-A sequence of statements (as in a rec) is desugared to an arrow between
-two environments
-\begin{code}
-
-dsfixCmdStmts
-	:: DsCmdEnv		-- arrow combinators
-	-> IdSet		-- set of local vars available to this statement
-	-> [Id]			-- output vars of these statements
-	-> [LStmt Id]	-- statements to desugar
-	-> DsM (CoreExpr,	-- desugared expression
-		IdSet,		-- set of local vars that occur free
-		[Id])		-- input vars
-
-dsfixCmdStmts ids local_vars out_ids stmts
-  = fixDs (\ ~(_,_,env_ids) ->
-	dsCmdStmts ids local_vars env_ids out_ids stmts
-					`thenDs` \ (core_stmts, fv_stmts) ->
-	returnDs (core_stmts, fv_stmts, varSetElems fv_stmts))
-
-dsCmdStmts
-	:: DsCmdEnv		-- arrow combinators
-	-> IdSet		-- set of local vars available to this statement
-	-> [Id]			-- list of vars in the input to these statements
-	-> [Id]			-- output vars of these statements
-	-> [LStmt Id]	-- statements to desugar
-	-> DsM (CoreExpr,	-- desugared expression
-		IdSet)		-- set of local vars that occur free
-
-dsCmdStmts ids local_vars env_ids out_ids [stmt]
-  = dsCmdLStmt ids local_vars env_ids out_ids stmt
-
-dsCmdStmts ids local_vars env_ids out_ids (stmt:stmts)
-  = let
-	bound_vars = mkVarSet (map unLoc (collectLStmtBinders stmt))
-	local_vars' = local_vars `unionVarSet` bound_vars
-    in
-    dsfixCmdStmts ids local_vars' out_ids stmts
-				`thenDs` \ (core_stmts, fv_stmts, env_ids') ->
-    dsCmdLStmt ids local_vars env_ids env_ids' stmt
-				`thenDs` \ (core_stmt, fv_stmt) ->
-    returnDs (do_compose ids
-		(mkTupleType env_ids)
-		(mkTupleType env_ids')
-		(mkTupleType out_ids)
-		core_stmt
-		core_stmts,
-	      fv_stmt)
-
-\end{code}
-
-Match a list of expressions against a list of patterns, left-to-right.
-
-\begin{code}
-matchSimplys :: [CoreExpr]              -- Scrutinees
-	     -> HsMatchContext Name	-- Match kind
-	     -> [LPat Id]         	-- Patterns they should match
-	     -> CoreExpr                -- Return this if they all match
-	     -> CoreExpr                -- Return this if they don't
-	     -> DsM CoreExpr
-matchSimplys [] _ctxt [] result_expr _fail_expr = returnDs result_expr
-matchSimplys (exp:exps) ctxt (pat:pats) result_expr fail_expr
-  = matchSimplys exps ctxt pats result_expr fail_expr
-					`thenDs` \ match_code ->
-    matchSimply exp ctxt pat match_code fail_expr
-\end{code}
-
-List of leaf expressions, with set of variables bound in each
-
-\begin{code}
-leavesMatch :: LMatch Id -> [(LHsExpr Id, IdSet)]
-leavesMatch (L _ (Match pats _ (GRHSs grhss binds)))
-  = let
-	defined_vars = mkVarSet (collectPatsBinders pats)
-			`unionVarSet`
-		       mkVarSet (map unLoc (collectLocalBinders binds))
-    in
-    [(expr, 
-      mkVarSet (map unLoc (collectLStmtsBinders stmts)) 
-	`unionVarSet` defined_vars) 
-    | L _ (GRHS stmts expr) <- grhss]
-\end{code}
-
-Replace the leaf commands in a match
-
-\begin{code}
-replaceLeavesMatch
-	:: Type			-- new result type
-	-> [LHsExpr Id]	-- replacement leaf expressions of that type
-	-> LMatch Id	-- the matches of a case command
-	-> ([LHsExpr Id],-- remaining leaf expressions
-	    LMatch Id)	-- updated match
-replaceLeavesMatch res_ty leaves (L loc (Match pat mt (GRHSs grhss binds)))
-  = let
-	(leaves', grhss') = mapAccumL replaceLeavesGRHS leaves grhss
-    in
-    (leaves', L loc (Match pat mt (GRHSs grhss' binds)))
-
-replaceLeavesGRHS
-	:: [LHsExpr Id]	-- replacement leaf expressions of that type
-	-> LGRHS Id	-- rhss of a case command
-	-> ([LHsExpr Id],-- remaining leaf expressions
-	    LGRHS Id)	-- updated GRHS
-replaceLeavesGRHS (leaf:leaves) (L loc (GRHS stmts rhs))
-  = (leaves, L loc (GRHS stmts leaf))
-\end{code}
-
-Balanced fold of a non-empty list.
-
-\begin{code}
-foldb :: (a -> a -> a) -> [a] -> a
-foldb _ [] = error "foldb of empty list"
-foldb _ [x] = x
-foldb f xs = foldb f (fold_pairs xs)
-  where
-    fold_pairs [] = []
-    fold_pairs [x] = [x]
-    fold_pairs (x1:x2:xs) = f x1 x2:fold_pairs xs
-\end{code}
diff --git a/ghc/compiler/deSugar/DsBinds.lhs b/ghc/compiler/deSugar/DsBinds.lhs
deleted file mode 100644
index 8f3006d0f3..0000000000
--- a/ghc/compiler/deSugar/DsBinds.lhs
+++ /dev/null
@@ -1,417 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[DsBinds]{Pattern-matching bindings (HsBinds and MonoBinds)}
-
-Handles @HsBinds@; those at the top level require different handling,
-in that the @Rec@/@NonRec@/etc structure is thrown away (whereas at
-lower levels it is preserved with @let@/@letrec@s).
-
-\begin{code}
-module DsBinds ( dsTopLHsBinds, dsLHsBinds, decomposeRuleLhs, 
-		 dsCoercion,
-		 AutoScc(..)
-  ) where
-
-#include "HsVersions.h"
-
-
-import {-# SOURCE #-}	DsExpr( dsLExpr, dsExpr )
-import {-# SOURCE #-}	Match( matchWrapper )
-
-import DsMonad
-import DsGRHSs		( dsGuarded )
-import DsUtils
-
-import HsSyn		-- lots of things
-import CoreSyn		-- lots of things
-import CoreUtils	( exprType, mkInlineMe, mkSCC )
-
-import StaticFlags	( opt_AutoSccsOnAllToplevs,
-			  opt_AutoSccsOnExportedToplevs )
-import OccurAnal	( occurAnalyseExpr )
-import CostCentre	( mkAutoCC, IsCafCC(..) )
-import Id		( Id, DictId, idType, idName, isExportedId, mkLocalId, setInlinePragma )
-import Rules		( addIdSpecialisations, mkLocalRule )
-import Var		( TyVar, Var, isGlobalId, setIdNotExported )
-import VarEnv
-import Type		( mkTyVarTy, substTyWith )
-import TysWiredIn	( voidTy )
-import Outputable
-import SrcLoc		( Located(..) )
-import Maybes		( isJust, catMaybes, orElse )
-import Bag		( bagToList )
-import BasicTypes	( Activation(..), InlineSpec(..), isAlwaysActive, defaultInlineSpec )
-import Monad		( foldM )
-import FastString	( mkFastString )
-import List		( (\\) )
-import Util		( mapSnd )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[dsMonoBinds]{Desugaring a @MonoBinds@}
-%*									*
-%************************************************************************
-
-\begin{code}
-dsTopLHsBinds :: AutoScc -> LHsBinds Id -> DsM [(Id,CoreExpr)]
-dsTopLHsBinds auto_scc binds = ds_lhs_binds auto_scc binds
-
-dsLHsBinds :: LHsBinds Id -> DsM [(Id,CoreExpr)]
-dsLHsBinds binds = ds_lhs_binds NoSccs binds
-
-
-------------------------
-ds_lhs_binds :: AutoScc -> LHsBinds Id -> DsM [(Id,CoreExpr)]
-	 -- scc annotation policy (see below)
-ds_lhs_binds auto_scc binds =  foldM (dsLHsBind auto_scc) [] (bagToList binds)
-
-dsLHsBind :: AutoScc
-	 -> [(Id,CoreExpr)]	-- Put this on the end (avoid quadratic append)
-	 -> LHsBind Id
-	 -> DsM [(Id,CoreExpr)] -- Result
-dsLHsBind auto_scc rest (L loc bind)
-  = putSrcSpanDs loc $ dsHsBind auto_scc rest bind
-
-dsHsBind :: AutoScc
-	 -> [(Id,CoreExpr)]	-- Put this on the end (avoid quadratic append)
-	 -> HsBind Id
-	 -> DsM [(Id,CoreExpr)] -- Result
-
-dsHsBind auto_scc rest (VarBind var expr)
-  = dsLExpr expr		`thenDs` \ core_expr ->
-
-	-- Dictionary bindings are always VarMonoBinds, so
-	-- we only need do this here
-    addDictScc var core_expr	`thenDs` \ core_expr' ->
-    returnDs ((var, core_expr') : rest)
-
-dsHsBind auto_scc rest (FunBind { fun_id = L _ fun, fun_matches = matches, fun_co_fn = co_fn })
-  = matchWrapper (FunRhs (idName fun)) matches		`thenDs` \ (args, body) ->
-    dsCoercion co_fn (return (mkLams args body))	`thenDs` \ rhs ->
-    addAutoScc auto_scc (fun, rhs)			`thenDs` \ pair ->
-    returnDs (pair : rest)
-
-dsHsBind auto_scc rest (PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty })
-  = dsGuarded grhss ty				`thenDs` \ body_expr ->
-    mkSelectorBinds pat body_expr		`thenDs` \ sel_binds ->
-    mappM (addAutoScc auto_scc) sel_binds	`thenDs` \ sel_binds ->
-    returnDs (sel_binds ++ rest)
-
-	-- Common special case: no type or dictionary abstraction
-	-- For the (rare) case when there are some mixed-up
-	-- dictionary bindings (for which a Rec is convenient)
-	-- we reply on the enclosing dsBind to wrap a Rec around.
-dsHsBind auto_scc rest (AbsBinds [] [] exports binds)
-  = ds_lhs_binds (addSccs auto_scc exports) binds 	`thenDs` \ core_prs ->
-    let
-	core_prs' = addLocalInlines exports core_prs
-	exports'  = [(global, Var local) | (_, global, local, _) <- exports]
-    in
-    returnDs (core_prs' ++ exports' ++ rest)
-
-	-- Another common case: one exported variable
-	-- Non-recursive bindings come through this way
-dsHsBind auto_scc rest
-     (AbsBinds all_tyvars dicts exports@[(tyvars, global, local, prags)] binds)
-  = ASSERT( all (`elem` tyvars) all_tyvars )
-    ds_lhs_binds (addSccs auto_scc exports) binds 	`thenDs` \ core_prs ->
-    let 
-	-- Always treat the binds as recursive, because the typechecker
-	-- makes rather mixed-up dictionary bindings
-	core_bind = Rec core_prs
-    in
-    mappM (dsSpec all_tyvars dicts tyvars global local core_bind) 
-	  prags				`thenDs` \ mb_specs ->
-    let
-	(spec_binds, rules) = unzip (catMaybes mb_specs)
-	global' = addIdSpecialisations global rules
-	rhs'    = mkLams tyvars $ mkLams dicts $ Let core_bind (Var local)
-	inl 	= case [inl | InlinePrag inl <- prags] of
-	    	 	[]      -> defaultInlineSpec 
-	    	 	(inl:_) -> inl
-    in
-    returnDs (addInlineInfo inl global' rhs' : spec_binds ++ rest)
-
-dsHsBind auto_scc rest (AbsBinds all_tyvars dicts exports binds)
-  = ds_lhs_binds (addSccs auto_scc exports) binds 	`thenDs` \ core_prs ->
-     let 
-	-- Rec because of mixed-up dictionary bindings
-	core_bind = Rec (addLocalInlines exports core_prs)
-
-	tup_expr      = mkTupleExpr locals
-	tup_ty	      = exprType tup_expr
-	poly_tup_expr = mkLams all_tyvars $ mkLams dicts $
-		        Let core_bind tup_expr
-	locals        = [local | (_, _, local, _) <- exports]
-	local_tys     = map idType locals
-    in
-    newSysLocalDs (exprType poly_tup_expr)		`thenDs` \ poly_tup_id ->
-    let
-	dict_args = map Var dicts
-
-	mk_bind ((tyvars, global, local, prags), n)	-- locals !! n == local
-	  = 	-- Need to make fresh locals to bind in the selector, because
-		-- some of the tyvars will be bound to voidTy
-	    newSysLocalsDs (map substitute local_tys) 	`thenDs` \ locals' ->
-	    newSysLocalDs  (substitute tup_ty)		`thenDs` \ tup_id ->
-	    mapM (dsSpec all_tyvars dicts tyvars global local core_bind) 
-		 prags				`thenDs` \ mb_specs ->
-	    let
-		(spec_binds, rules) = unzip (catMaybes mb_specs)
-		global' = addIdSpecialisations global rules
-	        rhs = mkLams tyvars $ mkLams dicts $
-		      mkTupleSelector locals' (locals' !! n) tup_id $
-		      mkApps (mkTyApps (Var poly_tup_id) ty_args) dict_args
-	    in
-	    returnDs ((global', rhs) : spec_binds)
-	  where
-	    mk_ty_arg all_tyvar | all_tyvar `elem` tyvars = mkTyVarTy all_tyvar
-				| otherwise		  = voidTy
-	    ty_args    = map mk_ty_arg all_tyvars
-	    substitute = substTyWith all_tyvars ty_args
-    in
-    mappM mk_bind (exports `zip` [0..])		`thenDs` \ export_binds_s ->
-     -- don't scc (auto-)annotate the tuple itself.
-
-    returnDs ((poly_tup_id, poly_tup_expr) : (concat export_binds_s ++ rest))
-
-dsSpec :: [TyVar] -> [DictId] -> [TyVar]
-       -> Id -> Id		-- Global, local
-       -> CoreBind -> Prag
-       -> DsM (Maybe ((Id,CoreExpr), 	-- Binding for specialised Id
-		      CoreRule))	-- Rule for the Global Id
-
--- Example:
---	f :: (Eq a, Ix b) => a -> b -> b
---	{-# SPECIALISE f :: Ix b => Int -> b -> b #-}
---
---	AbsBinds [ab] [d1,d2] [([ab], f, f_mono, prags)] binds
--- 
--- 	SpecPrag (/\b.\(d:Ix b). f Int b dInt d) 
---		 (forall b. Ix b => Int -> b -> b)
---
--- Rule: 	forall b,(d:Ix b). f Int b dInt d = f_spec b d
---
--- Spec bind:	f_spec = Let f = /\ab \(d1:Eq a)(d2:Ix b). let binds in f_mono 
---			 /\b.\(d:Ix b). in f Int b dInt d
---		The idea is that f occurs just once, so it'll be 
---		inlined and specialised
-
-dsSpec all_tvs dicts tvs poly_id mono_id mono_bind (InlinePrag {})
-  = return Nothing
-
-dsSpec all_tvs dicts tvs poly_id mono_id mono_bind
-       (SpecPrag spec_expr spec_ty const_dicts inl)
-  = do	{ let poly_name = idName poly_id
-	; spec_name <- newLocalName poly_name
-	; ds_spec_expr  <- dsExpr spec_expr
-	; let (bndrs, body) = collectBinders ds_spec_expr
-	      mb_lhs  	    = decomposeRuleLhs (bndrs ++ const_dicts) body
-
-	; case mb_lhs of
-	    Nothing -> do { dsWarn msg; return Nothing }
-
-	    Just (bndrs', var, args) -> return (Just (addInlineInfo inl spec_id spec_rhs, rule))
-		where
-		  local_poly  = setIdNotExported poly_id
-			-- Very important to make the 'f' non-exported,
-			-- else it won't be inlined!
-		  spec_id     = mkLocalId spec_name spec_ty
-		  spec_rhs    = Let (NonRec local_poly poly_f_body) ds_spec_expr
-		  poly_f_body = mkLams (tvs ++ dicts) $
-			   	fix_up (Let mono_bind (Var mono_id))
-
-			-- Quantify over constant dicts on the LHS, since
-			-- their value depends only on their type
-			-- The ones we are interested in may even be imported
-			-- e.g. GHC.Base.dEqInt
-
-		  rule =  mkLocalRule (mkFastString ("SPEC " ++ showSDoc (ppr poly_name)))
-				AlwaysActive poly_name
-			        bndrs'	-- Includes constant dicts
-				args
-				(mkVarApps (Var spec_id) bndrs)
-	}
-  where
-	-- Bind to voidTy any of all_ptvs that aren't 
-	-- relevant for this particular function 
-    fix_up body | null void_tvs = body
-		| otherwise	= mkTyApps (mkLams void_tvs body) 
-					   (map (const voidTy) void_tvs)
-    void_tvs = all_tvs \\ tvs
-
-    msg = hang (ptext SLIT("Specialisation too complicated to desugar; ignored"))
-	     2 (ppr spec_expr)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Adding inline pragmas}
-%*									*
-%************************************************************************
-
-\begin{code}
-decomposeRuleLhs :: [Var] -> CoreExpr -> Maybe ([Var], Id, [CoreExpr])
--- Returns Nothing if the LHS isn't of the expected shape
--- The argument 'all_bndrs' includes the "constant dicts" of the LHS,
--- and they may be GlobalIds, which we can't forall-ify. 
--- So we substitute them out instead
-decomposeRuleLhs all_bndrs lhs 
-  = go init_env (occurAnalyseExpr lhs)	-- Occurrence analysis sorts out the dict
-					-- bindings so we know if they are recursive
-  where
-
-	-- all_bndrs may include top-level imported dicts, 
-	-- imported things with a for-all.  
-	-- So we localise them and subtitute them out
-    bndr_prs =	[ (id, Var (localise id)) | id <- all_bndrs, isGlobalId id ]
-    localise d = mkLocalId (idName d) (idType d)
-
-    init_env = mkVarEnv bndr_prs
-    all_bndrs' = map subst_bndr all_bndrs
-    subst_bndr bndr = case lookupVarEnv init_env bndr of
-			Just (Var bndr') -> bndr'
-			Just other	 -> panic "decomposeRuleLhs"
-			Nothing		 -> bndr
-
-	-- Substitute dicts in the LHS args, so that there 
-	-- aren't any lets getting in the way
-	-- Note that we substitute the function too; we might have this as
-	-- a LHS:	let f71 = M.f Int in f71
-    go env (Let (NonRec dict rhs) body) 
-	= go (extendVarEnv env dict (simpleSubst env rhs)) body
-    go env body 
-	= case collectArgs (simpleSubst env body) of
-	    (Var fn, args) -> Just (all_bndrs', fn, args)
-	    other 	   -> Nothing
-
-simpleSubst :: IdEnv CoreExpr -> CoreExpr -> CoreExpr
--- Similar to CoreSubst.substExpr, except that 
--- (a) takes no account of capture; dictionary bindings use new names
--- (b) can have a GlobalId (imported) in its domain
--- (c) Ids only; no types are substituted
-
-simpleSubst subst expr
-  = go expr
-  where
-    go (Var v)	       = lookupVarEnv subst v `orElse` Var v
-    go (Type ty)       = Type ty
-    go (Lit lit)       = Lit lit
-    go (App fun arg)   = App (go fun) (go arg)
-    go (Note note e)   = Note note (go e)
-    go (Lam bndr body) = Lam bndr (go body)
-    go (Let (NonRec bndr rhs) body) = Let (NonRec bndr (go rhs)) (go body)
-    go (Let (Rec pairs) body)       = Let (Rec (mapSnd go pairs)) (go body)
-    go (Case scrut bndr ty alts)    = Case (go scrut) bndr ty 
-					   [(c,bs,go r) | (c,bs,r) <- alts]
-
-addLocalInlines exports core_prs
-  = map add_inline core_prs
-  where
-    add_inline (bndr,rhs) | Just inl <- lookupVarEnv inline_env bndr
-			  = addInlineInfo inl bndr rhs
-			  | otherwise 
-			  = (bndr,rhs)
-    inline_env = mkVarEnv [(mono_id, prag) 
-			  | (_, _, mono_id, prags) <- exports,
-			    InlinePrag prag <- prags]
-					   
-addInlineInfo :: InlineSpec -> Id -> CoreExpr -> (Id,CoreExpr)
-addInlineInfo (Inline phase is_inline) bndr rhs
-  = (attach_phase bndr phase, wrap_inline is_inline rhs)
-  where
-    attach_phase bndr phase 
-	| isAlwaysActive phase = bndr	-- Default phase
-	| otherwise  	       = bndr `setInlinePragma` phase
-
-    wrap_inline True  body = mkInlineMe body
-    wrap_inline False body = body
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[addAutoScc]{Adding automatic sccs}
-%*									*
-%************************************************************************
-
-\begin{code}
-data AutoScc
- 	= TopLevel
-	| TopLevelAddSccs (Id -> Maybe Id)
-	| NoSccs
-
-addSccs :: AutoScc -> [(a,Id,Id,[Prag])] -> AutoScc
-addSccs auto_scc@(TopLevelAddSccs _) exports = auto_scc
-addSccs NoSccs   exports = NoSccs
-addSccs TopLevel exports 
-  = TopLevelAddSccs (\id -> case [ exp | (_,exp,loc,_) <- exports, loc == id ] of
-				(exp:_)  | opt_AutoSccsOnAllToplevs || 
-					    (isExportedId exp && 
-					     opt_AutoSccsOnExportedToplevs)
-					-> Just exp
-				_ -> Nothing)
-
-addAutoScc :: AutoScc		-- if needs be, decorate toplevs?
-	   -> (Id, CoreExpr)
-	   -> DsM (Id, CoreExpr)
-
-addAutoScc (TopLevelAddSccs auto_scc_fn) pair@(bndr, core_expr) 
- | do_auto_scc
-     = getModuleDs `thenDs` \ mod ->
-       returnDs (bndr, mkSCC (mkAutoCC top_bndr mod NotCafCC) core_expr)
- where do_auto_scc = isJust maybe_auto_scc
-       maybe_auto_scc = auto_scc_fn bndr
-       (Just top_bndr) = maybe_auto_scc
-
-addAutoScc _ pair
-     = returnDs pair
-\end{code}
-
-If profiling and dealing with a dict binding,
-wrap the dict in @_scc_ DICT <dict>@:
-
-\begin{code}
-addDictScc var rhs = returnDs rhs
-
-{- DISABLED for now (need to somehow make up a name for the scc) -- SDM
-  | not ( opt_SccProfilingOn && opt_AutoSccsOnDicts)
-    || not (isDictId var)
-  = returnDs rhs				-- That's easy: do nothing
-
-  | otherwise
-  = getModuleAndGroupDs 	`thenDs` \ (mod, grp) ->
-	-- ToDo: do -dicts-all flag (mark dict things with individual CCs)
-    returnDs (Note (SCC (mkAllDictsCC mod grp False)) rhs)
--}
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Desugaring coercions
-%*									*
-%************************************************************************
-
-
-\begin{code}
-dsCoercion :: ExprCoFn -> DsM CoreExpr -> DsM CoreExpr
-dsCoercion CoHole 	     thing_inside = thing_inside
-dsCoercion (CoCompose c1 c2) thing_inside = dsCoercion c1 (dsCoercion c2 thing_inside)
-dsCoercion (CoLams ids c)    thing_inside = do { expr <- dsCoercion c thing_inside
-					       ; return (mkLams ids expr) }
-dsCoercion (CoTyLams tvs c)  thing_inside = do { expr <- dsCoercion c thing_inside
-					       ; return (mkLams tvs expr) }
-dsCoercion (CoApps c ids)    thing_inside = do { expr <- dsCoercion c thing_inside
-					       ; return (mkVarApps expr ids) }
-dsCoercion (CoTyApps c tys)  thing_inside = do { expr <- dsCoercion c thing_inside
-					       ; return (mkTyApps expr tys) }
-dsCoercion (CoLet bs c)      thing_inside = do { prs <- dsLHsBinds bs
-					       ; expr <- dsCoercion c thing_inside
-					       ; return (Let (Rec prs) expr) }
-\end{code}
-
-
diff --git a/ghc/compiler/deSugar/DsCCall.lhs b/ghc/compiler/deSugar/DsCCall.lhs
deleted file mode 100644
index 3554197fb8..0000000000
--- a/ghc/compiler/deSugar/DsCCall.lhs
+++ /dev/null
@@ -1,456 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1994-1998
-%
-\section[DsCCall]{Desugaring C calls}
-
-\begin{code}
-module DsCCall 
-	( dsCCall
-	, mkFCall
-	, unboxArg
-	, boxResult
-	, resultWrapper
-	) where
-
-#include "HsVersions.h"
-
-
-import CoreSyn
-
-import DsMonad
-
-import CoreUtils	( exprType, coreAltType, mkCoerce2 )
-import Id		( Id, mkWildId )
-import MkId		( mkFCallId, realWorldPrimId, mkPrimOpId )
-import Maybes		( maybeToBool )
-import ForeignCall	( ForeignCall(..), CCallSpec(..), CCallTarget(..), Safety, 
-			  CCallConv(..), CLabelString )
-import DataCon		( splitProductType_maybe, dataConSourceArity, dataConWrapId )
-
-import TcType		( tcSplitTyConApp_maybe )
-import Type		( Type, isUnLiftedType, mkFunTys, mkFunTy,
-			  tyVarsOfType, mkForAllTys, mkTyConApp, 
-			  isPrimitiveType, splitTyConApp_maybe, 
-			  splitRecNewType_maybe, splitForAllTy_maybe,
-			  isUnboxedTupleType
-			)
-
-import PrimOp		( PrimOp(..) )
-import TysPrim		( realWorldStatePrimTy, intPrimTy,
-			  byteArrayPrimTyCon, mutableByteArrayPrimTyCon,
-			  addrPrimTy
-			)
-import TyCon		( TyCon, tyConDataCons, tyConName )
-import TysWiredIn	( unitDataConId,
-			  unboxedSingletonDataCon, unboxedPairDataCon,
-			  unboxedSingletonTyCon, unboxedPairTyCon,
-			  trueDataCon, falseDataCon, 
-			  trueDataConId, falseDataConId,
-			  listTyCon, charTyCon, boolTy, 
-			  tupleTyCon, tupleCon
-			)
-import BasicTypes       ( Boxity(..) )
-import Literal		( mkMachInt )
-import PrelNames	( Unique, hasKey, ioTyConKey, boolTyConKey, unitTyConKey,
-			  int8TyConKey, int16TyConKey, int32TyConKey,
-			  word8TyConKey, word16TyConKey, word32TyConKey
-			  -- dotnet interop
-			  , marshalStringName, unmarshalStringName
-			  , marshalObjectName, unmarshalObjectName
-			  , objectTyConName
-			)
-import VarSet		( varSetElems )
-import Constants	( wORD_SIZE)
-import Outputable
-
-#ifdef DEBUG
-import TypeRep
-#endif
-
-\end{code}
-
-Desugaring of @ccall@s consists of adding some state manipulation,
-unboxing any boxed primitive arguments and boxing the result if
-desired.
-
-The state stuff just consists of adding in
-@PrimIO (\ s -> case s of { S# s# -> ... })@ in an appropriate place.
-
-The unboxing is straightforward, as all information needed to unbox is
-available from the type.  For each boxed-primitive argument, we
-transform:
-\begin{verbatim}
-   _ccall_ foo [ r, t1, ... tm ] e1 ... em
-   |
-   |
-   V
-   case e1 of { T1# x1# ->
-   ...
-   case em of { Tm# xm# -> xm#
-   ccall# foo [ r, t1#, ... tm# ] x1# ... xm#
-   } ... }
-\end{verbatim}
-
-The reboxing of a @_ccall_@ result is a bit tricker: the types don't
-contain information about the state-pairing functions so we have to
-keep a list of \tr{(type, s-p-function)} pairs.  We transform as
-follows:
-\begin{verbatim}
-   ccall# foo [ r, t1#, ... tm# ] e1# ... em#
-   |
-   |
-   V
-   \ s# -> case (ccall# foo [ r, t1#, ... tm# ] s# e1# ... em#) of
-	  (StateAnd<r># result# state#) -> (R# result#, realWorld#)
-\end{verbatim}
-
-\begin{code}
-dsCCall :: CLabelString	-- C routine to invoke
-	-> [CoreExpr]	-- Arguments (desugared)
-	-> Safety	-- Safety of the call
-	-> Type		-- Type of the result: IO t
-	-> DsM CoreExpr
-
-dsCCall lbl args may_gc result_ty
-  = mapAndUnzipDs unboxArg args	       `thenDs` \ (unboxed_args, arg_wrappers) ->
-    boxResult id Nothing result_ty  `thenDs` \ (ccall_result_ty, res_wrapper) ->
-    newUnique			       `thenDs` \ uniq ->
-    let
-	target = StaticTarget lbl
-	the_fcall    = CCall (CCallSpec target CCallConv may_gc)
- 	the_prim_app = mkFCall uniq the_fcall unboxed_args ccall_result_ty
-    in
-    returnDs (foldr ($) (res_wrapper the_prim_app) arg_wrappers)
-
-mkFCall :: Unique -> ForeignCall 
-	-> [CoreExpr] 	-- Args
-	-> Type 	-- Result type
-	-> CoreExpr
--- Construct the ccall.  The only tricky bit is that the ccall Id should have
--- no free vars, so if any of the arg tys do we must give it a polymorphic type.
--- 	[I forget *why* it should have no free vars!]
--- For example:
---	mkCCall ... [s::StablePtr (a->b), x::Addr, c::Char]
---
--- Here we build a ccall thus
---	(ccallid::(forall a b.  StablePtr (a -> b) -> Addr -> Char -> IO Addr))
---			a b s x c
-mkFCall uniq the_fcall val_args res_ty
-  = mkApps (mkVarApps (Var the_fcall_id) tyvars) val_args
-  where
-    arg_tys = map exprType val_args
-    body_ty = (mkFunTys arg_tys res_ty)
-    tyvars  = varSetElems (tyVarsOfType body_ty)
-    ty 	    = mkForAllTys tyvars body_ty
-    the_fcall_id = mkFCallId uniq the_fcall ty
-\end{code}
-
-\begin{code}
-unboxArg :: CoreExpr			-- The supplied argument
-	 -> DsM (CoreExpr,		-- To pass as the actual argument
-		 CoreExpr -> CoreExpr	-- Wrapper to unbox the arg
-		)
--- Example: if the arg is e::Int, unboxArg will return
---	(x#::Int#, \W. case x of I# x# -> W)
--- where W is a CoreExpr that probably mentions x#
-
-unboxArg arg
-  -- Primtive types: nothing to unbox
-  | isPrimitiveType arg_ty
-  = returnDs (arg, \body -> body)
-
-  -- Recursive newtypes
-  | Just rep_ty <- splitRecNewType_maybe arg_ty
-  = unboxArg (mkCoerce2 rep_ty arg_ty arg)
-      
-  -- Booleans
-  | Just (tc,_) <- splitTyConApp_maybe arg_ty, 
-    tc `hasKey` boolTyConKey
-  = newSysLocalDs intPrimTy		`thenDs` \ prim_arg ->
-    returnDs (Var prim_arg,
-	      \ body -> Case (Case arg (mkWildId arg_ty) intPrimTy
-  		                       [(DataAlt falseDataCon,[],mkIntLit 0),
-	                                (DataAlt trueDataCon, [],mkIntLit 1)])
-					-- In increasing tag order!
-                             prim_arg
-                             (exprType body) 
-			     [(DEFAULT,[],body)])
-
-  -- Data types with a single constructor, which has a single, primitive-typed arg
-  -- This deals with Int, Float etc; also Ptr, ForeignPtr
-  | is_product_type && data_con_arity == 1 
-  = ASSERT2(isUnLiftedType data_con_arg_ty1, pprType arg_ty)
-			-- Typechecker ensures this
-    newSysLocalDs arg_ty		`thenDs` \ case_bndr ->
-    newSysLocalDs data_con_arg_ty1	`thenDs` \ prim_arg ->
-    returnDs (Var prim_arg,
-	      \ body -> Case arg case_bndr (exprType body) [(DataAlt data_con,[prim_arg],body)]
-    )
-
-  -- Byte-arrays, both mutable and otherwise; hack warning
-  -- We're looking for values of type ByteArray, MutableByteArray
-  --	data ByteArray          ix = ByteArray        ix ix ByteArray#
-  --	data MutableByteArray s ix = MutableByteArray ix ix (MutableByteArray# s)
-  | is_product_type &&
-    data_con_arity == 3 &&
-    maybeToBool maybe_arg3_tycon &&
-    (arg3_tycon ==  byteArrayPrimTyCon ||
-     arg3_tycon ==  mutableByteArrayPrimTyCon)
-  = newSysLocalDs arg_ty		`thenDs` \ case_bndr ->
-    newSysLocalsDs data_con_arg_tys	`thenDs` \ vars@[l_var, r_var, arr_cts_var] ->
-    returnDs (Var arr_cts_var,
-	      \ body -> Case arg case_bndr (exprType body) [(DataAlt data_con,vars,body)]
-
-    )
-
-  | Just (tc, [arg_ty]) <- splitTyConApp_maybe arg_ty,
-    tc == listTyCon,
-    Just (cc,[]) <- splitTyConApp_maybe arg_ty,
-    cc == charTyCon
-    -- String; dotnet only
-  = dsLookupGlobalId marshalStringName `thenDs` \ unpack_id ->
-    newSysLocalDs addrPrimTy	       `thenDs` \ prim_string ->
-    returnDs (Var prim_string,
-    	      \ body ->
-	        let
-		 io_ty = exprType body
-		 (Just (_,[io_arg])) = tcSplitTyConApp_maybe io_ty
-		in
-	      	mkApps (Var unpack_id)
-		       [ Type io_arg
-		       , arg
-		       , Lam prim_string body
-		       ])
-  | Just (tc, [arg_ty]) <- splitTyConApp_maybe arg_ty,
-    tyConName tc == objectTyConName
-    -- Object; dotnet only
-  = dsLookupGlobalId marshalObjectName `thenDs` \ unpack_id ->
-    newSysLocalDs addrPrimTy	       `thenDs` \ prim_obj  ->
-    returnDs (Var prim_obj,
-    	      \ body ->
-	        let
-		 io_ty = exprType body
-		 (Just (_,[io_arg])) = tcSplitTyConApp_maybe io_ty
-		in
-	      	mkApps (Var unpack_id)
-		       [ Type io_arg
-		       , arg
-		       , Lam prim_obj body
-		       ])
-
-  | otherwise
-  = getSrcSpanDs `thenDs` \ l ->
-    pprPanic "unboxArg: " (ppr l <+> ppr arg_ty)
-  where
-    arg_ty					= exprType arg
-    maybe_product_type 			   	= splitProductType_maybe arg_ty
-    is_product_type			   	= maybeToBool maybe_product_type
-    Just (_, _, data_con, data_con_arg_tys)	= maybe_product_type
-    data_con_arity				= dataConSourceArity data_con
-    (data_con_arg_ty1 : _)			= data_con_arg_tys
-
-    (_ : _ : data_con_arg_ty3 : _) = data_con_arg_tys
-    maybe_arg3_tycon    	   = splitTyConApp_maybe data_con_arg_ty3
-    Just (arg3_tycon,_)		   = maybe_arg3_tycon
-\end{code}
-
-
-\begin{code}
-boxResult :: ((Maybe Type, CoreExpr -> CoreExpr) -> (Maybe Type, CoreExpr -> CoreExpr))
-	  -> Maybe Id
-	  -> Type
-	  -> DsM (Type, CoreExpr -> CoreExpr)
-
--- Takes the result of the user-level ccall: 
---	either (IO t), 
---	or maybe just t for an side-effect-free call
--- Returns a wrapper for the primitive ccall itself, along with the
--- type of the result of the primitive ccall.  This result type
--- will be of the form  
---	State# RealWorld -> (# State# RealWorld, t' #)
--- where t' is the unwrapped form of t.  If t is simply (), then
--- the result type will be 
---	State# RealWorld -> (# State# RealWorld #)
-
-boxResult augment mbTopCon result_ty
-  = case tcSplitTyConApp_maybe result_ty of
-	-- This split absolutely has to be a tcSplit, because we must
-	-- see the IO type; and it's a newtype which is transparent to splitTyConApp.
-
-	-- The result is IO t, so wrap the result in an IO constructor
-	Just (io_tycon, [io_res_ty]) | io_tycon `hasKey` ioTyConKey
-		-> resultWrapper io_res_ty             `thenDs` \ res ->
-		   let aug_res          = augment res
-		       extra_result_tys =
-		         case aug_res of
-			   (Just ty,_) 
-			     | isUnboxedTupleType ty ->
-			        let (Just (_, ls)) = splitTyConApp_maybe ty in tail ls
-			   _ -> []
-	           in
-		   mk_alt (return_result extra_result_tys) aug_res 
-		   					`thenDs` \ (ccall_res_ty, the_alt) ->
-		   newSysLocalDs  realWorldStatePrimTy  `thenDs` \ state_id ->
-		   let
-			io_data_con = head (tyConDataCons io_tycon)
-			toIOCon = 
-			  case mbTopCon of
-			    Nothing -> dataConWrapId io_data_con
-			    Just x  -> x
-			wrap = \ the_call -> 
-				 mkApps (Var toIOCon)
-					   [ Type io_res_ty, 
-					     Lam state_id $
-					      Case (App the_call (Var state_id))
-						   (mkWildId ccall_res_ty)
-                                                   (coreAltType the_alt) 
-						   [the_alt]
-					   ]
-		   in
-		   returnDs (realWorldStatePrimTy `mkFunTy` ccall_res_ty, wrap)
-		where
-		   return_result ts state anss 
-		     = mkConApp (tupleCon Unboxed (2 + length ts))
-			        (Type realWorldStatePrimTy : Type io_res_ty : map Type ts ++
-			         state : anss) 
-	-- It isn't, so do unsafePerformIO
-	-- It's not conveniently available, so we inline it
-	other -> resultWrapper result_ty            `thenDs` \ res ->
-	         mk_alt return_result (augment res) `thenDs` \ (ccall_res_ty, the_alt) ->
-		 let
-		    wrap = \ the_call -> Case (App the_call (Var realWorldPrimId)) 
-					      (mkWildId ccall_res_ty)
-                                              (coreAltType the_alt)
-					      [the_alt]
-		 in
-		 returnDs (realWorldStatePrimTy `mkFunTy` ccall_res_ty, wrap)
-	      where
-		 return_result state [ans] = ans
-		 return_result _ _ = panic "return_result: expected single result"
-  where
-    mk_alt return_result (Nothing, wrap_result)
-	= 	-- The ccall returns ()
-	  newSysLocalDs realWorldStatePrimTy	`thenDs` \ state_id ->
-	  let
-		the_rhs = return_result (Var state_id) 
-					[wrap_result (panic "boxResult")]
-
-		ccall_res_ty = mkTyConApp unboxedSingletonTyCon [realWorldStatePrimTy]
-		the_alt      = (DataAlt unboxedSingletonDataCon, [state_id], the_rhs)
-	  in
-	  returnDs (ccall_res_ty, the_alt)
-
-    mk_alt return_result (Just prim_res_ty, wrap_result)
-    		-- The ccall returns a non-() value
-        | isUnboxedTupleType prim_res_ty
-        = let
-		Just (_, ls) = splitTyConApp_maybe prim_res_ty
-		arity = 1 + length ls
-	  in
-	  mappM newSysLocalDs ls 		`thenDs` \ args_ids@(result_id:as) ->
-	  newSysLocalDs realWorldStatePrimTy	`thenDs` \ state_id ->
-	  let
-		the_rhs = return_result (Var state_id) 
-					(wrap_result (Var result_id) : map Var as)
-		ccall_res_ty = mkTyConApp (tupleTyCon Unboxed arity)
-					  (realWorldStatePrimTy : ls)
-		the_alt	     = ( DataAlt (tupleCon Unboxed arity)
-			       , (state_id : args_ids)
-			       , the_rhs
-			       )
-	  in
-	  returnDs (ccall_res_ty, the_alt)
-	| otherwise
-	= newSysLocalDs prim_res_ty 		`thenDs` \ result_id ->
-	  newSysLocalDs realWorldStatePrimTy	`thenDs` \ state_id ->
-	  let
-		the_rhs = return_result (Var state_id) 
-					[wrap_result (Var result_id)]
-
-		ccall_res_ty = mkTyConApp unboxedPairTyCon [realWorldStatePrimTy, prim_res_ty]
-		the_alt	     = (DataAlt unboxedPairDataCon, [state_id, result_id], the_rhs)
-	  in
-	  returnDs (ccall_res_ty, the_alt)
-
-
-resultWrapper :: Type
-   	      -> DsM (Maybe Type,		-- Type of the expected result, if any
-		      CoreExpr -> CoreExpr)	-- Wrapper for the result 
-resultWrapper result_ty
-  -- Base case 1: primitive types
-  | isPrimitiveType result_ty
-  = returnDs (Just result_ty, \e -> e)
-
-  -- Base case 2: the unit type ()
-  | Just (tc,_) <- maybe_tc_app, tc `hasKey` unitTyConKey
-  = returnDs (Nothing, \e -> Var unitDataConId)
-
-  -- Base case 3: the boolean type
-  | Just (tc,_) <- maybe_tc_app, tc `hasKey` boolTyConKey
-  = returnDs
-     (Just intPrimTy, \e -> Case e (mkWildId intPrimTy)
-                                   boolTy
-	                           [(DEFAULT             ,[],Var trueDataConId ),
-				    (LitAlt (mkMachInt 0),[],Var falseDataConId)])
-
-  -- Recursive newtypes
-  | Just rep_ty <- splitRecNewType_maybe result_ty
-  = resultWrapper rep_ty `thenDs` \ (maybe_ty, wrapper) ->
-    returnDs (maybe_ty, \e -> mkCoerce2 result_ty rep_ty (wrapper e))
-
-  -- The type might contain foralls (eg. for dummy type arguments,
-  -- referring to 'Ptr a' is legal).
-  | Just (tyvar, rest) <- splitForAllTy_maybe result_ty
-  = resultWrapper rest `thenDs` \ (maybe_ty, wrapper) ->
-    returnDs (maybe_ty, \e -> Lam tyvar (wrapper e))
-
-  -- Data types with a single constructor, which has a single arg
-  -- This includes types like Ptr and ForeignPtr
-  | Just (tycon, tycon_arg_tys, data_con, data_con_arg_tys) <- splitProductType_maybe result_ty,
-    dataConSourceArity data_con == 1
-  = let
-	(unwrapped_res_ty : _) = data_con_arg_tys
-	narrow_wrapper         = maybeNarrow tycon
-    in
-    resultWrapper unwrapped_res_ty `thenDs` \ (maybe_ty, wrapper) ->
-    returnDs
-      (maybe_ty, \e -> mkApps (Var (dataConWrapId data_con)) 
-			      (map Type tycon_arg_tys ++ [wrapper (narrow_wrapper e)]))
-
-    -- Strings; 'dotnet' only.
-  | Just (tc, [arg_ty]) <- maybe_tc_app,               tc == listTyCon,
-    Just (cc,[])        <- splitTyConApp_maybe arg_ty, cc == charTyCon
-  = dsLookupGlobalId unmarshalStringName	`thenDs` \ pack_id ->
-    returnDs (Just addrPrimTy,
-    	      \ e -> App (Var pack_id) e)
-
-    -- Objects; 'dotnet' only.
-  | Just (tc, [arg_ty]) <- maybe_tc_app, 
-    tyConName tc == objectTyConName
-  = dsLookupGlobalId unmarshalObjectName	`thenDs` \ pack_id ->
-    returnDs (Just addrPrimTy,
-    	      \ e -> App (Var pack_id) e)
-
-  | otherwise
-  = pprPanic "resultWrapper" (ppr result_ty)
-  where
-    maybe_tc_app = splitTyConApp_maybe result_ty
-
--- When the result of a foreign call is smaller than the word size, we
--- need to sign- or zero-extend the result up to the word size.  The C
--- standard appears to say that this is the responsibility of the
--- caller, not the callee.
-
-maybeNarrow :: TyCon -> (CoreExpr -> CoreExpr)
-maybeNarrow tycon
-  | tycon `hasKey` int8TyConKey   = \e -> App (Var (mkPrimOpId Narrow8IntOp)) e
-  | tycon `hasKey` int16TyConKey  = \e -> App (Var (mkPrimOpId Narrow16IntOp)) e
-  | tycon `hasKey` int32TyConKey
-	 && wORD_SIZE > 4         = \e -> App (Var (mkPrimOpId Narrow32IntOp)) e
-
-  | tycon `hasKey` word8TyConKey  = \e -> App (Var (mkPrimOpId Narrow8WordOp)) e
-  | tycon `hasKey` word16TyConKey = \e -> App (Var (mkPrimOpId Narrow16WordOp)) e
-  | tycon `hasKey` word32TyConKey
-	 && wORD_SIZE > 4         = \e -> App (Var (mkPrimOpId Narrow32WordOp)) e
-  | otherwise			  = id
-\end{code}
diff --git a/ghc/compiler/deSugar/DsExpr.hi-boot-5 b/ghc/compiler/deSugar/DsExpr.hi-boot-5
deleted file mode 100644
index 7e5bbaab7f..0000000000
--- a/ghc/compiler/deSugar/DsExpr.hi-boot-5
+++ /dev/null
@@ -1,5 +0,0 @@
-__interface DsExpr 1 0 where
-__export DsExpr dsExpr dsLet;
-1 dsExpr :: HsExpr.HsExpr Var.Id -> DsMonad.DsM CoreSyn.CoreExpr ;
-1 dsLExpr :: HsExpr.HsLExpr Var.Id -> DsMonad.DsM CoreSyn.CoreExpr ;
-1 dsLet  :: [HsBinds.HsBindGroup Var.Id] -> CoreSyn.CoreExpr -> DsMonad.DsM CoreSyn.CoreExpr ;
diff --git a/ghc/compiler/deSugar/DsExpr.hi-boot-6 b/ghc/compiler/deSugar/DsExpr.hi-boot-6
deleted file mode 100644
index c7ddb2ddfd..0000000000
--- a/ghc/compiler/deSugar/DsExpr.hi-boot-6
+++ /dev/null
@@ -1,6 +0,0 @@
-module DsExpr where
-
-dsExpr :: HsExpr.HsExpr Var.Id -> DsMonad.DsM CoreSyn.CoreExpr
-dsLExpr :: HsExpr.LHsExpr Var.Id -> DsMonad.DsM CoreSyn.CoreExpr
-dsLocalBinds :: HsBinds.HsLocalBinds Var.Id -> CoreSyn.CoreExpr -> DsMonad.DsM CoreSyn.CoreExpr
-dsValBinds   :: HsBinds.HsValBinds Var.Id   -> CoreSyn.CoreExpr -> DsMonad.DsM CoreSyn.CoreExpr
diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
deleted file mode 100644
index e8e9e7b370..0000000000
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ /dev/null
@@ -1,781 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[DsExpr]{Matching expressions (Exprs)}
-
-\begin{code}
-module DsExpr ( dsExpr, dsLExpr, dsLocalBinds, dsValBinds, dsLit ) where
-
-#include "HsVersions.h"
-#if defined(GHCI) && defined(BREAKPOINT)
-import Foreign.StablePtr ( newStablePtr, castStablePtrToPtr )
-import GHC.Exts         ( Ptr(..), Int(..), addr2Int# )
-import IOEnv            ( ioToIOEnv )
-import PrelNames        ( breakpointJumpName )
-import TysWiredIn       ( unitTy )
-import TypeRep          ( Type(..) )
-#endif
-
-import Match		( matchWrapper, matchSinglePat, matchEquations )
-import MatchLit		( dsLit, dsOverLit )
-import DsBinds		( dsLHsBinds, dsCoercion )
-import DsGRHSs		( dsGuarded )
-import DsListComp	( dsListComp, dsPArrComp )
-import DsUtils		( mkErrorAppDs, mkStringExpr, mkConsExpr, mkNilExpr,
-			  extractMatchResult, cantFailMatchResult, matchCanFail,
-			  mkCoreTupTy, selectSimpleMatchVarL, lookupEvidence, selectMatchVar )
-import DsArrows		( dsProcExpr )
-import DsMonad
-
-#ifdef GHCI
-	-- Template Haskell stuff iff bootstrapped
-import DsMeta		( dsBracket )
-#endif
-
-import HsSyn
-import TcHsSyn		( hsPatType, mkVanillaTuplePat )
-
--- NB: The desugarer, which straddles the source and Core worlds, sometimes
---     needs to see source types (newtypes etc), and sometimes not
---     So WATCH OUT; check each use of split*Ty functions.
--- Sigh.  This is a pain.
-
-import TcType		( tcSplitAppTy, tcSplitFunTys, tcTyConAppTyCon, 
-			  tcTyConAppArgs, isUnLiftedType, Type, mkAppTy )
-import Type		( funArgTy, splitFunTys, isUnboxedTupleType, mkFunTy )
-import CoreSyn
-import CoreUtils	( exprType, mkIfThenElse, bindNonRec )
-
-import CostCentre	( mkUserCC )
-import Id		( Id, idType, idName, idDataCon )
-import PrelInfo		( rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID )
-import DataCon		( DataCon, dataConWrapId, dataConFieldLabels, dataConInstOrigArgTys )
-import DataCon		( isVanillaDataCon )
-import TyCon		( FieldLabel, tyConDataCons )
-import TysWiredIn	( tupleCon )
-import BasicTypes	( RecFlag(..), Boxity(..), ipNameName )
-import PrelNames	( toPName,
-			  returnMName, bindMName, thenMName, failMName,
-			  mfixName )
-import SrcLoc		( Located(..), unLoc, getLoc, noLoc )
-import Util		( zipEqual, zipWithEqual )
-import Bag		( bagToList )
-import Outputable
-import FastString
-\end{code}
-
-
-%************************************************************************
-%*									*
-		dsLocalBinds, dsValBinds
-%*									*
-%************************************************************************
-
-\begin{code}
-dsLocalBinds :: HsLocalBinds Id -> CoreExpr -> DsM CoreExpr
-dsLocalBinds EmptyLocalBinds	body = return body
-dsLocalBinds (HsValBinds binds) body = dsValBinds binds body
-dsLocalBinds (HsIPBinds binds)  body = dsIPBinds  binds body
-
--------------------------
-dsValBinds :: HsValBinds Id -> CoreExpr -> DsM CoreExpr
-dsValBinds (ValBindsOut binds _) body = foldrDs ds_val_bind body binds
-
--------------------------
-dsIPBinds (IPBinds ip_binds dict_binds) body
-  = do	{ prs <- dsLHsBinds dict_binds
-	; let inner = foldr (\(x,r) e -> Let (NonRec x r) e) body prs 
-	; foldrDs ds_ip_bind inner ip_binds }
-  where
-    ds_ip_bind (L _ (IPBind n e)) body
-      = dsLExpr e	`thenDs` \ e' ->
-	returnDs (Let (NonRec (ipNameName n) e') body)
-
--------------------------
-ds_val_bind :: (RecFlag, LHsBinds Id) -> CoreExpr -> DsM CoreExpr
--- Special case for bindings which bind unlifted variables
--- We need to do a case right away, rather than building
--- a tuple and doing selections.
--- Silently ignore INLINE and SPECIALISE pragmas...
-ds_val_bind (NonRecursive, hsbinds) body
-  | [L _ (AbsBinds [] [] exports binds)] <- bagToList hsbinds,
-    (L loc bind : null_binds) <- bagToList binds,
-    isBangHsBind bind
-    || isUnboxedTupleBind bind
-    || or [isUnLiftedType (idType g) | (_, g, _, _) <- exports]
-  = let
-      body_w_exports		      = foldr bind_export body exports
-      bind_export (tvs, g, l, _) body = ASSERT( null tvs )
-				        bindNonRec g (Var l) body
-    in
-    ASSERT (null null_binds)
-	-- Non-recursive, non-overloaded bindings only come in ones
-	-- ToDo: in some bizarre case it's conceivable that there
-	--       could be dict binds in the 'binds'.  (See the notes
-	--	 below.  Then pattern-match would fail.  Urk.)
-    putSrcSpanDs loc	$
-    case bind of
-      FunBind { fun_id = L _ fun, fun_matches = matches, fun_co_fn = co_fn }
-	-> matchWrapper (FunRhs (idName fun)) matches 	 	`thenDs` \ (args, rhs) ->
-	   ASSERT( null args )	-- Functions aren't lifted
-	   ASSERT( isIdCoercion co_fn )
-	   returnDs (bindNonRec fun rhs body_w_exports)
-
-      PatBind {pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty }
-	-> 	-- let C x# y# = rhs in body
-		-- ==> case rhs of C x# y# -> body
-	   putSrcSpanDs loc			$
-	   do { rhs <- dsGuarded grhss ty
-	      ; let upat = unLoc pat
-		    eqn = EqnInfo { eqn_wrap = idWrapper, eqn_pats = [upat], 
-				    eqn_rhs = cantFailMatchResult body_w_exports }
-	      ; var    <- selectMatchVar upat ty
-	      ; result <- matchEquations PatBindRhs [var] [eqn] (exprType body)
-	      ; return (scrungleMatch var rhs result) }
-
-      other -> pprPanic "dsLet: unlifted" (pprLHsBinds hsbinds $$ ppr body)
-
-
--- Ordinary case for bindings; none should be unlifted
-ds_val_bind (is_rec, binds) body
-  = do	{ prs <- dsLHsBinds binds
-	; ASSERT( not (any (isUnLiftedType . idType . fst) prs) )
-	  case prs of
-	    []    -> return body
-	    other -> return (Let (Rec prs) body) }
-	-- Use a Rec regardless of is_rec. 
-	-- Why? Because it allows the binds to be all
-	-- mixed up, which is what happens in one rare case
-	-- Namely, for an AbsBind with no tyvars and no dicts,
-	-- 	   but which does have dictionary bindings.
-	-- See notes with TcSimplify.inferLoop [NO TYVARS]
-	-- It turned out that wrapping a Rec here was the easiest solution
-	--
-	-- NB The previous case dealt with unlifted bindings, so we
-	--    only have to deal with lifted ones now; so Rec is ok
-
-isUnboxedTupleBind :: HsBind Id -> Bool
-isUnboxedTupleBind (PatBind { pat_rhs_ty = ty }) = isUnboxedTupleType ty
-isUnboxedTupleBind other			 = False
-
-scrungleMatch :: Id -> CoreExpr -> CoreExpr -> CoreExpr
--- Returns something like (let var = scrut in body)
--- but if var is an unboxed-tuple type, it inlines it in a fragile way
--- Special case to handle unboxed tuple patterns; they can't appear nested
--- The idea is that 
---	case e of (# p1, p2 #) -> rhs
--- should desugar to
---	case e of (# x1, x2 #) -> ... match p1, p2 ...
--- NOT
---	let x = e in case x of ....
---
--- But there may be a big 
---	let fail = ... in case e of ...
--- wrapping the whole case, which complicates matters slightly
--- It all seems a bit fragile.  Test is dsrun013.
-
-scrungleMatch var scrut body
-  | isUnboxedTupleType (idType var) = scrungle body
-  | otherwise			    = bindNonRec var scrut body
-  where
-    scrungle (Case (Var x) bndr ty alts)
-		    | x == var = Case scrut bndr ty alts
-    scrungle (Let binds body)  = Let binds (scrungle body)
-    scrungle other = panic ("scrungleMatch: tuple pattern:\n" ++ showSDoc (ppr other))
-\end{code}	
-
-%************************************************************************
-%*									*
-\subsection[DsExpr-vars-and-cons]{Variables, constructors, literals}
-%*									*
-%************************************************************************
-
-\begin{code}
-dsLExpr :: LHsExpr Id -> DsM CoreExpr
-dsLExpr (L loc e) = putSrcSpanDs loc $ dsExpr e
-
-dsExpr :: HsExpr Id -> DsM CoreExpr
-
-dsExpr (HsPar e) 	      = dsLExpr e
-dsExpr (ExprWithTySigOut e _) = dsLExpr e
-dsExpr (HsVar var)     	      = returnDs (Var var)
-dsExpr (HsIPVar ip)    	      = returnDs (Var (ipNameName ip))
-dsExpr (HsLit lit)     	      = dsLit lit
-dsExpr (HsOverLit lit) 	      = dsOverLit lit
-
-dsExpr (NegApp expr neg_expr) 
-  = do	{ core_expr <- dsLExpr expr
-	; core_neg  <- dsExpr neg_expr
-	; return (core_neg `App` core_expr) }
-
-dsExpr expr@(HsLam a_Match)
-  = matchWrapper LambdaExpr a_Match	`thenDs` \ (binders, matching_code) ->
-    returnDs (mkLams binders matching_code)
-
-#if defined(GHCI) && defined(BREAKPOINT)
-dsExpr (HsApp (L _ (HsApp realFun@(L _ (HsCoerce _ fun)) (L loc arg))) _)
-    | HsVar funId <- fun
-    , idName funId == breakpointJumpName
-    , ids <- filter (not.hasTyVar.idType) (extractIds arg)
-    = do dsWarn (text "Extracted ids:" <+> ppr ids <+> ppr (map idType ids))
-         stablePtr <- ioToIOEnv $ newStablePtr ids
-         -- Yes, I know... I'm gonna burn in hell.
-         let Ptr addr# = castStablePtrToPtr stablePtr
-         funCore <- dsLExpr realFun
-         argCore <- dsLExpr (L loc (HsLit (HsInt (fromIntegral (I# (addr2Int# addr#))))))
-         hvalCore <- dsLExpr (L loc (extractHVals ids))
-         return ((funCore `App` argCore) `App` hvalCore)
-    where extractIds :: HsExpr Id -> [Id]
-          extractIds (HsApp fn arg)
-              | HsVar argId <- unLoc arg
-              = argId:extractIds (unLoc fn)
-              | TyApp arg' ts <- unLoc arg
-              , HsVar argId <- unLoc arg'
-              = error (showSDoc (ppr ts)) -- argId:extractIds (unLoc fn)
-          extractIds x = []
-          extractHVals ids = ExplicitList unitTy (map (L loc . HsVar) ids)
-          hasTyVar (TyVarTy _) = True
-          hasTyVar (FunTy a b) = hasTyVar a || hasTyVar b
-          hasTyVar (NoteTy _ t) = hasTyVar t
-          hasTyVar (AppTy a b) = hasTyVar a || hasTyVar b
-          hasTyVar (TyConApp _ ts) = any hasTyVar ts
-          hasTyVar _ = False
-#endif
-
-dsExpr expr@(HsApp fun arg)      
-  = dsLExpr fun		`thenDs` \ core_fun ->
-    dsLExpr arg		`thenDs` \ core_arg ->
-    returnDs (core_fun `App` core_arg)
-\end{code}
-
-Operator sections.  At first it looks as if we can convert
-\begin{verbatim}
-	(expr op)
-\end{verbatim}
-to
-\begin{verbatim}
-	\x -> op expr x
-\end{verbatim}
-
-But no!  expr might be a redex, and we can lose laziness badly this
-way.  Consider
-\begin{verbatim}
-	map (expr op) xs
-\end{verbatim}
-for example.  So we convert instead to
-\begin{verbatim}
-	let y = expr in \x -> op y x
-\end{verbatim}
-If \tr{expr} is actually just a variable, say, then the simplifier
-will sort it out.
-
-\begin{code}
-dsExpr (OpApp e1 op _ e2)
-  = dsLExpr op						`thenDs` \ core_op ->
-    -- for the type of y, we need the type of op's 2nd argument
-    dsLExpr e1				`thenDs` \ x_core ->
-    dsLExpr e2				`thenDs` \ y_core ->
-    returnDs (mkApps core_op [x_core, y_core])
-    
-dsExpr (SectionL expr op)
-  = dsLExpr op						`thenDs` \ core_op ->
-    -- for the type of y, we need the type of op's 2nd argument
-    let
-	(x_ty:y_ty:_, _) = splitFunTys (exprType core_op)
-	-- Must look through an implicit-parameter type; 
-	-- newtype impossible; hence Type.splitFunTys
-    in
-    dsLExpr expr				`thenDs` \ x_core ->
-    newSysLocalDs x_ty			`thenDs` \ x_id ->
-    newSysLocalDs y_ty			`thenDs` \ y_id ->
-
-    returnDs (bindNonRec x_id x_core $
-	      Lam y_id (mkApps core_op [Var x_id, Var y_id]))
-
--- dsLExpr (SectionR op expr)	-- \ x -> op x expr
-dsExpr (SectionR op expr)
-  = dsLExpr op			`thenDs` \ core_op ->
-    -- for the type of x, we need the type of op's 2nd argument
-    let
-	(x_ty:y_ty:_, _) = splitFunTys (exprType core_op)
-	-- See comment with SectionL
-    in
-    dsLExpr expr				`thenDs` \ y_core ->
-    newSysLocalDs x_ty			`thenDs` \ x_id ->
-    newSysLocalDs y_ty			`thenDs` \ y_id ->
-
-    returnDs (bindNonRec y_id y_core $
-	      Lam x_id (mkApps core_op [Var x_id, Var y_id]))
-
-dsExpr (HsSCC cc expr)
-  = dsLExpr expr			`thenDs` \ core_expr ->
-    getModuleDs			`thenDs` \ mod_name ->
-    returnDs (Note (SCC (mkUserCC cc mod_name)) core_expr)
-
-
--- hdaume: core annotation
-
-dsExpr (HsCoreAnn fs expr)
-  = dsLExpr expr        `thenDs` \ core_expr ->
-    returnDs (Note (CoreNote $ unpackFS fs) core_expr)
-
-dsExpr (HsCase discrim matches)
-  = dsLExpr discrim			`thenDs` \ core_discrim ->
-    matchWrapper CaseAlt matches 	`thenDs` \ ([discrim_var], matching_code) ->
-    returnDs (scrungleMatch discrim_var core_discrim matching_code)
-
-dsExpr (HsLet binds body)
-  = dsLExpr body		`thenDs` \ body' ->
-    dsLocalBinds binds body'
-
--- We need the `ListComp' form to use `deListComp' (rather than the "do" form)
--- because the interpretation of `stmts' depends on what sort of thing it is.
---
-dsExpr (HsDo ListComp stmts body result_ty)
-  =	-- Special case for list comprehensions
-    dsListComp stmts body elt_ty
-  where
-    [elt_ty] = tcTyConAppArgs result_ty
-
-dsExpr (HsDo DoExpr stmts body result_ty)
-  = dsDo stmts body result_ty
-
-dsExpr (HsDo (MDoExpr tbl) stmts body result_ty)
-  = dsMDo tbl stmts body result_ty
-
-dsExpr (HsDo PArrComp stmts body result_ty)
-  =	-- Special case for array comprehensions
-    dsPArrComp (map unLoc stmts) body elt_ty
-  where
-    [elt_ty] = tcTyConAppArgs result_ty
-
-dsExpr (HsIf guard_expr then_expr else_expr)
-  = dsLExpr guard_expr	`thenDs` \ core_guard ->
-    dsLExpr then_expr	`thenDs` \ core_then ->
-    dsLExpr else_expr	`thenDs` \ core_else ->
-    returnDs (mkIfThenElse core_guard core_then core_else)
-\end{code}
-
-
-\noindent
-\underline{\bf Type lambda and application}
-%              ~~~~~~~~~~~~~~~~~~~~~~~~~~~
-\begin{code}
-dsExpr (TyLam tyvars expr)
-  = dsLExpr expr `thenDs` \ core_expr ->
-    returnDs (mkLams tyvars core_expr)
-
-dsExpr (TyApp expr tys)
-  = dsLExpr expr		`thenDs` \ core_expr ->
-    returnDs (mkTyApps core_expr tys)
-\end{code}
-
-
-\noindent
-\underline{\bf Various data construction things}
-%              ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-\begin{code}
-dsExpr (ExplicitList ty xs)
-  = go xs
-  where
-    go []     = returnDs (mkNilExpr ty)
-    go (x:xs) = dsLExpr x				`thenDs` \ core_x ->
-		go xs					`thenDs` \ core_xs ->
-		returnDs (mkConsExpr ty core_x core_xs)
-
--- we create a list from the array elements and convert them into a list using
--- `PrelPArr.toP'
---
---  * the main disadvantage to this scheme is that `toP' traverses the list
---   twice: once to determine the length and a second time to put to elements
---   into the array; this inefficiency could be avoided by exposing some of
---   the innards of `PrelPArr' to the compiler (ie, have a `PrelPArrBase') so
---   that we can exploit the fact that we already know the length of the array
---   here at compile time
---
-dsExpr (ExplicitPArr ty xs)
-  = dsLookupGlobalId toPName				`thenDs` \toP      ->
-    dsExpr (ExplicitList ty xs)				`thenDs` \coreList ->
-    returnDs (mkApps (Var toP) [Type ty, coreList])
-
-dsExpr (ExplicitTuple expr_list boxity)
-  = mappM dsLExpr expr_list	  `thenDs` \ core_exprs  ->
-    returnDs (mkConApp (tupleCon boxity (length expr_list))
-	    	       (map (Type .  exprType) core_exprs ++ core_exprs))
-
-dsExpr (ArithSeq expr (From from))
-  = dsExpr expr		  `thenDs` \ expr2 ->
-    dsLExpr from	  `thenDs` \ from2 ->
-    returnDs (App expr2 from2)
-
-dsExpr (ArithSeq expr (FromTo from two))
-  = dsExpr expr		  `thenDs` \ expr2 ->
-    dsLExpr from	  `thenDs` \ from2 ->
-    dsLExpr two		  `thenDs` \ two2 ->
-    returnDs (mkApps expr2 [from2, two2])
-
-dsExpr (ArithSeq expr (FromThen from thn))
-  = dsExpr expr		  `thenDs` \ expr2 ->
-    dsLExpr from	  `thenDs` \ from2 ->
-    dsLExpr thn		  `thenDs` \ thn2 ->
-    returnDs (mkApps expr2 [from2, thn2])
-
-dsExpr (ArithSeq expr (FromThenTo from thn two))
-  = dsExpr expr		  `thenDs` \ expr2 ->
-    dsLExpr from	  `thenDs` \ from2 ->
-    dsLExpr thn		  `thenDs` \ thn2 ->
-    dsLExpr two		  `thenDs` \ two2 ->
-    returnDs (mkApps expr2 [from2, thn2, two2])
-
-dsExpr (PArrSeq expr (FromTo from two))
-  = dsExpr expr		  `thenDs` \ expr2 ->
-    dsLExpr from	  `thenDs` \ from2 ->
-    dsLExpr two		  `thenDs` \ two2 ->
-    returnDs (mkApps expr2 [from2, two2])
-
-dsExpr (PArrSeq expr (FromThenTo from thn two))
-  = dsExpr expr		  `thenDs` \ expr2 ->
-    dsLExpr from	  `thenDs` \ from2 ->
-    dsLExpr thn		  `thenDs` \ thn2 ->
-    dsLExpr two		  `thenDs` \ two2 ->
-    returnDs (mkApps expr2 [from2, thn2, two2])
-
-dsExpr (PArrSeq expr _)
-  = panic "DsExpr.dsExpr: Infinite parallel array!"
-    -- the parser shouldn't have generated it and the renamer and typechecker
-    -- shouldn't have let it through
-\end{code}
-
-\noindent
-\underline{\bf Record construction and update}
-%              ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-For record construction we do this (assuming T has three arguments)
-\begin{verbatim}
-	T { op2 = e }
-==>
-	let err = /\a -> recConErr a 
-	T (recConErr t1 "M.lhs/230/op1") 
-	  e 
-	  (recConErr t1 "M.lhs/230/op3")
-\end{verbatim}
-@recConErr@ then converts its arugment string into a proper message
-before printing it as
-\begin{verbatim}
-	M.lhs, line 230: missing field op1 was evaluated
-\end{verbatim}
-
-We also handle @C{}@ as valid construction syntax for an unlabelled
-constructor @C@, setting all of @C@'s fields to bottom.
-
-\begin{code}
-dsExpr (RecordCon (L _ data_con_id) con_expr rbinds)
-  = dsExpr con_expr	`thenDs` \ con_expr' ->
-    let
-	(arg_tys, _) = tcSplitFunTys (exprType con_expr')
-	-- A newtype in the corner should be opaque; 
-	-- hence TcType.tcSplitFunTys
-
-	mk_arg (arg_ty, lbl)	-- Selector id has the field label as its name
-	  = case [rhs | (L _ sel_id, rhs) <- rbinds, lbl == idName sel_id] of
-	      (rhs:rhss) -> ASSERT( null rhss )
-		 	    dsLExpr rhs
-	      []         -> mkErrorAppDs rEC_CON_ERROR_ID arg_ty (showSDoc (ppr lbl))
-	unlabelled_bottom arg_ty = mkErrorAppDs rEC_CON_ERROR_ID arg_ty ""
-
-	labels = dataConFieldLabels (idDataCon data_con_id)
-	-- The data_con_id is guaranteed to be the wrapper id of the constructor
-    in
-
-    (if null labels
-	then mappM unlabelled_bottom arg_tys
-	else mappM mk_arg (zipEqual "dsExpr:RecordCon" arg_tys labels))
-	`thenDs` \ con_args ->
-
-    returnDs (mkApps con_expr' con_args)
-\end{code}
-
-Record update is a little harder. Suppose we have the decl:
-\begin{verbatim}
-	data T = T1 {op1, op2, op3 :: Int}
-	       | T2 {op4, op2 :: Int}
-	       | T3
-\end{verbatim}
-Then we translate as follows:
-\begin{verbatim}
-	r { op2 = e }
-===>
-	let op2 = e in
-	case r of
-	  T1 op1 _ op3 -> T1 op1 op2 op3
-	  T2 op4 _     -> T2 op4 op2
-	  other	       -> recUpdError "M.lhs/230"
-\end{verbatim}
-It's important that we use the constructor Ids for @T1@, @T2@ etc on the
-RHSs, and do not generate a Core constructor application directly, because the constructor
-might do some argument-evaluation first; and may have to throw away some
-dictionaries.
-
-\begin{code}
-dsExpr (RecordUpd record_expr [] record_in_ty record_out_ty)
-  = dsLExpr record_expr
-
-dsExpr expr@(RecordUpd record_expr rbinds record_in_ty record_out_ty)
-  = dsLExpr record_expr	 	`thenDs` \ record_expr' ->
-
-	-- Desugar the rbinds, and generate let-bindings if
-	-- necessary so that we don't lose sharing
-
-    let
-	in_inst_tys  = tcTyConAppArgs record_in_ty	-- Newtype opaque
-	out_inst_tys = tcTyConAppArgs record_out_ty	-- Newtype opaque
-	in_out_ty    = mkFunTy record_in_ty record_out_ty
-
-	mk_val_arg field old_arg_id 
-	  = case [rhs | (L _ sel_id, rhs) <- rbinds, field == idName sel_id] of
-	      (rhs:rest) -> ASSERT(null rest) rhs
-	      []	 -> nlHsVar old_arg_id
-
-	mk_alt con
-	  = newSysLocalsDs (dataConInstOrigArgTys con in_inst_tys) `thenDs` \ arg_ids ->
-		-- This call to dataConInstOrigArgTys won't work for existentials
-		-- but existentials don't have record types anyway
-	    let 
-		val_args = zipWithEqual "dsExpr:RecordUpd" mk_val_arg
-					(dataConFieldLabels con) arg_ids
-		rhs = foldl (\a b -> nlHsApp a b)
-			(noLoc $ TyApp (nlHsVar (dataConWrapId con)) 
-				out_inst_tys)
-			  val_args
-	    in
-	    returnDs (mkSimpleMatch [noLoc $ ConPatOut (noLoc con) [] [] emptyLHsBinds 
-						       (PrefixCon (map nlVarPat arg_ids)) record_in_ty]
-				    rhs)
-    in
-	-- Record stuff doesn't work for existentials
-	-- The type checker checks for this, but we need 
-	-- worry only about the constructors that are to be updated
-    ASSERT2( all isVanillaDataCon cons_to_upd, ppr expr )
-
-	-- It's important to generate the match with matchWrapper,
-	-- and the right hand sides with applications of the wrapper Id
-	-- so that everything works when we are doing fancy unboxing on the
-	-- constructor aguments.
-    mappM mk_alt cons_to_upd				`thenDs` \ alts ->
-    matchWrapper RecUpd (MatchGroup alts in_out_ty)	`thenDs` \ ([discrim_var], matching_code) ->
-
-    returnDs (bindNonRec discrim_var record_expr' matching_code)
-
-  where
-    updated_fields :: [FieldLabel]
-    updated_fields = [ idName sel_id | (L _ sel_id,_) <- rbinds]
-
-	-- Get the type constructor from the record_in_ty
-	-- so that we are sure it'll have all its DataCons
-	-- (In GHCI, it's possible that some TyCons may not have all
-	--  their constructors, in a module-loop situation.)
-    tycon       = tcTyConAppTyCon record_in_ty
-    data_cons   = tyConDataCons tycon
-    cons_to_upd = filter has_all_fields data_cons
-
-    has_all_fields :: DataCon -> Bool
-    has_all_fields con_id 
-      = all (`elem` con_fields) updated_fields
-      where
-	con_fields = dataConFieldLabels con_id
-\end{code}
-
-
-\noindent
-\underline{\bf Dictionary lambda and application}
-%              ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-@DictLam@ and @DictApp@ turn into the regular old things.
-(OLD:) @DictFunApp@ also becomes a curried application, albeit slightly more
-complicated; reminiscent of fully-applied constructors.
-\begin{code}
-dsExpr (DictLam dictvars expr)
-  = dsLExpr expr `thenDs` \ core_expr ->
-    returnDs (mkLams dictvars core_expr)
-
-------------------
-
-dsExpr (DictApp expr dicts)	-- becomes a curried application
-  = dsLExpr expr			`thenDs` \ core_expr ->
-    returnDs (foldl (\f d -> f `App` (Var d)) core_expr dicts)
-
-dsExpr (HsCoerce co_fn e) = dsCoercion co_fn (dsExpr e)
-\end{code}
-
-Here is where we desugar the Template Haskell brackets and escapes
-
-\begin{code}
--- Template Haskell stuff
-
-#ifdef GHCI	/* Only if bootstrapping */
-dsExpr (HsBracketOut x ps) = dsBracket x ps
-dsExpr (HsSpliceE s)       = pprPanic "dsExpr:splice" (ppr s)
-#endif
-
--- Arrow notation extension
-dsExpr (HsProc pat cmd) = dsProcExpr pat cmd
-\end{code}
-
-
-\begin{code}
-
-#ifdef DEBUG
--- HsSyn constructs that just shouldn't be here:
-dsExpr (ExprWithTySig _ _)  = panic "dsExpr:ExprWithTySig"
-#endif
-
-\end{code}
-
-%--------------------------------------------------------------------
-
-Desugar 'do' and 'mdo' expressions (NOT list comprehensions, they're
-handled in DsListComp).  Basically does the translation given in the
-Haskell 98 report:
-
-\begin{code}
-dsDo	:: [LStmt Id]
-	-> LHsExpr Id
-	-> Type			-- Type of the whole expression
-	-> DsM CoreExpr
-
-dsDo stmts body result_ty
-  = go (map unLoc stmts)
-  where
-    go [] = dsLExpr body
-    
-    go (ExprStmt rhs then_expr _ : stmts)
-      = do { rhs2 <- dsLExpr rhs
-	   ; then_expr2 <- dsExpr then_expr
-	   ; rest <- go stmts
-	   ; returnDs (mkApps then_expr2 [rhs2, rest]) }
-    
-    go (LetStmt binds : stmts)
-      = do { rest <- go stmts
-	   ; dsLocalBinds binds rest }
-        
-    go (BindStmt pat rhs bind_op fail_op : stmts)
-      = do { body  <- go stmts
-	   ; var   <- selectSimpleMatchVarL pat
-	   ; match <- matchSinglePat (Var var) (StmtCtxt DoExpr) pat
-    				  result_ty (cantFailMatchResult body)
-	   ; match_code <- handle_failure pat match fail_op
-	   ; rhs'       <- dsLExpr rhs
-	   ; bind_op'   <- dsExpr bind_op
-	   ; returnDs (mkApps bind_op' [rhs', Lam var match_code]) }
-    
-    -- In a do expression, pattern-match failure just calls
-    -- the monadic 'fail' rather than throwing an exception
-    handle_failure pat match fail_op
-      | matchCanFail match
-      = do { fail_op' <- dsExpr fail_op
-	   ; fail_msg <- mkStringExpr (mk_fail_msg pat)
-    	   ; extractMatchResult match (App fail_op' fail_msg) }
-      | otherwise
-      = extractMatchResult match (error "It can't fail") 
-
-mk_fail_msg pat = "Pattern match failure in do expression at " ++ 
-		  showSDoc (ppr (getLoc pat))
-\end{code}
-
-Translation for RecStmt's: 
------------------------------
-We turn (RecStmt [v1,..vn] stmts) into:
-  
-  (v1,..,vn) <- mfix (\~(v1,..vn). do stmts
-				      return (v1,..vn))
-
-\begin{code}
-dsMDo	:: PostTcTable
-	-> [LStmt Id]
-	-> LHsExpr Id
-	-> Type			-- Type of the whole expression
-	-> DsM CoreExpr
-
-dsMDo tbl stmts body result_ty
-  = go (map unLoc stmts)
-  where
-    (m_ty, b_ty) = tcSplitAppTy result_ty	-- result_ty must be of the form (m b)
-    mfix_id   = lookupEvidence tbl mfixName
-    return_id = lookupEvidence tbl returnMName
-    bind_id   = lookupEvidence tbl bindMName
-    then_id   = lookupEvidence tbl thenMName
-    fail_id   = lookupEvidence tbl failMName
-    ctxt      = MDoExpr tbl
-
-    go [] = dsLExpr body
-    
-    go (LetStmt binds : stmts)
-      = do { rest <- go stmts
-	   ; dsLocalBinds binds rest }
-
-    go (ExprStmt rhs _ rhs_ty : stmts)
-      = do { rhs2 <- dsLExpr rhs
-	   ; rest <- go stmts
-	   ; returnDs (mkApps (Var then_id) [Type rhs_ty, Type b_ty, rhs2, rest]) }
-    
-    go (BindStmt pat rhs _ _ : stmts)
-      = do { body  <- go stmts
-	   ; var   <- selectSimpleMatchVarL pat
-	   ; match <- matchSinglePat (Var var) (StmtCtxt ctxt) pat
-    				  result_ty (cantFailMatchResult body)
-	   ; fail_msg   <- mkStringExpr (mk_fail_msg pat)
-	   ; let fail_expr = mkApps (Var fail_id) [Type b_ty, fail_msg]
-	   ; match_code <- extractMatchResult match fail_expr
-
-	   ; rhs'       <- dsLExpr rhs
-	   ; returnDs (mkApps (Var bind_id) [Type (hsPatType pat), Type b_ty, 
-					     rhs', Lam var match_code]) }
-    
-    go (RecStmt rec_stmts later_ids rec_ids rec_rets binds : stmts)
-      = ASSERT( length rec_ids > 0 )
-        ASSERT( length rec_ids == length rec_rets )
-	go (new_bind_stmt : let_stmt : stmts)
-      where
-        new_bind_stmt = mkBindStmt (mk_tup_pat later_pats) mfix_app
-	let_stmt = LetStmt (HsValBinds (ValBindsOut [(Recursive, binds)] []))
-
-	
-		-- Remove the later_ids that appear (without fancy coercions) 
-		-- in rec_rets, because there's no need to knot-tie them separately
-		-- See Note [RecStmt] in HsExpr
-	later_ids'   = filter (`notElem` mono_rec_ids) later_ids
-	mono_rec_ids = [ id | HsVar id <- rec_rets ]
-    
-	mfix_app = nlHsApp (noLoc $ TyApp (nlHsVar mfix_id) [tup_ty]) mfix_arg
-	mfix_arg = noLoc $ HsLam (MatchGroup [mkSimpleMatch [mfix_pat] body]
-					     (mkFunTy tup_ty body_ty))
-
-	-- The rec_tup_pat must bind the rec_ids only; remember that the 
-	-- 	trimmed_laters may share the same Names
-	-- Meanwhile, the later_pats must bind the later_vars
-	rec_tup_pats = map mk_wild_pat later_ids' ++ map nlVarPat rec_ids
-	later_pats   = map nlVarPat    later_ids' ++ map mk_later_pat rec_ids
-	rets         = map nlHsVar     later_ids' ++ map noLoc rec_rets
-
-	mfix_pat = noLoc $ LazyPat $ mk_tup_pat rec_tup_pats
-	body     = noLoc $ HsDo ctxt rec_stmts return_app body_ty
-	body_ty = mkAppTy m_ty tup_ty
-	tup_ty  = mkCoreTupTy (map idType (later_ids' ++ rec_ids))
-		  -- mkCoreTupTy deals with singleton case
-
-	return_app  = nlHsApp (noLoc $ TyApp (nlHsVar return_id) [tup_ty]) 
-			      (mk_ret_tup rets)
-
-	mk_wild_pat :: Id -> LPat Id 
-   	mk_wild_pat v = noLoc $ WildPat $ idType v
-
-	mk_later_pat :: Id -> LPat Id
-	mk_later_pat v | v `elem` later_ids' = mk_wild_pat v
-		       | otherwise	     = nlVarPat v
-
- 	mk_tup_pat :: [LPat Id] -> LPat Id
-  	mk_tup_pat [p] = p
-	mk_tup_pat ps  = noLoc $ mkVanillaTuplePat ps Boxed
-
-	mk_ret_tup :: [LHsExpr Id] -> LHsExpr Id
-	mk_ret_tup [r] = r
-	mk_ret_tup rs  = noLoc $ ExplicitTuple rs Boxed
-\end{code}
diff --git a/ghc/compiler/deSugar/DsExpr.lhs-boot b/ghc/compiler/deSugar/DsExpr.lhs-boot
deleted file mode 100644
index c65e99d80d..0000000000
--- a/ghc/compiler/deSugar/DsExpr.lhs-boot
+++ /dev/null
@@ -1,11 +0,0 @@
-\begin{code}
-module DsExpr where
-import HsSyn	( HsExpr, LHsExpr, HsLocalBinds )
-import Var  	( Id )
-import DsMonad	( DsM )
-import CoreSyn	( CoreExpr )
-
-dsExpr  :: HsExpr  Id -> DsM CoreExpr
-dsLExpr :: LHsExpr Id -> DsM CoreExpr
-dsLocalBinds :: HsLocalBinds Id -> CoreExpr -> DsM CoreExpr
-\end{code}
diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs
deleted file mode 100644
index 52956a09ff..0000000000
--- a/ghc/compiler/deSugar/DsForeign.lhs
+++ /dev/null
@@ -1,646 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1998
-%
-\section[DsCCall]{Desugaring \tr{foreign} declarations}
-
-Expanding out @foreign import@ and @foreign export@ declarations.
-
-\begin{code}
-module DsForeign ( dsForeigns ) where
-
-#include "HsVersions.h"
-import TcRnMonad	-- temp
-
-import CoreSyn
-
-import DsCCall		( dsCCall, mkFCall, boxResult, unboxArg, resultWrapper )
-import DsMonad
-
-import HsSyn		( ForeignDecl(..), ForeignExport(..), LForeignDecl,
-			  ForeignImport(..), CImportSpec(..) )
-import DataCon		( splitProductType_maybe )
-#ifdef DEBUG
-import DataCon		( dataConSourceArity )
-import Type		( isUnLiftedType )
-#endif
-import MachOp		( machRepByteWidth, MachRep(..) )
-import SMRep		( argMachRep, typeCgRep )
-import CoreUtils	( exprType, mkInlineMe )
-import Id		( Id, idType, idName, mkSysLocal, setInlinePragma )
-import Literal		( Literal(..), mkStringLit )
-import Module		( moduleFS )
-import Name		( getOccString, NamedThing(..) )
-import Type		( repType, coreEqType )
-import TcType		( Type, mkFunTys, mkForAllTys, mkTyConApp,
-			  mkFunTy, tcSplitTyConApp_maybe, 
-			  tcSplitForAllTys, tcSplitFunTys, tcTyConAppArgs,
-			)
-
-import BasicTypes       ( Boxity(..) )
-import HscTypes		( ForeignStubs(..) )
-import ForeignCall	( ForeignCall(..), CCallSpec(..), 
-			  Safety(..), playSafe,
-			  CExportSpec(..), CLabelString,
-			  CCallConv(..), ccallConvToInt,
-			  ccallConvAttribute
-			)
-import TysWiredIn	( unitTy, tupleTyCon )
-import TysPrim		( addrPrimTy, mkStablePtrPrimTy, alphaTy )
-import PrelNames	( hasKey, ioTyConKey, stablePtrTyConName, newStablePtrName, bindIOName,
-			  checkDotnetResName )
-import BasicTypes	( Activation( NeverActive ) )
-import SrcLoc		( Located(..), unLoc )
-import Outputable
-import Maybe 		( fromJust, isNothing )
-import FastString
-\end{code}
-
-Desugaring of @foreign@ declarations is naturally split up into
-parts, an @import@ and an @export@  part. A @foreign import@ 
-declaration
-\begin{verbatim}
-  foreign import cc nm f :: prim_args -> IO prim_res
-\end{verbatim}
-is the same as
-\begin{verbatim}
-  f :: prim_args -> IO prim_res
-  f a1 ... an = _ccall_ nm cc a1 ... an
-\end{verbatim}
-so we reuse the desugaring code in @DsCCall@ to deal with these.
-
-\begin{code}
-type Binding = (Id, CoreExpr)	-- No rec/nonrec structure;
-				-- the occurrence analyser will sort it all out
-
-dsForeigns :: [LForeignDecl Id] 
-	   -> DsM (ForeignStubs, [Binding])
-dsForeigns [] 
-  = returnDs (NoStubs, [])
-dsForeigns fos
-  = foldlDs combine (ForeignStubs empty empty [] [], []) fos
- where
-  combine stubs (L loc decl) = putSrcSpanDs loc (combine1 stubs decl)
-
-  combine1 (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f) 
-	   (ForeignImport id _ spec depr)
-    = traceIf (text "fi start" <+> ppr id)	`thenDs` \ _ ->
-      dsFImport (unLoc id) spec	                `thenDs` \ (bs, h, c, mbhd) -> 
-      warnDepr depr				`thenDs` \ _                ->
-      traceIf (text "fi end" <+> ppr id)	`thenDs` \ _ ->
-      returnDs (ForeignStubs (h $$ acc_h)
-      			     (c $$ acc_c)
-			     (addH mbhd acc_hdrs)
-			     acc_feb, 
-		bs ++ acc_f)
-
-  combine1 (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f) 
-	   (ForeignExport (L _ id) _ (CExport (CExportStatic ext_nm cconv)) depr)
-    = dsFExport id (idType id) 
-		ext_nm cconv False                 `thenDs` \(h, c, _, _) ->
-      warnDepr depr				   `thenDs` \_              ->
-      returnDs (ForeignStubs (h $$ acc_h) (c $$ acc_c) acc_hdrs (id:acc_feb), 
-		acc_f)
-
-  addH Nothing  ls = ls
-  addH (Just e) ls
-   | e `elem` ls = ls
-   | otherwise   = e:ls
-
-  warnDepr False = returnDs ()
-  warnDepr True  = dsWarn msg
-     where
-       msg = ptext SLIT("foreign declaration uses deprecated non-standard syntax")
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Foreign import}
-%*									*
-%************************************************************************
-
-Desugaring foreign imports is just the matter of creating a binding
-that on its RHS unboxes its arguments, performs the external call
-(using the @CCallOp@ primop), before boxing the result up and returning it.
-
-However, we create a worker/wrapper pair, thus:
-
-	foreign import f :: Int -> IO Int
-==>
-	f x = IO ( \s -> case x of { I# x# ->
-			 case fw s x# of { (# s1, y# #) ->
-			 (# s1, I# y# #)}})
-
-	fw s x# = ccall f s x#
-
-The strictness/CPR analyser won't do this automatically because it doesn't look
-inside returned tuples; but inlining this wrapper is a Really Good Idea 
-because it exposes the boxing to the call site.
-
-\begin{code}
-dsFImport :: Id
-	  -> ForeignImport
-	  -> DsM ([Binding], SDoc, SDoc, Maybe FastString)
-dsFImport id (CImport cconv safety header lib spec)
-  = dsCImport id spec cconv safety no_hdrs	  `thenDs` \(ids, h, c) ->
-    returnDs (ids, h, c, if no_hdrs then Nothing else Just header)
-  where
-    no_hdrs = nullFS header
-
-  -- FIXME: the `lib' field is needed for .NET ILX generation when invoking
-  --	    routines that are external to the .NET runtime, but GHC doesn't
-  --	    support such calls yet; if `nullFastString lib', the value was not given
-dsFImport id (DNImport spec)
-  = dsFCall id (DNCall spec) True {- No headers -} `thenDs` \(ids, h, c) ->
-    returnDs (ids, h, c, Nothing)
-
-dsCImport :: Id
-	  -> CImportSpec
-	  -> CCallConv
-	  -> Safety
-	  -> Bool	-- True <=> no headers in the f.i decl
-	  -> DsM ([Binding], SDoc, SDoc)
-dsCImport id (CLabel cid) _ _ no_hdrs
- = resultWrapper (idType id) `thenDs` \ (resTy, foRhs) ->
-   ASSERT(fromJust resTy `coreEqType` addrPrimTy)    -- typechecker ensures this
-    let rhs = foRhs (mkLit (MachLabel cid Nothing)) in
-    returnDs ([(setImpInline no_hdrs id, rhs)], empty, empty)
-dsCImport id (CFunction target) cconv safety no_hdrs
-  = dsFCall id (CCall (CCallSpec target cconv safety)) no_hdrs
-dsCImport id CWrapper cconv _ _
-  = dsFExportDynamic id cconv
-
-setImpInline :: Bool 	-- True <=> No #include headers 
-			-- in the foreign import declaration
-	     -> Id -> Id
--- If there is a #include header in the foreign import
--- we make the worker non-inlinable, because we currently
--- don't keep the #include stuff in the CCallId, and hence
--- it won't be visible in the importing module, which can be
--- fatal. 
--- (The #include stuff is just collected from the foreign import
---  decls in a module.)
--- If you want to do cross-module inlining of the c-calls themselves,
--- put the #include stuff in the package spec, not the foreign 
--- import decl.
-setImpInline True  id = id
-setImpInline False id = id `setInlinePragma` NeverActive
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Foreign calls}
-%*									*
-%************************************************************************
-
-\begin{code}
-dsFCall fn_id fcall no_hdrs
-  = let
-	ty		     = idType fn_id
-	(tvs, fun_ty)        = tcSplitForAllTys ty
-	(arg_tys, io_res_ty) = tcSplitFunTys fun_ty
-		-- Must use tcSplit* functions because we want to 
-		-- see that (IO t) in the corner
-    in
-    newSysLocalsDs arg_tys  			`thenDs` \ args ->
-    mapAndUnzipDs unboxArg (map Var args)	`thenDs` \ (val_args, arg_wrappers) ->
-
-    let
-	work_arg_ids  = [v | Var v <- val_args]	-- All guaranteed to be vars
-
-	forDotnet = 
-	 case fcall of
-	   DNCall{} -> True
-	   _        -> False
-
-	topConDs
-	  | forDotnet = 
-	     dsLookupGlobalId checkDotnetResName `thenDs` \ check_id -> 
-	     return (Just check_id)
-          | otherwise = return Nothing
-	     
-	augmentResultDs
-	  | forDotnet = 
-	  	newSysLocalDs addrPrimTy `thenDs` \ err_res -> 
-		returnDs (\ (mb_res_ty, resWrap) ->
-			      case mb_res_ty of
-			  	Nothing -> (Just (mkTyConApp (tupleTyCon Unboxed 1)
-							     [ addrPrimTy ]),
-						 resWrap)
-				Just x  -> (Just (mkTyConApp (tupleTyCon Unboxed 2)
-							     [ x, addrPrimTy ]),
-						 resWrap))
-	  | otherwise = returnDs id
-    in
-    augmentResultDs				     `thenDs` \ augment -> 
-    topConDs					     `thenDs` \ topCon -> 
-    boxResult augment topCon io_res_ty `thenDs` \ (ccall_result_ty, res_wrapper) ->
-
-    newUnique					`thenDs` \ ccall_uniq ->
-    newUnique					`thenDs` \ work_uniq ->
-    let
-	-- Build the worker
-	worker_ty     = mkForAllTys tvs (mkFunTys (map idType work_arg_ids) ccall_result_ty)
- 	the_ccall_app = mkFCall ccall_uniq fcall val_args ccall_result_ty
-	work_rhs      = mkLams tvs (mkLams work_arg_ids the_ccall_app)
-	work_id       = setImpInline no_hdrs $	-- See comments with setImpInline
-			mkSysLocal FSLIT("$wccall") work_uniq worker_ty
-
-	-- Build the wrapper
-	work_app     = mkApps (mkVarApps (Var work_id) tvs) val_args
-	wrapper_body = foldr ($) (res_wrapper work_app) arg_wrappers
-        wrap_rhs     = mkInlineMe (mkLams (tvs ++ args) wrapper_body)
-    in
-    returnDs ([(work_id, work_rhs), (fn_id, wrap_rhs)], empty, empty)
-
-unsafe_call (CCall (CCallSpec _ _ safety)) = playSafe safety
-unsafe_call (DNCall _)			   = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Foreign export}
-%*									*
-%************************************************************************
-
-The function that does most of the work for `@foreign export@' declarations.
-(see below for the boilerplate code a `@foreign export@' declaration expands
- into.)
-
-For each `@foreign export foo@' in a module M we generate:
-\begin{itemize}
-\item a C function `@foo@', which calls
-\item a Haskell stub `@M.$ffoo@', which calls
-\end{itemize}
-the user-written Haskell function `@M.foo@'.
-
-\begin{code}
-dsFExport :: Id			-- Either the exported Id, 
-				-- or the foreign-export-dynamic constructor
-	  -> Type		-- The type of the thing callable from C
-	  -> CLabelString	-- The name to export to C land
-	  -> CCallConv
-	  -> Bool		-- True => foreign export dynamic
-				-- 	   so invoke IO action that's hanging off 
-				-- 	   the first argument's stable pointer
-	  -> DsM ( SDoc		-- contents of Module_stub.h
-		 , SDoc		-- contents of Module_stub.c
-		 , [MachRep]    -- primitive arguments expected by stub function
-		 , Int		-- size of args to stub function
-		 )
-
-dsFExport fn_id ty ext_name cconv isDyn
-   = 
-     let
-        (_tvs,sans_foralls)		= tcSplitForAllTys ty
-        (fe_arg_tys', orig_res_ty)	= tcSplitFunTys sans_foralls
-	-- We must use tcSplits here, because we want to see 
-	-- the (IO t) in the corner of the type!
-        fe_arg_tys | isDyn     = tail fe_arg_tys'
-                   | otherwise = fe_arg_tys'
-     in
-	-- Look at the result type of the exported function, orig_res_ty
-	-- If it's IO t, return		(t, True)
-	-- If it's plain t, return	(t, False)
-     (case tcSplitTyConApp_maybe orig_res_ty of
-	-- We must use tcSplit here so that we see the (IO t) in
-	-- the type.  [IO t is transparent to plain splitTyConApp.]
-
-	Just (ioTyCon, [res_ty])
-	      -> ASSERT( ioTyCon `hasKey` ioTyConKey )
-		 -- The function already returns IO t
-		 returnDs (res_ty, True)
-
-	other -> -- The function returns t
-	         returnDs (orig_res_ty, False)
-     )
-					`thenDs` \ (res_ty,		-- t
-						    is_IO_res_ty) ->	-- Bool
-     returnDs $
-       mkFExportCBits ext_name 
-                      (if isDyn then Nothing else Just fn_id)
-                      fe_arg_tys res_ty is_IO_res_ty cconv
-\end{code}
-
-@foreign export dynamic@ lets you dress up Haskell IO actions
-of some fixed type behind an externally callable interface (i.e.,
-as a C function pointer). Useful for callbacks and stuff.
-
-\begin{verbatim}
-foreign export dynamic f :: (Addr -> Int -> IO Int) -> IO Addr
-
--- Haskell-visible constructor, which is generated from the above:
--- SUP: No check for NULL from createAdjustor anymore???
-
-f :: (Addr -> Int -> IO Int) -> IO Addr
-f cback =
-   bindIO (newStablePtr cback)
-          (\StablePtr sp# -> IO (\s1# ->
-              case _ccall_ createAdjustor cconv sp# ``f_helper'' s1# of
-                 (# s2#, a# #) -> (# s2#, A# a# #)))
-
-foreign export "f_helper" f_helper :: StablePtr (Addr -> Int -> IO Int) -> Addr -> Int -> IO Int
--- `special' foreign export that invokes the closure pointed to by the
--- first argument.
-\end{verbatim}
-
-\begin{code}
-dsFExportDynamic :: Id
-		 -> CCallConv
-		 -> DsM ([Binding], SDoc, SDoc)
-dsFExportDynamic id cconv
-  =  newSysLocalDs ty				 `thenDs` \ fe_id ->
-     getModuleDs				`thenDs` \ mod_name -> 
-     let 
-        -- hack: need to get at the name of the C stub we're about to generate.
-       fe_nm	   = mkFastString (unpackFS (zEncodeFS (moduleFS mod_name)) ++ "_" ++ toCName fe_id)
-     in
-     newSysLocalDs arg_ty			`thenDs` \ cback ->
-     dsLookupGlobalId newStablePtrName		`thenDs` \ newStablePtrId ->
-     dsLookupTyCon stablePtrTyConName		`thenDs` \ stable_ptr_tycon ->
-     let
-	mk_stbl_ptr_app = mkApps (Var newStablePtrId) [ Type arg_ty, Var cback ]
-	stable_ptr_ty	= mkTyConApp stable_ptr_tycon [arg_ty]
-	export_ty	= mkFunTy stable_ptr_ty arg_ty
-     in
-     dsLookupGlobalId bindIOName		`thenDs` \ bindIOId ->
-     newSysLocalDs stable_ptr_ty		`thenDs` \ stbl_value ->
-     dsFExport id export_ty fe_nm cconv True  	
-		`thenDs` \ (h_code, c_code, arg_reps, args_size) ->
-     let
-      stbl_app cont ret_ty = mkApps (Var bindIOId)
-				    [ Type stable_ptr_ty
-				    , Type ret_ty       
-				    , mk_stbl_ptr_app
-				    , cont
-				    ]
-       {-
-        The arguments to the external function which will
-	create a little bit of (template) code on the fly
-	for allowing the (stable pointed) Haskell closure
-	to be entered using an external calling convention
-	(stdcall, ccall).
-       -}
-      adj_args      = [ mkIntLitInt (ccallConvToInt cconv)
-		      , Var stbl_value
-		      , mkLit (MachLabel fe_nm mb_sz_args)
-                      , mkLit (mkStringLit arg_type_info)
-		      ]
-        -- name of external entry point providing these services.
-	-- (probably in the RTS.) 
-      adjustor	 = FSLIT("createAdjustor")
-      
-      arg_type_info = map repCharCode arg_reps
-      repCharCode F32 = 'f'
-      repCharCode F64 = 'd'
-      repCharCode I64 = 'l'
-      repCharCode _   = 'i'
-
-	-- Determine the number of bytes of arguments to the stub function,
-	-- so that we can attach the '@N' suffix to its label if it is a
-	-- stdcall on Windows.
-      mb_sz_args = case cconv of
-		      StdCallConv -> Just args_size
-		      _ 	  -> Nothing
-
-     in
-     dsCCall adjustor adj_args PlayRisky io_res_ty	`thenDs` \ ccall_adj ->
-	-- PlayRisky: the adjustor doesn't allocate in the Haskell heap or do a callback
-     let ccall_adj_ty = exprType ccall_adj
-         ccall_io_adj = mkLams [stbl_value]		     $
-			Note (Coerce io_res_ty ccall_adj_ty)
-			     ccall_adj
-         io_app = mkLams tvs	 $
-		  mkLams [cback] $
-		  stbl_app ccall_io_adj res_ty
-	 fed = (id `setInlinePragma` NeverActive, io_app)
-		-- Never inline the f.e.d. function, because the litlit
-		-- might not be in scope in other modules.
-     in
-     returnDs ([fed], h_code, c_code)
-
- where
-  ty			= idType id
-  (tvs,sans_foralls)	= tcSplitForAllTys ty
-  ([arg_ty], io_res_ty)	= tcSplitFunTys sans_foralls
-  [res_ty]		= tcTyConAppArgs io_res_ty
-	-- Must use tcSplit* to see the (IO t), which is a newtype
-
-toCName :: Id -> String
-toCName i = showSDoc (pprCode CStyle (ppr (idName i)))
-\end{code}
-
-%*
-%
-\subsection{Generating @foreign export@ stubs}
-%
-%*
-
-For each @foreign export@ function, a C stub function is generated.
-The C stub constructs the application of the exported Haskell function 
-using the hugs/ghc rts invocation API.
-
-\begin{code}
-mkFExportCBits :: FastString
-	       -> Maybe Id 	-- Just==static, Nothing==dynamic
-	       -> [Type] 
-	       -> Type 
-               -> Bool		-- True <=> returns an IO type
-	       -> CCallConv 
-	       -> (SDoc, 
-		   SDoc,
-		   [MachRep], 	-- the argument reps
-		   Int		-- total size of arguments
-		  )
-mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc 
- = (header_bits, c_bits, 
-    [rep | (_,_,_,rep) <- arg_info],  -- just the real args
-    sum [ machRepByteWidth rep | (_,_,_,rep) <- aug_arg_info] -- all the args
-    )
- where
-  -- list the arguments to the C function
-  arg_info :: [(SDoc, 		-- arg name
-		SDoc,		-- C type
-	        Type,		-- Haskell type
-		MachRep)]	-- the MachRep
-  arg_info  = [ (text ('a':show n), showStgType ty, ty, 
-		 typeMachRep (getPrimTyOf ty))
-	      | (ty,n) <- zip arg_htys [1..] ]
-
-  -- add some auxiliary args; the stable ptr in the wrapper case, and
-  -- a slot for the dummy return address in the wrapper + ccall case
-  aug_arg_info
-    | isNothing maybe_target = stable_ptr_arg : insertRetAddr cc arg_info
-    | otherwise              = arg_info
-
-  stable_ptr_arg = 
-	(text "the_stableptr", text "StgStablePtr", undefined,
-	 typeMachRep (mkStablePtrPrimTy alphaTy))
-
-  -- stuff to do with the return type of the C function
-  res_hty_is_unit = res_hty `coreEqType` unitTy	-- Look through any newtypes
-
-  cResType | res_hty_is_unit = text "void"
-	   | otherwise	     = showStgType res_hty
-
-  -- Now we can cook up the prototype for the exported function.
-  pprCconv = case cc of
-		CCallConv   -> empty
-		StdCallConv -> text (ccallConvAttribute cc)
-
-  header_bits = ptext SLIT("extern") <+> fun_proto <> semi
-
-  fun_proto = cResType <+> pprCconv <+> ftext c_nm <>
-	      parens (hsep (punctuate comma (map (\(nm,ty,_,_) -> ty <+> nm) 
-                                                 aug_arg_info)))
-
-  -- the target which will form the root of what we ask rts_evalIO to run
-  the_cfun
-     = case maybe_target of
-          Nothing    -> text "(StgClosure*)deRefStablePtr(the_stableptr)"
-          Just hs_fn -> char '&' <> ppr hs_fn <> text "_closure"
-
-  cap = text "cap" <> comma
-
-  -- the expression we give to rts_evalIO
-  expr_to_run
-     = foldl appArg the_cfun arg_info -- NOT aug_arg_info
-       where
-          appArg acc (arg_cname, _, arg_hty, _) 
-             = text "rts_apply" 
-               <> parens (cap <> acc <> comma <> mkHObj arg_hty <> parens (cap <> arg_cname))
-
-  -- various other bits for inside the fn
-  declareResult = text "HaskellObj ret;"
-  declareCResult | res_hty_is_unit = empty
-                 | otherwise       = cResType <+> text "cret;"
-
-  assignCResult | res_hty_is_unit = empty
-	        | otherwise       =
-	        	text "cret=" <> unpackHObj res_hty <> parens (text "ret") <> semi
-
-  -- an extern decl for the fn being called
-  extern_decl
-     = case maybe_target of
-          Nothing -> empty
-          Just hs_fn -> text "extern StgClosure " <> ppr hs_fn <> text "_closure" <> semi
-
-   
-   -- Initialise foreign exports by registering a stable pointer from an
-   -- __attribute__((constructor)) function.
-   -- The alternative is to do this from stginit functions generated in
-   -- codeGen/CodeGen.lhs; however, stginit functions have a negative impact
-   -- on binary sizes and link times because the static linker will think that
-   -- all modules that are imported directly or indirectly are actually used by
-   -- the program.
-   -- (this is bad for big umbrella modules like Graphics.Rendering.OpenGL)
-
-  initialiser
-     = case maybe_target of
-          Nothing -> empty
-          Just hs_fn ->
-            vcat
-             [ text "static void stginit_export_" <> ppr hs_fn
-                  <> text "() __attribute__((constructor));"
-             , text "static void stginit_export_" <> ppr hs_fn <> text "()"
-             , braces (text "getStablePtr"
-                <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure")
-                <> semi)
-             ]
-
-  -- finally, the whole darn thing
-  c_bits =
-    space $$
-    extern_decl $$
-    fun_proto  $$
-    vcat 
-     [ lbrace
-     ,   text "Capability *cap;"
-     ,   declareResult
-     ,   declareCResult
-     ,   text "cap = rts_lock();"
-	  -- create the application + perform it.
-     ,   text "cap=rts_evalIO" <> parens (
-		cap <>
-		text "rts_apply" <> parens (
-		    cap <>
-		    text "(HaskellObj)"
-	         <> text (if is_IO_res_ty 
-				then "runIO_closure" 
-				else "runNonIO_closure")
-		 <> comma
-        	 <> expr_to_run
-		) <+> comma
-	       <> text "&ret"
-	     ) <> semi
-     ,   text "rts_checkSchedStatus" <> parens (doubleQuotes (ftext c_nm)
-						<> comma <> text "cap") <> semi
-     ,   assignCResult
-     ,   text "rts_unlock(cap);"
-     ,   if res_hty_is_unit then empty
-            else text "return cret;"
-     , rbrace
-     ] $$
-    initialiser
-
--- NB. the calculation here isn't strictly speaking correct.
--- We have a primitive Haskell type (eg. Int#, Double#), and
--- we want to know the size, when passed on the C stack, of
--- the associated C type (eg. HsInt, HsDouble).  We don't have
--- this information to hand, but we know what GHC's conventions
--- are for passing around the primitive Haskell types, so we
--- use that instead.  I hope the two coincide --SDM
-typeMachRep ty = argMachRep (typeCgRep ty)
-
-mkHObj :: Type -> SDoc
-mkHObj t = text "rts_mk" <> text (showFFIType t)
-
-unpackHObj :: Type -> SDoc
-unpackHObj t = text "rts_get" <> text (showFFIType t)
-
-showStgType :: Type -> SDoc
-showStgType t = text "Hs" <> text (showFFIType t)
-
-showFFIType :: Type -> String
-showFFIType t = getOccString (getName tc)
- where
-  tc = case tcSplitTyConApp_maybe (repType t) of
-	    Just (tc,_) -> tc
-	    Nothing	-> pprPanic "showFFIType" (ppr t)
-
-#if !defined(x86_64_TARGET_ARCH)
-insertRetAddr CCallConv args = ret_addr_arg : args
-insertRetAddr _ args = args
-#else
--- On x86_64 we insert the return address after the 6th
--- integer argument, because this is the point at which we
--- need to flush a register argument to the stack (See rts/Adjustor.c for
--- details).
-insertRetAddr CCallConv args = go 0 args
-  where  go 6 args = ret_addr_arg : args
-	 go n (arg@(_,_,_,rep):args)
-	  | I64 <- rep = arg : go (n+1) args
-	  | otherwise  = arg : go n     args
-	 go n [] = []
-insertRetAddr _ args = args
-#endif
-
-ret_addr_arg = (text "original_return_addr", text "void*", undefined, 
-		typeMachRep addrPrimTy)
-
--- This function returns the primitive type associated with the boxed
--- type argument to a foreign export (eg. Int ==> Int#).  It assumes
--- that all the types we are interested in have a single constructor
--- with a single primitive-typed argument, which is true for all of the legal
--- foreign export argument types (see TcType.legalFEArgTyCon).
-getPrimTyOf :: Type -> Type
-getPrimTyOf ty =
-  case splitProductType_maybe (repType ty) of
-     Just (_, _, data_con, [prim_ty]) ->
-	ASSERT(dataConSourceArity data_con == 1)
-	ASSERT2(isUnLiftedType prim_ty, ppr prim_ty)
-	prim_ty
-     _other -> pprPanic "DsForeign.getPrimTyOf" (ppr ty)
-\end{code}
diff --git a/ghc/compiler/deSugar/DsGRHSs.lhs b/ghc/compiler/deSugar/DsGRHSs.lhs
deleted file mode 100644
index eea61bafb2..0000000000
--- a/ghc/compiler/deSugar/DsGRHSs.lhs
+++ /dev/null
@@ -1,128 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[DsGRHSs]{Matching guarded right-hand-sides (GRHSs)}
-
-\begin{code}
-module DsGRHSs ( dsGuarded, dsGRHSs ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} DsExpr  ( dsLExpr, dsLocalBinds )
-import {-# SOURCE #-} Match   ( matchSinglePat )
-
-import HsSyn		( Stmt(..), HsExpr(..), GRHSs(..), GRHS(..), 
-			  LHsExpr, HsMatchContext(..), Pat(..) )
-import CoreSyn		( CoreExpr )
-import Var		( Id )
-import Type		( Type )
-
-import DsMonad
-import DsUtils
-import Unique		( Uniquable(..) )
-import PrelInfo		( nON_EXHAUSTIVE_GUARDS_ERROR_ID )
-import TysWiredIn	( trueDataConId )
-import PrelNames	( otherwiseIdKey, hasKey )
-import Name		( Name )
-import SrcLoc		( unLoc, Located(..) )
-\end{code}
-
-@dsGuarded@ is used for both @case@ expressions and pattern bindings.
-It desugars:
-\begin{verbatim}
-	| g1 -> e1
-	...
-	| gn -> en
-	where binds
-\end{verbatim}
-producing an expression with a runtime error in the corner if
-necessary.  The type argument gives the type of the @ei@.
-
-\begin{code}
-dsGuarded :: GRHSs Id -> Type -> DsM CoreExpr
-
-dsGuarded grhss rhs_ty
-  = dsGRHSs PatBindRhs [] grhss rhs_ty 				`thenDs` \ match_result ->
-    mkErrorAppDs nON_EXHAUSTIVE_GUARDS_ERROR_ID rhs_ty ""	`thenDs` \ error_expr ->
-    extractMatchResult match_result error_expr
-\end{code}
-
-In contrast, @dsGRHSs@ produces a @MatchResult@.
-
-\begin{code}
-dsGRHSs :: HsMatchContext Name -> [Pat Id]	-- These are to build a MatchContext from
-	-> GRHSs Id				-- Guarded RHSs
-	-> Type					-- Type of RHS
-	-> DsM MatchResult
-
-dsGRHSs hs_ctx pats (GRHSs grhss binds) rhs_ty
-  = mappM (dsGRHS hs_ctx pats rhs_ty) grhss	`thenDs` \ match_results ->
-    let 
-	match_result1 = foldr1 combineMatchResults match_results
-	match_result2 = adjustMatchResultDs (dsLocalBinds binds) match_result1
-		-- NB: nested dsLet inside matchResult
-    in
-    returnDs match_result2
-
-dsGRHS hs_ctx pats rhs_ty (L loc (GRHS guards rhs))
-  = matchGuards (map unLoc guards) hs_ctx rhs rhs_ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-%*  matchGuard : make a MatchResult from a guarded RHS			*
-%*									*
-%************************************************************************
-
-\begin{code}
-matchGuards :: [Stmt Id] 		-- Guard
-            -> HsMatchContext Name	-- Context
-	    -> LHsExpr Id		-- RHS
-	    -> Type			-- Type of RHS of guard
-	    -> DsM MatchResult
-
--- See comments with HsExpr.Stmt re what an ExprStmt means
--- Here we must be in a guard context (not do-expression, nor list-comp)	
-
-matchGuards [] ctx rhs rhs_ty
-  = do	{ core_rhs <- dsLExpr rhs
-	; return (cantFailMatchResult core_rhs) }
-
-	-- ExprStmts must be guards
-	-- Turn an "otherwise" guard is a no-op.  This ensures that 
-	-- you don't get a "non-exhaustive eqns" message when the guards 
-	-- finish in "otherwise".
-	-- NB:	The success of this clause depends on the typechecker not
-	-- 	wrapping the 'otherwise' in empty HsTyApp or HsCoerce constructors
-	--	If it does, you'll get bogus overlap warnings
-matchGuards (ExprStmt (L _ (HsVar v)) _ _ : stmts) ctx rhs rhs_ty
-  |  v `hasKey` otherwiseIdKey
-  || v `hasKey` getUnique trueDataConId	
-	-- trueDataConId doesn't have the same unique as trueDataCon
-  = matchGuards stmts ctx rhs rhs_ty
-
-matchGuards (ExprStmt expr _ _ : stmts) ctx rhs rhs_ty
-  = matchGuards stmts ctx rhs rhs_ty	`thenDs` \ match_result ->
-    dsLExpr expr			`thenDs` \ pred_expr ->
-    returnDs (mkGuardedMatchResult pred_expr match_result)
-
-matchGuards (LetStmt binds : stmts) ctx rhs rhs_ty
-  = matchGuards stmts ctx rhs rhs_ty	`thenDs` \ match_result ->
-    returnDs (adjustMatchResultDs (dsLocalBinds binds) match_result)
-	-- NB the dsLet occurs inside the match_result
-	-- Reason: dsLet takes the body expression as its argument
-	--	   so we can't desugar the bindings without the
-	--	   body expression in hand
-
-matchGuards (BindStmt pat bind_rhs _ _ : stmts) ctx rhs rhs_ty
-  = matchGuards stmts ctx rhs rhs_ty	`thenDs` \ match_result ->
-    dsLExpr bind_rhs			`thenDs` \ core_rhs ->
-    matchSinglePat core_rhs ctx pat rhs_ty match_result
-\end{code}
-
-Should {\em fail} if @e@ returns @D@
-\begin{verbatim}
-f x | p <- e', let C y# = e, f y# = r1
-    | otherwise 	 = r2 
-\end{verbatim}
diff --git a/ghc/compiler/deSugar/DsListComp.lhs b/ghc/compiler/deSugar/DsListComp.lhs
deleted file mode 100644
index 6bb41a92e4..0000000000
--- a/ghc/compiler/deSugar/DsListComp.lhs
+++ /dev/null
@@ -1,516 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[DsListComp]{Desugaring list comprehensions and array comprehensions}
-
-\begin{code}
-module DsListComp ( dsListComp, dsPArrComp ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} DsExpr ( dsLExpr, dsLocalBinds )
-
-import BasicTypes	( Boxity(..) )
-import HsSyn
-import TcHsSyn		( hsPatType, mkVanillaTuplePat )
-import CoreSyn
-
-import DsMonad		-- the monadery used in the desugarer
-import DsUtils
-
-import DynFlags		( DynFlag(..), dopt )
-import StaticFlags	( opt_RulesOff )
-import CoreUtils	( exprType, mkIfThenElse )
-import Id		( idType )
-import Var              ( Id )
-import Type		( mkTyVarTy, mkFunTys, mkFunTy, Type,
-			  splitTyConApp_maybe )
-import TysPrim		( alphaTyVar )
-import TysWiredIn	( nilDataCon, consDataCon, trueDataConId, falseDataConId, 
-			  unitDataConId, unitTy, mkListTy, parrTyCon )
-import Match		( matchSimply )
-import PrelNames	( foldrName, buildName, replicatePName, mapPName, 
-			  filterPName, zipPName, crossPName ) 
-import PrelInfo		( pAT_ERROR_ID )
-import SrcLoc		( noLoc, unLoc )
-import Panic		( panic )
-\end{code}
-
-List comprehensions may be desugared in one of two ways: ``ordinary''
-(as you would expect if you read SLPJ's book) and ``with foldr/build
-turned on'' (if you read Gill {\em et al.}'s paper on the subject).
-
-There will be at least one ``qualifier'' in the input.
-
-\begin{code}
-dsListComp :: [LStmt Id] 
-	   -> LHsExpr Id
-	   -> Type		-- Type of list elements
-	   -> DsM CoreExpr
-dsListComp lquals body elt_ty
-  = getDOptsDs  `thenDs` \dflags ->
-    let
-	quals = map unLoc lquals
-    in
-    if opt_RulesOff || dopt Opt_IgnoreInterfacePragmas dflags
-	-- Either rules are switched off, or we are ignoring what there are;
-	-- Either way foldr/build won't happen, so use the more efficient
-	-- Wadler-style desugaring
-  	|| isParallelComp quals
-		-- Foldr-style desugaring can't handle
-		-- parallel list comprehensions
-  	then deListComp quals body (mkNilExpr elt_ty)
-
-   else		-- Foldr/build should be enabled, so desugar 
-		-- into foldrs and builds
-    newTyVarsDs [alphaTyVar]    `thenDs` \ [n_tyvar] ->
-    let
-	n_ty = mkTyVarTy n_tyvar
-        c_ty = mkFunTys [elt_ty, n_ty] n_ty
-    in
-    newSysLocalsDs [c_ty,n_ty]		`thenDs` \ [c, n] ->
-    dfListComp c n quals body		`thenDs` \ result ->
-    dsLookupGlobalId buildName	`thenDs` \ build_id ->
-    returnDs (Var build_id `App` Type elt_ty 
-			   `App` mkLams [n_tyvar, c, n] result)
-
-  where isParallelComp (ParStmt bndrstmtss : _) = True
-	isParallelComp _                        = False
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[DsListComp-ordinary]{Ordinary desugaring of list comprehensions}
-%*									*
-%************************************************************************
-
-Just as in Phil's chapter~7 in SLPJ, using the rules for
-optimally-compiled list comprehensions.  This is what Kevin followed
-as well, and I quite happily do the same.  The TQ translation scheme
-transforms a list of qualifiers (either boolean expressions or
-generators) into a single expression which implements the list
-comprehension.  Because we are generating 2nd-order polymorphic
-lambda-calculus, calls to NIL and CONS must be applied to a type
-argument, as well as their usual value arguments.
-\begin{verbatim}
-TE << [ e | qs ] >>  =  TQ << [ e | qs ] ++ Nil (typeOf e) >>
-
-(Rule C)
-TQ << [ e | ] ++ L >> = Cons (typeOf e) TE <<e>> TE <<L>>
-
-(Rule B)
-TQ << [ e | b , qs ] ++ L >> =
-    if TE << b >> then TQ << [ e | qs ] ++ L >> else TE << L >>
-
-(Rule A')
-TQ << [ e | p <- L1, qs ]  ++  L2 >> =
-  letrec
-    h = \ u1 ->
-    	  case u1 of
-	    []        ->  TE << L2 >>
-	    (u2 : u3) ->
-		  (( \ TE << p >> -> ( TQ << [e | qs]  ++  (h u3) >> )) u2)
-		    [] (h u3)
-  in
-    h ( TE << L1 >> )
-
-"h", "u1", "u2", and "u3" are new variables.
-\end{verbatim}
-
-@deListComp@ is the TQ translation scheme.  Roughly speaking, @dsExpr@
-is the TE translation scheme.  Note that we carry around the @L@ list
-already desugared.  @dsListComp@ does the top TE rule mentioned above.
-
-To the above, we add an additional rule to deal with parallel list
-comprehensions.  The translation goes roughly as follows:
-     [ e | p1 <- e11, let v1 = e12, p2 <- e13
-         | q1 <- e21, let v2 = e22, q2 <- e23]
-     =>
-     [ e | ((x1, .., xn), (y1, ..., ym)) <-
-               zip [(x1,..,xn) | p1 <- e11, let v1 = e12, p2 <- e13]
-                   [(y1,..,ym) | q1 <- e21, let v2 = e22, q2 <- e23]]
-where (x1, .., xn) are the variables bound in p1, v1, p2
-      (y1, .., ym) are the variables bound in q1, v2, q2
-
-In the translation below, the ParStmt branch translates each parallel branch
-into a sub-comprehension, and desugars each independently.  The resulting lists
-are fed to a zip function, we create a binding for all the variables bound in all
-the comprehensions, and then we hand things off the the desugarer for bindings.
-The zip function is generated here a) because it's small, and b) because then we
-don't have to deal with arbitrary limits on the number of zip functions in the
-prelude, nor which library the zip function came from.
-The introduced tuples are Boxed, but only because I couldn't get it to work
-with the Unboxed variety.
-
-\begin{code}
-deListComp :: [Stmt Id] -> LHsExpr Id -> CoreExpr -> DsM CoreExpr
-
-deListComp (ParStmt stmtss_w_bndrs : quals) body list
-  = mappM do_list_comp stmtss_w_bndrs	`thenDs` \ exps ->
-    mkZipBind qual_tys			`thenDs` \ (zip_fn, zip_rhs) ->
-
-	-- Deal with [e | pat <- zip l1 .. ln] in example above
-    deBindComp pat (Let (Rec [(zip_fn, zip_rhs)]) (mkApps (Var zip_fn) exps)) 
-		   quals body list
-
-  where 
-	bndrs_s = map snd stmtss_w_bndrs
-
-	-- pat is the pattern ((x1,..,xn), (y1,..,ym)) in the example above
-	pat	 = mkTuplePat pats
-	pats	 = map mk_hs_tuple_pat bndrs_s
-
-	-- Types of (x1,..,xn), (y1,..,yn) etc
-	qual_tys = map mk_bndrs_tys bndrs_s
-
-	do_list_comp (stmts, bndrs)
-	  = dsListComp stmts (mk_hs_tuple_expr bndrs)
-		       (mk_bndrs_tys bndrs)
-
-	mk_bndrs_tys bndrs = mkCoreTupTy (map idType bndrs)
-
-	-- Last: the one to return
-deListComp [] body list		-- Figure 7.4, SLPJ, p 135, rule C above
-  = dsLExpr body		`thenDs` \ core_body ->
-    returnDs (mkConsExpr (exprType core_body) core_body list)
-
-	-- Non-last: must be a guard
-deListComp (ExprStmt guard _ _ : quals) body list	-- rule B above
-  = dsLExpr guard      		`thenDs` \ core_guard ->
-    deListComp quals body list	`thenDs` \ core_rest ->
-    returnDs (mkIfThenElse core_guard core_rest list)
-
--- [e | let B, qs] = let B in [e | qs]
-deListComp (LetStmt binds : quals) body list
-  = deListComp quals body list	`thenDs` \ core_rest ->
-    dsLocalBinds binds core_rest
-
-deListComp (BindStmt pat list1 _ _ : quals) body core_list2 -- rule A' above
-  = dsLExpr list1		    `thenDs` \ core_list1 ->
-    deBindComp pat core_list1 quals body core_list2
-\end{code}
-
-
-\begin{code}
-deBindComp pat core_list1 quals body core_list2
-  = let
-	u3_ty@u1_ty = exprType core_list1	-- two names, same thing
-
-	-- u1_ty is a [alpha] type, and u2_ty = alpha
-	u2_ty = hsPatType pat
-
-	res_ty = exprType core_list2
-	h_ty   = u1_ty `mkFunTy` res_ty
-    in
-    newSysLocalsDs [h_ty, u1_ty, u2_ty, u3_ty]	`thenDs` \ [h, u1, u2, u3] ->
-
-    -- the "fail" value ...
-    let
-	core_fail   = App (Var h) (Var u3)
-	letrec_body = App (Var h) core_list1
-    in
-    deListComp quals body core_fail		`thenDs` \ rest_expr ->
-    matchSimply (Var u2) (StmtCtxt ListComp) pat
-		rest_expr core_fail		`thenDs` \ core_match ->
-    let
-	rhs = Lam u1 $
-	      Case (Var u1) u1 res_ty
-		   [(DataAlt nilDataCon,  [], 	    core_list2),
-		    (DataAlt consDataCon, [u2, u3], core_match)]
-			-- Increasing order of tag
-    in
-    returnDs (Let (Rec [(h, rhs)]) letrec_body)
-\end{code}
-
-
-\begin{code}
-mkZipBind :: [Type] -> DsM (Id, CoreExpr)
--- mkZipBind [t1, t2] 
--- = (zip, \as1:[t1] as2:[t2] 
---	   -> case as1 of 
---		[] -> []
---		(a1:as'1) -> case as2 of
---				[] -> []
---				(a2:as'2) -> (a2,a2) : zip as'1 as'2)]
-
-mkZipBind elt_tys 
-  = mappM newSysLocalDs  list_tys	`thenDs` \ ass ->
-    mappM newSysLocalDs  elt_tys	`thenDs` \ as' ->
-    mappM newSysLocalDs  list_tys	`thenDs` \ as's ->
-    newSysLocalDs zip_fn_ty		`thenDs` \ zip_fn ->
-    let 
-	inner_rhs = mkConsExpr ret_elt_ty 
-			(mkCoreTup (map Var as'))
-			(mkVarApps (Var zip_fn) as's)
-	zip_body  = foldr mk_case inner_rhs (zip3 ass as' as's)
-    in
-    returnDs (zip_fn, mkLams ass zip_body)
-  where
-    list_tys    = map mkListTy elt_tys
-    ret_elt_ty  = mkCoreTupTy elt_tys
-    list_ret_ty = mkListTy ret_elt_ty
-    zip_fn_ty   = mkFunTys list_tys list_ret_ty
-
-    mk_case (as, a', as') rest
-	  = Case (Var as) as list_ret_ty
-		  [(DataAlt nilDataCon,  [],        mkNilExpr ret_elt_ty),
-		   (DataAlt consDataCon, [a', as'], rest)]
-			-- Increasing order of tag
--- Helper functions that makes an HsTuple only for non-1-sized tuples
-mk_hs_tuple_expr :: [Id] -> LHsExpr Id
-mk_hs_tuple_expr []   = nlHsVar unitDataConId
-mk_hs_tuple_expr [id] = nlHsVar id
-mk_hs_tuple_expr ids  = noLoc $ ExplicitTuple [ nlHsVar i | i <- ids ] Boxed
-
-mk_hs_tuple_pat :: [Id] -> LPat Id
-mk_hs_tuple_pat bs  = mkTuplePat (map nlVarPat bs)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[DsListComp-foldr-build]{Foldr/Build desugaring of list comprehensions}
-%*									*
-%************************************************************************
-
-@dfListComp@ are the rules used with foldr/build turned on:
-
-\begin{verbatim}
-TE[ e | ]            c n = c e n
-TE[ e | b , q ]      c n = if b then TE[ e | q ] c n else n
-TE[ e | p <- l , q ] c n = let 
-				f = \ x b -> case x of
-						  p -> TE[ e | q ] c b
-						  _ -> b
-			   in
-			   foldr f n l
-\end{verbatim}
-
-\begin{code}
-dfListComp :: Id -> Id			-- 'c' and 'n'
-	   -> [Stmt Id] 	-- the rest of the qual's
-	   -> LHsExpr Id
-	   -> DsM CoreExpr
-
-	-- Last: the one to return
-dfListComp c_id n_id [] body
-  = dsLExpr body		`thenDs` \ core_body ->
-    returnDs (mkApps (Var c_id) [core_body, Var n_id])
-
-	-- Non-last: must be a guard
-dfListComp c_id n_id (ExprStmt guard _ _  : quals) body
-  = dsLExpr guard              		`thenDs` \ core_guard ->
-    dfListComp c_id n_id quals body	`thenDs` \ core_rest ->
-    returnDs (mkIfThenElse core_guard core_rest (Var n_id))
-
-dfListComp c_id n_id (LetStmt binds : quals) body
-  -- new in 1.3, local bindings
-  = dfListComp c_id n_id quals body	`thenDs` \ core_rest ->
-    dsLocalBinds binds core_rest
-
-dfListComp c_id n_id (BindStmt pat list1 _ _ : quals) body
-    -- evaluate the two lists
-  = dsLExpr list1			`thenDs` \ core_list1 ->
-
-    -- find the required type
-    let x_ty   = hsPatType pat
-	b_ty   = idType n_id
-    in
-
-    -- create some new local id's
-    newSysLocalsDs [b_ty,x_ty]			`thenDs` \ [b,x] ->
-
-    -- build rest of the comprehesion
-    dfListComp c_id b quals body		`thenDs` \ core_rest ->
-
-    -- build the pattern match
-    matchSimply (Var x) (StmtCtxt ListComp)
-		pat core_rest (Var b)		`thenDs` \ core_expr ->
-
-    -- now build the outermost foldr, and return
-    dsLookupGlobalId foldrName		`thenDs` \ foldr_id ->
-    returnDs (
-      Var foldr_id `App` Type x_ty 
-		   `App` Type b_ty
-		   `App` mkLams [x, b] core_expr
-		   `App` Var n_id
-		   `App` core_list1
-    )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[DsPArrComp]{Desugaring of array comprehensions}
-%*									*
-%************************************************************************
-
-\begin{code}
-
--- entry point for desugaring a parallel array comprehension
---
---   [:e | qss:] = <<[:e | qss:]>> () [:():]
---
-dsPArrComp      :: [Stmt Id] 
-		-> LHsExpr Id
-	        -> Type		    -- Don't use; called with `undefined' below
-	        -> DsM CoreExpr
-dsPArrComp qs body _  =
-  dsLookupGlobalId replicatePName			  `thenDs` \repP ->
-  let unitArray = mkApps (Var repP) [Type unitTy, 
-				     mkIntExpr 1, 
-				     mkCoreTup []]
-  in
-  dePArrComp qs body (mkTuplePat []) unitArray
-
--- the work horse
---
-dePArrComp :: [Stmt Id] 
-	   -> LHsExpr Id
-	   -> LPat Id		-- the current generator pattern
-	   -> CoreExpr		-- the current generator expression
-	   -> DsM CoreExpr
---
---  <<[:e' | :]>> pa ea = mapP (\pa -> e') ea
---
-dePArrComp [] e' pa cea =
-  dsLookupGlobalId mapPName				  `thenDs` \mapP    ->
-  let ty = parrElemType cea
-  in
-  deLambda ty pa e'					  `thenDs` \(clam, 
-								     ty'e') ->
-  returnDs $ mkApps (Var mapP) [Type ty, Type ty'e', clam, cea]
---
---  <<[:e' | b, qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea)
---
-dePArrComp (ExprStmt b _ _ : qs) body pa cea =
-  dsLookupGlobalId filterPName			  `thenDs` \filterP  ->
-  let ty = parrElemType cea
-  in
-  deLambda ty pa b				  `thenDs` \(clam,_) ->
-  dePArrComp qs body pa (mkApps (Var filterP) [Type ty, clam, cea])
---
---  <<[:e' | p <- e, qs:]>> pa ea = 
---    let ef = filterP (\x -> case x of {p -> True; _ -> False}) e
---    in
---    <<[:e' | qs:]>> (pa, p) (crossP ea ef)
---
-dePArrComp (BindStmt p e _ _ : qs) body pa cea =
-  dsLookupGlobalId filterPName			  `thenDs` \filterP ->
-  dsLookupGlobalId crossPName			  `thenDs` \crossP  ->
-  dsLExpr e					  `thenDs` \ce      ->
-  let ty'cea = parrElemType cea
-      ty'ce  = parrElemType ce
-      false  = Var falseDataConId
-      true   = Var trueDataConId
-  in
-  newSysLocalDs ty'ce					  `thenDs` \v       ->
-  matchSimply (Var v) (StmtCtxt PArrComp) p true false    `thenDs` \pred    ->
-  let cef    = mkApps (Var filterP) [Type ty'ce, mkLams [v] pred, ce]
-      ty'cef = ty'ce				-- filterP preserves the type
-      pa'    = mkTuplePat [pa, p]
-  in
-  dePArrComp qs body pa' (mkApps (Var crossP) [Type ty'cea, Type ty'cef, cea, cef])
---
---  <<[:e' | let ds, qs:]>> pa ea = 
---    <<[:e' | qs:]>> (pa, (x_1, ..., x_n)) 
---		      (mapP (\v@pa -> (v, let ds in (x_1, ..., x_n))) ea)
---  where
---    {x_1, ..., x_n} = DV (ds)		-- Defined Variables
---
-dePArrComp (LetStmt ds : qs) body pa cea =
-  dsLookupGlobalId mapPName				  `thenDs` \mapP    ->
-  let xs     = map unLoc (collectLocalBinders ds)
-      ty'cea = parrElemType cea
-  in
-  newSysLocalDs ty'cea					  `thenDs` \v       ->
-  dsLocalBinds ds (mkCoreTup (map Var xs))		  `thenDs` \clet    ->
-  newSysLocalDs (exprType clet)				  `thenDs` \let'v   ->
-  let projBody = mkDsLet (NonRec let'v clet) $ 
-		 mkCoreTup [Var v, Var let'v]
-      errTy    = exprType projBody
-      errMsg   = "DsListComp.dePArrComp: internal error!"
-  in
-  mkErrorAppDs pAT_ERROR_ID errTy errMsg                  `thenDs` \cerr    ->
-  matchSimply (Var v) (StmtCtxt PArrComp) pa projBody cerr`thenDs` \ccase   ->
-  let pa'    = mkTuplePat [pa, mkTuplePat (map nlVarPat xs)]
-      proj   = mkLams [v] ccase
-  in
-  dePArrComp qs body pa' (mkApps (Var mapP) [Type ty'cea, proj, cea])
---
---  <<[:e' | qs | qss:]>> pa ea = 
---    <<[:e' | qss:]>> (pa, (x_1, ..., x_n)) 
---		       (zipP ea <<[:(x_1, ..., x_n) | qs:]>>)
---    where
---      {x_1, ..., x_n} = DV (qs)
---
-dePArrComp (ParStmt qss : qs) body pa cea = 
-  dsLookupGlobalId crossPName				`thenDs` \crossP  ->
-  deParStmt qss						`thenDs` \(pQss, 
-								   ceQss) ->
-  let ty'cea   = parrElemType cea
-      ty'ceQss = parrElemType ceQss
-      pa'      = mkTuplePat [pa, pQss]
-  in
-  dePArrComp qs body pa' (mkApps (Var crossP) [Type ty'cea, Type ty'ceQss, 
-					       cea, ceQss])
-  where
-    deParStmt []             =
-      -- empty parallel statement lists have not source representation
-      panic "DsListComp.dePArrComp: Empty parallel list comprehension"
-    deParStmt ((qs, xs):qss) =          -- first statement
-      let res_expr = mkExplicitTuple (map nlHsVar xs)
-      in
-      dsPArrComp (map unLoc qs) res_expr undefined	  `thenDs` \cqs     ->
-      parStmts qss (mkTuplePat (map nlVarPat xs)) cqs
-    ---
-    parStmts []             pa cea = return (pa, cea)
-    parStmts ((qs, xs):qss) pa cea =    -- subsequent statements (zip'ed)
-      dsLookupGlobalId zipPName				  `thenDs` \zipP    ->
-      let pa'      = mkTuplePat [pa, mkTuplePat (map nlVarPat xs)]
-	  ty'cea   = parrElemType cea
-	  res_expr = mkExplicitTuple (map nlHsVar xs)
-      in
-      dsPArrComp (map unLoc qs) res_expr undefined	  `thenDs` \cqs     ->
-      let ty'cqs = parrElemType cqs
-	  cea'   = mkApps (Var zipP) [Type ty'cea, Type ty'cqs, cea, cqs]
-      in
-      parStmts qss pa' cea'
-
--- generate Core corresponding to `\p -> e'
---
-deLambda        :: Type			-- type of the argument
-		-> LPat Id		-- argument pattern
-		-> LHsExpr Id		-- body
-		-> DsM (CoreExpr, Type)
-deLambda ty p e  =
-  newSysLocalDs ty					  `thenDs` \v       ->
-  dsLExpr e						  `thenDs` \ce      ->
-  let errTy    = exprType ce
-      errMsg   = "DsListComp.deLambda: internal error!"
-  in
-  mkErrorAppDs pAT_ERROR_ID errTy errMsg                  `thenDs` \cerr    -> 
-  matchSimply (Var v) (StmtCtxt PArrComp) p ce cerr	  `thenDs` \res	    ->
-  returnDs (mkLams [v] res, errTy)
-
--- obtain the element type of the parallel array produced by the given Core
--- expression
---
-parrElemType   :: CoreExpr -> Type
-parrElemType e  = 
-  case splitTyConApp_maybe (exprType e) of
-    Just (tycon, [ty]) | tycon == parrTyCon -> ty
-    _							  -> panic
-      "DsListComp.parrElemType: not a parallel array type"
-
--- Smart constructor for source tuple patterns
---
-mkTuplePat :: [LPat Id] -> LPat Id
-mkTuplePat [lpat] = lpat
-mkTuplePat lpats  = noLoc $ mkVanillaTuplePat lpats Boxed
-
--- Smart constructor for source tuple expressions
---
-mkExplicitTuple :: [LHsExpr id] -> LHsExpr id
-mkExplicitTuple [lexp] = lexp
-mkExplicitTuple lexps  = noLoc $ ExplicitTuple lexps Boxed
-\end{code}
diff --git a/ghc/compiler/deSugar/DsMeta.hs b/ghc/compiler/deSugar/DsMeta.hs
deleted file mode 100644
index 88b0ba9c8e..0000000000
--- a/ghc/compiler/deSugar/DsMeta.hs
+++ /dev/null
@@ -1,1732 +0,0 @@
------------------------------------------------------------------------------
--- The purpose of this module is to transform an HsExpr into a CoreExpr which
--- when evaluated, returns a (Meta.Q Meta.Exp) computation analogous to the
--- input HsExpr. We do this in the DsM monad, which supplies access to
--- CoreExpr's of the "smart constructors" of the Meta.Exp datatype.
---
--- It also defines a bunch of knownKeyNames, in the same way as is done
--- in prelude/PrelNames.  It's much more convenient to do it here, becuase
--- otherwise we have to recompile PrelNames whenever we add a Name, which is
--- a Royal Pain (triggers other recompilation).
------------------------------------------------------------------------------
-
-
-module DsMeta( dsBracket, 
-	       templateHaskellNames, qTyConName, nameTyConName,
-	       liftName, expQTyConName, decQTyConName, typeQTyConName,
-	       decTyConName, typeTyConName, mkNameG_dName, mkNameG_vName, mkNameG_tcName
-	        ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-}	DsExpr ( dsExpr )
-
-import MatchLit	  ( dsLit )
-import DsUtils    ( mkListExpr, mkStringExpr, mkCoreTup, mkIntExpr )
-import DsMonad
-
-import qualified Language.Haskell.TH as TH
-
-import HsSyn
-import Class (FunDep)
-import PrelNames  ( rationalTyConName, integerTyConName, negateName )
-import OccName	  ( isDataOcc, isTvOcc, occNameString )
--- To avoid clashes with DsMeta.varName we must make a local alias for OccName.varName
--- we do this by removing varName from the import of OccName above, making
--- a qualified instance of OccName and using OccNameAlias.varName where varName
--- ws previously used in this file.
-import qualified OccName
-
-import Module	  ( Module, mkModule, moduleString )
-import Id         ( Id, mkLocalId )
-import OccName	  ( mkOccNameFS )
-import Name       ( Name, mkExternalName, localiseName, nameOccName, nameModule, 
-		    isExternalName, getSrcLoc )
-import NameEnv
-import Type       ( Type, mkTyConApp )
-import TcType	  ( tcTyConAppArgs )
-import TyCon	  ( tyConName )
-import TysWiredIn ( parrTyCon )
-import CoreSyn
-import CoreUtils  ( exprType )
-import SrcLoc	  ( noSrcLoc, unLoc, Located(..), SrcSpan, srcLocSpan )
-import Maybe	  ( catMaybes )
-import Unique	  ( mkPreludeTyConUnique, mkPreludeMiscIdUnique, getKey, Uniquable(..) )
-import BasicTypes ( isBoxed ) 
-import Outputable
-import Bag	  ( bagToList, unionManyBags )
-import FastString ( unpackFS )
-import ForeignCall ( Safety(..), CCallConv(..), CCallTarget(..) )
-
-import Monad ( zipWithM )
-import List ( sortBy )
- 
------------------------------------------------------------------------------
-dsBracket :: HsBracket Name -> [PendingSplice] -> DsM CoreExpr
--- Returns a CoreExpr of type TH.ExpQ
--- The quoted thing is parameterised over Name, even though it has
--- been type checked.  We don't want all those type decorations!
-
-dsBracket brack splices
-  = dsExtendMetaEnv new_bit (do_brack brack)
-  where
-    new_bit = mkNameEnv [(n, Splice (unLoc e)) | (n,e) <- splices]
-
-    do_brack (VarBr n)  = do { MkC e1  <- lookupOcc n ; return e1 }
-    do_brack (ExpBr e)  = do { MkC e1  <- repLE e     ; return e1 }
-    do_brack (PatBr p)  = do { MkC p1  <- repLP p     ; return p1 }
-    do_brack (TypBr t)  = do { MkC t1  <- repLTy t    ; return t1 }
-    do_brack (DecBr ds) = do { MkC ds1 <- repTopDs ds ; return ds1 }
-
-{- -------------- Examples --------------------
-
-  [| \x -> x |]
-====>
-  gensym (unpackString "x"#) `bindQ` \ x1::String ->
-  lam (pvar x1) (var x1)
-
-
-  [| \x -> $(f [| x |]) |]
-====>
-  gensym (unpackString "x"#) `bindQ` \ x1::String ->
-  lam (pvar x1) (f (var x1))
--}
-
-
--------------------------------------------------------
--- 			Declarations
--------------------------------------------------------
-
-repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
-repTopDs group
- = do { let { bndrs = map unLoc (groupBinders group) } ;
-	ss <- mkGenSyms bndrs ;
-
-	-- Bind all the names mainly to avoid repeated use of explicit strings.
-	-- Thus	we get
-	--	do { t :: String <- genSym "T" ;
-	--	     return (Data t [] ...more t's... }
-	-- The other important reason is that the output must mention
-	-- only "T", not "Foo:T" where Foo is the current module
-
-	
-	decls <- addBinds ss (do {
-			val_ds  <- rep_val_binds (hs_valds group) ;
-			tycl_ds <- mapM repTyClD (hs_tyclds group) ;
-			inst_ds <- mapM repInstD' (hs_instds group) ;
-			for_ds <- mapM repForD (hs_fords group) ;
-			-- more needed
-			return (de_loc $ sort_by_loc $ val_ds ++ catMaybes tycl_ds ++ inst_ds ++ for_ds) }) ;
-
-	decl_ty <- lookupType decQTyConName ;
-	let { core_list = coreList' decl_ty decls } ;
-
-	dec_ty <- lookupType decTyConName ;
-	q_decs  <- repSequenceQ dec_ty core_list ;
-
-	wrapNongenSyms ss q_decs
-	-- Do *not* gensym top-level binders
-      }
-
-groupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
-			hs_fords = foreign_decls })
--- Collect the binders of a Group
-  = collectHsValBinders val_decls ++
-    [n | d <- tycl_decls, n <- tyClDeclNames (unLoc d)] ++
-    [n | L _ (ForeignImport n _ _ _) <- foreign_decls]
-
-
-{- 	Note [Binders and occurrences]
-	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When we desugar [d| data T = MkT |]
-we want to get
-	Data "T" [] [Con "MkT" []] []
-and *not*
-	Data "Foo:T" [] [Con "Foo:MkT" []] []
-That is, the new data decl should fit into whatever new module it is
-asked to fit in.   We do *not* clone, though; no need for this:
-	Data "T79" ....
-
-But if we see this:
-	data T = MkT 
-	foo = reifyDecl T
-
-then we must desugar to
-	foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
-
-So in repTopDs we bring the binders into scope with mkGenSyms and addBinds.
-And we use lookupOcc, rather than lookupBinder
-in repTyClD and repC.
-
--}
-
-repTyClD :: LTyClDecl Name -> DsM (Maybe (SrcSpan, Core TH.DecQ))
-
-repTyClD (L loc (TyData { tcdND = DataType, tcdCtxt = cxt, 
-		    tcdLName = tc, tcdTyVars = tvs, 
-		    tcdCons = cons, tcdDerivs = mb_derivs }))
- = do { tc1 <- lookupLOcc tc ;		-- See note [Binders and occurrences] 
-        dec <- addTyVarBinds tvs $ \bndrs -> do {
-      	       cxt1    <- repLContext cxt ;
-               cons1   <- mapM repC cons ;
-      	       cons2   <- coreList conQTyConName cons1 ;
-      	       derivs1 <- repDerivs mb_derivs ;
-	       bndrs1  <- coreList nameTyConName bndrs ;
-      	       repData cxt1 tc1 bndrs1 cons2 derivs1 } ;
-        return $ Just (loc, dec) }
-
-repTyClD (L loc (TyData { tcdND = NewType, tcdCtxt = cxt, 
-		    tcdLName = tc, tcdTyVars = tvs, 
-		    tcdCons = [con], tcdDerivs = mb_derivs }))
- = do { tc1 <- lookupLOcc tc ;		-- See note [Binders and occurrences] 
-        dec <- addTyVarBinds tvs $ \bndrs -> do {
-      	       cxt1   <- repLContext cxt ;
-               con1   <- repC con ;
-      	       derivs1 <- repDerivs mb_derivs ;
-	       bndrs1  <- coreList nameTyConName bndrs ;
-      	       repNewtype cxt1 tc1 bndrs1 con1 derivs1 } ;
-        return $ Just (loc, dec) }
-
-repTyClD (L loc (TySynonym { tcdLName = tc, tcdTyVars = tvs, tcdSynRhs = ty }))
- = do { tc1 <- lookupLOcc tc ;		-- See note [Binders and occurrences] 
-        dec <- addTyVarBinds tvs $ \bndrs -> do {
-	       ty1     <- repLTy ty ;
-	       bndrs1  <- coreList nameTyConName bndrs ;
-	       repTySyn tc1 bndrs1 ty1 } ;
- 	return (Just (loc, dec)) }
-
-repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls, 
-		      tcdTyVars = tvs, 
-		      tcdFDs = fds,
-		      tcdSigs = sigs, tcdMeths = meth_binds }))
- = do { cls1 <- lookupLOcc cls ;		-- See note [Binders and occurrences] 
-    	dec  <- addTyVarBinds tvs $ \bndrs -> do {
- 		  cxt1   <- repLContext cxt ;
- 		  sigs1  <- rep_sigs sigs ;
- 		  binds1 <- rep_binds meth_binds ;
-	          fds1 <- repLFunDeps fds;
- 		  decls1 <- coreList decQTyConName (sigs1 ++ binds1) ;
-	          bndrs1 <- coreList nameTyConName bndrs ;
- 		  repClass cxt1 cls1 bndrs1 fds1 decls1 } ;
-    	return $ Just (loc, dec) }
-
--- Un-handled cases
-repTyClD (L loc d) = putSrcSpanDs loc $
-		     do { dsWarn (hang ds_msg 4 (ppr d))
-			; return Nothing }
-
--- represent fundeps
---
-repLFunDeps :: [Located (FunDep Name)] -> DsM (Core [TH.FunDep])
-repLFunDeps fds = do fds' <- mapM repLFunDep fds
-                     fdList <- coreList funDepTyConName fds'
-                     return fdList
-
-repLFunDep :: Located (FunDep Name) -> DsM (Core TH.FunDep)
-repLFunDep (L _ (xs, ys)) = do xs' <- mapM lookupBinder xs
-                               ys' <- mapM lookupBinder ys
-                               xs_list <- coreList nameTyConName xs'
-                               ys_list <- coreList nameTyConName ys'
-                               repFunDep xs_list ys_list
-
-repInstD' (L loc (InstDecl ty binds _))		-- Ignore user pragmas for now
- = do	{ i <- addTyVarBinds tvs $ \tv_bndrs ->
-		-- We must bring the type variables into scope, so their occurrences
-		-- don't fail,  even though the binders don't appear in the resulting 
-		-- data structure
-		do {  cxt1 <- repContext cxt
-		   ; inst_ty1 <- repPred (HsClassP cls tys)
-		   ; ss <- mkGenSyms (collectHsBindBinders binds)
-		   ; binds1 <- addBinds ss (rep_binds binds)
-		   ; decls1 <- coreList decQTyConName binds1
-		   ; decls2 <- wrapNongenSyms ss decls1
-		   -- wrapNonGenSyms: do not clone the class op names!
-		   -- They must be called 'op' etc, not 'op34'
-		   ; repInst cxt1 inst_ty1 decls2 }
-
-	; return (loc, i)}
- where
-   (tvs, cxt, cls, tys) = splitHsInstDeclTy (unLoc ty)
-
-repForD :: Located (ForeignDecl Name) -> DsM (SrcSpan, Core TH.DecQ)
-repForD (L loc (ForeignImport name typ (CImport cc s ch cn cis) _))
- = do MkC name' <- lookupLOcc name
-      MkC typ' <- repLTy typ
-      MkC cc' <- repCCallConv cc
-      MkC s' <- repSafety s
-      MkC str <- coreStringLit $ static
-                              ++ unpackFS ch ++ " "
-                              ++ unpackFS cn ++ " "
-                              ++ conv_cimportspec cis
-      dec <- rep2 forImpDName [cc', s', str, name', typ']
-      return (loc, dec)
- where
-    conv_cimportspec (CLabel cls) = panic "repForD': CLabel Not handled"
-    conv_cimportspec (CFunction DynamicTarget) = "dynamic"
-    conv_cimportspec (CFunction (StaticTarget fs)) = unpackFS fs
-    conv_cimportspec CWrapper = "wrapper"
-    static = case cis of
-                 CFunction (StaticTarget _) -> "static "
-                 _ -> ""
-
-repCCallConv :: CCallConv -> DsM (Core TH.Callconv)
-repCCallConv CCallConv = rep2 cCallName []
-repCCallConv StdCallConv = rep2 stdCallName []
-
-repSafety :: Safety -> DsM (Core TH.Safety)
-repSafety PlayRisky = rep2 unsafeName []
-repSafety (PlaySafe False) = rep2 safeName []
-repSafety (PlaySafe True) = rep2 threadsafeName []
-
-ds_msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
-
--------------------------------------------------------
--- 			Constructors
--------------------------------------------------------
-
-repC :: LConDecl Name -> DsM (Core TH.ConQ)
-repC (L loc (ConDecl con expl [] (L _ []) details ResTyH98))
-  = do { con1 <- lookupLOcc con ;		-- See note [Binders and occurrences] 
-	 repConstr con1 details }
-repC (L loc (ConDecl con expl tvs (L cloc ctxt) details ResTyH98))
-  = do { addTyVarBinds tvs $ \bndrs -> do {
-             c' <- repC (L loc (ConDecl con expl [] (L cloc []) details ResTyH98));
-             ctxt' <- repContext ctxt;
-             bndrs' <- coreList nameTyConName bndrs;
-             rep2 forallCName [unC bndrs', unC ctxt', unC c']
-         }
-       }
-repC (L loc con_decl)		-- GADTs
-  = putSrcSpanDs loc $ 
-    do	{ dsWarn (hang ds_msg 4 (ppr con_decl))
-	; return (panic "DsMeta:repC") }
-
-repBangTy :: LBangType Name -> DsM (Core (TH.StrictTypeQ))
-repBangTy ty= do 
-  MkC s <- rep2 str []
-  MkC t <- repLTy ty'
-  rep2 strictTypeName [s, t]
-  where 
-    (str, ty') = case ty of
-		   L _ (HsBangTy _ ty) -> (isStrictName,  ty)
-		   other	       -> (notStrictName, ty)
-
--------------------------------------------------------
--- 			Deriving clause
--------------------------------------------------------
-
-repDerivs :: Maybe [LHsType Name] -> DsM (Core [TH.Name])
-repDerivs Nothing = coreList nameTyConName []
-repDerivs (Just ctxt)
-  = do { strs <- mapM rep_deriv ctxt ; 
-	 coreList nameTyConName strs }
-  where
-    rep_deriv :: LHsType Name -> DsM (Core TH.Name)
-	-- Deriving clauses must have the simple H98 form
-    rep_deriv (L _ (HsPredTy (HsClassP cls []))) = lookupOcc cls
-    rep_deriv other		  		 = panic "rep_deriv"
-
-
--------------------------------------------------------
---   Signatures in a class decl, or a group of bindings
--------------------------------------------------------
-
-rep_sigs :: [LSig Name] -> DsM [Core TH.DecQ]
-rep_sigs sigs = do locs_cores <- rep_sigs' sigs
-                   return $ de_loc $ sort_by_loc locs_cores
-
-rep_sigs' :: [LSig Name] -> DsM [(SrcSpan, Core TH.DecQ)]
-	-- We silently ignore ones we don't recognise
-rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ;
-		     return (concat sigs1) }
-
-rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
-	-- Singleton => Ok
-	-- Empty     => Too hard, signature ignored
-rep_sig (L loc (TypeSig nm ty)) = rep_proto nm ty loc
-rep_sig other		        = return []
-
-rep_proto :: Located Name -> LHsType Name -> SrcSpan -> DsM [(SrcSpan, Core TH.DecQ)]
-rep_proto nm ty loc = do { nm1 <- lookupLOcc nm ; 
-		       ty1 <- repLTy ty ; 
-		       sig <- repProto nm1 ty1 ;
-		       return [(loc, sig)] }
-
-
--------------------------------------------------------
--- 			Types
--------------------------------------------------------
-
--- gensym a list of type variables and enter them into the meta environment;
--- the computations passed as the second argument is executed in that extended
--- meta environment and gets the *new* names on Core-level as an argument
---
-addTyVarBinds :: [LHsTyVarBndr Name]	         -- the binders to be added
-	      -> ([Core TH.Name] -> DsM (Core (TH.Q a))) -- action in the ext env
-	      -> DsM (Core (TH.Q a))
-addTyVarBinds tvs m =
-  do
-    let names = map (hsTyVarName.unLoc) tvs
-    freshNames <- mkGenSyms names
-    term       <- addBinds freshNames $ do
-		    bndrs <- mapM lookupBinder names 
-		    m bndrs
-    wrapGenSyns freshNames term
-
--- represent a type context
---
-repLContext :: LHsContext Name -> DsM (Core TH.CxtQ)
-repLContext (L _ ctxt) = repContext ctxt
-
-repContext :: HsContext Name -> DsM (Core TH.CxtQ)
-repContext ctxt = do 
-	            preds    <- mapM repLPred ctxt
-		    predList <- coreList typeQTyConName preds
-		    repCtxt predList
-
--- represent a type predicate
---
-repLPred :: LHsPred Name -> DsM (Core TH.TypeQ)
-repLPred (L _ p) = repPred p
-
-repPred :: HsPred Name -> DsM (Core TH.TypeQ)
-repPred (HsClassP cls tys) = do
-			       tcon <- repTy (HsTyVar cls)
-			       tys1 <- repLTys tys
-			       repTapps tcon tys1
-repPred (HsIParam _ _)     = 
-  panic "DsMeta.repTy: Can't represent predicates with implicit parameters"
-
--- yield the representation of a list of types
---
-repLTys :: [LHsType Name] -> DsM [Core TH.TypeQ]
-repLTys tys = mapM repLTy tys
-
--- represent a type
---
-repLTy :: LHsType Name -> DsM (Core TH.TypeQ)
-repLTy (L _ ty) = repTy ty
-
-repTy :: HsType Name -> DsM (Core TH.TypeQ)
-repTy (HsForAllTy _ tvs ctxt ty)  = 
-  addTyVarBinds tvs $ \bndrs -> do
-    ctxt1  <- repLContext ctxt
-    ty1    <- repLTy ty
-    bndrs1 <- coreList nameTyConName bndrs
-    repTForall bndrs1 ctxt1 ty1
-
-repTy (HsTyVar n)
-  | isTvOcc (nameOccName n)       = do 
-				      tv1 <- lookupBinder n
-				      repTvar tv1
-  | otherwise		          = do 
-				      tc1 <- lookupOcc n
-				      repNamedTyCon tc1
-repTy (HsAppTy f a)               = do 
-				      f1 <- repLTy f
-				      a1 <- repLTy a
-				      repTapp f1 a1
-repTy (HsFunTy f a)               = do 
-				      f1   <- repLTy f
-				      a1   <- repLTy a
-				      tcon <- repArrowTyCon
-				      repTapps tcon [f1, a1]
-repTy (HsListTy t)		  = do
-				      t1   <- repLTy t
-				      tcon <- repListTyCon
-				      repTapp tcon t1
-repTy (HsPArrTy t)                = do
-				      t1   <- repLTy t
-				      tcon <- repTy (HsTyVar (tyConName parrTyCon))
-				      repTapp tcon t1
-repTy (HsTupleTy tc tys)	  = do
-				      tys1 <- repLTys tys 
-				      tcon <- repTupleTyCon (length tys)
-				      repTapps tcon tys1
-repTy (HsOpTy ty1 n ty2) 	  = repLTy ((nlHsTyVar (unLoc n) `nlHsAppTy` ty1) 
-					   `nlHsAppTy` ty2)
-repTy (HsParTy t)  	       	  = repLTy t
-repTy (HsNumTy i)                 =
-  panic "DsMeta.repTy: Can't represent number types (for generics)"
-repTy (HsPredTy pred)             = repPred pred
-repTy (HsKindSig ty kind)	  = 
-  panic "DsMeta.repTy: Can't represent explicit kind signatures yet"
-
-
------------------------------------------------------------------------------
--- 		Expressions
------------------------------------------------------------------------------
-
-repLEs :: [LHsExpr Name] -> DsM (Core [TH.ExpQ])
-repLEs es = do { es'  <- mapM repLE es ;
-		 coreList expQTyConName es' }
-
--- FIXME: some of these panics should be converted into proper error messages
---	  unless we can make sure that constructs, which are plainly not
---	  supported in TH already lead to error messages at an earlier stage
-repLE :: LHsExpr Name -> DsM (Core TH.ExpQ)
-repLE (L _ e) = repE e
-
-repE :: HsExpr Name -> DsM (Core TH.ExpQ)
-repE (HsVar x)            =
-  do { mb_val <- dsLookupMetaEnv x 
-     ; case mb_val of
-	Nothing	         -> do { str <- globalVar x
-			       ; repVarOrCon x str }
-	Just (Bound y)   -> repVarOrCon x (coreVar y)
-	Just (Splice e)  -> do { e' <- dsExpr e
-			       ; return (MkC e') } }
-repE (HsIPVar x) = panic "DsMeta.repE: Can't represent implicit parameters"
-
-	-- Remember, we're desugaring renamer output here, so
-	-- HsOverlit can definitely occur
-repE (HsOverLit l) = do { a <- repOverloadedLiteral l; repLit a }
-repE (HsLit l)     = do { a <- repLiteral l;           repLit a }
-repE (HsLam (MatchGroup [m] _)) = repLambda m
-repE (HsApp x y)   = do {a <- repLE x; b <- repLE y; repApp a b}
-
-repE (OpApp e1 op fix e2) =
-  do { arg1 <- repLE e1; 
-       arg2 <- repLE e2; 
-       the_op <- repLE op ;
-       repInfixApp arg1 the_op arg2 } 
-repE (NegApp x nm)        = do
-			      a         <- repLE x
-			      negateVar <- lookupOcc negateName >>= repVar
-			      negateVar `repApp` a
-repE (HsPar x)            = repLE x
-repE (SectionL x y)       = do { a <- repLE x; b <- repLE y; repSectionL a b } 
-repE (SectionR x y)       = do { a <- repLE x; b <- repLE y; repSectionR a b } 
-repE (HsCase e (MatchGroup ms _)) = do { arg <- repLE e
-				       ; ms2 <- mapM repMatchTup ms
-				       ; repCaseE arg (nonEmptyCoreList ms2) }
-repE (HsIf x y z)         = do
-			      a <- repLE x
-			      b <- repLE y
-			      c <- repLE z
-			      repCond a b c
-repE (HsLet bs e)         = do { (ss,ds) <- repBinds bs
-			       ; e2 <- addBinds ss (repLE e)
-			       ; z <- repLetE ds e2
-			       ; wrapGenSyns ss z }
--- FIXME: I haven't got the types here right yet
-repE (HsDo DoExpr sts body ty) 
- = do { (ss,zs) <- repLSts sts; 
-	body'	<- addBinds ss $ repLE body;
-	ret	<- repNoBindSt body';	
-        e       <- repDoE (nonEmptyCoreList (zs ++ [ret]));
-        wrapGenSyns ss e }
-repE (HsDo ListComp sts body ty) 
- = do { (ss,zs) <- repLSts sts; 
-	body'	<- addBinds ss $ repLE body;
-	ret	<- repNoBindSt body';	
-        e       <- repComp (nonEmptyCoreList (zs ++ [ret]));
-        wrapGenSyns ss e }
-repE (HsDo _ _ _ _) = panic "DsMeta.repE: Can't represent mdo and [: :] yet"
-repE (ExplicitList ty es) = do { xs <- repLEs es; repListExp xs } 
-repE (ExplicitPArr ty es) = 
-  panic "DsMeta.repE: No explicit parallel arrays yet"
-repE (ExplicitTuple es boxed) 
-  | isBoxed boxed         = do { xs <- repLEs es; repTup xs }
-  | otherwise		  = panic "DsMeta.repE: Can't represent unboxed tuples"
-repE (RecordCon c _ flds)
- = do { x <- lookupLOcc c;
-        fs <- repFields flds;
-        repRecCon x fs }
-repE (RecordUpd e flds _ _)
- = do { x <- repLE e;
-        fs <- repFields flds;
-        repRecUpd x fs }
-
-repE (ExprWithTySig e ty) = do { e1 <- repLE e; t1 <- repLTy ty; repSigExp e1 t1 }
-repE (ArithSeq _ aseq) =
-  case aseq of
-    From e              -> do { ds1 <- repLE e; repFrom ds1 }
-    FromThen e1 e2      -> do 
-		             ds1 <- repLE e1
-			     ds2 <- repLE e2
-			     repFromThen ds1 ds2
-    FromTo   e1 e2      -> do 
-			     ds1 <- repLE e1
-			     ds2 <- repLE e2
-			     repFromTo ds1 ds2
-    FromThenTo e1 e2 e3 -> do 
-			     ds1 <- repLE e1
-			     ds2 <- repLE e2
-			     ds3 <- repLE e3
-			     repFromThenTo ds1 ds2 ds3
-repE (PArrSeq _ aseq)     = panic "DsMeta.repE: parallel array seq.s missing"
-repE (HsCoreAnn _ _)      = panic "DsMeta.repE: Can't represent CoreAnn" -- hdaume: core annotations
-repE (HsSCC _ _)          = panic "DsMeta.repE: Can't represent SCC"
-repE (HsBracketOut _ _)   = panic "DsMeta.repE: Can't represent Oxford brackets"
-repE (HsSpliceE (HsSplice n _)) 
-  = do { mb_val <- dsLookupMetaEnv n
-       ; case mb_val of
-		 Just (Splice e) -> do { e' <- dsExpr e
-				       ; return (MkC e') }
-		 other	     -> pprPanic "HsSplice" (ppr n) }
-
-repE e = pprPanic "DsMeta.repE: Illegal expression form" (ppr e)
-
------------------------------------------------------------------------------
--- Building representations of auxillary structures like Match, Clause, Stmt, 
-
-repMatchTup ::  LMatch Name -> DsM (Core TH.MatchQ) 
-repMatchTup (L _ (Match [p] ty (GRHSs guards wheres))) =
-  do { ss1 <- mkGenSyms (collectPatBinders p) 
-     ; addBinds ss1 $ do {
-     ; p1 <- repLP p
-     ; (ss2,ds) <- repBinds wheres
-     ; addBinds ss2 $ do {
-     ; gs    <- repGuards guards
-     ; match <- repMatch p1 gs ds
-     ; wrapGenSyns (ss1++ss2) match }}}
-
-repClauseTup ::  LMatch Name -> DsM (Core TH.ClauseQ)
-repClauseTup (L _ (Match ps ty (GRHSs guards wheres))) =
-  do { ss1 <- mkGenSyms (collectPatsBinders ps) 
-     ; addBinds ss1 $ do {
-       ps1 <- repLPs ps
-     ; (ss2,ds) <- repBinds wheres
-     ; addBinds ss2 $ do {
-       gs <- repGuards guards
-     ; clause <- repClause ps1 gs ds
-     ; wrapGenSyns (ss1++ss2) clause }}}
-
-repGuards ::  [LGRHS Name] ->  DsM (Core TH.BodyQ)
-repGuards [L _ (GRHS [] e)]
-  = do {a <- repLE e; repNormal a }
-repGuards other 
-  = do { zs <- mapM process other;
-     let {(xs, ys) = unzip zs};
-	 gd <- repGuarded (nonEmptyCoreList ys);
-     wrapGenSyns (concat xs) gd }
-  where 
-    process :: LGRHS Name -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp))))
-    process (L _ (GRHS [L _ (ExprStmt e1 _ _)] e2))
-           = do { x <- repLNormalGE e1 e2;
-                  return ([], x) }
-    process (L _ (GRHS ss rhs))
-           = do (gs, ss') <- repLSts ss
-		rhs' <- addBinds gs $ repLE rhs
-                g <- repPatGE (nonEmptyCoreList ss') rhs'
-                return (gs, g)
-
-repFields :: [(Located Name, LHsExpr Name)] -> DsM (Core [TH.Q TH.FieldExp])
-repFields flds = do
-        fnames <- mapM lookupLOcc (map fst flds)
-        es <- mapM repLE (map snd flds)
-        fs <- zipWithM repFieldExp fnames es
-        coreList fieldExpQTyConName fs
-
-
------------------------------------------------------------------------------
--- Representing Stmt's is tricky, especially if bound variables
--- shadow each other. Consider:  [| do { x <- f 1; x <- f x; g x } |]
--- First gensym new names for every variable in any of the patterns.
--- both static (x'1 and x'2), and dynamic ((gensym "x") and (gensym "y"))
--- if variables didn't shaddow, the static gensym wouldn't be necessary
--- and we could reuse the original names (x and x).
---
--- do { x'1 <- gensym "x"
---    ; x'2 <- gensym "x"   
---    ; doE [ BindSt (pvar x'1) [| f 1 |]
---          , BindSt (pvar x'2) [| f x |] 
---          , NoBindSt [| g x |] 
---          ]
---    }
-
--- The strategy is to translate a whole list of do-bindings by building a
--- bigger environment, and a bigger set of meta bindings 
--- (like:  x'1 <- gensym "x" ) and then combining these with the translations
--- of the expressions within the Do
-      
------------------------------------------------------------------------------
--- The helper function repSts computes the translation of each sub expression
--- and a bunch of prefix bindings denoting the dynamic renaming.
-
-repLSts :: [LStmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
-repLSts stmts = repSts (map unLoc stmts)
-
-repSts :: [Stmt Name] -> DsM ([GenSymBind], [Core TH.StmtQ])
-repSts (BindStmt p e _ _ : ss) =
-   do { e2 <- repLE e 
-      ; ss1 <- mkGenSyms (collectPatBinders p) 
-      ; addBinds ss1 $ do {
-      ; p1 <- repLP p; 
-      ; (ss2,zs) <- repSts ss
-      ; z <- repBindSt p1 e2
-      ; return (ss1++ss2, z : zs) }}
-repSts (LetStmt bs : ss) =
-   do { (ss1,ds) <- repBinds bs
-      ; z <- repLetSt ds
-      ; (ss2,zs) <- addBinds ss1 (repSts ss)
-      ; return (ss1++ss2, z : zs) } 
-repSts (ExprStmt e _ _ : ss) =       
-   do { e2 <- repLE e
-      ; z <- repNoBindSt e2 
-      ; (ss2,zs) <- repSts ss
-      ; return (ss2, z : zs) }
-repSts [] = return ([],[])
-repSts other = panic "Exotic Stmt in meta brackets"      
-
-
------------------------------------------------------------
---			Bindings
------------------------------------------------------------
-
-repBinds :: HsLocalBinds Name -> DsM ([GenSymBind], Core [TH.DecQ]) 
-repBinds EmptyLocalBinds
-  = do	{ core_list <- coreList decQTyConName []
-	; return ([], core_list) }
-
-repBinds (HsIPBinds _)
-  = panic "DsMeta:repBinds: can't do implicit parameters"
-
-repBinds (HsValBinds decs)
- = do	{ let { bndrs = map unLoc (collectHsValBinders decs) }
-		-- No need to worrry about detailed scopes within
-		-- the binding group, because we are talking Names
-		-- here, so we can safely treat it as a mutually 
-		-- recursive group
-	; ss        <- mkGenSyms bndrs
-	; prs       <- addBinds ss (rep_val_binds decs)
-	; core_list <- coreList decQTyConName 
-				(de_loc (sort_by_loc prs))
-	; return (ss, core_list) }
-
-rep_val_binds :: HsValBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
--- Assumes: all the binders of the binding are alrady in the meta-env
-rep_val_binds (ValBindsOut binds sigs)
- = do { core1 <- rep_binds' (unionManyBags (map snd binds))
-      ;	core2 <- rep_sigs' sigs
-      ;	return (core1 ++ core2) }
-
-rep_binds :: LHsBinds Name -> DsM [Core TH.DecQ]
-rep_binds binds = do { binds_w_locs <- rep_binds' binds
-		     ; return (de_loc (sort_by_loc binds_w_locs)) }
-
-rep_binds' :: LHsBinds Name -> DsM [(SrcSpan, Core TH.DecQ)]
-rep_binds' binds = mapM rep_bind (bagToList binds)
-
-rep_bind :: LHsBind Name -> DsM (SrcSpan, Core TH.DecQ)
--- Assumes: all the binders of the binding are alrady in the meta-env
-
--- Note GHC treats declarations of a variable (not a pattern) 
--- e.g.  x = g 5 as a Fun MonoBinds. This is indicated by a single match 
--- with an empty list of patterns
-rep_bind (L loc (FunBind { fun_id = fn, 
-			   fun_matches = MatchGroup [L _ (Match [] ty (GRHSs guards wheres))] _ }))
- = do { (ss,wherecore) <- repBinds wheres
-	; guardcore <- addBinds ss (repGuards guards)
-	; fn'  <- lookupLBinder fn
-	; p    <- repPvar fn'
-	; ans  <- repVal p guardcore wherecore
-	; ans' <- wrapGenSyns ss ans
-	; return (loc, ans') }
-
-rep_bind (L loc (FunBind { fun_id = fn, fun_matches = MatchGroup ms _ }))
- =   do { ms1 <- mapM repClauseTup ms
-	; fn' <- lookupLBinder fn
-        ; ans <- repFun fn' (nonEmptyCoreList ms1)
-        ; return (loc, ans) }
-
-rep_bind (L loc (PatBind { pat_lhs = pat, pat_rhs = GRHSs guards wheres }))
- =   do { patcore <- repLP pat 
-        ; (ss,wherecore) <- repBinds wheres
-	; guardcore <- addBinds ss (repGuards guards)
-        ; ans  <- repVal patcore guardcore wherecore
-	; ans' <- wrapGenSyns ss ans
-        ; return (loc, ans') }
-
-rep_bind (L loc (VarBind { var_id = v, var_rhs = e}))
- =   do { v' <- lookupBinder v 
-	; e2 <- repLE e
-        ; x <- repNormal e2
-        ; patcore <- repPvar v'
-	; empty_decls <- coreList decQTyConName [] 
-        ; ans <- repVal patcore x empty_decls
-        ; return (srcLocSpan (getSrcLoc v), ans) }
-
------------------------------------------------------------------------------
--- Since everything in a Bind is mutually recursive we need rename all
--- all the variables simultaneously. For example: 
--- [| AndMonoBinds (f x = x + g 2) (g x = f 1 + 2) |] would translate to
--- do { f'1 <- gensym "f"
---    ; g'2 <- gensym "g"
---    ; [ do { x'3 <- gensym "x"; fun f'1 [pvar x'3] [| x + g2 |]},
---        do { x'4 <- gensym "x"; fun g'2 [pvar x'4] [| f 1 + 2 |]}
---      ]}
--- This requires collecting the bindings (f'1 <- gensym "f"), and the 
--- environment ( f |-> f'1 ) from each binding, and then unioning them 
--- together. As we do this we collect GenSymBinds's which represent the renamed 
--- variables bound by the Bindings. In order not to lose track of these 
--- representations we build a shadow datatype MB with the same structure as 
--- MonoBinds, but which has slots for the representations
-
-
------------------------------------------------------------------------------
--- GHC allows a more general form of lambda abstraction than specified
--- by Haskell 98. In particular it allows guarded lambda's like : 
--- (\  x | even x -> 0 | odd x -> 1) at the moment we can't represent this in
--- Haskell Template's Meta.Exp type so we punt if it isn't a simple thing like
--- (\ p1 .. pn -> exp) by causing an error.  
-
-repLambda :: LMatch Name -> DsM (Core TH.ExpQ)
-repLambda (L _ (Match ps _ (GRHSs [L _ (GRHS [] e)] EmptyLocalBinds)))
- = do { let bndrs = collectPatsBinders ps ;
-      ; ss  <- mkGenSyms bndrs
-      ; lam <- addBinds ss (
-		do { xs <- repLPs ps; body <- repLE e; repLam xs body })
-      ; wrapGenSyns ss lam }
-
-repLambda z = panic "Can't represent a guarded lambda in Template Haskell"  
-
-  
------------------------------------------------------------------------------
---			Patterns
--- repP deals with patterns.  It assumes that we have already
--- walked over the pattern(s) once to collect the binders, and 
--- have extended the environment.  So every pattern-bound 
--- variable should already appear in the environment.
-
--- Process a list of patterns
-repLPs :: [LPat Name] -> DsM (Core [TH.PatQ])
-repLPs ps = do { ps' <- mapM repLP ps ;
-		 coreList patQTyConName ps' }
-
-repLP :: LPat Name -> DsM (Core TH.PatQ)
-repLP (L _ p) = repP p
-
-repP :: Pat Name -> DsM (Core TH.PatQ)
-repP (WildPat _)       = repPwild 
-repP (LitPat l)        = do { l2 <- repLiteral l; repPlit l2 }
-repP (VarPat x)        = do { x' <- lookupBinder x; repPvar x' }
-repP (LazyPat p)       = do { p1 <- repLP p; repPtilde p1 }
-repP (AsPat x p)       = do { x' <- lookupLBinder x; p1 <- repLP p; repPaspat x' p1 }
-repP (ParPat p)        = repLP p 
-repP (ListPat ps _)    = do { qs <- repLPs ps; repPlist qs }
-repP (TuplePat ps _ _) = do { qs <- repLPs ps; repPtup qs }
-repP (ConPatIn dc details)
- = do { con_str <- lookupLOcc dc
-      ; case details of
-         PrefixCon ps   -> do { qs <- repLPs ps; repPcon con_str qs }
-         RecCon pairs -> do { vs <- sequence $ map lookupLOcc (map fst pairs)
-                            ; ps <- sequence $ map repLP (map snd pairs)
-                            ; fps <- zipWithM (\x y -> rep2 fieldPatName [unC x,unC y]) vs ps
-                            ; fps' <- coreList fieldPatQTyConName fps
-                            ; repPrec con_str fps' }
-         InfixCon p1 p2 -> do { p1' <- repLP p1;
-                                p2' <- repLP p2;
-                                repPinfix p1' con_str p2' }
-   }
-repP (NPat l (Just _) _ _) = panic "Can't cope with negative overloaded patterns yet (repP (NPat _ (Just _)))"
-repP (NPat l Nothing _ _)  = do { a <- repOverloadedLiteral l; repPlit a }
-repP (SigPatIn p t)  = do { p' <- repLP p; t' <- repLTy t; repPsig p' t' }
-repP other = panic "Exotic pattern inside meta brackets"
-
-----------------------------------------------------------
--- Declaration ordering helpers
-
-sort_by_loc :: [(SrcSpan, a)] -> [(SrcSpan, a)]
-sort_by_loc xs = sortBy comp xs
-    where comp x y = compare (fst x) (fst y)
-
-de_loc :: [(a, b)] -> [b]
-de_loc = map snd
-
-----------------------------------------------------------
---	The meta-environment
-
--- A name/identifier association for fresh names of locally bound entities
-type GenSymBind = (Name, Id)	-- Gensym the string and bind it to the Id
-				-- I.e.		(x, x_id) means
-				--	let x_id = gensym "x" in ...
-
--- Generate a fresh name for a locally bound entity
-
-mkGenSyms :: [Name] -> DsM [GenSymBind]
--- We can use the existing name.  For example:
---	[| \x_77 -> x_77 + x_77 |]
--- desugars to
---	do { x_77 <- genSym "x"; .... }
--- We use the same x_77 in the desugared program, but with the type Bndr
--- instead of Int
---
--- We do make it an Internal name, though (hence localiseName)
---
--- Nevertheless, it's monadic because we have to generate nameTy
-mkGenSyms ns = do { var_ty <- lookupType nameTyConName
-		  ; return [(nm, mkLocalId (localiseName nm) var_ty) | nm <- ns] }
-
-	     
-addBinds :: [GenSymBind] -> DsM a -> DsM a
--- Add a list of fresh names for locally bound entities to the 
--- meta environment (which is part of the state carried around 
--- by the desugarer monad) 
-addBinds bs m = dsExtendMetaEnv (mkNameEnv [(n,Bound id) | (n,id) <- bs]) m
-
--- Look up a locally bound name
---
-lookupLBinder :: Located Name -> DsM (Core TH.Name)
-lookupLBinder (L _ n) = lookupBinder n
-
-lookupBinder :: Name -> DsM (Core TH.Name)
-lookupBinder n 
-  = do { mb_val <- dsLookupMetaEnv n;
-	 case mb_val of
-	    Just (Bound x) -> return (coreVar x)
-	    other	   -> pprPanic "DsMeta: failed binder lookup when desugaring a TH bracket:" (ppr n) }
-
--- Look up a name that is either locally bound or a global name
---
---  * If it is a global name, generate the "original name" representation (ie,
---   the <module>:<name> form) for the associated entity
---
-lookupLOcc :: Located Name -> DsM (Core TH.Name)
--- Lookup an occurrence; it can't be a splice.
--- Use the in-scope bindings if they exist
-lookupLOcc (L _ n) = lookupOcc n
-
-lookupOcc :: Name -> DsM (Core TH.Name)
-lookupOcc n
-  = do {  mb_val <- dsLookupMetaEnv n ;
-          case mb_val of
-		Nothing         -> globalVar n
-		Just (Bound x)  -> return (coreVar x)
-		Just (Splice _) -> pprPanic "repE:lookupOcc" (ppr n) 
-    }
-
-globalVar :: Name -> DsM (Core TH.Name)
--- Not bound by the meta-env
--- Could be top-level; or could be local
---	f x = $(g [| x |])
--- Here the x will be local
-globalVar name
-  | isExternalName name
-  = do	{ MkC mod <- coreStringLit name_mod
-	; MkC occ <- occNameLit name
-	; rep2 mk_varg [mod,occ] }
-  | otherwise
-  = do 	{ MkC occ <- occNameLit name
-	; MkC uni <- coreIntLit (getKey (getUnique name))
-	; rep2 mkNameLName [occ,uni] }
-  where
-      name_mod = moduleString (nameModule name)
-      name_occ = nameOccName name
-      mk_varg | OccName.isDataOcc name_occ = mkNameG_dName
-	      | OccName.isVarOcc  name_occ = mkNameG_vName
-	      | OccName.isTcOcc   name_occ = mkNameG_tcName
-	      | otherwise 	           = pprPanic "DsMeta.globalVar" (ppr name)
-
-lookupType :: Name 	-- Name of type constructor (e.g. TH.ExpQ)
-	   -> DsM Type	-- The type
-lookupType tc_name = do { tc <- dsLookupTyCon tc_name ;
-		          return (mkTyConApp tc []) }
-
-wrapGenSyns :: [GenSymBind] 
-	    -> Core (TH.Q a) -> DsM (Core (TH.Q a))
--- wrapGenSyns [(nm1,id1), (nm2,id2)] y 
---	--> bindQ (gensym nm1) (\ id1 -> 
---	    bindQ (gensym nm2 (\ id2 -> 
---	    y))
-
-wrapGenSyns binds body@(MkC b)
-  = do  { var_ty <- lookupType nameTyConName
-	; go var_ty binds }
-  where
-    [elt_ty] = tcTyConAppArgs (exprType b) 
-	-- b :: Q a, so we can get the type 'a' by looking at the
-	-- argument type. NB: this relies on Q being a data/newtype,
-	-- not a type synonym
-
-    go var_ty [] = return body
-    go var_ty ((name,id) : binds)
-      = do { MkC body'  <- go var_ty binds
-	   ; lit_str    <- occNameLit name
-	   ; gensym_app <- repGensym lit_str
-	   ; repBindQ var_ty elt_ty 
-		      gensym_app (MkC (Lam id body')) }
-
--- Just like wrapGenSym, but don't actually do the gensym
--- Instead use the existing name:
---	let x = "x" in ...
--- Only used for [Decl], and for the class ops in class 
--- and instance decls
-wrapNongenSyms :: [GenSymBind] -> Core a -> DsM (Core a)
-wrapNongenSyms binds (MkC body)
-  = do { binds' <- mapM do_one binds ;
-	 return (MkC (mkLets binds' body)) }
-  where
-    do_one (name,id) 
-	= do { MkC lit_str <- occNameLit name
-	     ; MkC var <- rep2 mkNameName [lit_str]
-	     ; return (NonRec id var) }
-
-occNameLit :: Name -> DsM (Core String)
-occNameLit n = coreStringLit (occNameString (nameOccName n))
-
-
--- %*********************************************************************
--- %*									*
---		Constructing code
--- %*									*
--- %*********************************************************************
-
------------------------------------------------------------------------------
--- PHANTOM TYPES for consistency. In order to make sure we do this correct 
--- we invent a new datatype which uses phantom types.
-
-newtype Core a = MkC CoreExpr
-unC (MkC x) = x
-
-rep2 :: Name -> [ CoreExpr ] -> DsM (Core a)
-rep2 n xs = do { id <- dsLookupGlobalId n
-               ; return (MkC (foldl App (Var id) xs)) }
-
--- Then we make "repConstructors" which use the phantom types for each of the
--- smart constructors of the Meta.Meta datatypes.
-
-
--- %*********************************************************************
--- %*									*
---		The 'smart constructors'
--- %*									*
--- %*********************************************************************
-
---------------- Patterns -----------------
-repPlit   :: Core TH.Lit -> DsM (Core TH.PatQ) 
-repPlit (MkC l) = rep2 litPName [l]
-
-repPvar :: Core TH.Name -> DsM (Core TH.PatQ)
-repPvar (MkC s) = rep2 varPName [s]
-
-repPtup :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
-repPtup (MkC ps) = rep2 tupPName [ps]
-
-repPcon   :: Core TH.Name -> Core [TH.PatQ] -> DsM (Core TH.PatQ)
-repPcon (MkC s) (MkC ps) = rep2 conPName [s, ps]
-
-repPrec   :: Core TH.Name -> Core [(TH.Name,TH.PatQ)] -> DsM (Core TH.PatQ)
-repPrec (MkC c) (MkC rps) = rep2 recPName [c,rps]
-
-repPinfix :: Core TH.PatQ -> Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
-repPinfix (MkC p1) (MkC n) (MkC p2) = rep2 infixPName [p1, n, p2]
-
-repPtilde :: Core TH.PatQ -> DsM (Core TH.PatQ)
-repPtilde (MkC p) = rep2 tildePName [p]
-
-repPaspat :: Core TH.Name -> Core TH.PatQ -> DsM (Core TH.PatQ)
-repPaspat (MkC s) (MkC p) = rep2 asPName [s, p]
-
-repPwild  :: DsM (Core TH.PatQ)
-repPwild = rep2 wildPName []
-
-repPlist :: Core [TH.PatQ] -> DsM (Core TH.PatQ)
-repPlist (MkC ps) = rep2 listPName [ps]
-
-repPsig :: Core TH.PatQ -> Core TH.TypeQ -> DsM (Core TH.PatQ)
-repPsig (MkC p) (MkC t) = rep2 sigPName [p, t]
-
---------------- Expressions -----------------
-repVarOrCon :: Name -> Core TH.Name -> DsM (Core TH.ExpQ)
-repVarOrCon vc str | isDataOcc (nameOccName vc) = repCon str
-	           | otherwise 		        = repVar str
-
-repVar :: Core TH.Name -> DsM (Core TH.ExpQ)
-repVar (MkC s) = rep2 varEName [s] 
-
-repCon :: Core TH.Name -> DsM (Core TH.ExpQ)
-repCon (MkC s) = rep2 conEName [s] 
-
-repLit :: Core TH.Lit -> DsM (Core TH.ExpQ)
-repLit (MkC c) = rep2 litEName [c] 
-
-repApp :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repApp (MkC x) (MkC y) = rep2 appEName [x,y] 
-
-repLam :: Core [TH.PatQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repLam (MkC ps) (MkC e) = rep2 lamEName [ps, e]
-
-repTup :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
-repTup (MkC es) = rep2 tupEName [es]
-
-repCond :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repCond (MkC x) (MkC y) (MkC z) =  rep2 condEName [x,y,z] 
-
-repLetE :: Core [TH.DecQ] -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repLetE (MkC ds) (MkC e) = rep2 letEName [ds, e] 
-
-repCaseE :: Core TH.ExpQ -> Core [TH.MatchQ] -> DsM( Core TH.ExpQ)
-repCaseE (MkC e) (MkC ms) = rep2 caseEName [e, ms]
-
-repDoE :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
-repDoE (MkC ss) = rep2 doEName [ss]
-
-repComp :: Core [TH.StmtQ] -> DsM (Core TH.ExpQ)
-repComp (MkC ss) = rep2 compEName [ss]
-
-repListExp :: Core [TH.ExpQ] -> DsM (Core TH.ExpQ)
-repListExp (MkC es) = rep2 listEName [es]
-
-repSigExp :: Core TH.ExpQ -> Core TH.TypeQ -> DsM (Core TH.ExpQ)
-repSigExp (MkC e) (MkC t) = rep2 sigEName [e,t]
-
-repRecCon :: Core TH.Name -> Core [TH.Q TH.FieldExp]-> DsM (Core TH.ExpQ)
-repRecCon (MkC c) (MkC fs) = rep2 recConEName [c,fs]
-
-repRecUpd :: Core TH.ExpQ -> Core [TH.Q TH.FieldExp] -> DsM (Core TH.ExpQ)
-repRecUpd (MkC e) (MkC fs) = rep2 recUpdEName [e,fs]
-
-repFieldExp :: Core TH.Name -> Core TH.ExpQ -> DsM (Core (TH.Q TH.FieldExp))
-repFieldExp (MkC n) (MkC x) = rep2 fieldExpName [n,x]
-
-repInfixApp :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repInfixApp (MkC x) (MkC y) (MkC z) = rep2 infixAppName [x,y,z]
-
-repSectionL :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repSectionL (MkC x) (MkC y) = rep2 sectionLName [x,y]
-
-repSectionR :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repSectionR (MkC x) (MkC y) = rep2 sectionRName [x,y]
-
------------- Right hand sides (guarded expressions) ----
-repGuarded :: Core [TH.Q (TH.Guard, TH.Exp)] -> DsM (Core TH.BodyQ)
-repGuarded (MkC pairs) = rep2 guardedBName [pairs]
-
-repNormal :: Core TH.ExpQ -> DsM (Core TH.BodyQ)
-repNormal (MkC e) = rep2 normalBName [e]
-
------------- Guards ----
-repLNormalGE :: LHsExpr Name -> LHsExpr Name -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
-repLNormalGE g e = do g' <- repLE g
-                      e' <- repLE e
-                      repNormalGE g' e'
-
-repNormalGE :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
-repNormalGE (MkC g) (MkC e) = rep2 normalGEName [g, e]
-
-repPatGE :: Core [TH.StmtQ] -> Core TH.ExpQ -> DsM (Core (TH.Q (TH.Guard, TH.Exp)))
-repPatGE (MkC ss) (MkC e) = rep2 patGEName [ss, e]
-
-------------- Stmts -------------------
-repBindSt :: Core TH.PatQ -> Core TH.ExpQ -> DsM (Core TH.StmtQ)
-repBindSt (MkC p) (MkC e) = rep2 bindSName [p,e]
-
-repLetSt :: Core [TH.DecQ] -> DsM (Core TH.StmtQ)
-repLetSt (MkC ds) = rep2 letSName [ds]
-
-repNoBindSt :: Core TH.ExpQ -> DsM (Core TH.StmtQ)
-repNoBindSt (MkC e) = rep2 noBindSName [e]
-
--------------- Range (Arithmetic sequences) -----------
-repFrom :: Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repFrom (MkC x) = rep2 fromEName [x]
-
-repFromThen :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repFromThen (MkC x) (MkC y) = rep2 fromThenEName [x,y]
-
-repFromTo :: Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repFromTo (MkC x) (MkC y) = rep2 fromToEName [x,y]
-
-repFromThenTo :: Core TH.ExpQ -> Core TH.ExpQ -> Core TH.ExpQ -> DsM (Core TH.ExpQ)
-repFromThenTo (MkC x) (MkC y) (MkC z) = rep2 fromThenToEName [x,y,z]
-
------------- Match and Clause Tuples -----------
-repMatch :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.MatchQ)
-repMatch (MkC p) (MkC bod) (MkC ds) = rep2 matchName [p, bod, ds]
-
-repClause :: Core [TH.PatQ] -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.ClauseQ)
-repClause (MkC ps) (MkC bod) (MkC ds) = rep2 clauseName [ps, bod, ds]
-
--------------- Dec -----------------------------
-repVal :: Core TH.PatQ -> Core TH.BodyQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
-repVal (MkC p) (MkC b) (MkC ds) = rep2 valDName [p, b, ds]
-
-repFun :: Core TH.Name -> Core [TH.ClauseQ] -> DsM (Core TH.DecQ)  
-repFun (MkC nm) (MkC b) = rep2 funDName [nm, b]
-
-repData :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.ConQ] -> Core [TH.Name] -> DsM (Core TH.DecQ)
-repData (MkC cxt) (MkC nm) (MkC tvs) (MkC cons) (MkC derivs)
-    = rep2 dataDName [cxt, nm, tvs, cons, derivs]
-
-repNewtype :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core TH.ConQ -> Core [TH.Name] -> DsM (Core TH.DecQ)
-repNewtype (MkC cxt) (MkC nm) (MkC tvs) (MkC con) (MkC derivs)
-    = rep2 newtypeDName [cxt, nm, tvs, con, derivs]
-
-repTySyn :: Core TH.Name -> Core [TH.Name] -> Core TH.TypeQ -> DsM (Core TH.DecQ)
-repTySyn (MkC nm) (MkC tvs) (MkC rhs) = rep2 tySynDName [nm, tvs, rhs]
-
-repInst :: Core TH.CxtQ -> Core TH.TypeQ -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
-repInst (MkC cxt) (MkC ty) (MkC ds) = rep2 instanceDName [cxt, ty, ds]
-
-repClass :: Core TH.CxtQ -> Core TH.Name -> Core [TH.Name] -> Core [TH.FunDep] -> Core [TH.DecQ] -> DsM (Core TH.DecQ)
-repClass (MkC cxt) (MkC cls) (MkC tvs) (MkC fds) (MkC ds) = rep2 classDName [cxt, cls, tvs, fds, ds]
-
-repFunDep :: Core [TH.Name] -> Core [TH.Name] -> DsM (Core TH.FunDep)
-repFunDep (MkC xs) (MkC ys) = rep2 funDepName [xs, ys]
-
-repProto :: Core TH.Name -> Core TH.TypeQ -> DsM (Core TH.DecQ)
-repProto (MkC s) (MkC ty) = rep2 sigDName [s, ty]
-
-repCtxt :: Core [TH.TypeQ] -> DsM (Core TH.CxtQ)
-repCtxt (MkC tys) = rep2 cxtName [tys]
-
-repConstr :: Core TH.Name -> HsConDetails Name (LBangType Name)
-          -> DsM (Core TH.ConQ)
-repConstr con (PrefixCon ps)
-    = do arg_tys  <- mapM repBangTy ps
-         arg_tys1 <- coreList strictTypeQTyConName arg_tys
-         rep2 normalCName [unC con, unC arg_tys1]
-repConstr con (RecCon ips)
-    = do arg_vs   <- mapM lookupLOcc (map fst ips)
-         arg_tys  <- mapM repBangTy (map snd ips)
-         arg_vtys <- zipWithM (\x y -> rep2 varStrictTypeName [unC x, unC y])
-                              arg_vs arg_tys
-         arg_vtys' <- coreList varStrictTypeQTyConName arg_vtys
-         rep2 recCName [unC con, unC arg_vtys']
-repConstr con (InfixCon st1 st2)
-    = do arg1 <- repBangTy st1
-         arg2 <- repBangTy st2
-         rep2 infixCName [unC arg1, unC con, unC arg2]
-
------------- Types -------------------
-
-repTForall :: Core [TH.Name] -> Core TH.CxtQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
-repTForall (MkC tvars) (MkC ctxt) (MkC ty)
-    = rep2 forallTName [tvars, ctxt, ty]
-
-repTvar :: Core TH.Name -> DsM (Core TH.TypeQ)
-repTvar (MkC s) = rep2 varTName [s]
-
-repTapp :: Core TH.TypeQ -> Core TH.TypeQ -> DsM (Core TH.TypeQ)
-repTapp (MkC t1) (MkC t2) = rep2 appTName [t1,t2]
-
-repTapps :: Core TH.TypeQ -> [Core TH.TypeQ] -> DsM (Core TH.TypeQ)
-repTapps f []     = return f
-repTapps f (t:ts) = do { f1 <- repTapp f t; repTapps f1 ts }
-
---------- Type constructors --------------
-
-repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
-repNamedTyCon (MkC s) = rep2 conTName [s]
-
-repTupleTyCon :: Int -> DsM (Core TH.TypeQ)
--- Note: not Core Int; it's easier to be direct here
-repTupleTyCon i = rep2 tupleTName [mkIntExpr (fromIntegral i)]
-
-repArrowTyCon :: DsM (Core TH.TypeQ)
-repArrowTyCon = rep2 arrowTName []
-
-repListTyCon :: DsM (Core TH.TypeQ)
-repListTyCon = rep2 listTName []
-
-
-----------------------------------------------------------
---		Literals
-
-repLiteral :: HsLit -> DsM (Core TH.Lit)
-repLiteral lit 
-  = do lit' <- case lit of
-                   HsIntPrim i    -> mk_integer i
-                   HsInt i        -> mk_integer i
-                   HsFloatPrim r  -> mk_rational r
-                   HsDoublePrim r -> mk_rational r
-                   _ -> return lit
-       lit_expr <- dsLit lit'
-       rep2 lit_name [lit_expr]
-  where
-    lit_name = case lit of
-		 HsInteger _ _  -> integerLName
-		 HsInt     _    -> integerLName
-		 HsIntPrim _    -> intPrimLName
-		 HsFloatPrim _  -> floatPrimLName
-		 HsDoublePrim _ -> doublePrimLName
-		 HsChar _       -> charLName
-		 HsString _     -> stringLName
-		 HsRat _ _      -> rationalLName
-		 other 	        -> uh_oh
-    uh_oh = pprPanic "DsMeta.repLiteral: trying to represent exotic literal"
-		    (ppr lit)
-
-mk_integer  i = do integer_ty <- lookupType integerTyConName
-                   return $ HsInteger i integer_ty
-mk_rational r = do rat_ty <- lookupType rationalTyConName
-                   return $ HsRat r rat_ty
-
-repOverloadedLiteral :: HsOverLit Name -> DsM (Core TH.Lit)
-repOverloadedLiteral (HsIntegral i _)   = do { lit <- mk_integer  i; repLiteral lit }
-repOverloadedLiteral (HsFractional f _) = do { lit <- mk_rational f; repLiteral lit }
-	-- The type Rational will be in the environment, becuase 
-	-- the smart constructor 'TH.Syntax.rationalL' uses it in its type,
-	-- and rationalL is sucked in when any TH stuff is used
-              
---------------- Miscellaneous -------------------
-
-repGensym :: Core String -> DsM (Core (TH.Q TH.Name))
-repGensym (MkC lit_str) = rep2 newNameName [lit_str]
-
-repBindQ :: Type -> Type	-- a and b
-	 -> Core (TH.Q a) -> Core (a -> TH.Q b) -> DsM (Core (TH.Q b))
-repBindQ ty_a ty_b (MkC x) (MkC y) 
-  = rep2 bindQName [Type ty_a, Type ty_b, x, y] 
-
-repSequenceQ :: Type -> Core [TH.Q a] -> DsM (Core (TH.Q [a]))
-repSequenceQ ty_a (MkC list)
-  = rep2 sequenceQName [Type ty_a, list]
-
------------- Lists and Tuples -------------------
--- turn a list of patterns into a single pattern matching a list
-
-coreList :: Name	-- Of the TyCon of the element type
-	 -> [Core a] -> DsM (Core [a])
-coreList tc_name es 
-  = do { elt_ty <- lookupType tc_name; return (coreList' elt_ty es) }
-
-coreList' :: Type 	-- The element type
-	  -> [Core a] -> Core [a]
-coreList' elt_ty es = MkC (mkListExpr elt_ty (map unC es ))
-
-nonEmptyCoreList :: [Core a] -> Core [a]
-  -- The list must be non-empty so we can get the element type
-  -- Otherwise use coreList
-nonEmptyCoreList [] 	      = panic "coreList: empty argument"
-nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs))
-
-corePair :: (Core a, Core b) -> Core (a,b)
-corePair (MkC x, MkC y) = MkC (mkCoreTup [x,y])
-
-coreStringLit :: String -> DsM (Core String)
-coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
-
-coreIntLit :: Int -> DsM (Core Int)
-coreIntLit i = return (MkC (mkIntExpr (fromIntegral i)))
-
-coreVar :: Id -> Core TH.Name	-- The Id has type Name
-coreVar id = MkC (Var id)
-
-
-
--- %************************************************************************
--- %*									*
---		The known-key names for Template Haskell
--- %*									*
--- %************************************************************************
-
--- To add a name, do three things
--- 
---  1) Allocate a key
---  2) Make a "Name"
---  3) Add the name to knownKeyNames
-
-templateHaskellNames :: [Name]
--- The names that are implicitly mentioned by ``bracket''
--- Should stay in sync with the import list of DsMeta
-
-templateHaskellNames = [
-    returnQName, bindQName, sequenceQName, newNameName, liftName,
-    mkNameName, mkNameG_vName, mkNameG_dName, mkNameG_tcName, mkNameLName, 
-
-    -- Lit
-    charLName, stringLName, integerLName, intPrimLName,
-    floatPrimLName, doublePrimLName, rationalLName,
-    -- Pat
-    litPName, varPName, tupPName, conPName, tildePName, infixPName,
-    asPName, wildPName, recPName, listPName, sigPName,
-    -- FieldPat
-    fieldPatName,
-    -- Match
-    matchName,
-    -- Clause
-    clauseName,
-    -- Exp
-    varEName, conEName, litEName, appEName, infixEName,
-    infixAppName, sectionLName, sectionRName, lamEName, tupEName,
-    condEName, letEName, caseEName, doEName, compEName,
-    fromEName, fromThenEName, fromToEName, fromThenToEName,
-    listEName, sigEName, recConEName, recUpdEName,
-    -- FieldExp
-    fieldExpName,
-    -- Body
-    guardedBName, normalBName,
-    -- Guard
-    normalGEName, patGEName,
-    -- Stmt
-    bindSName, letSName, noBindSName, parSName,
-    -- Dec
-    funDName, valDName, dataDName, newtypeDName, tySynDName,
-    classDName, instanceDName, sigDName, forImpDName,
-    -- Cxt
-    cxtName,
-    -- Strict
-    isStrictName, notStrictName,
-    -- Con
-    normalCName, recCName, infixCName, forallCName,
-    -- StrictType
-    strictTypeName,
-    -- VarStrictType
-    varStrictTypeName,
-    -- Type
-    forallTName, varTName, conTName, appTName,
-    tupleTName, arrowTName, listTName,
-    -- Callconv
-    cCallName, stdCallName,
-    -- Safety
-    unsafeName,
-    safeName,
-    threadsafeName,
-    -- FunDep
-    funDepName,
-
-    -- And the tycons
-    qTyConName, nameTyConName, patTyConName, fieldPatTyConName, matchQTyConName,
-    clauseQTyConName, expQTyConName, fieldExpTyConName, stmtQTyConName,
-    decQTyConName, conQTyConName, strictTypeQTyConName,
-    varStrictTypeQTyConName, typeQTyConName, expTyConName, decTyConName,
-    typeTyConName, matchTyConName, clauseTyConName, patQTyConName,
-    fieldPatQTyConName, fieldExpQTyConName, funDepTyConName]
-
-thSyn :: Module
-thSyn = mkModule "Language.Haskell.TH.Syntax"
-thLib = mkModule "Language.Haskell.TH.Lib"
-
-mk_known_key_name mod space str uniq 
-  = mkExternalName uniq mod (mkOccNameFS space str) 
-	           Nothing noSrcLoc
-
-libFun = mk_known_key_name thLib OccName.varName
-libTc  = mk_known_key_name thLib OccName.tcName
-thFun  = mk_known_key_name thSyn OccName.varName
-thTc   = mk_known_key_name thSyn OccName.tcName
-
--------------------- TH.Syntax -----------------------
-qTyConName        = thTc FSLIT("Q")            qTyConKey
-nameTyConName     = thTc FSLIT("Name")         nameTyConKey
-fieldExpTyConName = thTc FSLIT("FieldExp")     fieldExpTyConKey
-patTyConName      = thTc FSLIT("Pat")          patTyConKey
-fieldPatTyConName = thTc FSLIT("FieldPat")     fieldPatTyConKey
-expTyConName      = thTc FSLIT("Exp")          expTyConKey
-decTyConName      = thTc FSLIT("Dec")          decTyConKey
-typeTyConName     = thTc FSLIT("Type")         typeTyConKey
-matchTyConName    = thTc FSLIT("Match")        matchTyConKey
-clauseTyConName   = thTc FSLIT("Clause")       clauseTyConKey
-funDepTyConName   = thTc FSLIT("FunDep")       funDepTyConKey
-
-returnQName   = thFun FSLIT("returnQ")   returnQIdKey
-bindQName     = thFun FSLIT("bindQ")     bindQIdKey
-sequenceQName = thFun FSLIT("sequenceQ") sequenceQIdKey
-newNameName    = thFun FSLIT("newName")   newNameIdKey
-liftName      = thFun FSLIT("lift")      liftIdKey
-mkNameName     = thFun FSLIT("mkName")     mkNameIdKey
-mkNameG_vName  = thFun FSLIT("mkNameG_v")  mkNameG_vIdKey
-mkNameG_dName  = thFun FSLIT("mkNameG_d")  mkNameG_dIdKey
-mkNameG_tcName = thFun FSLIT("mkNameG_tc") mkNameG_tcIdKey
-mkNameLName    = thFun FSLIT("mkNameL")    mkNameLIdKey
-
-
--------------------- TH.Lib -----------------------
--- data Lit = ...
-charLName       = libFun FSLIT("charL")       charLIdKey
-stringLName     = libFun FSLIT("stringL")     stringLIdKey
-integerLName    = libFun FSLIT("integerL")    integerLIdKey
-intPrimLName    = libFun FSLIT("intPrimL")    intPrimLIdKey
-floatPrimLName  = libFun FSLIT("floatPrimL")  floatPrimLIdKey
-doublePrimLName = libFun FSLIT("doublePrimL") doublePrimLIdKey
-rationalLName   = libFun FSLIT("rationalL")     rationalLIdKey
-
--- data Pat = ...
-litPName   = libFun FSLIT("litP")   litPIdKey
-varPName   = libFun FSLIT("varP")   varPIdKey
-tupPName   = libFun FSLIT("tupP")   tupPIdKey
-conPName   = libFun FSLIT("conP")   conPIdKey
-infixPName = libFun FSLIT("infixP") infixPIdKey
-tildePName = libFun FSLIT("tildeP") tildePIdKey
-asPName    = libFun FSLIT("asP")    asPIdKey
-wildPName  = libFun FSLIT("wildP")  wildPIdKey
-recPName   = libFun FSLIT("recP")   recPIdKey
-listPName  = libFun FSLIT("listP")  listPIdKey
-sigPName   = libFun FSLIT("sigP")   sigPIdKey
-
--- type FieldPat = ...
-fieldPatName = libFun FSLIT("fieldPat") fieldPatIdKey
-
--- data Match = ...
-matchName = libFun FSLIT("match") matchIdKey
-
--- data Clause = ...	 
-clauseName = libFun FSLIT("clause") clauseIdKey
-
--- data Exp = ...
-varEName        = libFun FSLIT("varE")        varEIdKey
-conEName        = libFun FSLIT("conE")        conEIdKey
-litEName        = libFun FSLIT("litE")        litEIdKey
-appEName        = libFun FSLIT("appE")        appEIdKey
-infixEName      = libFun FSLIT("infixE")      infixEIdKey
-infixAppName    = libFun FSLIT("infixApp")    infixAppIdKey
-sectionLName    = libFun FSLIT("sectionL")    sectionLIdKey
-sectionRName    = libFun FSLIT("sectionR")    sectionRIdKey
-lamEName        = libFun FSLIT("lamE")        lamEIdKey
-tupEName        = libFun FSLIT("tupE")        tupEIdKey
-condEName       = libFun FSLIT("condE")       condEIdKey
-letEName        = libFun FSLIT("letE")        letEIdKey
-caseEName       = libFun FSLIT("caseE")       caseEIdKey
-doEName         = libFun FSLIT("doE")         doEIdKey
-compEName       = libFun FSLIT("compE")       compEIdKey
--- ArithSeq skips a level
-fromEName       = libFun FSLIT("fromE")       fromEIdKey
-fromThenEName   = libFun FSLIT("fromThenE")   fromThenEIdKey
-fromToEName     = libFun FSLIT("fromToE")     fromToEIdKey
-fromThenToEName = libFun FSLIT("fromThenToE") fromThenToEIdKey
--- end ArithSeq
-listEName       = libFun FSLIT("listE")       listEIdKey
-sigEName        = libFun FSLIT("sigE")        sigEIdKey
-recConEName     = libFun FSLIT("recConE")     recConEIdKey
-recUpdEName     = libFun FSLIT("recUpdE")     recUpdEIdKey
-
--- type FieldExp = ...
-fieldExpName = libFun FSLIT("fieldExp") fieldExpIdKey
-
--- data Body = ...
-guardedBName = libFun FSLIT("guardedB") guardedBIdKey
-normalBName  = libFun FSLIT("normalB")  normalBIdKey
-
--- data Guard = ...
-normalGEName = libFun FSLIT("normalGE") normalGEIdKey
-patGEName    = libFun FSLIT("patGE")    patGEIdKey
-
--- data Stmt = ...
-bindSName   = libFun FSLIT("bindS")   bindSIdKey
-letSName    = libFun FSLIT("letS")    letSIdKey
-noBindSName = libFun FSLIT("noBindS") noBindSIdKey
-parSName    = libFun FSLIT("parS")    parSIdKey
-
--- data Dec = ...
-funDName      = libFun FSLIT("funD")      funDIdKey
-valDName      = libFun FSLIT("valD")      valDIdKey
-dataDName     = libFun FSLIT("dataD")     dataDIdKey
-newtypeDName  = libFun FSLIT("newtypeD")  newtypeDIdKey
-tySynDName    = libFun FSLIT("tySynD")    tySynDIdKey
-classDName    = libFun FSLIT("classD")    classDIdKey
-instanceDName = libFun FSLIT("instanceD") instanceDIdKey
-sigDName      = libFun FSLIT("sigD")      sigDIdKey
-forImpDName   = libFun FSLIT("forImpD")   forImpDIdKey
-
--- type Ctxt = ...
-cxtName = libFun FSLIT("cxt") cxtIdKey
-
--- data Strict = ...
-isStrictName      = libFun  FSLIT("isStrict")      isStrictKey
-notStrictName     = libFun  FSLIT("notStrict")     notStrictKey
-
--- data Con = ...	 
-normalCName = libFun FSLIT("normalC") normalCIdKey
-recCName    = libFun FSLIT("recC")    recCIdKey
-infixCName  = libFun FSLIT("infixC")  infixCIdKey
-forallCName  = libFun FSLIT("forallC")  forallCIdKey
-			 
--- type StrictType = ...
-strictTypeName    = libFun  FSLIT("strictType")    strictTKey
-
--- type VarStrictType = ...
-varStrictTypeName = libFun  FSLIT("varStrictType") varStrictTKey
-
--- data Type = ...
-forallTName = libFun FSLIT("forallT") forallTIdKey
-varTName    = libFun FSLIT("varT")    varTIdKey
-conTName    = libFun FSLIT("conT")    conTIdKey
-tupleTName  = libFun FSLIT("tupleT") tupleTIdKey
-arrowTName  = libFun FSLIT("arrowT") arrowTIdKey
-listTName   = libFun FSLIT("listT")  listTIdKey
-appTName    = libFun FSLIT("appT")    appTIdKey
-			 
--- data Callconv = ...
-cCallName = libFun FSLIT("cCall") cCallIdKey
-stdCallName = libFun FSLIT("stdCall") stdCallIdKey
-
--- data Safety = ...
-unsafeName     = libFun FSLIT("unsafe") unsafeIdKey
-safeName       = libFun FSLIT("safe") safeIdKey
-threadsafeName = libFun FSLIT("threadsafe") threadsafeIdKey
-             
--- data FunDep = ...
-funDepName     = libFun FSLIT("funDep") funDepIdKey
-
-matchQTyConName         = libTc FSLIT("MatchQ")        matchQTyConKey
-clauseQTyConName        = libTc FSLIT("ClauseQ")       clauseQTyConKey
-expQTyConName           = libTc FSLIT("ExpQ")          expQTyConKey
-stmtQTyConName          = libTc FSLIT("StmtQ")         stmtQTyConKey
-decQTyConName           = libTc FSLIT("DecQ")          decQTyConKey
-conQTyConName           = libTc FSLIT("ConQ")          conQTyConKey
-strictTypeQTyConName    = libTc FSLIT("StrictTypeQ")    strictTypeQTyConKey
-varStrictTypeQTyConName = libTc FSLIT("VarStrictTypeQ") varStrictTypeQTyConKey
-typeQTyConName          = libTc FSLIT("TypeQ")          typeQTyConKey
-fieldExpQTyConName      = libTc FSLIT("FieldExpQ")      fieldExpQTyConKey
-patQTyConName           = libTc FSLIT("PatQ")           patQTyConKey
-fieldPatQTyConName      = libTc FSLIT("FieldPatQ")      fieldPatQTyConKey
-
---	TyConUniques available: 100-129
--- 	Check in PrelNames if you want to change this
-
-expTyConKey             = mkPreludeTyConUnique 100
-matchTyConKey           = mkPreludeTyConUnique 101
-clauseTyConKey          = mkPreludeTyConUnique 102
-qTyConKey               = mkPreludeTyConUnique 103
-expQTyConKey            = mkPreludeTyConUnique 104
-decQTyConKey            = mkPreludeTyConUnique 105
-patTyConKey             = mkPreludeTyConUnique 106
-matchQTyConKey          = mkPreludeTyConUnique 107
-clauseQTyConKey         = mkPreludeTyConUnique 108
-stmtQTyConKey           = mkPreludeTyConUnique 109
-conQTyConKey            = mkPreludeTyConUnique 110
-typeQTyConKey           = mkPreludeTyConUnique 111
-typeTyConKey            = mkPreludeTyConUnique 112
-decTyConKey             = mkPreludeTyConUnique 113
-varStrictTypeQTyConKey  = mkPreludeTyConUnique 114
-strictTypeQTyConKey     = mkPreludeTyConUnique 115
-fieldExpTyConKey        = mkPreludeTyConUnique 116
-fieldPatTyConKey        = mkPreludeTyConUnique 117
-nameTyConKey            = mkPreludeTyConUnique 118
-patQTyConKey            = mkPreludeTyConUnique 119
-fieldPatQTyConKey       = mkPreludeTyConUnique 120
-fieldExpQTyConKey       = mkPreludeTyConUnique 121
-funDepTyConKey          = mkPreludeTyConUnique 122
-
--- 	IdUniques available: 200-399
--- 	If you want to change this, make sure you check in PrelNames
-
-returnQIdKey        = mkPreludeMiscIdUnique 200
-bindQIdKey          = mkPreludeMiscIdUnique 201
-sequenceQIdKey      = mkPreludeMiscIdUnique 202
-liftIdKey           = mkPreludeMiscIdUnique 203
-newNameIdKey         = mkPreludeMiscIdUnique 204
-mkNameIdKey          = mkPreludeMiscIdUnique 205
-mkNameG_vIdKey       = mkPreludeMiscIdUnique 206
-mkNameG_dIdKey       = mkPreludeMiscIdUnique 207
-mkNameG_tcIdKey      = mkPreludeMiscIdUnique 208
-mkNameLIdKey         = mkPreludeMiscIdUnique 209
-
-
--- data Lit = ...
-charLIdKey        = mkPreludeMiscIdUnique 210
-stringLIdKey      = mkPreludeMiscIdUnique 211
-integerLIdKey     = mkPreludeMiscIdUnique 212
-intPrimLIdKey     = mkPreludeMiscIdUnique 213
-floatPrimLIdKey   = mkPreludeMiscIdUnique 214
-doublePrimLIdKey  = mkPreludeMiscIdUnique 215
-rationalLIdKey    = mkPreludeMiscIdUnique 216
-
--- data Pat = ...
-litPIdKey         = mkPreludeMiscIdUnique 220
-varPIdKey         = mkPreludeMiscIdUnique 221
-tupPIdKey         = mkPreludeMiscIdUnique 222
-conPIdKey         = mkPreludeMiscIdUnique 223
-infixPIdKey       = mkPreludeMiscIdUnique 312
-tildePIdKey       = mkPreludeMiscIdUnique 224
-asPIdKey          = mkPreludeMiscIdUnique 225
-wildPIdKey        = mkPreludeMiscIdUnique 226
-recPIdKey         = mkPreludeMiscIdUnique 227
-listPIdKey        = mkPreludeMiscIdUnique 228
-sigPIdKey         = mkPreludeMiscIdUnique 229
-
--- type FieldPat = ...
-fieldPatIdKey       = mkPreludeMiscIdUnique 230
-
--- data Match = ...
-matchIdKey          = mkPreludeMiscIdUnique 231
-
--- data Clause = ...
-clauseIdKey         = mkPreludeMiscIdUnique 232
-
--- data Exp = ...
-varEIdKey         = mkPreludeMiscIdUnique 240
-conEIdKey         = mkPreludeMiscIdUnique 241
-litEIdKey         = mkPreludeMiscIdUnique 242
-appEIdKey         = mkPreludeMiscIdUnique 243
-infixEIdKey       = mkPreludeMiscIdUnique 244
-infixAppIdKey       = mkPreludeMiscIdUnique 245
-sectionLIdKey       = mkPreludeMiscIdUnique 246
-sectionRIdKey       = mkPreludeMiscIdUnique 247
-lamEIdKey         = mkPreludeMiscIdUnique 248
-tupEIdKey         = mkPreludeMiscIdUnique 249
-condEIdKey        = mkPreludeMiscIdUnique 250
-letEIdKey         = mkPreludeMiscIdUnique 251
-caseEIdKey        = mkPreludeMiscIdUnique 252
-doEIdKey          = mkPreludeMiscIdUnique 253
-compEIdKey        = mkPreludeMiscIdUnique 254
-fromEIdKey        = mkPreludeMiscIdUnique 255
-fromThenEIdKey    = mkPreludeMiscIdUnique 256
-fromToEIdKey      = mkPreludeMiscIdUnique 257
-fromThenToEIdKey  = mkPreludeMiscIdUnique 258
-listEIdKey        = mkPreludeMiscIdUnique 259
-sigEIdKey         = mkPreludeMiscIdUnique 260
-recConEIdKey      = mkPreludeMiscIdUnique 261
-recUpdEIdKey      = mkPreludeMiscIdUnique 262
-
--- type FieldExp = ...
-fieldExpIdKey       = mkPreludeMiscIdUnique 265
-
--- data Body = ...
-guardedBIdKey     = mkPreludeMiscIdUnique 266
-normalBIdKey      = mkPreludeMiscIdUnique 267
-
--- data Guard = ...
-normalGEIdKey     = mkPreludeMiscIdUnique 310
-patGEIdKey        = mkPreludeMiscIdUnique 311
-
--- data Stmt = ...
-bindSIdKey       = mkPreludeMiscIdUnique 268
-letSIdKey        = mkPreludeMiscIdUnique 269
-noBindSIdKey     = mkPreludeMiscIdUnique 270
-parSIdKey        = mkPreludeMiscIdUnique 271
-
--- data Dec = ...
-funDIdKey         = mkPreludeMiscIdUnique 272
-valDIdKey         = mkPreludeMiscIdUnique 273
-dataDIdKey        = mkPreludeMiscIdUnique 274
-newtypeDIdKey     = mkPreludeMiscIdUnique 275
-tySynDIdKey       = mkPreludeMiscIdUnique 276
-classDIdKey       = mkPreludeMiscIdUnique 277
-instanceDIdKey    = mkPreludeMiscIdUnique 278
-sigDIdKey         = mkPreludeMiscIdUnique 279
-forImpDIdKey      = mkPreludeMiscIdUnique 297
-
--- type Cxt = ...
-cxtIdKey            = mkPreludeMiscIdUnique 280
-
--- data Strict = ...
-isStrictKey         = mkPreludeMiscIdUnique 281
-notStrictKey        = mkPreludeMiscIdUnique 282
-
--- data Con = ...
-normalCIdKey      = mkPreludeMiscIdUnique 283
-recCIdKey         = mkPreludeMiscIdUnique 284
-infixCIdKey       = mkPreludeMiscIdUnique 285
-forallCIdKey      = mkPreludeMiscIdUnique 288
-
--- type StrictType = ...
-strictTKey        = mkPreludeMiscIdUnique 286
-
--- type VarStrictType = ...
-varStrictTKey     = mkPreludeMiscIdUnique 287
-
--- data Type = ...
-forallTIdKey      = mkPreludeMiscIdUnique 290
-varTIdKey         = mkPreludeMiscIdUnique 291
-conTIdKey         = mkPreludeMiscIdUnique 292
-tupleTIdKey       = mkPreludeMiscIdUnique 294
-arrowTIdKey       = mkPreludeMiscIdUnique 295
-listTIdKey        = mkPreludeMiscIdUnique 296
-appTIdKey         = mkPreludeMiscIdUnique 293
-
--- data Callconv = ...
-cCallIdKey      = mkPreludeMiscIdUnique 300
-stdCallIdKey    = mkPreludeMiscIdUnique 301
-
--- data Safety = ...
-unsafeIdKey     = mkPreludeMiscIdUnique 305
-safeIdKey       = mkPreludeMiscIdUnique 306
-threadsafeIdKey = mkPreludeMiscIdUnique 307
-
--- data FunDep = ...
-funDepIdKey = mkPreludeMiscIdUnique 320
-
diff --git a/ghc/compiler/deSugar/DsMonad.lhs b/ghc/compiler/deSugar/DsMonad.lhs
deleted file mode 100644
index f24dee4905..0000000000
--- a/ghc/compiler/deSugar/DsMonad.lhs
+++ /dev/null
@@ -1,285 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[DsMonad]{@DsMonad@: monadery used in desugaring}
-
-\begin{code}
-module DsMonad (
-	DsM, mappM, mapAndUnzipM,
-	initDs, returnDs, thenDs, listDs, fixDs, mapAndUnzipDs, 
-	foldlDs, foldrDs,
-
-	newTyVarsDs, newLocalName,
-	duplicateLocalDs, newSysLocalDs, newSysLocalsDs, newUniqueId,
-	newFailLocalDs,
-	getSrcSpanDs, putSrcSpanDs,
-	getModuleDs,
-	newUnique, 
-	UniqSupply, newUniqueSupply,
-	getDOptsDs,
-	dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon, dsLookupDataCon,
-
-	DsMetaEnv, DsMetaVal(..), dsLookupMetaEnv, dsExtendMetaEnv,
-
-	-- Warnings
-	DsWarning, dsWarn, 
-
-	-- Data types
-	DsMatchContext(..),
-	EquationInfo(..), MatchResult(..), DsWrapper, idWrapper,
-	CanItFail(..), orFail
-    ) where
-
-#include "HsVersions.h"
-
-import TcRnMonad
-import CoreSyn		( CoreExpr )
-import HsSyn		( HsExpr, HsMatchContext, Pat )
-import TcIface		( tcIfaceGlobal )
-import RdrName		( GlobalRdrEnv )
-import HscTypes		( TyThing(..), TypeEnv, HscEnv, 
-			  tyThingId, tyThingTyCon, tyThingDataCon, unQualInScope )
-import Bag		( emptyBag, snocBag, Bag )
-import DataCon		( DataCon )
-import TyCon		( TyCon )
-import Id		( mkSysLocal, setIdUnique, Id )
-import Module		( Module )
-import Var		( TyVar, setTyVarUnique )
-import Outputable
-import SrcLoc		( noSrcSpan, SrcSpan )
-import Type             ( Type )
-import UniqSupply	( UniqSupply, uniqsFromSupply )
-import Name		( Name, nameOccName )
-import NameEnv
-import OccName          ( occNameFS )
-import DynFlags	( DynFlags )
-import ErrUtils		( WarnMsg, mkWarnMsg )
-import Bag		( mapBag )
-
-import DATA_IOREF	( newIORef, readIORef )
-
-infixr 9 `thenDs`
-\end{code}
-
-%************************************************************************
-%*									*
-		Data types for the desugarer
-%*									*
-%************************************************************************
-
-\begin{code}
-data DsMatchContext
-  = DsMatchContext (HsMatchContext Name) SrcSpan
-  | NoMatchContext
-  deriving ()
-
-data EquationInfo
-  = EqnInfo { eqn_wrap :: DsWrapper,	-- Bindings
-	      eqn_pats :: [Pat Id],    	-- The patterns for an eqn
-	      eqn_rhs  :: MatchResult }	-- What to do after match
-
-type DsWrapper = CoreExpr -> CoreExpr
-idWrapper e = e
-
--- The semantics of (match vs (EqnInfo wrap pats rhs)) is the MatchResult
---	\fail. wrap (case vs of { pats -> rhs fail })
--- where vs are not bound by wrap
-
-
--- A MatchResult is an expression with a hole in it
-data MatchResult
-  = MatchResult
-	CanItFail	-- Tells whether the failure expression is used
-	(CoreExpr -> DsM CoreExpr)
-			-- Takes a expression to plug in at the
-			-- failure point(s). The expression should
-			-- be duplicatable!
-
-data CanItFail = CanFail | CantFail
-
-orFail CantFail CantFail = CantFail
-orFail _        _	 = CanFail
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Monad stuff
-%*									*
-%************************************************************************
-
-Now the mondo monad magic (yes, @DsM@ is a silly name)---carry around
-a @UniqueSupply@ and some annotations, which
-presumably include source-file location information:
-\begin{code}
-type DsM result = TcRnIf DsGblEnv DsLclEnv result
-
--- Compatibility functions
-fixDs    = fixM
-thenDs   = thenM
-returnDs = returnM
-listDs   = sequenceM
-foldlDs  = foldlM
-foldrDs  = foldrM
-mapAndUnzipDs = mapAndUnzipM
-
-
-type DsWarning = (SrcSpan, SDoc)
-	-- Not quite the same as a WarnMsg, we have an SDoc here 
-	-- and we'll do the print_unqual stuff later on to turn it
-	-- into a Doc.
-
-data DsGblEnv = DsGblEnv {
-	ds_mod	   :: Module,       		-- For SCC profiling
-	ds_warns   :: IORef (Bag DsWarning),	-- Warning messages
-	ds_if_env  :: (IfGblEnv, IfLclEnv)	-- Used for looking up global, 
-						-- possibly-imported things
-    }
-
-data DsLclEnv = DsLclEnv {
-	ds_meta	   :: DsMetaEnv,	-- Template Haskell bindings
-	ds_loc	   :: SrcSpan		-- to put in pattern-matching error msgs
-     }
-
--- Inside [| |] brackets, the desugarer looks 
--- up variables in the DsMetaEnv
-type DsMetaEnv = NameEnv DsMetaVal
-
-data DsMetaVal
-   = Bound Id		-- Bound by a pattern inside the [| |]. 
-			-- Will be dynamically alpha renamed.
-			-- The Id has type THSyntax.Var
-
-   | Splice (HsExpr Id)	-- These bindings are introduced by
-			-- the PendingSplices on a HsBracketOut
-
--- initDs returns the UniqSupply out the end (not just the result)
-
-initDs  :: HscEnv
-	-> Module -> GlobalRdrEnv -> TypeEnv
-	-> DsM a
-	-> IO (a, Bag WarnMsg)
-
-initDs hsc_env mod rdr_env type_env thing_inside
-  = do 	{ warn_var <- newIORef emptyBag
-	; let { if_genv = IfGblEnv { if_rec_types = Just (mod, return type_env) }
-	      ; if_lenv = mkIfLclEnv mod (ptext SLIT("GHC error in desugarer lookup in") <+> ppr mod)
-	      ; gbl_env = DsGblEnv { ds_mod = mod, 
-				     ds_if_env = (if_genv, if_lenv),
-				     ds_warns = warn_var }
-	      ; lcl_env = DsLclEnv { ds_meta = emptyNameEnv, 
-				     ds_loc = noSrcSpan } }
-
-	; res <- initTcRnIf 'd' hsc_env gbl_env lcl_env thing_inside
-
-	; warns <- readIORef warn_var
-	; return (res, mapBag mk_warn warns)
-	}
-   where
-    print_unqual = unQualInScope rdr_env
-
-    mk_warn :: (SrcSpan,SDoc) -> WarnMsg
-    mk_warn (loc,sdoc) = mkWarnMsg loc print_unqual sdoc
-\end{code}
-
-%************************************************************************
-%*									*
-		Operations in the monad
-%*									*
-%************************************************************************
-
-And all this mysterious stuff is so we can occasionally reach out and
-grab one or more names.  @newLocalDs@ isn't exported---exported
-functions are defined with it.  The difference in name-strings makes
-it easier to read debugging output.
-
-\begin{code}
--- Make a new Id with the same print name, but different type, and new unique
-newUniqueId :: Name -> Type -> DsM Id
-newUniqueId id ty
-  = newUnique 	`thenDs` \ uniq ->
-    returnDs (mkSysLocal (occNameFS (nameOccName id)) uniq ty)
-
-duplicateLocalDs :: Id -> DsM Id
-duplicateLocalDs old_local 
-  = newUnique 	`thenDs` \ uniq ->
-    returnDs (setIdUnique old_local uniq)
-
-newSysLocalDs, newFailLocalDs :: Type -> DsM Id
-newSysLocalDs ty
-  = newUnique 	`thenDs` \ uniq ->
-    returnDs (mkSysLocal FSLIT("ds") uniq ty)
-
-newSysLocalsDs tys = mappM newSysLocalDs tys
-
-newFailLocalDs ty 
-  = newUnique 	`thenDs` \ uniq ->
-    returnDs (mkSysLocal FSLIT("fail") uniq ty)
-	-- The UserLocal bit just helps make the code a little clearer
-\end{code}
-
-\begin{code}
-newTyVarsDs :: [TyVar] -> DsM [TyVar]
-newTyVarsDs tyvar_tmpls 
-  = newUniqueSupply	`thenDs` \ uniqs ->
-    returnDs (zipWith setTyVarUnique tyvar_tmpls (uniqsFromSupply uniqs))
-\end{code}
-
-We can also reach out and either set/grab location information from
-the @SrcSpan@ being carried around.
-
-\begin{code}
-getDOptsDs :: DsM DynFlags
-getDOptsDs = getDOpts
-
-getModuleDs :: DsM Module
-getModuleDs = do { env <- getGblEnv; return (ds_mod env) }
-
-getSrcSpanDs :: DsM SrcSpan
-getSrcSpanDs = do { env <- getLclEnv; return (ds_loc env) }
-
-putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
-putSrcSpanDs new_loc thing_inside = updLclEnv (\ env -> env {ds_loc = new_loc}) thing_inside
-
-dsWarn :: SDoc -> DsM ()
-dsWarn warn = do { env <- getGblEnv 
-		 ; loc <- getSrcSpanDs
-		 ; updMutVar (ds_warns env) (`snocBag` (loc,msg)) }
-	    where
-	      msg = ptext SLIT("Warning:") <+> warn
-\end{code}
-
-\begin{code}
-dsLookupGlobal :: Name -> DsM TyThing
--- Very like TcEnv.tcLookupGlobal
-dsLookupGlobal name 
-  = do	{ env <- getGblEnv
-	; setEnvs (ds_if_env env)
-		  (tcIfaceGlobal name) }
-
-dsLookupGlobalId :: Name -> DsM Id
-dsLookupGlobalId name 
-  = dsLookupGlobal name		`thenDs` \ thing ->
-    returnDs (tyThingId thing)
-
-dsLookupTyCon :: Name -> DsM TyCon
-dsLookupTyCon name
-  = dsLookupGlobal name		`thenDs` \ thing ->
-    returnDs (tyThingTyCon thing)
-
-dsLookupDataCon :: Name -> DsM DataCon
-dsLookupDataCon name
-  = dsLookupGlobal name		`thenDs` \ thing ->
-    returnDs (tyThingDataCon thing)
-\end{code}
-
-\begin{code}
-dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal)
-dsLookupMetaEnv name = do { env <- getLclEnv; return (lookupNameEnv (ds_meta env) name) }
-
-dsExtendMetaEnv :: DsMetaEnv -> DsM a -> DsM a
-dsExtendMetaEnv menv thing_inside
-  = updLclEnv (\env -> env { ds_meta = ds_meta env `plusNameEnv` menv }) thing_inside
-\end{code}
-
-
diff --git a/ghc/compiler/deSugar/DsUtils.lhs b/ghc/compiler/deSugar/DsUtils.lhs
deleted file mode 100644
index 29e7773bb8..0000000000
--- a/ghc/compiler/deSugar/DsUtils.lhs
+++ /dev/null
@@ -1,884 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[DsUtils]{Utilities for desugaring}
-
-This module exports some utility functions of no great interest.
-
-\begin{code}
-module DsUtils (
-	EquationInfo(..), 
-	firstPat, shiftEqns,
-	
-	mkDsLet, mkDsLets,
-
-	MatchResult(..), CanItFail(..), 
-	cantFailMatchResult, alwaysFailMatchResult,
-	extractMatchResult, combineMatchResults, 
-	adjustMatchResult,  adjustMatchResultDs,
-	mkCoLetMatchResult, mkGuardedMatchResult, 
-	matchCanFail,
-	mkCoPrimCaseMatchResult, mkCoAlgCaseMatchResult,
-	wrapBind, wrapBinds,
-
-	mkErrorAppDs, mkNilExpr, mkConsExpr, mkListExpr,
-	mkIntExpr, mkCharExpr,
-	mkStringExpr, mkStringExprFS, mkIntegerExpr, 
-
-	mkSelectorBinds, mkTupleExpr, mkTupleSelector, 
-	mkTupleType, mkTupleCase, mkBigCoreTup,
-	mkCoreTup, mkCoreTupTy, seqVar,
-	
-	dsSyntaxTable, lookupEvidence,
-
-	selectSimpleMatchVarL, selectMatchVars, selectMatchVar
-    ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-}	Match ( matchSimply )
-import {-# SOURCE #-}	DsExpr( dsExpr )
-
-import HsSyn
-import TcHsSyn		( hsPatType )
-import CoreSyn
-import Constants	( mAX_TUPLE_SIZE )
-import DsMonad
-
-import CoreUtils	( exprType, mkIfThenElse, mkCoerce, bindNonRec )
-import MkId		( iRREFUT_PAT_ERROR_ID, mkReboxingAlt, mkNewTypeBody )
-import Id		( idType, Id, mkWildId, mkTemplateLocals, mkSysLocal )
-import Var		( Var )
-import Name		( Name )
-import Literal		( Literal(..), mkStringLit, inIntRange, tARGET_MAX_INT )
-import TyCon		( isNewTyCon, tyConDataCons )
-import DataCon		( DataCon, dataConSourceArity, dataConTyCon, dataConTag )
-import Type		( mkFunTy, isUnLiftedType, Type, splitTyConApp, mkTyVarTy )
-import TcType		( tcEqType )
-import TysPrim		( intPrimTy )
-import TysWiredIn	( nilDataCon, consDataCon, 
-                          tupleCon, mkTupleTy,
-			  unitDataConId, unitTy,
-                          charTy, charDataCon, 
-                          intTy, intDataCon, 
-			  isPArrFakeCon )
-import BasicTypes	( Boxity(..) )
-import UniqSet		( mkUniqSet, minusUniqSet, isEmptyUniqSet )
-import UniqSupply	( splitUniqSupply, uniqFromSupply, uniqsFromSupply )
-import PrelNames	( unpackCStringName, unpackCStringUtf8Name, 
-			  plusIntegerName, timesIntegerName, smallIntegerDataConName, 
-			  lengthPName, indexPName )
-import Outputable
-import SrcLoc		( Located(..), unLoc )
-import Util             ( isSingleton, zipEqual, sortWith )
-import ListSetOps	( assocDefault )
-import FastString
-import Data.Char	( ord )
-
-#ifdef DEBUG
-import Util		( notNull )	-- Used in an assertion
-#endif
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-		Rebindable syntax
-%*									*
-%************************************************************************
-
-\begin{code}
-dsSyntaxTable :: SyntaxTable Id 
-	       -> DsM ([CoreBind], 	-- Auxiliary bindings
-		       [(Name,Id)])	-- Maps the standard name to its value
-
-dsSyntaxTable rebound_ids
-  = mapAndUnzipDs mk_bind rebound_ids	`thenDs` \ (binds_s, prs) ->
-    return (concat binds_s, prs)
-  where
-	-- The cheapo special case can happen when we 
-	-- make an intermediate HsDo when desugaring a RecStmt
-    mk_bind (std_name, HsVar id) = return ([], (std_name, id))
-    mk_bind (std_name, expr)
- 	 = dsExpr expr				`thenDs` \ rhs ->
-     	   newSysLocalDs (exprType rhs)		`thenDs` \ id ->
-     	   return ([NonRec id rhs], (std_name, id))
-
-lookupEvidence :: [(Name, Id)] -> Name -> Id
-lookupEvidence prs std_name
-  = assocDefault (mk_panic std_name) prs std_name
-  where
-    mk_panic std_name = pprPanic "dsSyntaxTable" (ptext SLIT("Not found:") <+> ppr std_name)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Building lets}
-%*									*
-%************************************************************************
-
-Use case, not let for unlifted types.  The simplifier will turn some
-back again.
-
-\begin{code}
-mkDsLet :: CoreBind -> CoreExpr -> CoreExpr
-mkDsLet (NonRec bndr rhs) body
-  | isUnLiftedType (idType bndr) 
-  = Case rhs bndr (exprType body) [(DEFAULT,[],body)]
-mkDsLet bind body
-  = Let bind body
-
-mkDsLets :: [CoreBind] -> CoreExpr -> CoreExpr
-mkDsLets binds body = foldr mkDsLet body binds
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{ Selecting match variables}
-%*									*
-%************************************************************************
-
-We're about to match against some patterns.  We want to make some
-@Ids@ to use as match variables.  If a pattern has an @Id@ readily at
-hand, which should indeed be bound to the pattern as a whole, then use it;
-otherwise, make one up.
-
-\begin{code}
-selectSimpleMatchVarL :: LPat Id -> DsM Id
-selectSimpleMatchVarL pat = selectMatchVar (unLoc pat) (hsPatType pat)
-
--- (selectMatchVars ps tys) chooses variables of type tys
--- to use for matching ps against.  If the pattern is a variable,
--- we try to use that, to save inventing lots of fresh variables.
--- But even if it is a variable, its type might not match.  Consider
---	data T a where
---	  T1 :: Int -> T Int
---	  T2 :: a   -> T a
---
---	f :: T a -> a -> Int
---	f (T1 i) (x::Int) = x
---	f (T2 i) (y::a)   = 0
--- Then we must not choose (x::Int) as the matching variable!
-
-selectMatchVars :: [Pat Id] -> [Type] -> DsM [Id]
-selectMatchVars []     [] 	= return []
-selectMatchVars (p:ps) (ty:tys) = do { v  <- selectMatchVar  p  ty
-				     ; vs <- selectMatchVars ps tys
-				     ; return (v:vs) }
-
-selectMatchVar (BangPat pat)   pat_ty  = selectMatchVar (unLoc pat) pat_ty
-selectMatchVar (LazyPat pat)   pat_ty  = selectMatchVar (unLoc pat) pat_ty
-selectMatchVar (VarPat var)    pat_ty  = try_for var 	     pat_ty
-selectMatchVar (AsPat var pat) pat_ty  = try_for (unLoc var) pat_ty
-selectMatchVar other_pat       pat_ty  = newSysLocalDs pat_ty   -- OK, better make up one...
-
-try_for var pat_ty 
-  | idType var `tcEqType` pat_ty = returnDs var
-  | otherwise			 = newSysLocalDs pat_ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-%* type synonym EquationInfo and access functions for its pieces	*
-%*									*
-%************************************************************************
-\subsection[EquationInfo-synonym]{@EquationInfo@: a useful synonym}
-
-The ``equation info'' used by @match@ is relatively complicated and
-worthy of a type synonym and a few handy functions.
-
-\begin{code}
-firstPat :: EquationInfo -> Pat Id
-firstPat eqn = head (eqn_pats eqn)
-
-shiftEqns :: [EquationInfo] -> [EquationInfo]
--- Drop the first pattern in each equation
-shiftEqns eqns = [ eqn { eqn_pats = tail (eqn_pats eqn) } | eqn <- eqns ]
-\end{code}
-
-Functions on MatchResults
-
-\begin{code}
-matchCanFail :: MatchResult -> Bool
-matchCanFail (MatchResult CanFail _)  = True
-matchCanFail (MatchResult CantFail _) = False
-
-alwaysFailMatchResult :: MatchResult
-alwaysFailMatchResult = MatchResult CanFail (\fail -> returnDs fail)
-
-cantFailMatchResult :: CoreExpr -> MatchResult
-cantFailMatchResult expr = MatchResult CantFail (\ ignore -> returnDs expr)
-
-extractMatchResult :: MatchResult -> CoreExpr -> DsM CoreExpr
-extractMatchResult (MatchResult CantFail match_fn) fail_expr
-  = match_fn (error "It can't fail!")
-
-extractMatchResult (MatchResult CanFail match_fn) fail_expr
-  = mkFailurePair fail_expr	 	`thenDs` \ (fail_bind, if_it_fails) ->
-    match_fn if_it_fails		`thenDs` \ body ->
-    returnDs (mkDsLet fail_bind body)
-
-
-combineMatchResults :: MatchResult -> MatchResult -> MatchResult
-combineMatchResults (MatchResult CanFail      body_fn1)
-		    (MatchResult can_it_fail2 body_fn2)
-  = MatchResult can_it_fail2 body_fn
-  where
-    body_fn fail = body_fn2 fail			`thenDs` \ body2 ->
-		   mkFailurePair body2	 		`thenDs` \ (fail_bind, duplicatable_expr) ->
-		   body_fn1 duplicatable_expr		`thenDs` \ body1 ->
-		   returnDs (Let fail_bind body1)
-
-combineMatchResults match_result1@(MatchResult CantFail body_fn1) match_result2
-  = match_result1
-
-adjustMatchResult :: (CoreExpr -> CoreExpr) -> MatchResult -> MatchResult
-adjustMatchResult encl_fn (MatchResult can_it_fail body_fn)
-  = MatchResult can_it_fail (\fail -> body_fn fail	`thenDs` \ body ->
-				      returnDs (encl_fn body))
-
-adjustMatchResultDs :: (CoreExpr -> DsM CoreExpr) -> MatchResult -> MatchResult
-adjustMatchResultDs encl_fn (MatchResult can_it_fail body_fn)
-  = MatchResult can_it_fail (\fail -> body_fn fail	`thenDs` \ body ->
-				      encl_fn body)
-
-wrapBinds :: [(Var,Var)] -> CoreExpr -> CoreExpr
-wrapBinds [] e = e
-wrapBinds ((new,old):prs) e = wrapBind new old (wrapBinds prs e)
-
-wrapBind :: Var -> Var -> CoreExpr -> CoreExpr
-wrapBind new old body
-  | new==old    = body
-  | isTyVar new = App (Lam new body) (Type (mkTyVarTy old))
-  | otherwise   = Let (NonRec new (Var old)) body
-
-seqVar :: Var -> CoreExpr -> CoreExpr
-seqVar var body = Case (Var var) var (exprType body)
-			[(DEFAULT, [], body)]
-
-mkCoLetMatchResult :: CoreBind -> MatchResult -> MatchResult
-mkCoLetMatchResult bind match_result
-  = adjustMatchResult (mkDsLet bind) match_result
-
-mkGuardedMatchResult :: CoreExpr -> MatchResult -> MatchResult
-mkGuardedMatchResult pred_expr (MatchResult can_it_fail body_fn)
-  = MatchResult CanFail (\fail -> body_fn fail	`thenDs` \ body ->
-				  returnDs (mkIfThenElse pred_expr body fail))
-
-mkCoPrimCaseMatchResult :: Id				-- Scrutinee
-                    -> Type                             -- Type of the case
-		    -> [(Literal, MatchResult)]		-- Alternatives
-		    -> MatchResult
-mkCoPrimCaseMatchResult var ty match_alts
-  = MatchResult CanFail mk_case
-  where
-    mk_case fail
-      = mappM (mk_alt fail) sorted_alts		`thenDs` \ alts ->
-	returnDs (Case (Var var) var ty ((DEFAULT, [], fail) : alts))
-
-    sorted_alts = sortWith fst match_alts	-- Right order for a Case
-    mk_alt fail (lit, MatchResult _ body_fn) = body_fn fail	`thenDs` \ body ->
-					       returnDs (LitAlt lit, [], body)
-
-
-mkCoAlgCaseMatchResult :: Id					-- Scrutinee
-                    -> Type                                     -- Type of exp
-		    -> [(DataCon, [CoreBndr], MatchResult)]	-- Alternatives
-		    -> MatchResult
-mkCoAlgCaseMatchResult var ty match_alts 
-  | isNewTyCon tycon		-- Newtype case; use a let
-  = ASSERT( null (tail match_alts) && null (tail arg_ids1) )
-    mkCoLetMatchResult (NonRec arg_id1 newtype_rhs) match_result1
-
-  | isPArrFakeAlts match_alts	-- Sugared parallel array; use a literal case 
-  = MatchResult CanFail mk_parrCase
-
-  | otherwise			-- Datatype case; use a case
-  = MatchResult fail_flag mk_case
-  where
-    tycon = dataConTyCon con1
-	-- [Interesting: becuase of GADTs, we can't rely on the type of 
-	--  the scrutinised Id to be sufficiently refined to have a TyCon in it]
-
-	-- Stuff for newtype
-    (con1, arg_ids1, match_result1) = head match_alts
-    arg_id1 	= head arg_ids1
-    newtype_rhs = mkNewTypeBody tycon (idType arg_id1) (Var var)
-		
-	-- Stuff for data types
-    data_cons      = tyConDataCons tycon
-    match_results  = [match_result | (_,_,match_result) <- match_alts]
-
-    fail_flag | exhaustive_case
-	      = foldr1 orFail [can_it_fail | MatchResult can_it_fail _ <- match_results]
-	      | otherwise
-	      = CanFail
-
-    wild_var = mkWildId (idType var)
-    sorted_alts  = sortWith get_tag match_alts
-    get_tag (con, _, _) = dataConTag con
-    mk_case fail = mappM (mk_alt fail) sorted_alts	`thenDs` \ alts ->
-		   returnDs (Case (Var var) wild_var ty (mk_default fail ++ alts))
-
-    mk_alt fail (con, args, MatchResult _ body_fn)
-	= body_fn fail				`thenDs` \ body ->
-	  newUniqueSupply			`thenDs` \ us ->
-	  returnDs (mkReboxingAlt (uniqsFromSupply us) con args body)
-
-    mk_default fail | exhaustive_case = []
-		    | otherwise       = [(DEFAULT, [], fail)]
-
-    un_mentioned_constructors
-        = mkUniqSet data_cons `minusUniqSet` mkUniqSet [ con | (con, _, _) <- match_alts]
-    exhaustive_case = isEmptyUniqSet un_mentioned_constructors
-
-	-- Stuff for parallel arrays
-	-- 
-	--  * the following is to desugar cases over fake constructors for
-	--   parallel arrays, which are introduced by `tidy1' in the `PArrPat'
-	--   case
-	--
-	-- Concerning `isPArrFakeAlts':
-	--
-	--  * it is *not* sufficient to just check the type of the type
-	--   constructor, as we have to be careful not to confuse the real
-	--   representation of parallel arrays with the fake constructors;
-	--   moreover, a list of alternatives must not mix fake and real
-	--   constructors (this is checked earlier on)
-	--
-	-- FIXME: We actually go through the whole list and make sure that
-	--	  either all or none of the constructors are fake parallel
-	--	  array constructors.  This is to spot equations that mix fake
-	--	  constructors with the real representation defined in
-	--	  `PrelPArr'.  It would be nicer to spot this situation
-	--	  earlier and raise a proper error message, but it can really
-	--	  only happen in `PrelPArr' anyway.
-	--
-    isPArrFakeAlts [(dcon, _, _)]      = isPArrFakeCon dcon
-    isPArrFakeAlts ((dcon, _, _):alts) = 
-      case (isPArrFakeCon dcon, isPArrFakeAlts alts) of
-        (True , True ) -> True
-        (False, False) -> False
-	_	       -> 
-	  panic "DsUtils: You may not mix `[:...:]' with `PArr' patterns"
-    --
-    mk_parrCase fail = 		   
-      dsLookupGlobalId lengthPName			`thenDs` \lengthP  ->
-      unboxAlt						`thenDs` \alt      ->
-      returnDs (Case (len lengthP) (mkWildId intTy) ty [alt])
-      where
-	elemTy      = case splitTyConApp (idType var) of
-		        (_, [elemTy]) -> elemTy
-		        _	        -> panic panicMsg
-        panicMsg    = "DsUtils.mkCoAlgCaseMatchResult: not a parallel array?"
-	len lengthP = mkApps (Var lengthP) [Type elemTy, Var var]
-	--
-	unboxAlt = 
-	  newSysLocalDs intPrimTy			`thenDs` \l	   ->
-	  dsLookupGlobalId indexPName			`thenDs` \indexP   ->
-	  mappM (mkAlt indexP) sorted_alts              `thenDs` \alts     ->
-	  returnDs (DataAlt intDataCon, [l], (Case (Var l) wild ty (dft : alts)))
-          where
-	    wild = mkWildId intPrimTy
-	    dft  = (DEFAULT, [], fail)
-	--
-	-- each alternative matches one array length (corresponding to one
-	-- fake array constructor), so the match is on a literal; each
-	-- alternative's body is extended by a local binding for each
-	-- constructor argument, which are bound to array elements starting
-	-- with the first
-	--
-	mkAlt indexP (con, args, MatchResult _ bodyFun) = 
-	  bodyFun fail					`thenDs` \body     ->
-	  returnDs (LitAlt lit, [], mkDsLets binds body)
-	  where
-	    lit   = MachInt $ toInteger (dataConSourceArity con)
-	    binds = [NonRec arg (indexExpr i) | (i, arg) <- zip [1..] args]
-	    --
-	    indexExpr i = mkApps (Var indexP) [Type elemTy, Var var, mkIntExpr i]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Desugarer's versions of some Core functions}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkErrorAppDs :: Id 		-- The error function
-	     -> Type		-- Type to which it should be applied
-	     -> String		-- The error message string to pass
-	     -> DsM CoreExpr
-
-mkErrorAppDs err_id ty msg
-  = getSrcSpanDs		`thenDs` \ src_loc ->
-    let
-	full_msg = showSDoc (hcat [ppr src_loc, text "|", text msg])
-	core_msg = Lit (mkStringLit full_msg)
-	-- mkStringLit returns a result of type String#
-    in
-    returnDs (mkApps (Var err_id) [Type ty, core_msg])
-\end{code}
-
-
-*************************************************************
-%*									*
-\subsection{Making literals}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkCharExpr     :: Char	     -> CoreExpr      -- Returns	C# c :: Int
-mkIntExpr      :: Integer    -> CoreExpr      -- Returns	I# i :: Int
-mkIntegerExpr  :: Integer    -> DsM CoreExpr  -- Result :: Integer
-mkStringExpr   :: String     -> DsM CoreExpr  -- Result :: String
-mkStringExprFS :: FastString -> DsM CoreExpr  -- Result :: String
-
-mkIntExpr  i = mkConApp intDataCon  [mkIntLit i]
-mkCharExpr c = mkConApp charDataCon [mkLit (MachChar c)]
-
-mkIntegerExpr i
-  | inIntRange i  	-- Small enough, so start from an Int
-  = dsLookupDataCon  smallIntegerDataConName	`thenDs` \ integer_dc ->
-    returnDs (mkSmallIntegerLit integer_dc i)
-
--- Special case for integral literals with a large magnitude:
--- They are transformed into an expression involving only smaller
--- integral literals. This improves constant folding.
-
-  | otherwise 		-- Big, so start from a string
-  = dsLookupGlobalId plusIntegerName		`thenDs` \ plus_id ->
-    dsLookupGlobalId timesIntegerName		`thenDs` \ times_id ->
-    dsLookupDataCon  smallIntegerDataConName	`thenDs` \ integer_dc ->
-    let 
-	lit i = mkSmallIntegerLit integer_dc i
-        plus a b  = Var plus_id  `App` a `App` b
-        times a b = Var times_id `App` a `App` b
-
-	-- Transform i into (x1 + (x2 + (x3 + (...) * b) * b) * b) with abs xi <= b
-	horner :: Integer -> Integer -> CoreExpr
-	horner b i | abs q <= 1 = if r == 0 || r == i 
-				  then lit i 
-				  else lit r `plus` lit (i-r)
-	           | r == 0     =               horner b q `times` lit b
-	           | otherwise  = lit r `plus` (horner b q `times` lit b)
-  		   where
-		     (q,r) = i `quotRem` b
-
-    in
-    returnDs (horner tARGET_MAX_INT i)
-
-mkSmallIntegerLit small_integer_data_con i = mkConApp small_integer_data_con [mkIntLit i]
-
-mkStringExpr str = mkStringExprFS (mkFastString str)
-
-mkStringExprFS str
-  | nullFS str
-  = returnDs (mkNilExpr charTy)
-
-  | lengthFS str == 1
-  = let
-	the_char = mkCharExpr (headFS str)
-    in
-    returnDs (mkConsExpr charTy the_char (mkNilExpr charTy))
-
-  | all safeChar chars
-  = dsLookupGlobalId unpackCStringName	`thenDs` \ unpack_id ->
-    returnDs (App (Var unpack_id) (Lit (MachStr str)))
-
-  | otherwise
-  = dsLookupGlobalId unpackCStringUtf8Name	`thenDs` \ unpack_id ->
-    returnDs (App (Var unpack_id) (Lit (MachStr str)))
-
-  where
-    chars = unpackFS str
-    safeChar c = ord c >= 1 && ord c <= 0x7F
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[mkSelectorBind]{Make a selector bind}
-%*									*
-%************************************************************************
-
-This is used in various places to do with lazy patterns.
-For each binder $b$ in the pattern, we create a binding:
-\begin{verbatim}
-    b = case v of pat' -> b'
-\end{verbatim}
-where @pat'@ is @pat@ with each binder @b@ cloned into @b'@.
-
-ToDo: making these bindings should really depend on whether there's
-much work to be done per binding.  If the pattern is complex, it
-should be de-mangled once, into a tuple (and then selected from).
-Otherwise the demangling can be in-line in the bindings (as here).
-
-Boring!  Boring!  One error message per binder.  The above ToDo is
-even more helpful.  Something very similar happens for pattern-bound
-expressions.
-
-\begin{code}
-mkSelectorBinds :: LPat Id	-- The pattern
-		-> CoreExpr	-- Expression to which the pattern is bound
-		-> DsM [(Id,CoreExpr)]
-
-mkSelectorBinds (L _ (VarPat v)) val_expr
-  = returnDs [(v, val_expr)]
-
-mkSelectorBinds pat val_expr
-  | isSingleton binders || is_simple_lpat pat
-  = 	-- Given   p = e, where p binds x,y
-	-- we are going to make
-	--	v = p	(where v is fresh)
-	--	x = case v of p -> x
-	--	y = case v of p -> x
-
-	-- Make up 'v'
-	-- NB: give it the type of *pattern* p, not the type of the *rhs* e.
-	-- This does not matter after desugaring, but there's a subtle 
-	-- issue with implicit parameters. Consider
-	--	(x,y) = ?i
-	-- Then, ?i is given type {?i :: Int}, a PredType, which is opaque
-	-- to the desugarer.  (Why opaque?  Because newtypes have to be.  Why
-	-- does it get that type?  So that when we abstract over it we get the
-	-- right top-level type  (?i::Int) => ...)
-	--
-	-- So to get the type of 'v', use the pattern not the rhs.  Often more
-	-- efficient too.
-    newSysLocalDs (hsPatType pat)	`thenDs` \ val_var ->
-
-	-- For the error message we make one error-app, to avoid duplication.
-	-- But we need it at different types... so we use coerce for that
-    mkErrorAppDs iRREFUT_PAT_ERROR_ID 
-		 unitTy (showSDoc (ppr pat))	`thenDs` \ err_expr ->
-    newSysLocalDs unitTy			`thenDs` \ err_var ->
-    mappM (mk_bind val_var err_var) binders	`thenDs` \ binds ->
-    returnDs ( (val_var, val_expr) : 
-	       (err_var, err_expr) :
-	       binds )
-
-
-  | otherwise
-  = mkErrorAppDs iRREFUT_PAT_ERROR_ID 
-		 tuple_ty (showSDoc (ppr pat))			`thenDs` \ error_expr ->
-    matchSimply val_expr PatBindRhs pat local_tuple error_expr	`thenDs` \ tuple_expr ->
-    newSysLocalDs tuple_ty					`thenDs` \ tuple_var ->
-    let
-	mk_tup_bind binder
-	  = (binder, mkTupleSelector binders binder tuple_var (Var tuple_var))
-    in
-    returnDs ( (tuple_var, tuple_expr) : map mk_tup_bind binders )
-  where
-    binders	= collectPatBinders pat
-    local_tuple = mkTupleExpr binders
-    tuple_ty    = exprType local_tuple
-
-    mk_bind scrut_var err_var bndr_var
-    -- (mk_bind sv err_var) generates
-    --		bv = case sv of { pat -> bv; other -> coerce (type-of-bv) err_var }
-    -- Remember, pat binds bv
-      = matchSimply (Var scrut_var) PatBindRhs pat
-		    (Var bndr_var) error_expr			`thenDs` \ rhs_expr ->
-        returnDs (bndr_var, rhs_expr)
-      where
-        error_expr = mkCoerce (idType bndr_var) (Var err_var)
-
-    is_simple_lpat p = is_simple_pat (unLoc p)
-
-    is_simple_pat (TuplePat ps Boxed _)    = all is_triv_lpat ps
-    is_simple_pat (ConPatOut _ _ _ _ ps _) = all is_triv_lpat (hsConArgs ps)
-    is_simple_pat (VarPat _)	       	   = True
-    is_simple_pat (ParPat p)		   = is_simple_lpat p
-    is_simple_pat other		       	   = False
-
-    is_triv_lpat p = is_triv_pat (unLoc p)
-
-    is_triv_pat (VarPat v)  = True
-    is_triv_pat (WildPat _) = True
-    is_triv_pat (ParPat p)  = is_triv_lpat p
-    is_triv_pat other       = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Tuples
-%*									*
-%************************************************************************
-
-@mkTupleExpr@ builds a tuple; the inverse to @mkTupleSelector@.  
-
-* If it has only one element, it is the identity function.
-
-* If there are more elements than a big tuple can have, it nests 
-  the tuples.  
-
-Nesting policy.  Better a 2-tuple of 10-tuples (3 objects) than
-a 10-tuple of 2-tuples (11 objects).  So we want the leaves to be big.
-
-\begin{code}
-mkTupleExpr :: [Id] -> CoreExpr
-mkTupleExpr ids = mkBigCoreTup (map Var ids)
-
--- corresponding type
-mkTupleType :: [Id] -> Type
-mkTupleType ids = mkBigTuple mkCoreTupTy (map idType ids)
-
-mkBigCoreTup :: [CoreExpr] -> CoreExpr
-mkBigCoreTup = mkBigTuple mkCoreTup
-
-mkBigTuple :: ([a] -> a) -> [a] -> a
-mkBigTuple small_tuple as = mk_big_tuple (chunkify as)
-  where
-	-- Each sub-list is short enough to fit in a tuple
-    mk_big_tuple [as] = small_tuple as
-    mk_big_tuple as_s = mk_big_tuple (chunkify (map small_tuple as_s))
-
-chunkify :: [a] -> [[a]]
--- The sub-lists of the result all have length <= mAX_TUPLE_SIZE
--- But there may be more than mAX_TUPLE_SIZE sub-lists
-chunkify xs
-  | n_xs <= mAX_TUPLE_SIZE = {- pprTrace "Small" (ppr n_xs) -} [xs] 
-  | otherwise		   = {- pprTrace "Big"   (ppr n_xs) -} (split xs)
-  where
-    n_xs     = length xs
-    split [] = []
-    split xs = take mAX_TUPLE_SIZE xs : split (drop mAX_TUPLE_SIZE xs)
-\end{code}
-
-
-@mkTupleSelector@ builds a selector which scrutises the given
-expression and extracts the one name from the list given.
-If you want the no-shadowing rule to apply, the caller
-is responsible for making sure that none of these names
-are in scope.
-
-If there is just one id in the ``tuple'', then the selector is
-just the identity.
-
-If it's big, it does nesting
-	mkTupleSelector [a,b,c,d] b v e
-	  = case e of v { 
-		(p,q) -> case p of p {
-			   (a,b) -> b }}
-We use 'tpl' vars for the p,q, since shadowing does not matter.
-
-In fact, it's more convenient to generate it innermost first, getting
-
-	case (case e of v 
-		(p,q) -> p) of p
-	  (a,b) -> b
-
-\begin{code}
-mkTupleSelector :: [Id]		-- The tuple args
-		-> Id		-- The selected one
-		-> Id		-- A variable of the same type as the scrutinee
-		-> CoreExpr	-- Scrutinee
-		-> CoreExpr
-
-mkTupleSelector vars the_var scrut_var scrut
-  = mk_tup_sel (chunkify vars) the_var
-  where
-    mk_tup_sel [vars] the_var = mkCoreSel vars the_var scrut_var scrut
-    mk_tup_sel vars_s the_var = mkCoreSel group the_var tpl_v $
-				mk_tup_sel (chunkify tpl_vs) tpl_v
-	where
-	  tpl_tys = [mkCoreTupTy (map idType gp) | gp <- vars_s]
-	  tpl_vs  = mkTemplateLocals tpl_tys
-	  [(tpl_v, group)] = [(tpl,gp) | (tpl,gp) <- zipEqual "mkTupleSelector" tpl_vs vars_s,
-					 the_var `elem` gp ]
-\end{code}
-
-A generalization of @mkTupleSelector@, allowing the body
-of the case to be an arbitrary expression.
-
-If the tuple is big, it is nested:
-
-	mkTupleCase uniqs [a,b,c,d] body v e
-	  = case e of v { (p,q) ->
-	    case p of p { (a,b) ->
-	    case q of q { (c,d) ->
-	    body }}}
-
-To avoid shadowing, we use uniqs to invent new variables p,q.
-
-ToDo: eliminate cases where none of the variables are needed.
-
-\begin{code}
-mkTupleCase
-	:: UniqSupply	-- for inventing names of intermediate variables
-	-> [Id]		-- the tuple args
-	-> CoreExpr	-- body of the case
-	-> Id		-- a variable of the same type as the scrutinee
-	-> CoreExpr	-- scrutinee
-	-> CoreExpr
-
-mkTupleCase uniqs vars body scrut_var scrut
-  = mk_tuple_case uniqs (chunkify vars) body
-  where
-    mk_tuple_case us [vars] body
-      = mkSmallTupleCase vars body scrut_var scrut
-    mk_tuple_case us vars_s body
-      = let
-	    (us', vars', body') = foldr one_tuple_case (us, [], body) vars_s
-	in
-	mk_tuple_case us' (chunkify vars') body'
-    one_tuple_case chunk_vars (us, vs, body)
-      = let
-	    (us1, us2) = splitUniqSupply us
-	    scrut_var = mkSysLocal FSLIT("ds") (uniqFromSupply us1)
-			(mkCoreTupTy (map idType chunk_vars))
-	    body' = mkSmallTupleCase chunk_vars body scrut_var (Var scrut_var)
-	in (us2, scrut_var:vs, body')
-\end{code}
-
-The same, but with a tuple small enough not to need nesting.
-
-\begin{code}
-mkSmallTupleCase
-	:: [Id]		-- the tuple args
-	-> CoreExpr	-- body of the case
-	-> Id		-- a variable of the same type as the scrutinee
-	-> CoreExpr	-- scrutinee
-	-> CoreExpr
-
-mkSmallTupleCase [var] body _scrut_var scrut
-  = bindNonRec var scrut body
-mkSmallTupleCase vars body scrut_var scrut
--- One branch no refinement?
-  = Case scrut scrut_var (exprType body) [(DataAlt (tupleCon Boxed (length vars)), vars, body)]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[mkFailurePair]{Code for pattern-matching and other failures}
-%*									*
-%************************************************************************
-
-Call the constructor Ids when building explicit lists, so that they
-interact well with rules.
-
-\begin{code}
-mkNilExpr :: Type -> CoreExpr
-mkNilExpr ty = mkConApp nilDataCon [Type ty]
-
-mkConsExpr :: Type -> CoreExpr -> CoreExpr -> CoreExpr
-mkConsExpr ty hd tl = mkConApp consDataCon [Type ty, hd, tl]
-
-mkListExpr :: Type -> [CoreExpr] -> CoreExpr
-mkListExpr ty xs = foldr (mkConsExpr ty) (mkNilExpr ty) xs
-			    
-
--- The next three functions make tuple types, constructors and selectors,
--- with the rule that a 1-tuple is represented by the thing itselg
-mkCoreTupTy :: [Type] -> Type
-mkCoreTupTy [ty] = ty
-mkCoreTupTy tys  = mkTupleTy Boxed (length tys) tys
-
-mkCoreTup :: [CoreExpr] -> CoreExpr			    
--- Builds exactly the specified tuple.
--- No fancy business for big tuples
-mkCoreTup []  = Var unitDataConId
-mkCoreTup [c] = c
-mkCoreTup cs  = mkConApp (tupleCon Boxed (length cs))
-			 (map (Type . exprType) cs ++ cs)
-
-mkCoreSel :: [Id]	-- The tuple args
-	  -> Id		-- The selected one
-	  -> Id		-- A variable of the same type as the scrutinee
-	  -> CoreExpr	-- Scrutinee
-	  -> CoreExpr
--- mkCoreSel [x,y,z] x v e
--- ===>  case e of v { (x,y,z) -> x
-mkCoreSel [var] should_be_the_same_var scrut_var scrut
-  = ASSERT(var == should_be_the_same_var)
-    scrut
-
-mkCoreSel vars the_var scrut_var scrut
-  = ASSERT( notNull vars )
-    Case scrut scrut_var (idType the_var)
-	 [(DataAlt (tupleCon Boxed (length vars)), vars, Var the_var)]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[mkFailurePair]{Code for pattern-matching and other failures}
-%*									*
-%************************************************************************
-
-Generally, we handle pattern matching failure like this: let-bind a
-fail-variable, and use that variable if the thing fails:
-\begin{verbatim}
-	let fail.33 = error "Help"
-	in
-	case x of
-		p1 -> ...
-		p2 -> fail.33
-		p3 -> fail.33
-		p4 -> ...
-\end{verbatim}
-Then
-\begin{itemize}
-\item
-If the case can't fail, then there'll be no mention of @fail.33@, and the
-simplifier will later discard it.
-
-\item
-If it can fail in only one way, then the simplifier will inline it.
-
-\item
-Only if it is used more than once will the let-binding remain.
-\end{itemize}
-
-There's a problem when the result of the case expression is of
-unboxed type.  Then the type of @fail.33@ is unboxed too, and
-there is every chance that someone will change the let into a case:
-\begin{verbatim}
-	case error "Help" of
-	  fail.33 -> case ....
-\end{verbatim}
-
-which is of course utterly wrong.  Rather than drop the condition that
-only boxed types can be let-bound, we just turn the fail into a function
-for the primitive case:
-\begin{verbatim}
-	let fail.33 :: Void -> Int#
-	    fail.33 = \_ -> error "Help"
-	in
-	case x of
-		p1 -> ...
-		p2 -> fail.33 void
-		p3 -> fail.33 void
-		p4 -> ...
-\end{verbatim}
-
-Now @fail.33@ is a function, so it can be let-bound.
-
-\begin{code}
-mkFailurePair :: CoreExpr	-- Result type of the whole case expression
-	      -> DsM (CoreBind,	-- Binds the newly-created fail variable
-				-- to either the expression or \ _ -> expression
-		      CoreExpr)	-- Either the fail variable, or fail variable
-				-- applied to unit tuple
-mkFailurePair expr
-  | isUnLiftedType ty
-  = newFailLocalDs (unitTy `mkFunTy` ty)	`thenDs` \ fail_fun_var ->
-    newSysLocalDs unitTy			`thenDs` \ fail_fun_arg ->
-    returnDs (NonRec fail_fun_var (Lam fail_fun_arg expr),
-	      App (Var fail_fun_var) (Var unitDataConId))
-
-  | otherwise
-  = newFailLocalDs ty 		`thenDs` \ fail_var ->
-    returnDs (NonRec fail_var expr, Var fail_var)
-  where
-    ty = exprType expr
-\end{code}
-
-
diff --git a/ghc/compiler/deSugar/Match.hi-boot-5 b/ghc/compiler/deSugar/Match.hi-boot-5
deleted file mode 100644
index 42c200fbff..0000000000
--- a/ghc/compiler/deSugar/Match.hi-boot-5
+++ /dev/null
@@ -1,6 +0,0 @@
-__interface Match 1 0 where
-__export Match match matchExport matchSimply matchSinglePat;
-1 match :: [Var.Id] -> [DsUtils.EquationInfo] -> DsMonad.DsM DsUtils.MatchResult ;
-1 matchExport :: [Var.Id] -> [DsUtils.EquationInfo] -> DsMonad.DsM DsUtils.MatchResult ;
-1 matchSimply :: CoreSyn.CoreExpr -> HsExpr.HsMatchContext Name.Name -> HsPat.LPat Var.Id -> CoreSyn.CoreExpr -> CoreSyn.CoreExpr -> DsMonad.DsM CoreSyn.CoreExpr ;
-1 matchSinglePat :: CoreSyn.CoreExpr -> DsMonad.DsMatchContext -> HsPat.LPat Var.Id -> DsUtils.MatchResult -> DsMonad.DsM DsUtils.MatchResult ;
diff --git a/ghc/compiler/deSugar/Match.hi-boot-6 b/ghc/compiler/deSugar/Match.hi-boot-6
deleted file mode 100644
index df806ec644..0000000000
--- a/ghc/compiler/deSugar/Match.hi-boot-6
+++ /dev/null
@@ -1,27 +0,0 @@
-module Match where
-
-match 	:: [Var.Id]
-        -> TcType.TcType
-	-> [DsMonad.EquationInfo]
-	-> DsMonad.DsM DsMonad.MatchResult
-
-matchWrapper
-	:: HsExpr.HsMatchContext Name.Name
-        -> HsExpr.MatchGroup Var.Id
-	-> DsMonad.DsM ([Var.Id], CoreSyn.CoreExpr)
-
-matchSimply
-	:: CoreSyn.CoreExpr
-	-> HsExpr.HsMatchContext Name.Name
-	-> HsPat.LPat Var.Id
-	-> CoreSyn.CoreExpr
-	-> CoreSyn.CoreExpr
-	-> DsMonad.DsM CoreSyn.CoreExpr
-
-matchSinglePat
-	:: CoreSyn.CoreExpr
-	-> HsExpr.HsMatchContext Name.Name
-	-> HsPat.LPat Var.Id
-        -> TcType.TcType
-	-> DsMonad.MatchResult
-	-> DsMonad.DsM DsMonad.MatchResult
diff --git a/ghc/compiler/deSugar/Match.lhs b/ghc/compiler/deSugar/Match.lhs
deleted file mode 100644
index d72d6adf17..0000000000
--- a/ghc/compiler/deSugar/Match.lhs
+++ /dev/null
@@ -1,740 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Main_match]{The @match@ function}
-
-\begin{code}
-module Match ( match, matchEquations, matchWrapper, matchSimply, matchSinglePat ) where
-
-#include "HsVersions.h"
-
-import DynFlags	( DynFlag(..), dopt )
-import HsSyn		
-import TcHsSyn		( mkVanillaTuplePat )
-import Check            ( check, ExhaustivePat )
-import CoreSyn
-import CoreUtils	( bindNonRec, exprType )
-import DsMonad
-import DsBinds		( dsLHsBinds )
-import DsGRHSs		( dsGRHSs )
-import DsUtils
-import Id		( idName, idType, Id )
-import DataCon		( dataConFieldLabels, dataConInstOrigArgTys, isVanillaDataCon )
-import MatchCon		( matchConFamily )
-import MatchLit		( matchLiterals, matchNPlusKPats, matchNPats, tidyLitPat, tidyNPat )
-import PrelInfo		( pAT_ERROR_ID )
-import TcType		( Type, tcTyConAppArgs )
-import Type		( splitFunTysN, mkTyVarTys )
-import TysWiredIn	( consDataCon, mkListTy, unitTy,
-			  tupleCon, parrFakeCon, mkPArrTy )
-import BasicTypes	( Boxity(..) )
-import ListSetOps	( runs )
-import SrcLoc		( noLoc, unLoc, Located(..) )
-import Util             ( lengthExceeds, notNull )
-import Name		( Name )
-import Outputable
-\end{code}
-
-This function is a wrapper of @match@, it must be called from all the parts where 
-it was called match, but only substitutes the firs call, ....
-if the associated flags are declared, warnings will be issued.
-It can not be called matchWrapper because this name already exists :-(
-
-JJCQ 30-Nov-1997
-
-\begin{code}
-matchCheck ::  DsMatchContext
-	    -> [Id]	        -- Vars rep'ing the exprs we're matching with
-            -> Type             -- Type of the case expression
-            -> [EquationInfo]   -- Info about patterns, etc. (type synonym below)
-            -> DsM MatchResult  -- Desugared result!
-
-matchCheck ctx vars ty qs
-   = getDOptsDs 				`thenDs` \ dflags ->
-     matchCheck_really dflags ctx vars ty qs
-
-matchCheck_really dflags ctx vars ty qs
-  | incomplete && shadow = 
-      dsShadowWarn ctx eqns_shadow		`thenDs`   \ () ->
-      dsIncompleteWarn ctx pats			`thenDs`   \ () ->
-      match vars ty qs
-  | incomplete            = 
-      dsIncompleteWarn ctx pats			`thenDs`   \ () ->
-      match vars ty qs
-  | shadow                = 
-      dsShadowWarn ctx eqns_shadow		`thenDs`   \ () ->
-      match vars ty qs
-  | otherwise             =
-      match vars ty qs
-  where (pats, eqns_shadow) = check qs
-        incomplete    = want_incomplete && (notNull pats)
-        want_incomplete = case ctx of
-                              DsMatchContext RecUpd _ ->
-                                  dopt Opt_WarnIncompletePatternsRecUpd dflags
-                              _ ->
-                                  dopt Opt_WarnIncompletePatterns       dflags
-        shadow        = dopt Opt_WarnOverlappingPatterns dflags
-			&& not (null eqns_shadow)
-\end{code}
-
-This variable shows the maximum number of lines of output generated for warnings.
-It will limit the number of patterns/equations displayed to@ maximum_output@.
-
-(ToDo: add command-line option?)
-
-\begin{code}
-maximum_output = 4
-\end{code}
-
-The next two functions create the warning message.
-
-\begin{code}
-dsShadowWarn :: DsMatchContext -> [EquationInfo] -> DsM ()
-dsShadowWarn ctx@(DsMatchContext kind loc) qs
-  = putSrcSpanDs loc (dsWarn warn)
-  where
-    warn | qs `lengthExceeds` maximum_output
-         = pp_context ctx (ptext SLIT("are overlapped"))
-		      (\ f -> vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$
-		      ptext SLIT("..."))
-	 | otherwise
-         = pp_context ctx (ptext SLIT("are overlapped"))
-	              (\ f -> vcat $ map (ppr_eqn f kind) qs)
-
-
-dsIncompleteWarn :: DsMatchContext -> [ExhaustivePat] -> DsM ()
-dsIncompleteWarn ctx@(DsMatchContext kind loc) pats 
-  = putSrcSpanDs loc (dsWarn warn)
-	where
-	  warn = pp_context ctx (ptext SLIT("are non-exhaustive"))
-                    	    (\f -> hang (ptext SLIT("Patterns not matched:"))
-		                   4 ((vcat $ map (ppr_incomplete_pats kind)
-						  (take maximum_output pats))
-		                      $$ dots))
-
-	  dots | pats `lengthExceeds` maximum_output = ptext SLIT("...")
-	       | otherwise                           = empty
-
-pp_context (DsMatchContext kind _loc) msg rest_of_msg_fun
-  = vcat [ptext SLIT("Pattern match(es)") <+> msg,
-	  sep [ptext SLIT("In") <+> ppr_match <> char ':', nest 4 (rest_of_msg_fun pref)]]
-  where
-    (ppr_match, pref)
-	= case kind of
-	     FunRhs fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp)
-	     other	-> (pprMatchContext kind, \ pp -> pp)
-
-ppr_pats pats = sep (map ppr pats)
-
-ppr_shadow_pats kind pats
-  = sep [ppr_pats pats, matchSeparator kind, ptext SLIT("...")]
-    
-ppr_incomplete_pats kind (pats,[]) = ppr_pats pats
-ppr_incomplete_pats kind (pats,constraints) = 
-	                 sep [ppr_pats pats, ptext SLIT("with"), 
-	                      sep (map ppr_constraint constraints)]
-    
-
-ppr_constraint (var,pats) = sep [ppr var, ptext SLIT("`notElem`"), ppr pats]
-
-ppr_eqn prefixF kind eqn = prefixF (ppr_shadow_pats kind (eqn_pats eqn))
-\end{code}
-
-
-The function @match@ is basically the same as in the Wadler chapter,
-except it is monadised, to carry around the name supply, info about
-annotations, etc.
-
-Notes on @match@'s arguments, assuming $m$ equations and $n$ patterns:
-\begin{enumerate}
-\item
-A list of $n$ variable names, those variables presumably bound to the
-$n$ expressions being matched against the $n$ patterns.  Using the
-list of $n$ expressions as the first argument showed no benefit and
-some inelegance.
-
-\item
-The second argument, a list giving the ``equation info'' for each of
-the $m$ equations:
-\begin{itemize}
-\item
-the $n$ patterns for that equation, and
-\item
-a list of Core bindings [@(Id, CoreExpr)@ pairs] to be ``stuck on
-the front'' of the matching code, as in:
-\begin{verbatim}
-let <binds>
-in  <matching-code>
-\end{verbatim}
-\item
-and finally: (ToDo: fill in)
-
-The right way to think about the ``after-match function'' is that it
-is an embryonic @CoreExpr@ with a ``hole'' at the end for the
-final ``else expression''.
-\end{itemize}
-
-There is a type synonym, @EquationInfo@, defined in module @DsUtils@.
-
-An experiment with re-ordering this information about equations (in
-particular, having the patterns available in column-major order)
-showed no benefit.
-
-\item
-A default expression---what to evaluate if the overall pattern-match
-fails.  This expression will (almost?) always be
-a measly expression @Var@, unless we know it will only be used once
-(as we do in @glue_success_exprs@).
-
-Leaving out this third argument to @match@ (and slamming in lots of
-@Var "fail"@s) is a positively {\em bad} idea, because it makes it
-impossible to share the default expressions.  (Also, it stands no
-chance of working in our post-upheaval world of @Locals@.)
-\end{enumerate}
-So, the full type signature:
-\begin{code}
-match :: [Id]		  -- Variables rep'ing the exprs we're matching with
-      -> Type             -- Type of the case expression
-      -> [EquationInfo]	  -- Info about patterns, etc. (type synonym below)
-      -> DsM MatchResult  -- Desugared result!
-\end{code}
-
-Note: @match@ is often called via @matchWrapper@ (end of this module),
-a function that does much of the house-keeping that goes with a call
-to @match@.
-
-It is also worth mentioning the {\em typical} way a block of equations
-is desugared with @match@.  At each stage, it is the first column of
-patterns that is examined.  The steps carried out are roughly:
-\begin{enumerate}
-\item
-Tidy the patterns in column~1 with @tidyEqnInfo@ (this may add
-bindings to the second component of the equation-info):
-\begin{itemize}
-\item
-Remove the `as' patterns from column~1.
-\item
-Make all constructor patterns in column~1 into @ConPats@, notably
-@ListPats@ and @TuplePats@.
-\item
-Handle any irrefutable (or ``twiddle'') @LazyPats@.
-\end{itemize}
-\item
-Now {\em unmix} the equations into {\em blocks} [w/ local function
-@unmix_eqns@], in which the equations in a block all have variable
-patterns in column~1, or they all have constructor patterns in ...
-(see ``the mixture rule'' in SLPJ).
-\item
-Call @matchEqnBlock@ on each block of equations; it will do the
-appropriate thing for each kind of column-1 pattern, usually ending up
-in a recursive call to @match@.
-\end{enumerate}
-
-%************************************************************************
-%*									*
-%*  match: empty rule							*
-%*									*
-%************************************************************************
-\subsection[Match-empty-rule]{The ``empty rule''}
-
-We are a little more paranoid about the ``empty rule'' (SLPJ, p.~87)
-than the Wadler-chapter code for @match@ (p.~93, first @match@ clause).
-And gluing the ``success expressions'' together isn't quite so pretty.
-
-\begin{code}
-match [] ty eqns_info
-  = ASSERT( not (null eqns_info) )
-    returnDs (foldr1 combineMatchResults match_results)
-  where
-    match_results = [ ASSERT( null (eqn_pats eqn) ) 
-		      adjustMatchResult (eqn_wrap eqn) (eqn_rhs eqn)
-		    | eqn <- eqns_info ]
-\end{code}
-
-
-%************************************************************************
-%*									*
-%*  match: non-empty rule						*
-%*									*
-%************************************************************************
-\subsection[Match-nonempty]{@match@ when non-empty: unmixing}
-
-This (more interesting) clause of @match@ uses @tidy_and_unmix_eqns@
-(a)~to get `as'- and `twiddle'-patterns out of the way (tidying), and
-(b)~to do ``the mixture rule'' (SLPJ, p.~88) [which really {\em
-un}mixes the equations], producing a list of equation-info
-blocks, each block having as its first column of patterns either all
-constructors, or all variables (or similar beasts), etc.
-
-@match_unmixed_eqn_blks@ simply takes the place of the @foldr@ in the
-Wadler-chapter @match@ (p.~93, last clause), and @match_unmixed_blk@
-corresponds roughly to @matchVarCon@.
-
-\begin{code}
-match vars@(v:_) ty eqns_info
-  = do	{ tidy_eqns <- mappM (tidyEqnInfo v) eqns_info
-	; let eqns_blks = runs same_family tidy_eqns
-	; match_results <- mappM match_block eqns_blks
-	; ASSERT( not (null match_results) )
-	  return (foldr1 combineMatchResults match_results) }
-  where
-    same_family eqn1 eqn2 
-      = samePatFamily (firstPat eqn1) (firstPat eqn2)
- 
-    match_block eqns
-      = case firstPat (head eqns) of
-	  WildPat {}   -> matchVariables  vars ty eqns
-	  ConPatOut {} -> matchConFamily  vars ty eqns
-	  NPlusKPat {} -> matchNPlusKPats vars ty eqns
-	  NPat {}      -> matchNPats	  vars ty eqns
-	  LitPat {}    -> matchLiterals   vars ty eqns
-
--- After tidying, there are only five kinds of patterns
-samePatFamily (WildPat {})   (WildPat {})   = True
-samePatFamily (ConPatOut {}) (ConPatOut {}) = True
-samePatFamily (NPlusKPat {}) (NPlusKPat {}) = True
-samePatFamily (NPat {})	     (NPat {}) 	    = True
-samePatFamily (LitPat {})    (LitPat {})    = True
-samePatFamily _		     _		    = False
-
-matchVariables :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
--- Real true variables, just like in matchVar, SLPJ p 94
--- No binding to do: they'll all be wildcards by now (done in tidy)
-matchVariables (var:vars) ty eqns = match vars ty (shiftEqns eqns)
-\end{code}
-
-
-\end{code}
-
-Tidy up the leftmost pattern in an @EquationInfo@, given the variable @v@
-which will be scrutinised.  This means:
-\begin{itemize}
-\item
-Replace variable patterns @x@ (@x /= v@) with the pattern @_@,
-together with the binding @x = v@.
-\item
-Replace the `as' pattern @x@@p@ with the pattern p and a binding @x = v@.
-\item
-Removing lazy (irrefutable) patterns (you don't want to know...).
-\item
-Converting explicit tuple-, list-, and parallel-array-pats into ordinary
-@ConPats@. 
-\item
-Convert the literal pat "" to [].
-\end{itemize}
-
-The result of this tidying is that the column of patterns will include
-{\em only}:
-\begin{description}
-\item[@WildPats@:]
-The @VarPat@ information isn't needed any more after this.
-
-\item[@ConPats@:]
-@ListPats@, @TuplePats@, etc., are all converted into @ConPats@.
-
-\item[@LitPats@ and @NPats@:]
-@LitPats@/@NPats@ of ``known friendly types'' (Int, Char,
-Float, 	Double, at least) are converted to unboxed form; e.g.,
-\tr{(NPat (HsInt i) _ _)} is converted to:
-\begin{verbatim}
-(ConPat I# _ _ [LitPat (HsIntPrim i)])
-\end{verbatim}
-\end{description}
-
-\begin{code}
-tidyEqnInfo :: Id -> EquationInfo -> DsM EquationInfo
-	-- DsM'd because of internal call to dsLHsBinds
-	-- 	and mkSelectorBinds.
-	-- "tidy1" does the interesting stuff, looking at
-	-- one pattern and fiddling the list of bindings.
-	--
-	-- POST CONDITION: head pattern in the EqnInfo is
-	--	WildPat
-	--	ConPat
-	--	NPat
-	--	LitPat
-	--	NPlusKPat
-	-- but no other
-
-tidyEqnInfo v eqn@(EqnInfo { eqn_wrap = wrap, eqn_pats = pat : pats })
-  = tidy1 v wrap pat 	`thenDs` \ (wrap', pat') ->
-    returnDs (eqn { eqn_wrap = wrap', eqn_pats = pat' : pats })
-
-tidy1 :: Id 			-- The Id being scrutinised
-      -> DsWrapper		-- Previous wrapping bindings
-      -> Pat Id 		-- The pattern against which it is to be matched
-      -> DsM (DsWrapper,	-- Extra bindings around what to do afterwards
-	      Pat Id) 		-- Equivalent pattern
-
--- The extra bindings etc are all wrapped around the RHS of the match
--- so they are only available when matching is complete.  But that's ok
--- becuase, for example, in the pattern x@(...), the x can only be
--- used in the RHS, not in the nested pattern, nor subsquent patterns
---
--- However this does have an awkward consequence.  The bindings in 
--- a VarPatOut get wrapped around the result in right to left order,
--- rather than left to right.  This only matters if one set of 
--- bindings can mention things used in another, and that can happen
--- if we allow equality dictionary bindings of form d1=d2.  
--- bindIInstsOfLocalFuns is now careful not to do this, but it's a wart.
--- (Without this care in bindInstsOfLocalFuns, compiling 
--- Data.Generics.Schemes.hs fails in function everywhereBut.)
-
--------------------------------------------------------
---	(pat', mr') = tidy1 v pat mr
--- tidies the *outer level only* of pat, giving pat'
--- It eliminates many pattern forms (as-patterns, variable patterns,
--- list patterns, etc) yielding one of:
---	WildPat
---	ConPatOut
---	LitPat
---	NPat
---	NPlusKPat
-
-tidy1 v wrap (ParPat pat)      = tidy1 v wrap (unLoc pat) 
-tidy1 v wrap (SigPatOut pat _) = tidy1 v wrap (unLoc pat) 
-tidy1 v wrap (WildPat ty)      = returnDs (wrap, WildPat ty)
-
-	-- case v of { x -> mr[] }
-	-- = case v of { _ -> let x=v in mr[] }
-tidy1 v wrap (VarPat var)
-  = returnDs (wrap . wrapBind var v, WildPat (idType var)) 
-
-tidy1 v wrap (VarPatOut var binds)
-  = do	{ prs <- dsLHsBinds binds
-	; return (wrap . wrapBind var v . mkDsLet (Rec prs),
-		  WildPat (idType var)) }
-
-	-- case v of { x@p -> mr[] }
-	-- = case v of { p -> let x=v in mr[] }
-tidy1 v wrap (AsPat (L _ var) pat)
-  = tidy1 v (wrap . wrapBind var v) (unLoc pat)
-
-tidy1 v wrap (BangPat pat)
-  = tidy1 v (wrap . seqVar v) (unLoc pat)
-
-{- now, here we handle lazy patterns:
-    tidy1 v ~p bs = (v, v1 = case v of p -> v1 :
-			v2 = case v of p -> v2 : ... : bs )
-
-    where the v_i's are the binders in the pattern.
-
-    ToDo: in "v_i = ... -> v_i", are the v_i's really the same thing?
-
-    The case expr for v_i is just: match [v] [(p, [], \ x -> Var v_i)] any_expr
--}
-
-tidy1 v wrap (LazyPat pat)
-  = do	{ v' <- newSysLocalDs (idType v)
-	; sel_prs <- mkSelectorBinds pat (Var v)
-	; let sel_binds =  [NonRec b rhs | (b,rhs) <- sel_prs]
-	; returnDs (wrap . wrapBind v' v . mkDsLets sel_binds,
-		    WildPat (idType v)) }
-
--- re-express <con-something> as (ConPat ...) [directly]
-
-tidy1 v wrap (ConPatOut (L loc con) ex_tvs dicts binds ps pat_ty)
-  = returnDs (wrap, ConPatOut (L loc con) ex_tvs dicts binds tidy_ps pat_ty)
-  where
-    tidy_ps = PrefixCon (tidy_con con ex_tvs pat_ty ps)
-
-tidy1 v wrap (ListPat pats ty)
-  = returnDs (wrap, unLoc list_ConPat)
-  where
-    list_ty     = mkListTy ty
-    list_ConPat = foldr (\ x y -> mkPrefixConPat consDataCon [x, y] list_ty)
-	      	  	(mkNilPat list_ty)
-	      	  	pats
-
--- Introduce fake parallel array constructors to be able to handle parallel
--- arrays with the existing machinery for constructor pattern
-tidy1 v wrap (PArrPat pats ty)
-  = returnDs (wrap, unLoc parrConPat)
-  where
-    arity      = length pats
-    parrConPat = mkPrefixConPat (parrFakeCon arity) pats (mkPArrTy ty)
-
-tidy1 v wrap (TuplePat pats boxity ty)
-  = returnDs (wrap, unLoc tuple_ConPat)
-  where
-    arity = length pats
-    tuple_ConPat = mkPrefixConPat (tupleCon boxity arity) pats ty
-
-tidy1 v wrap (DictPat dicts methods)
-  = case num_of_d_and_ms of
-	0 -> tidy1 v wrap (TuplePat [] Boxed unitTy) 
-	1 -> tidy1 v wrap (unLoc (head dict_and_method_pats))
-	_ -> tidy1 v wrap (mkVanillaTuplePat dict_and_method_pats Boxed)
-  where
-    num_of_d_and_ms	 = length dicts + length methods
-    dict_and_method_pats = map nlVarPat (dicts ++ methods)
-
--- LitPats: we *might* be able to replace these w/ a simpler form
-tidy1 v wrap pat@(LitPat lit)
-  = returnDs (wrap, unLoc (tidyLitPat lit (noLoc pat)))
-
--- NPats: we *might* be able to replace these w/ a simpler form
-tidy1 v wrap pat@(NPat lit mb_neg _ lit_ty)
-  = returnDs (wrap, unLoc (tidyNPat lit mb_neg lit_ty (noLoc pat)))
-
--- and everything else goes through unchanged...
-
-tidy1 v wrap non_interesting_pat
-  = returnDs (wrap, non_interesting_pat)
-
-
-tidy_con data_con ex_tvs pat_ty (PrefixCon ps)   = ps
-tidy_con data_con ex_tvs pat_ty (InfixCon p1 p2) = [p1,p2]
-tidy_con data_con ex_tvs pat_ty (RecCon rpats)
-  | null rpats
-  =	-- Special case for C {}, which can be used for 
-	-- a constructor that isn't declared to have
-	-- fields at all
-    map (noLoc . WildPat) con_arg_tys'
-
-  | otherwise
-  = map mk_pat tagged_arg_tys
-  where
-	-- Boring stuff to find the arg-tys of the constructor
-	
-    inst_tys | isVanillaDataCon data_con = tcTyConAppArgs pat_ty	-- Newtypes must be opaque
-	     | otherwise		 = mkTyVarTys ex_tvs
-
-    con_arg_tys'     = dataConInstOrigArgTys data_con inst_tys
-    tagged_arg_tys   = con_arg_tys' `zip` dataConFieldLabels data_con
-
-	-- mk_pat picks a WildPat of the appropriate type for absent fields,
-	-- and the specified pattern for present fields
-    mk_pat (arg_ty, lbl) = 
-	case [ pat | (sel_id,pat) <- rpats, idName (unLoc sel_id) == lbl] of
-	  (pat:pats) -> ASSERT( null pats ) pat
-	  []	     -> noLoc (WildPat arg_ty)
-\end{code}
-
-\noindent
-{\bf Previous @matchTwiddled@ stuff:}
-
-Now we get to the only interesting part; note: there are choices for
-translation [from Simon's notes]; translation~1:
-\begin{verbatim}
-deTwiddle [s,t] e
-\end{verbatim}
-returns
-\begin{verbatim}
-[ w = e,
-  s = case w of [s,t] -> s
-  t = case w of [s,t] -> t
-]
-\end{verbatim}
-
-Here \tr{w} is a fresh variable, and the \tr{w}-binding prevents multiple
-evaluation of \tr{e}.  An alternative translation (No.~2):
-\begin{verbatim}
-[ w = case e of [s,t] -> (s,t)
-  s = case w of (s,t) -> s
-  t = case w of (s,t) -> t
-]
-\end{verbatim}
-
-%************************************************************************
-%*									*
-\subsubsection[improved-unmixing]{UNIMPLEMENTED idea for improved unmixing}
-%*									*
-%************************************************************************
-
-We might be able to optimise unmixing when confronted by
-only-one-constructor-possible, of which tuples are the most notable
-examples.  Consider:
-\begin{verbatim}
-f (a,b,c) ... = ...
-f d ... (e:f) = ...
-f (g,h,i) ... = ...
-f j ...       = ...
-\end{verbatim}
-This definition would normally be unmixed into four equation blocks,
-one per equation.  But it could be unmixed into just one equation
-block, because if the one equation matches (on the first column),
-the others certainly will.
-
-You have to be careful, though; the example
-\begin{verbatim}
-f j ...       = ...
--------------------
-f (a,b,c) ... = ...
-f d ... (e:f) = ...
-f (g,h,i) ... = ...
-\end{verbatim}
-{\em must} be broken into two blocks at the line shown; otherwise, you
-are forcing unnecessary evaluation.  In any case, the top-left pattern
-always gives the cue.  You could then unmix blocks into groups of...
-\begin{description}
-\item[all variables:]
-As it is now.
-\item[constructors or variables (mixed):]
-Need to make sure the right names get bound for the variable patterns.
-\item[literals or variables (mixed):]
-Presumably just a variant on the constructor case (as it is now).
-\end{description}
-
-%************************************************************************
-%*									*
-%*  matchWrapper: a convenient way to call @match@			*
-%*									*
-%************************************************************************
-\subsection[matchWrapper]{@matchWrapper@: a convenient interface to @match@}
-
-Calls to @match@ often involve similar (non-trivial) work; that work
-is collected here, in @matchWrapper@.  This function takes as
-arguments:
-\begin{itemize}
-\item
-Typchecked @Matches@ (of a function definition, or a case or lambda
-expression)---the main input;
-\item
-An error message to be inserted into any (runtime) pattern-matching
-failure messages.
-\end{itemize}
-
-As results, @matchWrapper@ produces:
-\begin{itemize}
-\item
-A list of variables (@Locals@) that the caller must ``promise'' to
-bind to appropriate values; and
-\item
-a @CoreExpr@, the desugared output (main result).
-\end{itemize}
-
-The main actions of @matchWrapper@ include:
-\begin{enumerate}
-\item
-Flatten the @[TypecheckedMatch]@ into a suitable list of
-@EquationInfo@s.
-\item
-Create as many new variables as there are patterns in a pattern-list
-(in any one of the @EquationInfo@s).
-\item
-Create a suitable ``if it fails'' expression---a call to @error@ using
-the error-string input; the {\em type} of this fail value can be found
-by examining one of the RHS expressions in one of the @EquationInfo@s.
-\item
-Call @match@ with all of this information!
-\end{enumerate}
-
-\begin{code}
-matchWrapper :: HsMatchContext Name	-- For shadowing warning messages
-	     -> MatchGroup Id		-- Matches being desugared
-	     -> DsM ([Id], CoreExpr) 	-- Results
-\end{code}
-
- There is one small problem with the Lambda Patterns, when somebody
- writes something similar to:
-\begin{verbatim}
-    (\ (x:xs) -> ...)
-\end{verbatim}
- he/she don't want a warning about incomplete patterns, that is done with 
- the flag @opt_WarnSimplePatterns@.
- This problem also appears in the:
-\begin{itemize}
-\item @do@ patterns, but if the @do@ can fail
-      it creates another equation if the match can fail
-      (see @DsExpr.doDo@ function)
-\item @let@ patterns, are treated by @matchSimply@
-   List Comprension Patterns, are treated by @matchSimply@ also
-\end{itemize}
-
-We can't call @matchSimply@ with Lambda patterns,
-due to the fact that lambda patterns can have more than
-one pattern, and match simply only accepts one pattern.
-
-JJQC 30-Nov-1997
-
-\begin{code}
-matchWrapper ctxt (MatchGroup matches match_ty)
-  = do	{ eqns_info   <- mapM mk_eqn_info matches
-	; new_vars    <- selectMatchVars arg_pats pat_tys
-	; result_expr <- matchEquations ctxt new_vars eqns_info rhs_ty
-	; return (new_vars, result_expr) }
-  where
-    arg_pats          = map unLoc (hsLMatchPats (head matches))
-    n_pats	      = length arg_pats
-    (pat_tys, rhs_ty) = splitFunTysN n_pats match_ty
-
-    mk_eqn_info (L _ (Match pats _ grhss))
-      = do { let upats = map unLoc pats
-	   ; match_result <- dsGRHSs ctxt upats grhss rhs_ty
-	   ; return (EqnInfo { eqn_wrap = idWrapper,
-			       eqn_pats = upats, 
-			       eqn_rhs  = match_result}) }
-
-
-matchEquations  :: HsMatchContext Name
-		-> [Id]	-> [EquationInfo] -> Type
-		-> DsM CoreExpr
-matchEquations ctxt vars eqns_info rhs_ty
-  = do	{ dflags <- getDOptsDs
-	; locn   <- getSrcSpanDs
-	; let   ds_ctxt      = DsMatchContext ctxt locn
-		error_string = matchContextErrString ctxt
-
-	; match_result <- match_fun dflags ds_ctxt vars rhs_ty eqns_info
-
-	; fail_expr <- mkErrorAppDs pAT_ERROR_ID rhs_ty error_string
-	; extractMatchResult match_result fail_expr }
-  where 
-    match_fun dflags ds_ctxt
-       = case ctxt of 
-           LambdaExpr | dopt Opt_WarnSimplePatterns dflags -> matchCheck ds_ctxt
-                      | otherwise                          -> match
-           _                                               -> matchCheck ds_ctxt
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[matchSimply]{@matchSimply@: match a single expression against a single pattern}
-%*									*
-%************************************************************************
-
-@mkSimpleMatch@ is a wrapper for @match@ which deals with the
-situation where we want to match a single expression against a single
-pattern. It returns an expression.
-
-\begin{code}
-matchSimply :: CoreExpr			-- Scrutinee
-	    -> HsMatchContext Name	-- Match kind
-	    -> LPat Id			-- Pattern it should match
-	    -> CoreExpr			-- Return this if it matches
-	    -> CoreExpr			-- Return this if it doesn't
-	    -> DsM CoreExpr
-
-matchSimply scrut hs_ctx pat result_expr fail_expr
-  = let
-      match_result = cantFailMatchResult result_expr
-      rhs_ty	   = exprType fail_expr
-	-- Use exprType of fail_expr, because won't refine in the case of failure!
-    in 
-    matchSinglePat scrut hs_ctx pat rhs_ty match_result	`thenDs` \ match_result' ->
-    extractMatchResult match_result' fail_expr
-
-
-matchSinglePat :: CoreExpr -> HsMatchContext Name -> LPat Id
-	       -> Type -> MatchResult -> DsM MatchResult
-matchSinglePat (Var var) hs_ctx (L _ pat) ty match_result
-  = getDOptsDs				`thenDs` \ dflags ->
-    getSrcSpanDs			`thenDs` \ locn ->
-    let
-	match_fn dflags
-           | dopt Opt_WarnSimplePatterns dflags = matchCheck ds_ctx
-  	   | otherwise	       		        = match
-	   where
-	     ds_ctx = DsMatchContext hs_ctx locn
-    in
-    match_fn dflags [var] ty [EqnInfo { eqn_wrap = idWrapper,
-					eqn_pats = [pat],
-					eqn_rhs  = match_result }]
-
-matchSinglePat scrut hs_ctx pat ty match_result
-  = selectSimpleMatchVarL pat 		 		`thenDs` \ var ->
-    matchSinglePat (Var var) hs_ctx pat ty match_result	`thenDs` \ match_result' ->
-    returnDs (adjustMatchResult (bindNonRec var scrut) match_result')
-\end{code}
-
diff --git a/ghc/compiler/deSugar/Match.lhs-boot b/ghc/compiler/deSugar/Match.lhs-boot
deleted file mode 100644
index 5f99f5cc1a..0000000000
--- a/ghc/compiler/deSugar/Match.lhs-boot
+++ /dev/null
@@ -1,35 +0,0 @@
-\begin{code}
-module Match where
-import Var	( Id )
-import TcType	( TcType )
-import DsMonad	( DsM, EquationInfo, MatchResult )
-import CoreSyn	( CoreExpr )
-import HsSyn	( LPat, HsMatchContext, MatchGroup )
-import Name	( Name )
-
-match 	:: [Id]
-        -> TcType
-	-> [EquationInfo]
-	-> DsM MatchResult
-
-matchWrapper
-	:: HsMatchContext Name
-        -> MatchGroup Id
-	-> DsM ([Id], CoreExpr)
-
-matchSimply
-	:: CoreExpr
-	-> HsMatchContext Name
-	-> LPat Id
-	-> CoreExpr
-	-> CoreExpr
-	-> DsM CoreExpr
-
-matchSinglePat
-	:: CoreExpr
-	-> HsMatchContext Name
-	-> LPat Id
-        -> TcType
-	-> MatchResult
-	-> DsM MatchResult
-\end{code}
diff --git a/ghc/compiler/deSugar/MatchCon.lhs b/ghc/compiler/deSugar/MatchCon.lhs
deleted file mode 100644
index 6ff502a8ae..0000000000
--- a/ghc/compiler/deSugar/MatchCon.lhs
+++ /dev/null
@@ -1,174 +0,0 @@
-
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[MatchCon]{Pattern-matching constructors}
-
-\begin{code}
-module MatchCon ( matchConFamily ) where
-
-#include "HsVersions.h"
-
-import Id( idType )
-
-import {-# SOURCE #-} Match	( match )
-
-import HsSyn		( Pat(..), HsConDetails(..) )
-import DsBinds		( dsLHsBinds )
-import DataCon		( isVanillaDataCon, dataConInstOrigArgTys )
-import TcType		( tcTyConAppArgs )
-import Type		( mkTyVarTys )
-import CoreSyn
-import DsMonad
-import DsUtils
-
-import Id		( Id )
-import Type             ( Type )
-import ListSetOps	( equivClassesByUniq )
-import SrcLoc		( unLoc, Located(..) )
-import Unique		( Uniquable(..) )
-import Outputable
-\end{code}
-
-We are confronted with the first column of patterns in a set of
-equations, all beginning with constructors from one ``family'' (e.g.,
-@[]@ and @:@ make up the @List@ ``family'').  We want to generate the
-alternatives for a @Case@ expression.  There are several choices:
-\begin{enumerate}
-\item
-Generate an alternative for every constructor in the family, whether
-they are used in this set of equations or not; this is what the Wadler
-chapter does.
-\begin{description}
-\item[Advantages:]
-(a)~Simple.  (b)~It may also be that large sparsely-used constructor
-families are mainly handled by the code for literals.
-\item[Disadvantages:]
-(a)~Not practical for large sparsely-used constructor families, e.g.,
-the ASCII character set.  (b)~Have to look up a list of what
-constructors make up the whole family.
-\end{description}
-
-\item
-Generate an alternative for each constructor used, then add a default
-alternative in case some constructors in the family weren't used.
-\begin{description}
-\item[Advantages:]
-(a)~Alternatives aren't generated for unused constructors.  (b)~The
-STG is quite happy with defaults.  (c)~No lookup in an environment needed.
-\item[Disadvantages:]
-(a)~A spurious default alternative may be generated.
-\end{description}
-
-\item
-``Do it right:'' generate an alternative for each constructor used,
-and add a default alternative if all constructors in the family
-weren't used.
-\begin{description}
-\item[Advantages:]
-(a)~You will get cases with only one alternative (and no default),
-which should be amenable to optimisation.  Tuples are a common example.
-\item[Disadvantages:]
-(b)~Have to look up constructor families in TDE (as above).
-\end{description}
-\end{enumerate}
-
-We are implementing the ``do-it-right'' option for now.  The arguments
-to @matchConFamily@ are the same as to @match@; the extra @Int@
-returned is the number of constructors in the family.
-
-The function @matchConFamily@ is concerned with this
-have-we-used-all-the-constructors? question; the local function
-@match_cons_used@ does all the real work.
-\begin{code}
-matchConFamily :: [Id]
-               -> Type
-	       -> [EquationInfo]
-	       -> DsM MatchResult
-matchConFamily (var:vars) ty eqns_info
-  = let
-	-- Sort into equivalence classes by the unique on the constructor
-	-- All the EqnInfos should start with a ConPat
-	groups = equivClassesByUniq get_uniq eqns_info
-	get_uniq (EqnInfo { eqn_pats = ConPatOut (L _ data_con) _ _ _ _ _ : _}) = getUnique data_con
-
-	-- Get the wrapper from the head of each group.  We're going to
-	-- use it as the pattern in this case expression, so we need to 
-	-- ensure that any type variables it mentions in the pattern are
-	-- in scope.  So we put its wrappers outside the case, and
-	-- zap the wrapper for it. 
-	wraps :: [CoreExpr -> CoreExpr]
-	wraps = map (eqn_wrap . head) groups
-
-	groups' = [ eqn { eqn_wrap = idWrapper } : eqns | eqn:eqns <- groups ]
-    in
-	-- Now make a case alternative out of each group
-    mappM (match_con vars ty) groups'	`thenDs` \ alts ->
-    returnDs (adjustMatchResult (foldr (.) idWrapper wraps) $
-	      mkCoAlgCaseMatchResult var ty alts)
-\end{code}
-
-And here is the local function that does all the work.  It is
-more-or-less the @matchCon@/@matchClause@ functions on page~94 in
-Wadler's chapter in SLPJ.  The function @shift_con_pats@ does what the
-list comprehension in @matchClause@ (SLPJ, p.~94) does, except things
-are trickier in real life.  Works for @ConPats@, and we want it to
-fail catastrophically for anything else (which a list comprehension
-wouldn't).  Cf.~@shift_lit_pats@ in @MatchLits@.
-
-\begin{code}
-match_con vars ty eqns
-  = do	{ -- Make new vars for the con arguments; avoid new locals where possible
-	  arg_vars     <- selectMatchVars (map unLoc arg_pats1) arg_tys
-	; eqns'        <- mapM shift eqns 
-	; match_result <- match (arg_vars ++ vars) ty eqns'
-	; return (con, tvs1 ++ dicts1 ++ arg_vars, match_result) }
-  where
-    ConPatOut (L _ con) tvs1 dicts1 _ (PrefixCon arg_pats1) pat_ty = firstPat (head eqns)
-
-    shift eqn@(EqnInfo { eqn_wrap = wrap, 
-		         eqn_pats = ConPatOut _ tvs ds bind (PrefixCon arg_pats) _ : pats })
-	= do { prs <- dsLHsBinds bind
-	     ; return (eqn { eqn_wrap = wrap . wrapBinds (tvs `zip` tvs1) 
-					     . wrapBinds (ds  `zip` dicts1)
-					     . mkDsLet (Rec prs),
-			     eqn_pats = map unLoc arg_pats ++ pats }) }
-
-     	-- Get the arg types, which we use to type the new vars
-	-- to match on, from the "outside"; the types of pats1 may 
-	-- be more refined, and hence won't do
-    arg_tys = dataConInstOrigArgTys con inst_tys
-    inst_tys | isVanillaDataCon con = tcTyConAppArgs pat_ty	-- Newtypes opaque!
-	     | otherwise	    = mkTyVarTys tvs1
-\end{code}
-
-Note [Existentials in shift_con_pat]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-	data T = forall a. Ord a => T a (a->Int)
-
-	f (T x f) True  = ...expr1...
-	f (T y g) False = ...expr2..
-
-When we put in the tyvars etc we get
-
-	f (T a (d::Ord a) (x::a) (f::a->Int)) True =  ...expr1...
-	f (T b (e::Ord b) (y::a) (g::a->Int)) True =  ...expr2...
-
-After desugaring etc we'll get a single case:
-
-	f = \t::T b::Bool -> 
-	    case t of
-	       T a (d::Ord a) (x::a) (f::a->Int)) ->
-	    case b of
-		True  -> ...expr1...
-		False -> ...expr2...
-
-*** We have to substitute [a/b, d/e] in expr2! **
-Hence
-		False -> ....((/\b\(e:Ord b).expr2) a d)....
-
-Originally I tried to use 
-	(\b -> let e = d in expr2) a 
-to do this substitution.  While this is "correct" in a way, it fails
-Lint, because e::Ord b but d::Ord a.  
-
diff --git a/ghc/compiler/deSugar/MatchLit.lhs b/ghc/compiler/deSugar/MatchLit.lhs
deleted file mode 100644
index 0b7907b22e..0000000000
--- a/ghc/compiler/deSugar/MatchLit.lhs
+++ /dev/null
@@ -1,329 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[MatchLit]{Pattern-matching literal patterns}
-
-\begin{code}
-module MatchLit ( dsLit, dsOverLit,
-		  tidyLitPat, tidyNPat,
-		  matchLiterals, matchNPlusKPats, matchNPats ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} Match  ( match )
-import {-# SOURCE #-} DsExpr ( dsExpr )
-
-import DsMonad
-import DsUtils
-
-import HsSyn
-import Id		( Id, idType )
-import CoreSyn
-import TyCon		( tyConDataCons )
-import TcType		( tcSplitTyConApp, isIntegerTy, isIntTy, 
-			  isFloatTy, isDoubleTy, isStringTy )
-import Type		( Type )
-import PrelNames	( ratioTyConKey )
-import TysWiredIn	( stringTy, consDataCon, intDataCon, floatDataCon, doubleDataCon )
-import PrelNames	( eqStringName )
-import Unique		( hasKey )
-import Literal		( mkMachInt, Literal(..) )
-import SrcLoc		( noLoc )
-import ListSetOps	( equivClasses, runs )
-import Ratio 		( numerator, denominator )
-import SrcLoc		( Located(..) )
-import Outputable
-import FastString	( lengthFS, unpackFS )
-\end{code}
-
-%************************************************************************
-%*									*
-		Desugaring literals
-	[used to be in DsExpr, but DsMeta needs it,
-	 and it's nice to avoid a loop]
-%*									*
-%************************************************************************
-
-We give int/float literals type @Integer@ and @Rational@, respectively.
-The typechecker will (presumably) have put \tr{from{Integer,Rational}s}
-around them.
-
-ToDo: put in range checks for when converting ``@i@''
-(or should that be in the typechecker?)
-
-For numeric literals, we try to detect there use at a standard type
-(@Int@, @Float@, etc.) are directly put in the right constructor.
-[NB: down with the @App@ conversion.]
-
-See also below where we look for @DictApps@ for \tr{plusInt}, etc.
-
-\begin{code}
-dsLit :: HsLit -> DsM CoreExpr
-dsLit (HsChar c)       = returnDs (mkCharExpr c)
-dsLit (HsCharPrim c)   = returnDs (mkLit (MachChar c))
-dsLit (HsString str)   = mkStringExprFS str
-dsLit (HsStringPrim s) = returnDs (mkLit (MachStr s))
-dsLit (HsInteger i _)  = mkIntegerExpr i
-dsLit (HsInt i)	       = returnDs (mkIntExpr i)
-dsLit (HsIntPrim i)    = returnDs (mkIntLit i)
-dsLit (HsFloatPrim f)  = returnDs (mkLit (MachFloat f))
-dsLit (HsDoublePrim d) = returnDs (mkLit (MachDouble d))
-
-dsLit (HsRat r ty)
-  = mkIntegerExpr (numerator r)		`thenDs` \ num ->
-    mkIntegerExpr (denominator r)	`thenDs` \ denom ->
-    returnDs (mkConApp ratio_data_con [Type integer_ty, num, denom])
-  where
-    (ratio_data_con, integer_ty) 
-	= case tcSplitTyConApp ty of
-		(tycon, [i_ty]) -> ASSERT(isIntegerTy i_ty && tycon `hasKey` ratioTyConKey)
-				   (head (tyConDataCons tycon), i_ty)
-
-dsOverLit :: HsOverLit Id -> DsM CoreExpr
--- Post-typechecker, the SyntaxExpr field of an OverLit contains 
--- (an expression for) the literal value itself
-dsOverLit (HsIntegral   _ lit) = dsExpr lit
-dsOverLit (HsFractional _ lit) = dsExpr lit
-\end{code}
-
-%************************************************************************
-%*									*
-	Tidying lit pats
-%*									*
-%************************************************************************
-
-\begin{code}
-tidyLitPat :: HsLit -> LPat Id -> LPat Id
--- Result has only the following HsLits:
---	HsIntPrim, HsCharPrim, HsFloatPrim
---	HsDoublePrim, HsStringPrim, HsString
---  * HsInteger, HsRat, HsInt can't show up in LitPats
---  * We get rid of HsChar right here
-tidyLitPat (HsChar c) pat = mkCharLitPat c
-tidyLitPat (HsString s) pat
-  | lengthFS s <= 1	-- Short string literals only
-  = foldr (\c pat -> mkPrefixConPat consDataCon [mkCharLitPat c,pat] stringTy)
-	  (mkNilPat stringTy) (unpackFS s)
-	-- The stringTy is the type of the whole pattern, not 
-	-- the type to instantiate (:) or [] with!
-tidyLitPat lit	      pat = pat
-
-----------------
-tidyNPat :: HsOverLit Id -> Maybe (SyntaxExpr Id) -> Type -> LPat Id -> LPat Id
-tidyNPat over_lit mb_neg lit_ty default_pat
-  | isIntTy    lit_ty = mk_con_pat intDataCon    (HsIntPrim int_val)
-  | isFloatTy  lit_ty = mk_con_pat floatDataCon  (HsFloatPrim  rat_val)
-  | isDoubleTy lit_ty = mk_con_pat doubleDataCon (HsDoublePrim rat_val)
-  | otherwise	      = default_pat
-  where
-    mk_con_pat con lit = mkPrefixConPat con [noLoc $ LitPat lit] lit_ty 
-    neg_lit = case (mb_neg, over_lit) of
-		(Nothing, 	       _)   -> over_lit
-		(Just _,  HsIntegral i s)   -> HsIntegral   (-i) s
-		(Just _,  HsFractional f s) -> HsFractional (-f) s
-			     
-    int_val :: Integer
-    int_val = case neg_lit of
-		HsIntegral   i _ -> i
-		HsFractional f _ -> panic "tidyNPat"
-	
-    rat_val :: Rational
-    rat_val = case neg_lit of
-		HsIntegral   i _ -> fromInteger i
-		HsFractional f _ -> f
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Pattern matching on LitPat
-%*									*
-%************************************************************************
-
-\begin{code}
-matchLiterals :: [Id]
-	      -> Type	-- Type of the whole case expression
-	      -> [EquationInfo]
-	      -> DsM MatchResult
--- All the EquationInfos have LitPats at the front
-
-matchLiterals (var:vars) ty eqns
-  = do	{	-- Group by literal
-	  let groups :: [[(Literal, EquationInfo)]]
-	      groups = equivClasses cmpTaggedEqn (tagLitEqns eqns)
-
-		-- Deal with each group
-	; alts <- mapM match_group groups
-
-	 	-- Combine results.  For everything except String
-		-- we can use a case expression; for String we need
-		-- a chain of if-then-else
-	; if isStringTy (idType var) then
-	    do	{ mrs <- mapM wrap_str_guard alts
-		; return (foldr1 combineMatchResults mrs) }
-	  else 
-	    return (mkCoPrimCaseMatchResult var ty alts)
-	}
-  where
-    match_group :: [(Literal, EquationInfo)] -> DsM (Literal, MatchResult)
-    match_group group
-	= do { let (lits, eqns) = unzip group
-	     ; match_result <- match vars ty (shiftEqns eqns)
-	     ; return (head lits, match_result) }
-
-    wrap_str_guard :: (Literal,MatchResult) -> DsM MatchResult
-	-- Equality check for string literals
-    wrap_str_guard (MachStr s, mr)
-	= do { eq_str <- dsLookupGlobalId eqStringName
-	     ; lit    <- mkStringExprFS s
-	     ; let pred = mkApps (Var eq_str) [Var var, lit]
-	     ; return (mkGuardedMatchResult pred mr) }
-\end{code}
-
-%************************************************************************
-%*									*
-		Pattern matching on NPat
-%*									*
-%************************************************************************
-
-\begin{code}
-matchNPats :: [Id] -> Type -> [EquationInfo] -> DsM MatchResult
--- All the EquationInfos have NPat at the front
-
-matchNPats (var:vars) ty eqns
-  = do {  let groups :: [[(Literal, EquationInfo)]]
-	      groups = equivClasses cmpTaggedEqn (tagLitEqns eqns)
-
-	; match_results <- mapM (match_group . map snd) groups
-
-	; ASSERT( not (null match_results) )
-	  return (foldr1 combineMatchResults match_results) }
-  where
-    match_group :: [EquationInfo] -> DsM MatchResult
-    match_group (eqn1:eqns)
-	= do { lit_expr <- dsOverLit lit
-	     ; neg_lit <- case mb_neg of
-			    Nothing -> return lit_expr
-			    Just neg -> do { neg_expr <- dsExpr neg
-					   ; return (App neg_expr lit_expr) }
-	     ; eq_expr <- dsExpr eq_chk
-	     ; let pred_expr = mkApps eq_expr [Var var, neg_lit]
-	     ; match_result <- match vars ty (eqn1' : shiftEqns eqns)
-	     ; return (adjustMatchResult (eqn_wrap eqn1) $
-			-- Bring the eqn1 wrapper stuff into scope because
-			-- it may be used in pred_expr
-		       mkGuardedMatchResult pred_expr match_result) }
-	where
-	  NPat lit mb_neg eq_chk _ : pats1 = eqn_pats eqn1
-	  eqn1' = eqn1 { eqn_wrap = idWrapper, eqn_pats = pats1 }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Pattern matching on n+k patterns
-%*									*
-%************************************************************************
-
-For an n+k pattern, we use the various magic expressions we've been given.
-We generate:
-\begin{verbatim}
-    if ge var lit then
-	let n = sub var lit
-	in  <expr-for-a-successful-match>
-    else
-	<try-next-pattern-or-whatever>
-\end{verbatim}
-
-WATCH OUT!  Consider
-
-	f (n+1) = ...
-	f (n+2) = ...
-	f (n+1) = ...
-
-We can't group the first and third together, because the second may match 
-the same thing as the first.  Contrast
-	f 1 = ...
-	f 2 = ...
-	f 1 = ...
-where we can group the first and third.  Hence 'runs' rather than 'equivClasses'
-
-\begin{code}
-matchNPlusKPats all_vars@(var:vars) ty eqns
-  = do {  let groups :: [[(Literal, EquationInfo)]]
-	      groups = runs eqTaggedEqn (tagLitEqns eqns)
-
-	; match_results <- mapM (match_group . map snd) groups
-
-	; ASSERT( not (null match_results) )
-	  return (foldr1 combineMatchResults match_results) }
-  where
-    match_group :: [EquationInfo] -> DsM MatchResult
-    match_group (eqn1:eqns)
-	= do { ge_expr     <- dsExpr ge
-	     ; minus_expr  <- dsExpr minus
-	     ; lit_expr    <- dsOverLit lit
-	     ; let pred_expr   = mkApps ge_expr [Var var, lit_expr]
-		   minusk_expr = mkApps minus_expr [Var var, lit_expr]
-	     ; match_result <- match vars ty (eqn1' : map shift eqns)
-	     ; return  (adjustMatchResult (eqn_wrap eqn1) 	     $
-			-- Bring the eqn1 wrapper stuff into scope because
-			-- it may be used in ge_expr, minusk_expr
-		        mkGuardedMatchResult pred_expr 		    $
-			mkCoLetMatchResult (NonRec n1 minusk_expr)  $
-			match_result) }
-	where
-	  NPlusKPat (L _ n1) lit ge minus : pats1 = eqn_pats eqn1
-	  eqn1' = eqn1 { eqn_wrap = idWrapper, eqn_pats = pats1 }
-
-	  shift eqn@(EqnInfo { eqn_wrap = wrap,
-			       eqn_pats = NPlusKPat (L _ n) _ _ _ : pats })
-	    = eqn { eqn_wrap = wrap . wrapBind n n1, eqn_pats = pats }  
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Grouping functions
-%*									*
-%************************************************************************
-
-Given a blob of @LitPat@s/@NPat@s, we want to split them into those
-that are ``same''/different as one we are looking at.  We need to know
-whether we're looking at a @LitPat@/@NPat@, and what literal we're after.
-
-\begin{code}
--- Tag equations by the leading literal
--- NB: we have ordering on Core Literals, but not on HsLits
-cmpTaggedEqn :: (Literal,EquationInfo) -> (Literal,EquationInfo) -> Ordering
-cmpTaggedEqn (lit1,_) (lit2,_) = lit1 `compare` lit2
-
-eqTaggedEqn :: (Literal,EquationInfo) -> (Literal,EquationInfo) -> Bool
-eqTaggedEqn (lit1,_) (lit2,_) = lit1 == lit2
-
-tagLitEqns :: [EquationInfo] -> [(Literal, EquationInfo)]
-tagLitEqns eqns = [(get_lit (firstPat eqn), eqn) | eqn <- eqns]
-
-get_lit :: Pat Id -> Literal
--- Get a Core literal to use (only) a grouping key
--- Hence its type doesn't need to match the type of the original literal
-get_lit (LitPat (HsIntPrim     i)) = mkMachInt  i
-get_lit (LitPat (HsCharPrim    c)) = MachChar   c
-get_lit (LitPat (HsStringPrim  s)) = MachStr    s
-get_lit (LitPat (HsFloatPrim   f)) = MachFloat  f
-get_lit (LitPat (HsDoublePrim  d)) = MachDouble d
-get_lit (LitPat (HsString s))	   = MachStr    s
-
-get_lit (NPat (HsIntegral i _) Nothing  _ _)   = MachInt i
-get_lit (NPat (HsIntegral i _) (Just _) _ _)   = MachInt (-i)
-get_lit (NPat (HsFractional r _) Nothing  _ _) = MachFloat r
-get_lit (NPat (HsFractional r _) (Just _) _ _) = MachFloat (-r)
-
-get_lit (NPlusKPat _ (HsIntegral i _) _ _) = MachInt i
-
--- These ones can't happen
--- get_lit (LitPat (HsChar c))
--- get_lit (LitPat (HsInt i))	
-get_lit other = pprPanic "get_lit:bad pattern" (ppr other)
-\end{code}
-
diff --git a/ghc/compiler/deSugar/deSugar.tex b/ghc/compiler/deSugar/deSugar.tex
deleted file mode 100644
index 02cb285742..0000000000
--- a/ghc/compiler/deSugar/deSugar.tex
+++ /dev/null
@@ -1,23 +0,0 @@
-\documentstyle{report}
-\input{lit-style}
-
-\begin{document}
-\centerline{{\Large{deSugar}}}
-\tableofcontents
-
-\input{Desugar}    % {@deSugar@: the main function}
-\input{DsBinds}    % {Pattern-matching bindings (HsBinds and MonoBinds)}
-\input{DsGRHSs}    % {Matching guarded right-hand-sides (GRHSs)}
-\input{DsExpr}     % {Matching expressions (Exprs)}
-\input{DsHsSyn}    % {Haskell abstract syntax---added things for desugarer}
-\input{DsListComp} % {Desugaring list comprehensions}
-\input{DsMonad}    % {@DsMonad@: monadery used in desugaring}
-\input{DsUtils}    % {Utilities for desugaring}
-\input{Check}      % {Module @Check@ in @deSugar@}
-\input{Match}      % {The @match@ function}
-\input{MatchCon}   % {Pattern-matching constructors}
-\input{MatchLit}   % {Pattern-matching literal patterns}
-\input{DsForeign}  % {Desugaring \tr{foreign} declarations}
-\input{DsCCall}    % {Desugaring \tr{_ccall_}s and \tr{_casm_}s}
-
-\end{document} 
diff --git a/ghc/compiler/ghci/ByteCodeAsm.lhs b/ghc/compiler/ghci/ByteCodeAsm.lhs
deleted file mode 100644
index e332413dae..0000000000
--- a/ghc/compiler/ghci/ByteCodeAsm.lhs
+++ /dev/null
@@ -1,497 +0,0 @@
-%
-% (c) The University of Glasgow 2002
-%
-\section[ByteCodeLink]{Bytecode assembler and linker}
-
-\begin{code}
-{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
-
-module ByteCodeAsm (  
-	assembleBCOs, assembleBCO,
-
-	CompiledByteCode(..), 
-	UnlinkedBCO(..), BCOPtr(..), bcoFreeNames,
-	SizedSeq, sizeSS, ssElts,
-	iNTERP_STACK_CHECK_THRESH
-  ) where
-
-#include "HsVersions.h"
-
-import ByteCodeInstr
-import ByteCodeItbls	( ItblEnv, mkITbls )
-
-import Name		( Name, getName )
-import NameSet
-import FiniteMap	( addToFM, lookupFM, emptyFM )
-import Literal		( Literal(..) )
-import TyCon		( TyCon )
-import PrimOp		( PrimOp )
-import Constants	( wORD_SIZE )
-import FastString	( FastString(..) )
-import SMRep		( CgRep(..), StgWord )
-import FiniteMap
-import Outputable
-
-import Control.Monad	( foldM )
-import Control.Monad.ST	( runST )
-
-import GHC.Word		( Word(..) )
-import Data.Array.MArray
-import Data.Array.Unboxed ( listArray )
-import Data.Array.Base	( UArray(..) )
-import Data.Array.ST	( castSTUArray )
-import Foreign		( Word16, free )
-import Data.Int		( Int64 )
-import Data.Char	( ord )
-
-import GHC.Base		( ByteArray# )
-import GHC.IOBase	( IO(..) )
-import GHC.Ptr		( Ptr(..) )
-
--- -----------------------------------------------------------------------------
--- Unlinked BCOs
-
--- CompiledByteCode represents the result of byte-code 
--- compiling a bunch of functions and data types
-
-data CompiledByteCode 
-  = ByteCode [UnlinkedBCO] -- Bunch of interpretable bindings
-	     ItblEnv       -- A mapping from DataCons to their itbls
-
-instance Outputable CompiledByteCode where
-  ppr (ByteCode bcos _) = ppr bcos
-
-
-data UnlinkedBCO
-   = UnlinkedBCO {
-	unlinkedBCOName   :: Name,
-	unlinkedBCOArity  :: Int,
-	unlinkedBCOInstrs :: ByteArray#,			 -- insns
-	unlinkedBCOBitmap :: ByteArray#,			 -- bitmap
-        unlinkedBCOLits   :: (SizedSeq (Either Word FastString)), -- literals
-			-- Either literal words or a pointer to a asciiz
-			-- string, denoting a label whose *address* should
-			-- be determined at link time
-        unlinkedBCOPtrs   :: (SizedSeq BCOPtr), 	-- ptrs
- 	unlinkedBCOItbls  :: (SizedSeq Name)	 	-- itbl refs
-   }
-
-data BCOPtr
-  = BCOPtrName   Name
-  | BCOPtrPrimOp PrimOp
-  | BCOPtrBCO    UnlinkedBCO
-
--- | Finds external references.  Remember to remove the names
--- defined by this group of BCOs themselves
-bcoFreeNames :: UnlinkedBCO -> NameSet
-bcoFreeNames bco
-  = bco_refs bco `minusNameSet` mkNameSet [unlinkedBCOName bco]
-  where
-    bco_refs (UnlinkedBCO _ _ _ _ _ ptrs itbls)
-	= unionManyNameSets (
-	     mkNameSet [ n | BCOPtrName n <- ssElts ptrs ] :
-	     mkNameSet (ssElts itbls) :
-	     map bco_refs [ bco | BCOPtrBCO bco <- ssElts ptrs ]
-	  )
-
-instance Outputable UnlinkedBCO where
-   ppr (UnlinkedBCO nm arity insns bitmap lits ptrs itbls)
-      = sep [text "BCO", ppr nm, text "with", 
-             int (sizeSS lits), text "lits",
-             int (sizeSS ptrs), text "ptrs",
-             int (sizeSS itbls), text "itbls"]
-
--- -----------------------------------------------------------------------------
--- The bytecode assembler
-
--- The object format for bytecodes is: 16 bits for the opcode, and 16
--- for each field -- so the code can be considered a sequence of
--- 16-bit ints.  Each field denotes either a stack offset or number of
--- items on the stack (eg SLIDE), and index into the pointer table (eg
--- PUSH_G), an index into the literal table (eg PUSH_I/D/L), or a
--- bytecode address in this BCO.
-
--- Top level assembler fn.
-assembleBCOs :: [ProtoBCO Name] -> [TyCon] -> IO CompiledByteCode
-assembleBCOs proto_bcos tycons
-  = do	itblenv <- mkITbls tycons
-	bcos    <- mapM assembleBCO proto_bcos
-        return (ByteCode bcos itblenv)
-
-assembleBCO :: ProtoBCO Name -> IO UnlinkedBCO
-assembleBCO (ProtoBCO nm instrs bitmap bsize arity origin malloced)
-   = let
-         -- pass 1: collect up the offsets of the local labels.
-         -- Remember that the first insn starts at offset 1 since offset 0
-         -- (eventually) will hold the total # of insns.
-         label_env = mkLabelEnv emptyFM 1 instrs
-
-         mkLabelEnv env i_offset [] = env
-         mkLabelEnv env i_offset (i:is)
-            = let new_env 
-                     = case i of LABEL n -> addToFM env n i_offset ; _ -> env
-              in  mkLabelEnv new_env (i_offset + instrSize16s i) is
-
-         findLabel lab
-            = case lookupFM label_env lab of
-                 Just bco_offset -> bco_offset
-                 Nothing -> pprPanic "assembleBCO.findLabel" (int lab)
-     in
-     do  -- pass 2: generate the instruction, ptr and nonptr bits
-         insns <- return emptySS :: IO (SizedSeq Word16)
-         lits  <- return emptySS :: IO (SizedSeq (Either Word FastString))
-         ptrs  <- return emptySS :: IO (SizedSeq BCOPtr)
-         itbls <- return emptySS :: IO (SizedSeq Name)
-         let init_asm_state = (insns,lits,ptrs,itbls)
-         (final_insns, final_lits, final_ptrs, final_itbls) 
-            <- mkBits findLabel init_asm_state instrs
-
-	 let asm_insns = ssElts final_insns
-	     n_insns   = sizeSS final_insns
-
-             insns_arr
-		 | n_insns > 65535 = panic "linkBCO: >= 64k insns in BCO"
-                 | otherwise = mkInstrArray n_insns asm_insns
-             insns_barr = case insns_arr of UArray _lo _hi barr -> barr
-
-	     bitmap_arr = mkBitmapArray bsize bitmap
-             bitmap_barr = case bitmap_arr of UArray _lo _hi barr -> barr
-
-         let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits 
-					final_ptrs final_itbls
-
-         -- 8 Aug 01: Finalisers aren't safe when attached to non-primitive
-         -- objects, since they might get run too early.  Disable this until
-         -- we figure out what to do.
-         -- when (notNull malloced) (addFinalizer ul_bco (mapM_ zonk malloced))
-
-         return ul_bco
-     where
-         zonk ptr = do -- putStrLn ("freeing malloc'd block at " ++ show (A# a#))
-                           free ptr
-
-mkBitmapArray :: Int -> [StgWord] -> UArray Int StgWord
-mkBitmapArray bsize bitmap
-  = listArray (0, length bitmap) (fromIntegral bsize : bitmap)
-
-mkInstrArray :: Int -> [Word16]	-> UArray Int Word16
-mkInstrArray n_insns asm_insns
-  = listArray (0, n_insns) (fromIntegral n_insns : asm_insns)
-
--- instrs nonptrs ptrs itbls
-type AsmState = (SizedSeq Word16, 
-                 SizedSeq (Either Word FastString),
-                 SizedSeq BCOPtr, 
-                 SizedSeq Name)
-
-data SizedSeq a = SizedSeq !Int [a]
-emptySS = SizedSeq 0 []
-
--- Why are these two monadic???
-addToSS (SizedSeq n r_xs) x = return (SizedSeq (n+1) (x:r_xs))
-addListToSS (SizedSeq n r_xs) xs 
-   = return (SizedSeq (n + length xs) (reverse xs ++ r_xs))
-
-ssElts :: SizedSeq a -> [a]
-ssElts (SizedSeq n r_xs) = reverse r_xs
-
-sizeSS :: SizedSeq a -> Int
-sizeSS (SizedSeq n r_xs) = n
-
--- Bring in all the bci_ bytecode constants.
-#include "Bytecodes.h"
-
--- This is where all the action is (pass 2 of the assembler)
-mkBits :: (Int -> Int) 			-- label finder
-       -> AsmState
-       -> [BCInstr]			-- instructions (in)
-       -> IO AsmState
-
-mkBits findLabel st proto_insns
-  = foldM doInstr st proto_insns
-    where
-       doInstr :: AsmState -> BCInstr -> IO AsmState
-       doInstr st i
-          = case i of
-               STKCHECK  n        -> instr2 st bci_STKCHECK n
-               PUSH_L    o1       -> instr2 st bci_PUSH_L o1
-               PUSH_LL   o1 o2    -> instr3 st bci_PUSH_LL o1 o2
-               PUSH_LLL  o1 o2 o3 -> instr4 st bci_PUSH_LLL o1 o2 o3
-               PUSH_G    nm       -> do (p, st2) <- ptr st (BCOPtrName nm)
-                                        instr2 st2 bci_PUSH_G p
-               PUSH_PRIMOP op     -> do (p, st2) <- ptr st (BCOPtrPrimOp op)
-                                        instr2 st2 bci_PUSH_G p
-               PUSH_BCO proto     -> do ul_bco <- assembleBCO proto
- 					(p, st2) <- ptr st (BCOPtrBCO ul_bco)
-                                        instr2 st2 bci_PUSH_G p
-               PUSH_ALTS proto    -> do ul_bco <- assembleBCO proto
- 					(p, st2) <- ptr st (BCOPtrBCO ul_bco)
-                                        instr2 st2 bci_PUSH_ALTS p
-               PUSH_ALTS_UNLIFTED proto pk -> do 
-					ul_bco <- assembleBCO proto
- 					(p, st2) <- ptr st (BCOPtrBCO ul_bco)
-                                        instr2 st2 (push_alts pk) p
-               PUSH_UBX  (Left lit) nws  
-                                  -> do (np, st2) <- literal st lit
-                                        instr3 st2 bci_PUSH_UBX np nws
-               PUSH_UBX  (Right aa) nws  
-                                  -> do (np, st2) <- addr st aa
-                                        instr3 st2 bci_PUSH_UBX np nws
-
-	       PUSH_APPLY_N	    -> do instr1 st bci_PUSH_APPLY_N
-	       PUSH_APPLY_V	    -> do instr1 st bci_PUSH_APPLY_V
-	       PUSH_APPLY_F	    -> do instr1 st bci_PUSH_APPLY_F
-	       PUSH_APPLY_D	    -> do instr1 st bci_PUSH_APPLY_D
-	       PUSH_APPLY_L	    -> do instr1 st bci_PUSH_APPLY_L
-	       PUSH_APPLY_P	    -> do instr1 st bci_PUSH_APPLY_P
-	       PUSH_APPLY_PP	    -> do instr1 st bci_PUSH_APPLY_PP
-	       PUSH_APPLY_PPP	    -> do instr1 st bci_PUSH_APPLY_PPP
-	       PUSH_APPLY_PPPP	    -> do instr1 st bci_PUSH_APPLY_PPPP
-	       PUSH_APPLY_PPPPP	    -> do instr1 st bci_PUSH_APPLY_PPPPP
-	       PUSH_APPLY_PPPPPP    -> do instr1 st bci_PUSH_APPLY_PPPPPP
-
-               SLIDE     n by     -> instr3 st bci_SLIDE n by
-               ALLOC_AP  n        -> instr2 st bci_ALLOC_AP n
-               ALLOC_PAP arity n  -> instr3 st bci_ALLOC_PAP arity n
-               MKAP      off sz   -> instr3 st bci_MKAP off sz
-               MKPAP     off sz   -> instr3 st bci_MKPAP off sz
-               UNPACK    n        -> instr2 st bci_UNPACK n
-               PACK      dcon sz  -> do (itbl_no,st2) <- itbl st dcon
-                                        instr3 st2 bci_PACK itbl_no sz
-               LABEL     lab      -> return st
-               TESTLT_I  i l      -> do (np, st2) <- int st i
-                                        instr3 st2 bci_TESTLT_I np (findLabel l)
-               TESTEQ_I  i l      -> do (np, st2) <- int st i
-                                        instr3 st2 bci_TESTEQ_I np (findLabel l)
-               TESTLT_F  f l      -> do (np, st2) <- float st f
-                                        instr3 st2 bci_TESTLT_F np (findLabel l)
-               TESTEQ_F  f l      -> do (np, st2) <- float st f
-                                        instr3 st2 bci_TESTEQ_F np (findLabel l)
-               TESTLT_D  d l      -> do (np, st2) <- double st d
-                                        instr3 st2 bci_TESTLT_D np (findLabel l)
-               TESTEQ_D  d l      -> do (np, st2) <- double st d
-                                        instr3 st2 bci_TESTEQ_D np (findLabel l)
-               TESTLT_P  i l      -> instr3 st bci_TESTLT_P i (findLabel l)
-               TESTEQ_P  i l      -> instr3 st bci_TESTEQ_P i (findLabel l)
-               CASEFAIL           -> instr1 st bci_CASEFAIL
-               SWIZZLE   stkoff n -> instr3 st bci_SWIZZLE stkoff n
-               JMP       l        -> instr2 st bci_JMP (findLabel l)
-               ENTER              -> instr1 st bci_ENTER
-               RETURN             -> instr1 st bci_RETURN
-               RETURN_UBX rep     -> instr1 st (return_ubx rep)
-               CCALL off m_addr   -> do (np, st2) <- addr st m_addr
-                                        instr3 st2 bci_CCALL off np
-
-       i2s :: Int -> Word16
-       i2s = fromIntegral
-
-       instr1 (st_i0,st_l0,st_p0,st_I0) i1
-          = do st_i1 <- addToSS st_i0 i1
-               return (st_i1,st_l0,st_p0,st_I0)
-
-       instr2 (st_i0,st_l0,st_p0,st_I0) i1 i2
-          = do st_i1 <- addToSS st_i0 (i2s i1)
-               st_i2 <- addToSS st_i1 (i2s i2)
-               return (st_i2,st_l0,st_p0,st_I0)
-
-       instr3 (st_i0,st_l0,st_p0,st_I0) i1 i2 i3
-          = do st_i1 <- addToSS st_i0 (i2s i1)
-               st_i2 <- addToSS st_i1 (i2s i2)
-               st_i3 <- addToSS st_i2 (i2s i3)
-               return (st_i3,st_l0,st_p0,st_I0)
-
-       instr4 (st_i0,st_l0,st_p0,st_I0) i1 i2 i3 i4
-          = do st_i1 <- addToSS st_i0 (i2s i1)
-               st_i2 <- addToSS st_i1 (i2s i2)
-               st_i3 <- addToSS st_i2 (i2s i3)
-               st_i4 <- addToSS st_i3 (i2s i4)
-               return (st_i4,st_l0,st_p0,st_I0)
-
-       float (st_i0,st_l0,st_p0,st_I0) f
-          = do let ws = mkLitF f
-               st_l1 <- addListToSS st_l0 (map Left ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0))
-
-       double (st_i0,st_l0,st_p0,st_I0) d
-          = do let ws = mkLitD d
-               st_l1 <- addListToSS st_l0 (map Left ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0))
-
-       int (st_i0,st_l0,st_p0,st_I0) i
-          = do let ws = mkLitI i
-               st_l1 <- addListToSS st_l0 (map Left ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0))
-
-       int64 (st_i0,st_l0,st_p0,st_I0) i
-          = do let ws = mkLitI64 i
-               st_l1 <- addListToSS st_l0 (map Left ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0))
-
-       addr (st_i0,st_l0,st_p0,st_I0) a
-          = do let ws = mkLitPtr a
-               st_l1 <- addListToSS st_l0 (map Left ws)
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0))
-
-       litlabel (st_i0,st_l0,st_p0,st_I0) fs
-          = do st_l1 <- addListToSS st_l0 [Right fs]
-               return (sizeSS st_l0, (st_i0,st_l1,st_p0,st_I0))
-
-       ptr (st_i0,st_l0,st_p0,st_I0) p
-          = do st_p1 <- addToSS st_p0 p
-               return (sizeSS st_p0, (st_i0,st_l0,st_p1,st_I0))
-
-       itbl (st_i0,st_l0,st_p0,st_I0) dcon
-          = do st_I1 <- addToSS st_I0 (getName dcon)
-               return (sizeSS st_I0, (st_i0,st_l0,st_p0,st_I1))
-
-       literal st (MachLabel fs _) = litlabel st fs
-       literal st (MachWord w)     = int st (fromIntegral w)
-       literal st (MachInt j)      = int st (fromIntegral j)
-       literal st (MachFloat r)    = float st (fromRational r)
-       literal st (MachDouble r)   = double st (fromRational r)
-       literal st (MachChar c)     = int st (ord c)
-       literal st (MachInt64 ii)   = int64 st (fromIntegral ii)
-       literal st (MachWord64 ii)  = int64 st (fromIntegral ii)
-       literal st other            = pprPanic "ByteCodeLink.literal" (ppr other)
-
-
-push_alts NonPtrArg = bci_PUSH_ALTS_N
-push_alts FloatArg  = bci_PUSH_ALTS_F
-push_alts DoubleArg = bci_PUSH_ALTS_D
-push_alts VoidArg   = bci_PUSH_ALTS_V
-push_alts LongArg   = bci_PUSH_ALTS_L
-push_alts PtrArg    = bci_PUSH_ALTS_P
-
-return_ubx NonPtrArg = bci_RETURN_N
-return_ubx FloatArg  = bci_RETURN_F
-return_ubx DoubleArg = bci_RETURN_D
-return_ubx VoidArg   = bci_RETURN_V
-return_ubx LongArg   = bci_RETURN_L
-return_ubx PtrArg    = bci_RETURN_P
-
-
--- The size in 16-bit entities of an instruction.
-instrSize16s :: BCInstr -> Int
-instrSize16s instr
-   = case instr of
-        STKCHECK{}		-> 2
-        PUSH_L{}		-> 2
-        PUSH_LL{}		-> 3
-        PUSH_LLL{}		-> 4
-        PUSH_G{}		-> 2
-        PUSH_PRIMOP{}		-> 2
-        PUSH_BCO{}		-> 2
-        PUSH_ALTS{}		-> 2
-        PUSH_ALTS_UNLIFTED{}	-> 2
-	PUSH_UBX{}		-> 3
-	PUSH_APPLY_N{}		-> 1
-	PUSH_APPLY_V{}		-> 1
-	PUSH_APPLY_F{}		-> 1
-	PUSH_APPLY_D{}		-> 1
-	PUSH_APPLY_L{}		-> 1
-	PUSH_APPLY_P{}		-> 1
-	PUSH_APPLY_PP{}		-> 1
-	PUSH_APPLY_PPP{}	-> 1
-	PUSH_APPLY_PPPP{}	-> 1
-	PUSH_APPLY_PPPPP{}	-> 1
-	PUSH_APPLY_PPPPPP{}	-> 1
-        SLIDE{}			-> 3
-        ALLOC_AP{}		-> 2
-        ALLOC_PAP{}		-> 3
-        MKAP{}			-> 3
-        MKPAP{}			-> 3
-        UNPACK{}		-> 2
-        PACK{}			-> 3
-        LABEL{}			-> 0	-- !!
-        TESTLT_I{}		-> 3
-        TESTEQ_I{}		-> 3
-        TESTLT_F{}		-> 3
-        TESTEQ_F{}		-> 3
-        TESTLT_D{}		-> 3
-        TESTEQ_D{}		-> 3
-        TESTLT_P{}		-> 3
-        TESTEQ_P{}		-> 3
-        JMP{}			-> 2
-        CASEFAIL{}		-> 1
-        ENTER{}			-> 1
-        RETURN{}		-> 1
-        RETURN_UBX{}		-> 1
-	CCALL{}			-> 3
-        SWIZZLE{}		-> 3
-
--- Make lists of host-sized words for literals, so that when the
--- words are placed in memory at increasing addresses, the
--- bit pattern is correct for the host's word size and endianness.
-mkLitI   :: Int    -> [Word]
-mkLitF   :: Float  -> [Word]
-mkLitD   :: Double -> [Word]
-mkLitPtr :: Ptr () -> [Word]
-mkLitI64 :: Int64  -> [Word]
-
-mkLitF f
-   = runST (do
-        arr <- newArray_ ((0::Int),0)
-        writeArray arr 0 f
-        f_arr <- castSTUArray arr
-        w0 <- readArray f_arr 0
-        return [w0 :: Word]
-     )
-
-mkLitD d
-   | wORD_SIZE == 4
-   = runST (do
-        arr <- newArray_ ((0::Int),1)
-        writeArray arr 0 d
-        d_arr <- castSTUArray arr
-        w0 <- readArray d_arr 0
-        w1 <- readArray d_arr 1
-        return [w0 :: Word, w1]
-     )
-   | wORD_SIZE == 8
-   = runST (do
-        arr <- newArray_ ((0::Int),0)
-        writeArray arr 0 d
-        d_arr <- castSTUArray arr
-        w0 <- readArray d_arr 0
-        return [w0 :: Word]
-     )
-
-mkLitI64 ii
-   | wORD_SIZE == 4
-   = runST (do
-        arr <- newArray_ ((0::Int),1)
-        writeArray arr 0 ii
-        d_arr <- castSTUArray arr
-        w0 <- readArray d_arr 0
-        w1 <- readArray d_arr 1
-        return [w0 :: Word,w1]
-     )
-   | wORD_SIZE == 8
-   = runST (do
-        arr <- newArray_ ((0::Int),0)
-        writeArray arr 0 ii
-        d_arr <- castSTUArray arr
-        w0 <- readArray d_arr 0
-        return [w0 :: Word]
-     )
-
-mkLitI i
-   = runST (do
-        arr <- newArray_ ((0::Int),0)
-        writeArray arr 0 i
-        i_arr <- castSTUArray arr
-        w0 <- readArray i_arr 0
-        return [w0 :: Word]
-     )
-
-mkLitPtr a
-   = runST (do
-        arr <- newArray_ ((0::Int),0)
-        writeArray arr 0 a
-        a_arr <- castSTUArray arr
-        w0 <- readArray a_arr 0
-        return [w0 :: Word]
-     )
-
-iNTERP_STACK_CHECK_THRESH = (INTERP_STACK_CHECK_THRESH :: Int)
-\end{code}
diff --git a/ghc/compiler/ghci/ByteCodeFFI.lhs b/ghc/compiler/ghci/ByteCodeFFI.lhs
deleted file mode 100644
index 61e70d64e4..0000000000
--- a/ghc/compiler/ghci/ByteCodeFFI.lhs
+++ /dev/null
@@ -1,832 +0,0 @@
-%
-% (c) The University of Glasgow 2001
-%
-\section[ByteCodeGen]{Generate machine-code sequences for foreign import}
-
-\begin{code}
-module ByteCodeFFI ( mkMarshalCode, moan64 ) where
-
-#include "HsVersions.h"
-
-import Outputable
-import SMRep		( CgRep(..), cgRepSizeW )
-import ForeignCall	( CCallConv(..) )
-import Panic
-
--- DON'T remove apparently unused imports here .. 
--- there is ifdeffery below
-import Control.Exception ( throwDyn )
-import DATA_BITS	( Bits(..), shiftR, shiftL )
-import Foreign		( newArray )
-import Data.List        ( mapAccumL )
-
-import DATA_WORD	( Word8, Word32 )
-import Foreign		( Ptr )
-import System.IO.Unsafe ( unsafePerformIO )
-import IO		( hPutStrLn, stderr )
-import Debug.Trace	( trace )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The platform-dependent marshall-code-generator.}
-%*									*
-%************************************************************************
-
-\begin{code}
-
-moan64 :: String -> SDoc -> a
-moan64 msg pp_rep
-   = unsafePerformIO (
-        hPutStrLn stderr (
-        "\nGHCi's bytecode generation machinery can't handle 64-bit\n" ++
-        "code properly yet.  You can work around this for the time being\n" ++
-        "by compiling this module and all those it imports to object code,\n" ++
-        "and re-starting your GHCi session.  The panic below contains information,\n" ++
-        "intended for the GHC implementors, about the exact place where GHC gave up.\n"
-        )
-     )
-     `seq`
-     pprPanic msg pp_rep
-
-
--- For sparc_TARGET_ARCH, i386_TARGET_ARCH, etc.
-#include "nativeGen/NCG.h"
-
-{-
-Make a piece of code which expects to see the Haskell stack
-looking like this.  It is given a pointer to the lowest word in
-the stack -- presumably the tag of the placeholder.
-                 
-                  <arg_n>
-                  ...
-                  <arg_1>
-                  Addr# address_of_C_fn
-                  <placeholder-for-result#> (must be an unboxed type)
-
-We cope with both ccall and stdcall for the C fn.  However, this code
-itself expects only to be called using the ccall convention -- that is,
-we don't clear our own (single) arg off the C stack.
--}
-mkMarshalCode :: CCallConv
-              -> (Int, CgRep) -> Int -> [(Int, CgRep)] 
-              -> IO (Ptr Word8)
-mkMarshalCode cconv (r_offW, r_rep) addr_offW arg_offs_n_reps
-   = let bytes = mkMarshalCode_wrk cconv (r_offW, r_rep) 
-                                   addr_offW arg_offs_n_reps
-     in  trace (show bytes) $ Foreign.newArray bytes
-
-
-
-
-mkMarshalCode_wrk :: CCallConv 
-                  -> (Int, CgRep) -> Int -> [(Int, CgRep)] 
-                  -> [Word8]
-
-mkMarshalCode_wrk cconv (r_offW, r_rep) addr_offW arg_offs_n_reps
-
-#if i386_TARGET_ARCH
-
-   = let -- Don't change this without first consulting Intel Corp :-)
-         bytes_per_word = 4
-
-         offsets_to_pushW
-            = concat
-              [   -- reversed because x86 is little-endian
-                  reverse [a_offW .. a_offW + cgRepSizeW a_rep - 1]
-
-                -- reversed because args are pushed L -> R onto C stack
-                | (a_offW, a_rep) <- reverse arg_offs_n_reps
-              ]
-         
-         arguments_size = bytes_per_word * length offsets_to_pushW
-#if darwin_TARGET_OS
-             -- Darwin: align stack frame size to a multiple of 16 bytes
-         stack_frame_size = (arguments_size + 15) .&. complement 15
-         stack_frame_pad = stack_frame_size - arguments_size
-#else
-         stack_frame_size = arguments_size
-#endif
-
-         -- some helpers to assemble x86 insns.
-         movl_offespmem_esi offB	-- movl   offB(%esp), %esi
-            = [0x8B, 0xB4, 0x24] ++ lit32 offB
-         movl_offesimem_ecx offB	-- movl   offB(%esi), %ecx
-            = [0x8B, 0x8E] ++ lit32 offB
-         save_regs			-- pushl  all intregs except %esp
-            = [0x50, 0x53, 0x51, 0x52, 0x56, 0x57, 0x55]
-         restore_regs			-- popl   ditto
-            = [0x5D, 0x5F, 0x5E, 0x5A, 0x59, 0x5B, 0x58]
-         pushl_ecx			-- pushl  %ecx
-            = [0x51]
-         call_star_ecx			-- call   * %ecx
-            = [0xFF, 0xD1]
-         add_lit_esp lit		-- addl   $lit, %esp
-            = [0x81, 0xC4] ++ lit32 lit
-         movl_eax_offesimem offB	-- movl   %eax, offB(%esi)
-            = [0x89, 0x86] ++ lit32 offB
-         movl_edx_offesimem offB	-- movl   %edx, offB(%esi)
-            = [0x89, 0x96] ++ lit32 offB
-         ret				-- ret
-            = [0xC3]
-         fstpl_offesimem offB		-- fstpl   offB(%esi)
-            = [0xDD, 0x9E] ++ lit32 offB
-         fstps_offesimem offB		-- fstps   offB(%esi)
-            = [0xD9, 0x9E] ++ lit32 offB
-         {-
-             2 0000 8BB42478    movl    0x12345678(%esp), %esi
-             2      563412
-             3 0007 8B8E7856    movl    0x12345678(%esi), %ecx
-             3      3412
-             4              
-             5 000d 50535152    pushl %eax ; pushl %ebx ; pushl %ecx ; pushl  %edx
-             6 0011 565755      pushl %esi ; pushl %edi ; pushl %ebp
-             7              
-             8 0014 5D5F5E      popl %ebp ; popl %edi ; popl %esi 
-             9 0017 5A595B58    popl %edx ; popl %ecx ; popl %ebx ; popl %eax
-            10              
-            11 001b 51          pushl %ecx
-            12 001c FFD1        call * %ecx
-            13              
-            14 001e 81C47856    addl $0x12345678, %esp
-            14      3412
-            15 0024 89867856    movl %eax, 0x12345678(%esi)
-            15      3412
-            16 002a 89967856    movl %edx, 0x12345678(%esi)
-            16      3412
-            17           
-            18 0030 DD967856    fstl    0x12345678(%esi)
-            18      3412
-            19 0036 DD9E7856    fstpl   0x12345678(%esi)
-            19      3412
-            20 003c D9967856    fsts    0x12345678(%esi)
-            20      3412
-            21 0042 D99E7856    fstps   0x12345678(%esi)
-            18              
-            19 0030 C3          ret
-            20              
-
-         -}
-
-     in
-     --trace (show (map fst arg_offs_n_reps))
-     (
-     {- On entry, top of C stack 0(%esp) is the RA and 4(%esp) is 
-        arg passed from the interpreter.
-
-        Push all callee saved regs.  Push all of them anyway ...
-           pushl       %eax
-           pushl       %ebx
-           pushl       %ecx
-           pushl       %edx
-           pushl       %esi
-           pushl       %edi
-           pushl       %ebp
-     -}
-     save_regs
-
-     {- Now 28+0(%esp) is RA and 28+4(%esp) is the arg (the H stack ptr).
-        We'll use %esi as a temporary to point at the H stack, and
-        %ecx as a temporary to copy via.
-
-           movl        28+4(%esp), %esi
-     -}
-     ++ movl_offespmem_esi 32
-
-#if darwin_TARGET_OS
-     {- On Darwin, add some padding so that the stack stays aligned. -}
-     ++ (if stack_frame_pad /= 0
-            then add_lit_esp (-stack_frame_pad)
-            else [])
-#endif
-
-     {- For each arg in args_offs_n_reps, examine the associated
-        CgRep to determine how many words there are.  This gives a
-        bunch of offsets on the H stack to copy to the C stack:
-
-           movl        off1(%esi), %ecx
-           pushl       %ecx
-     -}
-     ++ concatMap (\offW -> movl_offesimem_ecx (bytes_per_word * offW) 
-                            ++ pushl_ecx) 
-                  offsets_to_pushW
-
-     {- Get the addr to call into %ecx, bearing in mind that there's 
-        an Addr# tag at the indicated location, and do the call:
-
-           movl        4*(1 /*tag*/ +addr_offW)(%esi), %ecx
-           call        * %ecx
-     -}
-     ++ movl_offesimem_ecx (bytes_per_word * addr_offW)
-     ++ call_star_ecx
-
-     {- Nuke the args just pushed and re-establish %esi at the 
-        H-stack ptr:
-
-           addl        $4*number_of_args_pushed, %esp (ccall only)
-           movl        28+4(%esp), %esi
-     -}
-     ++ (if   cconv /= StdCallConv
-         then add_lit_esp stack_frame_size
-         else [])
-     ++ movl_offespmem_esi 32
-
-     {- Depending on what the return type is, get the result 
-        from %eax or %edx:%eax or %st(0).
-
-           movl        %eax, 4(%esi)        -- assuming tagged result
-        or
-           movl        %edx, 4(%esi)
-           movl        %eax, 8(%esi)
-        or
-           fstpl       4(%esi)
-        or
-           fstps       4(%esi)
-     -}
-     ++ let i32 = movl_eax_offesimem 0
-            i64 = movl_eax_offesimem 0 ++ movl_edx_offesimem 4
-            f32 = fstps_offesimem 0
-            f64 = fstpl_offesimem 0
-        in
-        case r_rep of
-           NonPtrArg -> i32
-           DoubleArg -> f64  
-           FloatArg  -> f32
-           -- LongArg -> i64
-           VoidArg   -> []
-           other     -> moan64 "ByteCodeFFI.mkMarshalCode_wrk(x86)" 
-                               (ppr r_rep)
-
-     {- Restore all the pushed regs and go home.
-
-           pushl        %ebp
-           pushl        %edi
-           pushl        %esi
-           pushl        %edx
-           pushl        %ecx
-           pushl        %ebx
-           pushl        %eax
-
-           ret
-     -}
-     ++ restore_regs
-     ++ ret
-     )
-
-#elif x86_64_TARGET_ARCH
-
-   =
-     -- the address of the H stack is in %rdi.  We need to move it out, so
-     -- we can use %rdi as an arg reg for the following call:
-    pushq_rbp ++
-    movq_rdi_rbp ++
-	
-     -- ####### load / push the args
-
-     let
-	(stack_args, fregs_unused, reg_loads) = 
-	   load_arg_regs arg_offs_n_reps int_loads float_loads []
-
-	tot_arg_size = bytes_per_word * length stack_args
-
-	-- On entry to the called function, %rsp should be aligned
-	-- on a 16-byte boundary +8 (i.e. the first stack arg after
-	-- the return address is 16-byte aligned).  In STG land
-	-- %rsp is kept 16-byte aligned (see StgCRun.c), so we just
-	-- need to make sure we push a multiple of 16-bytes of args,
-	-- plus the return address, to get the correct alignment.
-	(real_size, adjust_rsp)
-	  | tot_arg_size `rem` 16 == 0 	  = (tot_arg_size, [])
-	  | otherwise           	  = (tot_arg_size + 8, subq_lit_rsp 8)
-
-	(stack_pushes, stack_words) =
-		push_args stack_args [] 0
-
-	-- we need to know the number of SSE regs used in the call, see later
-	n_sse_regs_used = length float_loads - length fregs_unused
-     in
-        concat reg_loads
-     ++ adjust_rsp
-     ++ concat stack_pushes -- push in reverse order
-
-     -- ####### make the call
-
-	-- use %r10 to make the call, because we don't have to save it.
-        --      movq 8*addr_offW(%rbp), %r10
-     ++ movq_rbpoff_r10 (bytes_per_word * addr_offW)
-
-	-- The x86_64 ABI requires us to set %al to the number of SSE
-	-- registers that contain arguments, if the called routine
-	-- is a varargs function.  We don't know whether it's a
-	-- varargs function or not, so we have to assume it is.
-	--
-	-- It's not safe to omit this assignment, even if the number
-	-- of SSE regs in use is zero.  If %al is larger than 8
-	-- on entry to a varargs function, seg faults ensue.
-     ++ movq_lit_rax n_sse_regs_used
-     ++ call_star_r10
-
-	-- pop the args from the stack, only in ccall mode 
-	-- (in stdcall the callee does it).
-     ++ (if   cconv /= StdCallConv
-         then addq_lit_rsp real_size
-         else [])
-
-     -- ####### place the result in the right place and return
-
-     ++ assign_result
-     ++ popq_rbp
-     ++ ret
-
-  where
-     bytes_per_word = 8
-
-     -- int arg regs: rdi,rsi,rdx,rcx,r8,r9
-     -- flt arg regs: xmm0..xmm7
-     int_loads   = [ movq_rbpoff_rdi, movq_rbpoff_rsi, movq_rbpoff_rdx,
- 		     movq_rbpoff_rcx, movq_rbpoff_r8,  movq_rbpoff_r9 ]
-     float_loads = [ (mov_f32_rbpoff_xmm n, mov_f64_rbpoff_xmm n) | n <- [0..7] ]
-
-     load_arg_regs args [] [] code     =  (args, [], code)
-     load_arg_regs [] iregs fregs code =  ([], fregs, code)
-     load_arg_regs ((off,rep):args) iregs fregs code
-	| FloatArg  <- rep, ((mov_f32,_):frest) <- fregs =
-		load_arg_regs args iregs frest (mov_f32 (bytes_per_word * off) : code)
-	| DoubleArg <- rep, ((_,mov_f64):frest) <- fregs =
-		load_arg_regs args iregs frest (mov_f64 (bytes_per_word * off) : code)
-	| (mov_reg:irest) <- iregs =
-		load_arg_regs args irest fregs (mov_reg (bytes_per_word * off) : code)
-	| otherwise =
-		 push_this_arg
-	where
-	   push_this_arg = ((off,rep):args',fregs', code')
-		where (args',fregs',code') = load_arg_regs args iregs fregs code
-
-     push_args [] code pushed_words = (code, pushed_words)
-     push_args ((off,rep):args) code pushed_words
-	| FloatArg  <- rep =
-		push_args args (push_f32_rbpoff (bytes_per_word * off) : code) 
-			(pushed_words+1)
-	| DoubleArg <- rep =
-		push_args args (push_f64_rbpoff (bytes_per_word * off) : code)
-			(pushed_words+1)
-	| otherwise =
-		push_args args (pushq_rbpoff (bytes_per_word * off) : code)
-			(pushed_words+1)
-
-
-     assign_result = 
-	case r_rep of
-	  DoubleArg -> f64
-	  FloatArg  -> f32
-          VoidArg   -> []
-	  _other    -> i64
-	where
-	  i64 = movq_rax_rbpoff 0
-	  f32 = mov_f32_xmm0_rbpoff 0
-	  f64 = mov_f64_xmm0_rbpoff 0
-
--- ######### x86_64 machine code:
-
---   0:   48 89 fd                mov    %rdi,%rbp
---   3:   48 8b bd 78 56 34 12    mov    0x12345678(%rbp),%rdi
---   a:   48 8b b5 78 56 34 12    mov    0x12345678(%rbp),%rsi
---  11:   48 8b 95 78 56 34 12    mov    0x12345678(%rbp),%rdx
---  18:   48 8b 8d 78 56 34 12    mov    0x12345678(%rbp),%rcx
---  1f:   4c 8b 85 78 56 34 12    mov    0x12345678(%rbp),%r8
---  26:   4c 8b 8d 78 56 34 12    mov    0x12345678(%rbp),%r9
---  2d:   4c 8b 95 78 56 34 12    mov    0x12345678(%rbp),%r10
---  34:   48 c7 c0 78 56 34 12    mov    $0x12345678,%rax
---  3b:   48 89 85 78 56 34 12    mov    %rax,0x12345678(%rbp)
---  42:   f3 0f 10 85 78 56 34 12 movss  0x12345678(%rbp),%xmm0
---  4a:   f2 0f 10 85 78 56 34 12 movsd  0x12345678(%rbp),%xmm0
---  52:   f3 0f 11 85 78 56 34 12 movss  %xmm0,0x12345678(%rbp)
---  5a:   f2 0f 11 85 78 56 34 12 movsd  %xmm0,0x12345678(%rbp)
---  62:   ff b5 78 56 34 12       pushq  0x12345678(%rbp)
---  68:   f3 44 0f 11 04 24       movss  %xmm8,(%rsp)
---  6e:   f2 44 0f 11 04 24       movsd  %xmm8,(%rsp)
---  74:   48 81 ec 78 56 34 12    sub    $0x12345678,%rsp
---  7b:   48 81 c4 78 56 34 12    add    $0x12345678,%rsp
---  82:   41 ff d2                callq  *%r10
---  85:   c3                      retq   
-
-     movq_rdi_rbp         = [0x48,0x89,0xfd]
-     movq_rbpoff_rdi  off = [0x48, 0x8b, 0xbd] ++ lit32 off
-     movq_rbpoff_rsi  off = [0x48, 0x8b, 0xb5] ++ lit32 off
-     movq_rbpoff_rdx  off = [0x48, 0x8b, 0x95] ++ lit32 off
-     movq_rbpoff_rcx  off = [0x48, 0x8b, 0x8d] ++ lit32 off 
-     movq_rbpoff_r8   off = [0x4c, 0x8b, 0x85] ++ lit32 off
-     movq_rbpoff_r9   off = [0x4c, 0x8b, 0x8d] ++ lit32 off
-     movq_rbpoff_r10  off = [0x4c, 0x8b, 0x95] ++ lit32 off
-     movq_lit_rax     lit = [0x48, 0xc7, 0xc0] ++ lit32 lit
-     movq_rax_rbpoff  off = [0x48, 0x89, 0x85] ++ lit32 off
-     mov_f32_rbpoff_xmm n off = [0xf3, 0x0f, 0x10, 0x85 + n`shiftL`3] ++ lit32 off
-     mov_f64_rbpoff_xmm n off = [0xf2, 0x0f, 0x10, 0x85 + n`shiftL`3] ++ lit32 off
-     mov_f32_xmm0_rbpoff  off = [0xf3, 0x0f, 0x11, 0x85] ++ lit32 off
-     mov_f64_xmm0_rbpoff  off = [0xf2, 0x0f, 0x11, 0x85] ++ lit32 off
-     pushq_rbpoff     off = [0xff, 0xb5] ++ lit32 off
-     push_f32_rbpoff  off = 
-	mov_f32_rbpoff_xmm 8 off ++		 -- movss off(%rbp), %xmm8
-	[0xf3, 0x44, 0x0f, 0x11, 0x04, 0x24] ++	 -- movss %xmm8, (%rsp)
-	subq_lit_rsp 8				 -- subq $8, %rsp
-     push_f64_rbpoff  off =
-	mov_f64_rbpoff_xmm 8 off ++		 -- movsd off(%rbp), %xmm8
-	[0xf2, 0x44, 0x0f, 0x11, 0x04, 0x24] ++  -- movsd %xmm8, (%rsp)
-	subq_lit_rsp 8				 -- subq $8, %rsp
-     subq_lit_rsp     lit = [0x48, 0x81, 0xec] ++ lit32 lit
-     addq_lit_rsp     lit = [0x48, 0x81, 0xc4] ++ lit32 lit
-     call_star_r10 = [0x41,0xff,0xd2]
-     ret = [0xc3]
-     pushq_rbp = [0x55]
-     popq_rbp = [0x5d]
-
-#elif sparc_TARGET_ARCH
-
-   = let -- At least for sparc V8
-         bytes_per_word = 4
-
-         -- speaks for itself
-         w32_to_w8s_bigEndian :: Word32 -> [Word8]
-         w32_to_w8s_bigEndian w
-            =  [fromIntegral (0xFF .&. (w `shiftR` 24)),
-                fromIntegral (0xFF .&. (w `shiftR` 16)),
-                fromIntegral (0xFF .&. (w `shiftR` 8)),
-                fromIntegral (0xFF .&. w)]
-
-         offsets_to_pushW
-            = concat
-              [  [a_offW .. a_offW + cgRepSizeW a_rep - 1]
-
-                | (a_offW, a_rep) <- arg_offs_n_reps
-              ]
-
-         total_argWs    = length offsets_to_pushW
-         argWs_on_stack = if total_argWs > 6 then total_argWs - 6 
-                                             else 0
-
-         -- The stack pointer must be kept 8-byte aligned, which means
-         -- we need to calculate this quantity too
-         argWs_on_stack_ROUNDED_UP
-            | odd argWs_on_stack = 1 + argWs_on_stack
-            | otherwise          = argWs_on_stack
-
-         -- some helpers to assemble sparc insns.
-         -- REGS
-         iReg, oReg, gReg, fReg :: Int -> Word32
-         iReg = fromIntegral . (+ 24)
-         oReg = fromIntegral . (+ 8)
-         gReg = fromIntegral . (+ 0)
-         fReg = fromIntegral
-
-         sp = oReg 6
-         i0 = iReg 0
-         i7 = iReg 7
-         o0 = oReg 0
-         o1 = oReg 1
-         o7 = oReg 7
-         g0 = gReg 0
-         g1 = gReg 1
-         f0 = fReg 0
-         f1 = fReg 1
-
-         -- INSN templates
-         insn_r_r_i :: Word32 -> Word32 -> Word32 -> Int -> Word32
-         insn_r_r_i op3 rs1 rd imm13
-            = (3 `shiftL` 30) 
-              .|. (rs1 `shiftL` 25)
-              .|. (op3 `shiftL` 19)
-              .|. (rd `shiftL` 14) 
-              .|. (1 `shiftL` 13) 
-              .|. mkSimm13 imm13
-
-         insn_r_i_r :: Word32 -> Word32 -> Int -> Word32 -> Word32
-         insn_r_i_r op3 rs1 imm13 rd
-            = (2 `shiftL` 30) 
-              .|. (rd `shiftL` 25)
-              .|. (op3 `shiftL` 19)
-              .|. (rs1 `shiftL` 14) 
-              .|. (1 `shiftL` 13) 
-              .|. mkSimm13 imm13
-
-         mkSimm13 :: Int -> Word32
-         mkSimm13 imm13 
-            = let imm13w = (fromIntegral imm13) :: Word32
-              in  imm13w .&. 0x1FFF             
-
-         -- REAL (non-synthetic) insns
-         -- or %rs1, %rs2, %rd
-         mkOR :: Word32 -> Word32 -> Word32 -> Word32
-         mkOR rs1 rs2 rd 
-            = (2 `shiftL` 30) 
-              .|. (rd `shiftL` 25)
-              .|. (op3_OR `shiftL` 19)
-              .|. (rs1 `shiftL` 14) 
-              .|. (0 `shiftL` 13) 
-              .|. rs2
-              where op3_OR = 2 :: Word32
-
-         -- ld(int)   [%rs + imm13], %rd
-         mkLD rs1 imm13 rd = insn_r_r_i 0x00{-op3_LD-} rd rs1 imm13
-
-         -- st(int)   %rs, [%rd + imm13]
-         mkST   = insn_r_r_i 0x04 -- op3_ST
-
-         -- st(float) %rs, [%rd + imm13]
-         mkSTF  = insn_r_r_i 0x24 -- op3_STF
-
-         -- jmpl     %rs + imm13, %rd
-         mkJMPL = insn_r_i_r 0x38 -- op3_JMPL
-
-         -- save     %rs + imm13, %rd
-         mkSAVE = insn_r_i_r 0x3C -- op3_SAVE
-
-         -- restore  %rs + imm13, %rd
-         mkRESTORE = insn_r_i_r 0x3D -- op3_RESTORE
-
-         -- SYNTHETIC insns
-         mkNOP             = mkOR g0 g0 g0
-         mkCALL reg        = mkJMPL reg 0 o7
-         mkRET             = mkJMPL i7 8 g0
-         mkRESTORE_TRIVIAL = mkRESTORE g0 0 g0
-     in
-     --trace (show (map fst arg_offs_n_reps))
-     concatMap w32_to_w8s_bigEndian (
-
-     {- On entry, %o0 is the arg passed from the interpreter.  After
-        the initial save insn, it will be in %i0.  Studying the sparc
-        docs one would have thought that the minimum frame size is 92
-        bytes, but gcc always uses at least 112, and indeed there are
-        segfaults a-plenty with 92.  So I use 112 here as well.  I
-        don't understand why, tho.  
-     -}
-     [mkSAVE sp (- ({-92-}112 + 4*argWs_on_stack_ROUNDED_UP)) sp]
-
-     {- For each arg in args_offs_n_reps, examine the associated
-        CgRep to determine how many words there are.  This gives a
-        bunch of offsets on the H stack.  Move the first 6 words into
-        %o0 .. %o5 and the rest on the stack, starting at [%sp+92].
-        Use %g1 as a temp. 
-     -}
-     ++ let doArgW (offW, wordNo)
-              | wordNo < 6
-              = [mkLD i0 (bytes_per_word * offW) (oReg wordNo)]
-              | otherwise
-              = [mkLD i0 (bytes_per_word * offW) g1,
-                 mkST g1 sp (92 + bytes_per_word * (wordNo - 6))]
-        in  
-            concatMap doArgW (zip offsets_to_pushW [0 ..])
-
-     {- Get the addr to call into %g1, bearing in mind that there's 
-        an Addr# tag at the indicated location, and do the call:
-
-           ld     [4*(1 /*tag*/ +addr_offW) + %i0], %g1
-           call   %g1
-     -}
-     ++ [mkLD i0 (bytes_per_word * addr_offW) g1,
-         mkCALL g1,
-         mkNOP]
-
-     {- Depending on what the return type is, get the result 
-        from %o0 or %o1:%o0 or %f0 or %f1:%f0.
-
-           st          %o0, [%i0 + 4]        -- 32 bit int
-        or
-           st          %o0, [%i0 + 4]        -- 64 bit int
-           st          %o1, [%i0 + 8]        -- or the other way round?
-        or
-           st          %f0, [%i0 + 4]        -- 32 bit float
-        or
-           st          %f0, [%i0 + 4]        -- 64 bit float
-           st          %f1, [%i0 + 8]        -- or the other way round?
-
-     -}
-     ++ let i32 = [mkST o0 i0 0]
-            i64 = [mkST o0 i0 0, mkST o1 i0 4]
-            f32 = [mkSTF f0 i0 0]
-            f64 = [mkSTF f0 i0 0, mkSTF f1 i0 4]
-        in
-            case r_rep of
-               NonPtrArg -> i32
-               DoubleArg -> f64
-               FloatArg  -> f32
-               VoidArg   -> []
-               other     -> moan64 "ByteCodeFFI.mkMarshalCode_wrk(sparc)" 
-                                   (ppr r_rep)
-
-     ++ [mkRET,
-         mkRESTORE_TRIVIAL]  -- this is in the delay slot of the RET
-     )
-#elif powerpc_TARGET_ARCH && darwin_TARGET_OS
-
-   = let
-         bytes_per_word = 4
-
-         -- speaks for itself
-         w32_to_w8s_bigEndian :: Word32 -> [Word8]
-         w32_to_w8s_bigEndian w
-            =  [fromIntegral (0xFF .&. (w `shiftR` 24)),
-                fromIntegral (0xFF .&. (w `shiftR` 16)),
-                fromIntegral (0xFF .&. (w `shiftR` 8)),
-                fromIntegral (0xFF .&. w)]
-
-         -- addr and result bits offsetsW
-         a_off = addr_offW * bytes_per_word
-         result_off  = r_offW * bytes_per_word
-
-         linkageArea = 24
-         parameterArea = sum [ cgRepSizeW a_rep * bytes_per_word
-                        | (_, a_rep) <- arg_offs_n_reps ]
-         savedRegisterArea = 4
-         frameSize = padTo16 (linkageArea + max parameterArea 32 + savedRegisterArea)
-         padTo16 x = case x `mod` 16 of
-            0 -> x
-            y -> x - y + 16
-             
-         pass_parameters [] _ _ = []
-         pass_parameters ((a_offW, a_rep):args) nextFPR offsetW =
-            let
-               haskellArgOffset = a_offW * bytes_per_word
-               offsetW' = offsetW + cgRepSizeW a_rep
-               
-               pass_word w 
-                   | offsetW + w < 8 =
-                      [0x801f0000    -- lwz rX, src(r31)
-                        .|. (fromIntegral src .&. 0xFFFF)
-                        .|. (fromIntegral (offsetW+w+3) `shiftL` 21)]
-                   | otherwise =
-                      [0x801f0000    -- lwz r0, src(r31)
-                        .|. (fromIntegral src .&. 0xFFFF),
-                       0x90010000    -- stw r0, dst(r1)
-                        .|. (fromIntegral dst .&. 0xFFFF)]
-                  where
-                     src = haskellArgOffset + w*bytes_per_word
-                     dst = linkageArea + (offsetW+w) * bytes_per_word
-            in
-               case a_rep of
-                  FloatArg | nextFPR < 14 ->
-                      (0xc01f0000    -- lfs fX, haskellArgOffset(r31)
-                        .|. (fromIntegral haskellArgOffset .&. 0xFFFF)
-                        .|. (fromIntegral nextFPR `shiftL` 21))
-                      : pass_parameters args (nextFPR+1) offsetW'
-                  DoubleArg | nextFPR < 14 ->
-                      (0xc81f0000    -- lfd fX, haskellArgOffset(r31)
-                        .|. (fromIntegral haskellArgOffset .&. 0xFFFF)
-                        .|. (fromIntegral nextFPR `shiftL` 21))
-                      : pass_parameters args (nextFPR+1) offsetW'
-                  _ ->
-                      concatMap pass_word [0 .. cgRepSizeW a_rep - 1]
-                      ++ pass_parameters args nextFPR offsetW'              
-               
-         gather_result = case r_rep of
-            VoidArg -> []
-            FloatArg -> 
-               [0xd03f0000 .|. (fromIntegral result_off .&. 0xFFFF)]
-               -- stfs f1, result_off(r31)
-            DoubleArg -> 
-               [0xd83f0000 .|. (fromIntegral result_off .&. 0xFFFF)]
-               -- stfd f1, result_off(r31)
-            _ | cgRepSizeW r_rep == 2 ->
-               [0x907f0000 .|. (fromIntegral result_off .&. 0xFFFF),
-                0x909f0000 .|. (fromIntegral (result_off+4) .&. 0xFFFF)]
-               -- stw r3, result_off(r31)
-               -- stw r4, result_off+4(r31)
-            _ | cgRepSizeW r_rep == 1 ->
-               [0x907f0000 .|. (fromIntegral result_off .&. 0xFFFF)]
-               -- stw r3, result_off(r31)
-     in
-         concatMap w32_to_w8s_bigEndian $ [
-            0x7c0802a6,         -- mflr r0
-            0x93e1fffc,         -- stw r31,-4(r1)
-            0x90010008,         -- stw r0,8(r1)
-            0x94210000 .|. (fromIntegral (-frameSize) .&. 0xFFFF),
-                                -- stwu r1, -frameSize(r1)
-            0x7c7f1b78          -- mr r31, r3
-         ] ++ pass_parameters arg_offs_n_reps 1 0 ++ [
-            0x819f0000 .|. (fromIntegral a_off .&. 0xFFFF),
-                                -- lwz r12, a_off(r31)
-            0x7d8903a6,         -- mtctr r12
-            0x4e800421          -- bctrl
-         ] ++ gather_result ++ [
-            0x80210000,         -- lwz r1, 0(r1)
-            0x83e1fffc,         -- lwz r31, -4(r1)
-            0x80010008,         -- lwz r0, 8(r1)
-            0x7c0803a6,         -- mtlr r0
-            0x4e800020          -- blr
-         ]
-
-#elif powerpc_TARGET_ARCH && linux_TARGET_OS
-
-   -- All offsets here are measured in Words (not bytes).  This includes
-   -- arguments to the load/store machine code generators, alignment numbers
-   -- and the final 'framesize' among others.
-
-   = concatMap w32_to_w8s_bigEndian $ [
-            0x7c0802a6,                         -- mflr r0
-            0x93e1fffc,                         -- stw r31,-4(r1)
-            0x90010008,                         -- stw r0,8(r1)
-            0x94210000 .|. offset (-framesize), -- stwu r1, -frameSize(r1)
-            0x7c7f1b78                          -- mr r31, r3
-            ] ++ pass_parameters ++             -- pass the parameters
-            loadWord 12 addr_offW ++ [          -- lwz r12, a_off(r31)
-            0x7d8903a6,                         -- mtctr r12
-            0x4e800421                          -- bctrl
-            ] ++ gather_result ++ [             -- save the return value
-            0x80210000,                         -- lwz r1, 0(r1)
-            0x83e1fffc,                         -- lwz r31, -4(r1)
-            0x80010008,                         -- lwz r0, 8(r1)
-            0x7c0803a6,                         -- mtlr r0
-            0x4e800020                          -- blr
-         ]
-
-   where
-     gather_result :: [Word32]
-     gather_result = case r_rep of
-       VoidArg   -> []
-       FloatArg  -> storeFloat  1 r_offW
-       DoubleArg -> storeDouble 1 r_offW
-       LongArg   -> storeLong   3 r_offW
-       _         -> storeWord   3 r_offW
-
-     pass_parameters :: [Word32]
-     pass_parameters = concat params
-
-     -- vector aligned (4 word = 16 bytes) with 8 extra words of buffer space
-     framesize = alignedTo 4 (argsize + 8)
-
-     ((_,_,argsize), params) = mapAccumL loadparam (3,1,2) arg_offs_n_reps
-
-     -- handle one argument, returning machine code and the updated state
-     loadparam :: (Int, Int, Int) -> (Int, CgRep) ->
-                  ((Int, Int, Int), [Word32])
-
-     loadparam (gpr, fpr, stack) (ofs, rep) = case rep of
-       FloatArg | fpr <= 8  -> ( (gpr, fpr + 1, stack),  loadFloat fpr ofs )
-       FloatArg             -> ( (gpr, fpr, stack + 1),  stackWord stack ofs )
-
-       DoubleArg | fpr <= 8 -> ( (gpr, fpr + 1, stack),  loadDouble fpr ofs )
-       DoubleArg            -> ( (gpr, fpr, astack + 2), stackLong astack ofs )
-
-       LongArg | even gpr   -> loadparam (gpr + 1, fpr, stack) (ofs, rep)
-       LongArg | gpr <= 9   -> ( (gpr + 2, fpr, stack),  loadLong gpr ofs )
-       LongArg              -> ( (gpr, fpr, astack + 2), stackLong astack ofs )
-
-       _ | gpr <= 10        -> ( (gpr + 1, fpr, stack),  loadWord gpr ofs )
-       _                    -> ( (gpr, fpr, stack + 1),  stackWord stack ofs )
-      where astack = alignedTo 2 stack
-
-     alignedTo :: Int -> Int -> Int
-     alignedTo alignment x = case x `mod` alignment of
-                               0 -> x
-                               y -> x - y + alignment
-
-     -- convenience macros to do multiple-instruction data moves
-     stackWord dst src = loadWord 0 src ++ storeWordC 0 dst
-     stackLong dst src = stackWord dst src ++ stackWord (dst + 1) (src + 1)
-     loadLong  dst src = loadWord dst src ++ loadWord (dst + 1) (src + 1)
-     storeLong dst src = storeWord dst src ++ storeWord (dst + 1) (src + 1)
-
-     -- load data from the Haskell stack (relative to r31)
-     loadFloat   = loadstoreInstr 0xc01f0000 -- lfs fpr, ofs(r31)
-     loadDouble  = loadstoreInstr 0xc81f0000 -- lfd fpr, ofs(r31)
-     loadWord    = loadstoreInstr 0x801f0000 -- lwz gpr, ofs(r31)
-
-     -- store data to the Haskell stack (relative to r31)
-     storeFloat  = loadstoreInstr 0xd01f0000 -- stfs fpr, ofs(r31)
-     storeDouble = loadstoreInstr 0xd81f0000 -- stfd fpr, ofs(r31)
-     storeWord   = loadstoreInstr 0x901f0000 -- stw gpr, ofs(r31)
-
-     -- store data to the C stack (relative to r1)
-     storeWordC  = loadstoreInstr 0x90010000 -- stw gpr, ofs(r1)
-
-     -- machine code building blocks
-     loadstoreInstr :: Word32 -> Int -> Int -> [Word32]
-     loadstoreInstr code reg ofs = [ code .|. register reg .|. offset ofs ]
-
-     register :: Int -> Word32
-     register reg = fromIntegral reg `shiftL` 21
-
-     offset :: Int -> Word32
-     offset ofs   = fromIntegral (ofs * 4) .&. 0xFFFF
-
-     -- speaks for itself
-     w32_to_w8s_bigEndian :: Word32 -> [Word8]
-     w32_to_w8s_bigEndian w =  [fromIntegral (0xFF .&. (w `shiftR` 24)),
-                                fromIntegral (0xFF .&. (w `shiftR` 16)),
-                                fromIntegral (0xFF .&. (w `shiftR` 8)),
-                                fromIntegral (0xFF .&. w)]
-
-#else 
-
-   = throwDyn (InstallationError "foreign import is not implemented for GHCi on this platform.")
-
-#endif
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-lit32 :: Int -> [Word8]
-lit32 i = let w32 = (fromIntegral i) :: Word32
-          in  map (fromIntegral . ( .&. 0xFF))
-                  [w32, w32 `shiftR` 8, 
-                   w32 `shiftR` 16,  w32 `shiftR` 24]
-#endif
-\end{code}
-
diff --git a/ghc/compiler/ghci/ByteCodeGen.lhs b/ghc/compiler/ghci/ByteCodeGen.lhs
deleted file mode 100644
index 19db7af16b..0000000000
--- a/ghc/compiler/ghci/ByteCodeGen.lhs
+++ /dev/null
@@ -1,1358 +0,0 @@
-%
-% (c) The University of Glasgow 2002
-%
-\section[ByteCodeGen]{Generate bytecode from Core}
-
-\begin{code}
-module ByteCodeGen ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where
-
-#include "HsVersions.h"
-
-import ByteCodeInstr
-import ByteCodeFFI	( mkMarshalCode, moan64 )
-import ByteCodeAsm	( CompiledByteCode(..), UnlinkedBCO, 
-			  assembleBCO, assembleBCOs, iNTERP_STACK_CHECK_THRESH )
-import ByteCodeLink	( lookupStaticPtr )
-
-import Outputable
-import Name		( Name, getName, mkSystemVarName )
-import Id
-import FiniteMap
-import ForeignCall	( ForeignCall(..), CCallTarget(..), CCallSpec(..) )
-import HscTypes		( TypeEnv, typeEnvTyCons, typeEnvClasses )
-import CoreUtils	( exprType )
-import CoreSyn
-import PprCore		( pprCoreExpr )
-import Literal		( Literal(..), literalType )
-import PrimOp		( PrimOp(..) )
-import CoreFVs		( freeVars )
-import Type		( isUnLiftedType, splitTyConApp_maybe )
-import DataCon		( DataCon, dataConTag, fIRST_TAG, dataConTyCon, 
-                          isUnboxedTupleCon, isNullaryRepDataCon, dataConWorkId,
-			  dataConRepArity )
-import TyCon		( TyCon, tyConFamilySize, isDataTyCon, 
-			  tyConDataCons, isUnboxedTupleTyCon )
-import Class		( Class, classTyCon )
-import Type		( Type, repType, splitFunTys, dropForAlls, pprType )
-import Util
-import DataCon		( dataConRepArity )
-import Var		( isTyVar )
-import VarSet		( VarSet, varSetElems )
-import TysPrim		( arrayPrimTyCon, mutableArrayPrimTyCon,
-			  byteArrayPrimTyCon, mutableByteArrayPrimTyCon
-			)
-import DynFlags	( DynFlags, DynFlag(..) )
-import ErrUtils		( showPass, dumpIfSet_dyn )
-import Unique		( mkPseudoUniqueE )
-import FastString	( FastString(..), unpackFS )
-import Panic		( GhcException(..) )
-import SMRep		( typeCgRep, arrWordsHdrSize, arrPtrsHdrSize, StgWord, 
-			  CgRep(..), cgRepSizeW, isFollowableArg, idCgRep )
-import Bitmap		( intsToReverseBitmap, mkBitmap )
-import OrdList
-import Constants	( wORD_SIZE )
-
-import Data.List	( intersperse, sortBy, zip4, zip6, partition )
-import Foreign		( Ptr, castPtr, mallocBytes, pokeByteOff, Word8,
-			  withForeignPtr )
-import Foreign.C	( CInt )
-import Control.Exception	( throwDyn )
-
-import GHC.Exts		( Int(..), ByteArray# )
-
-import Control.Monad	( when )
-import Data.Char	( ord, chr )
-
--- -----------------------------------------------------------------------------
--- Generating byte code for a complete module 
-
-byteCodeGen :: DynFlags
-            -> [CoreBind]
-	    -> [TyCon]
-            -> IO CompiledByteCode
-byteCodeGen dflags binds tycs
-   = do showPass dflags "ByteCodeGen"
-
-        let flatBinds = [ (bndr, freeVars rhs) 
-			| (bndr, rhs) <- flattenBinds binds]
-
-        (BcM_State final_ctr mallocd, proto_bcos)
-           <- runBc (mapM schemeTopBind flatBinds)
-
-        when (notNull mallocd)
-             (panic "ByteCodeGen.byteCodeGen: missing final emitBc?")
-
-        dumpIfSet_dyn dflags Opt_D_dump_BCOs
-           "Proto-BCOs" (vcat (intersperse (char ' ') (map ppr proto_bcos)))
-
-        assembleBCOs proto_bcos tycs
-        
--- -----------------------------------------------------------------------------
--- Generating byte code for an expression
-
--- Returns: (the root BCO for this expression, 
---           a list of auxilary BCOs resulting from compiling closures)
-coreExprToBCOs :: DynFlags
-	       -> CoreExpr
-               -> IO UnlinkedBCO
-coreExprToBCOs dflags expr
- = do showPass dflags "ByteCodeGen"
-
-      -- create a totally bogus name for the top-level BCO; this
-      -- should be harmless, since it's never used for anything
-      let invented_name  = mkSystemVarName (mkPseudoUniqueE 0) FSLIT("ExprTopLevel")
-          invented_id    = mkLocalId invented_name (panic "invented_id's type")
-	  
-      (BcM_State final_ctr mallocd, proto_bco) 
-         <- runBc (schemeTopBind (invented_id, freeVars expr))
-
-      when (notNull mallocd)
-           (panic "ByteCodeGen.coreExprToBCOs: missing final emitBc?")
-
-      dumpIfSet_dyn dflags Opt_D_dump_BCOs "Proto-BCOs" (ppr proto_bco)
-
-      assembleBCO proto_bco
-
-
--- -----------------------------------------------------------------------------
--- Compilation schema for the bytecode generator
-
-type BCInstrList = OrdList BCInstr
-
-type Sequel = Int	-- back off to this depth before ENTER
-
--- Maps Ids to the offset from the stack _base_ so we don't have
--- to mess with it after each push/pop.
-type BCEnv = FiniteMap Id Int	-- To find vars on the stack
-
-ppBCEnv :: BCEnv -> SDoc
-ppBCEnv p
-   = text "begin-env"
-     $$ nest 4 (vcat (map pp_one (sortBy cmp_snd (fmToList p))))
-     $$ text "end-env"
-     where
-        pp_one (var, offset) = int offset <> colon <+> ppr var <+> ppr (idCgRep var)
-        cmp_snd x y = compare (snd x) (snd y)
-
--- Create a BCO and do a spot of peephole optimisation on the insns
--- at the same time.
-mkProtoBCO
-   :: name
-   -> BCInstrList
-   -> Either  [AnnAlt Id VarSet] (AnnExpr Id VarSet)
-   -> Int
-   -> Int
-   -> [StgWord]
-   -> Bool   	-- True <=> is a return point, rather than a function
-   -> [Ptr ()]
-   -> ProtoBCO name
-mkProtoBCO nm instrs_ordlist origin arity bitmap_size bitmap
-  is_ret mallocd_blocks
-   = ProtoBCO {
-	protoBCOName = nm,
-	protoBCOInstrs = maybe_with_stack_check,
-	protoBCOBitmap = bitmap,
-	protoBCOBitmapSize = bitmap_size,
-	protoBCOArity = arity,
-	protoBCOExpr = origin,
-	protoBCOPtrs = mallocd_blocks
-      }
-     where
-        -- Overestimate the stack usage (in words) of this BCO,
-        -- and if >= iNTERP_STACK_CHECK_THRESH, add an explicit
-        -- stack check.  (The interpreter always does a stack check
-        -- for iNTERP_STACK_CHECK_THRESH words at the start of each
-        -- BCO anyway, so we only need to add an explicit on in the
-        -- (hopefully rare) cases when the (overestimated) stack use
-        -- exceeds iNTERP_STACK_CHECK_THRESH.
-        maybe_with_stack_check
-	   | is_ret = peep_d
-		-- don't do stack checks at return points;
-		-- everything is aggregated up to the top BCO
-		-- (which must be a function)
-           | stack_overest >= 65535
-           = pprPanic "mkProtoBCO: stack use won't fit in 16 bits" 
-                      (int stack_overest)
-           | stack_overest >= iNTERP_STACK_CHECK_THRESH
-           = STKCHECK stack_overest : peep_d
-           | otherwise
-           = peep_d	-- the supposedly common case
-             
-        stack_overest = sum (map bciStackUse peep_d)
-
-        -- Merge local pushes
-        peep_d = peep (fromOL instrs_ordlist)
-
-        peep (PUSH_L off1 : PUSH_L off2 : PUSH_L off3 : rest)
-           = PUSH_LLL off1 (off2-1) (off3-2) : peep rest
-        peep (PUSH_L off1 : PUSH_L off2 : rest)
-           = PUSH_LL off1 (off2-1) : peep rest
-        peep (i:rest)
-           = i : peep rest
-        peep []
-           = []
-
-argBits :: [CgRep] -> [Bool]
-argBits [] = []
-argBits (rep : args)
-  | isFollowableArg rep = False : argBits args
-  | otherwise = take (cgRepSizeW rep) (repeat True) ++ argBits args
-
--- -----------------------------------------------------------------------------
--- schemeTopBind
-
--- Compile code for the right-hand side of a top-level binding
-
-schemeTopBind :: (Id, AnnExpr Id VarSet) -> BcM (ProtoBCO Name)
-
-
-schemeTopBind (id, rhs)
-  | Just data_con <- isDataConWorkId_maybe id,
-    isNullaryRepDataCon data_con
-  = 	-- Special case for the worker of a nullary data con.
-	-- It'll look like this:	Nil = /\a -> Nil a
-	-- If we feed it into schemeR, we'll get 
-	--	Nil = Nil
-	-- because mkConAppCode treats nullary constructor applications
-	-- by just re-using the single top-level definition.  So
-	-- for the worker itself, we must allocate it directly.
-    emitBc (mkProtoBCO (getName id) (toOL [PACK data_con 0, ENTER])
-                       (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-})
-
-  | otherwise
-  = schemeR [{- No free variables -}] (id, rhs)
-
--- -----------------------------------------------------------------------------
--- schemeR
-
--- Compile code for a right-hand side, to give a BCO that,
--- when executed with the free variables and arguments on top of the stack,
--- will return with a pointer to the result on top of the stack, after
--- removing the free variables and arguments.
---
--- Park the resulting BCO in the monad.  Also requires the
--- variable to which this value was bound, so as to give the
--- resulting BCO a name. 
-
-schemeR :: [Id] 		-- Free vars of the RHS, ordered as they
-				-- will appear in the thunk.  Empty for
-				-- top-level things, which have no free vars.
-	-> (Id, AnnExpr Id VarSet)
-	-> BcM (ProtoBCO Name)
-schemeR fvs (nm, rhs) 
-{-
-   | trace (showSDoc (
-              (char ' '
-               $$ (ppr.filter (not.isTyVar).varSetElems.fst) rhs
-               $$ pprCoreExpr (deAnnotate rhs)
-               $$ char ' '
-              ))) False
-   = undefined
-   | otherwise
--}
-   = schemeR_wrk fvs nm rhs (collect [] rhs)
-
-collect xs (_, AnnNote note e) = collect xs e
-collect xs (_, AnnLam x e)     = collect (if isTyVar x then xs else (x:xs)) e
-collect xs (_, not_lambda)     = (reverse xs, not_lambda)
-
-schemeR_wrk fvs nm original_body (args, body)
-   = let 
-	 all_args  = reverse args ++ fvs
-	 arity     = length all_args
-	 -- all_args are the args in reverse order.  We're compiling a function
-	 -- \fv1..fvn x1..xn -> e 
-	 -- i.e. the fvs come first
-
-         szsw_args = map idSizeW all_args
-         szw_args  = sum szsw_args
-         p_init    = listToFM (zip all_args (mkStackOffsets 0 szsw_args))
-
-	 -- make the arg bitmap
-	 bits = argBits (reverse (map idCgRep all_args))
-	 bitmap_size = length bits
-	 bitmap = mkBitmap bits
-     in
-     schemeE szw_args 0 p_init body 		`thenBc` \ body_code ->
-     emitBc (mkProtoBCO (getName nm) body_code (Right original_body)
-		arity bitmap_size bitmap False{-not alts-})
-
-
-fvsToEnv :: BCEnv -> VarSet -> [Id]
--- Takes the free variables of a right-hand side, and
--- delivers an ordered list of the local variables that will
--- be captured in the thunk for the RHS
--- The BCEnv argument tells which variables are in the local
--- environment: these are the ones that should be captured
---
--- The code that constructs the thunk, and the code that executes
--- it, have to agree about this layout
-fvsToEnv p fvs = [v | v <- varSetElems fvs, 
-		      isId v,		-- Could be a type variable
-		      v `elemFM` p]
-
--- -----------------------------------------------------------------------------
--- schemeE
-
--- Compile code to apply the given expression to the remaining args
--- on the stack, returning a HNF.
-schemeE :: Int -> Sequel -> BCEnv -> AnnExpr' Id VarSet -> BcM BCInstrList
-
--- Delegate tail-calls to schemeT.
-schemeE d s p e@(AnnApp f a) 
-   = schemeT d s p e
-
-schemeE d s p e@(AnnVar v)
-   | not (isUnLiftedType v_type)
-   =  -- Lifted-type thing; push it in the normal way
-     schemeT d s p e
-
-   | otherwise
-   = -- Returning an unlifted value.  
-     -- Heave it on the stack, SLIDE, and RETURN.
-     pushAtom d p (AnnVar v)	`thenBc` \ (push, szw) ->
-     returnBc (push 			-- value onto stack
-               `appOL`  mkSLIDE szw (d-s) 	-- clear to sequel
-               `snocOL` RETURN_UBX v_rep)	-- go
-   where
-      v_type = idType v
-      v_rep = typeCgRep v_type
-
-schemeE d s p (AnnLit literal)
-   = pushAtom d p (AnnLit literal)	`thenBc` \ (push, szw) ->
-     let l_rep = typeCgRep (literalType literal)
-     in  returnBc (push 			-- value onto stack
-                   `appOL`  mkSLIDE szw (d-s) 	-- clear to sequel
-                   `snocOL` RETURN_UBX l_rep)	-- go
-
-
-schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body))
-   | (AnnVar v, args_r_to_l) <- splitApp rhs,
-     Just data_con <- isDataConWorkId_maybe v,
-     dataConRepArity data_con == length args_r_to_l
-   = 	-- Special case for a non-recursive let whose RHS is a 
-	-- saturatred constructor application.
-	-- Just allocate the constructor and carry on
-     mkConAppCode d s p data_con args_r_to_l	`thenBc` \ alloc_code ->
-     schemeE (d+1) s (addToFM p x d) body	`thenBc` \ body_code ->
-     returnBc (alloc_code `appOL` body_code)
-
--- General case for let.  Generates correct, if inefficient, code in
--- all situations.
-schemeE d s p (AnnLet binds (_,body))
-   = let (xs,rhss) = case binds of AnnNonRec x rhs  -> ([x],[rhs])
-                                   AnnRec xs_n_rhss -> unzip xs_n_rhss
-         n_binds = length xs
-
-         fvss  = map (fvsToEnv p' . fst) rhss
-
-         -- Sizes of free vars
-         sizes = map (\rhs_fvs -> sum (map idSizeW rhs_fvs)) fvss
-
-	 -- the arity of each rhs
-	 arities = map (length . fst . collect []) rhss
-
-         -- This p', d' defn is safe because all the items being pushed
-         -- are ptrs, so all have size 1.  d' and p' reflect the stack
-         -- after the closures have been allocated in the heap (but not
-         -- filled in), and pointers to them parked on the stack.
-         p'    = addListToFM p (zipE xs (mkStackOffsets d (nOfThem n_binds 1)))
-         d'    = d + n_binds
-         zipE  = zipEqual "schemeE"
-
-         -- ToDo: don't build thunks for things with no free variables
-         build_thunk dd [] size bco off arity
-            = returnBc (PUSH_BCO bco `consOL` unitOL (mkap (off+size) size))
-	   where 
-		mkap | arity == 0 = MKAP
-		     | otherwise  = MKPAP
-         build_thunk dd (fv:fvs) size bco off arity = do
-              (push_code, pushed_szw) <- pushAtom dd p' (AnnVar fv) 
-              more_push_code <- build_thunk (dd+pushed_szw) fvs size bco off arity
-              returnBc (push_code `appOL` more_push_code)
-
-         alloc_code = toOL (zipWith mkAlloc sizes arities)
-	   where mkAlloc sz 0     = ALLOC_AP sz
-		 mkAlloc sz arity = ALLOC_PAP arity sz
-
-	 compile_bind d' fvs x rhs size arity off = do
-		bco <- schemeR fvs (x,rhs)
-		build_thunk d' fvs size bco off arity
-
-	 compile_binds = 
-	    [ compile_bind d' fvs x rhs size arity n
-	    | (fvs, x, rhs, size, arity, n) <- 
-		zip6 fvss xs rhss sizes arities [n_binds, n_binds-1 .. 1]
-	    ]
-     in do
-     body_code <- schemeE d' s p' body
-     thunk_codes <- sequence compile_binds
-     returnBc (alloc_code `appOL` concatOL thunk_codes `appOL` body_code)
-
-
-
-schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1, bind2], rhs)])
-   | isUnboxedTupleCon dc, VoidArg <- typeCgRep (idType bind1)
-	-- Convert 
-	--	case .... of x { (# VoidArg'd-thing, a #) -> ... }
-	-- to
-	-- 	case .... of a { DEFAULT -> ... }
-	-- becuse the return convention for both are identical.
-	--
-	-- Note that it does not matter losing the void-rep thing from the
-	-- envt (it won't be bound now) because we never look such things up.
-
-   = --trace "automagic mashing of case alts (# VoidArg, a #)" $
-     doCase d s p scrut bind2 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
-
-   | isUnboxedTupleCon dc, VoidArg <- typeCgRep (idType bind2)
-   = --trace "automagic mashing of case alts (# a, VoidArg #)" $
-     doCase d s p scrut bind1 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
-
-schemeE d s p (AnnCase scrut bndr _ [(DataAlt dc, [bind1], rhs)])
-   | isUnboxedTupleCon dc
-	-- Similarly, convert
-	--	case .... of x { (# a #) -> ... }
-	-- to
-	--	case .... of a { DEFAULT -> ... }
-   = --trace "automagic mashing of case alts (# a #)"  $
-     doCase d s p scrut bind1 [(DEFAULT, [], rhs)] True{-unboxed tuple-}
-
-schemeE d s p (AnnCase scrut bndr _ alts)
-   = doCase d s p scrut bndr alts False{-not an unboxed tuple-}
-
-schemeE d s p (AnnNote note (_, body))
-   = schemeE d s p body
-
-schemeE d s p other
-   = pprPanic "ByteCodeGen.schemeE: unhandled case" 
-               (pprCoreExpr (deAnnotate' other))
-
-
--- Compile code to do a tail call.  Specifically, push the fn,
--- slide the on-stack app back down to the sequel depth,
--- and enter.  Four cases:
---
--- 0.  (Nasty hack).
---     An application "GHC.Prim.tagToEnum# <type> unboxed-int".
---     The int will be on the stack.  Generate a code sequence
---     to convert it to the relevant constructor, SLIDE and ENTER.
---
--- 1.  The fn denotes a ccall.  Defer to generateCCall.
---
--- 2.  (Another nasty hack).  Spot (# a::VoidArg, b #) and treat
---     it simply as  b  -- since the representations are identical
---     (the VoidArg takes up zero stack space).  Also, spot
---     (# b #) and treat it as  b.
---
--- 3.  Application of a constructor, by defn saturated.
---     Split the args into ptrs and non-ptrs, and push the nonptrs, 
---     then the ptrs, and then do PACK and RETURN.
---
--- 4.  Otherwise, it must be a function call.  Push the args
---     right to left, SLIDE and ENTER.
-
-schemeT :: Int 		-- Stack depth
-        -> Sequel 	-- Sequel depth
-        -> BCEnv 	-- stack env
-        -> AnnExpr' Id VarSet 
-        -> BcM BCInstrList
-
-schemeT d s p app
-
---   | trace ("schemeT: env in = \n" ++ showSDocDebug (ppBCEnv p)) False
---   = panic "schemeT ?!?!"
-
---   | trace ("\nschemeT\n" ++ showSDoc (pprCoreExpr (deAnnotate' app)) ++ "\n") False
---   = error "?!?!" 
-
-   -- Case 0
-   | Just (arg, constr_names) <- maybe_is_tagToEnum_call
-   = pushAtom d p arg	 		`thenBc` \ (push, arg_words) ->
-     implement_tagToId constr_names	`thenBc` \ tagToId_sequence ->
-     returnBc (push `appOL`  tagToId_sequence            
-                    `appOL`  mkSLIDE 1 (d+arg_words-s)
-                    `snocOL` ENTER)
-
-   -- Case 1
-   | Just (CCall ccall_spec) <- isFCallId_maybe fn
-   = generateCCall d s p ccall_spec fn args_r_to_l
-
-   -- Case 2: Constructor application
-   | Just con <- maybe_saturated_dcon,
-     isUnboxedTupleCon con
-   = case args_r_to_l of
-	[arg1,arg2] | isVoidArgAtom arg1 -> 
-		  unboxedTupleReturn d s p arg2
-	[arg1,arg2] | isVoidArgAtom arg2 -> 
-		  unboxedTupleReturn d s p arg1
-	_other -> unboxedTupleException
-
-   -- Case 3: Ordinary data constructor
-   | Just con <- maybe_saturated_dcon
-   = mkConAppCode d s p con args_r_to_l	`thenBc` \ alloc_con ->
-     returnBc (alloc_con	 `appOL` 
-               mkSLIDE 1 (d - s) `snocOL`
-               ENTER)
-
-   -- Case 4: Tail call of function 
-   | otherwise
-   = doTailCall d s p fn args_r_to_l
-
-   where
-      -- Detect and extract relevant info for the tagToEnum kludge.
-      maybe_is_tagToEnum_call
-         = let extract_constr_Names ty
-		 | Just (tyc, []) <- splitTyConApp_maybe (repType ty),
-		   isDataTyCon tyc
-		   = map (getName . dataConWorkId) (tyConDataCons tyc)
-		   -- NOTE: use the worker name, not the source name of
-		   -- the DataCon.  See DataCon.lhs for details.
-		 | otherwise
-		   = panic "maybe_is_tagToEnum_call.extract_constr_Ids"
-           in
-           case app of
-              (AnnApp (_, AnnApp (_, AnnVar v) (_, AnnType t)) arg)
-                 -> case isPrimOpId_maybe v of
-                       Just TagToEnumOp -> Just (snd arg, extract_constr_Names t)
-		       other		-> Nothing
-              other -> Nothing
-
-	-- Extract the args (R->L) and fn
-	-- The function will necessarily be a variable, 
-	-- because we are compiling a tail call
-      (AnnVar fn, args_r_to_l) = splitApp app
-
-      -- Only consider this to be a constructor application iff it is
-      -- saturated.  Otherwise, we'll call the constructor wrapper.
-      n_args = length args_r_to_l
-      maybe_saturated_dcon  
-	= case isDataConWorkId_maybe fn of
-		Just con | dataConRepArity con == n_args -> Just con
-		_ -> Nothing
-
--- -----------------------------------------------------------------------------
--- Generate code to build a constructor application, 
--- leaving it on top of the stack
-
-mkConAppCode :: Int -> Sequel -> BCEnv
-	     -> DataCon 		-- The data constructor
-	     -> [AnnExpr' Id VarSet] 	-- Args, in *reverse* order
-	     -> BcM BCInstrList
-
-mkConAppCode orig_d s p con []	-- Nullary constructor
-  = ASSERT( isNullaryRepDataCon con )
-    returnBc (unitOL (PUSH_G (getName (dataConWorkId con))))
-	-- Instead of doing a PACK, which would allocate a fresh
-	-- copy of this constructor, use the single shared version.
-
-mkConAppCode orig_d s p con args_r_to_l 
-  = ASSERT( dataConRepArity con == length args_r_to_l )
-    do_pushery orig_d (non_ptr_args ++ ptr_args)
- where
-	-- The args are already in reverse order, which is the way PACK
-	-- expects them to be.  We must push the non-ptrs after the ptrs.
-      (ptr_args, non_ptr_args) = partition isPtrAtom args_r_to_l
-
-      do_pushery d (arg:args)
-         = pushAtom d p arg			`thenBc` \ (push, arg_words) ->
-           do_pushery (d+arg_words) args	`thenBc` \ more_push_code ->
-           returnBc (push `appOL` more_push_code)
-      do_pushery d []
-         = returnBc (unitOL (PACK con n_arg_words))
-	 where
-	   n_arg_words = d - orig_d
-
-
--- -----------------------------------------------------------------------------
--- Returning an unboxed tuple with one non-void component (the only
--- case we can handle).
---
--- Remember, we don't want to *evaluate* the component that is being
--- returned, even if it is a pointed type.  We always just return.
-
-unboxedTupleReturn
-	:: Int -> Sequel -> BCEnv
-	-> AnnExpr' Id VarSet -> BcM BCInstrList
-unboxedTupleReturn d s p arg = do
-  (push, sz) <- pushAtom d p arg
-  returnBc (push `appOL`
-	    mkSLIDE sz (d-s) `snocOL`
-	    RETURN_UBX (atomRep arg))
-
--- -----------------------------------------------------------------------------
--- Generate code for a tail-call
-
-doTailCall
-	:: Int -> Sequel -> BCEnv
-	-> Id -> [AnnExpr' Id VarSet]
-	-> BcM BCInstrList
-doTailCall init_d s p fn args
-  = do_pushes init_d args (map atomRep args)
-  where
-  do_pushes d [] reps = do
-	ASSERT( null reps ) return ()
-        (push_fn, sz) <- pushAtom d p (AnnVar fn)
-	ASSERT( sz == 1 ) return ()
-	returnBc (push_fn `appOL` (
-		  mkSLIDE ((d-init_d) + 1) (init_d - s) `appOL`
-		  unitOL ENTER))
-  do_pushes d args reps = do
-      let (push_apply, n, rest_of_reps) = findPushSeq reps
-	  (these_args, rest_of_args) = splitAt n args
-      (next_d, push_code) <- push_seq d these_args
-      instrs <- do_pushes (next_d + 1) rest_of_args rest_of_reps 
-		--                ^^^ for the PUSH_APPLY_ instruction
-      returnBc (push_code `appOL` (push_apply `consOL` instrs))
-
-  push_seq d [] = return (d, nilOL)
-  push_seq d (arg:args) = do
-    (push_code, sz) <- pushAtom d p arg 
-    (final_d, more_push_code) <- push_seq (d+sz) args
-    return (final_d, push_code `appOL` more_push_code)
-
--- v. similar to CgStackery.findMatch, ToDo: merge
-findPushSeq (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: rest)
-  = (PUSH_APPLY_PPPPPP, 6, rest)
-findPushSeq (PtrArg: PtrArg: PtrArg: PtrArg: PtrArg: rest)
-  = (PUSH_APPLY_PPPPP, 5, rest)
-findPushSeq (PtrArg: PtrArg: PtrArg: PtrArg: rest)
-  = (PUSH_APPLY_PPPP, 4, rest)
-findPushSeq (PtrArg: PtrArg: PtrArg: rest)
-  = (PUSH_APPLY_PPP, 3, rest)
-findPushSeq (PtrArg: PtrArg: rest)
-  = (PUSH_APPLY_PP, 2, rest)
-findPushSeq (PtrArg: rest)
-  = (PUSH_APPLY_P, 1, rest)
-findPushSeq (VoidArg: rest)
-  = (PUSH_APPLY_V, 1, rest)
-findPushSeq (NonPtrArg: rest)
-  = (PUSH_APPLY_N, 1, rest)
-findPushSeq (FloatArg: rest)
-  = (PUSH_APPLY_F, 1, rest)
-findPushSeq (DoubleArg: rest)
-  = (PUSH_APPLY_D, 1, rest)
-findPushSeq (LongArg: rest)
-  = (PUSH_APPLY_L, 1, rest)
-findPushSeq _
-  = panic "ByteCodeGen.findPushSeq"
-
--- -----------------------------------------------------------------------------
--- Case expressions
-
-doCase  :: Int -> Sequel -> BCEnv
-	-> AnnExpr Id VarSet -> Id -> [AnnAlt Id VarSet]
-	-> Bool  -- True <=> is an unboxed tuple case, don't enter the result
-	-> BcM BCInstrList
-doCase d s p (_,scrut)
- bndr alts is_unboxed_tuple
-  = let
-        -- Top of stack is the return itbl, as usual.
-        -- underneath it is the pointer to the alt_code BCO.
-        -- When an alt is entered, it assumes the returned value is
-        -- on top of the itbl.
-        ret_frame_sizeW = 2
-
-	-- An unlifted value gets an extra info table pushed on top
-	-- when it is returned.
-	unlifted_itbl_sizeW | isAlgCase = 0
-	  		    | otherwise = 1
-
-	-- depth of stack after the return value has been pushed
-	d_bndr = d + ret_frame_sizeW + idSizeW bndr
-
-	-- depth of stack after the extra info table for an unboxed return
-	-- has been pushed, if any.  This is the stack depth at the
-	-- continuation.
-        d_alts = d_bndr + unlifted_itbl_sizeW
-
-        -- Env in which to compile the alts, not including
-        -- any vars bound by the alts themselves
-        p_alts = addToFM p bndr (d_bndr - 1)
-
-	bndr_ty = idType bndr
-        isAlgCase = not (isUnLiftedType bndr_ty) && not is_unboxed_tuple
-
-        -- given an alt, return a discr and code for it.
-	codeALt alt@(DEFAULT, _, (_,rhs))
-	   = schemeE d_alts s p_alts rhs	`thenBc` \ rhs_code ->
-	     returnBc (NoDiscr, rhs_code)
-        codeAlt alt@(discr, bndrs, (_,rhs))
-	   -- primitive or nullary constructor alt: no need to UNPACK
-	   | null real_bndrs = do
-		rhs_code <- schemeE d_alts s p_alts rhs
-                returnBc (my_discr alt, rhs_code)
-	   -- algebraic alt with some binders
-           | ASSERT(isAlgCase) otherwise =
-             let
-		 (ptrs,nptrs) = partition (isFollowableArg.idCgRep) real_bndrs
-		 ptr_sizes    = map idSizeW ptrs
-		 nptrs_sizes  = map idSizeW nptrs
-		 bind_sizes   = ptr_sizes ++ nptrs_sizes
-		 size         = sum ptr_sizes + sum nptrs_sizes
-		 -- the UNPACK instruction unpacks in reverse order...
-		 p' = addListToFM p_alts 
-			(zip (reverse (ptrs ++ nptrs))
-			  (mkStackOffsets d_alts (reverse bind_sizes)))
-	     in do
-	     rhs_code <- schemeE (d_alts+size) s p' rhs
-             return (my_discr alt, unitOL (UNPACK size) `appOL` rhs_code)
-	   where
-	     real_bndrs = filter (not.isTyVar) bndrs
-
-
-        my_discr (DEFAULT, binds, rhs) = NoDiscr {-shouldn't really happen-}
-        my_discr (DataAlt dc, binds, rhs) 
-           | isUnboxedTupleCon dc
-           = unboxedTupleException
-           | otherwise
-           = DiscrP (dataConTag dc - fIRST_TAG)
-        my_discr (LitAlt l, binds, rhs)
-           = case l of MachInt i     -> DiscrI (fromInteger i)
-                       MachFloat r   -> DiscrF (fromRational r)
-                       MachDouble r  -> DiscrD (fromRational r)
-                       MachChar i    -> DiscrI (ord i)
-                       _ -> pprPanic "schemeE(AnnCase).my_discr" (ppr l)
-
-        maybe_ncons 
-           | not isAlgCase = Nothing
-           | otherwise 
-           = case [dc | (DataAlt dc, _, _) <- alts] of
-                []     -> Nothing
-                (dc:_) -> Just (tyConFamilySize (dataConTyCon dc))
-
-	-- the bitmap is relative to stack depth d, i.e. before the
-	-- BCO, info table and return value are pushed on.
-	-- This bit of code is v. similar to buildLivenessMask in CgBindery,
-	-- except that here we build the bitmap from the known bindings of
-	-- things that are pointers, whereas in CgBindery the code builds the
-	-- bitmap from the free slots and unboxed bindings.
-	-- (ToDo: merge?)
-	bitmap = intsToReverseBitmap d{-size-} (sortLe (<=) rel_slots)
-	  where
-	  binds = fmToList p
-	  rel_slots = concat (map spread binds)
-	  spread (id, offset)
-		| isFollowableArg (idCgRep id) = [ rel_offset ]
-		| otherwise = []
-		where rel_offset = d - offset - 1
-
-     in do
-     alt_stuff <- mapM codeAlt alts
-     alt_final <- mkMultiBranch maybe_ncons alt_stuff
-     let 
-         alt_bco_name = getName bndr
-         alt_bco = mkProtoBCO alt_bco_name alt_final (Left alts)
-			0{-no arity-} d{-bitmap size-} bitmap True{-is alts-}
-     -- in
---     trace ("case: bndr = " ++ showSDocDebug (ppr bndr) ++ "\ndepth = " ++ show d ++ "\nenv = \n" ++ showSDocDebug (ppBCEnv p) ++
---	     "\n      bitmap = " ++ show bitmap) $ do
-     scrut_code <- schemeE (d + ret_frame_sizeW) (d + ret_frame_sizeW) p scrut
-     alt_bco' <- emitBc alt_bco
-     let push_alts
-	    | isAlgCase = PUSH_ALTS alt_bco'
-	    | otherwise = PUSH_ALTS_UNLIFTED alt_bco' (typeCgRep bndr_ty)
-     returnBc (push_alts `consOL` scrut_code)
-
-
--- -----------------------------------------------------------------------------
--- Deal with a CCall.
-
--- Taggedly push the args onto the stack R->L,
--- deferencing ForeignObj#s and adjusting addrs to point to
--- payloads in Ptr/Byte arrays.  Then, generate the marshalling
--- (machine) code for the ccall, and create bytecodes to call that and
--- then return in the right way.  
-
-generateCCall :: Int -> Sequel 		-- stack and sequel depths
-              -> BCEnv
-              -> CCallSpec		-- where to call
-              -> Id 			-- of target, for type info
-              -> [AnnExpr' Id VarSet]	-- args (atoms)
-              -> BcM BCInstrList
-
-generateCCall d0 s p ccall_spec@(CCallSpec target cconv safety) fn args_r_to_l
-   = let 
-         -- useful constants
-         addr_sizeW = cgRepSizeW NonPtrArg
-
-         -- Get the args on the stack, with tags and suitably
-         -- dereferenced for the CCall.  For each arg, return the
-         -- depth to the first word of the bits for that arg, and the
-         -- CgRep of what was actually pushed.
-
-         pargs d [] = returnBc []
-         pargs d (a:az) 
-            = let arg_ty = repType (exprType (deAnnotate' a))
-
-              in case splitTyConApp_maybe arg_ty of
-                    -- Don't push the FO; instead push the Addr# it
-                    -- contains.
-		    Just (t, _)
-		     | t == arrayPrimTyCon || t == mutableArrayPrimTyCon
-                       -> pargs (d + addr_sizeW) az	`thenBc` \ rest ->
-                          parg_ArrayishRep arrPtrsHdrSize d p a
-							`thenBc` \ code ->
-                          returnBc ((code,NonPtrArg):rest)
-
-		     | t == byteArrayPrimTyCon || t == mutableByteArrayPrimTyCon
-                       -> pargs (d + addr_sizeW) az	`thenBc` \ rest ->
-                          parg_ArrayishRep arrWordsHdrSize d p a
-							`thenBc` \ code ->
-                          returnBc ((code,NonPtrArg):rest)
-
-                    -- Default case: push taggedly, but otherwise intact.
-                    other
-                       -> pushAtom d p a		`thenBc` \ (code_a, sz_a) ->
-                          pargs (d+sz_a) az		`thenBc` \ rest ->
-                          returnBc ((code_a, atomRep a) : rest)
-
-         -- Do magic for Ptr/Byte arrays.  Push a ptr to the array on
-         -- the stack but then advance it over the headers, so as to
-         -- point to the payload.
-         parg_ArrayishRep hdrSize d p a
-            = pushAtom d p a `thenBc` \ (push_fo, _) ->
-              -- The ptr points at the header.  Advance it over the
-              -- header and then pretend this is an Addr#.
-              returnBc (push_fo `snocOL` SWIZZLE 0 hdrSize)
-
-     in
-         pargs d0 args_r_to_l			`thenBc` \ code_n_reps ->
-     let
-         (pushs_arg, a_reps_pushed_r_to_l) = unzip code_n_reps
-
-         push_args    = concatOL pushs_arg
-         d_after_args = d0 + sum (map cgRepSizeW a_reps_pushed_r_to_l)
-         a_reps_pushed_RAW
-            | null a_reps_pushed_r_to_l || head a_reps_pushed_r_to_l /= VoidArg
-            = panic "ByteCodeGen.generateCCall: missing or invalid World token?"
-            | otherwise
-            = reverse (tail a_reps_pushed_r_to_l)
-
-         -- Now: a_reps_pushed_RAW are the reps which are actually on the stack.
-         -- push_args is the code to do that.
-         -- d_after_args is the stack depth once the args are on.
-
-         -- Get the result rep.
-         (returns_void, r_rep)
-            = case maybe_getCCallReturnRep (idType fn) of
-                 Nothing -> (True,  VoidArg)
-                 Just rr -> (False, rr) 
-         {-
-         Because the Haskell stack grows down, the a_reps refer to 
-         lowest to highest addresses in that order.  The args for the call
-         are on the stack.  Now push an unboxed Addr# indicating
-         the C function to call.  Then push a dummy placeholder for the 
-         result.  Finally, emit a CCALL insn with an offset pointing to the 
-         Addr# just pushed, and a literal field holding the mallocville
-         address of the piece of marshalling code we generate.
-         So, just prior to the CCALL insn, the stack looks like this 
-         (growing down, as usual):
-                 
-            <arg_n>
-            ...
-            <arg_1>
-            Addr# address_of_C_fn
-            <placeholder-for-result#> (must be an unboxed type)
-
-         The interpreter then calls the marshall code mentioned
-         in the CCALL insn, passing it (& <placeholder-for-result#>), 
-         that is, the addr of the topmost word in the stack.
-         When this returns, the placeholder will have been
-         filled in.  The placeholder is slid down to the sequel
-         depth, and we RETURN.
-
-         This arrangement makes it simple to do f-i-dynamic since the Addr#
-         value is the first arg anyway.
-
-         The marshalling code is generated specifically for this
-         call site, and so knows exactly the (Haskell) stack
-         offsets of the args, fn address and placeholder.  It
-         copies the args to the C stack, calls the stacked addr,
-         and parks the result back in the placeholder.  The interpreter
-         calls it as a normal C call, assuming it has a signature
-            void marshall_code ( StgWord* ptr_to_top_of_stack )
-         -}
-         -- resolve static address
-         get_target_info
-            = case target of
-                 DynamicTarget
-                    -> returnBc (False, panic "ByteCodeGen.generateCCall(dyn)")
-                 StaticTarget target
-                    -> ioToBc (lookupStaticPtr target) `thenBc` \res ->
-                       returnBc (True, res)
-     in
-         get_target_info	`thenBc` \ (is_static, static_target_addr) ->
-     let
-
-         -- Get the arg reps, zapping the leading Addr# in the dynamic case
-         a_reps --  | trace (showSDoc (ppr a_reps_pushed_RAW)) False = error "???"
-                | is_static = a_reps_pushed_RAW
-                | otherwise = if null a_reps_pushed_RAW 
-                              then panic "ByteCodeGen.generateCCall: dyn with no args"
-                              else tail a_reps_pushed_RAW
-
-         -- push the Addr#
-         (push_Addr, d_after_Addr)
-            | is_static
-            = (toOL [PUSH_UBX (Right static_target_addr) addr_sizeW],
-               d_after_args + addr_sizeW)
-            | otherwise	-- is already on the stack
-            = (nilOL, d_after_args)
-
-         -- Push the return placeholder.  For a call returning nothing,
-         -- this is a VoidArg (tag).
-         r_sizeW   = cgRepSizeW r_rep
-         d_after_r = d_after_Addr + r_sizeW
-         r_lit     = mkDummyLiteral r_rep
-         push_r    = (if   returns_void 
-                      then nilOL 
-                      else unitOL (PUSH_UBX (Left r_lit) r_sizeW))
-
-         -- generate the marshalling code we're going to call
-         r_offW       = 0 
-         addr_offW    = r_sizeW
-         arg1_offW    = r_sizeW + addr_sizeW
-         args_offW    = map (arg1_offW +) 
-                            (init (scanl (+) 0 (map cgRepSizeW a_reps)))
-     in
-         ioToBc (mkMarshalCode cconv
-                    (r_offW, r_rep) addr_offW
-                    (zip args_offW a_reps))	`thenBc` \ addr_of_marshaller ->
-         recordMallocBc addr_of_marshaller	`thenBc_`
-     let
-	 -- Offset of the next stack frame down the stack.  The CCALL
- 	 -- instruction needs to describe the chunk of stack containing
-	 -- the ccall args to the GC, so it needs to know how large it
-	 -- is.  See comment in Interpreter.c with the CCALL instruction.
-	 stk_offset   = d_after_r - s
-
-         -- do the call
-         do_call      = unitOL (CCALL stk_offset (castPtr addr_of_marshaller))
-         -- slide and return
-         wrapup       = mkSLIDE r_sizeW (d_after_r - r_sizeW - s)
-                        `snocOL` RETURN_UBX r_rep
-     in
-         --trace (show (arg1_offW, args_offW  ,  (map cgRepSizeW a_reps) )) $
-         returnBc (
-         push_args `appOL`
-         push_Addr `appOL` push_r `appOL` do_call `appOL` wrapup
-         )
-
-
--- Make a dummy literal, to be used as a placeholder for FFI return
--- values on the stack.
-mkDummyLiteral :: CgRep -> Literal
-mkDummyLiteral pr
-   = case pr of
-        NonPtrArg -> MachWord 0
-        DoubleArg -> MachDouble 0
-        FloatArg  -> MachFloat 0
-        _         -> moan64 "mkDummyLiteral" (ppr pr)
-
-
--- Convert (eg) 
---     GHC.Prim.Char# -> GHC.Prim.State# GHC.Prim.RealWorld
---                   -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #)
---
--- to  Just IntRep
--- and check that an unboxed pair is returned wherein the first arg is VoidArg'd.
---
--- Alternatively, for call-targets returning nothing, convert
---
---     GHC.Prim.Char# -> GHC.Prim.State# GHC.Prim.RealWorld
---                   -> (# GHC.Prim.State# GHC.Prim.RealWorld #)
---
--- to  Nothing
-
-maybe_getCCallReturnRep :: Type -> Maybe CgRep
-maybe_getCCallReturnRep fn_ty
-   = let (a_tys, r_ty) = splitFunTys (dropForAlls fn_ty)
-         maybe_r_rep_to_go  
-            = if isSingleton r_reps then Nothing else Just (r_reps !! 1)
-         (r_tycon, r_reps) 
-            = case splitTyConApp_maybe (repType r_ty) of
-                      (Just (tyc, tys)) -> (tyc, map typeCgRep tys)
-                      Nothing -> blargh
-         ok = ( ( r_reps `lengthIs` 2 && VoidArg == head r_reps)
-                || r_reps == [VoidArg] )
-              && isUnboxedTupleTyCon r_tycon
-              && case maybe_r_rep_to_go of
-                    Nothing    -> True
-                    Just r_rep -> r_rep /= PtrArg
-                                  -- if it was, it would be impossible 
-                                  -- to create a valid return value 
-                                  -- placeholder on the stack
-         blargh = pprPanic "maybe_getCCallReturn: can't handle:" 
-                           (pprType fn_ty)
-     in 
-     --trace (showSDoc (ppr (a_reps, r_reps))) $
-     if ok then maybe_r_rep_to_go else blargh
-
--- Compile code which expects an unboxed Int on the top of stack,
--- (call it i), and pushes the i'th closure in the supplied list 
--- as a consequence.
-implement_tagToId :: [Name] -> BcM BCInstrList
-implement_tagToId names
-   = ASSERT( notNull names )
-     getLabelsBc (length names)			`thenBc` \ labels ->
-     getLabelBc					`thenBc` \ label_fail ->
-     getLabelBc 				`thenBc` \ label_exit ->
-     zip4 labels (tail labels ++ [label_fail])
-                 [0 ..] names			`bind`   \ infos ->
-     map (mkStep label_exit) infos		`bind`   \ steps ->
-     returnBc (concatOL steps
-               `appOL` 
-               toOL [LABEL label_fail, CASEFAIL, LABEL label_exit])
-     where
-        mkStep l_exit (my_label, next_label, n, name_for_n)
-           = toOL [LABEL my_label, 
-                   TESTEQ_I n next_label, 
-                   PUSH_G name_for_n, 
-                   JMP l_exit]
-
-
--- -----------------------------------------------------------------------------
--- pushAtom
-
--- Push an atom onto the stack, returning suitable code & number of
--- stack words used.
---
--- The env p must map each variable to the highest- numbered stack
--- slot for it.  For example, if the stack has depth 4 and we
--- tagged-ly push (v :: Int#) on it, the value will be in stack[4],
--- the tag in stack[5], the stack will have depth 6, and p must map v
--- to 5 and not to 4.  Stack locations are numbered from zero, so a
--- depth 6 stack has valid words 0 .. 5.
-
-pushAtom :: Int -> BCEnv -> AnnExpr' Id VarSet -> BcM (BCInstrList, Int)
-
-pushAtom d p (AnnApp f (_, AnnType _))
-   = pushAtom d p (snd f)
-
-pushAtom d p (AnnNote note e)
-   = pushAtom d p (snd e)
-
-pushAtom d p (AnnLam x e) 
-   | isTyVar x 
-   = pushAtom d p (snd e)
-
-pushAtom d p (AnnVar v)
-
-   | idCgRep v == VoidArg
-   = returnBc (nilOL, 0)
-
-   | isFCallId v
-   = pprPanic "pushAtom: shouldn't get an FCallId here" (ppr v)
-
-   | Just primop <- isPrimOpId_maybe v
-   = returnBc (unitOL (PUSH_PRIMOP primop), 1)
-
-   | Just d_v <- lookupBCEnv_maybe p v  -- v is a local variable
-   = returnBc (toOL (nOfThem sz (PUSH_L (d-d_v+sz-2))), sz)
-	 -- d - d_v 		    the number of words between the TOS 
-	 --			    and the 1st slot of the object
-	 --
-	 -- d - d_v - 1 	    the offset from the TOS of the 1st slot
-	 --
-	 -- d - d_v - 1 + sz - 1    the offset from the TOS of the last slot
-	 --			    of the object.
-	 --
-	 -- Having found the last slot, we proceed to copy the right number of
-	 -- slots on to the top of the stack.
-
-    | otherwise  -- v must be a global variable
-    = ASSERT(sz == 1) 
-      returnBc (unitOL (PUSH_G (getName v)), sz)
-
-    where
-         sz = idSizeW v
-
-
-pushAtom d p (AnnLit lit)
-   = case lit of
-        MachLabel fs _ -> code NonPtrArg
-        MachWord w     -> code NonPtrArg
-        MachInt i      -> code PtrArg
-        MachFloat r    -> code FloatArg
-        MachDouble r   -> code DoubleArg
-        MachChar c     -> code NonPtrArg
-        MachStr s      -> pushStr s
-     where
-        code rep
-           = let size_host_words = cgRepSizeW rep
-             in  returnBc (unitOL (PUSH_UBX (Left lit) size_host_words), 
-                           size_host_words)
-
-        pushStr s 
-           = let getMallocvilleAddr
-                    = case s of
-                         FastString _ n _ fp _ -> 
-			    -- we could grab the Ptr from the ForeignPtr,
-			    -- but then we have no way to control its lifetime.
-			    -- In reality it'll probably stay alive long enoungh
-			    -- by virtue of the global FastString table, but
-			    -- to be on the safe side we copy the string into
-			    -- a malloc'd area of memory.
-                                ioToBc (mallocBytes (n+1)) `thenBc` \ ptr ->
-                                recordMallocBc ptr         `thenBc_`
-                                ioToBc (
-                                   withForeignPtr fp $ \p -> do
-				      memcpy ptr p (fromIntegral n)
-				      pokeByteOff ptr n (fromIntegral (ord '\0') :: Word8)
-                                      return ptr
-                                   )
-                         other -> panic "ByteCodeGen.pushAtom.pushStr"
-             in
-                getMallocvilleAddr `thenBc` \ addr ->
-                -- Get the addr on the stack, untaggedly
-                   returnBc (unitOL (PUSH_UBX (Right addr) 1), 1)
-
-pushAtom d p other
-   = pprPanic "ByteCodeGen.pushAtom" 
-              (pprCoreExpr (deAnnotate (undefined, other)))
-
-foreign import ccall unsafe "memcpy"
- memcpy :: Ptr a -> Ptr b -> CInt -> IO ()
-
-
--- -----------------------------------------------------------------------------
--- Given a bunch of alts code and their discrs, do the donkey work
--- of making a multiway branch using a switch tree.
--- What a load of hassle!
-
-mkMultiBranch :: Maybe Int	--  # datacons in tycon, if alg alt
-				-- a hint; generates better code
-				-- Nothing is always safe
-              -> [(Discr, BCInstrList)] 
-              -> BcM BCInstrList
-mkMultiBranch maybe_ncons raw_ways
-   = let d_way     = filter (isNoDiscr.fst) raw_ways
-         notd_ways = sortLe 
-                        (\w1 w2 -> leAlt (fst w1) (fst w2))
-                        (filter (not.isNoDiscr.fst) raw_ways)
-
-         mkTree :: [(Discr, BCInstrList)] -> Discr -> Discr -> BcM BCInstrList
-         mkTree [] range_lo range_hi = returnBc the_default
-
-         mkTree [val] range_lo range_hi
-            | range_lo `eqAlt` range_hi 
-            = returnBc (snd val)
-            | otherwise
-            = getLabelBc 				`thenBc` \ label_neq ->
-              returnBc (mkTestEQ (fst val) label_neq 
-			`consOL` (snd val
-			`appOL`   unitOL (LABEL label_neq)
-			`appOL`   the_default))
-
-         mkTree vals range_lo range_hi
-            = let n = length vals `div` 2
-                  vals_lo = take n vals
-                  vals_hi = drop n vals
-                  v_mid = fst (head vals_hi)
-              in
-              getLabelBc 				`thenBc` \ label_geq ->
-              mkTree vals_lo range_lo (dec v_mid) 	`thenBc` \ code_lo ->
-              mkTree vals_hi v_mid range_hi 		`thenBc` \ code_hi ->
-              returnBc (mkTestLT v_mid label_geq
-                        `consOL` (code_lo
-			`appOL`   unitOL (LABEL label_geq)
-			`appOL`   code_hi))
- 
-         the_default 
-            = case d_way of [] -> unitOL CASEFAIL
-                            [(_, def)] -> def
-
-         -- None of these will be needed if there are no non-default alts
-         (mkTestLT, mkTestEQ, init_lo, init_hi)
-            | null notd_ways
-            = panic "mkMultiBranch: awesome foursome"
-            | otherwise
-            = case fst (head notd_ways) of {
-              DiscrI _ -> ( \(DiscrI i) fail_label -> TESTLT_I i fail_label,
-                            \(DiscrI i) fail_label -> TESTEQ_I i fail_label,
-                            DiscrI minBound,
-                            DiscrI maxBound );
-              DiscrF _ -> ( \(DiscrF f) fail_label -> TESTLT_F f fail_label,
-                            \(DiscrF f) fail_label -> TESTEQ_F f fail_label,
-                            DiscrF minF,
-                            DiscrF maxF );
-              DiscrD _ -> ( \(DiscrD d) fail_label -> TESTLT_D d fail_label,
-                            \(DiscrD d) fail_label -> TESTEQ_D d fail_label,
-                            DiscrD minD,
-                            DiscrD maxD );
-              DiscrP _ -> ( \(DiscrP i) fail_label -> TESTLT_P i fail_label,
-                            \(DiscrP i) fail_label -> TESTEQ_P i fail_label,
-                            DiscrP algMinBound,
-                            DiscrP algMaxBound )
-              }
-
-         (algMinBound, algMaxBound)
-            = case maybe_ncons of
-                 Just n  -> (0, n - 1)
-                 Nothing -> (minBound, maxBound)
-
-         (DiscrI i1) `eqAlt` (DiscrI i2) = i1 == i2
-         (DiscrF f1) `eqAlt` (DiscrF f2) = f1 == f2
-         (DiscrD d1) `eqAlt` (DiscrD d2) = d1 == d2
-         (DiscrP i1) `eqAlt` (DiscrP i2) = i1 == i2
-         NoDiscr     `eqAlt` NoDiscr     = True
-         _           `eqAlt` _           = False
-
-         (DiscrI i1) `leAlt` (DiscrI i2) = i1 <= i2
-         (DiscrF f1) `leAlt` (DiscrF f2) = f1 <= f2
-         (DiscrD d1) `leAlt` (DiscrD d2) = d1 <= d2
-         (DiscrP i1) `leAlt` (DiscrP i2) = i1 <= i2
-         NoDiscr     `leAlt` NoDiscr     = True
-         _           `leAlt` _           = False
-
-         isNoDiscr NoDiscr = True
-         isNoDiscr _       = False
-
-         dec (DiscrI i) = DiscrI (i-1)
-         dec (DiscrP i) = DiscrP (i-1)
-         dec other      = other		-- not really right, but if you
-		-- do cases on floating values, you'll get what you deserve
-
-         -- same snotty comment applies to the following
-         minF, maxF :: Float
-         minD, maxD :: Double
-         minF = -1.0e37
-         maxF =  1.0e37
-         minD = -1.0e308
-         maxD =  1.0e308
-     in
-         mkTree notd_ways init_lo init_hi
-
-
--- -----------------------------------------------------------------------------
--- Supporting junk for the compilation schemes
-
--- Describes case alts
-data Discr 
-   = DiscrI Int
-   | DiscrF Float
-   | DiscrD Double
-   | DiscrP Int
-   | NoDiscr
-
-instance Outputable Discr where
-   ppr (DiscrI i) = int i
-   ppr (DiscrF f) = text (show f)
-   ppr (DiscrD d) = text (show d)
-   ppr (DiscrP i) = int i
-   ppr NoDiscr    = text "DEF"
-
-
-lookupBCEnv_maybe :: BCEnv -> Id -> Maybe Int
-lookupBCEnv_maybe = lookupFM
-
-idSizeW :: Id -> Int
-idSizeW id = cgRepSizeW (typeCgRep (idType id))
-
-unboxedTupleException :: a
-unboxedTupleException 
-   = throwDyn 
-        (Panic 
-           ("Bytecode generator can't handle unboxed tuples.  Possibly due\n" ++
-            "\tto foreign import/export decls in source.  Workaround:\n" ++
-            "\tcompile this module to a .o file, then restart session."))
-
-
-mkSLIDE n d = if d == 0 then nilOL else unitOL (SLIDE n d)
-bind x f    = f x
-
-splitApp :: AnnExpr' id ann -> (AnnExpr' id ann, [AnnExpr' id ann])
-	-- The arguments are returned in *right-to-left* order
-splitApp (AnnApp (_,f) (_,a))
-	       | isTypeAtom a = splitApp f
-	       | otherwise    = case splitApp f of 
-				     (f', as) -> (f', a:as)
-splitApp (AnnNote n (_,e))    = splitApp e
-splitApp e		      = (e, [])
-
-
-isTypeAtom :: AnnExpr' id ann -> Bool
-isTypeAtom (AnnType _) = True
-isTypeAtom _           = False
-
-isVoidArgAtom :: AnnExpr' id ann -> Bool
-isVoidArgAtom (AnnVar v)        = typeCgRep (idType v) == VoidArg
-isVoidArgAtom (AnnNote n (_,e)) = isVoidArgAtom e
-isVoidArgAtom _ 	        = False
-
-atomRep :: AnnExpr' Id ann -> CgRep
-atomRep (AnnVar v)    = typeCgRep (idType v)
-atomRep (AnnLit l)    = typeCgRep (literalType l)
-atomRep (AnnNote n b) = atomRep (snd b)
-atomRep (AnnApp f (_, AnnType _)) = atomRep (snd f)
-atomRep (AnnLam x e) | isTyVar x = atomRep (snd e)
-atomRep other = pprPanic "atomRep" (ppr (deAnnotate (undefined,other)))
-
-isPtrAtom :: AnnExpr' Id ann -> Bool
-isPtrAtom e = atomRep e == PtrArg
-
--- Let szsw be the sizes in words of some items pushed onto the stack,
--- which has initial depth d'.  Return the values which the stack environment
--- should map these items to.
-mkStackOffsets :: Int -> [Int] -> [Int]
-mkStackOffsets original_depth szsw
-   = map (subtract 1) (tail (scanl (+) original_depth szsw))
-
--- -----------------------------------------------------------------------------
--- The bytecode generator's monad
-
-data BcM_State 
-   = BcM_State { 
-	nextlabel :: Int,		-- for generating local labels
-	malloced  :: [Ptr ()] }		-- ptrs malloced for current BCO
-					-- Should be free()d when it is GCd
-
-newtype BcM r = BcM (BcM_State -> IO (BcM_State, r))
-
-ioToBc :: IO a -> BcM a
-ioToBc io = BcM $ \st -> do 
-  x <- io 
-  return (st, x)
-
-runBc :: BcM r -> IO (BcM_State, r)
-runBc (BcM m) = m (BcM_State 0 []) 
-
-thenBc :: BcM a -> (a -> BcM b) -> BcM b
-thenBc (BcM expr) cont = BcM $ \st0 -> do
-  (st1, q) <- expr st0
-  let BcM k = cont q 
-  (st2, r) <- k st1
-  return (st2, r)
-
-thenBc_ :: BcM a -> BcM b -> BcM b
-thenBc_ (BcM expr) (BcM cont) = BcM $ \st0 -> do
-  (st1, q) <- expr st0
-  (st2, r) <- cont st1
-  return (st2, r)
-
-returnBc :: a -> BcM a
-returnBc result = BcM $ \st -> (return (st, result))
-
-instance Monad BcM where
-  (>>=) = thenBc
-  (>>)  = thenBc_
-  return = returnBc
-
-emitBc :: ([Ptr ()] -> ProtoBCO Name) -> BcM (ProtoBCO Name)
-emitBc bco
-  = BcM $ \st -> return (st{malloced=[]}, bco (malloced st))
-
-recordMallocBc :: Ptr a -> BcM ()
-recordMallocBc a
-  = BcM $ \st -> return (st{malloced = castPtr a : malloced st}, ())
-
-getLabelBc :: BcM Int
-getLabelBc
-  = BcM $ \st -> return (st{nextlabel = 1 + nextlabel st}, nextlabel st)
-
-getLabelsBc :: Int -> BcM [Int]
-getLabelsBc n
-  = BcM $ \st -> let ctr = nextlabel st 
-		 in return (st{nextlabel = ctr+n}, [ctr .. ctr+n-1])
-\end{code}
diff --git a/ghc/compiler/ghci/ByteCodeInstr.lhs b/ghc/compiler/ghci/ByteCodeInstr.lhs
deleted file mode 100644
index 7bd4408fff..0000000000
--- a/ghc/compiler/ghci/ByteCodeInstr.lhs
+++ /dev/null
@@ -1,256 +0,0 @@
-%
-% (c) The University of Glasgow 2000
-%
-\section[ByteCodeInstrs]{Bytecode instruction definitions}
-
-\begin{code}
-module ByteCodeInstr ( 
- 	BCInstr(..), ProtoBCO(..), bciStackUse
-  ) where
-
-#include "HsVersions.h"
-#include "../includes/MachDeps.h"
-
-import Outputable
-import Name		( Name )
-import Id		( Id )
-import CoreSyn
-import PprCore		( pprCoreExpr, pprCoreAlt )
-import Literal		( Literal )
-import DataCon		( DataCon )
-import VarSet		( VarSet )
-import PrimOp		( PrimOp )
-import SMRep		( StgWord, CgRep )
-import GHC.Ptr
-
--- ----------------------------------------------------------------------------
--- Bytecode instructions
-
-data ProtoBCO a 
-   = ProtoBCO { 
-	protoBCOName       :: a,	  -- name, in some sense
-	protoBCOInstrs     :: [BCInstr],  -- instrs
-	-- arity and GC info
-	protoBCOBitmap     :: [StgWord],
-	protoBCOBitmapSize :: Int,
-	protoBCOArity	   :: Int,
-	-- what the BCO came from
-	protoBCOExpr       :: Either  [AnnAlt Id VarSet] (AnnExpr Id VarSet),
-	-- malloc'd pointers
-        protoBCOPtrs       :: [Ptr ()]
-   }
-
-type LocalLabel = Int
-
-data BCInstr
-   -- Messing with the stack
-   = STKCHECK  Int
-
-   -- Push locals (existing bits of the stack)
-   | PUSH_L    Int{-offset-}
-   | PUSH_LL   Int Int{-2 offsets-}
-   | PUSH_LLL  Int Int Int{-3 offsets-}
-
-   -- Push a ptr  (these all map to PUSH_G really)
-   | PUSH_G       Name
-   | PUSH_PRIMOP  PrimOp
-   | PUSH_BCO     (ProtoBCO Name)
-
-   -- Push an alt continuation
-   | PUSH_ALTS          (ProtoBCO Name)
-   | PUSH_ALTS_UNLIFTED (ProtoBCO Name) CgRep
-
-   -- Pushing literals
-   | PUSH_UBX  (Either Literal (Ptr ())) Int
-	-- push this int/float/double/addr, on the stack.  Int
-	-- is # of words to copy from literal pool.  Eitherness reflects
-	-- the difficulty of dealing with MachAddr here, mostly due to
-	-- the excessive (and unnecessary) restrictions imposed by the
-	-- designers of the new Foreign library.  In particular it is
-	-- quite impossible to convert an Addr to any other integral
-	-- type, and it appears impossible to get hold of the bits of
-	-- an addr, even though we need to to assemble BCOs.
-
-   -- various kinds of application
-   | PUSH_APPLY_N
-   | PUSH_APPLY_V
-   | PUSH_APPLY_F
-   | PUSH_APPLY_D
-   | PUSH_APPLY_L
-   | PUSH_APPLY_P
-   | PUSH_APPLY_PP
-   | PUSH_APPLY_PPP
-   | PUSH_APPLY_PPPP
-   | PUSH_APPLY_PPPPP
-   | PUSH_APPLY_PPPPPP
-
-   | SLIDE     Int{-this many-} Int{-down by this much-}
-
-   -- To do with the heap
-   | ALLOC_AP  Int	-- make an AP with this many payload words
-   | ALLOC_PAP Int Int	-- make a PAP with this arity / payload words
-   | MKAP      Int{-ptr to AP is this far down stack-} Int{-# words-}
-   | MKPAP     Int{-ptr to PAP is this far down stack-} Int{-# words-}
-   | UNPACK    Int	-- unpack N words from t.o.s Constr
-   | PACK      DataCon Int
-			-- after assembly, the DataCon is an index into the
-			-- itbl array
-   -- For doing case trees
-   | LABEL     LocalLabel
-   | TESTLT_I  Int    LocalLabel
-   | TESTEQ_I  Int    LocalLabel
-   | TESTLT_F  Float  LocalLabel
-   | TESTEQ_F  Float  LocalLabel
-   | TESTLT_D  Double LocalLabel
-   | TESTEQ_D  Double LocalLabel
-
-   -- The Int value is a constructor number and therefore
-   -- stored in the insn stream rather than as an offset into
-   -- the literal pool.
-   | TESTLT_P  Int    LocalLabel
-   | TESTEQ_P  Int    LocalLabel
-
-   | CASEFAIL
-   | JMP              LocalLabel
-
-   -- For doing calls to C (via glue code generated by ByteCodeFFI)
-   | CCALL            Int 	-- stack frame size
-		      (Ptr ())  -- addr of the glue code
-
-   -- For doing magic ByteArray passing to foreign calls
-   | SWIZZLE          Int	-- to the ptr N words down the stack,
-		      Int	-- add M (interpreted as a signed 16-bit entity)
-
-   -- To Infinity And Beyond
-   | ENTER
-   | RETURN		-- return a lifted value
-   | RETURN_UBX CgRep -- return an unlifted value, here's its rep
-
--- -----------------------------------------------------------------------------
--- Printing bytecode instructions
-
-instance Outputable a => Outputable (ProtoBCO a) where
-   ppr (ProtoBCO name instrs bitmap bsize arity origin malloced)
-      = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity 
-		<+> text (show malloced) <> colon)
-	$$ nest 6 (text "bitmap: " <+> text (show bsize) <+> text (show bitmap))
-        $$ nest 6 (vcat (map ppr instrs))
-        $$ case origin of
-              Left alts -> vcat (map (pprCoreAlt.deAnnAlt) alts)
-              Right rhs -> pprCoreExpr (deAnnotate rhs)
-
-instance Outputable BCInstr where
-   ppr (STKCHECK n)          = text "STKCHECK" <+> int n
-   ppr (PUSH_L offset)       = text "PUSH_L  " <+> int offset
-   ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> int o1 <+> int o2
-   ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> int o1 <+> int o2 <+> int o3
-   ppr (PUSH_G nm)  	     = text "PUSH_G  " <+> ppr nm
-   ppr (PUSH_PRIMOP op)      = text "PUSH_G  " <+> text "GHC.PrimopWrappers." 
-                                               <> ppr op
-   ppr (PUSH_BCO bco)        = text "PUSH_BCO" <+> nest 3 (ppr bco)
-   ppr (PUSH_ALTS bco)       = text "PUSH_ALTS " <+> ppr bco
-   ppr (PUSH_ALTS_UNLIFTED bco pk) = text "PUSH_ALTS_UNLIFTED " <+> ppr pk <+> ppr bco
-
-   ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (int nw) <+> ppr lit
-   ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (int nw) <+> text (show aa)
-   ppr PUSH_APPLY_N		= text "PUSH_APPLY_N"
-   ppr PUSH_APPLY_V		= text "PUSH_APPLY_V"
-   ppr PUSH_APPLY_F		= text "PUSH_APPLY_F"
-   ppr PUSH_APPLY_D		= text "PUSH_APPLY_D"
-   ppr PUSH_APPLY_L		= text "PUSH_APPLY_L"
-   ppr PUSH_APPLY_P		= text "PUSH_APPLY_P"
-   ppr PUSH_APPLY_PP		= text "PUSH_APPLY_PP"
-   ppr PUSH_APPLY_PPP		= text "PUSH_APPLY_PPP"
-   ppr PUSH_APPLY_PPPP		= text "PUSH_APPLY_PPPP"
-   ppr PUSH_APPLY_PPPPP		= text "PUSH_APPLY_PPPPP"
-   ppr PUSH_APPLY_PPPPPP	= text "PUSH_APPLY_PPPPPP"
-
-   ppr (SLIDE n d)           = text "SLIDE   " <+> int n <+> int d
-   ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> int sz
-   ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> int arity <+> int sz
-   ppr (MKAP offset sz)      = text "MKAP    " <+> int sz <+> text "words," 
-                                               <+> int offset <+> text "stkoff"
-   ppr (UNPACK sz)           = text "UNPACK  " <+> int sz
-   ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
-   ppr (LABEL     lab)       = text "__"       <> int lab <> colon
-   ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> int lab
-   ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> int lab
-   ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> int lab
-   ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> int lab
-   ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> int lab
-   ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> int lab
-   ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> int i <+> text "__" <> int lab
-   ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> int i <+> text "__" <> int lab
-   ppr (JMP lab)             = text "JMP"      <+> int lab
-   ppr CASEFAIL              = text "CASEFAIL"
-   ppr ENTER                 = text "ENTER"
-   ppr RETURN		     = text "RETURN"
-   ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
-   ppr (CCALL off marshall_addr) = text "CCALL   " <+> int off 
-						<+> text "marshall code at" 
-                                               <+> text (show marshall_addr)
-   ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> int stkoff 
-                                               <+> text "by" <+> int n 
-
--- -----------------------------------------------------------------------------
--- The stack use, in words, of each bytecode insn.  These _must_ be
--- correct, or overestimates of reality, to be safe.
-
--- NOTE: we aggregate the stack use from case alternatives too, so that
--- we can do a single stack check at the beginning of a function only.
-
--- This could all be made more accurate by keeping track of a proper
--- stack high water mark, but it doesn't seem worth the hassle.
-
-protoBCOStackUse :: ProtoBCO a -> Int
-protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
-
-bciStackUse :: BCInstr -> Int
-bciStackUse STKCHECK{}            = 0
-bciStackUse PUSH_L{}       	  = 1
-bciStackUse PUSH_LL{}       	  = 2
-bciStackUse PUSH_LLL{}            = 3
-bciStackUse PUSH_G{} 		  = 1
-bciStackUse PUSH_PRIMOP{}         = 1
-bciStackUse PUSH_BCO{}    	  = 1
-bciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco
-bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
-bciStackUse (PUSH_UBX _ nw)       = nw
-bciStackUse PUSH_APPLY_N{}	  = 1
-bciStackUse PUSH_APPLY_V{}	  = 1
-bciStackUse PUSH_APPLY_F{}	  = 1
-bciStackUse PUSH_APPLY_D{}	  = 1
-bciStackUse PUSH_APPLY_L{}	  = 1
-bciStackUse PUSH_APPLY_P{}	  = 1
-bciStackUse PUSH_APPLY_PP{}	  = 1
-bciStackUse PUSH_APPLY_PPP{}	  = 1
-bciStackUse PUSH_APPLY_PPPP{}	  = 1
-bciStackUse PUSH_APPLY_PPPPP{}	  = 1
-bciStackUse PUSH_APPLY_PPPPPP{}	  = 1
-bciStackUse ALLOC_AP{}            = 1
-bciStackUse ALLOC_PAP{}           = 1
-bciStackUse (UNPACK sz)           = sz
-bciStackUse LABEL{}       	  = 0
-bciStackUse TESTLT_I{}     	  = 0
-bciStackUse TESTEQ_I{}     	  = 0
-bciStackUse TESTLT_F{}     	  = 0
-bciStackUse TESTEQ_F{}     	  = 0
-bciStackUse TESTLT_D{}     	  = 0
-bciStackUse TESTEQ_D{}     	  = 0
-bciStackUse TESTLT_P{}     	  = 0
-bciStackUse TESTEQ_P{}     	  = 0
-bciStackUse CASEFAIL{}		  = 0
-bciStackUse JMP{}		  = 0
-bciStackUse ENTER{}		  = 0
-bciStackUse RETURN{}		  = 0
-bciStackUse RETURN_UBX{}	  = 1
-bciStackUse CCALL{} 		  = 0
-bciStackUse SWIZZLE{}    	  = 0
-
--- These insns actually reduce stack use, but we need the high-tide level,
--- so can't use this info.  Not that it matters much.
-bciStackUse SLIDE{}		  = 0
-bciStackUse MKAP{}		  = 0
-bciStackUse MKPAP{}		  = 0
-bciStackUse PACK{}		  = 1 -- worst case is PACK 0 words
-\end{code}
diff --git a/ghc/compiler/ghci/ByteCodeItbls.lhs b/ghc/compiler/ghci/ByteCodeItbls.lhs
deleted file mode 100644
index 74346c6218..0000000000
--- a/ghc/compiler/ghci/ByteCodeItbls.lhs
+++ /dev/null
@@ -1,366 +0,0 @@
-%
-% (c) The University of Glasgow 2000
-%
-\section[ByteCodeItbls]{Generate infotables for interpreter-made bytecodes}
-
-\begin{code}
-
-{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
-
-module ByteCodeItbls ( ItblEnv, ItblPtr, mkITbls ) where
-
-#include "HsVersions.h"
-
-import Name		( Name, getName )
-import NameEnv
-import SMRep		( typeCgRep )
-import DataCon		( DataCon, dataConRepArgTys )
-import TyCon		( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons )
-import Constants	( mIN_PAYLOAD_SIZE, wORD_SIZE )
-import CgHeapery	( mkVirtHeapOffsets )
-import FastString	( FastString(..) )
-import Util             ( lengthIs, listLengthCmp )
-
-import Foreign
-import Foreign.C
-import DATA_BITS	( Bits(..), shiftR )
-
-import GHC.Exts		( Int(I#), addr2Int# )
-#if __GLASGOW_HASKELL__ < 503
-import Ptr		( Ptr(..) )
-#else
-import GHC.Ptr		( Ptr(..) )
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Manufacturing of info tables for DataCons}
-%*									*
-%************************************************************************
-
-\begin{code}
-type ItblPtr = Ptr StgInfoTable
-type ItblEnv = NameEnv (Name, ItblPtr)
-	-- We need the Name in the range so we know which
-	-- elements to filter out when unloading a module
-
-mkItblEnv :: [(Name,ItblPtr)] -> ItblEnv
-mkItblEnv pairs = mkNameEnv [(n, (n,p)) | (n,p) <- pairs]
-
-
--- Make info tables for the data decls in this module
-mkITbls :: [TyCon] -> IO ItblEnv
-mkITbls [] = return emptyNameEnv
-mkITbls (tc:tcs) = do itbls  <- mkITbl tc
-                      itbls2 <- mkITbls tcs
-                      return (itbls `plusNameEnv` itbls2)
-
-mkITbl :: TyCon -> IO ItblEnv
-mkITbl tc
-   | not (isDataTyCon tc) 
-   = return emptyNameEnv
-   | dcs `lengthIs` n -- paranoia; this is an assertion.
-   = make_constr_itbls dcs
-     where
-        dcs = tyConDataCons tc
-        n   = tyConFamilySize tc
-
-#include "../includes/ClosureTypes.h"
-cONSTR :: Int	-- Defined in ClosureTypes.h
-cONSTR = CONSTR 
-
--- Assumes constructors are numbered from zero, not one
-make_constr_itbls :: [DataCon] -> IO ItblEnv
-make_constr_itbls cons
-   | listLengthCmp cons 8 /= GT -- <= 8 elements in the list
-   = do is <- mapM mk_vecret_itbl (zip cons [0..])
-	return (mkItblEnv is)
-   | otherwise
-   = do is <- mapM mk_dirret_itbl (zip cons [0..])
-	return (mkItblEnv is)
-     where
-        mk_vecret_itbl (dcon, conNo)
-           = mk_itbl dcon conNo (vecret_entry conNo)
-        mk_dirret_itbl (dcon, conNo)
-           = mk_itbl dcon conNo stg_interp_constr_entry
-
-        mk_itbl :: DataCon -> Int -> Ptr () -> IO (Name,ItblPtr)
-        mk_itbl dcon conNo entry_addr
-           = let rep_args = [ (typeCgRep arg,arg) 
-			    | arg <- dataConRepArgTys dcon ]
-		 (tot_wds, ptr_wds, _) = mkVirtHeapOffsets False{-not a THUNK-} rep_args
-
-                 ptrs  = ptr_wds
-                 nptrs = tot_wds - ptr_wds
-                 nptrs_really
-                    | ptrs + nptrs >= mIN_PAYLOAD_SIZE = nptrs
-                    | otherwise = mIN_PAYLOAD_SIZE - ptrs
-                 itbl  = StgInfoTable {
-                           ptrs  = fromIntegral ptrs, 
-                           nptrs = fromIntegral nptrs_really,
-                           tipe  = fromIntegral cONSTR,
-                           srtlen = fromIntegral conNo,
-                           code  = code
-                        }
-                 -- Make a piece of code to jump to "entry_label".
-                 -- This is the only arch-dependent bit.
-                 code = mkJumpToAddr entry_addr
-             in
-                 do addr <- malloc_exec (sizeOf itbl)
-                    --putStrLn ("SIZE of itbl is " ++ show (sizeOf itbl))
-                    --putStrLn ("# ptrs  of itbl is " ++ show ptrs)
-                    --putStrLn ("# nptrs of itbl is " ++ show nptrs_really)
-                    poke addr itbl
-                    return (getName dcon, addr `plusPtr` (2 * wORD_SIZE))
-
-
--- Make code which causes a jump to the given address.  This is the
--- only arch-dependent bit of the itbl story.  The returned list is
--- itblCodeLength elements (bytes) long.
-
--- For sparc_TARGET_ARCH, i386_TARGET_ARCH, etc.
-#include "nativeGen/NCG.h"
-
-itblCodeLength :: Int
-itblCodeLength = length (mkJumpToAddr undefined)
-
-mkJumpToAddr :: Ptr () -> [ItblCode]
-
-ptrToInt (Ptr a#) = I# (addr2Int# a#)
-
-#if sparc_TARGET_ARCH
--- After some consideration, we'll try this, where
--- 0x55555555 stands in for the address to jump to.
--- According to ghc/includes/MachRegs.h, %g3 is very
--- likely indeed to be baggable.
---
---   0000 07155555              sethi   %hi(0x55555555), %g3
---   0004 8610E155              or      %g3, %lo(0x55555555), %g3
---   0008 81C0C000              jmp     %g3
---   000c 01000000              nop
-
-type ItblCode = Word32
-mkJumpToAddr a
-   = let w32 = fromIntegral (ptrToInt a)
-
-         hi22, lo10 :: Word32 -> Word32
-         lo10 x = x .&. 0x3FF
-         hi22 x = (x `shiftR` 10) .&. 0x3FFFF
-
-     in  [ 0x07000000 .|. (hi22 w32),
-           0x8610E000 .|. (lo10 w32),
-           0x81C0C000,
-           0x01000000 ]
-
-#elif powerpc_TARGET_ARCH
--- We'll use r12, for no particular reason.
--- 0xDEADBEEF stands for the adress:
--- 3D80DEAD lis r12,0xDEAD
--- 618CBEEF ori r12,r12,0xBEEF
--- 7D8903A6 mtctr r12
--- 4E800420 bctr
-
-type ItblCode = Word32
-mkJumpToAddr a =
-    let w32 = fromIntegral (ptrToInt a)
-	hi16 x = (x `shiftR` 16) .&. 0xFFFF
-	lo16 x = x .&. 0xFFFF
-    in	[
-	0x3D800000 .|. hi16 w32,
-	0x618C0000 .|. lo16 w32,
-	0x7D8903A6, 0x4E800420
-	]
-
-#elif i386_TARGET_ARCH
--- Let the address to jump to be 0xWWXXYYZZ.
--- Generate   movl $0xWWXXYYZZ,%eax  ;  jmp *%eax
--- which is
--- B8 ZZ YY XX WW FF E0
-
-type ItblCode = Word8
-mkJumpToAddr a
-   = let w32 = fromIntegral (ptrToInt a) :: Word32
-         insnBytes :: [Word8]
-         insnBytes
-            = [0xB8, byte0 w32, byte1 w32, 
-                     byte2 w32, byte3 w32, 
-               0xFF, 0xE0]
-     in
-         insnBytes
-
-#elif x86_64_TARGET_ARCH
--- Generates:
--- 	jmpq *.L1(%rip)
--- 	.align 8
--- .L1:	
--- 	.quad <addr>
---
--- We need a full 64-bit pointer (we can't assume the info table is
--- allocated in low memory).  Assuming the info pointer is aligned to
--- an 8-byte boundary, the addr will also be aligned.
-
-type ItblCode = Word8
-mkJumpToAddr a
-   = let w64 = fromIntegral (ptrToInt a) :: Word64
-         insnBytes :: [Word8]
-         insnBytes
-            = [0xff, 0x25, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00,
-	       byte0 w64, byte1 w64, byte2 w64, byte3 w64,
-	       byte4 w64, byte5 w64, byte6 w64, byte7 w64]
-     in
-         insnBytes
-
-#elif alpha_TARGET_ARCH
-type ItblCode = Word32
-mkJumpToAddr a
-    = [ 0xc3800000      -- br   at, .+4
-      , 0xa79c000c      -- ldq  at, 12(at)
-      , 0x6bfc0000      -- jmp  (at)    # with zero hint -- oh well
-      , 0x47ff041f      -- nop
-      , fromIntegral (w64 .&. 0x0000FFFF)
-      , fromIntegral ((w64 `shiftR` 32) .&. 0x0000FFFF) ]
-    where w64 = fromIntegral (ptrToInt a) :: Word64
-
-#else
-type ItblCode = Word32
-mkJumpToAddr a
-    = undefined
-#endif
-
-
-byte0, byte1, byte2, byte3, byte4, byte5, byte6, byte7
-   :: (Integral w, Bits w) => w -> Word8
-byte0 w = fromIntegral w
-byte1 w = fromIntegral (w `shiftR` 8)
-byte2 w = fromIntegral (w `shiftR` 16)
-byte3 w = fromIntegral (w `shiftR` 24)
-byte4 w = fromIntegral (w `shiftR` 32)
-byte5 w = fromIntegral (w `shiftR` 40)
-byte6 w = fromIntegral (w `shiftR` 48)
-byte7 w = fromIntegral (w `shiftR` 56)
-
-
-vecret_entry 0 = stg_interp_constr1_entry
-vecret_entry 1 = stg_interp_constr2_entry
-vecret_entry 2 = stg_interp_constr3_entry
-vecret_entry 3 = stg_interp_constr4_entry
-vecret_entry 4 = stg_interp_constr5_entry
-vecret_entry 5 = stg_interp_constr6_entry
-vecret_entry 6 = stg_interp_constr7_entry
-vecret_entry 7 = stg_interp_constr8_entry
-
-#ifndef __HADDOCK__
--- entry point for direct returns for created constr itbls
-foreign import ccall "&stg_interp_constr_entry" stg_interp_constr_entry :: Ptr ()
--- and the 8 vectored ones
-foreign import ccall "&stg_interp_constr1_entry" stg_interp_constr1_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr2_entry" stg_interp_constr2_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr3_entry" stg_interp_constr3_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr4_entry" stg_interp_constr4_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr5_entry" stg_interp_constr5_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr6_entry" stg_interp_constr6_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr7_entry" stg_interp_constr7_entry :: Ptr ()
-foreign import ccall "&stg_interp_constr8_entry" stg_interp_constr8_entry :: Ptr ()
-#endif
-
-
-
-
--- Ultra-minimalist version specially for constructors
-#if SIZEOF_VOID_P == 8
-type HalfWord = Word32
-#else
-type HalfWord = Word16
-#endif
-
-data StgInfoTable = StgInfoTable {
-   ptrs   :: HalfWord,
-   nptrs  :: HalfWord,
-   tipe   :: HalfWord,
-   srtlen :: HalfWord,
-   code   :: [ItblCode]
-}
-
-instance Storable StgInfoTable where
-
-   sizeOf itbl 
-      = sum
-        [fieldSz ptrs itbl,
-         fieldSz nptrs itbl,
-         fieldSz tipe itbl,
-         fieldSz srtlen itbl,
-         fieldSz (head.code) itbl * itblCodeLength]
-
-   alignment itbl 
-      = SIZEOF_VOID_P
-
-   poke a0 itbl
-      = runState (castPtr a0)
-      $ do store (ptrs   itbl)
-           store (nptrs  itbl)
-           store (tipe   itbl)
-           store (srtlen itbl)
-           sequence_ (map store (code itbl))
-
-   peek a0
-      = runState (castPtr a0)
-      $ do ptrs   <- load
-           nptrs  <- load
-           tipe   <- load
-           srtlen <- load
-           code   <- sequence (replicate itblCodeLength load)
-           return 
-              StgInfoTable { 
-                 ptrs   = ptrs,
-                 nptrs  = nptrs, 
-                 tipe   = tipe,
-                 srtlen = srtlen,
-                 code   = code
-              }
-
-fieldSz :: (Storable a, Storable b) => (a -> b) -> a -> Int
-fieldSz sel x = sizeOf (sel x)
-
-newtype State s m a = State (s -> m (s, a))
-
-instance Monad m => Monad (State s m) where
-  return a      = State (\s -> return (s, a))
-  State m >>= k = State (\s -> m s >>= \(s', a) -> case k a of State n -> n s')
-  fail str      = State (\s -> fail str)
-
-class (Monad m, Monad (t m)) => MonadT t m where
-  lift :: m a -> t m a
-
-instance Monad m => MonadT (State s) m where
-  lift m        = State (\s -> m >>= \a -> return (s, a))
-
-runState :: (Monad m) => s -> State s m a -> m a
-runState s (State m) = m s >>= return . snd
-
-type PtrIO = State (Ptr Word8) IO
-
-advance :: Storable a => PtrIO (Ptr a)
-advance = State adv where
-    adv addr = case castPtr addr of { addrCast -> return
-        (addr `plusPtr` sizeOfPointee addrCast, addrCast) }
-
-sizeOfPointee :: (Storable a) => Ptr a -> Int
-sizeOfPointee addr = sizeOf (typeHack addr)
-    where typeHack = undefined :: Ptr a -> a
-
-store :: Storable a => a -> PtrIO ()
-store x = do addr <- advance
-             lift (poke addr x)
-
-load :: Storable a => PtrIO a
-load = do addr <- advance
-          lift (peek addr)
-
-foreign import ccall unsafe "stgMallocBytesRWX"
-  _stgMallocBytesRWX :: CInt -> IO (Ptr a)
-
-malloc_exec :: Int -> IO (Ptr a)
-malloc_exec bytes = _stgMallocBytesRWX (fromIntegral bytes)
-
-\end{code}
diff --git a/ghc/compiler/ghci/ByteCodeLink.lhs b/ghc/compiler/ghci/ByteCodeLink.lhs
deleted file mode 100644
index 875f1d6331..0000000000
--- a/ghc/compiler/ghci/ByteCodeLink.lhs
+++ /dev/null
@@ -1,268 +0,0 @@
-%
-% (c) The University of Glasgow 2000
-%
-\section[ByteCodeLink]{Bytecode assembler and linker}
-
-\begin{code}
-
-{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
-
-module ByteCodeLink ( 
-	HValue, 
-	ClosureEnv, emptyClosureEnv, extendClosureEnv,
-	linkBCO, lookupStaticPtr
-  ) where
-
-#include "HsVersions.h"
-
-import ByteCodeItbls	( ItblEnv, ItblPtr )
-import ByteCodeAsm	( UnlinkedBCO(..), BCOPtr(..), sizeSS, ssElts )
-import ObjLink		( lookupSymbol )
-
-import Name		( Name,  nameModule, nameOccName, isExternalName )
-import NameEnv
-import OccName		( occNameFS )
-import PrimOp		( PrimOp, primOpOcc )
-import Module		( moduleFS )
-import FastString	( FastString(..), unpackFS, zEncodeFS )
-import Outputable
-import Panic            ( GhcException(..) )
-
--- Standard libraries
-import GHC.Word		( Word(..) )
-
-import Data.Array.IArray ( listArray )
-import Data.Array.Base
-import GHC.Arr		( STArray(..) )
-
-import Control.Exception ( throwDyn )
-import Control.Monad	( zipWithM )
-import Control.Monad.ST ( stToIO )
-
-import GHC.Exts		( BCO#, newBCO#, unsafeCoerce#, Int#,
-			  ByteArray#, Array#, addrToHValue#, mkApUpd0# )
-
-import GHC.Arr		( Array(..) )
-import GHC.IOBase	( IO(..) )
-import GHC.Ptr		( Ptr(..) )
-import GHC.Base		( writeArray#, RealWorld, Int(..) )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Linking interpretables into something we can run}
-%*									*
-%************************************************************************
-
-\begin{code}
-type ClosureEnv = NameEnv (Name, HValue)
-newtype HValue = HValue (forall a . a)
-
-emptyClosureEnv = emptyNameEnv
-
-extendClosureEnv :: ClosureEnv -> [(Name,HValue)] -> ClosureEnv
-extendClosureEnv cl_env pairs
-  = extendNameEnvList cl_env [ (n, (n,v)) | (n,v) <- pairs]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Linking interpretables into something we can run}
-%*									*
-%************************************************************************
-
-\begin{code}
-{- 
-data BCO# = BCO# ByteArray# 		-- instrs   :: Array Word16#
-                 ByteArray# 		-- literals :: Array Word32#
-                 PtrArray# 		-- ptrs     :: Array HValue
-                 ByteArray#		-- itbls    :: Array Addr#
--}
-
-linkBCO :: ItblEnv -> ClosureEnv -> UnlinkedBCO -> IO HValue
-linkBCO ie ce ul_bco
-   = do BCO bco# <- linkBCO' ie ce ul_bco
-	-- SDM: Why do we need mkApUpd0 here?  I *think* it's because
-	-- otherwise top-level interpreted CAFs don't get updated 
- 	-- after evaluation.   A top-level BCO will evaluate itself and
-	-- return its value when entered, but it won't update itself.
-	-- Wrapping the BCO in an AP_UPD thunk will take care of the
-	-- update for us.
-	--
-	-- Update: the above is true, but now we also have extra invariants:
-	--   (a) An AP thunk *must* point directly to a BCO
-	--   (b) A zero-arity BCO *must* be wrapped in an AP thunk
-	--   (c) An AP is always fully saturated, so we *can't* wrap
-	--       non-zero arity BCOs in an AP thunk.
-	-- 
-	if (unlinkedBCOArity ul_bco > 0) 
-	   then return (unsafeCoerce# bco#)
-	   else case mkApUpd0# bco# of { (# final_bco #) -> return final_bco }
-
-
-linkBCO' :: ItblEnv -> ClosureEnv -> UnlinkedBCO -> IO BCO
-linkBCO' ie ce (UnlinkedBCO nm arity insns_barr bitmap literalsSS ptrsSS itblsSS)
-   -- Raises an IO exception on failure
-   = do let literals = ssElts literalsSS
-	    ptrs     = ssElts ptrsSS
-	    itbls    = ssElts itblsSS
-
-        linked_itbls    <- mapM (lookupIE ie) itbls
-        linked_literals <- mapM lookupLiteral literals
-
-        let n_literals = sizeSS literalsSS
-            n_ptrs     = sizeSS ptrsSS
-            n_itbls    = sizeSS itblsSS
-
-	ptrs_arr <- mkPtrsArray ie ce n_ptrs ptrs
-
-        let 
-            ptrs_parr = case ptrs_arr of Array lo hi parr -> parr
-
-            itbls_arr = listArray (0, n_itbls-1) linked_itbls
-                        :: UArray Int ItblPtr
-            itbls_barr = case itbls_arr of UArray lo hi barr -> barr
-
-            literals_arr = listArray (0, n_literals-1) linked_literals
-                           :: UArray Int Word
-            literals_barr = case literals_arr of UArray lo hi barr -> barr
-
-	    (I# arity#)  = arity
-
-        newBCO insns_barr literals_barr ptrs_parr itbls_barr arity# bitmap
-
-
--- we recursively link any sub-BCOs while making the ptrs array
-mkPtrsArray :: ItblEnv -> ClosureEnv -> Int -> [BCOPtr] -> IO (Array Int HValue)
-mkPtrsArray ie ce n_ptrs ptrs = do
-  marr <- newArray_ (0, n_ptrs-1)
-  let 
-    fill (BCOPtrName n)     i = do
-	ptr <- lookupName ce n
-	unsafeWrite marr i ptr
-    fill (BCOPtrPrimOp op)  i = do
- 	ptr <- lookupPrimOp op
-	unsafeWrite marr i ptr
-    fill (BCOPtrBCO ul_bco) i = do
-	BCO bco# <- linkBCO' ie ce ul_bco
-	writeArrayBCO marr i bco#
-  zipWithM fill ptrs [0..]
-  unsafeFreeze marr
-
-newtype IOArray i e = IOArray (STArray RealWorld i e)
-
-instance HasBounds IOArray where
-    bounds (IOArray marr) = bounds marr
-
-instance MArray IOArray e IO where
-    newArray lu init = stToIO $ do
-        marr <- newArray lu init; return (IOArray marr)
-    newArray_ lu = stToIO $ do
-        marr <- newArray_ lu; return (IOArray marr)
-    unsafeRead (IOArray marr) i = stToIO (unsafeRead marr i)
-    unsafeWrite (IOArray marr) i e = stToIO (unsafeWrite marr i e)
-
--- XXX HACK: we should really have a new writeArray# primop that takes a BCO#.
-writeArrayBCO :: IOArray Int a -> Int -> BCO# -> IO ()
-writeArrayBCO (IOArray (STArray _ _ marr#)) (I# i#) bco# = IO $ \s# ->
-  case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# ->
-  (# s#, () #) }
-
-data BCO = BCO BCO#
-
-newBCO :: ByteArray# -> ByteArray# -> Array# a
-	 -> ByteArray# -> Int# -> ByteArray# -> IO BCO
-newBCO instrs lits ptrs itbls arity bitmap
-   = IO $ \s -> case newBCO# instrs lits ptrs itbls arity bitmap s of 
-		  (# s1, bco #) -> (# s1, BCO bco #)
-
-
-lookupLiteral :: Either Word FastString -> IO Word
-lookupLiteral (Left lit)  = return lit
-lookupLiteral (Right sym) = do Ptr addr <- lookupStaticPtr sym
-			       return (W# (unsafeCoerce# addr)) 
-     -- Can't be bothered to find the official way to convert Addr# to Word#;
-     -- the FFI/Foreign designers make it too damn difficult
-     -- Hence we apply the Blunt Instrument, which works correctly
-     -- on all reasonable architectures anyway
-
-lookupStaticPtr :: FastString -> IO (Ptr ())
-lookupStaticPtr addr_of_label_string 
-   = do let label_to_find = unpackFS addr_of_label_string
-        m <- lookupSymbol label_to_find 
-        case m of
-           Just ptr -> return ptr
-           Nothing  -> linkFail "ByteCodeLink: can't find label" 
-                                label_to_find
-
-lookupPrimOp :: PrimOp -> IO HValue
-lookupPrimOp primop
-   = do let sym_to_find = primopToCLabel primop "closure"
-        m <- lookupSymbol sym_to_find
-        case m of
-           Just (Ptr addr) -> case addrToHValue# addr of
-                                 (# hval #) -> return hval
-           Nothing -> linkFail "ByteCodeLink.lookupCE(primop)" sym_to_find
-
-lookupName :: ClosureEnv -> Name -> IO HValue
-lookupName ce nm
-   = case lookupNameEnv ce nm of
-        Just (_,aa) -> return aa
-        Nothing 
-           -> ASSERT2(isExternalName nm, ppr nm)
-	      do let sym_to_find = nameToCLabel nm "closure"
-                 m <- lookupSymbol sym_to_find
-                 case m of
-                    Just (Ptr addr) -> case addrToHValue# addr of
-                                          (# hval #) -> return hval
-                    Nothing         -> linkFail "ByteCodeLink.lookupCE" sym_to_find
-
-lookupIE :: ItblEnv -> Name -> IO (Ptr a)
-lookupIE ie con_nm 
-   = case lookupNameEnv ie con_nm of
-        Just (_, Ptr a) -> return (Ptr a)
-        Nothing
-           -> do -- try looking up in the object files.
-                 let sym_to_find1 = nameToCLabel con_nm "con_info"
-                 m <- lookupSymbol sym_to_find1
-                 case m of
-                    Just addr -> return addr
-                    Nothing 
-                       -> do -- perhaps a nullary constructor?
-                             let sym_to_find2 = nameToCLabel con_nm "static_info"
-                             n <- lookupSymbol sym_to_find2
-                             case n of
-                                Just addr -> return addr
-                                Nothing   -> linkFail "ByteCodeLink.lookupIE" 
-                                                (sym_to_find1 ++ " or " ++ sym_to_find2)
-
-linkFail :: String -> String -> IO a
-linkFail who what
-   = throwDyn (ProgramError $
-        unlines [ ""
-	        , "During interactive linking, GHCi couldn't find the following symbol:"
-		, ' ' : ' ' : what 
-		, "This may be due to you not asking GHCi to load extra object files,"
-		, "archives or DLLs needed by your current session.  Restart GHCi, specifying"
-		, "the missing library using the -L/path/to/object/dir and -lmissinglibname"
-		, "flags, or simply by naming the relevant files on the GHCi command line."
-		, "Alternatively, this link failure might indicate a bug in GHCi."
-		, "If you suspect the latter, please send a bug report to:"
-		, "  glasgow-haskell-bugs@haskell.org"
-		])
-
--- HACKS!!!  ToDo: cleaner
-nameToCLabel :: Name -> String{-suffix-} -> String
-nameToCLabel n suffix
-   = unpackFS (zEncodeFS (moduleFS (nameModule n)))
-     ++ '_': unpackFS (zEncodeFS (occNameFS (nameOccName n))) ++ '_':suffix
-
-primopToCLabel :: PrimOp -> String{-suffix-} -> String
-primopToCLabel primop suffix
-   = let str = "GHCziPrimopWrappers_" ++ unpackFS (zEncodeFS (occNameFS (primOpOcc primop))) ++ '_':suffix
-     in --trace ("primopToCLabel: " ++ str)
-        str
-\end{code}
-
diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
deleted file mode 100644
index 9e9c262052..0000000000
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ /dev/null
@@ -1,1534 +0,0 @@
-{-# OPTIONS -#include "Linker.h" #-}
------------------------------------------------------------------------------
---
--- GHC Interactive User Interface
---
--- (c) The GHC Team 2005
---
------------------------------------------------------------------------------
-module InteractiveUI ( 
-	interactiveUI,
-	ghciWelcomeMsg
-   ) where
-
-#include "HsVersions.h"
-
-#if defined(GHCI) && defined(BREAKPOINT)
-import GHC.Exts         ( Int(..), Ptr(..), int2Addr# )
-import Foreign.StablePtr ( deRefStablePtr, castPtrToStablePtr )
-import System.IO.Unsafe ( unsafePerformIO )
-import Var              ( Id, globaliseId, idName, idType )
-import HscTypes         ( Session(..), InteractiveContext(..), HscEnv(..)
-                        , extendTypeEnvWithIds )
-import RdrName          ( extendLocalRdrEnv, mkRdrUnqual, lookupLocalRdrEnv )
-import NameEnv          ( delListFromNameEnv )
-import TcType           ( tidyTopType )
-import qualified Id     ( setIdType )
-import IdInfo           ( GlobalIdDetails(..) )
-import Linker           ( HValue, extendLinkEnv, withExtendedLinkEnv,initDynLinker  )
-import PrelNames        ( breakpointJumpName )
-#endif
-
--- The GHC interface
-import qualified GHC
-import GHC		( Session, verbosity, dopt, DynFlag(..), Target(..),
-			  TargetId(..), DynFlags(..),
-			  pprModule, Type, Module, SuccessFlag(..),
-			  TyThing(..), Name, LoadHowMuch(..), Phase,
-			  GhcException(..), showGhcException,
-			  CheckedModule(..), SrcLoc )
-import DynFlags         ( allFlags )
-import Packages		( PackageState(..) )
-import PackageConfig	( InstalledPackageInfo(..) )
-import UniqFM		( eltsUFM )
-import PprTyThing
-import Outputable
-
--- for createtags (should these come via GHC?)
-import Module		( moduleString )
-import Name		( nameSrcLoc, nameModule, nameOccName )
-import OccName		( pprOccName )
-import SrcLoc		( isGoodSrcLoc, srcLocFile, srcLocLine, srcLocCol )
-
--- Other random utilities
-import Digraph		( flattenSCCs )
-import BasicTypes	( failed, successIf )
-import Panic 		( panic, installSignalHandlers )
-import Config
-import StaticFlags	( opt_IgnoreDotGhci )
-import Linker		( showLinkerState )
-import Util		( removeSpaces, handle, global, toArgs,
-			  looksLikeModuleName, prefixMatch, sortLe )
-
-#ifndef mingw32_HOST_OS
-import System.Posix
-#if __GLASGOW_HASKELL__ > 504
-	hiding (getEnv)
-#endif
-#else
-import GHC.ConsoleHandler ( flushConsole )
-#endif
-
-#ifdef USE_READLINE
-import Control.Concurrent	( yield )	-- Used in readline loop
-import System.Console.Readline as Readline
-#endif
-
---import SystemExts
-
-import Control.Exception as Exception
-import Data.Dynamic
--- import Control.Concurrent
-
-import Numeric
-import Data.List
-import Data.Int		( Int64 )
-import Data.Maybe	( isJust, fromMaybe, catMaybes )
-import System.Cmd
-import System.CPUTime
-import System.Environment
-import System.Exit	( exitWith, ExitCode(..) )
-import System.Directory
-import System.IO
-import System.IO.Error as IO
-import Data.Char
-import Control.Monad as Monad
-import Foreign.StablePtr	( newStablePtr )
-import Text.Printf
-
-import GHC.Exts		( unsafeCoerce# )
-import GHC.IOBase	( IOErrorType(InvalidArgument) )
-
-import Data.IORef	( IORef, newIORef, readIORef, writeIORef )
-
-import System.Posix.Internals ( setNonBlockingFD )
-
------------------------------------------------------------------------------
-
-ghciWelcomeMsg =
- "   ___         ___ _\n"++
- "  / _ \\ /\\  /\\/ __(_)\n"++
- " / /_\\// /_/ / /  | |      GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++
- "/ /_\\\\/ __  / /___| |      http://www.haskell.org/ghc/\n"++
- "\\____/\\/ /_/\\____/|_|      Type :? for help.\n"
-
-type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
-cmdName (n,_,_,_) = n
-
-GLOBAL_VAR(commands, builtin_commands, [Command])
-
-builtin_commands :: [Command]
-builtin_commands = [
-  ("add",	keepGoingPaths addModule,	False, completeFilename),
-  ("browse",    keepGoing browseCmd,		False, completeModule),
-  ("cd",    	keepGoing changeDirectory, 	False, completeFilename),
-  ("def",	keepGoing defineMacro,		False, completeIdentifier),
-  ("help",	keepGoing help,			False, completeNone),
-  ("?",		keepGoing help,			False, completeNone),
-  ("info",      keepGoing info,			False, completeIdentifier),
-  ("load",	keepGoingPaths loadModule_,	False, completeHomeModuleOrFile),
-  ("module",	keepGoing setContext,		False, completeModule),
-  ("main",	keepGoing runMain,		False, completeIdentifier),
-  ("reload",	keepGoing reloadModule,		False, completeNone),
-  ("check",	keepGoing checkModule,		False, completeHomeModule),
-  ("set",	keepGoing setCmd,		True,  completeSetOptions),
-  ("show",	keepGoing showCmd,		False, completeNone),
-  ("etags",	keepGoing createETagsFileCmd,	False, completeFilename),
-  ("ctags",	keepGoing createCTagsFileCmd, 	False, completeFilename),
-  ("type",	keepGoing typeOfExpr,		False, completeIdentifier),
-  ("kind",	keepGoing kindOfType,		False, completeIdentifier),
-  ("unset",	keepGoing unsetOptions,		True,  completeSetOptions),
-  ("undef",     keepGoing undefineMacro,	False, completeMacro),
-  ("quit",	quit,				False, completeNone)
-  ]
-
-keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
-keepGoing a str = a str >> return False
-
-keepGoingPaths :: ([FilePath] -> GHCi ()) -> (String -> GHCi Bool)
-keepGoingPaths a str = a (toArgs str) >> return False
-
-shortHelpText = "use :? for help.\n"
-
--- NOTE: spaces at the end of each line to workaround CPP/string gap bug.
-helpText =
- " Commands available from the prompt:\n" ++
- "\n" ++
- "   <stmt>                      evaluate/run <stmt>\n" ++
- "   :add <filename> ...         add module(s) to the current target set\n" ++
- "   :browse [*]<module>         display the names defined by <module>\n" ++
- "   :cd <dir>                   change directory to <dir>\n" ++
- "   :def <cmd> <expr>           define a command :<cmd>\n" ++
- "   :help, :?                   display this list of commands\n" ++
- "   :info [<name> ...]          display information about the given names\n" ++
- "   :load <filename> ...        load module(s) and their dependents\n" ++
- "   :module [+/-] [*]<mod> ...  set the context for expression evaluation\n" ++
- "   :main [<arguments> ...]     run the main function with the given arguments\n" ++
- "   :reload                     reload the current module set\n" ++
- "\n" ++
- "   :set <option> ...           set options\n" ++
- "   :set args <arg> ...         set the arguments returned by System.getArgs\n" ++
- "   :set prog <progname>        set the value returned by System.getProgName\n" ++
- "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
- "\n" ++
- "   :show modules               show the currently loaded modules\n" ++
- "   :show bindings              show the current bindings made at the prompt\n" ++
- "\n" ++
- "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
- "   :etags [<file>]           	 create tags file for Emacs (defauilt: \"TAGS\")\n" ++
- "   :type <expr>                show the type of <expr>\n" ++
- "   :kind <type>                show the kind of <type>\n" ++
- "   :undef <cmd>                undefine user-defined command :<cmd>\n" ++
- "   :unset <option> ...         unset options\n" ++
- "   :quit                       exit GHCi\n" ++
- "   :!<command>                 run the shell command <command>\n" ++
- "\n" ++
- " Options for ':set' and ':unset':\n" ++
- "\n" ++
- "    +r            revert top-level expressions after each evaluation\n" ++
- "    +s            print timing/memory stats after each evaluation\n" ++
- "    +t            print type after evaluation\n" ++
- "    -<flags>      most GHC command line flags can also be set here\n" ++
- "                         (eg. -v2, -fglasgow-exts, etc.)\n"
-
-
-#if defined(GHCI) && defined(BREAKPOINT)
-globaliseAndTidy :: Id -> Id
-globaliseAndTidy id
--- Give the Id a Global Name, and tidy its type
-  = Id.setIdType (globaliseId VanillaGlobal id) tidy_type
-  where
-    tidy_type = tidyTopType (idType id)
-
-
-printScopeMsg :: Session -> String -> [Id] -> IO ()
-printScopeMsg session location ids
-    = GHC.getPrintUnqual session >>= \unqual ->
-      printForUser stdout unqual $
-        text "Local bindings in scope:" $$
-        nest 2 (pprWithCommas showId ids)
-    where showId id = ppr (idName id) <+> dcolon <+> ppr (idType id)
-
-jumpFunction :: Session -> Int -> [HValue] -> String -> b -> b
-jumpFunction session@(Session ref) (I# idsPtr) hValues location b
-    = unsafePerformIO $
-      do ids <- deRefStablePtr (castPtrToStablePtr (Ptr (int2Addr# idsPtr)))
-         let names = map idName ids
-         ASSERT (length names == length hValues) return ()
-         printScopeMsg session location ids
-         hsc_env <- readIORef ref
-
-         let ictxt = hsc_IC hsc_env
-             global_ids = map globaliseAndTidy ids
-             rn_env   = ic_rn_local_env ictxt
-             type_env = ic_type_env ictxt
-             bound_names = map idName global_ids
-             new_rn_env  = extendLocalRdrEnv rn_env bound_names
-		-- Remove any shadowed bindings from the type_env;
-		-- they are inaccessible but might, I suppose, cause 
-		-- a space leak if we leave them there
-             shadowed = [ n | name <- bound_names,
-                          let rdr_name = mkRdrUnqual (nameOccName name),
-                          Just n <- [lookupLocalRdrEnv rn_env rdr_name] ]
-             filtered_type_env = delListFromNameEnv type_env shadowed
-             new_type_env = extendTypeEnvWithIds filtered_type_env global_ids
-             new_ic = ictxt { ic_rn_local_env = new_rn_env, 
-		  	      ic_type_env     = new_type_env }
-         writeIORef ref (hsc_env { hsc_IC = new_ic })
-         withExtendedLinkEnv (zip names hValues) $
-           startGHCi (runGHCi [] Nothing)
-                     GHCiState{ progname = "<interactive>",
-                                args = [],
-                                prompt = location++"> ",
-                                session = session,
-                                options = [] }
-         writeIORef ref hsc_env
-         putStrLn $ "Returning to normal execution..."
-         return b
-#endif
-
-interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
-interactiveUI session srcs maybe_expr = do
-#if defined(GHCI) && defined(BREAKPOINT)
-   initDynLinker =<< GHC.getSessionDynFlags session
-   extendLinkEnv [(breakpointJumpName,unsafeCoerce# (jumpFunction session))]
-#endif
-   -- HACK! If we happen to get into an infinite loop (eg the user
-   -- types 'let x=x in x' at the prompt), then the thread will block
-   -- on a blackhole, and become unreachable during GC.  The GC will
-   -- detect that it is unreachable and send it the NonTermination
-   -- exception.  However, since the thread is unreachable, everything
-   -- it refers to might be finalized, including the standard Handles.
-   -- This sounds like a bug, but we don't have a good solution right
-   -- now.
-   newStablePtr stdin
-   newStablePtr stdout
-   newStablePtr stderr
-
-   hFlush stdout
-   hSetBuffering stdout NoBuffering
-
-	-- Initialise buffering for the *interpreted* I/O system
-   initInterpBuffering session
-
-	-- We don't want the cmd line to buffer any input that might be
-	-- intended for the program, so unbuffer stdin.
-   hSetBuffering stdin NoBuffering
-
-	-- initial context is just the Prelude
-   GHC.setContext session [] [prelude_mod]
-
-#ifdef USE_READLINE
-   Readline.initialize
-   Readline.setAttemptedCompletionFunction (Just completeWord)
-   --Readline.parseAndBind "set show-all-if-ambiguous 1"
-
-   let symbols = "!#$%&*+/<=>?@\\^|-~"
-       specials = "(),;[]`{}"
-       spaces = " \t\n"
-       word_break_chars = spaces ++ specials ++ symbols
-
-   Readline.setBasicWordBreakCharacters word_break_chars
-   Readline.setCompleterWordBreakCharacters word_break_chars
-#endif
-
-   startGHCi (runGHCi srcs maybe_expr)
-	GHCiState{ progname = "<interactive>",
-		   args = [],
-                   prompt = "%s> ",
-		   session = session,
-		   options = [] }
-
-#ifdef USE_READLINE
-   Readline.resetTerminal Nothing
-#endif
-
-   return ()
-
-runGHCi :: [(FilePath, Maybe Phase)] -> Maybe String -> GHCi ()
-runGHCi paths maybe_expr = do
-  let read_dot_files = not opt_IgnoreDotGhci
-
-  when (read_dot_files) $ do
-    -- Read in ./.ghci.
-    let file = "./.ghci"
-    exists <- io (doesFileExist file)
-    when exists $ do
-       dir_ok  <- io (checkPerms ".")
-       file_ok <- io (checkPerms file)
-       when (dir_ok && file_ok) $ do
-  	  either_hdl <- io (IO.try (openFile "./.ghci" ReadMode))
-  	  case either_hdl of
-  	     Left e    -> return ()
-  	     Right hdl -> fileLoop hdl False
-    
-  when (read_dot_files) $ do
-    -- Read in $HOME/.ghci
-    either_dir <- io (IO.try (getEnv "HOME"))
-    case either_dir of
-       Left e -> return ()
-       Right dir -> do
-  	  cwd <- io (getCurrentDirectory)
-  	  when (dir /= cwd) $ do
-  	     let file = dir ++ "/.ghci"
-  	     ok <- io (checkPerms file)
-  	     when ok $ do
-  	       either_hdl <- io (IO.try (openFile file ReadMode))
-  	       case either_hdl of
-  		  Left e    -> return ()
-  		  Right hdl -> fileLoop hdl False
-
-  -- Perform a :load for files given on the GHCi command line
-  -- When in -e mode, if the load fails then we want to stop
-  -- immediately rather than going on to evaluate the expression.
-  when (not (null paths)) $ do
-     ok <- ghciHandle (\e -> do showException e; return Failed) $ 
-		loadModule paths
-     when (isJust maybe_expr && failed ok) $
-	io (exitWith (ExitFailure 1))
-
-  -- if verbosity is greater than 0, or we are connected to a
-  -- terminal, display the prompt in the interactive loop.
-  is_tty <- io (hIsTerminalDevice stdin)
-  dflags <- getDynFlags
-  let show_prompt = verbosity dflags > 0 || is_tty
-
-  case maybe_expr of
-	Nothing -> 
-#if defined(mingw32_HOST_OS)
-          do
-            -- The win32 Console API mutates the first character of 
-            -- type-ahead when reading from it in a non-buffered manner. Work
-            -- around this by flushing the input buffer of type-ahead characters,
-            -- but only if stdin is available.
-            flushed <- io (IO.try (GHC.ConsoleHandler.flushConsole stdin))
-            case flushed of 
-   	     Left err | isDoesNotExistError err -> return ()
-   		      | otherwise -> io (ioError err)
-   	     Right () -> return ()
-#endif
-	    -- enter the interactive loop
-	    interactiveLoop is_tty show_prompt
-	Just expr -> do
-	    -- just evaluate the expression we were given
-	    runCommandEval expr
-	    return ()
-
-  -- and finally, exit
-  io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."
-
-
-interactiveLoop is_tty show_prompt =
-  -- Ignore ^C exceptions caught here
-  ghciHandleDyn (\e -> case e of 
-			Interrupted -> do
-#if defined(mingw32_HOST_OS)
-				io (putStrLn "")
-#endif
-				interactiveLoop is_tty show_prompt
-			_other      -> return ()) $ 
-
-  ghciUnblock $ do -- unblock necessary if we recursed from the 
-		   -- exception handler above.
-
-  -- read commands from stdin
-#ifdef USE_READLINE
-  if (is_tty) 
-	then readlineLoop
-	else fileLoop stdin show_prompt
-#else
-  fileLoop stdin show_prompt
-#endif
-
-
--- NOTE: We only read .ghci files if they are owned by the current user,
--- and aren't world writable.  Otherwise, we could be accidentally 
--- running code planted by a malicious third party.
-
--- Furthermore, We only read ./.ghci if . is owned by the current user
--- and isn't writable by anyone else.  I think this is sufficient: we
--- don't need to check .. and ../.. etc. because "."  always refers to
--- the same directory while a process is running.
-
-checkPerms :: String -> IO Bool
-checkPerms name =
-#ifdef mingw32_HOST_OS
-  return True
-#else
-  Util.handle (\_ -> return False) $ do
-     st <- getFileStatus name
-     me <- getRealUserID
-     if fileOwner st /= me then do
-   	putStrLn $ "WARNING: " ++ name ++ " is owned by someone else, IGNORING!"
-   	return False
-      else do
-   	let mode =  fileMode st
-   	if (groupWriteMode == (mode `intersectFileModes` groupWriteMode))
-   	   || (otherWriteMode == (mode `intersectFileModes` otherWriteMode)) 
-   	   then do
-   	       putStrLn $ "*** WARNING: " ++ name ++ 
-   			  " is writable by someone else, IGNORING!"
-   	       return False
-   	  else return True
-#endif
-
-fileLoop :: Handle -> Bool -> GHCi ()
-fileLoop hdl show_prompt = do
-   session <- getSession
-   (mod,imports) <- io (GHC.getContext session)
-   st <- getGHCiState
-   when show_prompt (io (putStr (mkPrompt mod imports (prompt st))))
-   l <- io (IO.try (hGetLine hdl))
-   case l of
-	Left e | isEOFError e		   -> return ()
-	       | InvalidArgument <- etype  -> return ()
-	       | otherwise		   -> io (ioError e)
-		where etype = ioeGetErrorType e
-		-- treat InvalidArgument in the same way as EOF:
-		-- this can happen if the user closed stdin, or
-		-- perhaps did getContents which closes stdin at
-		-- EOF.
-	Right l -> 
-	  case removeSpaces l of
-            "" -> fileLoop hdl show_prompt
-	    l  -> do quit <- runCommand l
-                     if quit then return () else fileLoop hdl show_prompt
-
-stringLoop :: [String] -> GHCi ()
-stringLoop [] = return ()
-stringLoop (s:ss) = do
-   case removeSpaces s of
-	"" -> stringLoop ss
-	l  -> do quit <- runCommand l
-                 if quit then return () else stringLoop ss
-
-mkPrompt toplevs exports prompt
-  = showSDoc $ f prompt
-    where
-        f ('%':'s':xs) = perc_s <> f xs
-        f ('%':'%':xs) = char '%' <> f xs
-        f (x:xs) = char x <> f xs
-        f [] = empty
-    
-        perc_s = hsep (map (\m -> char '*' <> pprModule m) toplevs) <+>
-                 hsep (map pprModule exports)
-             
-
-#ifdef USE_READLINE
-readlineLoop :: GHCi ()
-readlineLoop = do
-   session <- getSession
-   (mod,imports) <- io (GHC.getContext session)
-   io yield
-   saveSession -- for use by completion
-   st <- getGHCiState
-   l <- io (readline (mkPrompt mod imports (prompt st))
-	  	`finally` setNonBlockingFD 0)
-		-- readline sometimes puts stdin into blocking mode,
-		-- so we need to put it back for the IO library
-   splatSavedSession
-   case l of
-	Nothing -> return ()
-	Just l  ->
-	  case removeSpaces l of
-	    "" -> readlineLoop
-	    l  -> do
-        	  io (addHistory l)
-  	  	  quit <- runCommand l
-          	  if quit then return () else readlineLoop
-#endif
-
-runCommand :: String -> GHCi Bool
-runCommand c = ghciHandle handler (doCommand c)
-  where 
-    doCommand (':' : command) = specialCommand command
-    doCommand stmt
-       = do timeIt (do nms <- runStmt stmt; finishEvalExpr nms)
-            return False
-
--- This version is for the GHC command-line option -e.  The only difference
--- from runCommand is that it catches the ExitException exception and
--- exits, rather than printing out the exception.
-runCommandEval c = ghciHandle handleEval (doCommand c)
-  where 
-    handleEval (ExitException code) = io (exitWith code)
-    handleEval e                    = do showException e
-				         io (exitWith (ExitFailure 1))
-
-    doCommand (':' : command) = specialCommand command
-    doCommand stmt
-       = do nms <- runStmt stmt
-	    case nms of 
-		Nothing -> io (exitWith (ExitFailure 1))
-		  -- failure to run the command causes exit(1) for ghc -e.
-		_       -> finishEvalExpr nms
-
--- This is the exception handler for exceptions generated by the
--- user's code; it normally just prints out the exception.  The
--- handler must be recursive, in case showing the exception causes
--- more exceptions to be raised.
---
--- Bugfix: if the user closed stdout or stderr, the flushing will fail,
--- raising another exception.  We therefore don't put the recursive
--- handler arond the flushing operation, so if stderr is closed
--- GHCi will just die gracefully rather than going into an infinite loop.
-handler :: Exception -> GHCi Bool
-handler exception = do
-  flushInterpBuffers
-  io installSignalHandlers
-  ghciHandle handler (showException exception >> return False)
-
-showException (DynException dyn) =
-  case fromDynamic dyn of
-    Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
-    Just Interrupted      -> io (putStrLn "Interrupted.")
-    Just (CmdLineError s) -> io (putStrLn s)	 -- omit the location for CmdLineError
-    Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto
-    Just other_ghc_ex     -> io (print other_ghc_ex)
-
-showException other_exception
-  = io (putStrLn ("*** Exception: " ++ show other_exception))
-
-runStmt :: String -> GHCi (Maybe [Name])
-runStmt stmt
- | null (filter (not.isSpace) stmt) = return (Just [])
- | otherwise
- = do st <- getGHCiState
-      session <- getSession
-      result <- io $ withProgName (progname st) $ withArgs (args st) $
-	     	     GHC.runStmt session stmt
-      case result of
-	GHC.RunFailed      -> return Nothing
-	GHC.RunException e -> throw e  -- this is caught by runCommand(Eval)
-	GHC.RunOk names    -> return (Just names)
-
--- possibly print the type and revert CAFs after evaluating an expression
-finishEvalExpr mb_names
- = do b <- isOptionSet ShowType
-      session <- getSession
-      case mb_names of
-	Nothing    -> return ()      
-	Just names -> when b (mapM_ (showTypeOfName session) names)
-
-      flushInterpBuffers
-      io installSignalHandlers
-      b <- isOptionSet RevertCAFs
-      io (when b revertCAFs)
-      return True
-
-showTypeOfName :: Session -> Name -> GHCi ()
-showTypeOfName session n
-   = do maybe_tything <- io (GHC.lookupName session n)
-	case maybe_tything of
-	  Nothing    -> return ()
-	  Just thing -> showTyThing thing
-
-showForUser :: SDoc -> GHCi String
-showForUser doc = do
-  session <- getSession
-  unqual <- io (GHC.getPrintUnqual session)
-  return $! showSDocForUser unqual doc
-
-specialCommand :: String -> GHCi Bool
-specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
-specialCommand str = do
-  let (cmd,rest) = break isSpace str
-  maybe_cmd <- io (lookupCommand cmd)
-  case maybe_cmd of
-    Nothing -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n" 
-		                    ++ shortHelpText) >> return False)
-    Just (_,f,_,_) -> f (dropWhile isSpace rest)
-
-lookupCommand :: String -> IO (Maybe Command)
-lookupCommand str = do
-  cmds <- readIORef commands
-  -- look for exact match first, then the first prefix match
-  case [ c | c <- cmds, str == cmdName c ] of
-     c:_ -> return (Just c)
-     [] -> case [ c | c@(s,_,_,_) <- cmds, prefixMatch str s ] of
-     		[] -> return Nothing
-     		c:_ -> return (Just c)
-
------------------------------------------------------------------------------
--- To flush buffers for the *interpreted* computation we need
--- to refer to *its* stdout/stderr handles
-
-GLOBAL_VAR(flush_interp,       error "no flush_interp", IO ())
-GLOBAL_VAR(turn_off_buffering, error "no flush_stdout", IO ())
-
-no_buf_cmd = "System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering" ++
-	     " Prelude.>> System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering"
-flush_cmd  = "System.IO.hFlush System.IO.stdout Prelude.>> System.IO.hFlush IO.stderr"
-
-initInterpBuffering :: Session -> IO ()
-initInterpBuffering session
- = do maybe_hval <- GHC.compileExpr session no_buf_cmd
-	
-      case maybe_hval of
-	Just hval -> writeIORef turn_off_buffering (unsafeCoerce# hval :: IO ())
-	other	  -> panic "interactiveUI:setBuffering"
-	
-      maybe_hval <- GHC.compileExpr session flush_cmd
-      case maybe_hval of
-	Just hval -> writeIORef flush_interp (unsafeCoerce# hval :: IO ())
-	_         -> panic "interactiveUI:flush"
-
-      turnOffBuffering	-- Turn it off right now
-
-      return ()
-
-
-flushInterpBuffers :: GHCi ()
-flushInterpBuffers
- = io $ do Monad.join (readIORef flush_interp)
-           return ()
-
-turnOffBuffering :: IO ()
-turnOffBuffering
- = do Monad.join (readIORef turn_off_buffering)
-      return ()
-
------------------------------------------------------------------------------
--- Commands
-
-help :: String -> GHCi ()
-help _ = io (putStr helpText)
-
-info :: String -> GHCi ()
-info "" = throwDyn (CmdLineError "syntax: ':i <thing-you-want-info-about>'")
-info s  = do { let names = words s
-	     ; session <- getSession
-	     ; dflags <- getDynFlags
-	     ; let exts = dopt Opt_GlasgowExts dflags
-	     ; mapM_ (infoThing exts session) names }
-  where
-    infoThing exts session str = io $ do
-	names <- GHC.parseName session str
-	let filtered = filterOutChildren names
-	mb_stuffs <- mapM (GHC.getInfo session) filtered
-	unqual <- GHC.getPrintUnqual session
-	putStrLn (showSDocForUser unqual $
-     		   vcat (intersperse (text "") $
-		   [ pprInfo exts stuff | Just stuff <-  mb_stuffs ]))
-
-  -- Filter out names whose parent is also there Good
-  -- example is '[]', which is both a type and data
-  -- constructor in the same type
-filterOutChildren :: [Name] -> [Name]
-filterOutChildren names = filter (not . parent_is_there) names
- where parent_is_there n 
-	 | Just p <- GHC.nameParent_maybe n = p `elem` names
-	 | otherwise		           = False
-
-pprInfo exts (thing, fixity, insts)
-  =  pprTyThingInContextLoc exts thing 
-  $$ show_fixity fixity
-  $$ vcat (map GHC.pprInstance insts)
-  where
-    show_fixity fix 
-	| fix == GHC.defaultFixity = empty
-	| otherwise		   = ppr fix <+> ppr (GHC.getName thing)
-
------------------------------------------------------------------------------
--- Commands
-
-runMain :: String -> GHCi ()
-runMain args = do
-  let ss = concat $ intersperse "," (map (\ s -> ('"':s)++"\"") (toArgs args))
-  runCommand $ '[': ss ++ "] `System.Environment.withArgs` main"
-  return ()
-
-addModule :: [FilePath] -> GHCi ()
-addModule files = do
-  io (revertCAFs)			-- always revert CAFs on load/add.
-  files <- mapM expandPath files
-  targets <- mapM (\m -> io (GHC.guessTarget m Nothing)) files
-  session <- getSession
-  io (mapM_ (GHC.addTarget session) targets)
-  ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session
-
-changeDirectory :: String -> GHCi ()
-changeDirectory dir = do
-  session <- getSession
-  graph <- io (GHC.getModuleGraph session)
-  when (not (null graph)) $
-	io $ putStr "Warning: changing directory causes all loaded modules to be unloaded,\nbecause the search path has changed.\n"
-  io (GHC.setTargets session [])
-  io (GHC.load session LoadAllTargets)
-  setContextAfterLoad session []
-  io (GHC.workingDirectoryChanged session)
-  dir <- expandPath dir
-  io (setCurrentDirectory dir)
-
-defineMacro :: String -> GHCi ()
-defineMacro s = do
-  let (macro_name, definition) = break isSpace s
-  cmds <- io (readIORef commands)
-  if (null macro_name) 
-	then throwDyn (CmdLineError "invalid macro name") 
-	else do
-  if (macro_name `elem` map cmdName cmds)
-	then throwDyn (CmdLineError 
-		("command '" ++ macro_name ++ "' is already defined"))
-	else do
-
-  -- give the expression a type signature, so we can be sure we're getting
-  -- something of the right type.
-  let new_expr = '(' : definition ++ ") :: String -> IO String"
-
-  -- compile the expression
-  cms <- getSession
-  maybe_hv <- io (GHC.compileExpr cms new_expr)
-  case maybe_hv of
-     Nothing -> return ()
-     Just hv -> io (writeIORef commands --
-		    (cmds ++ [(macro_name, keepGoing (runMacro hv), False, completeNone)]))
-
-runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi ()
-runMacro fun s = do
-  str <- io ((unsafeCoerce# fun :: String -> IO String) s)
-  stringLoop (lines str)
-
-undefineMacro :: String -> GHCi ()
-undefineMacro macro_name = do
-  cmds <- io (readIORef commands)
-  if (macro_name `elem` map cmdName builtin_commands) 
-	then throwDyn (CmdLineError
-		("command '" ++ macro_name ++ "' cannot be undefined"))
-	else do
-  if (macro_name `notElem` map cmdName cmds) 
-	then throwDyn (CmdLineError 
-		("command '" ++ macro_name ++ "' not defined"))
-	else do
-  io (writeIORef commands (filter ((/= macro_name) . cmdName) cmds))
-
-
-loadModule :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
-loadModule fs = timeIt (loadModule' fs)
-
-loadModule_ :: [FilePath] -> GHCi ()
-loadModule_ fs = do loadModule (zip fs (repeat Nothing)); return ()
-
-loadModule' :: [(FilePath, Maybe Phase)] -> GHCi SuccessFlag
-loadModule' files = do
-  session <- getSession
-
-  -- unload first
-  io (GHC.setTargets session [])
-  io (GHC.load session LoadAllTargets)
-
-  -- expand tildes
-  let (filenames, phases) = unzip files
-  exp_filenames <- mapM expandPath filenames
-  let files' = zip exp_filenames phases
-  targets <- io (mapM (uncurry GHC.guessTarget) files')
-
-  -- NOTE: we used to do the dependency anal first, so that if it
-  -- fails we didn't throw away the current set of modules.  This would
-  -- require some re-working of the GHC interface, so we'll leave it
-  -- as a ToDo for now.
-
-  io (GHC.setTargets session targets)
-  ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session
-  return ok
-
-checkModule :: String -> GHCi ()
-checkModule m = do
-  let modl = GHC.mkModule m
-  session <- getSession
-  result <- io (GHC.checkModule session modl)
-  case result of
-    Nothing -> io $ putStrLn "Nothing"
-    Just r  -> io $ putStrLn (showSDoc (
-	case checkedModuleInfo r of
-	   Just cm | Just scope <- GHC.modInfoTopLevelScope cm -> 
-		let
-		    (local,global) = partition ((== modl) . GHC.nameModule) scope
-		in
-			(text "global names: " <+> ppr global) $$
-		        (text "local  names: " <+> ppr local)
-	   _ -> empty))
-  afterLoad (successIf (isJust result)) session
-
-reloadModule :: String -> GHCi ()
-reloadModule "" = do
-  io (revertCAFs)		-- always revert CAFs on reload.
-  session <- getSession
-  ok <- io (GHC.load session LoadAllTargets)
-  afterLoad ok session
-reloadModule m = do
-  io (revertCAFs)		-- always revert CAFs on reload.
-  session <- getSession
-  ok <- io (GHC.load session (LoadUpTo (GHC.mkModule m)))
-  afterLoad ok session
-
-afterLoad ok session = do
-  io (revertCAFs)  -- always revert CAFs on load.
-  graph <- io (GHC.getModuleGraph session)
-  graph' <- filterM (io . GHC.isLoaded session . GHC.ms_mod) graph
-  setContextAfterLoad session graph'
-  modulesLoadedMsg ok (map GHC.ms_mod graph')
-#if defined(GHCI) && defined(BREAKPOINT)
-  io (extendLinkEnv [(breakpointJumpName,unsafeCoerce# (jumpFunction session))])
-#endif
-
-setContextAfterLoad session [] = do
-  io (GHC.setContext session [] [prelude_mod])
-setContextAfterLoad session ms = do
-  -- load a target if one is available, otherwise load the topmost module.
-  targets <- io (GHC.getTargets session)
-  case [ m | Just m <- map (findTarget ms) targets ] of
-	[]    -> 
-	  let graph' = flattenSCCs (GHC.topSortModuleGraph True ms Nothing) in
-	  load_this (last graph')	  
-	(m:_) -> 
-	  load_this m
- where
-   findTarget ms t
-    = case filter (`matches` t) ms of
-	[]    -> Nothing
-	(m:_) -> Just m
-
-   summary `matches` Target (TargetModule m) _
-	= GHC.ms_mod summary == m
-   summary `matches` Target (TargetFile f _) _ 
-	| Just f' <- GHC.ml_hs_file (GHC.ms_location summary)	= f == f'
-   summary `matches` target
-	= False
-
-   load_this summary | m <- GHC.ms_mod summary = do
-	b <- io (GHC.moduleIsInterpreted session m)
-	if b then io (GHC.setContext session [m] []) 
-       	     else io (GHC.setContext session []  [prelude_mod,m])
-
-
-modulesLoadedMsg :: SuccessFlag -> [Module] -> GHCi ()
-modulesLoadedMsg ok mods = do
-  dflags <- getDynFlags
-  when (verbosity dflags > 0) $ do
-   let mod_commas 
-	| null mods = text "none."
-	| otherwise = hsep (
-	    punctuate comma (map pprModule mods)) <> text "."
-   case ok of
-    Failed ->
-       io (putStrLn (showSDoc (text "Failed, modules loaded: " <> mod_commas)))
-    Succeeded  ->
-       io (putStrLn (showSDoc (text "Ok, modules loaded: " <> mod_commas)))
-
-
-typeOfExpr :: String -> GHCi ()
-typeOfExpr str 
-  = do cms <- getSession
-       maybe_ty <- io (GHC.exprType cms str)
-       case maybe_ty of
-	  Nothing -> return ()
-	  Just ty -> do ty' <- cleanType ty
-			tystr <- showForUser (ppr ty')
-		        io (putStrLn (str ++ " :: " ++ tystr))
-
-kindOfType :: String -> GHCi ()
-kindOfType str 
-  = do cms <- getSession
-       maybe_ty <- io (GHC.typeKind cms str)
-       case maybe_ty of
-	  Nothing    -> return ()
-	  Just ty    -> do tystr <- showForUser (ppr ty)
-		           io (putStrLn (str ++ " :: " ++ tystr))
-
-quit :: String -> GHCi Bool
-quit _ = return True
-
-shellEscape :: String -> GHCi Bool
-shellEscape str = io (system str >> return False)
-
------------------------------------------------------------------------------
--- create tags file for currently loaded modules.
-
-createETagsFileCmd, createCTagsFileCmd :: String -> GHCi ()
-
-createCTagsFileCmd ""   = ghciCreateTagsFile CTags "tags"
-createCTagsFileCmd file = ghciCreateTagsFile CTags file
-
-createETagsFileCmd ""    = ghciCreateTagsFile ETags "TAGS"
-createETagsFileCmd file  = ghciCreateTagsFile ETags file
-
-data TagsKind = ETags | CTags
-
-ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
-ghciCreateTagsFile kind file = do
-  session <- getSession
-  io $ createTagsFile session kind file
-
--- ToDo: 
--- 	- remove restriction that all modules must be interpreted
---	  (problem: we don't know source locations for entities unless
---	  we compiled the module.
---
---	- extract createTagsFile so it can be used from the command-line
---	  (probably need to fix first problem before this is useful).
---
-createTagsFile :: Session -> TagsKind -> FilePath -> IO ()
-createTagsFile session tagskind tagFile = do
-  graph <- GHC.getModuleGraph session
-  let ms = map GHC.ms_mod graph
-      tagModule m = do 
-        is_interpreted <- GHC.moduleIsInterpreted session m
-        -- should we just skip these?
-        when (not is_interpreted) $
-          throwDyn (CmdLineError ("module '" ++ moduleString m ++ "' is not interpreted"))
-
-        mbModInfo <- GHC.getModuleInfo session m
-        let unqual 
-	      | Just modinfo <- mbModInfo,
-		Just unqual <- GHC.modInfoPrintUnqualified modinfo = unqual
-	      | otherwise = GHC.alwaysQualify
-
-        case mbModInfo of 
-          Just modInfo -> return $! listTags unqual modInfo 
-          _            -> return []
-
-  mtags <- mapM tagModule ms
-  either_res <- collateAndWriteTags tagskind tagFile $ concat mtags
-  case either_res of
-    Left e  -> hPutStrLn stderr $ ioeGetErrorString e
-    Right _ -> return ()
-
-listTags :: PrintUnqualified -> GHC.ModuleInfo -> [TagInfo]
-listTags unqual modInfo =
-	   [ tagInfo unqual name loc 
-           | name <- GHC.modInfoExports modInfo
-           , let loc = nameSrcLoc name
-           , isGoodSrcLoc loc
-           ]
-
-type TagInfo = (String -- tag name
-               ,String -- file name
-               ,Int    -- line number
-               ,Int    -- column number
-               )
-
--- get tag info, for later translation into Vim or Emacs style
-tagInfo :: PrintUnqualified -> Name -> SrcLoc -> TagInfo
-tagInfo unqual name loc
-    = ( showSDocForUser unqual $ pprOccName (nameOccName name)
-      , showSDocForUser unqual $ ftext (srcLocFile loc)
-      , srcLocLine loc
-      , srcLocCol loc
-      )
-
-collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
-collateAndWriteTags CTags file tagInfos = do -- ctags style, Vim et al
-  let tags = unlines $ sortLe (<=) $ nub $ map showTag tagInfos
-  IO.try (writeFile file tags)
-collateAndWriteTags ETags file tagInfos = do -- etags style, Emacs/XEmacs
-  let byFile op (_,f1,_,_) (_,f2,_,_) = f1 `op` f2
-      groups = groupBy (byFile (==)) $ sortLe (byFile (<=)) tagInfos
-  tagGroups <- mapM tagFileGroup groups 
-  IO.try (writeFile file $ concat tagGroups)
-  where
-    tagFileGroup group@[] = throwDyn (CmdLineError "empty tag file group??")
-    tagFileGroup group@((_,fileName,_,_):_) = do
-      file <- readFile fileName -- need to get additional info from sources..
-      let byLine (_,_,l1,_) (_,_,l2,_) = l1 <= l2
-          sortedGroup = sortLe byLine group
-          tags = unlines $ perFile sortedGroup 1 0 $ lines file
-      return $ "\x0c\n" ++ fileName ++ "," ++ show (length tags) ++ "\n" ++ tags
-    perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos (line:lines) | lNo>count =
-      perFile (tagInfo:tags) (count+1) (pos+length line) lines
-    perFile (tagInfo@(tag,file,lNo,colNo):tags) count pos lines@(line:_) | lNo==count =
-      showETag tagInfo line pos : perFile tags count pos lines
-    perFile tags count pos lines = []
-
--- simple ctags format, for Vim et al
-showTag :: TagInfo -> String
-showTag (tag,file,lineNo,colNo)
-    =  tag ++ "\t" ++ file ++ "\t" ++ show lineNo
-
--- etags format, for Emacs/XEmacs
-showETag :: TagInfo -> String -> Int -> String
-showETag (tag,file,lineNo,colNo) line charPos
-    =  take colNo line ++ tag
-    ++ "\x7f" ++ tag
-    ++ "\x01" ++ show lineNo
-    ++ "," ++ show charPos
-
------------------------------------------------------------------------------
--- Browsing a module's contents
-
-browseCmd :: String -> GHCi ()
-browseCmd m = 
-  case words m of
-    ['*':m] | looksLikeModuleName m -> browseModule m False
-    [m]     | looksLikeModuleName m -> browseModule m True
-    _ -> throwDyn (CmdLineError "syntax:  :browse <module>")
-
-browseModule m exports_only = do
-  s <- getSession
-
-  let modl = GHC.mkModule m
-  is_interpreted <- io (GHC.moduleIsInterpreted s modl)
-  when (not is_interpreted && not exports_only) $
-	throwDyn (CmdLineError ("module '" ++ m ++ "' is not interpreted"))
-
-  -- Temporarily set the context to the module we're interested in,
-  -- just so we can get an appropriate PrintUnqualified
-  (as,bs) <- io (GHC.getContext s)
-  io (if exports_only then GHC.setContext s [] [prelude_mod,modl]
-		      else GHC.setContext s [modl] [])
-  unqual <- io (GHC.getPrintUnqual s)
-  io (GHC.setContext s as bs)
-
-  mb_mod_info <- io $ GHC.getModuleInfo s modl
-  case mb_mod_info of
-    Nothing -> throwDyn (CmdLineError ("unknown module: " ++ m))
-    Just mod_info -> do
-        let names
-	       | exports_only = GHC.modInfoExports mod_info
-	       | otherwise    = fromMaybe [] (GHC.modInfoTopLevelScope mod_info)
-
-	    filtered = filterOutChildren names
-	
-        things <- io $ mapM (GHC.lookupName s) filtered
-
-        dflags <- getDynFlags
-	let exts = dopt Opt_GlasgowExts dflags
-	io (putStrLn (showSDocForUser unqual (
-		vcat (map (pprTyThingInContext exts) (catMaybes things))
-	   )))
-	-- ToDo: modInfoInstances currently throws an exception for
-	-- package modules.  When it works, we can do this:
-	--	$$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
-
------------------------------------------------------------------------------
--- Setting the module context
-
-setContext str
-  | all sensible mods = fn mods
-  | otherwise = throwDyn (CmdLineError "syntax:  :module [+/-] [*]M1 ... [*]Mn")
-  where
-    (fn, mods) = case str of 
-			'+':stuff -> (addToContext,      words stuff)
-			'-':stuff -> (removeFromContext, words stuff)
-			stuff     -> (newContext,        words stuff) 
-
-    sensible ('*':m) = looksLikeModuleName m
-    sensible m       = looksLikeModuleName m
-
-newContext mods = do
-  session <- getSession
-  (as,bs) <- separate session mods [] []
-  let bs' = if null as && prelude_mod `notElem` bs then prelude_mod:bs else bs
-  io (GHC.setContext session as bs')
-
-separate :: Session -> [String] -> [Module] -> [Module]
-  -> GHCi ([Module],[Module])
-separate session []           as bs = return (as,bs)
-separate session (('*':m):ms) as bs = do
-   let modl = GHC.mkModule m
-   b <- io (GHC.moduleIsInterpreted session modl)
-   if b then separate session ms (modl:as) bs
-   	else throwDyn (CmdLineError ("module '" ++ m ++ "' is not interpreted"))
-separate session (m:ms)       as bs = separate session ms as (GHC.mkModule m:bs)
-
-prelude_mod = GHC.mkModule "Prelude"
-
-
-addToContext mods = do
-  cms <- getSession
-  (as,bs) <- io (GHC.getContext cms)
-
-  (as',bs') <- separate cms mods [] []
-
-  let as_to_add = as' \\ (as ++ bs)
-      bs_to_add = bs' \\ (as ++ bs)
-
-  io (GHC.setContext cms (as ++ as_to_add) (bs ++ bs_to_add))
-
-
-removeFromContext mods = do
-  cms <- getSession
-  (as,bs) <- io (GHC.getContext cms)
-
-  (as_to_remove,bs_to_remove) <- separate cms mods [] []
-
-  let as' = as \\ (as_to_remove ++ bs_to_remove)
-      bs' = bs \\ (as_to_remove ++ bs_to_remove)
-
-  io (GHC.setContext cms as' bs')
-
-----------------------------------------------------------------------------
--- Code for `:set'
-
--- set options in the interpreter.  Syntax is exactly the same as the
--- ghc command line, except that certain options aren't available (-C,
--- -E etc.)
---
--- This is pretty fragile: most options won't work as expected.  ToDo:
--- figure out which ones & disallow them.
-
-setCmd :: String -> GHCi ()
-setCmd ""
-  = do st <- getGHCiState
-       let opts = options st
-       io $ putStrLn (showSDoc (
-   	      text "options currently set: " <> 
-   	      if null opts
-   		   then text "none."
-   		   else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
-   	   ))
-setCmd str
-  = case words str of
-	("args":args) -> setArgs args
-	("prog":prog) -> setProg prog
-        ("prompt":prompt) -> setPrompt (dropWhile isSpace $ drop 6 $ dropWhile isSpace str)
-	wds -> setOptions wds
-
-setArgs args = do
-  st <- getGHCiState
-  setGHCiState st{ args = args }
-
-setProg [prog] = do
-  st <- getGHCiState
-  setGHCiState st{ progname = prog }
-setProg _ = do
-  io (hPutStrLn stderr "syntax: :set prog <progname>")
-
-setPrompt value = do
-  st <- getGHCiState
-  if null value
-      then io $ hPutStrLn stderr $ "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
-      else setGHCiState st{ prompt = remQuotes value }
-  where
-     remQuotes ('\"':xs) | not (null xs) && last xs == '\"' = init xs
-     remQuotes x = x
-
-setOptions wds =
-   do -- first, deal with the GHCi opts (+s, +t, etc.)
-      let (plus_opts, minus_opts)  = partition isPlus wds
-      mapM_ setOpt plus_opts
-
-      -- then, dynamic flags
-      dflags <- getDynFlags
-      (dflags',leftovers) <- io $ GHC.parseDynamicFlags dflags minus_opts
-      setDynFlags dflags'
-
-        -- update things if the users wants more packages
-{- TODO:
-        let new_packages = pkgs_after \\ pkgs_before
-        when (not (null new_packages)) $
-  	   newPackages new_packages
--}
-
-      if (not (null leftovers))
-		then throwDyn (CmdLineError ("unrecognised flags: " ++ 
-						unwords leftovers))
-		else return ()
-
-
-unsetOptions :: String -> GHCi ()
-unsetOptions str
-  = do -- first, deal with the GHCi opts (+s, +t, etc.)
-       let opts = words str
-	   (minus_opts, rest1) = partition isMinus opts
-	   (plus_opts, rest2)  = partition isPlus rest1
-
-       if (not (null rest2)) 
-	  then io (putStrLn ("unknown option: '" ++ head rest2 ++ "'"))
-	  else do
-
-       mapM_ unsetOpt plus_opts
- 
-       -- can't do GHC flags for now
-       if (not (null minus_opts))
-	  then throwDyn (CmdLineError "can't unset GHC command-line flags")
-	  else return ()
-
-isMinus ('-':s) = True
-isMinus _ = False
-
-isPlus ('+':s) = True
-isPlus _ = False
-
-setOpt ('+':str)
-  = case strToGHCiOpt str of
-	Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
-	Just o  -> setOption o
-
-unsetOpt ('+':str)
-  = case strToGHCiOpt str of
-	Nothing -> io (putStrLn ("unknown option: '" ++ str ++ "'"))
-	Just o  -> unsetOption o
-
-strToGHCiOpt :: String -> (Maybe GHCiOption)
-strToGHCiOpt "s" = Just ShowTiming
-strToGHCiOpt "t" = Just ShowType
-strToGHCiOpt "r" = Just RevertCAFs
-strToGHCiOpt _   = Nothing
-
-optToStr :: GHCiOption -> String
-optToStr ShowTiming = "s"
-optToStr ShowType   = "t"
-optToStr RevertCAFs = "r"
-
-{- ToDo
-newPackages new_pkgs = do	-- The new packages are already in v_Packages
-  session <- getSession
-  io (GHC.setTargets session [])
-  io (GHC.load session Nothing)
-  dflags   <- getDynFlags
-  io (linkPackages dflags new_pkgs)
-  setContextAfterLoad []
--}
-
--- ---------------------------------------------------------------------------
--- code for `:show'
-
-showCmd str =
-  case words str of
-	["modules" ] -> showModules
-	["bindings"] -> showBindings
-	["linker"]   -> io showLinkerState
-	_ -> throwDyn (CmdLineError "syntax:  :show [modules|bindings]")
-
-showModules = do
-  session <- getSession
-  let show_one ms = do m <- io (GHC.showModule session ms)
-		       io (putStrLn m)
-  graph <- io (GHC.getModuleGraph session)
-  mapM_ show_one graph
-
-showBindings = do
-  s <- getSession
-  unqual <- io (GHC.getPrintUnqual s)
-  bindings <- io (GHC.getBindings s)
-  mapM_ showTyThing bindings
-  return ()
-
-showTyThing (AnId id) = do 
-  ty' <- cleanType (GHC.idType id)
-  str <- showForUser (ppr id <> text " :: " <> ppr ty')
-  io (putStrLn str)
-showTyThing _  = return ()
-
--- if -fglasgow-exts is on we show the foralls, otherwise we don't.
-cleanType :: Type -> GHCi Type
-cleanType ty = do
-  dflags <- getDynFlags
-  if dopt Opt_GlasgowExts dflags 
-	then return ty
-	else return $! GHC.dropForAlls ty
-
--- -----------------------------------------------------------------------------
--- Completion
-
-completeNone :: String -> IO [String]
-completeNone w = return []
-
-#ifdef USE_READLINE
-completeWord :: String -> Int -> Int -> IO (Maybe (String, [String]))
-completeWord w start end = do
-  line <- Readline.getLineBuffer
-  case w of 
-     ':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
-     _other
-	| Just c <- is_cmd line -> do
-	   maybe_cmd <- lookupCommand c
-           let (n,w') = selectWord (words' 0 line)
-	   case maybe_cmd of
-	     Nothing -> return Nothing
-	     Just (_,_,False,complete) -> wrapCompleter complete w
-	     Just (_,_,True,complete) -> let complete' w = do rets <- complete w
-                                                              return (map (drop n) rets)
-                                         in wrapCompleter complete' w'
-	| otherwise     -> do
-		--printf "complete %s, start = %d, end = %d\n" w start end
-		wrapCompleter completeIdentifier w
-    where words' _ [] = []
-          words' n str = let (w,r) = break isSpace str
-                             (s,r') = span isSpace r
-                         in (n,w):words' (n+length w+length s) r'
-          -- In a Haskell expression we want to parse 'a-b' as three words
-          -- where a compiler flag (ie. -fno-monomorphism-restriction) should
-          -- only be a single word.
-          selectWord [] = (0,w)
-          selectWord ((offset,x):xs)
-              | offset+length x >= start = (start-offset,take (end-offset) x)
-              | otherwise = selectWord xs
-
-is_cmd line 
- | ((':':w) : _) <- words (dropWhile isSpace line) = Just w
- | otherwise = Nothing
-
-completeCmd w = do
-  cmds <- readIORef commands
-  return (filter (w `isPrefixOf`) (map (':':) (map cmdName cmds)))
-
-completeMacro w = do
-  cmds <- readIORef commands
-  let cmds' = [ cmd | cmd <- map cmdName cmds, cmd `elem` map cmdName builtin_commands ]
-  return (filter (w `isPrefixOf`) cmds')
-
-completeIdentifier w = do
-  s <- restoreSession
-  rdrs <- GHC.getRdrNamesInScope s
-  return (filter (w `isPrefixOf`) (map (showSDoc.ppr) rdrs))
-
-completeModule w = do
-  s <- restoreSession
-  dflags <- GHC.getSessionDynFlags s
-  let pkg_mods = allExposedModules dflags
-  return (filter (w `isPrefixOf`) (map (showSDoc.ppr) pkg_mods))
-
-completeHomeModule w = do
-  s <- restoreSession
-  g <- GHC.getModuleGraph s
-  let home_mods = map GHC.ms_mod g
-  return (filter (w `isPrefixOf`) (map (showSDoc.ppr) home_mods))
-
-completeSetOptions w = do
-  return (filter (w `isPrefixOf`) options)
-    where options = "args":"prog":allFlags
-
-completeFilename = Readline.filenameCompletionFunction
-
-completeHomeModuleOrFile = unionComplete completeHomeModule completeFilename
-
-unionComplete :: (String -> IO [String]) -> (String -> IO [String]) -> String -> IO [String]
-unionComplete f1 f2 w = do
-  s1 <- f1 w
-  s2 <- f2 w
-  return (s1 ++ s2)
-
-wrapCompleter :: (String -> IO [String]) -> String -> IO (Maybe (String,[String]))
-wrapCompleter fun w =  do
-  strs <- fun w
-  case strs of
-    []  -> return Nothing
-    [x] -> return (Just (x,[]))
-    xs  -> case getCommonPrefix xs of
-		""   -> return (Just ("",xs))
-		pref -> return (Just (pref,xs))
-
-getCommonPrefix :: [String] -> String
-getCommonPrefix [] = ""
-getCommonPrefix (s:ss) = foldl common s ss
-  where common s "" = s
-	common "" s = ""
-	common (c:cs) (d:ds)
-	   | c == d = c : common cs ds
-	   | otherwise = ""
-
-allExposedModules :: DynFlags -> [Module]
-allExposedModules dflags 
- = map GHC.mkModule (concat (map exposedModules (filter exposed (eltsUFM pkg_db))))
- where
-  pkg_db = pkgIdMap (pkgState dflags)
-#else
-completeCmd        = completeNone
-completeMacro      = completeNone
-completeIdentifier = completeNone
-completeModule     = completeNone
-completeHomeModule = completeNone
-completeSetOptions = completeNone
-completeFilename   = completeNone
-completeHomeModuleOrFile=completeNone
-#endif
-
------------------------------------------------------------------------------
--- GHCi monad
-
-data GHCiState = GHCiState
-     { 
-	progname       :: String,
-	args	       :: [String],
-        prompt         :: String,
-	session        :: GHC.Session,
-	options        :: [GHCiOption]
-     }
-
-data GHCiOption 
-	= ShowTiming		-- show time/allocs after evaluation
-	| ShowType		-- show the type of expressions
-	| RevertCAFs		-- revert CAFs after every evaluation
-	deriving Eq
-
-newtype GHCi a = GHCi { unGHCi :: IORef GHCiState -> IO a }
-
-startGHCi :: GHCi a -> GHCiState -> IO a
-startGHCi g state = do ref <- newIORef state; unGHCi g ref
-
-instance Monad GHCi where
-  (GHCi m) >>= k  =  GHCi $ \s -> m s >>= \a -> unGHCi (k a) s
-  return a  = GHCi $ \s -> return a
-
-ghciHandleDyn :: Typeable t => (t -> GHCi a) -> GHCi a -> GHCi a
-ghciHandleDyn h (GHCi m) = GHCi $ \s -> 
-   Exception.catchDyn (m s) (\e -> unGHCi (h e) s)
-
-getGHCiState   = GHCi $ \r -> readIORef r
-setGHCiState s = GHCi $ \r -> writeIORef r s
-
--- for convenience...
-getSession = getGHCiState >>= return . session
-
-GLOBAL_VAR(saved_sess, no_saved_sess, Session)
-no_saved_sess = error "no saved_ses"
-saveSession = getSession >>= io . writeIORef saved_sess
-splatSavedSession = io (writeIORef saved_sess no_saved_sess)
-restoreSession = readIORef saved_sess
-
-getDynFlags = do
-  s <- getSession
-  io (GHC.getSessionDynFlags s)
-setDynFlags dflags = do 
-  s <- getSession 
-  io (GHC.setSessionDynFlags s dflags)
-
-isOptionSet :: GHCiOption -> GHCi Bool
-isOptionSet opt
- = do st <- getGHCiState
-      return (opt `elem` options st)
-
-setOption :: GHCiOption -> GHCi ()
-setOption opt
- = do st <- getGHCiState
-      setGHCiState (st{ options = opt : filter (/= opt) (options st) })
-
-unsetOption :: GHCiOption -> GHCi ()
-unsetOption opt
- = do st <- getGHCiState
-      setGHCiState (st{ options = filter (/= opt) (options st) })
-
-io :: IO a -> GHCi a
-io m = GHCi { unGHCi = \s -> m >>= return }
-
------------------------------------------------------------------------------
--- recursive exception handlers
-
--- Don't forget to unblock async exceptions in the handler, or if we're
--- in an exception loop (eg. let a = error a in a) the ^C exception
--- may never be delivered.  Thanks to Marcin for pointing out the bug.
-
-ghciHandle :: (Exception -> GHCi a) -> GHCi a -> GHCi a
-ghciHandle h (GHCi m) = GHCi $ \s -> 
-   Exception.catch (m s) 
-	(\e -> unGHCi (ghciUnblock (h e)) s)
-
-ghciUnblock :: GHCi a -> GHCi a
-ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
-
------------------------------------------------------------------------------
--- timing & statistics
-
-timeIt :: GHCi a -> GHCi a
-timeIt action
-  = do b <- isOptionSet ShowTiming
-       if not b 
-	  then action 
-	  else do allocs1 <- io $ getAllocations
-		  time1   <- io $ getCPUTime
-		  a <- action
-		  allocs2 <- io $ getAllocations
-		  time2   <- io $ getCPUTime
-		  io $ printTimes (fromIntegral (allocs2 - allocs1)) 
-				  (time2 - time1)
-		  return a
-
-foreign import ccall unsafe "getAllocations" getAllocations :: IO Int64
-	-- defined in ghc/rts/Stats.c
-
-printTimes :: Integer -> Integer -> IO ()
-printTimes allocs psecs
-   = do let secs = (fromIntegral psecs / (10^12)) :: Float
-	    secs_str = showFFloat (Just 2) secs
-	putStrLn (showSDoc (
-		 parens (text (secs_str "") <+> text "secs" <> comma <+> 
-			 text (show allocs) <+> text "bytes")))
-
------------------------------------------------------------------------------
--- reverting CAFs
-	
-revertCAFs :: IO ()
-revertCAFs = do
-  rts_revertCAFs
-  turnOffBuffering
-	-- Have to turn off buffering again, because we just 
-	-- reverted stdout, stderr & stdin to their defaults.
-
-foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()  
-	-- Make it "safe", just in case
-
--- -----------------------------------------------------------------------------
--- Utils
-
-expandPath :: String -> GHCi String
-expandPath path = 
-  case dropWhile isSpace path of
-   ('~':d) -> do
-	tilde <- io (getEnv "HOME")	-- will fail if HOME not defined
-	return (tilde ++ '/':d)
-   other -> 
-	return other
diff --git a/ghc/compiler/ghci/Linker.lhs b/ghc/compiler/ghci/Linker.lhs
deleted file mode 100644
index 3a5ecf8a6d..0000000000
--- a/ghc/compiler/ghci/Linker.lhs
+++ /dev/null
@@ -1,927 +0,0 @@
-%
-% (c) The University of Glasgow 2005
-%
-
--- --------------------------------------
--- 	The dynamic linker for GHCi      
--- --------------------------------------
-
-This module deals with the top-level issues of dynamic linking,
-calling the object-code linker and the byte-code linker where
-necessary.
-
-
-\begin{code}
-
-{-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}
-
-module Linker ( HValue, showLinkerState,
-		linkExpr, unload, extendLinkEnv, withExtendedLinkEnv,
-                extendLoadedPkgs,
-		linkPackages,initDynLinker
-	) where
-
-#include "HsVersions.h"
-
-import ObjLink		( loadDLL, loadObj, unloadObj, resolveObjs, initObjLinker )
-import ByteCodeLink	( HValue, ClosureEnv, extendClosureEnv, linkBCO )
-import ByteCodeItbls	( ItblEnv )
-import ByteCodeAsm	( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..))
-
-import Packages
-import DriverPhases	( isObjectFilename, isDynLibFilename )
-import Finder		( findModule, findObjectLinkableMaybe, FindResult(..) )
-import HscTypes
-import Name		( Name, nameModule, isExternalName, isWiredInName )
-import NameEnv
-import NameSet		( nameSetToList )
-import Module
-import ListSetOps	( minusList )
-import DynFlags		( DynFlags(..), getOpts )
-import BasicTypes	( SuccessFlag(..), succeeded, failed )
-import Outputable
-import Panic            ( GhcException(..) )
-import Util             ( zipLazy, global, joinFileExt, joinFileName, suffixOf )
-import StaticFlags	( v_Ld_inputs )
-import ErrUtils         ( debugTraceMsg )
-
--- Standard libraries
-import Control.Monad	( when, filterM, foldM )
-
-import Data.IORef	( IORef, readIORef, writeIORef, modifyIORef )
-import Data.List	( partition, nub )
-
-import System.IO	( putStr, putStrLn, hPutStrLn, stderr, fixIO )
-import System.Directory	( doesFileExist )
-
-import Control.Exception ( block, throwDyn, bracket )
-import Maybe		( isJust, fromJust )
-
-#if __GLASGOW_HASKELL__ >= 503
-import GHC.IOBase	( IO(..) )
-#else
-import PrelIOBase	( IO(..) )
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-			The Linker's state
-%*									*
-%************************************************************************
-
-The persistent linker state *must* match the actual state of the 
-C dynamic linker at all times, so we keep it in a private global variable.
-
-
-The PersistentLinkerState maps Names to actual closures (for
-interpreted code only), for use during linking.
-
-\begin{code}
-GLOBAL_VAR(v_PersistentLinkerState, panic "Dynamic linker not initialised", PersistentLinkerState)
-GLOBAL_VAR(v_InitLinkerDone, False, Bool)	-- Set True when dynamic linker is initialised
-
-data PersistentLinkerState
-   = PersistentLinkerState {
-
-	-- Current global mapping from Names to their true values
-        closure_env :: ClosureEnv,
-
-	-- The current global mapping from RdrNames of DataCons to
-	-- info table addresses.
-	-- When a new Unlinked is linked into the running image, or an existing
-	-- module in the image is replaced, the itbl_env must be updated
-	-- appropriately.
-        itbl_env    :: ItblEnv,
-
-	-- The currently loaded interpreted modules (home package)
-	bcos_loaded :: [Linkable],
-
-	-- And the currently-loaded compiled modules (home package)
-	objs_loaded :: [Linkable],
-
-	-- The currently-loaded packages; always object code
-	-- Held, as usual, in dependency order; though I am not sure if
-	-- that is really important
-	pkgs_loaded :: [PackageId]
-     }
-
-emptyPLS :: DynFlags -> PersistentLinkerState
-emptyPLS dflags = PersistentLinkerState { 
-			closure_env = emptyNameEnv,
-			itbl_env    = emptyNameEnv,
-			pkgs_loaded = init_pkgs,
-			bcos_loaded = [],
-			objs_loaded = [] }
-  -- Packages that don't need loading, because the compiler 
-  -- shares them with the interpreted program.
-  --
-  -- The linker's symbol table is populated with RTS symbols using an
-  -- explicit list.  See rts/Linker.c for details.
-  where init_pkgs
-	  | ExtPackage rts_id <- rtsPackageId (pkgState dflags) = [rts_id]
-	  | otherwise = []
-\end{code}
-
-\begin{code}
-extendLoadedPkgs :: [PackageId] -> IO ()
-extendLoadedPkgs pkgs
-    = modifyIORef v_PersistentLinkerState (\s -> s{pkgs_loaded = pkgs ++ pkgs_loaded s})
-
-extendLinkEnv :: [(Name,HValue)] -> IO ()
--- Automatically discards shadowed bindings
-extendLinkEnv new_bindings
-  = do	pls <- readIORef v_PersistentLinkerState
-	let new_closure_env = extendClosureEnv (closure_env pls) new_bindings
-	    new_pls = pls { closure_env = new_closure_env }
-	writeIORef v_PersistentLinkerState new_pls
-
-withExtendedLinkEnv :: [(Name,HValue)] -> IO a -> IO a
-withExtendedLinkEnv new_env action
-    = bracket set_new_env
-              reset_old_env
-              (const action)
-    where set_new_env = do pls <- readIORef v_PersistentLinkerState
-                           let new_closure_env = extendClosureEnv (closure_env pls) new_env
-                               new_pls = pls { closure_env = new_closure_env }
-                           writeIORef v_PersistentLinkerState new_pls
-                           return pls
-          reset_old_env pls = writeIORef v_PersistentLinkerState pls
-
--- filterNameMap removes from the environment all entries except 
--- 	those for a given set of modules;
--- Note that this removes all *local* (i.e. non-isExternal) names too 
---	(these are the temporary bindings from the command line).
--- Used to filter both the ClosureEnv and ItblEnv
-
-filterNameMap :: [Module] -> NameEnv (Name, a) -> NameEnv (Name, a)
-filterNameMap mods env 
-   = filterNameEnv keep_elt env
-   where
-     keep_elt (n,_) = isExternalName n 
-		      && (nameModule n `elem` mods)
-\end{code}
-
-
-\begin{code}
-showLinkerState :: IO ()
--- Display the persistent linker state
-showLinkerState
-  = do pls <- readIORef v_PersistentLinkerState
-       printDump (vcat [text "----- Linker state -----",
-			text "Pkgs:" <+> ppr (pkgs_loaded pls),
-			text "Objs:" <+> ppr (objs_loaded pls),
-			text "BCOs:" <+> ppr (bcos_loaded pls)])
-\end{code}
-			
-	
-
-
-%************************************************************************
-%*									*
-\subsection{Initialisation}
-%*									*
-%************************************************************************
-
-We initialise the dynamic linker by
-
-a) calling the C initialisation procedure
-
-b) Loading any packages specified on the command line,
-   now held in v_ExplicitPackages
-
-c) Loading any packages specified on the command line,
-   now held in the -l options in v_Opt_l
-
-d) Loading any .o/.dll files specified on the command line,
-   now held in v_Ld_inputs
-
-e) Loading any MacOS frameworks
-
-\begin{code}
-initDynLinker :: DynFlags -> IO ()
--- This function is idempotent; if called more than once, it does nothing
--- This is useful in Template Haskell, where we call it before trying to link
-initDynLinker dflags
-  = do	{ done <- readIORef v_InitLinkerDone
-	; if done then return () 
-		  else do { writeIORef v_InitLinkerDone True
-			  ; reallyInitDynLinker dflags }
-	}
-
-reallyInitDynLinker dflags
-  = do  {  -- Initialise the linker state
-	; writeIORef v_PersistentLinkerState (emptyPLS dflags)
-
-	 	-- (a) initialise the C dynamic linker
-	; initObjLinker 
-
-		-- (b) Load packages from the command-line
-	; linkPackages dflags (explicitPackages (pkgState dflags))
-
-	   	-- (c) Link libraries from the command-line
-	; let optl = getOpts dflags opt_l
-	; let minus_ls = [ lib | '-':'l':lib <- optl ]
-
-	   	-- (d) Link .o files from the command-line
-	; let lib_paths = libraryPaths dflags
-	; cmdline_ld_inputs <- readIORef v_Ld_inputs
-
-	; classified_ld_inputs <- mapM classifyLdInput cmdline_ld_inputs
-
-	   	-- (e) Link any MacOS frameworks
-#ifdef darwin_TARGET_OS	
-	; let framework_paths = frameworkPaths dflags
-	; let frameworks      = cmdlineFrameworks dflags
-#else
-	; let frameworks      = []
-	; let framework_paths = []
-#endif
-		-- Finally do (c),(d),(e)	
-        ; let cmdline_lib_specs = [ l | Just l <- classified_ld_inputs ]
-			       ++ map DLL       minus_ls 
-			       ++ map Framework frameworks
-	; if null cmdline_lib_specs then return ()
-				    else do
-
- 	{ mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs
-	; maybePutStr dflags "final link ... "
-	; ok <- resolveObjs
-
-	; if succeeded ok then maybePutStrLn dflags "done"
-	  else throwDyn (InstallationError "linking extra libraries/objects failed")
-	}}
-
-classifyLdInput :: FilePath -> IO (Maybe LibrarySpec)
-classifyLdInput f
-  | isObjectFilename f = return (Just (Object f))
-  | isDynLibFilename f = return (Just (DLLPath f))
-  | otherwise 	       = do
-	hPutStrLn stderr ("Warning: ignoring unrecognised input `" ++ f ++ "'")
-	return Nothing
-
-preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO ()
-preloadLib dflags lib_paths framework_paths lib_spec
-  = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
-       case lib_spec of
-          Object static_ish
-             -> do b <- preload_static lib_paths static_ish
-                   maybePutStrLn dflags (if b  then "done"
-	 					else "not found")
-	 
-          DLL dll_unadorned
-             -> do maybe_errstr <- loadDynamic lib_paths dll_unadorned
-                   case maybe_errstr of
-                      Nothing -> maybePutStrLn dflags "done"
-                      Just mm -> preloadFailed mm lib_paths lib_spec
-
-	  DLLPath dll_path
-	     -> do maybe_errstr <- loadDLL dll_path
-                   case maybe_errstr of
-                      Nothing -> maybePutStrLn dflags "done"
-                      Just mm -> preloadFailed mm lib_paths lib_spec
-
-#ifdef darwin_TARGET_OS
-	  Framework framework
-             -> do maybe_errstr <- loadFramework framework_paths framework
-                   case maybe_errstr of
-                      Nothing -> maybePutStrLn dflags "done"
-                      Just mm -> preloadFailed mm framework_paths lib_spec
-#endif
-  where
-    preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
-    preloadFailed sys_errmsg paths spec
-       = do maybePutStr dflags
-    	       ("failed.\nDynamic linker error message was:\n   " 
-                    ++ sys_errmsg  ++ "\nWhilst trying to load:  " 
-                    ++ showLS spec ++ "\nDirectories to search are:\n"
-                    ++ unlines (map ("   "++) paths) )
-            give_up
-    
-    -- Not interested in the paths in the static case.
-    preload_static paths name
-       = do b <- doesFileExist name
-            if not b then return False
-                     else loadObj name >> return True
-    
-    give_up = throwDyn $ 
-	      CmdLineError "user specified .o/.so/.DLL could not be loaded."
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Link a byte-code expression
-%*									*
-%************************************************************************
-
-\begin{code}
-linkExpr :: HscEnv -> UnlinkedBCO -> IO HValue
-
--- Link a single expression, *including* first linking packages and 
--- modules that this expression depends on.
---
--- Raises an IO exception if it can't find a compiled version of the
--- dependents to link.
-
-linkExpr hsc_env root_ul_bco
-  = do {  
-	-- Initialise the linker (if it's not been done already)
-     let dflags = hsc_dflags hsc_env
-   ; initDynLinker dflags
-
-	-- Find what packages and linkables are required
-   ; eps <- readIORef (hsc_EPS hsc_env)
-   ; (lnks, pkgs) <- getLinkDeps hsc_env hpt (eps_PIT eps) needed_mods
-
-	-- Link the packages and modules required
-   ; linkPackages dflags pkgs
-   ; ok <- linkModules dflags lnks
-   ; if failed ok then
-	dieWith empty
-     else do {
-
-	-- Link the expression itself
-     pls <- readIORef v_PersistentLinkerState
-   ; let ie = itbl_env pls
-	 ce = closure_env pls
-
-	-- Link the necessary packages and linkables
-   ; (_, (root_hval:_)) <- linkSomeBCOs False ie ce [root_ul_bco]
-   ; return root_hval
-   }}
-   where
-     hpt    = hsc_HPT hsc_env
-     dflags = hsc_dflags hsc_env
-     free_names = nameSetToList (bcoFreeNames root_ul_bco)
-
-     needed_mods :: [Module]
-     needed_mods = [ nameModule n | n <- free_names, 
-				    isExternalName n,	 	-- Names from other modules
-				    not (isWiredInName n)	-- Exclude wired-in names
-		   ]						-- (see note below)
-	-- Exclude wired-in names because we may not have read
-	-- their interface files, so getLinkDeps will fail
-	-- All wired-in names are in the base package, which we link
-	-- by default, so we can safely ignore them here.
- 
-dieWith msg = throwDyn (ProgramError (showSDoc msg))
-
-getLinkDeps :: HscEnv -> HomePackageTable -> PackageIfaceTable
-	    -> [Module]				-- If you need these
-	    -> IO ([Linkable], [PackageId])	-- ... then link these first
--- Fails with an IO exception if it can't find enough files
-
-getLinkDeps hsc_env hpt pit mods
--- Find all the packages and linkables that a set of modules depends on
- = do {	pls <- readIORef v_PersistentLinkerState ;
-	let {
-	-- 1.  Find the dependent home-pkg-modules/packages from each iface
-	    (mods_s, pkgs_s) = unzip (map get_deps mods) ;
-
-	-- 2.  Exclude ones already linked
-	--	Main reason: avoid findModule calls in get_linkable
-	    mods_needed = nub (concat mods_s) `minusList` linked_mods     ;
-	    pkgs_needed = nub (concat pkgs_s) `minusList` pkgs_loaded pls ;
-
-	    linked_mods = map linkableModule (objs_loaded pls ++ bcos_loaded pls)
-	} ;
-	
-	-- 3.  For each dependent module, find its linkable
-	--     This will either be in the HPT or (in the case of one-shot
-	--     compilation) we may need to use maybe_getFileLinkable
-	lnks_needed <- mapM get_linkable mods_needed ;
-
-	return (lnks_needed, pkgs_needed) }
-  where
-    get_deps :: Module -> ([Module],[PackageId])
-	-- Get the things needed for the specified module
-	-- This is rather similar to the code in RnNames.importsFromImportDecl
-    get_deps mod
-	| ExtPackage p <- mi_package iface
-	= ([], p : dep_pkgs deps)
-	| otherwise
-	= (mod : [m | (m,_) <- dep_mods deps], dep_pkgs deps)
-	where
-	  iface = get_iface mod
-	  deps  = mi_deps iface
-
-    get_iface mod = case lookupIface hpt pit mod of
-			    Just iface -> iface
-			    Nothing    -> pprPanic "getLinkDeps" (no_iface mod)
-    no_iface mod = ptext SLIT("No iface for") <+> ppr mod
-	-- This one is a GHC bug
-
-    no_obj mod = dieWith (ptext SLIT("No compiled code for") <+> ppr mod)
-	-- This one is a build-system bug
-
-    get_linkable mod_name	-- A home-package module
-	| Just mod_info <- lookupModuleEnv hpt mod_name 
-	= ASSERT(isJust (hm_linkable mod_info))
-	  return (fromJust (hm_linkable mod_info))
-	| otherwise	
-	=	-- It's not in the HPT because we are in one shot mode, 
-		-- so use the Finder to get a ModLocation...
-	  do { mb_stuff <- findModule hsc_env mod_name False ;
-	       case mb_stuff of {
-		  Found loc _ -> found loc mod_name ;
-		  _ -> no_obj mod_name
-	     }}
-
-    found loc mod_name = do {
-		-- ...and then find the linkable for it
-	       mb_lnk <- findObjectLinkableMaybe mod_name loc ;
-	       case mb_lnk of {
-		  Nothing -> no_obj mod_name ;
-		  Just lnk -> return lnk
-	      }}
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Link some linkables
-	The linkables may consist of a mixture of 
-	byte-code modules and object modules
-%*									*
-%************************************************************************
-
-\begin{code}
-linkModules :: DynFlags -> [Linkable] -> IO SuccessFlag
-linkModules dflags linkables
-  = block $ do  -- don't want to be interrupted by ^C in here
-	
-	let (objs, bcos) = partition isObjectLinkable 
-                              (concatMap partitionLinkable linkables)
-
-		-- Load objects first; they can't depend on BCOs
-	ok_flag <- dynLinkObjs dflags objs
-
-	if failed ok_flag then 
-		return Failed
-	  else do
-		dynLinkBCOs bcos
-		return Succeeded
-		
-
--- HACK to support f-x-dynamic in the interpreter; no other purpose
-partitionLinkable :: Linkable -> [Linkable]
-partitionLinkable li
-   = let li_uls = linkableUnlinked li
-         li_uls_obj = filter isObject li_uls
-         li_uls_bco = filter isInterpretable li_uls
-     in 
-         case (li_uls_obj, li_uls_bco) of
-            (objs@(_:_), bcos@(_:_)) 
-               -> [li{linkableUnlinked=li_uls_obj}, li{linkableUnlinked=li_uls_bco}]
-            other
-               -> [li]
-
-findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable
-findModuleLinkable_maybe lis mod
-   = case [LM time nm us | LM time nm us <- lis, nm == mod] of
-        []   -> Nothing
-        [li] -> Just li
-        many -> pprPanic "findModuleLinkable" (ppr mod)
-
-linkableInSet :: Linkable -> [Linkable] -> Bool
-linkableInSet l objs_loaded =
-  case findModuleLinkable_maybe objs_loaded (linkableModule l) of
-	Nothing -> False
-	Just m  -> linkableTime l == linkableTime m
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The object-code linker}
-%*									*
-%************************************************************************
-
-\begin{code}
-dynLinkObjs :: DynFlags -> [Linkable] -> IO SuccessFlag
-	-- Side-effects the PersistentLinkerState
-
-dynLinkObjs dflags objs
-  = do	pls <- readIORef v_PersistentLinkerState
-
-	-- Load the object files and link them
-	let (objs_loaded', new_objs) = rmDupLinkables (objs_loaded pls) objs
-	    pls1 		     = pls { objs_loaded = objs_loaded' }
-	    unlinkeds 		     = concatMap linkableUnlinked new_objs
-
-	mapM loadObj (map nameOfObject unlinkeds)
-
-	-- Link the all together
-	ok <- resolveObjs
-
-	-- If resolving failed, unload all our 
-	-- object modules and carry on
-	if succeeded ok then do
-		writeIORef v_PersistentLinkerState pls1
-		return Succeeded
-	  else do
-		pls2 <- unload_wkr dflags [] pls1
-		writeIORef v_PersistentLinkerState pls2
-		return Failed
-
-
-rmDupLinkables :: [Linkable] 	-- Already loaded
-	       -> [Linkable]	-- New linkables
-	       -> ([Linkable],	-- New loaded set (including new ones)
-		   [Linkable])	-- New linkables (excluding dups)
-rmDupLinkables already ls
-  = go already [] ls
-  where
-    go already extras [] = (already, extras)
-    go already extras (l:ls)
-	| linkableInSet l already = go already     extras     ls
-	| otherwise		  = go (l:already) (l:extras) ls
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The byte-code linker}
-%*									*
-%************************************************************************
-
-\begin{code}
-dynLinkBCOs :: [Linkable] -> IO ()
-	-- Side-effects the persistent linker state
-dynLinkBCOs bcos
-  = do	pls <- readIORef v_PersistentLinkerState
-
-	let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos
-	    pls1 		     = pls { bcos_loaded = bcos_loaded' }
-	    unlinkeds :: [Unlinked]
-	    unlinkeds 		     = concatMap linkableUnlinked new_bcos
-
-	    cbcs :: [CompiledByteCode]
-	    cbcs      = map byteCodeOfObject unlinkeds
-		      
-	    	      
-	    ul_bcos    = [b | ByteCode bs _  <- cbcs, b <- bs]
-	    ies	       = [ie | ByteCode _ ie <- cbcs]
-	    gce	      = closure_env pls
-            final_ie  = foldr plusNameEnv (itbl_env pls) ies
-
-        (final_gce, linked_bcos) <- linkSomeBCOs True final_ie gce ul_bcos
-		-- What happens to these linked_bcos?
-
-	let pls2 = pls1 { closure_env = final_gce,
-			  itbl_env    = final_ie }
-
-	writeIORef v_PersistentLinkerState pls2
-	return ()
-
--- Link a bunch of BCOs and return them + updated closure env.
-linkSomeBCOs :: Bool 	-- False <=> add _all_ BCOs to returned closure env
-                        -- True  <=> add only toplevel BCOs to closure env
-             -> ItblEnv 
-             -> ClosureEnv 
-             -> [UnlinkedBCO]
-             -> IO (ClosureEnv, [HValue])
-			-- The returned HValues are associated 1-1 with
-			-- the incoming unlinked BCOs.  Each gives the
-			-- value of the corresponding unlinked BCO
-					
-
-linkSomeBCOs toplevs_only ie ce_in ul_bcos
-   = do let nms = map unlinkedBCOName ul_bcos
-        hvals <- fixIO 
-                    ( \ hvs -> let ce_out = extendClosureEnv ce_in (zipLazy nms hvs)
-                               in  mapM (linkBCO ie ce_out) ul_bcos )
-
-        let ce_all_additions = zip nms hvals
-            ce_top_additions = filter (isExternalName.fst) ce_all_additions
-            ce_additions     = if toplevs_only then ce_top_additions 
-                                               else ce_all_additions
-            ce_out = -- make sure we're not inserting duplicate names into the 
-		     -- closure environment, which leads to trouble.
-		     ASSERT (all (not . (`elemNameEnv` ce_in)) (map fst ce_additions))
-		     extendClosureEnv ce_in ce_additions
-        return (ce_out, hvals)
-
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Unload some object modules
-%*									*
-%************************************************************************
-
-\begin{code}
--- ---------------------------------------------------------------------------
--- Unloading old objects ready for a new compilation sweep.
---
--- The compilation manager provides us with a list of linkables that it
--- considers "stable", i.e. won't be recompiled this time around.  For
--- each of the modules current linked in memory,
---
---	* if the linkable is stable (and it's the same one - the
---	  user may have recompiled the module on the side), we keep it,
---
---	* otherwise, we unload it.
---
---      * we also implicitly unload all temporary bindings at this point.
-
-unload :: DynFlags -> [Linkable] -> IO ()
--- The 'linkables' are the ones to *keep*
-
-unload dflags linkables
-  = block $ do -- block, so we're safe from Ctrl-C in here
-  
-	-- Initialise the linker (if it's not been done already)
-	initDynLinker dflags
-
-	pls	<- readIORef v_PersistentLinkerState
-	new_pls <- unload_wkr dflags linkables pls
-	writeIORef v_PersistentLinkerState new_pls
-
-	debugTraceMsg dflags 3 (text "unload: retaining objs" <+> ppr (objs_loaded new_pls))
-	debugTraceMsg dflags 3 (text "unload: retaining bcos" <+> ppr (bcos_loaded new_pls))
-	return ()
-
-unload_wkr :: DynFlags
-           -> [Linkable]		-- stable linkables
-	   -> PersistentLinkerState
-           -> IO PersistentLinkerState
--- Does the core unload business
--- (the wrapper blocks exceptions and deals with the PLS get and put)
-
-unload_wkr dflags linkables pls
-  = do	let (objs_to_keep, bcos_to_keep) = partition isObjectLinkable linkables
-
-	objs_loaded' <- filterM (maybeUnload objs_to_keep) (objs_loaded pls)
-        bcos_loaded' <- filterM (maybeUnload bcos_to_keep) (bcos_loaded pls)
-
-       	let bcos_retained = map linkableModule bcos_loaded'
-	    itbl_env'     = filterNameMap bcos_retained (itbl_env pls)
-            closure_env'  = filterNameMap bcos_retained (closure_env pls)
-  	    new_pls = pls { itbl_env = itbl_env',
-			    closure_env = closure_env',
-			    bcos_loaded = bcos_loaded',
-			    objs_loaded = objs_loaded' }
-
-	return new_pls
-  where
-    maybeUnload :: [Linkable] -> Linkable -> IO Bool
-    maybeUnload keep_linkables lnk
-      | linkableInSet lnk linkables = return True
-      | otherwise		    
-      = do mapM_ unloadObj [f | DotO f <- linkableUnlinked lnk]
-		-- The components of a BCO linkable may contain
-		-- dot-o files.  Which is very confusing.
-		--
-		-- But the BCO parts can be unlinked just by 
-		-- letting go of them (plus of course depopulating
-		-- the symbol table which is done in the main body)
-	   return False
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Loading packages
-%*									*
-%************************************************************************
-
-
-\begin{code}
-data LibrarySpec 
-   = Object FilePath 	-- Full path name of a .o file, including trailing .o
-			-- For dynamic objects only, try to find the object 
-			-- file in all the directories specified in 
-			-- v_Library_paths before giving up.
-
-   | DLL String		-- "Unadorned" name of a .DLL/.so
-			--  e.g.    On unix     "qt"  denotes "libqt.so"
-			--          On WinDoze  "burble"  denotes "burble.DLL"
-			--  loadDLL is platform-specific and adds the lib/.so/.DLL
-			--  suffixes platform-dependently
-
-   | DLLPath FilePath   -- Absolute or relative pathname to a dynamic library
-			-- (ends with .dll or .so).
-
-   | Framework String	-- Only used for darwin, but does no harm
-
--- If this package is already part of the GHCi binary, we'll already
--- have the right DLLs for this package loaded, so don't try to
--- load them again.
--- 
--- But on Win32 we must load them 'again'; doing so is a harmless no-op
--- as far as the loader is concerned, but it does initialise the list
--- of DLL handles that rts/Linker.c maintains, and that in turn is 
--- used by lookupSymbol.  So we must call addDLL for each library 
--- just to get the DLL handle into the list.
-partOfGHCi
-#          if defined(mingw32_TARGET_OS) || defined(darwin_TARGET_OS)
-           = [ ]
-#          else
-           = [ "base", "haskell98", "template-haskell", "readline" ]
-#          endif
-
-showLS (Object nm)    = "(static) " ++ nm
-showLS (DLL nm)       = "(dynamic) " ++ nm
-showLS (DLLPath nm)   = "(dynamic) " ++ nm
-showLS (Framework nm) = "(framework) " ++ nm
-
-linkPackages :: DynFlags -> [PackageId] -> IO ()
--- Link exactly the specified packages, and their dependents
--- (unless of course they are already linked)
--- The dependents are linked automatically, and it doesn't matter
--- what order you specify the input packages.
---
--- NOTE: in fact, since each module tracks all the packages it depends on,
---	 we don't really need to use the package-config dependencies.
--- However we do need the package-config stuff (to find aux libs etc),
--- and following them lets us load libraries in the right order, which 
--- perhaps makes the error message a bit more localised if we get a link
--- failure.  So the dependency walking code is still here.
-
-linkPackages dflags new_pkgs
-   = do	{ pls 	  <- readIORef v_PersistentLinkerState
-	; let pkg_map = pkgIdMap (pkgState dflags)
-
-	; pkgs' <- link pkg_map (pkgs_loaded pls) new_pkgs
-
-	; writeIORef v_PersistentLinkerState (pls { pkgs_loaded = pkgs' })
-	}
-   where
-     link :: PackageConfigMap -> [PackageId] -> [PackageId] -> IO [PackageId]
-     link pkg_map pkgs new_pkgs 
-	= foldM (link_one pkg_map) pkgs new_pkgs
-
-     link_one pkg_map pkgs new_pkg
-	| new_pkg `elem` pkgs	-- Already linked
-	= return pkgs
-
-	| Just pkg_cfg <- lookupPackage pkg_map new_pkg
-	= do { 	-- Link dependents first
-	       pkgs' <- link pkg_map pkgs (map mkPackageId (depends pkg_cfg))
-		-- Now link the package itself
-	     ; linkPackage dflags pkg_cfg
-	     ; return (new_pkg : pkgs') }
-
-	| otherwise
-	= throwDyn (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
-
-
-linkPackage :: DynFlags -> PackageConfig -> IO ()
-linkPackage dflags pkg
-   = do 
-        let dirs      =  Packages.libraryDirs pkg
-
-        let libs      =  Packages.hsLibraries pkg
-        -- Because of slight differences between the GHC dynamic linker and
-        -- the native system linker some packages have to link with a
-        -- different list of libraries when using GHCi. Examples include: libs
-        -- that are actually gnu ld scripts, and the possability that the .a
-        -- libs do not exactly match the .so/.dll equivalents. So if the
-        -- package file provides an "extra-ghci-libraries" field then we use
-        -- that instead of the "extra-libraries" field.
-                      ++ (if null (Packages.extraGHCiLibraries pkg)
-                            then Packages.extraLibraries pkg
-                            else Packages.extraGHCiLibraries pkg)
-                      ++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ]
-        classifieds   <- mapM (locateOneObj dirs) libs
-
-        -- Complication: all the .so's must be loaded before any of the .o's.  
-	let dlls = [ dll | DLL dll    <- classifieds ]
-	    objs = [ obj | Object obj <- classifieds ]
-
-	maybePutStr dflags ("Loading package " ++ showPackageId (package pkg) ++ " ... ")
-
-	-- See comments with partOfGHCi
-	when (pkgName (package pkg) `notElem` partOfGHCi) $ do
-	    loadFrameworks pkg
-            -- When a library A needs symbols from a library B, the order in
-            -- extra_libraries/extra_ld_opts is "-lA -lB", because that's the
-            -- way ld expects it for static linking. Dynamic linking is a
-            -- different story: When A has no dependency information for B,
-            -- dlopen-ing A with RTLD_NOW (see addDLL in Linker.c) will fail
-            -- when B has not been loaded before. In a nutshell: Reverse the
-            -- order of DLLs for dynamic linking.
-	    -- This fixes a problem with the HOpenGL package (see "Compiling
-	    -- HOpenGL under recent versions of GHC" on the HOpenGL list).
-	    mapM_ (load_dyn dirs) (reverse dlls)
-	
-	-- After loading all the DLLs, we can load the static objects.
-	-- Ordering isn't important here, because we do one final link
-	-- step to resolve everything.
-	mapM_ loadObj objs
-
-        maybePutStr dflags "linking ... "
-        ok <- resolveObjs
-	if succeeded ok then maybePutStrLn dflags "done."
-	      else throwDyn (InstallationError ("unable to load package `" ++ showPackageId (package pkg) ++ "'"))
-
-load_dyn dirs dll = do r <- loadDynamic dirs dll
-		       case r of
-			 Nothing  -> return ()
-			 Just err -> throwDyn (CmdLineError ("can't load .so/.DLL for: " 
-                                 			      ++ dll ++ " (" ++ err ++ ")" ))
-#ifndef darwin_TARGET_OS
-loadFrameworks pkg = return ()
-#else
-loadFrameworks pkg = mapM_ load frameworks
-  where
-    fw_dirs    = Packages.frameworkDirs pkg
-    frameworks = Packages.frameworks pkg
-
-    load fw = do  r <- loadFramework fw_dirs fw
-		  case r of
-		    Nothing  -> return ()
-		    Just err -> throwDyn (CmdLineError ("can't load framework: " 
-                               			        ++ fw ++ " (" ++ err ++ ")" ))
-#endif
-
--- Try to find an object file for a given library in the given paths.
--- If it isn't present, we assume it's a dynamic library.
-locateOneObj :: [FilePath] -> String -> IO LibrarySpec
-locateOneObj dirs lib
-  = do	{ mb_obj_path <- findFile mk_obj_path dirs 
-	; case mb_obj_path of
-	    Just obj_path -> return (Object obj_path)
-	    Nothing	  -> 
-                do { mb_lib_path <- findFile mk_dyn_lib_path dirs
-                   ; case mb_lib_path of
-                       Just lib_path -> return (DLL (lib ++ "_dyn"))
-                       Nothing       -> return (DLL lib) }}		-- We assume
-   where
-     mk_obj_path dir = dir `joinFileName` (lib `joinFileExt` "o")
-     mk_dyn_lib_path dir = dir `joinFileName` mkSOName (lib ++ "_dyn")
-
-
--- ----------------------------------------------------------------------------
--- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
-
--- return Nothing == success, else Just error message from dlopen
-loadDynamic paths rootname
-  = do	{ mb_dll <- findFile mk_dll_path paths
-	; case mb_dll of
-	    Just dll -> loadDLL dll
-	    Nothing  -> loadDLL (mkSOName rootname) }
-			-- Tried all our known library paths, so let 
-			-- dlopen() search its own builtin paths now.
-  where
-    mk_dll_path dir = dir `joinFileName` mkSOName rootname
-
-#if defined(darwin_TARGET_OS)
-mkSOName root = ("lib" ++ root) `joinFileExt` "dylib"
-#elif defined(mingw32_TARGET_OS)
--- Win32 DLLs have no .dll extension here, because addDLL tries
--- both foo.dll and foo.drv
-mkSOName root = root
-#else
-mkSOName root = ("lib" ++ root) `joinFileExt` "so"
-#endif
-
--- Darwin / MacOS X only: load a framework
--- a framework is a dynamic library packaged inside a directory of the same
--- name. They are searched for in different paths than normal libraries.
-#ifdef darwin_TARGET_OS
-loadFramework extraPaths rootname
-   = do	{ mb_fwk <- findFile mk_fwk (extraPaths ++ defaultFrameworkPaths)
-	; case mb_fwk of
-	    Just fwk_path -> loadDLL fwk_path
-	    Nothing	  -> return (Just "not found") }
- 		-- Tried all our known library paths, but dlopen()
-		-- has no built-in paths for frameworks: give up
-   where
-     mk_fwk dir = dir `joinFileName` (rootname ++ ".framework/" ++ rootname)
-	-- sorry for the hardcoded paths, I hope they won't change anytime soon:
-     defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"]
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-		Helper functions
-%*									*
-%************************************************************************
-
-\begin{code}
-findFile :: (FilePath -> FilePath)	-- Maps a directory path to a file path
-	 -> [FilePath]			-- Directories to look in
-	 -> IO (Maybe FilePath)		-- The first file path to match
-findFile mk_file_path [] 
-  = return Nothing
-findFile mk_file_path (dir:dirs)
-  = do	{ let file_path = mk_file_path dir
-	; b <- doesFileExist file_path
-	; if b then 
-	     return (Just file_path)
-	  else
-	     findFile mk_file_path dirs }
-\end{code}
-
-\begin{code}
-maybePutStr dflags s | verbosity dflags > 0 = putStr s
-		     | otherwise	    = return ()
-
-maybePutStrLn dflags s | verbosity dflags > 0 = putStrLn s
-		       | otherwise	      = return ()
-\end{code}
diff --git a/ghc/compiler/ghci/ObjLink.lhs b/ghc/compiler/ghci/ObjLink.lhs
deleted file mode 100644
index 057938a45e..0000000000
--- a/ghc/compiler/ghci/ObjLink.lhs
+++ /dev/null
@@ -1,97 +0,0 @@
-%
-% (c) The University of Glasgow, 2000
-%
-
--- ---------------------------------------------------------------------------
--- 	The dynamic linker for object code (.o .so .dll files)
--- ---------------------------------------------------------------------------
-
-Primarily, this module consists of an interface to the C-land dynamic linker.
-
-\begin{code}
-{-# OPTIONS -#include "Linker.h" #-}
-
-module ObjLink ( 
-   initObjLinker,	 -- :: IO ()
-   loadDLL,		 -- :: String -> IO (Maybe String)
-   loadObj,     	 -- :: String -> IO ()
-   unloadObj,   	 -- :: String -> IO ()
-   lookupSymbol,	 -- :: String -> IO (Maybe (Ptr a))
-   resolveObjs  	 -- :: IO SuccessFlag
-  )  where
-
-import Monad            ( when )
-
-import Foreign.C
-import Foreign		( Ptr, nullPtr )
-import Panic		( panic )
-import BasicTypes	( SuccessFlag, successIf )
-import Config		( cLeadingUnderscore )
-import Outputable
-
--- ---------------------------------------------------------------------------
--- RTS Linker Interface
--- ---------------------------------------------------------------------------
-
-lookupSymbol :: String -> IO (Maybe (Ptr a))
-lookupSymbol str_in = do
-   let str = prefixUnderscore str_in
-   withCString str $ \c_str -> do
-     addr <- c_lookupSymbol c_str
-     if addr == nullPtr
-	then return Nothing
-	else return (Just addr)
-
-prefixUnderscore :: String -> String
-prefixUnderscore
- | cLeadingUnderscore == "YES" = ('_':)
- | otherwise                   = id
-
-loadDLL :: String -> IO (Maybe String)
--- Nothing      => success
--- Just err_msg => failure
-loadDLL str = do
-  maybe_errmsg <- withCString str $ \dll -> c_addDLL dll
-  if maybe_errmsg == nullPtr
-	then return Nothing
-	else do str <- peekCString maybe_errmsg
-		return (Just str)
-
-loadObj :: String -> IO ()
-loadObj str = do
-   withCString str $ \c_str -> do
-     r <- c_loadObj c_str
-     when (r == 0) (panic "loadObj: failed")
-
-unloadObj :: String -> IO ()
-unloadObj str =
-   withCString str $ \c_str -> do
-     r <- c_unloadObj c_str
-     when (r == 0) (panic "unloadObj: failed")
-
-resolveObjs :: IO SuccessFlag
-resolveObjs = do
-   r <- c_resolveObjs
-   return (successIf (r /= 0))
-
--- ---------------------------------------------------------------------------
--- Foreign declaractions to RTS entry points which does the real work;
--- ---------------------------------------------------------------------------
-
-#if __GLASGOW_HASKELL__ >= 504
-foreign import ccall unsafe "addDLL"	   c_addDLL :: CString -> IO CString
-foreign import ccall unsafe "initLinker"   initObjLinker :: IO ()
-foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
-foreign import ccall unsafe "loadObj"      c_loadObj :: CString -> IO Int
-foreign import ccall unsafe "unloadObj"    c_unloadObj :: CString -> IO Int
-foreign import ccall unsafe "resolveObjs"  c_resolveObjs :: IO Int
-#else
-foreign import "addDLL"       unsafe	c_addDLL :: CString -> IO CString
-foreign import "initLinker"   unsafe	initLinker :: IO ()
-foreign import "lookupSymbol" unsafe	c_lookupSymbol :: CString -> IO (Ptr a)
-foreign import "loadObj"      unsafe	c_loadObj :: CString -> IO Int
-foreign import "unloadObj"    unsafe	c_unloadObj :: CString -> IO Int
-foreign import "resolveObjs"  unsafe	c_resolveObjs :: IO Int
-#endif
-
-\end{code}
diff --git a/ghc/compiler/ghci/keepCAFsForGHCi.c b/ghc/compiler/ghci/keepCAFsForGHCi.c
deleted file mode 100644
index 0aabbedea0..0000000000
--- a/ghc/compiler/ghci/keepCAFsForGHCi.c
+++ /dev/null
@@ -1,15 +0,0 @@
-#include "Rts.h"
-#include "Storage.h"
-
-// This file is only included when GhcBuildDylibs is set in mk/build.mk.
-// It contains an __attribute__((constructor)) function (run prior to main())
-// which sets the keepCAFs flag in the RTS, before any Haskell code is run.
-// This is required so that GHCi can use dynamic libraries instead of HSxyz.o
-// files.
-
-static void keepCAFsForGHCi() __attribute__((constructor));
-
-static void keepCAFsForGHCi()
-{
-    keepCAFs = 1;
-}
diff --git a/ghc/compiler/hsSyn/Convert.lhs b/ghc/compiler/hsSyn/Convert.lhs
deleted file mode 100644
index 6c14c11893..0000000000
--- a/ghc/compiler/hsSyn/Convert.lhs
+++ /dev/null
@@ -1,622 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-
-This module converts Template Haskell syntax into HsSyn
-
-
-\begin{code}
-module Convert( convertToHsExpr, convertToHsDecls, convertToHsType, thRdrName ) where
-
-#include "HsVersions.h"
-
-import Language.Haskell.TH as TH hiding (sigP)
-import Language.Haskell.TH.Syntax as TH
-
-import HsSyn as Hs
-import qualified Class (FunDep)
-import RdrName	( RdrName, mkRdrUnqual, mkRdrQual, mkOrig, getRdrName, nameRdrName )
-import qualified Name	( Name, mkInternalName, getName )
-import Module   ( Module, mkModule )
-import RdrHsSyn	( mkClassDecl, mkTyData )
-import qualified OccName
-import OccName	( startsVarId, startsVarSym, startsConId, startsConSym,
-		  pprNameSpace )
-import SrcLoc	( Located(..), SrcSpan )
-import Type	( Type )
-import TysWiredIn ( unitTyCon, tupleTyCon, tupleCon, trueDataCon, nilDataCon, consDataCon )
-import BasicTypes( Boxity(..) ) 
-import ForeignCall ( Safety(..), CCallConv(..), CCallTarget(..),
-                     CExportSpec(..)) 
-import Char 	( isAscii, isAlphaNum, isAlpha )
-import List	( partition )
-import Unique	( Unique, mkUniqueGrimily )
-import ErrUtils ( Message )
-import GLAEXTS	( Int(..), Int# )
-import SrcLoc	( noSrcLoc )
-import Bag	( listToBag )
-import FastString
-import Outputable
-
-
-
--------------------------------------------------------------------
---		The external interface
-
-convertToHsDecls :: SrcSpan -> [TH.Dec] -> Either Message [LHsDecl RdrName]
-convertToHsDecls loc ds = initCvt loc (mapM cvtTop ds)
-
-convertToHsExpr :: SrcSpan -> TH.Exp -> Either Message (LHsExpr RdrName)
-convertToHsExpr loc e = initCvt loc (cvtl e)
-
-convertToHsType :: SrcSpan -> TH.Type -> Either Message (LHsType RdrName)
-convertToHsType loc t = initCvt loc (cvtType t)
-
-
--------------------------------------------------------------------
-newtype CvtM a = CvtM { unCvtM :: SrcSpan -> Either Message a }
-	-- Push down the source location;
-	-- Can fail, with a single error message
-
--- NB: If the conversion succeeds with (Right x), there should 
---     be no exception values hiding in x
--- Reason: so a (head []) in TH code doesn't subsequently
--- 	   make GHC crash when it tries to walk the generated tree
-
--- Use the loc everywhere, for lack of anything better
--- In particular, we want it on binding locations, so that variables bound in
--- the spliced-in declarations get a location that at least relates to the splice point
-
-instance Monad CvtM where
-  return x       = CvtM $ \loc -> Right x
-  (CvtM m) >>= k = CvtM $ \loc -> case m loc of
-				    Left err -> Left err
-				    Right v  -> unCvtM (k v) loc
-
-initCvt :: SrcSpan -> CvtM a -> Either Message a
-initCvt loc (CvtM m) = m loc
-
-force :: a -> CvtM a
-force a = a `seq` return a
-
-failWith :: Message -> CvtM a
-failWith m = CvtM (\loc -> Left full_msg)
-   where
-     full_msg = m $$ ptext SLIT("When splicing generated code into the program")
-
-returnL :: a -> CvtM (Located a)
-returnL x = CvtM (\loc -> Right (L loc x))
-
-wrapL :: CvtM a -> CvtM (Located a)
-wrapL (CvtM m) = CvtM (\loc -> case m loc of
-			  Left err -> Left err
-			  Right v  -> Right (L loc v))
-
--------------------------------------------------------------------
-cvtTop :: TH.Dec -> CvtM (LHsDecl RdrName)
-cvtTop d@(TH.ValD _ _ _) = do { L loc d' <- cvtBind d; return (L loc $ Hs.ValD d') }
-cvtTop d@(TH.FunD _ _)   = do { L loc d' <- cvtBind d; return (L loc $ Hs.ValD d') }
-cvtTop (TH.SigD nm typ)  = do  { nm' <- vNameL nm
-				; ty' <- cvtType typ
-				; returnL $ Hs.SigD (TypeSig nm' ty') }
-
-cvtTop (TySynD tc tvs rhs)
-  = do	{ tc' <- tconNameL tc
-	; tvs' <- cvtTvs tvs
-	; rhs' <- cvtType rhs
-	; returnL $ TyClD (TySynonym tc' tvs' rhs') }
-
-cvtTop (DataD ctxt tc tvs constrs derivs)
-  = do	{ stuff <- cvt_tycl_hdr ctxt tc tvs
-	; cons' <- mapM cvtConstr constrs
-	; derivs' <- cvtDerivs derivs
-	; returnL $ TyClD (mkTyData DataType stuff Nothing cons' derivs') }
-
-
-cvtTop (NewtypeD ctxt tc tvs constr derivs)
-  = do	{ stuff <- cvt_tycl_hdr ctxt tc tvs
-	; con' <- cvtConstr constr
-	; derivs' <- cvtDerivs derivs
-	; returnL $ TyClD (mkTyData NewType stuff Nothing [con'] derivs') }
-
-cvtTop (ClassD ctxt cl tvs fds decs)
-  = do	{ stuff <- cvt_tycl_hdr ctxt cl tvs
-	; fds'  <- mapM cvt_fundep fds
-	; (binds', sigs') <- cvtBindsAndSigs decs
-	; returnL $ TyClD $ mkClassDecl stuff fds' sigs' binds' }
-
-cvtTop (InstanceD tys ty decs)
-  = do 	{ (binds', sigs') <- cvtBindsAndSigs decs
-	; ctxt' <- cvtContext tys
-	; L loc pred' <- cvtPred ty
-	; inst_ty' <- returnL $ mkImplicitHsForAllTy ctxt' (L loc (HsPredTy pred'))
-	; returnL $ InstD (InstDecl inst_ty' binds' sigs') }
-
-cvtTop (ForeignD ford) = do { ford' <- cvtForD ford; returnL $ ForD ford' }
-
-cvt_tycl_hdr cxt tc tvs
-  = do	{ cxt' <- cvtContext cxt
-	; tc'  <- tconNameL tc
-	; tvs' <- cvtTvs tvs
-	; return (cxt', tc', tvs') }
-
----------------------------------------------------
--- 	Data types
--- Can't handle GADTs yet
----------------------------------------------------
-
-cvtConstr (NormalC c strtys)
-  = do	{ c'   <- cNameL c 
-	; cxt' <- returnL []
-	; tys' <- mapM cvt_arg strtys
-	; returnL $ ConDecl c' Explicit noExistentials cxt' (PrefixCon tys') ResTyH98 }
-
-cvtConstr (RecC c varstrtys)
-  = do 	{ c'    <- cNameL c 
-	; cxt'  <- returnL []
-	; args' <- mapM cvt_id_arg varstrtys
-	; returnL $ ConDecl c' Explicit noExistentials cxt' (RecCon args') ResTyH98 }
-
-cvtConstr (InfixC st1 c st2)
-  = do 	{ c' <- cNameL c 
-	; cxt' <- returnL []
-	; st1' <- cvt_arg st1
-	; st2' <- cvt_arg st2
-	; returnL $ ConDecl c' Explicit noExistentials cxt' (InfixCon st1' st2') ResTyH98 }
-
-cvtConstr (ForallC tvs ctxt (ForallC tvs' ctxt' con'))
-  = cvtConstr (ForallC (tvs ++ tvs') (ctxt ++ ctxt') con')
-
-cvtConstr (ForallC tvs ctxt con)
-  = do	{ L _ con' <- cvtConstr con
-	; tvs'  <- cvtTvs tvs
-	; ctxt' <- cvtContext ctxt
-	; case con' of
-	    ConDecl l _ [] (L _ []) x ResTyH98
-	      -> returnL $ ConDecl l Explicit tvs' ctxt' x ResTyH98
-	    c -> panic "ForallC: Can't happen" }
-
-cvt_arg (IsStrict, ty)  = do { ty' <- cvtType ty; returnL $ HsBangTy HsStrict ty' }
-cvt_arg (NotStrict, ty) = cvtType ty
-
-cvt_id_arg (i, str, ty) = do { i' <- vNameL i
-			     ; ty' <- cvt_arg (str,ty)
-			     ; return (i', ty') }
-
-cvtDerivs [] = return Nothing
-cvtDerivs cs = do { cs' <- mapM cvt_one cs
-		  ; return (Just cs') }
-	where
-	  cvt_one c = do { c' <- tconName c
-			 ; returnL $ HsPredTy $ HsClassP c' [] }
-
-cvt_fundep :: FunDep -> CvtM (Located (Class.FunDep RdrName))
-cvt_fundep (FunDep xs ys) = do { xs' <- mapM tName xs; ys' <- mapM tName ys; returnL (xs', ys') }
-
-noExistentials = []
-
-------------------------------------------
--- 	Foreign declarations
-------------------------------------------
-
-cvtForD :: Foreign -> CvtM (ForeignDecl RdrName)
-cvtForD (ImportF callconv safety from nm ty)
-  | Just (c_header, cis) <- parse_ccall_impent (TH.nameBase nm) from
-  = do	{ nm' <- vNameL nm
-	; ty' <- cvtType ty
-	; let i = CImport (cvt_conv callconv) safety' c_header nilFS cis
-	; return $ ForeignImport nm' ty' i False }
-
-  | otherwise
-  = failWith $ text (show from)<+> ptext SLIT("is not a valid ccall impent")
-  where 
-    safety' = case safety of
-                     Unsafe     -> PlayRisky
-                     Safe       -> PlaySafe False
-                     Threadsafe -> PlaySafe True
-
-cvtForD (ExportF callconv as nm ty)
-  = do	{ nm' <- vNameL nm
-	; ty' <- cvtType ty
-	; let e = CExport (CExportStatic (mkFastString as) (cvt_conv callconv))
- 	; return $ ForeignExport nm' ty' e False }
-
-cvt_conv CCall   = CCallConv
-cvt_conv StdCall = StdCallConv
-
-parse_ccall_impent :: String -> String -> Maybe (FastString, CImportSpec)
-parse_ccall_impent nm s
- = case lex_ccall_impent s of
-       Just ["dynamic"] -> Just (nilFS, CFunction DynamicTarget)
-       Just ["wrapper"] -> Just (nilFS, CWrapper)
-       Just ("static":ts) -> parse_ccall_impent_static nm ts
-       Just ts -> parse_ccall_impent_static nm ts
-       Nothing -> Nothing
-
-parse_ccall_impent_static :: String
-                          -> [String]
-                          -> Maybe (FastString, CImportSpec)
-parse_ccall_impent_static nm ts
- = let ts' = case ts of
-                 [       "&", cid] -> [       cid]
-                 [fname, "&"     ] -> [fname     ]
-                 [fname, "&", cid] -> [fname, cid]
-                 _                 -> ts
-   in case ts' of
-          [       cid] | is_cid cid -> Just (nilFS,              mk_cid cid)
-          [fname, cid] | is_cid cid -> Just (mkFastString fname, mk_cid cid)
-          [          ]              -> Just (nilFS,              mk_cid nm)
-          [fname     ]              -> Just (mkFastString fname, mk_cid nm)
-          _                         -> Nothing
-    where is_cid :: String -> Bool
-          is_cid x = all (/= '.') x && (isAlpha (head x) || head x == '_')
-          mk_cid :: String -> CImportSpec
-          mk_cid  = CFunction . StaticTarget . mkFastString
-
-lex_ccall_impent :: String -> Maybe [String]
-lex_ccall_impent "" = Just []
-lex_ccall_impent ('&':xs) = fmap ("&":) $ lex_ccall_impent xs
-lex_ccall_impent (' ':xs) = lex_ccall_impent xs
-lex_ccall_impent ('\t':xs) = lex_ccall_impent xs
-lex_ccall_impent xs = case span is_valid xs of
-                          ("", _) -> Nothing
-                          (t, xs') -> fmap (t:) $ lex_ccall_impent xs'
-    where is_valid :: Char -> Bool
-          is_valid c = isAscii c && (isAlphaNum c || c `elem` "._")
-
-
----------------------------------------------------
---		Declarations
----------------------------------------------------
-
-cvtDecs :: [TH.Dec] -> CvtM (HsLocalBinds RdrName)
-cvtDecs [] = return EmptyLocalBinds
-cvtDecs ds = do { (binds,sigs) <- cvtBindsAndSigs ds
-		; return (HsValBinds (ValBindsIn binds sigs)) }
-
-cvtBindsAndSigs ds 
-  = do { binds' <- mapM cvtBind binds; sigs' <- mapM cvtSig sigs
-       ; return (listToBag binds', sigs') }
-  where 
-    (sigs, binds) = partition is_sig ds
-
-    is_sig (TH.SigD _ _) = True
-    is_sig other	 = False
-
-cvtSig (TH.SigD nm ty)
-  = do { nm' <- vNameL nm; ty' <- cvtType ty; returnL (Hs.TypeSig nm' ty') }
-
-cvtBind :: TH.Dec -> CvtM (LHsBind RdrName)
--- Used only for declarations in a 'let/where' clause,
--- not for top level decls
-cvtBind (TH.ValD (TH.VarP s) body ds) 
-  = do	{ s' <- vNameL s
-	; cl' <- cvtClause (Clause [] body ds)
-	; returnL $ mkFunBind s' [cl'] }
-
-cvtBind (TH.FunD nm cls)
-  = do	{ nm' <- vNameL nm
-	; cls' <- mapM cvtClause cls
-	; returnL $ mkFunBind nm' cls' }
-
-cvtBind (TH.ValD p body ds)
-  = do	{ p' <- cvtPat p
-	; g' <- cvtGuard body
-	; ds' <- cvtDecs ds
-	; returnL $ PatBind { pat_lhs = p', pat_rhs = GRHSs g' ds', 
-			      pat_rhs_ty = void, bind_fvs = placeHolderNames } }
-
-cvtBind d 
-  = failWith (sep [ptext SLIT("Illegal kind of declaration in where clause"),
-		   nest 2 (text (TH.pprint d))])
-
-cvtClause :: TH.Clause -> CvtM (Hs.LMatch RdrName)
-cvtClause (Clause ps body wheres)
-  = do	{ ps' <- cvtPats ps
-	; g'  <- cvtGuard body
-	; ds' <- cvtDecs wheres
-	; returnL $ Hs.Match ps' Nothing (GRHSs g' ds') }
-
-
--------------------------------------------------------------------
---		Expressions
--------------------------------------------------------------------
-
-cvtl :: TH.Exp -> CvtM (LHsExpr RdrName)
-cvtl e = wrapL (cvt e)
-  where
-    cvt (VarE s) 	= do { s' <- vName s; return $ HsVar s' }
-    cvt (ConE s) 	= do { s' <- cName s; return $ HsVar s' }
-    cvt (LitE l) 
-      | overloadedLit l = do { l' <- cvtOverLit l; return $ HsOverLit l' }
-      | otherwise	= do { l' <- cvtLit l;     return $ HsLit l' }
-
-    cvt (AppE x y)     = do { x' <- cvtl x; y' <- cvtl y; return $ HsApp x' y' }
-    cvt (LamE ps e)    = do { ps' <- cvtPats ps; e' <- cvtl e 
-			    ; return $ HsLam (mkMatchGroup [mkSimpleMatch ps' e']) }
-    cvt (TupE [e])     = cvt e
-    cvt (TupE es)      = do { es' <- mapM cvtl es; return $ ExplicitTuple es' Boxed }
-    cvt (CondE x y z)  = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z
-			    ; return $ HsIf x' y' z' }
-    cvt (LetE ds e)    = do { ds' <- cvtDecs ds; e' <- cvtl e; return $ HsLet ds' e' }
-    cvt (CaseE e ms)   = do { e' <- cvtl e; ms' <- mapM cvtMatch ms
-			    ; return $ HsCase e' (mkMatchGroup ms') }
-    cvt (DoE ss)       = cvtHsDo DoExpr ss
-    cvt (CompE ss)     = cvtHsDo ListComp ss
-    cvt (ArithSeqE dd) = do { dd' <- cvtDD dd; return $ ArithSeq noPostTcExpr dd' }
-    cvt (ListE xs)     = do { xs' <- mapM cvtl xs; return $ ExplicitList void xs' }
-    cvt (InfixE (Just x) s (Just y)) = do { x' <- cvtl x; s' <- cvtl s; y' <- cvtl y
-					  ; e' <- returnL $ OpApp x' s' undefined y'
-					  ; return $ HsPar e' }
-    cvt (InfixE Nothing  s (Just y)) = do { s' <- cvtl s; y' <- cvtl y
-					  ; return $ SectionR s' y' }
-    cvt (InfixE (Just x) s Nothing ) = do { x' <- cvtl x; s' <- cvtl s
-					  ; return $ SectionL x' s' }
-    cvt (InfixE Nothing  s Nothing ) = cvt s	-- Can I indicate this is an infix thing?
-
-    cvt (SigE e t)	 = do { e' <- cvtl e; t' <- cvtType t
-			      ; return $ ExprWithTySig e' t' }
-    cvt (RecConE c flds) = do { c' <- cNameL c
-			      ; flds' <- mapM cvtFld flds
-			      ; return $ RecordCon c' noPostTcExpr flds' }
-    cvt (RecUpdE e flds) = do { e' <- cvtl e
-			      ; flds' <- mapM cvtFld flds
-			      ; return $ RecordUpd e' flds' placeHolderType placeHolderType }
-
-cvtFld (v,e) = do { v' <- vNameL v; e' <- cvtl e; return (v',e') }
-
-cvtDD :: Range -> CvtM (ArithSeqInfo RdrName)
-cvtDD (FromR x) 	  = do { x' <- cvtl x; return $ From x' }
-cvtDD (FromThenR x y)     = do { x' <- cvtl x; y' <- cvtl y; return $ FromThen x' y' }
-cvtDD (FromToR x y)       = do { x' <- cvtl x; y' <- cvtl y; return $ FromTo x' y' }
-cvtDD (FromThenToR x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z; return $ FromThenTo x' y' z' }
-
--------------------------------------
--- 	Do notation and statements
--------------------------------------
-
-cvtHsDo do_or_lc stmts
-  = do	{ stmts' <- cvtStmts stmts
-	; let body = case last stmts' of
-			L _ (ExprStmt body _ _) -> body
-	; return $ HsDo do_or_lc (init stmts') body void }
-
-cvtStmts = mapM cvtStmt 
-
-cvtStmt :: TH.Stmt -> CvtM (Hs.LStmt RdrName)
-cvtStmt (NoBindS e)    = do { e' <- cvtl e; returnL $ mkExprStmt e' }
-cvtStmt (TH.BindS p e) = do { p' <- cvtPat p; e' <- cvtl e; returnL $ mkBindStmt p' e' }
-cvtStmt (TH.LetS ds)   = do { ds' <- cvtDecs ds; returnL $ LetStmt ds' }
-cvtStmt (TH.ParS dss)  = do { dss' <- mapM cvt_one dss; returnL $ ParStmt dss' }
-		       where
-			 cvt_one ds = do { ds' <- cvtStmts ds; return (ds', undefined) }
-
-cvtMatch :: TH.Match -> CvtM (Hs.LMatch RdrName)
-cvtMatch (TH.Match p body decs)
-  = do 	{ p' <- cvtPat p
-	; g' <- cvtGuard body
-	; decs' <- cvtDecs decs
-	; returnL $ Hs.Match [p'] Nothing (GRHSs g' decs') }
-
-cvtGuard :: TH.Body -> CvtM [LGRHS RdrName]
-cvtGuard (GuardedB pairs) = mapM cvtpair pairs
-cvtGuard (NormalB e)      = do { e' <- cvtl e; g' <- returnL $ GRHS [] e'; return [g'] }
-
-cvtpair :: (TH.Guard, TH.Exp) -> CvtM (LGRHS RdrName)
-cvtpair (NormalG ge,rhs) = do { ge' <- cvtl ge; rhs' <- cvtl rhs
-			      ; g' <- returnL $ mkBindStmt truePat ge'
-			      ; returnL $ GRHS [g'] rhs' }
-cvtpair (PatG gs,rhs)    = do { gs' <- cvtStmts gs; rhs' <- cvtl rhs
-			      ; returnL $ GRHS gs' rhs' }
-
-cvtOverLit :: Lit -> CvtM (HsOverLit RdrName)
-cvtOverLit (IntegerL i)  = do { force i; return $ mkHsIntegral i }
-cvtOverLit (RationalL r) = do { force r; return $ mkHsFractional r }
--- An Integer is like an an (overloaded) '3' in a Haskell source program
--- Similarly 3.5 for fractionals
-
-cvtLit :: Lit -> CvtM HsLit
-cvtLit (IntPrimL i)    = do { force i; return $ HsIntPrim i }
-cvtLit (FloatPrimL f)  = do { force f; return $ HsFloatPrim f }
-cvtLit (DoublePrimL f) = do { force f; return $ HsDoublePrim f }
-cvtLit (CharL c)       = do { force c; return $ HsChar c }
-cvtLit (StringL s)     = do { let { s' = mkFastString s }; force s'; return $ HsString s' }
-
-cvtPats :: [TH.Pat] -> CvtM [Hs.LPat RdrName]
-cvtPats pats = mapM cvtPat pats
-
-cvtPat :: TH.Pat -> CvtM (Hs.LPat RdrName)
-cvtPat pat = wrapL (cvtp pat)
-
-cvtp :: TH.Pat -> CvtM (Hs.Pat RdrName)
-cvtp (TH.LitP l)
-  | overloadedLit l   = do { l' <- cvtOverLit l
-		 	   ; return (mkNPat l' Nothing) }
-		 		  -- Not right for negative patterns; 
-		 		  -- need to think about that!
-  | otherwise	      = do { l' <- cvtLit l; return $ Hs.LitPat l' }
-cvtp (TH.VarP s)      = do { s' <- vName s; return $ Hs.VarPat s' }
-cvtp (TupP [p])       = cvtp p
-cvtp (TupP ps)        = do { ps' <- cvtPats ps; return $ TuplePat ps' Boxed void }
-cvtp (ConP s ps)      = do { s' <- cNameL s; ps' <- cvtPats ps; return $ ConPatIn s' (PrefixCon ps') }
-cvtp (InfixP p1 s p2) = do { s' <- cNameL s; p1' <- cvtPat p1; p2' <- cvtPat p2
-			   ; return $ ConPatIn s' (InfixCon p1' p2') }
-cvtp (TildeP p)       = do { p' <- cvtPat p; return $ LazyPat p' }
-cvtp (TH.AsP s p)     = do { s' <- vNameL s; p' <- cvtPat p; return $ AsPat s' p' }
-cvtp TH.WildP         = return $ WildPat void
-cvtp (RecP c fs)      = do { c' <- cNameL c; fs' <- mapM cvtPatFld fs 
-		  	   ; return $ ConPatIn c' $ Hs.RecCon fs' }
-cvtp (ListP ps)       = do { ps' <- cvtPats ps; return $ ListPat ps' void }
-cvtp (SigP p t)       = do { p' <- cvtPat p; t' <- cvtType t; return $ SigPatIn p' t' }
-
-cvtPatFld (s,p) = do { s' <- vNameL s; p' <- cvtPat p; return (s',p') }
-
------------------------------------------------------------
---	Types and type variables
-
-cvtTvs :: [TH.Name] -> CvtM [LHsTyVarBndr RdrName]
-cvtTvs tvs = mapM cvt_tv tvs
-
-cvt_tv tv = do { tv' <- tName tv; returnL $ UserTyVar tv' }
-
-cvtContext :: Cxt -> CvtM (LHsContext RdrName)
-cvtContext tys = do { preds' <- mapM cvtPred tys; returnL preds' }
-
-cvtPred :: TH.Type -> CvtM (LHsPred RdrName)
-cvtPred ty 
-  = do	{ (head, tys') <- split_ty_app ty
-	; case head of
-	    ConT tc -> do { tc' <- tconName tc; returnL $ HsClassP tc' tys' }
-	    VarT tv -> do { tv' <- tName tv;    returnL $ HsClassP tv' tys' }
-	    other   -> failWith (ptext SLIT("Malformed predicate") <+> text (TH.pprint ty)) }
-
-cvtType :: TH.Type -> CvtM (LHsType RdrName)
-cvtType ty = do { (head, tys') <- split_ty_app ty
-		; case head of
-		    TupleT n | length tys' == n -> returnL (HsTupleTy Boxed tys')
-		             | n == 0    -> mk_apps (HsTyVar (getRdrName unitTyCon)) tys'
-		             | otherwise -> mk_apps (HsTyVar (getRdrName (tupleTyCon Boxed n))) tys'
-		    ArrowT | [x',y'] <- tys' -> returnL (HsFunTy x' y')
-		    ListT  | [x']    <- tys' -> returnL (HsListTy x')
-		    VarT nm -> do { nm' <- tName nm;    mk_apps (HsTyVar nm') tys' }
-		    ConT nm -> do { nm' <- tconName nm; mk_apps (HsTyVar nm') tys' }
-
-		    ForallT tvs cxt ty | null tys' -> do { tvs' <- cvtTvs tvs
-							 ; cxt' <- cvtContext cxt
-							 ; ty'  <- cvtType ty
-							 ; returnL $ mkExplicitHsForAllTy tvs' cxt' ty' }
-		    otherwise -> failWith (ptext SLIT("Malformed type") <+> text (show ty))
-	     }
-  where
-    mk_apps head []       = returnL head
-    mk_apps head (ty:tys) = do { head' <- returnL head; mk_apps (HsAppTy head' ty) tys }
-
-split_ty_app :: TH.Type -> CvtM (TH.Type, [LHsType RdrName])
-split_ty_app ty = go ty []
-  where
-    go (AppT f a) as' = do { a' <- cvtType a; go f (a':as') }
-    go f as 	      = return (f,as)
-
------------------------------------------------------------
-
-
------------------------------------------------------------
--- some useful things
-
-truePat  = nlConPat (getRdrName trueDataCon)  []
-
-overloadedLit :: Lit -> Bool
--- True for literals that Haskell treats as overloaded
-overloadedLit (IntegerL  l) = True
-overloadedLit (RationalL l) = True
-overloadedLit l	            = False
-
-void :: Type.Type
-void = placeHolderType
-
---------------------------------------------------------------------
---	Turning Name back into RdrName
---------------------------------------------------------------------
-
--- variable names
-vNameL, cNameL, tconNameL :: TH.Name -> CvtM (Located RdrName)
-vName,  cName,  tName,  tconName  :: TH.Name -> CvtM RdrName
-
-vNameL n = wrapL (vName n)
-vName n = cvtName OccName.varName n
-
--- Constructor function names; this is Haskell source, hence srcDataName
-cNameL n = wrapL (cName n)
-cName n = cvtName OccName.dataName n 
-
--- Type variable names
-tName n = cvtName OccName.tvName n
-
--- Type Constructor names
-tconNameL n = wrapL (tconName n)
-tconName n = cvtName OccName.tcClsName n
-
-cvtName :: OccName.NameSpace -> TH.Name -> CvtM RdrName
-cvtName ctxt_ns (TH.Name occ flavour)
-  | not (okOcc ctxt_ns occ_str) = failWith (badOcc ctxt_ns occ_str)
-  | otherwise 		        = force (thRdrName ctxt_ns occ_str flavour)
-  where
-    occ_str = TH.occString occ
-
-okOcc :: OccName.NameSpace -> String -> Bool
-okOcc _  []      = False
-okOcc ns str@(c:_) 
-  | OccName.isVarName ns = startsVarId c || startsVarSym c
-  | otherwise 	 	 = startsConId c || startsConSym c || str == "[]"
-
-badOcc :: OccName.NameSpace -> String -> SDoc
-badOcc ctxt_ns occ 
-  = ptext SLIT("Illegal") <+> pprNameSpace ctxt_ns
-	<+> ptext SLIT("name:") <+> quotes (text occ)
-
-thRdrName :: OccName.NameSpace -> String -> TH.NameFlavour -> RdrName
--- This turns a Name into a RdrName
--- The passed-in name space tells what the context is expecting;
---	use it unless the TH name knows what name-space it comes
--- 	from, in which case use the latter
---
--- ToDo: we may generate silly RdrNames, by passing a name space
---       that doesn't match the string, like VarName ":+", 
--- 	 which will give confusing error messages later
--- 
--- The strict applications ensure that any buried exceptions get forced
-thRdrName ctxt_ns occ (TH.NameG th_ns mod) = (mkOrig     $! (mk_mod mod)) $! (mk_occ (mk_ghc_ns th_ns) occ)
-thRdrName ctxt_ns occ (TH.NameL uniq)      = nameRdrName $! (((Name.mkInternalName $! (mk_uniq uniq)) $! (mk_occ ctxt_ns occ)) noSrcLoc)
-thRdrName ctxt_ns occ (TH.NameQ mod)       = (mkRdrQual  $! (mk_mod mod)) $! (mk_occ ctxt_ns occ)
-thRdrName ctxt_ns occ (TH.NameU uniq)      = mkRdrUnqual $! (mk_uniq_occ ctxt_ns occ uniq)
-thRdrName ctxt_ns occ TH.NameS
-  | Just name <- isBuiltInOcc ctxt_ns occ  = nameRdrName $! name
-  | otherwise			           = mkRdrUnqual $! (mk_occ ctxt_ns occ)
-
-isBuiltInOcc :: OccName.NameSpace -> String -> Maybe Name.Name
--- Built in syntax isn't "in scope" so an Unqual RdrName won't do
--- We must generate an Exact name, just as the parser does
-isBuiltInOcc ctxt_ns occ
-  = case occ of
-	":" 		 -> Just (Name.getName consDataCon)
-	"[]"		 -> Just (Name.getName nilDataCon)
-	"()"		 -> Just (tup_name 0)
-	'(' : ',' : rest -> go_tuple 2 rest
-	other		 -> Nothing
-  where
-    go_tuple n ")" 	    = Just (tup_name n)
-    go_tuple n (',' : rest) = go_tuple (n+1) rest
-    go_tuple n other	    = Nothing
-
-    tup_name n 
-	| OccName.isTcClsName ctxt_ns = Name.getName (tupleTyCon Boxed n)
-	| otherwise 		      = Name.getName (tupleCon Boxed n)
-
-mk_uniq_occ :: OccName.NameSpace -> String -> Int# -> OccName.OccName
-mk_uniq_occ ns occ uniq 
-  = OccName.mkOccName ns (occ ++ '[' : shows (mk_uniq uniq) "]")
-	-- The idea here is to make a name that 
-	-- a) the user could not possibly write, and
-	-- b) cannot clash with another NameU
-	-- Previously I generated an Exact RdrName with mkInternalName.
-	-- This works fine for local binders, but does not work at all for
-	-- top-level binders, which must have External Names, since they are
-	-- rapidly baked into data constructors and the like.  Baling out
-	-- and generating an unqualified RdrName here is the simple solution
-
--- The packing and unpacking is rather turgid :-(
-mk_occ :: OccName.NameSpace -> String -> OccName.OccName
-mk_occ ns occ = OccName.mkOccNameFS ns (mkFastString occ)
-
-mk_ghc_ns :: TH.NameSpace -> OccName.NameSpace
-mk_ghc_ns TH.DataName  = OccName.dataName
-mk_ghc_ns TH.TcClsName = OccName.tcClsName
-mk_ghc_ns TH.VarName   = OccName.varName
-
-mk_mod :: TH.ModName -> Module
-mk_mod mod = mkModule (TH.modString mod)
-
-mk_uniq :: Int# -> Unique
-mk_uniq u = mkUniqueGrimily (I# u)
-\end{code}
-
diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs
deleted file mode 100644
index b5c21792af..0000000000
--- a/ghc/compiler/hsSyn/HsBinds.lhs
+++ /dev/null
@@ -1,479 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[HsBinds]{Abstract syntax: top-level bindings and signatures}
-
-Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
-
-\begin{code}
-module HsBinds where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} HsExpr ( HsExpr, pprExpr, LHsExpr,
-			       MatchGroup, pprFunBind,
-			       GRHSs, pprPatBind )
-import {-# SOURCE #-} HsPat  ( LPat )
-
-import HsTypes		( LHsType, PostTcType )
-import Type		( Type )
-import Name		( Name )
-import NameSet		( NameSet, elemNameSet )
-import BasicTypes	( IPName, RecFlag(..), InlineSpec(..), Fixity )
-import Outputable	
-import SrcLoc		( Located(..), SrcSpan, unLoc )
-import Util		( sortLe )
-import Var		( TyVar, DictId, Id )
-import Bag		( Bag, emptyBag, isEmptyBag, bagToList, unionBags, unionManyBags )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Bindings: @BindGroup@}
-%*									*
-%************************************************************************
-
-Global bindings (where clauses)
-
-\begin{code}
-data HsLocalBinds id	-- Bindings in a 'let' expression
-			-- or a 'where' clause
-  = HsValBinds (HsValBinds id)
-  | HsIPBinds  (HsIPBinds id)
-
-  | EmptyLocalBinds
-
-data HsValBinds id	-- Value bindings (not implicit parameters)
-  = ValBindsIn  			-- Before typechecking
-	(LHsBinds id) [LSig id]		-- Not dependency analysed
-					-- Recursive by default
-
-  | ValBindsOut				-- After renaming
-	[(RecFlag, LHsBinds id)]	-- Dependency analysed
-	[LSig Name]
-
-type LHsBinds id  = Bag (LHsBind id)
-type DictBinds id = LHsBinds id		-- Used for dictionary or method bindings
-type LHsBind  id  = Located (HsBind id)
-
-data HsBind id
-  = FunBind {	-- FunBind is used for both functions 	f x = e
-		-- and variables			f = \x -> e
--- Reason 1: the Match stuff lets us have an optional
---	   result type sig	f :: a->a = ...mentions a...
---
--- Reason 2: Special case for type inference: see TcBinds.tcMonoBinds
---
--- Reason 3: instance decls can only have FunBinds, which is convenient
---	     If you change this, you'll need tochange e.g. rnMethodBinds
-
-	fun_id :: Located id,
-
-	fun_infix :: Bool,	-- True => infix declaration
-
-	fun_matches :: MatchGroup id,	-- The payload
-
-	fun_co_fn :: ExprCoFn,	-- Coercion from the type of the MatchGroup to the type of
-				-- the Id.  Example:
-				--	f :: Int -> forall a. a -> a
-				--	f x y = y
-				-- Then the MatchGroup will have type (Int -> a' -> a')
-				-- (with a free type variable a').  The coercion will take
-				-- a CoreExpr of this type and convert it to a CoreExpr of
-				-- type 	Int -> forall a'. a' -> a'
-				-- Notice that the coercion captures the free a'.  That's
-				-- why coercions are (CoreExpr -> CoreExpr), rather than
-				-- just CoreExpr (with a functional type)
-
-	bind_fvs :: NameSet	-- After the renamer, this contains a superset of the 
-				-- Names of the other binders in this binding group that 
-				-- are free in the RHS of the defn
-				-- Before renaming, and after typechecking, 
-				-- the field is unused; it's just an error thunk
-    }
-
-  | PatBind {	-- The pattern is never a simple variable;
-		-- That case is done by FunBind
-	pat_lhs    :: LPat id,
-	pat_rhs    :: GRHSs id,
-	pat_rhs_ty :: PostTcType,	-- Type of the GRHSs
-	bind_fvs   :: NameSet		-- Same as for FunBind
-    }
-
-  | VarBind {	-- Dictionary binding and suchlike 
-	var_id :: id,		-- All VarBinds are introduced by the type checker
-	var_rhs :: LHsExpr id	-- Located only for consistency
-    }
-
-  | AbsBinds {					-- Binds abstraction; TRANSLATION
-	abs_tvs     :: [TyVar],  
-	abs_dicts   :: [DictId],
-	abs_exports :: [([TyVar], id, id, [Prag])],	-- (tvs, poly_id, mono_id, prags)
-	abs_binds   :: LHsBinds id		-- The dictionary bindings and typechecked user bindings
-						-- mixed up together; you can tell the dict bindings because
-						-- they are all VarBinds
-    }
-	-- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
-	-- 
-	-- Creates bindings for (polymorphic, overloaded) poly_f
-	-- in terms of monomorphic, non-overloaded mono_f
-	--
-	-- Invariants: 
-	--	1. 'binds' binds mono_f
-	--	2. ftvs is a subset of tvs
-	--	3. ftvs includes all tyvars free in ds
-	--
-	-- See section 9 of static semantics paper for more details.
-	-- (You can get a PhD for explaining the True Meaning
-	--  of this last construct.)
-
-placeHolderNames :: NameSet
--- Used for the NameSet in FunBind and PatBind prior to the renamer
-placeHolderNames = panic "placeHolderNames"
-
-------------
-instance OutputableBndr id => Outputable (HsLocalBinds id) where
-  ppr (HsValBinds bs) = ppr bs
-  ppr (HsIPBinds bs)  = ppr bs
-  ppr EmptyLocalBinds = empty
-
-instance OutputableBndr id => Outputable (HsValBinds id) where
-  ppr (ValBindsIn binds sigs)
-   = pprValBindsForUser binds sigs
-
-  ppr (ValBindsOut sccs sigs) 
-    = getPprStyle $ \ sty ->
-      if debugStyle sty then	-- Print with sccs showing
-	vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)
-     else
-	pprValBindsForUser (unionManyBags (map snd sccs)) sigs
-   where
-     ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds
-     pp_rec Recursive    = ptext SLIT("rec")
-     pp_rec NonRecursive = ptext SLIT("nonrec")
-
---  *not* pprLHsBinds because we don't want braces; 'let' and
--- 'where' include a list of HsBindGroups and we don't want
--- several groups of bindings each with braces around.
--- Sort by location before printing
-pprValBindsForUser binds sigs
-  = vcat (map snd (sort_by_loc decls))
-  where
-
-    decls :: [(SrcSpan, SDoc)]
-    decls = [(loc, ppr sig)  | L loc sig <- sigs] ++
-    	    [(loc, ppr bind) | L loc bind <- bagToList binds]
-
-    sort_by_loc decls = sortLe (\(l1,_) (l2,_) -> l1 <= l2) decls
-
-pprLHsBinds :: OutputableBndr id => LHsBinds id -> SDoc
-pprLHsBinds binds 
-  | isEmptyLHsBinds binds = empty
-  | otherwise = lbrace <+> vcat (map ppr (bagToList binds)) <+> rbrace
-
-------------
-emptyLocalBinds :: HsLocalBinds a
-emptyLocalBinds = EmptyLocalBinds
-
-isEmptyLocalBinds :: HsLocalBinds a -> Bool
-isEmptyLocalBinds (HsValBinds ds) = isEmptyValBinds ds
-isEmptyLocalBinds (HsIPBinds ds)  = isEmptyIPBinds ds
-isEmptyLocalBinds EmptyLocalBinds = True
-
-isEmptyValBinds :: HsValBinds a -> Bool
-isEmptyValBinds (ValBindsIn ds sigs)  = isEmptyLHsBinds ds && null sigs
-isEmptyValBinds (ValBindsOut ds sigs) = null ds && null sigs
-
-emptyValBindsIn, emptyValBindsOut :: HsValBinds a
-emptyValBindsIn  = ValBindsIn emptyBag []
-emptyValBindsOut = ValBindsOut []      []
-
-emptyLHsBinds :: LHsBinds id
-emptyLHsBinds = emptyBag
-
-isEmptyLHsBinds :: LHsBinds id -> Bool
-isEmptyLHsBinds = isEmptyBag
-
-------------
-plusHsValBinds :: HsValBinds a -> HsValBinds a -> HsValBinds a
-plusHsValBinds (ValBindsIn ds1 sigs1) (ValBindsIn ds2 sigs2)
-  = ValBindsIn (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
-plusHsValBinds (ValBindsOut ds1 sigs1) (ValBindsOut ds2 sigs2)
-  = ValBindsOut (ds1 ++ ds2) (sigs1 ++ sigs2)
-\end{code}
-
-What AbsBinds means
-~~~~~~~~~~~~~~~~~~~
-	 AbsBinds tvs
-		  [d1,d2]
-		  [(tvs1, f1p, f1m), 
-		   (tvs2, f2p, f2m)]
-		  BIND
-means
-
-	f1p = /\ tvs -> \ [d1,d2] -> letrec DBINDS and BIND 
-				      in fm
-
-	gp = ...same again, with gm instead of fm
-
-This is a pretty bad translation, because it duplicates all the bindings.
-So the desugarer tries to do a better job:
-
-	fp = /\ [a,b] -> \ [d1,d2] -> case tp [a,b] [d1,d2] of
-					(fm,gm) -> fm
-	..ditto for gp..
-
-	tp = /\ [a,b] -> \ [d1,d2] -> letrec DBINDS and BIND 
-				       in (fm,gm)
-
-\begin{code}
-instance OutputableBndr id => Outputable (HsBind id) where
-    ppr mbind = ppr_monobind mbind
-
-ppr_monobind :: OutputableBndr id => HsBind id -> SDoc
-
-ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })      = pprPatBind pat grhss
-ppr_monobind (VarBind { var_id = var, var_rhs = rhs })         = ppr var <+> equals <+> pprExpr (unLoc rhs)
-ppr_monobind (FunBind { fun_id = fun, fun_matches = matches }) = pprFunBind (unLoc fun) matches
-      -- ToDo: print infix if appropriate
-
-ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_dicts = dictvars, 
-			 abs_exports = exports, abs_binds = val_binds })
-     = sep [ptext SLIT("AbsBinds"),
-	    brackets (interpp'SP tyvars),
-	    brackets (interpp'SP dictvars),
-	    brackets (sep (punctuate comma (map ppr_exp exports)))]
-       $$
-       nest 2 ( vcat [pprBndr LetBind x | (_,x,_,_) <- exports]
-			-- Print type signatures
-		$$ pprLHsBinds val_binds )
-  where
-    ppr_exp (tvs, gbl, lcl, prags)
-	= vcat [ppr gbl <+> ptext SLIT("<=") <+> ppr tvs <+> ppr lcl,
-	  	nest 2 (vcat (map (pprPrag gbl) prags))]
-\end{code}
-
-%************************************************************************
-%*									*
-		Implicit parameter bindings
-%*									*
-%************************************************************************
-
-\begin{code}
-data HsIPBinds id
-  = IPBinds 
-	[LIPBind id] 
-	(DictBinds id)	-- Only in typechecker output; binds 
-			-- uses of the implicit parameters
-
-isEmptyIPBinds :: HsIPBinds id -> Bool
-isEmptyIPBinds (IPBinds is ds) = null is && isEmptyBag ds
-
-type LIPBind id = Located (IPBind id)
-
--- | Implicit parameter bindings.
-data IPBind id
-  = IPBind
-	(IPName id)
-	(LHsExpr id)
-
-instance (OutputableBndr id) => Outputable (HsIPBinds id) where
-  ppr (IPBinds bs ds) = vcat (map ppr bs) 
-			$$ pprLHsBinds ds
-
-instance (OutputableBndr id) => Outputable (IPBind id) where
-  ppr (IPBind id rhs) = pprBndr LetBind id <+> equals <+> pprExpr (unLoc rhs)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Coercion functions}
-%*									*
-%************************************************************************
-
-\begin{code}
--- A Coercion is an expression with a hole in it
--- We need coercions to have concrete form so that we can zonk them
-
-data ExprCoFn
-  = CoHole			-- The identity coercion
-  | CoCompose ExprCoFn ExprCoFn
-  | CoApps ExprCoFn [Id]		-- Non-empty list
-  | CoTyApps ExprCoFn [Type]		--   in all of these
-  | CoLams [Id] ExprCoFn		--   so that the identity coercion
-  | CoTyLams [TyVar] ExprCoFn		--   is just Hole
-  | CoLet (LHsBinds Id) ExprCoFn	-- Would be nicer to be core bindings
-
-(<.>) :: ExprCoFn -> ExprCoFn -> ExprCoFn
-(<.>) = CoCompose
-
-idCoercion :: ExprCoFn
-idCoercion = CoHole
-
-isIdCoercion :: ExprCoFn -> Bool
-isIdCoercion CoHole = True
-isIdCoercion other  = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{@Sig@: type signatures and value-modifying user pragmas}
-%*									*
-%************************************************************************
-
-It is convenient to lump ``value-modifying'' user-pragmas (e.g.,
-``specialise this function to these four types...'') in with type
-signatures.  Then all the machinery to move them into place, etc.,
-serves for both.
-
-\begin{code}
-type LSig name = Located (Sig name)
-
-data Sig name
-  = TypeSig	(Located name)	-- A bog-std type signature
-		(LHsType name)
-
-  | SpecSig 	(Located name)	-- Specialise a function or datatype ...
-		(LHsType name)	-- ... to these types
-		InlineSpec
-
-  | InlineSig	(Located name)	-- Function name
-		InlineSpec
-
-  | SpecInstSig (LHsType name)	-- (Class tys); should be a specialisation of the 
-				-- current instance decl
-
-  | FixSig	(FixitySig name)	-- Fixity declaration
-
-type LFixitySig name = Located (FixitySig name)
-data FixitySig name = FixitySig (Located name) Fixity 
-
--- A Prag conveys pragmas from the type checker to the desugarer
-data Prag 
-  = InlinePrag 
-	InlineSpec
-
-  | SpecPrag   
-	(HsExpr Id)	-- An expression, of the given specialised type, which
-	PostTcType 	-- specialises the polymorphic function
-	[Id]		-- Dicts mentioned free in the expression
-	InlineSpec 	-- Inlining spec for the specialised function
-
-isInlinePrag (InlinePrag _) = True
-isInlinePrag prag	    = False
-
-isSpecPrag (SpecPrag _ _ _ _) = True
-isSpecPrag prag		      = False
-\end{code}
-
-\begin{code}
-okBindSig :: NameSet -> LSig Name -> Bool
-okBindSig ns sig = sigForThisGroup ns sig
-
-okHsBootSig :: LSig Name -> Bool
-okHsBootSig (L _ (TypeSig  _ _)) = True
-okHsBootSig (L _ (FixSig _)) 	 = True
-okHsBootSig sig	      	     	 = False
-
-okClsDclSig :: LSig Name -> Bool
-okClsDclSig (L _ (SpecInstSig _)) = False
-okClsDclSig sig 	          = True	-- All others OK
-
-okInstDclSig :: NameSet -> LSig Name -> Bool
-okInstDclSig ns lsig@(L _ sig) = ok ns sig
-  where
-    ok ns (TypeSig _ _)	  = False
-    ok ns (FixSig _)	  = False
-    ok ns (SpecInstSig _) = True
-    ok ns sig		  = sigForThisGroup ns lsig
-
-sigForThisGroup :: NameSet -> LSig Name -> Bool
-sigForThisGroup ns sig
-  = case sigName sig of
-	Nothing -> False
-	Just n  -> n `elemNameSet` ns
-
-sigName :: LSig name -> Maybe name
-sigName (L _ sig) = f sig
- where
-    f (TypeSig   n _)          = Just (unLoc n)
-    f (SpecSig   n _ _)        = Just (unLoc n)
-    f (InlineSig n _)          = Just (unLoc n)
-    f (FixSig (FixitySig n _)) = Just (unLoc n)
-    f other			= Nothing
-
-isFixityLSig :: LSig name -> Bool
-isFixityLSig (L _ (FixSig {})) = True
-isFixityLSig _	               = False
-
-isVanillaLSig :: LSig name -> Bool
-isVanillaLSig (L _(TypeSig {})) = True
-isVanillaLSig sig	        = False
-
-isSpecLSig :: LSig name -> Bool
-isSpecLSig (L _(SpecSig {})) = True
-isSpecLSig sig	     	     = False
-
-isSpecInstLSig (L _ (SpecInstSig {})) = True
-isSpecInstLSig sig	       	      = False
-
-isPragLSig :: LSig name -> Bool
-	-- Identifies pragmas 
-isPragLSig (L _ (SpecSig {}))   = True
-isPragLSig (L _ (InlineSig {})) = True
-isPragLSig other		= False
-
-isInlineLSig :: LSig name -> Bool
-	-- Identifies inline pragmas 
-isInlineLSig (L _ (InlineSig {})) = True
-isInlineLSig other		  = False
-
-hsSigDoc (TypeSig {}) 		= ptext SLIT("type signature")
-hsSigDoc (SpecSig {})	 	= ptext SLIT("SPECIALISE pragma")
-hsSigDoc (InlineSig _ spec)   	= ppr spec <+> ptext SLIT("pragma")
-hsSigDoc (SpecInstSig {})	= ptext SLIT("SPECIALISE instance pragma")
-hsSigDoc (FixSig {}) 		= ptext SLIT("fixity declaration")
-\end{code}
-
-Signature equality is used when checking for duplicate signatures
-
-\begin{code}
-eqHsSig :: LSig Name -> LSig Name -> Bool
-eqHsSig (L _ (FixSig (FixitySig n1 _))) (L _ (FixSig (FixitySig n2 _))) = unLoc n1 == unLoc n2
-eqHsSig (L _ (TypeSig n1 _))         	(L _ (TypeSig n2 _))            = unLoc n1 == unLoc n2
-eqHsSig (L _ (InlineSig n1 s1))	(L _ (InlineSig n2 s2))    	        = s1 == s2 && unLoc n1 == unLoc n2
- 	-- For specialisations, we don't have equality over
-	-- HsType, so it's not convenient to spot duplicate 
-	-- specialisations here.  Check for this later, when we're in Type land
-eqHsSig _other1 _other2 = False
-\end{code}
-
-\begin{code}
-instance (OutputableBndr name) => Outputable (Sig name) where
-    ppr sig = ppr_sig sig
-
-ppr_sig :: OutputableBndr name => Sig name -> SDoc
-ppr_sig (TypeSig var ty)	  = pprVarSig (unLoc var) ty
-ppr_sig (FixSig fix_sig) 	  = ppr fix_sig
-ppr_sig (SpecSig var ty inl) 	  = pragBrackets (pprSpec var ty inl)
-ppr_sig (InlineSig var inl)       = pragBrackets (ppr inl <+> ppr var)
-ppr_sig (SpecInstSig ty) 	  = pragBrackets (ptext SLIT("SPECIALIZE instance") <+> ppr ty)
-
-instance Outputable name => Outputable (FixitySig name) where
-  ppr (FixitySig name fixity) = sep [ppr fixity, ppr name]
-
-pragBrackets :: SDoc -> SDoc
-pragBrackets doc = ptext SLIT("{-#") <+> doc <+> ptext SLIT("#-}") 
-
-pprVarSig :: (Outputable id, Outputable ty) => id -> ty -> SDoc
-pprVarSig var ty = sep [ppr var <+> dcolon, nest 2 (ppr ty)]
-
-pprSpec :: (Outputable id, Outputable ty) => id -> ty -> InlineSpec -> SDoc
-pprSpec var ty inl = sep [ptext SLIT("SPECIALIZE") <+> ppr inl <+> pprVarSig var ty]
-
-pprPrag :: Outputable id => id -> Prag -> SDoc
-pprPrag var (InlinePrag inl)         = ppr inl <+> ppr var
-pprPrag var (SpecPrag expr ty _ inl) = pprSpec var ty inl
-\end{code}
diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
deleted file mode 100644
index 8ff39857c6..0000000000
--- a/ghc/compiler/hsSyn/HsDecls.lhs
+++ /dev/null
@@ -1,796 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[HsDecls]{Abstract syntax: global declarations}
-
-Definitions for: @TyDecl@ and @oCnDecl@, @ClassDecl@,
-@InstDecl@, @DefaultDecl@ and @ForeignDecl@.
-
-\begin{code}
-module HsDecls (
-	HsDecl(..), LHsDecl, TyClDecl(..), LTyClDecl, 
-	InstDecl(..), LInstDecl, NewOrData(..),
-	RuleDecl(..), LRuleDecl, RuleBndr(..),
-	DefaultDecl(..), LDefaultDecl, SpliceDecl(..),
-	ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
-	CImportSpec(..), FoType(..),
-	ConDecl(..), ResType(..), LConDecl,	
-	DeprecDecl(..),  LDeprecDecl,
-	HsGroup(..),  emptyRdrGroup, emptyRnGroup, appendGroups,
-	tcdName, tyClDeclNames, tyClDeclTyVars,
-	isClassDecl, isSynDecl, isDataDecl, 
-	countTyClDecls,
-	conDetailsTys,
-	collectRuleBndrSigTys, 
-    ) where
-
-#include "HsVersions.h"
-
--- friends:
-import {-# SOURCE #-}	HsExpr( HsExpr, pprExpr )
-	-- Because Expr imports Decls via HsBracket
-
-import HsBinds		( HsValBinds(..), HsBind, LHsBinds, plusHsValBinds,
-			  Sig(..), LSig, LFixitySig, pprLHsBinds,
-			  emptyValBindsIn, emptyValBindsOut )
-import HsPat		( HsConDetails(..), hsConArgs )
-import HsImpExp		( pprHsVar )
-import HsTypes
-import NameSet          ( NameSet )
-import HscTypes		( DeprecTxt )
-import CoreSyn		( RuleName )
-import Kind		( Kind, pprKind )
-import BasicTypes	( Activation(..) )
-import ForeignCall	( CCallTarget(..), DNCallSpec, CCallConv, Safety,
-			  CExportSpec(..), CLabelString ) 
-
--- others:
-import FunDeps		( pprFundeps )
-import Class		( FunDep )
-import Outputable	
-import Util		( count )
-import SrcLoc		( Located(..), unLoc, noLoc )
-import FastString
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[HsDecl]{Declarations}
-%*									*
-%************************************************************************
-
-\begin{code}
-type LHsDecl id = Located (HsDecl id)
-
-data HsDecl id
-  = TyClD	(TyClDecl id)
-  | InstD	(InstDecl  id)
-  | ValD	(HsBind id)
-  | SigD	(Sig id)
-  | DefD	(DefaultDecl id)
-  | ForD        (ForeignDecl id)
-  | DeprecD	(DeprecDecl id)
-  | RuleD	(RuleDecl id)
-  | SpliceD	(SpliceDecl id)
-
--- NB: all top-level fixity decls are contained EITHER
--- EITHER SigDs
--- OR     in the ClassDecls in TyClDs
---
--- The former covers
--- 	a) data constructors
--- 	b) class methods (but they can be also done in the
--- 		signatures of class decls)
---	c) imported functions (that have an IfacSig)
---	d) top level decls
---
--- The latter is for class methods only
-
--- A [HsDecl] is categorised into a HsGroup before being 
--- fed to the renamer.
-data HsGroup id
-  = HsGroup {
-	hs_valds  :: HsValBinds id,
-	hs_tyclds :: [LTyClDecl id],
-	hs_instds :: [LInstDecl id],
-
-	hs_fixds  :: [LFixitySig id],
-		-- Snaffled out of both top-level fixity signatures,
-		-- and those in class declarations
-
-	hs_defds  :: [LDefaultDecl id],
-	hs_fords  :: [LForeignDecl id],
-	hs_depds  :: [LDeprecDecl id],
-	hs_ruleds :: [LRuleDecl id]
-  }
-
-emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
-emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
-emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }
-
-emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [],
-		       hs_fixds = [], hs_defds = [], hs_fords = [], 
-		       hs_depds = [], hs_ruleds = [],
-		       hs_valds = error "emptyGroup hs_valds: Can't happen" }
-
-appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
-appendGroups 
-    HsGroup { 
-	hs_valds  = val_groups1,
-	hs_tyclds = tyclds1, 
-	hs_instds = instds1,
-	hs_fixds  = fixds1, 
-	hs_defds  = defds1,
-	hs_fords  = fords1, 
-	hs_depds  = depds1,
-	hs_ruleds = rulds1 }
-    HsGroup { 
-	hs_valds  = val_groups2,
-	hs_tyclds = tyclds2, 
-	hs_instds = instds2,
-	hs_fixds  = fixds2, 
-	hs_defds  = defds2,
-	hs_fords  = fords2, 
-	hs_depds  = depds2,
-	hs_ruleds = rulds2 }
-  = 
-    HsGroup { 
-	hs_valds  = val_groups1 `plusHsValBinds` val_groups2,
-	hs_tyclds = tyclds1 ++ tyclds2, 
-	hs_instds = instds1 ++ instds2,
-	hs_fixds  = fixds1 ++ fixds2, 
-	hs_defds  = defds1 ++ defds2,
-	hs_fords  = fords1 ++ fords2, 
-	hs_depds  = depds1 ++ depds2,
-	hs_ruleds = rulds1 ++ rulds2 }
-\end{code}
-
-\begin{code}
-instance OutputableBndr name => Outputable (HsDecl name) where
-    ppr (TyClD dcl)  = ppr dcl
-    ppr (ValD binds) = ppr binds
-    ppr (DefD def)   = ppr def
-    ppr (InstD inst) = ppr inst
-    ppr (ForD fd)    = ppr fd
-    ppr (SigD sd)    = ppr sd
-    ppr (RuleD rd)   = ppr rd
-    ppr (DeprecD dd) = ppr dd
-    ppr (SpliceD dd) = ppr dd
-
-instance OutputableBndr name => Outputable (HsGroup name) where
-    ppr (HsGroup { hs_valds  = val_decls,
-		   hs_tyclds = tycl_decls,
-		   hs_instds = inst_decls,
-		   hs_fixds  = fix_decls,
-		   hs_depds  = deprec_decls,
-		   hs_fords  = foreign_decls,
-		   hs_defds  = default_decls,
-		   hs_ruleds = rule_decls })
-	= vcat [ppr_ds fix_decls, ppr_ds default_decls, 
-		ppr_ds deprec_decls, ppr_ds rule_decls,
-		ppr val_decls,
-		ppr_ds tycl_decls, ppr_ds inst_decls,
-		ppr_ds foreign_decls]
-	where
-	  ppr_ds [] = empty
-	  ppr_ds ds = text "" $$ vcat (map ppr ds)
-
-data SpliceDecl id = SpliceDecl (Located (HsExpr id))	-- Top level splice
-
-instance OutputableBndr name => Outputable (SpliceDecl name) where
-   ppr (SpliceDecl e) = ptext SLIT("$") <> parens (pprExpr (unLoc e))
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
-%*									*
-%************************************************************************
-
-		--------------------------------
-			THE NAMING STORY
-		--------------------------------
-
-Here is the story about the implicit names that go with type, class,
-and instance decls.  It's a bit tricky, so pay attention!
-
-"Implicit" (or "system") binders
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-  Each data type decl defines 
-	a worker name for each constructor
-	to-T and from-T convertors
-  Each class decl defines
-	a tycon for the class
-	a data constructor for that tycon
-	the worker for that constructor
-	a selector for each superclass
-
-All have occurrence names that are derived uniquely from their parent
-declaration.
-
-None of these get separate definitions in an interface file; they are
-fully defined by the data or class decl.  But they may *occur* in
-interface files, of course.  Any such occurrence must haul in the
-relevant type or class decl.
-
-Plan of attack:
- - Ensure they "point to" the parent data/class decl 
-   when loading that decl from an interface file
-   (See RnHiFiles.getSysBinders)
-
- - When typechecking the decl, we build the implicit TyCons and Ids.
-   When doing so we look them up in the name cache (RnEnv.lookupSysName),
-   to ensure correct module and provenance is set
-
-These are the two places that we have to conjure up the magic derived
-names.  (The actual magic is in OccName.mkWorkerOcc, etc.)
-
-Default methods
-~~~~~~~~~~~~~~~
- - Occurrence name is derived uniquely from the method name
-   E.g. $dmmax
-
- - If there is a default method name at all, it's recorded in
-   the ClassOpSig (in HsBinds), in the DefMeth field.
-   (DefMeth is defined in Class.lhs)
-
-Source-code class decls and interface-code class decls are treated subtly
-differently, which has given me a great deal of confusion over the years.
-Here's the deal.  (We distinguish the two cases because source-code decls
-have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
-
-In *source-code* class declarations:
-
- - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
-   This is done by RdrHsSyn.mkClassOpSigDM
-
- - The renamer renames it to a Name
-
- - During typechecking, we generate a binding for each $dm for 
-   which there's a programmer-supplied default method:
-	class Foo a where
-	  op1 :: <type>
-	  op2 :: <type>
-	  op1 = ...
-   We generate a binding for $dmop1 but not for $dmop2.
-   The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
-   The Name for $dmop2 is simply discarded.
-
-In *interface-file* class declarations:
-  - When parsing, we see if there's an explicit programmer-supplied default method
-    because there's an '=' sign to indicate it:
-	class Foo a where
-	  op1 = :: <type>	-- NB the '='
-  	  op2   :: <type>
-    We use this info to generate a DefMeth with a suitable RdrName for op1,
-    and a NoDefMeth for op2
-  - The interface file has a separate definition for $dmop1, with unfolding etc.
-  - The renamer renames it to a Name.
-  - The renamer treats $dmop1 as a free variable of the declaration, so that
-    the binding for $dmop1 will be sucked in.  (See RnHsSyn.tyClDeclFVs)  
-    This doesn't happen for source code class decls, because they *bind* the default method.
-
-Dictionary functions
-~~~~~~~~~~~~~~~~~~~~
-Each instance declaration gives rise to one dictionary function binding.
-
-The type checker makes up new source-code instance declarations
-(e.g. from 'deriving' or generic default methods --- see
-TcInstDcls.tcInstDecls1).  So we can't generate the names for
-dictionary functions in advance (we don't know how many we need).
-
-On the other hand for interface-file instance declarations, the decl
-specifies the name of the dictionary function, and it has a binding elsewhere
-in the interface file:
-	instance {Eq Int} = dEqInt
-	dEqInt :: {Eq Int} <pragma info>
-
-So again we treat source code and interface file code slightly differently.
-
-Source code:
-  - Source code instance decls have a Nothing in the (Maybe name) field
-    (see data InstDecl below)
-
-  - The typechecker makes up a Local name for the dict fun for any source-code
-    instance decl, whether it comes from a source-code instance decl, or whether
-    the instance decl is derived from some other construct (e.g. 'deriving').
-
-  - The occurrence name it chooses is derived from the instance decl (just for 
-    documentation really) --- e.g. dNumInt.  Two dict funs may share a common
-    occurrence name, but will have different uniques.  E.g.
-	instance Foo [Int]  where ...
-	instance Foo [Bool] where ...
-    These might both be dFooList
-
-  - The CoreTidy phase externalises the name, and ensures the occurrence name is
-    unique (this isn't special to dict funs).  So we'd get dFooList and dFooList1.
-
-  - We can take this relaxed approach (changing the occurrence name later) 
-    because dict fun Ids are not captured in a TyCon or Class (unlike default
-    methods, say).  Instead, they are kept separately in the InstEnv.  This
-    makes it easy to adjust them after compiling a module.  (Once we've finished
-    compiling that module, they don't change any more.)
-
-
-Interface file code:
-  - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
-    in the (Maybe name) field.
-
-  - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
-    suck in the dfun binding
-
-
-\begin{code}
--- TyClDecls are precisely the kind of declarations that can 
--- appear in interface files; or (internally) in GHC's interface
--- for a module.  That's why (despite the misnomer) IfaceSig and ForeignType
--- are both in TyClDecl
-
-type LTyClDecl name = Located (TyClDecl name)
-
-data TyClDecl name
-  = ForeignType { 
-		tcdLName    :: Located name,
-		tcdExtName  :: Maybe FastString,
-		tcdFoType   :: FoType
-  }
-
-  | TyData {	tcdND     :: NewOrData,
-		tcdCtxt   :: LHsContext name,	 	-- Context
-		tcdLName  :: Located name,	 	-- Type constructor
-		tcdTyVars :: [LHsTyVarBndr name], 	-- Type variables
-		tcdKindSig :: Maybe Kind,		-- Optional kind sig; 
-							-- (only for the 'where' form)
-
-		tcdCons	  :: [LConDecl name],	 	-- Data constructors
-			-- For data T a = T1 | T2 a          the LConDecls all have ResTyH98
-			-- For data T a where { T1 :: T a }  the LConDecls all have ResTyGADT
-
-		tcdDerivs :: Maybe [LHsType name]
-			-- Derivings; Nothing => not specified
-			-- 	      Just [] => derive exactly what is asked
-			-- These "types" must be of form
-			--	forall ab. C ty1 ty2
-			-- Typically the foralls and ty args are empty, but they
-			-- are non-empty for the newtype-deriving case
-    }
-
-  | TySynonym {	tcdLName  :: Located name,	        -- type constructor
-		tcdTyVars :: [LHsTyVarBndr name],	-- type variables
-		tcdSynRhs :: LHsType name	        -- synonym expansion
-    }
-
-  | ClassDecl {	tcdCtxt    :: LHsContext name, 	 	-- Context...
-		tcdLName   :: Located name,	    	-- Name of the class
-		tcdTyVars  :: [LHsTyVarBndr name],	-- Class type variables
-		tcdFDs     :: [Located (FunDep name)],	-- Functional deps
-		tcdSigs    :: [LSig name],		-- Methods' signatures
-		tcdMeths   :: LHsBinds name		-- Default methods
-    }
-
-data NewOrData
-  = NewType  	-- "newtype Blah ..."
-  | DataType 	-- "data Blah ..."
-  deriving( Eq )	-- Needed because Demand derives Eq
-\end{code}
-
-Simple classifiers
-
-\begin{code}
-isDataDecl, isSynDecl, isClassDecl :: TyClDecl name -> Bool
-
-isSynDecl (TySynonym {}) = True
-isSynDecl other		 = False
-
-isDataDecl (TyData {}) = True
-isDataDecl other       = False
-
-isClassDecl (ClassDecl {}) = True
-isClassDecl other	   = False
-\end{code}
-
-Dealing with names
-
-\begin{code}
-tcdName :: TyClDecl name -> name
-tcdName decl = unLoc (tcdLName decl)
-
-tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
--- Returns all the *binding* names of the decl, along with their SrcLocs
--- The first one is guaranteed to be the name of the decl
--- For record fields, the first one counts as the SrcLoc
--- We use the equality to filter out duplicate field names
-
-tyClDeclNames (TySynonym   {tcdLName = name})  = [name]
-tyClDeclNames (ForeignType {tcdLName = name})  = [name]
-
-tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs})
-  = cls_name : [n | L _ (TypeSig n _) <- sigs]
-
-tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
-  = tc_name : conDeclsNames (map unLoc cons)
-
-tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
-tyClDeclTyVars (TyData    {tcdTyVars = tvs}) = tvs
-tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
-tyClDeclTyVars (ForeignType {})		     = []
-\end{code}
-
-\begin{code}
-countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int)
-	-- class, data, newtype, synonym decls
-countTyClDecls decls 
- = (count isClassDecl     decls,
-    count isSynDecl       decls,
-    count isDataTy        decls,
-    count isNewTy         decls) 
- where
-   isDataTy TyData{tcdND=DataType} = True
-   isDataTy _                      = False
-   
-   isNewTy TyData{tcdND=NewType} = True
-   isNewTy _                     = False
-\end{code}
-
-\begin{code}
-instance OutputableBndr name
-	      => Outputable (TyClDecl name) where
-
-    ppr (ForeignType {tcdLName = ltycon})
-	= hsep [ptext SLIT("foreign import type dotnet"), ppr ltycon]
-
-    ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdSynRhs = mono_ty})
-      = hang (ptext SLIT("type") <+> pp_decl_head [] ltycon tyvars <+> equals)
-	     4 (ppr mono_ty)
-
-    ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
-		 tcdTyVars = tyvars, tcdKindSig = mb_sig, tcdCons = condecls, 
-		 tcdDerivs = derivings})
-      = pp_tydecl (ppr new_or_data <+> pp_decl_head (unLoc context) ltycon tyvars <+> ppr_sig mb_sig)
-		  (pp_condecls condecls)
-		  derivings
-      where
-	ppr_sig Nothing = empty
-	ppr_sig (Just kind) = dcolon <+> pprKind kind
-
-    ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, tcdFDs = fds,
-		    tcdSigs = sigs, tcdMeths = methods})
-      | null sigs	-- No "where" part
-      = top_matter
-
-      | otherwise	-- Laid out
-      = sep [hsep [top_matter, ptext SLIT("where {")],
-	     nest 4 (sep [sep (map ppr_sig sigs), ppr methods, char '}'])]
-      where
-        top_matter  = ptext SLIT("class") <+> pp_decl_head (unLoc context) lclas tyvars <+> pprFundeps (map unLoc fds)
-	ppr_sig sig = ppr sig <> semi
-
-pp_decl_head :: OutputableBndr name
-   => HsContext name
-   -> Located name
-   -> [LHsTyVarBndr name]
-   -> SDoc
-pp_decl_head context thing tyvars
-  = hsep [pprHsContext context, ppr thing, interppSP tyvars]
-pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
-  = hang (ptext SLIT("where")) 2 (vcat (map ppr cs))
-pp_condecls cs 			  -- In H98 syntax
-  = equals <+> sep (punctuate (ptext SLIT(" |")) (map ppr cs))
-
-pp_tydecl pp_head pp_decl_rhs derivings
-  = hang pp_head 4 (sep [
-	pp_decl_rhs,
-	case derivings of
-	  Nothing 	   -> empty
-	  Just ds	   -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
-    ])
-
-instance Outputable NewOrData where
-  ppr NewType  = ptext SLIT("newtype")
-  ppr DataType = ptext SLIT("data")
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[ConDecl]{A data-constructor declaration}
-%*									*
-%************************************************************************
-
-\begin{code}
-type LConDecl name = Located (ConDecl name)
-
--- data T b = forall a. Eq a => MkT a b
---   MkT :: forall b a. Eq a => MkT a b
-
--- data T b where
---	MkT1 :: Int -> T Int
-
--- data T = Int `MkT` Int
---	  | MkT2
-
--- data T a where
---	Int `MkT` Int :: T Int
-
-data ConDecl name
-  = ConDecl
-    { con_name      :: Located name	    -- Constructor name; this is used for the
-                                            -- DataCon itself, and for the user-callable wrapper Id
-
-    , con_explicit  :: HsExplicitForAll     -- Is there an user-written forall? (cf. HStypes.HsForAllTy)
-
-    , con_qvars     :: [LHsTyVarBndr name]  -- ResTyH98: the constructor's existential type variables
-					    -- ResTyGADT:    all the constructor's quantified type variables
-
-    , con_cxt       :: LHsContext name      -- The context.  This *does not* include the
-					    -- "stupid theta" which lives only in the TyData decl
-
-    , con_details   :: HsConDetails name (LBangType name)	-- The main payload
-
-    , con_res       :: ResType name         -- Result type of the constructor
-    }
-
-data ResType name
-   = ResTyH98		-- Constructor was declared using Haskell 98 syntax
-   | ResTyGADT (LHsType name)	-- Constructor was declared using GADT-style syntax,
-				--	and here is its result type
-\end{code}
-
-\begin{code}
-conDeclsNames :: Eq name => [ConDecl name] -> [Located name]
-  -- See tyClDeclNames for what this does
-  -- The function is boringly complicated because of the records
-  -- And since we only have equality, we have to be a little careful
-conDeclsNames cons
-  = snd (foldl do_one ([], []) cons)
-  where
-    do_one (flds_seen, acc) (ConDecl { con_name = lname, con_details = RecCon flds })
-	= (map unLoc new_flds ++ flds_seen, lname : [f | f <- new_flds] ++ acc)
-	where
-	  new_flds = [ f | (f,_) <- flds, not (unLoc f `elem` flds_seen) ]
-
-    do_one (flds_seen, acc) c
-	= (flds_seen, (con_name c):acc)
-
-conDetailsTys details = map getBangType (hsConArgs details)
-\end{code}
-  
-
-\begin{code}
-instance (OutputableBndr name) => Outputable (ConDecl name) where
-    ppr = pprConDecl
-
-pprConDecl (ConDecl con expl tvs cxt details ResTyH98)
-  = sep [pprHsForAll expl tvs cxt, ppr_details con details]
-  where
-    ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsVar con, ppr t2]
-    ppr_details con (PrefixCon tys)  = hsep (pprHsVar con : map ppr tys)
-    ppr_details con (RecCon fields)  = ppr con <+> ppr_fields fields
-
-pprConDecl (ConDecl con expl tvs cxt details (ResTyGADT res_ty))
-  = sep [pprHsForAll expl tvs cxt, ppr con <+> ppr_details details]
-  where
-    ppr_details (PrefixCon arg_tys) = dcolon <+> ppr (foldr mk_fun_ty res_ty arg_tys)
-    ppr_details (RecCon fields)     = ppr fields <+> dcolon <+> ppr res_ty
-
-    mk_fun_ty a b = noLoc (HsFunTy a b)
-
-ppr_fields fields = braces (sep (punctuate comma (map ppr_field fields)))
-ppr_field (n, ty) = ppr n <+> dcolon <+> ppr ty
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[InstDecl]{An instance declaration
-%*									*
-%************************************************************************
-
-\begin{code}
-type LInstDecl name = Located (InstDecl name)
-
-data InstDecl name
-  = InstDecl	(LHsType name)	-- Context => Class Instance-type
-				-- Using a polytype means that the renamer conveniently
-				-- figures out the quantified type variables for us.
-		(LHsBinds name)
-		[LSig name]		-- User-supplied pragmatic info
-
-instance (OutputableBndr name) => Outputable (InstDecl name) where
-
-    ppr (InstDecl inst_ty binds uprags)
-      = vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
-	      nest 4 (ppr uprags),
-	      nest 4 (pprLHsBinds binds) ]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[DefaultDecl]{A @default@ declaration}
-%*									*
-%************************************************************************
-
-There can only be one default declaration per module, but it is hard
-for the parser to check that; we pass them all through in the abstract
-syntax, and that restriction must be checked in the front end.
-
-\begin{code}
-type LDefaultDecl name = Located (DefaultDecl name)
-
-data DefaultDecl name
-  = DefaultDecl	[LHsType name]
-
-instance (OutputableBndr name)
-	      => Outputable (DefaultDecl name) where
-
-    ppr (DefaultDecl tys)
-      = ptext SLIT("default") <+> parens (interpp'SP tys)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Foreign function interface declaration}
-%*									*
-%************************************************************************
-
-\begin{code}
-
--- foreign declarations are distinguished as to whether they define or use a
--- Haskell name
---
---  * the Boolean value indicates whether the pre-standard deprecated syntax
---   has been used
---
-type LForeignDecl name = Located (ForeignDecl name)
-
-data ForeignDecl name
-  = ForeignImport (Located name) (LHsType name) ForeignImport Bool  -- defines name
-  | ForeignExport (Located name) (LHsType name) ForeignExport Bool  -- uses name
-
--- specification of an imported external entity in dependence on the calling
--- convention 
---
-data ForeignImport = -- import of a C entity
-		     --
-                     --  * the two strings specifying a header file or library
-                     --   may be empty, which indicates the absence of a
-                     --   header or object specification (both are not used
-                     --   in the case of `CWrapper' and when `CFunction'
-                     --   has a dynamic target)
-		     --
-		     --  * the calling convention is irrelevant for code
-		     --   generation in the case of `CLabel', but is needed
-		     --   for pretty printing 
-		     --
-		     --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
-		     --
-		     CImport  CCallConv	      -- ccall or stdcall
-			      Safety	      -- safe or unsafe
-			      FastString      -- name of C header
-			      FastString      -- name of library object
-			      CImportSpec     -- details of the C entity
-
-                     -- import of a .NET function
-		     --
-		   | DNImport DNCallSpec
-
--- details of an external C entity
---
-data CImportSpec = CLabel    CLabelString     -- import address of a C label
-		 | CFunction CCallTarget      -- static or dynamic function
-		 | CWrapper		      -- wrapper to expose closures
-					      -- (former f.e.d.)
-
--- specification of an externally exported entity in dependence on the calling
--- convention
---
-data ForeignExport = CExport  CExportSpec    -- contains the calling convention
-		   | DNExport		     -- presently unused
-
--- abstract type imported from .NET
---
-data FoType = DNType 		-- In due course we'll add subtype stuff
-	    deriving (Eq)	-- Used for equality instance for TyClDecl
-
-
--- pretty printing of foreign declarations
---
-
-instance OutputableBndr name => Outputable (ForeignDecl name) where
-  ppr (ForeignImport n ty fimport _) =
-    ptext SLIT("foreign import") <+> ppr fimport <+> 
-    ppr n <+> dcolon <+> ppr ty
-  ppr (ForeignExport n ty fexport _) =
-    ptext SLIT("foreign export") <+> ppr fexport <+> 
-    ppr n <+> dcolon <+> ppr ty
-
-instance Outputable ForeignImport where
-  ppr (DNImport			        spec) = 
-    ptext SLIT("dotnet") <+> ppr spec
-  ppr (CImport  cconv safety header lib spec) =
-    ppr cconv <+> ppr safety <+> 
-    char '"' <> pprCEntity header lib spec <> char '"'
-    where
-      pprCEntity header lib (CLabel lbl) = 
-        ptext SLIT("static") <+> ftext header <+> char '&' <>
-	pprLib lib <> ppr lbl
-      pprCEntity header lib (CFunction (StaticTarget lbl)) = 
-        ptext SLIT("static") <+> ftext header <+> char '&' <>
-	pprLib lib <> ppr lbl
-      pprCEntity header lib (CFunction (DynamicTarget)) = 
-        ptext SLIT("dynamic")
-      pprCEntity _      _   (CWrapper) = ptext SLIT("wrapper")
-      --
-      pprLib lib | nullFS lib = empty
-		 | otherwise  = char '[' <> ppr lib <> char ']'
-
-instance Outputable ForeignExport where
-  ppr (CExport  (CExportStatic lbl cconv)) = 
-    ppr cconv <+> char '"' <> ppr lbl <> char '"'
-  ppr (DNExport                          ) = 
-    ptext SLIT("dotnet") <+> ptext SLIT("\"<unused>\"")
-
-instance Outputable FoType where
-  ppr DNType = ptext SLIT("type dotnet")
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Transformation rules}
-%*									*
-%************************************************************************
-
-\begin{code}
-type LRuleDecl name = Located (RuleDecl name)
-
-data RuleDecl name
-  = HsRule			-- Source rule
-	RuleName		-- Rule name
-	Activation
-	[RuleBndr name]		-- Forall'd vars; after typechecking this includes tyvars
-	(Located (HsExpr name))	-- LHS
-        NameSet                 -- Free-vars from the LHS
-	(Located (HsExpr name))	-- RHS
-        NameSet                 -- Free-vars from the RHS
-
-data RuleBndr name
-  = RuleBndr (Located name)
-  | RuleBndrSig (Located name) (LHsType name)
-
-collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
-collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
-
-instance OutputableBndr name => Outputable (RuleDecl name) where
-  ppr (HsRule name act ns lhs fv_lhs rhs fv_rhs)
-	= sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
-	       nest 4 (pp_forall <+> pprExpr (unLoc lhs)), 
-	       nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
-	where
-	  pp_forall | null ns   = empty
-		    | otherwise	= text "forall" <+> fsep (map ppr ns) <> dot
-
-instance OutputableBndr name => Outputable (RuleBndr name) where
-   ppr (RuleBndr name) = ppr name
-   ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[DeprecDecl]{Deprecations}
-%*									*
-%************************************************************************
-
-We use exported entities for things to deprecate.
-
-\begin{code}
-type LDeprecDecl name = Located (DeprecDecl name)
-
-data DeprecDecl name = Deprecation name DeprecTxt
-
-instance OutputableBndr name => Outputable (DeprecDecl name) where
-    ppr (Deprecation thing txt)
-      = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
-\end{code}
diff --git a/ghc/compiler/hsSyn/HsExpr.hi-boot-5 b/ghc/compiler/hsSyn/HsExpr.hi-boot-5
deleted file mode 100644
index 05e2eb5394..0000000000
--- a/ghc/compiler/hsSyn/HsExpr.hi-boot-5
+++ /dev/null
@@ -1,14 +0,0 @@
-__interface HsExpr 1 0 where
-__export HsExpr HsExpr pprExpr Match GRHSs LHsExpr LMatch pprPatBind pprFunBind ;
-
-1 data HsExpr i ;
-1 data Match a ;
-1 data GRHSs a ;
-
-1 type LHsExpr a = SrcLoc.Located (HsExpr a) ;
-1 type LMatch a  = SrcLoc.Located (Match a) ;
-
-1 pprExpr :: __forall [i] {Outputable.OutputableBndr i} => HsExpr.HsExpr i -> Outputable.SDoc ;
-1 pprPatBind :: __forall [i] {Outputable.OutputableBndr i} => HsPat.LPat i -> HsExpr.GRHSs i -> Outputable.SDoc ;
-1 pprFunBind :: __forall [i] {Outputable.OutputableBndr i} => i -> [HsExpr.LMatch i] -> Outputable.SDoc ;
-
diff --git a/ghc/compiler/hsSyn/HsExpr.hi-boot-6 b/ghc/compiler/hsSyn/HsExpr.hi-boot-6
deleted file mode 100644
index 40e18ef971..0000000000
--- a/ghc/compiler/hsSyn/HsExpr.hi-boot-6
+++ /dev/null
@@ -1,22 +0,0 @@
-module HsExpr where
-
-data HsExpr i
-data HsSplice i
-data MatchGroup a
-data GRHSs a
-
-type LHsExpr a = SrcLoc.Located (HsExpr a)
-type SyntaxExpr a = HsExpr a
-type PostTcExpr = HsExpr Var.Id
-
-pprExpr :: (Outputable.OutputableBndr i) => 
-	HsExpr.HsExpr i -> Outputable.SDoc
-
-pprSplice :: (Outputable.OutputableBndr i) => 
-	HsExpr.HsSplice i -> Outputable.SDoc
-
-pprPatBind :: (Outputable.OutputableBndr b, Outputable.OutputableBndr i) => 
-	HsPat.LPat b -> HsExpr.GRHSs i -> Outputable.SDoc
-
-pprFunBind :: (Outputable.OutputableBndr i) => 
-	i -> HsExpr.MatchGroup i -> Outputable.SDoc
diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs
deleted file mode 100644
index dbdd24c3c5..0000000000
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ /dev/null
@@ -1,975 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[HsExpr]{Abstract Haskell syntax: expressions}
-
-\begin{code}
-module HsExpr where
-
-#include "HsVersions.h"
-
--- friends:
-import HsDecls		( HsGroup )
-import HsPat		( LPat )
-import HsLit		( HsLit(..), HsOverLit )
-import HsTypes		( LHsType, PostTcType )
-import HsImpExp		( isOperator, pprHsVar )
-import HsBinds		( HsLocalBinds, DictBinds, ExprCoFn, isEmptyLocalBinds )
-
--- others:
-import Type		( Type, pprParendType )
-import Var		( TyVar, Id )
-import Name		( Name )
-import BasicTypes	( IPName, Boxity, tupleParens, Arity, Fixity(..) )
-import SrcLoc		( Located(..), unLoc )
-import Outputable	
-import FastString
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Expressions proper}
-%*									*
-%************************************************************************
-
-\begin{code}
-type LHsExpr id = Located (HsExpr id)
-
--------------------------
--- PostTcExpr is an evidence expression attached to the
--- syntax tree by the type checker (c.f. postTcType)
--- We use a PostTcTable where there are a bunch of pieces of 
--- evidence, more than is convenient to keep individually
-type PostTcExpr  = HsExpr Id
-type PostTcTable = [(Name, Id)]
-
-noPostTcExpr :: PostTcExpr
-noPostTcExpr = HsLit (HsString FSLIT("noPostTcExpr"))
-
-noPostTcTable :: PostTcTable
-noPostTcTable = []
-
--------------------------
--- SyntaxExpr is like PostTcExpr, but it's filled in a little earlier,
--- by the renamer.  It's used for rebindable syntax.  
--- E.g. (>>=) is filled in before the renamer by the appropriate Name
---      for (>>=), and then instantiated by the type checker with its
---	type args tec
-
-type SyntaxExpr id = HsExpr id
-
-noSyntaxExpr :: SyntaxExpr id	-- Before renaming, and sometimes after,
-				-- (if the syntax slot makes no sense)
-noSyntaxExpr = HsLit (HsString FSLIT("noSyntaxExpr"))
-
-
-type SyntaxTable id = [(Name, SyntaxExpr id)]
---	*** Currently used only for CmdTop (sigh) ***
--- * Before the renamer, this list is noSyntaxTable
---
--- * After the renamer, it takes the form [(std_name, HsVar actual_name)]
---   For example, for the 'return' op of a monad
---	normal case:		(GHC.Base.return, HsVar GHC.Base.return)
---	with rebindable syntax:	(GHC.Base.return, return_22)
---		where return_22 is whatever "return" is in scope
---
--- * After the type checker, it takes the form [(std_name, <expression>)]
---	where <expression> is the evidence for the method
-
-noSyntaxTable :: SyntaxTable id
-noSyntaxTable = []
-
-
--------------------------
-data HsExpr id
-  = HsVar	id		-- variable
-  | HsIPVar	(IPName id)	-- implicit parameter
-  | HsOverLit	(HsOverLit id)	-- Overloaded literals
-  | HsLit	HsLit		-- Simple (non-overloaded) literals
-
-  | HsLam	(MatchGroup  id)	-- Currently always a single match
-
-  | HsApp	(LHsExpr id)		-- Application
-		(LHsExpr id)
-
-  -- Operator applications:
-  -- NB Bracketed ops such as (+) come out as Vars.
-
-  -- NB We need an expr for the operator in an OpApp/Section since
-  -- the typechecker may need to apply the operator to a few types.
-
-  | OpApp	(LHsExpr id)	-- left operand
-		(LHsExpr id)	-- operator
-		Fixity		-- Renamer adds fixity; bottom until then
-		(LHsExpr id)	-- right operand
-
-  | NegApp	(LHsExpr id)	-- negated expr
-		(SyntaxExpr id)	-- Name of 'negate'
-
-  | HsPar	(LHsExpr id)	-- parenthesised expr
-
-  | SectionL	(LHsExpr id)	-- operand
-		(LHsExpr id)	-- operator
-  | SectionR	(LHsExpr id)	-- operator
-		(LHsExpr id)	-- operand
-				
-  | HsCase	(LHsExpr id)
-		(MatchGroup id)
-
-  | HsIf	(LHsExpr id)	--  predicate
-		(LHsExpr id)	--  then part
-		(LHsExpr id)	--  else part
-
-  | HsLet	(HsLocalBinds id) -- let(rec)
-		(LHsExpr  id)
-
-  | HsDo	(HsStmtContext Name)	-- The parameterisation is unimportant
-					-- because in this context we never use
-					-- the PatGuard or ParStmt variant
-		[LStmt id]		-- "do":one or more stmts
-		(LHsExpr id)		-- The body; the last expression in the 'do'
-					--	     of [ body | ... ] in a list comp
-		PostTcType		-- Type of the whole expression
-
-  | ExplicitList		-- syntactic list
-		PostTcType	-- Gives type of components of list
-		[LHsExpr id]
-
-  | ExplicitPArr		-- syntactic parallel array: [:e1, ..., en:]
-		PostTcType	-- type of elements of the parallel array
-		[LHsExpr id]
-
-  | ExplicitTuple		-- tuple
-		[LHsExpr id]
-				-- NB: Unit is ExplicitTuple []
-				-- for tuples, we can get the types
-				-- direct from the components
-		Boxity
-
-
-	-- Record construction
-  | RecordCon	(Located id)		-- The constructor.  After type checking
-					-- it's the dataConWrapId of the constructor
-		PostTcExpr		-- Data con Id applied to type args
-		(HsRecordBinds id)
-
-	-- Record update
-  | RecordUpd	(LHsExpr id)
-		(HsRecordBinds id)
-		PostTcType		-- Type of *input* record
-		PostTcType		-- Type of *result* record (may differ from
-					-- 	type of input record)
-
-  | ExprWithTySig			-- e :: type
-		(LHsExpr id)
-		(LHsType id)
-
-  | ExprWithTySigOut			-- TRANSLATION
-		(LHsExpr id)
-		(LHsType Name)		-- Retain the signature for round-tripping purposes
-
-  | ArithSeq				-- arithmetic sequence
-		PostTcExpr
-		(ArithSeqInfo id)
-
-  | PArrSeq	           		-- arith. sequence for parallel array
-		PostTcExpr		-- [:e1..e2:] or [:e1, e2..e3:]
-		(ArithSeqInfo id)
-
-  | HsSCC	FastString	-- "set cost centre" (_scc_) annotation
-		(LHsExpr id) 	-- expr whose cost is to be measured
-
-  | HsCoreAnn   FastString      -- hdaume: core annotation
-                (LHsExpr id)
-		
-  -----------------------------------------------------------
-  -- MetaHaskell Extensions
-  | HsBracket    (HsBracket id)
-
-  | HsBracketOut (HsBracket Name)	-- Output of the type checker is the *original*
-		 [PendingSplice]	-- renamed expression, plus *typechecked* splices
-					-- to be pasted back in by the desugarer
-
-  | HsSpliceE (HsSplice id) 
-
-  -----------------------------------------------------------
-  -- Arrow notation extension
-
-  | HsProc	(LPat id)		-- arrow abstraction, proc
-		(LHsCmdTop id)		-- body of the abstraction
-					-- always has an empty stack
-
-  ---------------------------------------
-  -- The following are commands, not expressions proper
-
-  | HsArrApp	-- Arrow tail, or arrow application (f -< arg)
-	(LHsExpr id)	-- arrow expression, f
-	(LHsExpr id)	-- input expression, arg
-	PostTcType	-- type of the arrow expressions f,
-			-- of the form a t t', where arg :: t
-	HsArrAppType	-- higher-order (-<<) or first-order (-<)
-	Bool		-- True => right-to-left (f -< arg)
-			-- False => left-to-right (arg >- f)
-
-  | HsArrForm	-- Command formation,  (| e cmd1 .. cmdn |)
-	(LHsExpr id)	-- the operator
-			-- after type-checking, a type abstraction to be
-			-- applied to the type of the local environment tuple
-	(Maybe Fixity)	-- fixity (filled in by the renamer), for forms that
-			-- were converted from OpApp's by the renamer
-	[LHsCmdTop id]	-- argument commands
-\end{code}
-
-
-These constructors only appear temporarily in the parser.
-The renamer translates them into the Right Thing.
-
-\begin{code}
-  | EWildPat			-- wildcard
-
-  | EAsPat	(Located id)	-- as pattern
-		(LHsExpr id)
-
-  | ELazyPat	(LHsExpr id) -- ~ pattern
-
-  | HsType      (LHsType id)     -- Explicit type argument; e.g  f {| Int |} x y
-\end{code}
-
-Everything from here on appears only in typechecker output.
-
-\begin{code}
-  | TyLam			-- TRANSLATION
-		[TyVar]
-		(LHsExpr id)
-  | TyApp			-- TRANSLATION
-		(LHsExpr id) -- generated by Spec
-		[Type]
-
-  -- DictLam and DictApp are "inverses"
-  |  DictLam
-		[id]
-		(LHsExpr id)
-  |  DictApp
-		(LHsExpr id)
-		[id]
-
-  |  HsCoerce	ExprCoFn 	-- TRANSLATION
-		(HsExpr id)
-
-type PendingSplice = (Name, LHsExpr Id)	-- Typechecked splices, waiting to be 
-					-- pasted back in by the desugarer
-\end{code}
-
-A @Dictionary@, unless of length 0 or 1, becomes a tuple.  A
-@ClassDictLam dictvars methods expr@ is, therefore:
-\begin{verbatim}
-\ x -> case x of ( dictvars-and-methods-tuple ) -> expr
-\end{verbatim}
-
-\begin{code}
-instance OutputableBndr id => Outputable (HsExpr id) where
-    ppr expr = pprExpr expr
-\end{code}
-
-\begin{code}
-pprExpr :: OutputableBndr id => HsExpr id -> SDoc
-
-pprExpr  e = pprDeeper (ppr_expr e)
-
-pprBinds :: OutputableBndr id => HsLocalBinds id -> SDoc
-pprBinds b = pprDeeper (ppr b)
-
-ppr_lexpr :: OutputableBndr id => LHsExpr id -> SDoc
-ppr_lexpr e = ppr_expr (unLoc e)
-
-ppr_expr (HsVar v)	 = pprHsVar v
-ppr_expr (HsIPVar v)     = ppr v
-ppr_expr (HsLit lit)     = ppr lit
-ppr_expr (HsOverLit lit) = ppr lit
-
-ppr_expr (HsApp e1 e2)
-  = let (fun, args) = collect_args e1 [e2] in
-    (ppr_lexpr fun) <+> (sep (map pprParendExpr args))
-  where
-    collect_args (L _ (HsApp fun arg)) args = collect_args fun (arg:args)
-    collect_args fun args = (fun, args)
-
-ppr_expr (OpApp e1 op fixity e2)
-  = case unLoc op of
-      HsVar v -> pp_infixly v
-      _	      -> pp_prefixly
-  where
-    pp_e1 = pprParendExpr e1		-- Add parens to make precedence clear
-    pp_e2 = pprParendExpr e2
-
-    pp_prefixly
-      = hang (ppr op) 4 (sep [pp_e1, pp_e2])
-
-    pp_infixly v
-      = sep [pp_e1, hsep [pprInfix v, pp_e2]]
-
-ppr_expr (NegApp e _) = char '-' <+> pprParendExpr e
-
-ppr_expr (HsPar e) = parens (ppr_lexpr e)
-
-ppr_expr (SectionL expr op)
-  = case unLoc op of
-      HsVar v -> pp_infixly v
-      _	      -> pp_prefixly
-  where
-    pp_expr = pprParendExpr expr
-
-    pp_prefixly = hang (hsep [text " \\ x_ ->", ppr op])
-		       4 (hsep [pp_expr, ptext SLIT("x_ )")])
-    pp_infixly v = parens (sep [pp_expr, pprInfix v])
-
-ppr_expr (SectionR op expr)
-  = case unLoc op of
-      HsVar v -> pp_infixly v
-      _	      -> pp_prefixly
-  where
-    pp_expr = pprParendExpr expr
-
-    pp_prefixly = hang (hsep [text "( \\ x_ ->", ppr op, ptext SLIT("x_")])
-		       4 ((<>) pp_expr rparen)
-    pp_infixly v
-      = parens (sep [pprInfix v, pp_expr])
-
-ppr_expr (HsLam matches) 
-  = pprMatches LambdaExpr matches
-
-ppr_expr (HsCase expr matches)
-  = sep [ sep [ptext SLIT("case"), nest 4 (ppr expr), ptext SLIT("of")],
-	    nest 2 (pprMatches CaseAlt matches) ]
-
-ppr_expr (HsIf e1 e2 e3)
-  = sep [hsep [ptext SLIT("if"), nest 2 (ppr e1), ptext SLIT("then")],
-	   nest 4 (ppr e2),
-	   ptext SLIT("else"),
-	   nest 4 (ppr e3)]
-
--- special case: let ... in let ...
-ppr_expr (HsLet binds expr@(L _ (HsLet _ _)))
-  = sep [hang (ptext SLIT("let")) 2 (hsep [pprBinds binds, ptext SLIT("in")]),
-	 ppr_lexpr expr]
-
-ppr_expr (HsLet binds expr)
-  = sep [hang (ptext SLIT("let")) 2 (pprBinds binds),
-	 hang (ptext SLIT("in"))  2 (ppr expr)]
-
-ppr_expr (HsDo do_or_list_comp stmts body _) = pprDo do_or_list_comp stmts body
-
-ppr_expr (ExplicitList _ exprs)
-  = brackets (fsep (punctuate comma (map ppr_lexpr exprs)))
-
-ppr_expr (ExplicitPArr _ exprs)
-  = pa_brackets (fsep (punctuate comma (map ppr_lexpr exprs)))
-
-ppr_expr (ExplicitTuple exprs boxity)
-  = tupleParens boxity (sep (punctuate comma (map ppr_lexpr exprs)))
-
-ppr_expr (RecordCon con_id con_expr rbinds)
-  = pp_rbinds (ppr con_id) rbinds
-
-ppr_expr (RecordUpd aexp rbinds _ _)
-  = pp_rbinds (pprParendExpr aexp) rbinds
-
-ppr_expr (ExprWithTySig expr sig)
-  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
-	 4 (ppr sig)
-ppr_expr (ExprWithTySigOut expr sig)
-  = hang (nest 2 (ppr_lexpr expr) <+> dcolon)
-	 4 (ppr sig)
-
-ppr_expr (ArithSeq expr info) = brackets (ppr info)
-ppr_expr (PArrSeq expr info)  = pa_brackets (ppr info)
-
-ppr_expr EWildPat     = char '_'
-ppr_expr (ELazyPat e) = char '~' <> pprParendExpr e
-ppr_expr (EAsPat v e) = ppr v <> char '@' <> pprParendExpr e
-
-ppr_expr (HsSCC lbl expr)
-  = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ftext lbl), pprParendExpr expr ]
-
-ppr_expr (TyLam tyvars expr)
-  = hang (hsep [ptext SLIT("/\\"), 
-		hsep (map (pprBndr LambdaBind) tyvars), 
-		ptext SLIT("->")])
-	 4 (ppr_lexpr expr)
-
-ppr_expr (TyApp expr [ty])
-  = hang (ppr_lexpr expr) 4 (pprParendType ty)
-
-ppr_expr (TyApp expr tys)
-  = hang (ppr_lexpr expr)
-	 4 (brackets (interpp'SP tys))
-
-ppr_expr (DictLam dictvars expr)
-  = hang (hsep [ptext SLIT("\\{-dict-}"), 
-	  	hsep (map (pprBndr LambdaBind) dictvars), 
-		ptext SLIT("->")])
-	 4 (ppr_lexpr expr)
-
-ppr_expr (DictApp expr [dname])
-  = hang (ppr_lexpr expr) 4 (ppr dname)
-
-ppr_expr (DictApp expr dnames)
-  = hang (ppr_lexpr expr)
-	 4 (brackets (interpp'SP dnames))
-
-ppr_expr (HsCoerce co_fn e) = ppr_expr e
-
-ppr_expr (HsType id) = ppr id
-
-ppr_expr (HsSpliceE s)       = pprSplice s
-ppr_expr (HsBracket b)       = pprHsBracket b
-ppr_expr (HsBracketOut e []) = ppr e	
-ppr_expr (HsBracketOut e ps) = ppr e $$ ptext SLIT("pending") <+> ppr ps
-
-ppr_expr (HsProc pat (L _ (HsCmdTop cmd _ _ _)))
-  = hsep [ptext SLIT("proc"), ppr pat, ptext SLIT("->"), ppr cmd]
-
-ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp True)
-  = hsep [ppr_lexpr arrow, ptext SLIT("-<"), ppr_lexpr arg]
-ppr_expr (HsArrApp arrow arg _ HsFirstOrderApp False)
-  = hsep [ppr_lexpr arg, ptext SLIT(">-"), ppr_lexpr arrow]
-ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp True)
-  = hsep [ppr_lexpr arrow, ptext SLIT("-<<"), ppr_lexpr arg]
-ppr_expr (HsArrApp arrow arg _ HsHigherOrderApp False)
-  = hsep [ppr_lexpr arg, ptext SLIT(">>-"), ppr_lexpr arrow]
-
-ppr_expr (HsArrForm (L _ (HsVar v)) (Just _) [arg1, arg2])
-  = sep [pprCmdArg (unLoc arg1), hsep [pprInfix v, pprCmdArg (unLoc arg2)]]
-ppr_expr (HsArrForm op _ args)
-  = hang (ptext SLIT("(|") <> ppr_lexpr op)
-	 4 (sep (map (pprCmdArg.unLoc) args) <> ptext SLIT("|)"))
-
-pprCmdArg :: OutputableBndr id => HsCmdTop id -> SDoc
-pprCmdArg (HsCmdTop cmd@(L _ (HsArrForm _ Nothing [])) _ _ _)
-  = ppr_lexpr cmd
-pprCmdArg (HsCmdTop cmd _ _ _)
-  = parens (ppr_lexpr cmd)
-
--- Put a var in backquotes if it's not an operator already
-pprInfix :: Outputable name => name -> SDoc
-pprInfix v | isOperator ppr_v = ppr_v
-	   | otherwise        = char '`' <> ppr_v <> char '`'
-	   where
-	     ppr_v = ppr v
-
--- add parallel array brackets around a document
---
-pa_brackets :: SDoc -> SDoc
-pa_brackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")    
-\end{code}
-
-Parenthesize unless very simple:
-\begin{code}
-pprParendExpr :: OutputableBndr id => LHsExpr id -> SDoc
-pprParendExpr expr
-  = let
-	pp_as_was = ppr_lexpr expr
-	-- Using ppr_expr here avoids the call to 'deeper'
-	-- Not sure if that's always right.
-    in
-    case unLoc expr of
-      HsLit l		-> ppr l
-      HsOverLit l 	-> ppr l
-			
-      HsVar _		-> pp_as_was
-      HsIPVar _		-> pp_as_was
-      ExplicitList _ _  -> pp_as_was
-      ExplicitPArr _ _  -> pp_as_was
-      ExplicitTuple _ _	-> pp_as_was
-      HsPar _		-> pp_as_was
-      HsBracket _	-> pp_as_was
-      HsBracketOut _ []	-> pp_as_was
-			
-      _			-> parens pp_as_was
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Commands (in arrow abstractions)}
-%*									*
-%************************************************************************
-
-We re-use HsExpr to represent these.
-
-\begin{code}
-type HsCmd id = HsExpr id
-
-type LHsCmd id = LHsExpr id
-
-data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp
-\end{code}
-
-The legal constructors for commands are:
-
-  = HsArrApp ...		-- as above
-
-  | HsArrForm ...		-- as above
-
-  | HsApp	(HsCmd id)
-		(HsExpr id)
-
-  | HsLam	(Match  id)	-- kappa
-
-  -- the renamer turns this one into HsArrForm
-  | OpApp	(HsExpr id)	-- left operand
-		(HsCmd id)	-- operator
-		Fixity		-- Renamer adds fixity; bottom until then
-		(HsCmd id)	-- right operand
-
-  | HsPar	(HsCmd id)	-- parenthesised command
-
-  | HsCase	(HsExpr id)
-		[Match id]	-- bodies are HsCmd's
-		SrcLoc
-
-  | HsIf	(HsExpr id)	--  predicate
-		(HsCmd id)	--  then part
-		(HsCmd id)	--  else part
-		SrcLoc
-
-  | HsLet	(HsLocalBinds id)	-- let(rec)
-		(HsCmd  id)
-
-  | HsDo	(HsStmtContext Name)	-- The parameterisation is unimportant
-					-- because in this context we never use
-					-- the PatGuard or ParStmt variant
-		[Stmt id]	-- HsExpr's are really HsCmd's
-		PostTcType	-- Type of the whole expression
-		SrcLoc
-
-Top-level command, introducing a new arrow.
-This may occur inside a proc (where the stack is empty) or as an
-argument of a command-forming operator.
-
-\begin{code}
-type LHsCmdTop id = Located (HsCmdTop id)
-
-data HsCmdTop id
-  = HsCmdTop	(LHsCmd id)
-		[PostTcType]	-- types of inputs on the command's stack
-		PostTcType	-- return type of the command
-		(SyntaxTable id)
-				-- after type checking:
-				-- names used in the command's desugaring
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Record binds}
-%*									*
-%************************************************************************
-
-\begin{code}
-type HsRecordBinds id = [(Located id, LHsExpr id)]
-
-recBindFields :: HsRecordBinds id -> [id]
-recBindFields rbinds = [unLoc field | (field,_) <- rbinds]
-
-pp_rbinds :: OutputableBndr id => SDoc -> HsRecordBinds id -> SDoc
-pp_rbinds thing rbinds
-  = hang thing 
-	 4 (braces (sep (punctuate comma (map (pp_rbind) rbinds))))
-  where
-    pp_rbind (v, e) = hsep [pprBndr LetBind (unLoc v), char '=', ppr e]
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{@Match@, @GRHSs@, and @GRHS@ datatypes}
-%*									*
-%************************************************************************
-
-@Match@es are sets of pattern bindings and right hand sides for
-functions, patterns or case branches. For example, if a function @g@
-is defined as:
-\begin{verbatim}
-g (x,y) = y
-g ((x:ys),y) = y+1,
-\end{verbatim}
-then \tr{g} has two @Match@es: @(x,y) = y@ and @((x:ys),y) = y+1@.
-
-It is always the case that each element of an @[Match]@ list has the
-same number of @pats@s inside it.  This corresponds to saying that
-a function defined by pattern matching must have the same number of
-patterns in each equation.
-
-\begin{code}
-data MatchGroup id 
-  = MatchGroup 
-	[LMatch id] 	-- The alternatives
-	PostTcType	-- The type is the type of the entire group
-			-- 	t1 -> ... -> tn -> tr
-			-- where there are n patterns
-
-type LMatch id = Located (Match id)
-
-data Match id
-  = Match
-	[LPat id]		-- The patterns
-	(Maybe (LHsType id))	-- A type signature for the result of the match
-				--	Nothing after typechecking
-	(GRHSs id)
-
-matchGroupArity :: MatchGroup id -> Arity
-matchGroupArity (MatchGroup (match:matches) _)
-  = ASSERT( all ((== n_pats) . length . hsLMatchPats) matches )
-	-- Assertion just checks that all the matches have the same number of pats
-    n_pats
-  where
-    n_pats = length (hsLMatchPats match)
-
-hsLMatchPats :: LMatch id -> [LPat id]
-hsLMatchPats (L _ (Match pats _ _)) = pats
-
--- GRHSs are used both for pattern bindings and for Matches
-data GRHSs id	
-  = GRHSs [LGRHS id]		-- Guarded RHSs
-	  (HsLocalBinds id)	-- The where clause
-
-type LGRHS id = Located (GRHS id)
-
-data GRHS id = GRHS [LStmt id]		-- Guards
-		    (LHsExpr id)	-- Right hand side
-\end{code}
-
-We know the list must have at least one @Match@ in it.
-
-\begin{code}
-pprMatches :: (OutputableBndr id) => HsMatchContext id -> MatchGroup id -> SDoc
-pprMatches ctxt (MatchGroup matches _) = vcat (map (pprMatch ctxt) (map unLoc matches))
-
--- Exported to HsBinds, which can't see the defn of HsMatchContext
-pprFunBind :: (OutputableBndr id) => id -> MatchGroup id -> SDoc
-pprFunBind fun matches = pprMatches (FunRhs fun) matches
-
--- Exported to HsBinds, which can't see the defn of HsMatchContext
-pprPatBind :: (OutputableBndr bndr, OutputableBndr id)
-	   => LPat bndr -> GRHSs id -> SDoc
-pprPatBind pat grhss = sep [ppr pat, nest 4 (pprGRHSs PatBindRhs grhss)]
-
-
-pprMatch :: OutputableBndr id => HsMatchContext id -> Match id -> SDoc
-pprMatch ctxt (Match pats maybe_ty grhss)
-  = pp_name ctxt <+> sep [sep (map ppr pats), 
-		     ppr_maybe_ty, 
-		     nest 2 (pprGRHSs ctxt grhss)]
-  where
-    pp_name (FunRhs fun) = ppr fun	-- Not pprBndr; the AbsBinds will
-					-- have printed the signature
-    pp_name LambdaExpr   = char '\\'
-    pp_name other	 = empty
-
-    ppr_maybe_ty = case maybe_ty of
-			Just ty -> dcolon <+> ppr ty
-			Nothing -> empty
-
-
-pprGRHSs :: OutputableBndr id => HsMatchContext id -> GRHSs id -> SDoc
-pprGRHSs ctxt (GRHSs grhss binds)
-  = vcat (map (pprGRHS ctxt . unLoc) grhss)
-    $$
-    (if isEmptyLocalBinds binds then empty
-     else text "where" $$ nest 4 (pprBinds binds))
-
-pprGRHS :: OutputableBndr id => HsMatchContext id -> GRHS id -> SDoc
-
-pprGRHS ctxt (GRHS [] expr)
- =  pp_rhs ctxt expr
-
-pprGRHS ctxt (GRHS guards expr)
- = sep [char '|' <+> interpp'SP guards, pp_rhs ctxt expr]
-
-pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Do stmts and list comprehensions}
-%*									*
-%************************************************************************
-
-\begin{code}
-type LStmt id = Located (Stmt id)
-
--- The SyntaxExprs in here are used *only* for do-notation, which
--- has rebindable syntax.  Otherwise they are unused.
-data Stmt id
-  = BindStmt	(LPat id)		
-		(LHsExpr id) 
-		(SyntaxExpr id)		-- The (>>=) operator
-		(SyntaxExpr id)		-- The fail operator 
-		-- The fail operator is noSyntaxExpr 
-		-- if the pattern match can't fail
-
-  | ExprStmt	(LHsExpr id)
-		(SyntaxExpr id)		-- The (>>) operator
-		PostTcType		-- Element type of the RHS (used for arrows)
-
-  | LetStmt	(HsLocalBinds id)	
-
-	-- ParStmts only occur in a list comprehension
-  | ParStmt	[([LStmt id], [id])]	-- After renaming, the ids are the binders
-					-- bound by the stmts and used subsequently
-
-	-- Recursive statement (see Note [RecStmt] below)
-  | RecStmt  [LStmt id] 
-		--- The next two fields are only valid after renaming
-	     [id] 	-- The ids are a subset of the variables bound by the stmts
-	     	 	-- that are used in stmts that follow the RecStmt
-
-	     [id]	-- Ditto, but these variables are the "recursive" ones, that 
-			-- are used before they are bound in the stmts of the RecStmt
-			-- From a type-checking point of view, these ones have to be monomorphic
-
-		--- These fields are only valid after typechecking
-	     [PostTcExpr]	-- These expressions correspond
-				-- 1-to-1 with the "recursive" [id], and are the expresions that 
-				-- should be returned by the recursion.  They may not quite be the
-				-- Ids themselves, because the Id may be *polymorphic*, but
-				-- the returned thing has to be *monomorphic*.
-	     (DictBinds id)	-- Method bindings of Ids bound by the RecStmt,
-				-- and used afterwards
-\end{code}
-
-ExprStmts are a bit tricky, because what they mean
-depends on the context.  Consider the following contexts:
-
-	A do expression of type (m res_ty)
-	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-	* ExprStmt E any_ty:   do { ....; E; ... }
-		E :: m any_ty
-	  Translation: E >> ...
-	
-	A list comprehensions of type [elt_ty]
-	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-	* ExprStmt E Bool:   [ .. | .... E ]
-			[ .. | ..., E, ... ]
-			[ .. | .... | ..., E | ... ]
-		E :: Bool
-	  Translation: if E then fail else ...
-
-	A guard list, guarding a RHS of type rhs_ty
-	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-	* ExprStmt E Bool:   f x | ..., E, ... = ...rhs...
-		E :: Bool
-	  Translation: if E then fail else ...
-	
-Array comprehensions are handled like list comprehensions -=chak
-
-Note [RecStmt]
-~~~~~~~~~~~~~~
-Example:
-	HsDo [ BindStmt x ex
-
-	     , RecStmt [a::forall a. a -> a, b] 
-		       [a::Int -> Int,       c] 
-		       [ BindStmt b (return x)
-		       , LetStmt a = ea
-		       , BindStmt c ec ]
-
-	     , return (a b) ]
-
-Here, the RecStmt binds a,b,c; but 
-  - Only a,b are used in the stmts *following* the RecStmt, 
-	This 'a' is *polymorphic'
-  - Only a,c are used in the stmts *inside* the RecStmt
-	*before* their bindings
-	This 'a' is monomorphic
-
-Nota Bene: the two a's have different types, even though they
-have the same Name.
-
-
-\begin{code}
-instance OutputableBndr id => Outputable (Stmt id) where
-    ppr stmt = pprStmt stmt
-
-pprStmt (BindStmt pat expr _ _)	  = hsep [ppr pat, ptext SLIT("<-"), ppr expr]
-pprStmt (LetStmt binds)       	  = hsep [ptext SLIT("let"), pprBinds binds]
-pprStmt (ExprStmt expr _ _)   	  = ppr expr
-pprStmt (ParStmt stmtss)          = hsep (map (\stmts -> ptext SLIT("| ") <> ppr stmts) stmtss)
-pprStmt (RecStmt segment _ _ _ _) = ptext SLIT("rec") <+> braces (vcat (map ppr segment))
-
-pprDo :: OutputableBndr id => HsStmtContext any -> [LStmt id] -> LHsExpr id -> SDoc
-pprDo DoExpr      stmts body = hang (ptext SLIT("do"))  2 (vcat (map ppr stmts) $$ ppr body)
-pprDo (MDoExpr _) stmts body = hang (ptext SLIT("mdo")) 3 (vcat (map ppr stmts) $$ ppr body)
-pprDo ListComp    stmts body = pprComp brackets    stmts body
-pprDo PArrComp    stmts body = pprComp pa_brackets stmts body
-
-pprComp :: OutputableBndr id => (SDoc -> SDoc) -> [LStmt id] -> LHsExpr id -> SDoc
-pprComp brack quals body
-  = brack $
-	hang (ppr body <+> char '|')
-	     4 (interpp'SP quals)
-\end{code}
-
-%************************************************************************
-%*									*
-		Template Haskell quotation brackets
-%*									*
-%************************************************************************
-
-\begin{code}
-data HsSplice id  = HsSplice 	--  $z  or $(f 4)
-			id 		-- The id is just a unique name to 
-			(LHsExpr id) 	-- identify this splice point
-					
-instance OutputableBndr id => Outputable (HsSplice id) where
-  ppr = pprSplice
-
-pprSplice :: OutputableBndr id => HsSplice id -> SDoc
-pprSplice (HsSplice n e) = char '$' <> brackets (ppr n) <> pprParendExpr e
-
-
-data HsBracket id = ExpBr (LHsExpr id)		-- [|  expr  |]
-		  | PatBr (LPat id)		-- [p| pat   |]
-		  | DecBr (HsGroup id)		-- [d| decls |]
-		  | TypBr (LHsType id)		-- [t| type  |]
-		  | VarBr id			-- 'x, ''T
-
-instance OutputableBndr id => Outputable (HsBracket id) where
-  ppr = pprHsBracket
-
-
-pprHsBracket (ExpBr e) = thBrackets empty (ppr e)
-pprHsBracket (PatBr p) = thBrackets (char 'p') (ppr p)
-pprHsBracket (DecBr d) = thBrackets (char 'd') (ppr d)
-pprHsBracket (TypBr t) = thBrackets (char 't') (ppr t)
-pprHsBracket (VarBr n) = char '\'' <> ppr n
-	-- Infelicity: can't show ' vs '', because
-	-- we can't ask n what its OccName is, because the 
-	-- pretty-printer for HsExpr doesn't ask for NamedThings
-	-- But the pretty-printer for names will show the OccName class
-
-thBrackets pp_kind pp_body = char '[' <> pp_kind <> char '|' <+> 
-			     pp_body <+> ptext SLIT("|]")
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Enumerations and list comprehensions}
-%*									*
-%************************************************************************
-
-\begin{code}
-data ArithSeqInfo id
-  = From	    (LHsExpr id)
-  | FromThen 	    (LHsExpr id)
-		    (LHsExpr id)
-  | FromTo	    (LHsExpr id)
-		    (LHsExpr id)
-  | FromThenTo	    (LHsExpr id)
-		    (LHsExpr id)
-		    (LHsExpr id)
-\end{code}
-
-\begin{code}
-instance OutputableBndr id => Outputable (ArithSeqInfo id) where
-    ppr (From e1)		= hcat [ppr e1, pp_dotdot]
-    ppr (FromThen e1 e2)	= hcat [ppr e1, comma, space, ppr e2, pp_dotdot]
-    ppr (FromTo e1 e3)	= hcat [ppr e1, pp_dotdot, ppr e3]
-    ppr (FromThenTo e1 e2 e3)
-      = hcat [ppr e1, comma, space, ppr e2, pp_dotdot, ppr e3]
-
-pp_dotdot = ptext SLIT(" .. ")
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{HsMatchCtxt}
-%*									*
-%************************************************************************
-
-\begin{code}
-data HsMatchContext id	-- Context of a Match
-  = FunRhs id			-- Function binding for f
-  | CaseAlt			-- Guard on a case alternative
-  | LambdaExpr			-- Pattern of a lambda
-  | ProcExpr			-- Pattern of a proc
-  | PatBindRhs			-- Pattern binding
-  | RecUpd			-- Record update [used only in DsExpr to tell matchWrapper
-				-- 	what sort of runtime error message to generate]
-  | StmtCtxt (HsStmtContext id)	-- Pattern of a do-stmt or list comprehension
-  deriving ()
-
-data HsStmtContext id
-  = ListComp 
-  | DoExpr 
-  | MDoExpr PostTcTable			-- Recursive do-expression
-					-- (tiresomely, it needs table
-					--  of its return/bind ops)
-  | PArrComp				-- Parallel array comprehension
-  | PatGuard (HsMatchContext id)	-- Pattern guard for specified thing
-  | ParStmtCtxt (HsStmtContext id)	-- A branch of a parallel stmt 
-\end{code}
-
-\begin{code}
-isDoExpr :: HsStmtContext id -> Bool
-isDoExpr DoExpr      = True
-isDoExpr (MDoExpr _) = True
-isDoExpr other       = False
-\end{code}
-
-\begin{code}
-matchSeparator (FunRhs _)   = ptext SLIT("=")
-matchSeparator CaseAlt      = ptext SLIT("->") 
-matchSeparator LambdaExpr   = ptext SLIT("->") 
-matchSeparator ProcExpr     = ptext SLIT("->") 
-matchSeparator PatBindRhs   = ptext SLIT("=") 
-matchSeparator (StmtCtxt _) = ptext SLIT("<-")  
-matchSeparator RecUpd       = panic "unused"
-\end{code}
-
-\begin{code}
-pprMatchContext (FunRhs fun) 	  = ptext SLIT("the definition of") <+> quotes (ppr fun)
-pprMatchContext CaseAlt	     	  = ptext SLIT("a case alternative")
-pprMatchContext RecUpd	     	  = ptext SLIT("a record-update construct")
-pprMatchContext PatBindRhs   	  = ptext SLIT("a pattern binding")
-pprMatchContext LambdaExpr   	  = ptext SLIT("a lambda abstraction")
-pprMatchContext ProcExpr   	  = ptext SLIT("an arrow abstraction")
-pprMatchContext (StmtCtxt ctxt)   = ptext SLIT("a pattern binding in") $$ pprStmtContext ctxt
-
-pprMatchRhsContext (FunRhs fun) = ptext SLIT("a right-hand side of function") <+> quotes (ppr fun)
-pprMatchRhsContext CaseAlt	= ptext SLIT("the body of a case alternative")
-pprMatchRhsContext PatBindRhs	= ptext SLIT("the right-hand side of a pattern binding")
-pprMatchRhsContext LambdaExpr	= ptext SLIT("the body of a lambda")
-pprMatchRhsContext ProcExpr	= ptext SLIT("the body of a proc")
-pprMatchRhsContext RecUpd	= panic "pprMatchRhsContext"
-
-pprStmtContext (ParStmtCtxt c) = sep [ptext SLIT("a parallel branch of"), pprStmtContext c]
-pprStmtContext (PatGuard ctxt) = ptext SLIT("a pattern guard for") $$ pprMatchContext ctxt
-pprStmtContext DoExpr          = ptext SLIT("a 'do' expression")
-pprStmtContext (MDoExpr _)     = ptext SLIT("an 'mdo' expression")
-pprStmtContext ListComp        = ptext SLIT("a list comprehension")
-pprStmtContext PArrComp        = ptext SLIT("an array comprehension")
-
--- Used for the result statement of comprehension
--- e.g. the 'e' in	[ e | ... ]
---	or the 'r' in   f x = r
-pprStmtResultContext (PatGuard ctxt) = pprMatchRhsContext ctxt
-pprStmtResultContext other	     = ptext SLIT("the result of") <+> pprStmtContext other
-
-
--- Used to generate the string for a *runtime* error message
-matchContextErrString (FunRhs fun)    	      	 = "function " ++ showSDoc (ppr fun)
-matchContextErrString CaseAlt	      	      	 = "case"
-matchContextErrString PatBindRhs      	      	 = "pattern binding"
-matchContextErrString RecUpd	      	      	 = "record update"
-matchContextErrString LambdaExpr      	      	 = "lambda"
-matchContextErrString ProcExpr      	      	 = "proc"
-matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c)
-matchContextErrString (StmtCtxt (PatGuard _)) 	 = "pattern guard"
-matchContextErrString (StmtCtxt DoExpr)       	 = "'do' expression"
-matchContextErrString (StmtCtxt (MDoExpr _))   	 = "'mdo' expression"
-matchContextErrString (StmtCtxt ListComp)     	 = "list comprehension"
-matchContextErrString (StmtCtxt PArrComp)     	 = "array comprehension"
-\end{code}
diff --git a/ghc/compiler/hsSyn/HsExpr.lhs-boot b/ghc/compiler/hsSyn/HsExpr.lhs-boot
deleted file mode 100644
index 503701bf66..0000000000
--- a/ghc/compiler/hsSyn/HsExpr.lhs-boot
+++ /dev/null
@@ -1,27 +0,0 @@
-\begin{code}
-module HsExpr where
-
-import SrcLoc	  ( Located )
-import Outputable ( SDoc, OutputableBndr )
-import {-# SOURCE #-} HsPat  ( LPat )
-	
-data HsExpr i
-data HsSplice i
-data MatchGroup a
-data GRHSs a
-
-type LHsExpr a = Located (HsExpr a)
-type SyntaxExpr a = HsExpr a
-
-pprExpr :: (OutputableBndr i) => 
-	HsExpr i -> SDoc
-
-pprSplice :: (OutputableBndr i) => 
-	HsSplice i -> SDoc
-
-pprPatBind :: (OutputableBndr b, OutputableBndr i) => 
-	LPat b -> GRHSs i -> SDoc
-
-pprFunBind :: (OutputableBndr i) => 
-	i -> MatchGroup i -> SDoc
-\end{code}
diff --git a/ghc/compiler/hsSyn/HsImpExp.lhs b/ghc/compiler/hsSyn/HsImpExp.lhs
deleted file mode 100644
index 220afb7499..0000000000
--- a/ghc/compiler/hsSyn/HsImpExp.lhs
+++ /dev/null
@@ -1,125 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[HsImpExp]{Abstract syntax: imports, exports, interfaces}
-
-\begin{code}
-module HsImpExp where
-
-#include "HsVersions.h"
-
-import Module		( Module )
-import Outputable
-import FastString
-import SrcLoc		( Located(..) )
-import Char		( isAlpha )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Import and export declaration lists}
-%*									*
-%************************************************************************
-
-One per \tr{import} declaration in a module.
-\begin{code}
-type LImportDecl name = Located (ImportDecl name)
-
-data ImportDecl name
-  = ImportDecl	  (Located Module)		-- module name
-		  Bool				-- True <=> {-# SOURCE #-} import
-		  Bool				-- True => qualified
-		  (Maybe Module)		-- as Module
-		  (Maybe (Bool, [LIE name]))	-- (True => hiding, names)
-\end{code}
-
-\begin{code}
-instance (Outputable name) => Outputable (ImportDecl name) where
-    ppr (ImportDecl mod from qual as spec)
-      = hang (hsep [ptext SLIT("import"), ppr_imp from, 
-                    pp_qual qual, ppr mod, pp_as as])
-	     4 (pp_spec spec)
-      where
-	pp_qual False   = empty
-	pp_qual True	= ptext SLIT("qualified")
-
-	pp_as Nothing   = empty
-	pp_as (Just a)  = ptext SLIT("as ") <+> ppr a
-
-	ppr_imp True  = ptext SLIT("{-# SOURCE #-}")
-	ppr_imp False = empty
-
-	pp_spec Nothing = empty
-	pp_spec (Just (False, spec))
-			= parens (interpp'SP spec)
-	pp_spec (Just (True, spec))
-			= ptext SLIT("hiding") <+> parens (interpp'SP spec)
-
-ideclName (ImportDecl mod_nm _ _ _ _) = mod_nm
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Imported and exported entities}
-%*									*
-%************************************************************************
-
-\begin{code}
-type LIE name = Located (IE name)
-
-data IE name
-  = IEVar		name
-  | IEThingAbs          name		-- Class/Type (can't tell)
-  | IEThingAll          name		-- Class/Type plus all methods/constructors
-  | IEThingWith		name [name]	-- Class/Type plus some methods/constructors
-  | IEModuleContents    Module		-- (Export Only)
-\end{code}
-
-\begin{code}
-ieName :: IE name -> name
-ieName (IEVar n) 	 = n
-ieName (IEThingAbs  n)   = n
-ieName (IEThingWith n _) = n
-ieName (IEThingAll  n)   = n
-
-ieNames :: IE a -> [a]
-ieNames (IEVar            n   ) = [n]
-ieNames (IEThingAbs       n   ) = [n]
-ieNames (IEThingAll       n   ) = [n]
-ieNames (IEThingWith      n ns) = n:ns
-ieNames (IEModuleContents _   ) = []
-\end{code}
-
-\begin{code}
-instance (Outputable name) => Outputable (IE name) where
-    ppr (IEVar	        var)	= pprHsVar var
-    ppr (IEThingAbs	thing)	= ppr thing
-    ppr (IEThingAll	thing)	= hcat [ppr thing, text "(..)"]
-    ppr (IEThingWith thing withs)
-	= ppr thing <> parens (fsep (punctuate comma (map pprHsVar withs)))
-    ppr (IEModuleContents mod)
-	= ptext SLIT("module") <+> ppr mod
-\end{code}
-
-\begin{code}
-pprHsVar :: Outputable name => name -> SDoc
-pprHsVar v | isOperator ppr_v = parens ppr_v
-	   | otherwise	      = ppr_v
-	   where
-	     ppr_v = ppr v
-
-isOperator :: SDoc -> Bool
-isOperator ppr_v 
-  = case showSDocUnqual ppr_v of
-	('(':s)   -> False		-- (), (,) etc
-	('[':s)   -> False		-- []
-	('$':c:s) -> not (isAlpha c)	-- Don't treat $d as an operator
-	(':':c:s) -> not (isAlpha c)	-- Don't treat :T as an operator
-	('_':s)   -> False		-- Not an operator
-	(c:s)     -> not (isAlpha c)	-- Starts with non-alpha
-	other     -> False
-    -- We use (showSDoc (ppr v)), rather than isSymOcc (getOccName v) simply so
-    -- that we don't need NamedThing in the context of all these functions.
-    -- Gruesome, but simple.
-\end{code}
-
diff --git a/ghc/compiler/hsSyn/HsLit.lhs b/ghc/compiler/hsSyn/HsLit.lhs
deleted file mode 100644
index c6d7e5dbea..0000000000
--- a/ghc/compiler/hsSyn/HsLit.lhs
+++ /dev/null
@@ -1,96 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[HsLit]{Abstract syntax: source-language literals}
-
-\begin{code}
-module HsLit where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} HsExpr( SyntaxExpr )
-import Type	( Type )
-import Outputable
-import FastString
-import Ratio	( Rational )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[HsLit]{Literals}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-data HsLit
-  = HsChar	    Char		-- Character
-  | HsCharPrim	    Char		-- Unboxed character
-  | HsString	    FastString		-- String
-  | HsStringPrim    FastString		-- Packed string
-  | HsInt	    Integer		-- Genuinely an Int; arises from TcGenDeriv, 
-					--	and from TRANSLATION
-  | HsIntPrim	    Integer		-- Unboxed Int
-  | HsInteger	    Integer  Type	-- Genuinely an integer; arises only from TRANSLATION
-					-- 	(overloaded literals are done with HsOverLit)
-  | HsRat	    Rational Type	-- Genuinely a rational; arises only from TRANSLATION
-					-- 	(overloaded literals are done with HsOverLit)
-  | HsFloatPrim	    Rational		-- Unboxed Float
-  | HsDoublePrim    Rational		-- Unboxed Double
-
-instance Eq HsLit where
-  (HsChar x1)	    == (HsChar x2)	 = x1==x2
-  (HsCharPrim x1)   == (HsCharPrim x2)	 = x1==x2
-  (HsString x1)     == (HsString x2)	 = x1==x2
-  (HsStringPrim x1) == (HsStringPrim x2) = x1==x2
-  (HsInt x1)	    == (HsInt x2)	 = x1==x2
-  (HsIntPrim x1)    == (HsIntPrim x2)    = x1==x2
-  (HsInteger x1 _)  == (HsInteger x2 _)  = x1==x2
-  (HsRat x1 _)	    == (HsRat x2 _)      = x1==x2
-  (HsFloatPrim x1)  == (HsFloatPrim x2)  = x1==x2
-  (HsDoublePrim x1) == (HsDoublePrim x2) = x1==x2
-  lit1		    == lit2		 = False
-
-data HsOverLit id 	-- An overloaded literal
-  = HsIntegral	 Integer  (SyntaxExpr id)	-- Integer-looking literals;
-  | HsFractional Rational (SyntaxExpr id)	-- Frac-looking literals
-  -- Before type checking, the SyntaxExpr is 'fromInteger' or 'fromRational'
-  -- After type checking, it is (fromInteger 3) or lit_78; that is,
-  -- the expression that should replace the literal.
-  -- This is unusual, because we're replacing 'fromInteger' with a call 
-  -- to fromInteger.  Reason: it allows commoning up of the fromInteger
-  -- calls, which wouldn't be possible if the desguarar made the application
-
--- Comparison operations are needed when grouping literals
--- for compiling pattern-matching (module MatchLit)
-instance Eq (HsOverLit id) where
-  (HsIntegral i1 _)   == (HsIntegral i2 _)   = i1 == i2
-  (HsFractional f1 _) == (HsFractional f2 _) = f1 == f2
-  l1		      == l2		     = False
-
-instance Ord (HsOverLit id) where
-  compare (HsIntegral i1 _)   (HsIntegral i2 _)   = i1 `compare` i2
-  compare (HsIntegral _ _)    (HsFractional _ _)  = LT
-  compare (HsFractional f1 _) (HsFractional f2 _) = f1 `compare` f2
-  compare (HsFractional f1 _) (HsIntegral _ _)    = GT
-\end{code}
-
-\begin{code}
-instance Outputable HsLit where
-	-- Use "show" because it puts in appropriate escapes
-    ppr (HsChar c)	 = pprHsChar c
-    ppr (HsCharPrim c)	 = pprHsChar c <> char '#'
-    ppr (HsString s)	 = pprHsString s
-    ppr (HsStringPrim s) = pprHsString s <> char '#'
-    ppr (HsInt i)	 = integer i
-    ppr (HsInteger i _)	 = integer i
-    ppr (HsRat f _)	 = rational f
-    ppr (HsFloatPrim f)	 = rational f <> char '#'
-    ppr (HsDoublePrim d) = rational d <> text "##"
-    ppr (HsIntPrim i)	 = integer i  <> char '#'
-
-instance Outputable (HsOverLit id) where
-  ppr (HsIntegral i _)   = integer i
-  ppr (HsFractional f _) = rational f
-\end{code}
diff --git a/ghc/compiler/hsSyn/HsPat.hi-boot-5 b/ghc/compiler/hsSyn/HsPat.hi-boot-5
deleted file mode 100644
index 1f02ce3d47..0000000000
--- a/ghc/compiler/hsSyn/HsPat.hi-boot-5
+++ /dev/null
@@ -1,6 +0,0 @@
-__interface HsPat 1 0 where
-__export Pat LPat ;
-
-1 data Pat i ;
-1 type LPat i = SrcLoc.Located (Pat i) ;
-
diff --git a/ghc/compiler/hsSyn/HsPat.hi-boot-6 b/ghc/compiler/hsSyn/HsPat.hi-boot-6
deleted file mode 100644
index 593caf2d17..0000000000
--- a/ghc/compiler/hsSyn/HsPat.hi-boot-6
+++ /dev/null
@@ -1,4 +0,0 @@
-module HsPat where
-
-data Pat i
-type LPat i = SrcLoc.Located (Pat i)
diff --git a/ghc/compiler/hsSyn/HsPat.lhs b/ghc/compiler/hsSyn/HsPat.lhs
deleted file mode 100644
index 953d228942..0000000000
--- a/ghc/compiler/hsSyn/HsPat.lhs
+++ /dev/null
@@ -1,324 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[PatSyntax]{Abstract Haskell syntax---patterns}
-
-\begin{code}
-module HsPat (
-	Pat(..), InPat, OutPat, LPat,
-	
-	HsConDetails(..), hsConArgs,
-
-	mkPrefixConPat, mkCharLitPat, mkNilPat, 
-
-	isBangHsBind,	
-	patsAreAllCons, isConPat, isSigPat, isWildPat,
-	patsAreAllLits,	isLitPat, isIrrefutableHsPat
-    ) where
-
-#include "HsVersions.h"
-
-
-import {-# SOURCE #-} HsExpr		( SyntaxExpr )
-
--- friends:
-import HsBinds		( DictBinds, HsBind(..), emptyLHsBinds, pprLHsBinds )
-import HsLit		( HsLit(HsCharPrim), HsOverLit )
-import HsTypes		( LHsType, PostTcType )
-import BasicTypes	( Boxity, tupleParens )
--- others:
-import PprCore		( {- instance OutputableBndr TyVar -} )
-import TysWiredIn	( nilDataCon, charDataCon, charTy )
-import Var		( TyVar )
-import DataCon		( DataCon, dataConTyCon )
-import TyCon		( isProductTyCon )
-import Outputable	
-import Type		( Type )
-import SrcLoc		( Located(..), unLoc, noLoc )
-\end{code}
-
-
-\begin{code}
-type InPat id  = LPat id	-- No 'Out' constructors
-type OutPat id = LPat id	-- No 'In' constructors
-
-type LPat id = Located (Pat id)
-
-data Pat id
-  =	------------ Simple patterns ---------------
-    WildPat	PostTcType		-- Wild card
-  | VarPat	id			-- Variable
-  | VarPatOut	id (DictBinds id)	-- Used only for overloaded Ids; the 
-					-- bindings give its overloaded instances
-  | LazyPat	(LPat id)		-- Lazy pattern
-  | AsPat	(Located id) (LPat id)  -- As pattern
-  | ParPat      (LPat id)		-- Parenthesised pattern
-  | BangPat	(LPat id)		-- Bang patterng
-
-	------------ Lists, tuples, arrays ---------------
-  | ListPat	[LPat id]		-- Syntactic list
-		PostTcType		-- The type of the elements
-   	    	    
-  | TuplePat	[LPat id]		-- Tuple
-		Boxity			-- UnitPat is TuplePat []
-		PostTcType
-	-- You might think that the PostTcType was redundant, but it's essential
-	--	data T a where
-	--	  T1 :: Int -> T Int
-	--	f :: (T a, a) -> Int
-	--	f (T1 x, z) = z
-	-- When desugaring, we must generate
-	--	f = /\a. \v::a.  case v of (t::T a, w::a) ->
-	--			 case t of (T1 (x::Int)) -> 
-	-- Note the (w::a), NOT (w::Int), because we have not yet
-	-- refined 'a' to Int.  So we must know that the second component
-	-- of the tuple is of type 'a' not Int.  See selectMatchVar
-
-  | PArrPat	[LPat id]		-- Syntactic parallel array
-		PostTcType		-- The type of the elements
-
-	------------ Constructor patterns ---------------
-  | ConPatIn	(Located id)
-		(HsConDetails id (LPat id))
-
-  | ConPatOut	(Located DataCon)
-		[TyVar]			-- Existentially bound type variables
-		[id]			-- Ditto dictionaries
-		(DictBinds id)		-- Bindings involving those dictionaries
-		(HsConDetails id (LPat id))
-		Type    		-- The type of the pattern
-
-	------------ Literal and n+k patterns ---------------
-  | LitPat	    HsLit		-- Used for *non-overloaded* literal patterns:
-					-- Int#, Char#, Int, Char, String, etc.
-
-  | NPat	    (HsOverLit id)		-- ALWAYS positive
-		    (Maybe (SyntaxExpr id))	-- Just (Name of 'negate') for negative
-						-- patterns, Nothing otherwise
-		    (SyntaxExpr id)		-- Equality checker, of type t->t->Bool
-		    PostTcType			-- Type of the pattern
-
-  | NPlusKPat	    (Located id)	-- n+k pattern
-		    (HsOverLit id)	-- It'll always be an HsIntegral
-		    (SyntaxExpr id)	-- (>=) function, of type t->t->Bool
-		    (SyntaxExpr id)	-- Name of '-' (see RnEnv.lookupSyntaxName)
-
-	------------ Generics ---------------
-  | TypePat	    (LHsType id)	-- Type pattern for generic definitions
-                                        -- e.g  f{| a+b |} = ...
-                                        -- These show up only in class declarations,
-                                        -- and should be a top-level pattern
-
-	------------ Pattern type signatures ---------------
-  | SigPatIn	    (LPat id)		-- Pattern with a type signature
-		    (LHsType id)
-
-  | SigPatOut	    (LPat id)		-- Pattern with a type signature
-		    Type
-
-	------------ Dictionary patterns (translation only) ---------------
-  | DictPat	    -- Used when destructing Dictionaries with an explicit case
-		    [id]			-- superclass dicts
-		    [id]			-- methods
-\end{code}
-
-HsConDetails is use both for patterns and for data type declarations
-
-\begin{code}
-data HsConDetails id arg
-  = PrefixCon [arg]			-- C p1 p2 p3
-  | RecCon    [(Located id, arg)]	-- C { x = p1, y = p2 }
-  | InfixCon  arg arg			-- p1 `C` p2
-
-hsConArgs :: HsConDetails id arg -> [arg]
-hsConArgs (PrefixCon ps)   = ps
-hsConArgs (RecCon fs)      = map snd fs
-hsConArgs (InfixCon p1 p2) = [p1,p2]
-\end{code}
-
-
-%************************************************************************
-%*									*
-%* 		Printing patterns
-%*									*
-%************************************************************************
-
-\begin{code}
-instance (OutputableBndr name) => Outputable (Pat name) where
-    ppr = pprPat
-
-pprPatBndr :: OutputableBndr name => name -> SDoc
-pprPatBndr var		  	-- Print with type info if -dppr-debug is on
-  = getPprStyle $ \ sty ->
-    if debugStyle sty then
-	parens (pprBndr LambdaBind var)		-- Could pass the site to pprPat
-						-- but is it worth it?
-    else
-	ppr var
-
-pprPat :: (OutputableBndr name) => Pat name -> SDoc
-pprPat (VarPat var)  	  = pprPatBndr var
-pprPat (VarPatOut var bs) = parens (pprPatBndr var <+> braces (ppr bs))
-pprPat (WildPat _)	  = char '_'
-pprPat (LazyPat pat)      = char '~' <> ppr pat
-pprPat (BangPat pat)      = char '!' <> ppr pat
-pprPat (AsPat name pat)   = parens (hcat [ppr name, char '@', ppr pat])
-pprPat (ParPat pat)	  = parens (ppr pat)
-pprPat (ListPat pats _)     = brackets (interpp'SP pats)
-pprPat (PArrPat pats _)     = pabrackets (interpp'SP pats)
-pprPat (TuplePat pats bx _) = tupleParens bx (interpp'SP pats)
-
-pprPat (ConPatIn con details) = pprUserCon con details
-pprPat (ConPatOut con tvs dicts binds details _) 
-  = getPprStyle $ \ sty ->	-- Tiresome; in TcBinds.tcRhs we print out a 
-    if debugStyle sty then 	-- typechecked Pat in an error message, 
-				-- and we want to make sure it prints nicely
-	ppr con <+> sep [ hsep (map pprPatBndr tvs) <+> hsep (map pprPatBndr dicts),
-		   	  pprLHsBinds binds, pprConArgs details]
-    else pprUserCon con details
-
-pprPat (LitPat s)	      = ppr s
-pprPat (NPat l Nothing  _ _)  = ppr l
-pprPat (NPat l (Just _) _ _)  = char '-' <> ppr l
-pprPat (NPlusKPat n k _ _)    = hcat [ppr n, char '+', ppr k]
-pprPat (TypePat ty)	      = ptext SLIT("{|") <> ppr ty <> ptext SLIT("|}")
-pprPat (SigPatIn pat ty)      = ppr pat <+> dcolon <+> ppr ty
-pprPat (SigPatOut pat ty)     = ppr pat <+> dcolon <+> ppr ty
-pprPat (DictPat ds ms)	      = parens (sep [ptext SLIT("{-dict-}"),
-					     brackets (interpp'SP ds),
-					     brackets (interpp'SP ms)])
-
-pprUserCon c (InfixCon p1 p2) = ppr p1 <+> ppr c <+> ppr p2
-pprUserCon c details          = ppr c <+> pprConArgs details
-
-pprConArgs (PrefixCon pats) = interppSP pats
-pprConArgs (InfixCon p1 p2) = interppSP [p1,p2]
-pprConArgs (RecCon rpats)   = braces (hsep (punctuate comma (map (pp_rpat) rpats)))
-			    where
-			      pp_rpat (v, p) = hsep [ppr v, char '=', ppr p]
-
-
--- add parallel array brackets around a document
---
-pabrackets   :: SDoc -> SDoc
-pabrackets p  = ptext SLIT("[:") <> p <> ptext SLIT(":]")
-\end{code}
-
-
-%************************************************************************
-%*									*
-%* 		Building patterns
-%*									*
-%************************************************************************
-
-\begin{code}
-mkPrefixConPat :: DataCon -> [OutPat id] -> Type -> OutPat id
--- Make a vanilla Prefix constructor pattern
-mkPrefixConPat dc pats ty = noLoc $ ConPatOut (noLoc dc) [] [] emptyLHsBinds (PrefixCon pats) ty
-
-mkNilPat :: Type -> OutPat id
-mkNilPat ty = mkPrefixConPat nilDataCon [] ty
-
-mkCharLitPat :: Char -> OutPat id
-mkCharLitPat c = mkPrefixConPat charDataCon [noLoc $ LitPat (HsCharPrim c)] charTy
-\end{code}
-
-
-%************************************************************************
-%*									*
-%* Predicates for checking things about pattern-lists in EquationInfo	*
-%*									*
-%************************************************************************
-
-\subsection[Pat-list-predicates]{Look for interesting things in patterns}
-
-Unlike in the Wadler chapter, where patterns are either ``variables''
-or ``constructors,'' here we distinguish between:
-\begin{description}
-\item[unfailable:]
-Patterns that cannot fail to match: variables, wildcards, and lazy
-patterns.
-
-These are the irrefutable patterns; the two other categories
-are refutable patterns.
-
-\item[constructor:]
-A non-literal constructor pattern (see next category).
-
-\item[literal patterns:]
-At least the numeric ones may be overloaded.
-\end{description}
-
-A pattern is in {\em exactly one} of the above three categories; `as'
-patterns are treated specially, of course.
-
-The 1.3 report defines what ``irrefutable'' and ``failure-free'' patterns are.
-\begin{code}
-isWildPat (WildPat _) = True
-isWildPat other	      = False
-
-patsAreAllCons :: [Pat id] -> Bool
-patsAreAllCons pat_list = all isConPat pat_list
-
-isConPat (AsPat _ pat)		 = isConPat (unLoc pat)
-isConPat (ConPatIn _ _)		 = True
-isConPat (ConPatOut _ _ _ _ _ _) = True
-isConPat (ListPat _ _)		 = True
-isConPat (PArrPat _ _)		 = True
-isConPat (TuplePat _ _ _)	 = True
-isConPat (DictPat ds ms)	 = (length ds + length ms) > 1
-isConPat other			 = False
-
-isSigPat (SigPatIn _ _)  = True
-isSigPat (SigPatOut _ _) = True
-isSigPat other		 = False
-
-patsAreAllLits :: [Pat id] -> Bool
-patsAreAllLits pat_list = all isLitPat pat_list
-
-isLitPat (AsPat _ pat)	        = isLitPat (unLoc pat)
-isLitPat (LitPat _)	        = True
-isLitPat (NPat _ _ _ _)	        = True
-isLitPat (NPlusKPat _ _ _ _)    = True
-isLitPat other		        = False
-
-isBangHsBind :: HsBind id -> Bool
--- In this module because HsPat is above HsBinds in the import graph
-isBangHsBind (PatBind { pat_lhs = L _ (BangPat p) }) = True
-isBangHsBind bind				     = False
-
-isIrrefutableHsPat :: LPat id -> Bool
--- This function returns False if it's in doubt; specifically
--- on a ConPatIn it doesn't know the size of the constructor family
--- But if it returns True, the pattern is definitely irrefutable
-isIrrefutableHsPat pat
-  = go pat
-  where
-    go (L _ pat)	 = go1 pat
-
-    go1 (WildPat _)         = True
-    go1 (VarPat _)          = True
-    go1 (VarPatOut _ _)     = True
-    go1 (LazyPat pat)       = True
-    go1 (BangPat pat)       = go pat
-    go1 (ParPat pat)        = go pat
-    go1 (AsPat _ pat)       = go pat
-    go1 (SigPatIn pat _)    = go pat
-    go1 (SigPatOut pat _)   = go pat
-    go1 (TuplePat pats _ _) = all go pats
-    go1 (ListPat pats _)    = False
-    go1 (PArrPat pats _)    = False	-- ?
-
-    go1 (ConPatIn _ _) = False	-- Conservative
-    go1 (ConPatOut (L _ con) _ _ _ details _) 
-	=  isProductTyCon (dataConTyCon con)
-	&& all go (hsConArgs details)
-
-    go1 (LitPat _) 	   = False
-    go1 (NPat _ _ _ _)	   = False
-    go1 (NPlusKPat _ _ _ _) = False
-
-    go1 (TypePat _)   = panic "isIrrefutableHsPat: type pattern"
-    go1 (DictPat _ _) = panic "isIrrefutableHsPat: type pattern"
-\end{code}
-
diff --git a/ghc/compiler/hsSyn/HsPat.lhs-boot b/ghc/compiler/hsSyn/HsPat.lhs-boot
deleted file mode 100644
index d5b685c1f1..0000000000
--- a/ghc/compiler/hsSyn/HsPat.lhs-boot
+++ /dev/null
@@ -1,7 +0,0 @@
-\begin{code}
-module HsPat where
-import SrcLoc( Located )
-
-data Pat i
-type LPat i = Located (Pat i)
-\end{code}
diff --git a/ghc/compiler/hsSyn/HsSyn.lhs b/ghc/compiler/hsSyn/HsSyn.lhs
deleted file mode 100644
index a9982a630a..0000000000
--- a/ghc/compiler/hsSyn/HsSyn.lhs
+++ /dev/null
@@ -1,98 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section{Haskell abstract syntax definition}
-
-This module glues together the pieces of the Haskell abstract syntax,
-which is declared in the various \tr{Hs*} modules.  This module,
-therefore, is almost nothing but re-exporting.
-
-\begin{code}
-module HsSyn (
-	module HsBinds,
-	module HsDecls,
-	module HsExpr,
-	module HsImpExp,
-	module HsLit,
-	module HsPat,
-	module HsTypes,
- 	module HsUtils,
-	Fixity,
-
-	HsModule(..), HsExtCore(..)
-     ) where
-
-#include "HsVersions.h"
-
--- friends:
-import HsDecls		
-import HsBinds
-import HsExpr
-import HsImpExp
-import HsLit
-import HsPat
-import HsTypes
-import HscTypes		( DeprecTxt )
-import BasicTypes	( Fixity )
-import HsUtils
-
--- others:
-import IfaceSyn		( IfaceBinding )
-import Outputable
-import SrcLoc		( Located(..) )
-import Module		( Module )
-\end{code}
-
-All we actually declare here is the top-level structure for a module.
-\begin{code}
-data HsModule name
-  = HsModule
-	(Maybe (Located Module))-- Nothing => "module X where" is omitted
-				--	(in which case the next field is Nothing too)
-	(Maybe [LIE name])	-- Export list; Nothing => export list omitted, so export everything
-				-- Just [] => export *nothing*
-				-- Just [...] => as you would expect...
-	[LImportDecl name]	-- We snaffle interesting stuff out of the
-				-- imported interfaces early on, adding that
-				-- info to TyDecls/etc; so this list is
-				-- often empty, downstream.
-	[LHsDecl name]		-- Type, class, value, and interface signature decls
-	(Maybe DeprecTxt)	-- reason/explanation for deprecation of this module
-
-data HsExtCore name	-- Read from Foo.hcr
-  = HsExtCore
-	Module
-	[TyClDecl name]	-- Type declarations only; just as in Haskell source,
-			-- so that we can infer kinds etc
-	[IfaceBinding]	-- And the bindings
-\end{code}
-
-\begin{code}
-instance (OutputableBndr name)
-	=> Outputable (HsModule name) where
-
-    ppr (HsModule Nothing _ imports decls _)
-      = pp_nonnull imports $$ pp_nonnull decls
-
-    ppr (HsModule (Just name) exports imports decls deprec)
-      = vcat [
-	    case exports of
-	      Nothing -> pp_header (ptext SLIT("where"))
-	      Just es -> vcat [
-			   pp_header lparen,
-			   nest 8 (fsep (punctuate comma (map ppr es))),
-			   nest 4 (ptext SLIT(") where"))
-			  ],
-	    pp_nonnull imports,
-	    pp_nonnull decls
-	]
-      where
-	pp_header rest = case deprec of
-           Nothing -> pp_modname <+> rest
-           Just d -> vcat [ pp_modname, ppr d, rest ]
-
-	pp_modname = ptext SLIT("module") <+> ppr name
-
-pp_nonnull [] = empty
-pp_nonnull xs = vcat (map ppr xs)
-\end{code}
diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
deleted file mode 100644
index f1343a39ef..0000000000
--- a/ghc/compiler/hsSyn/HsTypes.lhs
+++ /dev/null
@@ -1,370 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[HsTypes]{Abstract syntax: user-defined types}
-
-\begin{code}
-module HsTypes (
-	HsType(..), LHsType, 
-	HsTyVarBndr(..), LHsTyVarBndr,
-	HsExplicitForAll(..),
-	HsContext, LHsContext,
-	HsPred(..), LHsPred,
-
-	LBangType, BangType, HsBang(..), 
-        getBangType, getBangStrictness, 
-	
-	mkExplicitHsForAllTy, mkImplicitHsForAllTy, 
-	hsTyVarName, hsTyVarNames, replaceTyVarName,
-	hsLTyVarName, hsLTyVarNames, hsLTyVarLocName, hsLTyVarLocNames,
-	splitHsInstDeclTy, splitHsFunType,
-	
-	-- Type place holder
-	PostTcType, placeHolderType,
-
-	-- Printing
-	pprParendHsType, pprHsForAll, pprHsContext, ppr_hs_context, pprHsTyVarBndr
-    ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )
-
-import Type		( Type )
-import Kind		( {- instance Outputable Kind -}, Kind,
-			  pprParendKind, pprKind, isLiftedTypeKind )
-import BasicTypes	( IPName, Boxity, tupleParens )
-import SrcLoc		( Located(..), unLoc, noSrcSpan )
-import StaticFlags	( opt_PprStyle_Debug )
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Annotating the syntax}
-%*									*
-%************************************************************************
-
-\begin{code}
-type PostTcType = Type		-- Used for slots in the abstract syntax
-				-- where we want to keep slot for a type
-				-- to be added by the type checker...but
-				-- before typechecking it's just bogus
-
-placeHolderType :: PostTcType	-- Used before typechecking
-placeHolderType  = panic "Evaluated the place holder for a PostTcType"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Bang annotations}
-%*									*
-%************************************************************************
-
-\begin{code}
-type LBangType name = Located (BangType name)
-type BangType name  = HsType name	-- Bangs are in the HsType data type
-
-data HsBang = HsNoBang	-- Only used as a return value for getBangStrictness,
-			-- never appears on a HsBangTy
-	    | HsStrict	-- ! 
-	    | HsUnbox	-- {-# UNPACK #-} ! (GHC extension, meaning "unbox")
-
-instance Outputable HsBang where
-    ppr (HsNoBang) = empty
-    ppr (HsStrict) = char '!'
-    ppr (HsUnbox)  = ptext SLIT("!!")
-
-getBangType :: LHsType a -> LHsType a
-getBangType (L _ (HsBangTy _ ty)) = ty
-getBangType ty                    = ty
-
-getBangStrictness :: LHsType a -> HsBang
-getBangStrictness (L _ (HsBangTy s _)) = s
-getBangStrictness _                    = HsNoBang
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Data types}
-%*									*
-%************************************************************************
-
-This is the syntax for types as seen in type signatures.
-
-\begin{code}
-type LHsContext name = Located (HsContext name)
-
-type HsContext name = [LHsPred name]
-
-type LHsPred name = Located (HsPred name)
-
-data HsPred name = HsClassP name [LHsType name]
-		 | HsIParam (IPName name) (LHsType name)
-
-type LHsType name = Located (HsType name)
-
-data HsType name
-  = HsForAllTy	HsExplicitForAll	-- Renamer leaves this flag unchanged, to record the way
-					-- the user wrote it originally, so that the printer can
-					-- print it as the user wrote it
-		[LHsTyVarBndr name]	-- With ImplicitForAll, this is the empty list
-					-- until the renamer fills in the variables
-		(LHsContext name)
-		(LHsType name)
-
-  | HsTyVar		name		-- Type variable or type constructor
-
-  | HsBangTy	HsBang (LHsType name)	-- Bang-style type annotations 
-
-  | HsAppTy		(LHsType name)
-			(LHsType name)
-
-  | HsFunTy		(LHsType name)   -- function type
-			(LHsType name)
-
-  | HsListTy		(LHsType name)	-- Element type
-
-  | HsPArrTy		(LHsType name)	-- Elem. type of parallel array: [:t:]
-
-  | HsTupleTy		Boxity
-			[LHsType name]	-- Element types (length gives arity)
-
-  | HsOpTy		(LHsType name) (Located name) (LHsType name)
-
-  | HsParTy		(LHsType name)   
-	-- Parenthesis preserved for the precedence re-arrangement in RnTypes
-	-- It's important that a * (b + c) doesn't get rearranged to (a*b) + c!
-	-- 
-	-- However, NB that toHsType doesn't add HsParTys (in an effort to keep
-	-- interface files smaller), so when printing a HsType we may need to
-	-- add parens.  
-
-  | HsNumTy             Integer		-- Generics only
-
-  | HsPredTy		(HsPred name)	-- Only used in the type of an instance
-					-- declaration, eg.  Eq [a] -> Eq a
-					--			       ^^^^
-					--                            HsPredTy
-					-- Note no need for location info on the
-					-- enclosed HsPred; the one on the type will do
-
-  | HsKindSig		(LHsType name)	-- (ty :: kind)
-			Kind		-- A type with a kind signature
-
-  | HsSpliceTy		(HsSplice name)
-
-data HsExplicitForAll = Explicit | Implicit
-
------------------------
--- Combine adjacent for-alls. 
--- The following awkward situation can happen otherwise:
---	f :: forall a. ((Num a) => Int)
--- might generate HsForAll (Just [a]) [] (HsForAll Nothing [Num a] t)
--- Then a isn't discovered as ambiguous, and we abstract the AbsBinds wrt []
--- but the export list abstracts f wrt [a].  Disaster.
---
--- A valid type must have one for-all at the top of the type, or of the fn arg types
-
-mkImplicitHsForAllTy     ctxt ty = mkHsForAllTy Implicit [] ctxt ty
-mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
-
-mkHsForAllTy :: HsExplicitForAll -> [LHsTyVarBndr name] -> LHsContext name -> LHsType name -> HsType name
--- Smart constructor for HsForAllTy
-mkHsForAllTy exp tvs (L _ []) ty = mk_forall_ty exp tvs ty
-mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
-
--- mk_forall_ty makes a pure for-all type (no context)
-mk_forall_ty exp  tvs  (L _ (HsParTy ty))		    = mk_forall_ty exp tvs ty
-mk_forall_ty exp1 tvs1 (L _ (HsForAllTy exp2 tvs2 ctxt ty)) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
-mk_forall_ty exp  tvs  ty			            = HsForAllTy exp tvs (L noSrcSpan []) ty
-	-- Even if tvs is empty, we still make a HsForAll!
-	-- In the Implicit case, this signals the place to do implicit quantification
-	-- In the Explicit case, it prevents implicit quantification	
-	--	(see the sigtype production in Parser.y.pp)
-	-- 	so that (forall. ty) isn't implicitly quantified
-
-Implicit `plus` Implicit = Implicit
-exp1     `plus` exp2     = Explicit
-
-type LHsTyVarBndr name = Located (HsTyVarBndr name)
-
-data HsTyVarBndr name
-  = UserTyVar name
-  | KindedTyVar name Kind
-	--  *** NOTA BENE *** A "monotype" in a pragma can have
-	-- for-alls in it, (mostly to do with dictionaries).  These
-	-- must be explicitly Kinded.
-
-hsTyVarName :: HsTyVarBndr name -> name
-hsTyVarName (UserTyVar n)     = n
-hsTyVarName (KindedTyVar n _) = n
-
-hsLTyVarName :: LHsTyVarBndr name -> name
-hsLTyVarName = hsTyVarName . unLoc
-
-hsTyVarNames :: [HsTyVarBndr name] -> [name]
-hsTyVarNames tvs = map hsTyVarName tvs
-
-hsLTyVarNames :: [LHsTyVarBndr name] -> [name]
-hsLTyVarNames = map hsLTyVarName
-
-hsLTyVarLocName :: LHsTyVarBndr name -> Located name
-hsLTyVarLocName = fmap hsTyVarName
-
-hsLTyVarLocNames :: [LHsTyVarBndr name] -> [Located name]
-hsLTyVarLocNames = map hsLTyVarLocName
-
-replaceTyVarName :: HsTyVarBndr name1 -> name2 -> HsTyVarBndr name2
-replaceTyVarName (UserTyVar n)     n' = UserTyVar n'
-replaceTyVarName (KindedTyVar n k) n' = KindedTyVar n' k
-\end{code}
-
-
-\begin{code}
-splitHsInstDeclTy 
-    :: OutputableBndr name
-    => HsType name 
-    -> ([LHsTyVarBndr name], HsContext name, name, [LHsType name])
-	-- Split up an instance decl type, returning the pieces
-
-splitHsInstDeclTy inst_ty
-  = case inst_ty of
-	HsParTy (L _ ty)	      -> splitHsInstDeclTy ty
-	HsForAllTy _ tvs cxt (L _ ty) -> split_tau tvs (unLoc cxt) ty
-	other 			      -> split_tau []  []          other
-    -- The type vars should have been computed by now, even if they were implicit
-  where
-    split_tau tvs cxt (HsPredTy (HsClassP cls tys)) = (tvs, cxt, cls, tys)
-    split_tau tvs cxt (HsParTy (L _ ty))	    = split_tau tvs cxt ty
-
--- Splits HsType into the (init, last) parts
--- Breaks up any parens in the result type: 
---	splitHsFunType (a -> (b -> c)) = ([a,b], c)
-splitHsFunType :: LHsType name -> ([LHsType name], LHsType name)
-splitHsFunType (L l (HsFunTy x y)) = (x:args, res)
-  where
-  (args, res) = splitHsFunType y
-splitHsFunType (L _ (HsParTy ty))  = splitHsFunType ty
-splitHsFunType other 	   	   = ([], other)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Pretty printing}
-%*									*
-%************************************************************************
-
-NB: these types get printed into interface files, so 
-    don't change the printing format lightly
-
-\begin{code}
-instance (OutputableBndr name) => Outputable (HsType name) where
-    ppr ty = pprHsType ty
-
-instance (Outputable name) => Outputable (HsTyVarBndr name) where
-    ppr (UserTyVar name)        = ppr name
-    ppr (KindedTyVar name kind) = pprHsTyVarBndr name kind
-
-instance OutputableBndr name => Outputable (HsPred name) where
-    ppr (HsClassP clas tys) = ppr clas <+> hsep (map (pprParendHsType.unLoc) tys)
-    ppr (HsIParam n ty)    = hsep [ppr n, dcolon, ppr ty]
-
-pprHsTyVarBndr :: Outputable name => name -> Kind -> SDoc
-pprHsTyVarBndr name kind | isLiftedTypeKind kind = ppr name
-			 | otherwise 	  	 = hsep [ppr name, dcolon, pprParendKind kind]
-
-pprHsForAll exp tvs cxt 
-  | show_forall = forall_part <+> pprHsContext (unLoc cxt)
-  | otherwise   = pprHsContext (unLoc cxt)
-  where
-    show_forall =  opt_PprStyle_Debug
-		|| (not (null tvs) && is_explicit)
-    is_explicit = case exp of {Explicit -> True; Implicit -> False}
-    forall_part = ptext SLIT("forall") <+> interppSP tvs <> dot
-
-pprHsContext :: (OutputableBndr name) => HsContext name -> SDoc
-pprHsContext []	 = empty
-pprHsContext cxt = ppr_hs_context cxt <+> ptext SLIT("=>")
-
-ppr_hs_context []  = empty
-ppr_hs_context cxt = parens (interpp'SP cxt)
-\end{code}
-
-\begin{code}
-pREC_TOP = (0 :: Int)  -- type   in ParseIface.y
-pREC_FUN = (1 :: Int)  -- btype  in ParseIface.y
-			-- Used for LH arg of (->)
-pREC_OP  = (2 :: Int)	-- Used for arg of any infix operator
-			-- (we don't keep their fixities around)
-pREC_CON = (3 :: Int)	-- Used for arg of type applicn: 
-			-- always parenthesise unless atomic
-
-maybeParen :: Int 	-- Precedence of context
-	   -> Int	-- Precedence of top-level operator
-	   -> SDoc -> SDoc	-- Wrap in parens if (ctxt >= op)
-maybeParen ctxt_prec op_prec p | ctxt_prec >= op_prec = parens p
-			       | otherwise	      = p
-	
--- printing works more-or-less as for Types
-
-pprHsType, pprParendHsType :: (OutputableBndr name) => HsType name -> SDoc
-
-pprHsType ty       = getPprStyle $ \sty -> ppr_mono_ty pREC_TOP (prepare sty ty)
-pprParendHsType ty = ppr_mono_ty pREC_CON ty
-
--- Before printing a type
--- (a) Remove outermost HsParTy parens
--- (b) Drop top-level for-all type variables in user style
---     since they are implicit in Haskell
-prepare sty (HsParTy ty)	  = prepare sty (unLoc ty)
-prepare sty ty			  = ty
-
-ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
-
-ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
-  = maybeParen ctxt_prec pREC_FUN $
-    sep [pprHsForAll exp tvs ctxt, ppr_mono_lty pREC_TOP ty]
-
--- gaw 2004
-ppr_mono_ty ctxt_prec (HsBangTy b ty)     = ppr b <> ppr ty
-ppr_mono_ty ctxt_prec (HsTyVar name)      = ppr name
-ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   = ppr_fun_ty ctxt_prec ty1 ty2
-ppr_mono_ty ctxt_prec (HsTupleTy con tys) = tupleParens con (interpp'SP tys)
-ppr_mono_ty ctxt_prec (HsKindSig ty kind) = parens (ppr_mono_lty pREC_TOP ty <+> dcolon <+> pprKind kind)
-ppr_mono_ty ctxt_prec (HsListTy ty)	  = brackets (ppr_mono_lty pREC_TOP ty)
-ppr_mono_ty ctxt_prec (HsPArrTy ty)	  = pabrackets (ppr_mono_lty pREC_TOP ty)
-ppr_mono_ty ctxt_prec (HsPredTy pred)     = braces (ppr pred)
-ppr_mono_ty ctxt_prec (HsNumTy n)         = integer n  -- generics only
-ppr_mono_ty ctxt_prec (HsSpliceTy s)      = pprSplice s
-
-ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty)
-  = maybeParen ctxt_prec pREC_CON $
-    hsep [ppr_mono_lty pREC_FUN fun_ty, ppr_mono_lty pREC_CON arg_ty]
-
-ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2)  
-  = maybeParen ctxt_prec pREC_OP $
-    ppr_mono_lty pREC_OP ty1 <+> ppr op <+> ppr_mono_lty pREC_OP ty2
-
-ppr_mono_ty ctxt_prec (HsParTy ty)
-  = parens (ppr_mono_lty pREC_TOP ty)
-  -- Put the parens in where the user did
-  -- But we still use the precedence stuff to add parens because
-  --	toHsType doesn't put in any HsParTys, so we may still need them
-
---------------------------
-ppr_fun_ty ctxt_prec ty1 ty2
-  = let p1 = ppr_mono_lty pREC_FUN ty1
-	p2 = ppr_mono_lty pREC_TOP ty2
-    in
-    maybeParen ctxt_prec pREC_FUN $
-    sep [p1, ptext SLIT("->") <+> p2]
-
---------------------------
-pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
-\end{code}
-
-
diff --git a/ghc/compiler/hsSyn/HsUtils.lhs b/ghc/compiler/hsSyn/HsUtils.lhs
deleted file mode 100644
index d9c45e6529..0000000000
--- a/ghc/compiler/hsSyn/HsUtils.lhs
+++ /dev/null
@@ -1,423 +0,0 @@
-%
-% (c) The University of Glasgow, 1992-2003
-%
-
-Here we collect a variety of helper functions that construct or
-analyse HsSyn.  All these functions deal with generic HsSyn; functions
-which deal with the intantiated versions are located elsewhere:
-
-   Parameterised by	Module
-   ----------------     -------------
-   RdrName		parser/RdrHsSyn
-   Name			rename/RnHsSyn
-   Id			typecheck/TcHsSyn	
-
-\begin{code}
-module HsUtils where
-
-#include "HsVersions.h"
-
-import HsBinds
-import HsExpr
-import HsPat
-import HsTypes	
-import HsLit
-
-import RdrName		( RdrName, getRdrName, mkRdrUnqual )
-import Var		( Id )
-import Type		( Type )
-import DataCon		( DataCon, dataConWrapId, dataConSourceArity )
-import OccName		( mkVarOccFS )
-import Name		( Name )
-import BasicTypes	( RecFlag(..) )
-import SrcLoc
-import FastString	( mkFastString )
-import Outputable
-import Util		( nOfThem )
-import Bag
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Some useful helpers for constructing syntax
-%*									*
-%************************************************************************
-
-These functions attempt to construct a not-completely-useless SrcSpan
-from their components, compared with the nl* functions below which
-just attach noSrcSpan to everything.
-
-\begin{code}
-mkHsPar :: LHsExpr id -> LHsExpr id
-mkHsPar e = L (getLoc e) (HsPar e)
-
--- gaw 2004
-mkSimpleMatch :: [LPat id] -> LHsExpr id -> LMatch id
-mkSimpleMatch pats rhs 
-  = L loc $
-    Match pats Nothing (GRHSs (unguardedRHS rhs) emptyLocalBinds)
-  where
-    loc = case pats of
-		[]      -> getLoc rhs
-		(pat:_) -> combineSrcSpans (getLoc pat) (getLoc rhs)
-
-unguardedRHS :: LHsExpr id -> [LGRHS id]
-unguardedRHS rhs@(L loc _) = [L loc (GRHS [] rhs)]
-
-mkHsAppTy :: LHsType name -> LHsType name -> LHsType name
-mkHsAppTy t1 t2 = addCLoc t1 t2 (HsAppTy t1 t2)
-
-mkHsApp :: LHsExpr name -> LHsExpr name -> LHsExpr name
-mkHsApp e1 e2 = addCLoc e1 e2 (HsApp e1 e2)
-
-mkHsTyApp :: LHsExpr name -> [Type] -> LHsExpr name
-mkHsTyApp expr []  = expr
-mkHsTyApp expr tys = L (getLoc expr) (TyApp expr tys)
-
-mkHsDictApp :: LHsExpr name -> [name] -> LHsExpr name
-mkHsDictApp expr []	 = expr
-mkHsDictApp expr dict_vars = L (getLoc expr) (DictApp expr dict_vars)
-
-mkHsCoerce :: ExprCoFn -> HsExpr id -> HsExpr id
-mkHsCoerce co_fn e | isIdCoercion co_fn = e
-		   | otherwise		= HsCoerce co_fn e
-
-mkHsLam :: [LPat id] -> LHsExpr id -> LHsExpr id
-mkHsLam pats body = mkHsPar (L (getLoc body) (HsLam matches))
-	where
-	  matches = mkMatchGroup [mkSimpleMatch pats body]
-
-mkMatchGroup :: [LMatch id] -> MatchGroup id
-mkMatchGroup matches = MatchGroup matches placeHolderType
-
-mkHsTyLam []     expr = expr
-mkHsTyLam tyvars expr = L (getLoc expr) (TyLam tyvars expr)
-
-mkHsDictLam []    expr = expr
-mkHsDictLam dicts expr = L (getLoc expr) (DictLam dicts expr)
-
-mkHsDictLet :: LHsBinds Id -> LHsExpr Id -> LHsExpr Id
--- Used for the dictionary bindings gotten from TcSimplify
--- We make them recursive to be on the safe side
-mkHsDictLet binds expr 
-  | isEmptyLHsBinds binds = expr
-  | otherwise             = L (getLoc expr) (HsLet (HsValBinds val_binds) expr)
-			  where
-			    val_binds = ValBindsOut [(Recursive, binds)] []
-
-mkHsConApp :: DataCon -> [Type] -> [HsExpr Id] -> LHsExpr Id
--- Used for constructing dictinoary terms etc, so no locations 
-mkHsConApp data_con tys args 
-  = foldl mk_app (noLoc (HsVar (dataConWrapId data_con)) `mkHsTyApp` tys) args
-  where
-    mk_app f a = noLoc (HsApp f (noLoc a))
-
-mkSimpleHsAlt :: LPat id -> LHsExpr id -> LMatch id
--- A simple lambda with a single pattern, no binds, no guards; pre-typechecking
-mkSimpleHsAlt pat expr 
-  = mkSimpleMatch [pat] expr
-
--------------------------------
--- These are the bits of syntax that contain rebindable names
--- See RnEnv.lookupSyntaxName
-
-mkHsIntegral   i       = HsIntegral   i  noSyntaxExpr
-mkHsFractional f       = HsFractional f  noSyntaxExpr
-mkHsDo ctxt stmts body = HsDo ctxt stmts body placeHolderType
-
-mkNPat lit neg     = NPat lit neg noSyntaxExpr placeHolderType
-mkNPlusKPat id lit = NPlusKPat id lit noSyntaxExpr noSyntaxExpr
-
-mkExprStmt expr	    = ExprStmt expr noSyntaxExpr placeHolderType
-mkBindStmt pat expr = BindStmt pat expr noSyntaxExpr noSyntaxExpr
-mkRecStmt stmts	    = RecStmt stmts [] [] [] emptyLHsBinds
-
--------------------------------
---- A useful function for building @OpApps@.  The operator is always a
--- variable, and we don't know the fixity yet.
-mkHsOpApp e1 op e2 = OpApp e1 (noLoc (HsVar op)) (error "mkOpApp:fixity") e2
-
-mkHsSplice e = HsSplice unqualSplice e
-
-unqualSplice = mkRdrUnqual (mkVarOccFS FSLIT("splice"))
-		-- A name (uniquified later) to
-		-- identify the splice
-
-mkHsString s = HsString (mkFastString s)
-
--------------
-userHsTyVarBndrs :: [Located name] -> [Located (HsTyVarBndr name)]
-userHsTyVarBndrs bndrs = [ L loc (UserTyVar v) | L loc v <- bndrs ]
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Constructing syntax with no location info
-%*									*
-%************************************************************************
-
-\begin{code}
-nlHsVar :: id -> LHsExpr id
-nlHsVar n = noLoc (HsVar n)
-
-nlHsLit :: HsLit -> LHsExpr id
-nlHsLit n = noLoc (HsLit n)
-
-nlVarPat :: id -> LPat id
-nlVarPat n = noLoc (VarPat n)
-
-nlLitPat :: HsLit -> LPat id
-nlLitPat l = noLoc (LitPat l)
-
-nlHsApp :: LHsExpr id -> LHsExpr id -> LHsExpr id
-nlHsApp f x = noLoc (HsApp f x)
-
-nlHsIntLit n = noLoc (HsLit (HsInt n))
-
-nlHsApps :: id -> [LHsExpr id] -> LHsExpr id
-nlHsApps f xs = foldl nlHsApp (nlHsVar f) xs
-	     
-nlHsVarApps :: id -> [id] -> LHsExpr id
-nlHsVarApps f xs = noLoc (foldl mk (HsVar f) (map HsVar xs))
-		 where
-		   mk f a = HsApp (noLoc f) (noLoc a)
-
-nlConVarPat :: id -> [id] -> LPat id
-nlConVarPat con vars = nlConPat con (map nlVarPat vars)
-
-nlInfixConPat :: id -> LPat id -> LPat id -> LPat id
-nlInfixConPat con l r = noLoc (ConPatIn (noLoc con) (InfixCon l r))
-
-nlConPat :: id -> [LPat id] -> LPat id
-nlConPat con pats = noLoc (ConPatIn (noLoc con) (PrefixCon pats))
-
-nlNullaryConPat :: id -> LPat id
-nlNullaryConPat con = noLoc (ConPatIn (noLoc con) (PrefixCon []))
-
-nlWildConPat :: DataCon -> LPat RdrName
-nlWildConPat con = noLoc (ConPatIn (noLoc (getRdrName con))
-				   (PrefixCon (nOfThem (dataConSourceArity con) nlWildPat)))
-
-nlTuplePat pats box = noLoc (TuplePat pats box placeHolderType)
-nlWildPat  = noLoc (WildPat placeHolderType)	-- Pre-typechecking
-
-nlHsDo :: HsStmtContext Name -> [LStmt id] -> LHsExpr id -> LHsExpr id
-nlHsDo ctxt stmts body = noLoc (mkHsDo ctxt stmts body)
-
-nlHsOpApp e1 op e2 = noLoc (mkHsOpApp e1 op e2)
-
-nlHsLam	match		= noLoc (HsLam (mkMatchGroup [match]))
-nlHsPar e		= noLoc (HsPar e)
-nlHsIf cond true false	= noLoc (HsIf cond true false)
-nlHsCase expr matches	= noLoc (HsCase expr (mkMatchGroup matches))
-nlTuple exprs box	= noLoc (ExplicitTuple exprs box)
-nlList exprs		= noLoc (ExplicitList placeHolderType exprs)
-
-nlHsAppTy f t		= noLoc (HsAppTy f t)
-nlHsTyVar x		= noLoc (HsTyVar x)
-nlHsFunTy a b		= noLoc (HsFunTy a b)
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-		Bindings; with a location at the top
-%*									*
-%************************************************************************
-
-\begin{code}
-mkFunBind :: Located id -> [LMatch id] -> HsBind id
--- Not infix, with place holders for coercion and free vars
-mkFunBind fn ms = FunBind { fun_id = fn, fun_infix = False, fun_matches = mkMatchGroup ms,
-			    fun_co_fn = idCoercion, bind_fvs = placeHolderNames }
-
-
-mkVarBind :: SrcSpan -> RdrName -> LHsExpr RdrName -> LHsBind RdrName
-mkVarBind loc var rhs = mk_easy_FunBind loc var [] rhs
-
-------------
-mk_easy_FunBind :: SrcSpan -> RdrName -> [LPat RdrName]
-		-> LHsExpr RdrName -> LHsBind RdrName
-
-mk_easy_FunBind loc fun pats expr
-  = L loc $ mkFunBind (L loc fun) [mkMatch pats expr emptyLocalBinds]
-
-------------
-mk_FunBind :: SrcSpan -> RdrName
-	   -> [([LPat RdrName], LHsExpr RdrName)]
-	   -> LHsBind RdrName
-
-mk_FunBind loc fun [] = panic "TcGenDeriv:mk_FunBind"
-mk_FunBind loc fun pats_and_exprs
-  = L loc $ mkFunBind (L loc fun) matches
-  where
-    matches = [mkMatch p e emptyLocalBinds | (p,e) <-pats_and_exprs]
-
-------------
-mkMatch :: [LPat id] -> LHsExpr id -> HsLocalBinds id -> LMatch id
-mkMatch pats expr binds
-  = noLoc (Match (map paren pats) Nothing 
-		 (GRHSs (unguardedRHS expr) binds))
-  where
-    paren p = case p of
-		L _ (VarPat _) -> p
-		L l _	       -> L l (ParPat p)
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Collecting binders from HsBindGroups and HsBinds
-%*									*
-%************************************************************************
-
-Get all the binders in some HsBindGroups, IN THE ORDER OF APPEARANCE. eg.
-
-...
-where
-  (x, y) = ...
-  f i j  = ...
-  [a, b] = ...
-
-it should return [x, y, f, a, b] (remember, order important).
-
-\begin{code}
-collectLocalBinders :: HsLocalBinds name -> [Located name]
-collectLocalBinders (HsValBinds val_binds) = collectHsValBinders val_binds
-collectLocalBinders (HsIPBinds _)   = []
-collectLocalBinders EmptyLocalBinds = []
-
-collectHsValBinders :: HsValBinds name -> [Located name]
-collectHsValBinders (ValBindsIn binds sigs)  = collectHsBindLocatedBinders binds
-collectHsValBinders (ValBindsOut binds sigs) = foldr collect_one [] binds
-  where
-   collect_one (_,binds) acc = foldrBag (collectAcc . unLoc) acc binds
-
-collectAcc :: HsBind name -> [Located name] -> [Located name]
-collectAcc (PatBind { pat_lhs = p }) acc = collectLocatedPatBinders p ++ acc
-collectAcc (FunBind { fun_id = f })  acc    = f : acc
-collectAcc (VarBind { var_id = f })  acc    = noLoc f : acc
-collectAcc (AbsBinds { abs_exports = dbinds, abs_binds = binds }) acc
-  = [noLoc dp | (_,dp,_,_) <- dbinds] ++ acc
-	-- ++ foldr collectAcc acc binds
-	-- I don't think we want the binders from the nested binds
-	-- The only time we collect binders from a typechecked 
-	-- binding (hence see AbsBinds) is in zonking in TcHsSyn
-
-collectHsBindBinders :: LHsBinds name -> [name]
-collectHsBindBinders binds = map unLoc (collectHsBindLocatedBinders binds)
-
-collectHsBindLocatedBinders :: LHsBinds name -> [Located name]
-collectHsBindLocatedBinders binds = foldrBag (collectAcc . unLoc) [] binds
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Getting binders from statements
-%*									*
-%************************************************************************
-
-\begin{code}
-collectLStmtsBinders :: [LStmt id] -> [Located id]
-collectLStmtsBinders = concatMap collectLStmtBinders
-
-collectStmtsBinders :: [Stmt id] -> [Located id]
-collectStmtsBinders = concatMap collectStmtBinders
-
-collectLStmtBinders :: LStmt id -> [Located id]
-collectLStmtBinders = collectStmtBinders . unLoc
-
-collectStmtBinders :: Stmt id -> [Located id]
-  -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
-collectStmtBinders (BindStmt pat _ _ _) = collectLocatedPatBinders pat
-collectStmtBinders (LetStmt binds)      = collectLocalBinders binds
-collectStmtBinders (ExprStmt _ _ _)   	= []
-collectStmtBinders (RecStmt ss _ _ _ _)	= collectLStmtsBinders ss
-collectStmtBinders other              	= panic "collectStmtBinders"
-\end{code}
-
-
-%************************************************************************
-%*									*
-%* 	Gathering stuff out of patterns
-%*									*
-%************************************************************************
-
-This function @collectPatBinders@ works with the ``collectBinders''
-functions for @HsBinds@, etc.  The order in which the binders are
-collected is important; see @HsBinds.lhs@.
-
-It collects the bounds *value* variables in renamed patterns; type variables
-are *not* collected.
-
-\begin{code}
-collectPatBinders :: LPat a -> [a]
-collectPatBinders pat = map unLoc (collectLocatedPatBinders pat)
-
-collectLocatedPatBinders :: LPat a -> [Located a]
-collectLocatedPatBinders pat = collectl pat []
-
-collectPatsBinders :: [LPat a] -> [a]
-collectPatsBinders pats = map unLoc (collectLocatedPatsBinders pats)
-
-collectLocatedPatsBinders :: [LPat a] -> [Located a]
-collectLocatedPatsBinders pats = foldr collectl [] pats
-
----------------------
-collectl (L l pat) bndrs
-  = go pat
-  where
-    go (VarPat var) 	   	  = L l var : bndrs
-    go (VarPatOut var bs) 	  = L l var : collectHsBindLocatedBinders bs 
-				    ++ bndrs
-    go (WildPat _)	      	  = bndrs
-    go (LazyPat pat)     	  = collectl pat bndrs
-    go (BangPat pat)     	  = collectl pat bndrs
-    go (AsPat a pat)     	  = a : collectl pat bndrs
-    go (ParPat  pat)     	  = collectl pat bndrs
-				  
-    go (ListPat pats _)    	  = foldr collectl bndrs pats
-    go (PArrPat pats _)    	  = foldr collectl bndrs pats
-    go (TuplePat pats _ _)  	  = foldr collectl bndrs pats
-				  
-    go (ConPatIn c ps)   	  = foldr collectl bndrs (hsConArgs ps)
-    go (ConPatOut c _ ds bs ps _) = map noLoc ds
-				    ++ collectHsBindLocatedBinders bs
-				    ++ foldr collectl bndrs (hsConArgs ps)
-    go (LitPat _)	      	  = bndrs
-    go (NPat _ _ _ _)		  = bndrs
-    go (NPlusKPat n _ _ _)        = n : bndrs
-
-    go (SigPatIn pat _)	 	  = collectl pat bndrs
-    go (SigPatOut pat _)	  = collectl pat bndrs
-    go (TypePat ty)               = bndrs
-    go (DictPat ids1 ids2)        = map noLoc ids1 ++ map noLoc ids2
-				    ++ bndrs
-\end{code}
-
-\begin{code}
-collectSigTysFromPats :: [InPat name] -> [LHsType name]
-collectSigTysFromPats pats = foldr collect_lpat [] pats
-
-collectSigTysFromPat :: InPat name -> [LHsType name]
-collectSigTysFromPat pat = collect_lpat pat []
-
-collect_lpat pat acc = collect_pat (unLoc pat) acc
-
-collect_pat (SigPatIn pat ty)  	acc = collect_lpat pat (ty:acc)
-collect_pat (TypePat ty)       	acc = ty:acc
-
-collect_pat (LazyPat pat)      	acc = collect_lpat pat acc
-collect_pat (BangPat pat)      	acc = collect_lpat pat acc
-collect_pat (AsPat a pat)      	acc = collect_lpat pat acc
-collect_pat (ParPat  pat)      	acc = collect_lpat pat acc
-collect_pat (ListPat pats _)   	acc = foldr collect_lpat acc pats
-collect_pat (PArrPat pats _)   	acc = foldr collect_lpat acc pats
-collect_pat (TuplePat pats _ _) acc = foldr collect_lpat acc pats
-collect_pat (ConPatIn c ps)     acc = foldr collect_lpat acc (hsConArgs ps)
-collect_pat other	        acc = acc 	-- Literals, vars, wildcard
-\end{code}
diff --git a/ghc/compiler/iface/BinIface.hs b/ghc/compiler/iface/BinIface.hs
deleted file mode 100644
index 6d02fe00c7..0000000000
--- a/ghc/compiler/iface/BinIface.hs
+++ /dev/null
@@ -1,1056 +0,0 @@
-{-% DrIFT (Automatic class derivations for Haskell) v1.1 %-}
-{-% DrIFT (Automatic class derivations for Haskell) v1.1 %-}
--- 
---  (c) The University of Glasgow 2002
--- 
--- Binary interface file support.
-
-module BinIface ( writeBinIface, readBinIface, v_IgnoreHiWay ) where
-
-#include "HsVersions.h"
-
-import HscTypes
-import BasicTypes
-import NewDemand
-import IfaceSyn
-import VarEnv
-import InstEnv		( OverlapFlag(..) )
-import Packages		( PackageIdH(..) )
-import Class		( DefMeth(..) )
-import CostCentre
-import StaticFlags	( opt_HiVersion, v_Build_tag )
-import Kind		( Kind(..) )
-import Panic
-import Binary
-import Util
-import Config		( cGhcUnregisterised )
-
-import DATA_IOREF
-import EXCEPTION	( throwDyn )
-import Monad		( when )
-import Outputable
-
-#include "HsVersions.h"
-
--- ---------------------------------------------------------------------------
-writeBinIface :: FilePath -> ModIface -> IO ()
-writeBinIface hi_path mod_iface
-  = putBinFileWithDict hi_path mod_iface
-
-readBinIface :: FilePath -> IO ModIface
-readBinIface hi_path = getBinFileWithDict hi_path
-
-
--- %*********************************************************
--- %*						 	    *
--- 		All the Binary instances
--- %*							    *
--- %*********************************************************
-
--- BasicTypes
-{-! for IPName derive: Binary !-}
-{-! for Fixity derive: Binary !-}
-{-! for FixityDirection derive: Binary !-}
-{-! for Boxity derive: Binary !-}
-{-! for StrictnessMark derive: Binary !-}
-{-! for Activation derive: Binary !-}
-
--- NewDemand
-{-! for Demand derive: Binary !-}
-{-! for Demands derive: Binary !-}
-{-! for DmdResult derive: Binary !-}
-{-! for StrictSig derive: Binary !-}
-
--- Class
-{-! for DefMeth derive: Binary !-}
-
--- HsTypes
-{-! for HsPred derive: Binary !-}
-{-! for HsType derive: Binary !-}
-{-! for TupCon derive: Binary !-}
-{-! for HsTyVarBndr derive: Binary !-}
-
--- HsCore
-{-! for UfExpr derive: Binary !-}
-{-! for UfConAlt derive: Binary !-}
-{-! for UfBinding derive: Binary !-}
-{-! for UfBinder derive: Binary !-}
-{-! for HsIdInfo derive: Binary !-}
-{-! for UfNote derive: Binary !-}
-
--- HsDecls
-{-! for ConDetails derive: Binary !-}
-{-! for BangType derive: Binary !-}
-
--- CostCentre
-{-! for IsCafCC derive: Binary !-}
-{-! for IsDupdCC derive: Binary !-}
-{-! for CostCentre derive: Binary !-}
-
-
-
--- ---------------------------------------------------------------------------
--- Reading a binary interface into ParsedIface
-
-instance Binary ModIface where
-   put_ bh (ModIface {
-		 mi_module    = mod,
-		 mi_boot      = is_boot,
-		 mi_mod_vers  = mod_vers,
-		 mi_package   = _, -- we ignore the package on output
-		 mi_orphan    = orphan,
-		 mi_deps      = deps,
-		 mi_usages    = usages,
-		 mi_exports   = exports,
-		 mi_exp_vers  = exp_vers,
-		 mi_fixities  = fixities,
-		 mi_deprecs   = deprecs,
-		 mi_decls     = decls,
-		 mi_insts     = insts,
-		 mi_rules     = rules,
-		 mi_rule_vers = rule_vers }) = do
-	put_ bh (show opt_HiVersion)
-	way_descr <- getWayDescr
-	put  bh way_descr
-	put_ bh mod
-	put_ bh is_boot
-	put_ bh mod_vers
-	put_ bh orphan
-	lazyPut bh deps
-	lazyPut bh usages
-	put_ bh exports
-	put_ bh exp_vers
-	put_ bh fixities
-	lazyPut bh deprecs
-        put_ bh decls
-	put_ bh insts
-	lazyPut bh rules
-	put_ bh rule_vers
-
-   get bh = do
-	check_ver  <- get bh
-	let our_ver = show opt_HiVersion
-        when (check_ver /= our_ver) $
-	   -- use userError because this will be caught by readIface
-	   -- which will emit an error msg containing the iface module name.
-	   throwDyn (ProgramError (
-		"mismatched interface file versions: expected "
-		++ our_ver ++ ", found " ++ check_ver))
-
-	check_way <- get bh
-        ignore_way <- readIORef v_IgnoreHiWay
-	way_descr <- getWayDescr
-        when (not ignore_way && check_way /= way_descr) $
-	   -- use userError because this will be caught by readIface
-	   -- which will emit an error msg containing the iface module name.
-	   throwDyn (ProgramError (
-		"mismatched interface file ways: expected "
-		++ way_descr ++ ", found " ++ check_way))
-
-	mod_name  <- get bh
-	is_boot   <- get bh
-	mod_vers  <- get bh
-	orphan    <- get bh
-	deps	  <- lazyGet bh
-	usages	  <- {-# SCC "bin_usages" #-} lazyGet bh
-	exports	  <- {-# SCC "bin_exports" #-} get bh
-	exp_vers  <- get bh
-	fixities  <- {-# SCC "bin_fixities" #-} get bh
-	deprecs   <- {-# SCC "bin_deprecs" #-} lazyGet bh
-        decls 	  <- {-# SCC "bin_tycldecls" #-} get bh
-	insts     <- {-# SCC "bin_insts" #-} get bh
-	rules	  <- {-# SCC "bin_rules" #-} lazyGet bh
-	rule_vers <- get bh
-	return (ModIface {
-		 mi_package   = HomePackage, -- to be filled in properly later
-		 mi_module    = mod_name,
-		 mi_boot      = is_boot,
-		 mi_mod_vers  = mod_vers,
-		 mi_orphan    = orphan,
-		 mi_deps      = deps,
-		 mi_usages    = usages,
-		 mi_exports   = exports,
-		 mi_exp_vers  = exp_vers,
-		 mi_fixities  = fixities,
-		 mi_deprecs   = deprecs,
-		 mi_decls     = decls,
-		 mi_globals   = Nothing,
-		 mi_insts     = insts,
-		 mi_rules     = rules,
-		 mi_rule_vers = rule_vers,
-			-- And build the cached values
-		 mi_dep_fn = mkIfaceDepCache deprecs,
-		 mi_fix_fn = mkIfaceFixCache fixities,
-		 mi_ver_fn = mkIfaceVerCache decls })
-
-GLOBAL_VAR(v_IgnoreHiWay, False, Bool)
-
-getWayDescr :: IO String
-getWayDescr = do
-  tag <- readIORef v_Build_tag
-  if cGhcUnregisterised == "YES" then return ('u':tag) else return tag
-	-- if this is an unregisterised build, make sure our interfaces
-	-- can't be used by a registerised build.
-
--------------------------------------------------------------------------
---		Types from: HscTypes
--------------------------------------------------------------------------
-
-instance Binary Dependencies where
-    put_ bh deps = do put_ bh (dep_mods deps)
-		      put_ bh (dep_pkgs deps)
-		      put_ bh (dep_orphs deps)
-
-    get bh = do ms <- get bh 
-		ps <- get bh
-		os <- get bh
-		return (Deps { dep_mods = ms, dep_pkgs = ps, dep_orphs = os })
-
-instance (Binary name) => Binary (GenAvailInfo name) where
-    put_ bh (Avail aa) = do
-	    putByte bh 0
-	    put_ bh aa
-    put_ bh (AvailTC ab ac) = do
-	    putByte bh 1
-	    put_ bh ab
-	    put_ bh ac
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      return (Avail aa)
-	      _ -> do ab <- get bh
-		      ac <- get bh
-		      return (AvailTC ab ac)
-
-instance Binary Usage where
-    put_ bh usg	= do 
-	put_ bh (usg_name     usg)
-	put_ bh (usg_mod      usg)
-	put_ bh (usg_exports  usg)
-	put_ bh (usg_entities usg)
-	put_ bh (usg_rules    usg)
-
-    get bh = do
-	nm    <- get bh
-	mod   <- get bh
-	exps  <- get bh
-	ents  <- get bh
-	rules <- get bh
-	return (Usage {	usg_name = nm, usg_mod = mod,
-			usg_exports = exps, usg_entities = ents,
-			usg_rules = rules })
-
-instance Binary a => Binary (Deprecs a) where
-    put_ bh NoDeprecs     = putByte bh 0
-    put_ bh (DeprecAll t) = do
-	    putByte bh 1
-	    put_ bh t
-    put_ bh (DeprecSome ts) = do
-	    putByte bh 2
-	    put_ bh ts
-
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> return NoDeprecs
-	      1 -> do aa <- get bh
-		      return (DeprecAll aa)
-	      _ -> do aa <- get bh
-		      return (DeprecSome aa)
-
--------------------------------------------------------------------------
---		Types from: BasicTypes
--------------------------------------------------------------------------
-
-instance Binary Activation where
-    put_ bh NeverActive = do
-	    putByte bh 0
-    put_ bh AlwaysActive = do
-	    putByte bh 1
-    put_ bh (ActiveBefore aa) = do
-	    putByte bh 2
-	    put_ bh aa
-    put_ bh (ActiveAfter ab) = do
-	    putByte bh 3
-	    put_ bh ab
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return NeverActive
-	      1 -> do return AlwaysActive
-	      2 -> do aa <- get bh
-		      return (ActiveBefore aa)
-	      _ -> do ab <- get bh
-		      return (ActiveAfter ab)
-
-instance Binary StrictnessMark where
-    put_ bh MarkedStrict = do
-	    putByte bh 0
-    put_ bh MarkedUnboxed = do
-	    putByte bh 1
-    put_ bh NotMarkedStrict = do
-	    putByte bh 2
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return MarkedStrict
-	      1 -> do return MarkedUnboxed
-	      _ -> do return NotMarkedStrict
-
-instance Binary Boxity where
-    put_ bh Boxed = do
-	    putByte bh 0
-    put_ bh Unboxed = do
-	    putByte bh 1
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return Boxed
-	      _ -> do return Unboxed
-
-instance Binary TupCon where
-    put_ bh (TupCon ab ac) = do
-	    put_ bh ab
-	    put_ bh ac
-    get bh = do
-	  ab <- get bh
-	  ac <- get bh
-	  return (TupCon ab ac)
-
-instance Binary RecFlag where
-    put_ bh Recursive = do
-	    putByte bh 0
-    put_ bh NonRecursive = do
-	    putByte bh 1
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return Recursive
-	      _ -> do return NonRecursive
-
-instance Binary DefMeth where
-    put_ bh NoDefMeth  = putByte bh 0
-    put_ bh DefMeth    = putByte bh 1
-    put_ bh GenDefMeth = putByte bh 2
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> return NoDefMeth
-	      1 -> return DefMeth
-	      _ -> return GenDefMeth
-
-instance Binary FixityDirection where
-    put_ bh InfixL = do
-	    putByte bh 0
-    put_ bh InfixR = do
-	    putByte bh 1
-    put_ bh InfixN = do
-	    putByte bh 2
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return InfixL
-	      1 -> do return InfixR
-	      _ -> do return InfixN
-
-instance Binary Fixity where
-    put_ bh (Fixity aa ab) = do
-	    put_ bh aa
-	    put_ bh ab
-    get bh = do
-	  aa <- get bh
-	  ab <- get bh
-	  return (Fixity aa ab)
-
-instance (Binary name) => Binary (IPName name) where
-    put_ bh (Dupable aa) = do
-	    putByte bh 0
-	    put_ bh aa
-    put_ bh (Linear ab) = do
-	    putByte bh 1
-	    put_ bh ab
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      return (Dupable aa)
-	      _ -> do ab <- get bh
-		      return (Linear ab)
-
--------------------------------------------------------------------------
---		Types from: Demand
--------------------------------------------------------------------------
-
-instance Binary DmdType where
-	-- Ignore DmdEnv when spitting out the DmdType
-  put bh (DmdType _ ds dr) = do p <- put bh ds; put bh dr; return (castBin p)
-  get bh = do ds <- get bh; dr <- get bh; return (DmdType emptyVarEnv ds dr)
-
-instance Binary Demand where
-    put_ bh Top = do
-	    putByte bh 0
-    put_ bh Abs = do
-	    putByte bh 1
-    put_ bh (Call aa) = do
-	    putByte bh 2
-	    put_ bh aa
-    put_ bh (Eval ab) = do
-	    putByte bh 3
-	    put_ bh ab
-    put_ bh (Defer ac) = do
-	    putByte bh 4
-	    put_ bh ac
-    put_ bh (Box ad) = do
-	    putByte bh 5
-	    put_ bh ad
-    put_ bh Bot = do
-	    putByte bh 6
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return Top
-	      1 -> do return Abs
-	      2 -> do aa <- get bh
-		      return (Call aa)
-	      3 -> do ab <- get bh
-		      return (Eval ab)
-	      4 -> do ac <- get bh
-		      return (Defer ac)
-	      5 -> do ad <- get bh
-		      return (Box ad)
-	      _ -> do return Bot
-
-instance Binary Demands where
-    put_ bh (Poly aa) = do
-	    putByte bh 0
-	    put_ bh aa
-    put_ bh (Prod ab) = do
-	    putByte bh 1
-	    put_ bh ab
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      return (Poly aa)
-	      _ -> do ab <- get bh
-		      return (Prod ab)
-
-instance Binary DmdResult where
-    put_ bh TopRes = do
-	    putByte bh 0
-    put_ bh RetCPR = do
-	    putByte bh 1
-    put_ bh BotRes = do
-	    putByte bh 2
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return TopRes
-	      1 -> do return RetCPR	-- Really use RetCPR even if -fcpr-off
-					-- The wrapper was generated for CPR in 
-					-- the imported module!
-	      _ -> do return BotRes
-
-instance Binary StrictSig where
-    put_ bh (StrictSig aa) = do
-	    put_ bh aa
-    get bh = do
-	  aa <- get bh
-	  return (StrictSig aa)
-
-
--------------------------------------------------------------------------
---		Types from: CostCentre
--------------------------------------------------------------------------
-
-instance Binary IsCafCC where
-    put_ bh CafCC = do
-	    putByte bh 0
-    put_ bh NotCafCC = do
-	    putByte bh 1
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return CafCC
-	      _ -> do return NotCafCC
-
-instance Binary IsDupdCC where
-    put_ bh OriginalCC = do
-	    putByte bh 0
-    put_ bh DupdCC = do
-	    putByte bh 1
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return OriginalCC
-	      _ -> do return DupdCC
-
-instance Binary CostCentre where
-    put_ bh NoCostCentre = do
-	    putByte bh 0
-    put_ bh (NormalCC aa ab ac ad) = do
-	    putByte bh 1
-	    put_ bh aa
-	    put_ bh ab
-	    put_ bh ac
-	    put_ bh ad
-    put_ bh (AllCafsCC ae) = do
-	    putByte bh 2
-	    put_ bh ae
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return NoCostCentre
-	      1 -> do aa <- get bh
-		      ab <- get bh
-		      ac <- get bh
-		      ad <- get bh
-		      return (NormalCC aa ab ac ad)
-	      _ -> do ae <- get bh
-		      return (AllCafsCC ae)
-
--------------------------------------------------------------------------
---		IfaceTypes and friends
--------------------------------------------------------------------------
-
-instance Binary IfaceExtName where
-    put_ bh (ExtPkg mod occ) = do
-	    putByte bh 0
-	    put_ bh mod
-	    put_ bh occ
-    put_ bh (HomePkg mod occ vers) = do
-	    putByte bh 1
-	    put_ bh mod
-	    put_ bh occ
-	    put_ bh vers
-    put_ bh (LocalTop occ) = do
-	    putByte bh 2
-	    put_ bh occ
-    put_ bh (LocalTopSub occ _) = do	-- Write LocalTopSub just like LocalTop
-	    putByte bh 2
-	    put_ bh occ
-
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do mod <- get bh
-		      occ <- get bh
-		      return (ExtPkg mod occ)
-	      1 -> do mod <- get bh
-		      occ <- get bh
-		      vers <- get bh
-		      return (HomePkg mod occ vers)
-	      _ -> do occ <- get bh
-		      return (LocalTop occ)
-
-instance Binary IfaceBndr where
-    put_ bh (IfaceIdBndr aa) = do
-	    putByte bh 0
-	    put_ bh aa
-    put_ bh (IfaceTvBndr ab) = do
-	    putByte bh 1
-	    put_ bh ab
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      return (IfaceIdBndr aa)
-	      _ -> do ab <- get bh
-		      return (IfaceTvBndr ab)
-
-instance Binary Kind where
-    put_ bh LiftedTypeKind   = putByte bh 0
-    put_ bh UnliftedTypeKind = putByte bh 1
-    put_ bh OpenTypeKind     = putByte bh 2
-    put_ bh ArgTypeKind      = putByte bh 3
-    put_ bh UbxTupleKind     = putByte bh 4
-    put_ bh (FunKind k1 k2)  = do 
-	    putByte bh 5
-	    put_ bh k1
-	    put_ bh k2
-    put_ bh (KindVar kv) = pprPanic "BinIface.put_: kind var" (ppr kv)
-
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> return LiftedTypeKind 
-	      1 -> return UnliftedTypeKind
-	      2 -> return OpenTypeKind
-	      3 -> return ArgTypeKind
-	      4 -> return UbxTupleKind
-	      _ -> do k1 <- get bh
-		      k2 <- get bh
-		      return (FunKind k1 k2)
-
-instance Binary IfaceType where
-    put_ bh (IfaceForAllTy aa ab) = do
-	    putByte bh 0
-	    put_ bh aa
-	    put_ bh ab
-    put_ bh (IfaceTyVar ad) = do
-	    putByte bh 1
-	    put_ bh ad
-    put_ bh (IfaceAppTy ae af) = do
-	    putByte bh 2
-	    put_ bh ae
-	    put_ bh af
-    put_ bh (IfaceFunTy ag ah) = do
-	    putByte bh 3
-	    put_ bh ag
-	    put_ bh ah
-    put_ bh (IfacePredTy aq) = do
-	    putByte bh 5
-	    put_ bh aq
-
-	-- Simple compression for common cases of TyConApp
-    put_ bh (IfaceTyConApp IfaceIntTc  [])   = putByte bh 6
-    put_ bh (IfaceTyConApp IfaceCharTc [])   = putByte bh 7
-    put_ bh (IfaceTyConApp IfaceBoolTc [])   = putByte bh 8
-    put_ bh (IfaceTyConApp IfaceListTc [ty]) = do { putByte bh 9; put_ bh ty }
-	-- Unit tuple and pairs
-    put_ bh (IfaceTyConApp (IfaceTupTc Boxed 0) []) 	 = putByte bh 10
-    put_ bh (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) = do { putByte bh 11; put_ bh t1; put_ bh t2 }
-	-- Generic cases
-    put_ bh (IfaceTyConApp (IfaceTc tc) tys) = do { putByte bh 12; put_ bh tc; put_ bh tys }
-    put_ bh (IfaceTyConApp tc tys) 	     = do { putByte bh 13; put_ bh tc; put_ bh tys }
-
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      ab <- get bh
-		      return (IfaceForAllTy aa ab)
-	      1 -> do ad <- get bh
-		      return (IfaceTyVar ad)
-	      2 -> do ae <- get bh
-		      af <- get bh
-		      return (IfaceAppTy ae af)
-	      3 -> do ag <- get bh
-		      ah <- get bh
-		      return (IfaceFunTy ag ah)
-	      5 -> do ap <- get bh
-		      return (IfacePredTy ap)
-
-		-- Now the special cases for TyConApp
-	      6 -> return (IfaceTyConApp IfaceIntTc [])
-	      7 -> return (IfaceTyConApp IfaceCharTc [])
-	      8 -> return (IfaceTyConApp IfaceBoolTc [])
-	      9 -> do { ty <- get bh; return (IfaceTyConApp IfaceListTc [ty]) }
-	      10 -> return (IfaceTyConApp (IfaceTupTc Boxed 0) [])
-	      11 -> do { t1 <- get bh; t2 <- get bh; return (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) }
-	      12 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
-	      _  -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp tc tys) }
-
-instance Binary IfaceTyCon where
-	-- Int,Char,Bool can't show up here because they can't not be saturated
-
-   put_ bh IfaceIntTc  	      = putByte bh 1
-   put_ bh IfaceBoolTc 	      = putByte bh 2
-   put_ bh IfaceCharTc 	      = putByte bh 3
-   put_ bh IfaceListTc 	      = putByte bh 4
-   put_ bh IfacePArrTc 	      = putByte bh 5
-   put_ bh (IfaceTupTc bx ar) = do { putByte bh 6; put_ bh bx; put_ bh ar }
-   put_ bh (IfaceTc ext)      = do { putByte bh 7; put_ bh ext }
-
-   get bh = do
-	h <- getByte bh
-	case h of
-	  1 -> return IfaceIntTc
-	  2 -> return IfaceBoolTc
-	  3 -> return IfaceCharTc
-	  4 -> return IfaceListTc
-	  5 -> return IfacePArrTc
-	  6 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
-	  _ -> do { ext <- get bh; return (IfaceTc ext) }
-
-instance Binary IfacePredType where
-    put_ bh (IfaceClassP aa ab) = do
-	    putByte bh 0
-	    put_ bh aa
-	    put_ bh ab
-    put_ bh (IfaceIParam ac ad) = do
-	    putByte bh 1
-	    put_ bh ac
-	    put_ bh ad
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      ab <- get bh
-		      return (IfaceClassP aa ab)
-	      _ -> do ac <- get bh
-		      ad <- get bh
-		      return (IfaceIParam ac ad)
-
--------------------------------------------------------------------------
---		IfaceExpr and friends
--------------------------------------------------------------------------
-
-instance Binary IfaceExpr where
-    put_ bh (IfaceLcl aa) = do
-	    putByte bh 0
-	    put_ bh aa
-    put_ bh (IfaceType ab) = do
-	    putByte bh 1
-	    put_ bh ab
-    put_ bh (IfaceTuple ac ad) = do
-	    putByte bh 2
-	    put_ bh ac
-	    put_ bh ad
-    put_ bh (IfaceLam ae af) = do
-	    putByte bh 3
-	    put_ bh ae
-	    put_ bh af
-    put_ bh (IfaceApp ag ah) = do
-	    putByte bh 4
-	    put_ bh ag
-	    put_ bh ah
--- gaw 2004
-    put_ bh (IfaceCase ai aj al ak) = do
-	    putByte bh 5
-	    put_ bh ai
-	    put_ bh aj
--- gaw 2004
-            put_ bh al
-	    put_ bh ak
-    put_ bh (IfaceLet al am) = do
-	    putByte bh 6
-	    put_ bh al
-	    put_ bh am
-    put_ bh (IfaceNote an ao) = do
-	    putByte bh 7
-	    put_ bh an
-	    put_ bh ao
-    put_ bh (IfaceLit ap) = do
-	    putByte bh 8
-	    put_ bh ap
-    put_ bh (IfaceFCall as at) = do
-	    putByte bh 9
-	    put_ bh as
-	    put_ bh at
-    put_ bh (IfaceExt aa) = do
-	    putByte bh 10
-	    put_ bh aa
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      return (IfaceLcl aa)
-	      1 -> do ab <- get bh
-		      return (IfaceType ab)
-	      2 -> do ac <- get bh
-		      ad <- get bh
-		      return (IfaceTuple ac ad)
-	      3 -> do ae <- get bh
-		      af <- get bh
-		      return (IfaceLam ae af)
-	      4 -> do ag <- get bh
-		      ah <- get bh
-		      return (IfaceApp ag ah)
-	      5 -> do ai <- get bh
-		      aj <- get bh
--- gaw 2004
-                      al <- get bh                   
-		      ak <- get bh
--- gaw 2004
-		      return (IfaceCase ai aj al ak)
-	      6 -> do al <- get bh
-		      am <- get bh
-		      return (IfaceLet al am)
-	      7 -> do an <- get bh
-		      ao <- get bh
-		      return (IfaceNote an ao)
-	      8 -> do ap <- get bh
-		      return (IfaceLit ap)
-	      9 -> do as <- get bh
-		      at <- get bh
-		      return (IfaceFCall as at)
-	      _ -> do aa <- get bh
-		      return (IfaceExt aa)
-
-instance Binary IfaceConAlt where
-    put_ bh IfaceDefault = do
-	    putByte bh 0
-    put_ bh (IfaceDataAlt aa) = do
-	    putByte bh 1
-	    put_ bh aa
-    put_ bh (IfaceTupleAlt ab) = do
-	    putByte bh 2
-	    put_ bh ab
-    put_ bh (IfaceLitAlt ac) = do
-	    putByte bh 3
-	    put_ bh ac
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return IfaceDefault
-	      1 -> do aa <- get bh
-		      return (IfaceDataAlt aa)
-	      2 -> do ab <- get bh
-		      return (IfaceTupleAlt ab)
-	      _ -> do ac <- get bh
-		      return (IfaceLitAlt ac)
-
-instance Binary IfaceBinding where
-    put_ bh (IfaceNonRec aa ab) = do
-	    putByte bh 0
-	    put_ bh aa
-	    put_ bh ab
-    put_ bh (IfaceRec ac) = do
-	    putByte bh 1
-	    put_ bh ac
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      ab <- get bh
-		      return (IfaceNonRec aa ab)
-	      _ -> do ac <- get bh
-		      return (IfaceRec ac)
-
-instance Binary IfaceIdInfo where
-    put_ bh NoInfo = putByte bh 0
-    put_ bh (HasInfo i) = do
-	    putByte bh 1
-	    lazyPut bh i			-- NB lazyPut
-
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> return NoInfo
-	      _ -> do info <- lazyGet bh	-- NB lazyGet
-		      return (HasInfo info)
-
-instance Binary IfaceInfoItem where
-    put_ bh (HsArity aa) = do
-	    putByte bh 0
-	    put_ bh aa
-    put_ bh (HsStrictness ab) = do
-	    putByte bh 1
-	    put_ bh ab
-    put_ bh (HsUnfold ac ad) = do
-	    putByte bh 2
-	    put_ bh ac
-	    put_ bh ad
-    put_ bh HsNoCafRefs = do
-	    putByte bh 3
-    put_ bh (HsWorker ae af) = do
-	    putByte bh 4
-	    put_ bh ae
-	    put_ bh af
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      return (HsArity aa)
-	      1 -> do ab <- get bh
-		      return (HsStrictness ab)
-	      2 -> do ac <- get bh
-		      ad <- get bh
-		      return (HsUnfold ac ad)
-	      3 -> do return HsNoCafRefs
-	      _ -> do ae <- get bh
-		      af <- get bh
-		      return (HsWorker ae af)
-
-instance Binary IfaceNote where
-    put_ bh (IfaceSCC aa) = do
-	    putByte bh 0
-	    put_ bh aa
-    put_ bh (IfaceCoerce ab) = do
-	    putByte bh 1
-	    put_ bh ab
-    put_ bh IfaceInlineCall = do
-	    putByte bh 2
-    put_ bh IfaceInlineMe = do
-	    putByte bh 3
-    put_ bh (IfaceCoreNote s) = do
-            putByte bh 4
-            put_ bh s
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      return (IfaceSCC aa)
-	      1 -> do ab <- get bh
-		      return (IfaceCoerce ab)
-	      2 -> do return IfaceInlineCall
-	      3 -> do return IfaceInlineMe
-              _ -> do ac <- get bh
-                      return (IfaceCoreNote ac)
-
-
--------------------------------------------------------------------------
---		IfaceDecl and friends
--------------------------------------------------------------------------
-
-instance Binary IfaceDecl where
-    put_ bh (IfaceId name ty idinfo) = do
-	    putByte bh 0
-	    put_ bh name
-	    put_ bh ty
-	    put_ bh idinfo
-    put_ bh (IfaceForeign ae af) = 
-	error "Binary.put_(IfaceDecl): IfaceForeign"
-    put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7) = do
-	    putByte bh 2
-	    put_ bh a1
-	    put_ bh a2
-	    put_ bh a3
-	    put_ bh a4
-	    put_ bh a5
-	    put_ bh a6
-	    put_ bh a7
-
-    put_ bh (IfaceSyn aq ar as at) = do
-	    putByte bh 3
-	    put_ bh aq
-	    put_ bh ar
-	    put_ bh as
-	    put_ bh at
-    put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
-	    putByte bh 4
-	    put_ bh a1
-	    put_ bh a2
-	    put_ bh a3
-	    put_ bh a4
-	    put_ bh a5
-	    put_ bh a6
-	    put_ bh a7
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do name   <- get bh
-		      ty     <- get bh
-		      idinfo <- get bh
-		      return (IfaceId name ty idinfo)
-	      1 -> error "Binary.get(TyClDecl): ForeignType"
-	      2 -> do
-		    a1 <- get bh
-		    a2 <- get bh
-		    a3 <- get bh
-		    a4 <- get bh
-		    a5 <- get bh
-		    a6 <- get bh
-		    a7 <- get bh
-		    return (IfaceData a1 a2 a3 a4 a5 a6 a7)
-	      3 -> do
-		    aq <- get bh
-		    ar <- get bh
-		    as <- get bh
-		    at <- get bh
-		    return (IfaceSyn aq ar as at)
-	      _ -> do
-		    a1 <- get bh
-		    a2 <- get bh
-		    a3 <- get bh
-		    a4 <- get bh
-		    a5 <- get bh
-		    a6 <- get bh
-		    a7 <- get bh
-		    return (IfaceClass a1 a2 a3 a4 a5 a6 a7)
-
-instance Binary IfaceInst where
-    put_ bh (IfaceInst cls tys dfun flag orph) = do
-	    put_ bh cls
-	    put_ bh tys
-	    put_ bh dfun
-	    put_ bh flag
-	    put_ bh orph
-    get bh = do cls  <- get bh
-		tys  <- get bh
-		dfun <- get bh
-		flag <- get bh
-		orph <- get bh
-		return (IfaceInst cls tys dfun flag orph)
-
-instance Binary OverlapFlag where
-    put_ bh NoOverlap  = putByte bh 0
-    put_ bh OverlapOk  = putByte bh 1
-    put_ bh Incoherent = putByte bh 2
-    get bh = do h <- getByte bh
-		case h of
-		  0 -> return NoOverlap
-		  1 -> return OverlapOk
-		  2 -> return Incoherent
-
-instance Binary IfaceConDecls where
-    put_ bh IfAbstractTyCon = putByte bh 0
-    put_ bh (IfDataTyCon cs) = do { putByte bh 1
-				  ; put_ bh cs }
-    put_ bh (IfNewTyCon c)  = do { putByte bh 2
-				  ; put_ bh c }
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> return IfAbstractTyCon
-	      1 -> do cs <- get bh
-		      return (IfDataTyCon cs)
-	      _ -> do aa <- get bh
-		      return (IfNewTyCon aa)
-
-instance Binary IfaceConDecl where
-    put_ bh (IfVanillaCon a1 a2 a3 a4 a5) = do
-	    putByte bh 0
-	    put_ bh a1
-	    put_ bh a2
-	    put_ bh a3
-	    put_ bh a4
-	    put_ bh a5
-    put_ bh (IfGadtCon a1 a2 a3 a4 a5 a6) = do
-	    putByte bh 1
-	    put_ bh a1
-	    put_ bh a2
-	    put_ bh a3
-	    put_ bh a4
-	    put_ bh a5
-	    put_ bh a6
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do a1 <- get bh
-		      a2 <- get bh
-		      a3 <- get bh	      
-		      a4 <- get bh
-		      a5 <- get bh
-		      return (IfVanillaCon a1 a2 a3 a4 a5)
-	      _ -> do a1 <- get bh
-		      a2 <- get bh
-		      a3 <- get bh	      
-		      a4 <- get bh
-		      a5 <- get bh
-		      a6 <- get bh
-		      return (IfGadtCon a1 a2 a3 a4 a5 a6)
-
-instance Binary IfaceClassOp where
-   put_ bh (IfaceClassOp n def ty) = do	
-	put_ bh n 
-	put_ bh def	
-	put_ bh ty
-   get bh = do
-	n <- get bh
-	def <- get bh
-	ty <- get bh
-	return (IfaceClassOp n def ty)
-
-instance Binary IfaceRule where
-    put_ bh (IfaceRule a1 a2 a3 a4 a5 a6 a7) = do
-	    put_ bh a1
-	    put_ bh a2
-	    put_ bh a3
-	    put_ bh a4
-	    put_ bh a5
-	    put_ bh a6
-	    put_ bh a7
-    get bh = do
-	    a1 <- get bh
-	    a2 <- get bh
-	    a3 <- get bh
-	    a4 <- get bh
-	    a5 <- get bh
-	    a6 <- get bh
-	    a7 <- get bh
-	    return (IfaceRule a1 a2 a3 a4 a5 a6 a7)
-
-
diff --git a/ghc/compiler/iface/BuildTyCl.lhs b/ghc/compiler/iface/BuildTyCl.lhs
deleted file mode 100644
index f81f2e7d07..0000000000
--- a/ghc/compiler/iface/BuildTyCl.lhs
+++ /dev/null
@@ -1,256 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-
-\begin{code}
-module BuildTyCl (
-	buildSynTyCon, buildAlgTyCon, buildDataCon,
-	buildClass,
-	mkAbstractTyConRhs, mkNewTyConRhs, mkDataTyConRhs
-    ) where
-
-#include "HsVersions.h"
-
-import IfaceEnv		( newImplicitBinder )
-import TcRnMonad
-
-import DataCon		( DataCon, isNullarySrcDataCon, dataConTyVars,
-			  mkDataCon, dataConFieldLabels, dataConOrigArgTys )
-import Var		( tyVarKind, TyVar, Id )
-import VarSet		( isEmptyVarSet, intersectVarSet, elemVarSet )
-import TysWiredIn  	( unitTy )
-import BasicTypes	( RecFlag, StrictnessMark(..) )
-import Name		( Name )
-import OccName		( mkDataConWrapperOcc, mkDataConWorkerOcc, mkClassTyConOcc,
-			  mkClassDataConOcc, mkSuperDictSelOcc )
-import MkId		( mkDataConIds, mkRecordSelId, mkDictSelId )
-import Class		( mkClass, Class( classTyCon), FunDep, DefMeth(..) )
-import TyCon		( mkSynTyCon, mkAlgTyCon, visibleDataCons, tyConStupidTheta,
-			  tyConDataCons, isNewTyCon, mkClassTyCon, TyCon( tyConTyVars ),
-			  isRecursiveTyCon,
-			  ArgVrcs, AlgTyConRhs(..), newTyConRhs )
-import Type		( mkArrowKinds, liftedTypeKind, typeKind, 
-			  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
-			  splitTyConApp_maybe, splitAppTy_maybe, getTyVar_maybe,
-			  mkPredTys, mkTyVarTys, ThetaType, Type, 
-			  substTyWith, zipTopTvSubst, substTheta )
-import Outputable
-import List		( nub )
-
-\end{code}
-	
-
-\begin{code}
-------------------------------------------------------
-buildSynTyCon name tvs rhs_ty arg_vrcs
-  = mkSynTyCon name kind tvs rhs_ty arg_vrcs
-  where
-    kind = mkArrowKinds (map tyVarKind tvs) (typeKind rhs_ty)
-
-
-------------------------------------------------------
-buildAlgTyCon :: Name -> [TyVar] 
-	      -> ThetaType		-- Stupid theta
-	      -> AlgTyConRhs
-	      -> ArgVrcs -> RecFlag
-	      -> Bool			-- True <=> want generics functions
-	      -> TcRnIf m n TyCon
-
-buildAlgTyCon tc_name tvs stupid_theta rhs arg_vrcs is_rec want_generics
-  = do	{ let { tycon = mkAlgTyCon tc_name kind tvs arg_vrcs stupid_theta
-				   rhs fields is_rec want_generics
-	      ; kind    = mkArrowKinds (map tyVarKind tvs) liftedTypeKind
-	      ; fields  = mkTyConSelIds tycon rhs
-	  }
-	; return tycon }
-
-------------------------------------------------------
-mkAbstractTyConRhs :: AlgTyConRhs
-mkAbstractTyConRhs = AbstractTyCon
-
-mkDataTyConRhs :: [DataCon] -> AlgTyConRhs
-mkDataTyConRhs cons
-  = DataTyCon { data_cons = cons, is_enum = all isNullarySrcDataCon cons }
-
-mkNewTyConRhs :: TyCon -> DataCon -> AlgTyConRhs
-mkNewTyConRhs tycon con 
-  = NewTyCon { data_con = con, 
-	       nt_rhs = rhs_ty,
-	       nt_etad_rhs = eta_reduce tvs rhs_ty,
-	       nt_rep = mkNewTyConRep tycon rhs_ty }
-  where
-    tvs    = dataConTyVars con
-    rhs_ty = head (dataConOrigArgTys con)
-	-- Newtypes are guaranteed vanilla, so OrigArgTys will do
-
-    eta_reduce [] ty = ([], ty)
-    eta_reduce (a:as) ty | null as', 
-			   Just (fun, arg) <- splitAppTy_maybe ty',
-			   Just tv <- getTyVar_maybe arg,
-			   tv == a,
-			   not (a `elemVarSet` tyVarsOfType fun)
-			 = ([], fun)	-- Successful eta reduction
-			 | otherwise
-			 = (a:as', ty')
-	where
-  	  (as', ty') = eta_reduce as ty
-				
-mkNewTyConRep :: TyCon		-- The original type constructor
-	      -> Type		-- The arg type of its constructor
-	      -> Type		-- Chosen representation type
--- The "representation type" is guaranteed not to be another newtype
--- at the outermost level; but it might have newtypes in type arguments
-
--- Find the representation type for this newtype TyCon
--- Remember that the representation type is the *ultimate* representation
--- type, looking through other newtypes.
--- 
--- The non-recursive newtypes are easy, because they look transparent
--- to splitTyConApp_maybe, but recursive ones really are represented as
--- TyConApps (see TypeRep).
--- 
--- The trick is to to deal correctly with recursive newtypes
--- such as	newtype T = MkT T
-
-mkNewTyConRep tc rhs_ty
-  | null (tyConDataCons tc) = unitTy
-	-- External Core programs can have newtypes with no data constructors
-  | otherwise		    = go [tc] rhs_ty
-  where
-	-- Invariant: tcs have been seen before
-    go tcs rep_ty 
-	= case splitTyConApp_maybe rep_ty of
-	    Just (tc, tys)
-		| tc `elem` tcs -> unitTy	-- Recursive loop
-		| isNewTyCon tc -> ASSERT( isRecursiveTyCon tc )
-					-- Non-recursive ones have been 
-					-- dealt with by splitTyConApp_maybe
-				   go (tc:tcs) (substTyWith tvs tys rhs_ty)
-		where
-		  (tvs, rhs_ty) = newTyConRhs tc
-
-	    other -> rep_ty 
-
-------------------------------------------------------
-buildDataCon :: Name -> Bool -> Bool
-	    -> [StrictnessMark] 
-	    -> [Name]			-- Field labels
-	    -> [TyVar] 
-	    -> ThetaType		-- Does not include the "stupid theta"
-	    -> [Type] -> TyCon -> [Type]
-	    -> TcRnIf m n DataCon
--- A wrapper for DataCon.mkDataCon that
---   a) makes the worker Id
---   b) makes the wrapper Id if necessary, including
---	allocating its unique (hence monadic)
-buildDataCon src_name declared_infix vanilla arg_stricts field_lbls
-	     tyvars ctxt arg_tys tycon res_tys
-  = do	{ wrap_name <- newImplicitBinder src_name mkDataConWrapperOcc
-	; work_name <- newImplicitBinder src_name mkDataConWorkerOcc
-	-- This last one takes the name of the data constructor in the source
-	-- code, which (for Haskell source anyway) will be in the DataName name
-	-- space, and puts it into the VarName name space
-
-	; let
-		stupid_ctxt = mkDataConStupidTheta tycon arg_tys res_tys
-		data_con = mkDataCon src_name declared_infix vanilla
-				     arg_stricts field_lbls
-				     tyvars stupid_ctxt ctxt
-				     arg_tys tycon res_tys dc_ids
-		dc_ids = mkDataConIds wrap_name work_name data_con
-
-	; returnM data_con }
-
-
--- The stupid context for a data constructor should be limited to
--- the type variables mentioned in the arg_tys
-mkDataConStupidTheta tycon arg_tys res_tys
-  | null stupid_theta = []	-- The common case
-  | otherwise 	      = filter in_arg_tys stupid_theta
-  where
-    tc_subst	    = zipTopTvSubst (tyConTyVars tycon) res_tys
-    stupid_theta    = substTheta tc_subst (tyConStupidTheta tycon)
-	-- Start by instantiating the master copy of the 
-	-- stupid theta, taken from the TyCon
-
-    arg_tyvars      = tyVarsOfTypes arg_tys
-    in_arg_tys pred = not $ isEmptyVarSet $ 
-			tyVarsOfPred pred `intersectVarSet` arg_tyvars
-
-------------------------------------------------------
-mkTyConSelIds :: TyCon -> AlgTyConRhs -> [Id]
-mkTyConSelIds tycon rhs
-  =  [ mkRecordSelId tycon fld 
-     | fld <- nub (concatMap dataConFieldLabels (visibleDataCons rhs)) ]
-	-- We'll check later that fields with the same name 
-	-- from different constructors have the same type.
-\end{code}
-
-
-------------------------------------------------------
-\begin{code}
-buildClass :: Name -> [TyVar] -> ThetaType
-	   -> [FunDep TyVar]		-- Functional dependencies
-	   -> [(Name, DefMeth, Type)]	-- Method info
-	   -> RecFlag -> ArgVrcs	-- Info for type constructor
-	   -> TcRnIf m n Class
-
-buildClass class_name tvs sc_theta fds sig_stuff tc_isrec tc_vrcs
-  = do	{ tycon_name <- newImplicitBinder class_name mkClassTyConOcc
-	; datacon_name <- newImplicitBinder class_name mkClassDataConOcc
-		-- The class name is the 'parent' for this datacon, not its tycon,
-		-- because one should import the class to get the binding for 
-		-- the datacon
-	; sc_sel_names <- mapM (newImplicitBinder class_name . mkSuperDictSelOcc) 
-				[1..length sc_theta]
-	      -- We number off the superclass selectors, 1, 2, 3 etc so that we 
-	      -- can construct names for the selectors.  Thus
-	      --      class (C a, C b) => D a b where ...
-	      -- gives superclass selectors
-	      --      D_sc1, D_sc2
-	      -- (We used to call them D_C, but now we can have two different
-	      --  superclasses both called C!)
-
-	; fixM (\ clas -> do {	-- Only name generation inside loop
-
-	  let { op_tys		   = [ty | (_,_,ty) <- sig_stuff]
-	      ; sc_tys		   = mkPredTys sc_theta
-	      ;	dict_component_tys = sc_tys ++ op_tys
-	      ; sc_sel_ids	   = [mkDictSelId sc_name clas | sc_name <- sc_sel_names]
-	      ; op_items = [ (mkDictSelId op_name clas, dm_info)
-			   | (op_name, dm_info, _) <- sig_stuff ] }
-	  		-- Build the selector id and default method id
-
-	; dict_con <- buildDataCon datacon_name 
-				   False 	-- Not declared infix
-				   True		-- Is vanilla; tyvars same as tycon
-				   (map (const NotMarkedStrict) dict_component_tys)
-				   [{- No labelled fields -}]
-				   tvs [{-No context-}] dict_component_tys
-				   (classTyCon clas) (mkTyVarTys tvs)
-
-	; let {	clas = mkClass class_name tvs fds
-		       sc_theta sc_sel_ids op_items
-		       tycon
-
-	      ;	tycon = mkClassTyCon tycon_name clas_kind tvs
-                             tc_vrcs rhs clas tc_isrec
-		-- A class can be recursive, and in the case of newtypes 
-		-- this matters.  For example
-		-- 	class C a where { op :: C b => a -> b -> Int }
-		-- Because C has only one operation, it is represented by
-		-- a newtype, and it should be a *recursive* newtype.
-		-- [If we don't make it a recursive newtype, we'll expand the
-		-- newtype like a synonym, but that will lead to an infinite type]
-
-	      ; clas_kind = mkArrowKinds (map tyVarKind tvs) liftedTypeKind
-
- 	      ; rhs = case dict_component_tys of
-			    [rep_ty] -> mkNewTyConRhs tycon dict_con
-			    other    -> mkDataTyConRhs [dict_con]
-	      }
-	; return clas
-	})}
-\end{code}
-
-
diff --git a/ghc/compiler/iface/IfaceEnv.lhs b/ghc/compiler/iface/IfaceEnv.lhs
deleted file mode 100644
index 40b7d31f13..0000000000
--- a/ghc/compiler/iface/IfaceEnv.lhs
+++ /dev/null
@@ -1,359 +0,0 @@
-(c) The University of Glasgow 2002
-
-\begin{code}
-module IfaceEnv (
-	newGlobalBinder, newIPName, newImplicitBinder, 
-	lookupIfaceTop, lookupIfaceExt,
-	lookupOrig, lookupIfaceTc,
-	newIfaceName, newIfaceNames,
-	extendIfaceIdEnv, extendIfaceTyVarEnv, refineIfaceIdEnv,
-	tcIfaceLclId,     tcIfaceTyVar, 
-
-	lookupAvail, ifaceExportNames,
-
-	-- Name-cache stuff
-	allocateGlobalBinder, initNameCache, 
-   ) where
-
-#include "HsVersions.h"
-
-import TcRnMonad
-import IfaceType	( IfaceExtName(..), IfaceTyCon(..), ifaceTyConName )
-import TysWiredIn	( tupleTyCon, tupleCon )
-import HscTypes		( NameCache(..), HscEnv(..), GenAvailInfo(..), 
-			  IfaceExport, OrigNameCache )
-import Type		( mkOpenTvSubst, substTy )
-import TyCon		( TyCon, tyConName )
-import Unify		( TypeRefinement )
-import DataCon		( dataConWorkId, dataConName )
-import Var		( TyVar, Id, varName, setIdType, idType )
-import Name		( Name, nameUnique, nameModule, 
-			  nameOccName, nameSrcLoc, 
-			  getOccName, nameParent_maybe,
-		  	  isWiredInName, mkIPName,
-			  mkExternalName, mkInternalName )
-import NameSet		( NameSet, emptyNameSet, addListToNameSet )
-import OccName		( OccName, isTupleOcc_maybe, tcName, dataName, mapOccEnv,
-			  lookupOccEnv, unitOccEnv, extendOccEnv, extendOccEnvList )
-import PrelNames	( gHC_PRIM, pREL_TUP )
-import Module		( Module, emptyModuleEnv, 
-			  lookupModuleEnv, extendModuleEnv_C )
-import UniqSupply	( UniqSupply, splitUniqSupply, uniqFromSupply, uniqsFromSupply )
-import FiniteMap	( emptyFM, lookupFM, addToFM )
-import BasicTypes	( IPName(..), mapIPName )
-import SrcLoc		( SrcLoc, noSrcLoc )
-import Maybes		( orElse )
-
-import Outputable
-\end{code}
-
-
-%*********************************************************
-%*							*
-	Allocating new Names in the Name Cache
-%*							*
-%*********************************************************
-
-\begin{code}
-newGlobalBinder :: Module -> OccName -> Maybe Name -> SrcLoc -> TcRnIf a b Name
--- Used for source code and interface files, to make the
--- Name for a thing, given its Module and OccName
---
--- The cache may already already have a binding for this thing,
--- because we may have seen an occurrence before, but now is the
--- moment when we know its Module and SrcLoc in their full glory
-
-newGlobalBinder mod occ mb_parent loc
-  = do	{ mod `seq` occ `seq` return ()	-- See notes with lookupOrig_help
-	-- ; traceIf (text "newGlobalBinder" <+> ppr mod <+> ppr occ <+> ppr loc)
-    	; name_supply <- getNameCache
-	; let (name_supply', name) = allocateGlobalBinder 
-					name_supply mod occ
-					mb_parent loc
-	; setNameCache name_supply'
-	; return name }
-
-allocateGlobalBinder
-  :: NameCache 
-  -> Module -> OccName -> Maybe Name -> SrcLoc 
-  -> (NameCache, Name)
-allocateGlobalBinder name_supply mod occ mb_parent loc
-  = case lookupOrigNameCache (nsNames name_supply) mod occ of
-	-- A hit in the cache!  We are at the binding site of the name.
-	-- This is the moment when we know the defining parent and SrcLoc
-	-- of the Name, so we set these fields in the Name we return.
-	--
-	-- Then (bogus) multiple bindings of the same Name
-	-- get different SrcLocs can can be reported as such.
-	--
-	-- Possible other reason: it might be in the cache because we
-	-- 	encountered an occurrence before the binding site for an
-	--	implicitly-imported Name.  Perhaps the current SrcLoc is
-	--	better... but not really: it'll still just say 'imported'
-	--
-	-- IMPORTANT: Don't mess with wired-in names.  
-	-- 	      Their wired-in-ness is in their NameSort
-	--	      and their Module is correct.
-
-	Just name | isWiredInName name -> (name_supply, name)
-		  | otherwise -> (new_name_supply, name')
-		  where
-		    uniq      = nameUnique name
-		    name'     = mkExternalName uniq mod occ mb_parent loc
-		    new_cache = extend_name_cache (nsNames name_supply) mod occ name'
-		    new_name_supply = name_supply {nsNames = new_cache}		     
-
-	-- Miss in the cache!
-	-- Build a completely new Name, and put it in the cache
-	Nothing -> (new_name_supply, name)
-		where
-		  (us', us1)      = splitUniqSupply (nsUniqs name_supply)
-		  uniq   	  = uniqFromSupply us1
-		  name            = mkExternalName uniq mod occ mb_parent loc
-		  new_cache       = extend_name_cache (nsNames name_supply) mod occ name
-		  new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
-
-
-newImplicitBinder :: Name			-- Base name
-	          -> (OccName -> OccName) 	-- Occurrence name modifier
-	          -> TcRnIf m n Name		-- Implicit name
--- Called in BuildTyCl to allocate the implicit binders of type/class decls
--- For source type/class decls, this is the first occurrence
--- For iface ones, the LoadIface has alrady allocated a suitable name in the cache
---
--- An *implicit* name has the base-name as parent
-newImplicitBinder base_name mk_sys_occ
-  = newGlobalBinder (nameModule base_name)
-		    (mk_sys_occ (nameOccName base_name))
-		    (Just parent_name)
-		    (nameSrcLoc base_name)    
-  where
-    parent_name = case nameParent_maybe base_name of
-		    Just parent_name  -> parent_name
-		    Nothing 	      -> base_name
-
-ifaceExportNames :: [IfaceExport] -> TcRnIf gbl lcl NameSet
-ifaceExportNames exports 
-  = foldlM do_one emptyNameSet exports
-  where
-    do_one acc (mod, exports)  = foldlM (do_avail mod) acc exports
-    do_avail mod acc avail = do { ns <- lookupAvail mod avail
-				; return (addListToNameSet acc ns) }
-
-lookupAvail :: Module -> GenAvailInfo OccName -> TcRnIf a b [Name]
--- Find all the names arising from an import
--- Make sure the parent info is correct, even though we may not
--- yet have read the interface for this module
-lookupAvail mod (Avail n) = do { n' <- lookupOrig mod n; 
-			       ; return [n'] }
-lookupAvail mod (AvailTC p_occ occs) 
-  = do { p_name <- lookupOrig mod p_occ
-       ; let lookup_sub occ | occ == p_occ = return p_name
-			    | otherwise	   = lookup_orig mod occ (Just p_name)
-       ; mappM lookup_sub occs }
-	-- Remember that 'occs' is all the exported things, including
-	-- the parent.  It's possible to export just class ops without
-	-- the class, via C( op ). If the class was exported too we'd
-	-- have C( C, op )
-
-	-- The use of lookupOrigSub here (rather than lookupOrig) 
-	-- ensures that the subordinate names record their parent; 
-	-- and that in turn ensures that the GlobalRdrEnv
-	-- has the correct parent for all the names in its range.
-	-- For imported things, we may only suck in the interface later, if ever.
-	-- Reason for all this:
-	--   Suppose module M exports type A.T, and constructor A.MkT
-	--   Then, we know that A.MkT is a subordinate name of A.T,
-	--   even though we aren't at the binding site of A.T
-	--   And it's important, because we may simply re-export A.T
-	--   without ever sucking in the declaration itself.
-
-
-lookupOrig :: Module -> OccName -> TcRnIf a b Name
--- Even if we get a miss in the original-name cache, we 
--- make a new External Name. 
--- We fake up 
--- 	SrcLoc to noSrcLoc
---	Parent no Nothing
--- They'll be overwritten, in due course, by LoadIface.loadDecl.
-lookupOrig mod occ = lookup_orig mod occ Nothing
-
-lookup_orig :: Module -> OccName ->  Maybe Name -> TcRnIf a b Name
--- Used when we know the parent of the thing we are looking up
-lookup_orig mod occ mb_parent
-  = do 	{ 	-- First ensure that mod and occ are evaluated
-		-- If not, chaos can ensue:
-		-- 	we read the name-cache
-		-- 	then pull on mod (say)
-		--	which does some stuff that modifies the name cache
-		-- This did happen, with tycon_mod in TcIface.tcIfaceAlt (DataAlt..)
-	  mod `seq` occ `seq` return ()	
-    
-	; name_supply <- getNameCache
-    	; case lookupOrigNameCache (nsNames name_supply) mod occ of {
-	      Just name -> returnM name ;
-	      Nothing   -> do 
-
-	{ let { (us', us1)      = splitUniqSupply (nsUniqs name_supply)
-	      ;	uniq   	  	= uniqFromSupply us1
-	      ;	name            = mkExternalName uniq mod occ mb_parent noSrcLoc
-	      ;	new_cache       = extend_name_cache (nsNames name_supply) mod occ name
-	      ;	new_name_supply = name_supply {nsUniqs = us', nsNames = new_cache}
-	  }
-	; setNameCache new_name_supply
-	; return name }
-    }}
-
-newIPName :: IPName OccName -> TcRnIf m n (IPName Name)
-newIPName occ_name_ip
-  = getNameCache		`thenM` \ name_supply ->
-    let
-	ipcache = nsIPs name_supply
-    in
-    case lookupFM ipcache key of
-	Just name_ip -> returnM name_ip
-	Nothing      -> setNameCache new_ns 	`thenM_`
-		        returnM name_ip
-		  where
-		     (us', us1)  = splitUniqSupply (nsUniqs name_supply)
-		     uniq   	 = uniqFromSupply us1
-		     name_ip	 = mapIPName (mkIPName uniq) occ_name_ip
-		     new_ipcache = addToFM ipcache key name_ip
-		     new_ns	 = name_supply {nsUniqs = us', nsIPs = new_ipcache}
-    where 
-	key = occ_name_ip	-- Ensures that ?x and %x get distinct Names
-\end{code}
-
-	Local helper functions (not exported)
-
-\begin{code}
-lookupOrigNameCache :: OrigNameCache -> Module -> OccName -> Maybe Name
-lookupOrigNameCache nc mod occ
-  | mod == pREL_TUP || mod == gHC_PRIM,		-- Boxed tuples from one, 
-    Just tup_info <- isTupleOcc_maybe occ	-- unboxed from the other
-  = 	-- Special case for tuples; there are too many
-	-- of them to pre-populate the original-name cache
-    Just (mk_tup_name tup_info)
-  where
-    mk_tup_name (ns, boxity, arity)
-	| ns == tcName   = tyConName (tupleTyCon boxity arity)
-	| ns == dataName = dataConName (tupleCon boxity arity)
-	| otherwise      = varName (dataConWorkId (tupleCon boxity arity))
-
-lookupOrigNameCache nc mod occ	-- The normal case
-  = case lookupModuleEnv nc mod of
-	Nothing      -> Nothing
-	Just occ_env -> lookupOccEnv occ_env occ
-
-extendOrigNameCache :: OrigNameCache -> Name -> OrigNameCache
-extendOrigNameCache nc name 
-  = extend_name_cache nc (nameModule name) (nameOccName name) name
-
-extend_name_cache :: OrigNameCache -> Module -> OccName -> Name -> OrigNameCache
-extend_name_cache nc mod occ name
-  = extendModuleEnv_C combine nc mod (unitOccEnv occ name)
-  where
-    combine occ_env _ = extendOccEnv occ_env occ name
-
-getNameCache :: TcRnIf a b NameCache
-getNameCache = do { HscEnv { hsc_NC = nc_var } <- getTopEnv; 
-		    readMutVar nc_var }
-
-setNameCache :: NameCache -> TcRnIf a b ()
-setNameCache nc = do { HscEnv { hsc_NC = nc_var } <- getTopEnv; 
-		       writeMutVar nc_var nc }
-\end{code}
-
-
-\begin{code}
-initNameCache :: UniqSupply -> [Name] -> NameCache
-initNameCache us names
-  = NameCache { nsUniqs = us,
-		nsNames = initOrigNames names,
-		nsIPs   = emptyFM }
-
-initOrigNames :: [Name] -> OrigNameCache
-initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-		Type variables and local Ids
-%*									*
-%************************************************************************
-
-\begin{code}
-tcIfaceLclId :: OccName -> IfL Id
-tcIfaceLclId occ
-  = do	{ lcl <- getLclEnv
-	; return (lookupOccEnv (if_id_env lcl) occ
-		  `orElse` 
-		  pprPanic "tcIfaceLclId" (ppr occ)) }
-
-refineIfaceIdEnv :: TypeRefinement -> IfL a -> IfL a
-refineIfaceIdEnv (tv_subst, _) thing_inside
-  = do	{ env <- getLclEnv
-	; let { id_env' = mapOccEnv refine_id (if_id_env env)
-	      ;	refine_id id = setIdType id (substTy subst (idType id))
-	      ;	subst = mkOpenTvSubst tv_subst }
-	; setLclEnv (env { if_id_env = id_env' }) thing_inside }
-	
-extendIfaceIdEnv :: [Id] -> IfL a -> IfL a
-extendIfaceIdEnv ids thing_inside
-  = do	{ env <- getLclEnv
-	; let { id_env' = extendOccEnvList (if_id_env env) pairs
-	      ;	pairs   = [(getOccName id, id) | id <- ids] }
-	; setLclEnv (env { if_id_env = id_env' }) thing_inside }
-
-
-tcIfaceTyVar :: OccName -> IfL TyVar
-tcIfaceTyVar occ
-  = do	{ lcl <- getLclEnv
-	; return (lookupOccEnv (if_tv_env lcl) occ
-		  `orElse`
-		  pprPanic "tcIfaceTyVar" (ppr occ)) }
-
-extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a
-extendIfaceTyVarEnv tyvars thing_inside
-  = do	{ env <- getLclEnv
-	; let { tv_env' = extendOccEnvList (if_tv_env env) pairs
-	      ;	pairs   = [(getOccName tv, tv) | tv <- tyvars] }
-	; setLclEnv (env { if_tv_env = tv_env' }) thing_inside }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Getting from RdrNames to Names
-%*									*
-%************************************************************************
-
-\begin{code}
-lookupIfaceTc :: IfaceTyCon -> IfL Name
-lookupIfaceTc (IfaceTc ext) = lookupIfaceExt ext
-lookupIfaceTc other_tc	    = return (ifaceTyConName other_tc)
-
-lookupIfaceExt :: IfaceExtName -> IfL Name
-lookupIfaceExt (ExtPkg  mod occ)   = lookupOrig mod occ
-lookupIfaceExt (HomePkg mod occ _) = lookupOrig mod occ
-lookupIfaceExt (LocalTop occ)	   = lookupIfaceTop occ
-lookupIfaceExt (LocalTopSub occ _) = lookupIfaceTop occ
-
-lookupIfaceTop :: OccName -> IfL Name
--- Look up a top-level name from the current Iface module
-lookupIfaceTop occ
-  = do	{ env <- getLclEnv; lookupOrig (if_mod env) occ }
-
-newIfaceName :: OccName -> IfL Name
-newIfaceName occ
-  = do	{ uniq <- newUnique
-	; return (mkInternalName uniq occ noSrcLoc) }
-
-newIfaceNames :: [OccName] -> IfL [Name]
-newIfaceNames occs
-  = do	{ uniqs <- newUniqueSupply
-	; return [ mkInternalName uniq occ noSrcLoc
-		 | (occ,uniq) <- occs `zip` uniqsFromSupply uniqs] }
-\end{code}
diff --git a/ghc/compiler/iface/IfaceSyn.lhs b/ghc/compiler/iface/IfaceSyn.lhs
deleted file mode 100644
index 99501a5b68..0000000000
--- a/ghc/compiler/iface/IfaceSyn.lhs
+++ /dev/null
@@ -1,998 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-%************************************************************************
-%*									*
-\section[HsCore]{Core-syntax unfoldings in Haskell interface files}
-%*									*
-%************************************************************************
-
-We could either use this, or parameterise @GenCoreExpr@ on @Types@ and
-@TyVars@ as well.  Currently trying the former... MEGA SIGH.
-
-\begin{code}
-module IfaceSyn (
-	module IfaceType,		-- Re-export all this
-
-	IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
-	IfaceExpr(..), IfaceAlt, IfaceNote(..),
-	IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..),
-	IfaceInfoItem(..), IfaceRule(..), IfaceInst(..), 
-
-	-- Misc
-	visibleIfConDecls,
-
-	-- Converting things to IfaceSyn
-	tyThingToIfaceDecl, instanceToIfaceInst, coreRuleToIfaceRule, 
-
-	-- Equality
-	IfaceEq(..), (&&&), bool, eqListBy, eqMaybeBy,
-	eqIfDecl, eqIfInst, eqIfRule, 
-	
-	-- Pretty printing
-	pprIfaceExpr, pprIfaceDecl, pprIfaceDeclHead 
-    ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-import IfaceType
-
-import FunDeps		( pprFundeps )
-import NewDemand	( StrictSig, pprIfaceStrictSig )
-import TcType		( deNoteType )
-import Type		( TyThing(..), splitForAllTys, funResultTy )
-import InstEnv		( Instance(..), OverlapFlag )
-import Id		( Id, idName, idType, idInfo, idArity, isDataConWorkId_maybe, isFCallId_maybe )
-import NewDemand	( isTopSig )
-import IdInfo		( IdInfo, CafInfo(..), WorkerInfo(..), 
-			  arityInfo, cafInfo, newStrictnessInfo, 
-			  workerInfo, unfoldingInfo, inlinePragInfo )
-import TyCon		( TyCon, ArgVrcs, AlgTyConRhs(..), isRecursiveTyCon, isForeignTyCon,
-			  isSynTyCon, isAlgTyCon, isPrimTyCon, isFunTyCon,
-			  isTupleTyCon, tupleTyConBoxity, tyConStupidTheta,
-			  tyConHasGenerics, tyConArgVrcs, synTyConRhs,
-			  tyConArity, tyConTyVars, algTyConRhs, tyConExtName  )
-import DataCon		( dataConName, dataConSig, dataConFieldLabels, dataConStrictMarks,
-			  dataConTyCon, dataConIsInfix, isVanillaDataCon )
-import Class		( FunDep, DefMeth, classExtraBigSig, classTyCon )
-import OccName		( OccName, OccEnv, emptyOccEnv, 
-			  lookupOccEnv, extendOccEnv, parenSymOcc,
-			  OccSet, unionOccSets, unitOccSet )
-import Name		( Name, NamedThing(..), nameOccName, isExternalName )
-import CostCentre	( CostCentre, pprCostCentreCore )
-import Literal		( Literal )
-import ForeignCall	( ForeignCall )
-import TysPrim		( alphaTyVars )
-import BasicTypes	( Arity, Activation(..), StrictnessMark, 
-			  RecFlag(..), boolToRecFlag, Boxity(..), 
-			  tupleParens )
-import Outputable
-import FastString
-import Maybes		( catMaybes )
-import Util		( lengthIs )
-
-infixl 3 &&&
-infix  4 `eqIfExt`, `eqIfIdInfo`, `eqIfType`
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Data type declarations
-%*									*
-%************************************************************************
-
-\begin{code}
-data IfaceDecl 
-  = IfaceId { ifName   :: OccName,
-	      ifType   :: IfaceType, 
-	      ifIdInfo :: IfaceIdInfo }
-
-  | IfaceData { ifName     :: OccName,		-- Type constructor
-		ifTyVars   :: [IfaceTvBndr],	-- Type variables
-		ifCtxt	   :: IfaceContext,	-- The "stupid theta"
-		ifCons	   :: IfaceConDecls,	-- Includes new/data info
-	        ifRec	   :: RecFlag,		-- Recursive or not?
-		ifVrcs     :: ArgVrcs,
-		ifGeneric  :: Bool		-- True <=> generic converter functions available
-    }						-- We need this for imported data decls, since the
-						-- imported modules may have been compiled with
-						-- different flags to the current compilation unit
-
-  | IfaceSyn  {	ifName   :: OccName,		-- Type constructor
-		ifTyVars :: [IfaceTvBndr],	-- Type variables
-		ifVrcs   :: ArgVrcs,
-		ifSynRhs :: IfaceType		-- synonym expansion
-    }
-
-  | IfaceClass { ifCtxt    :: IfaceContext, 	-- Context...
-		 ifName    :: OccName,		-- Name of the class
-		 ifTyVars  :: [IfaceTvBndr],	-- Type variables
-		 ifFDs     :: [FunDep OccName],	-- Functional dependencies
-		 ifSigs    :: [IfaceClassOp],	-- Method signatures
-	         ifRec	   :: RecFlag,		-- Is newtype/datatype associated with the class recursive?
-		 ifVrcs    :: ArgVrcs		-- ... and what are its argument variances ...
-    }
-
-  | IfaceForeign { ifName :: OccName,		-- Needs expanding when we move beyond .NET
-		   ifExtName :: Maybe FastString }
-
-data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
-	-- Nothing    => no default method
-	-- Just False => ordinary polymorphic default method
-	-- Just True  => generic default method
-
-data IfaceConDecls
-  = IfAbstractTyCon		-- No info
-  | IfDataTyCon [IfaceConDecl]	-- data type decls
-  | IfNewTyCon  IfaceConDecl	-- newtype decls
-
-visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
-visibleIfConDecls IfAbstractTyCon  = []
-visibleIfConDecls (IfDataTyCon cs) = cs
-visibleIfConDecls (IfNewTyCon c)   = [c]
-
-data IfaceConDecl 
-  = IfVanillaCon {
-	ifConOcc     :: OccName,		-- Constructor name
-	ifConInfix   :: Bool,			-- True <=> declared infix
-	ifConArgTys  :: [IfaceType],		-- Arg types
-	ifConStricts :: [StrictnessMark],	-- Empty (meaning all lazy), or 1-1 corresp with arg types
-	ifConFields  :: [OccName] }		-- ...ditto... (field labels)
-  | IfGadtCon {
-	ifConOcc     :: OccName,		-- Constructor name
-	ifConTyVars  :: [IfaceTvBndr],		-- All tyvars
-	ifConCtxt    :: IfaceContext,		-- Non-stupid context
-	ifConArgTys  :: [IfaceType],		-- Arg types
-	ifConResTys  :: [IfaceType],		-- Result type args
-	ifConStricts :: [StrictnessMark] }	-- Empty (meaning all lazy), or 1-1 corresp with arg types
-			
-data IfaceInst 
-  = IfaceInst { ifInstCls  :: IfaceExtName,		-- See comments with
-		ifInstTys  :: [Maybe IfaceTyCon],	-- the defn of Instance
-		ifDFun     :: OccName, 			-- The dfun
-		ifOFlag    :: OverlapFlag,		-- Overlap flag
-		ifInstOrph :: Maybe OccName }		-- See is_orph in defn of Instance
-	-- There's always a separate IfaceDecl for the DFun, which gives 
-	-- its IdInfo with its full type and version number.
-	-- The instance declarations taken together have a version number,
-	-- and we don't want that to wobble gratuitously
-	-- If this instance decl is *used*, we'll record a usage on the dfun;
-	-- and if the head does not change it won't be used if it wasn't before
-
-data IfaceRule
-  = IfaceRule { 
-	ifRuleName   :: RuleName,
-	ifActivation :: Activation,
-	ifRuleBndrs  :: [IfaceBndr],	-- Tyvars and term vars
-	ifRuleHead   :: IfaceExtName,	-- Head of lhs
-	ifRuleArgs   :: [IfaceExpr],	-- Args of LHS
-	ifRuleRhs    :: IfaceExpr,
-	ifRuleOrph   :: Maybe OccName	-- Just like IfaceInst
-    }
-
-data IfaceIdInfo
-  = NoInfo			-- When writing interface file without -O
-  | HasInfo [IfaceInfoItem]	-- Has info, and here it is
-
--- Here's a tricky case:
---   * Compile with -O module A, and B which imports A.f
---   * Change function f in A, and recompile without -O
---   * When we read in old A.hi we read in its IdInfo (as a thunk)
---	(In earlier GHCs we used to drop IdInfo immediately on reading,
---	 but we do not do that now.  Instead it's discarded when the
---	 ModIface is read into the various decl pools.)
---   * The version comparsion sees that new (=NoInfo) differs from old (=HasInfo *)
---	and so gives a new version.
-
-data IfaceInfoItem
-  = HsArity	 Arity
-  | HsStrictness StrictSig
-  | HsUnfold	 Activation IfaceExpr
-  | HsNoCafRefs
-  | HsWorker	 IfaceExtName Arity	-- Worker, if any see IdInfo.WorkerInfo
-					-- for why we want arity here.
-	-- NB: we need IfaceExtName (not just OccName) because the worker
-	--     can simplify to a function in another module.
--- NB: Specialisations and rules come in separately and are
--- only later attached to the Id.  Partial reason: some are orphans.
-
---------------------------------
-data IfaceExpr
-  = IfaceLcl 	OccName
-  | IfaceExt    IfaceExtName
-  | IfaceType   IfaceType
-  | IfaceTuple 	Boxity [IfaceExpr]		-- Saturated; type arguments omitted
-  | IfaceLam 	IfaceBndr IfaceExpr
-  | IfaceApp 	IfaceExpr IfaceExpr
-  | IfaceCase	IfaceExpr OccName IfaceType [IfaceAlt]
-  | IfaceLet	IfaceBinding  IfaceExpr
-  | IfaceNote	IfaceNote IfaceExpr
-  | IfaceLit	Literal
-  | IfaceFCall	ForeignCall IfaceType
-
-data IfaceNote = IfaceSCC CostCentre
-	       | IfaceCoerce IfaceType
-	       | IfaceInlineCall
-	       | IfaceInlineMe
-               | IfaceCoreNote String
-
-type IfaceAlt = (IfaceConAlt, [OccName], IfaceExpr)
-	-- Note: OccName, not IfaceBndr (and same with the case binder)
-	-- We reconstruct the kind/type of the thing from the context
-	-- thus saving bulk in interface files
-
-data IfaceConAlt = IfaceDefault
- 		 | IfaceDataAlt OccName
-		 | IfaceTupleAlt Boxity
-		 | IfaceLitAlt Literal
-
-data IfaceBinding
-  = IfaceNonRec	IfaceIdBndr IfaceExpr
-  | IfaceRec 	[(IfaceIdBndr, IfaceExpr)]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[HsCore-print]{Printing Core unfoldings}
-%*									*
-%************************************************************************
-
------------------------------ Printing IfaceDecl ------------------------------------
-
-\begin{code}
-instance Outputable IfaceDecl where
-  ppr = pprIfaceDecl
-
-pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
-  = sep [ ppr var <+> dcolon <+> ppr ty, 
-	  nest 2 (ppr info) ]
-
-pprIfaceDecl (IfaceForeign {ifName = tycon})
-  = hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
-
-pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, ifSynRhs = mono_ty, ifVrcs = vrcs})
-  = hang (ptext SLIT("type") <+> pprIfaceDeclHead [] tycon tyvars)
-       4 (vcat [equals <+> ppr mono_ty,
-		pprVrcs vrcs])
-
-pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
-			 ifTyVars = tyvars, ifCons = condecls, 
-			 ifRec = isrec, ifVrcs = vrcs})
-  = hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
-       4 (vcat [pprVrcs vrcs, pprRec isrec, pprGen gen, pp_condecls tycon condecls])
-  where
-    pp_nd = case condecls of
-		IfAbstractTyCon -> ptext SLIT("data")
-		IfDataTyCon _   -> ptext SLIT("data")
-		IfNewTyCon _  	-> ptext SLIT("newtype")
-
-pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars, 
-			  ifFDs = fds, ifSigs = sigs, ifVrcs = vrcs, ifRec = isrec})
-  = hang (ptext SLIT("class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
-       4 (vcat [pprVrcs vrcs, 
-		pprRec isrec,
-	        sep (map ppr sigs)])
-
-pprVrcs vrcs = ptext SLIT("Variances") <+> ppr vrcs
-pprRec isrec = ptext SLIT("RecFlag") <+> ppr isrec
-pprGen True  = ptext SLIT("Generics: yes")
-pprGen False = ptext SLIT("Generics: no")
-
-instance Outputable IfaceClassOp where
-   ppr (IfaceClassOp n dm ty) = ppr n <+> ppr dm <+> dcolon <+> ppr ty
-
-pprIfaceDeclHead :: IfaceContext -> OccName -> [IfaceTvBndr] -> SDoc
-pprIfaceDeclHead context thing tyvars 
-  = hsep [pprIfaceContext context, parenSymOcc thing (ppr thing), pprIfaceTvBndrs tyvars]
-
-pp_condecls tc IfAbstractTyCon  = ptext SLIT("{- abstract -}")
-pp_condecls tc (IfNewTyCon c)   = equals <+> pprIfaceConDecl tc c
-pp_condecls tc (IfDataTyCon cs) = equals <+> sep (punctuate (ptext SLIT(" |"))
-						     (map (pprIfaceConDecl tc) cs))
-
-pprIfaceConDecl tc (IfVanillaCon { 
-		      ifConOcc = name, ifConInfix = is_infix, 
-		      ifConArgTys = arg_tys, 
-		      ifConStricts = strs, ifConFields = fields })
-    = sep [ppr name <+> sep (map pprParendIfaceType arg_tys),
-	   if is_infix then ptext SLIT("Infix") else empty,
-	   if null strs then empty 
-	      else nest 4 (ptext SLIT("Stricts:") <+> hsep (map ppr strs)),
-	   if null fields then empty
-	      else nest 4 (ptext SLIT("Fields:") <+> hsep (map ppr fields))]
-
-pprIfaceConDecl tc (IfGadtCon { 
-		      ifConOcc = name, 
-		      ifConTyVars = tvs, ifConCtxt = ctxt,
-		      ifConArgTys = arg_tys, ifConResTys = res_tys, 
-		      ifConStricts = strs })
-    = sep [ppr name <+> dcolon <+> pprIfaceForAllPart tvs ctxt (ppr con_tau),
-	   if null strs then empty 
-	      else nest 4 (ptext SLIT("Stricts:") <+> hsep (map ppr strs))]
-    where
-      con_tau = foldr1 IfaceFunTy (arg_tys ++ [tc_app])
-      tc_app  = IfaceTyConApp (IfaceTc (LocalTop tc)) res_tys	
-	-- Gruesome, but jsut for debug print
-
-instance Outputable IfaceRule where
-  ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
-		   ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs }) 
-    = sep [hsep [doubleQuotes (ftext name), ppr act,
-		 ptext SLIT("forall") <+> pprIfaceBndrs bndrs],
-	   nest 2 (sep [ppr fn <+> sep (map (pprIfaceExpr parens) args),
-		        ptext SLIT("=") <+> ppr rhs])
-      ]
-
-instance Outputable IfaceInst where
-  ppr (IfaceInst {ifDFun = dfun_id, ifOFlag = flag, 
-		  ifInstCls = cls, ifInstTys = mb_tcs})
-    = hang (ptext SLIT("instance") <+> ppr flag 
-		<+> ppr cls <+> brackets (pprWithCommas ppr_mb mb_tcs))
-         2 (equals <+> ppr dfun_id)
-    where
-      ppr_mb Nothing   = dot
-      ppr_mb (Just tc) = ppr tc
-\end{code}
-
-
------------------------------ Printing IfaceExpr ------------------------------------
-
-\begin{code}
-instance Outputable IfaceExpr where
-    ppr e = pprIfaceExpr noParens e
-
-pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
-	-- The function adds parens in context that need
-	-- an atomic value (e.g. function args)
-
-pprIfaceExpr add_par (IfaceLcl v)       = ppr v
-pprIfaceExpr add_par (IfaceExt v)       = ppr v
-pprIfaceExpr add_par (IfaceLit l)       = ppr l
-pprIfaceExpr add_par (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
-pprIfaceExpr add_par (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
-
-pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
-pprIfaceExpr add_par (IfaceTuple c as)  = tupleParens c (interpp'SP as)
-
-pprIfaceExpr add_par e@(IfaceLam _ _)   
-  = add_par (sep [char '\\' <+> sep (map ppr bndrs) <+> arrow,
-		  pprIfaceExpr noParens body])
-  where 
-    (bndrs,body) = collect [] e
-    collect bs (IfaceLam b e) = collect (b:bs) e
-    collect bs e              = (reverse bs, e)
-
--- gaw 2004 
-pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
--- gaw 2004
-  = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty <+> pprIfaceExpr noParens scrut <+> ptext SLIT("of") 
-			<+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
-  		  pprIfaceExpr noParens rhs <+> char '}'])
-
--- gaw 2004
-pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
--- gaw 2004
-  = add_par (sep [ptext SLIT("case") <+> char '@' <+> pprParendIfaceType ty <+> pprIfaceExpr noParens scrut <+> ptext SLIT("of") 
-			<+> ppr bndr <+> char '{',
-  		  nest 2 (sep (map ppr_alt alts)) <+> char '}'])
-
-pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
-  = add_par (sep [ptext SLIT("let {"), 
-		  nest 2 (ppr_bind (b, rhs)),
-		  ptext SLIT("} in"), 
-		  pprIfaceExpr noParens body])
-
-pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
-  = add_par (sep [ptext SLIT("letrec {"),
-		  nest 2 (sep (map ppr_bind pairs)), 
-		  ptext SLIT("} in"),
-		  pprIfaceExpr noParens body])
-
-pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprIfaceExpr parens body)
-
-ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs, 
-			      arrow <+> pprIfaceExpr noParens rhs]
-
-ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
-ppr_con_bs con bs		      = ppr con <+> hsep (map ppr bs)
-  
-ppr_bind ((b,ty),rhs) = sep [ppr b <+> dcolon <+> ppr ty, 
-			     equals <+> pprIfaceExpr noParens rhs]
-
-------------------
-pprIfaceApp (IfaceApp fun arg) args = pprIfaceApp fun (nest 2 (pprIfaceExpr parens arg) : args)
-pprIfaceApp fun	 	       args = sep (pprIfaceExpr parens fun : args)
-
-------------------
-instance Outputable IfaceNote where
-    ppr (IfaceSCC cc)     = pprCostCentreCore cc
-    ppr (IfaceCoerce ty)  = ptext SLIT("__coerce") <+> pprParendIfaceType ty
-    ppr IfaceInlineCall   = ptext SLIT("__inline_call")
-    ppr IfaceInlineMe     = ptext SLIT("__inline_me")
-    ppr (IfaceCoreNote s) = ptext SLIT("__core_note") <+> pprHsString (mkFastString s)
-
-instance Outputable IfaceConAlt where
-    ppr IfaceDefault	  = text "DEFAULT"
-    ppr (IfaceLitAlt l)   = ppr l
-    ppr (IfaceDataAlt d)  = ppr d
-    ppr (IfaceTupleAlt b) = panic "ppr IfaceConAlt" 
-	-- IfaceTupleAlt is handled by the case-alternative printer
-
-------------------
-instance Outputable IfaceIdInfo where
-   ppr NoInfo       = empty
-   ppr (HasInfo is) = ptext SLIT("{-") <+> fsep (map ppr_hs_info is) <+> ptext SLIT("-}")
-
-ppr_hs_info (HsUnfold prag unf) = sep [ptext SLIT("Unfolding: ") <> ppr prag,
-				       parens (pprIfaceExpr noParens unf)]
-ppr_hs_info (HsArity arity)     = ptext SLIT("Arity:") <+> int arity
-ppr_hs_info (HsStrictness str)  = ptext SLIT("Strictness:") <+> pprIfaceStrictSig str
-ppr_hs_info HsNoCafRefs		= ptext SLIT("HasNoCafRefs")
-ppr_hs_info (HsWorker w a)	= ptext SLIT("Worker:") <+> ppr w <+> int a
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Converting things to their Iface equivalents
-%*									*
-%************************************************************************
-
-		 
-\begin{code}
-tyThingToIfaceDecl :: (Name -> IfaceExtName) -> TyThing -> IfaceDecl
--- Assumption: the thing is already tidied, so that locally-bound names
--- 	       (lambdas, for-alls) already have non-clashing OccNames
--- Reason: Iface stuff uses OccNames, and the conversion here does
---	   not do tidying on the way
-tyThingToIfaceDecl ext (AnId id)
-  = IfaceId { ifName   = getOccName id, 
-	      ifType   = toIfaceType ext (idType id),
-	      ifIdInfo = info }
-  where
-    info = case toIfaceIdInfo ext (idInfo id) of
-		[]    -> NoInfo
-		items -> HasInfo items
-
-tyThingToIfaceDecl ext (AClass clas)
-  = IfaceClass { ifCtxt	  = toIfaceContext ext sc_theta,
-		 ifName	  = getOccName clas,
-		 ifTyVars = toIfaceTvBndrs clas_tyvars,
-		 ifFDs    = map toIfaceFD clas_fds,
-		 ifSigs	  = map toIfaceClassOp op_stuff,
-	  	 ifRec    = boolToRecFlag (isRecursiveTyCon tycon),
-		 ifVrcs   = tyConArgVrcs tycon }
-  where
-    (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
-    tycon = classTyCon clas
-
-    toIfaceClassOp (sel_id, def_meth)
-	= ASSERT(sel_tyvars == clas_tyvars)
-	  IfaceClassOp (getOccName sel_id) def_meth (toIfaceType ext op_ty)
-	where
-		-- Be careful when splitting the type, because of things
-		-- like  	class Foo a where
-		--		  op :: (?x :: String) => a -> a
-		-- and  	class Baz a where
-		--		  op :: (Ord a) => a -> a
-	  (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
-	  op_ty		       = funResultTy rho_ty
-
-    toIfaceFD (tvs1, tvs2) = (map getOccName tvs1, map getOccName tvs2)
-
-tyThingToIfaceDecl ext (ATyCon tycon)
-  | isSynTyCon tycon
-  = IfaceSyn {	ifName   = getOccName tycon,
-		ifTyVars = toIfaceTvBndrs tyvars,
-		ifVrcs    = tyConArgVrcs tycon,
-		ifSynRhs = toIfaceType ext syn_ty }
-
-  | isAlgTyCon tycon
-  = IfaceData {	ifName    = getOccName tycon,
-		ifTyVars  = toIfaceTvBndrs tyvars,
-		ifCtxt    = toIfaceContext ext (tyConStupidTheta tycon),
-		ifCons    = ifaceConDecls (algTyConRhs tycon),
-	  	ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
-		ifVrcs    = tyConArgVrcs tycon,
-		ifGeneric = tyConHasGenerics tycon }
-
-  | isForeignTyCon tycon
-  = IfaceForeign { ifName    = getOccName tycon,
-	    	   ifExtName = tyConExtName tycon }
-
-  | isPrimTyCon tycon || isFunTyCon tycon
-	-- Needed in GHCi for ':info Int#', for example
-  = IfaceData { ifName    = getOccName tycon,
-	  	ifTyVars  = toIfaceTvBndrs (take (tyConArity tycon) alphaTyVars),
-		ifCtxt	  = [],
-		ifCons    = IfAbstractTyCon,
-		ifGeneric = False,
-		ifRec     = NonRecursive,
-		ifVrcs    = tyConArgVrcs tycon }
-
-  | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
-  where
-    tyvars = tyConTyVars tycon
-    syn_ty = synTyConRhs tycon
-
-    ifaceConDecls (NewTyCon { data_con = con })    = IfNewTyCon  (ifaceConDecl con)
-    ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
-    ifaceConDecls AbstractTyCon			   = IfAbstractTyCon
-	-- The last case happens when a TyCon has been trimmed during tidying
-	-- Furthermore, tyThingToIfaceDecl is also used
-	-- in TcRnDriver for GHCi, when browsing a module, in which case the
-	-- AbstractTyCon case is perfectly sensible.
-
-    ifaceConDecl data_con 
-	| isVanillaDataCon data_con
-	= IfVanillaCon {ifConOcc = getOccName (dataConName data_con),
-			ifConInfix = dataConIsInfix data_con,
-			ifConArgTys = map (toIfaceType ext) arg_tys,
-			ifConStricts = strict_marks,
-			ifConFields = map getOccName field_labels }
-	| otherwise
-	= IfGadtCon   { ifConOcc = getOccName (dataConName data_con),
-			ifConTyVars = toIfaceTvBndrs tyvars,
-			ifConCtxt = toIfaceContext ext theta,
-			ifConArgTys = map (toIfaceType ext) arg_tys,
-			ifConResTys = map (toIfaceType ext) res_tys,
-			ifConStricts = strict_marks }
-	where
-	  (tyvars, theta, arg_tys, _, res_tys) = dataConSig data_con
-          field_labels = dataConFieldLabels data_con
-          strict_marks = dataConStrictMarks data_con
-
-tyThingToIfaceDecl ext (ADataCon dc)
- = pprPanic "toIfaceDecl" (ppr dc)	-- Should be trimmed out earlier
-
-
---------------------------
-instanceToIfaceInst :: (Name -> IfaceExtName) -> Instance -> IfaceInst
-instanceToIfaceInst ext_lhs ispec@(Instance { is_dfun = dfun_id, is_flag = oflag,
-					      is_cls = cls, is_tcs = mb_tcs, 
-					      is_orph = orph })
-  = IfaceInst { ifDFun    = getOccName dfun_id, 
-		ifOFlag   = oflag,
-		ifInstCls = ext_lhs cls,
-		ifInstTys = map do_rough mb_tcs,
-		ifInstOrph = orph }
-  where
-    do_rough Nothing  = Nothing
-    do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
-
---------------------------
-toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
-toIfaceIdInfo ext id_info
-  = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, 
-	       wrkr_hsinfo,  unfold_hsinfo] 
-  where
-    ------------  Arity  --------------
-    arity_info = arityInfo id_info
-    arity_hsinfo | arity_info == 0 = Nothing
-		 | otherwise       = Just (HsArity arity_info)
-
-    ------------ Caf Info --------------
-    caf_info   = cafInfo id_info
-    caf_hsinfo = case caf_info of
-		   NoCafRefs -> Just HsNoCafRefs
-		   _other    -> Nothing
-
-    ------------  Strictness  --------------
-	-- No point in explicitly exporting TopSig
-    strict_hsinfo = case newStrictnessInfo id_info of
-			Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
-			_other			      -> Nothing
-
-    ------------  Worker  --------------
-    work_info   = workerInfo id_info
-    has_worker  = case work_info of { HasWorker _ _ -> True; other -> False }
-    wrkr_hsinfo = case work_info of
-		    HasWorker work_id wrap_arity -> 
-			Just (HsWorker (ext (idName work_id)) wrap_arity)
-		    NoWorker -> Nothing
-
-    ------------  Unfolding  --------------
-    -- The unfolding is redundant if there is a worker
-    unfold_info = unfoldingInfo id_info
-    inline_prag = inlinePragInfo id_info
-    rhs		= unfoldingTemplate unfold_info
-    unfold_hsinfo |  neverUnfold unfold_info 
-		  || has_worker = Nothing
-		  | otherwise	= Just (HsUnfold inline_prag (toIfaceExpr ext rhs))
-
---------------------------
-coreRuleToIfaceRule :: (Name -> IfaceExtName) 	-- For the LHS names
-		    -> (Name -> IfaceExtName) 	-- For the RHS names
-		    -> CoreRule -> IfaceRule
-coreRuleToIfaceRule ext_lhs ext_rhs (BuiltinRule { ru_fn = fn})
-  = pprTrace "toHsRule: builtin" (ppr fn) $
-    bogusIfaceRule (mkIfaceExtName fn)
-
-coreRuleToIfaceRule ext_lhs ext_rhs
-    (Rule { ru_name = name, ru_fn = fn, ru_act = act, ru_bndrs = bndrs,
-	    ru_args = args, ru_rhs = rhs, ru_orph = orph })
-  = IfaceRule { ifRuleName  = name, ifActivation = act, 
-		ifRuleBndrs = map (toIfaceBndr ext_lhs) bndrs,
-		ifRuleHead  = ext_lhs fn, 
-		ifRuleArgs  = map do_arg args,
-		ifRuleRhs   = toIfaceExpr ext_rhs rhs,
-		ifRuleOrph  = orph }
-  where
-	-- For type args we must remove synonyms from the outermost
-	-- level.  Reason: so that when we read it back in we'll
-	-- construct the same ru_rough field as we have right now;
-	-- see tcIfaceRule
-    do_arg (Type ty) = IfaceType (toIfaceType ext_lhs (deNoteType ty))
-    do_arg arg       = toIfaceExpr ext_lhs arg
-
-bogusIfaceRule :: IfaceExtName -> IfaceRule
-bogusIfaceRule id_name
-  = IfaceRule { ifRuleName = FSLIT("bogus"), ifActivation = NeverActive,  
-	ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [], 
-	ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
-
----------------------
-toIfaceExpr :: (Name -> IfaceExtName) -> CoreExpr -> IfaceExpr
-toIfaceExpr ext (Var v)       = toIfaceVar ext v
-toIfaceExpr ext (Lit l)       = IfaceLit l
-toIfaceExpr ext (Type ty)     = IfaceType (toIfaceType ext ty)
-toIfaceExpr ext (Lam x b)     = IfaceLam (toIfaceBndr ext x) (toIfaceExpr ext b)
-toIfaceExpr ext (App f a)     = toIfaceApp ext f [a]
--- gaw 2004
-toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (getOccName x) (toIfaceType ext ty) (map (toIfaceAlt ext) as)
-toIfaceExpr ext (Let b e)     = IfaceLet (toIfaceBind ext b) (toIfaceExpr ext e)
-toIfaceExpr ext (Note n e)    = IfaceNote (toIfaceNote ext n) (toIfaceExpr ext e)
-
----------------------
-toIfaceNote ext (SCC cc)      = IfaceSCC cc
-toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
-toIfaceNote ext InlineCall    = IfaceInlineCall
-toIfaceNote ext InlineMe      = IfaceInlineMe
-toIfaceNote ext (CoreNote s)  = IfaceCoreNote s
-
----------------------
-toIfaceBind ext (NonRec b r) = IfaceNonRec (toIfaceIdBndr ext b) (toIfaceExpr ext r)
-toIfaceBind ext (Rec prs)    = IfaceRec [(toIfaceIdBndr ext b, toIfaceExpr ext r) | (b,r) <- prs]
-
----------------------
-toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map getOccName bs, toIfaceExpr ext r)
-
----------------------
-toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
-	   		| otherwise       = IfaceDataAlt (getOccName dc)
-	   		where
-	   		  tc = dataConTyCon dc
-	   
-toIfaceCon (LitAlt l) = IfaceLitAlt l
-toIfaceCon DEFAULT    = IfaceDefault
-
----------------------
-toIfaceApp ext (App f a) as = toIfaceApp ext f (a:as)
-toIfaceApp ext (Var v) as
-  = case isDataConWorkId_maybe v of
-	-- We convert the *worker* for tuples into IfaceTuples
-	Just dc |  isTupleTyCon tc && saturated 
-		-> IfaceTuple (tupleTyConBoxity tc) tup_args
-	  where
-	    val_args  = dropWhile isTypeArg as
-	    saturated = val_args `lengthIs` idArity v
-	    tup_args  = map (toIfaceExpr ext) val_args
-	    tc	      = dataConTyCon dc
-
-        other -> mkIfaceApps ext (toIfaceVar ext v) as
-
-toIfaceApp ext e as = mkIfaceApps ext (toIfaceExpr ext e) as
-
-mkIfaceApps ext f as = foldl (\f a -> IfaceApp f (toIfaceExpr ext a)) f as
-
----------------------
-toIfaceVar :: (Name -> IfaceExtName) -> Id -> IfaceExpr
-toIfaceVar ext v 
-  | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType ext (idType v))
-	  -- Foreign calls have special syntax
-  | isExternalName name		    = IfaceExt (ext name)
-  | otherwise			    = IfaceLcl (nameOccName name)
-  where
-    name = idName v
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Equality, for interface file version generaion only
-%*									*
-%************************************************************************
-
-Equality over IfaceSyn returns an IfaceEq, not a Bool.  The new constructor is
-EqBut, which gives the set of *locally-defined* things whose version must be equal
-for the whole thing to be equal.  So the key function is eqIfExt, which compares
-IfaceExtNames.
-
-Of course, equality is also done modulo alpha conversion.
-
-\begin{code}
-data IfaceEq 
-  = Equal 		-- Definitely exactly the same
-  | NotEqual		-- Definitely different
-  | EqBut OccSet	-- The same provided these local things have not changed
-
-bool :: Bool -> IfaceEq
-bool True  = Equal
-bool False = NotEqual
-
-zapEq :: IfaceEq -> IfaceEq	-- Used to forget EqBut information
-zapEq (EqBut _) = Equal
-zapEq other	= other
-
-(&&&) :: IfaceEq -> IfaceEq -> IfaceEq
-Equal       &&& x 	    = x
-NotEqual    &&& x	    = NotEqual
-EqBut occs  &&& Equal       = EqBut occs
-EqBut occs  &&& NotEqual    = NotEqual
-EqBut occs1 &&& EqBut occs2 = EqBut (occs1 `unionOccSets` occs2)
-
----------------------
-eqIfExt :: IfaceExtName -> IfaceExtName -> IfaceEq
--- This function is the core of the EqBut stuff
-eqIfExt (ExtPkg mod1 occ1)     (ExtPkg mod2 occ2)     = bool (mod1==mod2 && occ1==occ2)
-eqIfExt (HomePkg mod1 occ1 v1) (HomePkg mod2 occ2 v2) = bool (mod1==mod2 && occ1==occ2 && v1==v2)
-eqIfExt (LocalTop occ1)       (LocalTop occ2)      | occ1 == occ2 = EqBut (unitOccSet occ1)
-eqIfExt (LocalTopSub occ1 p1) (LocalTop occ2)      | occ1 == occ2 = EqBut (unitOccSet p1)
-eqIfExt (LocalTopSub occ1 p1) (LocalTopSub occ2 _) | occ1 == occ2 = EqBut (unitOccSet p1)
-eqIfExt n1 n2 = NotEqual
-\end{code}
-
-
-\begin{code}
----------------------
-eqIfDecl :: IfaceDecl -> IfaceDecl -> IfaceEq
-eqIfDecl (IfaceId s1 t1 i1) (IfaceId s2 t2 i2)
-  = bool (s1 == s2) &&& (t1 `eqIfType` t2) &&& (i1 `eqIfIdInfo` i2)
-
-eqIfDecl d1@(IfaceForeign {}) d2@(IfaceForeign {})
-  = bool (ifName d1 == ifName d2 && ifExtName d1 == ifExtName d2)
-
-eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
-  = bool (ifName d1    == ifName d2 && 
-	  ifRec d1     == ifRec   d2 && 
-	  ifVrcs d1    == ifVrcs   d2 && 
-	  ifGeneric d1 == ifGeneric d2) &&&
-    eqWith (ifTyVars d1) (ifTyVars d2) (\ env -> 
-	    eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&& 
-    	    eq_hsCD env (ifCons d1) (ifCons d2) 
-	)
-	-- The type variables of the data type do not scope
-	-- over the constructors (any more), but they do scope
-	-- over the stupid context in the IfaceConDecls
-
-eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
-  = bool (ifName d1 == ifName d2) &&&
-    eqWith (ifTyVars d1) (ifTyVars d2) (\ env -> 
-          eq_ifType env (ifSynRhs d1) (ifSynRhs d2)
-        )
-
-eqIfDecl d1@(IfaceClass {}) d2@(IfaceClass {})
-  = bool (ifName d1 == ifName d2 && 
-	  ifRec d1  == ifRec  d2 && 
-	  ifVrcs d1 == ifVrcs d2) &&&
-    eqWith (ifTyVars d1) (ifTyVars d2) (\ env -> 
-   	  eq_ifContext env (ifCtxt d1) (ifCtxt d2)  &&&
-	  eqListBy (eq_hsFD env)    (ifFDs d1)  (ifFDs d2) &&&
-	  eqListBy (eq_cls_sig env) (ifSigs d1) (ifSigs d2)
-       )
-
-eqIfDecl _ _ = NotEqual	-- default case
-
--- Helper
-eqWith :: [IfaceTvBndr] -> [IfaceTvBndr] -> (EqEnv -> IfaceEq) -> IfaceEq
-eqWith = eq_ifTvBndrs emptyEqEnv
-
------------------------
-eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2)
--- All other changes are handled via the version info on the dfun
-
-eqIfRule (IfaceRule n1 a1 bs1 f1 es1 rhs1 o1)
-	 (IfaceRule n2 a2 bs2 f2 es2 rhs2 o2)
-       = bool (n1==n2 && a1==a2 && o1 == o2) &&&
-	 f1 `eqIfExt` f2 &&&
-         eq_ifBndrs emptyEqEnv bs1 bs2 (\env -> 
-	 zapEq (eqListBy (eq_ifaceExpr env) es1 es2) &&&
-		-- zapEq: for the LHSs, ignore the EqBut part
-         eq_ifaceExpr env rhs1 rhs2)
-
-eq_hsCD env (IfDataTyCon c1) (IfDataTyCon c2) 
-  = eqListBy (eq_ConDecl env) c1 c2
-
-eq_hsCD env (IfNewTyCon c1)  (IfNewTyCon c2)  = eq_ConDecl env c1 c2
-eq_hsCD env IfAbstractTyCon  IfAbstractTyCon  = Equal
-eq_hsCD env d1		     d2		      = NotEqual
-
-eq_ConDecl env c1@(IfVanillaCon {}) c2@(IfVanillaCon {})
-  = bool (ifConOcc c1     == ifConOcc c2 && 
-	  ifConInfix c1   == ifConInfix c2 && 
-	  ifConStricts c1 == ifConStricts c2 && 
-	  ifConFields c1  == ifConFields c2) &&&
-   eq_ifTypes env (ifConArgTys c1) (ifConArgTys c2)
-
-eq_ConDecl env c1@(IfGadtCon {}) c2@(IfGadtCon {})
-  = bool (ifConOcc c1     == ifConOcc c2 && 
-	  ifConStricts c1 == ifConStricts c2) &&& 
-    eq_ifTvBndrs env (ifConTyVars c1) (ifConTyVars c2) (\ env ->
-	eq_ifContext env (ifConCtxt c1) (ifConCtxt c2) &&&
-	eq_ifTypes env (ifConResTys c1) (ifConResTys c2) &&&
-	eq_ifTypes env (ifConArgTys c1) (ifConArgTys c2))
-
-eq_ConDecl env c1 c2 = NotEqual
-
-eq_hsFD env (ns1,ms1) (ns2,ms2)
-  = eqListBy (eqIfOcc env) ns1 ns2 &&& eqListBy (eqIfOcc env) ms1 ms2
-
-eq_cls_sig env (IfaceClassOp n1 dm1 ty1) (IfaceClassOp n2 dm2 ty2)
-  = bool (n1==n2 && dm1 == dm2) &&& eq_ifType env ty1 ty2
-\end{code}
-
-
-\begin{code}
------------------
-eqIfIdInfo NoInfo	 NoInfo	       = Equal
-eqIfIdInfo (HasInfo is1) (HasInfo is2) = eqListBy eq_item is1 is2
-eqIfIdInfo i1 i2 = NotEqual
-
-eq_item (HsArity a1)	   (HsArity a2)	      = bool (a1 == a2)
-eq_item (HsStrictness s1)  (HsStrictness s2)  = bool (s1 == s2)
-eq_item (HsUnfold a1 u1)   (HsUnfold a2 u2)   = bool (a1 == a2) &&& eq_ifaceExpr emptyEqEnv u1 u2
-eq_item HsNoCafRefs        HsNoCafRefs	      = Equal
-eq_item (HsWorker wkr1 a1) (HsWorker wkr2 a2) = bool (a1==a2) &&& (wkr1 `eqIfExt` wkr2)
-eq_item _ _ = NotEqual
-
------------------
-eq_ifaceExpr :: EqEnv -> IfaceExpr -> IfaceExpr -> IfaceEq
-eq_ifaceExpr env (IfaceLcl v1)	      (IfaceLcl v2)	   = eqIfOcc env v1 v2
-eq_ifaceExpr env (IfaceExt v1)	      (IfaceExt v2)	   = eqIfExt v1 v2
-eq_ifaceExpr env (IfaceLit l1)        (IfaceLit l2) 	   = bool (l1 == l2)
-eq_ifaceExpr env (IfaceFCall c1 ty1)  (IfaceFCall c2 ty2)  = bool (c1==c2) &&& eq_ifType env ty1 ty2
-eq_ifaceExpr env (IfaceType ty1)      (IfaceType ty2)	   = eq_ifType env ty1 ty2
-eq_ifaceExpr env (IfaceTuple n1 as1)  (IfaceTuple n2 as2)  = bool (n1==n2) &&& eqListBy (eq_ifaceExpr env) as1 as2
-eq_ifaceExpr env (IfaceLam b1 body1)  (IfaceLam b2 body2)  = eq_ifBndr env b1 b2 (\env -> eq_ifaceExpr env body1 body2)
-eq_ifaceExpr env (IfaceApp f1 a1)     (IfaceApp f2 a2)	   = eq_ifaceExpr env f1 f2 &&& eq_ifaceExpr env a1 a2
-eq_ifaceExpr env (IfaceNote n1 r1)    (IfaceNote n2 r2)    = eq_ifaceNote env n1 n2 &&& eq_ifaceExpr env r1 r2
-
-eq_ifaceExpr env (IfaceCase s1 b1 ty1 as1) (IfaceCase s2 b2 ty2 as2)
-  = eq_ifaceExpr env s1 s2 &&&
-    eq_ifType env ty1 ty2 &&&
-    eq_ifNakedBndr env b1 b2 (\env -> eqListBy (eq_ifaceAlt env) as1 as2)
-  where
-    eq_ifaceAlt env (c1,bs1,r1) (c2,bs2,r2)
-	= bool (eq_ifaceConAlt c1 c2) &&& 
-	  eq_ifNakedBndrs env bs1 bs2 (\env -> eq_ifaceExpr env r1 r2)
-
-eq_ifaceExpr env (IfaceLet (IfaceNonRec b1 r1) x1) (IfaceLet (IfaceNonRec b2 r2) x2)
-  = eq_ifaceExpr env r1 r2 &&& eq_ifIdBndr env b1 b2 (\env -> eq_ifaceExpr env x1 x2)
-
-eq_ifaceExpr env (IfaceLet (IfaceRec as1) x1) (IfaceLet (IfaceRec as2) x2)
-  = eq_ifIdBndrs env bs1 bs2 (\env -> eqListBy (eq_ifaceExpr env) rs1 rs2 &&& eq_ifaceExpr env x1 x2)
-  where
-    (bs1,rs1) = unzip as1
-    (bs2,rs2) = unzip as2
-
-
-eq_ifaceExpr env _ _ = NotEqual
-
------------------
-eq_ifaceConAlt :: IfaceConAlt -> IfaceConAlt -> Bool
-eq_ifaceConAlt IfaceDefault	  IfaceDefault		= True
-eq_ifaceConAlt (IfaceDataAlt n1)  (IfaceDataAlt n2)	= n1==n2
-eq_ifaceConAlt (IfaceTupleAlt c1) (IfaceTupleAlt c2)	= c1==c2
-eq_ifaceConAlt (IfaceLitAlt l1)	  (IfaceLitAlt l2)	= l1==l2
-eq_ifaceConAlt _ _ = False
-
------------------
-eq_ifaceNote :: EqEnv -> IfaceNote -> IfaceNote -> IfaceEq
-eq_ifaceNote env (IfaceSCC c1)    (IfaceSCC c2)        = bool (c1==c2)
-eq_ifaceNote env (IfaceCoerce t1) (IfaceCoerce t2)     = eq_ifType env t1 t2
-eq_ifaceNote env IfaceInlineCall  IfaceInlineCall      = Equal
-eq_ifaceNote env IfaceInlineMe    IfaceInlineMe        = Equal
-eq_ifaceNote env (IfaceCoreNote s1) (IfaceCoreNote s2) = bool (s1==s2)
-eq_ifaceNote env _ _ = NotEqual
-\end{code}
-
-\begin{code}
----------------------
-eqIfType t1 t2 = eq_ifType emptyEqEnv t1 t2
-
--------------------
-eq_ifType env (IfaceTyVar n1)         (IfaceTyVar n2)         = eqIfOcc env n1 n2
-eq_ifType env (IfaceAppTy s1 t1)      (IfaceAppTy s2 t2)      = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
-eq_ifType env (IfacePredTy st1)       (IfacePredTy st2)       = eq_ifPredType env st1 st2
-eq_ifType env (IfaceTyConApp tc1 ts1) (IfaceTyConApp tc2 ts2) = tc1 `eqIfTc` tc2 &&& eq_ifTypes env ts1 ts2
-eq_ifType env (IfaceForAllTy tv1 t1)  (IfaceForAllTy tv2 t2)  = eq_ifTvBndr env tv1 tv2 (\env -> eq_ifType env t1 t2)
-eq_ifType env (IfaceFunTy s1 t1)      (IfaceFunTy s2 t2)      = eq_ifType env s1 s2 &&& eq_ifType env t1 t2
-eq_ifType env _ _ = NotEqual
-
--------------------
-eq_ifTypes env = eqListBy (eq_ifType env)
-
--------------------
-eq_ifContext env a b = eqListBy (eq_ifPredType env) a b
-
--------------------
-eq_ifPredType env (IfaceClassP c1 tys1) (IfaceClassP c2 tys2) = c1 `eqIfExt` c2 &&&  eq_ifTypes env tys1 tys2
-eq_ifPredType env (IfaceIParam n1 ty1) (IfaceIParam n2 ty2)   = bool (n1 == n2) &&& eq_ifType env ty1 ty2
-eq_ifPredType env _ _ = NotEqual
-
--------------------
-eqIfTc (IfaceTc tc1) (IfaceTc tc2) = tc1 `eqIfExt` tc2
-eqIfTc IfaceIntTc    IfaceIntTc	   = Equal
-eqIfTc IfaceCharTc   IfaceCharTc   = Equal
-eqIfTc IfaceBoolTc   IfaceBoolTc   = Equal
-eqIfTc IfaceListTc   IfaceListTc   = Equal
-eqIfTc IfacePArrTc   IfacePArrTc   = Equal
-eqIfTc (IfaceTupTc bx1 ar1) (IfaceTupTc bx2 ar2) = bool (bx1==bx2 && ar1==ar2)
-eqIfTc _ _ = NotEqual
-\end{code}
-
------------------------------------------------------------
-	Support code for equality checking
------------------------------------------------------------
-
-\begin{code}
-------------------------------------
-type EqEnv = OccEnv OccName	-- Tracks the mapping from L-variables to R-variables
-
-eqIfOcc :: EqEnv -> OccName -> OccName -> IfaceEq
-eqIfOcc env n1 n2 = case lookupOccEnv env n1 of
-			Just n1 -> bool (n1 == n2)
-			Nothing -> bool (n1 == n2)
-
-extendEqEnv :: EqEnv -> OccName -> OccName -> EqEnv
-extendEqEnv env n1 n2 | n1 == n2  = env
-		      | otherwise = extendOccEnv env n1 n2
-
-emptyEqEnv :: EqEnv
-emptyEqEnv = emptyOccEnv
-
-------------------------------------
-type ExtEnv bndr = EqEnv -> bndr -> bndr -> (EqEnv -> IfaceEq) -> IfaceEq
-
-eq_ifNakedBndr :: ExtEnv OccName
-eq_ifBndr      :: ExtEnv IfaceBndr
-eq_ifTvBndr    :: ExtEnv IfaceTvBndr
-eq_ifIdBndr    :: ExtEnv IfaceIdBndr
-
-eq_ifNakedBndr env n1 n2 k = k (extendEqEnv env n1 n2)
-
-eq_ifBndr env (IfaceIdBndr b1) (IfaceIdBndr b2) k = eq_ifIdBndr env b1 b2 k
-eq_ifBndr env (IfaceTvBndr b1) (IfaceTvBndr b2) k = eq_ifTvBndr env b1 b2 k
-eq_ifBndr _ _ _ _ = NotEqual
-
-eq_ifTvBndr env (v1, k1) (v2, k2) k = bool (k1 == k2)     &&& k (extendEqEnv env v1 v2)
-eq_ifIdBndr env (v1, t1) (v2, t2) k = eq_ifType env t1 t2 &&& k (extendEqEnv env v1 v2)
-
-eq_ifBndrs   	:: ExtEnv [IfaceBndr]
-eq_ifIdBndrs 	:: ExtEnv [IfaceIdBndr]
-eq_ifTvBndrs 	:: ExtEnv [IfaceTvBndr]
-eq_ifNakedBndrs :: ExtEnv [OccName]
-eq_ifBndrs   	= eq_bndrs_with eq_ifBndr
-eq_ifIdBndrs 	= eq_bndrs_with eq_ifIdBndr
-eq_ifTvBndrs 	= eq_bndrs_with eq_ifTvBndr
-eq_ifNakedBndrs = eq_bndrs_with eq_ifNakedBndr
-
-eq_bndrs_with eq env []       []       k = k env
-eq_bndrs_with eq env (b1:bs1) (b2:bs2) k = eq env b1 b2 (\env -> eq_bndrs_with eq env bs1 bs2 k)
-eq_bndrs_with eq env _	      _	       _ = NotEqual
-\end{code}
-
-\begin{code}
-eqListBy :: (a->a->IfaceEq) -> [a] -> [a] -> IfaceEq
-eqListBy eq []     []     = Equal
-eqListBy eq (x:xs) (y:ys) = eq x y &&& eqListBy eq xs ys
-eqListBy eq xs     ys     = NotEqual
-
-eqMaybeBy :: (a->a->IfaceEq) -> Maybe a -> Maybe a -> IfaceEq
-eqMaybeBy eq Nothing Nothing   = Equal
-eqMaybeBy eq (Just x) (Just y) = eq x y
-eqMaybeBy eq x        y        = NotEqual
-\end{code}
diff --git a/ghc/compiler/iface/IfaceType.lhs b/ghc/compiler/iface/IfaceType.lhs
deleted file mode 100644
index 76438ddb23..0000000000
--- a/ghc/compiler/iface/IfaceType.lhs
+++ /dev/null
@@ -1,390 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-
-	This module defines interface types and binders
-
-\begin{code}
-module IfaceType (
-	IfaceType(..), IfaceKind, IfacePredType(..), IfaceTyCon(..),
-	IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr,
-
-	IfaceExtName(..), mkIfaceExtName, isLocalIfaceExtName,
-	ifaceTyConName, interactiveExtNameFun,
-
-	-- Conversion from Type -> IfaceType
-	toIfaceType, toIfacePred, toIfaceContext, 
-	toIfaceBndr, toIfaceIdBndr, toIfaceTvBndrs, 
-	toIfaceTyCon, toIfaceTyCon_name,
-
-	-- Printing
-	pprIfaceType, pprParendIfaceType, pprIfaceContext, 
-	pprIfaceIdBndr, pprIfaceTvBndr, pprIfaceTvBndrs, pprIfaceBndrs,
-	tOP_PREC, tYCON_PREC, noParens, maybeParen, pprIfaceForAllPart
-
-    ) where
-
-#include "HsVersions.h"
-
-import Kind		( Kind(..) )
-import TypeRep		( TyThing(..), Type(..), PredType(..), ThetaType )
-import TyCon		( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity, tyConName )
-import Var		( isId, tyVarKind, idType )
-import TysWiredIn	( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName )
-import OccName		( OccName, parenSymOcc )
-import Name		( Name, getName, getOccName, nameModule, nameOccName,
-			  wiredInNameTyThing_maybe )
-import Module		( Module )
-import BasicTypes	( IPName(..), Arity, Version, mapIPName, tupleParens, Boxity )
-import Outputable
-import FastString
-\end{code}
-
-	
-%************************************************************************
-%*									*
-		IfaceExtName
-%*									*
-%************************************************************************
-
-\begin{code}
-data IfaceExtName
-  = ExtPkg Module OccName		-- From an external package; no version #
-					-- Also used for wired-in things regardless
-					-- of whether they are home-pkg or not
-
-  | HomePkg Module OccName Version	-- From another module in home package;
-					-- has version #; in all other respects,
-					-- HomePkg and ExtPkg are the same
-
-  | LocalTop OccName			-- Top-level from the same module as 
-					-- the enclosing IfaceDecl
-
-  | LocalTopSub		-- Same as LocalTop, but for a class method or constr
-	OccName		-- Class-meth/constr name
-	OccName		-- Parent class/datatype name
-	-- LocalTopSub is written into iface files as LocalTop; the parent 
-	-- info is only used when computing version information in MkIface
-
-isLocalIfaceExtName :: IfaceExtName -> Bool
-isLocalIfaceExtName (LocalTop _)      = True
-isLocalIfaceExtName (LocalTopSub _ _) = True
-isLocalIfaceExtName other	      = False
-
-mkIfaceExtName name = ExtPkg (nameModule name) (nameOccName name)
-	-- Local helper for wired-in names
-
-ifaceExtOcc :: IfaceExtName -> OccName
-ifaceExtOcc (ExtPkg _ occ)    	= occ
-ifaceExtOcc (HomePkg _ occ _) 	= occ
-ifaceExtOcc (LocalTop occ)    	= occ
-ifaceExtOcc (LocalTopSub occ _) = occ
-
-interactiveExtNameFun :: PrintUnqualified -> Name-> IfaceExtName
-interactiveExtNameFun print_unqual name
-  | print_unqual mod occ = LocalTop occ
-  | otherwise		 = ExtPkg mod occ
-  where
-    mod = nameModule name
-    occ = nameOccName name
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Local (nested) binders
-%*									*
-%************************************************************************
-
-\begin{code}
-data IfaceBndr 		-- Local (non-top-level) binders
-  = IfaceIdBndr IfaceIdBndr
-  | IfaceTvBndr IfaceTvBndr
-
-type IfaceIdBndr  = (OccName, IfaceType)	-- OccName, because always local
-type IfaceTvBndr  = (OccName, IfaceKind)
-
--------------------------------
-type IfaceKind = Kind			-- Re-use the Kind type, but no KindVars in it
-
-data IfaceType
-  = IfaceTyVar    OccName			-- Type variable only, not tycon
-  | IfaceAppTy    IfaceType IfaceType
-  | IfaceForAllTy IfaceTvBndr IfaceType
-  | IfacePredTy   IfacePredType
-  | IfaceTyConApp IfaceTyCon [IfaceType]	-- Not necessarily saturated
-						-- Includes newtypes, synonyms, tuples
-  | IfaceFunTy  IfaceType IfaceType
-
-data IfacePredType 	-- NewTypes are handled as ordinary TyConApps
-  = IfaceClassP IfaceExtName [IfaceType]
-  | IfaceIParam (IPName OccName) IfaceType
-
-type IfaceContext = [IfacePredType]
-
-data IfaceTyCon 	-- Abbreviations for common tycons with known names
-  = IfaceTc IfaceExtName	-- The common case
-  | IfaceIntTc | IfaceBoolTc | IfaceCharTc
-  | IfaceListTc | IfacePArrTc
-  | IfaceTupTc Boxity Arity 
-
-ifaceTyConName :: IfaceTyCon -> Name	-- Works for all except IfaceTc
-ifaceTyConName IfaceIntTc  	  = intTyConName
-ifaceTyConName IfaceBoolTc 	  = boolTyConName
-ifaceTyConName IfaceCharTc 	  = charTyConName
-ifaceTyConName IfaceListTc 	  = listTyConName
-ifaceTyConName IfacePArrTc 	  = parrTyConName
-ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
-ifaceTyConName (IfaceTc ext)      = pprPanic "ifaceTyConName" (ppr ext)
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Functions over IFaceTypes
-%*									*
-%************************************************************************
-
-
-\begin{code}
-splitIfaceSigmaTy :: IfaceType -> ([IfaceTvBndr], IfaceContext, IfaceType)
--- Mainly for printing purposes
-splitIfaceSigmaTy ty
-  = (tvs,theta,tau)
-  where
-    (tvs, rho)   = split_foralls ty
-    (theta, tau) = split_rho rho
-
-    split_foralls (IfaceForAllTy tv ty) 
-	= case split_foralls ty of { (tvs, rho) -> (tv:tvs, rho) }
-    split_foralls rho = ([], rho)
-
-    split_rho (IfaceFunTy (IfacePredTy st) ty) 
-	= case split_rho ty of { (sts, tau) -> (st:sts, tau) }
-    split_rho tau = ([], tau)
-\end{code}
-
-%************************************************************************
-%*									*
-		Pretty-printing
-%*									*
-%************************************************************************
-
-Precedence
-~~~~~~~~~~
-@ppr_ty@ takes an @Int@ that is the precedence of the context.
-The precedence levels are:
-\begin{description}
-\item[tOP_PREC]   No parens required.
-\item[fUN_PREC]   Left hand argument of a function arrow.
-\item[tYCON_PREC] Argument of a type constructor.
-\end{description}
-
-\begin{code}
-tOP_PREC    = (0 :: Int)  -- type   in ParseIface.y
-fUN_PREC    = (1 :: Int)  -- btype  in ParseIface.y
-tYCON_PREC  = (2 :: Int)  -- atype  in ParseIface.y
-
-noParens :: SDoc -> SDoc
-noParens pp = pp
-
-maybeParen ctxt_prec inner_prec pretty
-  | ctxt_prec < inner_prec = pretty
-  | otherwise		   = parens pretty
-\end{code}
-
-
------------------------------ Printing binders ------------------------------------
-
-\begin{code}
--- These instances are used only when printing for the user, either when
--- debugging, or in GHCi when printing the results of a :info command
-instance Outputable IfaceExtName where
-    ppr (ExtPkg mod occ)       = pprExt mod occ
-    ppr (HomePkg mod occ vers) = pprExt mod occ <> braces (ppr vers)
-    ppr (LocalTop occ)	       = ppr occ	-- Do we want to distinguish these 
-    ppr (LocalTopSub occ _)    = ppr occ	-- from an ordinary occurrence?
-
-pprExt :: Module -> OccName -> SDoc
--- No need to worry about printing unqualified becuase that was handled
--- in the transiation to IfaceSyn 
-pprExt mod occ = ppr mod <> dot <> ppr occ
-
-instance Outputable IfaceBndr where
-    ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
-    ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
-
-pprIfaceBndrs :: [IfaceBndr] -> SDoc
-pprIfaceBndrs bs = sep (map ppr bs)
-
-pprIfaceIdBndr (name, ty) = hsep [ppr name, dcolon, ppr ty]
-
-pprIfaceTvBndr :: IfaceTvBndr -> SDoc
-pprIfaceTvBndr (tv, LiftedTypeKind) = ppr tv
-pprIfaceTvBndr (tv, kind) 	    = parens (ppr tv <> dcolon <> ppr kind)
-
-pprIfaceTvBndrs :: [IfaceTvBndr] -> SDoc
-pprIfaceTvBndrs tyvars = hsep (map pprIfaceTvBndr tyvars)
-\end{code}
-
------------------------------ Printing IfaceType ------------------------------------
-
-\begin{code}
----------------------------------
-instance Outputable IfaceType where
-  ppr ty = pprIfaceTypeForUser ty
-
-pprIfaceTypeForUser ::IfaceType -> SDoc
--- Drop top-level for-alls; if that's not what you want, use pprIfaceType dire
-pprIfaceTypeForUser ty
-  = pprIfaceForAllPart [] theta (pprIfaceType tau)
- where		
-    (_tvs, theta, tau) = splitIfaceSigmaTy ty
-
-pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
-pprIfaceType       = ppr_ty tOP_PREC
-pprParendIfaceType = ppr_ty tYCON_PREC
-
-
-ppr_ty :: Int -> IfaceType -> SDoc
-ppr_ty ctxt_prec (IfaceTyVar tyvar)     = ppr tyvar
-ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
-ppr_ty ctxt_prec (IfacePredTy st)       = ppr st
-
-	-- Function types
-ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
-  = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
-    maybeParen ctxt_prec fUN_PREC $
-    sep (ppr_ty fUN_PREC ty1 : ppr_fun_tail ty2)
-  where
-    ppr_fun_tail (IfaceFunTy ty1 ty2) 
-      = (arrow <+> ppr_ty fUN_PREC ty1) : ppr_fun_tail ty2
-    ppr_fun_tail other_ty
-      = [arrow <+> pprIfaceType other_ty]
-
-ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
-  = maybeParen ctxt_prec tYCON_PREC $
-    ppr_ty fUN_PREC ty1 <+> pprParendIfaceType ty2
-
-ppr_ty ctxt_prec ty@(IfaceForAllTy _ _)
-  = maybeParen ctxt_prec fUN_PREC (pprIfaceForAllPart tvs theta (pprIfaceType tau))
- where		
-    (tvs, theta, tau) = splitIfaceSigmaTy ty
-    
--------------------
-pprIfaceForAllPart :: [IfaceTvBndr] -> IfaceContext -> SDoc -> SDoc
-pprIfaceForAllPart tvs ctxt doc 
-  = sep [ppr_tvs, pprIfaceContext ctxt, doc]
-  where
-    ppr_tvs | null tvs  = empty
-	    | otherwise = ptext SLIT("forall") <+> pprIfaceTvBndrs tvs <> dot
-
--------------------
-ppr_tc_app ctxt_prec tc 	 []   = ppr_tc tc
-ppr_tc_app ctxt_prec IfaceListTc [ty] = brackets   (pprIfaceType ty)
-ppr_tc_app ctxt_prec IfacePArrTc [ty] = pabrackets (pprIfaceType ty)
-ppr_tc_app ctxt_prec (IfaceTupTc bx arity) tys
-  | arity == length tys 
-  = tupleParens bx (sep (punctuate comma (map pprIfaceType tys)))
-ppr_tc_app ctxt_prec tc tys 
-  = maybeParen ctxt_prec tYCON_PREC 
-	       (sep [ppr_tc tc, nest 4 (sep (map pprParendIfaceType tys))])
-
-ppr_tc :: IfaceTyCon -> SDoc
--- Wrap infix type constructors in parens
-ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (ifaceExtOcc ext_nm) (ppr tc)
-ppr_tc tc		   = ppr tc
-
--------------------
-instance Outputable IfacePredType where
-	-- Print without parens
-  ppr (IfaceIParam ip ty)  = hsep [ppr ip, dcolon, ppr ty]
-  ppr (IfaceClassP cls ts) = parenSymOcc (ifaceExtOcc cls) (ppr cls)
-			     <+> sep (map pprParendIfaceType ts)
-
-instance Outputable IfaceTyCon where
-  ppr (IfaceTc ext) = ppr ext
-  ppr other_tc      = ppr (ifaceTyConName other_tc)
-
--------------------
-pprIfaceContext :: IfaceContext -> SDoc
--- Prints "(C a, D b) =>", including the arrow
-pprIfaceContext []     = empty
-pprIfaceContext theta = ppr_preds theta <+> ptext SLIT("=>")
-
-ppr_preds [pred] = ppr pred	-- No parens
-ppr_preds preds  = parens (sep (punctuate comma (map ppr preds))) 
-			 
--------------------
-pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]")
-\end{code}
-
-%************************************************************************
-%*									*
-	Conversion from Type to IfaceType
-%*									*
-%************************************************************************
-
-\begin{code}
-----------------
-toIfaceTvBndr tyvar   = (getOccName tyvar, tyVarKind tyvar)
-toIfaceIdBndr ext id  = (getOccName id,    toIfaceType ext (idType id))
-toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars
-
-toIfaceBndr ext var
-  | isId var  = IfaceIdBndr (toIfaceIdBndr ext var)
-  | otherwise = IfaceTvBndr (toIfaceTvBndr var)
-
----------------------
-toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType
--- Synonyms are retained in the interface type
-toIfaceType ext (TyVarTy tv)     	     = IfaceTyVar (getOccName tv)
-toIfaceType ext (AppTy t1 t2)    	     = IfaceAppTy (toIfaceType ext t1) (toIfaceType ext t2)
-toIfaceType ext (FunTy t1 t2)    	     = IfaceFunTy (toIfaceType ext t1) (toIfaceType ext t2)
-toIfaceType ext (TyConApp tc tys) 	     = IfaceTyConApp (toIfaceTyCon ext tc) (toIfaceTypes ext tys)
-toIfaceType ext (ForAllTy tv t)  	     = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType ext t)
-toIfaceType ext (PredTy st)     	     = IfacePredTy (toIfacePred ext st)
-toIfaceType ext (NoteTy other_note ty)	     = toIfaceType ext ty
-
-----------------
--- A little bit of (perhaps optional) trickiness here.  When
--- compiling Data.Tuple, the tycons are not TupleTyCons, although
--- they have a wired-in name.  But we'd like to dump them into the Iface
--- as a tuple tycon, to save lookups when reading the interface
--- Hence a tuple tycon may 'miss' in toIfaceTyCon, but then
--- toIfaceTyCon_name will still catch it.
-
-toIfaceTyCon :: (Name -> IfaceExtName) -> TyCon -> IfaceTyCon
-toIfaceTyCon ext tc 
-  | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
-  | otherwise	    = toIfaceTyCon_name ext (tyConName tc)
-
-toIfaceTyCon_name :: (Name -> IfaceExtName) -> Name -> IfaceTyCon
-toIfaceTyCon_name ext nm
-  | Just (ATyCon tc) <- wiredInNameTyThing_maybe nm
-  = toIfaceWiredInTyCon ext tc nm
-  | otherwise
-  = IfaceTc (ext nm)
-
-toIfaceWiredInTyCon :: (Name -> IfaceExtName) -> TyCon -> Name -> IfaceTyCon
-toIfaceWiredInTyCon ext tc nm
-  | isTupleTyCon tc     = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
-  | nm == intTyConName  = IfaceIntTc
-  | nm == boolTyConName = IfaceBoolTc 
-  | nm == charTyConName = IfaceCharTc 
-  | nm == listTyConName = IfaceListTc 
-  | nm == parrTyConName = IfacePArrTc 
-  | otherwise		= IfaceTc (ext nm)
-
-----------------
-toIfaceTypes ext ts = map (toIfaceType ext) ts
-
-----------------
-toIfacePred ext (ClassP cls ts) = IfaceClassP (ext (getName cls)) (toIfaceTypes ext ts)
-toIfacePred ext (IParam ip t)   = IfaceIParam (mapIPName getOccName ip) (toIfaceType ext t)
-
-----------------
-toIfaceContext :: (Name -> IfaceExtName) -> ThetaType -> IfaceContext
-toIfaceContext ext cs = map (toIfacePred ext) cs
-\end{code}
-
diff --git a/ghc/compiler/iface/LoadIface.lhs b/ghc/compiler/iface/LoadIface.lhs
deleted file mode 100644
index 8c496f76ef..0000000000
--- a/ghc/compiler/iface/LoadIface.lhs
+++ /dev/null
@@ -1,582 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section{Dealing with interface files}
-
-\begin{code}
-module LoadIface (
-	loadInterface, loadHomeInterface, loadWiredInHomeIface, 
-	loadSrcInterface, loadSysInterface, loadOrphanModules, 
-	findAndReadIface, readIface,	-- Used when reading the module's old interface
-	loadDecls, ifaceStats, discardDeclPrags,
-	initExternalPackageState
-   ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-}	TcIface( tcIfaceDecl, tcIfaceRule, tcIfaceInst )
-
-import Packages		( PackageState(..), PackageIdH(..), isHomePackage )
-import DynFlags		( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ),
-			  isOneShot )
-import IfaceSyn		( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
-			  IfaceConDecls(..), IfaceIdInfo(..) )
-import IfaceEnv		( newGlobalBinder )
-import HscTypes		( ModIface(..), TyThing, emptyModIface, EpsStats(..),
-			  addEpsInStats, ExternalPackageState(..),
-			  PackageTypeEnv, emptyTypeEnv,  HscEnv(..),
-			  lookupIfaceByModule, emptyPackageIfaceTable,
-			  IsBootInterface, mkIfaceFixCache, 
-			  implicitTyThings 
-			 )
-
-import BasicTypes	( Version, Fixity(..), FixityDirection(..),
-			  isMarkedStrict )
-import TcRnMonad
-
-import PrelNames	( gHC_PRIM )
-import PrelInfo		( ghcPrimExports )
-import PrelRules	( builtinRules )
-import Rules		( extendRuleBaseList, mkRuleBase )
-import InstEnv		( emptyInstEnv, extendInstEnvList )
-import Name		( Name {-instance NamedThing-}, getOccName,
-			  nameModule, nameIsLocalOrFrom, isWiredInName )
-import NameEnv
-import MkId		( seqId )
-import Module		( Module, ModLocation(ml_hi_file), emptyModuleEnv, 
-			  addBootSuffix_maybe,
-			  extendModuleEnv, lookupModuleEnv, moduleString
-			)
-import OccName		( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataConOcc,
-			  mkSuperDictSelOcc, mkDataConWrapperOcc, mkDataConWorkerOcc )
-import SrcLoc		( importedSrcLoc )
-import Maybes		( MaybeErr(..) )
-import FastString	( mkFastString )
-import ErrUtils         ( Message )
-import Finder		( findModule, findPackageModule,  FindResult(..), cantFindError )
-import Outputable
-import BinIface		( readBinIface )
-import Panic		( ghcError, tryMost, showException, GhcException(..) )
-import List		( nub )
-\end{code}
-
-
-%************************************************************************
-%*									*
-	loadSrcInterface, loadOrphanModules, loadHomeInterface
-
-		These three are called from TcM-land	
-%*									*
-%************************************************************************
-
-\begin{code}
-loadSrcInterface :: SDoc -> Module -> IsBootInterface -> RnM ModIface
--- This is called for each 'import' declaration in the source code
--- On a failure, fail in the monad with an error message
-
-loadSrcInterface doc mod want_boot
-  = do 	{ mb_iface <- initIfaceTcRn $ 
-		      loadInterface doc mod (ImportByUser want_boot)
-	; case mb_iface of
-	    Failed err      -> failWithTc (elaborate err)
-	    Succeeded iface -> return iface
-	}
-  where
-    elaborate err = hang (ptext SLIT("Failed to load interface for") <+> 
-			  quotes (ppr mod) <> colon) 4 err
-
----------------
-loadOrphanModules :: [Module] -> TcM ()
-loadOrphanModules mods
-  | null mods = returnM ()
-  | otherwise = initIfaceTcRn $
-		do { traceIf (text "Loading orphan modules:" <+> 
-		     		 fsep (map ppr mods))
-		   ; mappM_ load mods
-		   ; returnM () }
-  where
-    load mod   = loadSysInterface (mk_doc mod) mod
-    mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
-
----------------
-loadHomeInterface :: SDoc -> Name -> TcRn ModIface
-loadHomeInterface doc name
-  = do	{ 
-#ifdef DEBUG
-		-- Should not be called with a name from the module being compiled
-	  this_mod <- getModule
-	; ASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc )
-#endif
-	  initIfaceTcRn $ loadSysInterface doc (nameModule name)
-    }
-
----------------
-loadWiredInHomeIface :: Name -> IfM lcl ()
--- A IfM function to load the home interface for a wired-in thing,
--- so that we're sure that we see its instance declarations and rules
-loadWiredInHomeIface name
-  = ASSERT( isWiredInName name )
-    do { loadSysInterface doc (nameModule name); return () }
-  where
-    doc = ptext SLIT("Need home interface for wired-in thing") <+> ppr name
-
----------------
-loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
--- A wrapper for loadInterface that Throws an exception if it fails
-loadSysInterface doc mod_name
-  = do	{ mb_iface <- loadInterface doc mod_name ImportBySystem
-	; case mb_iface of 
-	    Failed err      -> ghcError (ProgramError (showSDoc err))
-	    Succeeded iface -> return iface }
-\end{code}
-
-
-%*********************************************************
-%*							*
-		loadInterface
-
-	The main function to load an interface
-	for an imported module, and put it in
-	the External Package State
-%*							*
-%*********************************************************
-
-\begin{code}
-loadInterface :: SDoc -> Module -> WhereFrom 
-	      -> IfM lcl (MaybeErr Message ModIface)
-
--- If it can't find a suitable interface file, we
---	a) modify the PackageIfaceTable to have an empty entry
---		(to avoid repeated complaints)
---	b) return (Left message)
---
--- It's not necessarily an error for there not to be an interface
--- file -- perhaps the module has changed, and that interface 
--- is no longer used
-
-loadInterface doc_str mod from
-  = do	{ 	-- Read the state
-	  (eps,hpt) <- getEpsAndHpt
-
-	; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
-
-		-- Check whether we have the interface already
-	; case lookupIfaceByModule hpt (eps_PIT eps) mod of {
-	    Just iface 
-		-> returnM (Succeeded iface) ;	-- Already loaded
-			-- The (src_imp == mi_boot iface) test checks that the already-loaded
-			-- interface isn't a boot iface.  This can conceivably happen,
-			-- if an earlier import had a before we got to real imports.   I think.
-	    other -> do
-
-	{ let { hi_boot_file = case from of
-				ImportByUser usr_boot -> usr_boot
-				ImportBySystem        -> sys_boot
-
-	      ; mb_dep   = lookupModuleEnv (eps_is_boot eps) mod
-	      ; sys_boot = case mb_dep of
-				Just (_, is_boot) -> is_boot
-				Nothing		  -> False
-			-- The boot-ness of the requested interface, 
-	      }		-- based on the dependencies in directly-imported modules
-
-	-- READ THE MODULE IN
-	; let explicit | ImportByUser _ <- from = True
-		       | otherwise              = False
-	; read_result <- findAndReadIface explicit doc_str mod hi_boot_file
-	; dflags <- getDOpts
-	; case read_result of {
-	    Failed err -> do
-	  	{ let fake_iface = emptyModIface HomePackage mod
-
-		; updateEps_ $ \eps ->
-			eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
-			-- Not found, so add an empty iface to 
-			-- the EPS map so that we don't look again
-				
-		; returnM (Failed err) } ;
-
-	-- Found and parsed!
-	    Succeeded (iface, file_path) 			-- Sanity check:
-		| ImportBySystem <- from,		--   system-importing...
-		  isHomePackage (mi_package iface),	--   ...a home-package module
-		  Nothing <- mb_dep			--   ...that we know nothing about
-		-> returnM (Failed (badDepMsg mod))
-
-		| otherwise ->
-
-	let 
-	    loc_doc = text file_path
-	in 
-	initIfaceLcl mod loc_doc $ do
-
-	-- 	Load the new ModIface into the External Package State
-	-- Even home-package interfaces loaded by loadInterface 
-	-- 	(which only happens in OneShot mode; in Batch/Interactive 
-	--  	mode, home-package modules are loaded one by one into the HPT)
-	-- are put in the EPS.
-	--
-	-- The main thing is to add the ModIface to the PIT, but
-	-- we also take the
-	--	IfaceDecls, IfaceInst, IfaceRules
-	-- out of the ModIface and put them into the big EPS pools
-
-	-- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
-	---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
-	--     If we do loadExport first the wrong info gets into the cache (unless we
-	-- 	explicitly tag each export which seems a bit of a bore)
-
-	; ignore_prags <- doptM Opt_IgnoreInterfacePragmas
-	; new_eps_decls <- loadDecls ignore_prags (mi_decls iface)
-	; new_eps_insts <- mapM tcIfaceInst (mi_insts iface)
-	; new_eps_rules <- if ignore_prags 
-			   then return []
-			   else mapM tcIfaceRule (mi_rules iface)
-
-	; let {	final_iface = iface {	mi_decls = panic "No mi_decls in PIT",
-					mi_insts = panic "No mi_insts in PIT",
-					mi_rules = panic "No mi_rules in PIT" } }
-
-	; updateEps_  $ \ eps -> 
-	    eps { eps_PIT       = extendModuleEnv (eps_PIT eps) mod final_iface,
-		  eps_PTE       = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
-		  eps_rule_base = extendRuleBaseList (eps_rule_base eps) new_eps_rules,
-		  eps_inst_env  = extendInstEnvList  (eps_inst_env eps)  new_eps_insts,
-		  eps_stats     = addEpsInStats (eps_stats eps) (length new_eps_decls)
-						(length new_eps_insts) (length new_eps_rules) }
-
-	; return (Succeeded final_iface)
-    }}}}
-
-badDepMsg mod 
-  = hang (ptext SLIT("Interface file inconsistency:"))
-       2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is mentioned,"), 
-	       ptext SLIT("but does not appear in the dependencies of the interface")])
-
------------------------------------------------------
---	Loading type/class/value decls
--- We pass the full Module name here, replete with
--- its package info, so that we can build a Name for
--- each binder with the right package info in it
--- All subsequent lookups, including crucially lookups during typechecking
--- the declaration itself, will find the fully-glorious Name
------------------------------------------------------
-
-addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
-addDeclsToPTE pte things = extendNameEnvList pte things
-
-loadDecls :: Bool
-	  -> [(Version, IfaceDecl)]
-	  -> IfL [(Name,TyThing)]
-loadDecls ignore_prags ver_decls
-   = do { mod <- getIfModule
- 	; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
-	; return (concat thingss)
-	}
-
-loadDecl :: Bool			-- Don't load pragmas into the decl pool
-	 -> Module
-	  -> (Version, IfaceDecl)
-	  -> IfL [(Name,TyThing)]	-- The list can be poked eagerly, but the
-					-- TyThings are forkM'd thunks
-loadDecl ignore_prags mod (_version, decl)
-  = do 	{ 	-- Populate the name cache with final versions of all 
-		-- the names associated with the decl
-	  main_name      <- mk_new_bndr mod Nothing (ifName decl)
-	; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) (ifaceDeclSubBndrs decl)
-
-	-- Typecheck the thing, lazily
-	-- NB. firstly, the laziness is there in case we never need the
-	-- declaration (in one-shot mode), and secondly it is there so that 
-	-- we don't look up the occurrence of a name before calling mk_new_bndr
-	-- on the binder.  This is important because we must get the right name
-	-- which includes its nameParent.
-	; thing <- forkM doc (bumpDeclStats main_name >> tcIfaceDecl stripped_decl)
-	; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
-	      lookup n = case lookupOccEnv mini_env (getOccName n) of
-			   Just thing -> thing
-			   Nothing    -> pprPanic "loadDecl" (ppr main_name <+> ppr n)
-
-	; returnM ((main_name, thing) : [(n, lookup n) | n <- implicit_names]) }
-		-- We build a list from the *known* names, with (lookup n) thunks
-		-- as the TyThings.  That way we can extend the PTE without poking the
-		-- thunks
-  where
-    stripped_decl | ignore_prags = discardDeclPrags decl
-		  | otherwise    = decl
-
-	-- mk_new_bndr allocates in the name cache the final canonical
-	-- name for the thing, with the correct 
-	--	* parent
-	--	* location
-	-- imported name, to fix the module correctly in the cache
-    mk_new_bndr mod mb_parent occ 
-	= newGlobalBinder mod occ mb_parent 
-			  (importedSrcLoc (moduleString mod))
-
-    doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
-
-discardDeclPrags :: IfaceDecl -> IfaceDecl
-discardDeclPrags decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = NoInfo }
-discardDeclPrags decl 		    	  	       = decl
-
-bumpDeclStats :: Name -> IfL ()		-- Record that one more declaration has actually been used
-bumpDeclStats name
-  = do	{ traceIf (text "Loading decl for" <+> ppr name)
-	; updateEps_ (\eps -> let stats = eps_stats eps
-			      in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
-	}
-
------------------
-ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
---  *Excludes* the 'main' name, but *includes* the implicitly-bound names
--- Deeply revolting, because it has to predict what gets bound,
--- especially the question of whether there's a wrapper for a datacon
-
-ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, ifSigs = sigs })
-  = [tc_occ, dc_occ, dcww_occ] ++
-    [op | IfaceClassOp op _ _ <- sigs] ++
-    [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]] 
-  where
-    n_ctxt = length sc_ctxt
-    n_sigs = length sigs
-    tc_occ  = mkClassTyConOcc cls_occ
-    dc_occ  = mkClassDataConOcc cls_occ	
-    dcww_occ | is_newtype = mkDataConWrapperOcc dc_occ	-- Newtypes have wrapper but no worker
-	     | otherwise  = mkDataConWorkerOcc dc_occ	-- Otherwise worker but no wrapper
-    is_newtype = n_sigs + n_ctxt == 1			-- Sigh 
-
-ifaceDeclSubBndrs (IfaceData {ifCons = IfAbstractTyCon}) 
-  = []
--- Newtype
-ifaceDeclSubBndrs (IfaceData {ifCons = IfNewTyCon (IfVanillaCon { ifConOcc = con_occ, 
-								  ifConFields = fields})}) 
-  = fields ++ [con_occ, mkDataConWrapperOcc con_occ] 	
-	-- Wrapper, no worker; see MkId.mkDataConIds
-
-ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon cons})
-  = nub (concatMap fld_occs cons) 	-- Eliminate duplicate fields
-    ++ concatMap dc_occs cons
-  where
-    fld_occs (IfVanillaCon { ifConFields = fields }) = fields
-    fld_occs (IfGadtCon {}) 			     = []
-    dc_occs con_decl
-	| has_wrapper = [con_occ, work_occ, wrap_occ]
-	| otherwise   = [con_occ, work_occ]
-	where
-	  con_occ = ifConOcc con_decl
-	  strs    = ifConStricts con_decl
-	  wrap_occ = mkDataConWrapperOcc con_occ
-	  work_occ = mkDataConWorkerOcc con_occ
-	  has_wrapper = any isMarkedStrict strs	-- See MkId.mkDataConIds (sigh)
-		-- ToDo: may miss strictness in existential dicts
-
-ifaceDeclSubBndrs _other 		      = []
-
-\end{code}
-
-
-%*********************************************************
-%*							*
-\subsection{Reading an interface file}
-%*							*
-%*********************************************************
-
-\begin{code}
-findAndReadIface :: Bool 		-- True <=> explicit user import
-		 -> SDoc -> Module 
-		 -> IsBootInterface	-- True  <=> Look for a .hi-boot file
-					-- False <=> Look for .hi file
-		 -> TcRnIf gbl lcl (MaybeErr Message (ModIface, FilePath))
-	-- Nothing <=> file not found, or unreadable, or illegible
-	-- Just x  <=> successfully found and parsed 
-
-	-- It *doesn't* add an error to the monad, because 
-	-- sometimes it's ok to fail... see notes with loadInterface
-
-findAndReadIface explicit doc_str mod_name hi_boot_file
-  = do	{ traceIf (sep [hsep [ptext SLIT("Reading"), 
-			      if hi_boot_file 
-				then ptext SLIT("[boot]") 
-				else empty,
-			      ptext SLIT("interface for"), 
-			      ppr mod_name <> semi],
-		        nest 4 (ptext SLIT("reason:") <+> doc_str)])
-
-	-- Check for GHC.Prim, and return its static interface
-	; dflags <- getDOpts
-	; let base_pkg = basePackageId (pkgState dflags)
-	; if mod_name == gHC_PRIM
-	  then returnM (Succeeded (ghcPrimIface{ mi_package = base_pkg }, 
-			"<built in interface for GHC.Prim>"))
-	  else do
-
-	-- Look for the file
-	; hsc_env <- getTopEnv
-	; mb_found <- ioToIOEnv (findHiFile hsc_env explicit mod_name hi_boot_file)
-	; case mb_found of {
-	      Failed err -> do
-		{ traceIf (ptext SLIT("...not found"))
-		; dflags <- getDOpts
-		; returnM (Failed (cantFindError dflags mod_name err)) } ;
-
-	      Succeeded (file_path, pkg) -> do 
-
-	-- Found file, so read it
-	{ traceIf (ptext SLIT("readIFace") <+> text file_path)
-	; read_result <- readIface mod_name file_path hi_boot_file
-	; case read_result of
-	    Failed err -> returnM (Failed (badIfaceFile file_path err))
-	    Succeeded iface 
-		| mi_module iface /= mod_name ->
-		  return (Failed (wrongIfaceModErr iface mod_name file_path))
-		| otherwise ->
-		  returnM (Succeeded (iface{mi_package=pkg}, file_path))
-			-- Don't forget to fill in the package name...
-	}}}
-
-findHiFile :: HscEnv -> Bool -> Module -> IsBootInterface
-	   -> IO (MaybeErr FindResult (FilePath, PackageIdH))
-findHiFile hsc_env explicit mod_name hi_boot_file
- = do { 
-	-- In interactive or --make mode, we are *not allowed* to demand-load
-	-- a home package .hi file.  So don't even look for them.
-	-- This helps in the case where you are sitting in eg. ghc/lib/std
-	-- and start up GHCi - it won't complain that all the modules it tries
-	-- to load are found in the home location.
-	let { home_allowed = isOneShot (ghcMode (hsc_dflags hsc_env)) } ;
-	maybe_found <-	if home_allowed 
-			then findModule        hsc_env mod_name explicit
-			else findPackageModule hsc_env mod_name explicit;
-
-	case maybe_found of
-	  Found loc pkg -> return (Succeeded (path, pkg))
-			where
-			   path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc)
-
-	  err -> return (Failed err)
-	}
-\end{code}
-
-@readIface@ tries just the one file.
-
-\begin{code}
-readIface :: Module -> String -> IsBootInterface 
-	  -> TcRnIf gbl lcl (MaybeErr Message ModIface)
-	-- Failed err    <=> file not found, or unreadable, or illegible
-	-- Succeeded iface <=> successfully found and parsed 
-
-readIface wanted_mod file_path is_hi_boot_file
-  = do	{ dflags <- getDOpts
-	; ioToIOEnv $ do
-	{ res <- tryMost (readBinIface file_path)
-	; case res of
-	    Right iface 
-		| wanted_mod == actual_mod -> return (Succeeded iface)
-		| otherwise	  	   -> return (Failed err)
-		where
-		  actual_mod = mi_module iface
-		  err = hiModuleNameMismatchWarn wanted_mod actual_mod
-
-	    Left exn    -> return (Failed (text (showException exn)))
-    }}
-\end{code}
-
-
-%*********************************************************
-%*						 	 *
-	Wired-in interface for GHC.Prim
-%*							 *
-%*********************************************************
-
-\begin{code}
-initExternalPackageState :: ExternalPackageState
-initExternalPackageState
-  = EPS { 
-      eps_is_boot    = emptyModuleEnv,
-      eps_PIT        = emptyPackageIfaceTable,
-      eps_PTE        = emptyTypeEnv,
-      eps_inst_env   = emptyInstEnv,
-      eps_rule_base  = mkRuleBase builtinRules,
-	-- Initialise the EPS rule pool with the built-in rules
-      eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
-			   , n_insts_in = 0, n_insts_out = 0
-			   , n_rules_in = length builtinRules, n_rules_out = 0 }
-    }
-\end{code}
-
-
-%*********************************************************
-%*						 	 *
-	Wired-in interface for GHC.Prim
-%*							 *
-%*********************************************************
-
-\begin{code}
-ghcPrimIface :: ModIface
-ghcPrimIface
-  = (emptyModIface HomePackage gHC_PRIM) {
-	mi_exports  = [(gHC_PRIM, ghcPrimExports)],
-	mi_decls    = [],
-	mi_fixities = fixities,
-	mi_fix_fn  = mkIfaceFixCache fixities
-    }		
-  where
-    fixities = [(getOccName seqId, Fixity 0 InfixR)]
-			-- seq is infixr 0
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{Statistics}
-%*							*
-%*********************************************************
-
-\begin{code}
-ifaceStats :: ExternalPackageState -> SDoc
-ifaceStats eps 
-  = hcat [text "Renamer stats: ", msg]
-  where
-    stats = eps_stats eps
-    msg = vcat 
-    	[int (n_ifaces_in stats) <+> text "interfaces read",
-    	 hsep [ int (n_decls_out stats), text "type/class/variable imported, out of", 
-    	        int (n_decls_in stats), text "read"],
-    	 hsep [ int (n_insts_out stats), text "instance decls imported, out of",  
-    	        int (n_insts_in stats), text "read"],
-    	 hsep [ int (n_rules_out stats), text "rule decls imported, out of",  
-    	        int (n_rules_in stats), text "read"]
-	]
-\end{code}    
-
-
-%*********************************************************
-%*						 	 *
-\subsection{Errors}
-%*							 *
-%*********************************************************
-
-\begin{code}
-badIfaceFile file err
-  = vcat [ptext SLIT("Bad interface file:") <+> text file, 
-	  nest 4 err]
-
-hiModuleNameMismatchWarn :: Module -> Module -> Message
-hiModuleNameMismatchWarn requested_mod read_mod = 
-    hsep [ ptext SLIT("Something is amiss; requested module name")
-	 , ppr requested_mod
-	 , ptext SLIT("differs from name found in the interface file")
-   	 , ppr read_mod
-  	 ]
-
-wrongIfaceModErr iface mod_name file_path 
-  = sep [ptext SLIT("Interface file") <+> iface_file,
-         ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
-         ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
-	 sep [ptext SLIT("Probable cause: the source code which generated"),
-	     nest 2 iface_file,
-	     ptext SLIT("has an incompatible module name")
-	    ]
-	]
-  where iface_file = doubleQuotes (text file_path)
-\end{code}
diff --git a/ghc/compiler/iface/MkIface.lhs b/ghc/compiler/iface/MkIface.lhs
deleted file mode 100644
index cafb6b6692..0000000000
--- a/ghc/compiler/iface/MkIface.lhs
+++ /dev/null
@@ -1,1066 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-
-\begin{code}
-module MkIface ( 
-	pprModIface, showIface, 	-- Print the iface in Foo.hi
-
-	mkUsageInfo, 	-- Construct the usage info for a module
-
-	mkIface, 	-- Build a ModIface from a ModGuts, 
-			-- including computing version information
-
-	writeIfaceFile,	-- Write the interface file
-
-	checkOldIface	-- See if recompilation is required, by
-			-- comparing version information
- ) where
-\end{code}
-
-	-----------------------------------------------
-		MkIface.lhs deals with versioning
-	-----------------------------------------------
-
-Here's the version-related info in an interface file
-
-  module Foo 8		-- module-version 
-	     3		-- export-list-version
-	     2		-- rule-version
-    Usages: 	-- Version info for what this compilation of Foo imported
-	Baz 3		-- Module version
-	    [4]		-- The export-list version if Foo depended on it
-	    (g,2)	-- Function and its version
-	    (T,1)	-- Type and its version
-
-    <version> f :: Int -> Int {- Unfolding: \x -> Wib.t[2] x -}
-		-- The [2] says that f's unfolding 
-		-- mentions verison 2 of Wib.t
-	
-	-----------------------------------------------
-			Basic idea
-	-----------------------------------------------
-
-Basic idea: 
-  * In the mi_usages information in an interface, we record the 
-    version number of each free variable of the module
-
-  * In mkIface, we compute the version number of each exported thing A.f
-    by comparing its A.f's info with its new info, and bumping its 
-    version number if it differs.  If A.f mentions B.g, and B.g's version
-    number has changed, then we count A.f as having changed too.
-
-  * In checkOldIface we compare the mi_usages for the module with
-    the actual version info for all each thing recorded in mi_usages
-
-
-Fixities
-~~~~~~~~
-We count A.f as changing if its fixity changes
-
-Rules
-~~~~~
-If a rule changes, we want to recompile any module that might be
-affected by that rule.  For non-orphan rules, this is relatively easy.
-If module M defines f, and a rule for f, just arrange that the version
-number for M.f changes if any of the rules for M.f change.  Any module
-that does not depend on M.f can't be affected by the rule-change
-either.
-
-Orphan rules (ones whose 'head function' is not defined in M) are
-harder.  Here's what we do.
-
-  * We have a per-module orphan-rule version number which changes if 
-    any orphan rule changes. (It's unaffected by non-orphan rules.)
-
-  * We record usage info for any orphan module 'below' this one,
-    giving the orphan-rule version number.  We recompile if this 
-    changes. 
-
-The net effect is that if an orphan rule changes, we recompile every
-module above it.  That's very conservative, but it's devilishly hard
-to know what it might affect, so we just have to be conservative.
-
-Instance decls
-~~~~~~~~~~~~~~
-In an iface file we have
-     module A where
-	instance Eq a => Eq [a]  =  dfun29
-	dfun29 :: ... 
-
-We have a version number for dfun29, covering its unfolding
-etc. Suppose we are compiling a module M that imports A only
-indirectly.  If typechecking M uses this instance decl, we record the
-dependency on A.dfun29 as if it were a free variable of the module
-(via the tcg_inst_usages accumulator).  That means that A will appear
-in M's usage list.  If the shape of the instance declaration changes,
-then so will dfun29's version, triggering a recompilation.
-
-Adding an instance declaration, or changing an instance decl that is
-not currently used, is more tricky.  (This really only makes a
-difference when we have overlapping instance decls, because then the
-new instance decl might kick in to override the old one.)  We handle
-this in a very similar way that we handle rules above.
-
-  * For non-orphan instance decls, identify one locally-defined tycon/class
-    mentioned in the decl.  Treat the instance decl as part of the defn of that
-    tycon/class, so that if the shape of the instance decl changes, so does the
-    tycon/class; that in turn will force recompilation of anything that uses
-    that tycon/class.
-
-  * For orphan instance decls, act the same way as for orphan rules.
-    Indeed, we use the same global orphan-rule version number.
-
-mkUsageInfo
-~~~~~~~~~~~
-mkUsageInfo figures out what the ``usage information'' for this
-moudule is; that is, what it must record in its interface file as the
-things it uses.  
-
-We produce a line for every module B below the module, A, currently being
-compiled:
-	import B <n> ;
-to record the fact that A does import B indirectly.  This is used to decide
-to look to look for B.hi rather than B.hi-boot when compiling a module that
-imports A.  This line says that A imports B, but uses nothing in it.
-So we'll get an early bale-out when compiling A if B's version changes.
-
-The usage information records:
-
-\begin{itemize}
-\item	(a) anything reachable from its body code
-\item	(b) any module exported with a @module Foo@
-\item   (c) anything reachable from an exported item
-\end{itemize}
-
-Why (b)?  Because if @Foo@ changes then this module's export list
-will change, so we must recompile this module at least as far as
-making a new interface file --- but in practice that means complete
-recompilation.
-
-Why (c)?  Consider this:
-\begin{verbatim}
-	module A( f, g ) where	|	module B( f ) where
-	  import B( f )		|	  f = h 3
-	  g = ...		|	  h = ...
-\end{verbatim}
-
-Here, @B.f@ isn't used in A.  Should we nevertheless record @B.f@ in
-@A@'s usages?  Our idea is that we aren't going to touch A.hi if it is
-*identical* to what it was before.  If anything about @B.f@ changes
-than anyone who imports @A@ should be recompiled in case they use
-@B.f@ (they'll get an early exit if they don't).  So, if anything
-about @B.f@ changes we'd better make sure that something in A.hi
-changes, and the convenient way to do that is to record the version
-number @B.f@ in A.hi in the usage list.  If B.f changes that'll force a
-complete recompiation of A, which is overkill but it's the only way to 
-write a new, slightly different, A.hi.
-
-But the example is tricker.  Even if @B.f@ doesn't change at all,
-@B.h@ may do so, and this change may not be reflected in @f@'s version
-number.  But with -O, a module that imports A must be recompiled if
-@B.h@ changes!  So A must record a dependency on @B.h@.  So we treat
-the occurrence of @B.f@ in the export list *just as if* it were in the
-code of A, and thereby haul in all the stuff reachable from it.
-
-	*** Conclusion: if A mentions B.f in its export list,
-	    behave just as if A mentioned B.f in its source code,
-	    and slurp in B.f and all its transitive closure ***
-
-[NB: If B was compiled with -O, but A isn't, we should really *still*
-haul in all the unfoldings for B, in case the module that imports A *is*
-compiled with -O.  I think this is the case.]
-
-
-\begin{code}
-#include "HsVersions.h"
-
-import HsSyn
-import Packages		( isHomeModule, PackageIdH(..) )
-import IfaceSyn		( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..),
-			  IfaceRule(..), IfaceInst(..), IfaceExtName(..), 
-			  eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool, 
-			  eqMaybeBy, eqListBy, visibleIfConDecls,
-			  tyThingToIfaceDecl, instanceToIfaceInst, coreRuleToIfaceRule )
-import LoadIface	( readIface, loadInterface )
-import BasicTypes	( Version, initialVersion, bumpVersion )
-import TcRnMonad
-import HscTypes		( ModIface(..), ModDetails(..), 
-			  ModGuts(..), IfaceExport,
-			  HscEnv(..), hscEPS, Dependencies(..), FixItem(..), 
-			  ModSummary(..), msHiFilePath, 
-			  mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
-			  typeEnvElts, 
-			  GenAvailInfo(..), availName, 
-			  ExternalPackageState(..),
-			  Usage(..), IsBootInterface,
-			  Deprecs(..), IfaceDeprecs, Deprecations,
-			  lookupIfaceByModule
-			)
-
-
-import Packages		( HomeModules )
-import DynFlags		( GhcMode(..), DynFlags(..), DynFlag(..), dopt )
-import StaticFlags	( opt_HiVersion )
-import Name		( Name, nameModule, nameOccName, nameParent,
-			  isExternalName, isInternalName, nameParent_maybe, isWiredInName,
-			  isImplicitName, NamedThing(..) )
-import NameEnv
-import NameSet
-import OccName		( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
-			  extendOccEnv_C,
-			  OccSet, emptyOccSet, elemOccSet, occSetElts, 
-			  extendOccSet, extendOccSetList,
-			  isEmptyOccSet, intersectOccSet, intersectsOccSet,
-			  occNameFS, isTcOcc )
-import Module		( Module, moduleFS,
-			  ModLocation(..), mkModuleFS, moduleString,
-			  ModuleEnv, emptyModuleEnv, lookupModuleEnv,
-			  extendModuleEnv_C
-			)
-import Outputable
-import Util		( createDirectoryHierarchy, directoryOf )
-import Util		( sortLe, seqList )
-import Binary		( getBinFileWithDict )
-import BinIface		( writeBinIface, v_IgnoreHiWay )
-import Unique		( Unique, Uniquable(..) )
-import ErrUtils		( dumpIfSet_dyn, showPass )
-import Digraph		( stronglyConnComp, SCC(..) )
-import SrcLoc		( SrcSpan )
-import FiniteMap
-import FastString
-
-import DATA_IOREF	( writeIORef )
-import Monad		( when )
-import List		( insert )
-import Maybes		( orElse, mapCatMaybes, isNothing, isJust, 
-			  expectJust, MaybeErr(..) )
-\end{code}
-
-
-
-%************************************************************************
-%*				 					*
-\subsection{Completing an interface}
-%*				 					*
-%************************************************************************
-
-\begin{code}
-mkIface :: HscEnv
-	-> Maybe ModIface	-- The old interface, if we have it
-	-> ModGuts		-- Usages, deprecations, etc
-	-> ModDetails		-- The trimmed, tidied interface
-	-> IO (ModIface, 	-- The new one, complete with decls and versions
-	       Bool)		-- True <=> there was an old Iface, and the new one
-				--	    is identical, so no need to write it
-
-mkIface hsc_env maybe_old_iface 
-	(ModGuts{     mg_module  = this_mod,
-		      mg_boot    = is_boot,
-		      mg_usages  = usages,
-		      mg_deps    = deps,
-		      mg_home_mods = home_mods,
-		      mg_rdr_env = rdr_env,
-		      mg_fix_env = fix_env,
-		      mg_deprecs = src_deprecs })
-	(ModDetails{  md_insts 	 = insts, 
-		      md_rules 	 = rules,
-		      md_types 	 = type_env,
-		      md_exports = exports })
-	
--- NB:	notice that mkIface does not look at the bindings
---	only at the TypeEnv.  The previous Tidy phase has
---	put exactly the info into the TypeEnv that we want
---	to expose in the interface
-
-  = do	{ eps <- hscEPS hsc_env
-	; let	{ ext_nm_rhs = mkExtNameFn hsc_env home_mods eps this_mod
-		; ext_nm_lhs = mkLhsNameFn this_mod
-
-		; decls  = [ tyThingToIfaceDecl ext_nm_rhs thing 
-			   | thing <- typeEnvElts type_env, 
-			     not (isImplicitName (getName thing)) ]
-		    	-- Don't put implicit Ids and class tycons in the interface file
-
-		; fixities    = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
-		; deprecs     = mkIfaceDeprec src_deprecs
-		; iface_rules = map (coreRuleToIfaceRule ext_nm_lhs ext_nm_rhs) rules
-		; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts
-
-	        ; intermediate_iface = ModIface { 
-			mi_module   = this_mod,
-			mi_package  = HomePackage,
-			mi_boot     = is_boot,
-			mi_deps     = deps,
-			mi_usages   = usages,
-			mi_exports  = mkIfaceExports exports,
-			mi_insts    = sortLe le_inst iface_insts,
-			mi_rules    = sortLe le_rule iface_rules,
-			mi_fixities = fixities,
-			mi_deprecs  = deprecs,
-			mi_globals  = Just rdr_env,
-
-			-- Left out deliberately: filled in by addVersionInfo
-			mi_mod_vers  = initialVersion,
- 			mi_exp_vers  = initialVersion,
- 			mi_rule_vers = initialVersion,
-			mi_orphan    = False,	-- Always set by addVersionInfo, but
-						-- it's a strict field, so we can't omit it.
-			mi_decls     = deliberatelyOmitted "decls",
-			mi_ver_fn    = deliberatelyOmitted "ver_fn",
-
-			-- And build the cached values
-			mi_dep_fn = mkIfaceDepCache deprecs,
-			mi_fix_fn = mkIfaceFixCache fixities }
-
-		-- Add version information
-		; (new_iface, no_change_at_all, pp_diffs, pp_orphs) 
-			= _scc_ "versioninfo" 
-			 addVersionInfo maybe_old_iface intermediate_iface decls
-		}
-
-		-- Debug printing
-	; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags) 
-	       (printDump (expectJust "mkIface" pp_orphs))
-	; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
-	; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE" 
-			(pprModIface new_iface)
-
-	; return (new_iface, no_change_at_all) }
-  where
-     r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
-     i1 `le_inst` i2 = ifDFun     i1 <= ifDFun     i2
-
-     dflags = hsc_dflags hsc_env
-     deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
-
-					      
------------------------------
-writeIfaceFile :: ModLocation -> ModIface -> IO ()
-writeIfaceFile location new_iface
-    = do createDirectoryHierarchy (directoryOf hi_file_path)
-         writeBinIface hi_file_path new_iface
-    where hi_file_path = ml_hi_file location
-
-
------------------------------
-mkExtNameFn :: HscEnv -> HomeModules -> ExternalPackageState -> Module -> Name -> IfaceExtName
-mkExtNameFn hsc_env hmods eps this_mod
-  = ext_nm
-  where
-    hpt = hsc_HPT hsc_env
-    pit = eps_PIT eps
-
-    ext_nm name 
-      | mod == this_mod = case nameParent_maybe name of
-    				Nothing  -> LocalTop occ
-    				Just par -> LocalTopSub occ (nameOccName par)
-      | isWiredInName name       = ExtPkg  mod occ
-      | isHomeModule hmods mod   = HomePkg mod occ vers
-      | otherwise	         = ExtPkg  mod occ
-      where
-    	mod      = nameModule name
-    	occ	 = nameOccName name
-    	par_occ  = nameOccName (nameParent name)
-    		-- The version of the *parent* is the one want
-    	vers     = lookupVersion mod par_occ
-    	      
-    lookupVersion :: Module -> OccName -> Version
-	-- Even though we're looking up a home-package thing, in
-	-- one-shot mode the imported interfaces may be in the PIT
-    lookupVersion mod occ
-      = mi_ver_fn iface occ `orElse` 
-        pprPanic "lookupVers1" (ppr mod <+> ppr occ)
-      where
-        iface = lookupIfaceByModule hpt pit mod `orElse` 
-	        pprPanic "lookupVers2" (ppr mod <+> ppr occ)
-
-
----------------------
--- mkLhsNameFn ignores versioning info altogether
--- It is used for the LHS of instance decls and rules, where we 
--- there's no point in recording version info
-mkLhsNameFn :: Module -> Name -> IfaceExtName
-mkLhsNameFn this_mod name	
-  | isInternalName name = pprTrace "mkLhsNameFn: unexpected internal" (ppr name) $
-			  LocalTop occ	-- Should not happen
-  | mod == this_mod = LocalTop occ
-  | otherwise	    = ExtPkg mod occ
-  where
-    mod = nameModule name
-    occ	= nameOccName name
-
-
------------------------------
--- Compute version numbers for local decls
-
-addVersionInfo :: Maybe ModIface	-- The old interface, read from M.hi
-	       -> ModIface		-- The new interface decls (lacking decls)
-	       -> [IfaceDecl]		-- The new decls
-	       -> (ModIface, 
-		   Bool,		-- True <=> no changes at all; no need to write new Iface
-		   SDoc,		-- Differences
-		   Maybe SDoc)		-- Warnings about orphans
-
-addVersionInfo Nothing new_iface new_decls
--- No old interface, so definitely write a new one!
-  = (new_iface { mi_orphan = anyNothing ifInstOrph (mi_insts new_iface)
-			  || anyNothing ifRuleOrph (mi_rules new_iface),
-		 mi_decls  = [(initialVersion, decl) | decl <- new_decls],
-		 mi_ver_fn = \n -> Just initialVersion },
-     False, 
-     ptext SLIT("No old interface file"),
-     pprOrphans orph_insts orph_rules)
-  where
-    orph_insts = filter (isNothing . ifInstOrph) (mi_insts new_iface)
-    orph_rules = filter (isNothing . ifRuleOrph) (mi_rules new_iface)
-
-addVersionInfo (Just old_iface@(ModIface { mi_mod_vers  = old_mod_vers, 
-					   mi_exp_vers  = old_exp_vers, 
-					   mi_rule_vers = old_rule_vers, 
-				       	   mi_decls     = old_decls,
-					   mi_ver_fn    = old_decl_vers,
-				       	   mi_fix_fn    = old_fixities }))
-	       new_iface@(ModIface { mi_fix_fn = new_fixities })
-	       new_decls
-
-  | no_change_at_all = (old_iface,   True,  ptext SLIT("Interface file unchanged"), pp_orphs)
-  | otherwise	     = (final_iface, False, vcat [ptext SLIT("Interface file has changed"),
-						  nest 2 pp_diffs], pp_orphs)
-  where
-    final_iface = new_iface { mi_mod_vers  = bump_unless no_output_change old_mod_vers,
-			      mi_exp_vers  = bump_unless no_export_change old_exp_vers,
-			      mi_rule_vers = bump_unless no_rule_change   old_rule_vers,
-			      mi_orphan    = not (null new_orph_rules && null new_orph_insts),
-			      mi_decls     = decls_w_vers,
-			      mi_ver_fn    = mkIfaceVerCache decls_w_vers }
-
-    decls_w_vers = [(add_vers decl, decl) | decl <- new_decls]
-
-    -------------------
-    (old_non_orph_insts, old_orph_insts) = mkOrphMap ifInstOrph (mi_insts old_iface)
-    (new_non_orph_insts, new_orph_insts) = mkOrphMap ifInstOrph (mi_insts new_iface)
-    same_insts occ = eqMaybeBy	(eqListBy eqIfInst) 
-				(lookupOccEnv old_non_orph_insts occ)
-				(lookupOccEnv new_non_orph_insts occ)
-  
-    (old_non_orph_rules, old_orph_rules) = mkOrphMap ifRuleOrph (mi_rules old_iface)
-    (new_non_orph_rules, new_orph_rules) = mkOrphMap ifRuleOrph (mi_rules new_iface)
-    same_rules occ = eqMaybeBy	(eqListBy eqIfRule)
-				(lookupOccEnv old_non_orph_rules occ)
-				(lookupOccEnv new_non_orph_rules occ)
-    -------------------
-    -- Computing what changed
-    no_output_change = no_decl_change   && no_rule_change && 
-    		       no_export_change && no_deprec_change
-    no_export_change = mi_exports new_iface == mi_exports old_iface	-- Kept sorted
-    no_decl_change   = isEmptyOccSet changed_occs
-    no_rule_change   = not (changedWrt changed_occs (eqListBy eqIfRule old_orph_rules new_orph_rules)
-	    		 || changedWrt changed_occs (eqListBy eqIfInst old_orph_insts new_orph_insts))
-    no_deprec_change = mi_deprecs new_iface == mi_deprecs old_iface
-
-	-- If the usages havn't changed either, we don't need to write the interface file
-    no_other_changes = mi_usages new_iface == mi_usages old_iface && 
-		       mi_deps new_iface == mi_deps old_iface
-    no_change_at_all = no_output_change && no_other_changes
- 
-    pp_diffs = vcat [pp_change no_export_change "Export list" 
-			(ppr old_exp_vers <+> arrow <+> ppr (mi_exp_vers final_iface)),
- 		     pp_change no_rule_change "Rules"
-			(ppr old_rule_vers <+> arrow <+> ppr (mi_rule_vers final_iface)),
- 		     pp_change no_deprec_change "Deprecations" empty,
- 		     pp_change no_other_changes  "Usages" empty,
-		     pp_decl_diffs]
-    pp_change True  what info = empty
-    pp_change False what info = text what <+> ptext SLIT("changed") <+> info
-
-    -------------------
-    old_decl_env = mkOccEnv [(ifName decl, decl) | (_,decl) <- old_decls]
-    same_fixity n = bool (old_fixities n == new_fixities n)
-
-    -------------------
-    -- Adding version info
-    new_version     = bumpVersion old_mod_vers
-    add_vers decl | occ `elemOccSet` changed_occs = new_version
-		  | otherwise = expectJust "add_vers" (old_decl_vers occ)
-				-- If it's unchanged, there jolly well 
-		  where		-- should be an old version number
-		    occ = ifName decl
-
-    -------------------
-    changed_occs :: OccSet
-    changed_occs = computeChangedOccs eq_info
-
-    eq_info :: [(OccName, IfaceEq)]
-    eq_info = map check_eq new_decls
-    check_eq new_decl | Just old_decl <- lookupOccEnv old_decl_env occ 
-		      = (occ, new_decl `eqIfDecl` old_decl &&&
-			      eq_indirects new_decl)
-		      | otherwise {- No corresponding old decl -}      
-		      = (occ, NotEqual)	
-		      where
-			occ = ifName new_decl
-
-    eq_indirects :: IfaceDecl -> IfaceEq
-		-- When seeing if two decls are the same, remember to
-		-- check whether any relevant fixity or rules have changed
-    eq_indirects (IfaceId {ifName = occ}) = eq_ind_occ occ
-    eq_indirects (IfaceClass {ifName = cls_occ, ifSigs = sigs})
-	= same_insts cls_occ &&& 
-	  eq_ind_occs [op | IfaceClassOp op _ _ <- sigs] 
-    eq_indirects (IfaceData {ifName = tc_occ, ifCons = cons})
-	= same_insts tc_occ &&& same_fixity tc_occ &&&	-- The TyCon can have a fixity too
-	  eq_ind_occs (map ifConOcc (visibleIfConDecls cons))
-    eq_indirects other = Equal	-- Synonyms and foreign declarations
-
-    eq_ind_occ :: OccName -> IfaceEq	-- For class ops and Ids; check fixity and rules
-    eq_ind_occ occ = same_fixity occ &&& same_rules occ
-    eq_ind_occs = foldr ((&&&) . eq_ind_occ) Equal 
-   
-    -------------------
-    -- Diffs
-    pp_decl_diffs :: SDoc	-- Nothing => no changes
-    pp_decl_diffs 
-	| isEmptyOccSet changed_occs = empty
-	| otherwise 
-	= vcat [ptext SLIT("Changed occs:") <+> ppr (occSetElts changed_occs),
-		ptext SLIT("Version change for these decls:"),
-		nest 2 (vcat (map show_change new_decls))]
-
-    eq_env = mkOccEnv eq_info
-    show_change new_decl
-	| not (occ `elemOccSet` changed_occs) = empty
-	| otherwise
-	= vcat [ppr occ <+> ppr (old_decl_vers occ) <+> arrow <+> ppr new_version, 
-		nest 2 why]
-	where
-	  occ = ifName new_decl
-	  why = case lookupOccEnv eq_env occ of
-		    Just (EqBut occs) -> sep [ppr occ <> colon, ptext SLIT("Free vars (only) changed:"),
-					      nest 2 (braces (fsep (map ppr (occSetElts 
-						(occs `intersectOccSet` changed_occs)))))]
-		    Just NotEqual  
-			| Just old_decl <- lookupOccEnv old_decl_env occ 
-			-> vcat [ptext SLIT("Old:") <+> ppr old_decl,
-			 ptext SLIT("New:") <+> ppr new_decl]
-			| otherwise 
-			-> ppr occ <+> ptext SLIT("only in new interface")
-		    other -> pprPanic "MkIface.show_change" (ppr occ)
-	
-    pp_orphs = pprOrphans new_orph_insts new_orph_rules
-
-pprOrphans insts rules
-  | null insts && null rules = Nothing
-  | otherwise
-  = Just $ vcat [
-	if null insts then empty else
-	     hang (ptext SLIT("Warning: orphan instances:"))
-		2 (vcat (map ppr insts)),
-	if null rules then empty else
-	     hang (ptext SLIT("Warning: orphan rules:"))
-		2 (vcat (map ppr rules))
-    ]
-
-computeChangedOccs :: [(OccName, IfaceEq)] -> OccSet
-computeChangedOccs eq_info
-  = foldl add_changes emptyOccSet (stronglyConnComp edges)
-  where
-    edges :: [((OccName,IfaceEq), Unique, [Unique])]
-    edges = [ (node, getUnique occ, map getUnique occs)
-	    | node@(occ, iface_eq) <- eq_info
-	    , let occs = case iface_eq of
-			   EqBut occ_set -> occSetElts occ_set
-			   other -> [] ]
-
-    -- Changes in declarations
-    add_changes :: OccSet -> SCC (OccName, IfaceEq) -> OccSet
-    add_changes so_far (AcyclicSCC (occ, iface_eq)) 
-	| changedWrt so_far iface_eq 				-- This one has changed
-	= extendOccSet so_far occ
-    add_changes so_far (CyclicSCC pairs)
-	| changedWrt so_far (foldr1 (&&&) (map snd pairs)) 	-- One of this group has changed
-	= extendOccSetList so_far (map fst pairs)
-    add_changes so_far other = so_far
-
-changedWrt :: OccSet -> IfaceEq -> Bool
-changedWrt so_far Equal        = False
-changedWrt so_far NotEqual     = True
-changedWrt so_far (EqBut kids) = so_far `intersectsOccSet` kids
-
-----------------------
--- mkOrphMap partitions instance decls or rules into
--- 	(a) an OccEnv for ones that are not orphans, 
---	    mapping the local OccName to a list of its decls
---	(b) a list of orphan decls
-mkOrphMap :: (decl -> Maybe OccName)	-- (Just occ) for a non-orphan decl, keyed by occ
-					-- Nothing for an orphan decl
-	  -> [decl] 			-- Sorted into canonical order
-	  -> (OccEnv [decl],	 	-- Non-orphan decls associated with their key;
-					--	each sublist in canonical order
-	      [decl])			-- Orphan decls; in canonical order
-mkOrphMap get_key decls
-  = foldl go (emptyOccEnv, []) decls
-  where
-    go (non_orphs, orphs) d
-	| Just occ <- get_key d
-	= (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
-	| otherwise = (non_orphs, d:orphs)
-
-anyNothing :: (a -> Maybe b) -> [a] -> Bool
-anyNothing p []     = False
-anyNothing p (x:xs) = isNothing (p x) || anyNothing p xs
-
-----------------------
-mkIfaceDeprec :: Deprecations -> IfaceDeprecs
-mkIfaceDeprec NoDeprecs        = NoDeprecs
-mkIfaceDeprec (DeprecAll t)    = DeprecAll t
-mkIfaceDeprec (DeprecSome env) = DeprecSome (sortLe (<=) (nameEnvElts env))
-
-----------------------
-bump_unless :: Bool -> Version -> Version
-bump_unless True  v = v	-- True <=> no change
-bump_unless False v = bumpVersion v
-\end{code}
-
-
-%*********************************************************
-%*							*
-\subsection{Keeping track of what we've slurped, and version numbers}
-%*							*
-%*********************************************************
-
-
-\begin{code}
-mkUsageInfo :: HscEnv 
-	    -> HomeModules
-	    -> ModuleEnv (Module, Bool, SrcSpan)
-	    -> [(Module, IsBootInterface)]
-	    -> NameSet -> IO [Usage]
-mkUsageInfo hsc_env hmods dir_imp_mods dep_mods used_names
-  = do	{ eps <- hscEPS hsc_env
-	; let usages = mk_usage_info (eps_PIT eps) hsc_env hmods
-				     dir_imp_mods dep_mods used_names
-	; usages `seqList`  return usages }
-	 -- seq the list of Usages returned: occasionally these
-	 -- don't get evaluated for a while and we can end up hanging on to
-	 -- the entire collection of Ifaces.
-
-mk_usage_info pit hsc_env hmods dir_imp_mods dep_mods proto_used_names
-  = mapCatMaybes mkUsage dep_mods
-	-- ToDo: do we need to sort into canonical order?
-  where
-    hpt = hsc_HPT hsc_env
-
-    used_names = mkNameSet $			-- Eliminate duplicates
-		 [ nameParent n			-- Just record usage on the 'main' names
-		 | n <- nameSetToList proto_used_names
-		 , not (isWiredInName n)	-- Don't record usages for wired-in names
-		 , isExternalName n		-- Ignore internal names
-		 ]
-
-    -- ent_map groups together all the things imported and used
-    -- from a particular module in this package
-    ent_map :: ModuleEnv [OccName]
-    ent_map  = foldNameSet add_mv emptyModuleEnv used_names
-    add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [occ]
-    		   where
-		     occ = nameOccName name
-    		     mod = nameModule name
-    		     add_item occs _ = occ:occs
-    
-    depend_on_exports mod = case lookupModuleEnv dir_imp_mods mod of
-    				Just (_,no_imp,_) -> not no_imp
-	    			Nothing		  -> True
-    
-    -- We want to create a Usage for a home module if 
-    --	a) we used something from; has something in used_names
-    --	b) we imported all of it, even if we used nothing from it
-    --		(need to recompile if its export list changes: export_vers)
-    --	c) is a home-package orphan module (need to recompile if its
-    --	 	instance decls change: rules_vers)
-    mkUsage :: (Module, Bool) -> Maybe Usage
-    mkUsage (mod_name, _)
-      |  isNothing maybe_iface	-- We can't depend on it if we didn't
-      || not (isHomeModule hmods mod)	-- even open the interface!
-      || (null used_occs
-	  && isNothing export_vers
-	  && not orphan_mod)
-      = Nothing			-- Record no usage info
-    
-      | otherwise	
-      = Just (Usage { usg_name     = mod,
-    	  	      usg_mod      = mod_vers,
-    		      usg_exports  = export_vers,
-    		      usg_entities = ent_vers,
-    		      usg_rules    = rules_vers })
-      where
-	maybe_iface  = lookupIfaceByModule hpt pit mod_name
-		-- In one-shot mode, the interfaces for home-package 
-		-- modules accumulate in the PIT not HPT.  Sigh.
-
-        Just iface   = maybe_iface
-        mod   	     = mi_module    iface
-	orphan_mod   = mi_orphan    iface
-        version_env  = mi_ver_fn    iface
-        mod_vers     = mi_mod_vers  iface
-        rules_vers   = mi_rule_vers iface
-        export_vers | depend_on_exports mod = Just (mi_exp_vers iface)
-    		    | otherwise 	    = Nothing
-    
-    	-- The sort is to put them into canonical order
-        used_occs = lookupModuleEnv ent_map mod `orElse` []
-	ent_vers :: [(OccName,Version)]
-        ent_vers = [ (occ, version_env occ `orElse` initialVersion) 
-		   | occ <- sortLe (<=) used_occs]
-\end{code}
-
-\begin{code}
-mkIfaceExports :: NameSet -> [(Module, [GenAvailInfo OccName])]
-  -- Group by module and sort by occurrence
-  -- This keeps the list in canonical order
-mkIfaceExports exports 
-  = [ (mkModuleFS fs, eltsFM avails)
-    | (fs, avails) <- fmToList groupFM
-    ]
-  where
-    groupFM :: FiniteMap FastString (FiniteMap FastString (GenAvailInfo OccName))
-	-- Deliberately use the FastString so we
-	-- get a canonical ordering
-    groupFM = foldl add emptyFM (nameSetToList exports)
-
-    add env name = addToFM_C add_avail env mod_fs 
-			     (unitFM avail_fs avail)
-      where
-	occ    = nameOccName name
-	mod_fs = moduleFS (nameModule name)
-	avail | Just p <- nameParent_maybe name	= AvailTC (nameOccName p) [occ]
-	      | isTcOcc occ 			= AvailTC occ [occ]
-	      | otherwise			= Avail occ
-	avail_fs = occNameFS (availName avail)	    
-	add_avail avail_fm _ = addToFM_C add_item avail_fm avail_fs avail
-
-	add_item (AvailTC p occs) _ = AvailTC p (List.insert occ occs)
-	add_item (Avail n)	  _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name)
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Load the old interface file for this module (unless
-	we have it aleady), and check whether it is up to date
-	
-%*									*
-%************************************************************************
-
-\begin{code}
-checkOldIface :: HscEnv
-	      -> ModSummary
-	      -> Bool 			-- Source unchanged
-	      -> Maybe ModIface 	-- Old interface from compilation manager, if any
-	      -> IO (RecompileRequired, Maybe ModIface)
-
-checkOldIface hsc_env mod_summary source_unchanged maybe_iface
-  = do	{ showPass (hsc_dflags hsc_env) 
-	           ("Checking old interface for " ++ moduleString (ms_mod mod_summary)) ;
-
-	; initIfaceCheck hsc_env $
-	  check_old_iface mod_summary source_unchanged maybe_iface
-     }
-
-check_old_iface mod_summary source_unchanged maybe_iface
- = 	-- CHECK WHETHER THE SOURCE HAS CHANGED
-    ifM (not source_unchanged)
-	(traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
-					      	`thenM_`
-
-     -- If the source has changed and we're in interactive mode, avoid reading
-     -- an interface; just return the one we might have been supplied with.
-    getGhcMode					`thenM` \ ghc_mode ->
-    if (ghc_mode == Interactive || ghc_mode == JustTypecheck) 
-	&& not source_unchanged then
-         returnM (outOfDate, maybe_iface)
-    else
-
-    case maybe_iface of {
-       Just old_iface -> -- Use the one we already have
-                         checkVersions source_unchanged old_iface	`thenM` \ recomp ->
-			 returnM (recomp, Just old_iface)
-
-    ;  Nothing ->
-
-	-- Try and read the old interface for the current module
-	-- from the .hi file left from the last time we compiled it
-    let
-	iface_path = msHiFilePath mod_summary
-    in
-    readIface (ms_mod mod_summary) iface_path False	`thenM` \ read_result ->
-    case read_result of {
-       Failed err ->	-- Old interface file not found, or garbled; give up
-		   traceIf (text "FYI: cannot read old interface file:"
-			   	 $$ nest 4 err) 	`thenM_`
-	           returnM (outOfDate, Nothing)
-
-    ;  Succeeded iface ->	
-
-	-- We have got the old iface; check its versions
-    checkVersions source_unchanged iface	`thenM` \ recomp ->
-    returnM (recomp, Just iface)
-    }}
-\end{code}
-
-@recompileRequired@ is called from the HscMain.   It checks whether
-a recompilation is required.  It needs access to the persistent state,
-finder, etc, because it may have to load lots of interface files to
-check their versions.
-
-\begin{code}
-type RecompileRequired = Bool
-upToDate  = False	-- Recompile not required
-outOfDate = True	-- Recompile required
-
-checkVersions :: Bool		-- True <=> source unchanged
-	      -> ModIface 	-- Old interface
-	      -> IfG RecompileRequired
-checkVersions source_unchanged iface
-  | not source_unchanged
-  = returnM outOfDate
-  | otherwise
-  = do	{ traceHiDiffs (text "Considering whether compilation is required for" <+> 
-		        ppr (mi_module iface) <> colon)
-
-	-- Source code unchanged and no errors yet... carry on 
-
-	-- First put the dependent-module info, read from the old interface, into the envt, 
-	-- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
-	-- 
-	-- It's just temporary because either the usage check will succeed 
-	-- (in which case we are done with this module) or it'll fail (in which
-	-- case we'll compile the module from scratch anyhow).
-	--	
-	-- We do this regardless of compilation mode
-	; updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
-
-	; checkList [checkModUsage u | u <- mi_usages iface]
-    }
-  where
-	-- This is a bit of a hack really
-    mod_deps :: ModuleEnv (Module, IsBootInterface)
-    mod_deps = mkModDeps (dep_mods (mi_deps iface))
-
-checkModUsage :: Usage -> IfG RecompileRequired
--- Given the usage information extracted from the old
--- M.hi file for the module being compiled, figure out
--- whether M needs to be recompiled.
-
-checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
-		       usg_rules = old_rule_vers,
-		       usg_exports = maybe_old_export_vers, 
-		       usg_entities = old_decl_vers })
-  = 	-- Load the imported interface is possible
-    let
-    	doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
-    in
-    traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_`
-
-    loadInterface doc_str mod_name ImportBySystem	`thenM` \ mb_iface ->
-	-- Load the interface, but don't complain on failure;
-	-- Instead, get an Either back which we can test
-
-    case mb_iface of {
-	Failed exn ->  (out_of_date (sep [ptext SLIT("Can't find version number for module"), 
-				       ppr mod_name]));
-		-- Couldn't find or parse a module mentioned in the
-		-- old interface file.  Don't complain -- it might just be that
-		-- the current module doesn't need that import and it's been deleted
-
-	Succeeded iface -> 
-    let
-	new_mod_vers    = mi_mod_vers  iface
-	new_decl_vers 	= mi_ver_fn    iface
-	new_export_vers = mi_exp_vers  iface
-	new_rule_vers   = mi_rule_vers iface
-    in
-	-- CHECK MODULE
-    checkModuleVersion old_mod_vers new_mod_vers	`thenM` \ recompile ->
-    if not recompile then
-	returnM upToDate
-    else
-				 
-	-- CHECK EXPORT LIST
-    if checkExportList maybe_old_export_vers new_export_vers then
-	out_of_date_vers (ptext SLIT("  Export list changed"))
-		         (expectJust "checkModUsage" maybe_old_export_vers) 
-		         new_export_vers
-    else
-
-	-- CHECK RULES
-    if old_rule_vers /= new_rule_vers then
-	out_of_date_vers (ptext SLIT("  Rules changed")) 
-			 old_rule_vers new_rule_vers
-    else
-
-	-- CHECK ITEMS ONE BY ONE
-    checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers]	`thenM` \ recompile ->
-    if recompile then
-	returnM outOfDate	-- This one failed, so just bail out now
-    else
-	up_to_date (ptext SLIT("  Great!  The bits I use are up to date"))
-    }
-
-------------------------
-checkModuleVersion old_mod_vers new_mod_vers
-  | new_mod_vers == old_mod_vers
-  = up_to_date (ptext SLIT("Module version unchanged"))
-
-  | otherwise
-  = out_of_date_vers (ptext SLIT("  Module version has changed"))
-		     old_mod_vers new_mod_vers
-
-------------------------
-checkExportList Nothing  new_vers = upToDate
-checkExportList (Just v) new_vers = v /= new_vers
-
-------------------------
-checkEntityUsage new_vers (name,old_vers)
-  = case new_vers name of
-
-	Nothing       -> 	-- We used it before, but it ain't there now
-			  out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
-
-	Just new_vers 	-- It's there, but is it up to date?
-	  | new_vers == old_vers -> traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenM_`
-			  	    returnM upToDate
-	  | otherwise	 	 -> out_of_date_vers (ptext SLIT("  Out of date:") <+> ppr name)
-						     old_vers new_vers
-
-up_to_date  msg = traceHiDiffs msg `thenM_` returnM upToDate
-out_of_date msg = traceHiDiffs msg `thenM_` returnM outOfDate
-out_of_date_vers msg old_vers new_vers 
-  = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers])
-
-----------------------
-checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
--- This helper is used in two places
-checkList []		 = returnM upToDate
-checkList (check:checks) = check	`thenM` \ recompile ->
-			   if recompile then 
-				returnM outOfDate
-			   else
-				checkList checks
-\end{code}
-
-%************************************************************************
-%*				 					*
-		Printing interfaces
-%*				 					*
-%************************************************************************
-
-\begin{code}
-showIface :: FilePath -> IO ()
--- Read binary interface, and print it out
-showIface filename = do
-   -- skip the version check; we don't want to worry about profiled vs.
-   -- non-profiled interfaces, for example.
-   writeIORef v_IgnoreHiWay True
-   iface <- Binary.getBinFileWithDict filename
-   printDump (pprModIface iface)
- where
-\end{code}
-
-
-\begin{code}
-pprModIface :: ModIface -> SDoc
--- Show a ModIface
-pprModIface iface
- = vcat [ ptext SLIT("interface")
-		<+> ppr_package (mi_package iface)
-		<+> ppr (mi_module iface) <+> pp_boot 
-		<+> ppr (mi_mod_vers iface) <+> pp_sub_vers
-		<+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
-		<+> int opt_HiVersion
-		<+> ptext SLIT("where")
-	, vcat (map pprExport (mi_exports iface))
-	, pprDeps (mi_deps iface)
-	, vcat (map pprUsage (mi_usages iface))
-	, pprFixities (mi_fixities iface)
-	, vcat (map pprIfaceDecl (mi_decls iface))
-	, vcat (map ppr (mi_insts iface))
-	, vcat (map ppr (mi_rules iface))
-	, pprDeprecs (mi_deprecs iface)
-	]
-  where
-    pp_boot | mi_boot iface = ptext SLIT("[boot]")
-	    | otherwise     = empty
-    ppr_package HomePackage = empty
-    ppr_package (ExtPackage id) = doubleQuotes (ppr id)
-
-    exp_vers  = mi_exp_vers iface
-    rule_vers = mi_rule_vers iface
-
-    pp_sub_vers | exp_vers == initialVersion && rule_vers == initialVersion = empty
-		| otherwise = brackets (ppr exp_vers <+> ppr rule_vers)
-\end{code}
-
-When printing export lists, we print like this:
-	Avail   f		f
-	AvailTC C [C, x, y]	C(x,y)
-	AvailTC C [x, y]	C!(x,y)		-- Exporting x, y but not C
-
-\begin{code}
-pprExport :: IfaceExport -> SDoc
-pprExport (mod, items)
- = hsep [ ptext SLIT("export"), ppr mod, hsep (map pp_avail items) ]
-  where
-    pp_avail :: GenAvailInfo OccName -> SDoc
-    pp_avail (Avail occ)    = ppr occ
-    pp_avail (AvailTC _ []) = empty
-    pp_avail (AvailTC n (n':ns)) 
-	| n==n'     = ppr n <> pp_export ns
- 	| otherwise = ppr n <> char '|' <> pp_export (n':ns)
-    
-    pp_export []    = empty
-    pp_export names = braces (hsep (map ppr names))
-
-pprUsage :: Usage -> SDoc
-pprUsage usage
-  = hsep [ptext SLIT("import"), ppr (usg_name usage), 
-	  int (usg_mod usage), 
-	  pp_export_version (usg_exports usage),
-	  int (usg_rules usage),
-	  pp_versions (usg_entities usage) ]
-  where
-    pp_versions nvs = hsep [ ppr n <+> int v | (n,v) <- nvs ]
-    pp_export_version Nothing  = empty
-    pp_export_version (Just v) = int v
-
-pprDeps :: Dependencies -> SDoc
-pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs})
-  = vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods),
-	  ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs), 
-	  ptext SLIT("orphans:") <+> fsep (map ppr orphs)
-	]
-  where
-    ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
-    ppr_boot True  = text "[boot]"
-    ppr_boot False = empty
-
-pprIfaceDecl :: (Version, IfaceDecl) -> SDoc
-pprIfaceDecl (ver, decl)
-  = ppr_vers ver <+> ppr decl
-  where
-	-- Print the version for the decl
-    ppr_vers v | v == initialVersion = empty
-	       | otherwise	     = int v
-
-pprFixities :: [(OccName, Fixity)] -> SDoc
-pprFixities []    = empty
-pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes
-		  where
-		    pprFix (occ,fix) = ppr fix <+> ppr occ 
-
-pprDeprecs NoDeprecs	    = empty
-pprDeprecs (DeprecAll txt)  = ptext SLIT("Deprecate all") <+> doubleQuotes (ftext txt)
-pprDeprecs (DeprecSome prs) = ptext SLIT("Deprecate") <+> vcat (map pprDeprec prs)
-			    where
-			      pprDeprec (name, txt) = ppr name <+> doubleQuotes (ftext txt)
-\end{code}
diff --git a/ghc/compiler/iface/TcIface.hi-boot-5 b/ghc/compiler/iface/TcIface.hi-boot-5
deleted file mode 100644
index 3647edfa22..0000000000
--- a/ghc/compiler/iface/TcIface.hi-boot-5
+++ /dev/null
@@ -1,5 +0,0 @@
-__interface TcIface 1 0 where
-__export TcIface tcImportDecl ;
-1 tcImportDecl :: Name.Name -> TcRnTypes.IfG TypeRep.TyThing ;
-
-
diff --git a/ghc/compiler/iface/TcIface.hi-boot-6 b/ghc/compiler/iface/TcIface.hi-boot-6
deleted file mode 100644
index b03830c03d..0000000000
--- a/ghc/compiler/iface/TcIface.hi-boot-6
+++ /dev/null
@@ -1,7 +0,0 @@
-module TcIface where
-
-tcIfaceDecl  :: IfaceSyn.IfaceDecl -> TcRnTypes.IfL TypeRep.TyThing
-tcIfaceInst  :: IfaceSyn.IfaceInst -> TcRnTypes.IfL InstEnv.Instance
-tcIfaceRule  :: IfaceSyn.IfaceRule -> TcRnTypes.IfL CoreSyn.CoreRule
-
-
diff --git a/ghc/compiler/iface/TcIface.lhs b/ghc/compiler/iface/TcIface.lhs
deleted file mode 100644
index b902c8c5fe..0000000000
--- a/ghc/compiler/iface/TcIface.lhs
+++ /dev/null
@@ -1,977 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcIfaceSig]{Type checking of type signatures in interface files}
-
-\begin{code}
-module TcIface ( 
-	tcImportDecl, checkWiredInTyCon, tcHiBootIface, typecheckIface, 
-	tcIfaceDecl, tcIfaceInst, tcIfaceRule, tcIfaceGlobal, 
-	tcExtCoreBindings
- ) where
-
-#include "HsVersions.h"
-
-import IfaceSyn
-import LoadIface	( loadInterface, loadWiredInHomeIface,
-			  loadDecls, findAndReadIface )
-import IfaceEnv		( lookupIfaceTop, lookupIfaceExt, newGlobalBinder, 
-			  extendIfaceIdEnv, extendIfaceTyVarEnv, newIPName,
-			  tcIfaceTyVar, tcIfaceLclId, lookupIfaceTc, refineIfaceIdEnv,
-			  newIfaceName, newIfaceNames, ifaceExportNames )
-import BuildTyCl	( buildSynTyCon, buildAlgTyCon, buildDataCon, buildClass,
-			  mkAbstractTyConRhs, mkDataTyConRhs, mkNewTyConRhs )
-import TcRnMonad
-import Type		( liftedTypeKind, splitTyConApp, mkTyConApp,
-			  mkTyVarTys, ThetaType )
-import TypeRep		( Type(..), PredType(..) )
-import TyCon		( TyCon, tyConName )
-import HscTypes		( ExternalPackageState(..), 
-			  TyThing(..), tyThingClass, tyThingTyCon, 
-			  ModIface(..), ModDetails(..), HomeModInfo(..),
-			  emptyModDetails, lookupTypeEnv, lookupType, typeEnvIds )
-import InstEnv		( Instance(..), mkImportedInstance )
-import Unify		( coreRefineTys )
-import CoreSyn
-import CoreUtils	( exprType )
-import CoreUnfold
-import CoreLint		( lintUnfolding )
-import WorkWrap		( mkWrapper )
-import Id		( Id, mkVanillaGlobal, mkLocalId )
-import MkId		( mkFCallId )
-import IdInfo		( IdInfo, CafInfo(..), WorkerInfo(..), 
-			  setUnfoldingInfoLazily, setAllStrictnessInfo, setWorkerInfo,
-			  setArityInfo, setInlinePragInfo, setCafInfo, 
-			  vanillaIdInfo, newStrictnessInfo )
-import Class		( Class )
-import TyCon		( tyConDataCons, isTupleTyCon, mkForeignTyCon )
-import DataCon		( DataCon, dataConWorkId, dataConTyVars, dataConInstArgTys, isVanillaDataCon )
-import TysWiredIn	( tupleCon, tupleTyCon, listTyCon, intTyCon, boolTyCon, charTyCon, parrTyCon )
-import Var		( TyVar, mkTyVar, tyVarKind )
-import Name		( Name, nameModule, nameIsLocalOrFrom, isWiredInName,
-			  wiredInNameTyThing_maybe, nameParent )
-import NameEnv
-import OccName		( OccName )
-import Module		( Module, lookupModuleEnv )
-import UniqSupply	( initUs_ )
-import Outputable	
-import ErrUtils		( Message )
-import Maybes		( MaybeErr(..) )
-import SrcLoc		( noSrcLoc )
-import Util		( zipWithEqual, dropList, equalLength )
-import DynFlags		( DynFlag(..), isOneShot )
-\end{code}
-
-This module takes
-
-	IfaceDecl -> TyThing
-	IfaceType -> Type
-	etc
-
-An IfaceDecl is populated with RdrNames, and these are not renamed to
-Names before typechecking, because there should be no scope errors etc.
-
-	-- For (b) consider: f = $(...h....)
-	-- where h is imported, and calls f via an hi-boot file.  
-	-- This is bad!  But it is not seen as a staging error, because h
-	-- is indeed imported.  We don't want the type-checker to black-hole 
-	-- when simplifying and compiling the splice!
-	--
-	-- Simple solution: discard any unfolding that mentions a variable
-	-- bound in this module (and hence not yet processed).
-	-- The discarding happens when forkM finds a type error.
-
-%************************************************************************
-%*									*
-%*	tcImportDecl is the key function for "faulting in" 		*
-%*	imported things
-%*									*
-%************************************************************************
-
-The main idea is this.  We are chugging along type-checking source code, and
-find a reference to GHC.Base.map.  We call tcLookupGlobal, which doesn't find
-it in the EPS type envt.  So it 
-	1 loads GHC.Base.hi
-	2 gets the decl for GHC.Base.map
-	3 typechecks it via tcIfaceDecl
-	4 and adds it to the type env in the EPS
-
-Note that DURING STEP 4, we may find that map's type mentions a type 
-constructor that also 
-
-Notice that for imported things we read the current version from the EPS
-mutable variable.  This is important in situations like
-	...$(e1)...$(e2)...
-where the code that e1 expands to might import some defns that 
-also turn out to be needed by the code that e2 expands to.
-
-\begin{code}
-tcImportDecl :: Name -> TcM TyThing
--- Entry point for *source-code* uses of importDecl
-tcImportDecl name 
-  | Just thing <- wiredInNameTyThing_maybe name
-  = do	{ initIfaceTcRn (loadWiredInHomeIface name) 
-	; return thing }
-  | otherwise
-  = do 	{ traceIf (text "tcImportDecl" <+> ppr name)
-	; mb_thing <- initIfaceTcRn (importDecl name)
-	; case mb_thing of
-	    Succeeded thing -> return thing
-	    Failed err      -> failWithTc err }
-
-checkWiredInTyCon :: TyCon -> TcM ()
--- Ensure that the home module of the TyCon (and hence its instances)
--- are loaded. It might not be a wired-in tycon (see the calls in TcUnify),
--- in which case this is a no-op.
-checkWiredInTyCon tc	
-  | not (isWiredInName tc_name) 
-  = return ()
-  | otherwise
-  = do	{ mod <- getModule
-	; if nameIsLocalOrFrom mod tc_name then
-		-- Don't look for (non-existent) Float.hi when
-		-- compiling Float.lhs, which mentions Float of course
-		return ()
-	  else	-- A bit yukky to call initIfaceTcRn here
-		initIfaceTcRn (loadWiredInHomeIface tc_name) 
-	}
-  where
-    tc_name = tyConName tc
-
-importDecl :: Name -> IfM lcl (MaybeErr Message TyThing)
--- Get the TyThing for this Name from an interface file
--- It's not a wired-in thing -- the caller caught that
-importDecl name
-  = ASSERT( not (isWiredInName name) )
-    do	{ traceIf nd_doc
-
-	-- Load the interface, which should populate the PTE
-	; mb_iface <- loadInterface nd_doc (nameModule name) ImportBySystem
-	; case mb_iface of {
-		Failed err_msg  -> return (Failed err_msg) ;
-		Succeeded iface -> do
-
-	-- Now look it up again; this time we should find it
-	{ eps <- getEps	
-	; case lookupTypeEnv (eps_PTE eps) name of
-	    Just thing -> return (Succeeded thing)
-	    Nothing    -> return (Failed not_found_msg)
-    }}}
-  where
-    nd_doc = ptext SLIT("Need decl for") <+> ppr name
-    not_found_msg = hang (ptext SLIT("Can't find interface-file declaration for") <+> ppr (nameParent name))
-	  	       2 (vcat [ptext SLIT("Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
-		                ptext SLIT("Use -ddump-if-trace to get an idea of which file caused the error")])
-\end{code}
-
-%************************************************************************
-%*									*
-		Type-checking a complete interface
-%*									*
-%************************************************************************
-
-Suppose we discover we don't need to recompile.  Then we must type
-check the old interface file.  This is a bit different to the
-incremental type checking we do as we suck in interface files.  Instead
-we do things similarly as when we are typechecking source decls: we
-bring into scope the type envt for the interface all at once, using a
-knot.  Remember, the decls aren't necessarily in dependency order --
-and even if they were, the type decls might be mutually recursive.
-
-\begin{code}
-typecheckIface :: ModIface 	-- Get the decls from here
-	       -> TcRnIf gbl lcl ModDetails
-typecheckIface iface
-  = initIfaceTc iface $ \ tc_env_var -> do
-	-- The tc_env_var is freshly allocated, private to 
-	-- type-checking this particular interface
-	{ 	-- Get the right set of decls and rules.  If we are compiling without -O
-		-- we discard pragmas before typechecking, so that we don't "see"
-		-- information that we shouldn't.  From a versioning point of view
-		-- It's not actually *wrong* to do so, but in fact GHCi is unable 
-		-- to handle unboxed tuples, so it must not see unfoldings.
-	  ignore_prags <- doptM Opt_IgnoreInterfacePragmas
-
-		-- Load & typecheck the decls
-	; decl_things <- loadDecls ignore_prags (mi_decls iface)
-
-	; let type_env = mkNameEnv decl_things
-	; writeMutVar tc_env_var type_env
-
-		-- Now do those rules and instances
-	; let { rules | ignore_prags = []
-		      | otherwise    = mi_rules iface
-	      ; dfuns = mi_insts iface
-	      } 
-	; dfuns <- mapM tcIfaceInst dfuns
-	; rules <- mapM tcIfaceRule rules
-
-		-- Exports
-	; exports <-  ifaceExportNames (mi_exports iface)
-
-		-- Finished
-	; return (ModDetails {	md_types = type_env, 
-				md_insts = dfuns,
-				md_rules = rules,
-				md_exports = exports }) 
-    }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Type and class declarations
-%*									*
-%************************************************************************
-
-\begin{code}
-tcHiBootIface :: Module -> TcRn ModDetails
--- Load the hi-boot iface for the module being compiled,
--- if it indeed exists in the transitive closure of imports
--- Return the ModDetails, empty if no hi-boot iface
-tcHiBootIface mod
-  = do 	{ traceIf (text "loadHiBootInterface" <+> ppr mod)
-
-	; mode <- getGhcMode
-	; if not (isOneShot mode)
-		-- In --make and interactive mode, if this module has an hs-boot file
-		-- we'll have compiled it already, and it'll be in the HPT
-		-- 
-		-- We check wheher the interface is a *boot* interface.
-		-- It can happen (when using GHC from Visual Studio) that we
-		-- compile a module in TypecheckOnly mode, with a stable, 
-		-- fully-populated HPT.  In that case the boot interface isn't there
-		-- (it's been replaced by the mother module) so we can't check it.
-		-- And that's fine, because if M's ModInfo is in the HPT, then 
-		-- it's been compiled once, and we don't need to check the boot iface
-	  then do { hpt <- getHpt
-		  ; case lookupModuleEnv hpt mod of
-		      Just info | mi_boot (hm_iface info) 
-				-> return (hm_details info)
-		      other -> return emptyModDetails }
-	  else do
-
-	-- OK, so we're in one-shot mode.  
-	-- In that case, we're read all the direct imports by now, 
-	-- so eps_is_boot will record if any of our imports mention us by 
-	-- way of hi-boot file
-	{ eps <- getEps
-	; case lookupModuleEnv (eps_is_boot eps) mod of {
-	    Nothing -> return emptyModDetails ;	-- The typical case
-
-	    Just (_, False) -> failWithTc moduleLoop ;
- 		-- Someone below us imported us!
-		-- This is a loop with no hi-boot in the way
-		
-	    Just (mod, True) -> 	-- There's a hi-boot interface below us
-		
-    do	{ read_result <- findAndReadIface 
-				True	-- Explicit import? 
-				need mod
-				True	-- Hi-boot file
-
-	; case read_result of
-		Failed err               -> failWithTc (elaborate err)
-		Succeeded (iface, _path) -> typecheckIface iface
-    }}}}
-  where
-    need = ptext SLIT("Need the hi-boot interface for") <+> ppr mod
-		 <+> ptext SLIT("to compare against the Real Thing")
-
-    moduleLoop = ptext SLIT("Circular imports: module") <+> quotes (ppr mod) 
-		     <+> ptext SLIT("depends on itself")
-
-    elaborate err = hang (ptext SLIT("Could not find hi-boot interface for") <+> 
-		          quotes (ppr mod) <> colon) 4 err
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Type and class declarations
-%*									*
-%************************************************************************
-
-When typechecking a data type decl, we *lazily* (via forkM) typecheck
-the constructor argument types.  This is in the hope that we may never
-poke on those argument types, and hence may never need to load the
-interface files for types mentioned in the arg types.
-
-E.g.	
-	data Foo.S = MkS Baz.T
-Mabye we can get away without even loading the interface for Baz!
-
-This is not just a performance thing.  Suppose we have
-	data Foo.S = MkS Baz.T
-	data Baz.T = MkT Foo.S
-(in different interface files, of course).
-Now, first we load and typecheck Foo.S, and add it to the type envt.  
-If we do explore MkS's argument, we'll load and typecheck Baz.T.
-If we explore MkT's argument we'll find Foo.S already in the envt.  
-
-If we typechecked constructor args eagerly, when loading Foo.S we'd try to
-typecheck the type Baz.T.  So we'd fault in Baz.T... and then need Foo.S...
-which isn't done yet.
-
-All very cunning. However, there is a rather subtle gotcha which bit
-me when developing this stuff.  When we typecheck the decl for S, we
-extend the type envt with S, MkS, and all its implicit Ids.  Suppose
-(a bug, but it happened) that the list of implicit Ids depended in
-turn on the constructor arg types.  Then the following sequence of
-events takes place:
-	* we build a thunk <t> for the constructor arg tys
-	* we build a thunk for the extended type environment (depends on <t>)
-	* we write the extended type envt into the global EPS mutvar
-	
-Now we look something up in the type envt
-	* that pulls on <t>
-	* which reads the global type envt out of the global EPS mutvar
-	* but that depends in turn on <t>
-
-It's subtle, because, it'd work fine if we typechecked the constructor args 
-eagerly -- they don't need the extended type envt.  They just get the extended
-type envt by accident, because they look at it later.
-
-What this means is that the implicitTyThings MUST NOT DEPEND on any of
-the forkM stuff.
-
-
-\begin{code}
-tcIfaceDecl :: IfaceDecl -> IfL TyThing
-
-tcIfaceDecl (IfaceId {ifName = occ_name, ifType = iface_type, ifIdInfo = info})
-  = do	{ name <- lookupIfaceTop occ_name
-	; ty <- tcIfaceType iface_type
-	; info <- tcIdInfo name ty info
-	; return (AnId (mkVanillaGlobal name ty info)) }
-
-tcIfaceDecl (IfaceData {ifName = occ_name, 
-			ifTyVars = tv_bndrs, 
-			ifCtxt = ctxt,
-			ifCons = rdr_cons, 
-			ifVrcs = arg_vrcs, ifRec = is_rec, 
-			ifGeneric = want_generic })
-  = do	{ tc_name <- lookupIfaceTop occ_name
-	; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
-
-	{ tycon <- fixM ( \ tycon -> do
-	    { stupid_theta <- tcIfaceCtxt ctxt
-	    ; cons  <- tcIfaceDataCons tycon tyvars rdr_cons
-	    ; buildAlgTyCon tc_name tyvars stupid_theta
-			    cons arg_vrcs is_rec want_generic
-	    })
-        ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
-	; return (ATyCon tycon)
-    }}
-
-tcIfaceDecl (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, 
-		       ifSynRhs = rdr_rhs_ty, ifVrcs = arg_vrcs})
-   = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
-     { tc_name <- lookupIfaceTop occ_name
-     ; rhs_ty <- tcIfaceType rdr_rhs_ty
-     ; return (ATyCon (buildSynTyCon tc_name tyvars rhs_ty arg_vrcs))
-     }
-
-tcIfaceDecl (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, ifTyVars = tv_bndrs, 
-			 ifFDs = rdr_fds, ifSigs = rdr_sigs, 
-			 ifVrcs = tc_vrcs, ifRec = tc_isrec })
-  = bindIfaceTyVars tv_bndrs $ \ tyvars -> do
-    { cls_name <- lookupIfaceTop occ_name
-    ; ctxt <- tcIfaceCtxt rdr_ctxt
-    ; sigs <- mappM tc_sig rdr_sigs
-    ; fds  <- mappM tc_fd rdr_fds
-    ; cls  <- buildClass cls_name tyvars ctxt fds sigs tc_isrec tc_vrcs
-    ; return (AClass cls) }
-  where
-   tc_sig (IfaceClassOp occ dm rdr_ty)
-     = do { op_name <- lookupIfaceTop occ
-	  ; op_ty   <- forkM (mk_doc op_name rdr_ty) (tcIfaceType rdr_ty)
-		-- Must be done lazily for just the same reason as the 
-		-- context of a data decl: the type sig might mention the
-		-- class being defined
-	  ; return (op_name, dm, op_ty) }
-
-   mk_doc op_name op_ty = ptext SLIT("Class op") <+> sep [ppr op_name, ppr op_ty]
-
-   tc_fd (tvs1, tvs2) = do { tvs1' <- mappM tcIfaceTyVar tvs1
-			   ; tvs2' <- mappM tcIfaceTyVar tvs2
-			   ; return (tvs1', tvs2') }
-
-tcIfaceDecl (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
-  = do	{ name <- lookupIfaceTop rdr_name
-	; return (ATyCon (mkForeignTyCon name ext_name 
-					 liftedTypeKind 0 [])) }
-
-tcIfaceDataCons tycon tc_tyvars if_cons
-  = case if_cons of
-	IfAbstractTyCon	 -> return mkAbstractTyConRhs
-	IfDataTyCon cons -> do 	{ data_cons <- mappM tc_con_decl cons
-				; return (mkDataTyConRhs data_cons) }
-	IfNewTyCon con	 -> do 	{ data_con <- tc_con_decl con
-				; return (mkNewTyConRhs tycon data_con) }
-  where
-    tc_con_decl (IfVanillaCon {	ifConOcc = occ, ifConInfix = is_infix, ifConArgTys = args, 
-				ifConStricts = stricts, ifConFields = field_lbls})
-      = do { name  <- lookupIfaceTop occ
-		-- Read the argument types, but lazily to avoid faulting in
-		-- the component types unless they are really needed
- 	   ; arg_tys <- forkM (mk_doc name) (mappM tcIfaceType args)
-	   ; lbl_names <- mappM lookupIfaceTop field_lbls
-	   ; buildDataCon name is_infix True {- Vanilla -} 
-			  stricts lbl_names
-			  tc_tyvars [] arg_tys tycon
-			  (mkTyVarTys tc_tyvars)	-- Vanilla => we know result tys
-	   }  
-
-    tc_con_decl (IfGadtCon {	ifConTyVars = con_tvs,
-				ifConOcc = occ, ifConCtxt = ctxt, 
-				ifConArgTys = args, ifConResTys = ress, 
-				ifConStricts = stricts})
-      = bindIfaceTyVars con_tvs	$ \ con_tyvars -> do
-	{ name  <- lookupIfaceTop occ
-	; theta <- tcIfaceCtxt ctxt	-- Laziness seems not worth the bother here
-	 	-- At one stage I thought that this context checking *had*
-		-- to be lazy, because of possible mutual recursion between the
-		-- type and the classe: 
-		-- E.g. 
-		--	class Real a where { toRat :: a -> Ratio Integer }
-		--	data (Real a) => Ratio a = ...
-		-- But now I think that the laziness in checking class ops breaks 
-		-- the loop, so no laziness needed
-
-	-- Read the argument types, but lazily to avoid faulting in
-	-- the component types unless they are really needed
- 	; arg_tys <- forkM (mk_doc name) (mappM tcIfaceType args)
- 	; res_tys <- forkM (mk_doc name) (mappM tcIfaceType ress)
-
-	; buildDataCon name False {- Not infix -} False {- Not vanilla -}
-		       stricts [{- No fields -}]
-		       con_tyvars theta 
-		       arg_tys tycon res_tys
-	}
-    mk_doc con_name = ptext SLIT("Constructor") <+> ppr con_name
-\end{code}	
-
-
-%************************************************************************
-%*									*
-		Instances
-%*									*
-%************************************************************************
-
-\begin{code}
-tcIfaceInst :: IfaceInst -> IfL Instance
-tcIfaceInst (IfaceInst { ifDFun = dfun_occ, ifOFlag = oflag,
-			 ifInstCls = cls, ifInstTys = mb_tcs,
-			 ifInstOrph = orph })
-  = do	{ dfun    <- forkM (ptext SLIT("Dict fun") <+> ppr dfun_occ) $
-		     tcIfaceExtId (LocalTop dfun_occ)
-	; cls'    <- lookupIfaceExt cls
-	; mb_tcs' <- mapM do_tc mb_tcs
-	; return (mkImportedInstance cls' mb_tcs' orph dfun oflag) }
-  where
-    do_tc Nothing   = return Nothing
-    do_tc (Just tc) = do { tc' <- lookupIfaceTc tc; return (Just tc') }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Rules
-%*									*
-%************************************************************************
-
-We move a IfaceRule from eps_rules to eps_rule_base when all its LHS free vars
-are in the type environment.  However, remember that typechecking a Rule may 
-(as a side effect) augment the type envt, and so we may need to iterate the process.
-
-\begin{code}
-tcIfaceRule :: IfaceRule -> IfL CoreRule
-tcIfaceRule (IfaceRule {ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
-			ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs,
-			ifRuleOrph = orph })
-  = do	{ fn' <- lookupIfaceExt fn
-	; ~(bndrs', args', rhs') <- 
-		-- Typecheck the payload lazily, in the hope it'll never be looked at
-		forkM (ptext SLIT("Rule") <+> ftext name) $
-		bindIfaceBndrs bndrs 			  $ \ bndrs' ->
-		do { args' <- mappM tcIfaceExpr args
-		   ; rhs'  <- tcIfaceExpr rhs
-		   ; return (bndrs', args', rhs') }
-	; mb_tcs <- mapM ifTopFreeName args
-	; returnM (Rule { ru_name = name, ru_fn = fn', ru_act = act, 
-			  ru_bndrs = bndrs', ru_args = args', 
-			  ru_rhs = rhs', ru_orph = orph,
-			  ru_rough = mb_tcs,
-			  ru_local = isLocalIfaceExtName fn }) }
-  where
-	-- This function *must* mirror exactly what Rules.topFreeName does
-	-- We could have stored the ru_rough field in the iface file
-	-- but that would be redundant, I think.
-	-- The only wrinkle is that we must not be deceived by
-	-- type syononyms at the top of a type arg.  Since
-	-- we can't tell at this point, we are careful not
-	-- to write them out in coreRuleToIfaceRule
-    ifTopFreeName :: IfaceExpr -> IfL (Maybe Name)
-    ifTopFreeName (IfaceType (IfaceTyConApp tc _ ))
-	= do { n <- lookupIfaceTc tc
-	     ; return (Just n) }
-    ifTopFreeName (IfaceApp f a) = ifTopFreeName f
-    ifTopFreeName (IfaceExt ext) = do { n <- lookupIfaceExt ext
-				      ; return (Just n) }
-    ifTopFreeName other = return Nothing
-\end{code}
-
-
-%************************************************************************
-%*									*
-			Types
-%*									*
-%************************************************************************
-
-\begin{code}
-tcIfaceType :: IfaceType -> IfL Type
-tcIfaceType (IfaceTyVar n)        = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
-tcIfaceType (IfaceAppTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
-tcIfaceType (IfaceFunTy t1 t2)    = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
-tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
-tcIfaceType (IfaceForAllTy tv t)  = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
-tcIfaceType (IfacePredTy st)      = do { st' <- tcIfacePredType st; return (PredTy st') }
-
-tcIfaceTypes tys = mapM tcIfaceType tys
-
------------------------------------------
-tcIfacePredType :: IfacePredType -> IfL PredType
-tcIfacePredType (IfaceClassP cls ts) = do { cls' <- tcIfaceClass cls; ts' <- tcIfaceTypes ts; return (ClassP cls' ts') }
-tcIfacePredType (IfaceIParam ip t)   = do { ip' <- newIPName ip; t' <- tcIfaceType t; return (IParam ip' t') }
-
------------------------------------------
-tcIfaceCtxt :: IfaceContext -> IfL ThetaType
-tcIfaceCtxt sts = mappM tcIfacePredType sts
-\end{code}
-
-
-%************************************************************************
-%*									*
-			Core
-%*									*
-%************************************************************************
-
-\begin{code}
-tcIfaceExpr :: IfaceExpr -> IfL CoreExpr
-tcIfaceExpr (IfaceType ty)
-  = tcIfaceType ty		`thenM` \ ty' ->
-    returnM (Type ty')
-
-tcIfaceExpr (IfaceLcl name)
-  = tcIfaceLclId name 	`thenM` \ id ->
-    returnM (Var id)
-
-tcIfaceExpr (IfaceExt gbl)
-  = tcIfaceExtId gbl 	`thenM` \ id ->
-    returnM (Var id)
-
-tcIfaceExpr (IfaceLit lit)
-  = returnM (Lit lit)
-
-tcIfaceExpr (IfaceFCall cc ty)
-  = tcIfaceType ty 	`thenM` \ ty' ->
-    newUnique		`thenM` \ u ->
-    returnM (Var (mkFCallId u cc ty'))
-
-tcIfaceExpr (IfaceTuple boxity args) 
-  = mappM tcIfaceExpr args	`thenM` \ args' ->
-    let
-	-- Put the missing type arguments back in
-	con_args = map (Type . exprType) args' ++ args'
-    in
-    returnM (mkApps (Var con_id) con_args)
-  where
-    arity = length args
-    con_id = dataConWorkId (tupleCon boxity arity)
-    
-
-tcIfaceExpr (IfaceLam bndr body)
-  = bindIfaceBndr bndr 		$ \ bndr' ->
-    tcIfaceExpr body		`thenM` \ body' ->
-    returnM (Lam bndr' body')
-
-tcIfaceExpr (IfaceApp fun arg)
-  = tcIfaceExpr fun		`thenM` \ fun' ->
-    tcIfaceExpr arg		`thenM` \ arg' ->
-    returnM (App fun' arg')
-
-tcIfaceExpr (IfaceCase scrut case_bndr ty alts) 
-  = tcIfaceExpr scrut		`thenM` \ scrut' ->
-    newIfaceName case_bndr	`thenM` \ case_bndr_name ->
-    let
-	scrut_ty   = exprType scrut'
-	case_bndr' = mkLocalId case_bndr_name scrut_ty
-	tc_app     = splitTyConApp scrut_ty
-		-- NB: Won't always succeed (polymoprhic case)
-		--     but won't be demanded in those cases
-		-- NB: not tcSplitTyConApp; we are looking at Core here
-		--     look through non-rec newtypes to find the tycon that
-		--     corresponds to the datacon in this case alternative
-    in
-    extendIfaceIdEnv [case_bndr']	$
-    mappM (tcIfaceAlt tc_app) alts	`thenM` \ alts' ->
-    tcIfaceType ty		`thenM` \ ty' ->
-    returnM (Case scrut' case_bndr' ty' alts')
-
-tcIfaceExpr (IfaceLet (IfaceNonRec bndr rhs) body)
-  = tcIfaceExpr rhs		`thenM` \ rhs' ->
-    bindIfaceId bndr 		$ \ bndr' ->
-    tcIfaceExpr body		`thenM` \ body' ->
-    returnM (Let (NonRec bndr' rhs') body')
-
-tcIfaceExpr (IfaceLet (IfaceRec pairs) body)
-  = bindIfaceIds bndrs		$ \ bndrs' ->
-    mappM tcIfaceExpr rhss	`thenM` \ rhss' ->
-    tcIfaceExpr body		`thenM` \ body' ->
-    returnM (Let (Rec (bndrs' `zip` rhss')) body')
-  where
-    (bndrs, rhss) = unzip pairs
-
-tcIfaceExpr (IfaceNote note expr) 
-  = tcIfaceExpr expr		`thenM` \ expr' ->
-    case note of
-	IfaceCoerce to_ty -> tcIfaceType to_ty	`thenM` \ to_ty' ->
-			     returnM (Note (Coerce to_ty'
-                                                   (exprType expr')) expr')
-	IfaceInlineCall   -> returnM (Note InlineCall expr')
-	IfaceInlineMe     -> returnM (Note InlineMe   expr')
-	IfaceSCC cc       -> returnM (Note (SCC cc)   expr')
-	IfaceCoreNote n   -> returnM (Note (CoreNote n) expr')
-
--------------------------
-tcIfaceAlt _ (IfaceDefault, names, rhs)
-  = ASSERT( null names )
-    tcIfaceExpr rhs		`thenM` \ rhs' ->
-    returnM (DEFAULT, [], rhs')
-  
-tcIfaceAlt _ (IfaceLitAlt lit, names, rhs)
-  = ASSERT( null names )
-    tcIfaceExpr rhs		`thenM` \ rhs' ->
-    returnM (LitAlt lit, [], rhs')
-
--- A case alternative is made quite a bit more complicated
--- by the fact that we omit type annotations because we can
--- work them out.  True enough, but its not that easy!
-tcIfaceAlt (tycon, inst_tys) (IfaceDataAlt data_occ, arg_occs, rhs)
-  = do	{ let tycon_mod = nameModule (tyConName tycon)
-	; con <- tcIfaceDataCon (ExtPkg tycon_mod data_occ)
-	; ASSERT2( con `elem` tyConDataCons tycon,
-		   ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon) )
-		  
-	  if isVanillaDataCon con then
-		tcVanillaAlt con inst_tys arg_occs rhs
-	  else
-    do 	{ 	-- General case
-	  arg_names <- newIfaceNames arg_occs
-	; let	tyvars   = [ mkTyVar name (tyVarKind tv) 
-			   | (name,tv) <- arg_names `zip` dataConTyVars con] 
-		arg_tys	 = dataConInstArgTys con (mkTyVarTys tyvars)
-		id_names = dropList tyvars arg_names
-		arg_ids  = ASSERT2( equalLength id_names arg_tys,
-				    ppr (con, arg_names, rhs) $$ ppr tyvars $$ ppr arg_tys )
-			   zipWith mkLocalId id_names arg_tys
-
-		Just refine = coreRefineTys con tyvars (mkTyConApp tycon inst_tys)
-		
-	; rhs' <- extendIfaceTyVarEnv tyvars	$
-		  extendIfaceIdEnv arg_ids	$
-		  refineIfaceIdEnv refine	$
-			-- You might think that we don't need to refine the envt here,
-			-- but we do: \(x::a) -> case y of 
-			--			     MkT -> case x of { True -> ... }
-			-- In the "case x" we need to know x's type, because we use that
-			-- to find which module to look for "True" in. Sigh.
-		  tcIfaceExpr rhs
-	; return (DataAlt con, tyvars ++ arg_ids, rhs') }}
-
-tcIfaceAlt (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
-  = ASSERT( isTupleTyCon tycon )
-    do	{ let [data_con] = tyConDataCons tycon
-	; tcVanillaAlt data_con inst_tys arg_occs rhs }
-
-tcVanillaAlt data_con inst_tys arg_occs rhs
-  = do	{ arg_names <- newIfaceNames arg_occs
-	; let arg_tys = dataConInstArgTys data_con inst_tys
-	; let arg_ids = ASSERT2( equalLength arg_names arg_tys,
-				 ppr data_con <+> ppr inst_tys <+> ppr arg_occs $$ ppr rhs )
-			zipWith mkLocalId arg_names arg_tys
-	; rhs' <- extendIfaceIdEnv arg_ids (tcIfaceExpr rhs)
-	; returnM (DataAlt data_con, arg_ids, rhs') }
-\end{code}
-
-
-\begin{code}
-tcExtCoreBindings :: [IfaceBinding] -> IfL [CoreBind]	-- Used for external core
-tcExtCoreBindings []     = return []
-tcExtCoreBindings (b:bs) = do_one b (tcExtCoreBindings bs)
-
-do_one :: IfaceBinding -> IfL [CoreBind] -> IfL [CoreBind]
-do_one (IfaceNonRec bndr rhs) thing_inside
-  = do	{ rhs' <- tcIfaceExpr rhs
-	; bndr' <- newExtCoreBndr bndr
-	; extendIfaceIdEnv [bndr'] $ do 
-	{ core_binds <- thing_inside
-	; return (NonRec bndr' rhs' : core_binds) }}
-
-do_one (IfaceRec pairs) thing_inside
-  = do	{ bndrs' <- mappM newExtCoreBndr bndrs
-	; extendIfaceIdEnv bndrs' $ do
- 	{ rhss' <- mappM tcIfaceExpr rhss
-	; core_binds <- thing_inside
-	; return (Rec (bndrs' `zip` rhss') : core_binds) }}
-  where
-    (bndrs,rhss) = unzip pairs
-\end{code}
-
-
-%************************************************************************
-%*									*
-		IdInfo
-%*									*
-%************************************************************************
-
-\begin{code}
-tcIdInfo :: Name -> Type -> IfaceIdInfo -> IfL IdInfo
-tcIdInfo name ty NoInfo		= return vanillaIdInfo
-tcIdInfo name ty (HasInfo info) = foldlM tcPrag init_info info
-  where
-    -- Set the CgInfo to something sensible but uninformative before
-    -- we start; default assumption is that it has CAFs
-    init_info = vanillaIdInfo
-
-    tcPrag info HsNoCafRefs         = returnM (info `setCafInfo`   NoCafRefs)
-    tcPrag info (HsArity arity)     = returnM (info `setArityInfo` arity)
-    tcPrag info (HsStrictness str)  = returnM (info `setAllStrictnessInfo` Just str)
-
-	-- The next two are lazy, so they don't transitively suck stuff in
-    tcPrag info (HsWorker nm arity) = tcWorkerInfo ty info nm arity
-    tcPrag info (HsUnfold inline_prag expr)
-	= tcPragExpr name expr 	`thenM` \ maybe_expr' ->
-	  let
-		-- maybe_expr' doesn't get looked at if the unfolding
-		-- is never inspected; so the typecheck doesn't even happen
-		unfold_info = case maybe_expr' of
-				Nothing    -> noUnfolding
-				Just expr' -> mkTopUnfolding expr' 
-	  in
- 	  returnM (info `setUnfoldingInfoLazily` unfold_info
-			`setInlinePragInfo`      inline_prag)
-\end{code}
-
-\begin{code}
-tcWorkerInfo ty info wkr arity
-  = do 	{ mb_wkr_id <- forkM_maybe doc (tcIfaceExtId wkr)
-
-	-- We return without testing maybe_wkr_id, but as soon as info is
-	-- looked at we will test it.  That's ok, because its outside the
-	-- knot; and there seems no big reason to further defer the
-	-- tcIfaceId lookup.  (Contrast with tcPragExpr, where postponing walking
-	-- over the unfolding until it's actually used does seem worth while.)
-	; us <- newUniqueSupply
-
-	; returnM (case mb_wkr_id of
-		     Nothing     -> info
-		     Just wkr_id -> add_wkr_info us wkr_id info) }
-  where
-    doc = text "Worker for" <+> ppr wkr
-    add_wkr_info us wkr_id info
-	= info `setUnfoldingInfoLazily`  mk_unfolding us wkr_id
-	       `setWorkerInfo`           HasWorker wkr_id arity
-
-    mk_unfolding us wkr_id = mkTopUnfolding (initUs_ us (mkWrapper ty strict_sig) wkr_id)
-
-    	-- We are relying here on strictness info always appearing 
-	-- before worker info,  fingers crossed ....
-    strict_sig = case newStrictnessInfo info of
-		   Just sig -> sig
-		   Nothing  -> pprPanic "Worker info but no strictness for" (ppr wkr)
-\end{code}
-
-For unfoldings we try to do the job lazily, so that we never type check
-an unfolding that isn't going to be looked at.
-
-\begin{code}
-tcPragExpr :: Name -> IfaceExpr -> IfL (Maybe CoreExpr)
-tcPragExpr name expr
-  = forkM_maybe doc $
-    tcIfaceExpr expr		`thenM` \ core_expr' ->
-
-		-- Check for type consistency in the unfolding
-    ifOptM Opt_DoCoreLinting (
-	get_in_scope_ids			`thenM` \ in_scope -> 
-	case lintUnfolding noSrcLoc in_scope core_expr' of
-	  Nothing       -> returnM ()
-	  Just fail_msg -> pprPanic "Iface Lint failure" (doc <+> fail_msg)
-    )				`thenM_`
-
-   returnM core_expr'	
-  where
-    doc = text "Unfolding of" <+> ppr name
-    get_in_scope_ids 	-- Urgh; but just for linting
-	= setLclEnv () $ 
-	  do	{ env <- getGblEnv 
-		; case if_rec_types env of {
-			  Nothing -> return [] ;
-			  Just (_, get_env) -> do
-		{ type_env <- get_env
-		; return (typeEnvIds type_env) }}}
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-		Getting from Names to TyThings
-%*									*
-%************************************************************************
-
-\begin{code}
-tcIfaceGlobal :: Name -> IfL TyThing
-tcIfaceGlobal name
-  | Just thing <- wiredInNameTyThing_maybe name
-	-- Wired-in things include TyCons, DataCons, and Ids
-  = do { loadWiredInHomeIface name; return thing }
-	-- Even though we are in an interface file, we want to make
-	-- sure its instances are loaded (imagine f :: Double -> Double)
-	-- and its RULES are loaded too
-  | otherwise
-  = do	{ (eps,hpt) <- getEpsAndHpt
-	; case lookupType hpt (eps_PTE eps) name of {
-	    Just thing -> return thing ;
-	    Nothing    -> do
-
-	{ env <- getGblEnv
-	; case if_rec_types env of {
-	    Just (mod, get_type_env) 
-		| nameIsLocalOrFrom mod name
-		-> do 		-- It's defined in the module being compiled
-	  	{ type_env <- setLclEnv () get_type_env		-- yuk
-		; case lookupNameEnv type_env name of
-			Just thing -> return thing
-			Nothing	   -> pprPanic "tcIfaceGlobal (local): not found:"  
-						(ppr name $$ ppr type_env) }
-
-	  ; other -> do
-
-	{ mb_thing <- importDecl name 	-- It's imported; go get it
-	; case mb_thing of
-	    Failed err      -> failIfM err
-	    Succeeded thing -> return thing
-    }}}}}
-
-tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
-tcIfaceTyCon IfaceIntTc       	= tcWiredInTyCon intTyCon
-tcIfaceTyCon IfaceBoolTc      	= tcWiredInTyCon boolTyCon
-tcIfaceTyCon IfaceCharTc      	= tcWiredInTyCon charTyCon
-tcIfaceTyCon IfaceListTc      	= tcWiredInTyCon listTyCon
-tcIfaceTyCon IfacePArrTc      	= tcWiredInTyCon parrTyCon
-tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
-tcIfaceTyCon (IfaceTc ext_nm)   = do { name <- lookupIfaceExt ext_nm
-				     ; thing <- tcIfaceGlobal name 
-				     ; return (check_tc (tyThingTyCon thing)) }
-  where
-#ifdef DEBUG
-    check_tc tc = case toIfaceTyCon (error "urk") tc of
-		   IfaceTc _ -> tc
-		   other     -> pprTrace "check_tc" (ppr tc) tc
-#else
-    check_tc tc = tc
-#endif
-
--- Even though we are in an interface file, we want to make
--- sure the instances and RULES of this tycon are loaded 
--- Imagine: f :: Double -> Double
-tcWiredInTyCon :: TyCon -> IfL TyCon
-tcWiredInTyCon tc = do { loadWiredInHomeIface (tyConName tc)
-		       ; return tc }
-
-tcIfaceClass :: IfaceExtName -> IfL Class
-tcIfaceClass rdr_name = do { name <- lookupIfaceExt rdr_name
-			   ; thing <- tcIfaceGlobal name
-			   ; return (tyThingClass thing) }
-
-tcIfaceDataCon :: IfaceExtName -> IfL DataCon
-tcIfaceDataCon gbl = do { name <- lookupIfaceExt gbl
-			; thing <- tcIfaceGlobal name
-		 	; case thing of
-				ADataCon dc -> return dc
-				other   -> pprPanic "tcIfaceExtDC" (ppr gbl $$ ppr name$$ ppr thing) }
-
-tcIfaceExtId :: IfaceExtName -> IfL Id
-tcIfaceExtId gbl = do { name <- lookupIfaceExt gbl
-		      ; thing <- tcIfaceGlobal name
-		      ; case thing of
-			  AnId id -> return id
-			  other   -> pprPanic "tcIfaceExtId" (ppr gbl $$ ppr name$$ ppr thing) }
-\end{code}
-
-%************************************************************************
-%*									*
-		Bindings
-%*									*
-%************************************************************************
-
-\begin{code}
-bindIfaceBndr :: IfaceBndr -> (CoreBndr -> IfL a) -> IfL a
-bindIfaceBndr (IfaceIdBndr bndr) thing_inside
-  = bindIfaceId bndr thing_inside
-bindIfaceBndr (IfaceTvBndr bndr) thing_inside
-  = bindIfaceTyVar bndr thing_inside
-    
-bindIfaceBndrs :: [IfaceBndr] -> ([CoreBndr] -> IfL a) -> IfL a
-bindIfaceBndrs []     thing_inside = thing_inside []
-bindIfaceBndrs (b:bs) thing_inside
-  = bindIfaceBndr b	$ \ b' ->
-    bindIfaceBndrs bs	$ \ bs' ->
-    thing_inside (b':bs')
-
------------------------
-bindIfaceId :: (OccName, IfaceType) -> (Id -> IfL a) -> IfL a
-bindIfaceId (occ, ty) thing_inside
-  = do	{ name <- newIfaceName occ
-	; ty' <- tcIfaceType ty
-	; let {	id = mkLocalId name ty' }
-	; extendIfaceIdEnv [id] (thing_inside id) }
-    
-bindIfaceIds :: [(OccName, IfaceType)] -> ([Id] -> IfL a) -> IfL a
-bindIfaceIds bndrs thing_inside
-  = do 	{ names <- newIfaceNames occs
-	; tys' <- mappM tcIfaceType tys
-	; let {	ids = zipWithEqual "tcCoreValBndr" mkLocalId names tys' }
-	; extendIfaceIdEnv ids (thing_inside ids) }
-  where
-    (occs,tys) = unzip bndrs
-
-
------------------------
-newExtCoreBndr :: (OccName, IfaceType) -> IfL Id
-newExtCoreBndr (occ, ty)
-  = do	{ mod <- getIfModule
-	; name <- newGlobalBinder mod occ Nothing noSrcLoc
-	; ty' <- tcIfaceType ty
-	; return (mkLocalId name ty') }
-
------------------------
-bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
-bindIfaceTyVar (occ,kind) thing_inside
-  = do	{ name <- newIfaceName occ
-   	; let tyvar = mk_iface_tyvar name kind
-	; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) }
-
-bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
-bindIfaceTyVars bndrs thing_inside
-  = do	{ names <- newIfaceNames occs
-  	; let tyvars = zipWith mk_iface_tyvar names kinds
-	; extendIfaceTyVarEnv tyvars (thing_inside tyvars) }
-  where
-    (occs,kinds) = unzip bndrs
-
-mk_iface_tyvar name kind = mkTyVar name kind
-\end{code}
-
diff --git a/ghc/compiler/iface/TcIface.lhs-boot b/ghc/compiler/iface/TcIface.lhs-boot
deleted file mode 100644
index 25191fcaae..0000000000
--- a/ghc/compiler/iface/TcIface.lhs-boot
+++ /dev/null
@@ -1,13 +0,0 @@
-\begin{code}
-module TcIface where
-import IfaceSyn	 ( IfaceDecl, IfaceInst, IfaceRule )
-import TypeRep	 ( TyThing )
-import TcRnTypes ( IfL )
-import InstEnv	 ( Instance )
-import CoreSyn	 ( CoreRule )
-
-tcIfaceDecl  :: IfaceDecl -> IfL TyThing
-tcIfaceInst  :: IfaceInst -> IfL Instance
-tcIfaceRule  :: IfaceRule -> IfL CoreRule
-\end{code}
-
diff --git a/ghc/compiler/ilxGen/Entry.ilx b/ghc/compiler/ilxGen/Entry.ilx
deleted file mode 100644
index 674c83141a..0000000000
--- a/ghc/compiler/ilxGen/Entry.ilx
+++ /dev/null
@@ -1,53 +0,0 @@
-.assembly test { }
-.assembly extern 'mscorlib' { }
-.assembly extern ilx 'std' { }
-// ENTRYPOINT
-.class MainMain { 
-   .method public static void Main(class [mscorlib]System.String[]) {
-       .entrypoint
-           ldstr "LOG: *** loading main value"   call void [mscorlib]System.Console::WriteLine(class [mscorlib]System.String)
-      ldsfld thunk<(func ( /* unit skipped */ ) --> class [std]PrelBase_Z0T)> class Main::'Main_main'
-
-           ldstr "LOG: *** evaluating main value"
-           call void [mscorlib]System.Console::WriteLine(class [mscorlib]System.String) 
-      callfunc () --> (func ( /* unit skipped */ ) --> class [std]PrelBase_Z0T)
-           ldstr "LOG: *** calling main value"
-           call void [mscorlib]System.Console::WriteLine(class [mscorlib]System.String) 
-      // ldunit
-      callfunc ( /* unit skipped */ ) --> class [std]PrelBase_Z0T
-
-      pop
-
-
-// HACK HACK HACK
-// Call the "finalizers" for stdin, stdout and stderr, because COM+ doesn't 
-// guarantee that finalizers will be run. WE DON'T GUARANTEE TO RUN ANY
-// OTHER FINALIZERS...
-
-      ldstr "LOG: ***calling critical finalizers manually in main()"
-           call void [mscorlib]System.Console::WriteLine(class [mscorlib]System.String)
-
-ldsfld thunk<(func (thunk<class [std]PrelIOBase_MVar<class [std]PrelIOBase_Handlezuzu>>) --> (func (/* unit skipped */) --> class [std]PrelBase_Z0T))>  [std]'PrelHandle'::'PrelHandle_stdHandleFinalizzer'
-ldsfld thunk<class [std]PrelIOBase_MVar<class [std]PrelIOBase_Handle__>>  [std]'PrelHandle'::'PrelHandle_stdin'
-      callfunc () (thunk<class [std]PrelIOBase_MVar<class [std]PrelIOBase_Handle__>>) --> (func ( /* unit skipped */ ) -->  class [std]PrelBase_Z0T)
-      callfunc ( /* unit skipped */ ) --> class [std]PrelBase_Z0T
-      pop
-
-ldsfld thunk<(func (thunk<class [std]PrelIOBase_MVar<class [std]PrelIOBase_Handlezuzu>>) --> (func (/* unit skipped */) --> class [std]PrelBase_Z0T))>  [std]'PrelHandle'::'PrelHandle_stdHandleFinalizzer'
-ldsfld thunk<class [std]PrelIOBase_MVar<class [std]PrelIOBase_Handle__>>  [std]'PrelHandle'::'PrelHandle_stdout'
-      callfunc () (thunk<class [std]PrelIOBase_MVar<class [std]PrelIOBase_Handle__>>) --> (func ( /* unit skipped */ ) -->  class [std]PrelBase_Z0T)
-      callfunc ( /* unit skipped */ ) --> class [std]PrelBase_Z0T
-      pop
-
-ldsfld thunk<(func (thunk<class [std]PrelIOBase_MVar<class [std]PrelIOBase_Handlezuzu>>) --> (func (/* unit skipped */) --> class [std]PrelBase_Z0T))>  [std]'PrelHandle'::'PrelHandle_stdHandleFinalizzer'
-ldsfld thunk<class [std]PrelIOBase_MVar<class [std]PrelIOBase_Handle__>>  [std]'PrelHandle'::'PrelHandle_stderr'
-      callfunc () (thunk<class [std]PrelIOBase_MVar<class [std]PrelIOBase_Handle__>>) --> (func ( /* unit skipped */ ) -->  class [std]PrelBase_Z0T)
-      callfunc ( /* unit skipped */ ) --> class [std]PrelBase_Z0T
-      pop
-
-      ldstr "LOG: exit main()\n"
-           call void [mscorlib]System.Console::WriteLine(class [mscorlib]System.String)
-      ret
-   }
-}
-
diff --git a/ghc/compiler/ilxGen/IlxGen.lhs b/ghc/compiler/ilxGen/IlxGen.lhs
deleted file mode 100644
index 19e9f76ecf..0000000000
--- a/ghc/compiler/ilxGen/IlxGen.lhs
+++ /dev/null
@@ -1,2403 +0,0 @@
-%
-\section{Generate .NET extended IL}
-
-\begin{code}
-module IlxGen( ilxGen ) where
-
-#include "HsVersions.h"
-
-import Char	( ord, chr )
-import StgSyn
-import Id	( idType, idName, isDeadBinder, idArity )
-import Var	( Var, Id, TyVar, isId, isTyVar, tyVarKind, tyVarName )
-import VarEnv
-import VarSet   ( isEmptyVarSet )
-import TyCon	( TyCon,  tyConPrimRep, isUnboxedTupleTyCon, tyConDataCons, 
-		  tyConTyVars, isDataTyCon, isAlgTyCon, tyConArity
-		)
-import Type	( liftedTypeKind, openTypeKind, unliftedTypeKind,
-		  isUnLiftedType, isTyVarTy, mkTyVarTy, predTypeRep, pprType,
-		  splitForAllTys, splitFunTys, applyTy, applyTys, eqKind, tyVarsOfTypes
-		)
-import TypeRep	( Type(..) )
-import DataCon	( isUnboxedTupleCon, dataConTyCon, dataConRepType, dataConRepArgTys, DataCon(..) )
-import Literal	( Literal(..) )
-import PrelNames	-- Lots of keys
-import PrimOp		( PrimOp(..) )
-import ForeignCall	( CCallConv(..), ForeignCall(..), CCallSpec(..), CCallTarget(..), DNCallSpec(..) )
-import TysWiredIn	( mkTupleTy, tupleCon )
-import PrimRep		( PrimRep(..) )
-import Name		( nameModule, nameOccName, isExternalName, isInternalName, NamedThing(getName) )
-import Subst   		( substTyWith )
-
-import Module		( Module, PackageName, ModuleName, moduleName, 
-                          modulePackage, basePackage,
-			  isHomeModule, isVanillaModule,
-                          pprModuleName, mkHomeModule, mkModuleName
-			)
-
-import UniqFM
-import BasicTypes	( Boxity(..) )
-import CStrings		( CLabelString, pprCLabelString )
-import Outputable
-import Char		( ord )
-import List		( partition, elem, insertBy,any  )
-import UniqSet
-
-import TysPrim  ( foreignObjPrimTyCon, weakPrimTyCon, byteArrayPrimTyCon, mutableByteArrayPrimTyCon )
-
--- opt_SimplDoEtaReduction is used to help with assembly naming conventions for different
--- versions of compiled Haskell code.  We add a ".O" to all assembly and module 
--- names when this is set (because that's clue that -O was set).  
--- One day this will be configured by the command line.
-import DynFlags	( opt_InPackage, opt_SimplDoEtaReduction )
-
-import Util		( lengthIs, equalLength )
-
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Main driver}
-%*									*
-%************************************************************************
-
-\begin{code}
-ilxGen :: Module -> [TyCon] -> [(StgBinding,[Id])] -> SDoc
-	-- The TyCons should include those arising from classes
-ilxGen mod tycons binds_w_srts
-  =  vcat [ text ".module '" <> (ppr (moduleName mod)) <> hscOptionQual <> text "o'",
-	    text ".assembly extern 'mscorlib' {}",
-	    vcat (map (ilxImportPackage topenv) (uniqSetToList import_packages)),
-            vcat (map (ilxImportModule topenv) (uniqSetToList import_modules)),
-            vcat (map (ilxImportTyCon topenv) (uniqSetToList import_tycons)),
-            vcat (map (ilxImportCCall topenv) (map snd (ufmToList import_ccalls))),
-            vcat (map (ilxTyCon topenv) data_tycons),
-            vcat (map (ilxBindClosures topenv) binds),
-	    ilxTopBind mod topenv toppairs
-	 ]
-    where
-      binds = map fst binds_w_srts
-      toppairs = ilxPairs binds
-      topenv = extendIlxEnvWithTops (emptyIlxEnv False mod) mod toppairs
- 	-- Generate info from class decls as well
-      (import_packages,import_modules,import_tycons,import_ccalls) = importsBinds topenv binds (importsPrelude emptyImpInfo)
-      data_tycons = filter isDataTyCon tycons
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Find Imports}
-%*									*
-%************************************************************************
-
-\begin{code}
-
-importsBinds :: IlxEnv -> [StgBinding] -> ImportsInfo -> ImportsInfo
-importsBinds env binds = foldR (importsBind env) binds
-
-importsNone :: ImportsInfo -> ImportsInfo
-importsNone sofar = sofar
-
-importsBind :: IlxEnv -> StgBinding -> ImportsInfo -> ImportsInfo
-importsBind env (StgNonRec _ b rhs) = importsRhs env rhs.importsVar env b
-importsBind env (StgRec _ pairs) = foldR (\(b,rhs) -> importsRhs env rhs . importsVar env b) pairs
-
-importsRhs :: IlxEnv -> StgRhs -> ImportsInfo -> ImportsInfo
-importsRhs env (StgRhsCon _ con args) = importsDataCon env con . importsStgArgs env args
-importsRhs env (StgRhsClosure _ _ _ _ args body) = importsExpr env body. importsVars env args
-
-importsExpr :: IlxEnv -> StgExpr -> ImportsInfo -> ImportsInfo
-importsExpr env (StgLit _) = importsNone
-importsExpr env (StgApp f args) = importsVar env f.importsStgArgs env args
-importsExpr env (StgConApp con args) = importsDataCon env con.importsStgArgs env args
-importsExpr env (StgOpApp (StgFCallOp (CCall (CCallSpec (StaticTarget c) cc _)) _) args rty)
-  = addCCallInfo (c,cc, map stgArgType tm_args, rty) . importsStgArgs env args
-  where 
-    (ty_args,tm_args) = splitTyArgs1 args 
-
-importsExpr env (StgOpApp _ args res_ty) = importsType env res_ty. importsStgArgs env args
-
-
-importsExpr env (StgSCC _ expr) = importsExpr env expr
-importsExpr env (StgCase scrut _ _ bndr _ alts)
-  = importsExpr env scrut. imports_alts alts. importsVar env bndr
-   where
-    imports_alts (StgAlgAlts _ alg_alts deflt) 	-- The Maybe TyCon part is dealt with 
-						-- by the case-binder's type
-      = foldR imports_alg_alt alg_alts .  imports_deflt deflt
-       where
-        imports_alg_alt (con, bndrs, _, rhs)
-	  = importsExpr env rhs . importsDataCon env con. importsVars env bndrs
-
-    imports_alts (StgPrimAlts _ alg_alts deflt)
-      = foldR imports_prim_alt alg_alts . imports_deflt deflt
-       where
-        imports_prim_alt (_, rhs) = importsExpr env rhs
-    imports_deflt StgNoDefault = importsNone
-    imports_deflt (StgBindDefault rhs) = importsExpr env rhs
-
-
-importsExpr env (StgLetNoEscape _ _ bind body) = importsExpr env (StgLet bind body)
-importsExpr env (StgLet bind body)
-  = importsBind env bind .  importsExpr env body
-
-importsApp env v args = importsVar env v.  importsStgArgs env args
-importsStgArgs env args = foldR (importsStgArg env) args
-
-importsStgArg :: IlxEnv -> StgArg -> ImportsInfo -> ImportsInfo
-importsStgArg env (StgTypeArg ty) = importsType env ty
-importsStgArg env (StgVarArg v) = importsVar env v
-importsStgArg env _ = importsNone
-
-importsVars env vs = foldR (importsVar env) vs
-importsVar env v = importsName env (idName v). importsType env (idType v)
-
-importsName env n
-   | isInternalName n = importsNone
-   | ilxEnvModule env == nameModule n = importsNone
-   | isHomeModule (nameModule n) =  addModuleImpInfo (moduleName (nameModule n))
--- See HACK below
-   | isVanillaModule (nameModule n)  && not inPrelude =  importsPrelude
-   | isVanillaModule (nameModule n)  && inPrelude =   addModuleImpInfo (moduleName (nameModule n))
--- End HACK
-   | otherwise = addPackageImpInfo (modulePackage (nameModule n))
-
-
-importsPrelude | inPrelude = addModuleImpInfo (mkModuleName "PrelGHC")
-	       | otherwise = addPackageImpInfo basePackage
-
-
-importsType :: IlxEnv -> Type -> ImportsInfo -> ImportsInfo
-importsType env ty = importsType2 env (deepIlxRepType ty)
-
-importsType2 :: IlxEnv -> Type -> ImportsInfo -> ImportsInfo
-importsType2 env (AppTy f x) =  importsType2 env f . importsType2 env x
-importsType2 env (TyVarTy _) = importsNone
-importsType2 env (TyConApp tc args) =importsTyCon env tc . importsTypeArgs2 env args
-importsType2 env (FunTy arg res) =  importsType env arg .  importsType2 env res
-importsType2 env (ForAllTy tv body_ty) =  importsType2 env body_ty
-importsType2 env (NoteTy _ ty) = importsType2 env ty
-importsType2 _ _ = panic "IlxGen.lhs: importsType2 ty"
-importsTypeArgs2 env tys = foldR (importsType2 env) tys
-
-importsDataCon env dcon = importsTyCon env (dataConTyCon dcon)
-
-importsTyCon env tc | (not (isDataTyCon tc) || 
-                   isInternalName (getName tc) || 
-                   ilxEnvModule env == nameModule (getName tc)) = importsNone
-importsTyCon env tc | otherwise = importsName env (getName tc) . addTyConImpInfo tc .
-				    foldR (importsTyConDataCon env) (tyConDataCons tc)
-
-
-importsTyConDataCon :: IlxEnv -> DataCon -> ImportsInfo -> ImportsInfo
-importsTyConDataCon env dcon = foldR (importsTyConDataConType env) (filter (not . isVoidIlxRepType) (dataConRepArgTys dcon))
-
-importsTyConDataConType :: IlxEnv -> Type -> ImportsInfo -> ImportsInfo
-importsTyConDataConType env ty = importsTyConDataConType2 env (deepIlxRepType ty)
-
-importsTyConDataConType2 :: IlxEnv -> Type -> ImportsInfo -> ImportsInfo
-importsTyConDataConType2 env (AppTy f x) =  importsTyConDataConType2 env f . importsTyConDataConType2 env x
-importsTyConDataConType2 env (TyVarTy _) = importsNone
-importsTyConDataConType2 env (TyConApp tc args) = importsTyConDataConTypeTyCon env tc . importsTyConDataConTypeArgs2 env args
-importsTyConDataConType2 env (FunTy arg res) = importsTyConDataConType env arg .  importsTyConDataConType2 env res
-importsTyConDataConType2 env (ForAllTy tv body_ty) = importsTyConDataConType2 env body_ty
-importsTyConDataConType2 env (NoteTy _ ty) = importsTyConDataConType2 env ty
-importsTyConDataConType2 _ _ = panic "IlxGen.lhs: importsTyConDataConType2 ty"
-importsTyConDataConTypeArgs2 env tys = foldR (importsTyConDataConType2 env) tys
-
-importsTyConDataConTypeTyCon env tc | (not (isDataTyCon tc) || 
-                   isInternalName (getName tc) || 
-                   ilxEnvModule env == nameModule (getName tc)) = importsNone
-importsTyConDataConTypeTyCon env tc | otherwise = importsName env (getName tc)
-
-
-type StaticCCallInfo = (CLabelString,CCallConv,[Type],Type)
-type ImportsInfo = (UniqSet PackageName, UniqSet ModuleName, UniqSet TyCon, UniqFM StaticCCallInfo)
-   -- (Packages, Modules, Datatypes, Imported CCalls)
-
-emptyImpInfo :: ImportsInfo
-emptyImpInfo = (emptyUniqSet, emptyUniqSet, emptyUniqSet, emptyUFM)
-addPackageImpInfo p (w,x,y,z) = (addOneToUniqSet w p, x, y,z)
-addModuleImpInfo m (w,x,y,z) = (w, addOneToUniqSet x m, y,z)
-addTyConImpInfo tc (w,x,y,z) = (w, x, addOneToUniqSet y tc,z)
-addCCallInfo info@(nm,a,b,c) (w,x,y,z) = (w, x, y,addToUFM z nm info)
-
-ilxImportTyCon :: IlxEnv -> TyCon -> SDoc
-ilxImportTyCon env tycon | isDataTyCon tycon = ilxTyConDef True env tycon
-ilxImportTyCon _ _ | otherwise =  empty
-
-ilxImportPackage :: IlxEnv -> PackageName -> SDoc
-ilxImportPackage _ p = text ".assembly extern" <+> singleQuotes (ppr p <> hscOptionQual) <+> text "{ }"
-
-ilxImportModule :: IlxEnv -> ModuleName -> SDoc
-ilxImportModule _ m = text ".module extern" <+> singleQuotes (ppr m <> hscOptionQual <> text "o")
-
--- Emit a P/Invoke declaration for the imported C function
--- TODO: emit the right DLL name
-ilxImportCCall :: IlxEnv -> StaticCCallInfo -> SDoc
-ilxImportCCall env (c,cc,args,ret) = 
-    text ".method static assembly pinvokeimpl" <+> 
-    parens (doubleQuotes (text "HSstd_cbits.dll") <+> text "cdecl") <+> retdoc <+> singleQuotes (pprCLabelString c) <+> 
-    pprCValArgTys ilxTypeL env (map deepIlxRepType (filter (not. isVoidIlxRepType) args)) <+> 
-    text "unmanaged preservesig { }"
-  where 
-    retdoc = 
-          if isVoidIlxRepType ret then text "void" 
-          else ilxTypeR env (deepIlxRepType ret)
-
-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Type declarations}
-%*									*
-%************************************************************************
-
-\begin{code}
-
-
-ilxTyCon :: IlxEnv -> TyCon -> SDoc
-ilxTyCon env tycon =  ilxTyConDef False env tycon
-
--- filter to get only dataTyCons?
-ilxTyConDef importing env tycon = 
-	vcat [empty $$ line,
-	      text ".classunion" <+> (if importing then text "import" else empty) <+> tycon_ref <+> tyvars_text <+> super_text   <+> alts_text]
-   where
-     tycon_ref =  nameReference env (getName tycon)  <> (ppr tycon)
-     super_text = if importing then empty else text "extends thunk" <> angleBrackets (text "class" <+> tycon_ref)
-     tyvars = tyConTyVars tycon
-     (ilx_tvs, _) = categorizeTyVars tyvars
-     alts_env = extendIlxEnvWithFormalTyVars env ilx_tvs 
-     tyvars_text = pprTyVarBinders alts_env ilx_tvs 
-     alts = vcat (map (pprIlxDataCon alts_env) (tyConDataCons tycon))
-     alts_text = nest 2 (braces alts)
-
-pprIlxDataCon env dcon =
-        text ".alternative" <+> pprId dcon <+> 
-        parens (pprSepWithCommas (ilxTypeL env) (map deepIlxRepType (filter (not. isVoidIlxRepType) (dataConRepArgTys dcon))))
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Getting the .closures and literals out}			*
-%************************************************************************
-
-\begin{code}
-
-ilxBindClosures :: IlxEnv -> StgBinding -> SDoc
-ilxBindClosures env (StgNonRec _ b rhs) = ilxRhsClosures env (b,rhs)
-ilxBindClosures env (StgRec _ pairs)  
-  = vcat (map (ilxRhsClosures new_env) pairs)
-  where
-     new_env = extendIlxEnvWithBinds env pairs
-
----------------
-ilxRhsClosures _ (_, StgRhsCon _ _ _)
-  = empty
-
-ilxRhsClosures env (bndr, StgRhsClosure _ _ fvs upd args rhs)
-  = vcat [ilxExprClosures next_env rhs,
-
-	 empty $$ line,
-	 kind_text <+> singleQuotes cloname <+>  free_vs_text,
-	 nest 2 (braces (
-	    nest 2 (vcat [empty,
-                          vcat [text ".apply" <+> closure_sig_text,
-                                body_text
-                          ],
-                          empty
-                    ])
-                ))
-    ]
-  where
-    kind_of_thing = case upd of
-			  Updatable -> ASSERT( null args ) ".thunk"
-			  otherwise -> ".closure"
-    kind_text = text kind_of_thing 
-		
-    cloname = ilxEnvQualifyByModule env (ppr bndr)
-    next_env = ilxPlaceStgRhsClosure env bndr 
-    (free_vs_text,env_with_fvs) = pprFreeBinders next_env fvs
-
-
-    closure_sig_text =     
-      vcat [ text "()",
-             (case args of 
-               []        -> empty
-               otherwise -> args_text),
-             text "-->" <+>  rty_text]
-
-    (args_text,env_with_args) = pprArgBinders env_with_fvs args
-
-        -- Find the type returned, from the no. of args and the type of "bndr"
-    rty_text = 
-      case retType env_with_fvs (idIlxRepType bndr) args of
-       Just (env,ty) -> 
-          if isVoidIlxRepType ty  then  (text "void")
-          else ilxTypeR env ty 
-       Nothing -> trace "WARNING!  IlxGen.trace could not find return type - see generated ILX for context where this occurs." (text "// Could not find return type:" <+> ilxTypeR env_with_fvs (idIlxRepType bndr)<+> text ", non representation: " <+> ilxTypeR env_with_fvs (idType bndr))
-
-    -- strip off leading ForAll and Fun type constructions
-    -- up to the given number of arguments, extending the environment as
-    -- we go.  
-    retType env ty [] = Just (env, ty)
-    retType env (ForAllTy tv ty) (arg:args) = retType (extendIlxEnvWithTyArgs env [tv]) ty args
-    retType env (FunTy l r) (arg:args) = retType env r args
-    retType _ _ _  = Nothing
-
-	-- Code for the local variables
-    locals = ilxExprLocals env_with_args rhs
-
-    env_with_locals = extendIlxEnvWithLocals env_with_args locals
-
-	-- Code for the body of the main apply method
-    body_code = vcat [empty,
-                      pprIlxLocals env_with_args locals,
-		      ilxExpr (IlxEEnv env_with_locals (mkUniqSet (filter (not.isTyVar) args))) rhs Return,
-                      empty
-	        ]
-
-    body_text = nest 2 (braces (text ".maxstack 100" <+> nest 2 body_code))
-
-
-pprIlxLocals env [] = empty
-pprIlxLocals env vs 
-   = text ".locals" <+> parens (pprSepWithCommas (pprIlxLocal env) (filter nonVoidLocal vs))
-  where
-    nonVoidLocal (LocalId v,_) = not (isVoidIlxRepId v)
-    nonVoidLocal _ = True
-
-pprIlxLocal env (LocalId v,_) = ilxTypeL env (idIlxRepType v) <+> pprId v
-pprIlxLocal env (LocalSDoc (ty,doc,pin),_) = ilxTypeL env (deepIlxRepType ty) <+> (if pin then text "pinned" else empty) <+> doc
-
-
-pprFreeBinders env fvs 
-    = (ilx_tvs_text <+> vs_text, env2)
-    where   
-       (free_ilx_tvs, _,free_vs) = categorizeVars fvs
-       real_free_vs = filter (not . isVoidIlxRepId) free_vs
-        -- ignore the higher order type parameters for the moment
-       env1 = extendIlxEnvWithFreeTyVars env free_ilx_tvs 
-       ilx_tvs_text = pprTyVarBinders env1 free_ilx_tvs
-       vs_text = parens (pprSepWithCommas ppr_id real_free_vs)
-       ppr_id v = ilxTypeL env1 (idIlxRepType v) <+> pprId v 
-       env2 = extendIlxEnvWithFreeVars env1 real_free_vs 
-
-pprIdBinder env v = parens (ilxTypeL env (idIlxRepType v) <+> pprId v)
-
-	-- Declarations for the arguments of the main apply method
-pprArgBinders env [] = (empty,env)
-pprArgBinders env (arg:args)
-    = (arg_text <+> rest_text, res_env)
-   where 
-     (arg_text,env') = pprArgBinder env arg
-     (rest_text,res_env) = pprArgBinders env' args 
-
--- We could probably omit some void argument binders, but
--- don't...
-pprArgBinder env arg 
-  | isVoidIlxRepId arg = (text "()", extendIlxEnvWithArgs env [arg])
-  | otherwise 
-      = if isTyVar arg then 
-         let env' = extendIlxEnvWithTyArgs env [arg] in 
-         (pprTyVarBinder env' arg, env')
-      else (pprIdBinder env arg,extendIlxEnvWithArgs env [arg])
-
---------------
--- Compute local variables used by generated method.
--- The names of some generated locals are recorded as SDocs.
-
-data LocalSpec = LocalId Id | LocalSDoc (Type, SDoc, Bool)  -- flag is for pinning
-
-ilxExprLocals :: IlxEnv -> StgExpr -> [(LocalSpec,Maybe (IlxEnv,StgRhs))]
-ilxExprLocals env (StgLet bind body) 		  = ilxBindLocals env bind ++ ilxExprLocals env body
-ilxExprLocals env (StgLetNoEscape _ _ bind body)  = ilxBindLocals env bind ++ ilxExprLocals env body  -- TO DO????
-ilxExprLocals env (StgCase scrut _ _ bndr _ alts) 
-     = ilxExprLocals (ilxPlaceStgCaseScrut env) scrut ++ 
-       (if isDeadBinder bndr then [] else [(LocalId bndr,Nothing)]) ++ 
-       ilxAltsLocals env alts
-ilxExprLocals env (StgOpApp (StgFCallOp fcall _) args _) 
-     = concat (ilxMapPlaceArgs 0 ilxCCallArgLocals env args)
-ilxExprLocals _ _  = []
-
--- Generate locals to use for pinning arguments as we cross the boundary
--- to C.
-ilxCCallArgLocals env (StgVarArg v) | pinCCallArg v = 
-   [(LocalSDoc (idType v, ilxEnvQualifyByExact env (ppr v) <> text "pin", True), Nothing)]
-ilxCCallArgLocals _ _ | otherwise = []
-
-ilxBindLocals env (StgNonRec _ b rhs) = [(LocalId b,Just (env, rhs))]
-ilxBindLocals env (StgRec _ pairs)    = map (\(x,y) -> (LocalId x,Just (env, y))) pairs
-
-ilxAltsLocals env (StgAlgAlts  _ alts deflt) = ilxDefltLocals env deflt ++ concat (ilxMapPlaceAlts ilxAlgAltLocals env alts)
-ilxAltsLocals env (StgPrimAlts _ alts deflt) = ilxDefltLocals env deflt ++ concat (ilxMapPlaceAlts ilxPrimAltLocals env alts)
-
-ilxAlgAltLocals env (_, bndrs, _, rhs) = map (\x -> (LocalId x,Nothing)) (filter (\v -> isId v && not (isDeadBinder v)) bndrs) ++ ilxExprLocals env rhs
-ilxPrimAltLocals env (_, rhs)          = ilxExprLocals env rhs
-
-ilxDefltLocals _ StgNoDefault 	= []
-ilxDefltLocals env (StgBindDefault rhs) = ilxExprLocals (ilxPlaceStgBindDefault env) rhs
-
---------------
-ilxExprClosures :: IlxEnv -> StgExpr -> SDoc
-ilxExprClosures env (StgApp _ args)
-  = vcat (ilxMapPlaceArgs 0 (ilxArgClosures) env args)  -- get strings
-ilxExprClosures env (StgConApp _ args)
-  = vcat (ilxMapPlaceArgs 0 (ilxArgClosures) env args) -- get strings
-ilxExprClosures env (StgOpApp _ args _)
-  = vcat (ilxMapPlaceArgs 0 (ilxArgClosures) env args) -- get strings
-ilxExprClosures env (StgLet bind body)
-  = ilxBindClosures env bind $$ ilxExprClosures (extendIlxEnvWithBinds env (ilxPairs1 bind)) body
-ilxExprClosures env (StgLetNoEscape _ _ bind body)  -- TO DO????
-  = ilxBindClosures env bind $$ ilxExprClosures (extendIlxEnvWithBinds env (ilxPairs1 bind)) body
-ilxExprClosures env (StgCase scrut _ _ _ _ alts)
-  = ilxExprClosures (ilxPlaceStgCaseScrut env) scrut $$ ilxAltsClosures env alts 
-ilxExprClosures env (StgLit lit) 
-  = ilxGenLit env lit 
-ilxExprClosures _ _ 
-  = empty
-
-ilxAltsClosures env (StgAlgAlts _ alts deflt)
-  = vcat [ilxExprClosures (ilxPlaceAlt env i) rhs | (i,(_, _, _, rhs))  <- [1..] `zip` alts]
-    $$ 
-    ilxDefltClosures env deflt
-
-ilxAltsClosures env (StgPrimAlts _ alts deflt)
-  = vcat [ilxExprClosures (ilxPlaceAlt env i) rhs | (i,(_, rhs)) <- [1..] `zip` alts]
-    $$ 
-    vcat [ ilxGenLit (ilxPlacePrimAltLit env i) lit | (i,(lit,_)) <- [1..] `zip` alts]
-    $$ 
-    ilxDefltClosures  env deflt
-
-ilxDefltClosures env (StgBindDefault rhs) = ilxExprClosures (ilxPlaceStgBindDefault env) rhs
-ilxDefltClosures _ StgNoDefault	  = empty
-
-ilxArgClosures env (StgLitArg lit) = ilxGenLit env lit 
-ilxArgClosures _ _ = empty
-
-
-
-ilxGenLit env (MachStr fs) 
-  = vcat [text ".field static assembly char "  <+> singleQuotes nm <+> text "at" <+> nm <> text "L",
-          text ".data" <+> nm <> text "L" <+> text "= char *("  <> pprFSInILStyle fs  <> text ")"
-         ]
- where
-   nm = ilxEnvQualifyByExact env (text "string")
-
-ilxGenLit  _ _ = empty
-
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Generating code}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-
--- Environment when generating expressions
-data IlxEEnv = IlxEEnv IlxEnv (UniqSet Id)
-
-data Sequel = Return | Jump IlxLabel
-
-ilxSequel Return     = text "ret"
-ilxSequel (Jump lbl) = text "br" <+> pprIlxLabel lbl
-
-isReturn Return = True
-isReturn (Jump _) = False
-
-
-ilxExpr :: IlxEEnv -> StgExpr 
-	-> Sequel 	-- What to do at the end
-	-> SDoc
-
-ilxExpr (IlxEEnv env _) (StgApp fun args) sequel
-  = ilxFunApp env fun args (isReturn sequel) $$ ilxSequel sequel
-
--- ilxExpr eenv (StgLit lit) sequel
-ilxExpr (IlxEEnv env _) (StgLit lit) sequel
-  = pushLit env lit $$ ilxSequel sequel
-
--- ilxExpr eenv (StgConApp data_con args) sequel
-ilxExpr (IlxEEnv env _) (StgConApp data_con args) sequel
-  = text " /* ilxExpr:StgConApp */ " <+>  ilxConApp env data_con args $$ ilxSequel sequel
-
--- ilxExpr eenv (StgPrimApp primop args _) sequel
-ilxExpr (IlxEEnv env _) (StgOpApp (StgFCallOp fcall _) args ret_ty) sequel
-  = ilxFCall env fcall args ret_ty $$ ilxSequel sequel
-
-ilxExpr (IlxEEnv env _) (StgOpApp (StgPrimOp primop) args ret_ty) sequel
-  = ilxPrimOpTable primop args env $$ ilxSequel sequel
-
---BEGIN TEMPORARY
--- The following are versions of a peephole optimizations for "let t = \[] t2[fvs] in t"
--- I think would be subsumed by a general treatmenet of let-no-rec bindings??
-ilxExpr eenv@(IlxEEnv env _) (StgLet (StgNonRec _ bndr (StgRhsClosure _ _ _ _ [] rhs)) (StgApp fun [])) sequel 
-              | (bndr == fun && null (ilxExprLocals env rhs)) -- TO DO???
-  = ilxExpr eenv rhs sequel
-ilxExpr eenv@(IlxEEnv env _) (StgLetNoEscape _ _ (StgNonRec _ bndr (StgRhsClosure _ _ _ _ [] rhs)) (StgApp fun [])) sequel 
-              | (bndr == fun && null (ilxExprLocals env rhs)) -- TO DO???
-  = ilxExpr eenv rhs sequel
---END TEMPORARY
-
-ilxExpr eenv (StgLet bind body) sequel
-  = ilxBind eenv bind $$ ilxExpr eenv body sequel
-
-
-ilxExpr eenv (StgLetNoEscape _ _ bind body) sequel -- TO DO???
-  = ilxBind eenv bind $$ ilxExpr eenv body sequel
-
--- StgCase: Special case 1 to avoid spurious branch.
-ilxExpr eenv@(IlxEEnv env live) (StgCase (StgApp fun args) live_in_case _live_in_alts bndr _ alts) sequel
-  = vcat [ilxWipe env (uniqSetToList (live `minusUniqSet` live_in_case)),
-	  ilxFunApp (ilxPlaceStgCaseScrut env) fun args False,
-          --ilxWipe env (uniqSetToList (live_in_case `minusUniqSet` _live_in_alts)),
-	  --ilxAlts (IlxEEnv env _live_in_alts) bndr alts sequel
-	  ilxAlts (IlxEEnv env live_in_case) bndr alts sequel
-    ]
-
--- StgCase: Special case 2 to avoid spurious branch.
-ilxExpr eenv@(IlxEEnv env live) (StgCase (StgOpApp (StgPrimOp primop) args ret_ty) live_in_case _live_in_alts bndr _ alts) sequel
-  = vcat [ilxWipe env (uniqSetToList (live `minusUniqSet` live_in_case)),
-	  ilxPrimOpTable primop args (ilxPlaceStgCaseScrut env),
-          --ilxWipe env (uniqSetToList (live_in_case `minusUniqSet` _live_in_alts)),
-	  --ilxAlts (IlxEEnv env _live_in_alts) bndr alts sequel
-	  ilxAlts (IlxEEnv env live_in_case) bndr alts sequel
-    ]
-
--- StgCase: Normal case.
-ilxExpr eenv@(IlxEEnv env live) (StgCase scrut live_in_case _live_in_alts bndr _ alts) sequel
-  = vcat [ilxWipe env (uniqSetToList (live `minusUniqSet` live_in_case)),
-	  ilxExpr (IlxEEnv (ilxPlaceStgCaseScrut env) live_in_case) scrut (Jump join_lbl),
-	  ilxLabel join_lbl,
-          --ilxWipe env (uniqSetToList (live_in_case `minusUniqSet` _live_in_alts)),
-	  --ilxAlts (IlxEEnv env _live_in_alts) bndr alts sequel
-	  ilxAlts (IlxEEnv env live_in_case) bndr alts sequel
-    ]
-  where
-    join_lbl = mkJoinLabel bndr
-
-ilxExpr _ _ _ 
-  = panic "ilxExpr:  Patterns not matched:(IlxEEnv _ _) (StgSCC _ _) _ (IlxEEnv _ _) (StgLam _ _ _) _"
-
-
--- Wipe out locals and arguments that are no longer in use, to
--- prevent space leaks. If the VM is implemented 100% correctly then
--- this should probably not be needed, as the live variable analysis
--- in the JIT would tell the GC that these locals and arguments are
--- no longer live.  However I'm putting it in here so we can
--- check out if it helps.
---
--- Also, in any case this doesn't capture everything we need.  e.g.
--- when making a call:
---     case f x of ...
--- where x is not used in the alternatives, then the variable x
--- is no longer live from the point it is transferred to the call
--- onwards.  We should expunge "live_in_case - live_in_alts" right
--- before making the call, not after returning from the call....
---
--- Strictly speaking we also don't need to do this for primitive
--- values such as integers and addresses, i.e. things not
--- mapped down to GC'able objects.
-ilxWipe env ids 
-   = vcat (map (ilxWipeOne env) (filter (not.isVoidIlxRepId) ids))
-
-ilxWipeOne env id
-   = case lookupIlxVarEnv env id of
-	  Just Local  -> text "ldloca " <+> pprId id <+> text "initobj.any" <+> (ilxTypeL env (idIlxRepType id))
-	  Just Arg   -> text "deadarg " <+> pprId id <+> text "," <+> (ilxTypeL env (idIlxRepType id))
-	  Just (CloVar _)  -> ilxComment (text "not yet wiping closure variable" <+> pprId id )
-	  _ -> ilxComment (text "cannot wipe non-local/non-argument" <+> pprId id )
-  where 
-      
-
-----------------------
-
-ilxAlts :: IlxEEnv -> Id -> StgCaseAlts -> Sequel -> SDoc
-ilxAlts (IlxEEnv env live) bndr alts sequel
-	-- At the join label, the result is on top
-	-- of the stack
-  = vcat [store_in_bndr,
-	  do_case_analysis alts
-    ]
-  where
-    scrut_rep_ty = deepIlxRepType (idType bndr)
-
-    store_in_bndr | isDeadBinder bndr = empty
-                  | isVoidIlxRepId bndr 
-                        = ilxComment (text "ignoring store of zero-rep value to be analyzed")
-		  | otherwise	      = text "dup" $$ (text "stloc" <+> pprId bndr)
-
-    do_case_analysis (StgAlgAlts _ []    deflt)
-	= do_deflt deflt
-
-    do_case_analysis (StgAlgAlts _ args deflt) 
-        = do_alg_alts ([1..] `zip` args) deflt
-
-    do_case_analysis (StgPrimAlts _ alts deflt)
-	= do_prim_alts ([1..] `zip` alts) $$ do_deflt deflt
-
-    do_alg_alts [(i, alt@(data_con,bndrs,used_flags, rhs))] StgNoDefault | isUnboxedTupleCon data_con
-      -- Collapse the analysis of unboxed tuples where 
-      -- some or all elements are zero-sized
-      --
-      -- TO DO: add bndrs to set of live variables
-          = case bndrs' of
-                  [h] -> bind_collapse bndrs used_flags <+> do_rhs_no_pop alt_env rhs
-                  _ -> bind_components alt_env dcon' bndrs 0 used_flags <+> do_rhs alt_env rhs
-           where 
-            bndrs' = filter (not. isVoidIlxRepId) bndrs
-            -- Replacement unboxed tuple type constructor, used if any of the
-            -- arguments have zero-size and more than one remains.
-            dcon'  = tupleCon Unboxed (length bndrs')
-
-            alt_env = IlxEEnv (ilxPlaceAlt env i) live
-            --alt_env = IlxEEnv (ilxPlaceAlt env i) 
-
-            bind_collapse [] _ = panic "bind_collapse: unary element not found"
-            bind_collapse (h:t) (is_used:used_flags) 
-                | isVoidIlxRepId h = ilxComment (text "zero-rep binding eliminated") <+> (bind_collapse t used_flags)
-	        | not is_used = ilxComment (text "not used") <+> text "pop"
-                | otherwise = text "stloc" <+> pprId h
-
-
-    do_alg_alts [(i, alt@(data_con,bndrs,used_flags, rhs))] StgNoDefault 
-            = vcat [text "castdata" <+> sep [ilxTypeR env scrut_rep_ty <> comma,
-		  			     ilxConRef env data_con],
- 		do_alg_alt (IlxEEnv (ilxPlaceAlt env i) live) alt
-	      ]
-
-    do_alg_alts alts deflt
-	= vcat [text "datacase" <+> sep [ilxTypeR env scrut_rep_ty,text ",",
-					 pprSepWithCommas pp_case labels_w_alts],
-		do_deflt deflt,
-		vcat (map do_labelled_alg_alt labels_w_alts)
-	  ]
-	where
-	  pp_case (i, (lbl, (data_con, _, _, _))) = parens (ilxConRef env data_con <> comma <> pprIlxLabel lbl)
-	  labels_w_alts = [(i,(mkAltLabel bndr i, alt)) | (i, alt) <- alts]
-
-    do_prim_alts [] = empty
-    do_prim_alts ((i, (lit,alt)) : alts) 
-	= vcat [text "dup", pushLit (ilxPlacePrimAltLit env i) lit, text "bne.un" <+> pprIlxLabel lbl, 
-		do_rhs (IlxEEnv (ilxPlaceAlt env i) live) alt, 
-		ilxLabel lbl, do_prim_alts alts]
-	where
-	  lbl = mkAltLabel bndr i
-
-    do_labelled_alg_alt (i,(lbl, alt)) 
-        = ilxLabel lbl $$ do_alg_alt (IlxEEnv (ilxPlaceAlt env i) live) alt
-
-    do_alg_alt alt_eenv (data_con, bndrs, used_flags, rhs) 
-      = vcat [bind_components alt_eenv data_con bndrs 0 used_flags,
-	      do_rhs alt_eenv rhs
-	     ]
-
-    bind_components alt_eenv data_con [] n _ = empty
-    bind_components alt_eenv data_con (h:t) n (is_used:used_flags) 
-       | isVoidIlxRepId h 
-             -- don't increase the count in this case
-             = ilxComment (text "zero-rep binding eliminated") 
-               <+> bind_components alt_eenv data_con t n used_flags
-       | otherwise 
-             = bind_component alt_eenv data_con h is_used n 
-               <+> bind_components alt_eenv data_con t (n + 1) used_flags
-
-    bind_component alt_eenv@(IlxEEnv alt_env _) data_con bndr is_used reduced_fld_no 
-	| not is_used 
-            = ilxComment (text "not used")
-        | isVoidIlxRepId bndr 
-            = ilxComment (text "ignoring bind of zero-rep variable")
-	| otherwise   = vcat [text "dup",
-			      ld_data alt_env data_con reduced_fld_no bndr,
-			      text "stloc" <+> pprId bndr]
-
-    do_deflt (StgBindDefault rhs) = do_rhs (IlxEEnv (ilxPlaceStgBindDefault env) live) rhs
-    do_deflt StgNoDefault 	  = empty
-
-    do_rhs alt_eenv rhs  
-        | isVoidIlxRepId bndr = do_rhs_no_pop alt_eenv rhs     -- void on the stack, nothing to pop
-        | otherwise = text "pop" $$ do_rhs_no_pop alt_eenv rhs  -- drop the value
-
-    do_rhs_no_pop alt_env rhs = ilxExpr alt_env rhs sequel
-
-    ld_data alt_env data_con reduced_fld_no bndr
-      | isUnboxedTupleCon data_con
-      = text "ldfld" <+> sep [text "!" <> integer reduced_fld_no,
-			      ilxTypeR alt_env scrut_rep_ty <> text "::fld" <> integer reduced_fld_no]
-      | otherwise 
-      = text "lddata" <+> sep [ilxTypeR alt_env scrut_rep_ty <> comma, 
-		               ilxConRef env data_con <> comma,
-			       integer reduced_fld_no]
-
-
--------------------------
-
-ilxBestTermArity = 3
-ilxBestTypeArity = 7
-
-
--- Constants of unlifted types are represented as
--- applications to no arguments.
-ilxFunApp env fun [] _ | isUnLiftedType (idType fun)
-  = pushId env fun
-
-ilxFunApp env fun args tail_call 
-  =	-- For example:
-        --	ldloc f		function of type forall a. a->a
-	--	ldloc x		arg of type Int
-	--	.tail callfunc <Int32> (!0) --> !0
-	--
-    vcat [pushId env fun,ilxFunAppAfterPush env fun args tail_call]
-
-ilxFunAppAfterPush env fun args tail_call 
-  =	-- For example:
-        --	ldloc f		function of type forall a. a->a
-	--	ldloc x		arg of type Int
-	--	.tail callfunc <Int32> (!0) --> !0
-	--
-    vcat [ilxFunAppArgs env 0 (idIlxRepType fun) args tail_call known_clo]
-  where
-    known_clo :: KnownClosure
-    known_clo =
-      case lookupIlxBindEnv env fun of
-	  Just (_, StgRhsClosure  _ _ _ Updatable _ _)   -> Nothing 
-	  Just (place, StgRhsClosure  _ _ fvs _ args _)  -> Just (place,fun,args,fvs)
-	  _ -> Nothing -- trace (show fun ++ " --> " ++ show (idArity fun))
-
-type KnownClosure = Maybe (  IlxEnv	-- Of the binding site of the function
-			   , Id		-- The function
-			   , [Var]	-- Binders
-			   , [Var])	-- Free vars of the closure
-
--- Push as many arguments as ILX allows us to in one go, and call the function
--- Recurse until we're done.
--- The function is already on the stack
-ilxFunAppArgs :: IlxEnv
-	      -> Int		-- Number of args already pushed (zero is a special case;
-				--	otherwise used only for place generation)
-	      -> Type		-- Type of the function
-	      -> [StgArg]	-- The arguments
-	      -> Bool		-- True <=> tail call please
-	      -> KnownClosure	-- Information about the function we're calling
-	      -> SDoc
-
-ilxFunAppArgs env num_sofar funty args tail_call known_clo
- =   vcat [vcat (ilxMapPlaceArgs num_sofar pushArgWithVoids env now_args),
-	   call_instr <+> (if num_sofar == 0 then text "() /* first step in every Haskell app. is to a thunk */ " else empty)
-                     <+> now_args_text
-                     <+> text "-->" 
-                     <+> later_ty_text,
-           later
-          ]
-  where
-    now_args_text = 
-      case now_arg_tys of
-        [] -> empty
-        _ -> hsep (map (pprIlxArgInfo env_after_now_tyvs) now_arg_tys)
-
-    later_ty_text
-        | isVoidIlxRepType later_ty = text "void"
-        | otherwise = ilxTypeR env_after_now_tyvs later_ty
-
-    (now_args,now_arg_tys,env_after_now_tyvs,later_args,later_ty) = 
-	case args of
-          (StgTypeArg v:rest) -> get_type_args ilxBestTypeArity args env funty
-          _ -> get_term_args 0 ilxBestTermArity args env funty
-
-     -- Only apply up to maxArity real (non-type) arguments
-     -- at a time.  ILX should, in principle, allow us to apply
-     -- arbitrary numbers, but you will get more succinct 
-     -- (and perhaps more efficient) IL code
-     -- if you apply in clumps according to its maxArity setting.
-     -- This is because it has to unwind the stack and store it away
-     -- in local variables to do the partial applications.
-     --
-     -- Similarly, ILX only allows one type application at a time, at
-     -- least until we implement unwinding the stack for this case.
-     --
-     -- NB: In the future we may have to be more careful 
-     -- all the way through 
-     -- this file to bind type variables as we move through
-     -- type abstractions and "forall" types.  This would apply
-     -- especially if the type variables were ever bound by expressions
-     -- involving the type variables.  
-
-    -- This part strips off at most "max" term applications or one type application
-    get_type_args 0 args env funty = ([],[],env,args,funty)
-    get_type_args max args env (NoteTy _ ty) = 
-          trace "IlxGen Internal Error: non representation type passed to get_args" (get_type_args max args env ty)
-    get_type_args max ((arg@(StgTypeArg v)):rest) env (ForAllTy tv rem_funty) 
-        = if isIlxTyVar tv then 
-            let env2 = extendIlxEnvWithFormalTyVars env [tv] in 
-            let rest_ty = deepIlxRepType (substTyWith [tv] [v] rem_funty) in 
-            let (now,now_tys,env3,later,later_ty) = get_type_args (max - 1) rest env rest_ty in 
-            let arg_ty = mkTyVarTy tv in 
-            (arg:now,(arg,arg_ty):now_tys,env2, later, later_ty)
-          else 
-             get_type_args max rest env rem_funty  -- ? subst??
-    get_type_args _ (StgTypeArg _:_) _ _ = trace "IlxGen Internal Error: get_type_args could not get ForAllTy for corresponding arg" ([],[],env,[],funty)
-    get_type_args _ args env funty = ([],[],env,args,funty)
-
-    get_term_args n max args env (NoteTy _ ty)
-       -- Skip NoteTy types 
-       = trace "IlxGen Internal Error: non representation type passed to get_term_args" (get_term_args n max args env ty)
-    get_term_args n 0 args env funty
-       -- Stop if we've hit the maximum number of ILX arguments to apply n one hit.
-       = ([],[],env,args,funty)
-    get_term_args n max args env funty
-      | (case known_clo of
-           Just (_,_,needed,_) -> needed `lengthIs` n
-           Nothing -> False)
-       -- Stop if we have the optimal number for a direct call
-       = ([],[],env,args,funty)
-    get_term_args _ _ (args@(StgTypeArg _:_)) env funty 
-       -- Stop if we hit a type arg.
-       = ([],[],env,args,funty)
-    get_term_args n max (h:t) env (FunTy dom ran)
-       -- Take an argument.
-       = let (now,now_tys,env2,later,later_ty) = get_term_args (n+1) (max - 1) t env ran in 
-         (h:now, (h,dom):now_tys,env2,later,later_ty)
-    get_term_args _ max (h:t) env funty = trace "IlxGen Internal Error: get_term_args could not get FunTy or ForAllTy for corresponding arg" ([],[],env,[],funty)
-    get_term_args _ max args env funty = ([],[],env,args,funty)
-
-    -- Are there any remaining arguments?
-    done  = case later_args of
-          [] -> True
-          _ -> False
-
-    -- If so, generate the subsequent calls.
-    later = if done then text "// done"  
-            else ilxFunAppArgs env (num_sofar + length now_args) later_ty later_args tail_call Nothing
-
-    -- Work out whether to issue a direct call a known closure (callclo) or
-    -- an indirect call (callfunc).  Basically, see if the identifier has
-    -- been let-bound, and then check we are applying exactly the right 
-    -- number of arguments.  Also check that it's not a thunk (actually, this
-    -- is done up above).
-    -- 
-    -- The nasty "all" check makes sure that 
-    -- the set of type variables in scope at the callsite is a superset 
-    -- of the set of type variables needed for the direct call.  This is
-    -- is needed because not all of the type variables captured by a 
-    -- let-bound binding will get propogated down to the callsite, and 
-    -- the ILX system of polymorphism demands that the free type variables
-    -- get reapplied when we issue the direct "callclo".  The
-    -- type variables are in reality also "bound up" in the closure that is
-    -- passed as the first argument, so when we do an indirect call
-    -- to that closure we're fine, which is why we don't need them in 
-    -- the "callfunc" case.
-    basic_call_instr =
-      case known_clo of
-        Just (known_env,fun,needed,fvs) | (equalLength needed now_args) && 
-                                          all (\x -> elemIlxTyEnv x env) free_ilx_tvs -> 
-           vcat [text "callclo class",
-                 nameReference env (idName fun) <+> singleQuotes (ilxEnvQualifyByModule env (ppr fun)),
-                 pprTypeArgs ilxTypeR env (map mkTyVarTy free_ilx_tvs)]
-           <> text ","
-          where 
-           (free_ilx_tvs, free_non_ilx_tvs,free_vs) = categorizeVars fvs
-        otherwise -> text "callfunc"
-    call_instr =
-           if (tail_call && done) then text "tail." <+> basic_call_instr
-	   else basic_call_instr
-
-
---------------------------
--- Print the arg info at the call site
--- For type args we are, at the moment, required to
--- give both the actual and the formal (bound).  The formal
--- bound is always System.Object at the moment (bounds are
--- not properly implemented in ILXASM in any case, and nor do
--- we plan on making use og them) For
--- non-type args the actuals are on the stack, and we just give the
--- formal type.
-pprIlxArgInfo env (StgTypeArg  arg,ty) =  
-    angleBrackets (ilxTypeR env (deepIlxRepType arg) <+> ilxComment (text "actual for tyvar")) <+> text "<class [mscorlib] System.Object>" 
-pprIlxArgInfo env (_,ty) =  
-    parens (ilxTypeL env ty)
-
-
-----------------------------
--- Code for a binding
-ilxBind :: IlxEEnv -> StgBinding -> SDoc
-ilxBind eenv@(IlxEEnv env _) bind = 
-    vcat [vcat (map (ilxRhs env rec) pairs), 
-          vcat (map (ilxFixupRec env rec) pairs)]
-       where 
-         rec = ilxRecIds1 bind
-         pairs = ilxPairs1 bind
-
-
-----------------------------
--- Allocate a closure or constructor.  Fix up recursive definitions.
-ilxRhs :: IlxEnv -> [Id] -> (Id, StgRhs) -> SDoc
-
-ilxRhs env rec (bndr, _) | isVoidIlxRepId bndr  
-  = empty
-
-ilxRhs env rec (bndr, StgRhsCon _ con args)
-  = vcat [text " /* ilxRhs:StgRhsCon */ " <+> ilxConApp env con args,
-	   text "stloc" <+> pprId bndr
-          ]
-
-ilxRhs env rec (bndr, StgRhsClosure _ _ fvs upd args rhs)
-  = 	-- Assume .closure v<any A>(int64,!A) { 
-	--		.apply <any B> (int32) (B) { ... }
-	--	   }
-	-- Then
-        --    let v = \B (x:int32) (y:B). ... 
-        -- becomes:
-        --    newclo v<int32>(int64,!0)
-	--    stloc v
-    vcat [vcat (map pushFv free_vs),
-          (if null free_non_ilx_tvs then empty else (ilxComment (text "ignored some higher order type arguments in application - code will be non-verifiable"))),
-	  text "newclo" <+> clotext,
-	  text "stloc" <+> pprId bndr
-    ]
-  where
-    pushFv id = if elem id rec then text "ldnull" else pushId env id
-    (free_ilx_tvs, free_non_ilx_tvs,free_vs) = categorizeVars fvs
-    clotext = pprIlxNamedTyConApp env (ilxEnvQualifyByModule env (ppr bndr)) (map mkTyVarTy free_ilx_tvs)
-
-ilxFixupRec env rec (bndr, _) | isVoidIlxRepId bndr = ilxComment (text "no recursive fixup for void-rep-id")
-
-ilxFixupRec env rec (bndr, StgRhsCon _ con args)
-  = text "// no recursive fixup"
-
-ilxFixupRec env rec (bndr, StgRhsClosure _ _ fvs upd args rhs)
-     = vcat [vcat (map fixFv rec)]
-  where
-    fixFv recid = if elem recid fvs then 
-                    vcat [pushId env bndr,
-                          pushId env recid,
-                          text "stclofld" <+> clotext <> text "," <+> pprId recid] 
-                else text "//no fixup needed for" <+> pprId recid
-    (free_ilx_tvs, free_non_ilx_tvs,free_vs) = categorizeVars fvs
-    clotext = pprIlxNamedTyConApp env (ilxEnvQualifyByModule env (ppr bndr)) (map mkTyVarTy free_ilx_tvs)
-
-
-
----------------------------------------------
--- Code for a top-level binding in a module
-ilxPairs binds = concat (map ilxPairs1 binds)
-
-ilxPairs1 (StgNonRec _ bndr rhs) = [(bndr,rhs)]
-ilxPairs1 (StgRec _ pairs)       = pairs
-
-ilxRecIds1 (StgNonRec _ bndr rhs) = []
-ilxRecIds1 (StgRec _ pairs)       = map fst pairs
-
----------------------------------------------
--- Code for a top-level binding in a module
--- TODO: fix up recursions amongst CAF's
--- e.g. 
---    x = S x
--- for infinity...
--- 
--- For the moment I've put in a completely spurious "reverse"...
---
--- Consider: make fixing up of CAF's part of ILX?  i.e.
--- put static, constant, allocated datastructures into ILX. 
-
-stableSortBy :: (a -> a -> Ordering) -> [a] -> [a]
-stableSortBy f (h:t) = insertBy f h (stableSortBy f t)
-stableSortBy f [] = []
-
-usedBy :: (Id,StgRhs) -> (Id,StgRhs) -> Ordering
-usedBy (m,_) (_,StgRhsCon _ data_con args) | any (isArg m) args = LT
-usedBy (m,_) (n,_) | m == n = EQ
-usedBy (m,_) (_,_) = GT
-
-isArg m  (StgVarArg n) = (n == m)
-isArg m _ = False
-
-
-ilxTopBind :: Module -> IlxEnv -> [(Id,StgRhs)] -> SDoc
---ilxTopBind mod env (StgNonRec _ bndr rhs) = 
---ilxTopRhs env (bndr,rhs)
-ilxTopBind mod env pairs       = 
-   vcat [text ".class" <+> pprId mod,
-         nest 2 (braces (nest 2 (vcat [empty,cctor, flds, empty])))]
-     where
-       cctor = vcat [text ".method static rtspecialname specialname void .cctor()",
-                     nest 2 (braces 
-                      (nest 2 (vcat [text ".maxstack 100",
-			             text "ldstr \"LOG: initializing module" <+> pprId mod <+> text "\" call void ['mscorlib']System.Console::WriteLine(class [mscorlib]System.String)",
-                                     vcat (map (ilxTopRhs mod env) (stableSortBy usedBy pairs)), 
-			             text "ldstr \"LOG: initialized module" <+> pprId mod <+> text "\" call void ['mscorlib']System.Console::WriteLine(class [mscorlib]System.String)",
-                                     text "ret",
-                                     empty])))]
-       flds =   vcat (map (ilxTopRhsStorage mod env) pairs)
-
---ilxTopRhs mod env (bndr, _) | isVoidIlxRepId bndr 
---  = empty
-
-ilxTopRhs mod env (bndr, StgRhsClosure _ _ fvs upd args rhs)
-  = vcat [vcat (map (pushId env) free_vs),
-         (if null free_non_ilx_tvs then empty else (ilxComment (text "ignored some higher order type arguments in application - code will be non verifiable...."))),
-	  text "newclo" <+> pprIlxNamedTyConApp env (ilxEnvQualifyByModule env (ppr bndr)) (map mkTyVarTy free_ilx_tvs),
-	  text "stsfld"  <+> pprFieldRef env (mod,bndTy,bndr)
-    ]
-  where
-    (free_ilx_tvs, free_non_ilx_tvs,free_vs) = categorizeVars fvs
-    bndTy = idIlxRepType bndr
-
-ilxTopRhs mod env (bndr, StgRhsCon _ data_con args)
-  = vcat [ text " /* ilxTopRhs: StgRhsCon */ " <+> ilxConApp env data_con args, 
-	   text "stsfld" <+> pprFieldRef env (mod,bndTy,bndr)
-    ]
-  where
-    bndTy = idIlxRepType bndr
-
-pprFieldRef env (mod,ty,id) 
-  =  ilxTypeL env ty <+> moduleReference env mod <+> pprId mod <> text "::" <> pprId id
-
-ilxTopRhsStorage mod env (bndr, StgRhsClosure _ _ _ _ _ _) 
-  =   text ".field public static " <+> ilxTypeL env bndTy <+> pprId bndr
-  where
-    bndTy = idIlxRepType bndr
-ilxTopRhsStorage mod env (bndr, StgRhsCon _ _ _) 
-  =   text ".field public static " <+> ilxTypeL env bndTy <+> pprId bndr
-  where
-    bndTy = idIlxRepType bndr
-
---------------------------------------
--- Push an argument
-pushArgWithVoids =  pushArg_aux True
-pushArg = pushArg_aux False
-
-pushArg_aux voids env (StgTypeArg ty) = empty
-pushArg_aux voids env (StgVarArg var) = pushId_aux voids env var
-pushArg_aux voids env (StgLitArg lit) = pushLit env lit
-
-
-mapi f l = mapi_aux f l 0
-
-mapi_aux f [] n = []
-mapi_aux f (h:t) n = f n h : mapi_aux f t (n+1)
-
---------------------------------------
--- Push an Id
-pushId = pushId_aux False
-
-pushId_aux :: Bool -> IlxEnv -> Id -> SDoc
-pushId_aux voids _ id | isVoidIlxRepId id =
-   /* if voids then  text "ldunit" else */ ilxComment (text "pushId: void rep skipped")
-pushId_aux _ env var 
-  = case lookupIlxVarEnv env var of
-	  Just Arg    -> text "ldarg"    <+> pprId var
-	  Just (CloVar n) -> text "ldenv" <+> int n
-	  Just Local  -> text "ldloc"    <+> pprId var
-	  Just (Top m)  -> 
-             vcat [ilxComment (text "pushId (Top) " <+> pprId m), 
-                   text "ldsfld" <+> ilxTypeL env (idIlxRepType var)
-                      <+> moduleReference env m <+> pprId (moduleName m) <> text "::" <> pprId var]
-
-	  Nothing ->  
-             vcat [ilxComment (text "pushId (import) " <+> pprIlxTopVar env var), 
-                   text "ldsfld" <+> ilxTypeL env (idIlxRepType var) 
-                    <+> pprIlxTopVar env var]
-
---------------------------------------
--- Push a literal
-pushLit env (MachChar c)   = text "ldc.i4" <+> int c
-pushLit env (MachStr s)    = text "ldsflda char "  <+> ilxEnvQualifyByExact env (text "string") -- pprFSInILStyle s 
-pushLit env (MachInt i)    = text "ldc.i4" <+> integer i
-pushLit env (MachInt64 i)  = text "ldc.i8" <+> integer i
-pushLit env (MachWord w)   = text "ldc.i4" <+> integer w <+> text "conv.u4"
-pushLit env (MachWord64 w) = text "ldc.i8" <+> integer w <+> text "conv.u8"
-pushLit env (MachFloat f)  = text "ldc.r4" <+> rational f
-pushLit env (MachDouble f) = text "ldc.r8" <+> rational f
-pushLit env (MachNullAddr)  = text "ldc.i4 0"
-pushLit env (MachLabel l _) = trace "WARNING: Cannot compile MachLabel to ILX in IlxGen.lhs" (text "// MachLabel!!!  Not valid in ILX!!")
-
-pprIlxTopVar env v
-  | isExternalName n = (nameReference env n) <> pprId (nameModule n) <> text "::" <> singleQuotes (ppr (nameModule n) <> text "_" <> ppr (nameOccName n))
-  | otherwise	   = pprId (nameOccName n)
-  where
-    n = idName v
-
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Printing types}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-
-isVoidIlxRepType (NoteTy   _ ty) = isVoidIlxRepType ty
-isVoidIlxRepType (TyConApp tc _) | (tyConPrimRep tc == VoidRep) = True
-isVoidIlxRepType (TyConApp tc tys) 
-  = isUnboxedTupleTyCon tc && null (filter (not. isVoidIlxRepType) tys)
-isVoidIlxRepType _ = False
-
-isVoidIlxRepId id = isVoidIlxRepType (idType id)
-
-
-
--- Get rid of all NoteTy and NewTy artifacts
-deepIlxRepType :: Type -> Type
-deepIlxRepType (FunTy l r)
-  = FunTy (deepIlxRepType l) (deepIlxRepType r)
-
-deepIlxRepType ty@(TyConApp tc tys) 
-  =        -- collapse UnboxedTupleTyCon down when it contains VoidRep types.
-	   -- e.g. 	(# State#, Int#, Int# #)  ===>   (# Int#, Int# #)
-            if isUnboxedTupleTyCon tc then 
-               let tys' = map deepIlxRepType (filter (not. isVoidIlxRepType) tys) in 
-               case tys' of
-                  [h] -> h
-                  _ -> mkTupleTy Unboxed (length tys') tys'
-            else 
-              TyConApp tc (map deepIlxRepType tys)
-deepIlxRepType (AppTy f x)     = AppTy (deepIlxRepType f) (deepIlxRepType x)
-deepIlxRepType (ForAllTy b ty) = ForAllTy b (deepIlxRepType ty)
-deepIlxRepType (NoteTy   _ ty) = deepIlxRepType ty
-deepIlxRepType (PredTy p)      = deepIlxRepType (predTypeRep p)
-deepIlxRepType ty@(TyVarTy tv) = ty
-
-idIlxRepType id = deepIlxRepType (idType id)
-
---------------------------
--- Some primitive type constructors are not thunkable.
--- Everything else needs to be marked thunkable.
-ilxTypeL :: IlxEnv -> Type -> SDoc
-
-ilxTypeL env ty | isUnLiftedType ty ||  isVoidIlxRepType ty = ilxTypeR env ty
-ilxTypeL env ty = text "thunk" <> angleBrackets (ilxTypeR env ty)
-
-
---------------------------
--- Print non-thunkable version of type.
---
-
-ilxTypeR :: IlxEnv -> Type -> SDoc
-ilxTypeR env ty | isVoidIlxRepType ty = text "/* unit skipped */"
-ilxTypeR env ty@(AppTy f _) | isTyVarTy f    = ilxComment (text "type app:" <+> pprType ty) <+> (text "class [mscorlib]System.Object")
-ilxTypeR env ty@(AppTy f x)     = trace "ilxTypeR: should I be beta reducing types?!" (ilxComment (text "ilxTypeR: should I be beta reducing types?!") <+> ilxTypeR env (applyTy f x))
-ilxTypeR env (TyVarTy tv)       = ilxTyVar env tv
-
--- The following is a special rule for types constructed out of 
--- higher kinds, e.g. Monad f or Functor f.  
---
--- The code below is not as general as it should be, but as I
--- have no idea if this approach will even work, I'm going to
--- just try it out on some simple cases arising from the prelude.
-ilxTypeR env ty@(TyConApp tc (h:t)) | isAlgTyCon tc && null (tyConTyVars tc)
-   = ilxComment (text "what on earth? 2") <+> (ilxTypeR env (TyConApp tc t))
-ilxTypeR env ty@(TyConApp tc (h:t)) | isAlgTyCon tc && not (isIlxTyVar (hd (tyConTyVars tc)))
-   = ilxTypeR env (TyConApp tc t)
-ilxTypeR env (TyConApp tc args) = ilxTyConApp env tc args
-
-  -- nb. the only legitimate place for VoidIlxRepTypes to occur in normalized IlxRepTypes 
-  -- is on the left of an arrow
-  --  We could probably eliminate all but a final occurrence of these.
-ilxTypeR env (FunTy arg res)| isVoidIlxRepType res 
-    = pprIlxFunTy (ilxTypeL env arg) (text "void")
-ilxTypeR env (FunTy arg res)
-    = pprIlxFunTy (ilxTypeL env arg) (ilxTypeR env res)
-
-ilxTypeR env ty@(ForAllTy tv body_ty) | isIlxTyVar tv
-  = parens (text "forall" <+> pprTyVarBinders env' [tv] <+> nest 2 (ilxTypeR env' body_ty))
-    where
-       env' = extendIlxEnvWithFormalTyVars env [tv]
-
-ilxTypeR env ty@(ForAllTy tv body_ty) | otherwise
-  = ilxComment (text "higher order type var " <+> pprId tv) <+>
-    pprIlxFunTy (text "class [mscorlib]System.Object") (ilxTypeR env body_ty)
-
-ilxTypeR env (NoteTy _ ty)       
-   = trace "WARNING! non-representation type given to ilxTypeR: see generated ILX for context where this occurs"
-     (vcat [text "/* WARNING! non-representation type given to ilxTypeR! */",
-           ilxTypeR env ty ])
-
-pprIlxFunTy dom ran = parens (hsep [text "func",parens dom,text "-->", ran])
-
-ilxTyConApp env tcon args =
-   case lookupUFM tyPrimConTable (getUnique tcon) of
-	Just f  -> f args env
-        Nothing -> 
-            (if isUnboxedTupleTyCon tcon then pprIlxUnboxedTupleTyConApp else pprIlxBoxedTyConApp)
-              env tcon args
-
-pprIlxTyCon env tcon = nameReference env (getName tcon) <> ppr tcon
-pprIlxUnboxedTupleTyConApp env tcon args 
-  = text "/* unboxed */ value class" <+> pprIlxTyCon env tcon' <> pprTypeArgs ilxTypeL env non_void
-  where 
-   non_void = filter (not . isVoidIlxRepType) args
-   tcon' = dataConTyCon (tupleCon Unboxed (length non_void)) 
-pprIlxBoxedTyConApp env tcon args 
-  = pprIlxNamedTyConApp env (pprIlxTyCon env tcon) args
-pprIlxNamedTyConApp env tcon_text args 
-  = text "class" <+> tcon_text <> pprTypeArgs ilxTypeR env args
-
--- Returns e.g: <Int32, Bool>
--- Void-sized type arguments are _always_ eliminated, everywhere.
--- If the type constructor is an unboxed tuple type then it should already have
--- been adjusted to be the correct constructor.
-pprTypeArgs f env tys = pprTypeArgs_aux f env (filter (not . isVoidIlxRepType) tys)
-
-pprTypeArgs_aux f env []  = empty
-pprTypeArgs_aux f env tys = angleBrackets (pprSepWithCommas (f env) tys)
-
-
-pprTyVarBinders :: IlxEnv -> [TyVar] -> SDoc
--- Returns e.g: <class [mscorlib]System.Object> <class [mscorlib]System.Object>
--- plus a new environment with the type variables added.
-pprTyVarBinders env [] = empty
-pprTyVarBinders env tvs = angleBrackets (pprSepWithCommas (pprTyVarBinder_aux env) tvs)
-
-pprTyVarBinder :: IlxEnv -> TyVar -> SDoc
-pprTyVarBinder env tv = 
-    if isIlxTyVar tv then 
-       angleBrackets (pprTyVarBinder_aux env tv)
-    else
-       ilxComment (text "higher order tyvar" <+> pprId tv <+> 
-                         text ":" <+> ilxTypeR env (tyVarKind tv)) <+>
-             ilxComment (text "omitted")
-             -- parens (text "class [mscorlib]System.Object" <+> pprId tv)
-
-
-pprTyVarBinder_aux env tv = 
-   ilxComment (text "tyvar" <+> pprId tv <+> text ":" <+> 
-                        ilxTypeR env (tyVarKind tv)) <+>
-             (text "class [mscorlib]System.Object")
-
--- Only a subset of Haskell types can be generalized using the type quantification
--- of ILX
-isIlxForAllKind h = 
-        ( h `eqKind` liftedTypeKind) ||
-        ( h `eqKind` unliftedTypeKind) ||
-        ( h `eqKind` openTypeKind)
-
-isIlxTyVar v = isTyVar v && isIlxForAllKind (tyVarKind v)
-
-categorizeVars fvs = (ilx_tvs, non_ilx_tvs, vs)
-         where
-           (tvs, vs) = partition isTyVar fvs
-           (ilx_tvs, non_ilx_tvs) = categorizeTyVars tvs
-
-categorizeTyVars tyvs = partition isIlxTyVar tyvs
-
-pprValArgTys ppr_ty env tys = parens (pprSepWithCommas (ppr_ty env) tys)
-
-pprId id = singleQuotes (ppr id)
-
-\end{code}			
-
-%************************************************************************
-%*									*
-\subsection{IlxEnv}	
-%*									*
-%************************************************************************
-
-\begin{code}
-type IlxTyEnv = [TyVar]
-emptyIlxTyEnv = []
-
--- Nb. There is currently no distinction between the kinds of type variables.
--- We may need to add this to print out correct numbers, esp. for
--- "forall" types
-extendIlxTyEnvWithFreeTyVars env tyvars = env ++ mkIlxTyEnv tyvars -- bound by .closure x<...> in a closure declared with type parameters
-extendIlxTyEnvWithFormalTyVars env tyvars = env ++ mkIlxTyEnv tyvars -- bound by "forall <...>" in a type
-extendIlxTyEnvWithTyArgs env tyvars = env ++ mkIlxTyEnv tyvars -- bound by "<...>" in a closure implementing a universal type
-
-formalIlxTyEnv tyvars = mkIlxTyEnv tyvars
-mkIlxTyEnv tyvars = [ v | v <- tyvars, isIlxTyVar v ]
-
-data HowBound = Top Module 	-- Bound in a modules
-	      | Arg	-- Arguments to the enclosing closure
-	      | CloVar Int -- A free variable of the enclosing closure
-                           -- The int is the index of the field in the 
-                           -- environment
-	      | Local	-- Local let binding
-
--- The SDoc prints a unique name for the syntactic block we're currently processing,
--- e.g. Foo_bar_baz when inside closure baz inside closure bar inside module Foo.
-data IlxEnv = IlxEnv (Module, IlxTyEnv, IdEnv HowBound,IdEnv (IlxEnv, StgRhs), Place,Bool)
-type Place = (SDoc,SDoc)
-
-ilxTyVar  env tv
-  = go 0 (ilxEnvTyEnv env)
-  where
-    go n [] 		    
-      = pprTrace "ilxTyVar" (pprId tv <+> text "tv_env = { "
-           <+> pprSepWithCommas
-	         (\x -> pprId x <+> text ":" <+> ilxTypeR env (tyVarKind x)) 
-               (ilxEnvTyEnv env) <+> text "}") 
-        (char '!' <> pprId tv) 
-    go n (x:xs)
-      = {- pprTrace "go" (ppr (tyVarName tv) <+> ppr (tyVarName x)) -}
-        (if tyVarName x== tyVarName tv then  char '!' <> int n <+> ilxComment (char '!' <> pprId tv) 
-         else go (n+1) xs)
-
-emptyIlxEnv :: Bool -> Module -> IlxEnv
-emptyIlxEnv trace mod = IlxEnv (mod, emptyIlxTyEnv, emptyVarEnv, emptyVarEnv, (ppr mod,empty),trace)
-
-nextPlace place sdoc = place <> sdoc
-usePlace  place sdoc = place <> sdoc
-
-ilxEnvModule (IlxEnv (m, _, _,  _, _,_)) = m
-ilxEnvSetPlace (IlxEnv (m, tv_env, id_env,  bind_env, (mod,exact),tr)) sdoc 
-   = IlxEnv (m, tv_env, id_env,  bind_env, (mod, sdoc),tr)
-ilxEnvNextPlace (IlxEnv (m, tv_env, id_env,  bind_env, (mod,exact),tr)) sdoc 
-   = IlxEnv (m, tv_env, id_env,  bind_env, (mod, nextPlace exact sdoc),tr)
-ilxEnvQualifyByModule (IlxEnv (_, _, _, _,(mod,_),_)) sdoc = usePlace mod sdoc
-ilxEnvQualifyByExact (IlxEnv (_, _, _, _,(mod,exact),_)) sdoc = usePlace mod sdoc <> usePlace exact sdoc
-
-ilxPlaceStgBindDefault env = ilxEnvNextPlace env (text "D")
-ilxPlaceStgRhsClosure env bndr = ilxEnvSetPlace env (ppr bndr) -- binders are already unique
-ilxPlaceStgCaseScrut env = ilxEnvNextPlace env (text "S")
-
-ilxPlaceAlt :: IlxEnv -> Int -> IlxEnv
-ilxPlaceAlt env i = ilxEnvNextPlace env (text "a" <> int i)
-ilxPlacePrimAltLit env i = ilxEnvNextPlace env (text "P" <> int i)
-ilxMapPlaceArgs start f env args = [ f (ilxEnvNextPlace env (text "A" <> int i)) a | (i,a) <- [start..] `zip` args ]
-ilxMapPlaceAlts f env alts = [ f (ilxPlaceAlt env i) alt | (i,alt) <- [1..] `zip` alts ]
-
-extendIlxEnvWithFreeTyVars (IlxEnv (mod, tv_env, id_env,  bind_env, place,tr)) tyvars 
-  = IlxEnv (mod, extendIlxTyEnvWithFreeTyVars tv_env tyvars,id_env,  bind_env, place,tr)
-
-extendIlxEnvWithFormalTyVars (IlxEnv (mod, tv_env, id_env,  bind_env, place,tr)) tyvars 
-  = IlxEnv (mod, extendIlxTyEnvWithFormalTyVars tv_env tyvars,id_env,  bind_env, place,tr)
-
-extendIlxEnvWithTyArgs (IlxEnv (mod, tv_env, id_env,  bind_env, place,tr)) tyvars 
-  = IlxEnv (mod, extendIlxTyEnvWithTyArgs tv_env tyvars,id_env,  bind_env, place,tr)
-
-extendIlxEnvWithArgs :: IlxEnv -> [Var] -> IlxEnv
-extendIlxEnvWithArgs (IlxEnv (mod, tv_env, id_env,  bind_env, place,tr)) args
-  = IlxEnv (mod, extendIlxTyEnvWithTyArgs tv_env [tv      | tv <- args, isIlxTyVar tv],
-            extendVarEnvList id_env [(v,Arg) | v  <- args, not (isIlxTyVar v)], 
-	     bind_env, place,tr)
-
-extendIlxEnvWithFreeVars (IlxEnv (mod, tv_env, id_env,  bind_env, place,tr)) args
-  = IlxEnv (mod, 
-            extendIlxTyEnvWithFreeTyVars tv_env [tv | tv <- args, isIlxTyVar tv],
-            extendVarEnvList id_env (clovs 0 args), 
-            bind_env, 
-            place,tr)
-   where
-     clovs _ [] = []
-     clovs n (x:xs) = if not (isIlxTyVar x) then (x,CloVar n):clovs (n+1) xs else clovs n xs
-
-extendIlxEnvWithBinds env@(IlxEnv (mod, tv_env, id_env, bind_env, place,tr)) bnds
-  = IlxEnv (mod, tv_env, id_env, 
-            extendVarEnvList bind_env [(v,(env,rhs)) | (v,rhs) <- bnds], 
-            place,tr)
-
-extendIlxEnvWithLocals (IlxEnv (m, tv_env, id_env, bind_env, p,tr)) locals
-  = IlxEnv (m, tv_env, 
-            extendVarEnvList id_env [(v,Local) | (LocalId v,_) <- locals],
-            extendVarEnvList bind_env [(v,(env,rhs)) | (LocalId v,Just (env,rhs)) <- locals], 
-            p,tr)
-extendIlxEnvWithTops env@(IlxEnv (m, tv_env, id_env, bind_env, place,tr)) mod binds
-  = IlxEnv (m, tv_env, 
-            extendVarEnvList id_env [(bndr,Top mod) | (bndr,rhs) <- binds], 
-            extendVarEnvList bind_env [(bndr,(env, rhs)) | (bndr,rhs) <- binds], 
-            place,tr)
-
-formalIlxEnv (IlxEnv (m, tv_env, id_env, bind_env, place, tr)) tyvars 
-  = IlxEnv (m, formalIlxTyEnv tyvars, id_env, bind_env, place, tr)
-
-ilxEnvTyEnv :: IlxEnv -> IlxTyEnv
-ilxEnvTyEnv (IlxEnv (_, tv_env, _,_,_,_)) = tv_env 
-elemIlxTyEnv var env = elem var (ilxEnvTyEnv env )
-elemIlxVarEnv var (IlxEnv (_, _, id_env,_,_,_)) = elemVarEnv var id_env 
-lookupIlxVarEnv (IlxEnv (_, _, id_env,_,_,_)) var = lookupVarEnv id_env var
-lookupIlxBindEnv (IlxEnv (_, _, _, bind_env,_,_)) var = lookupVarEnv bind_env var
-
-\end{code}
-
-
-\begin{code}
-type IlxLabel = SDoc
-
-pprIlxLabel lbl = lbl
-
-mkJoinLabel :: Id -> IlxLabel
-mkJoinLabel v = text "J_" <> ppr v
-
-mkAltLabel  :: Id -> Int -> IlxLabel
-mkAltLabel v n = text "A" <> int n <> ppr v
-
-ilxLabel :: IlxLabel -> SDoc
-ilxLabel lbl =  line $$ (pprIlxLabel lbl <> colon)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Local pretty helper functions}
-%*									*
-%************************************************************************
-
-\begin{code}
-pprSepWithCommas :: (a -> SDoc) -> [a] -> SDoc
-pprSepWithCommas pp xs = sep (punctuate comma (map pp xs))
-ilxComment pp   = text "/*" <+> pp <+> text "*/"
-singleQuotes pp = char '\'' <> pp <> char '\''
-
-line = text "// ----------------------------------"
-
-hscOptionQual = text ".i_"
-
-nameReference env n
-  | isInternalName n = empty
-  | ilxEnvModule env == nameModule n  = text ""
-  | isHomeModule (nameModule n)   = moduleNameReference (moduleName (nameModule n))
--- HACK: no Vanilla modules should be around, but they are!!  This
--- gets things working for the scenario "standard library linked as one
--- assembly with multiple modules + a one module program running on top of this"
--- Same applies to all other mentions of Vailla modules in this file
-  | isVanillaModule (nameModule n)  && not inPrelude =  basePackageReference
-  | isVanillaModule (nameModule n)  && inPrelude =   moduleNameReference (moduleName (nameModule n))
--- end hack
-  | otherwise = packageReference (modulePackage (nameModule n))
-
-packageReference p = brackets (singleQuotes (ppr p  <> hscOptionQual))
-moduleNameReference m = brackets ((text ".module") <+> (singleQuotes (pprModuleName m <> hscOptionQual <> text "o")))
-
-moduleReference env m
-  | ilxEnvModule env   == m = text ""
-  | isHomeModule m = moduleNameReference (moduleName m)
-  -- See hack above
-  | isVanillaModule m && not inPrelude =  basePackageReference
-  | isVanillaModule m && inPrelude =  moduleNameReference (moduleName m)
-  -- end hack
-  | otherwise  =  packageReference (modulePackage m)
-
-basePackageReference = packageReference basePackage
-inPrelude = basePackage == opt_InPackage
-
-------------------------------------------------
--- This code is copied from absCSyn/CString.lhs,
--- and modified to do the correct thing!  It's
--- still a mess though.  Also, still have to do the
--- right thing for embedded nulls.
-
-pprFSInILStyle :: FastString -> SDoc
-pprFSInILStyle fs = doubleQuotes (text (stringToC (unpackFS fs)))
-
-stringToC   :: String -> String
--- Convert a string to the form required by C in a C literal string
--- Tthe hassle is what to do w/ strings like "ESC 0"...
-stringToC ""  = ""
-stringToC [c] = charToC c
-stringToC (c:cs)
-    -- if we have something "octifiable" in "c", we'd better "octify"
-    -- the rest of the string, too.
-  = if (c < ' ' || c > '~')
-    then (charToC c) ++ (concat (map char_to_C cs))
-    else (charToC c) ++ (stringToC cs)
-  where
-    char_to_C c | c == '\n' = "\\n"	-- use C escapes when we can
-		| c == '\a' = "\\a"
-		| c == '\b' = "\\b"	-- ToDo: chk some of these...
-		| c == '\r' = "\\r"
-		| c == '\t' = "\\t"
-		| c == '\f' = "\\f"
-		| c == '\v' = "\\v"
-		| otherwise = '\\' : (trigraph (ord c))
-
-charToC :: Char -> String
--- Convert a character to the form reqd in a C character literal
-charToC c = if (c >= ' ' && c <= '~')	-- non-portable...
-	    then case c of
-		  '\'' -> "\\'"
-		  '\\' -> "\\\\"
-		  '"'  -> "\\\""
-		  '\n' -> "\\n"
-		  '\a' -> "\\a"
-		  '\b' -> "\\b"
-		  '\r' -> "\\r"
-		  '\t' -> "\\t"
-		  '\f' -> "\\f"
-		  '\v' -> "\\v"
-		  _    -> [c]
-	    else '\\' : (trigraph (ord c))
-
-trigraph :: Int -> String
-trigraph n
-  = [chr ((n `div` 100) `rem` 10 + ord '0'),
-     chr ((n `div` 10) `rem` 10 + ord '0'),
-     chr (n `rem` 10 + ord '0')]
-
-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{PrimOps and Constructors}
-%*									*
-%************************************************************************
-
-\begin{code}
-----------------------------
--- Allocate a fresh constructor
-
-ilxConApp env data_con args
-  | isUnboxedTupleCon data_con
-     = let tm_args' = filter (not. isVoidIlxRepType . stgArgType) tm_args in 
-       case tm_args' of
-        [h] -> 
-          -- Collapse the construction of an unboxed tuple type where
-          -- every element is zero-sized
-            vcat (ilxMapPlaceArgs 0 pushArg env tm_args')
-        _ -> 
-          -- Minimize the construction of an unboxed tuple type, which
-          -- may contain zero-sized elements.  Recompute all the 
-          -- bits and pieces from the simpler case below for the new data
-          -- type constructor....
-           let data_con' = tupleCon Unboxed (length tm_args') in 
-           let rep_ty_args' = filter (not . isVoidIlxRepType) rep_ty_args in 
-
-           let tycon' = dataConTyCon data_con' in
-           let (formal_tyvars', formal_tau_ty') = splitForAllTys (dataConRepType data_con') in 
-           let (formal_arg_tys', _)     = splitFunTys formal_tau_ty' in
-           let formal_env' 	     = formalIlxEnv env formal_tyvars' in 
-
-           vcat [vcat (ilxMapPlaceArgs 0 pushArg env tm_args'),
-	           sep [text "newobj void ",
-  		        ilxTyConApp env tycon' rep_ty_args',
-                        text "::.ctor",
-                        pprValArgTys ilxTypeR formal_env' (map deepIlxRepType formal_arg_tys')
-	           ]
-             ]
- | otherwise
-    -- Now all other constructions
-     =	--  Assume C :: forall a. a -> T a -> T a
-   	--	ldloc x		arg of type Int
-	--	ldloc y		arg of type T Int
-	-- 	newdata classunion T<Int32>, C(!0, T <!0>)
-	--
-        let tycon   = dataConTyCon data_con in 
-        let (formal_tyvars, formal_tau_ty) = splitForAllTys (dataConRepType data_con) in
-        let (formal_arg_tys, _)     = splitFunTys formal_tau_ty in 
-
-       vcat [vcat (ilxMapPlaceArgs 0 pushArg env tm_args),
-	  sep [	text "newdata",
-		nest 2 (ilxTyConApp env tycon rep_ty_args <> comma),
-		nest 2 (ilxConRef env data_con)
-	  ]
-        ]
- where
-   tycon   = dataConTyCon data_con 
-   rep_ty_args = map deepIlxRepType ty_args
-   (ty_args,tm_args) = if isAlgTyCon tycon then splitTyArgs (tyConTyVars tycon) args  else splitTyArgs1 args
-
--- Split some type arguments off, throwing away the higher kinded ones for the moment.
--- Base the higher-kinded checks off a corresponding list of formals.
-splitTyArgs :: [Var] 		-- Formals
-	    -> [StgArg]		-- Actuals
-	    -> ([Type], [StgArg])
-splitTyArgs (htv:ttv) (StgTypeArg h:t) 
-   | isIlxTyVar htv = ((h:l), r) 
-   | otherwise = trace "splitTyArgs: threw away higher kinded type arg" (l, r) 
-   where (l,r) = splitTyArgs ttv t 
-splitTyArgs _ l = ([],l)
- 
--- Split some type arguments off, where none should be higher kinded
-splitTyArgs1 :: [StgArg] -> ([Type], [StgArg])
-splitTyArgs1 (StgTypeArg ty : args) = (ty:tys, args')
-				    where
-				      (tys, args') = splitTyArgs1 args
-splitTyArgs1 args		    = ([], args)
-
-ilxConRef env data_con
- | isUnboxedTupleCon data_con
-    = let data_con' = tupleCon Unboxed (length non_void_args)in 
-      pprId data_con' <> arg_text
- | otherwise 
-    = pprId data_con <> arg_text
-  where
-    arg_text = pprValArgTys ilxTypeL env' (map deepIlxRepType non_void_args)
-    non_void_args = filter (not . isVoidIlxRepType) arg_tys
-    (tyvars, tau_ty) = splitForAllTys (dataConRepType data_con)
-    (arg_tys, _)     = splitFunTys tau_ty
-    env' 	     = formalIlxEnv env tyvars
-
-
-
-
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{PrimOps and Prim Representations}				*
-%************************************************************************
-
-\begin{code}
-
-ilxPrimApp env op 	       args ret_ty = ilxPrimOpTable op args env
-
-
-type IlxTyFrag = IlxEnv -> SDoc
-ilxType s env = text s
-
-ilxLift ty env = text "thunk" <> angleBrackets (ty env)
-
-ilxTypeSeq :: [IlxTyFrag] -> IlxTyFrag
-ilxTypeSeq ops env = hsep (map (\x -> x env) ops)
-
-tyPrimConTable :: UniqFM ([Type] -> IlxTyFrag)
-tyPrimConTable = 
-  listToUFM [(addrPrimTyConKey, 	(\_ -> repAddr)),
---	     (fileStreamPrimTyConKey, 	(\_ -> repFileStream)),
-	     (foreignObjPrimTyConKey, 	(\_ -> repForeign)),
-             (stablePtrPrimTyConKey, 	(\[ty] -> repStablePtr {- (ilxTypeL2 ty) -})),
-             (stableNamePrimTyConKey, 	(\[ty] -> repStableName {- (ilxTypeL2 ty) -} )),
-             (charPrimTyConKey, 	(\_ -> repChar)),
-	     (wordPrimTyConKey, 	(\_ -> repWord)),
-	     (byteArrayPrimTyConKey,	(\_ -> repByteArray)),
-	     (intPrimTyConKey, 	        (\_ -> repInt)),
-	     (int64PrimTyConKey,	(\_ -> repInt64)),
-	     (word64PrimTyConKey,	(\_ -> repWord64)),
-	     (floatPrimTyConKey, 	(\_ -> repFloat)),
-	     (doublePrimTyConKey,	(\_ -> repDouble)),
-              -- These can all also accept unlifted parameter types so we explicitly lift.
-	     (arrayPrimTyConKey, 	(\[ty] -> repArray (ilxTypeL2 ty))),
-	     (mutableArrayPrimTyConKey, 	(\[_, ty] -> repMutArray (ilxTypeL2 ty))),
-	     (weakPrimTyConKey, 	(\[ty] -> repWeak (ilxTypeL2 ty))),
-	     (mVarPrimTyConKey, 	(\[_, ty] -> repMVar (ilxTypeL2 ty))),
-	     (mutVarPrimTyConKey, 	(\[ty1, ty2] -> repMutVar (ilxTypeL2 ty1) (ilxTypeL2 ty2))),
-	     (mutableByteArrayPrimTyConKey,	(\_ -> repByteArray)),
-	     (threadIdPrimTyConKey,	(\_ -> repThread)),
-	     (bcoPrimTyConKey,	(\_ -> repBCO))
-	     ]
-
-ilxTypeL2 :: Type -> IlxTyFrag
-ilxTypeL2 ty env = ilxTypeL env ty
-ilxTypeR2 :: Type -> IlxTyFrag
-ilxTypeR2 ty env = ilxTypeR env ty
-
-ilxMethTyVarA = ilxType "!!0"
-ilxMethTyVarB = ilxType "!!1"
-prelGHCReference :: IlxTyFrag
-prelGHCReference env =
-   if ilxEnvModule env == mkHomeModule (mkModuleName "PrelGHC") then empty
-   else if inPrelude then moduleNameReference (mkModuleName "PrelGHC")
-   else basePackageReference
-
-prelBaseReference :: IlxTyFrag
-prelBaseReference env =
-   if ilxEnvModule env == mkHomeModule (mkModuleName "PrelBase") then empty
-   else if inPrelude then moduleNameReference (mkModuleName "PrelBase")
-   else basePackageReference
-
-repThread = ilxType "class [mscorlib]System.Threading.Thread /* ThreadId# */ "
-repByteArray = ilxType "unsigned int8[] /* ByteArr# */ "
---repFileStream = text "void * /* FileStream# */ "  -- text "class [mscorlib]System.IO.FileStream"
-repInt = ilxType "int32"
-repWord = ilxType "unsigned int32"
-repAddr =ilxType "/* Addr */ void *"
-repInt64 = ilxType "int64"
-repWord64 = ilxType "unsigned int64"
-repFloat = ilxType "float32"
-repDouble = ilxType "float64"
-repChar = ilxType "/* Char */ unsigned int8"
-repForeign = ilxTypeSeq [ilxType "class ",prelGHCReference,ilxType "PrelGHC_Foreignzh"]
-repInteger = ilxUnboxedPairRep repInt repByteArray
-repIntegerPair = ilxUnboxedQuadRep repInt repByteArray repInt repByteArray
-repArray ty = ilxTypeSeq [ty,ilxType "[]"]
-repMutArray ty = ilxTypeSeq [ty,ilxType "[]"]
-repMVar ty = ilxTypeSeq [ilxType "class ",prelGHCReference,ilxType "PrelGHC_MVarzh",ilxTyParams [ty]]
-repMutVar _ ty2 = ilxTypeSeq [ilxType "class ",prelGHCReference,ilxType "PrelGHC_MutVarzh",ilxTyParams [ty2]]
-repWeak ty1 = ilxTypeSeq [ilxType "class ",prelGHCReference,ilxType "PrelGHC_Weakzh",ilxTyParams [ty1]]
-repStablePtr {- ty1 -} = ilxTypeSeq [ilxType "class ",prelGHCReference,ilxType "PrelGHC_StablePtrzh" {- ,ilxTyParams [ty1] -} ]
-repStableName {- ty1 -}  = ilxTypeSeq [ilxType "class ",prelGHCReference,ilxType "PrelGHC_StableNamezh" {- ,ilxTyParams [ty1] -} ]
-classWeak = ilxTypeSeq [ilxType "class ",prelGHCReference,ilxType "PrelGHC_Weakzh"]
-repBCO = ilxTypeSeq [ilxType "class ",prelGHCReference,ilxType "PrelGHC_BCOzh"]
-
-ilxTyPair l r = ilxTyParams [l,r]
-ilxTyTriple l m r = ilxTyParams [l,m,r]
-ilxTyQuad l m1 m2 r = ilxTyParams [l,m1,m2,r]
-ilxUnboxedEmptyRep = ilxTypeSeq [ilxType "value class",prelGHCReference,ilxType "PrelGHC_Z1H"]
-ilxUnboxedPairRep l r = ilxTypeSeq [ilxType "value class",prelGHCReference,ilxType "PrelGHC_Z2H",ilxTyPair l r]
-ilxUnboxedTripleRep l m r = ilxTypeSeq [ilxType "value class",prelGHCReference,ilxType "PrelGHC_Z3H",ilxTyTriple l m r]
-ilxUnboxedQuadRep l m1 m2 r = ilxTypeSeq [ilxType "value class",prelGHCReference,ilxType "PrelGHC_Z4H",ilxTyQuad l m1 m2 r]
-
-ilxTyIO b = ilxTypeSeq [ilxType "(func ( /* unit skipped */ ) --> ", b, ilxType ")"]
-
-ilxTyParams :: [IlxTyFrag] -> IlxTyFrag
-ilxTyParams [] env = empty
-ilxTyParams l env = angleBrackets (ilxTyParamsAux l env)
-  where
-   ilxTyParamsAux [] env = empty
-   ilxTyParamsAux [h] env = h env
-   ilxTyParamsAux (h:t) env = h env <> text "," <+> ilxTyParamsAux t env
-   ilxTyParams [] env = empty
-
-
-type IlxOpFrag = IlxEnv -> SDoc
-ilxOp :: String -> IlxOpFrag
-ilxOp s env = text s
-ilxOpSeq :: [IlxOpFrag] -> IlxOpFrag
-ilxOpSeq ops env = hsep (map (\x -> x env) ops)
-
-ilxParams :: [IlxOpFrag] -> IlxOpFrag
-ilxParams l env = parens (ilxParamsAux l env)
-  where
-   ilxParamsAux [] env = empty
-   ilxParamsAux [h] env = h env
-   ilxParamsAux (h:t) env = h env <> text "," <+> ilxParamsAux t env
-
-
-ilxMethodRef rty cls nm tyargs args = 
-    ilxOpSeq [rty,cls,ilxOp "::",ilxOp nm,
-              ilxTyParams tyargs,ilxParams args]
-
-ilxCall m = ilxOpSeq [ilxOp "call", m]
-
-ilxSupportClass = ilxOpSeq [prelGHCReference, ilxOp "'GHC.support'"]
-ilxSuppMeth rty nm tyargs args = ilxMethodRef rty ilxSupportClass nm tyargs args
-
-ilxCallSuppMeth rty nm tyargs args  = ilxCall (ilxSuppMeth rty nm tyargs args)
-
-ilxMkBool :: IlxOpFrag
-ilxMkBool =  ilxOpSeq [ilxOp "call class",prelBaseReference,
-                       ilxOp "PrelBase_Bool",
-                       prelGHCReference,ilxOp "GHC.support::mkBool(bool)"]
-ilxCgt = ilxOpSeq [ilxOp "cgt",ilxMkBool]
-ilxCge = ilxOpSeq [ilxOp "clt ldc.i4 0 ceq ",ilxMkBool]
-ilxClt = ilxOpSeq [ilxOp "clt ",ilxMkBool]
-ilxCle = ilxOpSeq [ilxOp "cgt ldc.i4 0 ceq ",ilxMkBool]
-ilxCeq = ilxOpSeq [ilxOp "ceq ",ilxMkBool]
-ilxCne = ilxOpSeq [ilxOp "ceq ldc.i4 0 ceq " ,ilxMkBool]
-ilxCgtUn = ilxOpSeq [ilxOp "cgt.un ",ilxMkBool]
-ilxCgeUn  = ilxOpSeq [ilxOp "clt.un ldc.i4 0 ceq ",ilxMkBool]
-ilxCltUn = ilxOpSeq [ilxOp "clt.un ",ilxMkBool]
-ilxCleUn = ilxOpSeq [ilxOp "cgt.un ldc.i4 0 ceq ",ilxMkBool]
-
-ilxAddrOfForeignOp = ilxOpSeq [ilxOp "ldfld void *" , repForeign, ilxOp "::contents"]
-ilxAddrOfByteArrOp = ilxOp "ldc.i4 0 ldelema unsigned int8"
-
-ilxPrimOpTable :: PrimOp -> [StgArg] -> IlxOpFrag
-ilxPrimOpTable op
-  = case op of
- 	CharGtOp    -> simp_op ilxCgt
-	CharGeOp    -> simp_op ilxCge
-	CharEqOp    -> simp_op ilxCeq
-	CharNeOp    -> simp_op ilxCne
-	CharLtOp    -> simp_op ilxClt
-	CharLeOp    -> simp_op ilxCle
-
-	OrdOp       -> simp_op (ilxOp "conv.i4") -- chars represented by UInt32 (u4)
-	ChrOp       -> simp_op (ilxOp "conv.u4")
-
-	IntGtOp     -> simp_op ilxCgt
-	IntGeOp     -> simp_op ilxCge
-	IntEqOp     -> simp_op ilxCeq
-	IntNeOp     -> simp_op ilxCne
-	IntLtOp     -> simp_op ilxClt
-	IntLeOp     -> simp_op ilxCle
-
-        Narrow8IntOp   -> simp_op  (ilxOp"conv.i1")
-        Narrow16IntOp  -> simp_op (ilxOp "conv.i2")
-        Narrow32IntOp  -> simp_op (ilxOp "conv.i4")
-        Narrow8WordOp  -> simp_op (ilxOp "conv.u1")
-        Narrow16WordOp -> simp_op (ilxOp "conv.u2")
-        Narrow32WordOp -> simp_op (ilxOp "conv.u4")
-
-	WordGtOp     -> simp_op ilxCgtUn
-	WordGeOp     -> simp_op ilxCgeUn
-	WordEqOp     -> simp_op ilxCeq
-	WordNeOp     -> simp_op ilxCne
-	WordLtOp     -> simp_op ilxCltUn
-	WordLeOp     -> simp_op ilxCleUn
-
-	AddrGtOp     -> simp_op ilxCgt
-	AddrGeOp     -> simp_op ilxCge
-	AddrEqOp     -> simp_op ilxCeq
-	AddrNeOp     -> simp_op ilxCne
-	AddrLtOp     -> simp_op ilxClt
-	AddrLeOp     -> simp_op ilxCle
-
-	FloatGtOp     -> simp_op ilxCgt
-	FloatGeOp     -> simp_op ilxCge
-	FloatEqOp     -> simp_op ilxCeq
-	FloatNeOp     -> simp_op ilxCne
-	FloatLtOp     -> simp_op ilxClt
-	FloatLeOp     -> simp_op ilxCle
-
-	DoubleGtOp     -> simp_op ilxCgt
-	DoubleGeOp     -> simp_op ilxCge
-	DoubleEqOp     -> simp_op ilxCeq
-	DoubleNeOp     -> simp_op ilxCne
-	DoubleLtOp     -> simp_op ilxClt
-	DoubleLeOp     -> simp_op ilxCle
-
-    -- Int#-related ops:
-	IntAddOp    -> simp_op (ilxOp "add")
-	IntSubOp    -> simp_op (ilxOp "sub")
-	IntMulOp    -> simp_op (ilxOp "mul")
-	IntQuotOp   -> simp_op (ilxOp "div")
-	IntNegOp    -> simp_op (ilxOp "neg")
-	IntRemOp    -> simp_op (ilxOp "rem")
-
-    -- Addr# ops:
-        AddrAddOp  -> simp_op (ilxOp "add")
-	AddrSubOp  -> simp_op (ilxOp "sub")
-	AddrRemOp  -> simp_op (ilxOp "rem")
-	Int2AddrOp -> warn_op "int2Addr" (simp_op (ilxOp "/* PrimOp int2Addr */ "))
-	Addr2IntOp -> warn_op "addr2Int" (simp_op (ilxOp "/* PrimOp addr2Int */ "))
-
-    -- Word#-related ops:
-	WordAddOp    -> simp_op (ilxOp "add")
-	WordSubOp    -> simp_op (ilxOp "sub")
-	WordMulOp    -> simp_op (ilxOp "mul")
-	WordQuotOp   -> simp_op (ilxOp "div")
-	WordRemOp    -> simp_op (ilxOp "rem")
-
-	ISllOp      -> simp_op (ilxOp "shl")
-	ISraOp      -> simp_op (ilxOp "shr")
-	ISrlOp      -> simp_op (ilxOp "shr.un")
-	IntAddCOp   -> simp_op (ilxCallSuppMeth (ilxUnboxedPairRep repInt repInt) "IntAddCOp" [] [repInt, repInt])
-	IntSubCOp   -> simp_op (ilxCallSuppMeth (ilxUnboxedPairRep repInt repInt) "IntSubCOp" [] [repInt, repInt])
-	IntGcdOp    -> simp_op (ilxCallSuppMeth repInt "IntGcdOp" [] [repInt, repInt])
-
-
-    -- Word#-related ops:
-	AndOp  	    -> simp_op (ilxOp "and") 
-	OrOp   	    -> simp_op (ilxOp "or") 
-	NotOp  	    -> simp_op (ilxOp "not") 
-	XorOp  	    -> simp_op (ilxOp "xor") 
-	SllOp  	    -> simp_op (ilxOp "shl") 
-	SrlOp 	    -> simp_op (ilxOp "shr") 
-	Word2IntOp  -> simp_op (ilxOp "conv.i4")
-	Int2WordOp  -> simp_op (ilxOp "conv.u4")
-
-    -- Float#-related ops:
-	FloatAddOp   -> simp_op (ilxOp "add")
-	FloatSubOp   -> simp_op (ilxOp "sub")
-	FloatMulOp   -> simp_op (ilxOp "mul")
-	FloatDivOp   -> simp_op (ilxOp "div")
-	FloatNegOp   -> simp_op (ilxOp "neg")
-	Float2IntOp  -> simp_op (ilxOp "conv.i4")
-	Int2FloatOp  -> simp_op (ilxOp "conv.r4")
-
-	DoubleAddOp   	-> simp_op (ilxOp "add")
-	DoubleSubOp   	-> simp_op (ilxOp "sub")
-	DoubleMulOp   	-> simp_op (ilxOp "mul")
-	DoubleDivOp   	-> simp_op (ilxOp "div")
-	DoubleNegOp   	-> simp_op (ilxOp "neg")
-	Double2IntOp  	-> simp_op (ilxOp "conv.i4")
-	Int2DoubleOp  	-> simp_op (ilxOp "conv.r4")
-	Double2FloatOp  -> simp_op (ilxOp "conv.r4")
-	Float2DoubleOp  -> simp_op (ilxOp "conv.r8")
-	DoubleDecodeOp  -> simp_op (ilxCallSuppMeth (ilxUnboxedTripleRep repInt repInt repByteArray) "decodeDouble" [] [ilxType "float64"])
-	FloatDecodeOp   -> simp_op (ilxCallSuppMeth (ilxUnboxedTripleRep repInt repInt repByteArray) "decodeFloat" [] [ilxType "float32"])
-
-	FloatExpOp   -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Exp(float64) conv.r4")
-	FloatLogOp   -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Log(float64) conv.r4")
-	FloatSqrtOp  -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Sqrt(float64) conv.r4")
-	FloatSinOp   -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Sin(float64) conv.r4")
-	FloatCosOp   -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Cos(float64) conv.r4")
-	FloatTanOp   -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Tan(float64) conv.r4")
-	FloatAsinOp  -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Asin(float64) conv.r4")
-	FloatAcosOp  -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Acos(float64) conv.r4")
-	FloatAtanOp  -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Atan(float64) conv.r4")
-	FloatSinhOp  -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Sinh(float64) conv.r4")
-	FloatCoshOp  -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Cosh(float64) conv.r4")
-	FloatTanhOp  -> simp_op (ilxOp "conv.r8 call float64 [mscorlib]System.Math::Tanh(float64) conv.r4")
-	FloatPowerOp -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Pow(float64, float64) conv.r4") --  ** op, make use of implicit cast to r8...
-
-	DoubleExpOp   -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Exp(float64)")
-	DoubleLogOp   -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Log(float64)")
-	DoubleSqrtOp  -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Sqrt(float64)")
-          
-	DoubleSinOp   -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Sin(float64)")
-	DoubleCosOp   -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Cos(float64)")
-	DoubleTanOp   -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Tan(float64)")
-          
-	DoubleAsinOp   -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Asin(float64)")
-	DoubleAcosOp   -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Acos(float64)")
-	DoubleAtanOp   -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Atan(float64)")
-          
-	DoubleSinhOp   -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Sinh(float64)")
-	DoubleCoshOp   -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Cosh(float64)")
-	DoubleTanhOp   -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Tanh(float64)")
-          
-	DoublePowerOp  -> simp_op (ilxOp "call float64 [mscorlib]System.Math::Pow(float64, float64)")
-
-    -- Integer (and related...) ops: bail out to support routines
-	IntegerAndOp  	   -> simp_op (ilxCallSuppMeth repInteger "IntegerAndOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerOrOp  	   -> simp_op (ilxCallSuppMeth repInteger "IntegerOrOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerXorOp  	   -> simp_op (ilxCallSuppMeth repInteger "IntegerXorOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerComplementOp -> simp_op (ilxCallSuppMeth repInteger "IntegerComplementOp" [] [repInt, repByteArray])
-	IntegerAddOp  	   -> simp_op (ilxCallSuppMeth repInteger "IntegerAddOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerSubOp  	   -> simp_op (ilxCallSuppMeth repInteger "IntegerSubOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerMulOp  	   -> simp_op (ilxCallSuppMeth repInteger "IntegerMulOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerGcdOp  	   -> simp_op (ilxCallSuppMeth repInteger "IntegerGcdOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerQuotRemOp   -> simp_op (ilxCallSuppMeth repIntegerPair "IntegerQuotRemOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerDivModOp    -> simp_op (ilxCallSuppMeth repIntegerPair "IntegerDivModOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerIntGcdOp    -> simp_op (ilxCallSuppMeth repInt "IntegerIntGcdOp" [] [repInt, repByteArray, repInt])
-	IntegerDivExactOp  -> simp_op (ilxCallSuppMeth repInteger "IntegerDivExactOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerQuotOp  	   -> simp_op (ilxCallSuppMeth repInteger "IntegerQuotOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerRemOp   	   -> simp_op (ilxCallSuppMeth repInteger "IntegerRemOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerCmpOp   	   -> simp_op (ilxCallSuppMeth repInt "IntegerCmpOp" [] [repInt, repByteArray, repInt, repByteArray])
-	IntegerCmpIntOp    -> simp_op (ilxCallSuppMeth repInt "IntegerCmpIntOp" [] [repInt, repByteArray, repInt])
-	Integer2IntOp      -> simp_op (ilxCallSuppMeth repInt "Integer2IntOp" [] [repInt, repByteArray])
-	Integer2WordOp     -> simp_op (ilxCallSuppMeth repWord "Integer2WordOp" [] [repInt, repByteArray])
-	Int2IntegerOp  	   -> simp_op (ilxCallSuppMeth repInteger "Int2IntegerOp" [] [repInt])
-	Word2IntegerOp     -> simp_op (ilxCallSuppMeth repInteger "Word2IntegerOp" [] [repWord])
---	IntegerToInt64Op   -> simp_op (ilxCallSuppMeth repInt64 "IntegerToInt64Op" [] [repInt,repByteArray])
-	Int64ToIntegerOp   -> simp_op (ilxCallSuppMeth repInteger "Int64ToIntegerOp" [] [repInt64])
---	IntegerToWord64Op  -> simp_op (ilxCallSuppMeth repWord64 "IntegerToWord64Op" [] [repInt,repByteArray])
-	Word64ToIntegerOp  -> simp_op (ilxCallSuppMeth repInteger "Word64ToIntegerOp" [] [repWord64])
-
-
-
-	IndexByteArrayOp_Char  	   -> simp_op (ilxOp "ldelem.u1")
-	IndexByteArrayOp_WideChar  -> simp_op (ilxOp "ldelem.u4")
-	IndexByteArrayOp_Int   	   -> simp_op (ilxOp "ldelem.i4")
-	IndexByteArrayOp_Word  	   -> simp_op (ilxOp "ldelem.u4")
-	IndexByteArrayOp_Addr  	   -> simp_op (ilxOp "ldelem.u")
-	IndexByteArrayOp_Float 	   -> simp_op (ilxOp "ldelem.r4")
-	IndexByteArrayOp_Double    -> simp_op (ilxOp "ldelem.r8")
-	IndexByteArrayOp_StablePtr -> simp_op (ilxOp "ldelem.ref")
-	IndexByteArrayOp_Int8     -> simp_op (ilxOp "ldelem.i1")
-	IndexByteArrayOp_Int16     -> simp_op (ilxOp "ldelem.i2")
-	IndexByteArrayOp_Int32     -> simp_op (ilxOp "ldelem.i4")
-	IndexByteArrayOp_Int64     -> simp_op (ilxOp "ldelem.i8")
-	IndexByteArrayOp_Word8    -> simp_op (ilxOp "ldelem.u1")
-	IndexByteArrayOp_Word16    -> simp_op (ilxOp "ldelem.u2")
-	IndexByteArrayOp_Word32    -> simp_op (ilxOp "ldelem.u4")
-	IndexByteArrayOp_Word64    -> simp_op (ilxOp "ldelem.u8")
-
-            {- should be monadic??? -}
-	ReadByteArrayOp_Char   	  -> simp_op (ilxOp "ldelem.u1")
-	ReadByteArrayOp_WideChar  -> simp_op (ilxOp "ldelem.u4")
-	ReadByteArrayOp_Int    	  -> simp_op (ilxOp "ldelem.i4")
-	ReadByteArrayOp_Word   	  -> simp_op (ilxOp "ldelem.u4")
-	ReadByteArrayOp_Addr   	  -> simp_op (ilxOp "ldelem.u")
-	ReadByteArrayOp_Float  	  -> simp_op (ilxOp "ldelem.r4")
-	ReadByteArrayOp_Double 	  -> simp_op (ilxOp "ldelem.r8")
-	ReadByteArrayOp_StablePtr -> simp_op (ilxOp "ldelem.ref")
-	ReadByteArrayOp_Int8     -> simp_op (ilxOp "ldelem.i1")
-	ReadByteArrayOp_Int16     -> simp_op (ilxOp "ldelem.i2")
-	ReadByteArrayOp_Int32     -> simp_op (ilxOp "ldelem.i4")
-	ReadByteArrayOp_Int64     -> simp_op (ilxOp "ldelem.i8")
-	ReadByteArrayOp_Word8    -> simp_op (ilxOp "ldelem.u1")
-	ReadByteArrayOp_Word16    -> simp_op (ilxOp "ldelem.u2")
-	ReadByteArrayOp_Word32    -> simp_op (ilxOp "ldelem.u4")
-	ReadByteArrayOp_Word64    -> simp_op (ilxOp "ldelem.u8")
-                 {-   MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #) -}
-                 {- ByteArr# -> Int# -> Char# -}
-
-
-	WriteByteArrayOp_Char  	   -> simp_op (ilxOp "stelem.u1")
-	WriteByteArrayOp_WideChar   -> simp_op (ilxOp "stelem.u4")
-	WriteByteArrayOp_Int   	   -> simp_op (ilxOp "stelem.i4")
-	WriteByteArrayOp_Word  	   -> simp_op (ilxOp "stelem.u4")
-	WriteByteArrayOp_Addr  	   -> simp_op (ilxOp "stelem.u")
-	WriteByteArrayOp_Float 	   -> simp_op (ilxOp "stelem.r4")
-	WriteByteArrayOp_Double    -> simp_op (ilxOp "stelem.r8")
-	WriteByteArrayOp_StablePtr -> simp_op (ilxOp "stelem.ref")
-	WriteByteArrayOp_Int8     -> simp_op (ilxOp "stelem.i1")
-	WriteByteArrayOp_Int16     -> simp_op (ilxOp "stelem.i2")
-	WriteByteArrayOp_Int32     -> simp_op (ilxOp "stelem.i4")
-	WriteByteArrayOp_Int64     -> simp_op (ilxOp "stelem.i8")
-	WriteByteArrayOp_Word8    -> simp_op (ilxOp "stelem.u1")
-	WriteByteArrayOp_Word16    -> simp_op (ilxOp "stelem.u2")
-	WriteByteArrayOp_Word32    -> simp_op (ilxOp "stelem.u4")
-	WriteByteArrayOp_Word64    -> simp_op (ilxOp "stelem.i8 /* nb. no stelem.u8 */")
-                 {- MutByteArr# s -> Int# -> Char# -> State# s -> State# s -}
-
-	IndexOffAddrOp_Char    -> simp_op (ilxOp "sizeof unsigned int8 mul add ldind.u1")
-	IndexOffAddrOp_WideChar    -> simp_op (ilxOp "sizeof int32 mul add ldind.u4")
-	IndexOffAddrOp_Int     -> simp_op (ilxOp "sizeof int32 mul add ldind.i4")
-	IndexOffAddrOp_Word    -> simp_op (ilxOp "sizeof int32 mul add ldind.u4")
-	IndexOffAddrOp_Addr    -> simp_op (ilxOp "sizeof native unsigned int mul add ldind.i")
-	IndexOffAddrOp_StablePtr   -> simp_op (ilxOp "sizeof native unsigned int mul add ldind.ref")
-	IndexOffAddrOp_Float   -> simp_op (ilxOp "sizeof float32 mul add ldind.r4")
-	IndexOffAddrOp_Double  -> simp_op (ilxOp "sizeof float64 mul add ldind.r8")
-	IndexOffAddrOp_Int8   -> simp_op (ilxOp "sizeof int8 mul add ldind.i1")
-	IndexOffAddrOp_Int16   -> simp_op (ilxOp "sizeof int16 mul add ldind.i2")
-	IndexOffAddrOp_Int32   -> simp_op (ilxOp "sizeof int32 mul add ldind.i4")
-	IndexOffAddrOp_Int64   -> simp_op (ilxOp "sizeof int64 mul add ldind.i8")
-	IndexOffAddrOp_Word8  -> simp_op (ilxOp "sizeof unsigned int8 mul add ldind.u1")
-	IndexOffAddrOp_Word16 -> simp_op (ilxOp "sizeof unsigned int16 mul add ldind.u2")
-	IndexOffAddrOp_Word32  -> simp_op (ilxOp "sizeof unsigned int32 mul add ldind.u4")
-	IndexOffAddrOp_Word64  -> simp_op (ilxOp "sizeof int64 mul add ldind.u8")
-
-	-- ForeignObj: load the address inside the object first
-        -- TODO: is this remotely right?
-	EqForeignObj                 -> warn_op "eqForeignObj" (simp_op (ilxOp "pop /* PrimOp eqForeignObj */ "))
-        IndexOffForeignObjOp_Char    -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof unsigned int8 mul add ldind.u1"])
-	IndexOffForeignObjOp_WideChar    -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof int32 mul add ldind.u4"])
-	IndexOffForeignObjOp_Int     -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof int32 mul add ldind.i4"])
-	IndexOffForeignObjOp_Word    -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof unsigned int32 mul add ldind.u4"])
-	IndexOffForeignObjOp_Addr    ->  arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof native unsigned int mul add ldind.i  "])
-	IndexOffForeignObjOp_StablePtr    ->  ty1_arg2_op (\ty fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof native unsigned int mul add ldind.ref  "])
-	IndexOffForeignObjOp_Float   -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof float32 mul add ldind.r4"])
-	IndexOffForeignObjOp_Double  -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof float64 mul add ldind.r8"])
-	IndexOffForeignObjOp_Int8   -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof int8 mul add ldind.i1"])
-	IndexOffForeignObjOp_Int16   -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof int16 mul add ldind.i2"])
-	IndexOffForeignObjOp_Int32   -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof int32 mul add ldind.i4"])
-	IndexOffForeignObjOp_Int64   -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof int64 mul add ldind.i8"])
-	IndexOffForeignObjOp_Word8  -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof unsigned int8 mul add ldind.u1"])
-	IndexOffForeignObjOp_Word16  -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof unsigned int16 mul add ldind.u2"])
-	IndexOffForeignObjOp_Word32  -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof unsigned int32 mul add ldind.u4"])
-	IndexOffForeignObjOp_Word64  -> arg2_op (\fobj n -> ilxOpSeq [fobj, ilxAddrOfForeignOp, n, ilxOp "sizeof unsigned int64 mul add ldind.u8"])
-
-	ReadOffAddrOp_Char   -> simp_op (ilxOp "sizeof unsigned int8 mul add ldind.u1")
-	ReadOffAddrOp_WideChar -> simp_op (ilxOp "sizeof int32 mul add ldind.u4")
-	ReadOffAddrOp_Int    -> simp_op (ilxOp "sizeof int32 mul add ldind.i4")
-	ReadOffAddrOp_Word   -> simp_op (ilxOp "sizeof unsigned int32 mul add ldind.u4")
-	ReadOffAddrOp_Addr   -> simp_op (ilxOp "sizeof native unsigned int mul add ldind.i")
-	ReadOffAddrOp_Float  -> simp_op (ilxOp "sizeof float32 mul add ldind.r4")
-	ReadOffAddrOp_Double -> simp_op (ilxOp "sizeof float64 mul add ldind.r8")
-	ReadOffAddrOp_StablePtr  -> simp_op (ilxOp "sizeof native unsigned int mul add ldind.ref")
-	ReadOffAddrOp_Int8  -> simp_op (ilxOp "sizeof int8 mul add ldind.i1")
-	ReadOffAddrOp_Int16  -> simp_op (ilxOp "sizeof int16 mul add ldind.i2")
-	ReadOffAddrOp_Int32  -> simp_op (ilxOp "sizeof int32 mul add ldind.i4")
-	ReadOffAddrOp_Int64  -> simp_op (ilxOp "sizeof int64 mul add ldind.i8")
-	ReadOffAddrOp_Word8 -> simp_op (ilxOp "sizeof unsigned int8 mul add ldind.u1")
-	ReadOffAddrOp_Word16 -> simp_op (ilxOp "sizeof unsigned int16 mul add ldind.u2")
-	ReadOffAddrOp_Word32 -> simp_op (ilxOp "sizeof unsigned int32 mul add ldind.u4")
-	ReadOffAddrOp_Word64 -> simp_op (ilxOp "sizeof unsigned int64 mul add ldind.u8")
-                  {-    Addr# -> Int# -> Char# -> State# s -> State# s -} 
-
-	WriteOffAddrOp_Char   -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr, n, ilxOp "add", v, ilxOp "stind.u1"])
-	WriteOffAddrOp_WideChar   -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr, n, ilxOp "sizeof int32 mul add", v, ilxOp "stind.u4"])
-	WriteOffAddrOp_Int    -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr, n, ilxOp "sizeof int32 mul add", v, ilxOp "stind.i4"])
-	WriteOffAddrOp_Word   -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr, n, ilxOp "sizeof int32 mul add", v, ilxOp "stind.u4"])
-	WriteOffAddrOp_Addr   -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr, n, ilxOp "sizeof native unsigned int mul add", v, ilxOp "stind.i"])
-	WriteOffAddrOp_ForeignObj   -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr, n, ilxOp "sizeof native unsigned int mul add", v, ilxOp "stind.ref"])
-	WriteOffAddrOp_Float  -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr, n, ilxOp "sizeof float32 mul add", v,ilxOp "stind.r4"])
-	WriteOffAddrOp_StablePtr   -> ty2_arg4_op (\ty1 sty addr n v s -> ilxOpSeq [addr, n, ilxOp "sizeof native unsigned int mul add", v, ilxOp "stind.ref"])
-	WriteOffAddrOp_Double -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr,n,ilxOp "sizeof float64 mul add",v,ilxOp "stind.r8"])
-	WriteOffAddrOp_Int8  -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr,n,ilxOp "sizeof int8 mul add",v,ilxOp "stind.i1"])
-	WriteOffAddrOp_Int16  -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr,n,ilxOp "sizeof int16 mul add",v,ilxOp "stind.i2"])
-	WriteOffAddrOp_Int32  -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr,n,ilxOp "sizeof int32 mul add",v,ilxOp "stind.i4"])
-	WriteOffAddrOp_Int64  -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr,n,ilxOp "sizeof int64 mul add",v,ilxOp "stind.i8"])
-	WriteOffAddrOp_Word8 -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr,n,ilxOp "sizeof unsigned int8 mul add",v,ilxOp "stind.u1"])
-	WriteOffAddrOp_Word16 -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr,n,ilxOp "sizeof unsigned int16 mul add",v,ilxOp "stind.u2"])
-	WriteOffAddrOp_Word32 -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr,n,ilxOp "sizeof unsigned int32 mul add",v,ilxOp "stind.u4"])
-	WriteOffAddrOp_Word64 -> ty1_arg4_op (\sty addr n v s -> ilxOpSeq [addr,n,ilxOp "sizeof unsigned int64 mul add",v,ilxOp "stind.u8"])
-                  {-    Addr# -> Int# -> Char# -> State# s -> State# s -} 
-
-            {- should be monadic??? -}
-	NewPinnedByteArrayOp_Char -> warn_op "newPinnedByteArray" (simp_op (ilxOp "newarr [mscorlib]System.Byte "))
-	NewByteArrayOp_Char   	 -> simp_op (ilxOp "newarr [mscorlib]System.Byte")
---	NewByteArrayOp_Int    	 -> simp_op (ilxOp "newarr [mscorlib]System.Int32")
---	NewByteArrayOp_Word   	 -> simp_op (ilxOp "newarr [mscorlib]System.UInt32")
---	NewByteArrayOp_Addr   	 -> simp_op (ilxOp "newarr [mscorlib]System.UInt64")
---	NewByteArrayOp_Float  	 -> simp_op (ilxOp "newarr [mscorlib]System.Single")
---	NewByteArrayOp_Double 	 -> simp_op (ilxOp "newarr [mscorlib]System.Double")
---	NewByteArrayOp_StablePtr -> simp_op (ilxOp "newarr [mscorlib]System.UInt32")
---      NewByteArrayOp_Int64     -> simp_op (ilxOp "newarr [mscorlib]System.Int64")  TODO: there is no unique for this one -}
---      NewByteArrayOp_Word64    -> simp_op (ilxOp "newarr  [mscorlib]System.UInt64") -}
-                  {- Int# -> State# s -> (# State# s, MutByteArr# s #) -}
-	ByteArrayContents_Char   -> warn_op "byteArrayContents" (simp_op ilxAddrOfByteArrOp)
-
-	UnsafeFreezeByteArrayOp ->   ty1_op (\ty1  -> ilxOp "nop ")
-                  {- MutByteArr# s -> State# s -> (# State# s, ByteArr# #) -}
-	SizeofByteArrayOp  -> simp_op (ilxOp "ldlen")
-                  {- ByteArr# -> Int# -}
-
-	SameMutableByteArrayOp -> ty1_op (\ty1  -> ilxCeq)
-                 {- MutByteArr# s -> MutByteArr# s -> Bool -}
-	SizeofMutableByteArrayOp -> ty1_op (\ty1  -> ilxOp "ldlen")
-                 {- MutByteArr# s -> Int# -}
-
-	SameMutVarOp -> ty2_op (\ty1 ty2 -> ilxCeq)
-                 {- MutVar# s a -> MutVar# s a -> Bool -}
-	NewMutVarOp -> ty2_op (\ty1 ty2 -> ilxOpSeq [ilxOp "newobj void" , repMutVar ty1 ty2 , ilxOp "::.ctor(!0)"])
-                 {- a -> State# s -> (# State# s, MutVar# s a #) -}
-	ReadMutVarOp -> ty2_op (\ty1 ty2 ->  ilxOpSeq [ilxOp "ldfld !0" , repMutVar ty1 ty2 , ilxOp "::contents"])
-                 {-  MutVar# s a -> State# s -> (# State# s, a #) -}
-	WriteMutVarOp -> ty2_op (\ty1 ty2 -> ilxOpSeq [ilxOp "stfld !0" , repMutVar ty1 ty2 , ilxOp "::contents"])
-                 {- MutVar# s a -> a -> State# s -> State# s -}
-
-	NewArrayOp -> ty2_op (\ty1 ty2 -> ilxCallSuppMeth (ilxType "!!0[]") "newArray" [ty1] [repInt,ilxMethTyVarA])
-                 {- Int# -> a -> State# s -> (# State# s, MutArr# s a #) -}
-	IndexArrayOp -> ty1_op (\ty1 -> ilxOp "ldelem.ref")
-                 {- Array# a -> Int# -> (# a #) -}
-	WriteArrayOp -> ty2_op (\ty1 ty2 -> ilxOp "stelem.ref")
-                 {- MutArr# s a -> Int# -> a -> State# s -> State# s -}
-	ReadArrayOp -> ty2_op (\ty1 ty2 -> ilxOp "ldelem.ref")
-                 {- MutArr# s a -> Int# -> State# s -> (# State# s, a #) -}
-	UnsafeFreezeArrayOp -> ty2_op (\ty1 ty2 -> ilxOp "nop")
-                 {-   MutArr# s a -> State# s -> (# State# s, Array# a #) -}
-	UnsafeThawArrayOp -> ty2_op (\ty1 ty2 -> ilxOp "nop")
-                 {-  Array# a -> State# s -> (# State# s, MutArr# s a #) -}
-
-	SameMutableArrayOp -> ty2_op (\ty1 ty2 -> ilxCeq)
-                 {- MutArr# s a -> MutArr# s a -> Bool -}
-
-
-	RaiseOp -> ty2_op (\ty1 ty2 -> ilxOp "throw")
-	CatchOp -> ty2_op (\ty1 ty2 -> 
-		ilxCallSuppMeth ilxMethTyVarA "'catch'" [ty1,ty2] [ilxLift (ilxTyIO (ilxType "!!0")), 
-                                                              ilxOp "thunk<(func (!!1) --> (func ( /* unit skipped */ ) --> !!0))>"])
-	                    {-        (State# RealWorld -> (# State# RealWorld, a #) )
-	                           -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) 
-	                           -> State# RealWorld
-	                           -> (# State# RealWorld, a #) 
-	                     -} 
-
-	BlockAsyncExceptionsOp -> ty1_op (\ty1 -> 
-		ilxCallSuppMeth ilxMethTyVarA "blockAsyncExceptions" [ty1] [ilxLift (ilxTyIO (ilxType "!!0"))])
-
-                {-     (State# RealWorld -> (# State# RealWorld, a #))
-                    -> (State# RealWorld -> (# State# RealWorld, a #))
-                -}
-
-	UnblockAsyncExceptionsOp -> ty1_op (\ty1 -> 
-		ilxCallSuppMeth ilxMethTyVarA "unblockAsyncExceptions" [ty1] [ilxLift (ilxTyIO (ilxType "!!0"))])
-
-                {-
-		    State# RealWorld -> (# State# RealWorld, a #))
-                    -> (State# RealWorld -> (# State# RealWorld, a #))
-                -}
- 
-	NewMVarOp -> ty2_op (\sty ty -> 
-		ilxOpSeq [ilxOp "newobj void " , repMVar ty , ilxOp "::.ctor()"])
-                 {- State# s -> (# State# s, MVar# s a #) -}
-
-	TakeMVarOp -> ty2_op (\sty ty -> 
-		ilxCallSuppMeth ilxMethTyVarA "takeMVar" [ty] [repMVar ilxMethTyVarA])
-                  {-  MVar# s a -> State# s -> (# State# s, a #) -}
-
-	-- These aren't yet right
-        TryTakeMVarOp -> ty2_op (\sty ty -> 
-		ilxCallSuppMeth (ilxUnboxedPairRep repInt ilxMethTyVarA) "tryTakeMVar" [ty] [repMVar ilxMethTyVarA])
-                  {-  MVar# s a -> State# s -> (# State# s, a #) -}
-
-	TryPutMVarOp -> ty2_op (\sty ty -> 
-		ilxCallSuppMeth repInt "tryPutMVar" [ty] [repMVar ilxMethTyVarA,ilxMethTyVarA])
-                  {-  MVar# s a -> State# s -> (# State# s, a #) -}
-
-	PutMVarOp -> ty2_op (\sty ty -> 
-		ilxCallSuppMeth (ilxOp "void") "putMVar" [ty] [repMVar ilxMethTyVarA, ilxMethTyVarA])
-                   {- MVar# s a -> a -> State# s -> State# s -}
-
-	SameMVarOp -> ty2_op (\sty ty -> ilxCeq)
-                   {- MVar# s a -> MVar# s a -> Bool -}
-
---	TakeMaybeMVarOp -> ty2_op (\sty ty -> 
---		(ilxCallSuppMeth (ilxUnboxedPairRep repInt ilxMethTyVarA) "tryTakeMVar" [ty] [repMVar ilxMethTyVarA]))
---              {- MVar# s a -> State# s -> (# State# s, Int#, a #) -}
-
-	IsEmptyMVarOp -> ty2_op (\sty ty -> 
-		ilxCallSuppMeth repInt "isEmptyMVar" [ty] [repMVar ilxMethTyVarA])
-               {- MVar# s a -> State# s -> (# State# s, Int# #) -}
-
-	TouchOp -> warn_op "touch" (ty1_op (\ty1 -> ilxOp "pop /* PrimOp touch */ "))
-
-               {- a -> Int# -}
-	DataToTagOp -> ty1_op (\ty1 -> 
-		ilxCallSuppMeth repInt "dataToTag" [ty1] [ilxMethTyVarA])
-               {- a -> Int# -}
-
-	TagToEnumOp -> ty1_op (\ty1 -> 
-		ilxCallSuppMeth ilxMethTyVarA "tagToEnum" [ty1] [repInt])
-               {- Int# -> a -}
-
-	MakeStablePtrOp -> ty1_op (\ty1 -> ilxOpSeq [ilxOp "box", ty1, ilxOp "newobj void", repStablePtr {- ty1 -}, ilxOp "::.ctor(class [mscorlib]System.Object)"])
-                 {-   a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #) -}
-	MakeStableNameOp -> ty1_op (\ty1 -> ilxOpSeq [ilxOp "pop newobj void", repStableName {- ty1 -}, ilxOp "::.ctor()"])
-                        -- primOpInfo MakeStableNameOp = mkGenPrimOp SLIT("makeStableName#")  [alphaTyVar] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed 2 [mkStatePrimTy realWorldTy, mkStableNamePrimTy alphaTy]))
-
-        EqStableNameOp -> ty1_op (\ty1 -> ilxOp "ceq")
-               -- [alphaTyVar] [mkStableNamePrimTy alphaTy, mkStableNamePrimTy alphaTy] (intPrimTy)
-        StableNameToIntOp -> warn_op "StableNameToIntOp" (ty1_op (\ty1 -> ilxOp "pop ldc.i4 0"))
-               -- [alphaTyVar] [mkStableNamePrimTy alphaTy] (intPrimTy)
-
-	DeRefStablePtrOp -> ty1_op (\ty1 -> ilxOpSeq [ilxOp "ldfld class [mscorlib]System.Object", repStablePtr {- ty1 -}, ilxOp "::contents"])
-                 {-  StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #) -}
-
-	EqStablePtrOp -> ty1_op (\ty1 -> ilxOp "ceq")
-                 {-  StablePtr# a -> StablePtr# a -> Int# -}
-
-            -- The 3rd argument to MkWeakOp is always a IO Monad action, i.e. passed as () --> ()
-	MkWeakOp -> ty3_op (\ty1 ty2 ty3 ->  ilxCall (ilxMethodRef (repWeak ilxMethTyVarB) classWeak "bake" [ilxLift ty1,ilxLift ty2] [ilxMethTyVarA, ilxMethTyVarB, ilxLift (ilxTyIO ilxUnboxedEmptyRep)]))
-                 {- o -> b -> c -> State# RealWorld -> (# State# RealWorld, Weak# b #) -}
-
-	DeRefWeakOp -> ty1_op (\ty1 ->  ilxCall (ilxMethodRef (ilxUnboxedPairRep repInt ilxMethTyVarA) classWeak "deref" [ty1] [repWeak ilxMethTyVarA]))
-	FinalizeWeakOp -> ty1_op (\ty1 ->  ilxCall (ilxMethodRef (ilxUnboxedPairRep repInt (ilxTyIO ilxUnboxedEmptyRep)) classWeak "finalizer" [ty1] [repWeak ilxMethTyVarA]))
-                   {-    Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, 
-	State# RealWorld -> (# State# RealWorld, Unit #)) #) -}
-
-	MkForeignObjOp -> simp_op (ilxOpSeq [ilxOp "newobj void", repForeign, ilxOp "::.ctor(void *)"])
-	WriteForeignObjOp -> ty1_op (\sty -> ilxOpSeq [ilxOp "stfld void *", repForeign, ilxOp "::contents"])
-        ForeignObjToAddrOp -> simp_op ilxAddrOfForeignOp
-	YieldOp -> simp_op (ilxOpSeq [ilxOp "call class [mscorlib]System.Threading.Thread class [mscorlib]System.Threading.Thread::get_CurrentThread() 
-                                call instance void class [mscorlib]System.Threading.Thread::Suspend()"])
-	MyThreadIdOp -> simp_op (ilxOpSeq [ilxOp "call default  class [mscorlib]System.Threading.Thread class [mscorlib]System.Threading.Thread::get_CurrentThread() "])
-	-- This pushes a THUNK across as the exception value.
-        -- This is the correct Haskell semantics...  TODO: we should probably
-        -- push across an HaskellThreadAbortException object that wraps this
-        -- thunk, but which is still actually an exception of
-        -- an appropriate type.
-        KillThreadOp -> ty1_op (\ty -> ilxOpSeq [ilxOp "call instance void class [mscorlib]System.Threading.Thread::Abort(class [mscorlib]System.Object) "])
-              {-   ThreadId# -> a -> State# RealWorld -> State# RealWorld -}
-
-	ForkOp -> warn_op "ForkOp" (simp_op (ilxOp "/* ForkOp skipped... */ newobj void [mscorlib]System.Object::.ctor() throw"))
-	ParOp ->  warn_op "ParOp" (simp_op (ilxOp "/* ParOp skipped... */ newobj void [mscorlib]System.Object::.ctor() throw"))
-	DelayOp -> simp_op (ilxOp "call void class [mscorlib]System.Threading.Thread::Sleep(int32) ")
-                 {-    Int# -> State# s -> State# s -}
-
-	WaitReadOp  -> warn_op "WaitReadOp" (simp_op (ilxOp "/* WaitReadOp skipped... */ pop"))
-   	WaitWriteOp -> warn_op "WaitWriteOp" (simp_op (ilxOp " /* WaitWriteOp skipped... */ newobj void [mscorlib]System.Object::.ctor() throw"))
-	ParAtForNowOp -> warn_op "ParAtForNowOp" (simp_op (ilxOp " /* ParAtForNowOp skipped... */ newobj void [mscorlib]System.Object::.ctor() throw"))
-	ParAtRelOp -> warn_op "ParAtRelOp" (simp_op (ilxOp " /* ParAtRelOp skipped... */ newobj void [mscorlib]System.Object::.ctor() throw"))
-	ParAtAbsOp -> warn_op "ParAtAbsOp" (simp_op (ilxOp " /* ParAtAbsOp skipped... */ newobj void [mscorlib]System.Object::.ctor() throw"))
-	ParAtOp -> warn_op "ParAtOp" (simp_op (ilxOp " /* ParAtOp skipped... */ newobj void [mscorlib]System.Object::.ctor() throw"))
-	ParLocalOp -> warn_op "ParLocalOp" (simp_op (ilxOp " /* ParLocalOp skipped... */ newobj void [mscorlib]System.Object::.ctor() throw"))
-	ParGlobalOp -> warn_op "ParGlobalOp" (simp_op (ilxOp " /* ParGlobalOp skipped... */ newobj void [mscorlib]System.Object::.ctor() throw"))
-	SeqOp -> warn_op "SeqOp" (simp_op (ilxOp " newobj void [mscorlib]System.Object::.ctor() throw "))
-	AddrToHValueOp -> warn_op "AddrToHValueOp" (simp_op (ilxOp "newobj void [mscorlib]System.Object::.ctor() throw"))
---	ReallyUnsafePtrEqualityOp -> simp_op (ilxOp "ceq")
-
-        MkApUpd0_Op ->  warn_op "MkApUpd0_Op" (simp_op (ilxOp " newobj void [mscorlib]System.Object::.ctor() throw"))
-        NewBCOOp ->  warn_op "NewBCOOp" (simp_op (ilxOp " newobj void [mscorlib]System.Object::.ctor() throw"))
-                  -- ("newBCO#")  [alphaTyVar, deltaTyVar] [byteArrayPrimTy, byteArrayPrimTy, mkArrayPrimTy alphaTy, byteArrayPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed 2 [mkStatePrimTy deltaTy, bcoPrimTy]))
-        _        -> pprPanic "Unimplemented primop" (ppr op)
-
-
-ty1_op :: (IlxTyFrag -> IlxOpFrag) -> [StgArg] ->  IlxOpFrag 
-ty1_op  op ((StgTypeArg ty1):rest)  = 
-      ilxOpSeq [getArgsStartingAt 1 rest, 
-                op (ilxTypeR2 (deepIlxRepType ty1))]
-
-ty2_op :: (IlxTyFrag -> IlxTyFrag -> IlxOpFrag) -> [StgArg] ->  IlxOpFrag 
-ty2_op  op ((StgTypeArg ty1):(StgTypeArg ty2):rest)  = 
-      ilxOpSeq [getArgsStartingAt 2 rest, 
-                op (ilxTypeR2 (deepIlxRepType ty1)) 
-                   (ilxTypeR2 (deepIlxRepType ty2))]
-
-ty3_op :: (IlxTyFrag -> IlxTyFrag -> IlxTyFrag -> IlxOpFrag) -> [StgArg] ->  IlxOpFrag 
-ty3_op  op ((StgTypeArg ty1):(StgTypeArg ty2):(StgTypeArg ty3):rest) = 
-      ilxOpSeq [getArgsStartingAt 3 rest, 
-                op (ilxTypeR2 (deepIlxRepType ty1)) 
-                   (ilxTypeR2 (deepIlxRepType ty2))
-                   (ilxTypeR2 (deepIlxRepType ty3))]
-
-arg2_op :: (IlxTyFrag -> IlxOpFrag -> IlxOpFrag) -> [StgArg] ->  IlxOpFrag 
-arg2_op  op [a1, a2] = 
-       op (getAsArg 1 a1)
-          (getAsArg 2 a2)
-
-ty1_arg2_op :: (IlxTyFrag -> IlxOpFrag ->  IlxOpFrag -> IlxOpFrag) -> [StgArg] ->  IlxOpFrag 
-ty1_arg2_op  op [(StgTypeArg ty1), a1, a2] = 
-       op (ilxTypeR2 (deepIlxRepType ty1)) 
-          (getAsArg 1 a1)
-          (getAsArg 2 a2)
-
-ty1_arg4_op :: (IlxTyFrag -> IlxOpFrag -> IlxOpFrag -> IlxOpFrag -> IlxOpFrag -> IlxOpFrag) -> [StgArg] ->  IlxOpFrag 
-ty1_arg4_op  op [(StgTypeArg ty1), a1, a2, a3, a4] = 
-       op (ilxTypeR2 (deepIlxRepType ty1)) 
-          (getAsArg 1 a1)
-          (getAsArg 2 a2)
-          (getAsArg 3 a3)
-          (getAsArg 4 a4)
-
-ty2_arg4_op :: (IlxTyFrag -> IlxTyFrag -> IlxOpFrag -> IlxOpFrag -> IlxOpFrag -> IlxOpFrag -> IlxOpFrag) -> [StgArg] ->  IlxOpFrag 
-ty2_arg4_op  op [(StgTypeArg ty1), (StgTypeArg ty2),a1, a2, a3, a4] = 
-       op (ilxTypeR2 (deepIlxRepType ty1)) 
-          (ilxTypeR2 (deepIlxRepType ty2)) 
-          (getAsArg 2 a1)
-          (getAsArg 3 a2)
-          (getAsArg 4 a3)
-          (getAsArg 5 a4)
-
-hd (h:t) = h
-
-getAsArg n a env = hd (ilxMapPlaceArgs n pushArg env [a])
-getArgsStartingAt n a env = vcat (ilxMapPlaceArgs n pushArg env a)
-
-simp_op :: IlxOpFrag -> [StgArg] -> IlxOpFrag
-simp_op  op args env    = vcat (ilxMapPlaceArgs 0 pushArg env args) $$ op env
-warn_op  warning f args = trace ("WARNING! IlxGen cannot translate primop " ++ warning) (f args)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{C Calls}
-%*									*
-%************************************************************************
-
-\begin{code}
--- Call the P/Invoke stub wrapper generated in the import section.
--- We eliminate voids in and around an IL C Call.  
--- We also do some type-directed translation for pinning Haskell-managed blobs
--- of data as we throw them across the boundary.
-ilxFCall env (CCall (CCallSpec (StaticTarget c) cconv gc)) args ret_ty
- = ilxComment ((text "C call") <+> pprCLabelString c) <+> 
-	vcat [vcat (ilxMapPlaceArgs 0 pushCArg env args),
-              text "call" <+> retdoc <+> pprCLabelString c <+> tyarg_doc
-                    <+> pprCValArgTys ilxTypeL env (map deepIlxRepType (filter (not. isVoidIlxRepType) (map stgArgType tm_args))) ]
-  where 
-    retdoc | isVoidIlxRepType ret_ty = text "void"
-	   | otherwise		     = ilxTypeR env (deepIlxRepType ret_ty)
-    (ty_args,tm_args) = splitTyArgs1 args
-    tyarg_doc | not (isEmptyVarSet (tyVarsOfTypes ty_args)) = text "/* type variable found */"
-	      | otherwise = pprTypeArgs ilxTypeR env ty_args
-
-ilxFCall env (DNCall (DNCallSpec call_instr)) args ret_ty
-  = ilxComment (text "IL call") <+> 
-    vcat [vcat (ilxMapPlaceArgs 0 pushEvalArg env tm_args), 
-	  ptext call_instr
-		-- In due course we'll need to pass the type arguments
-		-- and to do that we'll need to have more than just a string
-		-- for call_instr
-    ]
-  where
-    (ty_args,tm_args) = splitTyArgs1 args 
-
--- Push and argument and force its evaluation if necessary.
-pushEvalArg _ (StgTypeArg _) = empty
-pushEvalArg env (StgVarArg arg) = ilxFunApp env arg [] False
-pushEvalArg env (StgLitArg lit) = pushLit env lit
-
-
-hasTyCon (TyConApp tc _) tc2 = tc == tc2
-hasTyCon _  _ = False
-
-isByteArrayCArgTy ty = hasTyCon ty byteArrayPrimTyCon || hasTyCon ty mutableByteArrayPrimTyCon
-isByteArrayCArg v = isByteArrayCArgTy (deepIlxRepType (idType v))
-
-isForeignObjCArgTy ty = hasTyCon ty foreignObjPrimTyCon
-isForeignObjCArg v = isForeignObjCArgTy (deepIlxRepType (idType v))
-
-pinCCallArg v = isByteArrayCArg v || isForeignObjCArg v  
-
-pinCArg  env arg v = pushArg env arg <+> text "dup stloc" <+> singleQuotes (ilxEnvQualifyByExact env (ppr v) <> text "pin") 
-pushCArg  env arg@(StgVarArg v) | isByteArrayCArg v = pinCArg env arg v <+> ilxAddrOfByteArrOp env
-pushCArg env arg@(StgVarArg v) | isForeignObjCArg v = pinCArg env arg v <+> ilxAddrOfForeignOp env
-pushCArg env arg | otherwise = pushArg env arg
-
-pprCValArgTys f env tys = parens (pprSepWithCommas (pprCValArgTy f env) tys)
-pprCValArgTy f env ty | isByteArrayCArgTy ty = text "void *" <+> ilxComment (text "interior pointer into ByteArr#")
-pprCValArgTy f env ty | isForeignObjCArgTy ty = text "void *" <+> ilxComment (text "foreign object")
-pprCValArgTy f env ty | otherwise = f env ty
-
-
-foldR            :: (a -> b -> b) -> [a] -> b -> b
--- foldR _ [] z     =  z
--- foldR f (x:xs) z =  f x (foldR f xs z) 
-{-# INLINE foldR #-}
-foldR k xs z = go xs
-	     where
-	       go []     = z
-	       go (y:ys) = y `k` go ys
-
-\end{code}
-
diff --git a/ghc/compiler/ilxGen/Makefile.stdlib b/ghc/compiler/ilxGen/Makefile.stdlib
deleted file mode 100644
index bab993346e..0000000000
--- a/ghc/compiler/ilxGen/Makefile.stdlib
+++ /dev/null
@@ -1,82 +0,0 @@
-PrelAll_SRC=Array.lhs          Maybe.lhs          PrelDynamic.lhs    PrelIOBase.lhs     PrelShow.lhs \
-CPUTime.lhs        Monad.lhs          PrelEnum.lhs       PrelList.lhs       PrelStable.lhs \
-Char.lhs           Numeric.lhs        PrelErr.lhs               PrelTup.lhs \
-Complex.lhs        PrelAddr.lhs       PrelException.lhs  PrelMaybe.lhs      PrelWeak.lhs \
-Directory.lhs      PrelArr.lhs        PrelFloat.lhs      PrelNum.lhs        Prelude.lhs \
-IO.lhs             PrelArrExtra.lhs   PrelForeign.lhs    PrelPack.lhs       Random.lhs \
-Ix.lhs             PrelBase.lhs       PrelHandle.lhs     PrelRead.lhs       Ratio.lhs \
-List.lhs           PrelByteArr.lhs    PrelHugs.lhs       PrelReal.lhs       System.lhs \
-Locale.lhs         PrelConc.lhs       PrelIO.lhs         PrelST.lhs         Time.lhs
-
-PrelAll_ILX=$(patsubst %.lhs,%.ilx,$(PrelAll_SRC))
-CLEAN_FILES += $(PrelAll_ILX)
-PrelAll_ILX_FWD=$(patsubst %.lhs,%.ilx.fwd.ok,$(PrelAll_SRC))
-PrelAll_IL=$(patsubst %.lhs,%.il,$(PrelAll_SRC))  PrelGHC.il
-PrelAll_MOD=$(patsubst %.il,%.mod,$(PrelAll_IL))
-
-
-%.ilx %.ilx.fwd: %.lhs
-	$(HC_PRE_OPTS)
-	$(HC) $(HC_OPTS) -Onot -D__ILX__ --ilx $*.lhs -o $*.ilx 
-	$(HC_POST_OPTS)
-
-
-CORRUN=
-LOCALRUN=./
-ifeq ($(HOSTNAME),msrc-hilda)
-CORRUN=cmd /c "devvs && "
-LOCALRUN=.\\
-endif    
-
-ILXASM=/devel/fcom/src/bin/ilxasmx.exe -l /devel/fcom/src/ilxasm --no-ilasm --box-everything
-ILASM=$(CORRUN)ilasm
-AL=$(CORRUN)al
-
-%.ilx.fwd.ok: %.ilx.fwd
-	if diff -q $< $@; then true; else cp $< $@; fi
-
-%.mod : %.il
-	$(ILASM) /QUIET /DLL /OUT=$@ $<
-
-PrelGHC.il: ../../compiler/ilxGen/PrelGHC.il
-	cp $< $@
-
-PrelAll.dll : ilxasm-stdlib.mod $(PrelAll_MOD)
-	$(AL) ilxasm-stdlib.mod $(PrelAll_MOD) -out:$@
-
-%.ilx_with_fwd: %.ilx $(PrelAll_ILX_FWD)
-	cat  $(PrelAll_ILX_FWD) $*.ilx > $@
-
-%.il : %.ilx_with_fwd  /devel/fcom/src/bin/ilxasmx.exe
-	$(ILXASM) --no-stdlib -o $@ $*.ilx_with_fwd 
-
-ilxasm-stdlib.il : /devel/fcom/src/bin/ilxasmx.exe /devel/fcom/src/ilxasm/stdlib-func-by-mcalli.ilx
-	rm -f tmp.ilx
-	touch tmp.ilx
-	$(ILXASM) -o $@ tmp.ilx
-	rm -f tmp.ilx
-
-
-#--------------------
-# For validation only:
-
-PrelAll.il: $(PrelAll_IL) ilxasm-stdlib.il
-	cat ilxasm-stdlib.il $(PrelAll_IL) > $@
-
-%.mvl: %.il
-	make -C ../../compiler/ilxGen/tests ilvalidx
-	ILVALID_HOME=/devel/fcom/src /devel/fcom/src/bin/ilvalidx.exe $*.il
-
-
-ilxasm:
-	make -C ../../compiler/ilxGen/tests ilxasmx
-
-ilvalid:
-	$(MAKE) -C /devel/fcom/src bin/ilvalidx.exe
-
-
-ghc:
-	make -C ../../compiler/ilxGen/tests ghc
-
-
-.PRECIOUS: %.ilx.fwd %.ilx.fwd.ok %.il %.ilx_with_fwd
diff --git a/ghc/compiler/ilxGen/tests/Makefile b/ghc/compiler/ilxGen/tests/Makefile
deleted file mode 100644
index 423839c9e8..0000000000
--- a/ghc/compiler/ilxGen/tests/Makefile
+++ /dev/null
@@ -1,130 +0,0 @@
-
-TOP = ../../..
-include $(TOP)/mk/boilerplate.mk
-
-WAYS=$(GhcLibWays)
-
-#-----------------------------------------------------------------------------
-# 	Setting the standard variables
-#
-
-HC = $(GHC_INPLACE)
-SRC_HC_OPTS+=-cpp -fglasgow-exts
-
-#-----------------------------------------------------------------------------
-# 
-CORENV_DEBUG=
-CORENV_RETAIL=
-LOCALRUN=./
-ifeq ($(HOSTNAME),MSRC-HILDA)
-CORENV_DEBUG="call devcorb2gen.bat checked"
-CORENV_RETAIL="call devcorb2gen.bat free"
-LOCALRUN=.\\
-endif    
-
-ghc:
-	$(MAKE) -C ../.. 
-
-ilx:
-	$(MAKE) -C $(ILX2IL_HOME) ilxdefault
-
-prel: ilx
-	$(MAKE) -C ../../../lib/std std.$(ilx_way).dll std.$(ilx_way).vlb
-
-#========================================================================
-# 1. From Haskell to ILX and then to IL - see build.mk 
-
-#------------------------------------------------------------------------
-# 2. From IL to .EXE
-
-%.$(ilx_way).exe : %.$(ilx_way).il ../Entry.$(ilx_way).il 
-	cat $*.$(ilx_way).il ../Entry.$(ilx_way).il > $@.tmp
-#	echo "call devcorb2gen free" > tmp.bat
-	echo "ilasm /DEBUG /QUIET /OUT=$@ $@.tmp" >> tmp.bat
-	cmd /c tmp.bat
-
-../Entry.$(hs2ilx_suffix)_o: ../Entry.ilx
-	sed -e "s|ilx std|ilx std.$(hs2ilx_suffix)|g" ../Entry.ilx > $@.tmp
-	mv $@.tmp $@
-
-
-%.$(ilx_way).mvl:  %.$(ilx_way).il
-	(ILVALID_HOME=c:\\devel\\fcom\\src\\ ILVALID_MSCORLIB=mscorlib.vlb $(ILVALID) c:\\devel\\fcom\\src\\bin\\msilxlib$(ilx2il_suffix).vlb $(TOP)/lib/std/std.$(ilx_way).vlb $<) 2>&1
-
-
-#------------------------------------------------------------------------
-# From .HS to .EXE without using ILX
-# Used to run performance comparisons against native code GHC
-
-%.Onot.exe: %.hs
-	$(GHC_INPLACE) -Onot -o $@ $<
-
-%.O.exe: %.hs
-	$(GHC_INPLACE) -O -o $@ $<
-
-WIN_TOP_ABS = $(subst /,\,$(FPTOOLS_TOP_ABS))
-WIN_ILX2IL_HOME = $(subst /,\,$(ILX2IL_HOME))
-
-app.config:
-	echo "<configuration>" > $@
-	echo "<runtime>" >> $@
-	echo "<assemblyBinding xmlns=\"urn:schemas-microsoft-com:asm.v1\">" >> $@
-	echo "<probing privatePath=\"$(WIN_TOP_ABS)\\ghc\\lib\\std;$(WIN_ILX2IL_HOME)\\bin\"/>" >> $@
-	echo "</assemblyBinding>" >> $@
-	echo "</runtime>" >> $@
-	echo "</configuration>" >> $@
-
-%.run: %.exe app.config
-	time -p $<
-
-#------------------------------------------------------------------------
-# Running:
-
-HSstd_cbits.dll: $(DLL_PEN)/HSstd_cbits.dll
-	cp $< $@
-
-%.cordbg.run: HSstd_cbits.dll %.exe
-	cp app.config $@.config
-#	echo "call devcorb2gen fastchecked" > $@.bat
-	echo "$(LOCALRUN)$(subst /,\\,$*).exe 2>&1" >> $@.bat
-	time -p cmd /c $(subst /,\\,$@).bat
-	rm $@.bat
-
-%.debug.run: HSstd_cbits.dll %.exe
-	cp app.config $@.config
-#	echo "call devcorb2gen fastchecked" > $@.bat
-	echo "$(LOCALRUN)$(subst /,\\,$*).exe 2>&1" >> $@.bat
-	time -p cmd /c $(subst /,\\,$@).bat
-	rm $@.bat
-
-%.retail.run: HSstd_cbits.dll %.exe
-	cp app.config $@.config
-#	echo "call devcorb2gen free" > $@.bat
-	echo "$(LOCALRUN)$(subst /,\\,$*).exe 2>&1" >> $@.bat
-	time -p cmd /c $(subst /,\\,$@).bat
-	rm $@.bat
-
-
-%.run: %.exe
-	time -p $<
-
-
-#--------------------
-
-%.mvl: %.nolib.il
-	ILVALID_HOME=$(ILX2IL_HOME) $(ILVALID) $*.nolib.il
-
-ci:
-	(cd $(ILX2IL_HOME); $(CVS) ci -m "")
-	(cd ../..; cvs ci -m "")
-	(cd ../../../lib/std; $(CVS) ci -m "")
-
-upd:
-	(cd $(ILX2IL_HOME); $(CVS) up)
-	(cd ../..; $(CVS) up)
-	(cd ../../../lib/std; $(CVS) up)
-
-
-.PHONY: %.run
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/compiler/ilxGen/tests/PrelNum.hs b/ghc/compiler/ilxGen/tests/PrelNum.hs
deleted file mode 100644
index ca23e149ff..0000000000
--- a/ghc/compiler/ilxGen/tests/PrelNum.hs
+++ /dev/null
@@ -1,120 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
-
-module PrelNum where
-
-import {-# SOURCE #-} PrelErr
-import PrelBase
-import PrelList
-import PrelEnum
-import PrelShow
-
-infixl 7  *
-infixl 6  +, -
-
-default ()		-- Double isn't available yet, 
-			-- and we shouldn't be using defaults anyway
-
-
-
-
-
-
-
-
-
-class  (Eq a, Show a) => Num a  where
-    (+), (-), (*)	:: a -> a -> a
-    negate		:: a -> a
-    abs, signum		:: a -> a
-    fromInteger		:: Integer -> a
-    fromInt		:: Int -> a -- partain: Glasgow extension
-
-    x - y		= x + negate y
-    negate x		= 0 - x
-    fromInt (I# i#)	= fromInteger (S# i#)
-					-- Go via the standard class-op if the
-					-- non-standard one ain't provided
-
-
-
-
-
-subtract	:: (Num a) => a -> a -> a
-{-# INLINE subtract #-}
-subtract x y	=  y - x
-
-ord_0 :: Num a => a
-ord_0 = fromInt (ord '0')
-
-
-
-
-
-
-
-
-
-
-instance  Num Int  where
-    (+)	   x y =  plusInt x y
-    (-)	   x y =  minusInt x y
-    negate x   =  negateInt x
-    (*)	   x y =  timesInt x y
-    abs    n   = if n `geInt` 0 then n else (negateInt n)
-
-    signum n | n `ltInt` 0 = negateInt 1
-	     | n `eqInt` 0 = 0
-	     | otherwise   = 1
-
-    fromInt n	  = n
-
-
-
-
--- These can't go in PrelBase with the defn of Int, because
--- we don't have pairs defined at that time!
-
-quotRemInt :: Int -> Int -> (Int, Int)
-a@(I# _) `quotRemInt` b@(I# _) = (a `quotInt` b, a `remInt` b)
-    -- OK, so I made it a little stricter.  Shoot me.  (WDP 94/10)
-
-divModInt ::  Int -> Int -> (Int, Int)
-divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y)
-    -- Stricter.  Sorry if you don't like it.  (WDP 94/10)
-
-
-
-
-
-
-
-
-
-
-data Integer	
-   = S# Int#				-- small integers
-   | J# Int# ByteArray#			-- large integers
-
-
-
-
-
-zeroInteger :: Integer
-zeroInteger = S# 0#
-
diff --git a/ghc/compiler/ilxGen/tests/build.mk b/ghc/compiler/ilxGen/tests/build.mk
deleted file mode 100644
index 285fd5de4e..0000000000
--- a/ghc/compiler/ilxGen/tests/build.mk
+++ /dev/null
@@ -1,121 +0,0 @@
-# 1. To make standard library:
-#
-# e.g. from lib/std directory:
-#	$(MAKE) way=ilx-Onot-mono std.ilx-Onot.mono.dll std.ilx-Onot.mono.vlb
-#	$(MAKE) way=ilx-O-mono  std.ilx-O.mono.dll std.ilx-O.mono.vlb
-#	$(MAKE) way=ilx-Onot-generic std.ilx-Onot.generic.dll
-#
-# 2. To make tests:
-#
-# e.g. from ilxGen/tests directory:
-#
-#  $ make -n way=ilx-Onot-mono test1.ilx-Onot.mono.retail.run 
-#
-#  $ make -n way=ilx-Onot-mono test1-nostdlib.ilx-Onot.mono.retail.run HC_OPTS="-fno-implicit-prelude -fglasgow-exts"
-#
-
-
-# Add all the ILX ways so dependencies get made correctly.
-# (n.b. Actually we only need to add "ilx-Onot" and "ilx-O" for the 
-#       GHC --> ILX dependencies, as these are the portions of the ILX
-#       ways that are relevant in terms of GHC options,
-#       but we list some of the others anyway.  Also note that
-#       there are no dependencies required for the ILX --> IL or
-#       IL --> CLR phases as these operate on the "standalone"
-#       ILX and IL files).
-#
-#GhcLibWays+= ilx-Onot-mono ilx-Onot ilx-O ilx-O-mono
-GhcLibWays+=i
-GhcWithIlx=YES
-
-ILXized=YES
-
-GhcHcOpts+=-DILX -DNO_BIG_TUPLES
-GhcLibHcOpts+=-optI--mono -optI--add-suffix-to-assembly -optImsilxlib -optI--suffix-to-add -optI.mono
-
-# Each set of args below defines one ILX way.
-#ALL_WAYS+=ilx-Onot-generic
-#WAY_ilx-Onot-generic_NAME=ILX with Haskell Optimizer Off to run on Generic CLR
-#WAY_ilx-Onot-generic_HC_OPTS=-buildtag ilx-Onot  $(GHC_ILX_OPTS) -Onot 
-#WAY_ilx-Onot-generic_ILX2IL_OPTS=--generic
-#WAY_ilx-Onot-generic_ILX=YES
-
-#ALL_WAYS+=ilx-Onot-fullgeneric-verifiable
-#WAY_ilx-Onot-fullgeneric-verifiable_NAME=ILX with Haskell Optimizer Off to run on Generic CLR
-#WAY_ilx-Onot-fullgeneric-verifiable_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot 
-#WAY_ilx-Onot-fullgeneric-verifiable_ILX2IL_OPTS=--fullgeneric --verifiable
-#WAY_ilx-Onot-fullgeneric-verifiable_ILX=YES
-
-#ALL_WAYS+=ilx-Onot-repgeneric-verifiable
-#WAY_ilx-Onot-repgeneric-verifiable_NAME=ILX with Haskell Optimizer Off to run on Generic CLR
-#WAY_ilx-Onot-repgeneric-verifiable_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot 
-#WAY_ilx-Onot-repgeneric-verifiable_ILX2IL_OPTS=--repgeneric --verifiable
-#WAY_ilx-Onot-repgeneric-verifiable_ILX=YES
-
-#ALL_WAYS+=ilx-O-generic
-#WAY_ilx-O-generic_NAME=ILX with Haskell Optimizer On to run on Generic CLR
-#WAY_ilx-O-generic_HC_OPTS=-buildtag ilx-O $(GHC_ILX_OPTS) -O 
-#WAY_ilx-O-generic_ILX2IL_OPTS=--generic
-#WAY_ilx-O-generic_ILX=YES
-
-#ALL_WAYS+=ilx-Onot-mono
-#WAY_ilx-Onot-mono_NAME=ILX with Haskell Optimizer Off to run on V1 CLR
-#WAY_ilx-Onot-mono_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot 
-#WAY_ilx-Onot-mono_ILX2IL_OPTS=--mono
-#WAY_ilx-Onot-mono_ILX=YES
-
-#ALL_WAYS+=ilx-Onot-mono-verifiable
-#WAY_ilx-Onot-mono-verifiable_NAME=ILX with Haskell Optimizer Off to run on V1 CLR, verifiable code (CURRENTLY WILL NOT RUN BECAUSE OF LACK OF HIGHER KINDED TYPE PARAMETERS BUT IS USEFUL TO FIND BUGS USING THE VERIFIER)
-#WAY_ilx-Onot-mono-verifiable_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot 
-#WAY_ilx-Onot-mono-verifiable_ILX2IL_OPTS=--mono --verifiable
-#WAY_ilx-Onot-mono-verifiable_ILX=YES
-
-#ALL_WAYS+=ilx-O-mono
-#WAY_ilx-O-mono_NAME=ILX with Haskell Optimizer On to run on V1 CLR
-#WAY_ilx-O-mono_HC_OPTS=-buildtag ilx-O $(GHC_ILX_OPTS) -O 
-#WAY_ilx-O-mono_ILX2IL_OPTS=--mono
-#WAY_ilx-O-mono_ILX=YES
-
-#ALL_WAYS+=ilx-Onot-generic-traced
-#WAY_ilx-Onot-generic-traced_NAME=ILX with Haskell Optimizer Off to run on Generic CLR
-#WAY_ilx-Onot-generic-traced_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot 
-#WAY_ilx-Onot-generic-traced_ILX2IL_OPTS=--generic --traced
-#WAY_ilx-Onot-generic-traced_ILX=YES
-
-#ALL_WAYS+=ilx-O-generic-traced
-#WAY_ilx-O-generic-traced_NAME=ILX with Haskell Optimizer On to run on Generic CLR
-#WAY_ilx-O-generic-traced_HC_OPTS=-buildtag ilx-O $(GHC_ILX_OPTS) -O 
-#WAY_ilx-O-generic-traced_ILX2IL_OPTS=--generic --traced
-#WAY_ilx-O-generic-traced_ILX=YES
-
-#ALL_WAYS+=ilx-Onot-mono-traced
-#WAY_ilx-Onot-mono-traced_NAME=ILX with Haskell Optimizer Off to run on V1 CLR
-#WAY_ilx-Onot-mono-traced_HC_OPTS=-buildtag ilx-Onot $(GHC_ILX_OPTS) -Onot 
-#WAY_ilx-Onot-mono-traced_ILX2IL_OPTS=--mono --traced
-#WAY_ilx-Onot-mono-traced_ILX=YES
-
-#ALL_WAYS+=ilx-O-mono-traced
-#WAY_ilx-O-mono-traced_NAME=ILX with Haskell Optimizer On to run on V1 CLR
-#WAY_ilx-O-mono-traced_HC_OPTS=-buildtag ilx-O $(GHC_ILX_OPTS) -O 
-#WAY_ilx-O-mono-traced_ILX2IL_OPTS=--mono --traced
-#WAY_ilx-O-mono-traced_ILX=YES
-
-# Put a "." after the Haskell portion of the way.  Way names can't contain
-# dots for some reason elsewhere in the Make system.  But we need to be able
-# to split out the Haskell portion of the way from the ILX portion (e.g. --generic)
-# and the runtime portion (e.g. --retail).
-ilx_way=$(subst ilx-Onot-,ilx-Onot.,$(subst ilx-O-,ilx-O.,$(way)))
-ilx2il_suffix=$(subst ilx-Onot.,.,$(subst ilx-O.,.,$(ilx_way)))
-hs2ilx_suffix=$(subst $(ilx2il_suffix),,$(ilx_way))
-HS_ILX=$(subst $(way),$(hs2ilx_suffix),$(HS_OBJS))
-#HS_IL=$(subst $(hs2ilx_suffix)_o,$(ilx_way).il,$(HS_ILX))
-HS_IL=$(subst .o,.il,$(HS_ILX))
-
-ILVALID=C:/devel/fcom/bin/ilvalid.exe
-ILVERIFY=C:/devel/fcom/bin/ilverify.exe
-
-%.$(ilx_way).mvl : %.$(ilx_way).il $(HS_IL)  
-	((ILVALID_HOME=c:\\devel\\fcom\\src\\ ILVALID_MSCORLIB=mscorlib.vlb $(ILVALID) c:\\devel\\fcom\\src\\bin\\msilxlib$(ilx2il_suffix).vlb  $(addprefix --other-il-module ,$(filter-out $*.$(ilx_way).il,$(HS_IL))) $<) 2>&1) | tee $@
-
-%.$(ilx_way).mvr : %.$(ilx_way).il $(HS_IL) 
-	((ILVALID_HOME=c:\\devel\\fcom\\src\\ ILVALID_MSCORLIB=mscorlib.vlb $(ILVERIFY) c:\\devel\\fcom\\src\\bin\\msilxlib$(ilx2il_suffix).vlb  $(addprefix --other-il-module ,$(filter-out $<,$(HS_IL))) $<) 2>&1) | tee $@
diff --git a/ghc/compiler/ilxGen/tests/foo.hs b/ghc/compiler/ilxGen/tests/foo.hs
deleted file mode 100644
index d66608ba22..0000000000
--- a/ghc/compiler/ilxGen/tests/foo.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-{-# OPTIONS -fglasgow-exts  #-}
-module Foo where
-import PrelGHC
-import PrelNum
-import PrelBase
-integer2Intx :: Integer -> Int
-integer2Intx (S# i)   = I# i
-integer2Intx (J# s d) = case (integer2Int# s d) of { n# -> I# n# }
-
diff --git a/ghc/compiler/ilxGen/tests/life.hs b/ghc/compiler/ilxGen/tests/life.hs
deleted file mode 100644
index d6bcd16f9f..0000000000
--- a/ghc/compiler/ilxGen/tests/life.hs
+++ /dev/null
@@ -1,360 +0,0 @@
---------------------------------
---	The Game of Life      --
---------------------------------
-
-generations x = 30
-
-data L a = N | C1 a (L a)
-
-data Tuple2 a b = T2 a b
-
-data Tuple3 a b c = T3 a b c
-
-
-main = putStr (listChar_string
-                    (append1 (C1 '\FF' N)
-                             (life1 (generations ()) (start ()))))
-
-listChar_string :: L Char -> String
-listChar_string N = []
-listChar_string (C1 x xs) = x : listChar_string xs
-
-start :: a -> L (L Int)
-start x = (C1 N
-          (C1 N
-          (C1 N
-          (C1 N
-          (C1 N
-          (C1 N
-          (C1 N
-          (C1 N
-          (C1 N
-          (C1 N
-          (C1 N
-          (C1 N
-          (C1 N
-          (C1 N
-          (C1
-           (C1 0
-           (C1 0
-           (C1 0
-           (C1 1
-           (C1 1
-           (C1 1
-           (C1 1
-           (C1 1
-           (C1 0
-           (C1 1
-           (C1 1
-           (C1 1
-           (C1 1
-           (C1 1
-           (C1 0
-           (C1 1
-           (C1 1
-           (C1 1
-           (C1 1
-           (C1 1
-           (C1 0
-           (C1 1
-           (C1 1
-           (C1 1
-           (C1 1
-           (C1 1
-           (C1 0 N))))))))))))))))))))))))))) N)))))))))))))))
-
--- Calculating the next generation
-
-gen1 :: Int -> L (L Int) -> L (L Int)
-gen1 n board = map1 row1 (shift1 (copy1 n 0) board)
-
-row1 :: Tuple3 (L Int) (L Int) (L Int) -> L Int
-row1 (T3 last this next)
-  = zipWith31 elt1 (shift2 0 last) 
-                   (shift2 0 this) 
-                   (shift2 0 next)
-
-
-elt1 :: Tuple3 Int Int Int 
-        -> (Tuple3 Int Int Int) 
-        -> (Tuple3 Int Int Int) -> Int
-elt1 (T3 a b c) (T3 d e f) (T3 g h i) 
- = if (not (eq tot 2))
-          && (not (eq tot 3))
-      then 0
-      else if (eq tot 3) then 1 else e
-   where tot = a `plus` b `plus` c `plus` d 
-               `plus` f `plus` g `plus` h `plus` i
-
-eq :: Int -> Int -> Bool
-eq x y = x == y
-
-plus :: Int -> Int -> Int
-plus x y = x + y
-
-shiftr1 :: L Int -> L (L Int) -> L (L Int)
-shiftr1 x xs = append2 (C1 x N)  (init1 xs)
-
-shiftl1 :: L Int -> L (L Int) -> L (L Int)
-shiftl1 x xs = append2 (tail1 xs) (C1 x N)
-
-shift1 :: L Int -> L (L Int) 
-            -> L (Tuple3 (L Int) (L Int) (L Int))
-shift1 x xs = zip31 (shiftr1 x xs) xs (shiftl1 x xs)
-
-shiftr2 :: Int -> L Int -> L Int
-shiftr2 x xs = append3 (C1 x N) (init2 xs)
-
-shiftl2 :: Int -> L Int -> L Int
-shiftl2 x xs = append3 (tail2 xs) (C1 x N)
-
-shift2 :: Int -> L Int -> L (Tuple3 Int Int Int)
-shift2 x xs = zip32 (shiftr2 x xs) xs (shiftl2 x xs)
-
--- copy
-
-copy1 :: Int -> Int -> L Int
-copy1 0 x = N
-copy1 n x = C1 x (copy1 (n-1) x)
-
-copy2 :: Int -> L Int -> L (L Int)
-copy2 0 x = N
-copy2 n x = C1 x (copy2 (n-1) x)
-
-copy3 :: Int -> Char -> L Char
-copy3 0 x = N
-copy3 n x = C1 x (copy3 (n-1) x)
-
--- Displaying one generation
-
-disp1 :: (Tuple2 (L Char) (L (L Int))) -> L Char
-disp1 (T2 gen xss) 
- = append1 gen 
-    (append1 (C1 '\n' (C1 '\n' N)) 
-             (foldr_1 (glue1 (C1 '\n' N)) N
-                       (map4 (compose2 concat1 (map2 star1)) xss)))
-
-star1 :: Int -> L Char
-star1 i = case i of
-           0 -> C1 ' ' (C1 ' ' N)
-           1 -> C1 ' ' (C1 'o' N)
-
-glue1 :: L Char -> L Char -> L Char -> L Char 
-glue1 s xs ys = append1 xs (append1 s ys)
-
--- Generating and displaying a sequence of generations
-
-life1 :: Int -> L (L Int) -> L Char
-life1 n xss 
-  = foldr_1 (glue1 (copy3 (n+2) '\VT')) N
-            (map5 disp1
-              (zip1_ (map6 (string_ListChar.show) (ints 0))
-                    gens))
-    where
-    gens = take3 (740::Int) (iterate1 (gen1 n) (initial1 n xss))
-
-ints :: Int -> L Int
-ints x = C1 x (ints (x+1))
-
-string_ListChar :: String -> L Char
-string_ListChar [] = N
-string_ListChar (x:xs) = C1 x (string_ListChar xs)
-
-initial1 :: Int -> L (L Int) -> L (L Int)
-initial1 n xss = take1 n (append2 (map3 (compose1 (take2 n)
-                           (`append3` (copy1 n 0))) xss)
-                                (copy2 n (copy1 n 0)))
-
-iterate1 :: (L (L Int) -> L (L Int)) 
-               -> L (L Int) -> L (L (L Int))
-iterate1 f x = C1 x (iterate1 f (f x))
-
--- versions of built in functions
-
--- take
-take1 :: Int -> L (L Int) -> L (L Int)
-take1 0 _ = N
-take1 _ N = N
---should be:take1 (n+1) (C1 x xs) = C1 x (take1 n xs)
-take1 n (C1 x xs) | n < 0     = error "Main.take1"
-		  | otherwise = C1 x (take1 (n-1) xs)
-
-take2 :: Int -> L Int -> L Int
-take2 0 _ = N
-take2 _ N = N
---should be:take2 (n+1) (C1 x xs) = C1 x (take2 n xs)
-take2 n (C1 x xs) | n < 0     = error "Main.take2"
-		  | otherwise = C1 x (take2 (n-1) xs)
-
-take3 :: Int -> L (L (L Int))
-             -> L (L (L Int))
-take3 0 _ = N
-take3 _ N = N
-take3 n (C1 x xs) = C1 x (take3 (n-1) xs)
-
--- init
-
-init1 :: L (L Int) -> L (L Int)
-init1 (C1 x N) = N
-init1 (C1 x xs) = C1 x (init1 xs)
-init1 N = error "init1 got a bad list"
-
-init2 :: L Int -> L Int
-init2 (C1 x N) = N
-init2 (C1 x xs) = C1 x (init2 xs)
-init2 N = error "init1 got a bad list"
-
--- tail
-
-tail1 :: L (L Int) -> L (L Int)
-tail1 (C1 _ xs) = xs
-tail1 N = error "tail1 got a bad list"
-
-tail2 :: L Int -> L Int
-tail2 (C1 _ xs) = xs
-tail2 N = error "tail2 got a bad list"
-
--- maps
-
-map1 :: (Tuple3 (L Int) (L Int) (L Int) -> L Int) -> 
-                L (Tuple3 (L Int) (L Int) (L Int))
-             -> L (L Int)
-map1 f N = N
-map1 f (C1 x xs) = C1 (f x) (map1 f xs)
-
-map2 :: (Int -> L Char) -> L Int -> L (L Char)
-map2 f N = N
-map2 f (C1 x xs) = C1 (f x) (map2 f xs)
-
-map3 :: (L Int -> L Int) -> L (L Int) -> L (L Int)
-map3 f N = N
-map3 f (C1 x xs) = C1 (f x) (map3 f xs)
-
-map4 :: (L Int -> L Char)
-         -> L (L Int) -> L (L Char)
-map4 f N = N
-map4 f (C1 x xs) = C1 (f x) (map4 f xs)
-
-map5 :: (Tuple2 (L Char) (L (L Int)) -> L Char) 
-          -> L (Tuple2 (L Char) (L (L Int)))
-          -> L (L Char)
-map5 f N = N
-map5 f (C1 x xs) = C1 (f x) (map5 f xs)
-
-map6 :: (Int -> L Char) -> L Int -> L (L Char)
-map6 f N = N
-map6 f (C1 x xs) = C1 (f x) (map6 f xs)
-
--- compose
-
-compose2 :: (L (L Char) -> L Char) 
-            -> (L Int -> L (L Char)) 
-            -> L Int -> L Char
-compose2 f g xs = f (g xs)
-
-compose1 :: (L Int -> L Int) 
-             -> (L Int -> L Int) -> L Int -> L Int
-compose1 f g xs = f (g xs)
-
--- concat
-
-concat1 :: L (L Char) -> L Char
-concat1 = foldr_1 append1 N
-
--- foldr
-
-foldr_1 :: (L Char -> L Char -> L Char) 
-            -> L Char -> L (L Char) -> L Char
-foldr_1 f a N = a
-foldr_1 f a (C1 x xs) = f x (foldr_1 f a xs)
-
--- appends
-
-append1 :: L Char -> L Char -> L Char
-append1 N ys = ys
-append1 (C1 x xs) ys = C1 x (append1 xs ys)
-
-append2 :: L (L Int) -> L (L Int) -> L (L Int)
-append2 N ys = ys
-append2 (C1 x xs) ys = C1 x (append2 xs ys)
-
-append3 :: L Int -> L Int -> L Int
-append3 N ys = ys
-append3 (C1 x xs) ys = C1 x (append3 xs ys)
-
--- zips
-
-pzip f (C1 x1 xs) (C1 y1 ys)
- = C1 (f x1 y1) (pzip f xs ys)
-pzip f _ _ = N
-
-
-zip1_ :: L (L Char)
-         -> L (L (L Int))
-         -> L (Tuple2 (L Char) (L (L Int)))
-zip1_ = pzip T2
-
-zip2_ :: L (L Int)
-         -> L (L Int)
-         -> L (Tuple2 (L Int) (L Int))
-zip2_ = pzip T2 
-
-zip3d :: L Int -> (Tuple2 (L Int) (L Int)) 
-            -> (Tuple3 (L Int) (L Int) (L Int))
-zip3d x (T2 y z) = T3 x y z
-
-zip3_ :: L (L Int) 
-         -> L (Tuple2 (L Int) (L Int))
-         -> L (Tuple3 (L Int) (L Int) (L Int))
-zip3_ = pzip zip3d
-
-zip4_ :: L Int
-         -> L Int 
-         -> L (Tuple2 Int Int)
-zip4_ = pzip T2
-
-zip5d :: Int -> (Tuple2 Int Int) -> (Tuple3 Int Int Int)
-zip5d x (T2 y z) = T3 x y z
-
-zip5_ :: L Int 
-         -> L (Tuple2 Int Int)
-         -> L (Tuple3 Int Int Int)
-zip5_ = pzip zip5d
-
-zip6_ :: L (Tuple3 Int Int Int)
-         -> L (Tuple3 Int Int Int)
-         -> L (Tuple2 (Tuple3 Int Int Int)
-                      (Tuple3 Int Int Int))
-zip6_ = pzip T2
-
-zip31 :: L (L Int) -> L (L Int) 
-         -> L (L Int)  
-         -> L (Tuple3 (L Int) (L Int) (L Int))
-zip31 as bs cs
-  = zip3_ as (zip2_ bs cs)
-
-zip32 :: L Int -> L Int -> L Int 
-          -> L (Tuple3 Int Int Int)
-zip32 as bs cs
-  = zip5_ as (zip4_ bs cs)
-
--- zipWith
-
-zipWith21 :: ((Tuple3 Int Int Int) 
-              -> (Tuple2 (Tuple3 Int Int Int) 
-                         (Tuple3 Int Int Int)) -> Int)
-              -> L (Tuple3 Int Int Int) 
-              -> L (Tuple2 (Tuple3 Int Int Int) 
-                           (Tuple3 Int Int Int))
-              -> L Int
-zipWith21 = pzip 
-
-zipWith31 :: ((Tuple3 Int Int Int) 
-              -> (Tuple3 Int Int Int) 
-              -> (Tuple3 Int Int Int) -> Int)
-               -> L (Tuple3 Int Int Int)
-               -> L (Tuple3 Int Int Int)
-               -> L (Tuple3 Int Int Int) -> L Int
-zipWith31 z as bs cs
- = zipWith21 z' as (zip6_ bs cs)
-   where z' a (T2 b c) = z a b c
diff --git a/ghc/compiler/ilxGen/tests/reduce.ml b/ghc/compiler/ilxGen/tests/reduce.ml
deleted file mode 100644
index cad379b522..0000000000
--- a/ghc/compiler/ilxGen/tests/reduce.ml
+++ /dev/null
@@ -1,101 +0,0 @@
-
-
-type kind = 
-    ARROW of kind * kind
-  | TYP
-
-type tycon = 
-  | TyVar of int
-  | FUN
-  | LIST
-  | STRING
-
-type typ = 
-    TyForall of kind * typ
-  | TyApp of tycon * typ list
-
-type exp = 
-  | AbsTm of typ * exp
-  | Var of int
-  | App of exp * exp
-  | String of string
-  | AbsTy of kind * exp
-  | AppTy of exp * typ
-
-type ttyp =
-  | TTyFun of ttyp * ttyp
-  | TTyList of ttyp
-  | TTyString
-  | TTyAny
-  | TTyVar of int
-  | TTyForall of ttyp
-
-type texp =
-  | TAbsTm of  ttyp * texp
-  | TVar of int
-  | TApp of texp * texp
-  | TString of string
-  | TLetTy of texp * texp
-  | TCast of texp * ttyp
-
-  | TAppTy of texp * ttyp
-  | TAbsTy of texp
-
- 
-let (-->) x y = TyApp (FUN, [x;y])
-let (--->) x y = TTyFun (x,y)
-
-let rec trans_kind = function
-    ARROW (k1,k2) -> (trans_kind k1 ---> trans_kind k2)
-  | TYP -> (TTyForall TANY ---> TTyAny)
-
-let rec trans_typ_arg_aux = function
-    (* TyForall (k,ty) -> TAbsTm (trans_kind k, TAbsTy (trans_typ ty)) ??? *)
-  | TyApp (TyVar tv, args) -> failwith "unreduced"
-  | ty -> TAbsTm (trans_kind k, TAbsTy (trans_typ ty))failwith "unreduced"
-  | 
-let rec trans_typ_arg env = function
-  | TyApp (FUN, []) -> 
-      TAbsTm 
-	(trans_kind TYP, 
-	 TLetTy (TVar 0, 
-		 TAbsTm 
-		   (trans_kind TYP, 
-		    TLetTy (TVar 0, 
-			    TAbsTm 
-			      (TTyForall TANY, 
-			       TAppTy (TVar 0, TTyFun (TTyVar 0, TTyVar 1)))))))
-  | TyApp (TyVar tv, args) -> 
-      try List.assoc (tv,args) env 
-      with Not_found -> failwith "trans_typ: unreduced type variable"
-  | ty -> TAbsTm (TTyForall TANY, TAppTy (TVar 0, trans_typ env ty))
-(*
-  | TyApp (STRING, []) -> TAbsTm (TTyForall TANY, TAppTy (TVar 0, TTyString))
-  | TyApp (FUN, [l;r]) -> TAbsTm (TTyForall TANY, TAppTy (TVar 0, TTyFun (trans_typ l, trans_typ r)))
-*)
-
-
-let rec trans_typ env = function
-    TyForall (k,ty) -> (trans_kind k ---> TTyAny)
-  | TyApp (TyVar tv, args) -> 
-      try List.assoc (tv,args) env 
-      with Not_found -> failwith "trans_typ: unreduced type variable"
-  | TyApp (FUN, [l;r]) -> TTyFun (trans_typ env l, trans_typ env r)
-  | TyApp (STRING, []) -> TTyString
-  | _ -> failwith "trans_typ: badly formed input type"
-
-
-let rec trans_exp env = function
-  | AbsTm (ty,e) -> TAbsTm(trans_typ ty, trans_exp e)
-  | Var n -> TVar n
-  | App (l,r) -> TApp(trans_exp l, trans_exp r)
-  | String s -> TString s
-  | AbsTy (k,e) -> TAbsTm(trans_kind k, reduce env e)
-  | AppTy (tm,ty) -> TAppTy(trans_exp tm, trans_typ_arg env ty)
-
-
-open Format;;
-
-
-let rec pp_print_exp pps = function
-    L e -> fprintf pps "\
diff --git a/ghc/compiler/ilxGen/tests/test1-nostdlib.hs b/ghc/compiler/ilxGen/tests/test1-nostdlib.hs
deleted file mode 100644
index 1e9053ea41..0000000000
--- a/ghc/compiler/ilxGen/tests/test1-nostdlib.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-module Test1_nostdlib  where
-foreign import "ilxHello" unsafe ilxHello :: ()
-
-ilx_main_no_stdlib = ilxHello
diff --git a/ghc/compiler/ilxGen/tests/test1.hs b/ghc/compiler/ilxGen/tests/test1.hs
deleted file mode 100644
index 10f307e08e..0000000000
--- a/ghc/compiler/ilxGen/tests/test1.hs
+++ /dev/null
@@ -1 +0,0 @@
-main = putStr "HELLO HELLO Hello world WORLD WORLD.\n"
diff --git a/ghc/compiler/ilxGen/tests/test10.hs b/ghc/compiler/ilxGen/tests/test10.hs
deleted file mode 100644
index 46c384d9e0..0000000000
--- a/ghc/compiler/ilxGen/tests/test10.hs
+++ /dev/null
@@ -1,45 +0,0 @@
-
-data N = Z | S N
-
-choose1 n1 = 
-  case n1 of 
-       Z -> "even\n"
-       S Z -> "odd\n"
-       S (S m) -> choose1 m 
-choose2 n1 n2 = 
-  case n1 of 
-       Z -> choose1 n2
-       S Z -> "odd\n"
-       S (S m) -> choose2 m n2
-choose3 n1 n2 n3 = 
-  case n1 of 
-       Z -> choose2 n2 n3
-       S Z -> "odd\n"
-       S (S m) -> choose3 m n2 n3
-
-choose4 n1 n2 n3 n4  = 
-  case n1 of 
-       Z -> choose3 n2 n3 n4
-       S Z -> "odd\n"
-       S (S m) -> choose4 m n2 n3 n4 
-
-choose5 n1 n2 n3 n4 n5 = 
-  case n1 of 
-       Z -> choose4 n2 n3 n4 n5
-       S Z -> "odd\n"
-       S (S m) -> choose5 m n2 n3 n4 n5
-
-add n m = 
-   case n of
-       Z -> m  
-       S nn -> S (add nn m)
-
-n1 = S Z
-n2 = add n1 n1
-n4 = add n2 n2
-n6 = add n2 n4
-
-
-
-main = putStr (choose5 n6 n4 n2 n2 n1)
-
diff --git a/ghc/compiler/ilxGen/tests/test11.hs b/ghc/compiler/ilxGen/tests/test11.hs
deleted file mode 100644
index ce53f71389..0000000000
--- a/ghc/compiler/ilxGen/tests/test11.hs
+++ /dev/null
@@ -1,61 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
-
-import PrelGHC
-
-class  EEq a  where
-    (===), (/==)		:: a -> a -> Bool
-
---    x /= y		= not (x == y)
---    x == y		= not (x /= y)
---    x /= y		=  True
-    (/==) x y            = mynot  ((===) x y)
-    x === y		=  True
-
-data EOrdering = ELT | EEQ | EGT 
-
-mynot True = False
-mynot False = True
-
-{-
-class  (EEq a) => EOrd a  where
-    ecompare             :: a -> a -> EOrdering
-    (<<), (<<=), (>>>=), (>>>):: a -> a -> Bool
-    emax, emin		:: a -> a -> a
-
--- An instance of Ord should define either compare or <=
--- Using compare can be more efficient for complex types.
-    ecompare x y
-	    | x === y    = EEQ
-	    | x <<= y    = ELT	-- NB: must be '<=' not '<' to validate the
-				-- above claim about the minimal things that can
-				-- be defined for an instance of Ord
-	    | otherwise = EGT
-
-    x <<= y  = case ecompare x y of { EGT -> False; _other -> True }
-    x <<	 y  = case ecompare x y of { ELT -> True;  _other -> False }
-    x >>>= y  = case ecompare x y of { ELT -> False; _other -> True }
-    x >>>	 y  = case ecompare x y of { EGT -> True;  _other -> False }
-
-	-- These two default methods use '>' rather than compare
-	-- because the latter is often more expensive
-    emax x y = if x >>> y then x else y
-    emin x y = if x >>> y then y else x
--}
-
-data EInt = EI Int#
-
-ezeroInt, eoneInt, etwoInt, emaxInt, eminInt :: EInt
-ezeroInt = EI 0#
-eoneInt  = EI 1#
-etwoInt  = EI 2#
-eminInt  = EI (-2147483648#)	-- GHC <= 2.09 had this at -2147483647
-emaxInt  = EI 2147483647#
-eeqInt	(EI x) (EI y) = x ==# y
-eneInt	(EI x) (EI y) = x /=# y
-
-instance EEq EInt where
-    (===) x y = x `eeqInt` y
-    (/==) x y = x `eneInt` y
-
-main = putStr (if (ezeroInt === eoneInt) then "no!\n" else "yes!\n")
-
diff --git a/ghc/compiler/ilxGen/tests/test12.hs b/ghc/compiler/ilxGen/tests/test12.hs
deleted file mode 100644
index 216c792f32..0000000000
--- a/ghc/compiler/ilxGen/tests/test12.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-class  NewFunctor f  where
-    new_fmap         :: (a -> b) -> f a -> f b
-
-data N a = Z a | S (N a)
-
-nmap f (Z x) = Z (f x)
-nmap f (S n) = S (nmap f n)
-
-tag (Z x) = x
-tag (S n) = tag n
-
-instance NewFunctor N where
-    new_fmap = nmap
-
---class  Strange f  where
---    zero         :: a -> f a
---    suc         :: f a -> f a
---    tag         :: f a -> a
-
-
---class  FMonad m  where
---    (>>=)       :: m a -> (a -> m b) -> m b
---    (>>)        :: m a -> m b -> m b
---    return      :: a -> m a
---    fail	:: String -> m a
---
---    m >> k      =  m >>= \_ -> k
---    fail s      = error s
-
-
-
-
---instance Strange N
---  where
---   zero x = Z x
---   suc y = S y
---   tag n = gettag n
-
-twice :: NewFunctor f => (a -> a) -> f a -> f a
-twice f x = new_fmap f (new_fmap f x)
-
-main = putStr (tag (nmap (\x -> x) (Z "hello world\n")))
---main = putStr (tag (nmap (\x -> x) (Z "hello world\n")))
--- main = putStr (tag {- (twice (\x -> x) -}  (Z "hello world\n"))
diff --git a/ghc/compiler/ilxGen/tests/test13.hs b/ghc/compiler/ilxGen/tests/test13.hs
deleted file mode 100644
index 559c8674fa..0000000000
--- a/ghc/compiler/ilxGen/tests/test13.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-class  NewFunctor f  where
-    inj         :: a -> f a
-    surj         :: f a -> a
-
-data N a = Z a 
-
-ninj x = (Z x) 
-nsurj (Z x) = x
-
-instance NewFunctor N where
-    inj = ninj
-    surj = nsurj
-
-twice :: NewFunctor f => a -> f (f a)
-twice x = inj(inj x)
-
-undo :: NewFunctor f => f (f a) -> a
-undo x = surj(surj x)
-
-main = putStr (undo (Z (Z "hello world\n")))
diff --git a/ghc/compiler/ilxGen/tests/test14.hs b/ghc/compiler/ilxGen/tests/test14.hs
deleted file mode 100644
index 86b5d1c821..0000000000
--- a/ghc/compiler/ilxGen/tests/test14.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-class  EMonad m  where
-    aaaaa       :: m a -> (a -> m b) -> m b
-    bbbbb        :: m a -> m b -> m b
-
-    bbbbb m k      =  aaaaa m (\_ -> k)
-                  -- = \M \A \B -> \m:(M A) -> \k:(M B) -> aaaaa M A B m (\_:A -> k: M B)
-                  --   Free types must include "A"!!!
-
-main = putStr "hello world\n"
-
-
diff --git a/ghc/compiler/ilxGen/tests/test15.hs b/ghc/compiler/ilxGen/tests/test15.hs
deleted file mode 100644
index 3e522d757c..0000000000
--- a/ghc/compiler/ilxGen/tests/test15.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-
-{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
-
-
-import PrelBase
-import PrelList
-import PrelEnum
-import PrelShow
-import PrelIO
-
-
-bbuild 	:: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
-{-# INLINE 2 bbuild #-}
-bbuild g = g (:) []
-
-main = putStr "hello world\n"
-
-
diff --git a/ghc/compiler/ilxGen/tests/test16.hs b/ghc/compiler/ilxGen/tests/test16.hs
deleted file mode 100644
index 0e8b9974a9..0000000000
--- a/ghc/compiler/ilxGen/tests/test16.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-
-
-data MMaybe a = No | Yes a 
-
-main = putStr "hello world\n"
\ No newline at end of file
diff --git a/ghc/compiler/ilxGen/tests/test17.hs b/ghc/compiler/ilxGen/tests/test17.hs
deleted file mode 100644
index 5e551b2dcd..0000000000
--- a/ghc/compiler/ilxGen/tests/test17.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-{-# OPTIONS -fno-implicit-prelude #-}
-
-module Test17 where
-
-import PrelGHC
-import PrelBase
-
-data Exception = IOException IOError | OtherExc
-
-data IOError 
- = IOError 
-     String      
-
-tthrow :: Exception -> a
-
-tthrow exception = raise# exception
-ccatchException (IO m) k =  IO (\s -> catch# m (\ex -> unIO (k ex)) s)
-
-
-ccatch           :: IO a -> (IOError -> IO a) -> IO a 
-ccatch m k	=  ccatchException m handler
-  where handler (IOException err) = k err
-	handler other             = tthrow other
-
-ccatchNonIO      :: IO a -> (Exception -> IO a) -> IO a 
-ccatchNonIO m k	=  ccatchException m handler
-  where handler (IOException err) = ioError err
-	handler other             = k other
-
-newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
-
-unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
-unIO (IO a) = a
-
-ioError         :: IOError -> IO a 
-ioError err	=  IO (\s -> tthrow (IOException err) s)
-
-
-
-blockAsyncExceptions :: IO a -> IO a
-blockAsyncExceptions (IO io) = IO (blockAsyncExceptions# io)
-
-unblockAsyncExceptions :: IO a -> IO a
-unblockAsyncExceptions (IO io) = IO (unblockAsyncExceptions# io)
diff --git a/ghc/compiler/ilxGen/tests/test18.hs b/ghc/compiler/ilxGen/tests/test18.hs
deleted file mode 100644
index 12ca7413f1..0000000000
--- a/ghc/compiler/ilxGen/tests/test18.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-{-# OPTIONS -fno-implicit-prelude #-}
-
-module Test18 where
-
-import PrelGHC
-import PrelBase
-
-eftCharFB c n x y = go x
-		 where
-		    go x | x ># y    = n
-			 | otherwise = C# (chr# x) `c` go (x +# 1#)
-
-
-eftIntFB c n x y | x ># y    = n	
-		 | otherwise = go x
-		 where
-		   go x = I# x `c` if x ==# y then n else go (x +# 1#)
-
-eftIntList x y | x ># y    = []
-	       | otherwise = go x
-	       where
-		 go x = I# x : if x ==# y then [] else go (x +# 1#)
-
-
-efdCharFB c n x1 x2
-  | delta >=# 0# = go_up_char_fb c n x1 delta 255#
-  | otherwise    = go_dn_char_fb c n x1 delta 0#
-  where
-    delta = x2 -# x1
-
-efdCharList x1 x2
-  | delta >=# 0# = go_up_char_list x1 delta 255#
-  | otherwise    = go_dn_char_list x1 delta 0#
-  where
-    delta = x2 -# x1
-
-efdtCharFB c n x1 x2 lim
-  | delta >=# 0# = go_up_char_fb c n x1 delta lim
-  | otherwise    = go_dn_char_fb c n x1 delta lim
-  where
-    delta = x2 -# x1
-
-efdtCharList x1 x2 lim
-  | delta >=# 0# = go_up_char_list x1 delta lim
-  | otherwise    = go_dn_char_list x1 delta lim
-  where
-    delta = x2 -# x1
-
-go_up_char_fb c n x delta lim
-  = go_up x
-  where
-    go_up x | x ># lim  = n
-	    | otherwise	= C# (chr# x) `c` go_up (x +# delta)
-
-go_dn_char_fb c n x delta lim
-  = go_dn x
-  where
-    go_dn x | x <# lim  = n
-	    | otherwise	= C# (chr# x) `c` go_dn (x +# delta)
-
-go_up_char_list x delta lim
-  = go_up x
-  where
-    go_up x | x ># lim  = []
-	    | otherwise	= C# (chr# x) : go_up (x +# delta)
-
-
-go_dn_char_list x delta lim
-  = go_dn x
-  where
-    go_dn x | x <# lim  = []
-	    | otherwise	= C# (chr# x) : go_dn (x +# delta)
-
-efdtIntFB c n x1 x2 y
-  | delta >=# 0# = if x1 ># y then n else go_up_int_fb c n x1 delta lim
-  | otherwise    = if x1 <# y then n else go_dn_int_fb c n x1 delta lim 
-  where
-    delta = x2 -# x1
-    lim   = y -# delta
-
-efdtIntList x1 x2 y
-  | delta >=# 0# = if x1 ># y then [] else go_up_int_list x1 delta lim
-  | otherwise    = if x1 <# y then [] else go_dn_int_list x1 delta lim
-  where
-    delta = x2 -# x1
-    lim   = y -# delta
-
-efdIntFB c n x1 x2
-  | delta >=# 0# = go_up_int_fb c n x1 delta (  2147483647#  -# delta)
-  | otherwise    = go_dn_int_fb c n x1 delta ((-2147483648#) -# delta)
-  where
-    delta = x2 -# x1
-
-efdIntList x1 x2
-  | delta >=# 0# = go_up_int_list x1 delta (  2147483647#  -# delta)
-  | otherwise    = go_dn_int_list x1 delta ((-2147483648#) -# delta)
-  where
-    delta = x2 -# x1
-
--- In all of these, the (x +# delta) is guaranteed not to overflow
-
-go_up_int_fb c n x delta lim
-  = go_up x
-  where
-    go_up x | x ># lim  = I# x `c` n
-	    | otherwise = I# x `c` go_up (x +# delta)
-
-go_dn_int_fb c n x delta lim 
-  = go_dn x
-  where
-    go_dn x | x <# lim  = I# x `c` n
-	    | otherwise = I# x `c` go_dn (x +# delta)
-
-go_up_int_list x delta lim
-  = go_up x
-  where
-    go_up x | x ># lim  = [I# x]
-	    | otherwise = I# x : go_up (x +# delta)
-
-go_dn_int_list x delta lim 
-  = go_dn x
-  where
-    go_dn x | x <# lim  = [I# x]
-	    | otherwise = I# x : go_dn (x +# delta)
-eftInt 	= eftIntList
-efdInt 	= efdIntList
-efdtInt = efdtIntList
-
-
diff --git a/ghc/compiler/ilxGen/tests/test19.hs b/ghc/compiler/ilxGen/tests/test19.hs
deleted file mode 100644
index a292599031..0000000000
--- a/ghc/compiler/ilxGen/tests/test19.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-
-{-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
-
-
-module Test19 where
-
-import PrelST
-import PrelBase
-import PrelErr
-
-newtype IIO a = IIO (State# RealWorld -> (# State# RealWorld, a #))
-
-unIIO :: IIO a -> (State# RealWorld -> (# State# RealWorld, a #))
-unIIO (IIO a) = a
-
-instance  Functor IIO where
-   fmap f x = x >>= (return . f)
-
-instance  Monad IIO  where
-    {-# INLINE return #-}
-    {-# INLINE (>>)   #-}
-    {-# INLINE (>>=)  #-}
-    m >> k      =  m >>= \ _ -> k
-    return x	= returnIIO x
-
-    m >>= k     = bindIIO m k
-    fail s	= error s -- not ioError?
-
-
-bindIIO :: IIO a -> (a -> IIO b) -> IIO b
-bindIIO (IIO m) k = IIO ( \ s ->
-  case m s of 
-    (# new_s, a #) -> unIIO (k a) new_s
-  )
-
-returnIIO :: a -> IIO a
-returnIIO x = IIO (\ s -> (# s, x #))
diff --git a/ghc/compiler/ilxGen/tests/test1b.hs b/ghc/compiler/ilxGen/tests/test1b.hs
deleted file mode 100644
index c4b2336df1..0000000000
--- a/ghc/compiler/ilxGen/tests/test1b.hs
+++ /dev/null
@@ -1,104 +0,0 @@
--- To start:
--- source /bin/devghc
-
--- To compile GHC
--- make ilxGen/IlxGen.o hsc
-
--- To compile ILXASM
--- (cd /devel/fcom/src; make bin/ilxasm.exe) 
-
--- To compile to ILX
--- (cd ilxGen/tests; ../../../driver/ghc-inplace --ilx test.hs) 
-
-
-
--- To generate a complete ILX file, including preludes for GHC and ILX:
--- (cd ilxGen/tests/; cat prelude.ilx test.ilx  /devel/fcom/src/ilxasm/stdlib-func.ilx > test.full.ilx)
-
--- Run ILXASM to get a IL
--- ( cd ilxGen/tests/; /devel/fcom/src/bin/ilxasm.exe --no-ilasm --no-stdlib test.full.ilx > test.il)
-
--- To compile IL to .EXE or .DLL:
--- With build of VS (e.g. Don & Andrew)
---   ( cd ilxGen/tests/; cmd /C "c:\\bin\\devvs.bat && ilasm test.il") 
--- With Lightning SDK, where env. variables are on path (e.g. Reuben):
---   ( cd ilxGen/tests/; ilasm test.il) 
-
--- To validate .EXE:
--- (cd /devel/fcom/src; make  bin/ilvalid.exe mscorlib.vlb)
--- (export ILVALID_HOME=/devel/fcom/src; cd ilxGen/tests/; /devel/fcom/src/bin/ilvalid.exe test.il) 
-
--- To run unverifiable code:
--- With build of VS (e.g. Don & Andrew)
---    (cd ilxGen/tests/;  cmd /C "c:\\bin\\devvs.bat && .\test.exe")
--- With Lightning SDK, where env. variables are on path (e.g. Reuben):
---    (cd ilxGen/tests/; ./test.exe)
-
--- To compile ILX to verifiable code and verify
--- (cd /devel/fcom/src; make bin/ilxasm.exe bin/ilverify.exe)  && (cd ilxGen/tests/; export ILVALID_HOME=/devel/fcom/src; cat prelude.ilx  test.ilx /devel/fcom/src/assem/stdlib-func.ilx > test.full.ilx && cd ilxGen/tests/; /devel/fcom/src/bin/ilxasm.exe --no-ilasm test.full.ilx > test.safe.il && /devel/fcom/src/bin/ilverify.exe test.safe.il) 
-
--- (cd ilxGen/tests/;  cmd /C "c:\\bin\\devvs.bat && .\test.safe.exe")
-
---append:: [Char] -> [Char] -> [Char]
---append [] l2 = l2
---append (h:t) l2 = h:append t l2
-
-data N = Z | S N
-
-chooseN n  = 
-  case n of 
-       Z -> "even\n"
-       S Z -> "odd\n"
-       S (S m) -> chooseN m 
-
-signN n  = 
-  case n of 
-       Z -> Z
-       S Z -> S Z
-       S (S m) -> signN m 
-add n m = 
-   case n of
-       Z -> m  
-       S nn -> S (add nn m)
-
-mul n m = 
-   case n of
-       Z -> Z
-       S nn -> add m (mul nn m)
-
-pow n m = 
-   case m of
-       Z -> S Z
-       S mm -> mul n (pow n mm)
-
-sq n = mul n n
-
-n1 = S Z
-n2 = add n1 n1
-n4 = add n2 n2
-n6 = add n2 n4
-n8 = add n2 n6
-n10 = add n2 n8
-n11 = add n1 n10
-n12 = add n1 n11
-n13 = add n1 n12
-n14 = add n1 n13
-n15 = add n1 n14
-n16 = add n1 n15
-n17 = add n1 n16
-n18 = add n1 n17
-n19 = add n1 n18
-n20 = add n1 n18
-
-bign = pow n2 n19
-bign1 = add bign n1
-
-foldn f n acc = 
-   case n of
-    Z -> acc
-    S x -> foldn f x (f n acc)
-
-main = putStr (chooseN (foldn (\x y -> add (signN x) y)  (pow n2 n4)  n1))
-
-
-
diff --git a/ghc/compiler/ilxGen/tests/test2.hs b/ghc/compiler/ilxGen/tests/test2.hs
deleted file mode 100644
index 8b1f5b5eb6..0000000000
--- a/ghc/compiler/ilxGen/tests/test2.hs
+++ /dev/null
@@ -1,88 +0,0 @@
--- To start:
--- source /bin/devghc
-
--- To compile GHC
--- make ilxGen/IlxGen.o hsc
-
--- To compile ILXASM
--- (cd /devel/fcom/src; make bin/ilxasm.exe) 
-
--- To compile to ILX
--- (cd ilxGen/tests; ../../../driver/ghc-inplace --ilx test.hs) 
-
-
-
--- To generate a complete ILX file, including preludes for GHC and ILX:
--- (cd ilxGen/tests/; cat prelude.ilx test.ilx  /devel/fcom/src/ilxasm/stdlib-func.ilx > test.full.ilx)
-
--- Run ILXASM to get a IL
--- ( cd ilxGen/tests/; /devel/fcom/src/bin/ilxasm.exe --no-ilasm --no-stdlib test.full.ilx > test.il)
-
--- To compile IL to .EXE or .DLL:
--- With build of VS (e.g. Don & Andrew)
---   ( cd ilxGen/tests/; cmd /C "c:\\bin\\devvs.bat && ilasm test.il") 
--- With Lightning SDK, where env. variables are on path (e.g. Reuben):
---   ( cd ilxGen/tests/; ilasm test.il) 
-
--- To validate .EXE:
--- (cd /devel/fcom/src; make  bin/ilvalid.exe mscorlib.vlb)
--- (export ILVALID_HOME=/devel/fcom/src; cd ilxGen/tests/; /devel/fcom/src/bin/ilvalid.exe test.il) 
-
--- To run unverifiable code:
--- With build of VS (e.g. Don & Andrew)
---    (cd ilxGen/tests/;  cmd /C "c:\\bin\\devvs.bat && .\test.exe")
--- With Lightning SDK, where env. variables are on path (e.g. Reuben):
---    (cd ilxGen/tests/; ./test.exe)
-
--- To compile ILX to verifiable code and verify
--- (cd /devel/fcom/src; make bin/ilxasm.exe bin/ilverify.exe)  && (cd ilxGen/tests/; export ILVALID_HOME=/devel/fcom/src; cat prelude.ilx  test.ilx /devel/fcom/src/assem/stdlib-func.ilx > test.full.ilx && cd ilxGen/tests/; /devel/fcom/src/bin/ilxasm.exe --no-ilasm test.full.ilx > test.safe.il && /devel/fcom/src/bin/ilverify.exe test.safe.il) 
-
--- (cd ilxGen/tests/;  cmd /C "c:\\bin\\devvs.bat && .\test.safe.exe")
-
---append:: [Char] -> [Char] -> [Char]
---append [] l2 = l2
---append (h:t) l2 = h:append t l2
-
-data N = Z | S N
-
-chooseN n  = 
-  case n of 
-       Z -> "even\n"
-       S Z -> "odd\n"
-       S (S m) -> chooseN m 
-
-add n m = 
-   case n of
-       Z -> m  
-       S nn -> S (add nn m)
-
-mul n m = 
-   case n of
-       Z -> Z
-       S nn -> add m (mul nn m)
-
-pow n m = 
-   case m of
-       Z -> S Z
-       S mm -> mul n (pow n mm)
-
-sq n = mul n n
-
-n1 = S Z
-n2 = add n1 n1
-n4 = add n2 n2
-n6 = add n2 n4
-n8 = add n2 n6
-n10 = add n2 n8
-n16 = add n6 n10
-n17 = add n1 n16
-n18 = add n8 n10
-n19 = add n1 n18
-n20 = add n4 n16
-
-bign = pow n2 n10
-bign1 = add bign n1
-
-main = putStr (chooseN bign1)
-
-
diff --git a/ghc/compiler/ilxGen/tests/test20.hs b/ghc/compiler/ilxGen/tests/test20.hs
deleted file mode 100644
index 157a16da1d..0000000000
--- a/ghc/compiler/ilxGen/tests/test20.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-
-data N = Z | S N
-
-res Z x y = (# x, y #)
-res (S n) x y = res n x y
-
-(# x, y #) = res (S Z) "no!" "hello world\n"
-
-main = putStr y
diff --git a/ghc/compiler/ilxGen/tests/test21.hs b/ghc/compiler/ilxGen/tests/test21.hs
deleted file mode 100644
index 1870f22b97..0000000000
--- a/ghc/compiler/ilxGen/tests/test21.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-{-# OPTIONS -fno-implicit-prelude  #-}
-
-import PrelIOBase
-import PrelIO
-import PrelBase
-import PrelAddr
-
-foreign import "libHS_cbits" "getErrStr__"  unsafe ggetErrStr__  :: Int -> IO Addr 
-
-main = putStr (uunsafePerformIO (ggetErrStr__ 4))
-
-uunsafePerformIO	:: IO Addr -> [Char]
-uunsafePerformIO (IO m) = case m realWorld# of (# _, (A# r) #)   -> (unpackCString#  r)
diff --git a/ghc/compiler/ilxGen/tests/test2b.hs b/ghc/compiler/ilxGen/tests/test2b.hs
deleted file mode 100644
index 08a391f799..0000000000
--- a/ghc/compiler/ilxGen/tests/test2b.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-foreign import "ilxHello" unsafe ilxHello :: IO ()
-main = ilxHello
diff --git a/ghc/compiler/ilxGen/tests/test2c.hs b/ghc/compiler/ilxGen/tests/test2c.hs
deleted file mode 100644
index d01df051f8..0000000000
--- a/ghc/compiler/ilxGen/tests/test2c.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-import PrelIOBase
-
-
-bindIO2 :: IO () -> IO () -> IO ()
-bindIO2 m (IO k) = IO ( \ s -> k s )
-
-foreign import "ilxHello" unsafe ilxHello :: IO ()
-
-data N = S N | Z
-
-f Z = bindIO2 
-f (S x) = f x
-
-main = f(S Z) ilxHello ilxHello
diff --git a/ghc/compiler/ilxGen/tests/test2d.hs b/ghc/compiler/ilxGen/tests/test2d.hs
deleted file mode 100644
index 8126127a32..0000000000
--- a/ghc/compiler/ilxGen/tests/test2d.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-foreign import ccall "libHS_cbits.so" "get_prog_argc" unsafe primArgc :: Int
-
-foreign import "ilxHello" unsafe ilxHello :: IO ()
-foreign import "ilxBad" unsafe ilxBad :: IO ()
-
-
-main = if (primArgc == 0) then ilxHello else ilxBad
diff --git a/ghc/compiler/ilxGen/tests/test3.hs b/ghc/compiler/ilxGen/tests/test3.hs
deleted file mode 100644
index 0254ee41c4..0000000000
--- a/ghc/compiler/ilxGen/tests/test3.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-foreign import "ilxHello" unsafe ilxHello :: IO ()
-foreign import "ilxBad" unsafe ilxBad :: IO ()
-
-class  Eqq a  where
-    eqq		:: a -> Bool
-    eqq2	:: a -> Bool
-
---    x /= y		= not (x == y)
---    x == y		= not (x /= y)
---    x /= y		=  True
-    eqq x		=  False
-    eqq2 x		=  True
-
-
-data  Unit  =  Unit
-
-instance Eqq Unit 
---  where
---    eqq Unit = True
---    eqq2 Unit = False
-
-choose x = if eqq x then ilxHello else if eqq2 x then ilxBad else ilxBad
-
-main = choose Unit
diff --git a/ghc/compiler/ilxGen/tests/test4.hs b/ghc/compiler/ilxGen/tests/test4.hs
deleted file mode 100644
index 080c6521e3..0000000000
--- a/ghc/compiler/ilxGen/tests/test4.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-class  Eqq a  where
-    evenN :: a -> Bool
-    oddN	:: a -> Bool
-    evenN x		=  False
-    oddN x		=  True
-
-
-data N = Z | S N
-
-instance Eqq N 
-  where
-   evenN Z = True
-   evenN (S x) = oddN x
-   oddN Z = False
-   oddN (S x) = evenN x
-
-choose x = if evenN x then "hello world (evenN)\n" else if oddN x then "hello world (oddN)\n" else "no!\n"
-
-add n m = 
-   case n of
-       Z -> m  
-       S nn -> S (add nn m)
-
-mul n m = 
-   case n of
-       Z -> Z
-       S nn -> add m (mul nn m)
-
-pow n m = 
-   case m of
-       Z -> S Z
-       S mm -> mul n (pow n mm)
-
-n1 = S Z
-n2 = add n1 n1
-n4 = add n2 n2
-n6 = add n2 n4
-n8 = add n2 n6
-n10 = add n2 n8
-n16 = add n6 n10
-n18 = add n8 n10
-n20 = add n4 n16
-
-bign = pow n2 n16
-bign1 = add bign n1
-
-main = putStr (choose bign1)
diff --git a/ghc/compiler/ilxGen/tests/test5.hs b/ghc/compiler/ilxGen/tests/test5.hs
deleted file mode 100644
index 13d6028c02..0000000000
--- a/ghc/compiler/ilxGen/tests/test5.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-data One a = One a
-
-choose (One x) = x
-main = putStr (choose (One "hello world\n"))
-
diff --git a/ghc/compiler/ilxGen/tests/test6.hs b/ghc/compiler/ilxGen/tests/test6.hs
deleted file mode 100644
index 17e51ab51d..0000000000
--- a/ghc/compiler/ilxGen/tests/test6.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-data List a = Cons a (List a)
-
-hdL (Cons x y) = x
-tlL (Cons x y) = y
-
-test = Cons "hello world\n" test
-main = putStr (hdL (tlL test))
-
diff --git a/ghc/compiler/ilxGen/tests/test7.hs b/ghc/compiler/ilxGen/tests/test7.hs
deleted file mode 100644
index c146038052..0000000000
--- a/ghc/compiler/ilxGen/tests/test7.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-data List a = Cons a (List a)
-
-hdL (Cons x y) = x
-tlL (Cons x y) = y
-
-mk f x = f x (mk f x)
-main = putStr (hdL (tlL (mk Cons "hello world!\n")))
-
diff --git a/ghc/compiler/ilxGen/tests/test8.hs b/ghc/compiler/ilxGen/tests/test8.hs
deleted file mode 100644
index 94a7e1f83d..0000000000
--- a/ghc/compiler/ilxGen/tests/test8.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-data Inf a = A (Inf a)
-
-hd (A x) = x
-
-choose (A (A x)) =  "hello world\n"
-mk f = f (mk f)
-main = putStr (choose (hd (mk A)))
-
diff --git a/ghc/compiler/ilxGen/tests/test9.hs b/ghc/compiler/ilxGen/tests/test9.hs
deleted file mode 100644
index 311b65c4e1..0000000000
--- a/ghc/compiler/ilxGen/tests/test9.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-data Tree a = Node (Tree a) (Tree a)
-
-left (Node x y) = x
-right (Node x y) = y
-
-choose (Node (Node _ _) (Node _ _)) = "hello world!\n"
-
-mk f = f (mk f) (mk f)
-main = putStr (choose (mk Node))
-
diff --git a/ghc/compiler/ilxGen/tests/yes.hs b/ghc/compiler/ilxGen/tests/yes.hs
deleted file mode 100644
index 1dc4f085fd..0000000000
--- a/ghc/compiler/ilxGen/tests/yes.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-
-foreign import "ilxHello" unsafe ilxHello :: IO ()
-
-main :: IO ()
-main = ilxHello >> main
\ No newline at end of file
diff --git a/ghc/compiler/ilxGen/tests/yes2.hs b/ghc/compiler/ilxGen/tests/yes2.hs
deleted file mode 100644
index 7fa20c5b7d..0000000000
--- a/ghc/compiler/ilxGen/tests/yes2.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-
-import PrelIOBase
-foreign import "ilxHello" unsafe ilxHello :: IO ()
-
-
-
-seqIO :: IO () -> IO () -> IO ()
-seqIO (IO m) (IO k) = IO ( \ s ->
-  case m s of 
-    (# new_s, a #) -> k new_s
-  )
-
-
-yes () = seqIO ilxHello (yes ())
-
-main :: IO ()
-main = yes ()
-
diff --git a/ghc/compiler/javaGen/Java.lhs b/ghc/compiler/javaGen/Java.lhs
deleted file mode 100644
index 368be03fc1..0000000000
--- a/ghc/compiler/javaGen/Java.lhs
+++ /dev/null
@@ -1,169 +0,0 @@
-Anbstract syntax for Java subset that is the target of Mondrian.
-The syntax has been taken from "The Java Language Specification".
-
-(c) Erik Meijer & Arjan van IJzendoorn
-
-November 1999
-
-Major reworking to be usable for the intermeduate (GOO) language
-for the backend of GHC and to target languauges like Java sucessfully.
--- Andy Gill
-
-\begin{code}
-module Java where
-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Java type declararations}
-%*									*
-%************************************************************************
-
-\begin{code}
-data CompilationUnit
-  = Package PackageName [Decl]
-    deriving (Show)
-    
-data Decl
- = Import PackageName
- | Field [Modifier] Name (Maybe Expr)
- | Constructor [Modifier] TypeName [Parameter] [Statement]
- | Method [Modifier] Name [Parameter] [Exception] [Statement]
- | Comment [String]
- | Interface [Modifier] TypeName [TypeName] [Decl]
- | Class [Modifier] TypeName [TypeName] [TypeName] [Decl]
-   deriving (Show)
-
-data Parameter
- = Parameter [Modifier] Name
-   deriving (Show)
-   
-data Statement
-  = Skip
-  | Return Expr		-- This always comes last in a list
-			-- of statements, and it is understood
-			-- you might change this to something
-			-- else (like a variable assignment)
-			-- if this is not top level statements.
-  | Block [Statement]
-  | ExprStatement Expr	-- You are never interested in the result
-			-- of an ExprStatement
-  | Declaration Decl -- variable = inner Field, Class = innerclass
-  | IfThenElse [(Expr,Statement)] (Maybe Statement)
-  | Switch Expr [(Expr, [Statement])] (Maybe [Statement])
-    deriving (Show)
-
-data Expr 
-  = Var Name
-  | Literal Lit
-  | Cast Type Expr
-  | Access Expr Name
-  | Assign Expr Expr
-  | InstanceOf Expr Type
-  | Call Expr Name [Expr]
-  | Op Expr String Expr
-  | Raise TypeName [Expr]
-  | New Type [Expr] (Maybe [Decl]) -- anonymous innerclass
-    deriving (Show)
-    
-data Modifier 
-  = Public | Protected | Private
-  | Static
-  | Abstract | Final | Native | Synchronized | Transient | Volatile
-  deriving (Show, Eq, Ord)
-
--- A type is used to refer in general to the shape of things,
--- or a specific class. Never use a name to refer to a class,
--- always use a type.
-
-data Type 
-  = PrimType  PrimType
-  | ArrayType Type
-  | Type      TypeName
-    deriving (Show, Eq)
-
-data PrimType 
-  = PrimInt 
-  | PrimBoolean
-  | PrimChar
-  | PrimLong
-  | PrimFloat
-  | PrimDouble
-  | PrimByte
-  | PrimVoid
-    deriving (Show, Eq)
-
-type PackageName = String	-- A package name
-				-- like "java.awt.Button"
-
-type Exception   = TypeName	-- A class name that must be an exception.
-
-type TypeName    = String	-- a fully qualified type name
-				-- like "java.lang.Object".
-				-- has type "Type <the name>"
-
-data Name        = Name String Type
-	deriving Show		-- A class name or method etc, 
-				-- at defintion time,
-				-- this generally not a qualified name.
-
-				-- The type is shape of the box require
-				-- to store an access to this thing.
-				-- So variables might be Int or Object.
-
-				--  ** method calls store the returned
-				--  ** type, not a complete arg x result type.
-				--
-				-- Thinking:
-				-- ... foo1.foo2(...).foo3 ...
-				-- here you want to know the *result*
-				-- after calling foo1, then foo2,
-				-- then foo3.
-
-instance Eq Name where
-   (Name nm _) == (Name nm' _) = nm == nm'
-
-
-instance Ord Name where
-   (Name nm _) `compare` (Name nm' _) = nm `compare` nm'
-
-
-data Lit
-  = IntLit Integer	-- unboxed
-  | CharLit Int 	-- unboxed
-  | StringLit String	-- java string
-  deriving Show
-
-addModifier :: Modifier -> Decl -> Decl
-addModifier = \m -> \d ->
- case d of
-   { Import n -> Import n
-   ; Field ms n e -> Field (m:ms) n e  
-   ; Constructor ms n as ss -> Constructor (m:ms) n as ss
-   ; Method ms n as ts ss -> Method (m:ms) n as ts ss
-   ; Comment ss -> Comment ss
-   ; Interface ms n xs ds -> Interface (m:ms) n xs ds
-   ; Class ms n xs is ds -> Class (m:ms) n xs is ds
-   }
-
-changeNameType :: Type -> Name -> Name
-changeNameType ty (Name n _) = Name n ty
-   
-areSimple :: [Expr] -> Bool
-areSimple = \es -> all isSimple es
-
-isSimple :: Expr -> Bool
-isSimple = \e ->
-  case e of
-   { Cast t e -> isSimple e
-   ; Access e n -> isSimple e
-   ; Assign l r -> isSimple l && isSimple r
-   ; InstanceOf e t -> isSimple e
-   ; Call e n es -> isSimple e && areSimple es
-   ; Op e1 o e2 -> False
-   ; New n es Nothing -> areSimple es
-   ; New n es (Just ds) -> False
-   ; otherwise -> True
-   }
-\end{code}
diff --git a/ghc/compiler/javaGen/JavaGen.lhs b/ghc/compiler/javaGen/JavaGen.lhs
deleted file mode 100644
index a3925b18e8..0000000000
--- a/ghc/compiler/javaGen/JavaGen.lhs
+++ /dev/null
@@ -1,1166 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-2000
-%
-\section{Generate Java}
-
-Name mangling for Java.
-~~~~~~~~~~~~~~~~~~~~~~
-
-Haskell has a number of namespaces. The Java translator uses
-the standard Haskell mangles (see OccName.lhs), and some extra
-mangles.
-
-All names are hidden inside packages.
-
-module name:
-  - becomes a first level java package.
-  - can not clash with java, because haskell modules are upper case,
-     java default packages are lower case.
-
-function names: 
-  - these turn into classes
-  - java keywords (eg. private) have the suffix "zdk" ($k) added.
-
-data *types*
-  - These have a base class, so need to appear in the 
-    same name space as other object. for example data Foo = Foo
-  - We add a postfix to types: "zdc" ($c)
-  - Types are upper case, so never clash with keywords
-
-data constructors
-  - There are tWO classes for each Constructor
-   (1) - Class with the payload extends the relevent datatype baseclass.
-       - This class has the prefix zdw ($w)
-   (2) - Constructor *wrapper* just use their own name.
-    - Constructors are upper case, so never clash with keywords
-    - So Foo would become 2 classes.
-	* Foo		-- the constructor wrapper
-	* zdwFoo	-- the worker, with the payload
-
-
-$i  for instances.
-$k  for keyword nameclash avoidance.
-
-\begin{code}
-module JavaGen( javaGen ) where
-
-import Java
-
-import Literal	( Literal(..) )
-import Id	( Id, isDataConWorkId_maybe, isId, idName, isDeadBinder, idPrimRep
-		, isPrimOpId_maybe )
-import Name	( NamedThing(..), getOccString, isExternalName, isInternalName
-		, nameModule )
-import PrimRep  ( PrimRep(..) )
-import DataCon	( DataCon, dataConRepArity, dataConRepArgTys, dataConWorkId )
-import qualified Type
-import qualified CoreSyn
-import CoreSyn	( CoreBind, CoreExpr, CoreAlt, CoreBndr,
-		  Bind(..), AltCon(..), collectBinders, isValArg
-		)
-import TysWiredIn	( boolTy, trueDataCon, falseDataCon )
-import qualified CoreUtils
-import Module	( Module, moduleString )
-import TyCon	( TyCon, isDataTyCon, tyConDataCons )
-import Outputable
-
-import Maybe
-import PrimOp
-import Util     ( lengthIs, notNull )
-
-#include "HsVersions.h"
-
-\end{code}
-
-
-\begin{code}
-javaGen :: Module -> [Module] -> [TyCon] -> [CoreBind] -> CompilationUnit
-
-javaGen mod import_mods tycons binds
-  = liftCompilationUnit package
-  where
-    decls = [Import "haskell.runtime.*"] ++
-	    [Import (moduleString mod) | mod <- import_mods] ++
-	    concat (map javaTyCon (filter isDataTyCon tycons)) ++ 
-	    concat (map javaTopBind binds)
-    package = Package (moduleString mod) decls
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Type declarations}
-%*									*
-%************************************************************************
-
-\begin{code}
-javaTyCon :: TyCon -> [Decl]
---  	public class List {}
---
---	public class $wCons extends List {
---		Object f1; Object f2
---	}
---	public class $wNil extends List {}
-
-javaTyCon tycon 
-  = tycon_jclass : concat (map constr_class constrs)
-  where
-    constrs = tyConDataCons tycon
-    tycon_jclass_jname =  javaTyConTypeName tycon ++ "zdc"
-    tycon_jclass = Class [Public] (shortName tycon_jclass_jname) [] [] []
-
-    constr_class data_con
-	= [ Class [Public] constr_jname [tycon_jclass_jname] []
-				(field_decls ++ [cons_meth,debug_meth])
-	  ]
-	where
-	  constr_jname = shortName (javaConstrWkrName data_con)
-
-	  field_names  = constrToFields data_con
-	  field_decls  = [ Field [Public] n Nothing 
-			 | n <- field_names
-			 ]
-
-	  cons_meth    = mkCons constr_jname field_names
-
-	  debug_meth   = Method [Public] (Name "toString" stringType)
-					 []
-					 []
-		       (  [ Declaration (Field [] txt Nothing) ]
-		       ++ [ ExprStatement
-				(Assign (Var txt)
-					    (mkStr
-						("( " ++ 
-						  getOccString data_con ++ 
-						  " ")
-				       	     )
-				)
-			  ]
-		       ++ [ ExprStatement
-				(Assign (Var txt)
-				   (Op (Var txt)
-				        "+" 
-				       (Op (Var n) "+" litSp)
-				   )
-				)
-			  | n <- field_names
-			  ]
-		       ++ [ Return (Op (Var txt)
-				        "+" 
-				      (mkStr ")")
-				   )
-			  ]
-		       )
-
-	  litSp    = mkStr " "
-	  txt      = Name "__txt" stringType
-	 
-
--- This checks to see the type is reasonable to call new with.
--- primitives might use a static method later.
-mkNew :: Type -> [Expr] -> Expr
-mkNew t@(PrimType primType) _  = error "new primitive -- fix it???"
-mkNew t@(Type _)            es = New t es Nothing
-mkNew _                     _  = error "new with strange arguments"
-
-constrToFields :: DataCon -> [Name]
-constrToFields cons = 
-	[ fieldName i t 
-	| (i,t) <- zip [1..] (map primRepToType
-			          (map Type.typePrimRep
-				       (dataConRepArgTys cons)
-				  )
-			     )
-	]
-
-mkCons :: TypeName -> [Name] -> Decl
-mkCons name args = Constructor [Public] name
-	[ Parameter [] n | n <- args ]
-	[ ExprStatement (Assign 
-			   (Access this n)
-			   (Var n)
-			 )
-		    | n <- args ]
-
-mkStr :: String -> Expr
-mkStr str = Literal (StringLit str)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Bindings}
-%*									*
-%************************************************************************
-
-\begin{code}
-javaTopBind :: CoreBind -> [Decl]
-javaTopBind (NonRec bndr rhs) = [java_top_bind bndr rhs]
-javaTopBind (Rec prs) 	      = [java_top_bind bndr rhs | (bndr,rhs) <- prs]
-
-java_top_bind :: Id -> CoreExpr -> Decl
--- 	public class f implements Code {
---	  public Object ENTER() { ...translation of rhs... }
---	}
-java_top_bind bndr rhs
-  = Class [Public] (shortName (javaIdTypeName bndr))
-		[] [codeName] [enter_meth]
-  where
-    enter_meth = Method [Public]
-			enterName
-			[vmArg]
-			[excName]
-			(javaExpr vmRETURN rhs)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Expressions}
-%*									*
-%************************************************************************
-
-\begin{code}
-javaVar :: Id -> Expr
-javaVar v | isExternalName (idName v) = mkNew (javaIdType v) []
-	  | otherwise	  	    =   Var (javaName v)
-
-javaLit :: Literal.Literal -> Expr
-javaLit (MachInt i)  = Literal (IntLit (fromInteger i))
-javaLit (MachChar c) = Literal (CharLit c)
-javaLit (MachStr fs) = Literal (StringLit str)
-   where
-	str = concatMap renderString (unpackFS fs) ++ "\\000"
-	-- This should really handle all the chars 0..31.
-	renderString '\NUL' = "\\000"
-	renderString other  = [other]
-
-javaLit other	     = pprPanic "javaLit" (ppr other)
-
--- Pass in the 'shape' of the result.
-javaExpr :: (Expr -> Statement) -> CoreExpr -> [Statement]
--- Generate code to apply the value of 
--- the expression to the arguments aleady on the stack
-javaExpr r (CoreSyn.Var v)   = [r (javaVar v)]
-javaExpr r (CoreSyn.Lit l)   = [r (javaLit l)]
-javaExpr r (CoreSyn.App f a) = javaApp r f [a]
-javaExpr r e@(CoreSyn.Lam _ _) = javaLam r (collectBinders e)
-javaExpr r (CoreSyn.Case e x alts) = javaCase r e x alts
-javaExpr r (CoreSyn.Let bind body) = javaBind bind ++ javaExpr r body
-javaExpr r (CoreSyn.Note _ e)	 = javaExpr r e
-
-javaCase :: (Expr -> Statement) -> CoreExpr -> Id -> [CoreAlt] -> [Statement]
--- 	case e of x { Nil      -> r1
---		      Cons p q -> r2 }
--- ==>
---	final Object x = VM.WHNF(...code for e...)
---	else if x instance_of Nil {
---		...translation of r1...
---	} else if x instance_of Cons {
---		final Object p = ((Cons) x).f1
---		final Object q = ((Cons) x).f2
---		...translation of r2...
---	} else throw java.lang.Exception
-
--- This first special case happens a lot, typically
--- during dictionary deconstruction.
--- We need to access at least *one* field, to check to see
--- if we have correct constructor.
--- If we've got the wrong one, this is _|_, and the
--- casting will catch this with an exception.
-
-javaCase r e x [(DataAlt d,bs,rhs)] | notNull bs
-  = java_expr PushExpr e ++
-    [ var [Final] (javaName x)
-	          (whnf primRep (vmPOP (primRepToType primRep))) ] ++
-    bind_args d bs ++
-    javaExpr r rhs
-   where      
-     primRep = idPrimRep x
-     whnf PtrRep = vmWHNF	-- needs evaluation
-     whnf _      = id		-- anything else does notg
-
-     bind_args d bs = [var [Final] (javaName b) 
-			   (Access (Cast (javaConstrWkrType d) (javaVar x)
-				   ) f
-			   )
-		      | (b,f) <- filter isId bs `zip` (constrToFields d)
-		      , not (isDeadBinder b)
-		      ]
-   
-javaCase r e x alts
-  | isIfThenElse && isPrimCmp
-  = javaIfThenElse r (fromJust maybePrim) tExpr fExpr
-  | otherwise
-  = java_expr PushExpr e ++
-       [ var [Final] (javaName x)
-		           (whnf primRep (vmPOP (primRepToType primRep)))
-       , IfThenElse (map mk_alt con_alts) (Just default_code)
-       ]
-  where
-     isIfThenElse = CoreUtils.exprType e `Type.eqType` boolTy
-		    -- also need to check that x is not free in
-		    -- any of the branches.
-     maybePrim    = findCmpPrim e []
-     isPrimCmp    = isJust maybePrim
-     (_,_,tExpr)  = CoreUtils.findAlt (DataAlt trueDataCon) alts 
-     (_,_,fExpr)  = CoreUtils.findAlt (DataAlt falseDataCon) alts 
-
-     primRep = idPrimRep x
-     whnf PtrRep = vmWHNF	-- needs evaluation
-     whnf _      = id
-
-     (con_alts, maybe_default) = CoreUtils.findDefault alts
-     default_code = case maybe_default of
-			Nothing  -> ExprStatement (Raise excName [Literal (StringLit "case failure")])
-			Just rhs -> Block (javaExpr r rhs)
-
-     mk_alt (DataAlt d,  bs, rhs) = (instanceOf x d, Block (bind_args d bs ++ javaExpr r rhs))
-     mk_alt (LitAlt lit, bs, rhs) = (eqLit lit     , Block (javaExpr r rhs))
-
-
-     eqLit (MachInt n) = Op (Literal (IntLit n))
-
-			    "=="
-			    (Var (javaName x))
-     eqLit (MachChar n) = Op (Literal (CharLit n))
-			    "=="
-			    (Var (javaName x))
-     eqLit other       = pprPanic "eqLit" (ppr other)
-
-     bind_args d bs = [var [Final] (javaName b) 
-			   (Access (Cast (javaConstrWkrType d) (javaVar x)
-				   ) f
-			   )
-		      | (b,f) <- filter isId bs `zip` (constrToFields d)
-		      , not (isDeadBinder b)
-		      ]
-
-javaIfThenElse r cmp tExpr fExpr 
-{-
- - Now what we need to do is generate code for the if/then/else.
- - [all arguments are already check for simpleness (Var or Lit).]
- - 
- - if (<prim> arg1 arg2 arg3 ...) {
- -	trueCode
- -  } else {
- -	falseCode
- - }
- -}
- = [IfThenElse [(cmp,j_tExpr)] (Just j_fExpr)]
- where
-   j_tExpr, j_fExpr :: Statement
-   j_tExpr = Block (javaExpr r tExpr)
-   j_fExpr = Block (javaExpr r fExpr)
-
-javaBind (NonRec x rhs)
-{-
-	x = ...rhs_x...
-  ==>
-	final Object x = new Thunk( new Code() { ...code for rhs_x... } )
--}
-
-  = java_expr (SetVar name) rhs
-  where
-    name = case coreTypeToType rhs of
-	    ty@(PrimType _) -> javaName x `withType` ty
-	    _               -> javaName x `withType` codeType
-
-javaBind (Rec prs)
-{- 	rec { x = ...rhs_x...; y = ...rhs_y... }
-  ==>
-	class x implements Code {
-	  Code x, y;
-	  public Object ENTER() { ...code for rhs_x...}
-	}
-	...ditto for y...
-
-	final x x_inst = new x();
-	...ditto for y...
-
-	final Thunk x = new Thunk( x_inst );
-	...ditto for y...
-
-	x_inst.x = x;
-	x_inst.y = y;
-	...ditto for y...
--}
-  = (map mk_class prs) ++ (map mk_inst prs) ++ 
-    (map mk_thunk prs) ++ concat (map mk_knot prs)
-  where
-    mk_class (b,r) = Declaration (Class [] class_name [] [codeName] stmts)
-		   where
-		     class_name = javaIdTypeName b
-		     stmts = [Field [] (javaName b `withType` codeType) Nothing | (b,_) <- prs] ++
-			     [Method [Public] enterName [vmArg] [excName] (javaExpr vmRETURN r)]	
-
-    mk_inst (b,r) = var [Final] name (mkNew ty [])
-	where
-	   name@(Name _ ty)  = javaInstName b
-
-    mk_thunk (b,r) = var [Final] (javaName b `withType` codeType)
-			 (mkNew thunkType [Var (javaInstName b)])
-
-    mk_knot (b,_) = [ ExprStatement (Assign lhs rhs) 
-		    | (b',_) <- prs,
-		      let lhs = Access (Var (javaInstName b)) (javaName b'),
-		      let rhs = Var (javaName b')
-		    ]
-
-javaLam :: (Expr -> Statement) -> ([CoreBndr], CoreExpr) -> [Statement]
-javaLam r (bndrs, body)
-  | null val_bndrs = javaExpr r body
-  | otherwise
-  =  vmCOLLECT (length val_bndrs) this
-  ++ [var [Final] n (vmPOP t) | n@(Name _ t) <- val_bndrs]
-  ++ javaExpr r body
-  where
-    val_bndrs = map javaName (filter isId bndrs)
-
-javaApp :: (Expr -> Statement) -> CoreExpr -> [CoreExpr] -> [Statement]
-javaApp r (CoreSyn.App f a) as 
-	| isValArg a = javaApp r f (a:as)
-	| otherwise  = javaApp r f as
-javaApp r (CoreSyn.Var f) as 
-  = case isDataConWorkId_maybe f of {
-	Just dc | as `lengthIs` dataConRepArity dc
-	 -- NOTE: Saturated constructors never returning a primitive at this point
-	 --
-	 -- We push the arguments backwards, because we are using
-	 -- the (ugly) semantics of the order of evaluation of arguments,
-	 -- to avoid making up local names. Oh to have a namesupply...
-	 --
-		-> javaArgs (reverse as) ++
-		   [r (New (javaIdType f)
-			   (javaPops as)
-			   Nothing
-		       )
-		   ]
-	        | otherwise ->
-		   --  build a local 
-		   let stmts = 
-			  vmCOLLECT (dataConRepArity dc) this ++
-			[ vmRETURN
-			   (New (javaIdType f)
-				[ vmPOP ty | (Name _ ty) <- constrToFields dc ]
-				Nothing
-			    )
-			]
-		   in javaArgs (reverse as) ++ [r (newCode stmts)]
-    ; other -> java_apply r (CoreSyn.Var f) as
-    }
-	
-javaApp r f as = java_apply r f as
-
--- This means, given a expression an a list of arguments,
--- generate code for "pushing the arguments on the stack,
---  and the executing the expression."
-
-java_apply :: (Expr -> Statement) -> CoreExpr -> [CoreExpr] -> [Statement]
-java_apply r f as = javaArgs as ++ javaExpr r f
-
--- This generates statements that have the net effect
--- of pushing values (perhaps thunks) onto the stack.
-
-javaArgs :: [CoreExpr] -> [Statement]
-javaArgs args = concat [ java_expr PushExpr a | a <- args, isValArg a]
-
-javaPops :: [CoreExpr] -> [Expr]
-javaPops args = [ vmPOP (primRepToType (Type.typePrimRep (CoreUtils.exprType a)))
-		| a <- args 
-		, isValArg a
-		]
-
-
--- The result is a list of statments that have the effect of
--- pushing onto the stack (via one of the VM.PUSH* commands)
--- the argument, (or returning, or setting a variable)
--- perhaps thunked.
-
-{- This is mixing two things.
- (1) Optimizations for things like primitives, whnf calls, etc.
- (2) If something needs a thunk constructor round it.
- - Seperate them at some point!
- -}
-data ExprRetStyle = SetVar Name | PushExpr | ReturnExpr
-
-java_expr :: ExprRetStyle -> CoreExpr -> [Statement]
-java_expr _ (CoreSyn.Type t) = pprPanic "java_expr" (ppr t)
-java_expr ret e
-   | isPrimCall = [push (fromJust maybePrim)]
-	-- This is a shortcut, 
-	-- basic names and literals do not need a code block
-	-- to compute the value.
-   | isPrim primty && CoreUtils.exprIsTrivial e = javaExpr push e
-   | isPrim primty =
- 	  let expr  = javaExpr vmRETURN e
-	      code  = access (vmWHNF (newCode expr)) (primRepToType primty)
-	  in [push code]
-   | otherwise =
- 	  let expr  = javaExpr vmRETURN e
-	      code  = newCode expr
-	      code' = if CoreUtils.exprIsValue e 
-		      || CoreUtils.exprIsTrivial e 
-		      || isPrim primty
-		      then code
-		      else newThunk code
-	  in [push code']
-   where
-	maybePrim  = findFnPrim e []
-	isPrimCall = isJust maybePrim
-
-	push e = case ret of
-		  SetVar name -> var [Final] name e
-		  PushExpr -> vmPUSH e
-		  ReturnExpr -> vmRETURN e
-	corety = CoreUtils.exprType e
-	primty = Type.typePrimRep corety
-	isPrim PtrRep  = False	-- only this needs updated
-	isPrim _       = True
-
-coreTypeToType = primRepToType . Type.typePrimRep . CoreUtils.exprType
-
-renameForKeywords :: (NamedThing name) => name -> String
-renameForKeywords name 
-  | str `elem` keywords = "zdk" ++ str
-  | otherwise            = str
-  where
-	str = getOccString name
-
-keywords :: [String]
-keywords =
-	[ "return"
-	, "if"
-	, "then"
-	, "else"
-	, "class"
-	, "instance"
-	, "import"
-	, "throw"
-	, "try"
-	]
-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Helper functions}
-%*									*
-%************************************************************************
-
-\begin{code}
-true, this,javaNull :: Expr
-this = Var thisName 
-true = Var (Name "true" (PrimType PrimBoolean))
-javaNull = Var (Name "null" objectType)
-
-vmCOLLECT :: Int -> Expr -> [Statement]
-vmCOLLECT 0 e = []
-vmCOLLECT n e = [ExprStatement 
-		    (Call varVM collectName
-			[ Literal (IntLit (toInteger n))
-			, e
-			]
-		    )
-		]
-
-vmPOP :: Type -> Expr 
-vmPOP ty = Call varVM (Name ("POP" ++ suffix ty) ty) []
-
-vmPUSH :: Expr -> Statement
-vmPUSH e = ExprStatement 
-	     (Call varVM (Name ("PUSH" ++ suffix (exprType e)) void) [e])
-
-vmRETURN :: Expr -> Statement
-vmRETURN e = Return (
-     case ty of
-	PrimType _ -> Call varVM (Name ("RETURN" ++ suffix ty)
-				       valueType
-				 ) [e]
-	_ -> e)
-  where
-	ty = exprType e
-
-var :: [Modifier] -> Name -> Expr -> Statement
-var ms field_name@(Name _ ty) value 
-   | exprType value == ty = Declaration (Field ms field_name (Just value))
-   | otherwise            = var ms field_name (Cast ty value)
-
-vmWHNF :: Expr -> Expr
-vmWHNF e = Call varVM whnfName [e]
-
-suffix :: Type -> String
-suffix (PrimType t) = primName t
-suffix _            = ""
-
-primName :: PrimType -> String
-primName PrimInt       = "int"
-primName PrimChar      = "char"
-primName PrimByte      = "byte"
-primName PrimBoolean   = "boolean"
-primName _             = error "unsupported primitive"
-
-varVM :: Expr
-varVM = Var vmName 
-
-instanceOf :: Id -> DataCon -> Expr
-instanceOf x data_con
-  = InstanceOf (Var (javaName x)) (javaConstrWkrType data_con)
-
-newCode :: [Statement] -> Expr
-newCode [Return e] = e
-newCode stmts	   = New codeType [] (Just [Method [Public] enterName [vmArg] [excName] stmts])
-
-newThunk :: Expr -> Expr
-newThunk e = New thunkType [e] Nothing
-
-vmArg :: Parameter
-vmArg = Parameter [Final] vmName
-
--- This is called with boolean compares, checking 
--- to see if we can do an obvious shortcut.
--- If there is, we return a (GOO) expression for doing this,
-
--- So if, we have case (#< x y) of { True -> e1; False -> e2 },
--- we will call findCmpFn with (#< x y), this return Just (Op x "<" y)
-
-findCmpPrim :: CoreExpr -> [Expr] -> Maybe Expr
-findCmpPrim (CoreSyn.App f a) as =
-     case a of
-	CoreSyn.Var v -> findCmpPrim f (javaVar v:as)
-	CoreSyn.Lit l -> findCmpPrim f (javaLit l:as)
-	_ -> Nothing
-findCmpPrim (CoreSyn.Var p)   as = 
-	case isPrimOpId_maybe p of
-	  Just prim -> find_cmp_prim prim as
-	  Nothing   -> Nothing
-findCmpPrim _                 as = Nothing
-
-find_cmp_prim cmpPrim args@[a,b] = 
-   case cmpPrim of
-     IntGtOp -> fn ">"
-     IntGeOp -> fn ">="
-     IntEqOp -> fn "=="
-     IntNeOp -> fn "/="
-     IntLtOp -> fn "<"
-     IntLeOp -> fn "<="
-     _ -> Nothing
-  where
-	fn op = Just (Op a op b)
-find_cmp_prim _ _ = Nothing
-
-findFnPrim :: CoreExpr -> [Expr] -> Maybe Expr
-findFnPrim (CoreSyn.App f a) as =
-     case a of
-	CoreSyn.Var v -> findFnPrim f (javaVar v:as)
-	CoreSyn.Lit l -> findFnPrim f (javaLit l:as)
-	_ -> Nothing
-findFnPrim (CoreSyn.Var p)   as = 
-	case isPrimOpId_maybe p of
-	  Just prim -> find_fn_prim prim as
-	  Nothing   -> Nothing
-findFnPrim _                 as = Nothing
-
-find_fn_prim cmpPrim args@[a,b] = 
-   case cmpPrim of
-     IntAddOp -> fn "+"
-     IntSubOp -> fn "-"
-     IntMulOp -> fn "*"
-     _ -> Nothing
-  where
-	fn op = Just (Op a op b)
-find_fn_prim _ _ = Nothing
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Haskell to Java Types}
-%*									*
-%************************************************************************
-
-\begin{code}
-exprType (Var (Name _ t)) = t
-exprType (Literal lit)    = litType lit
-exprType (Cast t _)       = t
-exprType (New t _ _)      = t
-exprType (Call _ (Name _ t) _) = t
-exprType (Access _ (Name _ t)) = t
-exprType (Raise t _)           = error "do not know the type of raise!"
-exprType (Op _ op _) | op `elem` ["==","/=","<","<=","=>",">"]
-		     = PrimType PrimBoolean
-exprType (Op x op _) | op `elem` ["+","-","*"]
-		     = exprType x
-exprType expr = error ("can't figure out an expression type: " ++ show expr)
-
-litType (IntLit i)    = PrimType PrimInt
-litType (CharLit i)   = PrimType PrimChar
-litType (StringLit i) = stringType	-- later, might use char array?
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Name mangling}
-%*									*
-%************************************************************************
-
-\begin{code}
-codeName, excName, thunkName :: TypeName
-codeName  = "haskell.runtime.Code"
-thunkName = "haskell.runtime.Thunk"
-excName   = "java.lang.Exception"
-
-enterName, vmName,thisName,collectName, whnfName :: Name
-enterName   = Name "ENTER"   objectType
-vmName      = Name "VM"      vmType
-thisName    = Name "this"    (Type "<this>")
-collectName = Name "COLLECT" void
-whnfName    = Name "WHNF"    objectType
-
-fieldName :: Int -> Type -> Name	-- Names for fields of a constructor
-fieldName n ty = Name ("f" ++ show n) ty
-
-withType :: Name -> Type -> Name
-withType (Name n _) t = Name n t
-
--- This maps (local only) names Ids to Names, 
--- using the same string as the Id.
-javaName :: Id -> Name
-javaName n 
-  | isExternalName (idName n) = error "useing javaName on global"
-  | otherwise = Name (getOccString n)
-		     (primRepToType (idPrimRep n))
-
--- TypeName's are almost always global. This would typically return something
--- like Test.foo or Test.Foozdc or PrelBase.foldr.
--- Local might use locally bound types, (which do not have '.' in them).
-
-javaIdTypeName :: Id -> TypeName
-javaIdTypeName n
-    | isInternalName n' = renameForKeywords n'
-    | otherwise      = moduleString (nameModule n') ++ "." ++ renameForKeywords n'
-  where
-	     n' = getName n
-
--- There is no such thing as a local type constructor.
-
-javaTyConTypeName :: TyCon -> TypeName
-javaTyConTypeName n = (moduleString (nameModule n') ++ "." ++ renameForKeywords n')
-  where
-	     n' = getName n
-
--- this is used for getting the name of a class when defining it.
-shortName :: TypeName -> TypeName
-shortName = reverse . takeWhile (/= '.') . reverse
-
--- The function that makes the constructor name
--- The constructor "Foo ..." in module Test,
--- would return the name "Test.Foo".
-
-javaConstrWkrName :: DataCon -> TypeName
-javaConstrWkrName = javaIdTypeName . dataConWorkId
-
--- Makes x_inst for Rec decls
--- They are *never* is primitive
--- and always have local (type) names.
-javaInstName :: Id -> Name
-javaInstName n = Name (renameForKeywords n ++ "zdi_inst")
-		      (Type (renameForKeywords n))
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Types and type mangling}
-%*									*
-%************************************************************************
-
-\begin{code}
--- Haskell RTS types
-codeType, thunkType, valueType :: Type
-codeType   = Type codeName
-thunkType  = Type thunkName
-valueType  = Type "haskell.runtime.Value"
-vmType     = Type "haskell.runtime.VMEngine"
-
--- Basic Java types
-objectType, stringType :: Type
-objectType = Type "java.lang.Object"
-stringType = Type "java.lang.String"
-
-void :: Type
-void = PrimType PrimVoid
-
-inttype :: Type
-inttype = PrimType PrimInt
-
-chartype :: Type
-chartype = PrimType PrimChar
-
-bytetype :: Type
-bytetype = PrimType PrimByte
-
--- This lets you get inside a possible "Value" type,
--- to access the internal unboxed object.
-access :: Expr -> Type -> Expr
-access expr (PrimType prim) = accessPrim (Cast valueType expr) prim
-access expr other           = expr
-
-accessPrim expr PrimInt  = Call expr (Name "intValue" inttype) []
-accessPrim expr PrimChar = Call expr (Name "charValue" chartype) []
-accessPrim expr PrimByte = Call expr (Name "byteValue" bytetype) []
-accessPrim expr other    = pprPanic "accessPrim" (text (show other))
-
--- This is where we map from typename to types,
--- allowing to match possible primitive types.
-mkType :: TypeName -> Type
-mkType "PrelGHC.Intzh"  = inttype
-mkType "PrelGHC.Charzh" = chartype
-mkType other            = Type other
-
--- Turns a (global) Id into a Type (fully qualified name).
-javaIdType :: Id -> Type
-javaIdType = mkType . javaIdTypeName
-
-javaLocalIdType :: Id -> Type
-javaLocalIdType = primRepToType . idPrimRep
-
-primRepToType ::PrimRep -> Type
-primRepToType PtrRep  = objectType
-primRepToType IntRep  = inttype
-primRepToType CharRep = chartype
-primRepToType Int8Rep = bytetype
-primRepToType AddrRep = objectType
-primRepToType other   = pprPanic "primRepToType" (ppr other)
-
--- The function that makes the constructor name
-javaConstrWkrType :: DataCon -> Type
-javaConstrWkrType con = Type (javaConstrWkrName con)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Class Lifting}
-%*									*
-%************************************************************************
-
-This is a very simple class lifter. It works by carrying inwards a
-list of bound variables (things that might need to be passed to a
-lifted inner class). 
- * Any variable references is check with this list, and if it is
-   bound, then it is not top level, external reference. 
- * This means that for the purposes of lifting, it might be free
-   inside a lifted inner class.
- * We remember these "free inside the inner class" values, and 
-   use this list (which is passed, via the monad, outwards)
-   when lifting.
-
-\begin{code}
-type Bound = [Name]
-type Frees = [Name]
-
-combine :: [Name] -> [Name] -> [Name]
-combine []           names          = names
-combine names        []             = names
-combine (name:names) (name':names') 
-	| name < name' = name  : combine names (name':names')
-	| name > name' = name' : combine (name:names) names'
-	| name == name = name  : combine names names'
-	| otherwise    = error "names are not a total order"
-
-both :: [Name] -> [Name] -> [Name]
-both []           names          = []
-both names        []             = []
-both (name:names) (name':names') 
-	| name < name' = both names (name':names')
-	| name > name' = both (name:names) names'
-	| name == name = name  : both names names'
-	| otherwise    = error "names are not a total order"
-
-combineEnv :: Env -> [Name] -> Env
-combineEnv (Env bound env) new = Env (bound `combine` new) env
-
-addTypeMapping :: TypeName -> TypeName -> [Name] -> Env -> Env
-addTypeMapping origName newName frees (Env bound env)
-	= Env bound ((origName,(newName,frees)) : env)
-
--- This a list of bound vars (with types)
--- and a mapping from old class name 
---     to inner class name (with a list of frees that need passed
---	                    to the inner class.)
-
-data Env = Env Bound [(TypeName,(TypeName,[Name]))]
-
-newtype LifterM a = 
-  	LifterM { unLifterM ::
-		     TypeName ->		-- this class name
-		     Int -> 			-- uniq supply
-			  ( a			--  *
-			    , Frees		-- frees
-			    , [Decl]		-- lifted classes
-			    , Int		-- The uniqs
-			    )
-		}
-
-instance Monad LifterM where
-	return a = LifterM (\ n s -> (a,[],[],s))
-	(LifterM m) >>= fn = LifterM (\ n s ->
-	  case m n s of
-	    (a,frees,lifted,s) 
-	         -> case unLifterM (fn a) n s of
-	 	     (a,frees2,lifted2,s) -> ( a
-					     , combine frees frees2
-					     , lifted ++ lifted2
-					     , s)
-	  )
-
-liftAccess :: Env -> Name -> LifterM ()
-liftAccess env@(Env bound _) name 
-	| name `elem` bound = LifterM (\ n s -> ((),[name],[],s))
-	| otherwise         = return ()
-
-scopedName :: TypeName -> LifterM a -> LifterM a
-scopedName name (LifterM m) =
-   LifterM (\ _ s -> 
-      case m name 1 of
-	(a,frees,lifted,_) -> (a,frees,lifted,s)
-      )
-
-genAnonInnerClassName :: LifterM TypeName
-genAnonInnerClassName = LifterM (\ n s ->
-	( n ++ "$" ++ show s
-	, []
-	, []
-	, s + 1
-	)
-    )
-
-genInnerClassName :: TypeName -> LifterM TypeName
-genInnerClassName name = LifterM (\ n s ->
-	( n ++ "$" ++ name 
-	, []
-	, []
-	, s
-	)
-    )
-
-getFrees  :: LifterM a -> LifterM (a,Frees)
-getFrees (LifterM m) = LifterM (\ n s ->
-	case m n s of
-	  (a,frees,lifted,n) -> ((a,frees),frees,lifted,n)
-    )
-
-rememberClass :: Decl -> LifterM ()
-rememberClass decl = LifterM (\ n s -> ((),[],[decl],s))
-
-
-liftCompilationUnit :: CompilationUnit -> CompilationUnit
-liftCompilationUnit (Package name ds) = 
-    Package name (concatMap liftCompilationUnit' ds)
-
-liftCompilationUnit' :: Decl -> [Decl]
-liftCompilationUnit' decl = 
-    case unLifterM (liftDecls True (Env [] []) [decl]) [] 1 of
-      (ds,_,ds',_) -> ds ++ ds'
-
-
--- The bound vars for the current class have
--- already be captured before calling liftDecl,
--- because they are in scope everywhere inside the class.
-
-liftDecl :: Bool -> Env -> Decl -> LifterM Decl
-liftDecl = \ top env decl ->
-  case decl of
-    { Import n -> return (Import n)
-    ; Field mfs n e -> 
-      do { e <- liftMaybeExpr env e
-	 ; return (Field mfs (liftName env n) e)
-	 }
-    ; Constructor mfs n as ss -> 
-      do { let newBound = getBoundAtParameters as
-	 ; (ss,_) <- liftStatements (combineEnv env newBound) ss
-	 ; return (Constructor mfs n (liftParameters env as) ss)
-	 }
-    ; Method mfs n as ts ss -> 
-      do { let newBound = getBoundAtParameters as
-	 ; (ss,_) <- liftStatements (combineEnv env newBound) ss
-	 ; return (Method mfs (liftName env n) (liftParameters env as) ts ss)
-	 }
-    ; Comment s -> return (Comment s)
-    ; Interface mfs n is ms -> error "interfaces not supported"
-    ; Class mfs n x is ms -> 
-      do { let newBound = getBoundAtDecls ms
-	 ; ms <- scopedName n
-		    (liftDecls False (combineEnv env newBound) ms)
-	 ; return (Class mfs n x is ms)
-	 }
-    }
-
-liftDecls :: Bool -> Env -> [Decl] -> LifterM [Decl]
-liftDecls top env = mapM (liftDecl top env)
-
-getBoundAtDecls :: [Decl] -> Bound
-getBoundAtDecls = foldr combine [] . map getBoundAtDecl
-
-getBoundAtDecl :: Decl -> Bound
-getBoundAtDecl (Field _ n _) = [n]
-getBoundAtDecl _             = []
-
-getBoundAtParameters :: [Parameter] -> Bound
-getBoundAtParameters = foldr combine [] . map getBoundAtParameter
-
--- TODO
-getBoundAtParameter :: Parameter -> Bound
-getBoundAtParameter (Parameter _ n) = [n]
-
-
-liftStatement :: Env -> Statement -> LifterM (Statement,Env)
-liftStatement = \ env stmt ->
-  case stmt of 
-    { Skip -> return (stmt,env)
-    ; Return e -> do { e <- liftExpr env e
-		     ; return (Return e,env)
-		     } 
-    ; Block ss -> do { (ss,env) <- liftStatements env ss
-		     ; return (Block ss,env)
-		     }
-    ; ExprStatement e -> do { e <- liftExpr env e
-			    ; return (ExprStatement e,env)
-			    }
-    ; Declaration decl@(Field mfs n e) ->
-      do { e <- liftMaybeExpr env e
-	 ; return ( Declaration (Field mfs (liftName env n) e)
-		  , env `combineEnv` getBoundAtDecl decl
-		  )
-	 }
-    ; Declaration decl@(Class mfs n x is ms) ->
-      do { innerName <- genInnerClassName n
-	 ; frees <- liftClass env innerName ms x is
-	 ; return ( Declaration (Comment ["lifted " ++  n])
-		  , addTypeMapping n innerName frees env
-		  )
-	 }
-    ; Declaration d -> error "general Decl not supported"
-    ; IfThenElse ecs s -> ifthenelse env ecs s
-    ; Switch e as d -> error "switch not supported"
-    } 
-
-ifthenelse :: Env 
-	   -> [(Expr,Statement)] 
-	   -> (Maybe Statement) 
-	   -> LifterM (Statement,Env)
-ifthenelse env pairs may_stmt =
-  do { let (exprs,stmts) = unzip pairs
-     ; exprs <- liftExprs env exprs
-     ; (stmts,_) <- liftStatements env stmts
-     ; may_stmt <- case may_stmt of
-		      Just stmt -> do { (stmt,_) <- liftStatement env stmt
-				      ; return (Just stmt)
-				      }
-		      Nothing -> return Nothing
-     ; return (IfThenElse (zip exprs stmts) may_stmt,env)
-     }
-
-liftStatements :: Env -> [Statement] -> LifterM ([Statement],Env)
-liftStatements env []     = return ([],env)
-liftStatements env (s:ss) = 
-	do { (s,env) <- liftStatement env s
-	   ; (ss,env) <- liftStatements env ss
-	   ; return (s:ss,env) 
-	   }
-
-liftExpr :: Env -> Expr -> LifterM Expr
-liftExpr = \ env expr ->
- case expr of
-   { Var n -> do { liftAccess env n 
-		 ; return (Var (liftName env n))
-	         }
-   ; Literal l -> return expr
-   ; Cast t e -> do { e <- liftExpr env e
-	            ; return (Cast (liftType env t) e) 
-	            }
-   ; Access e n -> do { e <- liftExpr env e 
-			-- do not consider n as an access, because
-			-- this is a indirection via a reference
-		      ; return (Access e n) 
-		      }
-   ; Assign l r -> do { l <- liftExpr env l
-		      ; r <- liftExpr env r
-		      ; return (Assign l r)
-		      } 
-   ; InstanceOf e t -> do { e <- liftExpr env e
-			  ; return (InstanceOf e (liftType env t))
-			  }	    
-   ; Raise n es -> do { es <- liftExprs env es
-		      ; return (Raise n es)
-		      }
-   ; Call e n es -> do { e <- liftExpr env e
-		       ; es <- mapM (liftExpr env) es
-		       ; return (Call e n es) 
-		       }
-   ; Op e1 o e2 -> do { e1 <- liftExpr env e1
-		      ;	e2 <- liftExpr env e2
-		      ; return (Op e1 o e2)
-		      }
-   ; New n es ds -> new env n es ds
-   }
-
-liftParameter env (Parameter ms n) = Parameter ms (liftName env n)
-liftParameters env = map (liftParameter env)
-
-liftName env (Name n t) = Name n (liftType env t)
-
-liftExprs :: Env -> [Expr] -> LifterM [Expr]
-liftExprs = mapM . liftExpr
-
-
-liftMaybeExpr :: Env -> (Maybe Expr) -> LifterM (Maybe Expr)
-liftMaybeExpr env Nothing     = return Nothing
-liftMaybeExpr env (Just stmt) = do { stmt <- liftExpr env stmt
-				     ; return (Just stmt)
-				     }
-
-
-
-new :: Env -> Type -> [Expr] -> Maybe [Decl] -> LifterM Expr
-new env@(Env _ pairs) typ args Nothing =
-  do { args <- liftExprs env args
-     ; return (liftNew env typ args)
-     }
-new env typ [] (Just inner) =
-  -- anon. inner class
-  do { innerName <- genAnonInnerClassName 
-     ; frees <- liftClass env innerName inner [] [unType typ]
-     ; return (New (Type (innerName)) 
-	           (map Var frees) 
-	            Nothing)
-     }
-  where unType (Type name) = name
-	unType _             = error "incorrect type style"
-new env typ _ (Just inner) = error "cant handle inner class with args"
-
-
-liftClass :: Env -> TypeName -> [Decl] -> [TypeName] -> [TypeName] -> LifterM [ Name ]
-liftClass env@(Env bound _) innerName inner xs is =
-  do { let newBound = getBoundAtDecls inner
-     ; (inner,frees) <- 
-	   getFrees (liftDecls False (env `combineEnv` newBound) inner)
-     ; let trueFrees = filter (\ (Name xs _) -> xs /= "VM") (both frees bound)
-     ; let freeDefs = [ Field [Final] n Nothing | n <- trueFrees ]
-     ; let cons = mkCons innerName trueFrees
-     ; let innerClass = Class [] innerName xs is (freeDefs ++ [cons] ++ inner)
-     ; rememberClass innerClass
-     ; return trueFrees
-     }
-
-liftType :: Env -> Type -> Type
-liftType (Env _ env) typ@(Type name) 
-   = case lookup name env of
-	Nothing     -> typ
-	Just (nm,_) -> Type nm
-liftType _           typ = typ
-
-liftNew :: Env -> Type -> [Expr] -> Expr
-liftNew (Env _ env) typ@(Type name) exprs
-   = case lookup name env of
-	Nothing                     -> New typ exprs Nothing
-	Just (nm,args) | null exprs 
-		-> New (Type nm) (map Var args) Nothing
-	_ -> error "pre-lifted constructor with arguments"
-\end{code}
diff --git a/ghc/compiler/javaGen/PrintJava.lhs b/ghc/compiler/javaGen/PrintJava.lhs
deleted file mode 100644
index eb2811d38f..0000000000
--- a/ghc/compiler/javaGen/PrintJava.lhs
+++ /dev/null
@@ -1,224 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section{Generate Java}
-
-\begin{code}
-module PrintJava( compilationUnit ) where
-
-import Java
-import Outputable
-import Char( toLower )
-\end{code}
-
-\begin{code}
-indent :: SDoc -> SDoc
-indent = nest 2
-\end{code}
-  
-%************************************************************************
-%*									*
-\subsection{Pretty printer}
-%*									*
-%************************************************************************
-
-\begin{code}
-compilationUnit :: CompilationUnit -> SDoc
-compilationUnit (Package n ds) = package n (decls ds)
-
-package = \n -> \ds ->
-  text "package" <+> packagename n <> text ";"
-  $$
-  ds
-  
-decls []     = empty
-decls (d:ds) = decl d $$ decls ds
-    
-decl = \d ->
-  case d of
-    { Import n -> importDecl (packagename n)
-    ; Field mfs n e -> field (modifiers mfs) (nameTy n) (name n) e  
-    ; Constructor mfs n as ss -> constructor (modifiers mfs) (typename n) (parameters as) (statements ss)
-    ; Method mfs n as ts ss -> method (modifiers mfs) (nameTy n) (name n) (parameters as) (throws ts) (statements ss)
-    ; Comment s -> comment s
-    ; Interface mfs n is ms -> interface (modifiers mfs) (typename n) (extends is) (decls ms)
-    ; Class mfs n x is ms -> clazz (modifiers mfs) (typename n) (extends x) (implements is) (decls ms)
-    }
-
-importDecl n = text "import" <+> n <> text ";"
-  
-field = \mfs -> \t -> \n -> \e ->
-  case e of
-    { Nothing -> mfs <+> t <+> n <> text ";" 
-    ; Just e  -> lay [mfs <+> t <+> n <+> text "=", indent (expr e <> text ";")]
-	     where
-		lay | isSimple e = hsep
-		    | otherwise  = sep
-    }
-
-constructor = \mfs -> \n -> \as -> \ss ->
-  mfs <+> n <+> parens (hsep (punctuate comma as)) <+> text "{"
-  $$ indent ss 
-  $$ text "}"
-
-method = \mfs -> \t -> \n -> \as -> \ts -> \ss -> 
-  mfs <+> t <+> n <+> parens (hsep (punctuate comma as)) <+> ts <+> text "{" 
-  $$ indent ss 
-  $$ text "}"
-
-comment = \ss ->
-  text "/**"
-  $$ indent (vcat [ text s | s <- ss])
-  $$ text "**/"
-
-interface = \mfs -> \n -> \xs -> \ms -> 
-  mfs <+> n <+> xs <+> text "{"
-  $$ indent ms
-  $$ text "}"
-     
-clazz = \mfs -> \n -> \x -> \is -> \ms ->
-  mfs <+> text "class" <+> n <+> x <+> is <+> text "{" 
-  $$ indent ms 
-  $$ text "}"
-
-modifiers mfs = hsep (map modifier mfs)
-    
-modifier mf = text $ map toLower (show mf)
-  
-extends [] = empty
-extends xs = text "extends" <+> hsep (punctuate comma (map typename xs))
-
-implements [] = empty
-implements xs = text "implements" <+> hsep (punctuate comma (map typename xs))
-
-throws [] = empty
-throws xs = text "throws" <+> hsep (punctuate comma (map typename xs))
-
-name (Name n t)   = text n
-
-nameTy (Name n t) = typ t
-
-typename n        = text n
-packagename n     = text n
-
-parameters as = map parameter as
-
-parameter (Parameter mfs n) = modifiers mfs <+> nameTy n <+> name n
-
-typ (PrimType s)  = primtype s
-typ (Type n)      = typename n
-typ (ArrayType t) = typ t <> text "[]"
-
-primtype PrimInt     = text "int"
-primtype PrimBoolean = text "boolean"
-primtype PrimChar    = text "char"
-primtype PrimLong    = text "long"
-primtype PrimFloat   = text "float"
-primtype PrimDouble  = text "double"
-primtype PrimByte    = text "byte"
-primtype PrimVoid    = text "void"
-
-statements ss = vcat (map statement ss)
-  
-statement = \s ->
-  case s of
-    { Skip -> skip
-    ; Return e -> returnStat (expr e)
-    ; Block ss -> vcat [statement s | s <- ss]
-    ; ExprStatement e -> exprStatement (expr e)
-    ; Declaration d -> declStatement (decl d)
-    ; IfThenElse ecs s -> ifthenelse [ (expr e, statement s) | (e,s) <- ecs ] (maybe Nothing (Just .statement) s)
-    ; Switch e as d -> switch (expr e) (arms as) (deflt d)
-    } 
-
-skip = empty
-  
-returnStat e = sep [text "return", indent e <> semi]
-
-exprStatement e = e <> semi
-
-declStatement d = d
-
-ifthenelse ((e,s):ecs) ms = sep [ text "if" <+> parens e <+> text "{", 
-			          indent s, 
-				  thenelse ecs ms]
-
-thenelse ((e,s):ecs) ms = sep [	text "} else if" <+> parens e <+> text "{", 
-				indent s,
-				thenelse ecs ms]
-
-thenelse [] Nothing  = text "}"
-thenelse [] (Just s) = sep [text "} else {", indent s, text "}"]
-    
-switch = \e -> \as -> \d ->
-  text "switch" <+> parens e <+> text "{" 
-  $$ indent (as $$ d)
-  $$ text "}"
-  
-deflt Nothing   = empty
-deflt (Just ss) = text "default:" $$ indent (statements ss)  
-    
-arms [] = empty
-arms ((e,ss):as) = text "case" <+> expr e <> colon
-                   $$ indent (statements ss)
-                   $$ arms as
-
-maybeExpr Nothing  = Nothing
-maybeExpr (Just e) = Just (expr e)
-           
-expr = \e ->
- case e of
-   { Var n -> name n
-   ; Literal l -> literal l
-   ; Cast t e -> cast (typ t) e
-   ; Access e n -> expr e <> text "." <> name n
-   ; Assign l r -> assign (expr l) r
-   ; New n es ds -> new (typ n) es (maybeClass ds)
-   ; Raise n es  -> text "raise" <+> text n
-			<+> parens (hsep (punctuate comma (map expr es)))
-   ; Call e n es -> call (expr e) (name n) es
-   ; Op e1 o e2 -> op e1 o e2
-   ; InstanceOf e t -> expr e <+> text "instanceof" <+> typ t
-   }
-   
-op = \e1 -> \o -> \e2 ->
-  ( if isSimple e1 
-    then expr e1 
-    else parens (expr e1)
-  ) 
-  <+> 
-  text o
-  <+>
-  ( if isSimple e2
-    then expr e2 
-    else parens (expr e2)
-  )
-  
-assign = \l -> \r ->
-  if isSimple r
-  then l <+> text "=" <+> (expr r)
-  else l <+> text "=" $$ indent (expr r)
-
-cast = \t -> \e ->
-  if isSimple e
-  then parens (parens t <> expr e)
-  else parens (parens t $$ indent (expr e))
-
-new n [] (Just ds) = sep [text "new" <+> n <+> text "()" <+> text "{",
-			     indent ds,
-			     text "}"]
-new n es Nothing = text "new" <+> n <> parens (hsep (punctuate comma (map expr es)))
-
-      
-call e n es = e <> dot <> n <> parens (hsep (punctuate comma (map expr es)))
-
-literal = \l ->
-  case l of
-    { IntLit i    -> text (show i)
-    ; CharLit c   -> text "(char)" <+> text (show c)
-    ; StringLit s -> text ("\"" ++ s ++ "\"")	-- strings are already printable
-    }
-
-maybeClass Nothing   = Nothing
-maybeClass (Just ds) = Just (decls ds)
-\end{code}
diff --git a/ghc/compiler/main/CmdLineParser.hs b/ghc/compiler/main/CmdLineParser.hs
deleted file mode 100644
index e34b8c0857..0000000000
--- a/ghc/compiler/main/CmdLineParser.hs
+++ /dev/null
@@ -1,139 +0,0 @@
------------------------------------------------------------------------------
---
--- Command-line parser
---
--- This is an abstract command-line parser used by both StaticFlags and
--- DynFlags.
---
--- (c) The University of Glasgow 2005
---
------------------------------------------------------------------------------
-
-module CmdLineParser (
-	processArgs, OptKind(..), 
-	CmdLineP(..), getCmdLineState, putCmdLineState
-  ) where
-
-#include "HsVersions.h"
-
-import Util	( maybePrefixMatch, notNull, removeSpaces )
-#ifdef DEBUG
-import Panic	( assertPanic )
-#endif
-
-data OptKind m
-	= NoArg (m ())  -- flag with no argument
-	| HasArg    (String -> m ())    -- flag has an argument (maybe prefix)
-	| SepArg    (String -> m ())    -- flag has a separate argument
-	| Prefix    (String -> m ())    -- flag is a prefix only
-	| OptPrefix (String -> m ())    -- flag may be a prefix
-	| AnySuffix (String -> m ())    -- flag is a prefix, pass whole arg to fn
-	| PassFlag  (String -> m ())    -- flag with no arg, pass flag to fn
-	| PrefixPred    (String -> Bool) (String -> m ())
-	| AnySuffixPred (String -> Bool) (String -> m ())
-
-processArgs :: Monad m
-	    => [(String, OptKind m)]	-- cmdline parser spec
-	    -> [String]			-- args
-	    -> m (
-	        [String],  -- spare args
-                [String]   -- errors
-		)
-processArgs spec args = process spec args [] []
-  where
-    process _spec [] spare errs =
-      return (reverse spare, reverse errs)
-    
-    process spec args@(('-':arg):args') spare errs =
-      case findArg spec arg of
-        Just (rest,action) -> 
-           case processOneArg action rest args of
-    	   Left err       -> process spec args' spare (err:errs)
-    	   Right (action,rest) -> do
-    		action >> process spec rest spare errs
-        Nothing -> 
-    	   process spec args' (('-':arg):spare) errs
-    
-    process spec (arg:args) spare errs = 
-      process spec args (arg:spare) errs
-
-
-processOneArg :: OptKind m -> String -> [String]
-  -> Either String (m (), [String])
-processOneArg action rest (dash_arg@('-':arg):args) =
-  case action of
-	NoArg  a -> ASSERT(null rest) Right (a, args)
-
-	HasArg f -> 
-		if rest /= "" 
-			then Right (f rest, args)
-			else case args of
-				[] -> missingArgErr dash_arg
-				(arg1:args1) -> Right (f arg1, args1)
-
-	SepArg f -> 
-		case args of
-			[] -> unknownFlagErr dash_arg
-			(arg1:args1) -> Right (f arg1, args1)
-
-	Prefix f -> 
-		if rest /= ""
-			then Right (f rest, args)
-			else unknownFlagErr dash_arg
-	
-	PrefixPred p f -> 
-		if rest /= ""
-			then Right (f rest, args)
-			else unknownFlagErr dash_arg
-	
-	OptPrefix f       -> Right (f rest, args)
-
-	AnySuffix f       -> Right (f dash_arg, args)
-
-	AnySuffixPred p f -> Right (f dash_arg, args)
-
-	PassFlag f  -> 
-		if rest /= ""
-			then unknownFlagErr dash_arg
-			else Right (f dash_arg, args)
-
-
-findArg :: [(String,OptKind a)] -> String -> Maybe (String,OptKind a)
-findArg spec arg
-  = case [ (removeSpaces rest, k) 
-	 | (pat,k)   <- spec, 
-	   Just rest <- [maybePrefixMatch pat arg],
-	   arg_ok k rest arg ] 
-    of
-	[]      -> Nothing
-	(one:_) -> Just one
-
-arg_ok (NoArg _)            rest arg = null rest
-arg_ok (HasArg _)           rest arg = True
-arg_ok (SepArg _)           rest arg = null rest
-arg_ok (Prefix _)	    rest arg = notNull rest
-arg_ok (PrefixPred p _)     rest arg = notNull rest && p rest
-arg_ok (OptPrefix _)	    rest arg = True
-arg_ok (PassFlag _)         rest arg = null rest 
-arg_ok (AnySuffix _)        rest arg = True
-arg_ok (AnySuffixPred p _)  rest arg = p arg
-
-unknownFlagErr :: String -> Either String a
-unknownFlagErr f = Left ("unrecognised flag: " ++ f)
-
-missingArgErr :: String -> Either String a
-missingArgErr f = Left ("missing argument for flag: " ++ f)
-
--- -----------------------------------------------------------------------------
--- A state monad for use in the command-line parser
-
-newtype CmdLineP s a = CmdLineP { runCmdLine :: s -> (a, s) }
-
-instance Monad (CmdLineP s) where
-	return a = CmdLineP $ \s -> (a, s)
-	m >>= k  = CmdLineP $ \s -> let
-		(a, s') = runCmdLine m s
-		in runCmdLine (k a) s'
-
-getCmdLineState   = CmdLineP $ \s -> (s,s)
-putCmdLineState s = CmdLineP $ \_ -> ((),s)
diff --git a/ghc/compiler/main/CodeOutput.lhs b/ghc/compiler/main/CodeOutput.lhs
deleted file mode 100644
index d1b293353a..0000000000
--- a/ghc/compiler/main/CodeOutput.lhs
+++ /dev/null
@@ -1,303 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section{Code output phase}
-
-\begin{code}
-module CodeOutput( codeOutput, outputForeignStubs ) where
-
-#include "HsVersions.h"
-
-#ifndef OMIT_NATIVE_CODEGEN
-import UniqSupply	( mkSplitUniqSupply )
-import AsmCodeGen	( nativeCodeGen )
-#endif
-
-#ifdef ILX
-import IlxGen		( ilxGen )
-#endif
-
-#ifdef JAVA
-import JavaGen		( javaGen )
-import qualified PrintJava
-import OccurAnal	( occurAnalyseBinds )
-#endif
-
-import Finder		( mkStubPaths )
-import PprC		( writeCs )
-import CmmLint		( cmmLint )
-import Packages
-import Util
-import FastString	( unpackFS )
-import Cmm		( Cmm )
-import HscTypes
-import DynFlags
-import ErrUtils		( dumpIfSet_dyn, showPass, ghcExit )
-import Outputable
-import Pretty		( Mode(..), printDoc )
-import Module		( Module, ModLocation(..) )
-import List		( nub )
-import Maybes		( firstJust )
-
-import Distribution.Package	( showPackageId )
-import Directory	( doesFileExist )
-import Monad		( when )
-import IO
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Steering}
-%*									*
-%************************************************************************
-
-\begin{code}
-codeOutput :: DynFlags
-	   -> Module
-	   -> ModLocation
-	   -> ForeignStubs
-	   -> [PackageId]
-	   -> [Cmm]			-- Compiled C--
-	   -> IO (Bool{-stub_h_exists-}, Bool{-stub_c_exists-})
-
-codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC
-  = 
-    -- You can have C (c_output) or assembly-language (ncg_output),
-    -- but not both.  [Allowing for both gives a space leak on
-    -- flat_abstractC.  WDP 94/10]
-
-    -- Dunno if the above comment is still meaningful now.  JRS 001024.
-
-    do	{ when (dopt Opt_DoCmmLinting dflags) $ do
-		{ showPass dflags "CmmLint"
-		; let lints = map cmmLint flat_abstractC
-		; case firstJust lints of
-			Just err -> do { printDump err
-				       ; ghcExit dflags 1
-				       }
-			Nothing  -> return ()
-		}
-
-	; showPass dflags "CodeOutput"
-	; let filenm = hscOutName dflags 
-	; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs
-	; case hscTarget dflags of {
-             HscInterpreted -> return ();
-             HscAsm         -> outputAsm dflags filenm flat_abstractC;
-             HscC           -> outputC dflags filenm this_mod location 
-				 flat_abstractC stubs_exist pkg_deps
-				 foreign_stubs;
-             HscJava        -> 
-#ifdef JAVA
-			       outputJava dflags filenm mod_name tycons core_binds;
-#else
-                               panic "Java support not compiled into this ghc";
-#endif
-	     HscILX         -> 
-#ifdef ILX
-			       let tycons = typeEnvTyCons type_env in
-	                       outputIlx dflags filenm mod_name tycons stg_binds;
-#else
-                               panic "ILX support not compiled into this ghc";
-#endif
-	  }
-	; return stubs_exist
-	}
-
-doOutput :: String -> (Handle -> IO ()) -> IO ()
-doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{C}
-%*									*
-%************************************************************************
-
-\begin{code}
-outputC dflags filenm mod location flat_absC 
-	(stub_h_exists, _) packages foreign_stubs
-  = do 
-       -- figure out which header files to #include in the generated .hc file:
-       --
-       --   * extra_includes from packages
-       --   * -#include options from the cmdline and OPTIONS pragmas
-       --   * the _stub.h file, if there is one.
-       --
-       pkg_configs <- getExplicitPackagesAnd dflags packages
-       let pkg_names = map (showPackageId.package) pkg_configs
-
-       c_includes <- getPackageCIncludes pkg_configs
-       let cmdline_includes = cmdlineHcIncludes dflags -- -#include options
-       
-	   ffi_decl_headers 
-	      = case foreign_stubs of
-		  NoStubs 		  -> []
-		  ForeignStubs _ _ fdhs _ -> map unpackFS (nub fdhs)
-			-- Remove duplicates, because distinct foreign import decls
-			-- may cite the same #include.  Order doesn't matter.
-
-           all_headers =  c_includes
-		       ++ reverse cmdline_includes
-		       ++ ffi_decl_headers
-
-       let cc_injects = unlines (map mk_include all_headers)
-       	   mk_include h_file = 
-       	    case h_file of 
-       	       '"':_{-"-} -> "#include "++h_file
-       	       '<':_      -> "#include "++h_file
-       	       _          -> "#include \""++h_file++"\""
-
-       doOutput filenm $ \ h -> do
-	  hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
-	  hPutStr h cc_injects
-	  when stub_h_exists $ 
-	     hPutStrLn h ("#include \"" ++ (filenameOf stub_h) ++ "\"")
-	  writeCs dflags h flat_absC
-  where
-    (_, stub_h) = mkStubPaths dflags mod location
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Assembler}
-%*									*
-%************************************************************************
-
-\begin{code}
-outputAsm dflags filenm flat_absC
-
-#ifndef OMIT_NATIVE_CODEGEN
-
-  = do ncg_uniqs <- mkSplitUniqSupply 'n'
-       ncg_output_d <- _scc_ "NativeCodeGen" 
-			  nativeCodeGen dflags flat_absC ncg_uniqs
-       dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" (docToSDoc ncg_output_d)
-       _scc_ "OutputAsm" doOutput filenm $
-	   \f -> printDoc LeftMode f ncg_output_d
-  where
-
-#else /* OMIT_NATIVE_CODEGEN */
-
-  = pprPanic "This compiler was built without a native code generator"
-	     (text "Use -fvia-C instead")
-
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Java}
-%*									*
-%************************************************************************
-
-\begin{code}
-#ifdef JAVA
-outputJava dflags filenm mod tycons core_binds
-  = doOutput filenm (\ f -> printForUser f alwaysQualify pp_java)
-	-- User style printing for now to keep indentation
-  where
-    occ_anal_binds = occurAnalyseBinds core_binds
-	-- Make sure we have up to date dead-var information
-    java_code = javaGen mod [{- Should be imports-}] tycons occ_anal_binds
-    pp_java   = PrintJava.compilationUnit java_code
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Ilx}
-%*									*
-%************************************************************************
-
-\begin{code}
-#ifdef ILX
-outputIlx dflags filename mod tycons stg_binds
-  =  doOutput filename (\ f -> printForC f pp_ilx)
-  where
-    pp_ilx = ilxGen mod tycons stg_binds
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Foreign import/export}
-%*									*
-%************************************************************************
-
-\begin{code}
-outputForeignStubs :: DynFlags -> Module -> ModLocation -> ForeignStubs
-		   -> IO (Bool, 	-- Header file created
-			  Bool)		-- C file created
-outputForeignStubs dflags mod location stubs
-  | NoStubs <- stubs = do
-	-- When compiling External Core files, may need to use stub
-	-- files from a previous compilation
-	stub_c_exists <- doesFileExist stub_c
-	stub_h_exists <- doesFileExist stub_h
-	return (stub_h_exists, stub_c_exists)
-
-  | ForeignStubs h_code c_code _ _ <- stubs
-  = do
-	let
-	    stub_c_output_d = pprCode CStyle c_code
-	    stub_c_output_w = showSDoc stub_c_output_d
-	
-	    -- Header file protos for "foreign export"ed functions.
-	    stub_h_output_d = pprCode CStyle h_code
-	    stub_h_output_w = showSDoc stub_h_output_d
-	-- in
-
-	createDirectoryHierarchy (directoryOf stub_c)
-
-	dumpIfSet_dyn dflags Opt_D_dump_foreign
-                      "Foreign export header file" stub_h_output_d
-
-	-- we need the #includes from the rts package for the stub files
-	let rtsid = rtsPackageId (pkgState dflags)
- 	    rts_includes 
-		| ExtPackage pid <- rtsid = 
-			let rts_pkg = getPackageDetails (pkgState dflags) pid in
-			concatMap mk_include (includes rts_pkg)
-		| otherwise = []
-	    mk_include i = "#include \"" ++ i ++ "\"\n"
-
-	stub_h_file_exists
-           <- outputForeignStubs_help stub_h stub_h_output_w
-		("#include \"HsFFI.h\"\n" ++ cplusplus_hdr) cplusplus_ftr
-
-	dumpIfSet_dyn dflags Opt_D_dump_foreign
-                      "Foreign export stubs" stub_c_output_d
-
-	stub_c_file_exists
-           <- outputForeignStubs_help stub_c stub_c_output_w
-		("#define IN_STG_CODE 0\n" ++ 
-		 "#include \"Rts.h\"\n" ++
-		 rts_includes ++
-		 cplusplus_hdr)
-		 cplusplus_ftr
-	   -- We're adding the default hc_header to the stub file, but this
-	   -- isn't really HC code, so we need to define IN_STG_CODE==0 to
-	   -- avoid the register variables etc. being enabled.
-
-        return (stub_h_file_exists, stub_c_file_exists)
-  where
-   (stub_c, stub_h) = mkStubPaths dflags mod location
-
-cplusplus_hdr = "#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
-cplusplus_ftr = "#ifdef __cplusplus\n}\n#endif\n"
-
--- Don't use doOutput for dumping the f. export stubs
--- since it is more than likely that the stubs file will
--- turn out to be empty, in which case no file should be created.
-outputForeignStubs_help fname ""      header footer = return False
-outputForeignStubs_help fname doc_str header footer
-   = do writeFile fname (header ++ doc_str ++ '\n':footer ++ "\n")
-        return True
-\end{code}
-
diff --git a/ghc/compiler/main/Constants.lhs b/ghc/compiler/main/Constants.lhs
deleted file mode 100644
index 43db93249a..0000000000
--- a/ghc/compiler/main/Constants.lhs
+++ /dev/null
@@ -1,150 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Constants]{Info about this compilation}
-
-\begin{code}
-module Constants (module Constants) where
-
--- This magical #include brings in all the everybody-knows-these magic
--- constants unfortunately, we need to be *explicit* about which one
--- we want; if we just hope a -I... will get the right one, we could
--- be in trouble.
-
-#include "HsVersions.h"
-#include "../includes/MachRegs.h"
-#include "../includes/Constants.h"
-#include "../includes/MachDeps.h"
-#include "../includes/DerivedConstants.h"
-
--- import Util
-\end{code}
-
-All pretty arbitrary:
-
-\begin{code}
-mAX_TUPLE_SIZE = (62 :: Int)	-- Should really match the number
-				-- of decls in Data.Tuple
-mAX_CONTEXT_REDUCTION_DEPTH = (20 :: Int)
-\end{code}
-
-
-\begin{code}
--- specialised fun/thunk/constr closure types
-mAX_SPEC_THUNK_SIZE   = (MAX_SPEC_THUNK_SIZE :: Int)
-mAX_SPEC_FUN_SIZE     = (MAX_SPEC_FUN_SIZE :: Int)
-mAX_SPEC_CONSTR_SIZE  = (MAX_SPEC_CONSTR_SIZE :: Int)
-
--- pre-compiled thunk types
-mAX_SPEC_SELECTEE_SIZE	= (MAX_SPEC_SELECTEE_SIZE :: Int)
-mAX_SPEC_AP_SIZE        = (MAX_SPEC_AP_SIZE :: Int)
-
--- closure sizes: these do NOT include the header (see below for header sizes)
-mIN_PAYLOAD_SIZE	= (MIN_PAYLOAD_SIZE::Int)
-\end{code}
-
-\begin{code}
-mIN_INTLIKE, mAX_INTLIKE :: Int	
-mIN_INTLIKE = MIN_INTLIKE
-mAX_INTLIKE = MAX_INTLIKE
-
-mIN_CHARLIKE, mAX_CHARLIKE :: Int
-mIN_CHARLIKE = MIN_CHARLIKE
-mAX_CHARLIKE = MAX_CHARLIKE
-\end{code}
-
-A section of code-generator-related MAGIC CONSTANTS.
-
-\begin{code}
-mAX_FAMILY_SIZE_FOR_VEC_RETURNS = (MAX_VECTORED_RTN::Int)  -- pretty arbitrary
--- If you change this, you may need to change runtimes/standard/Update.lhc
-\end{code}
-
-\begin{code}
-mAX_Vanilla_REG	= (MAX_VANILLA_REG :: Int)
-mAX_Float_REG	= (MAX_FLOAT_REG :: Int)
-mAX_Double_REG	= (MAX_DOUBLE_REG :: Int)
-mAX_Long_REG    = (MAX_LONG_REG  :: Int)
-
-mAX_Real_Vanilla_REG	= (MAX_REAL_VANILLA_REG :: Int)
-mAX_Real_Float_REG	= (MAX_REAL_FLOAT_REG :: Int)
-mAX_Real_Double_REG	= (MAX_REAL_DOUBLE_REG :: Int)
-#ifdef MAX_REAL_LONG_REG
-mAX_Real_Long_REG	= (MAX_REAL_LONG_REG :: Int)
-#else
-mAX_Real_Long_REG       = (0::Int)
-#endif
-\end{code}
-
-Closure header sizes.
-
-\begin{code}
-sTD_HDR_SIZE       = (STD_HDR_SIZE       :: Int)
-pROF_HDR_SIZE      = (PROF_HDR_SIZE      :: Int)
-gRAN_HDR_SIZE      = (GRAN_HDR_SIZE      :: Int)
-\end{code}
-
-Info Table sizes.
-
-\begin{code}
-sTD_ITBL_SIZE   = (STD_ITBL_SIZE   :: Int)
-rET_ITBL_SIZE   = (RET_ITBL_SIZE   :: Int)
-pROF_ITBL_SIZE  = (PROF_ITBL_SIZE  :: Int)
-gRAN_ITBL_SIZE  = (GRAN_ITBL_SIZE  :: Int)
-tICKY_ITBL_SIZE = (TICKY_ITBL_SIZE :: Int)
-\end{code}
-
-Size of a double in StgWords.
-
-\begin{code}
-dOUBLE_SIZE     = SIZEOF_DOUBLE :: Int
-wORD64_SIZE     = 8 :: Int
-iNT64_SIZE      = wORD64_SIZE
-\end{code}
-
-This tells the native code generator the size of the spill
-area is has available.
-
-\begin{code}
-rESERVED_C_STACK_BYTES = (RESERVED_C_STACK_BYTES :: Int)
-\end{code}
-
-The amount of (Haskell) stack to leave free for saving registers when
-returning to the scheduler.
-
-\begin{code}
-rESERVED_STACK_WORDS = (RESERVED_STACK_WORDS :: Int)
-\end{code}
-
-Size of a word, in bytes
-
-\begin{code}
-wORD_SIZE = (SIZEOF_HSWORD :: Int)
-wORD_SIZE_IN_BITS = wORD_SIZE * 8 :: Int
-\end{code}
-
-Size of a C int, in bytes. May be smaller than wORD_SIZE.
-
-\begin{code}
-cINT_SIZE = (SIZEOF_INT :: Int)
-\end{code}
-
-Size of a storage manager block (in bytes).
-
-\begin{code}
-bLOCK_SIZE = (BLOCK_SIZE :: Int)
-bLOCK_SIZE_W = (bLOCK_SIZE `quot` wORD_SIZE :: Int)
-\end{code}
-
-Number of bits to shift a bitfield left by in an info table.
-
-\begin{code}
-bITMAP_BITS_SHIFT = (BITMAP_BITS_SHIFT :: Int)
-\end{code}
-
-Constants derived from headers in ghc/includes, generated by the program
-../includes/mkDerivedConstants.c.
-
-\begin{code}
-#include "../includes/GHCConstants.h"
-\end{code}
diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs
deleted file mode 100644
index 80d906c4a7..0000000000
--- a/ghc/compiler/main/DriverMkDepend.hs
+++ /dev/null
@@ -1,342 +0,0 @@
------------------------------------------------------------------------------
---
--- Makefile Dependency Generation
---
--- (c) The University of Glasgow 2005
---
------------------------------------------------------------------------------
-
-module DriverMkDepend (
-	doMkDependHS
-  ) where
-
-#include "HsVersions.h"
-
-import qualified GHC
-import GHC		( Session, ModSummary(..) )
-import DynFlags		( DynFlags( verbosity, opt_dep ), getOpts )
-import Util		( escapeSpaces, splitFilename, joinFileExt )
-import HscTypes		( HscEnv, IsBootInterface, msObjFilePath, msHsFilePath )
-import Packages		( PackageIdH(..) )
-import SysTools		( newTempName )
-import qualified SysTools
-import Module		( Module, ModLocation(..), mkModule, 
-			  addBootSuffix_maybe )
-import Digraph		( SCC(..) )
-import Finder		( findModule, FindResult(..) )
-import Util             ( global, consIORef )
-import Outputable
-import Panic
-import SrcLoc		( unLoc )
-import CmdLineParser
-
-#if __GLASGOW_HASKELL__ <= 408
-import Panic		( catchJust, ioErrors )
-#endif
-import ErrUtils         ( debugTraceMsg, printErrorsAndWarnings )
-
-import DATA_IOREF	( IORef, readIORef, writeIORef )
-import EXCEPTION
-
-import System		( ExitCode(..), exitWith )
-import Directory
-import IO
-import Monad            ( when )
-import Maybe            ( isJust )
-
------------------------------------------------------------------
---
---		The main function
---
------------------------------------------------------------------
-
-doMkDependHS :: Session -> [FilePath] -> IO ()
-doMkDependHS session srcs
-  = do	{ 	-- Initialisation
-	  dflags <- GHC.getSessionDynFlags session
-	; files <- beginMkDependHS dflags
-
-		-- Do the downsweep to find all the modules
-	; targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
-	; GHC.setTargets session targets
-	; excl_mods <- readIORef v_Dep_exclude_mods
-	; r <- GHC.depanal session excl_mods True {- Allow dup roots -}
-	; case r of
- 	    Nothing -> exitWith (ExitFailure 1)
-	    Just mod_summaries -> do {
-
-		-- Sort into dependency order
-		-- There should be no cycles
-	  let sorted = GHC.topSortModuleGraph False mod_summaries Nothing
-
-		-- Print out the dependencies if wanted
-	; debugTraceMsg dflags 2 (text "Module dependencies" $$ ppr sorted)
-
-		-- Prcess them one by one, dumping results into makefile
-		-- and complaining about cycles
-	; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted
-
-		-- Tidy up
-	; endMkDependHS dflags files }}
-
------------------------------------------------------------------
---
---		beginMkDependHs
---	Create a temporary file, 
---	find the Makefile, 
---	slurp through it, etc
---
------------------------------------------------------------------
-
-data MkDepFiles 
-  = MkDep { mkd_make_file :: FilePath,		-- Name of the makefile
-	    mkd_make_hdl  :: Maybe Handle, 	-- Handle for the open makefile 
-	    mkd_tmp_file  :: FilePath,		-- Name of the temporary file
-	    mkd_tmp_hdl   :: Handle }		-- Handle of the open temporary file
-
-beginMkDependHS :: DynFlags -> IO MkDepFiles
-	
-beginMkDependHS dflags = do
-  	-- slurp in the mkdependHS-style options
-  let flags = getOpts dflags opt_dep
-  _ <- processArgs dep_opts flags
-
-     	-- open a new temp file in which to stuff the dependency info
-     	-- as we go along.
-  tmp_file <- newTempName dflags "dep"
-  tmp_hdl <- openFile tmp_file WriteMode
-
-  	-- open the makefile
-  makefile <- readIORef v_Dep_makefile
-  exists <- doesFileExist makefile
-  mb_make_hdl <- 
-	if not exists
-	then return Nothing
-	else do
-  	   makefile_hdl <- openFile makefile ReadMode
-
-		-- slurp through until we get the magic start string,
-		-- copying the contents into dep_makefile
-  	   let slurp = do
-		l <- hGetLine makefile_hdl
-		if (l == depStartMarker)
-			then return ()
-			else do hPutStrLn tmp_hdl l; slurp
-	 
-		-- slurp through until we get the magic end marker,
-		-- throwing away the contents
-  	   let chuck = do
-		l <- hGetLine makefile_hdl
-		if (l == depEndMarker)
-			then return ()
-			else chuck
-	 
-	   catchJust ioErrors slurp 
-		(\e -> if isEOFError e then return () else ioError e)
-	   catchJust ioErrors chuck
-		(\e -> if isEOFError e then return () else ioError e)
-
-	   return (Just makefile_hdl)
-
-
-	-- write the magic marker into the tmp file
-  hPutStrLn tmp_hdl depStartMarker
-
-  return (MkDep { mkd_make_file = makefile, mkd_make_hdl = mb_make_hdl, 
-		  mkd_tmp_file  = tmp_file, mkd_tmp_hdl  = tmp_hdl})
-
-
------------------------------------------------------------------
---
---		processDeps
---
------------------------------------------------------------------
-
-processDeps :: Session
-	    -> [Module]
-	    -> Handle		-- Write dependencies to here
-	    -> SCC ModSummary
-	    -> IO ()
--- Write suitable dependencies to handle
--- Always:
--- 			this.o : this.hs
---
--- If the dependency is on something other than a .hi file:
---   			this.o this.p_o ... : dep
--- otherwise
---   			this.o ...   : dep.hi
---   			this.p_o ... : dep.p_hi
---   			...
--- (where .o is $osuf, and the other suffixes come from
--- the cmdline -s options).
---
--- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
-
-processDeps session excl_mods hdl (CyclicSCC nodes)
-  =	-- There shouldn't be any cycles; report them	
-    throwDyn (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
-
-processDeps session excl_mods hdl (AcyclicSCC node)
-  = do	{ extra_suffixes   <- readIORef v_Dep_suffixes
-	; hsc_env <- GHC.sessionHscEnv session
-	; include_pkg_deps <- readIORef v_Dep_include_pkg_deps
-	; let src_file  = msHsFilePath node
-	      obj_file  = msObjFilePath node
-	      obj_files = insertSuffixes obj_file extra_suffixes
-
-	      do_imp is_boot imp_mod
-		= do { mb_hi <- findDependency hsc_env src_file imp_mod 
-					       is_boot include_pkg_deps
-		     ; case mb_hi of {
-			   Nothing      -> return () ;
-			   Just hi_file -> do
-		     { let hi_files = insertSuffixes hi_file extra_suffixes
-			   write_dep (obj,hi) = writeDependency hdl [obj] hi
-
-			-- Add one dependency for each suffix; 
-			-- e.g.		A.o   : B.hi
-			--		A.x_o : B.x_hi
-		     ; mapM_ write_dep (obj_files `zip` hi_files) }}}
-
-	     
-	  	-- Emit std dependency of the object(s) on the source file
-		-- Something like 	A.o : A.hs
-	; writeDependency hdl obj_files src_file
-
-		-- Emit a dependency for each import
-
-	-- SOURCE imports
-	; mapM_ (do_imp True)  
-		(filter (`notElem` excl_mods) (map unLoc (ms_srcimps node)))
-
-	-- regular imports
-	; mapM_ (do_imp False)
-		(filter (`notElem` excl_mods) (map unLoc (ms_imps node)))
-	}
-
-
-findDependency	:: HscEnv
-		-> FilePath 		-- Importing module: used only for error msg
-		-> Module		-- Imported module
-		-> IsBootInterface	-- Source import
-		-> Bool			-- Record dependency on package modules
-		-> IO (Maybe FilePath)	-- Interface file file
-findDependency hsc_env src imp is_boot include_pkg_deps
-  = do	{ 	-- Find the module; this will be fast because
-		-- we've done it once during downsweep
-	  r <- findModule hsc_env imp True {-explicit-}
-	; case r of 
-	    Found loc pkg
-		-- Not in this package: we don't need a dependency
-		| ExtPackage _ <- pkg, not include_pkg_deps
-		-> return Nothing
-
-		-- Home package: just depend on the .hi or hi-boot file
-		| otherwise
-		-> return (Just (addBootSuffix_maybe is_boot (ml_hi_file loc)))
-
-	    _ -> panic "findDependency"
-	}
-
------------------------------
-writeDependency :: Handle -> [FilePath] -> FilePath -> IO ()
--- (writeDependency h [t1,t2] dep) writes to handle h the dependency
---	t1 t2 : dep
-writeDependency hdl targets dep
-  = hPutStrLn hdl (unwords (map escapeSpaces targets) ++ " : "
-		   ++ escapeSpaces dep)
-
------------------------------
-insertSuffixes	
-	:: FilePath 	-- Original filename;	e.g. "foo.o"
-	-> [String]	-- Extra suffices	e.g. ["x","y"]
-	-> [FilePath]	-- Zapped filenames	e.g. ["foo.o", "foo.x_o", "foo.y_o"]
-	-- Note that that the extra bit gets inserted *before* the old suffix
-	-- We assume the old suffix contains no dots, so we can strip it with removeSuffix
-
-	-- NOTE: we used to have this comment
-		-- In order to construct hi files with alternate suffixes, we
-		-- now have to find the "basename" of the hi file.  This is
-		-- difficult because we can't just split the hi filename
-		-- at the last dot - the hisuf might have dots in it.  So we
-		-- check whether the hi filename ends in hisuf, and if it does,
-		-- we strip off hisuf, otherwise we strip everything after the
-		-- last dot.
-	-- But I'm not sure we care about hisufs with dots in them. 
-	-- Lots of other things will break first!
-
-insertSuffixes file_name extras
-  = file_name : [ basename `joinFileExt` (extra ++ "_" ++ suffix) | extra <- extras ]
-  where
-    (basename, suffix) = splitFilename file_name
-
-
------------------------------------------------------------------
---
---		endMkDependHs
---	Complete the makefile, close the tmp file etc
---
------------------------------------------------------------------
-
-endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
-
-endMkDependHS dflags 
-   (MkDep { mkd_make_file = makefile, mkd_make_hdl =  makefile_hdl,
-            mkd_tmp_file  = tmp_file, mkd_tmp_hdl  =  tmp_hdl }) 
-  = do
-  -- write the magic marker into the tmp file
-  hPutStrLn tmp_hdl depEndMarker
-
-  case makefile_hdl of
-     Nothing  -> return ()
-     Just hdl -> do
-
-	  -- slurp the rest of the original makefile and copy it into the output
-  	let slurp = do
-		l <- hGetLine hdl
-		hPutStrLn tmp_hdl l
-		slurp
-	 
-  	catchJust ioErrors slurp 
-		(\e -> if isEOFError e then return () else ioError e)
-
-	hClose hdl
-
-  hClose tmp_hdl  -- make sure it's flushed
-
-	-- Create a backup of the original makefile
-  when (isJust makefile_hdl)
-       (SysTools.copy dflags ("Backing up " ++ makefile) 
-	  makefile (makefile++".bak"))
-
-  	-- Copy the new makefile in place
-  SysTools.copy dflags "Installing new makefile" tmp_file makefile
-
-
------------------------------------------------------------------
---
---		Flags
---
------------------------------------------------------------------
-
-	-- Flags
-GLOBAL_VAR(v_Dep_makefile, 		"Makefile", String);
-GLOBAL_VAR(v_Dep_include_pkg_deps, 	False, Bool);
-GLOBAL_VAR(v_Dep_exclude_mods,          [], [Module]);
-GLOBAL_VAR(v_Dep_suffixes,		[], [String]);
-GLOBAL_VAR(v_Dep_warnings,		True, Bool);
-
-depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
-depEndMarker   = "# DO NOT DELETE: End of Haskell dependencies"
-
--- for compatibility with the old mkDependHS, we accept options of the form
--- -optdep-f -optdep.depend, etc.
-dep_opts = 
-   [ (  "s", 			SepArg (consIORef v_Dep_suffixes) )
-   , (  "f", 			SepArg (writeIORef v_Dep_makefile) )
-   , (  "w", 			NoArg (writeIORef v_Dep_warnings False) )
-   , (  "-include-prelude",  	NoArg (writeIORef v_Dep_include_pkg_deps True) )
-   , (  "-include-pkg-deps",  	NoArg (writeIORef v_Dep_include_pkg_deps True) )
-   , (  "-exclude-module=",     Prefix (consIORef v_Dep_exclude_mods . mkModule) )
-   , (  "x",                    Prefix (consIORef v_Dep_exclude_mods . mkModule) )
-   ]
diff --git a/ghc/compiler/main/DriverPhases.hs b/ghc/compiler/main/DriverPhases.hs
deleted file mode 100644
index 6e945314cb..0000000000
--- a/ghc/compiler/main/DriverPhases.hs
+++ /dev/null
@@ -1,229 +0,0 @@
------------------------------------------------------------------------------
---  $Id: DriverPhases.hs,v 1.38 2005/05/17 11:01:59 simonmar Exp $
---
--- GHC Driver
---
--- (c) The University of Glasgow 2002
---
------------------------------------------------------------------------------
-
-module DriverPhases (
-   HscSource(..), isHsBoot, hscSourceString,
-   Phase(..),
-   happensBefore, eqPhase, anyHsc, isStopLn,
-   startPhase,		-- :: String -> Phase
-   phaseInputExt, 	-- :: Phase -> String
-
-   isHaskellishSuffix, 
-   isHaskellSrcSuffix,
-   isObjectSuffix,
-   isCishSuffix,
-   isExtCoreSuffix,
-   isDynLibSuffix,
-   isHaskellUserSrcSuffix,
-   isSourceSuffix,
-
-   isHaskellishFilename, 
-   isHaskellSrcFilename,
-   isObjectFilename,
-   isCishFilename,
-   isExtCoreFilename,
-   isDynLibFilename,
-   isHaskellUserSrcFilename,
-   isSourceFilename         -- :: FilePath -> Bool
- ) where
-
-import Util		( suffixOf )
-import Panic		( panic )
-
------------------------------------------------------------------------------
--- Phases
-
-{-
-   Phase of the           | Suffix saying | Flag saying   | (suffix of)
-   compilation system     | ``start here''| ``stop after''| output file
-   
-   literate pre-processor | .lhs          | -             | -
-   C pre-processor (opt.) | -             | -E            | -
-   Haskell compiler       | .hs           | -C, -S        | .hc, .s
-   C compiler (opt.)      | .hc or .c     | -S            | .s
-   assembler              | .s  or .S     | -c            | .o
-   linker                 | other         | -             | a.out
--}
-
-data HscSource
-   = HsSrcFile | HsBootFile | ExtCoreFile
-     deriving( Eq, Ord, Show )
-	-- Ord needed for the finite maps we build in CompManager
-
-
-hscSourceString :: HscSource -> String
-hscSourceString HsSrcFile   = ""
-hscSourceString HsBootFile  = "[boot]"
-hscSourceString ExtCoreFile = "[ext core]"
-
-isHsBoot :: HscSource -> Bool
-isHsBoot HsBootFile = True
-isHsBoot other      = False
-
-data Phase 
-	= Unlit HscSource
-	| Cpp   HscSource
-	| HsPp  HscSource
-	| Hsc   HscSource
-	| Cc
-	| HCc		-- Haskellised C (as opposed to vanilla C) compilation
-	| Mangle	-- assembly mangling, now done by a separate script.
-	| SplitMangle	-- after mangler if splitting
-	| SplitAs
-	| As
-	| CmmCpp	-- pre-process Cmm source
-	| Cmm		-- parse & compile Cmm code
-
-	-- The final phase is a pseudo-phase that tells the pipeline to stop.
-	-- There is no runPhase case for it.
-	| StopLn	-- Stop, but linking will follow, so generate .o file
-  deriving (Eq, Show)
-
-anyHsc :: Phase
-anyHsc = Hsc (panic "anyHsc")
-
-isStopLn :: Phase -> Bool
-isStopLn StopLn = True
-isStopLn other  = False
-
-eqPhase :: Phase -> Phase -> Bool
--- Equality of constructors, ignoring the HscSource field
--- NB: the HscSource field can be 'bot'; see anyHsc above
-eqPhase (Unlit _)   (Unlit _) 	= True
-eqPhase (Cpp   _)   (Cpp   _) 	= True
-eqPhase (HsPp  _)   (HsPp  _) 	= True
-eqPhase (Hsc   _)   (Hsc   _) 	= True
-eqPhase Cc	    Cc	        = True
-eqPhase HCc	    HCc		= True
-eqPhase Mangle	    Mangle    	= True
-eqPhase SplitMangle SplitMangle = True
-eqPhase SplitAs	    SplitAs 	= True
-eqPhase As	    As 		= True
-eqPhase CmmCpp	    CmmCpp 	= True
-eqPhase Cmm	    Cmm 	= True
-eqPhase StopLn	    StopLn	= True
-eqPhase _	    _		= False
-
--- Partial ordering on phases: we want to know which phases will occur before 
--- which others.  This is used for sanity checking, to ensure that the
--- pipeline will stop at some point (see DriverPipeline.runPipeline).
-StopLn `happensBefore` y = False
-x      `happensBefore` y = after_x `eqPhase` y || after_x `happensBefore` y
-	where
-	  after_x = nextPhase x
-
-nextPhase :: Phase -> Phase
--- A conservative approximation the next phase, used in happensBefore
-nextPhase (Unlit sf)	= Cpp  sf
-nextPhase (Cpp   sf)	= HsPp sf
-nextPhase (HsPp  sf)	= Hsc  sf
-nextPhase (Hsc   sf)	= HCc
-nextPhase HCc		= Mangle
-nextPhase Mangle	= SplitMangle
-nextPhase SplitMangle	= As
-nextPhase As		= SplitAs
-nextPhase SplitAs	= StopLn
-nextPhase Cc		= As
-nextPhase CmmCpp	= Cmm
-nextPhase Cmm		= HCc
-nextPhase StopLn	= panic "nextPhase: nothing after StopLn"
-
--- the first compilation phase for a given file is determined
--- by its suffix.
-startPhase "lhs"      = Unlit HsSrcFile
-startPhase "lhs-boot" = Unlit HsBootFile
-startPhase "hs"       = Cpp   HsSrcFile
-startPhase "hs-boot"  = Cpp   HsBootFile
-startPhase "hscpp"    = HsPp  HsSrcFile
-startPhase "hspp"     = Hsc   HsSrcFile
-startPhase "hcr"      = Hsc   ExtCoreFile
-startPhase "hc"       = HCc
-startPhase "c"        = Cc
-startPhase "cpp"      = Cc
-startPhase "C"        = Cc
-startPhase "cc"       = Cc
-startPhase "cxx"      = Cc
-startPhase "raw_s"    = Mangle
-startPhase "split_s"  = SplitMangle
-startPhase "s"        = As
-startPhase "S"        = As
-startPhase "o"        = StopLn
-startPhase "cmm"      = CmmCpp
-startPhase "cmmcpp"   = Cmm
-startPhase _          = StopLn	   -- all unknown file types
-
--- This is used to determine the extension for the output from the
--- current phase (if it generates a new file).  The extension depends
--- on the next phase in the pipeline.
-phaseInputExt (Unlit HsSrcFile)   = "lhs"
-phaseInputExt (Unlit HsBootFile)  = "lhs-boot"
-phaseInputExt (Unlit ExtCoreFile) = "lhcr"
-phaseInputExt (Cpp   _)  	  = "lpp"	-- intermediate only
-phaseInputExt (HsPp  _)		  = "hscpp"	-- intermediate only
-phaseInputExt (Hsc   _)  	  = "hspp"	-- intermediate only
-	-- NB: as things stand, phaseInputExt (Hsc x) must not evaluate x
-	--     because runPipeline uses the StopBefore phase to pick the
-	--     output filename.  That could be fixed, but watch out.
-phaseInputExt HCc         	  = "hc"  
-phaseInputExt Cc          	  = "c"
-phaseInputExt Mangle      	  = "raw_s"
-phaseInputExt SplitMangle 	  = "split_s"	-- not really generated
-phaseInputExt As          	  = "s"
-phaseInputExt SplitAs     	  = "split_s"   -- not really generated
-phaseInputExt CmmCpp	  	  = "cmm"
-phaseInputExt Cmm	  	  = "cmmcpp"
-phaseInputExt StopLn          	  = "o"
-#ifdef ILX
-phaseInputExt Ilx2Il      	  = "ilx"
-phaseInputExt Ilasm       	  = "il"
-#endif
-
-haskellish_src_suffixes      = haskellish_user_src_suffixes ++
-			       [ "hspp", "hscpp", "hcr", "cmm" ]
-haskellish_suffixes          = haskellish_src_suffixes ++ ["hc", "raw_s"]
-cish_suffixes                = [ "c", "cpp", "C", "cc", "cxx", "s", "S" ]
-extcoreish_suffixes          = [ "hcr" ]
-haskellish_user_src_suffixes = [ "hs", "lhs", "hs-boot", "lhs-boot" ]	-- Will not be deleted as temp files
-
--- Use the appropriate suffix for the system on which 
--- the GHC-compiled code will run
-#if mingw32_TARGET_OS || cygwin32_TARGET_OS
-objish_suffixes     = [ "o", "O", "obj", "OBJ" ]
-#else
-objish_suffixes     = [ "o" ]
-#endif
-
-#ifdef mingw32_TARGET_OS
-dynlib_suffixes = ["dll", "DLL"]
-#elif defined(darwin_TARGET_OS)
-dynlib_suffixes = ["dylib"]
-#else
-dynlib_suffixes = ["so"]
-#endif
-
-isHaskellishSuffix     s = s `elem` haskellish_suffixes
-isHaskellSrcSuffix     s = s `elem` haskellish_src_suffixes
-isCishSuffix           s = s `elem` cish_suffixes
-isExtCoreSuffix        s = s `elem` extcoreish_suffixes
-isObjectSuffix         s = s `elem` objish_suffixes
-isHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes
-isDynLibSuffix	       s = s `elem` dynlib_suffixes
-
-isSourceSuffix suff  = isHaskellishSuffix suff || isCishSuffix suff
-
-isHaskellishFilename     f = isHaskellishSuffix     (suffixOf f)
-isHaskellSrcFilename     f = isHaskellSrcSuffix     (suffixOf f)
-isCishFilename           f = isCishSuffix           (suffixOf f)
-isExtCoreFilename        f = isExtCoreSuffix        (suffixOf f)
-isObjectFilename         f = isObjectSuffix         (suffixOf f)
-isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (suffixOf f)
-isDynLibFilename	 f = isDynLibSuffix         (suffixOf f)
-isSourceFilename 	 f = isSourceSuffix 	    (suffixOf f)
-
-
diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
deleted file mode 100644
index e20bc56940..0000000000
--- a/ghc/compiler/main/DriverPipeline.hs
+++ /dev/null
@@ -1,1405 +0,0 @@
------------------------------------------------------------------------------
---
--- GHC Driver
---
--- (c) The University of Glasgow 2005
---
------------------------------------------------------------------------------
-
-module DriverPipeline (
-	-- Run a series of compilation steps in a pipeline, for a
-	-- collection of source files.
-   oneShot, compileFile,
-
-	-- Interfaces for the batch-mode driver
-   staticLink,
-
-	-- Interfaces for the compilation manager (interpreted/batch-mode)
-   preprocess, 
-   compile, CompResult(..), 
-   link, 
-
-        -- DLL building
-   doMkDLL,
-
-  ) where
-
-#include "HsVersions.h"
-
-import Packages
-import HeaderInfo
-import DriverPhases
-import SysTools		( newTempName, addFilesToClean, getSysMan, copy )
-import qualified SysTools	
-import HscMain
-import Finder
-import HscTypes
-import Outputable
-import Module
-import ErrUtils
-import DynFlags
-import StaticFlags	( v_Ld_inputs, opt_Static, WayName(..) )
-import Config
-import Panic
-import Util
-import StringBuffer	( hGetStringBuffer )
-import BasicTypes	( SuccessFlag(..) )
-import Maybes		( expectJust )
-import ParserCoreUtils	( getCoreModuleName )
-import SrcLoc		( unLoc )
-import SrcLoc		( Located(..) )
-
-import EXCEPTION
-import DATA_IOREF	( readIORef, writeIORef, IORef )
-import GLAEXTS		( Int(..) )
-
-import Directory
-import System
-import IO
-import Monad
-import Data.List	( isSuffixOf )
-import Maybe
-
-
--- ---------------------------------------------------------------------------
--- Pre-process
-
--- Just preprocess a file, put the result in a temp. file (used by the
--- compilation manager during the summary phase).
---
--- We return the augmented DynFlags, because they contain the result
--- of slurping in the OPTIONS pragmas
-
-preprocess :: DynFlags -> (FilePath, Maybe Phase) -> IO (DynFlags, FilePath)
-preprocess dflags (filename, mb_phase) =
-  ASSERT2(isJust mb_phase || isHaskellSrcFilename filename, text filename) 
-  runPipeline anyHsc dflags (filename, mb_phase) Temporary Nothing{-no ModLocation-}
-
--- ---------------------------------------------------------------------------
--- Compile
-
--- Compile a single module, under the control of the compilation manager.
---
--- This is the interface between the compilation manager and the
--- compiler proper (hsc), where we deal with tedious details like
--- reading the OPTIONS pragma from the source file, and passing the
--- output of hsc through the C compiler.
-
--- NB.  No old interface can also mean that the source has changed.
-
-compile :: HscEnv
-	-> ModSummary
-	-> Maybe Linkable	-- Just linkable <=> source unchanged
-        -> Maybe ModIface       -- Old interface, if available
-        -> Int -> Int
-        -> IO CompResult
-
-data CompResult
-   = CompOK   ModDetails 	-- New details
-              ModIface		-- New iface
-              (Maybe Linkable)	-- a Maybe, for the same reasons as hm_linkable
-
-   | CompErrs 
-
-
-compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do 
-
-   let dflags0     = ms_hspp_opts mod_summary
-       this_mod    = ms_mod mod_summary
-       src_flavour = ms_hsc_src mod_summary
-
-       have_object 
-	       | Just l <- maybe_old_linkable, isObjectLinkable l = True
-	       | otherwise = False
-
-   -- FIXME: We need to know whether or not we're recompiling the file. Move this to HscMain?
-   --showPass dflags0 ("Compiling " ++ showModMsg have_object mod_summary)
-
-   let location	  = ms_location mod_summary
-   let input_fn   = expectJust "compile:hs" (ml_hs_file location) 
-   let input_fnpp = ms_hspp_file mod_summary
-
-   debugTraceMsg dflags0 2 (text "compile: input file" <+> text input_fnpp)
-
-   let (basename, _) = splitFilename input_fn
-
-  -- We add the directory in which the .hs files resides) to the import path.
-  -- This is needed when we try to compile the .hc file later, if it
-  -- imports a _stub.h file that we created here.
-   let current_dir = directoryOf basename
-       old_paths   = includePaths dflags0
-       dflags      = dflags0 { includePaths = current_dir : old_paths }
-
-   -- Figure out what lang we're generating
-   let hsc_lang = hscMaybeAdjustTarget dflags StopLn src_flavour (hscTarget dflags)
-   -- ... and what the next phase should be
-   let next_phase = hscNextPhase dflags src_flavour hsc_lang
-   -- ... and what file to generate the output into
-   output_fn <- getOutputFilename dflags next_phase 
-			Temporary basename next_phase (Just location)
-
-   let dflags' = dflags { hscTarget = hsc_lang,
-				hscOutName = output_fn,
-				extCoreName = basename ++ ".hcr" }
-
-   -- -no-recomp should also work with --make
-   let do_recomp = dopt Opt_RecompChecking dflags
-       source_unchanged = isJust maybe_old_linkable && do_recomp
-       hsc_env' = hsc_env { hsc_dflags = dflags' }
-       object_filename = ml_obj_file location
-
-   let getStubLinkable False = return []
-       getStubLinkable True
-           = do stub_o <- compileStub dflags' this_mod location
-                return [ DotO stub_o ]
-
-       handleBatch (HscNoRecomp, iface, details)
-           = ASSERT (isJust maybe_old_linkable)
-             return (CompOK details iface maybe_old_linkable)
-       handleBatch (HscRecomp hasStub, iface, details)
-           | isHsBoot src_flavour
-               = return (CompOK details iface Nothing)
-           | otherwise
-               = do stub_unlinked <- getStubLinkable hasStub
-                    (hs_unlinked, unlinked_time) <-
-                        case hsc_lang of
-                          HscNothing
-                            -> return ([], ms_hs_date mod_summary)
-                          -- We're in --make mode: finish the compilation pipeline.
-                          _other
-                            -> do runPipeline StopLn dflags (output_fn,Nothing) Persistent
-                                              (Just location)
-                                  -- The object filename comes from the ModLocation
-                                  o_time <- getModificationTime object_filename
-                                  return ([DotO object_filename], o_time)
-                    let linkable = LM unlinked_time this_mod
-			           (hs_unlinked ++ stub_unlinked)
-                    return (CompOK details iface (Just linkable))
-
-       handleInterpreted (InteractiveNoRecomp, iface, details)
-           = ASSERT (isJust maybe_old_linkable)
-             return (CompOK details iface maybe_old_linkable)
-       handleInterpreted (InteractiveRecomp hasStub comp_bc, iface, details)
-           = do stub_unlinked <- getStubLinkable hasStub
-                let hs_unlinked = [BCOs comp_bc]
-                    unlinked_time = ms_hs_date mod_summary
-                  -- Why do we use the timestamp of the source file here,
-                  -- rather than the current time?  This works better in
-                  -- the case where the local clock is out of sync
-                  -- with the filesystem's clock.  It's just as accurate:
-                  -- if the source is modified, then the linkable will
-                  -- be out of date.
-                let linkable = LM unlinked_time this_mod
-                               (hs_unlinked ++ stub_unlinked)
-                return (CompOK details iface (Just linkable))
-
-   let runCompiler compiler handle
-           = do mbResult <- compiler hsc_env' mod_summary
-                                     source_unchanged old_iface
-                                     (Just (mod_index, nmods))
-                case mbResult of
-                  Nothing     -> return CompErrs
-                  Just result -> handle result
-   -- run the compiler
-   case hsc_lang of
-     HscInterpreted | not (isHsBoot src_flavour) -- We can't compile boot files to
-                                                 -- bytecode so don't even try.
-         -> runCompiler hscCompileInteractive handleInterpreted
-     HscNothing
-         -> runCompiler hscCompileNothing handleBatch
-     _other
-         -> runCompiler hscCompileBatch handleBatch
-
------------------------------------------------------------------------------
--- stub .h and .c files (for foreign export support)
-
--- The _stub.c file is derived from the haskell source file, possibly taking
--- into account the -stubdir option.
---
--- Consequently, we derive the _stub.o filename from the haskell object
--- filename.  
---
--- This isn't necessarily the same as the object filename we
--- would get if we just compiled the _stub.c file using the pipeline.
--- For example:
---
---    ghc src/A.hs -odir obj
--- 
--- results in obj/A.o, and src/A_stub.c.  If we compile src/A_stub.c with
--- -odir obj, we would get obj/src/A_stub.o, which is wrong; we want
--- obj/A_stub.o.
-
-compileStub :: DynFlags -> Module -> ModLocation -> IO FilePath
-compileStub dflags mod location = do
-	let (o_base, o_ext) = splitFilename (ml_obj_file location)
-	    stub_o = o_base ++ "_stub" `joinFileExt` o_ext
-
-	-- compile the _stub.c file w/ gcc
-	let (stub_c,_) = mkStubPaths dflags mod location
-	runPipeline StopLn dflags (stub_c,Nothing) 
-		(SpecificFile stub_o) Nothing{-no ModLocation-}
-
-	return stub_o
-
-
--- ---------------------------------------------------------------------------
--- Link
-
-link :: GhcMode			-- interactive or batch
-     -> DynFlags		-- dynamic flags
-     -> Bool			-- attempt linking in batch mode?
-     -> HomePackageTable	-- what to link
-     -> IO SuccessFlag
-
--- For the moment, in the batch linker, we don't bother to tell doLink
--- which packages to link -- it just tries all that are available.
--- batch_attempt_linking should only be *looked at* in batch mode.  It
--- should only be True if the upsweep was successful and someone
--- exports main, i.e., we have good reason to believe that linking
--- will succeed.
-
-#ifdef GHCI
-link Interactive dflags batch_attempt_linking hpt
-    = do -- Not Linking...(demand linker will do the job)
-	 return Succeeded
-#endif
-
-link JustTypecheck dflags batch_attempt_linking hpt
-   = return Succeeded
-
-link BatchCompile dflags batch_attempt_linking hpt
-   | batch_attempt_linking
-   = do 
-	let 
-	    home_mod_infos = moduleEnvElts hpt
-
-	    -- the packages we depend on
-	    pkg_deps  = concatMap (dep_pkgs . mi_deps . hm_iface) home_mod_infos
-
-	    -- the linkables to link
-	    linkables = map (expectJust "link".hm_linkable) home_mod_infos
-
-        debugTraceMsg dflags 3 (text "link: linkables are ..." $$ vcat (map ppr linkables))
-
-	-- check for the -no-link flag
-	if isNoLink (ghcLink dflags)
-	  then do debugTraceMsg dflags 3 (text "link(batch): linking omitted (-c flag given).")
-	          return Succeeded
-	  else do
-
-	let getOfiles (LM _ _ us) = map nameOfObject (filter isObject us)
-	    obj_files = concatMap getOfiles linkables
-
-	    exe_file = exeFileName dflags
-
-	-- if the modification time on the executable is later than the
-	-- modification times on all of the objects, then omit linking
-	-- (unless the -no-recomp flag was given).
-	e_exe_time <- IO.try $ getModificationTime exe_file
-	let linking_needed 
-		| Left _  <- e_exe_time = True
-		| Right t <- e_exe_time = 
-			any (t <) (map linkableTime linkables)
-
-	if dopt Opt_RecompChecking dflags && not linking_needed
-	   then do debugTraceMsg dflags 1 (text exe_file <+> ptext SLIT("is up to date, linking not required."))
-		   return Succeeded
-	   else do
-
-	debugTraceMsg dflags 1 (ptext SLIT("Linking") <+> text exe_file
-				 <+> text "...")
-
-	-- Don't showPass in Batch mode; doLink will do that for us.
-	let link = case ghcLink dflags of
-	        MkDLL       -> doMkDLL
-	        StaticLink  -> staticLink
-	link dflags obj_files pkg_deps
-
-        debugTraceMsg dflags 3 (text "link: done")
-
-	-- staticLink only returns if it succeeds
-        return Succeeded
-
-   | otherwise
-   = do debugTraceMsg dflags 3 (text "link(batch): upsweep (partially) failed OR" $$
-                                text "   Main.main not exported; not linking.")
-        return Succeeded
-      
-
--- -----------------------------------------------------------------------------
--- Compile files in one-shot mode.
-
-oneShot :: DynFlags -> Phase -> [(String, Maybe Phase)] -> IO ()
-oneShot dflags stop_phase srcs = do
-  o_files <- mapM (compileFile dflags stop_phase) srcs
-  doLink dflags stop_phase o_files
-
-compileFile :: DynFlags -> Phase -> (FilePath, Maybe Phase) -> IO FilePath
-compileFile dflags stop_phase (src, mb_phase) = do
-   exists <- doesFileExist src
-   when (not exists) $ 
-   	throwDyn (CmdLineError ("does not exist: " ++ src))
-   
-   let
-	split     = dopt Opt_SplitObjs dflags
-	mb_o_file = outputFile dflags
-	ghc_link  = ghcLink dflags	-- Set by -c or -no-link
-
-	-- When linking, the -o argument refers to the linker's output.	
-	-- otherwise, we use it as the name for the pipeline's output.
-        output
-	 | StopLn <- stop_phase, not (isNoLink ghc_link) = Persistent
-		-- -o foo applies to linker
-	 | Just o_file <- mb_o_file = SpecificFile o_file
-		-- -o foo applies to the file we are compiling now
-	 | otherwise = Persistent
-
-        stop_phase' = case stop_phase of 
-			As | split -> SplitAs
-			other      -> stop_phase
-
-   (_, out_file) <- runPipeline stop_phase' dflags
-			  (src, mb_phase) output Nothing{-no ModLocation-}
-   return out_file
-
-
-doLink :: DynFlags -> Phase -> [FilePath] -> IO ()
-doLink dflags stop_phase o_files
-  | not (isStopLn stop_phase)
-  = return ()		-- We stopped before the linking phase
-
-  | otherwise
-  = case ghcLink dflags of
-	NoLink     -> return ()
-	StaticLink -> staticLink dflags o_files link_pkgs
-	MkDLL      -> doMkDLL dflags o_files link_pkgs
-  where
-   -- Always link in the haskell98 package for static linking.  Other
-   -- packages have to be specified via the -package flag.
-    link_pkgs
-	  | ExtPackage h98_id <- haskell98PackageId (pkgState dflags) = [h98_id]
-	  | otherwise = []
-
-
--- ---------------------------------------------------------------------------
--- Run a compilation pipeline, consisting of multiple phases.
-
--- This is the interface to the compilation pipeline, which runs
--- a series of compilation steps on a single source file, specifying
--- at which stage to stop.
-
--- The DynFlags can be modified by phases in the pipeline (eg. by
--- GHC_OPTIONS pragmas), and the changes affect later phases in the
--- pipeline.
-
-data PipelineOutput 
-  = Temporary
-	-- output should be to a temporary file: we're going to
-	-- run more compilation steps on this output later
-  | Persistent
-	-- we want a persistent file, i.e. a file in the current directory
-	-- derived from the input filename, but with the appropriate extension.
-	-- eg. in "ghc -c Foo.hs" the output goes into ./Foo.o.
-  | SpecificFile FilePath
-	-- the output must go into the specified file.
-
-runPipeline
-  :: Phase		        -- When to stop
-  -> DynFlags		        -- Dynamic flags
-  -> (FilePath,Maybe Phase)     -- Input filename (and maybe -x suffix)
-  -> PipelineOutput	        -- Output filename
-  -> Maybe ModLocation          -- A ModLocation, if this is a Haskell module
-  -> IO (DynFlags, FilePath)	-- (final flags, output filename)
-
-runPipeline stop_phase dflags (input_fn, mb_phase) output maybe_loc
-  = do
-  let (basename, suffix) = splitFilename input_fn
-
-	-- If we were given a -x flag, then use that phase to start from
-      start_phase
-	| Just x_phase <- mb_phase = x_phase
-	| otherwise                = startPhase suffix
-
-  -- We want to catch cases of "you can't get there from here" before
-  -- we start the pipeline, because otherwise it will just run off the
-  -- end.
-  --
-  -- There is a partial ordering on phases, where A < B iff A occurs
-  -- before B in a normal compilation pipeline.
-
-  when (not (start_phase `happensBefore` stop_phase)) $
-	throwDyn (UsageError 
-		    ("cannot compile this file to desired target: "
-		       ++ input_fn))
-
-  -- this is a function which will be used to calculate output file names
-  -- as we go along (we partially apply it to some of its inputs here)
-  let get_output_fn = getOutputFilename dflags stop_phase output basename
-
-  -- Execute the pipeline...
-  (dflags', output_fn, maybe_loc) <- 
-	pipeLoop dflags start_phase stop_phase input_fn 
-	  	 basename suffix get_output_fn maybe_loc
-
-  -- Sometimes, a compilation phase doesn't actually generate any output
-  -- (eg. the CPP phase when -fcpp is not turned on).  If we end on this
-  -- stage, but we wanted to keep the output, then we have to explicitly
-  -- copy the file.
-  case output of
-    Temporary -> 
-	return (dflags', output_fn)
-    _other ->
-	do final_fn <- get_output_fn stop_phase maybe_loc
-	   when (final_fn /= output_fn) $
-		  copy dflags ("Copying `" ++ output_fn ++ "' to `" ++ final_fn
-			++ "'") output_fn final_fn
-	   return (dflags', final_fn)
-	        
-
-
-pipeLoop :: DynFlags -> Phase -> Phase 
-	 -> FilePath  -> String -> Suffix
-	 -> (Phase -> Maybe ModLocation -> IO FilePath)
-	 -> Maybe ModLocation
-	 -> IO (DynFlags, FilePath, Maybe ModLocation)
-
-pipeLoop dflags phase stop_phase 
-	 input_fn orig_basename orig_suff 
-	 orig_get_output_fn maybe_loc
-
-  | phase `eqPhase` stop_phase		  -- All done
-  = return (dflags, input_fn, maybe_loc)
-
-  | not (phase `happensBefore` stop_phase)
-	-- Something has gone wrong.  We'll try to cover all the cases when
-	-- this could happen, so if we reach here it is a panic.
-	-- eg. it might happen if the -C flag is used on a source file that
-	-- has {-# OPTIONS -fasm #-}.
-  = panic ("pipeLoop: at phase " ++ show phase ++ 
-	   " but I wanted to stop at phase " ++ show stop_phase)
-
-  | otherwise 
-  = do	{ (next_phase, dflags', maybe_loc, output_fn)
-		<- runPhase phase stop_phase dflags orig_basename 
-			    orig_suff input_fn orig_get_output_fn maybe_loc
-	; pipeLoop dflags' next_phase stop_phase output_fn
-		   orig_basename orig_suff orig_get_output_fn maybe_loc }
-
-getOutputFilename
-  :: DynFlags -> Phase -> PipelineOutput -> String
-  -> Phase{-next phase-} -> Maybe ModLocation -> IO FilePath
-getOutputFilename dflags stop_phase output basename
- = func
- where
-	hcsuf      = hcSuf dflags
-	odir       = objectDir dflags
-	osuf       = objectSuf dflags
-	keep_hc    = dopt Opt_KeepHcFiles dflags
-	keep_raw_s = dopt Opt_KeepRawSFiles dflags
-	keep_s     = dopt Opt_KeepSFiles dflags
-
-        myPhaseInputExt HCc    = hcsuf
-        myPhaseInputExt StopLn = osuf
-        myPhaseInputExt other  = phaseInputExt other
-
-	func next_phase maybe_location
-	   | is_last_phase, Persistent <- output     = persistent_fn
-	   | is_last_phase, SpecificFile f <- output = return f
-	   | keep_this_output	   		     = persistent_fn
-     	   | otherwise        	   		     = newTempName dflags suffix
-	   where
-		is_last_phase = next_phase `eqPhase` stop_phase
-
-		-- sometimes, we keep output from intermediate stages
-		keep_this_output = 
-     		     case next_phase of
-     			     StopLn              -> True
-     			     Mangle | keep_raw_s -> True
-     			     As     | keep_s     -> True
-     			     HCc    | keep_hc    -> True
-     			     _other              -> False
-
-		suffix = myPhaseInputExt next_phase
-
-		-- persistent object files get put in odir
-	        persistent_fn 
-		   | StopLn <- next_phase = return odir_persistent
-		   | otherwise            = return persistent
-
-		persistent = basename `joinFileExt` suffix
-
-		odir_persistent
-		   | Just loc <- maybe_location = ml_obj_file loc
-		   | Just d <- odir = d `joinFileName` persistent
-		   | otherwise      = persistent
-
-
--- -----------------------------------------------------------------------------
--- Each phase in the pipeline returns the next phase to execute, and the
--- name of the file in which the output was placed.
---
--- We must do things dynamically this way, because we often don't know
--- what the rest of the phases will be until part-way through the
--- compilation: for example, an {-# OPTIONS -fasm #-} at the beginning
--- of a source file can change the latter stages of the pipeline from
--- taking the via-C route to using the native code generator.
-
-runPhase :: Phase	-- Do this phase first
-	 -> Phase	-- Stop just before this phase
-	 -> DynFlags
-	 -> String	-- basename of original input source
-	 -> String	-- its extension
-	 -> FilePath	-- name of file which contains the input to this phase.
-	 -> (Phase -> Maybe ModLocation -> IO FilePath)
-			-- how to calculate the output filename
-	 -> Maybe ModLocation		-- the ModLocation, if we have one
-	 -> IO (Phase,	  		-- next phase
-		DynFlags,		-- new dynamic flags
-		Maybe ModLocation,	-- the ModLocation, if we have one
-		FilePath)		-- output filename
-
-	-- Invariant: the output filename always contains the output
-	-- Interesting case: Hsc when there is no recompilation to do
-	--		     Then the output filename is still a .o file 
-
--------------------------------------------------------------------------------
--- Unlit phase 
-
-runPhase (Unlit sf) _stop dflags _basename _suff input_fn get_output_fn maybe_loc
-  = do let unlit_flags = getOpts dflags opt_L
-       -- The -h option passes the file name for unlit to put in a #line directive
-       output_fn <- get_output_fn (Cpp sf) maybe_loc
-
-       SysTools.runUnlit dflags 
-		(map SysTools.Option unlit_flags ++
-       			  [ SysTools.Option     "-h"
- 			  , SysTools.Option     input_fn
-			  , SysTools.FileOption "" input_fn
-			  , SysTools.FileOption "" output_fn
-			  ])
-
-       return (Cpp sf, dflags, maybe_loc, output_fn)
-
--------------------------------------------------------------------------------
--- Cpp phase : (a) gets OPTIONS out of file
---	       (b) runs cpp if necessary
-
-runPhase (Cpp sf) _stop dflags0 basename suff input_fn get_output_fn maybe_loc
-  = do src_opts <- getOptionsFromFile input_fn
-       (dflags,unhandled_flags) <- parseDynamicFlags dflags0 (map unLoc src_opts)
-       checkProcessArgsResult unhandled_flags (basename `joinFileExt` suff)
-
-       if not (dopt Opt_Cpp dflags) then
-           -- no need to preprocess CPP, just pass input file along
-	   -- to the next phase of the pipeline.
-          return (HsPp sf, dflags, maybe_loc, input_fn)
-	else do
-	    output_fn <- get_output_fn (HsPp sf) maybe_loc
-	    doCpp dflags True{-raw-} False{-no CC opts-} input_fn output_fn
-	    return (HsPp sf, dflags, maybe_loc, output_fn)
-
--------------------------------------------------------------------------------
--- HsPp phase 
-
-runPhase (HsPp sf) _stop dflags basename suff input_fn get_output_fn maybe_loc
-  = do if not (dopt Opt_Pp dflags) then
-           -- no need to preprocess, just pass input file along
-	   -- to the next phase of the pipeline.
-          return (Hsc sf, dflags, maybe_loc, input_fn)
-	else do
-	    let hspp_opts = getOpts dflags opt_F
-	    let orig_fn = basename `joinFileExt` suff
-	    output_fn <- get_output_fn (Hsc sf) maybe_loc
-	    SysTools.runPp dflags
-			   ( [ SysTools.Option     orig_fn
-			     , SysTools.Option     input_fn
-			     , SysTools.FileOption "" output_fn
-			     ] ++
-			     map SysTools.Option hspp_opts
-			   )
-	    return (Hsc sf, dflags, maybe_loc, output_fn)
-
------------------------------------------------------------------------------
--- Hsc phase
-
--- Compilation of a single module, in "legacy" mode (_not_ under
--- the direction of the compilation manager).
-runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _maybe_loc 
- = do	-- normal Hsc mode, not mkdependHS
-
-  -- we add the current directory (i.e. the directory in which
-  -- the .hs files resides) to the import path, since this is
-  -- what gcc does, and it's probably what you want.
-	let current_dir = directoryOf basename
-	
-	    paths = includePaths dflags0
-	    dflags = dflags0 { includePaths = current_dir : paths }
-	
-  -- gather the imports and module name
-        (hspp_buf,mod_name) <- 
-            case src_flavour of
-		ExtCoreFile -> do {  -- no explicit imports in ExtCore input.
-			          ; m <- getCoreModuleName input_fn
-			          ; return (Nothing, mkModule m) }
-
-		other -> do { buf <- hGetStringBuffer input_fn
-			    ; (_,_,L _ mod_name) <- getImports dflags buf input_fn
-			    ; return (Just buf, mod_name) }
-
-  -- Build a ModLocation to pass to hscMain.
-  -- The source filename is rather irrelevant by now, but it's used
-  -- by hscMain for messages.  hscMain also needs 
-  -- the .hi and .o filenames, and this is as good a way
-  -- as any to generate them, and better than most. (e.g. takes 
-  -- into accout the -osuf flags)
-	location1 <- mkHomeModLocation2 dflags mod_name basename suff
-
-  -- Boot-ify it if necessary
-	let location2 | isHsBoot src_flavour = addBootSuffixLocn location1
-		      | otherwise	     = location1 
-					
-
-  -- Take -ohi into account if present
-  -- This can't be done in mkHomeModuleLocation because
-  -- it only applies to the module being compiles
-	let ohi = outputHi dflags
-	    location3 | Just fn <- ohi = location2{ ml_hi_file = fn }
-		      | otherwise      = location2
-
-  -- Take -o into account if present
-  -- Very like -ohi, but we must *only* do this if we aren't linking
-  -- (If we're linking then the -o applies to the linked thing, not to
-  -- the object file for one module.)
-  -- Note the nasty duplication with the same computation in compileFile above
-	let expl_o_file = outputFile dflags
-	    location4 | Just ofile <- expl_o_file
-		      , isNoLink (ghcLink dflags)
-		      = location3 { ml_obj_file = ofile }
-		      | otherwise = location3
-
-  -- Make the ModSummary to hand to hscMain
-	src_timestamp <- getModificationTime (basename `joinFileExt` suff)
-	let
-	    unused_field = panic "runPhase:ModSummary field"
-		-- Some fields are not looked at by hscMain
-	    mod_summary = ModSummary {	ms_mod 	     = mod_name, 
-					ms_hsc_src   = src_flavour,
-				 	ms_hspp_file = input_fn,
-                                        ms_hspp_opts = dflags,
-					ms_hspp_buf  = hspp_buf,
-					ms_location  = location4,
-					ms_hs_date   = src_timestamp,
-					ms_obj_date  = Nothing,
-					ms_imps	     = unused_field,
-					ms_srcimps   = unused_field }
-
-	    o_file = ml_obj_file location4 	-- The real object file
-
-
-  -- Figure out if the source has changed, for recompilation avoidance.
-  --
-  -- Setting source_unchanged to True means that M.o seems
-  -- to be up to date wrt M.hs; so no need to recompile unless imports have
-  -- changed (which the compiler itself figures out).
-  -- Setting source_unchanged to False tells the compiler that M.o is out of
-  -- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
-	let do_recomp = dopt Opt_RecompChecking dflags
-	source_unchanged <- 
-          if not do_recomp || not (isStopLn stop)
-		-- Set source_unchanged to False unconditionally if
-		--	(a) recompilation checker is off, or
-		-- 	(b) we aren't going all the way to .o file (e.g. ghc -S)
-	     then return False	
-		-- Otherwise look at file modification dates
-	     else do o_file_exists <- doesFileExist o_file
-		     if not o_file_exists
-		        then return False	-- Need to recompile
-			else do t2 <- getModificationTime o_file
-			        if t2 > src_timestamp
-				  then return True
-				  else return False
-
-  -- get the DynFlags
-	let hsc_lang = hscMaybeAdjustTarget dflags stop src_flavour (hscTarget dflags)
-	let next_phase = hscNextPhase dflags src_flavour hsc_lang
-	output_fn  <- get_output_fn next_phase (Just location4)
-
-        let dflags' = dflags { hscTarget = hsc_lang,
-			       hscOutName = output_fn,
-			       extCoreName = basename ++ ".hcr" }
-
-	hsc_env <- newHscEnv dflags'
-
-  -- Tell the finder cache about this module
-	addHomeModuleToFinder hsc_env mod_name location4
-
-  -- run the compiler!
-	mbResult <- hscCompileOneShot hsc_env
-			  mod_summary source_unchanged 
-			  Nothing	-- No iface
-                          Nothing       -- No "module i of n" progress info
-
-	case mbResult of
-          Nothing -> throwDyn (PhaseFailed "hsc" (ExitFailure 1))
-          Just HscNoRecomp
-              -> do SysTools.touch dflags' "Touching object file" o_file
-                    -- The .o file must have a later modification date
-                    -- than the source file (else we wouldn't be in HscNoRecomp)
-                    -- but we touch it anyway, to keep 'make' happy (we think).
-                    return (StopLn, dflags', Just location4, o_file)
-          Just (HscRecomp hasStub)
-              -> do when hasStub $
-                         do stub_o <- compileStub dflags' mod_name location4
-                            consIORef v_Ld_inputs stub_o
-                    -- In the case of hs-boot files, generate a dummy .o-boot 
-                    -- stamp file for the benefit of Make
-                    when (isHsBoot src_flavour) $
-                      SysTools.touch dflags' "Touching object file" o_file
-                    return (next_phase, dflags', Just location4, output_fn)
-
------------------------------------------------------------------------------
--- Cmm phase
-
-runPhase CmmCpp stop dflags basename suff input_fn get_output_fn maybe_loc
-  = do
-       output_fn <- get_output_fn Cmm maybe_loc
-       doCpp dflags False{-not raw-} True{-include CC opts-} input_fn output_fn	
-       return (Cmm, dflags, maybe_loc, output_fn)
-
-runPhase Cmm stop dflags basename suff input_fn get_output_fn maybe_loc
-  = do
-	let hsc_lang = hscMaybeAdjustTarget dflags stop HsSrcFile (hscTarget dflags)
-	let next_phase = hscNextPhase dflags HsSrcFile hsc_lang
-	output_fn <- get_output_fn next_phase maybe_loc
-
-        let dflags' = dflags { hscTarget = hsc_lang,
-			       hscOutName = output_fn,
-			       extCoreName = basename ++ ".hcr" }
-
-	ok <- hscCmmFile dflags' input_fn
-
-	when (not ok) $ throwDyn (PhaseFailed "cmm" (ExitFailure 1))
-
-	return (next_phase, dflags, maybe_loc, output_fn)
-
------------------------------------------------------------------------------
--- Cc phase
-
--- we don't support preprocessing .c files (with -E) now.  Doing so introduces
--- way too many hacks, and I can't say I've ever used it anyway.
-
-runPhase cc_phase stop dflags basename suff input_fn get_output_fn maybe_loc
-   | cc_phase `eqPhase` Cc || cc_phase `eqPhase` HCc
-   = do	let cc_opts = getOpts dflags opt_c
-	    hcc = cc_phase `eqPhase` HCc
-
-       	let cmdline_include_paths = includePaths dflags
-
-	-- HC files have the dependent packages stamped into them
-	pkgs <- if hcc then getHCFilePackages input_fn else return []
-
-	-- add package include paths even if we're just compiling .c
-	-- files; this is the Value Add(TM) that using ghc instead of
-	-- gcc gives you :)
-        pkg_include_dirs <- getPackageIncludePath dflags pkgs
-        let include_paths = foldr (\ x xs -> "-I" : x : xs) []
-			      (cmdline_include_paths ++ pkg_include_dirs)
-
-	let (md_c_flags, md_regd_c_flags) = machdepCCOpts dflags
-        let pic_c_flags = picCCOpts dflags
-
-        let verb = getVerbFlag dflags
-
-	pkg_extra_cc_opts <- getPackageExtraCcOpts dflags pkgs
-
-	let split_objs = dopt Opt_SplitObjs dflags
-	    split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ]
-		      | otherwise         = [ ]
-
-	let excessPrecision = dopt Opt_ExcessPrecision dflags
-
-	let cc_opt | optLevel dflags >= 2 = "-O2"
-		   | otherwise            = "-O"
-
-	-- Decide next phase
-	
-        let mangle = dopt Opt_DoAsmMangling dflags
-            next_phase
-		| hcc && mangle     = Mangle
-		| otherwise         = As
-	output_fn <- get_output_fn next_phase maybe_loc
-
-	let
-	  more_hcc_opts =
-#if i386_TARGET_ARCH
-	   	-- on x86 the floating point regs have greater precision
-	     	-- than a double, which leads to unpredictable results.
-		-- By default, we turn this off with -ffloat-store unless
-		-- the user specified -fexcess-precision.
-		(if excessPrecision then [] else [ "-ffloat-store" ]) ++
-#endif
-		-- gcc's -fstrict-aliasing allows two accesses to memory
-		-- to be considered non-aliasing if they have different types.
-		-- This interacts badly with the C code we generate, which is
-		-- very weakly typed, being derived from C--.
-		["-fno-strict-aliasing"]
-
-
-
-	SysTools.runCc dflags (
-		-- force the C compiler to interpret this file as C when
-		-- compiling .hc files, by adding the -x c option.
-		-- Also useful for plain .c files, just in case GHC saw a 
-		-- -x c option.
-			[ SysTools.Option "-x", SysTools.Option "c"] ++
-			[ SysTools.FileOption "" input_fn
-			, SysTools.Option "-o"
-			, SysTools.FileOption "" output_fn
-			]
-		       ++ map SysTools.Option (
-		          md_c_flags
-                       ++ pic_c_flags
-		       ++ (if hcc && mangle
-		  	     then md_regd_c_flags
-		  	     else [])
-		       ++ (if hcc 
-			     then more_hcc_opts
-			     else [])
-		       ++ [ verb, "-S", "-Wimplicit", cc_opt ]
-		       ++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
-		       ++ cc_opts
-		       ++ split_opt
-		       ++ include_paths
-		       ++ pkg_extra_cc_opts
-		       ))
-
-	return (next_phase, dflags, maybe_loc, output_fn)
-
-	-- ToDo: postprocess the output from gcc
-
------------------------------------------------------------------------------
--- Mangle phase
-
-runPhase Mangle stop dflags _basename _suff input_fn get_output_fn maybe_loc
-   = do let mangler_opts = getOpts dflags opt_m
-
-#if i386_TARGET_ARCH
-        machdep_opts <- return [ show (stolen_x86_regs dflags) ]
-#else
-	machdep_opts <- return []
-#endif
-
-	let split = dopt Opt_SplitObjs dflags
-            next_phase
-		| split = SplitMangle
-		| otherwise = As
-	output_fn <- get_output_fn next_phase maybe_loc
-
-	SysTools.runMangle dflags (map SysTools.Option mangler_opts
-		          ++ [ SysTools.FileOption "" input_fn
-			     , SysTools.FileOption "" output_fn
-			     ]
-			  ++ map SysTools.Option machdep_opts)
-
-	return (next_phase, dflags, maybe_loc, output_fn)
-
------------------------------------------------------------------------------
--- Splitting phase
-
-runPhase SplitMangle stop dflags _basename _suff input_fn get_output_fn maybe_loc
-  = do  -- tmp_pfx is the prefix used for the split .s files
-	-- We also use it as the file to contain the no. of split .s files (sigh)
-	split_s_prefix <- SysTools.newTempName dflags "split"
-	let n_files_fn = split_s_prefix
-
-	SysTools.runSplit dflags
-			  [ SysTools.FileOption "" input_fn
-			  , SysTools.FileOption "" split_s_prefix
-			  , SysTools.FileOption "" n_files_fn
-			  ]
-
-	-- Save the number of split files for future references
-	s <- readFile n_files_fn
-	let n_files = read s :: Int
-	writeIORef v_Split_info (split_s_prefix, n_files)
-
-	-- Remember to delete all these files
-	addFilesToClean [ split_s_prefix ++ "__" ++ show n ++ ".s"
-			| n <- [1..n_files]]
-
-	return (SplitAs, dflags, maybe_loc, "**splitmangle**")
-	  -- we don't use the filename
-
------------------------------------------------------------------------------
--- As phase
-
-runPhase As stop dflags _basename _suff input_fn get_output_fn maybe_loc
-  = do	let as_opts =  getOpts dflags opt_a
-        let cmdline_include_paths = includePaths dflags
-
-	output_fn <- get_output_fn StopLn maybe_loc
-
-	-- we create directories for the object file, because it
-	-- might be a hierarchical module.
-	createDirectoryHierarchy (directoryOf output_fn)
-
-	SysTools.runAs dflags	
-		       (map SysTools.Option as_opts
-		       ++ [ SysTools.Option ("-I" ++ p) | p <- cmdline_include_paths ]
-		       ++ [ SysTools.Option "-c"
-		          , SysTools.FileOption "" input_fn
-			  , SysTools.Option "-o"
-			  , SysTools.FileOption "" output_fn
-			  ])
-
-	return (StopLn, dflags, maybe_loc, output_fn)
-
-
-runPhase SplitAs stop dflags basename _suff _input_fn get_output_fn maybe_loc
-  = do  
-	output_fn <- get_output_fn StopLn maybe_loc
-
-	let (base_o, _) = splitFilename output_fn
-	    split_odir  = base_o ++ "_split"
-	    osuf = objectSuf dflags
-
-	createDirectoryHierarchy split_odir
-
-	-- remove M_split/ *.o, because we're going to archive M_split/ *.o
-	-- later and we don't want to pick up any old objects.
-	fs <- getDirectoryContents split_odir 
-	mapM_ removeFile $ map (split_odir `joinFileName`)
-			 $ filter (osuf `isSuffixOf`) fs
-
-	let as_opts = getOpts dflags opt_a
-
-	(split_s_prefix, n) <- readIORef v_Split_info
-
-	let split_s   n = split_s_prefix ++ "__" ++ show n `joinFileExt` "s"
-	    split_obj n = split_odir `joinFileName`
-				filenameOf base_o ++ "__" ++ show n
-					`joinFileExt` osuf
-
-	let assemble_file n
-	      = SysTools.runAs dflags
-			 (map SysTools.Option as_opts ++
-		   	 [ SysTools.Option "-c"
-			 , SysTools.Option "-o"
-			 , SysTools.FileOption "" (split_obj n)
-			 , SysTools.FileOption "" (split_s n)
-			 ])
-	
-	mapM_ assemble_file [1..n]
-
-	-- and join the split objects into a single object file:
-	let ld_r args = SysTools.runLink dflags ([ 
-				SysTools.Option "-nostdlib",
-				SysTools.Option "-nodefaultlibs",
-				SysTools.Option "-Wl,-r", 
-				SysTools.Option ld_x_flag, 
-				SysTools.Option "-o", 
-				SysTools.FileOption "" output_fn ] ++ args)
-            ld_x_flag | null cLD_X = ""
-		      | otherwise  = "-Wl,-x"	  
-
-	if cLdIsGNULd == "YES"
-	    then do 
-		  let script = split_odir `joinFileName` "ld.script"
-		  writeFile script $
-		      "INPUT(" ++ unwords (map split_obj [1..n]) ++ ")"
-		  ld_r [SysTools.FileOption "" script]
-	    else do
-		  ld_r (map (SysTools.FileOption "" . split_obj) [1..n])
-
-	return (StopLn, dflags, maybe_loc, output_fn)
-
-
------------------------------------------------------------------------------
--- MoveBinary sort-of-phase
--- After having produced a binary, move it somewhere else and generate a
--- wrapper script calling the binary. Currently, we need this only in 
--- a parallel way (i.e. in GUM), because PVM expects the binary in a
--- central directory.
--- This is called from staticLink below, after linking. I haven't made it
--- a separate phase to minimise interfering with other modules, and
--- we don't need the generality of a phase (MoveBinary is always
--- done after linking and makes only sense in a parallel setup)   -- HWL
-
-runPhase_MoveBinary input_fn
-  = do	
-        sysMan   <- getSysMan
-        pvm_root <- getEnv "PVM_ROOT"
-        pvm_arch <- getEnv "PVM_ARCH"
-        let 
-           pvm_executable_base = "=" ++ input_fn
-           pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base
-        -- nuke old binary; maybe use configur'ed names for cp and rm?
-        system ("rm -f " ++ pvm_executable)
-        -- move the newly created binary into PVM land
-        system ("cp -p " ++ input_fn ++ " " ++ pvm_executable)
-        -- generate a wrapper script for running a parallel prg under PVM
-        writeFile input_fn (mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan)
-	return True
-
--- generates a Perl skript starting a parallel prg under PVM
-mk_pvm_wrapper_script :: String -> String -> String -> String
-mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
- [
-  "eval 'exec perl -S $0 ${1+\"$@\"}'", 
-  "  if $running_under_some_shell;",
-  "# =!=!=!=!=!=!=!=!=!=!=!",
-  "# This script is automatically generated: DO NOT EDIT!!!",
-  "# Generated by Glasgow Haskell Compiler",
-  "# ngoqvam choHbogh vaj' vIHoHnISbej !!!!",
-  "#",
-  "$pvm_executable      = '" ++ pvm_executable ++ "';",
-  "$pvm_executable_base = '" ++ pvm_executable_base ++ "';",
-  "$SysMan = '" ++ sysMan ++ "';",
-  "",
-  {- ToDo: add the magical shortcuts again iff we actually use them -- HWL
-  "# first, some magical shortcuts to run "commands" on the binary",
-  "# (which is hidden)",
-  "if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) {",
-  "    local($cmd) = $1;",
-  "    system("$cmd $pvm_executable");",
-  "    exit(0); # all done",
-  "}", -}
-  "",
-  "# Now, run the real binary; process the args first",
-  "$ENV{'PE'} = $pvm_executable_base;", --  ++ pvm_executable_base,
-  "$debug = '';",
-  "$nprocessors = 0; # the default: as many PEs as machines in PVM config",
-  "@nonPVM_args = ();",
-  "$in_RTS_args = 0;",
-  "",
-  "args: while ($a = shift(@ARGV)) {",
-  "    if ( $a eq '+RTS' ) {",
-  "	$in_RTS_args = 1;",
-  "    } elsif ( $a eq '-RTS' ) {",
-  "	$in_RTS_args = 0;",
-  "    }",
-  "    if ( $a eq '-d' && $in_RTS_args ) {",
-  "	$debug = '-';",
-  "    } elsif ( $a =~ /^-qN(\\d+)/ && $in_RTS_args ) {",
-  "	$nprocessors = $1;",
-  "    } elsif ( $a =~ /^-qp(\\d+)/ && $in_RTS_args ) {",
-  "	$nprocessors = $1;",
-  "    } else {",
-  "	push(@nonPVM_args, $a);",
-  "    }",
-  "}",
-  "",
-  "local($return_val) = 0;",
-  "# Start the parallel execution by calling SysMan",
-  "system(\"$SysMan $debug $pvm_executable $nprocessors @nonPVM_args\");",
-  "$return_val = $?;",
-  "# ToDo: fix race condition moving files and flushing them!!",
-  "system(\"cp $ENV{'HOME'}/$pvm_executable_base.???.gr .\") if -f \"$ENV{'HOME'}/$pvm_executable_base.002.gr\";",
-  "exit($return_val);"
- ]
-
------------------------------------------------------------------------------
--- Complain about non-dynamic flags in OPTIONS pragmas
-
-checkProcessArgsResult flags filename
-  = do when (notNull flags) (throwDyn (ProgramError (
-	  showSDoc (hang (text filename <> char ':')
-		      4 (text "unknown flags in  {-# OPTIONS #-} pragma:" <+>
-			  hsep (map text flags)))
-	)))
-
------------------------------------------------------------------------------
--- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file
-
-getHCFilePackages :: FilePath -> IO [PackageId]
-getHCFilePackages filename =
-  EXCEPTION.bracket (openFile filename ReadMode) hClose $ \h -> do
-    l <- hGetLine h
-    case l of
-      '/':'*':' ':'G':'H':'C':'_':'P':'A':'C':'K':'A':'G':'E':'S':rest ->
-	  return (map stringToPackageId (words rest))
-      _other ->
-	  return []
-
------------------------------------------------------------------------------
--- Static linking, of .o files
-
--- The list of packages passed to link is the list of packages on
--- which this program depends, as discovered by the compilation
--- manager.  It is combined with the list of packages that the user
--- specifies on the command line with -package flags.  
---
--- In one-shot linking mode, we can't discover the package
--- dependencies (because we haven't actually done any compilation or
--- read any interface files), so the user must explicitly specify all
--- the packages.
-
-staticLink :: DynFlags -> [FilePath] -> [PackageId] -> IO ()
-staticLink dflags o_files dep_packages = do
-    let verb = getVerbFlag dflags
-        output_fn = exeFileName dflags
-
-    -- get the full list of packages to link with, by combining the
-    -- explicit packages with the auto packages and all of their
-    -- dependencies, and eliminating duplicates.
-
-    pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
-    let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
-
-    let lib_paths = libraryPaths dflags
-    let lib_path_opts = map ("-L"++) lib_paths
-
-    pkg_link_opts <- getPackageLinkOpts dflags dep_packages
-
-#ifdef darwin_TARGET_OS
-    pkg_framework_paths <- getPackageFrameworkPath dflags dep_packages
-    let pkg_framework_path_opts = map ("-F"++) pkg_framework_paths
-
-    let framework_paths = frameworkPaths dflags
-        framework_path_opts = map ("-F"++) framework_paths
-
-    pkg_frameworks <- getPackageFrameworks dflags dep_packages
-    let pkg_framework_opts = concat [ ["-framework", fw] | fw <- pkg_frameworks ]
-    
-    let frameworks = cmdlineFrameworks dflags
-        framework_opts = concat [ ["-framework", fw] | fw <- reverse frameworks ]
-	 -- reverse because they're added in reverse order from the cmd line
-#endif
-
-	-- probably _stub.o files
-    extra_ld_inputs <- readIORef v_Ld_inputs
-
-	-- opts from -optl-<blah> (including -l<blah> options)
-    let extra_ld_opts = getOpts dflags opt_l
-
-    let ways = wayNames dflags
-
-    -- Here are some libs that need to be linked at the *end* of
-    -- the command line, because they contain symbols that are referred to
-    -- by the RTS.  We can't therefore use the ordinary way opts for these.
-    let
-	debug_opts | WayDebug `elem` ways = [ 
-#if defined(HAVE_LIBBFD)
-			"-lbfd", "-liberty"
-#endif
-			 ]
-		   | otherwise            = []
-
-    let
-	thread_opts | WayThreaded `elem` ways = [ 
-#if !defined(mingw32_TARGET_OS) && !defined(freebsd_TARGET_OS)
-			"-lpthread"
-#endif
-#if defined(osf3_TARGET_OS)
-			, "-lexc"
-#endif
-			]
-		    | otherwise               = []
-
-    let (md_c_flags, _) = machdepCCOpts dflags
-    SysTools.runLink dflags ( 
-		       [ SysTools.Option verb
-    		       , SysTools.Option "-o"
-		       , SysTools.FileOption "" output_fn
-		       ]
-		      ++ map SysTools.Option (
-		         md_c_flags
-	 	      ++ o_files
-		      ++ extra_ld_inputs
-	 	      ++ lib_path_opts
-	 	      ++ extra_ld_opts
-#ifdef darwin_TARGET_OS
-	 	      ++ framework_path_opts
-	 	      ++ framework_opts
-#endif
-	 	      ++ pkg_lib_path_opts
-	 	      ++ pkg_link_opts
-#ifdef darwin_TARGET_OS
-	 	      ++ pkg_framework_path_opts
-	 	      ++ pkg_framework_opts
-#endif
-		      ++ debug_opts
-		      ++ thread_opts
-		    ))
-
-    -- parallel only: move binary to another dir -- HWL
-    when (WayPar `elem` ways)
-	 (do success <- runPhase_MoveBinary output_fn
-             if success then return ()
-                        else throwDyn (InstallationError ("cannot move binary to PVM dir")))
-
-
-exeFileName :: DynFlags -> FilePath
-exeFileName dflags
-  | Just s <- outputFile dflags = 
-#if defined(mingw32_HOST_OS)
-      if null (suffixOf s)
-        then s `joinFileExt` "exe"
-        else s
-#else
-      s
-#endif
-  | otherwise = 
-#if defined(mingw32_HOST_OS)
-	"main.exe"
-#else
-	"a.out"
-#endif
-
------------------------------------------------------------------------------
--- Making a DLL (only for Win32)
-
-doMkDLL :: DynFlags -> [String] -> [PackageId] -> IO ()
-doMkDLL dflags o_files dep_packages = do
-    let verb = getVerbFlag dflags
-    let static = opt_Static
-    let no_hs_main = dopt Opt_NoHsMain dflags
-    let o_file = outputFile dflags
-    let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; }
-
-    pkg_lib_paths <- getPackageLibraryPath dflags dep_packages
-    let pkg_lib_path_opts = map ("-L"++) pkg_lib_paths
-
-    let lib_paths = libraryPaths dflags
-    let lib_path_opts = map ("-L"++) lib_paths
-
-    pkg_link_opts <- getPackageLinkOpts dflags dep_packages
-
-	-- probably _stub.o files
-    extra_ld_inputs <- readIORef v_Ld_inputs
-
-	-- opts from -optdll-<blah>
-    let extra_ld_opts = getOpts dflags opt_dll 
-
-    let pstate = pkgState dflags
-	rts_id | ExtPackage id <- rtsPackageId pstate = id
-	       | otherwise = panic "staticLink: rts package missing"
-	base_id | ExtPackage id <- basePackageId pstate = id
-	        | otherwise = panic "staticLink: base package missing"
-	rts_pkg  = getPackageDetails pstate rts_id
-        base_pkg = getPackageDetails pstate base_id
-
-    let extra_os = if static || no_hs_main
-                   then []
-                   else [ head (libraryDirs rts_pkg) ++ "/Main.dll_o",
-                          head (libraryDirs base_pkg) ++ "/PrelMain.dll_o" ]
-
-    let (md_c_flags, _) = machdepCCOpts dflags
-    SysTools.runMkDLL dflags
-	 ([ SysTools.Option verb
-	  , SysTools.Option "-o"
-	  , SysTools.FileOption "" output_fn
-	  ]
-	 ++ map SysTools.Option (
-	    md_c_flags
-	 ++ o_files
-	 ++ extra_os
-	 ++ [ "--target=i386-mingw32" ]
-	 ++ extra_ld_inputs
-	 ++ lib_path_opts
-	 ++ extra_ld_opts
-	 ++ pkg_lib_path_opts
-	 ++ pkg_link_opts
-         ++ (if "--def" `elem` (concatMap words extra_ld_opts)
-	       then [ "" ]
-               else [ "--export-all" ])
-	))
-
--- -----------------------------------------------------------------------------
--- Running CPP
-
-doCpp :: DynFlags -> Bool -> Bool -> FilePath -> FilePath -> IO ()
-doCpp dflags raw include_cc_opts input_fn output_fn = do
-    let hscpp_opts = getOpts dflags opt_P
-    let cmdline_include_paths = includePaths dflags
-
-    pkg_include_dirs <- getPackageIncludePath dflags []
-    let include_paths = foldr (\ x xs -> "-I" : x : xs) []
-			  (cmdline_include_paths ++ pkg_include_dirs)
-
-    let verb = getVerbFlag dflags
-
-    let cc_opts
-	  | not include_cc_opts = []
-	  | otherwise           = (optc ++ md_c_flags)
-		where 
-		      optc = getOpts dflags opt_c
-		      (md_c_flags, _) = machdepCCOpts dflags
-
-    let cpp_prog args | raw       = SysTools.runCpp dflags args
-	              | otherwise = SysTools.runCc dflags (SysTools.Option "-E" : args)
-
-    let target_defs = 
-	  [ "-D" ++ HOST_OS     ++ "_BUILD_OS=1",
-	    "-D" ++ HOST_ARCH   ++ "_BUILD_ARCH=1",
-	    "-D" ++ TARGET_OS   ++ "_HOST_OS=1",
-	    "-D" ++ TARGET_ARCH ++ "_HOST_ARCH=1" ]
-	-- remember, in code we *compile*, the HOST is the same our TARGET,
-	-- and BUILD is the same as our HOST.
-
-    cpp_prog       ([SysTools.Option verb]
-		    ++ map SysTools.Option include_paths
-		    ++ map SysTools.Option hsSourceCppOpts
-		    ++ map SysTools.Option hscpp_opts
-		    ++ map SysTools.Option cc_opts
-		    ++ map SysTools.Option target_defs
-		    ++ [ SysTools.Option     "-x"
-		       , SysTools.Option     "c"
-		       , SysTools.Option     input_fn
-	-- We hackily use Option instead of FileOption here, so that the file
-	-- name is not back-slashed on Windows.  cpp is capable of
-	-- dealing with / in filenames, so it works fine.  Furthermore
-	-- if we put in backslashes, cpp outputs #line directives
-	-- with *double* backslashes.   And that in turn means that
-	-- our error messages get double backslashes in them.
-	-- In due course we should arrange that the lexer deals
-	-- with these \\ escapes properly.
-		       , SysTools.Option     "-o"
-		       , SysTools.FileOption "" output_fn
-		       ])
-
-cHaskell1Version = "5" -- i.e., Haskell 98
-
--- Default CPP defines in Haskell source
-hsSourceCppOpts =
-	[ "-D__HASKELL1__="++cHaskell1Version
-	, "-D__GLASGOW_HASKELL__="++cProjectVersionInt				
-	, "-D__HASKELL98__"
-	, "-D__CONCURRENT_HASKELL__"
-	]
-
-
--- -----------------------------------------------------------------------------
--- Misc.
-
-hscNextPhase :: DynFlags -> HscSource -> HscTarget -> Phase
-hscNextPhase dflags HsBootFile hsc_lang  =  StopLn
-hscNextPhase dflags other hsc_lang = 
-  case hsc_lang of
-	HscC -> HCc
-	HscAsm | dopt Opt_SplitObjs dflags -> SplitMangle
-	       | otherwise -> As
-	HscNothing     -> StopLn
-	HscInterpreted -> StopLn
-	_other         -> StopLn
-
-
-hscMaybeAdjustTarget :: DynFlags -> Phase -> HscSource -> HscTarget -> HscTarget
-hscMaybeAdjustTarget dflags stop HsBootFile current_hsc_lang 
-  = HscNothing		-- No output (other than Foo.hi-boot) for hs-boot files
-hscMaybeAdjustTarget dflags stop other current_hsc_lang 
-  = hsc_lang 
-  where
-	keep_hc = dopt Opt_KeepHcFiles dflags
-	hsc_lang
-		-- don't change the lang if we're interpreting
-		 | current_hsc_lang == HscInterpreted = current_hsc_lang
-
-		-- force -fvia-C if we are being asked for a .hc file
-		 | HCc <- stop = HscC
-		 | keep_hc     = HscC
-		-- otherwise, stick to the plan
-		 | otherwise = current_hsc_lang
-
-GLOBAL_VAR(v_Split_info, ("",0), (String,Int))
-	-- The split prefix and number of files
diff --git a/ghc/compiler/main/DynFlags.hs b/ghc/compiler/main/DynFlags.hs
deleted file mode 100644
index 78acb98375..0000000000
--- a/ghc/compiler/main/DynFlags.hs
+++ /dev/null
@@ -1,1344 +0,0 @@
------------------------------------------------------------------------------
---
--- Dynamic flags
---
--- Most flags are dynamic flags, which means they can change from
--- compilation to compilation using OPTIONS_GHC pragmas, and in a
--- multi-session GHC each session can be using different dynamic
--- flags.  Dynamic flags can also be set at the prompt in GHCi.
---
--- (c) The University of Glasgow 2005
---
------------------------------------------------------------------------------
-
-module DynFlags (
-	-- Dynamic flags
-	DynFlag(..),
-	DynFlags(..),
-	HscTarget(..),
-	GhcMode(..), isOneShot,
-	GhcLink(..), isNoLink,
-	PackageFlag(..),
-	Option(..),
-
-	-- Configuration of the core-to-core and stg-to-stg phases
-	CoreToDo(..),
-	StgToDo(..),
-	SimplifierSwitch(..), 
-	SimplifierMode(..), FloatOutSwitches(..),
-	getCoreToDo, getStgToDo,
-	
-	-- Manipulating DynFlags
-	defaultDynFlags,		-- DynFlags
-	initDynFlags,			-- DynFlags -> IO DynFlags
-
-	dopt,				-- DynFlag -> DynFlags -> Bool
-	dopt_set, dopt_unset,		-- DynFlags -> DynFlag -> DynFlags
-	getOpts,			-- (DynFlags -> [a]) -> IO [a]
-	getVerbFlag,
-	updOptLevel,
-	setTmpDir,
-	
-	-- parsing DynFlags
-	parseDynamicFlags,
-        allFlags,
-
-	-- misc stuff
-	machdepCCOpts, picCCOpts,
-  ) where
-
-#include "HsVersions.h"
-
-import Module		( Module, mkModule )
-import PrelNames	( mAIN )
-import StaticFlags	( opt_Static, opt_PIC, 
-			  WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag )
-import {-# SOURCE #-} Packages (PackageState)
-import DriverPhases	( Phase(..), phaseInputExt )
-import Config
-import CmdLineParser
-import Panic		( panic, GhcException(..) )
-import Util		( notNull, splitLongestPrefix, split, normalisePath )
-import SrcLoc           ( SrcSpan )
-
-import DATA_IOREF	( readIORef )
-import EXCEPTION	( throwDyn )
-import Monad		( when )
-#ifdef mingw32_TARGET_OS
-import Data.List	( isPrefixOf )
-#endif
-import Maybe		( fromJust )
-import Char		( isDigit, isUpper )
-import Outputable
-import System.IO        ( hPutStrLn, stderr )
-import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
-
--- -----------------------------------------------------------------------------
--- DynFlags
-
-data DynFlag
-
-   -- debugging flags
-   = Opt_D_dump_cmm
-   | Opt_D_dump_asm
-   | Opt_D_dump_cpranal
-   | Opt_D_dump_deriv
-   | Opt_D_dump_ds
-   | Opt_D_dump_flatC
-   | Opt_D_dump_foreign
-   | Opt_D_dump_inlinings
-   | Opt_D_dump_occur_anal
-   | Opt_D_dump_parsed
-   | Opt_D_dump_rn
-   | Opt_D_dump_simpl
-   | Opt_D_dump_simpl_iterations
-   | Opt_D_dump_spec
-   | Opt_D_dump_prep
-   | Opt_D_dump_stg
-   | Opt_D_dump_stranal
-   | Opt_D_dump_tc
-   | Opt_D_dump_types
-   | Opt_D_dump_rules
-   | Opt_D_dump_cse
-   | Opt_D_dump_worker_wrapper
-   | Opt_D_dump_rn_trace
-   | Opt_D_dump_rn_stats
-   | Opt_D_dump_opt_cmm
-   | Opt_D_dump_simpl_stats
-   | Opt_D_dump_tc_trace
-   | Opt_D_dump_if_trace
-   | Opt_D_dump_splices
-   | Opt_D_dump_BCOs
-   | Opt_D_dump_vect
-   | Opt_D_source_stats
-   | Opt_D_verbose_core2core
-   | Opt_D_verbose_stg2stg
-   | Opt_D_dump_hi
-   | Opt_D_dump_hi_diffs
-   | Opt_D_dump_minimal_imports
-   | Opt_D_faststring_stats
-   | Opt_DoCoreLinting
-   | Opt_DoStgLinting
-   | Opt_DoCmmLinting
-
-   | Opt_WarnIsError		-- -Werror; makes warnings fatal
-   | Opt_WarnDuplicateExports
-   | Opt_WarnHiShadows
-   | Opt_WarnIncompletePatterns
-   | Opt_WarnIncompletePatternsRecUpd
-   | Opt_WarnMissingFields
-   | Opt_WarnMissingMethods
-   | Opt_WarnMissingSigs
-   | Opt_WarnNameShadowing
-   | Opt_WarnOverlappingPatterns
-   | Opt_WarnSimplePatterns
-   | Opt_WarnTypeDefaults
-   | Opt_WarnUnusedBinds
-   | Opt_WarnUnusedImports
-   | Opt_WarnUnusedMatches
-   | Opt_WarnDeprecations
-   | Opt_WarnDodgyImports
-   | Opt_WarnOrphans
-
-   -- language opts
-   | Opt_AllowOverlappingInstances
-   | Opt_AllowUndecidableInstances
-   | Opt_AllowIncoherentInstances
-   | Opt_MonomorphismRestriction
-   | Opt_GlasgowExts
-   | Opt_FFI
-   | Opt_PArr			       -- syntactic support for parallel arrays
-   | Opt_Arrows			       -- Arrow-notation syntax
-   | Opt_TH
-   | Opt_ImplicitParams
-   | Opt_Generics
-   | Opt_ImplicitPrelude 
-   | Opt_ScopedTypeVariables
-   | Opt_BangPatterns
-
-   -- optimisation opts
-   | Opt_Strictness
-   | Opt_FullLaziness
-   | Opt_CSE
-   | Opt_IgnoreInterfacePragmas
-   | Opt_OmitInterfacePragmas
-   | Opt_DoLambdaEtaExpansion
-   | Opt_IgnoreAsserts
-   | Opt_IgnoreBreakpoints
-   | Opt_DoEtaReduction
-   | Opt_CaseMerge
-   | Opt_UnboxStrictFields
-
-   -- misc opts
-   | Opt_Cpp
-   | Opt_Pp
-   | Opt_RecompChecking
-   | Opt_DryRun
-   | Opt_DoAsmMangling
-   | Opt_ExcessPrecision
-   | Opt_ReadUserPackageConf
-   | Opt_NoHsMain
-   | Opt_SplitObjs
-   | Opt_StgStats
-   | Opt_HideAllPackages
-
-   -- keeping stuff
-   | Opt_KeepHiDiffs
-   | Opt_KeepHcFiles
-   | Opt_KeepSFiles
-   | Opt_KeepRawSFiles
-   | Opt_KeepTmpFiles
-
-   deriving (Eq)
- 
-data DynFlags = DynFlags {
-  ghcMode		:: GhcMode,
-  ghcLink		:: GhcLink,
-  coreToDo   		:: Maybe [CoreToDo], -- reserved for -Ofile
-  stgToDo    		:: Maybe [StgToDo],  -- similarly
-  hscTarget    		:: HscTarget,
-  hscOutName 		:: String,  	-- name of the output file
-  extCoreName		:: String,	-- name of the .core output file
-  verbosity  		:: Int,	 	-- verbosity level
-  optLevel		:: Int,		-- optimisation level
-  maxSimplIterations    :: Int,		-- max simplifier iterations
-  ruleCheck		:: Maybe String,
-  stolen_x86_regs	:: Int,		
-  cmdlineHcIncludes	:: [String],	-- -#includes
-  importPaths		:: [FilePath],
-  mainModIs		:: Module,
-  mainFunIs		:: Maybe String,
-
-  -- ways
-  wayNames		:: [WayName],	-- way flags from the cmd line
-  buildTag		:: String,	-- the global "way" (eg. "p" for prof)
-  rtsBuildTag		:: String,	-- the RTS "way"
-  
-  -- paths etc.
-  objectDir		:: Maybe String,
-  hiDir			:: Maybe String,
-  stubDir		:: Maybe String,
-
-  objectSuf		:: String,
-  hcSuf			:: String,
-  hiSuf			:: String,
-
-  outputFile		:: Maybe String,
-  outputHi		:: Maybe String,
-
-  includePaths		:: [String],
-  libraryPaths		:: [String],
-  frameworkPaths	:: [String],  	-- used on darwin only
-  cmdlineFrameworks	:: [String],	-- ditto
-  tmpDir		:: String,	-- no trailing '/'
-  
-  -- options for particular phases
-  opt_L			:: [String],
-  opt_P			:: [String],
-  opt_F			:: [String],
-  opt_c			:: [String],
-  opt_m			:: [String],
-  opt_a			:: [String],
-  opt_l			:: [String],
-  opt_dll		:: [String],
-  opt_dep		:: [String],
-
-  -- commands for particular phases
-  pgm_L			:: String,
-  pgm_P			:: (String,[Option]),
-  pgm_F			:: String,
-  pgm_c			:: (String,[Option]),
-  pgm_m			:: (String,[Option]),
-  pgm_s			:: (String,[Option]),
-  pgm_a			:: (String,[Option]),
-  pgm_l			:: (String,[Option]),
-  pgm_dll		:: (String,[Option]),
-
-  --  ** Package flags
-  extraPkgConfs		:: [FilePath],
-	-- The -package-conf flags given on the command line, in the order
-	-- they appeared.
-
-  packageFlags		:: [PackageFlag],
-	-- The -package and -hide-package flags from the command-line
-
-  --  ** Package state
-  pkgState		:: PackageState,
-
-  -- hsc dynamic flags
-  flags      		:: [DynFlag],
-  
-  -- message output
-  log_action            :: Severity -> SrcSpan -> PprStyle -> Message -> IO ()
- }
-
-data HscTarget
-  = HscC
-  | HscAsm
-  | HscJava
-  | HscILX
-  | HscInterpreted
-  | HscNothing
-  deriving (Eq, Show)
-
-data GhcMode
-  = BatchCompile	-- | @ghc --make Main@
-  | Interactive		-- | @ghc --interactive@
-  | OneShot		-- | @ghc -c Foo.hs@
-  | JustTypecheck	-- | Development environemnts, refactorer, etc.
-  | MkDepend
-  deriving Eq
-
-isOneShot :: GhcMode -> Bool
-isOneShot OneShot = True
-isOneShot _other  = False
-
-data GhcLink	-- What to do in the link step, if there is one
-  =		-- Only relevant for modes
-		-- 	DoMake and StopBefore StopLn
-    NoLink		-- Don't link at all
-  | StaticLink		-- Ordinary linker [the default]
-  | MkDLL		-- Make a DLL
-
-isNoLink :: GhcLink -> Bool
-isNoLink NoLink = True
-isNoLink other  = False
-
-data PackageFlag
-  = ExposePackage  String
-  | HidePackage    String
-  | IgnorePackage  String
-
-defaultHscTarget
-  | cGhcWithNativeCodeGen == "YES" 	=  HscAsm
-  | otherwise				=  HscC
-
-initDynFlags dflags = do
- -- someday these will be dynamic flags
- ways <- readIORef v_Ways
- build_tag <- readIORef v_Build_tag
- rts_build_tag <- readIORef v_RTS_Build_tag
- return dflags{
-	wayNames	= ways,
-	buildTag	= build_tag,
-	rtsBuildTag	= rts_build_tag
-	}
-
-defaultDynFlags =
-     DynFlags {
-	ghcMode			= OneShot,
-	ghcLink			= StaticLink,
-	coreToDo 		= Nothing,
-	stgToDo			= Nothing, 
-	hscTarget		= defaultHscTarget, 
-	hscOutName		= "", 
-	extCoreName		= "",
-	verbosity		= 0, 
-	optLevel		= 0,
-	maxSimplIterations	= 4,
-	ruleCheck		= Nothing,
-	stolen_x86_regs		= 4,
-	cmdlineHcIncludes	= [],
-	importPaths		= ["."],
-	mainModIs		= mAIN,
-	mainFunIs		= Nothing,
-	
-	wayNames		= panic "ways",
-	buildTag		= panic "buildTag",
-	rtsBuildTag		= panic "rtsBuildTag",
-
-	objectDir		= Nothing,
-	hiDir			= Nothing,
-	stubDir			= Nothing,
-
-	objectSuf		= phaseInputExt StopLn,
-	hcSuf			= phaseInputExt HCc,
-	hiSuf			= "hi",
-
-	outputFile		= Nothing,
-	outputHi		= Nothing,
-	includePaths		= [],
-	libraryPaths		= [],
-	frameworkPaths		= [],
-	cmdlineFrameworks	= [],
-	tmpDir			= cDEFAULT_TMPDIR,
-	
-	opt_L			= [],
-	opt_P			= [],
-	opt_F			= [],
-	opt_c			= [],
-	opt_a			= [],
-	opt_m			= [],
-	opt_l			= [],
-	opt_dll			= [],
-	opt_dep			= [],
-	
-	pgm_L			= panic "pgm_L",
-	pgm_P			= panic "pgm_P",
-	pgm_F			= panic "pgm_F",
-	pgm_c			= panic "pgm_c",
-	pgm_m			= panic "pgm_m",
-	pgm_s			= panic "pgm_s",
-	pgm_a			= panic "pgm_a",
-	pgm_l			= panic "pgm_l",
-	pgm_dll			= panic "pgm_mkdll",
-	
-	extraPkgConfs		= [],
-	packageFlags		= [],
-	pkgState		= panic "pkgState",
-	
-	flags = [ 
-    	    Opt_RecompChecking,
-    	    Opt_ReadUserPackageConf,
-    
-    	    Opt_ImplicitPrelude,
-    	    Opt_MonomorphismRestriction,
-    	    Opt_Strictness,
-    			-- strictness is on by default, but this only
-    			-- applies to -O.
-    	    Opt_CSE,		-- similarly for CSE.
-    	    Opt_FullLaziness,	-- ...and for full laziness
-    
-    	    Opt_DoLambdaEtaExpansion,
-    			-- This one is important for a tiresome reason:
-    			-- we want to make sure that the bindings for data 
-    			-- constructors are eta-expanded.  This is probably
-    			-- a good thing anyway, but it seems fragile.
-    
-    	    Opt_DoAsmMangling,
-    
-    	    -- and the default no-optimisation options:
-    	    Opt_IgnoreInterfacePragmas,
-    	    Opt_OmitInterfacePragmas
-    
-               ] ++ standardWarnings,
-               
-        log_action = \severity srcSpan style msg -> 
-                        case severity of
-                          SevInfo  -> hPutStrLn stderr (show (msg style))
-                          SevFatal -> hPutStrLn stderr (show (msg style))
-                          _        -> hPutStrLn stderr ('\n':show ((mkLocMessage srcSpan msg) style))
-      }
-
-{- 
-    Verbosity levels:
-	
-    0	|   print errors & warnings only
-    1   |   minimal verbosity: print "compiling M ... done." for each module.
-    2   |   equivalent to -dshow-passes
-    3   |   equivalent to existing "ghc -v"
-    4   |   "ghc -v -ddump-most"
-    5   |   "ghc -v -ddump-all"
--}
-
-dopt :: DynFlag -> DynFlags -> Bool
-dopt f dflags  = f `elem` (flags dflags)
-
-dopt_set :: DynFlags -> DynFlag -> DynFlags
-dopt_set dfs f = dfs{ flags = f : flags dfs }
-
-dopt_unset :: DynFlags -> DynFlag -> DynFlags
-dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) }
-
-getOpts :: DynFlags -> (DynFlags -> [a]) -> [a]
-getOpts dflags opts = reverse (opts dflags)
-	-- We add to the options from the front, so we need to reverse the list
-
-getVerbFlag :: DynFlags -> String
-getVerbFlag dflags 
-  | verbosity dflags >= 3  = "-v" 
-  | otherwise =  ""
-
-setObjectDir  f d = d{ objectDir  = f}
-setHiDir      f d = d{ hiDir      = f}
-setStubDir    f d = d{ stubDir    = f}
-
-setObjectSuf  f d = d{ objectSuf  = f}
-setHiSuf      f d = d{ hiSuf      = f}
-setHcSuf      f d = d{ hcSuf      = f}
-
-setOutputFile f d = d{ outputFile = f}
-setOutputHi   f d = d{ outputHi   = f}
-
--- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
--- Config.hs should really use Option.
-setPgmP   f d = let (pgm:args) = words f in d{ pgm_P   = (pgm, map Option args)}
-
-setPgmL   f d = d{ pgm_L   = f}
-setPgmF   f d = d{ pgm_F   = f}
-setPgmc   f d = d{ pgm_c   = (f,[])}
-setPgmm   f d = d{ pgm_m   = (f,[])}
-setPgms   f d = d{ pgm_s   = (f,[])}
-setPgma   f d = d{ pgm_a   = (f,[])}
-setPgml   f d = d{ pgm_l   = (f,[])}
-setPgmdll f d = d{ pgm_dll = (f,[])}
-
-addOptL   f d = d{ opt_L   = f : opt_L d}
-addOptP   f d = d{ opt_P   = f : opt_P d}
-addOptF   f d = d{ opt_F   = f : opt_F d}
-addOptc   f d = d{ opt_c   = f : opt_c d}
-addOptm   f d = d{ opt_m   = f : opt_m d}
-addOpta   f d = d{ opt_a   = f : opt_a d}
-addOptl   f d = d{ opt_l   = f : opt_l d}
-addOptdll f d = d{ opt_dll = f : opt_dll d}
-addOptdep f d = d{ opt_dep = f : opt_dep d}
-
-addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
-
--- -----------------------------------------------------------------------------
--- Command-line options
-
--- When invoking external tools as part of the compilation pipeline, we
--- pass these a sequence of options on the command-line. Rather than
--- just using a list of Strings, we use a type that allows us to distinguish
--- between filepaths and 'other stuff'. [The reason being, of course, that
--- this type gives us a handle on transforming filenames, and filenames only,
--- to whatever format they're expected to be on a particular platform.]
-
-data Option
- = FileOption -- an entry that _contains_ filename(s) / filepaths.
-              String  -- a non-filepath prefix that shouldn't be 
-		      -- transformed (e.g., "/out=")
- 	      String  -- the filepath/filename portion
- | Option     String
- 
------------------------------------------------------------------------------
--- Setting the optimisation level
-
-updOptLevel :: Int -> DynFlags -> DynFlags
--- Set dynflags appropriate to the optimisation level
-updOptLevel n dfs
-  = if (n >= 1)
-     then dfs2{ hscTarget = HscC, optLevel = n } -- turn on -fvia-C with -O
-     else dfs2{ optLevel = n }
-  where
-   dfs1 = foldr (flip dopt_unset) dfs  remove_dopts
-   dfs2 = foldr (flip dopt_set)   dfs1 extra_dopts
-
-   extra_dopts
-	| n == 0    = opt_0_dopts
-	| otherwise = opt_1_dopts
-
-   remove_dopts
-	| n == 0    = opt_1_dopts
-	| otherwise = opt_0_dopts
-	
-opt_0_dopts =  [ 
-	Opt_IgnoreInterfacePragmas,
-	Opt_OmitInterfacePragmas
-    ]
-
-opt_1_dopts = [
-	Opt_IgnoreAsserts,
-	Opt_DoEtaReduction,
-	Opt_CaseMerge
-     ]
-
--- -----------------------------------------------------------------------------
--- Standard sets of warning options
-
-standardWarnings
-    = [ Opt_WarnDeprecations,
-	Opt_WarnOverlappingPatterns,
-	Opt_WarnMissingFields,
-	Opt_WarnMissingMethods,
-	Opt_WarnDuplicateExports
-      ]
-
-minusWOpts
-    = standardWarnings ++ 
-      [	Opt_WarnUnusedBinds,
-	Opt_WarnUnusedMatches,
-	Opt_WarnUnusedImports,
-	Opt_WarnIncompletePatterns,
-	Opt_WarnDodgyImports
-      ]
-
-minusWallOpts
-    = minusWOpts ++
-      [	Opt_WarnTypeDefaults,
-	Opt_WarnNameShadowing,
-	Opt_WarnMissingSigs,
-	Opt_WarnHiShadows,
-	Opt_WarnOrphans
-      ]
-
--- -----------------------------------------------------------------------------
--- CoreToDo:  abstraction of core-to-core passes to run.
-
-data CoreToDo		-- These are diff core-to-core passes,
-			-- which may be invoked in any order,
-  			-- as many times as you like.
-
-  = CoreDoSimplify	-- The core-to-core simplifier.
-	SimplifierMode
-	[SimplifierSwitch]
-			-- Each run of the simplifier can take a different
-			-- set of simplifier-specific flags.
-  | CoreDoFloatInwards
-  | CoreDoFloatOutwards FloatOutSwitches
-  | CoreLiberateCase
-  | CoreDoPrintCore
-  | CoreDoStaticArgs
-  | CoreDoStrictness
-  | CoreDoWorkerWrapper
-  | CoreDoSpecialising
-  | CoreDoSpecConstr
-  | CoreDoOldStrictness
-  | CoreDoGlomBinds
-  | CoreCSE
-  | CoreDoRuleCheck Int{-CompilerPhase-} String	-- Check for non-application of rules 
-						-- matching this string
-
-  | CoreDoNothing 	 -- useful when building up lists of these things
-
-data SimplifierMode 		-- See comments in SimplMonad
-  = SimplGently
-  | SimplPhase Int
-
-data SimplifierSwitch
-  = MaxSimplifierIterations Int
-  | NoCaseOfCase
-
-data FloatOutSwitches
-  = FloatOutSw  Bool 	-- True <=> float lambdas to top level
-		Bool	-- True <=> float constants to top level,
-			-- 	    even if they do not escape a lambda
-
-
--- The core-to-core pass ordering is derived from the DynFlags:
-
-getCoreToDo :: DynFlags -> [CoreToDo]
-getCoreToDo dflags
-  | Just todo <- coreToDo dflags = todo -- set explicitly by user
-  | otherwise = core_todo
-  where
-    opt_level  	  = optLevel dflags
-    max_iter   	  = maxSimplIterations dflags
-    strictness    = dopt Opt_Strictness dflags
-    full_laziness = dopt Opt_FullLaziness dflags
-    cse           = dopt Opt_CSE dflags
-    rule_check    = ruleCheck dflags
-
-    core_todo = 
-     if opt_level == 0 then
-      [
-	CoreDoSimplify (SimplPhase 0) [
-	    MaxSimplifierIterations max_iter
-	]
-      ]
-     else {- opt_level >= 1 -} [ 
-
-	-- initial simplify: mk specialiser happy: minimum effort please
-	CoreDoSimplify SimplGently [
-			-- 	Simplify "gently"
-			-- Don't inline anything till full laziness has bitten
-			-- In particular, inlining wrappers inhibits floating
-			-- e.g. ...(case f x of ...)...
-			--  ==> ...(case (case x of I# x# -> fw x#) of ...)...
-			--  ==> ...(case x of I# x# -> case fw x# of ...)...
-			-- and now the redex (f x) isn't floatable any more
-			-- Similarly, don't apply any rules until after full 
-			-- laziness.  Notably, list fusion can prevent floating.
-
-            NoCaseOfCase,
-			-- Don't do case-of-case transformations.
-			-- This makes full laziness work better
-	    MaxSimplifierIterations max_iter
-	],
-
-	-- Specialisation is best done before full laziness
-	-- so that overloaded functions have all their dictionary lambdas manifest
-	CoreDoSpecialising,
-
-	if full_laziness then CoreDoFloatOutwards (FloatOutSw False False)
-			 else CoreDoNothing,
-
-	CoreDoFloatInwards,
-
-	CoreDoSimplify (SimplPhase 2) [
-		-- Want to run with inline phase 2 after the specialiser to give
-		-- maximum chance for fusion to work before we inline build/augment
-		-- in phase 1.  This made a difference in 'ansi' where an 
-		-- overloaded function wasn't inlined till too late.
-	   MaxSimplifierIterations max_iter
-	],
-	case rule_check of { Just pat -> CoreDoRuleCheck 2 pat; Nothing -> CoreDoNothing },
-
-	CoreDoSimplify (SimplPhase 1) [
-		-- Need inline-phase2 here so that build/augment get 
-		-- inlined.  I found that spectral/hartel/genfft lost some useful
-		-- strictness in the function sumcode' if augment is not inlined
-		-- before strictness analysis runs
-	   MaxSimplifierIterations max_iter
-	],
-	case rule_check of { Just pat -> CoreDoRuleCheck 1 pat; Nothing -> CoreDoNothing },
-
-	CoreDoSimplify (SimplPhase 0) [
-		-- Phase 0: allow all Ids to be inlined now
-		-- This gets foldr inlined before strictness analysis
-
-	   MaxSimplifierIterations 3
-		-- At least 3 iterations because otherwise we land up with
-		-- huge dead expressions because of an infelicity in the 
-		-- simpifier.   
-		--	let k = BIG in foldr k z xs
-		-- ==>  let k = BIG in letrec go = \xs -> ...(k x).... in go xs
-		-- ==>  let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
-		-- Don't stop now!
-
-	],
-	case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
-
-#ifdef OLD_STRICTNESS
-	CoreDoOldStrictness
-#endif
-	if strictness then CoreDoStrictness else CoreDoNothing,
-	CoreDoWorkerWrapper,
-	CoreDoGlomBinds,
-
-	CoreDoSimplify (SimplPhase 0) [
-	   MaxSimplifierIterations max_iter
-	],
-
-	if full_laziness then
-	  CoreDoFloatOutwards (FloatOutSw False	  -- Not lambdas
-					  True)   -- Float constants
-	else CoreDoNothing,
-		-- nofib/spectral/hartel/wang doubles in speed if you
-		-- do full laziness late in the day.  It only happens
-		-- after fusion and other stuff, so the early pass doesn't
-		-- catch it.  For the record, the redex is 
-		--	  f_el22 (f_el21 r_midblock)
-
-
-	-- We want CSE to follow the final full-laziness pass, because it may
-	-- succeed in commoning up things floated out by full laziness.
-	-- CSE used to rely on the no-shadowing invariant, but it doesn't any more
-
-	if cse then CoreCSE else CoreDoNothing,
-
-	CoreDoFloatInwards,
-
--- Case-liberation for -O2.  This should be after
--- strictness analysis and the simplification which follows it.
-
-	case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing },
-
-	if opt_level >= 2 then
-	   CoreLiberateCase
-	else
-	   CoreDoNothing,
-	if opt_level >= 2 then
-	   CoreDoSpecConstr
-	else
-	   CoreDoNothing,
-
-	-- Final clean-up simplification:
-	CoreDoSimplify (SimplPhase 0) [
-	  MaxSimplifierIterations max_iter
-	]
-     ]
-
--- -----------------------------------------------------------------------------
--- StgToDo:  abstraction of stg-to-stg passes to run.
-
-data StgToDo
-  = StgDoMassageForProfiling  -- should be (next to) last
-  -- There's also setStgVarInfo, but its absolute "lastness"
-  -- is so critical that it is hardwired in (no flag).
-  | D_stg_stats
-
-getStgToDo :: DynFlags -> [StgToDo]
-getStgToDo dflags
-  | Just todo <- stgToDo dflags = todo -- set explicitly by user
-  | otherwise = todo2
-  where
-	stg_stats = dopt Opt_StgStats dflags
-
-	todo1 = if stg_stats then [D_stg_stats] else []
-
-	todo2 | WayProf `elem` wayNames dflags
-	      = StgDoMassageForProfiling : todo1
-	      | otherwise
-	      = todo1
-
--- -----------------------------------------------------------------------------
--- DynFlags parser
-
-allFlags :: [String]
-allFlags = map ('-':) $
-           [ name | (name, optkind) <- dynamic_flags, ok optkind ] ++
-           map ("fno-"++) flags ++
-           map ("f"++) flags
-    where ok (PrefixPred _ _) = False
-          ok _ = True
-          flags = map fst fFlags
-
-dynamic_flags :: [(String, OptKind DynP)]
-dynamic_flags = [
-     ( "n"              , NoArg  (setDynFlag Opt_DryRun) )
-  ,  ( "cpp"		, NoArg  (setDynFlag Opt_Cpp))
-  ,  ( "F"		, NoArg  (setDynFlag Opt_Pp))
-  ,  ( "#include"	, HasArg (addCmdlineHCInclude) )
-  ,  ( "v"		, OptPrefix (setVerbosity) )
-
-        ------- Specific phases  --------------------------------------------
-  ,  ( "pgmL"           , HasArg (upd . setPgmL) )  
-  ,  ( "pgmP"           , HasArg (upd . setPgmP) )  
-  ,  ( "pgmF"           , HasArg (upd . setPgmF) )  
-  ,  ( "pgmc"           , HasArg (upd . setPgmc) )  
-  ,  ( "pgmm"           , HasArg (upd . setPgmm) )  
-  ,  ( "pgms"           , HasArg (upd . setPgms) )  
-  ,  ( "pgma"           , HasArg (upd . setPgma) )  
-  ,  ( "pgml"           , HasArg (upd . setPgml) )  
-  ,  ( "pgmdll"		, HasArg (upd . setPgmdll) )
-
-  ,  ( "optL"		, HasArg (upd . addOptL) )  
-  ,  ( "optP"		, HasArg (upd . addOptP) )  
-  ,  ( "optF"           , HasArg (upd . addOptF) )  
-  ,  ( "optc"		, HasArg (upd . addOptc) )  
-  ,  ( "optm"		, HasArg (upd . addOptm) )  
-  ,  ( "opta"		, HasArg (upd . addOpta) )  
-  ,  ( "optl"		, HasArg (upd . addOptl) )  
-  ,  ( "optdll"		, HasArg (upd . addOptdll) )  
-  ,  ( "optdep"		, HasArg (upd . addOptdep) )
-
-  ,  ( "split-objs"	, NoArg (if can_split
-				    then setDynFlag Opt_SplitObjs
-				    else return ()) )
-
-	-------- Linking ----------------------------------------------------
-  ,  ( "c"		, NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
-  ,  ( "no-link"	, NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep.
-  ,  ( "-mk-dll"	, NoArg (upd $ \d -> d{ ghcLink=MkDLL } ))
-
-	------- Libraries ---------------------------------------------------
-  ,  ( "L"		, Prefix addLibraryPath )
-  ,  ( "l"		, AnySuffix (\s -> do upd (addOptl s)
-					      upd (addOptdll s)))
-
-	------- Frameworks --------------------------------------------------
-        -- -framework-path should really be -F ...
-  ,  ( "framework-path" , HasArg addFrameworkPath )
-  ,  ( "framework"	, HasArg (upd . addCmdlineFramework) )
-
-	------- Output Redirection ------------------------------------------
-  ,  ( "odir"		, HasArg (upd . setObjectDir  . Just))
-  ,  ( "o"		, SepArg (upd . setOutputFile . Just))
-  ,  ( "ohi"		, HasArg (upd . setOutputHi   . Just ))
-  ,  ( "osuf"		, HasArg (upd . setObjectSuf))
-  ,  ( "hcsuf"		, HasArg (upd . setHcSuf))
-  ,  ( "hisuf"		, HasArg (upd . setHiSuf))
-  ,  ( "hidir"		, HasArg (upd . setHiDir . Just))
-  ,  ( "tmpdir"		, HasArg (upd . setTmpDir))
-  ,  ( "stubdir"	, HasArg (upd . setStubDir . Just))
-
-	------- Keeping temporary files -------------------------------------
-  ,  ( "keep-hc-file"   , AnySuffix (\_ -> setDynFlag Opt_KeepHcFiles))
-  ,  ( "keep-s-file"    , AnySuffix (\_ -> setDynFlag Opt_KeepSFiles))
-  ,  ( "keep-raw-s-file", AnySuffix (\_ -> setDynFlag Opt_KeepRawSFiles))
-  ,  ( "keep-tmp-files" , AnySuffix (\_ -> setDynFlag Opt_KeepTmpFiles))
-
-	------- Miscellaneous ----------------------------------------------
-  ,  ( "no-hs-main"     , NoArg (setDynFlag Opt_NoHsMain))
-  ,  ( "main-is"   	, SepArg setMainIs )
-
-	------- recompilation checker --------------------------------------
-  ,  ( "recomp"		, NoArg (setDynFlag   Opt_RecompChecking) )
-  ,  ( "no-recomp"  	, NoArg (unSetDynFlag Opt_RecompChecking) )
-
-        ------- Packages ----------------------------------------------------
-  ,  ( "package-conf"   , HasArg extraPkgConf_ )
-  ,  ( "no-user-package-conf", NoArg (unSetDynFlag Opt_ReadUserPackageConf) )
-  ,  ( "package-name"   , HasArg ignorePackage ) -- for compatibility
-  ,  ( "package"        , HasArg exposePackage )
-  ,  ( "hide-package"   , HasArg hidePackage )
-  ,  ( "hide-all-packages", NoArg (setDynFlag Opt_HideAllPackages) )
-  ,  ( "ignore-package" , HasArg ignorePackage )
-  ,  ( "syslib"         , HasArg exposePackage )  -- for compatibility
-
-	------ HsCpp opts ---------------------------------------------------
-  ,  ( "D",		AnySuffix (upd . addOptP) )
-  ,  ( "U",		AnySuffix (upd . addOptP) )
-
-	------- Include/Import Paths ----------------------------------------
-  ,  ( "I" 		, Prefix    addIncludePath)
-  ,  ( "i"		, OptPrefix addImportPath )
-
-	------ Debugging ----------------------------------------------------
-  ,  ( "dstg-stats",	NoArg (setDynFlag Opt_StgStats))
-
-  ,  ( "ddump-cmm",         	 setDumpFlag Opt_D_dump_cmm)
-  ,  ( "ddump-asm",          	 setDumpFlag Opt_D_dump_asm)
-  ,  ( "ddump-cpranal",      	 setDumpFlag Opt_D_dump_cpranal)
-  ,  ( "ddump-deriv",        	 setDumpFlag Opt_D_dump_deriv)
-  ,  ( "ddump-ds",           	 setDumpFlag Opt_D_dump_ds)
-  ,  ( "ddump-flatC",        	 setDumpFlag Opt_D_dump_flatC)
-  ,  ( "ddump-foreign",      	 setDumpFlag Opt_D_dump_foreign)
-  ,  ( "ddump-inlinings",    	 setDumpFlag Opt_D_dump_inlinings)
-  ,  ( "ddump-occur-anal",   	 setDumpFlag Opt_D_dump_occur_anal)
-  ,  ( "ddump-parsed",       	 setDumpFlag Opt_D_dump_parsed)
-  ,  ( "ddump-rn",           	 setDumpFlag Opt_D_dump_rn)
-  ,  ( "ddump-simpl",        	 setDumpFlag Opt_D_dump_simpl)
-  ,  ( "ddump-simpl-iterations", setDumpFlag Opt_D_dump_simpl_iterations)
-  ,  ( "ddump-spec",         	 setDumpFlag Opt_D_dump_spec)
-  ,  ( "ddump-prep",          	 setDumpFlag Opt_D_dump_prep)
-  ,  ( "ddump-stg",          	 setDumpFlag Opt_D_dump_stg)
-  ,  ( "ddump-stranal",      	 setDumpFlag Opt_D_dump_stranal)
-  ,  ( "ddump-tc",           	 setDumpFlag Opt_D_dump_tc)
-  ,  ( "ddump-types",        	 setDumpFlag Opt_D_dump_types)
-  ,  ( "ddump-rules",        	 setDumpFlag Opt_D_dump_rules)
-  ,  ( "ddump-cse",          	 setDumpFlag Opt_D_dump_cse)
-  ,  ( "ddump-worker-wrapper",   setDumpFlag Opt_D_dump_worker_wrapper)
-  ,  ( "ddump-rn-trace",         NoArg (setDynFlag Opt_D_dump_rn_trace))
-  ,  ( "ddump-if-trace",         NoArg (setDynFlag Opt_D_dump_if_trace))
-  ,  ( "ddump-tc-trace",         setDumpFlag Opt_D_dump_tc_trace)
-  ,  ( "ddump-splices",          setDumpFlag Opt_D_dump_splices)
-  ,  ( "ddump-rn-stats",         NoArg (setDynFlag Opt_D_dump_rn_stats))
-  ,  ( "ddump-opt-cmm",          setDumpFlag Opt_D_dump_opt_cmm)
-  ,  ( "ddump-simpl-stats",      setDumpFlag Opt_D_dump_simpl_stats)
-  ,  ( "ddump-bcos",             setDumpFlag Opt_D_dump_BCOs)
-  ,  ( "dsource-stats",          setDumpFlag Opt_D_source_stats)
-  ,  ( "dverbose-core2core",     setDumpFlag Opt_D_verbose_core2core)
-  ,  ( "dverbose-stg2stg",       setDumpFlag Opt_D_verbose_stg2stg)
-  ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs))
-  ,  ( "ddump-hi",               setDumpFlag Opt_D_dump_hi)
-  ,  ( "ddump-minimal-imports",  NoArg (setDynFlag Opt_D_dump_minimal_imports))
-  ,  ( "ddump-vect",         	 setDumpFlag Opt_D_dump_vect)
-  ,  ( "dcore-lint",       	 NoArg (setDynFlag Opt_DoCoreLinting))
-  ,  ( "dstg-lint",        	 NoArg (setDynFlag Opt_DoStgLinting))
-  ,  ( "dcmm-lint",		 NoArg (setDynFlag Opt_DoCmmLinting))
-  ,  ( "dshow-passes",           NoArg (do unSetDynFlag Opt_RecompChecking
-				           setVerbosity "2") )
-  ,  ( "dfaststring-stats",	 NoArg (setDynFlag Opt_D_faststring_stats))
-
-	------ Machine dependant (-m<blah>) stuff ---------------------------
-
-  ,  ( "monly-2-regs", 	NoArg (upd (\s -> s{stolen_x86_regs = 2}) ))
-  ,  ( "monly-3-regs", 	NoArg (upd (\s -> s{stolen_x86_regs = 3}) ))
-  ,  ( "monly-4-regs", 	NoArg (upd (\s -> s{stolen_x86_regs = 4}) ))
-
-	------ Warning opts -------------------------------------------------
-  ,  ( "W"		, NoArg (mapM_ setDynFlag   minusWOpts)    )
-  ,  ( "Werror"		, NoArg (setDynFlag   	    Opt_WarnIsError) )
-  ,  ( "Wall"		, NoArg (mapM_ setDynFlag   minusWallOpts) )
-  ,  ( "Wnot"		, NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */
-  ,  ( "w"		, NoArg (mapM_ unSetDynFlag minusWallOpts) )
-
-	------ Optimisation flags ------------------------------------------
-  ,  ( "O"		   , NoArg (upd (setOptLevel 1)))
-  ,  ( "Onot"		   , NoArg (upd (setOptLevel 0)))
-  ,  ( "O"		   , PrefixPred (all isDigit) 
-				(\f -> upd (setOptLevel (read f))))
-
-  ,  ( "fmax-simplifier-iterations", 
-		PrefixPred (all isDigit) 
-		  (\n -> upd (\dfs -> 
-			dfs{ maxSimplIterations = read n })) )
-
-  ,  ( "frule-check", 
-		SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s })))
-
-        ------ Compiler flags -----------------------------------------------
-
-  ,  ( "fno-code",	NoArg (setTarget HscNothing))
-  ,  ( "fasm",		AnySuffix (\_ -> setTarget HscAsm) )
-  ,  ( "fvia-c",	NoArg (setTarget HscC) )
-  ,  ( "fvia-C",	NoArg (setTarget HscC) )
-  ,  ( "filx",		NoArg (setTarget HscILX) )
-
-  ,  ( "fglasgow-exts",    NoArg (mapM_ setDynFlag   glasgowExtsFlags) )
-  ,  ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) )
-
-	-- the rest of the -f* and -fno-* flags
-  ,  ( "fno-", 		PrefixPred (\f -> isFFlag f) (\f -> unSetDynFlag (getFFlag f)) )
-  ,  ( "f",		PrefixPred (\f -> isFFlag f) (\f -> setDynFlag (getFFlag f)) )
- ]
-
--- these -f<blah> flags can all be reversed with -fno-<blah>
-
-fFlags = [
-  ( "warn-duplicate-exports",    	Opt_WarnDuplicateExports ),
-  ( "warn-hi-shadowing",         	Opt_WarnHiShadows ),
-  ( "warn-incomplete-patterns",  	Opt_WarnIncompletePatterns ),
-  ( "warn-incomplete-record-updates",  	Opt_WarnIncompletePatternsRecUpd ),
-  ( "warn-missing-fields",       	Opt_WarnMissingFields ),
-  ( "warn-missing-methods",      	Opt_WarnMissingMethods ),
-  ( "warn-missing-signatures",   	Opt_WarnMissingSigs ),
-  ( "warn-name-shadowing",       	Opt_WarnNameShadowing ),
-  ( "warn-overlapping-patterns", 	Opt_WarnOverlappingPatterns ),
-  ( "warn-simple-patterns",      	Opt_WarnSimplePatterns ),
-  ( "warn-type-defaults",        	Opt_WarnTypeDefaults ),
-  ( "warn-unused-binds",         	Opt_WarnUnusedBinds ),
-  ( "warn-unused-imports",       	Opt_WarnUnusedImports ),
-  ( "warn-unused-matches",       	Opt_WarnUnusedMatches ),
-  ( "warn-deprecations",         	Opt_WarnDeprecations ),
-  ( "warn-orphans",	         	Opt_WarnOrphans ),
-  ( "fi",				Opt_FFI ),  -- support `-ffi'...
-  ( "ffi",				Opt_FFI ),  -- ...and also `-fffi'
-  ( "arrows",				Opt_Arrows ), -- arrow syntax
-  ( "parr",				Opt_PArr ),
-  ( "th",				Opt_TH ),
-  ( "implicit-prelude",  		Opt_ImplicitPrelude ),
-  ( "scoped-type-variables",  		Opt_ScopedTypeVariables ),
-  ( "bang-patterns",	  		Opt_BangPatterns ),
-  ( "monomorphism-restriction",		Opt_MonomorphismRestriction ),
-  ( "implicit-params",			Opt_ImplicitParams ),
-  ( "allow-overlapping-instances", 	Opt_AllowOverlappingInstances ),
-  ( "allow-undecidable-instances", 	Opt_AllowUndecidableInstances ),
-  ( "allow-incoherent-instances", 	Opt_AllowIncoherentInstances ),
-  ( "generics",  			Opt_Generics ),
-  ( "strictness",			Opt_Strictness ),
-  ( "full-laziness",			Opt_FullLaziness ),
-  ( "cse",				Opt_CSE ),
-  ( "ignore-interface-pragmas",		Opt_IgnoreInterfacePragmas ),
-  ( "omit-interface-pragmas",		Opt_OmitInterfacePragmas ),
-  ( "do-lambda-eta-expansion",		Opt_DoLambdaEtaExpansion ),
-  ( "ignore-asserts",			Opt_IgnoreAsserts ),
-  ( "ignore-breakpoints",               Opt_IgnoreBreakpoints),
-  ( "do-eta-reduction",			Opt_DoEtaReduction ),
-  ( "case-merge",			Opt_CaseMerge ),
-  ( "unbox-strict-fields",		Opt_UnboxStrictFields ),
-  ( "excess-precision",			Opt_ExcessPrecision ),
-  ( "asm-mangling",			Opt_DoAsmMangling )
-  ]
-
-glasgowExtsFlags = [ 
-  Opt_GlasgowExts, 
-  Opt_FFI, 
-  Opt_TH, 
-  Opt_ImplicitParams, 
-  Opt_ScopedTypeVariables,
-  Opt_BangPatterns ]
-
-isFFlag f = f `elem` (map fst fFlags)
-getFFlag f = fromJust (lookup f fFlags)
-
--- -----------------------------------------------------------------------------
--- Parsing the dynamic flags.
-
-parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags,[String])
-parseDynamicFlags dflags args = do
-  let ((leftover,errs),dflags') 
-	  = runCmdLine (processArgs dynamic_flags args) dflags
-  when (not (null errs)) $ do
-    throwDyn (UsageError (unlines errs))
-  return (dflags', leftover)
-
-
-type DynP = CmdLineP DynFlags
-
-upd :: (DynFlags -> DynFlags) -> DynP ()
-upd f = do 
-   dfs <- getCmdLineState
-   putCmdLineState $! (f dfs)
-
-setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
-setDynFlag f   = upd (\dfs -> dopt_set dfs f)
-unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
-
-setDumpFlag :: DynFlag -> OptKind DynP
-setDumpFlag dump_flag 
-  = NoArg (unSetDynFlag Opt_RecompChecking >> setDynFlag dump_flag)
-	-- Whenver we -ddump, switch off the recompilation checker,
-	-- else you don't see the dump!
-
-setVerbosity "" = upd (\dfs -> dfs{ verbosity = 3 })
-setVerbosity n 
-  | all isDigit n = upd (\dfs -> dfs{ verbosity = read n })
-  | otherwise     = throwDyn (UsageError "can't parse verbosity flag (-v<n>)")
-
-addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes =  a : cmdlineHcIncludes s})
-
-extraPkgConf_  p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s })
-
-exposePackage p = 
-  upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s })
-hidePackage p = 
-  upd (\s -> s{ packageFlags = HidePackage p : packageFlags s })
-ignorePackage p = 
-  upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s })
-
--- we can only switch between HscC, HscAsmm, and HscILX with dynamic flags 
--- (-fvia-C, -fasm, -filx respectively).
-setTarget l = upd (\dfs -> case hscTarget dfs of
-					HscC   -> dfs{ hscTarget = l }
-					HscAsm -> dfs{ hscTarget = l }
-					HscILX -> dfs{ hscTarget = l }
-					_      -> dfs)
-
-setOptLevel :: Int -> DynFlags -> DynFlags
-setOptLevel n dflags
-   | hscTarget dflags == HscInterpreted && n > 0
-	= dflags
-	    -- not in IO any more, oh well:
-	    -- putStr "warning: -O conflicts with --interactive; -O ignored.\n"
-   | otherwise
-	= updOptLevel n dflags
-
-
-setMainIs :: String -> DynP ()
-setMainIs arg
-  | not (null main_fn)		-- The arg looked like "Foo.baz"
-  = upd $ \d -> d{ mainFunIs = Just main_fn,
-	  	   mainModIs = mkModule main_mod }
-
-  | isUpper (head main_mod)	-- The arg looked like "Foo"
-  = upd $ \d -> d{ mainModIs = mkModule main_mod }
-  
-  | otherwise			-- The arg looked like "baz"
-  = upd $ \d -> d{ mainFunIs = Just main_mod }
-  where
-    (main_mod, main_fn) = splitLongestPrefix arg (== '.')
-
------------------------------------------------------------------------------
--- Paths & Libraries
-
--- -i on its own deletes the import paths
-addImportPath "" = upd (\s -> s{importPaths = []})
-addImportPath p  = upd (\s -> s{importPaths = importPaths s ++ splitPathList p})
-
-
-addLibraryPath p = 
-  upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p})
-
-addIncludePath p = 
-  upd (\s -> s{includePaths = includePaths s ++ splitPathList p})
-
-addFrameworkPath p = 
-  upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p})
-
-split_marker = ':'   -- not configurable (ToDo)
-
-splitPathList :: String -> [String]
-splitPathList s = filter notNull (splitUp s)
-		-- empty paths are ignored: there might be a trailing
-		-- ':' in the initial list, for example.  Empty paths can
-		-- cause confusion when they are translated into -I options
-		-- for passing to gcc.
-  where
-#ifndef mingw32_TARGET_OS
-    splitUp xs = split split_marker xs
-#else 
-     -- Windows: 'hybrid' support for DOS-style paths in directory lists.
-     -- 
-     -- That is, if "foo:bar:baz" is used, this interpreted as
-     -- consisting of three entries, 'foo', 'bar', 'baz'.
-     -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted
-     -- as 3 elts, "c:/foo", "c:\\foo", "x:/bar"
-     --
-     -- Notice that no attempt is made to fully replace the 'standard'
-     -- split marker ':' with the Windows / DOS one, ';'. The reason being
-     -- that this will cause too much breakage for users & ':' will
-     -- work fine even with DOS paths, if you're not insisting on being silly.
-     -- So, use either.
-    splitUp []             = []
-    splitUp (x:':':div:xs) | div `elem` dir_markers
-			   = ((x:':':div:p): splitUp rs)
-			   where
-			      (p,rs) = findNextPath xs
-	  -- we used to check for existence of the path here, but that
-	  -- required the IO monad to be threaded through the command-line
-   	  -- parser which is quite inconvenient.  The 
-    splitUp xs = cons p (splitUp rs)
-	       where
-		 (p,rs) = findNextPath xs
-    
-		 cons "" xs = xs
-		 cons x  xs = x:xs
-
-    -- will be called either when we've consumed nought or the
-    -- "<Drive>:/" part of a DOS path, so splitting is just a Q of
-    -- finding the next split marker.
-    findNextPath xs = 
-        case break (`elem` split_markers) xs of
-	   (p, d:ds) -> (p, ds)
-	   (p, xs)   -> (p, xs)
-
-    split_markers :: [Char]
-    split_markers = [':', ';']
-
-    dir_markers :: [Char]
-    dir_markers = ['/', '\\']
-#endif
-
--- -----------------------------------------------------------------------------
--- tmpDir, where we store temporary files.
-
-setTmpDir :: FilePath -> DynFlags -> DynFlags
-setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir }
-  where
-#if !defined(mingw32_HOST_OS)
-     canonicalise p = normalisePath p
-#else
-	-- Canonicalisation of temp path under win32 is a bit more
-	-- involved: (a) strip trailing slash, 
-	-- 	     (b) normalise slashes
-	--	     (c) just in case, if there is a prefix /cygdrive/x/, change to x:
-	-- 
-     canonicalise path = normalisePath (xltCygdrive (removeTrailingSlash path))
-
-        -- if we're operating under cygwin, and TMP/TEMP is of
-	-- the form "/cygdrive/drive/path", translate this to
-	-- "drive:/path" (as GHC isn't a cygwin app and doesn't
-	-- understand /cygdrive paths.)
-     xltCygdrive path
-      | "/cygdrive/" `isPrefixOf` path = 
-	  case drop (length "/cygdrive/") path of
-	    drive:xs@('/':_) -> drive:':':xs
-	    _ -> path
-      | otherwise = path
-
-        -- strip the trailing backslash (awful, but we only do this once).
-     removeTrailingSlash path = 
-       case last path of
-         '/'  -> init path
-         '\\' -> init path
-         _    -> path
-#endif
-
------------------------------------------------------------------------------
--- Via-C compilation stuff
-
-machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations
-			      [String]) -- for registerised HC compilations
-machdepCCOpts dflags
-#if alpha_TARGET_ARCH
-	=       ( ["-w", "-mieee"
-#ifdef HAVE_THREADED_RTS_SUPPORT
-		    , "-D_REENTRANT"
-#endif
-		   ], [] )
-	-- For now, to suppress the gcc warning "call-clobbered
-	-- register used for global register variable", we simply
-	-- disable all warnings altogether using the -w flag. Oh well.
-
-#elif hppa_TARGET_ARCH
-        -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
-        -- (very nice, but too bad the HP /usr/include files don't agree.)
-	= ( ["-D_HPUX_SOURCE"], [] )
-
-#elif m68k_TARGET_ARCH
-      -- -fno-defer-pop : for the .hc files, we want all the pushing/
-      --    popping of args to routines to be explicit; if we let things
-      --    be deferred 'til after an STGJUMP, imminent death is certain!
-      --
-      -- -fomit-frame-pointer : *don't*
-      --     It's better to have a6 completely tied up being a frame pointer
-      --     rather than let GCC pick random things to do with it.
-      --     (If we want to steal a6, then we would try to do things
-      --     as on iX86, where we *do* steal the frame pointer [%ebp].)
-	= ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] )
-
-#elif i386_TARGET_ARCH
-      -- -fno-defer-pop : basically the same game as for m68k
-      --
-      -- -fomit-frame-pointer : *must* in .hc files; because we're stealing
-      --   the fp (%ebp) for our register maps.
-	=  let n_regs = stolen_x86_regs dflags
-	       sta = opt_Static
-	   in
-	            ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else ""
---                    , if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" 
-		      ],
-		      [ "-fno-defer-pop",
-#ifdef HAVE_GCC_MNO_OMIT_LFPTR
-			-- Some gccs are configured with
-			-- -momit-leaf-frame-pointer on by default, and it
-			-- apparently takes precedence over 
-			-- -fomit-frame-pointer, so we disable it first here.
-			"-mno-omit-leaf-frame-pointer",
-#endif
-			"-fomit-frame-pointer",
-			-- we want -fno-builtin, because when gcc inlines
-			-- built-in functions like memcpy() it tends to
-			-- run out of registers, requiring -monly-n-regs
-			"-fno-builtin",
-	                "-DSTOLEN_X86_REGS="++show n_regs ]
-		    )
-
-#elif ia64_TARGET_ARCH
-	= ( [], ["-fomit-frame-pointer", "-G0"] )
-
-#elif x86_64_TARGET_ARCH
-	= ( [], ["-fomit-frame-pointer",
-		 "-fno-asynchronous-unwind-tables",
-			-- the unwind tables are unnecessary for HC code,
-			-- and get in the way of -split-objs.  Another option
-			-- would be to throw them away in the mangler, but this
-			-- is easier.
-		 "-fno-unit-at-a-time",
-			-- unit-at-a-time doesn't do us any good, and screws
-			-- up -split-objs by moving the split markers around.
-			-- It's only turned on with -O2, but put it here just
-			-- in case someone uses -optc-O2.
-		 "-fno-builtin"
-			-- calling builtins like strlen() using the FFI can
-			-- cause gcc to run out of regs, so use the external
-			-- version.
-		] )
-
-#elif mips_TARGET_ARCH
-	= ( ["-static"], [] )
-
-#elif sparc_TARGET_ARCH
-	= ( [], ["-w"] )
-	-- For now, to suppress the gcc warning "call-clobbered
-	-- register used for global register variable", we simply
-	-- disable all warnings altogether using the -w flag. Oh well.
-
-#elif powerpc_apple_darwin_TARGET
-      -- -no-cpp-precomp:
-      --     Disable Apple's precompiling preprocessor. It's a great thing
-      --     for "normal" programs, but it doesn't support register variable
-      --     declarations.
-        = ( [], ["-no-cpp-precomp"] )
-#else
-	= ( [], [] )
-#endif
-
-picCCOpts :: DynFlags -> [String]
-picCCOpts dflags
-#if darwin_TARGET_OS
-      -- Apple prefers to do things the other way round.
-      -- PIC is on by default.
-      -- -mdynamic-no-pic:
-      --     Turn off PIC code generation.
-      -- -fno-common:
-      --     Don't generate "common" symbols - these are unwanted
-      --     in dynamic libraries.
-
-    | opt_PIC
-        = ["-fno-common"]
-    | otherwise
-        = ["-mdynamic-no-pic"]
-#elif mingw32_TARGET_OS
-      -- no -fPIC for Windows
-        = []
-#else
-    | opt_PIC
-        = ["-fPIC"]
-    | otherwise
-        = []
-#endif
-
--- -----------------------------------------------------------------------------
--- Splitting
-
-can_split :: Bool
-can_split =  
-#if    defined(i386_TARGET_ARCH)     \
-    || defined(x86_64_TARGET_ARCH)   \
-    || defined(alpha_TARGET_ARCH)    \
-    || defined(hppa_TARGET_ARCH)     \
-    || defined(m68k_TARGET_ARCH)     \
-    || defined(mips_TARGET_ARCH)     \
-    || defined(powerpc_TARGET_ARCH)  \
-    || defined(rs6000_TARGET_ARCH)   \
-    || defined(sparc_TARGET_ARCH) 
-   True
-#else
-   False
-#endif
-
diff --git a/ghc/compiler/main/ErrUtils.hi-boot-6 b/ghc/compiler/main/ErrUtils.hi-boot-6
deleted file mode 100644
index fd98ca3950..0000000000
--- a/ghc/compiler/main/ErrUtils.hi-boot-6
+++ /dev/null
@@ -1,11 +0,0 @@
-module ErrUtils where
-
-data Severity
-  = SevInfo
-  | SevWarning
-  | SevError
-  | SevFatal
-
-type Message = Outputable.SDoc
-
-mkLocMessage :: SrcLoc.SrcSpan -> Message -> Message
diff --git a/ghc/compiler/main/ErrUtils.lhs b/ghc/compiler/main/ErrUtils.lhs
deleted file mode 100644
index 90e5dc87b6..0000000000
--- a/ghc/compiler/main/ErrUtils.lhs
+++ /dev/null
@@ -1,260 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1994-1998
-%
-\section[ErrsUtils]{Utilities for error reporting}
-
-\begin{code}
-module ErrUtils (
-	Message, mkLocMessage, printError,
-	Severity(..),
-
-	ErrMsg, WarnMsg,
-	errMsgSpans, errMsgContext, errMsgShortDoc, errMsgExtraInfo,
-	Messages, errorsFound, emptyMessages,
-	mkErrMsg, mkWarnMsg, mkPlainErrMsg, mkLongErrMsg,
-	printErrorsAndWarnings, printBagOfErrors, printBagOfWarnings,
-
-	ghcExit,
-	doIfSet, doIfSet_dyn, 
-	dumpIfSet, dumpIfSet_core, dumpIfSet_dyn, dumpIfSet_dyn_or, mkDumpDoc,	
-
-	--  * Messages during compilation
-	putMsg,
-	errorMsg,
-	fatalErrorMsg,
-	compilationProgressMsg,
-	showPass,
-	debugTraceMsg,	
-    ) where
-
-#include "HsVersions.h"
-
-import Bag		( Bag, bagToList, isEmptyBag, emptyBag )
-import SrcLoc		( SrcSpan )
-import Util		( sortLe, global )
-import Outputable
-import qualified Pretty
-import SrcLoc		( srcSpanStart, noSrcSpan )
-import DynFlags		( DynFlags(..), DynFlag(..), dopt )
-import StaticFlags	( opt_ErrorSpans )
-import System		( ExitCode(..), exitWith )
-import DATA_IOREF
-import IO		( hPutStrLn, stderr )
-import DYNAMIC
-
-
--- -----------------------------------------------------------------------------
--- Basic error messages: just render a message with a source location.
-
-type Message = SDoc
-
-data Severity
-  = SevInfo
-  | SevWarning
-  | SevError
-  | SevFatal
-
-mkLocMessage :: SrcSpan -> Message -> Message
-mkLocMessage locn msg
-  | opt_ErrorSpans = hang (ppr locn <> colon) 4 msg
-  | otherwise      = hang (ppr (srcSpanStart locn) <> colon) 4 msg
-  -- always print the location, even if it is unhelpful.  Error messages
-  -- are supposed to be in a standard format, and one without a location
-  -- would look strange.  Better to say explicitly "<no location info>".
-
-printError :: SrcSpan -> Message -> IO ()
-printError span msg = printErrs (mkLocMessage span msg $ defaultErrStyle)
-
-
--- -----------------------------------------------------------------------------
--- Collecting up messages for later ordering and printing.
-
-data ErrMsg = ErrMsg { 
-	errMsgSpans     :: [SrcSpan],
-	errMsgContext   :: PrintUnqualified,
-	errMsgShortDoc  :: Message,
-	errMsgExtraInfo :: Message
-	}
-	-- The SrcSpan is used for sorting errors into line-number order
-	-- NB  Pretty.Doc not SDoc: we deal with the printing style (in ptic 
-	-- whether to qualify an External Name) at the error occurrence
-
--- So we can throw these things as exceptions
-errMsgTc :: TyCon
-errMsgTc = mkTyCon "ErrMsg"
-{-# NOINLINE errMsgTc #-}
-instance Typeable ErrMsg where
-#if __GLASGOW_HASKELL__ < 603
-  typeOf _ = mkAppTy errMsgTc []
-#else
-  typeOf _ = mkTyConApp errMsgTc []
-#endif
-
-type WarnMsg = ErrMsg
-
--- A short (one-line) error message, with context to tell us whether
--- to qualify names in the message or not.
-mkErrMsg :: SrcSpan -> PrintUnqualified -> Message -> ErrMsg
-mkErrMsg locn print_unqual msg
-  = ErrMsg [locn] print_unqual msg empty
-
--- Variant that doesn't care about qualified/unqualified names
-mkPlainErrMsg :: SrcSpan -> Message -> ErrMsg
-mkPlainErrMsg locn msg
-  = ErrMsg [locn] alwaysQualify msg empty
-
--- A long (multi-line) error message, with context to tell us whether
--- to qualify names in the message or not.
-mkLongErrMsg :: SrcSpan -> PrintUnqualified -> Message -> Message -> ErrMsg
-mkLongErrMsg locn print_unqual msg extra 
- = ErrMsg [locn] print_unqual msg extra
-
-mkWarnMsg :: SrcSpan -> PrintUnqualified -> Message -> WarnMsg
-mkWarnMsg = mkErrMsg
-
-type Messages = (Bag WarnMsg, Bag ErrMsg)
-
-emptyMessages :: Messages
-emptyMessages = (emptyBag, emptyBag)
-
-errorsFound :: DynFlags -> Messages -> Bool
--- The dyn-flags are used to see if the user has specified
--- -Werorr, which says that warnings should be fatal
-errorsFound dflags (warns, errs) 
-  | dopt Opt_WarnIsError dflags = not (isEmptyBag errs) || not (isEmptyBag warns)
-  | otherwise  		        = not (isEmptyBag errs)
-
-printErrorsAndWarnings :: DynFlags -> Messages -> IO ()
-printErrorsAndWarnings dflags (warns, errs)
-  | no_errs && no_warns  = return ()
-  | no_errs		 = printBagOfWarnings dflags warns
-			    -- Don't print any warnings if there are errors
-  | otherwise		 = printBagOfErrors   dflags errs
-  where
-    no_warns = isEmptyBag warns
-    no_errs  = isEmptyBag errs
-
-printBagOfErrors :: DynFlags -> Bag ErrMsg -> IO ()
-printBagOfErrors dflags bag_of_errors
-  = sequence_   [ let style = mkErrStyle unqual
-		  in log_action dflags SevError s style (d $$ e)
-		| ErrMsg { errMsgSpans = s:ss,
-			   errMsgShortDoc = d,
-			   errMsgExtraInfo = e,
-			   errMsgContext = unqual } <- sorted_errs ]
-    where
-      bag_ls	  = bagToList bag_of_errors
-      sorted_errs = sortLe occ'ed_before bag_ls
-
-      occ'ed_before err1 err2 = 
-         case compare (head (errMsgSpans err1)) (head (errMsgSpans err2)) of
-		LT -> True
-		EQ -> True
-		GT -> False
-
-printBagOfWarnings :: DynFlags -> Bag ErrMsg -> IO ()
-printBagOfWarnings dflags bag_of_warns
-  = sequence_   [ let style = mkErrStyle unqual
-		  in log_action dflags SevWarning s style (d $$ e)
-		| ErrMsg { errMsgSpans = s:ss,
-			   errMsgShortDoc = d,
-			   errMsgExtraInfo = e,
-			   errMsgContext = unqual } <- sorted_errs ]
-    where
-      bag_ls	  = bagToList bag_of_warns
-      sorted_errs = sortLe occ'ed_before bag_ls
-
-      occ'ed_before err1 err2 = 
-         case compare (head (errMsgSpans err1)) (head (errMsgSpans err2)) of
-		LT -> True
-		EQ -> True
-		GT -> False
-\end{code}
-
-\begin{code}
-ghcExit :: DynFlags -> Int -> IO ()
-ghcExit dflags val
-  | val == 0  = exitWith ExitSuccess
-  | otherwise = do errorMsg dflags (text "\nCompilation had errors\n\n")
-	           exitWith (ExitFailure val)
-\end{code}
-
-\begin{code}
-doIfSet :: Bool -> IO () -> IO ()
-doIfSet flag action | flag      = action
-		    | otherwise = return ()
-
-doIfSet_dyn :: DynFlags -> DynFlag -> IO () -> IO()
-doIfSet_dyn dflags flag action | dopt flag dflags = action
-		               | otherwise        = return ()
-\end{code}
-
-\begin{code}
-dumpIfSet :: Bool -> String -> SDoc -> IO ()
-dumpIfSet flag hdr doc
-  | not flag   = return ()
-  | otherwise  = printDump (mkDumpDoc hdr doc)
-
-dumpIfSet_core :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
-dumpIfSet_core dflags flag hdr doc
-  | dopt flag dflags
-	|| verbosity dflags >= 4
-	|| dopt Opt_D_verbose_core2core dflags 	= printDump (mkDumpDoc hdr doc)
-  | otherwise                                   = return ()
-
-dumpIfSet_dyn :: DynFlags -> DynFlag -> String -> SDoc -> IO ()
-dumpIfSet_dyn dflags flag hdr doc
-  | dopt flag dflags || verbosity dflags >= 4 
-  = printDump (mkDumpDoc hdr doc)
-  | otherwise
-  = return ()
-
-dumpIfSet_dyn_or :: DynFlags -> [DynFlag] -> String -> SDoc -> IO ()
-dumpIfSet_dyn_or dflags flags hdr doc
-  | or [dopt flag dflags | flag <- flags]
-  || verbosity dflags >= 4 
-  = printDump (mkDumpDoc hdr doc)
-  | otherwise = return ()
-
-mkDumpDoc hdr doc 
-   = vcat [text "", 
-	   line <+> text hdr <+> line,
-	   doc,
-	   text ""]
-     where 
-        line = text (replicate 20 '=')
-
--- -----------------------------------------------------------------------------
--- Outputting messages from the compiler
-
--- We want all messages to go through one place, so that we can
--- redirect them if necessary.  For example, when GHC is used as a
--- library we might want to catch all messages that GHC tries to
--- output and do something else with them.
-
-ifVerbose :: DynFlags -> Int -> IO () -> IO ()
-ifVerbose dflags val act
-  | verbosity dflags >= val = act
-  | otherwise               = return ()
-
-putMsg :: DynFlags -> Message -> IO ()
-putMsg dflags msg = log_action dflags SevInfo noSrcSpan defaultUserStyle msg
-
-errorMsg :: DynFlags -> Message -> IO ()
-errorMsg dflags msg = log_action dflags SevError noSrcSpan defaultErrStyle msg
-
-fatalErrorMsg :: DynFlags -> Message -> IO ()
-fatalErrorMsg dflags msg = log_action dflags SevFatal noSrcSpan defaultErrStyle msg
-
-compilationProgressMsg :: DynFlags -> String -> IO ()
-compilationProgressMsg dflags msg
-  = ifVerbose dflags 1 (log_action dflags SevInfo noSrcSpan defaultUserStyle (text msg))
-
-showPass :: DynFlags -> String -> IO ()
-showPass dflags what 
-  = ifVerbose dflags 2 (log_action dflags SevInfo noSrcSpan defaultUserStyle (text "***" <+> text what <> colon))
-
-debugTraceMsg :: DynFlags -> Int -> Message -> IO ()
-debugTraceMsg dflags val msg
-  = ifVerbose dflags val (log_action dflags SevInfo noSrcSpan defaultDumpStyle msg)
-\end{code}
diff --git a/ghc/compiler/main/ErrUtils.lhs-boot b/ghc/compiler/main/ErrUtils.lhs-boot
deleted file mode 100644
index 77d6cfdb4a..0000000000
--- a/ghc/compiler/main/ErrUtils.lhs-boot
+++ /dev/null
@@ -1,16 +0,0 @@
-\begin{code}
-module ErrUtils where
-
-import Outputable (SDoc)
-import SrcLoc (SrcSpan)
-
-data Severity
-  = SevInfo
-  | SevWarning
-  | SevError
-  | SevFatal
-
-type Message = SDoc
-
-mkLocMessage :: SrcSpan -> Message -> Message
-\end{code}
diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs
deleted file mode 100644
index fbde40f6ea..0000000000
--- a/ghc/compiler/main/Finder.lhs
+++ /dev/null
@@ -1,499 +0,0 @@
-%
-% (c) The University of Glasgow, 2000
-%
-\section[Finder]{Module Finder}
-
-\begin{code}
-module Finder (
-    flushFinderCache,	-- :: IO ()
-    FindResult(..),
-    findModule,			-- :: ModuleName -> Bool -> IO FindResult
-    findPackageModule,  	-- :: ModuleName -> Bool -> IO FindResult
-    mkHomeModLocation,		-- :: ModuleName -> FilePath -> IO ModLocation
-    mkHomeModLocation2,		-- :: ModuleName -> FilePath -> String -> IO ModLocation
-    addHomeModuleToFinder, 	-- :: HscEnv -> Module -> ModLocation -> IO ()
-    uncacheModule,		-- :: HscEnv -> Module -> IO ()
-    mkStubPaths,
-
-    findObjectLinkableMaybe,
-    findObjectLinkable,
-
-    cantFindError, 	-- :: DynFlags -> Module -> FindResult -> SDoc
-  ) where
-
-#include "HsVersions.h"
-
-import Module
-import UniqFM		( filterUFM, delFromUFM )
-import HscTypes
-import Packages
-import FastString
-import Util
-import DynFlags		( DynFlags(..), isOneShot, GhcMode(..) )
-import Outputable
-import Maybes		( expectJust )
-
-import DATA_IOREF	( IORef, writeIORef, readIORef )
-
-import Data.List
-import System.Directory
-import System.IO
-import Control.Monad
-import Data.Maybe	( isNothing )
-import Time		( ClockTime )
-
-
-type FileExt = String	-- Filename extension
-type BaseName = String	-- Basename of file
-
--- -----------------------------------------------------------------------------
--- The Finder
-
--- The Finder provides a thin filesystem abstraction to the rest of
--- the compiler.  For a given module, it can tell you where the
--- source, interface, and object files for that module live.
-
--- It does *not* know which particular package a module lives in.  Use
--- Packages.lookupModuleInAllPackages for that.
-
--- -----------------------------------------------------------------------------
--- The finder's cache
-
--- remove all the home modules from the cache; package modules are
--- assumed to not move around during a session.
-flushFinderCache :: IORef FinderCache -> IO ()
-flushFinderCache finder_cache = do
-  fm <- readIORef finder_cache
-  writeIORef finder_cache $! filterUFM (\(loc,m) -> isNothing m) fm
-
-addToFinderCache :: IORef FinderCache -> Module -> FinderCacheEntry -> IO ()
-addToFinderCache finder_cache mod_name entry = do
-  fm <- readIORef finder_cache
-  writeIORef finder_cache $! extendModuleEnv fm mod_name entry
-
-removeFromFinderCache :: IORef FinderCache -> Module -> IO ()
-removeFromFinderCache finder_cache mod_name = do
-  fm <- readIORef finder_cache
-  writeIORef finder_cache $! delFromUFM fm mod_name
-
-lookupFinderCache :: IORef FinderCache -> Module -> IO (Maybe FinderCacheEntry)
-lookupFinderCache finder_cache mod_name = do
-  fm <- readIORef finder_cache
-  return $! lookupModuleEnv fm mod_name
-
--- -----------------------------------------------------------------------------
--- The two external entry points
-
--- This is the main interface to the finder, which maps ModuleNames to
--- Modules and ModLocations.
---
--- The Module contains one crucial bit of information about a module:
--- whether it lives in the current ("home") package or not (see Module
--- for more details).
---
--- The ModLocation contains the names of all the files associated with
--- that module: its source file, .hi file, object file, etc.
-
-data FindResult
-  = Found ModLocation PackageIdH
-	-- the module was found
-  | FoundMultiple [PackageId]
-	-- *error*: both in multiple packages
-  | PackageHidden PackageId
-	-- for an explicit source import: the package containing the module is
-	-- not exposed.
-  | ModuleHidden  PackageId
-	-- for an explicit source import: the package containing the module is
-	-- exposed, but the module itself is hidden.
-  | NotFound [FilePath]
-	-- the module was not found, the specified places were searched.
-
-findModule :: HscEnv -> Module -> Bool -> IO FindResult
-findModule = findModule' True
-  
-findPackageModule :: HscEnv -> Module -> Bool -> IO FindResult
-findPackageModule = findModule' False
-
-
-data LocalFindResult 
-  = Ok FinderCacheEntry
-  | CantFindAmongst [FilePath]
-  | MultiplePackages [PackageId]
-
-findModule' :: Bool -> HscEnv -> Module -> Bool -> IO FindResult
-findModule' home_allowed hsc_env name explicit 
-  = do	-- First try the cache
-  mb_entry <- lookupFinderCache cache name
-  case mb_entry of
-     Just old_entry -> return $! found old_entry
-     Nothing        -> not_cached
-
- where
-  cache  = hsc_FC hsc_env
-  dflags = hsc_dflags hsc_env
-
-	-- We've found the module, so the remaining question is
-	-- whether it's visible or not
-  found :: FinderCacheEntry -> FindResult
-  found (loc, Nothing)
-	| home_allowed  = Found loc HomePackage
-	| otherwise     = NotFound []
-  found (loc, Just (pkg, exposed_mod))
-	| explicit && not exposed_mod   = ModuleHidden pkg_name
-	| explicit && not (exposed pkg) = PackageHidden pkg_name
-	| otherwise = 
-		Found loc (ExtPackage (mkPackageId (package pkg)))
-	where
-	  pkg_name = packageConfigId pkg
-
-  found_new entry = do
-	addToFinderCache cache name entry
-	return $! found entry
-
-  not_cached
-	| not home_allowed = do
-	    j <- findPackageModule' dflags name
-	    case j of
-	       Ok entry              -> found_new entry
-	       MultiplePackages pkgs -> return (FoundMultiple pkgs)
-	       CantFindAmongst paths -> return (NotFound paths)
-
-	| otherwise = do
-	    j <- findHomeModule' dflags name
-	    case j of
-		Ok entry              -> found_new entry
-	        MultiplePackages pkgs -> return (FoundMultiple pkgs)
-		CantFindAmongst home_files -> do
-	    	    r <- findPackageModule' dflags name
-    	    	    case r of
-			CantFindAmongst pkg_files ->
-				return (NotFound (home_files ++ pkg_files))
-		        MultiplePackages pkgs -> 
-				return (FoundMultiple pkgs)
-			Ok entry -> 
-				found_new entry
-
-addHomeModuleToFinder :: HscEnv -> Module -> ModLocation -> IO ()
-addHomeModuleToFinder hsc_env mod loc 
-  = addToFinderCache (hsc_FC hsc_env) mod (loc, Nothing)
-
-uncacheModule :: HscEnv -> Module -> IO ()
-uncacheModule hsc_env mod = removeFromFinderCache (hsc_FC hsc_env) mod
-
--- -----------------------------------------------------------------------------
--- 	The internal workers
-
-findHomeModule' :: DynFlags -> Module -> IO LocalFindResult
-findHomeModule' dflags mod = do
-   let home_path = importPaths dflags
-       hisuf = hiSuf dflags
-
-   let
-     source_exts = 
-      [ ("hs",   mkHomeModLocationSearched dflags mod "hs")
-      , ("lhs",  mkHomeModLocationSearched dflags  mod "lhs")
-      ]
-     
-     hi_exts = [ (hisuf,  	 	mkHiOnlyModLocation dflags hisuf)
-	       , (addBootSuffix hisuf,	mkHiOnlyModLocation dflags hisuf)
-	       ]
-     
-     	-- In compilation manager modes, we look for source files in the home
-     	-- package because we can compile these automatically.  In one-shot
-     	-- compilation mode we look for .hi and .hi-boot files only.
-     exts | isOneShot (ghcMode dflags) = hi_exts
-          | otherwise      	       = source_exts
-
-   searchPathExts home_path mod exts
-   	
-findPackageModule' :: DynFlags -> Module -> IO LocalFindResult
-findPackageModule' dflags mod 
-  = case lookupModuleInAllPackages dflags mod of
-    	[]          -> return (CantFindAmongst [])
-	[pkg_info]  -> findPackageIface dflags mod pkg_info
-	many        -> return (MultiplePackages (map (mkPackageId.package.fst) many))
-
-findPackageIface :: DynFlags -> Module -> (PackageConfig,Bool) -> IO LocalFindResult
-findPackageIface dflags mod pkg_info@(pkg_conf, _) = do
-  let
-     tag = buildTag dflags
-
-	   -- hi-suffix for packages depends on the build tag.
-     package_hisuf | null tag  = "hi"
-		   | otherwise = tag ++ "_hi"
-     hi_exts =
-        [ (package_hisuf, 
-	    mkPackageModLocation dflags pkg_info package_hisuf) ]
-
-     source_exts = 
-       [ ("hs",   mkPackageModLocation dflags pkg_info package_hisuf)
-       , ("lhs",  mkPackageModLocation dflags pkg_info package_hisuf)
-       ]
-
-     -- mkdependHS needs to look for source files in packages too, so
-     -- that we can make dependencies between package before they have
-     -- been built.
-     exts 
-      | MkDepend <- ghcMode dflags = hi_exts ++ source_exts
-      | otherwise	 	   = hi_exts
-      -- we never look for a .hi-boot file in an external package;
-      -- .hi-boot files only make sense for the home package.
-
-  searchPathExts (importDirs pkg_conf) mod exts
-
--- -----------------------------------------------------------------------------
--- General path searching
-
-searchPathExts
-  :: [FilePath]		-- paths to search
-  -> Module		-- module name
-  -> [ (
-	FileExt,				     -- suffix
-	FilePath -> BaseName -> IO FinderCacheEntry  -- action
-       )
-     ] 
-  -> IO LocalFindResult
-
-searchPathExts paths mod exts 
-   = do result <- search to_search
-{-
-	hPutStrLn stderr (showSDoc $
-		vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
-		    , nest 2 (vcat (map text paths))
-		    , case result of
-			Succeeded (loc, p) -> text "Found" <+> ppr loc
-			Failed fs	   -> text "not found"])
--}	
-	return result
-
-  where
-    basename = dots_to_slashes (moduleString mod)
-
-    to_search :: [(FilePath, IO FinderCacheEntry)]
-    to_search = [ (file, fn path basename)
-		| path <- paths, 
-		  (ext,fn) <- exts,
-		  let base | path == "." = basename
-	     	           | otherwise   = path `joinFileName` basename
-	              file = base `joinFileExt` ext
-		]
-
-    search [] = return (CantFindAmongst (map fst to_search))
-    search ((file, mk_result) : rest) = do
-      b <- doesFileExist file
-      if b 
-	then do { res <- mk_result; return (Ok res) }
-	else search rest
-
-mkHomeModLocationSearched :: DynFlags -> Module -> FileExt
-		          -> FilePath -> BaseName -> IO FinderCacheEntry
-mkHomeModLocationSearched dflags mod suff path basename = do
-   loc <- mkHomeModLocation2 dflags mod (path `joinFileName` basename) suff
-   return (loc, Nothing)
-
-mkHiOnlyModLocation :: DynFlags -> FileExt -> FilePath -> BaseName
-		    -> IO FinderCacheEntry
-mkHiOnlyModLocation dflags hisuf path basename = do
-  loc <- hiOnlyModLocation dflags path basename hisuf
-  return (loc, Nothing)
-
-mkPackageModLocation :: DynFlags -> (PackageConfig, Bool) -> FileExt
-		     -> FilePath -> BaseName -> IO FinderCacheEntry
-mkPackageModLocation dflags pkg_info hisuf path basename = do
-  loc <- hiOnlyModLocation dflags path basename hisuf
-  return (loc, Just pkg_info)
-
--- -----------------------------------------------------------------------------
--- Constructing a home module location
-
--- This is where we construct the ModLocation for a module in the home
--- package, for which we have a source file.  It is called from three
--- places:
---
---  (a) Here in the finder, when we are searching for a module to import,
---      using the search path (-i option).
---
---  (b) The compilation manager, when constructing the ModLocation for
---      a "root" module (a source file named explicitly on the command line
---      or in a :load command in GHCi).
---
---  (c) The driver in one-shot mode, when we need to construct a
---      ModLocation for a source file named on the command-line.
---
--- Parameters are:
---
--- mod
---      The name of the module
---
--- path
---      (a): The search path component where the source file was found.
---      (b) and (c): "."
---
--- src_basename
---      (a): dots_to_slashes (moduleNameUserString mod)
---      (b) and (c): The filename of the source file, minus its extension
---
--- ext
---	The filename extension of the source file (usually "hs" or "lhs").
-
-mkHomeModLocation :: DynFlags -> Module -> FilePath -> IO ModLocation
-mkHomeModLocation dflags mod src_filename = do
-   let (basename,extension) = splitFilename src_filename
-   mkHomeModLocation2 dflags mod basename extension
-
-mkHomeModLocation2 :: DynFlags
-		   -> Module	
-		   -> FilePath 	-- Of source module, without suffix
-		   -> String 	-- Suffix
-		   -> IO ModLocation
-mkHomeModLocation2 dflags mod src_basename ext = do
-   let mod_basename = dots_to_slashes (moduleString mod)
-
-   obj_fn  <- mkObjPath  dflags src_basename mod_basename
-   hi_fn   <- mkHiPath   dflags src_basename mod_basename
-
-   return (ModLocation{ ml_hs_file   = Just (src_basename `joinFileExt` ext),
-			ml_hi_file   = hi_fn,
-			ml_obj_file  = obj_fn })
-
-hiOnlyModLocation :: DynFlags -> FilePath -> String -> Suffix -> IO ModLocation
-hiOnlyModLocation dflags path basename hisuf 
- = do let full_basename = path `joinFileName` basename
-      obj_fn  <- mkObjPath  dflags full_basename basename
-      return ModLocation{    ml_hs_file   = Nothing,
- 	        	     ml_hi_file   = full_basename  `joinFileExt` hisuf,
-		 		-- Remove the .hi-boot suffix from
-		 		-- hi_file, if it had one.  We always
-		 		-- want the name of the real .hi file
-		 		-- in the ml_hi_file field.
-	   	             ml_obj_file  = obj_fn
-                  }
-
--- | Constructs the filename of a .o file for a given source file.
--- Does /not/ check whether the .o file exists
-mkObjPath
-  :: DynFlags
-  -> FilePath		-- the filename of the source file, minus the extension
-  -> String		-- the module name with dots replaced by slashes
-  -> IO FilePath
-mkObjPath dflags basename mod_basename
-  = do  let
-		odir = objectDir dflags
-		osuf = objectSuf dflags
-	
-		obj_basename | Just dir <- odir = dir `joinFileName` mod_basename
-			     | otherwise        = basename
-
-        return (obj_basename `joinFileExt` osuf)
-
--- | Constructs the filename of a .hi file for a given source file.
--- Does /not/ check whether the .hi file exists
-mkHiPath
-  :: DynFlags
-  -> FilePath		-- the filename of the source file, minus the extension
-  -> String		-- the module name with dots replaced by slashes
-  -> IO FilePath
-mkHiPath dflags basename mod_basename
-  = do  let
-		hidir = hiDir dflags
-		hisuf = hiSuf dflags
-
-		hi_basename | Just dir <- hidir = dir `joinFileName` mod_basename
-			    | otherwise         = basename
-
-        return (hi_basename `joinFileExt` hisuf)
-
-
--- -----------------------------------------------------------------------------
--- Filenames of the stub files
-
--- We don't have to store these in ModLocations, because they can be derived
--- from other available information, and they're only rarely needed.
-
-mkStubPaths
-  :: DynFlags
-  -> Module
-  -> ModLocation
-  -> (FilePath,FilePath)
-
-mkStubPaths dflags mod location
-  = let
-		stubdir = stubDir dflags
-
-		mod_basename = dots_to_slashes (moduleString mod)
-		src_basename = basenameOf (expectJust "mkStubPaths" 
-						(ml_hs_file location))
-
-		stub_basename0
-			| Just dir <- stubdir = dir `joinFileName` mod_basename
-			| otherwise           = src_basename
-
-		stub_basename = stub_basename0 ++ "_stub"
-     in
-        (stub_basename `joinFileExt` "c",
-	 stub_basename `joinFileExt` "h")
-	-- the _stub.o filename is derived from the ml_obj_file.
-
--- -----------------------------------------------------------------------------
--- findLinkable isn't related to the other stuff in here, 
--- but there's no other obvious place for it
-
-findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable)
-findObjectLinkableMaybe mod locn
-   = do let obj_fn = ml_obj_file locn
-	maybe_obj_time <- modificationTimeIfExists obj_fn
-	case maybe_obj_time of
-	  Nothing -> return Nothing
-	  Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time)
-
--- Make an object linkable when we know the object file exists, and we know
--- its modification time.
-findObjectLinkable :: Module -> FilePath -> ClockTime -> IO Linkable
-findObjectLinkable mod obj_fn obj_time = do
-  let stub_fn = case splitFilename3 obj_fn of
-			(dir, base, ext) -> dir ++ "/" ++ base ++ "_stub.o"
-  stub_exist <- doesFileExist stub_fn
-  if stub_exist
-	then return (LM obj_time mod [DotO obj_fn, DotO stub_fn])
-	else return (LM obj_time mod [DotO obj_fn])
-
--- -----------------------------------------------------------------------------
--- Utils
-
-dots_to_slashes = map (\c -> if c == '.' then '/' else c)
-
-
--- -----------------------------------------------------------------------------
--- Error messages
-
-cantFindError :: DynFlags -> Module -> FindResult -> SDoc
-cantFindError dflags mod_name (FoundMultiple pkgs)
-  = hang (ptext SLIT("Cannot import") <+> quotes (ppr mod_name) <> colon) 2 (
-       sep [ptext SLIT("it was found in multiple packages:"),
-		hsep (map (text.packageIdString) pkgs)]
-    )
-cantFindError dflags mod_name find_result
-  = hang (ptext SLIT("Could not find module") <+> quotes (ppr mod_name) <> colon)
-       2 more_info
-  where
-    more_info
-      = case find_result of
-	    PackageHidden pkg 
-		-> ptext SLIT("it is a member of package") <+> ppr pkg <> comma
-		   <+> ptext SLIT("which is hidden")
-
-	    ModuleHidden pkg
-		-> ptext SLIT("it is hidden") <+> parens (ptext SLIT("in package")
-		   <+> ppr pkg)
-
-	    NotFound files
-		| null files
-		-> ptext SLIT("it is not a module in the current program, or in any known package.")
-		| verbosity dflags < 3 
-		-> ptext SLIT("use -v to see a list of the files searched for")
-		| otherwise 
-		-> hang (ptext SLIT("locations searched:")) 
-		      2 (vcat (map text files))
-
-	    _ -> panic "cantFindErr"
-\end{code}
diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
deleted file mode 100644
index 3f91af6cc4..0000000000
--- a/ghc/compiler/main/GHC.hs
+++ /dev/null
@@ -1,2053 +0,0 @@
--- -----------------------------------------------------------------------------
---
--- (c) The University of Glasgow, 2005
---
--- The GHC API
---
--- -----------------------------------------------------------------------------
-
-module GHC (
-	-- * Initialisation
-	Session,
-	defaultErrorHandler,
-	defaultCleanupHandler,
-	init, initFromArgs,
-	newSession,
-
-	-- * Flags and settings
-	DynFlags(..), DynFlag(..), Severity(..), GhcMode(..), HscTarget(..), dopt,
-	parseDynamicFlags,
-	initPackages,
-	getSessionDynFlags,
-	setSessionDynFlags,
-
-	-- * Targets
-	Target(..), TargetId(..), Phase,
-	setTargets,
-	getTargets,
-	addTarget,
-	removeTarget,
-	guessTarget,
-	
-	-- * Loading\/compiling the program
-	depanal,
-	load, LoadHowMuch(..), SuccessFlag(..),	-- also does depanal
-	workingDirectoryChanged,
-	checkModule, CheckedModule(..),
-	TypecheckedSource, ParsedSource, RenamedSource,
-
-	-- * Inspecting the module structure of the program
-	ModuleGraph, ModSummary(..), ModLocation(..),
-	getModuleGraph,
-	isLoaded,
-	topSortModuleGraph,
-
-	-- * Inspecting modules
-	ModuleInfo,
-	getModuleInfo,
-	modInfoTyThings,
-	modInfoTopLevelScope,
-	modInfoPrintUnqualified,
-	modInfoExports,
-	modInfoInstances,
-	modInfoIsExportedName,
-	modInfoLookupName,
-	lookupGlobalName,
-
-	-- * Printing
-	PrintUnqualified, alwaysQualify,
-
-	-- * Interactive evaluation
-	getBindings, getPrintUnqual,
-#ifdef GHCI
-	setContext, getContext,	
-	getNamesInScope,
-	getRdrNamesInScope,
-	moduleIsInterpreted,
-	getInfo,
-	exprType,
-	typeKind,
-	parseName,
-	RunResult(..),
-	runStmt,
-	showModule,
-	compileExpr, HValue,
-	lookupName,
-#endif
-
-	-- * Abstract syntax elements
-
-	-- ** Modules
-	Module, mkModule, pprModule,
-
-	-- ** Names
-	Name, 
-	nameModule, nameParent_maybe, pprParenSymName, nameSrcLoc,
-	NamedThing(..),
-	RdrName(Qual,Unqual),
-	
-	-- ** Identifiers
-	Id, idType,
-	isImplicitId, isDeadBinder,
-	isExportedId, isLocalId, isGlobalId,
-	isRecordSelector,
-	isPrimOpId, isFCallId, isClassOpId_maybe,
-	isDataConWorkId, idDataCon,
-	isBottomingId, isDictonaryId,
-	recordSelectorFieldLabel,
-
-	-- ** Type constructors
-	TyCon, 
-	tyConTyVars, tyConDataCons, tyConArity,
-	isClassTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isFunTyCon,
-	synTyConDefn, synTyConRhs,
-
-	-- ** Type variables
-	TyVar,
-	alphaTyVars,
-
-	-- ** Data constructors
-	DataCon,
-	dataConSig, dataConType, dataConTyCon, dataConFieldLabels,
-	dataConIsInfix, isVanillaDataCon,
-	dataConStrictMarks,  
-	StrictnessMark(..), isMarkedStrict,
-
-	-- ** Classes
-	Class, 
-	classMethods, classSCTheta, classTvsFds,
-	pprFundeps,
-
-	-- ** Instances
-	Instance, 
-	instanceDFunId, pprInstance, pprInstanceHdr,
-
-	-- ** Types and Kinds
-	Type, dropForAlls, splitForAllTys, funResultTy, pprParendType,
-	Kind,
-	PredType,
-	ThetaType, pprThetaArrow,
-
-	-- ** Entities
-	TyThing(..), 
-
-	-- ** Syntax
-	module HsSyn, -- ToDo: remove extraneous bits
-
-	-- ** Fixities
-	FixityDirection(..), 
-	defaultFixity, maxPrecedence, 
-	negateFixity,
-	compareFixity,
-
-	-- ** Source locations
-	SrcLoc, pprDefnLoc,
-
-	-- * Exceptions
-	GhcException(..), showGhcException,
-
-	-- * Miscellaneous
-	sessionHscEnv,
-	cyclicModuleErr,
-  ) where
-
-{-
- ToDo:
-
-  * inline bits of HscMain here to simplify layering: hscTcExpr, hscStmt.
-  * we need to expose DynFlags, so should parseDynamicFlags really be
-    part of this interface?
-  * what StaticFlags should we expose, if any?
--}
-
-#include "HsVersions.h"
-
-#ifdef GHCI
-import qualified Linker
-import Linker		( HValue, extendLinkEnv )
-import TcRnDriver	( tcRnLookupRdrName, tcRnGetInfo,
-			  tcRnLookupName, getModuleExports )
-import RdrName		( plusGlobalRdrEnv, Provenance(..), 
-			  ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
-			  emptyGlobalRdrEnv, mkGlobalRdrEnv )
-import HscMain		( hscParseIdentifier, hscStmt, hscTcExpr, hscKcType )
-import Type		( tidyType )
-import VarEnv		( emptyTidyEnv )
-import GHC.Exts		( unsafeCoerce# )
-#endif
-
-import Packages		( initPackages )
-import NameSet		( NameSet, nameSetToList, elemNameSet )
-import RdrName		( GlobalRdrEnv, GlobalRdrElt(..), RdrName(..), 
-			  globalRdrEnvElts )
-import HsSyn
-import Type		( Kind, Type, dropForAlls, PredType, ThetaType,
-			  pprThetaArrow, pprParendType, splitForAllTys,
-			  funResultTy )
-import Id		( Id, idType, isImplicitId, isDeadBinder,
-                          isExportedId, isLocalId, isGlobalId,
-                          isRecordSelector, recordSelectorFieldLabel,
-                          isPrimOpId, isFCallId, isClassOpId_maybe,
-                          isDataConWorkId, idDataCon,
-                          isBottomingId )
-import Var		( TyVar )
-import TysPrim		( alphaTyVars )
-import TyCon		( TyCon, isClassTyCon, isSynTyCon, isNewTyCon,
-			  isPrimTyCon, isFunTyCon, tyConArity,
-			  tyConTyVars, tyConDataCons, synTyConDefn, synTyConRhs )
-import Class		( Class, classSCTheta, classTvsFds, classMethods )
-import FunDeps		( pprFundeps )
-import DataCon		( DataCon, dataConWrapId, dataConSig, dataConTyCon,
-			  dataConFieldLabels, dataConStrictMarks, 
-			  dataConIsInfix, isVanillaDataCon )
-import Name		( Name, nameModule, NamedThing(..), nameParent_maybe,
-			  nameSrcLoc, nameOccName )
-import OccName		( parenSymOcc )
-import NameEnv		( nameEnvElts )
-import InstEnv		( Instance, instanceDFunId, pprInstance, pprInstanceHdr )
-import SrcLoc
-import DriverPipeline
-import DriverPhases	( Phase(..), isHaskellSrcFilename, startPhase )
-import HeaderInfo	( getImports, getOptions )
-import Packages		( isHomePackage )
-import Finder
-import HscMain		( newHscEnv, hscFileCheck, HscChecked(..) )
-import HscTypes
-import DynFlags
-import SysTools		( initSysTools, cleanTempFiles )
-import Module
-import FiniteMap
-import Panic
-import Digraph
-import Bag		( unitBag )
-import ErrUtils		( Severity(..), showPass, fatalErrorMsg, debugTraceMsg,
-			  mkPlainErrMsg, printBagOfErrors, printErrorsAndWarnings )
-import qualified ErrUtils
-import Util
-import StringBuffer	( StringBuffer, hGetStringBuffer )
-import Outputable
-import SysTools		( cleanTempFilesExcept )
-import BasicTypes
-import TcType           ( tcSplitSigmaTy, isDictTy )
-import Maybes		( expectJust, mapCatMaybes )
-
-import Control.Concurrent
-import System.Directory ( getModificationTime, doesFileExist )
-import Data.Maybe	( isJust, isNothing )
-import Data.List	( partition, nub )
-import qualified Data.List as List
-import Control.Monad	( unless, when )
-import System.Exit	( exitWith, ExitCode(..) )
-import System.Time	( ClockTime )
-import Control.Exception as Exception hiding (handle)
-import Data.IORef
-import System.IO
-import System.IO.Error	( isDoesNotExistError )
-import Prelude hiding (init)
-
-#if __GLASGOW_HASKELL__ < 600
-import System.IO as System.IO.Error ( try )
-#else
-import System.IO.Error	( try )
-#endif
-
--- -----------------------------------------------------------------------------
--- Exception handlers
-
--- | Install some default exception handlers and run the inner computation.
--- Unless you want to handle exceptions yourself, you should wrap this around
--- the top level of your program.  The default handlers output the error
--- message(s) to stderr and exit cleanly.
-defaultErrorHandler :: DynFlags -> IO a -> IO a
-defaultErrorHandler dflags inner = 
-  -- top-level exception handler: any unrecognised exception is a compiler bug.
-  handle (\exception -> do
-  	   hFlush stdout
-	   case exception of
-		-- an IO exception probably isn't our fault, so don't panic
-		IOException _ ->
-		  fatalErrorMsg dflags (text (show exception))
-		AsyncException StackOverflow ->
-		  fatalErrorMsg dflags (text "stack overflow: use +RTS -K<size> to increase it")
-		_other ->
-		  fatalErrorMsg dflags (text (show (Panic (show exception))))
-	   exitWith (ExitFailure 1)
-         ) $
-
-  -- program errors: messages with locations attached.  Sometimes it is
-  -- convenient to just throw these as exceptions.
-  handleDyn (\dyn -> do printBagOfErrors dflags (unitBag dyn)
-			exitWith (ExitFailure 1)) $
-
-  -- error messages propagated as exceptions
-  handleDyn (\dyn -> do
-  		hFlush stdout
-  		case dyn of
-		     PhaseFailed _ code -> exitWith code
-		     Interrupted -> exitWith (ExitFailure 1)
-		     _ -> do fatalErrorMsg dflags (text (show (dyn :: GhcException)))
-			     exitWith (ExitFailure 1)
-	    ) $
-  inner
-
--- | Install a default cleanup handler to remove temporary files
--- deposited by a GHC run.  This is seperate from
--- 'defaultErrorHandler', because you might want to override the error
--- handling, but still get the ordinary cleanup behaviour.
-defaultCleanupHandler :: DynFlags -> IO a -> IO a
-defaultCleanupHandler dflags inner = 
-   -- make sure we clean up after ourselves
-   later (unless (dopt Opt_KeepTmpFiles dflags) $ 
-	    cleanTempFiles dflags) 
-	-- exceptions will be blocked while we clean the temporary files,
-	-- so there shouldn't be any difficulty if we receive further
-	-- signals.
-   inner
-
-
--- | Initialises GHC.  This must be done /once/ only.  Takes the
--- TopDir path without the '-B' prefix.
-
-init :: Maybe String -> IO ()
-init mbMinusB = do
-   -- catch ^C
-   main_thread <- myThreadId
-   putMVar interruptTargetThread [main_thread]
-   installSignalHandlers
-
-   dflags0 <- initSysTools mbMinusB defaultDynFlags
-   writeIORef v_initDynFlags dflags0
-
--- | Initialises GHC. This must be done /once/ only. Takes the
--- command-line arguments.  All command-line arguments which aren't
--- understood by GHC will be returned.
-
-initFromArgs :: [String] -> IO [String]
-initFromArgs args
-    = do init mbMinusB
-         return argv1
-    where -- Grab the -B option if there is one
-          (minusB_args, argv1) = partition (prefixMatch "-B") args
-          mbMinusB | null minusB_args
-                       = Nothing
-                   | otherwise
-                       = Just (drop 2 (last minusB_args))
-
-GLOBAL_VAR(v_initDynFlags, error "initDynFlags", DynFlags)
-	-- stores the DynFlags between the call to init and subsequent
-	-- calls to newSession.
-
--- | Starts a new session.  A session consists of a set of loaded
--- modules, a set of options (DynFlags), and an interactive context.
--- ToDo: GhcMode should say "keep typechecked code" and\/or "keep renamed
--- code".
-newSession :: GhcMode -> IO Session
-newSession mode = do
-  dflags0 <- readIORef v_initDynFlags
-  dflags <- initDynFlags dflags0
-  env <- newHscEnv dflags{ ghcMode=mode }
-  ref <- newIORef env
-  return (Session ref)
-
--- tmp: this breaks the abstraction, but required because DriverMkDepend
--- needs to call the Finder.  ToDo: untangle this.
-sessionHscEnv :: Session -> IO HscEnv
-sessionHscEnv (Session ref) = readIORef ref
-
-withSession :: Session -> (HscEnv -> IO a) -> IO a
-withSession (Session ref) f = do h <- readIORef ref; f h
-
-modifySession :: Session -> (HscEnv -> HscEnv) -> IO ()
-modifySession (Session ref) f = do h <- readIORef ref; writeIORef ref $! f h
-
--- -----------------------------------------------------------------------------
--- Flags & settings
-
--- | Grabs the DynFlags from the Session
-getSessionDynFlags :: Session -> IO DynFlags
-getSessionDynFlags s = withSession s (return . hsc_dflags)
-
--- | Updates the DynFlags in a Session
-setSessionDynFlags :: Session -> DynFlags -> IO ()
-setSessionDynFlags s dflags = modifySession s (\h -> h{ hsc_dflags = dflags })
-
--- | If there is no -o option, guess the name of target executable
--- by using top-level source file name as a base.
-guessOutputFile :: Session -> IO ()
-guessOutputFile s = modifySession s $ \env ->
-    let dflags = hsc_dflags env
-        mod_graph = hsc_mod_graph env
-        mainModuleSrcPath, guessedName :: Maybe String
-        mainModuleSrcPath = do
-            let isMain = (== mainModIs dflags) . ms_mod
-            [ms] <- return (filter isMain mod_graph)
-            ml_hs_file (ms_location ms)
-        guessedName = fmap basenameOf mainModuleSrcPath
-    in
-    case outputFile dflags of
-        Just _ -> env
-        Nothing -> env { hsc_dflags = dflags { outputFile = guessedName } }
-
--- -----------------------------------------------------------------------------
--- Targets
-
--- ToDo: think about relative vs. absolute file paths. And what
--- happens when the current directory changes.
-
--- | Sets the targets for this session.  Each target may be a module name
--- or a filename.  The targets correspond to the set of root modules for
--- the program\/library.  Unloading the current program is achieved by
--- setting the current set of targets to be empty, followed by load.
-setTargets :: Session -> [Target] -> IO ()
-setTargets s targets = modifySession s (\h -> h{ hsc_targets = targets })
-
--- | returns the current set of targets
-getTargets :: Session -> IO [Target]
-getTargets s = withSession s (return . hsc_targets)
-
--- | Add another target
-addTarget :: Session -> Target -> IO ()
-addTarget s target
-  = modifySession s (\h -> h{ hsc_targets = target : hsc_targets h })
-
--- | Remove a target
-removeTarget :: Session -> TargetId -> IO ()
-removeTarget s target_id
-  = modifySession s (\h -> h{ hsc_targets = filter (hsc_targets h) })
-  where
-   filter targets = [ t | t@(Target id _) <- targets, id /= target_id ]
-
--- Attempts to guess what Target a string refers to.  This function implements
--- the --make/GHCi command-line syntax for filenames: 
---
--- 	- if the string looks like a Haskell source filename, then interpret
---	  it as such
---	- if adding a .hs or .lhs suffix yields the name of an existing file,
---	  then use that
--- 	- otherwise interpret the string as a module name
---
-guessTarget :: String -> Maybe Phase -> IO Target
-guessTarget file (Just phase)
-   = return (Target (TargetFile file (Just phase)) Nothing)
-guessTarget file Nothing
-   | isHaskellSrcFilename file
-   = return (Target (TargetFile file Nothing) Nothing)
-   | otherwise
-   = do exists <- doesFileExist hs_file
-	if exists
-	   then return (Target (TargetFile hs_file Nothing) Nothing)
-	   else do
-	exists <- doesFileExist lhs_file
-	if exists
-	   then return (Target (TargetFile lhs_file Nothing) Nothing)
-	   else do
-	return (Target (TargetModule (mkModule file)) Nothing)
-     where 
-	 hs_file  = file `joinFileExt` "hs"
-	 lhs_file = file `joinFileExt` "lhs"
-
--- -----------------------------------------------------------------------------
--- Loading the program
-
--- Perform a dependency analysis starting from the current targets
--- and update the session with the new module graph.
-depanal :: Session -> [Module] -> Bool -> IO (Maybe ModuleGraph)
-depanal (Session ref) excluded_mods allow_dup_roots = do
-  hsc_env <- readIORef ref
-  let
-	 dflags  = hsc_dflags hsc_env
-	 gmode   = ghcMode (hsc_dflags hsc_env)
-	 targets = hsc_targets hsc_env
-	 old_graph = hsc_mod_graph hsc_env
-	
-  showPass dflags "Chasing dependencies"
-  when (gmode == BatchCompile) $
-	debugTraceMsg dflags 1 (hcat [
-		     text "Chasing modules from: ",
-	     		hcat (punctuate comma (map pprTarget targets))])
-
-  r <- downsweep hsc_env old_graph excluded_mods allow_dup_roots
-  case r of
-    Just mod_graph -> writeIORef ref hsc_env{ hsc_mod_graph = mod_graph }
-    _ -> return ()
-  return r
-
-{-
--- | The result of load.
-data LoadResult
-  = LoadOk	Errors	-- ^ all specified targets were loaded successfully.
-  | LoadFailed  Errors	-- ^ not all modules were loaded.
-
-type Errors = [String]
-
-data ErrMsg = ErrMsg { 
-	errMsgSeverity  :: Severity,  -- warning, error, etc.
-	errMsgSpans     :: [SrcSpan],
-	errMsgShortDoc  :: Doc,
-	errMsgExtraInfo :: Doc
-	}
--}
-
-data LoadHowMuch
-   = LoadAllTargets
-   | LoadUpTo Module
-   | LoadDependenciesOf Module
-
--- | Try to load the program.  If a Module is supplied, then just
--- attempt to load up to this target.  If no Module is supplied,
--- then try to load all targets.
-load :: Session -> LoadHowMuch -> IO SuccessFlag
-load s@(Session ref) how_much
-   = do 
-	-- Dependency analysis first.  Note that this fixes the module graph:
-	-- even if we don't get a fully successful upsweep, the full module
-	-- graph is still retained in the Session.  We can tell which modules
-	-- were successfully loaded by inspecting the Session's HPT.
-	mb_graph <- depanal s [] False
-	case mb_graph of	   
-	   Just mod_graph -> load2 s how_much mod_graph 
-	   Nothing        -> return Failed
-
-load2 s@(Session ref) how_much mod_graph = do
-        guessOutputFile s
-	hsc_env <- readIORef ref
-
-        let hpt1      = hsc_HPT hsc_env
-        let dflags    = hsc_dflags hsc_env
-        let ghci_mode = ghcMode dflags -- this never changes
-
-	-- The "bad" boot modules are the ones for which we have
-	-- B.hs-boot in the module graph, but no B.hs
-	-- The downsweep should have ensured this does not happen
-	-- (see msDeps)
-        let all_home_mods = [ms_mod s | s <- mod_graph, not (isBootSummary s)]
-#ifdef DEBUG
-	    bad_boot_mods = [s 	      | s <- mod_graph, isBootSummary s,
-					not (ms_mod s `elem` all_home_mods)]
-#endif
-	ASSERT( null bad_boot_mods ) return ()
-
-        -- mg2_with_srcimps drops the hi-boot nodes, returning a 
-	-- graph with cycles.  Among other things, it is used for
-        -- backing out partially complete cycles following a failed
-        -- upsweep, and for removing from hpt all the modules
-        -- not in strict downwards closure, during calls to compile.
-        let mg2_with_srcimps :: [SCC ModSummary]
-	    mg2_with_srcimps = topSortModuleGraph True mod_graph Nothing
-
-	    -- check the stability property for each module.
-	    stable_mods@(stable_obj,stable_bco)
-		| BatchCompile <- ghci_mode = ([],[])
-	        | otherwise = checkStability hpt1 mg2_with_srcimps all_home_mods
-
-	    -- prune bits of the HPT which are definitely redundant now,
-	    -- to save space.
-	    pruned_hpt = pruneHomePackageTable hpt1 
-				(flattenSCCs mg2_with_srcimps)
-				stable_mods
-
-	evaluate pruned_hpt
-
-	debugTraceMsg dflags 2 (text "Stable obj:" <+> ppr stable_obj $$
-				text "Stable BCO:" <+> ppr stable_bco)
-
-	-- Unload any modules which are going to be re-linked this time around.
-	let stable_linkables = [ linkable
-			       | m <- stable_obj++stable_bco,
-				 Just hmi <- [lookupModuleEnv pruned_hpt m],
-				 Just linkable <- [hm_linkable hmi] ]
-	unload hsc_env stable_linkables
-
-        -- We could at this point detect cycles which aren't broken by
-        -- a source-import, and complain immediately, but it seems better
-        -- to let upsweep_mods do this, so at least some useful work gets
-        -- done before the upsweep is abandoned.
-        --hPutStrLn stderr "after tsort:\n"
-        --hPutStrLn stderr (showSDoc (vcat (map ppr mg2)))
-
-        -- Now do the upsweep, calling compile for each module in
-        -- turn.  Final result is version 3 of everything.
-
-        -- Topologically sort the module graph, this time including hi-boot
-	-- nodes, and possibly just including the portion of the graph
-	-- reachable from the module specified in the 2nd argument to load.
-	-- This graph should be cycle-free.
-	-- If we're restricting the upsweep to a portion of the graph, we
-	-- also want to retain everything that is still stable.
-        let full_mg :: [SCC ModSummary]
-	    full_mg    = topSortModuleGraph False mod_graph Nothing
-
-	    maybe_top_mod = case how_much of
-				LoadUpTo m           -> Just m
-			  	LoadDependenciesOf m -> Just m
-			  	_		     -> Nothing
-
-	    partial_mg0 :: [SCC ModSummary]
-	    partial_mg0 = topSortModuleGraph False mod_graph maybe_top_mod
-
-	    -- LoadDependenciesOf m: we want the upsweep to stop just
-	    -- short of the specified module (unless the specified module
-	    -- is stable).
-	    partial_mg
-		| LoadDependenciesOf mod <- how_much
-		= ASSERT( case last partial_mg0 of 
-			    AcyclicSCC ms -> ms_mod ms == mod; _ -> False )
-		  List.init partial_mg0
-		| otherwise
-		= partial_mg0
-  
-	    stable_mg = 
-		[ AcyclicSCC ms
-	        | AcyclicSCC ms <- full_mg,
-		  ms_mod ms `elem` stable_obj++stable_bco,
-		  ms_mod ms `notElem` [ ms_mod ms' | 
-					AcyclicSCC ms' <- partial_mg ] ]
-
-	    mg = stable_mg ++ partial_mg
-
-	-- clean up between compilations
-	let cleanup = cleanTempFilesExcept dflags
-			  (ppFilesFromSummaries (flattenSCCs mg2_with_srcimps))
-
-        (upsweep_ok, hsc_env1, modsUpswept)
-           <- upsweep (hsc_env { hsc_HPT = emptyHomePackageTable })
-			   pruned_hpt stable_mods cleanup mg
-
-	-- Make modsDone be the summaries for each home module now
-	-- available; this should equal the domain of hpt3.
-        -- Get in in a roughly top .. bottom order (hence reverse).
-
-        let modsDone = reverse modsUpswept
-
-        -- Try and do linking in some form, depending on whether the
-        -- upsweep was completely or only partially successful.
-
-        if succeeded upsweep_ok
-
-         then 
-           -- Easy; just relink it all.
-           do debugTraceMsg dflags 2 (text "Upsweep completely successful.")
-
-	      -- Clean up after ourselves
-	      cleanTempFilesExcept dflags (ppFilesFromSummaries modsDone)
-
-	      -- Issue a warning for the confusing case where the user
-	      -- said '-o foo' but we're not going to do any linking.
-	      -- We attempt linking if either (a) one of the modules is
-	      -- called Main, or (b) the user said -no-hs-main, indicating
-	      -- that main() is going to come from somewhere else.
-	      --
-	      let ofile = outputFile dflags
-	      let no_hs_main = dopt Opt_NoHsMain dflags
-	      let 
-	 	main_mod = mainModIs dflags
-		a_root_is_Main = any ((==main_mod).ms_mod) mod_graph
-		do_linking = a_root_is_Main || no_hs_main
-
-	      when (ghci_mode == BatchCompile && isJust ofile && not do_linking) $
-	        debugTraceMsg dflags 1 (text ("Warning: output was redirected with -o, " ++
-				              "but no output will be generated\n" ++
-				              "because there is no " ++ moduleString main_mod ++ " module."))
-
-	      -- link everything together
-              linkresult <- link ghci_mode dflags do_linking (hsc_HPT hsc_env1)
-
-	      loadFinish Succeeded linkresult ref hsc_env1
-
-         else 
-           -- Tricky.  We need to back out the effects of compiling any
-           -- half-done cycles, both so as to clean up the top level envs
-           -- and to avoid telling the interactive linker to link them.
-           do debugTraceMsg dflags 2 (text "Upsweep partially successful.")
-
-              let modsDone_names
-                     = map ms_mod modsDone
-              let mods_to_zap_names 
-                     = findPartiallyCompletedCycles modsDone_names 
-			  mg2_with_srcimps
-              let mods_to_keep
-                     = filter ((`notElem` mods_to_zap_names).ms_mod) 
-			  modsDone
-
-              let hpt4 = retainInTopLevelEnvs (map ms_mod mods_to_keep) 
-					      (hsc_HPT hsc_env1)
-
-	      -- Clean up after ourselves
-	      cleanTempFilesExcept dflags (ppFilesFromSummaries mods_to_keep)
-
-	      -- there should be no Nothings where linkables should be, now
-	      ASSERT(all (isJust.hm_linkable) 
-			(moduleEnvElts (hsc_HPT hsc_env))) do
-	
-	      -- Link everything together
-              linkresult <- link ghci_mode dflags False hpt4
-
-	      let hsc_env4 = hsc_env1{ hsc_HPT = hpt4 }
-	      loadFinish Failed linkresult ref hsc_env4
-
--- Finish up after a load.
-
--- If the link failed, unload everything and return.
-loadFinish all_ok Failed ref hsc_env
-  = do unload hsc_env []
-       writeIORef ref $! discardProg hsc_env
-       return Failed
-
--- Empty the interactive context and set the module context to the topmost
--- newly loaded module, or the Prelude if none were loaded.
-loadFinish all_ok Succeeded ref hsc_env
-  = do writeIORef ref $! hsc_env{ hsc_IC = emptyInteractiveContext }
-       return all_ok
-
-
--- Forget the current program, but retain the persistent info in HscEnv
-discardProg :: HscEnv -> HscEnv
-discardProg hsc_env
-  = hsc_env { hsc_mod_graph = emptyMG, 
-	      hsc_IC = emptyInteractiveContext,
-	      hsc_HPT = emptyHomePackageTable }
-
--- used to fish out the preprocess output files for the purposes of
--- cleaning up.  The preprocessed file *might* be the same as the
--- source file, but that doesn't do any harm.
-ppFilesFromSummaries summaries = map ms_hspp_file summaries
-
--- -----------------------------------------------------------------------------
--- Check module
-
-data CheckedModule = 
-  CheckedModule { parsedSource      :: ParsedSource,
-		  renamedSource     :: Maybe RenamedSource,
-		  typecheckedSource :: Maybe TypecheckedSource,
-		  checkedModuleInfo :: Maybe ModuleInfo
-	        }
-	-- ToDo: improvements that could be made here:
-	--  if the module succeeded renaming but not typechecking,
-	--  we can still get back the GlobalRdrEnv and exports, so
-	--  perhaps the ModuleInfo should be split up into separate
-	--  fields within CheckedModule.
-
-type ParsedSource      = Located (HsModule RdrName)
-type RenamedSource     = (HsGroup Name, [LImportDecl Name], Maybe [LIE Name])
-type TypecheckedSource = LHsBinds Id
-
--- NOTE:
---   - things that aren't in the output of the typechecker right now:
---     - the export list
---     - the imports
---     - type signatures
---     - type/data/newtype declarations
---     - class declarations
---     - instances
---   - extra things in the typechecker's output:
---     - default methods are turned into top-level decls.
---     - dictionary bindings
-
-
--- | This is the way to get access to parsed and typechecked source code
--- for a module.  'checkModule' loads all the dependencies of the specified
--- module in the Session, and then attempts to typecheck the module.  If
--- successful, it returns the abstract syntax for the module.
-checkModule :: Session -> Module -> IO (Maybe CheckedModule)
-checkModule session@(Session ref) mod = do
-	-- load up the dependencies first
-   r <- load session (LoadDependenciesOf mod)
-   if (failed r) then return Nothing else do
-
-	-- now parse & typecheck the module
-   hsc_env <- readIORef ref   
-   let mg  = hsc_mod_graph hsc_env
-   case [ ms | ms <- mg, ms_mod ms == mod ] of
-	[] -> return Nothing
-	(ms:_) -> do 
-	   mbChecked <- hscFileCheck hsc_env{hsc_dflags=ms_hspp_opts ms} ms
-	   case mbChecked of
-             Nothing -> return Nothing
-             Just (HscChecked parsed renamed Nothing) ->
-		   return (Just (CheckedModule {
-					parsedSource = parsed,
-					renamedSource = renamed,
-					typecheckedSource = Nothing,
-					checkedModuleInfo = Nothing }))
-             Just (HscChecked parsed renamed
-			   (Just (tc_binds, rdr_env, details))) -> do
-		   let minf = ModuleInfo {
-				minf_type_env  = md_types details,
-				minf_exports   = md_exports details,
-				minf_rdr_env   = Just rdr_env,
-				minf_instances = md_insts details
-			      }
-		   return (Just (CheckedModule {
-					parsedSource = parsed,
-					renamedSource = renamed,
-					typecheckedSource = Just tc_binds,
-					checkedModuleInfo = Just minf }))
-
--- ---------------------------------------------------------------------------
--- Unloading
-
-unload :: HscEnv -> [Linkable] -> IO ()
-unload hsc_env stable_linkables	-- Unload everthing *except* 'stable_linkables'
-  = case ghcMode (hsc_dflags hsc_env) of
-	BatchCompile  -> return ()
-	JustTypecheck -> return ()
-#ifdef GHCI
-	Interactive -> Linker.unload (hsc_dflags hsc_env) stable_linkables
-#else
-	Interactive -> panic "unload: no interpreter"
-#endif
-	other -> panic "unload: strange mode"
-
--- -----------------------------------------------------------------------------
--- checkStability
-
-{-
-  Stability tells us which modules definitely do not need to be recompiled.
-  There are two main reasons for having stability:
-  
-   - avoid doing a complete upsweep of the module graph in GHCi when
-     modules near the bottom of the tree have not changed.
-
-   - to tell GHCi when it can load object code: we can only load object code
-     for a module when we also load object code fo  all of the imports of the
-     module.  So we need to know that we will definitely not be recompiling
-     any of these modules, and we can use the object code.
-
-  NB. stability is of no importance to BatchCompile at all, only Interactive.
-  (ToDo: what about JustTypecheck?)
-
-  The stability check is as follows.  Both stableObject and
-  stableBCO are used during the upsweep phase later.
-
-  -------------------
-  stable m = stableObject m || stableBCO m
-
-  stableObject m = 
-	all stableObject (imports m)
-	&& old linkable does not exist, or is == on-disk .o
-	&& date(on-disk .o) > date(.hs)
-
-  stableBCO m =
-	all stable (imports m)
-	&& date(BCO) > date(.hs)
-  -------------------    
-
-  These properties embody the following ideas:
-
-    - if a module is stable:
-	- if it has been compiled in a previous pass (present in HPT)
-	  then it does not need to be compiled or re-linked.
-        - if it has not been compiled in a previous pass,
-	  then we only need to read its .hi file from disk and
-	  link it to produce a ModDetails.
-
-    - if a modules is not stable, we will definitely be at least
-      re-linking, and possibly re-compiling it during the upsweep.
-      All non-stable modules can (and should) therefore be unlinked
-      before the upsweep.
-
-    - Note that objects are only considered stable if they only depend
-      on other objects.  We can't link object code against byte code.
--}
-
-checkStability
-	:: HomePackageTable		-- HPT from last compilation
-	-> [SCC ModSummary]		-- current module graph (cyclic)
-	-> [Module]			-- all home modules
-	-> ([Module],			-- stableObject
-	    [Module])			-- stableBCO
-
-checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
-  where
-   checkSCC (stable_obj, stable_bco) scc0
-     | stableObjects = (scc_mods ++ stable_obj, stable_bco)
-     | stableBCOs    = (stable_obj, scc_mods ++ stable_bco)
-     | otherwise     = (stable_obj, stable_bco)
-     where
-	scc = flattenSCC scc0
-	scc_mods = map ms_mod scc
-	home_module m   = m `elem` all_home_mods && m `notElem` scc_mods
-
-        scc_allimps = nub (filter home_module (concatMap ms_allimps scc))
-	    -- all imports outside the current SCC, but in the home pkg
-	
-	stable_obj_imps = map (`elem` stable_obj) scc_allimps
-	stable_bco_imps = map (`elem` stable_bco) scc_allimps
-
-	stableObjects = 
-	   and stable_obj_imps
-	   && all object_ok scc
-
-	stableBCOs = 
-	   and (zipWith (||) stable_obj_imps stable_bco_imps)
-	   && all bco_ok scc
-
-	object_ok ms
-	  | Just t <- ms_obj_date ms  =  t >= ms_hs_date ms 
-					 && same_as_prev t
-	  | otherwise = False
-	  where
-	     same_as_prev t = case lookupModuleEnv hpt (ms_mod ms) of
-				Just hmi  | Just l <- hm_linkable hmi
-				 -> isObjectLinkable l && t == linkableTime l
-				_other  -> True
-		-- why '>=' rather than '>' above?  If the filesystem stores
-		-- times to the nearset second, we may occasionally find that
-		-- the object & source have the same modification time, 
-		-- especially if the source was automatically generated
-		-- and compiled.  Using >= is slightly unsafe, but it matches
-		-- make's behaviour.
-
-	bco_ok ms
-	  = case lookupModuleEnv hpt (ms_mod ms) of
-		Just hmi  | Just l <- hm_linkable hmi ->
-			not (isObjectLinkable l) && 
-			linkableTime l >= ms_hs_date ms
-		_other  -> False
-
-ms_allimps :: ModSummary -> [Module]
-ms_allimps ms = map unLoc (ms_srcimps ms ++ ms_imps ms)
-
--- -----------------------------------------------------------------------------
--- Prune the HomePackageTable
-
--- Before doing an upsweep, we can throw away:
---
---   - For non-stable modules:
---	- all ModDetails, all linked code
---   - all unlinked code that is out of date with respect to
---     the source file
---
--- This is VERY IMPORTANT otherwise we'll end up requiring 2x the
--- space at the end of the upsweep, because the topmost ModDetails of the
--- old HPT holds on to the entire type environment from the previous
--- compilation.
-
-pruneHomePackageTable
-   :: HomePackageTable
-   -> [ModSummary]
-   -> ([Module],[Module])
-   -> HomePackageTable
-
-pruneHomePackageTable hpt summ (stable_obj, stable_bco)
-  = mapModuleEnv prune hpt
-  where prune hmi
-	  | is_stable modl = hmi'
-	  | otherwise      = hmi'{ hm_details = emptyModDetails }
-	  where
-	   modl = mi_module (hm_iface hmi)
-	   hmi' | Just l <- hm_linkable hmi, linkableTime l < ms_hs_date ms
-		= hmi{ hm_linkable = Nothing }
-		| otherwise
-		= hmi
-		where ms = expectJust "prune" (lookupModuleEnv ms_map modl)
-
-        ms_map = mkModuleEnv [(ms_mod ms, ms) | ms <- summ]
-
-	is_stable m = m `elem` stable_obj || m `elem` stable_bco
-
--- -----------------------------------------------------------------------------
-
--- Return (names of) all those in modsDone who are part of a cycle
--- as defined by theGraph.
-findPartiallyCompletedCycles :: [Module] -> [SCC ModSummary] -> [Module]
-findPartiallyCompletedCycles modsDone theGraph
-   = chew theGraph
-     where
-        chew [] = []
-        chew ((AcyclicSCC v):rest) = chew rest    -- acyclic?  not interesting.
-        chew ((CyclicSCC vs):rest)
-           = let names_in_this_cycle = nub (map ms_mod vs)
-                 mods_in_this_cycle  
-                    = nub ([done | done <- modsDone, 
-                                   done `elem` names_in_this_cycle])
-                 chewed_rest = chew rest
-             in 
-             if   notNull mods_in_this_cycle
-                  && length mods_in_this_cycle < length names_in_this_cycle
-             then mods_in_this_cycle ++ chewed_rest
-             else chewed_rest
-
--- -----------------------------------------------------------------------------
--- The upsweep
-
--- This is where we compile each module in the module graph, in a pass
--- from the bottom to the top of the graph.
-
--- There better had not be any cyclic groups here -- we check for them.
-
-upsweep
-    :: HscEnv			-- Includes initially-empty HPT
-    -> HomePackageTable		-- HPT from last time round (pruned)
-    -> ([Module],[Module])	-- stable modules (see checkStability)
-    -> IO ()			-- How to clean up unwanted tmp files
-    -> [SCC ModSummary]		-- Mods to do (the worklist)
-    -> IO (SuccessFlag,
-           HscEnv,		-- With an updated HPT
-           [ModSummary])	-- Mods which succeeded
-
-upsweep hsc_env old_hpt stable_mods cleanup mods
-   = upsweep' hsc_env old_hpt stable_mods cleanup mods 1 (length mods)
-
-upsweep' hsc_env old_hpt stable_mods cleanup
-     [] _ _
-   = return (Succeeded, hsc_env, [])
-
-upsweep' hsc_env old_hpt stable_mods cleanup
-     (CyclicSCC ms:_) _ _
-   = do fatalErrorMsg (hsc_dflags hsc_env) (cyclicModuleErr ms)
-        return (Failed, hsc_env, [])
-
-upsweep' hsc_env old_hpt stable_mods cleanup
-     (AcyclicSCC mod:mods) mod_index nmods
-   = do -- putStrLn ("UPSWEEP_MOD: hpt = " ++ 
-	--	     show (map (moduleUserString.moduleName.mi_module.hm_iface) 
-	--		       (moduleEnvElts (hsc_HPT hsc_env)))
-
-        mb_mod_info <- upsweep_mod hsc_env old_hpt stable_mods mod 
-                       mod_index nmods
-
-	cleanup		-- Remove unwanted tmp files between compilations
-
-        case mb_mod_info of
-	    Nothing -> return (Failed, hsc_env, [])
-	    Just mod_info -> do 
-		{ let this_mod = ms_mod mod
-
-			-- Add new info to hsc_env
-		      hpt1     = extendModuleEnv (hsc_HPT hsc_env) 
-					this_mod mod_info
-		      hsc_env1 = hsc_env { hsc_HPT = hpt1 }
-
-			-- Space-saving: delete the old HPT entry
-			-- for mod BUT if mod is a hs-boot
-			-- node, don't delete it.  For the
-			-- interface, the HPT entry is probaby for the
-			-- main Haskell source file.  Deleting it
-			-- would force .. (what?? --SDM)
-		      old_hpt1 | isBootSummary mod = old_hpt
-			       | otherwise = delModuleEnv old_hpt this_mod
-
-		; (restOK, hsc_env2, modOKs) 
-			<- upsweep' hsc_env1 old_hpt1 stable_mods cleanup 
-				mods (mod_index+1) nmods
-		; return (restOK, hsc_env2, mod:modOKs)
-		}
-
-
--- Compile a single module.  Always produce a Linkable for it if 
--- successful.  If no compilation happened, return the old Linkable.
-upsweep_mod :: HscEnv
-            -> HomePackageTable
-	    -> ([Module],[Module])
-            -> ModSummary
-            -> Int  -- index of module
-            -> Int  -- total number of modules
-            -> IO (Maybe HomeModInfo)	-- Nothing => Failed
-
-upsweep_mod hsc_env old_hpt (stable_obj, stable_bco) summary mod_index nmods
-   = do 
-        let 
-	    this_mod    = ms_mod summary
-	    mb_obj_date = ms_obj_date summary
-	    obj_fn	= ml_obj_file (ms_location summary)
-	    hs_date     = ms_hs_date summary
-
-	    compile_it :: Maybe Linkable -> IO (Maybe HomeModInfo)
-	    compile_it  = upsweep_compile hsc_env old_hpt this_mod 
-				summary mod_index nmods
-
-	case ghcMode (hsc_dflags hsc_env) of
-	    BatchCompile ->
-		case () of
-		   -- Batch-compilating is easy: just check whether we have
-		   -- an up-to-date object file.  If we do, then the compiler
-		   -- needs to do a recompilation check.
-		   _ | Just obj_date <- mb_obj_date, obj_date >= hs_date -> do
-		           linkable <- 
-				findObjectLinkable this_mod obj_fn obj_date
-			   compile_it (Just linkable)
-
-		     | otherwise ->
-		           compile_it Nothing
-
-	    interactive ->
-		case () of
-		    _ | is_stable_obj, isJust old_hmi ->
-			   return old_hmi
-			-- object is stable, and we have an entry in the
-			-- old HPT: nothing to do
-
-		      | is_stable_obj, isNothing old_hmi -> do
-		           linkable <-
-				findObjectLinkable this_mod obj_fn 
-					(expectJust "upseep1" mb_obj_date)
-			   compile_it (Just linkable)
-			-- object is stable, but we need to load the interface
-			-- off disk to make a HMI.
-
-		      | is_stable_bco -> 
-			   ASSERT(isJust old_hmi) -- must be in the old_hpt
-			   return old_hmi
-			-- BCO is stable: nothing to do
-
-		      | Just hmi <- old_hmi,
-			Just l <- hm_linkable hmi, not (isObjectLinkable l),
-			linkableTime l >= ms_hs_date summary ->
-			   compile_it (Just l)
-			-- we have an old BCO that is up to date with respect
-			-- to the source: do a recompilation check as normal.
-
-		      | otherwise ->
-			  compile_it Nothing
-			-- no existing code at all: we must recompile.
-		   where
-		    is_stable_obj = this_mod `elem` stable_obj
-		    is_stable_bco = this_mod `elem` stable_bco
-
-		    old_hmi = lookupModuleEnv old_hpt this_mod
-
--- Run hsc to compile a module
-upsweep_compile hsc_env old_hpt this_mod summary
-                mod_index nmods
-                mb_old_linkable = do
-  let
-	-- The old interface is ok if it's in the old HPT 
-	--	a) we're compiling a source file, and the old HPT
-	--	   entry is for a source file
-	--	b) we're compiling a hs-boot file
-	-- Case (b) allows an hs-boot file to get the interface of its
-	-- real source file on the second iteration of the compilation
-	-- manager, but that does no harm.  Otherwise the hs-boot file
-	-- will always be recompiled
-
-        mb_old_iface 
-		= case lookupModuleEnv old_hpt this_mod of
-		     Nothing	 			  -> Nothing
-		     Just hm_info | isBootSummary summary -> Just iface
-				  | not (mi_boot iface)   -> Just iface
-				  | otherwise		  -> Nothing
-				   where 
-				     iface = hm_iface hm_info
-
-  compresult <- compile hsc_env summary mb_old_linkable mb_old_iface
-                        mod_index nmods
-
-  case compresult of
-        -- Compilation failed.  Compile may still have updated the PCS, tho.
-        CompErrs -> return Nothing
-
-	-- Compilation "succeeded", and may or may not have returned a new
-	-- linkable (depending on whether compilation was actually performed
-	-- or not).
-	CompOK new_details new_iface new_linkable
-              -> do let new_info = HomeModInfo { hm_iface = new_iface,
-						 hm_details = new_details,
-						 hm_linkable = new_linkable }
-                    return (Just new_info)
-
-
--- Filter modules in the HPT
-retainInTopLevelEnvs :: [Module] -> HomePackageTable -> HomePackageTable
-retainInTopLevelEnvs keep_these hpt
-   = mkModuleEnv [ (mod, expectJust "retain" mb_mod_info)
-		 | mod <- keep_these
-		 , let mb_mod_info = lookupModuleEnv hpt mod
-		 , isJust mb_mod_info ]
-
--- ---------------------------------------------------------------------------
--- Topological sort of the module graph
-
-topSortModuleGraph
-	  :: Bool 		-- Drop hi-boot nodes? (see below)
-	  -> [ModSummary]
-	  -> Maybe Module
-	  -> [SCC ModSummary]
--- Calculate SCCs of the module graph, possibly dropping the hi-boot nodes
--- The resulting list of strongly-connected-components is in topologically
--- sorted order, starting with the module(s) at the bottom of the
--- dependency graph (ie compile them first) and ending with the ones at
--- the top.
---
--- Drop hi-boot nodes (first boolean arg)? 
---
---   False:	treat the hi-boot summaries as nodes of the graph,
---		so the graph must be acyclic
---
---   True:	eliminate the hi-boot nodes, and instead pretend
---		the a source-import of Foo is an import of Foo
---		The resulting graph has no hi-boot nodes, but can by cyclic
-
-topSortModuleGraph drop_hs_boot_nodes summaries Nothing
-  = stronglyConnComp (fst (moduleGraphNodes drop_hs_boot_nodes summaries))
-topSortModuleGraph drop_hs_boot_nodes summaries (Just mod)
-  = stronglyConnComp (map vertex_fn (reachable graph root))
-  where 
-	-- restrict the graph to just those modules reachable from
-	-- the specified module.  We do this by building a graph with
-	-- the full set of nodes, and determining the reachable set from
-	-- the specified node.
-	(nodes, lookup_key) = moduleGraphNodes drop_hs_boot_nodes summaries
-	(graph, vertex_fn, key_fn) = graphFromEdges' nodes
-	root 
-	  | Just key <- lookup_key HsSrcFile mod, Just v <- key_fn key = v
-	  | otherwise  = throwDyn (ProgramError "module does not exist")
-
-moduleGraphNodes :: Bool -> [ModSummary]
-  -> ([(ModSummary, Int, [Int])], HscSource -> Module -> Maybe Int)
-moduleGraphNodes drop_hs_boot_nodes summaries = (nodes, lookup_key)
-   where
-	-- Drop hs-boot nodes by using HsSrcFile as the key
-	hs_boot_key | drop_hs_boot_nodes = HsSrcFile
-		    | otherwise		 = HsBootFile	
-
-	-- We use integers as the keys for the SCC algorithm
-	nodes :: [(ModSummary, Int, [Int])]	
-	nodes = [(s, expectJust "topSort" (lookup_key (ms_hsc_src s) (ms_mod s)), 
-		     out_edge_keys hs_boot_key (map unLoc (ms_srcimps s)) ++
-		     out_edge_keys HsSrcFile   (map unLoc (ms_imps s))    )
-		| s <- summaries
-		, not (isBootSummary s && drop_hs_boot_nodes) ]
-		-- Drop the hi-boot ones if told to do so
-
-	key_map :: NodeMap Int
-	key_map = listToFM ([(ms_mod s, ms_hsc_src s) | s <- summaries]
-			   `zip` [1..])
-
-	lookup_key :: HscSource -> Module -> Maybe Int
-	lookup_key hs_src mod = lookupFM key_map (mod, hs_src)
-
-	out_edge_keys :: HscSource -> [Module] -> [Int]
-        out_edge_keys hi_boot ms = mapCatMaybes (lookup_key hi_boot) ms
-		-- If we want keep_hi_boot_nodes, then we do lookup_key with
-		-- the IsBootInterface parameter True; else False
-
-
-type NodeKey   = (Module, HscSource)	  -- The nodes of the graph are 
-type NodeMap a = FiniteMap NodeKey a	  -- keyed by (mod, src_file_type) pairs
-
-msKey :: ModSummary -> NodeKey
-msKey (ModSummary { ms_mod = mod, ms_hsc_src = boot }) = (mod,boot)
-
-mkNodeMap :: [ModSummary] -> NodeMap ModSummary
-mkNodeMap summaries = listToFM [ (msKey s, s) | s <- summaries]
-	
-nodeMapElts :: NodeMap a -> [a]
-nodeMapElts = eltsFM
-
------------------------------------------------------------------------------
--- Downsweep (dependency analysis)
-
--- Chase downwards from the specified root set, returning summaries
--- for all home modules encountered.  Only follow source-import
--- links.
-
--- We pass in the previous collection of summaries, which is used as a
--- cache to avoid recalculating a module summary if the source is
--- unchanged.
---
--- The returned list of [ModSummary] nodes has one node for each home-package
--- module, plus one for any hs-boot files.  The imports of these nodes 
--- are all there, including the imports of non-home-package modules.
-
-downsweep :: HscEnv
-	  -> [ModSummary]	-- Old summaries
-	  -> [Module]		-- Ignore dependencies on these; treat
-				-- them as if they were package modules
-	  -> Bool		-- True <=> allow multiple targets to have 
-				-- 	    the same module name; this is 
-				--	    very useful for ghc -M
-	  -> IO (Maybe [ModSummary])
-		-- The elts of [ModSummary] all have distinct
-		-- (Modules, IsBoot) identifiers, unless the Bool is true
-		-- in which case there can be repeats
-downsweep hsc_env old_summaries excl_mods allow_dup_roots
-   = -- catch error messages and return them
-     handleDyn (\err_msg -> printBagOfErrors (hsc_dflags hsc_env) (unitBag err_msg) >> return Nothing) $ do
-       rootSummaries <- mapM getRootSummary roots
-       let root_map = mkRootMap rootSummaries
-       checkDuplicates root_map
-       summs <- loop (concatMap msDeps rootSummaries) root_map
-       return (Just summs)
-     where
-	roots = hsc_targets hsc_env
-
-	old_summary_map :: NodeMap ModSummary
-	old_summary_map = mkNodeMap old_summaries
-
-	getRootSummary :: Target -> IO ModSummary
-	getRootSummary (Target (TargetFile file mb_phase) maybe_buf)
-	   = do exists <- doesFileExist file
-		if exists 
-		    then summariseFile hsc_env old_summaries file mb_phase maybe_buf
-		    else throwDyn $ mkPlainErrMsg noSrcSpan $
-			   text "can't find file:" <+> text file
-	getRootSummary (Target (TargetModule modl) maybe_buf)
- 	   = do maybe_summary <- summariseModule hsc_env old_summary_map False 
-					   (L rootLoc modl) maybe_buf excl_mods
-		case maybe_summary of
-		   Nothing -> packageModErr modl
-		   Just s  -> return s
-
-	rootLoc = mkGeneralSrcSpan FSLIT("<command line>")
-
-	-- In a root module, the filename is allowed to diverge from the module
-	-- name, so we have to check that there aren't multiple root files
-	-- defining the same module (otherwise the duplicates will be silently
- 	-- ignored, leading to confusing behaviour).
-	checkDuplicates :: NodeMap [ModSummary] -> IO ()
-	checkDuplicates root_map 
-	   | allow_dup_roots = return ()
-	   | null dup_roots  = return ()
-	   | otherwise	     = multiRootsErr (head dup_roots)
-	   where
-	     dup_roots :: [[ModSummary]]	-- Each at least of length 2
-	     dup_roots = filterOut isSingleton (nodeMapElts root_map)
-
-	loop :: [(Located Module,IsBootInterface)]
-			-- Work list: process these modules
-	     -> NodeMap [ModSummary]
-		 	-- Visited set; the range is a list because
-			-- the roots can have the same module names
-			-- if allow_dup_roots is True
-	     -> IO [ModSummary]
-			-- The result includes the worklist, except
-			-- for those mentioned in the visited set
-	loop [] done 	  = return (concat (nodeMapElts done))
-	loop ((wanted_mod, is_boot) : ss) done 
-	  | Just summs <- lookupFM done key
-	  = if isSingleton summs then
-		loop ss done
-	    else
-		do { multiRootsErr summs; return [] }
-	  | otherwise	      = do { mb_s <- summariseModule hsc_env old_summary_map 
-						 is_boot wanted_mod Nothing excl_mods
-				   ; case mb_s of
-					Nothing -> loop ss done
-					Just s  -> loop (msDeps s ++ ss) 
-							(addToFM done key [s]) }
-	  where
-	    key = (unLoc wanted_mod, if is_boot then HsBootFile else HsSrcFile)
-
-mkRootMap :: [ModSummary] -> NodeMap [ModSummary]
-mkRootMap summaries = addListToFM_C (++) emptyFM 
-			[ (msKey s, [s]) | s <- summaries ]
-
-msDeps :: ModSummary -> [(Located Module, IsBootInterface)]
--- (msDeps s) returns the dependencies of the ModSummary s.
--- A wrinkle is that for a {-# SOURCE #-} import we return
---	*both* the hs-boot file
---	*and* the source file
--- as "dependencies".  That ensures that the list of all relevant
--- modules always contains B.hs if it contains B.hs-boot.
--- Remember, this pass isn't doing the topological sort.  It's
--- just gathering the list of all relevant ModSummaries
-msDeps s = 
-    concat [ [(m,True), (m,False)] | m <- ms_srcimps s ] 
-	 ++ [ (m,False) | m <- ms_imps s ] 
-
------------------------------------------------------------------------------
--- Summarising modules
-
--- We have two types of summarisation:
---
---    * Summarise a file.  This is used for the root module(s) passed to
---	cmLoadModules.  The file is read, and used to determine the root
---	module name.  The module name may differ from the filename.
---
---    * Summarise a module.  We are given a module name, and must provide
---	a summary.  The finder is used to locate the file in which the module
---	resides.
-
-summariseFile
-	:: HscEnv
-	-> [ModSummary]			-- old summaries
-	-> FilePath			-- source file name
-	-> Maybe Phase			-- start phase
-	-> Maybe (StringBuffer,ClockTime)
-	-> IO ModSummary
-
-summariseFile hsc_env old_summaries file mb_phase maybe_buf
-	-- we can use a cached summary if one is available and the
-	-- source file hasn't changed,  But we have to look up the summary
-	-- by source file, rather than module name as we do in summarise.
-   | Just old_summary <- findSummaryBySourceFile old_summaries file
-   = do
-	let location = ms_location old_summary
-
-		-- return the cached summary if the source didn't change
-	src_timestamp <- case maybe_buf of
-			   Just (_,t) -> return t
-			   Nothing    -> getModificationTime file
-		-- The file exists; we checked in getRootSummary above.
-		-- If it gets removed subsequently, then this 
-		-- getModificationTime may fail, but that's the right
-		-- behaviour.
-
-	if ms_hs_date old_summary == src_timestamp 
-	   then do -- update the object-file timestamp
-		  obj_timestamp <- getObjTimestamp location False
-		  return old_summary{ ms_obj_date = obj_timestamp }
-	   else
-		new_summary
-
-   | otherwise
-   = new_summary
-  where
-    new_summary = do
-   	let dflags = hsc_dflags hsc_env
-
-	(dflags', hspp_fn, buf)
-	    <- preprocessFile dflags file mb_phase maybe_buf
-
-        (srcimps,the_imps, L _ mod) <- getImports dflags' buf hspp_fn
-
-	-- Make a ModLocation for this file
-	location <- mkHomeModLocation dflags mod file
-
-	-- Tell the Finder cache where it is, so that subsequent calls
-	-- to findModule will find it, even if it's not on any search path
-	addHomeModuleToFinder hsc_env mod location
-
-        src_timestamp <- case maybe_buf of
-			   Just (_,t) -> return t
-			   Nothing    -> getModificationTime file
-			-- getMofificationTime may fail
-
-	obj_timestamp <- modificationTimeIfExists (ml_obj_file location)
-
-        return (ModSummary { ms_mod = mod, ms_hsc_src = HsSrcFile,
-			     ms_location = location,
-                             ms_hspp_file = hspp_fn,
-                             ms_hspp_opts = dflags',
-			     ms_hspp_buf  = Just buf,
-                             ms_srcimps = srcimps, ms_imps = the_imps,
-			     ms_hs_date = src_timestamp,
-			     ms_obj_date = obj_timestamp })
-
-findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
-findSummaryBySourceFile summaries file
-  = case [ ms | ms <- summaries, HsSrcFile <- [ms_hsc_src ms],
-			         expectJust "findSummaryBySourceFile" (ml_hs_file (ms_location ms)) == file ] of
-	[] -> Nothing
-	(x:xs) -> Just x
-
--- Summarise a module, and pick up source and timestamp.
-summariseModule
-	  :: HscEnv
-	  -> NodeMap ModSummary	-- Map of old summaries
-	  -> IsBootInterface	-- True <=> a {-# SOURCE #-} import
-	  -> Located Module	-- Imported module to be summarised
-	  -> Maybe (StringBuffer, ClockTime)
-	  -> [Module]		-- Modules to exclude
-	  -> IO (Maybe ModSummary)	-- Its new summary
-
-summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod) maybe_buf excl_mods
-  | wanted_mod `elem` excl_mods
-  = return Nothing
-
-  | Just old_summary <- lookupFM old_summary_map (wanted_mod, hsc_src)
-  = do	 	-- Find its new timestamp; all the 
-		-- ModSummaries in the old map have valid ml_hs_files
-	let location = ms_location old_summary
-	    src_fn = expectJust "summariseModule" (ml_hs_file location)
-
-		-- check the modification time on the source file, and
-		-- return the cached summary if it hasn't changed.  If the
-		-- file has disappeared, we need to call the Finder again.
-	case maybe_buf of
-	   Just (_,t) -> check_timestamp old_summary location src_fn t
-	   Nothing    -> do
-		m <- System.IO.Error.try (getModificationTime src_fn)
-		case m of
-		   Right t -> check_timestamp old_summary location src_fn t
-		   Left e | isDoesNotExistError e -> find_it
-		          | otherwise             -> ioError e
-
-  | otherwise  = find_it
-  where
-    dflags = hsc_dflags hsc_env
-
-    hsc_src = if is_boot then HsBootFile else HsSrcFile
-
-    check_timestamp old_summary location src_fn src_timestamp
-	| ms_hs_date old_summary == src_timestamp = do
-		-- update the object-file timestamp
-	   	obj_timestamp <- getObjTimestamp location is_boot
-		return (Just old_summary{ ms_obj_date = obj_timestamp })
-	| otherwise = 
-		-- source changed: find and re-summarise.  We call the finder
-		-- again, because the user may have moved the source file.
-		new_summary location src_fn src_timestamp
-
-    find_it = do
-	-- Don't use the Finder's cache this time.  If the module was
-	-- previously a package module, it may have now appeared on the
-	-- search path, so we want to consider it to be a home module.  If
-	-- the module was previously a home module, it may have moved.
-	uncacheModule hsc_env wanted_mod
-	found <- findModule hsc_env wanted_mod True {-explicit-}
-	case found of
-	     Found location pkg 
-		| not (isHomePackage pkg) -> return Nothing
-			-- Drop external-pkg
-		| isJust (ml_hs_file location) -> just_found location
-			-- Home package
-	     err -> noModError dflags loc wanted_mod err
-			-- Not found
-
-    just_found location = do
-	  	-- Adjust location to point to the hs-boot source file, 
-		-- hi file, object file, when is_boot says so
-	let location' | is_boot   = addBootSuffixLocn location
-		      | otherwise = location
-	    src_fn = expectJust "summarise2" (ml_hs_file location')
-
-		-- Check that it exists
-	  	-- It might have been deleted since the Finder last found it
-	maybe_t <- modificationTimeIfExists src_fn
-	case maybe_t of
-	  Nothing -> noHsFileErr loc src_fn
-	  Just t  -> new_summary location' src_fn t
-
-
-    new_summary location src_fn src_timestamp
-      = do
-	-- Preprocess the source file and get its imports
-	-- The dflags' contains the OPTIONS pragmas
-	(dflags', hspp_fn, buf) <- preprocessFile dflags src_fn Nothing maybe_buf
-        (srcimps, the_imps, L mod_loc mod_name) <- getImports dflags' buf hspp_fn
-
-	when (mod_name /= wanted_mod) $
-		throwDyn $ mkPlainErrMsg mod_loc $ 
-			      text "file name does not match module name"
-			      <+> quotes (ppr mod_name)
-
-		-- Find the object timestamp, and return the summary
-	obj_timestamp <- getObjTimestamp location is_boot
-
-	return (Just ( ModSummary { ms_mod       = wanted_mod, 
-				    ms_hsc_src   = hsc_src,
-				    ms_location  = location,
-				    ms_hspp_file = hspp_fn,
-                                    ms_hspp_opts = dflags',
-				    ms_hspp_buf  = Just buf,
-				    ms_srcimps   = srcimps,
-				    ms_imps      = the_imps,
-				    ms_hs_date   = src_timestamp,
-				    ms_obj_date  = obj_timestamp }))
-
-
-getObjTimestamp location is_boot
-  = if is_boot then return Nothing
-	       else modificationTimeIfExists (ml_obj_file location)
-
-
-preprocessFile :: DynFlags -> FilePath -> Maybe Phase -> Maybe (StringBuffer,ClockTime)
-  -> IO (DynFlags, FilePath, StringBuffer)
-preprocessFile dflags src_fn mb_phase Nothing
-  = do
-	(dflags', hspp_fn) <- preprocess dflags (src_fn, mb_phase)
-	buf <- hGetStringBuffer hspp_fn
-	return (dflags', hspp_fn, buf)
-
-preprocessFile dflags src_fn mb_phase (Just (buf, time))
-  = do
-	-- case we bypass the preprocessing stage?
-	let 
-	    local_opts = getOptions buf src_fn
-	--
-	(dflags', errs) <- parseDynamicFlags dflags (map unLoc local_opts)
-
-	let
-	    needs_preprocessing
-		| Just (Unlit _) <- mb_phase    = True
-	        | Nothing <- mb_phase, Unlit _ <- startPhase src_fn  = True
-		  -- note: local_opts is only required if there's no Unlit phase
-		| dopt Opt_Cpp dflags'		= True
-		| dopt Opt_Pp  dflags'		= True
-		| otherwise			= False
-
-	when needs_preprocessing $
-	   ghcError (ProgramError "buffer needs preprocesing; interactive check disabled")
-
-	return (dflags', src_fn, buf)
-
-
------------------------------------------------------------------------------
--- 			Error messages
------------------------------------------------------------------------------
-
-noModError :: DynFlags -> SrcSpan -> Module -> FindResult -> IO ab
--- ToDo: we don't have a proper line number for this error
-noModError dflags loc wanted_mod err
-  = throwDyn $ mkPlainErrMsg loc $ cantFindError dflags wanted_mod err
-				
-noHsFileErr loc path
-  = throwDyn $ mkPlainErrMsg loc $ text "Can't find" <+> text path
- 
-packageModErr mod
-  = throwDyn $ mkPlainErrMsg noSrcSpan $
-	text "module" <+> quotes (ppr mod) <+> text "is a package module"
-
-multiRootsErr :: [ModSummary] -> IO ()
-multiRootsErr summs@(summ1:_)
-  = throwDyn $ mkPlainErrMsg noSrcSpan $
-	text "module" <+> quotes (ppr mod) <+> 
-	text "is defined in multiple files:" <+>
-	sep (map text files)
-  where
-    mod = ms_mod summ1
-    files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
-
-cyclicModuleErr :: [ModSummary] -> SDoc
-cyclicModuleErr ms
-  = hang (ptext SLIT("Module imports form a cycle for modules:"))
-       2 (vcat (map show_one ms))
-  where
-    show_one ms = sep [ show_mod (ms_hsc_src ms) (ms_mod ms),
-			nest 2 $ ptext SLIT("imports:") <+> 
-				   (pp_imps HsBootFile (ms_srcimps ms)
-				   $$ pp_imps HsSrcFile  (ms_imps ms))]
-    show_mod hsc_src mod = ppr mod <> text (hscSourceString hsc_src)
-    pp_imps src mods = fsep (map (show_mod src) mods)
-
-
--- | Inform GHC that the working directory has changed.  GHC will flush
--- its cache of module locations, since it may no longer be valid.
--- Note: if you change the working directory, you should also unload
--- the current program (set targets to empty, followed by load).
-workingDirectoryChanged :: Session -> IO ()
-workingDirectoryChanged s = withSession s $ \hsc_env ->
-  flushFinderCache (hsc_FC hsc_env)
-
--- -----------------------------------------------------------------------------
--- inspecting the session
-
--- | Get the module dependency graph.
-getModuleGraph :: Session -> IO ModuleGraph -- ToDo: DiGraph ModSummary
-getModuleGraph s = withSession s (return . hsc_mod_graph)
-
-isLoaded :: Session -> Module -> IO Bool
-isLoaded s m = withSession s $ \hsc_env ->
-  return $! isJust (lookupModuleEnv (hsc_HPT hsc_env) m)
-
-getBindings :: Session -> IO [TyThing]
-getBindings s = withSession s (return . nameEnvElts . ic_type_env . hsc_IC)
-
-getPrintUnqual :: Session -> IO PrintUnqualified
-getPrintUnqual s = withSession s (return . icPrintUnqual . hsc_IC)
-
--- | Container for information about a 'Module'.
-data ModuleInfo = ModuleInfo {
-	minf_type_env  :: TypeEnv,
-	minf_exports   :: NameSet,
-	minf_rdr_env   :: Maybe GlobalRdrEnv,	-- Nothing for a compiled/package mod
-	minf_instances :: [Instance]
-	-- ToDo: this should really contain the ModIface too
-  }
-	-- We don't want HomeModInfo here, because a ModuleInfo applies
-	-- to package modules too.
-
--- | Request information about a loaded 'Module'
-getModuleInfo :: Session -> Module -> IO (Maybe ModuleInfo)
-getModuleInfo s mdl = withSession s $ \hsc_env -> do
-  let mg = hsc_mod_graph hsc_env
-  if mdl `elem` map ms_mod mg
-	then getHomeModuleInfo hsc_env mdl
-	else do
-  {- if isHomeModule (hsc_dflags hsc_env) mdl
-	then return Nothing
-	else -} getPackageModuleInfo hsc_env mdl
-   -- getPackageModuleInfo will attempt to find the interface, so
-   -- we don't want to call it for a home module, just in case there
-   -- was a problem loading the module and the interface doesn't
-   -- exist... hence the isHomeModule test here.  (ToDo: reinstate)
-
-getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
-getPackageModuleInfo hsc_env mdl = do
-#ifdef GHCI
-  (_msgs, mb_names) <- getModuleExports hsc_env mdl
-  case mb_names of
-    Nothing -> return Nothing
-    Just names -> do
-	eps <- readIORef (hsc_EPS hsc_env)
-	let 
-	    pte    = eps_PTE eps
-	    n_list = nameSetToList names
-	    tys    = [ ty | name <- n_list,
-			    Just ty <- [lookupTypeEnv pte name] ]
-	--
-	return (Just (ModuleInfo {
-			minf_type_env  = mkTypeEnv tys,
-			minf_exports   = names,
-			minf_rdr_env   = Just $! nameSetToGlobalRdrEnv names mdl,
-			minf_instances = error "getModuleInfo: instances for package module unimplemented"
-		}))
-#else
-  -- bogusly different for non-GHCI (ToDo)
-  return Nothing
-#endif
-
-getHomeModuleInfo hsc_env mdl = 
-  case lookupModuleEnv (hsc_HPT hsc_env) mdl of
-    Nothing  -> return Nothing
-    Just hmi -> do
-      let details = hm_details hmi
-      return (Just (ModuleInfo {
-			minf_type_env  = md_types details,
-			minf_exports   = md_exports details,
-			minf_rdr_env   = mi_globals $! hm_iface hmi,
-			minf_instances = md_insts details
-			}))
-
--- | The list of top-level entities defined in a module
-modInfoTyThings :: ModuleInfo -> [TyThing]
-modInfoTyThings minf = typeEnvElts (minf_type_env minf)
-
-modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
-modInfoTopLevelScope minf
-  = fmap (map gre_name . globalRdrEnvElts) (minf_rdr_env minf)
-
-modInfoExports :: ModuleInfo -> [Name]
-modInfoExports minf = nameSetToList $! minf_exports minf
-
--- | Returns the instances defined by the specified module.
--- Warning: currently unimplemented for package modules.
-modInfoInstances :: ModuleInfo -> [Instance]
-modInfoInstances = minf_instances
-
-modInfoIsExportedName :: ModuleInfo -> Name -> Bool
-modInfoIsExportedName minf name = elemNameSet name (minf_exports minf)
-
-modInfoPrintUnqualified :: ModuleInfo -> Maybe PrintUnqualified
-modInfoPrintUnqualified minf = fmap unQualInScope (minf_rdr_env minf)
-
-modInfoLookupName :: Session -> ModuleInfo -> Name -> IO (Maybe TyThing)
-modInfoLookupName s minf name = withSession s $ \hsc_env -> do
-   case lookupTypeEnv (minf_type_env minf) name of
-     Just tyThing -> return (Just tyThing)
-     Nothing      -> do
-       eps <- readIORef (hsc_EPS hsc_env)
-       return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
-
-isDictonaryId :: Id -> Bool
-isDictonaryId id
-  = case tcSplitSigmaTy (idType id) of { (tvs, theta, tau) -> isDictTy tau }
-
--- | Looks up a global name: that is, any top-level name in any
--- visible module.  Unlike 'lookupName', lookupGlobalName does not use
--- the interactive context, and therefore does not require a preceding
--- 'setContext'.
-lookupGlobalName :: Session -> Name -> IO (Maybe TyThing)
-lookupGlobalName s name = withSession s $ \hsc_env -> do
-   eps <- readIORef (hsc_EPS hsc_env)
-   return $! lookupType (hsc_HPT hsc_env) (eps_PTE eps) name
-
--- -----------------------------------------------------------------------------
--- Misc exported utils
-
-dataConType :: DataCon -> Type
-dataConType dc = idType (dataConWrapId dc)
-
--- | print a 'NamedThing', adding parentheses if the name is an operator.
-pprParenSymName :: NamedThing a => a -> SDoc
-pprParenSymName a = parenSymOcc (getOccName a) (ppr (getName a))
-
--- ----------------------------------------------------------------------------
-
-#if 0
-
--- ToDo:
---   - Data and Typeable instances for HsSyn.
-
--- ToDo: check for small transformations that happen to the syntax in
--- the typechecker (eg. -e ==> negate e, perhaps for fromIntegral)
-
--- ToDo: maybe use TH syntax instead of IfaceSyn?  There's already a way
--- to get from TyCons, Ids etc. to TH syntax (reify).
-
--- :browse will use either lm_toplev or inspect lm_interface, depending
--- on whether the module is interpreted or not.
-
--- This is for reconstructing refactored source code
--- Calls the lexer repeatedly.
--- ToDo: add comment tokens to token stream
-getTokenStream :: Session -> Module -> IO [Located Token]
-#endif
-
--- -----------------------------------------------------------------------------
--- Interactive evaluation
-
-#ifdef GHCI
-
--- | Set the interactive evaluation context.
---
--- Setting the context doesn't throw away any bindings; the bindings
--- we've built up in the InteractiveContext simply move to the new
--- module.  They always shadow anything in scope in the current context.
-setContext :: Session
-	   -> [Module]	-- entire top level scope of these modules
-	   -> [Module]	-- exports only of these modules
-	   -> IO ()
-setContext (Session ref) toplevs exports = do 
-  hsc_env <- readIORef ref
-  let old_ic  = hsc_IC     hsc_env
-      hpt     = hsc_HPT    hsc_env
-
-  mapM_ (checkModuleExists hsc_env hpt) exports
-  export_env  <- mkExportEnv hsc_env exports
-  toplev_envs <- mapM (mkTopLevEnv hpt) toplevs
-  let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
-  writeIORef ref hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplevs,
-					    ic_exports      = exports,
-					    ic_rn_gbl_env   = all_env }}
-
-
--- Make a GlobalRdrEnv based on the exports of the modules only.
-mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
-mkExportEnv hsc_env mods = do
-  stuff <- mapM (getModuleExports hsc_env) mods
-  let 
-	(_msgs, mb_name_sets) = unzip stuff
-	gres = [ nameSetToGlobalRdrEnv name_set mod
-  	       | (Just name_set, mod) <- zip mb_name_sets mods ]
-  --
-  return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv gres
-
-nameSetToGlobalRdrEnv :: NameSet -> Module -> GlobalRdrEnv
-nameSetToGlobalRdrEnv names mod =
-  mkGlobalRdrEnv [ GRE  { gre_name = name, gre_prov = vanillaProv mod }
-		 | name <- nameSetToList names ]
-
-vanillaProv :: Module -> Provenance
--- We're building a GlobalRdrEnv as if the user imported
--- all the specified modules into the global interactive module
-vanillaProv mod = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}]
-  where
-    decl = ImpDeclSpec { is_mod = mod, is_as = mod, 
-			 is_qual = False, 
-			 is_dloc = srcLocSpan interactiveSrcLoc }
-
-checkModuleExists :: HscEnv -> HomePackageTable -> Module -> IO ()
-checkModuleExists hsc_env hpt mod = 
-  case lookupModuleEnv hpt mod of
-    Just mod_info -> return ()
-    _not_a_home_module -> do
-	  res <- findPackageModule hsc_env mod True
-	  case res of
-	    Found _ _ -> return  ()
-	    err -> let msg = cantFindError (hsc_dflags hsc_env) mod err in
-		   throwDyn (CmdLineError (showSDoc msg))
-
-mkTopLevEnv :: HomePackageTable -> Module -> IO GlobalRdrEnv
-mkTopLevEnv hpt modl
- = case lookupModuleEnv hpt modl of
-      Nothing -> 	
-	 throwDyn (ProgramError ("mkTopLevEnv: not a home module " 
-			++ showSDoc (pprModule modl)))
-      Just details ->
-	 case mi_globals (hm_iface details) of
-		Nothing  -> 
-		   throwDyn (ProgramError ("mkTopLevEnv: not interpreted " 
-						++ showSDoc (pprModule modl)))
-		Just env -> return env
-
--- | Get the interactive evaluation context, consisting of a pair of the
--- set of modules from which we take the full top-level scope, and the set
--- of modules from which we take just the exports respectively.
-getContext :: Session -> IO ([Module],[Module])
-getContext s = withSession s (\HscEnv{ hsc_IC=ic } ->
-				return (ic_toplev_scope ic, ic_exports ic))
-
--- | Returns 'True' if the specified module is interpreted, and hence has
--- its full top-level scope available.
-moduleIsInterpreted :: Session -> Module -> IO Bool
-moduleIsInterpreted s modl = withSession s $ \h ->
- case lookupModuleEnv (hsc_HPT h) modl of
-      Just details       -> return (isJust (mi_globals (hm_iface details)))
-      _not_a_home_module -> return False
-
--- | Looks up an identifier in the current interactive context (for :info)
-getInfo :: Session -> Name -> IO (Maybe (TyThing,Fixity,[Instance]))
-getInfo s name = withSession s $ \hsc_env -> tcRnGetInfo hsc_env name
-
--- | Returns all names in scope in the current interactive context
-getNamesInScope :: Session -> IO [Name]
-getNamesInScope s = withSession s $ \hsc_env -> do
-  return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
-
-getRdrNamesInScope :: Session -> IO [RdrName]
-getRdrNamesInScope  s = withSession s $ \hsc_env -> do
-  let env = ic_rn_gbl_env (hsc_IC hsc_env)
-  return (concat (map greToRdrNames (globalRdrEnvElts env)))
-
--- ToDo: move to RdrName
-greToRdrNames :: GlobalRdrElt -> [RdrName]
-greToRdrNames GRE{ gre_name = name, gre_prov = prov }
-  = case prov of
-     LocalDef -> [unqual]
-     Imported specs -> concat (map do_spec (map is_decl specs))
-  where
-    occ = nameOccName name
-    unqual = Unqual occ
-    do_spec decl_spec
-	| is_qual decl_spec = [qual]
-	| otherwise         = [unqual,qual]
-	where qual = Qual (is_as decl_spec) occ
-
--- | Parses a string as an identifier, and returns the list of 'Name's that
--- the identifier can refer to in the current interactive context.
-parseName :: Session -> String -> IO [Name]
-parseName s str = withSession s $ \hsc_env -> do
-   maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
-   case maybe_rdr_name of
-	Nothing -> return []
-	Just (L _ rdr_name) -> do
-	    mb_names <- tcRnLookupRdrName hsc_env rdr_name
-	    case mb_names of
-		Nothing -> return []
-		Just ns -> return ns
-		-- ToDo: should return error messages
-
--- | Returns the 'TyThing' for a 'Name'.  The 'Name' may refer to any
--- entity known to GHC, including 'Name's defined using 'runStmt'.
-lookupName :: Session -> Name -> IO (Maybe TyThing)
-lookupName s name = withSession s $ \hsc_env -> tcRnLookupName hsc_env name
-
--- -----------------------------------------------------------------------------
--- Getting the type of an expression
-
--- | Get the type of an expression
-exprType :: Session -> String -> IO (Maybe Type)
-exprType s expr = withSession s $ \hsc_env -> do
-   maybe_stuff <- hscTcExpr hsc_env expr
-   case maybe_stuff of
-	Nothing -> return Nothing
-	Just ty -> return (Just tidy_ty)
- 	     where 
-		tidy_ty = tidyType emptyTidyEnv ty
-
--- -----------------------------------------------------------------------------
--- Getting the kind of a type
-
--- | Get the kind of a  type
-typeKind  :: Session -> String -> IO (Maybe Kind)
-typeKind s str = withSession s $ \hsc_env -> do
-   maybe_stuff <- hscKcType hsc_env str
-   case maybe_stuff of
-	Nothing -> return Nothing
-	Just kind -> return (Just kind)
-
------------------------------------------------------------------------------
--- cmCompileExpr: compile an expression and deliver an HValue
-
-compileExpr :: Session -> String -> IO (Maybe HValue)
-compileExpr s expr = withSession s $ \hsc_env -> do
-  maybe_stuff <- hscStmt hsc_env ("let __cmCompileExpr = "++expr)
-  case maybe_stuff of
-	Nothing -> return Nothing
-	Just (new_ic, names, hval) -> do
-			-- Run it!
-		hvals <- (unsafeCoerce# hval) :: IO [HValue]
-
-		case (names,hvals) of
-		  ([n],[hv]) -> return (Just hv)
-		  _ 	     -> panic "compileExpr"
-
--- -----------------------------------------------------------------------------
--- running a statement interactively
-
-data RunResult
-  = RunOk [Name] 		-- ^ names bound by this evaluation
-  | RunFailed	 		-- ^ statement failed compilation
-  | RunException Exception	-- ^ statement raised an exception
-
--- | Run a statement in the current interactive context.  Statemenet
--- may bind multple values.
-runStmt :: Session -> String -> IO RunResult
-runStmt (Session ref) expr
-   = do 
-	hsc_env <- readIORef ref
-
-	-- Turn off -fwarn-unused-bindings when running a statement, to hide
-	-- warnings about the implicit bindings we introduce.
-	let dflags'  = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
-	    hsc_env' = hsc_env{ hsc_dflags = dflags' }
-
-        maybe_stuff <- hscStmt hsc_env' expr
-
-        case maybe_stuff of
-	   Nothing -> return RunFailed
-	   Just (new_hsc_env, names, hval) -> do
-
-		let thing_to_run = unsafeCoerce# hval :: IO [HValue]
-		either_hvals <- sandboxIO thing_to_run
-
-		case either_hvals of
-		    Left e -> do
-			-- on error, keep the *old* interactive context,
-			-- so that 'it' is not bound to something
-			-- that doesn't exist.
-		        return (RunException e)
-
-		    Right hvals -> do
-			-- Get the newly bound things, and bind them.  
-			-- Don't need to delete any shadowed bindings;
-			-- the new ones override the old ones. 
-			extendLinkEnv (zip names hvals)
-	     		
-			writeIORef ref new_hsc_env
-			return (RunOk names)
-
--- When running a computation, we redirect ^C exceptions to the running
--- thread.  ToDo: we might want a way to continue even if the target
--- thread doesn't die when it receives the exception... "this thread
--- is not responding".
-sandboxIO :: IO a -> IO (Either Exception a)
-sandboxIO thing = do
-  m <- newEmptyMVar
-  ts <- takeMVar interruptTargetThread
-  child <- forkIO (do res <- Exception.try thing; putMVar m res)
-  putMVar interruptTargetThread (child:ts)
-  takeMVar m `finally` modifyMVar_ interruptTargetThread (return.tail)
-
-{-
--- This version of sandboxIO runs the expression in a completely new
--- RTS main thread.  It is disabled for now because ^C exceptions
--- won't be delivered to the new thread, instead they'll be delivered
--- to the (blocked) GHCi main thread.
-
--- SLPJ: when re-enabling this, reflect a wrong-stat error as an exception
-
-sandboxIO :: IO a -> IO (Either Int (Either Exception a))
-sandboxIO thing = do
-  st_thing <- newStablePtr (Exception.try thing)
-  alloca $ \ p_st_result -> do
-    stat <- rts_evalStableIO st_thing p_st_result
-    freeStablePtr st_thing
-    if stat == 1
-	then do st_result <- peek p_st_result
-		result <- deRefStablePtr st_result
-		freeStablePtr st_result
-		return (Right result)
-	else do
-		return (Left (fromIntegral stat))
-
-foreign import "rts_evalStableIO"  {- safe -}
-  rts_evalStableIO :: StablePtr (IO a) -> Ptr (StablePtr a) -> IO CInt
-  -- more informative than the C type!
--}
-
------------------------------------------------------------------------------
--- show a module and it's source/object filenames
-
-showModule :: Session -> ModSummary -> IO String
-showModule s mod_summary = withSession s $ \hsc_env -> do
-  case lookupModuleEnv (hsc_HPT hsc_env) (ms_mod mod_summary) of
-	Nothing	      -> panic "missing linkable"
-	Just mod_info -> return (showModMsg (hscTarget (hsc_dflags hsc_env)) (not obj_linkable) mod_summary)
-		      where
-			 obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
-
-#endif /* GHCI */
diff --git a/ghc/compiler/main/HeaderInfo.hs b/ghc/compiler/main/HeaderInfo.hs
deleted file mode 100644
index 913ac33a33..0000000000
--- a/ghc/compiler/main/HeaderInfo.hs
+++ /dev/null
@@ -1,201 +0,0 @@
------------------------------------------------------------------------------
---
--- Parsing the top of a Haskell source file to get its module name,
--- imports and options.
---
--- (c) Simon Marlow 2005
--- (c) Lemmih 2006
---
------------------------------------------------------------------------------
-
-module HeaderInfo ( getImportsFromFile, getImports
-                  , getOptionsFromFile, getOptions
-                  , optionsErrorMsgs ) where
-
-#include "HsVersions.h"
-
-import Parser		( parseHeader )
-import Lexer		( P(..), ParseResult(..), mkPState, pragState
-                        , lexer, Token(..), PState(..) )
-import FastString
-import HsSyn		( ImportDecl(..), HsModule(..) )
-import Module		( Module, mkModule )
-import PrelNames        ( gHC_PRIM )
-import StringBuffer	( StringBuffer(..), hGetStringBuffer, hGetStringBufferBlock
-                        , appendStringBuffers )
-import SrcLoc		( Located(..), mkSrcLoc, unLoc, noSrcSpan )
-import FastString	( mkFastString )
-import DynFlags	( DynFlags )
-import ErrUtils
-import Util
-import Outputable
-import Pretty           ()
-import Panic
-import Bag		( unitBag, emptyBag, listToBag )
-
-import Distribution.Compiler
-
-import TRACE
-
-import EXCEPTION	( throwDyn )
-import IO
-import List
-
-#if __GLASGOW_HASKELL__ >= 601
-import System.IO		( openBinaryFile )
-#else
-import IOExts                   ( openFileEx, IOModeEx(..) )
-#endif
-
-#if __GLASGOW_HASKELL__ < 601
-openBinaryFile fp mode = openFileEx fp (BinaryMode mode)
-#endif
-
--- getImportsFromFile is careful to close the file afterwards, otherwise
--- we can end up with a large number of open handles before the garbage
--- collector gets around to closing them.
-getImportsFromFile :: DynFlags -> FilePath
-   -> IO ([Located Module], [Located Module], Located Module)
-getImportsFromFile dflags filename = do
-  buf <- hGetStringBuffer filename
-  getImports dflags buf filename
-
-getImports :: DynFlags -> StringBuffer -> FilePath
-    -> IO ([Located Module], [Located Module], Located Module)
-getImports dflags buf filename = do
-  let loc  = mkSrcLoc (mkFastString filename) 1 0
-  case unP parseHeader (mkPState buf loc dflags) of
-	PFailed span err -> parseError span err
-	POk _ rdr_module -> 
-	  case rdr_module of
-	    L _ (HsModule mod _ imps _ _) ->
-	      let
-		mod_name | Just located_mod <- mod = located_mod
-			 | otherwise               = L noSrcSpan (mkModule "Main")
-	        (src_idecls, ord_idecls) = partition isSourceIdecl (map unLoc imps)
-		source_imps   = map getImpMod src_idecls	
-		ordinary_imps = filter ((/= gHC_PRIM) . unLoc) 
-					(map getImpMod ord_idecls)
-		     -- GHC.Prim doesn't exist physically, so don't go looking for it.
-	      in
-	      return (source_imps, ordinary_imps, mod_name)
-  
-parseError span err = throwDyn $ mkPlainErrMsg span err
-
-isSourceIdecl (ImportDecl _ s _ _ _) = s
-
-getImpMod (ImportDecl located_mod _ _ _ _) = located_mod
-
---------------------------------------------------------------
--- Get options
---------------------------------------------------------------
-
-
-getOptionsFromFile :: FilePath            -- input file
-                   -> IO [Located String] -- options, if any
-getOptionsFromFile filename
-    = bracket (openBinaryFile filename ReadMode)
-              (hClose)
-              (\handle ->
-                   do buf <- hGetStringBufferBlock handle blockSize
-                      loop handle buf)
-    where blockSize = 1024
-          loop handle buf
-              | len buf == 0 = return []
-              | otherwise
-              = case getOptions' buf filename of
-                  (Nothing, opts) -> return opts
-                  (Just buf', opts) -> do nextBlock <- hGetStringBufferBlock handle blockSize
-                                          newBuf <- appendStringBuffers buf' nextBlock
-                                          if len newBuf == len buf
-                                             then return opts
-                                             else do opts' <- loop handle newBuf
-                                                     return (opts++opts')
-
-getOptions :: StringBuffer -> FilePath -> [Located String]
-getOptions buf filename
-    = case getOptions' buf filename of
-        (_,opts) -> opts
-
--- The token parser is written manually because Happy can't
--- return a partial result when it encounters a lexer error.
--- We want to extract options before the buffer is passed through
--- CPP, so we can't use the same trick as 'getImports'.
-getOptions' :: StringBuffer         -- Input buffer
-            -> FilePath             -- Source file. Used for msgs only.
-            -> ( Maybe StringBuffer -- Just => we can use more input
-               , [Located String]   -- Options.
-               )
-getOptions' buf filename
-    = parseToks (lexAll (pragState buf loc))
-    where loc  = mkSrcLoc (mkFastString filename) 1 0
-
-          getToken (buf,L _loc tok) = tok
-          getLoc (buf,L loc _tok) = loc
-          getBuf (buf,_tok) = buf
-          combine opts (flag, opts') = (flag, opts++opts')
-          add opt (flag, opts) = (flag, opt:opts)
-
-          parseToks (open:close:xs)
-              | IToptions_prag str <- getToken open
-              , ITclose_prag       <- getToken close
-              = map (L (getLoc open)) (words str) `combine`
-                parseToks xs
-          parseToks (open:close:xs)
-              | ITinclude_prag str <- getToken open
-              , ITclose_prag       <- getToken close
-              = map (L (getLoc open)) ["-#include",removeSpaces str] `combine`
-                parseToks xs
-          parseToks (open:xs)
-              | ITlanguage_prag <- getToken open
-              = parseLanguage xs
-          -- The last token before EOF could have been truncated.
-          -- We ignore it to be on the safe side.
-          parseToks [tok,eof]
-              | ITeof <- getToken eof
-              = (Just (getBuf tok),[])
-          parseToks (eof:_)
-              | ITeof <- getToken eof
-              = (Just (getBuf eof),[])
-          parseToks _ = (Nothing,[])
-          parseLanguage ((_buf,L loc (ITconid fs)):rest)
-              = checkExtension (L loc fs) `add`
-                case rest of
-                  (_,L loc ITcomma):more -> parseLanguage more
-                  (_,L loc ITclose_prag):more -> parseToks more
-                  (_,L loc _):_ -> languagePragParseError loc
-          parseLanguage (tok:_)
-              = languagePragParseError (getLoc tok)
-          lexToken t = return t
-          lexAll state = case unP (lexer lexToken) state of
-                           POk state' t@(L _ ITeof) -> [(buffer state,t)]
-                           POk state' t -> (buffer state,t):lexAll state'
-                           _ -> [(buffer state,L (last_loc state) ITeof)]
-
-checkExtension :: Located FastString -> Located String
-checkExtension (L l ext)
-    = case reads (unpackFS ext) of
-        [] -> languagePragParseError l
-        (okExt,""):_ -> case extensionsToGHCFlag [okExt] of
-                          ([],[opt]) -> L l opt
-                          _ -> unsupportedExtnError l okExt
-
-languagePragParseError loc =
-  pgmError (showSDoc (mkLocMessage loc (
-                text "cannot parse LANGUAGE pragma")))
-
-unsupportedExtnError loc unsup =
-  pgmError (showSDoc (mkLocMessage loc (
-                text "unsupported extension: " <>
-                (text.show) unsup)))
-
-
-optionsErrorMsgs :: [String] -> [Located String] -> FilePath -> Messages
-optionsErrorMsgs unhandled_flags flags_lines filename
-  = (emptyBag, listToBag (map mkMsg unhandled_flags_lines))
-  where	unhandled_flags_lines = [ L l f | f <- unhandled_flags, 
-					  L l f' <- flags_lines, f == f' ]
-        mkMsg (L flagSpan flag) = 
-            ErrUtils.mkPlainErrMsg flagSpan $
-                    text "unknown flag in  {-# OPTIONS #-} pragma:" <+> text flag
-
diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
deleted file mode 100644
index e170f8fa31..0000000000
--- a/ghc/compiler/main/HscMain.lhs
+++ /dev/null
@@ -1,965 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-2000
-%
-
-\section[GHC_Main]{Main driver for Glasgow Haskell compiler}
-
-\begin{code}
-module HscMain
-    ( newHscEnv, hscCmmFile
-    , hscFileCheck
-    , hscParseIdentifier
-#ifdef GHCI
-    , hscStmt, hscTcExpr, hscKcType
-    , compileExpr
-#endif
-    , hscCompileOneShot     -- :: Compiler HscStatus
-    , hscCompileBatch       -- :: Compiler (HscStatus, ModIface, ModDetails)
-    , hscCompileNothing     -- :: Compiler (HscStatus, ModIface, ModDetails)
-    , hscCompileInteractive -- :: Compiler (InteractiveStatus, ModIface, ModDetails)
-    , HscStatus (..)
-    , InteractiveStatus (..)
-    , HscChecked (..)
-    ) where
-
-#include "HsVersions.h"
-
-#ifdef GHCI
-import HsSyn		( Stmt(..), LHsExpr, LStmt, LHsType )
-import Module		( Module )
-import CodeOutput	( outputForeignStubs )
-import ByteCodeGen	( byteCodeGen, coreExprToBCOs )
-import Linker		( HValue, linkExpr )
-import CoreTidy		( tidyExpr )
-import CorePrep		( corePrepExpr )
-import Flattening	( flattenExpr )
-import Desugar          ( deSugarExpr )
-import SimplCore        ( simplifyExpr )
-import TcRnDriver	( tcRnStmt, tcRnExpr, tcRnType ) 
-import Type		( Type )
-import PrelNames	( iNTERACTIVE )
-import Kind		( Kind )
-import CoreLint		( lintUnfolding )
-import DsMeta		( templateHaskellNames )
-import SrcLoc		( noSrcLoc )
-import VarEnv		( emptyTidyEnv )
-#endif
-
-import Var		( Id )
-import Module		( emptyModuleEnv, ModLocation(..) )
-import RdrName		( GlobalRdrEnv, RdrName )
-import HsSyn		( HsModule, LHsBinds, HsGroup, LIE, LImportDecl )
-import SrcLoc		( Located(..) )
-import StringBuffer	( hGetStringBuffer, stringToStringBuffer )
-import Parser
-import Lexer		( P(..), ParseResult(..), mkPState )
-import SrcLoc		( mkSrcLoc )
-import TcRnDriver	( tcRnModule, tcRnExtCore )
-import TcIface		( typecheckIface )
-import TcRnMonad	( initIfaceCheck, TcGblEnv(..) )
-import IfaceEnv		( initNameCache )
-import LoadIface	( ifaceStats, initExternalPackageState )
-import PrelInfo		( wiredInThings, basicKnownKeyNames )
-import MkIface		( checkOldIface, mkIface, writeIfaceFile )
-import Desugar          ( deSugar )
-import Flattening       ( flatten )
-import SimplCore        ( core2core )
-import TidyPgm		( tidyProgram, mkBootModDetails )
-import CorePrep		( corePrepPgm )
-import CoreToStg	( coreToStg )
-import TyCon		( isDataTyCon )
-import Packages		( mkHomeModules )
-import Name		( Name, NamedThing(..) )
-import SimplStg		( stg2stg )
-import CodeGen		( codeGen )
-import CmmParse		( parseCmmFile )
-import CodeOutput	( codeOutput )
-
-import DynFlags
-import ErrUtils
-import UniqSupply	( mkSplitUniqSupply )
-
-import Outputable
-import HscStats		( ppSourceStats )
-import HscTypes
-import MkExternalCore	( emitExternalCore )
-import ParserCore
-import ParserCoreUtils
-import FastString
-import Maybes		( expectJust )
-import Bag		( unitBag )
-import Monad		( unless )
-import IO
-import DATA_IOREF	( newIORef, readIORef )
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Initialisation
-%*									*
-%************************************************************************
-
-\begin{code}
-newHscEnv :: DynFlags -> IO HscEnv
-newHscEnv dflags
-  = do 	{ eps_var <- newIORef initExternalPackageState
-	; us      <- mkSplitUniqSupply 'r'
-	; nc_var  <- newIORef (initNameCache us knownKeyNames)
-	; fc_var  <- newIORef emptyModuleEnv
-	; return (HscEnv { hsc_dflags = dflags,
-			   hsc_targets = [],
-			   hsc_mod_graph = [],
-			   hsc_IC     = emptyInteractiveContext,
-			   hsc_HPT    = emptyHomePackageTable,
-			   hsc_EPS    = eps_var,
-			   hsc_NC     = nc_var,
-			   hsc_FC     = fc_var } ) }
-			
-
-knownKeyNames :: [Name]	-- Put here to avoid loops involving DsMeta,
-			-- where templateHaskellNames are defined
-knownKeyNames = map getName wiredInThings 
-	      ++ basicKnownKeyNames
-#ifdef GHCI
-	      ++ templateHaskellNames
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-		The main compiler pipeline
-%*									*
-%************************************************************************
-
-                   --------------------------------
-                        The compilation proper
-                   --------------------------------
-
-
-It's the task of the compilation proper to compile Haskell, hs-boot and
-core files to either byte-code, hard-code (C, asm, Java, ect) or to
-nothing at all (the module is still parsed and type-checked. This
-feature is mostly used by IDE's and the likes).
-Compilation can happen in either 'one-shot', 'batch', 'nothing',
-or 'interactive' mode. 'One-shot' mode targets hard-code, 'batch' mode
-targets hard-code, 'nothing' mode targets nothing and 'interactive' mode
-targets byte-code.
-The modes are kept separate because of their different types and meanings.
-In 'one-shot' mode, we're only compiling a single file and can therefore
-discard the new ModIface and ModDetails. This is also the reason it only
-targets hard-code; compiling to byte-code or nothing doesn't make sense
-when we discard the result.
-'Batch' mode is like 'one-shot' except that we keep the resulting ModIface
-and ModDetails. 'Batch' mode doesn't target byte-code since that require
-us to return the newly compiled byte-code.
-'Nothing' mode has exactly the same type as 'batch' mode but they're still
-kept separate. This is because compiling to nothing is fairly special: We
-don't output any interface files, we don't run the simplifier and we don't
-generate any code.
-'Interactive' mode is similar to 'batch' mode except that we return the
-compiled byte-code together with the ModIface and ModDetails.
-
-Trying to compile a hs-boot file to byte-code will result in a run-time
-error. This is the only thing that isn't caught by the type-system.
-
-\begin{code}
-
-data HscChecked
-    = HscChecked
-        -- parsed
-        (Located (HsModule RdrName))
-        -- renamed
-        (Maybe (HsGroup Name,[LImportDecl Name],Maybe [LIE Name]))
-        -- typechecked
-        (Maybe (LHsBinds Id, GlobalRdrEnv, ModDetails))
-
-
--- Status of a compilation to hard-code or nothing.
-data HscStatus
-    = HscNoRecomp
-    | HscRecomp  Bool -- Has stub files.
-                      -- This is a hack. We can't compile C files here
-                      -- since it's done in DriverPipeline. For now we
-                      -- just return True if we want the caller to compile
-                      -- it for us.
-
--- Status of a compilation to byte-code.
-data InteractiveStatus
-    = InteractiveNoRecomp
-    | InteractiveRecomp Bool     -- Same as HscStatus
-                        CompiledByteCode
-
-
--- I want Control.Monad.State! --Lemmih 03/07/2006
-newtype Comp a = Comp {runComp :: CompState -> IO (a, CompState)}
-
-instance Monad Comp where
-    g >>= fn = Comp $ \s -> runComp g s >>= \(a,s') -> runComp (fn a) s'
-    return a = Comp $ \s -> return (a,s)
-    fail = error
-
-evalComp :: Comp a -> CompState -> IO a
-evalComp comp st = do (val,_st') <- runComp comp st
-                      return val
-
-data CompState
-    = CompState
-    { compHscEnv     :: HscEnv
-    , compModSummary :: ModSummary
-    , compOldIface   :: Maybe ModIface
-    }
-
-get :: Comp CompState
-get = Comp $ \s -> return (s,s)
-
-gets :: (CompState -> a) -> Comp a
-gets getter = do st <- get
-                 return (getter st)
-
-liftIO :: IO a -> Comp a
-liftIO ioA = Comp $ \s -> do a <- ioA
-                             return (a,s)
-
-type NoRecomp result = ModIface -> Comp result
-type FrontEnd core = Comp (Maybe core)
-
--- FIXME: The old interface and module index are only using in 'batch' and
---        'interactive' mode. They should be removed from 'oneshot' mode.
-type Compiler result =  HscEnv
-                     -> ModSummary
-                     -> Bool                -- True <=> source unchanged
-                     -> Maybe ModIface      -- Old interface, if available
-                     -> Maybe (Int,Int)     -- Just (i,n) <=> module i of n (for msgs)
-                     -> IO (Maybe result)
-
-
--- This functions checks if recompilation is necessary and
--- then combines the FrontEnd and BackEnd to a working compiler.
-hscMkCompiler :: NoRecomp result         -- What to do when recompilation isn't required.
-              -> (Maybe (Int,Int) -> Bool -> Comp ())
-              -> FrontEnd core
-              -> (core -> Comp result)   -- Backend.
-              -> Compiler result
-hscMkCompiler norecomp messenger frontend backend
-              hsc_env mod_summary source_unchanged
-              mbOldIface mbModIndex
-    = flip evalComp (CompState hsc_env mod_summary mbOldIface) $
-      do (recomp_reqd, mbCheckedIface)
-             <- {-# SCC "checkOldIface" #-}
-                liftIO $ checkOldIface hsc_env mod_summary
-                              source_unchanged mbOldIface
-         case mbCheckedIface of 
-           Just iface | not recomp_reqd
-               -> do messenger mbModIndex False
-                     result <- norecomp iface
-                     return (Just result)
-           _otherwise
-               -> do messenger mbModIndex True
-                     mbCore <- frontend
-                     case mbCore of
-                       Nothing
-                           -> return Nothing
-                       Just core
-                           -> do result <- backend core
-                                 return (Just result)
-
---------------------------------------------------------------
--- Compilers
---------------------------------------------------------------
-
---        1         2         3         4         5         6         7         8          9
--- Compile Haskell, boot and extCore in OneShot mode.
-hscCompileOneShot :: Compiler HscStatus
-hscCompileOneShot hsc_env mod_summary =
-    compiler hsc_env mod_summary
-    where mkComp = hscMkCompiler norecompOneShot oneShotMsg
-          -- How to compile nonBoot files.
-          nonBootComp inp = hscSimplify inp >>= hscNormalIface >>=
-                            hscWriteIface >>= hscOneShot
-          -- How to compile boot files.
-          bootComp inp = hscSimpleIface inp >>= hscWriteIface >>= hscConst (HscRecomp False)
-          compiler
-              = case ms_hsc_src mod_summary of
-                ExtCoreFile
-                    -> mkComp hscCoreFrontEnd nonBootComp
-                HsSrcFile
-                    -> mkComp hscFileFrontEnd nonBootComp
-                HsBootFile
-                    -> mkComp hscFileFrontEnd bootComp
-
--- Compile Haskell, boot and extCore in batch mode.
-hscCompileBatch :: Compiler (HscStatus, ModIface, ModDetails)
-hscCompileBatch hsc_env mod_summary
-    = compiler hsc_env mod_summary
-    where mkComp = hscMkCompiler norecompBatch batchMsg
-          nonBootComp inp = hscSimplify inp >>= hscNormalIface >>=
-                            hscWriteIface >>= hscBatch
-          bootComp inp = hscSimpleIface inp >>= hscWriteIface >>= hscNothing
-          compiler
-              = case ms_hsc_src mod_summary of
-                ExtCoreFile
-                    -> mkComp hscCoreFrontEnd nonBootComp
-                HsSrcFile
-                    -> mkComp hscFileFrontEnd nonBootComp
-                HsBootFile
-                    -> mkComp hscFileFrontEnd bootComp
-
--- Type-check Haskell, boot and extCore.
--- Does it make sense to compile extCore to nothing?
-hscCompileNothing :: Compiler (HscStatus, ModIface, ModDetails)
-hscCompileNothing hsc_env mod_summary
-    = compiler hsc_env mod_summary
-    where mkComp = hscMkCompiler norecompBatch batchMsg
-          pipeline inp = hscSimpleIface inp >>= hscIgnoreIface >>= hscNothing
-          compiler
-              = case ms_hsc_src mod_summary of
-                ExtCoreFile
-                    -> mkComp hscCoreFrontEnd pipeline
-                HsSrcFile
-                    -> mkComp hscFileFrontEnd pipeline
-                HsBootFile
-                    -> mkComp hscFileFrontEnd pipeline
-
--- Compile Haskell, extCore to bytecode.
-hscCompileInteractive :: Compiler (InteractiveStatus, ModIface, ModDetails)
-hscCompileInteractive hsc_env mod_summary =
-    hscMkCompiler norecompInteractive batchMsg
-                  frontend backend
-                  hsc_env mod_summary
-    where backend inp = hscSimplify inp >>= hscNormalIface >>= hscIgnoreIface >>= hscInteractive
-          frontend = case ms_hsc_src mod_summary of
-                       ExtCoreFile -> hscCoreFrontEnd
-                       HsSrcFile   -> hscFileFrontEnd
-                       HsBootFile  -> panic bootErrorMsg
-          bootErrorMsg = "Compiling a HsBootFile to bytecode doesn't make sense. " ++
-                         "Use 'hscCompileBatch' instead."
-
---------------------------------------------------------------
--- NoRecomp handlers
---------------------------------------------------------------
-
-norecompOneShot :: NoRecomp HscStatus
-norecompOneShot old_iface
-    = do hsc_env <- gets compHscEnv
-         liftIO $ do
-         dumpIfaceStats hsc_env
-         return HscNoRecomp
-
-norecompBatch :: NoRecomp (HscStatus, ModIface, ModDetails)
-norecompBatch = norecompWorker HscNoRecomp False
-
-norecompInteractive :: NoRecomp (InteractiveStatus, ModIface, ModDetails)
-norecompInteractive = norecompWorker InteractiveNoRecomp True
-
-norecompWorker :: a -> Bool -> NoRecomp (a, ModIface, ModDetails)
-norecompWorker a isInterp old_iface
-    = do hsc_env <- gets compHscEnv
-         mod_summary <- gets compModSummary
-         liftIO $ do
-         new_details <- {-# SCC "tcRnIface" #-}
-                        initIfaceCheck hsc_env $
-                        typecheckIface old_iface
-         dumpIfaceStats hsc_env
-         return (a, old_iface, new_details)
-
---------------------------------------------------------------
--- Progress displayers.
---------------------------------------------------------------
-
-oneShotMsg :: Maybe (Int,Int) -> Bool -> Comp ()
-oneShotMsg _mb_mod_index recomp
-    = do hsc_env <- gets compHscEnv
-         liftIO $ do
-         if recomp
-            then return ()
-            else compilationProgressMsg (hsc_dflags hsc_env) $
-                     "compilation IS NOT required"
-
-batchMsg :: Maybe (Int,Int) -> Bool -> Comp ()
-batchMsg mb_mod_index recomp
-    = do hsc_env <- gets compHscEnv
-         mod_summary <- gets compModSummary
-         let showMsg msg = compilationProgressMsg (hsc_dflags hsc_env) $
-                           (showModuleIndex mb_mod_index ++
-                            msg ++ showModMsg (hscTarget (hsc_dflags hsc_env)) recomp mod_summary)
-         liftIO $ do
-         if recomp
-            then showMsg "Compiling "
-            else showMsg "Skipping  "
-
-
-
---------------------------------------------------------------
--- FrontEnds
---------------------------------------------------------------
-
-hscCoreFrontEnd :: FrontEnd ModGuts
-hscCoreFrontEnd =
-    do hsc_env <- gets compHscEnv
-       mod_summary <- gets compModSummary
-       liftIO $ do
-            -------------------
-            -- PARSE
-            -------------------
-       inp <- readFile (ms_hspp_file mod_summary)
-       case parseCore inp 1 of
-         FailP s
-             -> do errorMsg (hsc_dflags hsc_env) (text s{-ToDo: wrong-})
-                   return Nothing
-         OkP rdr_module
-             -------------------
-             -- RENAME and TYPECHECK
-             -------------------
-             -> do (tc_msgs, maybe_tc_result) <- {-# SCC "TypeCheck" #-}
-                                                 tcRnExtCore hsc_env rdr_module
-                   printErrorsAndWarnings (hsc_dflags hsc_env) tc_msgs
-                   case maybe_tc_result of
-                     Nothing       -> return Nothing
-                     Just mod_guts -> return (Just mod_guts)         -- No desugaring to do!
-
-	 
-hscFileFrontEnd :: FrontEnd ModGuts
-hscFileFrontEnd =
-    do hsc_env <- gets compHscEnv
-       mod_summary <- gets compModSummary
-       liftIO $ do
-             -------------------
-             -- PARSE
-             -------------------
-       let dflags = hsc_dflags hsc_env
-           hspp_file = ms_hspp_file mod_summary
-           hspp_buf  = ms_hspp_buf  mod_summary
-       maybe_parsed <- myParseModule dflags hspp_file hspp_buf
-       case maybe_parsed of
-         Left err
-             -> do printBagOfErrors dflags (unitBag err)
-                   return Nothing
-         Right rdr_module
-             -------------------
-             -- RENAME and TYPECHECK
-             -------------------
-             -> do (tc_msgs, maybe_tc_result) 
-                       <- {-# SCC "Typecheck-Rename" #-}
-                          tcRnModule hsc_env (ms_hsc_src mod_summary) False rdr_module
-                   printErrorsAndWarnings dflags tc_msgs
-                   case maybe_tc_result of
-                     Nothing
-                         -> return Nothing
-                     Just tc_result
-                         -------------------
-                         -- DESUGAR
-                         -------------------
-                         -> do (warns, maybe_ds_result) <- {-# SCC "DeSugar" #-}
-                                                           deSugar hsc_env tc_result
-                               printBagOfWarnings dflags warns
-                               return maybe_ds_result
-
---------------------------------------------------------------
--- Simplifiers
---------------------------------------------------------------
-
-hscSimplify :: ModGuts -> Comp ModGuts
-hscSimplify ds_result
-  = do hsc_env <- gets compHscEnv
-       liftIO $ do
-       flat_result <- {-# SCC "Flattening" #-}
-                      flatten hsc_env ds_result
-           -------------------
-           -- SIMPLIFY
-           -------------------
-       simpl_result <- {-# SCC "Core2Core" #-}
-                       core2core hsc_env flat_result
-       return simpl_result
-
---------------------------------------------------------------
--- Interface generators
---------------------------------------------------------------
-
--- HACK: we return ModGuts even though we know it's not gonna be used.
---       We do this because the type signature needs to be identical
---       in structure to the type of 'hscNormalIface'.
-hscSimpleIface :: ModGuts -> Comp (ModIface, Bool, ModDetails, ModGuts)
-hscSimpleIface ds_result
-  = do hsc_env <- gets compHscEnv
-       mod_summary <- gets compModSummary
-       maybe_old_iface <- gets compOldIface
-       liftIO $ do
-       details <- mkBootModDetails hsc_env ds_result
-       (new_iface, no_change) 
-           <- {-# SCC "MkFinalIface" #-}
-              mkIface hsc_env maybe_old_iface ds_result details
-       -- And the answer is ...
-       dumpIfaceStats hsc_env
-       return (new_iface, no_change, details, ds_result)
-
-hscNormalIface :: ModGuts -> Comp (ModIface, Bool, ModDetails, CgGuts)
-hscNormalIface simpl_result
-  = do hsc_env <- gets compHscEnv
-       mod_summary <- gets compModSummary
-       maybe_old_iface <- gets compOldIface
-       liftIO $ do
- 	    -------------------
- 	    -- TIDY
- 	    -------------------
-       (cg_guts, details) <- {-# SCC "CoreTidy" #-}
-                             tidyProgram hsc_env simpl_result
-
- 	    -------------------
-	    -- BUILD THE NEW ModIface and ModDetails
-	    --	and emit external core if necessary
-	    -- This has to happen *after* code gen so that the back-end
-	    -- info has been set.  Not yet clear if it matters waiting
-	    -- until after code output
-       (new_iface, no_change)
-		<- {-# SCC "MkFinalIface" #-}
-		   mkIface hsc_env maybe_old_iface simpl_result details
-	-- Emit external core
-       emitExternalCore (hsc_dflags hsc_env) cg_guts -- Move this? --Lemmih 03/07/2006
-       dumpIfaceStats hsc_env
-
- 	    -------------------
- 	    -- Return the prepared code.
-       return (new_iface, no_change, details, cg_guts)
-
---------------------------------------------------------------
--- BackEnd combinators
---------------------------------------------------------------
-
-hscWriteIface :: (ModIface, Bool, ModDetails, a) -> Comp (ModIface, ModDetails, a)
-hscWriteIface (iface, no_change, details, a)
-    = do mod_summary <- gets compModSummary
-         liftIO $ do
-         unless no_change
-           $ writeIfaceFile (ms_location mod_summary) iface
-         return (iface, details, a)
-
-hscIgnoreIface :: (ModIface, Bool, ModDetails, a) -> Comp (ModIface, ModDetails, a)
-hscIgnoreIface (iface, no_change, details, a)
-    = return (iface, details, a)
-
--- Don't output any code.
-hscNothing :: (ModIface, ModDetails, a) -> Comp (HscStatus, ModIface, ModDetails)
-hscNothing (iface, details, a)
-    = return (HscRecomp False, iface, details)
-
--- Generate code and return both the new ModIface and the ModDetails.
-hscBatch :: (ModIface, ModDetails, CgGuts) -> Comp (HscStatus, ModIface, ModDetails)
-hscBatch (iface, details, cgguts)
-    = do hasStub <- hscCompile cgguts
-         return (HscRecomp hasStub, iface, details)
-
--- Here we don't need the ModIface and ModDetails anymore.
-hscOneShot :: (ModIface, ModDetails, CgGuts) -> Comp HscStatus
-hscOneShot (_, _, cgguts)
-    = do hasStub <- hscCompile cgguts
-         return (HscRecomp hasStub)
-
--- Compile to hard-code.
-hscCompile :: CgGuts -> Comp Bool
-hscCompile cgguts
-    = do hsc_env <- gets compHscEnv
-         mod_summary <- gets compModSummary
-         liftIO $ do
-         let CgGuts{ -- This is the last use of the ModGuts in a compilation.
-                     -- From now on, we just use the bits we need.
-                     cg_module   = this_mod,
-                     cg_binds    = core_binds,
-                     cg_tycons   = tycons,
-                     cg_dir_imps = dir_imps,
-                     cg_foreign  = foreign_stubs,
-                     cg_home_mods = home_mods,
-                     cg_dep_pkgs = dependencies } = cgguts
-             dflags = hsc_dflags hsc_env
-             location = ms_location mod_summary
-             data_tycons = filter isDataTyCon tycons
-             -- cg_tycons includes newtypes, for the benefit of External Core,
-             -- but we don't generate any code for newtypes
-
-         -------------------
-         -- PREPARE FOR CODE GENERATION
-         -- Do saturation and convert to A-normal form
-         prepd_binds <- {-# SCC "CorePrep" #-}
-                        corePrepPgm dflags core_binds data_tycons ;
-         -----------------  Convert to STG ------------------
-         (stg_binds, cost_centre_info)
-             <- {-# SCC "CoreToStg" #-}
-                myCoreToStg dflags home_mods this_mod prepd_binds	
-         ------------------  Code generation ------------------
-         abstractC <- {-# SCC "CodeGen" #-}
-                      codeGen dflags home_mods this_mod data_tycons
-                              foreign_stubs dir_imps cost_centre_info
-                              stg_binds
-         ------------------  Code output -----------------------
-         (stub_h_exists,stub_c_exists)
-             <- codeOutput dflags this_mod location foreign_stubs 
-                dependencies abstractC
-         return stub_c_exists
-
-hscConst :: b -> a -> Comp b
-hscConst b a = return b
-
-hscInteractive :: (ModIface, ModDetails, CgGuts)
-               -> Comp (InteractiveStatus, ModIface, ModDetails)
-hscInteractive (iface, details, cgguts)
-#ifdef GHCI
-    = do hsc_env <- gets compHscEnv
-         mod_summary <- gets compModSummary
-         liftIO $ do
-         let CgGuts{ -- This is the last use of the ModGuts in a compilation.
-                     -- From now on, we just use the bits we need.
-                     cg_module   = this_mod,
-                     cg_binds    = core_binds,
-                     cg_tycons   = tycons,
-                     cg_foreign  = foreign_stubs } = cgguts
-             dflags = hsc_dflags hsc_env
-             location = ms_location mod_summary
-             data_tycons = filter isDataTyCon tycons
-             -- cg_tycons includes newtypes, for the benefit of External Core,
-             -- but we don't generate any code for newtypes
-
-         -------------------
-         -- PREPARE FOR CODE GENERATION
-         -- Do saturation and convert to A-normal form
-         prepd_binds <- {-# SCC "CorePrep" #-}
-                        corePrepPgm dflags core_binds data_tycons ;
-         -----------------  Generate byte code ------------------
-         comp_bc <- byteCodeGen dflags prepd_binds data_tycons
-         ------------------ Create f-x-dynamic C-side stuff ---
-         (istub_h_exists, istub_c_exists) 
-             <- outputForeignStubs dflags this_mod location foreign_stubs
-         return (InteractiveRecomp istub_c_exists comp_bc, iface, details)
-#else
-    = panic "GHC not compiled with interpreter"
-#endif
-
-------------------------------
-
-hscFileCheck :: HscEnv -> ModSummary -> IO (Maybe HscChecked)
-hscFileCheck hsc_env mod_summary = do {
- 	    -------------------
- 	    -- PARSE
- 	    -------------------
-	; let dflags    = hsc_dflags hsc_env
-	      hspp_file = ms_hspp_file mod_summary
-	      hspp_buf  = ms_hspp_buf  mod_summary
-
-	; maybe_parsed <- myParseModule dflags hspp_file hspp_buf
-
-	; case maybe_parsed of {
-      	     Left err -> do { printBagOfErrors dflags (unitBag err)
-			    ; return Nothing } ;
-      	     Right rdr_module -> do {
-
- 	    -------------------
- 	    -- RENAME and TYPECHECK
- 	    -------------------
-	  (tc_msgs, maybe_tc_result) 
-		<- _scc_ "Typecheck-Rename" 
-		   tcRnModule hsc_env (ms_hsc_src mod_summary) 
-			True{-save renamed syntax-}
-			rdr_module
-
-	; printErrorsAndWarnings dflags tc_msgs
-	; case maybe_tc_result of {
-      	     Nothing -> return (Just (HscChecked rdr_module Nothing Nothing));
-      	     Just tc_result -> do
-		let md = ModDetails { 
-				md_types   = tcg_type_env tc_result,
-				md_exports = tcg_exports  tc_result,
-				md_insts   = tcg_insts    tc_result,
-				md_rules   = [panic "no rules"] }
-				   -- Rules are CoreRules, not the
-				   -- RuleDecls we get out of the typechecker
-                    rnInfo = do decl <- tcg_rn_decls tc_result
-                                imports <- tcg_rn_imports tc_result
-                                let exports = tcg_rn_exports tc_result
-                                return (decl,imports,exports)
-		return (Just (HscChecked rdr_module 
-                                   rnInfo
-				   (Just (tcg_binds tc_result,
-					  tcg_rdr_env tc_result,
-					  md))))
-	}}}}
-
-
-hscCmmFile :: DynFlags -> FilePath -> IO Bool
-hscCmmFile dflags filename = do
-  maybe_cmm <- parseCmmFile dflags (mkHomeModules []) filename
-  case maybe_cmm of
-    Nothing -> return False
-    Just cmm -> do
-	codeOutput dflags no_mod no_loc NoStubs [] [cmm]
-	return True
-  where
-	no_mod = panic "hscCmmFile: no_mod"
-	no_loc = ModLocation{ ml_hs_file  = Just filename,
-                              ml_hi_file  = panic "hscCmmFile: no hi file",
-                              ml_obj_file = panic "hscCmmFile: no obj file" }
-
-
-myParseModule dflags src_filename maybe_src_buf
- =    --------------------------  Parser  ----------------
-      showPass dflags "Parser" >>
-      {-# SCC "Parser" #-} do
-
-	-- sometimes we already have the buffer in memory, perhaps
-	-- because we needed to parse the imports out of it, or get the 
-	-- module name.
-      buf <- case maybe_src_buf of
-		Just b  -> return b
-		Nothing -> hGetStringBuffer src_filename
-
-      let loc  = mkSrcLoc (mkFastString src_filename) 1 0
-
-      case unP parseModule (mkPState buf loc dflags) of {
-
-	PFailed span err -> return (Left (mkPlainErrMsg span err));
-
-	POk _ rdr_module -> do {
-
-      dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr rdr_module) ;
-      
-      dumpIfSet_dyn dflags Opt_D_source_stats "Source Statistics"
-			   (ppSourceStats False rdr_module) ;
-      
-      return (Right rdr_module)
-	-- ToDo: free the string buffer later.
-      }}
-
-
-myCoreToStg dflags home_mods this_mod prepd_binds
- = do 
-      stg_binds <- {-# SCC "Core2Stg" #-}
-	     coreToStg home_mods prepd_binds
-
-      (stg_binds2, cost_centre_info) <- {-# SCC "Stg2Stg" #-}
-	     stg2stg dflags home_mods this_mod stg_binds
-
-      return (stg_binds2, cost_centre_info)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Compiling a do-statement}
-%*									*
-%************************************************************************
-
-When the UnlinkedBCOExpr is linked you get an HValue of type
-	IO [HValue]
-When you run it you get a list of HValues that should be 
-the same length as the list of names; add them to the ClosureEnv.
-
-A naked expression returns a singleton Name [it].
-
-	What you type			The IO [HValue] that hscStmt returns
-	-------------			------------------------------------
-	let pat = expr		==> 	let pat = expr in return [coerce HVal x, coerce HVal y, ...]
-					bindings: [x,y,...]
-
-	pat <- expr		==> 	expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
-					bindings: [x,y,...]
-
-	expr (of IO type)	==>	expr >>= \ v -> return [v]
-	  [NB: result not printed]	bindings: [it]
-	  
-
-	expr (of non-IO type, 
-	  result showable)	==>	let v = expr in print v >> return [v]
-	  				bindings: [it]
-
-	expr (of non-IO type, 
-	  result not showable)	==>	error
-
-\begin{code}
-#ifdef GHCI
-hscStmt		-- Compile a stmt all the way to an HValue, but don't run it
-  :: HscEnv
-  -> String			-- The statement
-  -> IO (Maybe (HscEnv, [Name], HValue))
-
-hscStmt hsc_env stmt
-  = do	{ maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) stmt
-	; case maybe_stmt of {
-      	     Nothing	  -> return Nothing ;	-- Parse error
-      	     Just Nothing -> return Nothing ;	-- Empty line
-      	     Just (Just parsed_stmt) -> do {	-- The real stuff
-
-		-- Rename and typecheck it
-	  let icontext = hsc_IC hsc_env
-	; maybe_tc_result <- tcRnStmt hsc_env icontext parsed_stmt
-
-	; case maybe_tc_result of {
-		Nothing -> return Nothing ;
-		Just (new_ic, bound_names, tc_expr) -> do {
-
-		-- Then desugar, code gen, and link it
-	; hval <- compileExpr hsc_env iNTERACTIVE 
-			      (ic_rn_gbl_env new_ic) 
-			      (ic_type_env new_ic)
-			      tc_expr
-
-	; return (Just (hsc_env{ hsc_IC=new_ic }, bound_names, hval))
-	}}}}}
-
-hscTcExpr	-- Typecheck an expression (but don't run it)
-  :: HscEnv
-  -> String			-- The expression
-  -> IO (Maybe Type)
-
-hscTcExpr hsc_env expr
-  = do	{ maybe_stmt <- hscParseStmt (hsc_dflags hsc_env) expr
-	; let icontext = hsc_IC hsc_env
-	; case maybe_stmt of {
-	     Nothing      -> return Nothing ;	-- Parse error
-	     Just (Just (L _ (ExprStmt expr _ _)))
-			-> tcRnExpr hsc_env icontext expr ;
-	     Just other -> do { errorMsg (hsc_dflags hsc_env) (text "not an expression:" <+> quotes (text expr)) ;
-			        return Nothing } ;
-      	     } }
-
-hscKcType	-- Find the kind of a type
-  :: HscEnv
-  -> String			-- The type
-  -> IO (Maybe Kind)
-
-hscKcType hsc_env str
-  = do	{ maybe_type <- hscParseType (hsc_dflags hsc_env) str
-	; let icontext = hsc_IC hsc_env
-	; case maybe_type of {
-	     Just ty	-> tcRnType hsc_env icontext ty ;
-	     Just other -> do { errorMsg (hsc_dflags hsc_env) (text "not an type:" <+> quotes (text str)) ;
-			        return Nothing } ;
-      	     Nothing    -> return Nothing } }
-#endif
-\end{code}
-
-\begin{code}
-#ifdef GHCI
-hscParseStmt :: DynFlags -> String -> IO (Maybe (Maybe (LStmt RdrName)))
-hscParseStmt = hscParseThing parseStmt
-
-hscParseType :: DynFlags -> String -> IO (Maybe (LHsType RdrName))
-hscParseType = hscParseThing parseType
-#endif
-
-hscParseIdentifier :: DynFlags -> String -> IO (Maybe (Located RdrName))
-hscParseIdentifier = hscParseThing parseIdentifier
-
-hscParseThing :: Outputable thing
-	      => Lexer.P thing
-	      -> DynFlags -> String
-	      -> IO (Maybe thing)
-	-- Nothing => Parse error (message already printed)
-	-- Just x  => success
-hscParseThing parser dflags str
- = showPass dflags "Parser" >>
-      {-# SCC "Parser" #-} do
-
-      buf <- stringToStringBuffer str
-
-      let loc  = mkSrcLoc FSLIT("<interactive>") 1 0
-
-      case unP parser (mkPState buf loc dflags) of {
-
-	PFailed span err -> do { printError span err;
-                                 return Nothing };
-
-	POk _ thing -> do {
-
-      --ToDo: can't free the string buffer until we've finished this
-      -- compilation sweep and all the identifiers have gone away.
-      dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser" (ppr thing);
-      return (Just thing)
-      }}
-\end{code}
-
-%************************************************************************
-%*									*
-	Desugar, simplify, convert to bytecode, and link an expression
-%*									*
-%************************************************************************
-
-\begin{code}
-#ifdef GHCI
-compileExpr :: HscEnv 
-	    -> Module -> GlobalRdrEnv -> TypeEnv
-	    -> LHsExpr Id
-	    -> IO HValue
-
-compileExpr hsc_env this_mod rdr_env type_env tc_expr
-  = do	{ let { dflags  = hsc_dflags hsc_env ;
-		lint_on = dopt Opt_DoCoreLinting dflags }
-	      
-	 	-- Desugar it
-	; ds_expr <- deSugarExpr hsc_env this_mod rdr_env type_env tc_expr
-	
-		-- Flatten it
-	; flat_expr <- flattenExpr hsc_env ds_expr
-
-		-- Simplify it
-	; simpl_expr <- simplifyExpr dflags flat_expr
-
-		-- Tidy it (temporary, until coreSat does cloning)
-	; let tidy_expr = tidyExpr emptyTidyEnv simpl_expr
-
-		-- Prepare for codegen
-	; prepd_expr <- corePrepExpr dflags tidy_expr
-
-		-- Lint if necessary
-		-- ToDo: improve SrcLoc
-	; if lint_on then 
-		case lintUnfolding noSrcLoc [] prepd_expr of
-		   Just err -> pprPanic "compileExpr" err
-		   Nothing  -> return ()
-	  else
-		return ()
-
-		-- Convert to BCOs
-	; bcos <- coreExprToBCOs dflags prepd_expr
-
-		-- link it
-	; hval <- linkExpr hsc_env bcos
-
-	; return hval
-     }
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Statistics on reading interfaces
-%*									*
-%************************************************************************
-
-\begin{code}
-dumpIfaceStats :: HscEnv -> IO ()
-dumpIfaceStats hsc_env
-  = do	{ eps <- readIORef (hsc_EPS hsc_env)
-	; dumpIfSet (dump_if_trace || dump_rn_stats)
-	      	    "Interface statistics"
-	      	    (ifaceStats eps) }
-  where
-    dflags = hsc_dflags hsc_env
-    dump_rn_stats = dopt Opt_D_dump_rn_stats dflags
-    dump_if_trace = dopt Opt_D_dump_if_trace dflags
-\end{code}
-
-%************************************************************************
-%*									*
-	Progress Messages: Module i of n
-%*									*
-%************************************************************************
-
-\begin{code}
-showModuleIndex Nothing = ""
-showModuleIndex (Just (i,n)) = "[" ++ padded ++ " of " ++ n_str ++ "] "
-    where
-        n_str = show n
-        i_str = show i
-        padded = replicate (length n_str - length i_str) ' ' ++ i_str
-\end{code}
-
diff --git a/ghc/compiler/main/HscStats.lhs b/ghc/compiler/main/HscStats.lhs
deleted file mode 100644
index 750744af44..0000000000
--- a/ghc/compiler/main/HscStats.lhs
+++ /dev/null
@@ -1,160 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[GHC_Stats]{Statistics for per-module compilations}
-
-\begin{code}
-module HscStats ( ppSourceStats ) where
-
-#include "HsVersions.h"
-
-import HsSyn
-import Outputable
-import SrcLoc		( unLoc, Located(..) )
-import Char		( isSpace )
-import Bag		( bagToList )
-import Util             ( count )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Statistics}
-%*									*
-%************************************************************************
-
-\begin{code}
-ppSourceStats short (L _ (HsModule _ exports imports ldecls _))
- = (if short then hcat else vcat)
-        (map pp_val
-	       [("ExportAll        ", export_all), -- 1 if no export list
-		("ExportDecls      ", export_ds),
-		("ExportModules    ", export_ms),
-		("Imports          ", import_no),
-		("  ImpQual        ", import_qual),
-		("  ImpAs          ", import_as),
-		("  ImpAll         ", import_all),
-		("  ImpPartial     ", import_partial),
-		("  ImpHiding      ", import_hiding),
-		("FixityDecls      ", fixity_sigs),
-		("DefaultDecls     ", default_ds),
-	      	("TypeDecls        ", type_ds),
-	      	("DataDecls        ", data_ds),
-	      	("NewTypeDecls     ", newt_ds),
-	      	("DataConstrs      ", data_constrs),
-		("DataDerivings    ", data_derivs),
-	      	("ClassDecls       ", class_ds),
-	      	("ClassMethods     ", class_method_ds),
-	      	("DefaultMethods   ", default_method_ds),
-	      	("InstDecls        ", inst_ds),
-	      	("InstMethods      ", inst_method_ds),
-	      	("TypeSigs         ", bind_tys),
-	      	("ValBinds         ", val_bind_ds),
-	      	("FunBinds         ", fn_bind_ds),
-	      	("InlineMeths      ", method_inlines),
-		("InlineBinds      ", bind_inlines),
---	      	("SpecialisedData  ", data_specs),
---	      	("SpecialisedInsts ", inst_specs),
-	      	("SpecialisedMeths ", method_specs),
-	      	("SpecialisedBinds ", bind_specs)
-	       ])
-  where
-    decls = map unLoc ldecls
-
-    pp_val (str, 0) = empty
-    pp_val (str, n) 
-      | not short   = hcat [text str, int n]
-      | otherwise   = hcat [text (trim str), equals, int n, semi]
-    
-    trim ls     = takeWhile (not.isSpace) (dropWhile isSpace ls)
-
-    (fixity_sigs, bind_tys, bind_specs, bind_inlines) 
-	= count_sigs [d | SigD d <- decls]
-		-- NB: this omits fixity decls on local bindings and
-		-- in class decls.  ToDo
-
-    tycl_decls  = [d | TyClD d <- decls]
-    (class_ds, type_ds, data_ds, newt_ds) = countTyClDecls tycl_decls
-
-    inst_decls  = [d | InstD d <- decls]
-    inst_ds     = length inst_decls
-    default_ds  = count (\ x -> case x of { DefD{} -> True; _ -> False}) decls
-    val_decls   = [d | ValD d <- decls]
-
-    real_exports = case exports of { Nothing -> []; Just es -> es }
-    n_exports  	 = length real_exports
-    export_ms  	 = count (\ e -> case unLoc e of { IEModuleContents{} -> True;_ -> False})
-                         real_exports
-    export_ds  	 = n_exports - export_ms
-    export_all 	 = case exports of { Nothing -> 1; other -> 0 }
-
-    (val_bind_ds, fn_bind_ds)
-	= foldr add2 (0,0) (map count_bind val_decls)
-
-    (import_no, import_qual, import_as, import_all, import_partial, import_hiding)
-	= foldr add6 (0,0,0,0,0,0) (map import_info imports)
-    (data_constrs, data_derivs)
-	= foldr add2 (0,0) (map data_info tycl_decls)
-    (class_method_ds, default_method_ds)
-	= foldr add2 (0,0) (map class_info tycl_decls)
-    (inst_method_ds, method_specs, method_inlines)
-	= foldr add3 (0,0,0) (map inst_info inst_decls)
-
-    count_bind (PatBind { pat_lhs = L _ (VarPat n) }) = (1,0)
-    count_bind (PatBind {})                           = (0,1)
-    count_bind (FunBind {})                           = (0,1)
-
-    count_sigs sigs = foldr add4 (0,0,0,0) (map sig_info sigs)
-
-    sig_info (FixSig _)		= (1,0,0,0)
-    sig_info (TypeSig _ _)      = (0,1,0,0)
-    sig_info (SpecSig _ _ _)    = (0,0,1,0)
-    sig_info (InlineSig _ _)    = (0,0,0,1)
-    sig_info _                  = (0,0,0,0)
-
-    import_info (L _ (ImportDecl _ _ qual as spec))
-	= add6 (1, qual_info qual, as_info as, 0,0,0) (spec_info spec)
-    qual_info False  = 0
-    qual_info True   = 1
-    as_info Nothing  = 0
-    as_info (Just _) = 1
-    spec_info Nothing 	        = (0,0,0,1,0,0)
-    spec_info (Just (False, _)) = (0,0,0,0,1,0)
-    spec_info (Just (True, _))  = (0,0,0,0,0,1)
-
-    data_info (TyData {tcdCons = cs, tcdDerivs = derivs})
-	= (length cs, case derivs of Nothing -> 0
-				     Just ds -> length ds)
-    data_info other = (0,0)
-
-    class_info decl@(ClassDecl {})
-	= case count_sigs (map unLoc (tcdSigs decl)) of
-	    (_,classops,_,_) ->
-	       (classops, addpr (foldr add2 (0,0) (map (count_bind.unLoc) (bagToList (tcdMeths decl)))))
-    class_info other = (0,0)
-
-    inst_info (InstDecl _ inst_meths inst_sigs)
-	= case count_sigs (map unLoc inst_sigs) of
-	    (_,_,ss,is) ->
-	       (addpr (foldr add2 (0,0) (map (count_bind.unLoc) (bagToList inst_meths))), ss, is)
-
-    addpr :: (Int,Int) -> Int
-    add2  :: (Int,Int) -> (Int,Int) -> (Int, Int)
-    add3  :: (Int,Int,Int) -> (Int,Int,Int) -> (Int, Int, Int)
-    add4  :: (Int,Int,Int,Int) -> (Int,Int,Int,Int) -> (Int, Int, Int, Int)
-    add6  :: (Int,Int,Int,Int,Int,Int) -> (Int,Int,Int,Int,Int,Int) -> (Int, Int, Int, Int, Int, Int)
-
-    addpr (x,y) = x+y
-    add2 (x1,x2) (y1,y2) = (x1+y1,x2+y2)
-    add3 (x1,x2,x3) (y1,y2,y3) = (x1+y1,x2+y2,x3+y3)
-    add4 (x1,x2,x3,x4) (y1,y2,y3,y4) = (x1+y1,x2+y2,x3+y3,x4+y4)
-    add6 (x1,x2,x3,x4,x5,x6) (y1,y2,y3,y4,y5,y6) = (x1+y1,x2+y2,x3+y3,x4+y4,x5+y5,x6+y6)
-\end{code}
-
-
-
-
-
-
-
-
-
diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
deleted file mode 100644
index ee5438b319..0000000000
--- a/ghc/compiler/main/HscTypes.lhs
+++ /dev/null
@@ -1,1083 +0,0 @@
-
-% (c) The University of Glasgow, 2000
-%
-\section[HscTypes]{Types for the per-module compiler}
-
-\begin{code}
-module HscTypes ( 
-	-- * Sessions and compilation state
-	Session(..), HscEnv(..), hscEPS,
-	FinderCache, FinderCacheEntry,
-	Target(..), TargetId(..), pprTarget, pprTargetId,
-	ModuleGraph, emptyMG,
-
-	ModDetails(..),	emptyModDetails,
-	ModGuts(..), CgGuts(..), ModImports(..), ForeignStubs(..),
-
-	ModSummary(..), showModMsg, isBootSummary,
-	msHsFilePath, msHiFilePath, msObjFilePath, 
-
-	HscSource(..), isHsBoot, hscSourceString,	-- Re-exported from DriverPhases
-	
-	HomePackageTable, HomeModInfo(..), emptyHomePackageTable,
-	hptInstances, hptRules,
-
-	ExternalPackageState(..), EpsStats(..), addEpsInStats,
-	PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,
-	lookupIface, lookupIfaceByModule, emptyModIface,
-
-	InteractiveContext(..), emptyInteractiveContext, 
-	icPrintUnqual, unQualInScope,
-
-	ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
-	emptyIfaceDepCache, 
-
-	Deprecs(..), IfaceDeprecs,
-
-	FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
-
-	implicitTyThings, 
-
-	TyThing(..), tyThingClass, tyThingTyCon, tyThingDataCon, tyThingId,
-	TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
-	extendTypeEnv, extendTypeEnvList, extendTypeEnvWithIds, lookupTypeEnv,
-	typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
-
-	WhetherHasOrphans, IsBootInterface, Usage(..), 
-	Dependencies(..), noDependencies,
-	NameCache(..), OrigNameCache, OrigIParamCache,
-	Avails, availsToNameSet, availName, availNames,
-	GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
-	IfaceExport,
-
-	Deprecations, DeprecTxt, lookupDeprec, plusDeprecs,
-
-	PackageInstEnv, PackageRuleBase,
-
-	-- Linker stuff
-	Linkable(..), isObjectLinkable,
-	Unlinked(..), CompiledByteCode,
-	isObject, nameOfObject, isInterpretable, byteCodeOfObject
-    ) where
-
-#include "HsVersions.h"
-
-#ifdef GHCI
-import ByteCodeAsm	( CompiledByteCode )
-#endif
-
-import RdrName		( GlobalRdrEnv, emptyGlobalRdrEnv,
-			  LocalRdrEnv, emptyLocalRdrEnv,
-			  GlobalRdrElt(..), mkRdrUnqual, lookupGRE_RdrName )
-import Name		( Name, NamedThing, getName, nameOccName, nameModule )
-import NameEnv
-import NameSet	
-import OccName		( OccName, OccEnv, lookupOccEnv, mkOccEnv, emptyOccEnv, 
-			  extendOccEnv )
-import Module
-import InstEnv		( InstEnv, Instance )
-import Rules		( RuleBase )
-import CoreSyn		( CoreBind )
-import Id		( Id )
-import Type		( TyThing(..) )
-
-import Class		( Class, classSelIds, classTyCon )
-import TyCon		( TyCon, tyConSelIds, tyConDataCons )
-import DataCon		( dataConImplicitIds )
-import PrelNames	( gHC_PRIM )
-import Packages		( PackageIdH, PackageId, PackageConfig, HomeModules )
-import DynFlags		( DynFlags(..), isOneShot, HscTarget (..) )
-import DriverPhases	( HscSource(..), isHsBoot, hscSourceString, Phase )
-import BasicTypes	( Version, initialVersion, IPName, 
-			  Fixity, defaultFixity, DeprecTxt )
-
-import IfaceSyn		( IfaceInst, IfaceRule, IfaceDecl(ifName) )
-
-import FiniteMap	( FiniteMap )
-import CoreSyn		( CoreRule )
-import Maybes		( orElse, expectJust, expectJust )
-import Outputable
-import SrcLoc		( SrcSpan, Located )
-import UniqSupply	( UniqSupply )
-import FastString	( FastString )
-
-import DATA_IOREF	( IORef, readIORef )
-import StringBuffer	( StringBuffer )
-import Time		( ClockTime )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Compilation environment}
-%*									*
-%************************************************************************
-
-
-\begin{code}
--- | The Session is a handle to the complete state of a compilation
--- session.  A compilation session consists of a set of modules
--- constituting the current program or library, the context for
--- interactive evaluation, and various caches.
-newtype Session = Session (IORef HscEnv)
-\end{code}
-
-HscEnv is like Session, except that some of the fields are immutable.
-An HscEnv is used to compile a single module from plain Haskell source
-code (after preprocessing) to either C, assembly or C--.  Things like
-the module graph don't change during a single compilation.
-
-Historical note: "hsc" used to be the name of the compiler binary,
-when there was a separate driver and compiler.  To compile a single
-module, the driver would invoke hsc on the source code... so nowadays
-we think of hsc as the layer of the compiler that deals with compiling
-a single module.
-
-\begin{code}
-data HscEnv 
-  = HscEnv { 
-	hsc_dflags :: DynFlags,
-		-- The dynamic flag settings
-
-	hsc_targets :: [Target],
-		-- The targets (or roots) of the current session
-
-	hsc_mod_graph :: ModuleGraph,
-		-- The module graph of the current session
-
-	hsc_IC :: InteractiveContext,
-		-- The context for evaluating interactive statements
-
-	hsc_HPT    :: HomePackageTable,
-		-- The home package table describes already-compiled
-		-- home-packge modules, *excluding* the module we 
-		-- are compiling right now.
-		-- (In one-shot mode the current module is the only
-		--  home-package module, so hsc_HPT is empty.  All other
-		--  modules count as "external-package" modules.
-		--  However, even in GHCi mode, hi-boot interfaces are
-		--  demand-loadeded into the external-package table.)
-		--
-		-- hsc_HPT is not mutable because we only demand-load 
-		-- external packages; the home package is eagerly 
-		-- loaded, module by module, by the compilation manager.
-		--	
-		-- The HPT may contain modules compiled earlier by --make
-		-- but not actually below the current module in the dependency
-		-- graph.  (This changes a previous invariant: changed Jan 05.)
-	
-	hsc_EPS	:: {-# UNPACK #-} !(IORef ExternalPackageState),
-	hsc_NC	:: {-# UNPACK #-} !(IORef NameCache),
-		-- These are side-effected by compiling to reflect
-		-- sucking in interface files.  They cache the state of
-		-- external interface files, in effect.
-
-	hsc_FC  :: {-# UNPACK #-} !(IORef FinderCache)
-		-- The finder's cache.  This caches the location of modules,
-		-- so we don't have to search the filesystem multiple times.
- }
-
-hscEPS :: HscEnv -> IO ExternalPackageState
-hscEPS hsc_env = readIORef (hsc_EPS hsc_env)
-
--- | A compilation target.
---
--- A target may be supplied with the actual text of the
--- module.  If so, use this instead of the file contents (this
--- is for use in an IDE where the file hasn't been saved by
--- the user yet).
-data Target = Target TargetId (Maybe (StringBuffer,ClockTime))
-
-data TargetId
-  = TargetModule Module
-	-- ^ A module name: search for the file
-  | TargetFile FilePath (Maybe Phase)
-	-- ^ A filename: preprocess & parse it to find the module name.
-	-- If specified, the Phase indicates how to compile this file
-	-- (which phase to start from).  Nothing indicates the starting phase
-	-- should be determined from the suffix of the filename.
-  deriving Eq
-
-pprTarget :: Target -> SDoc
-pprTarget (Target id _) = pprTargetId id
-
-pprTargetId (TargetModule m) = ppr m
-pprTargetId (TargetFile f _) = text f
-
-type FinderCache = ModuleEnv FinderCacheEntry
-type FinderCacheEntry = (ModLocation, Maybe (PackageConfig,Bool))
-	-- The finder's cache (see module Finder)
-
-type HomePackageTable  = ModuleEnv HomeModInfo
-	-- Domain = modules in the home package
-type PackageIfaceTable = ModuleEnv ModIface
-	-- Domain = modules in the imported packages
-
-emptyHomePackageTable  = emptyModuleEnv
-emptyPackageIfaceTable = emptyModuleEnv
-
-data HomeModInfo 
-  = HomeModInfo { hm_iface    :: !ModIface,
-		  hm_details  :: !ModDetails,
-		  hm_linkable :: !(Maybe Linkable) }
-		-- hm_linkable might be Nothing if:
-		--   a) this is an .hs-boot module
-		--   b) temporarily during compilation if we pruned away
-		--      the old linkable because it was out of date.
-		-- after a complete compilation (GHC.load), all hm_linkable
-		-- fields in the HPT will be Just.
-		--
-		-- When re-linking a module (hscNoRecomp), we construct
-		-- the HomModInfo by building a new ModDetails from the
-		-- old ModIface (only).
-\end{code}
-
-Simple lookups in the symbol table.
-
-\begin{code}
-lookupIface :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
--- We often have two IfaceTables, and want to do a lookup
-lookupIface hpt pit mod
-  = case lookupModuleEnv hpt mod of
-	Just mod_info -> Just (hm_iface mod_info)
-	Nothing       -> lookupModuleEnv pit mod
-
-lookupIfaceByModule :: HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
--- We often have two IfaceTables, and want to do a lookup
-lookupIfaceByModule hpt pit mod
-  = case lookupModuleEnv hpt mod of
-	Just mod_info -> Just (hm_iface mod_info)
-	Nothing       -> lookupModuleEnv pit mod
-\end{code}
-
-
-\begin{code}
-hptInstances :: HscEnv -> (Module -> Bool) -> [Instance]
--- Find all the instance declarations that are in modules imported 
--- by this one, directly or indirectly, and are in the Home Package Table
--- This ensures that we don't see instances from modules --make compiled 
--- before this one, but which are not below this one
-hptInstances hsc_env want_this_module
-  = [ ispec 
-    | mod_info <- moduleEnvElts (hsc_HPT hsc_env)
-    , want_this_module (mi_module (hm_iface mod_info))
-    , ispec <- md_insts (hm_details mod_info) ]
-
-hptRules :: HscEnv -> [(Module, IsBootInterface)] -> [CoreRule]
--- Get rules from modules "below" this one (in the dependency sense)
--- C.f Inst.hptInstances
-hptRules hsc_env deps
-  | isOneShot (ghcMode (hsc_dflags hsc_env)) = []
-  | otherwise
-  = let 
-	hpt = hsc_HPT hsc_env
-    in
-    [ rule
-    |	-- Find each non-hi-boot module below me
-      (mod, False) <- deps
-
-	-- unsavoury: when compiling the base package with --make, we
-	-- sometimes try to look up RULES for GHC.Prim.  GHC.Prim won't
-	-- be in the HPT, because we never compile it; it's in the EPT
-	-- instead.  ToDo: clean up, and remove this slightly bogus
-	-- filter:
-    , mod /= gHC_PRIM
-
-	-- Look it up in the HPT
-    , let mod_info = case lookupModuleEnv hpt mod of
-		  	Nothing -> pprPanic "hptRules" (ppr mod <+> ppr deps)
-		  	Just x  -> x
-
-	-- And get its dfuns
-    , rule <- md_rules (hm_details mod_info) ]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Symbol tables and Module details}
-%*									*
-%************************************************************************
-
-A @ModIface@ plus a @ModDetails@ summarises everything we know 
-about a compiled module.  The @ModIface@ is the stuff *before* linking,
-and can be written out to an interface file.  (The @ModDetails@ is after 
-linking; it is the "linked" form of the mi_decls field.)
-
-When we *read* an interface file, we also construct a @ModIface@ from it,
-except that the mi_decls part is empty; when reading we consolidate
-the declarations into a single indexed map in the @PersistentRenamerState@.
-
-\begin{code}
-data ModIface 
-   = ModIface {
-	mi_package  :: !PackageIdH,	    -- Which package the module comes from
-        mi_module   :: !Module,
-        mi_mod_vers :: !Version,	    -- Module version: changes when anything changes
-
-        mi_orphan   :: !WhetherHasOrphans,  -- Whether this module has orphans
-	mi_boot	    :: !IsBootInterface,    -- Read from an hi-boot file?
-
-	mi_deps	    :: Dependencies,
-		-- This is consulted for directly-imported modules,
-		-- but not for anything else (hence lazy)
-
-		-- Usages; kept sorted so that it's easy to decide
-		-- whether to write a new iface file (changing usages
-		-- doesn't affect the version of this module)
-        mi_usages   :: [Usage],
-		-- NOT STRICT!  we read this field lazily from the interface file
-		-- It is *only* consulted by the recompilation checker
-
-		-- Exports
-		-- Kept sorted by (mod,occ), to make version comparisons easier
-        mi_exports  :: ![IfaceExport],
-        mi_exp_vers :: !Version,	-- Version number of export list
-
-		-- Fixities
-        mi_fixities :: [(OccName,Fixity)],
-		-- NOT STRICT!  we read this field lazily from the interface file
-
-		-- Deprecations
-	mi_deprecs  :: IfaceDeprecs,
-		-- NOT STRICT!  we read this field lazily from the interface file
-
-		-- Type, class and variable declarations
-		-- The version of an Id changes if its fixity or deprecations change
-		--	(as well as its type of course)
-		-- Ditto data constructors, class operations, except that 
-		-- the version of the parent class/tycon changes
-	mi_decls :: [(Version,IfaceDecl)],	-- Sorted
-
-        mi_globals  :: !(Maybe GlobalRdrEnv),
-		-- Binds all the things defined at the top level in
-		-- the *original source* code for this module. which
-		-- is NOT the same as mi_exports, nor mi_decls (which
-		-- may contains declarations for things not actually
-		-- defined by the user).  Used for GHCi and for inspecting
-		-- the contents of modules via the GHC API only.
-		--
-		-- (We need the source file to figure out the
-		-- top-level environment, if we didn't compile this module
-		-- from source then this field contains Nothing).
-		--
-		-- Strictly speaking this field should live in the
-		-- HomeModInfo, but that leads to more plumbing.
-
-		-- Instance declarations and rules
-	mi_insts     :: [IfaceInst],	-- Sorted
-	mi_rules     :: [IfaceRule],	-- Sorted
-	mi_rule_vers :: !Version,	-- Version number for rules and instances combined
-
-		-- Cached environments for easy lookup
-		-- These are computed (lazily) from other fields
-		-- and are not put into the interface file
-	mi_dep_fn  :: Name -> Maybe DeprecTxt,	-- Cached lookup for mi_deprecs
-	mi_fix_fn  :: OccName -> Fixity,	-- Cached lookup for mi_fixities
-	mi_ver_fn  :: OccName -> Maybe Version	-- Cached lookup for mi_decls
-			-- The Nothing in mi_ver_fn means that the thing
-			-- isn't in decls. It's useful to know that when
-			-- seeing if we are up to date wrt the old interface
-     }
-
--- Should be able to construct ModDetails from mi_decls in ModIface
-data ModDetails
-   = ModDetails {
-	-- The next three fields are created by the typechecker
-	md_exports  :: NameSet,
-        md_types    :: !TypeEnv,
-        md_insts    :: ![Instance],	-- Dfun-ids for the instances in this module
-        md_rules    :: ![CoreRule]	-- Domain may include Ids from other modules
-     }
-
-emptyModDetails = ModDetails { md_types = emptyTypeEnv,
-			       md_exports = emptyNameSet,
-			       md_insts = [],
-			       md_rules = [] }
-
--- A ModGuts is carried through the compiler, accumulating stuff as it goes
--- There is only one ModGuts at any time, the one for the module
--- being compiled right now.  Once it is compiled, a ModIface and 
--- ModDetails are extracted and the ModGuts is dicarded.
-
-data ModGuts
-  = ModGuts {
-        mg_module   :: !Module,
-	mg_boot     :: IsBootInterface, -- Whether it's an hs-boot module
-	mg_exports  :: !NameSet,	-- What it exports
-	mg_deps	    :: !Dependencies,	-- What is below it, directly or otherwise
-	mg_home_mods :: !HomeModules,	-- For calling isHomeModule etc.
-	mg_dir_imps :: ![Module],	-- Directly-imported modules; used to
-					--	generate initialisation code
-	mg_usages   :: ![Usage],	-- Version info for what it needed
-
-        mg_rdr_env  :: !GlobalRdrEnv,	-- Top-level lexical environment
-	mg_fix_env  :: !FixityEnv,	-- Fixity env, for things declared in this module
-	mg_deprecs  :: !Deprecations,	-- Deprecations declared in the module
-
-	mg_types    :: !TypeEnv,
-	mg_insts    :: ![Instance],	-- Instances 
-        mg_rules    :: ![CoreRule],	-- Rules from this module
-	mg_binds    :: ![CoreBind],	-- Bindings for this module
-	mg_foreign  :: !ForeignStubs
-    }
-
--- The ModGuts takes on several slightly different forms:
---
--- After simplification, the following fields change slightly:
---	mg_rules	Orphan rules only (local ones now attached to binds)
---	mg_binds	With rules attached
-
-
----------------------------------------------------------
--- The Tidy pass forks the information about this module: 
---	* one lot goes to interface file generation (ModIface)
---	  and later compilations (ModDetails)
---	* the other lot goes to code generation (CgGuts)
-data CgGuts 
-  = CgGuts {
-	cg_module   :: !Module,
-
-	cg_tycons   :: [TyCon],
-		-- Algebraic data types (including ones that started
-		-- life as classes); generate constructors and info
-		-- tables Includes newtypes, just for the benefit of
-		-- External Core
-
-	cg_binds    :: [CoreBind],
-		-- The tidied main bindings, including
-		-- previously-implicit bindings for record and class
-		-- selectors, and data construtor wrappers.  But *not*
-		-- data constructor workers; reason: we we regard them
-		-- as part of the code-gen of tycons
-
-	cg_dir_imps :: ![Module],
-		-- Directly-imported modules; used to generate
-		-- initialisation code
-
-	cg_foreign  :: !ForeignStubs,	
-	cg_home_mods :: !HomeModules,	-- for calling isHomeModule etc.
-	cg_dep_pkgs :: ![PackageId]	-- Used to generate #includes for C code gen
-    }
-
------------------------------------
-data ModImports
-  = ModImports {
-	imp_direct     :: ![(Module,Bool)],	-- Explicitly-imported modules
-						-- Boolean is true if we imported the whole
-						--	module (apart, perhaps, from hiding some)
-	imp_pkg_mods   :: !ModuleSet,		-- Non-home-package modules on which we depend,
-						--	directly or indirectly
-	imp_home_names :: !NameSet		-- Home package things on which we depend,
-						--	directly or indirectly
-    }
-
------------------------------------
-data ForeignStubs = NoStubs
-		  | ForeignStubs
-			SDoc 		-- Header file prototypes for
-                                      	-- 	"foreign exported" functions
-			SDoc 		-- C stubs to use when calling
-                                        -- 	"foreign exported" functions
-			[FastString] 	-- Headers that need to be included
-				        -- 	into C code generated for this module
-			[Id]		-- Foreign-exported binders
-					-- 	we have to generate code to register these
-
-\end{code}
-
-\begin{code}
-emptyModIface :: PackageIdH -> Module -> ModIface
-emptyModIface pkg mod
-  = ModIface { mi_package  = pkg,
-	       mi_module   = mod,
-	       mi_mod_vers = initialVersion,
-	       mi_orphan   = False,
-	       mi_boot	   = False,
-	       mi_deps     = noDependencies,
-	       mi_usages   = [],
-	       mi_exports  = [],
-	       mi_exp_vers = initialVersion,
-	       mi_fixities = [],
-	       mi_deprecs  = NoDeprecs,
-	       mi_insts = [],
-	       mi_rules = [],
-	       mi_decls = [],
-	       mi_globals  = Nothing,
-	       mi_rule_vers = initialVersion,
-	       mi_dep_fn = emptyIfaceDepCache,
-	       mi_fix_fn = emptyIfaceFixCache,
-	       mi_ver_fn = emptyIfaceVerCache
-    }		
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The interactive context}
-%*									*
-%************************************************************************
-
-\begin{code}
-data InteractiveContext 
-  = InteractiveContext { 
-	ic_toplev_scope :: [Module],	-- Include the "top-level" scope of
-					-- these modules
-
-	ic_exports :: [Module],		-- Include just the exports of these
-					-- modules
-
-	ic_rn_gbl_env :: GlobalRdrEnv,	-- The cached GlobalRdrEnv, built from
-					-- ic_toplev_scope and ic_exports
-
-	ic_rn_local_env :: LocalRdrEnv,	-- Lexical context for variables bound
-					-- during interaction
-
-	ic_type_env :: TypeEnv		-- Ditto for types
-    }
-
-emptyInteractiveContext
-  = InteractiveContext { ic_toplev_scope = [],
-			 ic_exports = [],
-			 ic_rn_gbl_env = emptyGlobalRdrEnv,
-			 ic_rn_local_env = emptyLocalRdrEnv,
-			 ic_type_env = emptyTypeEnv }
-
-icPrintUnqual :: InteractiveContext -> PrintUnqualified
-icPrintUnqual ictxt = unQualInScope (ic_rn_gbl_env ictxt)
-\end{code}
-
-@unQualInScope@ returns a function that takes a @Name@ and tells whether
-its unqualified name is in scope.  This is put as a boolean flag in
-the @Name@'s provenance to guide whether or not to print the name qualified
-in error messages.
-
-\begin{code}
-unQualInScope :: GlobalRdrEnv -> PrintUnqualified
--- True if 'f' is in scope, and has only one binding,
--- and the thing it is bound to is the name we are looking for
--- (i.e. false if A.f and B.f are both in scope as unqualified 'f')
---
--- [Out of date] Also checks for built-in syntax, which is always 'in scope'
-unQualInScope env mod occ
-  = case lookupGRE_RdrName (mkRdrUnqual occ) env of
-	[gre] -> nameModule (gre_name gre) == mod
-	other -> False
-\end{code}
-
-
-%************************************************************************
-%*									*
-		TyThing
-%*									*
-%************************************************************************
-
-\begin{code}
-implicitTyThings :: TyThing -> [TyThing]
-implicitTyThings (AnId id)   = []
-
-	-- For type constructors, add the data cons (and their extras),
-	-- and the selectors and generic-programming Ids too
-	--
-	-- Newtypes don't have a worker Id, so don't generate that?
-implicitTyThings (ATyCon tc) = map AnId (tyConSelIds tc) ++ 
-			       concatMap (extras_plus . ADataCon) (tyConDataCons tc)
-		     
-	-- For classes, add the class TyCon too (and its extras)
-	-- and the class selector Ids
-implicitTyThings (AClass cl) = map AnId (classSelIds cl) ++
-			       extras_plus (ATyCon (classTyCon cl))
-			 
-
-	-- For data cons add the worker and wrapper (if any)
-implicitTyThings (ADataCon dc) = map AnId (dataConImplicitIds dc)
-
-extras_plus thing = thing : implicitTyThings thing
-
-extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
-extendTypeEnvWithIds env ids
-  = extendNameEnvList env [(getName id, AnId id) | id <- ids]
-\end{code}
-
-%************************************************************************
-%*									*
-		TypeEnv
-%*									*
-%************************************************************************
-
-\begin{code}
-type TypeEnv = NameEnv TyThing
-
-emptyTypeEnv   :: TypeEnv
-typeEnvElts    :: TypeEnv -> [TyThing]
-typeEnvClasses :: TypeEnv -> [Class]
-typeEnvTyCons  :: TypeEnv -> [TyCon]
-typeEnvIds     :: TypeEnv -> [Id]
-lookupTypeEnv  :: TypeEnv -> Name -> Maybe TyThing
-
-emptyTypeEnv 	   = emptyNameEnv
-typeEnvElts    env = nameEnvElts env
-typeEnvClasses env = [cl | AClass cl <- typeEnvElts env]
-typeEnvTyCons  env = [tc | ATyCon tc <- typeEnvElts env] 
-typeEnvIds     env = [id | AnId id   <- typeEnvElts env] 
-
-mkTypeEnv :: [TyThing] -> TypeEnv
-mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
-		
-lookupTypeEnv = lookupNameEnv
-
--- Extend the type environment
-extendTypeEnv :: TypeEnv -> TyThing -> TypeEnv
-extendTypeEnv env thing = extendNameEnv env (getName thing) thing 
-
-extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
-extendTypeEnvList env things = foldl extendTypeEnv env things
-\end{code}
-
-\begin{code}
-lookupType :: HomePackageTable -> PackageTypeEnv -> Name -> Maybe TyThing
-lookupType hpt pte name
-  = case lookupModuleEnv hpt (nameModule name) of
-	Just details -> lookupNameEnv (md_types (hm_details details)) name
-	Nothing	     -> lookupNameEnv pte name
-\end{code}
-
-
-\begin{code}
-tyThingTyCon (ATyCon tc) = tc
-tyThingTyCon other	 = pprPanic "tyThingTyCon" (ppr other)
-
-tyThingClass (AClass cls) = cls
-tyThingClass other	  = pprPanic "tyThingClass" (ppr other)
-
-tyThingDataCon (ADataCon dc) = dc
-tyThingDataCon other	     = pprPanic "tyThingDataCon" (ppr other)
-
-tyThingId (AnId id) = id
-tyThingId other     = pprPanic "tyThingId" (ppr other)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Auxiliary types}
-%*									*
-%************************************************************************
-
-These types are defined here because they are mentioned in ModDetails,
-but they are mostly elaborated elsewhere
-
-\begin{code}
-mkIfaceVerCache :: [(Version,IfaceDecl)] -> OccName -> Maybe Version
-mkIfaceVerCache pairs 
-  = \occ -> lookupOccEnv env occ
-  where
-    env = foldl add emptyOccEnv pairs
-    add env (v,d) = extendOccEnv env (ifName d) v
-
-emptyIfaceVerCache :: OccName -> Maybe Version
-emptyIfaceVerCache occ = Nothing
-
------------------- Deprecations -------------------------
-data Deprecs a
-  = NoDeprecs
-  | DeprecAll DeprecTxt	-- Whole module deprecated
-  | DeprecSome a	-- Some specific things deprecated
-  deriving( Eq )
-
-type IfaceDeprecs = Deprecs [(OccName,DeprecTxt)]
-type Deprecations = Deprecs (NameEnv (OccName,DeprecTxt))
-	-- Keep the OccName so we can flatten the NameEnv to
-	-- get an IfaceDeprecs from a Deprecations
-	-- Only an OccName is needed, because a deprecation always
-	-- applies to things defined in the module in which the
-	-- deprecation appears.
-
-mkIfaceDepCache:: IfaceDeprecs -> Name -> Maybe DeprecTxt
-mkIfaceDepCache NoDeprecs     	  = \n -> Nothing
-mkIfaceDepCache (DeprecAll t) 	  = \n -> Just t
-mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
-
-emptyIfaceDepCache :: Name -> Maybe DeprecTxt
-emptyIfaceDepCache n = Nothing
-
-lookupDeprec :: Deprecations -> Name -> Maybe DeprecTxt
-lookupDeprec NoDeprecs        name = Nothing
-lookupDeprec (DeprecAll  txt) name = Just txt
-lookupDeprec (DeprecSome env) name = case lookupNameEnv env name of
-					    Just (_, txt) -> Just txt
-					    Nothing	  -> Nothing
-
-plusDeprecs :: Deprecations -> Deprecations -> Deprecations
-plusDeprecs d NoDeprecs = d
-plusDeprecs NoDeprecs d = d
-plusDeprecs d (DeprecAll t) = DeprecAll t
-plusDeprecs (DeprecAll t) d = DeprecAll t
-plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 `plusNameEnv` v2)
-\end{code}
-
-
-\begin{code}
-type Avails	  = [AvailInfo]
-type AvailInfo    = GenAvailInfo Name
-type RdrAvailInfo = GenAvailInfo OccName
-
-data GenAvailInfo name	= Avail name	 -- An ordinary identifier
-			| AvailTC name 	 -- The name of the type or class
-				  [name] -- The available pieces of type/class.
-					 -- NB: If the type or class is itself
-					 -- to be in scope, it must be in this list.
-					 -- Thus, typically: AvailTC Eq [Eq, ==, /=]
-			deriving( Eq )
-			-- Equality used when deciding if the interface has changed
-
-type IfaceExport = (Module, [GenAvailInfo OccName])
-
-availsToNameSet :: [AvailInfo] -> NameSet
-availsToNameSet avails = foldl add emptyNameSet avails
-		       where
-			 add set avail = addListToNameSet set (availNames avail)
-
-availName :: GenAvailInfo name -> name
-availName (Avail n)     = n
-availName (AvailTC n _) = n
-
-availNames :: GenAvailInfo name -> [name]
-availNames (Avail n)      = [n]
-availNames (AvailTC n ns) = ns
-
-instance Outputable n => Outputable (GenAvailInfo n) where
-   ppr = pprAvail
-
-pprAvail :: Outputable n => GenAvailInfo n -> SDoc
-pprAvail (AvailTC n ns) = ppr n <> case {- filter (/= n) -} ns of
-					[]  -> empty
-					ns' -> braces (hsep (punctuate comma (map ppr ns')))
-
-pprAvail (Avail n) = ppr n
-\end{code}
-
-\begin{code}
-mkIfaceFixCache :: [(OccName, Fixity)] -> OccName -> Fixity
-mkIfaceFixCache pairs 
-  = \n -> lookupOccEnv env n `orElse` defaultFixity
-  where
-   env = mkOccEnv pairs
-
-emptyIfaceFixCache :: OccName -> Fixity
-emptyIfaceFixCache n = defaultFixity
-
--- This fixity environment is for source code only
-type FixityEnv = NameEnv FixItem
-
--- We keep the OccName in the range so that we can generate an interface from it
-data FixItem = FixItem OccName Fixity SrcSpan
-
-instance Outputable FixItem where
-  ppr (FixItem occ fix loc) = ppr fix <+> ppr occ <+> parens (ppr loc)
-
-emptyFixityEnv :: FixityEnv
-emptyFixityEnv = emptyNameEnv
-
-lookupFixity :: FixityEnv -> Name -> Fixity
-lookupFixity env n = case lookupNameEnv env n of
-			Just (FixItem _ fix _) -> fix
-			Nothing	      	       -> defaultFixity
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{WhatsImported}
-%*									*
-%************************************************************************
-
-\begin{code}
-type WhetherHasOrphans   = Bool
-	-- An "orphan" is 
-	-- 	* an instance decl in a module other than the defn module for 
-	--		one of the tycons or classes in the instance head
-	--	* a transformation rule in a module other than the one defining
-	--		the function in the head of the rule.
-
-type IsBootInterface = Bool
-
--- Dependency info about modules and packages below this one
--- in the import hierarchy.  See TcRnTypes.ImportAvails for details.
---
--- Invariant: the dependencies of a module M never includes M
--- Invariant: the lists are unordered, with no duplicates
-data Dependencies
-  = Deps { dep_mods  :: [(Module,IsBootInterface)],	-- Home-package module dependencies
-	   dep_pkgs  :: [PackageId], 			-- External package dependencies
-	   dep_orphs :: [Module] }			-- Orphan modules (whether home or external pkg)
-  deriving( Eq )
-	-- Equality used only for old/new comparison in MkIface.addVersionInfo
-
-noDependencies :: Dependencies
-noDependencies = Deps [] [] []
- 	  
-data Usage
-  = Usage { usg_name     :: Module,			-- Name of the module
-	    usg_mod      :: Version,			-- Module version
-	    usg_entities :: [(OccName,Version)],	-- Sorted by occurrence name
-	    usg_exports  :: Maybe Version,		-- Export-list version, if we depend on it
-	    usg_rules    :: Version 			-- Orphan-rules version (for non-orphan
-							-- modules this will always be initialVersion)
-    }	    deriving( Eq )
-	-- This type doesn't let you say "I imported f but none of the rules in
-	-- the module". If you use anything in the module you get its rule version
-	-- So if the rules change, you'll recompile, even if you don't use them.
-	-- This is easy to implement, and it's safer: you might not have used the rules last
-	-- time round, but if someone has added a new rule you might need it this time
-
-	-- The export list field is (Just v) if we depend on the export list:
-	--	i.e. we imported the module directly, whether or not we
-	--	     enumerated the things we imported, or just imported everything
-	-- We need to recompile if M's exports change, because 
-	-- if the import was	import M, 	we might now have a name clash in the 
-	--					importing module.
-	-- if the import was	import M(x)	M might no longer export x
-	-- The only way we don't depend on the export list is if we have
-	--			import M()
-	-- And of course, for modules that aren't imported directly we don't
-	-- depend on their export lists
-\end{code}
-
-
-%************************************************************************
-%*									*
-		The External Package State
-%*									*
-%************************************************************************
-
-\begin{code}
-type PackageTypeEnv  = TypeEnv
-type PackageRuleBase = RuleBase
-type PackageInstEnv  = InstEnv
-
-data ExternalPackageState
-  = EPS {
-	eps_is_boot :: !(ModuleEnv (Module, IsBootInterface)),
-		-- In OneShot mode (only), home-package modules accumulate in the
-		-- external package state, and are sucked in lazily.
-		-- For these home-pkg modules (only) we need to record which are
-		-- boot modules.  We set this field after loading all the 
-		-- explicitly-imported interfaces, but before doing anything else
-		--
-		-- The Module part is not necessary, but it's useful for
-		-- debug prints, and it's convenient because this field comes
-		-- direct from TcRnTypes.ImportAvails.imp_dep_mods
-
-	eps_PIT :: !PackageIfaceTable,
-		-- The ModuleIFaces for modules in external packages
-		-- whose interfaces we have opened
-		-- The declarations in these interface files are held in
-		-- eps_decls, eps_inst_env, eps_rules (below), not in the 
-		-- mi_decls fields of the iPIT.  
-		-- What _is_ in the iPIT is:
-		--	* The Module 
-		--	* Version info
-		--	* Its exports
-		--	* Fixities
-		--	* Deprecations
-
-	eps_PTE :: !PackageTypeEnv,		-- Domain = external-package modules
-
-	eps_inst_env :: !PackageInstEnv,	-- The total InstEnv accumulated from
-						--   all the external-package modules
-	eps_rule_base :: !PackageRuleBase,	-- Ditto RuleEnv
-
-	eps_stats :: !EpsStats
-  }
-
--- "In" means read from iface files
--- "Out" means actually sucked in and type-checked
-data EpsStats = EpsStats { n_ifaces_in
-			 , n_decls_in, n_decls_out 
-			 , n_rules_in, n_rules_out
-			 , n_insts_in, n_insts_out :: !Int }
-
-addEpsInStats :: EpsStats -> Int -> Int -> Int -> EpsStats
--- Add stats for one newly-read interface
-addEpsInStats stats n_decls n_insts n_rules
-  = stats { n_ifaces_in = n_ifaces_in stats + 1
-	  , n_decls_in  = n_decls_in stats + n_decls
-	  , n_insts_in  = n_insts_in stats + n_insts
-	  , n_rules_in  = n_rules_in stats + n_rules }
-\end{code}
-
-The NameCache makes sure that there is just one Unique assigned for
-each original name; i.e. (module-name, occ-name) pair.  The Name is
-always stored as a Global, and has the SrcLoc of its binding location.
-Actually that's not quite right.  When we first encounter the original
-name, we might not be at its binding site (e.g. we are reading an
-interface file); so we give it 'noSrcLoc' then.  Later, when we find
-its binding site, we fix it up.
-
-\begin{code}
-data NameCache
- = NameCache {  nsUniqs :: UniqSupply,
-		-- Supply of uniques
-		nsNames :: OrigNameCache,
-		-- Ensures that one original name gets one unique
-		nsIPs   :: OrigIParamCache
-		-- Ensures that one implicit parameter name gets one unique
-   }
-
-type OrigNameCache   = ModuleEnv (OccEnv Name)
-type OrigIParamCache = FiniteMap (IPName OccName) (IPName Name)
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-		The module graph and ModSummary type
-	A ModSummary is a node in the compilation manager's
-	dependency graph, and it's also passed to hscMain
-%*									*
-%************************************************************************
-
-A ModuleGraph contains all the nodes from the home package (only).  
-There will be a node for each source module, plus a node for each hi-boot
-module.
-
-\begin{code}
-type ModuleGraph = [ModSummary]  -- The module graph, 
-				 -- NOT NECESSARILY IN TOPOLOGICAL ORDER
-
-emptyMG :: ModuleGraph
-emptyMG = []
-
--- The nodes of the module graph are
--- 	EITHER a regular Haskell source module
--- 	OR     a hi-boot source module
-
-data ModSummary
-   = ModSummary {
-        ms_mod       :: Module,			-- Name of the module
-	ms_hsc_src   :: HscSource,		-- Source is Haskell, hs-boot, external core
-        ms_location  :: ModLocation,		-- Location
-        ms_hs_date   :: ClockTime,		-- Timestamp of source file
-	ms_obj_date  :: Maybe ClockTime,	-- Timestamp of object, maybe
-        ms_srcimps   :: [Located Module],	-- Source imports
-        ms_imps      :: [Located Module],	-- Non-source imports
-        ms_hspp_file :: FilePath,		-- Filename of preprocessed source.
-        ms_hspp_opts :: DynFlags,               -- Cached flags from OPTIONS, INCLUDE
-                                                -- and LANGUAGE pragmas.
-	ms_hspp_buf  :: Maybe StringBuffer    	-- The actual preprocessed source, maybe.
-     }
-
--- The ModLocation contains both the original source filename and the
--- filename of the cleaned-up source file after all preprocessing has been
--- done.  The point is that the summariser will have to cpp/unlit/whatever
--- all files anyway, and there's no point in doing this twice -- just 
--- park the result in a temp file, put the name of it in the location,
--- and let @compile@ read from that file on the way back up.
-
--- The ModLocation is stable over successive up-sweeps in GHCi, wheres
--- the ms_hs_date and imports can, of course, change
-
-msHsFilePath, msHiFilePath, msObjFilePath :: ModSummary -> FilePath
-msHsFilePath  ms = expectJust "msHsFilePath" (ml_hs_file  (ms_location ms))
-msHiFilePath  ms = ml_hi_file  (ms_location ms)
-msObjFilePath ms = ml_obj_file (ms_location ms)
-
-isBootSummary :: ModSummary -> Bool
-isBootSummary ms = isHsBoot (ms_hsc_src ms)
-
-instance Outputable ModSummary where
-   ppr ms
-      = sep [text "ModSummary {",
-             nest 3 (sep [text "ms_hs_date = " <> text (show (ms_hs_date ms)),
-                          text "ms_mod =" <+> ppr (ms_mod ms) 
-				<> text (hscSourceString (ms_hsc_src ms)) <> comma,
-                          text "ms_imps =" <+> ppr (ms_imps ms),
-                          text "ms_srcimps =" <+> ppr (ms_srcimps ms)]),
-             char '}'
-            ]
-
-showModMsg :: HscTarget -> Bool -> ModSummary -> String
-showModMsg target recomp mod_summary
-  = showSDoc (hsep [text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' '),
-	            char '(', text (msHsFilePath mod_summary) <> comma,
-		    case target of
-                      HscInterpreted | recomp
-                                 -> text "interpreted"
-                      HscNothing -> text "nothing"
-                      _other     -> text (msObjFilePath mod_summary),
-		    char ')'])
- where 
-    mod     = ms_mod mod_summary 
-    mod_str = moduleString mod ++ hscSourceString (ms_hsc_src mod_summary)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Linkable stuff}
-%*									*
-%************************************************************************
-
-This stuff is in here, rather than (say) in Linker.lhs, because the Linker.lhs
-stuff is the *dynamic* linker, and isn't present in a stage-1 compiler
-
-\begin{code}
-data Linkable = LM {
-  linkableTime     :: ClockTime,	-- Time at which this linkable was built
-					-- (i.e. when the bytecodes were produced,
-					--	 or the mod date on the files)
-  linkableModule   :: Module,		-- Should be Module, but see below
-  linkableUnlinked :: [Unlinked]
- }
-
-isObjectLinkable :: Linkable -> Bool
-isObjectLinkable l = not (null unlinked) && all isObject unlinked
-  where unlinked = linkableUnlinked l
-	-- A linkable with no Unlinked's is treated as a BCO.  We can
-	-- generate a linkable with no Unlinked's as a result of
-	-- compiling a module in HscNothing mode, and this choice
-	-- happens to work well with checkStability in module GHC.
-
-instance Outputable Linkable where
-   ppr (LM when_made mod unlinkeds)
-      = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)
-        $$ nest 3 (ppr unlinkeds)
-
--------------------------------------------
-data Unlinked
-   = DotO FilePath
-   | DotA FilePath
-   | DotDLL FilePath
-   | BCOs CompiledByteCode
-
-#ifndef GHCI
-data CompiledByteCode = NoByteCode
-#endif
-
-instance Outputable Unlinked where
-   ppr (DotO path)   = text "DotO" <+> text path
-   ppr (DotA path)   = text "DotA" <+> text path
-   ppr (DotDLL path) = text "DotDLL" <+> text path
-#ifdef GHCI
-   ppr (BCOs bcos)   = text "BCOs" <+> ppr bcos
-#else
-   ppr (BCOs bcos)   = text "No byte code"
-#endif
-
-isObject (DotO _)   = True
-isObject (DotA _)   = True
-isObject (DotDLL _) = True
-isObject _          = False
-
-isInterpretable = not . isObject
-
-nameOfObject (DotO fn)   = fn
-nameOfObject (DotA fn)   = fn
-nameOfObject (DotDLL fn) = fn
-
-byteCodeOfObject (BCOs bc) = bc
-\end{code}
-
-
-
diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
deleted file mode 100644
index ec5a116894..0000000000
--- a/ghc/compiler/main/Main.hs
+++ /dev/null
@@ -1,476 +0,0 @@
-{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
------------------------------------------------------------------------------
---
--- GHC Driver program
---
--- (c) The University of Glasgow 2005
---
------------------------------------------------------------------------------
-
-module Main (main) where
-
-#include "HsVersions.h"
-
--- The official GHC API
-import qualified GHC
-import GHC		( Session, DynFlags(..), GhcMode(..), HscTarget(..),
-			  LoadHowMuch(..), dopt, DynFlag(..) )
-import CmdLineParser
-
--- Implementations of the various modes (--show-iface, mkdependHS. etc.)
-import MkIface		( showIface )
-import DriverPipeline	( oneShot, compileFile )
-import DriverMkDepend	( doMkDependHS )
-import SysTools		( getTopDir, getUsageMsgPaths )
-#ifdef GHCI
-import InteractiveUI	( ghciWelcomeMsg, interactiveUI )
-#endif
-
--- Various other random stuff that we need
-import Config		( cProjectVersion, cBooterVersion, cProjectName )
-import Packages		( dumpPackages, initPackages )
-import DriverPhases	( Phase(..), isSourceFilename, anyHsc,
-			  startPhase, isHaskellSrcFilename )
-import StaticFlags	( staticFlags, v_Ld_inputs, parseStaticFlags )
-import DynFlags         ( defaultDynFlags )
-import BasicTypes	( failed )
-import ErrUtils		( Message, debugTraceMsg, putMsg )
-import FastString	( getFastStringTable, isZEncoded, hasZEncoding )
-import Outputable
-import Util
-import Panic
-
--- Standard Haskell libraries
-import EXCEPTION	( throwDyn )
-import IO
-import Directory	( doesDirectoryExist )
-import System		( getArgs, exitWith, ExitCode(..) )
-import Monad
-import List
-import Maybe
-
------------------------------------------------------------------------------
--- ToDo:
-
--- time commands when run with -v
--- user ways
--- Win32 support: proper signal handling
--- reading the package configuration file is too slow
--- -K<size>
-
------------------------------------------------------------------------------
--- GHC's command-line interface
-
-main =
-  GHC.defaultErrorHandler defaultDynFlags $ do
-  
-  argv0 <- getArgs
-  argv1 <- parseStaticFlags =<< GHC.initFromArgs argv0
-
-  -- 2. Parse the "mode" flags (--make, --interactive etc.)
-  (cli_mode, argv2) <- parseModeFlags argv1
-
-  let mode = case cli_mode of
-		DoInteractive	-> Interactive
-		DoEval _	-> Interactive
-		DoMake		-> BatchCompile
-		DoMkDependHS	-> MkDepend
-		_		-> OneShot
-
-  -- start our GHC session
-  session <- GHC.newSession mode
-
-  dflags0 <- GHC.getSessionDynFlags session
-
-  -- set the default HscTarget.  The HscTarget can be further
-  -- adjusted on a module by module basis, using only the -fvia-C and
-  -- -fasm flags.  If the default HscTarget is not HscC or HscAsm,
-  -- -fvia-C and -fasm have no effect.
-  let lang = case cli_mode of 
-		 DoInteractive  -> HscInterpreted
-		 DoEval _	-> HscInterpreted
-		 _other		-> hscTarget dflags0
-
-  let dflags1 = dflags0{ ghcMode = mode,
-                  	 hscTarget  = lang,
-			 -- leave out hscOutName for now
-	                 hscOutName = panic "Main.main:hscOutName not set",
-		  	 verbosity = case cli_mode of
-				 	 DoEval _ -> 0
-				 	 _other   -> 1
-			}
-
-	-- The rest of the arguments are "dynamic"
-	-- Leftover ones are presumably files
-  (dflags2, fileish_args) <- GHC.parseDynamicFlags dflags1 argv2
-
-	-- make sure we clean up after ourselves
-  GHC.defaultCleanupHandler dflags2 $ do
-
-	-- Display banner
-  showBanner cli_mode dflags2
-
-	-- Read the package config(s), and process the package-related
-	-- command-line flags
-  dflags <- initPackages dflags2
-
-  -- we've finished manipulating the DynFlags, update the session
-  GHC.setSessionDynFlags session dflags
-
-  let
-     -- To simplify the handling of filepaths, we normalise all filepaths right 
-     -- away - e.g., for win32 platforms, backslashes are converted
-     -- into forward slashes.
-    normal_fileish_paths = map normalisePath fileish_args
-    (srcs, objs)         = partition_args normal_fileish_paths [] []
-
-  -- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on 
-  --       the command-line.
-  mapM_ (consIORef v_Ld_inputs) (reverse objs)
-
-	---------------- Display configuration -----------
-  when (verbosity dflags >= 4) $
-	dumpPackages dflags
-
-  when (verbosity dflags >= 3) $ do
-	hPutStrLn stderr ("Hsc static flags: " ++ unwords staticFlags)
-
-	---------------- Final sanity checking -----------
-  checkOptions cli_mode dflags srcs objs
-
-	---------------- Do the business -----------
-  case cli_mode of
-	ShowUsage       -> showGhcUsage cli_mode
-	PrintLibdir     -> do d <- getTopDir; putStrLn d
-	ShowVersion     -> showVersion
-        ShowNumVersion  -> putStrLn cProjectVersion
-        ShowInterface f -> showIface f
-	DoMake 	        -> doMake session srcs
-	DoMkDependHS    -> doMkDependHS session (map fst srcs)
-	StopBefore p    -> oneShot dflags p srcs
-	DoInteractive   -> interactiveUI session srcs Nothing
-	DoEval expr     -> interactiveUI session srcs (Just expr)
-
-  dumpFinalStats dflags
-  exitWith ExitSuccess
-
-#ifndef GHCI
-interactiveUI _ _ _ = 
-  throwDyn (CmdLineError "not built for interactive use")
-#endif
-
--- -----------------------------------------------------------------------------
--- Splitting arguments into source files and object files.  This is where we
--- interpret the -x <suffix> option, and attach a (Maybe Phase) to each source
--- file indicating the phase specified by the -x option in force, if any.
-
-partition_args [] srcs objs = (reverse srcs, reverse objs)
-partition_args ("-x":suff:args) srcs objs
-  | "none" <- suff	= partition_args args srcs objs
-  | StopLn <- phase	= partition_args args srcs (slurp ++ objs)
-  | otherwise		= partition_args rest (these_srcs ++ srcs) objs
-	where phase = startPhase suff
-	      (slurp,rest) = break (== "-x") args 
-	      these_srcs = zip slurp (repeat (Just phase))
-partition_args (arg:args) srcs objs
-  | looks_like_an_input arg = partition_args args ((arg,Nothing):srcs) objs
-  | otherwise               = partition_args args srcs (arg:objs)
-
-    {-
-      We split out the object files (.o, .dll) and add them
-      to v_Ld_inputs for use by the linker.
-
-      The following things should be considered compilation manager inputs:
-
-       - haskell source files (strings ending in .hs, .lhs or other 
-         haskellish extension),
-
-       - module names (not forgetting hierarchical module names),
-
-       - and finally we consider everything not containing a '.' to be
-         a comp manager input, as shorthand for a .hs or .lhs filename.
-
-      Everything else is considered to be a linker object, and passed
-      straight through to the linker.
-    -}
-looks_like_an_input m =  isSourceFilename m 
-		      || looksLikeModuleName m
-		      || '.' `notElem` m
-
--- -----------------------------------------------------------------------------
--- Option sanity checks
-
-checkOptions :: CmdLineMode -> DynFlags -> [(String,Maybe Phase)] -> [String] -> IO ()
-     -- Final sanity checking before kicking off a compilation (pipeline).
-checkOptions cli_mode dflags srcs objs = do
-     -- Complain about any unknown flags
-   let unknown_opts = [ f | (f@('-':_), _) <- srcs ]
-   when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
-
-	-- -prof and --interactive are not a good combination
-   when (notNull (wayNames dflags)  && isInterpretiveMode cli_mode) $
-      do throwDyn (UsageError 
-                   "--interactive can't be used with -prof, -ticky, -unreg or -smp.")
-	-- -ohi sanity check
-   if (isJust (outputHi dflags) && 
-      (isCompManagerMode cli_mode || srcs `lengthExceeds` 1))
-	then throwDyn (UsageError "-ohi can only be used when compiling a single source file")
-	else do
-
-	-- -o sanity checking
-   if (srcs `lengthExceeds` 1 && isJust (outputFile dflags)
-	 && not (isLinkMode cli_mode))
-	then throwDyn (UsageError "can't apply -o to multiple source files")
-	else do
-
-	-- Check that there are some input files
-	-- (except in the interactive case)
-   if null srcs && null objs && needsInputsMode cli_mode
-	then throwDyn (UsageError "no input files")
-	else do
-
-     -- Verify that output files point somewhere sensible.
-   verifyOutputFiles dflags
-
-
--- Compiler output options
-
--- called to verify that the output files & directories
--- point somewhere valid. 
---
--- The assumption is that the directory portion of these output
--- options will have to exist by the time 'verifyOutputFiles'
--- is invoked.
--- 
-verifyOutputFiles :: DynFlags -> IO ()
-verifyOutputFiles dflags = do
-  let odir = objectDir dflags
-  when (isJust odir) $ do
-     let dir = fromJust odir
-     flg <- doesDirectoryExist dir
-     when (not flg) (nonExistentDir "-odir" dir)
-  let ofile = outputFile dflags
-  when (isJust ofile) $ do
-     let fn = fromJust ofile
-     flg <- doesDirNameExist fn
-     when (not flg) (nonExistentDir "-o" fn)
-  let ohi = outputHi dflags
-  when (isJust ohi) $ do
-     let hi = fromJust ohi
-     flg <- doesDirNameExist hi
-     when (not flg) (nonExistentDir "-ohi" hi)
- where
-   nonExistentDir flg dir = 
-     throwDyn (CmdLineError ("error: directory portion of " ++ 
-                             show dir ++ " does not exist (used with " ++ 
-			     show flg ++ " option.)"))
-
------------------------------------------------------------------------------
--- GHC modes of operation
-
-data CmdLineMode
-  = ShowUsage			-- ghc -?
-  | PrintLibdir			-- ghc --print-libdir
-  | ShowVersion			-- ghc -V/--version
-  | ShowNumVersion		-- ghc --numeric-version
-  | ShowInterface String	-- ghc --show-iface
-  | DoMkDependHS		-- ghc -M
-  | StopBefore Phase		-- ghc -E | -C | -S
-				-- StopBefore StopLn is the default
-  | DoMake			-- ghc --make
-  | DoInteractive		-- ghc --interactive
-  | DoEval String		-- ghc -e
-  deriving (Show)
-
-isInteractiveMode, isInterpretiveMode     :: CmdLineMode -> Bool
-isLinkMode, isCompManagerMode :: CmdLineMode -> Bool
-
-isInteractiveMode DoInteractive = True
-isInteractiveMode _		= False
-
--- isInterpretiveMode: byte-code compiler involved
-isInterpretiveMode DoInteractive = True
-isInterpretiveMode (DoEval _)    = True
-isInterpretiveMode _             = False
-
-needsInputsMode DoMkDependHS	= True
-needsInputsMode (StopBefore _)	= True
-needsInputsMode DoMake		= True
-needsInputsMode _		= False
-
--- True if we are going to attempt to link in this mode.
--- (we might not actually link, depending on the GhcLink flag)
-isLinkMode (StopBefore StopLn) = True
-isLinkMode DoMake	       = True
-isLinkMode _   		       = False
-
-isCompManagerMode DoMake        = True
-isCompManagerMode DoInteractive = True
-isCompManagerMode (DoEval _)    = True
-isCompManagerMode _             = False
-
-
--- -----------------------------------------------------------------------------
--- Parsing the mode flag
-
-parseModeFlags :: [String] -> IO (CmdLineMode, [String])
-parseModeFlags args = do
-  let ((leftover, errs), (mode, _, flags)) = 
-	 runCmdLine (processArgs mode_flags args) (StopBefore StopLn, "", []) 
-  when (not (null errs)) $ do
-    throwDyn (UsageError (unlines errs))
-  return (mode, flags ++ leftover)
-
-type ModeM a = CmdLineP (CmdLineMode, String, [String]) a
-  -- mode flags sometimes give rise to new DynFlags (eg. -C, see below)
-  -- so we collect the new ones and return them.
-
-mode_flags :: [(String, OptKind (CmdLineP (CmdLineMode, String, [String])))]
-mode_flags =
-  [  ------- help / version ----------------------------------------------
-     ( "?"    		 , PassFlag (setMode ShowUsage))
-  ,  ( "-help"	 	 , PassFlag (setMode ShowUsage))
-  ,  ( "-print-libdir"   , PassFlag (setMode PrintLibdir))
-  ,  ( "V"	 	 , PassFlag (setMode ShowVersion))
-  ,  ( "-version"	 , PassFlag (setMode ShowVersion))
-  ,  ( "-numeric-version", PassFlag (setMode ShowNumVersion))
-
-      ------- interfaces ----------------------------------------------------
-  ,  ( "-show-iface"     , HasArg (\f -> setMode (ShowInterface f)
-					  "--show-iface"))
-
-      ------- primary modes ------------------------------------------------
-  ,  ( "M"		, PassFlag (setMode DoMkDependHS))
-  ,  ( "E"		, PassFlag (setMode (StopBefore anyHsc)))
-  ,  ( "C"		, PassFlag (\f -> do setMode (StopBefore HCc) f
-					     addFlag "-fvia-C"))
-  ,  ( "S"		, PassFlag (setMode (StopBefore As)))
-  ,  ( "-make"		, PassFlag (setMode DoMake))
-  ,  ( "-interactive"	, PassFlag (setMode DoInteractive))
-  ,  ( "e"              , HasArg   (\s -> setMode (DoEval s) "-e"))
-
-	-- -fno-code says to stop after Hsc but don't generate any code.
-  ,  ( "fno-code"	, PassFlag (\f -> do setMode (StopBefore HCc) f
-					     addFlag "-fno-code"
-					     addFlag "-no-recomp"))
-  ]
-
-setMode :: CmdLineMode -> String -> ModeM ()
-setMode m flag = do
-  (old_mode, old_flag, flags) <- getCmdLineState
-  when (notNull old_flag && flag /= old_flag) $
-      throwDyn (UsageError 
-          ("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'"))
-  putCmdLineState (m, flag, flags)
-
-addFlag :: String -> ModeM ()
-addFlag s = do
-  (m, f, flags) <- getCmdLineState
-  putCmdLineState (m, f, s:flags)
-
-
--- ----------------------------------------------------------------------------
--- Run --make mode
-
-doMake :: Session -> [(String,Maybe Phase)] -> IO ()
-doMake sess []    = throwDyn (UsageError "no input files")
-doMake sess srcs  = do 
-    let (hs_srcs, non_hs_srcs) = partition haskellish srcs
-
-	haskellish (f,Nothing) = 
-	  looksLikeModuleName f || isHaskellSrcFilename f || '.' `notElem` f
-	haskellish (f,Just phase) = 
-	  phase `notElem` [As, Cc, CmmCpp, Cmm, StopLn]
-
-    dflags <- GHC.getSessionDynFlags sess
-    o_files <- mapM (compileFile dflags StopLn) non_hs_srcs
-    mapM_ (consIORef v_Ld_inputs) (reverse o_files)
-
-    targets <- mapM (uncurry GHC.guessTarget) hs_srcs
-    GHC.setTargets sess targets
-    ok_flag <- GHC.load sess LoadAllTargets
-    when (failed ok_flag) (exitWith (ExitFailure 1))
-    return ()
-
--- ---------------------------------------------------------------------------
--- Various banners and verbosity output.
-
-showBanner :: CmdLineMode -> DynFlags -> IO ()
-showBanner cli_mode dflags = do
-   let verb = verbosity dflags
-	-- Show the GHCi banner
-#  ifdef GHCI
-   when (isInteractiveMode cli_mode && verb >= 1) $
-      hPutStrLn stdout ghciWelcomeMsg
-#  endif
-
-	-- Display details of the configuration in verbose mode
-   when (not (isInteractiveMode cli_mode) && verb >= 2) $
-	do hPutStr stderr "Glasgow Haskell Compiler, Version "
- 	   hPutStr stderr cProjectVersion
-	   hPutStr stderr ", for Haskell 98, compiled by GHC version "
-#ifdef GHCI
-	   -- GHCI is only set when we are bootstrapping...
- 	   hPutStrLn stderr cProjectVersion
-#else
-	   hPutStrLn stderr cBooterVersion
-#endif
-
-showVersion :: IO ()
-showVersion = do
-  putStrLn (cProjectName ++ ", version " ++ cProjectVersion)
-  exitWith ExitSuccess
-
-showGhcUsage cli_mode = do 
-  (ghc_usage_path,ghci_usage_path) <- getUsageMsgPaths
-  let usage_path 
-	| DoInteractive <- cli_mode = ghci_usage_path
-	| otherwise		    = ghc_usage_path
-  usage <- readFile usage_path
-  dump usage
-  exitWith ExitSuccess
-  where
-     dump ""	      = return ()
-     dump ('$':'$':s) = putStr progName >> dump s
-     dump (c:s)	      = putChar c >> dump s
-
-dumpFinalStats :: DynFlags -> IO ()
-dumpFinalStats dflags = 
-  when (dopt Opt_D_faststring_stats dflags) $ dumpFastStringStats dflags
-
-dumpFastStringStats :: DynFlags -> IO ()
-dumpFastStringStats dflags = do
-  buckets <- getFastStringTable
-  let (entries, longest, is_z, has_z) = countFS 0 0 0 0 buckets
-      msg = text "FastString stats:" $$
-	    nest 4 (vcat [text "size:           " <+> int (length buckets),
-			  text "entries:        " <+> int entries,
-			  text "longest chain:  " <+> int longest,
-			  text "z-encoded:      " <+> (is_z `pcntOf` entries),
-			  text "has z-encoding: " <+> (has_z `pcntOf` entries)
-			 ])
-	-- we usually get more "has z-encoding" than "z-encoded", because
-	-- when we z-encode a string it might hash to the exact same string,
-	-- which will is not counted as "z-encoded".  Only strings whose
-	-- Z-encoding is different from the original string are counted in
-	-- the "z-encoded" total.
-  putMsg dflags msg
-  where
-   x `pcntOf` y = int ((x * 100) `quot` y) <> char '%'
-  
-countFS entries longest is_z has_z [] = (entries, longest, is_z, has_z)
-countFS entries longest is_z has_z (b:bs) = 
-  let
-	len = length b
-	longest' = max len longest
-	entries' = entries + len
-	is_zs = length (filter isZEncoded b)
-	has_zs = length (filter hasZEncoding b)
-  in
-	countFS entries' longest' (is_z + is_zs) (has_z + has_zs) bs
-
--- -----------------------------------------------------------------------------
--- Util
-
-unknownFlagsErr :: [String] -> a
-unknownFlagsErr fs = throwDyn (UsageError ("unrecognised flags: " ++ unwords fs))
diff --git a/ghc/compiler/main/PackageConfig.hs b/ghc/compiler/main/PackageConfig.hs
deleted file mode 100644
index e19a10dbc5..0000000000
--- a/ghc/compiler/main/PackageConfig.hs
+++ /dev/null
@@ -1,69 +0,0 @@
---
--- (c) The University of Glasgow, 2004
---
-
-module PackageConfig (
-	-- * PackageId
-	PackageId, 
-	mkPackageId, stringToPackageId, packageIdString, packageConfigId,
-	packageIdFS, fsToPackageId, 
-	
-	-- * The PackageConfig type: information about a package
-	PackageConfig,
-	InstalledPackageInfo(..), showPackageId,
-	Version(..),
-	PackageIdentifier(..),
-	defaultPackageConfig
-  ) where
-
-#include "HsVersions.h"
-
-import Distribution.InstalledPackageInfo
-import Distribution.Package
-import Distribution.Version
-import FastString
-
--- -----------------------------------------------------------------------------
--- Our PackageConfig type is just InstalledPackageInfo from Cabal.  Later we
--- might need to extend it with some GHC-specific stuff, but for now it's fine.
-
-type PackageConfig = InstalledPackageInfo
-defaultPackageConfig = emptyInstalledPackageInfo
-
--- -----------------------------------------------------------------------------
--- PackageId (package names with versions)
-
--- Mostly the compiler deals in terms of PackageNames, which don't
--- have the version suffix.  This is so that we don't need to know the
--- version for the -package-name flag, or know the versions of
--- wired-in packages like base & rts.  Versions are confined to the
--- package sub-system.
---
--- This means that in theory you could have multiple base packages installed
--- (for example), and switch between them using -package/-hide-package.
---
--- A PackageId is a string of the form <pkg>-<version>.
-
-newtype PackageId = PId FastString deriving( Eq, Ord )  -- includes the version
-	-- easier not to use a newtype here, because we need instances of
-	-- Binary & Outputable, and we're too early to define them
-
-fsToPackageId :: FastString -> PackageId
-fsToPackageId = PId
-
-packageIdFS :: PackageId -> FastString
-packageIdFS (PId fs) = fs
-
-stringToPackageId :: String -> PackageId
-stringToPackageId = fsToPackageId . mkFastString
-
-packageIdString :: PackageId -> String
-packageIdString = unpackFS . packageIdFS
-
-mkPackageId :: PackageIdentifier -> PackageId
-mkPackageId = stringToPackageId . showPackageId
-
-packageConfigId :: PackageConfig -> PackageId
-packageConfigId = mkPackageId . package
-
-
diff --git a/ghc/compiler/main/Packages.hi-boot-5 b/ghc/compiler/main/Packages.hi-boot-5
deleted file mode 100644
index 62f020cddb..0000000000
--- a/ghc/compiler/main/Packages.hi-boot-5
+++ /dev/null
@@ -1,3 +0,0 @@
-__interface Packages 1 0 where
-__export Packages PackageState ;
-1 data PackageState ;
diff --git a/ghc/compiler/main/Packages.hi-boot-6 b/ghc/compiler/main/Packages.hi-boot-6
deleted file mode 100644
index 6b12f1496e..0000000000
--- a/ghc/compiler/main/Packages.hi-boot-6
+++ /dev/null
@@ -1,2 +0,0 @@
-module Packages where
-data PackageState
diff --git a/ghc/compiler/main/Packages.lhs b/ghc/compiler/main/Packages.lhs
deleted file mode 100644
index ae6b18863e..0000000000
--- a/ghc/compiler/main/Packages.lhs
+++ /dev/null
@@ -1,705 +0,0 @@
-%
-% (c) The University of Glasgow, 2000
-%
-\section{Package manipulation}
-
-\begin{code}
-module Packages (
-	module PackageConfig,
-
-	-- * The PackageConfigMap
-	PackageConfigMap, emptyPackageConfigMap, lookupPackage,
-	extendPackageConfigMap,	dumpPackages,
-
-	-- * Reading the package config, and processing cmdline args
-	PackageIdH(..), isHomePackage,
-	PackageState(..),
-	mkPackageState,
-	initPackages,
-	getPackageDetails,
-	checkForPackageConflicts,
-	lookupModuleInAllPackages,
-
-	HomeModules, mkHomeModules, isHomeModule,
-
-	-- * Inspecting the set of packages in scope
-	getPackageIncludePath,
-	getPackageCIncludes,
-	getPackageLibraryPath,
-	getPackageLinkOpts,
-	getPackageExtraCcOpts,
-	getPackageFrameworkPath,
-	getPackageFrameworks,
-	getExplicitPackagesAnd,
-
-	-- * Utils
-	isDllName
-    )
-where
-
-#include "HsVersions.h"
-
-import PackageConfig	
-import SysTools		( getTopDir, getPackageConfigPath )
-import ParsePkgConf	( loadPackageConfig )
-import DynFlags		( dopt, DynFlag(..), DynFlags(..), PackageFlag(..) )
-import StaticFlags	( opt_Static )
-import Config		( cProjectVersion )
-import Name		( Name, nameModule_maybe )
-import UniqFM
-import Module
-import FiniteMap
-import UniqSet
-import Util
-import Maybes		( expectJust, MaybeErr(..) )
-import Panic
-import Outputable
-
-#if __GLASGOW_HASKELL__ >= 603
-import System.Directory	( getAppUserDataDirectory )
-#else
-import Compat.Directory	( getAppUserDataDirectory )
-#endif
-
-import System.Environment ( getEnv )
-import Distribution.InstalledPackageInfo
-import Distribution.Package
-import Distribution.Version
-import System.Directory	( doesFileExist, doesDirectoryExist,
-			  getDirectoryContents )
-import Control.Monad	( foldM )
-import Data.List	( nub, partition, sortBy, isSuffixOf )
-import FastString
-import EXCEPTION	( throwDyn )
-import ErrUtils         ( debugTraceMsg, putMsg, Message )
-
--- ---------------------------------------------------------------------------
--- The Package state
-
--- Package state is all stored in DynFlags, including the details of
--- all packages, which packages are exposed, and which modules they
--- provide.
-
--- The package state is computed by initPackages, and kept in DynFlags.
---
---   * -package <pkg> causes <pkg> to become exposed, and all other packages 
---	with the same name to become hidden.
--- 
---   * -hide-package <pkg> causes <pkg> to become hidden.
--- 
---   * Let exposedPackages be the set of packages thus exposed.  
---     Let depExposedPackages be the transitive closure from exposedPackages of
---     their dependencies.
---
---   * It is an error for any two packages in depExposedPackages to provide the
---     same module.
--- 
---   * When searching for a module from an explicit import declaration,
---     only the exposed modules in exposedPackages are valid.
---
---   * When searching for a module from an implicit import, all modules
---     from depExposedPackages are valid.
---
---   * When linking in a comp manager mode, we link in packages the
---     program depends on (the compiler knows this list by the
---     time it gets to the link step).  Also, we link in all packages
---     which were mentioned with explicit -package flags on the command-line,
---     or are a transitive dependency of same, or are "base"/"rts".
---     The reason for (b) is that we might need packages which don't
---     contain any Haskell modules, and therefore won't be discovered
---     by the normal mechanism of dependency tracking.
-
-
--- One important thing that the package state provides is a way to
--- tell, for a given module, whether it is part of the current package
--- or not.  We need to know this for two reasons:
---
---  * generating cross-DLL calls is different from intra-DLL calls 
---    (see below).
---  * we don't record version information in interface files for entities
---    in a different package.
--- 
--- Notes on DLLs
--- ~~~~~~~~~~~~~
--- When compiling module A, which imports module B, we need to 
--- know whether B will be in the same DLL as A.  
--- 	If it's in the same DLL, we refer to B_f_closure
--- 	If it isn't, we refer to _imp__B_f_closure
--- When compiling A, we record in B's Module value whether it's
--- in a different DLL, by setting the DLL flag.
-
-data PackageState = PackageState {
-
-  explicitPackages      :: [PackageId],
-	-- The packages we're going to link in eagerly.  This list
-	-- should be in reverse dependency order; that is, a package
-	-- is always mentioned before the packages it depends on.
-
-  origPkgIdMap	        :: PackageConfigMap, -- PackageId   -> PackageConfig
-	-- the full package database
-
-  pkgIdMap		:: PackageConfigMap, -- PackageId   -> PackageConfig
-	-- Derived from origPkgIdMap.
-	-- The exposed flags are adjusted according to -package and
-	-- -hide-package flags, and -ignore-package removes packages.
-
-  moduleToPkgConfAll 	:: ModuleEnv [(PackageConfig,Bool)],
-	-- Derived from pkgIdMap.	
-	-- Maps Module to (pkgconf,exposed), where pkgconf is the
-	-- PackageConfig for the package containing the module, and
-	-- exposed is True if the package exposes that module.
-
-  -- The PackageIds of some known packages
-  basePackageId		:: PackageIdH,
-  rtsPackageId		:: PackageIdH,
-  haskell98PackageId	:: PackageIdH,
-  thPackageId		:: PackageIdH
-  }
-
-data PackageIdH 
-   = HomePackage 		-- The "home" package is the package curently
-				-- being compiled
-   | ExtPackage PackageId	-- An "external" package is any other package
-
-
-isHomePackage :: PackageIdH -> Bool
-isHomePackage HomePackage    = True
-isHomePackage (ExtPackage _) = False
-
--- A PackageConfigMap maps a PackageId to a PackageConfig
-type PackageConfigMap = UniqFM PackageConfig
-
-emptyPackageConfigMap :: PackageConfigMap
-emptyPackageConfigMap = emptyUFM
-
-lookupPackage :: PackageConfigMap -> PackageId -> Maybe PackageConfig
-lookupPackage = lookupUFM
-
-extendPackageConfigMap
-   :: PackageConfigMap -> [PackageConfig] -> PackageConfigMap
-extendPackageConfigMap pkg_map new_pkgs 
-  = foldl add pkg_map new_pkgs
-  where add pkg_map p = addToUFM pkg_map (packageConfigId p) p
-
-getPackageDetails :: PackageState -> PackageId -> PackageConfig
-getPackageDetails dflags ps = expectJust "getPackageDetails" (lookupPackage (pkgIdMap dflags) ps)
-
--- ----------------------------------------------------------------------------
--- Loading the package config files and building up the package state
-
--- | Call this after parsing the DynFlags.  It reads the package
--- configuration files, and sets up various internal tables of package
--- information, according to the package-related flags on the
--- command-line (@-package@, @-hide-package@ etc.)
-initPackages :: DynFlags -> IO DynFlags
-initPackages dflags = do 
-  pkg_map <- readPackageConfigs dflags; 
-  state <- mkPackageState dflags pkg_map
-  return dflags{ pkgState = state }
-
--- -----------------------------------------------------------------------------
--- Reading the package database(s)
-
-readPackageConfigs :: DynFlags -> IO PackageConfigMap
-readPackageConfigs dflags = do
-   e_pkg_path <- try (getEnv "GHC_PACKAGE_PATH")
-   system_pkgconfs <- getSystemPackageConfigs dflags
-
-   let pkgconfs = case e_pkg_path of
-		    Left _   -> system_pkgconfs
-		    Right path
-		     | last cs == "" -> init cs ++ system_pkgconfs
-		     | otherwise     -> cs
-		     where cs = parseSearchPath path
-		     -- if the path ends in a separator (eg. "/foo/bar:")
-		     -- the we tack on the system paths.
-
-	-- Read all the ones mentioned in -package-conf flags
-   pkg_map <- foldM (readPackageConfig dflags) emptyPackageConfigMap
-		 (reverse pkgconfs ++ extraPkgConfs dflags)
-
-   return pkg_map
-
-
-getSystemPackageConfigs :: DynFlags -> IO [FilePath]
-getSystemPackageConfigs dflags = do
-	-- System one always comes first
-   system_pkgconf <- getPackageConfigPath
-
-	-- allow package.conf.d to contain a bunch of .conf files
-	-- containing package specifications.  This is an easier way
-	-- to maintain the package database on systems with a package
-	-- management system, or systems that don't want to run ghc-pkg
-	-- to register or unregister packages.  Undocumented feature for now.
-   let system_pkgconf_dir = system_pkgconf ++ ".d"
-   system_pkgconf_dir_exists <- doesDirectoryExist system_pkgconf_dir
-   system_pkgconfs <-
-     if system_pkgconf_dir_exists
-       then do files <- getDirectoryContents system_pkgconf_dir
-               return [ system_pkgconf_dir ++ '/' : file
-                      | file <- files
-                      , isSuffixOf ".conf" file]
-       else return []
-
-	-- Read user's package conf (eg. ~/.ghc/i386-linux-6.3/package.conf)
-	-- unless the -no-user-package-conf flag was given.
-	-- We only do this when getAppUserDataDirectory is available 
-	-- (GHC >= 6.3).
-   user_pkgconf <- handle (\_ -> return []) $ do
-      appdir <- getAppUserDataDirectory "ghc"
-      let 
-     	 pkgconf = appdir
-		   `joinFileName` (TARGET_ARCH ++ '-':TARGET_OS ++ '-':cProjectVersion)
-		   `joinFileName` "package.conf"
-      flg <- doesFileExist pkgconf
-      if (flg && dopt Opt_ReadUserPackageConf dflags)
-	then return [pkgconf]
-	else return []
-
-   return (user_pkgconf ++ system_pkgconfs ++ [system_pkgconf])
-
-
-readPackageConfig
-   :: DynFlags -> PackageConfigMap -> FilePath -> IO PackageConfigMap
-readPackageConfig dflags pkg_map conf_file = do
-  debugTraceMsg dflags 2 (text "Using package config file:" <+> text conf_file)
-  proto_pkg_configs <- loadPackageConfig conf_file
-  top_dir 	    <- getTopDir
-  let pkg_configs1 = mungePackagePaths top_dir proto_pkg_configs
-      pkg_configs2 = maybeHidePackages dflags pkg_configs1
-  return (extendPackageConfigMap pkg_map pkg_configs2)
-
-maybeHidePackages :: DynFlags -> [PackageConfig] -> [PackageConfig]
-maybeHidePackages dflags pkgs
-  | dopt Opt_HideAllPackages dflags = map hide pkgs
-  | otherwise 			    = pkgs
-  where
-    hide pkg = pkg{ exposed = False }
-
-mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
--- Replace the string "$topdir" at the beginning of a path
--- with the current topdir (obtained from the -B option).
-mungePackagePaths top_dir ps = map munge_pkg ps
- where 
-  munge_pkg p = p{ importDirs  = munge_paths (importDirs p),
-		   includeDirs = munge_paths (includeDirs p),
-    		   libraryDirs = munge_paths (libraryDirs p),
-		   frameworkDirs = munge_paths (frameworkDirs p) }
-
-  munge_paths = map munge_path
-
-  munge_path p 
-	  | Just p' <- maybePrefixMatch "$topdir" p = top_dir ++ p'
-	  | otherwise				    = p
-
-
--- -----------------------------------------------------------------------------
--- When all the command-line options are in, we can process our package
--- settings and populate the package state.
-
-mkPackageState :: DynFlags -> PackageConfigMap -> IO PackageState
-mkPackageState dflags orig_pkg_db = do
-  --
-  -- Modify the package database according to the command-line flags
-  -- (-package, -hide-package, -ignore-package, -hide-all-packages).
-  --
-  -- Also, here we build up a set of the packages mentioned in -package
-  -- flags on the command line; these are called the "explicit" packages.
-  -- we link these packages in eagerly.  The explicit set should contain
-  -- at least rts & base, which is why we pretend that the command line
-  -- contains -package rts & -package base.
-  --
-  let
-	flags = reverse (packageFlags dflags)
-
-	procflags pkgs expl [] = return (pkgs,expl)
-	procflags pkgs expl (ExposePackage str : flags) = do
-	   case pick str pkgs of
-		Nothing -> missingPackageErr str
-		Just (p,ps) -> procflags (p':ps') expl' flags
-		  where pkgid = packageConfigId p
-			p' = p {exposed=True}
-		        ps' = hideAll (pkgName (package p)) ps
-			expl' = addOneToUniqSet expl pkgid
-	procflags pkgs expl (HidePackage str : flags) = do
-	   case partition (matches str) pkgs of
-		([],_)   -> missingPackageErr str
-		(ps,qs) -> procflags (map hide ps ++ qs) expl flags
-		  where hide p = p {exposed=False}
-	procflags pkgs expl (IgnorePackage str : flags) = do
-	   case partition (matches str) pkgs of
-		(ps,qs) -> procflags qs expl flags
-		-- missing package is not an error for -ignore-package,
-		-- because a common usage is to -ignore-package P as
-		-- a preventative measure just in case P exists.
-
-	pick str pkgs
-	  = case partition (matches str) pkgs of
-		([],_) -> Nothing
-		(ps,rest) -> 
-		   case sortBy (flip (comparing (pkgVersion.package))) ps of
-			(p:ps) -> Just (p, ps ++ rest)
-			_ -> panic "Packages.pick"
-
-        comparing f a b = f a `compare` f b
-
-	-- A package named on the command line can either include the
-	-- version, or just the name if it is unambiguous.
-	matches str p
-		=  str == showPackageId (package p)
-		|| str == pkgName (package p)
-
-	-- When a package is requested to be exposed, we hide all other
-	-- packages with the same name.
-	hideAll name ps = map maybe_hide ps
-	  where maybe_hide p | pkgName (package p) == name = p {exposed=False}
-			     | otherwise                   = p
-  --
-  (pkgs1,explicit) <- procflags (eltsUFM orig_pkg_db) emptyUniqSet flags
-  --
-  -- hide all packages for which there is also a later version
-  -- that is already exposed.  This just makes it non-fatal to have two
-  -- versions of a package exposed, which can happen if you install a
-  -- later version of a package in the user database, for example.
-  --
-  let maybe_hide p
-	   | not (exposed p) = return p
-	   | (p' : _) <- later_versions = do
-		debugTraceMsg dflags 2 $
-		   (ptext SLIT("hiding package") <+> text (showPackageId (package p)) <+>
-		    ptext SLIT("to avoid conflict with later version") <+>
-		    text (showPackageId (package p')))
-		return (p {exposed=False})
-	   | otherwise = return p
-	  where myname = pkgName (package p)
-		myversion = pkgVersion (package p)
-		later_versions = [ p | p <- pkgs1, exposed p,
-				    let pkg = package p,
-				    pkgName pkg == myname,
-				    pkgVersion pkg > myversion ]
-		a_later_version_is_exposed
-		  = not (null later_versions)
-
-  pkgs2 <- mapM maybe_hide pkgs1
-  --
-  -- Eliminate any packages which have dangling dependencies (perhaps
-  -- because the package was removed by -ignore-package).
-  --
-  let
-	elimDanglingDeps pkgs = 
-	   case partition (not.null.snd) (map (getDanglingDeps pkgs) pkgs) of
-	      ([],ps) -> return (map fst ps)
-	      (ps,qs) -> do
-		 mapM_ reportElim ps
-		 elimDanglingDeps (map fst qs)
-
-	reportElim (p, deps) = 
-		debugTraceMsg dflags 2 $
-		   (ptext SLIT("package") <+> pprPkg p <+> 
-			ptext SLIT("will be ignored due to missing dependencies:") $$ 
-		    nest 2 (hsep (map (text.showPackageId) deps)))
-
-	getDanglingDeps pkgs p = (p, filter dangling (depends p))
-	  where dangling pid = pid `notElem` all_pids
-		all_pids = map package pkgs
-  --
-  pkgs <- elimDanglingDeps pkgs2
-  let pkg_db = extendPackageConfigMap emptyPackageConfigMap pkgs
-  --
-  -- Find the transitive closure of dependencies of exposed
-  --
-  let exposed_pkgids = [ packageConfigId p | p <- pkgs, exposed p ]
-  dep_exposed <- closeDeps pkg_db exposed_pkgids
-  --
-  -- Look up some known PackageIds
-  --
-  let
-	lookupPackageByName :: FastString -> PackageIdH
-	lookupPackageByName nm = 
-	  case [ conf | p <- dep_exposed,
-			Just conf <- [lookupPackage pkg_db p],
-			nm == mkFastString (pkgName (package conf)) ] of
-		[]     -> HomePackage
-		(p:ps) -> ExtPackage (mkPackageId (package p))
-
-	-- Get the PackageIds for some known packages (we know the names,
-	-- but we don't know the versions).  Some of these packages might
-	-- not exist in the database, so they are Maybes.
-	basePackageId		= lookupPackageByName basePackageName
-	rtsPackageId		= lookupPackageByName rtsPackageName
-	haskell98PackageId	= lookupPackageByName haskell98PackageName
-	thPackageId		= lookupPackageByName thPackageName
-
-	-- add base & rts to the explicit packages
-	basicLinkedPackages = [basePackageId,rtsPackageId]
-	explicit' = addListToUniqSet explicit 
-			[ p | ExtPackage p <- basicLinkedPackages ]
-  --
-  -- Close the explicit packages with their dependencies
-  --
-  dep_explicit <- closeDeps pkg_db (uniqSetToList explicit')
-  --
-  -- Build up a mapping from Module -> PackageConfig for all modules.
-  -- Discover any conflicts at the same time, and factor in the new exposed
-  -- status of each package.
-  --
-  let mod_map = mkModuleMap pkg_db dep_exposed
-
-  return PackageState{ explicitPackages     = dep_explicit,
-		       origPkgIdMap	    = orig_pkg_db,
-		       pkgIdMap   	    = pkg_db,
-		       moduleToPkgConfAll   = mod_map,
-		       basePackageId	    = basePackageId,
-		       rtsPackageId	    = rtsPackageId,
-  		       haskell98PackageId   = haskell98PackageId,
-  		       thPackageId          = thPackageId
-		     }
-  -- done!
-
-basePackageName      = FSLIT("base")
-rtsPackageName	     = FSLIT("rts")
-haskell98PackageName = FSLIT("haskell98")
-thPackageName        = FSLIT("template-haskell")
-				-- Template Haskell libraries in here
-
-mkModuleMap
-  :: PackageConfigMap
-  -> [PackageId]
-  -> ModuleEnv [(PackageConfig, Bool)]
-mkModuleMap pkg_db pkgs = foldr extend_modmap emptyUFM pkgs
-  where
-	extend_modmap pkgname modmap =
-		addListToUFM_C (++) modmap 
-		    [(m, [(pkg, m `elem` exposed_mods)]) | m <- all_mods]
-	  where
-		pkg = expectJust "mkModuleMap" (lookupPackage pkg_db pkgname)
-	        exposed_mods = map mkModule (exposedModules pkg)
-	        hidden_mods  = map mkModule (hiddenModules pkg)
-		all_mods = exposed_mods ++ hidden_mods
-
--- -----------------------------------------------------------------------------
--- Check for conflicts in the program.
-
--- | A conflict arises if the program contains two modules with the same
--- name, which can arise if the program depends on multiple packages that
--- expose the same module, or if the program depends on a package that
--- contains a module also present in the program (the "home package").
---
-checkForPackageConflicts
-   :: DynFlags
-   -> [Module]		-- modules in the home package
-   -> [PackageId]	-- packages on which the program depends
-   -> MaybeErr Message ()
-
-checkForPackageConflicts dflags mods pkgs = do
-    let 
-	state   = pkgState dflags
-	pkg_db  = pkgIdMap state
-    --
-    dep_pkgs <- closeDepsErr pkg_db pkgs
-
-    let 
-	extend_modmap pkgname modmap  =
-		addListToFM_C (++) modmap
-		    [(m, [(pkg, m `elem` exposed_mods)]) | m <- all_mods]
-	  where
-		pkg = expectJust "checkForPackageConflicts" 
-				(lookupPackage pkg_db pkgname)
-	        exposed_mods = map mkModule (exposedModules pkg)
-	        hidden_mods  = map mkModule (hiddenModules pkg)
-		all_mods = exposed_mods ++ hidden_mods
-
-        mod_map = foldr extend_modmap emptyFM pkgs
-	mod_map_list :: [(Module,[(PackageConfig,Bool)])]
-        mod_map_list = fmToList mod_map
-
-	overlaps = [ (m, map fst ps) | (m,ps@(_:_:_)) <- mod_map_list ]
-    --
-    if not (null overlaps)
-	then Failed (pkgOverlapError overlaps)
-	else do
-
-    let 
-	overlap_mods = [ (mod,pkg)
-		       | mod <- mods,
-		         Just ((pkg,_):_) <- [lookupFM mod_map mod] ]    
-				-- will be only one package here
-    if not (null overlap_mods)
-	then Failed (modOverlapError overlap_mods)
-	else do
-
-    return ()
-       
-pkgOverlapError overlaps =  vcat (map msg overlaps)
-  where 
-	msg (mod,pkgs) =
-	   text "conflict: module" <+> quotes (ppr mod)
-		 <+> ptext SLIT("is present in multiple packages:")
-		 <+> hsep (punctuate comma (map pprPkg pkgs))
-
-modOverlapError overlaps =   vcat (map msg overlaps)
-  where 
-	msg (mod,pkg) = fsep [
-	   	text "conflict: module",
-		quotes (ppr mod),
-		ptext SLIT("belongs to the current program/library"),
-		ptext SLIT("and also to package"),
-		pprPkg pkg ]
-
-pprPkg :: PackageConfig -> SDoc
-pprPkg p = text (showPackageId (package p))
-
--- -----------------------------------------------------------------------------
--- Extracting information from the packages in scope
-
--- Many of these functions take a list of packages: in those cases,
--- the list is expected to contain the "dependent packages",
--- i.e. those packages that were found to be depended on by the
--- current module/program.  These can be auto or non-auto packages, it
--- doesn't really matter.  The list is always combined with the list
--- of explicit (command-line) packages to determine which packages to
--- use.
-
-getPackageIncludePath :: DynFlags -> [PackageId] -> IO [String]
-getPackageIncludePath dflags pkgs = do
-  ps <- getExplicitPackagesAnd dflags pkgs
-  return (nub (filter notNull (concatMap includeDirs ps)))
-
-	-- includes are in reverse dependency order (i.e. rts first)
-getPackageCIncludes :: [PackageConfig] -> IO [String]
-getPackageCIncludes pkg_configs = do
-  return (reverse (nub (filter notNull (concatMap includes pkg_configs))))
-
-getPackageLibraryPath :: DynFlags -> [PackageId] -> IO [String]
-getPackageLibraryPath dflags pkgs = do 
-  ps <- getExplicitPackagesAnd dflags pkgs
-  return (nub (filter notNull (concatMap libraryDirs ps)))
-
-getPackageLinkOpts :: DynFlags -> [PackageId] -> IO [String]
-getPackageLinkOpts dflags pkgs = do
-  ps <- getExplicitPackagesAnd dflags pkgs
-  let tag = buildTag dflags
-      rts_tag = rtsBuildTag dflags
-  let 
-	imp        = if opt_Static then "" else "_dyn"
-      	libs p     = map ((++imp) . addSuffix) (hsLibraries p)
-      	                 ++ hACK_dyn (extraLibraries p)
-	all_opts p = map ("-l" ++) (libs p) ++ ldOptions p
-
-	suffix     = if null tag then "" else  '_':tag
-	rts_suffix = if null rts_tag then "" else  '_':rts_tag
-
-        addSuffix rts@"HSrts"    = rts       ++ rts_suffix
-        addSuffix other_lib      = other_lib ++ suffix
-
-        -- This is a hack that's even more horrible (and hopefully more temporary)
-        -- than the one below [referring to previous splittage of HSbase into chunks
-	-- to work around GNU ld bug]. HSbase_cbits and friends require the _dyn suffix
-        -- for dynamic linking, but not _p or other 'way' suffix. So we just add
-        -- _dyn to extraLibraries if they already have a _cbits suffix.
-        
-        hACK_dyn = map hack
-          where hack lib | not opt_Static && "_cbits" `isSuffixOf` lib = lib ++ "_dyn"
-                         | otherwise = lib
-
-  return (concat (map all_opts ps))
-
-getPackageExtraCcOpts :: DynFlags -> [PackageId] -> IO [String]
-getPackageExtraCcOpts dflags pkgs = do
-  ps <- getExplicitPackagesAnd dflags pkgs
-  return (concatMap ccOptions ps)
-
-getPackageFrameworkPath  :: DynFlags -> [PackageId] -> IO [String]
-getPackageFrameworkPath dflags pkgs = do
-  ps <- getExplicitPackagesAnd dflags pkgs
-  return (nub (filter notNull (concatMap frameworkDirs ps)))
-
-getPackageFrameworks  :: DynFlags -> [PackageId] -> IO [String]
-getPackageFrameworks dflags pkgs = do
-  ps <- getExplicitPackagesAnd dflags pkgs
-  return (concatMap frameworks ps)
-
--- -----------------------------------------------------------------------------
--- Package Utils
-
--- | Takes a Module, and if the module is in a package returns 
--- @(pkgconf,exposed)@ where pkgconf is the PackageConfig for that package,
--- and exposed is True if the package exposes the module.
-lookupModuleInAllPackages :: DynFlags -> Module -> [(PackageConfig,Bool)]
-lookupModuleInAllPackages dflags m =
-  case lookupModuleEnv (moduleToPkgConfAll (pkgState dflags)) m of
-	Nothing -> []
-	Just ps -> ps
-
-getExplicitPackagesAnd :: DynFlags -> [PackageId] -> IO [PackageConfig]
-getExplicitPackagesAnd dflags pkgids =
-  let 
-      state   = pkgState dflags
-      pkg_map = pkgIdMap state
-      expl    = explicitPackages state
-  in do
-  all_pkgs <- throwErr (foldM (add_package pkg_map) expl pkgids)
-  return (map (getPackageDetails state) all_pkgs)
-
--- Takes a list of packages, and returns the list with dependencies included,
--- in reverse dependency order (a package appears before those it depends on).
-closeDeps :: PackageConfigMap -> [PackageId] -> IO [PackageId]
-closeDeps pkg_map ps = throwErr (closeDepsErr pkg_map ps)
-
-throwErr :: MaybeErr Message a -> IO a
-throwErr m = case m of
-		Failed e    -> throwDyn (CmdLineError (showSDoc e))
-		Succeeded r -> return r
-
-closeDepsErr :: PackageConfigMap -> [PackageId]
-	-> MaybeErr Message [PackageId]
-closeDepsErr pkg_map ps = foldM (add_package pkg_map) [] ps
-
--- internal helper
-add_package :: PackageConfigMap -> [PackageId] -> PackageId 
-	-> MaybeErr Message [PackageId]
-add_package pkg_db ps p
-  | p `elem` ps = return ps	-- Check if we've already added this package
-  | otherwise =
-      case lookupPackage pkg_db p of
-        Nothing -> Failed (missingPackageMsg (packageIdString p))
-        Just pkg -> do
-    	   -- Add the package's dependents also
-	   let deps = map mkPackageId (depends pkg)
-    	   ps' <- foldM (add_package pkg_db) ps deps
-    	   return (p : ps')
-
-missingPackageErr p = throwDyn (CmdLineError (showSDoc (missingPackageMsg p)))
-missingPackageMsg p = ptext SLIT("unknown package:") <+> text p
-
--- -----------------------------------------------------------------------------
--- The home module set
-
-newtype HomeModules = HomeModules ModuleSet
-
-mkHomeModules :: [Module] -> HomeModules
-mkHomeModules = HomeModules . mkModuleSet
-
-isHomeModule :: HomeModules -> Module -> Bool
-isHomeModule (HomeModules set) mod  = elemModuleSet mod set
-
--- Determining whether a Name refers to something in another package or not.
--- Cross-package references need to be handled differently when dynamically-
--- linked libraries are involved.
-
-isDllName :: HomeModules -> Name -> Bool
-isDllName pdeps name
-  | opt_Static = False
-  | Just mod <- nameModule_maybe name = not (isHomeModule pdeps mod)
-  | otherwise = False  -- no, it is not even an external name
-
--- -----------------------------------------------------------------------------
--- Displaying packages
-
-dumpPackages :: DynFlags -> IO ()
--- Show package info on console, if verbosity is >= 3
-dumpPackages dflags
-  = do  let pkg_map = pkgIdMap (pkgState dflags)
-	putMsg dflags $
-	      vcat (map (text.showInstalledPackageInfo) (eltsUFM pkg_map))
-\end{code}
diff --git a/ghc/compiler/main/Packages.lhs-boot b/ghc/compiler/main/Packages.lhs-boot
deleted file mode 100644
index 3a1712e2da..0000000000
--- a/ghc/compiler/main/Packages.lhs-boot
+++ /dev/null
@@ -1,4 +0,0 @@
-\begin{code}
-module Packages where
-data PackageState
-\end{code}
diff --git a/ghc/compiler/main/ParsePkgConf.y b/ghc/compiler/main/ParsePkgConf.y
deleted file mode 100644
index 901a5bc943..0000000000
--- a/ghc/compiler/main/ParsePkgConf.y
+++ /dev/null
@@ -1,153 +0,0 @@
-{
-module ParsePkgConf( loadPackageConfig ) where
-
-#include "HsVersions.h"
-
-import PackageConfig
-import Lexer
-import DynFlags
-import FastString
-import StringBuffer
-import ErrUtils  ( mkLocMessage )
-import SrcLoc
-import Outputable
-import Panic     ( GhcException(..) )
-import EXCEPTION ( throwDyn )
-
-}
-
-%token
- '{'		{ L _ ITocurly }
- '}'		{ L _ ITccurly }
- '['		{ L _ ITobrack }
- ']'		{ L _ ITcbrack }
- ','		{ L _ ITcomma }
- '='		{ L _ ITequal }
- VARID   	{ L _ (ITvarid    $$) }
- CONID   	{ L _ (ITconid    $$) }
- STRING		{ L _ (ITstring   $$) }
- INT		{ L _ (ITinteger  $$) }
-
-%monad { P } { >>= } { return }
-%lexer { lexer } { L _ ITeof }
-%name parse
-%tokentype { Located Token }
-%%
-
-pkgconf :: { [ PackageConfig ] }
-	: '[' ']'			{ [] }
-	| '[' pkgs ']'			{ reverse $2 }
-
-pkgs 	:: { [ PackageConfig ] }
-	: pkg 				{ [ $1 ] }
-	| pkgs ',' pkg			{ $3 : $1 }
-
-pkg 	:: { PackageConfig }
-	: CONID '{' fields '}'		{ $3 defaultPackageConfig }
-
-fields  :: { PackageConfig -> PackageConfig }
-	: field				{ \p -> $1 p }
-	| fields ',' field		{ \p -> $1 ($3 p) }
-
-field	:: { PackageConfig -> PackageConfig }
-	: VARID '=' pkgid
-		{% case unpackFS $1 of
-		        "package"     -> return (\p -> p{package = $3})
-			_other        -> happyError
-		}
-
-	| VARID '=' STRING		{ id }
-		-- we aren't interested in the string fields, they're all
-		-- boring (copyright, maintainer etc.)
-			
-        | VARID '=' CONID
-		{% case unpackFS $1 of {
-		   	"exposed" -> 
-			   case unpackFS $3 of {
-				"True"  -> return (\p -> p{exposed=True});
-				"False" -> return (\p -> p{exposed=False});
-				_       -> happyError };
-		   	"license" -> return id; -- not interested
-		   	_         -> happyError }
-		}
-
-	| VARID '=' CONID STRING	{ id }
-		-- another case of license
-
-	| VARID '=' strlist		
-		{\p -> case unpackFS $1 of
-		        "exposedModules"    -> p{exposedModules    = $3}
-		        "hiddenModules"     -> p{hiddenModules     = $3}
-		        "importDirs"        -> p{importDirs        = $3}
-		        "libraryDirs"       -> p{libraryDirs       = $3}
-		        "hsLibraries"       -> p{hsLibraries       = $3}
-		        "extraLibraries"    -> p{extraLibraries    = $3}
-		        "extraGHCiLibraries"-> p{extraGHCiLibraries= $3}
-		        "includeDirs"       -> p{includeDirs       = $3}
-		        "includes"          -> p{includes          = $3}
-		        "hugsOptions"       -> p{hugsOptions       = $3}
-		        "ccOptions"         -> p{ccOptions         = $3}
-		        "ldOptions"         -> p{ldOptions         = $3}
-		        "frameworkDirs"     -> p{frameworkDirs     = $3}
-		        "frameworks"        -> p{frameworks        = $3}
-		        "haddockInterfaces" -> p{haddockInterfaces = $3}
-		        "haddockHTMLs"      -> p{haddockHTMLs      = $3}
-		        "depends"     	    -> p{depends = []}
-				-- empty list only, non-empty handled below
-			other -> p
-		}
-
-	| VARID '=' pkgidlist
-		{% case unpackFS $1 of
-		        "depends"     -> return (\p -> p{depends = $3})
-			_other        -> happyError
-		}
-
-pkgid	:: { PackageIdentifier }
-	: CONID '{' VARID '=' STRING ',' VARID '=' version '}'
-			{ PackageIdentifier{ pkgName = unpackFS $5, 
-					     pkgVersion = $9 } }
-
-version :: { Version }
-	: CONID '{' VARID '=' intlist ',' VARID '=' strlist '}'
-			{ Version{ versionBranch=$5, versionTags=$9 } }
-
-pkgidlist :: { [PackageIdentifier] }
-	: '[' pkgids ']'		{ $2 }
-	-- empty list case is covered by strlist, to avoid conflicts
-
-pkgids	:: { [PackageIdentifier] }
-	: pkgid				{ [ $1 ] }
-	| pkgid ',' pkgids		{ $1 : $3 }
-
-intlist :: { [Int] }
-        : '[' ']'			{ [] }
-	| '[' ints ']'			{ $2 }
-
-ints	:: { [Int] }
-	: INT				{ [ fromIntegral $1 ] }
-	| INT ',' ints			{ fromIntegral $1 : $3 }
-
-strlist :: { [String] }
-        : '[' ']'			{ [] }
-	| '[' strs ']'			{ $2 }
-
-strs	:: { [String] }
-	: STRING			{ [ unpackFS $1 ] }
-	| STRING ',' strs 		{ unpackFS $1 : $3 }
-
-{
-happyError :: P a
-happyError = srcParseFail
-
-loadPackageConfig :: FilePath -> IO [PackageConfig]
-loadPackageConfig conf_filename = do
-   buf <- hGetStringBuffer conf_filename
-   let loc  = mkSrcLoc (mkFastString conf_filename) 1 0
-   case unP parse (mkPState buf loc defaultDynFlags) of
-	PFailed span err -> 
-           throwDyn (InstallationError (showSDoc (mkLocMessage span err)))
-
-	POk _ pkg_details -> do
-	    return pkg_details
-}
diff --git a/ghc/compiler/main/PprTyThing.hs b/ghc/compiler/main/PprTyThing.hs
deleted file mode 100644
index 2763b052fd..0000000000
--- a/ghc/compiler/main/PprTyThing.hs
+++ /dev/null
@@ -1,223 +0,0 @@
------------------------------------------------------------------------------
---
--- Pretty-printing TyThings
---
--- (c) The GHC Team 2005
---
------------------------------------------------------------------------------
-
-module PprTyThing (
-	pprTyThing,
-	pprTyThingInContext,
-	pprTyThingLoc,
-	pprTyThingInContextLoc,
-	pprTyThingHdr
-  ) where
-
-#include "HsVersions.h"
-
-import qualified GHC
-import GHC ( TyThing(..), SrcLoc )
-import Outputable
-
--- -----------------------------------------------------------------------------
--- Pretty-printing entities that we get from the GHC API
-
--- This should be a good source of sample code for using the GHC API to
--- inspect source code entities.
-
--- | Pretty-prints a 'TyThing' with its defining location.
-pprTyThingLoc :: Bool -> TyThing -> SDoc
-pprTyThingLoc exts tyThing 
-  = showWithLoc loc (pprTyThing exts tyThing)
-  where loc = GHC.nameSrcLoc (GHC.getName tyThing)
-
--- | Pretty-prints a 'TyThing'.
-pprTyThing :: Bool -> TyThing -> SDoc
-pprTyThing exts (AnId id)          = pprId         exts id
-pprTyThing exts (ADataCon dataCon) = pprDataConSig exts dataCon
-pprTyThing exts (ATyCon tyCon)     = pprTyCon      exts tyCon
-pprTyThing exts (AClass cls)       = pprClass      exts cls
-        
--- | Like 'pprTyThingInContext', but adds the defining location.
-pprTyThingInContextLoc :: Bool -> TyThing -> SDoc
-pprTyThingInContextLoc exts tyThing 
-  = showWithLoc loc (pprTyThingInContext exts tyThing)
-  where loc = GHC.nameSrcLoc (GHC.getName tyThing)
-
--- | Pretty-prints a 'TyThing' in context: that is, if the entity
--- is a data constructor, record selector, or class method, then 
--- the entity's parent declaration is pretty-printed with irrelevant
--- parts omitted.
-pprTyThingInContext :: Bool -> TyThing -> SDoc
-pprTyThingInContext exts (AnId id)          = pprIdInContext exts id
-pprTyThingInContext exts (ADataCon dataCon) = pprDataCon exts dataCon
-pprTyThingInContext exts (ATyCon tyCon)     = pprTyCon   exts tyCon
-pprTyThingInContext exts (AClass cls)       = pprClass   exts cls
-
--- | Pretty-prints the 'TyThing' header. For functions and data constructors
--- the function is equivalent to 'pprTyThing' but for type constructors
--- and classes it prints only the header part of the declaration.
-pprTyThingHdr :: Bool -> TyThing -> SDoc
-pprTyThingHdr exts (AnId id)          = pprId         exts id
-pprTyThingHdr exts (ADataCon dataCon) = pprDataConSig exts dataCon
-pprTyThingHdr exts (ATyCon tyCon)     = pprTyConHdr   exts tyCon
-pprTyThingHdr exts (AClass cls)       = pprClassHdr   exts cls
-        
-pprTyConHdr exts tyCon =
-  ptext keyword <+> ppr_bndr tyCon <+> hsep (map ppr vars)
-  where
-    vars | GHC.isPrimTyCon tyCon || 
-	   GHC.isFunTyCon tyCon = take (GHC.tyConArity tyCon) GHC.alphaTyVars
-	 | otherwise = GHC.tyConTyVars tyCon
-
-    keyword | GHC.isSynTyCon tyCon = SLIT("type")
-            | GHC.isNewTyCon tyCon = SLIT("newtype")
-            | otherwise            = SLIT("data")
-
-pprDataConSig exts dataCon =
-  ppr_bndr dataCon <+> dcolon <+> pprType exts (GHC.dataConType dataCon)
-
-pprClassHdr exts cls =
-  let (tyVars, funDeps) = GHC.classTvsFds cls
-  in ptext SLIT("class") <+> 
-     GHC.pprThetaArrow (GHC.classSCTheta cls) <+>
-     ppr_bndr cls <+>
-     hsep (map ppr tyVars) <+>
-     GHC.pprFundeps funDeps
-
-pprIdInContext exts id
-  | GHC.isRecordSelector id  		  = pprRecordSelector exts id
-  | Just cls <- GHC.isClassOpId_maybe id  = pprClassOneMethod exts cls id
-  | otherwise				  = pprId exts id
-
-pprRecordSelector exts id
-  = pprAlgTyCon exts tyCon show_con show_label
-  where
-	(tyCon,label) = GHC.recordSelectorFieldLabel id
-	show_con dataCon  = label `elem` GHC.dataConFieldLabels dataCon
-	show_label label' = label == label'
-
-pprId exts id
-  = hang (ppr_bndr id <+> dcolon) 2 
-	(pprType exts (GHC.idType id))
-
-pprType True  ty = ppr ty
-pprType False ty = ppr (GHC.dropForAlls ty)
-
-pprTyCon exts tyCon
-  | GHC.isSynTyCon tyCon
-  = let rhs_type = GHC.synTyConRhs tyCon
-    in hang (pprTyConHdr exts tyCon <+> equals) 2 (pprType exts rhs_type)
-  | otherwise
-  = pprAlgTyCon exts tyCon (const True) (const True)
-
-pprAlgTyCon exts tyCon ok_con ok_label
-  | gadt      = pprTyConHdr exts tyCon <+> ptext SLIT("where") $$ 
-		   nest 2 (vcat (ppr_trim show_con datacons))
-  | otherwise = hang (pprTyConHdr exts tyCon)
-    		   2 (add_bars (ppr_trim show_con datacons))
-  where
-    datacons = GHC.tyConDataCons tyCon
-    gadt = any (not . GHC.isVanillaDataCon) datacons
-
-    show_con dataCon
-      | ok_con dataCon = Just (pprDataConDecl exts gadt ok_label dataCon)
-      | otherwise      = Nothing
-
-pprDataCon exts dataCon = pprAlgTyCon exts tyCon (== dataCon) (const True)
-  where tyCon = GHC.dataConTyCon dataCon
-
-pprDataConDecl exts gadt_style show_label dataCon
-  | not gadt_style = ppr_fields tys_w_strs
-  | otherwise      = ppr_bndr dataCon <+> dcolon <+> 
-			sep [ ppr_tvs, GHC.pprThetaArrow theta, pp_tau ]
-  where
-    (tyvars, theta, argTypes, tyCon, res_tys) = GHC.dataConSig dataCon
-    labels = GHC.dataConFieldLabels dataCon
-    qualVars = filter (flip notElem (GHC.tyConTyVars tyCon)) tyvars
-    stricts = GHC.dataConStrictMarks dataCon
-    tys_w_strs = zip stricts argTypes
-
-    ppr_tvs 
-	| null qualVars = empty
-	| otherwise     = ptext SLIT("forall") <+> 
-				hsep (map ppr qualVars) <> dot
-
-	-- printing out the dataCon as a type signature, in GADT style
-    pp_tau = foldr add pp_res_ty tys_w_strs
-    pp_res_ty = ppr_bndr tyCon <+> hsep (map GHC.pprParendType res_tys)
-    add (str,ty) pp_ty = pprBangTy str ty <+> arrow <+> pp_ty
-
-    pprParendBangTy (strict,ty)
-	| GHC.isMarkedStrict strict = char '!' <> GHC.pprParendType ty
-	| otherwise		    = GHC.pprParendType ty
-
-    pprBangTy strict ty
-	| GHC.isMarkedStrict strict = char '!' <> ppr ty
-	| otherwise		    = ppr ty
-
-    maybe_show_label (lbl,(strict,tp))
-	| show_label lbl = Just (ppr lbl <+> dcolon <+> pprBangTy strict tp)
-	| otherwise      = Nothing
-
-    ppr_fields [ty1, ty2]
-	| GHC.dataConIsInfix dataCon && null labels
-	= sep [pprParendBangTy ty1, ppr dataCon, pprParendBangTy ty2]
-    ppr_fields fields
-	| null labels
-	= ppr_bndr dataCon <+> sep (map pprParendBangTy fields)
-	| otherwise
-	= ppr_bndr dataCon <+> 
-		braces (sep (punctuate comma (ppr_trim maybe_show_label 
-					(zip labels fields))))
-
-pprClass exts cls
-  | null methods = 
-	pprClassHdr exts cls
-  | otherwise = 
-	hang (pprClassHdr exts cls <+> ptext SLIT("where"))
-	    2 (vcat (map (pprClassMethod exts) methods))
-  where
-	methods = GHC.classMethods cls
-
-pprClassOneMethod exts cls this_one = 
-  hang (pprClassHdr exts cls <+> ptext SLIT("where"))
-	2 (vcat (ppr_trim show_meth methods))
-  where
-	methods = GHC.classMethods cls
-	show_meth id | id == this_one = Just (pprClassMethod exts id)
-		     | otherwise      = Nothing
-
-pprClassMethod exts id =
-  hang (ppr_bndr id <+> dcolon) 2 (pprType exts (classOpType id))
-  where
-  -- Here's the magic incantation to strip off the dictionary
-  -- from the class op type.  Stolen from IfaceSyn.tyThingToIfaceDecl.
-  classOpType id = GHC.funResultTy rho_ty
-     where (_sel_tyvars, rho_ty) = GHC.splitForAllTys (GHC.idType id)
-
-ppr_trim :: (a -> Maybe SDoc) -> [a] -> [SDoc]
-ppr_trim show xs
-  = snd (foldr go (False, []) xs)
-  where
-    go x (eliding, so_far)
-	| Just doc <- show x = (False, doc : so_far)
-	| otherwise = if eliding then (True, so_far)
-		                 else (True, ptext SLIT("...") : so_far)
-
-add_bars []      = empty
-add_bars [c]     = equals <+> c
-add_bars (c:cs)  = sep ((equals <+> c) : map (char '|' <+>) cs)
-
--- Wrap operators in ()
-ppr_bndr :: GHC.NamedThing a => a -> SDoc
-ppr_bndr a = GHC.pprParenSymName a
-
-showWithLoc :: SrcLoc -> SDoc -> SDoc
-showWithLoc loc doc 
-    = hang doc 2 (char '\t' <> comment <+> GHC.pprDefnLoc loc)
-		-- The tab tries to make them line up a bit
-  where
-    comment = ptext SLIT("--")
-
diff --git a/ghc/compiler/main/StaticFlags.hs b/ghc/compiler/main/StaticFlags.hs
deleted file mode 100644
index 3067063f7b..0000000000
--- a/ghc/compiler/main/StaticFlags.hs
+++ /dev/null
@@ -1,584 +0,0 @@
------------------------------------------------------------------------------
---
--- Static flags
---
--- Static flags can only be set once, on the command-line.  Inside GHC,
--- each static flag corresponds to a top-level value, usually of type Bool.
---
--- (c) The University of Glasgow 2005
---
------------------------------------------------------------------------------
-
-module StaticFlags (
-	parseStaticFlags,
-	staticFlags,
-
-	-- Ways
-	WayName(..), v_Ways, v_Build_tag, v_RTS_Build_tag,
-
-	-- Output style options
-	opt_PprUserLength,
-	opt_PprStyle_Debug,
-
-	-- profiling opts
-	opt_AutoSccsOnAllToplevs,
-	opt_AutoSccsOnExportedToplevs,
-	opt_AutoSccsOnIndividualCafs,
-	opt_SccProfilingOn,
-	opt_DoTickyProfiling,
-
-	-- language opts
-	opt_DictsStrict,
-        opt_MaxContextReductionDepth,
-	opt_IrrefutableTuples,
-	opt_Parallel,
-	opt_RuntimeTypes,
-	opt_Flatten,
-
-	-- optimisation opts
-	opt_NoMethodSharing, 
-	opt_NoStateHack,
-	opt_LiberateCaseThreshold,
-	opt_CprOff,
-	opt_RulesOff,
-	opt_SimplNoPreInlining,
-	opt_SimplExcessPrecision,
-	opt_MaxWorkerArgs,
-
-	-- Unfolding control
-	opt_UF_CreationThreshold,
-	opt_UF_UseThreshold,
-	opt_UF_FunAppDiscount,
-	opt_UF_KeenessFactor,
-	opt_UF_UpdateInPlace,
-	opt_UF_DearOp,
-
-	-- misc opts
-	opt_IgnoreDotGhci,
-	opt_ErrorSpans,
-	opt_EmitCExternDecls,
-	opt_GranMacros,
-	opt_HiVersion,
-	opt_HistorySize,
-	opt_OmitBlackHoling,
-	opt_Static,
-	opt_Unregisterised,
-	opt_EmitExternalCore,
-	opt_PIC,
-	v_Ld_inputs,
-  ) where
-
-#include "HsVersions.h"
-
-import Util		( consIORef )
-import CmdLineParser
-import Config		( cProjectVersionInt, cProjectPatchLevel,
-			  cGhcUnregisterised )
-import FastString	( FastString, mkFastString )
-import Util
-import Maybes		( firstJust )
-import Panic		( GhcException(..), ghcError )
-import Constants	( mAX_CONTEXT_REDUCTION_DEPTH )
-
-import EXCEPTION	( throwDyn )
-import DATA_IOREF
-import UNSAFE_IO	( unsafePerformIO )
-import Monad		( when )
-import Char		( isDigit )
-import List		( sort, intersperse )
-
------------------------------------------------------------------------------
--- Static flags
-
-parseStaticFlags :: [String] -> IO [String]
-parseStaticFlags args = do
-  (leftover, errs) <- processArgs static_flags args
-  when (not (null errs)) $ throwDyn (UsageError (unlines errs))
-
-    -- deal with the way flags: the way (eg. prof) gives rise to
-    -- futher flags, some of which might be static.
-  way_flags <- findBuildTag
-
-    -- if we're unregisterised, add some more flags
-  let unreg_flags | cGhcUnregisterised == "YES" = unregFlags
-		  | otherwise = []
-
-  (more_leftover, errs) <- processArgs static_flags (unreg_flags ++ way_flags)
-  when (not (null errs)) $ ghcError (UsageError (unlines errs))
-  return (more_leftover++leftover)
-
-
--- note that ordering is important in the following list: any flag which
--- is a prefix flag (i.e. HasArg, Prefix, OptPrefix, AnySuffix) will override
--- flags further down the list with the same prefix.
-
-static_flags :: [(String, OptKind IO)]
-static_flags = [
-	------- GHCi -------------------------------------------------------
-     ( "ignore-dot-ghci", PassFlag addOpt )
-  ,  ( "read-dot-ghci"  , NoArg (removeOpt "-ignore-dot-ghci") )
-
-	------- ways --------------------------------------------------------
-  ,  ( "prof"		, NoArg (addWay WayProf) )
-  ,  ( "unreg"		, NoArg (addWay WayUnreg) )
-  ,  ( "ticky"		, NoArg (addWay WayTicky) )
-  ,  ( "parallel"	, NoArg (addWay WayPar) )
-  ,  ( "gransim"	, NoArg (addWay WayGran) )
-  ,  ( "smp"		, NoArg (addWay WayThreaded) ) -- backwards compat.
-  ,  ( "debug"		, NoArg (addWay WayDebug) )
-  ,  ( "ndp"		, NoArg (addWay WayNDP) )
-  ,  ( "threaded"	, NoArg (addWay WayThreaded) )
- 	-- ToDo: user ways
-
-	------ Debugging ----------------------------------------------------
-  ,  ( "dppr-noprags",     PassFlag addOpt )
-  ,  ( "dppr-debug",       PassFlag addOpt )
-  ,  ( "dppr-user-length", AnySuffix addOpt )
-      -- rest of the debugging flags are dynamic
-
-	--------- Profiling --------------------------------------------------
-  ,  ( "auto-all"	, NoArg (addOpt "-fauto-sccs-on-all-toplevs") )
-  ,  ( "auto"		, NoArg (addOpt "-fauto-sccs-on-exported-toplevs") )
-  ,  ( "caf-all"	, NoArg (addOpt "-fauto-sccs-on-individual-cafs") )
-         -- "ignore-sccs"  doesn't work  (ToDo)
-
-  ,  ( "no-auto-all"	, NoArg (removeOpt "-fauto-sccs-on-all-toplevs") )
-  ,  ( "no-auto"	, NoArg (removeOpt "-fauto-sccs-on-exported-toplevs") )
-  ,  ( "no-caf-all"	, NoArg (removeOpt "-fauto-sccs-on-individual-cafs") )
-
-	------- Miscellaneous -----------------------------------------------
-  ,  ( "no-link-chk"    , NoArg (return ()) ) -- ignored for backwards compat
-
-	----- Linker --------------------------------------------------------
-  ,  ( "static" 	, PassFlag addOpt )
-  ,  ( "dynamic"        , NoArg (removeOpt "-static") )
-  ,  ( "rdynamic"       , NoArg (return ()) ) -- ignored for compat w/ gcc
-
-	----- RTS opts ------------------------------------------------------
-  ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
-  ,  ( "Rghc-timing"	   , NoArg  (enableTimingStats) )
-
-        ------ Compiler flags -----------------------------------------------
-	-- All other "-fno-<blah>" options cancel out "-f<blah>" on the hsc cmdline
-  ,  ( "fno-",			PrefixPred (\s -> isStaticFlag ("f"++s))
-				    (\s -> removeOpt ("-f"++s)) )
-
-	-- Pass all remaining "-f<blah>" options to hsc
-  ,  ( "f", 			AnySuffixPred (isStaticFlag) addOpt )
-  ]
-
-addOpt = consIORef v_opt_C
-
-addWay = consIORef v_Ways
-
-removeOpt f = do
-  fs <- readIORef v_opt_C
-  writeIORef v_opt_C $! filter (/= f) fs    
-
-lookUp	       	 :: FastString -> Bool
-lookup_def_int   :: String -> Int -> Int
-lookup_def_float :: String -> Float -> Float
-lookup_str       :: String -> Maybe String
-
--- holds the static opts while they're being collected, before
--- being unsafely read by unpacked_static_opts below.
-GLOBAL_VAR(v_opt_C, defaultStaticOpts, [String])
-staticFlags = unsafePerformIO (readIORef v_opt_C)
-
--- -static is the default
-defaultStaticOpts = ["-static"]
-
-packed_static_opts   = map mkFastString staticFlags
-
-lookUp     sw = sw `elem` packed_static_opts
-	
--- (lookup_str "foo") looks for the flag -foo=X or -fooX, 
--- and returns the string X
-lookup_str sw 
-   = case firstJust (map (startsWith sw) staticFlags) of
-	Just ('=' : str) -> Just str
-	Just str         -> Just str
-	Nothing		 -> Nothing	
-
-lookup_def_int sw def = case (lookup_str sw) of
-			    Nothing -> def		-- Use default
-		  	    Just xx -> try_read sw xx
-
-lookup_def_float sw def = case (lookup_str sw) of
-			    Nothing -> def		-- Use default
-		  	    Just xx -> try_read sw xx
-
-
-try_read :: Read a => String -> String -> a
--- (try_read sw str) tries to read s; if it fails, it
--- bleats about flag sw
-try_read sw str
-  = case reads str of
-	((x,_):_) -> x	-- Be forgiving: ignore trailing goop, and alternative parses
-	[]	  -> ghcError (UsageError ("Malformed argument " ++ str ++ " for flag " ++ sw))
-			-- ToDo: hack alert. We should really parse the arugments
-			-- 	 and announce errors in a more civilised way.
-
-
-{-
- Putting the compiler options into temporary at-files
- may turn out to be necessary later on if we turn hsc into
- a pure Win32 application where I think there's a command-line
- length limit of 255. unpacked_opts understands the @ option.
-
-unpacked_opts :: [String]
-unpacked_opts =
-  concat $
-  map (expandAts) $
-  map unpackFS argv  -- NOT ARGV any more: v_Static_hsc_opts
-  where
-   expandAts ('@':fname) = words (unsafePerformIO (readFile fname))
-   expandAts l = [l]
--}
-
-
-opt_IgnoreDotGhci		= lookUp FSLIT("-ignore-dot-ghci")
-
--- debugging opts
-opt_PprStyle_Debug		= lookUp  FSLIT("-dppr-debug")
-opt_PprUserLength	        = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
-
--- profiling opts
-opt_AutoSccsOnAllToplevs	= lookUp  FSLIT("-fauto-sccs-on-all-toplevs")
-opt_AutoSccsOnExportedToplevs	= lookUp  FSLIT("-fauto-sccs-on-exported-toplevs")
-opt_AutoSccsOnIndividualCafs	= lookUp  FSLIT("-fauto-sccs-on-individual-cafs")
-opt_SccProfilingOn		= lookUp  FSLIT("-fscc-profiling")
-opt_DoTickyProfiling		= lookUp  FSLIT("-fticky-ticky")
-
--- language opts
-opt_DictsStrict			= lookUp  FSLIT("-fdicts-strict")
-opt_IrrefutableTuples		= lookUp  FSLIT("-firrefutable-tuples")
-opt_MaxContextReductionDepth	= lookup_def_int "-fcontext-stack" mAX_CONTEXT_REDUCTION_DEPTH
-opt_Parallel			= lookUp  FSLIT("-fparallel")
-opt_Flatten			= lookUp  FSLIT("-fflatten")
-
--- optimisation opts
-opt_NoStateHack			= lookUp  FSLIT("-fno-state-hack")
-opt_NoMethodSharing		= lookUp  FSLIT("-fno-method-sharing")
-opt_CprOff			= lookUp  FSLIT("-fcpr-off")
-opt_RulesOff			= lookUp  FSLIT("-frules-off")
-	-- Switch off CPR analysis in the new demand analyser
-opt_LiberateCaseThreshold	= lookup_def_int "-fliberate-case-threshold" (10::Int)
-opt_MaxWorkerArgs		= lookup_def_int "-fmax-worker-args" (10::Int)
-
-opt_EmitCExternDecls	        = lookUp  FSLIT("-femit-extern-decls")
-opt_GranMacros			= lookUp  FSLIT("-fgransim")
-opt_HiVersion			= read (cProjectVersionInt ++ cProjectPatchLevel) :: Int
-opt_HistorySize			= lookup_def_int "-fhistory-size" 20
-opt_OmitBlackHoling		= lookUp  FSLIT("-dno-black-holing")
-opt_RuntimeTypes		= lookUp  FSLIT("-fruntime-types")
-
--- Simplifier switches
-opt_SimplNoPreInlining		= lookUp  FSLIT("-fno-pre-inlining")
-	-- NoPreInlining is there just to see how bad things
-	-- get if you don't do it!
-opt_SimplExcessPrecision	= lookUp  FSLIT("-fexcess-precision")
-
--- Unfolding control
-opt_UF_CreationThreshold	= lookup_def_int "-funfolding-creation-threshold"  (45::Int)
-opt_UF_UseThreshold		= lookup_def_int "-funfolding-use-threshold"	   (8::Int)	-- Discounts can be big
-opt_UF_FunAppDiscount		= lookup_def_int "-funfolding-fun-discount"	   (6::Int)	-- It's great to inline a fn
-opt_UF_KeenessFactor		= lookup_def_float "-funfolding-keeness-factor"	   (1.5::Float)
-opt_UF_UpdateInPlace		= lookUp  FSLIT("-funfolding-update-in-place")
-
-opt_UF_DearOp   = ( 4 :: Int)
-			
-opt_Static			= lookUp  FSLIT("-static")
-opt_Unregisterised		= lookUp  FSLIT("-funregisterised")
-opt_EmitExternalCore		= lookUp  FSLIT("-fext-core")
-
--- Include full span info in error messages, instead of just the start position.
-opt_ErrorSpans			= lookUp FSLIT("-ferror-spans")
-
-opt_PIC                         = lookUp FSLIT("-fPIC")
-
--- object files and libraries to be linked in are collected here.
--- ToDo: perhaps this could be done without a global, it wasn't obvious
--- how to do it though --SDM.
-GLOBAL_VAR(v_Ld_inputs,	[],      [String])
-
-isStaticFlag f =
-  f `elem` [
-	"fauto-sccs-on-all-toplevs",
-	"fauto-sccs-on-exported-toplevs",
-	"fauto-sccs-on-individual-cafs",
-	"fscc-profiling",
-	"fticky-ticky",
-	"fall-strict",
-	"fdicts-strict",
-	"firrefutable-tuples",
-	"fparallel",
-	"fflatten",
-	"fsemi-tagging",
-	"flet-no-escape",
-	"femit-extern-decls",
-	"fglobalise-toplev-names",
-	"fgransim",
-	"fno-hi-version-check",
-	"dno-black-holing",
-	"fno-method-sharing",
-	"fno-state-hack",
-	"fruntime-types",
-	"fno-pre-inlining",
-	"fexcess-precision",
-	"funfolding-update-in-place",
-	"static",
-	"funregisterised",
-	"fext-core",
-	"frule-check",
-	"frules-off",
-	"fcpr-off",
-	"ferror-spans",
-	"fPIC"
-	]
-  || any (flip prefixMatch f) [
-	"fcontext-stack",
-	"fliberate-case-threshold",
-	"fmax-worker-args",
-	"fhistory-size",
-	"funfolding-creation-threshold",
-	"funfolding-use-threshold",
-	"funfolding-fun-discount",
-	"funfolding-keeness-factor"
-     ]
-
-
-
--- Misc functions for command-line options
-
-startsWith :: String -> String -> Maybe String
--- startsWith pfx (pfx++rest) = Just rest
-
-startsWith []     str = Just str
-startsWith (c:cs) (s:ss)
-  = if c /= s then Nothing else startsWith cs ss
-startsWith  _	  []  = Nothing
-
-
------------------------------------------------------------------------------
--- convert sizes like "3.5M" into integers
-
-decodeSize :: String -> Integer
-decodeSize str
-  | c == ""		 = truncate n
-  | c == "K" || c == "k" = truncate (n * 1000)
-  | c == "M" || c == "m" = truncate (n * 1000 * 1000)
-  | c == "G" || c == "g" = truncate (n * 1000 * 1000 * 1000)
-  | otherwise            = throwDyn (CmdLineError ("can't decode size: " ++ str))
-  where (m, c) = span pred str
-        n      = read m  :: Double
-	pred c = isDigit c || c == '.'
-
-
------------------------------------------------------------------------------
--- RTS Hooks
-
-#if __GLASGOW_HASKELL__ >= 504
-foreign import ccall unsafe "setHeapSize"       setHeapSize       :: Int -> IO ()
-foreign import ccall unsafe "enableTimingStats" enableTimingStats :: IO ()
-#else
-foreign import "setHeapSize"       unsafe setHeapSize       :: Int -> IO ()
-foreign import "enableTimingStats" unsafe enableTimingStats :: IO ()
-#endif
-
------------------------------------------------------------------------------
--- Ways
-
--- The central concept of a "way" is that all objects in a given
--- program must be compiled in the same "way".  Certain options change
--- parameters of the virtual machine, eg. profiling adds an extra word
--- to the object header, so profiling objects cannot be linked with
--- non-profiling objects.
-
--- After parsing the command-line options, we determine which "way" we
--- are building - this might be a combination way, eg. profiling+ticky-ticky.
-
--- We then find the "build-tag" associated with this way, and this
--- becomes the suffix used to find .hi files and libraries used in
--- this compilation.
-
-GLOBAL_VAR(v_Build_tag, "", String)
-
--- The RTS has its own build tag, because there are some ways that
--- affect the RTS only.
-GLOBAL_VAR(v_RTS_Build_tag, "", String)
-
-data WayName
-  = WayThreaded
-  | WayDebug
-  | WayProf
-  | WayUnreg
-  | WayTicky
-  | WayPar
-  | WayGran
-  | WayNDP
-  | WayUser_a
-  | WayUser_b
-  | WayUser_c
-  | WayUser_d
-  | WayUser_e
-  | WayUser_f
-  | WayUser_g
-  | WayUser_h
-  | WayUser_i
-  | WayUser_j
-  | WayUser_k
-  | WayUser_l
-  | WayUser_m
-  | WayUser_n
-  | WayUser_o
-  | WayUser_A
-  | WayUser_B
-  deriving (Eq,Ord)
-
-GLOBAL_VAR(v_Ways, [] ,[WayName])
-
-allowed_combination way = and [ x `allowedWith` y 
-			      | x <- way, y <- way, x < y ]
-  where
-	-- Note ordering in these tests: the left argument is
-	-- <= the right argument, according to the Ord instance
-	-- on Way above.
-
-	-- debug is allowed with everything
-	_ `allowedWith` WayDebug		= True
-	WayDebug `allowedWith` _		= True
-
-	WayThreaded `allowedWith` WayProf	= True
-	WayProf `allowedWith` WayUnreg		= True
-	WayProf `allowedWith` WayNDP		= True
-	_ `allowedWith` _ 			= False
-
-
-findBuildTag :: IO [String]  -- new options
-findBuildTag = do
-  way_names <- readIORef v_Ways
-  let ws = sort way_names
-  if not (allowed_combination ws)
-      then throwDyn (CmdLineError $
-      		    "combination not supported: "  ++
-      		    foldr1 (\a b -> a ++ '/':b) 
-      		    (map (wayName . lkupWay) ws))
-      else let ways    = map lkupWay ws
-      	       tag     = mkBuildTag (filter (not.wayRTSOnly) ways)
-      	       rts_tag = mkBuildTag ways
-      	       flags   = map wayOpts ways
-      	   in do
-      	   writeIORef v_Build_tag tag
-      	   writeIORef v_RTS_Build_tag rts_tag
-      	   return (concat flags)
-
-mkBuildTag :: [Way] -> String
-mkBuildTag ways = concat (intersperse "_" (map wayTag ways))
-
-lkupWay w = 
-   case lookup w way_details of
-	Nothing -> error "findBuildTag"
-	Just details -> details
-
-data Way = Way {
-  wayTag     :: String,
-  wayRTSOnly :: Bool,
-  wayName    :: String,
-  wayOpts    :: [String]
-  }
-
-way_details :: [ (WayName, Way) ]
-way_details =
-  [ (WayThreaded, Way "thr" True "Threaded" [
-#if defined(freebsd_TARGET_OS)
-	  "-optc-pthread"
-        , "-optl-pthread"
-#endif
-	] ),
-
-    (WayDebug, Way "debug" True "Debug" [] ),
-
-    (WayProf, Way  "p" False "Profiling"
-	[ "-fscc-profiling"
-	, "-DPROFILING"
-	, "-optc-DPROFILING" ]),
-
-    (WayTicky, Way  "t" False "Ticky-ticky Profiling"  
-	[ "-fticky-ticky"
-	, "-DTICKY_TICKY"
-	, "-optc-DTICKY_TICKY" ]),
-
-    (WayUnreg, Way  "u" False "Unregisterised" 
-	unregFlags ),
-
-    -- optl's below to tell linker where to find the PVM library -- HWL
-    (WayPar, Way  "mp" False "Parallel" 
-	[ "-fparallel"
-	, "-D__PARALLEL_HASKELL__"
-	, "-optc-DPAR"
-	, "-package concurrent"
-        , "-optc-w"
-        , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
-        , "-optl-lpvm3"
-        , "-optl-lgpvm3" ]),
-
-    -- at the moment we only change the RTS and could share compiler and libs!
-    (WayPar, Way  "mt" False "Parallel ticky profiling" 
-	[ "-fparallel"
-	, "-D__PARALLEL_HASKELL__"
-	, "-optc-DPAR"
-	, "-optc-DPAR_TICKY"
-	, "-package concurrent"
-        , "-optc-w"
-        , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
-        , "-optl-lpvm3"
-        , "-optl-lgpvm3" ]),
-
-    (WayPar, Way  "md" False "Distributed" 
-	[ "-fparallel"
-	, "-D__PARALLEL_HASKELL__"
-	, "-D__DISTRIBUTED_HASKELL__"
-	, "-optc-DPAR"
-	, "-optc-DDIST"
-	, "-package concurrent"
-        , "-optc-w"
-        , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
-        , "-optl-lpvm3"
-        , "-optl-lgpvm3" ]),
-
-    (WayGran, Way  "mg" False "GranSim"
-	[ "-fgransim"
-	, "-D__GRANSIM__"
-	, "-optc-DGRAN"
-	, "-package concurrent" ]),
-
-    (WayNDP, Way  "ndp" False "Nested data parallelism"
-	[ "-fparr"
-	, "-fflatten"]),
-
-    (WayUser_a,  Way  "a"  False "User way 'a'"  ["$WAY_a_REAL_OPTS"]),	
-    (WayUser_b,  Way  "b"  False "User way 'b'"  ["$WAY_b_REAL_OPTS"]),	
-    (WayUser_c,  Way  "c"  False "User way 'c'"  ["$WAY_c_REAL_OPTS"]),	
-    (WayUser_d,  Way  "d"  False "User way 'd'"  ["$WAY_d_REAL_OPTS"]),	
-    (WayUser_e,  Way  "e"  False "User way 'e'"  ["$WAY_e_REAL_OPTS"]),	
-    (WayUser_f,  Way  "f"  False "User way 'f'"  ["$WAY_f_REAL_OPTS"]),	
-    (WayUser_g,  Way  "g"  False "User way 'g'"  ["$WAY_g_REAL_OPTS"]),	
-    (WayUser_h,  Way  "h"  False "User way 'h'"  ["$WAY_h_REAL_OPTS"]),	
-    (WayUser_i,  Way  "i"  False "User way 'i'"  ["$WAY_i_REAL_OPTS"]),	
-    (WayUser_j,  Way  "j"  False "User way 'j'"  ["$WAY_j_REAL_OPTS"]),	
-    (WayUser_k,  Way  "k"  False "User way 'k'"  ["$WAY_k_REAL_OPTS"]),	
-    (WayUser_l,  Way  "l"  False "User way 'l'"  ["$WAY_l_REAL_OPTS"]),	
-    (WayUser_m,  Way  "m"  False "User way 'm'"  ["$WAY_m_REAL_OPTS"]),	
-    (WayUser_n,  Way  "n"  False "User way 'n'"  ["$WAY_n_REAL_OPTS"]),	
-    (WayUser_o,  Way  "o"  False "User way 'o'"  ["$WAY_o_REAL_OPTS"]),	
-    (WayUser_A,  Way  "A"  False "User way 'A'"  ["$WAY_A_REAL_OPTS"]),	
-    (WayUser_B,  Way  "B"  False "User way 'B'"  ["$WAY_B_REAL_OPTS"]) 
-  ]
-
-unregFlags = 
-   [ "-optc-DNO_REGS"
-   , "-optc-DUSE_MINIINTERPRETER"
-   , "-fno-asm-mangling"
-   , "-funregisterised"
-   , "-fvia-C" ]
diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
deleted file mode 100644
index eee3e1a383..0000000000
--- a/ghc/compiler/main/SysTools.lhs
+++ /dev/null
@@ -1,817 +0,0 @@
------------------------------------------------------------------------------
---
--- (c) The University of Glasgow 2001-2003
---
--- Access to system tools: gcc, cp, rm etc
---
------------------------------------------------------------------------------
-
-\begin{code}
-module SysTools (
-	-- Initialisation
-	initSysTools,
-
-	getTopDir,		-- IO String	-- The value of $topdir
-	getPackageConfigPath,	-- IO String	-- Where package.conf is
-        getUsageMsgPaths,       -- IO (String,String)
-
-	-- Interface to system tools
-	runUnlit, runCpp, runCc, -- [Option] -> IO ()
-	runPp,                   -- [Option] -> IO ()
-	runMangle, runSplit,	 -- [Option] -> IO ()
-	runAs, runLink,		 -- [Option] -> IO ()
-	runMkDLL,
-
-	touch,			-- String -> String -> IO ()
-	copy,			-- String -> String -> String -> IO ()
-	normalisePath,          -- FilePath -> FilePath
-	
-	-- Temporary-file management
-	setTmpDir,
-	newTempName,
-	cleanTempFiles, cleanTempFilesExcept,
-	addFilesToClean,
-
-	-- System interface
-	system, 		-- String -> IO ExitCode
-
-	-- Misc
-	getSysMan,		-- IO String	Parallel system only
-	
-	Option(..)
-
- ) where
-
-#include "HsVersions.h"
-
-import DriverPhases     ( isHaskellUserSrcFilename )
-import Config
-import Outputable
-import ErrUtils		( putMsg, debugTraceMsg, showPass, Severity(..), Messages )
-import Panic		( GhcException(..) )
-import Util		( Suffix, global, notNull, consIORef, joinFileName,
-			  normalisePath, pgmPath, platformPath, joinFileExt )
-import DynFlags		( DynFlags(..), DynFlag(..), dopt, Option(..),
-			  setTmpDir, defaultDynFlags )
-
-import EXCEPTION	( throwDyn, finally )
-import DATA_IOREF	( IORef, readIORef, writeIORef )
-import DATA_INT
-    
-import Monad		( when, unless )
-import System		( ExitCode(..), getEnv, system )
-import IO		( try, catch, hGetContents,
-			  openFile, hPutStr, hClose, hFlush, IOMode(..), 
-			  stderr, ioError, isDoesNotExistError )
-import Directory	( doesFileExist, removeFile )
-import Maybe		( isJust )
-import List             ( partition )
-
--- GHC <= 4.08 didn't have rawSystem, and runs into problems with long command
--- lines on mingw32, so we disallow it now.
-#if __GLASGOW_HASKELL__ < 500
-#error GHC >= 5.00 is required for bootstrapping GHC
-#endif
-
-#ifndef mingw32_HOST_OS
-#if __GLASGOW_HASKELL__ > 504
-import qualified System.Posix.Internals
-#else
-import qualified Posix
-#endif
-#else /* Must be Win32 */
-import List		( isPrefixOf )
-import Util		( dropList )
-import Foreign
-import CString		( CString, peekCString )
-#endif
-
-import Text.Regex
-
-#if __GLASGOW_HASKELL__ < 603
--- rawSystem comes from libghccompat.a in stage1
-import Compat.RawSystem	( rawSystem )
-import GHC.IOBase       ( IOErrorType(..) ) 
-import System.IO.Error  ( ioeGetErrorType )
-#else
-import System.Process	( runInteractiveProcess, getProcessExitCode )
-import System.IO        ( hSetBuffering, hGetLine, BufferMode(..) )
-import Control.Concurrent( forkIO, newChan, readChan, writeChan )
-import Data.Char        ( isSpace )
-import FastString       ( mkFastString )
-import SrcLoc           ( SrcLoc, mkSrcLoc, noSrcSpan, mkSrcSpan )
-#endif
-\end{code}
-
-
-		The configuration story
-		~~~~~~~~~~~~~~~~~~~~~~~
-
-GHC needs various support files (library packages, RTS etc), plus
-various auxiliary programs (cp, gcc, etc).  It finds these in one
-of two places:
-
-* When running as an *installed program*, GHC finds most of this support
-  stuff in the installed library tree.  The path to this tree is passed
-  to GHC via the -B flag, and given to initSysTools .
-
-* When running *in-place* in a build tree, GHC finds most of this support
-  stuff in the build tree.  The path to the build tree is, again passed
-  to GHC via -B. 
-
-GHC tells which of the two is the case by seeing whether package.conf
-is in TopDir [installed] or in TopDir/ghc/driver [inplace] (what a hack).
-
-
-SysTools.initSysProgs figures out exactly where all the auxiliary programs
-are, and initialises mutable variables to make it easy to call them.
-To to this, it makes use of definitions in Config.hs, which is a Haskell
-file containing variables whose value is figured out by the build system.
-
-Config.hs contains two sorts of things
-
-  cGCC, 	The *names* of the programs
-  cCPP		  e.g.  cGCC = gcc
-  cUNLIT	        cCPP = gcc -E
-  etc		They do *not* include paths
-				
-
-  cUNLIT_DIR_REL   The *path* to the directory containing unlit, split etc
-  cSPLIT_DIR_REL   *relative* to the root of the build tree,
-		   for use when running *in-place* in a build tree (only)
-		
-
-
----------------------------------------------
-NOTES for an ALTERNATIVE scheme (i.e *not* what is currently implemented):
-
-Another hair-brained scheme for simplifying the current tool location
-nightmare in GHC: Simon originally suggested using another
-configuration file along the lines of GCC's specs file - which is fine
-except that it means adding code to read yet another configuration
-file.  What I didn't notice is that the current package.conf is
-general enough to do this:
-
-Package
-    {name = "tools",    import_dirs = [],  source_dirs = [],
-     library_dirs = [], hs_libraries = [], extra_libraries = [],
-     include_dirs = [], c_includes = [],   package_deps = [],
-     extra_ghc_opts = ["-pgmc/usr/bin/gcc","-pgml${topdir}/bin/unlit", ... etc.],
-     extra_cc_opts = [], extra_ld_opts = []}
-
-Which would have the advantage that we get to collect together in one
-place the path-specific package stuff with the path-specific tool
-stuff.
-		End of NOTES
----------------------------------------------
-
-
-%************************************************************************
-%*									*
-\subsection{Global variables to contain system programs}
-%*									*
-%************************************************************************
-
-All these pathnames are maintained IN THE NATIVE FORMAT OF THE HOST MACHINE.
-(See remarks under pathnames below)
-
-\begin{code}
-GLOBAL_VAR(v_Pgm_T,    error "pgm_T",    String)	-- touch
-GLOBAL_VAR(v_Pgm_CP,   error "pgm_CP", 	 String)	-- cp
-
-GLOBAL_VAR(v_Path_package_config, error "path_package_config", String)
-GLOBAL_VAR(v_Path_usages,  	  error "ghc_usage.txt",       (String,String))
-
-GLOBAL_VAR(v_TopDir,	error "TopDir",	String)		-- -B<dir>
-
--- Parallel system only
-GLOBAL_VAR(v_Pgm_sysman, error "pgm_sysman", String)	-- system manager
-
--- ways to get at some of these variables from outside this module
-getPackageConfigPath = readIORef v_Path_package_config
-getTopDir	     = readIORef v_TopDir
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Initialisation}
-%*									*
-%************************************************************************
-
-\begin{code}
-initSysTools :: Maybe String	-- Maybe TopDir path (without the '-B' prefix)
-
-	     -> DynFlags
-	     -> IO DynFlags	-- Set all the mutable variables above, holding 
-				--	(a) the system programs
-				--	(b) the package-config file
-				--	(c) the GHC usage message
-
-
-initSysTools mbMinusB dflags
-  = do  { (am_installed, top_dir) <- findTopDir mbMinusB
-	; writeIORef v_TopDir top_dir
-		-- top_dir
-		-- 	for "installed" this is the root of GHC's support files
-		--	for "in-place" it is the root of the build tree
-		-- NB: top_dir is assumed to be in standard Unix format '/' separated
-
-	; let installed, installed_bin :: FilePath -> FilePath
-              installed_bin pgm   =  pgmPath top_dir pgm
-	      installed     file  =  pgmPath top_dir file
-	      inplace dir   pgm   =  pgmPath (top_dir `joinFileName` 
-						cPROJECT_DIR `joinFileName` dir) pgm
-
-	; let pkgconfig_path
-		| am_installed = installed "package.conf"
-		| otherwise    = inplace cGHC_DRIVER_DIR_REL "package.conf.inplace"
-
-	      ghc_usage_msg_path
-		| am_installed = installed "ghc-usage.txt"
-		| otherwise    = inplace cGHC_DRIVER_DIR_REL "ghc-usage.txt"
-
-	      ghci_usage_msg_path
-		| am_installed = installed "ghci-usage.txt"
-		| otherwise    = inplace cGHC_DRIVER_DIR_REL "ghci-usage.txt"
-
-		-- For all systems, unlit, split, mangle are GHC utilities
-		-- architecture-specific stuff is done when building Config.hs
-	      unlit_path
-		| am_installed = installed_bin cGHC_UNLIT_PGM
-		| otherwise    = inplace cGHC_UNLIT_DIR_REL cGHC_UNLIT_PGM
-
-		-- split and mangle are Perl scripts
-	      split_script
-		| am_installed = installed_bin cGHC_SPLIT_PGM
-		| otherwise    = inplace cGHC_SPLIT_DIR_REL cGHC_SPLIT_PGM
-
-	      mangle_script
-		| am_installed = installed_bin cGHC_MANGLER_PGM
-		| otherwise    = inplace cGHC_MANGLER_DIR_REL cGHC_MANGLER_PGM
-
-	; let dflags0 = defaultDynFlags
-#ifndef mingw32_HOST_OS
-	-- check whether TMPDIR is set in the environment
-	; e_tmpdir <- IO.try (getEnv "TMPDIR") -- fails if not set
-#else
-	  -- On Win32, consult GetTempPath() for a temp dir.
-	  --  => it first tries TMP, TEMP, then finally the
-	  --   Windows directory(!). The directory is in short-path
-	  --   form.
-	; e_tmpdir <- 
-            IO.try (do
-	        let len = (2048::Int)
-		buf  <- mallocArray len
-		ret  <- getTempPath len buf
-		if ret == 0 then do
-		      -- failed, consult TMPDIR.
- 	             free buf
-		     getEnv "TMPDIR"
-		  else do
-		     s <- peekCString buf
-		     free buf
-		     return s)
-#endif
-        ; let dflags1 = case e_tmpdir of
-			  Left _  -> dflags0
-			  Right d -> setTmpDir d dflags0
-
-	-- Check that the package config exists
-	; config_exists <- doesFileExist pkgconfig_path
-	; when (not config_exists) $
-	     throwDyn (InstallationError 
-		         ("Can't find package.conf as " ++ pkgconfig_path))
-
-#if defined(mingw32_HOST_OS)
-	--		WINDOWS-SPECIFIC STUFF
-	-- On Windows, gcc and friends are distributed with GHC,
-	-- 	so when "installed" we look in TopDir/bin
-	-- When "in-place" we look wherever the build-time configure 
-	--	script found them
-	-- When "install" we tell gcc where its specs file + exes are (-B)
-	--	and also some places to pick up include files.  We need
-	--	to be careful to put all necessary exes in the -B place
-	--	(as, ld, cc1, etc) since if they don't get found there, gcc
-	--	then tries to run unadorned "as", "ld", etc, and will
-	--	pick up whatever happens to be lying around in the path,
-	--	possibly including those from a cygwin install on the target,
-	--	which is exactly what we're trying to avoid.
-	; let gcc_b_arg = Option ("-B" ++ installed "gcc-lib/")
-	      (gcc_prog,gcc_args)
-		| am_installed = (installed_bin "gcc", [gcc_b_arg])
-		| otherwise    = (cGCC, [])
-		-- The trailing "/" is absolutely essential; gcc seems
-		-- to construct file names simply by concatenating to
-		-- this -B path with no extra slash We use "/" rather
-		-- than "\\" because otherwise "\\\" is mangled
-		-- later on; although gcc_args are in NATIVE format,
-		-- gcc can cope
-		--	(see comments with declarations of global variables)
-		--
-		-- The quotes round the -B argument are in case TopDir
-		-- has spaces in it
-
-	      perl_path | am_installed = installed_bin cGHC_PERL
-		        | otherwise    = cGHC_PERL
-
-	-- 'touch' is a GHC util for Windows, and similarly unlit, mangle
-	; let touch_path  | am_installed = installed_bin cGHC_TOUCHY_PGM
-		       	  | otherwise    = inplace cGHC_TOUCHY_DIR_REL cGHC_TOUCHY_PGM
-
-	-- On Win32 we don't want to rely on #!/bin/perl, so we prepend 
-	-- a call to Perl to get the invocation of split and mangle
-	; let (split_prog,  split_args)  = (perl_path, [Option split_script])
-	      (mangle_prog, mangle_args) = (perl_path, [Option mangle_script])
-
-	; let (mkdll_prog, mkdll_args)
-	        | am_installed = 
-		    (pgmPath (installed "gcc-lib/") cMKDLL,
-		     [ Option "--dlltool-name",
-		       Option (pgmPath (installed "gcc-lib/") "dlltool"),
-		       Option "--driver-name",
-		       Option gcc_prog, gcc_b_arg ])
-		| otherwise    = (cMKDLL, [])
-#else
-	--		UNIX-SPECIFIC STUFF
-	-- On Unix, the "standard" tools are assumed to be
-	-- in the same place whether we are running "in-place" or "installed"
-	-- That place is wherever the build-time configure script found them.
-	; let   gcc_prog   = cGCC
-		gcc_args   = []
-		touch_path = "touch"
-		mkdll_prog = panic "Can't build DLLs on a non-Win32 system"
-		mkdll_args = []
-
-	-- On Unix, scripts are invoked using the '#!' method.  Binary
-	-- installations of GHC on Unix place the correct line on the front
-	-- of the script at installation time, so we don't want to wire-in
-	-- our knowledge of $(PERL) on the host system here.
-	; let (split_prog,  split_args)  = (split_script,  [])
-	      (mangle_prog, mangle_args) = (mangle_script, [])
-#endif
-
-	-- cpp is derived from gcc on all platforms
-        -- HACK, see setPgmP below. We keep 'words' here to remember to fix
-        -- Config.hs one day.
-        ; let cpp_path  = (gcc_prog, gcc_args ++ 
-			   (Option "-E"):(map Option (words cRAWCPP_FLAGS)))
-
-	-- For all systems, copy and remove are provided by the host
-	-- system; architecture-specific stuff is done when building Config.hs
-	; let	cp_path = cGHC_CP
-	
-	-- Other things being equal, as and ld are simply gcc
-	; let	(as_prog,as_args)  = (gcc_prog,gcc_args)
-		(ld_prog,ld_args)  = (gcc_prog,gcc_args)
-
-	-- Initialise the global vars
-	; writeIORef v_Path_package_config pkgconfig_path
-	; writeIORef v_Path_usages 	   (ghc_usage_msg_path,
-					    ghci_usage_msg_path)
-
-	; writeIORef v_Pgm_sysman	   (top_dir ++ "/ghc/rts/parallel/SysMan")
-		-- Hans: this isn't right in general, but you can 
-		-- elaborate it in the same way as the others
-
-	; writeIORef v_Pgm_T   	 	   touch_path
-	; writeIORef v_Pgm_CP  	 	   cp_path
-
-	; return dflags1{
-			pgm_L	= unlit_path,
-			pgm_P	= cpp_path,
-			pgm_F	= "",
-			pgm_c	= (gcc_prog,gcc_args),
-			pgm_m	= (mangle_prog,mangle_args),
-			pgm_s   = (split_prog,split_args),
-			pgm_a   = (as_prog,as_args),
-			pgm_l	= (ld_prog,ld_args),
-			pgm_dll = (mkdll_prog,mkdll_args) }
-	}
-
-#if defined(mingw32_HOST_OS)
-foreign import stdcall unsafe "GetTempPathA" getTempPath :: Int -> CString -> IO Int32
-#endif
-\end{code}
-
-\begin{code}
--- Find TopDir
--- 	for "installed" this is the root of GHC's support files
---	for "in-place" it is the root of the build tree
---
--- Plan of action:
--- 1. Set proto_top_dir
---	if there is no given TopDir path, get the directory 
---	where GHC is running (only on Windows)
---
--- 2. If package.conf exists in proto_top_dir, we are running
---	installed; and TopDir = proto_top_dir
---
--- 3. Otherwise we are running in-place, so
---	proto_top_dir will be /...stuff.../ghc/compiler
---	Set TopDir to /...stuff..., which is the root of the build tree
---
--- This is very gruesome indeed
-
-findTopDir :: Maybe String   -- Maybe TopDir path (without the '-B' prefix).
-           -> IO (Bool,      -- True <=> am installed, False <=> in-place
-                  String)    -- TopDir (in Unix format '/' separated)
-
-findTopDir mbMinusB
-  = do { top_dir <- get_proto
-        -- Discover whether we're running in a build tree or in an installation,
-	-- by looking for the package configuration file.
-       ; am_installed <- doesFileExist (top_dir `joinFileName` "package.conf")
-
-       ; return (am_installed, top_dir)
-       }
-  where
-    -- get_proto returns a Unix-format path (relying on getBaseDir to do so too)
-    get_proto = case mbMinusB of
-                  Just minusb -> return (normalisePath minusb)
-                  Nothing
-                      -> do maybe_exec_dir <- getBaseDir -- Get directory of executable
-		            case maybe_exec_dir of       -- (only works on Windows; 
-                                                         --  returns Nothing on Unix)
-                              Nothing  -> throwDyn (InstallationError "missing -B<dir> option")
-                              Just dir -> return dir
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Running an external program}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-runUnlit :: DynFlags -> [Option] -> IO ()
-runUnlit dflags args = do 
-  let p = pgm_L dflags
-  runSomething dflags "Literate pre-processor" p args
-
-runCpp :: DynFlags -> [Option] -> IO ()
-runCpp dflags args =   do 
-  let (p,args0) = pgm_P dflags
-  runSomething dflags "C pre-processor" p (args0 ++ args)
-
-runPp :: DynFlags -> [Option] -> IO ()
-runPp dflags args =   do 
-  let p = pgm_F dflags
-  runSomething dflags "Haskell pre-processor" p args
-
-runCc :: DynFlags -> [Option] -> IO ()
-runCc dflags args =   do 
-  let (p,args0) = pgm_c dflags
-  runSomethingFiltered dflags cc_filter "C Compiler" p (args0++args)
- where
-  -- discard some harmless warnings from gcc that we can't turn off
-  cc_filter str = unlines (do_filter (lines str))
-
-  do_filter [] = []
-  do_filter ls@(l:ls')
-      | (w:rest) <- dropWhile (isJust .matchRegex r_from) ls, 
-        isJust (matchRegex r_warn w)
-      = do_filter rest
-      | otherwise
-      = l : do_filter ls'
-
-  r_from = mkRegex "from.*:[0-9]+"
-  r_warn = mkRegex "warning: call-clobbered register used"
-
-runMangle :: DynFlags -> [Option] -> IO ()
-runMangle dflags args = do 
-  let (p,args0) = pgm_m dflags
-  runSomething dflags "Mangler" p (args0++args)
-
-runSplit :: DynFlags -> [Option] -> IO ()
-runSplit dflags args = do 
-  let (p,args0) = pgm_s dflags
-  runSomething dflags "Splitter" p (args0++args)
-
-runAs :: DynFlags -> [Option] -> IO ()
-runAs dflags args = do 
-  let (p,args0) = pgm_a dflags
-  runSomething dflags "Assembler" p (args0++args)
-
-runLink :: DynFlags -> [Option] -> IO ()
-runLink dflags args = do 
-  let (p,args0) = pgm_l dflags
-  runSomething dflags "Linker" p (args0++args)
-
-runMkDLL :: DynFlags -> [Option] -> IO ()
-runMkDLL dflags args = do
-  let (p,args0) = pgm_dll dflags
-  runSomething dflags "Make DLL" p (args0++args)
-
-touch :: DynFlags -> String -> String -> IO ()
-touch dflags purpose arg =  do 
-  p <- readIORef v_Pgm_T
-  runSomething dflags purpose p [FileOption "" arg]
-
-copy :: DynFlags -> String -> String -> String -> IO ()
-copy dflags purpose from to = do
-  showPass dflags purpose
-
-  h <- openFile to WriteMode
-  ls <- readFile from -- inefficient, but it'll do for now.
-	    	      -- ToDo: speed up via slurping.
-  hPutStr h ls
-  hClose h
-
-\end{code}
-
-\begin{code}
-getSysMan :: IO String	-- How to invoke the system manager 
-			-- (parallel system only)
-getSysMan = readIORef v_Pgm_sysman
-\end{code}
-
-\begin{code}
-getUsageMsgPaths :: IO (FilePath,FilePath)
-	  -- the filenames of the usage messages (ghc, ghci)
-getUsageMsgPaths = readIORef v_Path_usages
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Managing temporary files
-%*									*
-%************************************************************************
-
-\begin{code}
-GLOBAL_VAR(v_FilesToClean, [],               [String] )
-\end{code}
-
-\begin{code}
-cleanTempFiles :: DynFlags -> IO ()
-cleanTempFiles dflags
-   = do fs <- readIORef v_FilesToClean
-	removeTmpFiles dflags fs
-	writeIORef v_FilesToClean []
-
-cleanTempFilesExcept :: DynFlags -> [FilePath] -> IO ()
-cleanTempFilesExcept dflags dont_delete
-   = do files <- readIORef v_FilesToClean
-	let (to_keep, to_delete) = partition (`elem` dont_delete) files
-	removeTmpFiles dflags to_delete
-	writeIORef v_FilesToClean to_keep
-
-
--- find a temporary name that doesn't already exist.
-newTempName :: DynFlags -> Suffix -> IO FilePath
-newTempName DynFlags{tmpDir=tmp_dir} extn
-  = do x <- getProcessID
-       findTempName (tmp_dir ++ "/ghc" ++ show x ++ "_") 0
-  where 
-    findTempName prefix x
-      = do let filename = (prefix ++ show x) `joinFileExt` extn
-  	   b  <- doesFileExist filename
-	   if b then findTempName prefix (x+1)
-		else do consIORef v_FilesToClean filename -- clean it up later
-		        return filename
-
-addFilesToClean :: [FilePath] -> IO ()
--- May include wildcards [used by DriverPipeline.run_phase SplitMangle]
-addFilesToClean files = mapM_ (consIORef v_FilesToClean) files
-
-removeTmpFiles :: DynFlags -> [FilePath] -> IO ()
-removeTmpFiles dflags fs
-  = warnNon $
-    traceCmd dflags "Deleting temp files" 
-	     ("Deleting: " ++ unwords deletees)
-	     (mapM_ rm deletees)
-  where
-     -- Flat out refuse to delete files that are likely to be source input
-     -- files (is there a worse bug than having a compiler delete your source
-     -- files?)
-     -- 
-     -- Deleting source files is a sign of a bug elsewhere, so prominently flag
-     -- the condition.
-    warnNon act
-     | null non_deletees = act
-     | otherwise         = do
-        putMsg dflags (text "WARNING - NOT deleting source files:" <+> hsep (map text non_deletees))
-	act
-
-    (non_deletees, deletees) = partition isHaskellUserSrcFilename fs
-
-    rm f = removeFile f `IO.catch` 
-		(\_ignored -> 
-		    debugTraceMsg dflags 2 (ptext SLIT("Warning: deleting non-existent") <+> text f)
-		)
-
-
------------------------------------------------------------------------------
--- Running an external program
-
-runSomething :: DynFlags
-	     -> String		-- For -v message
-	     -> String		-- Command name (possibly a full path)
-				-- 	assumed already dos-ified
-	     -> [Option]	-- Arguments
-				--	runSomething will dos-ify them
-	     -> IO ()
-
-runSomething dflags phase_name pgm args = 
-  runSomethingFiltered dflags id phase_name pgm args
-
-runSomethingFiltered
-  :: DynFlags -> (String->String) -> String -> String -> [Option] -> IO ()
-
-runSomethingFiltered dflags filter_fn phase_name pgm args = do
-  let real_args = filter notNull (map showOpt args)
-  traceCmd dflags phase_name (unwords (pgm:real_args)) $ do
-  (exit_code, doesn'tExist) <- 
-     IO.catch (do
-         rc <- builderMainLoop dflags filter_fn pgm real_args
-	 case rc of
-	   ExitSuccess{} -> return (rc, False)
-	   ExitFailure n 
-             -- rawSystem returns (ExitFailure 127) if the exec failed for any
-             -- reason (eg. the program doesn't exist).  This is the only clue
-             -- we have, but we need to report something to the user because in
-             -- the case of a missing program there will otherwise be no output
-             -- at all.
-	    | n == 127  -> return (rc, True)
-	    | otherwise -> return (rc, False))
-		-- Should 'rawSystem' generate an IO exception indicating that
-		-- 'pgm' couldn't be run rather than a funky return code, catch
-		-- this here (the win32 version does this, but it doesn't hurt
-		-- to test for this in general.)
-              (\ err -> 
-	        if IO.isDoesNotExistError err 
-#if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ < 604
-		-- the 'compat' version of rawSystem under mingw32 always
-		-- maps 'errno' to EINVAL to failure.
-		   || case (ioeGetErrorType err ) of { InvalidArgument{} -> True ; _ -> False}
-#endif
-	         then return (ExitFailure 1, True)
-	         else IO.ioError err)
-  case (doesn'tExist, exit_code) of
-     (True, _)        -> throwDyn (InstallationError ("could not execute: " ++ pgm))
-     (_, ExitSuccess) -> return ()
-     _                -> throwDyn (PhaseFailed phase_name exit_code)
-
-
-
-#if __GLASGOW_HASKELL__ < 603
-builderMainLoop dflags filter_fn pgm real_args = do
-  rawSystem pgm real_args
-#else
-builderMainLoop dflags filter_fn pgm real_args = do
-  chan <- newChan
-  (hStdIn, hStdOut, hStdErr, hProcess) <- runInteractiveProcess pgm real_args Nothing Nothing
-
-  -- and run a loop piping the output from the compiler to the log_action in DynFlags
-  hSetBuffering hStdOut LineBuffering
-  hSetBuffering hStdErr LineBuffering
-  forkIO (readerProc chan hStdOut filter_fn)
-  forkIO (readerProc chan hStdErr filter_fn)
-  rc <- loop chan hProcess 2 1 ExitSuccess
-  hClose hStdIn
-  hClose hStdOut
-  hClose hStdErr
-  return rc
-  where
-    -- status starts at zero, and increments each time either
-    -- a reader process gets EOF, or the build proc exits.  We wait
-    -- for all of these to happen (status==3).
-    -- ToDo: we should really have a contingency plan in case any of
-    -- the threads dies, such as a timeout.
-    loop chan hProcess 0 0 exitcode = return exitcode
-    loop chan hProcess t p exitcode = do
-      mb_code <- if p > 0
-                   then getProcessExitCode hProcess
-                   else return Nothing
-      case mb_code of
-        Just code -> loop chan hProcess t (p-1) code
-	Nothing 
-	  | t > 0 -> do 
-	      msg <- readChan chan
-              case msg of
-                BuildMsg msg -> do
-                  log_action dflags SevInfo noSrcSpan defaultUserStyle msg
-                  loop chan hProcess t p exitcode
-                BuildError loc msg -> do
-                  log_action dflags SevError (mkSrcSpan loc loc) defaultUserStyle msg
-                  loop chan hProcess t p exitcode
-                EOF ->
-                  loop chan hProcess (t-1) p exitcode
-          | otherwise -> loop chan hProcess t p exitcode
-
-readerProc chan hdl filter_fn =
-    (do str <- hGetContents hdl
-        loop (lines (filter_fn str)) Nothing) 
-    `finally`
-       writeChan chan EOF
-	-- ToDo: check errors more carefully
-	-- ToDo: in the future, the filter should be implemented as
-	-- a stream transformer.
-    where
-	loop []     Nothing    = return ()	
-	loop []     (Just err) = writeChan chan err
-	loop (l:ls) in_err     =
-		case in_err of
-		  Just err@(BuildError srcLoc msg)
-		    | leading_whitespace l -> do
-			loop ls (Just (BuildError srcLoc (msg $$ text l)))
-		    | otherwise -> do
-			writeChan chan err
-			checkError l ls
-		  Nothing -> do
-			checkError l ls
-
-	checkError l ls
-	   = case matchRegex errRegex l of
-		Nothing -> do
-		    writeChan chan (BuildMsg (text l))
-		    loop ls Nothing
-		Just (file':lineno':colno':msg:_) -> do
-		    let file   = mkFastString file'
-		        lineno = read lineno'::Int
-		        colno  = case colno' of
-		                   "" -> 0
-		                   _  -> read (init colno') :: Int
-		        srcLoc = mkSrcLoc file lineno colno
-		    loop ls (Just (BuildError srcLoc (text msg)))
-
-	leading_whitespace []    = False
-	leading_whitespace (x:_) = isSpace x
-
-errRegex = mkRegex "^([^:]*):([0-9]+):([0-9]+:)?(.*)"
-
-data BuildMessage
-  = BuildMsg   !SDoc
-  | BuildError !SrcLoc !SDoc
-  | EOF
-#endif
-
-showOpt (FileOption pre f) = pre ++ platformPath f
-showOpt (Option "") = ""
-showOpt (Option s)  = s
-
-traceCmd :: DynFlags -> String -> String -> IO () -> IO ()
--- a) trace the command (at two levels of verbosity)
--- b) don't do it at all if dry-run is set
-traceCmd dflags phase_name cmd_line action
- = do	{ let verb = verbosity dflags
-	; showPass dflags phase_name
-	; debugTraceMsg dflags 3 (text cmd_line)
-	; hFlush stderr
-	
-	   -- Test for -n flag
-	; unless (dopt Opt_DryRun dflags) $ do {
-
-	   -- And run it!
-	; action `IO.catch` handle_exn verb
-	}}
-  where
-    handle_exn verb exn = do { debugTraceMsg dflags 2 (char '\n')
-			     ; debugTraceMsg dflags 2 (ptext SLIT("Failed:") <+> text cmd_line <+> text (show exn))
-	          	     ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Support code}
-%*									*
-%************************************************************************
-
-\begin{code}
------------------------------------------------------------------------------
--- Define	getBaseDir     :: IO (Maybe String)
-
-getBaseDir :: IO (Maybe String)
-#if defined(mingw32_HOST_OS)
--- Assuming we are running ghc, accessed by path  $()/bin/ghc.exe,
--- return the path $(stuff).  Note that we drop the "bin/" directory too.
-getBaseDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
-		buf <- mallocArray len
-		ret <- getModuleFileName nullPtr buf len
-		if ret == 0 then free buf >> return Nothing
-		            else do s <- peekCString buf
-				    free buf
-				    return (Just (rootDir s))
-  where
-    rootDir s = reverse (dropList "/bin/ghc.exe" (reverse (normalisePath s)))
-
-foreign import stdcall unsafe "GetModuleFileNameA"
-  getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
-#else
-getBaseDir = return Nothing
-#endif
-
-#ifdef mingw32_HOST_OS
-foreign import ccall unsafe "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
-#elif __GLASGOW_HASKELL__ > 504
-getProcessID :: IO Int
-getProcessID = System.Posix.Internals.c_getpid >>= return . fromIntegral
-#else
-getProcessID :: IO Int
-getProcessID = Posix.getProcessID
-#endif
-
-\end{code}
diff --git a/ghc/compiler/main/TidyPgm.lhs b/ghc/compiler/main/TidyPgm.lhs
deleted file mode 100644
index 86e55f9e06..0000000000
--- a/ghc/compiler/main/TidyPgm.lhs
+++ /dev/null
@@ -1,816 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section{Tidying up Core}
-
-\begin{code}
-module TidyPgm( mkBootModDetails, tidyProgram ) where
-
-#include "HsVersions.h"
-
-import DynFlags		( DynFlag(..), dopt )
-import Packages		( HomeModules )
-import CoreSyn
-import CoreUnfold	( noUnfolding, mkTopUnfolding )
-import CoreFVs		( ruleLhsFreeIds, exprSomeFreeVars )
-import CoreTidy		( tidyExpr, tidyVarOcc, tidyRules )
-import PprCore 		( pprRules )
-import CoreLint		( showPass, endPass )
-import CoreUtils	( exprArity, rhsIsStatic )
-import VarEnv
-import VarSet
-import Var		( Id, Var )
-import Id		( idType, idInfo, idName, idCoreRules, isGlobalId,
-			  isExportedId, mkVanillaGlobal, isLocalId, isNaughtyRecordSelector,
-			  idArity, idCafInfo, idUnfolding, isImplicitId, setIdInfo
-			) 
-import IdInfo		{- loads of stuff -}
-import InstEnv		( Instance, DFunId, instanceDFunId, setInstanceDFunId )
-import NewDemand	( isBottomingSig, topSig )
-import BasicTypes	( Arity, isNeverActive )
-import Name		( Name, getOccName, nameOccName, mkInternalName,
-		  	  localiseName, isExternalName, nameSrcLoc, nameParent_maybe,
-			  isWiredInName, getName
-			)
-import NameSet		( NameSet, elemNameSet )
-import IfaceEnv		( allocateGlobalBinder )
-import NameEnv		( filterNameEnv, mapNameEnv )
-import OccName		( TidyOccEnv, initTidyOccEnv, tidyOccName )
-import Type		( tidyTopType )
-import TcType		( isFFITy )
-import DataCon		( dataConName, dataConFieldLabels, dataConWrapId_maybe )
-import TyCon		( TyCon, makeTyConAbstract, tyConDataCons, isNewTyCon, 
-			  newTyConRep, tyConSelIds, isAlgTyCon, isEnumerationTyCon )
-import Class		( classSelIds )
-import Module		( Module )
-import HscTypes		( HscEnv(..), NameCache( nsUniqs ), CgGuts(..),
-			  TypeEnv, typeEnvIds, typeEnvElts, typeEnvTyCons, 
-			  extendTypeEnvWithIds, lookupTypeEnv,
-			  ModGuts(..), TyThing(..), ModDetails(..), Dependencies(..)
-			)
-import Maybes		( orElse, mapCatMaybes )
-import ErrUtils		( showPass, dumpIfSet_core )
-import UniqSupply	( splitUniqSupply, uniqFromSupply )
-import List		( partition )
-import Maybe		( isJust )
-import Outputable
-import DATA_IOREF	( IORef, readIORef, writeIORef )
-import FastTypes  hiding ( fastOr )
-\end{code}
-
-
-Constructing the TypeEnv, Instances, Rules from which the ModIface is
-constructed, and which goes on to subsequent modules in --make mode.
-
-Most of the interface file is obtained simply by serialising the
-TypeEnv.  One important consequence is that if the *interface file*
-has pragma info if and only if the final TypeEnv does. This is not so
-important for *this* module, but it's essential for ghc --make:
-subsequent compilations must not see (e.g.) the arity if the interface
-file does not contain arity If they do, they'll exploit the arity;
-then the arity might change, but the iface file doesn't change =>
-recompilation does not happen => disaster. 
-
-For data types, the final TypeEnv will have a TyThing for the TyCon,
-plus one for each DataCon; the interface file will contain just one
-data type declaration, but it is de-serialised back into a collection
-of TyThings.
-
-%************************************************************************
-%*				 					*
-		Plan A: simpleTidyPgm
-%*				 					* 
-%************************************************************************
-
-
-Plan A: mkBootModDetails: omit pragmas, make interfaces small
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-* Ignore the bindings
-
-* Drop all WiredIn things from the TypeEnv 
-	(we never want them in interface files)
-
-* Retain all TyCons and Classes in the TypeEnv, to avoid
-	having to find which ones are mentioned in the
-	types of exported Ids
-
-* Trim off the constructors of non-exported TyCons, both
-	from the TyCon and from the TypeEnv
-
-* Drop non-exported Ids from the TypeEnv
-
-* Tidy the types of the DFunIds of Instances, 
-  make them into GlobalIds, (they already have External Names)
-  and add them to the TypeEnv
-
-* Tidy the types of the (exported) Ids in the TypeEnv,
-  make them into GlobalIds (they already have External Names)
-
-* Drop rules altogether
-
-* Tidy the bindings, to ensure that the Caf and Arity
-  information is correct for each top-level binder; the 
-  code generator needs it. And to ensure that local names have
-  distinct OccNames in case of object-file splitting
-
-\begin{code}
-mkBootModDetails :: HscEnv -> ModGuts -> IO ModDetails
--- This is Plan A: make a small type env when typechecking only,
--- or when compiling a hs-boot file, or simply when not using -O
---
--- We don't look at the bindings at all -- there aren't any
--- for hs-boot files
-
-mkBootModDetails hsc_env (ModGuts { mg_module = mod, 
-				    mg_exports = exports,
-				    mg_types = type_env, 	
-				    mg_insts = ispecs })
-  = do	{ let dflags = hsc_dflags hsc_env 
-	; showPass dflags "Tidy [hoot] type env"
-
-	; let { ispecs'   = tidyInstances tidyExternalId ispecs
-	      ; type_env1 = filterNameEnv (not . isWiredInThing) type_env
-	      ; type_env2 = mapNameEnv tidyBootThing type_env1
-	      ; type_env' = extendTypeEnvWithIds type_env2
-				(map instanceDFunId ispecs')
-	      }
-	; return (ModDetails { md_types = type_env',
-			       md_insts = ispecs',
-			       md_rules = [],
-			       md_exports = exports })
-	}
-  where
-
-isWiredInThing :: TyThing -> Bool
-isWiredInThing thing = isWiredInName (getName thing)
-
-tidyBootThing :: TyThing -> TyThing
--- Just externalise the Ids; keep everything
-tidyBootThing (AnId id) | isLocalId id = AnId (tidyExternalId id)
-tidyBootThing thing		       = thing
-
-tidyExternalId :: Id -> Id
--- Takes an LocalId with an External Name, 
--- makes it into a GlobalId with VanillaIdInfo, and tidies its type
--- (NB: vanillaIdInfo makes a conservative assumption about Caf-hood.)
-tidyExternalId id 
-  = ASSERT2( isLocalId id && isExternalName (idName id), ppr id )
-    mkVanillaGlobal (idName id) (tidyTopType (idType id)) vanillaIdInfo
-\end{code}
-
-
-%************************************************************************
-%*				 					*
-	Plan B: tidy bindings, make TypeEnv full of IdInfo
-%*				 					* 
-%************************************************************************
-
-Plan B: include pragmas, make interfaces 
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-* Figure out which Ids are externally visible
-
-* Tidy the bindings, externalising appropriate Ids
-
-* Drop all Ids from the TypeEnv, and add all the External Ids from 
-  the bindings.  (This adds their IdInfo to the TypeEnv; and adds
-  floated-out Ids that weren't even in the TypeEnv before.)
-
-Step 1: Figure out external Ids
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-First we figure out which Ids are "external" Ids.  An
-"external" Id is one that is visible from outside the compilation
-unit.  These are
-	a) the user exported ones
-	b) ones mentioned in the unfoldings, workers, 
-	   or rules of externally-visible ones 
-This exercise takes a sweep of the bindings bottom to top.  Actually,
-in Step 2 we're also going to need to know which Ids should be
-exported with their unfoldings, so we produce not an IdSet but an
-IdEnv Bool
-
-
-Step 2: Tidy the program
-~~~~~~~~~~~~~~~~~~~~~~~~
-Next we traverse the bindings top to bottom.  For each *top-level*
-binder
-
- 1. Make it into a GlobalId; its IdDetails becomes VanillaGlobal, 
-    reflecting the fact that from now on we regard it as a global, 
-    not local, Id
-
- 2. Give it a system-wide Unique.
-    [Even non-exported things need system-wide Uniques because the
-    byte-code generator builds a single Name->BCO symbol table.]
-
-    We use the NameCache kept in the HscEnv as the
-    source of such system-wide uniques.
-
-    For external Ids, use the original-name cache in the NameCache
-    to ensure that the unique assigned is the same as the Id had 
-    in any previous compilation run.
-  
- 3. If it's an external Id, make it have a External Name, otherwise
-    make it have an Internal Name.
-    This is used by the code generator to decide whether
-    to make the label externally visible
-
- 4. Give external Ids a "tidy" OccName.  This means
-    we can print them in interface files without confusing 
-    "x" (unique 5) with "x" (unique 10).
-  
- 5. Give it its UTTERLY FINAL IdInfo; in ptic, 
-  	* its unfolding, if it should have one
-	
-	* its arity, computed from the number of visible lambdas
-
-	* its CAF info, computed from what is free in its RHS
-
-		
-Finally, substitute these new top-level binders consistently
-throughout, including in unfoldings.  We also tidy binders in
-RHSs, so that they print nicely in interfaces.
-
-\begin{code}
-tidyProgram :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails)
-tidyProgram hsc_env
-	    mod_impl@(ModGuts {	mg_module = mod, mg_exports = exports, 
-				mg_types = type_env, mg_insts = insts_tc, 
-				mg_binds = binds, 
-				mg_rules = imp_rules,
-				mg_dir_imps = dir_imps, mg_deps = deps, 
-				mg_home_mods = home_mods,
-				mg_foreign = foreign_stubs })
-
-  = do	{ let dflags = hsc_dflags hsc_env
-	; showPass dflags "Tidy Core"
-
-	; let { omit_prags = dopt Opt_OmitInterfacePragmas dflags
-	      ; ext_ids = findExternalIds omit_prags binds
-	      ; ext_rules 
-		   | omit_prags = []
-		   | otherwise  = findExternalRules binds imp_rules ext_ids
-		-- findExternalRules filters imp_rules to avoid binders that 
-		-- aren't externally visible; but the externally-visible binders 
-		-- are computed (by findExternalIds) assuming that all orphan
-		-- rules are exported (they get their Exported flag set in the desugarer)
-		-- So in fact we may export more than we need. 
-		-- (It's a sort of mutual recursion.)
-  	}
-
-	; (tidy_env, tidy_binds) <- tidyTopBinds hsc_env home_mods mod type_env ext_ids binds
-
-	; let { tidy_type_env = tidyTypeEnv omit_prags exports type_env tidy_binds
-	      ; tidy_ispecs   = tidyInstances (lookup_dfun tidy_type_env) insts_tc
-		-- A DFunId will have a binding in tidy_binds, and so
-		-- will now be in final_env, replete with IdInfo
-		-- Its name will be unchanged since it was born, but
-		-- we want Global, IdInfo-rich (or not) DFunId in the tidy_ispecs
-
-	      ; tidy_rules = tidyRules tidy_env ext_rules
-		-- You might worry that the tidy_env contains IdInfo-rich stuff
-		-- and indeed it does, but if omit_prags is on, ext_rules is empty
-
-	      ; implicit_binds = getImplicitBinds type_env
-	      ; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env)
-	      }
-
-   	; endPass dflags "Tidy Core" Opt_D_dump_simpl tidy_binds
-	; dumpIfSet_core dflags Opt_D_dump_simpl
-		"Tidy Core Rules"
-		(pprRules tidy_rules)
-
-	; return (CgGuts { cg_module   = mod, 
-			   cg_tycons   = alg_tycons,
-			   cg_binds    = implicit_binds ++ tidy_binds,
-			   cg_dir_imps = dir_imps,
-			   cg_foreign  = foreign_stubs,
-			   cg_home_mods = home_mods,
-			   cg_dep_pkgs = dep_pkgs deps }, 
-
-		   ModDetails { md_types = tidy_type_env,
-				md_rules = tidy_rules,
-				md_insts = tidy_ispecs,
-				md_exports = exports })
-	}
-
-lookup_dfun type_env dfun_id
-  = case lookupTypeEnv type_env (idName dfun_id) of
-	Just (AnId dfun_id') -> dfun_id'
-	other -> pprPanic "lookup_dfun" (ppr dfun_id)
-
-tidyTypeEnv :: Bool -> NameSet -> TypeEnv -> [CoreBind] -> TypeEnv
-
--- The competed type environment is gotten from
---	Dropping any wired-in things, and then
--- 	a) keeping the types and classes
---	b) removing all Ids, 
---	c) adding Ids with correct IdInfo, including unfoldings,
---		gotten from the bindings
--- From (c) we keep only those Ids with External names;
---	    the CoreTidy pass makes sure these are all and only
---	    the externally-accessible ones
--- This truncates the type environment to include only the 
--- exported Ids and things needed from them, which saves space
-
-tidyTypeEnv omit_prags exports type_env tidy_binds
-  = let type_env1 = filterNameEnv keep_it type_env
-	type_env2 = extendTypeEnvWithIds type_env1 final_ids
-	type_env3 | omit_prags = mapNameEnv trim_thing type_env2
-		  | otherwise  = type_env2
-    in 
-    type_env3
-  where
-    final_ids  = [ id | id <- bindersOfBinds tidy_binds, 
-			isExternalName (idName id)]
-
-   	-- We keep GlobalIds, because they won't appear 
-	-- in the bindings from which final_ids are derived!
-	-- (The bindings bind LocalIds.)
-    keep_it thing | isWiredInThing thing = False
-    keep_it (AnId id) = isGlobalId id	-- Keep GlobalIds (e.g. class ops)
-    keep_it other     = True		-- Keep all TyCons, DataCons, and Classes
-
-    trim_thing thing
-	= case thing of
-	    ATyCon tc | mustExposeTyCon exports tc -> thing
-		      | otherwise -> ATyCon (makeTyConAbstract tc)
-
-	    AnId id | isImplicitId id -> thing
-		    | otherwise	      -> AnId (id `setIdInfo` vanillaIdInfo)
-
-	    other -> thing
-
-mustExposeTyCon :: NameSet	-- Exports
-		-> TyCon	-- The tycon
-		-> Bool 	-- Can its rep be hidden?
--- We are compiling without -O, and thus trying to write as little as 
--- possible into the interface file.  But we must expose the details of
--- any data types whose constructors or fields are exported
-mustExposeTyCon exports tc
-  | not (isAlgTyCon tc) 	-- Synonyms
-  = True
-  | isEnumerationTyCon tc	-- For an enumeration, exposing the constructors
-  = True			-- won't lead to the need for further exposure
-				-- (This includes data types with no constructors.)
-  | otherwise			-- Newtype, datatype
-  = any exported_con (tyConDataCons tc)
-	-- Expose rep if any datacon or field is exported
-
-  || (isNewTyCon tc && isFFITy (snd (newTyConRep tc)))
-	-- Expose the rep for newtypes if the rep is an FFI type.  
-	-- For a very annoying reason.  'Foreign import' is meant to
-	-- be able to look through newtypes transparently, but it
-	-- can only do that if it can "see" the newtype representation
-  where
-    exported_con con = any (`elemNameSet` exports) 
-			   (dataConName con : dataConFieldLabels con)
-
-tidyInstances :: (DFunId -> DFunId) -> [Instance] -> [Instance]
-tidyInstances tidy_dfun ispecs
-  = map tidy ispecs
-  where
-    tidy ispec = setInstanceDFunId ispec $
-		 tidy_dfun (instanceDFunId ispec)
-
-getImplicitBinds :: TypeEnv -> [CoreBind]
-getImplicitBinds type_env
-  = map get_defn (concatMap implicit_con_ids (typeEnvTyCons type_env)
-		  ++ concatMap other_implicit_ids (typeEnvElts type_env))
-	-- Put the constructor wrappers first, because
-	-- other implicit bindings (notably the fromT functions arising 
-	-- from generics) use the constructor wrappers.  At least that's
-	-- what External Core likes
-  where
-    implicit_con_ids tc = mapCatMaybes dataConWrapId_maybe (tyConDataCons tc)
-    
-    other_implicit_ids (ATyCon tc) = filter (not . isNaughtyRecordSelector) (tyConSelIds tc)
-	-- The "naughty" ones are not real functions at all
-	-- They are there just so we can get decent error messages
-	-- See Note  [Naughty record selectors] in MkId.lhs
-    other_implicit_ids (AClass cl) = classSelIds cl
-    other_implicit_ids other       = []
-    
-    get_defn :: Id -> CoreBind
-    get_defn id = NonRec id (tidyExpr emptyTidyEnv rhs)
-	where
-	  rhs = unfoldingTemplate (idUnfolding id)
-	-- Don't forget to tidy the body !  Otherwise you get silly things like
-	--	\ tpl -> case tpl of tpl -> (tpl,tpl) -> tpl
-\end{code}
-
-
-%************************************************************************
-%*				 					*
-\subsection{Step 1: finding externals}
-%*				 					* 
-%************************************************************************
-
-\begin{code}
-findExternalIds :: Bool
-		-> [CoreBind]
-		-> IdEnv Bool	-- In domain => external
-				-- Range = True <=> show unfolding
-	-- Step 1 from the notes above
-findExternalIds omit_prags binds
-  | omit_prags
-  = mkVarEnv [ (id,False) | id <- bindersOfBinds binds, isExportedId id ]
-
-  | otherwise
-  = foldr find emptyVarEnv binds
-  where
-    find (NonRec id rhs) needed
-	| need_id needed id = addExternal (id,rhs) needed
-	| otherwise 	    = needed
-    find (Rec prs) needed   = find_prs prs needed
-
-	-- For a recursive group we have to look for a fixed point
-    find_prs prs needed	
-	| null needed_prs = needed
-	| otherwise	  = find_prs other_prs new_needed
-	where
-	  (needed_prs, other_prs) = partition (need_pr needed) prs
-	  new_needed = foldr addExternal needed needed_prs
-
-	-- The 'needed' set contains the Ids that are needed by earlier
-	-- interface file emissions.  If the Id isn't in this set, and isn't
-	-- exported, there's no need to emit anything
-    need_id needed_set id       = id `elemVarEnv` needed_set || isExportedId id 
-    need_pr needed_set (id,rhs)	= need_id needed_set id
-
-addExternal :: (Id,CoreExpr) -> IdEnv Bool -> IdEnv Bool
--- The Id is needed; extend the needed set
--- with it and its dependents (free vars etc)
-addExternal (id,rhs) needed
-  = extendVarEnv (foldVarSet add_occ needed new_needed_ids)
-		 id show_unfold
-  where
-    add_occ id needed = extendVarEnv needed id False
-	-- "False" because we don't know we need the Id's unfolding
-	-- We'll override it later when we find the binding site
-
-    new_needed_ids = worker_ids	`unionVarSet`
-		     unfold_ids	`unionVarSet`
-		     spec_ids
-
-    idinfo	   = idInfo id
-    dont_inline	   = isNeverActive (inlinePragInfo idinfo)
-    loop_breaker   = isLoopBreaker (occInfo idinfo)
-    bottoming_fn   = isBottomingSig (newStrictnessInfo idinfo `orElse` topSig)
-    spec_ids	   = specInfoFreeVars (specInfo idinfo)
-    worker_info	   = workerInfo idinfo
-
-	-- Stuff to do with the Id's unfolding
-	-- The simplifier has put an up-to-date unfolding
-	-- in the IdInfo, but the RHS will do just as well
-    unfolding	 = unfoldingInfo idinfo
-    rhs_is_small = not (neverUnfold unfolding)
-
-	-- We leave the unfolding there even if there is a worker
-	-- In GHCI the unfolding is used by importers
-	-- When writing an interface file, we omit the unfolding 
-	-- if there is a worker
-    show_unfold = not bottoming_fn	 &&	-- Not necessary
-		  not dont_inline	 &&
-		  not loop_breaker	 &&
-		  rhs_is_small		 	-- Small enough
-
-    unfold_ids | show_unfold = exprSomeFreeVars isLocalId rhs
-	       | otherwise   = emptyVarSet
-
-    worker_ids = case worker_info of
-		   HasWorker work_id _ -> unitVarSet work_id
-		   otherwise	       -> emptyVarSet
-\end{code}
-
-
-\begin{code}
-findExternalRules :: [CoreBind]
-		  -> [CoreRule]	-- Non-local rules (i.e. ones for imported fns)
-	          -> IdEnv a	-- Ids that are exported, so we need their rules
-	          -> [CoreRule]
-  -- The complete rules are gotten by combining
-  --	a) the non-local rules
-  --	b) rules embedded in the top-level Ids
-findExternalRules binds non_local_rules ext_ids
-  = filter (not . internal_rule) (non_local_rules ++ local_rules)
-  where
-    local_rules  = [ rule
- 		   | id <- bindersOfBinds binds,
-		     id `elemVarEnv` ext_ids,
-		     rule <- idCoreRules id
-		   ]
-
-    internal_rule rule
-	=  any internal_id (varSetElems (ruleLhsFreeIds rule))
-		-- Don't export a rule whose LHS mentions a locally-defined
-		--  Id that is completely internal (i.e. not visible to an
-		-- importing module)
-
-    internal_id id = not (id `elemVarEnv` ext_ids)
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Step 2: top-level tidying}
-%*									*
-%************************************************************************
-
-
-\begin{code}
--- TopTidyEnv: when tidying we need to know
---   * nc_var: The NameCache, containing a unique supply and any pre-ordained Names.  
---	  These may have arisen because the
---	  renamer read in an interface file mentioning M.$wf, say,
---	  and assigned it unique r77.  If, on this compilation, we've
---	  invented an Id whose name is $wf (but with a different unique)
---	  we want to rename it to have unique r77, so that we can do easy
---	  comparisons with stuff from the interface file
---
---   * occ_env: The TidyOccEnv, which tells us which local occurrences 
---     are 'used'
---
---   * subst_env: A Var->Var mapping that substitutes the new Var for the old
-
-tidyTopBinds :: HscEnv
-	     -> HomeModules
-	     -> Module
-	     -> TypeEnv
-	     -> IdEnv Bool	-- Domain = Ids that should be external
-				-- True <=> their unfolding is external too
-	     -> [CoreBind]
-	     -> IO (TidyEnv, [CoreBind])
-
-tidyTopBinds hsc_env hmods mod type_env ext_ids binds
-  = tidy init_env binds
-  where
-    nc_var = hsc_NC hsc_env 
-
-	-- We also make sure to avoid any exported binders.  Consider
-	--	f{-u1-} = 1	-- Local decl
-	--	...
-	--	f{-u2-} = 2	-- Exported decl
-	--
-	-- The second exported decl must 'get' the name 'f', so we
-	-- have to put 'f' in the avoids list before we get to the first
-	-- decl.  tidyTopId then does a no-op on exported binders.
-    init_env = (initTidyOccEnv avoids, emptyVarEnv)
-    avoids   = [getOccName name | bndr <- typeEnvIds type_env,
-				  let name = idName bndr,
-				  isExternalName name]
-		-- In computing our "avoids" list, we must include
-		--	all implicit Ids
-		--	all things with global names (assigned once and for
-		--					all by the renamer)
-		-- since their names are "taken".
-		-- The type environment is a convenient source of such things.
-
-    tidy env []     = return (env, [])
-    tidy env (b:bs) = do { (env1, b')  <- tidyTopBind hmods mod nc_var ext_ids env b
-			 ; (env2, bs') <- tidy env1 bs
-			 ; return (env2, b':bs') }
-
-------------------------
-tidyTopBind  :: HomeModules
-	     -> Module
-	     -> IORef NameCache	-- For allocating new unique names
-	     -> IdEnv Bool	-- Domain = Ids that should be external
-				-- True <=> their unfolding is external too
-	     -> TidyEnv -> CoreBind
-	     -> IO (TidyEnv, CoreBind)
-
-tidyTopBind hmods mod nc_var ext_ids tidy_env1@(occ_env1,subst1) (NonRec bndr rhs)
-  = do	{ (occ_env2, name') <- tidyTopName mod nc_var ext_ids occ_env1 bndr
-	; let	{ (bndr', rhs') = tidyTopPair ext_ids tidy_env2 caf_info name' (bndr, rhs)
-		; subst2        = extendVarEnv subst1 bndr bndr'
-		; tidy_env2     = (occ_env2, subst2) }
-	; return (tidy_env2, NonRec bndr' rhs') }
-  where
-    caf_info = hasCafRefs hmods subst1 (idArity bndr) rhs
-
-tidyTopBind hmods mod nc_var ext_ids tidy_env1@(occ_env1,subst1) (Rec prs)
-  = do	{ (occ_env2, names') <- tidyTopNames mod nc_var ext_ids occ_env1 bndrs
-	; let	{ prs'      = zipWith (tidyTopPair ext_ids tidy_env2 caf_info)
-				      names' prs
-		; subst2    = extendVarEnvList subst1 (bndrs `zip` map fst prs')
-		; tidy_env2 = (occ_env2, subst2) }
-	; return (tidy_env2, Rec prs') }
-  where
-    bndrs = map fst prs
-
-	-- the CafInfo for a recursive group says whether *any* rhs in
-	-- the group may refer indirectly to a CAF (because then, they all do).
-    caf_info 
-	| or [ mayHaveCafRefs (hasCafRefs hmods subst1 (idArity bndr) rhs)
-	     | (bndr,rhs) <- prs ] = MayHaveCafRefs
-	| otherwise 		   = NoCafRefs
-
---------------------------------------------------------------------
---		tidyTopName
--- This is where we set names to local/global based on whether they really are 
--- externally visible (see comment at the top of this module).  If the name
--- was previously local, we have to give it a unique occurrence name if
--- we intend to externalise it.
-tidyTopNames mod nc_var ext_ids occ_env [] = return (occ_env, [])
-tidyTopNames mod nc_var ext_ids occ_env (id:ids)
-  = do	{ (occ_env1, name)  <- tidyTopName  mod nc_var ext_ids occ_env id
-  	; (occ_env2, names) <- tidyTopNames mod nc_var ext_ids occ_env1 ids
-	; return (occ_env2, name:names) }
-
-tidyTopName :: Module -> IORef NameCache -> VarEnv Bool -> TidyOccEnv
-	    -> Id -> IO (TidyOccEnv, Name)
-tidyTopName mod nc_var ext_ids occ_env id
-  | global && internal = return (occ_env, localiseName name)
-
-  | global && external = return (occ_env, name)
-	-- Global names are assumed to have been allocated by the renamer,
-	-- so they already have the "right" unique
-	-- And it's a system-wide unique too
-
-  -- Now we get to the real reason that all this is in the IO Monad:
-  -- we have to update the name cache in a nice atomic fashion
-
-  | local  && internal = do { nc <- readIORef nc_var
-			    ; let (nc', new_local_name) = mk_new_local nc
-			    ; writeIORef nc_var nc'
-			    ; return (occ_env', new_local_name) }
-	-- Even local, internal names must get a unique occurrence, because
-	-- if we do -split-objs we externalise the name later, in the code generator
-	--
-	-- Similarly, we must make sure it has a system-wide Unique, because
-	-- the byte-code generator builds a system-wide Name->BCO symbol table
-
-  | local  && external = do { nc <- readIORef nc_var
-			    ; let (nc', new_external_name) = mk_new_external nc
-			    ; writeIORef nc_var nc'
-			    ; return (occ_env', new_external_name) }
-  where
-    name	= idName id
-    external    = id `elemVarEnv` ext_ids
-    global	= isExternalName name
-    local	= not global
-    internal	= not external
-    mb_parent   = nameParent_maybe name
-    loc		= nameSrcLoc name
-
-    (occ_env', occ') = tidyOccName occ_env (nameOccName name)
-
-    mk_new_local nc = (nc { nsUniqs = us2 }, mkInternalName uniq occ' loc)
- 		    where
-		      (us1, us2) = splitUniqSupply (nsUniqs nc)
-		      uniq	 = uniqFromSupply us1
-
-    mk_new_external nc = allocateGlobalBinder nc mod occ' mb_parent loc
-	-- If we want to externalise a currently-local name, check
-	-- whether we have already assigned a unique for it.
-	-- If so, use it; if not, extend the table.
-	-- All this is done by allcoateGlobalBinder.
-	-- This is needed when *re*-compiling a module in GHCi; we must
-	-- use the same name for externally-visible things as we did before.
-
-
------------------------------------------------------------
-tidyTopPair :: VarEnv Bool
-	    -> TidyEnv 	-- The TidyEnv is used to tidy the IdInfo
-			-- It is knot-tied: don't look at it!
-	    -> CafInfo
-	    -> Name		-- New name
-	    -> (Id, CoreExpr) 	-- Binder and RHS before tidying
-	    -> (Id, CoreExpr)
-	-- This function is the heart of Step 2
-	-- The rec_tidy_env is the one to use for the IdInfo
-	-- It's necessary because when we are dealing with a recursive
-	-- group, a variable late in the group might be mentioned
-	-- in the IdInfo of one early in the group
-
-tidyTopPair ext_ids rhs_tidy_env caf_info name' (bndr, rhs)
-  | isGlobalId bndr 		-- Injected binding for record selector, etc
-  = (bndr, tidyExpr rhs_tidy_env rhs)
-  | otherwise
-  = (bndr', rhs')
-  where
-    bndr'   = mkVanillaGlobal name' ty' idinfo'
-    ty'	    = tidyTopType (idType bndr)
-    rhs'    = tidyExpr rhs_tidy_env rhs
-    idinfo' = tidyTopIdInfo rhs_tidy_env (isJust maybe_external)
-			    (idInfo bndr) unfold_info arity
-			    caf_info
-
-    -- Expose an unfolding if ext_ids tells us to
-    -- Remember that ext_ids maps an Id to a Bool: 
-    --	True to show the unfolding, False to hide it
-    maybe_external = lookupVarEnv ext_ids bndr
-    show_unfold = maybe_external `orElse` False
-    unfold_info | show_unfold = mkTopUnfolding rhs'
-		| otherwise   = noUnfolding
-
-    -- Usually the Id will have an accurate arity on it, because
-    -- the simplifier has just run, but not always. 
-    -- One case I found was when the last thing the simplifier
-    -- did was to let-bind a non-atomic argument and then float
-    -- it to the top level. So it seems more robust just to
-    -- fix it here.
-    arity = exprArity rhs
-
-
--- tidyTopIdInfo creates the final IdInfo for top-level
--- binders.  There are two delicate pieces:
---
---  * Arity.  After CoreTidy, this arity must not change any more.
---	Indeed, CorePrep must eta expand where necessary to make
---	the manifest arity equal to the claimed arity.
---
---  * CAF info.  This must also remain valid through to code generation.
--- 	We add the info here so that it propagates to all
--- 	occurrences of the binders in RHSs, and hence to occurrences in
--- 	unfoldings, which are inside Ids imported by GHCi. Ditto RULES.
---	CoreToStg makes use of this when constructing SRTs.
-
-tidyTopIdInfo tidy_env is_external idinfo unfold_info arity caf_info
-  | not is_external	-- For internal Ids (not externally visible)
-  = vanillaIdInfo	-- we only need enough info for code generation
-			-- Arity and strictness info are enough;
-			--	c.f. CoreTidy.tidyLetBndr
-	`setCafInfo` 	       caf_info
-	`setArityInfo`	       arity
-	`setAllStrictnessInfo` newStrictnessInfo idinfo
-
-  | otherwise		-- Externally-visible Ids get the whole lot
-  = vanillaIdInfo
-	`setCafInfo` 	       caf_info
-	`setArityInfo`	       arity
-	`setAllStrictnessInfo` newStrictnessInfo idinfo
-	`setInlinePragInfo`    inlinePragInfo idinfo
-	`setUnfoldingInfo`     unfold_info
-	`setWorkerInfo`	       tidyWorker tidy_env (workerInfo idinfo)
-		-- NB: we throw away the Rules
-		-- They have already been extracted by findExternalRules
-
-
-
-------------  Worker  --------------
-tidyWorker tidy_env (HasWorker work_id wrap_arity) 
-  = HasWorker (tidyVarOcc tidy_env work_id) wrap_arity
-tidyWorker tidy_env other
-  = NoWorker
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Figuring out CafInfo for an expression}
-%*									*
-%************************************************************************
-
-hasCafRefs decides whether a top-level closure can point into the dynamic heap.
-We mark such things as `MayHaveCafRefs' because this information is
-used to decide whether a particular closure needs to be referenced
-in an SRT or not.
-
-There are two reasons for setting MayHaveCafRefs:
-	a) The RHS is a CAF: a top-level updatable thunk.
-	b) The RHS refers to something that MayHaveCafRefs
-
-Possible improvement: In an effort to keep the number of CAFs (and 
-hence the size of the SRTs) down, we could also look at the expression and 
-decide whether it requires a small bounded amount of heap, so we can ignore 
-it as a CAF.  In these cases however, we would need to use an additional
-CAF list to keep track of non-collectable CAFs.  
-
-\begin{code}
-hasCafRefs  :: HomeModules -> VarEnv Var -> Arity -> CoreExpr -> CafInfo
-hasCafRefs hmods p arity expr 
-  | is_caf || mentions_cafs = MayHaveCafRefs
-  | otherwise 		    = NoCafRefs
- where
-  mentions_cafs = isFastTrue (cafRefs p expr)
-  is_caf = not (arity > 0 || rhsIsStatic hmods expr)
-  -- NB. we pass in the arity of the expression, which is expected
-  -- to be calculated by exprArity.  This is because exprArity
-  -- knows how much eta expansion is going to be done by 
-  -- CorePrep later on, and we don't want to duplicate that
-  -- knowledge in rhsIsStatic below.
-
-cafRefs p (Var id)
-	-- imported Ids first:
-  | not (isLocalId id) = fastBool (mayHaveCafRefs (idCafInfo id))
-	-- now Ids local to this module:
-  | otherwise =
-     case lookupVarEnv p id of
-	Just id' -> fastBool (mayHaveCafRefs (idCafInfo id'))
-	Nothing  -> fastBool False
-
-cafRefs p (Lit l) 	       = fastBool False
-cafRefs p (App f a) 	       = fastOr (cafRefs p f) (cafRefs p) a
-cafRefs p (Lam x e) 	       = cafRefs p e
-cafRefs p (Let b e) 	       = fastOr (cafRefss p (rhssOfBind b)) (cafRefs p) e
-cafRefs p (Case e bndr _ alts) = fastOr (cafRefs p e) (cafRefss p) (rhssOfAlts alts)
-cafRefs p (Note n e) 	       = cafRefs p e
-cafRefs p (Type t) 	       = fastBool False
-
-cafRefss p [] 	  = fastBool False
-cafRefss p (e:es) = fastOr (cafRefs p e) (cafRefss p) es
-
--- hack for lazy-or over FastBool.
-fastOr a f x = fastBool (isFastTrue a || isFastTrue (f x))
-\end{code}
diff --git a/ghc/compiler/nativeGen/AsmCodeGen.lhs b/ghc/compiler/nativeGen/AsmCodeGen.lhs
deleted file mode 100644
index 1576162167..0000000000
--- a/ghc/compiler/nativeGen/AsmCodeGen.lhs
+++ /dev/null
@@ -1,545 +0,0 @@
--- -----------------------------------------------------------------------------
---
--- (c) The University of Glasgow 1993-2004
--- 
--- This is the top-level module in the native code generator.
---
--- -----------------------------------------------------------------------------
-
-\begin{code}
-module AsmCodeGen ( nativeCodeGen ) where
-
-#include "HsVersions.h"
-#include "NCG.h"
-
-import MachInstrs
-import MachRegs
-import MachCodeGen
-import PprMach
-import RegisterAlloc
-import RegAllocInfo	( jumpDests )
-import NCGMonad
-import PositionIndependentCode
-
-import Cmm
-import CmmOpt		( cmmMiniInline, cmmMachOpFold )
-import PprCmm		( pprStmt, pprCmms )
-import MachOp
-import CLabel           ( CLabel, mkSplitMarkerLabel, mkAsmTempLabel )
-#if powerpc_TARGET_ARCH
-import CLabel           ( mkRtsCodeLabel )
-#endif
-
-import UniqFM
-import Unique		( Unique, getUnique )
-import UniqSupply
-import FastTypes
-import List		( groupBy, sortBy )
-import CLabel           ( pprCLabel )
-import ErrUtils		( dumpIfSet_dyn )
-import DynFlags		( DynFlags, DynFlag(..), dopt )
-import StaticFlags	( opt_Static, opt_PIC )
-
-import Digraph
-import qualified Pretty
-import Outputable
-import FastString
-
--- DEBUGGING ONLY
---import OrdList
-
-#ifdef NCG_DEBUG
-import List		( intersperse )
-#endif
-
-import DATA_INT
-import DATA_WORD
-import DATA_BITS
-import GLAEXTS
-
-{-
-The native-code generator has machine-independent and
-machine-dependent modules.
-
-This module ("AsmCodeGen") is the top-level machine-independent
-module.  Before entering machine-dependent land, we do some
-machine-independent optimisations (defined below) on the
-'CmmStmts's.
-
-We convert to the machine-specific 'Instr' datatype with
-'cmmCodeGen', assuming an infinite supply of registers.  We then use
-a machine-independent register allocator ('regAlloc') to rejoin
-reality.  Obviously, 'regAlloc' has machine-specific helper
-functions (see about "RegAllocInfo" below).
-
-Finally, we order the basic blocks of the function so as to minimise
-the number of jumps between blocks, by utilising fallthrough wherever
-possible.
-
-The machine-dependent bits break down as follows:
-
-  * ["MachRegs"]  Everything about the target platform's machine
-    registers (and immediate operands, and addresses, which tend to
-    intermingle/interact with registers).
-
-  * ["MachInstrs"]  Includes the 'Instr' datatype (possibly should
-    have a module of its own), plus a miscellany of other things
-    (e.g., 'targetDoubleSize', 'smStablePtrTable', ...)
-
-  * ["MachCodeGen"]  is where 'Cmm' stuff turns into
-    machine instructions.
-
-  * ["PprMach"] 'pprInstr' turns an 'Instr' into text (well, really
-    a 'Doc').
-
-  * ["RegAllocInfo"] In the register allocator, we manipulate
-    'MRegsState's, which are 'BitSet's, one bit per machine register.
-    When we want to say something about a specific machine register
-    (e.g., ``it gets clobbered by this instruction''), we set/unset
-    its bit.  Obviously, we do this 'BitSet' thing for efficiency
-    reasons.
-
-    The 'RegAllocInfo' module collects together the machine-specific
-    info needed to do register allocation.
-
-   * ["RegisterAlloc"] The (machine-independent) register allocator.
--}
-
--- -----------------------------------------------------------------------------
--- Top-level of the native codegen
-
--- NB. We *lazilly* compile each block of code for space reasons.
-
-nativeCodeGen :: DynFlags -> [Cmm] -> UniqSupply -> IO Pretty.Doc
-nativeCodeGen dflags cmms us
-  = let (res, _) = initUs us $
-	   cgCmm (concat (map add_split cmms))
-
-	cgCmm :: [CmmTop] -> UniqSM (Cmm, Pretty.Doc, [CLabel])
-	cgCmm tops = 
-	   lazyMapUs (cmmNativeGen dflags) tops  `thenUs` \ results -> 
-	   case unzip3 results of { (cmms,docs,imps) ->
-	   returnUs (Cmm cmms, my_vcat docs, concat imps)
-	   }
-    in 
-    case res of { (ppr_cmms, insn_sdoc, imports) -> do
-    dumpIfSet_dyn dflags Opt_D_dump_opt_cmm "Optimised Cmm" (pprCmms [ppr_cmms])
-    return (insn_sdoc Pretty.$$ dyld_stubs imports
-#if HAVE_SUBSECTIONS_VIA_SYMBOLS
-                -- On recent versions of Darwin, the linker supports
-                -- dead-stripping of code and data on a per-symbol basis.
-                -- There's a hack to make this work in PprMach.pprNatCmmTop.
-            Pretty.$$ Pretty.text ".subsections_via_symbols"
-#endif
-            )
-   }
-
-  where
-
-    add_split (Cmm tops)
-	| dopt Opt_SplitObjs dflags = split_marker : tops
-	| otherwise		    = tops
-
-    split_marker = CmmProc [] mkSplitMarkerLabel [] []
-
-     	 -- Generate "symbol stubs" for all external symbols that might
-	 -- come from a dynamic library.
-{-    dyld_stubs imps = Pretty.vcat $ map pprDyldSymbolStub $
-				    map head $ group $ sort imps-}
-				    
-	-- (Hack) sometimes two Labels pretty-print the same, but have
-	-- different uniques; so we compare their text versions...
-    dyld_stubs imps 
-        | needImportedSymbols
-          = Pretty.vcat $
-            (pprGotDeclaration :) $
-            map (pprImportedSymbol . fst . head) $
-            groupBy (\(_,a) (_,b) -> a == b) $
-            sortBy (\(_,a) (_,b) -> compare a b) $
-            map doPpr $
-            imps
-        | otherwise
-          = Pretty.empty
-        
-        where doPpr lbl = (lbl, Pretty.render $ pprCLabel lbl astyle)
-              astyle = mkCodeStyle AsmStyle
-
-#ifndef NCG_DEBUG
-    my_vcat sds = Pretty.vcat sds
-#else
-    my_vcat sds = Pretty.vcat (
-                      intersperse (
-                         Pretty.char ' ' 
-                            Pretty.$$ Pretty.ptext SLIT("# ___ncg_debug_marker")
-                            Pretty.$$ Pretty.char ' '
-                      ) 
-                      sds
-                   )
-#endif
-
-
--- Complete native code generation phase for a single top-level chunk
--- of Cmm.
-
-cmmNativeGen :: DynFlags -> CmmTop -> UniqSM (CmmTop, Pretty.Doc, [CLabel])
-cmmNativeGen dflags cmm
-   = {-# SCC "fixAssigns"       #-} 
- 	fixAssignsTop cmm	     `thenUs` \ fixed_cmm ->
-     {-# SCC "genericOpt"       #-} 
-	cmmToCmm fixed_cmm           `bind`   \ (cmm, imports) ->
-        (if dopt Opt_D_dump_opt_cmm dflags  -- space leak avoidance
-	   then cmm 
-	   else CmmData Text [])     `bind`   \ ppr_cmm ->
-     {-# SCC "genMachCode"      #-}
-	genMachCode cmm              `thenUs` \ (pre_regalloc, lastMinuteImports) ->
-     {-# SCC "regAlloc"         #-}
-	mapUs regAlloc pre_regalloc `thenUs`   \ with_regs ->
-     {-# SCC "sequenceBlocks"   #-}
-	map sequenceTop with_regs    `bind`   \ sequenced ->
-     {-# SCC "x86fp_kludge"     #-}
-	map x86fp_kludge sequenced   `bind`   \ final_mach_code ->
-     {-# SCC "vcat"             #-}
-	Pretty.vcat (map pprNatCmmTop final_mach_code)  `bind`   \ final_sdoc ->
-
-        returnUs (ppr_cmm, final_sdoc Pretty.$$ Pretty.text "", lastMinuteImports ++ imports)
-     where
-        x86fp_kludge :: NatCmmTop -> NatCmmTop
-        x86fp_kludge top@(CmmData _ _) = top
-#if i386_TARGET_ARCH
-        x86fp_kludge top@(CmmProc info lbl params code) = 
-		CmmProc info lbl params (map bb_i386_insert_ffrees code)
-		where
-		  bb_i386_insert_ffrees (BasicBlock id instrs) =
-			BasicBlock id (i386_insert_ffrees instrs)
-#else
-        x86fp_kludge top =  top
-#endif
-
--- -----------------------------------------------------------------------------
--- Sequencing the basic blocks
-
--- Cmm BasicBlocks are self-contained entities: they always end in a
--- jump, either non-local or to another basic block in the same proc.
--- In this phase, we attempt to place the basic blocks in a sequence
--- such that as many of the local jumps as possible turn into
--- fallthroughs.
-
-sequenceTop :: NatCmmTop -> NatCmmTop
-sequenceTop top@(CmmData _ _) = top
-sequenceTop (CmmProc info lbl params blocks) = 
-  CmmProc info lbl params (sequenceBlocks blocks)
-
--- The algorithm is very simple (and stupid): we make a graph out of
--- the blocks where there is an edge from one block to another iff the
--- first block ends by jumping to the second.  Then we topologically
--- sort this graph.  Then traverse the list: for each block, we first
--- output the block, then if it has an out edge, we move the
--- destination of the out edge to the front of the list, and continue.
-
-sequenceBlocks :: [NatBasicBlock] -> [NatBasicBlock]
-sequenceBlocks [] = []
-sequenceBlocks (entry:blocks) = 
-  seqBlocks (mkNode entry : reverse (flattenSCCs (sccBlocks blocks)))
-  -- the first block is the entry point ==> it must remain at the start.
-
-sccBlocks :: [NatBasicBlock] -> [SCC (NatBasicBlock,Unique,[Unique])]
-sccBlocks blocks = stronglyConnCompR (map mkNode blocks)
-
-getOutEdges :: [Instr] -> [Unique]
-getOutEdges instrs = case jumpDests (last instrs) [] of
-			[one] -> [getUnique one]
-			_many -> []
-		-- we're only interested in the last instruction of
-		-- the block, and only if it has a single destination.
-
-mkNode block@(BasicBlock id instrs) = (block, getUnique id, getOutEdges instrs)
-
-seqBlocks [] = []
-seqBlocks ((block,_,[]) : rest)
-  = block : seqBlocks rest
-seqBlocks ((block@(BasicBlock id instrs),_,[next]) : rest)
-  | can_fallthrough = BasicBlock id (init instrs) : seqBlocks rest'
-  | otherwise       = block : seqBlocks rest'
-  where
-	(can_fallthrough, rest') = reorder next [] rest
-	  -- TODO: we should do a better job for cycles; try to maximise the
-	  -- fallthroughs within a loop.
-seqBlocks _ = panic "AsmCodegen:seqBlocks"
-
-reorder id accum [] = (False, reverse accum)
-reorder id accum (b@(block,id',out) : rest)
-  | id == id'  = (True, (block,id,out) : reverse accum ++ rest)
-  | otherwise  = reorder id (b:accum) rest
-
--- -----------------------------------------------------------------------------
--- Instruction selection
-
--- Native code instruction selection for a chunk of stix code.  For
--- this part of the computation, we switch from the UniqSM monad to
--- the NatM monad.  The latter carries not only a Unique, but also an
--- Int denoting the current C stack pointer offset in the generated
--- code; this is needed for creating correct spill offsets on
--- architectures which don't offer, or for which it would be
--- prohibitively expensive to employ, a frame pointer register.  Viz,
--- x86.
-
--- The offset is measured in bytes, and indicates the difference
--- between the current (simulated) C stack-ptr and the value it was at
--- the beginning of the block.  For stacks which grow down, this value
--- should be either zero or negative.
-
--- Switching between the two monads whilst carrying along the same
--- Unique supply breaks abstraction.  Is that bad?
-
-genMachCode :: CmmTop -> UniqSM ([NatCmmTop], [CLabel])
-
-genMachCode cmm_top initial_us
-  = let initial_st             = mkNatM_State initial_us 0
-        (new_tops, final_st)   = initNat initial_st (cmmTopCodeGen cmm_top)
-        final_us               = natm_us final_st
-        final_delta            = natm_delta final_st
-	final_imports          = natm_imports final_st
-    in
-        if   final_delta == 0
-        then ((new_tops, final_imports), final_us)
-        else pprPanic "genMachCode: nonzero final delta"
-                      (int final_delta)
-
--- -----------------------------------------------------------------------------
--- Fixup assignments to global registers so that they assign to 
--- locations within the RegTable, if appropriate.
-
--- Note that we currently don't fixup reads here: they're done by
--- the generic optimiser below, to avoid having two separate passes
--- over the Cmm.
-
-fixAssignsTop :: CmmTop -> UniqSM CmmTop
-fixAssignsTop top@(CmmData _ _) = returnUs top
-fixAssignsTop (CmmProc info lbl params blocks) =
-  mapUs fixAssignsBlock blocks `thenUs` \ blocks' ->
-  returnUs (CmmProc info lbl params blocks')
-
-fixAssignsBlock :: CmmBasicBlock -> UniqSM CmmBasicBlock
-fixAssignsBlock (BasicBlock id stmts) =
-  fixAssigns stmts `thenUs` \ stmts' ->
-  returnUs (BasicBlock id stmts')
-
-fixAssigns :: [CmmStmt] -> UniqSM [CmmStmt]
-fixAssigns stmts =
-  mapUs fixAssign stmts `thenUs` \ stmtss ->
-  returnUs (concat stmtss)
-
-fixAssign :: CmmStmt -> UniqSM [CmmStmt]
-fixAssign (CmmAssign (CmmGlobal BaseReg) src)
-   = panic "cmmStmtConFold: assignment to BaseReg";
-
-fixAssign (CmmAssign (CmmGlobal reg) src)
-  | Left  realreg <- reg_or_addr
-  = returnUs [CmmAssign (CmmGlobal reg) src]
-  | Right baseRegAddr <- reg_or_addr
-  = returnUs [CmmStore baseRegAddr src]
-           -- Replace register leaves with appropriate StixTrees for
-           -- the given target. GlobalRegs which map to a reg on this
-           -- arch are left unchanged.  Assigning to BaseReg is always
-           -- illegal, so we check for that.
-  where
-	reg_or_addr = get_GlobalReg_reg_or_addr reg
-
-fixAssign (CmmCall target results args vols)
-  = mapAndUnzipUs fixResult results `thenUs` \ (results',stores) ->
-    returnUs (caller_save ++
-	      CmmCall target results' args vols :
-	      caller_restore ++
-	      concat stores)
-  where
-	-- we also save/restore any caller-saves STG registers here
-	(caller_save, caller_restore) = callerSaveVolatileRegs vols
-
-	fixResult g@(CmmGlobal reg,hint) = 
-	  case get_GlobalReg_reg_or_addr reg of
-		Left realreg -> returnUs (g, [])
-		Right baseRegAddr ->
-		    getUniqueUs `thenUs` \ uq ->
-		    let local = CmmLocal (LocalReg uq (globalRegRep reg)) in
-		    returnUs ((local,hint), 
-			      [CmmStore baseRegAddr (CmmReg local)])
-	fixResult other =
-	  returnUs (other,[])
-
-fixAssign other_stmt = returnUs [other_stmt]
-
--- -----------------------------------------------------------------------------
--- Generic Cmm optimiser
-
-{-
-Here we do:
-
-  (a) Constant folding
-  (b) Simple inlining: a temporary which is assigned to and then
-      used, once, can be shorted.
-  (c) Replacement of references to GlobalRegs which do not have
-      machine registers by the appropriate memory load (eg.
-      Hp ==>  *(BaseReg + 34) ).
-  (d) Position independent code and dynamic linking
-        (i)  introduce the appropriate indirections
-             and position independent refs
-        (ii) compile a list of imported symbols
-
-Ideas for other things we could do (ToDo):
-
-  - shortcut jumps-to-jumps
-  - eliminate dead code blocks
-  - simple CSE: if an expr is assigned to a temp, then replace later occs of
-    that expr with the temp, until the expr is no longer valid (can push through
-    temp assignments, and certain assigns to mem...)
--}
-
-cmmToCmm :: CmmTop -> (CmmTop, [CLabel])
-cmmToCmm top@(CmmData _ _) = (top, [])
-cmmToCmm (CmmProc info lbl params blocks) = runCmmOpt $ do
-  blocks' <- mapM cmmBlockConFold (cmmMiniInline blocks)
-  return $ CmmProc info lbl params blocks'
-
-newtype CmmOptM a = CmmOptM ([CLabel] -> (# a, [CLabel] #))
-
-instance Monad CmmOptM where
-  return x = CmmOptM $ \imports -> (# x,imports #)
-  (CmmOptM f) >>= g =
-    CmmOptM $ \imports ->
-                case f imports of
-                  (# x, imports' #) ->
-                    case g x of
-                      CmmOptM g' -> g' imports'
-
-addImportCmmOpt :: CLabel -> CmmOptM ()
-addImportCmmOpt lbl = CmmOptM $ \imports -> (# (), lbl:imports #)
-
-runCmmOpt :: CmmOptM a -> (a, [CLabel])
-runCmmOpt (CmmOptM f) = case f [] of
-                        (# result, imports #) -> (result, imports)
-
-cmmBlockConFold :: CmmBasicBlock -> CmmOptM CmmBasicBlock
-cmmBlockConFold (BasicBlock id stmts) = do
-  stmts' <- mapM cmmStmtConFold stmts
-  return $ BasicBlock id stmts'
-
-cmmStmtConFold stmt
-   = case stmt of
-        CmmAssign reg src
-           -> do src' <- cmmExprConFold False src
-                 return $ case src' of
-		   CmmReg reg' | reg == reg' -> CmmNop
-		   new_src -> CmmAssign reg new_src
-
-        CmmStore addr src
-           -> do addr' <- cmmExprConFold False addr
-                 src'  <- cmmExprConFold False src
-                 return $ CmmStore addr' src'
-
-        CmmJump addr regs
-           -> do addr' <- cmmExprConFold True addr
-                 return $ CmmJump addr' regs
-
-	CmmCall target regs args vols
-	   -> do target' <- case target of
-			      CmmForeignCall e conv -> do
-			        e' <- cmmExprConFold True e
-			        return $ CmmForeignCall e' conv
-			      other -> return other
-                 args' <- mapM (\(arg, hint) -> do
-                                  arg' <- cmmExprConFold False arg
-                                  return (arg', hint)) args
-	         return $ CmmCall target' regs args' vols
-
-        CmmCondBranch test dest
-           -> do test' <- cmmExprConFold False test
-	         return $ case test' of
-		   CmmLit (CmmInt 0 _) -> 
-		     CmmComment (mkFastString ("deleted: " ++ 
-					showSDoc (pprStmt stmt)))
-
-		   CmmLit (CmmInt n _) -> CmmBranch dest
-		   other -> CmmCondBranch test' dest
-
-	CmmSwitch expr ids
-	   -> do expr' <- cmmExprConFold False expr
-	         return $ CmmSwitch expr' ids
-
-        other
-           -> return other
-
-
-cmmExprConFold isJumpTarget expr
-   = case expr of
-        CmmLoad addr rep
-           -> do addr' <- cmmExprConFold False addr
-                 return $ CmmLoad addr' rep
-
-        CmmMachOp mop args
-           -- For MachOps, we first optimize the children, and then we try 
-           -- our hand at some constant-folding.
-           -> do args' <- mapM (cmmExprConFold False) args
-                 return $ cmmMachOpFold mop args'
-
-        CmmLit (CmmLabel lbl)
-           -> cmmMakeDynamicReference addImportCmmOpt isJumpTarget lbl
-        CmmLit (CmmLabelOff lbl off)
-           -> do dynRef <- cmmMakeDynamicReference addImportCmmOpt isJumpTarget lbl
-                 return $ cmmMachOpFold (MO_Add wordRep) [
-                     dynRef,
-                     (CmmLit $ CmmInt (fromIntegral off) wordRep)
-                   ]
-
-#if powerpc_TARGET_ARCH
-           -- On powerpc (non-PIC), it's easier to jump directly to a label than
-           -- to use the register table, so we replace these registers
-           -- with the corresponding labels:
-        CmmReg (CmmGlobal GCEnter1)
-          | not opt_PIC
-          -> cmmExprConFold isJumpTarget $
-             CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "__stg_gc_enter_1"))) 
-        CmmReg (CmmGlobal GCFun)
-          | not opt_PIC
-          -> cmmExprConFold isJumpTarget $
-             CmmLit (CmmLabel (mkRtsCodeLabel SLIT( "__stg_gc_fun")))
-#endif
-
-        CmmReg (CmmGlobal mid)
-           -- Replace register leaves with appropriate StixTrees for
-           -- the given target.  MagicIds which map to a reg on this
-           -- arch are left unchanged.  For the rest, BaseReg is taken
-           -- to mean the address of the reg table in MainCapability,
-           -- and for all others we generate an indirection to its
-           -- location in the register table.
-           -> case get_GlobalReg_reg_or_addr mid of
-                 Left  realreg -> return expr
-                 Right baseRegAddr 
-                    -> case mid of 
-                          BaseReg -> cmmExprConFold False baseRegAddr
-                          other   -> cmmExprConFold False (CmmLoad baseRegAddr 
-							(globalRegRep mid))
-	   -- eliminate zero offsets
-	CmmRegOff reg 0
-	   -> cmmExprConFold False (CmmReg reg)
-
-        CmmRegOff (CmmGlobal mid) offset
-           -- RegOf leaves are just a shorthand form. If the reg maps
-           -- to a real reg, we keep the shorthand, otherwise, we just
-           -- expand it and defer to the above code. 
-           -> case get_GlobalReg_reg_or_addr mid of
-                Left  realreg -> return expr
-                Right baseRegAddr
-                   -> cmmExprConFold False (CmmMachOp (MO_Add wordRep) [
-                                        CmmReg (CmmGlobal mid),
-                                        CmmLit (CmmInt (fromIntegral offset)
-                                                       wordRep)])
-        other
-           -> return other
-
--- -----------------------------------------------------------------------------
--- Utils
-
-bind f x = x $! f
-
-\end{code}
-
diff --git a/ghc/compiler/nativeGen/MachCodeGen.hs b/ghc/compiler/nativeGen/MachCodeGen.hs
deleted file mode 100644
index 90ce6b5bf8..0000000000
--- a/ghc/compiler/nativeGen/MachCodeGen.hs
+++ /dev/null
@@ -1,4654 +0,0 @@
------------------------------------------------------------------------------
---
--- Generating machine code (instruction selection)
---
--- (c) The University of Glasgow 1996-2004
---
------------------------------------------------------------------------------
-
--- This is a big module, but, if you pay attention to
--- (a) the sectioning, (b) the type signatures, and
--- (c) the #if blah_TARGET_ARCH} things, the
--- structure should not be too overwhelming.
-
-module MachCodeGen ( cmmTopCodeGen, InstrBlock ) where
-
-#include "HsVersions.h"
-#include "nativeGen/NCG.h"
-#include "MachDeps.h"
-
--- NCG stuff:
-import MachInstrs
-import MachRegs
-import NCGMonad
-import PositionIndependentCode ( cmmMakeDynamicReference, initializePicBase )
-import RegAllocInfo ( mkBranchInstr )
-
--- Our intermediate code:
-import PprCmm		( pprExpr )
-import Cmm
-import MachOp
-import CLabel
-
--- The rest:
-import StaticFlags	( opt_PIC )
-import ForeignCall	( CCallConv(..) )
-import OrdList
-import Pretty
-import Outputable
-import FastString
-import FastTypes	( isFastTrue )
-import Constants	( wORD_SIZE )
-
-#ifdef DEBUG
-import Outputable	( assertPanic )
-import TRACE		( trace )
-#endif
-
-import Control.Monad	( mapAndUnzipM )
-import Maybe		( fromJust )
-import DATA_BITS
-import DATA_WORD
-
--- -----------------------------------------------------------------------------
--- Top-level of the instruction selector
-
--- | 'InstrBlock's are the insn sequences generated by the insn selectors.
--- They are really trees of insns to facilitate fast appending, where a
--- left-to-right traversal (pre-order?) yields the insns in the correct
--- order.
-
-type InstrBlock = OrdList Instr
-
-cmmTopCodeGen :: CmmTop -> NatM [NatCmmTop]
-cmmTopCodeGen (CmmProc info lab params blocks) = do
-  (nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
-  picBaseMb <- getPicBaseMaybeNat
-  let proc = CmmProc info lab params (concat nat_blocks)
-      tops = proc : concat statics
-  case picBaseMb of
-      Just picBase -> initializePicBase picBase tops
-      Nothing -> return tops
-  
-cmmTopCodeGen (CmmData sec dat) = do
-  return [CmmData sec dat]  -- no translation, we just use CmmStatic
-
-basicBlockCodeGen :: CmmBasicBlock -> NatM ([NatBasicBlock],[NatCmmTop])
-basicBlockCodeGen (BasicBlock id stmts) = do
-  instrs <- stmtsToInstrs stmts
-  -- code generation may introduce new basic block boundaries, which
-  -- are indicated by the NEWBLOCK instruction.  We must split up the
-  -- instruction stream into basic blocks again.  Also, we extract
-  -- LDATAs here too.
-  let
-	(top,other_blocks,statics) = foldrOL mkBlocks ([],[],[]) instrs
-	
-	mkBlocks (NEWBLOCK id) (instrs,blocks,statics) 
-	  = ([], BasicBlock id instrs : blocks, statics)
-	mkBlocks (LDATA sec dat) (instrs,blocks,statics) 
-	  = (instrs, blocks, CmmData sec dat:statics)
-	mkBlocks instr (instrs,blocks,statics)
-	  = (instr:instrs, blocks, statics)
-  -- in
-  return (BasicBlock id top : other_blocks, statics)
-
-stmtsToInstrs :: [CmmStmt] -> NatM InstrBlock
-stmtsToInstrs stmts
-   = do instrss <- mapM stmtToInstrs stmts
-        return (concatOL instrss)
-
-stmtToInstrs :: CmmStmt -> NatM InstrBlock
-stmtToInstrs stmt = case stmt of
-    CmmNop	   -> return nilOL
-    CmmComment s   -> return (unitOL (COMMENT s))
-
-    CmmAssign reg src
-      | isFloatingRep kind -> assignReg_FltCode kind reg src
-#if WORD_SIZE_IN_BITS==32
-      | kind == I64 	   -> assignReg_I64Code      reg src
-#endif
-      | otherwise	   -> assignReg_IntCode kind reg src
-	where kind = cmmRegRep reg
-
-    CmmStore addr src
-      | isFloatingRep kind -> assignMem_FltCode kind addr src
-#if WORD_SIZE_IN_BITS==32
-      | kind == I64 	 -> assignMem_I64Code      addr src
-#endif
-      | otherwise	 -> assignMem_IntCode kind addr src
-	where kind = cmmExprRep src
-
-    CmmCall target result_regs args vols
-       -> genCCall target result_regs args vols
-
-    CmmBranch id	  -> genBranch id
-    CmmCondBranch arg id  -> genCondJump id arg
-    CmmSwitch arg ids     -> genSwitch arg ids
-    CmmJump arg params	  -> genJump arg
-
--- -----------------------------------------------------------------------------
--- General things for putting together code sequences
-
--- Expand CmmRegOff.  ToDo: should we do it this way around, or convert
--- CmmExprs into CmmRegOff?
-mangleIndexTree :: CmmExpr -> CmmExpr
-mangleIndexTree (CmmRegOff reg off)
-  = CmmMachOp (MO_Add rep) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) rep)]
-  where rep = cmmRegRep reg
-
--- -----------------------------------------------------------------------------
---  Code gen for 64-bit arithmetic on 32-bit platforms
-
-{-
-Simple support for generating 64-bit code (ie, 64 bit values and 64
-bit assignments) on 32-bit platforms.  Unlike the main code generator
-we merely shoot for generating working code as simply as possible, and
-pay little attention to code quality.  Specifically, there is no
-attempt to deal cleverly with the fixed-vs-floating register
-distinction; all values are generated into (pairs of) floating
-registers, even if this would mean some redundant reg-reg moves as a
-result.  Only one of the VRegUniques is returned, since it will be
-of the VRegUniqueLo form, and the upper-half VReg can be determined
-by applying getHiVRegFromLo to it.
--}
-
-data ChildCode64 	-- a.k.a "Register64"
-   = ChildCode64 
-        InstrBlock 	-- code
-        Reg	 	-- the lower 32-bit temporary which contains the
-			-- result; use getHiVRegFromLo to find the other
-			-- VRegUnique.  Rules of this simplified insn
-			-- selection game are therefore that the returned
-			-- Reg may be modified
-
-#if WORD_SIZE_IN_BITS==32
-assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock
-assignReg_I64Code :: CmmReg  -> CmmExpr -> NatM InstrBlock
-#endif
-
-#ifndef x86_64_TARGET_ARCH
-iselExpr64        :: CmmExpr -> NatM ChildCode64
-#endif
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if i386_TARGET_ARCH
-
-assignMem_I64Code addrTree valueTree = do
-  Amode addr addr_code <- getAmode addrTree
-  ChildCode64 vcode rlo <- iselExpr64 valueTree
-  let 
-        rhi = getHiVRegFromLo rlo
-
-        -- Little-endian store
-        mov_lo = MOV I32 (OpReg rlo) (OpAddr addr)
-        mov_hi = MOV I32 (OpReg rhi) (OpAddr (fromJust (addrOffset addr 4)))
-  -- in
-  return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
-
-
-assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
-   ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
-   let 
-         r_dst_lo = mkVReg u_dst I32
-         r_dst_hi = getHiVRegFromLo r_dst_lo
-         r_src_hi = getHiVRegFromLo r_src_lo
-         mov_lo = MOV I32 (OpReg r_src_lo) (OpReg r_dst_lo)
-         mov_hi = MOV I32 (OpReg r_src_hi) (OpReg r_dst_hi)
-   -- in
-   return (
-        vcode `snocOL` mov_lo `snocOL` mov_hi
-     )
-
-assignReg_I64Code lvalue valueTree
-   = panic "assignReg_I64Code(i386): invalid lvalue"
-
-------------
-
-iselExpr64 (CmmLit (CmmInt i _)) = do
-  (rlo,rhi) <- getNewRegPairNat I32
-  let
-	r = fromIntegral (fromIntegral i :: Word32)
-	q = fromIntegral ((fromIntegral i `shiftR` 32) :: Word32)
-	code = toOL [
-		MOV I32 (OpImm (ImmInteger r)) (OpReg rlo),
-		MOV I32 (OpImm (ImmInteger q)) (OpReg rhi)
-		]
-  -- in
-  return (ChildCode64 code rlo)
-
-iselExpr64 (CmmLoad addrTree I64) = do
-   Amode addr addr_code <- getAmode addrTree
-   (rlo,rhi) <- getNewRegPairNat I32
-   let 
-        mov_lo = MOV I32 (OpAddr addr) (OpReg rlo)
-        mov_hi = MOV I32 (OpAddr (fromJust (addrOffset addr 4))) (OpReg rhi)
-   -- in
-   return (
-            ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi) 
-                        rlo
-     )
-
-iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
-   = return (ChildCode64 nilOL (mkVReg vu I32))
-         
--- we handle addition, but rather badly
-iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) = do
-   ChildCode64 code1 r1lo <- iselExpr64 e1
-   (rlo,rhi) <- getNewRegPairNat I32
-   let
-	r = fromIntegral (fromIntegral i :: Word32)
-	q = fromIntegral ((fromIntegral i `shiftR` 32) :: Word32)
-	r1hi = getHiVRegFromLo r1lo
-	code =  code1 `appOL`
-		toOL [ MOV I32 (OpReg r1lo) (OpReg rlo),
-		       ADD I32 (OpImm (ImmInteger r)) (OpReg rlo),
-		       MOV I32 (OpReg r1hi) (OpReg rhi),
-		       ADC I32 (OpImm (ImmInteger q)) (OpReg rhi) ]
-   -- in
-   return (ChildCode64 code rlo)
-
-iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
-   ChildCode64 code1 r1lo <- iselExpr64 e1
-   ChildCode64 code2 r2lo <- iselExpr64 e2
-   (rlo,rhi) <- getNewRegPairNat I32
-   let
-	r1hi = getHiVRegFromLo r1lo
-	r2hi = getHiVRegFromLo r2lo
-	code =  code1 `appOL`
-		code2 `appOL`
-		toOL [ MOV I32 (OpReg r1lo) (OpReg rlo),
-		       ADD I32 (OpReg r2lo) (OpReg rlo),
-		       MOV I32 (OpReg r1hi) (OpReg rhi),
-		       ADC I32 (OpReg r2hi) (OpReg rhi) ]
-   -- in
-   return (ChildCode64 code rlo)
-
-iselExpr64 expr
-   = pprPanic "iselExpr64(i386)" (ppr expr)
-
-#endif /* i386_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if sparc_TARGET_ARCH
-
-assignMem_I64Code addrTree valueTree = do
-     Amode addr addr_code <- getAmode addrTree
-     ChildCode64 vcode rlo <- iselExpr64 valueTree  
-     (src, code) <- getSomeReg addrTree
-     let 
-         rhi = getHiVRegFromLo rlo
-         -- Big-endian store
-         mov_hi = ST I32 rhi (AddrRegImm src (ImmInt 0))
-         mov_lo = ST I32 rlo (AddrRegImm src (ImmInt 4))
-     return (vcode `appOL` code `snocOL` mov_hi `snocOL` mov_lo)
-
-assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
-     ChildCode64 vcode r_src_lo <- iselExpr64 valueTree    
-     let 
-         r_dst_lo = mkVReg u_dst pk
-         r_dst_hi = getHiVRegFromLo r_dst_lo
-         r_src_hi = getHiVRegFromLo r_src_lo
-         mov_lo = mkMOV r_src_lo r_dst_lo
-         mov_hi = mkMOV r_src_hi r_dst_hi
-         mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
-     return (vcode `snocOL` mov_hi `snocOL` mov_lo)
-assignReg_I64Code lvalue valueTree
-   = panic "assignReg_I64Code(sparc): invalid lvalue"
-
-
--- Don't delete this -- it's very handy for debugging.
---iselExpr64 expr 
---   | trace ("iselExpr64: " ++ showSDoc (ppr expr)) False
---   = panic "iselExpr64(???)"
-
-iselExpr64 (CmmLoad addrTree I64) = do
-     Amode (AddrRegReg r1 r2) addr_code <- getAmode addrTree
-     rlo <- getNewRegNat I32
-     let rhi = getHiVRegFromLo rlo
-         mov_hi = LD I32 (AddrRegImm r1 (ImmInt 0)) rhi
-         mov_lo = LD I32 (AddrRegImm r1 (ImmInt 4)) rlo
-     return (
-            ChildCode64 (addr_code `snocOL` mov_hi `snocOL` mov_lo) 
-                         rlo
-          )
-
-iselExpr64 (CmmReg (CmmLocal (LocalReg uq I64))) = do
-     r_dst_lo <-  getNewRegNat I32
-     let r_dst_hi = getHiVRegFromLo r_dst_lo
-         r_src_lo = mkVReg uq I32
-         r_src_hi = getHiVRegFromLo r_src_lo
-         mov_lo = mkMOV r_src_lo r_dst_lo
-         mov_hi = mkMOV r_src_hi r_dst_hi
-         mkMOV sreg dreg = OR False g0 (RIReg sreg) dreg
-     return (
-            ChildCode64 (toOL [mov_hi, mov_lo]) r_dst_lo
-         )
-
-iselExpr64 expr
-   = pprPanic "iselExpr64(sparc)" (ppr expr)
-
-#endif /* sparc_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if powerpc_TARGET_ARCH
-
-getI64Amodes :: CmmExpr -> NatM (AddrMode, AddrMode, InstrBlock)
-getI64Amodes addrTree = do
-    Amode hi_addr addr_code <- getAmode addrTree
-    case addrOffset hi_addr 4 of
-        Just lo_addr -> return (hi_addr, lo_addr, addr_code)
-        Nothing      -> do (hi_ptr, code) <- getSomeReg addrTree
-                           return (AddrRegImm hi_ptr (ImmInt 0),
-                                   AddrRegImm hi_ptr (ImmInt 4),
-                                   code)
-
-assignMem_I64Code addrTree valueTree = do
-        (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
-	ChildCode64 vcode rlo <- iselExpr64 valueTree
-	let 
-		rhi = getHiVRegFromLo rlo
-
-		-- Big-endian store
-		mov_hi = ST I32 rhi hi_addr
-		mov_lo = ST I32 rlo lo_addr
-	-- in
-	return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
-
-assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
-   ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
-   let 
-         r_dst_lo = mkVReg u_dst I32
-         r_dst_hi = getHiVRegFromLo r_dst_lo
-         r_src_hi = getHiVRegFromLo r_src_lo
-         mov_lo = MR r_dst_lo r_src_lo
-         mov_hi = MR r_dst_hi r_src_hi
-   -- in
-   return (
-        vcode `snocOL` mov_lo `snocOL` mov_hi
-     )
-
-assignReg_I64Code lvalue valueTree
-   = panic "assignReg_I64Code(powerpc): invalid lvalue"
-
-
--- Don't delete this -- it's very handy for debugging.
---iselExpr64 expr 
---   | trace ("iselExpr64: " ++ showSDoc (pprCmmExpr expr)) False
---   = panic "iselExpr64(???)"
-
-iselExpr64 (CmmLoad addrTree I64) = do
-    (hi_addr, lo_addr, addr_code) <- getI64Amodes addrTree
-    (rlo, rhi) <- getNewRegPairNat I32
-    let mov_hi = LD I32 rhi hi_addr
-        mov_lo = LD I32 rlo lo_addr
-    return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi) 
-                         rlo
-
-iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
-   = return (ChildCode64 nilOL (mkVReg vu I32))
-
-iselExpr64 (CmmLit (CmmInt i _)) = do
-  (rlo,rhi) <- getNewRegPairNat I32
-  let
-	half0 = fromIntegral (fromIntegral i :: Word16)
-	half1 = fromIntegral ((fromIntegral i `shiftR` 16) :: Word16)
-	half2 = fromIntegral ((fromIntegral i `shiftR` 32) :: Word16)
-	half3 = fromIntegral ((fromIntegral i `shiftR` 48) :: Word16)
-	
-	code = toOL [
-		LIS rlo (ImmInt half1),
-		OR rlo rlo (RIImm $ ImmInt half0),
-		LIS rhi (ImmInt half3),
-		OR rlo rlo (RIImm $ ImmInt half2)
-		]
-  -- in
-  return (ChildCode64 code rlo)
-
-iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
-   ChildCode64 code1 r1lo <- iselExpr64 e1
-   ChildCode64 code2 r2lo <- iselExpr64 e2
-   (rlo,rhi) <- getNewRegPairNat I32
-   let
-	r1hi = getHiVRegFromLo r1lo
-	r2hi = getHiVRegFromLo r2lo
-	code =  code1 `appOL`
-		code2 `appOL`
-		toOL [ ADDC rlo r1lo r2lo,
-		       ADDE rhi r1hi r2hi ]
-   -- in
-   return (ChildCode64 code rlo)
-
-iselExpr64 expr
-   = pprPanic "iselExpr64(powerpc)" (ppr expr)
-
-#endif /* powerpc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- The 'Register' type
-
--- 'Register's passed up the tree.  If the stix code forces the register
--- to live in a pre-decided machine register, it comes out as @Fixed@;
--- otherwise, it comes out as @Any@, and the parent can decide which
--- register to put it in.
-
-data Register
-  = Fixed   MachRep Reg InstrBlock
-  | Any	    MachRep (Reg -> InstrBlock)
-
-swizzleRegisterRep :: Register -> MachRep -> Register
-swizzleRegisterRep (Fixed _ reg code) rep = Fixed rep reg code
-swizzleRegisterRep (Any _ codefn)     rep = Any rep codefn
-
-
--- -----------------------------------------------------------------------------
--- Utils based on getRegister, below
-
--- The dual to getAnyReg: compute an expression into a register, but
--- we don't mind which one it is.
-getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
-getSomeReg expr = do
-  r <- getRegister expr
-  case r of
-    Any rep code -> do
-	tmp <- getNewRegNat rep
-	return (tmp, code tmp)
-    Fixed _ reg code -> 
-	return (reg, code)
-
--- -----------------------------------------------------------------------------
--- Grab the Reg for a CmmReg
-
-getRegisterReg :: CmmReg -> Reg
-
-getRegisterReg (CmmLocal (LocalReg u pk))
-  = mkVReg u pk
-
-getRegisterReg (CmmGlobal mid)
-  = case get_GlobalReg_reg_or_addr mid of
-       Left (RealReg rrno) -> RealReg rrno
-       _other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
-          -- By this stage, the only MagicIds remaining should be the
-          -- ones which map to a real machine register on this
-          -- platform.  Hence ...
-
-
--- -----------------------------------------------------------------------------
--- Generate code to get a subtree into a Register
-
--- Don't delete this -- it's very handy for debugging.
---getRegister expr 
---   | trace ("getRegister: " ++ showSDoc (pprCmmExpr expr)) False
---   = panic "getRegister(???)"
-
-getRegister :: CmmExpr -> NatM Register
-
-getRegister (CmmReg (CmmGlobal PicBaseReg))
-  = do
-      reg <- getPicBaseNat wordRep
-      return (Fixed wordRep reg nilOL)
-
-getRegister (CmmReg reg) 
-  = return (Fixed (cmmRegRep reg) (getRegisterReg reg) nilOL)
-
-getRegister tree@(CmmRegOff _ _) 
-  = getRegister (mangleIndexTree tree)
-
--- end of machine-"independent" bit; here we go on the rest...
-
-#if alpha_TARGET_ARCH
-
-getRegister (StDouble d)
-  = getBlockIdNat 	    	    `thenNat` \ lbl ->
-    getNewRegNat PtrRep    	    `thenNat` \ tmp ->
-    let code dst = mkSeqInstrs [
-	    LDATA RoDataSegment lbl [
-		    DATA TF [ImmLab (rational d)]
-		],
-	    LDA tmp (AddrImm (ImmCLbl lbl)),
-	    LD TF dst (AddrReg tmp)]
-    in
-    	return (Any F64 code)
-
-getRegister (StPrim primop [x]) -- unary PrimOps
-  = case primop of
-      IntNegOp -> trivialUCode (NEG Q False) x
-
-      NotOp    -> trivialUCode NOT x
-
-      FloatNegOp  -> trivialUFCode FloatRep  (FNEG TF) x
-      DoubleNegOp -> trivialUFCode F64 (FNEG TF) x
-
-      OrdOp -> coerceIntCode IntRep x
-      ChrOp -> chrCode x
-
-      Float2IntOp  -> coerceFP2Int    x
-      Int2FloatOp  -> coerceInt2FP pr x
-      Double2IntOp -> coerceFP2Int    x
-      Int2DoubleOp -> coerceInt2FP pr x
-
-      Double2FloatOp -> coerceFltCode x
-      Float2DoubleOp -> coerceFltCode x
-
-      other_op -> getRegister (StCall fn CCallConv F64 [x])
-	where
-	  fn = case other_op of
-		 FloatExpOp    -> FSLIT("exp")
-		 FloatLogOp    -> FSLIT("log")
-		 FloatSqrtOp   -> FSLIT("sqrt")
-		 FloatSinOp    -> FSLIT("sin")
-		 FloatCosOp    -> FSLIT("cos")
-		 FloatTanOp    -> FSLIT("tan")
-		 FloatAsinOp   -> FSLIT("asin")
-		 FloatAcosOp   -> FSLIT("acos")
-		 FloatAtanOp   -> FSLIT("atan")
-		 FloatSinhOp   -> FSLIT("sinh")
-		 FloatCoshOp   -> FSLIT("cosh")
-		 FloatTanhOp   -> FSLIT("tanh")
-		 DoubleExpOp   -> FSLIT("exp")
-		 DoubleLogOp   -> FSLIT("log")
-		 DoubleSqrtOp  -> FSLIT("sqrt")
-		 DoubleSinOp   -> FSLIT("sin")
-		 DoubleCosOp   -> FSLIT("cos")
-		 DoubleTanOp   -> FSLIT("tan")
-		 DoubleAsinOp  -> FSLIT("asin")
-		 DoubleAcosOp  -> FSLIT("acos")
-		 DoubleAtanOp  -> FSLIT("atan")
-		 DoubleSinhOp  -> FSLIT("sinh")
-		 DoubleCoshOp  -> FSLIT("cosh")
-		 DoubleTanhOp  -> FSLIT("tanh")
-  where
-    pr = panic "MachCode.getRegister: no primrep needed for Alpha"
-
-getRegister (StPrim primop [x, y]) -- dyadic PrimOps
-  = case primop of
-      CharGtOp -> trivialCode (CMP LTT) y x
-      CharGeOp -> trivialCode (CMP LE) y x
-      CharEqOp -> trivialCode (CMP EQQ) x y
-      CharNeOp -> int_NE_code x y
-      CharLtOp -> trivialCode (CMP LTT) x y
-      CharLeOp -> trivialCode (CMP LE) x y
-
-      IntGtOp  -> trivialCode (CMP LTT) y x
-      IntGeOp  -> trivialCode (CMP LE) y x
-      IntEqOp  -> trivialCode (CMP EQQ) x y
-      IntNeOp  -> int_NE_code x y
-      IntLtOp  -> trivialCode (CMP LTT) x y
-      IntLeOp  -> trivialCode (CMP LE) x y
-
-      WordGtOp -> trivialCode (CMP ULT) y x
-      WordGeOp -> trivialCode (CMP ULE) x y
-      WordEqOp -> trivialCode (CMP EQQ)  x y
-      WordNeOp -> int_NE_code x y
-      WordLtOp -> trivialCode (CMP ULT) x y
-      WordLeOp -> trivialCode (CMP ULE) x y
-
-      AddrGtOp -> trivialCode (CMP ULT) y x
-      AddrGeOp -> trivialCode (CMP ULE) y x
-      AddrEqOp -> trivialCode (CMP EQQ)  x y
-      AddrNeOp -> int_NE_code x y
-      AddrLtOp -> trivialCode (CMP ULT) x y
-      AddrLeOp -> trivialCode (CMP ULE) x y
-	
-      FloatGtOp -> cmpF_code (FCMP TF LE) EQQ x y
-      FloatGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
-      FloatEqOp -> cmpF_code (FCMP TF EQQ) NE x y
-      FloatNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y
-      FloatLtOp -> cmpF_code (FCMP TF LTT) NE x y
-      FloatLeOp -> cmpF_code (FCMP TF LE) NE x y
-
-      DoubleGtOp -> cmpF_code (FCMP TF LE) EQQ x y
-      DoubleGeOp -> cmpF_code (FCMP TF LTT) EQQ x y
-      DoubleEqOp -> cmpF_code (FCMP TF EQQ) NE x y
-      DoubleNeOp -> cmpF_code (FCMP TF EQQ) EQQ x y
-      DoubleLtOp -> cmpF_code (FCMP TF LTT) NE x y
-      DoubleLeOp -> cmpF_code (FCMP TF LE) NE x y
-
-      IntAddOp  -> trivialCode (ADD Q False) x y
-      IntSubOp  -> trivialCode (SUB Q False) x y
-      IntMulOp  -> trivialCode (MUL Q False) x y
-      IntQuotOp -> trivialCode (DIV Q False) x y
-      IntRemOp  -> trivialCode (REM Q False) x y
-
-      WordAddOp  -> trivialCode (ADD Q False) x y
-      WordSubOp  -> trivialCode (SUB Q False) x y
-      WordMulOp  -> trivialCode (MUL Q False) x y
-      WordQuotOp -> trivialCode (DIV Q True) x y
-      WordRemOp  -> trivialCode (REM Q True) x y
-
-      FloatAddOp -> trivialFCode  FloatRep (FADD TF) x y
-      FloatSubOp -> trivialFCode  FloatRep (FSUB TF) x y
-      FloatMulOp -> trivialFCode  FloatRep (FMUL TF) x y
-      FloatDivOp -> trivialFCode  FloatRep (FDIV TF) x y
-
-      DoubleAddOp -> trivialFCode  F64 (FADD TF) x y
-      DoubleSubOp -> trivialFCode  F64 (FSUB TF) x y
-      DoubleMulOp -> trivialFCode  F64 (FMUL TF) x y
-      DoubleDivOp -> trivialFCode  F64 (FDIV TF) x y
-
-      AddrAddOp  -> trivialCode (ADD Q False) x y
-      AddrSubOp  -> trivialCode (SUB Q False) x y
-      AddrRemOp  -> trivialCode (REM Q True) x y
-
-      AndOp  -> trivialCode AND x y
-      OrOp   -> trivialCode OR  x y
-      XorOp  -> trivialCode XOR x y
-      SllOp  -> trivialCode SLL x y
-      SrlOp  -> trivialCode SRL x y
-
-      ISllOp -> trivialCode SLL x y -- was: panic "AlphaGen:isll"
-      ISraOp -> trivialCode SRA x y -- was: panic "AlphaGen:isra"
-      ISrlOp -> trivialCode SRL x y -- was: panic "AlphaGen:isrl"
-
-      FloatPowerOp  -> getRegister (StCall FSLIT("pow") CCallConv F64 [x,y])
-      DoublePowerOp -> getRegister (StCall FSLIT("pow") CCallConv F64 [x,y])
-  where
-    {- ------------------------------------------------------------
-	Some bizarre special code for getting condition codes into
-	registers.  Integer non-equality is a test for equality
-	followed by an XOR with 1.  (Integer comparisons always set
-	the result register to 0 or 1.)  Floating point comparisons of
-	any kind leave the result in a floating point register, so we
-	need to wrangle an integer register out of things.
-    -}
-    int_NE_code :: StixTree -> StixTree -> NatM Register
-
-    int_NE_code x y
-      = trivialCode (CMP EQQ) x y	`thenNat` \ register ->
-	getNewRegNat IntRep		`thenNat` \ tmp ->
-	let
-	    code = registerCode register tmp
-	    src  = registerName register tmp
-	    code__2 dst = code . mkSeqInstr (XOR src (RIImm (ImmInt 1)) dst)
-	in
-	return (Any IntRep code__2)
-
-    {- ------------------------------------------------------------
-	Comments for int_NE_code also apply to cmpF_code
-    -}
-    cmpF_code
-	:: (Reg -> Reg -> Reg -> Instr)
-	-> Cond
-	-> StixTree -> StixTree
-	-> NatM Register
-
-    cmpF_code instr cond x y
-      = trivialFCode pr instr x y	`thenNat` \ register ->
-	getNewRegNat F64		`thenNat` \ tmp ->
-	getBlockIdNat			`thenNat` \ lbl ->
-	let
-	    code = registerCode register tmp
-	    result  = registerName register tmp
-
-	    code__2 dst = code . mkSeqInstrs [
-		OR zeroh (RIImm (ImmInt 1)) dst,
-		BF cond  result (ImmCLbl lbl),
-		OR zeroh (RIReg zeroh) dst,
-		NEWBLOCK lbl]
-	in
-	return (Any IntRep code__2)
-      where
-	pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
-      ------------------------------------------------------------
-
-getRegister (CmmLoad pk mem)
-  = getAmode mem    	    	    `thenNat` \ amode ->
-    let
-    	code = amodeCode amode
-    	src   = amodeAddr amode
-    	size = primRepToSize pk
-    	code__2 dst = code . mkSeqInstr (LD size dst src)
-    in
-    return (Any pk code__2)
-
-getRegister (StInt i)
-  | fits8Bits i
-  = let
-    	code dst = mkSeqInstr (OR zeroh (RIImm src) dst)
-    in
-    return (Any IntRep code)
-  | otherwise
-  = let
-    	code dst = mkSeqInstr (LDI Q dst src)
-    in
-    return (Any IntRep code)
-  where
-    src = ImmInt (fromInteger i)
-
-getRegister leaf
-  | isJust imm
-  = let
-    	code dst = mkSeqInstr (LDA dst (AddrImm imm__2))
-    in
-    return (Any PtrRep code)
-  where
-    imm = maybeImm leaf
-    imm__2 = case imm of Just x -> x
-
-#endif /* alpha_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if i386_TARGET_ARCH
-
-getRegister (CmmLit (CmmFloat f F32)) = do
-    lbl <- getNewLabelNat
-    dynRef <- cmmMakeDynamicReference addImportNat False lbl
-    Amode addr addr_code <- getAmode dynRef
-    let code dst =
-	    LDATA ReadOnlyData
-			[CmmDataLabel lbl,
-			 CmmStaticLit (CmmFloat f F32)]
-	    `consOL` (addr_code `snocOL`
-	    GLD F32 addr dst)
-    -- in
-    return (Any F32 code)
-
-
-getRegister (CmmLit (CmmFloat d F64))
-  | d == 0.0
-  = let code dst = unitOL (GLDZ dst)
-    in  return (Any F64 code)
-
-  | d == 1.0
-  = let code dst = unitOL (GLD1 dst)
-    in  return (Any F64 code)
-
-  | otherwise = do
-    lbl <- getNewLabelNat
-    dynRef <- cmmMakeDynamicReference addImportNat False lbl
-    Amode addr addr_code <- getAmode dynRef
-    let code dst =
-	    LDATA ReadOnlyData
-			[CmmDataLabel lbl,
-			 CmmStaticLit (CmmFloat d F64)]
-	    `consOL` (addr_code `snocOL`
-	    GLD F64 addr dst)
-    -- in
-    return (Any F64 code)
-
-#endif /* i386_TARGET_ARCH */
-
-#if x86_64_TARGET_ARCH
-
-getRegister (CmmLit (CmmFloat 0.0 rep)) = do
-   let code dst = unitOL  (XOR rep (OpReg dst) (OpReg dst))
-	-- I don't know why there are xorpd, xorps, and pxor instructions.
-	-- They all appear to do the same thing --SDM
-   return (Any rep code)
-
-getRegister (CmmLit (CmmFloat f rep)) = do
-    lbl <- getNewLabelNat
-    let code dst = toOL [
-	    LDATA ReadOnlyData
-			[CmmDataLabel lbl,
-			 CmmStaticLit (CmmFloat f rep)],
-	    MOV rep (OpAddr (ripRel (ImmCLbl lbl))) (OpReg dst)
-	    ]
-    -- in
-    return (Any rep code)
-
-#endif /* x86_64_TARGET_ARCH */
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
--- catch simple cases of zero- or sign-extended load
-getRegister (CmmMachOp (MO_U_Conv I8 I32) [CmmLoad addr _]) = do
-  code <- intLoadCode (MOVZxL I8) addr
-  return (Any I32 code)
-
-getRegister (CmmMachOp (MO_S_Conv I8 I32) [CmmLoad addr _]) = do
-  code <- intLoadCode (MOVSxL I8) addr
-  return (Any I32 code)
-
-getRegister (CmmMachOp (MO_U_Conv I16 I32) [CmmLoad addr _]) = do
-  code <- intLoadCode (MOVZxL I16) addr
-  return (Any I32 code)
-
-getRegister (CmmMachOp (MO_S_Conv I16 I32) [CmmLoad addr _]) = do
-  code <- intLoadCode (MOVSxL I16) addr
-  return (Any I32 code)
-
-#endif
-
-#if x86_64_TARGET_ARCH
-
--- catch simple cases of zero- or sign-extended load
-getRegister (CmmMachOp (MO_U_Conv I8 I64) [CmmLoad addr _]) = do
-  code <- intLoadCode (MOVZxL I8) addr
-  return (Any I64 code)
-
-getRegister (CmmMachOp (MO_S_Conv I8 I64) [CmmLoad addr _]) = do
-  code <- intLoadCode (MOVSxL I8) addr
-  return (Any I64 code)
-
-getRegister (CmmMachOp (MO_U_Conv I16 I64) [CmmLoad addr _]) = do
-  code <- intLoadCode (MOVZxL I16) addr
-  return (Any I64 code)
-
-getRegister (CmmMachOp (MO_S_Conv I16 I64) [CmmLoad addr _]) = do
-  code <- intLoadCode (MOVSxL I16) addr
-  return (Any I64 code)
-
-getRegister (CmmMachOp (MO_U_Conv I32 I64) [CmmLoad addr _]) = do
-  code <- intLoadCode (MOV I32) addr -- 32-bit loads zero-extend
-  return (Any I64 code)
-
-getRegister (CmmMachOp (MO_S_Conv I32 I64) [CmmLoad addr _]) = do
-  code <- intLoadCode (MOVSxL I32) addr
-  return (Any I64 code)
-
-#endif
-
-#if x86_64_TARGET_ARCH
-getRegister (CmmMachOp (MO_S_Neg F32) [x]) = do
-  x_code <- getAnyReg x
-  lbl <- getNewLabelNat
-  let
-    code dst = x_code dst `appOL` toOL [
-	-- This is how gcc does it, so it can't be that bad:
-	LDATA ReadOnlyData16 [
-		CmmAlign 16,
-		CmmDataLabel lbl,
-		CmmStaticLit (CmmInt 0x80000000 I32),
-		CmmStaticLit (CmmInt 0 I32),
-		CmmStaticLit (CmmInt 0 I32),
-		CmmStaticLit (CmmInt 0 I32)
-	],
-	XOR F32 (OpAddr (ripRel (ImmCLbl lbl))) (OpReg dst)
-		-- xorps, so we need the 128-bit constant
-		-- ToDo: rip-relative
-	]
-  --
-  return (Any F32 code)
-
-getRegister (CmmMachOp (MO_S_Neg F64) [x]) = do
-  x_code <- getAnyReg x
-  lbl <- getNewLabelNat
-  let
-	-- This is how gcc does it, so it can't be that bad:
-    code dst = x_code dst `appOL` toOL [
-	LDATA ReadOnlyData16 [
-		CmmAlign 16,
-		CmmDataLabel lbl,
-		CmmStaticLit (CmmInt 0x8000000000000000 I64),
-		CmmStaticLit (CmmInt 0 I64)
-	],
-		-- gcc puts an unpck here.  Wonder if we need it.
-	XOR F64 (OpAddr (ripRel (ImmCLbl lbl))) (OpReg dst)
-		-- xorpd, so we need the 128-bit constant
-	]
-  --
-  return (Any F64 code)
-#endif
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
-getRegister (CmmMachOp mop [x]) -- unary MachOps
-  = case mop of
-#if i386_TARGET_ARCH
-      MO_S_Neg F32 -> trivialUFCode F32 (GNEG F32) x
-      MO_S_Neg F64 -> trivialUFCode F64 (GNEG F64) x
-#endif
-
-      MO_S_Neg rep -> trivialUCode rep (NEGI rep) x
-      MO_Not rep   -> trivialUCode rep (NOT  rep) x
-
-      -- Nop conversions
-      -- TODO: these are only nops if the arg is not a fixed register that
-      -- can't be byte-addressed.
-      MO_U_Conv I32 I8  -> conversionNop I32 x
-      MO_S_Conv I32 I8  -> conversionNop I32 x
-      MO_U_Conv I16 I8  -> conversionNop I16 x
-      MO_S_Conv I16 I8  -> conversionNop I16 x
-      MO_U_Conv I32 I16 -> conversionNop I32 x
-      MO_S_Conv I32 I16 -> conversionNop I32 x
-#if x86_64_TARGET_ARCH
-      MO_U_Conv I64 I32 -> conversionNop I64 x
-      MO_S_Conv I64 I32 -> conversionNop I64 x
-      MO_U_Conv I64 I16 -> conversionNop I64 x
-      MO_S_Conv I64 I16 -> conversionNop I64 x
-      MO_U_Conv I64 I8  -> conversionNop I64 x
-      MO_S_Conv I64 I8  -> conversionNop I64 x
-#endif
-
-      MO_U_Conv rep1 rep2 | rep1 == rep2 -> conversionNop rep1 x
-      MO_S_Conv rep1 rep2 | rep1 == rep2 -> conversionNop rep1 x
-
-      -- widenings
-      MO_U_Conv I8  I32 -> integerExtend I8  I32 MOVZxL x
-      MO_U_Conv I16 I32 -> integerExtend I16 I32 MOVZxL x
-      MO_U_Conv I8  I16 -> integerExtend I8  I16 MOVZxL x
-
-      MO_S_Conv I8  I32 -> integerExtend I8  I32 MOVSxL x
-      MO_S_Conv I16 I32 -> integerExtend I16 I32 MOVSxL x
-      MO_S_Conv I8  I16 -> integerExtend I8  I16 MOVSxL x
-
-#if x86_64_TARGET_ARCH
-      MO_U_Conv I8  I64 -> integerExtend I8  I64 MOVZxL x
-      MO_U_Conv I16 I64 -> integerExtend I16 I64 MOVZxL x
-      MO_U_Conv I32 I64 -> integerExtend I32 I64 MOVZxL x
-      MO_S_Conv I8  I64 -> integerExtend I8  I64 MOVSxL x
-      MO_S_Conv I16 I64 -> integerExtend I16 I64 MOVSxL x
-      MO_S_Conv I32 I64 -> integerExtend I32 I64 MOVSxL x
-	-- for 32-to-64 bit zero extension, amd64 uses an ordinary movl.
-	-- However, we don't want the register allocator to throw it
-	-- away as an unnecessary reg-to-reg move, so we keep it in
-	-- the form of a movzl and print it as a movl later.
-#endif
-
-#if i386_TARGET_ARCH
-      MO_S_Conv F32 F64 -> conversionNop F64 x
-      MO_S_Conv F64 F32 -> conversionNop F32 x
-#else
-      MO_S_Conv F32 F64 -> coerceFP2FP F64 x
-      MO_S_Conv F64 F32 -> coerceFP2FP F32 x
-#endif
-
-      MO_S_Conv from to
-	| isFloatingRep from -> coerceFP2Int from to x
-	| isFloatingRep to   -> coerceInt2FP from to x
-
-      other -> pprPanic "getRegister" (pprMachOp mop)
-   where
-	-- signed or unsigned extension.
-	integerExtend from to instr expr = do
-	    (reg,e_code) <- if from == I8 then getByteReg expr
-					  else getSomeReg expr
-	    let 
-		code dst = 
-		  e_code `snocOL`
-		  instr from (OpReg reg) (OpReg dst)
-	    return (Any to code)
-
-        conversionNop new_rep expr
-            = do e_code <- getRegister expr
-                 return (swizzleRegisterRep e_code new_rep)
-
-
-getRegister e@(CmmMachOp mop [x, y]) -- dyadic MachOps
-  = ASSERT2(cmmExprRep x /= I8, pprExpr e)
-    case mop of
-      MO_Eq F32   -> condFltReg EQQ x y
-      MO_Ne F32   -> condFltReg NE x y
-      MO_S_Gt F32 -> condFltReg GTT x y
-      MO_S_Ge F32 -> condFltReg GE x y
-      MO_S_Lt F32 -> condFltReg LTT x y
-      MO_S_Le F32 -> condFltReg LE x y
-
-      MO_Eq F64   -> condFltReg EQQ x y
-      MO_Ne F64   -> condFltReg NE x y
-      MO_S_Gt F64 -> condFltReg GTT x y
-      MO_S_Ge F64 -> condFltReg GE x y
-      MO_S_Lt F64 -> condFltReg LTT x y
-      MO_S_Le F64 -> condFltReg LE x y
-
-      MO_Eq rep   -> condIntReg EQQ x y
-      MO_Ne rep   -> condIntReg NE x y
-
-      MO_S_Gt rep -> condIntReg GTT x y
-      MO_S_Ge rep -> condIntReg GE x y
-      MO_S_Lt rep -> condIntReg LTT x y
-      MO_S_Le rep -> condIntReg LE x y
-
-      MO_U_Gt rep -> condIntReg GU  x y
-      MO_U_Ge rep -> condIntReg GEU x y
-      MO_U_Lt rep -> condIntReg LU  x y
-      MO_U_Le rep -> condIntReg LEU x y
-
-#if i386_TARGET_ARCH
-      MO_Add F32 -> trivialFCode F32 GADD x y
-      MO_Sub F32 -> trivialFCode F32 GSUB x y
-
-      MO_Add F64 -> trivialFCode F64 GADD x y
-      MO_Sub F64 -> trivialFCode F64 GSUB x y
-
-      MO_S_Quot F32 -> trivialFCode F32 GDIV x y
-      MO_S_Quot F64 -> trivialFCode F64 GDIV x y
-#endif
-
-#if x86_64_TARGET_ARCH
-      MO_Add F32 -> trivialFCode F32 ADD x y
-      MO_Sub F32 -> trivialFCode F32 SUB x y
-
-      MO_Add F64 -> trivialFCode F64 ADD x y
-      MO_Sub F64 -> trivialFCode F64 SUB x y
-
-      MO_S_Quot F32 -> trivialFCode F32 FDIV x y
-      MO_S_Quot F64 -> trivialFCode F64 FDIV x y
-#endif
-
-      MO_Add rep -> add_code rep x y
-      MO_Sub rep -> sub_code rep x y
-
-      MO_S_Quot rep -> div_code rep True  True  x y
-      MO_S_Rem  rep -> div_code rep True  False x y
-      MO_U_Quot rep -> div_code rep False True  x y
-      MO_U_Rem  rep -> div_code rep False False x y
-
-#if i386_TARGET_ARCH
-      MO_Mul   F32 -> trivialFCode F32 GMUL x y
-      MO_Mul   F64 -> trivialFCode F64 GMUL x y
-#endif
-
-#if x86_64_TARGET_ARCH
-      MO_Mul   F32 -> trivialFCode F32 MUL x y
-      MO_Mul   F64 -> trivialFCode F64 MUL x y
-#endif
-
-      MO_Mul   rep -> let op = IMUL rep in 
-		      trivialCode rep op (Just op) x y
-
-      MO_S_MulMayOflo rep -> imulMayOflo rep x y
-
-      MO_And rep -> let op = AND rep in 
-		    trivialCode rep op (Just op) x y
-      MO_Or  rep -> let op = OR  rep in
-		    trivialCode rep op (Just op) x y
-      MO_Xor rep -> let op = XOR rep in
-		    trivialCode rep op (Just op) x y
-
-	{- Shift ops on x86s have constraints on their source, it
-	   either has to be Imm, CL or 1
-	    => trivialCode is not restrictive enough (sigh.)
-	-}	   
-      MO_Shl rep   -> shift_code rep (SHL rep) x y {-False-}
-      MO_U_Shr rep -> shift_code rep (SHR rep) x y {-False-}
-      MO_S_Shr rep -> shift_code rep (SAR rep) x y {-False-}
-
-      other -> pprPanic "getRegister(x86) - binary CmmMachOp (1)" (pprMachOp mop)
-  where
-    --------------------
-    imulMayOflo :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
-    imulMayOflo rep a b = do
-         (a_reg, a_code) <- getNonClobberedReg a
-         b_code <- getAnyReg b
-         let 
-	     shift_amt  = case rep of
-			   I32 -> 31
-			   I64 -> 63
-			   _ -> panic "shift_amt"
-
-             code = a_code `appOL` b_code eax `appOL`
-                        toOL [
-			   IMUL2 rep (OpReg a_reg),   -- result in %edx:%eax
-                           SAR rep (OpImm (ImmInt shift_amt)) (OpReg eax),
-				-- sign extend lower part
-                           SUB rep (OpReg edx) (OpReg eax)
-				-- compare against upper
-                           -- eax==0 if high part == sign extended low part
-                        ]
-         -- in
-	 return (Fixed rep eax code)
-
-    --------------------
-    shift_code :: MachRep
-	       -> (Operand -> Operand -> Instr)
-	       -> CmmExpr
-	       -> CmmExpr
-	       -> NatM Register
-
-    {- Case1: shift length as immediate -}
-    shift_code rep instr x y@(CmmLit lit) = do
-	  x_code <- getAnyReg x
-	  let
-	       code dst
-		  = x_code dst `snocOL` 
-		    instr (OpImm (litToImm lit)) (OpReg dst)
-	  -- in
-	  return (Any rep code)
-        
-    {- Case2: shift length is complex (non-immediate) -}
-    shift_code rep instr x y{-amount-} = do
-        (x_reg, x_code) <- getNonClobberedReg x
-        y_code <- getAnyReg y
-	let 
-	   code = x_code `appOL`
-		  y_code ecx `snocOL`
-		  instr (OpReg ecx) (OpReg x_reg)
-        -- in
-        return (Fixed rep x_reg code)
-
-    --------------------
-    add_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
-    add_code rep x (CmmLit (CmmInt y _))
-	| not (is64BitInteger y) = add_int rep x y
-    add_code rep x y = trivialCode rep (ADD rep) (Just (ADD rep)) x y
-
-    --------------------
-    sub_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
-    sub_code rep x (CmmLit (CmmInt y _))
-	| not (is64BitInteger (-y)) = add_int rep x (-y)
-    sub_code rep x y = trivialCode rep (SUB rep) Nothing x y
-
-    -- our three-operand add instruction:
-    add_int rep x y = do
-	(x_reg, x_code) <- getSomeReg x
-	let
-	    imm = ImmInt (fromInteger y)
-	    code dst
-               = x_code `snocOL`
-		 LEA rep
-			(OpAddr (AddrBaseIndex (EABaseReg x_reg) EAIndexNone imm))
-                        (OpReg dst)
-	-- 
-	return (Any rep code)
-
-    ----------------------
-    div_code rep signed quotient x y = do
-	   (y_op, y_code) <- getRegOrMem y -- cannot be clobbered
-	   x_code <- getAnyReg x
-	   let
-	     widen | signed    = CLTD rep
-		   | otherwise = XOR rep (OpReg edx) (OpReg edx)
-
-	     instr | signed    = IDIV
-		   | otherwise = DIV
-
-	     code = y_code `appOL`
-		    x_code eax `appOL`
-		    toOL [widen, instr rep y_op]
-
-	     result | quotient  = eax
-		    | otherwise = edx
-
-	   -- in
-           return (Fixed rep result code)
-
-
-getRegister (CmmLoad mem pk)
-  | isFloatingRep pk
-  = do
-    Amode src mem_code <- getAmode mem
-    let
-    	code dst = mem_code `snocOL` 
-		   IF_ARCH_i386(GLD pk src dst,
-			        MOV pk (OpAddr src) (OpReg dst))
-    --
-    return (Any pk code)
-
-#if i386_TARGET_ARCH
-getRegister (CmmLoad mem pk)
-  | pk /= I64
-  = do 
-    code <- intLoadCode (instr pk) mem
-    return (Any pk code)
-  where
-	instr I8  = MOVZxL pk
-	instr I16 = MOV I16
-	instr I32 = MOV I32
-	-- we always zero-extend 8-bit loads, if we
-	-- can't think of anything better.  This is because
-	-- we can't guarantee access to an 8-bit variant of every register
-	-- (esi and edi don't have 8-bit variants), so to make things
-	-- simpler we do our 8-bit arithmetic with full 32-bit registers.
-#endif
-
-#if x86_64_TARGET_ARCH
--- Simpler memory load code on x86_64
-getRegister (CmmLoad mem pk)
-  = do 
-    code <- intLoadCode (MOV pk) mem
-    return (Any pk code)
-#endif
-
-getRegister (CmmLit (CmmInt 0 rep))
-  = let
-	-- x86_64: 32-bit xor is one byte shorter, and zero-extends to 64 bits
-	adj_rep = case rep of I64 -> I32; _ -> rep
-	rep1 = IF_ARCH_i386( rep, adj_rep ) 
-    	code dst 
-           = unitOL (XOR rep1 (OpReg dst) (OpReg dst))
-    in
-    	return (Any rep code)
-
-#if x86_64_TARGET_ARCH
-  -- optimisation for loading small literals on x86_64: take advantage
-  -- of the automatic zero-extension from 32 to 64 bits, because the 32-bit
-  -- instruction forms are shorter.
-getRegister (CmmLit lit) 
-  | I64 <- cmmLitRep lit, not (isBigLit lit)
-  = let 
-	imm = litToImm lit
-	code dst = unitOL (MOV I32 (OpImm imm) (OpReg dst))
-    in
-    	return (Any I64 code)
-  where
-   isBigLit (CmmInt i I64) = i < 0 || i > 0xffffffff
-   isBigLit _ = False
-	-- note1: not the same as is64BitLit, because that checks for
-	-- signed literals that fit in 32 bits, but we want unsigned
-	-- literals here.
-	-- note2: all labels are small, because we're assuming the
-	-- small memory model (see gcc docs, -mcmodel=small).
-#endif
-
-getRegister (CmmLit lit)
-  = let 
-	rep = cmmLitRep lit
-	imm = litToImm lit
-	code dst = unitOL (MOV rep (OpImm imm) (OpReg dst))
-    in
-    	return (Any rep code)
-
-getRegister other = pprPanic "getRegister(x86)" (ppr other)
-
-
-intLoadCode :: (Operand -> Operand -> Instr) -> CmmExpr
-   -> NatM (Reg -> InstrBlock)
-intLoadCode instr mem = do
-  Amode src mem_code <- getAmode mem
-  return (\dst -> mem_code `snocOL` instr (OpAddr src) (OpReg dst))
-
--- Compute an expression into *any* register, adding the appropriate
--- move instruction if necessary.
-getAnyReg :: CmmExpr -> NatM (Reg -> InstrBlock)
-getAnyReg expr = do
-  r <- getRegister expr
-  anyReg r
-
-anyReg :: Register -> NatM (Reg -> InstrBlock)
-anyReg (Any _ code)          = return code
-anyReg (Fixed rep reg fcode) = return (\dst -> fcode `snocOL` reg2reg rep reg dst)
-
--- A bit like getSomeReg, but we want a reg that can be byte-addressed.
--- Fixed registers might not be byte-addressable, so we make sure we've
--- got a temporary, inserting an extra reg copy if necessary.
-getByteReg :: CmmExpr -> NatM (Reg, InstrBlock)
-#if x86_64_TARGET_ARCH
-getByteReg = getSomeReg -- all regs are byte-addressable on x86_64
-#else
-getByteReg expr = do
-  r <- getRegister expr
-  case r of
-    Any rep code -> do
-	tmp <- getNewRegNat rep
-	return (tmp, code tmp)
-    Fixed rep reg code 
-	| isVirtualReg reg -> return (reg,code)
-	| otherwise -> do
-	    tmp <- getNewRegNat rep
-	    return (tmp, code `snocOL` reg2reg rep reg tmp)
-	-- ToDo: could optimise slightly by checking for byte-addressable
-	-- real registers, but that will happen very rarely if at all.
-#endif
-
--- Another variant: this time we want the result in a register that cannot
--- be modified by code to evaluate an arbitrary expression.
-getNonClobberedReg :: CmmExpr -> NatM (Reg, InstrBlock)
-getNonClobberedReg expr = do
-  r <- getRegister expr
-  case r of
-    Any rep code -> do
-	tmp <- getNewRegNat rep
-	return (tmp, code tmp)
-    Fixed rep reg code
-	-- only free regs can be clobbered
-	| RealReg rr <- reg, isFastTrue (freeReg rr) -> do
-		tmp <- getNewRegNat rep
-		return (tmp, code `snocOL` reg2reg rep reg tmp)
-	| otherwise -> 
-		return (reg, code)
-
-reg2reg :: MachRep -> Reg -> Reg -> Instr
-reg2reg rep src dst 
-#if i386_TARGET_ARCH
-  | isFloatingRep rep = GMOV src dst
-#endif
-  | otherwise	      = MOV rep (OpReg src) (OpReg dst)
-
-#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if sparc_TARGET_ARCH
-
-getRegister (CmmLit (CmmFloat f F32)) = do
-    lbl <- getNewLabelNat
-    let code dst = toOL [
-	    LDATA ReadOnlyData
-	                [CmmDataLabel lbl,
-			 CmmStaticLit (CmmFloat f F32)],
-	    SETHI (HI (ImmCLbl lbl)) dst,
-	    LD F32 (AddrRegImm dst (LO (ImmCLbl lbl))) dst] 
-    return (Any F32 code)
-
-getRegister (CmmLit (CmmFloat d F64)) = do
-    lbl <- getNewLabelNat
-    let code dst = toOL [
-	    LDATA ReadOnlyData
-	                [CmmDataLabel lbl,
-			 CmmStaticLit (CmmFloat d F64)],
-	    SETHI (HI (ImmCLbl lbl)) dst,
-	    LD F64 (AddrRegImm dst (LO (ImmCLbl lbl))) dst] 
-    return (Any F64 code)
-
-getRegister (CmmMachOp mop [x]) -- unary MachOps
-  = case mop of
-      MO_S_Neg F32     -> trivialUFCode F32 (FNEG F32) x
-      MO_S_Neg F64     -> trivialUFCode F64 (FNEG F64) x
-
-      MO_S_Neg rep     -> trivialUCode rep (SUB False False g0) x
-      MO_Not rep       -> trivialUCode rep (XNOR False g0) x
-
-      MO_U_Conv I32 I8 -> trivialCode I8 (AND False) x (CmmLit (CmmInt 255 I8))
-
-      MO_U_Conv F64 F32-> coerceDbl2Flt x
-      MO_U_Conv F32 F64-> coerceFlt2Dbl x
-
-      MO_S_Conv F32 I32-> coerceFP2Int F32 I32 x
-      MO_S_Conv I32 F32-> coerceInt2FP I32 F32 x
-      MO_S_Conv F64 I32-> coerceFP2Int F64 I32 x
-      MO_S_Conv I32 F64-> coerceInt2FP I32 F64 x
-
-      -- Conversions which are a nop on sparc
-      MO_U_Conv from to
-	| from == to   -> conversionNop to   x
-      MO_U_Conv I32 to -> conversionNop to   x
-      MO_S_Conv I32 to -> conversionNop to   x
-
-      -- widenings
-      MO_U_Conv I8 I32  -> integerExtend False I8 I32  x
-      MO_U_Conv I16 I32 -> integerExtend False I16 I32 x
-      MO_U_Conv I8 I16  -> integerExtend False I8 I16  x
-      MO_S_Conv I16 I32 -> integerExtend True I16 I32  x
-
-      other_op -> panic "Unknown unary mach op"
-    where
-        -- XXX SLL/SRL?
-        integerExtend signed from to expr = do
-           (reg, e_code) <- getSomeReg expr
-	   let
-	       code dst =
-		   e_code `snocOL` 
-		   ((if signed then SRA else SRL)
-		          reg (RIImm (ImmInt 0)) dst)
-	   return (Any to code)
-        conversionNop new_rep expr
-            = do e_code <- getRegister expr
-                 return (swizzleRegisterRep e_code new_rep)
-
-getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
-  = case mop of
-      MO_Eq F32 -> condFltReg EQQ x y
-      MO_Ne F32 -> condFltReg NE x y
-
-      MO_S_Gt F32 -> condFltReg GTT x y
-      MO_S_Ge F32 -> condFltReg GE x y 
-      MO_S_Lt F32 -> condFltReg LTT x y
-      MO_S_Le F32 -> condFltReg LE x y
-
-      MO_Eq F64 -> condFltReg EQQ x y
-      MO_Ne F64 -> condFltReg NE x y
-
-      MO_S_Gt F64 -> condFltReg GTT x y
-      MO_S_Ge F64 -> condFltReg GE x y
-      MO_S_Lt F64 -> condFltReg LTT x y
-      MO_S_Le F64 -> condFltReg LE x y
-
-      MO_Eq rep -> condIntReg EQQ x y
-      MO_Ne rep -> condIntReg NE x y
-
-      MO_S_Gt rep -> condIntReg GTT x y
-      MO_S_Ge rep -> condIntReg GE x y
-      MO_S_Lt rep -> condIntReg LTT x y
-      MO_S_Le rep -> condIntReg LE x y
-	      
-      MO_U_Gt I32  -> condIntReg GTT x y
-      MO_U_Ge I32  -> condIntReg GE x y
-      MO_U_Lt I32  -> condIntReg LTT x y
-      MO_U_Le I32  -> condIntReg LE x y
-
-      MO_U_Gt I16 -> condIntReg GU  x y
-      MO_U_Ge I16 -> condIntReg GEU x y
-      MO_U_Lt I16 -> condIntReg LU  x y
-      MO_U_Le I16 -> condIntReg LEU x y
-
-      MO_Add I32 -> trivialCode I32 (ADD False False) x y
-      MO_Sub I32 -> trivialCode I32 (SUB False False) x y
-
-      MO_S_MulMayOflo rep -> imulMayOflo rep x y
-{-
-      -- ToDo: teach about V8+ SPARC div instructions
-      MO_S_Quot I32 -> idiv FSLIT(".div")  x y
-      MO_S_Rem I32  -> idiv FSLIT(".rem")  x y
-      MO_U_Quot I32 -> idiv FSLIT(".udiv")  x y
-      MO_U_Rem I32  -> idiv FSLIT(".urem")  x y
--}
-      MO_Add F32  -> trivialFCode F32 FADD  x y
-      MO_Sub F32   -> trivialFCode F32  FSUB x y
-      MO_Mul F32   -> trivialFCode F32  FMUL  x y
-      MO_S_Quot F32   -> trivialFCode F32  FDIV x y
-
-      MO_Add F64   -> trivialFCode F64 FADD  x y
-      MO_Sub F64   -> trivialFCode F64  FSUB x y
-      MO_Mul F64   -> trivialFCode F64  FMUL x y
-      MO_S_Quot F64   -> trivialFCode F64  FDIV x y
-
-      MO_And rep   -> trivialCode rep (AND False) x y
-      MO_Or rep    -> trivialCode rep (OR  False) x y
-      MO_Xor rep   -> trivialCode rep (XOR False) x y
-
-      MO_Mul rep -> trivialCode rep (SMUL False) x y
-
-      MO_Shl rep   -> trivialCode rep SLL  x y
-      MO_U_Shr rep   -> trivialCode rep SRL x y
-      MO_S_Shr rep   -> trivialCode rep SRA x y
-
-{-
-      MO_F32_Pwr  -> getRegister (StCall (Left FSLIT("pow")) CCallConv F64 
-                                         [promote x, promote y])
-		       where promote x = CmmMachOp MO_F32_to_Dbl [x]
-      MO_F64_Pwr -> getRegister (StCall (Left FSLIT("pow")) CCallConv F64 
-                                        [x, y])
--}
-      other -> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop)
-  where
-    --idiv fn x y = getRegister (StCall (Left fn) CCallConv I32 [x, y])
-
-    --------------------
-    imulMayOflo :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
-    imulMayOflo rep a b = do
-         (a_reg, a_code) <- getSomeReg a
-	 (b_reg, b_code) <- getSomeReg b
-	 res_lo <- getNewRegNat I32
-	 res_hi <- getNewRegNat I32
-	 let
-	    shift_amt  = case rep of
-			  I32 -> 31
-			  I64 -> 63
-			  _ -> panic "shift_amt"
-	    code dst = a_code `appOL` b_code `appOL`
-                       toOL [
-                           SMUL False a_reg (RIReg b_reg) res_lo,
-                           RDY res_hi,
-                           SRA res_lo (RIImm (ImmInt shift_amt)) res_lo,
-                           SUB False False res_lo (RIReg res_hi) dst
-                        ]
-         return (Any I32 code)
-
-getRegister (CmmLoad mem pk) = do
-    Amode src code <- getAmode mem
-    let
-    	code__2 dst = code `snocOL` LD pk src dst
-    return (Any pk code__2)
-
-getRegister (CmmLit (CmmInt i _))
-  | fits13Bits i
-  = let
-    	src = ImmInt (fromInteger i)
-    	code dst = unitOL (OR False g0 (RIImm src) dst)
-    in
-    	return (Any I32 code)
-
-getRegister (CmmLit lit)
-  = let rep = cmmLitRep lit
-	imm = litToImm lit
-    	code dst = toOL [
-    	    SETHI (HI imm) dst,
-    	    OR False dst (RIImm (LO imm)) dst]
-    in return (Any I32 code)
-
-#endif /* sparc_TARGET_ARCH */
-
-#if powerpc_TARGET_ARCH
-getRegister (CmmLoad mem pk)
-  | pk /= I64
-  = do
-        Amode addr addr_code <- getAmode mem
-        let code dst = ASSERT((regClass dst == RcDouble) == isFloatingRep pk)
-                       addr_code `snocOL` LD pk dst addr
-        return (Any pk code)
-
--- catch simple cases of zero- or sign-extended load
-getRegister (CmmMachOp (MO_U_Conv I8 I32) [CmmLoad mem _]) = do
-    Amode addr addr_code <- getAmode mem
-    return (Any I32 (\dst -> addr_code `snocOL` LD I8 dst addr))
-
--- Note: there is no Load Byte Arithmetic instruction, so no signed case here
-
-getRegister (CmmMachOp (MO_U_Conv I16 I32) [CmmLoad mem _]) = do
-    Amode addr addr_code <- getAmode mem
-    return (Any I32 (\dst -> addr_code `snocOL` LD I16 dst addr))
-
-getRegister (CmmMachOp (MO_S_Conv I16 I32) [CmmLoad mem _]) = do
-    Amode addr addr_code <- getAmode mem
-    return (Any I32 (\dst -> addr_code `snocOL` LA I16 dst addr))
-
-getRegister (CmmMachOp mop [x]) -- unary MachOps
-  = case mop of
-      MO_Not rep   -> trivialUCode rep NOT x
-
-      MO_S_Conv F64 F32 -> trivialUCode F32 FRSP x
-      MO_S_Conv F32 F64 -> conversionNop F64 x
-
-      MO_S_Conv from to
-        | from == to         -> conversionNop to x
-	| isFloatingRep from -> coerceFP2Int from to x
-	| isFloatingRep to   -> coerceInt2FP from to x
-
-        -- narrowing is a nop: we treat the high bits as undefined
-      MO_S_Conv I32 to -> conversionNop to x
-      MO_S_Conv I16 I8 -> conversionNop I8 x
-      MO_S_Conv I8 to -> trivialUCode to (EXTS I8) x
-      MO_S_Conv I16 to -> trivialUCode to (EXTS I16) x
-
-      MO_U_Conv from to
-        | from == to -> conversionNop to x
-        -- narrowing is a nop: we treat the high bits as undefined
-      MO_U_Conv I32 to -> conversionNop to x
-      MO_U_Conv I16 I8 -> conversionNop I8 x
-      MO_U_Conv I8 to -> trivialCode to False AND x (CmmLit (CmmInt 255 I32))
-      MO_U_Conv I16 to -> trivialCode to False AND x (CmmLit (CmmInt 65535 I32)) 
-
-      MO_S_Neg F32      -> trivialUCode F32 FNEG x
-      MO_S_Neg F64      -> trivialUCode F64 FNEG x
-      MO_S_Neg rep      -> trivialUCode rep NEG x
-      
-    where
-        conversionNop new_rep expr
-            = do e_code <- getRegister expr
-                 return (swizzleRegisterRep e_code new_rep)
-
-getRegister (CmmMachOp mop [x, y]) -- dyadic PrimOps
-  = case mop of
-      MO_Eq F32 -> condFltReg EQQ x y
-      MO_Ne F32 -> condFltReg NE  x y
-
-      MO_S_Gt F32 -> condFltReg GTT x y
-      MO_S_Ge F32 -> condFltReg GE  x y
-      MO_S_Lt F32 -> condFltReg LTT x y
-      MO_S_Le F32 -> condFltReg LE  x y
-
-      MO_Eq F64 -> condFltReg EQQ x y
-      MO_Ne F64 -> condFltReg NE  x y
-
-      MO_S_Gt F64 -> condFltReg GTT x y
-      MO_S_Ge F64 -> condFltReg GE  x y
-      MO_S_Lt F64 -> condFltReg LTT x y
-      MO_S_Le F64 -> condFltReg LE  x y
-
-      MO_Eq rep -> condIntReg EQQ  (extendUExpr rep x) (extendUExpr rep y)
-      MO_Ne rep -> condIntReg NE   (extendUExpr rep x) (extendUExpr rep y)
-
-      MO_S_Gt rep -> condIntReg GTT  (extendSExpr rep x) (extendSExpr rep y)
-      MO_S_Ge rep -> condIntReg GE   (extendSExpr rep x) (extendSExpr rep y)
-      MO_S_Lt rep -> condIntReg LTT  (extendSExpr rep x) (extendSExpr rep y)
-      MO_S_Le rep -> condIntReg LE   (extendSExpr rep x) (extendSExpr rep y)
-
-      MO_U_Gt rep -> condIntReg GU   (extendUExpr rep x) (extendUExpr rep y)
-      MO_U_Ge rep -> condIntReg GEU  (extendUExpr rep x) (extendUExpr rep y)
-      MO_U_Lt rep -> condIntReg LU   (extendUExpr rep x) (extendUExpr rep y)
-      MO_U_Le rep -> condIntReg LEU  (extendUExpr rep x) (extendUExpr rep y)
-
-      MO_Add F32   -> trivialCodeNoImm F32 (FADD F32) x y
-      MO_Sub F32   -> trivialCodeNoImm F32 (FSUB F32) x y
-      MO_Mul F32   -> trivialCodeNoImm F32 (FMUL F32) x y
-      MO_S_Quot F32   -> trivialCodeNoImm F32 (FDIV F32) x y
-      
-      MO_Add F64   -> trivialCodeNoImm F64 (FADD F64) x y
-      MO_Sub F64   -> trivialCodeNoImm F64 (FSUB F64) x y
-      MO_Mul F64   -> trivialCodeNoImm F64 (FMUL F64) x y
-      MO_S_Quot F64   -> trivialCodeNoImm F64 (FDIV F64) x y
-
-         -- optimize addition with 32-bit immediate
-         -- (needed for PIC)
-      MO_Add I32 ->
-        case y of
-          CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate I32 True (-imm)
-            -> trivialCode I32 True ADD x (CmmLit $ CmmInt imm immrep)
-          CmmLit lit
-            -> do
-                (src, srcCode) <- getSomeReg x
-                let imm = litToImm lit
-                    code dst = srcCode `appOL` toOL [
-                                    ADDIS dst src (HA imm),
-                                    ADD dst dst (RIImm (LO imm))
-                                ]
-                return (Any I32 code)
-          _ -> trivialCode I32 True ADD x y
-
-      MO_Add rep -> trivialCode rep True ADD x y
-      MO_Sub rep ->
-        case y of    -- subfi ('substract from' with immediate) doesn't exist
-          CmmLit (CmmInt imm immrep) | Just _ <- makeImmediate rep True (-imm)
-            -> trivialCode rep True ADD x (CmmLit $ CmmInt (-imm) immrep)
-          _ -> trivialCodeNoImm rep SUBF y x
-
-      MO_Mul rep -> trivialCode rep True MULLW x y
-
-      MO_S_MulMayOflo I32 -> trivialCodeNoImm I32 MULLW_MayOflo x y
-      
-      MO_S_MulMayOflo rep -> panic "S_MulMayOflo (rep /= I32): not implemented"
-      MO_U_MulMayOflo rep -> panic "U_MulMayOflo: not implemented"
-
-      MO_S_Quot rep -> trivialCodeNoImm rep DIVW (extendSExpr rep x) (extendSExpr rep y)
-      MO_U_Quot rep -> trivialCodeNoImm rep DIVWU (extendUExpr rep x) (extendUExpr rep y)
-      
-      MO_S_Rem rep -> remainderCode rep DIVW (extendSExpr rep x) (extendSExpr rep y)
-      MO_U_Rem rep -> remainderCode rep DIVWU (extendUExpr rep x) (extendUExpr rep y)
-      
-      MO_And rep   -> trivialCode rep False AND x y
-      MO_Or rep    -> trivialCode rep False OR x y
-      MO_Xor rep   -> trivialCode rep False XOR x y
-
-      MO_Shl rep   -> trivialCode rep False SLW x y
-      MO_S_Shr rep -> trivialCode rep False SRAW (extendSExpr rep x) y
-      MO_U_Shr rep -> trivialCode rep False SRW (extendUExpr rep x) y
-
-getRegister (CmmLit (CmmInt i rep))
-  | Just imm <- makeImmediate rep True i
-  = let
-    	code dst = unitOL (LI dst imm)
-    in
-    	return (Any rep code)
-
-getRegister (CmmLit (CmmFloat f frep)) = do
-    lbl <- getNewLabelNat
-    dynRef <- cmmMakeDynamicReference addImportNat False lbl
-    Amode addr addr_code <- getAmode dynRef
-    let code dst = 
-	    LDATA ReadOnlyData  [CmmDataLabel lbl,
-				 CmmStaticLit (CmmFloat f frep)]
-            `consOL` (addr_code `snocOL` LD frep dst addr)
-    return (Any frep code)
-
-getRegister (CmmLit lit)
-  = let rep = cmmLitRep lit
-        imm = litToImm lit
-        code dst = toOL [
-              LIS dst (HI imm),
-              OR dst dst (RIImm (LO imm))
-          ]
-    in return (Any rep code)
-
-getRegister other = pprPanic "getRegister(ppc)" (pprExpr other)
-    
-    -- extend?Rep: wrap integer expression of type rep
-    -- in a conversion to I32
-extendSExpr I32 x = x
-extendSExpr rep x = CmmMachOp (MO_S_Conv rep I32) [x]
-extendUExpr I32 x = x
-extendUExpr rep x = CmmMachOp (MO_U_Conv rep I32) [x]
-
-#endif /* powerpc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
---  The 'Amode' type: Memory addressing modes passed up the tree.
-
-data Amode = Amode AddrMode InstrBlock
-
-{-
-Now, given a tree (the argument to an CmmLoad) that references memory,
-produce a suitable addressing mode.
-
-A Rule of the Game (tm) for Amodes: use of the addr bit must
-immediately follow use of the code part, since the code part puts
-values in registers which the addr then refers to.  So you can't put
-anything in between, lest it overwrite some of those registers.  If
-you need to do some other computation between the code part and use of
-the addr bit, first store the effective address from the amode in a
-temporary, then do the other computation, and then use the temporary:
-
-    code
-    LEA amode, tmp
-    ... other computation ...
-    ... (tmp) ...
--}
-
-getAmode :: CmmExpr -> NatM Amode
-getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree)
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if alpha_TARGET_ARCH
-
-getAmode (StPrim IntSubOp [x, StInt i])
-  = getNewRegNat PtrRep		`thenNat` \ tmp ->
-    getRegister x		`thenNat` \ register ->
-    let
-    	code = registerCode register tmp
-    	reg  = registerName register tmp
-    	off  = ImmInt (-(fromInteger i))
-    in
-    return (Amode (AddrRegImm reg off) code)
-
-getAmode (StPrim IntAddOp [x, StInt i])
-  = getNewRegNat PtrRep		`thenNat` \ tmp ->
-    getRegister x		`thenNat` \ register ->
-    let
-    	code = registerCode register tmp
-    	reg  = registerName register tmp
-    	off  = ImmInt (fromInteger i)
-    in
-    return (Amode (AddrRegImm reg off) code)
-
-getAmode leaf
-  | isJust imm
-  = return (Amode (AddrImm imm__2) id)
-  where
-    imm = maybeImm leaf
-    imm__2 = case imm of Just x -> x
-
-getAmode other
-  = getNewRegNat PtrRep		`thenNat` \ tmp ->
-    getRegister other		`thenNat` \ register ->
-    let
-    	code = registerCode register tmp
-    	reg  = registerName register tmp
-    in
-    return (Amode (AddrReg reg) code)
-
-#endif /* alpha_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
--- This is all just ridiculous, since it carefully undoes 
--- what mangleIndexTree has just done.
-getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit lit@(CmmInt i _)])
-  | not (is64BitLit lit)
-  -- ASSERT(rep == I32)???
-  = do (x_reg, x_code) <- getSomeReg x
-       let off = ImmInt (-(fromInteger i))
-       return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
-  
-getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit@(CmmInt i _)])
-  | not (is64BitLit lit)
-  -- ASSERT(rep == I32)???
-  = do (x_reg, x_code) <- getSomeReg x
-       let off = ImmInt (fromInteger i)
-       return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
-
--- Turn (lit1 << n  + lit2) into  (lit2 + lit1 << n) so it will be 
--- recognised by the next rule.
-getAmode (CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _),
-				  b@(CmmLit _)])
-  = getAmode (CmmMachOp (MO_Add rep) [b,a])
-
-getAmode (CmmMachOp (MO_Add rep) [x, CmmMachOp (MO_Shl _) 
-					[y, CmmLit (CmmInt shift _)]])
-  | shift == 0 || shift == 1 || shift == 2 || shift == 3
-  = do (x_reg, x_code) <- getNonClobberedReg x
-	-- x must be in a temp, because it has to stay live over y_code
-	-- we could compre x_reg and y_reg and do something better here...
-       (y_reg, y_code) <- getSomeReg y
-       let
-    	   code = x_code `appOL` y_code
-           base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8
-       return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt 0))
-               code)
-
-getAmode (CmmLit lit) | not (is64BitLit lit)
-  = return (Amode (ImmAddr (litToImm lit) 0) nilOL)
-
-getAmode expr = do
-  (reg,code) <- getSomeReg expr
-  return (Amode (AddrBaseIndex (EABaseReg reg) EAIndexNone (ImmInt 0)) code)
-
-#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if sparc_TARGET_ARCH
-
-getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit (CmmInt i _)])
-  | fits13Bits (-i)
-  = do
-       (reg, code) <- getSomeReg x
-       let
-         off  = ImmInt (-(fromInteger i))
-       return (Amode (AddrRegImm reg off) code)
-
-
-getAmode (CmmMachOp (MO_Add rep) [x, CmmLit (CmmInt i _)])
-  | fits13Bits i
-  = do
-       (reg, code) <- getSomeReg x
-       let
-     	 off  = ImmInt (fromInteger i)
-       return (Amode (AddrRegImm reg off) code)
-
-getAmode (CmmMachOp (MO_Add rep) [x, y])
-  = do
-    (regX, codeX) <- getSomeReg x
-    (regY, codeY) <- getSomeReg y
-    let
-    	code = codeX `appOL` codeY
-    return (Amode (AddrRegReg regX regY) code)
-
--- XXX Is this same as "leaf" in Stix?
-getAmode (CmmLit lit)
-  = do
-      tmp <- getNewRegNat I32
-      let
-    	code = unitOL (SETHI (HI imm__2) tmp)
-      return (Amode (AddrRegImm tmp (LO imm__2)) code)
-      where
-         imm__2 = litToImm lit
-
-getAmode other
-  = do
-       (reg, code) <- getSomeReg other
-       let
-    	    off  = ImmInt 0
-       return (Amode (AddrRegImm reg off) code)
-
-#endif /* sparc_TARGET_ARCH */
-
-#ifdef powerpc_TARGET_ARCH
-getAmode (CmmMachOp (MO_Sub I32) [x, CmmLit (CmmInt i _)])
-  | Just off <- makeImmediate I32 True (-i)
-  = do
-        (reg, code) <- getSomeReg x
-        return (Amode (AddrRegImm reg off) code)
-
-
-getAmode (CmmMachOp (MO_Add I32) [x, CmmLit (CmmInt i _)])
-  | Just off <- makeImmediate I32 True i
-  = do
-        (reg, code) <- getSomeReg x
-        return (Amode (AddrRegImm reg off) code)
-
-   -- optimize addition with 32-bit immediate
-   -- (needed for PIC)
-getAmode (CmmMachOp (MO_Add I32) [x, CmmLit lit])
-  = do
-        tmp <- getNewRegNat I32
-        (src, srcCode) <- getSomeReg x
-        let imm = litToImm lit
-            code = srcCode `snocOL` ADDIS tmp src (HA imm)
-        return (Amode (AddrRegImm tmp (LO imm)) code)
-
-getAmode (CmmLit lit)
-  = do
-        tmp <- getNewRegNat I32
-        let imm = litToImm lit
-            code = unitOL (LIS tmp (HA imm))
-        return (Amode (AddrRegImm tmp (LO imm)) code)
-    
-getAmode (CmmMachOp (MO_Add I32) [x, y])
-  = do
-        (regX, codeX) <- getSomeReg x
-        (regY, codeY) <- getSomeReg y
-        return (Amode (AddrRegReg regX regY) (codeX `appOL` codeY))
-    
-getAmode other
-  = do
-        (reg, code) <- getSomeReg other
-        let
-            off  = ImmInt 0
-        return (Amode (AddrRegImm reg off) code)
-#endif /* powerpc_TARGET_ARCH */
-
--- -----------------------------------------------------------------------------
--- getOperand: sometimes any operand will do.
-
--- getNonClobberedOperand: the value of the operand will remain valid across
--- the computation of an arbitrary expression, unless the expression
--- is computed directly into a register which the operand refers to
--- (see trivialCode where this function is used for an example).
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
-getNonClobberedOperand :: CmmExpr -> NatM (Operand, InstrBlock)
-#if x86_64_TARGET_ARCH
-getNonClobberedOperand (CmmLit lit)
-  | isSuitableFloatingPointLit lit = do
-    lbl <- getNewLabelNat
-    let code = unitOL (LDATA ReadOnlyData  [CmmDataLabel lbl,
-					   CmmStaticLit lit])
-    return (OpAddr (ripRel (ImmCLbl lbl)), code)
-#endif
-getNonClobberedOperand (CmmLit lit)
-  | not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) =
-    return (OpImm (litToImm lit), nilOL)
-getNonClobberedOperand (CmmLoad mem pk) 
-  | IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
-    Amode src mem_code <- getAmode mem
-    (src',save_code) <- 
-	if (amodeCouldBeClobbered src) 
-		then do
-		   tmp <- getNewRegNat wordRep
-		   return (AddrBaseIndex (EABaseReg tmp) EAIndexNone (ImmInt 0),
-			   unitOL (LEA I32 (OpAddr src) (OpReg tmp)))
-		else
-		   return (src, nilOL)
-    return (OpAddr src', save_code `appOL` mem_code)
-getNonClobberedOperand e = do
-    (reg, code) <- getNonClobberedReg e
-    return (OpReg reg, code)
-
-amodeCouldBeClobbered :: AddrMode -> Bool
-amodeCouldBeClobbered amode = any regClobbered (addrModeRegs amode)
-
-regClobbered (RealReg rr) = isFastTrue (freeReg rr)
-regClobbered _ = False
-
--- getOperand: the operand is not required to remain valid across the
--- computation of an arbitrary expression.
-getOperand :: CmmExpr -> NatM (Operand, InstrBlock)
-#if x86_64_TARGET_ARCH
-getOperand (CmmLit lit)
-  | isSuitableFloatingPointLit lit = do
-    lbl <- getNewLabelNat
-    let code = unitOL (LDATA ReadOnlyData  [CmmDataLabel lbl,
-					   CmmStaticLit lit])
-    return (OpAddr (ripRel (ImmCLbl lbl)), code)
-#endif
-getOperand (CmmLit lit)
-  | not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) = do
-    return (OpImm (litToImm lit), nilOL)
-getOperand (CmmLoad mem pk)
-  | IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
-    Amode src mem_code <- getAmode mem
-    return (OpAddr src, mem_code)
-getOperand e = do
-    (reg, code) <- getSomeReg e
-    return (OpReg reg, code)
-
-isOperand :: CmmExpr -> Bool
-isOperand (CmmLoad _ _) = True
-isOperand (CmmLit lit)  = not (is64BitLit lit)
-			  || isSuitableFloatingPointLit lit
-isOperand _             = False
-
--- if we want a floating-point literal as an operand, we can
--- use it directly from memory.  However, if the literal is
--- zero, we're better off generating it into a register using
--- xor.
-isSuitableFloatingPointLit (CmmFloat f _) = f /= 0.0
-isSuitableFloatingPointLit _ = False
-
-getRegOrMem :: CmmExpr -> NatM (Operand, InstrBlock)
-getRegOrMem (CmmLoad mem pk)
-  | IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
-    Amode src mem_code <- getAmode mem
-    return (OpAddr src, mem_code)
-getRegOrMem e = do
-    (reg, code) <- getNonClobberedReg e
-    return (OpReg reg, code)
-
-#if x86_64_TARGET_ARCH
-is64BitLit (CmmInt i I64) = is64BitInteger i
-   -- assume that labels are in the range 0-2^31-1: this assumes the
-   -- small memory model (see gcc docs, -mcmodel=small).
-#endif
-is64BitLit x = False
-#endif
-
-is64BitInteger :: Integer -> Bool
-is64BitInteger i = i > 0x7fffffff || i < -0x80000000
-
--- -----------------------------------------------------------------------------
---  The 'CondCode' type:  Condition codes passed up the tree.
-
-data CondCode = CondCode Bool Cond InstrBlock
-
--- Set up a condition code for a conditional branch.
-
-getCondCode :: CmmExpr -> NatM CondCode
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if alpha_TARGET_ARCH
-getCondCode = panic "MachCode.getCondCode: not on Alphas"
-#endif /* alpha_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
--- yes, they really do seem to want exactly the same!
-
-getCondCode (CmmMachOp mop [x, y])
-  = ASSERT (cmmExprRep x /= I8) -- tmp, not set up to handle 8-bit comparisons
-    case mop of
-      MO_Eq F32 -> condFltCode EQQ x y
-      MO_Ne F32 -> condFltCode NE  x y
-
-      MO_S_Gt F32 -> condFltCode GTT x y
-      MO_S_Ge F32 -> condFltCode GE  x y
-      MO_S_Lt F32 -> condFltCode LTT x y
-      MO_S_Le F32 -> condFltCode LE  x y
-
-      MO_Eq F64 -> condFltCode EQQ x y
-      MO_Ne F64 -> condFltCode NE  x y
-
-      MO_S_Gt F64 -> condFltCode GTT x y
-      MO_S_Ge F64 -> condFltCode GE  x y
-      MO_S_Lt F64 -> condFltCode LTT x y
-      MO_S_Le F64 -> condFltCode LE  x y
-
-      MO_Eq rep -> condIntCode EQQ  x y
-      MO_Ne rep -> condIntCode NE   x y
-
-      MO_S_Gt rep -> condIntCode GTT  x y
-      MO_S_Ge rep -> condIntCode GE   x y
-      MO_S_Lt rep -> condIntCode LTT  x y
-      MO_S_Le rep -> condIntCode LE   x y
-
-      MO_U_Gt rep -> condIntCode GU   x y
-      MO_U_Ge rep -> condIntCode GEU  x y
-      MO_U_Lt rep -> condIntCode LU   x y
-      MO_U_Le rep -> condIntCode LEU  x y
-
-      other -> pprPanic "getCondCode(x86,sparc)" (pprMachOp mop)
-
-getCondCode other =  pprPanic "getCondCode(2)(x86,sparc)" (ppr other)
-
-#elif powerpc_TARGET_ARCH
-
--- almost the same as everywhere else - but we need to
--- extend small integers to 32 bit first
-
-getCondCode (CmmMachOp mop [x, y])
-  = case mop of
-      MO_Eq F32 -> condFltCode EQQ x y
-      MO_Ne F32 -> condFltCode NE  x y
-
-      MO_S_Gt F32 -> condFltCode GTT x y
-      MO_S_Ge F32 -> condFltCode GE  x y
-      MO_S_Lt F32 -> condFltCode LTT x y
-      MO_S_Le F32 -> condFltCode LE  x y
-
-      MO_Eq F64 -> condFltCode EQQ x y
-      MO_Ne F64 -> condFltCode NE  x y
-
-      MO_S_Gt F64 -> condFltCode GTT x y
-      MO_S_Ge F64 -> condFltCode GE  x y
-      MO_S_Lt F64 -> condFltCode LTT x y
-      MO_S_Le F64 -> condFltCode LE  x y
-
-      MO_Eq rep -> condIntCode EQQ  (extendUExpr rep x) (extendUExpr rep y)
-      MO_Ne rep -> condIntCode NE   (extendUExpr rep x) (extendUExpr rep y)
-
-      MO_S_Gt rep -> condIntCode GTT  (extendSExpr rep x) (extendSExpr rep y)
-      MO_S_Ge rep -> condIntCode GE   (extendSExpr rep x) (extendSExpr rep y)
-      MO_S_Lt rep -> condIntCode LTT  (extendSExpr rep x) (extendSExpr rep y)
-      MO_S_Le rep -> condIntCode LE   (extendSExpr rep x) (extendSExpr rep y)
-
-      MO_U_Gt rep -> condIntCode GU   (extendUExpr rep x) (extendUExpr rep y)
-      MO_U_Ge rep -> condIntCode GEU  (extendUExpr rep x) (extendUExpr rep y)
-      MO_U_Lt rep -> condIntCode LU   (extendUExpr rep x) (extendUExpr rep y)
-      MO_U_Le rep -> condIntCode LEU  (extendUExpr rep x) (extendUExpr rep y)
-
-      other -> pprPanic "getCondCode(powerpc)" (pprMachOp mop)
-
-getCondCode other =  panic "getCondCode(2)(powerpc)"
-
-
-#endif
-
-
--- @cond(Int|Flt)Code@: Turn a boolean expression into a condition, to be
--- passed back up the tree.
-
-condIntCode, condFltCode :: Cond -> CmmExpr -> CmmExpr -> NatM CondCode
-
-#if alpha_TARGET_ARCH
-condIntCode = panic "MachCode.condIntCode: not on Alphas"
-condFltCode = panic "MachCode.condFltCode: not on Alphas"
-#endif /* alpha_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
--- memory vs immediate
-condIntCode cond (CmmLoad x pk) (CmmLit lit) | not (is64BitLit lit) = do
-    Amode x_addr x_code <- getAmode x
-    let
-	imm  = litToImm lit
-    	code = x_code `snocOL`
-    	    	  CMP pk (OpImm imm) (OpAddr x_addr)
-    --
-    return (CondCode False cond code)
-
--- anything vs zero
-condIntCode cond x (CmmLit (CmmInt 0 pk)) = do
-    (x_reg, x_code) <- getSomeReg x
-    let
-	code = x_code `snocOL`
-    	    	  TEST pk (OpReg x_reg) (OpReg x_reg)
-    --
-    return (CondCode False cond code)
-
--- anything vs operand
-condIntCode cond x y | isOperand y = do
-    (x_reg, x_code) <- getNonClobberedReg x
-    (y_op,  y_code) <- getOperand y    
-    let
-	code = x_code `appOL` y_code `snocOL`
-                  CMP (cmmExprRep x) y_op (OpReg x_reg)
-    -- in
-    return (CondCode False cond code)
-
--- anything vs anything
-condIntCode cond x y = do
-  (y_reg, y_code) <- getNonClobberedReg y
-  (x_op, x_code) <- getRegOrMem x
-  let
-	code = y_code `appOL`
-	       x_code `snocOL`
-    	    	  CMP (cmmExprRep x) (OpReg y_reg) x_op
-  -- in
-  return (CondCode False cond code)
-#endif
-
-#if i386_TARGET_ARCH
-condFltCode cond x y 
-  = ASSERT(cond `elem` ([EQQ, NE, LE, LTT, GE, GTT])) do
-  (x_reg, x_code) <- getNonClobberedReg x
-  (y_reg, y_code) <- getSomeReg y
-  let
-	code = x_code `appOL` y_code `snocOL`
-		GCMP cond x_reg y_reg
-  -- The GCMP insn does the test and sets the zero flag if comparable
-  -- and true.  Hence we always supply EQQ as the condition to test.
-  return (CondCode True EQQ code)
-#endif /* i386_TARGET_ARCH */
-
-#if x86_64_TARGET_ARCH
--- in the SSE2 comparison ops (ucomiss, ucomisd) the left arg may be
--- an operand, but the right must be a reg.  We can probably do better
--- than this general case...
-condFltCode cond x y = do
-  (x_reg, x_code) <- getNonClobberedReg x
-  (y_op, y_code) <- getOperand y
-  let
-	code = x_code `appOL`
-	       y_code `snocOL`
-    	    	  CMP (cmmExprRep x) y_op (OpReg x_reg)
-	-- NB(1): we need to use the unsigned comparison operators on the
-	-- result of this comparison.
-  -- in
-  return (CondCode True (condToUnsigned cond) code)
-#endif
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if sparc_TARGET_ARCH
-
-condIntCode cond x (CmmLit (CmmInt y rep))
-  | fits13Bits y
-  = do
-       (src1, code) <- getSomeReg x
-       let
-           src2 = ImmInt (fromInteger y)
-           code' = code `snocOL` SUB False True src1 (RIImm src2) g0
-       return (CondCode False cond code')
-
-condIntCode cond x y = do
-    (src1, code1) <- getSomeReg x
-    (src2, code2) <- getSomeReg y
-    let
-	code__2 = code1 `appOL` code2 `snocOL`
-    	    	  SUB False True src1 (RIReg src2) g0
-    return (CondCode False cond code__2)
-
------------
-condFltCode cond x y = do
-    (src1, code1) <- getSomeReg x
-    (src2, code2) <- getSomeReg y
-    tmp <- getNewRegNat F64
-    let
-   	promote x = FxTOy F32 F64 x tmp
-
-    	pk1   = cmmExprRep x
-    	pk2   = cmmExprRep y
-
-    	code__2 =
-		if pk1 == pk2 then
-    	            code1 `appOL` code2 `snocOL`
-    	    	    FCMP True pk1 src1 src2
-    	    	else if pk1 == F32 then
-    	    	    code1 `snocOL` promote src1 `appOL` code2 `snocOL`
-    	    	    FCMP True F64 tmp src2
-    	    	else
-    	    	    code1 `appOL` code2 `snocOL` promote src2 `snocOL`
-    	    	    FCMP True F64 src1 tmp
-    return (CondCode True cond code__2)
-
-#endif /* sparc_TARGET_ARCH */
-
-#if powerpc_TARGET_ARCH
---  ###FIXME: I16 and I8!
-condIntCode cond x (CmmLit (CmmInt y rep))
-  | Just src2 <- makeImmediate rep (not $ condUnsigned cond) y
-  = do
-        (src1, code) <- getSomeReg x
-        let
-            code' = code `snocOL` 
-                (if condUnsigned cond then CMPL else CMP) I32 src1 (RIImm src2)
-        return (CondCode False cond code')
-
-condIntCode cond x y = do
-    (src1, code1) <- getSomeReg x
-    (src2, code2) <- getSomeReg y
-    let
-	code' = code1 `appOL` code2 `snocOL`
-    	    	  (if condUnsigned cond then CMPL else CMP) I32 src1 (RIReg src2)
-    return (CondCode False cond code')
-
-condFltCode cond x y = do
-    (src1, code1) <- getSomeReg x
-    (src2, code2) <- getSomeReg y
-    let
-	code'  = code1 `appOL` code2 `snocOL` FCMP src1 src2
-	code'' = case cond of -- twiddle CR to handle unordered case
-                    GE -> code' `snocOL` CRNOR ltbit eqbit gtbit
-	            LE -> code' `snocOL` CRNOR gtbit eqbit ltbit
-	            _ -> code'
-                 where
-                    ltbit = 0 ; eqbit = 2 ; gtbit = 1
-    return (CondCode True cond code'')
-
-#endif /* powerpc_TARGET_ARCH */
-
--- -----------------------------------------------------------------------------
--- Generating assignments
-
--- Assignments are really at the heart of the whole code generation
--- business.  Almost all top-level nodes of any real importance are
--- assignments, which correspond to loads, stores, or register
--- transfers.  If we're really lucky, some of the register transfers
--- will go away, because we can use the destination register to
--- complete the code generation for the right hand side.  This only
--- fails when the right hand side is forced into a fixed register
--- (e.g. the result of a call).
-
-assignMem_IntCode :: MachRep -> CmmExpr -> CmmExpr -> NatM InstrBlock
-assignReg_IntCode :: MachRep -> CmmReg  -> CmmExpr -> NatM InstrBlock
-
-assignMem_FltCode :: MachRep -> CmmExpr -> CmmExpr -> NatM InstrBlock
-assignReg_FltCode :: MachRep -> CmmReg  -> CmmExpr -> NatM InstrBlock
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if alpha_TARGET_ARCH
-
-assignIntCode pk (CmmLoad dst _) src
-  = getNewRegNat IntRep    	    `thenNat` \ tmp ->
-    getAmode dst    	    	    `thenNat` \ amode ->
-    getRegister src	     	    `thenNat` \ register ->
-    let
-    	code1   = amodeCode amode []
-    	dst__2  = amodeAddr amode
-    	code2   = registerCode register tmp []
-    	src__2  = registerName register tmp
-    	sz      = primRepToSize pk
-    	code__2 = asmSeqThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
-    in
-    return code__2
-
-assignIntCode pk dst src
-  = getRegister dst	    	    	    `thenNat` \ register1 ->
-    getRegister src	    	    	    `thenNat` \ register2 ->
-    let
-    	dst__2  = registerName register1 zeroh
-    	code    = registerCode register2 dst__2
-    	src__2  = registerName register2 dst__2
-    	code__2 = if isFixed register2
-		  then code . mkSeqInstr (OR src__2 (RIReg src__2) dst__2)
-    	    	  else code
-    in
-    return code__2
-
-#endif /* alpha_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
--- integer assignment to memory
-assignMem_IntCode pk addr src = do
-    Amode addr code_addr <- getAmode addr
-    (code_src, op_src)   <- get_op_RI src
-    let
-	code = code_src `appOL`
-	       code_addr `snocOL`
-                  MOV pk op_src (OpAddr addr)
-	-- NOTE: op_src is stable, so it will still be valid
-	-- after code_addr.  This may involve the introduction 
-	-- of an extra MOV to a temporary register, but we hope
-	-- the register allocator will get rid of it.
-    --
-    return code
-  where
-    get_op_RI :: CmmExpr -> NatM (InstrBlock,Operand)	-- code, operator
-    get_op_RI (CmmLit lit) | not (is64BitLit lit)
-      = return (nilOL, OpImm (litToImm lit))
-    get_op_RI op
-      = do (reg,code) <- getNonClobberedReg op
-	   return (code, OpReg reg)
-
-
--- Assign; dst is a reg, rhs is mem
-assignReg_IntCode pk reg (CmmLoad src _) = do
-  load_code <- intLoadCode (MOV pk) src
-  return (load_code (getRegisterReg reg))
-
--- dst is a reg, but src could be anything
-assignReg_IntCode pk reg src = do
-  code <- getAnyReg src
-  return (code (getRegisterReg reg))
-
-#endif /* i386_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if sparc_TARGET_ARCH
-
-assignMem_IntCode pk addr src = do
-    (srcReg, code) <- getSomeReg src
-    Amode dstAddr addr_code <- getAmode addr
-    return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
-
-assignReg_IntCode pk reg src = do
-    r <- getRegister src
-    return $ case r of
-	Any _ code         -> code dst
-	Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg dst) freg
-    where
-      dst = getRegisterReg reg
-
-
-#endif /* sparc_TARGET_ARCH */
-
-#if powerpc_TARGET_ARCH
-
-assignMem_IntCode pk addr src = do
-    (srcReg, code) <- getSomeReg src
-    Amode dstAddr addr_code <- getAmode addr
-    return $ code `appOL` addr_code `snocOL` ST pk srcReg dstAddr
-
--- dst is a reg, but src could be anything
-assignReg_IntCode pk reg src
-    = do
-        r <- getRegister src
-        return $ case r of
-            Any _ code         -> code dst
-            Fixed _ freg fcode -> fcode `snocOL` MR dst freg
-    where
-        dst = getRegisterReg reg
-
-#endif /* powerpc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- Floating-point assignments
-
-#if alpha_TARGET_ARCH
-
-assignFltCode pk (CmmLoad dst _) src
-  = getNewRegNat pk        	    `thenNat` \ tmp ->
-    getAmode dst    	    	    `thenNat` \ amode ->
-    getRegister src	    	    	    `thenNat` \ register ->
-    let
-    	code1   = amodeCode amode []
-    	dst__2  = amodeAddr amode
-    	code2   = registerCode register tmp []
-    	src__2  = registerName register tmp
-    	sz      = primRepToSize pk
-    	code__2 = asmSeqThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
-    in
-    return code__2
-
-assignFltCode pk dst src
-  = getRegister dst	    	    	    `thenNat` \ register1 ->
-    getRegister src	    	    	    `thenNat` \ register2 ->
-    let
-    	dst__2  = registerName register1 zeroh
-    	code    = registerCode register2 dst__2
-    	src__2  = registerName register2 dst__2
-    	code__2 = if isFixed register2
-		  then code . mkSeqInstr (FMOV src__2 dst__2)
-		  else code
-    in
-    return code__2
-
-#endif /* alpha_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
--- Floating point assignment to memory
-assignMem_FltCode pk addr src = do
-  (src_reg, src_code) <- getNonClobberedReg src
-  Amode addr addr_code <- getAmode addr
-  let
-	code = src_code `appOL`
-	       addr_code `snocOL`
-                IF_ARCH_i386(GST pk src_reg addr,
-		             MOV pk (OpReg src_reg) (OpAddr addr))
-  return code
-
--- Floating point assignment to a register/temporary
-assignReg_FltCode pk reg src = do
-  src_code <- getAnyReg src
-  return (src_code (getRegisterReg reg))
-
-#endif /* i386_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if sparc_TARGET_ARCH
-
--- Floating point assignment to memory
-assignMem_FltCode pk addr src = do
-    Amode dst__2 code1 <- getAmode addr
-    (src__2, code2) <- getSomeReg src
-    tmp1 <- getNewRegNat pk
-    let
-    	pk__2   = cmmExprRep src
-    	code__2 = code1 `appOL` code2 `appOL`
-	    if   pk == pk__2 
-            then unitOL (ST pk src__2 dst__2)
-	    else toOL [FxTOy pk__2 pk src__2 tmp1, ST pk tmp1 dst__2]
-    return code__2
-
--- Floating point assignment to a register/temporary
--- ToDo: Verify correctness
-assignReg_FltCode pk reg src = do
-    r <- getRegister src
-    v1 <- getNewRegNat pk
-    return $ case r of
-        Any _ code         -> code dst
-	Fixed _ freg fcode -> fcode `snocOL` FMOV pk freg v1
-    where
-      dst = getRegisterReg reg
-
-#endif /* sparc_TARGET_ARCH */
-
-#if powerpc_TARGET_ARCH
-
--- Easy, isn't it?
-assignMem_FltCode = assignMem_IntCode
-assignReg_FltCode = assignReg_IntCode
-
-#endif /* powerpc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- Generating an non-local jump
-
--- (If applicable) Do not fill the delay slots here; you will confuse the
--- register allocator.
-
-genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if alpha_TARGET_ARCH
-
-genJump (CmmLabel lbl)
-  | isAsmTemp lbl = returnInstr (BR target)
-  | otherwise     = returnInstrs [LDA pv (AddrImm target), JMP zeroh (AddrReg pv) 0]
-  where
-    target = ImmCLbl lbl
-
-genJump tree
-  = getRegister tree	     	    `thenNat` \ register ->
-    getNewRegNat PtrRep    	    `thenNat` \ tmp ->
-    let
-    	dst    = registerName register pv
-    	code   = registerCode register pv
-    	target = registerName register pv
-    in
-    if isFixed register then
-	returnSeq code [OR dst (RIReg dst) pv, JMP zeroh (AddrReg pv) 0]
-    else
-    return (code . mkSeqInstr (JMP zeroh (AddrReg pv) 0))
-
-#endif /* alpha_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
-genJump (CmmLoad mem pk) = do
-  Amode target code <- getAmode mem
-  return (code `snocOL` JMP (OpAddr target))
-
-genJump (CmmLit lit) = do
-  return (unitOL (JMP (OpImm (litToImm lit))))
-
-genJump expr = do
-  (reg,code) <- getSomeReg expr
-  return (code `snocOL` JMP (OpReg reg))
-
-#endif /* i386_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if sparc_TARGET_ARCH
-
-genJump (CmmLit (CmmLabel lbl))
-  = return (toOL [CALL (Left target) 0 True, NOP])
-  where
-    target = ImmCLbl lbl
-
-genJump tree
-  = do
-        (target, code) <- getSomeReg tree
-	return (code `snocOL` JMP (AddrRegReg target g0)  `snocOL` NOP)
-
-#endif /* sparc_TARGET_ARCH */
-
-#if powerpc_TARGET_ARCH
-genJump (CmmLit (CmmLabel lbl))
-  = return (unitOL $ JMP lbl)
-
-genJump tree
-  = do
-        (target,code) <- getSomeReg tree
-        return (code `snocOL` MTCTR target `snocOL` BCTR [])
-#endif /* powerpc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
---  Unconditional branches
-
-genBranch :: BlockId -> NatM InstrBlock
-
-genBranch = return . toOL . mkBranchInstr
-
--- -----------------------------------------------------------------------------
---  Conditional jumps
-
-{-
-Conditional jumps are always to local labels, so we can use branch
-instructions.  We peek at the arguments to decide what kind of
-comparison to do.
-
-ALPHA: For comparisons with 0, we're laughing, because we can just do
-the desired conditional branch.
-
-I386: First, we have to ensure that the condition
-codes are set according to the supplied comparison operation.
-
-SPARC: First, we have to ensure that the condition codes are set
-according to the supplied comparison operation.  We generate slightly
-different code for floating point comparisons, because a floating
-point operation cannot directly precede a @BF@.  We assume the worst
-and fill that slot with a @NOP@.
-
-SPARC: Do not fill the delay slots here; you will confuse the register
-allocator.
--}
-
-
-genCondJump
-    :: BlockId	    -- the branch target
-    -> CmmExpr      -- the condition on which to branch
-    -> NatM InstrBlock
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if alpha_TARGET_ARCH
-
-genCondJump id (StPrim op [x, StInt 0])
-  = getRegister x	  	    	    `thenNat` \ register ->
-    getNewRegNat (registerRep register)
-    	    	        	    `thenNat` \ tmp ->
-    let
-    	code   = registerCode register tmp
-    	value  = registerName register tmp
-    	pk     = registerRep register
-	target = ImmCLbl lbl
-    in
-    returnSeq code [BI (cmpOp op) value target]
-  where
-    cmpOp CharGtOp = GTT
-    cmpOp CharGeOp = GE
-    cmpOp CharEqOp = EQQ
-    cmpOp CharNeOp = NE
-    cmpOp CharLtOp = LTT
-    cmpOp CharLeOp = LE
-    cmpOp IntGtOp = GTT
-    cmpOp IntGeOp = GE
-    cmpOp IntEqOp = EQQ
-    cmpOp IntNeOp = NE
-    cmpOp IntLtOp = LTT
-    cmpOp IntLeOp = LE
-    cmpOp WordGtOp = NE
-    cmpOp WordGeOp = ALWAYS
-    cmpOp WordEqOp = EQQ
-    cmpOp WordNeOp = NE
-    cmpOp WordLtOp = NEVER
-    cmpOp WordLeOp = EQQ
-    cmpOp AddrGtOp = NE
-    cmpOp AddrGeOp = ALWAYS
-    cmpOp AddrEqOp = EQQ
-    cmpOp AddrNeOp = NE
-    cmpOp AddrLtOp = NEVER
-    cmpOp AddrLeOp = EQQ
-
-genCondJump lbl (StPrim op [x, StDouble 0.0])
-  = getRegister x	  	    	    `thenNat` \ register ->
-    getNewRegNat (registerRep register)
-    	    	        	    `thenNat` \ tmp ->
-    let
-    	code   = registerCode register tmp
-    	value  = registerName register tmp
-    	pk     = registerRep register
-	target = ImmCLbl lbl
-    in
-    return (code . mkSeqInstr (BF (cmpOp op) value target))
-  where
-    cmpOp FloatGtOp = GTT
-    cmpOp FloatGeOp = GE
-    cmpOp FloatEqOp = EQQ
-    cmpOp FloatNeOp = NE
-    cmpOp FloatLtOp = LTT
-    cmpOp FloatLeOp = LE
-    cmpOp DoubleGtOp = GTT
-    cmpOp DoubleGeOp = GE
-    cmpOp DoubleEqOp = EQQ
-    cmpOp DoubleNeOp = NE
-    cmpOp DoubleLtOp = LTT
-    cmpOp DoubleLeOp = LE
-
-genCondJump lbl (StPrim op [x, y])
-  | fltCmpOp op
-  = trivialFCode pr instr x y 	    `thenNat` \ register ->
-    getNewRegNat F64    	    `thenNat` \ tmp ->
-    let
-    	code   = registerCode register tmp
-    	result = registerName register tmp
-	target = ImmCLbl lbl
-    in
-    return (code . mkSeqInstr (BF cond result target))
-  where
-    pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
-
-    fltCmpOp op = case op of
-	FloatGtOp -> True
-	FloatGeOp -> True
-	FloatEqOp -> True
-	FloatNeOp -> True
-	FloatLtOp -> True
-	FloatLeOp -> True
-	DoubleGtOp -> True
-	DoubleGeOp -> True
-	DoubleEqOp -> True
-	DoubleNeOp -> True
-	DoubleLtOp -> True
-	DoubleLeOp -> True
-	_ -> False
-    (instr, cond) = case op of
-	FloatGtOp -> (FCMP TF LE, EQQ)
-	FloatGeOp -> (FCMP TF LTT, EQQ)
-	FloatEqOp -> (FCMP TF EQQ, NE)
-	FloatNeOp -> (FCMP TF EQQ, EQQ)
-	FloatLtOp -> (FCMP TF LTT, NE)
-	FloatLeOp -> (FCMP TF LE, NE)
-	DoubleGtOp -> (FCMP TF LE, EQQ)
-	DoubleGeOp -> (FCMP TF LTT, EQQ)
-	DoubleEqOp -> (FCMP TF EQQ, NE)
-	DoubleNeOp -> (FCMP TF EQQ, EQQ)
-	DoubleLtOp -> (FCMP TF LTT, NE)
-	DoubleLeOp -> (FCMP TF LE, NE)
-
-genCondJump lbl (StPrim op [x, y])
-  = trivialCode instr x y    	    `thenNat` \ register ->
-    getNewRegNat IntRep    	    `thenNat` \ tmp ->
-    let
-    	code   = registerCode register tmp
-    	result = registerName register tmp
-	target = ImmCLbl lbl
-    in
-    return (code . mkSeqInstr (BI cond result target))
-  where
-    (instr, cond) = case op of
-	CharGtOp -> (CMP LE, EQQ)
-	CharGeOp -> (CMP LTT, EQQ)
-	CharEqOp -> (CMP EQQ, NE)
-	CharNeOp -> (CMP EQQ, EQQ)
-	CharLtOp -> (CMP LTT, NE)
-	CharLeOp -> (CMP LE, NE)
-	IntGtOp -> (CMP LE, EQQ)
-	IntGeOp -> (CMP LTT, EQQ)
-	IntEqOp -> (CMP EQQ, NE)
-	IntNeOp -> (CMP EQQ, EQQ)
-	IntLtOp -> (CMP LTT, NE)
-	IntLeOp -> (CMP LE, NE)
-	WordGtOp -> (CMP ULE, EQQ)
-	WordGeOp -> (CMP ULT, EQQ)
-	WordEqOp -> (CMP EQQ, NE)
-	WordNeOp -> (CMP EQQ, EQQ)
-	WordLtOp -> (CMP ULT, NE)
-	WordLeOp -> (CMP ULE, NE)
-	AddrGtOp -> (CMP ULE, EQQ)
-	AddrGeOp -> (CMP ULT, EQQ)
-	AddrEqOp -> (CMP EQQ, NE)
-	AddrNeOp -> (CMP EQQ, EQQ)
-	AddrLtOp -> (CMP ULT, NE)
-	AddrLeOp -> (CMP ULE, NE)
-
-#endif /* alpha_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if i386_TARGET_ARCH
-
-genCondJump id bool = do
-  CondCode _ cond code <- getCondCode bool
-  return (code `snocOL` JXX cond id)
-
-#endif
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if x86_64_TARGET_ARCH
-
-genCondJump id bool = do
-  CondCode is_float cond cond_code <- getCondCode bool
-  if not is_float
-    then
-	return (cond_code `snocOL` JXX cond id)
-    else do
-	lbl <- getBlockIdNat
-
-	-- see comment with condFltReg
-	let code = case cond of
-	  		NE  -> or_unordered
-			GU  -> plain_test
-			GEU -> plain_test
-			_   -> and_ordered
-
-	    plain_test = unitOL (
-		  JXX cond id
-		)
-	    or_unordered = toOL [
-		  JXX cond id,
-		  JXX PARITY id
-		]
-	    and_ordered = toOL [
-		  JXX PARITY lbl,
-		  JXX cond id,
-		  JXX ALWAYS lbl,
-		  NEWBLOCK lbl
-		]
-	return (cond_code `appOL` code)
-
-#endif
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if sparc_TARGET_ARCH
-
-genCondJump (BlockId id) bool = do
-  CondCode is_float cond code <- getCondCode bool
-  return (
-       code `appOL` 
-       toOL (
-         if   is_float
-         then [NOP, BF cond False (ImmCLbl (mkAsmTempLabel id)), NOP]
-         else [BI cond False (ImmCLbl (mkAsmTempLabel id)), NOP]
-       )
-    )
-
-#endif /* sparc_TARGET_ARCH */
-
-
-#if powerpc_TARGET_ARCH
-
-genCondJump id bool = do
-  CondCode is_float cond code <- getCondCode bool
-  return (code `snocOL` BCC cond id)
-
-#endif /* powerpc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
---  Generating C calls
-
--- Now the biggest nightmare---calls.  Most of the nastiness is buried in
--- @get_arg@, which moves the arguments to the correct registers/stack
--- locations.  Apart from that, the code is easy.
--- 
--- (If applicable) Do not fill the delay slots here; you will confuse the
--- register allocator.
-
-genCCall
-    :: CmmCallTarget		-- function to call
-    -> [(CmmReg,MachHint)]	-- where to put the result
-    -> [(CmmExpr,MachHint)]	-- arguments (of mixed type)
-    -> Maybe [GlobalReg]	-- volatile regs to save
-    -> NatM InstrBlock
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if alpha_TARGET_ARCH
-
-ccallResultRegs = 
-
-genCCall fn cconv result_regs args
-  = mapAccumLNat get_arg (allArgRegs, eXTRA_STK_ARGS_HERE) args
-    	    	  	  `thenNat` \ ((unused,_), argCode) ->
-    let
-    	nRegs = length allArgRegs - length unused
-    	code = asmSeqThen (map ($ []) argCode)
-    in
-    	returnSeq code [
-    	    LDA pv (AddrImm (ImmLab (ptext fn))),
-    	    JSR ra (AddrReg pv) nRegs,
-    	    LDGP gp (AddrReg ra)]
-  where
-    ------------------------
-    {-	Try to get a value into a specific register (or registers) for
-	a call.  The first 6 arguments go into the appropriate
-	argument register (separate registers for integer and floating
-	point arguments, but used in lock-step), and the remaining
-	arguments are dumped to the stack, beginning at 0(sp).  Our
-	first argument is a pair of the list of remaining argument
-	registers to be assigned for this call and the next stack
-	offset to use for overflowing arguments.  This way,
-	@get_Arg@ can be applied to all of a call's arguments using
-	@mapAccumLNat@.
-    -}
-    get_arg
-	:: ([(Reg,Reg)], Int)	-- Argument registers and stack offset (accumulator)
-	-> StixTree		-- Current argument
-	-> NatM (([(Reg,Reg)],Int), InstrBlock) -- Updated accumulator and code
-
-    -- We have to use up all of our argument registers first...
-
-    get_arg ((iDst,fDst):dsts, offset) arg
-      = getRegister arg	    	    	    `thenNat` \ register ->
-	let
-	    reg  = if isFloatingRep pk then fDst else iDst
-	    code = registerCode register reg
-	    src  = registerName register reg
-	    pk   = registerRep register
-	in
-	return (
-	    if isFloatingRep pk then
-		((dsts, offset), if isFixed register then
-		    code . mkSeqInstr (FMOV src fDst)
-		    else code)
-	    else
-		((dsts, offset), if isFixed register then
-		    code . mkSeqInstr (OR src (RIReg src) iDst)
-		    else code))
-
-    -- Once we have run out of argument registers, we move to the
-    -- stack...
-
-    get_arg ([], offset) arg
-      = getRegister arg			`thenNat` \ register ->
-	getNewRegNat (registerRep register)
-					`thenNat` \ tmp ->
-	let
-	    code = registerCode register tmp
-	    src  = registerName register tmp
-	    pk   = registerRep register
-	    sz   = primRepToSize pk
-	in
-	return (([], offset + 1), code . mkSeqInstr (ST sz src (spRel offset)))
-
-#endif /* alpha_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if i386_TARGET_ARCH
-
--- we only cope with a single result for foreign calls
-genCCall (CmmPrim op) [(r,_)] args vols = do
-  case op of
-	MO_F32_Sqrt -> actuallyInlineFloatOp F32  (GSQRT F32) args
-	MO_F64_Sqrt -> actuallyInlineFloatOp F64 (GSQRT F64) args
-	
-	MO_F32_Sin  -> actuallyInlineFloatOp F32  (GSIN F32) args
-	MO_F64_Sin  -> actuallyInlineFloatOp F64 (GSIN F64) args
-	
-	MO_F32_Cos  -> actuallyInlineFloatOp F32  (GCOS F32) args
-	MO_F64_Cos  -> actuallyInlineFloatOp F64 (GCOS F64) args
-	
-	MO_F32_Tan  -> actuallyInlineFloatOp F32  (GTAN F32) args
-	MO_F64_Tan  -> actuallyInlineFloatOp F64 (GTAN F64) args
-	
-	other_op    -> outOfLineFloatOp op r args vols
- where
-  actuallyInlineFloatOp rep instr [(x,_)]
-	= do res <- trivialUFCode rep instr x
-	     any <- anyReg res
- 	     return (any (getRegisterReg r))
-
-genCCall target dest_regs args vols = do
-    let
-        sizes               = map (arg_size . cmmExprRep . fst) (reverse args)
-#if !darwin_TARGET_OS        
-        tot_arg_size        = sum sizes
-#else
-        raw_arg_size        = sum sizes
-        tot_arg_size        = roundTo 16 raw_arg_size
-        arg_pad_size        = tot_arg_size - raw_arg_size
-    delta0 <- getDeltaNat
-    setDeltaNat (delta0 - arg_pad_size)
-#endif
-
-    push_codes <- mapM push_arg (reverse args)
-    delta <- getDeltaNat
-
-    -- in
-    -- deal with static vs dynamic call targets
-    (callinsns,cconv) <-
-      case target of
-	-- CmmPrim -> ...
-        CmmForeignCall (CmmLit (CmmLabel lbl)) conv
-           -> -- ToDo: stdcall arg sizes
-	      return (unitOL (CALL (Left fn_imm) []), conv)
-	   where fn_imm = ImmCLbl lbl
-        CmmForeignCall expr conv
-           -> do (dyn_c, dyn_r, dyn_rep) <- get_op expr
-                 ASSERT(dyn_rep == I32)
-                  return (dyn_c `snocOL` CALL (Right dyn_r) [], conv)
-
-    let	push_code
-#if darwin_TARGET_OS
-            | arg_pad_size /= 0
-            = toOL [SUB I32 (OpImm (ImmInt arg_pad_size)) (OpReg esp),
-                    DELTA (delta0 - arg_pad_size)]
-              `appOL` concatOL push_codes
-            | otherwise
-#endif
-            = concatOL push_codes
-	call = callinsns `appOL`
-               toOL (
-			-- Deallocate parameters after call for ccall;
-			-- but not for stdcall (callee does it)
-                  (if cconv == StdCallConv || tot_arg_size==0 then [] else 
-		   [ADD I32 (OpImm (ImmInt tot_arg_size)) (OpReg esp)])
-                  ++
-                  [DELTA (delta + tot_arg_size)]
-               )
-    -- in
-    setDeltaNat (delta + tot_arg_size)
-
-    let
-	-- assign the results, if necessary
-	assign_code []     = nilOL
-	assign_code [(dest,_hint)] = 
-	  case rep of
-		I64 -> toOL [MOV I32 (OpReg eax) (OpReg r_dest),
-			     MOV I32 (OpReg edx) (OpReg r_dest_hi)]
-		F32 -> unitOL (GMOV fake0 r_dest)
-		F64 -> unitOL (GMOV fake0 r_dest)
-		rep -> unitOL (MOV rep (OpReg eax) (OpReg r_dest))
-	  where 
-		r_dest_hi = getHiVRegFromLo r_dest
-		rep = cmmRegRep dest
-		r_dest = getRegisterReg dest
-	assign_code many = panic "genCCall.assign_code many"
-
-    return (push_code `appOL` 
-	    call `appOL` 
-	    assign_code dest_regs)
-
-  where
-    arg_size F64 = 8
-    arg_size F32 = 4
-    arg_size I64 = 8
-    arg_size _   = 4
-
-    roundTo a x | x `mod` a == 0 = x
-                | otherwise = x + a - (x `mod` a)
-
-
-    push_arg :: (CmmExpr,MachHint){-current argument-}
-                    -> NatM InstrBlock  -- code
-
-    push_arg (arg,_hint) -- we don't need the hints on x86
-      | arg_rep == I64 = do
-        ChildCode64 code r_lo <- iselExpr64 arg
-        delta <- getDeltaNat
-        setDeltaNat (delta - 8)
-        let 
-            r_hi = getHiVRegFromLo r_lo
-        -- in
-	return (       code `appOL`
-                       toOL [PUSH I32 (OpReg r_hi), DELTA (delta - 4),
-                             PUSH I32 (OpReg r_lo), DELTA (delta - 8),
-			     DELTA (delta-8)]
-            )
-
-      | otherwise = do
-        (code, reg, sz) <- get_op arg
-        delta <- getDeltaNat
-        let size = arg_size sz
-        setDeltaNat (delta-size)
-        if (case sz of F64 -> True; F32 -> True; _ -> False)
-           then return (code `appOL`
-                        toOL [SUB I32 (OpImm (ImmInt size)) (OpReg esp),
-                              DELTA (delta-size),
-                              GST sz reg (AddrBaseIndex (EABaseReg esp) 
-                                                        EAIndexNone
-                                                        (ImmInt 0))]
-                       )
-           else return (code `snocOL`
-                        PUSH I32 (OpReg reg) `snocOL`
-                        DELTA (delta-size)
-                       )
-      where
-         arg_rep = cmmExprRep arg
-
-    ------------
-    get_op :: CmmExpr -> NatM (InstrBlock, Reg, MachRep) -- code, reg, size
-    get_op op = do
-        (reg,code) <- getSomeReg op
-	return (code, reg, cmmExprRep op)
-
-#endif /* i386_TARGET_ARCH */
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
-outOfLineFloatOp :: CallishMachOp -> CmmReg -> [(CmmExpr,MachHint)]
-  -> Maybe [GlobalReg] -> NatM InstrBlock
-outOfLineFloatOp mop res args vols
-  = do
-      targetExpr <- cmmMakeDynamicReference addImportNat True lbl
-      let target = CmmForeignCall targetExpr CCallConv
-        
-      if cmmRegRep res == F64
-        then
-          stmtToInstrs (CmmCall target [(res,FloatHint)] args vols)  
-        else do
-          uq <- getUniqueNat
-          let 
-            tmp = CmmLocal (LocalReg uq F64)
-          -- in
-          code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args vols)
-          code2 <- stmtToInstrs (CmmAssign res (CmmReg tmp))
-          return (code1 `appOL` code2)
-  where
-	lbl = mkForeignLabel fn Nothing True
-
-	fn = case mop of
-	      MO_F32_Sqrt  -> FSLIT("sqrtf")
-	      MO_F32_Sin   -> FSLIT("sinf")
-	      MO_F32_Cos   -> FSLIT("cosf")
-	      MO_F32_Tan   -> FSLIT("tanf")
-	      MO_F32_Exp   -> FSLIT("expf")
-	      MO_F32_Log   -> FSLIT("logf")
-
-	      MO_F32_Asin  -> FSLIT("asinf")
-	      MO_F32_Acos  -> FSLIT("acosf")
-	      MO_F32_Atan  -> FSLIT("atanf")
-
-	      MO_F32_Sinh  -> FSLIT("sinhf")
-	      MO_F32_Cosh  -> FSLIT("coshf")
-	      MO_F32_Tanh  -> FSLIT("tanhf")
-	      MO_F32_Pwr   -> FSLIT("powf")
-
-	      MO_F64_Sqrt  -> FSLIT("sqrt")
-	      MO_F64_Sin   -> FSLIT("sin")
-	      MO_F64_Cos   -> FSLIT("cos")
-	      MO_F64_Tan   -> FSLIT("tan")
-	      MO_F64_Exp   -> FSLIT("exp")
-	      MO_F64_Log   -> FSLIT("log")
-
-	      MO_F64_Asin  -> FSLIT("asin")
-	      MO_F64_Acos  -> FSLIT("acos")
-	      MO_F64_Atan  -> FSLIT("atan")
-
-	      MO_F64_Sinh  -> FSLIT("sinh")
-	      MO_F64_Cosh  -> FSLIT("cosh")
-	      MO_F64_Tanh  -> FSLIT("tanh")
-	      MO_F64_Pwr   -> FSLIT("pow")
-
-#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if x86_64_TARGET_ARCH
-
-genCCall (CmmPrim op) [(r,_)] args vols = 
-  outOfLineFloatOp op r args vols
-
-genCCall target dest_regs args vols = do
-
-	-- load up the register arguments
-    (stack_args, aregs, fregs, load_args_code)
-	 <- load_args args allArgRegs allFPArgRegs nilOL
-
-    let
-	fp_regs_used  = reverse (drop (length fregs) (reverse allFPArgRegs))
-	int_regs_used = reverse (drop (length aregs) (reverse allArgRegs))
-	arg_regs = int_regs_used ++ fp_regs_used
-		-- for annotating the call instruction with
-
-	sse_regs = length fp_regs_used
-
-	tot_arg_size = arg_size * length stack_args
-
-	-- On entry to the called function, %rsp should be aligned
-	-- on a 16-byte boundary +8 (i.e. the first stack arg after
-	-- the return address is 16-byte aligned).  In STG land
-	-- %rsp is kept 16-byte aligned (see StgCRun.c), so we just
-	-- need to make sure we push a multiple of 16-bytes of args,
-	-- plus the return address, to get the correct alignment.
-	-- Urg, this is hard.  We need to feed the delta back into
-	-- the arg pushing code.
-    (real_size, adjust_rsp) <-
-	if tot_arg_size `rem` 16 == 0
-	    then return (tot_arg_size, nilOL)
-	    else do -- we need to adjust...
-		delta <- getDeltaNat
-		setDeltaNat (delta-8)
-		return (tot_arg_size+8, toOL [
-				SUB I64 (OpImm (ImmInt 8)) (OpReg rsp),
-				DELTA (delta-8)
-			])
-
-	-- push the stack args, right to left
-    push_code <- push_args (reverse stack_args) nilOL
-    delta <- getDeltaNat
-
-    -- deal with static vs dynamic call targets
-    (callinsns,cconv) <-
-      case target of
-	-- CmmPrim -> ...
-        CmmForeignCall (CmmLit (CmmLabel lbl)) conv
-           -> -- ToDo: stdcall arg sizes
-	      return (unitOL (CALL (Left fn_imm) arg_regs), conv)
-	   where fn_imm = ImmCLbl lbl
-        CmmForeignCall expr conv
-           -> do (dyn_r, dyn_c) <- getSomeReg expr
-		 return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
-
-    let
-	-- The x86_64 ABI requires us to set %al to the number of SSE
-	-- registers that contain arguments, if the called routine
-	-- is a varargs function.  We don't know whether it's a
-	-- varargs function or not, so we have to assume it is.
-	--
-	-- It's not safe to omit this assignment, even if the number
-	-- of SSE regs in use is zero.  If %al is larger than 8
-	-- on entry to a varargs function, seg faults ensue.
-	assign_eax n = unitOL (MOV I32 (OpImm (ImmInt n)) (OpReg eax))
-
-    let call = callinsns `appOL`
-               toOL (
-			-- Deallocate parameters after call for ccall;
-			-- but not for stdcall (callee does it)
-                  (if cconv == StdCallConv || real_size==0 then [] else 
-		   [ADD wordRep (OpImm (ImmInt real_size)) (OpReg esp)])
-                  ++
-                  [DELTA (delta + real_size)]
-               )
-    -- in
-    setDeltaNat (delta + real_size)
-
-    let
-	-- assign the results, if necessary
-	assign_code []     = nilOL
-	assign_code [(dest,_hint)] = 
-	  case rep of
-		F32 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
-		F64 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
-		rep -> unitOL (MOV rep (OpReg rax) (OpReg r_dest))
-	  where 
-		rep = cmmRegRep dest
-		r_dest = getRegisterReg dest
-	assign_code many = panic "genCCall.assign_code many"
-
-    return (load_args_code 	`appOL` 
-	    adjust_rsp 		`appOL`
-	    push_code 		`appOL`
-	    assign_eax sse_regs `appOL`
-	    call 		`appOL` 
-	    assign_code dest_regs)
-
-  where
-    arg_size = 8 -- always, at the mo
-
-    load_args :: [(CmmExpr,MachHint)]
-	      -> [Reg] 			-- int regs avail for args
-	      -> [Reg] 			-- FP regs avail for args
-	      -> InstrBlock
-	      -> NatM ([(CmmExpr,MachHint)],[Reg],[Reg],InstrBlock)
-    load_args args [] [] code     =  return (args, [], [], code)
-	-- no more regs to use
-    load_args [] aregs fregs code =  return ([], aregs, fregs, code)
-	-- no more args to push
-    load_args ((arg,hint) : rest) aregs fregs code
-	| isFloatingRep arg_rep = 
-	case fregs of
-	  [] -> push_this_arg
-	  (r:rs) -> do
-	     arg_code <- getAnyReg arg
-	     load_args rest aregs rs (code `appOL` arg_code r)
-	| otherwise =
-	case aregs of
-	  [] -> push_this_arg
-	  (r:rs) -> do
-	     arg_code <- getAnyReg arg
-	     load_args rest rs fregs (code `appOL` arg_code r)
-	where
-	  arg_rep = cmmExprRep arg
-
-	  push_this_arg = do
-	    (args',ars,frs,code') <- load_args rest aregs fregs code
-	    return ((arg,hint):args', ars, frs, code')
-
-    push_args [] code = return code
-    push_args ((arg,hint):rest) code
-       | isFloatingRep arg_rep = do
-	 (arg_reg, arg_code) <- getSomeReg arg
-         delta <- getDeltaNat
-         setDeltaNat (delta-arg_size)
-	 let code' = code `appOL` toOL [
-			MOV arg_rep (OpReg arg_reg) (OpAddr  (spRel 0)),
-			SUB wordRep (OpImm (ImmInt arg_size)) (OpReg rsp) ,
-	 		DELTA (delta-arg_size)]
-	 push_args rest code'
-
-       | otherwise = do
-       -- we only ever generate word-sized function arguments.  Promotion
-       -- has already happened: our Int8# type is kept sign-extended
-       -- in an Int#, for example.
-	 ASSERT(arg_rep == I64) return ()
-	 (arg_op, arg_code) <- getOperand arg
-         delta <- getDeltaNat
-         setDeltaNat (delta-arg_size)
-	 let code' = code `appOL` toOL [PUSH I64 arg_op, 
-	 			        DELTA (delta-arg_size)]
-	 push_args rest code'
-	where
-	  arg_rep = cmmExprRep arg
-#endif
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if sparc_TARGET_ARCH
-{- 
-   The SPARC calling convention is an absolute
-   nightmare.  The first 6x32 bits of arguments are mapped into
-   %o0 through %o5, and the remaining arguments are dumped to the
-   stack, beginning at [%sp+92].  (Note that %o6 == %sp.)
-
-   If we have to put args on the stack, move %o6==%sp down by
-   the number of words to go on the stack, to ensure there's enough space.
-
-   According to Fraser and Hanson's lcc book, page 478, fig 17.2,
-   16 words above the stack pointer is a word for the address of
-   a structure return value.  I use this as a temporary location
-   for moving values from float to int regs.  Certainly it isn't
-   safe to put anything in the 16 words starting at %sp, since
-   this area can get trashed at any time due to window overflows
-   caused by signal handlers.
-
-   A final complication (if the above isn't enough) is that 
-   we can't blithely calculate the arguments one by one into
-   %o0 .. %o5.  Consider the following nested calls:
-
-       fff a (fff b c)
-
-   Naive code moves a into %o0, and (fff b c) into %o1.  Unfortunately
-   the inner call will itself use %o0, which trashes the value put there
-   in preparation for the outer call.  Upshot: we need to calculate the
-   args into temporary regs, and move those to arg regs or onto the
-   stack only immediately prior to the call proper.  Sigh.
--}
-
-genCCall target dest_regs argsAndHints vols = do
-    let
-        args = map fst argsAndHints
-    argcode_and_vregs <- mapM arg_to_int_vregs args
-    let 
-        (argcodes, vregss) = unzip argcode_and_vregs
-        n_argRegs          = length allArgRegs
-        n_argRegs_used     = min (length vregs) n_argRegs
-        vregs              = concat vregss
-    -- deal with static vs dynamic call targets
-    callinsns <- (case target of
-        CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> do
-		return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
-        CmmForeignCall expr conv -> do
-                (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
-                return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
-	CmmPrim mop -> do
-		  (res, reduce) <- outOfLineFloatOp mop
-		  lblOrMopExpr <- case res of
-		       Left lbl -> do
-		            return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
-		       Right mopExpr -> do
-			    (dyn_c, [dyn_r]) <- arg_to_int_vregs mopExpr
-			    return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
-		  if reduce then panic "genCCall(sparc): can not reduce" else return lblOrMopExpr
-
-      )
-    let
-        argcode = concatOL argcodes
-        (move_sp_down, move_sp_up)
-           = let diff = length vregs - n_argRegs
-                 nn   = if odd diff then diff + 1 else diff -- keep 8-byte alignment
-             in  if   nn <= 0
-                 then (nilOL, nilOL)
-                 else (unitOL (moveSp (-1*nn)), unitOL (moveSp (1*nn)))
-        transfer_code
-           = toOL (move_final vregs allArgRegs eXTRA_STK_ARGS_HERE)
-    return (argcode       `appOL`
-            move_sp_down  `appOL`
-            transfer_code `appOL`
-            callinsns     `appOL`
-            unitOL NOP    `appOL`
-            move_sp_up)
-  where
-     -- move args from the integer vregs into which they have been 
-     -- marshalled, into %o0 .. %o5, and the rest onto the stack.
-     move_final :: [Reg] -> [Reg] -> Int -> [Instr]
-
-     move_final [] _ offset          -- all args done
-        = []
-
-     move_final (v:vs) [] offset     -- out of aregs; move to stack
-        = ST I32 v (spRel offset)
-          : move_final vs [] (offset+1)
-
-     move_final (v:vs) (a:az) offset -- move into an arg (%o[0..5]) reg
-        = OR False g0 (RIReg v) a
-          : move_final vs az offset
-
-     -- generate code to calculate an argument, and move it into one
-     -- or two integer vregs.
-     arg_to_int_vregs :: CmmExpr -> NatM (OrdList Instr, [Reg])
-     arg_to_int_vregs arg
-        | (cmmExprRep arg) == I64
-        = do
-	  (ChildCode64 code r_lo) <- iselExpr64 arg
-          let 
-              r_hi = getHiVRegFromLo r_lo
-          return (code, [r_hi, r_lo])
-        | otherwise
-        = do
-	  (src, code) <- getSomeReg arg
-          tmp <- getNewRegNat (cmmExprRep arg)
-          let
-              pk   = cmmExprRep arg
-          case pk of
-             F64 -> do
-                      v1 <- getNewRegNat I32
-                      v2 <- getNewRegNat I32
-                      return (
-                        code                          `snocOL`
-                        FMOV F64 src f0                `snocOL`
-                        ST   F32  f0 (spRel 16)         `snocOL`
-                        LD   I32  (spRel 16) v1         `snocOL`
-                        ST   F32  (fPair f0) (spRel 16) `snocOL`
-                        LD   I32  (spRel 16) v2
-                        ,
-                        [v1,v2]
-                       )
-             F32 -> do
-                      v1 <- getNewRegNat I32
-                      return (
-                        code                    `snocOL`
-                        ST   F32  src (spRel 16)  `snocOL`
-                        LD   I32  (spRel 16) v1
-                        ,
-                        [v1]
-                       )
-             other -> do
-                        v1 <- getNewRegNat I32
-                        return (
-                          code `snocOL` OR False g0 (RIReg src) v1
-                          , 
-                          [v1]
-                         )
-outOfLineFloatOp mop =
-    do
-      mopExpr <- cmmMakeDynamicReference addImportNat True $
-		  mkForeignLabel functionName Nothing True
-      let mopLabelOrExpr = case mopExpr of
-			CmmLit (CmmLabel lbl) -> Left lbl
-                        _ -> Right mopExpr
-      return (mopLabelOrExpr, reduce)
-            where
-                (reduce, functionName) = case mop of
-	          MO_F32_Exp    -> (True,  FSLIT("exp"))
-	          MO_F32_Log    -> (True,  FSLIT("log"))
-	          MO_F32_Sqrt   -> (True,  FSLIT("sqrt"))
-
-	          MO_F32_Sin    -> (True,  FSLIT("sin"))
-	          MO_F32_Cos    -> (True,  FSLIT("cos"))
-	          MO_F32_Tan    -> (True,  FSLIT("tan"))
-
-	          MO_F32_Asin   -> (True,  FSLIT("asin"))
-	          MO_F32_Acos   -> (True,  FSLIT("acos"))
-	          MO_F32_Atan   -> (True,  FSLIT("atan"))
-
-	          MO_F32_Sinh   -> (True,  FSLIT("sinh"))
-	          MO_F32_Cosh   -> (True,  FSLIT("cosh"))
-	          MO_F32_Tanh   -> (True,  FSLIT("tanh"))
-
-	          MO_F64_Exp    -> (False, FSLIT("exp"))
-	          MO_F64_Log    -> (False, FSLIT("log"))
-	          MO_F64_Sqrt   -> (False, FSLIT("sqrt"))
-
-	          MO_F64_Sin    -> (False, FSLIT("sin"))
-	          MO_F64_Cos    -> (False, FSLIT("cos"))
-	          MO_F64_Tan    -> (False, FSLIT("tan"))
-
-	          MO_F64_Asin   -> (False, FSLIT("asin"))
-	          MO_F64_Acos   -> (False, FSLIT("acos"))
-	          MO_F64_Atan   -> (False, FSLIT("atan"))
-
-	          MO_F64_Sinh   -> (False, FSLIT("sinh"))
-	          MO_F64_Cosh   -> (False, FSLIT("cosh"))
-	          MO_F64_Tanh   -> (False, FSLIT("tanh"))
-
-                  other -> pprPanic "outOfLineFloatOp(sparc) "
-                                (pprCallishMachOp mop)
-
-#endif /* sparc_TARGET_ARCH */
-
-#if powerpc_TARGET_ARCH
-
-#if darwin_TARGET_OS || linux_TARGET_OS
-{-
-    The PowerPC calling convention for Darwin/Mac OS X
-    is described in Apple's document
-    "Inside Mac OS X - Mach-O Runtime Architecture".
-    
-    PowerPC Linux uses the System V Release 4 Calling Convention
-    for PowerPC. It is described in the
-    "System V Application Binary Interface PowerPC Processor Supplement".
-
-    Both conventions are similar:
-    Parameters may be passed in general-purpose registers starting at r3, in
-    floating point registers starting at f1, or on the stack. 
-    
-    But there are substantial differences:
-    * The number of registers used for parameter passing and the exact set of
-      nonvolatile registers differs (see MachRegs.lhs).
-    * On Darwin, stack space is always reserved for parameters, even if they are
-      passed in registers. The called routine may choose to save parameters from
-      registers to the corresponding space on the stack.
-    * On Darwin, a corresponding amount of GPRs is skipped when a floating point
-      parameter is passed in an FPR.
-    * SysV insists on either passing I64 arguments on the stack, or in two GPRs,
-      starting with an odd-numbered GPR. It may skip a GPR to achieve this.
-      Darwin just treats an I64 like two separate I32s (high word first).
-    * I64 and F64 arguments are 8-byte aligned on the stack for SysV, but only
-      4-byte aligned like everything else on Darwin.
-    * The SysV spec claims that F32 is represented as F64 on the stack. GCC on
-      PowerPC Linux does not agree, so neither do we.
-      
-    According to both conventions, The parameter area should be part of the
-    caller's stack frame, allocated in the caller's prologue code (large enough
-    to hold the parameter lists for all called routines). The NCG already
-    uses the stack for register spilling, leaving 64 bytes free at the top.
-    If we need a larger parameter area than that, we just allocate a new stack
-    frame just before ccalling.
--}
-
-genCCall target dest_regs argsAndHints vols
-  = ASSERT (not $ any (`elem` [I8,I16]) argReps)
-        -- we rely on argument promotion in the codeGen
-    do
-        (finalStack,passArgumentsCode,usedRegs) <- passArguments
-                                                        (zip args argReps)
-                                                        allArgRegs allFPArgRegs
-                                                        initialStackOffset
-                                                        (toOL []) []
-                                                
-        (labelOrExpr, reduceToF32) <- case target of
-            CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
-            CmmForeignCall expr conv -> return  (Right expr, False)
-            CmmPrim mop -> outOfLineFloatOp mop
-                                                        
-        let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
-            codeAfter = move_sp_up finalStack `appOL` moveResult reduceToF32
-
-        case labelOrExpr of
-            Left lbl -> do
-		return (         codeBefore
-                        `snocOL` BL lbl usedRegs
-                        `appOL`	 codeAfter)
-            Right dyn -> do
-		(dynReg, dynCode) <- getSomeReg dyn
-		return (         dynCode
-			`snocOL` MTCTR dynReg
-                        `appOL`	 codeBefore
-                        `snocOL` BCTRL usedRegs
-                        `appOL`	 codeAfter)
-    where
-#if darwin_TARGET_OS
-        initialStackOffset = 24
-	    -- size of linkage area + size of arguments, in bytes	
-	stackDelta _finalStack = roundTo 16 $ (24 +) $ max 32 $ sum $
-	                               map machRepByteWidth argReps
-#elif linux_TARGET_OS
-        initialStackOffset = 8
-        stackDelta finalStack = roundTo 16 finalStack
-#endif
-	args = map fst argsAndHints
-	argReps = map cmmExprRep args
-
-	roundTo a x | x `mod` a == 0 = x
-		    | otherwise = x + a - (x `mod` a)
-
-        move_sp_down finalStack
-               | delta > 64 =
-                        toOL [STU I32 sp (AddrRegImm sp (ImmInt (-delta))),
-	                      DELTA (-delta)]
-	       | otherwise = nilOL
-	       where delta = stackDelta finalStack
-	move_sp_up finalStack
-	       | delta > 64 =
-                        toOL [ADD sp sp (RIImm (ImmInt delta)),
-                              DELTA 0]
-	       | otherwise = nilOL
-	       where delta = stackDelta finalStack
-	       
-
-        passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed)
-        passArguments ((arg,I64):args) gprs fprs stackOffset
-               accumCode accumUsed =
-            do
-                ChildCode64 code vr_lo <- iselExpr64 arg
-                let vr_hi = getHiVRegFromLo vr_lo
-
-#if darwin_TARGET_OS                
-                passArguments args
-                              (drop 2 gprs)
-                              fprs
-                              (stackOffset+8)
-                              (accumCode `appOL` code
-                                    `snocOL` storeWord vr_hi gprs stackOffset
-                                    `snocOL` storeWord vr_lo (drop 1 gprs) (stackOffset+4))
-                              ((take 2 gprs) ++ accumUsed)
-            where
-                storeWord vr (gpr:_) offset = MR gpr vr
-                storeWord vr [] offset = ST I32 vr (AddrRegImm sp (ImmInt offset))
-                
-#elif linux_TARGET_OS
-                let stackOffset' = roundTo 8 stackOffset
-                    stackCode = accumCode `appOL` code
-                        `snocOL` ST I32 vr_hi (AddrRegImm sp (ImmInt stackOffset'))
-                        `snocOL` ST I32 vr_lo (AddrRegImm sp (ImmInt (stackOffset'+4)))
-                    regCode hireg loreg =
-                        accumCode `appOL` code
-                            `snocOL` MR hireg vr_hi
-                            `snocOL` MR loreg vr_lo
-                                        
-                case gprs of
-                    hireg : loreg : regs | even (length gprs) ->
-                        passArguments args regs fprs stackOffset
-                                      (regCode hireg loreg) (hireg : loreg : accumUsed)
-                    _skipped : hireg : loreg : regs ->
-                        passArguments args regs fprs stackOffset
-                                      (regCode hireg loreg) (hireg : loreg : accumUsed)
-                    _ -> -- only one or no regs left
-                        passArguments args [] fprs (stackOffset'+8)
-                                      stackCode accumUsed
-#endif
-        
-        passArguments ((arg,rep):args) gprs fprs stackOffset accumCode accumUsed
-            | reg : _ <- regs = do
-                register <- getRegister arg
-                let code = case register of
-                            Fixed _ freg fcode -> fcode `snocOL` MR reg freg
-                            Any _ acode -> acode reg
-                passArguments args
-                              (drop nGprs gprs)
-                              (drop nFprs fprs)
-#if darwin_TARGET_OS
-        -- The Darwin ABI requires that we reserve stack slots for register parameters
-                              (stackOffset + stackBytes)
-#elif linux_TARGET_OS
-        -- ... the SysV ABI doesn't.
-                              stackOffset
-#endif
-                              (accumCode `appOL` code)
-                              (reg : accumUsed)
-            | otherwise = do
-                (vr, code) <- getSomeReg arg
-                passArguments args
-                              (drop nGprs gprs)
-                              (drop nFprs fprs)
-                              (stackOffset' + stackBytes)
-                              (accumCode `appOL` code `snocOL` ST rep vr stackSlot)
-                              accumUsed
-            where
-#if darwin_TARGET_OS
-        -- stackOffset is at least 4-byte aligned
-        -- The Darwin ABI is happy with that.
-                stackOffset' = stackOffset
-#else
-        -- ... the SysV ABI requires 8-byte alignment for doubles.
-                stackOffset' | rep == F64 = roundTo 8 stackOffset
-                             | otherwise  =           stackOffset
-#endif
-                stackSlot = AddrRegImm sp (ImmInt stackOffset')
-                (nGprs, nFprs, stackBytes, regs) = case rep of
-                    I32 -> (1, 0, 4, gprs)
-#if darwin_TARGET_OS
-        -- The Darwin ABI requires that we skip a corresponding number of GPRs when
-        -- we use the FPRs.
-                    F32 -> (1, 1, 4, fprs)
-                    F64 -> (2, 1, 8, fprs)
-#elif linux_TARGET_OS
-        -- ... the SysV ABI doesn't.
-                    F32 -> (0, 1, 4, fprs)
-                    F64 -> (0, 1, 8, fprs)
-#endif
-        
-        moveResult reduceToF32 =
-            case dest_regs of
-                [] -> nilOL
-                [(dest, _hint)]
-                    | reduceToF32 && rep == F32 -> unitOL (FRSP r_dest f1)
-                    | rep == F32 || rep == F64 -> unitOL (MR r_dest f1)
-                    | rep == I64 -> toOL [MR (getHiVRegFromLo r_dest) r3,
-                                          MR r_dest r4]
-                    | otherwise -> unitOL (MR r_dest r3)
-                    where rep = cmmRegRep dest
-                          r_dest = getRegisterReg dest
-                          
-        outOfLineFloatOp mop =
-            do
-                mopExpr <- cmmMakeDynamicReference addImportNat True $
-                              mkForeignLabel functionName Nothing True
-                let mopLabelOrExpr = case mopExpr of
-                        CmmLit (CmmLabel lbl) -> Left lbl
-                        _ -> Right mopExpr
-                return (mopLabelOrExpr, reduce)
-            where
-                (functionName, reduce) = case mop of
-                    MO_F32_Exp   -> (FSLIT("exp"), True)
-                    MO_F32_Log   -> (FSLIT("log"), True)
-                    MO_F32_Sqrt  -> (FSLIT("sqrt"), True)
-                        
-                    MO_F32_Sin   -> (FSLIT("sin"), True)
-                    MO_F32_Cos   -> (FSLIT("cos"), True)
-                    MO_F32_Tan   -> (FSLIT("tan"), True)
-                    
-                    MO_F32_Asin  -> (FSLIT("asin"), True)
-                    MO_F32_Acos  -> (FSLIT("acos"), True)
-                    MO_F32_Atan  -> (FSLIT("atan"), True)
-                    
-                    MO_F32_Sinh  -> (FSLIT("sinh"), True)
-                    MO_F32_Cosh  -> (FSLIT("cosh"), True)
-                    MO_F32_Tanh  -> (FSLIT("tanh"), True)
-                    MO_F32_Pwr   -> (FSLIT("pow"), True)
-                        
-                    MO_F64_Exp   -> (FSLIT("exp"), False)
-                    MO_F64_Log   -> (FSLIT("log"), False)
-                    MO_F64_Sqrt  -> (FSLIT("sqrt"), False)
-                        
-                    MO_F64_Sin   -> (FSLIT("sin"), False)
-                    MO_F64_Cos   -> (FSLIT("cos"), False)
-                    MO_F64_Tan   -> (FSLIT("tan"), False)
-                     
-                    MO_F64_Asin  -> (FSLIT("asin"), False)
-                    MO_F64_Acos  -> (FSLIT("acos"), False)
-                    MO_F64_Atan  -> (FSLIT("atan"), False)
-                    
-                    MO_F64_Sinh  -> (FSLIT("sinh"), False)
-                    MO_F64_Cosh  -> (FSLIT("cosh"), False)
-                    MO_F64_Tanh  -> (FSLIT("tanh"), False)
-                    MO_F64_Pwr   -> (FSLIT("pow"), False)
-                    other -> pprPanic "genCCall(ppc): unknown callish op"
-                                    (pprCallishMachOp other)
-
-#endif /* darwin_TARGET_OS || linux_TARGET_OS */
-                
-#endif /* powerpc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- Generating a table-branch
-
-genSwitch :: CmmExpr -> [Maybe BlockId] -> NatM InstrBlock
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-genSwitch expr ids
-  | opt_PIC
-  = do
-        (reg,e_code) <- getSomeReg expr
-        lbl <- getNewLabelNat
-        dynRef <- cmmMakeDynamicReference addImportNat False lbl
-        (tableReg,t_code) <- getSomeReg $ dynRef
-        let
-            jumpTable = map jumpTableEntryRel ids
-            
-            jumpTableEntryRel Nothing
-                = CmmStaticLit (CmmInt 0 wordRep)
-            jumpTableEntryRel (Just (BlockId id))
-                = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
-                where blockLabel = mkAsmTempLabel id
-
-            op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
-                                       (EAIndex reg wORD_SIZE) (ImmInt 0))
-
-            code = e_code `appOL` t_code `appOL` toOL [
-                            LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
-                            ADD wordRep op (OpReg tableReg),
-                            JMP_TBL (OpReg tableReg) [ id | Just id <- ids ]
-                    ]
-        return code
-  | otherwise
-  = do
-        (reg,e_code) <- getSomeReg expr
-        lbl <- getNewLabelNat
-        let
-            jumpTable = map jumpTableEntry ids
-            op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg wORD_SIZE) (ImmCLbl lbl))
-            code = e_code `appOL` toOL [
-                    LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
-                    JMP_TBL op [ id | Just id <- ids ]
-                 ]
-        -- in
-        return code
-#elif powerpc_TARGET_ARCH
-genSwitch expr ids 
-  | opt_PIC
-  = do
-        (reg,e_code) <- getSomeReg expr
-        tmp <- getNewRegNat I32
-        lbl <- getNewLabelNat
-        dynRef <- cmmMakeDynamicReference addImportNat False lbl
-        (tableReg,t_code) <- getSomeReg $ dynRef
-        let
-            jumpTable = map jumpTableEntryRel ids
-            
-            jumpTableEntryRel Nothing
-                = CmmStaticLit (CmmInt 0 wordRep)
-            jumpTableEntryRel (Just (BlockId id))
-                = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
-                where blockLabel = mkAsmTempLabel id
-
-            code = e_code `appOL` t_code `appOL` toOL [
-                            LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
-                            SLW tmp reg (RIImm (ImmInt 2)),
-                            LD I32 tmp (AddrRegReg tableReg tmp),
-                            ADD tmp tmp (RIReg tableReg),
-                            MTCTR tmp,
-                            BCTR [ id | Just id <- ids ]
-                    ]
-        return code
-  | otherwise
-  = do
-        (reg,e_code) <- getSomeReg expr
-        tmp <- getNewRegNat I32
-        lbl <- getNewLabelNat
-        let
-            jumpTable = map jumpTableEntry ids
-        
-            code = e_code `appOL` toOL [
-                            LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
-                            SLW tmp reg (RIImm (ImmInt 2)),
-                            ADDIS tmp tmp (HA (ImmCLbl lbl)),
-                            LD I32 tmp (AddrRegImm tmp (LO (ImmCLbl lbl))),
-                            MTCTR tmp,
-                            BCTR [ id | Just id <- ids ]
-                    ]
-        return code
-#else
-genSwitch expr ids = panic "ToDo: genSwitch"
-#endif
-
-jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordRep)
-jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
-    where blockLabel = mkAsmTempLabel id
-
--- -----------------------------------------------------------------------------
--- Support bits
--- -----------------------------------------------------------------------------
-
-
--- -----------------------------------------------------------------------------
--- 'condIntReg' and 'condFltReg': condition codes into registers
-
--- Turn those condition codes into integers now (when they appear on
--- the right hand side of an assignment).
--- 
--- (If applicable) Do not fill the delay slots here; you will confuse the
--- register allocator.
-
-condIntReg, condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if alpha_TARGET_ARCH
-condIntReg = panic "MachCode.condIntReg (not on Alpha)"
-condFltReg = panic "MachCode.condFltReg (not on Alpha)"
-#endif /* alpha_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
-condIntReg cond x y = do
-  CondCode _ cond cond_code <- condIntCode cond x y
-  tmp <- getNewRegNat I8
-  let 
-	code dst = cond_code `appOL` toOL [
-		    SETCC cond (OpReg tmp),
-		    MOVZxL I8 (OpReg tmp) (OpReg dst)
-		  ]
-  -- in
-  return (Any I32 code)
-
-#endif
-
-#if i386_TARGET_ARCH
-
-condFltReg cond x y = do
-  CondCode _ cond cond_code <- condFltCode cond x y
-  tmp <- getNewRegNat I8
-  let 
-	code dst = cond_code `appOL` toOL [
-		    SETCC cond (OpReg tmp),
-		    MOVZxL I8 (OpReg tmp) (OpReg dst)
-		  ]
-  -- in
-  return (Any I32 code)
-
-#endif
-
-#if x86_64_TARGET_ARCH
-
-condFltReg cond x y = do
-  CondCode _ cond cond_code <- condFltCode cond x y
-  tmp1 <- getNewRegNat wordRep
-  tmp2 <- getNewRegNat wordRep
-  let 
-	-- We have to worry about unordered operands (eg. comparisons
-	-- against NaN).  If the operands are unordered, the comparison
-	-- sets the parity flag, carry flag and zero flag.
-	-- All comparisons are supposed to return false for unordered
-	-- operands except for !=, which returns true.
-	--
-	-- Optimisation: we don't have to test the parity flag if we
-	-- know the test has already excluded the unordered case: eg >
-	-- and >= test for a zero carry flag, which can only occur for
-	-- ordered operands.
-	--
-	-- ToDo: by reversing comparisons we could avoid testing the
-	-- parity flag in more cases.
-
-	code dst = 
-	   cond_code `appOL` 
-	     (case cond of
-	  	NE  -> or_unordered dst
-		GU  -> plain_test   dst
-		GEU -> plain_test   dst
-		_   -> and_ordered  dst)
-
-	plain_test dst = toOL [
-		    SETCC cond (OpReg tmp1),
-		    MOVZxL I8 (OpReg tmp1) (OpReg dst)
-		 ]
-	or_unordered dst = toOL [
-		    SETCC cond (OpReg tmp1),
-		    SETCC PARITY (OpReg tmp2),
-		    OR I8 (OpReg tmp1) (OpReg tmp2),
-		    MOVZxL I8 (OpReg tmp2) (OpReg dst)
-		  ]
-	and_ordered dst = toOL [
-		    SETCC cond (OpReg tmp1),
-		    SETCC NOTPARITY (OpReg tmp2),
-		    AND I8 (OpReg tmp1) (OpReg tmp2),
-		    MOVZxL I8 (OpReg tmp2) (OpReg dst)
-		  ]
-  -- in
-  return (Any I32 code)
-
-#endif
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if sparc_TARGET_ARCH
-
-condIntReg EQQ x (CmmLit (CmmInt 0 d)) = do
-    (src, code) <- getSomeReg x
-    tmp <- getNewRegNat I32
-    let
-	code__2 dst = code `appOL` toOL [
-    	    SUB False True g0 (RIReg src) g0,
-    	    SUB True False g0 (RIImm (ImmInt (-1))) dst]
-    return (Any I32 code__2)
-
-condIntReg EQQ x y = do
-    (src1, code1) <- getSomeReg x
-    (src2, code2) <- getSomeReg y
-    tmp1 <- getNewRegNat I32
-    tmp2 <- getNewRegNat I32
-    let
-    	code__2 dst = code1 `appOL` code2 `appOL` toOL [
-    	    XOR False src1 (RIReg src2) dst,
-    	    SUB False True g0 (RIReg dst) g0,
-    	    SUB True False g0 (RIImm (ImmInt (-1))) dst]
-    return (Any I32 code__2)
-
-condIntReg NE x (CmmLit (CmmInt 0 d)) = do
-    (src, code) <- getSomeReg x
-    tmp <- getNewRegNat I32
-    let
-    	code__2 dst = code `appOL` toOL [
-    	    SUB False True g0 (RIReg src) g0,
-    	    ADD True False g0 (RIImm (ImmInt 0)) dst]
-    return (Any I32 code__2)
-
-condIntReg NE x y = do
-    (src1, code1) <- getSomeReg x
-    (src2, code2) <- getSomeReg y
-    tmp1 <- getNewRegNat I32
-    tmp2 <- getNewRegNat I32
-    let
-	code__2 dst = code1 `appOL` code2 `appOL` toOL [
-    	    XOR False src1 (RIReg src2) dst,
-    	    SUB False True g0 (RIReg dst) g0,
-    	    ADD True False g0 (RIImm (ImmInt 0)) dst]
-    return (Any I32 code__2)
-
-condIntReg cond x y = do
-    BlockId lbl1 <- getBlockIdNat
-    BlockId lbl2 <- getBlockIdNat
-    CondCode _ cond cond_code <- condIntCode cond x y
-    let
-	code__2 dst = cond_code `appOL` toOL [
-	    BI cond False (ImmCLbl (mkAsmTempLabel lbl1)), NOP,
-	    OR False g0 (RIImm (ImmInt 0)) dst,
-	    BI ALWAYS False (ImmCLbl (mkAsmTempLabel lbl2)), NOP,
-	    NEWBLOCK (BlockId lbl1),
-	    OR False g0 (RIImm (ImmInt 1)) dst,
-	    NEWBLOCK (BlockId lbl2)]
-    return (Any I32 code__2)
-
-condFltReg cond x y = do
-    BlockId lbl1 <- getBlockIdNat
-    BlockId lbl2 <- getBlockIdNat
-    CondCode _ cond cond_code <- condFltCode cond x y
-    let
-    	code__2 dst = cond_code `appOL` toOL [ 
-    	    NOP,
-	    BF cond False (ImmCLbl (mkAsmTempLabel lbl1)), NOP,
-	    OR False g0 (RIImm (ImmInt 0)) dst,
-	    BI ALWAYS False (ImmCLbl (mkAsmTempLabel lbl2)), NOP,
-	    NEWBLOCK (BlockId lbl1),
-	    OR False g0 (RIImm (ImmInt 1)) dst,
-	    NEWBLOCK (BlockId lbl2)]
-    return (Any I32 code__2)
-
-#endif /* sparc_TARGET_ARCH */
-
-#if powerpc_TARGET_ARCH
-condReg getCond = do
-    lbl1 <- getBlockIdNat
-    lbl2 <- getBlockIdNat
-    CondCode _ cond cond_code <- getCond
-    let
-{-        code dst = cond_code `appOL` toOL [
-                BCC cond lbl1,
-                LI dst (ImmInt 0),
-                BCC ALWAYS lbl2,
-                NEWBLOCK lbl1,
-                LI dst (ImmInt 1),
-                BCC ALWAYS lbl2,
-                NEWBLOCK lbl2
-            ]-}
-        code dst = cond_code
-            `appOL` negate_code
-            `appOL` toOL [
-                MFCR dst,
-                RLWINM dst dst (bit + 1) 31 31
-            ]
-        
-        negate_code | do_negate = unitOL (CRNOR bit bit bit)
-                    | otherwise = nilOL
-                    
-        (bit, do_negate) = case cond of
-            LTT -> (0, False)
-            LE  -> (1, True)
-            EQQ -> (2, False)
-            GE  -> (0, True)
-            GTT -> (1, False)
-            
-            NE  -> (2, True)
-            
-            LU  -> (0, False)
-            LEU -> (1, True)
-            GEU -> (0, True)
-            GU  -> (1, False)
-                
-    return (Any I32 code)
-    
-condIntReg cond x y = condReg (condIntCode cond x y)
-condFltReg cond x y = condReg (condFltCode cond x y)
-#endif /* powerpc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- 'trivial*Code': deal with trivial instructions
-
--- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',
--- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.
--- Only look for constants on the right hand side, because that's
--- where the generic optimizer will have put them.
-
--- Similarly, for unary instructions, we don't have to worry about
--- matching an StInt as the argument, because genericOpt will already
--- have handled the constant-folding.
-
-trivialCode
-    :: MachRep 
-    -> IF_ARCH_alpha((Reg -> RI -> Reg -> Instr)
-      ,IF_ARCH_i386 ((Operand -> Operand -> Instr) 
-                     -> Maybe (Operand -> Operand -> Instr)
-      ,IF_ARCH_x86_64 ((Operand -> Operand -> Instr) 
-                     -> Maybe (Operand -> Operand -> Instr)
-      ,IF_ARCH_sparc((Reg -> RI -> Reg -> Instr)
-      ,IF_ARCH_powerpc(Bool -> (Reg -> Reg -> RI -> Instr)
-      ,)))))
-    -> CmmExpr -> CmmExpr -- the two arguments
-    -> NatM Register
-
-#ifndef powerpc_TARGET_ARCH
-trivialFCode
-    :: MachRep
-    -> IF_ARCH_alpha((Reg -> Reg -> Reg -> Instr)
-      ,IF_ARCH_sparc((MachRep -> Reg -> Reg -> Reg -> Instr)
-      ,IF_ARCH_i386 ((MachRep -> Reg -> Reg -> Reg -> Instr)
-      ,IF_ARCH_x86_64 ((MachRep -> Operand -> Operand -> Instr)
-      ,))))
-    -> CmmExpr -> CmmExpr -- the two arguments
-    -> NatM Register
-#endif
-
-trivialUCode
-    :: MachRep 
-    -> IF_ARCH_alpha((RI -> Reg -> Instr)
-      ,IF_ARCH_i386 ((Operand -> Instr)
-      ,IF_ARCH_x86_64 ((Operand -> Instr)
-      ,IF_ARCH_sparc((RI -> Reg -> Instr)
-      ,IF_ARCH_powerpc((Reg -> Reg -> Instr)
-      ,)))))
-    -> CmmExpr	-- the one argument
-    -> NatM Register
-
-#ifndef powerpc_TARGET_ARCH
-trivialUFCode
-    :: MachRep
-    -> IF_ARCH_alpha((Reg -> Reg -> Instr)
-      ,IF_ARCH_i386 ((Reg -> Reg -> Instr)
-      ,IF_ARCH_x86_64 ((Reg -> Reg -> Instr)
-      ,IF_ARCH_sparc((Reg -> Reg -> Instr)
-      ,))))
-    -> CmmExpr -- the one argument
-    -> NatM Register
-#endif
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if alpha_TARGET_ARCH
-
-trivialCode instr x (StInt y)
-  | fits8Bits y
-  = getRegister x		`thenNat` \ register ->
-    getNewRegNat IntRep		`thenNat` \ tmp ->
-    let
-    	code = registerCode register tmp
-    	src1 = registerName register tmp
-    	src2 = ImmInt (fromInteger y)
-    	code__2 dst = code . mkSeqInstr (instr src1 (RIImm src2) dst)
-    in
-    return (Any IntRep code__2)
-
-trivialCode instr x y
-  = getRegister x		`thenNat` \ register1 ->
-    getRegister y		`thenNat` \ register2 ->
-    getNewRegNat IntRep		`thenNat` \ tmp1 ->
-    getNewRegNat IntRep		`thenNat` \ tmp2 ->
-    let
-    	code1 = registerCode register1 tmp1 []
-    	src1  = registerName register1 tmp1
-    	code2 = registerCode register2 tmp2 []
-    	src2  = registerName register2 tmp2
-    	code__2 dst = asmSeqThen [code1, code2] .
-    	    	     mkSeqInstr (instr src1 (RIReg src2) dst)
-    in
-    return (Any IntRep code__2)
-
-------------
-trivialUCode instr x
-  = getRegister x		`thenNat` \ register ->
-    getNewRegNat IntRep		`thenNat` \ tmp ->
-    let
-    	code = registerCode register tmp
-    	src  = registerName register tmp
-    	code__2 dst = code . mkSeqInstr (instr (RIReg src) dst)
-    in
-    return (Any IntRep code__2)
-
-------------
-trivialFCode _ instr x y
-  = getRegister x		`thenNat` \ register1 ->
-    getRegister y		`thenNat` \ register2 ->
-    getNewRegNat F64	`thenNat` \ tmp1 ->
-    getNewRegNat F64	`thenNat` \ tmp2 ->
-    let
-    	code1 = registerCode register1 tmp1
-    	src1  = registerName register1 tmp1
-
-    	code2 = registerCode register2 tmp2
-    	src2  = registerName register2 tmp2
-
-    	code__2 dst = asmSeqThen [code1 [], code2 []] .
-    	    	      mkSeqInstr (instr src1 src2 dst)
-    in
-    return (Any F64 code__2)
-
-trivialUFCode _ instr x
-  = getRegister x		`thenNat` \ register ->
-    getNewRegNat F64	`thenNat` \ tmp ->
-    let
-    	code = registerCode register tmp
-    	src  = registerName register tmp
-    	code__2 dst = code . mkSeqInstr (instr src dst)
-    in
-    return (Any F64 code__2)
-
-#endif /* alpha_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
-{-
-The Rules of the Game are:
-
-* You cannot assume anything about the destination register dst;
-  it may be anything, including a fixed reg.
-
-* You may compute an operand into a fixed reg, but you may not 
-  subsequently change the contents of that fixed reg.  If you
-  want to do so, first copy the value either to a temporary
-  or into dst.  You are free to modify dst even if it happens
-  to be a fixed reg -- that's not your problem.
-
-* You cannot assume that a fixed reg will stay live over an
-  arbitrary computation.  The same applies to the dst reg.
-
-* Temporary regs obtained from getNewRegNat are distinct from 
-  each other and from all other regs, and stay live over 
-  arbitrary computations.
-
---------------------
-
-SDM's version of The Rules:
-
-* If getRegister returns Any, that means it can generate correct
-  code which places the result in any register, period.  Even if that
-  register happens to be read during the computation.
-
-  Corollary #1: this means that if you are generating code for an
-  operation with two arbitrary operands, you cannot assign the result
-  of the first operand into the destination register before computing
-  the second operand.  The second operand might require the old value
-  of the destination register.
-
-  Corollary #2: A function might be able to generate more efficient
-  code if it knows the destination register is a new temporary (and
-  therefore not read by any of the sub-computations).
-
-* If getRegister returns Any, then the code it generates may modify only:
-	(a) fresh temporaries
-	(b) the destination register
-	(c) known registers (eg. %ecx is used by shifts)
-  In particular, it may *not* modify global registers, unless the global
-  register happens to be the destination register.
--}
-
-trivialCode rep instr (Just revinstr) (CmmLit lit_a) b
-  | not (is64BitLit lit_a) = do
-  b_code <- getAnyReg b
-  let
-       code dst 
-	 = b_code dst `snocOL`
-           revinstr (OpImm (litToImm lit_a)) (OpReg dst)
-  -- in
-  return (Any rep code)
-
-trivialCode rep instr maybe_revinstr a b = genTrivialCode rep instr a b
-
--- This is re-used for floating pt instructions too.
-genTrivialCode rep instr a b = do
-  (b_op, b_code) <- getNonClobberedOperand b
-  a_code <- getAnyReg a
-  tmp <- getNewRegNat rep
-  let
-     -- We want the value of b to stay alive across the computation of a.
-     -- But, we want to calculate a straight into the destination register,
-     -- because the instruction only has two operands (dst := dst `op` src).
-     -- The troublesome case is when the result of b is in the same register
-     -- as the destination reg.  In this case, we have to save b in a
-     -- new temporary across the computation of a.
-     code dst
-	| dst `regClashesWithOp` b_op =
-		b_code `appOL`
-		unitOL (MOV rep b_op (OpReg tmp)) `appOL`
-		a_code dst `snocOL`
-		instr (OpReg tmp) (OpReg dst)
-	| otherwise =
-		b_code `appOL`
-		a_code dst `snocOL`
-		instr b_op (OpReg dst)
-  -- in
-  return (Any rep code)
-
-reg `regClashesWithOp` OpReg reg2   = reg == reg2
-reg `regClashesWithOp` OpAddr amode = any (==reg) (addrModeRegs amode)
-reg `regClashesWithOp` _            = False
-
------------
-
-trivialUCode rep instr x = do
-  x_code <- getAnyReg x
-  let
-     code dst =
-	x_code dst `snocOL`
-	instr (OpReg dst)
-  -- in
-  return (Any rep code)
-
------------
-
-#if i386_TARGET_ARCH
-
-trivialFCode pk instr x y = do
-  (x_reg, x_code) <- getNonClobberedReg x -- these work for float regs too
-  (y_reg, y_code) <- getSomeReg y
-  let
-     code dst =
-	x_code `appOL`
-	y_code `snocOL`
-	instr pk x_reg y_reg dst
-  -- in
-  return (Any pk code)
-
-#endif
-
-#if x86_64_TARGET_ARCH
-
-trivialFCode pk instr x y = genTrivialCode  pk (instr pk) x y
-
-#endif
-
--------------
-
-trivialUFCode rep instr x = do
-  (x_reg, x_code) <- getSomeReg x
-  let
-     code dst =
-	x_code `snocOL`
-	instr x_reg dst
-  -- in
-  return (Any rep code)
-
-#endif /* i386_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if sparc_TARGET_ARCH
-
-trivialCode pk instr x (CmmLit (CmmInt y d))
-  | fits13Bits y
-  = do
-      (src1, code) <- getSomeReg x
-      tmp <- getNewRegNat I32
-      let
-    	src2 = ImmInt (fromInteger y)
-    	code__2 dst = code `snocOL` instr src1 (RIImm src2) dst
-      return (Any I32 code__2)
-
-trivialCode pk instr x y = do
-    (src1, code1) <- getSomeReg x
-    (src2, code2) <- getSomeReg y
-    tmp1 <- getNewRegNat I32
-    tmp2 <- getNewRegNat I32
-    let
-    	code__2 dst = code1 `appOL` code2 `snocOL`
-    	    	      instr src1 (RIReg src2) dst
-    return (Any I32 code__2)
-
-------------
-trivialFCode pk instr x y = do
-    (src1, code1) <- getSomeReg x
-    (src2, code2) <- getSomeReg y
-    tmp1 <- getNewRegNat (cmmExprRep x)
-    tmp2 <- getNewRegNat (cmmExprRep y)
-    tmp <- getNewRegNat F64
-    let
-    	promote x = FxTOy F32 F64 x tmp
-
-    	pk1   = cmmExprRep x
-    	pk2   = cmmExprRep y
-
-    	code__2 dst =
-    	    	if pk1 == pk2 then
-    	            code1 `appOL` code2 `snocOL`
-    	    	    instr pk src1 src2 dst
-    	    	else if pk1 == F32 then
-    	    	    code1 `snocOL` promote src1 `appOL` code2 `snocOL`
-    	    	    instr F64 tmp src2 dst
-    	    	else
-    	    	    code1 `appOL` code2 `snocOL` promote src2 `snocOL`
-    	    	    instr F64 src1 tmp dst
-    return (Any (if pk1 == pk2 then pk1 else F64) code__2)
-
-------------
-trivialUCode pk instr x = do
-    (src, code) <- getSomeReg x
-    tmp <- getNewRegNat pk
-    let
-    	code__2 dst = code `snocOL` instr (RIReg src) dst
-    return (Any pk code__2)
-
--------------
-trivialUFCode pk instr x = do
-    (src, code) <- getSomeReg x
-    tmp <- getNewRegNat pk
-    let
-    	code__2 dst = code `snocOL` instr src dst
-    return (Any pk code__2)
-
-#endif /* sparc_TARGET_ARCH */
-
-#if powerpc_TARGET_ARCH
-
-{-
-Wolfgang's PowerPC version of The Rules:
-
-A slightly modified version of The Rules to take advantage of the fact
-that PowerPC instructions work on all registers and don't implicitly
-clobber any fixed registers.
-
-* The only expression for which getRegister returns Fixed is (CmmReg reg).
-
-* If getRegister returns Any, then the code it generates may modify only:
-	(a) fresh temporaries
-	(b) the destination register
-  It may *not* modify global registers, unless the global
-  register happens to be the destination register.
-  It may not clobber any other registers. In fact, only ccalls clobber any
-  fixed registers.
-  Also, it may not modify the counter register (used by genCCall).
-  
-  Corollary: If a getRegister for a subexpression returns Fixed, you need
-  not move it to a fresh temporary before evaluating the next subexpression.
-  The Fixed register won't be modified.
-  Therefore, we don't need a counterpart for the x86's getStableReg on PPC.
-  
-* SDM's First Rule is valid for PowerPC, too: subexpressions can depend on
-  the value of the destination register.
--}
-
-trivialCode rep signed instr x (CmmLit (CmmInt y _))
-    | Just imm <- makeImmediate rep signed y 
-    = do
-        (src1, code1) <- getSomeReg x
-        let code dst = code1 `snocOL` instr dst src1 (RIImm imm)
-        return (Any rep code)
-  
-trivialCode rep signed instr x y = do
-    (src1, code1) <- getSomeReg x
-    (src2, code2) <- getSomeReg y
-    let code dst = code1 `appOL` code2 `snocOL` instr dst src1 (RIReg src2)
-    return (Any rep code)
-
-trivialCodeNoImm :: MachRep -> (Reg -> Reg -> Reg -> Instr)
-    -> CmmExpr -> CmmExpr -> NatM Register
-trivialCodeNoImm rep instr x y = do
-    (src1, code1) <- getSomeReg x
-    (src2, code2) <- getSomeReg y
-    let code dst = code1 `appOL` code2 `snocOL` instr dst src1 src2
-    return (Any rep code)
-    
-trivialUCode rep instr x = do
-    (src, code) <- getSomeReg x
-    let code' dst = code `snocOL` instr dst src
-    return (Any rep code')
-    
--- There is no "remainder" instruction on the PPC, so we have to do
--- it the hard way.
--- The "div" parameter is the division instruction to use (DIVW or DIVWU)
-
-remainderCode :: MachRep -> (Reg -> Reg -> Reg -> Instr)
-    -> CmmExpr -> CmmExpr -> NatM Register
-remainderCode rep div x y = do
-    (src1, code1) <- getSomeReg x
-    (src2, code2) <- getSomeReg y
-    let code dst = code1 `appOL` code2 `appOL` toOL [
-                div dst src1 src2,
-                MULLW dst dst (RIReg src2),
-                SUBF dst dst src1
-            ]
-    return (Any rep code)
-
-#endif /* powerpc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
---  Coercing to/from integer/floating-point...
-
--- @coerce(Int2FP|FP2Int)@ are more complicated integer/float
--- conversions.  We have to store temporaries in memory to move
--- between the integer and the floating point register sets.
-
--- @coerceDbl2Flt@ and @coerceFlt2Dbl@ are done this way because we
--- pretend, on sparc at least, that double and float regs are seperate
--- kinds, so the value has to be computed into one kind before being
--- explicitly "converted" to live in the other kind.
-
-coerceInt2FP :: MachRep -> MachRep -> CmmExpr -> NatM Register
-coerceFP2Int :: MachRep -> MachRep -> CmmExpr -> NatM Register
-
-#if sparc_TARGET_ARCH
-coerceDbl2Flt :: CmmExpr -> NatM Register
-coerceFlt2Dbl :: CmmExpr -> NatM Register
-#endif
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if alpha_TARGET_ARCH
-
-coerceInt2FP _ x
-  = getRegister x		`thenNat` \ register ->
-    getNewRegNat IntRep		`thenNat` \ reg ->
-    let
-    	code = registerCode register reg
-    	src  = registerName register reg
-
-    	code__2 dst = code . mkSeqInstrs [
-    	    ST Q src (spRel 0),
-    	    LD TF dst (spRel 0),
-    	    CVTxy Q TF dst dst]
-    in
-    return (Any F64 code__2)
-
--------------
-coerceFP2Int x
-  = getRegister x		`thenNat` \ register ->
-    getNewRegNat F64	`thenNat` \ tmp ->
-    let
-    	code = registerCode register tmp
-    	src  = registerName register tmp
-
-    	code__2 dst = code . mkSeqInstrs [
-    	    CVTxy TF Q src tmp,
-    	    ST TF tmp (spRel 0),
-    	    LD Q dst (spRel 0)]
-    in
-    return (Any IntRep code__2)
-
-#endif /* alpha_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if i386_TARGET_ARCH
-
-coerceInt2FP from to x = do
-  (x_reg, x_code) <- getSomeReg x
-  let
-        opc  = case to of F32 -> GITOF; F64 -> GITOD
-        code dst = x_code `snocOL` opc x_reg dst
-	-- ToDo: works for non-I32 reps?
-  -- in
-  return (Any to code)
-
-------------
-
-coerceFP2Int from to x = do
-  (x_reg, x_code) <- getSomeReg x
-  let
-        opc  = case from of F32 -> GFTOI; F64 -> GDTOI
-        code dst = x_code `snocOL` opc x_reg dst
-	-- ToDo: works for non-I32 reps?
-  -- in
-  return (Any to code)
-
-#endif /* i386_TARGET_ARCH */
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if x86_64_TARGET_ARCH
-
-coerceFP2Int from to x = do
-  (x_op, x_code) <- getOperand x  -- ToDo: could be a safe operand
-  let
-        opc  = case from of F32 -> CVTSS2SI; F64 -> CVTSD2SI
-        code dst = x_code `snocOL` opc x_op dst
-  -- in
-  return (Any to code) -- works even if the destination rep is <I32
-
-coerceInt2FP from to x = do
-  (x_op, x_code) <- getOperand x  -- ToDo: could be a safe operand
-  let
-        opc  = case to of F32 -> CVTSI2SS; F64 -> CVTSI2SD
-        code dst = x_code `snocOL` opc x_op dst
-  -- in
-  return (Any to code) -- works even if the destination rep is <I32
-
-coerceFP2FP :: MachRep -> CmmExpr -> NatM Register
-coerceFP2FP to x = do
-  (x_reg, x_code) <- getSomeReg x
-  let
-        opc  = case to of F32 -> CVTSD2SS; F64 -> CVTSS2SD
-        code dst = x_code `snocOL` opc x_reg dst
-  -- in
-  return (Any to code)
-
-#endif
-
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-
-#if sparc_TARGET_ARCH
-
-coerceInt2FP pk1 pk2 x = do
-    (src, code) <- getSomeReg x
-    let
-    	code__2 dst = code `appOL` toOL [
-    	    ST pk1 src (spRel (-2)),
-    	    LD pk1 (spRel (-2)) dst,
-    	    FxTOy pk1 pk2 dst dst]
-    return (Any pk2 code__2)
-
-------------
-coerceFP2Int pk fprep x = do
-    (src, code) <- getSomeReg x
-    reg <- getNewRegNat fprep
-    tmp <- getNewRegNat pk
-    let
-    	code__2 dst = ASSERT(fprep == F64 || fprep == F32)
-	    code `appOL` toOL [
-    	    FxTOy fprep pk src tmp,
-    	    ST pk tmp (spRel (-2)),
-    	    LD pk (spRel (-2)) dst]
-    return (Any pk code__2)
-
-------------
-coerceDbl2Flt x = do
-    (src, code) <- getSomeReg x
-    return (Any F32 (\dst -> code `snocOL` FxTOy F64 F32 src dst)) 
-
-------------
-coerceFlt2Dbl x = do
-    (src, code) <- getSomeReg x
-    return (Any F64 (\dst -> code `snocOL` FxTOy F32 F64 src dst))
-
-#endif /* sparc_TARGET_ARCH */
-
-#if powerpc_TARGET_ARCH
-coerceInt2FP fromRep toRep x = do
-    (src, code) <- getSomeReg x
-    lbl <- getNewLabelNat
-    itmp <- getNewRegNat I32
-    ftmp <- getNewRegNat F64
-    dynRef <- cmmMakeDynamicReference addImportNat False lbl
-    Amode addr addr_code <- getAmode dynRef
-    let
-    	code' dst = code `appOL` maybe_exts `appOL` toOL [
-		LDATA ReadOnlyData
-				[CmmDataLabel lbl,
-				 CmmStaticLit (CmmInt 0x43300000 I32),
-				 CmmStaticLit (CmmInt 0x80000000 I32)],
-		XORIS itmp src (ImmInt 0x8000),
-		ST I32 itmp (spRel 3),
-		LIS itmp (ImmInt 0x4330),
-		ST I32 itmp (spRel 2),
-		LD F64 ftmp (spRel 2)
-            ] `appOL` addr_code `appOL` toOL [
-		LD F64 dst addr,
-		FSUB F64 dst ftmp dst
-	    ] `appOL` maybe_frsp dst
-            
-        maybe_exts = case fromRep of
-                        I8 ->  unitOL $ EXTS I8 src src
-                        I16 -> unitOL $ EXTS I16 src src
-                        I32 -> nilOL
-        maybe_frsp dst = case toRep of
-                        F32 -> unitOL $ FRSP dst dst
-                        F64 -> nilOL
-    return (Any toRep code')
-
-coerceFP2Int fromRep toRep x = do
-    -- the reps don't really matter: F*->F64 and I32->I* are no-ops
-    (src, code) <- getSomeReg x
-    tmp <- getNewRegNat F64
-    let
-    	code' dst = code `appOL` toOL [
-		-- convert to int in FP reg
-    	    FCTIWZ tmp src,
-		-- store value (64bit) from FP to stack
-    	    ST F64 tmp (spRel 2),
-		-- read low word of value (high word is undefined)
-    	    LD I32 dst (spRel 3)]	
-    return (Any toRep code')
-#endif /* powerpc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- eXTRA_STK_ARGS_HERE
-
--- We (allegedly) put the first six C-call arguments in registers;
--- where do we start putting the rest of them?
-
--- Moved from MachInstrs (SDM):
-
-#if alpha_TARGET_ARCH || sparc_TARGET_ARCH
-eXTRA_STK_ARGS_HERE :: Int
-eXTRA_STK_ARGS_HERE
-  = IF_ARCH_alpha(0, IF_ARCH_sparc(23, ???))
-#endif
-
diff --git a/ghc/compiler/nativeGen/MachInstrs.hs b/ghc/compiler/nativeGen/MachInstrs.hs
deleted file mode 100644
index 0f718d3cea..0000000000
--- a/ghc/compiler/nativeGen/MachInstrs.hs
+++ /dev/null
@@ -1,722 +0,0 @@
------------------------------------------------------------------------------
---
--- Machine-dependent assembly language
---
--- (c) The University of Glasgow 1993-2004
---
------------------------------------------------------------------------------
-
-#include "nativeGen/NCG.h"
-
-module MachInstrs (
-	-- * Cmm instantiations
-	NatCmm, NatCmmTop, NatBasicBlock,	
-
-	-- * Machine instructions
-	Instr(..),
-	Cond(..), condUnsigned, condToSigned, condToUnsigned,
-
-#if !powerpc_TARGET_ARCH && !i386_TARGET_ARCH && !x86_64_TARGET_ARCH
-	Size(..), machRepSize,
-#endif
-	RI(..),
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-	Operand(..),
-#endif
-#if i386_TARGET_ARCH
-	i386_insert_ffrees,
-#endif
-#if sparc_TARGET_ARCH
-	riZero, fpRelEA, moveSp, fPair,
-#endif
-    ) where
-
-#include "HsVersions.h"
-
-import MachRegs
-import Cmm
-import MachOp		( MachRep(..) )
-import CLabel           ( CLabel, pprCLabel )
-import Panic		( panic )
-import Outputable
-import FastString
-import Constants       ( wORD_SIZE )
-
-import GLAEXTS
-
-
--- -----------------------------------------------------------------------------
--- Our flavours of the Cmm types
-
--- Type synonyms for Cmm populated with native code
-type NatCmm        = GenCmm CmmStatic Instr
-type NatCmmTop     = GenCmmTop CmmStatic Instr
-type NatBasicBlock = GenBasicBlock Instr
-
--- -----------------------------------------------------------------------------
--- Conditions on this architecture
-
-data Cond
-#if alpha_TARGET_ARCH
-  = ALWAYS	-- For BI (same as BR)
-  | EQQ		-- For CMP and BI (NB: "EQ" is a 1.3 Prelude name)
-  | GE		-- For BI only
-  | GTT		-- For BI only (NB: "GT" is a 1.3 Prelude name)
-  | LE		-- For CMP and BI
-  | LTT		-- For CMP and BI (NB: "LT" is a 1.3 Prelude name)
-  | NE		-- For BI only
-  | NEVER	-- For BI (null instruction)
-  | ULE		-- For CMP only
-  | ULT		-- For CMP only
-#endif
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-  = ALWAYS	-- What's really used? ToDo
-  | EQQ
-  | GE
-  | GEU
-  | GTT
-  | GU
-  | LE
-  | LEU
-  | LTT
-  | LU
-  | NE
-  | NEG
-  | POS
-  | CARRY
-  | OFLO
-  | PARITY
-  | NOTPARITY
-#endif
-#if sparc_TARGET_ARCH
-  = ALWAYS	-- What's really used? ToDo
-  | EQQ
-  | GE
-  | GEU
-  | GTT
-  | GU
-  | LE
-  | LEU
-  | LTT
-  | LU
-  | NE
-  | NEG
-  | NEVER
-  | POS
-  | VC
-  | VS
-#endif
-#if powerpc_TARGET_ARCH
-  = ALWAYS
-  | EQQ
-  | GE
-  | GEU
-  | GTT
-  | GU
-  | LE
-  | LEU
-  | LTT
-  | LU
-  | NE
-#endif
-    deriving Eq  -- to make an assertion work
-
-condUnsigned GU  = True
-condUnsigned LU  = True
-condUnsigned GEU = True
-condUnsigned LEU = True
-condUnsigned _   = False
-
-condToSigned GU  = GTT
-condToSigned LU  = LTT
-condToSigned GEU = GE
-condToSigned LEU = LE
-condToSigned x   = x
-
-condToUnsigned GTT = GU
-condToUnsigned LTT = LU
-condToUnsigned GE  = GEU
-condToUnsigned LE  = LEU
-condToUnsigned x   = x
-
--- -----------------------------------------------------------------------------
--- Sizes on this architecture
-
--- ToDo: it's not clear to me that we need separate signed-vs-unsigned sizes
--- here.  I've removed them from the x86 version, we'll see what happens --SDM
-
-#if !powerpc_TARGET_ARCH && !i386_TARGET_ARCH && !x86_64_TARGET_ARCH
-data Size
-#if alpha_TARGET_ARCH
-    = B	    -- byte
-    | Bu
---  | W	    -- word (2 bytes): UNUSED
---  | Wu    -- : UNUSED
-    | L	    -- longword (4 bytes)
-    | Q	    -- quadword (8 bytes)
---  | FF    -- VAX F-style floating pt: UNUSED
---  | GF    -- VAX G-style floating pt: UNUSED
---  | DF    -- VAX D-style floating pt: UNUSED
---  | SF    -- IEEE single-precision floating pt: UNUSED
-    | TF    -- IEEE double-precision floating pt
-#endif
-#if sparc_TARGET_ARCH || powerpc_TARGET_ARCH
-    = B     -- byte (signed)
-    | Bu    -- byte (unsigned)
-    | H     -- halfword (signed, 2 bytes)
-    | Hu    -- halfword (unsigned, 2 bytes)
-    | W	    -- word (4 bytes)
-    | F	    -- IEEE single-precision floating pt
-    | DF    -- IEEE single-precision floating pt
-#endif
-  deriving Eq
-
-machRepSize :: MachRep -> Size
-machRepSize I8    = IF_ARCH_alpha(Bu, IF_ARCH_sparc(Bu, ))
-machRepSize I16   = IF_ARCH_alpha(err,IF_ARCH_sparc(Hu, ))
-machRepSize I32   = IF_ARCH_alpha(L,  IF_ARCH_sparc(W,  ))
-machRepSize I64	  = panic "machRepSize: I64"
-machRepSize I128  = panic "machRepSize: I128"
-machRepSize F32   = IF_ARCH_alpha(TF, IF_ARCH_sparc(F, ))
-machRepSize F64   = IF_ARCH_alpha(TF, IF_ARCH_sparc(DF,))
-#endif
-
--- -----------------------------------------------------------------------------
--- Register or immediate (a handy type on some platforms)
-
-data RI = RIReg Reg
-	| RIImm Imm
-
-
--- -----------------------------------------------------------------------------
--- Machine's assembly language
-
--- We have a few common "instructions" (nearly all the pseudo-ops) but
--- mostly all of 'Instr' is machine-specific.
-
-data Instr
-  = COMMENT FastString		-- comment pseudo-op
-
-  | LDATA   Section [CmmStatic]	-- some static data spat out during code
-				-- generation.  Will be extracted before
-				-- pretty-printing.
-
-  | NEWBLOCK BlockId		-- start a new basic block.  Useful during
-				-- codegen, removed later.  Preceding 
-				-- instruction should be a jump, as per the
-				-- invariants for a BasicBlock (see Cmm).
-
-  | DELTA   Int                 -- specify current stack offset for
-                                -- benefit of subsequent passes
-
--- -----------------------------------------------------------------------------
--- Alpha instructions
-
-#if alpha_TARGET_ARCH
-
--- data Instr continues...
-
--- Loads and stores.
-	      |	LD	      Size Reg AddrMode -- size, dst, src
-	      | LDA	      Reg AddrMode      -- dst, src
-	      | LDAH	      Reg AddrMode      -- dst, src
-	      | LDGP	      Reg AddrMode      -- dst, src
-	      | LDI	      Size Reg Imm     -- size, dst, src
-	      | ST	      Size Reg AddrMode -- size, src, dst
-
--- Int Arithmetic.
-	      | CLR	      Reg		    -- dst
-	      | ABS	      Size RI Reg	    -- size, src, dst
-	      | NEG	      Size Bool RI Reg	    -- size, overflow, src, dst
-	      | ADD	      Size Bool Reg RI Reg  -- size, overflow, src, src, dst
-	      | SADD	      Size Size Reg RI Reg  -- size, scale, src, src, dst
-	      | SUB	      Size Bool Reg RI Reg  -- size, overflow, src, src, dst
-	      | SSUB	      Size Size Reg RI Reg  -- size, scale, src, src, dst
-	      | MUL	      Size Bool Reg RI Reg  -- size, overflow, src, src, dst
-	      | DIV	      Size Bool Reg RI Reg  -- size, unsigned, src, src, dst
-	      | REM	      Size Bool Reg RI Reg  -- size, unsigned, src, src, dst
-
--- Simple bit-twiddling.
-	      | NOT	      RI Reg
-	      | AND	      Reg RI Reg
-	      | ANDNOT	      Reg RI Reg
-	      | OR	      Reg RI Reg
-	      | ORNOT	      Reg RI Reg
-	      | XOR	      Reg RI Reg
-	      | XORNOT	      Reg RI Reg
-	      | SLL	      Reg RI Reg
-	      | SRL	      Reg RI Reg
-	      | SRA	      Reg RI Reg
-
-	      | ZAP	      Reg RI Reg
-	      | ZAPNOT	      Reg RI Reg
-
-	      | NOP
-
--- Comparison
-	      | CMP	      Cond Reg RI Reg
-
--- Float Arithmetic.
-	      | FCLR	      Reg
-	      | FABS	      Reg Reg
-	      | FNEG	      Size Reg Reg
-	      | FADD	      Size Reg Reg Reg
-	      | FDIV	      Size Reg Reg Reg
-	      | FMUL	      Size Reg Reg Reg
-	      | FSUB	      Size Reg Reg Reg
-	      | CVTxy	      Size Size Reg Reg
-	      | FCMP	      Size Cond Reg Reg Reg
-	      | FMOV	      Reg Reg
-
--- Jumping around.
-	      | BI	      Cond Reg Imm
-	      | BF	      Cond Reg Imm
-	      | BR	      Imm
-	      | JMP	      Reg AddrMode Int
-	      | BSR	      Imm Int
-	      | JSR	      Reg AddrMode Int
-
--- Alpha-specific pseudo-ops.
-	      | FUNBEGIN CLabel
-	      | FUNEND CLabel
-
-data RI
-  = RIReg Reg
-  | RIImm Imm
-
-#endif /* alpha_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- Intel x86 instructions
-
-{-
-Intel, in their infinite wisdom, selected a stack model for floating
-point registers on x86.  That might have made sense back in 1979 --
-nowadays we can see it for the nonsense it really is.  A stack model
-fits poorly with the existing nativeGen infrastructure, which assumes
-flat integer and FP register sets.  Prior to this commit, nativeGen
-could not generate correct x86 FP code -- to do so would have meant
-somehow working the register-stack paradigm into the register
-allocator and spiller, which sounds very difficult.
-  
-We have decided to cheat, and go for a simple fix which requires no
-infrastructure modifications, at the expense of generating ropey but
-correct FP code.  All notions of the x86 FP stack and its insns have
-been removed.  Instead, we pretend (to the instruction selector and
-register allocator) that x86 has six floating point registers, %fake0
-.. %fake5, which can be used in the usual flat manner.  We further
-claim that x86 has floating point instructions very similar to SPARC
-and Alpha, that is, a simple 3-operand register-register arrangement.
-Code generation and register allocation proceed on this basis.
-  
-When we come to print out the final assembly, our convenient fiction
-is converted to dismal reality.  Each fake instruction is
-independently converted to a series of real x86 instructions.
-%fake0 .. %fake5 are mapped to %st(0) .. %st(5).  To do reg-reg
-arithmetic operations, the two operands are pushed onto the top of the
-FP stack, the operation done, and the result copied back into the
-relevant register.  There are only six %fake registers because 2 are
-needed for the translation, and x86 has 8 in total.
-
-The translation is inefficient but is simple and it works.  A cleverer
-translation would handle a sequence of insns, simulating the FP stack
-contents, would not impose a fixed mapping from %fake to %st regs, and
-hopefully could avoid most of the redundant reg-reg moves of the
-current translation.
-
-We might as well make use of whatever unique FP facilities Intel have
-chosen to bless us with (let's not be churlish, after all).
-Hence GLDZ and GLD1.  Bwahahahahahahaha!
--}
-
-{-
-MORE FLOATING POINT MUSINGS...
-
-Intel's internal floating point registers are by default 80 bit
-extended precision.  This means that all operations done on values in
-registers are done at 80 bits, and unless the intermediate values are
-truncated to the appropriate size (32 or 64 bits) by storing in
-memory, calculations in registers will give different results from
-calculations which pass intermediate values in memory (eg. via
-function calls).
-
-One solution is to set the FPU into 64 bit precision mode.  Some OSs
-do this (eg. FreeBSD) and some don't (eg. Linux).  The problem here is
-that this will only affect 64-bit precision arithmetic; 32-bit
-calculations will still be done at 64-bit precision in registers.  So
-it doesn't solve the whole problem.  
-
-There's also the issue of what the C library is expecting in terms of
-precision.  It seems to be the case that glibc on Linux expects the
-FPU to be set to 80 bit precision, so setting it to 64 bit could have
-unexpected effects.  Changing the default could have undesirable
-effects on other 3rd-party library code too, so the right thing would
-be to save/restore the FPU control word across Haskell code if we were
-to do this.
-
-gcc's -ffloat-store gives consistent results by always storing the
-results of floating-point calculations in memory, which works for both
-32 and 64-bit precision.  However, it only affects the values of
-user-declared floating point variables in C, not intermediate results.
-GHC in -fvia-C mode uses -ffloat-store (see the -fexcess-precision
-flag).
-
-Another problem is how to spill floating point registers in the
-register allocator.  Should we spill the whole 80 bits, or just 64?
-On an OS which is set to 64 bit precision, spilling 64 is fine.  On
-Linux, spilling 64 bits will round the results of some operations.
-This is what gcc does.  Spilling at 80 bits requires taking up a full
-128 bit slot (so we get alignment).  We spill at 80-bits and ignore
-the alignment problems.
-
-In the future, we'll use the SSE registers for floating point.  This
-requires a CPU that supports SSE2 (ordinary SSE only supports 32 bit
-precision float ops), which means P4 or Xeon and above.  Using SSE
-will solve all these problems, because the SSE registers use fixed 32
-bit or 64 bit precision.
-
---SDM 1/2003
--}
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
--- data Instr continues...
-
--- Moves.
-	| MOV	      MachRep Operand Operand
-	| MOVZxL      MachRep Operand Operand -- size is the size of operand 1
-	| MOVSxL      MachRep Operand Operand -- size is the size of operand 1
-	-- x86_64 note: plain mov into a 32-bit register always zero-extends
-	-- into the 64-bit reg, in contrast to the 8 and 16-bit movs which
-	-- don't affect the high bits of the register.
-
--- Load effective address (also a very useful three-operand add instruction :-)
-	| LEA         MachRep Operand Operand
-
--- Int Arithmetic.
-	| ADD	      MachRep Operand Operand
-	| ADC	      MachRep Operand Operand
-	| SUB	      MachRep Operand Operand
-
-	| MUL	      MachRep Operand Operand
-	| IMUL	      MachRep Operand Operand	-- signed int mul
-        | IMUL2       MachRep Operand -- %edx:%eax = operand * %eax
-
-	| DIV	      MachRep Operand	-- eax := eax:edx/op, edx := eax:edx%op
-	| IDIV	      MachRep Operand	-- ditto, but signed
-
--- Simple bit-twiddling.
-	| AND	      MachRep Operand Operand
-	| OR	      MachRep Operand Operand
-	| XOR	      MachRep Operand Operand
-	| NOT	      MachRep Operand
-	| NEGI	      MachRep Operand -- NEG instruction (name clash with Cond)
-
--- Shifts (amount may be immediate or %cl only)
-	| SHL	      MachRep Operand{-amount-} Operand
-	| SAR	      MachRep Operand{-amount-} Operand
-	| SHR	      MachRep Operand{-amount-} Operand
-
-        | BT          MachRep Imm Operand
-	| NOP
-
-#if i386_TARGET_ARCH
--- Float Arithmetic.
-
--- Note that we cheat by treating G{ABS,MOV,NEG} of doubles 
--- as single instructions right up until we spit them out.
-        -- all the 3-operand fake fp insns are src1 src2 dst
-        -- and furthermore are constrained to be fp regs only.
-        -- IMPORTANT: keep is_G_insn up to date with any changes here
-    	| GMOV	      Reg Reg -- src(fpreg), dst(fpreg)
-        | GLD         MachRep AddrMode Reg -- src, dst(fpreg)
-        | GST         MachRep Reg AddrMode -- src(fpreg), dst
-		      
-        | GLDZ        Reg -- dst(fpreg)
-        | GLD1        Reg -- dst(fpreg)
-		      
-        | GFTOI       Reg Reg -- src(fpreg), dst(intreg)
-        | GDTOI       Reg Reg -- src(fpreg), dst(intreg)
-		      
-        | GITOF       Reg Reg -- src(intreg), dst(fpreg)
-        | GITOD       Reg Reg -- src(intreg), dst(fpreg)
-	
-	| GADD	      MachRep Reg Reg Reg -- src1, src2, dst
-	| GDIV	      MachRep Reg Reg Reg -- src1, src2, dst
-	| GSUB	      MachRep Reg Reg Reg -- src1, src2, dst
-	| GMUL	      MachRep Reg Reg Reg -- src1, src2, dst
-	
-		-- FP compare.  Cond must be `elem` [EQQ, NE, LE, LTT, GE, GTT]
-		-- Compare src1 with src2; set the Zero flag iff the numbers are
-		-- comparable and the comparison is True.  Subsequent code must
-		-- test the %eflags zero flag regardless of the supplied Cond.
-    	| GCMP	      Cond Reg Reg -- src1, src2
-	
-     	| GABS	      MachRep Reg Reg -- src, dst
-    	| GNEG	      MachRep Reg Reg -- src, dst
-    	| GSQRT	      MachRep Reg Reg -- src, dst
-    	| GSIN	      MachRep Reg Reg -- src, dst
-    	| GCOS	      MachRep Reg Reg -- src, dst
-    	| GTAN	      MachRep Reg Reg -- src, dst
-	
-        | GFREE         -- do ffree on all x86 regs; an ugly hack
-#endif
-
-#if x86_64_TARGET_ARCH
--- SSE2 floating point: we use a restricted set of the available SSE2
--- instructions for floating-point.
-
-	-- use MOV for moving (either movss or movsd (movlpd better?))
-
-	| CVTSS2SD	Reg Reg		-- F32 to F64
-	| CVTSD2SS	Reg Reg		-- F64 to F32
-	| CVTSS2SI	Operand Reg	-- F32 to I32/I64 (with rounding)
-	| CVTSD2SI	Operand	Reg	-- F64 to I32/I64 (with rounding)
-	| CVTSI2SS	Operand Reg	-- I32/I64 to F32
-	| CVTSI2SD	Operand Reg	-- I32/I64 to F64
-
-	-- use ADD & SUB for arithmetic.  In both cases, operands
-	-- are  Operand Reg.
-
- 	-- SSE2 floating-point division:
-	| FDIV		MachRep Operand Operand   -- divisor, dividend(dst)
-
-	-- use CMP for comparisons.  ucomiss and ucomisd instructions
-	-- compare single/double prec floating point respectively.
-
-	| SQRT		MachRep Operand Reg	-- src, dst
-#endif
-
--- Comparison
-	| TEST          MachRep Operand Operand
-	| CMP           MachRep Operand Operand
-	| SETCC         Cond Operand
-
--- Stack Operations.
-	| PUSH          MachRep Operand
-	| POP           MachRep Operand
-	-- both unused (SDM):
-	--  | PUSHA
-	--  | POPA
-
--- Jumping around.
-	| JMP	      Operand
-	| JXX	      Cond BlockId  -- includes unconditional branches
-	| JMP_TBL     Operand [BlockId]  -- table jump
-	| CALL	      (Either Imm Reg) [Reg]
-
--- Other things.
-	| CLTD MachRep	 -- sign extend %eax into %edx:%eax
-
-	| FETCHGOT    Reg  -- pseudo-insn for ELF position-independent code
-                           -- pretty-prints as
-                           --       call 1f
-                           -- 1:    popl %reg
-                           --       addl __GLOBAL_OFFSET_TABLE__+.-1b, %reg
-	| FETCHPC     Reg  -- pseudo-insn for Darwin position-independent code
-                           -- pretty-prints as
-                           --       call 1f
-                           -- 1:    popl %reg
-
-
-data Operand
-  = OpReg  Reg	        -- register
-  | OpImm  Imm	        -- immediate value
-  | OpAddr AddrMode	-- memory reference
-
-#endif /* i386 or x86_64 */
-
-#if i386_TARGET_ARCH
-i386_insert_ffrees :: [Instr] -> [Instr]
-i386_insert_ffrees insns
-   | any is_G_instr insns
-   = concatMap ffree_before_nonlocal_transfers insns
-   | otherwise
-   = insns
-
-ffree_before_nonlocal_transfers insn
-   = case insn of
-        CALL _ _ -> [GFREE, insn]
-        JMP _    -> [GFREE, insn]
-        other    -> [insn]
-
-
--- if you ever add a new FP insn to the fake x86 FP insn set,
--- you must update this too
-is_G_instr :: Instr -> Bool
-is_G_instr instr
-   = case instr of
-        GMOV _ _ -> True; GLD _ _ _ -> True; GST _ _ _ -> True
-        GLDZ _ -> True; GLD1 _ -> True
-        GFTOI _ _ -> True; GDTOI _ _ -> True
-        GITOF _ _ -> True; GITOD _ _ -> True
-	GADD _ _ _ _ -> True; GDIV _ _ _ _ -> True
-	GSUB _ _ _ _ -> True; GMUL _ _ _ _ -> True
-    	GCMP _ _ _ -> True; GABS _ _ _ -> True
-    	GNEG _ _ _ -> True; GSQRT _ _ _ -> True
-        GSIN _ _ _ -> True; GCOS _ _ _ -> True; GTAN _ _ _ -> True
-        GFREE -> panic "is_G_instr: GFREE (!)"
-        other -> False
-#endif /* i386_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- Sparc instructions
-
-#if sparc_TARGET_ARCH
-
--- data Instr continues...
-
--- Loads and stores.
-	      | LD	      MachRep AddrMode Reg -- size, src, dst
-	      | ST	      MachRep Reg AddrMode -- size, src, dst
-
--- Int Arithmetic.
-	      | ADD	      Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
-	      | SUB	      Bool Bool Reg RI Reg -- x?, cc?, src1, src2, dst
-	      | UMUL	           Bool Reg RI Reg --     cc?, src1, src2, dst
-	      | SMUL	           Bool Reg RI Reg --     cc?, src1, src2, dst
-              | RDY           Reg	-- move contents of Y register to reg
-
--- Simple bit-twiddling.
-	      | AND	      Bool Reg RI Reg -- cc?, src1, src2, dst
-	      | ANDN	      Bool Reg RI Reg -- cc?, src1, src2, dst
-	      | OR	      Bool Reg RI Reg -- cc?, src1, src2, dst
-	      | ORN	      Bool Reg RI Reg -- cc?, src1, src2, dst
-	      | XOR	      Bool Reg RI Reg -- cc?, src1, src2, dst
-	      | XNOR	      Bool Reg RI Reg -- cc?, src1, src2, dst
-	      | SLL	      Reg RI Reg -- src1, src2, dst
-	      | SRL	      Reg RI Reg -- src1, src2, dst
-	      | SRA	      Reg RI Reg -- src1, src2, dst
-	      | SETHI	      Imm Reg -- src, dst
-	      | NOP	      -- Really SETHI 0, %g0, but worth an alias
-
--- Float Arithmetic.
-
--- Note that we cheat by treating F{ABS,MOV,NEG} of doubles as single
--- instructions right up until we spit them out.
-    	      | FABS	      MachRep Reg Reg	   -- src dst
-	      | FADD	      MachRep Reg Reg Reg  -- src1, src2, dst
-    	      | FCMP	      Bool MachRep Reg Reg -- exception?, src1, src2, dst
-	      | FDIV	      MachRep Reg Reg Reg -- src1, src2, dst
-    	      | FMOV	      MachRep Reg Reg     -- src, dst
-	      | FMUL	      MachRep Reg Reg Reg -- src1, src2, dst
-    	      | FNEG	      MachRep Reg Reg     -- src, dst
-    	      | FSQRT	      MachRep Reg Reg     -- src, dst
-	      | FSUB	      MachRep Reg Reg Reg -- src1, src2, dst
-    	      | FxTOy	      MachRep MachRep Reg Reg -- src, dst
-
--- Jumping around.
-	      | BI	      Cond Bool Imm -- cond, annul?, target
-    	      | BF  	      Cond Bool Imm -- cond, annul?, target
-
-	      | JMP	      AddrMode     -- target
-	      | CALL	      (Either Imm Reg) Int Bool -- target, args, terminal
-
-riZero :: RI -> Bool
-
-riZero (RIImm (ImmInt 0))	    = True
-riZero (RIImm (ImmInteger 0))	    = True
-riZero (RIReg (RealReg 0))          = True
-riZero _			    = False
-
--- Calculate the effective address which would be used by the
--- corresponding fpRel sequence.  fpRel is in MachRegs.lhs,
--- alas -- can't have fpRelEA here because of module dependencies.
-fpRelEA :: Int -> Reg -> Instr
-fpRelEA n dst
-   = ADD False False fp (RIImm (ImmInt (n * wORD_SIZE))) dst
-
--- Code to shift the stack pointer by n words.
-moveSp :: Int -> Instr
-moveSp n
-   = ADD False False sp (RIImm (ImmInt (n * wORD_SIZE))) sp
-
--- Produce the second-half-of-a-double register given the first half.
-fPair :: Reg -> Reg
-fPair (RealReg n) | n >= 32 && n `mod` 2 == 0  = RealReg (n+1)
-fPair other = pprPanic "fPair(sparc NCG)" (ppr other)
-#endif /* sparc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- PowerPC instructions
-
-#ifdef powerpc_TARGET_ARCH
--- data Instr continues...
-
--- Loads and stores.
-	      | LD	MachRep Reg AddrMode -- Load size, dst, src
-	      | LA      MachRep Reg AddrMode -- Load arithmetic size, dst, src
-	      | ST	MachRep Reg AddrMode -- Store size, src, dst 
-	      | STU	MachRep Reg AddrMode -- Store with Update size, src, dst 
-	      | LIS	Reg Imm -- Load Immediate Shifted dst, src
-	      | LI	Reg Imm -- Load Immediate dst, src
-	      | MR	Reg Reg -- Move Register dst, src -- also for fmr
-	      
-	      | CMP     MachRep Reg RI --- size, src1, src2
-	      | CMPL    MachRep Reg RI --- size, src1, src2
-	      
-	      | BCC     Cond BlockId
-              | JMP     CLabel          -- same as branch,
-                                        -- but with CLabel instead of block ID
-	      | MTCTR	Reg
-	      | BCTR    [BlockId]       -- with list of local destinations
-	      | BL	CLabel [Reg]	-- with list of argument regs
-	      | BCTRL	[Reg]
-	      
-	      | ADD     Reg Reg RI -- dst, src1, src2
-	      | ADDC    Reg Reg Reg -- (carrying) dst, src1, src2
-	      | ADDE    Reg Reg Reg -- (extend) dst, src1, src2
-	      | ADDIS   Reg Reg Imm -- Add Immediate Shifted dst, src1, src2
-	      | SUBF    Reg Reg Reg -- dst, src1, src2 ; dst = src2 - src1  
-	      | MULLW	Reg Reg RI
-	      | DIVW	Reg Reg Reg
-	      | DIVWU	Reg Reg Reg
-
-	      | MULLW_MayOflo Reg Reg Reg
-                        -- dst = 1 if src1 * src2 overflows
-                        -- pseudo-instruction; pretty-printed as:
-                        -- mullwo. dst, src1, src2
-                        -- mfxer dst
-                        -- rlwinm dst, dst, 2, 31,31
-	      
-	      | AND	Reg Reg RI -- dst, src1, src2
-	      | OR	Reg Reg RI -- dst, src1, src2
-	      | XOR	Reg Reg RI -- dst, src1, src2
-	      | XORIS	Reg Reg Imm -- XOR Immediate Shifted dst, src1, src2
-	      
-              | EXTS    MachRep Reg Reg
-		  
-	      | NEG	Reg Reg
-	      | NOT	Reg Reg
-	      
-	      | SLW	Reg Reg RI	-- shift left word
-	      | SRW	Reg Reg RI	-- shift right word
-	      | SRAW	Reg Reg RI	-- shift right arithmetic word
-	      
-        	        -- Rotate Left Word Immediate then AND with Mask
-	      | RLWINM  Reg Reg Int Int Int
-	      
-	      | FADD	MachRep Reg Reg Reg
-	      | FSUB	MachRep Reg Reg Reg
-	      | FMUL	MachRep Reg Reg Reg
-	      | FDIV	MachRep Reg Reg Reg
-	      | FNEG	Reg Reg	 -- negate is the same for single and double prec.
-	      
-	      | FCMP	Reg Reg
-	      
-	      | FCTIWZ	Reg Reg		-- convert to integer word
-              | FRSP    Reg Reg		-- reduce to single precision
-					-- (but destination is a FP register)
-	      
-	      | CRNOR   Int Int Int    -- condition register nor
-	      | MFCR    Reg            -- move from condition register
-	      
-	      | MFLR    Reg            -- move from link register
-	      | FETCHPC Reg            -- pseudo-instruction:
-	                               -- bcl to next insn, mflr reg
-	      
-#endif /* powerpc_TARGET_ARCH */
diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs
deleted file mode 100644
index bffb723d1b..0000000000
--- a/ghc/compiler/nativeGen/MachRegs.lhs
+++ /dev/null
@@ -1,1437 +0,0 @@
--- -----------------------------------------------------------------------------
---
--- (c) The University of Glasgow 1994-2004
--- 
--- Machine-specific info about registers.
--- 
--- Also includes stuff about immediate operands, which are
--- often/usually quite entangled with registers.
--- 
--- (Immediates could be untangled from registers at some cost in tangled
--- modules --- the pleasure has been foregone.)
--- 
--- -----------------------------------------------------------------------------
-
-\begin{code}
-#include "nativeGen/NCG.h"
-
-module MachRegs (
-
-	-- * Immediate values
-	Imm(..), strImmLit, litToImm,
-
-	-- * Addressing modes
-	AddrMode(..),
-	addrOffset,
-
-	-- * The 'Reg' type
-	RegNo,
-	Reg(..), isRealReg, isVirtualReg,
-        RegClass(..), regClass,
-	getHiVRegFromLo, 
-	mkVReg,
-
-	-- * Global registers
-        get_GlobalReg_reg_or_addr,
-	callerSaves, callerSaveVolatileRegs,
-
-	-- * Machine-dependent register-related stuff
-        allocatableRegs, argRegs, allArgRegs, callClobberedRegs,
-	freeReg,
-	spRel,
-
-#if alpha_TARGET_ARCH
-	fits8Bits,
-	fReg,
-	gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zeroh,
-#endif
-#if i386_TARGET_ARCH
-	EABase(..), EAIndex(..),
-	eax, ebx, ecx, edx, esi, edi, ebp, esp,
-	fake0, fake1, fake2, fake3, fake4, fake5,
-	addrModeRegs,
-#endif
-#if x86_64_TARGET_ARCH
-	EABase(..), EAIndex(..), ripRel,
-	rax, rbx, rcx, rdx, rsi, rdi, rbp, rsp,
-	eax, ebx, ecx, edx, esi, edi, ebp, esp,
-	r8, r9, r10, r11, r12, r13, r14, r15,
-  	xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7,
-  	xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15,
-	xmm,
-	addrModeRegs, allFPArgRegs,
-#endif
-#if sparc_TARGET_ARCH
-	fits13Bits,
-	fpRel, gReg, iReg, lReg, oReg, largeOffsetError,
-	fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f26, f27,
-#endif
-#if powerpc_TARGET_ARCH
-	allFPArgRegs,
-	makeImmediate,
-	sp,
-	r3, r4, r27, r28,
-	f1, f20, f21,
-#endif
-    ) where
-
-#include "HsVersions.h"
-
-#if i386_TARGET_ARCH
-# define STOLEN_X86_REGS 4
--- HACK: go for the max
-#endif
-
-#include "../includes/MachRegs.h"
-
-import Cmm
-import MachOp		( MachRep(..) )
-
-import CLabel           ( CLabel, mkMainCapabilityLabel )
-import Pretty
-import Outputable	( Outputable(..), pprPanic, panic )
-import qualified Outputable
-import Unique
-import Constants
-import FastTypes
-
-#if powerpc_TARGET_ARCH
-#if __GLASGOW_HASKELL__ >= 504
-import Data.Word	( Word8, Word16, Word32 )
-import Data.Int 	( Int8, Int16, Int32 )
-#else
-import Word     	( Word8, Word16, Word32 )
-import Int 	        ( Int8, Int16, Int32 )
-#endif
-#endif
-
--- -----------------------------------------------------------------------------
--- Immediates
-
-data Imm
-  = ImmInt	Int
-  | ImmInteger	Integer	    -- Sigh.
-  | ImmCLbl	CLabel	    -- AbstractC Label (with baggage)
-  | ImmLit	Doc	    -- Simple string
-  | ImmIndex    CLabel Int
-  | ImmFloat	Rational
-  | ImmDouble	Rational
-  | ImmConstantSum Imm Imm
-  | ImmConstantDiff Imm Imm
-#if sparc_TARGET_ARCH
-  | LO Imm		    {- Possible restrictions... -}
-  | HI Imm
-#endif
-#if powerpc_TARGET_ARCH
-  | LO Imm
-  | HI Imm
-  | HA Imm	{- high halfword adjusted -}
-#endif
-strImmLit s = ImmLit (text s)
-
-litToImm :: CmmLit -> Imm
-litToImm (CmmInt i _)        = ImmInteger i
-litToImm (CmmFloat f F32)    = ImmFloat f
-litToImm (CmmFloat f F64)    = ImmDouble f
-litToImm (CmmLabel l)        = ImmCLbl l
-litToImm (CmmLabelOff l off) = ImmIndex l off
-litToImm (CmmLabelDiffOff l1 l2 off)
-                             = ImmConstantSum
-                               (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
-                               (ImmInt off)
-
--- -----------------------------------------------------------------------------
--- Addressing modes
-
-data AddrMode
-#if alpha_TARGET_ARCH
-  = AddrImm	Imm
-  | AddrReg	Reg
-  | AddrRegImm	Reg Imm
-#endif
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-  = AddrBaseIndex	EABase EAIndex Displacement
-  | ImmAddr		Imm Int
-
-data EABase       = EABaseNone  | EABaseReg Reg | EABaseRip
-data EAIndex      = EAIndexNone | EAIndex Reg Int
-type Displacement = Imm
-#endif
-
-#if sparc_TARGET_ARCH
-  = AddrRegReg	Reg Reg
-  | AddrRegImm	Reg Imm
-#endif
-
-#if powerpc_TARGET_ARCH
-  = AddrRegReg	Reg Reg
-  | AddrRegImm	Reg Imm
-#endif
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-addrModeRegs :: AddrMode -> [Reg]
-addrModeRegs (AddrBaseIndex b i _) =  b_regs ++ i_regs
-  where
-   b_regs = case b of { EABaseReg r -> [r]; _ -> [] }
-   i_regs = case i of { EAIndex r _ -> [r]; _ -> [] }
-addrModeRegs _ = []
-#endif
-
-
-addrOffset :: AddrMode -> Int -> Maybe AddrMode
-
-addrOffset addr off
-  = case addr of
-#if alpha_TARGET_ARCH
-      _ -> panic "MachMisc.addrOffset not defined for Alpha"
-#endif
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-      ImmAddr i off0	  -> Just (ImmAddr i (off0 + off))
-
-      AddrBaseIndex r i (ImmInt n) -> Just (AddrBaseIndex r i (ImmInt (n + off)))
-      AddrBaseIndex r i (ImmInteger n)
-	-> Just (AddrBaseIndex r i (ImmInt (fromInteger (n + toInteger off))))
-
-      AddrBaseIndex r i (ImmCLbl lbl)
-	-> Just (AddrBaseIndex r i (ImmIndex lbl off))
-
-      AddrBaseIndex r i (ImmIndex lbl ix)
-	-> Just (AddrBaseIndex r i (ImmIndex lbl (ix+off)))
-
-      _ -> Nothing  -- in theory, shouldn't happen
-#endif
-#if sparc_TARGET_ARCH
-      AddrRegImm r (ImmInt n)
-       | fits13Bits n2 -> Just (AddrRegImm r (ImmInt n2))
-       | otherwise     -> Nothing
-       where n2 = n + off
-
-      AddrRegImm r (ImmInteger n)
-       | fits13Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
-       | otherwise     -> Nothing
-       where n2 = n + toInteger off
-
-      AddrRegReg r (RealReg 0)
-       | fits13Bits off -> Just (AddrRegImm r (ImmInt off))
-       | otherwise     -> Nothing
-       
-      _ -> Nothing
-#endif /* sparc */
-#if powerpc_TARGET_ARCH
-      AddrRegImm r (ImmInt n)
-       | fits16Bits n2 -> Just (AddrRegImm r (ImmInt n2))
-       | otherwise     -> Nothing
-       where n2 = n + off
-
-      AddrRegImm r (ImmInteger n)
-       | fits16Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
-       | otherwise     -> Nothing
-       where n2 = n + toInteger off
-       
-      _ -> Nothing
-#endif /* powerpc */
-
------------------
-#if alpha_TARGET_ARCH
-
-fits8Bits :: Integer -> Bool
-fits8Bits i = i >= -256 && i < 256
-
-#endif
-
-#if sparc_TARGET_ARCH
-
-{-# SPECIALIZE fits13Bits :: Int -> Bool, Integer -> Bool #-}
-fits13Bits :: Integral a => a -> Bool
-fits13Bits x = x >= -4096 && x < 4096
-
------------------
-largeOffsetError i
-  = error ("ERROR: SPARC native-code generator cannot handle large offset ("
-           ++show i++");\nprobably because of large constant data structures;" ++ 
-           "\nworkaround: use -fvia-C on this module.\n")
-
-#endif /* sparc */
-
-#if powerpc_TARGET_ARCH
-fits16Bits :: Integral a => a -> Bool
-fits16Bits x = x >= -32768 && x < 32768
-
-makeImmediate :: Integral a => MachRep -> Bool -> a -> Maybe Imm
-
-makeImmediate rep signed x = fmap ImmInt (toI16 rep signed)
-    where
-        narrow I32 False = fromIntegral (fromIntegral x :: Word32)
-        narrow I16 False = fromIntegral (fromIntegral x :: Word16)
-        narrow I8  False = fromIntegral (fromIntegral x :: Word8)
-        narrow I32 True  = fromIntegral (fromIntegral x :: Int32)
-        narrow I16 True  = fromIntegral (fromIntegral x :: Int16)
-        narrow I8  True  = fromIntegral (fromIntegral x :: Int8)
-        
-        narrowed = narrow rep signed
-        
-        toI16 I32 True
-            | narrowed >= -32768 && narrowed < 32768 = Just narrowed
-            | otherwise = Nothing
-        toI16 I32 False
-            | narrowed >= 0 && narrowed < 65536 = Just narrowed
-            | otherwise = Nothing
-        toI16 _ _  = Just narrowed
-#endif
-
-
--- @spRel@ gives us a stack relative addressing mode for volatile
--- temporaries and for excess call arguments.  @fpRel@, where
--- applicable, is the same but for the frame pointer.
-
-spRel :: Int	-- desired stack offset in words, positive or negative
-      -> AddrMode
-
-spRel n
-#if defined(i386_TARGET_ARCH)
-  = AddrBaseIndex (EABaseReg esp) EAIndexNone (ImmInt (n * wORD_SIZE))
-#elif defined(x86_64_TARGET_ARCH)
-  = AddrBaseIndex (EABaseReg rsp) EAIndexNone (ImmInt (n * wORD_SIZE))
-#else
-  = AddrRegImm sp (ImmInt (n * wORD_SIZE))
-#endif
-
-#if sparc_TARGET_ARCH
-fpRel :: Int -> AddrMode
-    -- Duznae work for offsets greater than 13 bits; we just hope for
-    -- the best
-fpRel n
-  = AddrRegImm fp (ImmInt (n * wORD_SIZE))
-#endif
-
-#if x86_64_TARGET_ARCH
-ripRel imm = AddrBaseIndex EABaseRip EAIndexNone imm
-#endif
-
--- -----------------------------------------------------------------------------
--- Global registers
-
--- We map STG registers onto appropriate CmmExprs.  Either they map
--- to real machine registers or stored as offsets from BaseReg.  Given
--- a GlobalReg, get_GlobalReg_reg_or_addr produces either the real
--- register it is in, on this platform, or a StixExpr denoting the
--- address in the register table holding it.  get_MagicId_addr always
--- produces the register table address for it.
-
-get_GlobalReg_reg_or_addr       :: GlobalReg -> Either Reg CmmExpr
-get_GlobalReg_addr              :: GlobalReg -> CmmExpr
-get_Regtable_addr_from_offset   :: MachRep -> Int -> CmmExpr
-
-get_GlobalReg_reg_or_addr mid
-   = case globalRegMaybe mid of
-        Just rr -> Left rr
-        Nothing -> Right (get_GlobalReg_addr mid)
-
-get_GlobalReg_addr BaseReg = regTableOffset 0
-get_GlobalReg_addr mid     = get_Regtable_addr_from_offset 
-				(globalRegRep mid) (baseRegOffset mid)
-
--- Calculate a literal representing an offset into the register table.
--- Used when we don't have an actual BaseReg to offset from.
-regTableOffset n = 
-  CmmLit (CmmLabelOff mkMainCapabilityLabel (oFFSET_Capability_r + n))
-
-get_Regtable_addr_from_offset rep offset
-   = case globalRegMaybe BaseReg of
-                 Nothing -> regTableOffset offset
-                 Just _  -> CmmRegOff (CmmGlobal BaseReg) offset
-
--- -----------------------------------------------------------------------------
--- caller-save registers
-
--- Here we generate the sequence of saves/restores required around a
--- foreign call instruction.
-
-callerSaveVolatileRegs :: Maybe [GlobalReg] -> ([CmmStmt], [CmmStmt])
-callerSaveVolatileRegs vols = (caller_save, caller_load)
-  where
-    caller_save = foldr ($!) [] (map callerSaveGlobalReg    regs_to_save)
-    caller_load = foldr ($!) [] (map callerRestoreGlobalReg regs_to_save)
-
-    system_regs = [Sp,SpLim,Hp,HpLim,CurrentTSO,CurrentNursery,
-		   {-SparkHd,SparkTl,SparkBase,SparkLim,-}BaseReg ]
-
-    regs_to_save = system_regs ++ vol_list
-
-    vol_list = case vols of Nothing -> all_of_em; Just regs -> regs
-
-    all_of_em = [ VanillaReg n | n <- [0..mAX_Vanilla_REG] ]
-	     ++ [ FloatReg   n | n <- [0..mAX_Float_REG] ]
-	     ++ [ DoubleReg  n | n <- [0..mAX_Double_REG] ]
-	     ++ [ LongReg    n | n <- [0..mAX_Long_REG] ]
-
-    callerSaveGlobalReg reg next
-	| callerSaves reg = 
-		CmmStore (get_GlobalReg_addr reg) 
-			 (CmmReg (CmmGlobal reg)) : next
-	| otherwise = next
-
-    callerRestoreGlobalReg reg next
-	| callerSaves reg = 
-		CmmAssign (CmmGlobal reg)
-			  (CmmLoad (get_GlobalReg_addr reg) (globalRegRep reg))
-			: next
-	| otherwise = next
-
-
--- ---------------------------------------------------------------------------
--- Registers
-
--- RealRegs are machine regs which are available for allocation, in
--- the usual way.  We know what class they are, because that's part of
--- the processor's architecture.
-
--- VirtualRegs are virtual registers.  The register allocator will
--- eventually have to map them into RealRegs, or into spill slots.
--- VirtualRegs are allocated on the fly, usually to represent a single
--- value in the abstract assembly code (i.e. dynamic registers are
--- usually single assignment).  With the new register allocator, the
--- single assignment restriction isn't necessary to get correct code,
--- although a better register allocation will result if single
--- assignment is used -- because the allocator maps a VirtualReg into
--- a single RealReg, even if the VirtualReg has multiple live ranges.
-
--- Virtual regs can be of either class, so that info is attached.
-
--- Determine the upper-half vreg for a 64-bit quantity on a 32-bit platform
--- when supplied with the vreg for the lower-half of the quantity.
--- (NB. Not reversible).
-getHiVRegFromLo (VirtualRegI u) 
-   = VirtualRegHi (newTagUnique u 'H') -- makes a pseudo-unique with tag 'H'
-getHiVRegFromLo other 
-   = pprPanic "getHiVRegFromLo" (ppr other)
-
-data RegClass 
-   = RcInteger 
-   | RcFloat
-   | RcDouble
-     deriving Eq
-
-type RegNo = Int
-
-data Reg
-   = RealReg      {-# UNPACK #-} !RegNo
-   | VirtualRegI  {-# UNPACK #-} !Unique
-   | VirtualRegHi {-# UNPACK #-} !Unique  -- High part of 2-word register
-   | VirtualRegF  {-# UNPACK #-} !Unique
-   | VirtualRegD  {-# UNPACK #-} !Unique
-   deriving (Eq,Ord)
-
--- We like to have Uniques for Reg so that we can make UniqFM and UniqSets 
--- in the register allocator.
-instance Uniquable Reg where
-   getUnique (RealReg i)      = mkUnique 'C' i
-   getUnique (VirtualRegI u)  = u
-   getUnique (VirtualRegHi u) = u
-   getUnique (VirtualRegF u)  = u
-   getUnique (VirtualRegD u)  = u
-
-unRealReg (RealReg i) = i
-unRealReg vreg        = pprPanic "unRealReg on VirtualReg" (ppr vreg)
-
-mkVReg :: Unique -> MachRep -> Reg
-mkVReg u rep
-   = case rep of
-#if sparc_TARGET_ARCH
-        F32   -> VirtualRegF u
-#else
-        F32   -> VirtualRegD u
-#endif
-        F64   -> VirtualRegD u
-        other -> VirtualRegI u
-
-isVirtualReg :: Reg -> Bool
-isVirtualReg (RealReg _)      = False
-isVirtualReg (VirtualRegI _)  = True
-isVirtualReg (VirtualRegHi _) = True
-isVirtualReg (VirtualRegF _)  = True
-isVirtualReg (VirtualRegD _)  = True
-
-isRealReg :: Reg -> Bool
-isRealReg = not . isVirtualReg
-
-instance Show Reg where
-    show (RealReg i)      = showReg i
-    show (VirtualRegI u)  = "%vI_" ++ show u
-    show (VirtualRegHi u) = "%vHi_" ++ show u
-    show (VirtualRegF u)  = "%vF_" ++ show u
-    show (VirtualRegD u)  = "%vD_" ++ show u
-
-instance Outputable Reg where
-    ppr r = Outputable.text (show r)
-
-
--- -----------------------------------------------------------------------------
--- Machine-specific register stuff
-
--- The Alpha has 64 registers of interest; 32 integer registers and 32 floating
--- point registers.  The mapping of STG registers to alpha machine registers
--- is defined in StgRegs.h.  We are, of course, prepared for any eventuality.
-
-#if alpha_TARGET_ARCH
-fReg :: Int -> RegNo
-fReg x = (32 + x)
-
-v0, f0, ra, pv, gp, sp, zeroh :: Reg
-v0    = realReg 0
-f0    = realReg (fReg 0)
-ra    = FixedReg ILIT(26)
-pv    = t12
-gp    = FixedReg ILIT(29)
-sp    = FixedReg ILIT(30)
-zeroh = FixedReg ILIT(31) -- "zero" is used in 1.3 (MonadZero method)
-
-t9, t10, t11, t12 :: Reg
-t9  = realReg 23
-t10 = realReg 24
-t11 = realReg 25
-t12 = realReg 27
-#endif
-
-{-
-Intel x86 architecture:
-- All registers except 7 (esp) are available for use.
-- Only ebx, esi, edi and esp are available across a C call (they are callee-saves).
-- Registers 0-7 have 16-bit counterparts (ax, bx etc.)
-- Registers 0-3 have 8 bit counterparts (ah, bh etc.)
-- Registers 8-13 are fakes; we pretend x86 has 6 conventionally-addressable
-  fp registers, and 3-operand insns for them, and we translate this into
-  real stack-based x86 fp code after register allocation.
-
-The fp registers are all Double registers; we don't have any RcFloat class
-regs.  @regClass@ barfs if you give it a VirtualRegF, and mkVReg above should
-never generate them.
--}
-
-#if i386_TARGET_ARCH
-
-fake0, fake1, fake2, fake3, fake4, fake5, 
-       eax, ebx, ecx, edx, esp, ebp, esi, edi :: Reg
-eax   = RealReg 0
-ebx   = RealReg 1
-ecx   = RealReg 2
-edx   = RealReg 3
-esi   = RealReg 4
-edi   = RealReg 5
-ebp   = RealReg 6
-esp   = RealReg 7
-fake0 = RealReg 8
-fake1 = RealReg 9
-fake2 = RealReg 10
-fake3 = RealReg 11
-fake4 = RealReg 12
-fake5 = RealReg 13
-
--- On x86, we might want to have an 8-bit RegClass, which would
--- contain just regs 1-4 (the others don't have 8-bit versions).
--- However, we can get away without this at the moment because the
--- only allocatable integer regs are also 8-bit compatible (1, 3, 4).
-regClass (RealReg i)     = if i < 8 then RcInteger else RcDouble
-regClass (VirtualRegI  u) = RcInteger
-regClass (VirtualRegHi u) = RcInteger
-regClass (VirtualRegD  u) = RcDouble
-regClass (VirtualRegF  u) = pprPanic "regClass(x86):VirtualRegF" 
-                                    (ppr (VirtualRegF u))
-
-regNames 
-   = ["%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "%ebp", "%esp", 
-      "%fake0", "%fake1", "%fake2", "%fake3", "%fake4", "%fake5", "%fake6"]
-
-showReg :: RegNo -> String
-showReg n
-   = if   n >= 0 && n < 14
-     then regNames !! n
-     else "%unknown_x86_real_reg_" ++ show n
-
-#endif
-
-{-
-AMD x86_64 architecture:
-- Registers 0-16 have 32-bit counterparts (eax, ebx etc.)
-- Registers 0-7 have 16-bit counterparts (ax, bx etc.)
-- Registers 0-3 have 8 bit counterparts (ah, bh etc.)
-
--}
-
-#if x86_64_TARGET_ARCH
-
-rax, rbx, rcx, rdx, rsp, rbp, rsi, rdi, 
-  r8, r9, r10, r11, r12, r13, r14, r15,
-  xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7,
-  xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15 :: Reg
-
-rax   = RealReg 0
-rbx   = RealReg 1
-rcx   = RealReg 2
-rdx   = RealReg 3
-rsi   = RealReg 4
-rdi   = RealReg 5
-rbp   = RealReg 6
-rsp   = RealReg 7
-r8    = RealReg 8
-r9    = RealReg 9
-r10   = RealReg 10
-r11   = RealReg 11
-r12   = RealReg 12
-r13   = RealReg 13
-r14   = RealReg 14
-r15   = RealReg 15
-xmm0  = RealReg 16
-xmm1  = RealReg 17
-xmm2  = RealReg 18
-xmm3  = RealReg 19
-xmm4  = RealReg 20
-xmm5  = RealReg 21
-xmm6  = RealReg 22
-xmm7  = RealReg 23
-xmm8  = RealReg 24
-xmm9  = RealReg 25
-xmm10 = RealReg 26
-xmm11 = RealReg 27
-xmm12 = RealReg 28
-xmm13 = RealReg 29
-xmm14 = RealReg 30
-xmm15 = RealReg 31
-
- -- so we can re-use some x86 code:
-eax = rax
-ebx = rbx
-ecx = rcx
-edx = rdx
-esi = rsi
-edi = rdi
-ebp = rbp
-esp = rsp
-
-xmm n = RealReg (16+n)
-
--- On x86, we might want to have an 8-bit RegClass, which would
--- contain just regs 1-4 (the others don't have 8-bit versions).
--- However, we can get away without this at the moment because the
--- only allocatable integer regs are also 8-bit compatible (1, 3, 4).
-regClass (RealReg i)     = if i < 16 then RcInteger else RcDouble
-regClass (VirtualRegI  u) = RcInteger
-regClass (VirtualRegHi u) = RcInteger
-regClass (VirtualRegD  u) = RcDouble
-regClass (VirtualRegF  u) = pprPanic "regClass(x86_64):VirtualRegF" 
-                                    (ppr (VirtualRegF u))
-
-regNames 
- = ["%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi", "%rbp", "%rsp" ]
-
-showReg :: RegNo -> String
-showReg n
-  | n >= 16 = "%xmm" ++ show (n-16)
-  | n >= 8  = "%r" ++ show n
-  | otherwise = regNames !! n
-
-#endif
-
-{-
-The SPARC has 64 registers of interest; 32 integer registers and 32
-floating point registers.  The mapping of STG registers to SPARC
-machine registers is defined in StgRegs.h.  We are, of course,
-prepared for any eventuality.
-
-The whole fp-register pairing thing on sparcs is a huge nuisance.  See
-fptools/ghc/includes/MachRegs.h for a description of what's going on
-here.
--}
-
-#if sparc_TARGET_ARCH
-
-gReg,lReg,iReg,oReg,fReg :: Int -> RegNo
-gReg x = x
-oReg x = (8 + x)
-lReg x = (16 + x)
-iReg x = (24 + x)
-fReg x = (32 + x)
-
-nCG_FirstFloatReg :: RegNo
-nCG_FirstFloatReg = unRealReg NCG_FirstFloatReg
-
-regClass (VirtualRegI u) = RcInteger
-regClass (VirtualRegF u) = RcFloat
-regClass (VirtualRegD u) = RcDouble
-regClass (RealReg i) | i < 32                = RcInteger 
-                     | i < nCG_FirstFloatReg = RcDouble
-                     | otherwise             = RcFloat
-
-showReg :: RegNo -> String
-showReg n
-   | n >= 0  && n < 8   = "%g" ++ show n
-   | n >= 8  && n < 16  = "%o" ++ show (n-8)
-   | n >= 16 && n < 24  = "%l" ++ show (n-16)
-   | n >= 24 && n < 32  = "%i" ++ show (n-24)
-   | n >= 32 && n < 64  = "%f" ++ show (n-32)
-   | otherwise          = "%unknown_sparc_real_reg_" ++ show n
-
-g0, g1, g2, fp, sp, o0, o1, f0, f1, f6, f8, f22, f26, f27 :: Reg
-
-f6  = RealReg (fReg 6)
-f8  = RealReg (fReg 8)
-f22 = RealReg (fReg 22)
-f26 = RealReg (fReg 26)
-f27 = RealReg (fReg 27)
-
-
--- g0 is useful for codegen; is always zero, and writes to it vanish.
-g0  = RealReg (gReg 0)
-g1  = RealReg (gReg 1)
-g2  = RealReg (gReg 2)
-
--- FP, SP, int and float return (from C) regs.
-fp  = RealReg (iReg 6)
-sp  = RealReg (oReg 6)
-o0  = RealReg (oReg 0)
-o1  = RealReg (oReg 1)
-f0  = RealReg (fReg 0)
-f1  = RealReg (fReg 1)
-
-#endif
-
-{-
-The PowerPC has 64 registers of interest; 32 integer registers and 32 floating
-point registers.
--}
-
-#if powerpc_TARGET_ARCH
-fReg :: Int -> RegNo
-fReg x = (32 + x)
-
-regClass (VirtualRegI  u) = RcInteger
-regClass (VirtualRegHi u) = RcInteger
-regClass (VirtualRegF  u) = pprPanic "regClass(ppc):VirtualRegF" 
-                                    (ppr (VirtualRegF u))
-regClass (VirtualRegD u) = RcDouble
-regClass (RealReg i) | i < 32                = RcInteger 
-		     | otherwise	     = RcDouble
-
-showReg :: RegNo -> String
-showReg n
-    | n >= 0 && n <= 31	  = "%r" ++ show n
-    | n >= 32 && n <= 63  = "%f" ++ show (n - 32)
-    | otherwise           = "%unknown_powerpc_real_reg_" ++ show n
-
-sp = RealReg 1
-r3 = RealReg 3
-r4 = RealReg 4
-r27 = RealReg 27
-r28 = RealReg 28
-f1 = RealReg $ fReg 1
-f20 = RealReg $ fReg 20
-f21 = RealReg $ fReg 21
-#endif
-
-{-
-Redefine the literals used for machine-registers with non-numeric
-names in the header files.  Gag me with a spoon, eh?
--}
-
-#if alpha_TARGET_ARCH
-#define f0 32
-#define f1 33
-#define f2 34
-#define f3 35
-#define f4 36
-#define f5 37
-#define f6 38
-#define f7 39
-#define f8 40
-#define f9 41
-#define f10 42
-#define f11 43
-#define f12 44
-#define f13 45
-#define f14 46
-#define f15 47
-#define f16 48
-#define f17 49
-#define f18 50
-#define f19 51
-#define f20 52
-#define f21 53
-#define f22 54
-#define f23 55
-#define f24 56
-#define f25 57
-#define f26 58
-#define f27 59
-#define f28 60
-#define f29 61
-#define f30 62
-#define f31 63
-#endif
-#if i386_TARGET_ARCH
-#define eax 0
-#define ebx 1
-#define ecx 2
-#define edx 3
-#define esi 4
-#define edi 5
-#define ebp 6
-#define esp 7
-#define fake0 8
-#define fake1 9
-#define fake2 10
-#define fake3 11
-#define fake4 12
-#define fake5 13
-#endif
-
-#if x86_64_TARGET_ARCH
-#define rax   0
-#define rbx   1
-#define rcx   2
-#define rdx   3
-#define rsi   4
-#define rdi   5
-#define rbp   6
-#define rsp   7
-#define r8    8
-#define r9    9
-#define r10   10
-#define r11   11
-#define r12   12
-#define r13   13
-#define r14   14
-#define r15   15
-#define xmm0  16
-#define xmm1  17
-#define xmm2  18
-#define xmm3  19
-#define xmm4  20
-#define xmm5  21
-#define xmm6  22
-#define xmm7  23
-#define xmm8  24
-#define xmm9  25
-#define xmm10 26
-#define xmm11 27
-#define xmm12 28
-#define xmm13 29
-#define xmm14 30
-#define xmm15 31
-#endif
-
-#if sparc_TARGET_ARCH
-#define g0 0
-#define g1 1
-#define g2 2
-#define g3 3
-#define g4 4
-#define g5 5
-#define g6 6
-#define g7 7
-#define o0 8
-#define o1 9
-#define o2 10
-#define o3 11
-#define o4 12
-#define o5 13
-#define o6 14
-#define o7 15
-#define l0 16
-#define l1 17
-#define l2 18
-#define l3 19
-#define l4 20
-#define l5 21
-#define l6 22
-#define l7 23
-#define i0 24
-#define i1 25
-#define i2 26
-#define i3 27
-#define i4 28
-#define i5 29
-#define i6 30
-#define i7 31
-
-#define f0  32
-#define f1  33
-#define f2  34
-#define f3  35
-#define f4  36
-#define f5  37
-#define f6  38
-#define f7  39
-#define f8  40
-#define f9  41
-#define f10 42
-#define f11 43
-#define f12 44
-#define f13 45
-#define f14 46
-#define f15 47
-#define f16 48
-#define f17 49
-#define f18 50
-#define f19 51
-#define f20 52
-#define f21 53
-#define f22 54
-#define f23 55
-#define f24 56
-#define f25 57
-#define f26 58
-#define f27 59
-#define f28 60
-#define f29 61
-#define f30 62
-#define f31 63
-#endif
-
-#if powerpc_TARGET_ARCH
-#define r0 0
-#define r1 1
-#define r2 2
-#define r3 3
-#define r4 4
-#define r5 5
-#define r6 6
-#define r7 7
-#define r8 8
-#define r9 9
-#define r10 10
-#define r11 11
-#define r12 12
-#define r13 13
-#define r14 14
-#define r15 15
-#define r16 16
-#define r17 17
-#define r18 18
-#define r19 19
-#define r20 20
-#define r21 21
-#define r22 22
-#define r23 23
-#define r24 24
-#define r25 25
-#define r26 26
-#define r27 27
-#define r28 28
-#define r29 29
-#define r30 30
-#define r31 31
-
-#ifdef darwin_TARGET_OS
-#define f0  32
-#define f1  33
-#define f2  34
-#define f3  35
-#define f4  36
-#define f5  37
-#define f6  38
-#define f7  39
-#define f8  40
-#define f9  41
-#define f10 42
-#define f11 43
-#define f12 44
-#define f13 45
-#define f14 46
-#define f15 47
-#define f16 48
-#define f17 49
-#define f18 50
-#define f19 51
-#define f20 52
-#define f21 53
-#define f22 54
-#define f23 55
-#define f24 56
-#define f25 57
-#define f26 58
-#define f27 59
-#define f28 60
-#define f29 61
-#define f30 62
-#define f31 63
-#else
-#define fr0  32
-#define fr1  33
-#define fr2  34
-#define fr3  35
-#define fr4  36
-#define fr5  37
-#define fr6  38
-#define fr7  39
-#define fr8  40
-#define fr9  41
-#define fr10 42
-#define fr11 43
-#define fr12 44
-#define fr13 45
-#define fr14 46
-#define fr15 47
-#define fr16 48
-#define fr17 49
-#define fr18 50
-#define fr19 51
-#define fr20 52
-#define fr21 53
-#define fr22 54
-#define fr23 55
-#define fr24 56
-#define fr25 57
-#define fr26 58
-#define fr27 59
-#define fr28 60
-#define fr29 61
-#define fr30 62
-#define fr31 63
-#endif
-#endif
-
-
--- allMachRegs is the complete set of machine regs.
-allMachRegNos :: [RegNo]
-allMachRegNos
-   = IF_ARCH_alpha( [0..63],
-     IF_ARCH_i386(  [0..13],
-     IF_ARCH_x86_64( [0..31],
-     IF_ARCH_sparc( ([0..31]
-                     ++ [f0,f2 .. nCG_FirstFloatReg-1]
-                     ++ [nCG_FirstFloatReg .. f31]),
-     IF_ARCH_powerpc([0..63],
-                   )))))
-
--- allocatableRegs is allMachRegNos with the fixed-use regs removed.
--- i.e., these are the regs for which we are prepared to allow the
--- register allocator to attempt to map VRegs to.
-allocatableRegs :: [RegNo]
-allocatableRegs
-   = let isFree i = isFastTrue (freeReg i)
-     in  filter isFree allMachRegNos
-
--- these are the regs which we cannot assume stay alive over a
--- C call.  
-callClobberedRegs :: [Reg]
-callClobberedRegs
-  =
-#if alpha_TARGET_ARCH
-    [0, 1, 2, 3, 4, 5, 6, 7, 8,
-     16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
-     fReg 0, fReg 1, fReg 10, fReg 11, fReg 12, fReg 13, fReg 14, fReg 15,
-     fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21, fReg 22, fReg 23,
-     fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30]
-#endif /* alpha_TARGET_ARCH */
-#if i386_TARGET_ARCH
-    -- caller-saves registers
-    map RealReg [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5]
-#endif /* i386_TARGET_ARCH */
-#if x86_64_TARGET_ARCH
-    -- caller-saves registers
-    map RealReg ([rax,rcx,rdx,rsi,rdi,r8,r9,r10,r11] ++ [16..31])
-       -- all xmm regs are caller-saves
-#endif /* x86_64_TARGET_ARCH */
-#if sparc_TARGET_ARCH
-    map RealReg 
-        ( oReg 7 :
-          [oReg i | i <- [0..5]] ++
-          [gReg i | i <- [1..7]] ++
-          [fReg i | i <- [0..31]] )
-#endif /* sparc_TARGET_ARCH */
-#if powerpc_TARGET_ARCH
-#if darwin_TARGET_OS
-    map RealReg (0:[2..12] ++ map fReg [0..13])
-#elif linux_TARGET_OS
-    map RealReg (0:[2..13] ++ map fReg [0..13])
-#endif
-#endif /* powerpc_TARGET_ARCH */
-
-
--- argRegs is the set of regs which are read for an n-argument call to C.
--- For archs which pass all args on the stack (x86), is empty.
--- Sparc passes up to the first 6 args in regs.
--- Dunno about Alpha.
-argRegs :: RegNo -> [Reg]
-
-#if i386_TARGET_ARCH
-argRegs _ = panic "MachRegs.argRegs(x86): should not be used!"
-#endif
-
-#if x86_64_TARGET_ARCH
-argRegs _ = panic "MachRegs.argRegs(x86_64): should not be used!"
-#endif
-
-#if alpha_TARGET_ARCH
-argRegs 0 = []
-argRegs 1 = freeMappedRegs [16, fReg 16]
-argRegs 2 = freeMappedRegs [16, 17, fReg 16, fReg 17]
-argRegs 3 = freeMappedRegs [16, 17, 18, fReg 16, fReg 17, fReg 18]
-argRegs 4 = freeMappedRegs [16, 17, 18, 19, fReg 16, fReg 17, fReg 18, fReg 19]
-argRegs 5 = freeMappedRegs [16, 17, 18, 19, 20, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20]
-argRegs 6 = freeMappedRegs [16, 17, 18, 19, 20, 21, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21]
-argRegs _ = panic "MachRegs.argRegs(alpha): don't know about >6 arguments!"
-#endif /* alpha_TARGET_ARCH */
-
-#if sparc_TARGET_ARCH
-argRegs 0 = []
-argRegs 1 = map (RealReg . oReg) [0]
-argRegs 2 = map (RealReg . oReg) [0,1]
-argRegs 3 = map (RealReg . oReg) [0,1,2]
-argRegs 4 = map (RealReg . oReg) [0,1,2,3]
-argRegs 5 = map (RealReg . oReg) [0,1,2,3,4]
-argRegs 6 = map (RealReg . oReg) [0,1,2,3,4,5]
-argRegs _ = panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"
-#endif /* sparc_TARGET_ARCH */
-
-#if powerpc_TARGET_ARCH
-argRegs 0 = []
-argRegs 1 = map RealReg [3]
-argRegs 2 = map RealReg [3,4]
-argRegs 3 = map RealReg [3..5]
-argRegs 4 = map RealReg [3..6]
-argRegs 5 = map RealReg [3..7]
-argRegs 6 = map RealReg [3..8]
-argRegs 7 = map RealReg [3..9]
-argRegs 8 = map RealReg [3..10]
-argRegs _ = panic "MachRegs.argRegs(powerpc): don't know about >8 arguments!"
-#endif /* powerpc_TARGET_ARCH */
-
-
--- all of the arg regs ??
-#if alpha_TARGET_ARCH
-allArgRegs :: [(Reg, Reg)]
-allArgRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]]
-#endif /* alpha_TARGET_ARCH */
-
-#if sparc_TARGET_ARCH
-allArgRegs :: [Reg]
-allArgRegs = map RealReg [oReg i | i <- [0..5]]
-#endif /* sparc_TARGET_ARCH */
-
-#if i386_TARGET_ARCH
-allArgRegs :: [Reg]
-allArgRegs = panic "MachRegs.allArgRegs(x86): should not be used!"
-#endif
-
-#if x86_64_TARGET_ARCH
-allArgRegs :: [Reg]
-allArgRegs = map RealReg [rdi,rsi,rdx,rcx,r8,r9]
-allFPArgRegs :: [Reg]
-allFPArgRegs = map RealReg [xmm0 .. xmm7]
-#endif
-
-#if powerpc_TARGET_ARCH
-allArgRegs :: [Reg]
-allArgRegs = map RealReg [3..10]
-allFPArgRegs :: [Reg]
-#if darwin_TARGET_OS
-allFPArgRegs = map (RealReg . fReg) [1..13]
-#elif linux_TARGET_OS
-allFPArgRegs = map (RealReg . fReg) [1..8]
-#endif
-#endif /* powerpc_TARGET_ARCH */
-\end{code}
-
-\begin{code}
-freeReg :: RegNo -> FastBool
-
-#if alpha_TARGET_ARCH
-freeReg 26 = fastBool False  -- return address (ra)
-freeReg 28 = fastBool False  -- reserved for the assembler (at)
-freeReg 29 = fastBool False  -- global pointer (gp)
-freeReg 30 = fastBool False  -- stack pointer (sp)
-freeReg 31 = fastBool False  -- always zero (zeroh)
-freeReg 63 = fastBool False  -- always zero (f31)
-#endif
-
-#if i386_TARGET_ARCH
-freeReg esp = fastBool False  --	%esp is the C stack pointer
-#endif
-
-#if x86_64_TARGET_ARCH
-freeReg rsp = fastBool False  --	%rsp is the C stack pointer
-#endif
-
-#if sparc_TARGET_ARCH
-freeReg g0 = fastBool False  --	%g0 is always 0.
-freeReg g5 = fastBool False  --	%g5 is reserved (ABI).
-freeReg g6 = fastBool False  --	%g6 is reserved (ABI).
-freeReg g7 = fastBool False  --	%g7 is reserved (ABI).
-freeReg i6 = fastBool False  --	%i6 is our frame pointer.
-freeReg i7 = fastBool False  --	%i7 tends to have ret-addr-ish things
-freeReg o6 = fastBool False  --	%o6 is our stack pointer.
-freeReg o7 = fastBool False  --	%o7 holds ret addrs (???)
-freeReg f0 = fastBool False  --  %f0/%f1 are the C fp return registers.
-freeReg f1 = fastBool False
-#endif
-
-#if powerpc_TARGET_ARCH
-freeReg 0 = fastBool False -- Hack: r0 can't be used in all insns, but it's actually free
-freeReg 1 = fastBool False -- The Stack Pointer
-#if !darwin_TARGET_OS
- -- most non-darwin powerpc OSes use r2 as a TOC pointer or something like that
-freeReg 2 = fastBool False
-#endif
-#endif
-
-#ifdef REG_Base
-freeReg REG_Base = fastBool False
-#endif
-#ifdef REG_R1
-freeReg REG_R1   = fastBool False
-#endif	
-#ifdef REG_R2  
-freeReg REG_R2   = fastBool False
-#endif	
-#ifdef REG_R3  
-freeReg REG_R3   = fastBool False
-#endif	
-#ifdef REG_R4  
-freeReg REG_R4   = fastBool False
-#endif	
-#ifdef REG_R5  
-freeReg REG_R5   = fastBool False
-#endif	
-#ifdef REG_R6  
-freeReg REG_R6   = fastBool False
-#endif	
-#ifdef REG_R7  
-freeReg REG_R7   = fastBool False
-#endif	
-#ifdef REG_R8  
-freeReg REG_R8   = fastBool False
-#endif
-#ifdef REG_F1
-freeReg REG_F1 = fastBool False
-#endif
-#ifdef REG_F2
-freeReg REG_F2 = fastBool False
-#endif
-#ifdef REG_F3
-freeReg REG_F3 = fastBool False
-#endif
-#ifdef REG_F4
-freeReg REG_F4 = fastBool False
-#endif
-#ifdef REG_D1
-freeReg REG_D1 = fastBool False
-#endif
-#ifdef REG_D2
-freeReg REG_D2 = fastBool False
-#endif
-#ifdef REG_Sp 
-freeReg REG_Sp   = fastBool False
-#endif 
-#ifdef REG_Su
-freeReg REG_Su   = fastBool False
-#endif 
-#ifdef REG_SpLim 
-freeReg REG_SpLim = fastBool False
-#endif 
-#ifdef REG_Hp 
-freeReg REG_Hp   = fastBool False
-#endif
-#ifdef REG_HpLim
-freeReg REG_HpLim = fastBool False
-#endif
-freeReg n               = fastBool True
-
-
--- -----------------------------------------------------------------------------
--- Information about global registers
-
-baseRegOffset :: GlobalReg -> Int
-
-baseRegOffset (VanillaReg 1)      = oFFSET_StgRegTable_rR1
-baseRegOffset (VanillaReg 2)      = oFFSET_StgRegTable_rR2
-baseRegOffset (VanillaReg 3)      = oFFSET_StgRegTable_rR3
-baseRegOffset (VanillaReg 4)      = oFFSET_StgRegTable_rR4
-baseRegOffset (VanillaReg 5)      = oFFSET_StgRegTable_rR5
-baseRegOffset (VanillaReg 6)      = oFFSET_StgRegTable_rR6
-baseRegOffset (VanillaReg 7)      = oFFSET_StgRegTable_rR7
-baseRegOffset (VanillaReg 8)      = oFFSET_StgRegTable_rR8
-baseRegOffset (VanillaReg 9)      = oFFSET_StgRegTable_rR9
-baseRegOffset (VanillaReg 10)     = oFFSET_StgRegTable_rR10
-baseRegOffset (FloatReg  1)       = oFFSET_StgRegTable_rF1
-baseRegOffset (FloatReg  2)       = oFFSET_StgRegTable_rF2
-baseRegOffset (FloatReg  3)       = oFFSET_StgRegTable_rF3
-baseRegOffset (FloatReg  4)       = oFFSET_StgRegTable_rF4
-baseRegOffset (DoubleReg 1)       = oFFSET_StgRegTable_rD1
-baseRegOffset (DoubleReg 2)       = oFFSET_StgRegTable_rD2
-baseRegOffset Sp		  = oFFSET_StgRegTable_rSp
-baseRegOffset SpLim		  = oFFSET_StgRegTable_rSpLim
-baseRegOffset (LongReg 1)         = oFFSET_StgRegTable_rL1
-baseRegOffset Hp		  = oFFSET_StgRegTable_rHp
-baseRegOffset HpLim		  = oFFSET_StgRegTable_rHpLim
-baseRegOffset CurrentTSO	  = oFFSET_StgRegTable_rCurrentTSO
-baseRegOffset CurrentNursery	  = oFFSET_StgRegTable_rCurrentNursery
-baseRegOffset HpAlloc		  = oFFSET_StgRegTable_rHpAlloc
-baseRegOffset GCEnter1		  = oFFSET_stgGCEnter1
-baseRegOffset GCFun		  = oFFSET_stgGCFun
-#ifdef DEBUG
-baseRegOffset BaseReg		  = panic "baseRegOffset:BaseReg"
-baseRegOffset _			  = panic "baseRegOffset:other"
-#endif
-
-
--- | Returns 'True' if this global register is stored in a caller-saves
--- machine register.
-
-callerSaves :: GlobalReg -> Bool
-
-#ifdef CALLER_SAVES_Base
-callerSaves BaseReg		= True
-#endif
-#ifdef CALLER_SAVES_R1
-callerSaves (VanillaReg 1)	= True
-#endif
-#ifdef CALLER_SAVES_R2
-callerSaves (VanillaReg 2)	= True
-#endif
-#ifdef CALLER_SAVES_R3
-callerSaves (VanillaReg 3)	= True
-#endif
-#ifdef CALLER_SAVES_R4
-callerSaves (VanillaReg 4)	= True
-#endif
-#ifdef CALLER_SAVES_R5
-callerSaves (VanillaReg 5)	= True
-#endif
-#ifdef CALLER_SAVES_R6
-callerSaves (VanillaReg 6)	= True
-#endif
-#ifdef CALLER_SAVES_R7
-callerSaves (VanillaReg 7)	= True
-#endif
-#ifdef CALLER_SAVES_R8
-callerSaves (VanillaReg 8)	= True
-#endif
-#ifdef CALLER_SAVES_F1
-callerSaves (FloatReg 1)	= True
-#endif
-#ifdef CALLER_SAVES_F2
-callerSaves (FloatReg 2)	= True
-#endif
-#ifdef CALLER_SAVES_F3
-callerSaves (FloatReg 3)	= True
-#endif
-#ifdef CALLER_SAVES_F4
-callerSaves (FloatReg 4)	= True
-#endif
-#ifdef CALLER_SAVES_D1
-callerSaves (DoubleReg 1)	= True
-#endif
-#ifdef CALLER_SAVES_D2
-callerSaves (DoubleReg 2)	= True
-#endif
-#ifdef CALLER_SAVES_L1
-callerSaves (LongReg 1)		= True
-#endif
-#ifdef CALLER_SAVES_Sp
-callerSaves Sp			= True
-#endif
-#ifdef CALLER_SAVES_SpLim
-callerSaves SpLim		= True
-#endif
-#ifdef CALLER_SAVES_Hp
-callerSaves Hp			= True
-#endif
-#ifdef CALLER_SAVES_HpLim
-callerSaves HpLim		= True
-#endif
-#ifdef CALLER_SAVES_CurrentTSO
-callerSaves CurrentTSO		= True
-#endif
-#ifdef CALLER_SAVES_CurrentNursery
-callerSaves CurrentNursery	= True
-#endif
-callerSaves _			= False
-
-
---  | Returns 'Nothing' if this global register is not stored
--- in a real machine register, otherwise returns @'Just' reg@, where
--- reg is the machine register it is stored in.
-
-globalRegMaybe :: GlobalReg -> Maybe Reg
-
-#ifdef REG_Base
-globalRegMaybe BaseReg			= Just (RealReg REG_Base)
-#endif
-#ifdef REG_R1
-globalRegMaybe (VanillaReg 1) 		= Just (RealReg REG_R1)
-#endif 
-#ifdef REG_R2 
-globalRegMaybe (VanillaReg 2) 		= Just (RealReg REG_R2)
-#endif 
-#ifdef REG_R3 
-globalRegMaybe (VanillaReg 3) 		= Just (RealReg REG_R3)
-#endif 
-#ifdef REG_R4 
-globalRegMaybe (VanillaReg 4) 		= Just (RealReg REG_R4)
-#endif 
-#ifdef REG_R5 
-globalRegMaybe (VanillaReg 5) 		= Just (RealReg REG_R5)
-#endif 
-#ifdef REG_R6 
-globalRegMaybe (VanillaReg 6) 		= Just (RealReg REG_R6)
-#endif 
-#ifdef REG_R7 
-globalRegMaybe (VanillaReg 7) 		= Just (RealReg REG_R7)
-#endif 
-#ifdef REG_R8 
-globalRegMaybe (VanillaReg 8) 		= Just (RealReg REG_R8)
-#endif
-#ifdef REG_R9 
-globalRegMaybe (VanillaReg 9) 		= Just (RealReg REG_R9)
-#endif
-#ifdef REG_R10 
-globalRegMaybe (VanillaReg 10)		= Just (RealReg REG_R10)
-#endif
-#ifdef REG_F1
-globalRegMaybe (FloatReg 1)		= Just (RealReg REG_F1)
-#endif				 	
-#ifdef REG_F2			 	
-globalRegMaybe (FloatReg 2)		= Just (RealReg REG_F2)
-#endif				 	
-#ifdef REG_F3			 	
-globalRegMaybe (FloatReg 3)		= Just (RealReg REG_F3)
-#endif				 	
-#ifdef REG_F4			 	
-globalRegMaybe (FloatReg 4)		= Just (RealReg REG_F4)
-#endif				 	
-#ifdef REG_D1			 	
-globalRegMaybe (DoubleReg 1)		= Just (RealReg REG_D1)
-#endif				 	
-#ifdef REG_D2			 	
-globalRegMaybe (DoubleReg 2)		= Just (RealReg REG_D2)
-#endif
-#ifdef REG_Sp	    
-globalRegMaybe Sp		   	= Just (RealReg REG_Sp)
-#endif
-#ifdef REG_Lng1			 	
-globalRegMaybe (LongReg 1)		= Just (RealReg REG_Lng1)
-#endif				 	
-#ifdef REG_Lng2			 	
-globalRegMaybe (LongReg 2)		= Just (RealReg REG_Lng2)
-#endif
-#ifdef REG_SpLim	    			
-globalRegMaybe SpLim		   	= Just (RealReg REG_SpLim)
-#endif	    				
-#ifdef REG_Hp	   			
-globalRegMaybe Hp		   	= Just (RealReg REG_Hp)
-#endif	    				
-#ifdef REG_HpLim      			
-globalRegMaybe HpLim		   	= Just (RealReg REG_HpLim)
-#endif	    				
-#ifdef REG_CurrentTSO      			
-globalRegMaybe CurrentTSO	   	= Just (RealReg REG_CurrentTSO)
-#endif	    				
-#ifdef REG_CurrentNursery      			
-globalRegMaybe CurrentNursery	   	= Just (RealReg REG_CurrentNursery)
-#endif	    				
-globalRegMaybe _		   	= Nothing
-
-
-\end{code}
diff --git a/ghc/compiler/nativeGen/NCG.h b/ghc/compiler/nativeGen/NCG.h
deleted file mode 100644
index b17f682e71..0000000000
--- a/ghc/compiler/nativeGen/NCG.h
+++ /dev/null
@@ -1,108 +0,0 @@
-/* -----------------------------------------------------------------------------
-
-   (c) The University of Glasgow, 1994-2004
-
-   Native-code generator header file - just useful macros for now.
-
-   -------------------------------------------------------------------------- */
-
-#ifndef NCG_H
-#define NCG_H
-
-#include "ghc_boot_platform.h"
-
-#define COMMA ,
-
--- - - - - - - - - - - - - - - - - - - - - - 
-#if alpha_TARGET_ARCH
-# define IF_ARCH_alpha(x,y) x
-#else
-# define IF_ARCH_alpha(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if i386_TARGET_ARCH
-# define IF_ARCH_i386(x,y) x
-#else
-# define IF_ARCH_i386(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if x86_64_TARGET_ARCH
-# define IF_ARCH_x86_64(x,y) x
-#else
-# define IF_ARCH_x86_64(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if freebsd_TARGET_OS
-# define IF_OS_freebsd(x,y) x
-#else
-# define IF_OS_freebsd(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if netbsd_TARGET_OS
-# define IF_OS_netbsd(x,y) x
-#else
-# define IF_OS_netbsd(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if openbsd_TARGET_OS
-# define IF_OS_openbsd(x,y) x
-#else
-# define IF_OS_openbsd(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if linux_TARGET_OS
-# define IF_OS_linux(x,y) x
-#else
-# define IF_OS_linux(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if linuxaout_TARGET_OS
-# define IF_OS_linuxaout(x,y) x
-#else
-# define IF_OS_linuxaout(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if bsdi_TARGET_OS
-# define IF_OS_bsdi(x,y) x
-#else
-# define IF_OS_bsdi(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if cygwin32_TARGET_OS
-# define IF_OS_cygwin32(x,y) x
-#else
-# define IF_OS_cygwin32(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if sparc_TARGET_ARCH
-# define IF_ARCH_sparc(x,y) x
-#else
-# define IF_ARCH_sparc(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if sunos4_TARGET_OS
-# define IF_OS_sunos4(x,y) x
-#else
-# define IF_OS_sunos4(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
--- NB: this will catch i386-*-solaris2, too
-#if solaris2_TARGET_OS
-# define IF_OS_solaris2(x,y) x
-#else
-# define IF_OS_solaris2(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if powerpc_TARGET_ARCH
-# define IF_ARCH_powerpc(x,y) x
-#else
-# define IF_ARCH_powerpc(x,y) y
-#endif
--- - - - - - - - - - - - - - - - - - - - - - 
-#if darwin_TARGET_OS
-# define IF_OS_darwin(x,y) x
-#else
-# define IF_OS_darwin(x,y) y
-#endif
----------------------------------------------
-#endif
diff --git a/ghc/compiler/nativeGen/NCGMonad.hs b/ghc/compiler/nativeGen/NCGMonad.hs
deleted file mode 100644
index 8fdcd44024..0000000000
--- a/ghc/compiler/nativeGen/NCGMonad.hs
+++ /dev/null
@@ -1,111 +0,0 @@
--- -----------------------------------------------------------------------------
---
--- (c) The University of Glasgow 1993-2004
--- 
--- The native code generator's monad.
---
--- -----------------------------------------------------------------------------
-
-module NCGMonad (
-	NatM_State(..), mkNatM_State,
-
-	NatM, -- instance Monad
-	initNat, addImportNat, getUniqueNat,
-	mapAccumLNat, setDeltaNat, getDeltaNat,
-	getBlockIdNat, getNewLabelNat, getNewRegNat, getNewRegPairNat,
-	getPicBaseMaybeNat, getPicBaseNat
- ) where
-  
-#include "HsVersions.h"
-
-import Cmm		( BlockId(..) )
-import CLabel		( CLabel, mkAsmTempLabel )
-import MachRegs
-import MachOp		( MachRep )
-import UniqSupply
-import Unique		( Unique )
-
-
-data NatM_State = NatM_State {
-			natm_us      :: UniqSupply,
-			natm_delta   :: Int,
-			natm_imports :: [(CLabel)],
-			natm_pic     :: Maybe Reg
-		}
-
-newtype NatM result = NatM (NatM_State -> (result, NatM_State))
-
-unNat (NatM a) = a
-
-mkNatM_State :: UniqSupply -> Int -> NatM_State
-mkNatM_State us delta = NatM_State us delta [] Nothing
-
-initNat :: NatM_State -> NatM a -> (a, NatM_State)
-initNat init_st m = case unNat m init_st of { (r,st) -> (r,st) }
-
-instance Monad NatM where
-  (>>=) = thenNat
-  return = returnNat
-
-thenNat :: NatM a -> (a -> NatM b) -> NatM b
-thenNat expr cont
-  = NatM $ \st -> case unNat expr st of
-			(result, st') -> unNat (cont result) st'
-
-returnNat :: a -> NatM a
-returnNat result = NatM $ \st ->  (result, st)
-
-mapAccumLNat :: (acc -> x -> NatM (acc, y))
-                -> acc
-	        -> [x]
-	        -> NatM (acc, [y])
-
-mapAccumLNat f b []
-  = return (b, [])
-mapAccumLNat f b (x:xs)
-  = do (b__2, x__2)  <- f b x
-       (b__3, xs__2) <- mapAccumLNat f b__2 xs
-       return (b__3, x__2:xs__2)
-
-getUniqueNat :: NatM Unique
-getUniqueNat = NatM $ \ (NatM_State us delta imports pic) ->
-    case splitUniqSupply us of
-         (us1,us2) -> (uniqFromSupply us1, (NatM_State us2 delta imports pic))
-
-getDeltaNat :: NatM Int
-getDeltaNat = NatM $ \ st -> (natm_delta st, st)
-
-setDeltaNat :: Int -> NatM ()
-setDeltaNat delta = NatM $ \ (NatM_State us _ imports pic) ->
-   ((), NatM_State us delta imports pic)
-
-addImportNat :: CLabel -> NatM ()
-addImportNat imp = NatM $ \ (NatM_State us delta imports pic) -> 
-   ((), NatM_State us delta (imp:imports) pic)
-
-getBlockIdNat :: NatM BlockId
-getBlockIdNat = do u <- getUniqueNat; return (BlockId u)
-
-getNewLabelNat :: NatM CLabel
-getNewLabelNat = do u <- getUniqueNat; return (mkAsmTempLabel u)
-
-getNewRegNat :: MachRep -> NatM Reg
-getNewRegNat rep = do u <- getUniqueNat; return (mkVReg u rep)
-
-getNewRegPairNat :: MachRep -> NatM (Reg,Reg)
-getNewRegPairNat rep = do 
-  u <- getUniqueNat
-  let lo = mkVReg u rep; hi = getHiVRegFromLo lo
-  return (lo,hi)
-
-getPicBaseMaybeNat :: NatM (Maybe Reg)
-getPicBaseMaybeNat = NatM (\state -> (natm_pic state, state))
-
-getPicBaseNat :: MachRep -> NatM Reg
-getPicBaseNat rep = do
-  mbPicBase <- getPicBaseMaybeNat
-  case mbPicBase of
-        Just picBase -> return picBase
-        Nothing -> do
-            reg <- getNewRegNat rep
-            NatM (\state -> (reg, state { natm_pic = Just reg }))
diff --git a/ghc/compiler/nativeGen/NOTES b/ghc/compiler/nativeGen/NOTES
deleted file mode 100644
index 9068a7fc2c..0000000000
--- a/ghc/compiler/nativeGen/NOTES
+++ /dev/null
@@ -1,41 +0,0 @@
-TODO in new NCG
-~~~~~~~~~~~~~~~
-
-- Are we being careful enough about narrowing those out-of-range CmmInts?
-
-- Register allocator:
-    - fixup code
-    - keep track of free stack slots
-
-    Optimisations:
-
-    - picking the assignment on entry to a block: better to defer this
-      until we know all the assignments.  In a loop, we should pick
-      the assignment from the looping jump (fixpointing?), so that any
-      fixup code ends up *outside* the loop.  Otherwise, we should
-      pick the assignment that results in the least fixup code.
-
-- splitting?
-
--- -----------------------------------------------------------------------------
--- x86 ToDos
-
-- x86 genCCall needs to tack on the @size for stdcalls (might not be in the
-  foreignlabel).
-
-- x86: should really clean up that IMUL64 stuff, and tell the code gen about
-  Intel imul instructions.
-
-- x86: we're not careful enough about making sure that we only use
-  byte-addressable registers in byte instructions.  Should we do it this
-  way, or stick to using 32-bit registers everywhere?
-
-- Use SSE for floating point, optionally.
-
-------------------------------------------------------------------------------
--- Further optimisations:
-
-- We might be able to extend the scope of the inlining phase so it can
-  skip over more statements that don't affect the value of the inlined
-  expr.
-
diff --git a/ghc/compiler/nativeGen/PositionIndependentCode.hs b/ghc/compiler/nativeGen/PositionIndependentCode.hs
deleted file mode 100644
index 0daccb6530..0000000000
--- a/ghc/compiler/nativeGen/PositionIndependentCode.hs
+++ /dev/null
@@ -1,605 +0,0 @@
-module PositionIndependentCode (
-        cmmMakeDynamicReference,
-        needImportedSymbols,
-        pprImportedSymbol,
-        pprGotDeclaration,
-        initializePicBase
-     ) where
-
-{-
-  This module handles generation of position independent code and
-  dynamic-linking related issues for the native code generator.
-  
-  Things outside this module which are related to this:
-  
-  + module CLabel
-    - PIC base label (pretty printed as local label 1)
-    - DynamicLinkerLabels - several kinds:
-        CodeStub, SymbolPtr, GotSymbolPtr, GotSymbolOffset
-    - labelDynamic predicate
-  + module Cmm
-    - The GlobalReg datatype has a PicBaseReg constructor
-    - The CmmLit datatype has a CmmLabelDiffOff constructor
-  + codeGen & RTS
-    - When tablesNextToCode, no absolute addresses are stored in info tables
-      any more. Instead, offsets from the info label are used.
-    - For Win32 only, SRTs might contain addresses of __imp_ symbol pointers
-      because Win32 doesn't support external references in data sections.
-      TODO: make sure this still works, it might be bitrotted
-  + NCG
-    - The cmmToCmm pass in AsmCodeGen calls cmmMakeDynamicReference for all
-      labels.
-    - nativeCodeGen calls pprImportedSymbol and pprGotDeclaration to output
-      all the necessary stuff for imported symbols.
-    - The NCG monad keeps track of a list of imported symbols.
-    - MachCodeGen invokes initializePicBase to generate code to initialize
-      the PIC base register when needed.
-    - MachCodeGen calls cmmMakeDynamicReference whenever it uses a CLabel
-      that wasn't in the original Cmm code (e.g. floating point literals).
-  + The Mangler
-    - The mangler converts absolure refs to relative refs in info tables
-    - Symbol pointers, stub code and PIC calculations that are generated
-      by GCC are left intact by the mangler (so far only on ppc-darwin
-      and ppc-linux).
--}
-     
-#include "HsVersions.h"
-#include "nativeGen/NCG.h"
-
-import Cmm
-import MachOp           ( MachOp(MO_Add), wordRep )
-import CLabel           ( CLabel, pprCLabel,
-                          mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
-                          dynamicLinkerLabelInfo, mkPicBaseLabel,
-                          labelDynamic, externallyVisibleCLabel )
-
-#if linux_TARGET_OS
-import CLabel           ( mkForeignLabel )
-#endif
-
-import MachRegs
-import MachInstrs
-import NCGMonad         ( NatM, getNewRegNat, getNewLabelNat )
-
-import StaticFlags	( opt_PIC, opt_Static )
-
-import Pretty
-import qualified Outputable
-
-import Panic            ( panic )
-
-
--- The most important function here is cmmMakeDynamicReference.
-
--- It gets called by the cmmToCmm pass for every CmmLabel in the Cmm
--- code. It does The Right Thing(tm) to convert the CmmLabel into a
--- position-independent, dynamic-linking-aware reference to the thing
--- in question.
--- Note that this also has to be called from MachCodeGen in order to
--- access static data like floating point literals (labels that were
--- created after the cmmToCmm pass).
--- The function must run in a monad that can keep track of imported symbols
--- A function for recording an imported symbol must be passed in:
--- - addImportCmmOpt for the CmmOptM monad
--- - addImportNat for the NatM monad.
-
-cmmMakeDynamicReference
-  :: Monad m => (CLabel -> m ())  -- a monad & a function
-                                  -- used for recording imported symbols
-             -> Bool              -- whether this is the target of a jump
-             -> CLabel            -- the label
-             -> m CmmExpr
-  
-cmmMakeDynamicReference addImport isJumpTarget lbl
-  | Just _ <- dynamicLinkerLabelInfo lbl
-  = return $ CmmLit $ CmmLabel lbl   -- already processed it, pass through
-  | otherwise = case howToAccessLabel isJumpTarget lbl of
-        AccessViaStub -> do
-              let stub = mkDynamicLinkerLabel CodeStub lbl
-              addImport stub
-              return $ CmmLit $ CmmLabel stub
-        AccessViaSymbolPtr -> do
-              let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl
-              addImport symbolPtr
-              return $ CmmLoad (cmmMakePicReference symbolPtr) wordRep
-        AccessDirectly
-                -- all currently supported processors support
-                -- a PC-relative branch instruction, so just jump there
-          | isJumpTarget -> return $ CmmLit $ CmmLabel lbl
-                -- for data, we might have to make some calculations:
-          | otherwise    -> return $ cmmMakePicReference lbl  
-  
--- -------------------------------------------------------------------
-  
--- Create a position independent reference to a label.
--- (but do not bother with dynamic linking).
--- We calculate the label's address by adding some (platform-dependent)
--- offset to our base register; this offset is calculated by
--- the function picRelative in the platform-dependent part below.
-
-cmmMakePicReference :: CLabel -> CmmExpr
-  
-#if !mingw32_TARGET_OS
-        -- Windows doesn't need PIC,
-        -- everything gets relocated at runtime
-
-cmmMakePicReference lbl
-    | opt_PIC && absoluteLabel lbl = CmmMachOp (MO_Add wordRep) [
-            CmmReg (CmmGlobal PicBaseReg),
-            CmmLit $ picRelative lbl
-        ]
-    where
-        absoluteLabel lbl = case dynamicLinkerLabelInfo lbl of
-                                Just (GotSymbolPtr, _) -> False
-                                Just (GotSymbolOffset, _) -> False
-                                _ -> True
-
-#endif
-cmmMakePicReference lbl = CmmLit $ CmmLabel lbl
-
--- ===================================================================
--- Platform dependent stuff
--- ===================================================================
-
--- Knowledge about how special dynamic linker labels like symbol
--- pointers, code stubs and GOT offsets look like is located in the
--- module CLabel.
-
--- -------------------------------------------------------------------
-
--- We have to decide which labels need to be accessed
--- indirectly or via a piece of stub code.
-
-data LabelAccessStyle = AccessViaStub
-                      | AccessViaSymbolPtr
-                      | AccessDirectly
-
-howToAccessLabel :: Bool -> CLabel -> LabelAccessStyle
-
-#if mingw32_TARGET_OS
--- Windows
--- 
--- We need to use access *exactly* those things that
--- are imported from a DLL via an __imp_* label.
--- There are no stubs for imported code.
-
-howToAccessLabel _ lbl | labelDynamic lbl = AccessViaSymbolPtr
-                       | otherwise        = AccessDirectly
-
-#elif darwin_TARGET_OS
--- Mach-O (Darwin, Mac OS X)
---
--- Indirect access is required in the following cases:
---  * things imported from a dynamic library
---  * things from a different module, if we're generating PIC code
--- It is always possible to access something indirectly,
--- even when it's not necessary.
-
-howToAccessLabel True lbl
-      -- jumps to a dynamic library go via a symbol stub
-    | labelDynamic lbl = AccessViaStub
-      -- when generating PIC code, all cross-module references must
-      -- must go via a symbol pointer, too.
-      -- Unfortunately, we don't know whether it's cross-module,
-      -- so we do it for all externally visible labels.
-      -- This is a slight waste of time and space, but otherwise
-      -- we'd need to pass the current Module all the way in to
-      -- this function.
-    | opt_PIC && externallyVisibleCLabel lbl = AccessViaStub
-howToAccessLabel False lbl
-      -- data access to a dynamic library goes via a symbol pointer
-    | labelDynamic lbl = AccessViaSymbolPtr
-      -- cross-module PIC references: same as above
-    | opt_PIC && externallyVisibleCLabel lbl = AccessViaSymbolPtr
-howToAccessLabel _ _ = AccessDirectly
-
-#elif linux_TARGET_OS && powerpc64_TARGET_ARCH
--- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC
-
-howToAccessLabel True lbl = AccessDirectly -- actually, .label instead of label
-howToAccessLabel _ lbl = AccessViaSymbolPtr
-
-#elif linux_TARGET_OS
--- ELF (Linux)
---
--- ELF tries to pretend to the main application code that dynamic linking does 
--- not exist. While this may sound convenient, it tends to mess things up in
--- very bad ways, so we have to be careful when we generate code for the main
--- program (-dynamic but no -fPIC).
---
--- Indirect access is required for references to imported symbols
--- from position independent code. It is also required from the main program
--- when dynamic libraries containing Haskell code are used.
-
-howToAccessLabel isJump lbl
-	-- no PIC -> the dynamic linker does everything for us;
-	--           if we don't dynamically link to Haskell code,
-	--           it actually manages to do so without messing thins up.
-    | not opt_PIC && opt_Static = AccessDirectly
-   
-#if !i386_TARGET_ARCH
--- for Intel, we temporarily disable the use of the
--- Procedure Linkage Table, because PLTs on intel require the
--- address of the GOT to be loaded into register %ebx before
--- a jump through the PLT is made.
--- TODO: make the i386 NCG ensure this before jumping to a
---       CodeStub label, so we can remove this special case.
-
-	-- As long as we're in a shared library ourselves,
-	-- we can use the plt.
-	-- NOTE: We might want to disable this, because this
-	--       prevents -fPIC code from being linked statically.
-    | isJump && labelDynamic lbl && opt_PIC = AccessViaStub
-
-    	-- TODO: it would be OK to access non-Haskell code via a stub
---  | isJump && labelDynamic lbl && not isHaskellCode lbl = AccessViaStub
-
-	-- Using code stubs for jumps from the main program to an entry
-	-- label in a dynamic library is deadly; this will cause the dynamic
-	-- linker to replace all references (even data references) to that
-	-- label by references to the stub, so we won't find our info tables
-	-- any more.
-#endif
-
-    	-- A dynamic label needs to be accessed via a symbol pointer.
-	-- NOTE: It would be OK to jump to foreign code via a PLT stub.
-    | labelDynamic lbl = AccessViaSymbolPtr
-    
-#if powerpc_TARGET_ARCH
- 	-- For PowerPC32 -fPIC, we have to access even static data
-	-- via a symbol pointer (see below for an explanation why
-	-- PowerPC32 Linux is especially broken).
-    | opt_PIC && not isJump = AccessViaSymbolPtr
-#endif
-
-    | otherwise = AccessDirectly
-
-#else
---
--- all other platforms
---
-howToAccessLabel _ _
-        | not opt_PIC = AccessDirectly
-        | otherwise   = panic "howToAccessLabel: PIC not defined for this platform"
-#endif
-
--- -------------------------------------------------------------------
-
--- What do we have to add to our 'PIC base register' in order to
--- get the address of a label?
-
-picRelative :: CLabel -> CmmLit
-#if darwin_TARGET_OS
--- Darwin:
--- The PIC base register points to the PIC base label at the beginning
--- of the current CmmTop. We just have to use a label difference to
--- get the offset.
--- We have already made sure that all labels that are not from the current
--- module are accessed indirectly ('as' can't calculate differences between
--- undefined labels).
-
-picRelative lbl
-  = CmmLabelDiffOff lbl mkPicBaseLabel 0
-
-#elif powerpc_TARGET_ARCH && linux_TARGET_OS
--- PowerPC Linux:
--- The PIC base register points to our fake GOT. Use a label difference
--- to get the offset.
--- We have made sure that *everything* is accessed indirectly, so this
--- is only used for offsets from the GOT to symbol pointers inside the
--- GOT.
-picRelative lbl
-  = CmmLabelDiffOff lbl gotLabel 0
-
-#elif linux_TARGET_OS
--- Other Linux versions:
--- The PIC base register points to the GOT. Use foo@got for symbol
--- pointers, and foo@gotoff for everything else.
-
-picRelative lbl
-  | Just (SymbolPtr, lbl') <- dynamicLinkerLabelInfo lbl
-  = CmmLabel $ mkDynamicLinkerLabel GotSymbolPtr lbl'
-  | otherwise
-  = CmmLabel $ mkDynamicLinkerLabel GotSymbolOffset lbl
-
-#else
-picRelative lbl = panic "PositionIndependentCode.picRelative"
-#endif
-
--- -------------------------------------------------------------------
-
--- What do we have to add to every assembly file we generate?
-
--- utility function for pretty-printing asm-labels,
--- copied from PprMach
-asmSDoc d = Outputable.withPprStyleDoc (
-	      Outputable.mkCodeStyle Outputable.AsmStyle) d
-pprCLabel_asm l = asmSDoc (pprCLabel l)
-
-
-#if darwin_TARGET_OS
-
-needImportedSymbols = True
-
--- We don't need to declare any offset tables.
--- However, for PIC on x86, we need a small helper function.
-#if i386_TARGET_ARCH
-pprGotDeclaration
-    | opt_PIC
-    = vcat [
-        ptext SLIT(".section __TEXT,__textcoal_nt,coalesced,no_toc"),
-        ptext SLIT(".weak_definition ___i686.get_pc_thunk.ax"),
-        ptext SLIT(".private_extern ___i686.get_pc_thunk.ax"),
-        ptext SLIT("___i686.get_pc_thunk.ax:"),
-            ptext SLIT("\tmovl (%esp), %eax"),
-            ptext SLIT("\tret")
-    ]
-    | otherwise = Pretty.empty
-#else
-pprGotDeclaration = Pretty.empty
-#endif
-
--- On Darwin, we have to generate our own stub code for lazy binding..
--- For each processor architecture, there are two versions, one for PIC
--- and one for non-PIC.
-pprImportedSymbol importedLbl
-#if powerpc_TARGET_ARCH
-    | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
-    = case opt_PIC of
-        False ->
-            vcat [
-                ptext SLIT(".symbol_stub"),
-                ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
-                    ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-                    ptext SLIT("\tlis r11,ha16(L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr)"),
-                    ptext SLIT("\tlwz r12,lo16(L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr)(r11)"),
-                    ptext SLIT("\tmtctr r12"),
-                    ptext SLIT("\taddi r11,r11,lo16(L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr)"),
-                    ptext SLIT("\tbctr")
-            ]
-        True ->
-            vcat [
-                ptext SLIT(".section __TEXT,__picsymbolstub1,")
-                  <> ptext SLIT("symbol_stubs,pure_instructions,32"),
-                ptext SLIT("\t.align 2"),
-                ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
-                    ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-                    ptext SLIT("\tmflr r0"),
-                    ptext SLIT("\tbcl 20,31,L0$") <> pprCLabel_asm lbl,
-                ptext SLIT("L0$") <> pprCLabel_asm lbl <> char ':',
-                    ptext SLIT("\tmflr r11"),
-                    ptext SLIT("\taddis r11,r11,ha16(L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr-L0$") <> pprCLabel_asm lbl <> char ')',
-                    ptext SLIT("\tmtlr r0"),
-                    ptext SLIT("\tlwzu r12,lo16(L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr-L0$") <> pprCLabel_asm lbl
-                        <> ptext SLIT(")(r11)"),
-                    ptext SLIT("\tmtctr r12"),
-                    ptext SLIT("\tbctr")
-            ]
-    $+$ vcat [
-        ptext SLIT(".lazy_symbol_pointer"),
-        ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$lazy_ptr:"),
-            ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-            ptext SLIT("\t.long dyld_stub_binding_helper")
-    ]
-#elif i386_TARGET_ARCH
-    | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
-    = case opt_PIC of
-        False ->
-            vcat [
-                ptext SLIT(".symbol_stub"),
-                ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
-                    ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-                    ptext SLIT("\tjmp *L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr"),
-                ptext SLIT("L") <> pprCLabel_asm lbl
-                    <> ptext SLIT("$stub_binder:"),
-                    ptext SLIT("\tpushl $L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr"),
-                    ptext SLIT("\tjmp dyld_stub_binding_helper")
-            ]
-        True ->
-            vcat [
-                ptext SLIT(".section __TEXT,__picsymbolstub2,")
-                    <> ptext SLIT("symbol_stubs,pure_instructions,25"),
-                ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"),
-                    ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-                    ptext SLIT("\tcall ___i686.get_pc_thunk.ax"),
-                ptext SLIT("1:"),
-                    ptext SLIT("\tmovl L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr-1b(%eax),%edx"),
-                    ptext SLIT("\tjmp %edx"),
-                ptext SLIT("L") <> pprCLabel_asm lbl
-                    <> ptext SLIT("$stub_binder:"),
-                    ptext SLIT("\tlea L") <> pprCLabel_asm lbl
-                        <> ptext SLIT("$lazy_ptr-1b(%eax),%eax"),
-                    ptext SLIT("\tpushl %eax"),
-                    ptext SLIT("\tjmp dyld_stub_binding_helper")
-            ]
-    $+$ vcat [        ptext SLIT(".section __DATA, __la_sym_ptr")
-                    <> (if opt_PIC then int 2 else int 3)
-                    <> ptext SLIT(",lazy_symbol_pointers"),
-        ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$lazy_ptr:"),
-            ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-            ptext SLIT("\t.long L") <> pprCLabel_asm lbl
-                    <> ptext SLIT("$stub_binder")
-    ]
-#endif
--- We also have to declare our symbol pointers ourselves:
-    | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
-    = vcat [
-        ptext SLIT(".non_lazy_symbol_pointer"),
-        char 'L' <> pprCLabel_asm lbl <> ptext SLIT("$non_lazy_ptr:"),
-	    ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl,
-            ptext SLIT("\t.long\t0")
-    ]
-
-    | otherwise = empty
-
-#elif linux_TARGET_OS && !powerpc64_TARGET_ARCH
-
--- ELF / Linux
---
--- In theory, we don't need to generate any stubs or symbol pointers
--- by hand for Linux.
---
--- Reality differs from this in two areas.
---
--- 1) If we just use a dynamically imported symbol directly in a read-only
---    section of the main executable (as GCC does), ld generates R_*_COPY
---    relocations, which are fundamentally incompatible with reversed info
---    tables. Therefore, we need a table of imported addresses in a writable
---    section.
---    The "official" GOT mechanism (label@got) isn't intended to be used
---    in position dependent code, so we have to create our own "fake GOT"
---    when not opt_PCI && not opt_Static.
---
--- 2) PowerPC Linux is just plain broken.
---    While it's theoretically possible to use GOT offsets larger
---    than 16 bit, the standard crt*.o files don't, which leads to
---    linker errors as soon as the GOT size exceeds 16 bit.
---    Also, the assembler doesn't support @gotoff labels.
---    In order to be able to use a larger GOT, we have to circumvent the
---    entire GOT mechanism and do it ourselves (this is also what GCC does).
-
-
--- When needImportedSymbols is defined,
--- the NCG will keep track of all DynamicLinkerLabels it uses
--- and output each of them using pprImportedSymbol.
-#if powerpc_TARGET_ARCH
-    -- PowerPC Linux: -fPIC or -dynamic
-needImportedSymbols = opt_PIC || not opt_Static
-#else
-    -- i386 (and others?): -dynamic but not -fPIC
-needImportedSymbols = not opt_Static && not opt_PIC
-#endif
-
--- gotLabel
--- The label used to refer to our "fake GOT" from
--- position-independent code.
-gotLabel = mkForeignLabel -- HACK: it's not really foreign
-                           FSLIT(".LCTOC1") Nothing False
-
--- pprGotDeclaration
--- Output whatever needs to be output once per .s file.
--- The .LCTOC1 label is defined to point 32768 bytes into the table,
--- to make the most of the PPC's 16-bit displacements.
--- Only needed for PIC.
-
-pprGotDeclaration
-    | not opt_PIC = Pretty.empty
-    | otherwise = vcat [
-        ptext SLIT(".section \".got2\",\"aw\""),
-        ptext SLIT(".LCTOC1 = .+32768")
-    ]
-
--- We generate one .long literal for every symbol we import;
--- the dynamic linker will relocate those addresses.
-
-pprImportedSymbol importedLbl
-    | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
-    = vcat [
-        ptext SLIT(".section \".got2\", \"aw\""),
-        ptext SLIT(".LC_") <> pprCLabel_asm lbl <> char ':',
-        ptext SLIT("\t.long") <+> pprCLabel_asm lbl
-    ]
-
--- PLT code stubs are generated automatically be the dynamic linker.
-    | otherwise = empty
-
-#else
-
--- For all other currently supported platforms, we don't need to do
--- anything at all.
-
-needImportedSymbols = False
-pprGotDeclaration = Pretty.empty
-pprImportedSymbol _ = empty
-#endif
-
--- -------------------------------------------------------------------
-
--- Generate code to calculate the address that should be put in the
--- PIC base register.
--- This is called by MachCodeGen for every CmmProc that accessed the
--- PIC base register. It adds the appropriate instructions to the
--- top of the CmmProc.
-
--- It is assumed that the first NatCmmTop in the input list is a Proc
--- and the rest are CmmDatas.
-
-initializePicBase :: Reg -> [NatCmmTop] -> NatM [NatCmmTop]
-
-#if darwin_TARGET_OS
-
--- Darwin is simple: just fetch the address of a local label.
--- The FETCHPC pseudo-instruction is expanded to multiple instructions
--- during pretty-printing so that we don't have to deal with the
--- local label:
-
--- PowerPC version:
---          bcl 20,31,1f.
---      1:  mflr picReg
-
--- i386 version:
---          call 1f
---      1:  popl %picReg
-
-initializePicBase picReg (CmmProc info lab params blocks : statics)
-    = return (CmmProc info lab params (b':tail blocks) : statics)
-    where BasicBlock bID insns = head blocks
-          b' = BasicBlock bID (FETCHPC picReg : insns)
-
-#elif powerpc_TARGET_ARCH && linux_TARGET_OS
-
--- Get a pointer to our own fake GOT, which is defined on a per-module basis.
--- This is exactly how GCC does it, and it's quite horrible:
--- We first fetch the address of a local label (mkPicBaseLabel).
--- Then we add a 16-bit offset to that to get the address of a .long that we
--- define in .text space right next to the proc. This .long literal contains
--- the (32-bit) offset from our local label to our global offset table
--- (.LCTOC1 aka gotOffLabel).
-initializePicBase picReg
-    (CmmProc info lab params blocks : statics)
-    = do
-        gotOffLabel <- getNewLabelNat
-        tmp <- getNewRegNat wordRep
-        let 
-            gotOffset = CmmData Text [
-                            CmmDataLabel gotOffLabel,
-			    CmmStaticLit (CmmLabelDiffOff gotLabel
-                        	                          mkPicBaseLabel
-				                          0)
-                        ]
-            offsetToOffset = ImmConstantDiff (ImmCLbl gotOffLabel)
-                                             (ImmCLbl mkPicBaseLabel)
-            BasicBlock bID insns = head blocks
-            b' = BasicBlock bID (FETCHPC picReg
-                               : LD wordRep tmp
-                                    (AddrRegImm picReg offsetToOffset)
-                               : ADD picReg picReg (RIReg tmp)
-                               : insns)
-        return (CmmProc info lab params (b' : tail blocks) : gotOffset : statics)
-#elif i386_TARGET_ARCH && linux_TARGET_OS
-
--- We cheat a bit here by defining a pseudo-instruction named FETCHGOT
--- which pretty-prints as:
---              call 1f
--- 1:           popl %picReg
---              addl __GLOBAL_OFFSET_TABLE__+.-1b, %picReg
--- (See PprMach.lhs)
-
-initializePicBase picReg (CmmProc info lab params blocks : statics)
-    = return (CmmProc info lab params (b':tail blocks) : statics)
-    where BasicBlock bID insns = head blocks
-          b' = BasicBlock bID (FETCHGOT picReg : insns)
-
-#else
-initializePicBase picReg proc = panic "initializePicBase"
-
--- mingw32_TARGET_OS: not needed, won't be called
-#endif
diff --git a/ghc/compiler/nativeGen/PprMach.hs b/ghc/compiler/nativeGen/PprMach.hs
deleted file mode 100644
index afa5bcd872..0000000000
--- a/ghc/compiler/nativeGen/PprMach.hs
+++ /dev/null
@@ -1,2454 +0,0 @@
------------------------------------------------------------------------------
---
--- Pretty-printing assembly language
---
--- (c) The University of Glasgow 1993-2005
---
------------------------------------------------------------------------------
-
--- We start with the @pprXXX@s with some cross-platform commonality
--- (e.g., 'pprReg'); we conclude with the no-commonality monster,
--- 'pprInstr'.
-
-#include "nativeGen/NCG.h"
-
-module PprMach ( 
-	pprNatCmmTop, pprBasicBlock,
-	pprInstr, pprSize, pprUserReg,
-  ) where
-
-
-#include "HsVersions.h"
-
-import Cmm
-import MachOp		( MachRep(..), wordRep, isFloatingRep )
-import MachRegs		-- may differ per-platform
-import MachInstrs
-
-import CLabel		( CLabel, pprCLabel, externallyVisibleCLabel,
-			  labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
-#if HAVE_SUBSECTIONS_VIA_SYMBOLS
-import CLabel       ( mkDeadStripPreventer )
-#endif
-
-import Panic		( panic )
-import Unique		( pprUnique )
-import Pretty
-import FastString
-import qualified Outputable
-
-import StaticFlags      ( opt_PIC, opt_Static )
-
-#if __GLASGOW_HASKELL__ >= 504
-import Data.Array.ST
-import Data.Word	( Word8 )
-#else
-import MutableArray
-#endif
-
-import MONAD_ST
-import Char		( chr, ord )
-import Maybe            ( isJust )
-
-#if powerpc_TARGET_ARCH || darwin_TARGET_OS
-import DATA_WORD(Word32)
-import DATA_BITS
-#endif
-
--- -----------------------------------------------------------------------------
--- Printing this stuff out
-
-asmSDoc d = Outputable.withPprStyleDoc (
-	      Outputable.mkCodeStyle Outputable.AsmStyle) d
-pprCLabel_asm l = asmSDoc (pprCLabel l)
-
-pprNatCmmTop :: NatCmmTop -> Doc
-pprNatCmmTop (CmmData section dats) = 
-  pprSectionHeader section $$ vcat (map pprData dats)
-
- -- special case for split markers:
-pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl
-
-pprNatCmmTop (CmmProc info lbl params blocks) = 
-  pprSectionHeader Text $$
-  (if not (null info)
-	then
-#if HAVE_SUBSECTIONS_VIA_SYMBOLS
-            pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
-                <> char ':' $$
-#endif
-            vcat (map pprData info) $$
-            pprLabel (entryLblToInfoLbl lbl)
-	else empty) $$
-  (case blocks of
-	[] -> empty
-	(BasicBlock _ instrs : rest) -> 
-		(if null info then pprLabel lbl else empty) $$
-		-- the first block doesn't get a label:
-		vcat (map pprInstr instrs) $$
-		vcat (map pprBasicBlock rest)
-  )
-#if HAVE_SUBSECTIONS_VIA_SYMBOLS
-        -- If we are using the .subsections_via_symbols directive
-        -- (available on recent versions of Darwin),
-        -- we have to make sure that there is some kind of reference
-        -- from the entry code to a label on the _top_ of of the info table,
-        -- so that the linker will not think it is unreferenced and dead-strip
-        -- it. That's why the label is called a DeadStripPreventer (_dsp).
-  $$ if not (null info)
-		    then text "\t.long "
-		      <+> pprCLabel_asm (entryLblToInfoLbl lbl)
-		      <+> char '-'
-		      <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
-		    else empty
-#endif
-
-
-pprBasicBlock :: NatBasicBlock -> Doc
-pprBasicBlock (BasicBlock (BlockId id) instrs) =
-  pprLabel (mkAsmTempLabel id) $$
-  vcat (map pprInstr instrs)
-
--- -----------------------------------------------------------------------------
--- pprReg: print a 'Reg'
-
--- For x86, the way we print a register name depends
--- on which bit of it we care about.  Yurgh.
-
-pprUserReg :: Reg -> Doc
-pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,)
-
-pprReg :: IF_ARCH_i386(MachRep ->,) IF_ARCH_x86_64(MachRep ->,) Reg -> Doc
-
-pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r
-  = case r of
-      RealReg i      -> ppr_reg_no IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) i
-      VirtualRegI  u  -> text "%vI_" <> asmSDoc (pprUnique u)
-      VirtualRegHi u  -> text "%vHi_" <> asmSDoc (pprUnique u)
-      VirtualRegF  u  -> text "%vF_" <> asmSDoc (pprUnique u)
-      VirtualRegD  u  -> text "%vD_" <> asmSDoc (pprUnique u)
-  where
-#if alpha_TARGET_ARCH
-    ppr_reg_no :: Int -> Doc
-    ppr_reg_no i = ptext
-      (case i of {
-	 0 -> SLIT("$0");    1 -> SLIT("$1");
-	 2 -> SLIT("$2");    3 -> SLIT("$3");
-	 4 -> SLIT("$4");    5 -> SLIT("$5");
-	 6 -> SLIT("$6");    7 -> SLIT("$7");
-	 8 -> SLIT("$8");    9 -> SLIT("$9");
-	10 -> SLIT("$10");  11 -> SLIT("$11");
-	12 -> SLIT("$12");  13 -> SLIT("$13");
-	14 -> SLIT("$14");  15 -> SLIT("$15");
-	16 -> SLIT("$16");  17 -> SLIT("$17");
-	18 -> SLIT("$18");  19 -> SLIT("$19");
-	20 -> SLIT("$20");  21 -> SLIT("$21");
-	22 -> SLIT("$22");  23 -> SLIT("$23");
-	24 -> SLIT("$24");  25 -> SLIT("$25");
-	26 -> SLIT("$26");  27 -> SLIT("$27");
-	28 -> SLIT("$28");  29 -> SLIT("$29");
-	30 -> SLIT("$30");  31 -> SLIT("$31");
-	32 -> SLIT("$f0");  33 -> SLIT("$f1");
-	34 -> SLIT("$f2");  35 -> SLIT("$f3");
-	36 -> SLIT("$f4");  37 -> SLIT("$f5");
-	38 -> SLIT("$f6");  39 -> SLIT("$f7");
-	40 -> SLIT("$f8");  41 -> SLIT("$f9");
-	42 -> SLIT("$f10"); 43 -> SLIT("$f11");
-	44 -> SLIT("$f12"); 45 -> SLIT("$f13");
-	46 -> SLIT("$f14"); 47 -> SLIT("$f15");
-	48 -> SLIT("$f16"); 49 -> SLIT("$f17");
-	50 -> SLIT("$f18"); 51 -> SLIT("$f19");
-	52 -> SLIT("$f20"); 53 -> SLIT("$f21");
-	54 -> SLIT("$f22"); 55 -> SLIT("$f23");
-	56 -> SLIT("$f24"); 57 -> SLIT("$f25");
-	58 -> SLIT("$f26"); 59 -> SLIT("$f27");
-	60 -> SLIT("$f28"); 61 -> SLIT("$f29");
-	62 -> SLIT("$f30"); 63 -> SLIT("$f31");
-	_  -> SLIT("very naughty alpha register")
-      })
-#endif
-#if i386_TARGET_ARCH
-    ppr_reg_no :: MachRep -> Int -> Doc
-    ppr_reg_no I8   = ppr_reg_byte
-    ppr_reg_no I16  = ppr_reg_word
-    ppr_reg_no _    = ppr_reg_long
-
-    ppr_reg_byte i = ptext
-      (case i of {
-	 0 -> SLIT("%al");     1 -> SLIT("%bl");
-	 2 -> SLIT("%cl");     3 -> SLIT("%dl");
-	_  -> SLIT("very naughty I386 byte register")
-      })
-
-    ppr_reg_word i = ptext
-      (case i of {
-	 0 -> SLIT("%ax");     1 -> SLIT("%bx");
-	 2 -> SLIT("%cx");     3 -> SLIT("%dx");
-	 4 -> SLIT("%si");     5 -> SLIT("%di");
-	 6 -> SLIT("%bp");     7 -> SLIT("%sp");
-	_  -> SLIT("very naughty I386 word register")
-      })
-
-    ppr_reg_long i = ptext
-      (case i of {
-	 0 -> SLIT("%eax");    1 -> SLIT("%ebx");
-	 2 -> SLIT("%ecx");    3 -> SLIT("%edx");
-	 4 -> SLIT("%esi");    5 -> SLIT("%edi");
-	 6 -> SLIT("%ebp");    7 -> SLIT("%esp");
-	 8 -> SLIT("%fake0");  9 -> SLIT("%fake1");
-	10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
-	12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
-	_  -> SLIT("very naughty I386 register")
-      })
-#endif
-
-#if x86_64_TARGET_ARCH
-    ppr_reg_no :: MachRep -> Int -> Doc
-    ppr_reg_no I8   = ppr_reg_byte
-    ppr_reg_no I16  = ppr_reg_word
-    ppr_reg_no I32  = ppr_reg_long
-    ppr_reg_no _    = ppr_reg_quad
-
-    ppr_reg_byte i = ptext
-      (case i of {
-	 0 -> SLIT("%al");     1 -> SLIT("%bl");
-	 2 -> SLIT("%cl");     3 -> SLIT("%dl");
-	 4 -> SLIT("%sil");    5 -> SLIT("%dil"); -- new 8-bit regs!
-	 6 -> SLIT("%bpl");    7 -> SLIT("%spl");
-	 8 -> SLIT("%r8b");    9  -> SLIT("%r9b");
-	10 -> SLIT("%r10b");   11 -> SLIT("%r11b");
-	12 -> SLIT("%r12b");   13 -> SLIT("%r13b");
-	14 -> SLIT("%r14b");   15 -> SLIT("%r15b");
-	_  -> SLIT("very naughty x86_64 byte register")
-      })
-
-    ppr_reg_word i = ptext
-      (case i of {
-	 0 -> SLIT("%ax");     1 -> SLIT("%bx");
-	 2 -> SLIT("%cx");     3 -> SLIT("%dx");
-	 4 -> SLIT("%si");     5 -> SLIT("%di");
-	 6 -> SLIT("%bp");     7 -> SLIT("%sp");
-	 8 -> SLIT("%r8w");    9  -> SLIT("%r9w");
-	10 -> SLIT("%r10w");   11 -> SLIT("%r11w");
-	12 -> SLIT("%r12w");   13 -> SLIT("%r13w");
-	14 -> SLIT("%r14w");   15 -> SLIT("%r15w");
-	_  -> SLIT("very naughty x86_64 word register")
-      })
-
-    ppr_reg_long i = ptext
-      (case i of {
-	 0 -> SLIT("%eax");    1  -> SLIT("%ebx");
-	 2 -> SLIT("%ecx");    3  -> SLIT("%edx");
-	 4 -> SLIT("%esi");    5  -> SLIT("%edi");
-	 6 -> SLIT("%ebp");    7  -> SLIT("%esp");
-	 8 -> SLIT("%r8d");    9  -> SLIT("%r9d");
-	10 -> SLIT("%r10d");   11 -> SLIT("%r11d");
-	12 -> SLIT("%r12d");   13 -> SLIT("%r13d");
-	14 -> SLIT("%r14d");   15 -> SLIT("%r15d");
-	_  -> SLIT("very naughty x86_64 register")
-      })
-
-    ppr_reg_quad i = ptext
-      (case i of {
-	 0 -> SLIT("%rax");	1 -> SLIT("%rbx");
-	 2 -> SLIT("%rcx");	3 -> SLIT("%rdx");
-	 4 -> SLIT("%rsi");	5 -> SLIT("%rdi");
-	 6 -> SLIT("%rbp");	7 -> SLIT("%rsp");
-	 8 -> SLIT("%r8");  	9 -> SLIT("%r9");
-	10 -> SLIT("%r10");    11 -> SLIT("%r11");
-	12 -> SLIT("%r12");    13 -> SLIT("%r13");
-	14 -> SLIT("%r14");    15 -> SLIT("%r15");
-	16 -> SLIT("%xmm0");   17 -> SLIT("%xmm1");
-	18 -> SLIT("%xmm2");   19 -> SLIT("%xmm3");
-	20 -> SLIT("%xmm4");   21 -> SLIT("%xmm5");
-	22 -> SLIT("%xmm6");   23 -> SLIT("%xmm7");
-	24 -> SLIT("%xmm8");   25 -> SLIT("%xmm9");
-	26 -> SLIT("%xmm10");  27 -> SLIT("%xmm11");
-	28 -> SLIT("%xmm12");  29 -> SLIT("%xmm13");
-	30 -> SLIT("%xmm14");  31 -> SLIT("%xmm15");
-	_  -> SLIT("very naughty x86_64 register")
-      })
-#endif
-
-#if sparc_TARGET_ARCH
-    ppr_reg_no :: Int -> Doc
-    ppr_reg_no i = ptext
-      (case i of {
-	 0 -> SLIT("%g0");   1 -> SLIT("%g1");
-	 2 -> SLIT("%g2");   3 -> SLIT("%g3");
-	 4 -> SLIT("%g4");   5 -> SLIT("%g5");
-	 6 -> SLIT("%g6");   7 -> SLIT("%g7");
-	 8 -> SLIT("%o0");   9 -> SLIT("%o1");
-	10 -> SLIT("%o2");  11 -> SLIT("%o3");
-	12 -> SLIT("%o4");  13 -> SLIT("%o5");
-	14 -> SLIT("%o6");  15 -> SLIT("%o7");
-	16 -> SLIT("%l0");  17 -> SLIT("%l1");
-	18 -> SLIT("%l2");  19 -> SLIT("%l3");
-	20 -> SLIT("%l4");  21 -> SLIT("%l5");
-	22 -> SLIT("%l6");  23 -> SLIT("%l7");
-	24 -> SLIT("%i0");  25 -> SLIT("%i1");
-	26 -> SLIT("%i2");  27 -> SLIT("%i3");
-	28 -> SLIT("%i4");  29 -> SLIT("%i5");
-	30 -> SLIT("%i6");  31 -> SLIT("%i7");
-	32 -> SLIT("%f0");  33 -> SLIT("%f1");
-	34 -> SLIT("%f2");  35 -> SLIT("%f3");
-	36 -> SLIT("%f4");  37 -> SLIT("%f5");
-	38 -> SLIT("%f6");  39 -> SLIT("%f7");
-	40 -> SLIT("%f8");  41 -> SLIT("%f9");
-	42 -> SLIT("%f10"); 43 -> SLIT("%f11");
-	44 -> SLIT("%f12"); 45 -> SLIT("%f13");
-	46 -> SLIT("%f14"); 47 -> SLIT("%f15");
-	48 -> SLIT("%f16"); 49 -> SLIT("%f17");
-	50 -> SLIT("%f18"); 51 -> SLIT("%f19");
-	52 -> SLIT("%f20"); 53 -> SLIT("%f21");
-	54 -> SLIT("%f22"); 55 -> SLIT("%f23");
-	56 -> SLIT("%f24"); 57 -> SLIT("%f25");
-	58 -> SLIT("%f26"); 59 -> SLIT("%f27");
-	60 -> SLIT("%f28"); 61 -> SLIT("%f29");
-	62 -> SLIT("%f30"); 63 -> SLIT("%f31");
-	_  -> SLIT("very naughty sparc register")
-      })
-#endif
-#if powerpc_TARGET_ARCH
-#if darwin_TARGET_OS
-    ppr_reg_no :: Int -> Doc
-    ppr_reg_no i = ptext
-      (case i of {
-	 0 -> SLIT("r0");   1 -> SLIT("r1");
-	 2 -> SLIT("r2");   3 -> SLIT("r3");
-	 4 -> SLIT("r4");   5 -> SLIT("r5");
-	 6 -> SLIT("r6");   7 -> SLIT("r7");
-	 8 -> SLIT("r8");   9 -> SLIT("r9");
-	10 -> SLIT("r10");  11 -> SLIT("r11");
-	12 -> SLIT("r12");  13 -> SLIT("r13");
-	14 -> SLIT("r14");  15 -> SLIT("r15");
-	16 -> SLIT("r16");  17 -> SLIT("r17");
-	18 -> SLIT("r18");  19 -> SLIT("r19");
-	20 -> SLIT("r20");  21 -> SLIT("r21");
-	22 -> SLIT("r22");  23 -> SLIT("r23");
-	24 -> SLIT("r24");  25 -> SLIT("r25");
-	26 -> SLIT("r26");  27 -> SLIT("r27");
-	28 -> SLIT("r28");  29 -> SLIT("r29");
-	30 -> SLIT("r30");  31 -> SLIT("r31");
-	32 -> SLIT("f0");  33 -> SLIT("f1");
-	34 -> SLIT("f2");  35 -> SLIT("f3");
-	36 -> SLIT("f4");  37 -> SLIT("f5");
-	38 -> SLIT("f6");  39 -> SLIT("f7");
-	40 -> SLIT("f8");  41 -> SLIT("f9");
-	42 -> SLIT("f10"); 43 -> SLIT("f11");
-	44 -> SLIT("f12"); 45 -> SLIT("f13");
-	46 -> SLIT("f14"); 47 -> SLIT("f15");
-	48 -> SLIT("f16"); 49 -> SLIT("f17");
-	50 -> SLIT("f18"); 51 -> SLIT("f19");
-	52 -> SLIT("f20"); 53 -> SLIT("f21");
-	54 -> SLIT("f22"); 55 -> SLIT("f23");
-	56 -> SLIT("f24"); 57 -> SLIT("f25");
-	58 -> SLIT("f26"); 59 -> SLIT("f27");
-	60 -> SLIT("f28"); 61 -> SLIT("f29");
-	62 -> SLIT("f30"); 63 -> SLIT("f31");
-	_  -> SLIT("very naughty powerpc register")
-      })
-#else
-    ppr_reg_no :: Int -> Doc
-    ppr_reg_no i | i <= 31 = int i	-- GPRs
-                 | i <= 63 = int (i-32) -- FPRs
-		 | otherwise = ptext SLIT("very naughty powerpc register")
-#endif
-#endif
-
-
--- -----------------------------------------------------------------------------
--- pprSize: print a 'Size'
-
-#if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
-pprSize :: MachRep -> Doc
-#else
-pprSize :: Size -> Doc
-#endif
-
-pprSize x = ptext (case x of
-#if alpha_TARGET_ARCH
-	 B  -> SLIT("b")
-	 Bu -> SLIT("bu")
---	 W  -> SLIT("w") UNUSED
---	 Wu -> SLIT("wu") UNUSED
-	 L  -> SLIT("l")
-	 Q  -> SLIT("q")
---	 FF -> SLIT("f") UNUSED
---	 DF -> SLIT("d") UNUSED
---	 GF -> SLIT("g") UNUSED
---	 SF -> SLIT("s") UNUSED
-	 TF -> SLIT("t")
-#endif
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-	I8   -> SLIT("b")
-	I16  -> SLIT("w")
-	I32  -> SLIT("l")
-	I64  -> SLIT("q")
-#endif
-#if i386_TARGET_ARCH
-	F32  -> SLIT("s")
-	F64  -> SLIT("l")
-	F80  -> SLIT("t")
-#endif
-#if x86_64_TARGET_ARCH
-	F32  -> SLIT("ss")	-- "scalar single-precision float" (SSE2)
-	F64  -> SLIT("sd")	-- "scalar double-precision float" (SSE2)
-#endif
-#if sparc_TARGET_ARCH
-	I8   -> SLIT("sb")
-        I16   -> SLIT("sh")
-	I32   -> SLIT("")
-	F32   -> SLIT("")
-	F64  -> SLIT("d")
-    )
-pprStSize :: MachRep -> Doc
-pprStSize x = ptext (case x of
-	I8   -> SLIT("b")
-	I16  -> SLIT("h")
-	I32  -> SLIT("")
-	F32  -> SLIT("")
-	F64  -> SLIT("d")
-#endif
-#if powerpc_TARGET_ARCH
-	I8   -> SLIT("b")
-        I16  -> SLIT("h")
-	I32  -> SLIT("w")
-	F32  -> SLIT("fs")
-	F64  -> SLIT("fd")
-#endif
-    )
-
--- -----------------------------------------------------------------------------
--- pprCond: print a 'Cond'
-
-pprCond :: Cond -> Doc
-
-pprCond c = ptext (case c of {
-#if alpha_TARGET_ARCH
-	EQQ  -> SLIT("eq");
-	LTT  -> SLIT("lt");
-	LE  -> SLIT("le");
-	ULT -> SLIT("ult");
-	ULE -> SLIT("ule");
-	NE  -> SLIT("ne");
-	GTT  -> SLIT("gt");
-	GE  -> SLIT("ge")
-#endif
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-	GEU	-> SLIT("ae");	LU    -> SLIT("b");
-	EQQ	-> SLIT("e");	GTT   -> SLIT("g");
-	GE	-> SLIT("ge");	GU    -> SLIT("a");
-	LTT	-> SLIT("l");	LE    -> SLIT("le");
-	LEU	-> SLIT("be");	NE    -> SLIT("ne");
-	NEG	-> SLIT("s");	POS   -> SLIT("ns");
-        CARRY   -> SLIT("c");   OFLO  -> SLIT("o");
-	PARITY  -> SLIT("p");   NOTPARITY -> SLIT("np");
-	ALWAYS	-> SLIT("mp")	-- hack
-#endif
-#if sparc_TARGET_ARCH
-	ALWAYS	-> SLIT("");	NEVER -> SLIT("n");
-	GEU	-> SLIT("geu");	LU    -> SLIT("lu");
-	EQQ	-> SLIT("e");	GTT   -> SLIT("g");
-	GE	-> SLIT("ge");	GU    -> SLIT("gu");
-	LTT	-> SLIT("l");	LE    -> SLIT("le");
-	LEU	-> SLIT("leu");	NE    -> SLIT("ne");
-	NEG	-> SLIT("neg");	POS   -> SLIT("pos");
-	VC	-> SLIT("vc");	VS    -> SLIT("vs")
-#endif
-#if powerpc_TARGET_ARCH
-	ALWAYS  -> SLIT("");
-	EQQ	-> SLIT("eq");	NE    -> SLIT("ne");
-	LTT     -> SLIT("lt");  GE    -> SLIT("ge");
-	GTT     -> SLIT("gt");  LE    -> SLIT("le");
-	LU      -> SLIT("lt");  GEU   -> SLIT("ge");
-	GU      -> SLIT("gt");  LEU   -> SLIT("le");
-#endif
-    })
-
-
--- -----------------------------------------------------------------------------
--- pprImm: print an 'Imm'
-
-pprImm :: Imm -> Doc
-
-pprImm (ImmInt i)     = int i
-pprImm (ImmInteger i) = integer i
-pprImm (ImmCLbl l)    = pprCLabel_asm l
-pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
-pprImm (ImmLit s)     = s
-
-pprImm (ImmFloat _) = ptext SLIT("naughty float immediate")
-pprImm (ImmDouble _) = ptext SLIT("naughty double immediate")
-
-pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
-#if sparc_TARGET_ARCH
--- ToDo: This should really be fixed in the PIC support, but only
--- print a for now.
-pprImm (ImmConstantDiff a b) = pprImm a 
-#else
-pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
-                            <> lparen <> pprImm b <> rparen
-#endif
-
-#if sparc_TARGET_ARCH
-pprImm (LO i)
-  = hcat [ pp_lo, pprImm i, rparen ]
-  where
-    pp_lo = text "%lo("
-
-pprImm (HI i)
-  = hcat [ pp_hi, pprImm i, rparen ]
-  where
-    pp_hi = text "%hi("
-#endif
-#if powerpc_TARGET_ARCH
-#if darwin_TARGET_OS
-pprImm (LO i)
-  = hcat [ pp_lo, pprImm i, rparen ]
-  where
-    pp_lo = text "lo16("
-
-pprImm (HI i)
-  = hcat [ pp_hi, pprImm i, rparen ]
-  where
-    pp_hi = text "hi16("
-
-pprImm (HA i)
-  = hcat [ pp_ha, pprImm i, rparen ]
-  where
-    pp_ha = text "ha16("
-    
-#else
-pprImm (LO i)
-  = pprImm i <> text "@l"
-
-pprImm (HI i)
-  = pprImm i <> text "@h"
-
-pprImm (HA i)
-  = pprImm i <> text "@ha"
-#endif
-#endif
-
-
--- -----------------------------------------------------------------------------
--- @pprAddr: print an 'AddrMode'
-
-pprAddr :: AddrMode -> Doc
-
-#if alpha_TARGET_ARCH
-pprAddr (AddrReg r) = parens (pprReg r)
-pprAddr (AddrImm i) = pprImm i
-pprAddr (AddrRegImm r1 i)
-  = (<>) (pprImm i) (parens (pprReg r1))
-#endif
-
--------------------
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-pprAddr (ImmAddr imm off)
-  = let	pp_imm = pprImm imm
-    in
-    if (off == 0) then
-	pp_imm
-    else if (off < 0) then
-	pp_imm <> int off
-    else
-	pp_imm <> char '+' <> int off
-
-pprAddr (AddrBaseIndex base index displacement)
-  = let
-	pp_disp  = ppr_disp displacement
-	pp_off p = pp_disp <> char '(' <> p <> char ')'
-	pp_reg r = pprReg wordRep r
-    in
-    case (base,index) of
-      (EABaseNone,  EAIndexNone) -> pp_disp
-      (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
-      (EABaseRip,   EAIndexNone) -> pp_off (ptext SLIT("%rip"))
-      (EABaseNone,  EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
-      (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r 
-                                       <> comma <> int i)
-  where
-    ppr_disp (ImmInt 0) = empty
-    ppr_disp imm        = pprImm imm
-#endif
-
--------------------
-
-#if sparc_TARGET_ARCH
-pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
-
-pprAddr (AddrRegReg r1 r2)
-  = hcat [ pprReg r1, char '+', pprReg r2 ]
-
-pprAddr (AddrRegImm r1 (ImmInt i))
-  | i == 0 = pprReg r1
-  | not (fits13Bits i) = largeOffsetError i
-  | otherwise = hcat [ pprReg r1, pp_sign, int i ]
-  where
-    pp_sign = if i > 0 then char '+' else empty
-
-pprAddr (AddrRegImm r1 (ImmInteger i))
-  | i == 0 = pprReg r1
-  | not (fits13Bits i) = largeOffsetError i
-  | otherwise  = hcat [ pprReg r1, pp_sign, integer i ]
-  where
-    pp_sign = if i > 0 then char '+' else empty
-
-pprAddr (AddrRegImm r1 imm)
-  = hcat [ pprReg r1, char '+', pprImm imm ]
-#endif
-
--------------------
-
-#if powerpc_TARGET_ARCH
-pprAddr (AddrRegReg r1 r2)
-  = pprReg r1 <+> ptext SLIT(", ") <+> pprReg r2
-
-pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
-pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
-pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
-#endif
-
-
--- -----------------------------------------------------------------------------
--- pprData: print a 'CmmStatic'
-
-pprSectionHeader Text
-    = ptext
-	IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
-       ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
-       ,IF_ARCH_i386(IF_OS_darwin(SLIT(".text\n\t.align 2"),
-                                  SLIT(".text\n\t.align 4,0x90"))
-                                  {-needs per-OS variation!-}
-       ,IF_ARCH_x86_64(SLIT(".text\n\t.align 8") {-needs per-OS variation!-}
-       ,IF_ARCH_powerpc(SLIT(".text\n.align 2")
-       ,)))))
-pprSectionHeader Data
-    = ptext
-	 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
-	,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
-	,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
-                                   SLIT(".data\n\t.align 4"))
-	,IF_ARCH_x86_64(SLIT(".data\n\t.align 8")
-        ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
-	,)))))
-pprSectionHeader ReadOnlyData
-    = ptext
-	 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
-	,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
-	,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 2"),
-                                   SLIT(".section .rodata\n\t.align 4"))
-	,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
-        ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
-                                      SLIT(".section .rodata\n\t.align 2"))
-	,)))))
-pprSectionHeader RelocatableReadOnlyData
-    = ptext
-	 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
-	,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
-	,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n.align 2"),
-                                   SLIT(".section .rodata\n\t.align 4"))
-	,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
-        ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
-                                      SLIT(".data\n\t.align 2"))
-	,)))))
-pprSectionHeader UninitialisedData
-    = ptext
-	 IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
-	,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
-	,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n\t.align 2"),
-                                   SLIT(".section .bss\n\t.align 4"))
-	,IF_ARCH_x86_64(SLIT(".section .bss\n\t.align 8")
-        ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
-                                      SLIT(".section .bss\n\t.align 2"))
-	,)))))
-pprSectionHeader ReadOnlyData16
-    = ptext
-	 IF_ARCH_alpha(SLIT("\t.data\n\t.align 4")
-	,IF_ARCH_sparc(SLIT(".data\n\t.align 16")
-	,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 4"),
-                                   SLIT(".section .rodata\n\t.align 16"))
-	,IF_ARCH_x86_64(SLIT(".section .rodata.cst16\n\t.align 16")
-        ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 4"),
-                                      SLIT(".section .rodata\n\t.align 4"))
-	,)))))
-
-pprSectionHeader (OtherSection sec)
-    = panic "PprMach.pprSectionHeader: unknown section"
-
-pprData :: CmmStatic -> Doc
-pprData (CmmAlign bytes)         = pprAlign bytes
-pprData (CmmDataLabel lbl)       = pprLabel lbl
-pprData (CmmString str)          = pprASCII str
-pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes
-pprData (CmmStaticLit lit)       = pprDataItem lit
-
-pprGloblDecl :: CLabel -> Doc
-pprGloblDecl lbl
-  | not (externallyVisibleCLabel lbl) = empty
-  | otherwise = ptext IF_ARCH_sparc(SLIT(".global "), 
-				    SLIT(".globl ")) <>
-		pprCLabel_asm lbl
-
-pprLabel :: CLabel -> Doc
-pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':')
-
-
-pprASCII str
-  = vcat (map do1 str) $$ do1 0
-    where
-       do1 :: Word8 -> Doc
-       do1 w = ptext SLIT("\t.byte\t") <> int (fromIntegral w)
-
-pprAlign bytes =
-	IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
-	IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
-	IF_ARCH_x86_64(ptext SLIT(".align ") <> int bytes,
-	IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
-	IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
-  where
-	pow2 = log2 bytes
-	
-	log2 :: Int -> Int  -- cache the common ones
-	log2 1 = 0 
-	log2 2 = 1
-	log2 4 = 2
-	log2 8 = 3
-	log2 n = 1 + log2 (n `quot` 2)
-
-
-pprDataItem :: CmmLit -> Doc
-pprDataItem lit
-  = vcat (ppr_item (cmmLitRep lit) lit)
-    where
-	imm = litToImm lit
-
-	-- These seem to be common:
-	ppr_item I8   x = [ptext SLIT("\t.byte\t") <> pprImm imm]
-	ppr_item I32  x = [ptext SLIT("\t.long\t") <> pprImm imm]
-	ppr_item F32  (CmmFloat r _)
-           = let bs = floatToBytes (fromRational r)
-             in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
-    	ppr_item F64 (CmmFloat r _)
-           = let bs = doubleToBytes (fromRational r)
-             in  map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
-
-#if sparc_TARGET_ARCH
-        -- copy n paste of x86 version
-	ppr_item I16  x = [ptext SLIT("\t.short\t") <> pprImm imm]
-	ppr_item I64  x = [ptext SLIT("\t.quad\t") <> pprImm imm]
-#endif
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-	ppr_item I16  x = [ptext SLIT("\t.word\t") <> pprImm imm]
-#endif
-#if i386_TARGET_ARCH && darwin_TARGET_OS
-        ppr_item I64 (CmmInt x _)  =
-                [ptext SLIT("\t.long\t")
-                    <> int (fromIntegral (fromIntegral x :: Word32)),
-                 ptext SLIT("\t.long\t")
-                    <> int (fromIntegral
-                        (fromIntegral (x `shiftR` 32) :: Word32))]
-#endif
-#if i386_TARGET_ARCH
-	ppr_item I64  x = [ptext SLIT("\t.quad\t") <> pprImm imm]
-#endif
-#if x86_64_TARGET_ARCH
-	-- x86_64: binutils can't handle the R_X86_64_PC64 relocation
-	-- type, which means we can't do pc-relative 64-bit addresses.
-	-- Fortunately we're assuming the small memory model, in which
-	-- all such offsets will fit into 32 bits, so we have to stick
-	-- to 32-bit offset fields and modify the RTS appropriately
-	-- (see InfoTables.h).
-	-- 
-	ppr_item I64  x 
-	   | isRelativeReloc x =
-		[ptext SLIT("\t.long\t") <> pprImm imm,
-		 ptext SLIT("\t.long\t0")]
-	   | otherwise =
-		[ptext SLIT("\t.quad\t") <> pprImm imm]
-	   where
-		isRelativeReloc (CmmLabelOff _ _)       = True
-		isRelativeReloc (CmmLabelDiffOff _ _ _) = True
-		isRelativeReloc _ = False
-#endif
-#if powerpc_TARGET_ARCH
-	ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
-        ppr_item I64 (CmmInt x _)  =
-                [ptext SLIT("\t.long\t")
-                    <> int (fromIntegral 
-                        (fromIntegral (x `shiftR` 32) :: Word32)),
-                 ptext SLIT("\t.long\t")
-                    <> int (fromIntegral (fromIntegral x :: Word32))]
-#endif
-
--- fall through to rest of (machine-specific) pprInstr...
-
--- -----------------------------------------------------------------------------
--- pprInstr: print an 'Instr'
-
-pprInstr :: Instr -> Doc
-
---pprInstr (COMMENT s) = empty -- nuke 'em
-pprInstr (COMMENT s)
-   =  IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
-     ,IF_ARCH_sparc( ((<>) (ptext SLIT("! "))   (ftext s))
-     ,IF_ARCH_i386( ((<>) (ptext SLIT("# "))   (ftext s))
-     ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# "))   (ftext s))
-     ,IF_ARCH_powerpc( IF_OS_linux(
-        ((<>) (ptext SLIT("# ")) (ftext s)),
-        ((<>) (ptext SLIT("; ")) (ftext s)))
-     ,)))))
-
-pprInstr (DELTA d)
-   = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
-
-pprInstr (NEWBLOCK _)
-   = panic "PprMach.pprInstr: NEWBLOCK"
-
-pprInstr (LDATA _ _)
-   = panic "PprMach.pprInstr: LDATA"
-
--- -----------------------------------------------------------------------------
--- pprInstr for an Alpha
-
-#if alpha_TARGET_ARCH
-
-pprInstr (LD size reg addr)
-  = hcat [
-	ptext SLIT("\tld"),
-	pprSize size,
-	char '\t',
-	pprReg reg,
-	comma,
-	pprAddr addr
-    ]
-
-pprInstr (LDA reg addr)
-  = hcat [
-	ptext SLIT("\tlda\t"),
-	pprReg reg,
-	comma,
-	pprAddr addr
-    ]
-
-pprInstr (LDAH reg addr)
-  = hcat [
-	ptext SLIT("\tldah\t"),
-	pprReg reg,
-	comma,
-	pprAddr addr
-    ]
-
-pprInstr (LDGP reg addr)
-  = hcat [
-	ptext SLIT("\tldgp\t"),
-	pprReg reg,
-	comma,
-	pprAddr addr
-    ]
-
-pprInstr (LDI size reg imm)
-  = hcat [
-	ptext SLIT("\tldi"),
-	pprSize size,
-	char '\t',
-	pprReg reg,
-	comma,
-	pprImm imm
-    ]
-
-pprInstr (ST size reg addr)
-  = hcat [
-	ptext SLIT("\tst"),
-	pprSize size,
-	char '\t',
-	pprReg reg,
-	comma,
-	pprAddr addr
-    ]
-
-pprInstr (CLR reg)
-  = hcat [
-	ptext SLIT("\tclr\t"),
-	pprReg reg
-    ]
-
-pprInstr (ABS size ri reg)
-  = hcat [
-	ptext SLIT("\tabs"),
-	pprSize size,
-	char '\t',
-	pprRI ri,
-	comma,
-	pprReg reg
-    ]
-
-pprInstr (NEG size ov ri reg)
-  = hcat [
-	ptext SLIT("\tneg"),
-	pprSize size,
-	if ov then ptext SLIT("v\t") else char '\t',
-	pprRI ri,
-	comma,
-	pprReg reg
-    ]
-
-pprInstr (ADD size ov reg1 ri reg2)
-  = hcat [
-	ptext SLIT("\tadd"),
-	pprSize size,
-	if ov then ptext SLIT("v\t") else char '\t',
-	pprReg reg1,
-	comma,
-	pprRI ri,
-	comma,
-	pprReg reg2
-    ]
-
-pprInstr (SADD size scale reg1 ri reg2)
-  = hcat [
-	ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
-	ptext SLIT("add"),
-	pprSize size,
-	char '\t',
-	pprReg reg1,
-	comma,
-	pprRI ri,
-	comma,
-	pprReg reg2
-    ]
-
-pprInstr (SUB size ov reg1 ri reg2)
-  = hcat [
-	ptext SLIT("\tsub"),
-	pprSize size,
-	if ov then ptext SLIT("v\t") else char '\t',
-	pprReg reg1,
-	comma,
-	pprRI ri,
-	comma,
-	pprReg reg2
-    ]
-
-pprInstr (SSUB size scale reg1 ri reg2)
-  = hcat [
-	ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
-	ptext SLIT("sub"),
-	pprSize size,
-	char '\t',
-	pprReg reg1,
-	comma,
-	pprRI ri,
-	comma,
-	pprReg reg2
-    ]
-
-pprInstr (MUL size ov reg1 ri reg2)
-  = hcat [
-	ptext SLIT("\tmul"),
-	pprSize size,
-	if ov then ptext SLIT("v\t") else char '\t',
-	pprReg reg1,
-	comma,
-	pprRI ri,
-	comma,
-	pprReg reg2
-    ]
-
-pprInstr (DIV size uns reg1 ri reg2)
-  = hcat [
-	ptext SLIT("\tdiv"),
-	pprSize size,
-	if uns then ptext SLIT("u\t") else char '\t',
-	pprReg reg1,
-	comma,
-	pprRI ri,
-	comma,
-	pprReg reg2
-    ]
-
-pprInstr (REM size uns reg1 ri reg2)
-  = hcat [
-	ptext SLIT("\trem"),
-	pprSize size,
-	if uns then ptext SLIT("u\t") else char '\t',
-	pprReg reg1,
-	comma,
-	pprRI ri,
-	comma,
-	pprReg reg2
-    ]
-
-pprInstr (NOT ri reg)
-  = hcat [
-	ptext SLIT("\tnot"),
-	char '\t',
-	pprRI ri,
-	comma,
-	pprReg reg
-    ]
-
-pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
-pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
-pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
-pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
-pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
-pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
-
-pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
-pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
-pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
-
-pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
-pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
-
-pprInstr (NOP) = ptext SLIT("\tnop")
-
-pprInstr (CMP cond reg1 ri reg2)
-  = hcat [
-	ptext SLIT("\tcmp"),
-	pprCond cond,
-	char '\t',
-	pprReg reg1,
-	comma,
-	pprRI ri,
-	comma,
-	pprReg reg2
-    ]
-
-pprInstr (FCLR reg)
-  = hcat [
-	ptext SLIT("\tfclr\t"),
-	pprReg reg
-    ]
-
-pprInstr (FABS reg1 reg2)
-  = hcat [
-	ptext SLIT("\tfabs\t"),
-	pprReg reg1,
-	comma,
-	pprReg reg2
-    ]
-
-pprInstr (FNEG size reg1 reg2)
-  = hcat [
-	ptext SLIT("\tneg"),
-	pprSize size,
-	char '\t',
-	pprReg reg1,
-	comma,
-	pprReg reg2
-    ]
-
-pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
-pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
-pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
-pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
-
-pprInstr (CVTxy size1 size2 reg1 reg2)
-  = hcat [
-	ptext SLIT("\tcvt"),
-	pprSize size1,
-	case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
-	char '\t',
-	pprReg reg1,
-	comma,
-	pprReg reg2
-    ]
-
-pprInstr (FCMP size cond reg1 reg2 reg3)
-  = hcat [
-	ptext SLIT("\tcmp"),
-	pprSize size,
-	pprCond cond,
-	char '\t',
-	pprReg reg1,
-	comma,
-	pprReg reg2,
-	comma,
-	pprReg reg3
-    ]
-
-pprInstr (FMOV reg1 reg2)
-  = hcat [
-	ptext SLIT("\tfmov\t"),
-	pprReg reg1,
-	comma,
-	pprReg reg2
-    ]
-
-pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
-
-pprInstr (BI NEVER reg lab) = empty
-
-pprInstr (BI cond reg lab)
-  = hcat [
-	ptext SLIT("\tb"),
-	pprCond cond,
-	char '\t',
-	pprReg reg,
-	comma,
-	pprImm lab
-    ]
-
-pprInstr (BF cond reg lab)
-  = hcat [
-	ptext SLIT("\tfb"),
-	pprCond cond,
-	char '\t',
-	pprReg reg,
-	comma,
-	pprImm lab
-    ]
-
-pprInstr (BR lab)
-  = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
-
-pprInstr (JMP reg addr hint)
-  = hcat [
-	ptext SLIT("\tjmp\t"),
-	pprReg reg,
-	comma,
-	pprAddr addr,
-	comma,
-	int hint
-    ]
-
-pprInstr (BSR imm n)
-  = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
-
-pprInstr (JSR reg addr n)
-  = hcat [
-	ptext SLIT("\tjsr\t"),
-	pprReg reg,
-	comma,
-	pprAddr addr
-    ]
-
-pprInstr (FUNBEGIN clab)
-  = hcat [
-	if (externallyVisibleCLabel clab) then
-	    hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
-	else
-	    empty,
-	ptext SLIT("\t.ent "),
-	pp_lab,
-	char '\n',
-	pp_lab,
-	pp_ldgp,
-	pp_lab,
-	pp_frame
-    ]
-    where
-	pp_lab = pprCLabel_asm clab
-
-        -- NEVER use commas within those string literals, cpp will ruin your day
-	pp_ldgp  = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
-	pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
-                          ptext SLIT("4240"), char ',',
-                          ptext SLIT("$26"), char ',',
-                          ptext SLIT("0\n\t.prologue 1") ]
-
-pprInstr (FUNEND clab)
-  = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
-\end{code}
-
-Continue with Alpha-only printing bits and bobs:
-\begin{code}
-pprRI :: RI -> Doc
-
-pprRI (RIReg r) = pprReg r
-pprRI (RIImm r) = pprImm r
-
-pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
-pprRegRIReg name reg1 ri reg2
-  = hcat [
- 	char '\t',
-	ptext name,
-	char '\t',
-	pprReg reg1,
-	comma,
-	pprRI ri,
-	comma,
-	pprReg reg2
-    ]
-
-pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
-pprSizeRegRegReg name size reg1 reg2 reg3
-  = hcat [
-	char '\t',
-	ptext name,
-	pprSize size,
-	char '\t',
-	pprReg reg1,
-	comma,
-	pprReg reg2,
-	comma,
-	pprReg reg3
-    ]
-
-#endif /* alpha_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- pprInstr for an x86
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
-pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
-  | src == dst
-  =
-#if 0 /* #ifdef DEBUG */
-    (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
-#else
-    empty
-#endif
-
-pprInstr (MOV size src dst)
-  = pprSizeOpOp SLIT("mov") size src dst
-
-pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
-	-- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
-	-- movl.  But we represent it as a MOVZxL instruction, because
-	-- the reg alloc would tend to throw away a plain reg-to-reg
-	-- move, and we still want it to do that.
-
-pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
-	-- zero-extension only needs to extend to 32 bits: on x86_64, 
-	-- the remaining zero-extension to 64 bits is automatic, and the 32-bit
-	-- instruction is shorter.
-
-pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
-
--- here we do some patching, since the physical registers are only set late
--- in the code generation.
-pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
-  | reg1 == reg3
-  = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
-pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
-  | reg2 == reg3
-  = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
-pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
-  | reg1 == reg3
-  = pprInstr (ADD size (OpImm displ) dst)
-pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
-
-pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
-  = pprSizeOp SLIT("dec") size dst
-pprInstr (ADD size (OpImm (ImmInt 1)) dst)
-  = pprSizeOp SLIT("inc") size dst
-pprInstr (ADD size src dst)
-  = pprSizeOpOp SLIT("add") size src dst
-pprInstr (ADC size src dst)
-  = pprSizeOpOp SLIT("adc") size src dst
-pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
-pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
-
-{- A hack.  The Intel documentation says that "The two and three
-   operand forms [of IMUL] may also be used with unsigned operands
-   because the lower half of the product is the same regardless if
-   (sic) the operands are signed or unsigned.  The CF and OF flags,
-   however, cannot be used to determine if the upper half of the
-   result is non-zero."  So there.  
--} 
-pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
-pprInstr (OR  size src dst) = pprSizeOpOp SLIT("or")  size src dst
-
-pprInstr (XOR F32 src dst)  = pprOpOp SLIT("xorps") F32 src dst
-pprInstr (XOR F64 src dst)  = pprOpOp SLIT("xorpd") F64 src dst
-pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor")  size src dst
-
-pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
-pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
-
-pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
-pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
-pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
-
-pprInstr (BT  size imm src) = pprSizeImmOp SLIT("bt") size imm src
-
-pprInstr (CMP size src dst) 
-  | isFloatingRep size =  pprSizeOpOp SLIT("ucomi")  size src dst -- SSE2
-  | otherwise          =  pprSizeOpOp SLIT("cmp")  size src dst
-
-pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test")  size src dst
-pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
-pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
-
--- both unused (SDM):
--- pprInstr PUSHA = ptext SLIT("\tpushal")
--- pprInstr POPA = ptext SLIT("\tpopal")
-
-pprInstr NOP = ptext SLIT("\tnop")
-pprInstr (CLTD I32) = ptext SLIT("\tcltd")
-pprInstr (CLTD I64) = ptext SLIT("\tcqto")
-
-pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
-
-pprInstr (JXX cond (BlockId id)) 
-  = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
-  where lab = mkAsmTempLabel id
-
-pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
-pprInstr (JMP op)          = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
-pprInstr (JMP_TBL op ids)  = pprInstr (JMP op)
-pprInstr (CALL (Left imm) _)    = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
-pprInstr (CALL (Right reg) _)   = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
-
-pprInstr (IDIV sz op)	= pprSizeOp SLIT("idiv") sz op
-pprInstr (DIV sz op)    = pprSizeOp SLIT("div")  sz op
-pprInstr (IMUL2 sz op)  = pprSizeOp SLIT("imul") sz op
-
-#if x86_64_TARGET_ARCH
-pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
-
-pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
-
-pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
-pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
-pprInstr (CVTSS2SI from to) = pprOpReg  SLIT("cvtss2si") from to
-pprInstr (CVTSD2SI from to) = pprOpReg  SLIT("cvtsd2si") from to
-pprInstr (CVTSI2SS from to) = pprOpReg  SLIT("cvtsi2ss") from to
-pprInstr (CVTSI2SD from to) = pprOpReg  SLIT("cvtsi2sd") from to
-#endif
-
-    -- FETCHGOT for PIC on ELF platforms
-pprInstr (FETCHGOT reg)
-   = vcat [ ptext SLIT("\tcall 1f"),
-            hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
-            hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
-                   pprReg I32 reg ]
-          ]
-
-    -- FETCHPC for PIC on Darwin/x86
-    -- get the instruction pointer into a register
-    -- (Terminology note: the IP is called Program Counter on PPC,
-    --  and it's a good thing to use the same name on both platforms)
-pprInstr (FETCHPC reg)
-   = vcat [ ptext SLIT("\tcall 1f"),
-            hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
-          ]
-
-
-
-#endif
-
--- -----------------------------------------------------------------------------
--- i386 floating-point
-
-#if i386_TARGET_ARCH
--- Simulating a flat register set on the x86 FP stack is tricky.
--- you have to free %st(7) before pushing anything on the FP reg stack
--- so as to preclude the possibility of a FP stack overflow exception.
-pprInstr g@(GMOV src dst)
-   | src == dst
-   = empty
-   | otherwise 
-   = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
-
--- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
-pprInstr g@(GLD sz addr dst)
- = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp, 
-                 pprAddr addr, gsemi, gpop dst 1])
-
--- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
-pprInstr g@(GST sz src addr)
- = pprG g (hcat [gtab, gpush src 0, gsemi, 
-                 text "fstp", pprSize sz, gsp, pprAddr addr])
-
-pprInstr g@(GLDZ dst)
- = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
-pprInstr g@(GLD1 dst)
- = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
-
-pprInstr g@(GFTOI src dst) 
-   = pprInstr (GDTOI src dst)
-pprInstr g@(GDTOI src dst) 
-   = pprG g (hcat [gtab, text "subl $4, %esp ; ", 
-                   gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ", 
-                   pprReg I32 dst])
-
-pprInstr g@(GITOF src dst) 
-   = pprInstr (GITOD src dst)
-pprInstr g@(GITOD src dst) 
-   = pprG g (hcat [gtab, text "pushl ", pprReg I32 src, 
-                   text " ; ffree %st(7); fildl (%esp) ; ",
-                   gpop dst 1, text " ; addl $4,%esp"])
-
-{- Gruesome swamp follows.  If you're unfortunate enough to have ventured
-   this far into the jungle AND you give a Rat's Ass (tm) what's going
-   on, here's the deal.  Generate code to do a floating point comparison
-   of src1 and src2, of kind cond, and set the Zero flag if true.
-
-   The complications are to do with handling NaNs correctly.  We want the
-   property that if either argument is NaN, then the result of the
-   comparison is False ... except if we're comparing for inequality,
-   in which case the answer is True.
-
-   Here's how the general (non-inequality) case works.  As an
-   example, consider generating the an equality test:
-
-     pushl %eax		-- we need to mess with this
-     <get src1 to top of FPU stack>
-     fcomp <src2 location in FPU stack> and pop pushed src1
-		-- Result of comparison is in FPU Status Register bits
-		-- C3 C2 and C0
-     fstsw %ax	-- Move FPU Status Reg to %ax
-     sahf	-- move C3 C2 C0 from %ax to integer flag reg
-     -- now the serious magic begins
-     setpo %ah	   -- %ah = if comparable(neither arg was NaN) then 1 else 0
-     sete  %al     -- %al = if arg1 == arg2 then 1 else 0
-     andb %ah,%al  -- %al &= %ah
-                   -- so %al == 1 iff (comparable && same); else it holds 0
-     decb %al	   -- %al == 0, ZeroFlag=1  iff (comparable && same); 
-                      else %al == 0xFF, ZeroFlag=0
-     -- the zero flag is now set as we desire.
-     popl %eax
-
-   The special case of inequality differs thusly:
-
-     setpe %ah     -- %ah = if incomparable(either arg was NaN) then 1 else 0
-     setne %al     -- %al = if arg1 /= arg2 then 1 else 0
-     orb %ah,%al   -- %al = if (incomparable || different) then 1 else 0
-     decb %al      -- if (incomparable || different) then (%al == 0, ZF=1)
-                                                     else (%al == 0xFF, ZF=0)
--}
-pprInstr g@(GCMP cond src1 src2) 
-   | case cond of { NE -> True; other -> False }
-   = pprG g (vcat [
-        hcat [gtab, text "pushl %eax ; ",gpush src1 0],
-        hcat [gtab, text "fcomp ", greg src2 1, 
-                    text "; fstsw %ax ; sahf ;  setpe %ah"],
-        hcat [gtab, text "setne %al ;  ",
-              text "orb %ah,%al ;  decb %al ;  popl %eax"]
-    ])
-   | otherwise
-   = pprG g (vcat [
-        hcat [gtab, text "pushl %eax ; ",gpush src1 0],
-        hcat [gtab, text "fcomp ", greg src2 1, 
-                    text "; fstsw %ax ; sahf ;  setpo %ah"],
-        hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ;  ",
-              text "andb %ah,%al ;  decb %al ;  popl %eax"]
-    ])
-    where
-        {- On the 486, the flags set by FP compare are the unsigned ones!
-           (This looks like a HACK to me.  WDP 96/03)
-        -}
-        fix_FP_cond :: Cond -> Cond
-        fix_FP_cond GE   = GEU
-        fix_FP_cond GTT  = GU
-        fix_FP_cond LTT  = LU
-        fix_FP_cond LE   = LEU
-        fix_FP_cond EQQ  = EQQ
-        fix_FP_cond NE   = NE
-        -- there should be no others
-
-
-pprInstr g@(GABS sz src dst)
-   = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
-pprInstr g@(GNEG sz src dst)
-   = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
-
-pprInstr g@(GSQRT sz src dst)
-   = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$ 
-             hcat [gtab, gcoerceto sz, gpop dst 1])
-pprInstr g@(GSIN sz src dst)
-   = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$ 
-             hcat [gtab, gcoerceto sz, gpop dst 1])
-pprInstr g@(GCOS sz src dst)
-   = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$ 
-             hcat [gtab, gcoerceto sz, gpop dst 1])
-pprInstr g@(GTAN sz src dst)
-   = pprG g (hcat [gtab, text "ffree %st(6) ; ",
-                   gpush src 0, text " ; fptan ; ", 
-                   text " fstp %st(0)"] $$
-             hcat [gtab, gcoerceto sz, gpop dst 1])
-
--- In the translations for GADD, GMUL, GSUB and GDIV,
--- the first two cases are mere optimisations.  The otherwise clause
--- generates correct code under all circumstances.
-
-pprInstr g@(GADD sz src1 src2 dst)
-   | src1 == dst
-   = pprG g (text "\t#GADD-xxxcase1" $$ 
-             hcat [gtab, gpush src2 0,
-                   text " ; faddp %st(0),", greg src1 1])
-   | src2 == dst
-   = pprG g (text "\t#GADD-xxxcase2" $$ 
-             hcat [gtab, gpush src1 0,
-                   text " ; faddp %st(0),", greg src2 1])
-   | otherwise
-   = pprG g (hcat [gtab, gpush src1 0, 
-                   text " ; fadd ", greg src2 1, text ",%st(0)",
-                   gsemi, gpop dst 1])
-
-
-pprInstr g@(GMUL sz src1 src2 dst)
-   | src1 == dst
-   = pprG g (text "\t#GMUL-xxxcase1" $$ 
-             hcat [gtab, gpush src2 0,
-                   text " ; fmulp %st(0),", greg src1 1])
-   | src2 == dst
-   = pprG g (text "\t#GMUL-xxxcase2" $$ 
-             hcat [gtab, gpush src1 0,
-                   text " ; fmulp %st(0),", greg src2 1])
-   | otherwise
-   = pprG g (hcat [gtab, gpush src1 0, 
-                   text " ; fmul ", greg src2 1, text ",%st(0)",
-                   gsemi, gpop dst 1])
-
-
-pprInstr g@(GSUB sz src1 src2 dst)
-   | src1 == dst
-   = pprG g (text "\t#GSUB-xxxcase1" $$ 
-             hcat [gtab, gpush src2 0,
-                   text " ; fsubrp %st(0),", greg src1 1])
-   | src2 == dst
-   = pprG g (text "\t#GSUB-xxxcase2" $$ 
-             hcat [gtab, gpush src1 0,
-                   text " ; fsubp %st(0),", greg src2 1])
-   | otherwise
-   = pprG g (hcat [gtab, gpush src1 0, 
-                   text " ; fsub ", greg src2 1, text ",%st(0)",
-                   gsemi, gpop dst 1])
-
-
-pprInstr g@(GDIV sz src1 src2 dst)
-   | src1 == dst
-   = pprG g (text "\t#GDIV-xxxcase1" $$ 
-             hcat [gtab, gpush src2 0,
-                   text " ; fdivrp %st(0),", greg src1 1])
-   | src2 == dst
-   = pprG g (text "\t#GDIV-xxxcase2" $$ 
-             hcat [gtab, gpush src1 0,
-                   text " ; fdivp %st(0),", greg src2 1])
-   | otherwise
-   = pprG g (hcat [gtab, gpush src1 0, 
-                   text " ; fdiv ", greg src2 1, text ",%st(0)",
-                   gsemi, gpop dst 1])
-
-
-pprInstr GFREE 
-   = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
-            ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)") 
-          ]
-
---------------------------
-
--- coerce %st(0) to the specified size
-gcoerceto F64 = empty
-gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
-
-gpush reg offset
-   = hcat [text "ffree %st(7) ; fld ", greg reg offset]
-gpop reg offset
-   = hcat [text "fstp ", greg reg offset]
-
-greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
-gsemi = text " ; "
-gtab  = char '\t'
-gsp   = char ' '
-
-gregno (RealReg i) = i
-gregno other       = --pprPanic "gregno" (ppr other)
-                     999   -- bogus; only needed for debug printing
-
-pprG :: Instr -> Doc -> Doc
-pprG fake actual
-   = (char '#' <> pprGInstr fake) $$ actual
-
-pprGInstr (GMOV src dst)   = pprSizeRegReg SLIT("gmov") F64 src dst
-pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
-pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
-
-pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
-pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
-
-pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32  src dst
-pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
-
-pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32  src dst
-pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
-
-pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
-pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
-pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
-pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
-pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
-pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
-pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
-
-pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
-pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
-pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
-pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
-#endif
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
--- Continue with I386-only printing bits and bobs:
-
-pprDollImm :: Imm -> Doc
-
-pprDollImm i =  ptext SLIT("$") <> pprImm i
-
-pprOperand :: MachRep -> Operand -> Doc
-pprOperand s (OpReg r)   = pprReg s r
-pprOperand s (OpImm i)   = pprDollImm i
-pprOperand s (OpAddr ea) = pprAddr ea
-
-pprMnemonic_  :: LitString -> Doc
-pprMnemonic_ name = 
-   char '\t' <> ptext name <> space
-
-pprMnemonic  :: LitString -> MachRep -> Doc
-pprMnemonic name size = 
-   char '\t' <> ptext name <> pprSize size <> space
-
-pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
-pprSizeImmOp name size imm op1
-  = hcat [
-	pprMnemonic name size,
-	char '$',
-	pprImm imm,
-	comma,
-	pprOperand size op1
-    ]
-	
-pprSizeOp :: LitString -> MachRep -> Operand -> Doc
-pprSizeOp name size op1
-  = hcat [
-	pprMnemonic name size,
-	pprOperand size op1
-    ]
-
-pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
-pprSizeOpOp name size op1 op2
-  = hcat [
-	pprMnemonic name size,
-	pprOperand size op1,
-	comma,
-	pprOperand size op2
-    ]
-
-pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
-pprOpOp name size op1 op2
-  = hcat [
-	pprMnemonic_ name,
-	pprOperand size op1,
-	comma,
-	pprOperand size op2
-    ]
-
-pprSizeReg :: LitString -> MachRep -> Reg -> Doc
-pprSizeReg name size reg1
-  = hcat [
-	pprMnemonic name size,
-	pprReg size reg1
-    ]
-
-pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
-pprSizeRegReg name size reg1 reg2
-  = hcat [
-	pprMnemonic name size,
-	pprReg size reg1,
-        comma,
-        pprReg size reg2
-    ]
-
-pprRegReg :: LitString -> Reg -> Reg -> Doc
-pprRegReg name reg1 reg2
-  = hcat [
-	pprMnemonic_ name,
-	pprReg wordRep reg1,
-        comma,
-        pprReg wordRep reg2
-    ]
-
-pprOpReg :: LitString -> Operand -> Reg -> Doc
-pprOpReg name op1 reg2
-  = hcat [
-	pprMnemonic_ name,
-	pprOperand wordRep op1,
-        comma,
-        pprReg wordRep reg2
-    ]
-
-pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
-pprCondRegReg name size cond reg1 reg2
-  = hcat [
-    	char '\t',
-	ptext name,
-    	pprCond cond,
-	space,
-	pprReg size reg1,
-        comma,
-        pprReg size reg2
-    ]
-
-pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
-pprSizeSizeRegReg name size1 size2 reg1 reg2
-  = hcat [
-    	char '\t',
-	ptext name,
-    	pprSize size1,
-        pprSize size2,
-	space,
-	pprReg size1 reg1,
-
-        comma,
-        pprReg size2 reg2
-    ]
-
-pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
-pprSizeRegRegReg name size reg1 reg2 reg3
-  = hcat [
-	pprMnemonic name size,
-	pprReg size reg1,
-        comma,
-        pprReg size reg2,
-        comma,
-        pprReg size reg3
-    ]
-
-pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
-pprSizeAddrReg name size op dst
-  = hcat [
-	pprMnemonic name size,
-	pprAddr op,
-	comma,
-	pprReg size dst
-    ]
-
-pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
-pprSizeRegAddr name size src op
-  = hcat [
-	pprMnemonic name size,
-	pprReg size src,
-	comma,
-	pprAddr op
-    ]
-
-pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
-pprShift name size src dest
-  = hcat [
-	pprMnemonic name size,
-	pprOperand I8 src,  -- src is 8-bit sized
-	comma,
-	pprOperand size dest
-    ]
-
-pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
-pprSizeOpOpCoerce name size1 size2 op1 op2
-  = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
-	pprOperand size1 op1,
-	comma,
-	pprOperand size2 op2
-    ]
-
-pprCondInstr :: LitString -> Cond -> Doc -> Doc
-pprCondInstr name cond arg
-  = hcat [ char '\t', ptext name, pprCond cond, space, arg]
-
-#endif /* i386_TARGET_ARCH */
-
-
--- ------------------------------------------------------------------------------- pprInstr for a SPARC
-
-#if sparc_TARGET_ARCH
-
--- a clumsy hack for now, to handle possible double alignment problems
-
--- even clumsier, to allow for RegReg regs that show when doing indexed
--- reads (bytearrays).
---
-
--- Translate to the following:
---    add g1,g2,g1
---    ld  [g1],%fn
---    ld  [g1+4],%f(n+1)
---    sub g1,g2,g1           -- to restore g1
-
-pprInstr (LD F64 (AddrRegReg g1 g2) reg)
-  = vcat [
-       hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
-       hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
-       hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
-       hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
-    ]
-
--- Translate to
---    ld  [addr],%fn
---    ld  [addr+4],%f(n+1)
-pprInstr (LD F64 addr reg) | isJust off_addr
-  = vcat [
-       hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
-       hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
-    ]
-  where
-    off_addr = addrOffset addr 4
-    addr2 = case off_addr of Just x -> x
-
-
-pprInstr (LD size addr reg)
-  = hcat [
-       ptext SLIT("\tld"),
-       pprSize size,
-       char '\t',
-       lbrack,
-       pprAddr addr,
-       pp_rbracket_comma,
-       pprReg reg
-    ]
-
--- The same clumsy hack as above
-
--- Translate to the following:
---    add g1,g2,g1
---    st  %fn,[g1]
---    st  %f(n+1),[g1+4]
---    sub g1,g2,g1           -- to restore g1
-pprInstr (ST F64 reg (AddrRegReg g1 g2))
- = vcat [
-       hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
-       hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket, 
-             pprReg g1,	rbrack],
-       hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
-             pprReg g1, ptext SLIT("+4]")],
-       hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
-    ]
-
--- Translate to
---    st  %fn,[addr]
---    st  %f(n+1),[addr+4]
-pprInstr (ST F64 reg addr) | isJust off_addr 
- = vcat [
-      hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket, 
-            pprAddr addr, rbrack],
-      hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
-            pprAddr addr2, rbrack]
-    ]
-  where
-    off_addr = addrOffset addr 4
-    addr2 = case off_addr of Just x -> x
-
--- no distinction is made between signed and unsigned bytes on stores for the
--- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
--- so we call a special-purpose pprSize for ST..
-
-pprInstr (ST size reg addr)
-  = hcat [
-       ptext SLIT("\tst"),
-       pprStSize size,
-       char '\t',
-       pprReg reg,
-       pp_comma_lbracket,
-       pprAddr addr,
-       rbrack
-    ]
-
-pprInstr (ADD x cc reg1 ri reg2)
-  | not x && not cc && riZero ri
-  = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
-  | otherwise
-  = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
-
-pprInstr (SUB x cc reg1 ri reg2)
-  | not x && cc && reg2 == g0
-  = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
-  | not x && not cc && riZero ri
-  = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
-  | otherwise
-  = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
-
-pprInstr (AND  b reg1 ri reg2) = pprRegRIReg SLIT("and")  b reg1 ri reg2
-pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
-
-pprInstr (OR b reg1 ri reg2)
-  | not b && reg1 == g0
-  = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
-    in  case ri of
-           RIReg rrr | rrr == reg2 -> empty
-           other                   -> doit
-  | otherwise
-  = pprRegRIReg SLIT("or") b reg1 ri reg2
-
-pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
-
-pprInstr (XOR  b reg1 ri reg2) = pprRegRIReg SLIT("xor")  b reg1 ri reg2
-pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
-
-pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
-pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
-pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
-
-pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
-pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul")  b reg1 ri reg2
-pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul")  b reg1 ri reg2
-
-pprInstr (SETHI imm reg)
-  = hcat [
-	ptext SLIT("\tsethi\t"),
-	pprImm imm,
-	comma,
-	pprReg reg
-    ]
-
-pprInstr NOP = ptext SLIT("\tnop")
-
-pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
-pprInstr (FABS F64 reg1 reg2)
-  = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
-    (if (reg1 == reg2) then empty
-     else (<>) (char '\n')
-    	  (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
-
-pprInstr (FADD size reg1 reg2 reg3)
-  = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
-pprInstr (FCMP e size reg1 reg2)
-  = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
-pprInstr (FDIV size reg1 reg2 reg3)
-  = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
-
-pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
-pprInstr (FMOV F64 reg1 reg2)
-  = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
-    (if (reg1 == reg2) then empty
-     else (<>) (char '\n')
-    	  (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
-
-pprInstr (FMUL size reg1 reg2 reg3)
-  = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
-
-pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
-pprInstr (FNEG F64 reg1 reg2)
-  = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
-    (if (reg1 == reg2) then empty
-     else (<>) (char '\n')
-    	  (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
-
-pprInstr (FSQRT size reg1 reg2)     = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
-pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
-pprInstr (FxTOy size1 size2 reg1 reg2)
-  = hcat [
-    	ptext SLIT("\tf"),
-	ptext
-    	(case size1 of
-    	    I32  -> SLIT("ito")
-    	    F32  -> SLIT("sto")
-    	    F64  -> SLIT("dto")),
-	ptext
-    	(case size2 of
-    	    I32  -> SLIT("i\t")
-    	    F32  -> SLIT("s\t")
-    	    F64  -> SLIT("d\t")),
-	pprReg reg1, comma, pprReg reg2
-    ]
-
-
-pprInstr (BI cond b lab)
-  = hcat [
-	ptext SLIT("\tb"), pprCond cond,
-	if b then pp_comma_a else empty,
-	char '\t',
-	pprImm lab
-    ]
-
-pprInstr (BF cond b lab)
-  = hcat [
-	ptext SLIT("\tfb"), pprCond cond,
-	if b then pp_comma_a else empty,
-	char '\t',
-	pprImm lab
-    ]
-
-pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
-
-pprInstr (CALL (Left imm) n _)
-  = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
-pprInstr (CALL (Right reg) n _)
-  = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
-
-pprRI :: RI -> Doc
-pprRI (RIReg r) = pprReg r
-pprRI (RIImm r) = pprImm r
-
-pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
-pprSizeRegReg name size reg1 reg2
-  = hcat [
-    	char '\t',
-	ptext name,
-    	(case size of
-    	    F32  -> ptext SLIT("s\t")
-    	    F64 -> ptext SLIT("d\t")),
-	pprReg reg1,
-	comma,
-	pprReg reg2
-    ]
-
-pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
-pprSizeRegRegReg name size reg1 reg2 reg3
-  = hcat [
-    	char '\t',
-	ptext name,
-    	(case size of
-    	    F32  -> ptext SLIT("s\t")
-    	    F64  -> ptext SLIT("d\t")),
-	pprReg reg1,
-	comma,
-	pprReg reg2,
-	comma,
-	pprReg reg3
-    ]
-
-pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
-pprRegRIReg name b reg1 ri reg2
-  = hcat [
-	char '\t',
-	ptext name,
-	if b then ptext SLIT("cc\t") else char '\t',
-	pprReg reg1,
-	comma,
-	pprRI ri,
-	comma,
-	pprReg reg2
-    ]
-
-pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
-pprRIReg name b ri reg1
-  = hcat [
-	char '\t',
-	ptext name,
-	if b then ptext SLIT("cc\t") else char '\t',
-	pprRI ri,
-	comma,
-	pprReg reg1
-    ]
-
-pp_ld_lbracket    = ptext SLIT("\tld\t[")
-pp_rbracket_comma = text "],"
-pp_comma_lbracket = text ",["
-pp_comma_a	  = text ",a"
-
-#endif /* sparc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- pprInstr for PowerPC
-
-#if powerpc_TARGET_ARCH
-pprInstr (LD sz reg addr) = hcat [
-	char '\t',
-	ptext SLIT("l"),
-	ptext (case sz of
-	    I8  -> SLIT("bz")
-	    I16 -> SLIT("hz")
-	    I32 -> SLIT("wz")
-	    F32 -> SLIT("fs")
-	    F64 -> SLIT("fd")),
-        case addr of AddrRegImm _ _ -> empty
-                     AddrRegReg _ _ -> char 'x',
-	char '\t',
-	pprReg reg,
-	ptext SLIT(", "),
-	pprAddr addr
-    ]
-pprInstr (LA sz reg addr) = hcat [
-	char '\t',
-	ptext SLIT("l"),
-	ptext (case sz of
-	    I8  -> SLIT("ba")
-	    I16 -> SLIT("ha")
-	    I32 -> SLIT("wa")
-	    F32 -> SLIT("fs")
-	    F64 -> SLIT("fd")),
-        case addr of AddrRegImm _ _ -> empty
-                     AddrRegReg _ _ -> char 'x',
-	char '\t',
-	pprReg reg,
-	ptext SLIT(", "),
-	pprAddr addr
-    ]
-pprInstr (ST sz reg addr) = hcat [
-	char '\t',
-	ptext SLIT("st"),
-	pprSize sz,
-        case addr of AddrRegImm _ _ -> empty
-                     AddrRegReg _ _ -> char 'x',
-	char '\t',
-	pprReg reg,
-	ptext SLIT(", "),
-	pprAddr addr
-    ]
-pprInstr (STU sz reg addr) = hcat [
-	char '\t',
-	ptext SLIT("st"),
-	pprSize sz,
-	ptext SLIT("u\t"),
-        case addr of AddrRegImm _ _ -> empty
-                     AddrRegReg _ _ -> char 'x',
-	pprReg reg,
-	ptext SLIT(", "),
-	pprAddr addr
-    ]
-pprInstr (LIS reg imm) = hcat [
-	char '\t',
-	ptext SLIT("lis"),
-	char '\t',
-	pprReg reg,
-	ptext SLIT(", "),
-	pprImm imm
-    ]
-pprInstr (LI reg imm) = hcat [
-	char '\t',
-	ptext SLIT("li"),
-	char '\t',
-	pprReg reg,
-	ptext SLIT(", "),
-	pprImm imm
-    ]
-pprInstr (MR reg1 reg2) 
-    | reg1 == reg2 = empty
-    | otherwise = hcat [
-	char '\t',
-	case regClass reg1 of
-	    RcInteger -> ptext SLIT("mr")
-	    _ -> ptext SLIT("fmr"),
-	char '\t',
-	pprReg reg1,
-	ptext SLIT(", "),
-	pprReg reg2
-    ]
-pprInstr (CMP sz reg ri) = hcat [
-	char '\t',
-	op,
-	char '\t',
-	pprReg reg,
-	ptext SLIT(", "),
-	pprRI ri
-    ]
-    where
-	op = hcat [
-		ptext SLIT("cmp"),
-		pprSize sz,
-		case ri of
-		    RIReg _ -> empty
-		    RIImm _ -> char 'i'
-	    ]
-pprInstr (CMPL sz reg ri) = hcat [
-	char '\t',
-	op,
-	char '\t',
-	pprReg reg,
-	ptext SLIT(", "),
-	pprRI ri
-    ]
-    where
-	op = hcat [
-		ptext SLIT("cmpl"),
-		pprSize sz,
-		case ri of
-		    RIReg _ -> empty
-		    RIImm _ -> char 'i'
-	    ]
-pprInstr (BCC cond (BlockId id)) = hcat [
-	char '\t',
-	ptext SLIT("b"),
-	pprCond cond,
-	char '\t',
-	pprCLabel_asm lbl
-    ]
-    where lbl = mkAsmTempLabel id
-
-pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
-	char '\t',
-	ptext SLIT("b"),
-	char '\t',
-	pprCLabel_asm lbl
-    ]
-
-pprInstr (MTCTR reg) = hcat [
-	char '\t',
-	ptext SLIT("mtctr"),
-	char '\t',
-	pprReg reg
-    ]
-pprInstr (BCTR _) = hcat [
-	char '\t',
-	ptext SLIT("bctr")
-    ]
-pprInstr (BL lbl _) = hcat [
-	ptext SLIT("\tbl\t"),
-        pprCLabel_asm lbl
-    ]
-pprInstr (BCTRL _) = hcat [
-	char '\t',
-	ptext SLIT("bctrl")
-    ]
-pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
-pprInstr (ADDIS reg1 reg2 imm) = hcat [
-	char '\t',
-	ptext SLIT("addis"),
-	char '\t',
-	pprReg reg1,
-	ptext SLIT(", "),
-	pprReg reg2,
-	ptext SLIT(", "),
-	pprImm imm
-    ]
-
-pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
-pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
-pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
-pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
-pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
-pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
-pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
-
-pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
-         hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
-                                          pprReg reg2, ptext SLIT(", "),
-                                          pprReg reg3 ],
-         hcat [ ptext SLIT("\tmfxer\t"),  pprReg reg1 ],
-         hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
-                                          pprReg reg1, ptext SLIT(", "),
-                                          ptext SLIT("2, 31, 31") ]
-    ]
-
-    	-- for some reason, "andi" doesn't exist.
-	-- we'll use "andi." instead.
-pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
-	char '\t',
-	ptext SLIT("andi."),
-	char '\t',
-	pprReg reg1,
-	ptext SLIT(", "),
-	pprReg reg2,
-	ptext SLIT(", "),
-	pprImm imm
-    ]
-pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
-
-pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
-pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
-
-pprInstr (XORIS reg1 reg2 imm) = hcat [
-	char '\t',
-	ptext SLIT("xoris"),
-	char '\t',
-	pprReg reg1,
-	ptext SLIT(", "),
-	pprReg reg2,
-	ptext SLIT(", "),
-	pprImm imm
-    ]
-
-pprInstr (EXTS sz reg1 reg2) = hcat [
-	char '\t',
-	ptext SLIT("exts"),
-	pprSize sz,
-	char '\t',
-	pprReg reg1,
-	ptext SLIT(", "),
-	pprReg reg2
-    ]
-
-pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
-pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
-
-pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
-pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
-pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
-pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
-        ptext SLIT("\trlwinm\t"),
-        pprReg reg1,
-        ptext SLIT(", "),
-        pprReg reg2,
-        ptext SLIT(", "),
-        int sh,
-        ptext SLIT(", "),
-        int mb,
-        ptext SLIT(", "),
-        int me
-    ]
-    
-pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
-pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
-pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
-pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
-pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
-
-pprInstr (FCMP reg1 reg2) = hcat [
-	char '\t',
-	ptext SLIT("fcmpu\tcr0, "),
-	    -- Note: we're using fcmpu, not fcmpo
-	    -- The difference is with fcmpo, compare with NaN is an invalid operation.
-	    -- We don't handle invalid fp ops, so we don't care
-	pprReg reg1,
-	ptext SLIT(", "),
-	pprReg reg2
-    ]
-
-pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
-pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
-
-pprInstr (CRNOR dst src1 src2) = hcat [
-        ptext SLIT("\tcrnor\t"),
-        int dst,
-        ptext SLIT(", "),
-        int src1,
-        ptext SLIT(", "),
-        int src2
-    ]
-
-pprInstr (MFCR reg) = hcat [
-	char '\t',
-	ptext SLIT("mfcr"),
-	char '\t',
-	pprReg reg
-    ]
-
-pprInstr (MFLR reg) = hcat [
-	char '\t',
-	ptext SLIT("mflr"),
-	char '\t',
-	pprReg reg
-    ]
-
-pprInstr (FETCHPC reg) = vcat [
-        ptext SLIT("\tbcl\t20,31,1f"),
-        hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
-    ]
-
-pprInstr _ = panic "pprInstr (ppc)"
-
-pprLogic op reg1 reg2 ri = hcat [
-	char '\t',
-	ptext op,
-	case ri of
-	    RIReg _ -> empty
-	    RIImm _ -> char 'i',
-	char '\t',
-	pprReg reg1,
-	ptext SLIT(", "),
-	pprReg reg2,
-	ptext SLIT(", "),
-	pprRI ri
-    ]
-    
-pprUnary op reg1 reg2 = hcat [
-	char '\t',
-	ptext op,
-	char '\t',
-	pprReg reg1,
-	ptext SLIT(", "),
-	pprReg reg2
-    ]
-    
-pprBinaryF op sz reg1 reg2 reg3 = hcat [
-	char '\t',
-	ptext op,
-	pprFSize sz,
-	char '\t',
-	pprReg reg1,
-	ptext SLIT(", "),
-	pprReg reg2,
-	ptext SLIT(", "),
-	pprReg reg3
-    ]
-    
-pprRI :: RI -> Doc
-pprRI (RIReg r) = pprReg r
-pprRI (RIImm r) = pprImm r
-
-pprFSize F64 = empty
-pprFSize F32 = char 's'
-
-    -- limit immediate argument for shift instruction to range 0..32
-    -- (yes, the maximum is really 32, not 31)
-limitShiftRI :: RI -> RI
-limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
-limitShiftRI x = x
-
-#endif /* powerpc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- Converting floating-point literals to integrals for printing
-
-#if __GLASGOW_HASKELL__ >= 504
-newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
-newFloatArray = newArray_
-
-newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
-newDoubleArray = newArray_
-
-castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
-castFloatToCharArray = castSTUArray
-
-castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
-castDoubleToCharArray = castSTUArray
-
-writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
-writeFloatArray = writeArray
-
-writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
-writeDoubleArray = writeArray
-
-readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
-readCharArray arr i = do 
-  w <- readArray arr i
-  return $! (chr (fromIntegral w))
-
-#else
-
-castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
-castFloatToCharArray = return
-
-castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
-
-
-castDoubleToCharArray = return
-
-#endif
-
--- floatToBytes and doubleToBytes convert to the host's byte
--- order.  Providing that we're not cross-compiling for a 
--- target with the opposite endianness, this should work ok
--- on all targets.
-
--- ToDo: this stuff is very similar to the shenanigans in PprAbs,
--- could they be merged?
-
-floatToBytes :: Float -> [Int]
-floatToBytes f
-   = runST (do
-        arr <- newFloatArray ((0::Int),3)
-        writeFloatArray arr 0 f
-	arr <- castFloatToCharArray arr
-        i0 <- readCharArray arr 0
-        i1 <- readCharArray arr 1
-        i2 <- readCharArray arr 2
-        i3 <- readCharArray arr 3
-        return (map ord [i0,i1,i2,i3])
-     )
-
-doubleToBytes :: Double -> [Int]
-doubleToBytes d
-   = runST (do
-        arr <- newDoubleArray ((0::Int),7)
-        writeDoubleArray arr 0 d
-	arr <- castDoubleToCharArray arr
-        i0 <- readCharArray arr 0
-        i1 <- readCharArray arr 1
-        i2 <- readCharArray arr 2
-        i3 <- readCharArray arr 3
-        i4 <- readCharArray arr 4
-        i5 <- readCharArray arr 5
-        i6 <- readCharArray arr 6
-        i7 <- readCharArray arr 7
-        return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
-     )
diff --git a/ghc/compiler/nativeGen/RegAllocInfo.hs b/ghc/compiler/nativeGen/RegAllocInfo.hs
deleted file mode 100644
index 98c4e2dfe0..0000000000
--- a/ghc/compiler/nativeGen/RegAllocInfo.hs
+++ /dev/null
@@ -1,850 +0,0 @@
------------------------------------------------------------------------------
---
--- Machine-specific parts of the register allocator
---
--- (c) The University of Glasgow 1996-2004
---
------------------------------------------------------------------------------
-
-#include "nativeGen/NCG.h"
-
-module RegAllocInfo (
-	RegUsage(..),
-	noUsage,
-	regUsage,
-	patchRegs,
-	jumpDests,
-	patchJump,
-	isRegRegMove,
-
-	maxSpillSlots,
-	mkSpillInstr,
-	mkLoadInstr,
-	mkRegRegMoveInstr,
-	mkBranchInstr
-    ) where
-
-#include "HsVersions.h"
-
-import Cmm		( BlockId )
-import MachOp           ( MachRep(..), wordRep )
-import MachInstrs
-import MachRegs
-import Outputable
-import Constants	( rESERVED_C_STACK_BYTES )
-import FastTypes
-
--- -----------------------------------------------------------------------------
--- RegUsage type
-
--- @regUsage@ returns the sets of src and destination registers used
--- by a particular instruction.  Machine registers that are
--- pre-allocated to stgRegs are filtered out, because they are
--- uninteresting from a register allocation standpoint.  (We wouldn't
--- want them to end up on the free list!)  As far as we are concerned,
--- the fixed registers simply don't exist (for allocation purposes,
--- anyway).
-
--- regUsage doesn't need to do any trickery for jumps and such.  Just
--- state precisely the regs read and written by that insn.  The
--- consequences of control flow transfers, as far as register
--- allocation goes, are taken care of by the register allocator.
-
-data RegUsage = RU [Reg] [Reg]
-
-noUsage :: RegUsage
-noUsage  = RU [] []
-
-regUsage :: Instr -> RegUsage
-
-interesting (VirtualRegI  _)  = True
-interesting (VirtualRegHi _)  = True
-interesting (VirtualRegF  _)  = True
-interesting (VirtualRegD  _)  = True
-interesting (RealReg i)       = isFastTrue (freeReg i)
-
-
-#if alpha_TARGET_ARCH
-regUsage instr = case instr of
-    LD B reg addr	-> usage (regAddr addr, [reg, t9])
-    LD Bu reg addr	-> usage (regAddr addr, [reg, t9])
---  LD W reg addr	-> usage (regAddr addr, [reg, t9]) : UNUSED
---  LD Wu reg addr	-> usage (regAddr addr, [reg, t9]) : UNUSED
-    LD sz reg addr	-> usage (regAddr addr, [reg])
-    LDA reg addr	-> usage (regAddr addr, [reg])
-    LDAH reg addr	-> usage (regAddr addr, [reg])
-    LDGP reg addr	-> usage (regAddr addr, [reg])
-    LDI sz reg imm	-> usage ([], [reg])
-    ST B reg addr	-> usage (reg : regAddr addr, [t9, t10])
---  ST W reg addr	-> usage (reg : regAddr addr, [t9, t10]) : UNUSED
-    ST sz reg addr	-> usage (reg : regAddr addr, [])
-    CLR reg		-> usage ([], [reg])
-    ABS sz ri reg	-> usage (regRI ri, [reg])
-    NEG sz ov ri reg	-> usage (regRI ri, [reg])
-    ADD sz ov r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    SADD sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
-    SUB sz ov r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    SSUB sz sc r1 ar r2 -> usage (r1 : regRI ar, [r2])
-    MUL sz ov r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    DIV sz un r1 ar r2	-> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
-    REM sz un r1 ar r2	-> usage (r1 : regRI ar, [r2, t9, t10, t11, t12])
-    NOT ri reg		-> usage (regRI ri, [reg])
-    AND r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    ANDNOT r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    OR r1 ar r2		-> usage (r1 : regRI ar, [r2])
-    ORNOT r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    XOR r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    XORNOT r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    SLL r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    SRL r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    SRA r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    ZAP r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    ZAPNOT r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    CMP co r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    FCLR reg		-> usage ([], [reg])
-    FABS r1 r2		-> usage ([r1], [r2])
-    FNEG sz r1 r2	-> usage ([r1], [r2])
-    FADD sz r1 r2 r3	-> usage ([r1, r2], [r3])
-    FDIV sz r1 r2 r3	-> usage ([r1, r2], [r3])
-    FMUL sz r1 r2 r3	-> usage ([r1, r2], [r3])
-    FSUB sz r1 r2 r3	-> usage ([r1, r2], [r3])
-    CVTxy sz1 sz2 r1 r2 -> usage ([r1], [r2])
-    FCMP sz co r1 r2 r3 -> usage ([r1, r2], [r3])
-    FMOV r1 r2		-> usage ([r1], [r2])
-
-
-    -- We assume that all local jumps will be BI/BF/BR.	 JMP must be out-of-line.
-    BI cond reg lbl	-> usage ([reg], [])
-    BF cond reg lbl	-> usage ([reg], [])
-    JMP reg addr hint	-> RU (mkRegSet (filter interesting (regAddr addr))) freeRegSet
-
-    BSR _ n		-> RU (argRegSet n) callClobberedRegSet
-    JSR reg addr n	-> RU (argRegSet n) callClobberedRegSet
-
-    _			-> noUsage
-
-  where
-    usage (src, dst) = RU (mkRegSet (filter interesting src))
-			  (mkRegSet (filter interesting dst))
-
-    interesting (FixedReg _) = False
-    interesting _ = True
-
-    regAddr (AddrReg r1)      = [r1]
-    regAddr (AddrRegImm r1 _) = [r1]
-    regAddr (AddrImm _)	      = []
-
-    regRI (RIReg r) = [r]
-    regRI  _	= []
-
-#endif /* alpha_TARGET_ARCH */
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
-regUsage instr = case instr of
-    MOV    sz src dst	-> usageRW src dst
-    MOVZxL sz src dst	-> usageRW src dst
-    MOVSxL sz src dst	-> usageRW src dst
-    LEA    sz src dst	-> usageRW src dst
-    ADD    sz src dst	-> usageRM src dst
-    ADC    sz src dst	-> usageRM src dst
-    SUB    sz src dst	-> usageRM src dst
-    IMUL   sz src dst	-> usageRM src dst
-    IMUL2  sz src       -> mkRU (eax:use_R src) [eax,edx]
-    MUL    sz src dst	-> usageRM src dst
-    DIV    sz op	-> mkRU (eax:edx:use_R op) [eax,edx]
-    IDIV   sz op	-> mkRU (eax:edx:use_R op) [eax,edx]
-    AND    sz src dst	-> usageRM src dst
-    OR     sz src dst	-> usageRM src dst
-    XOR    sz src dst	-> usageRM src dst
-    NOT    sz op	-> usageM op
-    NEGI   sz op	-> usageM op
-    SHL    sz imm dst	-> usageRM imm dst
-    SAR    sz imm dst	-> usageRM imm dst
-    SHR    sz imm dst	-> usageRM imm dst
-    BT     sz imm src	-> mkRUR (use_R src)
-
-    PUSH   sz op	-> mkRUR (use_R op)
-    POP    sz op	-> mkRU [] (def_W op)
-    TEST   sz src dst	-> mkRUR (use_R src ++ use_R dst)
-    CMP    sz src dst	-> mkRUR (use_R src ++ use_R dst)
-    SETCC  cond op	-> mkRU [] (def_W op)
-    JXX    cond lbl	-> mkRU [] []
-    JMP    op		-> mkRUR (use_R op)
-    JMP_TBL op ids      -> mkRUR (use_R op)
-    CALL (Left imm)  params -> mkRU params callClobberedRegs
-    CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs
-    CLTD   sz		-> mkRU [eax] [edx]
-    NOP			-> mkRU [] []
-
-#if i386_TARGET_ARCH
-    GMOV   src dst	-> mkRU [src] [dst]
-    GLD    sz src dst	-> mkRU (use_EA src) [dst]
-    GST    sz src dst	-> mkRUR (src : use_EA dst)
-
-    GLDZ   dst		-> mkRU [] [dst]
-    GLD1   dst		-> mkRU [] [dst]
-
-    GFTOI  src dst	-> mkRU [src] [dst]
-    GDTOI  src dst	-> mkRU [src] [dst]
-
-    GITOF  src dst	-> mkRU [src] [dst]
-    GITOD  src dst	-> mkRU [src] [dst]
-
-    GADD   sz s1 s2 dst	-> mkRU [s1,s2] [dst]
-    GSUB   sz s1 s2 dst	-> mkRU [s1,s2] [dst]
-    GMUL   sz s1 s2 dst	-> mkRU [s1,s2] [dst]
-    GDIV   sz s1 s2 dst	-> mkRU [s1,s2] [dst]
-
-    GCMP   sz src1 src2	-> mkRUR [src1,src2]
-    GABS   sz src dst	-> mkRU [src] [dst]
-    GNEG   sz src dst	-> mkRU [src] [dst]
-    GSQRT  sz src dst	-> mkRU [src] [dst]
-    GSIN   sz src dst	-> mkRU [src] [dst]
-    GCOS   sz src dst	-> mkRU [src] [dst]
-    GTAN   sz src dst	-> mkRU [src] [dst]
-#endif
-
-#if x86_64_TARGET_ARCH
-    CVTSS2SD src dst	-> mkRU [src] [dst]
-    CVTSD2SS src dst	-> mkRU [src] [dst]
-    CVTSS2SI src dst	-> mkRU (use_R src) [dst]
-    CVTSD2SI src dst	-> mkRU (use_R src) [dst]
-    CVTSI2SS src dst	-> mkRU (use_R src) [dst]
-    CVTSI2SD src dst	-> mkRU (use_R src) [dst]
-    FDIV sz src dst     -> usageRM src dst
-#endif    
-
-    FETCHGOT reg        -> mkRU [] [reg]
-    FETCHPC  reg        -> mkRU [] [reg]
-
-    COMMENT _		-> noUsage
-    DELTA   _           -> noUsage
-
-    _other		-> panic "regUsage: unrecognised instr"
-
- where
-#if x86_64_TARGET_ARCH
-	-- call parameters: include %eax, because it is used
-	-- to pass the number of SSE reg arguments to varargs fns.
-    params = eax : allArgRegs ++ allFPArgRegs
-#endif
-
-    -- 2 operand form; first operand Read; second Written
-    usageRW :: Operand -> Operand -> RegUsage
-    usageRW op (OpReg reg) = mkRU (use_R op) [reg]
-    usageRW op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea)
-
-    -- 2 operand form; first operand Read; second Modified
-    usageRM :: Operand -> Operand -> RegUsage
-    usageRM op (OpReg reg) = mkRU (use_R op ++ [reg]) [reg]
-    usageRM op (OpAddr ea) = mkRUR (use_R op ++ use_EA ea)
-
-    -- 1 operand form; operand Modified
-    usageM :: Operand -> RegUsage
-    usageM (OpReg reg)    = mkRU [reg] [reg]
-    usageM (OpAddr ea)    = mkRUR (use_EA ea)
-
-    -- Registers defd when an operand is written.
-    def_W (OpReg reg)  = [reg]
-    def_W (OpAddr ea)  = []
-
-    -- Registers used when an operand is read.
-    use_R (OpReg reg)  = [reg]
-    use_R (OpImm imm)  = []
-    use_R (OpAddr ea)  = use_EA ea
-
-    -- Registers used to compute an effective address.
-    use_EA (ImmAddr _ _) = []
-    use_EA (AddrBaseIndex base index _) = 
-	use_base base $! use_index index
-	where use_base (EABaseReg r) x = r : x
-	      use_base _ x             = x
-	      use_index EAIndexNone   = []
-	      use_index (EAIndex i _) = [i]
-
-    mkRUR src = src' `seq` RU src' []
-	where src' = filter interesting src
-
-    mkRU src dst = src' `seq` dst' `seq` RU src' dst'
-	where src' = filter interesting src
-	      dst' = filter interesting dst
-
-#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if sparc_TARGET_ARCH
-
-regUsage instr = case instr of
-    LD    sz addr reg  	-> usage (regAddr addr, [reg])
-    ST    sz reg addr  	-> usage (reg : regAddr addr, [])
-    ADD   x cc r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    SUB   x cc r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    UMUL    cc r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    SMUL    cc r1 ar r2	-> usage (r1 : regRI ar, [r2])
-    RDY   rd            -> usage ([], [rd])
-    AND   b r1 ar r2  	-> usage (r1 : regRI ar, [r2])
-    ANDN  b r1 ar r2 	-> usage (r1 : regRI ar, [r2])
-    OR    b r1 ar r2   	-> usage (r1 : regRI ar, [r2])
-    ORN   b r1 ar r2  	-> usage (r1 : regRI ar, [r2])
-    XOR   b r1 ar r2  	-> usage (r1 : regRI ar, [r2])
-    XNOR  b r1 ar r2 	-> usage (r1 : regRI ar, [r2])
-    SLL   r1 ar r2    	-> usage (r1 : regRI ar, [r2])
-    SRL   r1 ar r2    	-> usage (r1 : regRI ar, [r2])
-    SRA   r1 ar r2    	-> usage (r1 : regRI ar, [r2])
-    SETHI imm reg   	-> usage ([], [reg])
-    FABS  s r1 r2    	-> usage ([r1], [r2])
-    FADD  s r1 r2 r3 	-> usage ([r1, r2], [r3])
-    FCMP  e s r1 r2  	-> usage ([r1, r2], [])
-    FDIV  s r1 r2 r3 	-> usage ([r1, r2], [r3])
-    FMOV  s r1 r2    	-> usage ([r1], [r2])
-    FMUL  s r1 r2 r3 	-> usage ([r1, r2], [r3])
-    FNEG  s r1 r2    	-> usage ([r1], [r2])
-    FSQRT s r1 r2   	-> usage ([r1], [r2])
-    FSUB  s r1 r2 r3 	-> usage ([r1, r2], [r3])
-    FxTOy s1 s2 r1 r2 	-> usage ([r1], [r2])
-
-    -- We assume that all local jumps will be BI/BF.  JMP must be out-of-line.
-    JMP   addr 	        -> usage (regAddr addr, [])
-
-    CALL  (Left imm)  n True  -> noUsage
-    CALL  (Left imm)  n False -> usage (argRegs n, callClobberedRegs)
-    CALL  (Right reg) n True  -> usage ([reg], [])
-    CALL  (Right reg) n False -> usage (reg : (argRegs n), callClobberedRegs)
-
-    _ 	    	    	-> noUsage
-  where
-    usage (src, dst) = RU (filter interesting src)
-    	    	    	 (filter interesting dst)
-
-    regAddr (AddrRegReg r1 r2) = [r1, r2]
-    regAddr (AddrRegImm r1 _)  = [r1]
-
-    regRI (RIReg r) = [r]
-    regRI  _	= []
-
-#endif /* sparc_TARGET_ARCH */
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if powerpc_TARGET_ARCH
-
-regUsage instr = case instr of
-    LD    sz reg addr  	-> usage (regAddr addr, [reg])
-    LA    sz reg addr  	-> usage (regAddr addr, [reg])
-    ST    sz reg addr  	-> usage (reg : regAddr addr, [])
-    STU    sz reg addr  -> usage (reg : regAddr addr, [])
-    LIS   reg imm	-> usage ([], [reg])
-    LI    reg imm	-> usage ([], [reg])
-    MR	  reg1 reg2     -> usage ([reg2], [reg1])
-    CMP   sz reg ri	-> usage (reg : regRI ri,[])
-    CMPL  sz reg ri	-> usage (reg : regRI ri,[])
-    BCC	  cond lbl	-> noUsage
-    MTCTR reg		-> usage ([reg],[])
-    BCTR  targets	-> noUsage
-    BL    imm params	-> usage (params, callClobberedRegs)
-    BCTRL params	-> usage (params, callClobberedRegs)
-    ADD	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
-    ADDC  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
-    ADDE  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
-    ADDIS reg1 reg2 imm -> usage ([reg2], [reg1])
-    SUBF  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
-    MULLW reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
-    DIVW  reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
-    DIVWU reg1 reg2 reg3-> usage ([reg2,reg3], [reg1])
-    MULLW_MayOflo reg1 reg2 reg3        
-                        -> usage ([reg2,reg3], [reg1])
-    AND	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
-    OR	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
-    XOR	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
-    XORIS reg1 reg2 imm -> usage ([reg2], [reg1])
-    EXTS  siz reg1 reg2 -> usage ([reg2], [reg1])
-    NEG	  reg1 reg2	-> usage ([reg2], [reg1])
-    NOT	  reg1 reg2	-> usage ([reg2], [reg1])
-    SLW	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
-    SRW	  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
-    SRAW  reg1 reg2 ri  -> usage (reg2 : regRI ri, [reg1])
-    RLWINM reg1 reg2 sh mb me
-                        -> usage ([reg2], [reg1])
-    FADD  sz r1 r2 r3   -> usage ([r2,r3], [r1])
-    FSUB  sz r1 r2 r3   -> usage ([r2,r3], [r1])
-    FMUL  sz r1 r2 r3   -> usage ([r2,r3], [r1])
-    FDIV  sz r1 r2 r3   -> usage ([r2,r3], [r1])
-    FNEG  r1 r2		-> usage ([r2], [r1])
-    FCMP  r1 r2		-> usage ([r1,r2], [])
-    FCTIWZ r1 r2	-> usage ([r2], [r1])
-    FRSP r1 r2		-> usage ([r2], [r1])
-    MFCR reg            -> usage ([], [reg])
-    MFLR reg            -> usage ([], [reg])
-    FETCHPC reg         -> usage ([], [reg])
-    _ 	    	    	-> noUsage
-  where
-    usage (src, dst) = RU (filter interesting src)
-    	    	    	  (filter interesting dst)
-    regAddr (AddrRegReg r1 r2) = [r1, r2]
-    regAddr (AddrRegImm r1 _)  = [r1]
-
-    regRI (RIReg r) = [r]
-    regRI  _	= []
-#endif /* powerpc_TARGET_ARCH */
-
-
--- -----------------------------------------------------------------------------
--- Determine the possible destinations from the current instruction.
-
--- (we always assume that the next instruction is also a valid destination;
--- if this isn't the case then the jump should be at the end of the basic
--- block).
-
-jumpDests :: Instr -> [BlockId] -> [BlockId]
-jumpDests insn acc
-  = case insn of
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-	JXX _ id	-> id : acc
-	JMP_TBL _ ids	-> ids ++ acc
-#elif powerpc_TARGET_ARCH
-        BCC _ id        -> id : acc
-        BCTR targets    -> targets ++ acc
-#endif
-	_other		-> acc
-
-patchJump :: Instr -> BlockId -> BlockId -> Instr
-
-patchJump insn old new
-  = case insn of
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-	JXX cc id | id == old -> JXX cc new
-	JMP_TBL op ids -> error "Cannot patch JMP_TBL"
-#elif powerpc_TARGET_ARCH
-        BCC cc id | id == old -> BCC cc new
-        BCTR targets -> error "Cannot patch BCTR"
-#endif
-	_other		-> insn
-
--- -----------------------------------------------------------------------------
--- 'patchRegs' function
-
--- 'patchRegs' takes an instruction and applies the given mapping to
--- all the register references.
-
-patchRegs :: Instr -> (Reg -> Reg) -> Instr
-
-#if alpha_TARGET_ARCH
-
-patchRegs instr env = case instr of
-    LD sz reg addr -> LD sz (env reg) (fixAddr addr)
-    LDA reg addr -> LDA (env reg) (fixAddr addr)
-    LDAH reg addr -> LDAH (env reg) (fixAddr addr)
-    LDGP reg addr -> LDGP (env reg) (fixAddr addr)
-    LDI sz reg imm -> LDI sz (env reg) imm
-    ST sz reg addr -> ST sz (env reg) (fixAddr addr)
-    CLR reg -> CLR (env reg)
-    ABS sz ar reg -> ABS sz (fixRI ar) (env reg)
-    NEG sz ov ar reg -> NEG sz ov (fixRI ar) (env reg)
-    ADD sz ov r1 ar r2 -> ADD sz ov (env r1) (fixRI ar) (env r2)
-    SADD sz sc r1 ar r2 -> SADD sz sc (env r1) (fixRI ar) (env r2)
-    SUB sz ov r1 ar r2 -> SUB sz ov (env r1) (fixRI ar) (env r2)
-    SSUB sz sc r1 ar r2 -> SSUB sz sc (env r1) (fixRI ar) (env r2)
-    MUL sz ov r1 ar r2 -> MUL sz ov (env r1) (fixRI ar) (env r2)
-    DIV sz un r1 ar r2 -> DIV sz un (env r1) (fixRI ar) (env r2)
-    REM sz un r1 ar r2 -> REM sz un (env r1) (fixRI ar) (env r2)
-    NOT ar reg -> NOT (fixRI ar) (env reg)
-    AND r1 ar r2 -> AND (env r1) (fixRI ar) (env r2)
-    ANDNOT r1 ar r2 -> ANDNOT (env r1) (fixRI ar) (env r2)
-    OR r1 ar r2 -> OR (env r1) (fixRI ar) (env r2)
-    ORNOT r1 ar r2 -> ORNOT (env r1) (fixRI ar) (env r2)
-    XOR r1 ar r2 -> XOR (env r1) (fixRI ar) (env r2)
-    XORNOT r1 ar r2 -> XORNOT (env r1) (fixRI ar) (env r2)
-    SLL r1 ar r2 -> SLL (env r1) (fixRI ar) (env r2)
-    SRL r1 ar r2 -> SRL (env r1) (fixRI ar) (env r2)
-    SRA r1 ar r2 -> SRA (env r1) (fixRI ar) (env r2)
-    ZAP r1 ar r2 -> ZAP (env r1) (fixRI ar) (env r2)
-    ZAPNOT r1 ar r2 -> ZAPNOT (env r1) (fixRI ar) (env r2)
-    CMP co r1 ar r2 -> CMP co (env r1) (fixRI ar) (env r2)
-    FCLR reg -> FCLR (env reg)
-    FABS r1 r2 -> FABS (env r1) (env r2)
-    FNEG s r1 r2 -> FNEG s (env r1) (env r2)
-    FADD s r1 r2 r3 -> FADD s (env r1) (env r2) (env r3)
-    FDIV s r1 r2 r3 -> FDIV s (env r1) (env r2) (env r3)
-    FMUL s r1 r2 r3 -> FMUL s (env r1) (env r2) (env r3)
-    FSUB s r1 r2 r3 -> FSUB s (env r1) (env r2) (env r3)
-    CVTxy s1 s2 r1 r2 -> CVTxy s1 s2 (env r1) (env r2)
-    FCMP s co r1 r2 r3 -> FCMP s co (env r1) (env r2) (env r3)
-    FMOV r1 r2 -> FMOV (env r1) (env r2)
-    BI cond reg lbl -> BI cond (env reg) lbl
-    BF cond reg lbl -> BF cond (env reg) lbl
-    JMP reg addr hint -> JMP (env reg) (fixAddr addr) hint
-    JSR reg addr i -> JSR (env reg) (fixAddr addr) i
-    _ -> instr
-  where
-    fixAddr (AddrReg r1)       = AddrReg (env r1)
-    fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
-    fixAddr other	       = other
-
-    fixRI (RIReg r) = RIReg (env r)
-    fixRI other	= other
-
-#endif /* alpha_TARGET_ARCH */
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-
-patchRegs instr env = case instr of
-    MOV  sz src dst	-> patch2 (MOV  sz) src dst
-    MOVZxL sz src dst	-> patch2 (MOVZxL sz) src dst
-    MOVSxL sz src dst	-> patch2 (MOVSxL sz) src dst
-    LEA  sz src dst	-> patch2 (LEA  sz) src dst
-    ADD  sz src dst	-> patch2 (ADD  sz) src dst
-    ADC  sz src dst	-> patch2 (ADC  sz) src dst
-    SUB  sz src dst	-> patch2 (SUB  sz) src dst
-    IMUL sz src dst 	-> patch2 (IMUL sz) src dst
-    IMUL2 sz src        -> patch1 (IMUL2 sz) src
-    MUL sz src dst 	-> patch2 (MUL sz) src dst
-    IDIV sz op		-> patch1 (IDIV sz) op
-    DIV sz op		-> patch1 (DIV sz) op
-    AND  sz src dst	-> patch2 (AND  sz) src dst
-    OR   sz src dst	-> patch2 (OR   sz) src dst
-    XOR  sz src dst	-> patch2 (XOR  sz) src dst
-    NOT  sz op 		-> patch1 (NOT  sz) op
-    NEGI sz op		-> patch1 (NEGI sz) op
-    SHL  sz imm dst 	-> patch1 (SHL sz imm) dst
-    SAR  sz imm dst 	-> patch1 (SAR sz imm) dst
-    SHR  sz imm dst 	-> patch1 (SHR sz imm) dst
-    BT   sz imm src     -> patch1 (BT  sz imm) src
-    TEST sz src dst	-> patch2 (TEST sz) src dst
-    CMP  sz src dst	-> patch2 (CMP  sz) src dst
-    PUSH sz op		-> patch1 (PUSH sz) op
-    POP  sz op		-> patch1 (POP  sz) op
-    SETCC cond op	-> patch1 (SETCC cond) op
-    JMP op		-> patch1 JMP op
-    JMP_TBL op ids      -> patch1 JMP_TBL op $ ids
-
-#if i386_TARGET_ARCH
-    GMOV src dst	-> GMOV (env src) (env dst)
-    GLD sz src dst	-> GLD sz (lookupAddr src) (env dst)
-    GST sz src dst	-> GST sz (env src) (lookupAddr dst)
-
-    GLDZ dst		-> GLDZ (env dst)
-    GLD1 dst		-> GLD1 (env dst)
-
-    GFTOI src dst	-> GFTOI (env src) (env dst)
-    GDTOI src dst	-> GDTOI (env src) (env dst)
-
-    GITOF src dst	-> GITOF (env src) (env dst)
-    GITOD src dst	-> GITOD (env src) (env dst)
-
-    GADD sz s1 s2 dst	-> GADD sz (env s1) (env s2) (env dst)
-    GSUB sz s1 s2 dst	-> GSUB sz (env s1) (env s2) (env dst)
-    GMUL sz s1 s2 dst	-> GMUL sz (env s1) (env s2) (env dst)
-    GDIV sz s1 s2 dst	-> GDIV sz (env s1) (env s2) (env dst)
-
-    GCMP sz src1 src2	-> GCMP sz (env src1) (env src2)
-    GABS sz src dst	-> GABS sz (env src) (env dst)
-    GNEG sz src dst	-> GNEG sz (env src) (env dst)
-    GSQRT sz src dst	-> GSQRT sz (env src) (env dst)
-    GSIN sz src dst	-> GSIN sz (env src) (env dst)
-    GCOS sz src dst	-> GCOS sz (env src) (env dst)
-    GTAN sz src dst	-> GTAN sz (env src) (env dst)
-#endif
-
-#if x86_64_TARGET_ARCH
-    CVTSS2SD src dst	-> CVTSS2SD (env src) (env dst)
-    CVTSD2SS src dst	-> CVTSD2SS (env src) (env dst)
-    CVTSS2SI src dst	-> CVTSS2SI (patchOp src) (env dst)
-    CVTSD2SI src dst	-> CVTSD2SI (patchOp src) (env dst)
-    CVTSI2SS src dst	-> CVTSI2SS (patchOp src) (env dst)
-    CVTSI2SD src dst	-> CVTSI2SD (patchOp src) (env dst)
-    FDIV sz src dst	-> FDIV sz (patchOp src) (patchOp dst)
-#endif    
-
-    CALL (Left imm)  _	-> instr
-    CALL (Right reg) p	-> CALL (Right (env reg)) p
-    
-    FETCHGOT reg        -> FETCHGOT (env reg)
-    FETCHPC  reg        -> FETCHPC  (env reg)
-   
-    NOP			-> instr
-    COMMENT _		-> instr
-    DELTA _ 		-> instr
-    JXX _ _		-> instr
-    CLTD _		-> instr
-
-    _other		-> panic "patchRegs: unrecognised instr"
-
-  where
-    patch1 insn op      = insn $! patchOp op
-    patch2 insn src dst = (insn $! patchOp src) $! patchOp dst
-
-    patchOp (OpReg  reg) = OpReg $! env reg
-    patchOp (OpImm  imm) = OpImm imm
-    patchOp (OpAddr ea)  = OpAddr $! lookupAddr ea
-
-    lookupAddr (ImmAddr imm off) = ImmAddr imm off
-    lookupAddr (AddrBaseIndex base index disp)
-      = ((AddrBaseIndex $! lookupBase base) $! lookupIndex index) disp
-      where
-	lookupBase EABaseNone       = EABaseNone
-	lookupBase EABaseRip        = EABaseRip
-	lookupBase (EABaseReg r)    = EABaseReg (env r)
-				 
-	lookupIndex EAIndexNone     = EAIndexNone
-	lookupIndex (EAIndex r i)   = EAIndex (env r) i
-
-#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH*/
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if sparc_TARGET_ARCH
-
-patchRegs instr env = case instr of
-    LD    sz addr reg   -> LD sz (fixAddr addr) (env reg)
-    ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
-    ADD   x cc r1 ar r2 -> ADD x cc (env r1) (fixRI ar) (env r2)
-    SUB   x cc r1 ar r2 -> SUB x cc (env r1) (fixRI ar) (env r2)
-    UMUL    cc r1 ar r2	-> UMUL cc (env r1) (fixRI ar) (env r2)
-    SMUL    cc r1 ar r2	-> SMUL cc (env r1) (fixRI ar) (env r2)
-    RDY   rd            -> RDY (env rd)
-    AND   b r1 ar r2    -> AND b (env r1) (fixRI ar) (env r2)
-    ANDN  b r1 ar r2    -> ANDN b (env r1) (fixRI ar) (env r2)
-    OR    b r1 ar r2    -> OR b (env r1) (fixRI ar) (env r2)
-    ORN   b r1 ar r2    -> ORN b (env r1) (fixRI ar) (env r2)
-    XOR   b r1 ar r2    -> XOR b (env r1) (fixRI ar) (env r2)
-    XNOR  b r1 ar r2    -> XNOR b (env r1) (fixRI ar) (env r2)
-    SLL   r1 ar r2      -> SLL (env r1) (fixRI ar) (env r2)
-    SRL   r1 ar r2      -> SRL (env r1) (fixRI ar) (env r2)
-    SRA   r1 ar r2      -> SRA (env r1) (fixRI ar) (env r2)
-    SETHI imm reg       -> SETHI imm (env reg)
-    FABS  s r1 r2       -> FABS s (env r1) (env r2)
-    FADD  s r1 r2 r3    -> FADD s (env r1) (env r2) (env r3)
-    FCMP  e s r1 r2     -> FCMP e s (env r1) (env r2)
-    FDIV  s r1 r2 r3    -> FDIV s (env r1) (env r2) (env r3)
-    FMOV  s r1 r2       -> FMOV s (env r1) (env r2)
-    FMUL  s r1 r2 r3    -> FMUL s (env r1) (env r2) (env r3)
-    FNEG  s r1 r2       -> FNEG s (env r1) (env r2)
-    FSQRT s r1 r2       -> FSQRT s (env r1) (env r2)
-    FSUB  s r1 r2 r3    -> FSUB s (env r1) (env r2) (env r3)
-    FxTOy s1 s2 r1 r2   -> FxTOy s1 s2 (env r1) (env r2)
-    JMP   addr          -> JMP (fixAddr addr)
-    CALL  (Left i) n t  -> CALL (Left i) n t
-    CALL  (Right r) n t -> CALL (Right (env r)) n t
-    _ -> instr
-  where
-    fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
-    fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
-
-    fixRI (RIReg r) = RIReg (env r)
-    fixRI other	= other
-
-#endif /* sparc_TARGET_ARCH */
--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-#if powerpc_TARGET_ARCH
-
-patchRegs instr env = case instr of
-    LD    sz reg addr   -> LD sz (env reg) (fixAddr addr)
-    LA    sz reg addr   -> LA sz (env reg) (fixAddr addr)
-    ST    sz reg addr   -> ST sz (env reg) (fixAddr addr)
-    STU    sz reg addr  -> STU sz (env reg) (fixAddr addr)
-    LIS   reg imm	-> LIS (env reg) imm
-    LI    reg imm	-> LI (env reg) imm
-    MR	  reg1 reg2     -> MR (env reg1) (env reg2)
-    CMP	  sz reg ri	-> CMP sz (env reg) (fixRI ri)
-    CMPL  sz reg ri	-> CMPL sz (env reg) (fixRI ri)
-    BCC	  cond lbl	-> BCC cond lbl
-    MTCTR reg		-> MTCTR (env reg)
-    BCTR  targets	-> BCTR targets
-    BL    imm argRegs	-> BL imm argRegs	-- argument regs
-    BCTRL argRegs	-> BCTRL argRegs 	-- cannot be remapped
-    ADD	  reg1 reg2 ri	-> ADD (env reg1) (env reg2) (fixRI ri)
-    ADDC  reg1 reg2 reg3-> ADDC (env reg1) (env reg2) (env reg3)
-    ADDE  reg1 reg2 reg3-> ADDE (env reg1) (env reg2) (env reg3)
-    ADDIS reg1 reg2 imm -> ADDIS (env reg1) (env reg2) imm
-    SUBF  reg1 reg2 reg3-> SUBF (env reg1) (env reg2) (env reg3)
-    MULLW reg1 reg2 ri	-> MULLW (env reg1) (env reg2) (fixRI ri)
-    DIVW  reg1 reg2 reg3-> DIVW (env reg1) (env reg2) (env reg3)
-    DIVWU reg1 reg2 reg3-> DIVWU (env reg1) (env reg2) (env reg3)
-    MULLW_MayOflo reg1 reg2 reg3
-                        -> MULLW_MayOflo (env reg1) (env reg2) (env reg3)
-    AND	  reg1 reg2 ri	-> AND (env reg1) (env reg2) (fixRI ri)
-    OR 	  reg1 reg2 ri	-> OR  (env reg1) (env reg2) (fixRI ri)
-    XOR	  reg1 reg2 ri	-> XOR (env reg1) (env reg2) (fixRI ri)
-    XORIS reg1 reg2 imm -> XORIS (env reg1) (env reg2) imm
-    EXTS  sz reg1 reg2 -> EXTS sz (env reg1) (env reg2)
-    NEG	  reg1 reg2	-> NEG (env reg1) (env reg2)
-    NOT	  reg1 reg2	-> NOT (env reg1) (env reg2)
-    SLW	  reg1 reg2 ri	-> SLW (env reg1) (env reg2) (fixRI ri)
-    SRW	  reg1 reg2 ri	-> SRW (env reg1) (env reg2) (fixRI ri)
-    SRAW  reg1 reg2 ri	-> SRAW (env reg1) (env reg2) (fixRI ri)
-    RLWINM reg1 reg2 sh mb me
-                        -> RLWINM (env reg1) (env reg2) sh mb me
-    FADD  sz r1 r2 r3   -> FADD sz (env r1) (env r2) (env r3)
-    FSUB  sz r1 r2 r3   -> FSUB sz (env r1) (env r2) (env r3)
-    FMUL  sz r1 r2 r3   -> FMUL sz (env r1) (env r2) (env r3)
-    FDIV  sz r1 r2 r3   -> FDIV sz (env r1) (env r2) (env r3)
-    FNEG  r1 r2		-> FNEG (env r1) (env r2)
-    FCMP  r1 r2		-> FCMP (env r1) (env r2)
-    FCTIWZ r1 r2	-> FCTIWZ (env r1) (env r2)
-    FRSP r1 r2		-> FRSP (env r1) (env r2)
-    MFCR reg            -> MFCR (env reg)
-    MFLR reg            -> MFLR (env reg)
-    FETCHPC reg         -> FETCHPC (env reg)
-    _ -> instr
-  where
-    fixAddr (AddrRegReg r1 r2) = AddrRegReg (env r1) (env r2)
-    fixAddr (AddrRegImm r1 i)  = AddrRegImm (env r1) i
-
-    fixRI (RIReg r) = RIReg (env r)
-    fixRI other	= other
-#endif /* powerpc_TARGET_ARCH */
-
--- -----------------------------------------------------------------------------
--- Detecting reg->reg moves
-
--- The register allocator attempts to eliminate reg->reg moves whenever it can,
--- by assigning the src and dest temporaries to the same real register.
-
-isRegRegMove :: Instr -> Maybe (Reg,Reg)
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
--- TMP:
-isRegRegMove (MOV _ (OpReg r1) (OpReg r2)) = Just (r1,r2)
-#elif powerpc_TARGET_ARCH
-isRegRegMove (MR dst src) = Just (src,dst)
-#else
-#warning ToDo: isRegRegMove
-#endif
-isRegRegMove _ = Nothing
-
--- -----------------------------------------------------------------------------
--- Generating spill instructions
-
-mkSpillInstr
-   :: Reg		-- register to spill (should be a real)
-   -> Int		-- current stack delta
-   -> Int		-- spill slot to use
-   -> Instr
-mkSpillInstr reg delta slot
-  = ASSERT(isRealReg reg)
-    let	
-        off     = spillSlotToOffset slot
-    in
-#ifdef alpha_TARGET_ARCH
-    {-Alpha: spill below the stack pointer (?)-}
-    ST sz dyn (spRel (- (off `div` 8)))
-#endif
-#ifdef i386_TARGET_ARCH
-    let off_w = (off-delta) `div` 4
-    in case regClass reg of
-	   RcInteger -> MOV I32 (OpReg reg) (OpAddr (spRel off_w))
-	   _         -> GST F80 reg (spRel off_w) {- RcFloat/RcDouble -}
-#endif
-#ifdef x86_64_TARGET_ARCH
-    let off_w = (off-delta) `div` 8
-    in case regClass reg of
-	   RcInteger -> MOV I64 (OpReg reg) (OpAddr (spRel off_w))
-	   RcDouble  -> MOV F64 (OpReg reg) (OpAddr (spRel off_w))
-		-- ToDo: will it work to always spill as a double?
-		-- does that cause a stall if the data was a float?
-#endif
-#ifdef sparc_TARGET_ARCH
-	{-SPARC: spill below frame pointer leaving 2 words/spill-}
-                        let{off_w = 1 + (off `div` 4);
-                            sz = case regClass reg of {
-                                    RcInteger -> I32;
-				    RcFloat   -> F32;
-                                    RcDouble  -> F64}}
-                        in ST sz reg (fpRel (- off_w))
-#endif
-#ifdef powerpc_TARGET_ARCH
-    let sz = case regClass reg of
-                RcInteger -> I32
-                RcDouble -> F64
-    in ST sz reg (AddrRegImm sp (ImmInt (off-delta)))
-#endif
-
-
-mkLoadInstr
-   :: Reg		-- register to load (should be a real)
-   -> Int		-- current stack delta
-   -> Int		-- spill slot to use
-   -> Instr
-mkLoadInstr reg delta slot
-  = ASSERT(isRealReg reg)
-    let
-        off     = spillSlotToOffset slot
-    in
-#if alpha_TARGET_ARCH
-	 LD  sz dyn (spRel (- (off `div` 8)))
-#endif
-#if i386_TARGET_ARCH
-	let off_w = (off-delta) `div` 4
-        in case regClass reg of {
-              RcInteger -> MOV I32 (OpAddr (spRel off_w)) (OpReg reg);
-              _         -> GLD F80 (spRel off_w) reg} {- RcFloat/RcDouble -}
-#endif
-#if x86_64_TARGET_ARCH
-	let off_w = (off-delta) `div` 8
-        in case regClass reg of
-              RcInteger -> MOV I64 (OpAddr (spRel off_w)) (OpReg reg)
-              _         -> MOV F64 (OpAddr (spRel off_w)) (OpReg reg)
-#endif
-#if sparc_TARGET_ARCH
-        let{off_w = 1 + (off `div` 4);
-            sz = case regClass reg of {
-                   RcInteger -> I32;
-		   RcFloat   -> F32;
-                   RcDouble  -> F64}}
-        in LD sz (fpRel (- off_w)) reg
-#endif
-#if powerpc_TARGET_ARCH
-    let sz = case regClass reg of
-                RcInteger -> I32
-                RcDouble -> F64
-    in LD sz reg (AddrRegImm sp (ImmInt (off-delta)))
-#endif
-
-mkRegRegMoveInstr
-    :: Reg
-    -> Reg
-    -> Instr
-mkRegRegMoveInstr src dst
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-    = case regClass src of
-        RcInteger -> MOV wordRep (OpReg src) (OpReg dst)
-#if i386_TARGET_ARCH
-        RcDouble  -> GMOV src dst
-#else
-        RcDouble  -> MOV F64 (OpReg src) (OpReg dst)
-#endif
-#elif powerpc_TARGET_ARCH
-    = MR dst src
-#endif
-
-mkBranchInstr
-    :: BlockId
-    -> [Instr]
-#if alpha_TARGET_ARCH
-mkBranchInstr id = [BR id]
-#endif
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-mkBranchInstr id = [JXX ALWAYS id]
-#endif
-
-#if sparc_TARGET_ARCH
-mkBranchInstr (BlockId id) = [BI ALWAYS False (ImmCLbl (mkAsmTempLabel id)), NOP]
-#endif
-
-#if powerpc_TARGET_ARCH
-mkBranchInstr id = [BCC ALWAYS id]
-#endif
-
-
-spillSlotSize :: Int
-spillSlotSize = IF_ARCH_i386(12, 8)
-
-maxSpillSlots :: Int
-maxSpillSlots = ((rESERVED_C_STACK_BYTES - 64) `div` spillSlotSize) - 1
-
--- convert a spill slot number to a *byte* offset, with no sign:
--- decide on a per arch basis whether you are spilling above or below
--- the C stack pointer.
-spillSlotToOffset :: Int -> Int
-spillSlotToOffset slot
-   | slot >= 0 && slot < maxSpillSlots
-   = 64 + spillSlotSize * slot
-   | otherwise
-   = pprPanic "spillSlotToOffset:" 
-              (text "invalid spill location: " <> int slot)
diff --git a/ghc/compiler/nativeGen/RegisterAlloc.hs b/ghc/compiler/nativeGen/RegisterAlloc.hs
deleted file mode 100644
index 7d2ab1b6d6..0000000000
--- a/ghc/compiler/nativeGen/RegisterAlloc.hs
+++ /dev/null
@@ -1,1004 +0,0 @@
------------------------------------------------------------------------------
---
--- The register allocator
---
--- (c) The University of Glasgow 2004
---
------------------------------------------------------------------------------
-
-{-
-The algorithm is roughly:
- 
-  1) Compute strongly connected components of the basic block list.
-
-  2) Compute liveness (mapping from pseudo register to
-     point(s) of death?).
-
-  3) Walk instructions in each basic block.  We keep track of
-	(a) Free real registers (a bitmap?)
-	(b) Current assignment of temporaries to machine registers and/or
-	    spill slots (call this the "assignment").
-     	(c) Partial mapping from basic block ids to a virt-to-loc mapping.
-	    When we first encounter a branch to a basic block,
-	    we fill in its entry in this table with the current mapping.
-
-     For each instruction:
-	(a) For each real register clobbered by this instruction:
-	    If a temporary resides in it,
-		If the temporary is live after this instruction,
-		    Move the temporary to another (non-clobbered & free) reg,
-		    or spill it to memory.  Mark the temporary as residing
-		    in both memory and a register if it was spilled (it might
-		    need to be read by this instruction).
-	    (ToDo: this is wrong for jump instructions?)
-
-	(b) For each temporary *read* by the instruction:
-	    If the temporary does not have a real register allocation:
-		- Allocate a real register from the free list.  If
-		  the list is empty:
-		  - Find a temporary to spill.  Pick one that is
-		    not used in this instruction (ToDo: not
-		    used for a while...)
-		  - generate a spill instruction
-		- If the temporary was previously spilled,
-		  generate an instruction to read the temp from its spill loc.
-	    (optimisation: if we can see that a real register is going to
-            be used soon, then don't use it for allocation).
-
-	(c) Update the current assignment
-
-	(d) If the intstruction is a branch:
-	      if the destination block already has a register assignment,
-	        Generate a new block with fixup code and redirect the
-		jump to the new block.
-	      else,
-		Update the block id->assignment mapping with the current
-		assignment.
-
-	(e) Delete all register assignments for temps which are read
-	    (only) and die here.  Update the free register list.
-
-	(f) Mark all registers clobbered by this instruction as not free,
-	    and mark temporaries which have been spilled due to clobbering
-	    as in memory (step (a) marks then as in both mem & reg).
-
-	(g) For each temporary *written* by this instruction:
-	    Allocate a real register as for (b), spilling something
-	    else if necessary.
-		- except when updating the assignment, drop any memory
-		  locations that the temporary was previously in, since
-		  they will be no longer valid after this instruction.
-
-	(h) Delete all register assignments for temps which are
-	    written and die here (there should rarely be any).  Update
-	    the free register list.
-
-	(i) Rewrite the instruction with the new mapping.
-
-	(j) For each spilled reg known to be now dead, re-add its stack slot
-	    to the free list.
-
--}
-
-module RegisterAlloc (
-  	regAlloc
-  ) where
-
-#include "HsVersions.h"
-
-import PprMach
-import MachRegs
-import MachInstrs
-import RegAllocInfo
-import Cmm
-
-import Digraph
-import Unique		( Uniquable(getUnique), Unique )
-import UniqSet
-import UniqFM
-import UniqSupply
-import Outputable
-
-#ifndef DEBUG
-import Maybe		( fromJust )
-#endif
-import Maybe		( fromMaybe )
-import List		( nub, partition, mapAccumL, groupBy )
-import Monad		( when )
-import DATA_WORD
-import DATA_BITS
-
--- -----------------------------------------------------------------------------
--- Some useful types
-
-type RegSet = UniqSet Reg
-
-type RegMap a = UniqFM a
-emptyRegMap = emptyUFM
-
-type BlockMap a = UniqFM a
-emptyBlockMap = emptyUFM
-
--- A basic block where the isntructions are annotated with the registers
--- which are no longer live in the *next* instruction in this sequence.
--- (NB. if the instruction is a jump, these registers might still be live
--- at the jump target(s) - you have to check the liveness at the destination
--- block to find out).
-type AnnBasicBlock 
-	= GenBasicBlock (Instr,
-			 [Reg],		-- registers read (only) which die
-			 [Reg])		-- registers written which die
-
--- -----------------------------------------------------------------------------
--- The free register set
-
--- This needs to be *efficient*
-
-{- Here's an inefficient 'executable specification' of the FreeRegs data type:
-type FreeRegs = [RegNo]
-
-noFreeRegs = 0
-releaseReg n f = if n `elem` f then f else (n : f)
-initFreeRegs = allocatableRegs
-getFreeRegs cls f = filter ( (==cls) . regClass . RealReg ) f
-allocateReg f r = filter (/= r) f
--}
-
-#if defined(powerpc_TARGET_ARCH)
-
--- The PowerPC has 32 integer and 32 floating point registers.
--- This is 32bit PowerPC, so Word64 is inefficient - two Word32s are much
--- better.
--- Note that when getFreeRegs scans for free registers, it starts at register
--- 31 and counts down. This is a hack for the PowerPC - the higher-numbered
--- registers are callee-saves, while the lower regs are caller-saves, so it
--- makes sense to start at the high end.
--- Apart from that, the code does nothing PowerPC-specific, so feel free to
--- add your favourite platform to the #if (if you have 64 registers but only
--- 32-bit words).
-
-data FreeRegs = FreeRegs !Word32 !Word32
-	      deriving( Show )	-- The Show is used in an ASSERT
-
-noFreeRegs :: FreeRegs
-noFreeRegs = FreeRegs 0 0
-
-releaseReg :: RegNo -> FreeRegs -> FreeRegs
-releaseReg r (FreeRegs g f)
-    | r > 31    = FreeRegs g (f .|. (1 `shiftL` (fromIntegral r - 32)))
-    | otherwise = FreeRegs (g .|. (1 `shiftL` fromIntegral r)) f
-    
-initFreeRegs :: FreeRegs
-initFreeRegs = foldr releaseReg noFreeRegs allocatableRegs
-
-getFreeRegs :: RegClass -> FreeRegs -> [RegNo]	-- lazilly
-getFreeRegs cls (FreeRegs g f)
-    | RcDouble <- cls = go f (0x80000000) 63
-    | RcInteger <- cls = go g (0x80000000) 31
-    where
-        go x 0 i = []
-        go x m i | x .&. m /= 0 = i : (go x (m `shiftR` 1) $! i-1)
-                 | otherwise    = go x (m `shiftR` 1) $! i-1
-
-allocateReg :: RegNo -> FreeRegs -> FreeRegs
-allocateReg r (FreeRegs g f) 
-    | r > 31    = FreeRegs g (f .&. complement (1 `shiftL` (fromIntegral r - 32)))
-    | otherwise = FreeRegs (g .&. complement (1 `shiftL` fromIntegral r)) f
-
-#else
-
--- If we have less than 32 registers, or if we have efficient 64-bit words,
--- we will just use a single bitfield.
-
-#if defined(alpha_TARGET_ARCH)
-type FreeRegs = Word64
-#else
-type FreeRegs = Word32
-#endif
-
-noFreeRegs :: FreeRegs
-noFreeRegs = 0
-
-releaseReg :: RegNo -> FreeRegs -> FreeRegs
-releaseReg n f = f .|. (1 `shiftL` n)
-
-initFreeRegs :: FreeRegs
-initFreeRegs = foldr releaseReg noFreeRegs allocatableRegs
-
-getFreeRegs :: RegClass -> FreeRegs -> [RegNo]	-- lazilly
-getFreeRegs cls f = go f 0
-  where go 0 m = []
-        go n m 
-	  | n .&. 1 /= 0 && regClass (RealReg m) == cls
-	  = m : (go (n `shiftR` 1) $! (m+1))
-	  | otherwise
-	  = go (n `shiftR` 1) $! (m+1)
-	-- ToDo: there's no point looking through all the integer registers
-	-- in order to find a floating-point one.
-
-allocateReg :: RegNo -> FreeRegs -> FreeRegs
-allocateReg r f = f .&. complement (1 `shiftL` fromIntegral r)
-
-#endif
-
--- -----------------------------------------------------------------------------
--- The free list of stack slots
-
--- This doesn't need to be so efficient.  It also doesn't really need to be
--- maintained as a set, so we just use an ordinary list (lazy, because it
--- contains all the possible stack slots and there are lots :-).
--- We do one more thing here: We make sure that we always use the same stack
--- slot to spill the same temporary. That way, the stack slot assignments
--- will always match up and we never need to worry about memory-to-memory
--- moves when generating fixup code.
-
-type StackSlot = Int
-data FreeStack = FreeStack [StackSlot] (UniqFM StackSlot)
-
-completelyFreeStack :: FreeStack
-completelyFreeStack = FreeStack [0..maxSpillSlots] emptyUFM
-
-getFreeStackSlot :: FreeStack -> (FreeStack,Int)
-getFreeStackSlot (FreeStack (slot:stack) reserved)
-    = (FreeStack stack reserved,slot)
-
-freeStackSlot :: FreeStack -> Int -> FreeStack
-freeStackSlot (FreeStack stack reserved) slot
-    -- NOTE: This is probably terribly, unthinkably slow.
-    --       But on the other hand, it never gets called, because the allocator
-    --       currently does not free stack slots. So who cares if it's slow?
-    | slot `elem` eltsUFM reserved = FreeStack stack reserved
-    | otherwise = FreeStack (slot:stack) reserved
-
-
-getFreeStackSlotFor :: FreeStack -> Unique -> (FreeStack,Int)
-getFreeStackSlotFor fs@(FreeStack _ reserved) reg =
-    case lookupUFM reserved reg of
-    	Just slot -> (fs,slot)
-    	Nothing -> let (FreeStack stack' _, slot) = getFreeStackSlot fs
-    	           in  (FreeStack stack' (addToUFM reserved reg slot), slot)
-
--- -----------------------------------------------------------------------------
--- Top level of the register allocator
-
-regAlloc :: NatCmmTop -> UniqSM NatCmmTop
-regAlloc (CmmData sec d) = returnUs $ CmmData sec d
-regAlloc (CmmProc info lbl params [])
-  = returnUs $ CmmProc info lbl params []  -- no blocks to run the regalloc on
-regAlloc (CmmProc info lbl params blocks@(first:rest))
-  = let
-        first_id               = blockId first
-        sccs	               = sccBlocks blocks
-        (ann_sccs, block_live) = computeLiveness sccs
-    in  linearRegAlloc block_live ann_sccs `thenUs` \final_blocks ->
-    let ((first':_),rest')     = partition ((== first_id) . blockId) final_blocks
-    in returnUs $ -- pprTrace "Liveness" (ppr block_live) $
-                  CmmProc info lbl params (first':rest')
-
-sccBlocks :: [NatBasicBlock] -> [SCC NatBasicBlock]
-sccBlocks blocks = stronglyConnComp graph
-  where
-	getOutEdges :: [Instr] -> [BlockId]
-	getOutEdges instrs = foldr jumpDests [] instrs
-
-	graph = [ (block, getUnique id, map getUnique (getOutEdges instrs))
-		| block@(BasicBlock id instrs) <- blocks ]
-
-
--- -----------------------------------------------------------------------------
--- Computing liveness
-
-computeLiveness
-   :: [SCC NatBasicBlock]
-   -> ([SCC AnnBasicBlock],	-- instructions annotated with list of registers
-				-- which are "dead after this instruction".
-       BlockMap RegSet)		-- blocks annontated with set of live registers
-				-- on entry to the block.
-
-  -- NOTE: on entry, the SCCs are in "reverse" order: later blocks may transfer
-  -- control to earlier ones only.  The SCCs returned are in the *opposite* 
-  -- order, which is exactly what we want for the next pass.
-	
-computeLiveness sccs
-  = livenessSCCs emptyBlockMap [] sccs
-  where
-  livenessSCCs 
-	 :: BlockMap RegSet 
-	 -> [SCC AnnBasicBlock]		-- accum
-	 -> [SCC NatBasicBlock]
-	 -> ([SCC AnnBasicBlock], BlockMap RegSet)
-
-  livenessSCCs blockmap done [] = (done, blockmap)
-  livenessSCCs blockmap done
-	(AcyclicSCC (BasicBlock block_id instrs) : sccs) =
-	  {- pprTrace "live instrs" (ppr (getUnique block_id) $$
-				  vcat (map (\(instr,regs) -> docToSDoc (pprInstr instr) $$ ppr regs) instrs')) $ 
-	  -}
-	  livenessSCCs blockmap'
-		(AcyclicSCC (BasicBlock block_id instrs'):done) sccs
-	where (live,instrs') = liveness emptyUniqSet blockmap []
-					(reverse instrs)
-	      blockmap' = addToUFM blockmap block_id live
-
-  livenessSCCs blockmap done
-	(CyclicSCC blocks : sccs) =
-	  livenessSCCs blockmap' (CyclicSCC blocks':done) sccs
-	where (blockmap', blocks')
-	          = iterateUntilUnchanged linearLiveness equalBlockMaps
-	                                blockmap blocks
-
-              iterateUntilUnchanged
-                  :: (a -> b -> (a,c)) -> (a -> a -> Bool)
-                  -> a -> b
-                  -> (a,c)
-
-	      iterateUntilUnchanged f eq a b
-	          = head $
-	            concatMap tail $
-	            groupBy (\(a1, _) (a2, _) -> eq a1 a2) $
-	            iterate (\(a, _) -> f a b) $
-	            (a, error "RegisterAlloc.livenessSCCs")
-
-
-              linearLiveness :: BlockMap RegSet -> [NatBasicBlock]
-                             -> (BlockMap RegSet, [AnnBasicBlock])
-              linearLiveness = mapAccumL processBlock
-
-	      processBlock blockmap input@(BasicBlock block_id instrs)
-                  = (blockmap', BasicBlock block_id instrs')
-	        where (live,instrs') = liveness emptyUniqSet blockmap []
-	                                        (reverse instrs)
-        	      blockmap' = addToUFM blockmap block_id live
-
-                  -- probably the least efficient way to compare two
-                  -- BlockMaps for equality.
-	      equalBlockMaps a b
-	          = a' == b'
-	        where a' = map f $ ufmToList a
-	              b' = map f $ ufmToList b
-	              f (key,elt) = (key, uniqSetToList elt)
-
-  liveness :: RegSet			-- live regs
-	   -> BlockMap RegSet   	-- live regs on entry to other BBs
-	   -> [(Instr,[Reg],[Reg])]   	-- instructions (accum)
-	   -> [Instr]			-- instructions
-	   -> (RegSet, [(Instr,[Reg],[Reg])])
-
-  liveness liveregs blockmap done []  = (liveregs, done)
-  liveness liveregs blockmap done (instr:instrs) 
- 	= liveness liveregs2 blockmap ((instr,r_dying,w_dying):done) instrs
-	where 
-	      RU read written = regUsage instr
-
-	      -- registers that were written here are dead going backwards.
-	      -- registers that were read here are live going backwards.
-	      liveregs1 = (liveregs `delListFromUniqSet` written)
-				    `addListToUniqSet` read
-
-	      -- union in the live regs from all the jump destinations of this
-	      -- instruction.
-	      targets = jumpDests instr [] -- where we go from here
-	      liveregs2 = unionManyUniqSets
-			    (liveregs1 : map targetLiveRegs targets)
-
-              targetLiveRegs target = case lookupUFM blockmap target of
-                                        Just ra -> ra
-                                        Nothing -> emptyBlockMap
-
-	      -- registers that are not live beyond this point, are recorded
-	      --  as dying here.
-	      r_dying  = [ reg | reg <- read, reg `notElem` written,
-			         not (elementOfUniqSet reg liveregs) ]
-
-	      w_dying = [ reg | reg <- written,
-			        not (elementOfUniqSet reg liveregs) ]
-
-
--- -----------------------------------------------------------------------------
--- Linear sweep to allocate registers
-
-data Loc = InReg   {-# UNPACK #-} !RegNo
-	 | InMem   {-# UNPACK #-} !Int		-- stack slot
-	 | InBoth  {-# UNPACK #-} !RegNo
-		   {-# UNPACK #-} !Int		-- stack slot
-  deriving (Eq, Show, Ord)
-
-{- 
-A temporary can be marked as living in both a register and memory
-(InBoth), for example if it was recently loaded from a spill location.
-This makes it cheap to spill (no save instruction required), but we
-have to be careful to turn this into InReg if the value in the
-register is changed.
-
-This is also useful when a temporary is about to be clobbered.  We
-save it in a spill location, but mark it as InBoth because the current
-instruction might still want to read it.
--}
-
-#ifdef DEBUG
-instance Outputable Loc where
-  ppr l = text (show l)
-#endif
-
-linearRegAlloc
-   :: BlockMap RegSet		-- live regs on entry to each basic block
-   -> [SCC AnnBasicBlock]	-- instructions annotated with "deaths"
-   -> UniqSM [NatBasicBlock]
-linearRegAlloc block_live sccs = linearRA_SCCs emptyBlockMap sccs
-  where
-  linearRA_SCCs
-	:: BlockAssignment
-	-> [SCC AnnBasicBlock]
-	-> UniqSM [NatBasicBlock]
-  linearRA_SCCs block_assig [] = returnUs []
-  linearRA_SCCs block_assig 
-	(AcyclicSCC (BasicBlock id instrs) : sccs) 
-	= getUs `thenUs` \us ->
-	  let
-            (block_assig',(instrs',fixups)) =
-               case lookupUFM block_assig id of
-                    -- no prior info about this block: assume everything is
-                    -- free and the assignment is empty.
-                    Nothing ->
-                        runR block_assig initFreeRegs
-                                    emptyRegMap completelyFreeStack us $
-                            linearRA [] [] instrs
-                    Just (freeregs,stack,assig) ->
-                       runR block_assig freeregs assig stack us $
-                            linearRA [] [] instrs
-	  in
-	  linearRA_SCCs block_assig' sccs `thenUs` \moreBlocks ->
-	  returnUs $ BasicBlock id instrs' : fixups ++ moreBlocks
-
-  linearRA_SCCs block_assig 
-	(CyclicSCC blocks : sccs) 
-	= getUs `thenUs` \us ->
-	  let
-            ((block_assig', us'), blocks') = mapAccumL processBlock
-                                                       (block_assig, us)
-                                                       ({-reverse-} blocks)
-          in
-	  linearRA_SCCs block_assig' sccs `thenUs` \moreBlocks ->
-	  returnUs $ concat blocks' ++ moreBlocks
-    where
-        processBlock (block_assig, us0) (BasicBlock id instrs)
-          = ((block_assig', us'), BasicBlock id instrs' : fixups)
-          where
-                (us, us') = splitUniqSupply us0
-                (block_assig',(instrs',fixups)) = 
-                   case lookupUFM block_assig id of
-                        -- no prior info about this block: assume everything is
-                        -- free and the assignment is empty.
-                        Nothing -> 
-                           runR block_assig initFreeRegs 
-                                        emptyRegMap completelyFreeStack us $
-                                linearRA [] [] instrs 
-                        Just (freeregs,stack,assig) -> 
-                           runR block_assig freeregs assig stack us $
-                                linearRA [] [] instrs 
-
-  linearRA :: [Instr] -> [NatBasicBlock] -> [(Instr,[Reg],[Reg])]
-	-> RegM ([Instr], [NatBasicBlock])
-  linearRA instr_acc fixups [] = 
-    return (reverse instr_acc, fixups)
-  linearRA instr_acc fixups (instr:instrs) = do
-    (instr_acc', new_fixups) <- raInsn block_live instr_acc instr
-    linearRA instr_acc' (new_fixups++fixups) instrs
-
--- -----------------------------------------------------------------------------
--- Register allocation for a single instruction
-
-type BlockAssignment = BlockMap (FreeRegs, FreeStack, RegMap Loc)
-
-raInsn  :: BlockMap RegSet		-- Live temporaries at each basic block
-	-> [Instr]			-- new instructions (accum.)
-	-> (Instr,[Reg],[Reg])		-- the instruction (with "deaths")
-	-> RegM (
-	     [Instr],			-- new instructions
-	     [NatBasicBlock]		-- extra fixup blocks
-	   )
-
-raInsn block_live new_instrs (instr@(DELTA n), _, _) = do
-    setDeltaR n
-    return (new_instrs, [])
-
-raInsn block_live new_instrs (instr, r_dying, w_dying) = do
-    assig    <- getAssigR
-
-    -- If we have a reg->reg move between virtual registers, where the
-    -- src register is not live after this instruction, and the dst
-    -- register does not already have an assignment, then we can
-    -- eliminate the instruction.
-    case isRegRegMove instr of
-	Just (src,dst)
-		| src `elem` r_dying, 
-		  isVirtualReg dst,
-		  Just loc <- lookupUFM assig src,
-	 	  not (dst `elemUFM` assig) -> do
-			setAssigR (addToUFM (delFromUFM assig src) dst loc)
-			return (new_instrs, [])
-
-	other -> genRaInsn block_live new_instrs instr r_dying w_dying
-
-
-genRaInsn block_live new_instrs instr r_dying w_dying =
-    case regUsage instr              of { RU read written ->
-    case partition isRealReg written of { (real_written1,virt_written) ->
-    do
-    let 
-	real_written = [ r | RealReg r <- real_written1 ]
-
-	-- we don't need to do anything with real registers that are
-	-- only read by this instr.  (the list is typically ~2 elements,
-	-- so using nub isn't a problem).
-	virt_read = nub (filter isVirtualReg read)
-    -- in
-
-    -- (a) save any temporaries which will be clobbered by this instruction
-    clobber_saves <- saveClobberedTemps real_written r_dying
-
-    {-
-    freeregs <- getFreeRegsR
-    assig <- getAssigR
-    pprTrace "raInsn" (docToSDoc (pprInstr instr) $$ ppr r_dying <+> ppr w_dying $$ ppr virt_read <+> ppr virt_written $$ text (show freeregs) $$ ppr assig) $ do
-    -}
-
-    -- (b), (c) allocate real regs for all regs read by this instruction.
-    (r_spills, r_allocd) <- 
-	allocateRegsAndSpill True{-reading-} virt_read [] [] virt_read
-
-    -- (d) Update block map for new destinations
-    -- NB. do this before removing dead regs from the assignment, because
-    -- these dead regs might in fact be live in the jump targets (they're
-    -- only dead in the code that follows in the current basic block).
-    (fixup_blocks, adjusted_instr)
-	<- joinToTargets block_live [] instr (jumpDests instr [])
-
-    -- (e) Delete all register assignments for temps which are read
-    --     (only) and die here.  Update the free register list.
-    releaseRegs r_dying
-
-    -- (f) Mark regs which are clobbered as unallocatable
-    clobberRegs real_written
-
-    -- (g) Allocate registers for temporaries *written* (only)
-    (w_spills, w_allocd) <- 
-	allocateRegsAndSpill False{-writing-} virt_written [] [] virt_written
-
-    -- (h) Release registers for temps which are written here and not
-    -- used again.
-    releaseRegs w_dying
-
-    let
-	-- (i) Patch the instruction
-	patch_map = listToUFM   [ (t,RealReg r) | 
-				  (t,r) <- zip virt_read r_allocd
-					  ++ zip virt_written w_allocd ]
-
-	patched_instr = patchRegs adjusted_instr patchLookup
-	patchLookup x = case lookupUFM patch_map x of
-				Nothing -> x
-				Just y  -> y
-    -- in
-
-    -- pprTrace "patched" (docToSDoc (pprInstr patched_instr)) $ do
-
-    -- (j) free up stack slots for dead spilled regs
-    -- TODO (can't be bothered right now)
-
-    return (patched_instr : w_spills ++ reverse r_spills
-		 ++ clobber_saves ++ new_instrs,
-	    fixup_blocks)
-  }}
-
--- -----------------------------------------------------------------------------
--- releaseRegs
-
-releaseRegs regs = do
-  assig <- getAssigR
-  free <- getFreeRegsR
-  loop assig free regs 
- where
-  loop assig free _ | free `seq` False = undefined
-  loop assig free [] = do setAssigR assig; setFreeRegsR free; return ()
-  loop assig free (RealReg r : rs) = loop assig (releaseReg r free) rs
-  loop assig free (r:rs) = 
-     case lookupUFM assig r of
-	Just (InBoth real _) -> loop (delFromUFM assig r) (releaseReg real free) rs
-	Just (InReg real) -> loop (delFromUFM assig r) (releaseReg real free) rs
-	_other            -> loop (delFromUFM assig r) free rs
-
--- -----------------------------------------------------------------------------
--- Clobber real registers
-
-{-
-For each temp in a register that is going to be clobbered:
-  - if the temp dies after this instruction, do nothing
-  - otherwise, put it somewhere safe (another reg if possible,
-    otherwise spill and record InBoth in the assignment).
-
-for allocateRegs on the temps *read*,
-  - clobbered regs are allocatable.
-
-for allocateRegs on the temps *written*, 
-  - clobbered regs are not allocatable.
--}
-
-saveClobberedTemps
-   :: [RegNo]		   -- real registers clobbered by this instruction
-   -> [Reg]		   -- registers which are no longer live after this insn
-   -> RegM [Instr] 	   -- return: instructions to spill any temps that will
-		 	   -- be clobbered.
-
-saveClobberedTemps [] _ = return [] -- common case
-saveClobberedTemps clobbered dying =  do
-  assig <- getAssigR
-  let
-	to_spill  = [ (temp,reg) | (temp, InReg reg) <- ufmToList assig,
-				   reg `elem` clobbered,
-				   temp `notElem` map getUnique dying  ]
-  -- in
-  (instrs,assig') <- clobber assig [] to_spill
-  setAssigR assig'
-  return instrs
- where
-  clobber assig instrs [] = return (instrs,assig)
-  clobber assig instrs ((temp,reg):rest)
-    = do
-	--ToDo: copy it to another register if possible
-      (spill,slot) <- spillR (RealReg reg) temp
-      clobber (addToUFM assig temp (InBoth reg slot)) (spill:instrs) rest
-
-clobberRegs :: [RegNo] -> RegM ()
-clobberRegs [] = return () -- common case
-clobberRegs clobbered = do
-  freeregs <- getFreeRegsR
-  setFreeRegsR $! foldr allocateReg freeregs clobbered
-  assig <- getAssigR
-  setAssigR $! clobber assig (ufmToList assig)
- where
-    -- if the temp was InReg and clobbered, then we will have
-    -- saved it in saveClobberedTemps above.  So the only case
-    -- we have to worry about here is InBoth.  Note that this
-    -- also catches temps which were loaded up during allocation
-    -- of read registers, not just those saved in saveClobberedTemps.
-  clobber assig [] = assig
-  clobber assig ((temp, InBoth reg slot) : rest)
-	| reg `elem` clobbered
-	= clobber (addToUFM assig temp (InMem slot)) rest
-  clobber assig (entry:rest)
-	= clobber assig rest 
-
--- -----------------------------------------------------------------------------
--- allocateRegsAndSpill
-
--- This function does several things:
---   For each temporary referred to by this instruction,
---   we allocate a real register (spilling another temporary if necessary).
---   We load the temporary up from memory if necessary.
---   We also update the register assignment in the process, and
---   the list of free registers and free stack slots.
-
-allocateRegsAndSpill
-	:: Bool			-- True <=> reading (load up spilled regs)
-	-> [Reg]		-- don't push these out
-	-> [Instr]		-- spill insns
-	-> [RegNo]		-- real registers allocated (accum.)
-	-> [Reg]		-- temps to allocate
-	-> RegM ([Instr], [RegNo])
-
-allocateRegsAndSpill reading keep spills alloc []
-  = return (spills,reverse alloc)
-
-allocateRegsAndSpill reading keep spills alloc (r:rs) = do
-  assig <- getAssigR
-  case lookupUFM assig r of
-  -- case (1a): already in a register
-     Just (InReg my_reg) ->
-	allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
-
-  -- case (1b): already in a register (and memory)
-  -- NB1. if we're writing this register, update its assignemnt to be
-  -- InReg, because the memory value is no longer valid.
-  -- NB2. This is why we must process written registers here, even if they
-  -- are also read by the same instruction.
-     Just (InBoth my_reg mem) -> do
-	when (not reading) (setAssigR (addToUFM assig r (InReg my_reg)))
-   	allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
-
-  -- Not already in a register, so we need to find a free one...
-     loc -> do
-	freeregs <- getFreeRegsR
-
-        case getFreeRegs (regClass r) freeregs of
-
-      	-- case (2): we have a free register
-      	  my_reg:_ -> do
-    	    spills'   <- do_load reading loc my_reg spills
-	    let new_loc 
-		 | Just (InMem slot) <- loc, reading = InBoth my_reg slot
-		 | otherwise		             = InReg my_reg
-	    setAssigR (addToUFM assig r $! new_loc)
-	    setFreeRegsR (allocateReg my_reg freeregs)
-    	    allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
-
-        -- case (3): we need to push something out to free up a register
-          [] -> do
-	    let
-	      keep' = map getUnique keep
-	      candidates1 = [ (temp,reg,mem)
-			    | (temp, InBoth reg mem) <- ufmToList assig,
-			      temp `notElem` keep', regClass (RealReg reg) == regClass r ]
-	      candidates2 = [ (temp,reg)
-			    | (temp, InReg reg) <- ufmToList assig,
-			      temp `notElem` keep', regClass (RealReg reg) == regClass r  ]
-	    -- in
-	    ASSERT2(not (null candidates1 && null candidates2), 
-		    text (show freeregs) <+> ppr r <+> ppr assig) do
-
-	    case candidates1 of
-
-	     -- we have a temporary that is in both register and mem,
-	     -- just free up its register for use.
-	     -- 
-	     (temp,my_reg,slot):_ -> do
-    	        spills' <- do_load reading loc my_reg spills
-    	        let	
-	          assig1  = addToUFM assig temp (InMem slot)
-	          assig2  = addToUFM assig1 r (InReg my_reg)
- 	        -- in
-		setAssigR assig2
-		allocateRegsAndSpill reading keep spills' (my_reg:alloc) rs
-
-	     -- otherwise, we need to spill a temporary that currently
-	     -- resides in a register.
-	     [] -> do
-	        let
-	          (temp_to_push_out, my_reg) = myHead "regalloc" candidates2
-	          -- TODO: plenty of room for optimisation in choosing which temp
-	          -- to spill.  We just pick the first one that isn't used in 
-	          -- the current instruction for now.
-	        -- in
-    	        (spill_insn,slot) <- spillR (RealReg my_reg) temp_to_push_out
-    	        let	
-	          assig1  = addToUFM assig temp_to_push_out (InMem slot)
-	          assig2  = addToUFM assig1 r (InReg my_reg)
- 	        -- in
-	        setAssigR assig2
-    	        spills' <- do_load reading loc my_reg spills
-    	        allocateRegsAndSpill reading keep (spill_insn:spills')
-		 	(my_reg:alloc) rs
-  where
-	-- load up a spilled temporary if we need to
-	do_load True (Just (InMem slot)) reg spills = do
-           insn <- loadR (RealReg reg) slot
-	   return (insn : spills)
-	do_load _ _ _ spills = 
-	   return spills
-
-myHead s [] = panic s
-myHead s (x:xs) = x
-
--- -----------------------------------------------------------------------------
--- Joining a jump instruction to its targets
-
--- The first time we encounter a jump to a particular basic block, we
--- record the assignment of temporaries.  The next time we encounter a
--- jump to the same block, we compare our current assignment to the
--- stored one.  They might be different if spilling has occrred in one
--- branch; so some fixup code will be required to match up the
--- assignments.
-
-joinToTargets
-	:: BlockMap RegSet
-	-> [NatBasicBlock]
-	-> Instr
-	-> [BlockId]
-	-> RegM ([NatBasicBlock], Instr)
-
-joinToTargets block_live new_blocks instr []
-  = return (new_blocks, instr)
-joinToTargets block_live new_blocks instr (dest:dests) = do
-  block_assig <- getBlockAssigR
-  assig <- getAssigR
-  let
-	-- adjust the assignment to remove any registers which are not
-	-- live on entry to the destination block.
-	adjusted_assig = filterUFM_Directly still_live assig
-	still_live uniq _ = uniq `elemUniqSet_Directly` live_set
-
-	-- and free up those registers which are now free.
-	to_free =
-	  [ r | (reg, loc) <- ufmToList assig, 
-		not (elemUniqSet_Directly reg live_set), 
-		r <- regsOfLoc loc ]
-
-	regsOfLoc (InReg r)    = [r]
-	regsOfLoc (InBoth r _) = [r]
-	regsOfLoc (InMem _)    = []
-  -- in
-  case lookupUFM block_assig dest of
-	-- Nothing <=> this is the first time we jumped to this
-	-- block.
-	Nothing -> do
-	  freeregs <- getFreeRegsR
-	  let freeregs' = foldr releaseReg freeregs to_free 
- 	  stack <- getStackR
-	  setBlockAssigR (addToUFM block_assig dest 
-				(freeregs',stack,adjusted_assig))
-	  joinToTargets block_live new_blocks instr dests
-
-	Just (freeregs,stack,dest_assig)
-	   | ufmToList dest_assig == ufmToList adjusted_assig
-	   -> -- ok, the assignments match
-	     joinToTargets block_live new_blocks instr dests
-	   | otherwise
-	   -> -- need fixup code
-	     do
-	       delta <- getDeltaR
-	       -- Construct a graph of register/spill movements and
-	       -- untangle it component by component.
-	       -- 
-	       -- We cut some corners by
-	       -- a) not handling cyclic components
-	       -- b) not handling memory-to-memory moves.
-	       --
-	       -- Cyclic components seem to occur only very rarely,
-	       -- and we don't need memory-to-memory moves because we
-	       -- make sure that every temporary always gets its own
-	       -- stack slot.
-	       
-	       let graph = [ (loc0, loc0,
-	                       [lookupWithDefaultUFM_Directly
-                                    dest_assig
-                                    (panic "RegisterAlloc.joinToTargets")
-                                    vreg]
-                                    )
-	                   | (vreg, loc0) <- ufmToList adjusted_assig ]
-	           sccs = stronglyConnCompR graph
-	           
-	           handleComponent (CyclicSCC [one]) = []
-	           handleComponent (AcyclicSCC (src,_,[dst]))
-	               = makeMove src dst
-	           handleComponent (CyclicSCC things)
-	               = panic $ "Register Allocator: handleComponent: cyclic"
-	                         ++ " (workaround: use -fviaC)"
-	           
-	           makeMove (InReg src) (InReg dst)
-	               = [mkRegRegMoveInstr (RealReg src) (RealReg dst)]
-	     	   makeMove (InMem src) (InReg dst)
-	     	       = [mkLoadInstr (RealReg dst) delta src]
-	     	   makeMove (InReg src) (InMem dst)
-	     	       = [mkSpillInstr (RealReg src) delta dst]
-	     	   
-	     	   makeMove (InBoth src _) (InReg dst)
-	     	       | src == dst = []
-	     	   makeMove (InBoth _ src) (InMem dst)
-	     	       | src == dst = []
-	     	   makeMove (InBoth src _) dst
-	     	       = makeMove (InReg src) dst
-                   makeMove (InReg src) (InBoth dstR dstM)
-                       | src == dstR
-                       = makeMove (InReg src) (InMem dstM)
-                       | otherwise
-                       = makeMove (InReg src) (InReg dstR)
-                       ++ makeMove (InReg src) (InMem dstM)
-	     	   
-	     	   makeMove src dst
-	     	       = panic $ "makeMove (" ++ show src ++ ") ("
-	     	                 ++ show dst ++ ")"
-	                         ++ " (workaround: use -fviaC)"
-	     
-	       block_id <- getUniqueR
-	       let block = BasicBlock (BlockId block_id) $
-	               concatMap handleComponent sccs ++ mkBranchInstr dest
-	       let instr' = patchJump instr dest (BlockId block_id)
-	       joinToTargets block_live (block : new_blocks) instr' dests
-  where
-	live_set = lookItUp "joinToTargets" block_live dest
-
--- -----------------------------------------------------------------------------
--- The register allocator's monad.  
-
--- Here we keep all the state that the register allocator keeps track
--- of as it walks the instructions in a basic block.
-
-data RA_State 
-  = RA_State {
-	ra_blockassig :: BlockAssignment,
-		-- The current mapping from basic blocks to 
-		-- the register assignments at the beginning of that block.
-	ra_freeregs   :: {-#UNPACK#-}!FreeRegs,	-- free machine registers
-	ra_assig      :: RegMap Loc,	-- assignment of temps to locations
-	ra_delta      :: Int,		-- current stack delta
-	ra_stack      :: FreeStack,	-- free stack slots for spilling
-	ra_us         :: UniqSupply     -- unique supply for generating names
-	                                -- for fixup blocks.
-  }
-
-newtype RegM a = RegM { unReg :: RA_State -> (# RA_State, a #) }
-
-instance Monad RegM where
-  m >>= k   =  RegM $ \s -> case unReg m s of { (# s, a #) -> unReg (k a) s }
-  return a  =  RegM $ \s -> (# s, a #)
-
-runR :: BlockAssignment -> FreeRegs -> RegMap Loc -> FreeStack -> UniqSupply
-  -> RegM a -> (BlockAssignment, a)
-runR block_assig freeregs assig stack us thing =
-  case unReg thing (RA_State{ ra_blockassig=block_assig, ra_freeregs=freeregs,
-			ra_assig=assig, ra_delta=0{-???-}, ra_stack=stack,
-			ra_us = us }) of
-	(# RA_State{ ra_blockassig=block_assig }, returned_thing #)
-		-> (block_assig, returned_thing)
-
-spillR :: Reg -> Unique -> RegM (Instr, Int)
-spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
-  let (stack',slot) = getFreeStackSlotFor stack temp
-      instr  = mkSpillInstr reg delta slot
-  in
-  (# s{ra_stack=stack'}, (instr,slot) #)
-
-loadR :: Reg -> Int -> RegM Instr
-loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack} ->
-  (# s, mkLoadInstr reg delta slot #)
-
-freeSlotR :: Int -> RegM ()
-freeSlotR slot = RegM $ \ s@RA_State{ra_stack=stack} ->
-  (# s{ra_stack=freeStackSlot stack slot}, () #)
-
-getFreeRegsR :: RegM FreeRegs
-getFreeRegsR = RegM $ \ s@RA_State{ra_freeregs = freeregs} ->
-  (# s, freeregs #)
-
-setFreeRegsR :: FreeRegs -> RegM ()
-setFreeRegsR regs = RegM $ \ s ->
-  (# s{ra_freeregs = regs}, () #)
-
-getAssigR :: RegM (RegMap Loc)
-getAssigR = RegM $ \ s@RA_State{ra_assig = assig} ->
-  (# s, assig #)
-
-setAssigR :: RegMap Loc -> RegM ()
-setAssigR assig = RegM $ \ s ->
-  (# s{ra_assig=assig}, () #)
-
-getStackR :: RegM FreeStack
-getStackR = RegM $ \ s@RA_State{ra_stack = stack} ->
-  (# s, stack #)
-
-setStackR :: FreeStack -> RegM ()
-setStackR stack = RegM $ \ s ->
-  (# s{ra_stack=stack}, () #)
-
-getBlockAssigR :: RegM BlockAssignment
-getBlockAssigR = RegM $ \ s@RA_State{ra_blockassig = assig} ->
-  (# s, assig #)
-
-setBlockAssigR :: BlockAssignment -> RegM ()
-setBlockAssigR assig = RegM $ \ s ->
-  (# s{ra_blockassig = assig}, () #)
-
-setDeltaR :: Int -> RegM ()
-setDeltaR n = RegM $ \ s ->
-  (# s{ra_delta = n}, () #)
-
-getDeltaR :: RegM Int
-getDeltaR = RegM $ \s -> (# s, ra_delta s #)
-
-getUniqueR :: RegM Unique
-getUniqueR = RegM $ \s ->
-  case splitUniqSupply (ra_us s) of
-    (us1, us2) -> (# s{ra_us = us2}, uniqFromSupply us1 #)
-
--- -----------------------------------------------------------------------------
--- Utils
-
-#ifdef DEBUG
-my_fromJust s p Nothing  = pprPanic ("fromJust: " ++ s) p
-my_fromJust s p (Just x) = x
-#else
-my_fromJust _ _ = fromJust
-#endif
-
-lookItUp :: Uniquable b => String -> UniqFM a -> b -> a
-lookItUp str fm x = my_fromJust str (ppr (getUnique x)) (lookupUFM fm x)
diff --git a/ghc/compiler/ndpFlatten/FlattenInfo.hs b/ghc/compiler/ndpFlatten/FlattenInfo.hs
deleted file mode 100644
index f759242455..0000000000
--- a/ghc/compiler/ndpFlatten/FlattenInfo.hs
+++ /dev/null
@@ -1,43 +0,0 @@
---  $Id$
---
---  Copyright (c) 2002 Manuel M T Chakravarty & Gabriele Keller
---
---  Information for modules outside of the flattening module collection.
---
---- DESCRIPTION ---------------------------------------------------------------
---
---  This module contains information that is needed, and thus imported, by
---  modules that are otherwise independent of flattening and may in fact be
---  directly or indirectly imported by some of the flattening-related
---  modules.  This is to avoid cyclic module dependencies.
--- 
---- DOCU ----------------------------------------------------------------------
---
---  Language: Haskell 98
---
---- TODO ----------------------------------------------------------------------
---
-
-module FlattenInfo (
-  namesNeededForFlattening
-) where
-
-import StaticFlags (opt_Flatten)
-import NameSet     (FreeVars, emptyFVs, mkFVs)
-import PrelNames   (fstName, andName, orName, lengthPName, replicatePName,
-		    mapPName, bpermutePName, bpermuteDftPName, indexOfPName)
-
-
--- this is a list of names that need to be available if flattening is
--- performed (EXPORTED)
---
---  * needs to be kept in sync with the names used in Core generation in
---   `FlattenMonad' and `NDPCoreUtils'
---
-namesNeededForFlattening :: FreeVars
-namesNeededForFlattening
-  | not opt_Flatten = emptyFVs		-- none without -fflatten
-  | otherwise
-  = mkFVs [fstName, andName, orName, lengthPName, replicatePName, mapPName,
-	   bpermutePName, bpermuteDftPName, indexOfPName]
-    -- stuff from PrelGHC doesn't have to go here
diff --git a/ghc/compiler/ndpFlatten/FlattenMonad.hs b/ghc/compiler/ndpFlatten/FlattenMonad.hs
deleted file mode 100644
index 45405088fc..0000000000
--- a/ghc/compiler/ndpFlatten/FlattenMonad.hs
+++ /dev/null
@@ -1,451 +0,0 @@
---  $Id$
---
---  Copyright (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller
---
---  Monad maintaining parallel contexts and substitutions for flattening.
---
---- DESCRIPTION ---------------------------------------------------------------
---
---  The flattening transformation needs to perform a fair amount of plumbing.
---  It needs to mainatin a set of variables, called the parallel context for
---  lifting, variable substitutions in case alternatives, and so on.
---  Moreover, we need to manage uniques to create new variables.  The monad
---  defined in this module takes care of maintaining this state.
--- 
---- DOCU ----------------------------------------------------------------------
---
---  Language: Haskell 98
---
---  * a parallel context is a set of variables that get vectorised during a
---    lifting transformations (ie, their type changes from `t' to `[:t:]')
---
---  * all vectorised variables in a parallel context have the same size; we
---    call this also the size of the parallel context
---
---  * we represent contexts by maps that give the lifted version of a variable
---    (remember that in GHC, variables contain type information that changes
---    during lifting)
---
---- TODO ----------------------------------------------------------------------
---
---  * Assumptions currently made that should (if they turn out to be true) be
---    documented in The Commentary:
---
---    - Local bindings can be copied without any need to alpha-rename bound
---      variables (or their uniques).  Such renaming is only necessary when
---      bindings in a recursive group are replicated; implying that this is
---      required in the case of top-level bindings).  (Note: The CoreTidy path
---      generates global uniques before code generation.)
---
---  * One FIXME left to resolve.
---
-
-module FlattenMonad (
-
-  -- monad definition
-  --
-  Flatten, runFlatten,
-
-  -- variable generation
-  --
-  newVar, mkBind,
-  
-  -- context management & query operations
-  --
-  extendContext, packContext, liftVar, liftConst, intersectWithContext,
-
-  -- construction of prelude functions
-  --
-  mk'fst, mk'eq, mk'neq, mk'and, mk'or, mk'lengthP, mk'replicateP, mk'mapP,
-  mk'bpermuteP, mk'bpermuteDftP, mk'indexOfP
-) where
-
--- standard
-import Monad	    (mplus)
-
--- GHC
-import Panic        (panic)
-import Outputable   (Outputable(ppr), pprPanic)
-import UniqSupply   (UniqSupply, splitUniqSupply, uniqFromSupply)
-import Var          (Var, idType)
-import Id	    (Id, mkSysLocal)
-import Name	    (Name)
-import VarSet       (VarSet, emptyVarSet, extendVarSet, varSetElems )
-import VarEnv       (VarEnv, emptyVarEnv, zipVarEnv, plusVarEnv,
-		     elemVarEnv, lookupVarEnv, lookupVarEnv_NF, delVarEnvList)
-import Type	    (Type, tyConAppTyCon)
-import HscTypes	    (HomePackageTable,
-		     ExternalPackageState(eps_PTE), HscEnv(hsc_HPT),
-		     TyThing(..), lookupType)
-import PrelNames    ( fstName, andName, orName,
-		     lengthPName, replicatePName, mapPName, bpermutePName,
-		     bpermuteDftPName, indexOfPName)
-import TysPrim      ( charPrimTyCon, intPrimTyCon, floatPrimTyCon, doublePrimTyCon )
-import PrimOp	    ( PrimOp(..) )
-import PrelInfo	    ( primOpId )
-import CoreSyn      (Expr(..), Bind(..), CoreBndr, CoreExpr, CoreBind, mkApps)
-import CoreUtils    (exprType)
-import FastString   (FastString)
-
--- friends
-import NDPCoreUtils (parrElemTy)
-
-
--- definition of the monad
--- -----------------------
-
--- state maintained by the flattening monad
---
-data FlattenState = FlattenState {
-
-		      -- our source for uniques
-		      --
-		      us       :: UniqSupply,
-
-		      -- environment containing all known names (including all
-		      -- Prelude functions)
-		      --
-		      env      :: Name -> Id,
-
-		      -- this variable determines the parallel context; if
-		      -- `Nothing', we are in pure vectorisation mode, no
-		      -- lifting going on
-		      --
-		      ctxtVar  :: Maybe Var,
-
-		      -- environment that maps each variable that is
-		      -- vectorised in the current parallel context to the
-		      -- vectorised version of that variable
-		      --
-		      ctxtEnv :: VarEnv Var,
-
-		      -- those variables from the *domain* of `ctxtEnv' that
-		      -- have been used since the last context restriction (cf.
-		      -- `restrictContext') 
-		      --
-		      usedVars :: VarSet
-		    }
-
--- initial value of the flattening state
---
-initialFlattenState :: ExternalPackageState
-		    -> HomePackageTable 
-		    -> UniqSupply 
-		    -> FlattenState
-initialFlattenState eps hpt us = 
-  FlattenState {
-    us	     = us,
-    env      = lookup,
-    ctxtVar  = Nothing,
-    ctxtEnv  = emptyVarEnv,
-    usedVars = emptyVarSet
-  }
-  where
-    lookup n = 
-      case lookupType hpt (eps_PTE eps) n of
-        Just (AnId v) -> v 
-	_             -> pprPanic "FlattenMonad: unknown name:" (ppr n)
-
--- the monad representation (EXPORTED ABSTRACTLY)
---
-newtype Flatten a = Flatten {
-		      unFlatten :: (FlattenState -> (a, FlattenState))
-		    }
-
-instance Monad Flatten where
-  return x = Flatten $ \s -> (x, s)
-  m >>= n  = Flatten $ \s -> let 
-			       (r, s') = unFlatten m s
-			     in
-			     unFlatten (n r) s'
-
--- execute the given flattening computation (EXPORTED)
---
-runFlatten :: HscEnv
-	   -> ExternalPackageState
-	   -> UniqSupply 
-	   -> Flatten a 
-	   -> a    
-runFlatten hsc_env eps us m 
-  = fst $ unFlatten m (initialFlattenState eps (hsc_HPT hsc_env) us)
-
-
--- variable generation
--- -------------------
-
--- generate a new local variable whose name is based on the given lexeme and
--- whose type is as specified in the second argument (EXPORTED)
---
-newVar           :: FastString -> Type -> Flatten Var
-newVar lexeme ty  = Flatten $ \state ->
-  let
-    (us1, us2) = splitUniqSupply (us state)
-    state'     = state {us = us2}
-  in
-  (mkSysLocal lexeme (uniqFromSupply us1) ty, state')
-
--- generate a non-recursive binding using a new binder whose name is derived
--- from the given lexeme (EXPORTED)
---
-mkBind          :: FastString -> CoreExpr -> Flatten (CoreBndr, CoreBind)
-mkBind lexeme e  =
-  do
-    v <- newVar lexeme (exprType e)
-    return (v, NonRec v e)
-
-
--- context management
--- ------------------
-
--- extend the parallel context by the given set of variables (EXPORTED)
---
---  * if there is no parallel context at the moment, the first element of the
---   variable list will be used to determine the new parallel context
---
---  * the second argument is executed in the current context extended with the
---   given variables
---
---  * the variables must already have been lifted by transforming their type,
---   but they *must* have retained their original name (or, at least, their
---   unique); this is needed so that they match the original variable in
---   variable environments
---
---  * any trace of the given set of variables has to be removed from the state
---   at the end of this operation
---
-extendContext      :: [Var] -> Flatten a -> Flatten a
-extendContext [] m  = m
-extendContext vs m  = Flatten $ \state -> 
-  let 
-    extState       = state {
-		       ctxtVar = ctxtVar state `mplus` Just (head vs),
-		       ctxtEnv = ctxtEnv state `plusVarEnv` zipVarEnv vs vs
-		     }
-    (r, extState') = unFlatten m extState
-    resState       = extState' { -- remove `vs' from the result state
-		       ctxtVar  = ctxtVar state,
-		       ctxtEnv  = ctxtEnv state,
-		       usedVars = usedVars extState' `delVarEnvList` vs
-		     }
-  in
-  (r, resState)
-
--- execute the second argument in a restricted context (EXPORTED)
---
---  * all variables in the current parallel context are packed according to
---   the permutation vector associated with the variable passed as the first
---   argument (ie, all elements of vectorised context variables that are
---   invalid in the restricted context are dropped)
---
---  * the returned list of core binders contains the operations that perform
---   the restriction on all variables in the parallel context that *do* occur
---   during the execution of the second argument (ie, `liftVar' is executed at
---   least once on any such variable)
---
-packContext        :: Var -> Flatten a -> Flatten (a, [CoreBind])
-packContext perm m  = Flatten $ \state ->
-  let
-    -- FIXME: To set the packed environment to the unpacked on is a hack of
-    --   which I am not sure yet (a) whether it works and (b) whether it's
-    --   really worth it.  The one advantages is that, we can use a var set,
-    --   after all, instead of a var environment.
-    --
-    --	 The idea is the following: If we have to pack a variable `x', we
-    --	 generate `let{-NonRec-} x = bpermuteP perm x in ...'.  As this is a
-    --	 non-recursive binding, the lhs `x' overshadows the rhs `x' in the
-    --	 body of the let.
-    --
-    --   NB: If we leave it like this, `mkCoreBind' can be simplified.
-    packedCtxtEnv     = ctxtEnv state
-    packedState       = state {
-	                  ctxtVar  = fmap
-				       (lookupVarEnv_NF packedCtxtEnv)
-				       (ctxtVar state),
-		          ctxtEnv  = packedCtxtEnv, 
-		          usedVars = emptyVarSet
-		        }
-    (r, packedState') = unFlatten m packedState
-    resState	      = state {    -- revert to the unpacked context
-			  ctxtVar  = ctxtVar state,
-			  ctxtEnv  = ctxtEnv state
-		        }
-    bndrs	      = map mkCoreBind . varSetElems . usedVars $ packedState'
-
-    -- generate a binding for the packed variant of a context variable
-    --
-    mkCoreBind var    = let
-			  rhs = fst $ unFlatten (mk'bpermuteP (idType var) 
-							      (Var perm) 
-							      (Var var)
-						) state
-			in
-			NonRec (lookupVarEnv_NF packedCtxtEnv var) $ rhs
-		          
-  in
-  ((r, bndrs), resState)
-
--- lift a single variable in the current context (EXPORTED)
---
---  * if the variable does not occur in the context, it's value is vectorised to
---   match the size of the current context
---
---  * otherwise, the variable is replaced by whatever the context environment
---   maps it to (this may either be simply the lifted version of the original
---   variable or a packed variant of that variable)
---
---  * the monad keeps track of all lifted variables that occur in the parallel
---   context, so that `packContext' can determine the correct set of core
---   bindings
---
-liftVar     :: Var -> Flatten CoreExpr
-liftVar var  = Flatten $ \s ->
-  let 
-    v          = ctxtVarErr s
-    v'elemType = parrElemTy . idType $ v
-    len        = fst $ unFlatten (mk'lengthP v'elemType (Var v)) s
-    replicated = fst $ unFlatten (mk'replicateP (idType var) len (Var var)) s
-  in case lookupVarEnv (ctxtEnv s) var of
-    Just liftedVar -> (Var liftedVar, 
-		       s {usedVars = usedVars s `extendVarSet` var})
-    Nothing        -> (replicated, s)
-
--- lift a constant expression in the current context (EXPORTED)
---
---  * the value of the constant expression is vectorised to match the current
---   parallel context
---
-liftConst   :: CoreExpr -> Flatten CoreExpr
-liftConst e  = Flatten $ \s ->
-  let
-     v          = ctxtVarErr s
-     v'elemType = parrElemTy . idType $ v
-     len        = fst $ unFlatten (mk'lengthP v'elemType (Var v)) s
-  in 
-  (fst $ unFlatten (mk'replicateP (exprType e) len e ) s, s)
-
--- pick those variables of the given set that occur (if albeit in lifted form)
--- in the current parallel context (EXPORTED)
---
---  * the variables returned are from the given set and *not* the corresponding
---   context variables
---
-intersectWithContext    :: VarSet -> Flatten [Var]
-intersectWithContext vs  = Flatten $ \s ->
-  let
-    vs' = filter (`elemVarEnv` ctxtEnv s) (varSetElems vs)
-  in
-  (vs', s)
-
-
--- construct applications of prelude functions
--- -------------------------------------------
-
--- NB: keep all the used names listed in `FlattenInfo.namesNeededForFlattening'
-
--- generate an application of `fst' (EXPORTED)
---
-mk'fst           :: Type -> Type -> CoreExpr -> Flatten CoreExpr
-mk'fst ty1 ty2 a  = mkFunApp fstName [Type ty1, Type ty2, a]
-
--- generate an application of `&&' (EXPORTED)
---
-mk'and       :: CoreExpr -> CoreExpr -> Flatten CoreExpr
-mk'and a1 a2  = mkFunApp andName [a1, a2]
-
--- generate an application of `||' (EXPORTED)
---
-mk'or       :: CoreExpr -> CoreExpr -> Flatten CoreExpr
-mk'or a1 a2  = mkFunApp orName [a1, a2]
-
--- generate an application of `==' where the arguments may only be literals
--- that may occur in a Core case expression (i.e., `Char', `Int', `Float', and
--- `Double') (EXPORTED)
---
-mk'eq          :: Type -> CoreExpr -> CoreExpr -> Flatten CoreExpr
-mk'eq ty a1 a2  = return (mkApps (Var eqName) [a1, a2])
-		  where
-		    tc = tyConAppTyCon ty
-		    --
-		    eqName | tc == charPrimTyCon   = primOpId CharEqOp
-			   | tc == intPrimTyCon    = primOpId IntEqOp
-			   | tc == floatPrimTyCon  = primOpId FloatEqOp
-			   | tc == doublePrimTyCon = primOpId DoubleEqOp
-			   | otherwise 		         =
-			     pprPanic "FlattenMonad.mk'eq: " (ppr ty)
-
--- generate an application of `==' where the arguments may only be literals
--- that may occur in a Core case expression (i.e., `Char', `Int', `Float', and
--- `Double') (EXPORTED)
---
-mk'neq          :: Type -> CoreExpr -> CoreExpr -> Flatten CoreExpr
-mk'neq ty a1 a2  = return (mkApps (Var neqName) [a1, a2])
-		   where
-		     tc = tyConAppTyCon ty
-		     --
-		     neqName {-  | name == charPrimTyConName   = neqCharName -}
-			     | tc == intPrimTyCon	      = primOpId IntNeOp
-			     {-  | name == floatPrimTyConName  = neqFloatName -}
-			     {-  | name == doublePrimTyConName = neqDoubleName -}
-			     | otherwise		   =
-			       pprPanic "FlattenMonad.mk'neq: " (ppr ty)
-
--- generate an application of `lengthP' (EXPORTED)
---
-mk'lengthP      :: Type -> CoreExpr -> Flatten CoreExpr
-mk'lengthP ty a  = mkFunApp lengthPName [Type ty, a]
-
--- generate an application of `replicateP' (EXPORTED)
---
-mk'replicateP          :: Type -> CoreExpr -> CoreExpr -> Flatten CoreExpr
-mk'replicateP ty a1 a2  = mkFunApp replicatePName [Type ty, a1, a2]
-
--- generate an application of `replicateP' (EXPORTED)
---
-mk'mapP :: Type -> Type -> CoreExpr -> CoreExpr -> Flatten CoreExpr
-mk'mapP ty1 ty2 a1 a2  = mkFunApp mapPName [Type ty1, Type ty2, a1, a2]
-
--- generate an application of `bpermuteP' (EXPORTED)
---
-mk'bpermuteP          :: Type -> CoreExpr -> CoreExpr -> Flatten CoreExpr
-mk'bpermuteP ty a1 a2  = mkFunApp bpermutePName [Type ty, a1, a2]
-
--- generate an application of `bpermuteDftP' (EXPORTED)
---
-mk'bpermuteDftP :: Type -> CoreExpr -> CoreExpr -> CoreExpr -> Flatten CoreExpr
-mk'bpermuteDftP ty a1 a2 a3 = mkFunApp bpermuteDftPName [Type ty, a1, a2, a3]
-
--- generate an application of `indexOfP' (EXPORTED)
---
-mk'indexOfP          :: Type -> CoreExpr -> CoreExpr -> Flatten CoreExpr
-mk'indexOfP ty a1 a2  = mkFunApp indexOfPName [Type ty, a1, a2]
-
-
--- auxilliary functions
--- --------------------
-
--- obtain the context variable, aborting if it is not available (as this
--- signals an internal error in the usage of the `Flatten' monad)
---
-ctxtVarErr   :: FlattenState -> Var
-ctxtVarErr s  = case ctxtVar s of
-		  Nothing -> panic "FlattenMonad.ctxtVarErr: No context variable available!"
-		  Just v  -> v
-
--- given the name of a known function and a set of arguments (needs to include
--- all needed type arguments), build a Core expression that applies the named
--- function to those arguments
---
-mkFunApp           :: Name -> [CoreExpr] -> Flatten CoreExpr
-mkFunApp name args  =
-  do
-    fun <- lookupName name
-    return $ mkApps (Var fun) args
-
--- get the `Id' of a known `Name'
---
---  * this can be the `Name' of any function that's visible on the toplevel of
---   the current compilation unit
---
-lookupName      :: Name -> Flatten Id
-lookupName name  = Flatten $ \s ->
-  (env s name, s)
diff --git a/ghc/compiler/ndpFlatten/Flattening.hs b/ghc/compiler/ndpFlatten/Flattening.hs
deleted file mode 100644
index 18daaa6323..0000000000
--- a/ghc/compiler/ndpFlatten/Flattening.hs
+++ /dev/null
@@ -1,808 +0,0 @@
---  $Id$
---
---  Copyright (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller
---  
---  Vectorisation and lifting
---
---- DESCRIPTION ---------------------------------------------------------------
---
---  This module implements the vectorisation and function lifting
---  transformations of the flattening transformation.
--- 
---- DOCU ----------------------------------------------------------------------
---
---  Language: Haskell 98 with C preprocessor
---
---  Types: 
---    the transformation on types has five purposes:
---
---        1) for each type definition, derive the lifted version of this type
---             liftTypeef
---        2) change the type annotations of functions & variables acc. to rep.
---             flattenType
---        3) derive the type of a lifted function
---             liftType
---        4) sumtypes:
---             this is the most fuzzy and complicated part. For each lifted
---             sumtype we need to generate function to access and combine the
---             component arrays
---
---   NOTE: the type information of variables and data constructors is *not*
---          changed to reflect it's representation. This has to be solved 
---          somehow (???, FIXME)  using type indexed types
---
---   Vectorisation:
---    is very naive at the moment. One of the most striking inefficiencies is
---    application vect (app e1 e2) -> app (fst (vect e1) (vect e2)) if e1 is a
---    lambda abstraction. The vectorisation produces a pair consisting of the
---    original and the lifted function, but the lifted version is discarded.
---    I'm also not sure how much of this would be thrown out by the simplifier
---    eventually
---
---        *) vectorise
---
---  Conventions:
---
---- TODO ----------------------------------------------------------------------
---
---   * look closer into the definition of type definition (TypeThing or so)
---
-
-module Flattening (
-  flatten, flattenExpr, 
-) where 
-
-#include "HsVersions.h"
-
--- friends
-import NDPCoreUtils (tupleTyArgs, funTyArgs, parrElemTy, isDefault,
-		     isLit, mkPArrTy, mkTuple, isSimpleExpr, substIdEnv)
-import FlattenMonad (Flatten, runFlatten, mkBind, extendContext, packContext,
-		     liftVar, liftConst, intersectWithContext, mk'fst,
-		     mk'lengthP, mk'replicateP, mk'mapP, mk'bpermuteDftP,
-		     mk'indexOfP,mk'eq,mk'neq) 
-
--- GHC
-import TcType	    ( tcIsForAllTy, tcView )
-import TypeRep	    ( Type(..) )
-import StaticFlags  (opt_Flatten)
-import Panic        (panic)
-import ErrUtils     (dumpIfSet_dyn)
-import UniqSupply   (mkSplitUniqSupply)
-import DynFlags  (DynFlag(..))
-import Literal      (Literal, literalType)
-import Var	    (Var(..), idType, isTyVar)
-import Id	    (setIdType)
-import DataCon	    (DataCon, dataConTag)
-import HscTypes	    ( ModGuts(..), ModGuts, HscEnv(..), hscEPS )
-import CoreFVs	    (exprFreeVars)
-import CoreSyn	    (Expr(..), Bind(..), Alt(..), AltCon(..), Note(..),
-		     CoreBndr, CoreExpr, CoreBind, mkLams, mkLets,
-		     mkApps, mkIntLitInt)  
-import PprCore      (pprCoreExpr)
-import CoreLint	    (showPass, endPass)
-
-import CoreUtils    (exprType, applyTypeToArg, mkPiType)
-import VarEnv       (zipVarEnv)
-import TysWiredIn   (mkTupleTy)
-import BasicTypes   (Boxity(..))
-import Outputable
-import FastString
-
-
--- FIXME: fro debugging - remove this
-import TRACE    (trace)
-
--- standard
-import Monad        (liftM, foldM)
-
--- toplevel transformation
--- -----------------------
-
--- entry point to the flattening transformation for the compiler driver when
--- compiling a complete module (EXPORTED) 
---
-flatten :: HscEnv
-	-> ModGuts
-	-> IO ModGuts
-flatten hsc_env mod_impl@(ModGuts {mg_binds = binds}) 
-  | not opt_Flatten = return mod_impl -- skip without -fflatten
-  | otherwise       =
-  do
-    let dflags = hsc_dflags hsc_env
-
-    eps <- hscEPS hsc_env
-    us <- mkSplitUniqSupply 'l'		-- 'l' as in fLattening
-    --
-    -- announce vectorisation
-    --
-    showPass dflags "Flattening [first phase: vectorisation]"
-    --
-    -- vectorise all toplevel bindings
-    --
-    let binds' = runFlatten hsc_env eps us $ vectoriseTopLevelBinds binds
-    --
-    -- and dump the result if requested
-    --
-    endPass dflags "Flattening [first phase: vectorisation]" 
-	    Opt_D_dump_vect binds'
-    return $ mod_impl {mg_binds = binds'}
-
--- entry point to the flattening transformation for the compiler driver when
--- compiling a single expression in interactive mode (EXPORTED) 
---
-flattenExpr :: HscEnv
-	    -> CoreExpr			-- the expression to be flattened
-	    -> IO CoreExpr
-flattenExpr hsc_env expr
-  | not opt_Flatten = return expr       -- skip without -fflatten
-  | otherwise       =
-  do
-    let dflags = hsc_dflags hsc_env
-    eps <- hscEPS hsc_env
-
-    us <- mkSplitUniqSupply 'l'		-- 'l' as in fLattening
-    --
-    -- announce vectorisation
-    --
-    showPass dflags "Flattening [first phase: vectorisation]"
-    --
-    -- vectorise the expression
-    --
-    let expr' = fst . runFlatten hsc_env eps us $ vectorise expr
-    --
-    -- and dump the result if requested
-    --
-    dumpIfSet_dyn dflags Opt_D_dump_vect "Vectorised expression"
-		  (pprCoreExpr expr')
-    return expr'
-
-
--- vectorisation of bindings and expressions
--- -----------------------------------------
-
-
-vectoriseTopLevelBinds:: [CoreBind] -> Flatten [CoreBind]
-vectoriseTopLevelBinds binds =
-  do
-    vbinds <- mapM vectoriseBind binds
-    return (adjustTypeBinds vbinds)
-
-adjustTypeBinds:: [CoreBind] -> [CoreBind]
-adjustTypeBinds vbinds =
-    let 
-       ids = concat (map extIds vbinds)
-       idEnv =  zipVarEnv ids ids
-     in map (substIdEnvBind idEnv) vbinds
-  where 
-    -- FIXME replace by 'bindersOf'
-    extIds (NonRec b expr) = [b]
-    extIds (Rec      bnds) = map fst bnds
-    substIdEnvBind idEnv (NonRec b expr) = NonRec b (substIdEnv idEnv expr)
-    substIdEnvBind idEnv (Rec bnds)      
-       = Rec (map (\ (b,e) -> (b, (substIdEnv idEnv e))) bnds) 
-
--- vectorise a single core binder
---
-vectoriseBind	              :: CoreBind -> Flatten CoreBind
-vectoriseBind (NonRec b expr)  = 
-  liftM (NonRec b) $ liftM fst $ vectorise expr
-vectoriseBind (Rec bindings)   = 
-  liftM Rec        $ mapM vectoriseOne bindings
-  where
-    vectoriseOne (b, expr) = 
-      do
-	(vexpr, ty) <- vectorise expr
-	return (setIdType b ty, vexpr)
-
-
--- Searches for function definitions and creates a lifted version for 
--- each function.
--- We have only two interesting cases:
--- 1) function application  (ex1) (ex2)
---      vectorise both subexpressions. The function will end up becoming a
---      pair (orig. fun, lifted fun), choose first component (in many cases,
---      this is pretty inefficient, since the lifted version is generated
---      although it is clear that it won't be used
--- 
--- 2) lambda abstraction
---      any function has to exist in two forms: it's original form and it's 
---      lifted form. Therefore, every lambda abstraction is transformed into
---      a pair of functions: the original function and its lifted variant
--- 
---
---  FIXME: currently, I use 'exprType' all over the place - this is terribly
---  inefficient. It should be suffiecient to change 'vectorise' and 'lift' to
---  return the type of the result expression as well.
---
-vectorise:: CoreExpr -> Flatten (CoreExpr, Type)
-vectorise (Var id)  =  
-  do 
-    let varTy  = idType id
-    let vecTy  = vectoriseTy varTy
-    return (Var (setIdType id vecTy), vecTy)
-
-vectorise (Lit lit) =  
-  return ((Lit lit), literalType lit) 
-
-
-vectorise e@(App expr t@(Type _)) = 
-  do 
-    (vexpr, vexprTy) <- vectorise expr
-    return ((App vexpr t), applyTypeToArg vexprTy t) 
-
-vectorise  (App (Lam b expr) arg) =
-  do
-    (varg, argTy)    <- vectorise arg
-    (vexpr, vexprTy) <- vectorise expr
-    let vb            = setIdType b argTy
-    return ((App (Lam vb  vexpr) varg), 
-            applyTypeToArg (mkPiType vb vexprTy) varg)
-
--- if vexpr expects a type as first argument
--- application stays just as it is
---
-vectorise (App expr arg) =          
-  do 
-    (vexpr, vexprTy) <-  vectorise expr
-    (varg,  vargTy)  <-  vectorise arg
-
-    if (tcIsForAllTy vexprTy)
-      then do
-        let resTy =  applyTypeToArg vexprTy varg
-        return (App vexpr varg, resTy)
-      else do 
-        let [t1, t2] = tupleTyArgs  vexprTy
-        vexpr'      <-  mk'fst t1 t2 vexpr
-        let resTy    = applyTypeToArg t1 varg   
-        return  ((App vexpr' varg), resTy)  -- apply the first component of
-                                            -- the vectorized function
-
-vectorise  e@(Lam b expr)
-  | isTyVar b
-  =  do
-        (vexpr, vexprTy) <- vectorise expr          -- don't vectorise 'b'!
-        return ((Lam b vexpr), mkPiType b vexprTy)
-  | otherwise =
-     do          
-       (vexpr, vexprTy)  <- vectorise expr
-       let vb             = setIdType b (vectoriseTy (idType b))
-       let ve             =  Lam  vb  vexpr 
-       (lexpr, lexprTy)  <- lift e
-       let veTy = mkPiType vb vexprTy  
-       return $ (mkTuple [veTy, lexprTy] [ve, lexpr], 
-                 mkTupleTy Boxed 2 [veTy, lexprTy])
-
-vectorise (Let bind body) = 
-  do    
-    vbind            <- vectoriseBind bind
-    (vbody, vbodyTy) <- vectorise body
-    return ((Let vbind vbody), vbodyTy)
-
-vectorise (Case expr b ty alts) =
-  do 
-    (vexpr, vexprTy) <- vectorise expr
-    valts <- mapM vectorise' alts
-    let res_ty = snd (head valts)
-    return (Case vexpr (setIdType b vexprTy) res_ty (map fst valts), res_ty)
-  where vectorise' (con, bs, expr) = 
-          do 
-            (vexpr, vexprTy) <- vectorise expr
-            return ((con, bs, vexpr), vexprTy)  -- FIXME: change type of con
-                                                --   and bs
-
-
-
-vectorise (Note note expr) = 
- do 
-   (vexpr, vexprTy) <- vectorise expr        -- FIXME: is this ok or does it
-   return ((Note note vexpr), vexprTy)       --   change the validity of note?
-
-vectorise e@(Type t) = 
-  return (e, t)                              -- FIXME: panic instead of 't'???
-
-
-{-
-myShowTy (TyVarTy _) = "TyVar "
-myShowTy (AppTy t1 t2) = 
-  "AppTy (" ++ (myShowTy t1) ++ ", " ++ (myShowTy t2) ++ ")"
-myShowTy (TyConApp _ t) =
-  "TyConApp TC (" ++ (myShowTy t) ++ ")"
--}
-
-vectoriseTy :: Type -> Type 
-vectoriseTy ty | Just ty' <- tcView ty = vectoriseTy ty'
-	-- Look through notes and synonyms
-	-- NB: This will discard notes and synonyms, of course
-	-- ToDo: retain somehow?
-vectoriseTy t@(TyVarTy v)      =  t
-vectoriseTy t@(AppTy t1 t2)    = 
-  AppTy (vectoriseTy t1) (vectoriseTy t2)
-vectoriseTy t@(TyConApp tc ts) = 
-  TyConApp tc (map vectoriseTy ts)
-vectoriseTy t@(FunTy t1 t2)    = 
-  mkTupleTy Boxed 2 [(FunTy (vectoriseTy t1) (vectoriseTy t2)), 
-                     (liftTy t)]
-vectoriseTy  t@(ForAllTy v ty)  = 
-  ForAllTy v (vectoriseTy  ty)
-vectoriseTy  t =  t
-
-
--- liftTy: wrap the type in an array but be careful with function types
---    on the *top level* (is this sufficient???)
-
-liftTy:: Type -> Type
-liftTy ty | Just ty' <- tcView ty = liftTy ty'
-liftTy (FunTy t1 t2)   = FunTy (liftTy t1) (liftTy t2)
-liftTy (ForAllTy tv t) = ForAllTy tv (liftTy t)
-liftTy  t              = mkPArrTy t
-
-
---  lifting:
--- ----------
---  * liftType
---  * lift
-
-
--- liftBinderType: Converts a  type 'a' stored in the binder to the
--- representation of '[:a:]' will therefore call liftType
---  
---  lift type, don't change name (incl unique) nor IdInfo. IdInfo looks ok,
---  but I'm not entirely sure about some fields (e.g., strictness info)
-liftBinderType:: CoreBndr ->  Flatten CoreBndr
-liftBinderType bndr = return $  setIdType bndr (liftTy (idType bndr))
-
--- lift: lifts an expression (a -> [:a:])
--- If the expression is a simple expression, it is treated like a constant
--- expression. 
--- If the body of a lambda expression is a simple expression, it is
--- transformed into a mapP
-lift:: CoreExpr -> Flatten (CoreExpr, Type)
-lift cExpr@(Var id)    = 
-  do
-    lVar@(Var lId) <- liftVar id
-    return (lVar, idType lId)
-
-lift cExpr@(Lit lit)   = 
-  do
-    lLit  <- liftConst cExpr
-    return (lLit, exprType lLit)   
-                                   
-
-lift (Lam b expr)
-  | isSimpleExpr expr      =  liftSimpleFun b expr
-  | isTyVar b = 
-    do
-      (lexpr, lexprTy) <- lift expr  -- don't lift b!
-      return (Lam b lexpr, mkPiType b lexprTy)
-  | otherwise =
-    do
-      lb               <- liftBinderType b
-      (lexpr, lexprTy) <- extendContext [lb] (lift expr)
-      return ((Lam lb lexpr) , mkPiType lb lexprTy)
-
-lift (App expr1 expr2) = 
-  do
-    (lexpr1, lexpr1Ty) <- lift expr1
-    (lexpr2, _)        <- lift expr2
-    return ((App lexpr1 lexpr2), applyTypeToArg lexpr1Ty lexpr2)
-
-
-lift (Let (NonRec b expr1) expr2) 
-  |isSimpleExpr expr2 =
-    do  			
-      (lexpr1, _)        <- lift expr1
-      (lexpr2, lexpr2Ty) <- liftSimpleFun b expr2
-      let (t1, t2) = funTyArgs lexpr2Ty
-      liftM (\x -> (x, liftTy t2)) $  mk'mapP t1 t2 lexpr2 lexpr1 
-
-  | otherwise =
-    do 
-      (lexpr1, _)        <- lift expr1
-      lb                 <- liftBinderType b
-      (lexpr2, lexpr2Ty) <- extendContext [lb] (lift expr1)
-      return ((Let (NonRec lb lexpr1) lexpr2), lexpr2Ty)
-
-lift (Let (Rec binds) expr2) =
-  do
-    let (bndVars, exprs)  = unzip binds
-    lBndVars           <- mapM liftBinderType bndVars 
-    lexprs             <- extendContext bndVars (mapM lift exprs)
-    (lexpr2, lexpr2Ty) <- extendContext bndVars (lift expr2)
-    return ((Let (Rec (zip  lBndVars (map fst lexprs))) lexpr2), lexpr2Ty)
-
--- FIXME: 
--- Assumption: alternatives can either be literals or data construtors.
---             Due to type restrictions, I don't think it is possible 
---             that they are mixed.
---             The handling of literals and data constructors is completely
---             different
---
---
--- let b = expr in alts
---
--- I think I read somewhere that the default case (if present) is stored
--- in the head of the list. Assume for now this is true, have to check
---
--- (1) literals
--- (2) data constructors
---
--- FIXME: optimisation: first, filter out all simple expression and 
---   loop (mapP & filter) over all the corresponding values in a single
---   traversal:
-							     
---    (1) splitAlts:: [Alt CoreBndr] -> ([Alt CoreBndr],[Alt CoreBndr])
---                                       simple alts     reg alts
---    (2) if simpleAlts = [] then (just as before)
---        if regAlts    = [] then (the whole thing is just a loop)
---        otherwise (a) compute index vector for simpleAlts (for def permute
---                      later on
---                  (b) 
--- gaw 2004 FIX? 
-lift cExpr@(Case expr b _ alts)  =
-  do  
-    (lExpr, _) <- lift expr
-    lb    <- liftBinderType  b     -- lift alt-expression
-    lalts <- if isLit alts 
-                then extendContext [lb] (liftCaseLit b alts)
-                else extendContext [lb] (liftCaseDataCon b alts)
-    letWrapper lExpr b lalts
-
-lift (Note (Coerce t1 t2) expr) =
-  do  
-    (lexpr, t) <- lift expr
-    let lt1 = liftTy t1
-    return ((Note (Coerce lt1 (liftTy t2)) lexpr), lt1)
-
-lift (Note note expr) =
-  do 
-    (lexpr, t) <- lift expr
-    return ((Note note lexpr), t)
-
-lift e@(Type t) = return (e, t)
-
-
--- auxilliary functions for lifting of case statements 
---
-
-liftCaseDataCon:: CoreBndr -> [Alt CoreBndr] -> 
-       Flatten (([CoreBind], [CoreBind], [CoreBind]))
-liftCaseDataCon b [] =
-  return ([], [], [])
-liftCaseDataCon b alls@(alt:alts)
-  | isDefault alt  =
-    do
-      (i,  e,  defAltBndrs) <- liftCaseDataConDefault b alt alts 
-      (is, es, altBndrs)    <- liftCaseDataCon' b alts 
-      return (i:is, e:es, defAltBndrs ++ altBndrs)
-  | otherwise =
-    liftCaseDataCon' b alls
-
-liftCaseDataCon':: CoreBndr -> [Alt CoreBndr] ->  
-    Flatten ([CoreBind], [CoreBind], [CoreBind])
-liftCaseDataCon' _ [] =
-  do
-    return ([], [], []) 
-
-
-liftCaseDataCon' b ((DataAlt dcon, bnds, expr): alts) =
-  do
-    (permBnd, exprBnd, packBnd)    <-  liftSingleDataCon b dcon bnds expr   
-    (permBnds, exprBnds, packBnds) <-  liftCaseDataCon' b alts 
-    return (permBnd:permBnds, exprBnd:exprBnds, packBnd ++ packBnds)
-
-
--- FIXME: is is really necessary to return the binding to the permutation
--- array in the data constructor case, as the representation already 
--- contains the extended flag vector
-liftSingleDataCon:: CoreBndr -> DataCon -> [CoreBndr] -> CoreExpr ->
-  Flatten (CoreBind, CoreBind, [CoreBind])
-liftSingleDataCon b dcon bnds expr =
-  do 
-    let dconId           = dataConTag dcon
-    indexExpr           <- mkIndexOfExprDCon (idType b)  b dconId
-    (bb, bbind)         <- mkBind FSLIT("is") indexExpr
-    lbnds               <- mapM liftBinderType bnds
-    ((lExpr, _), bnds') <- packContext  bb (extendContext lbnds (lift expr))
-    (_, vbind)          <- mkBind FSLIT("r") lExpr
-    return (bbind, vbind, bnds')
-
--- FIXME: clean this up. the datacon and the literal case are so
---   similar that it would be easy to use the same function here
---   instead of duplicating all the code.
---
-liftCaseDataConDefault:: CoreBndr -> (Alt CoreBndr) ->  [Alt CoreBndr] 
-  ->  Flatten (CoreBind, CoreBind, [CoreBind])
-liftCaseDataConDefault b (_, _, def) alts =
-  do
-    let dconIds        = map (\(DataAlt d, _, _) -> dataConTag d) alts
-    indexExpr         <- mkIndexOfExprDConDft (idType b) b dconIds
-    (bb, bbind)       <- mkBind FSLIT("is") indexExpr
-    ((lDef, _), bnds) <- packContext  bb (lift def)     
-    (_, vbind)        <- mkBind FSLIT("r") lDef
-    return (bbind, vbind, bnds)
-
--- liftCaseLit: checks if we have a default case and handles it 
--- if necessary
-liftCaseLit:: CoreBndr -> [Alt CoreBndr] -> 
-       Flatten ([CoreBind], [CoreBind], [CoreBind])
-liftCaseLit b [] =
-    return ([], [], [])    --FIXME: a case with no cases at all???
-liftCaseLit b alls@(alt:alts)
-  | isDefault alt  =
-    do
-        (i,  e,  defAltBndrs) <- liftCaseLitDefault b alt alts 
-        (is, es, altBndrs)    <- liftCaseLit' b alts 
-        return (i:is, e:es, defAltBndrs ++ altBndrs)
-  | otherwise = 
-    do 
-      liftCaseLit' b alls 
-
--- liftCaseLitDefault: looks at all the other alternatives which 
---    contain a literal and filters all those elements from the 
---    array which do not match any of the literals in the other
---    alternatives.
-liftCaseLitDefault:: CoreBndr -> (Alt CoreBndr) ->  [Alt CoreBndr] 
-  ->  Flatten (CoreBind, CoreBind, [CoreBind])
-liftCaseLitDefault b (_, _, def) alts =
-  do
-    let lits           = map (\(LitAlt l, _, _) -> l) alts
-    indexExpr         <- mkIndexOfExprDft (idType b) b lits
-    (bb, bbind)       <- mkBind FSLIT("is") indexExpr
-    ((lDef, _), bnds) <- packContext  bb (lift def)     
-    (_, vbind)        <- mkBind FSLIT("r") lDef
-    return (bbind, vbind, bnds)
-
--- FIXME: 
---  Assumption: in case of Lit, the list of binders of the alt is empty.
---
--- returns 
---   a list of all vars bound to the expr in the body of the alternative
---   a list of (var, expr) pairs, where var has to be bound to expr
---   by letWrapper
-liftCaseLit':: CoreBndr -> [Alt CoreBndr] ->  
-    Flatten ([CoreBind], [CoreBind], [CoreBind])						       
-liftCaseLit' _ [] =
-  do
-    return ([], [], [])
-liftCaseLit' b ((LitAlt lit, [], expr):alts) =
-  do
-    (permBnd, exprBnd, packBnd)    <-  liftSingleCaseLit b lit expr 
-    (permBnds, exprBnds, packBnds) <-  liftCaseLit' b alts 
-    return (permBnd:permBnds, exprBnd:exprBnds, packBnd ++ packBnds)
-
--- lift a single alternative of the form: case  b of lit -> expr. 
---    
---   It returns the bindings:
---   (a) let b' = indexOfP (mapP (\x -> x == lit) b)
---
---   (b) lift expr in the packed context. Returns lexpr and the
---       list of binds (bnds) that describe the packed arrays
---
---   (c) create new var v' to bind lexpr to
---
---   (d) return (b' = indexOf...., v' = lexpr, bnds)
-liftSingleCaseLit:: CoreBndr -> Literal -> CoreExpr  -> 
-  Flatten (CoreBind, CoreBind, [CoreBind])
-liftSingleCaseLit b lit expr =
- do 
-   indexExpr          <- mkIndexOfExpr (idType b) b lit -- (a)
-   (bb, bbind)        <- mkBind FSLIT("is") indexExpr
-   ((lExpr, t), bnds) <- packContext  bb (lift expr)     -- (b)         
-   (_, vbind)         <- mkBind FSLIT("r") lExpr
-   return (bbind, vbind, bnds)
-
--- letWrapper lExpr b ([indexbnd_i], [exprbnd_i], [pckbnd_ij])
--- 
--- let b = lExpr in
---  let index_bnd_1 in
---    let packbnd_11 in
---      ... packbnd_1m in 
---         let exprbnd_1 in        ....
---      ...
---          let nvar = replicate dummy (length <current context>)
---               nvar1 = bpermuteDftP index_bnd_1 ...
---
---   in bpermuteDftP index_bnd_n nvar_(n-1)
---
-letWrapper:: CoreExpr -> CoreBndr ->([CoreBind], [CoreBind], [CoreBind]) ->
-  Flatten (CoreExpr, Type)
-letWrapper lExpr b (indBnds, exprBnds, pckBnds)  =
-  do 
-    (defBpBnds, ty) <- dftbpBinders indBnds exprBnds
-    let resExpr      = getExprOfBind (head defBpBnds)
-    return ((mkLets (indBnds ++ pckBnds ++ exprBnds ++ defBpBnds) resExpr), ty)
-
--- dftbpBinders: return the list of binders necessary to construct the overall
---   result from the subresults computed in the different branches of the case
---   statement. The binding which contains the final result is in the *head*
---   of the result list.
--- 
--- dftbpBinders [ind_i = ...] [expr_i = ...] = [dn = ..., d_n-1 = .., d1 = ...]
---
--- let def = replicate (length of context) undefined
---     d1  = bpermuteDftP dft e1 i1
---     .....
---
-dftbpBinders:: [CoreBind] -> [CoreBind] -> Flatten ([CoreBind], Type)
-dftbpBinders indexBnds exprBnds =
-  do
-    let expr = getExprOfBind (head exprBnds)
-    defVecExpr     <- createDftArrayBind expr
-    ((b, bnds), t) <- dftbpBinders' indexBnds exprBnds defVecExpr
-    return ((b:bnds),t)
-  where
-    dftbpBinders' :: [CoreBind] 
-		  -> [CoreBind] 
-		  -> CoreBind 
-		  -> Flatten ((CoreBind, [CoreBind]), Type)
-    dftbpBinders' [] [] cBnd =
-      return ((cBnd, []), panic "dftbpBinders: undefined type")
-    dftbpBinders' (i:is) (e:es) cBind =
-      do
-	let iVar = getVarOfBind i
-	let eVar = getVarOfBind e
-	let cVar = getVarOfBind cBind
-        let ty   = idType eVar
-	newBnd  <- mkDftBackpermute ty iVar eVar cVar
-	((fBnd, restBnds), _) <- dftbpBinders' is es newBnd
-	return ((fBnd, (newBnd:restBnds)), liftTy ty)
-
-    dftbpBinders'  _ _ _ = 
-      panic "Flattening.dftbpBinders: index and expression binder lists have different length!"
-
-getExprOfBind:: CoreBind -> CoreExpr
-getExprOfBind (NonRec _ expr) = expr
-
-getVarOfBind:: CoreBind -> Var
-getVarOfBind (NonRec b _) = b
-
-
-
--- Optimised Transformation
--- =========================
---
-
--- liftSimpleFun
---   if variables x_1 to x_i occur in the context *and* free in expr
---   then 
---   (liftSimpleExpression expr) => mapP (\ (x1,..xn) -> expr) (x1,..xn)
---
-liftSimpleFun:: CoreBndr -> CoreExpr -> Flatten (CoreExpr, Type)
-liftSimpleFun b expr =
-  do
-    bndVars <- collectBoundVars expr
-    let bndVars'     = b:bndVars
-        bndVarsTuple = mkTuple (map idType bndVars') (map Var bndVars')
-	lamExpr      = mkLams (b:bndVars) expr     -- FIXME: should be tuple
-                                                   -- here 
-    let (t1, t2)     = funTyArgs . exprType $ lamExpr
-    mapExpr         <-  mk'mapP t1 t2 lamExpr bndVarsTuple
-    let lexpr        = mkApps mapExpr [bndVarsTuple]
-    return (lexpr, undefined)                      -- FIXME!!!!!
-
-
-collectBoundVars:: CoreExpr -> Flatten [CoreBndr]
-collectBoundVars  expr = 
-  intersectWithContext (exprFreeVars expr)
-
-
--- auxilliary routines
--- -------------------
-
--- mkIndexOfExpr b lit ->
---   indexOf (mapP (\x -> x == lit) b) b
---
-mkIndexOfExpr:: Type -> CoreBndr -> Literal -> Flatten CoreExpr
-mkIndexOfExpr  idType b lit =
-  do 
-    eqExpr        <- mk'eq idType (Var b) (Lit lit)
-    let lambdaExpr = (Lam b eqExpr)
-    mk'indexOfP idType  lambdaExpr (Var b)
-
--- there is FlattenMonad.mk'indexOfP as well as
--- CoreSyn.mkApps and CoreSyn.mkLam, all of which should help here
-
--- for case-distinction over data constructors:
--- let b = expr in 
---   case b of
---      dcon args -> ....
--- dconId = dataConTag dcon 
--- the call "mkIndexOfExprDCon b dconId" computes the core expression for
--- indexOfP (\x -> x == dconId) b)
---
-mkIndexOfExprDCon::Type -> CoreBndr -> Int -> Flatten CoreExpr
-mkIndexOfExprDCon  idType b dId = 
-  do 
-    let intExpr    = mkIntLitInt dId
-    eqExpr        <- mk'eq  idType (Var b) intExpr
-    let lambdaExpr = (Lam b intExpr)
-    mk'indexOfP idType lambdaExpr (Var b) 
-
-  
-
--- there is FlattenMonad.mk'indexOfP as well as
--- CoreSyn.mkApps and CoreSyn.mkLam, all of which should help here
-
--- mk'IndexOfExprDConDft b dconIds : Generates the index expression for the
--- default case. "dconIds" is a list of all the data constructor idents which 
--- are covered by the other cases.
--- indexOfP (\x -> x != dconId_1 && ....) b)
---
-mkIndexOfExprDConDft:: Type -> CoreBndr -> [Int] -> Flatten CoreExpr
-mkIndexOfExprDConDft idType b dId  = 
-  do 
-    let intExprs   = map mkIntLitInt dId
-    bExpr         <- foldM (mk'neq idType) (head intExprs) (tail intExprs)
-    let lambdaExpr = (Lam b bExpr)
-    mk'indexOfP idType (Var b) bExpr
-  
-
--- mkIndexOfExprDef b [lit1, lit2,...] ->
---   indexOf (\x -> not (x == lit1 || x == lit2 ....) b
-mkIndexOfExprDft:: Type -> CoreBndr -> [Literal] -> Flatten CoreExpr
-mkIndexOfExprDft idType b lits = 
-  do 
-    let litExprs   = map (\l-> Lit l)  lits
-    bExpr         <- foldM (mk'neq idType) (head litExprs) (tail litExprs)
-    let lambdaExpr = (Lam b bExpr)
-    mk'indexOfP idType bExpr (Var b) 
-
-
--- create a back-permute binder
---
---  * `mkDftBackpermute ty indexArrayVar srcArrayVar dftArrayVar' creates a
---   Core binding of the form
---
---     x = bpermuteDftP indexArrayVar srcArrayVar dftArrayVar
---
---   where `x' is a new local variable
---
-mkDftBackpermute :: Type -> Var -> Var -> Var -> Flatten CoreBind
-mkDftBackpermute ty idx src dft = 
-  do
-    rhs <- mk'bpermuteDftP ty (Var idx) (Var src) (Var dft)
-    liftM snd $ mkBind FSLIT("dbp") rhs
-
--- create a dummy array with elements of the given type, which can be used as
--- default array for the combination of the subresults of the lifted case
--- expression
---
-createDftArrayBind    :: CoreExpr -> Flatten CoreBind
-createDftArrayBind e  =
-  panic "Flattening.createDftArrayBind: not implemented yet"
-{-
-  do
-    let ty = parrElemTy . exprType $ expr
-    len <- mk'lengthP e
-    rhs <- mk'replicateP ty len err??
-    lift snd $ mkBind FSLIT("dft") rhs
-FIXME: nicht so einfach; man kann kein "error"-Wert nehmen, denn der w"urde
-  beim bpermuteDftP sofort evaluiert, aber es ist auch schwer m"oglich einen
-  generischen Wert f"ur jeden beliebigen Typ zu erfinden.
--}
-
-
-
-
--- show functions (the pretty print functions sometimes don't 
--- show it the way I want....
-
--- shows just the structure
-showCoreExpr (Var _ )    = "Var "
-showCoreExpr (Lit _) = "Lit "
-showCoreExpr (App e1 e2) = 
-  "(App \n  " ++ (showCoreExpr e1) ++ "\n  " ++ (showCoreExpr e2) ++ ") "
-showCoreExpr (Lam b e)   =
-  "Lam b " ++ (showCoreExpr e)
-showCoreExpr (Let bnds expr) =
-  "Let \n" ++ (showBinds bnds) ++ "in " ++ (showCoreExpr expr)
-  where showBinds (NonRec b e) = showBind (b,e)
-        showBinds (Rec bnds)   = concat (map showBind bnds)
-        showBind (b,e) = "  b = " ++ (showCoreExpr e)++ "\n"
--- gaw 2004 FIX?
-showCoreExpr (Case ex b ty alts) =
-  "Case b = " ++ (showCoreExpr ex) ++ " of \n" ++ (showAlts alts)
-  where showAlts _ = ""  
-showCoreExpr (Note _ ex) = "Note n " ++ (showCoreExpr ex)
-showCoreExpr (Type t) = "Type"
diff --git a/ghc/compiler/ndpFlatten/NDPCoreUtils.hs b/ghc/compiler/ndpFlatten/NDPCoreUtils.hs
deleted file mode 100644
index 6e6b94f175..0000000000
--- a/ghc/compiler/ndpFlatten/NDPCoreUtils.hs
+++ /dev/null
@@ -1,174 +0,0 @@
---  $Id$
---
---  Copyright (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller
---
---  Auxiliary routines for NDP-related Core transformations.
---
---- DESCRIPTION ---------------------------------------------------------------
---
---  This module exports all functions to access and alter the `Type' data 
---  structure from modules `Type' and `CoreExpr' from `CoreSyn'.  As it is part
---  of the NDP flattening component, the functions provide access to all the
---  fields that are important for the flattening and lifting transformation.
--- 
---- DOCU ----------------------------------------------------------------------
---
---  Language: Haskell 98
---
---- TODO ----------------------------------------------------------------------
---
-
-module NDPCoreUtils (
-
-  -- type inspection functions
-  --
-  tupleTyArgs,		-- :: Type -> [Type]
-  funTyArgs,		-- :: Type -> (Type, Type)
-  parrElemTy,		-- :: Type -> Type
-
-  -- Core generation functions
-  --
-  mkTuple,		-- :: [Type] -> [CoreExpr] -> CoreExpr
-  mkInt,		-- :: CoreExpr -> CoreExpr
-
-  -- query functions
-  --
-  isDefault,            -- :: CoreAlt -> Bool
-  isLit,		-- :: [CoreAlt] -> Bool
-  isSimpleExpr,		-- :: CoreExpr -> Bool
-
-  -- re-exported functions
-  --
-  mkPArrTy,		-- :: Type -> Type
-  boolTy,		-- :: Type
-  
-  -- substitution
-  -- 
-  substIdEnv
-) where
-
--- GHC
-import Panic      (panic)
-import Outputable (Outputable(ppr), pprPanic)
-import BasicTypes (Boxity(..))
-import Type       (Type, splitTyConApp_maybe, splitFunTy)
-import TyCon      (isTupleTyCon)
-import TysWiredIn (parrTyCon, unitDataConId, tupleCon, intDataCon, mkPArrTy,
-		   boolTy) 
-import CoreSyn    (CoreExpr, CoreAlt, Expr(..), AltCon(..),
-		   Bind(..), mkConApp)
-import PprCore	  ( {- instances -} )
-import Var        (Id)
-import VarEnv     (IdEnv, delVarEnv, delVarEnvList, lookupVarEnv)
-
--- friends: don't import any to avoid cyclic imports
--- 
-
-
--- type inspection functions
--- -------------------------
-
--- determines the argument types of a tuple type (EXPORTED)
---
-tupleTyArgs    :: Type -> [Type]
-tupleTyArgs ty  =
-  case splitTyConApp_maybe ty of
-    Just (tyCon, argTys) | isTupleTyCon tyCon -> argTys
-    _					      -> 
-      pprPanic "NDPCoreUtils.tupleTyArgs: wrong type: " (ppr ty)
-
--- determines the argument and result type of a function type (EXPORTED)
---
-funTyArgs :: Type -> (Type, Type)
-funTyArgs  = splitFunTy
-
--- for a type of the form `[:t:]', yield `t' (EXPORTED)
---
---  * if the type has any other form, a fatal error occurs
---
-parrElemTy    :: Type -> Type
-parrElemTy ty  = 
-  case splitTyConApp_maybe ty of
-    Just (tyCon, [argTy]) | tyCon == parrTyCon -> argTy
-    _							     -> 
-      pprPanic "NDPCoreUtils.parrElemTy: wrong type: " (ppr ty)
-
-
--- Core generation functions
--- -------------------------
-
--- make a tuple construction expression from a list of argument types and
--- argument values (EXPORTED)
---
---  * the two lists need to be of the same length
---
-mkTuple                                  :: [Type] -> [CoreExpr] -> CoreExpr
-mkTuple []  []                            = Var unitDataConId
-mkTuple [_] [e]                           = e
-mkTuple ts  es  | length ts == length es  = 
-  mkConApp (tupleCon Boxed (length es)) (map Type ts ++ es)
-mkTuple _   _                             =
-  panic "NDPCoreUtils.mkTuple: mismatch between number of types and exprs!"
-
--- make a boxed integer from an unboxed one (EXPORTED)
---
-mkInt   :: CoreExpr -> CoreExpr
-mkInt e  = mkConApp intDataCon [e]
-
-
--- query functions
--- ---------------
-
--- checks whether a given case alternative is a default alternative (EXPORTED)
---
-isDefault                 :: CoreAlt -> Bool
-isDefault (DEFAULT, _, _)  = True
-isDefault _                = False
-
--- check whether a list of case alternatives in belongs to a case over a
--- literal type (EXPORTED) 
---
-isLit			      :: [CoreAlt] -> Bool
-isLit ((DEFAULT, _, _ ):alts)  = isLit alts
-isLit ((LitAlt _, _, _):_   )  = True
-isLit _                        = False
-
--- FIXME: this function should get a more expressive name and maybe also a
---	  more detailed return type (depends on how the analysis goes)
-isSimpleExpr:: CoreExpr -> Bool
-isSimpleExpr _ =
-  -- FIXME
-  False
-
-
---  Substitution
---  -------------
-
-substIdEnv:: IdEnv Id -> CoreExpr -> CoreExpr
-substIdEnv env e@(Lit _) = e
-substIdEnv env e@(Var id)  =
-  case (lookupVarEnv env id) of
-    Just v -> (Var v)
-    _      -> e
-substIdEnv env (App e arg) =
-  App (substIdEnv env e) (substIdEnv env arg)
-substIdEnv env (Lam b expr) =
-  Lam b (substIdEnv (delVarEnv env b) expr)
-substIdEnv env (Let (NonRec b expr1) expr2) =
-  Let (NonRec b (substIdEnv env expr1)) 
-         (substIdEnv (delVarEnv env b) expr2)
-substIdEnv env (Let (Rec bnds) expr) = 
-   let 
-     newEnv  = delVarEnvList env (map fst bnds)
-     newExpr = substIdEnv newEnv expr 
-     substBnd (b,e) = (b, substIdEnv newEnv e)      
-   in Let (Rec (map substBnd bnds)) newExpr
-substIdEnv env (Case expr b ty alts) =
-   Case (substIdEnv newEnv expr) b ty (map substAlt alts)
-   where
-     newEnv = delVarEnv env b
-     substAlt (c, bnds, expr) =
-       (c, bnds, substIdEnv (delVarEnvList env bnds) expr)
-substIdEnv env (Note n expr) =
-  Note n (substIdEnv env expr)
-substIdEnv env e@(Type t) = e
diff --git a/ghc/compiler/ndpFlatten/PArrAnal.hs b/ghc/compiler/ndpFlatten/PArrAnal.hs
deleted file mode 100644
index 2db56221b2..0000000000
--- a/ghc/compiler/ndpFlatten/PArrAnal.hs
+++ /dev/null
@@ -1,203 +0,0 @@
---  $Id$
---
---  Copyright (c) 2002 Manuel M T Chakravarty & Gabriele Keller
---  
---  Analysis phase for an optimised flattening transformation
---
---- DESCRIPTION ---------------------------------------------------------------
---
---  This module implements an analysis phase that identifies Core expressions
---  that need not be transformed during flattening.  The expressions when
---  executed in a parallel context are implemented as an iteration over the
---  original scalar computation, instead of vectorising the computation.  This
---  usually improves efficiency by increasing locality and also reduces code
---  size. 
---
---- DOCU ----------------------------------------------------------------------
---
---  Language: Haskell 98 with C preprocessor
---
--- Analyse the expression and annotate each simple subexpression accordingly. 
---
---  The result of the analysis is stored in a new field in IdInfo (has yet to
---  be extended)
---
---  A simple expression is any expression which is not a function, not of
---  recursive type and does not contain a value of PArray type. Polymorphic
---  variables are simple expressions even though they might be instantiated to
---  a parray value or function.
---
---- TODO ----------------------------------------------------------------------
---
-
-module PArrAnal (
-  markScalarExprs	-- :: [CoreBind] -> [CoreBind]
-) where
-
-import Panic   (panic)
-import Outputable (pprPanic, ppr)
-import CoreSyn (CoreBind)
-
-import TypeRep      (Type(..))
-import Var (Var(..),Id)
-import Literal      (Literal)
-import CoreSyn (Expr(..),CoreExpr,Bind(..))
-import PprCore ( {- instances -} )
--- 
-
-data ArrayUsage = Prim | NonPrim | Array 
-                | PolyExpr (Id -> Maybe (ArrayUsage -> ArrayUsage))
-                | PolyFun (ArrayUsage -> ArrayUsage)
-
-         
-arrUsage:: CoreExpr -> ArrayUsage
-arrUsage (Var id)  = varArrayUsage id
-arrUsage (Lit lit) = litArrayUsage lit
-arrUsage (App expr1 expr2) =
-  let
-    arr1 = arrUsage expr1
-    arr2 = arrUsage expr2
-  in 
-  case (arr1, arr2) of   
-    (_,        Array)  -> Array
-    (PolyFun f, _)     -> f arr2
-    (_, _)             -> arr1
-
-arrUsage (Lam b expr) =
-  bindType (b, expr)
-
-arrUsage (Let (NonRec b expr1) expr2) =
-  arrUsage (App (Lam b expr2) expr1)
-
-arrUsage (Let (Rec bnds) expr) =
-  let 
-    t1 = foldr combineArrayUsage Prim (map bindType bnds)
-    t2 = arrUsage expr
-  in if isArrayUsage t1 then Array else t2
-
-arrUsage (Case expr b _ alts) = 
-  let 
-    t1 = arrUsage expr
-    t2 = scanType (map (arrUsage . (\ (_,_,x) -> x)) alts)
-  in scanType [t1, t2]
-
-arrUsage (Note n expr) =
-  arrUsage expr
-
-arrUsage (Type t) =
-  typeArrayUsage  t
-
-bindType (b, expr) =
-  let
-    bT    = varArrayUsage b
-    exprT = arrUsage expr
-  in case (bT, exprT) of
-       (Array, _) -> Array
-       _          -> exprT
-
-scanType:: [ArrayUsage] -> ArrayUsage
-scanType [t]        = t
-scanType (Array:ts) = Array
-scanType (_:ts)     = scanType ts
-  
-
-
--- the code expression represents a built-in function which generates
--- an array
-isArrayGen:: CoreExpr -> Bool
-isArrayGen _ = 
-  panic "PArrAnal: isArrayGen: not yet implemented"
-
-isArrayCon:: CoreExpr -> Bool
-isArrayCon _ = 
-  panic "PArrAnal: isArrayCon: not yet implemented"
-
-markScalarExprs:: [CoreBind] -> [CoreBind]
-markScalarExprs _ =
-  panic "PArrAnal.markScalarExprs: not implemented yet"
-
-
-varArrayUsage:: Id -> ArrayUsage
-varArrayUsage =
-  panic "PArrAnal.varArrayUsage: not yet implented"
-
-litArrayUsage:: Literal -> ArrayUsage
-litArrayUsage =
-  panic "PArrAnal.litArrayUsage: not yet implented"
-
-
-typeArrayUsage:: Type -> ArrayUsage
-typeArrayUsage (TyVarTy tvar) = 
-  PolyExpr (tIdFun tvar)
-typeArrayUsage (AppTy _ _) =
-   panic "PArrAnal.typeArrayUsage: AppTy case not yet implemented"
-typeArrayUsage (TyConApp tc tcargs) =
-  let
-    tcargsAU = map typeArrayUsage tcargs
-    tcCombine  = foldr combineArrayUsage Prim tcargsAU
-  in auCon tcCombine
-typeArrayUsage t@(PredTy _) =
-  pprPanic "PArrAnal.typeArrayUsage: encountered 'PredType - shouldn't be here!"
-           (ppr t)                 
- 
-
-combineArrayUsage:: ArrayUsage -> ArrayUsage -> ArrayUsage 
-combineArrayUsage Array _  = Array 
-combineArrayUsage _ Array  = Array 
-combineArrayUsage (PolyExpr f1) (PolyExpr f2) =
-  PolyExpr f'   
-  where 
-    f' var = 
-      let
-        f1lookup = f1 var
-        f2lookup = f2 var
-       in 
-       case (f1lookup, f2lookup) of
-         (Nothing, _) -> f2lookup
-         (_, Nothing) -> f1lookup
-         (Just f1', Just f2') -> Just ( \e -> (combineArrayUsage (f1' e) (f2' e)))
-combineArrayUsage (PolyFun f) (PolyExpr g) = 
-        panic ("PArrAnal.typeArrayUsage: PolyFun as argument in data" ++
-               " constructor - should not (?) happen\n")
-combineArrayUsage (PolyExpr g) (PolyFun f)  = 
-        panic ("PArrAnal.typeArrayUsage: PolyFun as argument in data" ++
-               " constructor - should not (?) happen\n")
-combineArrayUsage NonPrim _ = NonPrim
-combineArrayUsage _ NonPrim = NonPrim
-combineArrayUsage Prim Prim = Prim
-
-
-isArrayUsage:: ArrayUsage -> Bool
-isArrayUsage Array = True
-isArrayUsage _     = False
-
---  Functions to serve as arguments for PolyExpr
---  ---------------------------------------------
-
-tIdFun:: Var -> Var -> Maybe (ArrayUsage -> ArrayUsage) 
-tIdFun t tcomp =
-  if t == tcomp then
-     Just auId
-  else
-     Nothing  
-
--- Functions to serve as argument for PolyFun
--- -------------------------------------------
-
-auId:: ArrayUsage -> ArrayUsage 
-auId = id
-
-auCon:: ArrayUsage -> ArrayUsage
-auCon Prim = NonPrim
-auCon (PolyExpr f) = PolyExpr f'
-  where f' v  = case f v of
-                   Nothing -> Nothing
-                   Just g  -> Just  ( \e -> (auCon (g e)))
-auCon (PolyFun f)  = PolyFun (auCon . f)
-auCon _    = Array
-
--- traversal of Core expressions
--- -----------------------------
-
--- FIXME: implement
-
diff --git a/ghc/compiler/ndpFlatten/TODO b/ghc/compiler/ndpFlatten/TODO
deleted file mode 100644
index e596609205..0000000000
--- a/ghc/compiler/ndpFlatten/TODO
+++ /dev/null
@@ -1,202 +0,0 @@
-	           TODO List for Flattening Support in GHC	     -*-text-*-
-		   =======================================
-
-Middle-End Related
-~~~~~~~~~~~~~~~~~~
-
-Flattening Transformation
-~~~~~~~~~~~~~~~~~~~~~~~~~
-
-* Complete and test
-
-* Complete the analysis
-
-* Type transformation: The idea solution would probably be if we can add some
-  generic machinery, so that we can define all the rules for handling the type
-  and value transformations in a library.  (The PrelPArr for WayNDP.)
-
-
-Library Related
-~~~~~~~~~~~~~~~
-
-* Problem with re-exporting PrelPArr from Prelude is that it would also be
-  visible when -pparr is not given.  There should be a mechanism to implicitly
-  import more than one module (like PERVASIVE modules in M3)
-
-* We need a PrelPArr-like library for when flattening is used, too.  In fact,
-  we need some library routines that are on the level of merely vectorised
-  code (eg, for the dummy default vectors), and then, all the `PArrays' stuff
-  implementing fast unboxed arrays and fusion.
-
-* Enum is a problem.  Ideally, we would like `enumFromToP' and
-  `enumFromThenToP' to be members of `Enum'.  On the other hand, we really do
-  not want to change `Enum'.  The solution for the moment is to define
-
-    enumFromTo x y       = mapP toEnum [:fromEnum x .. fromEnum y:]
-    enumFromThenTo x y z = mapP toEnum [:fromEnum x, fromEnum y .. fromEnum z:]
-
-  like the Haskell Report does for the list versions.  This is hopefully
-  efficient enough as array fusion should fold the two traversals into one.
-  [DONE]
-
-
-DOCU that should go into the Commentary
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-The type constructor [::]
--------------------------
-
-The array type constructor [::] is quite similar to [] (list constructor) in
-that GHC has to know about it (in TysWiredIn); however, there are some
-differences:
-
-* [::] is an abstract type, whereas [] is not
-
-* if flattening is switched on, all occurences of the type are actually
-  removed by appropriate program transformations.
-
-The module PrelPArr that actually implements nested parallel arrays.  [::] is
-eliminated only if in addition to array support, flattening is activated.  It
-is just an option rather than the only method to implement those arrays.
-
-  Flags: -fparr	      -- syntactic support for parallel arrays (via `PrelPArr')
-			 * Dynamic hsc option; can be reversed with -fno-parr
-	 -fflatten    -- flattening transformation
-			 * Static hsc option
-	 -ndp	      -- this a way option, which implies -fparr and -fflatten
-			 (way options are handled by the driver and are not
-			 directly seen by hsc)
-	 -ddump-vect  -- dump Core after vectorisation
-		         * Dynamic hsc option
-
-* PrelPArr implements array variants of the Prelude list functions plus some
-  extra functions (also, some list functions (eg, those generating infinite
-  lists) have been left out.
-
-* prelude/PrelNames has been extended with all the names from PrelPArr that
-  need to be known inside the compiler
-
-* The variable GhcSupportsPArr, which can be set in build.mk decides whether
-  `PrelPArr' is to be compiled or not.  (We probably need to supress compiling
-  PrelPArr in WayNDP, or rather replace it with a different PrelPArr.)
-
-* Say something about `TysWiredIn.parrTyCon' as soon as we know how it
-  actually works... 
-
-Parser and AST Notes:
-- Parser and AST is quite straight forward.  Essentially, the list cases
-  duplicated with a name containing `PArr' or `parr' and modified to fit the
-  slightly different semantics (ie, finite length, strict).
-- The value and pattern `[::]' is an empty explicit parallel array (ie,
-  something of the form `ExplicitPArr ty []' in the AST).  This is in contrast
-  to lists, which use the nil-constructor instead.  In the case of parallel
-  arrays, using a constructor would be rather awkward, as it is not a
-  constructor-based type.
-- Thus, array patterns have the general form `[:p1, p2, ..., pn:]', where n >=
-  0.  Thus, two array patterns overlap iff they have the same length.
-- The type constructor for parallel is internally represented as a
-  `TyCon.AlgTyCon' with a wired in definition in `TysWiredIn'.  
-
-Desugarer Notes:
-- Desugaring of patterns involving parallel arrays:
-  * In Match.tidy1, we use fake array constructors; ie, any pattern `[:p1, ...,
-    pn:]' is replaces by the expression `MkPArr<n> p1 ... pn', where
-    `MkPArr<n>' is the n-ary array constructor.  These constructors are fake,
-    because they are never used to actually represent array values; in fact,
-    they are removed again before pattern compilation is finished.  However,
-    the use of these fake constructors implies that we need not modify large
-    parts of the machinery of the pattern matching compiler, as array patterns
-    are handled like any other constructor pattern.
-  * Check.simplify_pat introduces the same fake constructors as Match.tidy1
-    and removed again by Check.make_con.
-  * In DsUtils.mkCoAlgCaseMatchResult, we catch the case of array patterns and
-    generate code as the following example illustrates, where the LHS is the
-    code that would be produced if array construtors would really exist:
-
-      case v of pa {
-	MkPArr1 x1       -> e1
-	MkPArr2 x2 x3 x4 -> e2
-	DFT	         -> e3
-      }
-
-    =>
-
-      case lengthP v of
-        Int# i# -> 
-	  case i# of l {
-	    1   -> let x1 = v!:0                       in e1
-	    3   -> let x2 = v!:0; x2 = v!:1; x3 = v!:2 in e2
-	    DFT ->					      e3
-	  }
-  * The desugaring of array comprehensions is in `DsListComp', but follows
-    rules that are different from that for translating list comprehensions.
-    Denotationally, it boils down to the same, but the operational
-    requirements for an efficient implementation of array comprehensions are
-    rather different.
-
-    [:e | qss:] = <<[:e | qss:]>> () [:():]
-
-    <<[:e' |           :]>> pa ea = mapP (\pa -> e') ea
-    <<[:e' | b     , qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea)
-    <<[:e' | p <- e, qs:]>> pa ea = 
-      let ef = filterP (\x -> case x of {p -> True; _ -> False}) e
-      in
-      <<[:e' | qs:]>> (pa, p) (crossP ea ef)
-    <<[:e' | let ds, qs:]>> pa ea = 
-      <<[:e' | qs:]>> (pa, (x_1, ..., x_n)) 
-		      (mapP (\v@pa -> (v, let ds in (x_1, ..., x_n))) ea)
-    where
-      {x_1, ..., x_n} = DV (ds)		-- Defined Variables
-    <<[:e' | qs | qss:]>>   pa ea = 
-      <<[:e' | qss:]>> (pa, (x_1, ..., x_n)) 
-		       (zipP ea <<[:(x_1, ..., x_n) | qs:]>>)
-    where
-      {x_1, ..., x_n} = DV (qs)
-
-    Moreover, we have
-
-      crossP       :: [:a:] -> [:b:] -> [:(a, b):]
-      crossP a1 a2  = let
-			len1 = lengthP a1
-			len2 = lengthP a2
-			x1   = concatP $ mapP (replicateP len2) a1
-			x2   = concatP $ replicateP len1 a2
-		      in
-		      zipP x1 x2
-
-    For a more efficient implementation of `crossP', see `PrelPArr'.
-
-    Optimisations: 
-    - In the `p <- e' rule, if `pa = ()', drop it and simplify the `crossP ea
-      e' to `e'.
-    - We assume that fusion will optimise sequences of array processing
-      combinators.
-    - Do we want to have the following function?
-
-        mapFilterP :: (a -> Maybe b) -> [:a:] -> [:b:]
-
-      Even with fusion `(mapP (\p -> e) . filterP (\p -> b))' may still result
-      in redundant pattern matching operations.  (Let's wait with this until
-      we have seen what the Simplifier does to the generated code.)
-
-Flattening Notes:
-* The story about getting access to all the names like "fst" etc that we need
-  to generate during flattening is quite involved.  To have a reasonable
-  chance to get at the stuff, we need to put flattening inbetween the
-  desugarer and the simplifier as an extra pass in HscMain.hscMain.  After
-  that point, the persistent compiler state is zapped (for heap space
-  reduction reasons, I guess) and nothing remains of the imported interfaces
-  in one shot mode.
-
-  Moreover, to get the Ids that we need into the type environment, we need to
-  force the renamer to include them.  This is done in
-  RnEnv.getImplicitModuleFVs, which computes all implicitly imported names.
-  We let it add the names from FlattenInfo.namesNeededForFlattening.
-
-  Given all these arrangements, FlattenMonad can obtain the needed Ids from
-  the persistent compiler state without much further hassle.
-
-  [It might be worthwhile to document in the non-Flattening part of the
-  Commentary that the persistent compiler state is zapped after desugaring and
-  how the free variables determined by the renamer imply which names are
-  imported.] 
diff --git a/ghc/compiler/package.conf.in b/ghc/compiler/package.conf.in
deleted file mode 100644
index b356e90000..0000000000
--- a/ghc/compiler/package.conf.in
+++ /dev/null
@@ -1,300 +0,0 @@
-name:		PACKAGE
-version:	VERSION
-license:	BSD3
-maintainer:	glasgow-haskell-users@haskell.org
-exposed:	False
-
-exposed-modules:
-	AsmCodeGen
-	Bag
-	BasicTypes
-	BinIface
-	Binary
-	BitSet
-	Bitmap
-	BuildTyCl
-	ByteCodeAsm
-	ByteCodeFFI
-	ByteCodeGen
-	ByteCodeInstr
-	ByteCodeItbls
-	ByteCodeLink
-	CLabel
-	CSE
-	CgBindery
-	CgCallConv
-	CgCase
-	CgClosure
-	CgCon
-	CgExpr
-	CgForeignCall
-	CgHeapery
-	CgInfoTbls
-	CgLetNoEscape
-	CgMonad
-	CgParallel
-	CgPrimOp
-	CgProf
-	CgStackery
-	CgTailCall
-	CgTicky
-	CgUtils
-	Check
-	Class
-	ClosureInfo
-	CmdLineParser
-	Cmm
-	CmmLex
-	CmmLint
-	CmmParse
-	CmmUtils
-	CodeGen
-	CodeOutput
-	Config
-	Constants
-	Convert
-	CoreFVs
-	CoreLint
-	CorePrep
-	CoreSubst
-	CoreSyn
-	CoreTidy
-	CoreToStg
-	CoreUnfold
-	CoreUtils
-	CostCentre
-	CprAnalyse
-	Ctype
-	DataCon
-	Demand
-	Desugar
-	Digraph
-	DmdAnal
-	DriverMkDepend
-	DriverPhases
-	DriverPipeline
-	DsArrows
-	DsBinds
-	DsCCall
-	DsExpr
-	DsForeign
-	DsGRHSs
-	DsListComp
-	DsMeta
-	DsMonad
-	DsUtils
-	DynFlags
-	ErrUtils
-	ExternalCore
-	FastMutInt
-        Encoding
-	FastString
-	FastTypes
-	FieldLabel
-	Finder
-	FiniteMap
-	FlattenInfo
-	FlattenMonad
-	Flattening
-	FloatIn
-	FloatOut
-	ForeignCall
-	FunDeps
-	GHC
-	Generics
-        HeaderInfo
-	HsBinds
-	HsDecls
-	HsExpr
-	HsImpExp
-	HsLit
-	HsPat
-	HsSyn
-	HsTypes
-	HsUtils
-	HscMain
-	HscStats
-	HscTypes
-	IOEnv
-	Id
-	IdInfo
-	IfaceEnv
-	IfaceSyn
-	IfaceType
-	IlxGen
-	Inst
-	InstEnv
-	Java
-	JavaGen
-	InteractiveUI
-	Kind
-	Lexer
-	LexCore
-	LiberateCase
-	Linker
-	ListSetOps
-	Literal
-	LoadIface
-	MachCodeGen
-	MachInstrs
-	MachOp
-	MachRegs
-	Match
-	MatchCon
-	MatchLit
-	Maybes
-	MkExternalCore
-	MkId
-	MkIface
-	Module
-	NCGMonad
-	NDPCoreUtils
-	Name
-	NameEnv
-	NameSet
-	NewDemand
-	ObjLink
-	OccName
-	OccurAnal
-	OrdList
-	Outputable
-	PArrAnal
-	PackageConfig
-	Packages
-	Panic
-	Parser
-	ParserCoreUtils
-	ParsePkgConf
-	PositionIndependentCode
-	PprC
-	PprCmm
-	PprCore
-	PprExternalCore
-	PprMach
-	PprTyThing
-	PrelInfo
-	PrelNames
-	PrintJava
-	PrelRules
-	Pretty
-	PrimOp
-	RdrHsSyn
-	RdrName
-	RegAllocInfo
-	RegisterAlloc
-	RnBinds
-	RnEnv
-	RnExpr
-	RnHsSyn
-	RnNames
-	RnSource
-	RnTypes
-	Rules
-	SAT
-	SATMonad
-	SCCfinal
-	SMRep
-	SRT
-	SaAbsInt
-	SaLib
-	SetLevels
-	SimplCore
-	SimplEnv
-	SimplMonad
-	SimplStg
-	SimplUtils
-	Simplify
-	SpecConstr
-	Specialise
-	SrcLoc
-	StaticFlags
-	StgLint
-	StgStats
-	StgSyn
-	StrictAnal
-	StringBuffer
-	SysTools
-	TcArrows
-	TcBinds
-	TcClassDcl
-	TcDefaults
-	TcDeriv
-	TcEnv
-	TcExpr
-	TcForeign
-	TcGenDeriv
-	TcHsSyn
-	TcHsType
-	TcIface
-	TcInstDcls
-	TcMType
-	TcMatches
-	TcPat
-	TcRnDriver
-	TcRnMonad
-	TcRnTypes
-	TcRules
-	TcSimplify
-	TcSplice
-	TcTyClsDecls
-	TcTyDecls
-	TcType
-	TcUnify
-	TidyPgm
-	TyCon
-	Type
-	TypeRep
-	TysPrim
-	TysWiredIn
-	Unify
-	UniqFM
-	UniqSet
-	UniqSupply
-	Unique
-	Util
-	Var
-	VarEnv
-	VarSet
-	WorkWrap
-	WwLib
-
-#ifdef INSTALLING
-import-dirs:	PKG_LIBDIR"/hslibs-imports/ghc"
-#else
-import-dirs:   FPTOOLS_TOP_ABS"/ghc/compiler/stage2/utils",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/basicTypes",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/types",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/hsSyn",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/prelude",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/rename",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/typecheck",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/deSugar",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/ghci",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/coreSyn",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/specialise",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/simplCore",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/stranal",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/stgSyn",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/simplStg",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/codeGen",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/main",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/profiling",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/parser",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/cprAnalysis",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/ndpFlatten",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/iface",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/cmm",
-	       FPTOOLS_TOP_ABS"/ghc/compiler/stage2/nativeGen"
-#endif
-
-#ifdef INSTALLING
-library-dirs:		LIB_DIR
-#else
-library-dirs:		FPTOOLS_TOP_ABS"/ghc/compiler"
-#endif
-
-hs-libraries: 		"HSghc"
-extra-libraries:
-depends: 		PKG_DEPENDS
-haddock-interfaces:	HADDOCK_IFACE
-haddock-html:		HTML_DIR
diff --git a/ghc/compiler/parser/Ctype.lhs b/ghc/compiler/parser/Ctype.lhs
deleted file mode 100644
index dbe4e9f1b0..0000000000
--- a/ghc/compiler/parser/Ctype.lhs
+++ /dev/null
@@ -1,341 +0,0 @@
-Character classification
-
-\begin{code}
-module Ctype
-	( is_ident	-- Char# -> Bool
-	, is_symbol	-- Char# -> Bool
-	, is_any	-- Char# -> Bool
-	, is_space	-- Char# -> Bool
-	, is_lower	-- Char# -> Bool
-	, is_upper	-- Char# -> Bool
-	, is_digit	-- Char# -> Bool
-	, is_alphanum   -- Char# -> Bool
-
-	, is_hexdigit, is_octdigit
-	, hexDigit, octDecDigit
-	) where
-
-#include "HsVersions.h"
-
-import DATA_INT		( Int32 )
-import DATA_BITS	( Bits((.&.)) )
-import Char		( ord, chr )
-\end{code}
-
-Bit masks
-
-\begin{code}
-cIdent, cSymbol, cAny, cSpace, cLower, cUpper, cDigit :: Int
-cIdent  =  1
-cSymbol =  2
-cAny    =  4
-cSpace  =  8
-cLower  = 16
-cUpper  = 32
-cDigit  = 64
-\end{code}
-
-The predicates below look costly, but aren't, GHC+GCC do a great job
-at the big case below.
-
-\begin{code}
-{-# INLINE is_ctype #-}
-is_ctype :: Int -> Char -> Bool
-is_ctype mask c = (fromIntegral (charType c) .&. fromIntegral mask) /= (0::Int32)
-
-is_ident, is_symbol, is_any, is_space, is_lower, is_upper, is_digit :: Char -> Bool
-is_ident  = is_ctype cIdent
-is_symbol = is_ctype cSymbol
-is_any    = is_ctype cAny
-is_space  = is_ctype cSpace
-is_lower  = is_ctype cLower
-is_upper  = is_ctype cUpper
-is_digit  = is_ctype cDigit
-is_alphanum = is_ctype (cLower+cUpper+cDigit)
-\end{code}
-
-Utils
-
-\begin{code}
-hexDigit :: Char -> Int
-hexDigit c | is_digit c = ord c - ord '0'
-           | otherwise  = ord (to_lower c) - ord 'a' + 10
-
-octDecDigit :: Char -> Int
-octDecDigit c = ord c - ord '0'
-
-is_hexdigit c
-	=  is_digit c 
-	|| (c >= 'a' && c <= 'f')
-	|| (c >= 'A' && c <= 'F')
-
-is_octdigit c = c >= '0' && c <= '7'
-
-to_lower c 
-  | c >=  'A' && c <= 'Z' = chr (ord c - (ord 'A' - ord 'a'))
-  | otherwise = c
-\end{code}
-
-We really mean .|. instead of + below, but GHC currently doesn't do
-any constant folding with bitops. *sigh*
-
-\begin{code}
-charType :: Char -> Int
-charType c = case c of
-   '\0'   -> 0                         -- \000
-   '\1'   -> 0                         -- \001
-   '\2'   -> 0                         -- \002
-   '\3'   -> 0                         -- \003
-   '\4'   -> 0                         -- \004
-   '\5'   -> 0                         -- \005
-   '\6'   -> 0                         -- \006
-   '\7'   -> 0                         -- \007
-   '\8'   -> 0                         -- \010
-   '\9'   -> cAny + cSpace             -- \t
-   '\10'  -> cSpace	               -- \n (not allowed in strings, so !cAny)
-   '\11'  -> cAny + cSpace             -- \v
-   '\12'  -> cAny + cSpace             -- \f
-   '\13'  -> cAny + cSpace             --  ^M
-   '\14'  -> 0                         -- \016
-   '\15'  -> 0                         -- \017
-   '\16'  -> 0                         -- \020
-   '\17'  -> 0                         -- \021
-   '\18'  -> 0                         -- \022
-   '\19'  -> 0                         -- \023
-   '\20'  -> 0                         -- \024
-   '\21'  -> 0                         -- \025
-   '\22'  -> 0                         -- \026
-   '\23'  -> 0                         -- \027
-   '\24'  -> 0                         -- \030
-   '\25'  -> 0                         -- \031
-   '\26'  -> 0                         -- \032
-   '\27'  -> 0                         -- \033
-   '\28'  -> 0                         -- \034
-   '\29'  -> 0                         -- \035
-   '\30'  -> 0                         -- \036
-   '\31'  -> 0                         -- \037
-   '\32'  -> cAny + cSpace             --
-   '\33'  -> cAny + cSymbol            -- !
-   '\34'  -> cAny                      -- "
-   '\35'  -> cAny + cSymbol            --  #
-   '\36'  -> cAny + cSymbol            --  $
-   '\37'  -> cAny + cSymbol            -- %
-   '\38'  -> cAny + cSymbol            -- &
-   '\39'  -> cAny + cIdent             -- '
-   '\40'  -> cAny                      -- (
-   '\41'  -> cAny                      -- )
-   '\42'  -> cAny + cSymbol            --  *
-   '\43'  -> cAny + cSymbol            -- +
-   '\44'  -> cAny                      -- ,
-   '\45'  -> cAny + cSymbol            -- -
-   '\46'  -> cAny + cSymbol            -- .
-   '\47'  -> cAny + cSymbol            --  /
-   '\48'  -> cAny + cIdent  + cDigit   -- 0
-   '\49'  -> cAny + cIdent  + cDigit   -- 1
-   '\50'  -> cAny + cIdent  + cDigit   -- 2
-   '\51'  -> cAny + cIdent  + cDigit   -- 3
-   '\52'  -> cAny + cIdent  + cDigit   -- 4
-   '\53'  -> cAny + cIdent  + cDigit   -- 5
-   '\54'  -> cAny + cIdent  + cDigit   -- 6
-   '\55'  -> cAny + cIdent  + cDigit   -- 7
-   '\56'  -> cAny + cIdent  + cDigit   -- 8
-   '\57'  -> cAny + cIdent  + cDigit   -- 9
-   '\58'  -> cAny + cSymbol            -- :
-   '\59'  -> cAny                      -- ;
-   '\60'  -> cAny + cSymbol            -- <
-   '\61'  -> cAny + cSymbol            -- =
-   '\62'  -> cAny + cSymbol            -- >
-   '\63'  -> cAny + cSymbol            -- ?
-   '\64'  -> cAny + cSymbol            -- @
-   '\65'  -> cAny + cIdent  + cUpper   -- A
-   '\66'  -> cAny + cIdent  + cUpper   -- B
-   '\67'  -> cAny + cIdent  + cUpper   -- C
-   '\68'  -> cAny + cIdent  + cUpper   -- D
-   '\69'  -> cAny + cIdent  + cUpper   -- E
-   '\70'  -> cAny + cIdent  + cUpper   -- F
-   '\71'  -> cAny + cIdent  + cUpper   -- G
-   '\72'  -> cAny + cIdent  + cUpper   -- H
-   '\73'  -> cAny + cIdent  + cUpper   -- I
-   '\74'  -> cAny + cIdent  + cUpper   -- J
-   '\75'  -> cAny + cIdent  + cUpper   -- K
-   '\76'  -> cAny + cIdent  + cUpper   -- L
-   '\77'  -> cAny + cIdent  + cUpper   -- M
-   '\78'  -> cAny + cIdent  + cUpper   -- N
-   '\79'  -> cAny + cIdent  + cUpper   -- O
-   '\80'  -> cAny + cIdent  + cUpper   -- P
-   '\81'  -> cAny + cIdent  + cUpper   -- Q
-   '\82'  -> cAny + cIdent  + cUpper   -- R
-   '\83'  -> cAny + cIdent  + cUpper   -- S
-   '\84'  -> cAny + cIdent  + cUpper   -- T
-   '\85'  -> cAny + cIdent  + cUpper   -- U
-   '\86'  -> cAny + cIdent  + cUpper   -- V
-   '\87'  -> cAny + cIdent  + cUpper   -- W
-   '\88'  -> cAny + cIdent  + cUpper   -- X
-   '\89'  -> cAny + cIdent  + cUpper   -- Y
-   '\90'  -> cAny + cIdent  + cUpper   -- Z
-   '\91'  -> cAny                      -- [
-   '\92'  -> cAny + cSymbol            -- backslash
-   '\93'  -> cAny                      -- ]
-   '\94'  -> cAny + cSymbol            --  ^
-   '\95'  -> cAny + cIdent  + cLower   -- _
-   '\96'  -> cAny                      -- `
-   '\97'  -> cAny + cIdent  + cLower   -- a
-   '\98'  -> cAny + cIdent  + cLower   -- b
-   '\99'  -> cAny + cIdent  + cLower   -- c
-   '\100' -> cAny + cIdent  + cLower   -- d
-   '\101' -> cAny + cIdent  + cLower   -- e
-   '\102' -> cAny + cIdent  + cLower   -- f
-   '\103' -> cAny + cIdent  + cLower   -- g
-   '\104' -> cAny + cIdent  + cLower   -- h
-   '\105' -> cAny + cIdent  + cLower   -- i
-   '\106' -> cAny + cIdent  + cLower   -- j
-   '\107' -> cAny + cIdent  + cLower   -- k
-   '\108' -> cAny + cIdent  + cLower   -- l
-   '\109' -> cAny + cIdent  + cLower   -- m
-   '\110' -> cAny + cIdent  + cLower   -- n
-   '\111' -> cAny + cIdent  + cLower   -- o
-   '\112' -> cAny + cIdent  + cLower   -- p
-   '\113' -> cAny + cIdent  + cLower   -- q
-   '\114' -> cAny + cIdent  + cLower   -- r
-   '\115' -> cAny + cIdent  + cLower   -- s
-   '\116' -> cAny + cIdent  + cLower   -- t
-   '\117' -> cAny + cIdent  + cLower   -- u
-   '\118' -> cAny + cIdent  + cLower   -- v
-   '\119' -> cAny + cIdent  + cLower   -- w
-   '\120' -> cAny + cIdent  + cLower   -- x
-   '\121' -> cAny + cIdent  + cLower   -- y
-   '\122' -> cAny + cIdent  + cLower   -- z
-   '\123' -> cAny                      -- {
-   '\124' -> cAny + cSymbol            --  |
-   '\125' -> cAny                      -- }
-   '\126' -> cAny + cSymbol            -- ~
-   '\127' -> 0                         -- \177
-   '\128' -> 0                         -- \200
-   '\129' -> 0                         -- \201
-   '\130' -> 0                         -- \202
-   '\131' -> 0                         -- \203
-   '\132' -> 0                         -- \204
-   '\133' -> 0                         -- \205
-   '\134' -> 0                         -- \206
-   '\135' -> 0                         -- \207
-   '\136' -> 0                         -- \210
-   '\137' -> 0                         -- \211
-   '\138' -> 0                         -- \212
-   '\139' -> 0                         -- \213
-   '\140' -> 0                         -- \214
-   '\141' -> 0                         -- \215
-   '\142' -> 0                         -- \216
-   '\143' -> 0                         -- \217
-   '\144' -> 0                         -- \220
-   '\145' -> 0                         -- \221
-   '\146' -> 0                         -- \222
-   '\147' -> 0                         -- \223
-   '\148' -> 0                         -- \224
-   '\149' -> 0                         -- \225
-   '\150' -> 0                         -- \226
-   '\151' -> 0                         -- \227
-   '\152' -> 0                         -- \230
-   '\153' -> 0                         -- \231
-   '\154' -> 0                         -- \232
-   '\155' -> 0                         -- \233
-   '\156' -> 0                         -- \234
-   '\157' -> 0                         -- \235
-   '\158' -> 0                         -- \236
-   '\159' -> 0                         -- \237
-   '\160' -> cSpace                    --
-   '\161' -> cAny + cSymbol            -- ¡
-   '\162' -> cAny + cSymbol            -- ¢
-   '\163' -> cAny + cSymbol            -- £
-   '\164' -> cAny + cSymbol            -- ¤
-   '\165' -> cAny + cSymbol            -- ¥
-   '\166' -> cAny + cSymbol            -- ¦
-   '\167' -> cAny + cSymbol            -- §
-   '\168' -> cAny + cSymbol            -- ¨
-   '\169' -> cAny + cSymbol            -- ©
-   '\170' -> cAny + cSymbol            -- ª
-   '\171' -> cAny + cSymbol            -- «
-   '\172' -> cAny + cSymbol            -- ¬
-   '\173' -> cAny + cSymbol            -- ­
-   '\174' -> cAny + cSymbol            -- ®
-   '\175' -> cAny + cSymbol            -- ¯
-   '\176' -> cAny + cSymbol            -- °
-   '\177' -> cAny + cSymbol            -- ±
-   '\178' -> cAny + cSymbol            -- ²
-   '\179' -> cAny + cSymbol            -- ³
-   '\180' -> cAny + cSymbol            -- ´
-   '\181' -> cAny + cSymbol            -- µ
-   '\182' -> cAny + cSymbol            -- ¶
-   '\183' -> cAny + cSymbol            -- ·
-   '\184' -> cAny + cSymbol            -- ¸
-   '\185' -> cAny + cSymbol            -- ¹
-   '\186' -> cAny + cSymbol            -- º
-   '\187' -> cAny + cSymbol            -- »
-   '\188' -> cAny + cSymbol            -- ¼
-   '\189' -> cAny + cSymbol            -- ½
-   '\190' -> cAny + cSymbol            -- ¾
-   '\191' -> cAny + cSymbol            -- ¿
-   '\192' -> cAny + cIdent  + cUpper   -- À
-   '\193' -> cAny + cIdent  + cUpper   -- �
-   '\194' -> cAny + cIdent  + cUpper   -- Â
-   '\195' -> cAny + cIdent  + cUpper   -- Ã
-   '\196' -> cAny + cIdent  + cUpper   -- Ä
-   '\197' -> cAny + cIdent  + cUpper   -- Ã…
-   '\198' -> cAny + cIdent  + cUpper   -- Æ
-   '\199' -> cAny + cIdent  + cUpper   -- Ç
-   '\200' -> cAny + cIdent  + cUpper   -- È
-   '\201' -> cAny + cIdent  + cUpper   -- É
-   '\202' -> cAny + cIdent  + cUpper   -- Ê
-   '\203' -> cAny + cIdent  + cUpper   -- Ë
-   '\204' -> cAny + cIdent  + cUpper   -- Ì
-   '\205' -> cAny + cIdent  + cUpper   -- �
-   '\206' -> cAny + cIdent  + cUpper   -- ÃŽ
-   '\207' -> cAny + cIdent  + cUpper   -- �
-   '\208' -> cAny + cIdent  + cUpper   -- �
-   '\209' -> cAny + cIdent  + cUpper   -- Ñ
-   '\210' -> cAny + cIdent  + cUpper   -- Ã’
-   '\211' -> cAny + cIdent  + cUpper   -- Ó
-   '\212' -> cAny + cIdent  + cUpper   -- Ô
-   '\213' -> cAny + cIdent  + cUpper   -- Õ
-   '\214' -> cAny + cIdent  + cUpper   -- Ö
-   '\215' -> cAny + cSymbol + cLower   -- ×
-   '\216' -> cAny + cIdent  + cUpper   -- Ø
-   '\217' -> cAny + cIdent  + cUpper   -- Ù
-   '\218' -> cAny + cIdent  + cUpper   -- Ú
-   '\219' -> cAny + cIdent  + cUpper   -- Û
-   '\220' -> cAny + cIdent  + cUpper   -- Ü
-   '\221' -> cAny + cIdent  + cUpper   -- �
-   '\222' -> cAny + cIdent  + cUpper   -- Þ
-   '\223' -> cAny + cIdent             -- ß
-   '\224' -> cAny + cIdent  + cLower   -- à
-   '\225' -> cAny + cIdent  + cLower   -- á
-   '\226' -> cAny + cIdent  + cLower   -- â
-   '\227' -> cAny + cIdent  + cLower   -- ã
-   '\228' -> cAny + cIdent  + cLower   -- ä
-   '\229' -> cAny + cIdent  + cLower   -- å
-   '\230' -> cAny + cIdent  + cLower   -- æ
-   '\231' -> cAny + cIdent  + cLower   -- ç
-   '\232' -> cAny + cIdent  + cLower   -- è
-   '\233' -> cAny + cIdent  + cLower   -- é
-   '\234' -> cAny + cIdent  + cLower   -- ê
-   '\235' -> cAny + cIdent  + cLower   -- ë
-   '\236' -> cAny + cIdent  + cLower   -- ì
-   '\237' -> cAny + cIdent  + cLower   -- í
-   '\238' -> cAny + cIdent  + cLower   -- î
-   '\239' -> cAny + cIdent  + cLower   -- ï
-   '\240' -> cAny + cIdent  + cLower   -- ð
-   '\241' -> cAny + cIdent  + cLower   -- ñ
-   '\242' -> cAny + cIdent  + cLower   -- ò
-   '\243' -> cAny + cIdent  + cLower   -- ó
-   '\244' -> cAny + cIdent  + cLower   -- ô
-   '\245' -> cAny + cIdent  + cLower   -- õ
-   '\246' -> cAny + cIdent  + cLower   -- ö
-   '\247' -> cAny + cSymbol            -- ÷
-   '\248' -> cAny + cIdent             -- ø
-   '\249' -> cAny + cIdent  + cLower   -- ù
-   '\250' -> cAny + cIdent  + cLower   -- ú
-   '\251' -> cAny + cIdent  + cLower   -- û
-   '\252' -> cAny + cIdent  + cLower   -- ü
-   '\253' -> cAny + cIdent  + cLower   -- ý
-   '\254' -> cAny + cIdent  + cLower   -- þ
-   '\255' -> cAny + cIdent  + cLower   -- ÿ
-\end{code}
diff --git a/ghc/compiler/parser/LexCore.hs b/ghc/compiler/parser/LexCore.hs
deleted file mode 100644
index 1a545a3e43..0000000000
--- a/ghc/compiler/parser/LexCore.hs
+++ /dev/null
@@ -1,130 +0,0 @@
-module LexCore where
-
-import ParserCoreUtils
-import Ratio
-import Char
-import qualified Numeric( readFloat, readDec )
-
-isNameChar c = isAlpha c || isDigit c || (c == '_') || (c == '\'') 
-isKeywordChar c = isAlpha c || (c == '_') 
-
-lexer :: (Token -> P a) -> P a 
-lexer cont [] 		= cont TKEOF []
-lexer cont ('\n':cs) 	= \line -> lexer cont cs (line+1)
-lexer cont ('-':'>':cs) = cont TKrarrow cs
-
-lexer cont (c:cs) 
-      | isSpace c		= lexer cont cs
-      | isLower c || (c == '_') = lexName cont TKname (c:cs)
-      | isUpper c 		= lexName cont TKcname (c:cs)
-      | isDigit c || (c == '-') = lexNum cont (c:cs)
-
-lexer cont ('%':cs)  	= lexKeyword cont cs
-lexer cont ('\'':cs) 	= lexChar cont cs
-lexer cont ('\"':cs) 	= lexString [] cont cs 
-lexer cont ('#':cs) 	= cont TKhash cs
-lexer cont ('(':cs) 	= cont TKoparen cs
-lexer cont (')':cs) 	= cont TKcparen cs
-lexer cont ('{':cs) 	= cont TKobrace cs
-lexer cont ('}':cs) 	= cont TKcbrace cs
-lexer cont ('=':cs)     = cont TKeq cs
-lexer cont (':':':':cs) = cont TKcoloncolon cs
-lexer cont ('*':cs) 	= cont TKstar cs
-lexer cont ('.':cs) 	= cont TKdot cs
-lexer cont ('\\':cs)    = cont TKlambda cs
-lexer cont ('@':cs) 	= cont TKat cs
-lexer cont ('?':cs) 	= cont TKquestion cs
-lexer cont (';':cs) 	= cont TKsemicolon cs
-lexer cont (c:cs) 	= failP "invalid character" [c]
-
-
-
-lexChar cont ('\\':'x':h1:h0:'\'':cs)
-	| isHexEscape [h1,h0] =  cont (TKchar (hexToChar h1 h0)) cs
-lexChar cont ('\\':cs) 	 = failP "invalid char character" ('\\':(take 10 cs))
-lexChar cont ('\'':cs) 	 = failP "invalid char character" ['\'']
-lexChar cont ('\"':cs) 	 = failP "invalid char character" ['\"']
-lexChar cont (c:'\'':cs) = cont (TKchar c) cs
-
-
-lexString s cont ('\\':'x':h1:h0:cs) 
-	| isHexEscape [h1,h0] = lexString (s++[hexToChar h1 h0]) cont cs
-lexString s cont ('\\':cs) = failP "invalid string character" ['\\']
-lexString s cont ('\'':cs) = failP "invalid string character" ['\'']
-lexString s cont ('\"':cs) = cont (TKstring s) cs
-lexString s cont (c:cs) = lexString (s++[c]) cont cs
-
-isHexEscape = all (\c -> isHexDigit c && (isDigit c || isLower c))
-
-hexToChar h1 h0 = chr (digitToInt h1 * 16 + digitToInt h0)
-
-
-lexNum cont cs =
-  case cs of
-     ('-':cs) -> f (-1) cs
-     _ 	      -> f 1 cs
- where f sgn cs = 
-         case span isDigit cs of
-          (digits,'.':c:rest) 
-		| isDigit c -> cont (TKrational (fromInteger sgn * r)) rest'
-	        where ((r,rest'):_) = readFloat (digits ++ ('.':c:rest))
-		-- When reading a floating-point number, which is
-		-- a bit complicated, use the Haskell 98 library function
-          (digits,rest) -> cont (TKinteger (sgn * (read digits))) rest
-
-lexName cont cstr cs = cont (cstr name) rest
-   where (name,rest) = span isNameChar cs
-
-lexKeyword cont cs = 
-   case span isKeywordChar cs of
-      ("module",rest) -> cont TKmodule rest
-      ("data",rest)  -> cont TKdata rest
-      ("newtype",rest) -> cont TKnewtype rest
-      ("forall",rest) -> cont TKforall rest	
-      ("rec",rest) -> cont TKrec rest	
-      ("let",rest) -> cont TKlet rest	
-      ("in",rest) -> cont TKin rest	
-      ("case",rest) -> cont TKcase rest	
-      ("of",rest) -> cont TKof rest	
-      ("coerce",rest) -> cont TKcoerce rest	
-      ("note",rest) -> cont TKnote rest	
-      ("external",rest) -> cont TKexternal rest
-      ("_",rest) -> cont TKwild rest
-      _ -> failP "invalid keyword" ('%':cs) 
-
-
-#if __GLASGOW_HASKELL__ >= 504
--- The readFloat in the Numeric library will do the job
-
-readFloat :: (RealFrac a) => ReadS a
-readFloat = Numeric.readFloat
-
-#else
--- Haskell 98's Numeric.readFloat used to have a bogusly restricted signature
--- so it was incapable of reading a rational.  
--- So for GHCs that have that old bogus library, here is the code, written out longhand.
-
-readFloat r    = [(fromRational ((n%1)*10^^(k-d)),t) | (n,d,s) <- readFix r,
-                                                       (k,t)   <- readExp s] ++
-                 [ (0/0, t) | ("NaN",t)      <- lex r] ++
-                 [ (1/0, t) | ("Infinity",t) <- lex r]
-               where 
-                 readFix r = [(read (ds++ds'), length ds', t)
-                             | (ds,d) <- lexDigits r,
-                               (ds',t) <- lexFrac d ]
-               
-                 lexFrac ('.':ds) = lexDigits ds
-                 lexFrac s        = [("",s)]        
-                 
-                 readExp (e:s) | e `elem` "eE" = readExp' s
-                 readExp s                     = [(0,s)]
-                 
-                 readExp' ('-':s) = [(-k,t) | (k,t) <- Numeric.readDec s]
-                 readExp' ('+':s) = Numeric.readDec s
-                 readExp' s       = Numeric.readDec s
-
-lexDigits :: ReadS String 
-lexDigits s =  case span isDigit s of
-		 (cs,s') | not (null cs) -> [(cs,s')]
-		 otherwise		 -> []
-#endif
diff --git a/ghc/compiler/parser/Lexer.x b/ghc/compiler/parser/Lexer.x
deleted file mode 100644
index 4c1b48efc0..0000000000
--- a/ghc/compiler/parser/Lexer.x
+++ /dev/null
@@ -1,1457 +0,0 @@
------------------------------------------------------------------------------
--- (c) The University of Glasgow, 2006
---
--- GHC's lexer.
---
--- This is a combination of an Alex-generated lexer from a regex
--- definition, with some hand-coded bits.
---
--- Completely accurate information about token-spans within the source
--- file is maintained.  Every token has a start and end SrcLoc attached to it.
---
------------------------------------------------------------------------------
-
---   ToDo / known bugs:
---    - Unicode
---    - parsing integers is a bit slow
---    - readRational is a bit slow
---
---   Known bugs, that were also in the previous version:
---    - M... should be 3 tokens, not 1.
---    - pragma-end should be only valid in a pragma
-
-{
-module Lexer (
-   Token(..), lexer, pragState, mkPState, PState(..),
-   P(..), ParseResult(..), getSrcLoc, 
-   failLocMsgP, failSpanMsgP, srcParseFail,
-   popContext, pushCurrentContext, setLastToken, setSrcLoc,
-   getLexState, popLexState, pushLexState,
-   extension, bangPatEnabled
-  ) where
-
-#include "HsVersions.h"
-
-import ErrUtils		( Message )
-import Outputable
-import StringBuffer
-import FastString
-import FastTypes
-import SrcLoc
-import UniqFM
-import DynFlags
-import Ctype
-import Util		( maybePrefixMatch, readRational )
-
-import DATA_BITS
-import Data.Char 	( chr )
-import Ratio
---import TRACE
-
-#if __GLASGOW_HASKELL__ >= 605
-import Data.Char 	( GeneralCategory(..), generalCategory, isPrint, isUpper )
-#else
-import Compat.Unicode	( GeneralCategory(..), generalCategory, isPrint, isUpper )
-#endif
-}
-
-$unispace    = \x05
-$whitechar   = [\ \t\n\r\f\v\xa0 $unispace]
-$white_no_nl = $whitechar # \n
-
-$ascdigit  = 0-9
-$unidigit  = \x03
-$decdigit  = $ascdigit -- for now, should really be $digit (ToDo)
-$digit     = [$ascdigit $unidigit]
-
-$special   = [\(\)\,\;\[\]\`\{\}]
-$ascsymbol = [\!\#\$\%\&\*\+\.\/\<\=\>\?\@\\\^\|\-\~]
-$unisymbol = \x04
-$symbol    = [$ascsymbol $unisymbol] # [$special \_\:\"\']
-
-$unilarge  = \x01
-$asclarge  = [A-Z \xc0-\xd6 \xd8-\xde]
-$large     = [$asclarge $unilarge]
-
-$unismall  = \x02
-$ascsmall  = [a-z \xdf-\xf6 \xf8-\xff]
-$small     = [$ascsmall $unismall \_]
-
-$unigraphic = \x06
-$graphic   = [$small $large $symbol $digit $special $unigraphic \:\"\']
-
-$octit	   = 0-7
-$hexit     = [$decdigit A-F a-f]
-$symchar   = [$symbol \:]
-$nl        = [\n\r]
-$idchar    = [$small $large $digit \']
-
-@varid     = $small $idchar*
-@conid     = $large $idchar*
-
-@varsym    = $symbol $symchar*
-@consym    = \: $symchar*
-
-@decimal     = $decdigit+
-@octal       = $octit+
-@hexadecimal = $hexit+
-@exponent    = [eE] [\-\+]? @decimal
-
--- we support the hierarchical module name extension:
-@qual = (@conid \.)+
-
-@floating_point = @decimal \. @decimal @exponent? | @decimal @exponent
-
-haskell :-
-
--- everywhere: skip whitespace and comments
-$white_no_nl+ 				;
-
--- Everywhere: deal with nested comments.  We explicitly rule out
--- pragmas, "{-#", so that we don't accidentally treat them as comments.
--- (this can happen even though pragmas will normally take precedence due to
--- longest-match, because pragmas aren't valid in every state, but comments
--- are).
-"{-" / { notFollowedBy '#' }		{ nested_comment }
-
--- Single-line comments are a bit tricky.  Haskell 98 says that two or
--- more dashes followed by a symbol should be parsed as a varsym, so we
--- have to exclude those.
--- The regex says: "munch all the characters after the dashes, as long as
--- the first one is not a symbol".
-"--"\-* [^$symbol :] .*			;
-"--"\-* / { atEOL }			;
-
--- 'bol' state: beginning of a line.  Slurp up all the whitespace (including
--- blank lines) until we find a non-whitespace character, then do layout
--- processing.
---
--- One slight wibble here: what if the line begins with {-#? In
--- theory, we have to lex the pragma to see if it's one we recognise,
--- and if it is, then we backtrack and do_bol, otherwise we treat it
--- as a nested comment.  We don't bother with this: if the line begins
--- with {-#, then we'll assume it's a pragma we know about and go for do_bol.
-<bol> {
-  \n					;
-  ^\# (line)?				{ begin line_prag1 }
-  ^\# pragma .* \n			; -- GCC 3.3 CPP generated, apparently
-  ^\# \! .* \n				; -- #!, for scripts
-  ()					{ do_bol }
-}
-
--- after a layout keyword (let, where, do, of), we begin a new layout
--- context if the curly brace is missing.
--- Careful! This stuff is quite delicate.
-<layout, layout_do> {
-  \{ / { notFollowedBy '-' }		{ pop_and open_brace }
-	-- we might encounter {-# here, but {- has been handled already
-  \n					;
-  ^\# (line)?				{ begin line_prag1 }
-}
-
--- do is treated in a subtly different way, see new_layout_context
-<layout>    ()				{ new_layout_context True }
-<layout_do> ()				{ new_layout_context False }
-
--- after a new layout context which was found to be to the left of the
--- previous context, we have generated a '{' token, and we now need to
--- generate a matching '}' token.
-<layout_left>  ()			{ do_layout_left }
-
-<0,option_prags,glaexts> \n				{ begin bol }
-
-"{-#" $whitechar* (line|LINE) 		{ begin line_prag2 }
-
--- single-line line pragmas, of the form
---    # <line> "<file>" <extra-stuff> \n
-<line_prag1> $decdigit+			{ setLine line_prag1a }
-<line_prag1a> \" [$graphic \ ]* \"	{ setFile line_prag1b }
-<line_prag1b> .*			{ pop }
-
--- Haskell-style line pragmas, of the form
---    {-# LINE <line> "<file>" #-}
-<line_prag2> $decdigit+			{ setLine line_prag2a }
-<line_prag2a> \" [$graphic \ ]* \"	{ setFile line_prag2b }
-<line_prag2b> "#-}"|"-}"		{ pop }
-   -- NOTE: accept -} at the end of a LINE pragma, for compatibility
-   -- with older versions of GHC which generated these.
-
--- We only want RULES pragmas to be picked up when -fglasgow-exts
--- is on, because the contents of the pragma is always written using
--- glasgow-exts syntax (using forall etc.), so if glasgow exts are not
--- enabled, we're sure to get a parse error.
--- (ToDo: we should really emit a warning when ignoring pragmas)
-<glaexts>
-  "{-#" $whitechar* (RULES|rules)	{ token ITrules_prag }
-
-<0,option_prags,glaexts> {
-  "{-#" $whitechar* (INLINE|inline)	{ token (ITinline_prag True) }
-  "{-#" $whitechar* (NO(T?)INLINE|no(t?)inline)
-  					{ token (ITinline_prag False) }
-  "{-#" $whitechar* (SPECIALI[SZ]E|speciali[sz]e)
-  					{ token ITspec_prag }
-  "{-#" $whitechar* (SPECIALI[SZ]E|speciali[sz]e)
-	$whitechar* (INLINE|inline)	{ token (ITspec_inline_prag True) }
-  "{-#" $whitechar* (SPECIALI[SZ]E|speciali[sz]e)
-	$whitechar* (NO(T?)INLINE|no(t?)inline)
-					{ token (ITspec_inline_prag False) }
-  "{-#" $whitechar* (SOURCE|source)	{ token ITsource_prag }
-  "{-#" $whitechar* (DEPRECATED|deprecated)
-  					{ token ITdeprecated_prag }
-  "{-#" $whitechar* (SCC|scc)		{ token ITscc_prag }
-  "{-#" $whitechar* (CORE|core)		{ token ITcore_prag }
-  "{-#" $whitechar* (UNPACK|unpack)	{ token ITunpack_prag }
-
-  "{-#" 				{ nested_comment }
-
-  -- ToDo: should only be valid inside a pragma:
-  "#-}" 				{ token ITclose_prag}
-}
-
-<option_prags> {
-  "{-#" $whitechar* (OPTIONS|options)   { lex_string_prag IToptions_prag }
-  "{-#" $whitechar* (OPTIONS_GHC|options_ghc)
-                                        { lex_string_prag IToptions_prag }
-  "{-#" $whitechar* (LANGUAGE|language) { token ITlanguage_prag }
-  "{-#" $whitechar* (INCLUDE|include)   { lex_string_prag ITinclude_prag }
-}
-
--- '0' state: ordinary lexemes
--- 'glaexts' state: glasgow extensions (postfix '#', etc.)
-
--- "special" symbols
-
-<0,glaexts> {
-  "[:" / { ifExtension parrEnabled }	{ token ITopabrack }
-  ":]" / { ifExtension parrEnabled }	{ token ITcpabrack }
-}
-  
-<0,glaexts> {
-  "[|"	    / { ifExtension thEnabled }	{ token ITopenExpQuote }
-  "[e|"	    / { ifExtension thEnabled }	{ token ITopenExpQuote }
-  "[p|"	    / { ifExtension thEnabled }	{ token ITopenPatQuote }
-  "[d|"	    / { ifExtension thEnabled }	{ layout_token ITopenDecQuote }
-  "[t|"	    / { ifExtension thEnabled }	{ token ITopenTypQuote }
-  "|]"	    / { ifExtension thEnabled }	{ token ITcloseQuote }
-  \$ @varid / { ifExtension thEnabled }	{ skip_one_varid ITidEscape }
-  "$("	    / { ifExtension thEnabled }	{ token ITparenEscape }
-}
-
-<0,glaexts> {
-  "(|" / { ifExtension arrowsEnabled `alexAndPred` notFollowedBySymbol }
-					{ special IToparenbar }
-  "|)" / { ifExtension arrowsEnabled }  { special ITcparenbar }
-}
-
-<0,glaexts> {
-  \? @varid / { ifExtension ipEnabled }	{ skip_one_varid ITdupipvarid }
-  \% @varid / { ifExtension ipEnabled } { skip_one_varid ITsplitipvarid }
-}
-
-<glaexts> {
-  "(#" / { notFollowedBySymbol }	{ token IToubxparen }
-  "#)"					{ token ITcubxparen }
-  "{|"					{ token ITocurlybar }
-  "|}"					{ token ITccurlybar }
-}
-
-<0,option_prags,glaexts> {
-  \(					{ special IToparen }
-  \)					{ special ITcparen }
-  \[					{ special ITobrack }
-  \]					{ special ITcbrack }
-  \,					{ special ITcomma }
-  \;					{ special ITsemi }
-  \`					{ special ITbackquote }
- 				
-  \{					{ open_brace }
-  \}					{ close_brace }
-}
-
-<0,option_prags,glaexts> {
-  @qual @varid			{ check_qvarid }
-  @qual @conid			{ idtoken qconid }
-  @varid			{ varid }
-  @conid			{ idtoken conid }
-}
-
--- after an illegal qvarid, such as 'M.let', 
--- we back up and try again in the bad_qvarid state:
-<bad_qvarid> {
-  @conid			{ pop_and (idtoken conid) }
-  @qual @conid			{ pop_and (idtoken qconid) }
-}
-
-<glaexts> {
-  @qual @varid "#"+		{ idtoken qvarid }
-  @qual @conid "#"+		{ idtoken qconid }
-  @varid "#"+			{ varid }
-  @conid "#"+			{ idtoken conid }
-}
-
--- ToDo: M.(,,,)
-
-<0,glaexts> {
-  @qual @varsym			{ idtoken qvarsym }
-  @qual @consym			{ idtoken qconsym }
-  @varsym			{ varsym }
-  @consym			{ consym }
-}
-
-<0,glaexts> {
-  @decimal			{ tok_decimal }
-  0[oO] @octal			{ tok_octal }
-  0[xX] @hexadecimal		{ tok_hexadecimal }
-}
-
-<glaexts> {
-  @decimal \#			{ prim_decimal }
-  0[oO] @octal \#		{ prim_octal }
-  0[xX] @hexadecimal \#		{ prim_hexadecimal }
-}
-
-<0,glaexts> @floating_point		{ strtoken tok_float }
-<glaexts>   @floating_point \#		{ init_strtoken 1 prim_float }
-<glaexts>   @floating_point \# \#	{ init_strtoken 2 prim_double }
-
--- Strings and chars are lexed by hand-written code.  The reason is
--- that even if we recognise the string or char here in the regex
--- lexer, we would still have to parse the string afterward in order
--- to convert it to a String.
-<0,glaexts> {
-  \'				{ lex_char_tok }
-  \" 				{ lex_string_tok }
-}
-
-{
--- work around bug in Alex 2.0
-#if __GLASGOW_HASKELL__ < 503
-unsafeAt arr i = arr ! i
-#endif
-
--- -----------------------------------------------------------------------------
--- The token type
-
-data Token
-  = ITas  			-- Haskell keywords
-  | ITcase
-  | ITclass
-  | ITdata
-  | ITdefault
-  | ITderiving
-  | ITdo
-  | ITelse
-  | IThiding
-  | ITif
-  | ITimport
-  | ITin
-  | ITinfix
-  | ITinfixl
-  | ITinfixr
-  | ITinstance
-  | ITlet
-  | ITmodule
-  | ITnewtype
-  | ITof
-  | ITqualified
-  | ITthen
-  | ITtype
-  | ITwhere
-  | ITscc			-- ToDo: remove (we use {-# SCC "..." #-} now)
-
-  | ITforall			-- GHC extension keywords
-  | ITforeign
-  | ITexport
-  | ITlabel
-  | ITdynamic
-  | ITsafe
-  | ITthreadsafe
-  | ITunsafe
-  | ITstdcallconv
-  | ITccallconv
-  | ITdotnet
-  | ITmdo
-
-	-- Pragmas
-  | ITinline_prag Bool		-- True <=> INLINE, False <=> NOINLINE
-  | ITspec_prag			-- SPECIALISE	
-  | ITspec_inline_prag Bool	-- SPECIALISE INLINE (or NOINLINE)
-  | ITsource_prag
-  | ITrules_prag
-  | ITdeprecated_prag
-  | ITline_prag
-  | ITscc_prag
-  | ITcore_prag                 -- hdaume: core annotations
-  | ITunpack_prag
-  | ITclose_prag
-  | IToptions_prag String
-  | ITinclude_prag String
-  | ITlanguage_prag
-
-  | ITdotdot  			-- reserved symbols
-  | ITcolon
-  | ITdcolon
-  | ITequal
-  | ITlam
-  | ITvbar
-  | ITlarrow
-  | ITrarrow
-  | ITat
-  | ITtilde
-  | ITdarrow
-  | ITminus
-  | ITbang
-  | ITstar
-  | ITdot
-
-  | ITbiglam			-- GHC-extension symbols
-
-  | ITocurly  			-- special symbols
-  | ITccurly
-  | ITocurlybar                 -- {|, for type applications
-  | ITccurlybar                 -- |}, for type applications
-  | ITvocurly
-  | ITvccurly
-  | ITobrack
-  | ITopabrack			-- [:, for parallel arrays with -fparr
-  | ITcpabrack			-- :], for parallel arrays with -fparr
-  | ITcbrack
-  | IToparen
-  | ITcparen
-  | IToubxparen
-  | ITcubxparen
-  | ITsemi
-  | ITcomma
-  | ITunderscore
-  | ITbackquote
-
-  | ITvarid   FastString	-- identifiers
-  | ITconid   FastString
-  | ITvarsym  FastString
-  | ITconsym  FastString
-  | ITqvarid  (FastString,FastString)
-  | ITqconid  (FastString,FastString)
-  | ITqvarsym (FastString,FastString)
-  | ITqconsym (FastString,FastString)
-
-  | ITdupipvarid   FastString	-- GHC extension: implicit param: ?x
-  | ITsplitipvarid FastString	-- GHC extension: implicit param: %x
-
-  | ITpragma StringBuffer
-
-  | ITchar       Char
-  | ITstring     FastString
-  | ITinteger    Integer
-  | ITrational   Rational
-
-  | ITprimchar   Char
-  | ITprimstring FastString
-  | ITprimint    Integer
-  | ITprimfloat  Rational
-  | ITprimdouble Rational
-
-  -- MetaHaskell extension tokens
-  | ITopenExpQuote  		--  [| or [e|
-  | ITopenPatQuote		--  [p|
-  | ITopenDecQuote		--  [d|
-  | ITopenTypQuote		--  [t|         
-  | ITcloseQuote		--  |]
-  | ITidEscape   FastString	--  $x
-  | ITparenEscape		--  $( 
-  | ITvarQuote			--  '
-  | ITtyQuote			--  ''
-
-  -- Arrow notation extension
-  | ITproc
-  | ITrec
-  | IToparenbar			--  (|
-  | ITcparenbar			--  |)
-  | ITlarrowtail		--  -<
-  | ITrarrowtail		--  >-
-  | ITLarrowtail		--  -<<
-  | ITRarrowtail		--  >>-
-
-  | ITunknown String		-- Used when the lexer can't make sense of it
-  | ITeof			-- end of file token
-#ifdef DEBUG
-  deriving Show -- debugging
-#endif
-
-isSpecial :: Token -> Bool
--- If we see M.x, where x is a keyword, but
--- is special, we treat is as just plain M.x, 
--- not as a keyword.
-isSpecial ITas        	= True
-isSpecial IThiding    	= True
-isSpecial ITqualified 	= True
-isSpecial ITforall    	= True
-isSpecial ITexport    	= True
-isSpecial ITlabel     	= True
-isSpecial ITdynamic   	= True
-isSpecial ITsafe    	= True
-isSpecial ITthreadsafe 	= True
-isSpecial ITunsafe    	= True
-isSpecial ITccallconv   = True
-isSpecial ITstdcallconv = True
-isSpecial ITmdo		= True
-isSpecial _             = False
-
--- the bitmap provided as the third component indicates whether the
--- corresponding extension keyword is valid under the extension options
--- provided to the compiler; if the extension corresponding to *any* of the
--- bits set in the bitmap is enabled, the keyword is valid (this setup
--- facilitates using a keyword in two different extensions that can be
--- activated independently)
---
-reservedWordsFM = listToUFM $
-	map (\(x, y, z) -> (mkFastString x, (y, z)))
-       [( "_",		ITunderscore, 	0 ),
-	( "as",		ITas, 		0 ),
-	( "case",	ITcase, 	0 ),     
-	( "class",	ITclass, 	0 ),    
-	( "data",	ITdata, 	0 ),     
-	( "default",	ITdefault, 	0 ),  
-	( "deriving",	ITderiving, 	0 ), 
-	( "do",		ITdo, 		0 ),       
-	( "else",	ITelse, 	0 ),     
-	( "hiding",	IThiding, 	0 ),
-	( "if",		ITif, 		0 ),       
-	( "import",	ITimport, 	0 ),   
-	( "in",		ITin, 		0 ),       
-	( "infix",	ITinfix, 	0 ),    
-	( "infixl",	ITinfixl, 	0 ),   
-	( "infixr",	ITinfixr, 	0 ),   
-	( "instance",	ITinstance, 	0 ), 
-	( "let",	ITlet, 		0 ),      
-	( "module",	ITmodule, 	0 ),   
-	( "newtype",	ITnewtype, 	0 ),  
-	( "of",		ITof, 		0 ),       
-	( "qualified",	ITqualified, 	0 ),
-	( "then",	ITthen, 	0 ),     
-	( "type",	ITtype, 	0 ),     
-	( "where",	ITwhere, 	0 ),
-	( "_scc_",	ITscc, 		0 ),		-- ToDo: remove
-
-      	( "forall",	ITforall,	 bit tvBit),
-	( "mdo",	ITmdo,		 bit glaExtsBit),
-
-	( "foreign",	ITforeign,	 bit ffiBit),
-	( "export",	ITexport,	 bit ffiBit),
-	( "label",	ITlabel,	 bit ffiBit),
-	( "dynamic",	ITdynamic,	 bit ffiBit),
-	( "safe",	ITsafe,		 bit ffiBit),
-	( "threadsafe",	ITthreadsafe,	 bit ffiBit),
-	( "unsafe",	ITunsafe,	 bit ffiBit),
-	( "stdcall",    ITstdcallconv,	 bit ffiBit),
-	( "ccall",      ITccallconv,	 bit ffiBit),
-	( "dotnet",     ITdotnet,	 bit ffiBit),
-
-	( "rec",	ITrec,		 bit arrowsBit),
-	( "proc",	ITproc,		 bit arrowsBit)
-     ]
-
-reservedSymsFM = listToUFM $
-	map (\ (x,y,z) -> (mkFastString x,(y,z)))
-      [ ("..",	ITdotdot,	0)
-       ,(":",	ITcolon,	0)	-- (:) is a reserved op, 
-						-- meaning only list cons
-       ,("::",	ITdcolon, 	0)
-       ,("=",	ITequal, 	0)
-       ,("\\",	ITlam, 		0)
-       ,("|",	ITvbar, 	0)
-       ,("<-",	ITlarrow, 	0)
-       ,("->",	ITrarrow, 	0)
-       ,("@",	ITat, 		0)
-       ,("~",	ITtilde, 	0)
-       ,("=>",	ITdarrow, 	0)
-       ,("-",	ITminus, 	0)
-       ,("!",	ITbang, 	0)
-
-       ,("*",	ITstar,		bit glaExtsBit)	-- For data T (a::*) = MkT
-       ,(".",	ITdot,		bit tvBit)	-- For 'forall a . t'
-
-       ,("-<",	ITlarrowtail,	bit arrowsBit)
-       ,(">-",	ITrarrowtail,	bit arrowsBit)
-       ,("-<<",	ITLarrowtail,	bit arrowsBit)
-       ,(">>-",	ITRarrowtail,	bit arrowsBit)
-
-#if __GLASGOW_HASKELL__ >= 605
-       ,("λ",	ITlam,          bit glaExtsBit)
-       ,("∷",   ITdcolon,       bit glaExtsBit)
-       ,("⇒",   ITdarrow,	bit glaExtsBit)
-       ,("∀",	ITforall,	bit glaExtsBit)
-       ,("→",   ITrarrow,	bit glaExtsBit)
-       ,("�",   ITlarrow,	bit glaExtsBit)
-       ,("⋯", 	ITdotdot,	bit glaExtsBit)
-#endif
-       ]
-
--- -----------------------------------------------------------------------------
--- Lexer actions
-
-type Action = SrcSpan -> StringBuffer -> Int -> P (Located Token)
-
-special :: Token -> Action
-special tok span _buf len = return (L span tok)
-
-token, layout_token :: Token -> Action
-token t span buf len = return (L span t)
-layout_token t span buf len = pushLexState layout >> return (L span t)
-
-idtoken :: (StringBuffer -> Int -> Token) -> Action
-idtoken f span buf len = return (L span $! (f buf len))
-
-skip_one_varid :: (FastString -> Token) -> Action
-skip_one_varid f span buf len 
-  = return (L span $! f (lexemeToFastString (stepOn buf) (len-1)))
-
-strtoken :: (String -> Token) -> Action
-strtoken f span buf len = 
-  return (L span $! (f $! lexemeToString buf len))
-
-init_strtoken :: Int -> (String -> Token) -> Action
--- like strtoken, but drops the last N character(s)
-init_strtoken drop f span buf len = 
-  return (L span $! (f $! lexemeToString buf (len-drop)))
-
-begin :: Int -> Action
-begin code _span _str _len = do pushLexState code; lexToken
-
-pop :: Action
-pop _span _buf _len = do popLexState; lexToken
-
-pop_and :: Action -> Action
-pop_and act span buf len = do popLexState; act span buf len
-
-notFollowedBy char _ _ _ (AI _ _ buf) = atEnd buf || currentChar buf /= char
-
-notFollowedBySymbol _ _ _ (AI _ _ buf)
-  = atEnd buf || currentChar buf `notElem` "!#$%&*+./<=>?@\\^|-~"
-
-atEOL _ _ _ (AI _ _ buf) = atEnd buf || currentChar buf == '\n'
-
-ifExtension pred bits _ _ _ = pred bits
-
-{-
-  nested comments require traversing by hand, they can't be parsed
-  using regular expressions.
--}
-nested_comment :: Action
-nested_comment span _str _len = do
-  input <- getInput
-  go 1 input
-  where go 0 input = do setInput input; lexToken
-	go n input = do
-	  case alexGetChar input of
-	    Nothing  -> err input
-	    Just (c,input) -> do
-	      case c of
-	    	'-' -> do
-		  case alexGetChar input of
-		    Nothing  -> err input
-		    Just ('\125',input) -> go (n-1) input
-		    Just (c,_)          -> go n input
-	     	'\123' -> do
-		  case alexGetChar input of
-		    Nothing  -> err input
-		    Just ('-',input') -> go (n+1) input'
-		    Just (c,input)    -> go n input
-	    	c -> go n input
-
-        err (AI end _ _) = failLocMsgP (srcSpanStart span) end "unterminated `{-'"
-
-open_brace, close_brace :: Action
-open_brace span _str _len = do 
-  ctx <- getContext
-  setContext (NoLayout:ctx)
-  return (L span ITocurly)
-close_brace span _str _len = do 
-  popContext
-  return (L span ITccurly)
-
--- We have to be careful not to count M.<varid> as a qualified name
--- when <varid> is a keyword.  We hack around this by catching 
--- the offending tokens afterward, and re-lexing in a different state.
-check_qvarid span buf len = do
-  case lookupUFM reservedWordsFM var of
-	Just (keyword,exts)
-	  | not (isSpecial keyword) ->
-	  if exts == 0 
-	     then try_again
-	     else do
-		b <- extension (\i -> exts .&. i /= 0)
-		if b then try_again
-		     else return token
-	_other -> return token
-  where
-	(mod,var) = splitQualName buf len
-	token     = L span (ITqvarid (mod,var))
-
-	try_again = do
-		(AI _ offs _) <- getInput	
-		setInput (AI (srcSpanStart span) (offs-len) buf)
-		pushLexState bad_qvarid
-		lexToken
-
-qvarid buf len = ITqvarid $! splitQualName buf len
-qconid buf len = ITqconid $! splitQualName buf len
-
-splitQualName :: StringBuffer -> Int -> (FastString,FastString)
--- takes a StringBuffer and a length, and returns the module name
--- and identifier parts of a qualified name.  Splits at the *last* dot,
--- because of hierarchical module names.
-splitQualName orig_buf len = split orig_buf orig_buf
-  where
-    split buf dot_buf
-	| orig_buf `byteDiff` buf >= len  = done dot_buf
-	| c == '.'                	  = found_dot buf'
-	| otherwise               	  = split buf' dot_buf
-      where
-       (c,buf') = nextChar buf
-  
-    -- careful, we might get names like M....
-    -- so, if the character after the dot is not upper-case, this is
-    -- the end of the qualifier part.
-    found_dot buf -- buf points after the '.'
-	| isUpper c    = split buf' buf
-	| otherwise    = done buf
-      where
-       (c,buf') = nextChar buf
-
-    done dot_buf =
-	(lexemeToFastString orig_buf (qual_size - 1),
-	 lexemeToFastString dot_buf (len - qual_size))
-      where
-	qual_size = orig_buf `byteDiff` dot_buf
-
-varid span buf len = 
-  case lookupUFM reservedWordsFM fs of
-	Just (keyword,0)    -> do
-		maybe_layout keyword
-		return (L span keyword)
-	Just (keyword,exts) -> do
-		b <- extension (\i -> exts .&. i /= 0)
-		if b then do maybe_layout keyword
-			     return (L span keyword)
-		     else return (L span (ITvarid fs))
-	_other -> return (L span (ITvarid fs))
-  where
-	fs = lexemeToFastString buf len
-
-conid buf len = ITconid fs
-  where fs = lexemeToFastString buf len
-
-qvarsym buf len = ITqvarsym $! splitQualName buf len
-qconsym buf len = ITqconsym $! splitQualName buf len
-
-varsym = sym ITvarsym
-consym = sym ITconsym
-
-sym con span buf len = 
-  case lookupUFM reservedSymsFM fs of
-	Just (keyword,0)    -> return (L span keyword)
-	Just (keyword,exts) -> do
-		b <- extension (\i -> exts .&. i /= 0)
-		if b then return (L span keyword)
-		     else return (L span $! con fs)
-	_other -> return (L span $! con fs)
-  where
-	fs = lexemeToFastString buf len
-
-tok_decimal span buf len 
-  = return (L span (ITinteger  $! parseInteger buf len 10 octDecDigit))
-
-tok_octal span buf len 
-  = return (L span (ITinteger  $! parseInteger (offsetBytes 2 buf) (len-2) 8 octDecDigit))
-
-tok_hexadecimal span buf len 
-  = return (L span (ITinteger  $! parseInteger (offsetBytes 2 buf) (len-2) 16 hexDigit))
-
-prim_decimal span buf len 
-  = return (L span (ITprimint  $! parseInteger buf (len-1) 10 octDecDigit))
-
-prim_octal span buf len 
-  = return (L span (ITprimint  $! parseInteger (offsetBytes 2 buf) (len-3) 8 octDecDigit))
-
-prim_hexadecimal span buf len 
-  = return (L span (ITprimint  $! parseInteger (offsetBytes 2 buf) (len-3) 16 hexDigit))
-
-tok_float        str = ITrational   $! readRational str
-prim_float       str = ITprimfloat  $! readRational str
-prim_double      str = ITprimdouble $! readRational str
-
--- -----------------------------------------------------------------------------
--- Layout processing
-
--- we're at the first token on a line, insert layout tokens if necessary
-do_bol :: Action
-do_bol span _str _len = do
-	pos <- getOffside
-	case pos of
-	    LT -> do
-                --trace "layout: inserting '}'" $ do
-		popContext
-		-- do NOT pop the lex state, we might have a ';' to insert
-		return (L span ITvccurly)
-	    EQ -> do
-                --trace "layout: inserting ';'" $ do
-		popLexState
-		return (L span ITsemi)
-	    GT -> do
-		popLexState
-		lexToken
-
--- certain keywords put us in the "layout" state, where we might
--- add an opening curly brace.
-maybe_layout ITdo	= pushLexState layout_do
-maybe_layout ITmdo	= pushLexState layout_do
-maybe_layout ITof	= pushLexState layout
-maybe_layout ITlet	= pushLexState layout
-maybe_layout ITwhere	= pushLexState layout
-maybe_layout ITrec	= pushLexState layout
-maybe_layout _	        = return ()
-
--- Pushing a new implicit layout context.  If the indentation of the
--- next token is not greater than the previous layout context, then
--- Haskell 98 says that the new layout context should be empty; that is
--- the lexer must generate {}.
---
--- We are slightly more lenient than this: when the new context is started
--- by a 'do', then we allow the new context to be at the same indentation as
--- the previous context.  This is what the 'strict' argument is for.
---
-new_layout_context strict span _buf _len = do
-    popLexState
-    (AI _ offset _) <- getInput
-    ctx <- getContext
-    case ctx of
-	Layout prev_off : _  | 
-	   (strict     && prev_off >= offset  ||
-	    not strict && prev_off > offset) -> do
-		-- token is indented to the left of the previous context.
-		-- we must generate a {} sequence now.
-		pushLexState layout_left
-		return (L span ITvocurly)
-	other -> do
-		setContext (Layout offset : ctx)
-		return (L span ITvocurly)
-
-do_layout_left span _buf _len = do
-    popLexState
-    pushLexState bol  -- we must be at the start of a line
-    return (L span ITvccurly)
-
--- -----------------------------------------------------------------------------
--- LINE pragmas
-
-setLine :: Int -> Action
-setLine code span buf len = do
-  let line = parseInteger buf len 10 octDecDigit
-  setSrcLoc (mkSrcLoc (srcSpanFile span) (fromIntegral line - 1) 0)
-	-- subtract one: the line number refers to the *following* line
-  popLexState
-  pushLexState code
-  lexToken
-
-setFile :: Int -> Action
-setFile code span buf len = do
-  let file = lexemeToFastString (stepOn buf) (len-2)
-  setSrcLoc (mkSrcLoc file (srcSpanEndLine span) (srcSpanEndCol span))
-  popLexState
-  pushLexState code
-  lexToken
-
-
--- -----------------------------------------------------------------------------
--- Options, includes and language pragmas.
-
-lex_string_prag :: (String -> Token) -> Action
-lex_string_prag mkTok span buf len
-    = do input <- getInput
-         start <- getSrcLoc
-         tok <- go [] input
-         end <- getSrcLoc
-         return (L (mkSrcSpan start end) tok)
-    where go acc input
-              = if isString input "#-}"
-                   then do setInput input
-                           return (mkTok (reverse acc))
-                   else case alexGetChar input of
-                          Just (c,i) -> go (c:acc) i
-                          Nothing -> err input
-          isString i [] = True
-          isString i (x:xs)
-              = case alexGetChar i of
-                  Just (c,i') | c == x    -> isString i' xs
-                  _other -> False
-          err (AI end _ _) = failLocMsgP (srcSpanStart span) end "unterminated options pragma"
-
-
--- -----------------------------------------------------------------------------
--- Strings & Chars
-
--- This stuff is horrible.  I hates it.
-
-lex_string_tok :: Action
-lex_string_tok span buf len = do
-  tok <- lex_string ""
-  end <- getSrcLoc 
-  return (L (mkSrcSpan (srcSpanStart span) end) tok)
-
-lex_string :: String -> P Token
-lex_string s = do
-  i <- getInput
-  case alexGetChar' i of
-    Nothing -> lit_error
-
-    Just ('"',i)  -> do
-	setInput i
-	glaexts <- extension glaExtsEnabled
-	if glaexts
-	  then do
-	    i <- getInput
-	    case alexGetChar' i of
-	      Just ('#',i) -> do
-		   setInput i
-		   if any (> '\xFF') s
-                    then failMsgP "primitive string literal must contain only characters <= \'\\xFF\'"
-                    else let s' = mkZFastString (reverse s) in
-			 return (ITprimstring s')
-			-- mkZFastString is a hack to avoid encoding the
-			-- string in UTF-8.  We just want the exact bytes.
-	      _other ->
-		return (ITstring (mkFastString (reverse s)))
-	  else
-		return (ITstring (mkFastString (reverse s)))
-
-    Just ('\\',i)
-	| Just ('&',i) <- next -> do 
-		setInput i; lex_string s
-	| Just (c,i) <- next, is_space c -> do 
-		setInput i; lex_stringgap s
-	where next = alexGetChar' i
-
-    Just (c, i) -> do
-	c' <- lex_char c i
-	lex_string (c':s)
-
-lex_stringgap s = do
-  c <- getCharOrFail
-  case c of
-    '\\' -> lex_string s
-    c | is_space c -> lex_stringgap s
-    _other -> lit_error
-
-
-lex_char_tok :: Action
--- Here we are basically parsing character literals, such as 'x' or '\n'
--- but, when Template Haskell is on, we additionally spot
--- 'x and ''T, returning ITvarQuote and ITtyQuote respectively, 
--- but WIHTOUT CONSUMING the x or T part  (the parser does that).
--- So we have to do two characters of lookahead: when we see 'x we need to
--- see if there's a trailing quote
-lex_char_tok span buf len = do	-- We've seen '
-   i1 <- getInput	-- Look ahead to first character
-   let loc = srcSpanStart span
-   case alexGetChar' i1 of
-	Nothing -> lit_error 
-
-	Just ('\'', i2@(AI end2 _ _)) -> do 	-- We've seen ''
-		  th_exts <- extension thEnabled
-		  if th_exts then do
-			setInput i2
-			return (L (mkSrcSpan loc end2)  ITtyQuote)
-		   else lit_error
-
-	Just ('\\', i2@(AI end2 _ _)) -> do 	-- We've seen 'backslash 
-		  setInput i2
-		  lit_ch <- lex_escape
-		  mc <- getCharOrFail	-- Trailing quote
-		  if mc == '\'' then finish_char_tok loc lit_ch
-			        else do setInput i2; lit_error 
-
-        Just (c, i2@(AI end2 _ _)) 
-		| not (isAny c) -> lit_error
-		| otherwise ->
-
-		-- We've seen 'x, where x is a valid character
-		--  (i.e. not newline etc) but not a quote or backslash
-	   case alexGetChar' i2 of	-- Look ahead one more character
-		Nothing -> lit_error
-		Just ('\'', i3) -> do 	-- We've seen 'x'
-			setInput i3 
-			finish_char_tok loc c
-		_other -> do 		-- We've seen 'x not followed by quote
-					-- If TH is on, just parse the quote only
-			th_exts <- extension thEnabled	
-			let (AI end _ _) = i1
-			if th_exts then return (L (mkSrcSpan loc end) ITvarQuote)
-				   else do setInput i2; lit_error
-
-finish_char_tok :: SrcLoc -> Char -> P (Located Token)
-finish_char_tok loc ch	-- We've already seen the closing quote
-			-- Just need to check for trailing #
-  = do	glaexts <- extension glaExtsEnabled
-	i@(AI end _ _) <- getInput
-	if glaexts then do
-		case alexGetChar' i of
-			Just ('#',i@(AI end _ _)) -> do
-				setInput i
-				return (L (mkSrcSpan loc end) (ITprimchar ch))
-			_other ->
-				return (L (mkSrcSpan loc end) (ITchar ch))
-	        else do
-		   return (L (mkSrcSpan loc end) (ITchar ch))
-
-lex_char :: Char -> AlexInput -> P Char
-lex_char c inp = do
-  case c of
-      '\\' -> do setInput inp; lex_escape
-      c | isAny c -> do setInput inp; return c
-      _other -> lit_error
-
-isAny c | c > '\xff' = isPrint c
-	| otherwise  = is_any c
-
-lex_escape :: P Char
-lex_escape = do
-  c <- getCharOrFail
-  case c of
-	'a'   -> return '\a'
-	'b'   -> return '\b'
-	'f'   -> return '\f'
-	'n'   -> return '\n'
-	'r'   -> return '\r'
-	't'   -> return '\t'
-	'v'   -> return '\v'
-	'\\'  -> return '\\'
-	'"'   -> return '\"'
-	'\''  -> return '\''
-	'^'   -> do c <- getCharOrFail
-		    if c >= '@' && c <= '_'
-			then return (chr (ord c - ord '@'))
-			else lit_error
-
-	'x'   -> readNum is_hexdigit 16 hexDigit
-	'o'   -> readNum is_octdigit  8 octDecDigit
-	x | is_digit x -> readNum2 is_digit 10 octDecDigit (octDecDigit x)
-
-	c1 ->  do
-	   i <- getInput
-	   case alexGetChar' i of
-	    Nothing -> lit_error
-	    Just (c2,i2) -> 
-              case alexGetChar' i2 of
-		Nothing	-> do setInput i2; lit_error
-		Just (c3,i3) -> 
-		   let str = [c1,c2,c3] in
-		   case [ (c,rest) | (p,c) <- silly_escape_chars,
-			      	     Just rest <- [maybePrefixMatch p str] ] of
-			  (escape_char,[]):_ -> do
-				setInput i3
-				return escape_char
-			  (escape_char,_:_):_ -> do
-				setInput i2
-				return escape_char
-			  [] -> lit_error
-
-readNum :: (Char -> Bool) -> Int -> (Char -> Int) -> P Char
-readNum is_digit base conv = do
-  i <- getInput
-  c <- getCharOrFail
-  if is_digit c 
-	then readNum2 is_digit base conv (conv c)
-	else do setInput i; lit_error
-
-readNum2 is_digit base conv i = do
-  input <- getInput
-  read i input
-  where read i input = do
-	  case alexGetChar' input of
-	    Just (c,input') | is_digit c -> do
-		read (i*base + conv c) input'
-	    _other -> do
-		if i >= 0 && i <= 0x10FFFF
-		   then do setInput input; return (chr i)
-		   else lit_error
-
-silly_escape_chars = [
-	("NUL", '\NUL'),
-	("SOH", '\SOH'),
-	("STX", '\STX'),
-	("ETX", '\ETX'),
-	("EOT", '\EOT'),
-	("ENQ", '\ENQ'),
-	("ACK", '\ACK'),
-	("BEL", '\BEL'),
-	("BS", '\BS'),
-	("HT", '\HT'),
-	("LF", '\LF'),
-	("VT", '\VT'),
-	("FF", '\FF'),
-	("CR", '\CR'),
-	("SO", '\SO'),
-	("SI", '\SI'),
-	("DLE", '\DLE'),
-	("DC1", '\DC1'),
-	("DC2", '\DC2'),
-	("DC3", '\DC3'),
-	("DC4", '\DC4'),
-	("NAK", '\NAK'),
-	("SYN", '\SYN'),
-	("ETB", '\ETB'),
-	("CAN", '\CAN'),
-	("EM", '\EM'),
-	("SUB", '\SUB'),
-	("ESC", '\ESC'),
-	("FS", '\FS'),
-	("GS", '\GS'),
-	("RS", '\RS'),
-	("US", '\US'),
-	("SP", '\SP'),
-	("DEL", '\DEL')
-	]
-
--- before calling lit_error, ensure that the current input is pointing to
--- the position of the error in the buffer.  This is so that we can report
--- a correct location to the user, but also so we can detect UTF-8 decoding
--- errors if they occur.
-lit_error = lexError "lexical error in string/character literal"
-
-getCharOrFail :: P Char
-getCharOrFail =  do
-  i <- getInput
-  case alexGetChar' i of
-	Nothing -> lexError "unexpected end-of-file in string/character literal"
-	Just (c,i)  -> do setInput i; return c
-
--- -----------------------------------------------------------------------------
--- The Parse Monad
-
-data LayoutContext
-  = NoLayout
-  | Layout !Int
-
-data ParseResult a
-  = POk PState a
-  | PFailed 
-	SrcSpan		-- The start and end of the text span related to
-			-- the error.  Might be used in environments which can 
-			-- show this span, e.g. by highlighting it.
-	Message		-- The error message
-
-data PState = PState { 
-	buffer	   :: StringBuffer,
-        last_loc   :: SrcSpan,	-- pos of previous token
-        last_offs  :: !Int, 	-- offset of the previous token from the
-				-- beginning of  the current line.
-				-- \t is equal to 8 spaces.
-	last_len   :: !Int,	-- len of previous token
-        loc        :: SrcLoc,   -- current loc (end of prev token + 1)
-	extsBitmap :: !Int,	-- bitmap that determines permitted extensions
-	context	   :: [LayoutContext],
-	lex_state  :: [Int]
-     }
-	-- last_loc and last_len are used when generating error messages,
-	-- and in pushCurrentContext only.  Sigh, if only Happy passed the
-	-- current token to happyError, we could at least get rid of last_len.
-	-- Getting rid of last_loc would require finding another way to 
-	-- implement pushCurrentContext (which is only called from one place).
-
-newtype P a = P { unP :: PState -> ParseResult a }
-
-instance Monad P where
-  return = returnP
-  (>>=) = thenP
-  fail = failP
-
-returnP :: a -> P a
-returnP a = P $ \s -> POk s a
-
-thenP :: P a -> (a -> P b) -> P b
-(P m) `thenP` k = P $ \ s ->
-	case m s of
-		POk s1 a         -> (unP (k a)) s1
-		PFailed span err -> PFailed span err
-
-failP :: String -> P a
-failP msg = P $ \s -> PFailed (last_loc s) (text msg)
-
-failMsgP :: String -> P a
-failMsgP msg = P $ \s -> PFailed (last_loc s) (text msg)
-
-failLocMsgP :: SrcLoc -> SrcLoc -> String -> P a
-failLocMsgP loc1 loc2 str = P $ \s -> PFailed (mkSrcSpan loc1 loc2) (text str)
-
-failSpanMsgP :: SrcSpan -> String -> P a
-failSpanMsgP span msg = P $ \s -> PFailed span (text msg)
-
-extension :: (Int -> Bool) -> P Bool
-extension p = P $ \s -> POk s (p $! extsBitmap s)
-
-getExts :: P Int
-getExts = P $ \s -> POk s (extsBitmap s)
-
-setSrcLoc :: SrcLoc -> P ()
-setSrcLoc new_loc = P $ \s -> POk s{loc=new_loc} ()
-
-getSrcLoc :: P SrcLoc
-getSrcLoc = P $ \s@(PState{ loc=loc }) -> POk s loc
-
-setLastToken :: SrcSpan -> Int -> P ()
-setLastToken loc len = P $ \s -> POk s{ last_loc=loc, last_len=len } ()
-
-data AlexInput = AI SrcLoc {-#UNPACK#-}!Int StringBuffer
-
-alexInputPrevChar :: AlexInput -> Char
-alexInputPrevChar (AI _ _ buf) = prevChar buf '\n'
-
-alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
-alexGetChar (AI loc ofs s) 
-  | atEnd s   = Nothing
-  | otherwise = adj_c `seq` loc' `seq` ofs' `seq` s' `seq` 
-		Just (adj_c, (AI loc' ofs' s'))
-  where (c,s') = nextChar s
-        loc'   = advanceSrcLoc loc c
-        ofs'   = advanceOffs c ofs
-
-	non_graphic     = '\x0'
-	upper 		= '\x1'
-	lower		= '\x2'
-	digit		= '\x3'
-	symbol		= '\x4'
-	space		= '\x5'
-	other_graphic	= '\x6'
-
-	adj_c 
-	  | c <= '\x06' = non_graphic
-	  | c <= '\xff' = c
-	  | otherwise = 
-		case generalCategory c of
-		  UppercaseLetter       -> upper
-		  LowercaseLetter       -> lower
-		  TitlecaseLetter       -> upper
-		  ModifierLetter        -> other_graphic
-		  OtherLetter           -> other_graphic
-		  NonSpacingMark        -> other_graphic
-		  SpacingCombiningMark  -> other_graphic
-		  EnclosingMark         -> other_graphic
-		  DecimalNumber         -> digit
-		  LetterNumber          -> other_graphic
-		  OtherNumber           -> other_graphic
-		  ConnectorPunctuation  -> other_graphic
-		  DashPunctuation       -> other_graphic
-		  OpenPunctuation       -> other_graphic
-		  ClosePunctuation      -> other_graphic
-		  InitialQuote          -> other_graphic
-		  FinalQuote            -> other_graphic
-		  OtherPunctuation      -> other_graphic
-		  MathSymbol            -> symbol
-		  CurrencySymbol        -> symbol
-		  ModifierSymbol        -> symbol
-		  OtherSymbol           -> symbol
-		  Space                 -> space
-		  _other		-> non_graphic
-
--- This version does not squash unicode characters, it is used when
--- lexing strings.
-alexGetChar' :: AlexInput -> Maybe (Char,AlexInput)
-alexGetChar' (AI loc ofs s) 
-  | atEnd s   = Nothing
-  | otherwise = c `seq` loc' `seq` ofs' `seq` s' `seq` 
-		Just (c, (AI loc' ofs' s'))
-  where (c,s') = nextChar s
-        loc'   = advanceSrcLoc loc c
-        ofs'   = advanceOffs c ofs
-
-advanceOffs :: Char -> Int -> Int
-advanceOffs '\n' offs = 0
-advanceOffs '\t' offs = (offs `quot` 8 + 1) * 8
-advanceOffs _    offs = offs + 1
-
-getInput :: P AlexInput
-getInput = P $ \s@PState{ loc=l, last_offs=o, buffer=b } -> POk s (AI l o b)
-
-setInput :: AlexInput -> P ()
-setInput (AI l o b) = P $ \s -> POk s{ loc=l, last_offs=o, buffer=b } ()
-
-pushLexState :: Int -> P ()
-pushLexState ls = P $ \s@PState{ lex_state=l } -> POk s{lex_state=ls:l} ()
-
-popLexState :: P Int
-popLexState = P $ \s@PState{ lex_state=ls:l } -> POk s{ lex_state=l } ls
-
-getLexState :: P Int
-getLexState = P $ \s@PState{ lex_state=ls:l } -> POk s ls
-
--- for reasons of efficiency, flags indicating language extensions (eg,
--- -fglasgow-exts or -fparr) are represented by a bitmap stored in an unboxed
--- integer
-
-glaExtsBit, ffiBit, parrBit :: Int
-glaExtsBit = 0
-ffiBit	   = 1
-parrBit	   = 2
-arrowsBit  = 4
-thBit	   = 5
-ipBit      = 6
-tvBit	   = 7	-- Scoped type variables enables 'forall' keyword
-bangPatBit = 8	-- Tells the parser to understand bang-patterns
-		-- (doesn't affect the lexer)
-
-glaExtsEnabled, ffiEnabled, parrEnabled :: Int -> Bool
-glaExtsEnabled flags = testBit flags glaExtsBit
-ffiEnabled     flags = testBit flags ffiBit
-parrEnabled    flags = testBit flags parrBit
-arrowsEnabled  flags = testBit flags arrowsBit
-thEnabled      flags = testBit flags thBit
-ipEnabled      flags = testBit flags ipBit
-tvEnabled      flags = testBit flags tvBit
-bangPatEnabled flags = testBit flags bangPatBit
-
--- PState for parsing options pragmas
---
-pragState :: StringBuffer -> SrcLoc -> PState
-pragState buf loc  = 
-  PState {
-      buffer	 = buf,
-      last_loc   = mkSrcSpan loc loc,
-      last_offs  = 0,
-      last_len   = 0,
-      loc        = loc,
-      extsBitmap = 0,
-      context    = [],
-      lex_state  = [bol, option_prags, 0]
-    }
-
-
--- create a parse state
---
-mkPState :: StringBuffer -> SrcLoc -> DynFlags -> PState
-mkPState buf loc flags  = 
-  PState {
-      buffer	 = buf,
-      last_loc   = mkSrcSpan loc loc,
-      last_offs  = 0,
-      last_len   = 0,
-      loc        = loc,
-      extsBitmap = fromIntegral bitmap,
-      context    = [],
-      lex_state  = [bol, if glaExtsEnabled bitmap then glaexts else 0]
-	-- we begin in the layout state if toplev_layout is set
-    }
-    where
-      bitmap =     glaExtsBit `setBitIf` dopt Opt_GlasgowExts flags
-	       .|. ffiBit     `setBitIf` dopt Opt_FFI         flags
-	       .|. parrBit    `setBitIf` dopt Opt_PArr        flags
-	       .|. arrowsBit  `setBitIf` dopt Opt_Arrows      flags
-	       .|. thBit      `setBitIf` dopt Opt_TH          flags
-	       .|. ipBit      `setBitIf` dopt Opt_ImplicitParams flags
-	       .|. tvBit      `setBitIf` dopt Opt_ScopedTypeVariables flags
-	       .|. bangPatBit `setBitIf` dopt Opt_BangPatterns flags
-      --
-      setBitIf :: Int -> Bool -> Int
-      b `setBitIf` cond | cond      = bit b
-			| otherwise = 0
-
-getContext :: P [LayoutContext]
-getContext = P $ \s@PState{context=ctx} -> POk s ctx
-
-setContext :: [LayoutContext] -> P ()
-setContext ctx = P $ \s -> POk s{context=ctx} ()
-
-popContext :: P ()
-popContext = P $ \ s@(PState{ buffer = buf, context = ctx, 
-			   loc = loc, last_len = len, last_loc = last_loc }) ->
-  case ctx of
-	(_:tl) -> POk s{ context = tl } ()
-	[]     -> PFailed last_loc (srcParseErr buf len)
-
--- Push a new layout context at the indentation of the last token read.
--- This is only used at the outer level of a module when the 'module'
--- keyword is missing.
-pushCurrentContext :: P ()
-pushCurrentContext = P $ \ s@PState{ last_offs=offs, last_len=len, context=ctx } ->
-  POk s{context = Layout (offs-len) : ctx} ()
-
-getOffside :: P Ordering
-getOffside = P $ \s@PState{last_offs=offs, context=stk} ->
-		let ord = case stk of
-			(Layout n:_) -> compare offs n
-			_            -> GT
-		in POk s ord
-
--- ---------------------------------------------------------------------------
--- Construct a parse error
-
-srcParseErr
-  :: StringBuffer	-- current buffer (placed just after the last token)
-  -> Int		-- length of the previous token
-  -> Message
-srcParseErr buf len
-  = hcat [ if null token 
-	     then ptext SLIT("parse error (possibly incorrect indentation)")
-	     else hcat [ptext SLIT("parse error on input "),
-          	  	char '`', text token, char '\'']
-    ]
-  where token = lexemeToString (offsetBytes (-len) buf) len
-
--- Report a parse failure, giving the span of the previous token as
--- the location of the error.  This is the entry point for errors
--- detected during parsing.
-srcParseFail :: P a
-srcParseFail = P $ \PState{ buffer = buf, last_len = len, 	
-			    last_loc = last_loc } ->
-    PFailed last_loc (srcParseErr buf len)
-
--- A lexical error is reported at a particular position in the source file,
--- not over a token range.
-lexError :: String -> P a
-lexError str = do
-  loc <- getSrcLoc
-  i@(AI end _ buf) <- getInput
-  reportLexError loc end buf str
-
--- -----------------------------------------------------------------------------
--- This is the top-level function: called from the parser each time a
--- new token is to be read from the input.
-
-lexer :: (Located Token -> P a) -> P a
-lexer cont = do
-  tok@(L _ tok__) <- lexToken
-  --trace ("token: " ++ show tok__) $ do
-  cont tok
-
-lexToken :: P (Located Token)
-lexToken = do
-  inp@(AI loc1 _ buf) <- getInput
-  sc <- getLexState
-  exts <- getExts
-  case alexScanUser exts inp sc of
-    AlexEOF -> do let span = mkSrcSpan loc1 loc1
-		  setLastToken span 0
-		  return (L span ITeof)
-    AlexError (AI loc2 _ buf) -> do 
-	reportLexError loc1 loc2 buf "lexical error"
-    AlexSkip inp2 _ -> do
-	setInput inp2
-	lexToken
-    AlexToken inp2@(AI end _ buf2) len t -> do
-	setInput inp2
-	let span = mkSrcSpan loc1 end
-	let bytes = byteDiff buf buf2
-	span `seq` setLastToken span bytes
-	t span buf bytes
-
--- ToDo: Alex reports the buffer at the start of the erroneous lexeme,
--- but it would be more informative to report the location where the
--- error was actually discovered, especially if this is a decoding
--- error.
-reportLexError loc1 loc2 buf str = 
-  let 
-	c = fst (nextChar buf)
-  in
-  if c == '\0' -- decoding errors are mapped to '\0', see utf8DecodeChar#
-    then failLocMsgP loc2 loc2 "UTF-8 decoding error"
-    else failLocMsgP loc1 loc2 (str ++ " at character " ++ show c)
-}
diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp
deleted file mode 100644
index 3066a0f876..0000000000
--- a/ghc/compiler/parser/Parser.y.pp
+++ /dev/null
@@ -1,1607 +0,0 @@
---								-*-haskell-*-
--- ---------------------------------------------------------------------------
--- (c) The University of Glasgow 1997-2003
----
--- The GHC grammar.
---
--- Author(s): Simon Marlow, Sven Panne 1997, 1998, 1999
--- ---------------------------------------------------------------------------
-
-{
-module Parser ( parseModule, parseStmt, parseIdentifier, parseType,
-		parseHeader ) where
-
-#define INCLUDE #include 
-INCLUDE "HsVersions.h"
-
-import HsSyn
-import RdrHsSyn
-import HscTypes		( IsBootInterface, DeprecTxt )
-import Lexer
-import RdrName
-import TysWiredIn	( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
-			  listTyCon_RDR, parrTyCon_RDR, consDataCon_RDR )
-import Type		( funTyCon )
-import ForeignCall	( Safety(..), CExportSpec(..), CLabelString,
-			  CCallConv(..), CCallTarget(..), defaultCCallConv
-			)
-import OccName		( varName, dataName, tcClsName, tvName )
-import DataCon		( DataCon, dataConName )
-import SrcLoc		( Located(..), unLoc, getLoc, noLoc, combineSrcSpans,
-			  SrcSpan, combineLocs, srcLocFile, 
-			  mkSrcLoc, mkSrcSpan )
-import Module
-import StaticFlags	( opt_SccProfilingOn )
-import Type		( Kind, mkArrowKind, liftedTypeKind )
-import BasicTypes	( Boxity(..), Fixity(..), FixityDirection(..), IPName(..),
-			  Activation(..), defaultInlineSpec )
-import OrdList
-
-import FastString
-import Maybes		( orElse )
-import Outputable
-import GLAEXTS
-}
-
-{-
------------------------------------------------------------------------------
-Conflicts: 36 shift/reduce (1.25)
-
-10 for abiguity in 'if x then y else z + 1'		[State 178]
-	(shift parses as 'if x then y else (z + 1)', as per longest-parse rule)
-	10 because op might be: : - ! * . `x` VARSYM CONSYM QVARSYM QCONSYM
-
-1 for ambiguity in 'if x then y else z :: T'		[State 178]
-	(shift parses as 'if x then y else (z :: T)', as per longest-parse rule)
-
-4 for ambiguity in 'if x then y else z -< e'		[State 178]
-	(shift parses as 'if x then y else (z -< T)', as per longest-parse rule)
-	There are four such operators: -<, >-, -<<, >>-
-
-
-2 for ambiguity in 'case v of { x :: T -> T ... } ' 	[States 11, 253]
- 	Which of these two is intended?
-	  case v of
-	    (x::T) -> T		-- Rhs is T
-    or
-	  case v of
-	    (x::T -> T) -> ..	-- Rhs is ...
-
-10 for ambiguity in 'e :: a `b` c'.  Does this mean 	[States 11, 253]
-	(e::a) `b` c, or 
-	(e :: (a `b` c))
-    As well as `b` we can have !, VARSYM, QCONSYM, and CONSYM, hence 5 cases
-    Same duplication between states 11 and 253 as the previous case
-
-1 for ambiguity in 'let ?x ...'				[State 329]
-	the parser can't tell whether the ?x is the lhs of a normal binding or
-	an implicit binding.  Fortunately resolving as shift gives it the only
-	sensible meaning, namely the lhs of an implicit binding.
-
-1 for ambiguity in '{-# RULES "name" [ ... #-}		[State 382]
-	we don't know whether the '[' starts the activation or not: it
-  	might be the start of the declaration with the activation being
-	empty.  --SDM 1/4/2002
-
-6 for conflicts between `fdecl' and `fdeclDEPRECATED', 	[States 393,394]
-  	which are resolved correctly, and moreover, 
-  	should go away when `fdeclDEPRECATED' is removed.
-
-1 for ambiguity in '{-# RULES "name" forall = ... #-}' 	[State 474]
-	since 'forall' is a valid variable name, we don't know whether
-	to treat a forall on the input as the beginning of a quantifier
-	or the beginning of the rule itself.  Resolving to shift means
-	it's always treated as a quantifier, hence the above is disallowed.
-	This saves explicitly defining a grammar for the rule lhs that
-	doesn't include 'forall'.
-
--- ---------------------------------------------------------------------------
--- Adding location info
-
-This is done in a stylised way using the three macros below, L0, L1
-and LL.  Each of these macros can be thought of as having type
-
-   L0, L1, LL :: a -> Located a
-
-They each add a SrcSpan to their argument.
-
-   L0	adds 'noSrcSpan', used for empty productions
-
-   L1   for a production with a single token on the lhs.  Grabs the SrcSpan
-	from that token.
-
-   LL   for a production with >1 token on the lhs.  Makes up a SrcSpan from
-        the first and last tokens.
-
-These suffice for the majority of cases.  However, we must be
-especially careful with empty productions: LL won't work if the first
-or last token on the lhs can represent an empty span.  In these cases,
-we have to calculate the span using more of the tokens from the lhs, eg.
-
-	| 'newtype' tycl_hdr '=' newconstr deriving
-		{ L (comb3 $1 $4 $5)
-		    (mkTyData NewType (unLoc $2) [$4] (unLoc $5)) }
-
-We provide comb3 and comb4 functions which are useful in such cases.
-
-Be careful: there's no checking that you actually got this right, the
-only symptom will be that the SrcSpans of your syntax will be
-incorrect.
-
-/*
- * We must expand these macros *before* running Happy, which is why this file is
- * Parser.y.pp rather than just Parser.y - we run the C pre-processor first.
- */
-#define L0   L noSrcSpan
-#define L1   sL (getLoc $1)
-#define LL   sL (comb2 $1 $>)
-
--- -----------------------------------------------------------------------------
-
--}
-
-%token
- '_'            { L _ ITunderscore }		-- Haskell keywords
- 'as' 		{ L _ ITas }
- 'case' 	{ L _ ITcase }  	
- 'class' 	{ L _ ITclass } 
- 'data' 	{ L _ ITdata } 
- 'default' 	{ L _ ITdefault }
- 'deriving' 	{ L _ ITderiving }
- 'do' 		{ L _ ITdo }
- 'else' 	{ L _ ITelse }
- 'hiding' 	{ L _ IThiding }
- 'if' 		{ L _ ITif }
- 'import' 	{ L _ ITimport }
- 'in' 		{ L _ ITin }
- 'infix' 	{ L _ ITinfix }
- 'infixl' 	{ L _ ITinfixl }
- 'infixr' 	{ L _ ITinfixr }
- 'instance' 	{ L _ ITinstance }
- 'let' 		{ L _ ITlet }
- 'module' 	{ L _ ITmodule }
- 'newtype' 	{ L _ ITnewtype }
- 'of' 		{ L _ ITof }
- 'qualified' 	{ L _ ITqualified }
- 'then' 	{ L _ ITthen }
- 'type' 	{ L _ ITtype }
- 'where' 	{ L _ ITwhere }
- '_scc_'	{ L _ ITscc }	      -- ToDo: remove
-
- 'forall'	{ L _ ITforall }			-- GHC extension keywords
- 'foreign'	{ L _ ITforeign }
- 'export'	{ L _ ITexport }
- 'label'	{ L _ ITlabel } 
- 'dynamic'	{ L _ ITdynamic }
- 'safe'		{ L _ ITsafe }
- 'threadsafe'	{ L _ ITthreadsafe }
- 'unsafe'	{ L _ ITunsafe }
- 'mdo'		{ L _ ITmdo }
- 'stdcall'      { L _ ITstdcallconv }
- 'ccall'        { L _ ITccallconv }
- 'dotnet'       { L _ ITdotnet }
- 'proc'		{ L _ ITproc }		-- for arrow notation extension
- 'rec'		{ L _ ITrec }		-- for arrow notation extension
-
- '{-# INLINE'      	  { L _ (ITinline_prag _) }
- '{-# SPECIALISE'  	  { L _ ITspec_prag }
- '{-# SPECIALISE_INLINE'  { L _ (ITspec_inline_prag _) }
- '{-# SOURCE'	   { L _ ITsource_prag }
- '{-# RULES'	   { L _ ITrules_prag }
- '{-# CORE'        { L _ ITcore_prag }              -- hdaume: annotated core
- '{-# SCC'	   { L _ ITscc_prag }
- '{-# DEPRECATED'  { L _ ITdeprecated_prag }
- '{-# UNPACK'      { L _ ITunpack_prag }
- '#-}'		   { L _ ITclose_prag }
-
- '..'		{ L _ ITdotdot }  			-- reserved symbols
- ':'		{ L _ ITcolon }
- '::'		{ L _ ITdcolon }
- '='		{ L _ ITequal }
- '\\'		{ L _ ITlam }
- '|'		{ L _ ITvbar }
- '<-'		{ L _ ITlarrow }
- '->'		{ L _ ITrarrow }
- '@'		{ L _ ITat }
- '~'		{ L _ ITtilde }
- '=>'		{ L _ ITdarrow }
- '-'		{ L _ ITminus }
- '!'		{ L _ ITbang }
- '*'		{ L _ ITstar }
- '-<'		{ L _ ITlarrowtail }		-- for arrow notation
- '>-'		{ L _ ITrarrowtail }		-- for arrow notation
- '-<<'		{ L _ ITLarrowtail }		-- for arrow notation
- '>>-'		{ L _ ITRarrowtail }		-- for arrow notation
- '.'		{ L _ ITdot }
-
- '{'		{ L _ ITocurly } 			-- special symbols
- '}'		{ L _ ITccurly }
- '{|'           { L _ ITocurlybar }
- '|}'           { L _ ITccurlybar }
- vocurly	{ L _ ITvocurly } -- virtual open curly (from layout)
- vccurly	{ L _ ITvccurly } -- virtual close curly (from layout)
- '['		{ L _ ITobrack }
- ']'		{ L _ ITcbrack }
- '[:'		{ L _ ITopabrack }
- ':]'		{ L _ ITcpabrack }
- '('		{ L _ IToparen }
- ')'		{ L _ ITcparen }
- '(#'		{ L _ IToubxparen }
- '#)'		{ L _ ITcubxparen }
- '(|'		{ L _ IToparenbar }
- '|)'		{ L _ ITcparenbar }
- ';'		{ L _ ITsemi }
- ','		{ L _ ITcomma }
- '`'		{ L _ ITbackquote }
-
- VARID   	{ L _ (ITvarid    _) }		-- identifiers
- CONID   	{ L _ (ITconid    _) }
- VARSYM  	{ L _ (ITvarsym   _) }
- CONSYM  	{ L _ (ITconsym   _) }
- QVARID  	{ L _ (ITqvarid   _) }
- QCONID  	{ L _ (ITqconid   _) }
- QVARSYM 	{ L _ (ITqvarsym  _) }
- QCONSYM 	{ L _ (ITqconsym  _) }
-
- IPDUPVARID   	{ L _ (ITdupipvarid   _) }		-- GHC extension
- IPSPLITVARID  	{ L _ (ITsplitipvarid _) }		-- GHC extension
-
- CHAR		{ L _ (ITchar     _) }
- STRING		{ L _ (ITstring   _) }
- INTEGER	{ L _ (ITinteger  _) }
- RATIONAL	{ L _ (ITrational _) }
-		    
- PRIMCHAR	{ L _ (ITprimchar   _) }
- PRIMSTRING	{ L _ (ITprimstring _) }
- PRIMINTEGER	{ L _ (ITprimint    _) }
- PRIMFLOAT	{ L _ (ITprimfloat  _) }
- PRIMDOUBLE	{ L _ (ITprimdouble _) }
- 		    
--- Template Haskell 
-'[|'            { L _ ITopenExpQuote  }       
-'[p|'           { L _ ITopenPatQuote  }      
-'[t|'           { L _ ITopenTypQuote  }      
-'[d|'           { L _ ITopenDecQuote  }      
-'|]'            { L _ ITcloseQuote    }
-TH_ID_SPLICE    { L _ (ITidEscape _)  }     -- $x
-'$('	        { L _ ITparenEscape   }     -- $( exp )
-TH_VAR_QUOTE	{ L _ ITvarQuote      }     -- 'x
-TH_TY_QUOTE	{ L _ ITtyQuote       }      -- ''T
-
-%monad { P } { >>= } { return }
-%lexer { lexer } { L _ ITeof }
-%name parseModule module
-%name parseStmt   maybe_stmt
-%name parseIdentifier  identifier
-%name parseType ctype
-%partial parseHeader header
-%tokentype { (Located Token) }
-%%
-
------------------------------------------------------------------------------
--- Identifiers; one of the entry points
-identifier :: { Located RdrName }
-	: qvar				{ $1 }
-	| qcon				{ $1 }
-	| qvarop			{ $1 }
-	| qconop			{ $1 }
-
------------------------------------------------------------------------------
--- Module Header
-
--- The place for module deprecation is really too restrictive, but if it
--- was allowed at its natural place just before 'module', we get an ugly
--- s/r conflict with the second alternative. Another solution would be the
--- introduction of a new pragma DEPRECATED_MODULE, but this is not very nice,
--- either, and DEPRECATED is only expected to be used by people who really
--- know what they are doing. :-)
-
-module 	:: { Located (HsModule RdrName) }
- 	: 'module' modid maybemoddeprec maybeexports 'where' body 
-		{% fileSrcSpan >>= \ loc ->
-		   return (L loc (HsModule (Just $2) $4 (fst $6) (snd $6) $3)) }
-	| missing_module_keyword top close
-		{% fileSrcSpan >>= \ loc ->
-		   return (L loc (HsModule Nothing Nothing 
-				(fst $2) (snd $2) Nothing)) }
-
-missing_module_keyword :: { () }
-	: {- empty -}				{% pushCurrentContext }
-
-maybemoddeprec :: { Maybe DeprecTxt }
-	: '{-# DEPRECATED' STRING '#-}' 	{ Just (getSTRING $2) }
-	|  {- empty -}				{ Nothing }
-
-body 	:: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
-	:  '{'            top '}'		{ $2 }
- 	|      vocurly    top close		{ $2 }
-
-top 	:: { ([LImportDecl RdrName], [LHsDecl RdrName]) }
-	: importdecls				{ (reverse $1,[]) }
-	| importdecls ';' cvtopdecls		{ (reverse $1,$3) }
-	| cvtopdecls				{ ([],$1) }
-
-cvtopdecls :: { [LHsDecl RdrName] }
-	: topdecls				{ cvTopDecls $1 }
-
------------------------------------------------------------------------------
--- Module declaration & imports only
-
-header 	:: { Located (HsModule RdrName) }
- 	: 'module' modid maybemoddeprec maybeexports 'where' header_body
-		{% fileSrcSpan >>= \ loc ->
-		   return (L loc (HsModule (Just $2) $4 $6 [] $3)) }
-	| missing_module_keyword importdecls
-		{% fileSrcSpan >>= \ loc ->
-		   return (L loc (HsModule Nothing Nothing $2 [] Nothing)) }
-
-header_body :: { [LImportDecl RdrName] }
-	:  '{'            importdecls		{ $2 }
- 	|      vocurly    importdecls		{ $2 }
-
------------------------------------------------------------------------------
--- The Export List
-
-maybeexports :: { Maybe [LIE RdrName] }
-	:  '(' exportlist ')'			{ Just $2 }
-	|  {- empty -}				{ Nothing }
-
-exportlist :: { [LIE RdrName] }
- 	:  exportlist ',' export		{ $3 : $1 }
-	|  exportlist ','			{ $1 }
- 	|  export				{ [$1]  }
-	|  {- empty -}				{ [] }
-
-   -- No longer allow things like [] and (,,,) to be exported
-   -- They are built in syntax, always available
-export 	:: { LIE RdrName }
-	:  qvar				{ L1 (IEVar (unLoc $1)) }
-	|  oqtycon			{ L1 (IEThingAbs (unLoc $1)) }
-	|  oqtycon '(' '..' ')'		{ LL (IEThingAll (unLoc $1)) }
-	|  oqtycon '(' ')'		{ LL (IEThingWith (unLoc $1) []) }
-	|  oqtycon '(' qcnames ')'	{ LL (IEThingWith (unLoc $1) (reverse $3)) }
-	|  'module' modid		{ LL (IEModuleContents (unLoc $2)) }
-
-qcnames :: { [RdrName] }
-	:  qcnames ',' qcname			{ unLoc $3 : $1 }
-	|  qcname				{ [unLoc $1]  }
-
-qcname 	:: { Located RdrName }	-- Variable or data constructor
-	:  qvar					{ $1 }
-	|  qcon					{ $1 }
-
------------------------------------------------------------------------------
--- Import Declarations
-
--- import decls can be *empty*, or even just a string of semicolons
--- whereas topdecls must contain at least one topdecl.
-
-importdecls :: { [LImportDecl RdrName] }
-	: importdecls ';' importdecl		{ $3 : $1 }
-	| importdecls ';'			{ $1 }
-	| importdecl				{ [ $1 ] }
-	| {- empty -}				{ [] }
-
-importdecl :: { LImportDecl RdrName }
-	: 'import' maybe_src optqualified modid maybeas maybeimpspec 
-		{ L (comb4 $1 $4 $5 $6) (ImportDecl $4 $2 $3 (unLoc $5) (unLoc $6)) }
-
-maybe_src :: { IsBootInterface }
-	: '{-# SOURCE' '#-}'			{ True }
-	| {- empty -}				{ False }
-
-optqualified :: { Bool }
-      	: 'qualified'                           { True  }
-      	| {- empty -}				{ False }
-
-maybeas :: { Located (Maybe Module) }
-      	: 'as' modid                            { LL (Just (unLoc $2)) }
-      	| {- empty -}				{ noLoc Nothing }
-
-maybeimpspec :: { Located (Maybe (Bool, [LIE RdrName])) }
-	: impspec				{ L1 (Just (unLoc $1)) }
-	| {- empty -}				{ noLoc Nothing }
-
-impspec :: { Located (Bool, [LIE RdrName]) }
-	:  '(' exportlist ')'  			{ LL (False, reverse $2) }
-	|  'hiding' '(' exportlist ')' 		{ LL (True,  reverse $3) }
-
------------------------------------------------------------------------------
--- Fixity Declarations
-
-prec 	:: { Int }
-	: {- empty -}		{ 9 }
-	| INTEGER		{% checkPrecP (L1 (fromInteger (getINTEGER $1))) }
-
-infix 	:: { Located FixityDirection }
-	: 'infix'				{ L1 InfixN  }
-	| 'infixl'				{ L1 InfixL  }
-	| 'infixr'				{ L1 InfixR }
-
-ops   	:: { Located [Located RdrName] }
-	: ops ',' op				{ LL ($3 : unLoc $1) }
-	| op					{ L1 [$1] }
-
------------------------------------------------------------------------------
--- Top-Level Declarations
-
-topdecls :: { OrdList (LHsDecl RdrName) }	-- Reversed
-	: topdecls ';' topdecl		{ $1 `appOL` $3 }
-	| topdecls ';'			{ $1 }
-	| topdecl			{ $1 }
-
-topdecl :: { OrdList (LHsDecl RdrName) }
-  	: tycl_decl			{ unitOL (L1 (TyClD (unLoc $1))) }
-	| 'instance' inst_type where
-		{ let (binds,sigs) = cvBindsAndSigs (unLoc $3)
-		  in unitOL (L (comb3 $1 $2 $3) (InstD (InstDecl $2 binds sigs))) }
-	| 'default' '(' comma_types0 ')'	{ unitOL (LL $ DefD (DefaultDecl $3)) }
-	| 'foreign' fdecl			{ unitOL (LL (unLoc $2)) }
-	| '{-# DEPRECATED' deprecations '#-}'	{ $2 }
-	| '{-# RULES' rules '#-}'		{ $2 }
-	| '$(' exp ')'				{ unitOL (LL $ SpliceD (SpliceDecl $2)) }
-      	| decl					{ unLoc $1 }
-
-tycl_decl :: { LTyClDecl RdrName }
- 	: 'type' type '=' ctype	
-		-- Note type on the left of the '='; this allows
-		-- infix type constructors to be declared
-		-- 
-		-- Note ctype, not sigtype, on the right
-		-- We allow an explicit for-all but we don't insert one
-		-- in 	type Foo a = (b,b)
-		-- Instead we just say b is out of scope
- 		{% do { (tc,tvs) <- checkSynHdr $2
-		      ; return (LL (TySynonym tc tvs $4)) } }
-
-	| data_or_newtype tycl_hdr constrs deriving
-		{ L (comb4 $1 $2 $3 $4)	-- We need the location on tycl_hdr 
-					-- in case constrs and deriving are both empty
-		    (mkTyData (unLoc $1) (unLoc $2) Nothing (reverse (unLoc $3)) (unLoc $4)) }
-
-        | data_or_newtype tycl_hdr opt_kind_sig 
-		 'where' gadt_constrlist
-		 deriving
-		{ L (comb4 $1 $2 $4 $5)
-		    (mkTyData (unLoc $1) (unLoc $2) $3 (reverse (unLoc $5)) (unLoc $6)) }
-
-	| 'class' tycl_hdr fds where
-		{ let 
-			(binds,sigs) = cvBindsAndSigs (unLoc $4)
-		  in
-	 	  L (comb4 $1 $2 $3 $4) (mkClassDecl (unLoc $2) (unLoc $3) sigs 
-					  binds) }
-
-data_or_newtype :: { Located NewOrData }
-	: 'data'	{ L1 DataType }
-	| 'newtype'	{ L1 NewType }
-
-opt_kind_sig :: { Maybe Kind }
-	: 				{ Nothing }
-	| '::' kind			{ Just $2 }
-
--- tycl_hdr parses the header of a type or class decl,
--- which takes the form
---	T a b
--- 	Eq a => T a
---	(Eq a, Ord b) => T a b
--- Rather a lot of inlining here, else we get reduce/reduce errors
-tycl_hdr :: { Located (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName]) }
-	: context '=>' type		{% checkTyClHdr $1         $3 >>= return.LL }
-	| type				{% checkTyClHdr (noLoc []) $1 >>= return.L1 }
-
------------------------------------------------------------------------------
--- Nested declarations
-
-decls 	:: { Located (OrdList (LHsDecl RdrName)) }	-- Reversed
-	: decls ';' decl		{ LL (unLoc $1 `appOL` unLoc $3) }
-	| decls ';'			{ LL (unLoc $1) }
-	| decl				{ $1 }
-	| {- empty -}			{ noLoc nilOL }
-
-
-decllist :: { Located (OrdList (LHsDecl RdrName)) }	-- Reversed
-	: '{'            decls '}'	{ LL (unLoc $2) }
-	|     vocurly    decls close	{ $2 }
-
-where 	:: { Located (OrdList (LHsDecl RdrName)) }	-- Reversed
-				-- No implicit parameters
-	: 'where' decllist		{ LL (unLoc $2) }
-	| {- empty -}			{ noLoc nilOL }
-
-binds 	::  { Located (HsLocalBinds RdrName) } 		-- May have implicit parameters
-	: decllist			{ L1 (HsValBinds (cvBindGroup (unLoc $1))) }
-	| '{'            dbinds '}'	{ LL (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
-	|     vocurly    dbinds close	{ L (getLoc $2) (HsIPBinds (IPBinds (unLoc $2) emptyLHsBinds)) }
-
-wherebinds :: { Located (HsLocalBinds RdrName) }	-- May have implicit parameters
-	: 'where' binds			{ LL (unLoc $2) }
-	| {- empty -}			{ noLoc emptyLocalBinds }
-
-
------------------------------------------------------------------------------
--- Transformation Rules
-
-rules	:: { OrdList (LHsDecl RdrName) }	-- Reversed
-	:  rules ';' rule			{ $1 `snocOL` $3 }
-        |  rules ';'				{ $1 }
-        |  rule					{ unitOL $1 }
-	|  {- empty -}				{ nilOL }
-
-rule  	:: { LHsDecl RdrName }
-	: STRING activation rule_forall infixexp '=' exp
-	     { LL $ RuleD (HsRule (getSTRING $1) 
-				  ($2 `orElse` AlwaysActive) 
-				  $3 $4 placeHolderNames $6 placeHolderNames) }
-
-activation :: { Maybe Activation } 
-        : {- empty -}                           { Nothing }
-        | explicit_activation                   { Just $1 }
-
-explicit_activation :: { Activation }  -- In brackets
-        : '[' INTEGER ']'		{ ActiveAfter  (fromInteger (getINTEGER $2)) }
-        | '[' '~' INTEGER ']'		{ ActiveBefore (fromInteger (getINTEGER $3)) }
-
-rule_forall :: { [RuleBndr RdrName] }
-	: 'forall' rule_var_list '.'            { $2 }
-        | {- empty -}				{ [] }
-
-rule_var_list :: { [RuleBndr RdrName] }
-        : rule_var				{ [$1] }
-        | rule_var rule_var_list		{ $1 : $2 }
-
-rule_var :: { RuleBndr RdrName }
-	: varid                              	{ RuleBndr $1 }
-       	| '(' varid '::' ctype ')'             	{ RuleBndrSig $2 $4 }
-
------------------------------------------------------------------------------
--- Deprecations (c.f. rules)
-
-deprecations :: { OrdList (LHsDecl RdrName) }	-- Reversed
-	: deprecations ';' deprecation		{ $1 `appOL` $3 }
-	| deprecations ';' 			{ $1 }
-	| deprecation				{ $1 }
-	| {- empty -}				{ nilOL }
-
--- SUP: TEMPORARY HACK, not checking for `module Foo'
-deprecation :: { OrdList (LHsDecl RdrName) }
-	: depreclist STRING
-		{ toOL [ LL $ DeprecD (Deprecation n (getSTRING $2)) 
-		       | n <- unLoc $1 ] }
-
-
------------------------------------------------------------------------------
--- Foreign import and export declarations
-
--- for the time being, the following accepts foreign declarations conforming
--- to the FFI Addendum, Version 1.0 as well as pre-standard declarations
---
--- * a flag indicates whether pre-standard declarations have been used and
---   triggers a deprecation warning further down the road
---
--- NB: The first two rules could be combined into one by replacing `safety1'
---     with `safety'.  However, the combined rule conflicts with the
---     DEPRECATED rules.
---
-fdecl :: { LHsDecl RdrName }
-fdecl : 'import' callconv safety1 fspec
-		{% mkImport $2 $3 (unLoc $4) >>= return.LL }
-      | 'import' callconv         fspec		
-		{% do { d <- mkImport $2 (PlaySafe False) (unLoc $3);
-			return (LL d) } }
-      | 'export' callconv fspec
-		{% mkExport $2 (unLoc $3) >>= return.LL }
-        -- the following syntax is DEPRECATED
-      | fdecl1DEPRECATED			{ L1 (ForD (unLoc $1)) }
-      | fdecl2DEPRECATED			{ L1 (unLoc $1) }
-
-fdecl1DEPRECATED :: { LForeignDecl RdrName }
-fdecl1DEPRECATED 
-  ----------- DEPRECATED label decls ------------
-  : 'label' ext_name varid '::' sigtype
-    { LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS 
-				   (CLabel ($2 `orElse` mkExtName (unLoc $3)))) True }
-
-  ----------- DEPRECATED ccall/stdcall decls ------------
-  --
-  -- NB: This business with the case expression below may seem overly
-  --	 complicated, but it is necessary to avoid some conflicts.
-
-    -- DEPRECATED variant #1: lack of a calling convention specification
-    --			      (import) 
-  | 'import' {-no callconv-} ext_name safety varid_no_unsafe '::' sigtype
-    { let
-	target = StaticTarget ($2 `orElse` mkExtName (unLoc $4))
-      in
-      LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS 
-				   (CFunction target)) True }
-
-    -- DEPRECATED variant #2: external name consists of two separate strings
-    --			      (module name and function name) (import)
-  | 'import' callconv STRING STRING safety varid_no_unsafe '::' sigtype
-    {% case $2 of
-         DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
-	 CCall cconv -> return $
-           let
-	     imp = CFunction (StaticTarget (getSTRING $4))
-	   in
-	   LL $ ForeignImport $6 $8 (CImport cconv $5 nilFS nilFS imp) True }
-
-    -- DEPRECATED variant #3: `unsafe' after entity
-  | 'import' callconv STRING 'unsafe' varid_no_unsafe '::' sigtype
-    {% case $2 of
-         DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
-	 CCall cconv -> return $
-           let
-	     imp = CFunction (StaticTarget (getSTRING $3))
-	   in
-	   LL $ ForeignImport $5 $7 (CImport cconv PlayRisky nilFS nilFS imp) True }
-
-    -- DEPRECATED variant #4: use of the special identifier `dynamic' without
-    --			      an explicit calling convention (import)
-  | 'import' {-no callconv-} 'dynamic' safety varid_no_unsafe '::' sigtype
-    { LL $ ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS 
-				   (CFunction DynamicTarget)) True }
-
-    -- DEPRECATED variant #5: use of the special identifier `dynamic' (import)
-  | 'import' callconv 'dynamic' safety varid_no_unsafe '::' sigtype
-    {% case $2 of
-         DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
-	 CCall cconv -> return $
-	   LL $ ForeignImport $5 $7 (CImport cconv $4 nilFS nilFS 
-					(CFunction DynamicTarget)) True }
-
-    -- DEPRECATED variant #6: lack of a calling convention specification
-    --			      (export) 
-  | 'export' {-no callconv-} ext_name varid '::' sigtype
-    { LL $ ForeignExport $3 $5 (CExport (CExportStatic ($2 `orElse` mkExtName (unLoc $3))
-				   defaultCCallConv)) True }
-
-    -- DEPRECATED variant #7: external name consists of two separate strings
-    --			      (module name and function name) (export)
-  | 'export' callconv STRING STRING varid '::' sigtype
-    {% case $2 of
-         DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
-	 CCall cconv -> return $
-           LL $ ForeignExport $5 $7 
-			 (CExport (CExportStatic (getSTRING $4) cconv)) True }
-
-    -- DEPRECATED variant #8: use of the special identifier `dynamic' without
-    --			      an explicit calling convention (export)
-  | 'export' {-no callconv-} 'dynamic' varid '::' sigtype
-    { LL $ ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS 
-				   CWrapper) True }
-
-    -- DEPRECATED variant #9: use of the special identifier `dynamic' (export)
-  | 'export' callconv 'dynamic' varid '::' sigtype
-    {% case $2 of
-         DNCall      -> parseError (comb2 $1 $>) "Illegal format of .NET foreign import"
-	 CCall cconv -> return $
-	   LL $ ForeignImport $4 $6 
-		 (CImport cconv (PlaySafe False) nilFS nilFS CWrapper) True }
-
-  ----------- DEPRECATED .NET decls ------------
-  -- NB: removed the .NET call declaration, as it is entirely subsumed
-  --     by the new standard FFI declarations
-
-fdecl2DEPRECATED :: { LHsDecl RdrName }
-fdecl2DEPRECATED 
-  : 'import' 'dotnet' 'type' ext_name tycon { LL $ TyClD (ForeignType $5 $4 DNType) }
-    -- left this one unchanged for the moment as type imports are not
-    -- covered currently by the FFI standard -=chak
-
-
-callconv :: { CallConv }
-	  : 'stdcall'			{ CCall  StdCallConv }
-	  | 'ccall'			{ CCall  CCallConv   }
-	  | 'dotnet'			{ DNCall	     }
-
-safety :: { Safety }
-	: 'unsafe'			{ PlayRisky }
-	| 'safe'			{ PlaySafe False }
-	| 'threadsafe'			{ PlaySafe True  }
-	| {- empty -}			{ PlaySafe False }
-
-safety1 :: { Safety }
-	: 'unsafe'			{ PlayRisky }
-	| 'safe'			{ PlaySafe  False }
-	| 'threadsafe'			{ PlaySafe  True }
-	  -- only needed to avoid conflicts with the DEPRECATED rules
-
-fspec :: { Located (Located FastString, Located RdrName, LHsType RdrName) }
-       : STRING var '::' sigtype      { LL (L (getLoc $1) (getSTRING $1), $2, $4) }
-       |        var '::' sigtype      { LL (noLoc nilFS, $1, $3) }
-         -- if the entity string is missing, it defaults to the empty string;
-         -- the meaning of an empty entity string depends on the calling
-         -- convention
-
--- DEPRECATED syntax
-ext_name :: { Maybe CLabelString }
-	: STRING		{ Just (getSTRING $1) }
-	| STRING STRING		{ Just (getSTRING $2) }	-- Ignore "module name" for now
-	| {- empty -}           { Nothing }
-
-
------------------------------------------------------------------------------
--- Type signatures
-
-opt_sig :: { Maybe (LHsType RdrName) }
-	: {- empty -}			{ Nothing }
-	| '::' sigtype			{ Just $2 }
-
-opt_asig :: { Maybe (LHsType RdrName) }
-	: {- empty -}			{ Nothing }
-	| '::' atype			{ Just $2 }
-
-sigtypes1 :: { [LHsType RdrName] }
-	: sigtype			{ [ $1 ] }
-	| sigtype ',' sigtypes1		{ $1 : $3 }
-
-sigtype :: { LHsType RdrName }
-	: ctype				{ L1 (mkImplicitHsForAllTy (noLoc []) $1) }
-	-- Wrap an Implicit forall if there isn't one there already
-
-sig_vars :: { Located [Located RdrName] }
-	 : sig_vars ',' var		{ LL ($3 : unLoc $1) }
-	 | var				{ L1 [$1] }
-
------------------------------------------------------------------------------
--- Types
-
-strict_mark :: { Located HsBang }
-	: '!'				{ L1 HsStrict }
-	| '{-# UNPACK' '#-}' '!'	{ LL HsUnbox }
-
--- A ctype is a for-all type
-ctype	:: { LHsType RdrName }
-	: 'forall' tv_bndrs '.' ctype	{ LL $ mkExplicitHsForAllTy $2 (noLoc []) $4 }
-	| context '=>' type		{ LL $ mkImplicitHsForAllTy   $1 $3 }
-	-- A type of form (context => type) is an *implicit* HsForAllTy
-	| type				{ $1 }
-
--- We parse a context as a btype so that we don't get reduce/reduce
--- errors in ctype.  The basic problem is that
---	(Eq a, Ord a)
--- looks so much like a tuple type.  We can't tell until we find the =>
-context :: { LHsContext RdrName }
-	: btype 			{% checkContext $1 }
-
-type :: { LHsType RdrName }
-	: ipvar '::' gentype		{ LL (HsPredTy (HsIParam (unLoc $1) $3)) }
-	| gentype			{ $1 }
-
-gentype :: { LHsType RdrName }
-        : btype                         { $1 }
-        | btype qtyconop gentype        { LL $ HsOpTy $1 $2 $3 }
-        | btype tyvarop  gentype  	{ LL $ HsOpTy $1 $2 $3 }
- 	| btype '->' ctype		{ LL $ HsFunTy $1 $3 }
-
-btype :: { LHsType RdrName }
-	: btype atype			{ LL $ HsAppTy $1 $2 }
-	| atype				{ $1 }
-
-atype :: { LHsType RdrName }
-	: gtycon			{ L1 (HsTyVar (unLoc $1)) }
-	| tyvar				{ L1 (HsTyVar (unLoc $1)) }
-	| strict_mark atype		{ LL (HsBangTy (unLoc $1) $2) }
-	| '(' ctype ',' comma_types1 ')'  { LL $ HsTupleTy Boxed  ($2:$4) }
-	| '(#' comma_types1 '#)'	{ LL $ HsTupleTy Unboxed $2     }
-	| '[' ctype ']'			{ LL $ HsListTy  $2 }
-	| '[:' ctype ':]'		{ LL $ HsPArrTy  $2 }
-	| '(' ctype ')'		        { LL $ HsParTy   $2 }
-	| '(' ctype '::' kind ')'	{ LL $ HsKindSig $2 $4 }
--- Generics
-        | INTEGER                       { L1 (HsNumTy (getINTEGER $1)) }
-
--- An inst_type is what occurs in the head of an instance decl
---	e.g.  (Foo a, Gaz b) => Wibble a b
--- It's kept as a single type, with a MonoDictTy at the right
--- hand corner, for convenience.
-inst_type :: { LHsType RdrName }
-	: sigtype			{% checkInstType $1 }
-
-inst_types1 :: { [LHsType RdrName] }
-	: inst_type			{ [$1] }
-	| inst_type ',' inst_types1	{ $1 : $3 }
-
-comma_types0  :: { [LHsType RdrName] }
-	: comma_types1			{ $1 }
-	| {- empty -}			{ [] }
-
-comma_types1	:: { [LHsType RdrName] }
-	: ctype				{ [$1] }
-	| ctype  ',' comma_types1	{ $1 : $3 }
-
-tv_bndrs :: { [LHsTyVarBndr RdrName] }
-	 : tv_bndr tv_bndrs		{ $1 : $2 }
-	 | {- empty -}			{ [] }
-
-tv_bndr :: { LHsTyVarBndr RdrName }
-	: tyvar				{ L1 (UserTyVar (unLoc $1)) }
-	| '(' tyvar '::' kind ')'	{ LL (KindedTyVar (unLoc $2) $4) }
-
-fds :: { Located [Located ([RdrName], [RdrName])] }
-	: {- empty -}			{ noLoc [] }
-	| '|' fds1			{ LL (reverse (unLoc $2)) }
-
-fds1 :: { Located [Located ([RdrName], [RdrName])] }
-	: fds1 ',' fd			{ LL ($3 : unLoc $1) }
-	| fd				{ L1 [$1] }
-
-fd :: { Located ([RdrName], [RdrName]) }
-	: varids0 '->' varids0		{ L (comb3 $1 $2 $3)
-					   (reverse (unLoc $1), reverse (unLoc $3)) }
-
-varids0	:: { Located [RdrName] }
-	: {- empty -}			{ noLoc [] }
-	| varids0 tyvar			{ LL (unLoc $2 : unLoc $1) }
-
------------------------------------------------------------------------------
--- Kinds
-
-kind	:: { Kind }
-	: akind			{ $1 }
-	| akind '->' kind	{ mkArrowKind $1 $3 }
-
-akind	:: { Kind }
-	: '*'			{ liftedTypeKind }
-	| '(' kind ')'		{ $2 }
-
-
------------------------------------------------------------------------------
--- Datatype declarations
-
-gadt_constrlist :: { Located [LConDecl RdrName] }
-	: '{'            gadt_constrs '}'	{ LL (unLoc $2) }
-	|     vocurly    gadt_constrs close	{ $2 }
-
-gadt_constrs :: { Located [LConDecl RdrName] }
-        : gadt_constrs ';' gadt_constr  { LL ($3 : unLoc $1) }
-        | gadt_constrs ';' 		{ $1 }
-        | gadt_constr                   { L1 [$1] } 
-
--- We allow the following forms:
---	C :: Eq a => a -> T a
---	C :: forall a. Eq a => !a -> T a
---	D { x,y :: a } :: T a
---	forall a. Eq a => D { x,y :: a } :: T a
-
-gadt_constr :: { LConDecl RdrName }
-        : con '::' sigtype
-              { LL (mkGadtDecl $1 $3) } 
-        -- Syntax: Maybe merge the record stuff with the single-case above?
-        --         (to kill the mostly harmless reduce/reduce error)
-        -- XXX revisit autrijus
-	| constr_stuff_record '::' sigtype
-		{ let (con,details) = unLoc $1 in 
-		  LL (ConDecl con Implicit [] (noLoc []) details (ResTyGADT $3)) }
-{-
-	| forall context '=>' constr_stuff_record '::' sigtype
-		{ let (con,details) = unLoc $4 in 
-		  LL (ConDecl con Implicit (unLoc $1) $2 details (ResTyGADT $6)) }
-	| forall constr_stuff_record '::' sigtype
-		{ let (con,details) = unLoc $2 in 
-		  LL (ConDecl con Implicit (unLoc $1) (noLoc []) details (ResTyGADT $4)) }
--}
-
-
-constrs :: { Located [LConDecl RdrName] }
-        : {- empty; a GHC extension -}  { noLoc [] }
-        | '=' constrs1                  { LL (unLoc $2) }
-
-constrs1 :: { Located [LConDecl RdrName] }
-	: constrs1 '|' constr		{ LL ($3 : unLoc $1) }
-	| constr			{ L1 [$1] }
-
-constr :: { LConDecl RdrName }
-	: forall context '=>' constr_stuff	
-		{ let (con,details) = unLoc $4 in 
-		  LL (ConDecl con Explicit (unLoc $1) $2 details ResTyH98) }
-	| forall constr_stuff
-		{ let (con,details) = unLoc $2 in 
-		  LL (ConDecl con Explicit (unLoc $1) (noLoc []) details ResTyH98) }
-
-forall :: { Located [LHsTyVarBndr RdrName] }
-	: 'forall' tv_bndrs '.'		{ LL $2 }
-	| {- empty -}			{ noLoc [] }
-
-constr_stuff :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
--- We parse the constructor declaration 
---	C t1 t2
--- as a btype (treating C as a type constructor) and then convert C to be
--- a data constructor.  Reason: it might continue like this:
---	C t1 t2 %: D Int
--- in which case C really would be a type constructor.  We can't resolve this
--- ambiguity till we come across the constructor oprerator :% (or not, more usually)
-	: btype				{% mkPrefixCon $1 [] >>= return.LL }
-	| oqtycon '{' '}' 		{% mkRecCon $1 [] >>= return.LL }
-	| oqtycon '{' fielddecls '}' 	{% mkRecCon $1 $3 >>= return.LL }
-	| btype conop btype		{ LL ($2, InfixCon $1 $3) }
-
-constr_stuff_record :: { Located (Located RdrName, HsConDetails RdrName (LBangType RdrName)) }
-	: oqtycon '{' '}' 		{% mkRecCon $1 [] >>= return.sL (comb2 $1 $>) }
-	| oqtycon '{' fielddecls '}' 	{% mkRecCon $1 $3 >>= return.sL (comb2 $1 $>) }
-
-fielddecls :: { [([Located RdrName], LBangType RdrName)] }
-	: fielddecl ',' fielddecls	{ unLoc $1 : $3 }
-	| fielddecl			{ [unLoc $1] }
-
-fielddecl :: { Located ([Located RdrName], LBangType RdrName) }
-	: sig_vars '::' ctype		{ LL (reverse (unLoc $1), $3) }
-
--- We allow the odd-looking 'inst_type' in a deriving clause, so that
--- we can do deriving( forall a. C [a] ) in a newtype (GHC extension).
--- The 'C [a]' part is converted to an HsPredTy by checkInstType
--- We don't allow a context, but that's sorted out by the type checker.
-deriving :: { Located (Maybe [LHsType RdrName]) }
-	: {- empty -}				{ noLoc Nothing }
-	| 'deriving' qtycon	{% do { let { L loc tv = $2 }
-				      ; p <- checkInstType (L loc (HsTyVar tv))
-				      ; return (LL (Just [p])) } }
-	| 'deriving' '(' ')'	 		{ LL (Just []) }
-	| 'deriving' '(' inst_types1 ')' 	{ LL (Just $3) }
-             -- Glasgow extension: allow partial 
-             -- applications in derivings
-
------------------------------------------------------------------------------
--- Value definitions
-
-{- There's an awkward overlap with a type signature.  Consider
-	f :: Int -> Int = ...rhs...
-   Then we can't tell whether it's a type signature or a value
-   definition with a result signature until we see the '='.
-   So we have to inline enough to postpone reductions until we know.
--}
-
-{-
-  ATTENTION: Dirty Hackery Ahead! If the second alternative of vars is var
-  instead of qvar, we get another shift/reduce-conflict. Consider the
-  following programs:
-  
-     { (^^) :: Int->Int ; }          Type signature; only var allowed
-
-     { (^^) :: Int->Int = ... ; }    Value defn with result signature;
-				     qvar allowed (because of instance decls)
-  
-  We can't tell whether to reduce var to qvar until after we've read the signatures.
--}
-
-decl 	:: { Located (OrdList (LHsDecl RdrName)) }
-	: sigdecl			{ $1 }
-	| '!' infixexp rhs		{% do { pat <- checkPattern $2;
-					        return (LL $ unitOL $ LL $ ValD $ 
-							PatBind (LL $ BangPat pat) (unLoc $3)
-								placeHolderType placeHolderNames) } }
-	| infixexp opt_sig rhs		{% do { r <- checkValDef $1 $2 $3;
-						return (LL $ unitOL (LL $ ValD r)) } }
-
-rhs	:: { Located (GRHSs RdrName) }
-	: '=' exp wherebinds	{ L (comb3 $1 $2 $3) $ GRHSs (unguardedRHS $2) (unLoc $3) }
-	| gdrhs	wherebinds	{ LL $ GRHSs (reverse (unLoc $1)) (unLoc $2) }
-
-gdrhs :: { Located [LGRHS RdrName] }
-	: gdrhs gdrh		{ LL ($2 : unLoc $1) }
-	| gdrh			{ L1 [$1] }
-
-gdrh :: { LGRHS RdrName }
-	: '|' quals '=' exp  	{ sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
-
-sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
-	: infixexp '::' sigtype
-				{% do s <- checkValSig $1 $3; 
-				      return (LL $ unitOL (LL $ SigD s)) }
-		-- See the above notes for why we need infixexp here
-	| var ',' sig_vars '::' sigtype	
-				{ LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
-	| infix prec ops	{ LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
-					     | n <- unLoc $3 ] }
-	| '{-# INLINE'   activation qvar '#-}'	      
-				{ LL $ unitOL (LL $ SigD (InlineSig $3 (mkInlineSpec $2 (getINLINE $1)))) }
-	| '{-# SPECIALISE' qvar '::' sigtypes1 '#-}'
-			 	{ LL $ toOL [ LL $ SigD (SpecSig $2 t defaultInlineSpec)
-					    | t <- $4] }
-	| '{-# SPECIALISE_INLINE' activation qvar '::' sigtypes1 '#-}'
-			 	{ LL $ toOL [ LL $ SigD (SpecSig $3 t (mkInlineSpec $2 (getSPEC_INLINE $1)))
-					    | t <- $5] }
-	| '{-# SPECIALISE' 'instance' inst_type '#-}'
-				{ LL $ unitOL (LL $ SigD (SpecInstSig $3)) }
-
------------------------------------------------------------------------------
--- Expressions
-
-exp   :: { LHsExpr RdrName }
-	: infixexp '::' sigtype		{ LL $ ExprWithTySig $1 $3 }
-	| infixexp '-<' exp		{ LL $ HsArrApp $1 $3 placeHolderType HsFirstOrderApp True }
-	| infixexp '>-' exp		{ LL $ HsArrApp $3 $1 placeHolderType HsFirstOrderApp False }
-	| infixexp '-<<' exp		{ LL $ HsArrApp $1 $3 placeHolderType HsHigherOrderApp True }
-	| infixexp '>>-' exp		{ LL $ HsArrApp $3 $1 placeHolderType HsHigherOrderApp False}
-	| infixexp			{ $1 }
-
-infixexp :: { LHsExpr RdrName }
-	: exp10				{ $1 }
-	| infixexp qop exp10		{ LL (OpApp $1 $2 (panic "fixity") $3) }
-
-exp10 :: { LHsExpr RdrName }
-	: '\\' aexp aexps opt_asig '->' exp	
-			{% checkPatterns ($2 : reverse $3) >>= \ ps -> 
-			   return (LL $ HsLam (mkMatchGroup [LL $ Match ps $4
-					    (GRHSs (unguardedRHS $6) emptyLocalBinds
-							)])) }
-  	| 'let' binds 'in' exp			{ LL $ HsLet (unLoc $2) $4 }
-	| 'if' exp 'then' exp 'else' exp	{ LL $ HsIf $2 $4 $6 }
-   	| 'case' exp 'of' altslist		{ LL $ HsCase $2 (mkMatchGroup (unLoc $4)) }
-	| '-' fexp				{ LL $ mkHsNegApp $2 }
-
-  	| 'do' stmtlist			{% let loc = comb2 $1 $2 in
-					   checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
-					   return (L loc (mkHsDo DoExpr stmts body)) }
-  	| 'mdo' stmtlist		{% let loc = comb2 $1 $2 in
-					   checkDo loc (unLoc $2)  >>= \ (stmts,body) ->
-					   return (L loc (mkHsDo (MDoExpr noPostTcTable) stmts body)) }
-        | scc_annot exp		    		{ LL $ if opt_SccProfilingOn
-							then HsSCC (unLoc $1) $2
-							else HsPar $2 }
-
-	| 'proc' aexp '->' exp	
-			{% checkPattern $2 >>= \ p -> 
-			   return (LL $ HsProc p (LL $ HsCmdTop $4 [] 
-						   placeHolderType undefined)) }
-						-- TODO: is LL right here?
-
-        | '{-# CORE' STRING '#-}' exp           { LL $ HsCoreAnn (getSTRING $2) $4 }
-						    -- hdaume: core annotation
-	| fexp					{ $1 }
-
-scc_annot :: { Located FastString }
-	: '_scc_' STRING			{ LL $ getSTRING $2 }
-	| '{-# SCC' STRING '#-}'		{ LL $ getSTRING $2 }
-
-fexp 	:: { LHsExpr RdrName }
-	: fexp aexp				{ LL $ HsApp $1 $2 }
-  	| aexp					{ $1 }
-
-aexps 	:: { [LHsExpr RdrName] }
-	: aexps aexp				{ $2 : $1 }
-  	| {- empty -}				{ [] }
-
-aexp	:: { LHsExpr RdrName }
-	: qvar '@' aexp			{ LL $ EAsPat $1 $3 }
-	| '~' aexp			{ LL $ ELazyPat $2 }
---	| '!' aexp			{ LL $ EBangPat $2 }
-	| aexp1				{ $1 }
-
-aexp1	:: { LHsExpr RdrName }
-        : aexp1 '{' fbinds '}' 	{% do { r <- mkRecConstrOrUpdate $1 (comb2 $2 $4) 
-							(reverse $3);
-				        return (LL r) }}
-  	| aexp2			{ $1 }
-
--- Here was the syntax for type applications that I was planning
--- but there are difficulties (e.g. what order for type args)
--- so it's not enabled yet.
--- But this case *is* used for the left hand side of a generic definition,
--- which is parsed as an expression before being munged into a pattern
- 	| qcname '{|' gentype '|}'      { LL $ HsApp (sL (getLoc $1) (HsVar (unLoc $1)))
-						     (sL (getLoc $3) (HsType $3)) }
-
-aexp2	:: { LHsExpr RdrName }
-	: ipvar				{ L1 (HsIPVar $! unLoc $1) }
-	| qcname			{ L1 (HsVar   $! unLoc $1) }
-	| literal			{ L1 (HsLit   $! unLoc $1) }
-	| INTEGER			{ L1 (HsOverLit $! mkHsIntegral (getINTEGER $1)) }
-	| RATIONAL			{ L1 (HsOverLit $! mkHsFractional (getRATIONAL $1)) }
-	| '(' exp ')'			{ LL (HsPar $2) }
-	| '(' texp ',' texps ')'	{ LL $ ExplicitTuple ($2 : reverse $4) Boxed }
-	| '(#' texps '#)'		{ LL $ ExplicitTuple (reverse $2)      Unboxed }
-	| '[' list ']'                  { LL (unLoc $2) }
-	| '[:' parr ':]'                { LL (unLoc $2) }
-	| '(' infixexp qop ')'		{ LL $ SectionL $2 $3 }
-	| '(' qopm infixexp ')'		{ LL $ SectionR $2 $3 }
-	| '_'				{ L1 EWildPat }
-	
-	-- MetaHaskell Extension
-	| TH_ID_SPLICE          { L1 $ HsSpliceE (mkHsSplice 
-					(L1 $ HsVar (mkUnqual varName 
-							(getTH_ID_SPLICE $1)))) } -- $x
-	| '$(' exp ')'   	{ LL $ HsSpliceE (mkHsSplice $2) }               -- $( exp )
-
-	| TH_VAR_QUOTE qvar 	{ LL $ HsBracket (VarBr (unLoc $2)) }
-	| TH_VAR_QUOTE qcon 	{ LL $ HsBracket (VarBr (unLoc $2)) }
-	| TH_TY_QUOTE tyvar 	{ LL $ HsBracket (VarBr (unLoc $2)) }
- 	| TH_TY_QUOTE gtycon	{ LL $ HsBracket (VarBr (unLoc $2)) }
-	| '[|' exp '|]'         { LL $ HsBracket (ExpBr $2) }                       
-	| '[t|' ctype '|]'      { LL $ HsBracket (TypBr $2) }                       
-	| '[p|' infixexp '|]'   {% checkPattern $2 >>= \p ->
-					   return (LL $ HsBracket (PatBr p)) }
-	| '[d|' cvtopbody '|]'	{ LL $ HsBracket (DecBr (mkGroup $2)) }
-
-	-- arrow notation extension
-	| '(|' aexp2 cmdargs '|)'	{ LL $ HsArrForm $2 Nothing (reverse $3) }
-
-cmdargs	:: { [LHsCmdTop RdrName] }
-	: cmdargs acmd			{ $2 : $1 }
-  	| {- empty -}			{ [] }
-
-acmd	:: { LHsCmdTop RdrName }
-	: aexp2			{ L1 $ HsCmdTop $1 [] placeHolderType undefined }
-
-cvtopbody :: { [LHsDecl RdrName] }
-	:  '{'            cvtopdecls0 '}'		{ $2 }
-	|      vocurly    cvtopdecls0 close		{ $2 }
-
-cvtopdecls0 :: { [LHsDecl RdrName] }
-	: {- empty -}		{ [] }
-	| cvtopdecls		{ $1 }
-
-texp :: { LHsExpr RdrName }
-	: exp				{ $1 }
-	| qopm infixexp			{ LL $ SectionR $1 $2 }
-	-- The second production is really here only for bang patterns
-	-- but 
-
-texps :: { [LHsExpr RdrName] }
-	: texps ',' texp		{ $3 : $1 }
-	| texp				{ [$1] }
-
-
------------------------------------------------------------------------------
--- List expressions
-
--- The rules below are little bit contorted to keep lexps left-recursive while
--- avoiding another shift/reduce-conflict.
-
-list :: { LHsExpr RdrName }
-	: texp			{ L1 $ ExplicitList placeHolderType [$1] }
-	| lexps 		{ L1 $ ExplicitList placeHolderType (reverse (unLoc $1)) }
-	| texp '..'		{ LL $ ArithSeq noPostTcExpr (From $1) }
-	| texp ',' exp '..' 	{ LL $ ArithSeq noPostTcExpr (FromThen $1 $3) }
-	| texp '..' exp	 	{ LL $ ArithSeq noPostTcExpr (FromTo $1 $3) }
-	| texp ',' exp '..' exp	{ LL $ ArithSeq noPostTcExpr (FromThenTo $1 $3 $5) }
-	| texp pquals		{ sL (comb2 $1 $>) $ mkHsDo ListComp (reverse (unLoc $2)) $1 }
-
-lexps :: { Located [LHsExpr RdrName] }
-	: lexps ',' texp 		{ LL ($3 : unLoc $1) }
-	| texp ',' texp			{ LL [$3,$1] }
-
------------------------------------------------------------------------------
--- List Comprehensions
-
-pquals :: { Located [LStmt RdrName] }	-- Either a singleton ParStmt, 
-					-- or a reversed list of Stmts
-	: pquals1			{ case unLoc $1 of
-					    [qs] -> L1 qs
-					    qss  -> L1 [L1 (ParStmt stmtss)]
-						 where
-						    stmtss = [ (reverse qs, undefined) 
-						    	     | qs <- qss ]
-					}
-			
-pquals1 :: { Located [[LStmt RdrName]] }
-	: pquals1 '|' quals		{ LL (unLoc $3 : unLoc $1) }
-	| '|' quals			{ L (getLoc $2) [unLoc $2] }
-
-quals :: { Located [LStmt RdrName] }
-	: quals ',' qual		{ LL ($3 : unLoc $1) }
-	| qual				{ L1 [$1] }
-
------------------------------------------------------------------------------
--- Parallel array expressions
-
--- The rules below are little bit contorted; see the list case for details.
--- Note that, in contrast to lists, we only have finite arithmetic sequences.
--- Moreover, we allow explicit arrays with no element (represented by the nil
--- constructor in the list case).
-
-parr :: { LHsExpr RdrName }
-	: 				{ noLoc (ExplicitPArr placeHolderType []) }
-	| exp				{ L1 $ ExplicitPArr placeHolderType [$1] }
-	| lexps 			{ L1 $ ExplicitPArr placeHolderType 
-						       (reverse (unLoc $1)) }
-	| exp '..' exp	 		{ LL $ PArrSeq noPostTcExpr (FromTo $1 $3) }
-	| exp ',' exp '..' exp		{ LL $ PArrSeq noPostTcExpr (FromThenTo $1 $3 $5) }
-	| exp pquals			{ sL (comb2 $1 $>) $ mkHsDo PArrComp (reverse (unLoc $2)) $1 }
-
--- We are reusing `lexps' and `pquals' from the list case.
-
------------------------------------------------------------------------------
--- Case alternatives
-
-altslist :: { Located [LMatch RdrName] }
-	: '{'            alts '}'	{ LL (reverse (unLoc $2)) }
-	|     vocurly    alts  close	{ L (getLoc $2) (reverse (unLoc $2)) }
-
-alts    :: { Located [LMatch RdrName] }
-        : alts1				{ L1 (unLoc $1) }
-	| ';' alts			{ LL (unLoc $2) }
-
-alts1 	:: { Located [LMatch RdrName] }
-	: alts1 ';' alt			{ LL ($3 : unLoc $1) }
-	| alts1 ';'			{ LL (unLoc $1) }
-	| alt				{ L1 [$1] }
-
-alt 	:: { LMatch RdrName }
-	: infixexp opt_sig alt_rhs	{%  checkPattern $1 >>= \p ->
-			    		    return (LL (Match [p] $2 (unLoc $3))) }
-
-alt_rhs :: { Located (GRHSs RdrName) }
-	: ralt wherebinds		{ LL (GRHSs (unLoc $1) (unLoc $2)) }
-
-ralt :: { Located [LGRHS RdrName] }
-	: '->' exp			{ LL (unguardedRHS $2) }
-	| gdpats			{ L1 (reverse (unLoc $1)) }
-
-gdpats :: { Located [LGRHS RdrName] }
-	: gdpats gdpat			{ LL ($2 : unLoc $1) }
-	| gdpat				{ L1 [$1] }
-
-gdpat	:: { LGRHS RdrName }
-	: '|' quals '->' exp	 	{ sL (comb2 $1 $>) $ GRHS (reverse (unLoc $2)) $4 }
-
------------------------------------------------------------------------------
--- Statement sequences
-
-stmtlist :: { Located [LStmt RdrName] }
-	: '{'         	stmts '}'	{ LL (unLoc $2) }
-	|     vocurly   stmts close	{ $2 }
-
---	do { ;; s ; s ; ; s ;; }
--- The last Stmt should be an expression, but that's hard to enforce
--- here, because we need too much lookahead if we see do { e ; }
--- So we use ExprStmts throughout, and switch the last one over
--- in ParseUtils.checkDo instead
-stmts :: { Located [LStmt RdrName] }
-	: stmt stmts_help		{ LL ($1 : unLoc $2) }
-	| ';' stmts			{ LL (unLoc $2) }
-	| {- empty -}			{ noLoc [] }
-
-stmts_help :: { Located [LStmt RdrName] } -- might be empty
-	: ';' stmts			{ LL (unLoc $2) }
-	| {- empty -}			{ noLoc [] }
-
--- For typing stmts at the GHCi prompt, where 
--- the input may consist of just comments.
-maybe_stmt :: { Maybe (LStmt RdrName) }
-	: stmt				{ Just $1 }
-	| {- nothing -}			{ Nothing }
-
-stmt  :: { LStmt RdrName }
-	: qual				{ $1 }
-	| infixexp '->' exp		{% checkPattern $3 >>= \p ->
-					   return (LL $ mkBindStmt p $1) }
-  	| 'rec' stmtlist		{ LL $ mkRecStmt (unLoc $2) }
-
-qual  :: { LStmt RdrName }
-	: exp '<-' exp			{% checkPattern $1 >>= \p ->
-					   return (LL $ mkBindStmt p $3) }
-	| exp				{ L1 $ mkExprStmt $1 }
-  	| 'let' binds			{ LL $ LetStmt (unLoc $2) }
-
------------------------------------------------------------------------------
--- Record Field Update/Construction
-
-fbinds 	:: { HsRecordBinds RdrName }
-	: fbinds1			{ $1 }
-  	| {- empty -}			{ [] }
-
-fbinds1	:: { HsRecordBinds RdrName }
-	: fbinds1 ',' fbind		{ $3 : $1 }
-	| fbind				{ [$1] }
-  
-fbind	:: { (Located RdrName, LHsExpr RdrName) }
-	: qvar '=' exp			{ ($1,$3) }
-
------------------------------------------------------------------------------
--- Implicit Parameter Bindings
-
-dbinds 	:: { Located [LIPBind RdrName] }
-	: dbinds ';' dbind		{ LL ($3 : unLoc $1) }
-	| dbinds ';'			{ LL (unLoc $1) }
-	| dbind				{ L1 [$1] }
---	| {- empty -}			{ [] }
-
-dbind	:: { LIPBind RdrName }
-dbind	: ipvar '=' exp			{ LL (IPBind (unLoc $1) $3) }
-
-ipvar	:: { Located (IPName RdrName) }
-	: IPDUPVARID		{ L1 (Dupable (mkUnqual varName (getIPDUPVARID $1))) }
-	| IPSPLITVARID		{ L1 (Linear  (mkUnqual varName (getIPSPLITVARID $1))) }
-
------------------------------------------------------------------------------
--- Deprecations
-
-depreclist :: { Located [RdrName] }
-depreclist : deprec_var			{ L1 [unLoc $1] }
-	   | deprec_var ',' depreclist	{ LL (unLoc $1 : unLoc $3) }
-
-deprec_var :: { Located RdrName }
-deprec_var : var			{ $1 }
-	   | con			{ $1 }
-
------------------------------------------
--- Data constructors
-qcon	:: { Located RdrName }
-	: qconid		{ $1 }
-	| '(' qconsym ')'	{ LL (unLoc $2) }
-	| sysdcon		{ L1 $ nameRdrName (dataConName (unLoc $1)) }
--- The case of '[:' ':]' is part of the production `parr'
-
-con	:: { Located RdrName }
-	: conid			{ $1 }
-	| '(' consym ')'	{ LL (unLoc $2) }
-	| sysdcon		{ L1 $ nameRdrName (dataConName (unLoc $1)) }
-
-sysdcon	:: { Located DataCon }	-- Wired in data constructors
-	: '(' ')'		{ LL unitDataCon }
-	| '(' commas ')'	{ LL $ tupleCon Boxed $2 }
-	| '[' ']'		{ LL nilDataCon }
-
-conop :: { Located RdrName }
-	: consym		{ $1 }	
-	| '`' conid '`'		{ LL (unLoc $2) }
-
-qconop :: { Located RdrName }
-	: qconsym		{ $1 }
-	| '`' qconid '`'	{ LL (unLoc $2) }
-
------------------------------------------------------------------------------
--- Type constructors
-
-gtycon 	:: { Located RdrName }	-- A "general" qualified tycon
-	: oqtycon			{ $1 }
-	| '(' ')'			{ LL $ getRdrName unitTyCon }
-	| '(' commas ')'		{ LL $ getRdrName (tupleTyCon Boxed $2) }
-	| '(' '->' ')'			{ LL $ getRdrName funTyCon }
-	| '[' ']'			{ LL $ listTyCon_RDR }
-	| '[:' ':]'			{ LL $ parrTyCon_RDR }
-
-oqtycon :: { Located RdrName }	-- An "ordinary" qualified tycon
-	: qtycon			{ $1 }
- 	| '(' qtyconsym ')'		{ LL (unLoc $2) }
-
-qtyconop :: { Located RdrName }	-- Qualified or unqualified
-	: qtyconsym			{ $1 }
-	| '`' qtycon '`'		{ LL (unLoc $2) }
-
-qtycon :: { Located RdrName }	-- Qualified or unqualified
-	: QCONID			{ L1 $! mkQual tcClsName (getQCONID $1) }
-	| tycon				{ $1 }
-
-tycon 	:: { Located RdrName }	-- Unqualified
-	: CONID				{ L1 $! mkUnqual tcClsName (getCONID $1) }
-
-qtyconsym :: { Located RdrName }
-	: QCONSYM			{ L1 $! mkQual tcClsName (getQCONSYM $1) }
-	| tyconsym			{ $1 }
-
-tyconsym :: { Located RdrName }
-	: CONSYM			{ L1 $! mkUnqual tcClsName (getCONSYM $1) }
-
------------------------------------------------------------------------------
--- Operators
-
-op	:: { Located RdrName }   -- used in infix decls
-	: varop			{ $1 }
-	| conop 		{ $1 }
-
-varop	:: { Located RdrName }
-	: varsym		{ $1 }
-	| '`' varid '`'		{ LL (unLoc $2) }
-
-qop	:: { LHsExpr RdrName }   -- used in sections
-	: qvarop		{ L1 $ HsVar (unLoc $1) }
-	| qconop		{ L1 $ HsVar (unLoc $1) }
-
-qopm	:: { LHsExpr RdrName }   -- used in sections
-	: qvaropm		{ L1 $ HsVar (unLoc $1) }
-	| qconop		{ L1 $ HsVar (unLoc $1) }
-
-qvarop :: { Located RdrName }
-	: qvarsym		{ $1 }
-	| '`' qvarid '`'	{ LL (unLoc $2) }
-
-qvaropm :: { Located RdrName }
-	: qvarsym_no_minus	{ $1 }
-	| '`' qvarid '`'	{ LL (unLoc $2) }
-
------------------------------------------------------------------------------
--- Type variables
-
-tyvar   :: { Located RdrName }
-tyvar   : tyvarid		{ $1 }
-	| '(' tyvarsym ')'	{ LL (unLoc $2) }
-
-tyvarop :: { Located RdrName }
-tyvarop : '`' tyvarid '`'	{ LL (unLoc $2) }
-	| tyvarsym		{ $1 }
-
-tyvarid	:: { Located RdrName }
-	: VARID			{ L1 $! mkUnqual tvName (getVARID $1) }
-	| special_id		{ L1 $! mkUnqual tvName (unLoc $1) }
-	| 'unsafe' 		{ L1 $! mkUnqual tvName FSLIT("unsafe") }
-	| 'safe' 		{ L1 $! mkUnqual tvName FSLIT("safe") }
-	| 'threadsafe' 		{ L1 $! mkUnqual tvName FSLIT("threadsafe") }
-
-tyvarsym :: { Located RdrName }
--- Does not include "!", because that is used for strictness marks
---	         or ".", because that separates the quantified type vars from the rest
---		 or "*", because that's used for kinds
-tyvarsym : VARSYM		{ L1 $! mkUnqual tvName (getVARSYM $1) }
-
------------------------------------------------------------------------------
--- Variables 
-
-var 	:: { Located RdrName }
-	: varid			{ $1 }
-	| '(' varsym ')'	{ LL (unLoc $2) }
-
-qvar 	:: { Located RdrName }
-	: qvarid		{ $1 }
-	| '(' varsym ')'	{ LL (unLoc $2) }
-	| '(' qvarsym1 ')'	{ LL (unLoc $2) }
--- We've inlined qvarsym here so that the decision about
--- whether it's a qvar or a var can be postponed until
--- *after* we see the close paren.
-
-qvarid :: { Located RdrName }
-	: varid			{ $1 }
-	| QVARID		{ L1 $ mkQual varName (getQVARID $1) }
-
-varid :: { Located RdrName }
-	: varid_no_unsafe 	{ $1 }
-	| 'unsafe'		{ L1 $! mkUnqual varName FSLIT("unsafe") }
-	| 'safe'		{ L1 $! mkUnqual varName FSLIT("safe") }
-	| 'threadsafe'		{ L1 $! mkUnqual varName FSLIT("threadsafe") }
-
-varid_no_unsafe :: { Located RdrName }
-	: VARID			{ L1 $! mkUnqual varName (getVARID $1) }
-	| special_id		{ L1 $! mkUnqual varName (unLoc $1) }
-	| 'forall'		{ L1 $! mkUnqual varName FSLIT("forall") }
-
-qvarsym :: { Located RdrName }
-	: varsym		{ $1 }
-	| qvarsym1		{ $1 }
-
-qvarsym_no_minus :: { Located RdrName }
-	: varsym_no_minus	{ $1 }
-	| qvarsym1		{ $1 }
-
-qvarsym1 :: { Located RdrName }
-qvarsym1 : QVARSYM		{ L1 $ mkQual varName (getQVARSYM $1) }
-
-varsym :: { Located RdrName }
-	: varsym_no_minus 	{ $1 }
-	| '-'			{ L1 $ mkUnqual varName FSLIT("-") }
-
-varsym_no_minus :: { Located RdrName } -- varsym not including '-'
-	: VARSYM		{ L1 $ mkUnqual varName (getVARSYM $1) }
-	| special_sym		{ L1 $ mkUnqual varName (unLoc $1) }
-
-
--- These special_ids are treated as keywords in various places, 
--- but as ordinary ids elsewhere.   'special_id' collects all these
--- except 'unsafe' and 'forall' whose treatment differs depending on context
-special_id :: { Located FastString }
-special_id
-	: 'as'			{ L1 FSLIT("as") }
-	| 'qualified'		{ L1 FSLIT("qualified") }
-	| 'hiding'		{ L1 FSLIT("hiding") }
-	| 'export'		{ L1 FSLIT("export") }
-	| 'label'		{ L1 FSLIT("label")  }
-	| 'dynamic'		{ L1 FSLIT("dynamic") }
-	| 'stdcall'             { L1 FSLIT("stdcall") }
-	| 'ccall'               { L1 FSLIT("ccall") }
-
-special_sym :: { Located FastString }
-special_sym : '!'	{ L1 FSLIT("!") }
-	    | '.' 	{ L1 FSLIT(".") }
- 	    | '*' 	{ L1 FSLIT("*") }
-
------------------------------------------------------------------------------
--- Data constructors
-
-qconid :: { Located RdrName }	-- Qualified or unqualified
-	: conid			{ $1 }
-	| QCONID		{ L1 $ mkQual dataName (getQCONID $1) }
-
-conid 	:: { Located RdrName }
-	: CONID			{ L1 $ mkUnqual dataName (getCONID $1) }
-
-qconsym :: { Located RdrName }	-- Qualified or unqualified
-	: consym		{ $1 }
-	| QCONSYM		{ L1 $ mkQual dataName (getQCONSYM $1) }
-
-consym :: { Located RdrName }
-	: CONSYM		{ L1 $ mkUnqual dataName (getCONSYM $1) }
-
-	-- ':' means only list cons
-	| ':'			{ L1 $ consDataCon_RDR }
-
-
------------------------------------------------------------------------------
--- Literals
-
-literal :: { Located HsLit }
-	: CHAR 			{ L1 $ HsChar       $ getCHAR $1 }
-	| STRING		{ L1 $ HsString     $ getSTRING $1 }
-	| PRIMINTEGER		{ L1 $ HsIntPrim    $ getPRIMINTEGER $1 }
-	| PRIMCHAR		{ L1 $ HsCharPrim   $ getPRIMCHAR $1 }
-	| PRIMSTRING		{ L1 $ HsStringPrim $ getPRIMSTRING $1 }
-	| PRIMFLOAT		{ L1 $ HsFloatPrim  $ getPRIMFLOAT $1 }
-	| PRIMDOUBLE		{ L1 $ HsDoublePrim $ getPRIMDOUBLE $1 }
-
------------------------------------------------------------------------------
--- Layout
-
-close :: { () }
-	: vccurly		{ () } -- context popped in lexer.
-	| error			{% popContext }
-
------------------------------------------------------------------------------
--- Miscellaneous (mostly renamings)
-
-modid 	:: { Located Module }
-	: CONID			{ L1 $ mkModuleFS (getCONID $1) }
-        | QCONID		{ L1 $ let (mod,c) = getQCONID $1 in
-				  mkModuleFS
-				   (mkFastString
-				     (unpackFS mod ++ '.':unpackFS c))
-				}
-
-commas :: { Int }
-	: commas ','			{ $1 + 1 }
-	| ','				{ 2 }
-
------------------------------------------------------------------------------
-
-{
-happyError :: P a
-happyError = srcParseFail
-
-getVARID   	(L _ (ITvarid    x)) = x
-getCONID   	(L _ (ITconid    x)) = x
-getVARSYM  	(L _ (ITvarsym   x)) = x
-getCONSYM  	(L _ (ITconsym   x)) = x
-getQVARID  	(L _ (ITqvarid   x)) = x
-getQCONID  	(L _ (ITqconid   x)) = x
-getQVARSYM 	(L _ (ITqvarsym  x)) = x
-getQCONSYM 	(L _ (ITqconsym  x)) = x
-getIPDUPVARID   (L _ (ITdupipvarid   x)) = x
-getIPSPLITVARID (L _ (ITsplitipvarid x)) = x
-getCHAR		(L _ (ITchar     x)) = x
-getSTRING	(L _ (ITstring   x)) = x
-getINTEGER	(L _ (ITinteger  x)) = x
-getRATIONAL	(L _ (ITrational x)) = x
-getPRIMCHAR	(L _ (ITprimchar   x)) = x
-getPRIMSTRING	(L _ (ITprimstring x)) = x
-getPRIMINTEGER	(L _ (ITprimint    x)) = x
-getPRIMFLOAT	(L _ (ITprimfloat  x)) = x
-getPRIMDOUBLE	(L _ (ITprimdouble x)) = x
-getTH_ID_SPLICE (L _ (ITidEscape x)) = x
-getINLINE	(L _ (ITinline_prag b)) = b
-getSPEC_INLINE	(L _ (ITspec_inline_prag b)) = b
-
--- Utilities for combining source spans
-comb2 :: Located a -> Located b -> SrcSpan
-comb2 = combineLocs
-
-comb3 :: Located a -> Located b -> Located c -> SrcSpan
-comb3 a b c = combineSrcSpans (getLoc a) (combineSrcSpans (getLoc b) (getLoc c))
-
-comb4 :: Located a -> Located b -> Located c -> Located d -> SrcSpan
-comb4 a b c d = combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
-		combineSrcSpans (getLoc c) (getLoc d)
-
--- strict constructor version:
-{-# INLINE sL #-}
-sL :: SrcSpan -> a -> Located a
-sL span a = span `seq` L span a
-
--- Make a source location for the file.  We're a bit lazy here and just
--- make a point SrcSpan at line 1, column 0.  Strictly speaking we should
--- try to find the span of the whole file (ToDo).
-fileSrcSpan :: P SrcSpan
-fileSrcSpan = do 
-  l <- getSrcLoc; 
-  let loc = mkSrcLoc (srcLocFile l) 1 0;
-  return (mkSrcSpan loc loc)
-}
diff --git a/ghc/compiler/parser/ParserCore.y b/ghc/compiler/parser/ParserCore.y
deleted file mode 100644
index 3210583f96..0000000000
--- a/ghc/compiler/parser/ParserCore.y
+++ /dev/null
@@ -1,339 +0,0 @@
-{
-module ParserCore ( parseCore ) where
-
-import IfaceSyn
-import ForeignCall
-import RdrHsSyn
-import HsSyn
-import RdrName
-import OccName
-import Kind( Kind(..) )
-import Name( nameOccName, nameModule )
-import Module
-import ParserCoreUtils
-import LexCore
-import Literal
-import SrcLoc
-import TysPrim( wordPrimTyCon, intPrimTyCon, charPrimTyCon, 
-		floatPrimTyCon, doublePrimTyCon, addrPrimTyCon )
-import TyCon ( TyCon, tyConName )
-import FastString
-import Outputable
-import Char
-
-#include "../HsVersions.h"
-
-}
-
-%name parseCore
-%tokentype { Token }
-
-%token
- '%module'	{ TKmodule }
- '%data'	{ TKdata }
- '%newtype'	{ TKnewtype }
- '%forall'	{ TKforall }
- '%rec'		{ TKrec }
- '%let'		{ TKlet }
- '%in'		{ TKin }
- '%case'	{ TKcase }
- '%of'		{ TKof }
- '%coerce'	{ TKcoerce }
- '%note'	{ TKnote }
- '%external'	{ TKexternal }
- '%_'		{ TKwild }
- '('		{ TKoparen }
- ')'		{ TKcparen }
- '{'		{ TKobrace }
- '}'		{ TKcbrace }
- '#' 		{ TKhash}
- '='		{ TKeq }
- '::'		{ TKcoloncolon }
- '*'		{ TKstar }
- '->'		{ TKrarrow }
- '\\'		{ TKlambda}
- '@'		{ TKat }
- '.'		{ TKdot }
- '?'		{ TKquestion}
- ';'            { TKsemicolon }
- NAME		{ TKname $$ }
- CNAME 		{ TKcname $$ }
- INTEGER	{ TKinteger $$ }
- RATIONAL	{ TKrational $$ }
- STRING		{ TKstring $$ }
- CHAR		{ TKchar $$ }
-
-%monad { P } { thenP } { returnP }
-%lexer { lexer } { TKEOF }
-
-%%
-
-module	:: { HsExtCore RdrName }
-         : '%module' modid tdefs vdefgs { HsExtCore $2 $3 $4 }
-
-modid	:: { Module }
-	: CNAME	                 { mkModuleFS (mkFastString $1) }
-
--------------------------------------------------------------
---     Type and newtype declarations are in HsSyn syntax
-
-tdefs	:: { [TyClDecl RdrName] }
-	: {- empty -}	{[]}
-	| tdef ';' tdefs	{$1:$3}
-
-tdef	:: { TyClDecl RdrName }
-	: '%data' q_tc_name tv_bndrs '=' '{' cons1 '}'
-                { mkTyData DataType (noLoc [], noLoc (ifaceExtRdrName $2), map toHsTvBndr $3) Nothing $6 Nothing }
-	| '%newtype' q_tc_name tv_bndrs trep 
-		{ let tc_rdr = ifaceExtRdrName $2 in
-                  mkTyData NewType (noLoc [], noLoc tc_rdr, map toHsTvBndr $3) Nothing ($4 (rdrNameOcc tc_rdr)) Nothing }
-
--- For a newtype we have to invent a fake data constructor name
--- It doesn't matter what it is, because it won't be used
-trep    :: { OccName -> [LConDecl RdrName] }
-        : {- empty -}   { (\ tc_occ -> []) }
-        | '=' ty        { (\ tc_occ -> let { dc_name  = mkRdrUnqual (setOccNameSpace dataName tc_occ) ;
-			                     con_info = PrefixCon [toHsType $2] }
-			                in [noLoc $ ConDecl (noLoc dc_name) Explicit []
-					   (noLoc []) con_info ResTyH98]) }
-
-cons1	:: { [LConDecl RdrName] }
-	: con		{ [$1] }
-	| con ';' cons1	{ $1:$3 }
-
-con	:: { LConDecl RdrName }
-	: d_pat_occ attv_bndrs hs_atys 
-		{ noLoc $ ConDecl (noLoc (mkRdrUnqual $1)) Explicit $2 (noLoc []) (PrefixCon $3) ResTyH98}
-        | d_pat_occ '::' ty
-                -- XXX - autrijus - $3 needs to be split into argument and return types!
-                -- also not sure whether the [] below (quantified vars) appears.
-                -- also the "PrefixCon []" is wrong.
-                -- also we want to munge $3 somehow.
-                -- extractWhatEver to unpack ty into the parts to ConDecl
-                -- XXX - define it somewhere in RdrHsSyn
-		{ noLoc $ ConDecl (noLoc (mkRdrUnqual $1)) Explicit [] (noLoc []) (PrefixCon []) (undefined $3) }
-
-attv_bndrs :: { [LHsTyVarBndr RdrName] }
-	: {- empty -} 	         { [] }
-	| '@' tv_bndr attv_bndrs {  toHsTvBndr $2 : $3 }
-
-hs_atys :: { [LHsType RdrName] }
-         : atys               { map toHsType $1 }
-
-
----------------------------------------
---                 Types
----------------------------------------
-
-atys	:: { [IfaceType] }
-	: {- empty -}   { [] }
-	| aty atys      { $1:$2 }
-
-aty	:: { IfaceType }
-	: tv_occ    { IfaceTyVar $1 }
-	| q_tc_name  { IfaceTyConApp (IfaceTc $1) [] }
-	| '(' ty ')' { $2 }
-
-bty	:: { IfaceType }
-	: tv_occ atys    { foldl IfaceAppTy (IfaceTyVar $1) $2 }
-        | q_tc_name atys  { IfaceTyConApp (IfaceTc $1) $2 }
-        | '(' ty ')' { $2 }
-
-ty	:: { IfaceType }
-	: bty	                     { $1 }
-	| bty '->' ty                { IfaceFunTy $1 $3 }
-	| '%forall' tv_bndrs '.' ty  { foldr IfaceForAllTy $4 $2 }
-
-----------------------------------------------
---        Bindings are in Iface syntax
-
-vdefgs	:: { [IfaceBinding] }
-	: {- empty -}	        { [] }
-	| let_bind ';' vdefgs	{ $1 : $3 }
-
-let_bind :: { IfaceBinding }
-	: '%rec' '{' vdefs1 '}' { IfaceRec $3 }
-	|  vdef                 { let (b,r) = $1
-				  in IfaceNonRec b r }
-
-vdefs1	:: { [(IfaceIdBndr, IfaceExpr)] }
-	: vdef		        { [$1] }
-	| vdef ';' vdefs1       { $1:$3 }
-
-vdef	:: { (IfaceIdBndr, IfaceExpr) }
-	: qd_occ '::' ty '=' exp { (($1, $3), $5) }
-  -- NB: qd_occ includes data constructors, because
-  --     we allow data-constructor wrappers at top level
-  -- But we discard the module name, because it must be the
-  -- same as the module being compiled, and Iface syntax only
-  -- has OccNames in binding positions
-
-qd_occ :: { OccName }
-        : var_occ { $1 }
-        | d_occ   { $1 }
-
----------------------------------------
---  Binders
-bndr	:: { IfaceBndr }
-        : '@' tv_bndr 	{ IfaceTvBndr $2 }
-	| id_bndr	{ IfaceIdBndr $1 }
-
-bndrs 	:: { [IfaceBndr] }
-	: bndr		{ [$1] }
-	| bndr bndrs	{ $1:$2 }
-
-id_bndr	:: { IfaceIdBndr }
-	: '(' var_occ '::' ty ')'	{ ($2,$4) }
-
-id_bndrs :: { [IfaceIdBndr] }
-	: {-empty -}    	{ [] }
-	| id_bndr id_bndrs	{ $1:$2 }
-
-tv_bndr	:: { IfaceTvBndr }
-	:  tv_occ                    { ($1, LiftedTypeKind) }
-	|  '(' tv_occ '::' akind ')' { ($2, $4) }
-
-tv_bndrs 	:: { [IfaceTvBndr] }
-	: {- empty -}	{ [] }
-	| tv_bndr tv_bndrs	{ $1:$2 }
-
-akind	:: { IfaceKind }
-	: '*' 		   { LiftedTypeKind   }	
-	| '#'		   { UnliftedTypeKind }
-	| '?'		   { OpenTypeKind     }
-        | '(' kind ')'	   { $2 }
-
-kind 	:: { IfaceKind }
-	: akind 	   { $1 }
-	| akind '->' kind  { FunKind $1 $3 }
-
------------------------------------------
---             Expressions
-
-aexp    :: { IfaceExpr }
-	: var_occ	         { IfaceLcl $1 }
-	| modid '.' qd_occ	 { IfaceExt (ExtPkg $1 $3) }
-	| lit		{ IfaceLit $1 }
-	| '(' exp ')' 	{ $2 }
-
-fexp	:: { IfaceExpr }
-	: fexp aexp	{ IfaceApp $1 $2 }
-	| fexp '@' aty	{ IfaceApp $1 (IfaceType $3) }
-	| aexp		{ $1 }
-
-exp	:: { IfaceExpr }
-	: fexp		              { $1 }
-	| '\\' bndrs '->' exp 	      { foldr IfaceLam $4 $2 }
-	| '%let' let_bind '%in' exp   { IfaceLet $2 $4 }
--- gaw 2004
-	| '%case' '(' ty ')' aexp '%of' id_bndr
-	  '{' alts1 '}'		      { IfaceCase $5 (fst $7) $3 $9 }
-	| '%coerce' aty exp   	      { IfaceNote (IfaceCoerce $2) $3 }
-	| '%note' STRING exp 	   
-	    { case $2 of
-	       --"SCC"      -> IfaceNote (IfaceSCC "scc") $3
-	       "InlineCall" -> IfaceNote IfaceInlineCall $3
-	       "InlineMe"   -> IfaceNote IfaceInlineMe $3
-            }
-        | '%external' STRING aty   { IfaceFCall (ForeignCall.CCall 
-                                                    (CCallSpec (StaticTarget (mkFastString $2)) 
-                                                               CCallConv (PlaySafe False))) 
-                                                 $3 }
-
-alts1	:: { [IfaceAlt] }
-	: alt		{ [$1] }
-	| alt ';' alts1	{ $1:$3 }
-
-alt	:: { IfaceAlt }
-	: modid '.' d_pat_occ bndrs '->' exp 
-		{ (IfaceDataAlt $3, map ifaceBndrName $4, $6) } 
-                       -- The external syntax currently includes the types of the
-		       -- the args, but they aren't needed internally
-                       -- Nor is the module qualifier
-	| lit '->' exp
-		{ (IfaceLitAlt $1, [], $3) }
-	| '%_' '->' exp
-		{ (IfaceDefault, [], $3) }
-
-lit	:: { Literal }
-	: '(' INTEGER '::' aty ')'	{ convIntLit $2 $4 }
-	| '(' RATIONAL '::' aty ')'	{ convRatLit $2 $4 }
-	| '(' CHAR '::' aty ')'		{ MachChar $2 }
-	| '(' STRING '::' aty ')'	{ MachStr (mkFastString $2) }
-
-tv_occ	:: { OccName }
-	: NAME	{ mkOccName tvName $1 }
-
-var_occ	:: { OccName }
-	: NAME	{ mkVarOcc $1 }
-
-
--- Type constructor
-q_tc_name	:: { IfaceExtName }
-        : modid '.' CNAME	{ ExtPkg $1 (mkOccName tcName $3) }
-
--- Data constructor in a pattern or data type declaration; use the dataName, 
--- because that's what we expect in Core case patterns
-d_pat_occ :: { OccName }
-        : CNAME      { mkOccName dataName $1 }
-
--- Data constructor occurrence in an expression;
--- use the varName because that's the worker Id
-d_occ :: { OccName }
-       : CNAME { mkVarOcc $1 }
-
-{
-
-ifaceBndrName (IfaceIdBndr (n,_)) = n
-ifaceBndrName (IfaceTvBndr (n,_)) = n
-
-convIntLit :: Integer -> IfaceType -> Literal
-convIntLit i (IfaceTyConApp tc [])
-  | tc `eqTc` intPrimTyCon  = MachInt  i  
-  | tc `eqTc` wordPrimTyCon = MachWord i
-  | tc `eqTc` charPrimTyCon = MachChar (chr (fromInteger i))
-  | tc `eqTc` addrPrimTyCon && i == 0 = MachNullAddr
-convIntLit i aty
-  = pprPanic "Unknown integer literal type" (ppr aty)
-
-convRatLit :: Rational -> IfaceType -> Literal
-convRatLit r (IfaceTyConApp tc [])
-  | tc `eqTc` floatPrimTyCon  = MachFloat  r
-  | tc `eqTc` doublePrimTyCon = MachDouble r
-convRatLit i aty
-  = pprPanic "Unknown rational literal type" (ppr aty)
-
-eqTc :: IfaceTyCon -> TyCon -> Bool   -- Ugh!
-eqTc (IfaceTc (ExtPkg mod occ)) tycon
-  = mod == nameModule nm && occ == nameOccName nm
-  where
-    nm = tyConName tycon
-
--- Tiresomely, we have to generate both HsTypes (in type/class decls) 
--- and IfaceTypes (in Core expressions).  So we parse them as IfaceTypes,
--- and convert to HsTypes here.  But the IfaceTypes we can see here
--- are very limited (see the productions for 'ty', so the translation
--- isn't hard
-toHsType :: IfaceType -> LHsType RdrName
-toHsType (IfaceTyVar v)        		 = noLoc $ HsTyVar (mkRdrUnqual v)
-toHsType (IfaceAppTy t1 t2)    		 = noLoc $ HsAppTy (toHsType t1) (toHsType t2)
-toHsType (IfaceFunTy t1 t2)    		 = noLoc $ HsFunTy (toHsType t1) (toHsType t2)
-toHsType (IfaceTyConApp (IfaceTc tc) ts) = foldl mkHsAppTy (noLoc $ HsTyVar (ifaceExtRdrName tc)) (map toHsType ts) 
-toHsType (IfaceForAllTy tv t)            = add_forall (toHsTvBndr tv) (toHsType t)
-
-toHsTvBndr :: IfaceTvBndr -> LHsTyVarBndr RdrName
-toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual tv) k
-
-ifaceExtRdrName :: IfaceExtName -> RdrName
-ifaceExtRdrName (ExtPkg mod occ) = mkOrig mod occ
-ifaceExtRdrName other = pprPanic "ParserCore.ifaceExtRdrName" (ppr other)
-
-add_forall tv (L _ (HsForAllTy exp tvs cxt t))
-  = noLoc $ HsForAllTy exp (tv:tvs) cxt t
-add_forall tv t
-  = noLoc $ HsForAllTy Explicit [tv] (noLoc []) t
-  
-happyError :: P a 
-happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l
-}
-
diff --git a/ghc/compiler/parser/ParserCoreUtils.hs b/ghc/compiler/parser/ParserCoreUtils.hs
deleted file mode 100644
index a590fb5c93..0000000000
--- a/ghc/compiler/parser/ParserCoreUtils.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-module ParserCoreUtils where
-
-import IO 
-
-data ParseResult a = OkP a | FailP String
-type P a = String -> Int -> ParseResult a
-
-thenP :: P a -> (a -> P b) -> P b
-m `thenP`  k = \ s l -> 
-  case m s l of 
-    OkP a -> k a s l
-    FailP s -> FailP s
-
-returnP :: a -> P a
-returnP m _ _ = OkP m
-
-failP :: String -> P a
-failP s s' _ = FailP (s ++ ":" ++ s')
-
-getCoreModuleName :: FilePath -> IO String
-getCoreModuleName fpath = 
-   catch (do 
-     h  <- openFile fpath ReadMode
-     ls <- hGetContents h
-     let mo = findMod (words ls)
-      -- make sure we close up the file right away.
-     (length mo) `seq` return ()
-     hClose h
-     return mo)
-    (\ _ -> return "Main")
- where
-   findMod [] = "Main"
-   findMod ("%module":m:_) = m
-   findMod (_:xs) = findMod xs
-
-
-data Token =
-   TKmodule
- | TKdata
- | TKnewtype
- | TKforall
- | TKrec
- | TKlet
- | TKin
- | TKcase
- | TKof
- | TKcoerce
- | TKnote
- | TKexternal
- | TKwild
- | TKoparen
- | TKcparen
- | TKobrace
- | TKcbrace
- | TKhash
- | TKeq
- | TKcoloncolon
- | TKstar
- | TKrarrow
- | TKlambda
- | TKat
- | TKdot
- | TKquestion
- | TKsemicolon
- | TKname String
- | TKcname String
- | TKinteger Integer
- | TKrational Rational
- | TKstring String
- | TKchar Char
- | TKEOF
-
diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
deleted file mode 100644
index 8d59e2b22c..0000000000
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ /dev/null
@@ -1,869 +0,0 @@
-%
-% (c) The University of Glasgow, 1996-2003
-
-Functions over HsSyn specialised to RdrName.
-
-\begin{code}
-module RdrHsSyn (
-	extractHsTyRdrTyVars, 
-	extractHsRhoRdrTyVars, extractGenericPatTyVars,
- 
-	mkHsOpApp, mkClassDecl, 
-	mkHsNegApp, mkHsIntegral, mkHsFractional,
-	mkHsDo, mkHsSplice,
-        mkTyData, mkPrefixCon, mkRecCon, mkInlineSpec,	
-	mkRecConstrOrUpdate, -- HsExp -> [HsFieldUpdate] -> P HsExp
-
-	cvBindGroup,
-	cvBindsAndSigs,
-	cvTopDecls,
-	findSplice, mkGroup,
-
-	-- Stuff to do with Foreign declarations
-	CallConv(..),
-	mkImport,            -- CallConv -> Safety 
-			      -- -> (FastString, RdrName, RdrNameHsType)
-			      -- -> P RdrNameHsDecl
-	mkExport,            -- CallConv
-			      -- -> (FastString, RdrName, RdrNameHsType)
-			      -- -> P RdrNameHsDecl
-	mkExtName,           -- RdrName -> CLabelString
-	mkGadtDecl,          -- Located RdrName -> LHsType RdrName -> ConDecl RdrName
-			      
-	-- Bunch of functions in the parser monad for 
-	-- checking and constructing values
-	checkPrecP, 	      -- Int -> P Int
-	checkContext,	      -- HsType -> P HsContext
-	checkPred,	      -- HsType -> P HsPred
-	checkTyClHdr,         -- LHsContext RdrName -> LHsType RdrName -> P (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName])
-	checkSynHdr,	      -- LHsType RdrName -> P (Located RdrName, [LHsTyVarBndr RdrName])
-	checkInstType,	      -- HsType -> P HsType
-	checkPattern,	      -- HsExp -> P HsPat
-	checkPatterns,	      -- SrcLoc -> [HsExp] -> P [HsPat]
-	checkDo,	      -- [Stmt] -> P [Stmt]
-	checkMDo,	      -- [Stmt] -> P [Stmt]
-	checkValDef,	      -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
-	checkValSig,	      -- (SrcLoc, HsExp, HsRhs, [HsDecl]) -> P HsDecl
-	parseError,	      -- String -> Pa
-    ) where
-
-#include "HsVersions.h"
-
-import HsSyn		-- Lots of it
-import RdrName		( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc, 
-			  isRdrDataCon, isUnqual, getRdrName, isQual,
-			  setRdrNameSpace )
-import BasicTypes	( maxPrecedence, Activation, InlineSpec(..), alwaysInlineSpec, neverInlineSpec )
-import Lexer		( P, failSpanMsgP, extension, bangPatEnabled )
-import TysWiredIn	( unitTyCon ) 
-import ForeignCall	( CCallConv, Safety, CCallTarget(..), CExportSpec(..),
-			  DNCallSpec(..), DNKind(..), CLabelString )
-import OccName  	( srcDataName, varName, isDataOcc, isTcOcc, 
-			  occNameString )
-import SrcLoc
-import OrdList		( OrdList, fromOL )
-import Bag		( Bag, emptyBag, snocBag, consBag, foldrBag )
-import Outputable
-import FastString
-import Panic
-
-import List		( isSuffixOf, nubBy )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{A few functions over HsSyn at RdrName}
-%*                                                                    *
-%************************************************************************
-
-extractHsTyRdrNames finds the free variables of a HsType
-It's used when making the for-alls explicit.
-
-\begin{code}
-extractHsTyRdrTyVars :: LHsType RdrName -> [Located RdrName]
-extractHsTyRdrTyVars ty = nubBy eqLocated (extract_lty ty [])
-
-extractHsRhoRdrTyVars :: LHsContext RdrName -> LHsType RdrName -> [Located RdrName]
--- This one takes the context and tau-part of a 
--- sigma type and returns their free type variables
-extractHsRhoRdrTyVars ctxt ty 
- = nubBy eqLocated $ extract_lctxt ctxt (extract_lty ty [])
-
-extract_lctxt ctxt acc = foldr (extract_pred . unLoc) acc (unLoc ctxt)
-
-extract_pred (HsClassP cls tys) acc	= foldr extract_lty acc tys
-extract_pred (HsIParam n ty) acc	= extract_lty ty acc
-
-extract_lty (L loc ty) acc 
-  = case ty of
-      HsTyVar tv 	        -> extract_tv loc tv acc
-      HsBangTy _ ty            	-> extract_lty ty acc
-      HsAppTy ty1 ty2          	-> extract_lty ty1 (extract_lty ty2 acc)
-      HsListTy ty              	-> extract_lty ty acc
-      HsPArrTy ty              	-> extract_lty ty acc
-      HsTupleTy _ tys          	-> foldr extract_lty acc tys
-      HsFunTy ty1 ty2          	-> extract_lty ty1 (extract_lty ty2 acc)
-      HsPredTy p		-> extract_pred p acc
-      HsOpTy ty1 (L loc tv) ty2 -> extract_tv loc tv (extract_lty ty1 (extract_lty ty2 acc))
-      HsParTy ty               	-> extract_lty ty acc
-      HsNumTy num              	-> acc
-      HsSpliceTy _             	-> acc	-- Type splices mention no type variables
-      HsKindSig ty k	        -> extract_lty ty acc
-      HsForAllTy exp [] cx ty   -> extract_lctxt cx (extract_lty ty acc)
-      HsForAllTy exp tvs cx ty  -> acc ++ (filter ((`notElem` locals) . unLoc) $
-					   extract_lctxt cx (extract_lty ty []))
-				where
-				   locals = hsLTyVarNames tvs
-
-extract_tv :: SrcSpan -> RdrName -> [Located RdrName] -> [Located RdrName]
-extract_tv loc tv acc | isRdrTyVar tv = L loc tv : acc
-		      | otherwise     = acc
-
-extractGenericPatTyVars :: LHsBinds RdrName -> [Located RdrName]
--- Get the type variables out of the type patterns in a bunch of
--- possibly-generic bindings in a class declaration
-extractGenericPatTyVars binds
-  = nubBy eqLocated (foldrBag get [] binds)
-  where
-    get (L _ (FunBind { fun_matches = MatchGroup ms _ })) acc = foldr (get_m.unLoc) acc ms
-    get other	 	   			          acc = acc
-
-    get_m (Match (L _ (TypePat ty) : _) _ _) acc = extract_lty ty acc
-    get_m other			       		   acc = acc
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Construction functions for Rdr stuff}
-%*                                                                    *
-%************************************************************************
-
-mkClassDecl builds a RdrClassDecl, filling in the names for tycon and datacon
-by deriving them from the name of the class.  We fill in the names for the
-tycon and datacon corresponding to the class, by deriving them from the
-name of the class itself.  This saves recording the names in the interface
-file (which would be equally good).
-
-Similarly for mkConDecl, mkClassOpSig and default-method names.
-
-	*** See "THE NAMING STORY" in HsDecls ****
-  
-\begin{code}
-mkClassDecl (cxt, cname, tyvars) fds sigs mbinds
-  = ClassDecl { tcdCtxt = cxt, tcdLName = cname, tcdTyVars = tyvars,
-		tcdFDs = fds,  
-		tcdSigs = sigs,
-		tcdMeths = mbinds
-		}
-
-mkTyData new_or_data (context, tname, tyvars) ksig data_cons maybe_deriv
-  = TyData { tcdND = new_or_data, tcdCtxt = context, tcdLName = tname,
-	     tcdTyVars = tyvars,  tcdCons = data_cons, 
-	     tcdKindSig = ksig, tcdDerivs = maybe_deriv }
-\end{code}
-
-\begin{code}
-mkHsNegApp :: LHsExpr RdrName -> HsExpr RdrName
--- RdrName If the type checker sees (negate 3#) it will barf, because negate
--- can't take an unboxed arg.  But that is exactly what it will see when
--- we write "-3#".  So we have to do the negation right now!
-mkHsNegApp (L loc e) = f e
-  where f (HsLit (HsIntPrim i))    = HsLit (HsIntPrim (-i))    
-	f (HsLit (HsFloatPrim i))  = HsLit (HsFloatPrim (-i))  
-	f (HsLit (HsDoublePrim i)) = HsLit (HsDoublePrim (-i)) 
-	f expr	    		   = NegApp (L loc e) noSyntaxExpr
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[cvBinds-etc]{Converting to @HsBinds@, etc.}
-%*									*
-%************************************************************************
-
-Function definitions are restructured here. Each is assumed to be recursive
-initially, and non recursive definitions are discovered by the dependency
-analyser.
-
-
-\begin{code}
---  | Groups together bindings for a single function
-cvTopDecls :: OrdList (LHsDecl RdrName) -> [LHsDecl RdrName]
-cvTopDecls decls = go (fromOL decls)
-  where
-    go :: [LHsDecl RdrName] -> [LHsDecl RdrName]
-    go [] 		    = []
-    go (L l (ValD b) : ds)  = L l' (ValD b') : go ds'
-			    where (L l' b', ds') = getMonoBind (L l b) ds
-    go (d : ds)   	    = d : go ds
-
-cvBindGroup :: OrdList (LHsDecl RdrName) -> HsValBinds RdrName
-cvBindGroup binding
-  = case (cvBindsAndSigs binding) of { (mbs, sigs) ->
-    ValBindsIn mbs sigs
-    }
-
-cvBindsAndSigs :: OrdList (LHsDecl RdrName)
-  -> (Bag (LHsBind RdrName), [LSig RdrName])
--- Input decls contain just value bindings and signatures
-cvBindsAndSigs  fb = go (fromOL fb)
-  where
-    go [] 		   = (emptyBag, [])
-    go (L l (SigD s) : ds) = (bs, L l s : ss)
-			    where (bs,ss) = go ds
-    go (L l (ValD b) : ds) = (b' `consBag` bs, ss)
-			    where (b',ds') = getMonoBind (L l b) ds
-				  (bs,ss)  = go ds'
-
------------------------------------------------------------------------------
--- Group function bindings into equation groups
-
-getMonoBind :: LHsBind RdrName -> [LHsDecl RdrName]
-  -> (LHsBind RdrName, [LHsDecl RdrName])
--- Suppose 	(b',ds') = getMonoBind b ds
--- 	ds is a *reversed* list of parsed bindings
---	b is a MonoBinds that has just been read off the front
-
--- Then b' is the result of grouping more equations from ds that
--- belong with b into a single MonoBinds, and ds' is the depleted
--- list of parsed bindings.
---
--- No AndMonoBinds or EmptyMonoBinds here; just single equations
-
-getMonoBind (L loc bind@(FunBind { fun_id = L _ f, fun_matches = MatchGroup mtchs _ })) binds
-  | has_args mtchs
-  = go mtchs loc binds
-  where
-    go mtchs1 loc1 (L loc2 (ValD (FunBind { fun_id = L _ f2, fun_matches = MatchGroup mtchs2 _ })) : binds)
-	| f == f2 = go (mtchs2++mtchs1) loc binds
-	where loc = combineSrcSpans loc1 loc2
-    go mtchs1 loc binds
-	= (L loc (bind { fun_matches = mkMatchGroup (reverse mtchs1) }), binds)
-	-- Reverse the final matches, to get it back in the right order
-
-getMonoBind bind binds = (bind, binds)
-
-has_args ((L _ (Match args _ _)) : _) = not (null args)
-	-- Don't group together FunBinds if they have
-	-- no arguments.  This is necessary now that variable bindings
-	-- with no arguments are now treated as FunBinds rather
-	-- than pattern bindings (tests/rename/should_fail/rnfail002).
-\end{code}
-
-\begin{code}
-findSplice :: [LHsDecl a] -> (HsGroup a, Maybe (SpliceDecl a, [LHsDecl a]))
-findSplice ds = addl emptyRdrGroup ds
-
-mkGroup :: [LHsDecl a] -> HsGroup a
-mkGroup ds = addImpDecls emptyRdrGroup ds
-
-addImpDecls :: HsGroup a -> [LHsDecl a] -> HsGroup a
--- The decls are imported, and should not have a splice
-addImpDecls group decls = case addl group decls of
-				(group', Nothing) -> group'
-				other		  -> panic "addImpDecls"
-
-addl :: HsGroup a -> [LHsDecl a] -> (HsGroup a, Maybe (SpliceDecl a, [LHsDecl a]))
-	-- This stuff reverses the declarations (again) but it doesn't matter
-
--- Base cases
-addl gp []	     = (gp, Nothing)
-addl gp (L l d : ds) = add gp l d ds
-
-
-add :: HsGroup a -> SrcSpan -> HsDecl a -> [LHsDecl a]
-  -> (HsGroup a, Maybe (SpliceDecl a, [LHsDecl a]))
-
-add gp l (SpliceD e) ds = (gp, Just (e, ds))
-
--- Class declarations: pull out the fixity signatures to the top
-add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs}) l (TyClD d) ds
-	| isClassDecl d = 	
-		let fsigs = [ L l f | L l (FixSig f) <- tcdSigs d ] in
-		addl (gp { hs_tyclds = L l d : ts, hs_fixds  = fsigs ++ fs }) ds
-	| otherwise =
-		addl (gp { hs_tyclds = L l d : ts }) ds
-
--- Signatures: fixity sigs go a different place than all others
-add gp@(HsGroup {hs_fixds = ts}) l (SigD (FixSig f)) ds
-  = addl (gp {hs_fixds = L l f : ts}) ds
-add gp@(HsGroup {hs_valds = ts}) l (SigD d) ds
-  = addl (gp {hs_valds = add_sig (L l d) ts}) ds
-
--- Value declarations: use add_bind
-add gp@(HsGroup {hs_valds  = ts}) l (ValD d) ds
-  = addl (gp { hs_valds = add_bind (L l d) ts }) ds
-
--- The rest are routine
-add gp@(HsGroup {hs_instds = ts})  l (InstD d) ds
-  = addl (gp { hs_instds = L l d : ts }) ds
-add gp@(HsGroup {hs_defds  = ts})  l (DefD d) ds
-  = addl (gp { hs_defds = L l d : ts }) ds
-add gp@(HsGroup {hs_fords  = ts})  l (ForD d) ds
-  = addl (gp { hs_fords = L l d : ts }) ds
-add gp@(HsGroup {hs_depds  = ts})  l (DeprecD d) ds
-  = addl (gp { hs_depds = L l d : ts }) ds
-add gp@(HsGroup {hs_ruleds  = ts}) l (RuleD d) ds
-  = addl (gp { hs_ruleds = L l d : ts }) ds
-
-add_bind b (ValBindsIn bs sigs) = ValBindsIn (bs `snocBag` b) sigs
-add_sig  s (ValBindsIn bs sigs) = ValBindsIn bs	              (s:sigs) 
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[PrefixToHS-utils]{Utilities for conversion}
-%*									*
-%************************************************************************
-
-
-\begin{code}
------------------------------------------------------------------------------
--- mkPrefixCon
-
--- When parsing data declarations, we sometimes inadvertently parse
--- a constructor application as a type (eg. in data T a b = C a b `D` E a b)
--- This function splits up the type application, adds any pending
--- arguments, and converts the type constructor back into a data constructor.
-
-mkPrefixCon :: LHsType RdrName -> [LBangType RdrName]
-  -> P (Located RdrName, HsConDetails RdrName (LBangType RdrName))
-mkPrefixCon ty tys
- = split ty tys
- where
-   split (L _ (HsAppTy t u)) ts = split t (u : ts)
-   split (L l (HsTyVar tc))  ts = do data_con <- tyConToDataCon l tc
-				     return (data_con, PrefixCon ts)
-   split (L l _) _ 		= parseError l "parse error in data/newtype declaration"
-
-mkRecCon :: Located RdrName -> [([Located RdrName], LBangType RdrName)]
-  -> P (Located RdrName, HsConDetails RdrName (LBangType RdrName))
-mkRecCon (L loc con) fields
-  = do data_con <- tyConToDataCon loc con
-       return (data_con, RecCon [ (l,t) | (ls,t) <- fields, l <- ls ])
-
-tyConToDataCon :: SrcSpan -> RdrName -> P (Located RdrName)
-tyConToDataCon loc tc
-  | isTcOcc (rdrNameOcc tc)
-  = return (L loc (setRdrNameSpace tc srcDataName))
-  | otherwise
-  = parseError loc (showSDoc (text "Not a constructor:" <+> quotes (ppr tc)))
-
-----------------------------------------------------------------------------
--- Various Syntactic Checks
-
-checkInstType :: LHsType RdrName -> P (LHsType RdrName)
-checkInstType (L l t)
-  = case t of
-	HsForAllTy exp tvs ctxt ty -> do
-		dict_ty <- checkDictTy ty
-	      	return (L l (HsForAllTy exp tvs ctxt dict_ty))
-
-        HsParTy ty -> checkInstType ty
-
-	ty ->   do dict_ty <- checkDictTy (L l ty)
-	      	   return (L l (HsForAllTy Implicit [] (noLoc []) dict_ty))
-
-checkTyVars :: [LHsType RdrName] -> P [LHsTyVarBndr RdrName]
-checkTyVars tvs 
-  = mapM chk tvs
-  where
-	--  Check that the name space is correct!
-    chk (L l (HsKindSig (L _ (HsTyVar tv)) k))
-	| isRdrTyVar tv = return (L l (KindedTyVar tv k))
-    chk (L l (HsTyVar tv))
-        | isRdrTyVar tv = return (L l (UserTyVar tv))
-    chk (L l other)
-	= parseError l "Type found where type variable expected"
-
-checkSynHdr :: LHsType RdrName -> P (Located RdrName, [LHsTyVarBndr RdrName])
-checkSynHdr ty = do { (_, tc, tvs) <- checkTyClHdr (noLoc []) ty
-		    ; return (tc, tvs) }
-
-checkTyClHdr :: LHsContext RdrName -> LHsType RdrName
-  -> P (LHsContext RdrName, Located RdrName, [LHsTyVarBndr RdrName])
--- The header of a type or class decl should look like
---	(C a, D b) => T a b
--- or	T a b
--- or	a + b
--- etc
-checkTyClHdr (L l cxt) ty
-  = do (tc, tvs) <- gol ty []
-       mapM_ chk_pred cxt
-       return (L l cxt, tc, tvs)
-  where
-    gol (L l ty) acc = go l ty acc
-
-    go l (HsTyVar tc)    acc 
-	| not (isRdrTyVar tc)   = checkTyVars acc		>>= \ tvs ->
-				  return (L l tc, tvs)
-    go l (HsOpTy t1 tc t2) acc  = checkTyVars (t1:t2:acc)	>>= \ tvs ->
-				  return (tc, tvs)
-    go l (HsParTy ty)    acc    = gol ty acc
-    go l (HsAppTy t1 t2) acc    = gol t1 (t2:acc)
-    go l other	         acc    = parseError l "Malformed LHS to type of class declaration"
-
-	-- The predicates in a type or class decl must all
-	-- be HsClassPs.  They need not all be type variables,
-	-- even in Haskell 98.  E.g. class (Monad m, Monad (t m)) => MonadT t m
-    chk_pred (L l (HsClassP _ args)) = return ()
-    chk_pred (L l _)
-       = parseError l "Malformed context in type or class declaration"
-
-  
-checkContext :: LHsType RdrName -> P (LHsContext RdrName)
-checkContext (L l t)
-  = check t
- where
-  check (HsTupleTy _ ts) 	-- (Eq a, Ord b) shows up as a tuple type
-    = do ctx <- mapM checkPred ts
-	 return (L l ctx)
-
-  check (HsParTy ty)	-- to be sure HsParTy doesn't get into the way
-    = check (unLoc ty)
-
-  check (HsTyVar t)	-- Empty context shows up as a unit type ()
-    | t == getRdrName unitTyCon = return (L l [])
-
-  check t 
-    = do p <- checkPred (L l t)
-         return (L l [p])
-
-
-checkPred :: LHsType RdrName -> P (LHsPred RdrName)
--- Watch out.. in ...deriving( Show )... we use checkPred on 
--- the list of partially applied predicates in the deriving,
--- so there can be zero args.
-checkPred (L spn (HsPredTy (HsIParam n ty)))
-  = return (L spn (HsIParam n ty))
-checkPred (L spn ty)
-  = check spn ty []
-  where
-    checkl (L l ty) args = check l ty args
-
-    check _loc (HsTyVar t)             args | not (isRdrTyVar t) 
-		 		  	    = return (L spn (HsClassP t args))
-    check _loc (HsAppTy l r)           args = checkl l (r:args)
-    check _loc (HsOpTy l (L loc tc) r) args = check loc (HsTyVar tc) (l:r:args)
-    check _loc (HsParTy t)  	       args = checkl t args
-    check loc _                        _    = parseError loc  "malformed class assertion"
-
-checkDictTy :: LHsType RdrName -> P (LHsType RdrName)
-checkDictTy (L spn ty) = check ty []
-  where
-  check (HsTyVar t) args | not (isRdrTyVar t) 
-  	= return (L spn (HsPredTy (HsClassP t args)))
-  check (HsAppTy l r) args = check (unLoc l) (r:args)
-  check (HsParTy t)   args = check (unLoc t) args
-  check _ _ = parseError spn "Malformed context in instance header"
-
----------------------------------------------------------------------------
--- Checking statements in a do-expression
--- 	We parse   do { e1 ; e2 ; }
--- 	as [ExprStmt e1, ExprStmt e2]
--- checkDo (a) checks that the last thing is an ExprStmt
---	   (b) returns it separately
--- same comments apply for mdo as well
-
-checkDo	 = checkDoMDo "a " "'do'"
-checkMDo = checkDoMDo "an " "'mdo'"
-
-checkDoMDo :: String -> String -> SrcSpan -> [LStmt RdrName] -> P ([LStmt RdrName], LHsExpr RdrName)
-checkDoMDo pre nm loc []   = parseError loc ("Empty " ++ nm ++ " construct")
-checkDoMDo pre nm loc ss   = do 
-  check ss
-  where 
-	check  [L l (ExprStmt e _ _)] = return ([], e)
-	check  [L l _] = parseError l ("The last statement in " ++ pre ++ nm ++
-					 " construct must be an expression")
-	check (s:ss) = do
-	  (ss',e') <-  check ss
-	  return ((s:ss'),e')
-
--- -------------------------------------------------------------------------
--- Checking Patterns.
-
--- We parse patterns as expressions and check for valid patterns below,
--- converting the expression into a pattern at the same time.
-
-checkPattern :: LHsExpr RdrName -> P (LPat RdrName)
-checkPattern e = checkLPat e
-
-checkPatterns :: [LHsExpr RdrName] -> P [LPat RdrName]
-checkPatterns es = mapM checkPattern es
-
-checkLPat :: LHsExpr RdrName -> P (LPat RdrName)
-checkLPat e@(L l _) = checkPat l e []
-
-checkPat :: SrcSpan -> LHsExpr RdrName -> [LPat RdrName] -> P (LPat RdrName)
-checkPat loc (L l (HsVar c)) args
-  | isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args)))
-checkPat loc e args 	-- OK to let this happen even if bang-patterns
-			-- are not enabled, because there is no valid
-			-- non-bang-pattern parse of (C ! e)
-  | Just (e', args') <- splitBang e
-  = do	{ args'' <- checkPatterns args'
-	; checkPat loc e' (args'' ++ args) }
-checkPat loc (L _ (HsApp f x)) args
-  = do { x <- checkLPat x; checkPat loc f (x:args) }
-checkPat loc (L _ e) []
-  = do { p <- checkAPat loc e; return (L loc p) }
-checkPat loc pat _some_args
-  = patFail loc
-
-checkAPat loc e = case e of
-   EWildPat	       -> return (WildPat placeHolderType)
-   HsVar x | isQual x  -> parseError loc ("Qualified variable in pattern: "
-					 ++ showRdrName x)
-   	   | otherwise -> return (VarPat x)
-   HsLit l 	       -> return (LitPat l)
-
-   -- Overloaded numeric patterns (e.g. f 0 x = x)
-   -- Negation is recorded separately, so that the literal is zero or +ve
-   -- NB. Negative *primitive* literals are already handled by
-   --     RdrHsSyn.mkHsNegApp
-   HsOverLit pos_lit            -> return (mkNPat pos_lit Nothing)
-   NegApp (L _ (HsOverLit pos_lit)) _ 
-			-> return (mkNPat pos_lit (Just noSyntaxExpr))
-   
-   SectionR (L _ (HsVar bang)) e 
- 	| bang == bang_RDR -> checkLPat e >>= (return . BangPat)
-   ELazyPat e	      -> checkLPat e >>= (return . LazyPat)
-   EAsPat n e	      -> checkLPat e >>= (return . AsPat n)
-   ExprWithTySig e t  -> checkLPat e >>= \e ->
-   			 -- Pattern signatures are parsed as sigtypes,
-   			 -- but they aren't explicit forall points.  Hence
-   			 -- we have to remove the implicit forall here.
-   			 let t' = case t of 
-   				     L _ (HsForAllTy Implicit _ (L _ []) ty) -> ty
-   				     other -> other
-   			 in
-   			 return (SigPatIn e t')
-   
-   -- n+k patterns
-   OpApp (L nloc (HsVar n)) (L _ (HsVar plus)) _ 
-	(L _ (HsOverLit lit@(HsIntegral _ _)))
-   		      | plus == plus_RDR
-   		      -> return (mkNPlusKPat (L nloc n) lit)
-   
-   OpApp l op fix r   -> checkLPat l >>= \l ->
-   			 checkLPat r >>= \r ->
-   			 case op of
-   			    L cl (HsVar c) | isDataOcc (rdrNameOcc c)
-   				   -> return (ConPatIn (L cl c) (InfixCon l r))
-   			    _ -> patFail loc
-   
-   HsPar e		   -> checkLPat e >>= (return . ParPat)
-   ExplicitList _ es  -> mapM (\e -> checkLPat e) es >>= \ps ->
-   			 return (ListPat ps placeHolderType)
-   ExplicitPArr _ es  -> mapM (\e -> checkLPat e) es >>= \ps ->
-   			 return (PArrPat ps placeHolderType)
-   
-   ExplicitTuple es b -> mapM (\e -> checkLPat e) es >>= \ps ->
-   			 return (TuplePat ps b placeHolderType)
-   
-   RecordCon c _ fs   -> mapM checkPatField fs >>= \fs ->
-			 return (ConPatIn c (RecCon fs))
--- Generics 
-   HsType ty          -> return (TypePat ty) 
-   _                  -> patFail loc
-
-plus_RDR, bang_RDR :: RdrName
-plus_RDR = mkUnqual varName FSLIT("+")	-- Hack
-bang_RDR = mkUnqual varName FSLIT("!")	-- Hack
-
-checkPatField :: (Located RdrName, LHsExpr RdrName) -> P (Located RdrName, LPat RdrName)
-checkPatField (n,e) = do
-  p <- checkLPat e
-  return (n,p)
-
-patFail loc = parseError loc "Parse error in pattern"
-
-
----------------------------------------------------------------------------
--- Check Equation Syntax
-
-checkValDef :: LHsExpr RdrName
-	    -> Maybe (LHsType RdrName)
-	    -> Located (GRHSs RdrName)
-	    -> P (HsBind RdrName)
-
-checkValDef lhs opt_sig grhss
-  = do	{ mb_fun <- isFunLhs lhs
-	; case mb_fun of
-	    Just (fun, is_infix, pats) -> checkFunBind (getLoc lhs)
-						fun is_infix pats opt_sig grhss
-	    Nothing -> checkPatBind lhs grhss }
-
-checkFunBind lhs_loc fun is_infix pats opt_sig (L rhs_span grhss)
-  | isQual (unLoc fun)
-  = parseError (getLoc fun) ("Qualified name in function definition: "  ++ 
-			     showRdrName (unLoc fun))
-  | otherwise
-  = do	ps <- checkPatterns pats
-	let match_span = combineSrcSpans lhs_loc rhs_span
-	    matches    = mkMatchGroup [L match_span (Match ps opt_sig grhss)]
-	return (FunBind { fun_id = fun, fun_infix = is_infix, fun_matches = matches,
-			  fun_co_fn = idCoercion, bind_fvs = placeHolderNames })
-	-- The span of the match covers the entire equation.  
-	-- That isn't quite right, but it'll do for now.
-
-checkPatBind lhs (L _ grhss)
-  = do	{ lhs <- checkPattern lhs
-	; return (PatBind lhs grhss placeHolderType placeHolderNames) }
-
-checkValSig
-	:: LHsExpr RdrName
-	-> LHsType RdrName
-	-> P (Sig RdrName)
-checkValSig (L l (HsVar v)) ty 
-  | isUnqual v && not (isDataOcc (rdrNameOcc v))
-  = return (TypeSig (L l v) ty)
-checkValSig (L l other)     ty
-  = parseError l "Invalid type signature"
-
-mkGadtDecl
-        :: Located RdrName
-        -> LHsType RdrName -- assuming HsType
-        -> ConDecl RdrName
-mkGadtDecl name (L _ (HsForAllTy _ qvars cxt ty)) = ConDecl
-  { con_name     = name
-  , con_explicit = Implicit
-  , con_qvars    = qvars
-  , con_cxt      = cxt
-  , con_details  = PrefixCon args
-  , con_res      = ResTyGADT res
-  }
-  where
-  (args, res) = splitHsFunType ty
-mkGadtDecl name ty = ConDecl
-  { con_name     = name
-  , con_explicit = Implicit
-  , con_qvars    = []
-  , con_cxt      = noLoc []
-  , con_details  = PrefixCon args
-  , con_res      = ResTyGADT res
-  }
-  where
-  (args, res) = splitHsFunType ty
-
--- A variable binding is parsed as a FunBind.
-
-
-	-- The parser left-associates, so there should 
-	-- not be any OpApps inside the e's
-splitBang :: LHsExpr RdrName -> Maybe (LHsExpr RdrName, [LHsExpr RdrName])
--- Splits (f ! g a b) into (f, [(! g), a, g])
-splitBang (L loc (OpApp l_arg bang@(L loc' (HsVar op)) _ r_arg))
-  | op == bang_RDR = Just (l_arg, L loc (SectionR bang arg1) : argns)
-  where
-    (arg1,argns) = split_bang r_arg []
-    split_bang (L _ (HsApp f e)) es = split_bang f (e:es)
-    split_bang e	   	 es = (e,es)
-splitBang other = Nothing
-
-isFunLhs :: LHsExpr RdrName 
-	 -> P (Maybe (Located RdrName, Bool, [LHsExpr RdrName]))
--- Just (fun, is_infix, arg_pats) if e is a function LHS
-isFunLhs e = go e []
- where
-   go (L loc (HsVar f)) es 
-	| not (isRdrDataCon f)	 = return (Just (L loc f, False, es))
-   go (L _ (HsApp f e)) es 	 = go f (e:es)
-   go (L _ (HsPar e))   es@(_:_) = go e es
-   go e@(L loc (OpApp l (L loc' (HsVar op)) fix r)) es
-	| Just (e',es') <- splitBang e
-	= do { bang_on <- extension bangPatEnabled
-	     ; if bang_on then go e' (es' ++ es)
-	       else return (Just (L loc' op, True, (l:r:es))) }
-		-- No bangs; behave just like the next case
-	| not (isRdrDataCon op) 
-	= return (Just (L loc' op, True, (l:r:es)))
-	| otherwise
-	= do { mb_l <- go l es
-	     ; case mb_l of
-		 Just (op', True, j : k : es')
-		    -> return (Just (op', True, j : op_app : es'))
-		    where
-		      op_app = L loc (OpApp k (L loc' (HsVar op)) fix r)
-		 _ -> return Nothing }
-   go _ _ = return Nothing
-
----------------------------------------------------------------------------
--- Miscellaneous utilities
-
-checkPrecP :: Located Int -> P Int
-checkPrecP (L l i)
- | 0 <= i && i <= maxPrecedence = return i
- | otherwise     	        = parseError l "Precedence out of range"
-
-mkRecConstrOrUpdate 
-	:: LHsExpr RdrName 
-	-> SrcSpan
-	-> HsRecordBinds RdrName
-	-> P (HsExpr RdrName)
-
-mkRecConstrOrUpdate (L l (HsVar c)) loc fs | isRdrDataCon c
-  = return (RecordCon (L l c) noPostTcExpr fs)
-mkRecConstrOrUpdate exp loc fs@(_:_)
-  = return (RecordUpd exp fs placeHolderType placeHolderType)
-mkRecConstrOrUpdate _ loc []
-  = parseError loc "Empty record update"
-
-mkInlineSpec :: Maybe Activation -> Bool -> InlineSpec
--- The Maybe is becuase the user can omit the activation spec (and usually does)
-mkInlineSpec Nothing 	True  = alwaysInlineSpec	-- INLINE
-mkInlineSpec Nothing 	False = neverInlineSpec		-- NOINLINE
-mkInlineSpec (Just act) inl   = Inline act inl
-
-
------------------------------------------------------------------------------
--- utilities for foreign declarations
-
--- supported calling conventions
---
-data CallConv = CCall  CCallConv	-- ccall or stdcall
-	      | DNCall			-- .NET
-
--- construct a foreign import declaration
---
-mkImport :: CallConv 
-	 -> Safety 
-	 -> (Located FastString, Located RdrName, LHsType RdrName) 
-	 -> P (HsDecl RdrName)
-mkImport (CCall  cconv) safety (entity, v, ty) = do
-  importSpec <- parseCImport entity cconv safety v
-  return (ForD (ForeignImport v ty importSpec False))
-mkImport (DNCall      ) _      (entity, v, ty) = do
-  spec <- parseDImport entity
-  return $ ForD (ForeignImport v ty (DNImport spec) False)
-
--- parse the entity string of a foreign import declaration for the `ccall' or
--- `stdcall' calling convention'
---
-parseCImport :: Located FastString
-	     -> CCallConv 
-	     -> Safety 
-	     -> Located RdrName
-	     -> P ForeignImport
-parseCImport (L loc entity) cconv safety v
-  -- FIXME: we should allow white space around `dynamic' and `wrapper' -=chak
-  | entity == FSLIT ("dynamic") = 
-    return $ CImport cconv safety nilFS nilFS (CFunction DynamicTarget)
-  | entity == FSLIT ("wrapper") =
-    return $ CImport cconv safety nilFS nilFS CWrapper
-  | otherwise		       = parse0 (unpackFS entity)
-    where
-      -- using the static keyword?
-      parse0 (' ':                    rest) = parse0 rest
-      parse0 ('s':'t':'a':'t':'i':'c':rest) = parse1 rest
-      parse0                          rest  = parse1 rest
-      -- check for header file name
-      parse1     ""               = parse4 ""    nilFS        False nilFS
-      parse1     (' ':rest)       = parse1 rest
-      parse1 str@('&':_   )       = parse2 str   nilFS
-      parse1 str@('[':_   )       = parse3 str   nilFS        False
-      parse1 str
-	| ".h" `isSuffixOf` first = parse2 rest  (mkFastString first)
-        | otherwise               = parse4 str   nilFS        False nilFS
-        where
-	  (first, rest) = break (\c -> c == ' ' || c == '&' || c == '[') str
-      -- check for address operator (indicating a label import)
-      parse2     ""         header = parse4 ""   header False nilFS
-      parse2     (' ':rest) header = parse2 rest header
-      parse2     ('&':rest) header = parse3 rest header True
-      parse2 str@('[':_   ) header = parse3 str	 header False
-      parse2 str	    header = parse4 str	 header False nilFS
-      -- check for library object name
-      parse3 (' ':rest) header isLbl = parse3 rest header isLbl
-      parse3 ('[':rest) header isLbl = 
-        case break (== ']') rest of 
-	  (lib, ']':rest)           -> parse4 rest header isLbl (mkFastString lib)
-	  _			    -> parseError loc "Missing ']' in entity"
-      parse3 str	header isLbl = parse4 str  header isLbl nilFS
-      -- check for name of C function
-      parse4 ""         header isLbl lib = build (mkExtName (unLoc v)) header isLbl lib
-      parse4 (' ':rest) header isLbl lib = parse4 rest         	       header isLbl lib
-      parse4 str	header isLbl lib
-        | all (== ' ') rest              = build (mkFastString first)  header isLbl lib
-	| otherwise			 = parseError loc "Malformed entity string"
-        where
-	  (first, rest) = break (== ' ') str
-      --
-      build cid header False lib = return $
-        CImport cconv safety header lib (CFunction (StaticTarget cid))
-      build cid header True  lib = return $
-        CImport cconv safety header lib (CLabel                  cid )
-
---
--- Unravel a dotnet spec string.
---
-parseDImport :: Located FastString -> P DNCallSpec
-parseDImport (L loc entity) = parse0 comps
- where
-  comps = words (unpackFS entity)
-
-  parse0 [] = d'oh
-  parse0 (x : xs) 
-    | x == "static" = parse1 True xs
-    | otherwise     = parse1 False (x:xs)
-
-  parse1 _ [] = d'oh
-  parse1 isStatic (x:xs)
-    | x == "method" = parse2 isStatic DNMethod xs
-    | x == "field"  = parse2 isStatic DNField xs
-    | x == "ctor"   = parse2 isStatic DNConstructor xs
-  parse1 isStatic xs = parse2 isStatic DNMethod xs
-
-  parse2 _ _ [] = d'oh
-  parse2 isStatic kind (('[':x):xs) =
-     case x of
-	[] -> d'oh
-	vs | last vs == ']' -> parse3 isStatic kind (init vs) xs
-  parse2 isStatic kind xs = parse3 isStatic kind "" xs
-
-  parse3 isStatic kind assem [x] = 
-    return (DNCallSpec isStatic kind assem x 
-    			  -- these will be filled in once known.
-                        (error "FFI-dotnet-args")
-                        (error "FFI-dotnet-result"))
-  parse3 _ _ _ _ = d'oh
-
-  d'oh = parseError loc "Malformed entity string"
-  
--- construct a foreign export declaration
---
-mkExport :: CallConv
-         -> (Located FastString, Located RdrName, LHsType RdrName) 
-	 -> P (HsDecl RdrName)
-mkExport (CCall  cconv) (L loc entity, v, ty) = return $ 
-  ForD (ForeignExport v ty (CExport (CExportStatic entity' cconv)) False)
-  where
-    entity' | nullFS entity = mkExtName (unLoc v)
-	    | otherwise     = entity
-mkExport DNCall (L loc entity, v, ty) =
-  parseError (getLoc v){-TODO: not quite right-}
-	"Foreign export is not yet supported for .NET"
-
--- Supplying the ext_name in a foreign decl is optional; if it
--- isn't there, the Haskell name is assumed. Note that no transformation
--- of the Haskell name is then performed, so if you foreign export (++),
--- it's external name will be "++". Too bad; it's important because we don't
--- want z-encoding (e.g. names with z's in them shouldn't be doubled)
---
-mkExtName :: RdrName -> CLabelString
-mkExtName rdrNm = mkFastString (occNameString (rdrNameOcc rdrNm))
-\end{code}
-
-
------------------------------------------------------------------------------
--- Misc utils
-
-\begin{code}
-showRdrName :: RdrName -> String
-showRdrName r = showSDoc (ppr r)
-
-parseError :: SrcSpan -> String -> P a
-parseError span s = failSpanMsgP span s
-\end{code}
diff --git a/ghc/compiler/parser/cutils.c b/ghc/compiler/parser/cutils.c
deleted file mode 100644
index 08832f298d..0000000000
--- a/ghc/compiler/parser/cutils.c
+++ /dev/null
@@ -1,70 +0,0 @@
-/*
-These utility routines are used various
-places in the GHC library.
-*/
-
-/* For GHC 4.08, we are relying on the fact that RtsFlags has
- * compatible layout with the current version, because we're
- * #including the current version of RtsFlags.h below.  4.08 didn't
- * ship with its own RtsFlags.h, unfortunately.   For later GHC
- * versions, we #include the correct RtsFlags.h.
- */
-#if __GLASGOW_HASKELL__ < 502
-#include "../includes/Rts.h"
-#include "../includes/RtsFlags.h"
-#else
-#include "Rts.h"
-#include "RtsFlags.h"
-#endif
-
-#include "HsFFI.h"
-
-#include <string.h>
-
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-/*
-Calling 'strlen' and 'memcpy' directly gives problems with GCC's inliner,
-and causes gcc to require too many registers on x84
-*/
-
-HsInt
-ghc_strlen( HsAddr a )
-{
-    return (strlen((char *)a));
-}
-
-HsInt
-ghc_memcmp( HsAddr a1, HsAddr a2, HsInt len )
-{
-    return (memcmp((char *)a1, a2, len));
-}
-
-HsInt
-ghc_memcmp_off( HsAddr a1, HsInt i, HsAddr a2, HsInt len )
-{
-    return (memcmp((char *)a1 + i, a2, len));
-}
-
-void
-enableTimingStats( void )	/* called from the driver */
-{
-#if __GLASGOW_HASKELL__ >= 411
-    RtsFlags.GcFlags.giveStats = ONELINE_GC_STATS;
-#endif
-    /* ignored when bootstrapping with an older GHC */
-}
-
-void
-setHeapSize( HsInt size )
-{
-    RtsFlags.GcFlags.heapSizeSuggestion = size / BLOCK_SIZE;
-    if (RtsFlags.GcFlags.maxHeapSize != 0 &&
-	RtsFlags.GcFlags.heapSizeSuggestion > RtsFlags.GcFlags.maxHeapSize) {
-	RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
-    }
-}
-
-
diff --git a/ghc/compiler/parser/cutils.h b/ghc/compiler/parser/cutils.h
deleted file mode 100644
index c7c1867ded..0000000000
--- a/ghc/compiler/parser/cutils.h
+++ /dev/null
@@ -1,16 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * Utility C functions.
- *
- * -------------------------------------------------------------------------- */
-
-#include "HsFFI.h"
-
-// Out-of-line string functions, see PrimPacked.lhs
-HsInt ghc_strlen( HsAddr a );
-HsInt ghc_memcmp( HsAddr a1, HsAddr a2, HsInt len );
-HsInt ghc_memcmp_off( HsAddr a1, HsInt i, HsAddr a2, HsInt len );
-
-
-void enableTimingStats( void );
-void setHeapSize( HsInt size );
diff --git a/ghc/compiler/parser/hschooks.c b/ghc/compiler/parser/hschooks.c
deleted file mode 100644
index f3e7447a49..0000000000
--- a/ghc/compiler/parser/hschooks.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/*
-These routines customise the error messages
-for various bits of the RTS.  They are linked
-in instead of the defaults.
-*/
-
-/* For GHC 4.08, we are relying on the fact that RtsFlags has
- * compatible layout with the current version, because we're
- * #including the current version of RtsFlags.h below.  4.08 didn't
- * ship with its own RtsFlags.h, unfortunately.   For later GHC
- * versions, we #include the correct RtsFlags.h.
- */
-#if __GLASGOW_HASKELL__ < 502
-#include "../includes/Rts.h"
-#include "../includes/RtsFlags.h"
-#else
-#include "Rts.h"
-#include "RtsFlags.h"
-#endif
-
-#include "HsFFI.h"
-
-#include <string.h>
-
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-void
-defaultsHook (void)
-{
-    RtsFlags.GcFlags.heapSizeSuggestion = 6*1024*1024 / BLOCK_SIZE;
-    RtsFlags.GcFlags.maxStkSize         = 8*1024*1024 / sizeof(W_);
-#if __GLASGOW_HASKELL__ >= 411
-    /* GHC < 4.11 didn't have these */
-    RtsFlags.GcFlags.giveStats = COLLECT_GC_STATS;
-    RtsFlags.GcFlags.statsFile = stderr;
-#endif
-}
-
-void
-OutOfHeapHook (unsigned long request_size/* always zero these days */,
-	       unsigned long heap_size)
-    /* both in bytes */
-{
-    fprintf(stderr, "GHC's heap exhausted: current limit is %lu bytes;\nUse the `-M<size>' option to increase the total heap size.\n",
-	heap_size);
-}
-
-void
-StackOverflowHook (unsigned long stack_size)    /* in bytes */
-{
-    fprintf(stderr, "GHC stack-space overflow: current limit is %ld bytes.\nUse the `-K<size>' option to increase it.\n", stack_size);
-}
-
diff --git a/ghc/compiler/parser/hschooks.h b/ghc/compiler/parser/hschooks.h
deleted file mode 100644
index 4ce1c0f93d..0000000000
--- a/ghc/compiler/parser/hschooks.h
+++ /dev/null
@@ -1,9 +0,0 @@
-/* -----------------------------------------------------------------------------
- * $Id: hschooks.h,v 1.4 2002/04/22 14:54:10 simonmar Exp $
- *
- * Hooks into the RTS from the compiler.
- *
- * -------------------------------------------------------------------------- */
-
-#include "HsFFI.h"
-
diff --git a/ghc/compiler/prelude/ForeignCall.lhs b/ghc/compiler/prelude/ForeignCall.lhs
deleted file mode 100644
index 2c90a7dc6e..0000000000
--- a/ghc/compiler/prelude/ForeignCall.lhs
+++ /dev/null
@@ -1,423 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Foreign]{Foreign calls}
-
-\begin{code}
-module ForeignCall (
-	ForeignCall(..),
-	Safety(..), playSafe, playThreadSafe,
-
-	CExportSpec(..), CLabelString, isCLabelString, pprCLabelString,
-	CCallSpec(..), 
-	CCallTarget(..), isDynamicTarget,
-	CCallConv(..), defaultCCallConv, ccallConvToInt, ccallConvAttribute,
-
-	DNCallSpec(..), DNKind(..), DNType(..),
-	withDNTypes
-    ) where
-
-#include "HsVersions.h"
-
-import FastString	( FastString, unpackFS )
-import Char		( isAlphaNum )
-import Binary
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{Data types}
-%*									*
-%************************************************************************
-
-\begin{code}
-data ForeignCall
-  = CCall	CCallSpec
-  | DNCall	DNCallSpec
-  deriving( Eq )		-- We compare them when seeing if an interface
-				-- has changed (for versioning purposes)
-  {-! derive: Binary !-}
-
--- We may need more clues to distinguish foreign calls
--- but this simple printer will do for now
-instance Outputable ForeignCall where
-  ppr (CCall cc)  = ppr cc		
-  ppr (DNCall dn) = ppr dn
-\end{code}
-
-  
-\begin{code}
-data Safety
-  = PlaySafe		-- Might invoke Haskell GC, or do a call back, or
-			-- switch threads, etc.  So make sure things are
-			-- tidy before the call
-	Bool            -- => True, external function is also re-entrant.
-			--    [if supported, RTS arranges for the external call
-			--    to be executed by a separate OS thread, i.e.,
-			--    _concurrently_ to the execution of other Haskell threads.]
-
-  | PlayRisky		-- None of the above can happen; the call will return
-			-- without interacting with the runtime system at all
-  deriving( Eq, Show )
-	-- Show used just for Show Lex.Token, I think
-  {-! derive: Binary !-}
-
-instance Outputable Safety where
-  ppr (PlaySafe False) = ptext SLIT("safe")
-  ppr (PlaySafe True)  = ptext SLIT("threadsafe")
-  ppr PlayRisky = ptext SLIT("unsafe")
-
-playSafe :: Safety -> Bool
-playSafe PlaySafe{} = True
-playSafe PlayRisky  = False
-
-playThreadSafe :: Safety -> Bool
-playThreadSafe (PlaySafe x) = x
-playThreadSafe _ = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{Calling C}
-%*									*
-%************************************************************************
-
-\begin{code}
-data CExportSpec
-  = CExportStatic		-- foreign export ccall foo :: ty
-	CLabelString		-- C Name of exported function
-	CCallConv
-  {-! derive: Binary !-}
-
-data CCallSpec
-  =  CCallSpec	CCallTarget	-- What to call
-		CCallConv	-- Calling convention to use.
-		Safety
-  deriving( Eq )
-  {-! derive: Binary !-}
-\end{code}
-
-The call target:
-
-\begin{code}
-data CCallTarget
-  = StaticTarget  CLabelString  -- An "unboxed" ccall# to `fn'.
-  | DynamicTarget 		-- First argument (an Addr#) is the function pointer
-  deriving( Eq )
-  {-! derive: Binary !-}
-
-isDynamicTarget :: CCallTarget -> Bool
-isDynamicTarget DynamicTarget = True
-isDynamicTarget other	      = False
-\end{code}
-
-
-Stuff to do with calling convention:
-
-ccall:		Caller allocates parameters, *and* deallocates them.
-
-stdcall: 	Caller allocates parameters, callee deallocates.
-		Function name has @N after it, where N is number of arg bytes
-		e.g.  _Foo@8
-
-ToDo: The stdcall calling convention is x86 (win32) specific,
-so perhaps we should emit a warning if it's being used on other
-platforms.
-
-\begin{code}
-data CCallConv = CCallConv | StdCallConv
-  deriving (Eq)
-  {-! derive: Binary !-}
-
-instance Outputable CCallConv where
-  ppr StdCallConv = ptext SLIT("stdcall")
-  ppr CCallConv   = ptext SLIT("ccall")
-
-defaultCCallConv :: CCallConv
-defaultCCallConv = CCallConv
-
-ccallConvToInt :: CCallConv -> Int
-ccallConvToInt StdCallConv = 0
-ccallConvToInt CCallConv   = 1
-\end{code}
-
-Generate the gcc attribute corresponding to the given
-calling convention (used by PprAbsC):
-
-\begin{code}
-ccallConvAttribute :: CCallConv -> String
-ccallConvAttribute StdCallConv = "__attribute__((__stdcall__))"
-ccallConvAttribute CCallConv   = ""
-\end{code}
-
-\begin{code}
-type CLabelString = FastString		-- A C label, completely unencoded
-
-pprCLabelString :: CLabelString -> SDoc
-pprCLabelString lbl = ftext lbl
-
-isCLabelString :: CLabelString -> Bool	-- Checks to see if this is a valid C label
-isCLabelString lbl 
-  = all ok (unpackFS lbl)
-  where
-    ok c = isAlphaNum c || c == '_' || c == '.'
-	-- The '.' appears in e.g. "foo.so" in the 
-	-- module part of a ExtName.  Maybe it should be separate
-\end{code}
-
-
-Printing into C files:
-
-\begin{code}
-instance Outputable CExportSpec where
-  ppr (CExportStatic str _) = pprCLabelString str
-
-instance Outputable CCallSpec where
-  ppr (CCallSpec fun cconv safety)
-    = hcat [ ifPprDebug callconv, ppr_fun fun ]
-    where
-      callconv = text "{-" <> ppr cconv <> text "-}"
-
-      gc_suf | playSafe safety = text "_GC"
-	     | otherwise       = empty
-
-      ppr_fun DynamicTarget     = text "__dyn_ccall" <> gc_suf <+> text "\"\""
-      ppr_fun (StaticTarget fn) = text "__ccall"     <> gc_suf <+> pprCLabelString fn
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{.NET interop}
-%*									*
-%************************************************************************
-
-\begin{code}
-data DNCallSpec = 
-	DNCallSpec Bool       -- True => static method/field
-		   DNKind     -- what type of access
-		   String     -- assembly
-		   String     -- fully qualified method/field name.
-		   [DNType]   -- argument types.
-		   DNType     -- result type.
-    deriving ( Eq )
-  {-! derive: Binary !-}
-
-data DNKind
-  = DNMethod
-  | DNField
-  | DNConstructor
-    deriving ( Eq )
-  {-! derive: Binary !-}
-
-data DNType
-  = DNByte
-  | DNBool
-  | DNChar
-  | DNDouble
-  | DNFloat
-  | DNInt
-  | DNInt8
-  | DNInt16
-  | DNInt32
-  | DNInt64
-  | DNWord8
-  | DNWord16
-  | DNWord32
-  | DNWord64
-  | DNPtr
-  | DNUnit
-  | DNObject
-  | DNString
-    deriving ( Eq )
-  {-! derive: Binary !-}
-
-withDNTypes :: DNCallSpec -> [DNType] -> DNType -> DNCallSpec
-withDNTypes (DNCallSpec isStatic k assem nm _ _) argTys resTy
-  = DNCallSpec isStatic k assem nm argTys resTy
-
-instance Outputable DNCallSpec where
-  ppr (DNCallSpec isStatic kind ass nm _ _ ) 
-    = char '"' <> 
-       (if isStatic then text "static" else empty) <+>
-       (text (case kind of { DNMethod -> "method" ; DNField -> "field"; DNConstructor -> "ctor" })) <+>
-       (if null ass then char ' ' else char '[' <> text ass <> char ']') <>
-       text nm <> 
-      char '"'
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsubsection{Misc}
-%*									*
-%************************************************************************
-
-\begin{code}
-{-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
-instance Binary ForeignCall where
-    put_ bh (CCall aa) = do
-	    putByte bh 0
-	    put_ bh aa
-    put_ bh (DNCall ab) = do
-	    putByte bh 1
-	    put_ bh ab
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      return (CCall aa)
-	      _ -> do ab <- get bh
-		      return (DNCall ab)
-
-instance Binary Safety where
-    put_ bh (PlaySafe aa) = do
-	    putByte bh 0
-	    put_ bh aa
-    put_ bh PlayRisky = do
-	    putByte bh 1
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      return (PlaySafe aa)
-	      _ -> do return PlayRisky
-
-instance Binary CExportSpec where
-    put_ bh (CExportStatic aa ab) = do
-	    put_ bh aa
-	    put_ bh ab
-    get bh = do
-	  aa <- get bh
-	  ab <- get bh
-	  return (CExportStatic aa ab)
-
-instance Binary CCallSpec where
-    put_ bh (CCallSpec aa ab ac) = do
-	    put_ bh aa
-	    put_ bh ab
-	    put_ bh ac
-    get bh = do
-	  aa <- get bh
-	  ab <- get bh
-	  ac <- get bh
-	  return (CCallSpec aa ab ac)
-
-instance Binary CCallTarget where
-    put_ bh (StaticTarget aa) = do
-	    putByte bh 0
-	    put_ bh aa
-    put_ bh DynamicTarget = do
-	    putByte bh 1
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do aa <- get bh
-		      return (StaticTarget aa)
-	      _ -> do return DynamicTarget
-
-instance Binary CCallConv where
-    put_ bh CCallConv = do
-	    putByte bh 0
-    put_ bh StdCallConv = do
-	    putByte bh 1
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return CCallConv
-	      _ -> do return StdCallConv
-
-instance Binary DNCallSpec where
-    put_ bh (DNCallSpec isStatic kind ass nm _ _) = do
-            put_ bh isStatic
-	    put_ bh kind
-	    put_ bh ass
-	    put_ bh nm
-    get bh = do
-          isStatic <- get bh
-	  kind     <- get bh
-	  ass      <- get bh
-	  nm       <- get bh
-	  return (DNCallSpec isStatic kind ass nm [] undefined)
-
-instance Binary DNKind where
-    put_ bh DNMethod = do
-	    putByte bh 0
-    put_ bh DNField = do
-	    putByte bh 1
-    put_ bh DNConstructor = do
-	    putByte bh 2
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> do return DNMethod
-	      1 -> do return DNField
-	      _ -> do return DNConstructor
-
-instance Binary DNType where
-    put_ bh DNByte = do
-	    putByte bh 0
-    put_ bh DNBool = do
-	    putByte bh 1
-    put_ bh DNChar = do
-	    putByte bh 2
-    put_ bh DNDouble = do
-	    putByte bh 3
-    put_ bh DNFloat = do
-	    putByte bh 4
-    put_ bh DNInt = do
-	    putByte bh 5
-    put_ bh DNInt8 = do
-	    putByte bh 6
-    put_ bh DNInt16 = do
-	    putByte bh 7
-    put_ bh DNInt32 = do
-	    putByte bh 8
-    put_ bh DNInt64 = do
-	    putByte bh 9
-    put_ bh DNWord8 = do
-	    putByte bh 10
-    put_ bh DNWord16 = do
-	    putByte bh 11
-    put_ bh DNWord32 = do
-	    putByte bh 12
-    put_ bh DNWord64 = do
-	    putByte bh 13
-    put_ bh DNPtr = do
-	    putByte bh 14
-    put_ bh DNUnit = do
-	    putByte bh 15
-    put_ bh DNObject = do
-	    putByte bh 16
-    put_ bh DNString = do
-	    putByte bh 17
-
-    get bh = do
-	    h <- getByte bh
-	    case h of
-	      0 -> return DNByte
-	      1 -> return DNBool
-	      2 -> return DNChar
-  	      3 -> return DNDouble
-  	      4 -> return DNFloat
-  	      5 -> return DNInt
-  	      6 -> return DNInt8
-  	      7 -> return DNInt16
-  	      8 -> return DNInt32
-	      9 -> return DNInt64
-	      10 -> return DNWord8
-	      11 -> return DNWord16
-	      12 -> return DNWord32
-	      13 -> return DNWord64
-	      14 -> return DNPtr
-	      15 -> return DNUnit
-	      16 -> return DNObject
-	      17 -> return DNString
-
---  Imported from other files :-
-
-\end{code}
diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs
deleted file mode 100644
index 31457b2b63..0000000000
--- a/ghc/compiler/prelude/PrelInfo.lhs
+++ /dev/null
@@ -1,139 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[PrelInfo]{The @PrelInfo@ interface to the compiler's prelude knowledge}
-
-\begin{code}
-module PrelInfo (
-	module MkId,
-
-	ghcPrimExports,
-	wiredInThings, basicKnownKeyNames,
-	primOpId,
-	
-	-- Random other things
-	maybeCharLikeCon, maybeIntLikeCon,
-
-	-- Class categories
-	isNumericClass, isStandardClass
-
-    ) where
-
-#include "HsVersions.h"
-
-import PrelNames	( basicKnownKeyNames, 
-			  hasKey, charDataConKey, intDataConKey,
-			  numericClassKeys, standardClassKeys )
-
-import PrimOp		( PrimOp, allThePrimOps, primOpOcc, primOpTag, maxPrimOpTag )
-import DataCon		( DataCon )
-import Id		( Id, idName )
-import MkId		( mkPrimOpId, wiredInIds )
-import MkId		-- All of it, for re-export
-import Name		( nameOccName )
-import TysPrim		( primTyCons )
-import TysWiredIn	( wiredInTyCons )
-import HscTypes 	( TyThing(..), implicitTyThings, GenAvailInfo(..), RdrAvailInfo )
-import Class	 	( Class, classKey )
-import Type		( funTyCon )
-import TyCon		( tyConName )
-import Util		( isIn )
-
-import Array		( Array, array, (!) )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[builtinNameInfo]{Lookup built-in names}
-%*									*
-%************************************************************************
-
-We have two ``builtin name funs,'' one to look up @TyCons@ and
-@Classes@, the other to look up values.
-
-\begin{code}
-wiredInThings :: [TyThing]
-wiredInThings		
-  = concat
-    [		-- Wired in TyCons and their implicit Ids
-	  tycon_things
-	, concatMap implicitTyThings tycon_things
-
-		-- Wired in Ids
-	, map AnId wiredInIds
-
-		-- PrimOps
-	, map (AnId . mkPrimOpId) allThePrimOps
-    ]
-  where
-    tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons)
-\end{code}
-
-We let a lot of "non-standard" values be visible, so that we can make
-sense of them in interface pragmas. It's cool, though they all have
-"non-standard" names, so they won't get past the parser in user code.
-
-%************************************************************************
-%*									*
-		PrimOpIds
-%*									*
-%************************************************************************
-
-\begin{code}
-primOpIds :: Array Int Id	-- Indexed by PrimOp tag
-primOpIds = array (1,maxPrimOpTag) [ (primOpTag op, mkPrimOpId op) 
-				   | op <- allThePrimOps]
-
-primOpId :: PrimOp -> Id
-primOpId op = primOpIds ! primOpTag op
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Export lists for pseudo-modules (GHC.Prim)}
-%*									*
-%************************************************************************
-
-GHC.Prim "exports" all the primops and primitive types, some 
-wired-in Ids.
-
-\begin{code}
-ghcPrimExports :: [RdrAvailInfo]
-ghcPrimExports
- = map (Avail . nameOccName . idName) ghcPrimIds ++
-   map (Avail . primOpOcc) allThePrimOps ++
-   [ AvailTC occ [occ] |
-     n <- funTyCon : primTyCons, let occ = nameOccName (tyConName n) 
-   ]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Built-in keys}
-%*									*
-%************************************************************************
-
-ToDo: make it do the ``like'' part properly (as in 0.26 and before).
-
-\begin{code}
-maybeCharLikeCon, maybeIntLikeCon :: DataCon -> Bool
-maybeCharLikeCon con = con `hasKey` charDataConKey
-maybeIntLikeCon  con = con `hasKey` intDataConKey
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Class predicates}
-%*									*
-%************************************************************************
-
-\begin{code}
-isNumericClass, isStandardClass :: Class -> Bool
-
-isNumericClass     clas = classKey clas `is_elem` numericClassKeys
-isStandardClass    clas = classKey clas `is_elem` standardClassKeys
-is_elem = isIn "is_X_Class"
-\end{code}
diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs
deleted file mode 100644
index d656fbf18e..0000000000
--- a/ghc/compiler/prelude/PrelNames.lhs
+++ /dev/null
@@ -1,1063 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[PrelNames]{Definitions of prelude modules and names}
-
-
-Nota Bene: all Names defined in here should come from the base package
-
-* ModuleNames for prelude modules, 
-	e.g.	pREL_BASE_Name :: ModuleName
-
-* Modules for prelude modules
-	e.g.	pREL_Base :: Module
-
-* Uniques for Ids, DataCons, TyCons and Classes that the compiler 
-  "knows about" in some way
-	e.g.	intTyConKey :: Unique
-		minusClassOpKey :: Unique
-
-* Names for Ids, DataCons, TyCons and Classes that the compiler 
-  "knows about" in some way
-	e.g.	intTyConName :: Name
-		minusName    :: Name
-  One of these Names contains
-	(a) the module and occurrence name of the thing
-	(b) its Unique
-  The may way the compiler "knows about" one of these things is
-  where the type checker or desugarer needs to look it up. For
-  example, when desugaring list comprehensions the desugarer
-  needs to conjure up 'foldr'.  It does this by looking up
-  foldrName in the environment.
-
-* RdrNames for Ids, DataCons etc that the compiler may emit into
-  generated code (e.g. for deriving).  It's not necessary to know
-  the uniques for these guys, only their names
-
-
-\begin{code}
-module PrelNames (
-	Unique, Uniquable(..), hasKey, 	-- Re-exported for convenience
-
-	-----------------------------------------------------------
-	module PrelNames,	-- A huge bunch of (a) Names,  e.g. intTyConName
-				--		   (b) Uniques e.g. intTyConKey
-				--		   (c) Groups of classes and types
-				--		   (d) miscellaneous things
-				-- So many that we export them all
-    ) where
-
-#include "HsVersions.h"
-
-import Module	  ( Module, mkModule )
-import OccName	  ( dataName, tcName, clsName, varName, mkOccNameFS,
-		    mkVarOccFS )
-import RdrName	  ( RdrName, nameRdrName, mkOrig, rdrNameOcc, mkUnqual )
-import Unique	  ( Unique, Uniquable(..), hasKey,
-		    mkPreludeMiscIdUnique, mkPreludeDataConUnique,
-		    mkPreludeTyConUnique, mkPreludeClassUnique,
-		    mkTupleTyConUnique
-		  ) 
-import BasicTypes ( Boxity(..), Arity )
-import Name	  ( Name, mkInternalName, mkExternalName, nameModule )
-import SrcLoc     ( noSrcLoc )
-import FastString
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Local Names}
-%*									*
-%************************************************************************
-
-This *local* name is used by the interactive stuff
-
-\begin{code}
-itName uniq = mkInternalName uniq (mkOccNameFS varName FSLIT("it")) noSrcLoc
-\end{code}
-
-\begin{code}
--- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
--- during compiler debugging.
-mkUnboundName :: RdrName -> Name
-mkUnboundName rdr_name = mkInternalName unboundKey (rdrNameOcc rdr_name) noSrcLoc
-
-isUnboundName :: Name -> Bool
-isUnboundName name = name `hasKey` unboundKey
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Known key Names}
-%*									*
-%************************************************************************
-
-This section tells what the compiler knows about the assocation of
-names with uniques.  These ones are the *non* wired-in ones.  The
-wired in ones are defined in TysWiredIn etc.
-
-\begin{code}
-basicKnownKeyNames :: [Name]
-basicKnownKeyNames
- = genericTyConNames
- ++ typeableClassNames
- ++ [	-- Type constructors (synonyms especially)
-	ioTyConName, ioDataConName,
-	runMainIOName,
-	orderingTyConName,
-	rationalTyConName,
-	ratioDataConName,
-	ratioTyConName,
-	byteArrayTyConName,
-	mutableByteArrayTyConName,
-	integerTyConName, smallIntegerDataConName, largeIntegerDataConName,
-
-	--  Classes.  *Must* include:
-	--  	classes that are grabbed by key (e.g., eqClassKey)
-	--  	classes in "Class.standardClassKeys" (quite a few)
-	eqClassName,			-- mentioned, derivable
-	ordClassName,			-- derivable
-	boundedClassName,		-- derivable
-	numClassName,			-- mentioned, numeric
-	enumClassName,			-- derivable
-	monadClassName,
-    	functorClassName,
-	realClassName,			-- numeric
-	integralClassName,		-- numeric
-	fractionalClassName,		-- numeric
-	floatingClassName,		-- numeric
-	realFracClassName,		-- numeric
-	realFloatClassName,		-- numeric
-	dataClassName, 
-
-	-- Numeric stuff
-	negateName, minusName, 
-	fromRationalName, fromIntegerName, 
-	geName, eqName, 
-	
-	-- Enum stuff
-	enumFromName, enumFromThenName,	
-	enumFromThenToName, enumFromToName,
-	enumFromToPName, enumFromThenToPName,
-
-	-- Monad stuff
-	thenIOName, bindIOName, returnIOName, failIOName,
-	failMName, bindMName, thenMName, returnMName,
-
-	-- MonadRec stuff
-	mfixName,
-
-	-- Arrow stuff
-	arrAName, composeAName, firstAName,
-	appAName, choiceAName, loopAName,
-
-	-- Ix stuff
-	ixClassName, 
-
-	-- Show stuff
-	showClassName, 
-
-	-- Read stuff
-	readClassName, 
-	
-	-- Stable pointers
-	newStablePtrName,
-
-	-- Strings and lists
-	unpackCStringName, unpackCStringAppendName,
-	unpackCStringFoldrName, unpackCStringUtf8Name,
-
-	-- List operations
-	concatName, filterName,
-	zipName, foldrName, buildName, augmentName, appendName,
-
-        -- Parallel array operations
-	nullPName, lengthPName, replicatePName,	mapPName,
-	filterPName, zipPName, crossPName, indexPName,
-	toPName, bpermutePName, bpermuteDftPName, indexOfPName,
-
-	-- FFI primitive types that are not wired-in.
-	stablePtrTyConName, ptrTyConName, funPtrTyConName, addrTyConName,
-	int8TyConName, int16TyConName, int32TyConName, int64TyConName,
-	wordTyConName, word8TyConName, word16TyConName, word32TyConName, word64TyConName,
-
-	-- Others
-	otherwiseIdName, 
-	plusIntegerName, timesIntegerName,
-	eqStringName, assertName, breakpointName, assertErrorName,
-        runSTRepName,
-	printName, fstName, sndName,
-
-	-- MonadFix
-	monadFixClassName, mfixName,
-
-	-- Splittable class
-	splittableClassName, splitName,
-
-	-- Other classes
-	randomClassName, randomGenClassName, monadPlusClassName,
-
-	-- Booleans
-	andName, orName
-	
-	-- The Either type
-	, eitherTyConName, leftDataConName, rightDataConName
-
-	-- dotnet interop
-	, objectTyConName, marshalObjectName, unmarshalObjectName
-	, marshalStringName, unmarshalStringName, checkDotnetResName
-    ]
-
-genericTyConNames :: [Name]
-genericTyConNames = [crossTyConName, plusTyConName, genUnitTyConName]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Module names}
-%*									*
-%************************************************************************
-
-
---MetaHaskell Extension Add a new module here
-\begin{code}
-pRELUDE		= mkModule "Prelude"
-gHC_PRIM	= mkModule "GHC.Prim"	   -- Primitive types and values
-pREL_BASE	= mkModule "GHC.Base"
-pREL_ENUM	= mkModule "GHC.Enum"
-pREL_SHOW	= mkModule "GHC.Show"
-pREL_READ	= mkModule "GHC.Read"
-pREL_NUM	= mkModule "GHC.Num"
-pREL_LIST	= mkModule "GHC.List"
-pREL_PARR	= mkModule "GHC.PArr"
-pREL_TUP	= mkModule "Data.Tuple"
-pREL_EITHER	= mkModule "Data.Either"
-pREL_PACK	= mkModule "GHC.Pack"
-pREL_CONC	= mkModule "GHC.Conc"
-pREL_IO_BASE	= mkModule "GHC.IOBase"
-pREL_ST		= mkModule "GHC.ST"
-pREL_ARR	= mkModule "GHC.Arr"
-pREL_BYTEARR	= mkModule "PrelByteArr"
-pREL_STABLE	= mkModule "GHC.Stable"
-pREL_ADDR	= mkModule "GHC.Addr"
-pREL_PTR	= mkModule "GHC.Ptr"
-pREL_ERR	= mkModule "GHC.Err"
-pREL_REAL	= mkModule "GHC.Real"
-pREL_FLOAT	= mkModule "GHC.Float"
-pREL_TOP_HANDLER= mkModule "GHC.TopHandler"
-sYSTEM_IO	= mkModule "System.IO"
-dYNAMIC		= mkModule "Data.Dynamic"
-tYPEABLE	= mkModule "Data.Typeable"
-gENERICS	= mkModule "Data.Generics.Basics"
-dOTNET		= mkModule "GHC.Dotnet"
-
-rEAD_PREC	= mkModule "Text.ParserCombinators.ReadPrec"
-lEX		= mkModule "Text.Read.Lex"
-
-mAIN		= mkModule "Main"
-pREL_INT	= mkModule "GHC.Int"
-pREL_WORD	= mkModule "GHC.Word"
-mONAD		= mkModule "Control.Monad"
-mONAD_FIX	= mkModule "Control.Monad.Fix"
-aRROW		= mkModule "Control.Arrow"
-aDDR		= mkModule "Addr"
-rANDOM		= mkModule "System.Random"
-
-gLA_EXTS	= mkModule "GHC.Exts"
-rOOT_MAIN	= mkModule ":Main"		-- Root module for initialisation 
-	-- The ':xxx' makes a module name that the user can never
-	-- use himself.  The z-encoding for ':' is "ZC", so the z-encoded
-	-- module name still starts with a capital letter, which keeps
-	-- the z-encoded version consistent.
-
-iNTERACTIVE    = mkModule ":Interactive"
-thFAKE         = mkModule ":THFake"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Constructing the names of tuples
-%*									*
-%************************************************************************
-
-\begin{code}
-mkTupleModule :: Boxity -> Arity -> Module
-mkTupleModule Boxed   0 = pREL_BASE
-mkTupleModule Boxed   _ = pREL_TUP
-mkTupleModule Unboxed _ = gHC_PRIM
-\end{code}
-
-
-%************************************************************************
-%*									*
-			RdrNames
-%*									*
-%************************************************************************
-
-\begin{code}
-main_RDR_Unqual 	= mkUnqual varName FSLIT("main")
-	-- We definitely don't want an Orig RdrName, because
-	-- main might, in principle, be imported into module Main
-
-eq_RDR 			= nameRdrName eqName
-ge_RDR 			= nameRdrName geName
-ne_RDR 			= varQual_RDR  pREL_BASE FSLIT("/=")
-le_RDR 			= varQual_RDR  pREL_BASE FSLIT("<=") 
-gt_RDR 			= varQual_RDR  pREL_BASE FSLIT(">")  
-compare_RDR		= varQual_RDR  pREL_BASE FSLIT("compare") 
-ltTag_RDR		= dataQual_RDR pREL_BASE FSLIT("LT") 
-eqTag_RDR		= dataQual_RDR pREL_BASE FSLIT("EQ")
-gtTag_RDR		= dataQual_RDR pREL_BASE FSLIT("GT")
-
-eqClass_RDR		= nameRdrName eqClassName
-numClass_RDR 		= nameRdrName numClassName
-ordClass_RDR 		= nameRdrName ordClassName
-enumClass_RDR		= nameRdrName enumClassName
-monadClass_RDR		= nameRdrName monadClassName
-
-map_RDR 		= varQual_RDR pREL_BASE FSLIT("map")
-append_RDR 		= varQual_RDR pREL_BASE FSLIT("++")
-
-foldr_RDR 		= nameRdrName foldrName
-build_RDR 		= nameRdrName buildName
-returnM_RDR 		= nameRdrName returnMName
-bindM_RDR 		= nameRdrName bindMName
-failM_RDR 		= nameRdrName failMName
-
-and_RDR			= nameRdrName andName
-
-left_RDR		= nameRdrName leftDataConName
-right_RDR		= nameRdrName rightDataConName
-
-fromEnum_RDR		= varQual_RDR pREL_ENUM FSLIT("fromEnum")
-toEnum_RDR		= varQual_RDR pREL_ENUM FSLIT("toEnum")
-
-enumFrom_RDR		= nameRdrName enumFromName
-enumFromTo_RDR 		= nameRdrName enumFromToName
-enumFromThen_RDR	= nameRdrName enumFromThenName
-enumFromThenTo_RDR	= nameRdrName enumFromThenToName
-
-ratioDataCon_RDR	= nameRdrName ratioDataConName
-plusInteger_RDR		= nameRdrName plusIntegerName
-timesInteger_RDR	= nameRdrName timesIntegerName
-
-ioDataCon_RDR		= nameRdrName ioDataConName
-
-eqString_RDR		= nameRdrName eqStringName
-unpackCString_RDR      	= nameRdrName unpackCStringName
-unpackCStringFoldr_RDR 	= nameRdrName unpackCStringFoldrName
-unpackCStringUtf8_RDR  	= nameRdrName unpackCStringUtf8Name
-
-newStablePtr_RDR 	= nameRdrName newStablePtrName
-addrDataCon_RDR		= dataQual_RDR aDDR FSLIT("A#")
-wordDataCon_RDR		= dataQual_RDR pREL_WORD FSLIT("W#")
-
-bindIO_RDR	  	= nameRdrName bindIOName
-returnIO_RDR	  	= nameRdrName returnIOName
-
-fromInteger_RDR		= nameRdrName fromIntegerName
-fromRational_RDR	= nameRdrName fromRationalName
-minus_RDR		= nameRdrName minusName
-times_RDR		= varQual_RDR  pREL_NUM FSLIT("*")
-plus_RDR                = varQual_RDR pREL_NUM FSLIT("+")
-
-compose_RDR		= varQual_RDR pREL_BASE FSLIT(".")
-
-not_RDR 		= varQual_RDR pREL_BASE FSLIT("not")
-getTag_RDR	 	= varQual_RDR pREL_BASE FSLIT("getTag")
-succ_RDR 		= varQual_RDR pREL_ENUM FSLIT("succ")
-pred_RDR                = varQual_RDR pREL_ENUM FSLIT("pred")
-minBound_RDR            = varQual_RDR pREL_ENUM FSLIT("minBound")
-maxBound_RDR            = varQual_RDR pREL_ENUM FSLIT("maxBound")
-range_RDR               = varQual_RDR pREL_ARR FSLIT("range")
-inRange_RDR             = varQual_RDR pREL_ARR FSLIT("inRange")
-index_RDR		= varQual_RDR pREL_ARR FSLIT("index")
-unsafeIndex_RDR		= varQual_RDR pREL_ARR FSLIT("unsafeIndex")
-unsafeRangeSize_RDR	= varQual_RDR pREL_ARR FSLIT("unsafeRangeSize")
-
-readList_RDR            = varQual_RDR pREL_READ FSLIT("readList")
-readListDefault_RDR     = varQual_RDR pREL_READ FSLIT("readListDefault")
-readListPrec_RDR        = varQual_RDR pREL_READ FSLIT("readListPrec")
-readListPrecDefault_RDR = varQual_RDR pREL_READ FSLIT("readListPrecDefault")
-readPrec_RDR            = varQual_RDR pREL_READ FSLIT("readPrec")
-parens_RDR              = varQual_RDR pREL_READ FSLIT("parens")
-choose_RDR              = varQual_RDR pREL_READ FSLIT("choose")
-lexP_RDR                = varQual_RDR pREL_READ FSLIT("lexP")
-
-punc_RDR                = dataQual_RDR lEX FSLIT("Punc")
-ident_RDR               = dataQual_RDR lEX FSLIT("Ident")
-symbol_RDR              = dataQual_RDR lEX FSLIT("Symbol")
-
-step_RDR                = varQual_RDR  rEAD_PREC FSLIT("step")
-alt_RDR                 = varQual_RDR  rEAD_PREC FSLIT("+++") 
-reset_RDR               = varQual_RDR  rEAD_PREC FSLIT("reset")
-prec_RDR                = varQual_RDR  rEAD_PREC FSLIT("prec")
-
-showList_RDR            = varQual_RDR pREL_SHOW FSLIT("showList")
-showList___RDR          = varQual_RDR pREL_SHOW FSLIT("showList__")
-showsPrec_RDR           = varQual_RDR pREL_SHOW FSLIT("showsPrec") 
-showString_RDR          = varQual_RDR pREL_SHOW FSLIT("showString")
-showSpace_RDR           = varQual_RDR pREL_SHOW FSLIT("showSpace") 
-showParen_RDR           = varQual_RDR pREL_SHOW FSLIT("showParen") 
-
-typeOf_RDR     = varQual_RDR tYPEABLE FSLIT("typeOf")
-mkTypeRep_RDR  = varQual_RDR tYPEABLE FSLIT("mkTyConApp")
-mkTyConRep_RDR = varQual_RDR tYPEABLE FSLIT("mkTyCon")
-
-undefined_RDR = varQual_RDR pREL_ERR FSLIT("undefined")
-
-crossDataCon_RDR   = dataQual_RDR pREL_BASE FSLIT(":*:")
-inlDataCon_RDR     = dataQual_RDR pREL_BASE FSLIT("Inl")
-inrDataCon_RDR     = dataQual_RDR pREL_BASE FSLIT("Inr")
-genUnitDataCon_RDR = dataQual_RDR pREL_BASE FSLIT("Unit")
-
-----------------------
-varQual_RDR  mod str = mkOrig mod (mkOccNameFS varName str)
-tcQual_RDR   mod str = mkOrig mod (mkOccNameFS tcName str)
-clsQual_RDR  mod str = mkOrig mod (mkOccNameFS clsName str)
-dataQual_RDR mod str = mkOrig mod (mkOccNameFS dataName str)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Known-key names}
-%*									*
-%************************************************************************
-
-Many of these Names are not really "built in", but some parts of the
-compiler (notably the deriving mechanism) need to mention their names,
-and it's convenient to write them all down in one place.
-
---MetaHaskell Extension  add the constrs and the lower case case
--- guys as well (perhaps) e.g. see  trueDataConName	below
-
-
-\begin{code}
-runMainIOName = varQual pREL_TOP_HANDLER FSLIT("runMainIO") runMainKey
-
-orderingTyConName = tcQual   pREL_BASE FSLIT("Ordering") orderingTyConKey
-
-eitherTyConName	  = tcQual  pREL_EITHER     FSLIT("Either") eitherTyConKey
-leftDataConName   = conName eitherTyConName FSLIT("Left")   leftDataConKey
-rightDataConName  = conName eitherTyConName FSLIT("Right")  rightDataConKey
-
--- Generics
-crossTyConName     = tcQual   pREL_BASE FSLIT(":*:") crossTyConKey
-plusTyConName      = tcQual   pREL_BASE FSLIT(":+:") plusTyConKey
-genUnitTyConName   = tcQual   pREL_BASE FSLIT("Unit") genUnitTyConKey
-
--- Base strings Strings
-unpackCStringName       = varQual pREL_BASE FSLIT("unpackCString#") unpackCStringIdKey
-unpackCStringAppendName = varQual pREL_BASE FSLIT("unpackAppendCString#") unpackCStringAppendIdKey
-unpackCStringFoldrName  = varQual pREL_BASE FSLIT("unpackFoldrCString#") unpackCStringFoldrIdKey
-unpackCStringUtf8Name   = varQual pREL_BASE FSLIT("unpackCStringUtf8#") unpackCStringUtf8IdKey
-eqStringName	 	= varQual pREL_BASE FSLIT("eqString")  eqStringIdKey
-
--- Base classes (Eq, Ord, Functor)
-eqClassName	  = clsQual pREL_BASE FSLIT("Eq")      eqClassKey
-eqName		  = methName eqClassName FSLIT("==")   eqClassOpKey
-ordClassName	  = clsQual pREL_BASE FSLIT("Ord")     ordClassKey
-geName		  = methName ordClassName FSLIT(">=")  geClassOpKey
-functorClassName  = clsQual pREL_BASE FSLIT("Functor") functorClassKey
-
--- Class Monad
-monadClassName	   = clsQual pREL_BASE FSLIT("Monad")        monadClassKey
-thenMName	   = methName monadClassName FSLIT(">>")     thenMClassOpKey
-bindMName	   = methName monadClassName FSLIT(">>=")    bindMClassOpKey
-returnMName	   = methName monadClassName FSLIT("return") returnMClassOpKey
-failMName	   = methName monadClassName FSLIT("fail")   failMClassOpKey
-
--- Random PrelBase functions
-otherwiseIdName   = varQual pREL_BASE FSLIT("otherwise")  otherwiseIdKey
-foldrName	  = varQual pREL_BASE FSLIT("foldr")      foldrIdKey
-buildName	  = varQual pREL_BASE FSLIT("build")      buildIdKey
-augmentName	  = varQual pREL_BASE FSLIT("augment")    augmentIdKey
-appendName	  = varQual pREL_BASE FSLIT("++")         appendIdKey
-andName		  = varQual pREL_BASE FSLIT("&&")	  andIdKey
-orName		  = varQual pREL_BASE FSLIT("||")	  orIdKey
-assertName        = varQual pREL_BASE FSLIT("assert")     assertIdKey
-breakpointName    = varQual pREL_BASE FSLIT("breakpoint") breakpointIdKey
-breakpointJumpName
-    = mkInternalName
-        breakpointJumpIdKey
-        (mkOccNameFS varName FSLIT("breakpointJump"))
-        noSrcLoc
-
--- PrelTup
-fstName		  = varQual pREL_TUP FSLIT("fst") fstIdKey
-sndName		  = varQual pREL_TUP FSLIT("snd") sndIdKey
-
--- Module PrelNum
-numClassName	  = clsQual pREL_NUM FSLIT("Num") numClassKey
-fromIntegerName   = methName numClassName FSLIT("fromInteger") fromIntegerClassOpKey
-minusName	  = methName numClassName FSLIT("-") minusClassOpKey
-negateName	  = methName numClassName FSLIT("negate") negateClassOpKey
-plusIntegerName   = varQual pREL_NUM FSLIT("plusInteger") plusIntegerIdKey
-timesIntegerName  = varQual pREL_NUM FSLIT("timesInteger") timesIntegerIdKey
-integerTyConName  = tcQual  pREL_NUM FSLIT("Integer") integerTyConKey
-smallIntegerDataConName = conName integerTyConName FSLIT("S#") smallIntegerDataConKey
-largeIntegerDataConName = conName integerTyConName FSLIT("J#") largeIntegerDataConKey
-
--- PrelReal types and classes
-rationalTyConName   = tcQual  pREL_REAL  FSLIT("Rational") rationalTyConKey
-ratioTyConName	    = tcQual  pREL_REAL  FSLIT("Ratio") ratioTyConKey
-ratioDataConName    = conName ratioTyConName FSLIT(":%") ratioDataConKey
-realClassName	    = clsQual pREL_REAL  FSLIT("Real") realClassKey
-integralClassName   = clsQual pREL_REAL  FSLIT("Integral") integralClassKey
-realFracClassName   = clsQual pREL_REAL  FSLIT("RealFrac") realFracClassKey
-fractionalClassName = clsQual pREL_REAL  FSLIT("Fractional") fractionalClassKey
-fromRationalName    = methName fractionalClassName  FSLIT("fromRational") fromRationalClassOpKey
-
--- PrelFloat classes
-floatingClassName  = clsQual  pREL_FLOAT FSLIT("Floating") floatingClassKey
-realFloatClassName = clsQual  pREL_FLOAT FSLIT("RealFloat") realFloatClassKey
-
--- Class Ix
-ixClassName = clsQual pREL_ARR FSLIT("Ix") ixClassKey
-
--- Class Typeable
-typeableClassName  = clsQual tYPEABLE FSLIT("Typeable") typeableClassKey
-typeable1ClassName = clsQual tYPEABLE FSLIT("Typeable1") typeable1ClassKey
-typeable2ClassName = clsQual tYPEABLE FSLIT("Typeable2") typeable2ClassKey
-typeable3ClassName = clsQual tYPEABLE FSLIT("Typeable3") typeable3ClassKey
-typeable4ClassName = clsQual tYPEABLE FSLIT("Typeable4") typeable4ClassKey
-typeable5ClassName = clsQual tYPEABLE FSLIT("Typeable5") typeable5ClassKey
-typeable6ClassName = clsQual tYPEABLE FSLIT("Typeable6") typeable6ClassKey
-typeable7ClassName = clsQual tYPEABLE FSLIT("Typeable7") typeable7ClassKey
-
-typeableClassNames = 	[ typeableClassName, typeable1ClassName, typeable2ClassName
-		 	, typeable3ClassName, typeable4ClassName, typeable5ClassName
-			, typeable6ClassName, typeable7ClassName ]
-
--- Class Data
-dataClassName = clsQual gENERICS FSLIT("Data") dataClassKey
-
--- Error module
-assertErrorName	  = varQual pREL_ERR FSLIT("assertError") assertErrorIdKey
-
--- Enum module (Enum, Bounded)
-enumClassName 	   = clsQual pREL_ENUM FSLIT("Enum") enumClassKey
-enumFromName	   = methName enumClassName FSLIT("enumFrom") enumFromClassOpKey
-enumFromToName	   = methName enumClassName FSLIT("enumFromTo") enumFromToClassOpKey
-enumFromThenName   = methName enumClassName FSLIT("enumFromThen") enumFromThenClassOpKey
-enumFromThenToName = methName enumClassName FSLIT("enumFromThenTo") enumFromThenToClassOpKey
-boundedClassName   = clsQual pREL_ENUM FSLIT("Bounded") boundedClassKey
-
--- List functions
-concatName	  = varQual pREL_LIST FSLIT("concat") concatIdKey
-filterName	  = varQual pREL_LIST FSLIT("filter") filterIdKey
-zipName	   	  = varQual pREL_LIST FSLIT("zip") zipIdKey
-
--- Class Show
-showClassName	  = clsQual pREL_SHOW FSLIT("Show")       showClassKey
-
--- Class Read
-readClassName	   = clsQual pREL_READ FSLIT("Read") readClassKey
-
--- parallel array types and functions
-enumFromToPName	   = varQual pREL_PARR FSLIT("enumFromToP") enumFromToPIdKey
-enumFromThenToPName= varQual pREL_PARR FSLIT("enumFromThenToP") enumFromThenToPIdKey
-nullPName	  = varQual pREL_PARR FSLIT("nullP")      	 nullPIdKey
-lengthPName	  = varQual pREL_PARR FSLIT("lengthP")    	 lengthPIdKey
-replicatePName	  = varQual pREL_PARR FSLIT("replicateP") 	 replicatePIdKey
-mapPName	  = varQual pREL_PARR FSLIT("mapP")       	 mapPIdKey
-filterPName	  = varQual pREL_PARR FSLIT("filterP")    	 filterPIdKey
-zipPName	  = varQual pREL_PARR FSLIT("zipP")       	 zipPIdKey
-crossPName	  = varQual pREL_PARR FSLIT("crossP")     	 crossPIdKey
-indexPName	  = varQual pREL_PARR FSLIT("!:")	       	 indexPIdKey
-toPName	          = varQual pREL_PARR FSLIT("toP")	       	 toPIdKey
-bpermutePName     = varQual pREL_PARR FSLIT("bpermuteP")    bpermutePIdKey
-bpermuteDftPName  = varQual pREL_PARR FSLIT("bpermuteDftP") bpermuteDftPIdKey
-indexOfPName      = varQual pREL_PARR FSLIT("indexOfP")     indexOfPIdKey
-
--- IOBase things
-ioTyConName	  = tcQual  pREL_IO_BASE FSLIT("IO") ioTyConKey
-ioDataConName     = conName ioTyConName  FSLIT("IO") ioDataConKey
-thenIOName	  = varQual pREL_IO_BASE FSLIT("thenIO") thenIOIdKey
-bindIOName	  = varQual pREL_IO_BASE FSLIT("bindIO") bindIOIdKey
-returnIOName	  = varQual pREL_IO_BASE FSLIT("returnIO") returnIOIdKey
-failIOName	  = varQual pREL_IO_BASE FSLIT("failIO") failIOIdKey
-
--- IO things
-printName	  = varQual sYSTEM_IO FSLIT("print") printIdKey
-
--- Int, Word, and Addr things
-int8TyConName     = tcQual pREL_INT  FSLIT("Int8") int8TyConKey
-int16TyConName    = tcQual pREL_INT  FSLIT("Int16") int16TyConKey
-int32TyConName    = tcQual pREL_INT  FSLIT("Int32") int32TyConKey
-int64TyConName    = tcQual pREL_INT  FSLIT("Int64") int64TyConKey
-
--- Word module
-word8TyConName    = tcQual  pREL_WORD FSLIT("Word8")  word8TyConKey
-word16TyConName   = tcQual  pREL_WORD FSLIT("Word16") word16TyConKey
-word32TyConName   = tcQual  pREL_WORD FSLIT("Word32") word32TyConKey
-word64TyConName   = tcQual  pREL_WORD FSLIT("Word64") word64TyConKey
-wordTyConName     = tcQual  pREL_WORD FSLIT("Word")   wordTyConKey
-wordDataConName   = conName wordTyConName FSLIT("W#") wordDataConKey
-
--- Addr module
-addrTyConName	  = tcQual   aDDR FSLIT("Addr") addrTyConKey
-
--- PrelPtr module
-ptrTyConName	  = tcQual   pREL_PTR FSLIT("Ptr") ptrTyConKey
-funPtrTyConName	  = tcQual   pREL_PTR FSLIT("FunPtr") funPtrTyConKey
-
--- Byte array types
-byteArrayTyConName	  = tcQual pREL_BYTEARR  FSLIT("ByteArray") byteArrayTyConKey
-mutableByteArrayTyConName = tcQual pREL_BYTEARR  FSLIT("MutableByteArray") mutableByteArrayTyConKey
-
--- Foreign objects and weak pointers
-stablePtrTyConName    = tcQual   pREL_STABLE FSLIT("StablePtr") stablePtrTyConKey
-newStablePtrName      = varQual  pREL_STABLE FSLIT("newStablePtr") newStablePtrIdKey
-
--- PrelST module
-runSTRepName	   = varQual pREL_ST  FSLIT("runSTRep") runSTRepIdKey
-
--- The "split" Id for splittable implicit parameters
-splittableClassName = clsQual gLA_EXTS FSLIT("Splittable") splittableClassKey
-splitName           = methName splittableClassName FSLIT("split") splitIdKey
-
--- Recursive-do notation
-monadFixClassName  = clsQual mONAD_FIX FSLIT("MonadFix") monadFixClassKey
-mfixName	   = methName monadFixClassName FSLIT("mfix") mfixIdKey
-
--- Arrow notation
-arrAName	   = varQual aRROW FSLIT("arr")	  arrAIdKey
-composeAName	   = varQual aRROW FSLIT(">>>")	  composeAIdKey
-firstAName	   = varQual aRROW FSLIT("first") firstAIdKey
-appAName	   = varQual aRROW FSLIT("app")	  appAIdKey
-choiceAName	   = varQual aRROW FSLIT("|||")	  choiceAIdKey
-loopAName	   = varQual aRROW FSLIT("loop")  loopAIdKey
-
--- Other classes, needed for type defaulting
-monadPlusClassName  = clsQual mONAD FSLIT("MonadPlus")  monadPlusClassKey
-randomClassName     = clsQual rANDOM FSLIT("Random")    randomClassKey
-randomGenClassName  = clsQual rANDOM FSLIT("RandomGen") randomGenClassKey
-
--- dotnet interop
-objectTyConName	    = tcQual   dOTNET FSLIT("Object") objectTyConKey
-	-- objectTyConName was "wTcQual", but that's gone now, and
-	-- I can't see why it was wired in anyway...
-unmarshalObjectName = varQual  dOTNET FSLIT("unmarshalObject") unmarshalObjectIdKey
-marshalObjectName   = varQual  dOTNET FSLIT("marshalObject") marshalObjectIdKey
-marshalStringName   = varQual  dOTNET FSLIT("marshalString") marshalStringIdKey
-unmarshalStringName = varQual  dOTNET FSLIT("unmarshalString") unmarshalStringIdKey
-checkDotnetResName  = varQual  dOTNET FSLIT("checkResult")     checkDotnetResNameIdKey
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Local helpers}
-%*									*
-%************************************************************************
-
-All these are original names; hence mkOrig
-
-\begin{code}
-varQual  = mk_known_key_name varName
-tcQual   = mk_known_key_name tcName
-clsQual  = mk_known_key_name clsName
-
-mk_known_key_name space mod str uniq 
-  = mkExternalName uniq mod (mkOccNameFS space str) 
-		   Nothing noSrcLoc
-
-conName :: Name -> FastString -> Unique -> Name
-conName tycon occ uniq
-  = mkExternalName uniq (nameModule tycon) (mkOccNameFS dataName occ) 
-		   (Just tycon) noSrcLoc
-
-methName :: Name -> FastString -> Unique -> Name
-methName cls occ uniq
-  = mkExternalName uniq (nameModule cls) (mkVarOccFS occ) 
-		   (Just cls) noSrcLoc
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection[Uniques-prelude-Classes]{@Uniques@ for wired-in @Classes@}
-%*									*
-%************************************************************************
---MetaHaskell extension hand allocate keys here
-
-\begin{code}
-boundedClassKey		= mkPreludeClassUnique 1 
-enumClassKey		= mkPreludeClassUnique 2 
-eqClassKey		= mkPreludeClassUnique 3 
-floatingClassKey	= mkPreludeClassUnique 5 
-fractionalClassKey	= mkPreludeClassUnique 6 
-integralClassKey	= mkPreludeClassUnique 7 
-monadClassKey		= mkPreludeClassUnique 8 
-dataClassKey		= mkPreludeClassUnique 9
-functorClassKey		= mkPreludeClassUnique 10
-numClassKey		= mkPreludeClassUnique 11
-ordClassKey		= mkPreludeClassUnique 12
-readClassKey		= mkPreludeClassUnique 13
-realClassKey		= mkPreludeClassUnique 14
-realFloatClassKey	= mkPreludeClassUnique 15
-realFracClassKey	= mkPreludeClassUnique 16
-showClassKey		= mkPreludeClassUnique 17
-ixClassKey		= mkPreludeClassUnique 18
-
-typeableClassKey	= mkPreludeClassUnique 20
-typeable1ClassKey	= mkPreludeClassUnique 21
-typeable2ClassKey	= mkPreludeClassUnique 22
-typeable3ClassKey	= mkPreludeClassUnique 23
-typeable4ClassKey	= mkPreludeClassUnique 24
-typeable5ClassKey	= mkPreludeClassUnique 25
-typeable6ClassKey	= mkPreludeClassUnique 26
-typeable7ClassKey	= mkPreludeClassUnique 27
-
-monadFixClassKey	= mkPreludeClassUnique 28
-splittableClassKey	= mkPreludeClassUnique 29
-
-monadPlusClassKey	= mkPreludeClassUnique 30
-randomClassKey		= mkPreludeClassUnique 31
-randomGenClassKey	= mkPreludeClassUnique 32
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection[Uniques-prelude-TyCons]{@Uniques@ for wired-in @TyCons@}
-%*									*
-%************************************************************************
-
-\begin{code}
-addrPrimTyConKey			= mkPreludeTyConUnique	1
-addrTyConKey				= mkPreludeTyConUnique	2
-arrayPrimTyConKey			= mkPreludeTyConUnique	3
-boolTyConKey				= mkPreludeTyConUnique	4
-byteArrayPrimTyConKey			= mkPreludeTyConUnique	5
-charPrimTyConKey			= mkPreludeTyConUnique	7
-charTyConKey				= mkPreludeTyConUnique  8
-doublePrimTyConKey			= mkPreludeTyConUnique  9
-doubleTyConKey				= mkPreludeTyConUnique 10 
-floatPrimTyConKey			= mkPreludeTyConUnique 11
-floatTyConKey				= mkPreludeTyConUnique 12
-funTyConKey				= mkPreludeTyConUnique 13
-intPrimTyConKey				= mkPreludeTyConUnique 14
-intTyConKey				= mkPreludeTyConUnique 15
-int8TyConKey				= mkPreludeTyConUnique 16
-int16TyConKey				= mkPreludeTyConUnique 17
-int32PrimTyConKey			= mkPreludeTyConUnique 18
-int32TyConKey				= mkPreludeTyConUnique 19
-int64PrimTyConKey			= mkPreludeTyConUnique 20
-int64TyConKey				= mkPreludeTyConUnique 21
-integerTyConKey				= mkPreludeTyConUnique 22
-listTyConKey				= mkPreludeTyConUnique 23
-foreignObjPrimTyConKey			= mkPreludeTyConUnique 24
-weakPrimTyConKey			= mkPreludeTyConUnique 27
-mutableArrayPrimTyConKey		= mkPreludeTyConUnique 28
-mutableByteArrayPrimTyConKey		= mkPreludeTyConUnique 29
-orderingTyConKey			= mkPreludeTyConUnique 30
-mVarPrimTyConKey		    	= mkPreludeTyConUnique 31
-ratioTyConKey				= mkPreludeTyConUnique 32
-rationalTyConKey			= mkPreludeTyConUnique 33
-realWorldTyConKey			= mkPreludeTyConUnique 34
-stablePtrPrimTyConKey			= mkPreludeTyConUnique 35
-stablePtrTyConKey			= mkPreludeTyConUnique 36
-statePrimTyConKey			= mkPreludeTyConUnique 50
-stableNamePrimTyConKey			= mkPreludeTyConUnique 51
-stableNameTyConKey		        = mkPreludeTyConUnique 52
-mutableByteArrayTyConKey		= mkPreludeTyConUnique 53
-mutVarPrimTyConKey			= mkPreludeTyConUnique 55
-ioTyConKey				= mkPreludeTyConUnique 56
-byteArrayTyConKey			= mkPreludeTyConUnique 57
-wordPrimTyConKey			= mkPreludeTyConUnique 58
-wordTyConKey				= mkPreludeTyConUnique 59
-word8TyConKey				= mkPreludeTyConUnique 60
-word16TyConKey				= mkPreludeTyConUnique 61 
-word32PrimTyConKey			= mkPreludeTyConUnique 62 
-word32TyConKey				= mkPreludeTyConUnique 63
-word64PrimTyConKey			= mkPreludeTyConUnique 64
-word64TyConKey				= mkPreludeTyConUnique 65
-liftedConKey				= mkPreludeTyConUnique 66
-unliftedConKey				= mkPreludeTyConUnique 67
-anyBoxConKey				= mkPreludeTyConUnique 68
-kindConKey				= mkPreludeTyConUnique 69
-boxityConKey				= mkPreludeTyConUnique 70
-typeConKey				= mkPreludeTyConUnique 71
-threadIdPrimTyConKey			= mkPreludeTyConUnique 72
-bcoPrimTyConKey				= mkPreludeTyConUnique 73
-ptrTyConKey				= mkPreludeTyConUnique 74
-funPtrTyConKey				= mkPreludeTyConUnique 75
-tVarPrimTyConKey		    	= mkPreludeTyConUnique 76
-
--- Generic Type Constructors
-crossTyConKey		      		= mkPreludeTyConUnique 79
-plusTyConKey		      		= mkPreludeTyConUnique 80
-genUnitTyConKey				= mkPreludeTyConUnique 81
-
--- Parallel array type constructor
-parrTyConKey				= mkPreludeTyConUnique 82
-
--- dotnet interop
-objectTyConKey				= mkPreludeTyConUnique 83
-
-eitherTyConKey				= mkPreludeTyConUnique 84
-
----------------- Template Haskell -------------------
---	USES TyConUniques 100-129
------------------------------------------------------
-
-unitTyConKey = mkTupleTyConUnique Boxed 0
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection[Uniques-prelude-DataCons]{@Uniques@ for wired-in @DataCons@}
-%*									*
-%************************************************************************
-
-\begin{code}
-charDataConKey				= mkPreludeDataConUnique  1
-consDataConKey				= mkPreludeDataConUnique  2
-doubleDataConKey			= mkPreludeDataConUnique  3
-falseDataConKey				= mkPreludeDataConUnique  4
-floatDataConKey				= mkPreludeDataConUnique  5
-intDataConKey				= mkPreludeDataConUnique  6
-smallIntegerDataConKey			= mkPreludeDataConUnique  7
-largeIntegerDataConKey			= mkPreludeDataConUnique  8
-nilDataConKey				= mkPreludeDataConUnique 11
-ratioDataConKey				= mkPreludeDataConUnique 12
-stableNameDataConKey			= mkPreludeDataConUnique 14
-trueDataConKey				= mkPreludeDataConUnique 15
-wordDataConKey				= mkPreludeDataConUnique 16
-ioDataConKey				= mkPreludeDataConUnique 17
-
--- Generic data constructors
-crossDataConKey		      		= mkPreludeDataConUnique 20
-inlDataConKey		      		= mkPreludeDataConUnique 21
-inrDataConKey		      		= mkPreludeDataConUnique 22
-genUnitDataConKey			= mkPreludeDataConUnique 23
-
--- Data constructor for parallel arrays
-parrDataConKey				= mkPreludeDataConUnique 24
-
-leftDataConKey				= mkPreludeDataConUnique 25
-rightDataConKey				= mkPreludeDataConUnique 26
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection[Uniques-prelude-Ids]{@Uniques@ for wired-in @Ids@ (except @DataCons@)}
-%*									*
-%************************************************************************
-
-\begin{code}
-absentErrorIdKey	      = mkPreludeMiscIdUnique  1
-augmentIdKey		      = mkPreludeMiscIdUnique  3
-appendIdKey		      = mkPreludeMiscIdUnique  4
-buildIdKey		      = mkPreludeMiscIdUnique  5
-errorIdKey		      = mkPreludeMiscIdUnique  6
-foldlIdKey		      = mkPreludeMiscIdUnique  7
-foldrIdKey		      = mkPreludeMiscIdUnique  8
-recSelErrorIdKey	      = mkPreludeMiscIdUnique  9
-integerMinusOneIdKey	      = mkPreludeMiscIdUnique 10
-integerPlusOneIdKey	      = mkPreludeMiscIdUnique 11
-integerPlusTwoIdKey	      = mkPreludeMiscIdUnique 12
-integerZeroIdKey	      = mkPreludeMiscIdUnique 13
-int2IntegerIdKey	      = mkPreludeMiscIdUnique 14
-seqIdKey		      = mkPreludeMiscIdUnique 15
-irrefutPatErrorIdKey	      = mkPreludeMiscIdUnique 16
-eqStringIdKey		      = mkPreludeMiscIdUnique 17
-noMethodBindingErrorIdKey     = mkPreludeMiscIdUnique 18
-nonExhaustiveGuardsErrorIdKey = mkPreludeMiscIdUnique 19
-runtimeErrorIdKey	      = mkPreludeMiscIdUnique 20 
-parErrorIdKey		      = mkPreludeMiscIdUnique 21
-parIdKey		      = mkPreludeMiscIdUnique 22
-patErrorIdKey		      = mkPreludeMiscIdUnique 23
-realWorldPrimIdKey	      = mkPreludeMiscIdUnique 24
-recConErrorIdKey	      = mkPreludeMiscIdUnique 25
-recUpdErrorIdKey	      = mkPreludeMiscIdUnique 26
-traceIdKey		      = mkPreludeMiscIdUnique 27
-unpackCStringUtf8IdKey	      = mkPreludeMiscIdUnique 28
-unpackCStringAppendIdKey      = mkPreludeMiscIdUnique 29
-unpackCStringFoldrIdKey	      = mkPreludeMiscIdUnique 30
-unpackCStringIdKey	      = mkPreludeMiscIdUnique 31
-
-unsafeCoerceIdKey	      = mkPreludeMiscIdUnique 32
-concatIdKey		      = mkPreludeMiscIdUnique 33
-filterIdKey		      = mkPreludeMiscIdUnique 34
-zipIdKey		      = mkPreludeMiscIdUnique 35
-bindIOIdKey		      = mkPreludeMiscIdUnique 36
-returnIOIdKey		      = mkPreludeMiscIdUnique 37
-deRefStablePtrIdKey	      = mkPreludeMiscIdUnique 38
-newStablePtrIdKey	      = mkPreludeMiscIdUnique 39
-plusIntegerIdKey	      = mkPreludeMiscIdUnique 41
-timesIntegerIdKey	      = mkPreludeMiscIdUnique 42
-printIdKey		      = mkPreludeMiscIdUnique 43
-failIOIdKey		      = mkPreludeMiscIdUnique 44
-nullAddrIdKey		      = mkPreludeMiscIdUnique 46
-voidArgIdKey		      = mkPreludeMiscIdUnique 47
-splitIdKey		      = mkPreludeMiscIdUnique 48
-fstIdKey		      = mkPreludeMiscIdUnique 49
-sndIdKey		      = mkPreludeMiscIdUnique 50
-otherwiseIdKey		      = mkPreludeMiscIdUnique 51
-assertIdKey		      = mkPreludeMiscIdUnique 53
-runSTRepIdKey		      = mkPreludeMiscIdUnique 54
-
-rootMainKey		      = mkPreludeMiscIdUnique 55
-runMainKey		      = mkPreludeMiscIdUnique 56
-
-andIdKey		      = mkPreludeMiscIdUnique 57
-orIdKey			      = mkPreludeMiscIdUnique 58
-thenIOIdKey		      = mkPreludeMiscIdUnique 59
-lazyIdKey		      = mkPreludeMiscIdUnique 60
-assertErrorIdKey	      = mkPreludeMiscIdUnique 61
-
-breakpointIdKey               = mkPreludeMiscIdUnique 62
-breakpointJumpIdKey           = mkPreludeMiscIdUnique 63
-
--- Parallel array functions
-nullPIdKey	              = mkPreludeMiscIdUnique 80
-lengthPIdKey		      = mkPreludeMiscIdUnique 81
-replicatePIdKey		      = mkPreludeMiscIdUnique 82
-mapPIdKey		      = mkPreludeMiscIdUnique 83
-filterPIdKey		      = mkPreludeMiscIdUnique 84
-zipPIdKey		      = mkPreludeMiscIdUnique 85
-crossPIdKey		      = mkPreludeMiscIdUnique 86
-indexPIdKey		      = mkPreludeMiscIdUnique 87
-toPIdKey		      = mkPreludeMiscIdUnique 88
-enumFromToPIdKey              = mkPreludeMiscIdUnique 89
-enumFromThenToPIdKey          = mkPreludeMiscIdUnique 90
-bpermutePIdKey		      = mkPreludeMiscIdUnique 91
-bpermuteDftPIdKey	      = mkPreludeMiscIdUnique 92
-indexOfPIdKey		      = mkPreludeMiscIdUnique 93
-
--- dotnet interop
-unmarshalObjectIdKey          = mkPreludeMiscIdUnique 94
-marshalObjectIdKey            = mkPreludeMiscIdUnique 95
-marshalStringIdKey            = mkPreludeMiscIdUnique 96
-unmarshalStringIdKey          = mkPreludeMiscIdUnique 97
-checkDotnetResNameIdKey       = mkPreludeMiscIdUnique 98
-
-\end{code}
-
-Certain class operations from Prelude classes.  They get their own
-uniques so we can look them up easily when we want to conjure them up
-during type checking.
-
-\begin{code}
-	-- Just a place holder for  unbound variables  produced by the renamer:
-unboundKey		      = mkPreludeMiscIdUnique 101 
-
-fromIntegerClassOpKey	      = mkPreludeMiscIdUnique 102
-minusClassOpKey		      = mkPreludeMiscIdUnique 103
-fromRationalClassOpKey	      = mkPreludeMiscIdUnique 104
-enumFromClassOpKey	      = mkPreludeMiscIdUnique 105
-enumFromThenClassOpKey	      = mkPreludeMiscIdUnique 106
-enumFromToClassOpKey	      = mkPreludeMiscIdUnique 107
-enumFromThenToClassOpKey      = mkPreludeMiscIdUnique 108
-eqClassOpKey		      = mkPreludeMiscIdUnique 109
-geClassOpKey		      = mkPreludeMiscIdUnique 110
-negateClassOpKey	      = mkPreludeMiscIdUnique 111
-failMClassOpKey		      = mkPreludeMiscIdUnique 112
-bindMClassOpKey		      = mkPreludeMiscIdUnique 113 -- (>>=)
-thenMClassOpKey		      = mkPreludeMiscIdUnique 114 -- (>>)
-returnMClassOpKey	      = mkPreludeMiscIdUnique 117
-
--- Recursive do notation
-mfixIdKey	= mkPreludeMiscIdUnique 118
-
--- Arrow notation
-arrAIdKey	= mkPreludeMiscIdUnique 119
-composeAIdKey	= mkPreludeMiscIdUnique 120 -- >>>
-firstAIdKey	= mkPreludeMiscIdUnique 121
-appAIdKey	= mkPreludeMiscIdUnique 122
-choiceAIdKey	= mkPreludeMiscIdUnique 123 --  |||
-loopAIdKey	= mkPreludeMiscIdUnique 124
-
----------------- Template Haskell -------------------
---	USES IdUniques 200-399
------------------------------------------------------
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Standard groups of types}
-%*									*
-%************************************************************************
-
-\begin{code}
-numericTyKeys = 
-	[ addrTyConKey
-	, wordTyConKey
-	, intTyConKey
-	, integerTyConKey
-	, doubleTyConKey
-	, floatTyConKey
-	]
-
-	-- Renamer always imports these data decls replete with constructors
-	-- so that desugarer can always see their constructors.  Ugh!
-cCallishTyKeys = 
-	[ addrTyConKey
-	, wordTyConKey
-	, byteArrayTyConKey
-	, mutableByteArrayTyConKey
-	, stablePtrTyConKey
-	, int8TyConKey
-	, int16TyConKey
-	, int32TyConKey
-	, int64TyConKey
-	, word8TyConKey
-	, word16TyConKey
-	, word32TyConKey
-	, word64TyConKey
-	]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Class-std-groups]{Standard groups of Prelude classes}
-%*									*
-%************************************************************************
-
-NOTE: @Eq@ and @Text@ do need to appear in @standardClasses@
-even though every numeric class has these two as a superclass,
-because the list of ambiguous dictionaries hasn't been simplified.
-
-\begin{code}
-numericClassKeys =
-	[ numClassKey
-    	, realClassKey
-    	, integralClassKey
-	]
-	++ fractionalClassKeys
-
-fractionalClassKeys = 
-    	[ fractionalClassKey
-    	, floatingClassKey
-    	, realFracClassKey
-    	, realFloatClassKey
-    	]
-
-	-- the strictness analyser needs to know about numeric types
-	-- (see SaAbsInt.lhs)
-needsDataDeclCtxtClassKeys = -- see comments in TcDeriv
-  	[ readClassKey
-    	]
-
--- The "standard classes" are used in defaulting (Haskell 98 report 4.3.4),
--- and are: "classes defined in the Prelude or a standard library"
-standardClassKeys = derivableClassKeys ++ numericClassKeys
-		  ++ [randomClassKey, randomGenClassKey,
-		      functorClassKey, 
-		      monadClassKey, monadPlusClassKey]
-\end{code}
-
-@derivableClassKeys@ is also used in checking \tr{deriving} constructs
-(@TcDeriv@).
-
-\begin{code}
-derivableClassKeys
-  = [ eqClassKey, ordClassKey, enumClassKey, ixClassKey,
-      boundedClassKey, showClassKey, readClassKey ]
-\end{code}
-
diff --git a/ghc/compiler/prelude/PrelRules.lhs b/ghc/compiler/prelude/PrelRules.lhs
deleted file mode 100644
index 9cdddc9065..0000000000
--- a/ghc/compiler/prelude/PrelRules.lhs
+++ /dev/null
@@ -1,447 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[ConFold]{Constant Folder}
-
-Conceptually, constant folding should be parameterized with the kind
-of target machine to get identical behaviour during compilation time
-and runtime. We cheat a little bit here...
-
-ToDo:
-   check boundaries before folding, e.g. we can fold the Float addition
-   (i1 + i2) only if it results	in a valid Float.
-
-\begin{code}
-
-{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
-
-module PrelRules ( primOpRules, builtinRules ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-import Id		( mkWildId, isPrimOpId_maybe )
-import Literal		( Literal(..), mkMachInt, mkMachWord
-			, literalType
-			, word2IntLit, int2WordLit
-			, narrow8IntLit, narrow16IntLit, narrow32IntLit
-			, narrow8WordLit, narrow16WordLit, narrow32WordLit
-			, char2IntLit, int2CharLit
-			, float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
-			, float2DoubleLit, double2FloatLit
-			)
-import PrimOp		( PrimOp(..), primOpOcc )
-import TysWiredIn	( boolTy, trueDataConId, falseDataConId )
-import TyCon		( tyConDataCons_maybe, isEnumerationTyCon, isNewTyCon )
-import DataCon		( dataConTag, dataConTyCon, dataConWorkId, fIRST_TAG )
-import CoreUtils	( cheapEqExpr, exprIsConApp_maybe )
-import Type		( tyConAppTyCon, coreEqType )
-import OccName		( occNameFS )
-import PrelNames	( unpackCStringFoldrName, unpackCStringFoldrIdKey, hasKey,
-			  eqStringName, unpackCStringIdKey )
-import Maybes		( orElse )
-import Name		( Name )
-import Outputable
-import FastString
-import StaticFlags      ( opt_SimplExcessPrecision )
-
-import DATA_BITS	( Bits(..) )
-#if __GLASGOW_HASKELL__ >= 500
-import DATA_WORD	( Word )
-#else
-import DATA_WORD	( Word64 )
-#endif
-\end{code}
-
-
-\begin{code}
-primOpRules :: PrimOp -> Name -> [CoreRule]
-primOpRules op op_name = primop_rule op
-  where
-    rule_name = occNameFS (primOpOcc op)
-    rule_name_case = rule_name `appendFS` FSLIT("->case")
-
-	-- A useful shorthand
-    one_rule rule_fn = [BuiltinRule { ru_name = rule_name, 
-				      ru_fn = op_name, 
-				      ru_try = rule_fn }]
-    case_rule rule_fn = [BuiltinRule { ru_name = rule_name_case, 
-				       ru_fn = op_name, 
-				       ru_try = rule_fn }]
-
-    -- ToDo:	something for integer-shift ops?
-    --		NotOp
-
-    primop_rule TagToEnumOp = one_rule tagToEnumRule
-    primop_rule DataToTagOp = one_rule dataToTagRule
-
-	-- Int operations
-    primop_rule IntAddOp    = one_rule (twoLits (intOp2     (+)))
-    primop_rule IntSubOp    = one_rule (twoLits (intOp2     (-)))
-    primop_rule IntMulOp    = one_rule (twoLits (intOp2     (*)))
-    primop_rule IntQuotOp   = one_rule (twoLits (intOp2Z    quot))
-    primop_rule IntRemOp    = one_rule (twoLits (intOp2Z    rem))
-    primop_rule IntNegOp    = one_rule (oneLit  negOp)
-
-	-- Word operations
-#if __GLASGOW_HASKELL__ >= 500
-    primop_rule WordAddOp   = one_rule (twoLits (wordOp2    (+)))
-    primop_rule WordSubOp   = one_rule (twoLits (wordOp2    (-)))
-    primop_rule WordMulOp   = one_rule (twoLits (wordOp2    (*)))
-#endif
-    primop_rule WordQuotOp  = one_rule (twoLits (wordOp2Z   quot))
-    primop_rule WordRemOp   = one_rule (twoLits (wordOp2Z   rem))
-#if __GLASGOW_HASKELL__ >= 407
-    primop_rule AndOp       = one_rule (twoLits (wordBitOp2 (.&.)))
-    primop_rule OrOp        = one_rule (twoLits (wordBitOp2 (.|.)))
-    primop_rule XorOp       = one_rule (twoLits (wordBitOp2 xor))
-#endif
-
-	-- coercions
-    primop_rule Word2IntOp 	= one_rule (oneLit (litCoerce word2IntLit))
-    primop_rule Int2WordOp 	= one_rule (oneLit (litCoerce int2WordLit))
-    primop_rule Narrow8IntOp 	= one_rule (oneLit (litCoerce narrow8IntLit))
-    primop_rule Narrow16IntOp 	= one_rule (oneLit (litCoerce narrow16IntLit))
-    primop_rule Narrow32IntOp 	= one_rule (oneLit (litCoerce narrow32IntLit))
-    primop_rule Narrow8WordOp 	= one_rule (oneLit (litCoerce narrow8WordLit))
-    primop_rule Narrow16WordOp 	= one_rule (oneLit (litCoerce narrow16WordLit))
-    primop_rule Narrow32WordOp 	= one_rule (oneLit (litCoerce narrow32WordLit))
-    primop_rule OrdOp   	= one_rule (oneLit (litCoerce char2IntLit))
-    primop_rule ChrOp    	= one_rule (oneLit (litCoerce int2CharLit))
-    primop_rule Float2IntOp	= one_rule (oneLit (litCoerce float2IntLit))
-    primop_rule Int2FloatOp	= one_rule (oneLit (litCoerce int2FloatLit))
-    primop_rule Double2IntOp	= one_rule (oneLit (litCoerce double2IntLit))
-    primop_rule Int2DoubleOp	= one_rule (oneLit (litCoerce int2DoubleLit))
-	-- SUP: Not sure what the standard says about precision in the following 2 cases
-    primop_rule Float2DoubleOp 	= one_rule (oneLit (litCoerce float2DoubleLit))
-    primop_rule Double2FloatOp 	= one_rule (oneLit (litCoerce double2FloatLit))
-
-	-- Float
-    primop_rule FloatAddOp   = one_rule (twoLits (floatOp2  (+)))
-    primop_rule FloatSubOp   = one_rule (twoLits (floatOp2  (-)))
-    primop_rule FloatMulOp   = one_rule (twoLits (floatOp2  (*)))
-    primop_rule FloatDivOp   = one_rule (twoLits (floatOp2Z (/)))
-    primop_rule FloatNegOp   = one_rule (oneLit  negOp)
-
-	-- Double
-    primop_rule DoubleAddOp   = one_rule (twoLits (doubleOp2  (+)))
-    primop_rule DoubleSubOp   = one_rule (twoLits (doubleOp2  (-)))
-    primop_rule DoubleMulOp   = one_rule (twoLits (doubleOp2  (*)))
-    primop_rule DoubleDivOp   = one_rule (twoLits (doubleOp2Z (/)))
-    primop_rule DoubleNegOp   = one_rule (oneLit  negOp)
-
-	-- Relational operators
-    primop_rule IntEqOp  = one_rule (relop (==)) ++ case_rule (litEq True)
-    primop_rule IntNeOp  = one_rule (relop (/=)) ++ case_rule (litEq False)
-    primop_rule CharEqOp = one_rule (relop (==)) ++ case_rule (litEq True)
-    primop_rule CharNeOp = one_rule (relop (/=)) ++ case_rule (litEq False)
-
-    primop_rule IntGtOp		= one_rule (relop (>))
-    primop_rule IntGeOp		= one_rule (relop (>=))
-    primop_rule IntLeOp		= one_rule (relop (<=))
-    primop_rule IntLtOp		= one_rule (relop (<))
-
-    primop_rule CharGtOp	= one_rule (relop (>))
-    primop_rule CharGeOp	= one_rule (relop (>=))
-    primop_rule CharLeOp	= one_rule (relop (<=))
-    primop_rule CharLtOp	= one_rule (relop (<))
-
-    primop_rule FloatGtOp	= one_rule (relop (>))
-    primop_rule FloatGeOp	= one_rule (relop (>=))
-    primop_rule FloatLeOp	= one_rule (relop (<=))
-    primop_rule FloatLtOp	= one_rule (relop (<))
-    primop_rule FloatEqOp	= one_rule (relop (==))
-    primop_rule FloatNeOp	= one_rule (relop (/=))
-
-    primop_rule DoubleGtOp	= one_rule (relop (>))
-    primop_rule DoubleGeOp	= one_rule (relop (>=))
-    primop_rule DoubleLeOp	= one_rule (relop (<=))
-    primop_rule DoubleLtOp	= one_rule (relop (<))
-    primop_rule DoubleEqOp	= one_rule (relop (==))
-    primop_rule DoubleNeOp	= one_rule (relop (/=))
-
-    primop_rule WordGtOp	= one_rule (relop (>))
-    primop_rule WordGeOp	= one_rule (relop (>=))
-    primop_rule WordLeOp	= one_rule (relop (<=))
-    primop_rule WordLtOp	= one_rule (relop (<))
-    primop_rule WordEqOp	= one_rule (relop (==))
-    primop_rule WordNeOp	= one_rule (relop (/=))
-
-    primop_rule other		= []
-
-
-    relop cmp = twoLits (cmpOp (\ord -> ord `cmp` EQ))
-	-- Cunning.  cmpOp compares the values to give an Ordering.
-	-- It applies its argument to that ordering value to turn
-	-- the ordering into a boolean value.  (`cmp` EQ) is just the job.
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Doing the business}
-%*									*
-%************************************************************************
-
-ToDo: the reason these all return Nothing is because there used to be
-the possibility of an argument being a litlit.  Litlits are now gone,
-so this could be cleaned up.
-
-\begin{code}
---------------------------
-litCoerce :: (Literal -> Literal) -> Literal -> Maybe CoreExpr
-litCoerce fn lit = Just (Lit (fn lit))
-
---------------------------
-cmpOp :: (Ordering -> Bool) -> Literal -> Literal -> Maybe CoreExpr
-cmpOp cmp l1 l2
-  = go l1 l2
-  where
-    done res | cmp res   = Just trueVal
-	     | otherwise = Just falseVal
-
-	-- These compares are at different types
-    go (MachChar i1)   (MachChar i2)   = done (i1 `compare` i2)
-    go (MachInt i1)    (MachInt i2)    = done (i1 `compare` i2)
-    go (MachInt64 i1)  (MachInt64 i2)  = done (i1 `compare` i2)
-    go (MachWord i1)   (MachWord i2)   = done (i1 `compare` i2)
-    go (MachWord64 i1) (MachWord64 i2) = done (i1 `compare` i2)
-    go (MachFloat i1)  (MachFloat i2)  = done (i1 `compare` i2)
-    go (MachDouble i1) (MachDouble i2) = done (i1 `compare` i2)
-    go l1	       l2	       = Nothing
-
---------------------------
-
-negOp (MachFloat 0.0) = Nothing  -- can't represent -0.0 as a Rational
-negOp (MachFloat f)   = Just (mkFloatVal (-f))
-negOp (MachDouble 0.0) = Nothing
-negOp (MachDouble d)   = Just (mkDoubleVal (-d))
-negOp (MachInt i)      = intResult (-i)
-negOp l		       = Nothing
-
---------------------------
-intOp2 op (MachInt i1) (MachInt i2) = intResult (i1 `op` i2)
-intOp2 op l1	       l2	    = Nothing		-- Could find LitLit
-
-intOp2Z op (MachInt i1) (MachInt i2)
-  | i2 /= 0 = Just (mkIntVal (i1 `op` i2))
-intOp2Z op l1 l2 = Nothing		-- LitLit or zero dividend
-
---------------------------
-#if __GLASGOW_HASKELL__ >= 500
-wordOp2 op (MachWord w1) (MachWord w2)
-  = wordResult (w1 `op` w2)
-wordOp2 op l1 l2 = Nothing		-- Could find LitLit
-#endif
-
-wordOp2Z op (MachWord w1) (MachWord w2)
-  | w2 /= 0 = Just (mkWordVal (w1 `op` w2))
-wordOp2Z op l1 l2 = Nothing	-- LitLit or zero dividend
-
-#if __GLASGOW_HASKELL__ >= 500
-wordBitOp2 op l1@(MachWord w1) l2@(MachWord w2)
-  = Just (mkWordVal (w1 `op` w2))
-#else
--- Integer is not an instance of Bits, so we operate on Word64
-wordBitOp2 op l1@(MachWord w1) l2@(MachWord w2)
-  = Just (mkWordVal ((fromIntegral::Word64->Integer) (fromIntegral w1 `op` fromIntegral w2)))
-#endif
-wordBitOp2 op l1 l2 = Nothing		-- Could find LitLit
-
---------------------------
-floatOp2  op (MachFloat f1) (MachFloat f2)
-  = Just (mkFloatVal (f1 `op` f2))
-floatOp2  op l1 l2 = Nothing
-
-floatOp2Z op (MachFloat f1) (MachFloat f2)
-  | f2 /= 0   = Just (mkFloatVal (f1 `op` f2))
-floatOp2Z op l1 l2 = Nothing
-
---------------------------
-doubleOp2  op (MachDouble f1) (MachDouble f2)
-  = Just (mkDoubleVal (f1 `op` f2))
-doubleOp2 op l1 l2 = Nothing
-
-doubleOp2Z op (MachDouble f1) (MachDouble f2)
-  | f2 /= 0   = Just (mkDoubleVal (f1 `op` f2))
-doubleOp2Z op l1 l2 = Nothing
-
-
---------------------------
-	-- This stuff turns
-	--	n ==# 3#
-	-- into
-	--	case n of
-	--	  3# -> True
-	--	  m  -> False
-	--
-	-- This is a Good Thing, because it allows case-of case things
-	-- to happen, and case-default absorption to happen.  For
-	-- example:
-	--
-	--	if (n ==# 3#) || (n ==# 4#) then e1 else e2
-	-- will transform to
-	--	case n of
-	--	  3# -> e1
-	--	  4# -> e1
-	--	  m  -> e2
-	-- (modulo the usual precautions to avoid duplicating e1)
-
-litEq :: Bool		-- True <=> equality, False <=> inequality
-      -> RuleFun
-litEq is_eq [Lit lit, expr] = do_lit_eq is_eq lit expr
-litEq is_eq [expr, Lit lit] = do_lit_eq is_eq lit expr
-litEq is_eq other	    = Nothing
-
-do_lit_eq is_eq lit expr
-  = Just (Case expr (mkWildId (literalType lit)) boolTy
-		[(DEFAULT,    [], val_if_neq),
-		 (LitAlt lit, [], val_if_eq)])
-  where
-    val_if_eq  | is_eq     = trueVal
-	       | otherwise = falseVal
-    val_if_neq | is_eq     = falseVal
-	       | otherwise = trueVal
-
--- Note that we *don't* warn the user about overflow. It's not done at
--- runtime either, and compilation of completely harmless things like
---    ((124076834 :: Word32) + (2147483647 :: Word32))
--- would yield a warning. Instead we simply squash the value into the
--- Int range, but not in a way suitable for cross-compiling... :-(
-intResult :: Integer -> Maybe CoreExpr
-intResult result
-  = Just (mkIntVal (toInteger (fromInteger result :: Int)))
-
-#if __GLASGOW_HASKELL__ >= 500
-wordResult :: Integer -> Maybe CoreExpr
-wordResult result
-  = Just (mkWordVal (toInteger (fromInteger result :: Word)))
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Vaguely generic functions
-%*									*
-%************************************************************************
-
-\begin{code}
-type RuleFun = [CoreExpr] -> Maybe CoreExpr
-
-twoLits :: (Literal -> Literal -> Maybe CoreExpr) -> RuleFun
-twoLits rule [Lit l1, Lit l2] = rule (convFloating l1) (convFloating l2)
-twoLits rule _                = Nothing
-
-oneLit :: (Literal -> Maybe CoreExpr) -> RuleFun
-oneLit rule [Lit l1] = rule (convFloating l1)
-oneLit rule _        = Nothing
-
--- When excess precision is not requested, cut down the precision of the
--- Rational value to that of Float/Double. We confuse host architecture
--- and target architecture here, but it's convenient (and wrong :-).
-convFloating :: Literal -> Literal
-convFloating (MachFloat  f) | not opt_SimplExcessPrecision =
-   MachFloat  (toRational ((fromRational f) :: Float ))
-convFloating (MachDouble d) | not opt_SimplExcessPrecision =
-   MachDouble (toRational ((fromRational d) :: Double))
-convFloating l = l
-
-
-trueVal       = Var trueDataConId
-falseVal      = Var falseDataConId
-mkIntVal    i = Lit (mkMachInt  i)
-mkWordVal   w = Lit (mkMachWord w)
-mkFloatVal  f = Lit (convFloating (MachFloat  f))
-mkDoubleVal d = Lit (convFloating (MachDouble d))
-\end{code}
-
-						
-%************************************************************************
-%*									*
-\subsection{Special rules for seq, tagToEnum, dataToTag}
-%*									*
-%************************************************************************
-
-\begin{code}
-tagToEnumRule [Type ty, Lit (MachInt i)]
-  = ASSERT( isEnumerationTyCon tycon ) 
-    case filter correct_tag (tyConDataCons_maybe tycon `orElse` []) of
-
-
-	[]	  -> Nothing	-- Abstract type
-	(dc:rest) -> ASSERT( null rest )
-		     Just (Var (dataConWorkId dc))
-  where 
-    correct_tag dc = (dataConTag dc - fIRST_TAG) == tag
-    tag   = fromInteger i
-    tycon = tyConAppTyCon ty
-
-tagToEnumRule other = Nothing
-\end{code}
-
-For dataToTag#, we can reduce if either 
-	
-	(a) the argument is a constructor
-	(b) the argument is a variable whose unfolding is a known constructor
-
-\begin{code}
-dataToTagRule [Type ty1, Var tag_to_enum `App` Type ty2 `App` tag]
-  | Just TagToEnumOp <- isPrimOpId_maybe tag_to_enum
-  , ty1 `coreEqType` ty2
-  = Just tag	-- dataToTag (tagToEnum x)   ==>   x
-
-dataToTagRule [_, val_arg]
-  | Just (dc,_) <- exprIsConApp_maybe val_arg
-  = ASSERT( not (isNewTyCon (dataConTyCon dc)) )
-    Just (mkIntVal (toInteger (dataConTag dc - fIRST_TAG)))
-
-dataToTagRule other = Nothing
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Built in rules}
-%*									*
-%************************************************************************
-
-\begin{code}
-builtinRules :: [CoreRule]
--- Rules for non-primops that can't be expressed using a RULE pragma
-builtinRules
-  = [ BuiltinRule FSLIT("AppendLitString") unpackCStringFoldrName match_append_lit,
-      BuiltinRule FSLIT("EqString") eqStringName match_eq_string
-    ]
-
-
--- The rule is this:
--- 	unpackFoldrCString# "foo" c (unpackFoldrCString# "baz" c n)  =  unpackFoldrCString# "foobaz" c n
-
-match_append_lit [Type ty1,
-		   Lit (MachStr s1),
-		   c1,
-		   Var unpk `App` Type ty2 
-		  	    `App` Lit (MachStr s2)
-		  	    `App` c2
-		  	    `App` n
-		  ]
-  | unpk `hasKey` unpackCStringFoldrIdKey && 
-    c1 `cheapEqExpr` c2
-  = ASSERT( ty1 `coreEqType` ty2 )
-    Just (Var unpk `App` Type ty1
-		   `App` Lit (MachStr (s1 `appendFS` s2))
-		   `App` c1
-		   `App` n)
-
-match_append_lit other = Nothing
-
--- The rule is this:
--- 	eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2) = s1==s2
-
-match_eq_string [Var unpk1 `App` Lit (MachStr s1),
-		 Var unpk2 `App` Lit (MachStr s2)]
-  | unpk1 `hasKey` unpackCStringIdKey,
-    unpk2 `hasKey` unpackCStringIdKey
-  = Just (if s1 == s2 then trueVal else falseVal)
-
-match_eq_string other = Nothing
-\end{code}		
diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
deleted file mode 100644
index a650352280..0000000000
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ /dev/null
@@ -1,461 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[PrimOp]{Primitive operations (machine-level)}
-
-\begin{code}
-module PrimOp (
-	PrimOp(..), allThePrimOps,
-	primOpType, primOpSig,
-	primOpTag, maxPrimOpTag, primOpOcc,
-
-	primOpOutOfLine, primOpNeedsWrapper, 
-	primOpOkForSpeculation, primOpIsCheap, primOpIsDupable,
-
-	getPrimOpResultInfo,  PrimOpResultInfo(..)
-    ) where
-
-#include "HsVersions.h"
-
-import TysPrim
-import TysWiredIn
-
-import NewDemand
-import Var		( TyVar )
-import OccName		( OccName, pprOccName, mkVarOccFS )
-import TyCon		( TyCon, isPrimTyCon, tyConPrimRep, PrimRep(..) )
-import Type		( Type, mkForAllTys, mkFunTy, mkFunTys, tyConAppTyCon,
-			  typePrimRep )
-import BasicTypes	( Arity, Boxity(..) )
-import Outputable
-import FastTypes
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[PrimOp-datatype]{Datatype for @PrimOp@ (an enumeration)}
-%*									*
-%************************************************************************
-
-These are in \tr{state-interface.verb} order.
-
-\begin{code}
-
--- supplies: 
--- data PrimOp = ...
-#include "primop-data-decl.hs-incl"
-\end{code}
-
-Used for the Ord instance
-
-\begin{code}
-primOpTag :: PrimOp -> Int
-primOpTag op = iBox (tagOf_PrimOp op)
-
--- supplies   
--- tagOf_PrimOp :: PrimOp -> FastInt
-#include "primop-tag.hs-incl"
-
-
-instance Eq PrimOp where
-    op1 == op2 = tagOf_PrimOp op1 ==# tagOf_PrimOp op2
-
-instance Ord PrimOp where
-    op1 <  op2 =  tagOf_PrimOp op1 <# tagOf_PrimOp op2
-    op1 <= op2 =  tagOf_PrimOp op1 <=# tagOf_PrimOp op2
-    op1 >= op2 =  tagOf_PrimOp op1 >=# tagOf_PrimOp op2
-    op1 >  op2 =  tagOf_PrimOp op1 ># tagOf_PrimOp op2
-    op1 `compare` op2 | op1 < op2  = LT
-		      | op1 == op2 = EQ
-		      | otherwise  = GT
-
-instance Outputable PrimOp where
-    ppr op = pprPrimOp op
-
-instance Show PrimOp where
-    showsPrec p op = showsPrecSDoc p (pprPrimOp op)
-\end{code}
-
-An @Enum@-derived list would be better; meanwhile... (ToDo)
-
-\begin{code}
-allThePrimOps :: [PrimOp]
-allThePrimOps =
-#include "primop-list.hs-incl"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[PrimOp-info]{The essential info about each @PrimOp@}
-%*									*
-%************************************************************************
-
-The @String@ in the @PrimOpInfos@ is the ``base name'' by which the user may
-refer to the primitive operation.  The conventional \tr{#}-for-
-unboxed ops is added on later.
-
-The reason for the funny characters in the names is so we do not
-interfere with the programmer's Haskell name spaces.
-
-We use @PrimKinds@ for the ``type'' information, because they're
-(slightly) more convenient to use than @TyCons@.
-\begin{code}
-data PrimOpInfo
-  = Dyadic	OccName		-- string :: T -> T -> T
-		Type
-  | Monadic	OccName		-- string :: T -> T
-		Type
-  | Compare	OccName		-- string :: T -> T -> Bool
-		Type
-
-  | GenPrimOp   OccName  	-- string :: \/a1..an . T1 -> .. -> Tk -> T
-		[TyVar] 
-		[Type] 
-		Type 
-
-mkDyadic str  ty = Dyadic  (mkVarOccFS str) ty
-mkMonadic str ty = Monadic (mkVarOccFS str) ty
-mkCompare str ty = Compare (mkVarOccFS str) ty
-mkGenPrimOp str tvs tys ty = GenPrimOp (mkVarOccFS str) tvs tys ty
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{Strictness}
-%*									*
-%************************************************************************
-
-Not all primops are strict!
-
-\begin{code}
-primOpStrictness :: PrimOp -> Arity -> StrictSig
-	-- See Demand.StrictnessInfo for discussion of what the results
-	-- The arity should be the arity of the primop; that's why
-	-- this function isn't exported.
-#include "primop-strictness.hs-incl"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection[PrimOp-comparison]{PrimOpInfo basic comparison ops}
-%*									*
-%************************************************************************
-
-@primOpInfo@ gives all essential information (from which everything
-else, notably a type, can be constructed) for each @PrimOp@.
-
-\begin{code}
-primOpInfo :: PrimOp -> PrimOpInfo
-#include "primop-primop-info.hs-incl"
-\end{code}
-
-Here are a load of comments from the old primOp info:
-
-A @Word#@ is an unsigned @Int#@.
-
-@decodeFloat#@ is given w/ Integer-stuff (it's similar).
-
-@decodeDouble#@ is given w/ Integer-stuff (it's similar).
-
-Decoding of floating-point numbers is sorta Integer-related.  Encoding
-is done with plain ccalls now (see PrelNumExtra.lhs).
-
-A @Weak@ Pointer is created by the @mkWeak#@ primitive:
-
-	mkWeak# :: k -> v -> f -> State# RealWorld 
-			-> (# State# RealWorld, Weak# v #)
-
-In practice, you'll use the higher-level
-
-	data Weak v = Weak# v
-	mkWeak :: k -> v -> IO () -> IO (Weak v)
-
-The following operation dereferences a weak pointer.  The weak pointer
-may have been finalized, so the operation returns a result code which
-must be inspected before looking at the dereferenced value.
-
-	deRefWeak# :: Weak# v -> State# RealWorld ->
-			(# State# RealWorld, v, Int# #)
-
-Only look at v if the Int# returned is /= 0 !!
-
-The higher-level op is
-
-	deRefWeak :: Weak v -> IO (Maybe v)
-
-Weak pointers can be finalized early by using the finalize# operation:
-	
-	finalizeWeak# :: Weak# v -> State# RealWorld -> 
-	   		   (# State# RealWorld, Int#, IO () #)
-
-The Int# returned is either
-
-	0 if the weak pointer has already been finalized, or it has no
-	  finalizer (the third component is then invalid).
-
-	1 if the weak pointer is still alive, with the finalizer returned
-	  as the third component.
-
-A {\em stable name/pointer} is an index into a table of stable name
-entries.  Since the garbage collector is told about stable pointers,
-it is safe to pass a stable pointer to external systems such as C
-routines.
-
-\begin{verbatim}
-makeStablePtr#  :: a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
-freeStablePtr   :: StablePtr# a -> State# RealWorld -> State# RealWorld
-deRefStablePtr# :: StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
-eqStablePtr#    :: StablePtr# a -> StablePtr# a -> Int#
-\end{verbatim}
-
-It may seem a bit surprising that @makeStablePtr#@ is a @IO@
-operation since it doesn't (directly) involve IO operations.  The
-reason is that if some optimisation pass decided to duplicate calls to
-@makeStablePtr#@ and we only pass one of the stable pointers over, a
-massive space leak can result.  Putting it into the IO monad
-prevents this.  (Another reason for putting them in a monad is to
-ensure correct sequencing wrt the side-effecting @freeStablePtr@
-operation.)
-
-An important property of stable pointers is that if you call
-makeStablePtr# twice on the same object you get the same stable
-pointer back.
-
-Note that we can implement @freeStablePtr#@ using @_ccall_@ (and,
-besides, it's not likely to be used from Haskell) so it's not a
-primop.
-
-Question: Why @RealWorld@ - won't any instance of @_ST@ do the job? [ADR]
-
-Stable Names
-~~~~~~~~~~~~
-
-A stable name is like a stable pointer, but with three important differences:
-
-	(a) You can't deRef one to get back to the original object.
-	(b) You can convert one to an Int.
-	(c) You don't need to 'freeStableName'
-
-The existence of a stable name doesn't guarantee to keep the object it
-points to alive (unlike a stable pointer), hence (a).
-
-Invariants:
-	
-	(a) makeStableName always returns the same value for a given
-	    object (same as stable pointers).
-
-	(b) if two stable names are equal, it implies that the objects
-	    from which they were created were the same.
-
-	(c) stableNameToInt always returns the same Int for a given
-	    stable name.
-
-
--- HWL: The first 4 Int# in all par... annotations denote:
---   name, granularity info, size of result, degree of parallelism
---      Same  structure as _seq_ i.e. returns Int#
--- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine
---   `the processor containing the expression v'; it is not evaluated
-
-These primops are pretty wierd.
-
-	dataToTag# :: a -> Int    (arg must be an evaluated data type)
-	tagToEnum# :: Int -> a    (result type must be an enumerated type)
-
-The constraints aren't currently checked by the front end, but the
-code generator will fall over if they aren't satisfied.
-
-\begin{code}
-#ifdef DEBUG
-primOpInfo op = pprPanic "primOpInfo:" (ppr op)
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection[PrimOp-ool]{Which PrimOps are out-of-line}
-%*									*
-%************************************************************************
-
-Some PrimOps need to be called out-of-line because they either need to
-perform a heap check or they block.
-
-
-\begin{code}
-primOpOutOfLine :: PrimOp -> Bool
-#include "primop-out-of-line.hs-incl"
-\end{code}
-
-
-primOpOkForSpeculation
-~~~~~~~~~~~~~~~~~~~~~~
-Sometimes we may choose to execute a PrimOp even though it isn't
-certain that its result will be required; ie execute them
-``speculatively''.  The same thing as ``cheap eagerness.'' Usually
-this is OK, because PrimOps are usually cheap, but it isn't OK for
-(a)~expensive PrimOps and (b)~PrimOps which can fail.
-
-PrimOps that have side effects also should not be executed speculatively.
-
-Ok-for-speculation also means that it's ok *not* to execute the
-primop. For example
-	case op a b of
-	  r -> 3
-Here the result is not used, so we can discard the primop.  Anything
-that has side effects mustn't be dicarded in this way, of course!
-
-See also @primOpIsCheap@ (below).
-
-
-\begin{code}
-primOpOkForSpeculation :: PrimOp -> Bool
-	-- See comments with CoreUtils.exprOkForSpeculation
-primOpOkForSpeculation op 
-  = not (primOpHasSideEffects op || primOpOutOfLine op || primOpCanFail op)
-\end{code}
-
-
-primOpIsCheap
-~~~~~~~~~~~~~
-@primOpIsCheap@, as used in \tr{SimplUtils.lhs}.  For now (HACK
-WARNING), we just borrow some other predicates for a
-what-should-be-good-enough test.  "Cheap" means willing to call it more
-than once, and/or push it inside a lambda.  The latter could change the
-behaviour of 'seq' for primops that can fail, so we don't treat them as cheap.
-
-\begin{code}
-primOpIsCheap :: PrimOp -> Bool
-primOpIsCheap op = primOpOkForSpeculation op
--- In March 2001, we changed this to 
---	primOpIsCheap op = False
--- thereby making *no* primops seem cheap.  But this killed eta
--- expansion on case (x ==# y) of True -> \s -> ... 
--- which is bad.  In particular a loop like
---	doLoop n = loop 0
---     where
---         loop i | i == n    = return ()
---                | otherwise = bar i >> loop (i+1)
--- allocated a closure every time round because it doesn't eta expand.
--- 
--- The problem that originally gave rise to the change was
---	let x = a +# b *# c in x +# x
--- were we don't want to inline x. But primopIsCheap doesn't control
--- that (it's exprIsDupable that does) so the problem doesn't occur
--- even if primOpIsCheap sometimes says 'True'.
-\end{code}
-
-primOpIsDupable
-~~~~~~~~~~~~~~~
-primOpIsDupable means that the use of the primop is small enough to
-duplicate into different case branches.  See CoreUtils.exprIsDupable.
-
-\begin{code}
-primOpIsDupable :: PrimOp -> Bool
-	-- See comments with CoreUtils.exprIsDupable
-	-- We say it's dupable it isn't implemented by a C call with a wrapper
-primOpIsDupable op = not (primOpNeedsWrapper op)
-\end{code}
-
-
-\begin{code}
-primOpCanFail :: PrimOp -> Bool
-#include "primop-can-fail.hs-incl"
-\end{code}
-
-And some primops have side-effects and so, for example, must not be
-duplicated.
-
-\begin{code}
-primOpHasSideEffects :: PrimOp -> Bool
-#include "primop-has-side-effects.hs-incl"
-\end{code}
-
-Inline primitive operations that perform calls need wrappers to save
-any live variables that are stored in caller-saves registers.
-
-\begin{code}
-primOpNeedsWrapper :: PrimOp -> Bool
-#include "primop-needs-wrapper.hs-incl"
-\end{code}
-
-\begin{code}
-primOpType :: PrimOp -> Type  -- you may want to use primOpSig instead
-primOpType op
-  = case (primOpInfo op) of
-      Dyadic occ ty ->	    dyadic_fun_ty ty
-      Monadic occ ty ->	    monadic_fun_ty ty
-      Compare occ ty ->	    compare_fun_ty ty
-
-      GenPrimOp occ tyvars arg_tys res_ty -> 
-	mkForAllTys tyvars (mkFunTys arg_tys res_ty)
-
-primOpOcc :: PrimOp -> OccName
-primOpOcc op = case (primOpInfo op) of
-		Dyadic    occ _	    -> occ
-		Monadic   occ _	    -> occ
-		Compare   occ _	    -> occ
-		GenPrimOp occ _ _ _ -> occ
-
--- primOpSig is like primOpType but gives the result split apart:
--- (type variables, argument types, result type)
--- It also gives arity, strictness info
-
-primOpSig :: PrimOp -> ([TyVar], [Type], Type, Arity, StrictSig)
-primOpSig op
-  = (tyvars, arg_tys, res_ty, arity, primOpStrictness op arity)
-  where
-    arity = length arg_tys
-    (tyvars, arg_tys, res_ty)
-      = case (primOpInfo op) of
-	  Monadic   occ ty -> ([],     [ty],    ty    )
-	  Dyadic    occ ty -> ([],     [ty,ty], ty    )
-	  Compare   occ ty -> ([],     [ty,ty], boolTy)
-	  GenPrimOp occ tyvars arg_tys res_ty
-                           -> (tyvars, arg_tys, res_ty)
-\end{code}
-
-\begin{code}
-data PrimOpResultInfo
-  = ReturnsPrim	    PrimRep
-  | ReturnsAlg	    TyCon
-
--- Some PrimOps need not return a manifest primitive or algebraic value
--- (i.e. they might return a polymorphic value).  These PrimOps *must*
--- be out of line, or the code generator won't work.
-
-getPrimOpResultInfo :: PrimOp -> PrimOpResultInfo
-getPrimOpResultInfo op
-  = case (primOpInfo op) of
-      Dyadic  _ ty		 	  -> ReturnsPrim (typePrimRep ty)
-      Monadic _ ty		 	  -> ReturnsPrim (typePrimRep ty)
-      Compare _ ty		 	  -> ReturnsAlg boolTyCon
-      GenPrimOp _ _ _ ty | isPrimTyCon tc -> ReturnsPrim (tyConPrimRep tc)
-			 | otherwise      -> ReturnsAlg tc
-			 where
-			   tc = tyConAppTyCon ty
-			-- All primops return a tycon-app result
-			-- The tycon can be an unboxed tuple, though, which
-			-- gives rise to a ReturnAlg
-\end{code}
-
-The commutable ops are those for which we will try to move constants
-to the right hand side for strength reduction.
-
-\begin{code}
-commutableOp :: PrimOp -> Bool
-#include "primop-commutable.hs-incl"
-\end{code}
-
-Utils:
-\begin{code}
-dyadic_fun_ty  ty = mkFunTys [ty, ty] ty
-monadic_fun_ty ty = mkFunTy  ty ty
-compare_fun_ty ty = mkFunTys [ty, ty] boolTy
-\end{code}
-
-Output stuff:
-\begin{code}
-pprPrimOp  :: PrimOp -> SDoc
-pprPrimOp other_op = pprOccName (primOpOcc other_op)
-\end{code}
-
diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs
deleted file mode 100644
index 2f6168bafb..0000000000
--- a/ghc/compiler/prelude/TysPrim.lhs
+++ /dev/null
@@ -1,392 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1994-1998
-%
-\section[TysPrim]{Wired-in knowledge about primitive types}
-
-\begin{code}
-module TysPrim(
-	alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
-	alphaTy, betaTy, gammaTy, deltaTy,
-	openAlphaTy, openAlphaTyVar, openAlphaTyVars,
-
-	primTyCons,
-
-	charPrimTyCon, 		charPrimTy,
-	intPrimTyCon,		intPrimTy,
-	wordPrimTyCon,		wordPrimTy,
-	addrPrimTyCon,		addrPrimTy,
-	floatPrimTyCon,		floatPrimTy,
-	doublePrimTyCon,	doublePrimTy,
-
-	statePrimTyCon,		mkStatePrimTy,
-	realWorldTyCon,		realWorldTy, realWorldStatePrimTy,
-
-	arrayPrimTyCon,			mkArrayPrimTy, 
-	byteArrayPrimTyCon,		byteArrayPrimTy,
-	mutableArrayPrimTyCon,		mkMutableArrayPrimTy,
-	mutableByteArrayPrimTyCon,	mkMutableByteArrayPrimTy,
-	mutVarPrimTyCon,		mkMutVarPrimTy,
-
-	mVarPrimTyCon,			mkMVarPrimTy,	
-        tVarPrimTyCon,                  mkTVarPrimTy,
-	stablePtrPrimTyCon,		mkStablePtrPrimTy,
-	stableNamePrimTyCon,		mkStableNamePrimTy,
-	bcoPrimTyCon,			bcoPrimTy,
-	weakPrimTyCon,  		mkWeakPrimTy,
-	threadIdPrimTyCon,		threadIdPrimTy,
-	
-	int32PrimTyCon,		int32PrimTy,
-	word32PrimTyCon,	word32PrimTy,
-
-	int64PrimTyCon,		int64PrimTy,
-	word64PrimTyCon,	word64PrimTy
-  ) where
-
-#include "HsVersions.h"
-
-import Var		( TyVar, mkTyVar )
-import Name		( Name, BuiltInSyntax(..), mkInternalName, mkWiredInName )
-import OccName		( mkOccNameFS, tcName, mkTyVarOcc )
-import TyCon		( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon,
-			  PrimRep(..) )
-import Type		( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
-			  unliftedTypeKind, liftedTypeKind, openTypeKind, 
-			  Kind, mkArrowKinds,
-			  TyThing(..)
-			)
-import SrcLoc		( noSrcLoc )
-import Unique		( mkAlphaTyVarUnique )
-import PrelNames
-import FastString	( FastString, mkFastString )
-import Outputable
-
-import Char 		( ord, chr )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Primitive type constructors}
-%*									*
-%************************************************************************
-
-\begin{code}
-primTyCons :: [TyCon]
-primTyCons 
-  = [ addrPrimTyCon
-    , arrayPrimTyCon
-    , byteArrayPrimTyCon
-    , charPrimTyCon
-    , doublePrimTyCon
-    , floatPrimTyCon
-    , intPrimTyCon
-    , int32PrimTyCon
-    , int64PrimTyCon
-    , bcoPrimTyCon
-    , weakPrimTyCon
-    , mutableArrayPrimTyCon
-    , mutableByteArrayPrimTyCon
-    , mVarPrimTyCon
-    , tVarPrimTyCon
-    , mutVarPrimTyCon
-    , realWorldTyCon
-    , stablePtrPrimTyCon
-    , stableNamePrimTyCon
-    , statePrimTyCon
-    , threadIdPrimTyCon
-    , wordPrimTyCon
-    , word32PrimTyCon
-    , word64PrimTyCon
-    ]
-
-mkPrimTc :: FastString -> Unique -> TyCon -> Name
-mkPrimTc fs uniq tycon
-  = mkWiredInName gHC_PRIM (mkOccNameFS tcName fs) 
-		  uniq
-		  Nothing 		-- No parent object
-		  (ATyCon tycon)	-- Relevant TyCon
-		  UserSyntax		-- None are built-in syntax
-
-charPrimTyConName    	      = mkPrimTc FSLIT("Char#") charPrimTyConKey charPrimTyCon
-intPrimTyConName     	      = mkPrimTc FSLIT("Int#") intPrimTyConKey  intPrimTyCon
-int32PrimTyConName	      = mkPrimTc FSLIT("Int32#") int32PrimTyConKey int32PrimTyCon
-int64PrimTyConName   	      = mkPrimTc FSLIT("Int64#") int64PrimTyConKey int64PrimTyCon
-wordPrimTyConName    	      = mkPrimTc FSLIT("Word#") wordPrimTyConKey wordPrimTyCon
-word32PrimTyConName  	      = mkPrimTc FSLIT("Word32#") word32PrimTyConKey word32PrimTyCon
-word64PrimTyConName  	      = mkPrimTc FSLIT("Word64#") word64PrimTyConKey word64PrimTyCon
-addrPrimTyConName    	      = mkPrimTc FSLIT("Addr#") addrPrimTyConKey addrPrimTyCon
-floatPrimTyConName   	      = mkPrimTc FSLIT("Float#") floatPrimTyConKey floatPrimTyCon
-doublePrimTyConName  	      = mkPrimTc FSLIT("Double#") doublePrimTyConKey doublePrimTyCon
-statePrimTyConName   	      = mkPrimTc FSLIT("State#") statePrimTyConKey statePrimTyCon
-realWorldTyConName   	      = mkPrimTc FSLIT("RealWorld") realWorldTyConKey realWorldTyCon
-arrayPrimTyConName   	      = mkPrimTc FSLIT("Array#") arrayPrimTyConKey arrayPrimTyCon
-byteArrayPrimTyConName	      = mkPrimTc FSLIT("ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
-mutableArrayPrimTyConName     = mkPrimTc FSLIT("MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
-mutableByteArrayPrimTyConName = mkPrimTc FSLIT("MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
-mutVarPrimTyConName	      = mkPrimTc FSLIT("MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
-mVarPrimTyConName	      = mkPrimTc FSLIT("MVar#") mVarPrimTyConKey mVarPrimTyCon
-tVarPrimTyConName	      = mkPrimTc FSLIT("TVar#") tVarPrimTyConKey tVarPrimTyCon
-stablePtrPrimTyConName        = mkPrimTc FSLIT("StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon
-stableNamePrimTyConName       = mkPrimTc FSLIT("StableName#") stableNamePrimTyConKey stableNamePrimTyCon
-bcoPrimTyConName 	      = mkPrimTc FSLIT("BCO#") bcoPrimTyConKey bcoPrimTyCon
-weakPrimTyConName  	      = mkPrimTc FSLIT("Weak#") weakPrimTyConKey weakPrimTyCon
-threadIdPrimTyConName  	      = mkPrimTc FSLIT("ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Support code}
-%*									*
-%************************************************************************
-
-alphaTyVars is a list of type variables for use in templates: 
-	["a", "b", ..., "z", "t1", "t2", ... ]
-
-\begin{code}
-tyVarList :: Kind -> [TyVar]
-tyVarList kind = [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u) 
-				(mkTyVarOcc (mkFastString name))
-			 	noSrcLoc) kind
-	         | u <- [2..],
-		   let name | c <= 'z'  = [c]
-		            | otherwise = 't':show u
-			    where c = chr (u-2 + ord 'a')
-	         ]
-
-alphaTyVars :: [TyVar]
-alphaTyVars = tyVarList liftedTypeKind
-
-betaTyVars = tail alphaTyVars
-
-alphaTyVar, betaTyVar, gammaTyVar :: TyVar
-(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars
-
-alphaTys = mkTyVarTys alphaTyVars
-(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys
-
-	-- openAlphaTyVar is prepared to be instantiated
-	-- to a lifted or unlifted type variable.  It's used for the 
-	-- result type for "error", so that we can have (error Int# "Help")
-openAlphaTyVars :: [TyVar]
-openAlphaTyVars@(openAlphaTyVar:_) = tyVarList openTypeKind
-
-openAlphaTy = mkTyVarTy openAlphaTyVar
-
-vrcPos,vrcZero :: (Bool,Bool)
-vrcPos  = (True,False)
-vrcZero = (False,False)
-
-vrcsP,vrcsZ,vrcsZP :: ArgVrcs
-vrcsP  = [vrcPos]
-vrcsZ  = [vrcZero]
-vrcsZP = [vrcZero,vrcPos]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[TysPrim-basic]{Basic primitive types (@Char#@, @Int#@, etc.)}
-%*									*
-%************************************************************************
-
-\begin{code}
--- only used herein
-pcPrimTyCon :: Name -> ArgVrcs -> PrimRep -> TyCon
-pcPrimTyCon name arg_vrcs rep
-  = mkPrimTyCon name kind arity arg_vrcs rep
-  where
-    arity       = length arg_vrcs
-    kind        = mkArrowKinds (replicate arity liftedTypeKind) result_kind
-    result_kind = unliftedTypeKind -- all primitive types are unlifted
-
-pcPrimTyCon0 :: Name -> PrimRep -> TyCon
-pcPrimTyCon0 name rep
-  = mkPrimTyCon name result_kind 0 [] rep
-  where
-    result_kind = unliftedTypeKind -- all primitive types are unlifted
-
-charPrimTy	= mkTyConTy charPrimTyCon
-charPrimTyCon	= pcPrimTyCon0 charPrimTyConName WordRep
-
-intPrimTy	= mkTyConTy intPrimTyCon
-intPrimTyCon	= pcPrimTyCon0 intPrimTyConName IntRep
-
-int32PrimTy	= mkTyConTy int32PrimTyCon
-int32PrimTyCon	= pcPrimTyCon0 int32PrimTyConName IntRep
-
-int64PrimTy	= mkTyConTy int64PrimTyCon
-int64PrimTyCon	= pcPrimTyCon0 int64PrimTyConName Int64Rep
-
-wordPrimTy	= mkTyConTy wordPrimTyCon
-wordPrimTyCon	= pcPrimTyCon0 wordPrimTyConName WordRep
-
-word32PrimTy	= mkTyConTy word32PrimTyCon
-word32PrimTyCon	= pcPrimTyCon0 word32PrimTyConName WordRep
-
-word64PrimTy	= mkTyConTy word64PrimTyCon
-word64PrimTyCon	= pcPrimTyCon0 word64PrimTyConName Word64Rep
-
-addrPrimTy	= mkTyConTy addrPrimTyCon
-addrPrimTyCon	= pcPrimTyCon0 addrPrimTyConName AddrRep
-
-floatPrimTy	= mkTyConTy floatPrimTyCon
-floatPrimTyCon	= pcPrimTyCon0 floatPrimTyConName FloatRep
-
-doublePrimTy	= mkTyConTy doublePrimTyCon
-doublePrimTyCon	= pcPrimTyCon0 doublePrimTyConName DoubleRep
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[TysPrim-state]{The @State#@ type (and @_RealWorld@ types)}
-%*									*
-%************************************************************************
-
-State# is the primitive, unlifted type of states.  It has one type parameter,
-thus
-	State# RealWorld
-or
-	State# s
-
-where s is a type variable. The only purpose of the type parameter is to
-keep different state threads separate.  It is represented by nothing at all.
-
-\begin{code}
-mkStatePrimTy ty = mkTyConApp statePrimTyCon [ty]
-statePrimTyCon	 = pcPrimTyCon statePrimTyConName vrcsZ VoidRep
-\end{code}
-
-RealWorld is deeply magical.  It is *primitive*, but it is not
-*unlifted* (hence ptrArg).  We never manipulate values of type
-RealWorld; it's only used in the type system, to parameterise State#.
-
-\begin{code}
-realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 [] PtrRep
-realWorldTy	     = mkTyConTy realWorldTyCon
-realWorldStatePrimTy = mkStatePrimTy realWorldTy	-- State# RealWorld
-\end{code}
-
-Note: the ``state-pairing'' types are not truly primitive, so they are
-defined in \tr{TysWiredIn.lhs}, not here.
-
-
-%************************************************************************
-%*									*
-\subsection[TysPrim-arrays]{The primitive array types}
-%*									*
-%************************************************************************
-
-\begin{code}
-arrayPrimTyCon		  = pcPrimTyCon  arrayPrimTyConName	       vrcsP  PtrRep
-mutableArrayPrimTyCon	  = pcPrimTyCon  mutableArrayPrimTyConName     vrcsZP PtrRep
-mutableByteArrayPrimTyCon = pcPrimTyCon  mutableByteArrayPrimTyConName vrcsZ  PtrRep
-byteArrayPrimTyCon	  = pcPrimTyCon0 byteArrayPrimTyConName	              PtrRep
-
-mkArrayPrimTy elt    	    = mkTyConApp arrayPrimTyCon [elt]
-byteArrayPrimTy	    	    = mkTyConTy byteArrayPrimTyCon
-mkMutableArrayPrimTy s elt  = mkTyConApp mutableArrayPrimTyCon [s, elt]
-mkMutableByteArrayPrimTy s  = mkTyConApp mutableByteArrayPrimTyCon [s]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TysPrim-mut-var]{The mutable variable type}
-%*									*
-%************************************************************************
-
-\begin{code}
-mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PtrRep
-
-mkMutVarPrimTy s elt 	    = mkTyConApp mutVarPrimTyCon [s, elt]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TysPrim-synch-var]{The synchronizing variable type}
-%*									*
-%************************************************************************
-
-\begin{code}
-mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PtrRep
-
-mkMVarPrimTy s elt 	    = mkTyConApp mVarPrimTyCon [s, elt]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TysPrim-stm-var]{The transactional variable type}
-%*									*
-%************************************************************************
-
-\begin{code}
-tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName vrcsZP PtrRep
-
-mkTVarPrimTy s elt 	    = mkTyConApp tVarPrimTyCon [s, elt]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TysPrim-stable-ptrs]{The stable-pointer type}
-%*									*
-%************************************************************************
-
-\begin{code}
-stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName vrcsP AddrRep
-
-mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TysPrim-stable-names]{The stable-name type}
-%*									*
-%************************************************************************
-
-\begin{code}
-stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP PtrRep
-
-mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TysPrim-BCOs]{The ``bytecode object'' type}
-%*									*
-%************************************************************************
-
-\begin{code}
-bcoPrimTy    = mkTyConTy bcoPrimTyCon
-bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep
-\end{code}
-  
-%************************************************************************
-%*									*
-\subsection[TysPrim-Weak]{The ``weak pointer'' type}
-%*									*
-%************************************************************************
-
-\begin{code}
-weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP PtrRep
-
-mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TysPrim-thread-ids]{The ``thread id'' type}
-%*									*
-%************************************************************************
-
-A thread id is represented by a pointer to the TSO itself, to ensure
-that they are always unique and we can always find the TSO for a given
-thread id.  However, this has the unfortunate consequence that a
-ThreadId# for a given thread is treated as a root by the garbage
-collector and can keep TSOs around for too long.
-
-Hence the programmer API for thread manipulation uses a weak pointer
-to the thread id internally.
-
-\begin{code}
-threadIdPrimTy    = mkTyConTy threadIdPrimTyCon
-threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep
-\end{code}
diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
deleted file mode 100644
index ceb4df550a..0000000000
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ /dev/null
@@ -1,549 +0,0 @@
-%
-% (c) The GRASP Project, Glasgow University, 1994-1998
-%
-\section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
-
-This module is about types that can be defined in Haskell, but which
-must be wired into the compiler nonetheless.
-
-This module tracks the ``state interface'' document, ``GHC prelude:
-types and operations.''
-
-\begin{code}
-module TysWiredIn (
-	wiredInTyCons, 
-
-	boolTy,	boolTyCon, boolTyCon_RDR, boolTyConName,
-	trueDataCon,  trueDataConId,  true_RDR,
-	falseDataCon, falseDataConId, false_RDR,
-
-	charTyCon, charDataCon, charTyCon_RDR,
-	charTy, stringTy, charTyConName,
-
-	
-	doubleTyCon, doubleDataCon, doubleTy, doubleTyConName, 
-	
-	floatTyCon, floatDataCon, floatTy, floatTyConName,
-
-	intTyCon, intDataCon, intTyCon_RDR, intDataCon_RDR, intTyConName,
-	intTy,
-
-	listTyCon, nilDataCon, consDataCon,
-	listTyCon_RDR, consDataCon_RDR, listTyConName,
-	mkListTy,
-
-	-- tuples
-	mkTupleTy,
-	tupleTyCon, tupleCon, 
-	unitTyCon, unitDataCon, unitDataConId, pairTyCon, 
-	unboxedSingletonTyCon, unboxedSingletonDataCon,
-	unboxedPairTyCon, unboxedPairDataCon,
-
-	unitTy,
-	voidTy,
-
-        -- parallel arrays
-	mkPArrTy,
-	parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
-	parrTyCon_RDR, parrTyConName
-    ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} MkId( mkDataConIds )
-
--- friends:
-import PrelNames
-import TysPrim
-
--- others:
-import Constants	( mAX_TUPLE_SIZE )
-import Module		( Module )
-import RdrName		( nameRdrName )
-import Name		( Name, BuiltInSyntax(..), nameUnique, nameOccName, 
-			  nameModule, mkWiredInName )
-import OccName		( mkOccNameFS, tcName, dataName, mkTupleOcc,
-			  mkDataConWorkerOcc )
-import DataCon		( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
-import Var		( TyVar, tyVarKind )
-import TyCon		( TyCon, AlgTyConRhs(DataTyCon), tyConDataCons,
-			  mkTupleTyCon, mkAlgTyCon, tyConName )
-
-import BasicTypes	( Arity, RecFlag(..), Boxity(..), isBoxed,
-			  StrictnessMark(..) )
-
-import Type		( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys,
-			  TyThing(..) )
-import Kind		( mkArrowKinds, liftedTypeKind, ubxTupleKind )
-import Unique		( incrUnique, mkTupleTyConUnique,
-			  mkTupleDataConUnique, mkPArrDataConUnique )
-import Array
-import FastString
-import Outputable
-
-alpha_tyvar = [alphaTyVar]
-alpha_ty    = [alphaTy]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Wired in type constructors}
-%*									*
-%************************************************************************
-
-If you change which things are wired in, make sure you change their
-names in PrelNames, so they use wTcQual, wDataQual, etc
-
-\begin{code}
-wiredInTyCons :: [TyCon]	-- Excludes tuples
-wiredInTyCons = [ unitTyCon	-- Not treated like other tuples, because
-				-- it's defined in GHC.Base, and there's only
-				-- one of it.  We put it in wiredInTyCons so
-				-- that it'll pre-populate the name cache, so
-				-- the special case in lookupOrigNameCache 
-				-- doesn't need to look out for it
-	      , boolTyCon
-    	      , charTyCon
-    	      , doubleTyCon
-    	      , floatTyCon
-    	      , intTyCon
-    	      , listTyCon
-	      , parrTyCon
-    	      ]
-\end{code}
-
-\begin{code}
-mkWiredInTyConName :: BuiltInSyntax -> Module -> FastString -> Unique -> TyCon -> Name
-mkWiredInTyConName built_in mod fs uniq tycon
-  = mkWiredInName mod (mkOccNameFS tcName fs) uniq
-		  Nothing 		-- No parent object
-		  (ATyCon tycon)	-- Relevant TyCon
-		  built_in
-
-mkWiredInDataConName :: BuiltInSyntax -> Module -> FastString -> Unique -> DataCon -> Name -> Name
-mkWiredInDataConName built_in mod fs uniq datacon parent
-  = mkWiredInName mod (mkOccNameFS dataName fs) uniq
-		  (Just parent) 	-- Name of parent TyCon
-		  (ADataCon datacon)	-- Relevant DataCon
-		  built_in
-
-charTyConName	  = mkWiredInTyConName   UserSyntax pREL_BASE FSLIT("Char") charTyConKey charTyCon
-charDataConName   = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("C#") charDataConKey charDataCon charTyConName
-intTyConName	  = mkWiredInTyConName   UserSyntax pREL_BASE FSLIT("Int") intTyConKey   intTyCon
-intDataConName	  = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("I#") intDataConKey  intDataCon intTyConName
-						  
-boolTyConName	  = mkWiredInTyConName   UserSyntax pREL_BASE FSLIT("Bool") boolTyConKey boolTyCon
-falseDataConName  = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("False") falseDataConKey falseDataCon boolTyConName
-trueDataConName	  = mkWiredInDataConName UserSyntax pREL_BASE FSLIT("True")  trueDataConKey  trueDataCon  boolTyConName
-listTyConName	  = mkWiredInTyConName   BuiltInSyntax pREL_BASE FSLIT("[]") listTyConKey listTyCon
-nilDataConName 	  = mkWiredInDataConName BuiltInSyntax pREL_BASE FSLIT("[]") nilDataConKey nilDataCon  listTyConName
-consDataConName	  = mkWiredInDataConName BuiltInSyntax pREL_BASE FSLIT(":") consDataConKey consDataCon listTyConName
-
-floatTyConName	   = mkWiredInTyConName   UserSyntax pREL_FLOAT FSLIT("Float") floatTyConKey floatTyCon
-floatDataConName   = mkWiredInDataConName UserSyntax pREL_FLOAT FSLIT("F#") floatDataConKey floatDataCon floatTyConName
-doubleTyConName    = mkWiredInTyConName   UserSyntax pREL_FLOAT FSLIT("Double") doubleTyConKey doubleTyCon
-doubleDataConName  = mkWiredInDataConName UserSyntax pREL_FLOAT FSLIT("D#") doubleDataConKey doubleDataCon doubleTyConName
-
-parrTyConName	  = mkWiredInTyConName   BuiltInSyntax pREL_PARR FSLIT("[::]") parrTyConKey parrTyCon 
-parrDataConName   = mkWiredInDataConName UserSyntax    pREL_PARR FSLIT("PArr") parrDataConKey parrDataCon parrTyConName
-
-boolTyCon_RDR   = nameRdrName boolTyConName
-false_RDR	= nameRdrName falseDataConName
-true_RDR	= nameRdrName trueDataConName
-intTyCon_RDR	= nameRdrName intTyConName
-charTyCon_RDR	= nameRdrName charTyConName
-intDataCon_RDR	= nameRdrName intDataConName
-listTyCon_RDR	= nameRdrName listTyConName
-consDataCon_RDR = nameRdrName consDataConName
-parrTyCon_RDR	= nameRdrName parrTyConName
-\end{code}
-
-
-%************************************************************************
-%*                                                                      *
-\subsection{mkWiredInTyCon}
-%*                                                                      *
-%************************************************************************
-
-\begin{code}
-pcNonRecDataTyCon = pcTyCon False NonRecursive
-pcRecDataTyCon    = pcTyCon False Recursive
-
-pcTyCon is_enum is_rec name tyvars argvrcs cons
-  = tycon
-  where
-    tycon = mkAlgTyCon name
-		(mkArrowKinds (map tyVarKind tyvars) liftedTypeKind)
-                tyvars
-                argvrcs
-                []		-- No stupid theta
-		(DataTyCon cons is_enum)
-		[] 		-- No record selectors
-                is_rec
-		True		-- All the wired-in tycons have generics
-
-pcDataCon :: Name -> [TyVar] -> [Type] -> TyCon -> DataCon
-pcDataCon = pcDataConWithFixity False
-
-pcDataConWithFixity :: Bool -> Name -> [TyVar] -> [Type] -> TyCon -> DataCon
--- The Name should be in the DataName name space; it's the name
--- of the DataCon itself.
---
--- The unique is the first of two free uniques;
--- the first is used for the datacon itself,
--- the second is used for the "worker name"
-
-pcDataConWithFixity declared_infix dc_name tyvars arg_tys tycon
-  = data_con
-  where
-    data_con = mkDataCon dc_name declared_infix True {- Vanilla -}
-                (map (const NotMarkedStrict) arg_tys)
-                [{- No labelled fields -}]
-                tyvars [] [] arg_tys tycon (mkTyVarTys tyvars)
-		(mkDataConIds bogus_wrap_name wrk_name data_con)
-		
-
-    mod      = nameModule dc_name
-    wrk_occ  = mkDataConWorkerOcc (nameOccName dc_name)
-    wrk_key  = incrUnique (nameUnique dc_name)
-    wrk_name = mkWiredInName mod wrk_occ wrk_key
-			     (Just (tyConName tycon))
-			     (AnId (dataConWorkId data_con)) UserSyntax
-    bogus_wrap_name = pprPanic "Wired-in data wrapper id" (ppr dc_name)
-	-- Wired-in types are too simple to need wrappers
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[TysWiredIn-tuples]{The tuple types}
-%*									*
-%************************************************************************
-
-\begin{code}
-tupleTyCon :: Boxity -> Arity -> TyCon
-tupleTyCon boxity i | i > mAX_TUPLE_SIZE = fst (mk_tuple boxity i)	-- Build one specially
-tupleTyCon Boxed   i = fst (boxedTupleArr   ! i)
-tupleTyCon Unboxed i = fst (unboxedTupleArr ! i)
-
-tupleCon :: Boxity -> Arity -> DataCon
-tupleCon boxity i | i > mAX_TUPLE_SIZE = snd (mk_tuple boxity i)	-- Build one specially
-tupleCon Boxed   i = snd (boxedTupleArr   ! i)
-tupleCon Unboxed i = snd (unboxedTupleArr ! i)
-
-boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon)
-boxedTupleArr   = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed i | i <- [0..mAX_TUPLE_SIZE]]
-unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]]
-
-mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
-mk_tuple boxity arity = (tycon, tuple_con)
-  where
-	tycon   = mkTupleTyCon tc_name tc_kind arity tyvars tuple_con boxity gen_info 
-	mod	= mkTupleModule boxity arity
-	tc_name = mkWiredInName mod (mkTupleOcc tcName boxity arity) tc_uniq
-				Nothing (ATyCon tycon) BuiltInSyntax
-    	tc_kind = mkArrowKinds (map tyVarKind tyvars) res_kind
-	res_kind | isBoxed boxity = liftedTypeKind
-		 | otherwise	  = ubxTupleKind
-
-	tyvars   | isBoxed boxity = take arity alphaTyVars
-		 | otherwise	  = take arity openAlphaTyVars
-
-	tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon
-	tyvar_tys = mkTyVarTys tyvars
-	dc_name   = mkWiredInName mod (mkTupleOcc dataName boxity arity) dc_uniq
-				  (Just tc_name) (ADataCon tuple_con) BuiltInSyntax
- 	tc_uniq   = mkTupleTyConUnique   boxity arity
-	dc_uniq   = mkTupleDataConUnique boxity arity
-	gen_info  = True		-- Tuples all have generics..
-					-- hmm: that's a *lot* of code
-
-unitTyCon     = tupleTyCon Boxed 0
-unitDataCon   = head (tyConDataCons unitTyCon)
-unitDataConId = dataConWorkId unitDataCon
-
-pairTyCon = tupleTyCon Boxed 2
-
-unboxedSingletonTyCon   = tupleTyCon Unboxed 1
-unboxedSingletonDataCon = tupleCon   Unboxed 1
-
-unboxedPairTyCon   = tupleTyCon Unboxed 2
-unboxedPairDataCon = tupleCon   Unboxed 2
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
-%*									*
-%************************************************************************
-
-\begin{code}
--- The Void type is represented as a data type with no constructors
--- It's a built in type (i.e. there's no way to define it in Haskell;
---	the nearest would be
---
---		data Void =		-- No constructors!
---
--- ) It's lifted; there is only one value of this
--- type, namely "void", whose semantics is just bottom.
---
--- Haskell 98 drops the definition of a Void type, so we just 'simulate'
--- voidTy using ().
-voidTy = unitTy
-\end{code}
-
-
-\begin{code}
-charTy = mkTyConTy charTyCon
-
-charTyCon   = pcNonRecDataTyCon charTyConName [] [] [charDataCon]
-charDataCon = pcDataCon charDataConName [] [charPrimTy] charTyCon
-
-stringTy = mkListTy charTy -- convenience only
-\end{code}
-
-\begin{code}
-intTy = mkTyConTy intTyCon 
-
-intTyCon = pcNonRecDataTyCon intTyConName [] [] [intDataCon]
-intDataCon = pcDataCon intDataConName [] [intPrimTy] intTyCon
-\end{code}
-
-\begin{code}
-floatTy	= mkTyConTy floatTyCon
-
-floatTyCon   = pcNonRecDataTyCon floatTyConName   [] [] [floatDataCon]
-floatDataCon = pcDataCon         floatDataConName [] [floatPrimTy] floatTyCon
-\end{code}
-
-\begin{code}
-doubleTy = mkTyConTy doubleTyCon
-
-doubleTyCon   = pcNonRecDataTyCon doubleTyConName   [] [] [doubleDataCon]
-doubleDataCon = pcDataCon	  doubleDataConName [] [doublePrimTy] doubleTyCon
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[TysWiredIn-Bool]{The @Bool@ type}
-%*									*
-%************************************************************************
-
-An ordinary enumeration type, but deeply wired in.  There are no
-magical operations on @Bool@ (just the regular Prelude code).
-
-{\em BEGIN IDLE SPECULATION BY SIMON}
-
-This is not the only way to encode @Bool@.  A more obvious coding makes
-@Bool@ just a boxed up version of @Bool#@, like this:
-\begin{verbatim}
-type Bool# = Int#
-data Bool = MkBool Bool#
-\end{verbatim}
-
-Unfortunately, this doesn't correspond to what the Report says @Bool@
-looks like!  Furthermore, we get slightly less efficient code (I
-think) with this coding. @gtInt@ would look like this:
-
-\begin{verbatim}
-gtInt :: Int -> Int -> Bool
-gtInt x y = case x of I# x# ->
-	    case y of I# y# ->
-	    case (gtIntPrim x# y#) of
-		b# -> MkBool b#
-\end{verbatim}
-
-Notice that the result of the @gtIntPrim@ comparison has to be turned
-into an integer (here called @b#@), and returned in a @MkBool@ box.
-
-The @if@ expression would compile to this:
-\begin{verbatim}
-case (gtInt x y) of
-  MkBool b# -> case b# of { 1# -> e1; 0# -> e2 }
-\end{verbatim}
-
-I think this code is a little less efficient than the previous code,
-but I'm not certain.  At all events, corresponding with the Report is
-important.  The interesting thing is that the language is expressive
-enough to describe more than one alternative; and that a type doesn't
-necessarily need to be a straightforwardly boxed version of its
-primitive counterpart.
-
-{\em END IDLE SPECULATION BY SIMON}
-
-\begin{code}
-boolTy = mkTyConTy boolTyCon
-
-boolTyCon = pcTyCon True NonRecursive boolTyConName
-		    [] [] [falseDataCon, trueDataCon]
-
-falseDataCon = pcDataCon falseDataConName [] [] boolTyCon
-trueDataCon  = pcDataCon trueDataConName  [] [] boolTyCon
-
-falseDataConId = dataConWorkId falseDataCon
-trueDataConId  = dataConWorkId trueDataCon
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TysWiredIn-List]{The @List@ type (incl ``build'' magic)}
-%*									*
-%************************************************************************
-
-Special syntax, deeply wired in, but otherwise an ordinary algebraic
-data types:
-\begin{verbatim}
-data [] a = [] | a : (List a)
-data () = ()
-data (,) a b = (,,) a b
-...
-\end{verbatim}
-
-\begin{code}
-mkListTy :: Type -> Type
-mkListTy ty = mkTyConApp listTyCon [ty]
-
-listTyCon = pcRecDataTyCon listTyConName
-			alpha_tyvar [(True,False)] [nilDataCon, consDataCon]
-
-nilDataCon  = pcDataCon nilDataConName alpha_tyvar [] listTyCon
-consDataCon = pcDataConWithFixity True {- Declared infix -}
-	       consDataConName
- 	       alpha_tyvar [alphaTy, mkTyConApp listTyCon alpha_ty] listTyCon
--- Interesting: polymorphic recursion would help here.
--- We can't use (mkListTy alphaTy) in the defn of consDataCon, else mkListTy
--- gets the over-specific type (Type -> Type)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TysWiredIn-Tuples]{The @Tuple@ types}
-%*									*
-%************************************************************************
-
-The tuple types are definitely magic, because they form an infinite
-family.
-
-\begin{itemize}
-\item
-They have a special family of type constructors, of type @TyCon@
-These contain the tycon arity, but don't require a Unique.
-
-\item
-They have a special family of constructors, of type
-@Id@. Again these contain their arity but don't need a Unique.
-
-\item
-There should be a magic way of generating the info tables and
-entry code for all tuples.
-
-But at the moment we just compile a Haskell source
-file\srcloc{lib/prelude/...} containing declarations like:
-\begin{verbatim}
-data Tuple0		= Tup0
-data Tuple2  a b	= Tup2	a b
-data Tuple3  a b c	= Tup3	a b c
-data Tuple4  a b c d	= Tup4	a b c d
-...
-\end{verbatim}
-The print-names associated with the magic @Id@s for tuple constructors
-``just happen'' to be the same as those generated by these
-declarations.
-
-\item
-The instance environment should have a magic way to know
-that each tuple type is an instances of classes @Eq@, @Ix@, @Ord@ and
-so on. \ToDo{Not implemented yet.}
-
-\item
-There should also be a way to generate the appropriate code for each
-of these instances, but (like the info tables and entry code) it is
-done by enumeration\srcloc{lib/prelude/InTup?.hs}.
-\end{itemize}
-
-\begin{code}
-mkTupleTy :: Boxity -> Int -> [Type] -> Type
-mkTupleTy boxity arity tys = mkTyConApp (tupleTyCon boxity arity) tys
-
-unitTy    = mkTupleTy Boxed 0 []
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TysWiredIn-PArr]{The @[::]@ type}
-%*									*
-%************************************************************************
-
-Special syntax for parallel arrays needs some wired in definitions.
-
-\begin{code}
--- construct a type representing the application of the parallel array
--- constructor 
---
-mkPArrTy    :: Type -> Type
-mkPArrTy ty  = mkTyConApp parrTyCon [ty]
-
--- represents the type constructor of parallel arrays
---
---  * this must match the definition in `PrelPArr'
---
--- NB: Although the constructor is given here, it will not be accessible in
---     user code as it is not in the environment of any compiled module except
---     `PrelPArr'.
---
-parrTyCon :: TyCon
-parrTyCon  = pcNonRecDataTyCon parrTyConName alpha_tyvar [(True, False)] [parrDataCon]
-
-parrDataCon :: DataCon
-parrDataCon  = pcDataCon 
-	         parrDataConName 
-		 alpha_tyvar		-- forall'ed type variables
-		 [intPrimTy,		-- 1st argument: Int#
-		  mkTyConApp		-- 2nd argument: Array# a
-		    arrayPrimTyCon 
-		    alpha_ty] 
-		 parrTyCon
-
--- check whether a type constructor is the constructor for parallel arrays
---
-isPArrTyCon    :: TyCon -> Bool
-isPArrTyCon tc  = tyConName tc == parrTyConName
-
--- fake array constructors
---
---  * these constructors are never really used to represent array values;
---   however, they are very convenient during desugaring (and, in particular,
---   in the pattern matching compiler) to treat array pattern just like
---   yet another constructor pattern
---
-parrFakeCon                        :: Arity -> DataCon
-parrFakeCon i | i > mAX_TUPLE_SIZE  = mkPArrFakeCon  i	-- build one specially
-parrFakeCon i                       = parrFakeConArr!i
-
--- pre-defined set of constructors
---
-parrFakeConArr :: Array Int DataCon
-parrFakeConArr  = array (0, mAX_TUPLE_SIZE) [(i, mkPArrFakeCon i)   
-					    | i <- [0..mAX_TUPLE_SIZE]]
-
--- build a fake parallel array constructor for the given arity
---
-mkPArrFakeCon       :: Int -> DataCon
-mkPArrFakeCon arity  = data_con
-  where
-	data_con  = pcDataCon name [tyvar] tyvarTys parrTyCon
-	tyvar     = head alphaTyVars
-	tyvarTys  = replicate arity $ mkTyVarTy tyvar
-        nameStr   = mkFastString ("MkPArr" ++ show arity)
-	name      = mkWiredInName pREL_PARR (mkOccNameFS dataName nameStr) uniq
-				  Nothing (ADataCon data_con) UserSyntax
-	uniq      = mkPArrDataConUnique arity
-
--- checks whether a data constructor is a fake constructor for parallel arrays
---
-isPArrFakeCon      :: DataCon -> Bool
-isPArrFakeCon dcon  = dcon == parrFakeCon (dataConSourceArity dcon)
-\end{code}
-
diff --git a/ghc/compiler/prelude/primops.txt.pp b/ghc/compiler/prelude/primops.txt.pp
deleted file mode 100644
index 13b4b6c97d..0000000000
--- a/ghc/compiler/prelude/primops.txt.pp
+++ /dev/null
@@ -1,1687 +0,0 @@
------------------------------------------------------------------------
--- $Id: primops.txt.pp,v 1.37 2005/11/25 09:46:19 simonmar Exp $
---
--- Primitive Operations
---
------------------------------------------------------------------------
-
--- This file is processed by the utility program genprimopcode to produce
--- a number of include files within the compiler and optionally to produce
--- human-readable documentation.
---
--- It should first be preprocessed.
---
--- To add a new primop, you currently need to update the following files:
---
---	- this file (ghc/compiler/prelude/primops.txt.pp), which includes
---	  the type of the primop, and various other properties (its
---	  strictness attributes, whether it is defined as a macro
---	  or as out-of-line code, etc.)
---
---	- if the primop is inline (i.e. a macro), then:
---	  	ghc/compiler/AbsCUtils.lhs (dscCOpStmt)
---		  defines the translation of the primop into simpler
---		  abstract C operations.
---		
---	- or, for an out-of-line primop:
---	        ghc/includes/StgMiscClosures.h (just add the declaration)
---		ghc/rts/PrimOps.cmm     (define it here)
---		ghc/rts/Linker.c       (declare the symbol for GHCi)
---
---	- the User's Guide 
---
-
--- This file is divided into named sections, each containing or more
--- primop entries. Section headers have the format:
---
---	section "section-name" {description}
---
--- This information is used solely when producing documentation; it is
--- otherwise ignored.  The description is optional.
---
--- The format of each primop entry is as follows:
---
---	primop internal-name "name-in-program-text" type category {description} attributes
-
--- The default attribute values which apply if you don't specify
--- other ones.  Attribute values can be True, False, or arbitrary
--- text between curly brackets.  This is a kludge to enable 
--- processors of this file to easily get hold of simple info
--- (eg, out_of_line), whilst avoiding parsing complex expressions
--- needed for strictness and usage info.
-
-defaults
-   has_side_effects = False
-   out_of_line      = False
-   commutable       = False
-   needs_wrapper    = False
-   can_fail         = False
-   strictness       = { \ arity -> mkStrictSig (mkTopDmdType (replicate arity lazyDmd) TopRes) }
-   usage            = { nomangle other }
-
--- Currently, documentation is produced using latex, so contents of
--- description fields should be legal latex. Descriptions can contain
--- matched pairs of embedded curly brackets.
-
-#include "MachDeps.h"
-
--- We need platform defines (tests for mingw32 below).  However, we only
--- test the TARGET platform, which doesn't vary between stages, so the
--- stage1 platform defines are fine:
-#include "../stage1/ghc_boot_platform.h"
-
-section "The word size story."
-	{Haskell98 specifies that signed integers (type {\tt Int})
-	 must contain at least 30 bits. GHC always implements {\tt
-	 Int} using the primitive type {\tt Int\#}, whose size equals
-	 the {\tt MachDeps.h} constant {\tt WORD\_SIZE\_IN\_BITS}.
-	 This is normally set based on the {\tt config.h} parameter
-	 {\tt SIZEOF\_HSWORD}, i.e., 32 bits on 32-bit machines, 64
-	 bits on 64-bit machines.  However, it can also be explicitly
-	 set to a smaller number, e.g., 31 bits, to allow the
-	 possibility of using tag bits. Currently GHC itself has only
-	 32-bit and 64-bit variants, but 30 or 31-bit code can be
-	 exported as an external core file for use in other back ends.
-
-	 GHC also implements a primitive unsigned integer type {\tt
-	 Word\#} which always has the same number of bits as {\tt
-	 Int\#}.
-	
-	 In addition, GHC supports families of explicit-sized integers
-	 and words at 8, 16, 32, and 64 bits, with the usual
-	 arithmetic operations, comparisons, and a range of
-	 conversions.  The 8-bit and 16-bit sizes are always
-	 represented as {\tt Int\#} and {\tt Word\#}, and the
-	 operations implemented in terms of the the primops on these
-	 types, with suitable range restrictions on the results (using
-	 the {\tt narrow$n$Int\#} and {\tt narrow$n$Word\#} families
-	 of primops.  The 32-bit sizes are represented using {\tt
-	 Int\#} and {\tt Word\#} when {\tt WORD\_SIZE\_IN\_BITS}
-	 $\geq$ 32; otherwise, these are represented using distinct
-	 primitive types {\tt Int32\#} and {\tt Word32\#}. These (when
-	 needed) have a complete set of corresponding operations;
-	 however, nearly all of these are implemented as external C
-	 functions rather than as primops.  Exactly the same story
-	 applies to the 64-bit sizes.  All of these details are hidden
-	 under the {\tt PrelInt} and {\tt PrelWord} modules, which use
-	 {\tt \#if}-defs to invoke the appropriate types and
-	 operators.
-
-	 Word size also matters for the families of primops for
-	 indexing/reading/writing fixed-size quantities at offsets
-	 from an array base, address, or foreign pointer.  Here, a
-	 slightly different approach is taken.  The names of these
-	 primops are fixed, but their {\it types} vary according to
-	 the value of {\tt WORD\_SIZE\_IN\_BITS}. For example, if word
-	 size is at least 32 bits then an operator like
-	 \texttt{indexInt32Array\#} has type {\tt ByteArr\# -> Int\#
-	 -> Int\#}; otherwise it has type {\tt ByteArr\# -> Int\# ->
-	 Int32\#}.  This approach confines the necessary {\tt
-	 \#if}-defs to this file; no conditional compilation is needed
-	 in the files that expose these primops.
-
-	 Finally, there are strongly deprecated primops for coercing
-         between {\tt Addr\#}, the primitive type of machine
-         addresses, and {\tt Int\#}.  These are pretty bogus anyway,
-         but will work on existing 32-bit and 64-bit GHC targets; they
-         are completely bogus when tag bits are used in {\tt Int\#},
-         so are not available in this case.  }
-	
--- Define synonyms for indexing ops. 
-
-#if WORD_SIZE_IN_BITS < 32 
-#define INT32 Int32#
-#define WORD32 Word32#
-#else
-#define INT32 Int#
-#define WORD32 Word#
-#endif
-
-#if WORD_SIZE_IN_BITS < 64
-#define INT64 Int64#
-#define WORD64 Word64#
-#else
-#define INT64 Int#
-#define WORD64 Word#
-#endif
-
-------------------------------------------------------------------------
-section "Char#" 
-	{Operations on 31-bit characters.}
-------------------------------------------------------------------------
-
-
-primop   CharGtOp  "gtChar#"   Compare   Char# -> Char# -> Bool
-primop   CharGeOp  "geChar#"   Compare   Char# -> Char# -> Bool
-
-primop   CharEqOp  "eqChar#"   Compare
-   Char# -> Char# -> Bool
-   with commutable = True
-
-primop   CharNeOp  "neChar#"   Compare
-   Char# -> Char# -> Bool
-   with commutable = True
-
-primop   CharLtOp  "ltChar#"   Compare   Char# -> Char# -> Bool
-primop   CharLeOp  "leChar#"   Compare   Char# -> Char# -> Bool
-
-primop   OrdOp   "ord#"  GenPrimOp   Char# -> Int#
-
-------------------------------------------------------------------------
-section "Int#"
-	{Operations on native-size integers (30+ bits).}
-------------------------------------------------------------------------
-
-primop   IntAddOp    "+#"    Dyadic
-   Int# -> Int# -> Int#
-   with commutable = True
-
-primop   IntSubOp    "-#"    Dyadic   Int# -> Int# -> Int#
-
-primop   IntMulOp    "*#" 
-   Dyadic   Int# -> Int# -> Int#
-   {Low word of signed integer multiply.}
-   with commutable = True
-
-primop   IntMulMayOfloOp  "mulIntMayOflo#" 
-   Dyadic   Int# -> Int# -> Int#
-   {Return non-zero if there is any possibility that the upper word of a
-    signed integer multiply might contain useful information.  Return
-    zero only if you are completely sure that no overflow can occur.
-    On a 32-bit platform, the recommmended implementation is to do a 
-    32 x 32 -> 64 signed multiply, and subtract result[63:32] from
-    (result[31] >>signed 31).  If this is zero, meaning that the 
-    upper word is merely a sign extension of the lower one, no
-    overflow can occur.
-
-    On a 64-bit platform it is not always possible to 
-    acquire the top 64 bits of the result.  Therefore, a recommended 
-    implementation is to take the absolute value of both operands, and 
-    return 0 iff bits[63:31] of them are zero, since that means that their 
-    magnitudes fit within 31 bits, so the magnitude of the product must fit 
-    into 62 bits.
-
-    If in doubt, return non-zero, but do make an effort to create the
-    correct answer for small args, since otherwise the performance of
-    (*) :: Integer -> Integer -> Integer will be poor.
-   }
-   with commutable = True
-
-primop   IntQuotOp    "quotInt#"    Dyadic
-   Int# -> Int# -> Int#
-   {Rounds towards zero.}
-   with can_fail = True
-
-primop   IntRemOp    "remInt#"    Dyadic
-   Int# -> Int# -> Int#
-   {Satisfies \texttt{(quotInt\# x y) *\# y +\# (remInt\# x y) == x}.}
-   with can_fail = True
-
-primop   IntGcdOp    "gcdInt#"    Dyadic   Int# -> Int# -> Int#
-   with out_of_line = True
-
-primop   IntNegOp    "negateInt#"    Monadic   Int# -> Int#
-primop   IntAddCOp   "addIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
-	 {Add with carry.  First member of result is (wrapped) sum; 
-          second member is 0 iff no overflow occured.}
-primop   IntSubCOp   "subIntC#"    GenPrimOp   Int# -> Int# -> (# Int#, Int# #)
-	 {Subtract with carry.  First member of result is (wrapped) difference; 
-          second member is 0 iff no overflow occured.}
-
-primop   IntGtOp  ">#"   Compare   Int# -> Int# -> Bool
-primop   IntGeOp  ">=#"   Compare   Int# -> Int# -> Bool
-
-primop   IntEqOp  "==#"   Compare
-   Int# -> Int# -> Bool
-   with commutable = True
-
-primop   IntNeOp  "/=#"   Compare
-   Int# -> Int# -> Bool
-   with commutable = True
-
-primop   IntLtOp  "<#"   Compare   Int# -> Int# -> Bool
-primop   IntLeOp  "<=#"   Compare   Int# -> Int# -> Bool
-
-primop   ChrOp   "chr#"   GenPrimOp   Int# -> Char#
-
-primop   Int2WordOp "int2Word#" GenPrimOp Int# -> Word#
-primop   Int2FloatOp   "int2Float#"      GenPrimOp  Int# -> Float#
-primop   Int2DoubleOp   "int2Double#"          GenPrimOp  Int# -> Double#
-
-primop   Int2IntegerOp    "int2Integer#"
-   GenPrimOp Int# -> (# Int#, ByteArr# #)
-   with out_of_line = True
-
-primop   ISllOp   "uncheckedIShiftL#" GenPrimOp  Int# -> Int# -> Int#
-	 {Shift left.  Result undefined if shift amount is not
-          in the range 0 to word size - 1 inclusive.}
-primop   ISraOp   "uncheckedIShiftRA#" GenPrimOp Int# -> Int# -> Int#
-	 {Shift right arithmetic.  Result undefined if shift amount is not
-          in the range 0 to word size - 1 inclusive.}
-primop   ISrlOp   "uncheckedIShiftRL#" GenPrimOp Int# -> Int# -> Int#
-	 {Shift right logical.  Result undefined if shift amount is not
-          in the range 0 to word size - 1 inclusive.}
-
-------------------------------------------------------------------------
-section "Word#"
-	{Operations on native-sized unsigned words (30+ bits).}
-------------------------------------------------------------------------
-
-primop   WordAddOp   "plusWord#"   Dyadic   Word# -> Word# -> Word#
-   with commutable = True
-
-primop   WordSubOp   "minusWord#"   Dyadic   Word# -> Word# -> Word#
-
-primop   WordMulOp   "timesWord#"   Dyadic   Word# -> Word# -> Word#
-   with commutable = True
-
-primop   WordQuotOp   "quotWord#"   Dyadic   Word# -> Word# -> Word#
-   with can_fail = True
-
-primop   WordRemOp   "remWord#"   Dyadic   Word# -> Word# -> Word#
-   with can_fail = True
-
-primop   AndOp   "and#"   Dyadic   Word# -> Word# -> Word#
-   with commutable = True
-
-primop   OrOp   "or#"   Dyadic   Word# -> Word# -> Word#
-   with commutable = True
-
-primop   XorOp   "xor#"   Dyadic   Word# -> Word# -> Word#
-   with commutable = True
-
-primop   NotOp   "not#"   Monadic   Word# -> Word#
-
-primop   SllOp   "uncheckedShiftL#"   GenPrimOp   Word# -> Int# -> Word#
-	 {Shift left logical.   Result undefined if shift amount is not
-          in the range 0 to word size - 1 inclusive.}
-primop   SrlOp   "uncheckedShiftRL#"   GenPrimOp   Word# -> Int# -> Word#
-	 {Shift right logical.   Result undefined if shift  amount is not
-          in the range 0 to word size - 1 inclusive.}
-
-primop   Word2IntOp   "word2Int#"   GenPrimOp   Word# -> Int#
-
-primop   Word2IntegerOp   "word2Integer#"   GenPrimOp 
-   Word# -> (# Int#, ByteArr# #)
-   with out_of_line = True
-
-primop   WordGtOp   "gtWord#"   Compare   Word# -> Word# -> Bool
-primop   WordGeOp   "geWord#"   Compare   Word# -> Word# -> Bool
-primop   WordEqOp   "eqWord#"   Compare   Word# -> Word# -> Bool
-primop   WordNeOp   "neWord#"   Compare   Word# -> Word# -> Bool
-primop   WordLtOp   "ltWord#"   Compare   Word# -> Word# -> Bool
-primop   WordLeOp   "leWord#"   Compare   Word# -> Word# -> Bool
-
-------------------------------------------------------------------------
-section "Narrowings" 
-	{Explicit narrowing of native-sized ints or words.}
-------------------------------------------------------------------------
-
-primop   Narrow8IntOp      "narrow8Int#"      Monadic   Int# -> Int#
-primop   Narrow16IntOp     "narrow16Int#"     Monadic   Int# -> Int#
-primop   Narrow32IntOp     "narrow32Int#"     Monadic   Int# -> Int#
-primop   Narrow8WordOp     "narrow8Word#"     Monadic   Word# -> Word#
-primop   Narrow16WordOp    "narrow16Word#"    Monadic   Word# -> Word#
-primop   Narrow32WordOp    "narrow32Word#"    Monadic   Word# -> Word#
-
-
-#if WORD_SIZE_IN_BITS < 32
-------------------------------------------------------------------------
-section "Int32#"
-	{Operations on 32-bit integers (Int32\#).  This type is only used
-         if plain Int\# has less than 32 bits.  In any case, the operations
-	 are not primops; they are implemented (if needed) as ccalls instead.}
-------------------------------------------------------------------------
-
-primop   Int32ToIntegerOp   "int32ToInteger#" GenPrimOp 
-   Int32# -> (# Int#, ByteArr# #)
-   with out_of_line = True
-
-
-------------------------------------------------------------------------
-section "Word32#"
-	{Operations on 32-bit unsigned words. This type is only used 
-	 if plain Word\# has less than 32 bits. In any case, the operations
-	 are not primops; they are implemented (if needed) as ccalls instead.}
-------------------------------------------------------------------------
-
-primop   Word32ToIntegerOp   "word32ToInteger#" GenPrimOp
-   Word32# -> (# Int#, ByteArr# #)
-   with out_of_line = True
-
-
-#endif 
-
-
-#if WORD_SIZE_IN_BITS < 64
-------------------------------------------------------------------------
-section "Int64#"
-	{Operations on 64-bit unsigned words. This type is only used 
-	 if plain Int\# has less than 64 bits. In any case, the operations
-	 are not primops; they are implemented (if needed) as ccalls instead.}
-------------------------------------------------------------------------
-
-primop   Int64ToIntegerOp   "int64ToInteger#" GenPrimOp 
-   Int64# -> (# Int#, ByteArr# #)
-   with out_of_line = True
-
-------------------------------------------------------------------------
-section "Word64#"
-	{Operations on 64-bit unsigned words. This type is only used 
-	 if plain Word\# has less than 64 bits. In any case, the operations
-	 are not primops; they are implemented (if needed) as ccalls instead.}
-------------------------------------------------------------------------
-
-primop   Word64ToIntegerOp   "word64ToInteger#" GenPrimOp
-   Word64# -> (# Int#, ByteArr# #)
-   with out_of_line = True
-
-#endif
-
-------------------------------------------------------------------------
-section "Integer#"
-	{Operations on arbitrary-precision integers. These operations are 
-implemented via the GMP package. An integer is represented as a pair
-consisting of an Int\# representing the number of 'limbs' in use and
-the sign, and a ByteArr\# containing the 'limbs' themselves.  Such pairs
-are returned as unboxed pairs, but must be passed as separate
-components.
-
-For .NET these operations are implemented by foreign imports, so the
-primops are omitted.}
-------------------------------------------------------------------------
-
-#ifndef ILX
-
-primop   IntegerAddOp   "plusInteger#" GenPrimOp   
-   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
-   with commutable = True
-        out_of_line = True
-
-primop   IntegerSubOp   "minusInteger#" GenPrimOp  
-   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
-   with out_of_line = True
-
-primop   IntegerMulOp   "timesInteger#" GenPrimOp   
-   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
-   with commutable = True
-        out_of_line = True
-
-primop   IntegerGcdOp   "gcdInteger#" GenPrimOp    
-   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
-   {Greatest common divisor.}
-   with commutable = True
-        out_of_line = True
-
-primop   IntegerIntGcdOp   "gcdIntegerInt#" GenPrimOp
-   Int# -> ByteArr# -> Int# -> Int#
-   {Greatest common divisor, where second argument is an ordinary Int\#.}
-   with out_of_line = True
-
-primop   IntegerDivExactOp   "divExactInteger#" GenPrimOp
-   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
-   {Divisor is guaranteed to be a factor of dividend.}
-   with out_of_line = True
-
-primop   IntegerQuotOp   "quotInteger#" GenPrimOp
-   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
-   {Rounds towards zero.}
-   with out_of_line = True
-
-primop   IntegerRemOp   "remInteger#" GenPrimOp
-   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
-   {Satisfies \texttt{plusInteger\# (timesInteger\# (quotInteger\# x y) y) (remInteger\# x y) == x}.}
-   with out_of_line = True
-
-primop   IntegerCmpOp   "cmpInteger#"   GenPrimOp  
-   Int# -> ByteArr# -> Int# -> ByteArr# -> Int#
-   {Returns -1,0,1 according as first argument is less than, equal to, or greater than second argument.}
-   with needs_wrapper = True
-        out_of_line = True
-
-primop   IntegerCmpIntOp   "cmpIntegerInt#" GenPrimOp
-   Int# -> ByteArr# -> Int# -> Int#
-   {Returns -1,0,1 according as first argument is less than, equal to, or greater than second argument, which
-   is an ordinary Int\#.}
-   with needs_wrapper = True
-        out_of_line = True
-
-primop   IntegerQuotRemOp   "quotRemInteger#" GenPrimOp
-   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr#, Int#, ByteArr# #)
-   {Compute quot and rem simulaneously.}
-   with can_fail = True
-        out_of_line = True
-
-primop   IntegerDivModOp    "divModInteger#"  GenPrimOp
-   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr#, Int#, ByteArr# #)
-   {Compute div and mod simultaneously, where div rounds towards negative infinity
-    and\texttt{(q,r) = divModInteger\#(x,y)} implies \texttt{plusInteger\# (timesInteger\# q y) r = x}.}
-   with can_fail = True
-        out_of_line = True
-
-primop   Integer2IntOp   "integer2Int#"    GenPrimOp
-   Int# -> ByteArr# -> Int#
-   with needs_wrapper = True
-        out_of_line = True
-
-primop   Integer2WordOp   "integer2Word#"   GenPrimOp
-   Int# -> ByteArr# -> Word#
-   with needs_wrapper = True
-        out_of_line = True
-
-#if WORD_SIZE_IN_BITS < 32
-primop   IntegerToInt32Op   "integerToInt32#" GenPrimOp
-   Int# -> ByteArr# -> Int32#
-
-primop   IntegerToWord32Op   "integerToWord32#" GenPrimOp
-   Int# -> ByteArr# -> Word32#
-#endif
-
-primop   IntegerAndOp  "andInteger#" GenPrimOp
-   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
-   with out_of_line = True
-
-primop   IntegerOrOp  "orInteger#" GenPrimOp
-   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
-   with out_of_line = True
-
-primop   IntegerXorOp  "xorInteger#" GenPrimOp
-   Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
-   with out_of_line = True
-
-primop   IntegerComplementOp  "complementInteger#" GenPrimOp
-   Int# -> ByteArr# -> (# Int#, ByteArr# #)
-   with out_of_line = True
-
-#endif /* ndef ILX */
-
-------------------------------------------------------------------------
-section "Double#"
-	{Operations on double-precision (64 bit) floating-point numbers.}
-------------------------------------------------------------------------
-
-primop   DoubleGtOp ">##"   Compare   Double# -> Double# -> Bool
-primop   DoubleGeOp ">=##"   Compare   Double# -> Double# -> Bool
-
-primop DoubleEqOp "==##"   Compare
-   Double# -> Double# -> Bool
-   with commutable = True
-
-primop DoubleNeOp "/=##"   Compare
-   Double# -> Double# -> Bool
-   with commutable = True
-
-primop   DoubleLtOp "<##"   Compare   Double# -> Double# -> Bool
-primop   DoubleLeOp "<=##"   Compare   Double# -> Double# -> Bool
-
-primop   DoubleAddOp   "+##"   Dyadic
-   Double# -> Double# -> Double#
-   with commutable = True
-
-primop   DoubleSubOp   "-##"   Dyadic   Double# -> Double# -> Double#
-
-primop   DoubleMulOp   "*##"   Dyadic
-   Double# -> Double# -> Double#
-   with commutable = True
-
-primop   DoubleDivOp   "/##"   Dyadic
-   Double# -> Double# -> Double#
-   with can_fail = True
-
-primop   DoubleNegOp   "negateDouble#"  Monadic   Double# -> Double#
-
-primop   Double2IntOp   "double2Int#"          GenPrimOp  Double# -> Int#
-primop   Double2FloatOp   "double2Float#" GenPrimOp Double# -> Float#
-
-primop   DoubleExpOp   "expDouble#"      Monadic
-   Double# -> Double#
-   with needs_wrapper = True
-
-primop   DoubleLogOp   "logDouble#"      Monadic         
-   Double# -> Double#
-   with
-   needs_wrapper = True
-   can_fail = True
-
-primop   DoubleSqrtOp   "sqrtDouble#"      Monadic  
-   Double# -> Double#
-   with needs_wrapper = True
-
-primop   DoubleSinOp   "sinDouble#"      Monadic          
-   Double# -> Double#
-   with needs_wrapper = True
-
-primop   DoubleCosOp   "cosDouble#"      Monadic          
-   Double# -> Double#
-   with needs_wrapper = True
-
-primop   DoubleTanOp   "tanDouble#"      Monadic          
-   Double# -> Double#
-   with needs_wrapper = True
-
-primop   DoubleAsinOp   "asinDouble#"      Monadic 
-   Double# -> Double#
-   with
-   needs_wrapper = True
-   can_fail = True
-
-primop   DoubleAcosOp   "acosDouble#"      Monadic  
-   Double# -> Double#
-   with
-   needs_wrapper = True
-   can_fail = True
-
-primop   DoubleAtanOp   "atanDouble#"      Monadic  
-   Double# -> Double#
-   with
-   needs_wrapper = True
-
-primop   DoubleSinhOp   "sinhDouble#"      Monadic  
-   Double# -> Double#
-   with needs_wrapper = True
-
-primop   DoubleCoshOp   "coshDouble#"      Monadic  
-   Double# -> Double#
-   with needs_wrapper = True
-
-primop   DoubleTanhOp   "tanhDouble#"      Monadic  
-   Double# -> Double#
-   with needs_wrapper = True
-
-primop   DoublePowerOp   "**##" Dyadic  
-   Double# -> Double# -> Double#
-   {Exponentiation.}
-   with needs_wrapper = True
-
-primop   DoubleDecodeOp   "decodeDouble#" GenPrimOp    
-   Double# -> (# Int#, Int#, ByteArr# #)
-   {Convert to arbitrary-precision integer.
-    First Int\# in result is the exponent; second Int\# and ByteArr\# represent an Integer\# 
-    holding the mantissa.}
-   with out_of_line = True
-
-------------------------------------------------------------------------
-section "Float#" 
-	{Operations on single-precision (32-bit) floating-point numbers.}
-------------------------------------------------------------------------
-
-primop   FloatGtOp  "gtFloat#"   Compare   Float# -> Float# -> Bool
-primop   FloatGeOp  "geFloat#"   Compare   Float# -> Float# -> Bool
-
-primop   FloatEqOp  "eqFloat#"   Compare
-   Float# -> Float# -> Bool
-   with commutable = True
-
-primop   FloatNeOp  "neFloat#"   Compare
-   Float# -> Float# -> Bool
-   with commutable = True
-
-primop   FloatLtOp  "ltFloat#"   Compare   Float# -> Float# -> Bool
-primop   FloatLeOp  "leFloat#"   Compare   Float# -> Float# -> Bool
-
-primop   FloatAddOp   "plusFloat#"      Dyadic            
-   Float# -> Float# -> Float#
-   with commutable = True
-
-primop   FloatSubOp   "minusFloat#"      Dyadic      Float# -> Float# -> Float#
-
-primop   FloatMulOp   "timesFloat#"      Dyadic    
-   Float# -> Float# -> Float#
-   with commutable = True
-
-primop   FloatDivOp   "divideFloat#"      Dyadic  
-   Float# -> Float# -> Float#
-   with can_fail = True
-
-primop   FloatNegOp   "negateFloat#"      Monadic    Float# -> Float#
-
-primop   Float2IntOp   "float2Int#"      GenPrimOp  Float# -> Int#
-
-primop   FloatExpOp   "expFloat#"      Monadic          
-   Float# -> Float#
-   with needs_wrapper = True
-
-primop   FloatLogOp   "logFloat#"      Monadic          
-   Float# -> Float#
-   with needs_wrapper = True
-        can_fail = True
-
-primop   FloatSqrtOp   "sqrtFloat#"      Monadic          
-   Float# -> Float#
-   with needs_wrapper = True
-
-primop   FloatSinOp   "sinFloat#"      Monadic          
-   Float# -> Float#
-   with needs_wrapper = True
-
-primop   FloatCosOp   "cosFloat#"      Monadic          
-   Float# -> Float#
-   with needs_wrapper = True
-
-primop   FloatTanOp   "tanFloat#"      Monadic          
-   Float# -> Float#
-   with needs_wrapper = True
-
-primop   FloatAsinOp   "asinFloat#"      Monadic          
-   Float# -> Float#
-   with needs_wrapper = True
-        can_fail = True
-
-primop   FloatAcosOp   "acosFloat#"      Monadic          
-   Float# -> Float#
-   with needs_wrapper = True
-        can_fail = True
-
-primop   FloatAtanOp   "atanFloat#"      Monadic          
-   Float# -> Float#
-   with needs_wrapper = True
-
-primop   FloatSinhOp   "sinhFloat#"      Monadic          
-   Float# -> Float#
-   with needs_wrapper = True
-
-primop   FloatCoshOp   "coshFloat#"      Monadic          
-   Float# -> Float#
-   with needs_wrapper = True
-
-primop   FloatTanhOp   "tanhFloat#"      Monadic          
-   Float# -> Float#
-   with needs_wrapper = True
-
-primop   FloatPowerOp   "powerFloat#"      Dyadic   
-   Float# -> Float# -> Float#
-   with needs_wrapper = True
-
-primop   Float2DoubleOp   "float2Double#" GenPrimOp  Float# -> Double#
-
-primop   FloatDecodeOp   "decodeFloat#" GenPrimOp
-   Float# -> (# Int#, Int#, ByteArr# #)
-   {Convert to arbitrary-precision integer.
-    First Int\# in result is the exponent; second Int\# and ByteArr\# represent an Integer\# 
-    holding the mantissa.}
-   with out_of_line = True
-
-------------------------------------------------------------------------
-section "Arrays"
-	{Operations on Array\#.}
-------------------------------------------------------------------------
-
-primop  NewArrayOp "newArray#" GenPrimOp
-   Int# -> a -> State# s -> (# State# s, MutArr# s a #)
-   {Create a new mutable array of specified size (in bytes),
-    in the specified state thread,
-    with each element containing the specified initial value.}
-   with
-   usage       = { mangle NewArrayOp [mkP, mkM, mkP] mkM }
-   out_of_line = True
-
-primop  SameMutableArrayOp "sameMutableArray#" GenPrimOp
-   MutArr# s a -> MutArr# s a -> Bool
-   with
-   usage = { mangle SameMutableArrayOp [mkP, mkP] mkM }
-
-primop  ReadArrayOp "readArray#" GenPrimOp
-   MutArr# s a -> Int# -> State# s -> (# State# s, a #)
-   {Read from specified index of mutable array. Result is not yet evaluated.}
-   with
-   usage = { mangle ReadArrayOp [mkM, mkP, mkP] mkM }
-
-primop  WriteArrayOp "writeArray#" GenPrimOp
-   MutArr# s a -> Int# -> a -> State# s -> State# s
-   {Write to specified index of mutable array.}
-   with
-   usage            = { mangle WriteArrayOp [mkM, mkP, mkM, mkP] mkR }
-   has_side_effects = True
-
-primop  IndexArrayOp "indexArray#" GenPrimOp
-   Array# a -> Int# -> (# a #)
-   {Read from specified index of immutable array. Result is packaged into
-    an unboxed singleton; the result itself is not yet evaluated.}
-   with
-   usage = { mangle  IndexArrayOp [mkM, mkP] mkM }
-
-primop  UnsafeFreezeArrayOp "unsafeFreezeArray#" GenPrimOp
-   MutArr# s a -> State# s -> (# State# s, Array# a #)
-   {Make a mutable array immutable, without copying.}
-   with
-   usage            = { mangle UnsafeFreezeArrayOp [mkM, mkP] mkM }
-   has_side_effects = True
-
-primop  UnsafeThawArrayOp  "unsafeThawArray#" GenPrimOp
-   Array# a -> State# s -> (# State# s, MutArr# s a #)
-   {Make an immutable array mutable, without copying.}
-   with
-   usage       = { mangle UnsafeThawArrayOp [mkM, mkP] mkM }
-   out_of_line = True
-
-------------------------------------------------------------------------
-section "Byte Arrays"
-	{Operations on ByteArray\#. A ByteArray\# is a just a region of
-         raw memory in the garbage-collected heap, which is not scanned
-         for pointers. It carries its own size (in bytes). There are
-	 three sets of operations for accessing byte array contents:
-	 index for reading from immutable byte arrays, and read/write
-	 for mutable byte arrays.  Each set contains operations for 
-	 a range of useful primitive data types.  Each operation takes	
-	 an offset measured in terms of the size fo the primitive type
-	 being read or written.}
-
-------------------------------------------------------------------------
-
-primop  NewByteArrayOp_Char "newByteArray#" GenPrimOp
-   Int# -> State# s -> (# State# s, MutByteArr# s #)
-   {Create a new mutable byte array of specified size (in bytes), in
-    the specified state thread.}
-   with out_of_line = True
-
-primop  NewPinnedByteArrayOp_Char "newPinnedByteArray#" GenPrimOp
-   Int# -> State# s -> (# State# s, MutByteArr# s #)
-   {Create a mutable byte array that the GC guarantees not to move.}
-   with out_of_line = True
-
-primop  ByteArrayContents_Char "byteArrayContents#" GenPrimOp
-   ByteArr# -> Addr#
-   {Intended for use with pinned arrays; otherwise very unsafe!}
-
-primop  SameMutableByteArrayOp "sameMutableByteArray#" GenPrimOp
-   MutByteArr# s -> MutByteArr# s -> Bool
-
-primop  UnsafeFreezeByteArrayOp "unsafeFreezeByteArray#" GenPrimOp
-   MutByteArr# s -> State# s -> (# State# s, ByteArr# #)
-   {Make a mutable byte array immutable, without copying.}
-   with
-   has_side_effects = True
-
-primop  SizeofByteArrayOp "sizeofByteArray#" GenPrimOp  
-   ByteArr# -> Int#
-
-primop  SizeofMutableByteArrayOp "sizeofMutableByteArray#" GenPrimOp
-   MutByteArr# s -> Int#
-
-
-primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp
-   ByteArr# -> Int# -> Char#
-   {Read 8-bit character; offset in bytes.}
-
-primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp
-   ByteArr# -> Int# -> Char#
-   {Read 31-bit character; offset in 4-byte words.}
-
-primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp
-   ByteArr# -> Int# -> Int#
-
-primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp
-   ByteArr# -> Int# -> Word#
-
-primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp
-   ByteArr# -> Int# -> Addr#
-
-primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp
-   ByteArr# -> Int# -> Float#
-
-primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp
-   ByteArr# -> Int# -> Double#
-
-primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp
-   ByteArr# -> Int# -> StablePtr# a
-
-primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp
-   ByteArr# -> Int# -> Int#
-
-primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp
-   ByteArr# -> Int# -> Int#
-
-primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp
-   ByteArr# -> Int# -> INT32
-
-primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp
-   ByteArr# -> Int# -> INT64
-
-primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp
-   ByteArr# -> Int# -> Word#
-
-primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp
-   ByteArr# -> Int# -> Word#
-
-primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp
-   ByteArr# -> Int# -> WORD32
-
-primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp
-   ByteArr# -> Int# -> WORD64
-
-primop  ReadByteArrayOp_Char "readCharArray#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #)
-   {Read 8-bit character; offset in bytes.}
-
-primop  ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #)
-   {Read 31-bit character; offset in 4-byte words.}
-
-primop  ReadByteArrayOp_Int "readIntArray#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
-
-primop  ReadByteArrayOp_Word "readWordArray#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
-
-primop  ReadByteArrayOp_Addr "readAddrArray#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, Addr# #)
-
-primop  ReadByteArrayOp_Float "readFloatArray#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, Float# #)
-
-primop  ReadByteArrayOp_Double "readDoubleArray#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, Double# #)
-
-primop  ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, StablePtr# a #)
-
-primop  ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
-
-primop  ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
-
-primop  ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, INT32 #)
-
-primop  ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, INT64 #)
-
-primop  ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
-
-primop  ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
-
-primop  ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, WORD32 #)
-
-primop  ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp
-   MutByteArr# s -> Int# -> State# s -> (# State# s, WORD64 #)
-
-primop  WriteByteArrayOp_Char "writeCharArray#" GenPrimOp
-   MutByteArr# s -> Int# -> Char# -> State# s -> State# s
-   {Write 8-bit character; offset in bytes.}
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp
-   MutByteArr# s -> Int# -> Char# -> State# s -> State# s
-   {Write 31-bit character; offset in 4-byte words.}
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Int "writeIntArray#" GenPrimOp
-   MutByteArr# s -> Int# -> Int# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Word "writeWordArray#" GenPrimOp
-   MutByteArr# s -> Int# -> Word# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Addr "writeAddrArray#" GenPrimOp
-   MutByteArr# s -> Int# -> Addr# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Float "writeFloatArray#" GenPrimOp
-   MutByteArr# s -> Int# -> Float# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Double "writeDoubleArray#" GenPrimOp
-   MutByteArr# s -> Int# -> Double# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_StablePtr "writeStablePtrArray#" GenPrimOp
-   MutByteArr# s -> Int# -> StablePtr# a -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp
-   MutByteArr# s -> Int# -> Int# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp
-   MutByteArr# s -> Int# -> Int# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp
-   MutByteArr# s -> Int# -> INT32 -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp
-   MutByteArr# s -> Int# -> INT64 -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp
-   MutByteArr# s -> Int# -> Word# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp
-   MutByteArr# s -> Int# -> Word# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp
-   MutByteArr# s -> Int# -> WORD32 -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp
-   MutByteArr# s -> Int# -> WORD64 -> State# s -> State# s
-   with has_side_effects = True
-
-------------------------------------------------------------------------
-section "Addr#"
-	{Addr\# is an arbitrary machine address assumed to point outside
-	 the garbage-collected heap.  
-
-	 NB: {\tt nullAddr\#::Addr\#} is not a primop, but is defined in MkId.lhs.
-	 It is the null address.}
-------------------------------------------------------------------------
-
-primop	 AddrAddOp "plusAddr#" GenPrimOp Addr# -> Int# -> Addr#
-primop	 AddrSubOp "minusAddr#" GenPrimOp Addr# -> Addr# -> Int#
-	 {Result is meaningless if two Addr\#s are so far apart that their
-	 difference doesn't fit in an Int\#.}
-primop	 AddrRemOp "remAddr#" GenPrimOp Addr# -> Int# -> Int#
-	 {Return the remainder when the Addr\# arg, treated like an Int\#,
-	  is divided by the Int\# arg.}
-#if (WORD_SIZE_IN_BITS == 32 || WORD_SIZE_IN_BITS == 64)
-primop   Addr2IntOp  "addr2Int#"     GenPrimOp   Addr# -> Int#
-	{Coerce directly from address to int. Strongly deprecated.}
-primop   Int2AddrOp   "int2Addr#"    GenPrimOp  Int# -> Addr#
-	{Coerce directly from int to address. Strongly deprecated.}
-#endif
-
-primop   AddrGtOp  "gtAddr#"   Compare   Addr# -> Addr# -> Bool
-primop   AddrGeOp  "geAddr#"   Compare   Addr# -> Addr# -> Bool
-primop   AddrEqOp  "eqAddr#"   Compare   Addr# -> Addr# -> Bool
-primop   AddrNeOp  "neAddr#"   Compare   Addr# -> Addr# -> Bool
-primop   AddrLtOp  "ltAddr#"   Compare   Addr# -> Addr# -> Bool
-primop   AddrLeOp  "leAddr#"   Compare   Addr# -> Addr# -> Bool
-
-primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp
-   Addr# -> Int# -> Char#
-   {Reads 8-bit character; offset in bytes.}
-
-primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp
-   Addr# -> Int# -> Char#
-   {Reads 31-bit character; offset in 4-byte words.}
-
-primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp
-   Addr# -> Int# -> Int#
-
-primop IndexOffAddrOp_Word "indexWordOffAddr#" GenPrimOp
-   Addr# -> Int# -> Word#
-
-primop IndexOffAddrOp_Addr "indexAddrOffAddr#" GenPrimOp
-   Addr# -> Int# -> Addr#
-
-primop IndexOffAddrOp_Float "indexFloatOffAddr#" GenPrimOp
-   Addr# -> Int# -> Float#
-
-primop IndexOffAddrOp_Double "indexDoubleOffAddr#" GenPrimOp
-   Addr# -> Int# -> Double#
-
-primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp
-   Addr# -> Int# -> StablePtr# a
-
-primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp
-   Addr# -> Int# -> Int#
-
-primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp
-   Addr# -> Int# -> Int#
-
-primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp
-   Addr# -> Int# -> INT32
-
-primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp
-   Addr# -> Int# -> INT64
-
-primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp
-   Addr# -> Int# -> Word#
-
-primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp
-   Addr# -> Int# -> Word#
-
-primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp
-   Addr# -> Int# -> WORD32
-
-primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp
-   Addr# -> Int# -> WORD64
-
-primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Char# #)
-   {Reads 8-bit character; offset in bytes.}
-
-primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Char# #)
-   {Reads 31-bit character; offset in 4-byte words.}
-
-primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Int# #)
-
-primop ReadOffAddrOp_Word "readWordOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Word# #)
-
-primop ReadOffAddrOp_Addr "readAddrOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Addr# #)
-
-primop ReadOffAddrOp_Float "readFloatOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Float# #)
-
-primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Double# #)
-
-primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #)
-
-primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Int# #)
-
-primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Int# #)
-
-primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, INT32 #)
-
-primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, INT64 #)
-
-primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Word# #)
-
-primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, Word# #)
-
-primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, WORD32 #)
-
-primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp
-   Addr# -> Int# -> State# s -> (# State# s, WORD64 #)
-
-
-primop  WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp
-   Addr# -> Int# -> Char# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp
-   Addr# -> Int# -> Char# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp
-   Addr# -> Int# -> Int# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Word "writeWordOffAddr#" GenPrimOp
-   Addr# -> Int# -> Word# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp
-   Addr# -> Int# -> Addr# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp
-   Addr# -> Int# -> Float# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Double "writeDoubleOffAddr#" GenPrimOp
-   Addr# -> Int# -> Double# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp
-   Addr# -> Int# -> StablePtr# a -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp
-   Addr# -> Int# -> Int# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp
-   Addr# -> Int# -> Int# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp
-   Addr# -> Int# -> INT32 -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp
-   Addr# -> Int# -> INT64 -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp
-   Addr# -> Int# -> Word# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp
-   Addr# -> Int# -> Word# -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp
-   Addr# -> Int# -> WORD32 -> State# s -> State# s
-   with has_side_effects = True
-
-primop  WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp
-   Addr# -> Int# -> WORD64 -> State# s -> State# s
-   with has_side_effects = True
-
-------------------------------------------------------------------------
-section "Mutable variables"
-	{Operations on MutVar\#s, which behave like single-element mutable arrays.}
-------------------------------------------------------------------------
-
-primop  NewMutVarOp "newMutVar#" GenPrimOp
-   a -> State# s -> (# State# s, MutVar# s a #)
-   {Create MutVar\# with specified initial value in specified state thread.}
-   with
-   usage       = { mangle NewMutVarOp [mkM, mkP] mkM }
-   out_of_line = True
-
-primop  ReadMutVarOp "readMutVar#" GenPrimOp
-   MutVar# s a -> State# s -> (# State# s, a #)
-   {Read contents of MutVar\#. Result is not yet evaluated.}
-   with
-   usage = { mangle ReadMutVarOp [mkM, mkP] mkM }
-
-primop  WriteMutVarOp "writeMutVar#"  GenPrimOp
-   MutVar# s a -> a -> State# s -> State# s
-   {Write contents of MutVar\#.}
-   with
-   usage            = { mangle WriteMutVarOp [mkM, mkM, mkP] mkR }
-   has_side_effects = True
-
-primop  SameMutVarOp "sameMutVar#" GenPrimOp
-   MutVar# s a -> MutVar# s a -> Bool
-   with
-   usage = { mangle SameMutVarOp [mkP, mkP] mkM }
-
--- not really the right type, but we don't know about pairs here.  The
--- correct type is
---
---   MutVar# s a -> (a -> (a,b)) -> State# s -> (# State# s, b #)
---
-primop  AtomicModifyMutVarOp "atomicModifyMutVar#" GenPrimOp
-   MutVar# s a -> (a -> b) -> State# s -> (# State# s, c #)
-   with
-   usage = { mangle AtomicModifyMutVarOp [mkP, mkM, mkP] mkM }
-   has_side_effects = True
-   out_of_line = True
-
-------------------------------------------------------------------------
-section "Exceptions"
-------------------------------------------------------------------------
-
-primop  CatchOp "catch#" GenPrimOp
-          (State# RealWorld -> (# State# RealWorld, a #) )
-       -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) 
-       -> State# RealWorld
-       -> (# State# RealWorld, a #)
-   with
-	-- Catch is actually strict in its first argument
-	-- but we don't want to tell the strictness
-	-- analyser about that!
-   usage = { mangle CatchOp [mkM, mkM . (inFun CatchOp mkM mkM), mkP] mkM }
-        --     [mkO, mkO . (inFun mkM mkO)] mkO
-        -- might use caught action multiply
-   out_of_line = True
-
-primop  RaiseOp "raise#" GenPrimOp
-   a -> b
-   with
-   strictness  = { \ arity -> mkStrictSig (mkTopDmdType [lazyDmd] BotRes) }
-      -- NB: result is bottom
-   usage       = { mangle RaiseOp [mkM] mkM }
-   out_of_line = True
-
--- raiseIO# needs to be a primop, because exceptions in the IO monad
--- must be *precise* - we don't want the strictness analyser turning
--- one kind of bottom into another, as it is allowed to do in pure code.
-
-primop  RaiseIOOp "raiseIO#" GenPrimOp
-   a -> State# RealWorld -> (# State# RealWorld, b #)
-   with
-   out_of_line = True
-
-primop  BlockAsyncExceptionsOp "blockAsyncExceptions#" GenPrimOp
-        (State# RealWorld -> (# State# RealWorld, a #))
-     -> (State# RealWorld -> (# State# RealWorld, a #))
-   with
-   out_of_line = True
-
-primop  UnblockAsyncExceptionsOp "unblockAsyncExceptions#" GenPrimOp
-        (State# RealWorld -> (# State# RealWorld, a #))
-     -> (State# RealWorld -> (# State# RealWorld, a #))
-   with
-   out_of_line = True
-
-------------------------------------------------------------------------
-section "STM-accessible Mutable Variables"
-------------------------------------------------------------------------
-
-primop	AtomicallyOp "atomically#" GenPrimOp
-      (State# RealWorld -> (# State# RealWorld, a #) )
-   -> State# RealWorld -> (# State# RealWorld, a #)
-   with
-   out_of_line = True
-   has_side_effects = True
-
-primop  RetryOp "retry#" GenPrimOp
-   State# RealWorld -> (# State# RealWorld, a #)
-   with 
-   out_of_line = True
-   has_side_effects = True
-
-primop  CatchRetryOp "catchRetry#" GenPrimOp
-      (State# RealWorld -> (# State# RealWorld, a #) )
-   -> (State# RealWorld -> (# State# RealWorld, a #) )
-   -> (State# RealWorld -> (# State# RealWorld, a #) )
-   with 
-   out_of_line = True
-   has_side_effects = True
-
-primop  CatchSTMOp "catchSTM#" GenPrimOp
-      (State# RealWorld -> (# State# RealWorld, a #) )
-   -> (b -> State# RealWorld -> (# State# RealWorld, a #) )
-   -> (State# RealWorld -> (# State# RealWorld, a #) )
-   with 
-   out_of_line = True
-   has_side_effects = True
-
-primop	NewTVarOp "newTVar#" GenPrimOp
-       a
-    -> State# s -> (# State# s, TVar# s a #)
-   {Create a new Tar\# holding a specified initial value.}
-   with
-   out_of_line  = True
-
-primop	ReadTVarOp "readTVar#" GenPrimOp
-       TVar# s a
-    -> State# s -> (# State# s, a #)
-   {Read contents of TVar\#.  Result is not yet evaluated.}
-   with
-   out_of_line	= True
-
-primop	WriteTVarOp "writeTVar#" GenPrimOp
-       TVar# s a
-    -> a
-    -> State# s -> State# s
-   {Write contents of TVar\#.}
-   with
-   out_of_line	    = True
-   has_side_effects = True
-
-primop  SameTVarOp "sameTVar#" GenPrimOp
-   TVar# s a -> TVar# s a -> Bool
-
-
-------------------------------------------------------------------------
-section "Synchronized Mutable Variables"
-	{Operations on MVar\#s, which are shared mutable variables
-	({\it not} the same as MutVar\#s!). (Note: in a non-concurrent implementation,
-	(MVar\# a) can be represented by (MutVar\# (Maybe a)).)}
-------------------------------------------------------------------------
-
-
-primop  NewMVarOp "newMVar#"  GenPrimOp
-   State# s -> (# State# s, MVar# s a #)
-   {Create new mvar; initially empty.}
-   with
-   usage       = { mangle NewMVarOp [mkP] mkR }
-   out_of_line = True
-
-primop  TakeMVarOp "takeMVar#" GenPrimOp
-   MVar# s a -> State# s -> (# State# s, a #)
-   {If mvar is empty, block until it becomes full.
-   Then remove and return its contents, and set it empty.}
-   with
-   usage            = { mangle TakeMVarOp [mkM, mkP] mkM }
-   has_side_effects = True
-   out_of_line      = True
-
-primop  TryTakeMVarOp "tryTakeMVar#" GenPrimOp
-   MVar# s a -> State# s -> (# State# s, Int#, a #)
-   {If mvar is empty, immediately return with integer 0 and value undefined.
-   Otherwise, return with integer 1 and contents of mvar, and set mvar empty.}
-   with
-   usage            = { mangle TryTakeMVarOp [mkM, mkP] mkM }
-   has_side_effects = True
-   out_of_line      = True
-
-primop  PutMVarOp "putMVar#" GenPrimOp
-   MVar# s a -> a -> State# s -> State# s
-   {If mvar is full, block until it becomes empty.
-   Then store value arg as its new contents.}
-   with
-   usage            = { mangle PutMVarOp [mkM, mkM, mkP] mkR }
-   has_side_effects = True
-   out_of_line      = True
-
-primop  TryPutMVarOp "tryPutMVar#" GenPrimOp
-   MVar# s a -> a -> State# s -> (# State# s, Int# #)
-   {If mvar is full, immediately return with integer 0.
-    Otherwise, store value arg as mvar's new contents, and return with integer 1.}
-   with
-   usage            = { mangle TryPutMVarOp [mkM, mkM, mkP] mkR }
-   has_side_effects = True
-   out_of_line      = True
-
-primop  SameMVarOp "sameMVar#" GenPrimOp
-   MVar# s a -> MVar# s a -> Bool
-   with
-   usage = { mangle SameMVarOp [mkP, mkP] mkM }
-
-primop  IsEmptyMVarOp "isEmptyMVar#" GenPrimOp
-   MVar# s a -> State# s -> (# State# s, Int# #)
-   {Return 1 if mvar is empty; 0 otherwise.}
-   with
-   usage = { mangle IsEmptyMVarOp [mkP, mkP] mkM }
-   out_of_line = True
-
-------------------------------------------------------------------------
-section "Delay/wait operations"
-------------------------------------------------------------------------
-
-primop  DelayOp "delay#" GenPrimOp
-   Int# -> State# s -> State# s
-   {Sleep specified number of microseconds.}
-   with
-   needs_wrapper    = True
-   has_side_effects = True
-   out_of_line      = True
-
-primop  WaitReadOp "waitRead#" GenPrimOp
-   Int# -> State# s -> State# s
-   {Block until input is available on specified file descriptor.}
-   with
-   needs_wrapper    = True
-   has_side_effects = True
-   out_of_line      = True
-
-primop  WaitWriteOp "waitWrite#" GenPrimOp
-   Int# -> State# s -> State# s
-   {Block until output is possible on specified file descriptor.}
-   with
-   needs_wrapper    = True
-   has_side_effects = True
-   out_of_line      = True
-
-#ifdef mingw32_TARGET_OS
-primop  AsyncReadOp "asyncRead#" GenPrimOp
-   Int# -> Int# -> Int# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
-   {Asynchronously read bytes from specified file descriptor.}
-   with
-   needs_wrapper    = True
-   has_side_effects = True
-   out_of_line      = True
-
-primop  AsyncWriteOp "asyncWrite#" GenPrimOp
-   Int# -> Int# -> Int# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
-   {Asynchronously write bytes from specified file descriptor.}
-   with
-   needs_wrapper    = True
-   has_side_effects = True
-   out_of_line      = True
-
-primop  AsyncDoProcOp "asyncDoProc#" GenPrimOp
-   Addr# -> Addr# -> State# RealWorld-> (# State# RealWorld, Int#, Int# #)
-   {Asynchronously perform procedure (first arg), passing it 2nd arg.}
-   with
-   needs_wrapper    = True
-   has_side_effects = True
-   out_of_line      = True
-
-#endif
-
-------------------------------------------------------------------------
-section "Concurrency primitives"
-	{(In a non-concurrent implementation, ThreadId\# can be as singleton
-	type, whose (unique) value is returned by myThreadId\#.  The 
-	other operations can be omitted.)}
-------------------------------------------------------------------------
-
-primop  ForkOp "fork#" GenPrimOp
-   a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
-   with
-   usage            = { mangle ForkOp [mkO, mkP] mkR }
-   has_side_effects = True
-   out_of_line      = True
-
-primop  ForkOnOp "forkOn#" GenPrimOp
-   Int# -> a -> State# RealWorld -> (# State# RealWorld, ThreadId# #)
-   with
-   usage            = { mangle ForkOnOp [mkO, mkP] mkR }
-   has_side_effects = True
-   out_of_line      = True
-
-primop  KillThreadOp "killThread#"  GenPrimOp
-   ThreadId# -> a -> State# RealWorld -> State# RealWorld
-   with
-   usage            = { mangle KillThreadOp [mkP, mkM, mkP] mkR }
-   has_side_effects = True
-   out_of_line      = True
-
-primop  YieldOp "yield#" GenPrimOp
-   State# RealWorld -> State# RealWorld
-   with
-   has_side_effects = True
-   out_of_line      = True
-
-primop  MyThreadIdOp "myThreadId#" GenPrimOp
-   State# RealWorld -> (# State# RealWorld, ThreadId# #)
-   with
-   out_of_line = True
-
-primop LabelThreadOp "labelThread#" GenPrimOp
-   ThreadId# -> Addr# -> State# RealWorld -> State# RealWorld
-   with
-   has_side_effects = True
-   out_of_line      = True
-   
-primop  IsCurrentThreadBoundOp "isCurrentThreadBound#" GenPrimOp
-   State# RealWorld -> (# State# RealWorld, Int# #)
-   with
-   out_of_line = True
-
-------------------------------------------------------------------------
-section "Weak pointers"
-------------------------------------------------------------------------
-
--- note that tyvar "o" denotes openAlphaTyVar
-
-primop  MkWeakOp "mkWeak#" GenPrimOp
-   o -> b -> c -> State# RealWorld -> (# State# RealWorld, Weak# b #)
-   with
-   usage            = { mangle MkWeakOp [mkZ, mkM, mkM, mkP] mkM }
-   has_side_effects = True
-   out_of_line      = True
-
-primop  DeRefWeakOp "deRefWeak#" GenPrimOp
-   Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, a #)
-   with
-   usage            = { mangle DeRefWeakOp [mkM, mkP] mkM }
-   has_side_effects = True
-   out_of_line      = True
-
-primop  FinalizeWeakOp "finalizeWeak#" GenPrimOp
-   Weak# a -> State# RealWorld -> (# State# RealWorld, Int#, 
-              (State# RealWorld -> (# State# RealWorld, () #)) #)
-   with
-   usage            = { mangle FinalizeWeakOp [mkM, mkP] 
-                               (mkR . (inUB FinalizeWeakOp 
-                                            [id,id,inFun FinalizeWeakOp mkR mkM])) }
-   has_side_effects = True
-   out_of_line      = True
-
-primop TouchOp "touch#" GenPrimOp
-   o -> State# RealWorld -> State# RealWorld
-   with
-   has_side_effects = True
-
-------------------------------------------------------------------------
-section "Stable pointers and names"
-------------------------------------------------------------------------
-
-primop  MakeStablePtrOp "makeStablePtr#" GenPrimOp
-   a -> State# RealWorld -> (# State# RealWorld, StablePtr# a #)
-   with
-   usage            = { mangle MakeStablePtrOp [mkM, mkP] mkM }
-   has_side_effects = True
-   out_of_line      = True
-
-primop  DeRefStablePtrOp "deRefStablePtr#" GenPrimOp
-   StablePtr# a -> State# RealWorld -> (# State# RealWorld, a #)
-   with
-   usage            = { mangle DeRefStablePtrOp [mkM, mkP] mkM }
-   needs_wrapper    = True
-   has_side_effects = True
-   out_of_line      = True
-
-primop  EqStablePtrOp "eqStablePtr#" GenPrimOp
-   StablePtr# a -> StablePtr# a -> Int#
-   with
-   usage            = { mangle EqStablePtrOp [mkP, mkP] mkR }
-   has_side_effects = True
-
-primop  MakeStableNameOp "makeStableName#" GenPrimOp
-   a -> State# RealWorld -> (# State# RealWorld, StableName# a #)
-   with
-   usage            = { mangle MakeStableNameOp [mkZ, mkP] mkR }
-   needs_wrapper    = True
-   has_side_effects = True
-   out_of_line      = True
-
-primop  EqStableNameOp "eqStableName#" GenPrimOp
-   StableName# a -> StableName# a -> Int#
-   with
-   usage = { mangle EqStableNameOp [mkP, mkP] mkR }
-
-primop  StableNameToIntOp "stableNameToInt#" GenPrimOp
-   StableName# a -> Int#
-   with
-   usage = { mangle StableNameToIntOp [mkP] mkR }
-
-------------------------------------------------------------------------
-section "Unsafe pointer equality"
---  (#1 Bad Guy: Alistair Reid :)   
-------------------------------------------------------------------------
-
-primop  ReallyUnsafePtrEqualityOp "reallyUnsafePtrEquality#" GenPrimOp
-   a -> a -> Int#
-   with
-   usage = { mangle ReallyUnsafePtrEqualityOp [mkZ, mkZ] mkR }
-
-------------------------------------------------------------------------
-section "Parallelism"
-------------------------------------------------------------------------
-
-primop  ParOp "par#" GenPrimOp
-   a -> Int#
-   with
-   usage            = { mangle ParOp [mkO] mkR }
-      -- Note that Par is lazy to avoid that the sparked thing
-      -- gets evaluted strictly, which it should *not* be
-   has_side_effects = True
-
--- HWL: The first 4 Int# in all par... annotations denote:
---   name, granularity info, size of result, degree of parallelism
---      Same  structure as _seq_ i.e. returns Int#
--- KSW: v, the second arg in parAt# and parAtForNow#, is used only to determine
---   `the processor containing the expression v'; it is not evaluated
-
-primop  ParGlobalOp  "parGlobal#"  GenPrimOp
-   a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
-   with
-   usage            = { mangle ParGlobalOp [mkO, mkP, mkP, mkP, mkP, mkM] mkM }
-   has_side_effects = True
-
-primop  ParLocalOp  "parLocal#"  GenPrimOp
-   a -> Int# -> Int# -> Int# -> Int# -> b -> Int#
-   with
-   usage            = { mangle ParLocalOp [mkO, mkP, mkP, mkP, mkP, mkM] mkM }
-   has_side_effects = True
-
-primop  ParAtOp  "parAt#"  GenPrimOp
-   b -> a -> Int# -> Int# -> Int# -> Int# -> c -> Int#
-   with
-   usage            = { mangle ParAtOp [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM }
-   has_side_effects = True
-
-primop  ParAtAbsOp  "parAtAbs#"  GenPrimOp
-   a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
-   with
-   usage            = { mangle ParAtAbsOp [mkO, mkP, mkP, mkP, mkP, mkM] mkM }
-   has_side_effects = True
-
-primop  ParAtRelOp  "parAtRel#" GenPrimOp
-   a -> Int# -> Int# -> Int# -> Int# -> Int# -> b -> Int#
-   with
-   usage            = { mangle ParAtRelOp [mkO, mkP, mkP, mkP, mkP, mkM] mkM }
-   has_side_effects = True
-
-primop  ParAtForNowOp  "parAtForNow#" GenPrimOp
-   b -> a -> Int# -> Int# -> Int# -> Int# -> c -> Int#
-   with
-   usage            = { mangle ParAtForNowOp [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM }
-   has_side_effects = True
-
--- copyable# and noFollow# are yet to be implemented (for GpH)
---
---primop  CopyableOp  "copyable#" GenPrimOp
---   a -> Int#
---   with
---   usage            = { mangle CopyableOp [mkZ] mkR }
---   has_side_effects = True
---
---primop  NoFollowOp "noFollow#" GenPrimOp
---   a -> Int#
---   with
---   usage            = { mangle NoFollowOp [mkZ] mkR }
---   has_side_effects = True
-
-
-------------------------------------------------------------------------
-section "Tag to enum stuff"
-	{Convert back and forth between values of enumerated types
-	and small integers.}
-------------------------------------------------------------------------
-
-primop  DataToTagOp "dataToTag#" GenPrimOp
-   a -> Int#
-   with
-   strictness  = { \ arity -> mkStrictSig (mkTopDmdType [seqDmd] TopRes) }
-	-- dataToTag# must have an evaluated argument
-
-primop  TagToEnumOp "tagToEnum#" GenPrimOp     
-   Int# -> a
-
-------------------------------------------------------------------------
-section "Bytecode operations" 
-	{Support for the bytecode interpreter and linker.}
-------------------------------------------------------------------------
-
-
-primop   AddrToHValueOp "addrToHValue#" GenPrimOp
-   Addr# -> (# a #)
-   {Convert an Addr\# to a followable type.}
-
-primop   MkApUpd0_Op "mkApUpd0#" GenPrimOp
-   BCO# -> (# a #)
-   with
-   out_of_line = True
-
-primop  NewBCOOp "newBCO#" GenPrimOp
-   ByteArr# -> ByteArr# -> Array# a -> ByteArr# -> Int# -> ByteArr# -> State# s -> (# State# s, BCO# #)
-   with
-   has_side_effects = True
-   out_of_line      = True
-
-------------------------------------------------------------------------
-section "Coercion" 
-	{{\tt unsafeCoerce\# :: a -> b} is not a primop, but is defined in MkId.lhs.}
-
-------------------------------------------------------------------------
-
-
-------------------------------------------------------------------------
----                                                                  ---
-------------------------------------------------------------------------
-
-thats_all_folks
-
-
-
diff --git a/ghc/compiler/profiling/CostCentre.lhs b/ghc/compiler/profiling/CostCentre.lhs
deleted file mode 100644
index 3ee46a88db..0000000000
--- a/ghc/compiler/profiling/CostCentre.lhs
+++ /dev/null
@@ -1,373 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[CostCentre]{The @CostCentre@ data type}
-
-\begin{code}
-module CostCentre (
-	CostCentre(..), CcName, IsDupdCC(..), IsCafCC(..),
-		-- All abstract except to friend: ParseIface.y
-
-	CostCentreStack,
-	CollectedCCs,
-	noCCS, subsumedCCS, currentCCS, overheadCCS, dontCareCCS,
-	noCostCentre, noCCAttached,
-	noCCSAttached, isCurrentCCS,  isSubsumedCCS, currentOrSubsumedCCS,
-	isDerivedFromCurrentCCS, maybeSingletonCCS,
-	decomposeCCS,
-
-	mkUserCC, mkAutoCC, mkAllCafsCC, 
-	mkSingletonCCS, dupifyCC, pushCCOnCCS,
-	isCafCCS, isCafCC,
-	isSccCountCostCentre,
-	sccAbleCostCentre,
-	ccFromThisModule,
-
-	pprCostCentreCore,
-	costCentreUserName,
-
-	cmpCostCentre	-- used for removing dups in a list
-    ) where
-
-#include "HsVersions.h"
-
-import Var		( Id )
-import Name		( getOccName, occNameFS )
-import Module		( Module, moduleFS )
-import Outputable	
-import FastTypes
-import FastString
-import Util	        ( thenCmp )
-\end{code}
-
-A Cost Centre Stack is something that can be attached to a closure.
-This is either:
-	
-	- the current cost centre stack (CCCS)
-	- a pre-defined cost centre stack (there are several
-	  pre-defined CCSs, see below).
-
-\begin{code}
-data CostCentreStack
-  = NoCCS
-
-  | CurrentCCS		-- Pinned on a let(rec)-bound 
-			-- thunk/function/constructor, this says that the 
-			-- cost centre to be attached to the object, when it 
-			-- is allocated, is whatever is in the 
-			-- current-cost-centre-stack register.
-
-  | SubsumedCCS		-- Cost centre stack for top-level subsumed functions
-			-- (CAFs get an AllCafsCC).
-			-- Its execution costs get subsumed into the caller.
-			-- This guy is *only* ever pinned on static closures,
-			-- and is *never* the cost centre for an SCC construct.
-
-  | OverheadCCS		-- We charge costs due to the profiling-system
-  			-- doing its work to "overhead".
-			--
-			-- Objects whose CCS is "Overhead"
-			-- have their *allocation* charged to "overhead",
-			-- but have the current CCS put into the object
-			-- itself.
-
-			-- For example, if we transform "f g" to "let
-			-- g' = g in f g'" (so that something about
-			-- profiling works better...), then we charge
-			-- the *allocation* of g' to OverheadCCS, but
-			-- we put the cost-centre of the call to f
-			-- (i.e., current CCS) into the g' object.  When
-			-- g' is entered, the CCS of the call
-			-- to f will be set.
-
-  | DontCareCCS		-- We need a CCS to stick in static closures
-			-- (for data), but we *don't* expect them to
-			-- accumulate any costs.  But we still need
-			-- the placeholder.  This CCS is it.
-
-  | PushCC CostCentre CostCentreStack
-		-- These are used during code generation as the CCSs
-		-- attached to closures.  A PushCC never appears as
-		-- the argument to an _scc_.
-		--
-		-- The tail (2nd argument) is either NoCCS, indicating
-		-- a staticly allocated CCS, or CurrentCCS indicating
-		-- a dynamically created CCS.  We only support
-		-- statically allocated *singleton* CCSs at the
-		-- moment, for the purposes of initialising the CCS
-		-- field of a CAF.
-
-  deriving (Eq, Ord)	-- needed for Ord on CLabel
-\end{code}
-
-A Cost Centre is the argument of an _scc_ expression.
- 
-\begin{code}
-data CostCentre
-  = NoCostCentre	-- Having this constructor avoids having
-			-- to use "Maybe CostCentre" all the time.
-
-  | NormalCC {  
-		cc_name :: CcName,	-- Name of the cost centre itself
-		cc_mod  :: Module,	-- Name of module defining this CC.
-		cc_is_dupd :: IsDupdCC,	-- see below
-		cc_is_caf  :: IsCafCC	-- see below
-    }
-
-  | AllCafsCC {	
-		cc_mod  :: Module	-- Name of module defining this CC.
-    }
-
-type CcName = FastString
-
-data IsDupdCC
-  = OriginalCC	-- This says how the CC is *used*.  Saying that
-  | DupdCC		-- it is DupdCC doesn't make it a different
-			-- CC, just that it a sub-expression which has
-			-- been moved ("dupd") into a different scope.
-			--
-			-- The point about a dupd SCC is that we don't
-			-- count entries to it, because it's not the
-			-- "original" one.
-			--
-			-- In the papers, it's called "SCCsub",
-			--  i.e. SCCsub CC == SCC DupdCC,
-			-- but we are trying to avoid confusion between
-			-- "subd" and "subsumed".  So we call the former
-			-- "dupd".
-
-data IsCafCC = CafCC | NotCafCC
-
--- synonym for triple which describes the cost centre info in the generated
--- code for a module.
-type CollectedCCs
-  = ( [CostCentre]       -- local cost-centres that need to be decl'd
-    , [CostCentre]       -- "extern" cost-centres
-    , [CostCentreStack]  -- pre-defined "singleton" cost centre stacks
-    )
-\end{code}
-
-WILL: Would there be any merit to recording ``I am now using a
-cost-centre from another module''?  I don't know if this would help a
-user; it might be interesting to us to know how much computation is
-being moved across module boundaries.
-
-SIMON: Maybe later...
-
-\begin{code}
-
-noCCS 			= NoCCS
-subsumedCCS 		= SubsumedCCS
-currentCCS	 	= CurrentCCS
-overheadCCS	 	= OverheadCCS
-dontCareCCS	 	= DontCareCCS
-
-noCostCentre  		= NoCostCentre
-\end{code}
-
-Predicates on Cost-Centre Stacks
-
-\begin{code}
-noCCSAttached NoCCS			= True
-noCCSAttached _				= False
-
-noCCAttached NoCostCentre		= True
-noCCAttached _				= False
-
-isCurrentCCS CurrentCCS			= True
-isCurrentCCS _	      			= False
-
-isSubsumedCCS SubsumedCCS 		= True
-isSubsumedCCS _		     		= False
-
-isCafCCS (PushCC cc NoCCS)		= isCafCC cc
-isCafCCS _				= False
-
-isDerivedFromCurrentCCS CurrentCCS	= True
-isDerivedFromCurrentCCS (PushCC _ ccs)	= isDerivedFromCurrentCCS ccs
-isDerivedFromCurrentCCS _		= False
-
-currentOrSubsumedCCS SubsumedCCS	= True
-currentOrSubsumedCCS CurrentCCS		= True
-currentOrSubsumedCCS _			= False
-
-maybeSingletonCCS (PushCC cc NoCCS)	= Just cc
-maybeSingletonCCS _			= Nothing
-\end{code}
-
-Building cost centres
-
-\begin{code}
-mkUserCC :: FastString -> Module -> CostCentre
-mkUserCC cc_name mod
-  = NormalCC { cc_name = cc_name, cc_mod =  mod,
-	       cc_is_dupd = OriginalCC, cc_is_caf = NotCafCC {-might be changed-}
-    }
-
-mkAutoCC :: Id -> Module -> IsCafCC -> CostCentre
-mkAutoCC id mod is_caf
-  = NormalCC { cc_name = occNameFS (getOccName id), cc_mod =  mod,
-	       cc_is_dupd = OriginalCC, cc_is_caf = is_caf
-    }
-
-mkAllCafsCC m = AllCafsCC  { cc_mod = m }
-
-
-
-mkSingletonCCS :: CostCentre -> CostCentreStack
-mkSingletonCCS cc = pushCCOnCCS cc NoCCS
-
-pushCCOnCCS :: CostCentre -> CostCentreStack -> CostCentreStack
-pushCCOnCCS = PushCC
-
-dupifyCC cc = cc {cc_is_dupd = DupdCC}
-
-isCafCC, isDupdCC :: CostCentre -> Bool
-
-isCafCC (AllCafsCC {})		         = True
-isCafCC (NormalCC {cc_is_caf = CafCC}) = True
-isCafCC _		                 = False
-
-isDupdCC (NormalCC   {cc_is_dupd = DupdCC}) = True
-isDupdCC _		                     = False
-
-isSccCountCostCentre :: CostCentre -> Bool
-  -- Is this a cost-centre which records scc counts
-
-#if DEBUG
-isSccCountCostCentre NoCostCentre  = panic "isSccCount:NoCostCentre"
-#endif
-isSccCountCostCentre cc | isCafCC cc  = False
-                        | isDupdCC cc = False
-			| otherwise   = True
-
-sccAbleCostCentre :: CostCentre -> Bool
-  -- Is this a cost-centre which can be sccd ?
-
-#if DEBUG
-sccAbleCostCentre NoCostCentre  = panic "sccAbleCC:NoCostCentre"
-#endif
-sccAbleCostCentre cc | isCafCC cc = False
-		     | otherwise  = True
-
-ccFromThisModule :: CostCentre -> Module -> Bool
-ccFromThisModule cc m = cc_mod cc == m
-\end{code}
-
-\begin{code}
-instance Eq CostCentre where
-	c1 == c2 = case c1 `cmpCostCentre` c2 of { EQ -> True; _ -> False }
-
-instance Ord CostCentre where
-	compare = cmpCostCentre
-
-cmpCostCentre :: CostCentre -> CostCentre -> Ordering
-
-cmpCostCentre (AllCafsCC  {cc_mod = m1}) (AllCafsCC  {cc_mod = m2}) = m1 `compare` m2
-
-cmpCostCentre (NormalCC {cc_name = n1, cc_mod =  m1, cc_is_caf = c1}) 
-	      (NormalCC {cc_name = n2, cc_mod =  m2, cc_is_caf = c2}) 
-    -- first key is module name, then we use "kinds" (which include
-    -- names) and finally the caf flag
-  = (m1 `compare` m2) `thenCmp` (n1 `compare` n2) `thenCmp` (c1 `cmp_caf` c2)
-
-cmpCostCentre other_1 other_2
-  = let
-	tag1 = tag_CC other_1
-	tag2 = tag_CC other_2
-    in
-    if tag1 <# tag2 then LT else GT
-  where
-    tag_CC (NormalCC   {}) = (_ILIT 1 :: FastInt)
-    tag_CC (AllCafsCC  {}) = _ILIT 2
-
-cmp_caf NotCafCC CafCC     = LT
-cmp_caf NotCafCC NotCafCC  = EQ
-cmp_caf CafCC    CafCC     = EQ
-cmp_caf CafCC    NotCafCC  = GT
-
-decomposeCCS :: CostCentreStack -> ([CostCentre],CostCentreStack)
-decomposeCCS (PushCC cc ccs) = (cc:more, ccs') 
-  where (more,ccs') = decomposeCCS ccs
-decomposeCCS ccs = ([],ccs)
-\end{code}
-
------------------------------------------------------------------------------
-Printing Cost Centre Stacks.
-
-The outputable instance for CostCentreStack prints the CCS as a C
-expression.
-
-NOTE: Not all cost centres are suitable for using in a static
-initializer.  In particular, the PushCC forms where the tail is CCCS
-may only be used in inline C code because they expand to a
-non-constant C expression.
-
-\begin{code}
-instance Outputable CostCentreStack where
-  ppr NoCCS		= ptext SLIT("NO_CCS")
-  ppr CurrentCCS	= ptext SLIT("CCCS")
-  ppr OverheadCCS	= ptext SLIT("CCS_OVERHEAD")
-  ppr DontCareCCS	= ptext SLIT("CCS_DONT_CARE")
-  ppr SubsumedCCS	= ptext SLIT("CCS_SUBSUMED")
-  ppr (PushCC cc NoCCS) = ppr cc <> ptext SLIT("_ccs")
-  ppr (PushCC cc ccs)   = ptext SLIT("PushCostCentre") <> 
-			   parens (ppr ccs <> comma <> 
-			   parens(ptext SLIT("void *")) <> ppr cc)
-\end{code}
-
------------------------------------------------------------------------------
-Printing Cost Centres.
-
-There are several different ways in which we might want to print a
-cost centre:
-
-	- the name of the cost centre, for profiling output (a C string)
-	- the label, i.e. C label for cost centre in .hc file.
-	- the debugging name, for output in -ddump things
-	- the interface name, for printing in _scc_ exprs in iface files.
-
-The last 3 are derived from costCentreStr below.  The first is given
-by costCentreName.
-
-\begin{code}
-instance Outputable CostCentre where
-  ppr cc = getPprStyle $ \ sty ->
-	   if codeStyle sty
-  	   then ppCostCentreLbl cc
-	   else text (costCentreUserName cc)
-
--- Printing in an interface file or in Core generally
-pprCostCentreCore (AllCafsCC {cc_mod = m})
-  = text "__sccC" <+> braces (ppr_mod m)
-pprCostCentreCore (NormalCC {cc_name = n, cc_mod = m,
-			     cc_is_caf = caf, cc_is_dupd = dup})
-  = text "__scc" <+> braces (hsep [
-	ftext (zEncodeFS n),
-	ppr_mod m,
-	pp_dup dup,
-	pp_caf caf
-    ])
-
-pp_dup DupdCC = char '!'
-pp_dup other   = empty
-
-pp_caf CafCC = text "__C"
-pp_caf other   = empty
-
-ppr_mod m = ftext (zEncodeFS (moduleFS m))
-
--- Printing as a C label
-ppCostCentreLbl (NoCostCentre)		  = text "NONE_cc"
-ppCostCentreLbl (AllCafsCC  {cc_mod = m}) = ppr m <> text "_CAFs_cc"
-ppCostCentreLbl (NormalCC {cc_name = n, cc_mod = m, cc_is_caf = is_caf}) 
-  = ppr_mod m <> ftext (zEncodeFS n) <> 
-	text (case is_caf of { CafCC -> "_CAF"; _ -> "" }) <> text "_cc"
-
--- This is the name to go in the user-displayed string, 
--- recorded in the cost centre declaration
-costCentreUserName (NoCostCentre)  = "NO_CC"
-costCentreUserName (AllCafsCC {})  = "CAF"
-costCentreUserName cc@(NormalCC {cc_name = name, cc_is_caf = is_caf})
-  =  case is_caf of { CafCC -> "CAF:";   _ -> "" } ++ unpackFS name
-\end{code}
diff --git a/ghc/compiler/profiling/NOTES b/ghc/compiler/profiling/NOTES
deleted file mode 100644
index c50cf562e3..0000000000
--- a/ghc/compiler/profiling/NOTES
+++ /dev/null
@@ -1,301 +0,0 @@
-Profiling Implementation Notes -- June/July/Sept 1994
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Simon and Will
-
-Pre-code-generator-ish
-~~~~~~~~~~~~~~~~~~~~~~
-
-* Automagic insertion of _sccs_ on...
-
-  - If -auto is specified, add _scc_ on each *exported* top-level definition. 
-    NB this includes CAFs.  Done by addAutoCostCentres (Core-to-Core pass).
-
-  - If -auto-all is specified, add _scc_ on *all* top-level definitions.
-    Done by same pass.
-
-  - Always: just before code generation of module M, onto any CAF
-    which hasn't already got an explicit cost centre attached, pin
-    "AllCAFs-M".
-
-    Done by finalStgMassageForProfiling (final STG-to-STG pass)
-
-    Only the one-off costs of evaluating the CAFs will be attributed
-    to the AllCAFs-M cost centre.  We hope that these costs will be
-    small; since the _scc_s are introduced automatically it's
-    confusing to attribute any significant costs to them.  However if
-    there *are* significant one-off costs we'd better know about it.
-
-    Why so late in the compilation process?  We aren't *absolutely*
-    sure what is and isn't a CAF until *just* before code generation.
-    So we don't want to mark them as such until then.
-
-  - Individual DICTs
-
-    We do it in the desugarer, because that's the *only* point at
-    which we *know* exactly what bindings are introduced by
-    overloading.  NB should include bindings for selected methods, eg
-
-	f d = let op = _scc_ DICT op_sel d in
-	      ...op...op...op
-
-    The DICT CC ensures that:
-    (a) [minor] that the selection cost is separately attributed
-    (b) [major] that the cost of executing op is attributed to
-	its call site, eg
-
-	...(scc "a" op)...(scc "b" op)...(scc "c" op)...
-
-* Automagic "boxing" of higher-order args:
-
-	finalStgMassageForProfiling (final STG-to-STG pass)
-
-	This (as well as CAF stuff above) is really quite separate
-	from the other business of finalStgMassageForProfiling
-	(collecting up CostCentres that need to be
-	declared/registered).
-	
-	But throwing it all into the pot together means that we don't
-	have to have Yet Another STG Syntax Walker.
-
-	Furthermore, these "boxes" are really just let-bindings that
-	many other parts of the compiler will happily substitute away!
-	Doing them at the very last instant prevents this.
-
-	A down side of doing these so late is that we get lots of
-	"let"s, which if generated earlier and not substituted away,
-	could be floated outwards.  Having them floated outwards would
-	lessen the chance of skewing profiling results (because of
-	gratuitous "let"s added by the compiler into the inner loop of
-	some program...).  The allocation itself will be attributed to
-	profiling overhead; the only thing which'll be skewed is time measurement.
-
-	So if we have, post-boxing-higher-order-args...
-
-	    _scc_ "foo" ( let f' = [f] \ [] f
-			  in
-			  map f' xs )
-
-	... we want "foo" to be put in the thunk for "f'", but we want the
-	allocation cost (heap census stuff) to be attr to OVERHEAD.
-
-	As an example of what could be improved
-		f = _scc_ "f" (g h)
-	To save dynamic allocation, we could have a static closure for h:
-		h_inf = _scc_ "f" h
-		f = _scc_ "f" (g h_inf)
-	
-
-	
-
-
-Code generator-ish
-~~~~~~~~~~~~~~~~~~
-
-(1) _Entry_ code for a closure *usually* sets CC from the closure,
-		 at the fast entry point
-
-    Exceptions:
-
-    (a) Top-level subsumed functions (i.e., w/ no _scc_ on them)
-
-	Refrain from setting CC from the closure
-
-    (b) Constructors
-
-	Again, refrain.  (This is *new*)
-	
-	Reasons: (i) The CC will be zapped very shortly by the restore
-	of the enclosing CC when we return to the eval'ing "case".
-	(ii) Any intervening updates will indirect to this existing
-	constructor (...mumble... new update mechanism... mumble...)
-
-(2) "_scc_ cc expr"
-
-    Set current CC to "cc".  
-    No later "restore" of the previous CC is reqd.
-
-(3) "case e of { ...alts... }" expression (eval)
-
-    Save CC before eval'ing scrutinee
-    Restore CC at the start of the case-alternative(s)
-
-(4) _Updates_ : updatee gets current CC
-
-    (???? not sure this is OK yet 94/07/04)
-
-    Reasons:
-
-    * Constructors : want to be insensitive to return-in-heap vs
-	return-in-regs.  For example,
-
-	f x = _scc_ "f" (x, x)
-
-	The pair (x,x) would get CC of "f" if returned-in-heap;
-	therefore, updatees should get CC of "f".
-
-    * PAPs : Example:
-
-	f x = _scc_ "f" (let g = \ y -> ... in g)
-
-	At the moment of update (updatePAP?), CC is "f", which
-	is what we want to set it to if the "updatee" is entered
-
-    	When we enter the PAP ("please put the arguments back so I can
-	use them"), we restore the setup as at the moment the
-	arg-satisfaction check failed.
-
-        Be careful!  UPDATE_PAP is called from the arg-satis check,
-	which is before the fast entry point.  So the cost centre
-	won't yet have been set from the closure which has just
-	been entered.  Solution: in UPDATE_PAP see if the cost centre inside
-	the function closure which is being entered is "SUB"; if so, use
-	the current cost centre to update the updatee; otherwise use that
-	inside the function closure.  (See the computation of cc_pap
-	in rule 16_l for lexical semantics.)
-
-
-(5) CAFs
-
-CAFs get their own cost centre.  Ie
-
-			x = e
-is transformed to
-			x = _scc_ "CAF:x" e
-
-Or sometimes we lump all the CAFs in a module together.
-(Reporting issue or code-gen issue?)
-
-
-
-Hybrid stuff
-~~~~~~~~~~~~
-
-The problem:
-
-  f = _scc_ "CAF:f" (let g = \xy -> ...
-	 	   in (g,g))
-
-Now, g has cost-centre "CAF:f", and is returned as part of
-the result.  So whenever the function embedded in the result
-is called, the costs will accumulate to "CAF:f".  This is
-particularly (de)pressing for dictionaries, which contain lots
-of functions.
-
-Solution: 
-
-  A.  Whenever in case (1) above we would otherwise "set the CC from the
-  closure", we *refrain* from doing so if 
-	(a) the closure is a function, not a thunk; and
-	(b) the cost-centre in the closure is a CAF cost centre.
-
-  B.  Whenever we enter a thunk [at least, one which might return a function]
-  we save the current cost centre in the update frame.  Then, UPDATE_PAP
-  restores the saved cost centre from the update frame iff the cost
-  centre at the point of update (cc_pap in (4) above) is a CAF cost centre.
-
-  It isn't necessary to save and possibly-restore the cost centre for
-  thunks which will certainly return a constructor, because the 
-  cost centre is about to be restored anyway by the enclosing case.
-
-Both A and B are runtime tests.  For A, consider:
-
-  f = _scc_ "CAF:f" (g 2)
-
-  h y = _scc_ "h" g (y+y)
-
-  g x = let w = \p -> ...
-	in (w,w)
-
-
-Now, in the call to g from h, the cost-centre on w will be "h", and
-indeed all calls to the result of the call should be attributed to
-"h".  
-
-  ... _scc_ "x1" (let (t,_) = h 2 in t 3) ...
-
-  Costs of executing (w 3) attributed to "h".
-
-But in the call to g from f, the cost-centre on w will be
-"CAF:f", and calls to w should be attributed to the call site.
-
-  ..._scc_ "x2" (let (t,_) = f in t 3)...
-
-  Costs of executing (w 3) attributed to "x2".
-
-
-	Remaining problem
-
-Consider
-
-	_scc_ "CAF:f" (if expensive then g 2 else g 3)
-
-where g is a function with arity 2.  In theory we should
-restore the enclosing cost centre once we've reduced to
-(g 2) or (g 3).  In practice this is pretty tiresome; and pretty rare.
-
-A quick fix: given (_scc_ "CAF" e) where e might be function-valued
-(in practice we usually know, because CAF sccs are top level), transform to
-
-	_scc_ "CAF" (let f = e in f)
-
-
-
-
-
-============
-
-scc cc x  ===>   x
-
-  UNLESS
-
-(a)  cc is a user-defined, non-dup'd cost 
-     centre (so we care about entry counts)
-
-OR
-
-(b) cc is not a CAF/DICT cost centre and x is top-level subsumed
-     function.
-	[If x is lambda/let bound it'll have a cost centre
-	 attached dynamically.]
-
-	To repeat, the transformation is OK if 
-		x is a not top-level subsumed function
-	OR	
-		cc is a CAF/DICT cost centre and x is a top-level
-		subsumed function
-
-
-
-(scc cc e) x  ===>  (scc cc e x)
-
-	OK????? IFF
-
-cc is not CAF/DICT  --- remains to be proved!!!!!!
-True for lex
-False for eval
-Can we tell which in hybrid?
-
-eg  Is this ok?
-
-	(scc "f" (scc "CAF" (\x.b))) y ==>   (scc "f" (scc "CAF" (\x.b) y))
-
-
-\x -> (scc cc e)    ===>   (scc cc \x->e)
-
-	OK IFF cc is not CAF/DICT
-
-
-scc cc1 (scc cc2 e))   ===>  scc cc2 e
-
-	IFF not interested in cc1's entry count
-	AND cc2 is not CAF/DICT
-
-(scc cc1 ... (scc cc2 e) ...)   ===>  (scc cc1 ... e ...)
-
-	IFF cc2 is CAF/DICT
-	AND e is a lambda not appearing as the RHS of a let
-	    OR
-	    e is a variable not bound to SUB
-
-
diff --git a/ghc/compiler/profiling/SCCfinal.lhs b/ghc/compiler/profiling/SCCfinal.lhs
deleted file mode 100644
index c95db9c358..0000000000
--- a/ghc/compiler/profiling/SCCfinal.lhs
+++ /dev/null
@@ -1,411 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[SCCfinal]{Modify and collect code generation for final STG program}
-
-This is now a sort-of-normal STG-to-STG pass (WDP 94/06), run by stg2stg.
-
-* Traverses the STG program collecting the cost centres. These are
-  required to declare the cost centres at the start of code
-  generation.
-
-  Note: because of cross-module unfolding, some of these cost centres
-  may be from other modules.  But will still have to give them
-  "extern" declarations.
-
-* Puts on CAF cost-centres if the user has asked for individual CAF
-  cost-centres.
-
-* Ditto for individual DICT cost-centres.
-
-* Boxes top-level inherited functions passed as arguments.
-
-* "Distributes" given cost-centres to all as-yet-unmarked RHSs.
-
-\begin{code}
-module SCCfinal ( stgMassageForProfiling ) where
-
-#include "HsVersions.h"
-
-import StgSyn
-
-import Packages		( HomeModules )
-import StaticFlags	( opt_AutoSccsOnIndividualCafs )
-import CostCentre	-- lots of things
-import Id		( Id )
-import Module		( Module )
-import UniqSupply	( uniqFromSupply, splitUniqSupply, UniqSupply )
-import Unique           ( Unique )
-import VarSet
-import ListSetOps	( removeDups )
-import Outputable	
-
-infixr 9 `thenMM`, `thenMM_`
-\end{code}
-
-\begin{code}
-stgMassageForProfiling
-	:: HomeModules
-	-> Module			-- module name
-	-> UniqSupply		    	-- unique supply
-	-> [StgBinding]		    	-- input
-	-> (CollectedCCs, [StgBinding])
-
-stgMassageForProfiling pdeps mod_name us stg_binds
-  = let
-	((local_ccs, extern_ccs, cc_stacks),
-	 stg_binds2)
-	  = initMM mod_name us (do_top_bindings stg_binds)
-
-	(fixed_ccs, fixed_cc_stacks)
-	  = if opt_AutoSccsOnIndividualCafs
-	    then ([],[])  -- don't need "all CAFs" CC 
-			  -- (for Prelude, we use PreludeCC)
-	    else ([all_cafs_cc], [all_cafs_ccs])
-
-	local_ccs_no_dups  = fst (removeDups cmpCostCentre local_ccs)
-	extern_ccs_no_dups = fst (removeDups cmpCostCentre extern_ccs)
-    in
-    ((fixed_ccs ++ local_ccs_no_dups, 
-      extern_ccs_no_dups, 
-      fixed_cc_stacks ++ cc_stacks), stg_binds2)
-  where
-
-    all_cafs_cc  = mkAllCafsCC mod_name
-    all_cafs_ccs = mkSingletonCCS all_cafs_cc
-
-    ----------
-    do_top_bindings :: [StgBinding] -> MassageM [StgBinding]
-
-    do_top_bindings [] = returnMM []
-
-    do_top_bindings (StgNonRec b rhs : bs) 
-      = do_top_rhs b rhs 		`thenMM` \ rhs' ->
-	addTopLevelIshId b (
-	   do_top_bindings bs `thenMM` \bs' ->
-	   returnMM (StgNonRec b rhs' : bs')
-	)
-
-    do_top_bindings (StgRec pairs : bs)
-      = addTopLevelIshIds binders (
-	   mapMM do_pair pairs		`thenMM` \ pairs2 ->
-	   do_top_bindings bs `thenMM` \ bs' ->
-	   returnMM (StgRec pairs2 : bs')
-	)
-      where
-	binders = map fst pairs
-	do_pair (b, rhs) 
-	   = do_top_rhs b rhs	`thenMM` \ rhs2 ->
-	     returnMM (b, rhs2)
-
-    ----------
-    do_top_rhs :: Id -> StgRhs -> MassageM StgRhs
-
-    do_top_rhs binder (StgRhsClosure _ bi fv u srt [] (StgSCC cc (StgConApp con args)))
-      | not (isSccCountCostCentre cc) && not (isDllConApp pdeps con args)
-	-- Trivial _scc_ around nothing but static data
-	-- Eliminate _scc_ ... and turn into StgRhsCon
-
-	-- isDllConApp checks for LitLit args too
-      = returnMM (StgRhsCon dontCareCCS con args)
-
-{- Can't do this one with cost-centre stacks:  --SDM
-    do_top_rhs binder (StgRhsClosure no_cc bi fv u [] (StgSCC ty cc expr))
-      | (noCCSAttached no_cc || currentOrSubsumedCCS no_cc)
-        && not (isSccCountCostCentre cc)
-	-- Top level CAF without a cost centre attached
-	-- Attach and collect cc of trivial _scc_ in body
-      = collectCC cc					`thenMM_`
-	set_prevailing_cc cc (do_expr expr)		`thenMM`  \ expr' ->
-        returnMM (StgRhsClosure cc bi fv u [] expr')
--}
-
-    do_top_rhs binder (StgRhsClosure no_cc bi fv u srt [] body)
-      | noCCSAttached no_cc || currentOrSubsumedCCS no_cc
-	-- Top level CAF without a cost centre attached
-	-- Attach CAF cc (collect if individual CAF ccs)
-      = (if opt_AutoSccsOnIndividualCafs 
-		then let cc = mkAutoCC binder mod_name CafCC
-			 ccs = mkSingletonCCS cc
-		     in
-		     collectCC  cc  `thenMM_`
-		     collectCCS ccs `thenMM_`
-		     returnMM ccs
-		else 
-		     returnMM all_cafs_ccs)		`thenMM`  \ caf_ccs ->
-	   set_prevailing_cc caf_ccs (do_expr body)	`thenMM`  \ body' ->
-           returnMM (StgRhsClosure caf_ccs bi fv u srt [] body')
-
-    do_top_rhs binder (StgRhsClosure cc bi fv u srt [] body)
-	-- Top level CAF with cost centre attached
-	-- Should this be a CAF cc ??? Does this ever occur ???
-      = pprPanic "SCCfinal: CAF with cc:" (ppr cc)
-
-    do_top_rhs binder (StgRhsClosure no_ccs bi fv u srt args body)
-	-- Top level function, probably subsumed
-      | noCCSAttached no_ccs
-      = set_lambda_cc (do_expr body)	`thenMM` \ body' ->
-	returnMM (StgRhsClosure subsumedCCS bi fv u srt args body')
-
-      | otherwise
-      = pprPanic "SCCfinal: CAF with cc:" (ppr no_ccs)
-
-    do_top_rhs binder (StgRhsCon ccs con args)
-	-- Top-level (static) data is not counted in heap
-	-- profiles; nor do we set CCCS from it; so we
-	-- just slam in dontCareCostCentre
-      = returnMM (StgRhsCon dontCareCCS con args)
-
-    ------
-    do_expr :: StgExpr -> MassageM StgExpr
-
-    do_expr (StgLit l) = returnMM (StgLit l)
-
-    do_expr (StgApp fn args)
-      = boxHigherOrderArgs (StgApp fn) args
-
-    do_expr (StgConApp con args)
-      = boxHigherOrderArgs (\args -> StgConApp con args) args
-
-    do_expr (StgOpApp con args res_ty)
-      = boxHigherOrderArgs (\args -> StgOpApp con args res_ty) args
-
-    do_expr (StgSCC cc expr)	-- Ha, we found a cost centre!
-      = collectCC cc		`thenMM_`
-	do_expr expr		`thenMM` \ expr' ->
-	returnMM (StgSCC cc expr')
-
-    do_expr (StgCase expr fv1 fv2 bndr srt alt_type alts)
-      = do_expr expr		`thenMM` \ expr' ->
-	mapMM do_alt alts 	`thenMM` \ alts' ->
-	returnMM (StgCase expr' fv1 fv2 bndr srt alt_type alts')
-      where
-	do_alt (id, bs, use_mask, e)
-	  = do_expr e `thenMM` \ e' ->
-	    returnMM (id, bs, use_mask, e')
-
-    do_expr (StgLet b e)
-	= do_let b e `thenMM` \ (b,e) ->
-	  returnMM (StgLet b e)
-
-    do_expr (StgLetNoEscape lvs1 lvs2 b e)
-	= do_let b e `thenMM` \ (b,e) ->
-	  returnMM (StgLetNoEscape lvs1 lvs2 b e)
-
-#ifdef DEBUG
-    do_expr other = pprPanic "SCCfinal.do_expr" (ppr other)
-#endif
-
-    ----------------------------------
-
-    do_let (StgNonRec b rhs) e
-      = do_rhs rhs		 	`thenMM` \ rhs' ->
-	addTopLevelIshId b (
-	  do_expr e		  	`thenMM` \ e' ->
-	  returnMM (StgNonRec b rhs',e')
-        )
-
-    do_let (StgRec pairs) e
-      = addTopLevelIshIds binders (
-	   mapMM do_pair pairs	 	`thenMM` \ pairs' ->
-	   do_expr e		  	`thenMM` \ e' ->
-	   returnMM (StgRec pairs', e')
-	)
-      where
-	binders = map fst pairs
-	do_pair (b, rhs) 
-	   = do_rhs rhs			`thenMM` \ rhs2 ->
-	     returnMM (b, rhs2)
-
-    ----------------------------------
-    do_rhs :: StgRhs -> MassageM StgRhs
-	-- We play much the same game as we did in do_top_rhs above;
-	-- but we don't have to worry about cafs etc.
-
-{-
-    do_rhs (StgRhsClosure closure_cc bi fv u [] (StgSCC ty cc (StgCon (DataCon con) args _)))
-      | not (isSccCountCostCentre cc)
-      = collectCC cc `thenMM_`
-	returnMM (StgRhsCon cc con args)
--}
-
-    do_rhs (StgRhsClosure _ bi fv u srt args expr)
-      = slurpSCCs currentCCS expr	`thenMM` \ (expr', ccs) ->
-	do_expr expr'			`thenMM` \ expr'' ->
-	returnMM (StgRhsClosure ccs bi fv u srt args expr'')
-      where
-	slurpSCCs ccs (StgSCC cc e) 
-	     = collectCC cc 			`thenMM_`
-	       slurpSCCs (cc `pushCCOnCCS` ccs) e
-	slurpSCCs ccs e 
-	     = returnMM (e, ccs)
-
-    do_rhs (StgRhsCon cc con args)
-      = returnMM (StgRhsCon currentCCS con args)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Boxing higher-order args}
-%*									*
-%************************************************************************
-
-Boxing is *turned off* at the moment, until we can figure out how to
-do it properly in general.
-
-\begin{code}
-boxHigherOrderArgs
-    :: ([StgArg] -> StgExpr)
-			-- An application lacking its arguments
-    -> [StgArg]		-- arguments which we might box
-    -> MassageM StgExpr
-
-#ifndef PROF_DO_BOXING
-boxHigherOrderArgs almost_expr args
-   = returnMM (almost_expr args)
-#else
-boxHigherOrderArgs almost_expr args
-  = getTopLevelIshIds		`thenMM` \ ids ->
-    mapAccumMM (do_arg ids) [] args	`thenMM` \ (let_bindings, new_args) ->
-    returnMM (foldr (mk_stg_let currentCCS) (almost_expr new_args) let_bindings)
-  where
-    ---------------
-
-    do_arg ids bindings arg@(StgVarArg old_var)
-	|  (not (isLocalVar old_var) || elemVarSet old_var ids)
-	&& isFunTy (dropForAlls var_type)
-      =     -- make a trivial let-binding for the top-level function
-	getUniqueMM		`thenMM` \ uniq ->
-	let
-	    new_var = mkSysLocal FSLIT("sf") uniq var_type
-	in
-	returnMM ( (new_var, old_var) : bindings, StgVarArg new_var )
-      where
-	var_type = idType old_var
-
-    do_arg ids bindings arg = returnMM (bindings, arg)
-
-    ---------------
-    mk_stg_let :: CostCentreStack -> (Id, Id) -> StgExpr -> StgExpr
-
-    mk_stg_let cc (new_var, old_var) body
-      = let
-	    rhs_body    = StgApp old_var [{-args-}]
-	    rhs_closure = StgRhsClosure cc stgArgOcc [{-fvs-}] ReEntrant NoSRT{-eeek!!!-} [{-args-}] rhs_body
-        in
-	StgLet (StgNonRec new_var rhs_closure) body
-      where
-	bOGUS_LVs = emptyUniqSet -- easier to print than: panic "mk_stg_let: LVs"
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Boring monad stuff for this}
-%*									*
-%************************************************************************
-
-\begin{code}
-type MassageM result
-  =  Module		-- module name
-  -> CostCentreStack	-- prevailing CostCentre
-			-- if none, subsumedCosts at top-level
-			-- currentCostCentre at nested levels
-  -> UniqSupply
-  -> VarSet		-- toplevel-ish Ids for boxing
-  -> CollectedCCs
-  -> (CollectedCCs, result)
-
--- the initMM function also returns the final CollectedCCs
-
-initMM :: Module	-- module name, which we may consult
-       -> UniqSupply
-       -> MassageM a
-       -> (CollectedCCs, a)
-
-initMM mod_name init_us m = m mod_name noCCS init_us emptyVarSet ([],[],[])
-
-thenMM  :: MassageM a -> (a -> MassageM b) -> MassageM b
-thenMM_ :: MassageM a -> (MassageM b) -> MassageM b
-
-thenMM expr cont mod scope_cc us ids ccs
-  = case splitUniqSupply us	of { (s1, s2) ->
-    case (expr mod scope_cc s1 ids ccs) of { (ccs2, result) ->
-    cont result mod scope_cc s2 ids ccs2 }}
-
-thenMM_ expr cont mod scope_cc us ids ccs
-  = case splitUniqSupply us	of { (s1, s2) ->
-    case (expr mod scope_cc s1 ids ccs)	of { (ccs2, _) ->
-    cont mod scope_cc s2 ids ccs2 }}
-
-returnMM :: a -> MassageM a
-returnMM result mod scope_cc us ids ccs = (ccs, result)
-
-nopMM :: MassageM ()
-nopMM mod scope_cc us ids ccs = (ccs, ())
-
-mapMM :: (a -> MassageM b) -> [a] -> MassageM [b]
-mapMM f [] = returnMM []
-mapMM f (m:ms)
-  = f m		`thenMM` \ r  ->
-    mapMM f ms	`thenMM` \ rs ->
-    returnMM (r:rs)
-
-mapAccumMM :: (acc -> x -> MassageM (acc, y)) -> acc -> [x] -> MassageM (acc, [y])
-mapAccumMM f b [] = returnMM (b, [])
-mapAccumMM f b (m:ms)
-  = f b m		`thenMM` \ (b2, r)  ->
-    mapAccumMM f b2 ms	`thenMM` \ (b3, rs) ->
-    returnMM (b3, r:rs)
-
-getUniqueMM :: MassageM Unique
-getUniqueMM mod scope_cc us ids ccs = (ccs, uniqFromSupply us)
-
-addTopLevelIshId :: Id -> MassageM a -> MassageM a
-addTopLevelIshId id scope mod scope_cc us ids ccs
-  | isCurrentCCS scope_cc = scope mod scope_cc us ids ccs
-  | otherwise             = scope mod scope_cc us (extendVarSet ids id) ccs
-
-addTopLevelIshIds :: [Id] -> MassageM a -> MassageM a
-addTopLevelIshIds [] cont = cont
-addTopLevelIshIds (id:ids) cont 
-  = addTopLevelIshId id (addTopLevelIshIds ids cont)
-
-getTopLevelIshIds :: MassageM VarSet
-getTopLevelIshIds mod scope_cc us ids ccs = (ccs, ids)
-\end{code}
-
-The prevailing CCS is used to tell whether we're in a top-levelish
-position, where top-levelish is defined as "not inside a lambda".
-Prevailing CCs used to be used for something much more complicated,
-I'm sure --SDM
-
-\begin{code}
-set_lambda_cc :: MassageM a -> MassageM a
-set_lambda_cc action mod scope_cc us ids ccs
-  = action mod currentCCS us ids ccs
-
-set_prevailing_cc :: CostCentreStack -> MassageM a -> MassageM a
-set_prevailing_cc cc_to_set_to action mod scope_cc us ids ccs
-  = action mod cc_to_set_to us ids ccs
-
-get_prevailing_cc :: MassageM CostCentreStack
-get_prevailing_cc mod scope_cc us ids ccs = (ccs, scope_cc)
-\end{code}
-
-\begin{code}
-collectCC :: CostCentre -> MassageM ()
-
-collectCC cc mod_name scope_cc us ids (local_ccs, extern_ccs, ccss)
-  = ASSERT(not (noCCAttached cc))
-    if (cc `ccFromThisModule` mod_name) then
-	((cc : local_ccs, extern_ccs, ccss), ())
-    else -- must declare it "extern"
-	((local_ccs, cc : extern_ccs, ccss), ())
-
-collectCCS :: CostCentreStack -> MassageM ()
-
-collectCCS ccs mod_name scope_cc us ids (local_ccs, extern_ccs, ccss)
-  = ASSERT(not (noCCSAttached ccs))
-    ((local_ccs, extern_ccs, ccs : ccss), ())
-\end{code}
diff --git a/ghc/compiler/rename/RnBinds.lhs b/ghc/compiler/rename/RnBinds.lhs
deleted file mode 100644
index 13035e72e2..0000000000
--- a/ghc/compiler/rename/RnBinds.lhs
+++ /dev/null
@@ -1,660 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[RnBinds]{Renaming and dependency analysis of bindings}
-
-This module does renaming and dependency analysis on value bindings in
-the abstract syntax.  It does {\em not} do cycle-checks on class or
-type-synonym declarations; those cannot be done at this stage because
-they may be affected by renaming (which isn't fully worked out yet).
-
-\begin{code}
-module RnBinds (
-	rnTopBinds, 
-	rnLocalBindsAndThen, rnValBindsAndThen, rnValBinds, trimWith,
-	rnMethodBinds, renameSigs, 
-	rnMatchGroup, rnGRHSs
-   ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts )
-
-import HsSyn
-import RdrHsSyn
-import RnHsSyn
-import TcRnMonad
-import RnTypes		( rnHsSigType, rnLHsType, rnHsTypeFVs, 
-			  rnLPat, rnPatsAndThen, patSigErr, checkPrecMatch )
-import RnEnv		( bindLocatedLocalsRn, lookupLocatedBndrRn, 
-			  lookupLocatedInstDeclBndr, newIPNameRn,
-			  lookupLocatedSigOccRn, bindPatSigTyVars, bindPatSigTyVarsFV,
-			  bindLocalFixities, bindSigTyVarsFV, 
-			  warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
-			)
-import DynFlags	( DynFlag(..) )
-import Name		( Name, nameOccName, nameSrcLoc )
-import NameEnv
-import NameSet
-import PrelNames	( isUnboundName )
-import RdrName		( RdrName, rdrNameOcc )
-import SrcLoc		( mkSrcSpan, Located(..), unLoc )
-import ListSetOps	( findDupsEq )
-import BasicTypes	( RecFlag(..) )
-import Digraph		( SCC(..), stronglyConnComp )
-import Bag
-import Outputable
-import Maybes		( orElse, isJust )
-import Util		( filterOut )
-import Monad		( foldM )
-\end{code}
-
--- ToDo: Put the annotations into the monad, so that they arrive in the proper
--- place and can be used when complaining.
-
-The code tree received by the function @rnBinds@ contains definitions
-in where-clauses which are all apparently mutually recursive, but which may
-not really depend upon each other. For example, in the top level program
-\begin{verbatim}
-f x = y where a = x
-	      y = x
-\end{verbatim}
-the definitions of @a@ and @y@ do not depend on each other at all.
-Unfortunately, the typechecker cannot always check such definitions.
-\footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
-definitions. In Proceedings of the International Symposium on Programming,
-Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
-However, the typechecker usually can check definitions in which only the
-strongly connected components have been collected into recursive bindings.
-This is precisely what the function @rnBinds@ does.
-
-ToDo: deal with case where a single monobinds binds the same variable
-twice.
-
-The vertag tag is a unique @Int@; the tags only need to be unique
-within one @MonoBinds@, so that unique-Int plumbing is done explicitly
-(heavy monad machinery not needed).
-
-
-%************************************************************************
-%*									*
-%* naming conventions							*
-%*									*
-%************************************************************************
-
-\subsection[name-conventions]{Name conventions}
-
-The basic algorithm involves walking over the tree and returning a tuple
-containing the new tree plus its free variables. Some functions, such
-as those walking polymorphic bindings (HsBinds) and qualifier lists in
-list comprehensions (@Quals@), return the variables bound in local
-environments. These are then used to calculate the free variables of the
-expression evaluated in these environments.
-
-Conventions for variable names are as follows:
-\begin{itemize}
-\item
-new code is given a prime to distinguish it from the old.
-
-\item
-a set of variables defined in @Exp@ is written @dvExp@
-
-\item
-a set of variables free in @Exp@ is written @fvExp@
-\end{itemize}
-
-%************************************************************************
-%*									*
-%* analysing polymorphic bindings (HsBindGroup, HsBind)
-%*									*
-%************************************************************************
-
-\subsubsection[dep-HsBinds]{Polymorphic bindings}
-
-Non-recursive expressions are reconstructed without any changes at top
-level, although their component expressions may have to be altered.
-However, non-recursive expressions are currently not expected as
-\Haskell{} programs, and this code should not be executed.
-
-Monomorphic bindings contain information that is returned in a tuple
-(a @FlatMonoBinds@) containing:
-
-\begin{enumerate}
-\item
-a unique @Int@ that serves as the ``vertex tag'' for this binding.
-
-\item
-the name of a function or the names in a pattern. These are a set
-referred to as @dvLhs@, the defined variables of the left hand side.
-
-\item
-the free variables of the body. These are referred to as @fvBody@.
-
-\item
-the definition's actual code. This is referred to as just @code@.
-\end{enumerate}
-
-The function @nonRecDvFv@ returns two sets of variables. The first is
-the set of variables defined in the set of monomorphic bindings, while the
-second is the set of free variables in those bindings.
-
-The set of variables defined in a non-recursive binding is just the
-union of all of them, as @union@ removes duplicates. However, the
-free variables in each successive set of cumulative bindings is the
-union of those in the previous set plus those of the newest binding after
-the defined variables of the previous set have been removed.
-
-@rnMethodBinds@ deals only with the declarations in class and
-instance declarations.	It expects only to see @FunMonoBind@s, and
-it expects the global environment to contain bindings for the binders
-(which are all class operations).
-
-%************************************************************************
-%*									*
-\subsubsection{ Top-level bindings}
-%*									*
-%************************************************************************
-
-@rnTopMonoBinds@ assumes that the environment already
-contains bindings for the binders of this particular binding.
-
-\begin{code}
-rnTopBinds :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
-
--- The binders of the binding are in scope already;
--- the top level scope resolution does that
-
-rnTopBinds binds
- =  do	{ is_boot <- tcIsHsBoot
-	; if is_boot then rnTopBindsBoot binds
-		     else rnTopBindsSrc  binds }
-
-rnTopBindsBoot :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
--- A hs-boot file has no bindings. 
--- Return a single HsBindGroup with empty binds and renamed signatures
-rnTopBindsBoot (ValBindsIn mbinds sigs)
-  = do	{ checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)
-	; sigs' <- renameSigs okHsBootSig sigs
-	; return (ValBindsOut [] sigs', usesOnly (hsSigsFVs sigs')) }
-
-rnTopBindsSrc :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
-rnTopBindsSrc binds@(ValBindsIn mbinds _)
-  = do	{ (binds', dus) <- rnValBinds noTrim binds
-
-		-- Warn about missing signatures, 
-	; let	{ ValBindsOut _ sigs' = binds'
-		; ty_sig_vars = mkNameSet [ unLoc n | L _ (TypeSig n _) <- sigs']
-		; un_sigd_bndrs = duDefs dus `minusNameSet` ty_sig_vars }
-
-	; warn_missing_sigs <- doptM Opt_WarnMissingSigs
-	; ifM (warn_missing_sigs)
-	      (mappM_ missingSigWarn (nameSetToList un_sigd_bndrs))
-
-	; return (binds', dus)
-	}
-\end{code}
-
-
-
-%*********************************************************
-%*							*
-		HsLocalBinds
-%*							*
-%*********************************************************
-
-\begin{code}
-rnLocalBindsAndThen 
-  :: HsLocalBinds RdrName
-  -> (HsLocalBinds Name -> RnM (result, FreeVars))
-  -> RnM (result, FreeVars)
--- This version (a) assumes that the binding vars are not already in scope
---		(b) removes the binders from the free vars of the thing inside
--- The parser doesn't produce ThenBinds
-rnLocalBindsAndThen EmptyLocalBinds thing_inside
-  = thing_inside EmptyLocalBinds
-
-rnLocalBindsAndThen (HsValBinds val_binds) thing_inside
-  = rnValBindsAndThen val_binds $ \ val_binds' -> 
-    thing_inside (HsValBinds val_binds')
-
-rnLocalBindsAndThen (HsIPBinds binds) thing_inside
-  = rnIPBinds binds			`thenM` \ (binds',fv_binds) ->
-    thing_inside (HsIPBinds binds')	`thenM` \ (thing, fvs_thing) ->
-    returnM (thing, fvs_thing `plusFV` fv_binds)
-
--------------
-rnIPBinds (IPBinds ip_binds _no_dict_binds)
-  = do	{ (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds
-	; return (IPBinds ip_binds' emptyLHsBinds, plusFVs fvs_s) }
-
-rnIPBind (IPBind n expr)
-  = newIPNameRn  n		`thenM` \ name ->
-    rnLExpr expr		`thenM` \ (expr',fvExpr) ->
-    return (IPBind name expr', fvExpr)
-\end{code}
-
-
-%************************************************************************
-%*									*
-		ValBinds
-%*									*
-%************************************************************************
-
-\begin{code}
-rnValBindsAndThen :: HsValBinds RdrName
-	          -> (HsValBinds Name -> RnM (result, FreeVars))
-	          -> RnM (result, FreeVars)
-
-rnValBindsAndThen binds@(ValBindsIn mbinds sigs) thing_inside
-  =	-- Extract all the binders in this group, and extend the
-	-- current scope, inventing new names for the new binders
-	-- This also checks that the names form a set
-    bindLocatedLocalsRn doc mbinders_w_srclocs			$ \ bndrs ->
-
-	-- Then install local fixity declarations
-	-- Notice that they scope over thing_inside too
-    bindLocalFixities [sig | L _ (FixSig sig) <- sigs ] 	$
-
-	-- Do the business
-    rnValBinds (trimWith bndrs) binds	`thenM` \ (binds, bind_dus) ->
-
-	-- Now do the "thing inside"
-    thing_inside binds 			`thenM` \ (result,result_fvs) ->
-
-	-- Final error checking
-    let
-	all_uses = duUses bind_dus `plusFV` result_fvs
-	-- duUses: It's important to return all the uses, not the 'real uses' 
-	-- used for warning about unused bindings.  Otherwise consider:
-	--	x = 3
-	--	y = let p = x in 'x'	-- NB: p not used
-	-- If we don't "see" the dependency of 'y' on 'x', we may put the
-	-- bindings in the wrong order, and the type checker will complain
-	-- that x isn't in scope
-
-	unused_bndrs = [ b | b <- bndrs, not (b `elemNameSet` all_uses)]
-    in
-    warnUnusedLocalBinds unused_bndrs	`thenM_`
-
-    returnM (result, delListFromNameSet all_uses bndrs)
-  where
-    mbinders_w_srclocs = collectHsBindLocatedBinders mbinds
-    doc = text "In the binding group for:"
-	  <+> pprWithCommas ppr (map unLoc mbinders_w_srclocs)
-
----------------------
-rnValBinds :: (FreeVars -> FreeVars)
-	   -> HsValBinds RdrName
-	   -> RnM (HsValBinds Name, DefUses)
--- Assumes the binders of the binding are in scope already
-
-rnValBinds trim (ValBindsIn mbinds sigs)
-  = do	{ sigs' <- rename_sigs sigs
-
-	; binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds
-
-	; let (binds', bind_dus) = depAnalBinds binds_w_dus
-
-	-- We do the check-sigs after renaming the bindings,
-	-- so that we have convenient access to the binders
-	; check_sigs (okBindSig (duDefs bind_dus)) sigs'
-
-	; return (ValBindsOut binds' sigs', 
-		  usesOnly (hsSigsFVs sigs') `plusDU` bind_dus) }
-
-
----------------------
-depAnalBinds :: Bag (LHsBind Name, [Name], Uses)
-	     -> ([(RecFlag, LHsBinds Name)], DefUses)
--- Dependency analysis; this is important so that 
--- unused-binding reporting is accurate
-depAnalBinds binds_w_dus
-  = (map get_binds sccs, map get_du sccs)
-  where
-    sccs = stronglyConnComp edges
-
-    keyd_nodes = bagToList binds_w_dus `zip` [0::Int ..]
-
-    edges = [ (node, key, [key | n <- nameSetToList uses,
-			         Just key <- [lookupNameEnv key_map n] ])
-	    | (node@(_,_,uses), key) <- keyd_nodes ]
-
-    key_map :: NameEnv Int	-- Which binding it comes from
-    key_map = mkNameEnv [(bndr, key) | ((_, bndrs, _), key) <- keyd_nodes
-				     , bndr <- bndrs ]
-
-    get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
-    get_binds (CyclicSCC  binds_w_dus)  = (Recursive, listToBag [b | (b,d,u) <- binds_w_dus])
-
-    get_du (AcyclicSCC (_, bndrs, uses)) = (Just (mkNameSet bndrs), uses)
-    get_du (CyclicSCC  binds_w_dus)      = (Just defs, uses)
-	where
-	  defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs]
-	  uses = unionManyNameSets [u | (_,_,u) <- binds_w_dus]
-
-
----------------------
--- Bind the top-level forall'd type variables in the sigs.
--- E.g 	f :: a -> a
---	f = rhs
---	The 'a' scopes over the rhs
---
--- NB: there'll usually be just one (for a function binding)
---     but if there are many, one may shadow the rest; too bad!
---	e.g  x :: [a] -> [a]
---	     y :: [(a,a)] -> a
---	     (x,y) = e
---      In e, 'a' will be in scope, and it'll be the one from 'y'!
-
-mkSigTvFn :: [LSig Name] -> (Name -> [Name])
--- Return a lookup function that maps an Id Name to the names
--- of the type variables that should scope over its body..
-mkSigTvFn sigs
-  = \n -> lookupNameEnv env n `orElse` []
-  where
-    env :: NameEnv [Name]
-    env = mkNameEnv [ (name, map hsLTyVarName ltvs)
-		    | L _ (TypeSig (L _ name) 
-			           (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs]
-	-- Note the pattern-match on "Explicit"; we only bind
-	-- type variables from signatures with an explicit top-level for-all
-				
--- The trimming function trims the free vars we attach to a
--- binding so that it stays reasonably small
-noTrim :: FreeVars -> FreeVars
-noTrim fvs = fvs	-- Used at top level
-
-trimWith :: [Name] -> FreeVars -> FreeVars
--- Nested bindings; trim by intersection with the names bound here
-trimWith bndrs = intersectNameSet (mkNameSet bndrs)
-
----------------------
-rnBind :: (Name -> [Name])		-- Signature tyvar function
-       -> (FreeVars -> FreeVars)	-- Trimming function for rhs free vars
-       -> LHsBind RdrName
-       -> RnM (LHsBind Name, [Name], Uses)
-rnBind sig_fn trim (L loc (PatBind { pat_lhs = pat, pat_rhs = grhss }))
-  = setSrcSpan loc $ 
-    do	{ (pat', pat_fvs) <- rnLPat pat
-
-	; let bndrs = collectPatBinders pat'
-
-	; (grhss', fvs) <- bindSigTyVarsFV (concatMap sig_fn bndrs) $
-			   rnGRHSs PatBindRhs grhss
-
-	; return (L loc (PatBind { pat_lhs = pat', pat_rhs = grhss', 
-				   pat_rhs_ty = placeHolderType, bind_fvs = trim fvs }), 
-		  bndrs, pat_fvs `plusFV` fvs) }
-
-rnBind sig_fn trim (L loc (FunBind { fun_id = name, fun_infix = inf, fun_matches = matches }))
-  = setSrcSpan loc $ 
-    do	{ new_name <- lookupLocatedBndrRn name
-	; let plain_name = unLoc new_name
-
-	; (matches', fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
-			     rnMatchGroup (FunRhs plain_name) matches
-
-	; checkPrecMatch inf plain_name matches'
-
-	; return (L loc (FunBind { fun_id = new_name, fun_infix = inf, fun_matches = matches',
-				   bind_fvs = trim fvs, fun_co_fn = idCoercion }), 
-		  [plain_name], fvs)
-      }
-\end{code}
-
-
-@rnMethodBinds@ is used for the method bindings of a class and an instance
-declaration.   Like @rnBinds@ but without dependency analysis.
-
-NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
-That's crucial when dealing with an instance decl:
-\begin{verbatim}
-	instance Foo (T a) where
-	   op x = ...
-\end{verbatim}
-This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
-and unless @op@ occurs we won't treat the type signature of @op@ in the class
-decl for @Foo@ as a source of instance-decl gates.  But we should!  Indeed,
-in many ways the @op@ in an instance decl is just like an occurrence, not
-a binder.
-
-\begin{code}
-rnMethodBinds :: Name			-- Class name
-	      -> [Name]			-- Names for generic type variables
-	      -> LHsBinds RdrName
-	      -> RnM (LHsBinds Name, FreeVars)
-
-rnMethodBinds cls gen_tyvars binds
-  = foldM do_one (emptyBag,emptyFVs) (bagToList binds)
-  where do_one (binds,fvs) bind = do
-	   (bind', fvs_bind) <- rnMethodBind cls gen_tyvars bind
-	   return (bind' `unionBags` binds, fvs_bind `plusFV` fvs)
-
-rnMethodBind cls gen_tyvars (L loc (FunBind { fun_id = name, fun_infix = inf, 
-					      fun_matches = MatchGroup matches _ }))
-  =  setSrcSpan loc $ 
-     lookupLocatedInstDeclBndr cls name			`thenM` \ sel_name -> 
-     let plain_name = unLoc sel_name in
-	-- We use the selector name as the binder
-
-    mapFvRn (rn_match plain_name) matches		`thenM` \ (new_matches, fvs) ->
-    let 
-	new_group = MatchGroup new_matches placeHolderType
-    in
-    checkPrecMatch inf plain_name new_group		`thenM_`
-    returnM (unitBag (L loc (FunBind { fun_id = sel_name, fun_infix = inf, fun_matches = new_group,
-				       bind_fvs = fvs, fun_co_fn = idCoercion })), 
-	     fvs `addOneFV` plain_name)
-	-- The 'fvs' field isn't used for method binds
-  where
-	-- Truly gruesome; bring into scope the correct members of the generic 
-	-- type variables.  See comments in RnSource.rnSourceDecl(ClassDecl)
-    rn_match sel_name match@(L _ (Match (L _ (TypePat ty) : _) _ _))
-	= extendTyVarEnvFVRn gen_tvs 	$
-	  rnMatch (FunRhs sel_name) match
-	where
-	  tvs     = map (rdrNameOcc.unLoc) (extractHsTyRdrTyVars ty)
-	  gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs] 
-
-    rn_match sel_name match = rnMatch (FunRhs sel_name) match
-
-
--- Can't handle method pattern-bindings which bind multiple methods.
-rnMethodBind cls gen_tyvars mbind@(L loc (PatBind other_pat _ _ _))
-  = addLocErr mbind methodBindErr	`thenM_`
-    returnM (emptyBag, emptyFVs) 
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
-%*									*
-%************************************************************************
-
-@renameSigs@ checks for:
-\begin{enumerate}
-\item more than one sig for one thing;
-\item signatures given for things not bound here;
-\item with suitably flaggery, that all top-level things have type signatures.
-\end{enumerate}
-%
-At the moment we don't gather free-var info from the types in
-signatures.  We'd only need this if we wanted to report unused tyvars.
-
-\begin{code}
-renameSigs :: (LSig Name -> Bool) -> [LSig RdrName] -> RnM [LSig Name]
--- Renames the signatures and performs error checks
-renameSigs ok_sig sigs 
-  = do	{ sigs' <- rename_sigs sigs
-	; check_sigs ok_sig sigs'
-	; return sigs' }
-
-----------------------
-rename_sigs :: [LSig RdrName] -> RnM [LSig Name]
-rename_sigs sigs = mappM (wrapLocM renameSig)
-			 (filter (not . isFixityLSig) sigs)
-		-- Remove fixity sigs which have been dealt with already
-
-----------------------
-check_sigs :: (LSig Name -> Bool) -> [LSig Name] -> RnM ()
--- Used for class and instance decls, as well as regular bindings
-check_sigs ok_sig sigs 
-	-- Check for (a) duplicate signatures
-	--	     (b) signatures for things not in this group
-  = do	{ mappM_ unknownSigErr (filter (not . ok_sig) sigs')
-	; mappM_ dupSigDeclErr (findDupsEq eqHsSig sigs') }
-  where
-	-- Don't complain about an unbound name again
-    sigs' = filterOut bad_name sigs
-    bad_name sig = case sigName sig of
-			Just n -> isUnboundName n
-			other  -> False
-
--- We use lookupLocatedSigOccRn in the signatures, which is a little bit unsatisfactory
--- because this won't work for:
---	instance Foo T where
---	  {-# INLINE op #-}
---	  Baz.op = ...
--- We'll just rename the INLINE prag to refer to whatever other 'op'
--- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
--- Doesn't seem worth much trouble to sort this.
-
-renameSig :: Sig RdrName -> RnM (Sig Name)
--- FixitSig is renamed elsewhere.
-renameSig (TypeSig v ty)
-  = lookupLocatedSigOccRn v			`thenM` \ new_v ->
-    rnHsSigType (quotes (ppr v)) ty		`thenM` \ new_ty ->
-    returnM (TypeSig new_v new_ty)
-
-renameSig (SpecInstSig ty)
-  = rnLHsType (text "A SPECIALISE instance pragma") ty `thenM` \ new_ty ->
-    returnM (SpecInstSig new_ty)
-
-renameSig (SpecSig v ty inl)
-  = lookupLocatedSigOccRn v		`thenM` \ new_v ->
-    rnHsSigType (quotes (ppr v)) ty	`thenM` \ new_ty ->
-    returnM (SpecSig new_v new_ty inl)
-
-renameSig (InlineSig v s)
-  = lookupLocatedSigOccRn v		`thenM` \ new_v ->
-    returnM (InlineSig new_v s)
-\end{code}
-
-
-************************************************************************
-*									*
-\subsection{Match}
-*									*
-************************************************************************
-
-\begin{code}
-rnMatchGroup :: HsMatchContext Name -> MatchGroup RdrName -> RnM (MatchGroup Name, FreeVars)
-rnMatchGroup ctxt (MatchGroup ms _)
-  = mapFvRn (rnMatch ctxt) ms	`thenM` \ (new_ms, ms_fvs) ->
-    returnM (MatchGroup new_ms placeHolderType, ms_fvs)
-
-rnMatch :: HsMatchContext Name -> LMatch RdrName -> RnM (LMatch Name, FreeVars)
-rnMatch ctxt  = wrapLocFstM (rnMatch' ctxt)
-
-rnMatch' ctxt match@(Match pats maybe_rhs_sig grhss)
-  = 
-	-- Deal with the rhs type signature
-    bindPatSigTyVarsFV rhs_sig_tys	$ 
-    doptM Opt_GlasgowExts		`thenM` \ opt_GlasgowExts ->
-    (case maybe_rhs_sig of
-	Nothing -> returnM (Nothing, emptyFVs)
-	Just ty | opt_GlasgowExts -> rnHsTypeFVs doc_sig ty	`thenM` \ (ty', ty_fvs) ->
-				     returnM (Just ty', ty_fvs)
-		| otherwise	  -> addLocErr ty patSigErr	`thenM_`
-				     returnM (Nothing, emptyFVs)
-    )					`thenM` \ (maybe_rhs_sig', ty_fvs) ->
-
-	-- Now the main event
-    rnPatsAndThen ctxt pats	$ \ pats' ->
-    rnGRHSs ctxt grhss		`thenM` \ (grhss', grhss_fvs) ->
-
-    returnM (Match pats' maybe_rhs_sig' grhss', grhss_fvs `plusFV` ty_fvs)
-	-- The bindPatSigTyVarsFV and rnPatsAndThen will remove the bound FVs
-  where
-     rhs_sig_tys =  case maybe_rhs_sig of
-			Nothing -> []
-			Just ty -> [ty]
-     doc_sig = text "In a result type-signature"
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{Guarded right-hand sides (GRHSs)}
-%*									*
-%************************************************************************
-
-\begin{code}
-rnGRHSs :: HsMatchContext Name -> GRHSs RdrName -> RnM (GRHSs Name, FreeVars)
-
-rnGRHSs ctxt (GRHSs grhss binds)
-  = rnLocalBindsAndThen binds	$ \ binds' ->
-    mapFvRn (rnGRHS ctxt) grhss	`thenM` \ (grhss', fvGRHSs) ->
-    returnM (GRHSs grhss' binds', fvGRHSs)
-
-rnGRHS :: HsMatchContext Name -> LGRHS RdrName -> RnM (LGRHS Name, FreeVars)
-rnGRHS ctxt = wrapLocFstM (rnGRHS' ctxt)
-
-rnGRHS' ctxt (GRHS guards rhs)
-  = do	{ opt_GlasgowExts <- doptM Opt_GlasgowExts
-	; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $
-				    rnLExpr rhs
-
-	; checkM (opt_GlasgowExts || is_standard_guard guards')
-	  	 (addWarn (nonStdGuardErr guards'))
-
-	; return (GRHS guards' rhs', fvs) }
-  where
-	-- Standard Haskell 1.4 guards are just a single boolean
-	-- expression, rather than a list of qualifiers as in the
-	-- Glasgow extension
-    is_standard_guard []                     = True
-    is_standard_guard [L _ (ExprStmt _ _ _)] = True
-    is_standard_guard other	      	     = False
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Error messages}
-%*									*
-%************************************************************************
-
-\begin{code}
-dupSigDeclErr sigs@(L loc sig : _)
-  = addErrAt loc $
-	vcat [ptext SLIT("Duplicate") <+> what_it_is <> colon,
-	      nest 2 (vcat (map ppr_sig sigs))]
-  where
-    what_it_is = hsSigDoc sig
-    ppr_sig (L loc sig) = ppr loc <> colon <+> ppr sig
-
-unknownSigErr (L loc sig)
-  = addErrAt loc $
-	sep [ptext SLIT("Misplaced") <+> what_it_is <> colon, ppr sig]
-  where
-    what_it_is = hsSigDoc sig
-
-missingSigWarn var
-  = addWarnAt (mkSrcSpan loc loc) $
-      sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)]
-  where 
-    loc = nameSrcLoc var  -- TODO: make a proper span
-
-methodBindErr mbind
- =  hang (ptext SLIT("Pattern bindings (except simple variables) not allowed in instance declarations"))
-       2 (ppr mbind)
-
-bindsInHsBootFile mbinds
-  = hang (ptext SLIT("Bindings in hs-boot files are not allowed"))
-       2 (ppr mbinds)
-
-nonStdGuardErr guards
-  = hang (ptext SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)"))
-       4 (interpp'SP guards)
-\end{code}
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
deleted file mode 100644
index 2be3bfd5c0..0000000000
--- a/ghc/compiler/rename/RnEnv.lhs
+++ /dev/null
@@ -1,811 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[RnEnv]{Environment manipulation for the renamer monad}
-
-\begin{code}
-module RnEnv ( 
-	newTopSrcBinder, 
-	lookupLocatedBndrRn, lookupBndrRn, 
-	lookupLocatedTopBndrRn, lookupTopBndrRn,
-	lookupLocatedOccRn, lookupOccRn, 
-	lookupLocatedGlobalOccRn, lookupGlobalOccRn,
-	lookupLocalDataTcNames, lookupSrcOcc_maybe,
-	lookupFixityRn, lookupTyFixityRn, lookupLocatedSigOccRn, 
-	lookupLocatedInstDeclBndr,
-	lookupSyntaxName, lookupSyntaxTable, lookupImportedName,
-
-	newLocalsRn, newIPNameRn,
-	bindLocalNames, bindLocalNamesFV,
-	bindLocatedLocalsFV, bindLocatedLocalsRn,
-	bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
-	bindTyVarsRn, extendTyVarEnvFVRn,
-	bindLocalFixities,
-
-	checkDupNames, mapFvRn,
-	warnUnusedMatches, warnUnusedModules, warnUnusedImports, 
-	warnUnusedTopBinds, warnUnusedLocalBinds,
-	dataTcOccs, unknownNameErr,
-    ) where
-
-#include "HsVersions.h"
-
-import LoadIface	( loadHomeInterface, loadSrcInterface )
-import IfaceEnv		( lookupOrig, newGlobalBinder, newIPName )
-import HsSyn		( FixitySig(..), HsExpr(..), SyntaxExpr, SyntaxTable,
-			  LHsTyVarBndr, LHsType, 
-			  Fixity, hsLTyVarLocNames, replaceTyVarName )
-import RdrHsSyn		( extractHsTyRdrTyVars )
-import RdrName		( RdrName, rdrNameModule, isQual, isUnqual, isOrig,
-			  mkRdrUnqual, setRdrNameSpace, rdrNameOcc,
-			  pprGlobalRdrEnv, lookupGRE_RdrName, 
-			  isExact_maybe, isSrcRdrName,
-			  GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv, 
-			  isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
-			  Provenance(..), pprNameProvenance,
-			  importSpecLoc, importSpecModule
-			)
-import HscTypes		( availNames, ModIface(..), FixItem(..), lookupFixity )
-import TcRnMonad
-import Name		( Name, nameIsLocalOrFrom, mkInternalName, isWiredInName,
-			  nameSrcLoc, nameOccName, nameModule, nameParent, isExternalName )
-import NameSet
-import OccName		( tcName, isDataOcc, pprNonVarNameSpace, occNameSpace,
-			  reportIfUnused )
-import Module		( Module )
-import PrelNames	( mkUnboundName, rOOT_MAIN, iNTERACTIVE, consDataConKey, hasKey )
-import UniqSupply
-import BasicTypes	( IPName, mapIPName )
-import SrcLoc		( SrcSpan, srcSpanStart, Located(..), eqLocated, unLoc,
-			  srcLocSpan, getLoc, combineSrcSpans, srcSpanStartLine, srcSpanEndLine )
-import Outputable
-import Util		( sortLe )
-import ListSetOps	( removeDups )
-import List		( nubBy )
-import Monad		( when )
-import DynFlags
-\end{code}
-
-%*********************************************************
-%*							*
-		Source-code binders
-%*							*
-%*********************************************************
-
-\begin{code}
-newTopSrcBinder :: Module -> Maybe Name -> Located RdrName -> RnM Name
-newTopSrcBinder this_mod mb_parent (L loc rdr_name)
-  | Just name <- isExact_maybe rdr_name
-  =	-- This is here to catch 
-	--   (a) Exact-name binders created by Template Haskell
-	--   (b) The PrelBase defn of (say) [] and similar, for which
-	--	 the parser reads the special syntax and returns an Exact RdrName
-   	-- We are at a binding site for the name, so check first that it 
-	-- the current module is the correct one; otherwise GHC can get
-	-- very confused indeed. This test rejects code like
-	--	data T = (,) Int Int
-	-- unless we are in GHC.Tup
-    ASSERT2( isExternalName name,  ppr name )
-    do	checkErr (this_mod == nameModule name)
-	         (badOrigBinding rdr_name)
-	returnM name
-
-
-  | isOrig rdr_name
-  = do	checkErr (rdr_mod == this_mod || rdr_mod == rOOT_MAIN)
-	         (badOrigBinding rdr_name)
-	-- When reading External Core we get Orig names as binders, 
-	-- but they should agree with the module gotten from the monad
-	--
-	-- We can get built-in syntax showing up here too, sadly.  If you type
-	--	data T = (,,,)
-	-- the constructor is parsed as a type, and then RdrHsSyn.tyConToDataCon 
-	-- uses setRdrNameSpace to make it into a data constructors.  At that point
-	-- the nice Exact name for the TyCon gets swizzled to an Orig name.
-	-- Hence the badOrigBinding error message.
-	--
-	-- Except for the ":Main.main = ..." definition inserted into 
-	-- the Main module; ugh!
-
-	-- Because of this latter case, we call newGlobalBinder with a module from 
-	-- the RdrName, not from the environment.  In principle, it'd be fine to 
-	-- have an arbitrary mixture of external core definitions in a single module,
-	-- (apart from module-initialisation issues, perhaps).
-	newGlobalBinder rdr_mod (rdrNameOcc rdr_name) mb_parent 
-	    	        (srcSpanStart loc) --TODO, should pass the whole span
-
-  | otherwise
-  = newGlobalBinder this_mod (rdrNameOcc rdr_name) mb_parent (srcSpanStart loc)
-  where
-    rdr_mod  = rdrNameModule rdr_name
-\end{code}
-
-%*********************************************************
-%*							*
-	Source code occurrences
-%*							*
-%*********************************************************
-
-Looking up a name in the RnEnv.
-
-\begin{code}
-lookupLocatedBndrRn :: Located RdrName -> RnM (Located Name)
-lookupLocatedBndrRn = wrapLocM lookupBndrRn
-
-lookupBndrRn :: RdrName -> RnM Name
--- NOTE: assumes that the SrcSpan of the binder has already been setSrcSpan'd
-lookupBndrRn rdr_name
-  = getLocalRdrEnv		`thenM` \ local_env ->
-    case lookupLocalRdrEnv local_env rdr_name of 
-	  Just name -> returnM name
-	  Nothing   -> lookupTopBndrRn rdr_name
-
-lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
-lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn
-
-lookupTopBndrRn :: RdrName -> RnM Name
--- Look up a top-level source-code binder.   We may be looking up an unqualified 'f',
--- and there may be several imported 'f's too, which must not confuse us.
--- For example, this is OK:
---	import Foo( f )
---	infix 9 f	-- The 'f' here does not need to be qualified
---	f x = x		-- Nor here, of course
--- So we have to filter out the non-local ones.
---
--- A separate function (importsFromLocalDecls) reports duplicate top level
--- decls, so here it's safe just to choose an arbitrary one.
---
--- There should never be a qualified name in a binding position in Haskell,
--- but there can be if we have read in an external-Core file.
--- The Haskell parser checks for the illegal qualified name in Haskell 
--- source files, so we don't need to do so here.
-
-lookupTopBndrRn rdr_name
-  | Just name <- isExact_maybe rdr_name
-  = returnM name
-
-  | isOrig rdr_name	
-	-- This deals with the case of derived bindings, where
-	-- we don't bother to call newTopSrcBinder first
-	-- We assume there is no "parent" name
-  = do	{ loc <- getSrcSpanM
-	; newGlobalBinder (rdrNameModule rdr_name)
-		          (rdrNameOcc rdr_name) Nothing (srcSpanStart loc) }
-
-  | otherwise
-  = do	{ mb_gre <- lookupGreLocalRn rdr_name
-	; case mb_gre of
-		Nothing  -> unboundName rdr_name
-		Just gre -> returnM (gre_name gre) }
-	      
--- lookupLocatedSigOccRn is used for type signatures and pragmas
--- Is this valid?
---   module A
---	import M( f )
---	f :: Int -> Int
---	f x = x
--- It's clear that the 'f' in the signature must refer to A.f
--- The Haskell98 report does not stipulate this, but it will!
--- So we must treat the 'f' in the signature in the same way
--- as the binding occurrence of 'f', using lookupBndrRn
-lookupLocatedSigOccRn :: Located RdrName -> RnM (Located Name)
-lookupLocatedSigOccRn = lookupLocatedBndrRn
-
--- lookupInstDeclBndr is used for the binders in an 
--- instance declaration.   Here we use the class name to
--- disambiguate.  
-
-lookupLocatedInstDeclBndr :: Name -> Located RdrName -> RnM (Located Name)
-lookupLocatedInstDeclBndr cls = wrapLocM (lookupInstDeclBndr cls)
-
-lookupInstDeclBndr :: Name -> RdrName -> RnM Name
-lookupInstDeclBndr cls_name rdr_name
-  | isUnqual rdr_name	-- Find all the things the rdr-name maps to
-  = do	{		-- and pick the one with the right parent name
-	  let { is_op gre     = cls_name == nameParent (gre_name gre)
-	      ; occ	      = rdrNameOcc rdr_name
-	      ; lookup_fn env = filter is_op (lookupGlobalRdrEnv env occ) }
-	; mb_gre <- lookupGreRn_help rdr_name lookup_fn
-	; case mb_gre of
-	    Just gre -> return (gre_name gre)
-	    Nothing  -> do { addErr (unknownInstBndrErr cls_name rdr_name)
-			   ; return (mkUnboundName rdr_name) } }
-
-  | otherwise	-- Occurs in derived instances, where we just
-		-- refer directly to the right method
-  = ASSERT2( not (isQual rdr_name), ppr rdr_name )
-	  -- NB: qualified names are rejected by the parser
-    lookupImportedName rdr_name
-
-newIPNameRn :: IPName RdrName -> TcRnIf m n (IPName Name)
-newIPNameRn ip_rdr = newIPName (mapIPName rdrNameOcc ip_rdr)
-
---------------------------------------------------
---		Occurrences
---------------------------------------------------
-
-lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
-lookupLocatedOccRn = wrapLocM lookupOccRn
-
--- lookupOccRn looks up an occurrence of a RdrName
-lookupOccRn :: RdrName -> RnM Name
-lookupOccRn rdr_name
-  = getLocalRdrEnv			`thenM` \ local_env ->
-    case lookupLocalRdrEnv local_env rdr_name of
-	  Just name -> returnM name
-	  Nothing   -> lookupGlobalOccRn rdr_name
-
-lookupLocatedGlobalOccRn :: Located RdrName -> RnM (Located Name)
-lookupLocatedGlobalOccRn = wrapLocM lookupGlobalOccRn
-
-lookupGlobalOccRn :: RdrName -> RnM Name
--- lookupGlobalOccRn is like lookupOccRn, except that it looks in the global 
--- environment.  It's used only for
---	record field names
---	class op names in class and instance decls
-
-lookupGlobalOccRn rdr_name
-  | not (isSrcRdrName rdr_name)
-  = lookupImportedName rdr_name	
-
-  | otherwise
-  =	-- First look up the name in the normal environment.
-   lookupGreRn rdr_name			`thenM` \ mb_gre ->
-   case mb_gre of {
-	Just gre -> returnM (gre_name gre) ;
-	Nothing   -> 
-
-	-- We allow qualified names on the command line to refer to 
-	--  *any* name exported by any module in scope, just as if 
-	-- there was an "import qualified M" declaration for every 
-	-- module.
-   getModule 		`thenM` \ mod ->
-   if isQual rdr_name && mod == iNTERACTIVE then	
-					-- This test is not expensive,
-	lookupQualifiedName rdr_name	-- and only happens for failed lookups
-   else	
-	unboundName rdr_name }
-
-lookupImportedName :: RdrName -> TcRnIf m n Name
--- Lookup the occurrence of an imported name
--- The RdrName is *always* qualified or Exact
--- Treat it as an original name, and conjure up the Name
--- Usually it's Exact or Orig, but it can be Qual if it
---	comes from an hi-boot file.  (This minor infelicity is 
---	just to reduce duplication in the parser.)
-lookupImportedName rdr_name
-  | Just n <- isExact_maybe rdr_name 
-	-- This happens in derived code
-  = returnM n
-
-  | otherwise	-- Always Orig, even when reading a .hi-boot file
-  = ASSERT( not (isUnqual rdr_name) )
-    lookupOrig (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
-
-unboundName :: RdrName -> RnM Name
-unboundName rdr_name 
-  = do	{ addErr (unknownNameErr rdr_name)
-	; env <- getGlobalRdrEnv;
-	; traceRn (vcat [unknownNameErr rdr_name, 
-			 ptext SLIT("Global envt is:"),
-			 nest 3 (pprGlobalRdrEnv env)])
-	; returnM (mkUnboundName rdr_name) }
-
---------------------------------------------------
---	Lookup in the Global RdrEnv of the module
---------------------------------------------------
-
-lookupSrcOcc_maybe :: RdrName -> RnM (Maybe Name)
--- No filter function; does not report an error on failure
-lookupSrcOcc_maybe rdr_name
-  = do	{ mb_gre <- lookupGreRn rdr_name
-	; case mb_gre of
-		Nothing  -> returnM Nothing
-		Just gre -> returnM (Just (gre_name gre)) }
-	
--------------------------
-lookupGreRn :: RdrName -> RnM (Maybe GlobalRdrElt)
--- Just look up the RdrName in the GlobalRdrEnv
-lookupGreRn rdr_name 
-  = lookupGreRn_help rdr_name (lookupGRE_RdrName rdr_name)
-
-lookupGreLocalRn :: RdrName -> RnM (Maybe GlobalRdrElt)
--- Similar, but restricted to locally-defined things
-lookupGreLocalRn rdr_name 
-  = lookupGreRn_help rdr_name lookup_fn
-  where
-    lookup_fn env = filter isLocalGRE (lookupGRE_RdrName rdr_name env)
-
-lookupGreRn_help :: RdrName			-- Only used in error message
-		 -> (GlobalRdrEnv -> [GlobalRdrElt])	-- Lookup function
-		 -> RnM (Maybe GlobalRdrElt)
--- Checks for exactly one match; reports deprecations
--- Returns Nothing, without error, if too few
-lookupGreRn_help rdr_name lookup 
-  = do	{ env <- getGlobalRdrEnv
-	; case lookup env of
-	    []	  -> returnM Nothing
-	    [gre] -> returnM (Just gre)
-	    gres  -> do { addNameClashErrRn rdr_name gres
-			; returnM (Just (head gres)) } }
-
-------------------------------
---	GHCi support
-------------------------------
-
--- A qualified name on the command line can refer to any module at all: we
--- try to load the interface if we don't already have it.
-lookupQualifiedName :: RdrName -> RnM Name
-lookupQualifiedName rdr_name
- = let 
-       mod = rdrNameModule rdr_name
-       occ = rdrNameOcc rdr_name
-   in
-   -- Note: we want to behave as we would for a source file import here,
-   -- and respect hiddenness of modules/packages, hence loadSrcInterface.
-   loadSrcInterface doc mod False	`thenM` \ iface ->
-
-   case  [ (mod,occ) | 
-	   (mod,avails) <- mi_exports iface,
-    	   avail	<- avails,
-    	   name 	<- availNames avail,
-    	   name == occ ] of
-      ((mod,occ):ns) -> ASSERT (null ns) 
-			lookupOrig mod occ
-      _ -> unboundName rdr_name
-  where
-    doc = ptext SLIT("Need to find") <+> ppr rdr_name
-\end{code}
-
-%*********************************************************
-%*							*
-		Fixities
-%*							*
-%*********************************************************
-
-\begin{code}
-lookupLocalDataTcNames :: RdrName -> RnM [Name]
--- GHC extension: look up both the tycon and data con 
--- for con-like things
--- Complain if neither is in scope
-lookupLocalDataTcNames rdr_name
-  | Just n <- isExact_maybe rdr_name	
-	-- Special case for (:), which doesn't get into the GlobalRdrEnv
-  = return [n]	-- For this we don't need to try the tycon too
-  | otherwise
-  = do	{ mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name)
-	; case [gre_name gre | Just gre <- mb_gres] of
-	    [] -> do { addErr (unknownNameErr rdr_name)
-		     ; return [] }
-	    names -> return names
-    }
-
---------------------------------
-bindLocalFixities :: [FixitySig RdrName] -> RnM a -> RnM a
--- Used for nested fixity decls
--- No need to worry about type constructors here,
--- Should check for duplicates but we don't
-bindLocalFixities fixes thing_inside
-  | null fixes = thing_inside
-  | otherwise  = mappM rn_sig fixes	`thenM` \ new_bit ->
-		 extendFixityEnv new_bit thing_inside
-  where
-    rn_sig (FixitySig lv@(L loc v) fix)
-	= addLocM lookupBndrRn lv	`thenM` \ new_v ->
-	  returnM (new_v, (FixItem (rdrNameOcc v) fix loc))
-\end{code}
-
---------------------------------
-lookupFixity is a bit strange.  
-
-* Nested local fixity decls are put in the local fixity env, which we
-  find with getFixtyEnv
-
-* Imported fixities are found in the HIT or PIT
-
-* Top-level fixity decls in this module may be for Names that are
-    either  Global	   (constructors, class operations)
-    or 	    Local/Exported (everything else)
-  (See notes with RnNames.getLocalDeclBinders for why we have this split.)
-  We put them all in the local fixity environment
-
-\begin{code}
-lookupFixityRn :: Name -> RnM Fixity
-lookupFixityRn name
-  = getModule				`thenM` \ this_mod ->
-    if nameIsLocalOrFrom this_mod name
-    then	-- It's defined in this module
-	getFixityEnv		`thenM` \ local_fix_env ->
-	traceRn (text "lookupFixityRn" <+> (ppr name $$ ppr local_fix_env)) `thenM_`
-	returnM (lookupFixity local_fix_env name)
-
-    else	-- It's imported
-      -- For imported names, we have to get their fixities by doing a
-      -- loadHomeInterface, and consulting the Ifaces that comes back
-      -- from that, because the interface file for the Name might not
-      -- have been loaded yet.  Why not?  Suppose you import module A,
-      -- which exports a function 'f', thus;
-      --        module CurrentModule where
-      --	  import A( f )
-      -- 	module A( f ) where
-      --	  import B( f )
-      -- Then B isn't loaded right away (after all, it's possible that
-      -- nothing from B will be used).  When we come across a use of
-      -- 'f', we need to know its fixity, and it's then, and only
-      -- then, that we load B.hi.  That is what's happening here.
-      --
-      -- loadHomeInterface will find B.hi even if B is a hidden module,
-      -- and that's what we want.
-        loadHomeInterface doc name	`thenM` \ iface ->
-	returnM (mi_fix_fn iface (nameOccName name))
-  where
-    doc = ptext SLIT("Checking fixity for") <+> ppr name
-
----------------
-lookupTyFixityRn :: Located Name -> RnM Fixity
-lookupTyFixityRn (L loc n)
-  = doptM Opt_GlasgowExts 			`thenM` \ glaExts ->
-    when (not glaExts) 
-    	 (setSrcSpan loc $ addWarn (infixTyConWarn n))	`thenM_`
-    lookupFixityRn n
-
----------------
-dataTcOccs :: RdrName -> [RdrName]
--- If the input is a data constructor, return both it and a type
--- constructor.  This is useful when we aren't sure which we are
--- looking at.
-dataTcOccs rdr_name
-  | Just n <- isExact_maybe rdr_name		-- Ghastly special case
-  , n `hasKey` consDataConKey = [rdr_name]	-- see note below
-  | isDataOcc occ 	      = [rdr_name_tc, rdr_name]
-  | otherwise 	  	      = [rdr_name]
-  where    
-    occ 	= rdrNameOcc rdr_name
-    rdr_name_tc = setRdrNameSpace rdr_name tcName
-
--- If the user typed "[]" or "(,,)", we'll generate an Exact RdrName,
--- and setRdrNameSpace generates an Orig, which is fine
--- But it's not fine for (:), because there *is* no corresponding type
--- constructor.  If we generate an Orig tycon for GHC.Base.(:), it'll
--- appear to be in scope (because Orig's simply allocate a new name-cache
--- entry) and then we get an error when we use dataTcOccs in 
--- TcRnDriver.tcRnGetInfo.  Large sigh.
-\end{code}
-
-%************************************************************************
-%*									*
-			Rebindable names
-	Dealing with rebindable syntax is driven by the 
-	Opt_NoImplicitPrelude dynamic flag.
-
-	In "deriving" code we don't want to use rebindable syntax
-	so we switch off the flag locally
-
-%*									*
-%************************************************************************
-
-Haskell 98 says that when you say "3" you get the "fromInteger" from the
-Standard Prelude, regardless of what is in scope.   However, to experiment
-with having a language that is less coupled to the standard prelude, we're
-trying a non-standard extension that instead gives you whatever "Prelude.fromInteger"
-happens to be in scope.  Then you can
-	import Prelude ()
-	import MyPrelude as Prelude
-to get the desired effect.
-
-At the moment this just happens for
-  * fromInteger, fromRational on literals (in expressions and patterns)
-  * negate (in expressions)
-  * minus  (arising from n+k patterns)
-  * "do" notation
-
-We store the relevant Name in the HsSyn tree, in 
-  * HsIntegral/HsFractional	
-  * NegApp
-  * NPlusKPat
-  * HsDo
-respectively.  Initially, we just store the "standard" name (PrelNames.fromIntegralName,
-fromRationalName etc), but the renamer changes this to the appropriate user
-name if Opt_NoImplicitPrelude is on.  That is what lookupSyntaxName does.
-
-We treat the orignal (standard) names as free-vars too, because the type checker
-checks the type of the user thing against the type of the standard thing.
-
-\begin{code}
-lookupSyntaxName :: Name 				-- The standard name
-	         -> RnM (SyntaxExpr Name, FreeVars)	-- Possibly a non-standard name
-lookupSyntaxName std_name
-  = doptM Opt_ImplicitPrelude		`thenM` \ implicit_prelude -> 
-    if implicit_prelude then normal_case
-    else
-	-- Get the similarly named thing from the local environment
-    lookupOccRn (mkRdrUnqual (nameOccName std_name)) `thenM` \ usr_name ->
-    returnM (HsVar usr_name, unitFV usr_name)
-  where
-    normal_case = returnM (HsVar std_name, emptyFVs)
-
-lookupSyntaxTable :: [Name]				-- Standard names
-		  -> RnM (SyntaxTable Name, FreeVars)	-- See comments with HsExpr.ReboundNames
-lookupSyntaxTable std_names
-  = doptM Opt_ImplicitPrelude		`thenM` \ implicit_prelude -> 
-    if implicit_prelude then normal_case 
-    else
-    	-- Get the similarly named thing from the local environment
-    mappM (lookupOccRn . mkRdrUnqual . nameOccName) std_names 	`thenM` \ usr_names ->
-
-    returnM (std_names `zip` map HsVar usr_names, mkFVs usr_names)
-  where
-    normal_case = returnM (std_names `zip` map HsVar std_names, emptyFVs)
-\end{code}
-
-
-%*********************************************************
-%*							*
-\subsection{Binding}
-%*							*
-%*********************************************************
-
-\begin{code}
-newLocalsRn :: [Located RdrName] -> RnM [Name]
-newLocalsRn rdr_names_w_loc
-  = newUniqueSupply 		`thenM` \ us ->
-    returnM (zipWith mk rdr_names_w_loc (uniqsFromSupply us))
-  where
-    mk (L loc rdr_name) uniq
-	| Just name <- isExact_maybe rdr_name = name
-		-- This happens in code generated by Template Haskell 
-	| otherwise = ASSERT2( isUnqual rdr_name, ppr rdr_name )
-			-- We only bind unqualified names here
-			-- lookupRdrEnv doesn't even attempt to look up a qualified RdrName
-		      mkInternalName uniq (rdrNameOcc rdr_name) (srcSpanStart loc)
-
-bindLocatedLocalsRn :: SDoc	-- Documentation string for error message
-	   	    -> [Located RdrName]
-	    	    -> ([Name] -> RnM a)
-	    	    -> RnM a
-bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
-  = 	-- Check for duplicate names
-    checkDupNames doc_str rdr_names_w_loc	`thenM_`
-
-    	-- Warn about shadowing, but only in source modules
-    ifOptM Opt_WarnNameShadowing 
-      (checkShadowing doc_str rdr_names_w_loc)	`thenM_`
-
-	-- Make fresh Names and extend the environment
-    newLocalsRn rdr_names_w_loc		`thenM` \ names ->
-    getLocalRdrEnv			`thenM` \ local_env ->
-    setLocalRdrEnv (extendLocalRdrEnv local_env names)
-		   (enclosed_scope names)
-
-
-bindLocalNames :: [Name] -> RnM a -> RnM a
-bindLocalNames names enclosed_scope
-  = getLocalRdrEnv 		`thenM` \ name_env ->
-    setLocalRdrEnv (extendLocalRdrEnv name_env names)
-		    enclosed_scope
-
-bindLocalNamesFV :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
-bindLocalNamesFV names enclosed_scope
-  = do	{ (result, fvs) <- bindLocalNames names enclosed_scope
-	; returnM (result, delListFromNameSet fvs names) }
-
-
--------------------------------------
-	-- binLocalsFVRn is the same as bindLocalsRn
-	-- except that it deals with free vars
-bindLocatedLocalsFV :: SDoc -> [Located RdrName] -> ([Name] -> RnM (a,FreeVars))
-  -> RnM (a, FreeVars)
-bindLocatedLocalsFV doc rdr_names enclosed_scope
-  = bindLocatedLocalsRn doc rdr_names	$ \ names ->
-    enclosed_scope names		`thenM` \ (thing, fvs) ->
-    returnM (thing, delListFromNameSet fvs names)
-
--------------------------------------
-bindTyVarsRn :: SDoc -> [LHsTyVarBndr RdrName]
-	      -> ([LHsTyVarBndr Name] -> RnM a)
-	      -> RnM a
--- Haskell-98 binding of type variables; e.g. within a data type decl
-bindTyVarsRn doc_str tyvar_names enclosed_scope
-  = let
-	located_tyvars = hsLTyVarLocNames tyvar_names
-    in
-    bindLocatedLocalsRn doc_str located_tyvars	$ \ names ->
-    enclosed_scope (zipWith replace tyvar_names names)
-    where 
-	replace (L loc n1) n2 = L loc (replaceTyVarName n1 n2)
-
-bindPatSigTyVars :: [LHsType RdrName] -> ([Name] -> RnM a) -> RnM a
-  -- Find the type variables in the pattern type 
-  -- signatures that must be brought into scope
-bindPatSigTyVars tys thing_inside
-  = do 	{ scoped_tyvars <- doptM Opt_ScopedTypeVariables
-	; if not scoped_tyvars then 
-		thing_inside []
-	  else 
-    do 	{ name_env <- getLocalRdrEnv
-	; let locd_tvs  = [ tv | ty <- tys
-			       , tv <- extractHsTyRdrTyVars ty
-			       , not (unLoc tv `elemLocalRdrEnv` name_env) ]
-	      nubbed_tvs = nubBy eqLocated locd_tvs
-		-- The 'nub' is important.  For example:
-		--	f (x :: t) (y :: t) = ....
-		-- We don't want to complain about binding t twice!
-
-	; bindLocatedLocalsRn doc_sig nubbed_tvs thing_inside }}
-  where
-    doc_sig = text "In a pattern type-signature"
-
-bindPatSigTyVarsFV :: [LHsType RdrName]
-		   -> RnM (a, FreeVars)
-	  	   -> RnM (a, FreeVars)
-bindPatSigTyVarsFV tys thing_inside
-  = bindPatSigTyVars tys	$ \ tvs ->
-    thing_inside		`thenM` \ (result,fvs) ->
-    returnM (result, fvs `delListFromNameSet` tvs)
-
-bindSigTyVarsFV :: [Name]
-		-> RnM (a, FreeVars)
-	  	-> RnM (a, FreeVars)
-bindSigTyVarsFV tvs thing_inside
-  = do	{ scoped_tyvars <- doptM Opt_ScopedTypeVariables
-	; if not scoped_tyvars then 
-		thing_inside 
-	  else
-		bindLocalNamesFV tvs thing_inside }
-
-extendTyVarEnvFVRn :: [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
-	-- This function is used only in rnSourceDecl on InstDecl
-extendTyVarEnvFVRn tyvars thing_inside = bindLocalNamesFV tyvars thing_inside
-
--------------------------------------
-checkDupNames :: SDoc
-	      -> [Located RdrName]
-	      -> RnM ()
-checkDupNames doc_str rdr_names_w_loc
-  = 	-- Check for duplicated names in a binding group
-    mappM_ (dupNamesErr doc_str) dups
-  where
-    (_, dups) = removeDups (\n1 n2 -> unLoc n1 `compare` unLoc n2) rdr_names_w_loc
-
--------------------------------------
-checkShadowing doc_str loc_rdr_names
-  = getLocalRdrEnv		`thenM` \ local_env ->
-    getGlobalRdrEnv		`thenM` \ global_env ->
-    let
-      check_shadow (L loc rdr_name)
-	|  rdr_name `elemLocalRdrEnv` local_env 
- 	|| not (null (lookupGRE_RdrName rdr_name global_env ))
-	= setSrcSpan loc $ addWarn (shadowedNameWarn doc_str rdr_name)
-        | otherwise = returnM ()
-    in
-    mappM_ check_shadow loc_rdr_names
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Free variable manipulation}
-%*									*
-%************************************************************************
-
-\begin{code}
--- A useful utility
-mapFvRn f xs = mappM f xs	`thenM` \ stuff ->
-	       let
-		  (ys, fvs_s) = unzip stuff
-	       in
-	       returnM (ys, plusFVs fvs_s)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Envt utility functions}
-%*									*
-%************************************************************************
-
-\begin{code}
-warnUnusedModules :: [(Module,SrcSpan)] -> RnM ()
-warnUnusedModules mods
-  = ifOptM Opt_WarnUnusedImports (mappM_ bleat mods)
-  where
-    bleat (mod,loc) = setSrcSpan loc $ addWarn (mk_warn mod)
-    mk_warn m = vcat [ptext SLIT("Module") <+> quotes (ppr m)
-			<+> text "is imported, but nothing from it is used,",
-		      nest 2 (ptext SLIT("except perhaps instances visible in") 
-			<+> quotes (ppr m)),
-		      ptext SLIT("To suppress this warning, use:") 
-			<+> ptext SLIT("import") <+> ppr m <> parens empty ]
-
-
-warnUnusedImports, warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
-warnUnusedImports gres  = ifOptM Opt_WarnUnusedImports (warnUnusedGREs gres)
-warnUnusedTopBinds gres = ifOptM Opt_WarnUnusedBinds   (warnUnusedGREs gres)
-
-warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM ()
-warnUnusedLocalBinds names = ifOptM Opt_WarnUnusedBinds   (warnUnusedLocals names)
-warnUnusedMatches    names = ifOptM Opt_WarnUnusedMatches (warnUnusedLocals names)
-
--------------------------
---	Helpers
-warnUnusedGREs gres 
- = warnUnusedBinds [(n,Just p) | GRE {gre_name = n, gre_prov = p} <- gres]
-
-warnUnusedLocals names
- = warnUnusedBinds [(n,Nothing) | n<-names]
-
-warnUnusedBinds :: [(Name,Maybe Provenance)] -> RnM ()
-warnUnusedBinds names  = mappM_ warnUnusedName (filter reportable names)
- where reportable (name,_) 
-	| isWiredInName name = False	-- Don't report unused wired-in names
-					-- Otherwise we get a zillion warnings
-					-- from Data.Tuple
-	| otherwise = reportIfUnused (nameOccName name)
-
--------------------------
-
-warnUnusedName :: (Name, Maybe Provenance) -> RnM ()
-warnUnusedName (name, prov)
-  = addWarnAt loc $
-    sep [msg <> colon, 
-	 nest 2 $ pprNonVarNameSpace (occNameSpace (nameOccName name))
-			<+> quotes (ppr name)]
-	-- TODO should be a proper span
-  where
-    (loc,msg) = case prov of
-		  Just (Imported is)
-		        -> (importSpecLoc imp_spec, imp_from (importSpecModule imp_spec))
-		        where
-			  imp_spec = head is
-		  other -> (srcLocSpan (nameSrcLoc name), unused_msg)
-
-    unused_msg   = text "Defined but not used"
-    imp_from mod = text "Imported from" <+> quotes (ppr mod) <+> text "but not used"
-\end{code}
-
-\begin{code}
-addNameClashErrRn rdr_name (np1:nps)
-  = addErr (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
-		  ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
-  where
-    msg1 = ptext  SLIT("either") <+> mk_ref np1
-    msgs = [ptext SLIT("    or") <+> mk_ref np | np <- nps]
-    mk_ref gre = quotes (ppr (gre_name gre)) <> comma <+> pprNameProvenance gre
-
-shadowedNameWarn doc shadow
-  = hsep [ptext SLIT("This binding for"), 
-	       quotes (ppr shadow),
-	       ptext SLIT("shadows an existing binding")]
-    $$ doc
-
-unknownNameErr rdr_name
-  = sep [ptext SLIT("Not in scope:"), 
-	 nest 2 $ pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name))
-		  <+> quotes (ppr rdr_name)]
-
-unknownInstBndrErr cls op
-  = quotes (ppr op) <+> ptext SLIT("is not a (visible) method of class") <+> quotes (ppr cls)
-
-badOrigBinding name
-  = ptext SLIT("Illegal binding of built-in syntax:") <+> ppr (rdrNameOcc name)
-	-- The rdrNameOcc is because we don't want to print Prelude.(,)
-
-dupNamesErr :: SDoc -> [Located RdrName] -> RnM ()
-dupNamesErr descriptor located_names
-  = setSrcSpan big_loc $
-    addErr (vcat [ptext SLIT("Conflicting definitions for") <+> quotes (ppr name1),
-		  locations,
-		  descriptor])
-  where
-    L _ name1 = head located_names
-    locs      = map getLoc located_names
-    big_loc   = foldr1 combineSrcSpans locs
-    one_line  = srcSpanStartLine big_loc == srcSpanEndLine big_loc
-    locations | one_line  = empty 
-	      | otherwise = ptext SLIT("Bound at:") <+> 
-			    vcat (map ppr (sortLe (<=) locs))
-
-infixTyConWarn op
-  = vcat [ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op),
-	  ftext FSLIT("Use -fglasgow-exts to avoid this warning")]
-\end{code}
diff --git a/ghc/compiler/rename/RnExpr.hi-boot-6 b/ghc/compiler/rename/RnExpr.hi-boot-6
deleted file mode 100644
index 8f6c7f154b..0000000000
--- a/ghc/compiler/rename/RnExpr.hi-boot-6
+++ /dev/null
@@ -1,11 +0,0 @@
-module RnExpr where

-

-rnLExpr :: HsExpr.LHsExpr RdrName.RdrName

-	-> TcRnTypes.RnM (HsExpr.LHsExpr Name.Name, NameSet.FreeVars)

-

-rnStmts :: forall thing.

-	   HsExpr.HsStmtContext Name.Name -> [HsExpr.LStmt RdrName.RdrName] 

-	-> TcRnTypes.RnM (thing, NameSet.FreeVars)

-	-> TcRnTypes.RnM (([HsExpr.LStmt Name.Name], thing), NameSet.FreeVars)

-

-

diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
deleted file mode 100644
index 716a85a3b3..0000000000
--- a/ghc/compiler/rename/RnExpr.lhs
+++ /dev/null
@@ -1,996 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[RnExpr]{Renaming of expressions}
-
-Basically dependency analysis.
-
-Handles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes.  In
-general, all of these functions return a renamed thing, and a set of
-free variables.
-
-\begin{code}
-module RnExpr (
-	rnLExpr, rnExpr, rnStmts
-   ) where
-
-#include "HsVersions.h"
-
-import RnSource  ( rnSrcDecls, rnSplice, checkTH ) 
-import RnBinds	 ( rnLocalBindsAndThen, rnValBinds,
-		   rnMatchGroup, trimWith ) 
-import HsSyn
-import RnHsSyn
-import TcRnMonad
-import RnEnv
-import OccName		( plusOccEnv )
-import RnNames		( getLocalDeclBinders, extendRdrEnvRn )
-import RnTypes		( rnHsTypeFVs, rnLPat, rnOverLit, rnPatsAndThen, rnLit,
-			  mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec, 
-			  dupFieldErr, checkTupSize )
-import DynFlags		( DynFlag(..) )
-import BasicTypes	( FixityDirection(..) )
-import PrelNames	( thFAKE, hasKey, assertIdKey, assertErrorName,
-			  loopAName, choiceAName, appAName, arrAName, composeAName, firstAName,
-			  negateName, thenMName, bindMName, failMName )
-#if defined(GHCI) && defined(BREAKPOINT)
-import PrelNames        ( breakpointJumpName, undefined_RDR, breakpointIdKey )
-import UniqFM           ( eltsUFM )
-import DynFlags         ( GhcMode(..) )
-import SrcLoc           ( srcSpanFile, srcSpanStartLine )
-import Name             ( isTyVarName )
-#endif
-import Name		( Name, nameOccName, nameIsLocalOrFrom )
-import NameSet
-import RdrName		( RdrName, emptyGlobalRdrEnv, extendLocalRdrEnv, lookupLocalRdrEnv )
-import LoadIface	( loadHomeInterface )
-import UniqFM		( isNullUFM )
-import UniqSet		( emptyUniqSet )
-import List		( nub )
-import Util		( isSingleton )
-import ListSetOps	( removeDups )
-import Maybes		( expectJust )
-import Outputable
-import SrcLoc		( Located(..), unLoc, getLoc, cmpLocated )
-import FastString
-
-import List		( unzip4 )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{Expressions}
-%*									*
-%************************************************************************
-
-\begin{code}
-rnExprs :: [LHsExpr RdrName] -> RnM ([LHsExpr Name], FreeVars)
-rnExprs ls = rnExprs' ls emptyUniqSet
- where
-  rnExprs' [] acc = returnM ([], acc)
-  rnExprs' (expr:exprs) acc
-   = rnLExpr expr 	        `thenM` \ (expr', fvExpr) ->
-
-	-- Now we do a "seq" on the free vars because typically it's small
-	-- or empty, especially in very long lists of constants
-    let
-	acc' = acc `plusFV` fvExpr
-    in
-    (grubby_seqNameSet acc' rnExprs') exprs acc'	`thenM` \ (exprs', fvExprs) ->
-    returnM (expr':exprs', fvExprs)
-
--- Grubby little function to do "seq" on namesets; replace by proper seq when GHC can do seq
-grubby_seqNameSet ns result | isNullUFM ns = result
-			    | otherwise    = result
-\end{code}
-
-Variables. We look up the variable and return the resulting name. 
-
-\begin{code}
-rnLExpr :: LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars)
-rnLExpr = wrapLocFstM rnExpr
-
-rnExpr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
-
-rnExpr (HsVar v)
-  = do name           <- lookupOccRn v
-       localRdrEnv    <- getLocalRdrEnv
-       lclEnv         <- getLclEnv
-       ignore_asserts <- doptM Opt_IgnoreAsserts
-       ignore_breakpoints <- doptM Opt_IgnoreBreakpoints
-       let conds = [ (name `hasKey` assertIdKey
-                      && not ignore_asserts,
-                      do (e, fvs) <- mkAssertErrorExpr
-                         return (e, fvs `addOneFV` name))
-#if defined(GHCI) && defined(BREAKPOINT)
-                   , (name `hasKey` breakpointIdKey
-                      && not ignore_breakpoints,
-                      do ghcMode <- getGhcMode
-                         case ghcMode of
-                           Interactive
-                               -> do let isWantedName = not.isTyVarName
-                                     (e, fvs) <- mkBreakPointExpr (filter isWantedName (eltsUFM localRdrEnv))
-                                     return (e, fvs `addOneFV` name)
-                           _ -> return (HsVar name, unitFV name)
-                     )
-#endif
-                   ]
-       case lookup True conds of
-         Just action -> action
-         Nothing     -> return (HsVar name, unitFV name)
-
-rnExpr (HsIPVar v)
-  = newIPNameRn v		`thenM` \ name ->
-    returnM (HsIPVar name, emptyFVs)
-
-rnExpr (HsLit lit) 
-  = rnLit lit		`thenM_`
-    returnM (HsLit lit, emptyFVs)
-
-rnExpr (HsOverLit lit) 
-  = rnOverLit lit		`thenM` \ (lit', fvs) ->
-    returnM (HsOverLit lit', fvs)
-
-rnExpr (HsApp fun arg)
-  = rnLExpr fun		`thenM` \ (fun',fvFun) ->
-    rnLExpr arg		`thenM` \ (arg',fvArg) ->
-    returnM (HsApp fun' arg', fvFun `plusFV` fvArg)
-
-rnExpr (OpApp e1 op _ e2) 
-  = rnLExpr e1				`thenM` \ (e1', fv_e1) ->
-    rnLExpr e2				`thenM` \ (e2', fv_e2) ->
-    rnLExpr op				`thenM` \ (op'@(L _ (HsVar op_name)), fv_op) ->
-
-	-- Deal with fixity
-	-- When renaming code synthesised from "deriving" declarations
-	-- we used to avoid fixity stuff, but we can't easily tell any
-	-- more, so I've removed the test.  Adding HsPars in TcGenDeriv
-	-- should prevent bad things happening.
-    lookupFixityRn op_name		`thenM` \ fixity ->
-    mkOpAppRn e1' op' fixity e2'	`thenM` \ final_e -> 
-
-    returnM (final_e,
-	      fv_e1 `plusFV` fv_op `plusFV` fv_e2)
-
-rnExpr (NegApp e _)
-  = rnLExpr e			`thenM` \ (e', fv_e) ->
-    lookupSyntaxName negateName	`thenM` \ (neg_name, fv_neg) ->
-    mkNegAppRn e' neg_name	`thenM` \ final_e ->
-    returnM (final_e, fv_e `plusFV` fv_neg)
-
-rnExpr (HsPar e)
-  = rnLExpr e 		`thenM` \ (e', fvs_e) ->
-    returnM (HsPar e', fvs_e)
-
--- Template Haskell extensions
--- Don't ifdef-GHCI them because we want to fail gracefully
--- (not with an rnExpr crash) in a stage-1 compiler.
-rnExpr e@(HsBracket br_body)
-  = checkTH e "bracket"		`thenM_`
-    rnBracket br_body		`thenM` \ (body', fvs_e) ->
-    returnM (HsBracket body', fvs_e)
-
-rnExpr e@(HsSpliceE splice)
-  = rnSplice splice 		`thenM` \ (splice', fvs) ->
-    returnM (HsSpliceE splice', fvs)
-
-rnExpr section@(SectionL expr op)
-  = rnLExpr expr	 	`thenM` \ (expr', fvs_expr) ->
-    rnLExpr op	 		`thenM` \ (op', fvs_op) ->
-    checkSectionPrec InfixL section op' expr' `thenM_`
-    returnM (SectionL expr' op', fvs_op `plusFV` fvs_expr)
-
-rnExpr section@(SectionR op expr)
-  = rnLExpr op	 				`thenM` \ (op',   fvs_op) ->
-    rnLExpr expr	 				`thenM` \ (expr', fvs_expr) ->
-    checkSectionPrec InfixR section op' expr'	`thenM_`
-    returnM (SectionR op' expr', fvs_op `plusFV` fvs_expr)
-
-rnExpr (HsCoreAnn ann expr)
-  = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
-    returnM (HsCoreAnn ann expr', fvs_expr)
-
-rnExpr (HsSCC lbl expr)
-  = rnLExpr expr	 	`thenM` \ (expr', fvs_expr) ->
-    returnM (HsSCC lbl expr', fvs_expr)
-
-rnExpr (HsLam matches)
-  = rnMatchGroup LambdaExpr matches	`thenM` \ (matches', fvMatch) ->
-    returnM (HsLam matches', fvMatch)
-
-rnExpr (HsCase expr matches)
-  = rnLExpr expr		 	`thenM` \ (new_expr, e_fvs) ->
-    rnMatchGroup CaseAlt matches	`thenM` \ (new_matches, ms_fvs) ->
-    returnM (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs)
-
-rnExpr (HsLet binds expr)
-  = rnLocalBindsAndThen binds		$ \ binds' ->
-    rnLExpr expr			 `thenM` \ (expr',fvExpr) ->
-    returnM (HsLet binds' expr', fvExpr)
-
-rnExpr e@(HsDo do_or_lc stmts body _)
-  = do 	{ ((stmts', body'), fvs) <- rnStmts do_or_lc stmts $
-				    rnLExpr body
-	; return (HsDo do_or_lc stmts' body' placeHolderType, fvs) }
-
-rnExpr (ExplicitList _ exps)
-  = rnExprs exps		 	`thenM` \ (exps', fvs) ->
-    returnM  (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name)
-
-rnExpr (ExplicitPArr _ exps)
-  = rnExprs exps		 	`thenM` \ (exps', fvs) ->
-    returnM  (ExplicitPArr placeHolderType exps', fvs)
-
-rnExpr e@(ExplicitTuple exps boxity)
-  = checkTupSize tup_size			`thenM_`
-    rnExprs exps	 			`thenM` \ (exps', fvs) ->
-    returnM (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
-  where
-    tup_size   = length exps
-    tycon_name = tupleTyCon_name boxity tup_size
-
-rnExpr (RecordCon con_id _ rbinds)
-  = lookupLocatedOccRn con_id		`thenM` \ conname ->
-    rnRbinds "construction" rbinds	`thenM` \ (rbinds', fvRbinds) ->
-    returnM (RecordCon conname noPostTcExpr rbinds', 
-	     fvRbinds `addOneFV` unLoc conname)
-
-rnExpr (RecordUpd expr rbinds _ _)
-  = rnLExpr expr		`thenM` \ (expr', fvExpr) ->
-    rnRbinds "update" rbinds	`thenM` \ (rbinds', fvRbinds) ->
-    returnM (RecordUpd expr' rbinds' placeHolderType placeHolderType, 
-	     fvExpr `plusFV` fvRbinds)
-
-rnExpr (ExprWithTySig expr pty)
-  = rnLExpr expr		`thenM` \ (expr', fvExpr) ->
-    rnHsTypeFVs doc pty		`thenM` \ (pty', fvTy) ->
-    returnM (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy)
-  where 
-    doc = text "In an expression type signature"
-
-rnExpr (HsIf p b1 b2)
-  = rnLExpr p		`thenM` \ (p', fvP) ->
-    rnLExpr b1		`thenM` \ (b1', fvB1) ->
-    rnLExpr b2		`thenM` \ (b2', fvB2) ->
-    returnM (HsIf p' b1' b2', plusFVs [fvP, fvB1, fvB2])
-
-rnExpr (HsType a)
-  = rnHsTypeFVs doc a	`thenM` \ (t, fvT) -> 
-    returnM (HsType t, fvT)
-  where 
-    doc = text "In a type argument"
-
-rnExpr (ArithSeq _ seq)
-  = rnArithSeq seq	 `thenM` \ (new_seq, fvs) ->
-    returnM (ArithSeq noPostTcExpr new_seq, fvs)
-
-rnExpr (PArrSeq _ seq)
-  = rnArithSeq seq	 `thenM` \ (new_seq, fvs) ->
-    returnM (PArrSeq noPostTcExpr new_seq, fvs)
-\end{code}
-
-These three are pattern syntax appearing in expressions.
-Since all the symbols are reservedops we can simply reject them.
-We return a (bogus) EWildPat in each case.
-
-\begin{code}
-rnExpr e@EWildPat      = patSynErr e
-rnExpr e@(EAsPat {})   = patSynErr e
-rnExpr e@(ELazyPat {}) = patSynErr e
-\end{code}
-
-%************************************************************************
-%*									*
-	Arrow notation
-%*									*
-%************************************************************************
-
-\begin{code}
-rnExpr (HsProc pat body)
-  = newArrowScope $
-    rnPatsAndThen ProcExpr [pat] $ \ [pat'] ->
-    rnCmdTop body	         `thenM` \ (body',fvBody) ->
-    returnM (HsProc pat' body', fvBody)
-
-rnExpr (HsArrApp arrow arg _ ho rtl)
-  = select_arrow_scope (rnLExpr arrow)	`thenM` \ (arrow',fvArrow) ->
-    rnLExpr arg				`thenM` \ (arg',fvArg) ->
-    returnM (HsArrApp arrow' arg' placeHolderType ho rtl,
-	     fvArrow `plusFV` fvArg)
-  where
-    select_arrow_scope tc = case ho of
-        HsHigherOrderApp -> tc
-        HsFirstOrderApp  -> escapeArrowScope tc
-
--- infix form
-rnExpr (HsArrForm op (Just _) [arg1, arg2])
-  = escapeArrowScope (rnLExpr op)
-			`thenM` \ (op'@(L _ (HsVar op_name)),fv_op) ->
-    rnCmdTop arg1	`thenM` \ (arg1',fv_arg1) ->
-    rnCmdTop arg2	`thenM` \ (arg2',fv_arg2) ->
-
-	-- Deal with fixity
-
-    lookupFixityRn op_name		`thenM` \ fixity ->
-    mkOpFormRn arg1' op' fixity arg2'	`thenM` \ final_e -> 
-
-    returnM (final_e,
-	      fv_arg1 `plusFV` fv_op `plusFV` fv_arg2)
-
-rnExpr (HsArrForm op fixity cmds)
-  = escapeArrowScope (rnLExpr op)	`thenM` \ (op',fvOp) ->
-    rnCmdArgs cmds			`thenM` \ (cmds',fvCmds) ->
-    returnM (HsArrForm op' fixity cmds', fvOp `plusFV` fvCmds)
-
-rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
-	-- DictApp, DictLam, TyApp, TyLam
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Arrow commands
-%*									*
-%************************************************************************
-
-\begin{code}
-rnCmdArgs [] = returnM ([], emptyFVs)
-rnCmdArgs (arg:args)
-  = rnCmdTop arg	`thenM` \ (arg',fvArg) ->
-    rnCmdArgs args	`thenM` \ (args',fvArgs) ->
-    returnM (arg':args', fvArg `plusFV` fvArgs)
-
-
-rnCmdTop = wrapLocFstM rnCmdTop'
- where
-  rnCmdTop' (HsCmdTop cmd _ _ _) 
-   = rnLExpr (convertOpFormsLCmd cmd) `thenM` \ (cmd', fvCmd) ->
-     let 
-	cmd_names = [arrAName, composeAName, firstAName] ++
-		    nameSetToList (methodNamesCmd (unLoc cmd'))
-     in
-	-- Generate the rebindable syntax for the monad
-     lookupSyntaxTable cmd_names	`thenM` \ (cmd_names', cmd_fvs) ->
-
-     returnM (HsCmdTop cmd' [] placeHolderType cmd_names', 
-	     fvCmd `plusFV` cmd_fvs)
-
----------------------------------------------------
--- convert OpApp's in a command context to HsArrForm's
-
-convertOpFormsLCmd :: LHsCmd id -> LHsCmd id
-convertOpFormsLCmd = fmap convertOpFormsCmd
-
-convertOpFormsCmd :: HsCmd id -> HsCmd id
-
-convertOpFormsCmd (HsApp c e) = HsApp (convertOpFormsLCmd c) e
-convertOpFormsCmd (HsLam match) = HsLam (convertOpFormsMatch match)
-convertOpFormsCmd (OpApp c1 op fixity c2)
-  = let
-	arg1 = L (getLoc c1) $ HsCmdTop (convertOpFormsLCmd c1) [] placeHolderType []
-	arg2 = L (getLoc c2) $ HsCmdTop (convertOpFormsLCmd c2) [] placeHolderType []
-    in
-    HsArrForm op (Just fixity) [arg1, arg2]
-
-convertOpFormsCmd (HsPar c) = HsPar (convertOpFormsLCmd c)
-
--- gaw 2004
-convertOpFormsCmd (HsCase exp matches)
-  = HsCase exp (convertOpFormsMatch matches)
-
-convertOpFormsCmd (HsIf exp c1 c2)
-  = HsIf exp (convertOpFormsLCmd c1) (convertOpFormsLCmd c2)
-
-convertOpFormsCmd (HsLet binds cmd)
-  = HsLet binds (convertOpFormsLCmd cmd)
-
-convertOpFormsCmd (HsDo ctxt stmts body ty)
-  = HsDo ctxt (map (fmap convertOpFormsStmt) stmts)
-	      (convertOpFormsLCmd body) ty
-
--- Anything else is unchanged.  This includes HsArrForm (already done),
--- things with no sub-commands, and illegal commands (which will be
--- caught by the type checker)
-convertOpFormsCmd c = c
-
-convertOpFormsStmt (BindStmt pat cmd _ _)
-  = BindStmt pat (convertOpFormsLCmd cmd) noSyntaxExpr noSyntaxExpr
-convertOpFormsStmt (ExprStmt cmd _ _)
-  = ExprStmt (convertOpFormsLCmd cmd) noSyntaxExpr placeHolderType
-convertOpFormsStmt (RecStmt stmts lvs rvs es binds)
-  = RecStmt (map (fmap convertOpFormsStmt) stmts) lvs rvs es binds
-convertOpFormsStmt stmt = stmt
-
-convertOpFormsMatch (MatchGroup ms ty)
-  = MatchGroup (map (fmap convert) ms) ty
- where convert (Match pat mty grhss)
-	  = Match pat mty (convertOpFormsGRHSs grhss)
-
-convertOpFormsGRHSs (GRHSs grhss binds)
-  = GRHSs (map convertOpFormsGRHS grhss) binds
-
-convertOpFormsGRHS = fmap convert
- where 
-   convert (GRHS stmts cmd) = GRHS stmts (convertOpFormsLCmd cmd)
-
----------------------------------------------------
-type CmdNeeds = FreeVars	-- Only inhabitants are 
-				-- 	appAName, choiceAName, loopAName
-
--- find what methods the Cmd needs (loop, choice, apply)
-methodNamesLCmd :: LHsCmd Name -> CmdNeeds
-methodNamesLCmd = methodNamesCmd . unLoc
-
-methodNamesCmd :: HsCmd Name -> CmdNeeds
-
-methodNamesCmd cmd@(HsArrApp _arrow _arg _ HsFirstOrderApp _rtl)
-  = emptyFVs
-methodNamesCmd cmd@(HsArrApp _arrow _arg _ HsHigherOrderApp _rtl)
-  = unitFV appAName
-methodNamesCmd cmd@(HsArrForm {}) = emptyFVs
-
-methodNamesCmd (HsPar c) = methodNamesLCmd c
-
-methodNamesCmd (HsIf p c1 c2)
-  = methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
-
-methodNamesCmd (HsLet b c) = methodNamesLCmd c
-
-methodNamesCmd (HsDo sc stmts body ty) 
-  = methodNamesStmts stmts `plusFV` methodNamesLCmd body
-
-methodNamesCmd (HsApp c e) = methodNamesLCmd c
-
-methodNamesCmd (HsLam match) = methodNamesMatch match
-
-methodNamesCmd (HsCase scrut matches)
-  = methodNamesMatch matches `addOneFV` choiceAName
-
-methodNamesCmd other = emptyFVs
-   -- Other forms can't occur in commands, but it's not convenient 
-   -- to error here so we just do what's convenient.
-   -- The type checker will complain later
-
----------------------------------------------------
-methodNamesMatch (MatchGroup ms ty)
-  = plusFVs (map do_one ms)
- where 
-    do_one (L _ (Match pats sig_ty grhss)) = methodNamesGRHSs grhss
-
--------------------------------------------------
--- gaw 2004
-methodNamesGRHSs (GRHSs grhss binds) = plusFVs (map methodNamesGRHS grhss)
-
--------------------------------------------------
-methodNamesGRHS (L _ (GRHS stmts rhs)) = methodNamesLCmd rhs
-
----------------------------------------------------
-methodNamesStmts stmts = plusFVs (map methodNamesLStmt stmts)
-
----------------------------------------------------
-methodNamesLStmt = methodNamesStmt . unLoc
-
-methodNamesStmt (ExprStmt cmd _ _)     = methodNamesLCmd cmd
-methodNamesStmt (BindStmt pat cmd _ _) = methodNamesLCmd cmd
-methodNamesStmt (RecStmt stmts _ _ _ _)
-  = methodNamesStmts stmts `addOneFV` loopAName
-methodNamesStmt (LetStmt b)  = emptyFVs
-methodNamesStmt (ParStmt ss) = emptyFVs
-   -- ParStmt can't occur in commands, but it's not convenient to error 
-   -- here so we just do what's convenient
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Arithmetic sequences
-%*									*
-%************************************************************************
-
-\begin{code}
-rnArithSeq (From expr)
- = rnLExpr expr 	`thenM` \ (expr', fvExpr) ->
-   returnM (From expr', fvExpr)
-
-rnArithSeq (FromThen expr1 expr2)
- = rnLExpr expr1 	`thenM` \ (expr1', fvExpr1) ->
-   rnLExpr expr2	`thenM` \ (expr2', fvExpr2) ->
-   returnM (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
-
-rnArithSeq (FromTo expr1 expr2)
- = rnLExpr expr1	`thenM` \ (expr1', fvExpr1) ->
-   rnLExpr expr2	`thenM` \ (expr2', fvExpr2) ->
-   returnM (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
-
-rnArithSeq (FromThenTo expr1 expr2 expr3)
- = rnLExpr expr1	`thenM` \ (expr1', fvExpr1) ->
-   rnLExpr expr2	`thenM` \ (expr2', fvExpr2) ->
-   rnLExpr expr3	`thenM` \ (expr3', fvExpr3) ->
-   returnM (FromThenTo expr1' expr2' expr3',
-	    plusFVs [fvExpr1, fvExpr2, fvExpr3])
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
-%*									*
-%************************************************************************
-
-\begin{code}
-rnRbinds str rbinds 
-  = mappM_ field_dup_err dup_fields	`thenM_`
-    mapFvRn rn_rbind rbinds		`thenM` \ (rbinds', fvRbind) ->
-    returnM (rbinds', fvRbind)
-  where
-    (_, dup_fields) = removeDups cmpLocated [ f | (f,_) <- rbinds ]
-
-    field_dup_err dups = mappM_ (\f -> addLocErr f (dupFieldErr str)) dups
-
-    rn_rbind (field, expr)
-      = lookupLocatedGlobalOccRn field	`thenM` \ fieldname ->
-	rnLExpr expr			`thenM` \ (expr', fvExpr) ->
-	returnM ((fieldname, expr'), fvExpr `addOneFV` unLoc fieldname)
-\end{code}
-
-%************************************************************************
-%*									*
-	Template Haskell brackets
-%*									*
-%************************************************************************
-
-\begin{code}
-rnBracket (VarBr n) = do { name <- lookupOccRn n
-			 ; this_mod <- getModule
-			 ; checkM (nameIsLocalOrFrom this_mod name) $	-- Reason: deprecation checking asumes the
-			   do { loadHomeInterface msg name		-- home interface is loaded, and this is the
-			      ; return () }				-- only way that is going to happen
-			 ; returnM (VarBr name, unitFV name) }
-		    where
-		      msg = ptext SLIT("Need interface for Template Haskell quoted Name")
-
-rnBracket (ExpBr e) = do { (e', fvs) <- rnLExpr e
-			 ; return (ExpBr e', fvs) }
-rnBracket (PatBr p) = do { (p', fvs) <- rnLPat p
-			 ; return (PatBr p', fvs) }
-rnBracket (TypBr t) = do { (t', fvs) <- rnHsTypeFVs doc t
-			 ; return (TypBr t', fvs) }
-		    where
-		      doc = ptext SLIT("In a Template-Haskell quoted type")
-rnBracket (DecBr group) 
-  = do 	{ gbl_env  <- getGblEnv
-
-	; let gbl_env1 = gbl_env { tcg_mod = thFAKE }
-	-- Note the thFAKE.  The top-level names from the bracketed 
-	-- declarations will go into the name cache, and we don't want them to 
-	-- confuse the Names for the current module.  
-	-- By using a pretend module, thFAKE, we keep them safely out of the way.
-
-	; names    <- getLocalDeclBinders gbl_env1 group
-	; rdr_env' <- extendRdrEnvRn emptyGlobalRdrEnv names
-	-- Furthermore, the names in the bracket shouldn't conflict with
-	-- existing top-level names E.g.
-	--	foo = 1
-	--	bar = [d| foo = 1|]
-	-- But both 'foo's get a LocalDef provenance, so we'd get a complaint unless
-	-- we start with an emptyGlobalRdrEnv
-
-	; setGblEnv (gbl_env { tcg_rdr_env = tcg_rdr_env gbl_env1 `plusOccEnv` rdr_env',
-			       tcg_dus = emptyDUs }) $ do
-		-- Notice plusOccEnv, not plusGlobalRdrEnv.  In this situation we want
-		-- to *shadow* top-level bindings.  (See the 'foo' example above.)
-		-- If we don't shadow, we'll get an ambiguity complaint when we do 
-		-- a lookupTopBndrRn (which uses lookupGreLocalRn) on the binder of the 'foo'
-		--
-		-- Furthermore, arguably if the splice does define foo, that should hide
-		-- any foo's further out
-		--
-		-- The emptyDUs is so that we just collect uses for this group alone
-
-	{ (tcg_env, group') <- rnSrcDecls group
-		-- Discard the tcg_env; it contains only extra info about fixity
-	; return (DecBr group', allUses (tcg_dus tcg_env)) } }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{@Stmt@s: in @do@ expressions}
-%*									*
-%************************************************************************
-
-\begin{code}
-rnStmts :: HsStmtContext Name -> [LStmt RdrName] 
-	-> RnM (thing, FreeVars)
-	-> RnM (([LStmt Name], thing), FreeVars)
-
-rnStmts (MDoExpr _) = rnMDoStmts
-rnStmts ctxt        = rnNormalStmts ctxt
-
-rnNormalStmts :: HsStmtContext Name -> [LStmt RdrName]
-	      -> RnM (thing, FreeVars)
-	      -> RnM (([LStmt Name], thing), FreeVars)	
--- Used for cases *other* than recursive mdo
--- Implements nested scopes
-
-rnNormalStmts ctxt [] thing_inside 
-  = do	{ (thing, fvs) <- thing_inside
-	; return (([],thing), fvs) } 
-
-rnNormalStmts ctxt (L loc stmt : stmts) thing_inside
-  = do	{ ((stmt', (stmts', thing)), fvs) 
-		<- rnStmt ctxt stmt 	$
-		   rnNormalStmts ctxt stmts thing_inside
-	; return (((L loc stmt' : stmts'), thing), fvs) }
-    
-rnStmt :: HsStmtContext Name -> Stmt RdrName
-       -> RnM (thing, FreeVars)
-       -> RnM ((Stmt Name, thing), FreeVars)
-
-rnStmt ctxt (ExprStmt expr _ _) thing_inside
-  = do	{ (expr', fv_expr) <- rnLExpr expr
-	; (then_op, fvs1)  <- lookupSyntaxName thenMName
-	; (thing, fvs2)    <- thing_inside
-	; return ((ExprStmt expr' then_op placeHolderType, thing),
-		  fv_expr `plusFV` fvs1 `plusFV` fvs2) }
-
-rnStmt ctxt (BindStmt pat expr _ _) thing_inside
-  = do	{ (expr', fv_expr) <- rnLExpr expr
-		-- The binders do not scope over the expression
-	; (bind_op, fvs1) <- lookupSyntaxName bindMName
-	; (fail_op, fvs2) <- lookupSyntaxName failMName
-	; rnPatsAndThen (StmtCtxt ctxt) [pat] $ \ [pat'] -> do
-	{ (thing, fvs3) <- thing_inside
-	; return ((BindStmt pat' expr' bind_op fail_op, thing),
-		  fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }}
-	-- fv_expr shouldn't really be filtered by the rnPatsAndThen
-	-- but it does not matter because the names are unique
-
-rnStmt ctxt (LetStmt binds) thing_inside
-  = do	{ checkErr (ok ctxt binds) 
-		   (badIpBinds (ptext SLIT("a parallel list comprehension:")) binds)
-	; rnLocalBindsAndThen binds		$ \ binds' -> do
-	{ (thing, fvs) <- thing_inside
-	; return ((LetStmt binds', thing), fvs) }}
-  where
-	-- We do not allow implicit-parameter bindings in a parallel
-	-- list comprehension.  I'm not sure what it might mean.
-    ok (ParStmtCtxt _) (HsIPBinds _) = False
-    ok _	       _	     = True
-
-rnStmt ctxt (RecStmt rec_stmts _ _ _ _) thing_inside
-  = bindLocatedLocalsRn doc (collectLStmtsBinders rec_stmts)	$ \ bndrs ->
-    rn_rec_stmts bndrs rec_stmts	`thenM` \ segs ->
-    thing_inside 			`thenM` \ (thing, fvs) ->
-    let
-	segs_w_fwd_refs     	 = addFwdRefs segs
-	(ds, us, fs, rec_stmts') = unzip4 segs_w_fwd_refs
-	later_vars = nameSetToList (plusFVs ds `intersectNameSet` fvs)
-	fwd_vars   = nameSetToList (plusFVs fs)
-	uses	   = plusFVs us
-	rec_stmt   = RecStmt rec_stmts' later_vars fwd_vars [] emptyLHsBinds
-    in	
-    returnM ((rec_stmt, thing), uses `plusFV` fvs)
-  where
-    doc = text "In a recursive do statement"
-
-rnStmt ctxt (ParStmt segs) thing_inside
-  = do	{ opt_GlasgowExts <- doptM Opt_GlasgowExts
-	; checkM opt_GlasgowExts parStmtErr
- 	; orig_lcl_env <- getLocalRdrEnv
-	; ((segs',thing), fvs) <- go orig_lcl_env [] segs
-	; return ((ParStmt segs', thing), fvs) }
-  where
---  type ParSeg id = [([LStmt id], [id])]
---  go :: NameSet -> [ParSeg RdrName]
---       -> RnM (([ParSeg Name], thing), FreeVars)
-
-    go orig_lcl_env bndrs [] 
-	= do { let { (bndrs', dups) = removeDups cmpByOcc bndrs
-		   ; inner_env = extendLocalRdrEnv orig_lcl_env bndrs' }
-	     ; mappM dupErr dups
-	     ; (thing, fvs) <- setLocalRdrEnv inner_env thing_inside
-	     ; return (([], thing), fvs) }
-
-    go orig_lcl_env bndrs_so_far ((stmts, _) : segs)
-	= do { ((stmts', (bndrs, segs', thing)), fvs)
-		  <- rnNormalStmts par_ctxt stmts $ do
-		     { 	-- Find the Names that are bound by stmts
-		       lcl_env <- getLocalRdrEnv
-		     ; let { rdr_bndrs = collectLStmtsBinders stmts
-		     	   ; bndrs = map ( expectJust "rnStmt"
-		     		         . lookupLocalRdrEnv lcl_env
-		     		         . unLoc) rdr_bndrs
-		           ; new_bndrs = nub bndrs ++ bndrs_so_far 
-				-- The nub is because there might be shadowing
-				--	x <- e1; x <- e2
-				-- So we'll look up (Unqual x) twice, getting
-				-- the second binding both times, which is the
-			}	-- one we want
-
-			-- Typecheck the thing inside, passing on all
-			-- the Names bound, but separately; revert the envt
-		     ; ((segs', thing), fvs) <- setLocalRdrEnv orig_lcl_env $
-						go orig_lcl_env new_bndrs segs
-
-			-- Figure out which of the bound names are used
-		     ; let used_bndrs = filter (`elemNameSet` fvs) bndrs
-		     ; return ((used_bndrs, segs', thing), fvs) }
-
-	     ; let seg' = (stmts', bndrs)
-	     ; return (((seg':segs'), thing), 
-		       delListFromNameSet fvs bndrs) }
-
-    par_ctxt = ParStmtCtxt ctxt
-
-    cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
-    dupErr vs = addErr (ptext SLIT("Duplicate binding in parallel list comprehension for:")
-		        <+> quotes (ppr (head vs)))
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{mdo expressions}
-%*									*
-%************************************************************************
-
-\begin{code}
-type FwdRefs = NameSet
-type Segment stmts = (Defs,
-		      Uses, 	-- May include defs
-		      FwdRefs,	-- A subset of uses that are 
-				--   (a) used before they are bound in this segment, or 
-				--   (b) used here, and bound in subsequent segments
-		      stmts)	-- Either Stmt or [Stmt]
-
-
-----------------------------------------------------
-rnMDoStmts :: [LStmt RdrName]
-	   -> RnM (thing, FreeVars)
-	   -> RnM (([LStmt Name], thing), FreeVars)	
-rnMDoStmts stmts thing_inside
-  = 	-- Step1: bring all the binders of the mdo into scope
-	-- Remember that this also removes the binders from the
-	-- finally-returned free-vars
-    bindLocatedLocalsRn doc (collectLStmtsBinders stmts)	$ \ bndrs ->
-    do	{ 
-	-- Step 2: Rename each individual stmt, making a
-	--	   singleton segment.  At this stage the FwdRefs field
-	--	   isn't finished: it's empty for all except a BindStmt
-	--	   for which it's the fwd refs within the bind itself
-	-- 	   (This set may not be empty, because we're in a recursive 
-	--	    context.)
-	  segs <- rn_rec_stmts bndrs stmts
-
-	; (thing, fvs_later) <- thing_inside
-
-	; let
-	-- Step 3: Fill in the fwd refs.
-	-- 	   The segments are all singletons, but their fwd-ref
-	--	   field mentions all the things used by the segment
-	--	   that are bound after their use
-	    segs_w_fwd_refs = addFwdRefs segs
-
-	-- Step 4: Group together the segments to make bigger segments
-	--	   Invariant: in the result, no segment uses a variable
-	--	   	      bound in a later segment
-	    grouped_segs = glomSegments segs_w_fwd_refs
-
-	-- Step 5: Turn the segments into Stmts
-	--	   Use RecStmt when and only when there are fwd refs
-	--	   Also gather up the uses from the end towards the
-	--	   start, so we can tell the RecStmt which things are
-	--	   used 'after' the RecStmt
-	    (stmts', fvs) = segsToStmts grouped_segs fvs_later
-
-	; return ((stmts', thing), fvs) }
-  where
-    doc = text "In a recursive mdo-expression"
-
----------------------------------------------
-rn_rec_stmts :: [Name] -> [LStmt RdrName] -> RnM [Segment (LStmt Name)]
-rn_rec_stmts bndrs stmts = mappM (rn_rec_stmt bndrs) stmts	`thenM` \ segs_s ->
-		   	   returnM (concat segs_s)
-
-----------------------------------------------------
-rn_rec_stmt :: [Name] -> LStmt RdrName -> RnM [Segment (LStmt Name)]
-	-- Rename a Stmt that is inside a RecStmt (or mdo)
-	-- Assumes all binders are already in scope
-	-- Turns each stmt into a singleton Stmt
-
-rn_rec_stmt all_bndrs (L loc (ExprStmt expr _ _))
-  = rnLExpr expr 		`thenM` \ (expr', fvs) ->
-    lookupSyntaxName thenMName	`thenM` \ (then_op, fvs1) ->
-    returnM [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
-	      L loc (ExprStmt expr' then_op placeHolderType))]
-
-rn_rec_stmt all_bndrs (L loc (BindStmt pat expr _ _))
-  = rnLExpr expr		`thenM` \ (expr', fv_expr) ->
-    rnLPat pat			`thenM` \ (pat', fv_pat) ->
-    lookupSyntaxName bindMName	`thenM` \ (bind_op, fvs1) ->
-    lookupSyntaxName failMName	`thenM` \ (fail_op, fvs2) ->
-    let
-	bndrs = mkNameSet (collectPatBinders pat')
-	fvs   = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
-    in
-    returnM [(bndrs, fvs, bndrs `intersectNameSet` fvs,
-	      L loc (BindStmt pat' expr' bind_op fail_op))]
-
-rn_rec_stmt all_bndrs (L loc (LetStmt binds@(HsIPBinds _)))
-  = do	{ addErr (badIpBinds (ptext SLIT("an mdo expression")) binds)
-	; failM }
-
-rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds)))
-  = rnValBinds (trimWith all_bndrs) binds	`thenM` \ (binds', du_binds) ->
-    returnM [(duDefs du_binds, duUses du_binds, 
-	      emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
-
-rn_rec_stmt all_bndrs (L loc (RecStmt stmts _ _ _ _))	-- Flatten Rec inside Rec
-  = rn_rec_stmts all_bndrs stmts
-
-rn_rec_stmt all_bndrs stmt@(L _ (ParStmt _))	-- Syntactically illegal in mdo
-  = pprPanic "rn_rec_stmt" (ppr stmt)
-
----------------------------------------------
-addFwdRefs :: [Segment a] -> [Segment a]
--- So far the segments only have forward refs *within* the Stmt
--- 	(which happens for bind:  x <- ...x...)
--- This function adds the cross-seg fwd ref info
-
-addFwdRefs pairs 
-  = fst (foldr mk_seg ([], emptyNameSet) pairs)
-  where
-    mk_seg (defs, uses, fwds, stmts) (segs, later_defs)
-	= (new_seg : segs, all_defs)
-	where
-	  new_seg = (defs, uses, new_fwds, stmts)
-	  all_defs = later_defs `unionNameSets` defs
-	  new_fwds = fwds `unionNameSets` (uses `intersectNameSet` later_defs)
-		-- Add the downstream fwd refs here
-
-----------------------------------------------------
--- 	Glomming the singleton segments of an mdo into 
---	minimal recursive groups.
---
--- At first I thought this was just strongly connected components, but
--- there's an important constraint: the order of the stmts must not change.
---
--- Consider
---	mdo { x <- ...y...
---	      p <- z
---	      y <- ...x...
---	      q <- x
---	      z <- y
---	      r <- x }
---
--- Here, the first stmt mention 'y', which is bound in the third.  
--- But that means that the innocent second stmt (p <- z) gets caught
--- up in the recursion.  And that in turn means that the binding for
--- 'z' has to be included... and so on.
---
--- Start at the tail { r <- x }
--- Now add the next one { z <- y ; r <- x }
--- Now add one more     { q <- x ; z <- y ; r <- x }
--- Now one more... but this time we have to group a bunch into rec
---	{ rec { y <- ...x... ; q <- x ; z <- y } ; r <- x }
--- Now one more, which we can add on without a rec
---	{ p <- z ; 
---	  rec { y <- ...x... ; q <- x ; z <- y } ; 
--- 	  r <- x }
--- Finally we add the last one; since it mentions y we have to
--- glom it togeher with the first two groups
---	{ rec { x <- ...y...; p <- z ; y <- ...x... ; 
---		q <- x ; z <- y } ; 
--- 	  r <- x }
-
-glomSegments :: [Segment (LStmt Name)] -> [Segment [LStmt Name]]
-
-glomSegments [] = []
-glomSegments ((defs,uses,fwds,stmt) : segs)
-	-- Actually stmts will always be a singleton
-  = (seg_defs, seg_uses, seg_fwds, seg_stmts)  : others
-  where
-    segs'	     = glomSegments segs
-    (extras, others) = grab uses segs'
-    (ds, us, fs, ss) = unzip4 extras
-    
-    seg_defs  = plusFVs ds `plusFV` defs
-    seg_uses  = plusFVs us `plusFV` uses
-    seg_fwds  = plusFVs fs `plusFV` fwds
-    seg_stmts = stmt : concat ss
-
-    grab :: NameSet	 	-- The client
-	 -> [Segment a]
-	 -> ([Segment a],	-- Needed by the 'client'
-	     [Segment a])	-- Not needed by the client
-	-- The result is simply a split of the input
-    grab uses dus 
-	= (reverse yeses, reverse noes)
-	where
-	  (noes, yeses) 	  = span not_needed (reverse dus)
-	  not_needed (defs,_,_,_) = not (intersectsNameSet defs uses)
-
-
-----------------------------------------------------
-segsToStmts :: [Segment [LStmt Name]] 
-	    -> FreeVars			-- Free vars used 'later'
-	    -> ([LStmt Name], FreeVars)
-
-segsToStmts [] fvs_later = ([], fvs_later)
-segsToStmts ((defs, uses, fwds, ss) : segs) fvs_later
-  = ASSERT( not (null ss) )
-    (new_stmt : later_stmts, later_uses `plusFV` uses)
-  where
-    (later_stmts, later_uses) = segsToStmts segs fvs_later
-    new_stmt | non_rec	 = head ss
-	     | otherwise = L (getLoc (head ss)) $ 
-			   RecStmt ss (nameSetToList used_later) (nameSetToList fwds) 
-				      [] emptyLHsBinds
-	     where
-	       non_rec    = isSingleton ss && isEmptyNameSet fwds
-	       used_later = defs `intersectNameSet` later_uses
-				-- The ones needed after the RecStmt
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{breakpoint utils}
-%*									*
-%************************************************************************
-
-\begin{code}
-#if defined(GHCI) && defined(BREAKPOINT)
-mkBreakPointExpr :: [Name] -> RnM (HsExpr Name, FreeVars)
-mkBreakPointExpr scope
-    = do sloc <- getSrcSpanM
-         undef <- lookupOccRn undefined_RDR
-         let inLoc = L sloc
-             lHsApp x y = inLoc (HsApp x y)
-             mkExpr fnName args = mkExpr' fnName (reverse args)
-             mkExpr' fnName [] = inLoc (HsVar fnName)
-             mkExpr' fnName (arg:args)
-                 = lHsApp (mkExpr' fnName args) (inLoc arg)
-             expr = unLoc $ mkExpr breakpointJumpName [mkScopeArg scope, HsVar undef, HsLit msg]
-             mkScopeArg args
-                 = unLoc $ mkExpr undef (map HsVar args)
-             msg = HsString (mkFastString (unpackFS (srcSpanFile sloc) ++ ":" ++ show (srcSpanStartLine sloc)))
-         return (expr, emptyFVs)
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{Assertion utils}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkAssertErrorExpr :: RnM (HsExpr Name, FreeVars)
--- Return an expression for (assertError "Foo.hs:27")
-mkAssertErrorExpr
-  = getSrcSpanM    			`thenM` \ sloc ->
-    let
-	expr = HsApp (L sloc (HsVar assertErrorName)) (L sloc (HsLit msg))
-	msg  = HsStringPrim (mkFastString (showSDoc (ppr sloc)))
-    in
-    returnM (expr, emptyFVs)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{Errors}
-%*									*
-%************************************************************************
-
-\begin{code}
-patSynErr e = do { addErr (sep [ptext SLIT("Pattern syntax in expression context:"),
-			 	nest 4 (ppr e)])
-		 ; return (EWildPat, emptyFVs) }
-
-parStmtErr = addErr (ptext SLIT("Illegal parallel list comprehension: use -fglasgow-exts"))
-
-badIpBinds what binds
-  = hang (ptext SLIT("Implicit-parameter bindings illegal in") <+> what)
-	 2 (ppr binds)
-\end{code}
diff --git a/ghc/compiler/rename/RnExpr.lhs-boot b/ghc/compiler/rename/RnExpr.lhs-boot
deleted file mode 100644
index b03f50a890..0000000000
--- a/ghc/compiler/rename/RnExpr.lhs-boot
+++ /dev/null
@@ -1,17 +0,0 @@
-\begin{code}

-module RnExpr where

-import HsSyn

-import Name	( Name )

-import NameSet	( FreeVars )

-import RdrName	( RdrName )

-import TcRnTypes

-

-rnLExpr :: LHsExpr RdrName

-	-> RnM (LHsExpr Name, FreeVars)

-

-rnStmts :: forall thing.

-	   HsStmtContext Name -> [LStmt RdrName] 

-	-> RnM (thing, FreeVars)

-	-> RnM (([LStmt Name], thing), FreeVars)

-\end{code}

-

diff --git a/ghc/compiler/rename/RnHsSyn.lhs b/ghc/compiler/rename/RnHsSyn.lhs
deleted file mode 100644
index 6752218b29..0000000000
--- a/ghc/compiler/rename/RnHsSyn.lhs
+++ /dev/null
@@ -1,156 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1996-1998
-%
-\section[RnHsSyn]{Specialisations of the @HsSyn@ syntax for the renamer}
-
-\begin{code}
-module RnHsSyn( 
-	-- Names
-	charTyCon_name, listTyCon_name, parrTyCon_name, tupleTyCon_name,
-	extractHsTyVars, extractHsTyNames, extractHsTyNames_s, 
-	extractFunDepNames, extractHsCtxtTyNames, extractHsPredTyNames,
-
-	-- Free variables
-	hsSigsFVs, hsSigFVs, conDeclFVs, bangTyFVs,
-	
-	maybeGenericMatch
-  ) where
-
-#include "HsVersions.h"
-
-import HsSyn
-import Class		( FunDep )
-import TysWiredIn	( tupleTyCon, listTyCon, parrTyCon, charTyCon )
-import Name		( Name, getName, isTyVarName )
-import NameSet
-import BasicTypes	( Boxity )
-import SrcLoc		( Located(..), unLoc )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Free variables}
-%*									*
-%************************************************************************
-
-These free-variable finders returns tycons and classes too.
-
-\begin{code}
-charTyCon_name, listTyCon_name, parrTyCon_name :: Name
-charTyCon_name    = getName charTyCon
-listTyCon_name    = getName listTyCon
-parrTyCon_name    = getName parrTyCon
-
-tupleTyCon_name :: Boxity -> Int -> Name
-tupleTyCon_name boxity n = getName (tupleTyCon boxity n)
-
-extractHsTyVars :: LHsType Name -> NameSet
-extractHsTyVars x = filterNameSet isTyVarName (extractHsTyNames x)
-
-extractFunDepNames :: FunDep Name -> NameSet
-extractFunDepNames (ns1, ns2) = mkNameSet ns1 `unionNameSets` mkNameSet ns2
-
-extractHsTyNames   :: LHsType Name -> NameSet
-extractHsTyNames ty
-  = getl ty
-  where
-    getl (L _ ty) = get ty
-
-    get (HsAppTy ty1 ty2)      = getl ty1 `unionNameSets` getl ty2
-    get (HsListTy ty)          = unitNameSet listTyCon_name `unionNameSets` getl ty
-    get (HsPArrTy ty)          = unitNameSet parrTyCon_name `unionNameSets` getl ty
-    get (HsTupleTy con tys)    = extractHsTyNames_s tys
-    get (HsFunTy ty1 ty2)      = getl ty1 `unionNameSets` getl ty2
-    get (HsPredTy p)	       = extractHsPredTyNames p
-    get (HsOpTy ty1 op ty2)    = getl ty1 `unionNameSets` getl ty2 `unionNameSets` unitNameSet (unLoc op)
-    get (HsParTy ty)           = getl ty
-    get (HsBangTy _ ty)        = getl ty
-    get (HsNumTy n)            = emptyNameSet
-    get (HsTyVar tv)	       = unitNameSet tv
-    get (HsSpliceTy _)         = emptyNameSet	-- Type splices mention no type variables
-    get (HsKindSig ty k)       = getl ty
-    get (HsForAllTy _ tvs 
-		    ctxt ty)   = (extractHsCtxtTyNames ctxt
-					 `unionNameSets` getl ty)
-					    `minusNameSet`
-				  mkNameSet (hsLTyVarNames tvs)
-
-extractHsTyNames_s  :: [LHsType Name] -> NameSet
-extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys
-
-extractHsCtxtTyNames :: LHsContext Name -> NameSet
-extractHsCtxtTyNames (L _ ctxt)
-  = foldr (unionNameSets . extractHsPredTyNames . unLoc) emptyNameSet ctxt
-
--- You don't import or export implicit parameters,
--- so don't mention the IP names
-extractHsPredTyNames (HsClassP cls tys)
-  = unitNameSet cls `unionNameSets` extractHsTyNames_s tys
-extractHsPredTyNames (HsIParam n ty)
-  = extractHsTyNames ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Free variables of declarations}
-%*									*
-%************************************************************************
-
-Return the Names that must be in scope if we are to use this declaration.
-In all cases this is set up for interface-file declarations:
-	- for class decls we ignore the bindings
-	- for instance decls likewise, plus the pragmas
-	- for rule decls, we ignore HsRules
-        - for data decls, we ignore derivings
-
-	*** See "THE NAMING STORY" in HsDecls ****
-
-\begin{code}
-----------------
-hsSigsFVs :: [LSig Name] -> FreeVars
-hsSigsFVs sigs = plusFVs (map (hsSigFVs.unLoc) sigs)
-
-hsSigFVs (TypeSig v ty)     = extractHsTyNames ty
-hsSigFVs (SpecInstSig ty)   = extractHsTyNames ty
-hsSigFVs (SpecSig v ty inl) = extractHsTyNames ty
-hsSigFVs other		    = emptyFVs
-
-----------------
-conDeclFVs (L _ (ConDecl { con_qvars = tyvars, con_cxt = context, 
-			   con_details = details, con_res = res_ty}))
-  = delFVs (map hsLTyVarName tyvars) $
-    extractHsCtxtTyNames context  `plusFV`
-    conDetailsFVs details	  `plusFV`
-    conResTyFVs res_ty
-
-conResTyFVs ResTyH98       = emptyFVs
-conResTyFVs (ResTyGADT ty) = extractHsTyNames ty
-
-conDetailsFVs (PrefixCon btys)     = plusFVs (map bangTyFVs btys)
-conDetailsFVs (InfixCon bty1 bty2) = bangTyFVs bty1 `plusFV` bangTyFVs bty2
-conDetailsFVs (RecCon flds)	   = plusFVs [bangTyFVs bty | (_, bty) <- flds]
-
-bangTyFVs bty = extractHsTyNames (getBangType bty)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{A few functions on generic defintions
-%*									*
-%************************************************************************
-
-These functions on generics are defined over Matches Name, which is
-why they are here and not in HsMatches.
-
-\begin{code}
-maybeGenericMatch :: LMatch Name -> Maybe (HsType Name, LMatch Name)
-  -- Tells whether a Match is for a generic definition
-  -- and extract the type from a generic match and put it at the front
-
-maybeGenericMatch (L loc (Match (L _ (TypePat (L _ ty)) : pats) sig_ty grhss))
-  = Just (ty, L loc (Match pats sig_ty grhss))
-
-maybeGenericMatch other_match = Nothing
-\end{code}
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
deleted file mode 100644
index 654c101cd5..0000000000
--- a/ghc/compiler/rename/RnNames.lhs
+++ /dev/null
@@ -1,1138 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[RnNames]{Extracting imported and top-level names in scope}
-
-\begin{code}
-module RnNames (
-	rnImports, mkRdrEnvAndImports, importsFromLocalDecls,
-	rnExports, mkExportNameSet,
-	getLocalDeclBinders, extendRdrEnvRn,
-	reportUnusedNames, reportDeprecations
-    ) where
-
-#include "HsVersions.h"
-
-import DynFlags		( DynFlag(..), GhcMode(..) )
-import HsSyn		( IE(..), ieName, ImportDecl(..), LImportDecl,
-			  ForeignDecl(..), HsGroup(..), HsValBinds(..),
-			  Sig(..), collectHsBindLocatedBinders, tyClDeclNames,
-			  LIE )
-import RnEnv
-import IfaceEnv		( ifaceExportNames )
-import LoadIface	( loadSrcInterface )
-import TcRnMonad hiding (LIE)
-
-import FiniteMap
-import PrelNames	( pRELUDE, isUnboundName, main_RDR_Unqual )
-import Module		( Module, moduleString, unitModuleEnv, 
-			  lookupModuleEnv, moduleEnvElts, foldModuleEnv )
-import Name		( Name, nameSrcLoc, nameOccName, nameModule, isWiredInName,
-			  nameParent, nameParent_maybe, isExternalName,
-			  isBuiltInSyntax )
-import NameSet
-import NameEnv
-import OccName		( srcDataName, isTcOcc, pprNonVarNameSpace,
-			  occNameSpace,
-			  OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
-			  extendOccEnv )
-import HscTypes		( GenAvailInfo(..), AvailInfo,
-			  HomePackageTable, PackageIfaceTable, 
-			  unQualInScope, 
-			  Deprecs(..), ModIface(..), Dependencies(..), 
-			  lookupIface, ExternalPackageState(..)
-			)
-import Packages		( PackageIdH(..) )
-import RdrName		( RdrName, rdrNameOcc, setRdrNameSpace, 
-		  	  GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..), 
-			  emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
-			  extendGlobalRdrEnv, lookupGlobalRdrEnv, unQualOK, lookupGRE_Name,
-			  Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), 
-			  importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance )
-import Outputable
-import Maybes		( isNothing, catMaybes, mapCatMaybes, seqMaybe, orElse )
-import SrcLoc		( Located(..), mkGeneralSrcSpan,
-			  unLoc, noLoc, srcLocSpan, SrcSpan )
-import BasicTypes	( DeprecTxt )
-import DriverPhases	( isHsBoot )
-import Util		( notNull )
-import List		( partition )
-import IO		( openFile, IOMode(..) )
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-		rnImports
-%*									*
-%************************************************************************
-
-\begin{code}
-rnImports :: [LImportDecl RdrName] -> RnM [LImportDecl Name]
-rnImports imports
-         -- PROCESS IMPORT DECLS
-         -- Do the non {- SOURCE -} ones first, so that we get a helpful
-         -- warning for {- SOURCE -} ones that are unnecessary
-    = do this_mod <- getModule
-         implicit_prelude <- doptM Opt_ImplicitPrelude
-         let all_imports	       = mk_prel_imports this_mod implicit_prelude ++ imports
-             (source, ordinary) = partition is_source_import all_imports
-             is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
-             get_imports = rnImportDecl this_mod
-
-         stuff1 <- mapM get_imports ordinary
-         stuff2 <- mapM get_imports source
-         return (stuff1 ++ stuff2)
-    where
--- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
--- because the former doesn't even look at Prelude.hi for instance 
--- declarations, whereas the latter does.
-   mk_prel_imports this_mod implicit_prelude
-       |  this_mod == pRELUDE
-          || explicit_prelude_import
-          || not implicit_prelude
-           = []
-       | otherwise = [preludeImportDecl]
-   explicit_prelude_import
-       = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- imports, 
-	           unLoc mod == pRELUDE ]
-
-preludeImportDecl :: LImportDecl RdrName
-preludeImportDecl
-  = L loc $
-	ImportDecl (L loc pRELUDE)
-	       False {- Not a boot interface -}
-	       False	{- Not qualified -}
-	       Nothing	{- No "as" -}
-	       Nothing	{- No import list -}
-  where
-    loc = mkGeneralSrcSpan FSLIT("Implicit import declaration")         
-
-mkRdrEnvAndImports :: [LImportDecl Name] -> RnM (GlobalRdrEnv, ImportAvails)
-mkRdrEnvAndImports imports
-  = do this_mod <- getModule
-       let get_imports = importsFromImportDecl this_mod
-       stuff <- mapM get_imports imports
-       let (imp_gbl_envs, imp_avails) = unzip stuff
-           gbl_env :: GlobalRdrEnv
-           gbl_env = foldr plusGlobalRdrEnv emptyGlobalRdrEnv imp_gbl_envs
-
-           all_avails :: ImportAvails
-           all_avails = foldr plusImportAvails emptyImportAvails imp_avails
-       -- ALL DONE
-       return (gbl_env, all_avails)
-
-\end{code}
-	
-\begin{code}
-rnImportDecl :: Module
-             -> LImportDecl RdrName
-             -> RnM (LImportDecl Name)
-rnImportDecl this_mod (L loc importDecl@(ImportDecl loc_imp_mod_name want_boot qual_only as_mod imp_details))
-    = setSrcSpan loc $
-      do iface <- loadSrcInterface doc imp_mod_name want_boot
-         let qual_mod_name = case as_mod of
-                               Nothing           -> imp_mod_name
-                               Just another_name -> another_name
-             imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,  
-                                       is_dloc = loc, is_as = qual_mod_name }
-         total_avails <- ifaceExportNames (mi_exports iface)
-         importDecl' <- rnImportDecl' iface imp_spec importDecl total_avails
-         return (L loc importDecl')
-    where imp_mod_name = unLoc loc_imp_mod_name
-          doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
-
-rnImportDecl' :: ModIface -> ImpDeclSpec -> ImportDecl RdrName -> NameSet -> RnM (ImportDecl Name)
-rnImportDecl' iface decl_spec (ImportDecl mod_name want_boot qual_only as_mod Nothing) all_names
-    = return $ ImportDecl mod_name want_boot qual_only as_mod Nothing
-rnImportDecl' iface decl_spec (ImportDecl mod_name want_boot qual_only as_mod (Just (want_hiding,import_items))) all_names
-    = do import_items_mbs <- mapM (srcSpanWrapper) import_items
-         let rn_import_items = concat . catMaybes $ import_items_mbs
-         return $ ImportDecl mod_name want_boot qual_only as_mod (Just (want_hiding,rn_import_items))
-    where
-    srcSpanWrapper (L span ieRdr)
-        = setSrcSpan span $
-          case get_item ieRdr of
-            Nothing
-                -> do addErr (badImportItemErr iface decl_spec ieRdr)
-                      return Nothing
-            Just ieNames
-                -> return (Just [L span ie | ie <- ieNames])
-    occ_env :: OccEnv Name	-- Maps OccName to corresponding Name
-    occ_env = mkOccEnv [(nameOccName n, n) | n <- nameSetToList all_names]
-	-- This env will have entries for data constructors too,
-	-- they won't make any difference because naked entities like T
-	-- in an import list map to TcOccs, not VarOccs.
-
-    sub_env :: NameEnv [Name]
-    sub_env = mkSubNameEnv all_names
-
-    get_item :: IE RdrName -> Maybe [IE Name]
-        -- Empty result for a bad item.
-	-- Singleton result is typical case.
-        -- Can have two when we are hiding, and mention C which might be
-	--	both a class and a data constructor.  
-    get_item item@(IEModuleContents _) 
-        = Nothing
-    get_item (IEThingAll tc)
-        = do name <- check_name tc
-             return [IEThingAll name]
-    get_item (IEThingAbs tc)
-        | want_hiding   -- hiding ( C )
-                        -- Here the 'C' can be a data constructor 
-                        --  *or* a type/class, or even both
-            = case catMaybes [check_name tc, check_name (setRdrNameSpace tc srcDataName)] of
-                []    -> Nothing
-                names -> return [ IEThingAbs n | n <- names ]
-        | otherwise
-            = do name <- check_name tc
-                 return [IEThingAbs name]
-    get_item (IEThingWith n ns) -- import (C (A,B))
-        = do name <- check_name n
-             let env = mkOccEnv [(nameOccName s, s) | s <- subNames sub_env name]
-                 mb_names = map (lookupOccEnv env . rdrNameOcc) ns
-             names <- sequence mb_names
-             return [IEThingWith name names]
-    get_item (IEVar n)
-        = do name <- check_name n
-             return [IEVar name]
-
-    check_name :: RdrName -> Maybe Name
-    check_name rdrName
-	= lookupOccEnv occ_env (rdrNameOcc rdrName)
-
-
-importsFromImportDecl :: Module
-		      -> LImportDecl Name
-		      -> RnM (GlobalRdrEnv, ImportAvails)
-
-importsFromImportDecl this_mod
-	(L loc (ImportDecl loc_imp_mod_name want_boot qual_only as_mod imp_details))
-  = 
-    setSrcSpan loc $
-
-	-- If there's an error in loadInterface, (e.g. interface
-	-- file not found) we get lots of spurious errors from 'filterImports'
-    let
-	imp_mod_name = unLoc loc_imp_mod_name
-	doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
-    in
-    loadSrcInterface doc imp_mod_name want_boot	`thenM` \ iface ->
-
-	-- Compiler sanity check: if the import didn't say
-	-- {-# SOURCE #-} we should not get a hi-boot file
-    WARN( not want_boot && mi_boot iface, ppr imp_mod_name )
-
-	-- Issue a user warning for a redundant {- SOURCE -} import
-	-- NB that we arrange to read all the ordinary imports before 
-	-- any of the {- SOURCE -} imports
-    warnIf (want_boot && not (mi_boot iface))
-	   (warnRedundantSourceImport imp_mod_name)	`thenM_`
-
-    let
-	imp_mod	= mi_module iface
-	deprecs	= mi_deprecs iface
-	is_orph	= mi_orphan iface 
-	deps 	= mi_deps iface
-
-	filtered_exports = filter not_this_mod (mi_exports iface)
-	not_this_mod (mod,_) = mod /= this_mod
-	-- If the module exports anything defined in this module, just ignore it.
-	-- Reason: otherwise it looks as if there are two local definition sites
-	-- for the thing, and an error gets reported.  Easiest thing is just to
-	-- filter them out up front. This situation only arises if a module
-	-- imports itself, or another module that imported it.  (Necessarily,
-	-- this invoves a loop.)  
-	--
-	-- Tiresome consequence: if you say
-	--	module A where
-	--	   import B( AType )
-	--	   type AType = ...
-	--
-	--	module B( AType ) where
-	--	   import {-# SOURCE #-} A( AType )
-	--
-	-- then you'll get a 'B does not export AType' message.  Oh well.
-
-	qual_mod_name = case as_mod of
-			  Nothing  	    -> imp_mod_name
-			  Just another_name -> another_name
-	imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,  
-		  		  is_dloc = loc, is_as = qual_mod_name }
-    in
-	-- Get the total imports, and filter them according to the import list
-    ifaceExportNames filtered_exports		`thenM` \ total_avails ->
-    filterImports iface imp_spec
-		  imp_details total_avails	`thenM` \ (avail_env, gbl_env) ->
-
-    getDOpts `thenM` \ dflags ->
-
-    let
-	-- Compute new transitive dependencies
-
- 	orphans | is_orph   = ASSERT( not (imp_mod_name `elem` dep_orphs deps) )
-			      imp_mod_name : dep_orphs deps
-		| otherwise = dep_orphs deps
-
-	(dependent_mods, dependent_pkgs) 
-	   = case mi_package iface of
-		HomePackage ->
-	    	-- Imported module is from the home package
-		-- Take its dependent modules and add imp_mod itself
-		-- Take its dependent packages unchanged
-		--
-		-- NB: (dep_mods deps) might include a hi-boot file
-		-- for the module being compiled, CM. Do *not* filter
-		-- this out (as we used to), because when we've
-		-- finished dealing with the direct imports we want to
-		-- know if any of them depended on CM.hi-boot, in
-		-- which case we should do the hi-boot consistency
-		-- check.  See LoadIface.loadHiBootInterface
-		  ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)
-
-		ExtPackage pkg ->
- 	   	-- Imported module is from another package
-		-- Dump the dependent modules
-		-- Add the package imp_mod comes from to the dependent packages
-	         ASSERT2( not (pkg `elem` dep_pkgs deps), ppr pkg <+> ppr (dep_pkgs deps) )
-	         ([], pkg : dep_pkgs deps)
-
-	-- True <=> import M ()
-	import_all = case imp_details of
-			Just (is_hiding, ls) -> not is_hiding && null ls	
-			other 		     -> False
-
-	-- unqual_avails is the Avails that are visible in *unqualified* form
-	-- We need to know this so we know what to export when we see
-	--	module M ( module P ) where ...
-	-- Then we must export whatever came from P unqualified.
-	imports   = ImportAvails { 
-			imp_env      = unitModuleEnv qual_mod_name avail_env,
-			imp_mods     = unitModuleEnv imp_mod (imp_mod, import_all, loc),
-			imp_orphs    = orphans,
-			imp_dep_mods = mkModDeps dependent_mods,
-			imp_dep_pkgs = dependent_pkgs }
-
-    in
-	-- Complain if we import a deprecated module
-    ifOptM Opt_WarnDeprecations	(
-       case deprecs of	
-	  DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt)
-	  other	        -> returnM ()
-    )							`thenM_`
-
-    returnM (gbl_env, imports)
-
-warnRedundantSourceImport mod_name
-  = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
-          <+> quotes (ppr mod_name)
-\end{code}
-
-
-%************************************************************************
-%*									*
-		importsFromLocalDecls
-%*									*
-%************************************************************************
-
-From the top-level declarations of this module produce
-  	* the lexical environment
-	* the ImportAvails
-created by its bindings.  
-	
-Complain about duplicate bindings
-
-\begin{code}
-importsFromLocalDecls :: HsGroup RdrName -> RnM TcGblEnv
-importsFromLocalDecls group
-  = do	{ gbl_env  <- getGblEnv
-
-	; names <- getLocalDeclBinders gbl_env group
-
-	; implicit_prelude <- doptM Opt_ImplicitPrelude
-	; let {
-	    -- Optimisation: filter out names for built-in syntax
-	    -- They just clutter up the environment (esp tuples), and the parser
-	    -- will generate Exact RdrNames for them, so the cluttered
-	    -- envt is no use.  To avoid doing this filter all the time,
-	    -- we use -fno-implicit-prelude as a clue that the filter is
-	    -- worth while.  Really, it's only useful for GHC.Base and GHC.Tuple.
-	    --
-	    -- It's worth doing because it makes the environment smaller for
-	    -- every module that imports the Prelude
-	    --
-	    -- Note: don't filter the gbl_env (hence all_names, not filered_all_names
-	    -- in defn of gres above).      Stupid reason: when parsing 
-	    -- data type decls, the constructors start as Exact tycon-names,
-	    -- and then get turned into data con names by zapping the name space;
-	    -- but that stops them being Exact, so they get looked up.  
-	    -- Ditto in fixity decls; e.g. 	infix 5 :
-	    -- Sigh. It doesn't matter because it only affects the Data.Tuple really.
-	    -- The important thing is to trim down the exports.
-	      filtered_names 
-	        | implicit_prelude = names
-	        | otherwise	   = filter (not . isBuiltInSyntax) names ;
-
-	    ; this_mod = tcg_mod gbl_env
-	    ; imports = emptyImportAvails {
-			  imp_env = unitModuleEnv this_mod $
-				    mkNameSet filtered_names
-		        }
-	    }
-
-	; rdr_env' <- extendRdrEnvRn (tcg_rdr_env gbl_env) names
-
-	; returnM (gbl_env { tcg_rdr_env = rdr_env',
-			     tcg_imports = imports `plusImportAvails` tcg_imports gbl_env }) 
-	}
-
-extendRdrEnvRn :: GlobalRdrEnv -> [Name] -> RnM GlobalRdrEnv
--- Add the new locally-bound names one by one, checking for duplicates as
--- we do so.  Remember that in Template Haskell the duplicates
--- might *already be* in the GlobalRdrEnv from higher up the module
-extendRdrEnvRn rdr_env names
-  = foldlM add_local rdr_env names
-  where
-    add_local rdr_env name
-	| gres <- lookupGlobalRdrEnv rdr_env (nameOccName name)
-	, (dup_gre:_) <- filter isLocalGRE gres	-- Check for existing *local* defns
-	= do { addDupDeclErr (gre_name dup_gre) name
-	     ; return rdr_env }
-	| otherwise
-	= return (extendGlobalRdrEnv rdr_env new_gre)
-	where
-	  new_gre = GRE {gre_name = name, gre_prov = LocalDef}
-\end{code}
-
-@getLocalDeclBinders@ returns the names for an @HsDecl@.  It's
-used for source code.
-
-	*** See "THE NAMING STORY" in HsDecls ****
-
-\begin{code}
-getLocalDeclBinders :: TcGblEnv -> HsGroup RdrName -> RnM [Name]
-getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs, 
-				      hs_tyclds = tycl_decls, 
-				      hs_fords = foreign_decls })
-  = do	{ tc_names_s <- mappM new_tc tycl_decls
-	; val_names  <- mappM new_simple val_bndrs
-	; return (foldr (++) val_names tc_names_s) }
-  where
-    mod        = tcg_mod gbl_env
-    is_hs_boot = isHsBoot (tcg_src gbl_env) ;
-    val_bndrs | is_hs_boot = sig_hs_bndrs
-	      | otherwise  = for_hs_bndrs ++ val_hs_bndrs
-	-- In a hs-boot file, the value binders come from the
-	--  *signatures*, and there should be no foreign binders 
-
-    new_simple rdr_name = newTopSrcBinder mod Nothing rdr_name
-
-    sig_hs_bndrs = [nm | L _ (TypeSig nm _) <- val_sigs]
-    val_hs_bndrs = collectHsBindLocatedBinders val_decls
-    for_hs_bndrs = [nm | L _ (ForeignImport nm _ _ _) <- foreign_decls]
-
-    new_tc tc_decl 
-	= do { main_name <- newTopSrcBinder mod Nothing main_rdr
-	     ; sub_names <- mappM (newTopSrcBinder mod (Just main_name)) sub_rdrs
-	     ; return (main_name : sub_names) }
-	where
-	  (main_rdr : sub_rdrs) = tyClDeclNames (unLoc tc_decl)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Filtering imports}
-%*									*
-%************************************************************************
-
-@filterImports@ takes the @ExportEnv@ telling what the imported module makes
-available, and filters it through the import spec (if any).
-
-\begin{code}
-filterImports :: ModIface
-	      -> ImpDeclSpec			-- The span for the entire import decl
-	      -> Maybe (Bool, [LIE Name])	-- Import spec; True => hiding
-	      -> NameSet			-- What's available
-	      -> RnM (NameSet,			-- What's imported (qualified or unqualified)
-		      GlobalRdrEnv)		-- Same again, but in GRE form
-
-	-- Complains if import spec mentions things that the module doesn't export
-        -- Warns/informs if import spec contains duplicates.
-			
-mkGenericRdrEnv decl_spec names
-  = mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = Imported [imp_spec] }
-		   | name <- nameSetToList names ]
-  where
-    imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
-
-filterImports iface decl_spec Nothing all_names
-  = return (all_names, mkGenericRdrEnv decl_spec all_names)
-
-filterImports iface decl_spec (Just (want_hiding, import_items)) all_names
-  = mapM (addLocM get_item) import_items >>= \gres_s ->
-    let gres = concat gres_s
-        specified_names = mkNameSet (map gre_name gres)
-    in if not want_hiding then
-       return (specified_names, mkGlobalRdrEnv gres)
-    else let keep n = not (n `elemNameSet` specified_names)
-             pruned_avails = filterNameSet keep all_names
-         in return (pruned_avails, mkGenericRdrEnv decl_spec pruned_avails)
-  where
-    sub_env :: NameEnv [Name]	-- Classify each name by its parent
-    sub_env = mkSubNameEnv all_names
-
-    succeed_with :: Bool -> [Name] -> RnM [GlobalRdrElt]
-    succeed_with all_explicit names
-      = do { loc <- getSrcSpanM
-	   ; returnM (map (mk_gre loc) names) }
-      where
-	mk_gre loc name = GRE { gre_name = name, 
-				gre_prov = Imported [imp_spec] }
-	  where
-	    imp_spec  = ImpSpec { is_decl = decl_spec, is_item = item_spec }
-	    item_spec = ImpSome { is_explicit = explicit, is_iloc = loc }
-	    explicit  = all_explicit || isNothing (nameParent_maybe name)
-
-    get_item :: IE Name -> RnM [GlobalRdrElt]
-	-- Empty result for a bad item.
-	-- Singleton result is typical case.
-	-- Can have two when we are hiding, and mention C which might be
-	--	both a class and a data constructor.  
-    get_item item@(IEModuleContents _) 
-        -- This case should be filtered out by 'rnImports'.
-        = panic "filterImports: IEModuleContents?" 
-
-    get_item (IEThingAll name)
-        = case subNames sub_env name of
-            [] ->       -- This occurs when you import T(..), but
-                        -- only export T abstractly.
-                  do ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn name))
-                     succeed_with False [name]
-            names -> succeed_with False (name:names)
-
-    get_item (IEThingAbs name)
-        = succeed_with True [name]
-
-    get_item (IEThingWith name names)
-        = succeed_with True (name:names)
-    get_item (IEVar name)
-        = succeed_with True [name]
-
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Export list processing}
-%*									*
-%************************************************************************
-
-Processing the export list.
-
-You might think that we should record things that appear in the export
-list as ``occurrences'' (using @addOccurrenceName@), but you'd be
-wrong.  We do check (here) that they are in scope, but there is no
-need to slurp in their actual declaration (which is what
-@addOccurrenceName@ forces).
-
-Indeed, doing so would big trouble when compiling @PrelBase@, because
-it re-exports @GHC@, which includes @takeMVar#@, whose type includes
-@ConcBase.StateAndSynchVar#@, and so on...
-
-\begin{code}
-type ExportAccum	-- The type of the accumulating parameter of
-			-- the main worker function in rnExports
-     = ([Module], 		-- 'module M's seen so far
-	ExportOccMap,		-- Tracks exported occurrence names
-	NameSet)		-- The accumulated exported stuff
-emptyExportAccum = ([], emptyOccEnv, emptyNameSet) 
-
-type ExportOccMap = OccEnv (Name, IE RdrName)
-	-- Tracks what a particular exported OccName
-	--   in an export list refers to, and which item
-	--   it came from.  It's illegal to export two distinct things
-	--   that have the same occurrence name
-
-rnExports :: Maybe [LIE RdrName]
-          -> RnM (Maybe [LIE Name])
-rnExports Nothing = return Nothing
-rnExports (Just exports)
-    = do TcGblEnv { tcg_imports = ImportAvails { imp_env = imp_env } } <- getGblEnv
-         let sub_env :: NameEnv [Name]	-- Classify each name by its parent
-             sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env)
-             rnExport (IEVar rdrName)
-                 = do name <- lookupGlobalOccRn rdrName
-                      return (IEVar name)
-             rnExport (IEThingAbs rdrName)
-                 = do name <- lookupGlobalOccRn rdrName
-                      return (IEThingAbs name)
-             rnExport (IEThingAll rdrName)
-                 = do name <- lookupGlobalOccRn rdrName
-                      return (IEThingAll name)
-             rnExport ie@(IEThingWith rdrName rdrNames)
-                 = do name <- lookupGlobalOccRn rdrName
-                      if isUnboundName name
-                         then return (IEThingWith name [])
-                         else do
-                      let env = mkOccEnv [(nameOccName s, s) | s <- subNames sub_env name]
-                          mb_names = map (lookupOccEnv env . rdrNameOcc) rdrNames
-                      if any isNothing mb_names
-                         then do addErr (exportItemErr ie)
-                                 return (IEThingWith name [])
-                         else return (IEThingWith name (catMaybes mb_names))
-             rnExport (IEModuleContents mod)
-                 = return (IEModuleContents mod)
-         rn_exports <- mapM (wrapLocM rnExport) exports
-         return (Just rn_exports)
-
-mkExportNameSet :: Bool  -- False => no 'module M(..) where' header at all
-                -> Maybe ([LIE Name], [LIE RdrName]) -- Nothing => no explicit export list
-                -> RnM NameSet
-	-- Complains if two distinct exports have same OccName
-        -- Warns about identical exports.
-	-- Complains about exports items not in scope
-
-mkExportNameSet explicit_mod exports
- = do TcGblEnv { tcg_rdr_env = rdr_env, 
-                 tcg_imports = imports } <- getGblEnv
-
-	-- If the module header is omitted altogether, then behave
-	-- as if the user had written "module Main(main) where..."
-	-- EXCEPT in interactive mode, when we behave as if he had
-	-- written "module Main where ..."
-	-- Reason: don't want to complain about 'main' not in scope
-	--	   in interactive mode
-      ghc_mode <- getGhcMode
-      real_exports <- case () of
-                        () | explicit_mod
-                               -> return exports
-                           | ghc_mode == Interactive
-                               -> return Nothing
-                           | otherwise
-                               -> do mainName <- lookupGlobalOccRn main_RDR_Unqual
-                                     return (Just ([noLoc (IEVar mainName)]
-                                                  ,[noLoc (IEVar main_RDR_Unqual)]))
-		-- ToDo: the 'noLoc' here is unhelpful if 'main' turns out to be out of scope
-      exports_from_avail real_exports rdr_env imports
-
-
-exports_from_avail Nothing rdr_env imports
- =  	-- Export all locally-defined things
-	-- We do this by filtering the global RdrEnv,
-	-- keeping only things that are locally-defined
-   return (mkNameSet [ gre_name gre 
-		     | gre <- globalRdrEnvElts rdr_env,
-		       isLocalGRE gre ])
-
-exports_from_avail (Just (items,origItems)) rdr_env (ImportAvails { imp_env = imp_env }) 
-  = do (_, _, exports) <- foldlM do_litem emptyExportAccum (zip items origItems)
-       return exports
-  where
-    sub_env :: NameEnv [Name]	-- Classify each name by its parent
-    sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env)
-
-    do_litem :: ExportAccum -> (LIE Name, LIE RdrName) -> RnM ExportAccum
-    do_litem acc (ieName, ieRdr)
-        = addLocM (exports_from_item acc (unLoc ieRdr)) ieName
-
-    exports_from_item :: ExportAccum -> IE RdrName -> IE Name -> RnM ExportAccum
-    exports_from_item acc@(mods, occs, exports) ieRdr@(IEModuleContents mod) ie
-	| mod `elem` mods 	-- Duplicate export of M
-	= do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
-	       warnIf warn_dup_exports (dupModuleExport mod) ;
-	       returnM acc }
-
-	| otherwise
-	= case lookupModuleEnv imp_env mod of
-            Nothing -> do addErr (modExportErr mod)
-                          return acc
-            Just names
-                -> do let new_exports = filterNameSet (inScopeUnqual rdr_env) names
-                      -- This check_occs not only finds conflicts between this item
-                      -- and others, but also internally within this item.  That is,
-                      -- if 'M.x' is in scope in several ways, we'll have several
-                      -- members of mod_avails with the same OccName.
-                      occs' <- check_occs ieRdr occs (nameSetToList new_exports)
-                      return (mod:mods, occs', exports `unionNameSets` new_exports)
-
-    exports_from_item acc@(mods, occs, exports) ieRdr ie
-        = if isUnboundName (ieName ie)
-          then return acc 	-- Avoid error cascade
-          else let new_exports = filterAvail ie sub_env in
-          do -- checkErr (not (null (drop 1 new_exports))) (exportItemErr ie)
-             checkForDodgyExport ie new_exports
-             occs' <- check_occs ieRdr occs new_exports
-             return (mods, occs', addListToNameSet exports new_exports)
-	  
--------------------------------
-filterAvail :: IE Name  	-- Wanted
-	    -> NameEnv [Name]	-- Maps type/class names to their sub-names
-	    -> [Name]
-
-filterAvail (IEVar n)          subs = [n]
-filterAvail (IEThingAbs n)     subs = [n]
-filterAvail (IEThingAll n)     subs = n : subNames subs n
-filterAvail (IEThingWith n ns) subs = n : ns
-filterAvail (IEModuleContents _) _  = panic "filterAvail"
-
-subNames :: NameEnv [Name] -> Name -> [Name]
-subNames env n = lookupNameEnv env n `orElse` []
-
-mkSubNameEnv :: NameSet -> NameEnv [Name]
--- Maps types and classes to their constructors/classops respectively
--- This mapping just makes it easier to deal with A(..) export items
-mkSubNameEnv names
-  = foldNameSet add_name emptyNameEnv names
-  where
-    add_name name env 
-	| Just parent <- nameParent_maybe name 
-	= extendNameEnv_C (\ns _ -> name:ns) env parent [name]
-	| otherwise = env
-
--------------------------------
-inScopeUnqual :: GlobalRdrEnv -> Name -> Bool
--- Checks whether the Name is in scope unqualified, 
--- regardless of whether it's ambiguous or not
-inScopeUnqual env n = any unQualOK (lookupGRE_Name env n)
-
--------------------------------
-checkForDodgyExport :: IE Name -> [Name] -> RnM ()
-checkForDodgyExport ie@(IEThingAll tc) [n] 
-  | isTcOcc (nameOccName n) = addWarn (dodgyExportWarn tc)
-	-- This occurs when you export T(..), but
-	-- only import T abstractly, or T is a synonym.  
-	-- The single [n] is the type or class itself
-  | otherwise = addErr (exportItemErr ie)
-	-- This happes if you export x(..), which is bogus
-checkForDodgyExport _ _ = return ()
-
--------------------------------
-check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap
-check_occs ie occs names
-  = foldlM check occs names
-  where
-    check occs name
-      = case lookupOccEnv occs name_occ of
-	  Nothing -> returnM (extendOccEnv occs name_occ (name, ie))
-
-	  Just (name', ie') 
-	    | name == name'  	-- Duplicate export
-	    ->	do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
-		     warnIf warn_dup_exports (dupExportWarn name_occ ie ie') ;
-		     returnM occs }
-
-	    | otherwise		-- Same occ name but different names: an error
-	    ->	do { global_env <- getGlobalRdrEnv ;
-  		     addErr (exportClashErr global_env name name' ie ie') ;
-		     returnM occs }
-      where
-	name_occ = nameOccName name
-\end{code}
-
-%*********************************************************
-%*						 	 *
-		Deprecations
-%*							 *
-%*********************************************************
-
-\begin{code}
-reportDeprecations :: TcGblEnv -> RnM ()
-reportDeprecations tcg_env
-  = ifOptM Opt_WarnDeprecations	$
-    do	{ (eps,hpt) <- getEpsAndHpt
-		-- By this time, typechecking is complete, 
-		-- so the PIT is fully populated
-	; mapM_ (check hpt (eps_PIT eps)) all_gres }
-  where
-    used_names = allUses (tcg_dus tcg_env) 
-	-- Report on all deprecated uses; hence allUses
-    all_gres   = globalRdrEnvElts (tcg_rdr_env tcg_env)
-
-    check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
-      | name `elemNameSet` used_names
-      ,	Just deprec_txt <- lookupDeprec hpt pit name
-      = setSrcSpan (importSpecLoc imp_spec) $
-	addWarn (sep [ptext SLIT("Deprecated use of") <+> 
-			pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> 
-		 	quotes (ppr name),
-		      (parens imp_msg) <> colon,
-		      (ppr deprec_txt) ])
-	where
-	  name_mod = nameModule name
-	  imp_mod  = importSpecModule imp_spec
-	  imp_msg  = ptext SLIT("imported from") <+> ppr imp_mod <> extra
-	  extra | imp_mod == name_mod = empty
-		| otherwise = ptext SLIT(", but defined in") <+> ppr name_mod
-
-    check hpt pit ok_gre = returnM ()	-- Local, or not used, or not deprectated
-	    -- The Imported pattern-match: don't deprecate locally defined names
-	    -- For a start, we may be exporting a deprecated thing
-	    -- Also we may use a deprecated thing in the defn of another
-	    -- deprecated things.  We may even use a deprecated thing in
-	    -- the defn of a non-deprecated thing, when changing a module's 
-	    -- interface
-
-lookupDeprec :: HomePackageTable -> PackageIfaceTable 
-	     -> Name -> Maybe DeprecTxt
-lookupDeprec hpt pit n 
-  = case lookupIface hpt pit (nameModule n) of
-	Just iface -> mi_dep_fn iface n `seqMaybe` 	-- Bleat if the thing, *or
-		      mi_dep_fn iface (nameParent n)	-- its parent*, is deprec'd
-	Nothing    
-	  | isWiredInName n -> Nothing
-		-- We have not necessarily loaded the .hi file for a 
-		-- wired-in name (yet), although we *could*.
-		-- And we never deprecate them
-
-	 | otherwise -> pprPanic "lookupDeprec" (ppr n)	
-		-- By now all the interfaces should have been loaded
-
-gre_is_used :: NameSet -> GlobalRdrElt -> Bool
-gre_is_used used_names gre = gre_name gre `elemNameSet` used_names
-\end{code}
-
-%*********************************************************
-%*						 	 *
-		Unused names
-%*							 *
-%*********************************************************
-
-\begin{code}
-reportUnusedNames :: Maybe [LIE RdrName] 	-- Export list
-		  -> TcGblEnv -> RnM ()
-reportUnusedNames export_decls gbl_env 
-  = do	{ traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env)))
-	; warnUnusedTopBinds   unused_locals
-	; warnUnusedModules    unused_imp_mods
-	; warnUnusedImports    unused_imports	
-	; warnDuplicateImports defined_and_used
-	; printMinimalImports  minimal_imports }
-  where
-    used_names, all_used_names :: NameSet
-    used_names = findUses (tcg_dus gbl_env) emptyNameSet
-	-- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
-	-- Hence findUses
-
-    all_used_names = used_names `unionNameSets` 
-		     mkNameSet (mapCatMaybes nameParent_maybe (nameSetToList used_names))
-			-- A use of C implies a use of T,
-			-- if C was brought into scope by T(..) or T(C)
-
-	-- Collect the defined names from the in-scope environment
-    defined_names :: [GlobalRdrElt]
-    defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)
-
-	-- Note that defined_and_used, defined_but_not_used
-	-- are both [GRE]; that's why we need defined_and_used
-	-- rather than just all_used_names
-    defined_and_used, defined_but_not_used :: [GlobalRdrElt]
-    (defined_and_used, defined_but_not_used) 
-	= partition (gre_is_used all_used_names) defined_names
-    
-	-- Filter out the ones that are 
-	--  (a) defined in this module, and
-	--  (b) not defined by a 'deriving' clause 
-	-- The latter have an Internal Name, so we can filter them out easily
-    unused_locals :: [GlobalRdrElt]
-    unused_locals = filter is_unused_local defined_but_not_used
-    is_unused_local :: GlobalRdrElt -> Bool
-    is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre)
-    
-    unused_imports :: [GlobalRdrElt]
-    unused_imports = filter unused_imp defined_but_not_used
-    unused_imp (GRE {gre_prov = Imported imp_specs}) 
-	= not (all (module_unused . importSpecModule) imp_specs)
-	  && or [exp | ImpSpec { is_item = ImpSome { is_explicit = exp } } <- imp_specs]
-		-- Don't complain about unused imports if we've already said the
-		-- entire import is unused
-    unused_imp other = False
-    
-    -- To figure out the minimal set of imports, start with the things
-    -- that are in scope (i.e. in gbl_env).  Then just combine them
-    -- into a bunch of avails, so they are properly grouped
-    --
-    -- BUG WARNING: this does not deal properly with qualified imports!
-    minimal_imports :: FiniteMap Module AvailEnv
-    minimal_imports0 = foldr add_expall   emptyFM 	   expall_mods
-    minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
-    minimal_imports  = foldr add_inst_mod minimal_imports1 direct_import_mods
- 	-- The last line makes sure that we retain all direct imports
-    	-- even if we import nothing explicitly.
-    	-- It's not necessarily redundant to import such modules. Consider 
-    	--	      module This
-    	--		import M ()
-    	--
-    	-- The import M() is not *necessarily* redundant, even if
-    	-- we suck in no instance decls from M (e.g. it contains 
-    	-- no instance decls, or This contains no code).  It may be 
-    	-- that we import M solely to ensure that M's orphan instance 
-    	-- decls (or those in its imports) are visible to people who 
-    	-- import This.  Sigh. 
-    	-- There's really no good way to detect this, so the error message 
-    	-- in RnEnv.warnUnusedModules is weakened instead
-    
-	-- We've carefully preserved the provenance so that we can
-	-- construct minimal imports that import the name by (one of)
-	-- the same route(s) as the programmer originally did.
-    add_name (GRE {gre_name = n, gre_prov = Imported imp_specs}) acc 
-	= addToFM_C plusAvailEnv acc (importSpecModule (head imp_specs))
-		    (unitAvailEnv (mk_avail n (nameParent_maybe n)))
-    add_name other acc 
-	= acc
-
-	-- Modules mentioned as 'module M' in the export list
-    expall_mods = case export_decls of
-		    Nothing -> []
-		    Just es -> [m | L _ (IEModuleContents m) <- es]
-
-	-- This is really bogus.  The idea is that if we see 'module M' in 
-	-- the export list we must retain the import decls that drive it
-	-- If we aren't careful we might see
-	--	module A( module M ) where
-	--	  import M
-	--	  import N
-	-- and suppose that N exports everything that M does.  Then we 
-	-- must not drop the import of M even though N brings it all into
-	-- scope.
-	--
-	-- BUG WARNING: 'module M' exports aside, what if M.x is mentioned?!
-	--
-	-- The reason that add_expall is bogus is that it doesn't take
-	-- qualified imports into account.  But it's an improvement.
-    add_expall mod acc = addToFM_C plusAvailEnv acc mod emptyAvailEnv
-
-	-- n is the name of the thing, p is the name of its parent
-    mk_avail n (Just p)			 	 = AvailTC p [p,n]
-    mk_avail n Nothing | isTcOcc (nameOccName n) = AvailTC n [n]
-		       | otherwise		 = Avail n
-    
-    add_inst_mod (mod,_,_) acc 
-      | mod `elemFM` acc = acc	-- We import something already
-      | otherwise        = addToFM acc mod emptyAvailEnv
-      where
-    	-- Add an empty collection of imports for a module
-    	-- from which we have sucked only instance decls
-   
-    imports = tcg_imports gbl_env
-
-    direct_import_mods :: [(Module, Bool, SrcSpan)]
-	-- See the type of the imp_mods for this triple
-    direct_import_mods = moduleEnvElts (imp_mods imports)
-
-    -- unused_imp_mods are the directly-imported modules 
-    -- that are not mentioned in minimal_imports1
-    -- [Note: not 'minimal_imports', because that includes directly-imported
-    --	      modules even if we use nothing from them; see notes above]
-    --
-    -- BUG WARNING: does not deal correctly with multiple imports of the same module
-    --	 	    becuase direct_import_mods has only one entry per module
-    unused_imp_mods = [(mod,loc) | (mod,no_imp,loc) <- direct_import_mods,
-    		       not (mod `elemFM` minimal_imports1),
-    		       mod /= pRELUDE,
-		       not no_imp]
-	-- The not no_imp part is not to complain about
-	-- import M (), which is an idiom for importing
-	-- instance declarations
-    
-    module_unused :: Module -> Bool
-    module_unused mod = any (((==) mod) . fst) unused_imp_mods
-
----------------------
-warnDuplicateImports :: [GlobalRdrElt] -> RnM ()
--- Given the GREs for names that are used, figure out which imports 
--- could be omitted without changing the top-level environment.
---
--- NB: Given import Foo( T )
---     	     import qualified Foo
--- we do not report a duplicate import, even though Foo.T is brought
--- into scope by both, because there's nothing you can *omit* without
--- changing the top-level environment.  So we complain only if it's
--- explicitly named in both imports or neither.
---
--- Furthermore, we complain about Foo.T only if 
--- there is no complaint about (unqualified) T
-
-warnDuplicateImports gres
-  = ifOptM Opt_WarnUnusedImports $ 
-    sequenceM_	[ warn name pr
-			-- The 'head' picks the first offending group
-			-- for this particular name
-		| GRE { gre_name = name, gre_prov = Imported imps } <- gres
-		, pr <- redundants imps ]
-  where
-    warn name (red_imp, cov_imp)
-	= addWarnAt (importSpecLoc red_imp)
-	    (vcat [ptext SLIT("Redundant import of:") <+> quotes pp_name,
-	           ptext SLIT("It is also") <+> ppr cov_imp])
-	where
-	  pp_name | is_qual red_decl = ppr (is_as red_decl) <> dot <> ppr occ
-		  | otherwise	    = ppr occ
-	  occ = nameOccName name
-	  red_decl = is_decl red_imp
-    
-    redundants :: [ImportSpec] -> [(ImportSpec,ImportSpec)]
-	-- The returned pair is (redundant-import, covering-import)
-    redundants imps 
-	= [ (red_imp, cov_imp) 
-	  | red_imp <- imps
-	  , cov_imp <- take 1 (filter (covers red_imp) imps) ]
-
-	-- "red_imp" is a putative redundant import
-	-- "cov_imp" potentially covers it
-	-- This test decides whether red_imp could be dropped 
-	--
-	-- NOTE: currently the test does not warn about
-	--		import M( x )
-	--		imoprt N( x )
-	-- even if the same underlying 'x' is involved, because dropping
-	-- either import would change the qualified names in scope (M.x, N.x)
-	-- But if the qualified names aren't used, the import is indeed redundant
-	-- Sadly we don't know that.  Oh well.
-    covers red_imp@(ImpSpec { is_decl = red_decl, is_item = red_item }) 
-	   cov_imp@(ImpSpec { is_decl = cov_decl, is_item = cov_item })
-	| red_loc == cov_loc
-  	= False		-- Ignore diagonal elements
-	| not (is_as red_decl == is_as cov_decl)
-	= False		-- They bring into scope different qualified names
-	| not (is_qual red_decl) && is_qual cov_decl
-	= False		-- Covering one doesn't bring unqualified name into scope
-	| red_selective
-	= not cov_selective 	-- Redundant one is selective and covering one isn't
-	  || red_later		-- Both are explicit; tie-break using red_later
-	| otherwise		
-	= not cov_selective 	-- Neither import is selective
-	  && (is_mod red_decl == is_mod cov_decl)	-- They import the same module
-	  && red_later 		-- Tie-break
-	where
-	  red_loc   = importSpecLoc red_imp
-	  cov_loc   = importSpecLoc cov_imp
-	  red_later = red_loc > cov_loc
-	  cov_selective = selectiveImpItem cov_item
-	  red_selective = selectiveImpItem red_item
-
-selectiveImpItem :: ImpItemSpec -> Bool
-selectiveImpItem ImpAll       = False
-selectiveImpItem (ImpSome {}) = True
-
--- ToDo: deal with original imports with 'qualified' and 'as M' clauses
-printMinimalImports :: FiniteMap Module AvailEnv	-- Minimal imports
-		    -> RnM ()
-printMinimalImports imps
- = ifOptM Opt_D_dump_minimal_imports $ do {
-
-   mod_ies  <-  mappM to_ies (fmToList imps) ;
-   this_mod <- getModule ;
-   rdr_env  <- getGlobalRdrEnv ;
-   ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ;
-		  printForUser h (unQualInScope rdr_env) 
-				 (vcat (map ppr_mod_ie mod_ies)) })
-   }
-  where
-    mkFilename this_mod = moduleString this_mod ++ ".imports"
-    ppr_mod_ie (mod_name, ies) 
-	| mod_name == pRELUDE 
-	= empty
-	| null ies	-- Nothing except instances comes from here
-	= ptext SLIT("import") <+> ppr mod_name <> ptext SLIT("()    -- Instances only")
-	| otherwise
-	= ptext SLIT("import") <+> ppr mod_name <> 
-		    parens (fsep (punctuate comma (map ppr ies)))
-
-    to_ies (mod, avail_env) = do ies <- mapM to_ie (availEnvElts avail_env)
-                                 returnM (mod, ies)
-
-    to_ie :: AvailInfo -> RnM (IE Name)
-	-- The main trick here is that if we're importing all the constructors
-	-- we want to say "T(..)", but if we're importing only a subset we want
-	-- to say "T(A,B,C)".  So we have to find out what the module exports.
-    to_ie (Avail n)       = returnM (IEVar n)
-    to_ie (AvailTC n [m]) = ASSERT( n==m ) 
-			    returnM (IEThingAbs n)
-    to_ie (AvailTC n ns)  
-	= loadSrcInterface doc n_mod False			`thenM` \ iface ->
-	  case [xs | (m,as) <- mi_exports iface,
-		     m == n_mod,
-		     AvailTC x xs <- as, 
-		     x == nameOccName n] of
-	      [xs] | all_used xs -> returnM (IEThingAll n)
-		   | otherwise	 -> returnM (IEThingWith n (filter (/= n) ns))
-	      other		 -> pprTrace "to_ie" (ppr n <+> ppr n_mod <+> ppr other) $
-				    returnM (IEVar n)
-	where
-	  all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
-	  doc = text "Compute minimal imports from" <+> ppr n
-	  n_mod = nameModule n
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Errors}
-%*									*
-%************************************************************************
-
-\begin{code}
-badImportItemErr iface decl_spec ie
-  = sep [ptext SLIT("Module"), quotes (ppr (is_mod decl_spec)), source_import,
-	 ptext SLIT("does not export"), quotes (ppr ie)]
-  where
-    source_import | mi_boot iface = ptext SLIT("(hi-boot interface)")
-		  | otherwise     = empty
-
-dodgyImportWarn item = dodgyMsg (ptext SLIT("import")) item
-dodgyExportWarn item = dodgyMsg (ptext SLIT("export")) item
-
-dodgyMsg kind tc
-  = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr (IEThingAll tc)),
-	  ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructor or class methods"),
-	  ptext SLIT("but it has none; it is a type synonym or abstract type or class") ]
-	  
-modExportErr mod
-  = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (ppr mod)]
-
-exportItemErr export_item
-  = sep [ ptext SLIT("The export item") <+> quotes (ppr export_item),
-	  ptext SLIT("attempts to export constructors or class methods that are not visible here") ]
-
-exportClashErr global_env name1 name2 ie1 ie2
-  = vcat [ ptext SLIT("Conflicting exports for") <+> quotes (ppr occ) <> colon
-	 , ppr_export ie1 name1 
-	 , ppr_export ie2 name2  ]
-  where
-    occ = nameOccName name1
-    ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext SLIT("exports") <+> 
-			 	 quotes (ppr name) <+> pprNameProvenance (get_gre name))
-
-	-- get_gre finds a GRE for the Name, so that we can show its provenance
-    get_gre name
-	= case lookupGRE_Name global_env name of
-	     (gre:_) -> gre
-	     []	     -> pprPanic "exportClashErr" (ppr name)
-
-addDupDeclErr :: Name -> Name -> TcRn ()
-addDupDeclErr name_a name_b
-  = addErrAt (srcLocSpan loc2) $
-    vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr name1),
-	  ptext SLIT("Declared at:") <+> vcat [ppr (nameSrcLoc name1), ppr loc2]]
-  where
-    loc2 = nameSrcLoc name2
-    (name1,name2) | nameSrcLoc name_a > nameSrcLoc name_b = (name_b,name_a)
-		  | otherwise				  = (name_a,name_b)
-	-- Report the error at the later location
-
-dupExportWarn occ_name ie1 ie2
-  = hsep [quotes (ppr occ_name), 
-          ptext SLIT("is exported by"), quotes (ppr ie1),
-          ptext SLIT("and"),            quotes (ppr ie2)]
-
-dupModuleExport mod
-  = hsep [ptext SLIT("Duplicate"),
-	  quotes (ptext SLIT("Module") <+> ppr mod), 
-          ptext SLIT("in export list")]
-
-moduleDeprec mod txt
-  = sep [ ptext SLIT("Module") <+> quotes (ppr mod) <+> ptext SLIT("is deprecated:"), 
-	  nest 4 (ppr txt) ]	  
-\end{code}
diff --git a/ghc/compiler/rename/RnSource.hi-boot-5 b/ghc/compiler/rename/RnSource.hi-boot-5
deleted file mode 100644
index 1ec4d52522..0000000000
--- a/ghc/compiler/rename/RnSource.hi-boot-5
+++ /dev/null
@@ -1,13 +0,0 @@
-__interface RnSource 1 0 where
-__export RnSource rnBindsAndThen rnBinds rnSrcDecls;
-
-1 rnBindsAndThen :: __forall [b] => [HsBinds.HsBindGroup RdrName.RdrName]
-	-> ([HsBinds.HsBindGroup Name.Name]
- 	-> TcRnTypes.RnM (b, NameSet.FreeVars))
-	-> TcRnTypes.RnM (b, NameSet.FreeVars) ;
-
-1 rnBinds :: [HsBinds.HsBindGroup RdrName.RdrName]
-	-> TcRnTypes.RnM ([HsBinds.HsBindGroup Name.Name], NameSet.DefUses) ;
-
-1 rnSrcDecls :: HsDecls.HsGroup RdrName.RdrName
-	   -> TcRnTypes.RnM (TcRnTypes.TcGblEnv, HsDecls.HsGroup Name.Name)
diff --git a/ghc/compiler/rename/RnSource.lhs b/ghc/compiler/rename/RnSource.lhs
deleted file mode 100644
index 9150440aee..0000000000
--- a/ghc/compiler/rename/RnSource.lhs
+++ /dev/null
@@ -1,722 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[RnSource]{Main pass of renamer}
-
-\begin{code}
-module RnSource ( 
-	rnSrcDecls, addTcgDUs, 
-	rnTyClDecls, checkModDeprec,
-	rnSplice, checkTH
-    ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} RnExpr( rnLExpr )
-
-import HsSyn
-import RdrName		( RdrName, isRdrDataCon, elemLocalRdrEnv, globalRdrEnvElts,
-			  GlobalRdrElt(..), isLocalGRE )
-import RdrHsSyn		( extractGenericPatTyVars, extractHsRhoRdrTyVars )
-import RnHsSyn
-import RnTypes		( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
-import RnBinds		( rnTopBinds, rnMethodBinds, renameSigs )
-import RnEnv		( lookupLocalDataTcNames,
-			  lookupLocatedTopBndrRn, lookupLocatedOccRn,
-			  lookupOccRn, newLocalsRn, 
-			  bindLocatedLocalsFV, bindPatSigTyVarsFV,
-			  bindTyVarsRn, extendTyVarEnvFVRn,
-			  bindLocalNames, checkDupNames, mapFvRn
-			)
-import TcRnMonad
-
-import HscTypes		( FixityEnv, FixItem(..),
-			  Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
-import Class		( FunDep )
-import Name		( Name, nameOccName )
-import NameSet
-import NameEnv
-import OccName		( occEnvElts )
-import Outputable
-import SrcLoc		( Located(..), unLoc, getLoc, noLoc )
-import DynFlags	( DynFlag(..) )
-import Maybes		( seqMaybe )
-import Maybe            ( isNothing )
-import BasicTypes       ( Boxity(..) )
-\end{code}
-
-@rnSourceDecl@ `renames' declarations.
-It simultaneously performs dependency analysis and precedence parsing.
-It also does the following error checks:
-\begin{enumerate}
-\item
-Checks that tyvars are used properly. This includes checking
-for undefined tyvars, and tyvars in contexts that are ambiguous.
-(Some of this checking has now been moved to module @TcMonoType@,
-since we don't have functional dependency information at this point.)
-\item
-Checks that all variable occurences are defined.
-\item 
-Checks the @(..)@ etc constraints in the export list.
-\end{enumerate}
-
-
-\begin{code}
-rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
-
-rnSrcDecls (HsGroup { hs_valds  = val_decls,
-		      hs_tyclds = tycl_decls,
-		      hs_instds = inst_decls,
-		      hs_fixds  = fix_decls,
-		      hs_depds  = deprec_decls,
-		      hs_fords  = foreign_decls,
-		      hs_defds  = default_decls,
-		      hs_ruleds = rule_decls })
-
- = do {		-- Deal with deprecations (returns only the extra deprecations)
-	deprecs <- rnSrcDeprecDecls deprec_decls ;
-	updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
-		  $ do {
-
-		-- Deal with top-level fixity decls 
-		-- (returns the total new fixity env)
-	fix_env <- rnSrcFixityDeclsEnv fix_decls ;
-        rn_fix_decls <- rnSrcFixityDecls fix_decls ;
-	updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
-		  $ do {
-
-		-- Rename other declarations
-	traceRn (text "Start rnmono") ;
-	(rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
-	traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
-
-		-- You might think that we could build proper def/use information
-		-- for type and class declarations, but they can be involved
-		-- in mutual recursion across modules, and we only do the SCC
-		-- analysis for them in the type checker.
-		-- So we content ourselves with gathering uses only; that
-		-- means we'll only report a declaration as unused if it isn't
-		-- mentioned at all.  Ah well.
-	(rn_tycl_decls,    src_fvs1)
-	   <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
-	(rn_inst_decls,    src_fvs2)
-	   <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
-	(rn_rule_decls,    src_fvs3)
-	   <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
-	(rn_foreign_decls, src_fvs4)
-	   <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
-	(rn_default_decls, src_fvs5)
-	   <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
-	
-	let {
-	   rn_group = HsGroup { hs_valds  = rn_val_decls,
-			    	hs_tyclds = rn_tycl_decls,
-			    	hs_instds = rn_inst_decls,
-			    	hs_fixds  = rn_fix_decls,
-			    	hs_depds  = [],
-			    	hs_fords  = rn_foreign_decls,
-			    	hs_defds  = rn_default_decls,
-			    	hs_ruleds = rn_rule_decls } ;
-
-	   other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, 
-				src_fvs4, src_fvs5] ;
-	   src_dus = bind_dus `plusDU` usesOnly other_fvs 
-		-- Note: src_dus will contain *uses* for locally-defined types
-		-- and classes, but no *defs* for them.  (Because rnTyClDecl 
-		-- returns only the uses.)  This is a little 
-		-- surprising but it doesn't actually matter at all.
-	} ;
-
-	traceRn (text "finish rnSrc" <+> ppr rn_group) ;
-	traceRn (text "finish Dus" <+> ppr src_dus ) ;
-	tcg_env <- getGblEnv ;
-	return (tcg_env `addTcgDUs` src_dus, rn_group)
-    }}}
-
-rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
-rnTyClDecls tycl_decls = do 
-  (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
-  return decls'
-
-addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv 
-addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
-\end{code}
-
-
-%*********************************************************
-%*						 	 *
-	Source-code fixity declarations
-%*							 *
-%*********************************************************
-
-\begin{code}
-rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
-rnSrcFixityDecls fix_decls
-    = do fix_decls <- mapM rnFixityDecl fix_decls
-         return (concat fix_decls)
-
-rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
-rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
-    = do names <- lookupLocalDataTcNames rdr_name
-         return [ L loc (FixitySig (L nameLoc name) fixity)
-                      | name <- names ]
-
-rnSrcFixityDeclsEnv :: [LFixitySig RdrName] -> RnM FixityEnv
-rnSrcFixityDeclsEnv fix_decls
-  = getGblEnv					`thenM` \ gbl_env ->
-    foldlM rnFixityDeclEnv (tcg_fix_env gbl_env) 
-	    fix_decls				 	`thenM` \ fix_env ->
-    traceRn (text "fixity env" <+> pprFixEnv fix_env)	`thenM_`
-    returnM fix_env
-
-rnFixityDeclEnv :: FixityEnv -> LFixitySig RdrName -> RnM FixityEnv
-rnFixityDeclEnv fix_env (L loc (FixitySig rdr_name fixity))
-  = setSrcSpan loc $
-        -- GHC extension: look up both the tycon and data con 
-	-- for con-like things
-	-- If neither are in scope, report an error; otherwise
-	-- add both to the fixity env
-     addLocM lookupLocalDataTcNames rdr_name	`thenM` \ names ->
-     foldlM add fix_env names
-  where
-    add fix_env name
-      = case lookupNameEnv fix_env name of
-          Just (FixItem _ _ loc') 
-		  -> addLocErr rdr_name (dupFixityDecl loc')	`thenM_`
-    		     returnM fix_env
-    	  Nothing -> returnM (extendNameEnv fix_env name fix_item)
-      where
-	fix_item = FixItem (nameOccName name) fixity (getLoc rdr_name)
-
-pprFixEnv :: FixityEnv -> SDoc
-pprFixEnv env 
-  = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
-		  (nameEnvElts env)
-
-dupFixityDecl loc rdr_name
-  = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
-	  ptext SLIT("also at ") <+> ppr loc
-	]
-\end{code}
-
-
-%*********************************************************
-%*						 	 *
-	Source-code deprecations declarations
-%*							 *
-%*********************************************************
-
-For deprecations, all we do is check that the names are in scope.
-It's only imported deprecations, dealt with in RnIfaces, that we
-gather them together.
-
-\begin{code}
-rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
-rnSrcDeprecDecls [] 
-  = returnM NoDeprecs
-
-rnSrcDeprecDecls decls
-  = mappM (addLocM rn_deprec) decls	`thenM` \ pairs_s ->
-    returnM (DeprecSome (mkNameEnv (concat pairs_s)))
- where
-   rn_deprec (Deprecation rdr_name txt)
-     = lookupLocalDataTcNames rdr_name	`thenM` \ names ->
-       returnM [(name, (nameOccName name, txt)) | name <- names]
-
-checkModDeprec :: Maybe DeprecTxt -> Deprecations
--- Check for a module deprecation; done once at top level
-checkModDeprec Nothing    = NoDeprecs
-checkModDeprec (Just txt) = DeprecAll txt
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{Source code declarations}
-%*							*
-%*********************************************************
-
-\begin{code}
-rnDefaultDecl (DefaultDecl tys)
-  = mapFvRn (rnHsTypeFVs doc_str) tys	`thenM` \ (tys', fvs) ->
-    returnM (DefaultDecl tys', fvs)
-  where
-    doc_str = text "In a `default' declaration"
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{Foreign declarations}
-%*							*
-%*********************************************************
-
-\begin{code}
-rnHsForeignDecl (ForeignImport name ty spec isDeprec)
-  = lookupLocatedTopBndrRn name	        `thenM` \ name' ->
-    rnHsTypeFVs (fo_decl_msg name) ty	`thenM` \ (ty', fvs) ->
-    returnM (ForeignImport name' ty' spec isDeprec, fvs)
-
-rnHsForeignDecl (ForeignExport name ty spec isDeprec)
-  = lookupLocatedOccRn name	        `thenM` \ name' ->
-    rnHsTypeFVs (fo_decl_msg name) ty  	`thenM` \ (ty', fvs) ->
-    returnM (ForeignExport name' ty' spec isDeprec, fvs )
-	-- NB: a foreign export is an *occurrence site* for name, so 
-	--     we add it to the free-variable list.  It might, for example,
-	--     be imported from another module
-
-fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
-\end{code}
-
-
-%*********************************************************
-%*							*
-\subsection{Instance declarations}
-%*							*
-%*********************************************************
-
-\begin{code}
-rnSrcInstDecl (InstDecl inst_ty mbinds uprags)
-	-- Used for both source and interface file decls
-  = rnHsSigType (text "an instance decl") inst_ty	`thenM` \ inst_ty' ->
-
-	-- Rename the bindings
-	-- The typechecker (not the renamer) checks that all 
-	-- the bindings are for the right class
-    let
-	meth_doc    = text "In the bindings in an instance declaration"
-	meth_names  = collectHsBindLocatedBinders mbinds
-	(inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
-    in
-    checkDupNames meth_doc meth_names 	`thenM_`
-    extendTyVarEnvForMethodBinds inst_tyvars (		
-	-- (Slightly strangely) the forall-d tyvars scope over
-	-- the method bindings too
-	rnMethodBinds cls [] mbinds
-    )						`thenM` \ (mbinds', meth_fvs) ->
-	-- Rename the prags and signatures.
-	-- Note that the type variables are not in scope here,
-	-- so that	instance Eq a => Eq (T a) where
-	--			{-# SPECIALISE instance Eq a => Eq (T [a]) #-}
-	-- works OK. 
-	--
-	-- But the (unqualified) method names are in scope
-    let 
-	binders = collectHsBindBinders mbinds'
-	ok_sig  = okInstDclSig (mkNameSet binders)
-    in
-    bindLocalNames binders (renameSigs ok_sig uprags)	`thenM` \ uprags' ->
-
-    returnM (InstDecl inst_ty' mbinds' uprags',
-	     meth_fvs `plusFV` hsSigsFVs uprags'
-		      `plusFV` extractHsTyNames inst_ty')
-\end{code}
-
-For the method bindings in class and instance decls, we extend the 
-type variable environment iff -fglasgow-exts
-
-\begin{code}
-extendTyVarEnvForMethodBinds tyvars thing_inside
-  = doptM Opt_GlasgowExts			`thenM` \ opt_GlasgowExts ->
-    if opt_GlasgowExts then
-	extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
-    else
-	thing_inside
-\end{code}
-
-
-%*********************************************************
-%*							*
-\subsection{Rules}
-%*							*
-%*********************************************************
-
-\begin{code}
-rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
-  = bindPatSigTyVarsFV (collectRuleBndrSigTys vars)	$
-
-    bindLocatedLocalsFV doc (map get_var vars)		$ \ ids ->
-    mapFvRn rn_var (vars `zip` ids)		`thenM` \ (vars', fv_vars) ->
-
-    rnLExpr lhs					`thenM` \ (lhs', fv_lhs') ->
-    rnLExpr rhs					`thenM` \ (rhs', fv_rhs') ->
-    let
-	mb_bad = validRuleLhs ids lhs'
-    in
-    checkErr (isNothing mb_bad)
-	     (badRuleLhsErr rule_name lhs' mb_bad)	`thenM_`
-    let
-	bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
-    in
-    mappM (addErr . badRuleVar rule_name) bad_vars	`thenM_`
-    returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
-	     fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
-  where
-    doc = text "In the transformation rule" <+> ftext rule_name
-  
-    get_var (RuleBndr v)      = v
-    get_var (RuleBndrSig v _) = v
-
-    rn_var (RuleBndr (L loc v), id)
-	= returnM (RuleBndr (L loc id), emptyFVs)
-    rn_var (RuleBndrSig (L loc v) t, id)
-	= rnHsTypeFVs doc t	`thenM` \ (t', fvs) ->
-	  returnM (RuleBndrSig (L loc id) t', fvs)
-\end{code}
-
-Check the shape of a transformation rule LHS.  Currently
-we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
-not one of the @forall@'d variables.  We also restrict the form of the LHS so
-that it may be plausibly matched.  Basically you only get to write ordinary 
-applications.  (E.g. a case expression is not allowed: too elaborate.)
-
-NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
-
-\begin{code}
-validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
--- Nothing => OK
--- Just e  => Not ok, and e is the offending expression
-validRuleLhs foralls lhs
-  = checkl lhs
-  where
-    checkl (L loc e) = check e
-
-    check (OpApp e1 op _ e2)		  = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
-    check (HsApp e1 e2) 		  = checkl e1 `seqMaybe` checkl_e e2
-    check (HsVar v) | v `notElem` foralls = Nothing
-    check other				  = Just other 	-- Failure
-
-    checkl_e (L loc e) = check_e e
-
-    check_e (HsVar v)     = Nothing
-    check_e (HsPar e) 	  = checkl_e e
-    check_e (HsLit e) 	  = Nothing
-    check_e (HsOverLit e) = Nothing
-
-    check_e (OpApp e1 op _ e2) 	 = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
-    check_e (HsApp e1 e2)      	 = checkl_e e1 `seqMaybe` checkl_e e2
-    check_e (NegApp e _)       	 = checkl_e e
-    check_e (ExplicitList _ es)	 = checkl_es es
-    check_e (ExplicitTuple es _) = checkl_es es
-    check_e other		 = Just other	-- Fails
-
-    checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
-
-badRuleLhsErr name lhs (Just bad_e)
-  = sep [ptext SLIT("Rule") <+> ftext name <> colon,
-	 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e, 
-		       ptext SLIT("in left-hand side:") <+> ppr lhs])]
-    $$
-    ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
-
-badRuleVar name var
-  = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
-	 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+> 
-		ptext SLIT("does not appear on left hand side")]
-\end{code}
-
-
-%*********************************************************
-%*							*
-\subsection{Type, class and iface sig declarations}
-%*							*
-%*********************************************************
-
-@rnTyDecl@ uses the `global name function' to create a new type
-declaration in which local names have been replaced by their original
-names, reporting any unknown names.
-
-Renaming type variables is a pain. Because they now contain uniques,
-it is necessary to pass in an association list which maps a parsed
-tyvar to its @Name@ representation.
-In some cases (type signatures of values),
-it is even necessary to go over the type first
-in order to get the set of tyvars used by it, make an assoc list,
-and then go over it again to rename the tyvars!
-However, we can also do some scoping checks at the same time.
-
-\begin{code}
-rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
-  = lookupLocatedTopBndrRn name		`thenM` \ name' ->
-    returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
-	     emptyFVs)
-
-rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
-		    tcdTyVars = tyvars, tcdCons = condecls, 
-		    tcdKindSig = sig, tcdDerivs = derivs})
-  | is_vanilla	-- Normal Haskell data type decl
-  = ASSERT( isNothing sig )	-- In normal H98 form, kind signature on the 
-				-- data type is syntactically illegal
-    bindTyVarsRn data_doc tyvars		$ \ tyvars' ->
-    do	{ tycon' <- lookupLocatedTopBndrRn tycon
-	; context' <- rnContext data_doc context
-	; (derivs', deriv_fvs) <- rn_derivs derivs
-	; checkDupNames data_doc con_names
-	; condecls' <- rnConDecls (unLoc tycon') condecls
-	; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
-			   tcdTyVars = tyvars', tcdKindSig = Nothing, tcdCons = condecls', 
-			   tcdDerivs = derivs'}, 
-		   delFVs (map hsLTyVarName tyvars')	$
-	     	   extractHsCtxtTyNames context'	`plusFV`
-	     	   plusFVs (map conDeclFVs condecls') `plusFV`
-	     	   deriv_fvs) }
-
-  | otherwise	-- GADT
-  = do	{ tycon' <- lookupLocatedTopBndrRn tycon
-	; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
-    	; tyvars' <- bindTyVarsRn data_doc tyvars 
-				  (\ tyvars' -> return tyvars')
-		-- For GADTs, the type variables in the declaration 
-		-- do not scope over the constructor signatures
-		-- 	data T a where { T1 :: forall b. b-> b }
-	; (derivs', deriv_fvs) <- rn_derivs derivs
-	; checkDupNames data_doc con_names
-	; condecls' <- rnConDecls (unLoc tycon') condecls
-	; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
-			   tcdTyVars = tyvars', tcdCons = condecls', tcdKindSig = sig,
-			   tcdDerivs = derivs'}, 
-	     	   plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
-
-  where
-    is_vanilla = case condecls of	-- Yuk
-		     [] 		   -> True
-		     L _ (ConDecl { con_res = ResTyH98 }) : _  -> True
-		     other		   -> False
-
-    data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
-    con_names = map con_names_helper condecls
-
-    con_names_helper (L _ c) = con_name c
-
-    rn_derivs Nothing   = returnM (Nothing, emptyFVs)
-    rn_derivs (Just ds) = rnLHsTypes data_doc ds	`thenM` \ ds' -> 
-			  returnM (Just ds', extractHsTyNames_s ds')
-    
-rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
-  = lookupLocatedTopBndrRn name			`thenM` \ name' ->
-    bindTyVarsRn syn_doc tyvars 		$ \ tyvars' ->
-    rnHsTypeFVs syn_doc ty			`thenM` \ (ty', fvs) ->
-    returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars', 
-			tcdSynRhs = ty'},
-	     delFVs (map hsLTyVarName tyvars') fvs)
-  where
-    syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
-
-rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname, 
-		       tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs, 
-		       tcdMeths = mbinds})
-  = lookupLocatedTopBndrRn cname		`thenM` \ cname' ->
-
-	-- Tyvars scope over superclass context and method signatures
-    bindTyVarsRn cls_doc tyvars			( \ tyvars' ->
-	rnContext cls_doc context	`thenM` \ context' ->
-	rnFds cls_doc fds		`thenM` \ fds' ->
-	renameSigs okClsDclSig sigs	`thenM` \ sigs' ->
-	returnM   (tyvars', context', fds', sigs')
-    )	`thenM` \ (tyvars', context', fds', sigs') ->
-
-	-- Check the signatures
-	-- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
-    let
-	sig_rdr_names_w_locs   = [op | L _ (TypeSig op _) <- sigs]
-    in
-    checkDupNames sig_doc sig_rdr_names_w_locs	`thenM_` 
-	-- Typechecker is responsible for checking that we only
-	-- give default-method bindings for things in this class.
-	-- The renamer *could* check this for class decls, but can't
-	-- for instance decls.
-
-   	-- The newLocals call is tiresome: given a generic class decl
-	--	class C a where
-	--	  op :: a -> a
-	--	  op {| x+y |} (Inl a) = ...
-	--	  op {| x+y |} (Inr b) = ...
-	--	  op {| a*b |} (a*b)   = ...
-	-- we want to name both "x" tyvars with the same unique, so that they are
-	-- easy to group together in the typechecker.  
-    extendTyVarEnvForMethodBinds tyvars' (
-   	 getLocalRdrEnv					`thenM` \ name_env ->
-   	 let
- 	     meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
- 	     gen_rdr_tyvars_w_locs = 
-		[ tv | tv <- extractGenericPatTyVars mbinds,
- 		      not (unLoc tv `elemLocalRdrEnv` name_env) ]
-   	 in
-   	 checkDupNames meth_doc meth_rdr_names_w_locs	`thenM_`
-   	 newLocalsRn gen_rdr_tyvars_w_locs	`thenM` \ gen_tyvars ->
-   	 rnMethodBinds (unLoc cname') gen_tyvars mbinds
-    ) `thenM` \ (mbinds', meth_fvs) ->
-
-    returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
-			 tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
-	     delFVs (map hsLTyVarName tyvars')	$
-	     extractHsCtxtTyNames context'	    `plusFV`
-	     plusFVs (map extractFunDepNames (map unLoc fds'))  `plusFV`
-	     hsSigsFVs sigs'		  	    `plusFV`
-	     meth_fvs)
-  where
-    meth_doc = text "In the default-methods for class"	<+> ppr cname
-    cls_doc  = text "In the declaration for class" 	<+> ppr cname
-    sig_doc  = text "In the signatures for class"  	<+> ppr cname
-
-badGadtStupidTheta tycon
-  = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
-	  ptext SLIT("(You can put a context on each contructor, though.)")]
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{Support code for type/data declarations}
-%*							*
-%*********************************************************
-
-\begin{code}
-rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
-rnConDecls tycon condecls
-  = mappM (wrapLocM rnConDecl) condecls
-
-rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
-rnConDecl (ConDecl name expl tvs cxt details res_ty)
-  = do	{ addLocM checkConName name
-
-	; new_name <- lookupLocatedTopBndrRn name
-	; name_env <- getLocalRdrEnv
-	
-	-- For H98 syntax, the tvs are the existential ones
-	-- For GADT syntax, the tvs are all the quantified tyvars
-	-- Hence the 'filter' in the ResTyH98 case only
-	; let not_in_scope  = not . (`elemLocalRdrEnv` name_env) . unLoc
-	      arg_tys       = hsConArgs details
-	      implicit_tvs  = case res_ty of
-	      	    		ResTyH98 -> filter not_in_scope $
-						get_rdr_tvs arg_tys
-	      	    		ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
-	      tvs' = case expl of
-	        	Explicit -> tvs
-		    	Implicit -> userHsTyVarBndrs implicit_tvs
-
-	; bindTyVarsRn doc tvs' $ \new_tyvars -> do
-	{ new_context <- rnContext doc cxt
-        ; new_details <- rnConDetails doc details
-        ; new_res_ty  <- rnConResult doc res_ty
-        ; let rv = ConDecl new_name expl new_tyvars new_context new_details new_res_ty
-        ; traceRn (text "****** - autrijus" <> ppr rv)
-        ; return rv } }
-  where
-    doc = text "In the definition of data constructor" <+> quotes (ppr name)
-    get_rdr_tvs tys  = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
-
-rnConResult _ ResTyH98 = return ResTyH98
-rnConResult doc (ResTyGADT ty) = do
-    ty' <- rnHsSigType doc ty
-    return $ ResTyGADT ty'
-
-rnConDetails doc (PrefixCon tys)
-  = mappM (rnLHsType doc) tys	`thenM` \ new_tys  ->
-    returnM (PrefixCon new_tys)
-
-rnConDetails doc (InfixCon ty1 ty2)
-  = rnLHsType doc ty1  		`thenM` \ new_ty1 ->
-    rnLHsType doc ty2  		`thenM` \ new_ty2 ->
-    returnM (InfixCon new_ty1 new_ty2)
-
-rnConDetails doc (RecCon fields)
-  = checkDupNames doc field_names	`thenM_`
-    mappM (rnField doc) fields		`thenM` \ new_fields ->
-    returnM (RecCon new_fields)
-  where
-    field_names = [fld | (fld, _) <- fields]
-
-rnField doc (name, ty)
-  = lookupLocatedTopBndrRn name	`thenM` \ new_name ->
-    rnLHsType doc ty		`thenM` \ new_ty ->
-    returnM (new_name, new_ty) 
-
--- This data decl will parse OK
---	data T = a Int
--- treating "a" as the constructor.
--- It is really hard to make the parser spot this malformation.
--- So the renamer has to check that the constructor is legal
---
--- We can get an operator as the constructor, even in the prefix form:
---	data T = :% Int Int
--- from interface files, which always print in prefix form
-
-checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
-
-badDataCon name
-   = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
-\end{code}
-
-
-%*********************************************************
-%*							*
-\subsection{Support code to rename types}
-%*							*
-%*********************************************************
-
-\begin{code}
-rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
-
-rnFds doc fds
-  = mappM (wrapLocM rn_fds) fds
-  where
-    rn_fds (tys1, tys2)
-      =	rnHsTyVars doc tys1		`thenM` \ tys1' ->
-	rnHsTyVars doc tys2		`thenM` \ tys2' ->
-	returnM (tys1', tys2')
-
-rnHsTyVars doc tvs  = mappM (rnHsTyvar doc) tvs
-rnHsTyvar doc tyvar = lookupOccRn tyvar
-\end{code}
-
-
-%*********************************************************
-%*							*
-		Splices
-%*							*
-%*********************************************************
-
-Note [Splices]
-~~~~~~~~~~~~~~
-Consider
-	f = ...
-	h = ...$(thing "f")...
-
-The splice can expand into literally anything, so when we do dependency
-analysis we must assume that it might mention 'f'.  So we simply treat
-all locally-defined names as mentioned by any splice.  This is terribly
-brutal, but I don't see what else to do.  For example, it'll mean
-that every locally-defined thing will appear to be used, so no unused-binding
-warnings.  But if we miss the dependency, then we might typecheck 'h' before 'f',
-and that will crash the type checker because 'f' isn't in scope.
-
-Currently, I'm not treating a splice as also mentioning every import,
-which is a bit inconsistent -- but there are a lot of them.  We might
-thereby get some bogus unused-import warnings, but we won't crash the
-type checker.  Not very satisfactory really.
-
-\begin{code}
-rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
-rnSplice (HsSplice n expr)
-  = do	{ checkTH expr "splice"
-	; loc  <- getSrcSpanM
-	; [n'] <- newLocalsRn [L loc n]
-	; (expr', fvs) <- rnLExpr expr
-
-	-- Ugh!  See Note [Splices] above
-	; lcl_rdr <- getLocalRdrEnv
-	; gbl_rdr <- getGlobalRdrEnv
-	; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr, 
-						    isLocalGRE gre]
-	      lcl_names = mkNameSet (occEnvElts lcl_rdr)
-
-	; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
-
-#ifdef GHCI 
-checkTH e what = returnM ()	-- OK
-#else
-checkTH e what 	-- Raise an error in a stage-1 compiler
-  = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>  
-	          ptext SLIT("illegal in a stage-1 compiler"),
-	          nest 2 (ppr e)])
-#endif   
-\end{code}
diff --git a/ghc/compiler/rename/RnTypes.lhs b/ghc/compiler/rename/RnTypes.lhs
deleted file mode 100644
index d7d435ce97..0000000000
--- a/ghc/compiler/rename/RnTypes.lhs
+++ /dev/null
@@ -1,766 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[RnSource]{Main pass of renamer}
-
-\begin{code}
-module RnTypes ( 
-	-- Type related stuff
-	rnHsType, rnLHsType, rnLHsTypes, rnContext,
-	rnHsSigType, rnHsTypeFVs,
-
-	-- Patterns and literals
-	rnLPat, rnPat, rnPatsAndThen,	-- Here because it's not part 
-	rnLit, rnOverLit, 		-- of any mutual recursion	
-
-	-- Precence related stuff
-	mkOpAppRn, mkNegAppRn, mkOpFormRn, 
-	checkPrecMatch, checkSectionPrec, 
-	
-	-- Error messages
-	dupFieldErr, patSigErr, checkTupSize
-  ) where
-
-import DynFlags		( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts) )
-
-import HsSyn
-import RdrHsSyn		( extractHsRhoRdrTyVars )
-import RnHsSyn		( extractHsTyNames, parrTyCon_name, tupleTyCon_name, 
-			  listTyCon_name
-			)
-import RnEnv		( lookupOccRn, lookupBndrRn, lookupSyntaxName,
-			  lookupLocatedOccRn, lookupLocatedBndrRn,
-			  lookupLocatedGlobalOccRn, bindTyVarsRn, 
-			  lookupFixityRn, lookupTyFixityRn,
-			  mapFvRn, warnUnusedMatches,
-			  newIPNameRn, bindPatSigTyVarsFV, bindLocatedLocalsFV )
-import TcRnMonad
-import RdrName		( RdrName, elemLocalRdrEnv )
-import PrelNames	( eqClassName, integralClassName, geName, eqName,
-		  	  negateName, minusName, lengthPName, indexPName,
-			  plusIntegerName, fromIntegerName, timesIntegerName,
-			  ratioDataConName, fromRationalName )
-import TypeRep		( funTyCon )
-import Constants	( mAX_TUPLE_SIZE )
-import Name		( Name )
-import SrcLoc		( SrcSpan, Located(..), unLoc, noLoc, combineLocs )
-import NameSet
-
-import Literal		( inIntRange, inCharRange )
-import BasicTypes	( compareFixity, funTyFixity, negateFixity, 
-			  Fixity(..), FixityDirection(..) )
-import ListSetOps	( removeDups )
-import Outputable
-
-#include "HsVersions.h"
-\end{code}
-
-These type renamers are in a separate module, rather than in (say) RnSource,
-to break several loop.
-
-%*********************************************************
-%*							*
-\subsection{Renaming types}
-%*							*
-%*********************************************************
-
-\begin{code}
-rnHsTypeFVs :: SDoc -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
-rnHsTypeFVs doc_str ty 
-  = rnLHsType doc_str ty	`thenM` \ ty' ->
-    returnM (ty', extractHsTyNames ty')
-
-rnHsSigType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
-	-- rnHsSigType is used for source-language type signatures,
-	-- which use *implicit* universal quantification.
-rnHsSigType doc_str ty
-  = rnLHsType (text "In the type signature for" <+> doc_str) ty
-\end{code}
-
-rnHsType is here because we call it from loadInstDecl, and I didn't
-want a gratuitous knot.
-
-\begin{code}
-rnLHsType  :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
-rnLHsType doc = wrapLocM (rnHsType doc)
-
-rnHsType :: SDoc -> HsType RdrName -> RnM (HsType Name)
-
-rnHsType doc (HsForAllTy Implicit _ ctxt ty)
-	-- Implicit quantifiction in source code (no kinds on tyvars)
-	-- Given the signature  C => T  we universally quantify 
-	-- over FV(T) \ {in-scope-tyvars} 
-  = getLocalRdrEnv		`thenM` \ name_env ->
-    let
-	mentioned = extractHsRhoRdrTyVars ctxt ty
-
-	-- Don't quantify over type variables that are in scope;
-	-- when GlasgowExts is off, there usually won't be any, except for
-	-- class signatures:
-	--	class C a where { op :: a -> a }
-	forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env) . unLoc) mentioned
-	tyvar_bndrs   = userHsTyVarBndrs forall_tyvars
-    in
-    rnForAll doc Implicit tyvar_bndrs ctxt ty
-
-rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau)
-	-- Explicit quantification.
-	-- Check that the forall'd tyvars are actually 
-	-- mentioned in the type, and produce a warning if not
-  = let
-	mentioned	   = map unLoc (extractHsRhoRdrTyVars ctxt tau)
-	forall_tyvar_names = hsLTyVarLocNames forall_tyvars
-
-	-- Explicitly quantified but not mentioned in ctxt or tau
-	warn_guys = filter ((`notElem` mentioned) . unLoc) forall_tyvar_names
-    in
-    mappM_ (forAllWarn doc tau) warn_guys	`thenM_`
-    rnForAll doc Explicit forall_tyvars ctxt tau
-
-rnHsType doc (HsTyVar tyvar)
-  = lookupOccRn tyvar 		`thenM` \ tyvar' ->
-    returnM (HsTyVar tyvar')
-
-rnHsType doc (HsOpTy ty1 (L loc op) ty2)
-  = setSrcSpan loc (
-      lookupOccRn op			`thenM` \ op' ->
-      let
-	l_op' = L loc op'
-      in
-      lookupTyFixityRn l_op'		`thenM` \ fix ->
-      rnLHsType doc ty1			`thenM` \ ty1' ->
-      rnLHsType doc ty2			`thenM` \ ty2' -> 
-      mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) (ppr op') fix ty1' ty2'
-   )
-
-rnHsType doc (HsParTy ty)
-  = rnLHsType doc ty 	        `thenM` \ ty' ->
-    returnM (HsParTy ty')
-
-rnHsType doc (HsBangTy b ty)
-  = rnLHsType doc ty 	        `thenM` \ ty' ->
-    returnM (HsBangTy b ty')
-
-rnHsType doc (HsNumTy i)
-  | i == 1    = returnM (HsNumTy i)
-  | otherwise = addErr err_msg	`thenM_`  returnM (HsNumTy i)
-  where
-    err_msg = ptext SLIT("Only unit numeric type pattern is valid")
-			   
-
-rnHsType doc (HsFunTy ty1 ty2)
-  = rnLHsType doc ty1	`thenM` \ ty1' ->
-	-- Might find a for-all as the arg of a function type
-    rnLHsType doc ty2	`thenM` \ ty2' ->
-	-- Or as the result.  This happens when reading Prelude.hi
-	-- when we find return :: forall m. Monad m -> forall a. a -> m a
-
-	-- Check for fixity rearrangements
-    mkHsOpTyRn HsFunTy (ppr funTyCon) funTyFixity ty1' ty2'
-
-rnHsType doc (HsListTy ty)
-  = rnLHsType doc ty				`thenM` \ ty' ->
-    returnM (HsListTy ty')
-
-rnHsType doc (HsKindSig ty k)
-  = rnLHsType doc ty				`thenM` \ ty' ->
-    returnM (HsKindSig ty' k)
-
-rnHsType doc (HsPArrTy ty)
-  = rnLHsType doc ty				`thenM` \ ty' ->
-    returnM (HsPArrTy ty')
-
--- Unboxed tuples are allowed to have poly-typed arguments.  These
--- sometimes crop up as a result of CPR worker-wrappering dictionaries.
-rnHsType doc (HsTupleTy tup_con tys)
-  = mappM (rnLHsType doc) tys	  	`thenM` \ tys' ->
-    returnM (HsTupleTy tup_con tys')
-
-rnHsType doc (HsAppTy ty1 ty2)
-  = rnLHsType doc ty1		`thenM` \ ty1' ->
-    rnLHsType doc ty2		`thenM` \ ty2' ->
-    returnM (HsAppTy ty1' ty2')
-
-rnHsType doc (HsPredTy pred)
-  = rnPred doc pred	`thenM` \ pred' ->
-    returnM (HsPredTy pred')
-
-rnHsType doc (HsSpliceTy _)
-  = do	{ addErr (ptext SLIT("Type splices are not yet implemented"))
- 	; failM }
-
-rnLHsTypes doc tys = mappM (rnLHsType doc) tys
-\end{code}
-
-
-\begin{code}
-rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
-	 -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
-
-rnForAll doc exp [] (L _ []) (L _ ty) = rnHsType doc ty
-	-- One reason for this case is that a type like Int#
-	-- starts off as (HsForAllTy Nothing [] Int), in case
-	-- there is some quantification.  Now that we have quantified
-	-- and discovered there are no type variables, it's nicer to turn
-	-- it into plain Int.  If it were Int# instead of Int, we'd actually
-	-- get an error, because the body of a genuine for-all is
-	-- of kind *.
-
-rnForAll doc exp forall_tyvars ctxt ty
-  = bindTyVarsRn doc forall_tyvars	$ \ new_tyvars ->
-    rnContext doc ctxt			`thenM` \ new_ctxt ->
-    rnLHsType doc ty			`thenM` \ new_ty ->
-    returnM (HsForAllTy exp new_tyvars new_ctxt new_ty)
-	-- Retain the same implicit/explicit flag as before
-	-- so that we can later print it correctly
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Fixities and precedence parsing
-%*									*
-%************************************************************************
-
-@mkOpAppRn@ deals with operator fixities.  The argument expressions
-are assumed to be already correctly arranged.  It needs the fixities
-recorded in the OpApp nodes, because fixity info applies to the things
-the programmer actually wrote, so you can't find it out from the Name.
-
-Furthermore, the second argument is guaranteed not to be another
-operator application.  Why? Because the parser parses all
-operator appications left-associatively, EXCEPT negation, which
-we need to handle specially.
-Infix types are read in a *right-associative* way, so that
-	a `op` b `op` c
-is always read in as
-	a `op` (b `op` c)
-
-mkHsOpTyRn rearranges where necessary.  The two arguments
-have already been renamed and rearranged.  It's made rather tiresome
-by the presence of ->, which is a separate syntactic construct.
-
-\begin{code}
----------------
--- Building (ty1 `op1` (ty21 `op2` ty22))
-mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
-	   -> SDoc -> Fixity -> LHsType Name -> LHsType Name 
-	   -> RnM (HsType Name)
-
-mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
-  = do  { fix2 <- lookupTyFixityRn op2
-	; mk_hs_op_ty mk1 pp_op1 fix1 ty1 
-		      (\t1 t2 -> HsOpTy t1 op2 t2)
-		      (ppr op2) fix2 ty21 ty22 loc2 }
-
-mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2@(L loc2 (HsFunTy ty21 ty22))
-  = mk_hs_op_ty mk1 pp_op1 fix1 ty1 
-		HsFunTy (ppr funTyCon) funTyFixity ty21 ty22 loc2
-
-mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2 		-- Default case, no rearrangment
-  = return (mk1 ty1 ty2)
-
----------------
-mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
-	    -> SDoc -> Fixity -> LHsType Name
-	    -> (LHsType Name -> LHsType Name -> HsType Name)
-	    -> SDoc -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
-	    -> RnM (HsType Name)
-mk_hs_op_ty mk1 pp_op1 fix1 ty1 
-	    mk2 pp_op2 fix2 ty21 ty22 loc2
-  | nofix_error     = do { addErr (precParseErr (quotes pp_op1,fix1) 
-			 		        (quotes pp_op2,fix2))
-		         ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
-  | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
-  | otherwise	    = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
-			   new_ty <- mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty21
-			 ; return (mk2 (noLoc new_ty) ty22) }
-  where
-    (nofix_error, associate_right) = compareFixity fix1 fix2
-
-
----------------------------
-mkOpAppRn :: LHsExpr Name			-- Left operand; already rearranged
-	  -> LHsExpr Name -> Fixity 		-- Operator and fixity
-	  -> LHsExpr Name			-- Right operand (not an OpApp, but might
-						-- be a NegApp)
-	  -> RnM (HsExpr Name)
-
--- (e11 `op1` e12) `op2` e2
-mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
-  | nofix_error
-  = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))	`thenM_`
-    returnM (OpApp e1 op2 fix2 e2)
-
-  | associate_right
-  = mkOpAppRn e12 op2 fix2 e2		`thenM` \ new_e ->
-    returnM (OpApp e11 op1 fix1 (L loc' new_e))
-  where
-    loc'= combineLocs e12 e2
-    (nofix_error, associate_right) = compareFixity fix1 fix2
-
----------------------------
---	(- neg_arg) `op` e2
-mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
-  | nofix_error
-  = addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2))	`thenM_`
-    returnM (OpApp e1 op2 fix2 e2)
-
-  | associate_right
-  = mkOpAppRn neg_arg op2 fix2 e2	`thenM` \ new_e ->
-    returnM (NegApp (L loc' new_e) neg_name)
-  where
-    loc' = combineLocs neg_arg e2
-    (nofix_error, associate_right) = compareFixity negateFixity fix2
-
----------------------------
---	e1 `op` - neg_arg
-mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp neg_arg _))	-- NegApp can occur on the right
-  | not associate_right				-- We *want* right association
-  = addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity))	`thenM_`
-    returnM (OpApp e1 op1 fix1 e2)
-  where
-    (_, associate_right) = compareFixity fix1 negateFixity
-
----------------------------
---	Default case
-mkOpAppRn e1 op fix e2 			-- Default case, no rearrangment
-  = ASSERT2( right_op_ok fix (unLoc e2),
-	     ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
-    )
-    returnM (OpApp e1 op fix e2)
-
--- Parser left-associates everything, but 
--- derived instances may have correctly-associated things to
--- in the right operarand.  So we just check that the right operand is OK
-right_op_ok fix1 (OpApp _ _ fix2 _)
-  = not error_please && associate_right
-  where
-    (error_please, associate_right) = compareFixity fix1 fix2
-right_op_ok fix1 other
-  = True
-
--- Parser initially makes negation bind more tightly than any other operator
--- And "deriving" code should respect this (use HsPar if not)
-mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
-mkNegAppRn neg_arg neg_name
-  = ASSERT( not_op_app (unLoc neg_arg) )
-    returnM (NegApp neg_arg neg_name)
-
-not_op_app (OpApp _ _ _ _) = False
-not_op_app other	   = True
-
----------------------------
-mkOpFormRn :: LHsCmdTop Name		-- Left operand; already rearranged
-	  -> LHsExpr Name -> Fixity 	-- Operator and fixity
-	  -> LHsCmdTop Name		-- Right operand (not an infix)
-	  -> RnM (HsCmd Name)
-
--- (e11 `op1` e12) `op2` e2
-mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
-	op2 fix2 a2
-  | nofix_error
-  = addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))	`thenM_`
-    returnM (HsArrForm op2 (Just fix2) [a1, a2])
-
-  | associate_right
-  = mkOpFormRn a12 op2 fix2 a2		`thenM` \ new_c ->
-    returnM (HsArrForm op1 (Just fix1)
-	[a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
-	-- TODO: locs are wrong
-  where
-    (nofix_error, associate_right) = compareFixity fix1 fix2
-
---	Default case
-mkOpFormRn arg1 op fix arg2 			-- Default case, no rearrangment
-  = returnM (HsArrForm op (Just fix) [arg1, arg2])
-
-
---------------------------------------
-mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
-	     -> RnM (Pat Name)
-
-mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
-  = lookupFixityRn (unLoc op1)	`thenM` \ fix1 ->
-    let
-	(nofix_error, associate_right) = compareFixity fix1 fix2
-    in
-    if nofix_error then
-	addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))	`thenM_`
-	returnM (ConPatIn op2 (InfixCon p1 p2))
-    else 
-    if associate_right then
-	mkConOpPatRn op2 fix2 p12 p2		`thenM` \ new_p ->
-	returnM (ConPatIn op1 (InfixCon p11 (L loc new_p)))  -- XXX loc right?
-    else
-    returnM (ConPatIn op2 (InfixCon p1 p2))
-
-mkConOpPatRn op fix p1 p2 			-- Default case, no rearrangment
-  = ASSERT( not_op_pat (unLoc p2) )
-    returnM (ConPatIn op (InfixCon p1 p2))
-
-not_op_pat (ConPatIn _ (InfixCon _ _)) = False
-not_op_pat other   	               = True
-
---------------------------------------
-checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
-	-- True indicates an infix lhs
-	-- See comments with rnExpr (OpApp ...) about "deriving"
-
-checkPrecMatch False fn match 
-  = returnM ()
-checkPrecMatch True op (MatchGroup ms _)	
-  = mapM_ check ms			 	
-  where
-    check (L _ (Match (p1:p2:_) _ _))
-      = checkPrec op (unLoc p1) False	`thenM_`
-        checkPrec op (unLoc p2) True
-
-    check _ = panic "checkPrecMatch"
-
-checkPrec op (ConPatIn op1 (InfixCon _ _)) right
-  = lookupFixityRn op		`thenM` \  op_fix@(Fixity op_prec  op_dir) ->
-    lookupFixityRn (unLoc op1)	`thenM` \ op1_fix@(Fixity op1_prec op1_dir) ->
-    let
-	inf_ok = op1_prec > op_prec || 
-	         (op1_prec == op_prec &&
-		  (op1_dir == InfixR && op_dir == InfixR && right ||
-		   op1_dir == InfixL && op_dir == InfixL && not right))
-
-	info  = (ppr_op op,  op_fix)
-	info1 = (ppr_op op1, op1_fix)
-	(infol, infor) = if right then (info, info1) else (info1, info)
-    in
-    checkErr inf_ok (precParseErr infol infor)
-
-checkPrec op pat right
-  = returnM ()
-
--- Check precedence of (arg op) or (op arg) respectively
--- If arg is itself an operator application, then either
---   (a) its precedence must be higher than that of op
---   (b) its precedency & associativity must be the same as that of op
-checkSectionPrec :: FixityDirection -> HsExpr RdrName
-	-> LHsExpr Name -> LHsExpr Name -> RnM ()
-checkSectionPrec direction section op arg
-  = case unLoc arg of
-	OpApp _ op fix _ -> go_for_it (ppr_op op)     fix
-	NegApp _ _	 -> go_for_it pp_prefix_minus negateFixity
-	other		 -> returnM ()
-  where
-    L _ (HsVar op_name) = op
-    go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc)
-	= lookupFixityRn op_name	`thenM` \ op_fix@(Fixity op_prec _) ->
-	  checkErr (op_prec < arg_prec
-		     || op_prec == arg_prec && direction == assoc)
-		  (sectionPrecErr (ppr_op op_name, op_fix) 	
-		  (pp_arg_op, arg_fix) section)
-\end{code}
-
-Precedence-related error messages
-
-\begin{code}
-precParseErr op1 op2 
-  = hang (ptext SLIT("precedence parsing error"))
-      4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"), 
-	       ppr_opfix op2,
-	       ptext SLIT("in the same infix expression")])
-
-sectionPrecErr op arg_op section
- = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
-	 nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
-	 nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
-
-pp_prefix_minus = ptext SLIT("prefix `-'")
-ppr_op op = quotes (ppr op)	-- Here, op can be a Name or a (Var n), where n is a Name
-ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{Contexts and predicates}
-%*							*
-%*********************************************************
-
-\begin{code}
-rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
-rnContext doc = wrapLocM (rnContext' doc)
-
-rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
-rnContext' doc ctxt = mappM (rnLPred doc) ctxt
-
-rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
-rnLPred doc  = wrapLocM (rnPred doc)
-
-rnPred doc (HsClassP clas tys)
-  = lookupOccRn clas		`thenM` \ clas_name ->
-    rnLHsTypes doc tys		`thenM` \ tys' ->
-    returnM (HsClassP clas_name tys')
-
-rnPred doc (HsIParam n ty)
-  = newIPNameRn n		`thenM` \ name ->
-    rnLHsType doc ty		`thenM` \ ty' ->
-    returnM (HsIParam name ty')
-\end{code}
-
-
-*********************************************************
-*							*
-\subsection{Patterns}
-*							*
-*********************************************************
-
-\begin{code}
-rnPatsAndThen :: HsMatchContext Name
-	      -> [LPat RdrName] 
-	      -> ([LPat Name] -> RnM (a, FreeVars))
-	      -> RnM (a, FreeVars)
--- Bring into scope all the binders and type variables
--- bound by the patterns; then rename the patterns; then
--- do the thing inside.
---
--- Note that we do a single bindLocalsRn for all the
--- matches together, so that we spot the repeated variable in
---	f x x = 1
-
-rnPatsAndThen ctxt pats thing_inside
-  = bindPatSigTyVarsFV pat_sig_tys 	$
-    bindLocatedLocalsFV doc_pat bndrs	$ \ new_bndrs ->
-    rnLPats pats			`thenM` \ (pats', pat_fvs) ->
-    thing_inside pats'			`thenM` \ (res, res_fvs) ->
-
-    let
-	unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
-    in
-    warnUnusedMatches unused_binders   `thenM_`
-    returnM (res, res_fvs `plusFV` pat_fvs)
-  where
-    pat_sig_tys = collectSigTysFromPats pats
-    bndrs 	= collectLocatedPatsBinders pats
-    doc_pat     = ptext SLIT("In") <+> pprMatchContext ctxt
-
-rnLPats :: [LPat RdrName] -> RnM ([LPat Name], FreeVars)
-rnLPats ps = mapFvRn rnLPat ps
-
-rnLPat :: LPat RdrName -> RnM (LPat Name, FreeVars)
-rnLPat = wrapLocFstM rnPat
-
--- -----------------------------------------------------------------------------
--- rnPat
-
-rnPat :: Pat RdrName -> RnM (Pat Name, FreeVars)
-
-rnPat (WildPat _) = returnM (WildPat placeHolderType, emptyFVs)
-
-rnPat (VarPat name)
-  = lookupBndrRn  name			`thenM` \ vname ->
-    returnM (VarPat vname, emptyFVs)
-
-rnPat (SigPatIn pat ty)
-  = doptM Opt_GlasgowExts `thenM` \ glaExts ->
-    
-    if glaExts
-    then rnLPat pat		`thenM` \ (pat', fvs1) ->
-         rnHsTypeFVs doc ty	`thenM` \ (ty',  fvs2) ->
-         returnM (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
-
-    else addErr (patSigErr ty)	`thenM_`
-         rnPat (unLoc pat) -- XXX shouldn't throw away the loc
-  where
-    doc = text "In a pattern type-signature"
-    
-rnPat (LitPat lit) 
-  = rnLit lit 	`thenM_` 
-    returnM (LitPat lit, emptyFVs) 
-
-rnPat (NPat lit mb_neg eq _) 
-  = rnOverLit lit			`thenM` \ (lit', fvs1) ->
-    (case mb_neg of
-	Nothing -> returnM (Nothing, emptyFVs)
-	Just _  -> lookupSyntaxName negateName	`thenM` \ (neg, fvs) ->
-		   returnM (Just neg, fvs)
-    )					`thenM` \ (mb_neg', fvs2) ->
-    lookupSyntaxName eqName		`thenM` \ (eq', fvs3) -> 
-    returnM (NPat lit' mb_neg' eq' placeHolderType, 
-	      fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` eqClassName)	
-	-- Needed to find equality on pattern
-
-rnPat (NPlusKPat name lit _ _)
-  = rnOverLit lit			`thenM` \ (lit', fvs1) ->
-    lookupLocatedBndrRn name		`thenM` \ name' ->
-    lookupSyntaxName minusName		`thenM` \ (minus, fvs2) ->
-    lookupSyntaxName geName		`thenM` \ (ge, fvs3) ->
-    returnM (NPlusKPat name' lit' ge minus,
-	     fvs1 `plusFV` fvs2 `plusFV` fvs3 `addOneFV` integralClassName)
-	-- The Report says that n+k patterns must be in Integral
-
-rnPat (LazyPat pat)
-  = rnLPat pat		`thenM` \ (pat', fvs) ->
-    returnM (LazyPat pat', fvs)
-
-rnPat (BangPat pat)
-  = rnLPat pat		`thenM` \ (pat', fvs) ->
-    returnM (BangPat pat', fvs)
-
-rnPat (AsPat name pat)
-  = rnLPat pat			`thenM` \ (pat', fvs) ->
-    lookupLocatedBndrRn name	`thenM` \ vname ->
-    returnM (AsPat vname pat', fvs)
-
-rnPat (ConPatIn con stuff) = rnConPat con stuff
-
-
-rnPat (ParPat pat)
-  = rnLPat pat		`thenM` \ (pat', fvs) ->
-    returnM (ParPat pat', fvs)
-
-rnPat (ListPat pats _)
-  = rnLPats pats			`thenM` \ (patslist, fvs) ->
-    returnM (ListPat patslist placeHolderType, fvs `addOneFV` listTyCon_name)
-
-rnPat (PArrPat pats _)
-  = rnLPats pats			`thenM` \ (patslist, fvs) ->
-    returnM (PArrPat patslist placeHolderType, 
-	      fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
-  where
-    implicit_fvs = mkFVs [lengthPName, indexPName]
-
-rnPat (TuplePat pats boxed _)
-  = checkTupSize tup_size	`thenM_`
-    rnLPats pats			`thenM` \ (patslist, fvs) ->
-    returnM (TuplePat patslist boxed placeHolderType, 
-	     fvs `addOneFV` tycon_name)
-  where
-    tup_size   = length pats
-    tycon_name = tupleTyCon_name boxed tup_size
-
-rnPat (TypePat name) =
-    rnHsTypeFVs (text "In a type pattern") name	`thenM` \ (name', fvs) ->
-    returnM (TypePat name', fvs)
-
--- -----------------------------------------------------------------------------
--- rnConPat
-
-rnConPat con (PrefixCon pats)
-  = lookupLocatedOccRn con 	`thenM` \ con' ->
-    rnLPats pats		`thenM` \ (pats', fvs) ->
-    returnM (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` unLoc con')
-
-rnConPat con (RecCon rpats)
-  = lookupLocatedOccRn con 	`thenM` \ con' ->
-    rnRpats rpats		`thenM` \ (rpats', fvs) ->
-    returnM (ConPatIn con' (RecCon rpats'), fvs `addOneFV` unLoc con')
-
-rnConPat con (InfixCon pat1 pat2)
-  = lookupLocatedOccRn con			`thenM` \ con' ->
-    rnLPat pat1					`thenM` \ (pat1', fvs1) ->
-    rnLPat pat2					`thenM` \ (pat2', fvs2) ->
-    lookupFixityRn (unLoc con')			`thenM` \ fixity ->
-    mkConOpPatRn con' fixity pat1' pat2'	`thenM` \ pat' ->
-    returnM (pat', fvs1 `plusFV` fvs2 `addOneFV` unLoc con')
-
--- -----------------------------------------------------------------------------
--- rnRpats
-
-rnRpats :: [(Located RdrName, LPat RdrName)]
-        -> RnM ([(Located Name, LPat Name)], FreeVars)
-rnRpats rpats
-  = mappM_ field_dup_err dup_fields 	`thenM_`
-    mapFvRn rn_rpat rpats		`thenM` \ (rpats', fvs) ->
-    returnM (rpats', fvs)
-  where
-    (_, dup_fields) = removeDups compare [ unLoc f | (f,_) <- rpats ]
-
-    field_dup_err dups = addErr (dupFieldErr "pattern" dups)
-
-    rn_rpat (field, pat)
-      = lookupLocatedGlobalOccRn field	`thenM` \ fieldname ->
-	rnLPat pat			`thenM` \ (pat', fvs) ->
-	returnM ((fieldname, pat'), fvs `addOneFV` unLoc fieldname)
-
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{Literals}
-%*									*
-%************************************************************************
-
-When literals occur we have to make sure
-that the types and classes they involve
-are made available.
-
-\begin{code}
-rnLit :: HsLit -> RnM ()
-rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
-rnLit other	 = returnM ()
-
-rnOverLit (HsIntegral i _)
-  = lookupSyntaxName fromIntegerName	`thenM` \ (from_integer_name, fvs) ->
-    if inIntRange i then
-	returnM (HsIntegral i from_integer_name, fvs)
-    else let
-	extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
-	-- Big integer literals are built, using + and *, 
-	-- out of small integers (DsUtils.mkIntegerLit)
-	-- [NB: plusInteger, timesInteger aren't rebindable... 
-	--	they are used to construct the argument to fromInteger, 
-	--	which is the rebindable one.]
-    in
-    returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
-
-rnOverLit (HsFractional i _)
-  = lookupSyntaxName fromRationalName		`thenM` \ (from_rat_name, fvs) ->
-    let
-	extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
-	-- We have to make sure that the Ratio type is imported with
-	-- its constructor, because literals of type Ratio t are
-	-- built with that constructor.
-	-- The Rational type is needed too, but that will come in
-	-- as part of the type for fromRational.
-	-- The plus/times integer operations may be needed to construct the numerator
-	-- and denominator (see DsUtils.mkIntegerLit)
-    in
-    returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
-\end{code}
-
-
-
-%*********************************************************
-%*							*
-\subsection{Errors}
-%*							*
-%*********************************************************
-
-\begin{code}
-checkTupSize :: Int -> RnM ()
-checkTupSize tup_size
-  | tup_size <= mAX_TUPLE_SIZE 
-  = returnM ()
-  | otherwise		       
-  = addErr (sep [ptext SLIT("A") <+> int tup_size <> ptext SLIT("-tuple is too large for GHC"),
-		 nest 2 (parens (ptext SLIT("max size is") <+> int mAX_TUPLE_SIZE)),
-		 nest 2 (ptext SLIT("Workaround: use nested tuples or define a data type"))])
-
-forAllWarn doc ty (L loc tyvar)
-  = ifOptM Opt_WarnUnusedMatches 	$
-    setSrcSpan loc $
-    addWarn (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
-		   nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
-		   $$
-		   doc
-                )
-
-bogusCharError c
-  = ptext SLIT("character literal out of range: '\\") <> char c  <> char '\''
-
-patSigErr ty
-  =  (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
-	$$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
-
-dupFieldErr str dup
-  = hsep [ptext SLIT("duplicate field name"), 
-          quotes (ppr dup),
-	  ptext SLIT("in record"), text str]
-\end{code}
diff --git a/ghc/compiler/rename/rename.tex b/ghc/compiler/rename/rename.tex
deleted file mode 100644
index b3f8e1d770..0000000000
--- a/ghc/compiler/rename/rename.tex
+++ /dev/null
@@ -1,18 +0,0 @@
-\documentstyle{report}
-\input{lit-style}
-
-\begin{document}
-\centerline{{\Large{rename}}}
-\tableofcontents
-
-\input{Rename}    % {Renaming and dependency analysis passes}
-\input{RnSource}  % {Main pass of renamer}
-\input{RnMonad}   % {The monad used by the renamer}
-\input{RnEnv}     % {Environment manipulation for the renamer monad}
-\input{RnHsSyn}   % {Specialisations of the @HsSyn@ syntax for the renamer}
-\input{RnNames}   % {Extracting imported and top-level names in scope}
-\input{RnExpr}    % {Renaming of expressions}
-\input{RnBinds}   % {Renaming and dependency analysis of bindings}
-\input{RnIfaces}  % {Cacheing and Renaming of Interfaces}
-
-\end{document}
diff --git a/ghc/compiler/simplCore/CSE.lhs b/ghc/compiler/simplCore/CSE.lhs
deleted file mode 100644
index 2e8489a295..0000000000
--- a/ghc/compiler/simplCore/CSE.lhs
+++ /dev/null
@@ -1,290 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1993-1998
-%
-\section{Common subexpression}
-
-\begin{code}
-module CSE (
-	cseProgram
-    ) where
-
-#include "HsVersions.h"
-
-import DynFlags	( DynFlag(..), DynFlags )
-import Id		( Id, idType, idWorkerInfo )
-import IdInfo		( workerExists )
-import CoreUtils	( hashExpr, cheapEqExpr, exprIsBig, mkAltExpr, exprIsCheap )
-import DataCon		( isUnboxedTupleCon )
-import Type		( tyConAppArgs )
-import CoreSyn
-import VarEnv	
-import CoreLint		( showPass, endPass )
-import Outputable
-import Util		( mapAccumL, lengthExceeds )
-import UniqFM
-\end{code}
-
-
-			Simple common sub-expression
-			~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When we see
-	x1 = C a b
-	x2 = C x1 b
-we build up a reverse mapping:   C a b  -> x1
-				 C x1 b -> x2
-and apply that to the rest of the program.
-
-When we then see
-	y1 = C a b
-	y2 = C y1 b
-we replace the C a b with x1.  But then we *dont* want to
-add   x1 -> y1  to the mapping.  Rather, we want the reverse, y1 -> x1
-so that a subsequent binding
-	y2 = C y1 b
-will get transformed to C x1 b, and then to x2.  
-
-So we carry an extra var->var substitution which we apply *before* looking up in the
-reverse mapping.
-
-
-[Note: SHADOWING]
-~~~~~~~~~~~~~~~~~
-We have to be careful about shadowing.
-For example, consider
-	f = \x -> let y = x+x in
-	              h = \x -> x+x
-	          in ...
-
-Here we must *not* do CSE on the inner x+x!  The simplifier used to guarantee no
-shadowing, but it doesn't any more (it proved too hard), so we clone as we go.
-We can simply add clones to the substitution already described.
-
-However, we do NOT clone type variables.  It's just too hard, because then we need
-to run the substitution over types and IdInfo.  No no no.  Instead, we just throw
-
-(In fact, I think the simplifier does guarantee no-shadowing for type variables.)
-
-
-[Note: case binders 1]
-~~~~~~~~~~~~~~~~~~~~~~
-Consider
-
-	f = \x -> case x of wild { 
-			(a:as) -> case a of wild1 {
-				    (p,q) -> ...(wild1:as)...
-
-Here, (wild1:as) is morally the same as (a:as) and hence equal to wild.
-But that's not quite obvious.  In general we want to keep it as (wild1:as),
-but for CSE purpose that's a bad idea.
-
-So we add the binding (wild1 -> a) to the extra var->var mapping.
-Notice this is exactly backwards to what the simplifier does, which is
-to try to replaces uses of a with uses of wild1
-
-[Note: case binders 2]
-~~~~~~~~~~~~~~~~~~~~~~
-Consider
-	case (h x) of y -> ...(h x)...
-
-We'd like to replace (h x) in the alternative, by y.  But because of
-the preceding [Note: case binders 1], we only want to add the mapping
-	scrutinee -> case binder
-to the reverse CSE mapping if the scrutinee is a non-trivial expression.
-(If the scrutinee is a simple variable we want to add the mapping
-	case binder -> scrutinee 
-to the substitution
-
-[Note: unboxed tuple case binders]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-	case f x of t { (# a,b #) -> 
-	case ... of
-	  True -> f x
-	  False -> 0 }
-
-We must not replace (f x) by t, because t is an unboxed-tuple binder.
-Instead, we shoudl replace (f x) by (# a,b #).  That is, the "reverse mapping" is
-	f x --> (# a,b #)
-That is why the CSEMap has pairs of expressions.
-
-
-%************************************************************************
-%*									*
-\section{Common subexpression}
-%*									*
-%************************************************************************
-
-\begin{code}
-cseProgram :: DynFlags -> [CoreBind] -> IO [CoreBind]
-
-cseProgram dflags binds
-  = do {
-	showPass dflags "Common sub-expression";
-	let { binds' = cseBinds emptyCSEnv binds };
-	endPass dflags "Common sub-expression" 	Opt_D_dump_cse binds'	
-    }
-
-cseBinds :: CSEnv -> [CoreBind] -> [CoreBind]
-cseBinds env []     = []
-cseBinds env (b:bs) = (b':bs')
-		    where
-		      (env1, b') = cseBind  env  b
-		      bs'        = cseBinds env1 bs
-
-cseBind :: CSEnv -> CoreBind -> (CSEnv, CoreBind)
-cseBind env (NonRec b e) = let (env', (b',e')) = do_one env (b, e)
-			   in (env', NonRec b' e')
-cseBind env (Rec pairs)  = let (env', pairs') = mapAccumL do_one env pairs
-			   in (env', Rec pairs')
-			 
-
-do_one env (id, rhs) 
-  = case lookupCSEnv env rhs' of
-	Just (Var other_id) -> (extendSubst env' id other_id, 	  (id', Var other_id))
-	Just other_expr     -> (env', 			      	  (id', other_expr))
-	Nothing             -> (addCSEnvItem env' rhs' (Var id'), (id', rhs'))
-  where
-    (env', id') = addBinder env id
-    rhs' | not (workerExists (idWorkerInfo id)) = cseExpr env' rhs
-
-		-- Hack alert: don't do CSE on wrapper RHSs.
-		-- Otherwise we find:
-		--	$wf = h
-		--	f = \x -> ...$wf...
-		-- ===>
-		--	f = \x -> ...h...
-		-- But the WorkerInfo for f still says $wf, which is now dead!
-	  | otherwise = rhs
-
-
-tryForCSE :: CSEnv -> CoreExpr -> CoreExpr
-tryForCSE env (Type t) = Type t
-tryForCSE env expr     = case lookupCSEnv env expr' of
-			    Just smaller_expr -> smaller_expr
- 			    Nothing  	      -> expr'
-		       where
-	 	         expr' = cseExpr env expr
-
-cseExpr :: CSEnv -> CoreExpr -> CoreExpr
-cseExpr env (Type t)		   = Type t
-cseExpr env (Lit lit)		   = Lit lit
-cseExpr env (Var v)		   = Var (lookupSubst env v)
-cseExpr env (App f a)        	   = App (cseExpr env f) (tryForCSE env a)
-cseExpr env (Note n e)       	   = Note n (cseExpr env e)
-cseExpr env (Lam b e)	     	   = let (env', b') = addBinder env b
-				     in Lam b' (cseExpr env' e)
-cseExpr env (Let bind e)    	   = let (env', bind') = cseBind env bind
-				     in Let bind' (cseExpr env' e)
-cseExpr env (Case scrut bndr ty alts) = Case scrut' bndr' ty (cseAlts env' scrut' bndr bndr' alts)
-				   where
-				     scrut' = tryForCSE env scrut
-				     (env', bndr') = addBinder env bndr
-
-
-cseAlts env scrut' bndr bndr' [(DataAlt con, args, rhs)]
-  | isUnboxedTupleCon con
-	-- Unboxed tuples are special because the case binder isn't
-	-- a real values.  See [Note: unboxed tuple case binders]
-  = [(DataAlt con, args', tryForCSE new_env rhs)]
-  where
-    (env', args') = addBinders env args
-    new_env | exprIsCheap scrut' = env'
-	    | otherwise 	 = extendCSEnv env' scrut' tup_value
-    tup_value = mkAltExpr (DataAlt con) args' (tyConAppArgs (idType bndr))
-
-cseAlts env scrut' bndr bndr' alts
-  = map cse_alt alts
-  where
-    (con_target, alt_env)
-	= case scrut' of
-		Var v' -> (v',    extendSubst env bndr v')	-- See [Note: case binder 1]
-								-- map: bndr -> v'
-
-		other ->  (bndr', extendCSEnv env scrut' (Var  bndr'))	-- See [Note: case binder 2]
-									-- map: scrut' -> bndr'
-
-    arg_tys = tyConAppArgs (idType bndr)
-
-    cse_alt (DataAlt con, args, rhs)
-	| not (null args)
-		-- Don't try CSE if there are no args; it just increases the number
-		-- of live vars.  E.g.
-		--	case x of { True -> ....True.... }
-		-- Don't replace True by x!  
-		-- Hence the 'null args', which also deal with literals and DEFAULT
-	= (DataAlt con, args', tryForCSE new_env rhs)
-	where
-	  (env', args') = addBinders alt_env args
-	  new_env       = extendCSEnv env' (mkAltExpr (DataAlt con) args' arg_tys)
-					   (Var con_target)
-
-    cse_alt (con, args, rhs)
-	= (con, args', tryForCSE env' rhs)
-	where
-	  (env', args') = addBinders alt_env args
-\end{code}
-
-
-%************************************************************************
-%*									*
-\section{The CSE envt}
-%*									*
-%************************************************************************
-
-\begin{code}
-data CSEnv = CS CSEMap InScopeSet (IdEnv Id)
-			-- Simple substitution
-
-type CSEMap = UniqFM [(CoreExpr, CoreExpr)]	-- This is the reverse mapping
-	-- It maps the hash-code of an expression e to list of (e,e') pairs
-	-- This means that it's good to replace e by e'
-	-- INVARIANT: The expr in the range has already been CSE'd
-
-emptyCSEnv = CS emptyUFM emptyInScopeSet emptyVarEnv
-
-lookupCSEnv :: CSEnv -> CoreExpr -> Maybe CoreExpr
-lookupCSEnv (CS cs _ _) expr
-  = case lookupUFM cs (hashExpr expr) of
-	Nothing -> Nothing
-	Just pairs -> lookup_list pairs expr
-
-lookup_list :: [(CoreExpr,CoreExpr)] -> CoreExpr -> Maybe CoreExpr
-lookup_list [] expr = Nothing
-lookup_list ((e,e'):es) expr | cheapEqExpr e expr = Just e'
-			     | otherwise	  = lookup_list es expr
-
-addCSEnvItem env expr expr' | exprIsBig expr = env
-			    | otherwise      = extendCSEnv env expr expr'
-   -- We don't try to CSE big expressions, because they are expensive to compare
-   -- (and are unlikely to be the same anyway)
-
-extendCSEnv (CS cs in_scope sub) expr expr'
-  = CS (addToUFM_C combine cs hash [(expr, expr')]) in_scope sub
-  where
-    hash   = hashExpr expr
-    combine old new = WARN( result `lengthExceeds` 4, text "extendCSEnv: long list:" <+> ppr result )
-		      result
-		    where
-		      result = new ++ old
-
-lookupSubst (CS _ _ sub) x = case lookupVarEnv sub x of
-			       Just y  -> y
-			       Nothing -> x
-
-extendSubst (CS cs in_scope sub) x y = CS cs in_scope (extendVarEnv sub x y)
-
-addBinder :: CSEnv -> Id -> (CSEnv, Id)
-addBinder env@(CS cs in_scope sub) v
-  | not (v `elemInScopeSet` in_scope) = (CS cs (extendInScopeSet in_scope v)  sub,		       v)
-  | isId v			      = (CS cs (extendInScopeSet in_scope v') (extendVarEnv sub v v'), v')
-  | not (isId v)		      = WARN( True, ppr v )
-				        (CS emptyUFM in_scope		      sub,		       v)
-	-- This last case is the unusual situation where we have shadowing of
-	-- a type variable; we have to discard the CSE mapping
-	-- See "IMPORTANT NOTE" at the top 
-  where
-    v' = uniqAway in_scope v
-
-addBinders :: CSEnv -> [Id] -> (CSEnv, [Id])
-addBinders env vs = mapAccumL addBinder env vs
-\end{code}
diff --git a/ghc/compiler/simplCore/FloatIn.lhs b/ghc/compiler/simplCore/FloatIn.lhs
deleted file mode 100644
index 0e8edb5930..0000000000
--- a/ghc/compiler/simplCore/FloatIn.lhs
+++ /dev/null
@@ -1,464 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-%************************************************************************
-%*									*
-\section[FloatIn]{Floating Inwards pass}
-%*									*
-%************************************************************************
-
-The main purpose of @floatInwards@ is floating into branches of a
-case, so that we don't allocate things, save them on the stack, and
-then discover that they aren't needed in the chosen branch.
-
-\begin{code}
-module FloatIn ( floatInwards ) where
-
-#include "HsVersions.h"
-
-import DynFlags	( DynFlags, DynFlag(..) )
-import CoreSyn
-import CoreUtils	( exprIsHNF, exprIsDupable )
-import CoreLint		( showPass, endPass )
-import CoreFVs		( CoreExprWithFVs, freeVars, freeVarsOf )
-import Id		( isOneShotBndr )
-import Var		( Id, idType )
-import Type		( isUnLiftedType )
-import VarSet
-import Util		( zipEqual, zipWithEqual, count )
-import Outputable
-\end{code}
-
-Top-level interface function, @floatInwards@.  Note that we do not
-actually float any bindings downwards from the top-level.
-
-\begin{code}
-floatInwards :: DynFlags -> [CoreBind] -> IO [CoreBind]
-
-floatInwards dflags binds
-  = do {
-	showPass dflags "Float inwards";
-	let { binds' = map fi_top_bind binds };
-	endPass dflags "Float inwards" Opt_D_verbose_core2core binds'	
-				{- no specific flag for dumping float-in -} 
-    }
-			  
-  where
-    fi_top_bind (NonRec binder rhs)
-      = NonRec binder (fiExpr [] (freeVars rhs))
-    fi_top_bind (Rec pairs)
-      = Rec [ (b, fiExpr [] (freeVars rhs)) | (b, rhs) <- pairs ]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Mail from Andr\'e [edited]}
-%*									*
-%************************************************************************
-
-{\em Will wrote: What??? I thought the idea was to float as far
-inwards as possible, no matter what.  This is dropping all bindings
-every time it sees a lambda of any kind.  Help! }
-
-You are assuming we DO DO full laziness AFTER floating inwards!  We
-have to [not float inside lambdas] if we don't.
-
-If we indeed do full laziness after the floating inwards (we could
-check the compilation flags for that) then I agree we could be more
-aggressive and do float inwards past lambdas.
-
-Actually we are not doing a proper full laziness (see below), which
-was another reason for not floating inwards past a lambda.
-
-This can easily be fixed.  The problem is that we float lets outwards,
-but there are a few expressions which are not let bound, like case
-scrutinees and case alternatives.  After floating inwards the
-simplifier could decide to inline the let and the laziness would be
-lost, e.g.
-
-\begin{verbatim}
-let a = expensive             ==> \b -> case expensive of ...
-in \ b -> case a of ...
-\end{verbatim}
-The fix is
-\begin{enumerate}
-\item
-to let bind the algebraic case scrutinees (done, I think) and
-the case alternatives (except the ones with an
-unboxed type)(not done, I think). This is best done in the
-SetLevels.lhs module, which tags things with their level numbers.
-\item
-do the full laziness pass (floating lets outwards).
-\item
-simplify. The simplifier inlines the (trivial) lets that were
- created but were not floated outwards.
-\end{enumerate}
-
-With the fix I think Will's suggestion that we can gain even more from
-strictness by floating inwards past lambdas makes sense.
-
-We still gain even without going past lambdas, as things may be
-strict in the (new) context of a branch (where it was floated to) or
-of a let rhs, e.g.
-\begin{verbatim}
-let a = something            case x of
-in case x of                   alt1 -> case something of a -> a + a
-     alt1 -> a + a      ==>    alt2 -> b
-     alt2 -> b
-
-let a = something           let b = case something of a -> a + a
-in let b = a + a        ==> in (b,b)
-in (b,b)
-\end{verbatim}
-Also, even if a is not found to be strict in the new context and is
-still left as a let, if the branch is not taken (or b is not entered)
-the closure for a is not built.
-
-%************************************************************************
-%*									*
-\subsection{Main floating-inwards code}
-%*									*
-%************************************************************************
-
-\begin{code}
-type FreeVarsSet   = IdSet
-
-type FloatingBinds = [(CoreBind, FreeVarsSet)]
-	-- In reverse dependency order (innermost bindiner first)
-
-	-- The FreeVarsSet is the free variables of the binding.  In the case
-	-- of recursive bindings, the set doesn't include the bound
-	-- variables.
-
-fiExpr :: FloatingBinds		-- Binds we're trying to drop
-				-- as far "inwards" as possible
-       -> CoreExprWithFVs	-- Input expr
-       -> CoreExpr		-- Result
-
-fiExpr to_drop (_, AnnVar v) = mkCoLets' to_drop (Var v)
-
-fiExpr to_drop (_, AnnType ty) = ASSERT( null to_drop )
-				 Type ty
-
-fiExpr to_drop (_, AnnLit lit) = Lit lit
-\end{code}
-
-Applications: we do float inside applications, mainly because we
-need to get at all the arguments.  The next simplifier run will
-pull out any silly ones.
-
-\begin{code}
-fiExpr to_drop (_,AnnApp fun arg)
-  = mkCoLets' drop_here (App (fiExpr fun_drop fun) (fiExpr arg_drop arg))
-  where
-    [drop_here, fun_drop, arg_drop] = sepBindsByDropPoint False [freeVarsOf fun, freeVarsOf arg] to_drop
-\end{code}
-
-We are careful about lambdas: 
-
-* We must be careful about floating inside inside a value lambda.  
-  That risks losing laziness.
-  The float-out pass might rescue us, but then again it might not.
-
-* We must be careful about type lambdas too.  At one time we did, and
-  there is no risk of duplicating work thereby, but we do need to be
-  careful.  In particular, here is a bad case (it happened in the
-  cichelli benchmark:
-   	let v = ...
-   	in let f = /\t -> \a -> ...
-   	   ==>
-   	let f = /\t -> let v = ... in \a -> ...
-  This is bad as now f is an updatable closure (update PAP)
-  and has arity 0.
-
-So we treat lambda in groups, using the following rule:
-
-	Float inside a group of lambdas only if
-	they are all either type lambdas or one-shot lambdas.
-
-	Otherwise drop all the bindings outside the group.
-
-\begin{code}
-	-- Hack alert!  We only float in through one-shot lambdas, 
-	-- not (as you might guess) through big lambdas.  
-	-- Reason: we float *out* past big lambdas (see the test in the Lam
-	-- case of FloatOut.floatExpr) and we don't want to float straight
-	-- back in again.
-	--
-	-- It *is* important to float into one-shot lambdas, however;
-	-- see the remarks with noFloatIntoRhs.
-fiExpr to_drop lam@(_, AnnLam _ _)
-  | all is_one_shot bndrs 	-- Float in
-  = mkLams bndrs (fiExpr to_drop body)
-
-  | otherwise	 	-- Dump it all here
-  = mkCoLets' to_drop (mkLams bndrs (fiExpr [] body))
-
-  where
-    (bndrs, body) = collectAnnBndrs lam
-\end{code}
-
-We don't float lets inwards past an SCC.
-	ToDo: keep info on current cc, and when passing
-	one, if it is not the same, annotate all lets in binds with current
-	cc, change current cc to the new one and float binds into expr.
-
-\begin{code}
-fiExpr to_drop (_, AnnNote note@(SCC cc) expr)
-  = 	-- Wimp out for now
-    mkCoLets' to_drop (Note note (fiExpr [] expr))
-
-fiExpr to_drop (_, AnnNote InlineCall expr)
-  = 	-- Wimp out for InlineCall; keep it close
-	-- the the call it annotates
-    mkCoLets' to_drop (Note InlineCall (fiExpr [] expr))
-
-fiExpr to_drop (_, AnnNote InlineMe expr)
-  = 	-- Ditto... don't float anything into an INLINE expression
-    mkCoLets' to_drop (Note InlineMe (fiExpr [] expr))
-
-fiExpr to_drop (_, AnnNote note@(Coerce _ _) expr)
-  = 	-- Just float in past coercion
-    Note note (fiExpr to_drop expr)
-
-fiExpr to_drop (_, AnnNote note@(CoreNote _) expr)
-  = Note note (fiExpr to_drop expr)
-\end{code}
-
-For @Lets@, the possible ``drop points'' for the \tr{to_drop}
-bindings are: (a)~in the body, (b1)~in the RHS of a NonRec binding,
-or~(b2), in each of the RHSs of the pairs of a @Rec@.
-
-Note that we do {\em weird things} with this let's binding.  Consider:
-\begin{verbatim}
-let
-    w = ...
-in {
-    let v = ... w ...
-    in ... v .. w ...
-}
-\end{verbatim}
-Look at the inner \tr{let}.  As \tr{w} is used in both the bind and
-body of the inner let, we could panic and leave \tr{w}'s binding where
-it is.  But \tr{v} is floatable further into the body of the inner let, and
-{\em then} \tr{w} will also be only in the body of that inner let.
-
-So: rather than drop \tr{w}'s binding here, we add it onto the list of
-things to drop in the outer let's body, and let nature take its
-course.
-
-\begin{code}
-fiExpr to_drop (_,AnnLet (AnnNonRec id rhs@(rhs_fvs, ann_rhs)) body)
-  = fiExpr new_to_drop body
-  where
-    body_fvs = freeVarsOf body
-
-    final_body_fvs | noFloatIntoRhs ann_rhs
-		   || isUnLiftedType (idType id) = body_fvs `unionVarSet` rhs_fvs
-		   | otherwise		         = body_fvs
-	-- See commments with letrec below
-	-- No point in floating in only to float straight out again
-	-- Ditto ok-for-speculation unlifted RHSs
-
-    [shared_binds, rhs_binds, body_binds] = sepBindsByDropPoint False [rhs_fvs, final_body_fvs] to_drop
-
-    new_to_drop = body_binds ++				-- the bindings used only in the body
-		  [(NonRec id rhs', rhs_fvs')] ++ 	-- the new binding itself
-		  shared_binds  			-- the bindings used both in rhs and body
-
-	-- Push rhs_binds into the right hand side of the binding
-    rhs'     = fiExpr rhs_binds rhs
-    rhs_fvs' = rhs_fvs `unionVarSet` floatedBindsFVs rhs_binds
-
-fiExpr to_drop (_,AnnLet (AnnRec bindings) body)
-  = fiExpr new_to_drop body
-  where
-    rhss = map snd bindings
-
-    rhss_fvs = map freeVarsOf rhss
-    body_fvs = freeVarsOf body
-
-	-- Add to body_fvs the free vars of any RHS that has
-	-- a lambda at the top.  This has the effect of making it seem
-	-- that such things are used in the body as well, and hence prevents
-	-- them getting floated in.  The big idea is to avoid turning:
-	--	let x# = y# +# 1#
-	--	in
-	--	letrec f = \z. ...x#...f...
-	--	in ...
-	-- into
-	--	letrec f = let x# = y# +# 1# in \z. ...x#...f... in ...
-	-- 
-	-- Because now we can't float the let out again, because a letrec
-	-- can't have unboxed bindings.
-
-    final_body_fvs = foldr (unionVarSet . get_extras) body_fvs rhss
-    get_extras (rhs_fvs, rhs) | noFloatIntoRhs rhs = rhs_fvs
-			      | otherwise	   = emptyVarSet
-
-    (shared_binds:body_binds:rhss_binds) = sepBindsByDropPoint False (final_body_fvs:rhss_fvs) to_drop
-
-    new_to_drop = -- the bindings used only in the body
-		  body_binds ++
-		  -- the new binding itself
-		  [(Rec (fi_bind rhss_binds bindings), rhs_fvs')] ++
-		  -- the bindings used both in rhs and body or in more than one rhs
-		  shared_binds
-
-    rhs_fvs' = unionVarSet (unionVarSets rhss_fvs)
-			   (unionVarSets (map floatedBindsFVs rhss_binds))
-
-    -- Push rhs_binds into the right hand side of the binding
-    fi_bind :: [FloatingBinds]	    -- one per "drop pt" conjured w/ fvs_of_rhss
-	    -> [(Id, CoreExprWithFVs)]
-	    -> [(Id, CoreExpr)]
-
-    fi_bind to_drops pairs
-      = [ (binder, fiExpr to_drop rhs) 
-	| ((binder, rhs), to_drop) <- zipEqual "fi_bind" pairs to_drops ]
-\end{code}
-
-For @Case@, the possible ``drop points'' for the \tr{to_drop}
-bindings are: (a)~inside the scrutinee, (b)~inside one of the
-alternatives/default [default FVs always {\em first}!].
-
-\begin{code}
-fiExpr to_drop (_, AnnCase scrut case_bndr ty alts)
-  = mkCoLets' drop_here1 $
-    mkCoLets' drop_here2 $
-    Case (fiExpr scrut_drops scrut) case_bndr ty
-	 (zipWith fi_alt alts_drops_s alts)
-  where
-	-- Float into the scrut and alts-considered-together just like App
-    [drop_here1, scrut_drops, alts_drops] = sepBindsByDropPoint False [scrut_fvs, all_alts_fvs] to_drop
-
-	-- Float into the alts with the is_case flag set
-    (drop_here2 : alts_drops_s)           = sepBindsByDropPoint True alts_fvs alts_drops
-
-    scrut_fvs    = freeVarsOf scrut
-    alts_fvs     = map alt_fvs alts
-    all_alts_fvs = unionVarSets alts_fvs
-    alt_fvs (con, args, rhs) = foldl delVarSet (freeVarsOf rhs) (case_bndr:args)
-				-- Delete case_bndr and args from free vars of rhs 
-				-- to get free vars of alt
-
-    fi_alt to_drop (con, args, rhs) = (con, args, fiExpr to_drop rhs)
-
-noFloatIntoRhs (AnnNote InlineMe _) = True
-noFloatIntoRhs (AnnLam b _)   	    = not (is_one_shot b)
-	-- IMPORTANT: don't say 'True' for a RHS with a one-shot lambda at the top.
-	-- This makes a big difference for things like
-	--	f x# = let x = I# x#
-	--	       in let j = \() -> ...x...
-	--		  in if <condition> then normal-path else j ()
-	-- If x is used only in the error case join point, j, we must float the
-	-- boxing constructor into it, else we box it every time which is very bad
-	-- news indeed.
-
-noFloatIntoRhs rhs = exprIsHNF (deAnnotate' rhs)	-- We'd just float right back out again...
-
-is_one_shot b = isId b && isOneShotBndr b
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{@sepBindsByDropPoint@}
-%*									*
-%************************************************************************
-
-This is the crucial function.  The idea is: We have a wad of bindings
-that we'd like to distribute inside a collection of {\em drop points};
-insides the alternatives of a \tr{case} would be one example of some
-drop points; the RHS and body of a non-recursive \tr{let} binding
-would be another (2-element) collection.
-
-So: We're given a list of sets-of-free-variables, one per drop point,
-and a list of floating-inwards bindings.  If a binding can go into
-only one drop point (without suddenly making something out-of-scope),
-in it goes.  If a binding is used inside {\em multiple} drop points,
-then it has to go in a you-must-drop-it-above-all-these-drop-points
-point.
-
-We have to maintain the order on these drop-point-related lists.
-
-\begin{code}
-sepBindsByDropPoint
-    :: Bool		    -- True <=> is case expression
-    -> [FreeVarsSet]	    -- One set of FVs per drop point
-    -> FloatingBinds 	    -- Candidate floaters
-    -> [FloatingBinds]      -- FIRST one is bindings which must not be floated
-			    -- inside any drop point; the rest correspond
-			    -- one-to-one with the input list of FV sets
-
--- Every input floater is returned somewhere in the result;
--- none are dropped, not even ones which don't seem to be
--- free in *any* of the drop-point fvs.  Why?  Because, for example,
--- a binding (let x = E in B) might have a specialised version of
--- x (say x') stored inside x, but x' isn't free in E or B.
-
-type DropBox = (FreeVarsSet, FloatingBinds)
-
-sepBindsByDropPoint is_case drop_pts []
-  = [] : [[] | p <- drop_pts]	-- cut to the chase scene; it happens
-
-sepBindsByDropPoint is_case drop_pts floaters
-  = go floaters (map (\fvs -> (fvs, [])) (emptyVarSet : drop_pts))
-  where
-    go :: FloatingBinds -> [DropBox] -> [FloatingBinds]
-	-- The *first* one in the argument list is the drop_here set
-	-- The FloatingBinds in the lists are in the reverse of
-	-- the normal FloatingBinds order; that is, they are the right way round!
-
-    go [] drop_boxes = map (reverse . snd) drop_boxes
-
-    go (bind_w_fvs@(bind, bind_fvs) : binds) drop_boxes@(here_box : fork_boxes)
-	= go binds new_boxes
-	where
-	  -- "here" means the group of bindings dropped at the top of the fork
-
-	  (used_here : used_in_flags) = [ any (`elemVarSet` fvs) (bindersOf bind)
-					| (fvs, drops) <- drop_boxes]
-
-	  drop_here = used_here || not can_push
-
-		-- For case expressions we duplicate the binding if it is
-		-- reasonably small, and if it is not used in all the RHSs
-		-- This is good for situations like
-		--	let x = I# y in
-		--	case e of
-		--	  C -> error x
-		-- 	  D -> error x
-		--	  E -> ...not mentioning x...
-
-	  n_alts      = length used_in_flags
-	  n_used_alts = count id used_in_flags -- returns number of Trues in list.
-
-	  can_push = n_used_alts == 1		-- Used in just one branch
-		   || (is_case && 		-- We are looking at case alternatives
-		       n_used_alts > 1 && 	-- It's used in more than one
-		       n_used_alts < n_alts &&	-- ...but not all
-		       bindIsDupable bind)	-- and we can duplicate the binding
-
-	  new_boxes | drop_here = (insert here_box : fork_boxes)
-		    | otherwise = (here_box : new_fork_boxes)
-
-	  new_fork_boxes = zipWithEqual "FloatIn.sepBinds" insert_maybe fork_boxes used_in_flags
-
-	  insert :: DropBox -> DropBox
-	  insert (fvs,drops) = (fvs `unionVarSet` bind_fvs, bind_w_fvs:drops)
-
-	  insert_maybe box True  = insert box
-	  insert_maybe box False = box
-
-
-floatedBindsFVs :: FloatingBinds -> FreeVarsSet
-floatedBindsFVs binds = unionVarSets (map snd binds)
-
-mkCoLets' :: FloatingBinds -> CoreExpr -> CoreExpr
-mkCoLets' to_drop e = foldl (flip (Let . fst)) e to_drop
-	-- Remember to_drop is in *reverse* dependency order
-
-bindIsDupable (Rec prs)    = all (exprIsDupable . snd) prs
-bindIsDupable (NonRec b r) = exprIsDupable r
-\end{code}
diff --git a/ghc/compiler/simplCore/FloatOut.lhs b/ghc/compiler/simplCore/FloatOut.lhs
deleted file mode 100644
index 988bd53015..0000000000
--- a/ghc/compiler/simplCore/FloatOut.lhs
+++ /dev/null
@@ -1,443 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[FloatOut]{Float bindings outwards (towards the top level)}
-
-``Long-distance'' floating of bindings towards the top level.
-
-\begin{code}
-module FloatOut ( floatOutwards ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-import CoreUtils	( mkSCC, exprIsHNF, exprIsTrivial )
-
-import DynFlags	( DynFlags, DynFlag(..), FloatOutSwitches(..) )
-import ErrUtils		( dumpIfSet_dyn )
-import CostCentre	( dupifyCC, CostCentre )
-import Id		( Id, idType )
-import Type		( isUnLiftedType )
-import CoreLint		( showPass, endPass )
-import SetLevels	( Level(..), LevelledExpr, LevelledBind,
-			  setLevels, ltMajLvl, ltLvl, isTopLvl )
-import UniqSupply       ( UniqSupply )
-import List		( partition )
-import Outputable
-import Util             ( notNull )
-\end{code}
-
-	-----------------
-	Overall game plan
-	-----------------
-
-The Big Main Idea is:
-
-  	To float out sub-expressions that can thereby get outside
-	a non-one-shot value lambda, and hence may be shared.
-
-
-To achieve this we may need to do two thing:
-
-   a) Let-bind the sub-expression:
-
-	f (g x)  ==>  let lvl = f (g x) in lvl
-
-      Now we can float the binding for 'lvl'.  
-
-   b) More than that, we may need to abstract wrt a type variable
-
-	\x -> ... /\a -> let v = ...a... in ....
-
-      Here the binding for v mentions 'a' but not 'x'.  So we
-      abstract wrt 'a', to give this binding for 'v':
-
-	    vp = /\a -> ...a...
-	    v  = vp a
-
-      Now the binding for vp can float out unimpeded.
-      I can't remember why this case seemed important enough to
-      deal with, but I certainly found cases where important floats
-      didn't happen if we did not abstract wrt tyvars.
-
-With this in mind we can also achieve another goal: lambda lifting.
-We can make an arbitrary (function) binding float to top level by
-abstracting wrt *all* local variables, not just type variables, leaving
-a binding that can be floated right to top level.  Whether or not this
-happens is controlled by a flag.
-
-
-Random comments
-~~~~~~~~~~~~~~~
-
-At the moment we never float a binding out to between two adjacent
-lambdas.  For example:
-
-@
-	\x y -> let t = x+x in ...
-===>
-	\x -> let t = x+x in \y -> ...
-@
-Reason: this is less efficient in the case where the original lambda
-is never partially applied.
-
-But there's a case I've seen where this might not be true.  Consider:
-@
-elEm2 x ys
-  = elem' x ys
-  where
-    elem' _ []	= False
-    elem' x (y:ys)	= x==y || elem' x ys
-@
-It turns out that this generates a subexpression of the form
-@
-	\deq x ys -> let eq = eqFromEqDict deq in ...
-@
-vwhich might usefully be separated to
-@
-	\deq -> let eq = eqFromEqDict deq in \xy -> ...
-@
-Well, maybe.  We don't do this at the moment.
-
-\begin{code}
-type FloatBind     = (Level, CoreBind)	-- INVARIANT: a FloatBind is always lifted
-type FloatBinds    = [FloatBind]	
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[floatOutwards]{@floatOutwards@: let-floating interface function}
-%*									*
-%************************************************************************
-
-\begin{code}
-floatOutwards :: FloatOutSwitches
-	      -> DynFlags
-	      -> UniqSupply 
-	      -> [CoreBind] -> IO [CoreBind]
-
-floatOutwards float_sws dflags us pgm
-  = do {
-	showPass dflags float_msg ;
-
-	let { annotated_w_levels = setLevels float_sws pgm us ;
-	      (fss, binds_s')    = unzip (map floatTopBind annotated_w_levels)
-	    } ;
-
-	dumpIfSet_dyn dflags Opt_D_verbose_core2core "Levels added:"
-	          (vcat (map ppr annotated_w_levels));
-
-	let { (tlets, ntlets, lams) = get_stats (sum_stats fss) };
-
-	dumpIfSet_dyn dflags Opt_D_dump_simpl_stats "FloatOut stats:"
-		(hcat [	int tlets,  ptext SLIT(" Lets floated to top level; "),
-			int ntlets, ptext SLIT(" Lets floated elsewhere; from "),
-			int lams,   ptext SLIT(" Lambda groups")]);
-
-	endPass dflags float_msg  Opt_D_verbose_core2core (concat binds_s')
-			{- no specific flag for dumping float-out -} 
-    }
-  where
-    float_msg = showSDoc (text "Float out" <+> parens (sws float_sws))
-    sws (FloatOutSw lam const) = pp_not lam   <+> text "lambdas" <> comma <+>
-				 pp_not const <+> text "constants"
-    pp_not True  = empty
-    pp_not False = text "not"
-
-floatTopBind bind@(NonRec _ _)
-  = case (floatBind bind) of { (fs, floats, bind') ->
-    (fs, floatsToBinds floats ++ [bind'])
-    }
-
-floatTopBind bind@(Rec _)
-  = case (floatBind bind) of { (fs, floats, Rec pairs') ->
-    WARN( notNull floats, ppr bind $$ ppr floats )
-    (fs, [Rec (floatsToBindPairs floats ++ pairs')]) }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[FloatOut-Bind]{Floating in a binding (the business end)}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-floatBind :: LevelledBind
-	  -> (FloatStats, FloatBinds, CoreBind)
-
-floatBind (NonRec (TB name level) rhs)
-  = case (floatNonRecRhs level rhs) of { (fs, rhs_floats, rhs') ->
-    (fs, rhs_floats, NonRec name rhs') }
-
-floatBind bind@(Rec pairs)
-  = case (unzip3 (map do_pair pairs)) of { (fss, rhss_floats, new_pairs) ->
-
-    if not (isTopLvl bind_dest_level) then
-	-- Standard case; the floated bindings can't mention the
-	-- binders, because they couldn't be escaping a major level
-	-- if so.
-	(sum_stats fss, concat rhss_floats, Rec new_pairs)
-    else
-	-- In a recursive binding, *destined for* the top level
-	-- (only), the rhs floats may contain references to the 
-	-- bound things.  For example
-	--	f = ...(let v = ...f... in b) ...
-	--  might get floated to
-	--	v = ...f...
-	--	f = ... b ...
-	-- and hence we must (pessimistically) make all the floats recursive
-	-- with the top binding.  Later dependency analysis will unravel it.
-	--
-	-- This can only happen for bindings destined for the top level,
-	-- because only then will partitionByMajorLevel allow through a binding
-	-- that only differs in its minor level
-	(sum_stats fss, [],
-	 Rec (new_pairs ++ floatsToBindPairs (concat rhss_floats)))
-    }
-  where
-    bind_dest_level = getBindLevel bind
-
-    do_pair (TB name level, rhs)
-      = case (floatRhs level rhs) of { (fs, rhs_floats, rhs') ->
-	(fs, rhs_floats, (name, rhs'))
-	}
-\end{code}
-
-%************************************************************************
-
-\subsection[FloatOut-Expr]{Floating in expressions}
-%*									*
-%************************************************************************
-
-\begin{code}
-floatExpr, floatRhs, floatNonRecRhs
-	 :: Level
-	 -> LevelledExpr
-	 -> (FloatStats, FloatBinds, CoreExpr)
-
-floatRhs lvl arg	-- Used rec rhss, and case-alternative rhss
-  = case (floatExpr lvl arg) of { (fsa, floats, arg') ->
-    case (partitionByMajorLevel lvl floats) of { (floats', heres) ->
-	-- Dump bindings that aren't going to escape from a lambda;
-	-- in particular, we must dump the ones that are bound by 
-	-- the rec or case alternative
-    (fsa, floats', install heres arg') }}
-
-floatNonRecRhs lvl arg	-- Used for nested non-rec rhss, and fn args
-  = case (floatExpr lvl arg) of { (fsa, floats, arg') ->
-	-- Dump bindings that aren't going to escape from a lambda
-	-- This isn't a scoping issue (the binder isn't in scope in the RHS of a non-rec binding)
-	-- Rather, it is to avoid floating the x binding out of
-	--	f (let x = e in b)
-	-- unnecessarily.  But we first test for values or trival rhss,
-	-- because (in particular) we don't want to insert new bindings between
-	-- the "=" and the "\".  E.g.
-	--	f = \x -> let <bind> in <body>
-	-- We do not want
-	--	f = let <bind> in \x -> <body>
-	-- (a) The simplifier will immediately float it further out, so we may
-	--	as well do so right now; in general, keeping rhss as manifest 
-	--	values is good
-	-- (b) If a float-in pass follows immediately, it might add yet more
-	--	bindings just after the '='.  And some of them might (correctly)
-	--	be strict even though the 'let f' is lazy, because f, being a value,
-	--	gets its demand-info zapped by the simplifier.
-    if exprIsHNF arg' || exprIsTrivial arg' then
-	(fsa, floats, arg')
-    else
-    case (partitionByMajorLevel lvl floats) of { (floats', heres) ->
-    (fsa, floats', install heres arg') }}
-
-floatExpr _ (Var v)   = (zeroStats, [], Var v)
-floatExpr _ (Type ty) = (zeroStats, [], Type ty)
-floatExpr _ (Lit lit) = (zeroStats, [], Lit lit)
-	  
-floatExpr lvl (App e a)
-  = case (floatExpr      lvl e) of { (fse, floats_e, e') ->
-    case (floatNonRecRhs lvl a) of { (fsa, floats_a, a') ->
-    (fse `add_stats` fsa, floats_e ++ floats_a, App e' a') }}
-
-floatExpr lvl lam@(Lam _ _)
-  = let
-	(bndrs_w_lvls, body) = collectBinders lam
-	bndrs		     = [b | TB b _ <- bndrs_w_lvls]
-	lvls		     = [l | TB b l <- bndrs_w_lvls]
-
-	-- For the all-tyvar case we are prepared to pull 
-	-- the lets out, to implement the float-out-of-big-lambda
-	-- transform; but otherwise we only float bindings that are
-	-- going to escape a value lambda.
-	-- In particular, for one-shot lambdas we don't float things
-	-- out; we get no saving by so doing.
-	partition_fn | all isTyVar bndrs = partitionByLevel
-		     | otherwise	 = partitionByMajorLevel
-    in
-    case (floatExpr (last lvls) body) of { (fs, floats, body') ->
-
-	-- Dump any bindings which absolutely cannot go any further
-    case (partition_fn (head lvls) floats)	of { (floats', heres) ->
-
-    (add_to_stats fs floats', floats', mkLams bndrs (install heres body'))
-    }}
-
-floatExpr lvl (Note note@(SCC cc) expr)
-  = case (floatExpr lvl expr)    of { (fs, floating_defns, expr') ->
-    let
-	-- Annotate bindings floated outwards past an scc expression
-	-- with the cc.  We mark that cc as "duplicated", though.
-
-	annotated_defns = annotate (dupifyCC cc) floating_defns
-    in
-    (fs, annotated_defns, Note note expr') }
-  where
-    annotate :: CostCentre -> FloatBinds -> FloatBinds
-
-    annotate dupd_cc defn_groups
-      = [ (level, ann_bind floater) | (level, floater) <- defn_groups ]
-      where
-	ann_bind (NonRec binder rhs)
-	  = NonRec binder (mkSCC dupd_cc rhs)
-
-	ann_bind (Rec pairs)
-	  = Rec [(binder, mkSCC dupd_cc rhs) | (binder, rhs) <- pairs]
-
-floatExpr lvl (Note InlineMe expr)	-- Other than SCCs
-  = case floatExpr InlineCtxt expr of { (fs, floating_defns, expr') ->
-	-- There can be some floating_defns, arising from
-	-- ordinary lets that were there all the time.  It seems
-	-- more efficient to test once here than to avoid putting
-	-- them into floating_defns (which would mean testing for
-	-- inlineCtxt  at every let)
-    (fs, [], Note InlineMe (install floating_defns expr')) }	-- See notes in SetLevels
-
-floatExpr lvl (Note note expr)	-- Other than SCCs
-  = case (floatExpr lvl expr)    of { (fs, floating_defns, expr') ->
-    (fs, floating_defns, Note note expr') }
-
-floatExpr lvl (Let (NonRec (TB bndr bndr_lvl) rhs) body)
-  | isUnLiftedType (idType bndr)	-- Treat unlifted lets just like a case
-  = case floatExpr lvl rhs	of { (fs, rhs_floats, rhs') ->
-    case floatRhs bndr_lvl body of { (fs, body_floats, body') ->
-    (fs, rhs_floats ++ body_floats, Let (NonRec bndr rhs') body') }}
-
-floatExpr lvl (Let bind body)
-  = case (floatBind bind)     of { (fsb, rhs_floats,  bind') ->
-    case (floatExpr lvl body) of { (fse, body_floats, body') ->
-    (add_stats fsb fse,
-     rhs_floats ++ [(bind_lvl, bind')] ++ body_floats,
-     body')  }}
-  where
-    bind_lvl = getBindLevel bind
-
-floatExpr lvl (Case scrut (TB case_bndr case_lvl) ty alts)
-  = case floatExpr lvl scrut	of { (fse, fde, scrut') ->
-    case floatList float_alt alts	of { (fsa, fda, alts')  ->
-    (add_stats fse fsa, fda ++ fde, Case scrut' case_bndr ty alts')
-    }}
-  where
-	-- Use floatRhs for the alternatives, so that we
-	-- don't gratuitiously float bindings out of the RHSs
-    float_alt (con, bs, rhs)
-	= case (floatRhs case_lvl rhs)	of { (fs, rhs_floats, rhs') ->
-	  (fs, rhs_floats, (con, [b | TB b _ <- bs], rhs')) }
-
-
-floatList :: (a -> (FloatStats, FloatBinds, b)) -> [a] -> (FloatStats, FloatBinds, [b])
-floatList f [] = (zeroStats, [], [])
-floatList f (a:as) = case f a		 of { (fs_a,  binds_a,  b)  ->
-		     case floatList f as of { (fs_as, binds_as, bs) ->
-		     (fs_a `add_stats` fs_as, binds_a ++ binds_as, b:bs) }}
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Utility bits for floating stats}
-%*									*
-%************************************************************************
-
-I didn't implement this with unboxed numbers.  I don't want to be too
-strict in this stuff, as it is rarely turned on.  (WDP 95/09)
-
-\begin{code}
-data FloatStats
-  = FlS	Int  -- Number of top-floats * lambda groups they've been past
-	Int  -- Number of non-top-floats * lambda groups they've been past
-	Int  -- Number of lambda (groups) seen
-
-get_stats (FlS a b c) = (a, b, c)
-
-zeroStats = FlS 0 0 0
-
-sum_stats xs = foldr add_stats zeroStats xs
-
-add_stats (FlS a1 b1 c1) (FlS a2 b2 c2)
-  = FlS (a1 + a2) (b1 + b2) (c1 + c2)
-
-add_to_stats (FlS a b c) floats
-  = FlS (a + length top_floats) (b + length other_floats) (c + 1)
-  where
-    (top_floats, other_floats) = partition to_very_top floats
-
-    to_very_top (my_lvl, _) = isTopLvl my_lvl
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Utility bits for floating}
-%*									*
-%************************************************************************
-
-\begin{code}
-getBindLevel (NonRec (TB _ lvl) _)      = lvl
-getBindLevel (Rec (((TB _ lvl), _) : _)) = lvl
-\end{code}
-
-\begin{code}
-partitionByMajorLevel, partitionByLevel
-	:: Level		-- Partitioning level
-
-	-> FloatBinds   	-- Defns to be divided into 2 piles...
-
-	-> (FloatBinds,	-- Defns  with level strictly < partition level,
-	    FloatBinds)	-- The rest
-
-
-partitionByMajorLevel ctxt_lvl defns
-  = partition float_further defns
-  where
-	-- Float it if we escape a value lambda, or if we get to the top level
-    float_further (my_lvl, bind) = my_lvl `ltMajLvl` ctxt_lvl || isTopLvl my_lvl
-	-- The isTopLvl part says that if we can get to the top level, say "yes" anyway
-	-- This means that 
-	--	x = f e
-	-- transforms to 
-	--    lvl = e
-	--    x = f lvl
-	-- which is as it should be
-
-partitionByLevel ctxt_lvl defns
-  = partition float_further defns
-  where
-    float_further (my_lvl, _) = my_lvl `ltLvl` ctxt_lvl
-\end{code}
-
-\begin{code}
-floatsToBinds :: FloatBinds -> [CoreBind]
-floatsToBinds floats = map snd floats
-
-floatsToBindPairs :: FloatBinds -> [(Id,CoreExpr)]
-
-floatsToBindPairs floats = concat (map mk_pairs floats)
-  where
-   mk_pairs (_, Rec pairs)         = pairs
-   mk_pairs (_, NonRec binder rhs) = [(binder,rhs)]
-
-install :: FloatBinds -> CoreExpr -> CoreExpr
-
-install defn_groups expr
-  = foldr install_group expr defn_groups
-  where
-    install_group (_, defns) body = Let defns body
-\end{code}
diff --git a/ghc/compiler/simplCore/LiberateCase.lhs b/ghc/compiler/simplCore/LiberateCase.lhs
deleted file mode 100644
index c29a5b9c68..0000000000
--- a/ghc/compiler/simplCore/LiberateCase.lhs
+++ /dev/null
@@ -1,317 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1994-1998
-%
-\section[LiberateCase]{Unroll recursion to allow evals to be lifted from a loop}
-
-\begin{code}
-module LiberateCase ( liberateCase ) where
-
-#include "HsVersions.h"
-
-import DynFlags		( DynFlags, DynFlag(..) )
-import StaticFlags	( opt_LiberateCaseThreshold )
-import CoreLint		( showPass, endPass )
-import CoreSyn
-import CoreUnfold	( couldBeSmallEnoughToInline )
-import Id		( Id, setIdName, idName, setIdNotExported )
-import VarEnv
-import Name		( localiseName )
-import Outputable
-import Util             ( notNull )
-\end{code}
-
-This module walks over @Core@, and looks for @case@ on free variables.
-The criterion is:
-	if there is case on a free on the route to the recursive call,
-	then the recursive call is replaced with an unfolding.
-
-Example
-
-\begin{verbatim}
-f = \ t -> case v of
-	       V a b -> a : f t
-\end{verbatim}
-
-=> the inner f is replaced.
-
-\begin{verbatim}
-f = \ t -> case v of
-	       V a b -> a : (letrec
-				f =  \ t -> case v of
-					       V a b -> a : f t
-			     in f) t
-\end{verbatim}
-(note the NEED for shadowing)
-
-=> Simplify
-
-\begin{verbatim}
-f = \ t -> case v of
-	       V a b -> a : (letrec
-				f = \ t -> a : f t
-			     in f t)
-\begin{verbatim}
-
-Better code, because 'a' is  free inside the inner letrec, rather
-than needing projection from v.
-
-Other examples we'd like to catch with this kind of transformation
-
-	last []     = error 
-	last (x:[]) = x
-	last (x:xs) = last xs
-
-We'd like to avoid the redundant pattern match, transforming to
-
-	last [] = error
-	last (x:[]) = x
-	last (x:(y:ys)) = last' y ys
-		where
-		  last' y []     = y
-		  last' _ (y:ys) = last' y ys
-
-	(is this necessarily an improvement)
-
-
-Similarly drop:
-
-	drop n [] = []
-	drop 0 xs = xs
-	drop n (x:xs) = drop (n-1) xs
-
-Would like to pass n along unboxed.
-	
-
-To think about (Apr 94)
-~~~~~~~~~~~~~~
-
-Main worry: duplicating code excessively.  At the moment we duplicate
-the entire binding group once at each recursive call.  But there may
-be a group of recursive calls which share a common set of evaluated
-free variables, in which case the duplication is a plain waste.
-
-Another thing we could consider adding is some unfold-threshold thing,
-so that we'll only duplicate if the size of the group rhss isn't too
-big.
-
-Data types
-~~~~~~~~~~
-
-The ``level'' of a binder tells how many
-recursive defns lexically enclose the binding
-A recursive defn "encloses" its RHS, not its
-scope.  For example:
-\begin{verbatim}
-	letrec f = let g = ... in ...
-	in
-	let h = ...
-	in ...
-\end{verbatim}
-Here, the level of @f@ is zero, the level of @g@ is one,
-and the level of @h@ is zero (NB not one).
-
-\begin{code}
-type LibCaseLevel = Int
-
-topLevel :: LibCaseLevel
-topLevel = 0
-\end{code}
-
-\begin{code}
-data LibCaseEnv
-  = LibCaseEnv
-	Int			-- Bomb-out size for deciding if
-				-- potential liberatees are too big.
-				-- (passed in from cmd-line args)
-
-	LibCaseLevel		-- Current level
-
-	(IdEnv LibCaseLevel)	-- Binds all non-top-level in-scope Ids
-				-- (top-level and imported things have
-				-- a level of zero)
-
-	(IdEnv CoreBind)	-- Binds *only* recursively defined
-				-- Ids, to their own binding group,
-				-- and *only* in their own RHSs
-
-	[(Id,LibCaseLevel)]     -- Each of these Ids was scrutinised by an
-				-- enclosing case expression, with the
-				-- specified number of enclosing
-				-- recursive bindings; furthermore,
-				-- the Id is bound at a lower level
-				-- than the case expression.  The
-				-- order is insignificant; it's a bag
-				-- really
-
-initEnv :: Int -> LibCaseEnv
-initEnv bomb_size = LibCaseEnv bomb_size 0 emptyVarEnv emptyVarEnv []
-
-bombOutSize (LibCaseEnv bomb_size _ _ _ _) = bomb_size
-\end{code}
-
-
-Programs
-~~~~~~~~
-\begin{code}
-liberateCase :: DynFlags -> [CoreBind] -> IO [CoreBind]
-liberateCase dflags binds
-  = do {
-	showPass dflags "Liberate case" ;
-	let { binds' = do_prog (initEnv opt_LiberateCaseThreshold) binds } ;
-	endPass dflags "Liberate case" Opt_D_verbose_core2core binds'
-				{- no specific flag for dumping -} 
-    }
-  where
-    do_prog env [] = []
-    do_prog env (bind:binds) = bind' : do_prog env' binds
-			     where
-			       (env', bind') = libCaseBind env bind
-\end{code}
-
-Bindings
-~~~~~~~~
-
-\begin{code}
-libCaseBind :: LibCaseEnv -> CoreBind -> (LibCaseEnv, CoreBind)
-
-libCaseBind env (NonRec binder rhs)
-  = (addBinders env [binder], NonRec binder (libCase env rhs))
-
-libCaseBind env (Rec pairs)
-  = (env_body, Rec pairs')
-  where
-    (binders, rhss) = unzip pairs
-
-    env_body = addBinders env binders
-
-    pairs' = [(binder, libCase env_rhs rhs) | (binder,rhs) <- pairs]
-
-    env_rhs = if all rhs_small_enough rhss then extended_env else env
-
-	-- We extend the rec-env by binding each Id to its rhs, first
-	-- processing the rhs with an *un-extended* environment, so
-	-- that the same process doesn't occur for ever!
-	--
-    extended_env = addRecBinds env [ (adjust binder, libCase env_body rhs)
-				   | (binder, rhs) <- pairs ]
-
-	-- Two subtle things: 
-	-- (a)  Reset the export flags on the binders so
-	-- 	that we don't get name clashes on exported things if the 
-	-- 	local binding floats out to top level.  This is most unlikely
-	-- 	to happen, since the whole point concerns free variables. 
-	-- 	But resetting the export flag is right regardless.
-	-- 
-	-- (b)  Make the name an Internal one.  External Names should never be
-	--	nested; if it were floated to the top level, we'd get a name
-	-- 	clash at code generation time.
-    adjust bndr = setIdNotExported (setIdName bndr (localiseName (idName bndr)))
-
-    rhs_small_enough rhs = couldBeSmallEnoughToInline lIBERATE_BOMB_SIZE rhs
-    lIBERATE_BOMB_SIZE   = bombOutSize env
-\end{code}
-
-
-Expressions
-~~~~~~~~~~~
-
-\begin{code}
-libCase :: LibCaseEnv
-	-> CoreExpr
-	-> CoreExpr
-
-libCase env (Var v)		= libCaseId env v
-libCase env (Lit lit)		= Lit lit
-libCase env (Type ty)		= Type ty
-libCase env (App fun arg)       = App (libCase env fun) (libCase env arg)
-libCase env (Note note body)    = Note note (libCase env body)
-
-libCase env (Lam binder body)
-  = Lam binder (libCase (addBinders env [binder]) body)
-
-libCase env (Let bind body)
-  = Let bind' (libCase env_body body)
-  where
-    (env_body, bind') = libCaseBind env bind
-
-libCase env (Case scrut bndr ty alts)
-  = Case (libCase env scrut) bndr ty (map (libCaseAlt env_alts) alts)
-  where
-    env_alts = addBinders env_with_scrut [bndr]
-    env_with_scrut = case scrut of
-		  	Var scrut_var -> addScrutedVar env scrut_var
-			other	      -> env
-
-libCaseAlt env (con,args,rhs) = (con, args, libCase (addBinders env args) rhs)
-\end{code}
-
-Ids
-~~~
-\begin{code}
-libCaseId :: LibCaseEnv -> Id -> CoreExpr
-libCaseId env v
-  | Just the_bind <- lookupRecId env v	-- It's a use of a recursive thing
-  , notNull free_scruts 		-- with free vars scrutinised in RHS
-  = Let the_bind (Var v)
-
-  | otherwise
-  = Var v
-
-  where
-    rec_id_level = lookupLevel env v
-    free_scruts  = freeScruts env rec_id_level
-\end{code}
-
-
-
-Utility functions
-~~~~~~~~~~~~~~~~~
-\begin{code}
-addBinders :: LibCaseEnv -> [CoreBndr] -> LibCaseEnv
-addBinders (LibCaseEnv bomb lvl lvl_env rec_env scruts) binders
-  = LibCaseEnv bomb lvl lvl_env' rec_env scruts
-  where
-    lvl_env' = extendVarEnvList lvl_env (binders `zip` repeat lvl)
-
-addRecBinds :: LibCaseEnv -> [(Id,CoreExpr)] -> LibCaseEnv
-addRecBinds (LibCaseEnv bomb lvl lvl_env rec_env scruts) pairs
-  = LibCaseEnv bomb lvl' lvl_env' rec_env' scruts
-  where
-    lvl'     = lvl + 1
-    lvl_env' = extendVarEnvList lvl_env [(binder,lvl) | (binder,_) <- pairs]
-    rec_env' = extendVarEnvList rec_env [(binder, Rec pairs) | (binder,_) <- pairs]
-
-addScrutedVar :: LibCaseEnv
-	      -> Id		-- This Id is being scrutinised by a case expression
-	      -> LibCaseEnv
-
-addScrutedVar env@(LibCaseEnv bomb lvl lvl_env rec_env scruts) scrut_var
-  | bind_lvl < lvl
-  = LibCaseEnv bomb lvl lvl_env rec_env scruts'
-	-- Add to scruts iff the scrut_var is being scrutinised at
-	-- a deeper level than its defn
-
-  | otherwise = env
-  where
-    scruts'  = (scrut_var, lvl) : scruts
-    bind_lvl = case lookupVarEnv lvl_env scrut_var of
-		 Just lvl -> lvl
-		 Nothing  -> topLevel
-
-lookupRecId :: LibCaseEnv -> Id -> Maybe CoreBind
-lookupRecId (LibCaseEnv bomb lvl lvl_env rec_env scruts) id
-  = lookupVarEnv rec_env id
-
-lookupLevel :: LibCaseEnv -> Id -> LibCaseLevel
-lookupLevel (LibCaseEnv bomb lvl lvl_env rec_env scruts) id
-  = case lookupVarEnv lvl_env id of
-      Just lvl -> lvl
-      Nothing  -> topLevel
-
-freeScruts :: LibCaseEnv
-	   -> LibCaseLevel 	-- Level of the recursive Id
-	   -> [Id]		-- Ids that are scrutinised between the binding
-				-- of the recursive Id and here
-freeScruts (LibCaseEnv bomb lvl lvl_env rec_env scruts) rec_bind_lvl
-  = [v | (v,scrut_lvl) <- scruts, scrut_lvl > rec_bind_lvl]
-\end{code}
diff --git a/ghc/compiler/simplCore/OccurAnal.lhs b/ghc/compiler/simplCore/OccurAnal.lhs
deleted file mode 100644
index 90a565f4dd..0000000000
--- a/ghc/compiler/simplCore/OccurAnal.lhs
+++ /dev/null
@@ -1,823 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-%************************************************************************
-%*									*
-\section[OccurAnal]{Occurrence analysis pass}
-%*									*
-%************************************************************************
-
-The occurrence analyser re-typechecks a core expression, returning a new
-core expression with (hopefully) improved usage information.
-
-\begin{code}
-module OccurAnal (
-	occurAnalysePgm, occurAnalyseExpr
-    ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-import CoreFVs		( idRuleVars )
-import CoreUtils	( exprIsTrivial, isDefaultAlt )
-import Id		( isDataConWorkId, isOneShotBndr, setOneShotLambda, 
-			  idOccInfo, setIdOccInfo, isLocalId,
-			  isExportedId, idArity, idSpecialisation,
-			  idType, idUnique, Id
-			)
-import IdInfo		( isEmptySpecInfo )
-import BasicTypes	( OccInfo(..), isOneOcc, InterestingCxt )
-
-import VarSet
-import VarEnv
-
-import Type		( isFunTy, dropForAlls )
-import Maybes		( orElse )
-import Digraph		( stronglyConnCompR, SCC(..) )
-import PrelNames	( buildIdKey, foldrIdKey, runSTRepIdKey, augmentIdKey )
-import Unique		( Unique )
-import UniqFM		( keysUFM )  
-import Util		( zipWithEqual, mapAndUnzip )
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[OccurAnal-main]{Counting occurrences: main function}
-%*									*
-%************************************************************************
-
-Here's the externally-callable interface:
-
-\begin{code}
-occurAnalysePgm :: [CoreBind] -> [CoreBind]
-occurAnalysePgm binds
-  = snd (go initOccEnv binds)
-  where
-    go :: OccEnv -> [CoreBind] -> (UsageDetails, [CoreBind])
-    go env [] 
-	= (emptyDetails, [])
-    go env (bind:binds) 
-	= (final_usage, bind' ++ binds')
-	where
-	   (bs_usage, binds')   = go env binds
-	   (final_usage, bind') = occAnalBind env bind bs_usage
-
-occurAnalyseExpr :: CoreExpr -> CoreExpr
-	-- Do occurrence analysis, and discard occurence info returned
-occurAnalyseExpr expr = snd (occAnal initOccEnv expr)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[OccurAnal-main]{Counting occurrences: main function}
-%*									*
-%************************************************************************
-
-Bindings
-~~~~~~~~
-
-\begin{code}
-type IdWithOccInfo = Id			-- An Id with fresh PragmaInfo attached
-
-type Node details = (details, Unique, [Unique])	-- The Ints are gotten from the Unique,
-						-- which is gotten from the Id.
-type Details1	  = (Id, UsageDetails, CoreExpr)
-type Details2	  = (IdWithOccInfo, CoreExpr)
-
-
-occAnalBind :: OccEnv
-	    -> CoreBind
-	    -> UsageDetails		-- Usage details of scope
-	    -> (UsageDetails,		-- Of the whole let(rec)
-		[CoreBind])
-
-occAnalBind env (NonRec binder rhs) body_usage
-  | not (binder `usedIn` body_usage)		-- It's not mentioned
-  = (body_usage, [])
-
-  | otherwise			-- It's mentioned in the body
-  = (final_body_usage `combineUsageDetails` rhs_usage,
-     [NonRec tagged_binder rhs'])
-
-  where
-    (final_body_usage, tagged_binder) = tagBinder body_usage binder
-    (rhs_usage, rhs')		      = occAnalRhs env tagged_binder rhs
-\end{code}
-
-Dropping dead code for recursive bindings is done in a very simple way:
-
-	the entire set of bindings is dropped if none of its binders are
-	mentioned in its body; otherwise none are.
-
-This seems to miss an obvious improvement.
-@
-	letrec  f = ...g...
-		g = ...f...
-	in
-	...g...
-
-===>
-
-	letrec f = ...g...
-	       g = ...(...g...)...
-	in
-	...g...
-@
-
-Now @f@ is unused. But dependency analysis will sort this out into a
-@letrec@ for @g@ and a @let@ for @f@, and then @f@ will get dropped.
-It isn't easy to do a perfect job in one blow.  Consider
-
-@
-	letrec f = ...g...
-	       g = ...h...
-	       h = ...k...
-	       k = ...m...
-	       m = ...m...
-	in
-	...m...
-@
-
-
-\begin{code}
-occAnalBind env (Rec pairs) body_usage
-  = foldr (_scc_ "occAnalBind.dofinal" do_final_bind) (body_usage, []) sccs
-  where
-    analysed_pairs :: [Details1]
-    analysed_pairs  = [ (bndr, rhs_usage, rhs')
-		      | (bndr, rhs) <- pairs,
-			let (rhs_usage, rhs') = occAnalRhs env bndr rhs
-		      ]
-
-    sccs :: [SCC (Node Details1)]
-    sccs = _scc_ "occAnalBind.scc" stronglyConnCompR edges
-
-
-    ---- stuff for dependency analysis of binds -------------------------------
-    edges :: [Node Details1]
-    edges = _scc_ "occAnalBind.assoc"
-	    [ (details, idUnique id, edges_from rhs_usage)
-	    | details@(id, rhs_usage, rhs) <- analysed_pairs
-	    ]
-
-	-- (a -> b) means a mentions b
-	-- Given the usage details (a UFM that gives occ info for each free var of
-	-- the RHS) we can get the list of free vars -- or rather their Int keys --
-	-- by just extracting the keys from the finite map.  Grimy, but fast.
-	-- Previously we had this:
-	-- 	[ bndr | bndr <- bndrs,
-	--		 maybeToBool (lookupVarEnv rhs_usage bndr)]
-	-- which has n**2 cost, and this meant that edges_from alone 
-	-- consumed 10% of total runtime!
-    edges_from :: UsageDetails -> [Unique]
-    edges_from rhs_usage = _scc_ "occAnalBind.edges_from"
-			   keysUFM rhs_usage
-
-    ---- stuff to "re-constitute" bindings from dependency-analysis info ------
-
-	-- Non-recursive SCC
-    do_final_bind (AcyclicSCC ((bndr, rhs_usage, rhs'), _, _)) (body_usage, binds_so_far)
-      | not (bndr `usedIn` body_usage)
-      = (body_usage, binds_so_far)			-- Dead code
-      | otherwise
-      = (combined_usage, new_bind : binds_so_far)	
-      where
-	total_usage       	      = combineUsageDetails body_usage rhs_usage
-	(combined_usage, tagged_bndr) = tagBinder total_usage bndr
-	new_bind		      = NonRec tagged_bndr rhs'
-
-	-- Recursive SCC
-    do_final_bind (CyclicSCC cycle) (body_usage, binds_so_far)
-      | not (any (`usedIn` body_usage) bndrs)		-- NB: look at body_usage, not total_usage
-      = (body_usage, binds_so_far)			-- Dead code
-      | otherwise
-      = (combined_usage, final_bind:binds_so_far)
-      where
-	details			       = [details   | (details, _, _) <- cycle]
-	bndrs			       = [bndr      | (bndr, _, _)      <- details]
-	rhs_usages		       = [rhs_usage | (_, rhs_usage, _) <- details]
-	total_usage		       = foldr combineUsageDetails body_usage rhs_usages
-	(combined_usage, tagged_bndrs) = tagBinders total_usage bndrs
-	final_bind		       = Rec (reOrderRec env new_cycle)
-
-	new_cycle = CyclicSCC (zipWithEqual "occAnalBind" mk_new_bind tagged_bndrs cycle)
-	mk_new_bind tagged_bndr ((_, _, rhs'), key, keys) = ((tagged_bndr, rhs'), key, keys)
-\end{code}
-
-@reOrderRec@ is applied to the list of (binder,rhs) pairs for a cyclic
-strongly connected component (there's guaranteed to be a cycle).  It returns the
-same pairs, but 
-	a) in a better order,
-	b) with some of the Ids having a IMustNotBeINLINEd pragma
-
-The "no-inline" Ids are sufficient to break all cycles in the SCC.  This means
-that the simplifier can guarantee not to loop provided it never records an inlining
-for these no-inline guys.
-
-Furthermore, the order of the binds is such that if we neglect dependencies
-on the no-inline Ids then the binds are topologically sorted.  This means
-that the simplifier will generally do a good job if it works from top bottom,
-recording inlinings for any Ids which aren't marked as "no-inline" as it goes.
-
-==============
-[June 98: I don't understand the following paragraphs, and I've 
-	  changed the a=b case again so that it isn't a special case any more.]
-
-Here's a case that bit me:
-
-	letrec
-		a = b
-		b = \x. BIG
-	in
-	...a...a...a....
-
-Re-ordering doesn't change the order of bindings, but there was no loop-breaker.
-
-My solution was to make a=b bindings record b as Many, rather like INLINE bindings.
-Perhaps something cleverer would suffice.
-===============
-
-You might think that you can prevent non-termination simply by making
-sure that we simplify a recursive binding's RHS in an environment that
-simply clones the recursive Id.  But no.  Consider
-
-		letrec f = \x -> let z = f x' in ...
-
-		in
-		let n = f y
-		in
-		case n of { ... }
-
-We bind n to its *simplified* RHS, we then *re-simplify* it when
-we inline n.  Then we may well inline f; and then the same thing
-happens with z!
-
-I don't think it's possible to prevent non-termination by environment
-manipulation in this way.  Apart from anything else, successive
-iterations of the simplifier may unroll recursive loops in cases like
-that above.  The idea of beaking every recursive loop with an
-IMustNotBeINLINEd pragma is much much better.
-
-
-\begin{code}
-reOrderRec
-	:: OccEnv
-	-> SCC (Node Details2)
-	-> [Details2]
-			-- Sorted into a plausible order.  Enough of the Ids have
-			--	dontINLINE pragmas that there are no loops left.
-
-	-- Non-recursive case
-reOrderRec env (AcyclicSCC (bind, _, _)) = [bind]
-
-	-- Common case of simple self-recursion
-reOrderRec env (CyclicSCC [bind])
-  = [(setIdOccInfo tagged_bndr IAmALoopBreaker, rhs)]
-  where
-    ((tagged_bndr, rhs), _, _) = bind
-
-reOrderRec env (CyclicSCC (bind : binds))
-  = 	-- Choose a loop breaker, mark it no-inline,
-	-- do SCC analysis on the rest, and recursively sort them out
-    concat (map (reOrderRec env) (stronglyConnCompR unchosen))
-    ++ 
-    [(setIdOccInfo tagged_bndr IAmALoopBreaker, rhs)]
-
-  where
-    (chosen_pair, unchosen) = choose_loop_breaker bind (score bind) [] binds
-    (tagged_bndr, rhs)      = chosen_pair
-
-	-- This loop looks for the bind with the lowest score
-	-- to pick as the loop  breaker.  The rest accumulate in 
-    choose_loop_breaker (details,_,_) loop_sc acc []
-	= (details, acc)	-- Done
-
-    choose_loop_breaker loop_bind loop_sc acc (bind : binds)
-	| sc < loop_sc	-- Lower score so pick this new one
-	= choose_loop_breaker bind sc (loop_bind : acc) binds
-
-	| otherwise	-- No lower so don't pick it
-	= choose_loop_breaker loop_bind loop_sc (bind : acc) binds
-	where
-	  sc = score bind
-	  
-    score :: Node Details2 -> Int	-- Higher score => less likely to be picked as loop breaker
-    score ((bndr, rhs), _, _)
-	| exprIsTrivial rhs 	   = 4	-- Practically certain to be inlined
-		-- Used to have also: && not (isExportedId bndr)
-		-- But I found this sometimes cost an extra iteration when we have
-		--	rec { d = (a,b); a = ...df...; b = ...df...; df = d }
-		-- where df is the exported dictionary. Then df makes a really
-		-- bad choice for loop breaker
-	  
-	| not_fun_ty (idType bndr) = 3	-- Data types help with cases
-		-- This used to have a lower score than inlineCandidate, but
-		-- it's *really* helpful if dictionaries get inlined fast,
-		-- so I'm experimenting with giving higher priority to data-typed things
-
-	| inlineCandidate bndr rhs = 2	-- Likely to be inlined
-
-	| not (isEmptySpecInfo (idSpecialisation bndr)) = 1
-		-- Avoid things with specialisations; we'd like
-		-- to take advantage of them in the subsequent bindings
-
-	| otherwise = 0
-
-    inlineCandidate :: Id -> CoreExpr -> Bool
-    inlineCandidate id (Note InlineMe _) = True
-    inlineCandidate id rhs	         = isOneOcc (idOccInfo id)
-
-	-- Real example (the Enum Ordering instance from PrelBase):
-	--	rec	f = \ x -> case d of (p,q,r) -> p x
-	--		g = \ x -> case d of (p,q,r) -> q x
-	--		d = (v, f, g)
-	--
-	-- Here, f and g occur just once; but we can't inline them into d.
-	-- On the other hand we *could* simplify those case expressions if
-	-- we didn't stupidly choose d as the loop breaker.
-	-- But we won't because constructor args are marked "Many".
-
-    not_fun_ty ty = not (isFunTy (dropForAlls ty))
-\end{code}
-
-@occAnalRhs@ deals with the question of bindings where the Id is marked
-by an INLINE pragma.  For these we record that anything which occurs
-in its RHS occurs many times.  This pessimistically assumes that ths
-inlined binder also occurs many times in its scope, but if it doesn't
-we'll catch it next time round.  At worst this costs an extra simplifier pass.
-ToDo: try using the occurrence info for the inline'd binder.
-
-[March 97] We do the same for atomic RHSs.  Reason: see notes with reOrderRec.
-[June 98, SLPJ]  I've undone this change; I don't understand it.  See notes with reOrderRec.
-
-
-\begin{code}
-occAnalRhs :: OccEnv
-	   -> Id -> CoreExpr	-- Binder and rhs
-				-- For non-recs the binder is alrady tagged
-				-- with occurrence info
-	   -> (UsageDetails, CoreExpr)
-
-occAnalRhs env id rhs
-  = (final_usage, rhs')
-  where
-    (rhs_usage, rhs') = occAnal ctxt rhs
-    ctxt | certainly_inline id = env
-	 | otherwise	       = rhsCtxt
-	-- Note that we generally use an rhsCtxt.  This tells the occ anal n
-	-- that it's looking at an RHS, which has an effect in occAnalApp
-	--
-	-- But there's a problem.  Consider
-	--	x1 = a0 : []
-	--	x2 = a1 : x1
-	--	x3 = a2 : x2
-	--	g  = f x3
-	-- First time round, it looks as if x1 and x2 occur as an arg of a 
-	-- let-bound constructor ==> give them a many-occurrence.
-	-- But then x3 is inlined (unconditionally as it happens) and
-	-- next time round, x2 will be, and the next time round x1 will be
-	-- Result: multiple simplifier iterations.  Sigh.  
-	-- Crude solution: use rhsCtxt for things that occur just once...
-
-    certainly_inline id = case idOccInfo id of
-			    OneOcc in_lam one_br _ -> not in_lam && one_br
-			    other		   -> False
-
-	-- [March 98] A new wrinkle is that if the binder has specialisations inside
-	-- it then we count the specialised Ids as "extra rhs's".  That way
-	-- the "parent" keeps the specialised "children" alive.  If the parent
-	-- dies (because it isn't referenced any more), then the children will
-	-- die too unless they are already referenced directly.
-
-    final_usage = addRuleUsage rhs_usage id
-
-addRuleUsage :: UsageDetails -> Id -> UsageDetails
--- Add the usage from RULES in Id to the usage
-addRuleUsage usage id
-  = foldVarSet add usage (idRuleVars id)
-  where
-    add v u = addOneOcc u v NoOccInfo		-- Give a non-committal binder info
-						-- (i.e manyOcc) because many copies
-						-- of the specialised thing can appear
-\end{code}
-
-Expressions
-~~~~~~~~~~~
-\begin{code}
-occAnal :: OccEnv
-	-> CoreExpr
-	-> (UsageDetails,	-- Gives info only about the "interesting" Ids
-	    CoreExpr)
-
-occAnal env (Type t)  = (emptyDetails, Type t)
-occAnal env (Var v)   = (mkOneOcc env v False, Var v)
-    -- At one stage, I gathered the idRuleVars for v here too,
-    -- which in a way is the right thing to do.
-    -- Btu that went wrong right after specialisation, when
-    -- the *occurrences* of the overloaded function didn't have any
-    -- rules in them, so the *specialised* versions looked as if they
-    -- weren't used at all.
-\end{code}
-
-We regard variables that occur as constructor arguments as "dangerousToDup":
-
-\begin{verbatim}
-module A where
-f x = let y = expensive x in 
-      let z = (True,y) in 
-      (case z of {(p,q)->q}, case z of {(p,q)->q})
-\end{verbatim}
-
-We feel free to duplicate the WHNF (True,y), but that means
-that y may be duplicated thereby.
-
-If we aren't careful we duplicate the (expensive x) call!
-Constructors are rather like lambdas in this way.
-
-\begin{code}
-occAnal env expr@(Lit lit) = (emptyDetails, expr)
-\end{code}
-
-\begin{code}
-occAnal env (Note InlineMe body)
-  = case occAnal env body of { (usage, body') -> 
-    (mapVarEnv markMany usage, Note InlineMe body')
-    }
-
-occAnal env (Note note@(SCC cc) body)
-  = case occAnal env body of { (usage, body') ->
-    (mapVarEnv markInsideSCC usage, Note note body')
-    }
-
-occAnal env (Note note body)
-  = case occAnal env body of { (usage, body') ->
-    (usage, Note note body')
-    }
-\end{code}
-
-\begin{code}
-occAnal env app@(App fun arg)
-  = occAnalApp env (collectArgs app) False
-
--- Ignore type variables altogether
---   (a) occurrences inside type lambdas only not marked as InsideLam
---   (b) type variables not in environment
-
-occAnal env expr@(Lam x body) | isTyVar x
-  = case occAnal env body of { (body_usage, body') ->
-    (body_usage, Lam x body')
-    }
-
--- For value lambdas we do a special hack.  Consider
--- 	(\x. \y. ...x...)
--- If we did nothing, x is used inside the \y, so would be marked
--- as dangerous to dup.  But in the common case where the abstraction
--- is applied to two arguments this is over-pessimistic.
--- So instead, we just mark each binder with its occurrence
--- info in the *body* of the multiple lambda.
--- Then, the simplifier is careful when partially applying lambdas.
-
-occAnal env expr@(Lam _ _)
-  = case occAnal env_body body of { (body_usage, body') ->
-    let
-        (final_usage, tagged_binders) = tagBinders body_usage binders
-	--	URGH!  Sept 99: we don't seem to be able to use binders' here, because
-	--	we get linear-typed things in the resulting program that we can't handle yet.
-	--	(e.g. PrelShow)  TODO 
-
-	really_final_usage = if linear then
-				final_usage
-			     else
-				mapVarEnv markInsideLam final_usage
-    in
-    (really_final_usage,
-     mkLams tagged_binders body') }
-  where
-    env_body	    = vanillaCtxt			-- Body is (no longer) an RhsContext
-    (binders, body) = collectBinders expr
-    binders' 	    = oneShotGroup env binders
-    linear	    = all is_one_shot binders'
-    is_one_shot b   = isId b && isOneShotBndr b
-
-occAnal env (Case scrut bndr ty alts)
-  = case occ_anal_scrut scrut alts		of { (scrut_usage, scrut') ->
-    case mapAndUnzip (occAnalAlt env bndr) alts of { (alts_usage_s, alts')   -> 
-    let
-	alts_usage  = foldr1 combineAltsUsageDetails alts_usage_s
-	alts_usage' = addCaseBndrUsage alts_usage
-	(alts_usage1, tagged_bndr) = tagBinder alts_usage' bndr
-        total_usage = scrut_usage `combineUsageDetails` alts_usage1
-    in
-    total_usage `seq` (total_usage, Case scrut' tagged_bndr ty alts') }}
-  where
-	-- The case binder gets a usage of either "many" or "dead", never "one".
-	-- Reason: we like to inline single occurrences, to eliminate a binding,
-	-- but inlining a case binder *doesn't* eliminate a binding.
-	-- We *don't* want to transform
-	--	case x of w { (p,q) -> f w }
-	-- into
-	--	case x of w { (p,q) -> f (p,q) }
-    addCaseBndrUsage usage = case lookupVarEnv usage bndr of
-				Nothing  -> usage
-				Just occ -> extendVarEnv usage bndr (markMany occ)
-
-    occ_anal_scrut (Var v) (alt1 : other_alts)
-				| not (null other_alts) || not (isDefaultAlt alt1)
-			        = (mkOneOcc env v True, Var v)
-    occ_anal_scrut scrut alts   = occAnal vanillaCtxt scrut
-					-- No need for rhsCtxt
-
-occAnal env (Let bind body)
-  = case occAnal env body     	         of { (body_usage, body') ->
-    case occAnalBind env bind body_usage of { (final_usage, new_binds) ->
-       (final_usage, mkLets new_binds body') }}
-
-occAnalArgs env args
-  = case mapAndUnzip (occAnal arg_env) args of	{ (arg_uds_s, args') ->
-    (foldr combineUsageDetails emptyDetails arg_uds_s, args')}
-  where
-    arg_env = vanillaCtxt
-\end{code}
-
-Applications are dealt with specially because we want
-the "build hack" to work.
-
-\begin{code}
--- Hack for build, fold, runST
-occAnalApp env (Var fun, args) is_rhs
-  = case args_stuff of { (args_uds, args') ->
-    let
-	-- We mark the free vars of the argument of a constructor or PAP 
-	-- as "many", if it is the RHS of a let(rec).
-	-- This means that nothing gets inlined into a constructor argument
-	-- position, which is what we want.  Typically those constructor
-	-- arguments are just variables, or trivial expressions.
-	--
-	-- This is the *whole point* of the isRhsEnv predicate
-        final_args_uds
-		| isRhsEnv env,
-		  isDataConWorkId fun || valArgCount args < idArity fun
-		= mapVarEnv markMany args_uds
-		| otherwise = args_uds
-    in
-    (fun_uds `combineUsageDetails` final_args_uds, mkApps (Var fun) args') }
-  where
-    fun_uniq = idUnique fun
-    fun_uds  = mkOneOcc env fun (valArgCount args > 0)
-    args_stuff	| fun_uniq == buildIdKey    = appSpecial env 2 [True,True]  args
-		| fun_uniq == augmentIdKey  = appSpecial env 2 [True,True]  args
-		| fun_uniq == foldrIdKey    = appSpecial env 3 [False,True] args
-		| fun_uniq == runSTRepIdKey = appSpecial env 2 [True]	    args
-			-- (foldr k z xs) may call k many times, but it never
-			-- shares a partial application of k; hence [False,True]
-			-- This means we can optimise
-			--	foldr (\x -> let v = ...x... in \y -> ...v...) z xs
-			-- by floating in the v
-
-		| otherwise = occAnalArgs env args
-
-
-occAnalApp env (fun, args) is_rhs
-  = case occAnal (addAppCtxt env args) fun of	{ (fun_uds, fun') ->
-	-- The addAppCtxt is a bit cunning.  One iteration of the simplifier
-	-- often leaves behind beta redexs like
-	--	(\x y -> e) a1 a2
-	-- Here we would like to mark x,y as one-shot, and treat the whole
-	-- thing much like a let.  We do this by pushing some True items
-	-- onto the context stack.
-
-    case occAnalArgs env args of	{ (args_uds, args') ->
-    let
-	final_uds = fun_uds `combineUsageDetails` args_uds
-    in
-    (final_uds, mkApps fun' args') }}
-    
-appSpecial :: OccEnv 
-	   -> Int -> CtxtTy	-- Argument number, and context to use for it
-	   -> [CoreExpr]
-	   -> (UsageDetails, [CoreExpr])
-appSpecial env n ctxt args
-  = go n args
-  where
-    arg_env = vanillaCtxt
-
-    go n [] = (emptyDetails, [])	-- Too few args
-
-    go 1 (arg:args)			-- The magic arg
-      = case occAnal (setCtxt arg_env ctxt) arg of	{ (arg_uds, arg') ->
-	case occAnalArgs env args of			{ (args_uds, args') ->
-	(combineUsageDetails arg_uds args_uds, arg':args') }}
-    
-    go n (arg:args)
-      = case occAnal arg_env arg of	{ (arg_uds, arg') ->
-	case go (n-1) args of		{ (args_uds, args') ->
-	(combineUsageDetails arg_uds args_uds, arg':args') }}
-\end{code}
-
-    
-Case alternatives
-~~~~~~~~~~~~~~~~~
-If the case binder occurs at all, the other binders effectively do too.  
-For example
-	case e of x { (a,b) -> rhs }
-is rather like
-	let x = (a,b) in rhs
-If e turns out to be (e1,e2) we indeed get something like
-	let a = e1; b = e2; x = (a,b) in rhs
-
-\begin{code}
-occAnalAlt env case_bndr (con, bndrs, rhs)
-  = case occAnal env rhs of { (rhs_usage, rhs') ->
-    let
-        (final_usage, tagged_bndrs) = tagBinders rhs_usage bndrs
-	final_bndrs | case_bndr `elemVarEnv` final_usage = bndrs
-		    | otherwise				= tagged_bndrs
-		-- Leave the binders untagged if the case 
-		-- binder occurs at all; see note above
-    in
-    (final_usage, (con, final_bndrs, rhs')) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[OccurAnal-types]{OccEnv}
-%*									*
-%************************************************************************
-
-\begin{code}
-data OccEnv
-  = OccEnv OccEncl	-- Enclosing context information
-	   CtxtTy	-- Tells about linearity
-
--- OccEncl is used to control whether to inline into constructor arguments
--- For example:
---	x = (p,q)		-- Don't inline p or q
---	y = /\a -> (p a, q a)	-- Still don't inline p or q
---	z = f (p,q)		-- Do inline p,q; it may make a rule fire
--- So OccEncl tells enought about the context to know what to do when
--- we encounter a contructor application or PAP.
-
-data OccEncl
-  = OccRhs 		-- RHS of let(rec), albeit perhaps inside a type lambda
-			-- Don't inline into constructor args here
-  | OccVanilla		-- Argument of function, body of lambda, scruintee of case etc.
-			-- Do inline into constructor args here
-
-type CtxtTy = [Bool]
-	-- []	 	No info
-	--
-	-- True:ctxt  	Analysing a function-valued expression that will be
-	--			applied just once
-	--
-	-- False:ctxt	Analysing a function-valued expression that may
-	--			be applied many times; but when it is, 
-	--			the CtxtTy inside applies
-
-initOccEnv :: OccEnv
-initOccEnv = OccEnv OccRhs []
-
-vanillaCtxt = OccEnv OccVanilla []
-rhsCtxt     = OccEnv OccRhs     []
-
-isRhsEnv (OccEnv OccRhs     _) = True
-isRhsEnv (OccEnv OccVanilla _) = False
-
-setCtxt :: OccEnv -> CtxtTy -> OccEnv
-setCtxt (OccEnv encl _) ctxt = OccEnv encl ctxt
-
-oneShotGroup :: OccEnv -> [CoreBndr] -> [CoreBndr]
-	-- The result binders have one-shot-ness set that they might not have had originally.
-	-- This happens in (build (\cn -> e)).  Here the occurrence analyser
-	-- linearity context knows that c,n are one-shot, and it records that fact in
-	-- the binder. This is useful to guide subsequent float-in/float-out tranformations
-
-oneShotGroup (OccEnv encl ctxt) bndrs 
-  = go ctxt bndrs []
-  where
-    go ctxt [] rev_bndrs = reverse rev_bndrs
-
-    go (lin_ctxt:ctxt) (bndr:bndrs) rev_bndrs
-	| isId bndr = go ctxt bndrs (bndr':rev_bndrs)
-	where
-	  bndr' | lin_ctxt  = setOneShotLambda bndr
-		| otherwise = bndr
-
-    go ctxt (bndr:bndrs) rev_bndrs = go ctxt bndrs (bndr:rev_bndrs)
-
-addAppCtxt (OccEnv encl ctxt) args 
-  = OccEnv encl (replicate (valArgCount args) True ++ ctxt)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[OccurAnal-types]{OccEnv}
-%*									*
-%************************************************************************
-
-\begin{code}
-type UsageDetails = IdEnv OccInfo	-- A finite map from ids to their usage
-
-combineUsageDetails, combineAltsUsageDetails
-	:: UsageDetails -> UsageDetails -> UsageDetails
-
-combineUsageDetails usage1 usage2
-  = plusVarEnv_C addOccInfo usage1 usage2
-
-combineAltsUsageDetails usage1 usage2
-  = plusVarEnv_C orOccInfo usage1 usage2
-
-addOneOcc :: UsageDetails -> Id -> OccInfo -> UsageDetails
-addOneOcc usage id info
-  = plusVarEnv_C addOccInfo usage (unitVarEnv id info)
-	-- ToDo: make this more efficient
-
-emptyDetails = (emptyVarEnv :: UsageDetails)
-
-usedIn :: Id -> UsageDetails -> Bool
-v `usedIn` details =  isExportedId v || v `elemVarEnv` details
-
-tagBinders :: UsageDetails	    -- Of scope
-	   -> [Id]		    -- Binders
-	   -> (UsageDetails, 	    -- Details with binders removed
-	      [IdWithOccInfo])    -- Tagged binders
-
-tagBinders usage binders
- = let
-     usage' = usage `delVarEnvList` binders
-     uss    = map (setBinderOcc usage) binders
-   in
-   usage' `seq` (usage', uss)
-
-tagBinder :: UsageDetails	    -- Of scope
-	  -> Id			    -- Binders
-	  -> (UsageDetails, 	    -- Details with binders removed
-	      IdWithOccInfo)	    -- Tagged binders
-
-tagBinder usage binder
- = let
-     usage'  = usage `delVarEnv` binder
-     binder' = setBinderOcc usage binder
-   in
-   usage' `seq` (usage', binder')
-
-setBinderOcc :: UsageDetails -> CoreBndr -> CoreBndr
-setBinderOcc usage bndr
-  | isTyVar bndr      = bndr
-  | isExportedId bndr = case idOccInfo bndr of
-			  NoOccInfo -> bndr
-			  other     -> setIdOccInfo bndr NoOccInfo
-  	    -- Don't use local usage info for visible-elsewhere things
-	    -- BUT *do* erase any IAmALoopBreaker annotation, because we're
-	    -- about to re-generate it and it shouldn't be "sticky"
-			  
-  | otherwise = setIdOccInfo bndr occ_info
-  where
-    occ_info = lookupVarEnv usage bndr `orElse` IAmDead
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Operations over OccInfo}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkOneOcc :: OccEnv -> Id -> InterestingCxt -> UsageDetails
-mkOneOcc env id int_cxt
-  | isLocalId id = unitVarEnv id (OneOcc False True int_cxt)
-  | otherwise    = emptyDetails
-
-markMany, markInsideLam, markInsideSCC :: OccInfo -> OccInfo
-
-markMany IAmDead = IAmDead
-markMany other   = NoOccInfo
-
-markInsideSCC occ = markMany occ
-
-markInsideLam (OneOcc _ one_br int_cxt) = OneOcc True one_br int_cxt
-markInsideLam occ		 	= occ
-
-addOccInfo, orOccInfo :: OccInfo -> OccInfo -> OccInfo
-
-addOccInfo IAmDead info2 = info2
-addOccInfo info1 IAmDead = info1
-addOccInfo info1 info2   = NoOccInfo
-
--- (orOccInfo orig new) is used
--- when combining occurrence info from branches of a case
-
-orOccInfo IAmDead info2 = info2
-orOccInfo info1 IAmDead = info1
-orOccInfo (OneOcc in_lam1 one_branch1 int_cxt1)
-	  (OneOcc in_lam2 one_branch2 int_cxt2)
-  = OneOcc (in_lam1 || in_lam2)
-	   False	-- False, because it occurs in both branches
-	   (int_cxt1 && int_cxt2)
-
-orOccInfo info1 info2 = NoOccInfo
-\end{code}
diff --git a/ghc/compiler/simplCore/SAT.lhs b/ghc/compiler/simplCore/SAT.lhs
deleted file mode 100644
index 81f3c4c406..0000000000
--- a/ghc/compiler/simplCore/SAT.lhs
+++ /dev/null
@@ -1,214 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-%************************************************************************
-%*									*
-\section[SAT]{Static Argument Transformation pass}
-%*									*
-%************************************************************************
-
-96/03: We aren't using the static-argument transformation right now.
-
-May be seen as removing invariants from loops:
-Arguments of recursive functions that do not change in recursive
-calls are removed from the recursion, which is done locally
-and only passes the arguments which effectively change.
-
-Example:
-map = /\ ab -> \f -> \xs -> case xs of
-			     []	   -> []
-			     (a:b) -> f a : map f b
-
-as map is recursively called with the same argument f (unmodified)
-we transform it to
-
-map = /\ ab -> \f -> \xs -> let map' ys = case ys of
-					   []	 -> []
-					   (a:b) -> f a : map' b
-			    in map' xs
-
-Notice that for a compiler that uses lambda lifting this is
-useless as map' will be transformed back to what map was.
-
-We could possibly do the same for big lambdas, but we don't as
-they will eventually be removed in later stages of the compiler,
-therefore there is no penalty in keeping them.
-
-Experimental Evidence: Heap: +/- 7%
-		       Instrs: Always improves for 2 or more Static Args.
-
-\begin{code}
-module SAT ( doStaticArgs ) where
-
-#include "HsVersions.h"
-
-import Panic	( panic )
-
-doStaticArgs = panic "SAT.doStaticArgs (ToDo)"
-
-{- LATER: to end of file:
-
-import SATMonad
-import Util
-\end{code}
-
-\begin{code}
-doStaticArgs :: [CoreBind] -> UniqSupply -> [CoreBind]
-
-doStaticArgs binds
-  = do {
-	showPass "Static argument";
-	let { binds' = initSAT (mapSAT sat_bind binds) };
-	endPass "Static argument" 
-		False		-- No specific flag for dumping SAT
-		binds'
-    }
-  where
-    sat_bind (NonRec binder expr)
-      = emptyEnvSAT  `thenSAT_`
-	satExpr expr `thenSAT` (\ expr' ->
-	returnSAT (NonRec binder expr') )
-    sat_bind (Rec [(binder,rhs)])
-      = emptyEnvSAT			  `thenSAT_`
-	insSAEnv binder (getArgLists rhs) `thenSAT_`
-	satExpr rhs			  `thenSAT` (\ rhs' ->
-	saTransform binder rhs')
-    sat_bind (Rec pairs)
-      = emptyEnvSAT		`thenSAT_`
-	mapSAT satExpr rhss	`thenSAT` \ rhss' ->
-	returnSAT (Rec (zipEqual "doStaticArgs" binders rhss'))
-      where
-	(binders, rhss)	= unzip pairs
-\end{code}
-
-\begin{code}
-satAtom (VarArg v)
-  = updSAEnv (Just (v,([],[]))) `thenSAT_`
-    returnSAT ()
-
-satAtom _ = returnSAT ()
-\end{code}
-
-\begin{code}
-satExpr :: CoreExpr -> SatM CoreExpr
-
-satExpr var@(Var v)
-  = updSAEnv (Just (v,([],[]))) `thenSAT_`
-    returnSAT var
-
-satExpr lit@(Lit _) = returnSAT lit
-
-satExpr e@(Prim prim ty args)
-  = mapSAT satAtom args	    `thenSAT_`
-    returnSAT e
-
-satExpr (Lam binders body)
-  = satExpr body		`thenSAT` \ body' ->
-    returnSAT (Lam binders body')
-
-satExpr (CoTyLam tyvar body)
-  = satExpr body	   `thenSAT` (\ body' ->
-    returnSAT (CoTyLam tyvar body') )
-
-satExpr app@(App _ _)
-  = getAppArgs app
-
-satExpr app@(CoTyApp _ _)
-  = getAppArgs app
-
-satExpr (Case expr alts)
-  = satExpr expr	`thenSAT` \ expr' ->
-    sat_alts alts	`thenSAT` \ alts' ->
-    returnSAT (Case expr' alts')
-  where
-    sat_alts (AlgAlts alts deflt)
-      = mapSAT satAlgAlt alts	    `thenSAT` \ alts' ->
-	sat_default deflt	    `thenSAT` \ deflt' ->
-	returnSAT (AlgAlts alts' deflt')
-      where
-	satAlgAlt (con, params, rhs)
-	  = satExpr rhs		 `thenSAT` \ rhs' ->
-	    returnSAT (con, params, rhs')
-
-    sat_alts (PrimAlts alts deflt)
-      = mapSAT satPrimAlt alts	    `thenSAT` \ alts' ->
-	sat_default deflt	    `thenSAT` \ deflt' ->
-	returnSAT (PrimAlts alts' deflt')
-      where
-	satPrimAlt (lit, rhs)
-	  = satExpr rhs `thenSAT` \ rhs' ->
-	    returnSAT (lit, rhs')
-
-    sat_default NoDefault
-      = returnSAT NoDefault
-    sat_default (BindDefault binder rhs)
-      = satExpr rhs		     `thenSAT` \ rhs' ->
-	returnSAT (BindDefault binder rhs')
-
-satExpr (Let (NonRec binder rhs) body)
-  = satExpr body		`thenSAT` \ body' ->
-    satExpr rhs			`thenSAT` \ rhs' ->
-    returnSAT (Let (NonRec binder rhs') body')
-
-satExpr (Let (Rec [(binder,rhs)]) body)
-  = satExpr body		      `thenSAT` \ body' ->
-    insSAEnv binder (getArgLists rhs) `thenSAT_`
-    satExpr rhs			      `thenSAT` \ rhs' ->
-    saTransform binder rhs'	      `thenSAT` \ binding ->
-    returnSAT (Let binding body')
-
-satExpr (Let (Rec binds) body)
-  = let
-	(binders, rhss) = unzip binds
-    in
-    satExpr body		    `thenSAT` \ body' ->
-    mapSAT satExpr rhss		    `thenSAT` \ rhss' ->
-    returnSAT (Let (Rec (zipEqual "satExpr:Rec" binders rhss')) body')
-
-satExpr (Note note expr)
-  = satExpr expr		    `thenSAT` \ expr2 ->
-    returnSAT (Note note expr2)
-\end{code}
-
-\begin{code}
-getAppArgs :: CoreExpr -> SatM CoreExpr
-
-getAppArgs app
-  = get app		`thenSAT` \ (app',result) ->
-    updSAEnv result	`thenSAT_`
-    returnSAT app'
-  where
-    get :: CoreExpr
-	-> SatM (CoreExpr, Maybe (Id, SATInfo))
-
-    get (CoTyApp e ty)
-      = get e		`thenSAT` \ (e',result) ->
-	returnSAT (
-	  CoTyApp e' ty,
-	  case result of
-	    Nothing	     -> Nothing
-	    Just (v,(tv,lv)) -> Just (v,(tv++[Static ty],lv))
-	)
-
-    get (App e a)
-      = get e		`thenSAT` \ (e', result) ->
-	satAtom a	`thenSAT_`
-	let si = case a of
-		   (VarArg v) -> Static v
-		   _	         -> NotStatic
-	in
-	  returnSAT (
-	    App e' a,
-	    case result of
-		Just (v,(tv,lv)) -> Just (v,(tv,lv++[si]))
-		Nothing	    	 -> Nothing
-	  )
-
-    get var@(Var v)
-      = returnSAT (var, Just (v,([],[])))
-
-    get e
-      = satExpr e	`thenSAT` \ e2 ->
-	returnSAT (e2, Nothing)
--}
-\end{code}
diff --git a/ghc/compiler/simplCore/SATMonad.lhs b/ghc/compiler/simplCore/SATMonad.lhs
deleted file mode 100644
index 9786f448af..0000000000
--- a/ghc/compiler/simplCore/SATMonad.lhs
+++ /dev/null
@@ -1,263 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-%************************************************************************
-%*									*
-\section[SATMonad]{The Static Argument Transformation pass Monad}
-%*									*
-%************************************************************************
-
-96/03: We aren't using the static-argument transformation right now.
-
-\begin{code}
-module SATMonad where
-
-#include "HsVersions.h"
-
-import Panic		( panic )
-
-junk_from_SATMonad = panic "SATMonad.junk"
-
-{- LATER: to end of file:
-
-module SATMonad (
-	SATInfo(..), updSAEnv,
-	SatM(..), initSAT, emptyEnvSAT,
-	returnSAT, thenSAT, thenSAT_, mapSAT, getSATInfo, newSATName,
-	getArgLists, Arg(..), insSAEnv, saTransform,
-
-	SATEnv(..), isStatic, dropStatics
-    ) where
-
-import Type		( mkTyVarTy, mkSigmaTy,
-			  splitSigmaTy, splitFunTys,
-			  glueTyArgs, substTy,
-			  InstTyEnv(..)
-			)
-import MkId		( mkSysLocal )
-import Id		( idType, idName, mkLocalId )
-import UniqSupply
-import Util
-
-infixr 9 `thenSAT`, `thenSAT_`
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Static Argument Transformation Environment}
-%*									*
-%************************************************************************
-
-\begin{code}
-type SATEnv = IdEnv SATInfo
-
-type SATInfo = ([Arg Type],[Arg Id])
-
-data Arg a = Static a | NotStatic
-    deriving Eq
-
-delOneFromSAEnv v us env
-  = ((), delVarEnv env v)
-
-updSAEnv :: Maybe (Id,SATInfo) -> SatM ()
-updSAEnv Nothing
-  = returnSAT ()
-updSAEnv (Just (b,(tyargs,args)))
-  = getSATInfo b      `thenSAT` (\ r ->
-    case r of
-      Nothing		   -> returnSAT ()
-      Just (tyargs',args') -> delOneFromSAEnv b `thenSAT_`
-			      insSAEnv b (checkArgs tyargs tyargs',
-					  checkArgs args args')
-    )
-
-checkArgs as [] = notStatics (length as)
-checkArgs [] as = notStatics (length as)
-checkArgs (a:as) (a':as') | a == a' = a:checkArgs as as'
-checkArgs (_:as) (_:as') = NotStatic:checkArgs as as'
-
-notStatics :: Int -> [Arg a]
-notStatics n = nOfThem n NotStatic
-
-insSAEnv :: Id -> SATInfo -> SatM ()
-insSAEnv b info us env
-  = ((), extendVarEnv env b info)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Static Argument Transformation Monad}
-%*									*
-%************************************************************************
-
-Two items of state to thread around: a UniqueSupply and a SATEnv.
-
-\begin{code}
-type SatM result
-  =  UniqSupply -> SATEnv -> (result, SATEnv)
-
-initSAT :: SatM a -> UniqSupply -> a
-
-initSAT f us = fst (f us emptyVarEnv)
-
-thenSAT m k us env
-  = case splitUniqSupply us	of { (s1, s2) ->
-    case m s1 env   	    	of { (m_result, menv) ->
-    k m_result s2 menv }}
-
-thenSAT_ m k us env
-  = case splitUniqSupply us	of { (s1, s2) ->
-    case m s1 env   	    	of { (_, menv) ->
-    k s2 menv }}
-
-emptyEnvSAT :: SatM ()
-emptyEnvSAT us _ = ((), emptyVarEnv)
-
-returnSAT v us env = (v, env)
-
-mapSAT f [] 	= returnSAT []
-mapSAT f (x:xs)
-  = f x		`thenSAT` \ x'	->
-    mapSAT f xs	`thenSAT` \ xs' ->
-    returnSAT (x':xs')
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Utility Functions}
-%*									*
-%************************************************************************
-
-\begin{code}
-getSATInfo :: Id -> SatM (Maybe SATInfo)
-getSATInfo var us env
-  = (lookupVarEnv env var, env)
-
-newSATName :: Id -> Type -> SatM Id
-newSATName id ty us env
-  = case (getUnique us) of { unique ->
-    let
-	new_name = mkCompoundName SLIT("$sat") unique (idName id)
-    in
-    (mkLocalId new_name ty, env) }
-
-getArgLists :: CoreExpr -> ([Arg Type],[Arg Id])
-getArgLists expr
-  = let
-	(tvs, lambda_bounds, body) = collectBinders expr
-    in
-    ([ Static (mkTyVarTy tv) | tv <- tvs ],
-     [ Static v		     | v <- lambda_bounds ])
-
-dropArgs :: CoreExpr -> CoreExpr
-dropArgs (Lam   _ e)	= dropArgs e
-dropArgs (CoTyLam _ e)	= dropArgs e
-dropArgs e		= e
-\end{code}
-
-We implement saTransform using shadowing of binders, that is
-we transform
-map = \f as -> case as of
-		 [] -> []
-		 (a':as') -> let x = f a'
-				 y = map f as'
-			     in x:y
-to
-map = \f as -> let map = \f as -> map' as
-	       in let rec map' = \as -> case as of
-					  [] -> []
-					  (a':as') -> let x = f a'
-							  y = map f as'
-						      in x:y
-		  in map' as
-
-the inner map should get inlined and eliminated.
-\begin{code}
-saTransform :: Id -> CoreExpr -> SatM CoreBinding
-saTransform binder rhs
-  = getSATInfo binder `thenSAT` \ r ->
-    case r of
-      -- [Andre] test: do it only if we have more than one static argument.
-      --Just (tyargs,args) | any isStatic args
-      Just (tyargs,args) | (filter isStatic args) `lengthExceeds` 1
-	-> newSATName binder (new_ty tyargs args)  `thenSAT` \ binder' ->
-	   mkNewRhs binder binder' tyargs args rhs `thenSAT` \ new_rhs ->
-	   trace ("SAT "++ show (length (filter isStatic args))) (
-	   returnSAT (NonRec binder new_rhs)
-	   )
-      _ -> returnSAT (Rec [(binder, rhs)])
-  where
-    mkNewRhs binder binder' tyargs args rhs
-      = let
-	    non_static_args :: [Id]
-	    non_static_args
-	       = get_nsa args (snd (getArgLists rhs))
-	       where
-		 get_nsa :: [Arg a] -> [Arg a] -> [a]
-		 get_nsa [] _ = []
-		 get_nsa _ [] = []
-		 get_nsa (NotStatic:args) (Static v:as) = v:get_nsa args as
-		 get_nsa (_:args)	  (_:as)	=   get_nsa args as
-
-	    local_body = foldl App (Var binder')
-				[VarArg a | a <- non_static_args]
-
-	    nonrec_rhs = origLams local_body
-
-	    -- HACK! The following is a fake SysLocal binder with
-	    --  *the same* unique as binder.
-	    -- the reason for this is the following:
-	    -- this binder *will* get inlined but if it happen to be
-	    -- a top level binder it is never removed as dead code,
-	    -- therefore we have to remove that information (of it being
-	    -- top-level or exported somehow.)
-	    -- A better fix is to use binder directly but with the TopLevel
-	    -- tag (or Exported tag) modified.
-	    fake_binder = mkSysLocal SLIT("sat")
-			    (getUnique binder)
-			    (idType binder)
-	    rec_body = mkValLam non_static_args
-			       ( Let (NonRec fake_binder nonrec_rhs)
-				 {-in-} (dropArgs rhs))
-	in
-	returnSAT (
-	    origLams (Let (Rec [(binder',rec_body)]) {-in-} local_body)
-	)
-      where
-	origLams = origLams' rhs
-		 where
-		   origLams' (Lam v e)     e' = Lam   v  (origLams' e e')
-		   origLams' (CoTyLam ty e)  e' = CoTyLam ty (origLams' e e')
-		   origLams' _		     e' = e'
-
-    new_ty tyargs args
-      = substTy (mk_inst_tyenv tyargs tv_tmpl)
-		      (mkSigmaTy tv_tmpl' dict_tys' tau_ty')
-      where
-	-- get type info for the local function:
-	(tv_tmpl, dict_tys, tau_ty) = (splitSigmaTy . idType) binder
-	(reg_arg_tys, res_type)	    = splitFunTys tau_ty
-
-	-- now, we drop the ones that are
-	-- static, that is, the ones we will not pass to the local function
-	tv_tmpl'     = dropStatics tyargs tv_tmpl
-
-	(args1, args2) = splitAtList dict_tys args
-	dict_tys'    = dropStatics args1 dict_tys
-	reg_arg_tys' = dropStatics args2 reg_arg_tys
-
-	tau_ty'	     = glueTyArgs reg_arg_tys' res_type
-
-	mk_inst_tyenv []		    _ = emptyVarEnv
-	mk_inst_tyenv (Static s:args) (t:ts)  = extendVarEnv (mk_inst_tyenv args ts) t s
-	mk_inst_tyenv (_:args)	    (_:ts)    = mk_inst_tyenv args ts
-
-dropStatics [] t = t
-dropStatics (Static _:args) (t:ts) = dropStatics args ts
-dropStatics (_:args)	    (t:ts) = t:dropStatics args ts
-
-isStatic :: Arg a -> Bool
-isStatic NotStatic = False
-isStatic _	   = True
--}
-\end{code}
diff --git a/ghc/compiler/simplCore/SetLevels.lhs b/ghc/compiler/simplCore/SetLevels.lhs
deleted file mode 100644
index f8ab29dcd5..0000000000
--- a/ghc/compiler/simplCore/SetLevels.lhs
+++ /dev/null
@@ -1,847 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section{SetLevels}
-
-		***************************
-			Overview
-		***************************
-
-1. We attach binding levels to Core bindings, in preparation for floating
-   outwards (@FloatOut@).
-
-2. We also let-ify many expressions (notably case scrutinees), so they
-   will have a fighting chance of being floated sensible.
-
-3. We clone the binders of any floatable let-binding, so that when it is
-   floated out it will be unique.  (This used to be done by the simplifier
-   but the latter now only ensures that there's no shadowing; indeed, even 
-   that may not be true.)
-
-   NOTE: this can't be done using the uniqAway idea, because the variable
- 	 must be unique in the whole program, not just its current scope,
-	 because two variables in different scopes may float out to the
-	 same top level place
-
-   NOTE: Very tiresomely, we must apply this substitution to
-	 the rules stored inside a variable too.
-
-   We do *not* clone top-level bindings, because some of them must not change,
-   but we *do* clone bindings that are heading for the top level
-
-4. In the expression
-	case x of wild { p -> ...wild... }
-   we substitute x for wild in the RHS of the case alternatives:
-	case x of wild { p -> ...x... }
-   This means that a sub-expression involving x is not "trapped" inside the RHS.
-   And it's not inconvenient because we already have a substitution.
-
-  Note that this is EXACTLY BACKWARDS from the what the simplifier does.
-  The simplifier tries to get rid of occurrences of x, in favour of wild,
-  in the hope that there will only be one remaining occurrence of x, namely
-  the scrutinee of the case, and we can inline it.  
-
-\begin{code}
-module SetLevels (
-	setLevels, 
-
-	Level(..), tOP_LEVEL,
-	LevelledBind, LevelledExpr,
-
-	incMinorLvl, ltMajLvl, ltLvl, isTopLvl, isInlineCtxt
-    ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-
-import DynFlags	( FloatOutSwitches(..) )
-import CoreUtils	( exprType, exprIsTrivial, exprIsCheap, mkPiTypes )
-import CoreFVs		-- all of it
-import CoreSubst	( Subst, emptySubst, extendInScope, extendIdSubst,
-			  cloneIdBndr, cloneRecIdBndrs )
-import Id		( Id, idType, mkSysLocal, isOneShotLambda,
-			  zapDemandIdInfo,
-			  idSpecialisation, idWorkerInfo, setIdInfo
-			)
-import IdInfo		( workerExists, vanillaIdInfo, isEmptySpecInfo )
-import Var		( Var )
-import VarSet
-import VarEnv
-import Name		( getOccName )
-import OccName		( occNameString )
-import Type		( isUnLiftedType, Type )
-import BasicTypes	( TopLevelFlag(..) )
-import UniqSupply
-import Util		( sortLe, isSingleton, count )
-import Outputable
-import FastString
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Level numbers}
-%*									*
-%************************************************************************
-
-\begin{code}
-data Level = InlineCtxt	-- A level that's used only for
-			-- the context parameter ctxt_lvl
-	   | Level Int	-- Level number of enclosing lambdas
-	  	   Int	-- Number of big-lambda and/or case expressions between
-			-- here and the nearest enclosing lambda
-\end{code}
-
-The {\em level number} on a (type-)lambda-bound variable is the
-nesting depth of the (type-)lambda which binds it.  The outermost lambda
-has level 1, so (Level 0 0) means that the variable is bound outside any lambda.
-
-On an expression, it's the maximum level number of its free
-(type-)variables.  On a let(rec)-bound variable, it's the level of its
-RHS.  On a case-bound variable, it's the number of enclosing lambdas.
-
-Top-level variables: level~0.  Those bound on the RHS of a top-level
-definition but ``before'' a lambda; e.g., the \tr{x} in (levels shown
-as ``subscripts'')...
-\begin{verbatim}
-a_0 = let  b_? = ...  in
-	   x_1 = ... b ... in ...
-\end{verbatim}
-
-The main function @lvlExpr@ carries a ``context level'' (@ctxt_lvl@).
-That's meant to be the level number of the enclosing binder in the
-final (floated) program.  If the level number of a sub-expression is
-less than that of the context, then it might be worth let-binding the
-sub-expression so that it will indeed float.  
-
-If you can float to level @Level 0 0@ worth doing so because then your
-allocation becomes static instead of dynamic.  We always start with
-context @Level 0 0@.  
-
-
-InlineCtxt
-~~~~~~~~~~
-@InlineCtxt@ very similar to @Level 0 0@, but is used for one purpose:
-to say "don't float anything out of here".  That's exactly what we
-want for the body of an INLINE, where we don't want to float anything
-out at all.  See notes with lvlMFE below.
-
-But, check this out:
-
--- At one time I tried the effect of not float anything out of an InlineMe,
--- but it sometimes works badly.  For example, consider PrelArr.done.  It
--- has the form 	__inline (\d. e)
--- where e doesn't mention d.  If we float this to 
---	__inline (let x = e in \d. x)
--- things are bad.  The inliner doesn't even inline it because it doesn't look
--- like a head-normal form.  So it seems a lesser evil to let things float.
--- In SetLevels we do set the context to (Level 0 0) when we get to an InlineMe
--- which discourages floating out.
-
-So the conclusion is: don't do any floating at all inside an InlineMe.
-(In the above example, don't float the {x=e} out of the \d.)
-
-One particular case is that of workers: we don't want to float the
-call to the worker outside the wrapper, otherwise the worker might get
-inlined into the floated expression, and an importing module won't see
-the worker at all.
-
-\begin{code}
-type LevelledExpr  = TaggedExpr Level
-type LevelledBind  = TaggedBind Level
-
-tOP_LEVEL   = Level 0 0
-iNLINE_CTXT = InlineCtxt
-
-incMajorLvl :: Level -> Level
--- For InlineCtxt we ignore any inc's; we don't want
--- to do any floating at all; see notes above
-incMajorLvl InlineCtxt		= InlineCtxt
-incMajorLvl (Level major minor) = Level (major+1) 0
-
-incMinorLvl :: Level -> Level
-incMinorLvl InlineCtxt		= InlineCtxt
-incMinorLvl (Level major minor) = Level major (minor+1)
-
-maxLvl :: Level -> Level -> Level
-maxLvl InlineCtxt l2  = l2
-maxLvl l1  InlineCtxt = l1
-maxLvl l1@(Level maj1 min1) l2@(Level maj2 min2)
-  | (maj1 > maj2) || (maj1 == maj2 && min1 > min2) = l1
-  | otherwise					   = l2
-
-ltLvl :: Level -> Level -> Bool
-ltLvl any_lvl	 InlineCtxt  = False
-ltLvl InlineCtxt (Level _ _) = True
-ltLvl (Level maj1 min1) (Level maj2 min2)
-  = (maj1 < maj2) || (maj1 == maj2 && min1 < min2)
-
-ltMajLvl :: Level -> Level -> Bool
-    -- Tells if one level belongs to a difft *lambda* level to another
-ltMajLvl any_lvl	InlineCtxt     = False
-ltMajLvl InlineCtxt	(Level maj2 _) = 0 < maj2
-ltMajLvl (Level maj1 _) (Level maj2 _) = maj1 < maj2
-
-isTopLvl :: Level -> Bool
-isTopLvl (Level 0 0) = True
-isTopLvl other	     = False
-
-isInlineCtxt :: Level -> Bool
-isInlineCtxt InlineCtxt = True
-isInlineCtxt other	= False
-
-instance Outputable Level where
-  ppr InlineCtxt      = text "<INLINE>"
-  ppr (Level maj min) = hcat [ char '<', int maj, char ',', int min, char '>' ]
-
-instance Eq Level where
-  InlineCtxt	    == InlineCtxt	 = True
-  (Level maj1 min1) == (Level maj2 min2) = maj1==maj2 && min1==min2
-  l1		    == l2		 = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Main level-setting code}
-%*									*
-%************************************************************************
-
-\begin{code}
-setLevels :: FloatOutSwitches
-	  -> [CoreBind]
-	  -> UniqSupply
-	  -> [LevelledBind]
-
-setLevels float_lams binds us
-  = initLvl us (do_them binds)
-  where
-    -- "do_them"'s main business is to thread the monad along
-    -- It gives each top binding the same empty envt, because
-    -- things unbound in the envt have level number zero implicitly
-    do_them :: [CoreBind] -> LvlM [LevelledBind]
-
-    do_them [] = returnLvl []
-    do_them (b:bs)
-      = lvlTopBind init_env b	`thenLvl` \ (lvld_bind, _) ->
-	do_them bs		`thenLvl` \ lvld_binds ->
-    	returnLvl (lvld_bind : lvld_binds)
-
-    init_env = initialEnv float_lams
-
-lvlTopBind env (NonRec binder rhs)
-  = lvlBind TopLevel tOP_LEVEL env (AnnNonRec binder (freeVars rhs))
-					-- Rhs can have no free vars!
-
-lvlTopBind env (Rec pairs)
-  = lvlBind TopLevel tOP_LEVEL env (AnnRec [(b,freeVars rhs) | (b,rhs) <- pairs])
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Setting expression levels}
-%*									*
-%************************************************************************
-
-\begin{code}
-lvlExpr :: Level		-- ctxt_lvl: Level of enclosing expression
-	-> LevelEnv		-- Level of in-scope names/tyvars
-	-> CoreExprWithFVs	-- input expression
-	-> LvlM LevelledExpr	-- Result expression
-\end{code}
-
-The @ctxt_lvl@ is, roughly, the level of the innermost enclosing
-binder.  Here's an example
-
-	v = \x -> ...\y -> let r = case (..x..) of
-					..x..
-			   in ..
-
-When looking at the rhs of @r@, @ctxt_lvl@ will be 1 because that's
-the level of @r@, even though it's inside a level-2 @\y@.  It's
-important that @ctxt_lvl@ is 1 and not 2 in @r@'s rhs, because we
-don't want @lvlExpr@ to turn the scrutinee of the @case@ into an MFE
---- because it isn't a *maximal* free expression.
-
-If there were another lambda in @r@'s rhs, it would get level-2 as well.
-
-\begin{code}
-lvlExpr _ _ (_, AnnType ty)   = returnLvl (Type ty)
-lvlExpr _ env (_, AnnVar v)   = returnLvl (lookupVar env v)
-lvlExpr _ env (_, AnnLit lit) = returnLvl (Lit lit)
-
-lvlExpr ctxt_lvl env (_, AnnApp fun arg)
-  = lvl_fun fun				`thenLvl` \ fun' ->
-    lvlMFE  False ctxt_lvl env arg	`thenLvl` \ arg' ->
-    returnLvl (App fun' arg')
-  where
--- gaw 2004
-    lvl_fun (_, AnnCase _ _ _ _) = lvlMFE True ctxt_lvl env fun
-    lvl_fun other 	       = lvlExpr ctxt_lvl env fun
-	-- We don't do MFE on partial applications generally,
-	-- but we do if the function is big and hairy, like a case
-
-lvlExpr ctxt_lvl env (_, AnnNote InlineMe expr)
--- Don't float anything out of an InlineMe; hence the iNLINE_CTXT
-  = lvlExpr iNLINE_CTXT env expr 	`thenLvl` \ expr' ->
-    returnLvl (Note InlineMe expr')
-
-lvlExpr ctxt_lvl env (_, AnnNote note expr)
-  = lvlExpr ctxt_lvl env expr 		`thenLvl` \ expr' ->
-    returnLvl (Note note expr')
-
--- We don't split adjacent lambdas.  That is, given
---	\x y -> (x+1,y)
--- we don't float to give 
---	\x -> let v = x+y in \y -> (v,y)
--- Why not?  Because partial applications are fairly rare, and splitting
--- lambdas makes them more expensive.
-
-lvlExpr ctxt_lvl env expr@(_, AnnLam bndr rhs)
-  = lvlMFE True new_lvl new_env body	`thenLvl` \ new_body ->
-    returnLvl (mkLams new_bndrs new_body)
-  where 
-    (bndrs, body)	 = collectAnnBndrs expr
-    (new_lvl, new_bndrs) = lvlLamBndrs ctxt_lvl bndrs
-    new_env 		 = extendLvlEnv env new_bndrs
-	-- At one time we called a special verion of collectBinders,
-	-- which ignored coercions, because we don't want to split
-	-- a lambda like this (\x -> coerce t (\s -> ...))
-	-- This used to happen quite a bit in state-transformer programs,
-	-- but not nearly so much now non-recursive newtypes are transparent.
-	-- [See SetLevels rev 1.50 for a version with this approach.]
-
-lvlExpr ctxt_lvl env (_, AnnLet (AnnNonRec bndr rhs) body)
-  | isUnLiftedType (idType bndr)
-	-- Treat unlifted let-bindings (let x = b in e) just like (case b of x -> e)
-	-- That is, leave it exactly where it is
-	-- We used to float unlifted bindings too (e.g. to get a cheap primop
-	-- outside a lambda (to see how, look at lvlBind in rev 1.58)
-	-- but an unrelated change meant that these unlifed bindings
-	-- could get to the top level which is bad.  And there's not much point;
-	-- unlifted bindings are always cheap, and so hardly worth floating.
-  = lvlExpr ctxt_lvl env rhs		`thenLvl` \ rhs' ->
-    lvlExpr incd_lvl env' body		`thenLvl` \ body' ->
-    returnLvl (Let (NonRec bndr' rhs') body')
-  where
-    incd_lvl = incMinorLvl ctxt_lvl
-    bndr' = TB bndr incd_lvl
-    env'  = extendLvlEnv env [bndr']
-
-lvlExpr ctxt_lvl env (_, AnnLet bind body)
-  = lvlBind NotTopLevel ctxt_lvl env bind	`thenLvl` \ (bind', new_env) ->
-    lvlExpr ctxt_lvl new_env body		`thenLvl` \ body' ->
-    returnLvl (Let bind' body')
-
-lvlExpr ctxt_lvl env (_, AnnCase expr case_bndr ty alts)
-  = lvlMFE True ctxt_lvl env expr	`thenLvl` \ expr' ->
-    let
-	alts_env = extendCaseBndrLvlEnv env expr' case_bndr incd_lvl
-    in
-    mapLvl (lvl_alt alts_env) alts	`thenLvl` \ alts' ->
-    returnLvl (Case expr' (TB case_bndr incd_lvl) ty alts')
-  where
-      incd_lvl  = incMinorLvl ctxt_lvl
-
-      lvl_alt alts_env (con, bs, rhs)
-	= lvlMFE True incd_lvl new_env rhs	`thenLvl` \ rhs' ->
-	  returnLvl (con, bs', rhs')
-	where
-	  bs'     = [ TB b incd_lvl | b <- bs ]
-	  new_env = extendLvlEnv alts_env bs'
-\end{code}
-
-@lvlMFE@ is just like @lvlExpr@, except that it might let-bind
-the expression, so that it can itself be floated.
-
-[NOTE: unlifted MFEs]
-We don't float unlifted MFEs, which potentially loses big opportunites.
-For example:
-	\x -> f (h y)
-where h :: Int -> Int# is expensive. We'd like to float the (h y) outside
-the \x, but we don't because it's unboxed.  Possible solution: box it.
-
-\begin{code}
-lvlMFE ::  Bool			-- True <=> strict context [body of case or let]
-	-> Level		-- Level of innermost enclosing lambda/tylam
-	-> LevelEnv		-- Level of in-scope names/tyvars
-	-> CoreExprWithFVs	-- input expression
-	-> LvlM LevelledExpr	-- Result expression
-
-lvlMFE strict_ctxt ctxt_lvl env (_, AnnType ty)
-  = returnLvl (Type ty)
-
-
-lvlMFE strict_ctxt ctxt_lvl env ann_expr@(fvs, _)
-  |  isUnLiftedType ty			-- Can't let-bind it; see [NOTE: unlifted MFEs]
-  || isInlineCtxt ctxt_lvl		-- Don't float out of an __inline__ context
-  || exprIsTrivial expr			-- Never float if it's trivial
-  || not good_destination
-  = 	-- Don't float it out
-    lvlExpr ctxt_lvl env ann_expr
-
-  | otherwise	-- Float it out!
-  = lvlFloatRhs abs_vars dest_lvl env ann_expr	`thenLvl` \ expr' ->
-    newLvlVar "lvl" abs_vars ty			`thenLvl` \ var ->
-    returnLvl (Let (NonRec (TB var dest_lvl) expr') 
-		   (mkVarApps (Var var) abs_vars))
-  where
-    expr     = deAnnotate ann_expr
-    ty       = exprType expr
-    dest_lvl = destLevel env fvs (isFunction ann_expr)
-    abs_vars = abstractVars dest_lvl env fvs
-
-	-- A decision to float entails let-binding this thing, and we only do 
-	-- that if we'll escape a value lambda, or will go to the top level.
-    good_destination 
-	| dest_lvl `ltMajLvl` ctxt_lvl		-- Escapes a value lambda
-	= not (exprIsCheap expr) || isTopLvl dest_lvl
-	  -- Even if it escapes a value lambda, we only
-	  -- float if it's not cheap (unless it'll get all the
-	  -- way to the top).  I've seen cases where we
-	  -- float dozens of tiny free expressions, which cost
-	  -- more to allocate than to evaluate.
-	  -- NB: exprIsCheap is also true of bottom expressions, which
-	  --     is good; we don't want to share them
-	  --
-	  -- It's only Really Bad to float a cheap expression out of a
-	  -- strict context, because that builds a thunk that otherwise
-	  -- would never be built.  So another alternative would be to
-	  -- add 
-	  -- 	|| (strict_ctxt && not (exprIsBottom expr))
-	  -- to the condition above. We should really try this out.
-
-	| otherwise		-- Does not escape a value lambda
-	= isTopLvl dest_lvl 	-- Only float if we are going to the top level
-	&& floatConsts env	--   and the floatConsts flag is on
-	&& not strict_ctxt	-- Don't float from a strict context	
-	  -- We are keen to float something to the top level, even if it does not
-	  -- escape a lambda, because then it needs no allocation.  But it's controlled
-	  -- by a flag, because doing this too early loses opportunities for RULES
-	  -- which (needless to say) are important in some nofib programs
-	  -- (gcd is an example).
-	  --
-	  -- Beware:
-	  --	concat = /\ a -> foldr ..a.. (++) []
-	  -- was getting turned into
-	  --	concat = /\ a -> lvl a
-	  --	lvl    = /\ a -> foldr ..a.. (++) []
-	  -- which is pretty stupid.  Hence the strict_ctxt test
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Bindings}
-%*									*
-%************************************************************************
-
-The binding stuff works for top level too.
-
-\begin{code}
-lvlBind :: TopLevelFlag		-- Used solely to decide whether to clone
-	-> Level		-- Context level; might be Top even for bindings nested in the RHS
-				-- of a top level binding
-	-> LevelEnv
-	-> CoreBindWithFVs
-	-> LvlM (LevelledBind, LevelEnv)
-
-lvlBind top_lvl ctxt_lvl env (AnnNonRec bndr rhs@(rhs_fvs,_))
-  | isInlineCtxt ctxt_lvl		-- Don't do anything inside InlineMe
-  = lvlExpr ctxt_lvl env rhs			`thenLvl` \ rhs' ->
-    returnLvl (NonRec (TB bndr ctxt_lvl) rhs', env)
-
-  | null abs_vars
-  =	-- No type abstraction; clone existing binder
-    lvlExpr dest_lvl env rhs			`thenLvl` \ rhs' ->
-    cloneVar top_lvl env bndr ctxt_lvl dest_lvl	`thenLvl` \ (env', bndr') ->
-    returnLvl (NonRec (TB bndr' dest_lvl) rhs', env') 
-
-  | otherwise
-  = -- Yes, type abstraction; create a new binder, extend substitution, etc
-    lvlFloatRhs abs_vars dest_lvl env rhs	`thenLvl` \ rhs' ->
-    newPolyBndrs dest_lvl env abs_vars [bndr]	`thenLvl` \ (env', [bndr']) ->
-    returnLvl (NonRec (TB bndr' dest_lvl) rhs', env')
-
-  where
-    bind_fvs = rhs_fvs `unionVarSet` idFreeVars bndr
-    abs_vars = abstractVars dest_lvl env bind_fvs
-    dest_lvl = destLevel env bind_fvs (isFunction rhs)
-\end{code}
-
-
-\begin{code}
-lvlBind top_lvl ctxt_lvl env (AnnRec pairs)
-  | isInlineCtxt ctxt_lvl	-- Don't do anything inside InlineMe
-  = mapLvl (lvlExpr ctxt_lvl env) rhss			`thenLvl` \ rhss' ->
-    returnLvl (Rec ([TB b ctxt_lvl | b <- bndrs] `zip` rhss'), env)
-
-  | null abs_vars
-  = cloneRecVars top_lvl env bndrs ctxt_lvl dest_lvl	`thenLvl` \ (new_env, new_bndrs) ->
-    mapLvl (lvlExpr ctxt_lvl new_env) rhss		`thenLvl` \ new_rhss ->
-    returnLvl (Rec ([TB b dest_lvl | b <- new_bndrs] `zip` new_rhss), new_env)
-
-  | isSingleton pairs && count isId abs_vars > 1
-  = 	-- Special case for self recursion where there are
-	-- several variables carried around: build a local loop:	
-	--	poly_f = \abs_vars. \lam_vars . letrec f = \lam_vars. rhs in f lam_vars
-	-- This just makes the closures a bit smaller.  If we don't do
-	-- this, allocation rises significantly on some programs
-	--
-	-- We could elaborate it for the case where there are several
-	-- mutually functions, but it's quite a bit more complicated
-	-- 
-	-- This all seems a bit ad hoc -- sigh
-    let
-	(bndr,rhs) = head pairs
-	(rhs_lvl, abs_vars_w_lvls) = lvlLamBndrs dest_lvl abs_vars
-	rhs_env = extendLvlEnv env abs_vars_w_lvls
-    in
-    cloneVar NotTopLevel rhs_env bndr rhs_lvl rhs_lvl	`thenLvl` \ (rhs_env', new_bndr) ->
-    let
-	(lam_bndrs, rhs_body)     = collectAnnBndrs rhs
-        (body_lvl, new_lam_bndrs) = lvlLamBndrs rhs_lvl lam_bndrs
-	body_env 		  = extendLvlEnv rhs_env' new_lam_bndrs
-    in
-    lvlExpr body_lvl body_env rhs_body		`thenLvl` \ new_rhs_body ->
-    newPolyBndrs dest_lvl env abs_vars [bndr]	`thenLvl` \ (poly_env, [poly_bndr]) ->
-    returnLvl (Rec [(TB poly_bndr dest_lvl, 
-	       mkLams abs_vars_w_lvls $
-	       mkLams new_lam_bndrs $
-	       Let (Rec [(TB new_bndr rhs_lvl, mkLams new_lam_bndrs new_rhs_body)]) 
-		   (mkVarApps (Var new_bndr) lam_bndrs))],
-	       poly_env)
-
-  | otherwise	-- Non-null abs_vars
-  = newPolyBndrs dest_lvl env abs_vars bndrs		`thenLvl` \ (new_env, new_bndrs) ->
-    mapLvl (lvlFloatRhs abs_vars dest_lvl new_env) rhss `thenLvl` \ new_rhss ->
-    returnLvl (Rec ([TB b dest_lvl | b <- new_bndrs] `zip` new_rhss), new_env)
-
-  where
-    (bndrs,rhss) = unzip pairs
-
-	-- Finding the free vars of the binding group is annoying
-    bind_fvs	    = (unionVarSets [ idFreeVars bndr `unionVarSet` rhs_fvs
-				    | (bndr, (rhs_fvs,_)) <- pairs])
-		      `minusVarSet`
-		      mkVarSet bndrs
-
-    dest_lvl = destLevel env bind_fvs (all isFunction rhss)
-    abs_vars = abstractVars dest_lvl env bind_fvs
-
-----------------------------------------------------
--- Three help functons for the type-abstraction case
-
-lvlFloatRhs abs_vars dest_lvl env rhs
-  = lvlExpr rhs_lvl rhs_env rhs	`thenLvl` \ rhs' ->
-    returnLvl (mkLams abs_vars_w_lvls rhs')
-  where
-    (rhs_lvl, abs_vars_w_lvls) = lvlLamBndrs dest_lvl abs_vars
-    rhs_env = extendLvlEnv env abs_vars_w_lvls
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Deciding floatability}
-%*									*
-%************************************************************************
-
-\begin{code}
-lvlLamBndrs :: Level -> [CoreBndr] -> (Level, [TaggedBndr Level])
--- Compute the levels for the binders of a lambda group
--- The binders returned are exactly the same as the ones passed,
--- but they are now paired with a level
-lvlLamBndrs lvl [] 
-  = (lvl, [])
-
-lvlLamBndrs lvl bndrs
-  = go  (incMinorLvl lvl)
-	False 	-- Havn't bumped major level in this group
-	[] bndrs
-  where
-    go old_lvl bumped_major rev_lvld_bndrs (bndr:bndrs)
-	| isId bndr && 			-- Go to the next major level if this is a value binder,
-	  not bumped_major && 		-- and we havn't already gone to the next level (one jump per group)
-	  not (isOneShotLambda bndr)	-- and it isn't a one-shot lambda
-	= go new_lvl True (TB bndr new_lvl : rev_lvld_bndrs) bndrs
-
-	| otherwise
-	= go old_lvl bumped_major (TB bndr old_lvl : rev_lvld_bndrs) bndrs
-
-	where
-	  new_lvl = incMajorLvl old_lvl
-
-    go old_lvl _ rev_lvld_bndrs []
-	= (old_lvl, reverse rev_lvld_bndrs)
-	-- a lambda like this (\x -> coerce t (\s -> ...))
-	-- This happens quite a bit in state-transformer programs
-\end{code}
-
-\begin{code}
-  -- Destintion level is the max Id level of the expression
-  -- (We'll abstract the type variables, if any.)
-destLevel :: LevelEnv -> VarSet -> Bool -> Level
-destLevel env fvs is_function
-  |  floatLams env
-  && is_function = tOP_LEVEL		-- Send functions to top level; see
-					-- the comments with isFunction
-  | otherwise    = maxIdLevel env fvs
-
-isFunction :: CoreExprWithFVs -> Bool
--- The idea here is that we want to float *functions* to
--- the top level.  This saves no work, but 
---	(a) it can make the host function body a lot smaller, 
---		and hence inlinable.  
---	(b) it can also save allocation when the function is recursive:
---	    h = \x -> letrec f = \y -> ...f...y...x...
---		      in f x
---     becomes
---	    f = \x y -> ...(f x)...y...x...
---	    h = \x -> f x x
---     No allocation for f now.
--- We may only want to do this if there are sufficiently few free 
--- variables.  We certainly only want to do it for values, and not for
--- constructors.  So the simple thing is just to look for lambdas
-isFunction (_, AnnLam b e) | isId b    = True
-			   | otherwise = isFunction e
-isFunction (_, AnnNote n e)            = isFunction e
-isFunction other 		       = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Free-To-Level Monad}
-%*									*
-%************************************************************************
-
-\begin{code}
-type LevelEnv = (FloatOutSwitches,
-		 VarEnv Level, 			-- Domain is *post-cloned* TyVars and Ids
-	         Subst, 			-- Domain is pre-cloned Ids; tracks the in-scope set
-						-- 	so that subtitution is capture-avoiding
-	         IdEnv ([Var], LevelledExpr))	-- Domain is pre-cloned Ids
-	-- We clone let-bound variables so that they are still
-	-- distinct when floated out; hence the SubstEnv/IdEnv.
-        -- (see point 3 of the module overview comment).
-	-- We also use these envs when making a variable polymorphic
-	-- because we want to float it out past a big lambda.
-	--
-	-- The SubstEnv and IdEnv always implement the same mapping, but the
-	-- SubstEnv maps to CoreExpr and the IdEnv to LevelledExpr
-	-- Since the range is always a variable or type application,
-	-- there is never any difference between the two, but sadly
-	-- the types differ.  The SubstEnv is used when substituting in
-	-- a variable's IdInfo; the IdEnv when we find a Var.
-	--
-	-- In addition the IdEnv records a list of tyvars free in the
-	-- type application, just so we don't have to call freeVars on
-	-- the type application repeatedly.
-	--
-	-- The domain of the both envs is *pre-cloned* Ids, though
-	--
-	-- The domain of the VarEnv Level is the *post-cloned* Ids
-
-initialEnv :: FloatOutSwitches -> LevelEnv
-initialEnv float_lams = (float_lams, emptyVarEnv, emptySubst, emptyVarEnv)
-
-floatLams :: LevelEnv -> Bool
-floatLams (FloatOutSw float_lams _, _, _, _) = float_lams
-
-floatConsts :: LevelEnv -> Bool
-floatConsts (FloatOutSw _ float_consts, _, _, _) = float_consts
-
-extendLvlEnv :: LevelEnv -> [TaggedBndr Level] -> LevelEnv
--- Used when *not* cloning
-extendLvlEnv (float_lams, lvl_env, subst, id_env) prs
-  = (float_lams,
-     foldl add_lvl lvl_env prs,
-     foldl del_subst subst prs,
-     foldl del_id id_env prs)
-  where
-    add_lvl   env (TB v l) = extendVarEnv env v l
-    del_subst env (TB v _) = extendInScope env v
-    del_id    env (TB v _) = delVarEnv env v
-  -- We must remove any clone for this variable name in case of
-  -- shadowing.  This bit me in the following case
-  -- (in nofib/real/gg/Spark.hs):
-  -- 
-  --   case ds of wild {
-  --     ... -> case e of wild {
-  --              ... -> ... wild ...
-  --            }
-  --   }
-  -- 
-  -- The inside occurrence of @wild@ was being replaced with @ds@,
-  -- incorrectly, because the SubstEnv was still lying around.  Ouch!
-  -- KSW 2000-07.
-
--- extendCaseBndrLvlEnv adds the mapping case-bndr->scrut-var if it can
--- (see point 4 of the module overview comment)
-extendCaseBndrLvlEnv (float_lams, lvl_env, subst, id_env) (Var scrut_var) case_bndr lvl
-  = (float_lams,
-     extendVarEnv lvl_env case_bndr lvl,
-     extendIdSubst subst case_bndr (Var scrut_var),
-     extendVarEnv id_env case_bndr ([scrut_var], Var scrut_var))
-     
-extendCaseBndrLvlEnv env scrut case_bndr lvl
-  = extendLvlEnv          env [TB case_bndr lvl]
-
-extendPolyLvlEnv dest_lvl (float_lams, lvl_env, subst, id_env) abs_vars bndr_pairs
-  = (float_lams,
-     foldl add_lvl   lvl_env bndr_pairs,
-     foldl add_subst subst   bndr_pairs,
-     foldl add_id    id_env  bndr_pairs)
-  where
-     add_lvl   env (v,v') = extendVarEnv env v' dest_lvl
-     add_subst env (v,v') = extendIdSubst env v (mkVarApps (Var v') abs_vars)
-     add_id    env (v,v') = extendVarEnv env v ((v':abs_vars), mkVarApps (Var v') abs_vars)
-
-extendCloneLvlEnv lvl (float_lams, lvl_env, _, id_env) new_subst bndr_pairs
-  = (float_lams,
-     foldl add_lvl   lvl_env bndr_pairs,
-     new_subst,
-     foldl add_id    id_env  bndr_pairs)
-  where
-     add_lvl   env (v,v') = extendVarEnv env v' lvl
-     add_id    env (v,v') = extendVarEnv env v ([v'], Var v')
-
-
-maxIdLevel :: LevelEnv -> VarSet -> Level
-maxIdLevel (_, lvl_env,_,id_env) var_set
-  = foldVarSet max_in tOP_LEVEL var_set
-  where
-    max_in in_var lvl = foldr max_out lvl (case lookupVarEnv id_env in_var of
-						Just (abs_vars, _) -> abs_vars
-						Nothing		   -> [in_var])
-
-    max_out out_var lvl 
-	| isId out_var = case lookupVarEnv lvl_env out_var of
-				Just lvl' -> maxLvl lvl' lvl
-				Nothing   -> lvl 
-	| otherwise    = lvl	-- Ignore tyvars in *maxIdLevel*
-
-lookupVar :: LevelEnv -> Id -> LevelledExpr
-lookupVar (_, _, _, id_env) v = case lookupVarEnv id_env v of
-				       Just (_, expr) -> expr
-				       other	      -> Var v
-
-abstractVars :: Level -> LevelEnv -> VarSet -> [Var]
-	-- Find the variables in fvs, free vars of the target expresion,
-	-- whose level is greater than the destination level
-	-- These are the ones we are going to abstract out
-abstractVars dest_lvl env fvs
-  = uniq (sortLe le [var | fv <- varSetElems fvs, var <- absVarsOf dest_lvl env fv])
-  where
-	-- Sort the variables so we don't get 
-	-- mixed-up tyvars and Ids; it's just messy
-    v1 `le` v2 = case (isId v1, isId v2) of
-		   (True, False) -> False
-		   (False, True) -> True
-		   other	 -> v1 <= v2	-- Same family
-
-    uniq :: [Var] -> [Var]
-	-- Remove adjacent duplicates; the sort will have brought them together
-    uniq (v1:v2:vs) | v1 == v2  = uniq (v2:vs)
-		    | otherwise = v1 : uniq (v2:vs)
-    uniq vs = vs
-
-absVarsOf :: Level -> LevelEnv -> Var -> [Var]
-	-- If f is free in the expression, and f maps to poly_f a b c in the
-	-- current substitution, then we must report a b c as candidate type
-	-- variables
-absVarsOf dest_lvl (_, lvl_env, _, id_env) v 
-  | isId v
-  = [zap av2 | av1 <- lookup_avs v, av2 <- add_tyvars av1, abstract_me av2]
-
-  | otherwise
-  = if abstract_me v then [v] else []
-
-  where
-    abstract_me v = case lookupVarEnv lvl_env v of
-			Just lvl -> dest_lvl `ltLvl` lvl
-			Nothing  -> False
-
-    lookup_avs v = case lookupVarEnv id_env v of
-			Just (abs_vars, _) -> abs_vars
-			Nothing	           -> [v]
-
-    add_tyvars v | isId v    = v : varSetElems (idFreeTyVars v)
-		 | otherwise = [v]
-
-	-- We are going to lambda-abstract, so nuke any IdInfo,
-	-- and add the tyvars of the Id (if necessary)
-    zap v | isId v = WARN( workerExists (idWorkerInfo v) ||
-		           not (isEmptySpecInfo (idSpecialisation v)),
-		           text "absVarsOf: discarding info on" <+> ppr v )
-		     setIdInfo v vanillaIdInfo
-	  | otherwise = v
-\end{code}
-
-\begin{code}
-type LvlM result = UniqSM result
-
-initLvl		= initUs_
-thenLvl		= thenUs
-returnLvl	= returnUs
-mapLvl		= mapUs
-\end{code}
-
-\begin{code}
-newPolyBndrs dest_lvl env abs_vars bndrs
-  = getUniquesUs 		`thenLvl` \ uniqs ->
-    let
-	new_bndrs = zipWith mk_poly_bndr bndrs uniqs
-    in
-    returnLvl (extendPolyLvlEnv dest_lvl env abs_vars (bndrs `zip` new_bndrs), new_bndrs)
-  where
-    mk_poly_bndr bndr uniq = mkSysLocal (mkFastString str) uniq poly_ty
-			   where
-			     str     = "poly_" ++ occNameString (getOccName bndr)
-			     poly_ty = mkPiTypes abs_vars (idType bndr)
-	
-
-newLvlVar :: String 
-	  -> [CoreBndr] -> Type 	-- Abstract wrt these bndrs
-	  -> LvlM Id
-newLvlVar str vars body_ty 	
-  = getUniqueUs	`thenLvl` \ uniq ->
-    returnUs (mkSysLocal (mkFastString str) uniq (mkPiTypes vars body_ty))
-    
--- The deeply tiresome thing is that we have to apply the substitution
--- to the rules inside each Id.  Grr.  But it matters.
-
-cloneVar :: TopLevelFlag -> LevelEnv -> Id -> Level -> Level -> LvlM (LevelEnv, Id)
-cloneVar TopLevel env v ctxt_lvl dest_lvl
-  = returnUs (env, v)	-- Don't clone top level things
-cloneVar NotTopLevel env@(_,_,subst,_) v ctxt_lvl dest_lvl
-  = ASSERT( isId v )
-    getUs	`thenLvl` \ us ->
-    let
-      (subst', v1) = cloneIdBndr subst us v
-      v2	   = zap_demand ctxt_lvl dest_lvl v1
-      env'	   = extendCloneLvlEnv dest_lvl env subst' [(v,v2)]
-    in
-    returnUs (env', v2)
-
-cloneRecVars :: TopLevelFlag -> LevelEnv -> [Id] -> Level -> Level -> LvlM (LevelEnv, [Id])
-cloneRecVars TopLevel env vs ctxt_lvl dest_lvl 
-  = returnUs (env, vs)	-- Don't clone top level things
-cloneRecVars NotTopLevel env@(_,_,subst,_) vs ctxt_lvl dest_lvl
-  = ASSERT( all isId vs )
-    getUs 			`thenLvl` \ us ->
-    let
-      (subst', vs1) = cloneRecIdBndrs subst us vs
-      vs2	    = map (zap_demand ctxt_lvl dest_lvl) vs1
-      env'	    = extendCloneLvlEnv dest_lvl env subst' (vs `zip` vs2)
-    in
-    returnUs (env', vs2)
-
-	-- VERY IMPORTANT: we must zap the demand info 
-	-- if the thing is going to float out past a lambda
-zap_demand dest_lvl ctxt_lvl id
-  | ctxt_lvl == dest_lvl = id			-- Stays put
-  | otherwise		 = zapDemandIdInfo id	-- Floats out
-\end{code}
-	
diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
deleted file mode 100644
index a386a3d6b0..0000000000
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ /dev/null
@@ -1,674 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[SimplCore]{Driver for simplifying @Core@ programs}
-
-\begin{code}
-module SimplCore ( core2core, simplifyExpr ) where
-
-#include "HsVersions.h"
-
-import DynFlags		( CoreToDo(..), SimplifierSwitch(..),
-			  SimplifierMode(..), DynFlags, DynFlag(..), dopt,
-			  getCoreToDo )
-import CoreSyn
-import HscTypes		( HscEnv(..), ModGuts(..), ExternalPackageState(..),
-			  Dependencies( dep_mods ), 
-			  hscEPS, hptRules )
-import CSE		( cseProgram )
-import Rules		( RuleBase, emptyRuleBase, mkRuleBase, unionRuleBase,
-			  extendRuleBaseList, pprRuleBase, ruleCheckProgram,
-			  addSpecInfo, addIdSpecialisations )
-import PprCore		( pprCoreBindings, pprCoreExpr, pprRules )
-import OccurAnal	( occurAnalysePgm, occurAnalyseExpr )
-import IdInfo		( setNewStrictnessInfo, newStrictnessInfo, 
-			  setWorkerInfo, workerInfo,
-			  setSpecInfo, specInfo, specInfoRules )
-import CoreUtils	( coreBindsSize )
-import Simplify		( simplTopBinds, simplExpr )
-import SimplEnv		( SimplEnv, simplBinders, mkSimplEnv, setInScopeSet )
-import SimplMonad
-import ErrUtils		( dumpIfSet, dumpIfSet_dyn, showPass )
-import CoreLint		( endPass )
-import FloatIn		( floatInwards )
-import FloatOut		( floatOutwards )
-import Id		( Id, modifyIdInfo, idInfo, isExportedId, isLocalId,
-			  idSpecialisation, idName )
-import VarSet
-import VarEnv
-import NameEnv		( lookupNameEnv )
-import LiberateCase	( liberateCase )
-import SAT		( doStaticArgs )
-import Specialise	( specProgram)
-import SpecConstr	( specConstrProgram)
-import DmdAnal		( dmdAnalPgm )
-import WorkWrap	        ( wwTopBinds )
-#ifdef OLD_STRICTNESS
-import StrictAnal	( saBinds )
-import CprAnalyse       ( cprAnalyse )
-#endif
-
-import UniqSupply	( UniqSupply, mkSplitUniqSupply, splitUniqSupply )
-import IO		( hPutStr, stderr )
-import Outputable
-import List		( partition )
-import Maybes		( orElse )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The driver for the simplifier}
-%*									*
-%************************************************************************
-
-\begin{code}
-core2core :: HscEnv
-	  -> ModGuts
-	  -> IO ModGuts
-
-core2core hsc_env guts
-  = do
-        let dflags = hsc_dflags hsc_env
-	    core_todos = getCoreToDo dflags
-
-	us <- mkSplitUniqSupply 's'
-	let (cp_us, ru_us) = splitUniqSupply us
-
-		-- COMPUTE THE RULE BASE TO USE
-	(imp_rule_base, guts') <- prepareRules hsc_env guts ru_us
-
-		-- DO THE BUSINESS
-	(stats, guts'') <- doCorePasses hsc_env imp_rule_base cp_us
-			 		(zeroSimplCount dflags) 
-					guts' core_todos
-
-	dumpIfSet_dyn dflags Opt_D_dump_simpl_stats
-		  "Grand total simplifier statistics"
-		  (pprSimplCount stats)
-
-	return guts''
-
-
-simplifyExpr :: DynFlags -- includes spec of what core-to-core passes to do
-	     -> CoreExpr
-	     -> IO CoreExpr
--- simplifyExpr is called by the driver to simplify an
--- expression typed in at the interactive prompt
-simplifyExpr dflags expr
-  = do	{
-	; showPass dflags "Simplify"
-
-	; us <-  mkSplitUniqSupply 's'
-
-	; let (expr', _counts) = initSmpl dflags us $
-				 simplExprGently gentleSimplEnv expr
-
-	; dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
-			(pprCoreExpr expr')
-
-	; return expr'
-	}
-
-gentleSimplEnv :: SimplEnv
-gentleSimplEnv = mkSimplEnv SimplGently 
-			    (isAmongSimpl [])
-			    emptyRuleBase
-
-doCorePasses :: HscEnv
-             -> RuleBase        -- the imported main rule base
-             -> UniqSupply      -- uniques
-	     -> SimplCount      -- simplifier stats
-             -> ModGuts	        -- local binds in (with rules attached)
-             -> [CoreToDo]      -- which passes to do
-             -> IO (SimplCount, ModGuts)
-
-doCorePasses hsc_env rb us stats guts []
-  = return (stats, guts)
-
-doCorePasses hsc_env rb us stats guts (to_do : to_dos) 
-  = do
-	let (us1, us2) = splitUniqSupply us
-	(stats1, guts1) <- doCorePass to_do hsc_env us1 rb guts
-	doCorePasses hsc_env rb us2 (stats `plusSimplCount` stats1) guts1 to_dos
-
-doCorePass (CoreDoSimplify mode sws)   = _scc_ "Simplify"      simplifyPgm mode sws
-doCorePass CoreCSE		       = _scc_ "CommonSubExpr" trBinds  cseProgram
-doCorePass CoreLiberateCase	       = _scc_ "LiberateCase"  trBinds  liberateCase
-doCorePass CoreDoFloatInwards          = _scc_ "FloatInwards"  trBinds  floatInwards
-doCorePass (CoreDoFloatOutwards f)     = _scc_ "FloatOutwards" trBindsU (floatOutwards f)
-doCorePass CoreDoStaticArgs	       = _scc_ "StaticArgs"    trBinds  doStaticArgs
-doCorePass CoreDoStrictness	       = _scc_ "Stranal"       trBinds  dmdAnalPgm
-doCorePass CoreDoWorkerWrapper         = _scc_ "WorkWrap"      trBindsU wwTopBinds
-doCorePass CoreDoSpecialising          = _scc_ "Specialise"    trBindsU specProgram
-doCorePass CoreDoSpecConstr	       = _scc_ "SpecConstr"    trBindsU specConstrProgram
-doCorePass CoreDoGlomBinds	       = trBinds glomBinds
-doCorePass CoreDoPrintCore	       = observe printCore
-doCorePass (CoreDoRuleCheck phase pat) = observe (ruleCheck phase pat)
-doCorePass CoreDoNothing	       = observe (\ _ _ -> return ())
-#ifdef OLD_STRICTNESS		       
-doCorePass CoreDoOldStrictness	       = _scc_ "OldStrictness" trBinds doOldStrictness
-#endif
-
-#ifdef OLD_STRICTNESS
-doOldStrictness dfs binds
-  = do binds1 <- saBinds dfs binds
-       binds2 <- cprAnalyse dfs binds1
-       return binds2
-#endif
-
-printCore _ binds = dumpIfSet True "Print Core" (pprCoreBindings binds)
-
-ruleCheck phase pat dflags binds = do showPass dflags "RuleCheck"
-				      printDump (ruleCheckProgram phase pat binds)
-
--- Most passes return no stats and don't change rules
-trBinds :: (DynFlags -> [CoreBind] -> IO [CoreBind])
-	-> HscEnv -> UniqSupply -> RuleBase -> ModGuts
-	-> IO (SimplCount, ModGuts)
-trBinds do_pass hsc_env us rb guts
-  = do	{ binds' <- do_pass dflags (mg_binds guts)
-	; return (zeroSimplCount dflags, guts { mg_binds = binds' }) }
-  where
-    dflags = hsc_dflags hsc_env
-
-trBindsU :: (DynFlags -> UniqSupply -> [CoreBind] -> IO [CoreBind])
-	-> HscEnv -> UniqSupply -> RuleBase -> ModGuts
-	-> IO (SimplCount, ModGuts)
-trBindsU do_pass hsc_env us rb guts
-  = do	{ binds' <- do_pass dflags us (mg_binds guts)
-	; return (zeroSimplCount dflags, guts { mg_binds = binds' }) }
-  where
-    dflags = hsc_dflags hsc_env
-
--- Observer passes just peek; don't modify the bindings at all
-observe :: (DynFlags -> [CoreBind] -> IO a)
-	-> HscEnv -> UniqSupply -> RuleBase -> ModGuts
-	-> IO (SimplCount, ModGuts)
-observe do_pass hsc_env us rb guts 
-  = do	{ binds <- do_pass dflags (mg_binds guts)
-	; return (zeroSimplCount dflags, guts) }
-  where
-    dflags = hsc_dflags hsc_env
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Dealing with rules}
-%*									*
-%************************************************************************
-
--- prepareLocalRuleBase takes the CoreBinds and rules defined in this module.
--- It attaches those rules that are for local Ids to their binders, and
--- returns the remainder attached to Ids in an IdSet.  
-
-\begin{code}
-prepareRules :: HscEnv 
-	     -> ModGuts
-	     -> UniqSupply
-	     -> IO (RuleBase, 		-- Rule base for imported things, incl
-					-- (a) rules defined in this module (orphans)
-					-- (b) rules from other modules in home package
-					-- but not things from other packages
-
-		    ModGuts)		-- Modified fields are 
-					--	(a) Bindings have rules attached,
-					-- 	(b) Rules are now just orphan rules
-
-prepareRules hsc_env@(HscEnv { hsc_dflags = dflags, hsc_HPT = hpt })
-	     guts@(ModGuts { mg_binds = binds, mg_deps = deps, mg_rules = local_rules })
-	     us 
-  = do	{ let 	-- Simplify the local rules; boringly, we need to make an in-scope set
-		-- from the local binders, to avoid warnings from Simplify.simplVar
-	      local_ids        = mkInScopeSet (mkVarSet (bindersOfBinds binds))
-	      env	       = setInScopeSet gentleSimplEnv local_ids 
-	      (better_rules,_) = initSmpl dflags us (mapSmpl (simplRule env) local_rules)
-	      home_pkg_rules   = hptRules hsc_env (dep_mods deps)
-
-		-- Find the rules for locally-defined Ids; then we can attach them
-		-- to the binders in the top-level bindings
-		-- 
-		-- Reason
-		-- 	- It makes the rules easier to look up
-		--	- It means that transformation rules and specialisations for
-		--	  locally defined Ids are handled uniformly
-		--	- It keeps alive things that are referred to only from a rule
-		--	  (the occurrence analyser knows about rules attached to Ids)
-		--	- It makes sure that, when we apply a rule, the free vars
-		--	  of the RHS are more likely to be in scope
-		--	- The imported rules are carried in the in-scope set
-		--	  which is extended on each iteration by the new wave of
-		--	  local binders; any rules which aren't on the binding will
-		--	  thereby get dropped
-	      (rules_for_locals, rules_for_imps) = partition isLocalRule better_rules
-	      local_rule_base = extendRuleBaseList emptyRuleBase rules_for_locals
-	      binds_w_rules   = updateBinders local_rule_base binds
-
-	      hpt_rule_base = mkRuleBase home_pkg_rules
-	      imp_rule_base = extendRuleBaseList hpt_rule_base rules_for_imps
-
-	; dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules"
-		(vcat [text "Local rules", pprRules better_rules,
-		       text "",
-		       text "Imported rules", pprRuleBase imp_rule_base])
-
-	; return (imp_rule_base, guts { mg_binds = binds_w_rules, 
-					mg_rules = rules_for_imps })
-    }
-
-updateBinders :: RuleBase -> [CoreBind] -> [CoreBind]
-updateBinders local_rules binds
-  = map update_bndrs binds
-  where
-    update_bndrs (NonRec b r) = NonRec (update_bndr b) r
-    update_bndrs (Rec prs)    = Rec [(update_bndr b, r) | (b,r) <- prs]
-
-    update_bndr bndr = case lookupNameEnv local_rules (idName bndr) of
-			  Nothing    -> bndr
-			  Just rules -> bndr `addIdSpecialisations` rules
-				-- The binder might have some existing rules,
-				-- arising from specialisation pragmas
-\end{code}
-
-
-We must do some gentle simplification on the template (but not the RHS)
-of each rule.  The case that forced me to add this was the fold/build rule,
-which without simplification looked like:
-	fold k z (build (/\a. g a))  ==>  ...
-This doesn't match unless you do eta reduction on the build argument.
-
-\begin{code}
-simplRule env rule@(BuiltinRule {})
-  = returnSmpl rule
-simplRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs })
-  = simplBinders env bndrs		`thenSmpl` \ (env, bndrs') -> 
-    mapSmpl (simplExprGently env) args	`thenSmpl` \ args' ->
-    simplExprGently env rhs		`thenSmpl` \ rhs' ->
-    returnSmpl (rule { ru_bndrs = bndrs', ru_args = args', ru_rhs = rhs' })
-
--- It's important that simplExprGently does eta reduction.
--- For example, in a rule like:
---	augment g (build h) 
--- we do not want to get
---	augment (\a. g a) (build h)
--- otherwise we don't match when given an argument like
---	(\a. h a a)
---
--- The simplifier does indeed do eta reduction (it's in
--- Simplify.completeLam) but only if -O is on.
-\end{code}
-
-\begin{code}
-simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr
--- Simplifies an expression 
--- 	does occurrence analysis, then simplification
---	and repeats (twice currently) because one pass
---	alone leaves tons of crud.
--- Used (a) for user expressions typed in at the interactive prompt
---	(b) the LHS and RHS of a RULE
---
--- The name 'Gently' suggests that the SimplifierMode is SimplGently,
--- and in fact that is so.... but the 'Gently' in simplExprGently doesn't
--- enforce that; it just simplifies the expression twice
-
-simplExprGently env expr
-  = simplExpr env (occurAnalyseExpr expr) 	`thenSmpl` \ expr1 ->
-    simplExpr env (occurAnalyseExpr expr1)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Glomming}
-%*									*
-%************************************************************************
-
-\begin{code}
-glomBinds :: DynFlags -> [CoreBind] -> IO [CoreBind]
--- Glom all binds together in one Rec, in case any
--- transformations have introduced any new dependencies
---
--- NB: the global invariant is this:
---	*** the top level bindings are never cloned, and are always unique ***
---
--- We sort them into dependency order, but applying transformation rules may
--- make something at the top refer to something at the bottom:
---	f = \x -> p (q x)
---	h = \y -> 3
---	
---	RULE:  p (q x) = h x
---
--- Applying this rule makes f refer to h, 
--- although it doesn't appear to in the source program.  
--- This pass lets us control where it happens.
---
--- NOTICE that this cannot happen for rules whose head is a locally-defined
--- function.  It only happens for rules whose head is an imported function
--- (p in the example above).  So, for example, the rule had been
---	RULE: f (p x) = h x
--- then the rule for f would be attached to f itself (in its IdInfo) 
--- by prepareLocalRuleBase and h would be regarded by the occurrency 
--- analyser as free in f.
-
-glomBinds dflags binds
-  = do { showPass dflags "GlomBinds" ;
-	 let { recd_binds = [Rec (flattenBinds binds)] } ;
-	 return recd_binds }
-	-- Not much point in printing the result... 
-	-- just consumes output bandwidth
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The driver for the simplifier}
-%*									*
-%************************************************************************
-
-\begin{code}
-simplifyPgm :: SimplifierMode
-	    -> [SimplifierSwitch]
-	    -> HscEnv
-	    -> UniqSupply
-	    -> RuleBase
-	    -> ModGuts
-	    -> IO (SimplCount, ModGuts)  -- New bindings
-
-simplifyPgm mode switches hsc_env us imp_rule_base guts
-  = do {
-	showPass dflags "Simplify";
-
-	(termination_msg, it_count, counts_out, binds') 
-	   <- do_iteration us 1 (zeroSimplCount dflags) (mg_binds guts) ;
-
-	dumpIfSet (dopt Opt_D_verbose_core2core dflags 
-                   && dopt Opt_D_dump_simpl_stats dflags)
-		  "Simplifier statistics"
-		  (vcat [text termination_msg <+> text "after" <+> ppr it_count <+> text "iterations",
-			 text "",
-			 pprSimplCount counts_out]);
-
-	endPass dflags "Simplify" Opt_D_verbose_core2core binds';
-
-	return (counts_out, guts { mg_binds = binds' })
-    }
-  where
-    dflags 	   = hsc_dflags hsc_env
-    phase_info	   = case mode of
-		   	  SimplGently  -> "gentle"
-		   	  SimplPhase n -> show n
-		   
-    sw_chkr	   = isAmongSimpl switches
-    max_iterations = intSwitchSet sw_chkr MaxSimplifierIterations `orElse` 2
- 
-    do_iteration us iteration_no counts binds
-	-- iteration_no is the number of the iteration we are
-	-- about to begin, with '1' for the first
-      | iteration_no > max_iterations	-- Stop if we've run out of iterations
-      = do {
-#ifdef DEBUG
-	    if  max_iterations > 2 then
-		hPutStr stderr ("NOTE: Simplifier still going after " ++ 
-				show max_iterations ++ 
-			    	" iterations; bailing out.\n")
-	    else 
-		return ();
-#endif
-		-- Subtract 1 from iteration_no to get the
-		-- number of iterations we actually completed
-	    return ("Simplifier baled out", iteration_no - 1, counts, binds)
-	}
-
-      -- Try and force thunks off the binds; significantly reduces
-      -- space usage, especially with -O.  JRS, 000620.
-      | let sz = coreBindsSize binds in sz == sz
-      = do {
-		-- Occurrence analysis
-	   let { tagged_binds = _scc_ "OccAnal" occurAnalysePgm binds } ;
-	   dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
-		     (pprCoreBindings tagged_binds);
-
-	   	-- Get any new rules, and extend the rule base
-		-- We need to do this regularly, because simplification can
-		-- poke on IdInfo thunks, which in turn brings in new rules
-		-- behind the scenes.  Otherwise there's a danger we'll simply
-		-- miss the rules for Ids hidden inside imported inlinings
-	   eps <- hscEPS hsc_env ;
-	   let	{ rule_base' = unionRuleBase imp_rule_base (eps_rule_base eps)
-		; simpl_env  = mkSimplEnv mode sw_chkr rule_base' } ;
-	   
-		-- Simplify the program
-		-- We do this with a *case* not a *let* because lazy pattern
-		-- matching bit us with bad space leak!
-		-- With a let, we ended up with
-		--   let
-		--	t = initSmpl ...
-		--	counts' = snd t
-		--   in
-		-- 	case t of {(_,counts') -> if counts'=0 then ... }
-		-- So the conditional didn't force counts', because the
-		-- selection got duplicated.  Sigh!
-	   case initSmpl dflags us1 (_scc_ "SimplTopBinds" simplTopBinds simpl_env tagged_binds) of {
-	  	(binds', counts') -> do {
-
-	   let	{ all_counts = counts `plusSimplCount` counts'
-		; herald     = "Simplifier phase " ++ phase_info ++ 
-			      ", iteration " ++ show iteration_no ++
-			      " out of " ++ show max_iterations
-	        } ;
-
-		-- Stop if nothing happened; don't dump output
-	   if isZeroSimplCount counts' then
-		return ("Simplifier reached fixed point", iteration_no, 
-			all_counts, binds')
-	   else do {
-		-- Short out indirections
-		-- We do this *after* at least one run of the simplifier 
-		-- because indirection-shorting uses the export flag on *occurrences*
-		-- and that isn't guaranteed to be ok until after the first run propagates
-		-- stuff from the binding site to its occurrences
-	   let { binds'' = _scc_ "ZapInd" shortOutIndirections binds' } ;
-
-		-- Dump the result of this iteration
-	   dumpIfSet_dyn dflags Opt_D_dump_simpl_iterations herald
-		         (pprSimplCount counts') ;
-	   endPass dflags herald Opt_D_dump_simpl_iterations binds'' ;
-
-		-- Loop
-  	   do_iteration us2 (iteration_no + 1) all_counts binds''
-	}  } } }
-      where
-  	  (us1, us2) = splitUniqSupply us
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Shorting out indirections
-%*									*
-%************************************************************************
-
-If we have this:
-
-	x_local = <expression>
-	...bindings...
-	x_exported = x_local
-
-where x_exported is exported, and x_local is not, then we replace it with this:
-
-	x_exported = <expression>
-	x_local = x_exported
-	...bindings...
-
-Without this we never get rid of the x_exported = x_local thing.  This
-save a gratuitous jump (from \tr{x_exported} to \tr{x_local}), and
-makes strictness information propagate better.  This used to happen in
-the final phase, but it's tidier to do it here.
-
-STRICTNESS: if we have done strictness analysis, we want the strictness info on
-x_local to transfer to x_exported.  Hence the copyIdInfo call.
-
-RULES: we want to *add* any RULES for x_local to x_exported.
-
-Note [Rules and indirection-zapping]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Problem: what if x_exported has a RULE that mentions something in ...bindings...?
-Then the things mentioned can be out of scope!  Solution
- a) Make sure that in this pass the usage-info from x_exported is 
-	available for ...bindings...
- b) If there are any such RULES, rec-ify the entire top-level. 
-    It'll get sorted out next time round
-
-Messing up the rules
-~~~~~~~~~~~~~~~~~~~~
-The example that went bad on me at one stage was this one:
-	
-    iterate :: (a -> a) -> a -> [a]
-	[Exported]
-    iterate = iterateList	
-    
-    iterateFB c f x = x `c` iterateFB c f (f x)
-    iterateList f x =  x : iterateList f (f x)
-    	[Not exported]
-    
-    {-# RULES
-    "iterate"	forall f x.	iterate f x = build (\c _n -> iterateFB c f x)
-    "iterateFB" 		iterateFB (:) = iterateList
-     #-}
-
-This got shorted out to:
-
-    iterateList :: (a -> a) -> a -> [a]
-    iterateList = iterate
-    
-    iterateFB c f x = x `c` iterateFB c f (f x)
-    iterate f x =  x : iterate f (f x)
-    
-    {-# RULES
-    "iterate"	forall f x.	iterate f x = build (\c _n -> iterateFB c f x)
-    "iterateFB" 		iterateFB (:) = iterate
-     #-}
-
-And now we get an infinite loop in the rule system 
-	iterate f x -> build (\cn -> iterateFB c f x)
-		    -> iterateFB (:) f x
-		    -> iterate f x
-
-Tiresome old solution: 
-	don't do shorting out if f has rewrite rules (see shortableIdInfo)
-
-New solution (I think): 
-	use rule switching-off pragmas to get rid 
-	of iterateList in the first place
-
-
-Other remarks
-~~~~~~~~~~~~~
-If more than one exported thing is equal to a local thing (i.e., the
-local thing really is shared), then we do one only:
-\begin{verbatim}
-	x_local = ....
-	x_exported1 = x_local
-	x_exported2 = x_local
-==>
-	x_exported1 = ....
-
-	x_exported2 = x_exported1
-\end{verbatim}
-
-We rely on prior eta reduction to simplify things like
-\begin{verbatim}
-	x_exported = /\ tyvars -> x_local tyvars
-==>
-	x_exported = x_local
-\end{verbatim}
-Hence,there's a possibility of leaving unchanged something like this:
-\begin{verbatim}
-	x_local = ....
-	x_exported1 = x_local Int
-\end{verbatim}
-By the time we've thrown away the types in STG land this 
-could be eliminated.  But I don't think it's very common
-and it's dangerous to do this fiddling in STG land 
-because we might elminate a binding that's mentioned in the
-unfolding for something.
-
-\begin{code}
-type IndEnv = IdEnv Id		-- Maps local_id -> exported_id
-
-shortOutIndirections :: [CoreBind] -> [CoreBind]
-shortOutIndirections binds
-  | isEmptyVarEnv ind_env = binds
-  | no_need_to_flatten	  = binds'
-  | otherwise 		  = [Rec (flattenBinds binds')]	-- See Note [Rules and indirect-zapping]
-  where
-    ind_env 	       = makeIndEnv binds
-    exp_ids 	       = varSetElems ind_env	-- These exported Ids are the subjects
-    exp_id_set	       = mkVarSet exp_ids	-- of the indirection-elimination
-    no_need_to_flatten = all (null . specInfoRules . idSpecialisation) exp_ids
-    binds' 	       = concatMap zap binds
-
-    zap (NonRec bndr rhs) = [NonRec b r | (b,r) <- zapPair (bndr,rhs)]
-    zap (Rec pairs)	  = [Rec (concatMap zapPair pairs)]
-
-    zapPair (bndr, rhs)
-	| bndr `elemVarSet` exp_id_set 		   = []
-	| Just exp_id <- lookupVarEnv ind_env bndr = [(transferIdInfo exp_id bndr, rhs),
-						      (bndr, Var exp_id)]
-	| otherwise				   = [(bndr,rhs)]
-			     
-makeIndEnv :: [CoreBind] -> IndEnv
-makeIndEnv binds
-  = foldr add_bind emptyVarEnv binds
-  where
-    add_bind :: CoreBind -> IndEnv -> IndEnv
-    add_bind (NonRec exported_id rhs) env = add_pair (exported_id, rhs) env
-    add_bind (Rec pairs)	      env = foldr add_pair env pairs
-
-    add_pair :: (Id,CoreExpr) -> IndEnv -> IndEnv
-    add_pair (exported_id, Var local_id) env
-	| shortMeOut env exported_id local_id = extendVarEnv env local_id exported_id
-    add_pair (exported_id, rhs) env
-	= env
-			
-shortMeOut ind_env exported_id local_id
--- The if-then-else stuff is just so I can get a pprTrace to see
--- how often I don't get shorting out becuase of IdInfo stuff
-  = if isExportedId exported_id &&		-- Only if this is exported
-
-       isLocalId local_id &&			-- Only if this one is defined in this
-						-- 	module, so that we *can* change its
-				 	 	-- 	binding to be the exported thing!
-
-       not (isExportedId local_id) &&		-- Only if this one is not itself exported,
-					   	--	since the transformation will nuke it
-   
-       not (local_id `elemVarEnv` ind_env)	-- Only if not already substituted for
-    then
-	True
-
-{- No longer needed
-	if isEmptySpecInfo (specInfo (idInfo exported_id)) 	-- Only if no rules
-	then True	-- See note on "Messing up rules"
-	else 
-#ifdef DEBUG 
-          pprTrace "shortMeOut:" (ppr exported_id)
-#endif
-                                                False
--}
-    else
-	False
-
-
------------------
-transferIdInfo :: Id -> Id -> Id
-transferIdInfo exported_id local_id
-  = modifyIdInfo transfer exported_id
-  where
-    local_info = idInfo local_id
-    transfer exp_info = exp_info `setNewStrictnessInfo` newStrictnessInfo local_info
-				 `setWorkerInfo`        workerInfo local_info
-				 `setSpecInfo`	        addSpecInfo (specInfo exp_info)
-							            (specInfo local_info)
-\end{code}
diff --git a/ghc/compiler/simplCore/SimplEnv.lhs b/ghc/compiler/simplCore/SimplEnv.lhs
deleted file mode 100644
index 00f035e513..0000000000
--- a/ghc/compiler/simplCore/SimplEnv.lhs
+++ /dev/null
@@ -1,741 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1993-1998
-%
-\section[SimplMonad]{The simplifier Monad}
-
-\begin{code}
-module SimplEnv (
-	InId, InBind, InExpr, InAlt, InArg, InType, InBinder,
-	OutId, OutTyVar, OutBind, OutExpr, OutAlt, OutArg, OutType, OutBinder,
-
-	-- The simplifier mode
-	setMode, getMode, 
-
-	-- Switch checker
-	SwitchChecker, SwitchResult(..), getSwitchChecker, getSimplIntSwitch,
-	isAmongSimpl, intSwitchSet, switchIsOn,
-
-	setEnclosingCC, getEnclosingCC,
-
-	-- Environments
-	SimplEnv, mkSimplEnv, extendIdSubst, extendTvSubst, 
-	zapSubstEnv, setSubstEnv, 
-	getInScope, setInScope, setInScopeSet, modifyInScope, addNewInScopeIds,
-	getRules, refineSimplEnv,
-
-	SimplSR(..), mkContEx, substId, 
-
-	simplNonRecBndr, simplRecBndrs, simplLamBndr, simplLamBndrs, 
- 	simplBinder, simplBinders, addLetIdInfo,
-	substExpr, substTy,
-
-	-- Floats
-	FloatsWith, FloatsWithExpr,
-  	Floats, emptyFloats, isEmptyFloats, unitFloat, addFloats, flattenFloats,
-	allLifted, wrapFloats, floatBinds,
-	addAuxiliaryBind,
-    ) where
-
-#include "HsVersions.h"
-
-import SimplMonad	
-import Id		( Id, idType, idOccInfo, idUnfolding, setIdUnfolding )
-import IdInfo		( IdInfo, vanillaIdInfo, occInfo, setOccInfo, specInfo, setSpecInfo,
-			  arityInfo, setArityInfo, workerInfo, setWorkerInfo, 
-			  unfoldingInfo, setUnfoldingInfo, isEmptySpecInfo,
-			  unknownArity, workerExists
-			    )
-import CoreSyn
-import Unify		( TypeRefinement )
-import Rules		( RuleBase )
-import CoreUtils	( needsCaseBinding )
-import CostCentre	( CostCentreStack, subsumedCCS )
-import Var	
-import VarEnv
-import VarSet		( isEmptyVarSet )
-import OrdList
-
-import qualified CoreSubst	( Subst, mkSubst, substExpr, substSpec, substWorker )
-import qualified Type		( substTy, substTyVarBndr )
-
-import Type             ( Type, TvSubst(..), TvSubstEnv, composeTvSubst,
-			  isUnLiftedType, seqType, tyVarsOfType )
-import BasicTypes	( OccInfo(..), isFragileOcc )
-import DynFlags		( SimplifierMode(..) )
-import Util		( mapAccumL )
-import Outputable
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Simplify-types]{Type declarations}
-%*									*
-%************************************************************************
-
-\begin{code}
-type InBinder  = CoreBndr
-type InId      = Id			-- Not yet cloned
-type InType    = Type			-- Ditto
-type InBind    = CoreBind
-type InExpr    = CoreExpr
-type InAlt     = CoreAlt
-type InArg     = CoreArg
-
-type OutBinder  = CoreBndr
-type OutId	= Id			-- Cloned
-type OutTyVar	= TyVar			-- Cloned
-type OutType	= Type			-- Cloned
-type OutBind	= CoreBind
-type OutExpr	= CoreExpr
-type OutAlt	= CoreAlt
-type OutArg	= CoreArg
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{The @SimplEnv@ type}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-data SimplEnv
-  = SimplEnv {
-	seMode 	    :: SimplifierMode,
-	seChkr      :: SwitchChecker,
-	seCC        :: CostCentreStack,	-- The enclosing CCS (when profiling)
-
-	-- Rules from other modules
-	seExtRules  :: RuleBase,
-
-	-- The current set of in-scope variables
-	-- They are all OutVars, and all bound in this module
-	seInScope   :: InScopeSet,	-- OutVars only
-
-	-- The current substitution
-	seTvSubst   :: TvSubstEnv,	-- InTyVar |--> OutType
-	seIdSubst   :: SimplIdSubst	-- InId    |--> OutExpr
-    }
-
-type SimplIdSubst = IdEnv SimplSR	-- IdId |--> OutExpr
-
-data SimplSR
-  = DoneEx OutExpr		-- Completed term
-  | DoneId OutId OccInfo	-- Completed term variable, with occurrence info
-  | ContEx TvSubstEnv	 	-- A suspended substitution
-	   SimplIdSubst
-	   InExpr 	 
-\end{code}
-
-
-seInScope: 
-	The in-scope part of Subst includes *all* in-scope TyVars and Ids
-	The elements of the set may have better IdInfo than the
-	occurrences of in-scope Ids, and (more important) they will
-	have a correctly-substituted type.  So we use a lookup in this
-	set to replace occurrences
-
-	The Ids in the InScopeSet are replete with their Rules,
-	and as we gather info about the unfolding of an Id, we replace
-	it in the in-scope set.  
-
-	The in-scope set is actually a mapping OutVar -> OutVar, and
-	in case expressions we sometimes bind 
-
-seIdSubst:
-	The substitution is *apply-once* only, because InIds and OutIds can overlap.
-	For example, we generally omit mappings 
-		a77 -> a77
-	from the substitution, when we decide not to clone a77, but it's quite 
-	legitimate to put the mapping in the substitution anyway.
-	
-	Indeed, we do so when we want to pass fragile OccInfo to the
-	occurrences of the variable; we add a substitution
-		x77 -> DoneId x77 occ
-	to record x's occurrence information.]
-
-	Furthermore, consider 
-		let x = case k of I# x77 -> ... in
-		let y = case k of I# x77 -> ... in ...
-	and suppose the body is strict in both x and y.  Then the simplifier
-	will pull the first (case k) to the top; so the second (case k) will
-	cancel out, mapping x77 to, well, x77!  But one is an in-Id and the 
-	other is an out-Id. 
-
-	Of course, the substitution *must* applied! Things in its domain 
-	simply aren't necessarily bound in the result.
-
-* substId adds a binding (DoneId new_id occ) to the substitution if 
-	EITHER the Id's unique has changed
-	OR     the Id has interesting occurrence information
-  So in effect you can only get to interesting occurrence information
-  by looking up the *old* Id; it's not really attached to the new id
-  at all.
-
-  Note, though that the substitution isn't necessarily extended
-  if the type changes.  Why not?  Because of the next point:
-
-* We *always, always* finish by looking up in the in-scope set 
-  any variable that doesn't get a DoneEx or DoneVar hit in the substitution.
-  Reason: so that we never finish up with a "old" Id in the result.  
-  An old Id might point to an old unfolding and so on... which gives a space leak.
-
-  [The DoneEx and DoneVar hits map to "new" stuff.]
-
-* It follows that substExpr must not do a no-op if the substitution is empty.
-  substType is free to do so, however.
-
-* When we come to a let-binding (say) we generate new IdInfo, including an
-  unfolding, attach it to the binder, and add this newly adorned binder to
-  the in-scope set.  So all subsequent occurrences of the binder will get mapped
-  to the full-adorned binder, which is also the one put in the binding site.
-
-* The in-scope "set" usually maps x->x; we use it simply for its domain.
-  But sometimes we have two in-scope Ids that are synomyms, and should
-  map to the same target:  x->x, y->x.  Notably:
-	case y of x { ... }
-  That's why the "set" is actually a VarEnv Var
-
-
-Note [GADT type refinement]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When we come to a GADT pattern match that refines the in-scope types, we
-  a) Refine the types of the Ids in the in-scope set, seInScope.  
-     For exmaple, consider
-	data T a where
-		Foo :: T (Bool -> Bool)
-
-	(\ (x::T a) (y::a) -> case x of { Foo -> y True }
-
-     Technically this is well-typed, but exprType will barf on the
-     (y True) unless we refine the type on y's occurrence.
-
-  b) Refine the range of the type substitution, seTvSubst. 
-     Very similar reason to (a).
-
-  NB: we don't refine the range of the SimplIdSubst, because it's always
-  interpreted relative to the seInScope (see substId)
-
-For (b) we need to be a little careful.  Specifically, we compose the refinement 
-with the type substitution.  Suppose 
-  The substitution was	  [a->b, b->a]
-  and the refinement was  [b->Int]
-  Then we want [a->Int, b->a]
-
-But also if
-  The substitution was	  [a->b]
-  and the refinement was  [b->Int]
-  Then we want [a->Int, b->Int]
-	becuase b might be both an InTyVar and OutTyVar
-
-
-\begin{code}
-mkSimplEnv :: SimplifierMode -> SwitchChecker -> RuleBase -> SimplEnv
-mkSimplEnv mode switches rules
-  = SimplEnv { seChkr = switches, seCC = subsumedCCS, 
-	       seMode = mode, seInScope = emptyInScopeSet, 
-	       seExtRules = rules,
-	       seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv }
-	-- The top level "enclosing CC" is "SUBSUMED".
-
----------------------
-getSwitchChecker :: SimplEnv -> SwitchChecker
-getSwitchChecker env = seChkr env
-
----------------------
-getMode :: SimplEnv -> SimplifierMode
-getMode env = seMode env
-
-setMode :: SimplifierMode -> SimplEnv -> SimplEnv
-setMode mode env = env { seMode = mode }
-
----------------------
-getEnclosingCC :: SimplEnv -> CostCentreStack
-getEnclosingCC env = seCC env
-
-setEnclosingCC :: SimplEnv -> CostCentreStack -> SimplEnv
-setEnclosingCC env cc = env {seCC = cc}
-
----------------------
-extendIdSubst :: SimplEnv -> Id -> SimplSR -> SimplEnv
-extendIdSubst env@(SimplEnv {seIdSubst = subst}) var res
-  = env {seIdSubst = extendVarEnv subst var res}
-
-extendTvSubst :: SimplEnv -> TyVar -> Type -> SimplEnv
-extendTvSubst env@(SimplEnv {seTvSubst = subst}) var res
-  = env {seTvSubst = extendVarEnv subst var res}
-
----------------------
-getInScope :: SimplEnv -> InScopeSet
-getInScope env = seInScope env
-
-setInScopeSet :: SimplEnv -> InScopeSet -> SimplEnv
-setInScopeSet env in_scope = env {seInScope = in_scope}
-
-setInScope :: SimplEnv -> SimplEnv -> SimplEnv
-setInScope env env_with_in_scope = setInScopeSet env (getInScope env_with_in_scope)
-
-addNewInScopeIds :: SimplEnv -> [CoreBndr] -> SimplEnv
-	-- The new Ids are guaranteed to be freshly allocated
-addNewInScopeIds env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) vs
-  = env { seInScope = in_scope `extendInScopeSetList` vs,
-	  seIdSubst = id_subst `delVarEnvList` vs }
-	-- Why delete?  Consider 
-	--	let x = a*b in (x, \x -> x+3)
-	-- We add [x |-> a*b] to the substitution, but we must
-	-- *delete* it from the substitution when going inside
-	-- the (\x -> ...)!
-
-modifyInScope :: SimplEnv -> CoreBndr -> CoreBndr -> SimplEnv
-modifyInScope env@(SimplEnv {seInScope = in_scope}) v v'
-  = env {seInScope = modifyInScopeSet in_scope v v'}
-
----------------------
-zapSubstEnv :: SimplEnv -> SimplEnv
-zapSubstEnv env = env {seTvSubst = emptyVarEnv, seIdSubst = emptyVarEnv}
-
-setSubstEnv :: SimplEnv -> TvSubstEnv -> SimplIdSubst -> SimplEnv
-setSubstEnv env tvs ids = env { seTvSubst = tvs, seIdSubst = ids }
-
-mkContEx :: SimplEnv -> InExpr -> SimplSR
-mkContEx (SimplEnv { seTvSubst = tvs, seIdSubst = ids }) e = ContEx tvs ids e
-
-isEmptySimplSubst :: SimplEnv -> Bool
-isEmptySimplSubst (SimplEnv { seTvSubst = tvs, seIdSubst = ids })
-  = isEmptyVarEnv tvs && isEmptyVarEnv ids
-
----------------------
-getRules :: SimplEnv -> RuleBase
-getRules = seExtRules
-\end{code}
-
-		GADT stuff
-
-Given an idempotent substitution, generated by the unifier, use it to 
-refine the environment
-
-\begin{code}
-refineSimplEnv :: SimplEnv -> TypeRefinement -> SimplEnv
--- The TvSubstEnv is the refinement, and it refines OutTyVars into OutTypes
-refineSimplEnv env@(SimplEnv { seTvSubst = tv_subst, seInScope = in_scope })
-	       (refine_tv_subst, all_bound_here)
-  = env { seTvSubst = composeTvSubst in_scope refine_tv_subst tv_subst,
-	  seInScope = in_scope' }
-  where
-    in_scope' 
-	| all_bound_here = in_scope
-		-- The tvs are the tyvars bound here.  If only they 
-		-- are refined, there's no need to do anything 
-	| otherwise = mapInScopeSet refine_id in_scope
-
-    refine_id v 	-- Only refine its type; any rules will get
-			-- refined if they are used (I hope)
-	| isId v    = setIdType v (Type.substTy refine_subst (idType v))
-	| otherwise = v
-    refine_subst = TvSubst in_scope refine_tv_subst
-\end{code}
-
-%************************************************************************
-%*									*
-		Substitution of Vars
-%*									*
-%************************************************************************
-
-
-\begin{code}
-substId :: SimplEnv -> Id -> SimplSR
-substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v 
-  | not (isLocalId v) 
-  = DoneId v NoOccInfo
-  | otherwise	-- A local Id
-  = case lookupVarEnv ids v of
-	Just (DoneId v occ) -> DoneId (refine v) occ
-	Just res	    -> res
-	Nothing		    -> let v' = refine v
-			       in DoneId v' (idOccInfo v')
-		-- We don't put LoopBreakers in the substitution (unless then need
-		-- to be cloned for name-clash rasons), so the idOccInfo is
-		-- very important!  If isFragileOcc returned True for
-		-- loop breakers we could avoid this call, but at the expense
-		-- of adding more to the substitution, and building new Ids
-		-- a bit more often than really necessary
-  where
-	-- Get the most up-to-date thing from the in-scope set
-	-- Even though it isn't in the substitution, it may be in
-	-- the in-scope set with a different type (we only use the
-	-- substitution if the unique changes).
-    refine v = case lookupInScope in_scope v of
-		 Just v' -> v'
-		 Nothing -> WARN( True, ppr v ) v	-- This is an error!
-\end{code}
-
-
-%************************************************************************
-%*									*
-\section{Substituting an Id binder}
-%*									*
-%************************************************************************
-
-
-These functions are in the monad only so that they can be made strict via seq.
-
-\begin{code}
-simplBinders, simplLamBndrs
-	:: SimplEnv -> [InBinder] -> SimplM (SimplEnv, [OutBinder])
-simplBinders  env bndrs = mapAccumLSmpl simplBinder  env bndrs
-simplLamBndrs env bndrs = mapAccumLSmpl simplLamBndr env bndrs
-
--------------
-simplBinder :: SimplEnv -> InBinder -> SimplM (SimplEnv, OutBinder)
--- Used for lambda and case-bound variables
--- Clone Id if necessary, substitute type
--- Return with IdInfo already substituted, but (fragile) occurrence info zapped
--- The substitution is extended only if the variable is cloned, because
--- we *don't* need to use it to track occurrence info.
-simplBinder env bndr
-  | isTyVar bndr  = do	{ let (env', tv) = substTyVarBndr env bndr
-			; seqTyVar tv `seq` return (env', tv) }
-  | otherwise     = do	{ let (env', id) = substIdBndr env bndr
-			; seqId id `seq` return (env', id) }
-
--------------
-simplLamBndr :: SimplEnv -> Var -> SimplM (SimplEnv, Var)
--- Used for lambda binders.  These sometimes have unfoldings added by
--- the worker/wrapper pass that must be preserved, becuase they can't
--- be reconstructed from context.  For example:
---	f x = case x of (a,b) -> fw a b x
---	fw a b x{=(a,b)} = ...
--- The "{=(a,b)}" is an unfolding we can't reconstruct otherwise.
-simplLamBndr env bndr
-  | not (isId bndr && hasSomeUnfolding old_unf) = simplBinder env bndr	-- Normal case
-  | otherwise					= seqId id2 `seq` return (env', id2)
-  where
-    old_unf = idUnfolding bndr
-    (env', id1) = substIdBndr env bndr
-    id2 = id1 `setIdUnfolding` substUnfolding env old_unf
-
---------------
-substIdBndr :: SimplEnv -> Id 	-- Substitition and Id to transform
-	    -> (SimplEnv, Id)	-- Transformed pair
-
--- Returns with:
---	* Unique changed if necessary
---	* Type substituted
--- 	* Unfolding zapped
---	* Rules, worker, lbvar info all substituted 
---	* Fragile occurrence info zapped
---	* The in-scope set extended with the returned Id
---	* The substitution extended with a DoneId if unique changed
---	  In this case, the var in the DoneId is the same as the
---	  var returned
-
-substIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst})
-	    old_id
-  = (env { seInScope = in_scope `extendInScopeSet` new_id,
-	   seIdSubst = new_subst }, new_id)
-  where
-	-- id1 is cloned if necessary
-    id1 = uniqAway in_scope old_id
-
-	-- id2 has its type zapped
-    id2 = substIdType env id1
-
-	-- new_id has the final IdInfo
-    subst  = mkCoreSubst env
-    new_id = maybeModifyIdInfo (substIdInfo subst) id2
-
-	-- Extend the substitution if the unique has changed
-	-- See the notes with substTyVarBndr for the delSubstEnv
-    new_subst | new_id /= old_id
-	      = extendVarEnv id_subst old_id (DoneId new_id (idOccInfo old_id))
-	      | otherwise 
-	      = delVarEnv id_subst old_id
-\end{code}
-
-
-\begin{code}
-seqTyVar :: TyVar -> ()
-seqTyVar b = b `seq` ()
-
-seqId :: Id -> ()
-seqId id = seqType (idType id)	`seq`
-	   idInfo id		`seq`
-	   ()
-
-seqIds :: [Id] -> ()
-seqIds []       = ()
-seqIds (id:ids) = seqId id `seq` seqIds ids
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Let bindings
-%*									*
-%************************************************************************
-
-Simplifying let binders
-~~~~~~~~~~~~~~~~~~~~~~~
-Rename the binders if necessary, 
-
-\begin{code}
-simplNonRecBndr :: SimplEnv -> InBinder -> SimplM (SimplEnv, OutBinder)
-simplNonRecBndr env id
-  = do	{ let (env1, id1) = substLetIdBndr env id
-	; seqId id1 `seq` return (env1, id1) }
-
----------------
-simplRecBndrs :: SimplEnv -> [InBinder] -> SimplM (SimplEnv, [OutBinder])
-simplRecBndrs env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) ids
-  = do	{ let (env1, ids1) = mapAccumL substLetIdBndr env ids
-	; seqIds ids1 `seq` return (env1, ids1) }
-
----------------
-substLetIdBndr :: SimplEnv -> InBinder 	-- Env and binder to transform
-	       -> (SimplEnv, OutBinder)
--- C.f. CoreSubst.substIdBndr
--- Clone Id if necessary, substitute its type
--- Return an Id with completely zapped IdInfo
--- 	[addLetIdInfo, below, will restore its IdInfo]
--- Augment the subtitution 
---	if the unique changed, *or* 
---	if there's interesting occurrence info
-
-substLetIdBndr env@(SimplEnv { seInScope = in_scope, seIdSubst = id_subst }) old_id
-  = (env { seInScope = in_scope `extendInScopeSet` new_id, 
-	   seIdSubst = new_subst }, new_id)
-  where
-    id1	   = uniqAway in_scope old_id
-    id2    = substIdType env id1
-    new_id = setIdInfo id2 vanillaIdInfo
-
-	-- Extend the substitution if the unique has changed,
-	-- or there's some useful occurrence information
-	-- See the notes with substTyVarBndr for the delSubstEnv
-    occ_info = occInfo (idInfo old_id)
-    new_subst | new_id /= old_id || isFragileOcc occ_info
-	      = extendVarEnv id_subst old_id (DoneId new_id occ_info)
-	      | otherwise 
-	      = delVarEnv id_subst old_id
-\end{code}
-
-Add IdInfo back onto a let-bound Id
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We must transfer the IdInfo of the original binder to the new binder.
-This is crucial, to preserve
-	strictness
-	rules
-	worker info
-etc.  To do this we must apply the current substitution, 
-which incorporates earlier substitutions in this very letrec group.
-
-NB 1. We do this *before* processing the RHS of the binder, so that
-its substituted rules are visible in its own RHS.
-This is important.  Manuel found cases where he really, really
-wanted a RULE for a recursive function to apply in that function's
-own right-hand side.
-
-NB 2: We do not transfer the arity (see Subst.substIdInfo)
-The arity of an Id should not be visible
-in its own RHS, else we eta-reduce
-	f = \x -> f x
-to
-	f = f
-which isn't sound.  And it makes the arity in f's IdInfo greater than
-the manifest arity, which isn't good.
-The arity will get added later.
-
-NB 3: It's important that we *do* transer the loop-breaker OccInfo,
-because that's what stops the Id getting inlined infinitely, in the body
-of the letrec.
-
-NB 4: does no harm for non-recursive bindings
-
-NB 5: we can't do the addLetIdInfo part before *all* the RHSs because
-	rec { f = g
-	      h = ...
-		RULE h Int = f
-	}
-Here, we'll do postInlineUnconditionally on f, and we must "see" that 
-when substituting in h's RULE.  
-
-\begin{code}
-addLetIdInfo :: SimplEnv -> InBinder -> OutBinder -> (SimplEnv, OutBinder)
-addLetIdInfo env in_id out_id
-  = (modifyInScope env out_id out_id, final_id)
-  where
-    final_id = out_id `setIdInfo` new_info
-    subst = mkCoreSubst env
-    old_info = idInfo in_id
-    new_info = case substIdInfo subst old_info of
-	 	  Nothing       -> old_info
-		  Just new_info -> new_info
-
-substIdInfo :: CoreSubst.Subst -> IdInfo -> Maybe IdInfo
--- Substitute the 
---	rules
---	worker info
--- Zap the unfolding 
--- Keep only 'robust' OccInfo
--- Zap Arity
--- 
--- Seq'ing on the returned IdInfo is enough to cause all the 
--- substitutions to happen completely
-
-substIdInfo subst info
-  | nothing_to_do = Nothing
-  | otherwise     = Just (info `setOccInfo`    	  (if keep_occ then old_occ else NoOccInfo)
-			       `setArityInfo`     (if keep_arity then old_arity else unknownArity)
-			       `setSpecInfo`   	  CoreSubst.substSpec   subst old_rules
-			       `setWorkerInfo` 	  CoreSubst.substWorker subst old_wrkr
-			       `setUnfoldingInfo` noUnfolding)
-			-- setSpecInfo does a seq
-			-- setWorkerInfo does a seq
-  where
-    nothing_to_do = keep_occ && keep_arity &&
-		    isEmptySpecInfo old_rules &&
-		    not (workerExists old_wrkr) &&
-		    not (hasUnfolding (unfoldingInfo info))
-    
-    keep_occ   = not (isFragileOcc old_occ)
-    keep_arity = old_arity == unknownArity
-    old_arity = arityInfo info
-    old_occ   = occInfo info
-    old_rules = specInfo info
-    old_wrkr  = workerInfo info
-
-------------------
-substIdType :: SimplEnv -> Id -> Id
-substIdType env@(SimplEnv { seInScope = in_scope,  seTvSubst = tv_env}) id
-  | isEmptyVarEnv tv_env || isEmptyVarSet (tyVarsOfType old_ty) = id
-  | otherwise	= setIdType id (Type.substTy (TvSubst in_scope tv_env) old_ty)
-		-- The tyVarsOfType is cheaper than it looks
-		-- because we cache the free tyvars of the type
-		-- in a Note in the id's type itself
-  where
-    old_ty = idType id
-
-------------------
-substUnfolding env NoUnfolding     	       = NoUnfolding
-substUnfolding env (OtherCon cons) 	       = OtherCon cons
-substUnfolding env (CompulsoryUnfolding rhs)   = CompulsoryUnfolding (substExpr env rhs)
-substUnfolding env (CoreUnfolding rhs t v w g) = CoreUnfolding (substExpr env rhs) t v w g
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Impedence matching to type substitution
-%*									*
-%************************************************************************
-
-\begin{code}
-substTy :: SimplEnv -> Type -> Type 
-substTy (SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) ty
-  = Type.substTy (TvSubst in_scope tv_env) ty
-
-substTyVarBndr :: SimplEnv -> TyVar -> (SimplEnv, TyVar)
-substTyVarBndr env@(SimplEnv { seInScope = in_scope, seTvSubst = tv_env }) tv
-  = case Type.substTyVarBndr (TvSubst in_scope tv_env) tv of
-	(TvSubst in_scope' tv_env', tv') 
-	   -> (env { seInScope = in_scope', seTvSubst = tv_env'}, tv')
-
--- When substituting in rules etc we can get CoreSubst to do the work
--- But CoreSubst uses a simpler form of IdSubstEnv, so we must impedence-match
--- here.  I think the this will not usually result in a lot of work;
--- the substitutions are typically small, and laziness will avoid work in many cases.
-
-mkCoreSubst  :: SimplEnv -> CoreSubst.Subst
-mkCoreSubst (SimplEnv { seInScope = in_scope, seTvSubst = tv_env, seIdSubst = id_env })
-  = mk_subst tv_env id_env
-  where
-    mk_subst tv_env id_env = CoreSubst.mkSubst in_scope tv_env (mapVarEnv fiddle id_env)
-
-    fiddle (DoneEx e)       = e
-    fiddle (DoneId v occ)   = Var v
-    fiddle (ContEx tv id e) = CoreSubst.substExpr (mk_subst tv id) e
-
-substExpr :: SimplEnv -> CoreExpr -> CoreExpr
-substExpr env expr
-  | isEmptySimplSubst env = expr
-  | otherwise	          = CoreSubst.substExpr (mkCoreSubst env) expr
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Floats}
-%*									*
-%************************************************************************
-
-\begin{code}
-type FloatsWithExpr = FloatsWith OutExpr
-type FloatsWith a   = (Floats, a)
-	-- We return something equivalent to (let b in e), but
-	-- in pieces to avoid the quadratic blowup when floating 
-	-- incrementally.  Comments just before simplExprB in Simplify.lhs
-
-data Floats = Floats (OrdList OutBind) 
-		     InScopeSet		-- Environment "inside" all the floats
-		     Bool		-- True <=> All bindings are lifted
-
-allLifted :: Floats -> Bool
-allLifted (Floats _ _ is_lifted) = is_lifted
-
-wrapFloats :: Floats -> OutExpr -> OutExpr
-wrapFloats (Floats bs _ _) body = foldrOL Let body bs
-
-isEmptyFloats :: Floats -> Bool
-isEmptyFloats (Floats bs _ _) = isNilOL bs 
-
-floatBinds :: Floats -> [OutBind]
-floatBinds (Floats bs _ _) = fromOL bs
-
-flattenFloats :: Floats -> Floats
--- Flattens into a single Rec group
-flattenFloats (Floats bs is is_lifted) 
-  = ASSERT2( is_lifted, ppr (fromOL bs) )
-    Floats (unitOL (Rec (flattenBinds (fromOL bs)))) is is_lifted
-\end{code}
-
-\begin{code}
-emptyFloats :: SimplEnv -> Floats
-emptyFloats env = Floats nilOL (getInScope env) True
-
-unitFloat :: SimplEnv -> OutId -> OutExpr -> Floats
--- A single non-rec float; extend the in-scope set
-unitFloat env var rhs = Floats (unitOL (NonRec var rhs))
-			       (extendInScopeSet (getInScope env) var)
-			       (not (isUnLiftedType (idType var)))
-
-addFloats :: SimplEnv -> Floats 
-	  -> (SimplEnv -> SimplM (FloatsWith a))
-	  -> SimplM (FloatsWith a)
-addFloats env (Floats b1 is1 l1) thing_inside
-  | isNilOL b1 
-  = thing_inside env
-  | otherwise
-  = thing_inside (setInScopeSet env is1)	`thenSmpl` \ (Floats b2 is2 l2, res) ->
-    returnSmpl (Floats (b1 `appOL` b2) is2 (l1 && l2), res)
-
-addLetBind :: OutBind -> Floats -> Floats
-addLetBind bind (Floats binds in_scope lifted) 
-  = Floats (bind `consOL` binds) in_scope (lifted && is_lifted_bind bind)
-
-is_lifted_bind (Rec _)      = True
-is_lifted_bind (NonRec b r) = not (isUnLiftedType (idType b))
-
--- addAuxiliaryBind 	* takes already-simplified things (bndr and rhs)
---			* extends the in-scope env
---			* assumes it's a let-bindable thing
-addAuxiliaryBind :: SimplEnv -> OutBind
-		 -> (SimplEnv -> SimplM (FloatsWith a))
-	 	 -> SimplM (FloatsWith a)
-	-- Extends the in-scope environment as well as wrapping the bindings
-addAuxiliaryBind env bind thing_inside
-  = ASSERT( case bind of { NonRec b r -> not (needsCaseBinding (idType b) r) ; Rec _ -> True } )
-    thing_inside (addNewInScopeIds env (bindersOf bind))	`thenSmpl` \ (floats, x) ->
-    returnSmpl (addLetBind bind floats, x)
-\end{code}
-
-
diff --git a/ghc/compiler/simplCore/SimplMonad.lhs b/ghc/compiler/simplCore/SimplMonad.lhs
deleted file mode 100644
index bc09e1128c..0000000000
--- a/ghc/compiler/simplCore/SimplMonad.lhs
+++ /dev/null
@@ -1,526 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1993-1998
-%
-\section[SimplMonad]{The simplifier Monad}
-
-\begin{code}
-module SimplMonad (
-	-- The monad
-	SimplM,
-	initSmpl, returnSmpl, thenSmpl, thenSmpl_,
-	mapSmpl, mapAndUnzipSmpl, mapAccumLSmpl,
-	getDOptsSmpl,
-
-        -- Unique supply
-        getUniqueSmpl, getUniquesSmpl, getUniqSupplySmpl, newId,
-
-	-- Counting
-	SimplCount, Tick(..),
-	tick, freeTick,
-	getSimplCount, zeroSimplCount, pprSimplCount, 
-	plusSimplCount, isZeroSimplCount,
-
-	-- Switch checker
-	SwitchChecker, SwitchResult(..), getSimplIntSwitch,
-	isAmongSimpl, intSwitchSet, switchIsOn
-    ) where
-
-#include "HsVersions.h"
-
-import Id		( Id, mkSysLocal )
-import Type             ( Type )
-import UniqSupply	( uniqsFromSupply, uniqFromSupply, splitUniqSupply,
-			  UniqSupply
-			)
-import DynFlags		( SimplifierSwitch(..), DynFlags, DynFlag(..), dopt )
-import StaticFlags	( opt_PprStyle_Debug, opt_HistorySize )
-import Unique		( Unique )
-import Maybes		( expectJust )
-import FiniteMap	( FiniteMap, emptyFM, isEmptyFM, lookupFM, addToFM, plusFM_C, fmToList )
-import FastString	( FastString )
-import Outputable
-import FastTypes
-
-import GLAEXTS		( indexArray# )
-
-#if __GLASGOW_HASKELL__ < 503
-import PrelArr  ( Array(..) )
-#else
-import GHC.Arr  ( Array(..) )
-#endif
-
-import Array		( array, (//) )
-
-infixr 0  `thenSmpl`, `thenSmpl_`
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Monad plumbing}
-%*									*
-%************************************************************************
-
-For the simplifier monad, we want to {\em thread} a unique supply and a counter.
-(Command-line switches move around through the explicitly-passed SimplEnv.)
-
-\begin{code}
-newtype SimplM result
-  =  SM  { unSM :: DynFlags		-- We thread the unique supply because
-		   -> UniqSupply	-- constantly splitting it is rather expensive
-		   -> SimplCount 
-		   -> (result, UniqSupply, SimplCount)}
-\end{code}
-
-\begin{code}
-initSmpl :: DynFlags
-	 -> UniqSupply		-- No init count; set to 0
-	 -> SimplM a
-	 -> (a, SimplCount)
-
-initSmpl dflags us m
-  = case unSM m dflags us (zeroSimplCount dflags) of 
-	(result, _, count) -> (result, count)
-
-
-{-# INLINE thenSmpl #-}
-{-# INLINE thenSmpl_ #-}
-{-# INLINE returnSmpl #-}
-
-instance Monad SimplM where
-   (>>)   = thenSmpl_
-   (>>=)  = thenSmpl
-   return = returnSmpl
-
-returnSmpl :: a -> SimplM a
-returnSmpl e = SM (\ dflags us sc -> (e, us, sc))
-
-thenSmpl  :: SimplM a -> (a -> SimplM b) -> SimplM b
-thenSmpl_ :: SimplM a -> SimplM b -> SimplM b
-
-thenSmpl m k 
-  = SM (\ dflags us0 sc0 ->
-	  case (unSM m dflags us0 sc0) of 
-		(m_result, us1, sc1) -> unSM (k m_result) dflags us1 sc1 )
-
-thenSmpl_ m k 
-  = SM (\dflags us0 sc0 ->
-	 case (unSM m dflags us0 sc0) of 
-		(_, us1, sc1) -> unSM k dflags us1 sc1)
-\end{code}
-
-
-\begin{code}
-mapSmpl	    	:: (a -> SimplM b) -> [a] -> SimplM [b]
-mapAndUnzipSmpl :: (a -> SimplM (b, c)) -> [a] -> SimplM ([b],[c])
-
-mapSmpl f [] = returnSmpl []
-mapSmpl f (x:xs)
-  = f x		    `thenSmpl` \ x'  ->
-    mapSmpl f xs    `thenSmpl` \ xs' ->
-    returnSmpl (x':xs')
-
-mapAndUnzipSmpl f [] = returnSmpl ([],[])
-mapAndUnzipSmpl f (x:xs)
-  = f x			    `thenSmpl` \ (r1,  r2)  ->
-    mapAndUnzipSmpl f xs    `thenSmpl` \ (rs1, rs2) ->
-    returnSmpl (r1:rs1, r2:rs2)
-
-mapAccumLSmpl :: (acc -> b -> SimplM (acc,c)) -> acc -> [b] -> SimplM (acc, [c])
-mapAccumLSmpl f acc []     = returnSmpl (acc, [])
-mapAccumLSmpl f acc (x:xs) = f acc x	`thenSmpl` \ (acc', x') ->
-			     mapAccumLSmpl f acc' xs	`thenSmpl` \ (acc'', xs') ->
-			     returnSmpl (acc'', x':xs')
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The unique supply}
-%*									*
-%************************************************************************
-
-\begin{code}
-getUniqSupplySmpl :: SimplM UniqSupply
-getUniqSupplySmpl 
-   = SM (\dflags us sc -> case splitUniqSupply us of
-			        (us1, us2) -> (us1, us2, sc))
-
-getUniqueSmpl :: SimplM Unique
-getUniqueSmpl 
-   = SM (\dflags us sc -> case splitUniqSupply us of
-			        (us1, us2) -> (uniqFromSupply us1, us2, sc))
-
-getUniquesSmpl :: SimplM [Unique]
-getUniquesSmpl 
-   = SM (\dflags us sc -> case splitUniqSupply us of
-			        (us1, us2) -> (uniqsFromSupply us1, us2, sc))
-
-getDOptsSmpl :: SimplM DynFlags
-getDOptsSmpl 
-   = SM (\dflags us sc -> (dflags, us, sc))
-
-newId :: FastString -> Type -> SimplM Id
-newId fs ty = getUniqueSmpl 	`thenSmpl` \ uniq ->
-	      returnSmpl (mkSysLocal fs uniq ty)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Counting up what we've done}
-%*									*
-%************************************************************************
-
-\begin{code}
-getSimplCount :: SimplM SimplCount
-getSimplCount = SM (\dflags us sc -> (sc, us, sc))
-
-tick :: Tick -> SimplM ()
-tick t 
-   = SM (\dflags us sc -> let sc' = doTick t sc 
-			  in sc' `seq` ((), us, sc'))
-
-freeTick :: Tick -> SimplM ()
--- Record a tick, but don't add to the total tick count, which is
--- used to decide when nothing further has happened
-freeTick t 
-   = SM (\dflags us sc -> let sc' = doFreeTick t sc
-			  in sc' `seq` ((), us, sc'))
-\end{code}
-
-\begin{code}
-verboseSimplStats = opt_PprStyle_Debug		-- For now, anyway
-
-zeroSimplCount	   :: DynFlags -> SimplCount
-isZeroSimplCount   :: SimplCount -> Bool
-pprSimplCount	   :: SimplCount -> SDoc
-doTick, doFreeTick :: Tick -> SimplCount -> SimplCount
-plusSimplCount     :: SimplCount -> SimplCount -> SimplCount
-\end{code}
-
-\begin{code}
-data SimplCount = VerySimplZero		-- These two are used when 
-		| VerySimplNonZero	-- we are only interested in 
-					-- termination info
-
-		| SimplCount	{
-			ticks   :: !Int,		-- Total ticks
-			details :: !TickCounts,		-- How many of each type
-			n_log	:: !Int,		-- N
-			log1	:: [Tick],		-- Last N events; <= opt_HistorySize
-			log2	:: [Tick]		-- Last opt_HistorySize events before that
-		  }
-
-type TickCounts = FiniteMap Tick Int
-
-zeroSimplCount dflags
-		-- This is where we decide whether to do
-		-- the VerySimpl version or the full-stats version
-  | dopt Opt_D_dump_simpl_stats dflags
-  = SimplCount {ticks = 0, details = emptyFM,
-                n_log = 0, log1 = [], log2 = []}
-  | otherwise
-  = VerySimplZero
-
-isZeroSimplCount VerySimplZero    	    = True
-isZeroSimplCount (SimplCount { ticks = 0 }) = True
-isZeroSimplCount other			    = False
-
-doFreeTick tick sc@SimplCount { details = dts } 
-  = dts' `seqFM` sc { details = dts' }
-  where
-    dts' = dts `addTick` tick 
-doFreeTick tick sc = sc 
-
--- Gross hack to persuade GHC 3.03 to do this important seq
-seqFM fm x | isEmptyFM fm = x
-	   | otherwise    = x
-
-doTick tick sc@SimplCount { ticks = tks, details = dts, n_log = nl, log1 = l1, log2 = l2 }
-  | nl >= opt_HistorySize = sc1 { n_log = 1, log1 = [tick], log2 = l1 }
-  | otherwise		  = sc1 { n_log = nl+1, log1 = tick : l1 }
-  where
-    sc1 = sc { ticks = tks+1, details = dts `addTick` tick }
-
-doTick tick sc = VerySimplNonZero	-- The very simple case
-
-
--- Don't use plusFM_C because that's lazy, and we want to 
--- be pretty strict here!
-addTick :: TickCounts -> Tick -> TickCounts
-addTick fm tick = case lookupFM fm tick of
-			Nothing -> addToFM fm tick 1
-			Just n  -> n1 `seq` addToFM fm tick n1
-				where
-				   n1 = n+1
-
-
-plusSimplCount sc1@(SimplCount { ticks = tks1, details = dts1 })
-	       sc2@(SimplCount { ticks = tks2, details = dts2 })
-  = log_base { ticks = tks1 + tks2, details = plusFM_C (+) dts1 dts2 }
-  where
-	-- A hackish way of getting recent log info
-    log_base | null (log1 sc2) = sc1	-- Nothing at all in sc2
-	     | null (log2 sc2) = sc2 { log2 = log1 sc1 }
-	     | otherwise       = sc2
-
-plusSimplCount VerySimplZero VerySimplZero = VerySimplZero
-plusSimplCount sc1	     sc2	   = VerySimplNonZero
-
-pprSimplCount VerySimplZero    = ptext SLIT("Total ticks: ZERO!")
-pprSimplCount VerySimplNonZero = ptext SLIT("Total ticks: NON-ZERO!")
-pprSimplCount (SimplCount { ticks = tks, details = dts, log1 = l1, log2 = l2 })
-  = vcat [ptext SLIT("Total ticks:    ") <+> int tks,
-	  text "",
-	  pprTickCounts (fmToList dts),
-	  if verboseSimplStats then
-		vcat [text "",
-		      ptext SLIT("Log (most recent first)"),
-		      nest 4 (vcat (map ppr l1) $$ vcat (map ppr l2))]
-	  else empty
-    ]
-
-pprTickCounts :: [(Tick,Int)] -> SDoc
-pprTickCounts [] = empty
-pprTickCounts ((tick1,n1):ticks)
-  = vcat [int tot_n <+> text (tickString tick1),
-	  pprTCDetails real_these,
-	  pprTickCounts others
-    ]
-  where
-    tick1_tag		= tickToTag tick1
-    (these, others)	= span same_tick ticks
-    real_these		= (tick1,n1):these
-    same_tick (tick2,_) = tickToTag tick2 == tick1_tag
-    tot_n		= sum [n | (_,n) <- real_these]
-
-pprTCDetails ticks@((tick,_):_)
-  | verboseSimplStats || isRuleFired tick
-  = nest 4 (vcat [int n <+> pprTickCts tick | (tick,n) <- ticks])
-  | otherwise
-  = empty
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Ticks}
-%*									*
-%************************************************************************
-
-\begin{code}
-data Tick
-  = PreInlineUnconditionally	Id
-  | PostInlineUnconditionally	Id
-
-  | UnfoldingDone    		Id
-  | RuleFired			FastString	-- Rule name
-
-  | LetFloatFromLet
-  | EtaExpansion		Id	-- LHS binder
-  | EtaReduction		Id	-- Binder on outer lambda
-  | BetaReduction		Id	-- Lambda binder
-
-
-  | CaseOfCase			Id	-- Bndr on *inner* case
-  | KnownBranch			Id	-- Case binder
-  | CaseMerge			Id	-- Binder on outer case
-  | AltMerge			Id	-- Case binder
-  | CaseElim			Id	-- Case binder
-  | CaseIdentity		Id	-- Case binder
-  | FillInCaseDefault		Id	-- Case binder
-
-  | BottomFound		
-  | SimplifierDone		-- Ticked at each iteration of the simplifier
-
-isRuleFired (RuleFired _) = True
-isRuleFired other	  = False
-
-instance Outputable Tick where
-  ppr tick = text (tickString tick) <+> pprTickCts tick
-
-instance Eq Tick where
-  a == b = case a `cmpTick` b of { EQ -> True; other -> False }
-
-instance Ord Tick where
-  compare = cmpTick
-
-tickToTag :: Tick -> Int
-tickToTag (PreInlineUnconditionally _)	= 0
-tickToTag (PostInlineUnconditionally _)	= 1
-tickToTag (UnfoldingDone _)		= 2
-tickToTag (RuleFired _)			= 3
-tickToTag LetFloatFromLet		= 4
-tickToTag (EtaExpansion _)		= 5
-tickToTag (EtaReduction _)		= 6
-tickToTag (BetaReduction _)		= 7
-tickToTag (CaseOfCase _)		= 8
-tickToTag (KnownBranch _)		= 9
-tickToTag (CaseMerge _)			= 10
-tickToTag (CaseElim _)			= 11
-tickToTag (CaseIdentity _)		= 12
-tickToTag (FillInCaseDefault _)		= 13
-tickToTag BottomFound			= 14
-tickToTag SimplifierDone		= 16
-tickToTag (AltMerge _)			= 17
-
-tickString :: Tick -> String
-tickString (PreInlineUnconditionally _)	= "PreInlineUnconditionally"
-tickString (PostInlineUnconditionally _)= "PostInlineUnconditionally"
-tickString (UnfoldingDone _)		= "UnfoldingDone"
-tickString (RuleFired _)		= "RuleFired"
-tickString LetFloatFromLet		= "LetFloatFromLet"
-tickString (EtaExpansion _)		= "EtaExpansion"
-tickString (EtaReduction _)		= "EtaReduction"
-tickString (BetaReduction _)		= "BetaReduction"
-tickString (CaseOfCase _)		= "CaseOfCase"
-tickString (KnownBranch _)		= "KnownBranch"
-tickString (CaseMerge _)		= "CaseMerge"
-tickString (AltMerge _)			= "AltMerge"
-tickString (CaseElim _)			= "CaseElim"
-tickString (CaseIdentity _)		= "CaseIdentity"
-tickString (FillInCaseDefault _)	= "FillInCaseDefault"
-tickString BottomFound			= "BottomFound"
-tickString SimplifierDone		= "SimplifierDone"
-
-pprTickCts :: Tick -> SDoc
-pprTickCts (PreInlineUnconditionally v)	= ppr v
-pprTickCts (PostInlineUnconditionally v)= ppr v
-pprTickCts (UnfoldingDone v)		= ppr v
-pprTickCts (RuleFired v)		= ppr v
-pprTickCts LetFloatFromLet		= empty
-pprTickCts (EtaExpansion v)		= ppr v
-pprTickCts (EtaReduction v)		= ppr v
-pprTickCts (BetaReduction v)		= ppr v
-pprTickCts (CaseOfCase v)		= ppr v
-pprTickCts (KnownBranch v)		= ppr v
-pprTickCts (CaseMerge v)		= ppr v
-pprTickCts (AltMerge v)			= ppr v
-pprTickCts (CaseElim v)			= ppr v
-pprTickCts (CaseIdentity v)		= ppr v
-pprTickCts (FillInCaseDefault v)	= ppr v
-pprTickCts other			= empty
-
-cmpTick :: Tick -> Tick -> Ordering
-cmpTick a b = case (tickToTag a `compare` tickToTag b) of
-		GT -> GT
-		EQ | isRuleFired a || verboseSimplStats -> cmpEqTick a b
-		   | otherwise				-> EQ
-		LT -> LT
-	-- Always distinguish RuleFired, so that the stats
-	-- can report them even in non-verbose mode
-
-cmpEqTick :: Tick -> Tick -> Ordering
-cmpEqTick (PreInlineUnconditionally a)	(PreInlineUnconditionally b)	= a `compare` b
-cmpEqTick (PostInlineUnconditionally a)	(PostInlineUnconditionally b)	= a `compare` b
-cmpEqTick (UnfoldingDone a)		(UnfoldingDone b)		= a `compare` b
-cmpEqTick (RuleFired a)			(RuleFired b)			= a `compare` b
-cmpEqTick (EtaExpansion a)		(EtaExpansion b)		= a `compare` b
-cmpEqTick (EtaReduction a)		(EtaReduction b)		= a `compare` b
-cmpEqTick (BetaReduction a)		(BetaReduction b)		= a `compare` b
-cmpEqTick (CaseOfCase a)		(CaseOfCase b)			= a `compare` b
-cmpEqTick (KnownBranch a)		(KnownBranch b)			= a `compare` b
-cmpEqTick (CaseMerge a)			(CaseMerge b)			= a `compare` b
-cmpEqTick (AltMerge a)			(AltMerge b)			= a `compare` b
-cmpEqTick (CaseElim a)			(CaseElim b)			= a `compare` b
-cmpEqTick (CaseIdentity a)		(CaseIdentity b)		= a `compare` b
-cmpEqTick (FillInCaseDefault a)		(FillInCaseDefault b)		= a `compare` b
-cmpEqTick other1			other2				= EQ
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{Command-line switches}
-%*									*
-%************************************************************************
-
-\begin{code}
-type SwitchChecker = SimplifierSwitch -> SwitchResult
-
-data SwitchResult
-  = SwBool	Bool		-- on/off
-  | SwString	FastString	-- nothing or a String
-  | SwInt	Int		-- nothing or an Int
-
-isAmongSimpl :: [SimplifierSwitch] -> SimplifierSwitch -> SwitchResult
-isAmongSimpl on_switches		-- Switches mentioned later occur *earlier*
-					-- in the list; defaults right at the end.
-  = let
-	tidied_on_switches = foldl rm_dups [] on_switches
-		-- The fold*l* ensures that we keep the latest switches;
-		-- ie the ones that occur earliest in the list.
-
-	sw_tbl :: Array Int SwitchResult
-	sw_tbl = (array	(0, lAST_SIMPL_SWITCH_TAG) -- bounds...
-			all_undefined)
-		 // defined_elems
-
-	all_undefined = [ (i, SwBool False) | i <- [0 .. lAST_SIMPL_SWITCH_TAG ] ]
-
-	defined_elems = map mk_assoc_elem tidied_on_switches
-    in
-    -- (avoid some unboxing, bounds checking, and other horrible things:)
-    case sw_tbl of { Array _ _ stuff ->
-    \ switch ->
-	case (indexArray# stuff (tagOf_SimplSwitch switch)) of
-	  (# v #) -> v
-    }
-  where
-    mk_assoc_elem k@(MaxSimplifierIterations lvl)
-	= (iBox (tagOf_SimplSwitch k), SwInt lvl)
-    mk_assoc_elem k
-	= (iBox (tagOf_SimplSwitch k), SwBool True) -- I'm here, Mom!
-
-    -- cannot have duplicates if we are going to use the array thing
-    rm_dups switches_so_far switch
-      = if switch `is_elem` switches_so_far
-    	then switches_so_far
-	else switch : switches_so_far
-      where
-	sw `is_elem` []     = False
-	sw `is_elem` (s:ss) = (tagOf_SimplSwitch sw) ==# (tagOf_SimplSwitch s)
-			    || sw `is_elem` ss
-\end{code}
-
-\begin{code}
-getSimplIntSwitch :: SwitchChecker -> (Int-> SimplifierSwitch) -> Int
-getSimplIntSwitch chkr switch
-  = expectJust "getSimplIntSwitch" (intSwitchSet chkr switch)
-
-switchIsOn :: (switch -> SwitchResult) -> switch -> Bool
-
-switchIsOn lookup_fn switch
-  = case (lookup_fn switch) of
-      SwBool False -> False
-      _	    	   -> True
-
-intSwitchSet :: (switch -> SwitchResult)
-	     -> (Int -> switch)
-	     -> Maybe Int
-
-intSwitchSet lookup_fn switch
-  = case (lookup_fn (switch (panic "intSwitchSet"))) of
-      SwInt int -> Just int
-      _	    	-> Nothing
-\end{code}
-
-
-These things behave just like enumeration types.
-
-\begin{code}
-instance Eq SimplifierSwitch where
-    a == b = tagOf_SimplSwitch a ==# tagOf_SimplSwitch b
-
-instance Ord SimplifierSwitch where
-    a <  b  = tagOf_SimplSwitch a <# tagOf_SimplSwitch b
-    a <= b  = tagOf_SimplSwitch a <=# tagOf_SimplSwitch b
-
-
-tagOf_SimplSwitch (MaxSimplifierIterations _)	= _ILIT(1)
-tagOf_SimplSwitch NoCaseOfCase			= _ILIT(2)
-
--- If you add anything here, be sure to change lAST_SIMPL_SWITCH_TAG, too!
-
-lAST_SIMPL_SWITCH_TAG = 2
-\end{code}
-
diff --git a/ghc/compiler/simplCore/SimplUtils.lhs b/ghc/compiler/simplCore/SimplUtils.lhs
deleted file mode 100644
index 9e616b5df1..0000000000
--- a/ghc/compiler/simplCore/SimplUtils.lhs
+++ /dev/null
@@ -1,1592 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1993-1998
-%
-\section[SimplUtils]{The simplifier utilities}
-
-\begin{code}
-module SimplUtils (
-	mkLam, prepareAlts, mkCase,
-
-	-- Inlining,
-	preInlineUnconditionally, postInlineUnconditionally, activeInline, activeRule,
-	inlineMode,
-
-	-- The continuation type
-	SimplCont(..), DupFlag(..), LetRhsFlag(..), 
-	contIsDupable, contResultType,
-	countValArgs, countArgs, pushContArgs,
-	mkBoringStop, mkRhsStop, contIsRhs, contIsRhsOrArg,
-	getContArgs, interestingCallContext, interestingArg, isStrictType
-
-    ) where
-
-#include "HsVersions.h"
-
-import SimplEnv
-import DynFlags		( SimplifierSwitch(..), SimplifierMode(..),
-			  DynFlag(..), dopt )
-import StaticFlags	( opt_UF_UpdateInPlace, opt_SimplNoPreInlining,
-			  opt_RulesOff )
-import CoreSyn
-import CoreFVs		( exprFreeVars )
-import CoreUtils	( cheapEqExpr, exprType, exprIsTrivial, exprIsCheap,
-			  etaExpand, exprEtaExpandArity, bindNonRec, mkCoerce2,
-			  findDefault, exprOkForSpeculation, exprIsHNF
-			)
-import Literal		( mkStringLit )
-import CoreUnfold	( smallEnoughToInline )
-import MkId		( eRROR_ID )
-import Id		( idType, isDataConWorkId, idOccInfo, isDictId, 
-			  mkSysLocal, isDeadBinder, idNewDemandInfo, isExportedId,
-			  idUnfolding, idNewStrictness, idInlinePragma,
-			)
-import NewDemand	( isStrictDmd, isBotRes, splitStrictSig )
-import SimplMonad
-import Type		( Type, splitFunTys, dropForAlls, isStrictType,
-			  splitTyConApp_maybe, tyConAppArgs, mkTyVarTys
-			)
-import Name		( mkSysTvName )
-import TyCon		( tyConDataCons_maybe, isAlgTyCon, isNewTyCon )
-import DataCon		( dataConRepArity, dataConTyVars, dataConInstArgTys, isVanillaDataCon )
-import Var		( tyVarKind, mkTyVar )
-import VarSet
-import BasicTypes	( TopLevelFlag(..), isNotTopLevel, OccInfo(..), isLoopBreaker, isOneOcc,
-			  Activation, isAlwaysActive, isActive )
-import Util		( lengthExceeds )
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The continuation data type}
-%*									*
-%************************************************************************
-
-\begin{code}
-data SimplCont		-- Strict contexts
-  = Stop     OutType		-- Type of the result
-	     LetRhsFlag
-	     Bool		-- True <=> This is the RHS of a thunk whose type suggests
-				--	    that update-in-place would be possible
-				--	    (This makes the inliner a little keener.)
-
-  | CoerceIt OutType			-- The To-type, simplified
-	     SimplCont
-
-  | InlinePlease			-- This continuation makes a function very
-	     SimplCont			-- keen to inline itelf
-
-  | ApplyTo  DupFlag 
-	     InExpr SimplEnv		-- The argument, as yet unsimplified, 
-	     SimplCont			-- and its environment
-
-  | Select   DupFlag 
-	     InId [InAlt] SimplEnv	-- The case binder, alts, and subst-env
-	     SimplCont
-
-  | ArgOf    LetRhsFlag		-- An arbitrary strict context: the argument 
-  	     			-- 	of a strict function, or a primitive-arg fn
-				-- 	or a PrimOp
-				-- No DupFlag because we never duplicate it
-	     OutType		-- arg_ty: type of the argument itself
-	     OutType		-- cont_ty: the type of the expression being sought by the context
-				--	f (error "foo") ==> coerce t (error "foo")
-				-- when f is strict
-				-- We need to know the type t, to which to coerce.
-
-	     (SimplEnv -> OutExpr -> SimplM FloatsWithExpr)	-- What to do with the result
-				-- The result expression in the OutExprStuff has type cont_ty
-
-data LetRhsFlag = AnArg		-- It's just an argument not a let RHS
-		| AnRhs 	-- It's the RHS of a let (so please float lets out of big lambdas)
-
-instance Outputable LetRhsFlag where
-  ppr AnArg = ptext SLIT("arg")
-  ppr AnRhs = ptext SLIT("rhs")
-
-instance Outputable SimplCont where
-  ppr (Stop ty is_rhs _)  	     = ptext SLIT("Stop") <> brackets (ppr is_rhs) <+> ppr ty
-  ppr (ApplyTo dup arg se cont)      = (ptext SLIT("ApplyTo") <+> ppr dup <+> ppr arg) $$ ppr cont
-  ppr (ArgOf _ _ _ _)   	     = ptext SLIT("ArgOf...")
-  ppr (Select dup bndr alts se cont) = (ptext SLIT("Select") <+> ppr dup <+> ppr bndr) $$ 
-				       (nest 4 (ppr alts)) $$ ppr cont
-  ppr (CoerceIt ty cont)	     = (ptext SLIT("CoerceIt") <+> ppr ty) $$ ppr cont
-  ppr (InlinePlease cont)	     = ptext SLIT("InlinePlease") $$ ppr cont
-
-data DupFlag = OkToDup | NoDup
-
-instance Outputable DupFlag where
-  ppr OkToDup = ptext SLIT("ok")
-  ppr NoDup   = ptext SLIT("nodup")
-
-
--------------------
-mkBoringStop, mkRhsStop :: OutType -> SimplCont
-mkBoringStop ty = Stop ty AnArg (canUpdateInPlace ty)
-mkRhsStop    ty = Stop ty AnRhs (canUpdateInPlace ty)
-
-contIsRhs :: SimplCont -> Bool
-contIsRhs (Stop _ AnRhs _)    = True
-contIsRhs (ArgOf AnRhs _ _ _) = True
-contIsRhs other	              = False
-
-contIsRhsOrArg (Stop _ _ _)    = True
-contIsRhsOrArg (ArgOf _ _ _ _) = True
-contIsRhsOrArg other	       = False
-
--------------------
-contIsDupable :: SimplCont -> Bool
-contIsDupable (Stop _ _ _)     		 = True
-contIsDupable (ApplyTo  OkToDup _ _ _)   = True
-contIsDupable (Select   OkToDup _ _ _ _) = True
-contIsDupable (CoerceIt _ cont)          = contIsDupable cont
-contIsDupable (InlinePlease cont)        = contIsDupable cont
-contIsDupable other	  	         = False
-
--------------------
-discardableCont :: SimplCont -> Bool
-discardableCont (Stop _ _ _)	    = False
-discardableCont (CoerceIt _ cont)   = discardableCont cont
-discardableCont (InlinePlease cont) = discardableCont cont
-discardableCont other		    = True
-
-discardCont :: SimplCont	-- A continuation, expecting
-	    -> SimplCont	-- Replace the continuation with a suitable coerce
-discardCont cont = case cont of
-		     Stop to_ty is_rhs _ -> cont
-		     other               -> CoerceIt to_ty (mkBoringStop to_ty)
-		 where
-		   to_ty = contResultType cont
-
--------------------
-contResultType :: SimplCont -> OutType
-contResultType (Stop to_ty _ _)	     = to_ty
-contResultType (ArgOf _ _ to_ty _)   = to_ty
-contResultType (ApplyTo _ _ _ cont)  = contResultType cont
-contResultType (CoerceIt _ cont)     = contResultType cont
-contResultType (InlinePlease cont)   = contResultType cont
-contResultType (Select _ _ _ _ cont) = contResultType cont
-
--------------------
-countValArgs :: SimplCont -> Int
-countValArgs (ApplyTo _ (Type ty) se cont) = countValArgs cont
-countValArgs (ApplyTo _ val_arg   se cont) = 1 + countValArgs cont
-countValArgs other			   = 0
-
-countArgs :: SimplCont -> Int
-countArgs (ApplyTo _ arg se cont) = 1 + countArgs cont
-countArgs other			  = 0
-
--------------------
-pushContArgs :: SimplEnv -> [OutArg] -> SimplCont -> SimplCont
--- Pushes args with the specified environment
-pushContArgs env []           cont = cont
-pushContArgs env (arg : args) cont = ApplyTo NoDup arg env (pushContArgs env args cont)
-\end{code}
-
-
-\begin{code}
-getContArgs :: SwitchChecker
-	    -> OutId -> SimplCont 
-	    -> ([(InExpr, SimplEnv, Bool)],	-- Arguments; the Bool is true for strict args
-		SimplCont,			-- Remaining continuation
-		Bool)				-- Whether we came across an InlineCall
--- getContArgs id k = (args, k', inl)
--- 	args are the leading ApplyTo items in k
---	(i.e. outermost comes first)
---	augmented with demand info from the functionn
-getContArgs chkr fun orig_cont
-  = let
-		-- Ignore strictness info if the no-case-of-case
-		-- flag is on.  Strictness changes evaluation order
-		-- and that can change full laziness
-	stricts | switchIsOn chkr NoCaseOfCase = vanilla_stricts
-		| otherwise		       = computed_stricts
-    in
-    go [] stricts False orig_cont
-  where
-    ----------------------------
-
-	-- Type argument
-    go acc ss inl (ApplyTo _ arg@(Type _) se cont)
-	= go ((arg,se,False) : acc) ss inl cont
-		-- NB: don't bother to instantiate the function type
-
-	-- Value argument
-    go acc (s:ss) inl (ApplyTo _ arg se cont)
-	= go ((arg,se,s) : acc) ss inl cont
-
-	-- An Inline continuation
-    go acc ss inl (InlinePlease cont)
-	= go acc ss True cont
-
-	-- We're run out of arguments, or else we've run out of demands
-	-- The latter only happens if the result is guaranteed bottom
-	-- This is the case for
-	--	* case (error "hello") of { ... }
-	--	* (error "Hello") arg
-	--	* f (error "Hello") where f is strict
-	--	etc
-	-- Then, especially in the first of these cases, we'd like to discard
-	-- the continuation, leaving just the bottoming expression.  But the
-	-- type might not be right, so we may have to add a coerce.
-    go acc ss inl cont 
-	| null ss && discardableCont cont = (reverse acc, discardCont cont, inl)
-	| otherwise			  = (reverse acc, cont, 	    inl)
-
-    ----------------------------
-    vanilla_stricts, computed_stricts :: [Bool]
-    vanilla_stricts  = repeat False
-    computed_stricts = zipWith (||) fun_stricts arg_stricts
-
-    ----------------------------
-    (val_arg_tys, _) = splitFunTys (dropForAlls (idType fun))
-    arg_stricts      = map isStrictType val_arg_tys ++ repeat False
-	-- These argument types are used as a cheap and cheerful way to find
-	-- unboxed arguments, which must be strict.  But it's an InType
-	-- and so there might be a type variable where we expect a function
-	-- type (the substitution hasn't happened yet).  And we don't bother
-	-- doing the type applications for a polymorphic function.
-	-- Hence the splitFunTys*IgnoringForAlls*
-
-    ----------------------------
-	-- If fun_stricts is finite, it means the function returns bottom
-	-- after that number of value args have been consumed
-	-- Otherwise it's infinite, extended with False
-    fun_stricts
-      = case splitStrictSig (idNewStrictness fun) of
-	  (demands, result_info)
-		| not (demands `lengthExceeds` countValArgs orig_cont)
-		-> 	-- Enough args, use the strictness given.
-			-- For bottoming functions we used to pretend that the arg
-			-- is lazy, so that we don't treat the arg as an
-			-- interesting context.  This avoids substituting
-			-- top-level bindings for (say) strings into 
-			-- calls to error.  But now we are more careful about
-			-- inlining lone variables, so its ok (see SimplUtils.analyseCont)
-		   if isBotRes result_info then
-			map isStrictDmd demands		-- Finite => result is bottom
-		   else
-			map isStrictDmd demands ++ vanilla_stricts
-
-	  other -> vanilla_stricts	-- Not enough args, or no strictness
-
--------------------
-interestingArg :: OutExpr -> Bool
-	-- An argument is interesting if it has *some* structure
-	-- We are here trying to avoid unfolding a function that
-	-- is applied only to variables that have no unfolding
-	-- (i.e. they are probably lambda bound): f x y z
-	-- There is little point in inlining f here.
-interestingArg (Var v)	         = hasSomeUnfolding (idUnfolding v)
-					-- Was: isValueUnfolding (idUnfolding v')
-					-- But that seems over-pessimistic
-				 || isDataConWorkId v
-					-- This accounts for an argument like
-					-- () or [], which is definitely interesting
-interestingArg (Type _)	         = False
-interestingArg (App fn (Type _)) = interestingArg fn
-interestingArg (Note _ a)	 = interestingArg a
-interestingArg other	         = True
-	-- Consider 	let x = 3 in f x
-	-- The substitution will contain (x -> ContEx 3), and we want to
-	-- to say that x is an interesting argument.
-	-- But consider also (\x. f x y) y
-	-- The substitution will contain (x -> ContEx y), and we want to say
-	-- that x is not interesting (assuming y has no unfolding)
-\end{code}
-
-Comment about interestingCallContext
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We want to avoid inlining an expression where there can't possibly be
-any gain, such as in an argument position.  Hence, if the continuation
-is interesting (eg. a case scrutinee, application etc.) then we
-inline, otherwise we don't.  
-
-Previously some_benefit used to return True only if the variable was
-applied to some value arguments.  This didn't work:
-
-	let x = _coerce_ (T Int) Int (I# 3) in
-	case _coerce_ Int (T Int) x of
-		I# y -> ....
-
-we want to inline x, but can't see that it's a constructor in a case
-scrutinee position, and some_benefit is False.
-
-Another example:
-
-dMonadST = _/\_ t -> :Monad (g1 _@_ t, g2 _@_ t, g3 _@_ t)
-
-....  case dMonadST _@_ x0 of (a,b,c) -> ....
-
-we'd really like to inline dMonadST here, but we *don't* want to
-inline if the case expression is just
-
-	case x of y { DEFAULT -> ... }
-
-since we can just eliminate this case instead (x is in WHNF).  Similar
-applies when x is bound to a lambda expression.  Hence
-contIsInteresting looks for case expressions with just a single
-default case.
-
-\begin{code}
-interestingCallContext :: Bool 		-- False <=> no args at all
-		       -> Bool		-- False <=> no value args
-		       -> SimplCont -> Bool
-	-- The "lone-variable" case is important.  I spent ages
-	-- messing about with unsatisfactory varaints, but this is nice.
-	-- The idea is that if a variable appear all alone
-	--	as an arg of lazy fn, or rhs	Stop
-	-- 	as scrutinee of a case		Select
-	--	as arg of a strict fn		ArgOf
-	-- then we should not inline it (unless there is some other reason,
-	-- e.g. is is the sole occurrence).  We achieve this by making
-	-- interestingCallContext return False for a lone variable.
-	--
-	-- Why?  At least in the case-scrutinee situation, turning
-	--	let x = (a,b) in case x of y -> ...
-	-- into
-	--	let x = (a,b) in case (a,b) of y -> ...
-	-- and thence to 
-	--	let x = (a,b) in let y = (a,b) in ...
-	-- is bad if the binding for x will remain.
-	--
-	-- Another example: I discovered that strings
-	-- were getting inlined straight back into applications of 'error'
-	-- because the latter is strict.
-	--	s = "foo"
-	--	f = \x -> ...(error s)...
-
-	-- Fundamentally such contexts should not ecourage inlining because
-	-- the context can ``see'' the unfolding of the variable (e.g. case or a RULE)
-	-- so there's no gain.
-	--
-	-- However, even a type application or coercion isn't a lone variable.
-	-- Consider
-	--	case $fMonadST @ RealWorld of { :DMonad a b c -> c }
-	-- We had better inline that sucker!  The case won't see through it.
-	--
-	-- For now, I'm treating treating a variable applied to types 
-	-- in a *lazy* context "lone". The motivating example was
-	--	f = /\a. \x. BIG
-	--	g = /\a. \y.  h (f a)
-	-- There's no advantage in inlining f here, and perhaps
-	-- a significant disadvantage.  Hence some_val_args in the Stop case
-
-interestingCallContext some_args some_val_args cont
-  = interesting cont
-  where
-    interesting (InlinePlease _)         = True
-    interesting (Select _ _ _ _ _)       = some_args
-    interesting (ApplyTo _ _ _ _)        = True	-- Can happen if we have (coerce t (f x)) y
-						-- Perhaps True is a bit over-keen, but I've
-						-- seen (coerce f) x, where f has an INLINE prag,
-						-- So we have to give some motivaiton for inlining it
-    interesting (ArgOf _ _ _ _)	         = some_val_args
-    interesting (Stop ty _ upd_in_place) = some_val_args && upd_in_place
-    interesting (CoerceIt _ cont)        = interesting cont
-	-- If this call is the arg of a strict function, the context
-	-- is a bit interesting.  If we inline here, we may get useful
-	-- evaluation information to avoid repeated evals: e.g.
-	--	x + (y * z)
-	-- Here the contIsInteresting makes the '*' keener to inline,
-	-- which in turn exposes a constructor which makes the '+' inline.
-	-- Assuming that +,* aren't small enough to inline regardless.
-	--
-	-- It's also very important to inline in a strict context for things
-	-- like
-	--		foldr k z (f x)
-	-- Here, the context of (f x) is strict, and if f's unfolding is
-	-- a build it's *great* to inline it here.  So we must ensure that
-	-- the context for (f x) is not totally uninteresting.
-
-
--------------------
-canUpdateInPlace :: Type -> Bool
--- Consider   let x = <wurble> in ...
--- If <wurble> returns an explicit constructor, we might be able
--- to do update in place.  So we treat even a thunk RHS context
--- as interesting if update in place is possible.  We approximate
--- this by seeing if the type has a single constructor with a
--- small arity.  But arity zero isn't good -- we share the single copy
--- for that case, so no point in sharing.
-
-canUpdateInPlace ty 
-  | not opt_UF_UpdateInPlace = False
-  | otherwise
-  = case splitTyConApp_maybe ty of 
-	Nothing		-> False 
-	Just (tycon, _) -> case tyConDataCons_maybe tycon of
-				Just [dc]  -> arity == 1 || arity == 2
-				           where
-					      arity = dataConRepArity dc
-				other -> False
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Decisions about inlining}
-%*									*
-%************************************************************************
-
-Inlining is controlled partly by the SimplifierMode switch.  This has two
-settings:
-
-	SimplGently	(a) Simplifying before specialiser/full laziness
-			(b) Simplifiying inside INLINE pragma
-			(c) Simplifying the LHS of a rule
-			(d) Simplifying a GHCi expression or Template 
-				Haskell splice
-
-	SimplPhase n	Used at all other times
-
-The key thing about SimplGently is that it does no call-site inlining.
-Before full laziness we must be careful not to inline wrappers,
-because doing so inhibits floating
-    e.g. ...(case f x of ...)...
-    ==> ...(case (case x of I# x# -> fw x#) of ...)...
-    ==> ...(case x of I# x# -> case fw x# of ...)...
-and now the redex (f x) isn't floatable any more.
-
-The no-inling thing is also important for Template Haskell.  You might be 
-compiling in one-shot mode with -O2; but when TH compiles a splice before
-running it, we don't want to use -O2.  Indeed, we don't want to inline
-anything, because the byte-code interpreter might get confused about 
-unboxed tuples and suchlike.
-
-INLINE pragmas
-~~~~~~~~~~~~~~
-SimplGently is also used as the mode to simplify inside an InlineMe note.
-
-\begin{code}
-inlineMode :: SimplifierMode
-inlineMode = SimplGently
-\end{code}
-
-It really is important to switch off inlinings inside such
-expressions.  Consider the following example 
-
-     	let f = \pq -> BIG
-     	in
-     	let g = \y -> f y y
-	    {-# INLINE g #-}
-     	in ...g...g...g...g...g...
-
-Now, if that's the ONLY occurrence of f, it will be inlined inside g,
-and thence copied multiple times when g is inlined.
-
-
-This function may be inlinined in other modules, so we
-don't want to remove (by inlining) calls to functions that have
-specialisations, or that may have transformation rules in an importing
-scope.
-
-E.g. 	{-# INLINE f #-}
-		f x = ...g...
-
-and suppose that g is strict *and* has specialisations.  If we inline
-g's wrapper, we deny f the chance of getting the specialised version
-of g when f is inlined at some call site (perhaps in some other
-module).
-
-It's also important not to inline a worker back into a wrapper.
-A wrapper looks like
-	wraper = inline_me (\x -> ...worker... )
-Normally, the inline_me prevents the worker getting inlined into
-the wrapper (initially, the worker's only call site!).  But,
-if the wrapper is sure to be called, the strictness analyser will
-mark it 'demanded', so when the RHS is simplified, it'll get an ArgOf
-continuation.  That's why the keep_inline predicate returns True for
-ArgOf continuations.  It shouldn't do any harm not to dissolve the
-inline-me note under these circumstances.
-
-Note that the result is that we do very little simplification
-inside an InlineMe.  
-
-	all xs = foldr (&&) True xs
-	any p = all . map p  {-# INLINE any #-}
-
-Problem: any won't get deforested, and so if it's exported and the
-importer doesn't use the inlining, (eg passes it as an arg) then we
-won't get deforestation at all.  We havn't solved this problem yet!
-
-
-preInlineUnconditionally
-~~~~~~~~~~~~~~~~~~~~~~~~
-@preInlineUnconditionally@ examines a bndr to see if it is used just
-once in a completely safe way, so that it is safe to discard the
-binding inline its RHS at the (unique) usage site, REGARDLESS of how
-big the RHS might be.  If this is the case we don't simplify the RHS
-first, but just inline it un-simplified.
-
-This is much better than first simplifying a perhaps-huge RHS and then
-inlining and re-simplifying it.  Indeed, it can be at least quadratically
-better.  Consider
-
-	x1 = e1
-	x2 = e2[x1]
-	x3 = e3[x2]
-	...etc...
-	xN = eN[xN-1]
-
-We may end up simplifying e1 N times, e2 N-1 times, e3 N-3 times etc.
-This can happen with cascades of functions too:
-
-	f1 = \x1.e1
-	f2 = \xs.e2[f1]
-	f3 = \xs.e3[f3]
-	...etc...
-
-THE MAIN INVARIANT is this:
-
-	----  preInlineUnconditionally invariant -----
-   IF preInlineUnconditionally chooses to inline x = <rhs>
-   THEN doing the inlining should not change the occurrence
-	info for the free vars of <rhs>
-	----------------------------------------------
-
-For example, it's tempting to look at trivial binding like
-	x = y
-and inline it unconditionally.  But suppose x is used many times,
-but this is the unique occurrence of y.  Then inlining x would change
-y's occurrence info, which breaks the invariant.  It matters: y
-might have a BIG rhs, which will now be dup'd at every occurrenc of x.
-
-
-Evne RHSs labelled InlineMe aren't caught here, because there might be
-no benefit from inlining at the call site.
-
-[Sept 01] Don't unconditionally inline a top-level thing, because that
-can simply make a static thing into something built dynamically.  E.g.
-	x = (a,b)
-	main = \s -> h x
-
-[Remember that we treat \s as a one-shot lambda.]  No point in
-inlining x unless there is something interesting about the call site.
-
-But watch out: if you aren't careful, some useful foldr/build fusion
-can be lost (most notably in spectral/hartel/parstof) because the
-foldr didn't see the build.  Doing the dynamic allocation isn't a big
-deal, in fact, but losing the fusion can be.  But the right thing here
-seems to be to do a callSiteInline based on the fact that there is
-something interesting about the call site (it's strict).  Hmm.  That
-seems a bit fragile.
-
-Conclusion: inline top level things gaily until Phase 0 (the last
-phase), at which point don't.
-
-\begin{code}
-preInlineUnconditionally :: SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool
-preInlineUnconditionally env top_lvl bndr rhs
-  | not active 		   = False
-  | opt_SimplNoPreInlining = False
-  | otherwise = case idOccInfo bndr of
-		  IAmDead	     	     -> True	-- Happens in ((\x.1) v)
-	  	  OneOcc in_lam True int_cxt -> try_once in_lam int_cxt
-		  other 		     -> False
-  where
-    phase = getMode env
-    active = case phase of
-		   SimplGently  -> isAlwaysActive prag
-		   SimplPhase n -> isActive n prag
-    prag = idInlinePragma bndr
-
-    try_once in_lam int_cxt	-- There's one textual occurrence
-	| not in_lam = isNotTopLevel top_lvl || early_phase
-	| otherwise  = int_cxt && canInlineInLam rhs
-
--- Be very careful before inlining inside a lambda, becuase (a) we must not 
--- invalidate occurrence information, and (b) we want to avoid pushing a
--- single allocation (here) into multiple allocations (inside lambda).  
--- Inlining a *function* with a single *saturated* call would be ok, mind you.
---	|| (if is_cheap && not (canInlineInLam rhs) then pprTrace "preinline" (ppr bndr <+> ppr rhs) ok else ok)
---	where 
---	 	is_cheap = exprIsCheap rhs
---		ok = is_cheap && int_cxt
-
-	-- 	int_cxt		The context isn't totally boring
-	-- E.g. let f = \ab.BIG in \y. map f xs
-	-- 	Don't want to substitute for f, because then we allocate
-	--	its closure every time the \y is called
-	-- But: let f = \ab.BIG in \y. map (f y) xs
-	--	Now we do want to substitute for f, even though it's not 
-	--	saturated, because we're going to allocate a closure for 
-	--	(f y) every time round the loop anyhow.
-
-	-- canInlineInLam => free vars of rhs are (Once in_lam) or Many,
-	-- so substituting rhs inside a lambda doesn't change the occ info.
-	-- Sadly, not quite the same as exprIsHNF.
-    canInlineInLam (Lit l)		= True
-    canInlineInLam (Lam b e)		= isRuntimeVar b || canInlineInLam e
-    canInlineInLam (Note _ e)		= canInlineInLam e
-    canInlineInLam _			= False
-
-    early_phase = case phase of
-			SimplPhase 0 -> False
-			other	     -> True
--- If we don't have this early_phase test, consider
---	x = length [1,2,3]
--- The full laziness pass carefully floats all the cons cells to
--- top level, and preInlineUnconditionally floats them all back in.
--- Result is (a) static allocation replaced by dynamic allocation
---	     (b) many simplifier iterations because this tickles
---		 a related problem; only one inlining per pass
--- 
--- On the other hand, I have seen cases where top-level fusion is
--- lost if we don't inline top level thing (e.g. string constants)
--- Hence the test for phase zero (which is the phase for all the final
--- simplifications).  Until phase zero we take no special notice of
--- top level things, but then we become more leery about inlining
--- them.  
-
-\end{code}
-
-postInlineUnconditionally
-~~~~~~~~~~~~~~~~~~~~~~~~~
-@postInlineUnconditionally@ decides whether to unconditionally inline
-a thing based on the form of its RHS; in particular if it has a
-trivial RHS.  If so, we can inline and discard the binding altogether.
-
-NB: a loop breaker has must_keep_binding = True and non-loop-breakers
-only have *forward* references Hence, it's safe to discard the binding
-	
-NOTE: This isn't our last opportunity to inline.  We're at the binding
-site right now, and we'll get another opportunity when we get to the
-ocurrence(s)
-
-Note that we do this unconditional inlining only for trival RHSs.
-Don't inline even WHNFs inside lambdas; doing so may simply increase
-allocation when the function is called. This isn't the last chance; see
-NOTE above.
-
-NB: Even inline pragmas (e.g. IMustBeINLINEd) are ignored here Why?
-Because we don't even want to inline them into the RHS of constructor
-arguments. See NOTE above
-
-NB: At one time even NOINLINE was ignored here: if the rhs is trivial
-it's best to inline it anyway.  We often get a=E; b=a from desugaring,
-with both a and b marked NOINLINE.  But that seems incompatible with
-our new view that inlining is like a RULE, so I'm sticking to the 'active'
-story for now.
-
-\begin{code}
-postInlineUnconditionally :: SimplEnv -> TopLevelFlag -> OutId -> OccInfo -> OutExpr -> Unfolding -> Bool
-postInlineUnconditionally env top_lvl bndr occ_info rhs unfolding
-  | not active		   = False
-  | isLoopBreaker occ_info = False
-  | isExportedId bndr      = False
-  | exprIsTrivial rhs 	   = True
-  | otherwise
-  = case occ_info of
-      OneOcc in_lam one_br int_cxt
-	->     (one_br || smallEnoughToInline unfolding)	-- Small enough to dup
-			-- ToDo: consider discount on smallEnoughToInline if int_cxt is true
-			--
-		 	-- NB: Do we want to inline arbitrarily big things becuase
-			-- one_br is True? that can lead to inline cascades.  But
-			-- preInlineUnconditionlly has dealt with all the common cases
-			-- so perhaps it's worth the risk. Here's an example
-			--	let f = if b then Left (\x.BIG) else Right (\y.BIG)
-			--	in \y. ....f....
-			-- We can't preInlineUnconditionally because that woud invalidate
-			-- the occ info for b.  Yet f is used just once, and duplicating
-			-- the case work is fine (exprIsCheap).
-
-	   &&  ((isNotTopLevel top_lvl && not in_lam) || 
-			-- But outside a lambda, we want to be reasonably aggressive
-			-- about inlining into multiple branches of case
-			-- e.g. let x = <non-value> 
-			--	in case y of { C1 -> ..x..; C2 -> ..x..; C3 -> ... } 
-			-- Inlining can be a big win if C3 is the hot-spot, even if
-			-- the uses in C1, C2 are not 'interesting'
-			-- An example that gets worse if you add int_cxt here is 'clausify'
-
-		(isCheapUnfolding unfolding && int_cxt))
-			-- isCheap => acceptable work duplication; in_lam may be true
-			-- int_cxt to prevent us inlining inside a lambda without some 
-			-- good reason.  See the notes on int_cxt in preInlineUnconditionally
-
-      other -> False
-	-- The point here is that for *non-values* that occur
-	-- outside a lambda, the call-site inliner won't have
-	-- a chance (becuase it doesn't know that the thing
-	-- only occurs once).   The pre-inliner won't have gotten
-	-- it either, if the thing occurs in more than one branch
-	-- So the main target is things like
-	--	let x = f y in
-	--	case v of
-	--	   True  -> case x of ...
-	--	   False -> case x of ...
-	-- I'm not sure how important this is in practice
-  where
-    active = case getMode env of
-		   SimplGently  -> isAlwaysActive prag
-		   SimplPhase n -> isActive n prag
-    prag = idInlinePragma bndr
-
-activeInline :: SimplEnv -> OutId -> OccInfo -> Bool
-activeInline env id occ
-  = case getMode env of
-      SimplGently -> isOneOcc occ && isAlwaysActive prag
-	-- No inlining at all when doing gentle stuff,
-	-- except for local things that occur once
-	-- The reason is that too little clean-up happens if you 
-	-- don't inline use-once things.   Also a bit of inlining is *good* for
-	-- full laziness; it can expose constant sub-expressions.
-	-- Example in spectral/mandel/Mandel.hs, where the mandelset 
-	-- function gets a useful let-float if you inline windowToViewport
-
-	-- NB: we used to have a second exception, for data con wrappers.
-	-- On the grounds that we use gentle mode for rule LHSs, and 
-	-- they match better when data con wrappers are inlined.
-	-- But that only really applies to the trivial wrappers (like (:)),
-	-- and they are now constructed as Compulsory unfoldings (in MkId)
-	-- so they'll happen anyway.
-
-      SimplPhase n -> isActive n prag
-  where
-    prag = idInlinePragma id
-
-activeRule :: SimplEnv -> Maybe (Activation -> Bool)
--- Nothing => No rules at all
-activeRule env
-  | opt_RulesOff = Nothing
-  | otherwise
-  = case getMode env of
-	SimplGently  -> Just isAlwaysActive
-			-- Used to be Nothing (no rules in gentle mode)
-			-- Main motivation for changing is that I wanted
-			-- 	lift String ===> ...
-			-- to work in Template Haskell when simplifying
-			-- splices, so we get simpler code for literal strings
-	SimplPhase n -> Just (isActive n)
-\end{code}	
-
-
-%************************************************************************
-%*									*
-\subsection{Rebuilding a lambda}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkLam :: SimplEnv -> [OutBinder] -> OutExpr -> SimplCont -> SimplM FloatsWithExpr
-\end{code}
-
-Try three things
-	a) eta reduction, if that gives a trivial expression
-	b) eta expansion [only if there are some value lambdas]
-	c) floating lets out through big lambdas 
-		[only if all tyvar lambdas, and only if this lambda
-		 is the RHS of a let]
-
-\begin{code}
-mkLam env bndrs body cont
- = getDOptsSmpl	 `thenSmpl` \dflags ->
-   mkLam' dflags env bndrs body cont
- where
- mkLam' dflags env bndrs body cont
-   | dopt Opt_DoEtaReduction dflags,
-     Just etad_lam <- tryEtaReduce bndrs body
-   = tick (EtaReduction (head bndrs)) 	`thenSmpl_`
-     returnSmpl (emptyFloats env, etad_lam)
-
-   | dopt Opt_DoLambdaEtaExpansion dflags,
-     any isRuntimeVar bndrs
-   = tryEtaExpansion body		`thenSmpl` \ body' ->
-     returnSmpl (emptyFloats env, mkLams bndrs body')
-
-{-	Sept 01: I'm experimenting with getting the
-	full laziness pass to float out past big lambdsa
- | all isTyVar bndrs,	-- Only for big lambdas
-   contIsRhs cont	-- Only try the rhs type-lambda floating
-			-- if this is indeed a right-hand side; otherwise
-			-- we end up floating the thing out, only for float-in
-			-- to float it right back in again!
- = tryRhsTyLam env bndrs body		`thenSmpl` \ (floats, body') ->
-   returnSmpl (floats, mkLams bndrs body')
--}
-
-   | otherwise 
-   = returnSmpl (emptyFloats env, mkLams bndrs body)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Eta expansion and reduction}
-%*									*
-%************************************************************************
-
-We try for eta reduction here, but *only* if we get all the 
-way to an exprIsTrivial expression.    
-We don't want to remove extra lambdas unless we are going 
-to avoid allocating this thing altogether
-
-\begin{code}
-tryEtaReduce :: [OutBinder] -> OutExpr -> Maybe OutExpr
-tryEtaReduce bndrs body 
-	-- We don't use CoreUtils.etaReduce, because we can be more
-	-- efficient here:
-	--  (a) we already have the binders
-	--  (b) we can do the triviality test before computing the free vars
-  = go (reverse bndrs) body
-  where
-    go (b : bs) (App fun arg) | ok_arg b arg = go bs fun	-- Loop round
-    go []       fun           | ok_fun fun   = Just fun		-- Success!
-    go _        _			     = Nothing		-- Failure!
-
-    ok_fun fun =  exprIsTrivial fun
-	       && not (any (`elemVarSet` (exprFreeVars fun)) bndrs)
-	       && (exprIsHNF fun || all ok_lam bndrs)
-    ok_lam v = isTyVar v || isDictId v
-	-- The exprIsHNF is because eta reduction is not 
-	-- valid in general:  \x. bot  /=  bot
-	-- So we need to be sure that the "fun" is a value.
-	--
-	-- However, we always want to reduce (/\a -> f a) to f
-	-- This came up in a RULE: foldr (build (/\a -> g a))
-	--	did not match 	   foldr (build (/\b -> ...something complex...))
-	-- The type checker can insert these eta-expanded versions,
-	-- with both type and dictionary lambdas; hence the slightly 
-	-- ad-hoc isDictTy
-
-    ok_arg b arg = varToCoreExpr b `cheapEqExpr` arg
-\end{code}
-
-
-	Try eta expansion for RHSs
-
-We go for:
-   f = \x1..xn -> N  ==>   f = \x1..xn y1..ym -> N y1..ym
-				 (n >= 0)
-
-where (in both cases) 
-
-	* The xi can include type variables
-
-	* The yi are all value variables
-
-	* N is a NORMAL FORM (i.e. no redexes anywhere)
-	  wanting a suitable number of extra args.
-
-We may have to sandwich some coerces between the lambdas
-to make the types work.   exprEtaExpandArity looks through coerces
-when computing arity; and etaExpand adds the coerces as necessary when
-actually computing the expansion.
-
-\begin{code}
-tryEtaExpansion :: OutExpr -> SimplM OutExpr
--- There is at least one runtime binder in the binders
-tryEtaExpansion body
-  = getUniquesSmpl 			`thenSmpl` \ us ->
-    returnSmpl (etaExpand fun_arity us body (exprType body))
-  where
-    fun_arity = exprEtaExpandArity body
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Floating lets out of big lambdas}
-%*									*
-%************************************************************************
-
-tryRhsTyLam tries this transformation, when the big lambda appears as
-the RHS of a let(rec) binding:
-
-	/\abc -> let(rec) x = e in b
-   ==>
-	let(rec) x' = /\abc -> let x = x' a b c in e
-	in 
-	/\abc -> let x = x' a b c in b
-
-This is good because it can turn things like:
-
-	let f = /\a -> letrec g = ... g ... in g
-into
-	letrec g' = /\a -> ... g' a ...
-	in
-	let f = /\ a -> g' a
-
-which is better.  In effect, it means that big lambdas don't impede
-let-floating.
-
-This optimisation is CRUCIAL in eliminating the junk introduced by
-desugaring mutually recursive definitions.  Don't eliminate it lightly!
-
-So far as the implementation is concerned:
-
-	Invariant: go F e = /\tvs -> F e
-	
-	Equalities:
-		go F (Let x=e in b)
-		= Let x' = /\tvs -> F e 
-		  in 
-		  go G b
-		where
-		    G = F . Let x = x' tvs
-	
-		go F (Letrec xi=ei in b)
-		= Letrec {xi' = /\tvs -> G ei} 
-		  in
-		  go G b
-		where
-		  G = F . Let {xi = xi' tvs}
-
-[May 1999]  If we do this transformation *regardless* then we can
-end up with some pretty silly stuff.  For example, 
-
-	let 
-	    st = /\ s -> let { x1=r1 ; x2=r2 } in ...
-	in ..
-becomes
-	let y1 = /\s -> r1
-	    y2 = /\s -> r2
-	    st = /\s -> ...[y1 s/x1, y2 s/x2]
-	in ..
-
-Unless the "..." is a WHNF there is really no point in doing this.
-Indeed it can make things worse.  Suppose x1 is used strictly,
-and is of the form
-
-	x1* = case f y of { (a,b) -> e }
-
-If we abstract this wrt the tyvar we then can't do the case inline
-as we would normally do.
-
-
-\begin{code}
-{-	Trying to do this in full laziness
-
-tryRhsTyLam :: SimplEnv -> [OutTyVar] -> OutExpr -> SimplM FloatsWithExpr
--- Call ensures that all the binders are type variables
-
-tryRhsTyLam env tyvars body 		-- Only does something if there's a let
-  |  not (all isTyVar tyvars)
-  || not (worth_it body)		-- inside a type lambda, 
-  = returnSmpl (emptyFloats env, body)	-- and a WHNF inside that
-
-  | otherwise
-  = go env (\x -> x) body
-
-  where
-    worth_it e@(Let _ _) = whnf_in_middle e
-    worth_it e		 = False
-
-    whnf_in_middle (Let (NonRec x rhs) e) | isUnLiftedType (idType x) = False
-    whnf_in_middle (Let _ e) = whnf_in_middle e
-    whnf_in_middle e	     = exprIsCheap e
-
-    main_tyvar_set = mkVarSet tyvars
-
-    go env fn (Let bind@(NonRec var rhs) body)
-      | exprIsTrivial rhs
-      = go env (fn . Let bind) body
-
-    go env fn (Let (NonRec var rhs) body)
-      = mk_poly tyvars_here var							`thenSmpl` \ (var', rhs') ->
-	addAuxiliaryBind env (NonRec var' (mkLams tyvars_here (fn rhs)))	$ \ env -> 
-	go env (fn . Let (mk_silly_bind var rhs')) body
-
-      where
-
-	tyvars_here = varSetElems (main_tyvar_set `intersectVarSet` exprSomeFreeVars isTyVar rhs)
-		-- Abstract only over the type variables free in the rhs
-		-- wrt which the new binding is abstracted.  But the naive
-		-- approach of abstract wrt the tyvars free in the Id's type
-		-- fails. Consider:
-		--	/\ a b -> let t :: (a,b) = (e1, e2)
-		--		      x :: a     = fst t
-		--		  in ...
-		-- Here, b isn't free in x's type, but we must nevertheless
-		-- abstract wrt b as well, because t's type mentions b.
-		-- Since t is floated too, we'd end up with the bogus:
-		--	poly_t = /\ a b -> (e1, e2)
-		--	poly_x = /\ a   -> fst (poly_t a *b*)
-		-- So for now we adopt the even more naive approach of
-		-- abstracting wrt *all* the tyvars.  We'll see if that
-		-- gives rise to problems.   SLPJ June 98
-
-    go env fn (Let (Rec prs) body)
-       = mapAndUnzipSmpl (mk_poly tyvars_here) vars	`thenSmpl` \ (vars', rhss') ->
-	 let
-	    gn body = fn (foldr Let body (zipWith mk_silly_bind vars rhss'))
-	    pairs   = vars' `zip` [mkLams tyvars_here (gn rhs) | rhs <- rhss]
-	 in
-	 addAuxiliaryBind env (Rec pairs)		$ \ env ->
-	 go env gn body 
-       where
-	 (vars,rhss) = unzip prs
-	 tyvars_here = varSetElems (main_tyvar_set `intersectVarSet` exprsSomeFreeVars isTyVar (map snd prs))
-		-- See notes with tyvars_here above
-
-    go env fn body = returnSmpl (emptyFloats env, fn body)
-
-    mk_poly tyvars_here var
-      = getUniqueSmpl		`thenSmpl` \ uniq ->
-	let
-	    poly_name = setNameUnique (idName var) uniq		-- Keep same name
-	    poly_ty   = mkForAllTys tyvars_here (idType var)	-- But new type of course
-	    poly_id   = mkLocalId poly_name poly_ty 
-
-		-- In the olden days, it was crucial to copy the occInfo of the original var, 
-		-- because we were looking at occurrence-analysed but as yet unsimplified code!
-		-- In particular, we mustn't lose the loop breakers.  BUT NOW we are looking
-		-- at already simplified code, so it doesn't matter
-		-- 
-		-- It's even right to retain single-occurrence or dead-var info:
-		-- Suppose we started with  /\a -> let x = E in B
-		-- where x occurs once in B. Then we transform to:
-		--	let x' = /\a -> E in /\a -> let x* = x' a in B
-		-- where x* has an INLINE prag on it.  Now, once x* is inlined,
-		-- the occurrences of x' will be just the occurrences originally
-		-- pinned on x.
-	in
-	returnSmpl (poly_id, mkTyApps (Var poly_id) (mkTyVarTys tyvars_here))
-
-    mk_silly_bind var rhs = NonRec var (Note InlineMe rhs)
-		-- Suppose we start with:
-		--
-		--	x = /\ a -> let g = G in E
-		--
-		-- Then we'll float to get
-		--
-		--	x = let poly_g = /\ a -> G
-		--	    in /\ a -> let g = poly_g a in E
-		--
-		-- But now the occurrence analyser will see just one occurrence
-		-- of poly_g, not inside a lambda, so the simplifier will
-		-- PreInlineUnconditionally poly_g back into g!  Badk to square 1!
-		-- (I used to think that the "don't inline lone occurrences" stuff
-		--  would stop this happening, but since it's the *only* occurrence,
-		--  PreInlineUnconditionally kicks in first!)
-		--
-		-- Solution: put an INLINE note on g's RHS, so that poly_g seems
-		--	     to appear many times.  (NB: mkInlineMe eliminates
-		--	     such notes on trivial RHSs, so do it manually.)
--}
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Case alternative filtering
-%*									*
-%************************************************************************
-
-prepareAlts does two things:
-
-1.  Eliminate alternatives that cannot match, including the
-    DEFAULT alternative.
-
-2.  If the DEFAULT alternative can match only one possible constructor,
-    then make that constructor explicit.
-    e.g.
-	case e of x { DEFAULT -> rhs }
-     ===>
-	case e of x { (a,b) -> rhs }
-    where the type is a single constructor type.  This gives better code
-    when rhs also scrutinises x or e.
-
-It's a good idea do do this stuff before simplifying the alternatives, to
-avoid simplifying alternatives we know can't happen, and to come up with
-the list of constructors that are handled, to put into the IdInfo of the
-case binder, for use when simplifying the alternatives.
-
-Eliminating the default alternative in (1) isn't so obvious, but it can
-happen:
-
-data Colour = Red | Green | Blue
-
-f x = case x of
-	Red -> ..
-	Green -> ..
-	DEFAULT -> h x
-
-h y = case y of
-	Blue -> ..
-	DEFAULT -> [ case y of ... ]
-
-If we inline h into f, the default case of the inlined h can't happen.
-If we don't notice this, we may end up filtering out *all* the cases
-of the inner case y, which give us nowhere to go!
-
-
-\begin{code}
-prepareAlts :: OutExpr 		-- Scrutinee
-	    -> InId		-- Case binder (passed only to use in statistics)
-	    -> [InAlt]		-- Increasing order
-	    -> SimplM ([InAlt], 	-- Better alternatives, still incresaing order
-			[AltCon])	-- These cases are handled
-
-prepareAlts scrut case_bndr alts
-  = let
-	(alts_wo_default, maybe_deflt) = findDefault alts
-
-        impossible_cons = case scrut of
-			    Var v -> otherCons (idUnfolding v)
-			    other -> []
-
-	-- Filter out alternatives that can't possibly match
-	better_alts | null impossible_cons = alts_wo_default
-		    | otherwise		   = [alt | alt@(con,_,_) <- alts_wo_default, 
-						    not (con `elem` impossible_cons)]
-
-	-- "handled_cons" are handled either by the context, 
-	-- or by a branch in this case expression
-	-- (Don't add DEFAULT to the handled_cons!!)
-	handled_cons = impossible_cons ++ [con | (con,_,_) <- better_alts]
-    in
-	-- Filter out the default, if it can't happen,
-	-- or replace it with "proper" alternative if there
-	-- is only one constructor left
-    prepareDefault scrut case_bndr handled_cons maybe_deflt	`thenSmpl` \ deflt_alt ->
-
-    returnSmpl (mergeAlts better_alts deflt_alt, handled_cons)
-	-- We need the mergeAlts in case the new default_alt 
-	-- has turned into a constructor alternative.
-
-prepareDefault scrut case_bndr handled_cons (Just rhs)
-  | Just (tycon, inst_tys) <- splitTyConApp_maybe (exprType scrut),
-	-- Use exprType scrut here, rather than idType case_bndr, because
-	-- case_bndr is an InId, so exprType scrut may have more information
-	-- Test simpl013 is an example
-    isAlgTyCon tycon,		-- It's a data type, tuple, or unboxed tuples.  
-    not (isNewTyCon tycon),	-- We can have a newtype, if we are just doing an eval:
-				-- 	case x of { DEFAULT -> e }
-				-- and we don't want to fill in a default for them!
-    Just all_cons <- tyConDataCons_maybe tycon,
-    not (null all_cons),	-- This is a tricky corner case.  If the data type has no constructors,
-				-- which GHC allows, then the case expression will have at most a default
-				-- alternative.  We don't want to eliminate that alternative, because the
-				-- invariant is that there's always one alternative.  It's more convenient
-				-- to leave	
-				--	case x of { DEFAULT -> e }     
-				-- as it is, rather than transform it to
-				--	error "case cant match"
-				-- which would be quite legitmate.  But it's a really obscure corner, and
-				-- not worth wasting code on.
-    let handled_data_cons = [data_con | DataAlt data_con <- handled_cons],
-    let missing_cons      = [con | con <- all_cons, 
-			           not (con `elem` handled_data_cons)]
-  = case missing_cons of
-	[] 	    -> returnSmpl []	-- Eliminate the default alternative
-					-- if it can't match
-
-	[con]	    -> 	-- It matches exactly one constructor, so fill it in
-		       tick (FillInCaseDefault case_bndr)	`thenSmpl_`
-    		       mk_args con inst_tys 			`thenSmpl` \ args ->
-		       returnSmpl [(DataAlt con, args, rhs)]
-
-	two_or_more -> returnSmpl [(DEFAULT, [], rhs)]
-
-  | otherwise
-  = returnSmpl [(DEFAULT, [], rhs)]
-
-prepareDefault scrut case_bndr handled_cons Nothing
-  = returnSmpl []
-
-mk_args missing_con inst_tys
-  = mk_tv_bndrs missing_con inst_tys	`thenSmpl` \ (tv_bndrs, inst_tys') ->
-    getUniquesSmpl			`thenSmpl` \ id_uniqs ->
-    let arg_tys = dataConInstArgTys missing_con inst_tys'
-	arg_ids = zipWith (mkSysLocal FSLIT("a")) id_uniqs arg_tys
-    in
-    returnSmpl (tv_bndrs ++ arg_ids)
-
-mk_tv_bndrs missing_con inst_tys
-  | isVanillaDataCon missing_con
-  = returnSmpl ([], inst_tys)
-  | otherwise
-  = getUniquesSmpl		`thenSmpl` \ tv_uniqs ->
-    let new_tvs    = zipWith mk tv_uniqs (dataConTyVars missing_con)
-	mk uniq tv = mkTyVar (mkSysTvName uniq FSLIT("t")) (tyVarKind tv)
-    in
-    returnSmpl (new_tvs, mkTyVarTys new_tvs)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Case absorption and identity-case elimination}
-%*									*
-%************************************************************************
-
-mkCase puts a case expression back together, trying various transformations first.
-
-\begin{code}
-mkCase :: OutExpr -> OutId -> OutType
-       -> [OutAlt]		-- Increasing order
-       -> SimplM OutExpr
-
-mkCase scrut case_bndr ty alts
-  = getDOptsSmpl  			`thenSmpl` \dflags ->
-    mkAlts dflags scrut case_bndr alts	`thenSmpl` \ better_alts ->
-    mkCase1 scrut case_bndr ty better_alts
-\end{code}
-
-
-mkAlts tries these things:
-
-1.  If several alternatives are identical, merge them into
-    a single DEFAULT alternative.  I've occasionally seen this 
-    making a big difference:
-
-	case e of		=====>     case e of
-	  C _ -> f x			     D v -> ....v....
-	  D v -> ....v....		     DEFAULT -> f x
-	  DEFAULT -> f x
-
-   The point is that we merge common RHSs, at least for the DEFAULT case.
-   [One could do something more elaborate but I've never seen it needed.]
-   To avoid an expensive test, we just merge branches equal to the *first*
-   alternative; this picks up the common cases
-	a) all branches equal
-	b) some branches equal to the DEFAULT (which occurs first)
-
-2.  Case merging:
-       case e of b {             ==>   case e of b {
-    	 p1 -> rhs1	                 p1 -> rhs1
-    	 ...	                         ...
-    	 pm -> rhsm                      pm -> rhsm
-    	 _  -> case b of b' {            pn -> let b'=b in rhsn
- 		     pn -> rhsn          ...
- 		     ...                 po -> let b'=b in rhso
- 		     po -> rhso          _  -> let b'=b in rhsd
- 		     _  -> rhsd
-       }  
-    
-    which merges two cases in one case when -- the default alternative of
-    the outer case scrutises the same variable as the outer case This
-    transformation is called Case Merging.  It avoids that the same
-    variable is scrutinised multiple times.
-
-
-The case where transformation (1) showed up was like this (lib/std/PrelCError.lhs):
-
-	x | p `is` 1 -> e1
-	  | p `is` 2 -> e2
-	...etc...
-
-where @is@ was something like
-	
-	p `is` n = p /= (-1) && p == n
-
-This gave rise to a horrible sequence of cases
-
-	case p of
-	  (-1) -> $j p
-	  1    -> e1
-	  DEFAULT -> $j p
-
-and similarly in cascade for all the join points!
-
-
-
-\begin{code}
---------------------------------------------------
---	1. Merge identical branches
---------------------------------------------------
-mkAlts dflags scrut case_bndr alts@((con1,bndrs1,rhs1) : con_alts)
-  | all isDeadBinder bndrs1,			-- Remember the default 
-    length filtered_alts < length con_alts	-- alternative comes first
-  = tick (AltMerge case_bndr)			`thenSmpl_`
-    returnSmpl better_alts
-  where
-    filtered_alts	 = filter keep con_alts
-    keep (con,bndrs,rhs) = not (all isDeadBinder bndrs && rhs `cheapEqExpr` rhs1)
-    better_alts		 = (DEFAULT, [], rhs1) : filtered_alts
-
-
---------------------------------------------------
---	2.  Merge nested cases
---------------------------------------------------
-
-mkAlts dflags scrut outer_bndr outer_alts
-  | dopt Opt_CaseMerge dflags,
-    (outer_alts_without_deflt, maybe_outer_deflt)   <- findDefault outer_alts,
-    Just (Case (Var scrut_var) inner_bndr _ inner_alts) <- maybe_outer_deflt,
-    scruting_same_var scrut_var
-  = let
-  	munged_inner_alts = [(con, args, munge_rhs rhs) | (con, args, rhs) <- inner_alts]
-  	munge_rhs rhs = bindCaseBndr inner_bndr (Var outer_bndr) rhs
-  
-  	new_alts = mergeAlts outer_alts_without_deflt munged_inner_alts
-		-- The merge keeps the inner DEFAULT at the front, if there is one
-		-- and eliminates any inner_alts that are shadowed by the outer_alts
-    in
-    tick (CaseMerge outer_bndr)				`thenSmpl_`
-    returnSmpl new_alts
-    	-- Warning: don't call mkAlts recursively!
-    	-- Firstly, there's no point, because inner alts have already had
-    	-- mkCase applied to them, so they won't have a case in their default
-    	-- Secondly, if you do, you get an infinite loop, because the bindCaseBndr
-    	-- in munge_rhs may put a case into the DEFAULT branch!
-  where
-    	-- We are scrutinising the same variable if it's
-    	-- the outer case-binder, or if the outer case scrutinises a variable
-    	-- (and it's the same).  Testing both allows us not to replace the
-    	-- outer scrut-var with the outer case-binder (Simplify.simplCaseBinder).
-    scruting_same_var = case scrut of
-			  Var outer_scrut -> \ v -> v == outer_bndr || v == outer_scrut
-			  other		  -> \ v -> v == outer_bndr
-
-------------------------------------------------
---	Catch-all
-------------------------------------------------
-
-mkAlts dflags scrut case_bndr other_alts = returnSmpl other_alts
-
-
----------------------------------
-mergeAlts :: [OutAlt] -> [OutAlt] -> [OutAlt]
--- Merge preserving order; alternatives in the first arg
--- shadow ones in the second
-mergeAlts [] as2 = as2
-mergeAlts as1 [] = as1
-mergeAlts (a1:as1) (a2:as2)
-  = case a1 `cmpAlt` a2 of
-	LT -> a1 : mergeAlts as1      (a2:as2)
-	EQ -> a1 : mergeAlts as1      as2	-- Discard a2
-	GT -> a2 : mergeAlts (a1:as1) as2
-\end{code}
-
-
-
-=================================================================================
-
-mkCase1 tries these things
-
-1.  Eliminate the case altogether if possible
-
-2.  Case-identity:
-
-	case e of 		===> e
-		True  -> True;
-		False -> False
-
-    and similar friends.
-
-
-Start with a simple situation:
-
-	case x# of	===>   e[x#/y#]
-	  y# -> e
-
-(when x#, y# are of primitive type, of course).  We can't (in general)
-do this for algebraic cases, because we might turn bottom into
-non-bottom!
-
-Actually, we generalise this idea to look for a case where we're
-scrutinising a variable, and we know that only the default case can
-match.  For example:
-\begin{verbatim}
-	case x of
-	  0#    -> ...
-	  other -> ...(case x of
-			 0#    -> ...
-			 other -> ...) ...
-\end{code}
-Here the inner case can be eliminated.  This really only shows up in
-eliminating error-checking code.
-
-We also make sure that we deal with this very common case:
-
- 	case e of 
-	  x -> ...x...
-
-Here we are using the case as a strict let; if x is used only once
-then we want to inline it.  We have to be careful that this doesn't 
-make the program terminate when it would have diverged before, so we
-check that 
-	- x is used strictly, or
-	- e is already evaluated (it may so if e is a variable)
-
-Lastly, we generalise the transformation to handle this:
-
-	case e of	===> r
-	   True  -> r
-	   False -> r
-
-We only do this for very cheaply compared r's (constructors, literals
-and variables).  If pedantic bottoms is on, we only do it when the
-scrutinee is a PrimOp which can't fail.
-
-We do it *here*, looking at un-simplified alternatives, because we
-have to check that r doesn't mention the variables bound by the
-pattern in each alternative, so the binder-info is rather useful.
-
-So the case-elimination algorithm is:
-
-	1. Eliminate alternatives which can't match
-
-	2. Check whether all the remaining alternatives
-		(a) do not mention in their rhs any of the variables bound in their pattern
-	   and  (b) have equal rhss
-
-	3. Check we can safely ditch the case:
-		   * PedanticBottoms is off,
-		or * the scrutinee is an already-evaluated variable
-		or * the scrutinee is a primop which is ok for speculation
-			-- ie we want to preserve divide-by-zero errors, and
-			-- calls to error itself!
-
-		or * [Prim cases] the scrutinee is a primitive variable
-
-		or * [Alg cases] the scrutinee is a variable and
-		     either * the rhs is the same variable
-			(eg case x of C a b -> x  ===>   x)
-		     or     * there is only one alternative, the default alternative,
-				and the binder is used strictly in its scope.
-				[NB this is helped by the "use default binder where
-				 possible" transformation; see below.]
-
-
-If so, then we can replace the case with one of the rhss.
-
-Further notes about case elimination
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider:	test :: Integer -> IO ()
-		test = print
-
-Turns out that this compiles to:
-    Print.test
-      = \ eta :: Integer
-	  eta1 :: State# RealWorld ->
-	  case PrelNum.< eta PrelNum.zeroInteger of wild { __DEFAULT ->
-	  case hPutStr stdout
-		 (PrelNum.jtos eta ($w[] @ Char))
-		 eta1
-	  of wild1 { (# new_s, a4 #) -> PrelIO.lvl23 new_s  }}
-
-Notice the strange '<' which has no effect at all. This is a funny one.  
-It started like this:
-
-f x y = if x < 0 then jtos x
-          else if y==0 then "" else jtos x
-
-At a particular call site we have (f v 1).  So we inline to get
-
-	if v < 0 then jtos x 
-	else if 1==0 then "" else jtos x
-
-Now simplify the 1==0 conditional:
-
-	if v<0 then jtos v else jtos v
-
-Now common-up the two branches of the case:
-
-	case (v<0) of DEFAULT -> jtos v
-
-Why don't we drop the case?  Because it's strict in v.  It's technically
-wrong to drop even unnecessary evaluations, and in practice they
-may be a result of 'seq' so we *definitely* don't want to drop those.
-I don't really know how to improve this situation.
-
-
-\begin{code}
---------------------------------------------------
---	0. Check for empty alternatives
---------------------------------------------------
-
--- This isn't strictly an error.  It's possible that the simplifer might "see"
--- that an inner case has no accessible alternatives before it "sees" that the
--- entire branch of an outer case is inaccessible.  So we simply
--- put an error case here insteadd
-mkCase1 scrut case_bndr ty []
-  = pprTrace "mkCase1: null alts" (ppr case_bndr <+> ppr scrut) $
-    return (mkApps (Var eRROR_ID)
-		   [Type ty, Lit (mkStringLit "Impossible alternative")])
-
---------------------------------------------------
---	1. Eliminate the case altogether if poss
---------------------------------------------------
-
-mkCase1 scrut case_bndr ty [(con,bndrs,rhs)]
-  -- See if we can get rid of the case altogether
-  -- See the extensive notes on case-elimination above
-  -- mkCase made sure that if all the alternatives are equal, 
-  -- then there is now only one (DEFAULT) rhs
- |  all isDeadBinder bndrs,
-
-	-- Check that the scrutinee can be let-bound instead of case-bound
-    exprOkForSpeculation scrut
-		-- OK not to evaluate it
-		-- This includes things like (==# a# b#)::Bool
-		-- so that we simplify 
-		-- 	case ==# a# b# of { True -> x; False -> x }
-		-- to just
-		--	x
-		-- This particular example shows up in default methods for
-		-- comparision operations (e.g. in (>=) for Int.Int32)
-	|| exprIsHNF scrut			-- It's already evaluated
-	|| var_demanded_later scrut		-- It'll be demanded later
-
---      || not opt_SimplPedanticBottoms)	-- Or we don't care!
---	We used to allow improving termination by discarding cases, unless -fpedantic-bottoms was on,
--- 	but that breaks badly for the dataToTag# primop, which relies on a case to evaluate
--- 	its argument:  case x of { y -> dataToTag# y }
---	Here we must *not* discard the case, because dataToTag# just fetches the tag from
---	the info pointer.  So we'll be pedantic all the time, and see if that gives any
--- 	other problems
---	Also we don't want to discard 'seq's
-  = tick (CaseElim case_bndr)			`thenSmpl_` 
-    returnSmpl (bindCaseBndr case_bndr scrut rhs)
-
-  where
-	-- The case binder is going to be evaluated later, 
-	-- and the scrutinee is a simple variable
-    var_demanded_later (Var v) = isStrictDmd (idNewDemandInfo case_bndr)
-    var_demanded_later other   = False
-
-
---------------------------------------------------
---	2. Identity case
---------------------------------------------------
-
-mkCase1 scrut case_bndr ty alts	-- Identity case
-  | all identity_alt alts
-  = tick (CaseIdentity case_bndr)		`thenSmpl_`
-    returnSmpl (re_note scrut)
-  where
-    identity_alt (con, args, rhs) = de_note rhs `cheapEqExpr` identity_rhs con args
-
-    identity_rhs (DataAlt con) args = mkConApp con (arg_tys ++ map varToCoreExpr args)
-    identity_rhs (LitAlt lit)  _    = Lit lit
-    identity_rhs DEFAULT       _    = Var case_bndr
-
-    arg_tys = map Type (tyConAppArgs (idType case_bndr))
-
-	-- We've seen this:
-	--	case coerce T e of x { _ -> coerce T' x }
-	-- And we definitely want to eliminate this case!
-	-- So we throw away notes from the RHS, and reconstruct
-	-- (at least an approximation) at the other end
-    de_note (Note _ e) = de_note e
-    de_note e	       = e
-
-	-- re_note wraps a coerce if it might be necessary
-    re_note scrut = case head alts of
-			(_,_,rhs1@(Note _ _)) -> mkCoerce2 (exprType rhs1) (idType case_bndr) scrut
-			other		      -> scrut
-
-
---------------------------------------------------
---	Catch-all
---------------------------------------------------
-mkCase1 scrut bndr ty alts = returnSmpl (Case scrut bndr ty alts)
-\end{code}
-
-
-When adding auxiliary bindings for the case binder, it's worth checking if
-its dead, because it often is, and occasionally these mkCase transformations
-cascade rather nicely.
-
-\begin{code}
-bindCaseBndr bndr rhs body
-  | isDeadBinder bndr = body
-  | otherwise	      = bindNonRec bndr rhs body
-\end{code}
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
deleted file mode 100644
index 5ea0a91007..0000000000
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ /dev/null
@@ -1,1894 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1993-1998
-%
-\section[Simplify]{The main module of the simplifier}
-
-\begin{code}
-module Simplify ( simplTopBinds, simplExpr ) where
-
-#include "HsVersions.h"
-
-import DynFlags	( dopt, DynFlag(Opt_D_dump_inlinings),
-			  SimplifierSwitch(..)
-			)
-import SimplMonad
-import SimplEnv	
-import SimplUtils	( mkCase, mkLam, prepareAlts,
-			  SimplCont(..), DupFlag(..), LetRhsFlag(..), 
-			  mkRhsStop, mkBoringStop,  pushContArgs,
-			  contResultType, countArgs, contIsDupable, contIsRhsOrArg,
-			  getContArgs, interestingCallContext, interestingArg, isStrictType,
-			  preInlineUnconditionally, postInlineUnconditionally, 
-			  inlineMode, activeInline, activeRule
-			)
-import Id		( Id, idType, idInfo, idArity, isDataConWorkId, 
-			  setIdUnfolding, isDeadBinder,
-			  idNewDemandInfo, setIdInfo, 
-			  setIdOccInfo, zapLamIdInfo, setOneShotLambda
-			)
-import MkId		( eRROR_ID )
-import Literal		( mkStringLit )
-import IdInfo		( OccInfo(..), isLoopBreaker,
-			  setArityInfo, zapDemandInfo,
-			  setUnfoldingInfo, 
-			  occInfo
-			)
-import NewDemand	( isStrictDmd )
-import Unify		( coreRefineTys )
-import DataCon		( dataConTyCon, dataConRepStrictness, isVanillaDataCon )
-import TyCon		( tyConArity )
-import CoreSyn
-import PprCore		( pprParendExpr, pprCoreExpr )
-import CoreUnfold	( mkUnfolding, callSiteInline )
-import CoreUtils	( exprIsDupable, exprIsTrivial, needsCaseBinding,
-			  exprIsConApp_maybe, mkPiTypes, findAlt, 
-			  exprType, exprIsHNF, 
-			  exprOkForSpeculation, exprArity, 
-			  mkCoerce, mkCoerce2, mkSCC, mkInlineMe, applyTypeToArg
-			)
-import Rules		( lookupRule )
-import BasicTypes	( isMarkedStrict )
-import CostCentre	( currentCCS )
-import Type		( TvSubstEnv, isUnLiftedType, seqType, tyConAppArgs, funArgTy,
-			  splitFunTy_maybe, splitFunTy, coreEqType 
-			)
-import VarEnv		( elemVarEnv, emptyVarEnv )
-import TysPrim		( realWorldStatePrimTy )
-import PrelInfo		( realWorldPrimId )
-import BasicTypes	( TopLevelFlag(..), isTopLevel, 
-			  RecFlag(..), isNonRec
-			)
-import StaticFlags	( opt_PprStyle_Debug )
-import OrdList
-import Maybes		( orElse )
-import Outputable
-import Util             ( notNull )
-\end{code}
-
-
-The guts of the simplifier is in this module, but the driver loop for
-the simplifier is in SimplCore.lhs.
-
-
------------------------------------------
-	*** IMPORTANT NOTE ***
------------------------------------------
-The simplifier used to guarantee that the output had no shadowing, but
-it does not do so any more.   (Actually, it never did!)  The reason is
-documented with simplifyArgs.
-
-
------------------------------------------
-	*** IMPORTANT NOTE ***
------------------------------------------
-Many parts of the simplifier return a bunch of "floats" as well as an
-expression. This is wrapped as a datatype SimplUtils.FloatsWith.
-
-All "floats" are let-binds, not case-binds, but some non-rec lets may
-be unlifted (with RHS ok-for-speculation).
-
-
-
------------------------------------------
-	ORGANISATION OF FUNCTIONS
------------------------------------------
-simplTopBinds
-  - simplify all top-level binders
-  - for NonRec, call simplRecOrTopPair
-  - for Rec,    call simplRecBind
-
-	
-	------------------------------
-simplExpr (applied lambda)	==> simplNonRecBind
-simplExpr (Let (NonRec ...) ..) ==> simplNonRecBind
-simplExpr (Let (Rec ...)    ..) ==> simplify binders; simplRecBind
-
-	------------------------------
-simplRecBind	[binders already simplfied]
-  - use simplRecOrTopPair on each pair in turn
-
-simplRecOrTopPair [binder already simplified]
-  Used for: recursive bindings (top level and nested)
-	    top-level non-recursive bindings
-  Returns: 
-  - check for PreInlineUnconditionally
-  - simplLazyBind
-
-simplNonRecBind
-  Used for: non-top-level non-recursive bindings
-	    beta reductions (which amount to the same thing)
-  Because it can deal with strict arts, it takes a 
-	"thing-inside" and returns an expression
-
-  - check for PreInlineUnconditionally
-  - simplify binder, including its IdInfo
-  - if strict binding
-	simplStrictArg
-	mkAtomicArgs
-	completeNonRecX
-    else
-	simplLazyBind
-	addFloats
-
-simplNonRecX:	[given a *simplified* RHS, but an *unsimplified* binder]
-  Used for: binding case-binder and constr args in a known-constructor case
-  - check for PreInLineUnconditionally
-  - simplify binder
-  - completeNonRecX
- 
-	------------------------------
-simplLazyBind:	[binder already simplified, RHS not]
-  Used for: recursive bindings (top level and nested)
-	    top-level non-recursive bindings
-	    non-top-level, but *lazy* non-recursive bindings
-	[must not be strict or unboxed]
-  Returns floats + an augmented environment, not an expression
-  - substituteIdInfo and add result to in-scope 
-	[so that rules are available in rec rhs]
-  - simplify rhs
-  - mkAtomicArgs
-  - float if exposes constructor or PAP
-  - completeLazyBind
-
-
-completeNonRecX:	[binder and rhs both simplified]
-  - if the the thing needs case binding (unlifted and not ok-for-spec)
-	build a Case
-   else
-	completeLazyBind
-	addFloats
-
-completeLazyBind: 	[given a simplified RHS]
-	[used for both rec and non-rec bindings, top level and not]
-  - try PostInlineUnconditionally
-  - add unfolding [this is the only place we add an unfolding]
-  - add arity
-
-
-
-Right hand sides and arguments
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In many ways we want to treat 
-	(a) the right hand side of a let(rec), and 
-	(b) a function argument
-in the same way.  But not always!  In particular, we would
-like to leave these arguments exactly as they are, so they
-will match a RULE more easily.
-	
-	f (g x, h x)	
-	g (+ x)
-
-It's harder to make the rule match if we ANF-ise the constructor,
-or eta-expand the PAP:
-
-	f (let { a = g x; b = h x } in (a,b))
-	g (\y. + x y)
-
-On the other hand if we see the let-defns
-
-	p = (g x, h x)
-	q = + x
-
-then we *do* want to ANF-ise and eta-expand, so that p and q
-can be safely inlined.   
-
-Even floating lets out is a bit dubious.  For let RHS's we float lets
-out if that exposes a value, so that the value can be inlined more vigorously.
-For example
-
-	r = let x = e in (x,x)
-
-Here, if we float the let out we'll expose a nice constructor. We did experiments
-that showed this to be a generally good thing.  But it was a bad thing to float
-lets out unconditionally, because that meant they got allocated more often.
-
-For function arguments, there's less reason to expose a constructor (it won't
-get inlined).  Just possibly it might make a rule match, but I'm pretty skeptical.
-So for the moment we don't float lets out of function arguments either.
-
-
-Eta expansion
-~~~~~~~~~~~~~~
-For eta expansion, we want to catch things like
-
-	case e of (a,b) -> \x -> case a of (p,q) -> \y -> r
-
-If the \x was on the RHS of a let, we'd eta expand to bring the two
-lambdas together.  And in general that's a good thing to do.  Perhaps
-we should eta expand wherever we find a (value) lambda?  Then the eta
-expansion at a let RHS can concentrate solely on the PAP case.
-
-
-%************************************************************************
-%*									*
-\subsection{Bindings}
-%*									*
-%************************************************************************
-
-\begin{code}
-simplTopBinds :: SimplEnv -> [InBind] -> SimplM [OutBind]
-
-simplTopBinds env binds
-  = 	-- Put all the top-level binders into scope at the start
-	-- so that if a transformation rule has unexpectedly brought
-	-- anything into scope, then we don't get a complaint about that.
-	-- It's rather as if the top-level binders were imported.
-    simplRecBndrs env (bindersOfBinds binds)	`thenSmpl` \ (env, bndrs') -> 
-    simpl_binds env binds bndrs'		`thenSmpl` \ (floats, _) ->
-    freeTick SimplifierDone			`thenSmpl_`
-    returnSmpl (floatBinds floats)
-  where
-	-- We need to track the zapped top-level binders, because
-	-- they should have their fragile IdInfo zapped (notably occurrence info)
-	-- That's why we run down binds and bndrs' simultaneously.
-    simpl_binds :: SimplEnv -> [InBind] -> [OutId] -> SimplM (FloatsWith ())
-    simpl_binds env []		 bs = ASSERT( null bs ) returnSmpl (emptyFloats env, ())
-    simpl_binds env (bind:binds) bs = simpl_bind env bind bs 		`thenSmpl` \ (floats,env) ->
-				      addFloats env floats		$ \env -> 
-				      simpl_binds env binds (drop_bs bind bs)
-
-    drop_bs (NonRec _ _) (_ : bs) = bs
-    drop_bs (Rec prs)    bs	  = drop (length prs) bs
-
-    simpl_bind env bind bs 
-      = getDOptsSmpl				`thenSmpl` \ dflags ->
-        if dopt Opt_D_dump_inlinings dflags then
-	   pprTrace "SimplBind" (ppr (bindersOf bind)) $ simpl_bind1 env bind bs
-	else
-	   simpl_bind1 env bind bs
-
-    simpl_bind1 env (NonRec b r) (b':_) = simplRecOrTopPair env TopLevel b b' r
-    simpl_bind1 env (Rec pairs)  bs'    = simplRecBind      env TopLevel pairs bs'
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{simplNonRec}
-%*									*
-%************************************************************************
-
-simplNonRecBind is used for
-  * non-top-level non-recursive lets in expressions
-  * beta reduction
-
-It takes 
-  * An unsimplified (binder, rhs) pair
-  * The env for the RHS.  It may not be the same as the
-	current env because the bind might occur via (\x.E) arg
-
-It uses the CPS form because the binding might be strict, in which
-case we might discard the continuation:
-	let x* = error "foo" in (...x...)
-
-It needs to turn unlifted bindings into a @case@.  They can arise
-from, say: 	(\x -> e) (4# + 3#)
-
-\begin{code}
-simplNonRecBind :: SimplEnv
-		-> InId 				-- Binder
-	  	-> InExpr -> SimplEnv			-- Arg, with its subst-env
-	  	-> OutType				-- Type of thing computed by the context
-	  	-> (SimplEnv -> SimplM FloatsWithExpr)	-- The body
-	  	-> SimplM FloatsWithExpr
-#ifdef DEBUG
-simplNonRecBind env bndr rhs rhs_se cont_ty thing_inside
-  | isTyVar bndr
-  = pprPanic "simplNonRecBind" (ppr bndr <+> ppr rhs)
-#endif
-
-simplNonRecBind env bndr rhs rhs_se cont_ty thing_inside
-  = simplNonRecBind' env bndr rhs rhs_se cont_ty thing_inside
-
-simplNonRecBind' env bndr rhs rhs_se cont_ty thing_inside
-  | preInlineUnconditionally env NotTopLevel bndr rhs
-  = tick (PreInlineUnconditionally bndr)		`thenSmpl_`
-    thing_inside (extendIdSubst env bndr (mkContEx rhs_se rhs))
-
-  | isStrictDmd (idNewDemandInfo bndr) || isStrictType bndr_ty	-- A strict let
-  =  	-- Don't use simplBinder because that doesn't keep 
-	-- fragile occurrence info in the substitution
-    simplNonRecBndr env bndr					`thenSmpl` \ (env, bndr1) ->
-    simplStrictArg AnRhs env rhs rhs_se (idType bndr1) cont_ty	$ \ env1 rhs1 ->
-
-	-- Now complete the binding and simplify the body
-    let
-	(env2,bndr2) = addLetIdInfo env1 bndr bndr1
-    in
-    if needsCaseBinding bndr_ty rhs1
-    then
-      thing_inside env2					`thenSmpl` \ (floats, body) ->
-      returnSmpl (emptyFloats env2, Case rhs1 bndr2 (exprType body) 
-					[(DEFAULT, [], wrapFloats floats body)])
-    else
-      completeNonRecX env2 True {- strict -} bndr bndr2 rhs1 thing_inside
-
-  | otherwise							-- Normal, lazy case
-  =  	-- Don't use simplBinder because that doesn't keep 
-	-- fragile occurrence info in the substitution
-    simplNonRecBndr env bndr				`thenSmpl` \ (env, bndr') ->
-    simplLazyBind env NotTopLevel NonRecursive
-		  bndr bndr' rhs rhs_se 		`thenSmpl` \ (floats, env) ->
-    addFloats env floats thing_inside
-
-  where
-    bndr_ty = idType bndr
-\end{code}
-
-A specialised variant of simplNonRec used when the RHS is already simplified, notably
-in knownCon.  It uses case-binding where necessary.
-
-\begin{code}
-simplNonRecX :: SimplEnv
-	     -> InId 		-- Old binder
-	     -> OutExpr		-- Simplified RHS
-	     -> (SimplEnv -> SimplM FloatsWithExpr)
-	     -> SimplM FloatsWithExpr
-
-simplNonRecX env bndr new_rhs thing_inside
-  | needsCaseBinding (idType bndr) new_rhs
-	-- Make this test *before* the preInlineUnconditionally
-	-- Consider 	case I# (quotInt# x y) of 
-	--		  I# v -> let w = J# v in ...
-	-- If we gaily inline (quotInt# x y) for v, we end up building an
-	-- extra thunk:
-	--		  let w = J# (quotInt# x y) in ...
-	-- because quotInt# can fail.
-  = simplBinder env bndr	`thenSmpl` \ (env, bndr') ->
-    thing_inside env 		`thenSmpl` \ (floats, body) ->
-    let body' = wrapFloats floats body in 
-    returnSmpl (emptyFloats env, Case new_rhs bndr' (exprType body') [(DEFAULT, [], body')])
-
-  | preInlineUnconditionally env NotTopLevel bndr new_rhs
-  	-- This happens; for example, the case_bndr during case of
-	-- known constructor:  case (a,b) of x { (p,q) -> ... }
-	-- Here x isn't mentioned in the RHS, so we don't want to
-	-- create the (dead) let-binding  let x = (a,b) in ...
-	--
-	-- Similarly, single occurrences can be inlined vigourously
-	-- e.g.  case (f x, g y) of (a,b) -> ....
-	-- If a,b occur once we can avoid constructing the let binding for them.
-  = thing_inside (extendIdSubst env bndr (DoneEx new_rhs))
-
-  | otherwise
-  = simplBinder env bndr	`thenSmpl` \ (env, bndr') ->
-    completeNonRecX env False {- Non-strict; pessimistic -} 
-		    bndr bndr' new_rhs thing_inside
-
-completeNonRecX env is_strict old_bndr new_bndr new_rhs thing_inside
-  = mkAtomicArgs is_strict 
-		 True {- OK to float unlifted -} 
-		 new_rhs			`thenSmpl` \ (aux_binds, rhs2) ->
-
-	-- Make the arguments atomic if necessary, 
-	-- adding suitable bindings
-    addAtomicBindsE env (fromOL aux_binds)	$ \ env ->
-    completeLazyBind env NotTopLevel
-		     old_bndr new_bndr rhs2	`thenSmpl` \ (floats, env) ->
-    addFloats env floats thing_inside
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Lazy bindings}
-%*									*
-%************************************************************************
-
-simplRecBind is used for
-	* recursive bindings only
-
-\begin{code}
-simplRecBind :: SimplEnv -> TopLevelFlag
-	     -> [(InId, InExpr)] -> [OutId]
-	     -> SimplM (FloatsWith SimplEnv)
-simplRecBind env top_lvl pairs bndrs'
-  = go env pairs bndrs'		`thenSmpl` \ (floats, env) ->
-    returnSmpl (flattenFloats floats, env)
-  where
-    go env [] _ = returnSmpl (emptyFloats env, env)
-	
-    go env ((bndr, rhs) : pairs) (bndr' : bndrs')
-	= simplRecOrTopPair env top_lvl bndr bndr' rhs 	`thenSmpl` \ (floats, env) ->
-	  addFloats env floats (\env -> go env pairs bndrs')
-\end{code}
-
-
-simplRecOrTopPair is used for
-	* recursive bindings (whether top level or not)
-	* top-level non-recursive bindings
-
-It assumes the binder has already been simplified, but not its IdInfo.
-
-\begin{code}
-simplRecOrTopPair :: SimplEnv
-	     	  -> TopLevelFlag
-	     	  -> InId -> OutId		-- Binder, both pre-and post simpl
-	     	  -> InExpr 			-- The RHS and its environment
-	     	  -> SimplM (FloatsWith SimplEnv)
-
-simplRecOrTopPair env top_lvl bndr bndr' rhs
-  | preInlineUnconditionally env top_lvl bndr rhs  	-- Check for unconditional inline
-  = tick (PreInlineUnconditionally bndr)		`thenSmpl_`
-    returnSmpl (emptyFloats env, extendIdSubst env bndr (mkContEx env rhs))
-
-  | otherwise
-  = simplLazyBind env top_lvl Recursive bndr bndr' rhs env
-	-- May not actually be recursive, but it doesn't matter
-\end{code}
-
-
-simplLazyBind is used for
-	* recursive bindings (whether top level or not)
-	* top-level non-recursive bindings
-	* non-top-level *lazy* non-recursive bindings
-
-[Thus it deals with the lazy cases from simplNonRecBind, and all cases
-from SimplRecOrTopBind]
-
-Nota bene:
-    1. It assumes that the binder is *already* simplified, 
-       and is in scope, but not its IdInfo
-
-    2. It assumes that the binder type is lifted.
-
-    3. It does not check for pre-inline-unconditionallly;
-       that should have been done already.
-
-\begin{code}
-simplLazyBind :: SimplEnv
-	      -> TopLevelFlag -> RecFlag
-	      -> InId -> OutId		-- Binder, both pre-and post simpl
-	      -> InExpr -> SimplEnv 	-- The RHS and its environment
-	      -> SimplM (FloatsWith SimplEnv)
-
-simplLazyBind env top_lvl is_rec bndr bndr1 rhs rhs_se
-  = let	
-	(env1,bndr2)      = addLetIdInfo env bndr bndr1
-	rhs_env      	  = setInScope rhs_se env1
- 	is_top_level	  = isTopLevel top_lvl
-	ok_float_unlifted = not is_top_level && isNonRec is_rec
-	rhs_cont	  = mkRhsStop (idType bndr2)
-    in
-  	-- Simplify the RHS; note the mkRhsStop, which tells 
-	-- the simplifier that this is the RHS of a let.
-    simplExprF rhs_env rhs rhs_cont		`thenSmpl` \ (floats, rhs1) ->
-
-	-- If any of the floats can't be floated, give up now
-	-- (The allLifted predicate says True for empty floats.)
-    if (not ok_float_unlifted && not (allLifted floats)) then
-	completeLazyBind env1 top_lvl bndr bndr2
-			 (wrapFloats floats rhs1)
-    else	
-
-	-- ANF-ise a constructor or PAP rhs
-    mkAtomicArgs False {- Not strict -} 
-		 ok_float_unlifted rhs1 		`thenSmpl` \ (aux_binds, rhs2) ->
-
-	-- If the result is a PAP, float the floats out, else wrap them
-	-- By this time it's already been ANF-ised (if necessary)
-    if isEmptyFloats floats && isNilOL aux_binds then	-- Shortcut a common case
-	completeLazyBind env1 top_lvl bndr bndr2 rhs2
-
-    else if is_top_level || exprIsTrivial rhs2 || exprIsHNF rhs2 then
-	-- 	WARNING: long dodgy argument coming up
-	--	WANTED: a better way to do this
-	--		
-	-- We can't use "exprIsCheap" instead of exprIsHNF, 
-	-- because that causes a strictness bug.
-	--     	   x = let y* = E in case (scc y) of { T -> F; F -> T}
-	-- The case expression is 'cheap', but it's wrong to transform to
-	-- 	   y* = E; x = case (scc y) of {...}
- 	-- Either we must be careful not to float demanded non-values, or
-	-- we must use exprIsHNF for the test, which ensures that the
-	-- thing is non-strict.  So exprIsHNF => bindings are non-strict
-	-- I think.  The WARN below tests for this.
-	--
-	-- We use exprIsTrivial here because we want to reveal lone variables.  
-	-- E.g.  let { x = letrec { y = E } in y } in ...
-	-- Here we definitely want to float the y=E defn. 
-	-- exprIsHNF definitely isn't right for that.
-	--
-	-- Again, the floated binding can't be strict; if it's recursive it'll
-	-- be non-strict; if it's non-recursive it'd be inlined.
-	--
-	-- Note [SCC-and-exprIsTrivial]
-	-- If we have
-	--	y = let { x* = E } in scc "foo" x
-	-- then we do *not* want to float out the x binding, because
-	-- it's strict!  Fortunately, exprIsTrivial replies False to
-	-- (scc "foo" x).
-
-		-- There's a subtlety here.  There may be a binding (x* = e) in the
-		-- floats, where the '*' means 'will be demanded'.  So is it safe
-		-- to float it out?  Answer no, but it won't matter because
-		-- we only float if (a) arg' is a WHNF, or (b) it's going to top level
-		-- and so there can't be any 'will be demanded' bindings in the floats.
-		-- Hence the warning
-        ASSERT2( is_top_level || not (any demanded_float (floatBinds floats)), 
-	         ppr (filter demanded_float (floatBinds floats)) )
-
-	tick LetFloatFromLet			`thenSmpl_` (
-	addFloats env1 floats			$ \ env2 ->
-	addAtomicBinds env2 (fromOL aux_binds)	$ \ env3 ->
-	completeLazyBind env3 top_lvl bndr bndr2 rhs2)
-
-    else
-	completeLazyBind env1 top_lvl bndr bndr2 (wrapFloats floats rhs1)
-
-#ifdef DEBUG
-demanded_float (NonRec b r) = isStrictDmd (idNewDemandInfo b) && not (isUnLiftedType (idType b))
-		-- Unlifted-type (cheap-eagerness) lets may well have a demanded flag on them
-demanded_float (Rec _)	    = False
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Completing a lazy binding}
-%*									*
-%************************************************************************
-
-completeLazyBind
-	* deals only with Ids, not TyVars
-	* takes an already-simplified binder and RHS
-	* is used for both recursive and non-recursive bindings
-	* is used for both top-level and non-top-level bindings
-
-It does the following:
-  - tries discarding a dead binding
-  - tries PostInlineUnconditionally
-  - add unfolding [this is the only place we add an unfolding]
-  - add arity
-
-It does *not* attempt to do let-to-case.  Why?  Because it is used for
-	- top-level bindings (when let-to-case is impossible) 
-	- many situations where the "rhs" is known to be a WHNF
-		(so let-to-case is inappropriate).
-
-\begin{code}
-completeLazyBind :: SimplEnv
-		 -> TopLevelFlag	-- Flag stuck into unfolding
-		 -> InId 		-- Old binder
-		 -> OutId		-- New binder
-	         -> OutExpr		-- Simplified RHS
-	   	 -> SimplM (FloatsWith SimplEnv)
--- We return a new SimplEnv, because completeLazyBind may choose to do its work
--- by extending the substitution (e.g. let x = y in ...)
--- The new binding (if any) is returned as part of the floats.
--- NB: the returned SimplEnv has the right SubstEnv, but you should
---     (as usual) use the in-scope-env from the floats
-
-completeLazyBind env top_lvl old_bndr new_bndr new_rhs
-  | postInlineUnconditionally env top_lvl new_bndr occ_info new_rhs unfolding
-  = 		-- Drop the binding
-    tick (PostInlineUnconditionally old_bndr)	`thenSmpl_`
-    returnSmpl (emptyFloats env, extendIdSubst env old_bndr (DoneEx new_rhs))
-		-- Use the substitution to make quite, quite sure that the substitution
-		-- will happen, since we are going to discard the binding
-
-  |  otherwise
-  = let
-		-- Add arity info
-  	new_bndr_info = idInfo new_bndr `setArityInfo` exprArity new_rhs
-
-	-- Add the unfolding *only* for non-loop-breakers
-	-- Making loop breakers not have an unfolding at all 
-	-- means that we can avoid tests in exprIsConApp, for example.
-	-- This is important: if exprIsConApp says 'yes' for a recursive
-	-- thing, then we can get into an infinite loop
-
-	-- If the unfolding is a value, the demand info may
-	-- go pear-shaped, so we nuke it.  Example:
-	--	let x = (a,b) in
-	--	case x of (p,q) -> h p q x
-	-- Here x is certainly demanded. But after we've nuked
-	-- the case, we'll get just
-	--	let x = (a,b) in h a b x
-	-- and now x is not demanded (I'm assuming h is lazy)
-	-- This really happens.  Similarly
-	--	let f = \x -> e in ...f..f...
-	-- After inling f at some of its call sites the original binding may
-	-- (for example) be no longer strictly demanded.
-	-- The solution here is a bit ad hoc...
- 	info_w_unf = new_bndr_info `setUnfoldingInfo` unfolding
-        final_info | loop_breaker		= new_bndr_info
-		   | isEvaldUnfolding unfolding = zapDemandInfo info_w_unf `orElse` info_w_unf
-		   | otherwise			= info_w_unf
-
-	final_id = new_bndr `setIdInfo` final_info
-    in
-		-- These seqs forces the Id, and hence its IdInfo,
-		-- and hence any inner substitutions
-    final_id					`seq`
-    returnSmpl (unitFloat env final_id new_rhs, env)
-
-  where 
-    unfolding    = mkUnfolding (isTopLevel top_lvl) new_rhs
-    loop_breaker = isLoopBreaker occ_info
-    old_info     = idInfo old_bndr
-    occ_info     = occInfo old_info
-\end{code}    
-
-
-
-%************************************************************************
-%*									*
-\subsection[Simplify-simplExpr]{The main function: simplExpr}
-%*									*
-%************************************************************************
-
-The reason for this OutExprStuff stuff is that we want to float *after*
-simplifying a RHS, not before.  If we do so naively we get quadratic
-behaviour as things float out.
-
-To see why it's important to do it after, consider this (real) example:
-
-	let t = f x
-	in fst t
-==>
-	let t = let a = e1
-		    b = e2
-		in (a,b)
-	in fst t
-==>
-	let a = e1
-	    b = e2
-	    t = (a,b)
-	in
-	a	-- Can't inline a this round, cos it appears twice
-==>
-	e1
-
-Each of the ==> steps is a round of simplification.  We'd save a
-whole round if we float first.  This can cascade.  Consider
-
-	let f = g d
-	in \x -> ...f...
-==>
-	let f = let d1 = ..d.. in \y -> e
-	in \x -> ...f...
-==>
-	let d1 = ..d..
-	in \x -> ...(\y ->e)...
-
-Only in this second round can the \y be applied, and it 
-might do the same again.
-
-
-\begin{code}
-simplExpr :: SimplEnv -> CoreExpr -> SimplM CoreExpr
-simplExpr env expr = simplExprC env expr (mkBoringStop expr_ty')
-		   where
-		     expr_ty' = substTy env (exprType expr)
-	-- The type in the Stop continuation, expr_ty', is usually not used
-	-- It's only needed when discarding continuations after finding
-	-- a function that returns bottom.
-	-- Hence the lazy substitution
-
-
-simplExprC :: SimplEnv -> CoreExpr -> SimplCont -> SimplM CoreExpr
-	-- Simplify an expression, given a continuation
-simplExprC env expr cont 
-  = simplExprF env expr cont	`thenSmpl` \ (floats, expr) ->
-    returnSmpl (wrapFloats floats expr)
-
-simplExprF :: SimplEnv -> InExpr -> SimplCont -> SimplM FloatsWithExpr
-	-- Simplify an expression, returning floated binds
-
-simplExprF env (Var v)	        cont = simplVar env v cont
-simplExprF env (Lit lit)	cont = rebuild env (Lit lit) cont
-simplExprF env expr@(Lam _ _)   cont = simplLam env expr cont
-simplExprF env (Note note expr) cont = simplNote env note expr cont
-simplExprF env (App fun arg)    cont = simplExprF env fun (ApplyTo NoDup arg env cont)
-
-simplExprF env (Type ty) cont
-  = ASSERT( contIsRhsOrArg cont )
-    simplType env ty			`thenSmpl` \ ty' ->
-    rebuild env (Type ty') cont
-
-simplExprF env (Case scrut bndr case_ty alts) cont
-  | not (switchIsOn (getSwitchChecker env) NoCaseOfCase)
-  = 	-- Simplify the scrutinee with a Select continuation
-    simplExprF env scrut (Select NoDup bndr alts env cont)
-
-  | otherwise
-  = 	-- If case-of-case is off, simply simplify the case expression
-	-- in a vanilla Stop context, and rebuild the result around it
-    simplExprC env scrut case_cont	`thenSmpl` \ case_expr' ->
-    rebuild env case_expr' cont
-  where
-    case_cont = Select NoDup bndr alts env (mkBoringStop case_ty')
-    case_ty'  = substTy env case_ty	-- c.f. defn of simplExpr
-
-simplExprF env (Let (Rec pairs) body) cont
-  = simplRecBndrs env (map fst pairs) 		`thenSmpl` \ (env, bndrs') -> 
-	-- NB: bndrs' don't have unfoldings or rules
-	-- We add them as we go down
-
-    simplRecBind env NotTopLevel pairs bndrs' 	`thenSmpl` \ (floats, env) ->
-    addFloats env floats 			$ \ env ->
-    simplExprF env body cont
-
--- A non-recursive let is dealt with by simplNonRecBind
-simplExprF env (Let (NonRec bndr rhs) body) cont
-  = simplNonRecBind env bndr rhs env (contResultType cont)	$ \ env ->
-    simplExprF env body cont
-
-
----------------------------------
-simplType :: SimplEnv -> InType -> SimplM OutType
-	-- Kept monadic just so we can do the seqType
-simplType env ty
-  = seqType new_ty   `seq`   returnSmpl new_ty
-  where
-    new_ty = substTy env ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Lambdas}
-%*									*
-%************************************************************************
-
-\begin{code}
-simplLam env fun cont
-  = go env fun cont
-  where
-    zap_it  = mkLamBndrZapper fun (countArgs cont)
-    cont_ty = contResultType cont
-
-      	-- Type-beta reduction
-    go env (Lam bndr body) (ApplyTo _ (Type ty_arg) arg_se body_cont)
-      =	ASSERT( isTyVar bndr )
-	tick (BetaReduction bndr)			`thenSmpl_`
-	simplType (setInScope arg_se env) ty_arg 	`thenSmpl` \ ty_arg' ->
-	go (extendTvSubst env bndr ty_arg') body body_cont
-
-	-- Ordinary beta reduction
-    go env (Lam bndr body) cont@(ApplyTo _ arg arg_se body_cont)
-      = tick (BetaReduction bndr)				`thenSmpl_`
-	simplNonRecBind env (zap_it bndr) arg arg_se cont_ty	$ \ env -> 
-	go env body body_cont
-
-	-- Not enough args, so there are real lambdas left to put in the result
-    go env lam@(Lam _ _) cont
-      = simplLamBndrs env bndrs		`thenSmpl` \ (env, bndrs') ->
-	simplExpr env body 		`thenSmpl` \ body' ->
-	mkLam env bndrs' body' cont	`thenSmpl` \ (floats, new_lam) ->
-	addFloats env floats		$ \ env -> 
-	rebuild env new_lam cont
-      where
-	(bndrs,body) = collectBinders lam
-
-	-- Exactly enough args
-    go env expr cont = simplExprF env expr cont
-
-mkLamBndrZapper :: CoreExpr 	-- Function
-		-> Int		-- Number of args supplied, *including* type args
-		-> Id -> Id	-- Use this to zap the binders
-mkLamBndrZapper fun n_args
-  | n_args >= n_params fun = \b -> b		-- Enough args
-  | otherwise		   = \b -> zapLamIdInfo b
-  where
-	-- NB: we count all the args incl type args
-	-- so we must count all the binders (incl type lambdas)
-    n_params (Note _ e) = n_params e
-    n_params (Lam b e)  = 1 + n_params e
-    n_params other	= 0::Int
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Notes}
-%*									*
-%************************************************************************
-
-\begin{code}
-simplNote env (Coerce to from) body cont
-  = let
-	addCoerce s1 k1 cont 	-- Drop redundant coerces.  This can happen if a polymoprhic
-				-- (coerce a b e) is instantiated with a=ty1 b=ty2 and the
-				-- two are the same. This happens a lot in Happy-generated parsers
-	  | s1 `coreEqType` k1 = cont
-
-	addCoerce s1 k1 (CoerceIt t1 cont)
-		-- 	coerce T1 S1 (coerce S1 K1 e)
-		-- ==>
-		--	e, 			if T1=K1
-		--	coerce T1 K1 e,		otherwise
-		--
-		-- For example, in the initial form of a worker
-		-- we may find 	(coerce T (coerce S (\x.e))) y
-		-- and we'd like it to simplify to e[y/x] in one round 
-		-- of simplification
-	  | t1 `coreEqType` k1  = cont		 	-- The coerces cancel out
-	  | otherwise           = CoerceIt t1 cont	-- They don't cancel, but 
-							-- the inner one is redundant
-
-	addCoerce t1t2 s1s2 (ApplyTo dup arg arg_se cont)
-	  | not (isTypeArg arg),	-- This whole case only works for value args
-					-- Could upgrade to have equiv thing for type apps too	
- 	    Just (s1, s2) <- splitFunTy_maybe s1s2
-		--	(coerce (T1->T2) (S1->S2) F) E
-		-- ===> 
-		--	coerce T2 S2 (F (coerce S1 T1 E))
-		--
-		-- t1t2 must be a function type, T1->T2, because it's applied to something
-		-- but s1s2 might conceivably not be
-		--
-		-- When we build the ApplyTo we can't mix the out-types
-		-- with the InExpr in the argument, so we simply substitute
-		-- to make it all consistent.  It's a bit messy.
-		-- But it isn't a common case.
-	  = let 
-		(t1,t2) = splitFunTy t1t2
-		new_arg = mkCoerce2 s1 t1 (substExpr arg_env arg)
-		arg_env = setInScope arg_se env
-	    in
-	    ApplyTo dup new_arg (zapSubstEnv env) (addCoerce t2 s2 cont)
-			
-	addCoerce to' _ cont = CoerceIt to' cont
-    in
-    simplType env to		`thenSmpl` \ to' ->
-    simplType env from		`thenSmpl` \ from' ->
-    simplExprF env body (addCoerce to' from' cont)
-
-		
--- Hack: we only distinguish subsumed cost centre stacks for the purposes of
--- inlining.  All other CCCSs are mapped to currentCCS.
-simplNote env (SCC cc) e cont
-  = simplExpr (setEnclosingCC env currentCCS) e 	`thenSmpl` \ e' ->
-    rebuild env (mkSCC cc e') cont
-
-simplNote env InlineCall e cont
-  = simplExprF env e (InlinePlease cont)
-
--- See notes with SimplMonad.inlineMode
-simplNote env InlineMe e cont
-  | contIsRhsOrArg cont		-- Totally boring continuation; see notes above
-  =				-- Don't inline inside an INLINE expression
-    simplExpr (setMode inlineMode env )  e	`thenSmpl` \ e' ->
-    rebuild env (mkInlineMe e') cont
-
-  | otherwise  	-- Dissolve the InlineMe note if there's
-		-- an interesting context of any kind to combine with
-		-- (even a type application -- anything except Stop)
-  = simplExprF env e cont
-
-simplNote env (CoreNote s) e cont
-  = simplExpr env e    `thenSmpl` \ e' ->
-    rebuild env (Note (CoreNote s) e') cont
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Dealing with calls}
-%*									*
-%************************************************************************
-
-\begin{code}
-simplVar env var cont
-  = case substId env var of
-	DoneEx e	 -> simplExprF (zapSubstEnv env) e cont
-	ContEx tvs ids e -> simplExprF (setSubstEnv env tvs ids) e cont
-	DoneId var1 occ  -> completeCall (zapSubstEnv env) var1 occ cont
-		-- Note [zapSubstEnv]
-		-- The template is already simplified, so don't re-substitute.
-		-- This is VITAL.  Consider
-		--	let x = e in
-		--	let y = \z -> ...x... in
-		--	\ x -> ...y...
-		-- We'll clone the inner \x, adding x->x' in the id_subst
-		-- Then when we inline y, we must *not* replace x by x' in
-		-- the inlined copy!!
-
----------------------------------------------------------
---	Dealing with a call site
-
-completeCall env var occ_info cont
-  =     -- Simplify the arguments
-    getDOptsSmpl					`thenSmpl` \ dflags ->
-    let
-	chkr			       = getSwitchChecker env
-	(args, call_cont, inline_call) = getContArgs chkr var cont
-	fn_ty			       = idType var
-    in
-    simplifyArgs env fn_ty args (contResultType call_cont)	$ \ env args ->
-
-	-- Next, look for rules or specialisations that match
-	--
-	-- It's important to simplify the args first, because the rule-matcher
-	-- doesn't do substitution as it goes.  We don't want to use subst_args
-	-- (defined in the 'where') because that throws away useful occurrence info,
-	-- and perhaps-very-important specialisations.
-	--
-	-- Some functions have specialisations *and* are strict; in this case,
-	-- we don't want to inline the wrapper of the non-specialised thing; better
-	-- to call the specialised thing instead.
-	-- We used to use the black-listing mechanism to ensure that inlining of 
-	-- the wrapper didn't occur for things that have specialisations till a 
-	-- later phase, so but now we just try RULES first
-	--
-	-- You might think that we shouldn't apply rules for a loop breaker: 
-	-- doing so might give rise to an infinite loop, because a RULE is
-	-- rather like an extra equation for the function:
-	--	RULE:		f (g x) y = x+y
-	--	Eqn:		f a     y = a-y
-	--
-	-- But it's too drastic to disable rules for loop breakers.  
-	-- Even the foldr/build rule would be disabled, because foldr 
-	-- is recursive, and hence a loop breaker:
-	--	foldr k z (build g) = g k z
-	-- So it's up to the programmer: rules can cause divergence
-
-    let
-	in_scope   = getInScope env
-	rules	   = getRules env
-	maybe_rule = case activeRule env of
-			Nothing     -> Nothing	-- No rules apply
-			Just act_fn -> lookupRule act_fn in_scope rules var args 
-    in
-    case maybe_rule of {
-	Just (rule_name, rule_rhs) -> 
-		tick (RuleFired rule_name)			`thenSmpl_`
-		(if dopt Opt_D_dump_inlinings dflags then
-		   pprTrace "Rule fired" (vcat [
-			text "Rule:" <+> ftext rule_name,
-			text "Before:" <+> ppr var <+> sep (map pprParendExpr args),
-			text "After: " <+> pprCoreExpr rule_rhs,
-			text "Cont:  " <+> ppr call_cont])
-		 else
-			id)		$
-		simplExprF env rule_rhs call_cont ;
-	
-	Nothing -> 		-- No rules
-
-	-- Next, look for an inlining
-    let
-	arg_infos = [ interestingArg arg | arg <- args, isValArg arg]
-
-	interesting_cont = interestingCallContext (notNull args)
-						  (notNull arg_infos)
-						  call_cont
-
-    	active_inline = activeInline env var occ_info
-	maybe_inline  = callSiteInline dflags active_inline inline_call occ_info
-				       var arg_infos interesting_cont
-    in
-    case maybe_inline of {
-	Just unfolding  	-- There is an inlining!
-	  ->  tick (UnfoldingDone var)		`thenSmpl_`
-		(if dopt Opt_D_dump_inlinings dflags then
-		   pprTrace "Inlining done" (vcat [
-			text "Before:" <+> ppr var <+> sep (map pprParendExpr args),
-			text "Inlined fn: " <+> ppr unfolding,
-			text "Cont:  " <+> ppr call_cont])
-		 else
-			id)		$
-	      makeThatCall env var unfolding args call_cont
-
-	;
-	Nothing -> 		-- No inlining!
-
-	-- Done
-    rebuild env (mkApps (Var var) args) call_cont
-    }}
-
-makeThatCall :: SimplEnv
-	     -> Id
-	     -> InExpr		-- Inlined function rhs 
-	     -> [OutExpr]	-- Arguments, already simplified
-	     -> SimplCont	-- After the call
-	     -> SimplM FloatsWithExpr
--- Similar to simplLam, but this time 
--- the arguments are already simplified
-makeThatCall orig_env var fun@(Lam _ _) args cont
-  = go orig_env fun args
-  where
-    zap_it = mkLamBndrZapper fun (length args)
-
-      	-- Type-beta reduction
-    go env (Lam bndr body) (Type ty_arg : args)
-      =	ASSERT( isTyVar bndr )
-	tick (BetaReduction bndr)			`thenSmpl_`
-	go (extendTvSubst env bndr ty_arg) body args
-
-	-- Ordinary beta reduction
-    go env (Lam bndr body) (arg : args)
-      = tick (BetaReduction bndr)			`thenSmpl_`
-	simplNonRecX env (zap_it bndr) arg 		$ \ env -> 
-	go env body args
-
-	-- Not enough args, so there are real lambdas left to put in the result
-    go env fun args
-      = simplExprF env fun (pushContArgs orig_env args cont)
-	-- NB: orig_env; the correct environment to capture with
-	-- the arguments.... env has been augmented with substitutions 
-	-- from the beta reductions.
-
-makeThatCall env var fun args cont
-  = simplExprF env fun (pushContArgs env args cont)
-\end{code}		   
-
-
-%************************************************************************
-%*									*
-\subsection{Arguments}
-%*									*
-%************************************************************************
-
-\begin{code}
----------------------------------------------------------
---	Simplifying the arguments of a call
-
-simplifyArgs :: SimplEnv 
-	     -> OutType				-- Type of the function
-	     -> [(InExpr, SimplEnv, Bool)]	-- Details of the arguments
-	     -> OutType				-- Type of the continuation
-	     -> (SimplEnv -> [OutExpr] -> SimplM FloatsWithExpr)
-	     -> SimplM FloatsWithExpr
-
--- [CPS-like because of strict arguments]
-
--- Simplify the arguments to a call.
--- This part of the simplifier may break the no-shadowing invariant
--- Consider
---	f (...(\a -> e)...) (case y of (a,b) -> e')
--- where f is strict in its second arg
--- If we simplify the innermost one first we get (...(\a -> e)...)
--- Simplifying the second arg makes us float the case out, so we end up with
---	case y of (a,b) -> f (...(\a -> e)...) e'
--- So the output does not have the no-shadowing invariant.  However, there is
--- no danger of getting name-capture, because when the first arg was simplified
--- we used an in-scope set that at least mentioned all the variables free in its
--- static environment, and that is enough.
---
--- We can't just do innermost first, or we'd end up with a dual problem:
---	case x of (a,b) -> f e (...(\a -> e')...)
---
--- I spent hours trying to recover the no-shadowing invariant, but I just could
--- not think of an elegant way to do it.  The simplifier is already knee-deep in
--- continuations.  We have to keep the right in-scope set around; AND we have
--- to get the effect that finding (error "foo") in a strict arg position will
--- discard the entire application and replace it with (error "foo").  Getting
--- all this at once is TOO HARD!
-
-simplifyArgs env fn_ty args cont_ty thing_inside
-  = go env fn_ty args thing_inside
-  where
-    go env fn_ty []	    thing_inside = thing_inside env []
-    go env fn_ty (arg:args) thing_inside = simplifyArg env fn_ty arg cont_ty 		$ \ env arg' ->
-					   go env (applyTypeToArg fn_ty arg') args 	$ \ env args' ->
-					   thing_inside env (arg':args')
-
-simplifyArg env fn_ty (Type ty_arg, se, _) cont_ty thing_inside
-  = simplType (setInScope se env) ty_arg 	`thenSmpl` \ new_ty_arg ->
-    thing_inside env (Type new_ty_arg)
-
-simplifyArg env fn_ty (val_arg, arg_se, is_strict) cont_ty thing_inside 
-  | is_strict 
-  = simplStrictArg AnArg env val_arg arg_se arg_ty cont_ty thing_inside
-
-  | otherwise	-- Lazy argument
-		-- DO NOT float anything outside, hence simplExprC
-		-- There is no benefit (unlike in a let-binding), and we'd
-		-- have to be very careful about bogus strictness through 
-		-- floating a demanded let.
-  = simplExprC (setInScope arg_se env) val_arg
-	       (mkBoringStop arg_ty)		`thenSmpl` \ arg1 ->
-   thing_inside env arg1
-  where
-    arg_ty = funArgTy fn_ty
-
-
-simplStrictArg ::  LetRhsFlag
-	        -> SimplEnv		-- The env of the call
-		-> InExpr -> SimplEnv	-- The arg plus its env
-		-> OutType		-- arg_ty: type of the argument
-	        -> OutType		-- cont_ty: Type of thing computed by the context
-	        -> (SimplEnv -> OutExpr -> SimplM FloatsWithExpr)	
-	 			 	-- Takes an expression of type rhs_ty, 
-		 			-- returns an expression of type cont_ty
-					-- The env passed to this continuation is the
-					-- env of the call, plus any new in-scope variables
-	        -> SimplM FloatsWithExpr	-- An expression of type cont_ty
-
-simplStrictArg is_rhs call_env arg arg_env arg_ty cont_ty thing_inside
-  = simplExprF (setInScope arg_env call_env) arg
-	       (ArgOf is_rhs arg_ty cont_ty (\ new_env -> thing_inside (setInScope call_env new_env)))
-  -- Notice the way we use arg_env (augmented with in-scope vars from call_env) 
-  --	to simplify the argument
-  -- and call-env (augmented with in-scope vars from the arg) to pass to the continuation
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{mkAtomicArgs}
-%*									*
-%************************************************************************
-
-mkAtomicArgs takes a putative RHS, checks whether it's a PAP or
-constructor application and, if so, converts it to ANF, so that the 
-resulting thing can be inlined more easily.  Thus
-	x = (f a, g b)
-becomes
-	t1 = f a
-	t2 = g b
-	x = (t1,t2)
-
-There are three sorts of binding context, specified by the two
-boolean arguments
-
-Strict
-   OK-unlifted
-
-N  N	Top-level or recursive			Only bind args of lifted type
-
-N  Y	Non-top-level and non-recursive,	Bind args of lifted type, or
-		but lazy			unlifted-and-ok-for-speculation
-
-Y  Y	Non-top-level, non-recursive,		Bind all args
-		 and strict (demanded)
-	
-
-For example, given
-
-	x = MkC (y div# z)
-
-there is no point in transforming to
-
-	x = case (y div# z) of r -> MkC r
-
-because the (y div# z) can't float out of the let. But if it was
-a *strict* let, then it would be a good thing to do.  Hence the
-context information.
-
-\begin{code}
-mkAtomicArgs :: Bool	-- A strict binding
-	     -> Bool	-- OK to float unlifted args
-	     -> OutExpr
-	     -> SimplM (OrdList (OutId,OutExpr),  -- The floats (unusually) may include
-			OutExpr)		  -- things that need case-binding,
-						  -- if the strict-binding flag is on
-
-mkAtomicArgs is_strict ok_float_unlifted rhs
-  | (Var fun, args) <- collectArgs rhs,				-- It's an application
-    isDataConWorkId fun || valArgCount args < idArity fun	-- And it's a constructor or PAP
-  = go fun nilOL [] args	-- Have a go
-
-  | otherwise = bale_out	-- Give up
-
-  where
-    bale_out = returnSmpl (nilOL, rhs)
-
-    go fun binds rev_args [] 
-	= returnSmpl (binds, mkApps (Var fun) (reverse rev_args))
-
-    go fun binds rev_args (arg : args) 
-	| exprIsTrivial arg 	-- Easy case
-	= go fun binds (arg:rev_args) args
-
-	| not can_float_arg	-- Can't make this arg atomic
-  	= bale_out		-- ... so give up
-
-	| otherwise	-- Don't forget to do it recursively
-			-- E.g.  x = a:b:c:[]
-	=  mkAtomicArgs is_strict ok_float_unlifted arg	`thenSmpl` \ (arg_binds, arg') ->
-	   newId FSLIT("a") arg_ty			`thenSmpl` \ arg_id ->
-	   go fun ((arg_binds `snocOL` (arg_id,arg')) `appOL` binds) 
-	      (Var arg_id : rev_args) args
-	where
-	  arg_ty        = exprType arg
-	  can_float_arg =  is_strict 
-			|| not (isUnLiftedType arg_ty)
-			|| (ok_float_unlifted && exprOkForSpeculation arg)
-
-
-addAtomicBinds :: SimplEnv -> [(OutId,OutExpr)]
-	       -> (SimplEnv -> SimplM (FloatsWith a))
-	       -> SimplM (FloatsWith a)
-addAtomicBinds env []         thing_inside = thing_inside env
-addAtomicBinds env ((v,r):bs) thing_inside = addAuxiliaryBind env (NonRec v r) $ \ env -> 
-					     addAtomicBinds env bs thing_inside
-
-addAtomicBindsE :: SimplEnv -> [(OutId,OutExpr)]
-	 	-> (SimplEnv -> SimplM FloatsWithExpr)
-		-> SimplM FloatsWithExpr
--- Same again, but this time we're in an expression context,
--- and may need to do some case bindings
-
-addAtomicBindsE env [] thing_inside 
-  = thing_inside env
-addAtomicBindsE env ((v,r):bs) thing_inside 
-  | needsCaseBinding (idType v) r
-  = addAtomicBindsE (addNewInScopeIds env [v]) bs thing_inside	`thenSmpl` \ (floats, expr) ->
-    WARN( exprIsTrivial expr, ppr v <+> pprCoreExpr expr )
-    (let body = wrapFloats floats expr in 
-     returnSmpl (emptyFloats env, Case r v (exprType body) [(DEFAULT,[],body)]))
-
-  | otherwise
-  = addAuxiliaryBind env (NonRec v r) 	$ \ env -> 
-    addAtomicBindsE env bs thing_inside
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The main rebuilder}
-%*									*
-%************************************************************************
-
-\begin{code}
-rebuild :: SimplEnv -> OutExpr -> SimplCont -> SimplM FloatsWithExpr
-
-rebuild env expr (Stop _ _ _)		      = rebuildDone env expr
-rebuild env expr (ArgOf _ _ _ cont_fn)	      = cont_fn env expr
-rebuild env expr (CoerceIt to_ty cont)	      = rebuild env (mkCoerce to_ty expr) cont
-rebuild env expr (InlinePlease cont) 	      = rebuild env (Note InlineCall expr) cont
-rebuild env expr (Select _ bndr alts se cont) = rebuildCase (setInScope se env) expr bndr alts cont
-rebuild env expr (ApplyTo _ arg se cont)      = rebuildApp  (setInScope se env) expr arg cont
-
-rebuildApp env fun arg cont
-  = simplExpr env arg	`thenSmpl` \ arg' ->
-    rebuild env (App fun arg') cont
-
-rebuildDone env expr = returnSmpl (emptyFloats env, expr)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Functions dealing with a case}
-%*									*
-%************************************************************************
-
-Blob of helper functions for the "case-of-something-else" situation.
-
-\begin{code}
----------------------------------------------------------
--- 	Eliminate the case if possible
-
-rebuildCase :: SimplEnv
-	    -> OutExpr		-- Scrutinee
-	    -> InId		-- Case binder
-	    -> [InAlt]		-- Alternatives (inceasing order)
-	    -> SimplCont
-	    -> SimplM FloatsWithExpr
-
-rebuildCase env scrut case_bndr alts cont
-  | Just (con,args) <- exprIsConApp_maybe scrut	
-	-- Works when the scrutinee is a variable with a known unfolding
-	-- as well as when it's an explicit constructor application
-  = knownCon env (DataAlt con) args case_bndr alts cont
-
-  | Lit lit <- scrut	-- No need for same treatment as constructors
-			-- because literals are inlined more vigorously
-  = knownCon env (LitAlt lit) [] case_bndr alts cont
-
-  | otherwise
-  = 	-- Prepare the alternatives.
-    prepareAlts scrut case_bndr alts		`thenSmpl` \ (better_alts, handled_cons) -> 
-	
-	-- Prepare the continuation;
-	-- The new subst_env is in place
-    prepareCaseCont env better_alts cont	`thenSmpl` \ (floats, (dup_cont, nondup_cont)) ->
-    addFloats env floats			$ \ env ->	
-
-    let
-	-- The case expression is annotated with the result type of the continuation
-	-- This may differ from the type originally on the case.  For example
-	-- 	case(T) (case(Int#) a of { True -> 1#; False -> 0# }) of
-	--	   a# -> <blob>
-	-- ===>
-	--	let j a# = <blob>
-	--	in case(T) a of { True -> j 1#; False -> j 0# }
-	-- Note that the case that scrutinises a now returns a T not an Int#
-	res_ty' = contResultType dup_cont
-    in
-
-	-- Deal with case binder
-    simplCaseBinder env scrut case_bndr 	`thenSmpl` \ (alt_env, case_bndr') ->
-
-	-- Deal with the case alternatives
-    simplAlts alt_env handled_cons
-	      case_bndr' better_alts dup_cont 	`thenSmpl` \ alts' ->
-
-	-- Put the case back together
-    mkCase scrut case_bndr' res_ty' alts'	`thenSmpl` \ case_expr ->
-
-	-- Notice that rebuildDone returns the in-scope set from env, not alt_env
-	-- The case binder *not* scope over the whole returned case-expression
-    rebuild env case_expr nondup_cont
-\end{code}
-
-simplCaseBinder checks whether the scrutinee is a variable, v.  If so,
-try to eliminate uses of v in the RHSs in favour of case_bndr; that
-way, there's a chance that v will now only be used once, and hence
-inlined.
-
-Note 1
-~~~~~~
-There is a time we *don't* want to do that, namely when
--fno-case-of-case is on.  This happens in the first simplifier pass,
-and enhances full laziness.  Here's the bad case:
-	f = \ y -> ...(case x of I# v -> ...(case x of ...) ... )
-If we eliminate the inner case, we trap it inside the I# v -> arm,
-which might prevent some full laziness happening.  I've seen this
-in action in spectral/cichelli/Prog.hs:
-	 [(m,n) | m <- [1..max], n <- [1..max]]
-Hence the check for NoCaseOfCase.
-
-Note 2
-~~~~~~
-There is another situation when we don't want to do it.  If we have
-
-    case x of w1 { DEFAULT -> case x of w2 { A -> e1; B -> e2 }
-	           ...other cases .... }
-
-We'll perform the binder-swap for the outer case, giving
-
-    case x of w1 { DEFAULT -> case w1 of w2 { A -> e1; B -> e2 } 
-	           ...other cases .... }
-
-But there is no point in doing it for the inner case, because w1 can't
-be inlined anyway.  Furthermore, doing the case-swapping involves
-zapping w2's occurrence info (see paragraphs that follow), and that
-forces us to bind w2 when doing case merging.  So we get
-
-    case x of w1 { A -> let w2 = w1 in e1
-		   B -> let w2 = w1 in e2
-	           ...other cases .... }
-
-This is plain silly in the common case where w2 is dead.
-
-Even so, I can't see a good way to implement this idea.  I tried
-not doing the binder-swap if the scrutinee was already evaluated
-but that failed big-time:
-
-	data T = MkT !Int
-
-	case v of w  { MkT x ->
-	case x of x1 { I# y1 ->
-	case x of x2 { I# y2 -> ...
-
-Notice that because MkT is strict, x is marked "evaluated".  But to
-eliminate the last case, we must either make sure that x (as well as
-x1) has unfolding MkT y1.  THe straightforward thing to do is to do
-the binder-swap.  So this whole note is a no-op.
-
-Note 3
-~~~~~~
-If we replace the scrutinee, v, by tbe case binder, then we have to nuke
-any occurrence info (eg IAmDead) in the case binder, because the
-case-binder now effectively occurs whenever v does.  AND we have to do
-the same for the pattern-bound variables!  Example:
-
-	(case x of { (a,b) -> a }) (case x of { (p,q) -> q })
-
-Here, b and p are dead.  But when we move the argment inside the first
-case RHS, and eliminate the second case, we get
-
-	case x of { (a,b) -> a b }
-
-Urk! b is alive!  Reason: the scrutinee was a variable, and case elimination
-happened.  
-
-Indeed, this can happen anytime the case binder isn't dead:
-	case <any> of x { (a,b) -> 
-        case x of { (p,q) -> p } }
-Here (a,b) both look dead, but come alive after the inner case is eliminated.
-The point is that we bring into the envt a binding
-	let x = (a,b) 
-after the outer case, and that makes (a,b) alive.  At least we do unless
-the case binder is guaranteed dead.
-
-\begin{code}
-simplCaseBinder env (Var v) case_bndr
-  | not (switchIsOn (getSwitchChecker env) NoCaseOfCase)
-
--- Failed try [see Note 2 above]
---     not (isEvaldUnfolding (idUnfolding v))
-
-  = simplBinder env (zap case_bndr)		`thenSmpl` \ (env, case_bndr') ->
-    returnSmpl (modifyInScope env v case_bndr', case_bndr')
-	-- We could extend the substitution instead, but it would be
-	-- a hack because then the substitution wouldn't be idempotent
-	-- any more (v is an OutId).  And this does just as well.
-  where
-    zap b = b `setIdOccInfo` NoOccInfo
-	    
-simplCaseBinder env other_scrut case_bndr 
-  = simplBinder env case_bndr 		`thenSmpl` \ (env, case_bndr') ->
-    returnSmpl (env, case_bndr')
-\end{code}
-
-
-
-\begin{code}
-simplAlts :: SimplEnv 
-	  -> [AltCon]			-- Alternatives the scrutinee can't be
-					-- in the default case
-	  -> OutId			-- Case binder
-	  -> [InAlt] -> SimplCont
-	  -> SimplM [OutAlt]		-- Includes the continuation
-
-simplAlts env handled_cons case_bndr' alts cont'
-  = do	{ mb_alts <- mapSmpl simpl_alt alts
-	; return [alt' | Just (_, alt') <- mb_alts] }
-	-- Filter out the alternatives that are inaccessible
-  where
-    simpl_alt alt = simplAlt env handled_cons case_bndr' alt cont'
-
-simplAlt :: SimplEnv -> [AltCon] -> OutId -> InAlt -> SimplCont
-	 -> SimplM (Maybe (TvSubstEnv, OutAlt))
--- Simplify an alternative, returning the type refinement for the 
--- alternative, if the alternative does any refinement at all
--- Nothing => the alternative is inaccessible
-
-simplAlt env handled_cons case_bndr' (DEFAULT, bndrs, rhs) cont'
-  = ASSERT( null bndrs )
-    simplExprC env' rhs cont'	`thenSmpl` \ rhs' ->
-    returnSmpl (Just (emptyVarEnv, (DEFAULT, [], rhs')))
-  where
-    env' = mk_rhs_env env case_bndr' (mkOtherCon handled_cons)
-	-- Record the constructors that the case-binder *can't* be.
-
-simplAlt env handled_cons case_bndr' (LitAlt lit, bndrs, rhs) cont'
-  = ASSERT( null bndrs )
-    simplExprC env' rhs cont'	`thenSmpl` \ rhs' ->
-    returnSmpl (Just (emptyVarEnv, (LitAlt lit, [], rhs')))
-  where
-    env' = mk_rhs_env env case_bndr' (mkUnfolding False (Lit lit))
-
-simplAlt env handled_cons case_bndr' (DataAlt con, vs, rhs) cont'
-  | isVanillaDataCon con
-  = 	-- Deal with the pattern-bound variables
-	-- Mark the ones that are in ! positions in the data constructor
-	-- as certainly-evaluated.
-	-- NB: it happens that simplBinders does *not* erase the OtherCon
-	--     form of unfolding, so it's ok to add this info before 
-	--     doing simplBinders
-    simplBinders env (add_evals con vs)		`thenSmpl` \ (env, vs') ->
-
-		-- Bind the case-binder to (con args)
-    let unf       = mkUnfolding False (mkConApp con con_args)
-	inst_tys' = tyConAppArgs (idType case_bndr')
-	con_args  = map Type inst_tys' ++ map varToCoreExpr vs' 
-	env'      = mk_rhs_env env case_bndr' unf
-    in
-    simplExprC env' rhs cont'	`thenSmpl` \ rhs' ->
-    returnSmpl (Just (emptyVarEnv, (DataAlt con, vs', rhs')))
-
-  | otherwise	-- GADT case
-  = let
-	(tvs,ids) = span isTyVar vs
-    in
-    simplBinders env tvs			`thenSmpl` \ (env1, tvs') ->
-    case coreRefineTys con tvs' (idType case_bndr') of {
-	Nothing 	-- Inaccessible
-	    | opt_PprStyle_Debug	-- Hack: if debugging is on, generate an error case 
-					--  	 so we can see it
-	    ->	let rhs' = mkApps (Var eRROR_ID) 
-				[Type (substTy env (exprType rhs)),
-				 Lit (mkStringLit "Impossible alternative (GADT)")]
-		in 
-		simplBinders env1 ids		`thenSmpl` \ (env2, ids') -> 
-		returnSmpl (Just (emptyVarEnv, (DataAlt con, tvs' ++ ids', rhs'))) 
-
-	    | otherwise	-- Filter out the inaccessible branch
-	    -> return Nothing ;	
-
-	Just refine@(tv_subst_env, _) -> 	-- The normal case
-
-    let 
-	env2 = refineSimplEnv env1 refine
-	-- Simplify the Ids in the refined environment, so their types
-	-- reflect the refinement.  Usually this doesn't matter, but it helps
-	-- in mkDupableAlt, when we want to float a lambda that uses these binders
-	-- Furthermore, it means the binders contain maximal type information
-    in
-    simplBinders env2 (add_evals con ids)	`thenSmpl` \ (env3, ids') ->
-    let unf        = mkUnfolding False con_app
-	con_app    = mkConApp con con_args
-	con_args   = map varToCoreExpr vs' 	-- NB: no inst_tys'
-	env_w_unf  = mk_rhs_env env3 case_bndr' unf
-	vs'	   = tvs' ++ ids'
-    in
-    simplExprC env_w_unf rhs cont'	`thenSmpl` \ rhs' ->
-    returnSmpl (Just (tv_subst_env, (DataAlt con, vs', rhs'))) }
-
-  where
-	-- add_evals records the evaluated-ness of the bound variables of
-	-- a case pattern.  This is *important*.  Consider
-	--	data T = T !Int !Int
-	--
-	--	case x of { T a b -> T (a+1) b }
-	--
-	-- We really must record that b is already evaluated so that we don't
-	-- go and re-evaluate it when constructing the result.
-    add_evals dc vs = cat_evals dc vs (dataConRepStrictness dc)
-
-    cat_evals dc vs strs
-	= go vs strs
-	where
-	  go [] [] = []
-	  go (v:vs) strs | isTyVar v = v : go vs strs
-	  go (v:vs) (str:strs)
-	    | isMarkedStrict str = evald_v  : go vs strs
-	    | otherwise          = zapped_v : go vs strs
-	    where
-	      zapped_v = zap_occ_info v
-	      evald_v  = zapped_v `setIdUnfolding` evaldUnfolding
-	  go _ _ = pprPanic "cat_evals" (ppr dc $$ ppr vs $$ ppr strs)
-
-	-- If the case binder is alive, then we add the unfolding
-	--	case_bndr = C vs
-	-- to the envt; so vs are now very much alive
-    zap_occ_info | isDeadBinder case_bndr' = \id -> id
-		 | otherwise		   = \id -> id `setIdOccInfo` NoOccInfo
-
-mk_rhs_env env case_bndr' case_bndr_unf
-  = modifyInScope env case_bndr' (case_bndr' `setIdUnfolding` case_bndr_unf)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Known constructor}
-%*									*
-%************************************************************************
-
-We are a bit careful with occurrence info.  Here's an example
-
-	(\x* -> case x of (a*, b) -> f a) (h v, e)
-
-where the * means "occurs once".  This effectively becomes
-	case (h v, e) of (a*, b) -> f a)
-and then
-	let a* = h v; b = e in f a
-and then
-	f (h v)
-
-All this should happen in one sweep.
-
-\begin{code}
-knownCon :: SimplEnv -> AltCon -> [OutExpr]
-	 -> InId -> [InAlt] -> SimplCont
-	 -> SimplM FloatsWithExpr
-
-knownCon env con args bndr alts cont
-  = tick (KnownBranch bndr)	`thenSmpl_`
-    case findAlt con alts of
-	(DEFAULT, bs, rhs)     -> ASSERT( null bs )
-				  simplNonRecX env bndr scrut	$ \ env ->
-					-- This might give rise to a binding with non-atomic args
-					-- like x = Node (f x) (g x)
-					-- but no harm will be done
-				  simplExprF env rhs cont
-				where
-				  scrut = case con of
-					    LitAlt lit -> Lit lit
-					    DataAlt dc -> mkConApp dc args
-
-	(LitAlt lit, bs, rhs) ->  ASSERT( null bs )
-				  simplNonRecX env bndr (Lit lit)	$ \ env ->
-				  simplExprF env rhs cont
-
-	(DataAlt dc, bs, rhs)  
-		-> ASSERT( n_drop_tys + length bs == length args )
-		   bind_args env bs (drop n_drop_tys args)	$ \ env ->
-		   let
-			con_app  = mkConApp dc (take n_drop_tys args ++ con_args)
-			con_args = [substExpr env (varToCoreExpr b) | b <- bs]
-					-- args are aready OutExprs, but bs are InIds
-		   in
-		   simplNonRecX env bndr con_app		$ \ env ->
-		   simplExprF env rhs cont
-	        where
-		   n_drop_tys | isVanillaDataCon dc = tyConArity (dataConTyCon dc)
-			      | otherwise	    = 0
-			-- Vanilla data constructors lack type arguments in the pattern
-
--- Ugh!
-bind_args env [] _ thing_inside = thing_inside env
-
-bind_args env (b:bs) (Type ty : args) thing_inside
-  = ASSERT( isTyVar b )
-    bind_args (extendTvSubst env b ty) bs args thing_inside
-    
-bind_args env (b:bs) (arg : args) thing_inside
-  = ASSERT( isId b )
-    simplNonRecX env b arg	$ \ env ->
-    bind_args env bs args thing_inside
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Duplicating continuations}
-%*									*
-%************************************************************************
-
-\begin{code}
-prepareCaseCont :: SimplEnv
-		-> [InAlt] -> SimplCont
-	        -> SimplM (FloatsWith (SimplCont,SimplCont)) 	
-			-- Return a duplicatable continuation, a non-duplicable part 
-			-- plus some extra bindings
-
-	-- No need to make it duplicatable if there's only one alternative
-prepareCaseCont env [alt] cont = returnSmpl (emptyFloats env, (cont, mkBoringStop (contResultType cont)))
-prepareCaseCont env alts  cont = mkDupableCont env cont
-\end{code}
-
-\begin{code}
-mkDupableCont :: SimplEnv -> SimplCont 
-	      -> SimplM (FloatsWith (SimplCont, SimplCont))
-
-mkDupableCont env cont
-  | contIsDupable cont
-  = returnSmpl (emptyFloats env, (cont, mkBoringStop (contResultType cont)))
-
-mkDupableCont env (CoerceIt ty cont)
-  = mkDupableCont env cont		`thenSmpl` \ (floats, (dup_cont, nondup_cont)) ->
-    returnSmpl (floats, (CoerceIt ty dup_cont, nondup_cont))
-
-mkDupableCont env (InlinePlease cont)
-  = mkDupableCont env cont		`thenSmpl` \ (floats, (dup_cont, nondup_cont)) ->
-    returnSmpl (floats, (InlinePlease dup_cont, nondup_cont))
-
-mkDupableCont env cont@(ArgOf _ arg_ty _ _)
-  =  returnSmpl (emptyFloats env, (mkBoringStop arg_ty, cont))
-  	-- Do *not* duplicate an ArgOf continuation
-	-- Because ArgOf continuations are opaque, we gain nothing by
-	-- propagating them into the expressions, and we do lose a lot.
-	-- Here's an example:
-	--	&& (case x of { T -> F; F -> T }) E
-	-- Now, && is strict so we end up simplifying the case with
-	-- an ArgOf continuation.  If we let-bind it, we get
-	--
-	--	let $j = \v -> && v E
-	--	in simplExpr (case x of { T -> F; F -> T })
-	--		     (ArgOf (\r -> $j r)
-	-- And after simplifying more we get
-	--
-	--	let $j = \v -> && v E
-	--	in case of { T -> $j F; F -> $j T }
-	-- Which is a Very Bad Thing
-	--
-	-- The desire not to duplicate is the entire reason that
-	-- mkDupableCont returns a pair of continuations.
-	--
-	-- The original plan had:
-  	-- e.g. 	(...strict-fn...) [...hole...]
-	--	==>
-	--		let $j = \a -> ...strict-fn...
-	--		in $j [...hole...]
-
-mkDupableCont env (ApplyTo _ arg se cont)
-  = 	-- e.g. 	[...hole...] (...arg...)
-	--	==>
-	--		let a = ...arg... 
-	--		in [...hole...] a
-    simplExpr (setInScope se env) arg			`thenSmpl` \ arg' ->
-
-    mkDupableCont env cont				`thenSmpl` \ (floats, (dup_cont, nondup_cont)) ->
-    addFloats env floats				$ \ env ->
-
-    if exprIsDupable arg' then
-	returnSmpl (emptyFloats env, (ApplyTo OkToDup arg' (zapSubstEnv se) dup_cont, nondup_cont))
-    else
-    newId FSLIT("a") (exprType arg')			`thenSmpl` \ arg_id ->
-
-    tick (CaseOfCase arg_id)				`thenSmpl_`
-	-- Want to tick here so that we go round again,
-	-- and maybe copy or inline the code.
-	-- Not strictly CaseOfCase, but never mind
-
-    returnSmpl (unitFloat env arg_id arg', 
-		(ApplyTo OkToDup (Var arg_id) (zapSubstEnv se) dup_cont,
-		 nondup_cont))
-	-- But what if the arg should be case-bound? 
-	-- This has been this way for a long time, so I'll leave it,
-	-- but I can't convince myself that it's right.
-
-mkDupableCont env (Select _ case_bndr alts se cont)
-  = 	-- e.g.		(case [...hole...] of { pi -> ei })
-	--	===>
-	--		let ji = \xij -> ei 
-	--		in case [...hole...] of { pi -> ji xij }
-    tick (CaseOfCase case_bndr)					`thenSmpl_`
-    let
-	alt_env = setInScope se env
-    in
-    prepareCaseCont alt_env alts cont				`thenSmpl` \ (floats1, (dup_cont, nondup_cont)) ->
-    addFloats alt_env floats1 					$ \ alt_env ->
-
-    simplBinder alt_env case_bndr				`thenSmpl` \ (alt_env, case_bndr') ->
-	-- NB: simplBinder does not zap deadness occ-info, so
-	-- a dead case_bndr' will still advertise its deadness
-	-- This is really important because in
-	--	case e of b { (# a,b #) -> ... }
-	-- b is always dead, and indeed we are not allowed to bind b to (# a,b #),
-	-- which might happen if e was an explicit unboxed pair and b wasn't marked dead.
-	-- In the new alts we build, we have the new case binder, so it must retain
-	-- its deadness.
-
-    mkDupableAlts alt_env case_bndr' alts dup_cont	`thenSmpl` \ (floats2, alts') ->
-    addFloats alt_env floats2 				$ \ alt_env ->
-    returnSmpl (emptyFloats alt_env, 
-		(Select OkToDup case_bndr' alts' (zapSubstEnv se) 
-			(mkBoringStop (contResultType dup_cont)),
-		 nondup_cont))
-
-mkDupableAlts :: SimplEnv -> OutId -> [InAlt] -> SimplCont
-	      -> SimplM (FloatsWith [InAlt])
--- Absorbs the continuation into the new alternatives
-
-mkDupableAlts env case_bndr' alts dupable_cont 
-  = go env alts
-  where
-    go env [] = returnSmpl (emptyFloats env, [])
-    go env (alt:alts)
-	= do { (floats1, mb_alt') <- mkDupableAlt env case_bndr' dupable_cont alt
-	     ; addFloats env floats1	$ \ env -> do
-	     { (floats2, alts') <- go env alts
-	     ; returnSmpl (floats2, case mb_alt' of
-					Just alt' -> alt' : alts'
-					Nothing   -> alts'
-			  )}}
-					
-mkDupableAlt env case_bndr' cont alt
-  = simplAlt env [] case_bndr' alt cont		`thenSmpl` \ mb_stuff ->
-    case mb_stuff of {
-	Nothing -> returnSmpl (emptyFloats env, Nothing) ;
-
-	Just (reft, (con, bndrs', rhs')) ->
-	-- Safe to say that there are no handled-cons for the DEFAULT case
-
-    if exprIsDupable rhs' then
-	returnSmpl (emptyFloats env, Just (con, bndrs', rhs'))
-   	-- It is worth checking for a small RHS because otherwise we
-	-- get extra let bindings that may cause an extra iteration of the simplifier to
-	-- inline back in place.  Quite often the rhs is just a variable or constructor.
-	-- The Ord instance of Maybe in PrelMaybe.lhs, for example, took several extra
-	-- iterations because the version with the let bindings looked big, and so wasn't
-	-- inlined, but after the join points had been inlined it looked smaller, and so
-	-- was inlined.
-	--
-	-- NB: we have to check the size of rhs', not rhs. 
-	-- Duplicating a small InAlt might invalidate occurrence information
-	-- However, if it *is* dupable, we return the *un* simplified alternative,
-	-- because otherwise we'd need to pair it up with an empty subst-env....
-	-- but we only have one env shared between all the alts.
-	-- (Remember we must zap the subst-env before re-simplifying something).
-	-- Rather than do this we simply agree to re-simplify the original (small) thing later.
-
-    else
-    let
-	rhs_ty'     = exprType rhs'
-        used_bndrs' = filter abstract_over (case_bndr' : bndrs')
-	abstract_over bndr
-	  | isTyVar bndr = not (bndr `elemVarEnv` reft)
-		-- Don't abstract over tyvar binders which are refined away
-		-- See Note [Refinement] below
-	  | otherwise	 = not (isDeadBinder bndr)
-		-- The deadness info on the new Ids is preserved by simplBinders
-    in
-	-- If we try to lift a primitive-typed something out
-	-- for let-binding-purposes, we will *caseify* it (!),
-	-- with potentially-disastrous strictness results.  So
-	-- instead we turn it into a function: \v -> e
-	-- where v::State# RealWorld#.  The value passed to this function
-	-- is realworld#, which generates (almost) no code.
-
-	-- There's a slight infelicity here: we pass the overall 
-	-- case_bndr to all the join points if it's used in *any* RHS,
-	-- because we don't know its usage in each RHS separately
-
-	-- We used to say "&& isUnLiftedType rhs_ty'" here, but now
-	-- we make the join point into a function whenever used_bndrs'
-	-- is empty.  This makes the join-point more CPR friendly. 
-	-- Consider:	let j = if .. then I# 3 else I# 4
-	--		in case .. of { A -> j; B -> j; C -> ... }
-	--
-	-- Now CPR doesn't w/w j because it's a thunk, so
-	-- that means that the enclosing function can't w/w either,
-	-- which is a lose.  Here's the example that happened in practice:
-	--	kgmod :: Int -> Int -> Int
-	--	kgmod x y = if x > 0 && y < 0 || x < 0 && y > 0
-	--	            then 78
-	--		    else 5
-	--
-	-- I have seen a case alternative like this:
-	--	True -> \v -> ...
-	-- It's a bit silly to add the realWorld dummy arg in this case, making
-	--	$j = \s v -> ...
-	--	   True -> $j s
-	-- (the \v alone is enough to make CPR happy) but I think it's rare
-
-    ( if not (any isId used_bndrs')
-	then newId FSLIT("w") realWorldStatePrimTy  	`thenSmpl` \ rw_id ->
-	     returnSmpl ([rw_id], [Var realWorldPrimId])
-	else 
-	     returnSmpl (used_bndrs', map varToCoreExpr used_bndrs')
-    )							`thenSmpl` \ (final_bndrs', final_args) ->
-
-	-- See comment about "$j" name above
-    newId FSLIT("$j") (mkPiTypes final_bndrs' rhs_ty')	`thenSmpl` \ join_bndr ->
-	-- Notice the funky mkPiTypes.  If the contructor has existentials
-	-- it's possible that the join point will be abstracted over
-	-- type varaibles as well as term variables.
-	--  Example:  Suppose we have
-	--	data T = forall t.  C [t]
-	--  Then faced with
-	--	case (case e of ...) of
-	--	    C t xs::[t] -> rhs
-	--  We get the join point
-	--	let j :: forall t. [t] -> ...
-	--	    j = /\t \xs::[t] -> rhs
-	--	in
-	--	case (case e of ...) of
-	--	    C t xs::[t] -> j t xs
-    let 
-	-- We make the lambdas into one-shot-lambdas.  The
-	-- join point is sure to be applied at most once, and doing so
-	-- prevents the body of the join point being floated out by
-	-- the full laziness pass
-	really_final_bndrs     = map one_shot final_bndrs'
-	one_shot v | isId v    = setOneShotLambda v
-		   | otherwise = v
-	join_rhs  = mkLams really_final_bndrs rhs'
-	join_call = mkApps (Var join_bndr) final_args
-    in
-    returnSmpl (unitFloat env join_bndr join_rhs, Just (con, bndrs', join_call)) }
-\end{code}
-
-Note [Refinement]
-~~~~~~~~~~~~~~~~~
-Consider
-	data T a where
-	  MkT :: a -> b -> T a
-
-	f = /\a. \(w::a).
-	   case (case ...) of
-		  MkT a' b (p::a') (q::b) -> [p,w]
-
-The danger is that we'll make a join point
-	
-	j a' p = [p,w]
-
-and that's ill-typed, because (p::a') but (w::a).  
-
-Solution so far: don't abstract over a', because the type refinement
-maps [a' -> a] .  Ultimately that won't work when real refinement goes on.
-
-Then we must abstract over any refined free variables.  Hmm.  Maybe we 
-could just abstract over *all* free variables, thereby lambda-lifting
-the join point?   We should try this.
diff --git a/ghc/compiler/simplCore/simplifier.tib b/ghc/compiler/simplCore/simplifier.tib
deleted file mode 100644
index 18acd27943..0000000000
--- a/ghc/compiler/simplCore/simplifier.tib
+++ /dev/null
@@ -1,771 +0,0 @@
-% Andre:
-%
-% - I'd like the transformation rules to appear clearly-identified in
-% a box of some kind, so they can be distinguished from the examples.
-%
-
-
-
-\documentstyle[slpj,11pt]{article}
-
-\renewcommand{\textfraction}{0.2}
-\renewcommand{\floatpagefraction}{0.7}
-
-\begin{document}
-
-\title{How to simplify matters}
-
-\author{Simon Peyton Jones and Andre Santos\\ 
-Department of Computing Science, University of Glasgow, G12 8QQ \\
-	@simonpj@@dcs.gla.ac.uk@
-}
-
-\maketitle
-
-
-\section{Motivation}
-
-Quite a few compilers use the {\em compilation by transformation} idiom.
-The idea is that as much of possible of the compilation process is
-expressed as correctness-preserving transformations, each of which
-transforms a program into a semantically-equivalent
-program that (hopefully) executes more quickly or in less space.
-Functional languages are particularly amenable to this approach because
-they have a particularly rich family of possible transformations.
-Examples of transformation-based compilers
-include the Orbit compiler,[.kranz orbit thesis.]
-Kelsey's compilers,[.kelsey thesis, hudak kelsey principles 1989.]
-the New Jersey SML compiler,[.appel compiling with continuations.]
-and the Glasgow Haskell compiler.[.ghc JFIT.]  Of course many, perhaps most, 
-other compilers also use transformation to some degree.
-
-Compilation by transformation uses automatic transformations; that is, those
-which can safely be applied automatically by a compiler. There
-is also a whole approach to programming, which we might call {\em programming by transformation},
-in which the programmer manually transforms an inefficient specification into
-an efficient program. This development process might be supported by
-a programming environment in which does the book keeping, but the key steps
-are guided by the programmer.  We focus exclusively on automatic transformations
-in this paper.
-
-Automatic program transformations seem to fall into two broad categories:
-\begin{itemize}
-\item {\bf Glamorous transformations} are global, sophisticated,
-intellectually satisfying transformations, sometimes guided by some
-interesting kind of analysis.
-Examples include: 
-lambda lifting,[.johnsson lambda lifting.]
-full laziness,[.hughes thesis, lester spe.]
-closure conversion,[.appel jim 1989.]
-deforestation,[.wadler 1990 deforestation, marlow wadler deforestation Glasgow92, chin phd 1990 march, gill launchbury.]
-transformations based on strictness analysis,[.peyton launchbury unboxed.]
-and so on.  It is easy to write papers about these sorts of transformations.
-
-\item {\bf Humble transformations} are small, simple, local transformations, 
-which individually look pretty trivial.  Here are two simple examples\footnote{
-The notation @E[]@ stands for an arbitrary expression with zero or more holes.
-The notation @E[e]@ denotes @E[]@ with the holes filled in by the expression @e@.
-We implicitly assume that no name-capture happens --- it's just
-a short-hand, not an algorithm.
-}:
-@
-  let x = y in E[x]   	   ===>   E[y]
-
-  case (x:xs) of 	   ===>   E1[x,xs]
-    (y:ys) -> E1[y,ys]	
-    []     -> E2
-@
-Transformations of this kind are almost embarassingly simple.  How could
-anyone write a paper about them?
-\end{itemize}
-This paper is about humble transformations, and how to implement them. 
-Although each individual
-transformation is simple enough, there is a scaling issue:  
-there are a large number of candidate transformations to consider, and
-there are a very large number of opportunities to apply them.
-
-In the Glasgow Haskell compiler, all humble transformations
-are performed by the so-called {\em simplifier}.  
-Our goal in this paper is to give an overview of how the simplifier works, what
-transformations it applies, and what issues arose in its design.
-
-\section{The language}
-
-Mutter mutter.  Important points:
-\begin{itemize}
-\item Second order lambda calculus.
-\item Arguments are variables.
-\item Unboxed data types, and unboxed cases.
-\end{itemize}
-Less important points:
-\begin{itemize}
-\item Constructors and primitives are saturated.
-\item if-then-else desugared to @case@
-\end{itemize}
-
-Give data type.
-
-\section{Transformations}
-
-This section lists all the transformations implemented by the simplifier.
-Because it is a complete list, it is a long one.
-We content ourselves with a brief statement of each transformation, 
-augmented with forward references to Section~\ref{sect:composing}
-which gives examples of the ways in which the transformations can compose together.
-
-\subsection{Beta reduction}
-
-If a lambda abstraction is applied to an argument, we can simply
-beta-reduce.  This applies equally to ordinary lambda abstractions and 
-type abstractions:
-@
-  (\x  -> E[x]) arg	===>	E[arg]
-  (/\a -> E[a]) ty	===> 	E[ty]
-@
-There is no danger of duplicating work because the argument is 
-guaranteed to be a simple variable or literal.
-
-\subsubsection{Floating applications inward}
-
-Applications can be floated inside a @let(rec)@ or @case@ expression.
-This is a good idea, because they might find a lambda abstraction inside
-to beta-reduce with:
-@
-  (let(rec) Bind in E) arg	===>	let(rec) Bind in (E arg)
-
-  (case E of {P1 -> E1;...; Pn -> En}) arg	
-	===> 
-  case E of {P1 -> E1 arg; ...; Pn -> En arg}
-@
-
-
-
-\subsection{Transformations concerning @let(rec)@}
-
-\subsubsection{Floating @let@ out of @let@}
-
-It is sometimes useful to float a @let(rec)@ out of a @let(rec)@ right-hand
-side:
-@
-  let x = let(rec) Bind in B1	   ===>   let(rec) Bind in
-  in B2				          let x = B1
-				          in B2
-
-
-  letrec x = let(rec) Bind in B1   ===>   let(rec) Bind
-  in B2				                   x = B1
-				          in B2
-@
-
-\subsubsection{Floating @case@ out of @let@}
-
-  
-\subsubsection{@let@ to @case@}
-
-
-\subsection{Transformations concerning @case@}
-
-\subsubsection{Case of known constructor}
-
-If a @case@ expression scrutinises a constructor, 
-the @case@ can be eliminated.  This transformation is a real
-win: it eliminates a whole @case@ expression.
-@
-  case (C a1 .. an) of		  ===>  E[a1..an]
-	...
-	C b1 .. bn -> E[b1..bn]
-	...
-@
-If none of the constructors in the alternatives match, then
-the default is taken:
-@
-  case (C a1 .. an) of		  ===>  let y = C a1 .. an
-	...[no alt matches C]...	in E
-	y -> E
-@
-There is an important variant of this transformation when
-the @case@ expression scrutinises a {\em variable} 
-which is known to be bound to a constructor.  
-This situation can
-arise for two reasons:
-\begin{itemize}
-\item An enclosing @let(rec)@ binding binds the variable to a constructor.
-For example:
-@
-  let x = C p q in ... (case x of ...) ...
-@
-\item An enclosing @case@ expression scrutinises the same variable.
-For example:
-@
-  case x of 
-	...
-	C p q -> ... (case x of ...) ...
-	...
-@
-This situation is particularly common, as we discuss in Section~\ref{sect:repeated-evals}.
-\end{itemize}
-In each of these examples, @x@ is known to be bound to @C p q@ 
-at the inner @case@. The general rules are:
-@
-  case x of {...; C b1 .. bn -> E[b1..bn]; ...}
-===> {x bound to C a1 .. an}
-  E[a1..an]
-
-  case x of {...[no alts match C]...; y -> E[y]}
-===> {x bound to C a1 .. an}
-  E[x]
-@
-
-\subsubsection{Dead alternative elimination}
-@
-  case x of 		   
-	C a .. z -> E	
-	...[other alts]...
-===>   				x *not* bound to C
-  case x of
-	...[other alts]...
-@
-We might know that @x@ is not bound to a particular constructor
-because of an enclosing case:
-@
-	case x of
-		C a .. z -> E1
-		other -> E2
-@
-Inside @E1@ we know that @x@ is bound to @C@.
-However, if the type has more than two constructors,
-inside @E2@ all we know is that @x@ is {\em not} bound to @C@.
-
-This applies to unboxed cases also, in the obvious way.
-
-\subsubsection{Case elimination}
-
-If we can prove that @x@ is not bottom, then this rule applies.
-@
-  case x of	    ===>  E[x]
-	y -> E[y]
-@
-We might know that @x@ is non-bottom because:
-\begin{itemize}
-\item @x@ has an unboxed type.
-\item There's an enclosing case which scrutinises @x@.
-\item It is bound to an expression which provably terminates.
-\end{itemize}
-Since this transformation can only improve termination, even if we apply it
-when @x@ is not provably non-bottom, we provide a compiler flag to 
-enable it all the time.
-
-\subsubsection{Case of error}
-
-@
-  case (error ty E) of Alts   ===>   error ty' E
-			     where
-	     ty' is type of whole case expression
-@
-
-Mutter about types.  Mutter about variables bound to error.
-Mutter about disguised forms of error.
-
-\subsubsection{Floating @let(rec)@ out of @case@}
-
-A @let(rec)@ binding can be floated out of a @case@ scrutinee:
-@
-  case (let(rec) Bind in E) of Alts  ===>  let(rec) Bind in 
-   					   case E of Alts
-@
-This increases the likelihood of a case-of-known-constructor transformation,
-because @E@ is not hidden from the @case@ by the @let(rec)@.
-
-\subsubsection{Floating @case@ out of @case@}
-
-Analogous to floating a @let(rec)@ from a @case@ scrutinee is 
-floating a @case@ from a @case@ scrutinee.  We have to be
-careful, though, about code size.  If there's only one alternative
-in the inner case, things are easy:
-@
-  case (case E of {P -> R}) of  ===>  case E of {P -> case R of 
-    Q1 -> S1		    				Q1 -> S1
-    ...		    					...
-    Qm -> Sm		    				Qm -> Sm}
-@
-If there's more than one alternative there's a danger
-that we'll duplicate @S1@...@Sm@, which might be a lot of code.
-Our solution is to create a new local definition for each 
-alternative:
-@
-  case (case E of {P1 -> R1; ...; Pn -> Rn}) of
-    Q1 -> S1
-    ...
-    Qm -> Sm
-===>
-  let	s1 = \x1 ... z1 -> S1
-	...
-	sm = \xm ... zm -> Sm
-  in
-  case E of
-    P1 -> case R1 of {Q1 -> s1 x1 ... z1; ...; Qm -> sm xm ... zm}
-    ...
-    Pn -> case Rn of {Q1 -> s1 x1 ... z1; ...; Qm -> sm xm ... zm}
-@
-Here, @x1 ... z1@ are that subset of 
-variables bound by the pattern @Q1@ which are free in @S1@, and
-similarly for the other @si@.
-
-Is this transformation a win?  After all, we have introduced @m@ new
-functions!  Section~\ref{sect:join-points} discusses this point.
-
-\subsubsection{Case merging}
-
-@
-  case x of
-    ...[some alts]...
-    other -> case x of
-		...[more alts]...
-===>
-  case x of
-    ...[some alts]...
-    ...[more alts]...
-@
-Any alternatives in @[more alts]@ which are already covered by @[some alts]@
-should first be eliminated by the dead-alternative transformation.
-
-
-\subsection{Constructor reuse}
-
-
-\subsection{Inlining}
-
-The inlining transformtion is simple enough:
-@
-  let x = R in B[x]  ===>   B[R]
-@
-Inlining is more conventionally used to describe the instantiation of a function
-body at its call site, with arguments substituted for formal parameters.  We treat
-this as a two-stage process: inlining followed by beta reduction.  Since we are
-working with a higher-order language, not all the arguments may be available at every
-call site, so separating inlining from beta reduction allows us to concentrate on
-one problem at a time.
-
-The choice of exactly {\em which} bindings to inline has a major impact on efficiency.
-Specifically, we need to consider the following factors:
-\begin{itemize}
-\item
-Inlining a function at its call site, followed by some beta reduction, 
-very often exposes opportunities for further transformations.
-We inline many simple arithmetic and boolean operators for this reason.
-\item
-Inlining can increase code size.
-\item
-Inlining can duplicate work, for example if a redex is inlined at more than one site.
-Duplicating a single expensive redex can ruin a program's efficiency.
-\end{itemize}
-
-
-Our inlining strategy depends on the form of @R@:
-
-Mutter mutter.
-
-
-\subsubsection{Dead code removal}
-
-If a @let@-bound variable is not used the binding can be dropped:
-@
-  let x = E in B         ===>   	B
-		   x not free in B
-@
-A similar transformation applies for @letrec@-bound variables.
-Programmers seldom write dead code, of course, but bindings often become dead when they
-are inlined.
-
-
-
-
-\section{Composing transformations}
-\label{sect:composing}
-
-The really interesting thing about humble transformations is the way in which
-they compose together to carry out substantial and useful transformations.
-This section gives a collection of motivating examples, all of which have
-shown up in real application programs.
-
-\subsection{Repeated evals}
-\label{sect:repeated-evals}
-
-Example: x+x, as in unboxed paper.
-
-
-\subsection{Lazy pattern matching}
-
-Lazy pattern matching is pretty inefficient.  Consider:
-@
-  let (x,y) = E in B
-@
-which desugars to:
-@
-  let t = E
-      x = case t of (x,y) -> x
-      y = case t of (x,y) -> y
-  in B
-@
-This code allocates three thunks!  However, if @B@ is strict in {\em either}
-@x@ {\em or} @y@, then the strictness analyser will easily spot that
-the binding for @t@ is strict, so we can do a @let@-to-@case@ transformation:
-@
-  case E of
-    (x,y) -> let t = (x,y) in
-	     let x = case t of (x,y) -> x
-	         y = case t of (x,y) -> y
-	     in B
-@
-whereupon the case-of-known-constructor transformation 
-eliminates the @case@ expressions in the right-hand side of @x@ and @y@,
-and @t@ is then spotted as being dead, so we get
-@
-  case E of
-    (x,y) -> B
-@
-
-\subsection{Join points}
-\label{sect:join-points}
-
-One motivating example is this:
-@
-  if (not x) then E1 else E2
-@
-After desugaring the conditional, and inlining the definition of
-@not@, we get
-@
-  case (case x of True -> False; False -> True}) of 
-	True  -> E1
-	False -> E2
-@
-Now, if we apply our case-of-case transformation we get:
-@
-  let e1 = E1
-      e2 = E2
-  in
-  case x of
-     True  -> case False of {True -> e1; False -> e2}
-     False -> case True  of {True -> e1; False -> e2}
-@
-Now the case-of-known constructor transformation applies:
-@
-  let e1 = E1
-      e2 = E2
-  in
-  case x of
-     True  -> e2
-     False -> e1
-@
-Since there is now only one occurrence of @e1@ and @e2@ we can
-inline them, giving just what we hoped for:
-@
-  case x of {True  -> E2; False -> E1}
-@
-The point is that the local definitions will often disappear again.
-
-\subsubsection{How join points occur}
-
-But what if they don't disappear?  Then the definitions @s1@ ... @sm@
-play the role of ``join points''; they represent the places where
-execution joins up again, having forked at the @case x@.  The
-``calls'' to the @si@ should really be just jumps.  To see this more clearly
-consider the expression
-@
-  if (x || y) then E1 else E2
-@
-A C compiler will ``short-circuit'' the
-evaluation of the condition if @x@ turns out to be true
-generate code, something like this:
-@
-      if (x) goto l1;
-      if (y) {...code for E2...}
-  l1: ...code for E1...
-@
-In our setting, here's what will happen.  First we desguar the
-conditional, and inline the definition of @||@:
-@
-  case (case x of {True -> True; False -> y}) of
-    True -> E1
-    False -> E2
-@
-Now apply the case-of-case transformation:
-@
-  let e1 = E1
-      e2 = E2
-  in
-  case x of 
-     True  -> case True of {True -> e1; False -> e2}
-     False -> case y    of {True -> e1; False -> e2}
-@
-Unlike the @not@ example, only one of the two inner case
-simplifies, and we can therefore only inline @e2@, because
-@e1@ is still mentioned twice\footnote{Unless the
-inlining strategy decides that @E1@ is small enough to duplicate;
-it is used in separate @case@ branches so there's no concern about duplicating
-work.  Here's another example of the way in which we make one part of the 
-simplifier (the inlining strategy) help with the work of another (@case@-expression
-simplification.}
-@
-  let e1 = E1
-  in
-  case x of 
-     True  -> e1
-     False -> case y of {True -> e1; False -> e2}
-@
-The code generator produces essentially the same code as
-the C code given above.  The binding for @e1@ turns into 
-just a label, which is jumped to from the two occurrences of @e1@.
-
-\subsubsection{Case of @error@}
-
-The case-of-error transformation is often exposed by the case-of-case
-transformation.  Consider 
-@
-  case (hd xs) of
-	True  -> E1
-	False -> E2
-@
-After inlining @hd@, we get
-@
-  case (case xs of [] -> error "hd"; (x:_) -> x) of
-	True  -> E1
-	False -> E2
-@
-(I've omitted the type argument of @error@ to save clutter.)
-Now doing case-of-case gives
-@
-  let e1 = E1
-      e2 = E2
-  in
-  case xs of
-	[]    -> case (error "hd") of { True -> e1; False -> e2 }
-	(x:_) -> case x            of { True -> e1; False -> e2 }
-@
-Now the case-of-error transformation springs to life, after which
-we can inline @e1@ and @e2@:
-@
-  case xs of
-	[]    -> error "hd"
-	(x:_) -> case x of {True -> E1; False -> E2}
-@
-
-\subsection{Nested conditionals combined}
-
-Sometimes programmers write something which should be done
-by a single @case@ as a sequence of tests:
-@
-  if x==0::Int then E0 else
-  if x==1      then E1 else
-  E2
-@
-After eliminating some redundant evals and doing the case-of-case
-transformation we get
-@
-  case x of I# x# ->
-  case x# of
-    0#    -> E0
-    other -> case x# of 
-	       1#    -> E1
-	       other -> E2
-@ 
-The case-merging transformation puts these together to get
-@
-  case x of I# x# ->
-  case x# of
-    0#    -> E0
-    1#    -> E1
-    other -> E2
-@
-Sometimes the sequence of tests cannot be eliminated from the source
-code because of overloading:
-@
-  f :: Num a => a -> Bool
-  f 0 = True
-  f 3 = True
-  f n = False
-@
-If we specialise @f@ to @Int@ we'll get the previous example again.
-
-\subsection{Error tests eliminated}
-
-The elimination of redundant alternatives, and then of redundant cases,
-arises when we inline functions which do error checking.  A typical
-example is this:
-@
-  if (x `rem` y) == 0 then (x `div` y) else y
-@
-Here, both @rem@ and @div@ do an error-check for @y@ being zero.
-The second check is eliminated by the transformations.
-After transformation the code becomes:
-@
-  case x of I# x# ->
-  case y of I# y# ->
-  case y of 
-    0# -> error "rem: zero divisor"
-    _  -> case x# rem# y# of
-	    0# -> case x# div# y# of
-		    r# -> I# r#
-	    _  -> y
-@
-
-\subsection{Atomic arguments}
-
-At this point it is possible to appreciate the usefulness of
-the Core-language syntax requirement that arguments are atomic.
-For example, suppose that arguments could be arbitrary expressions.
-Here is a possible transformation:
-@
-  f (case x of (p,q) -> p)
-===>				f strict in its second argument
-  case x of (p,q) -> f (p,p)
-@
-Doing this transformation would be useful, because now the
-argument to @f@ is a simple variable rather than a thunk.
-However, if arguments are atomic, this transformation becomes
-just a special case of floating a @case@ out of a strict @let@:
-@
-  let a = case x of (p,q) -> p
-  in f a
-===>				(f a) strict in a
-  case x of (p,q) -> let a=p in f a
-===>
-  case x of (p,q) -> f p
-@
-There are many examples of this kind.  For almost any transformation
-involving @let@ there is a corresponding one involving a function
-argument.  The same effect is achieved with much less complexity
-by restricting function arguments to be atomic.
-
-\section{Design}
-
-Dependency analysis
-Occurrence analysis
-
-\subsection{Renaming and cloning}
-
-Every program-transformation system has to worry about name capture.
-For example, here is an erroneous transformation:
-@
-  let y = E 
-  in
-  (\x -> \y -> x + y) (y+3)
-===>				WRONG!
-  let y = E 
-  in
-  (\y -> (y+3) + y)
-@
-The transformation fails because the originally free-occurrence
-of @y@ in the argument @y+3@ has been ``captured'' by the @\y@-abstraction.
-There are various sophisticated solutions to this difficulty, but
-we adopted a very simple one: we uniquely rename every locally-bound identifier
-on every pass of the simplifier.  
-Since we are in any case producing an entirely new program (rather than side-effecting
-an existing one) it costs very little extra to rename the identifiers as we go.
-
-So our example would become
-@
-  let y = E 
-  in
-  (\x -> \y -> x + y) (y+3)
-===>				WRONG!
-  let y1 = E 
-  in
-  (\y2 -> (y1+3) + y2)
-@
-The simplifier accepts as input a program which has arbitrary bound
-variable names, including ``shadowing'' (where a binding hides an
-outer binding for the same identifier), but it produces a program in
-which every bound identifier has a distinct name.
-
-Both the ``old'' and ``new'' identifiers have type @Id@, but when writing 
-type signatures for functions in the simplifier we use the types @InId@, for
-identifiers from the input program, and @OutId@ for identifiers from the output program:
-@
-  type InId  = Id
-  type OutId = Id
-@
-This nomenclature extends naturally to expressions: a value of type @InExpr@ is an 
-expression whose identifiers are from the input-program name-space, and similarly
-@OutExpr@.
-
-
-\section{The simplifier}
-
-The basic algorithm followed by the simplifier is:
-\begin{enumerate}
-\item Analyse: perform occurrence analysis and dependency analysis.
-\item Simplify: apply as many transformations as possible.
-\item Iterate: perform the above two steps repeatedly until no further transformations are possible.
-(A compiler flag allows the programmer to bound the maximum number of iterations.)
-\end{enumerate}
-We make a effort to apply as many transformations as possible in Step
-2.  To see why this is a good idea, just consider a sequence of
-transformations in which each transformation enables the next.  If
-each iteration of Step 2 only performs one transformation, then the
-entire program will to be re-analysed by Step 1, and re-traversed by
-Step 2, for each transformation of the sequence.  Sometimes this is
-unavoidable, but it is often possible to perform a sequence of
-transformtions in a single pass.
-
-The key function, which simplifies expressions, has the following type:
-@
-  simplExpr :: SimplEnv
-	    -> InExpr -> [OutArg]
-	    -> SmplM OutExpr 
-@
-The monad, @SmplM@ can quickly be disposed of.  It has only two purposes:
-\begin{itemize}
-\item It plumbs around a supply of unique names, so that the simplifier can
-easily invent new names.
-\item It gathers together counts of how many of each kind of transformation
-has been applied, for statistical purposes.  These counts are also used
-in Step 3 to decide when the simplification process has terminated.
-\end{itemize}
-
-The signature can be understood like this:
-\begin{itemize}
-\item The environment, of type @SimplEnv@, provides information about
-identifiers bound by the enclosing context.
-\item The second and third arguments together specify the expression to be simplified.
-\item The result is the simplified expression, wrapped up by the monad.
-\end{itemize}
-The simplifier's invariant is this:
-$$
-@simplExpr@~env~expr~[a_1,\ldots,a_n] = expr[env]~a_1~\ldots~a_n
-$$
-That is, the expression returned by $@simplExpr@~env~expr~[a_1,\ldots,a_n]$
-is semantically equal (although hopefully more efficient than)
-$expr$, with the renamings in $env$ applied to it, applied to the arguments
-$a_1,\ldots,a_n$.
-
-\subsection{Application and beta reduction}
-
-The arguments are carried ``inwards'' by @simplExpr@, as an accumulating parameter.
-This is a convenient way of implementing the transformations which float
-arguments inside a @let@ and @case@.  This list of pending arguments
-requires a new data type, @CoreArg@, along with its ``in'' and ``out'' synonyms,
-because an argument might be a type or an atom:
-@
-data CoreArg bindee = TypeArg UniType
-		    | ValArg  (CoreAtom bindee)
-
-type InArg  = CoreArg InId
-type OutArg = CoreArg OutId
-@
-The equations for applications simply apply
-the environment to the argument (to handle renaming) and put the result 
-on the argument stack, tagged to say whether it is a type argument or value argument:
-@
-  simplExpr env (CoApp fun arg)  args 
-    = simplExpr env fun (ValArg  (simplAtom env arg) : args)
-  simplExpr env (CoTyApp fun ty) args 
-    = simplExpr env fun (TypeArg (simplTy env ty)    : args)
-@
-
-
-
-
-
-
-\end{document}
diff --git a/ghc/compiler/simplStg/SRT.lhs b/ghc/compiler/simplStg/SRT.lhs
deleted file mode 100644
index cd118d7092..0000000000
--- a/ghc/compiler/simplStg/SRT.lhs
+++ /dev/null
@@ -1,165 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-
-Run through the STG code and compute the Static Reference Table for
-each let-binding.  At the same time, we figure out which top-level
-bindings have no CAF references, and record the fact in their IdInfo.
-
-\begin{code}
-module SRT( computeSRTs ) where
-
-#include "HsVersions.h"
-
-import StgSyn
-import Id        	( Id )
-import VarSet
-import VarEnv
-import Util		( sortLe )
-import Maybes		( orElse )
-import Maybes		( expectJust )
-import Bitmap		( intsToBitmap )
-
-#ifdef DEBUG
-import Outputable
-#endif
-
-import List
-
-import Util
-import Outputable
-\end{code}
-
-\begin{code}
-computeSRTs :: [StgBinding] -> [(StgBinding,[(Id,[Id])])]
-  -- The incoming bindingd are filled with SRTEntries in their SRT slots
-  -- the outgoing ones have NoSRT/SRT values instead
-
-computeSRTs binds = srtTopBinds emptyVarEnv binds
-
--- --------------------------------------------------------------------------
--- Top-level Bindings
-
-srtTopBinds :: IdEnv Id -> [StgBinding] -> [(StgBinding, [(Id,[Id])])]
-
-srtTopBinds env [] = []
-srtTopBinds env (StgNonRec b rhs : binds) = 
-  (StgNonRec b rhs', [(b,srt')]) : srtTopBinds env' binds
-  where
-    (rhs', srt) = srtTopRhs b rhs
-    env' = maybeExtendEnv env b rhs
-    srt' = applyEnvList env srt
-srtTopBinds env (StgRec bs : binds) = 
-  (StgRec (zip bndrs rhss), zip bndrs srts') : srtTopBinds env binds
-  where
-    (rhss, srts) = unzip [ srtTopRhs b r | (b,r) <- bs ]
-    bndrs = map fst bs
-    srts' = map (applyEnvList env) srts
-
--- Shorting out indirections in SRTs:  if a binding has an SRT with a single
--- element in it, we just inline it with that element everywhere it occurs
--- in other SRTs.
---
--- This is in a way a generalisation of the CafInfo.  CafInfo says
--- whether a top-level binding has *zero* CAF references, allowing us
--- to omit it from SRTs.  Here, we pick up bindings with *one* CAF
--- reference, and inline its SRT everywhere it occurs.  We could pass
--- this information across module boundaries too, but we currently
--- don't.
-
-maybeExtendEnv env bndr (StgRhsClosure _ _ _ ReEntrant (SRTEntries cafs) _ _)
-  | [one] <- varSetElems cafs
-  = extendVarEnv env bndr (applyEnv env one)
-maybeExtendEnv env bndr _ = env
-
-applyEnvList :: IdEnv Id -> [Id] -> [Id]
-applyEnvList env = map (applyEnv env)
-
-applyEnv env id = lookupVarEnv env id `orElse` id
-
--- ----  Top-level right hand sides:
-
-srtTopRhs :: Id -> StgRhs -> (StgRhs, [Id])
-
-srtTopRhs binder rhs@(StgRhsCon _ _ _) = (rhs, [])
-srtTopRhs binder rhs@(StgRhsClosure _ _ _ _  (SRTEntries cafs) _ _)
-  = (srtRhs table rhs, elems)
-  where
-	elems = varSetElems cafs
-        table = mkVarEnv (zip elems [0..])
-
--- ---- Binds:
-
-srtBind :: IdEnv Int -> StgBinding -> StgBinding
-
-srtBind table (StgNonRec binder rhs) = StgNonRec binder (srtRhs table rhs)
-srtBind table (StgRec pairs) = StgRec [ (b, srtRhs table r) | (b,r) <- pairs ]
-
--- ---- Right Hand Sides:
-
-srtRhs :: IdEnv Int -> StgRhs -> StgRhs
-
-srtRhs table e@(StgRhsCon cc con args) = e
-srtRhs table (StgRhsClosure cc bi free_vars u srt args body)
-  = StgRhsClosure cc bi free_vars u (constructSRT table srt) args 
-	$! (srtExpr table body)
-
--- ---------------------------------------------------------------------------
--- Expressions
-
-srtExpr :: IdEnv Int -> StgExpr -> StgExpr
-
-srtExpr table e@(StgApp f args) 	= e
-srtExpr table e@(StgLit l)      	= e
-srtExpr table e@(StgConApp con args)    = e
-srtExpr table e@(StgOpApp op args ty)   = e
-
-srtExpr table (StgSCC cc expr) = StgSCC cc $! srtExpr table expr
-
-srtExpr table (StgCase scrut live1 live2 uniq srt alt_type alts)
- = StgCase expr' live1 live2 uniq srt' alt_type alts'
- where
-   expr' = srtExpr table scrut
-   srt'  = constructSRT table srt
-   alts' = map (srtAlt table) alts
-
-srtExpr table (StgLet bind body)
-  = srtBind table bind =: \ bind' ->
-    srtExpr table body		   =: \ body' ->
-    StgLet bind' body'
-     
-srtExpr table (StgLetNoEscape live1 live2 bind body)
-  = srtBind table bind =: \ bind' ->
-    srtExpr table body		   =: \ body' ->
-    StgLetNoEscape live1 live2 bind' body'
-
-#ifdef DEBUG
-srtExpr table expr = pprPanic "srtExpr" (ppr expr)
-#endif
-
-srtAlt :: IdEnv Int -> StgAlt -> StgAlt
-srtAlt table (con,args,used,rhs)
-  = (,,,) con args used $! srtExpr table rhs
-
------------------------------------------------------------------------------
--- Construct an SRT bitmap.
-
-constructSRT :: IdEnv Int -> SRT -> SRT
-constructSRT table (SRTEntries entries)
- | isEmptyVarSet entries = NoSRT
- | otherwise  = SRT offset len bitmap
-  where
-    ints = map (expectJust "constructSRT" . lookupVarEnv table) 
-		(varSetElems entries)
-    sorted_ints = sortLe (<=) ints
-    offset = head sorted_ints
-    bitmap_entries = map (subtract offset) sorted_ints
-    len = last bitmap_entries + 1
-    bitmap = intsToBitmap len bitmap_entries
-
--- ---------------------------------------------------------------------------
--- Misc stuff
-
-a =: k  = k a
-
-\end{code}
diff --git a/ghc/compiler/simplStg/SimplStg.lhs b/ghc/compiler/simplStg/SimplStg.lhs
deleted file mode 100644
index e87877cb4c..0000000000
--- a/ghc/compiler/simplStg/SimplStg.lhs
+++ /dev/null
@@ -1,96 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[SimplStg]{Driver for simplifying @STG@ programs}
-
-\begin{code}
-module SimplStg ( stg2stg ) where
-
-#include "HsVersions.h"
-
-import StgSyn
-
-import CostCentre       ( CollectedCCs )
-import SCCfinal		( stgMassageForProfiling )
-import StgLint		( lintStgBindings )
-import StgStats	        ( showStgStats )
-import SRT		( computeSRTs )
-
-import Packages		( HomeModules )
-import DynFlags		( DynFlags(..), DynFlag(..), dopt, StgToDo(..),
-			  getStgToDo )
-import Id		( Id )
-import Module		( Module )
-import ErrUtils		( doIfSet_dyn, dumpIfSet_dyn, showPass )
-import UniqSupply	( mkSplitUniqSupply, splitUniqSupply )
-import Outputable
-\end{code}
-
-\begin{code}
-stg2stg :: DynFlags		     -- includes spec of what stg-to-stg passes to do
-	-> HomeModules
-	-> Module		     -- module name (profiling only)
-	-> [StgBinding]		     -- input...
-	-> IO ( [(StgBinding,[(Id,[Id])])]  -- output program...
-	      , CollectedCCs)        -- cost centre information (declared and used)
-
-stg2stg dflags pkg_deps module_name binds
-  = do	{ showPass dflags "Stg2Stg"
-	; us <- mkSplitUniqSupply 'g'
-
-	; doIfSet_dyn dflags Opt_D_verbose_stg2stg 
-		      (printDump (text "VERBOSE STG-TO-STG:"))
-
-	; (binds', us', ccs) <- end_pass us "Stg2Stg" ([],[],[]) binds
-
-		-- Do the main business!
-	; (processed_binds, _, cost_centres) 
-		<- foldl_mn do_stg_pass (binds', us', ccs) (getStgToDo dflags)
-
-	; let srt_binds = computeSRTs processed_binds
-
-	; dumpIfSet_dyn dflags Opt_D_dump_stg "STG syntax:" 
-	     		(pprStgBindingsWithSRTs srt_binds)
-
-	; return (srt_binds, cost_centres)
-   }
-
-  where
-    stg_linter = if dopt Opt_DoStgLinting dflags
-		 then lintStgBindings
-		 else ( \ whodunnit binds -> binds )
-
-    -------------------------------------------
-    do_stg_pass (binds, us, ccs) to_do
-      =	let
-	    (us1, us2) = splitUniqSupply us
-	in
-	case to_do of
-	  D_stg_stats ->
-	     trace (showStgStats binds)
-	     end_pass us2 "StgStats" ccs binds
-
-	  StgDoMassageForProfiling ->
-	     {-# SCC "ProfMassage" #-}
-	     let
-		 (collected_CCs, binds3)
-		   = stgMassageForProfiling pkg_deps module_name us1 binds
-	     in
-	     end_pass us2 "ProfMassage" collected_CCs binds3
-
-    end_pass us2 what ccs binds2
-      = do -- report verbosely, if required
-	   dumpIfSet_dyn dflags Opt_D_verbose_stg2stg what
-	      (vcat (map ppr binds2))
-	   let linted_binds = stg_linter what binds2
-	   return (linted_binds, us2, ccs)
-	    -- return: processed binds
-	    -- 	       UniqueSupply for the next guy to use
-	    --	       cost-centres to be declared/registered (specialised)
-	    --	       add to description of what's happened (reverse order)
-
--- here so it can be inlined...
-foldl_mn f z []     = return z
-foldl_mn f z (x:xs) = f z x	>>= \ zz ->
-		     foldl_mn f zz xs
-\end{code}
diff --git a/ghc/compiler/simplStg/StgStats.lhs b/ghc/compiler/simplStg/StgStats.lhs
deleted file mode 100644
index a91873971c..0000000000
--- a/ghc/compiler/simplStg/StgStats.lhs
+++ /dev/null
@@ -1,172 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[StgStats]{Gathers statistical information about programs}
-
-
-The program gather statistics about
-\begin{enumerate}
-\item number of boxed cases
-\item number of unboxed cases
-\item number of let-no-escapes
-\item number of non-updatable lets
-\item number of updatable lets
-\item number of applications
-\item number of primitive applications
-\item number of closures (does not include lets bound to constructors)
-\item number of free variables in closures
-%\item number of top-level functions
-%\item number of top-level CAFs
-\item number of constructors
-\end{enumerate}
-
-\begin{code}
-module StgStats ( showStgStats ) where
-
-#include "HsVersions.h"
-
-import StgSyn
-
-import FiniteMap	( emptyFM, plusFM_C, unitFM, fmToList, FiniteMap )
-import Id (Id)
-\end{code}
-
-\begin{code}
-data CounterType
-  = Literals
-  | Applications
-  | ConstructorApps
-  | PrimitiveApps
-  | LetNoEscapes
-  | StgCases
-  | FreeVariables
-  | ConstructorBinds Bool{-True<=>top-level-}
-  | ReEntrantBinds   Bool{-ditto-}
-  | SingleEntryBinds Bool{-ditto-}
-  | UpdatableBinds   Bool{-ditto-}
-  deriving (Eq, Ord)
-
-type Count	= Int
-type StatEnv	= FiniteMap CounterType Count
-\end{code}
-
-\begin{code}
-emptySE	:: StatEnv
-emptySE	= emptyFM
-
-combineSE :: StatEnv -> StatEnv -> StatEnv
-combineSE = plusFM_C (+)
-
-combineSEs :: [StatEnv] -> StatEnv
-combineSEs = foldr combineSE emptySE
-
-countOne :: CounterType -> StatEnv
-countOne c = unitFM c 1
-
-countN :: CounterType -> Int -> StatEnv
-countN = unitFM
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Top-level list of bindings (a ``program'')}
-%*									*
-%************************************************************************
-
-\begin{code}
-showStgStats :: [StgBinding] -> String
-
-showStgStats prog
-  = "STG Statistics:\n\n"
-    ++ concat (map showc (fmToList (gatherStgStats prog)))
-  where
-    showc (x,n) = (showString (s x) . shows n) "\n"
-
-    s Literals		      = "Literals                   "
-    s Applications	      = "Applications               "
-    s ConstructorApps	      = "ConstructorApps            "
-    s PrimitiveApps	      = "PrimitiveApps              "
-    s LetNoEscapes	      = "LetNoEscapes               "
-    s StgCases		      = "StgCases                   "
-    s FreeVariables	      = "FreeVariables              "
-    s (ConstructorBinds True) = "ConstructorBinds_Top       "
-    s (ReEntrantBinds True)   = "ReEntrantBinds_Top         "
-    s (SingleEntryBinds True) = "SingleEntryBinds_Top       "
-    s (UpdatableBinds True)   = "UpdatableBinds_Top         "
-    s (ConstructorBinds _)    = "ConstructorBinds_Nested    "
-    s (ReEntrantBinds _)      = "ReEntrantBindsBinds_Nested "
-    s (SingleEntryBinds _)    = "SingleEntryBinds_Nested    "
-    s (UpdatableBinds _)      = "UpdatableBinds_Nested      "
-
-gatherStgStats :: [StgBinding] -> StatEnv
-
-gatherStgStats binds
-  = combineSEs (map (statBinding True{-top-level-}) binds)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Bindings}
-%*									*
-%************************************************************************
-
-\begin{code}
-statBinding :: Bool -- True <=> top-level; False <=> nested
-	    -> StgBinding
-	    -> StatEnv
-
-statBinding top (StgNonRec b rhs)
-  = statRhs top (b, rhs)
-
-statBinding top (StgRec pairs)
-  = combineSEs (map (statRhs top) pairs)
-
-statRhs :: Bool -> (Id, StgRhs) -> StatEnv
-
-statRhs top (b, StgRhsCon cc con args)
-  = countOne (ConstructorBinds top)
-
-statRhs top (b, StgRhsClosure cc bi fv u _srt args body)
-  = statExpr body			`combineSE`
-    countN FreeVariables (length fv)	`combineSE`
-    countOne (
-      case u of
-	ReEntrant   -> ReEntrantBinds   top
-	Updatable   -> UpdatableBinds   top
-	SingleEntry -> SingleEntryBinds top
-    )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Expressions}
-%*									*
-%************************************************************************
-
-\begin{code}
-statExpr :: StgExpr -> StatEnv
-
-statExpr (StgApp _ _)	  = countOne Applications
-statExpr (StgLit _)	  = countOne Literals
-statExpr (StgConApp _ _)  = countOne ConstructorApps
-statExpr (StgOpApp _ _ _) = countOne PrimitiveApps
-statExpr (StgSCC l e) 	  = statExpr e
-
-statExpr (StgLetNoEscape lvs_whole lvs_rhss binds body)
-  = statBinding False{-not top-level-} binds	`combineSE`
-    statExpr body				`combineSE`
-    countOne LetNoEscapes
-
-statExpr (StgLet binds body)
-  = statBinding False{-not top-level-} binds	`combineSE`
-    statExpr body
-
-statExpr (StgCase expr lve lva bndr srt alt_type alts)
-  = statExpr expr	`combineSE`
-    stat_alts alts	`combineSE`
-    countOne StgCases
-  where
-    stat_alts alts
-	= combineSEs (map statExpr [ e | (_,_,_,e) <- alts ])
-\end{code}
-
diff --git a/ghc/compiler/specialise/Rules.lhs b/ghc/compiler/specialise/Rules.lhs
deleted file mode 100644
index 4d743140ea..0000000000
--- a/ghc/compiler/specialise/Rules.lhs
+++ /dev/null
@@ -1,633 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[CoreRules]{Transformation rules}
-
-\begin{code}
-module Rules (
-	RuleBase, emptyRuleBase, mkRuleBase, extendRuleBaseList, 
-	unionRuleBase, pprRuleBase, ruleCheckProgram,
-
-	mkSpecInfo, extendSpecInfo, addSpecInfo,
-	rulesOfBinds, addIdSpecialisations, 
-
-        lookupRule, mkLocalRule, roughTopNames
-    ) where
-
-#include "HsVersions.h"
-
-import CoreSyn		-- All of it
-import OccurAnal	( occurAnalyseExpr )
-import CoreFVs		( exprFreeVars, exprsFreeVars, rulesRhsFreeVars )
-import CoreUnfold	( isCheapUnfolding, unfoldingTemplate )
-import CoreUtils	( tcEqExprX )
-import PprCore		( pprRules )
-import Type		( TvSubstEnv )
-import TcType		( tcSplitTyConApp_maybe )
-import CoreTidy		( tidyRules )
-import Id		( Id, idUnfolding, isLocalId, isGlobalId, idName,
-			  idSpecialisation, idCoreRules, setIdSpecialisation ) 
-import IdInfo		( SpecInfo( SpecInfo ) )
-import Var		( Var )
-import VarEnv		( IdEnv, InScopeSet, emptyTidyEnv,
-			  emptyInScopeSet, mkInScopeSet, extendInScopeSetList, 
-			  emptyVarEnv, lookupVarEnv, extendVarEnv, 
-			  nukeRnEnvL, mkRnEnv2, rnOccR, rnOccL, inRnEnvR,
-			  rnBndrR, rnBndr2, rnBndrL, rnBndrs2 )
-import VarSet
-import Name		( Name, NamedThing(..), nameOccName )
-import NameEnv
-import Unify 		( ruleMatchTyX, MatchEnv(..) )
-import BasicTypes	( Activation, CompilerPhase, isActive )
-import Outputable
-import FastString
-import Maybes		( isJust, orElse )
-import Bag
-import Util		( singleton )
-import List		( isPrefixOf )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[specialisation-IdInfo]{Specialisation info about an @Id@}
-%*									*
-%************************************************************************
-
-A @CoreRule@ holds details of one rule for an @Id@, which
-includes its specialisations.
-
-For example, if a rule for @f@ contains the mapping:
-\begin{verbatim}
-	forall a b d. [Type (List a), Type b, Var d]  ===>  f' a b
-\end{verbatim}
-then when we find an application of f to matching types, we simply replace
-it by the matching RHS:
-\begin{verbatim}
-	f (List Int) Bool dict ===>  f' Int Bool
-\end{verbatim}
-All the stuff about how many dictionaries to discard, and what types
-to apply the specialised function to, are handled by the fact that the
-Rule contains a template for the result of the specialisation.
-
-There is one more exciting case, which is dealt with in exactly the same
-way.  If the specialised value is unboxed then it is lifted at its
-definition site and unlifted at its uses.  For example:
-
-	pi :: forall a. Num a => a
-
-might have a specialisation
-
-	[Int#] ===>  (case pi' of Lift pi# -> pi#)
-
-where pi' :: Lift Int# is the specialised version of pi.
-
-\begin{code}
-mkLocalRule :: RuleName -> Activation 
-	    -> Name -> [CoreBndr] -> [CoreExpr] -> CoreExpr -> CoreRule
--- Used to make CoreRule for an Id defined in this module
-mkLocalRule name act fn bndrs args rhs
-  = Rule { ru_name = name, ru_fn = fn, ru_act = act,
-	   ru_bndrs = bndrs, ru_args = args,
-	   ru_rhs = rhs, ru_rough = roughTopNames args,
-	   ru_orph = Just (nameOccName fn), ru_local = True }
-
---------------
-roughTopNames :: [CoreExpr] -> [Maybe Name]
-roughTopNames args = map roughTopName args
-
-roughTopName :: CoreExpr -> Maybe Name
--- Find the "top" free name of an expression
--- a) the function in an App chain (if a GlobalId)
--- b) the TyCon in a type
--- This is used for the fast-match-check for rules; 
---	if the top names don't match, the rest can't
-roughTopName (Type ty) = case tcSplitTyConApp_maybe ty of
-			  Just (tc,_) -> Just (getName tc)
-			  Nothing     -> Nothing
-roughTopName (App f a) = roughTopName f
-roughTopName (Var f) | isGlobalId f = Just (idName f)
-		     | otherwise    = Nothing
-roughTopName other = Nothing
-
-ruleCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
--- (ruleCantMatch tpl actual) returns True only if 'actual'
--- definitely can't match 'tpl' by instantiating 'tpl'.  
--- It's only a one-way match; unlike instance matching we 
--- don't consider unification
-ruleCantMatch (Just n1 : ts) (Just n2 : as) = n1 /= n2 || ruleCantMatch ts as
-ruleCantMatch (Just n1 : ts) (Nothing : as) = True
-ruleCantMatch (t       : ts) (a       : as) = ruleCantMatch ts as
-ruleCantMatch ts	     as		    = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-		SpecInfo: the rules in an IdInfo
-%*									*
-%************************************************************************
-
-\begin{code}
-mkSpecInfo :: [CoreRule] -> SpecInfo
-mkSpecInfo rules = SpecInfo rules (rulesRhsFreeVars rules)
-
-extendSpecInfo :: SpecInfo -> [CoreRule] -> SpecInfo
-extendSpecInfo (SpecInfo rs1 fvs1) rs2
-  = SpecInfo (rs2 ++ rs1) (rulesRhsFreeVars rs2 `unionVarSet` fvs1)
-
-addSpecInfo :: SpecInfo -> SpecInfo -> SpecInfo
-addSpecInfo (SpecInfo rs1 fvs1) (SpecInfo rs2 fvs2) 
-  = SpecInfo (rs1 ++ rs2) (fvs1 `unionVarSet` fvs2)
-
-addIdSpecialisations :: Id -> [CoreRule] -> Id
-addIdSpecialisations id rules
-  = setIdSpecialisation id $
-    extendSpecInfo (idSpecialisation id) rules
-
-rulesOfBinds :: [CoreBind] -> [CoreRule]
-rulesOfBinds binds = concatMap (concatMap idCoreRules . bindersOf) binds
-\end{code}
-
-
-%************************************************************************
-%*									*
-		RuleBase
-%*									*
-%************************************************************************
-
-\begin{code}
-type RuleBase = NameEnv [CoreRule]
-	-- Maps (the name of) an Id to its rules
-	-- The rules are are unordered; 
-	-- we sort out any overlaps on lookup
-
-emptyRuleBase = emptyNameEnv
-
-mkRuleBase :: [CoreRule] -> RuleBase
-mkRuleBase rules = extendRuleBaseList emptyRuleBase rules
-
-extendRuleBaseList :: RuleBase -> [CoreRule] -> RuleBase
-extendRuleBaseList rule_base new_guys
-  = foldl extendRuleBase rule_base new_guys
-
-unionRuleBase :: RuleBase -> RuleBase -> RuleBase
-unionRuleBase rb1 rb2 = plusNameEnv_C (++) rb1 rb2
-
-extendRuleBase :: RuleBase -> CoreRule -> RuleBase
-extendRuleBase rule_base rule
-  = extendNameEnv_Acc (:) singleton rule_base (ruleIdName rule) rule
-
-pprRuleBase :: RuleBase -> SDoc
-pprRuleBase rules = vcat [ pprRules (tidyRules emptyTidyEnv rs) 
-			 | rs <- nameEnvElts rules ]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Matching}
-%*									*
-%************************************************************************
-
-\begin{code}
-lookupRule :: (Activation -> Bool) -> InScopeSet
-	   -> RuleBase	-- Imported rules
-	   -> Id -> [CoreExpr] -> Maybe (RuleName, CoreExpr)
-lookupRule is_active in_scope rule_base fn args
-  = matchRules is_active in_scope fn args rules
-  where
-	-- The rules for an Id come from two places:
-	--	(a) the ones it is born with (idCoreRules fn)
-	--	(b) rules added in subsequent modules (extra_rules)
-	-- PrimOps, for example, are born with a bunch of rules under (a)
-    rules = extra_rules ++ idCoreRules fn
-    extra_rules | isLocalId fn = []
-	  	| otherwise    = lookupNameEnv rule_base (idName fn) `orElse` []
-
-matchRules :: (Activation -> Bool) -> InScopeSet
-	   -> Id -> [CoreExpr]
-	   -> [CoreRule] -> Maybe (RuleName, CoreExpr)
--- See comments on matchRule
-matchRules is_active in_scope fn args rules
-  = case go [] rules of
-	[]     -> Nothing
-	(m:ms) -> Just (case findBest (fn,args) m ms of
-			  (rule, ans) -> (ru_name rule, ans))
-  where
-    rough_args = map roughTopName args
-
-    go :: [(CoreRule,CoreExpr)] -> [CoreRule] -> [(CoreRule,CoreExpr)]
-    go ms []	       = ms
-    go ms (r:rs) = case (matchRule is_active in_scope args rough_args r) of
-			Just e  -> go ((r,e):ms) rs
-			Nothing -> go ms         rs
-
-findBest :: (Id, [CoreExpr])
-	 -> (CoreRule,CoreExpr) -> [(CoreRule,CoreExpr)] -> (CoreRule,CoreExpr)
--- All these pairs matched the expression
--- Return the pair the the most specific rule
--- The (fn,args) is just for overlap reporting
-
-findBest target (rule,ans)   [] = (rule,ans)
-findBest target (rule1,ans1) ((rule2,ans2):prs)
-  | rule1 `isMoreSpecific` rule2 = findBest target (rule1,ans1) prs
-  | rule2 `isMoreSpecific` rule1 = findBest target (rule1,ans1) prs
-#ifdef DEBUG
-  | otherwise = pprTrace "Rules.findBest: rule overlap (Rule 1 wins)"
-			 (vcat [ptext SLIT("Expression to match:") <+> ppr fn <+> sep (map ppr args),
-				ptext SLIT("Rule 1:") <+> ppr rule1, 
-				ptext SLIT("Rule 2:") <+> ppr rule2]) $
-		findBest target (rule1,ans1) prs
-#else
-  | otherwise = findBest target (rule1,ans1) prs
-#endif
-  where
-    (fn,args) = target
-
-isMoreSpecific :: CoreRule -> CoreRule -> Bool
-isMoreSpecific (BuiltinRule {}) r2 = True
-isMoreSpecific r1 (BuiltinRule {}) = False
-isMoreSpecific (Rule { ru_bndrs = bndrs1, ru_args = args1 })
-	       (Rule { ru_bndrs = bndrs2, ru_args = args2 })
-  = isJust (matchN in_scope bndrs2 args2 args1)
-  where
-   in_scope = mkInScopeSet (mkVarSet bndrs1)
-	-- Actually we should probably include the free vars 
-	-- of rule1's args, but I can't be bothered
-
-noBlackList :: Activation -> Bool
-noBlackList act = False		-- Nothing is black listed
-
-matchRule :: (Activation -> Bool) -> InScopeSet
-	  -> [CoreExpr] -> [Maybe Name]
-	  -> CoreRule -> Maybe CoreExpr
-
--- If (matchRule rule args) returns Just (name,rhs)
--- then (f args) matches the rule, and the corresponding
--- rewritten RHS is rhs
---
--- The bndrs and rhs is occurrence-analysed
---
--- 	Example
---
--- The rule
---	forall f g x. map f (map g x) ==> map (f . g) x
--- is stored
---	CoreRule "map/map" 
---		 [f,g,x]		-- tpl_vars
---		 [f,map g x]		-- tpl_args
---		 map (f.g) x)		-- rhs
---	  
--- Then the call: matchRule the_rule [e1,map e2 e3]
---	  = Just ("map/map", (\f,g,x -> rhs) e1 e2 e3)
---
--- Any 'surplus' arguments in the input are simply put on the end
--- of the output.
-
-matchRule is_active in_scope args rough_args
-	  (BuiltinRule { ru_name = name, ru_try = match_fn })
-  = case match_fn args of
-	Just expr -> Just expr
-	Nothing   -> Nothing
-
-matchRule is_active in_scope args rough_args
-          (Rule { ru_name = rn, ru_act = act, ru_rough = tpl_tops,
-		  ru_bndrs = tpl_vars, ru_args = tpl_args,
-		  ru_rhs = rhs })
-  | not (is_active act)		      = Nothing
-  | ruleCantMatch tpl_tops rough_args = Nothing
-  | otherwise
-  = case matchN in_scope tpl_vars tpl_args args of
-	Nothing			   -> Nothing
-	Just (tpl_vals, leftovers) -> Just (rule_fn
-					    `mkApps` tpl_vals
-					    `mkApps` leftovers)
-  where
-    rule_fn = occurAnalyseExpr (mkLams tpl_vars rhs)
-	-- We could do this when putting things into the rulebase, I guess
-\end{code}
-
-\begin{code}
-matchN	:: InScopeSet
-	-> [Var]		-- Template tyvars
-	-> [CoreExpr]		-- Template
-	-> [CoreExpr]		-- Target; can have more elts than template
-	-> Maybe ([CoreExpr], 	-- What is substituted for each template var
-		  [CoreExpr])	-- Leftover target exprs
-
-matchN in_scope tmpl_vars tmpl_es target_es
-  = do	{ (subst, leftover_es) <- go init_menv emptySubstEnv tmpl_es target_es
-	; return (map (lookup_tmpl subst) tmpl_vars, leftover_es) }
-  where
-    init_menv = ME { me_tmpls = mkVarSet tmpl_vars, me_env = init_rn_env }
-    init_rn_env = mkRnEnv2 (extendInScopeSetList in_scope tmpl_vars)
-		
-    go menv subst []     es 	= Just (subst, es)
-    go menv subst ts     [] 	= Nothing	-- Fail if too few actual args
-    go menv subst (t:ts) (e:es) = do { subst1 <- match menv subst t e 
-				     ; go menv subst1 ts es }
-
-    lookup_tmpl :: (TvSubstEnv, IdSubstEnv) -> Var -> CoreExpr
-    lookup_tmpl (tv_subst, id_subst) tmpl_var
-	| isTyVar tmpl_var = case lookupVarEnv tv_subst tmpl_var of
-				Just ty 	-> Type ty
-				Nothing 	-> unbound tmpl_var
-	| otherwise	   = case lookupVarEnv id_subst tmpl_var of
-				Just e -> e
-				other  -> unbound tmpl_var
- 
-    unbound var = pprPanic "Template variable unbound in rewrite rule" (ppr var)
-\end{code}
-
-
-	---------------------------------------------
-		The inner workings of matching
-	---------------------------------------------
-
-\begin{code}
--- These two definitions are not the same as in Subst,
--- but they simple and direct, and purely local to this module
--- The third, for TvSubstEnv, is the same as in VarEnv, but repeated here
--- for uniformity with IdSubstEnv
-type SubstEnv   = (TvSubstEnv, IdSubstEnv)	
-type IdSubstEnv = IdEnv    CoreExpr		
-
-emptySubstEnv :: SubstEnv
-emptySubstEnv = (emptyVarEnv, emptyVarEnv)
-
-
---	At one stage I tried to match even if there are more 
---	template args than real args.
-
---	I now think this is probably a bad idea.
---	Should the template (map f xs) match (map g)?  I think not.
---	For a start, in general eta expansion wastes work.
---	SLPJ July 99
-
-
-match :: MatchEnv
-      -> SubstEnv
-      -> CoreExpr		-- Template
-      -> CoreExpr		-- Target
-      -> Maybe SubstEnv
-
--- See the notes with Unify.match, which matches types
--- Everything is very similar for terms
-
--- Interesting examples:
--- Consider matching
---	\x->f 	   against    \f->f
--- When we meet the lambdas we must remember to rename f to f' in the
--- second expresion.  The RnEnv2 does that.
---
--- Consider matching 
---	forall a. \b->b	   against   \a->3
--- We must rename the \a.  Otherwise when we meet the lambdas we 
--- might substitute [a/b] in the template, and then erroneously 
--- succeed in matching what looks like the template variable 'a' against 3.
-
--- The Var case follows closely what happens in Unify.match
-match menv subst@(tv_subst, id_subst) (Var v1) e2 
-  | v1 `elemVarSet` me_tmpls menv
-  = case lookupVarEnv id_subst v1' of
-	Nothing	| any (inRnEnvR rn_env) (varSetElems (exprFreeVars e2))
-		-> Nothing	-- Occurs check failure
-		-- e.g. match forall a. (\x-> a x) against (\y. y y)
-
-		| otherwise
-		-> Just (tv_subst, extendVarEnv id_subst v1 e2)
-
-	Just e2' | tcEqExprX (nukeRnEnvL rn_env) e2' e2 
-		 -> Just subst
-
-	other -> Nothing
-
-  | otherwise	-- v1 is not a template variable
-  = case e2 of
-	Var v2 | v1' == rnOccR rn_env v2 -> Just subst
-	other				 -> Nothing
-  where
-    rn_env = me_env menv
-    v1'    = rnOccL rn_env v1
-
--- Here is another important rule: if the term being matched is a
--- variable, we expand it so long as its unfolding is a WHNF
--- (Its occurrence information is not necessarily up to date,
---  so we don't use it.)
-match menv subst e1 (Var v2)
-  | isCheapUnfolding unfolding
-  = match menv subst e1 (unfoldingTemplate unfolding)
-  where
-    unfolding = idUnfolding v2
-
-match menv subst (Lit lit1) (Lit lit2)
-  | lit1 == lit2
-  = Just subst
-
-match menv subst (App f1 a1) (App f2 a2)
-  = do 	{ subst' <- match menv subst f1 f2
-	; match menv subst' a1 a2 }
-
-match menv subst (Lam x1 e1) (Lam x2 e2)
-  = match menv' subst e1 e2
-  where
-    menv' = menv { me_env = rnBndr2 (me_env menv) x1 x2 }
-
--- This rule does eta expansion
---		(\x.M)  ~  N 	iff	M  ~  N x
-match menv subst (Lam x1 e1) e2
-  = match menv' subst e1 (App e2 (varToCoreExpr new_x))
-  where
-    (rn_env', new_x) = rnBndrL (me_env menv) x1
-    menv' = menv { me_env = rn_env' }
-
--- Eta expansion the other way
---	M  ~  (\y.N)	iff   M	y     ~  N
-match menv subst e1 (Lam x2 e2)
-  = match menv' subst (App e1 (varToCoreExpr new_x)) e2
-  where
-    (rn_env', new_x) = rnBndrR (me_env menv) x2
-    menv' = menv { me_env = rn_env' }
-
-match menv subst (Case e1 x1 ty1 alts1) (Case e2 x2 ty2 alts2)
-  = do	{ subst1 <- match_ty menv subst ty1 ty2
-	; subst2 <- match menv subst1 e1 e2
-	; let menv' = menv { me_env = rnBndr2 (me_env menv) x2 x2 }
-	; match_alts menv' subst2 alts1 alts2	-- Alts are both sorted
-	}
-
-match menv subst (Type ty1) (Type ty2)
-  = match_ty menv subst ty1 ty2
-
-match menv subst (Note (Coerce to1 from1) e1) (Note (Coerce to2 from2) e2)
-  = do	{ subst1 <- match_ty menv subst  to1   to2
-	; subst2 <- match_ty menv subst1 from1 from2
-	; match menv subst2 e1 e2 }
-
--- This is an interesting rule: we simply ignore lets in the 
--- term being matched against!  The unfolding inside it is (by assumption)
--- already inside any occurrences of the bound variables, so we'll expand
--- them when we encounter them.
-match menv subst e1 (Let (NonRec x2 r2) e2)
-  = match menv' subst e1 e2
-  where
-    menv' = menv { me_env = fst (rnBndrR (me_env menv) x2) }
-	-- It's important to do this renaming. For example:
-	-- Matching
-	--	forall f,x,xs. f (x:xs)
-	--   against
-	--	f (let y = e in (y:[]))
-	-- We must not get success with x->y!  Instead, we 
-	-- need an occurs check.
-
--- Everything else fails
-match menv subst e1 e2 = Nothing
-
-------------------------------------------
-match_alts :: MatchEnv
-      -> SubstEnv
-      -> [CoreAlt]		-- Template
-      -> [CoreAlt]		-- Target
-      -> Maybe SubstEnv
-match_alts menv subst [] []
-  = return subst
-match_alts menv subst ((c1,vs1,r1):alts1) ((c2,vs2,r2):alts2)
-  | c1 == c2
-  = do	{ subst1 <- match menv' subst r1 r2
-	; match_alts menv subst1 alts1 alts2 }
-  where
-    menv' :: MatchEnv
-    menv' = menv { me_env = rnBndrs2 (me_env menv) vs1 vs2 }
-
-match_alts menv subst alts1 alts2 
-  = Nothing
-\end{code}
-
-Matching Core types: use the matcher in TcType.
-Notice that we treat newtypes as opaque.  For example, suppose 
-we have a specialised version of a function at a newtype, say 
-	newtype T = MkT Int
-We only want to replace (f T) with f', not (f Int).
-
-\begin{code}
-------------------------------------------
-match_ty menv (tv_subst, id_subst) ty1 ty2
-  = do	{ tv_subst' <- Unify.ruleMatchTyX menv tv_subst ty1 ty2
-	; return (tv_subst', id_subst) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Checking a program for failing rule applications}
-%*									*
-%************************************************************************
-
------------------------------------------------------
-			Game plan
------------------------------------------------------
-
-We want to know what sites have rules that could have fired but didn't.
-This pass runs over the tree (without changing it) and reports such.
-
-NB: we assume that this follows a run of the simplifier, so every Id
-occurrence (including occurrences of imported Ids) is decorated with
-all its (active) rules.  No need to construct a rule base or anything
-like that.
-
-\begin{code}
-ruleCheckProgram :: CompilerPhase -> String -> [CoreBind] -> SDoc
--- Report partial matches for rules beginning 
--- with the specified string
-ruleCheckProgram phase rule_pat binds 
-  | isEmptyBag results
-  = text "Rule check results: no rule application sites"
-  | otherwise
-  = vcat [text "Rule check results:",
-	  line,
-	  vcat [ p $$ line | p <- bagToList results ]
-	 ]
-  where
-    results = unionManyBags (map (ruleCheckBind (phase, rule_pat)) binds)
-    line = text (replicate 20 '-')
-	  
-type RuleCheckEnv = (CompilerPhase, String) 	-- Phase and Pattern
-
-ruleCheckBind :: RuleCheckEnv -> CoreBind -> Bag SDoc
-   -- The Bag returned has one SDoc for each call site found
-ruleCheckBind env (NonRec b r) = ruleCheck env r
-ruleCheckBind env (Rec prs)    = unionManyBags [ruleCheck env r | (b,r) <- prs]
-
-ruleCheck :: RuleCheckEnv -> CoreExpr -> Bag SDoc
-ruleCheck env (Var v) 	    = emptyBag
-ruleCheck env (Lit l) 	    = emptyBag
-ruleCheck env (Type ty)     = emptyBag
-ruleCheck env (App f a)     = ruleCheckApp env (App f a) []
-ruleCheck env (Note n e)    = ruleCheck env e
-ruleCheck env (Let bd e)    = ruleCheckBind env bd `unionBags` ruleCheck env e
-ruleCheck env (Lam b e)     = ruleCheck env e
-ruleCheck env (Case e _ _ as) = ruleCheck env e `unionBags` 
-			        unionManyBags [ruleCheck env r | (_,_,r) <- as]
-
-ruleCheckApp env (App f a) as = ruleCheck env a `unionBags` ruleCheckApp env f (a:as)
-ruleCheckApp env (Var f) as   = ruleCheckFun env f as
-ruleCheckApp env other as     = ruleCheck env other
-\end{code}
-
-\begin{code}
-ruleCheckFun :: RuleCheckEnv -> Id -> [CoreExpr] -> Bag SDoc
--- Produce a report for all rules matching the predicate
--- saying why it doesn't match the specified application
-
-ruleCheckFun (phase, pat) fn args
-  | null name_match_rules = emptyBag
-  | otherwise		  = unitBag (ruleAppCheck_help phase fn args name_match_rules)
-  where
-    name_match_rules = filter match (idCoreRules fn)
-    match rule = pat `isPrefixOf` unpackFS (ruleName rule)
-
-ruleAppCheck_help :: CompilerPhase -> Id -> [CoreExpr] -> [CoreRule] -> SDoc
-ruleAppCheck_help phase fn args rules
-  = 	-- The rules match the pattern, so we want to print something
-    vcat [text "Expression:" <+> ppr (mkApps (Var fn) args),
-	  vcat (map check_rule rules)]
-  where
-    n_args = length args
-    i_args = args `zip` [1::Int ..]
-    rough_args = map roughTopName args
-
-    check_rule rule = rule_herald rule <> colon <+> rule_info rule
-
-    rule_herald (BuiltinRule { ru_name = name })
-	= ptext SLIT("Builtin rule") <+> doubleQuotes (ftext name)
-    rule_herald (Rule { ru_name = name })
-	= ptext SLIT("Rule") <+> doubleQuotes (ftext name)
-
-    rule_info rule
-	| Just _ <- matchRule noBlackList emptyInScopeSet args rough_args rule
-	= text "matches (which is very peculiar!)"
-
-    rule_info (BuiltinRule {}) = text "does not match"
-
-    rule_info (Rule { ru_name = name, ru_act = act, 
-		      ru_bndrs = rule_bndrs, ru_args = rule_args})
-	| not (isActive phase act)    = text "active only in later phase"
-	| n_args < n_rule_args	      = text "too few arguments"
-	| n_mismatches == n_rule_args = text "no arguments match"
-	| n_mismatches == 0	      = text "all arguments match (considered individually), but rule as a whole does not"
-	| otherwise		      = text "arguments" <+> ppr mismatches <+> text "do not match (1-indexing)"
-	where
-	  n_rule_args  = length rule_args
-	  n_mismatches = length mismatches
-	  mismatches   = [i | (rule_arg, (arg,i)) <- rule_args `zip` i_args,
-			      not (isJust (match_fn rule_arg arg))]
-
-	  lhs_fvs = exprsFreeVars rule_args	-- Includes template tyvars
-	  match_fn rule_arg arg = match menv emptySubstEnv rule_arg arg
-		where
-		  in_scope = lhs_fvs `unionVarSet` exprFreeVars arg
-		  menv = ME { me_env   = mkRnEnv2 (mkInScopeSet in_scope)
-			    , me_tmpls = mkVarSet rule_bndrs }
-\end{code}
-
diff --git a/ghc/compiler/specialise/SpecConstr.lhs b/ghc/compiler/specialise/SpecConstr.lhs
deleted file mode 100644
index 74944da983..0000000000
--- a/ghc/compiler/specialise/SpecConstr.lhs
+++ /dev/null
@@ -1,625 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[SpecConstr]{Specialise over constructors}
-
-\begin{code}
-module SpecConstr(
-	specConstrProgram	
-    ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-import CoreLint		( showPass, endPass )
-import CoreUtils	( exprType, tcEqExpr, mkPiTypes )
-import CoreFVs 		( exprsFreeVars )
-import CoreSubst	( Subst, mkSubst, substExpr )
-import CoreTidy		( tidyRules )
-import PprCore		( pprRules )
-import WwLib		( mkWorkerArgs )
-import DataCon		( dataConRepArity, isVanillaDataCon )
-import Type		( tyConAppArgs, tyVarsOfTypes )
-import Unify		( coreRefineTys )
-import Id		( Id, idName, idType, isDataConWorkId_maybe, 
-			  mkUserLocal, mkSysLocal )
-import Var		( Var )
-import VarEnv
-import VarSet
-import Name		( nameOccName, nameSrcLoc )
-import Rules		( addIdSpecialisations, mkLocalRule, rulesOfBinds )
-import OccName		( mkSpecOcc )
-import ErrUtils		( dumpIfSet_dyn )
-import DynFlags		( DynFlags, DynFlag(..) )
-import BasicTypes	( Activation(..) )
-import Maybes		( orElse )
-import Util		( mapAccumL, lengthAtLeast, notNull )
-import List		( nubBy, partition )
-import UniqSupply
-import Outputable
-import FastString
-\end{code}
-
------------------------------------------------------
-			Game plan
------------------------------------------------------
-
-Consider
-	drop n []     = []
-	drop 0 xs     = []
-	drop n (x:xs) = drop (n-1) xs
-
-After the first time round, we could pass n unboxed.  This happens in
-numerical code too.  Here's what it looks like in Core:
-
-	drop n xs = case xs of
-		      []     -> []
-		      (y:ys) -> case n of 
-				  I# n# -> case n# of
-					     0 -> []
-					     _ -> drop (I# (n# -# 1#)) xs
-
-Notice that the recursive call has an explicit constructor as argument.
-Noticing this, we can make a specialised version of drop
-	
-	RULE: drop (I# n#) xs ==> drop' n# xs
-
-	drop' n# xs = let n = I# n# in ...orig RHS...
-
-Now the simplifier will apply the specialisation in the rhs of drop', giving
-
-	drop' n# xs = case xs of
-		      []     -> []
-		      (y:ys) -> case n# of
-				  0 -> []
-				  _ -> drop (n# -# 1#) xs
-
-Much better!  
-
-We'd also like to catch cases where a parameter is carried along unchanged,
-but evaluated each time round the loop:
-
-	f i n = if i>0 || i>n then i else f (i*2) n
-
-Here f isn't strict in n, but we'd like to avoid evaluating it each iteration.
-In Core, by the time we've w/wd (f is strict in i) we get
-
-	f i# n = case i# ># 0 of
-		   False -> I# i#
-		   True  -> case n of n' { I# n# ->
-			    case i# ># n# of
-				False -> I# i#
-				True  -> f (i# *# 2#) n'
-
-At the call to f, we see that the argument, n is know to be (I# n#),
-and n is evaluated elsewhere in the body of f, so we can play the same
-trick as above.  However we don't want to do that if the boxed version
-of n is needed (else we'd avoid the eval but pay more for re-boxing n).
-So in this case we want that the *only* uses of n are in case statements.
-
-
-So we look for
-
-* A self-recursive function.  Ignore mutual recursion for now, 
-  because it's less common, and the code is simpler for self-recursion.
-
-* EITHER
-
-   a) At a recursive call, one or more parameters is an explicit 
-      constructor application
-	AND
-      That same parameter is scrutinised by a case somewhere in 
-      the RHS of the function
-
-  OR
-
-    b) At a recursive call, one or more parameters has an unfolding
-       that is an explicit constructor application
-	AND
-      That same parameter is scrutinised by a case somewhere in 
-      the RHS of the function
-	AND
-      Those are the only uses of the parameter
-
-
-There's a bit of a complication with type arguments.  If the call
-site looks like
-
-	f p = ...f ((:) [a] x xs)...
-
-then our specialised function look like
-
-	f_spec x xs = let p = (:) [a] x xs in ....as before....
-
-This only makes sense if either
-  a) the type variable 'a' is in scope at the top of f, or
-  b) the type variable 'a' is an argument to f (and hence fs)
-
-Actually, (a) may hold for value arguments too, in which case
-we may not want to pass them.  Supose 'x' is in scope at f's
-defn, but xs is not.  Then we'd like
-
-	f_spec xs = let p = (:) [a] x xs in ....as before....
-
-Similarly (b) may hold too.  If x is already an argument at the
-call, no need to pass it again.
-
-Finally, if 'a' is not in scope at the call site, we could abstract
-it as we do the term variables:
-
-	f_spec a x xs = let p = (:) [a] x xs in ...as before...
-
-So the grand plan is:
-
-	* abstract the call site to a constructor-only pattern
-	  e.g.  C x (D (f p) (g q))  ==>  C s1 (D s2 s3)
-
-	* Find the free variables of the abstracted pattern
-
-	* Pass these variables, less any that are in scope at
-	  the fn defn.
-
-
-NOTICE that we only abstract over variables that are not in scope,
-so we're in no danger of shadowing variables used in "higher up"
-in f_spec's RHS.
-
-
-%************************************************************************
-%*									*
-\subsection{Top level wrapper stuff}
-%*									*
-%************************************************************************
-
-\begin{code}
-specConstrProgram :: DynFlags -> UniqSupply -> [CoreBind] -> IO [CoreBind]
-specConstrProgram dflags us binds
-  = do
-	showPass dflags "SpecConstr"
-
-	let (binds', _) = initUs us (go emptyScEnv binds)
-
-	endPass dflags "SpecConstr" Opt_D_dump_spec binds'
-
-	dumpIfSet_dyn dflags Opt_D_dump_rules "Top-level specialisations"
-		  (pprRules (tidyRules emptyTidyEnv (rulesOfBinds binds')))
-
-	return binds'
-  where
-    go env []	        = returnUs []
-    go env (bind:binds) = scBind env bind 	`thenUs` \ (env', _, bind') ->
-			  go env' binds 	`thenUs` \ binds' ->
-			  returnUs (bind' : binds')
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Environment: goes downwards}
-%*									*
-%************************************************************************
-
-\begin{code}
-data ScEnv = SCE { scope :: VarEnv HowBound,
-			-- Binds all non-top-level variables in scope
-
-		   cons  :: ConstrEnv
-	     }
-
-type ConstrEnv = IdEnv ConValue
-data ConValue  = CV AltCon [CoreArg]
-	-- Variables known to be bound to a constructor
-	-- in a particular case alternative
-
-refineConstrEnv :: Subst -> ConstrEnv -> ConstrEnv
--- The substitution is a type substitution only
-refineConstrEnv subst env = mapVarEnv refine_con_value env
-  where
-    refine_con_value (CV con args) = CV con (map (substExpr subst) args)
-
-emptyScEnv = SCE { scope = emptyVarEnv, cons = emptyVarEnv }
-
-data HowBound = RecFun		-- These are the recursive functions for which 
-				-- we seek interesting call patterns
-
-	      | RecArg		-- These are those functions' arguments; we are
-				-- interested to see if those arguments are scrutinised
-
-	      | Other		-- We track all others so we know what's in scope
-				-- This is used in spec_one to check what needs to be
-				-- passed as a parameter and what is in scope at the 
-				-- function definition site
-
-instance Outputable HowBound where
-  ppr RecFun = text "RecFun"
-  ppr RecArg = text "RecArg"
-  ppr Other = text "Other"
-
-lookupScopeEnv env v = lookupVarEnv (scope env) v
-
-extendBndrs env bndrs = env { scope = extendVarEnvList (scope env) [(b,Other) | b <- bndrs] }
-extendBndr  env bndr  = env { scope = extendVarEnv (scope env) bndr Other }
-
-    -- When we encounter
-    --	case scrut of b
-    --	    C x y -> ...
-    -- we want to bind b, and perhaps scrut too, to (C x y)
-extendCaseBndrs :: ScEnv -> Id -> CoreExpr -> AltCon -> [Var] -> ScEnv
-extendCaseBndrs env case_bndr scrut DEFAULT alt_bndrs
-  = extendBndrs env (case_bndr : alt_bndrs)
-
-extendCaseBndrs env case_bndr scrut con@(LitAlt lit) alt_bndrs
-  = ASSERT( null alt_bndrs ) extendAlt env case_bndr scrut (CV con []) []
-
-extendCaseBndrs env case_bndr scrut con@(DataAlt data_con) alt_bndrs
-  | isVanillaDataCon data_con
-  = extendAlt env case_bndr scrut (CV con vanilla_args) alt_bndrs
-    
-  | otherwise	-- GADT
-  = extendAlt env1 case_bndr scrut (CV con gadt_args) alt_bndrs
-  where
-    vanilla_args = map Type (tyConAppArgs (idType case_bndr)) ++
-		   map varToCoreExpr alt_bndrs
-
-    gadt_args = map (substExpr subst . varToCoreExpr) alt_bndrs
-
-    (alt_tvs, _) = span isTyVar alt_bndrs
-    Just (tv_subst, is_local) = coreRefineTys data_con alt_tvs (idType case_bndr)
-    subst = mkSubst in_scope tv_subst emptyVarEnv	-- No Id substitition
-    in_scope = mkInScopeSet (tyVarsOfTypes (varEnvElts tv_subst))
-
-    env1 | is_local  = env
-	 | otherwise = env { cons = refineConstrEnv subst (cons env) }
-
-
-
-extendAlt :: ScEnv -> Id -> CoreExpr -> ConValue -> [Var] -> ScEnv
-extendAlt env case_bndr scrut val alt_bndrs
-  = let 
-       env1 = SCE { scope = extendVarEnvList (scope env) [(b,Other) | b <- case_bndr : alt_bndrs],
-		    cons  = extendVarEnv     (cons  env) case_bndr val }
-    in
-    case scrut of
-	Var v ->   -- Bind the scrutinee in the ConstrEnv if it's a variable
-		   -- Also forget if the scrutinee is a RecArg, because we're
-		   -- now in the branch of a case, and we don't want to
-		   -- record a non-scrutinee use of v if we have
-		   --	case v of { (a,b) -> ...(f v)... }
-		 SCE { scope = extendVarEnv (scope env1) v Other,
-		       cons  = extendVarEnv (cons env1)  v val }
-	other -> env1
-
-    -- When we encounter a recursive function binding
-    --	f = \x y -> ...
-    -- we want to extend the scope env with bindings 
-    -- that record that f is a RecFn and x,y are RecArgs
-extendRecBndr env fn bndrs
-  =  env { scope = scope env `extendVarEnvList` 
-		   ((fn,RecFun): [(bndr,RecArg) | bndr <- bndrs]) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Usage information: flows upwards}
-%*									*
-%************************************************************************
-
-\begin{code}
-data ScUsage
-   = SCU {
-	calls :: !(IdEnv ([Call])),	-- Calls
-					-- The functions are a subset of the 
-					-- 	RecFuns in the ScEnv
-
-	occs :: !(IdEnv ArgOcc)		-- Information on argument occurrences
-     }					-- The variables are a subset of the 
-					--	RecArg in the ScEnv
-
-type Call = (ConstrEnv, [CoreArg])
-	-- The arguments of the call, together with the
-	-- env giving the constructor bindings at the call site
-
-nullUsage = SCU { calls = emptyVarEnv, occs = emptyVarEnv }
-
-combineUsage u1 u2 = SCU { calls = plusVarEnv_C (++) (calls u1) (calls u2),
-			   occs  = plusVarEnv_C combineOcc (occs u1) (occs u2) }
-
-combineUsages [] = nullUsage
-combineUsages us = foldr1 combineUsage us
-
-data ArgOcc = CaseScrut 
-	    | OtherOcc
-	    | Both
-
-instance Outputable ArgOcc where
-  ppr CaseScrut = ptext SLIT("case-scrut")
-  ppr OtherOcc  = ptext SLIT("other-occ")
-  ppr Both      = ptext SLIT("case-scrut and other")
-
-combineOcc CaseScrut CaseScrut = CaseScrut
-combineOcc OtherOcc  OtherOcc  = OtherOcc
-combineOcc _	     _	       = Both
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The main recursive function}
-%*									*
-%************************************************************************
-
-The main recursive function gathers up usage information, and
-creates specialised versions of functions.
-
-\begin{code}
-scExpr :: ScEnv -> CoreExpr -> UniqSM (ScUsage, CoreExpr)
-	-- The unique supply is needed when we invent
-	-- a new name for the specialised function and its args
-
-scExpr env e@(Type t) = returnUs (nullUsage, e)
-scExpr env e@(Lit l)  = returnUs (nullUsage, e)
-scExpr env e@(Var v)  = returnUs (varUsage env v OtherOcc, e)
-scExpr env (Note n e) = scExpr env e	`thenUs` \ (usg,e') ->
-			returnUs (usg, Note n e')
-scExpr env (Lam b e)  = scExpr (extendBndr env b) e	`thenUs` \ (usg,e') ->
-			returnUs (usg, Lam b e')
-
-scExpr env (Case scrut b ty alts) 
-  = sc_scrut scrut		`thenUs` \ (scrut_usg, scrut') ->
-    mapAndUnzipUs sc_alt alts	`thenUs` \ (alts_usgs, alts') ->
-    returnUs (combineUsages alts_usgs `combineUsage` scrut_usg,
-	      Case scrut' b ty alts')
-  where
-    sc_scrut e@(Var v) = returnUs (varUsage env v CaseScrut, e)
-    sc_scrut e	       = scExpr env e
-
-    sc_alt (con,bs,rhs) = scExpr env1 rhs	`thenUs` \ (usg,rhs') ->
-			  returnUs (usg, (con,bs,rhs'))
-			where
-			  env1 = extendCaseBndrs env b scrut con bs
-
-scExpr env (Let bind body)
-  = scBind env bind	`thenUs` \ (env', bind_usg, bind') ->
-    scExpr env' body	`thenUs` \ (body_usg, body') ->
-    returnUs (bind_usg `combineUsage` body_usg, Let bind' body')
-
-scExpr env e@(App _ _) 
-  = let 
-	(fn, args) = collectArgs e
-    in
-    mapAndUnzipUs (scExpr env) args	`thenUs` \ (usgs, args') ->
-    let
-	arg_usg = combineUsages usgs
-	fn_usg  | Var f <- fn,
-		  Just RecFun <- lookupScopeEnv env f
-		= SCU { calls = unitVarEnv f [(cons env, args)], 
-			occs  = emptyVarEnv }
-		| otherwise
-		= nullUsage
-    in
-    returnUs (arg_usg `combineUsage` fn_usg, mkApps fn args')
-	-- Don't bother to look inside fn;
-	-- it's almost always a variable
-
-----------------------
-scBind :: ScEnv -> CoreBind -> UniqSM (ScEnv, ScUsage, CoreBind)
-scBind env (Rec [(fn,rhs)])
-  | notNull val_bndrs
-  = scExpr env_fn_body body		`thenUs` \ (usg, body') ->
-    let
-	SCU { calls = calls, occs = occs } = usg
-    in
-    specialise env fn bndrs body usg	`thenUs` \ (rules, spec_prs) ->
-    returnUs (extendBndr env fn,	-- For the body of the letrec, just
-					-- extend the env with Other to record 
-					-- that it's in scope; no funny RecFun business
-	      SCU { calls = calls `delVarEnv` fn, occs = occs `delVarEnvList` val_bndrs},
-	      Rec ((fn `addIdSpecialisations` rules, mkLams bndrs body') : spec_prs))
-  where
-    (bndrs,body) = collectBinders rhs
-    val_bndrs    = filter isId bndrs
-    env_fn_body	 = extendRecBndr env fn bndrs
-
-scBind env (Rec prs)
-  = mapAndUnzipUs do_one prs	`thenUs` \ (usgs, prs') ->
-    returnUs (extendBndrs env (map fst prs), combineUsages usgs, Rec prs')
-  where
-    do_one (bndr,rhs) = scExpr env rhs	`thenUs` \ (usg, rhs') ->
-		        returnUs (usg, (bndr,rhs'))
-
-scBind env (NonRec bndr rhs)
-  = scExpr env rhs	`thenUs` \ (usg, rhs') ->
-    returnUs (extendBndr env bndr, usg, NonRec bndr rhs')
-
-----------------------
-varUsage env v use 
-  | Just RecArg <- lookupScopeEnv env v = SCU { calls = emptyVarEnv, 
-						occs = unitVarEnv v use }
-  | otherwise		   	        = nullUsage
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The specialiser}
-%*									*
-%************************************************************************
-
-\begin{code}
-specialise :: ScEnv
-	   -> Id 			-- Functionn
-	   -> [CoreBndr] -> CoreExpr	-- Its RHS
-	   -> ScUsage			-- Info on usage
-	   -> UniqSM ([CoreRule], 	-- Rules
-		      [(Id,CoreExpr)])	-- Bindings
-
-specialise env fn bndrs body (SCU {calls=calls, occs=occs})
-  = getUs		`thenUs` \ us ->
-    let
-	all_calls = lookupVarEnv calls fn `orElse` []
-
-	good_calls :: [[CoreArg]]
-	good_calls = [ pats
-		     | (con_env, call_args) <- all_calls,
-		       call_args `lengthAtLeast` n_bndrs,	    -- App is saturated
-		       let call = (bndrs `zip` call_args),
-		       any (good_arg con_env occs) call,    -- At least one arg is a constr app
-		       let (_, pats) = argsToPats con_env us call_args
-		     ]
-    in
-    mapAndUnzipUs (spec_one env fn (mkLams bndrs body)) 
-		  (nubBy same_call good_calls `zip` [1..])
-  where
-    n_bndrs  = length bndrs
-    same_call as1 as2 = and (zipWith tcEqExpr as1 as2)
-
----------------------
-good_arg :: ConstrEnv -> IdEnv ArgOcc -> (CoreBndr, CoreArg) -> Bool
-good_arg con_env arg_occs (bndr, arg)
-  = case is_con_app_maybe con_env arg of	
-	Just _ ->  bndr_usg_ok arg_occs bndr arg
-	other   -> False
-
-bndr_usg_ok :: IdEnv ArgOcc -> Var -> CoreArg -> Bool
-bndr_usg_ok arg_occs bndr arg
-  = case lookupVarEnv arg_occs bndr of
-	Just CaseScrut -> True			-- Used only by case scrutiny
-	Just Both      -> case arg of		-- Used by case and elsewhere
-			    App _ _ -> True	-- so the arg should be an explicit con app
-			    other   -> False
-	other -> False				-- Not used, or used wonkily
-    
-
----------------------
-spec_one :: ScEnv
-	 -> Id					-- Function
-	 -> CoreExpr				-- Rhs of the original function
-	 -> ([CoreArg], Int)
-	 -> UniqSM (CoreRule, (Id,CoreExpr))	-- Rule and binding
-
--- spec_one creates a specialised copy of the function, together
--- with a rule for using it.  I'm very proud of how short this
--- function is, considering what it does :-).
-
-{- 
-  Example
-  
-     In-scope: a, x::a   
-     f = /\b \y::[(a,b)] -> ....f (b,c) ((:) (a,(b,c)) (x,v) (h w))...
-	  [c::*, v::(b,c) are presumably bound by the (...) part]
-  ==>
-     f_spec = /\ b c \ v::(b,c) hw::[(a,(b,c))] ->
-		  (...entire RHS of f...) (b,c) ((:) (a,(b,c)) (x,v) hw)
-  
-     RULE:  forall b::* c::*,		-- Note, *not* forall a, x
-		   v::(b,c),
-		   hw::[(a,(b,c))] .
-  
-	    f (b,c) ((:) (a,(b,c)) (x,v) hw) = f_spec b c v hw
--}
-
-spec_one env fn rhs (pats, rule_number)
-  = getUniqueUs 		`thenUs` \ spec_uniq ->
-    let 
-	fn_name      = idName fn
-	fn_loc       = nameSrcLoc fn_name
-	spec_occ     = mkSpecOcc (nameOccName fn_name)
-	pat_fvs	     = varSetElems (exprsFreeVars pats)
-	vars_to_bind = filter not_avail pat_fvs
-	not_avail v  = not (v `elemVarEnv` scope env)
-		-- Put the type variables first; the type of a term
-		-- variable may mention a type variable
-	(tvs, ids)   = partition isTyVar vars_to_bind
-	bndrs  	     = tvs ++ ids
-	spec_body    = mkApps rhs pats
-	body_ty	     = exprType spec_body
-	
-	(spec_lam_args, spec_call_args) = mkWorkerArgs bndrs body_ty
-		-- Usual w/w hack to avoid generating 
-		-- a spec_rhs of unlifted type and no args
-	
-	rule_name = mkFastString ("SC:" ++ showSDoc (ppr fn <> int rule_number))
-	spec_rhs  = mkLams spec_lam_args spec_body
-	spec_id   = mkUserLocal spec_occ spec_uniq (mkPiTypes spec_lam_args body_ty) fn_loc
-	rule_rhs  = mkVarApps (Var spec_id) spec_call_args
-	rule      = mkLocalRule rule_name specConstrActivation fn_name bndrs pats rule_rhs
-    in
-    returnUs (rule, (spec_id, spec_rhs))
-
--- In which phase should the specialise-constructor rules be active?
--- Originally I made them always-active, but Manuel found that
--- this defeated some clever user-written rules.  So Plan B
--- is to make them active only in Phase 0; after all, currently,
--- the specConstr transformation is only run after the simplifier
--- has reached Phase 0.  In general one would want it to be 
--- flag-controllable, but for now I'm leaving it baked in
---					[SLPJ Oct 01]
-specConstrActivation :: Activation
-specConstrActivation = ActiveAfter 0	-- Baked in; see comments above
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Argument analysis}
-%*									*
-%************************************************************************
-
-This code deals with analysing call-site arguments to see whether
-they are constructor applications.
-
-\begin{code}
-    -- argToPat takes an actual argument, and returns an abstracted
-    -- version, consisting of just the "constructor skeleton" of the
-    -- argument, with non-constructor sub-expression replaced by new
-    -- placeholder variables.  For example:
-    --    C a (D (f x) (g y))  ==>  C p1 (D p2 p3)
-
-argToPat   :: ConstrEnv -> UniqSupply -> CoreArg -> (UniqSupply, CoreExpr)
-argToPat env us (Type ty) 
-  = (us, Type ty)
-
-argToPat env us arg
-  | Just (CV dc args) <- is_con_app_maybe env arg
-  = let
-	(us',args') = argsToPats env us args
-    in
-    (us', mk_con_app dc args')
-
-argToPat env us (Var v)	-- Don't uniqify existing vars,
-  = (us, Var v)		-- so that we can spot when we pass them twice
-
-argToPat env us arg
-  = (us1, Var (mkSysLocal FSLIT("sc") (uniqFromSupply us2) (exprType arg)))
-  where
-    (us1,us2) = splitUniqSupply us
-
-argsToPats :: ConstrEnv -> UniqSupply -> [CoreArg] -> (UniqSupply, [CoreExpr])
-argsToPats env us args = mapAccumL (argToPat env) us args
-\end{code}
-
-
-\begin{code}
-is_con_app_maybe :: ConstrEnv -> CoreExpr -> Maybe ConValue
-is_con_app_maybe env (Var v)
-  = lookupVarEnv env v
-	-- You might think we could look in the idUnfolding here
-	-- but that doesn't take account of which branch of a 
-	-- case we are in, which is the whole point
-
-is_con_app_maybe env (Lit lit)
-  = Just (CV (LitAlt lit) [])
-
-is_con_app_maybe env expr
-  = case collectArgs expr of
-	(Var fun, args) | Just con <- isDataConWorkId_maybe fun,
-			  args `lengthAtLeast` dataConRepArity con
-		-- Might be > because the arity excludes type args
-		        -> Just (CV (DataAlt con) args)
-
-	other -> Nothing
-
-mk_con_app :: AltCon -> [CoreArg] -> CoreExpr
-mk_con_app (LitAlt lit)  []   = Lit lit
-mk_con_app (DataAlt con) args = mkConApp con args
-\end{code}
diff --git a/ghc/compiler/specialise/Specialise.lhs b/ghc/compiler/specialise/Specialise.lhs
deleted file mode 100644
index 0e66b0bc78..0000000000
--- a/ghc/compiler/specialise/Specialise.lhs
+++ /dev/null
@@ -1,1236 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[Specialise]{Stamping out overloading, and (optionally) polymorphism}
-
-\begin{code}
-module Specialise ( specProgram ) where
-
-#include "HsVersions.h"
-
-import DynFlags	( DynFlags, DynFlag(..) )
-import Id		( Id, idName, idType, mkUserLocal ) 
-import TcType		( Type, mkTyVarTy, tcSplitSigmaTy, 
-			  tyVarsOfTypes, tyVarsOfTheta, isClassPred,
-			  tcCmpType, isUnLiftedType
-			)
-import CoreSubst	( Subst, mkEmptySubst, extendTvSubstList, lookupIdSubst,
-			  substBndr, substBndrs, substTy, substInScope,
-			  cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs
-			) 
-import VarSet
-import VarEnv
-import CoreSyn
-import CoreUtils	( applyTypeToArgs, mkPiTypes )
-import CoreFVs		( exprFreeVars, exprsFreeVars, idRuleVars )
-import CoreTidy		( tidyRules )
-import CoreLint		( showPass, endPass )
-import Rules		( addIdSpecialisations, mkLocalRule, lookupRule, emptyRuleBase, rulesOfBinds )
-import PprCore		( pprRules )
-import UniqSupply	( UniqSupply,
-			  UniqSM, initUs_, thenUs, returnUs, getUniqueUs, 
-			  getUs, mapUs
-			)
-import Name		( nameOccName, mkSpecOcc, getSrcLoc )
-import MkId		( voidArgId, realWorldPrimId )
-import FiniteMap
-import Maybes		( catMaybes, maybeToBool )
-import ErrUtils		( dumpIfSet_dyn )
-import BasicTypes	( Activation( AlwaysActive ) )
-import Bag
-import List		( partition )
-import Util		( zipEqual, zipWithEqual, cmpList, lengthIs,
-			  equalLength, lengthAtLeast, notNull )
-import Outputable
-import FastString
-
-infixr 9 `thenSM`
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[notes-Specialise]{Implementation notes [SLPJ, Aug 18 1993]}
-%*									*
-%************************************************************************
-
-These notes describe how we implement specialisation to eliminate
-overloading.
-
-The specialisation pass works on Core
-syntax, complete with all the explicit dictionary application,
-abstraction and construction as added by the type checker.  The
-existing type checker remains largely as it is.
-
-One important thought: the {\em types} passed to an overloaded
-function, and the {\em dictionaries} passed are mutually redundant.
-If the same function is applied to the same type(s) then it is sure to
-be applied to the same dictionary(s)---or rather to the same {\em
-values}.  (The arguments might look different but they will evaluate
-to the same value.)
-
-Second important thought: we know that we can make progress by
-treating dictionary arguments as static and worth specialising on.  So
-we can do without binding-time analysis, and instead specialise on
-dictionary arguments and no others.
-
-The basic idea
-~~~~~~~~~~~~~~
-Suppose we have
-
-	let f = <f_rhs>
-	in <body>
-
-and suppose f is overloaded.
-
-STEP 1: CALL-INSTANCE COLLECTION
-
-We traverse <body>, accumulating all applications of f to types and
-dictionaries.
-
-(Might there be partial applications, to just some of its types and
-dictionaries?  In principle yes, but in practice the type checker only
-builds applications of f to all its types and dictionaries, so partial
-applications could only arise as a result of transformation, and even
-then I think it's unlikely.  In any case, we simply don't accumulate such
-partial applications.)
-
-
-STEP 2: EQUIVALENCES
-
-So now we have a collection of calls to f:
-	f t1 t2 d1 d2
-	f t3 t4 d3 d4
-	...
-Notice that f may take several type arguments.  To avoid ambiguity, we
-say that f is called at type t1/t2 and t3/t4.
-
-We take equivalence classes using equality of the *types* (ignoring
-the dictionary args, which as mentioned previously are redundant).
-
-STEP 3: SPECIALISATION
-
-For each equivalence class, choose a representative (f t1 t2 d1 d2),
-and create a local instance of f, defined thus:
-
-	f@t1/t2 = <f_rhs> t1 t2 d1 d2
-
-f_rhs presumably has some big lambdas and dictionary lambdas, so lots
-of simplification will now result.  However we don't actually *do* that
-simplification.  Rather, we leave it for the simplifier to do.  If we
-*did* do it, though, we'd get more call instances from the specialised
-RHS.  We can work out what they are by instantiating the call-instance
-set from f's RHS with the types t1, t2.
-
-Add this new id to f's IdInfo, to record that f has a specialised version.
-
-Before doing any of this, check that f's IdInfo doesn't already
-tell us about an existing instance of f at the required type/s.
-(This might happen if specialisation was applied more than once, or
-it might arise from user SPECIALIZE pragmas.)
-
-Recursion
-~~~~~~~~~
-Wait a minute!  What if f is recursive?  Then we can't just plug in
-its right-hand side, can we?
-
-But it's ok.  The type checker *always* creates non-recursive definitions
-for overloaded recursive functions.  For example:
-
-	f x = f (x+x)		-- Yes I know its silly
-
-becomes
-
-	f a (d::Num a) = let p = +.sel a d
-			 in
-			 letrec fl (y::a) = fl (p y y)
-			 in
-			 fl
-
-We still have recusion for non-overloaded functions which we
-speciailise, but the recursive call should get specialised to the
-same recursive version.
-
-
-Polymorphism 1
-~~~~~~~~~~~~~~
-
-All this is crystal clear when the function is applied to *constant
-types*; that is, types which have no type variables inside.  But what if
-it is applied to non-constant types?  Suppose we find a call of f at type
-t1/t2.  There are two possibilities:
-
-(a) The free type variables of t1, t2 are in scope at the definition point
-of f.  In this case there's no problem, we proceed just as before.  A common
-example is as follows.  Here's the Haskell:
-
-	g y = let f x = x+x
-	      in f y + f y
-
-After typechecking we have
-
-	g a (d::Num a) (y::a) = let f b (d'::Num b) (x::b) = +.sel b d' x x
-				in +.sel a d (f a d y) (f a d y)
-
-Notice that the call to f is at type type "a"; a non-constant type.
-Both calls to f are at the same type, so we can specialise to give:
-
-	g a (d::Num a) (y::a) = let f@a (x::a) = +.sel a d x x
-				in +.sel a d (f@a y) (f@a y)
-
-
-(b) The other case is when the type variables in the instance types
-are *not* in scope at the definition point of f.  The example we are
-working with above is a good case.  There are two instances of (+.sel a d),
-but "a" is not in scope at the definition of +.sel.  Can we do anything?
-Yes, we can "common them up", a sort of limited common sub-expression deal.
-This would give:
-
-	g a (d::Num a) (y::a) = let +.sel@a = +.sel a d
-				    f@a (x::a) = +.sel@a x x
-				in +.sel@a (f@a y) (f@a y)
-
-This can save work, and can't be spotted by the type checker, because
-the two instances of +.sel weren't originally at the same type.
-
-Further notes on (b)
-
-* There are quite a few variations here.  For example, the defn of
-  +.sel could be floated ouside the \y, to attempt to gain laziness.
-  It certainly mustn't be floated outside the \d because the d has to
-  be in scope too.
-
-* We don't want to inline f_rhs in this case, because
-that will duplicate code.  Just commoning up the call is the point.
-
-* Nothing gets added to +.sel's IdInfo.
-
-* Don't bother unless the equivalence class has more than one item!
-
-Not clear whether this is all worth it.  It is of course OK to
-simply discard call-instances when passing a big lambda.
-
-Polymorphism 2 -- Overloading
-~~~~~~~~~~~~~~
-Consider a function whose most general type is
-
-	f :: forall a b. Ord a => [a] -> b -> b
-
-There is really no point in making a version of g at Int/Int and another
-at Int/Bool, because it's only instancing the type variable "a" which
-buys us any efficiency. Since g is completely polymorphic in b there
-ain't much point in making separate versions of g for the different
-b types.
-
-That suggests that we should identify which of g's type variables
-are constrained (like "a") and which are unconstrained (like "b").
-Then when taking equivalence classes in STEP 2, we ignore the type args
-corresponding to unconstrained type variable.  In STEP 3 we make
-polymorphic versions.  Thus:
-
-	f@t1/ = /\b -> <f_rhs> t1 b d1 d2
-
-We do this.
-
-
-Dictionary floating
-~~~~~~~~~~~~~~~~~~~
-Consider this
-
-	f a (d::Num a) = let g = ...
-			 in
-			 ...(let d1::Ord a = Num.Ord.sel a d in g a d1)...
-
-Here, g is only called at one type, but the dictionary isn't in scope at the
-definition point for g.  Usually the type checker would build a
-definition for d1 which enclosed g, but the transformation system
-might have moved d1's defn inward.  Solution: float dictionary bindings
-outwards along with call instances.
-
-Consider
-
-	f x = let g p q = p==q
-		  h r s = (r+s, g r s)
-	      in
-	      h x x
-
-
-Before specialisation, leaving out type abstractions we have
-
-	f df x = let g :: Eq a => a -> a -> Bool
-		     g dg p q = == dg p q
-		     h :: Num a => a -> a -> (a, Bool)
-		     h dh r s = let deq = eqFromNum dh
-				in (+ dh r s, g deq r s)
-	      in
-	      h df x x
-
-After specialising h we get a specialised version of h, like this:
-
-		    h' r s = let deq = eqFromNum df
-			     in (+ df r s, g deq r s)
-
-But we can't naively make an instance for g from this, because deq is not in scope
-at the defn of g.  Instead, we have to float out the (new) defn of deq
-to widen its scope.  Notice that this floating can't be done in advance -- it only
-shows up when specialisation is done.
-
-User SPECIALIZE pragmas
-~~~~~~~~~~~~~~~~~~~~~~~
-Specialisation pragmas can be digested by the type checker, and implemented
-by adding extra definitions along with that of f, in the same way as before
-
-	f@t1/t2 = <f_rhs> t1 t2 d1 d2
-
-Indeed the pragmas *have* to be dealt with by the type checker, because
-only it knows how to build the dictionaries d1 and d2!  For example
-
-	g :: Ord a => [a] -> [a]
-	{-# SPECIALIZE f :: [Tree Int] -> [Tree Int] #-}
-
-Here, the specialised version of g is an application of g's rhs to the
-Ord dictionary for (Tree Int), which only the type checker can conjure
-up.  There might not even *be* one, if (Tree Int) is not an instance of
-Ord!  (All the other specialision has suitable dictionaries to hand
-from actual calls.)
-
-Problem.  The type checker doesn't have to hand a convenient <f_rhs>, because
-it is buried in a complex (as-yet-un-desugared) binding group.
-Maybe we should say
-
-	f@t1/t2 = f* t1 t2 d1 d2
-
-where f* is the Id f with an IdInfo which says "inline me regardless!".
-Indeed all the specialisation could be done in this way.
-That in turn means that the simplifier has to be prepared to inline absolutely
-any in-scope let-bound thing.
-
-
-Again, the pragma should permit polymorphism in unconstrained variables:
-
-	h :: Ord a => [a] -> b -> b
-	{-# SPECIALIZE h :: [Int] -> b -> b #-}
-
-We *insist* that all overloaded type variables are specialised to ground types,
-(and hence there can be no context inside a SPECIALIZE pragma).
-We *permit* unconstrained type variables to be specialised to
-	- a ground type
-	- or left as a polymorphic type variable
-but nothing in between.  So
-
-	{-# SPECIALIZE h :: [Int] -> [c] -> [c] #-}
-
-is *illegal*.  (It can be handled, but it adds complication, and gains the
-programmer nothing.)
-
-
-SPECIALISING INSTANCE DECLARATIONS
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-
-	instance Foo a => Foo [a] where
-		...
-	{-# SPECIALIZE instance Foo [Int] #-}
-
-The original instance decl creates a dictionary-function
-definition:
-
-	dfun.Foo.List :: forall a. Foo a -> Foo [a]
-
-The SPECIALIZE pragma just makes a specialised copy, just as for
-ordinary function definitions:
-
-	dfun.Foo.List@Int :: Foo [Int]
-	dfun.Foo.List@Int = dfun.Foo.List Int dFooInt
-
-The information about what instance of the dfun exist gets added to
-the dfun's IdInfo in the same way as a user-defined function too.
-
-
-Automatic instance decl specialisation?
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Can instance decls be specialised automatically?  It's tricky.
-We could collect call-instance information for each dfun, but
-then when we specialised their bodies we'd get new call-instances
-for ordinary functions; and when we specialised their bodies, we might get
-new call-instances of the dfuns, and so on.  This all arises because of
-the unrestricted mutual recursion between instance decls and value decls.
-
-Still, there's no actual problem; it just means that we may not do all
-the specialisation we could theoretically do.
-
-Furthermore, instance decls are usually exported and used non-locally,
-so we'll want to compile enough to get those specialisations done.
-
-Lastly, there's no such thing as a local instance decl, so we can
-survive solely by spitting out *usage* information, and then reading that
-back in as a pragma when next compiling the file.  So for now,
-we only specialise instance decls in response to pragmas.
-
-
-SPITTING OUT USAGE INFORMATION
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-To spit out usage information we need to traverse the code collecting
-call-instance information for all imported (non-prelude?) functions
-and data types. Then we equivalence-class it and spit it out.
-
-This is done at the top-level when all the call instances which escape
-must be for imported functions and data types.
-
-*** Not currently done ***
-
-
-Partial specialisation by pragmas
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-What about partial specialisation:
-
-	k :: (Ord a, Eq b) => [a] -> b -> b -> [a]
-	{-# SPECIALIZE k :: Eq b => [Int] -> b -> b -> [a] #-}
-
-or even
-
-	{-# SPECIALIZE k :: Eq b => [Int] -> [b] -> [b] -> [a] #-}
-
-Seems quite reasonable.  Similar things could be done with instance decls:
-
-	instance (Foo a, Foo b) => Foo (a,b) where
-		...
-	{-# SPECIALIZE instance Foo a => Foo (a,Int) #-}
-	{-# SPECIALIZE instance Foo b => Foo (Int,b) #-}
-
-Ho hum.  Things are complex enough without this.  I pass.
-
-
-Requirements for the simplifer
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The simplifier has to be able to take advantage of the specialisation.
-
-* When the simplifier finds an application of a polymorphic f, it looks in
-f's IdInfo in case there is a suitable instance to call instead.  This converts
-
-	f t1 t2 d1 d2 	===>   f_t1_t2
-
-Note that the dictionaries get eaten up too!
-
-* Dictionary selection operations on constant dictionaries must be
-  short-circuited:
-
-	+.sel Int d	===>  +Int
-
-The obvious way to do this is in the same way as other specialised
-calls: +.sel has inside it some IdInfo which tells that if it's applied
-to the type Int then it should eat a dictionary and transform to +Int.
-
-In short, dictionary selectors need IdInfo inside them for constant
-methods.
-
-* Exactly the same applies if a superclass dictionary is being
-  extracted:
-
-	Eq.sel Int d   ===>   dEqInt
-
-* Something similar applies to dictionary construction too.  Suppose
-dfun.Eq.List is the function taking a dictionary for (Eq a) to
-one for (Eq [a]).  Then we want
-
-	dfun.Eq.List Int d	===> dEq.List_Int
-
-Where does the Eq [Int] dictionary come from?  It is built in
-response to a SPECIALIZE pragma on the Eq [a] instance decl.
-
-In short, dfun Ids need IdInfo with a specialisation for each
-constant instance of their instance declaration.
-
-All this uses a single mechanism: the SpecEnv inside an Id
-
-
-What does the specialisation IdInfo look like?
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-The SpecEnv of an Id maps a list of types (the template) to an expression
-
-	[Type]  |->  Expr
-
-For example, if f has this SpecInfo:
-
-	[Int, a]  ->  \d:Ord Int. f' a
-
-it means that we can replace the call
-
-	f Int t  ===>  (\d. f' t)
-
-This chucks one dictionary away and proceeds with the
-specialised version of f, namely f'.
-
-
-What can't be done this way?
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-There is no way, post-typechecker, to get a dictionary for (say)
-Eq a from a dictionary for Eq [a].  So if we find
-
-	==.sel [t] d
-
-we can't transform to
-
-	eqList (==.sel t d')
-
-where
-	eqList :: (a->a->Bool) -> [a] -> [a] -> Bool
-
-Of course, we currently have no way to automatically derive
-eqList, nor to connect it to the Eq [a] instance decl, but you
-can imagine that it might somehow be possible.  Taking advantage
-of this is permanently ruled out.
-
-Still, this is no great hardship, because we intend to eliminate
-overloading altogether anyway!
-
-
-
-A note about non-tyvar dictionaries
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Some Ids have types like
-
-	forall a,b,c. Eq a -> Ord [a] -> tau
-
-This seems curious at first, because we usually only have dictionary
-args whose types are of the form (C a) where a is a type variable.
-But this doesn't hold for the functions arising from instance decls,
-which sometimes get arguements with types of form (C (T a)) for some
-type constructor T.
-
-Should we specialise wrt this compound-type dictionary?  We used to say
-"no", saying:
-	"This is a heuristic judgement, as indeed is the fact that we 
-	specialise wrt only dictionaries.  We choose *not* to specialise
-	wrt compound dictionaries because at the moment the only place
-	they show up is in instance decls, where they are simply plugged
-	into a returned dictionary.  So nothing is gained by specialising
-	wrt them."
-
-But it is simpler and more uniform to specialise wrt these dicts too;
-and in future GHC is likely to support full fledged type signatures 
-like
-	f ;: Eq [(a,b)] => ...
-
-
-%************************************************************************
-%*									*
-\subsubsection{The new specialiser}
-%*									*
-%************************************************************************
-
-Our basic game plan is this.  For let(rec) bound function
-	f :: (C a, D c) => (a,b,c,d) -> Bool
-
-* Find any specialised calls of f, (f ts ds), where 
-  ts are the type arguments t1 .. t4, and
-  ds are the dictionary arguments d1 .. d2.
-
-* Add a new definition for f1 (say):
-
-	f1 = /\ b d -> (..body of f..) t1 b t3 d d1 d2
-
-  Note that we abstract over the unconstrained type arguments.
-
-* Add the mapping
-
-	[t1,b,t3,d]  |->  \d1 d2 -> f1 b d
-
-  to the specialisations of f.  This will be used by the
-  simplifier to replace calls 
-		(f t1 t2 t3 t4) da db
-  by
-		(\d1 d1 -> f1 t2 t4) da db
-
-  All the stuff about how many dictionaries to discard, and what types
-  to apply the specialised function to, are handled by the fact that the
-  SpecEnv contains a template for the result of the specialisation.
-
-We don't build *partial* specialisations for f.  For example:
-
-  f :: Eq a => a -> a -> Bool
-  {-# SPECIALISE f :: (Eq b, Eq c) => (b,c) -> (b,c) -> Bool #-}
-
-Here, little is gained by making a specialised copy of f.
-There's a distinct danger that the specialised version would
-first build a dictionary for (Eq b, Eq c), and then select the (==) 
-method from it!  Even if it didn't, not a great deal is saved.
-
-We do, however, generate polymorphic, but not overloaded, specialisations:
-
-  f :: Eq a => [a] -> b -> b -> b
-  {#- SPECIALISE f :: [Int] -> b -> b -> b #-}
-
-Hence, the invariant is this: 
-
-	*** no specialised version is overloaded ***
-
-
-%************************************************************************
-%*									*
-\subsubsection{The exported function}
-%*									*
-%************************************************************************
-
-\begin{code}
-specProgram :: DynFlags -> UniqSupply -> [CoreBind] -> IO [CoreBind]
-specProgram dflags us binds
-  = do
-	showPass dflags "Specialise"
-
-	let binds' = initSM us (go binds 	`thenSM` \ (binds', uds') ->
-			        returnSM (dumpAllDictBinds uds' binds'))
-
-	endPass dflags "Specialise" Opt_D_dump_spec binds'
-
-	dumpIfSet_dyn dflags Opt_D_dump_rules "Top-level specialisations"
-		  (pprRules (tidyRules emptyTidyEnv (rulesOfBinds binds')))
-
-	return binds'
-  where
-	-- We need to start with a Subst that knows all the things
-	-- that are in scope, so that the substitution engine doesn't
-	-- accidentally re-use a unique that's already in use
-	-- Easiest thing is to do it all at once, as if all the top-level
-	-- decls were mutually recursive
-    top_subst	    = mkEmptySubst (mkInScopeSet (mkVarSet (bindersOfBinds binds)))
-
-    go []	    = returnSM ([], emptyUDs)
-    go (bind:binds) = go binds 				`thenSM` \ (binds', uds) ->
-		      specBind top_subst bind uds	`thenSM` \ (bind', uds') ->
-		      returnSM (bind' ++ binds', uds')
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{@specExpr@: the main function}
-%*									*
-%************************************************************************
-
-\begin{code}
-specVar :: Subst -> Id -> CoreExpr
-specVar subst v = lookupIdSubst subst v
-
-specExpr :: Subst -> CoreExpr -> SpecM (CoreExpr, UsageDetails)
--- We carry a substitution down:
---	a) we must clone any binding that might flaot outwards,
---	   to avoid name clashes
---	b) we carry a type substitution to use when analysing
---	   the RHS of specialised bindings (no type-let!)
-
----------------- First the easy cases --------------------
-specExpr subst (Type ty) = returnSM (Type (substTy subst ty), emptyUDs)
-specExpr subst (Var v)   = returnSM (specVar subst v,         emptyUDs)
-specExpr subst (Lit lit) = returnSM (Lit lit, 		      emptyUDs)
-
-specExpr subst (Note note body)
-  = specExpr subst body 	`thenSM` \ (body', uds) ->
-    returnSM (Note (specNote subst note) body', uds)
-
-
----------------- Applications might generate a call instance --------------------
-specExpr subst expr@(App fun arg)
-  = go expr []
-  where
-    go (App fun arg) args = specExpr subst arg	`thenSM` \ (arg', uds_arg) ->
-			    go fun (arg':args)	`thenSM` \ (fun', uds_app) ->
-			    returnSM (App fun' arg', uds_arg `plusUDs` uds_app)
-
-    go (Var f)       args = case specVar subst f of
-				Var f' -> returnSM (Var f', mkCallUDs subst f' args)
-				e'     -> returnSM (e', emptyUDs)	-- I don't expect this!
-    go other	     args = specExpr subst other
-
----------------- Lambda/case require dumping of usage details --------------------
-specExpr subst e@(Lam _ _)
-  = specExpr subst' body 	`thenSM` \ (body', uds) ->
-    let
-	(filtered_uds, body'') = dumpUDs bndrs' uds body'
-    in
-    returnSM (mkLams bndrs' body'', filtered_uds)
-  where
-    (bndrs, body) = collectBinders e
-    (subst', bndrs') = substBndrs subst bndrs
-	-- More efficient to collect a group of binders together all at once
-	-- and we don't want to split a lambda group with dumped bindings
-
-specExpr subst (Case scrut case_bndr ty alts)
-  = specExpr subst scrut		`thenSM` \ (scrut', uds_scrut) ->
-    mapAndCombineSM spec_alt alts	`thenSM` \ (alts', uds_alts) ->
-    returnSM (Case scrut' case_bndr' (substTy subst ty) alts', uds_scrut `plusUDs` uds_alts)
-  where
-    (subst_alt, case_bndr') = substBndr subst case_bndr
-	-- No need to clone case binder; it can't float like a let(rec)
-
-    spec_alt (con, args, rhs)
-	= specExpr subst_rhs rhs		`thenSM` \ (rhs', uds) ->
-	  let
-	     (uds', rhs'') = dumpUDs args uds rhs'
-	  in
-	  returnSM ((con, args', rhs''), uds')
-	where
-	  (subst_rhs, args') = substBndrs subst_alt args
-
----------------- Finally, let is the interesting case --------------------
-specExpr subst (Let bind body)
-  =	-- Clone binders
-    cloneBindSM subst bind			`thenSM` \ (rhs_subst, body_subst, bind') ->
-	
-	-- Deal with the body
-    specExpr body_subst body			`thenSM` \ (body', body_uds) ->
-
-	-- Deal with the bindings
-    specBind rhs_subst bind' body_uds		`thenSM` \ (binds', uds) ->
-
-	-- All done
-    returnSM (foldr Let body' binds', uds)
-
--- Must apply the type substitution to coerceions
-specNote subst (Coerce t1 t2) = Coerce (substTy subst t1) (substTy subst t2)
-specNote subst note	      = note
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{Dealing with a binding}
-%*									*
-%************************************************************************
-
-\begin{code}
-specBind :: Subst			-- Use this for RHSs
-	 -> CoreBind
-	 -> UsageDetails		-- Info on how the scope of the binding
-	 -> SpecM ([CoreBind],		-- New bindings
-		   UsageDetails)	-- And info to pass upstream
-
-specBind rhs_subst bind body_uds
-  = specBindItself rhs_subst bind (calls body_uds)	`thenSM` \ (bind', bind_uds) ->
-    let
-	bndrs   = bindersOf bind
-	all_uds = zapCalls bndrs (body_uds `plusUDs` bind_uds)
-			-- It's important that the `plusUDs` is this way round,
-			-- because body_uds may bind dictionaries that are
-			-- used in the calls passed to specDefn.  So the
-			-- dictionary bindings in bind_uds may mention 
-			-- dictionaries bound in body_uds.
-    in
-    case splitUDs bndrs all_uds of
-
-	(_, ([],[]))  	-- This binding doesn't bind anything needed
-			-- in the UDs, so put the binding here
-			-- This is the case for most non-dict bindings, except
-			-- for the few that are mentioned in a dict binding
-			-- that is floating upwards in body_uds
-		-> returnSM ([bind'], all_uds)
-
-	(float_uds, (dict_binds, calls)) 	-- This binding is needed in the UDs, so float it out
-		-> returnSM ([], float_uds `plusUDs` mkBigUD bind' dict_binds calls)
-   
-
--- A truly gruesome function
-mkBigUD bind@(NonRec _ _) dbs calls
-  = 	-- Common case: non-recursive and no specialisations
-	-- (if there were any specialistions it would have been made recursive)
-    MkUD { dict_binds = listToBag (mkDB bind : dbs),
-	   calls = listToCallDetails calls }
-
-mkBigUD bind dbs calls
-  = 	-- General case
-    MkUD { dict_binds = unitBag (mkDB (Rec (bind_prs bind ++ dbsToPairs dbs))),
-			-- Make a huge Rec
-	   calls = listToCallDetails calls }
-  where
-    bind_prs (NonRec b r) = [(b,r)]
-    bind_prs (Rec prs)    = prs
-
-    dbsToPairs []             = []
-    dbsToPairs ((bind,_):dbs) = bind_prs bind ++ dbsToPairs dbs
-
--- specBindItself deals with the RHS, specialising it according
--- to the calls found in the body (if any)
-specBindItself rhs_subst (NonRec bndr rhs) call_info
-  = specDefn rhs_subst call_info (bndr,rhs)	`thenSM` \ ((bndr',rhs'), spec_defns, spec_uds) ->
-    let
-        new_bind | null spec_defns = NonRec bndr' rhs'
-                 | otherwise       = Rec ((bndr',rhs'):spec_defns)
-		-- bndr' mentions the spec_defns in its SpecEnv
-		-- Not sure why we couln't just put the spec_defns first
-    in
-    returnSM (new_bind, spec_uds)
-
-specBindItself rhs_subst (Rec pairs) call_info
-  = mapSM (specDefn rhs_subst call_info) pairs	`thenSM` \ stuff ->
-    let
-	(pairs', spec_defns_s, spec_uds_s) = unzip3 stuff
-	spec_defns = concat spec_defns_s
-	spec_uds   = plusUDList spec_uds_s
-        new_bind   = Rec (spec_defns ++ pairs')
-    in
-    returnSM (new_bind, spec_uds)
-    
-
-specDefn :: Subst			-- Subst to use for RHS
-	 -> CallDetails			-- Info on how it is used in its scope
-	 -> (Id, CoreExpr)		-- The thing being bound and its un-processed RHS
-	 -> SpecM ((Id, CoreExpr),	-- The thing and its processed RHS
-					-- 	the Id may now have specialisations attached
-		   [(Id,CoreExpr)],	-- Extra, specialised bindings
-		   UsageDetails		-- Stuff to fling upwards from the RHS and its
-	    )				-- 	specialised versions
-
-specDefn subst calls (fn, rhs)
-	-- The first case is the interesting one
-  |  rhs_tyvars `lengthIs` n_tyvars 	-- Rhs of fn's defn has right number of big lambdas
-  && rhs_bndrs  `lengthAtLeast` n_dicts	-- and enough dict args
-  && notNull calls_for_me		-- And there are some calls to specialise
-
--- At one time I tried not specialising small functions
--- but sometimes there are big functions marked INLINE
--- that we'd like to specialise.  In particular, dictionary
--- functions, which Marcin is keen to inline
---  && not (certainlyWillInline fn)	-- And it's not small
-					-- If it's small, it's better just to inline
-					-- it than to construct lots of specialisations
-  =   -- Specialise the body of the function
-    specExpr subst rhs					`thenSM` \ (rhs', rhs_uds) ->
-
-      -- Make a specialised version for each call in calls_for_me
-    mapSM spec_call calls_for_me		`thenSM` \ stuff ->
-    let
-	(spec_defns, spec_uds, spec_rules) = unzip3 stuff
-
-	fn' = addIdSpecialisations fn spec_rules
-    in
-    returnSM ((fn',rhs'), 
-	      spec_defns, 
-	      rhs_uds `plusUDs` plusUDList spec_uds)
-
-  | otherwise	-- No calls or RHS doesn't fit our preconceptions
-  = specExpr subst rhs			`thenSM` \ (rhs', rhs_uds) ->
-    returnSM ((fn, rhs'), [], rhs_uds)
-  
-  where
-    fn_type	       = idType fn
-    (tyvars, theta, _) = tcSplitSigmaTy fn_type
-    n_tyvars	       = length tyvars
-    n_dicts	       = length theta
-
-    (rhs_tyvars, rhs_ids, rhs_body) 
-	= collectTyAndValBinders (dropInline rhs)
-	-- It's important that we "see past" any INLINE pragma
-	-- else we'll fail to specialise an INLINE thing
-
-    rhs_dicts = take n_dicts rhs_ids
-    rhs_bndrs = rhs_tyvars ++ rhs_dicts
-    body      = mkLams (drop n_dicts rhs_ids) rhs_body
-		-- Glue back on the non-dict lambdas
-
-    calls_for_me = case lookupFM calls fn of
-			Nothing -> []
-			Just cs -> fmToList cs
-
-    ----------------------------------------------------------
-	-- Specialise to one particular call pattern
-    spec_call :: (CallKey, ([DictExpr], VarSet))	-- Call instance
-              -> SpecM ((Id,CoreExpr),			-- Specialised definition
-	                UsageDetails, 			-- Usage details from specialised body
-                	CoreRule)			-- Info for the Id's SpecEnv
-    spec_call (CallKey call_ts, (call_ds, call_fvs))
-      = ASSERT( call_ts `lengthIs` n_tyvars  && call_ds `lengthIs` n_dicts )
-		-- Calls are only recorded for properly-saturated applications
-	
-	-- Suppose f's defn is 	f = /\ a b c d -> \ d1 d2 -> rhs	
-        -- Supppose the call is for f [Just t1, Nothing, Just t3, Nothing] [dx1, dx2]
-
-	-- Construct the new binding
-	-- 	f1 = SUBST[a->t1,c->t3, d1->d1', d2->d2'] (/\ b d -> rhs)
-	-- PLUS the usage-details
-	--	{ d1' = dx1; d2' = dx2 }
-	-- where d1', d2' are cloned versions of d1,d2, with the type substitution applied.
-	--
-	-- Note that the substitution is applied to the whole thing.
-	-- This is convenient, but just slightly fragile.  Notably:
-	--	* There had better be no name clashes in a/b/c/d
-	--
-        let
-		-- poly_tyvars = [b,d] in the example above
-		-- spec_tyvars = [a,c] 
-		-- ty_args     = [t1,b,t3,d]
-	   poly_tyvars = [tv | (tv, Nothing) <- rhs_tyvars `zip` call_ts]
-           spec_tyvars = [tv | (tv, Just _)  <- rhs_tyvars `zip` call_ts]
-	   ty_args     = zipWithEqual "spec_call" mk_ty_arg rhs_tyvars call_ts
-		       where
-		 	 mk_ty_arg rhs_tyvar Nothing   = Type (mkTyVarTy rhs_tyvar)
-			 mk_ty_arg rhs_tyvar (Just ty) = Type ty
-	   rhs_subst  = extendTvSubstList subst (spec_tyvars `zip` [ty | Just ty <- call_ts])
-	in
-	cloneBinders rhs_subst rhs_dicts 		`thenSM` \ (rhs_subst', rhs_dicts') ->
-	let
-	   inst_args = ty_args ++ map Var rhs_dicts'
-
-		-- Figure out the type of the specialised function
-	   body_ty = applyTypeToArgs rhs fn_type inst_args
-	   (lam_args, app_args) 		-- Add a dummy argument if body_ty is unlifted
-		| isUnLiftedType body_ty	-- C.f. WwLib.mkWorkerArgs
-		= (poly_tyvars ++ [voidArgId], poly_tyvars ++ [realWorldPrimId])
-		| otherwise = (poly_tyvars, poly_tyvars)
-	   spec_id_ty = mkPiTypes lam_args body_ty
-	in
-	newIdSM fn spec_id_ty				`thenSM` \ spec_f ->
-	specExpr rhs_subst' (mkLams lam_args body)	`thenSM` \ (spec_rhs, rhs_uds) ->	
-	let
-		-- The rule to put in the function's specialisation is:
-		--	forall b,d, d1',d2'.  f t1 b t3 d d1' d2' = f1 b d  
-           spec_env_rule = mkLocalRule (mkFastString ("SPEC " ++ showSDoc (ppr fn)))
-				AlwaysActive (idName fn)
-			        (poly_tyvars ++ rhs_dicts')
-				inst_args 
-				(mkVarApps (Var spec_f) app_args)
-
-		-- Add the { d1' = dx1; d2' = dx2 } usage stuff
-	   final_uds = foldr addDictBind rhs_uds (my_zipEqual "spec_call" rhs_dicts' call_ds)
-
-	-- NOTE: we don't add back in any INLINE pragma on the RHS, so even if
-	-- the original function said INLINE, the specialised copies won't.
-	-- The idea is that the point of inlining was precisely to specialise
-	-- the function at its call site, and that's not so important for the
-	-- specialised copies.   But it still smells like an ad hoc decision.
-
-	in
-        returnSM ((spec_f, spec_rhs),	
-	          final_uds,
-		  spec_env_rule)
-
-      where
-	my_zipEqual doc xs ys 
-	 | not (equalLength xs ys) = pprPanic "my_zipEqual" (ppr xs $$ ppr ys $$ (ppr fn <+> ppr call_ts) $$ ppr rhs)
-	 | otherwise		   = zipEqual doc xs ys
-
-dropInline :: CoreExpr -> CoreExpr
-dropInline (Note InlineMe rhs) = rhs
-dropInline rhs		       = rhs
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{UsageDetails and suchlike}
-%*									*
-%************************************************************************
-
-\begin{code}
-data UsageDetails 
-  = MkUD {
-	dict_binds :: !(Bag DictBind),
-			-- Floated dictionary bindings
-			-- The order is important; 
-			-- in ds1 `union` ds2, bindings in ds2 can depend on those in ds1
-			-- (Remember, Bags preserve order in GHC.)
-
-	calls     :: !CallDetails
-    }
-
-type DictBind = (CoreBind, VarSet)
-	-- The set is the free vars of the binding
-	-- both tyvars and dicts
-
-type DictExpr = CoreExpr
-
-emptyUDs = MkUD { dict_binds = emptyBag, calls = emptyFM }
-
-type ProtoUsageDetails = ([DictBind],
-			  [(Id, CallKey, ([DictExpr], VarSet))]
-			 )
-
-------------------------------------------------------------			
-type CallDetails  = FiniteMap Id CallInfo
-newtype CallKey   = CallKey [Maybe Type]			-- Nothing => unconstrained type argument
-type CallInfo     = FiniteMap CallKey
-		              ([DictExpr], VarSet)		-- Dict args and the vars of the whole
-								-- call (including tyvars)
-								-- [*not* include the main id itself, of course]
-	-- The finite maps eliminate duplicates
-	-- The list of types and dictionaries is guaranteed to
-	-- match the type of f
-
--- Type isn't an instance of Ord, so that we can control which
--- instance we use.  That's tiresome here.  Oh well
-instance Eq CallKey where
-  k1 == k2 = case k1 `compare` k2 of { EQ -> True; other -> False }
-
-instance Ord CallKey where
-  compare (CallKey k1) (CallKey k2) = cmpList cmp k1 k2
-		where
-		  cmp Nothing Nothing     = EQ
-		  cmp Nothing (Just t2)   = LT
-		  cmp (Just t1) Nothing   = GT
-		  cmp (Just t1) (Just t2) = tcCmpType t1 t2
-
-unionCalls :: CallDetails -> CallDetails -> CallDetails
-unionCalls c1 c2 = plusFM_C plusFM c1 c2
-
-singleCall :: Id -> [Maybe Type] -> [DictExpr] -> CallDetails
-singleCall id tys dicts 
-  = unitFM id (unitFM (CallKey tys) (dicts, call_fvs))
-  where
-    call_fvs = exprsFreeVars dicts `unionVarSet` tys_fvs
-    tys_fvs  = tyVarsOfTypes (catMaybes tys)
-	-- The type args (tys) are guaranteed to be part of the dictionary
-	-- types, because they are just the constrained types,
-	-- and the dictionary is therefore sure to be bound
-	-- inside the binding for any type variables free in the type;
-	-- hence it's safe to neglect tyvars free in tys when making
-	-- the free-var set for this call
-	-- BUT I don't trust this reasoning; play safe and include tys_fvs
-	--
-	-- We don't include the 'id' itself.
-
-listToCallDetails calls
-  = foldr (unionCalls . mk_call) emptyFM calls
-  where
-    mk_call (id, tys, dicts_w_fvs) = unitFM id (unitFM tys dicts_w_fvs)
-	-- NB: the free vars of the call are provided
-
-callDetailsToList calls = [ (id,tys,dicts)
-			  | (id,fm) <- fmToList calls,
-		            (tys, dicts) <- fmToList fm
-			  ]
-
-mkCallUDs subst f args 
-  | null theta
-  || not (all isClassPred theta)	
-	-- Only specialise if all overloading is on class params. 
-	-- In ptic, with implicit params, the type args
-	--  *don't* say what the value of the implicit param is!
-  || not (spec_tys `lengthIs` n_tyvars)
-  || not ( dicts   `lengthIs` n_dicts)
-  || maybeToBool (lookupRule (\act -> True) (substInScope subst) emptyRuleBase f args)
-	-- There's already a rule covering this call.  A typical case
-	-- is where there's an explicit user-provided rule.  Then
-	-- we don't want to create a specialised version 
-	-- of the function that overlaps.
-  = emptyUDs	-- Not overloaded, or no specialisation wanted
-
-  | otherwise
-  = MkUD {dict_binds = emptyBag, 
-	  calls      = singleCall f spec_tys dicts
-    }
-  where
-    (tyvars, theta, _) = tcSplitSigmaTy (idType f)
-    constrained_tyvars = tyVarsOfTheta theta 
-    n_tyvars	       = length tyvars
-    n_dicts	       = length theta
-
-    spec_tys = [mk_spec_ty tv ty | (tv, Type ty) <- tyvars `zip` args]
-    dicts    = [dict_expr | (_, dict_expr) <- theta `zip` (drop n_tyvars args)]
-    
-    mk_spec_ty tyvar ty 
-	| tyvar `elemVarSet` constrained_tyvars = Just ty
-	| otherwise				= Nothing
-
-------------------------------------------------------------			
-plusUDs :: UsageDetails -> UsageDetails -> UsageDetails
-plusUDs (MkUD {dict_binds = db1, calls = calls1})
-	(MkUD {dict_binds = db2, calls = calls2})
-  = MkUD {dict_binds = d, calls = c}
-  where
-    d = db1    `unionBags`   db2 
-    c = calls1 `unionCalls`  calls2
-
-plusUDList = foldr plusUDs emptyUDs
-
--- zapCalls deletes calls to ids from uds
-zapCalls ids uds = uds {calls = delListFromFM (calls uds) ids}
-
-mkDB bind = (bind, bind_fvs bind)
-
-bind_fvs (NonRec bndr rhs) = pair_fvs (bndr,rhs)
-bind_fvs (Rec prs)	   = foldl delVarSet rhs_fvs bndrs
-			   where
-			     bndrs = map fst prs
-			     rhs_fvs = unionVarSets (map pair_fvs prs)
-
-pair_fvs (bndr, rhs) = exprFreeVars rhs `unionVarSet` idRuleVars bndr
-	-- Don't forget variables mentioned in the
-	-- rules of the bndr.  C.f. OccAnal.addRuleUsage
-
-
-addDictBind (dict,rhs) uds = uds { dict_binds = mkDB (NonRec dict rhs) `consBag` dict_binds uds }
-
-dumpAllDictBinds (MkUD {dict_binds = dbs}) binds
-  = foldrBag add binds dbs
-  where
-    add (bind,_) binds = bind : binds
-
-dumpUDs :: [CoreBndr]
-	-> UsageDetails -> CoreExpr
-	-> (UsageDetails, CoreExpr)
-dumpUDs bndrs uds body
-  = (free_uds, foldr add_let body dict_binds)
-  where
-    (free_uds, (dict_binds, _)) = splitUDs bndrs uds
-    add_let (bind,_) body 	= Let bind body
-
-splitUDs :: [CoreBndr]
-	 -> UsageDetails
-	 -> (UsageDetails,		-- These don't mention the binders
-	     ProtoUsageDetails)		-- These do
-	     
-splitUDs bndrs uds@(MkUD {dict_binds = orig_dbs, 
-			  calls      = orig_calls})
-
-  = if isEmptyBag dump_dbs && null dump_calls then
-   	-- Common case: binder doesn't affect floats
-	(uds, ([],[]))	
-
-    else
-  	-- Binders bind some of the fvs of the floats
-  	(MkUD {dict_binds = free_dbs, 
-	       calls      = listToCallDetails free_calls},
-	 (bagToList dump_dbs, dump_calls)
-	)
-
-  where
-    bndr_set = mkVarSet bndrs
-
-    (free_dbs, dump_dbs, dump_idset) 
-	  = foldlBag dump_db (emptyBag, emptyBag, bndr_set) orig_dbs
-		-- Important that it's foldl not foldr;
-		-- we're accumulating the set of dumped ids in dump_set
-
-	-- Filter out any calls that mention things that are being dumped
-    orig_call_list	     	   = callDetailsToList orig_calls
-    (dump_calls, free_calls) 	   = partition captured orig_call_list
-    captured (id,tys,(dicts, fvs)) =  fvs `intersectsVarSet` dump_idset
-				   || id `elemVarSet` dump_idset
-
-    dump_db (free_dbs, dump_dbs, dump_idset) db@(bind, fvs)
-	| dump_idset `intersectsVarSet` fvs	-- Dump it
-	= (free_dbs, dump_dbs `snocBag` db,
-	   extendVarSetList dump_idset (bindersOf bind))
-
-	| otherwise	-- Don't dump it
-	= (free_dbs `snocBag` db, dump_dbs, dump_idset)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{Boring helper functions}
-%*									*
-%************************************************************************
-
-\begin{code}
-type SpecM a = UniqSM a
-
-thenSM    = thenUs
-returnSM  = returnUs
-getUniqSM = getUniqueUs
-mapSM     = mapUs
-initSM	  = initUs_
-
-mapAndCombineSM f []     = returnSM ([], emptyUDs)
-mapAndCombineSM f (x:xs) = f x	`thenSM` \ (y, uds1) ->
-			   mapAndCombineSM f xs	`thenSM` \ (ys, uds2) ->
-			   returnSM (y:ys, uds1 `plusUDs` uds2)
-
-cloneBindSM :: Subst -> CoreBind -> SpecM (Subst, Subst, CoreBind)
--- Clone the binders of the bind; return new bind with the cloned binders
--- Return the substitution to use for RHSs, and the one to use for the body
-cloneBindSM subst (NonRec bndr rhs)
-  = getUs 	`thenUs` \ us ->
-    let
-	(subst', bndr') = cloneIdBndr subst us bndr
-    in
-    returnUs (subst, subst', NonRec bndr' rhs)
-
-cloneBindSM subst (Rec pairs)
-  = getUs 	`thenUs` \ us ->
-    let
-	(subst', bndrs') = cloneRecIdBndrs subst us (map fst pairs)
-    in
-    returnUs (subst', subst', Rec (bndrs' `zip` map snd pairs))
-
-cloneBinders subst bndrs
-  = getUs 	`thenUs` \ us ->
-    returnUs (cloneIdBndrs subst us bndrs)
-
-newIdSM old_id new_ty
-  = getUniqSM		`thenSM` \ uniq ->
-    let 
-	-- Give the new Id a similar occurrence name to the old one
-	name   = idName old_id
-	new_id = mkUserLocal (mkSpecOcc (nameOccName name)) uniq new_ty (getSrcLoc name)
-    in
-    returnSM new_id
-\end{code}
-
-
-		Old (but interesting) stuff about unboxed bindings
-		~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-What should we do when a value is specialised to a *strict* unboxed value?
-
-	map_*_* f (x:xs) = let h = f x
-			       t = map f xs
-			   in h:t
-
-Could convert let to case:
-
-	map_*_Int# f (x:xs) = case f x of h# ->
-			      let t = map f xs
-			      in h#:t
-
-This may be undesirable since it forces evaluation here, but the value
-may not be used in all branches of the body. In the general case this
-transformation is impossible since the mutual recursion in a letrec
-cannot be expressed as a case.
-
-There is also a problem with top-level unboxed values, since our
-implementation cannot handle unboxed values at the top level.
-
-Solution: Lift the binding of the unboxed value and extract it when it
-is used:
-
-	map_*_Int# f (x:xs) = let h = case (f x) of h# -> _Lift h#
-				  t = map f xs
-			      in case h of
-				 _Lift h# -> h#:t
-
-Now give it to the simplifier and the _Lifting will be optimised away.
-
-The benfit is that we have given the specialised "unboxed" values a
-very simplep lifted semantics and then leave it up to the simplifier to
-optimise it --- knowing that the overheads will be removed in nearly
-all cases.
-
-In particular, the value will only be evaluted in the branches of the
-program which use it, rather than being forced at the point where the
-value is bound. For example:
-
-	filtermap_*_* p f (x:xs)
-	  = let h = f x
-		t = ...
-	    in case p x of
-		True  -> h:t
-		False -> t
-   ==>
-	filtermap_*_Int# p f (x:xs)
-	  = let h = case (f x) of h# -> _Lift h#
-		t = ...
-	    in case p x of
-		True  -> case h of _Lift h#
-			   -> h#:t
-		False -> t
-
-The binding for h can still be inlined in the one branch and the
-_Lifting eliminated.
-
-
-Question: When won't the _Lifting be eliminated?
-
-Answer: When they at the top-level (where it is necessary) or when
-inlining would duplicate work (or possibly code depending on
-options). However, the _Lifting will still be eliminated if the
-strictness analyser deems the lifted binding strict.
-
diff --git a/ghc/compiler/stgSyn/CoreToStg.lhs b/ghc/compiler/stgSyn/CoreToStg.lhs
deleted file mode 100644
index 824cabaacb..0000000000
--- a/ghc/compiler/stgSyn/CoreToStg.lhs
+++ /dev/null
@@ -1,1107 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[CoreToStg]{Converts Core to STG Syntax}
-
-And, as we have the info in hand, we may convert some lets to
-let-no-escapes.
-
-\begin{code}
-module CoreToStg ( coreToStg, coreExprToStg ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-import CoreUtils	( rhsIsStatic, manifestArity, exprType, findDefault )
-import StgSyn
-
-import Type
-import TyCon		( isAlgTyCon )
-import Id
-import Var		( Var, globalIdDetails, idType )
-import TyCon		( isUnboxedTupleTyCon, isPrimTyCon, isFunTyCon, isHiBootTyCon )
-#ifdef ILX
-import MkId		( unsafeCoerceId )
-#endif
-import IdInfo
-import DataCon
-import CostCentre	( noCCS )
-import VarSet
-import VarEnv
-import Maybes		( maybeToBool )
-import Name		( getOccName, isExternalName, nameOccName )
-import OccName		( occNameString, occNameFS )
-import BasicTypes       ( Arity )
-import Packages		( HomeModules )
-import StaticFlags	( opt_RuntimeTypes )
-import Outputable
-
-infixr 9 `thenLne`
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[live-vs-free-doc]{Documentation}
-%*									*
-%************************************************************************
-
-(There is other relevant documentation in codeGen/CgLetNoEscape.)
-
-The actual Stg datatype is decorated with {\em live variable}
-information, as well as {\em free variable} information.  The two are
-{\em not} the same.  Liveness is an operational property rather than a
-semantic one.  A variable is live at a particular execution point if
-it can be referred to {\em directly} again.  In particular, a dead
-variable's stack slot (if it has one):
-\begin{enumerate}
-\item
-should be stubbed to avoid space leaks, and
-\item
-may be reused for something else.
-\end{enumerate}
-
-There ought to be a better way to say this.  Here are some examples:
-\begin{verbatim}
-	let v = [q] \[x] -> e
-	in
-	...v...	 (but no q's)
-\end{verbatim}
-
-Just after the `in', v is live, but q is dead.	If the whole of that
-let expression was enclosed in a case expression, thus:
-\begin{verbatim}
-	case (let v = [q] \[x] -> e in ...v...) of
-		alts[...q...]
-\end{verbatim}
-(ie @alts@ mention @q@), then @q@ is live even after the `in'; because
-we'll return later to the @alts@ and need it.
-
-Let-no-escapes make this a bit more interesting:
-\begin{verbatim}
-	let-no-escape v = [q] \ [x] -> e
-	in
-	...v...
-\end{verbatim}
-Here, @q@ is still live at the `in', because @v@ is represented not by
-a closure but by the current stack state.  In other words, if @v@ is
-live then so is @q@.  Furthermore, if @e@ mentions an enclosing
-let-no-escaped variable, then {\em its} free variables are also live
-if @v@ is.
-
-%************************************************************************
-%*									*
-\subsection[caf-info]{Collecting live CAF info}
-%*									*
-%************************************************************************
-
-In this pass we also collect information on which CAFs are live for 
-constructing SRTs (see SRT.lhs).  
-
-A top-level Id has CafInfo, which is
-
-	- MayHaveCafRefs, if it may refer indirectly to
-	  one or more CAFs, or
-	- NoCafRefs if it definitely doesn't
-
-The CafInfo has already been calculated during the CoreTidy pass.
-
-During CoreToStg, we then pin onto each binding and case expression, a
-list of Ids which represents the "live" CAFs at that point.  The meaning
-of "live" here is the same as for live variables, see above (which is
-why it's convenient to collect CAF information here rather than elsewhere).
-
-The later SRT pass takes these lists of Ids and uses them to construct
-the actual nested SRTs, and replaces the lists of Ids with (offset,length)
-pairs.
-
-
-Interaction of let-no-escape with SRTs   [Sept 01]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-
-	let-no-escape x = ...caf1...caf2...
-	in
-	...x...x...x...
-
-where caf1,caf2 are CAFs.  Since x doesn't have a closure, we 
-build SRTs just as if x's defn was inlined at each call site, and
-that means that x's CAF refs get duplicated in the overall SRT.
-
-This is unlike ordinary lets, in which the CAF refs are not duplicated.
-
-We could fix this loss of (static) sharing by making a sort of pseudo-closure
-for x, solely to put in the SRTs lower down.
-
-
-%************************************************************************
-%*									*
-\subsection[binds-StgVarInfo]{Setting variable info: top-level, binds, RHSs}
-%*									*
-%************************************************************************
-
-\begin{code}
-coreToStg :: HomeModules -> [CoreBind] -> IO [StgBinding]
-coreToStg hmods pgm
-  = return pgm'
-  where (_, _, pgm') = coreTopBindsToStg hmods emptyVarEnv pgm
-
-coreExprToStg :: CoreExpr -> StgExpr
-coreExprToStg expr 
-  = new_expr where (new_expr,_,_) = initLne emptyVarEnv (coreToStgExpr expr)
-
-
-coreTopBindsToStg
-    :: HomeModules
-    -> IdEnv HowBound		-- environment for the bindings
-    -> [CoreBind]
-    -> (IdEnv HowBound, FreeVarsInfo, [StgBinding])
-
-coreTopBindsToStg hmods env [] = (env, emptyFVInfo, [])
-coreTopBindsToStg hmods env (b:bs)
-  = (env2, fvs2, b':bs')
-  where
-	-- env accumulates down the list of binds, fvs accumulates upwards
-	(env1, fvs2, b' ) = coreTopBindToStg hmods env fvs1 b
-  	(env2, fvs1, bs') = coreTopBindsToStg hmods env1 bs
-
-
-coreTopBindToStg
-	:: HomeModules
-	-> IdEnv HowBound
-	-> FreeVarsInfo		-- Info about the body
-	-> CoreBind
-	-> (IdEnv HowBound, FreeVarsInfo, StgBinding)
-
-coreTopBindToStg hmods env body_fvs (NonRec id rhs)
-  = let 
-	env' 	  = extendVarEnv env id how_bound
-	how_bound = LetBound TopLet $! manifestArity rhs
-
-        (stg_rhs, fvs') = 
-	    initLne env (
-              coreToTopStgRhs hmods body_fvs (id,rhs)	`thenLne` \ (stg_rhs, fvs') ->
-	      returnLne (stg_rhs, fvs')
-           )
-	
-	bind = StgNonRec id stg_rhs
-    in
-    ASSERT2(manifestArity rhs == stgRhsArity stg_rhs, ppr id)
-    ASSERT2(consistentCafInfo id bind, ppr id)
---    WARN(not (consistent caf_info bind), ppr id <+> ppr cafs <+> ppCafInfo caf_info)
-    (env', fvs' `unionFVInfo` body_fvs, bind)
-
-coreTopBindToStg hmods env body_fvs (Rec pairs)
-  = let 
-	(binders, rhss) = unzip pairs
-
-	extra_env' = [ (b, LetBound TopLet $! manifestArity rhs)
-		     | (b, rhs) <- pairs ]
-	env' = extendVarEnvList env extra_env'
-
-        (stg_rhss, fvs')
-	  = initLne env' (
-	       mapAndUnzipLne (coreToTopStgRhs hmods body_fvs) pairs
-						`thenLne` \ (stg_rhss, fvss') ->
-	       let fvs' = unionFVInfos fvss' in
-	       returnLne (stg_rhss, fvs')
-           )
-
-	bind = StgRec (zip binders stg_rhss)
-    in
-    ASSERT2(and [manifestArity rhs == stgRhsArity stg_rhs | (rhs,stg_rhs) <- rhss `zip` stg_rhss], ppr binders)
-    ASSERT2(consistentCafInfo (head binders) bind, ppr binders)
-    (env', fvs' `unionFVInfo` body_fvs, bind)
-
-#ifdef DEBUG
--- Assertion helper: this checks that the CafInfo on the Id matches
--- what CoreToStg has figured out about the binding's SRT.  The
--- CafInfo will be exact in all cases except when CorePrep has
--- floated out a binding, in which case it will be approximate.
-consistentCafInfo id bind
-  | occNameFS (nameOccName (idName id)) == FSLIT("sat")
-  = safe
-  | otherwise
-  = WARN (not exact, ppr id) safe
-  where
-	safe  = id_marked_caffy || not binding_is_caffy
-	exact = id_marked_caffy == binding_is_caffy
-	id_marked_caffy  = mayHaveCafRefs (idCafInfo id)
-	binding_is_caffy = stgBindHasCafRefs bind
-#endif
-\end{code}
-
-\begin{code}
-coreToTopStgRhs
-	:: HomeModules
-	-> FreeVarsInfo		-- Free var info for the scope of the binding
-	-> (Id,CoreExpr)
-	-> LneM (StgRhs, FreeVarsInfo)
-
-coreToTopStgRhs hmods scope_fv_info (bndr, rhs)
-  = coreToStgExpr rhs 		`thenLne` \ (new_rhs, rhs_fvs, _) ->
-    freeVarsToLiveVars rhs_fvs	`thenLne` \ lv_info ->
-    returnLne (mkTopStgRhs is_static rhs_fvs (mkSRT lv_info) bndr_info new_rhs, rhs_fvs)
-  where
-    bndr_info = lookupFVInfo scope_fv_info bndr
-    is_static = rhsIsStatic hmods rhs
-
-mkTopStgRhs :: Bool -> FreeVarsInfo -> SRT -> StgBinderInfo -> StgExpr
-	-> StgRhs
-
-mkTopStgRhs is_static rhs_fvs srt binder_info (StgLam _ bndrs body)
-  = ASSERT( is_static )
-    StgRhsClosure noCCS binder_info
-		  (getFVs rhs_fvs)		 
-		  ReEntrant
-		  srt
-		  bndrs body
-	
-mkTopStgRhs is_static rhs_fvs srt binder_info (StgConApp con args)
-  | is_static	 -- StgConApps can be updatable (see isCrossDllConApp)
-  = StgRhsCon noCCS con args
-
-mkTopStgRhs is_static rhs_fvs srt binder_info rhs
-  = ASSERT2( not is_static, ppr rhs )
-    StgRhsClosure noCCS binder_info
-		  (getFVs rhs_fvs)		 
-	          Updatable
-		  srt
-	          [] rhs
-\end{code}
-
-
--- ---------------------------------------------------------------------------
--- Expressions
--- ---------------------------------------------------------------------------
-
-\begin{code}
-coreToStgExpr
-  	:: CoreExpr
-	-> LneM (StgExpr,	-- Decorated STG expr
-		 FreeVarsInfo,	-- Its free vars (NB free, not live)
-		 EscVarsSet)	-- Its escapees, a subset of its free vars;
-				-- also a subset of the domain of the envt
-				-- because we are only interested in the escapees
-				-- for vars which might be turned into
-				-- let-no-escaped ones.
-\end{code}
-
-The second and third components can be derived in a simple bottom up pass, not
-dependent on any decisions about which variables will be let-no-escaped or
-not.  The first component, that is, the decorated expression, may then depend
-on these components, but it in turn is not scrutinised as the basis for any
-decisions.  Hence no black holes.
-
-\begin{code}
-coreToStgExpr (Lit l) = returnLne (StgLit l, emptyFVInfo, emptyVarSet)
-coreToStgExpr (Var v) = coreToStgApp Nothing v []
-
-coreToStgExpr expr@(App _ _)
-  = coreToStgApp Nothing f args
-  where
-    (f, args) = myCollectArgs expr
-
-coreToStgExpr expr@(Lam _ _)
-  = let
-	(args, body) = myCollectBinders expr 
-	args'	     = filterStgBinders args
-    in
-    extendVarEnvLne [ (a, LambdaBound) | a <- args' ] $
-    coreToStgExpr body  `thenLne` \ (body, body_fvs, body_escs) ->
-    let
-	fvs		= args' `minusFVBinders` body_fvs
-	escs		= body_escs `delVarSetList` args'
-	result_expr | null args' = body
-		    | otherwise  = StgLam (exprType expr) args' body
-    in
-    returnLne (result_expr, fvs, escs)
-
-coreToStgExpr (Note (SCC cc) expr)
-  = coreToStgExpr expr		`thenLne` ( \ (expr2, fvs, escs) ->
-    returnLne (StgSCC cc expr2, fvs, escs) )
-
-#ifdef ILX
--- For ILX, convert (__coerce__ to_ty from_ty e) 
---	    into    (coerce to_ty from_ty e)
--- where coerce is real function
-coreToStgExpr (Note (Coerce to_ty from_ty) expr)
-  = coreToStgExpr (mkApps (Var unsafeCoerceId) 
-			  [Type from_ty, Type to_ty, expr])
-#endif
-
-coreToStgExpr (Note other_note expr)
-  = coreToStgExpr expr
-
--- Cases require a little more real work.
-
-coreToStgExpr (Case scrut bndr _ alts)
-  = extendVarEnvLne [(bndr, LambdaBound)]	(
-	 mapAndUnzip3Lne vars_alt alts	`thenLne` \ (alts2, fvs_s, escs_s) ->
-	 returnLne ( alts2,
-		     unionFVInfos fvs_s,
-		     unionVarSets escs_s )
-    )			   		`thenLne` \ (alts2, alts_fvs, alts_escs) ->
-    let
-	-- Determine whether the default binder is dead or not
-	-- This helps the code generator to avoid generating an assignment
-	-- for the case binder (is extremely rare cases) ToDo: remove.
-	bndr' | bndr `elementOfFVInfo` alts_fvs = bndr
-	      | otherwise			= bndr `setIdOccInfo` IAmDead
-
-	-- Don't consider the default binder as being 'live in alts',
-	-- since this is from the point of view of the case expr, where
-	-- the default binder is not free.
-	alts_fvs_wo_bndr  = bndr `minusFVBinder` alts_fvs
-	alts_escs_wo_bndr = alts_escs `delVarSet` bndr
-    in
-
-    freeVarsToLiveVars alts_fvs_wo_bndr		`thenLne` \ alts_lv_info ->
-
-	-- We tell the scrutinee that everything 
-	-- live in the alts is live in it, too.
-    setVarsLiveInCont alts_lv_info (
-	coreToStgExpr scrut	  `thenLne` \ (scrut2, scrut_fvs, scrut_escs) ->
-        freeVarsToLiveVars scrut_fvs `thenLne` \ scrut_lv_info ->
-	returnLne (scrut2, scrut_fvs, scrut_escs, scrut_lv_info)
-      )    
-		`thenLne` \ (scrut2, scrut_fvs, scrut_escs, scrut_lv_info) ->
-
-    returnLne (
-      StgCase scrut2 (getLiveVars scrut_lv_info)
-		     (getLiveVars alts_lv_info)
-		     bndr'
-		     (mkSRT alts_lv_info)
-		     (mkStgAltType (idType bndr) alts)
-		     alts2,
-      scrut_fvs `unionFVInfo` alts_fvs_wo_bndr,
-      alts_escs_wo_bndr `unionVarSet` getFVSet scrut_fvs
-		-- You might think we should have scrut_escs, not 
-		-- (getFVSet scrut_fvs), but actually we can't call, and 
-		-- then return from, a let-no-escape thing.
-      )
-  where
-    vars_alt (con, binders, rhs)
-      = let    	-- Remove type variables
-	    binders' = filterStgBinders binders
-        in	
-        extendVarEnvLne [(b, LambdaBound) | b <- binders']	$
-        coreToStgExpr rhs	`thenLne` \ (rhs2, rhs_fvs, rhs_escs) ->
-        let
-	    	-- Records whether each param is used in the RHS
-	    good_use_mask = [ b `elementOfFVInfo` rhs_fvs | b <- binders' ]
-        in
-        returnLne ( (con, binders', good_use_mask, rhs2),
-		    binders' `minusFVBinders` rhs_fvs,
-		    rhs_escs `delVarSetList` binders' )
-    		-- ToDo: remove the delVarSet;
-    		-- since escs won't include any of these binders
-\end{code}
-
-Lets not only take quite a bit of work, but this is where we convert
-then to let-no-escapes, if we wish.
-
-(Meanwhile, we don't expect to see let-no-escapes...)
-\begin{code}
-coreToStgExpr (Let bind body)
-  = fixLne (\ ~(_, _, _, no_binder_escapes) ->
-	coreToStgLet no_binder_escapes bind body
-    )				`thenLne` \ (new_let, fvs, escs, _) ->
-
-    returnLne (new_let, fvs, escs)
-\end{code}
-
-\begin{code}
-mkStgAltType scrut_ty alts
-  = case splitTyConApp_maybe (repType scrut_ty) of
-	Just (tc,_) | isUnboxedTupleTyCon tc -> UbxTupAlt tc
-		    | isPrimTyCon tc	     -> PrimAlt tc
-		    | isHiBootTyCon tc	     -> look_for_better_tycon
-		    | isAlgTyCon tc 	     -> AlgAlt tc
-		    | isFunTyCon tc	     -> PolyAlt
-		    | otherwise		     -> pprPanic "mkStgAlts" (ppr tc)
-	Nothing				     -> PolyAlt
-
-  where
-   -- Sometimes, the TyCon in the type of the scrutinee is an HiBootTyCon,
-   -- which may not have any constructors inside it.  If so, then we
-   -- can get a better TyCon by grabbing the one from a constructor alternative
-   -- if one exists.
-   look_for_better_tycon
-	| ((DataAlt con, _, _) : _) <- data_alts = 
-		AlgAlt (dataConTyCon con)
-	| otherwise =
-		ASSERT(null data_alts)
-		PolyAlt
-	where
-		(data_alts, _deflt) = findDefault alts
-\end{code}
-
-
--- ---------------------------------------------------------------------------
--- Applications
--- ---------------------------------------------------------------------------
-
-\begin{code}
-coreToStgApp
-	 :: Maybe UpdateFlag		-- Just upd <=> this application is
-					-- the rhs of a thunk binding
-					-- 	x = [...] \upd [] -> the_app
-					-- with specified update flag
-	-> Id				-- Function
-	-> [CoreArg]			-- Arguments
-	-> LneM (StgExpr, FreeVarsInfo, EscVarsSet)
-
-coreToStgApp maybe_thunk_body f args
-  = coreToStgArgs args		`thenLne` \ (args', args_fvs) ->
-    lookupVarLne f		`thenLne` \ how_bound ->
-
-    let
-	n_val_args	 = valArgCount args
-	not_letrec_bound = not (isLetBound how_bound)
-	fun_fvs	 	 
-          = let fvs = singletonFVInfo f how_bound fun_occ in
-            -- e.g. (f :: a -> int) (x :: a) 
-            -- Here the free variables are "f", "x" AND the type variable "a"
-            -- coreToStgArgs will deal with the arguments recursively
-            if opt_RuntimeTypes then
-	      fvs `unionFVInfo` tyvarFVInfo (tyVarsOfType (idType f))
-	    else fvs
-
-	-- Mostly, the arity info of a function is in the fn's IdInfo
-	-- But new bindings introduced by CoreSat may not have no
-	-- arity info; it would do us no good anyway.  For example:
-	--	let f = \ab -> e in f
-	-- No point in having correct arity info for f!
-	-- Hence the hasArity stuff below.
-	-- NB: f_arity is only consulted for LetBound things
-	f_arity   = stgArity f how_bound
-	saturated = f_arity <= n_val_args
-
-	fun_occ 
-	 | not_letrec_bound	    = noBinderInfo	-- Uninteresting variable
-	 | f_arity > 0 && saturated = stgSatOcc	-- Saturated or over-saturated function call
-	 | otherwise		    = stgUnsatOcc	-- Unsaturated function or thunk
-
-	fun_escs
-	 | not_letrec_bound      = emptyVarSet	-- Only letrec-bound escapees are interesting
-	 | f_arity == n_val_args = emptyVarSet	-- A function *or thunk* with an exactly
-						-- saturated call doesn't escape
-						-- (let-no-escape applies to 'thunks' too)
-
-	 | otherwise 	     = unitVarSet f	-- Inexact application; it does escape
-
-	-- At the moment of the call:
-
-	--  either the function is *not* let-no-escaped, in which case
-	--  	   nothing is live except live_in_cont
-	--	or the function *is* let-no-escaped in which case the
-	--	   variables it uses are live, but still the function
-	--	   itself is not.  PS.  In this case, the function's
-	--	   live vars should already include those of the
-	--	   continuation, but it does no harm to just union the
-	--	   two regardless.
-
-	res_ty = exprType (mkApps (Var f) args)
-	app = case globalIdDetails f of
-      		DataConWorkId dc | saturated -> StgConApp dc args'
-	        PrimOpId op  		     -> ASSERT( saturated )
-					        StgOpApp (StgPrimOp op) args' res_ty
-		FCallId call	 -> ASSERT( saturated )
-				    StgOpApp (StgFCallOp call (idUnique f)) args' res_ty
-		_other      	 -> StgApp f args'
-
-    in
-    returnLne (
-	app,
-	fun_fvs  `unionFVInfo` args_fvs,
-	fun_escs `unionVarSet` (getFVSet args_fvs)
-				-- All the free vars of the args are disqualified
-				-- from being let-no-escaped.
-    )
-
-
-
--- ---------------------------------------------------------------------------
--- Argument lists
--- This is the guy that turns applications into A-normal form
--- ---------------------------------------------------------------------------
-
-coreToStgArgs :: [CoreArg] -> LneM ([StgArg], FreeVarsInfo)
-coreToStgArgs []
-  = returnLne ([], emptyFVInfo)
-
-coreToStgArgs (Type ty : args)	-- Type argument
-  = coreToStgArgs args	`thenLne` \ (args', fvs) ->
-    if opt_RuntimeTypes then
- 	returnLne (StgTypeArg ty : args', fvs `unionFVInfo` tyvarFVInfo (tyVarsOfType ty))
-    else
-    returnLne (args', fvs)
-
-coreToStgArgs (arg : args)	-- Non-type argument
-  = coreToStgArgs args	`thenLne` \ (stg_args, args_fvs) ->
-    coreToStgExpr arg	`thenLne` \ (arg', arg_fvs, escs) ->
-    let
-	fvs = args_fvs `unionFVInfo` arg_fvs
-	stg_arg = case arg' of
-		       StgApp v []      -> StgVarArg v
-		       StgConApp con [] -> StgVarArg (dataConWorkId con)
-		       StgLit lit       -> StgLitArg lit
-		       _ 		-> pprPanic "coreToStgArgs" (ppr arg)
-    in
-    returnLne (stg_arg : stg_args, fvs)
-
-
--- ---------------------------------------------------------------------------
--- The magic for lets:
--- ---------------------------------------------------------------------------
-
-coreToStgLet
-	 :: Bool	-- True <=> yes, we are let-no-escaping this let
-	 -> CoreBind	-- bindings
-	 -> CoreExpr	-- body
-    	 -> LneM (StgExpr,	-- new let
-		  FreeVarsInfo,	-- variables free in the whole let
-		  EscVarsSet,	-- variables that escape from the whole let
-		  Bool)		-- True <=> none of the binders in the bindings
-				-- is among the escaping vars
-
-coreToStgLet let_no_escape bind body
-  = fixLne (\ ~(_, _, _, _, _, rec_body_fvs, _, _) ->
-
-	-- Do the bindings, setting live_in_cont to empty if
-	-- we ain't in a let-no-escape world
-	getVarsLiveInCont		`thenLne` \ live_in_cont ->
-	setVarsLiveInCont (if let_no_escape 
-				then live_in_cont 
-				else emptyLiveInfo)
-			  (vars_bind rec_body_fvs bind)
-	    `thenLne` \ ( bind2, bind_fvs, bind_escs, bind_lv_info, env_ext) ->
-
-  	-- Do the body
-	extendVarEnvLne env_ext (
-	  coreToStgExpr body          `thenLne` \(body2, body_fvs, body_escs) ->
-	  freeVarsToLiveVars body_fvs `thenLne` \ body_lv_info ->
-
-  	  returnLne (bind2, bind_fvs, bind_escs, getLiveVars bind_lv_info,
-		     body2, body_fvs, body_escs, getLiveVars body_lv_info)
-	)
-
-    ) `thenLne` (\ (bind2, bind_fvs, bind_escs, bind_lvs, 
-		    body2, body_fvs, body_escs, body_lvs) ->
-
-
-	-- Compute the new let-expression
-    let
-	new_let | let_no_escape = StgLetNoEscape live_in_whole_let bind_lvs bind2 body2
-		| otherwise	= StgLet bind2 body2
-
-	free_in_whole_let
-	  = binders `minusFVBinders` (bind_fvs `unionFVInfo` body_fvs)
-
-	live_in_whole_let
-	  = bind_lvs `unionVarSet` (body_lvs `delVarSetList` binders)
-
-	real_bind_escs = if let_no_escape then
-			    bind_escs
-			 else
-			    getFVSet bind_fvs
-			    -- Everything escapes which is free in the bindings
-
-	let_escs = (real_bind_escs `unionVarSet` body_escs) `delVarSetList` binders
-
-	all_escs = bind_escs `unionVarSet` body_escs	-- Still includes binders of
-							-- this let(rec)
-
-	no_binder_escapes = isEmptyVarSet (set_of_binders `intersectVarSet` all_escs)
-
-#ifdef DEBUG
-	-- Debugging code as requested by Andrew Kennedy
-	checked_no_binder_escapes
-		| not no_binder_escapes && any is_join_var binders
-		= pprTrace "Interesting!  A join var that isn't let-no-escaped" (ppr binders)
-		  False
-		| otherwise = no_binder_escapes
-#else
-	checked_no_binder_escapes = no_binder_escapes
-#endif
-			    
-		-- Mustn't depend on the passed-in let_no_escape flag, since
-		-- no_binder_escapes is used by the caller to derive the flag!
-    in
-    returnLne (
-	new_let,
-	free_in_whole_let,
-	let_escs,
-	checked_no_binder_escapes
-    ))
-  where
-    set_of_binders = mkVarSet binders
-    binders	   = bindersOf bind
-
-    mk_binding bind_lv_info binder rhs
-	= (binder, LetBound (NestedLet live_vars) (manifestArity rhs))
-	where
-	   live_vars | let_no_escape = addLiveVar bind_lv_info binder
-		     | otherwise     = unitLiveVar binder
-		-- c.f. the invariant on NestedLet
-
-    vars_bind :: FreeVarsInfo		-- Free var info for body of binding
-	      -> CoreBind
-	      -> LneM (StgBinding,
-		       FreeVarsInfo, 
-		       EscVarsSet,  	  -- free vars; escapee vars
-		       LiveInfo,	  -- Vars and CAFs live in binding
-		       [(Id, HowBound)])  -- extension to environment
-					 
-
-    vars_bind body_fvs (NonRec binder rhs)
-      = coreToStgRhs body_fvs [] (binder,rhs)
-				`thenLne` \ (rhs2, bind_fvs, bind_lv_info, escs) ->
-	let
-	    env_ext_item = mk_binding bind_lv_info binder rhs
-	in
-	returnLne (StgNonRec binder rhs2, 
-		   bind_fvs, escs, bind_lv_info, [env_ext_item])
-
-
-    vars_bind body_fvs (Rec pairs)
-      = fixLne (\ ~(_, rec_rhs_fvs, _, bind_lv_info, _) ->
-	   let
-		rec_scope_fvs = unionFVInfo body_fvs rec_rhs_fvs
-	        binders = map fst pairs
-	        env_ext = [ mk_binding bind_lv_info b rhs 
-			  | (b,rhs) <- pairs ]
-	   in
-	   extendVarEnvLne env_ext (
-	      mapAndUnzip4Lne (coreToStgRhs rec_scope_fvs binders) pairs 
-					`thenLne` \ (rhss2, fvss, lv_infos, escss) ->
-	      let
-			bind_fvs = unionFVInfos fvss
-			bind_lv_info = foldr unionLiveInfo emptyLiveInfo lv_infos
-			escs     = unionVarSets escss
-	      in
-	      returnLne (StgRec (binders `zip` rhss2),
-			 bind_fvs, escs, bind_lv_info, env_ext)
-	   )
-	)
-
-is_join_var :: Id -> Bool
--- A hack (used only for compiler debuggging) to tell if
--- a variable started life as a join point ($j)
-is_join_var j = occNameString (getOccName j) == "$j"
-\end{code}
-
-\begin{code}
-coreToStgRhs :: FreeVarsInfo		-- Free var info for the scope of the binding
-	     -> [Id]
-	     -> (Id,CoreExpr)
-  	     -> LneM (StgRhs, FreeVarsInfo, LiveInfo, EscVarsSet)
-
-coreToStgRhs scope_fv_info binders (bndr, rhs)
-  = coreToStgExpr rhs 		`thenLne` \ (new_rhs, rhs_fvs, rhs_escs) ->
-    getEnvLne			`thenLne` \ env ->    
-    freeVarsToLiveVars (binders `minusFVBinders` rhs_fvs) `thenLne` \ lv_info ->
-    returnLne (mkStgRhs rhs_fvs (mkSRT lv_info) bndr_info new_rhs,
-	       rhs_fvs, lv_info, rhs_escs)
-  where
-    bndr_info = lookupFVInfo scope_fv_info bndr
-
-mkStgRhs :: FreeVarsInfo -> SRT -> StgBinderInfo -> StgExpr -> StgRhs
-
-mkStgRhs rhs_fvs srt binder_info (StgConApp con args)
-  = StgRhsCon noCCS con args
-
-mkStgRhs rhs_fvs srt binder_info (StgLam _ bndrs body)
-  = StgRhsClosure noCCS binder_info
-		  (getFVs rhs_fvs)		 
-		  ReEntrant
-		  srt bndrs body
-	
-mkStgRhs rhs_fvs srt binder_info rhs
-  = StgRhsClosure noCCS binder_info
-		  (getFVs rhs_fvs)		 
-	          upd_flag srt [] rhs
-  where
-   upd_flag = Updatable
-  {-
-    SDM: disabled.  Eval/Apply can't handle functions with arity zero very
-    well; and making these into simple non-updatable thunks breaks other
-    assumptions (namely that they will be entered only once).
-
-    upd_flag | isPAP env rhs  = ReEntrant
-	     | otherwise      = Updatable
-  -}
-
-{- ToDo:
-          upd = if isOnceDem dem
-      		    then (if isNotTop toplev 
-                	    then SingleEntry    -- HA!  Paydirt for "dem"
-                	    else 
-#ifdef DEBUG
-                     trace "WARNING: SE CAFs unsupported, forcing UPD instead" $
-#endif
-                     Updatable)
-          	else Updatable
-        -- For now we forbid SingleEntry CAFs; they tickle the
-        -- ASSERT in rts/Storage.c line 215 at newCAF() re mut_link,
-        -- and I don't understand why.  There's only one SE_CAF (well,
-        -- only one that tickled a great gaping bug in an earlier attempt
-        -- at ClosureInfo.getEntryConvention) in the whole of nofib, 
-        -- specifically Main.lvl6 in spectral/cryptarithm2.
-        -- So no great loss.  KSW 2000-07.
--}
-\end{code}
-
-Detect thunks which will reduce immediately to PAPs, and make them
-non-updatable.  This has several advantages:
-
-        - the non-updatable thunk behaves exactly like the PAP,
-
-	- the thunk is more efficient to enter, because it is
-	  specialised to the task.
-
-        - we save one update frame, one stg_update_PAP, one update
-	  and lots of PAP_enters.
-
-	- in the case where the thunk is top-level, we save building
-	  a black hole and futhermore the thunk isn't considered to
-	  be a CAF any more, so it doesn't appear in any SRTs.
-
-We do it here, because the arity information is accurate, and we need
-to do it before the SRT pass to save the SRT entries associated with
-any top-level PAPs.
-
-isPAP env (StgApp f args) = listLengthCmp args arity == LT -- idArity f > length args
-			  where
-			    arity = stgArity f (lookupBinding env f)
-isPAP env _ 	          = False
-
-
-%************************************************************************
-%*									*
-\subsection[LNE-monad]{A little monad for this let-no-escaping pass}
-%*									*
-%************************************************************************
-
-There's a lot of stuff to pass around, so we use this @LneM@ monad to
-help.  All the stuff here is only passed *down*.
-
-\begin{code}
-type LneM a =  IdEnv HowBound
-	    -> LiveInfo		-- Vars and CAFs live in continuation
-	    -> a
-
-type LiveInfo = (StgLiveVars, 	-- Dynamic live variables; 
-				-- i.e. ones with a nested (non-top-level) binding
-		 CafSet)	-- Static live variables;
-				-- i.e. top-level variables that are CAFs or refer to them
-
-type EscVarsSet = IdSet
-type CafSet     = IdSet
-
-data HowBound
-  = ImportBound		-- Used only as a response to lookupBinding; never
-			-- exists in the range of the (IdEnv HowBound)
-
-  | LetBound		-- A let(rec) in this module
-	LetInfo		-- Whether top level or nested
- 	Arity		-- Its arity (local Ids don't have arity info at this point)
-
-  | LambdaBound		-- Used for both lambda and case
-
-data LetInfo
-  = TopLet		-- top level things
-  | NestedLet LiveInfo	-- For nested things, what is live if this
-			-- thing is live?  Invariant: the binder
-			-- itself is always a member of
-			-- the dynamic set of its own LiveInfo
-
-isLetBound (LetBound _ _) = True
-isLetBound other 	  = False
-
-topLevelBound ImportBound	  = True
-topLevelBound (LetBound TopLet _) = True
-topLevelBound other		  = False
-\end{code}
-
-For a let(rec)-bound variable, x, we record LiveInfo, the set of
-variables that are live if x is live.  This LiveInfo comprises
-	(a) dynamic live variables (ones with a non-top-level binding)
-	(b) static live variabes (CAFs or things that refer to CAFs)
-
-For "normal" variables (a) is just x alone.  If x is a let-no-escaped
-variable then x is represented by a code pointer and a stack pointer
-(well, one for each stack).  So all of the variables needed in the
-execution of x are live if x is, and are therefore recorded in the
-LetBound constructor; x itself *is* included.
-
-The set of dynamic live variables is guaranteed ot have no further let-no-escaped
-variables in it.
-
-\begin{code}
-emptyLiveInfo :: LiveInfo
-emptyLiveInfo = (emptyVarSet,emptyVarSet)
-
-unitLiveVar :: Id -> LiveInfo
-unitLiveVar lv = (unitVarSet lv, emptyVarSet)
-
-unitLiveCaf :: Id -> LiveInfo
-unitLiveCaf caf = (emptyVarSet, unitVarSet caf)
-
-addLiveVar :: LiveInfo -> Id -> LiveInfo
-addLiveVar (lvs, cafs) id = (lvs `extendVarSet` id, cafs)
-
-unionLiveInfo :: LiveInfo -> LiveInfo -> LiveInfo
-unionLiveInfo (lv1,caf1) (lv2,caf2) = (lv1 `unionVarSet` lv2, caf1 `unionVarSet` caf2)
-
-mkSRT :: LiveInfo -> SRT
-mkSRT (_, cafs) = SRTEntries cafs
-
-getLiveVars :: LiveInfo -> StgLiveVars
-getLiveVars (lvs, _) = lvs
-\end{code}
-
-
-The std monad functions:
-\begin{code}
-initLne :: IdEnv HowBound -> LneM a -> a
-initLne env m = m env emptyLiveInfo
-
-
-
-{-# INLINE thenLne #-}
-{-# INLINE returnLne #-}
-
-returnLne :: a -> LneM a
-returnLne e env lvs_cont = e
-
-thenLne :: LneM a -> (a -> LneM b) -> LneM b
-thenLne m k env lvs_cont 
-  = k (m env lvs_cont) env lvs_cont
-
-mapAndUnzipLne  :: (a -> LneM (b,c))   -> [a] -> LneM ([b],[c])
-mapAndUnzipLne f [] = returnLne ([],[])
-mapAndUnzipLne f (x:xs)
-  = f x		    	`thenLne` \ (r1,  r2)  ->
-    mapAndUnzipLne f xs	`thenLne` \ (rs1, rs2) ->
-    returnLne (r1:rs1, r2:rs2)
-
-mapAndUnzip3Lne :: (a -> LneM (b,c,d)) -> [a] -> LneM ([b],[c],[d])
-mapAndUnzip3Lne f []	= returnLne ([],[],[])
-mapAndUnzip3Lne f (x:xs)
-  = f x		    	 `thenLne` \ (r1,  r2,  r3)  ->
-    mapAndUnzip3Lne f xs `thenLne` \ (rs1, rs2, rs3) ->
-    returnLne (r1:rs1, r2:rs2, r3:rs3)
-
-mapAndUnzip4Lne :: (a -> LneM (b,c,d,e)) -> [a] -> LneM ([b],[c],[d],[e])
-mapAndUnzip4Lne f []	= returnLne ([],[],[],[])
-mapAndUnzip4Lne f (x:xs)
-  = f x		    	 `thenLne` \ (r1,  r2,  r3, r4)  ->
-    mapAndUnzip4Lne f xs `thenLne` \ (rs1, rs2, rs3, rs4) ->
-    returnLne (r1:rs1, r2:rs2, r3:rs3, r4:rs4)
-
-fixLne :: (a -> LneM a) -> LneM a
-fixLne expr env lvs_cont
-  = result
-  where
-    result = expr result env lvs_cont
-\end{code}
-
-Functions specific to this monad:
-
-\begin{code}
-getVarsLiveInCont :: LneM LiveInfo
-getVarsLiveInCont env lvs_cont = lvs_cont
-
-setVarsLiveInCont :: LiveInfo -> LneM a -> LneM a
-setVarsLiveInCont new_lvs_cont expr env lvs_cont
-  = expr env new_lvs_cont
-
-extendVarEnvLne :: [(Id, HowBound)] -> LneM a -> LneM a
-extendVarEnvLne ids_w_howbound expr env lvs_cont
-  = expr (extendVarEnvList env ids_w_howbound) lvs_cont
-
-lookupVarLne :: Id -> LneM HowBound
-lookupVarLne v env lvs_cont = returnLne (lookupBinding env v) env lvs_cont
-
-getEnvLne :: LneM (IdEnv HowBound)
-getEnvLne env lvs_cont = returnLne env env lvs_cont
-
-lookupBinding :: IdEnv HowBound -> Id -> HowBound
-lookupBinding env v = case lookupVarEnv env v of
-			Just xx -> xx
-			Nothing -> ASSERT2( isGlobalId v, ppr v ) ImportBound
-
-
--- The result of lookupLiveVarsForSet, a set of live variables, is
--- only ever tacked onto a decorated expression. It is never used as
--- the basis of a control decision, which might give a black hole.
-
-freeVarsToLiveVars :: FreeVarsInfo -> LneM LiveInfo
-freeVarsToLiveVars fvs env live_in_cont
-  = returnLne live_info env live_in_cont
-  where
-    live_info    = foldr unionLiveInfo live_in_cont lvs_from_fvs
-    lvs_from_fvs = map do_one (allFreeIds fvs)
-
-    do_one (v, how_bound)
-      = case how_bound of
-	  ImportBound 		          -> unitLiveCaf v	-- Only CAF imports are 
-								-- recorded in fvs
-	  LetBound TopLet _ 		 
-		| mayHaveCafRefs (idCafInfo v) -> unitLiveCaf v
-		| otherwise		       -> emptyLiveInfo
-
-	  LetBound (NestedLet lvs) _      -> lvs	-- lvs already contains v
-							-- (see the invariant on NestedLet)
-
-	  _lambda_or_case_binding	  -> unitLiveVar v	-- Bound by lambda or case
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Free-var info]{Free variable information}
-%*									*
-%************************************************************************
-
-\begin{code}
-type FreeVarsInfo = VarEnv (Var, HowBound, StgBinderInfo)
-	-- The Var is so we can gather up the free variables
-	-- as a set.
-	--
-	-- The HowBound info just saves repeated lookups;
-	-- we look up just once when we encounter the occurrence.
-	-- INVARIANT: Any ImportBound Ids are HaveCafRef Ids
-	--	      Imported Ids without CAF refs are simply
-	--	      not put in the FreeVarsInfo for an expression.
-	--	      See singletonFVInfo and freeVarsToLiveVars
-	--
-	-- StgBinderInfo records how it occurs; notably, we
-	-- are interested in whether it only occurs in saturated 
-	-- applications, because then we don't need to build a
-	-- curried version.
-	-- If f is mapped to noBinderInfo, that means
-	-- that f *is* mentioned (else it wouldn't be in the
-	-- IdEnv at all), but perhaps in an unsaturated applications.
-	--
-	-- All case/lambda-bound things are also mapped to
-	-- noBinderInfo, since we aren't interested in their
-	-- occurence info.
-	--
-	-- For ILX we track free var info for type variables too;
-	-- hence VarEnv not IdEnv
-\end{code}
-
-\begin{code}
-emptyFVInfo :: FreeVarsInfo
-emptyFVInfo = emptyVarEnv
-
-singletonFVInfo :: Id -> HowBound -> StgBinderInfo -> FreeVarsInfo
--- Don't record non-CAF imports at all, to keep free-var sets small
-singletonFVInfo id ImportBound info
-   | mayHaveCafRefs (idCafInfo id) = unitVarEnv id (id, ImportBound, info)
-   | otherwise         		   = emptyVarEnv
-singletonFVInfo id how_bound info  = unitVarEnv id (id, how_bound, info)
-
-tyvarFVInfo :: TyVarSet -> FreeVarsInfo
-tyvarFVInfo tvs = foldVarSet add emptyFVInfo tvs
-        where
-	  add tv fvs = extendVarEnv fvs tv (tv, LambdaBound, noBinderInfo)
-		-- Type variables must be lambda-bound
-
-unionFVInfo :: FreeVarsInfo -> FreeVarsInfo -> FreeVarsInfo
-unionFVInfo fv1 fv2 = plusVarEnv_C plusFVInfo fv1 fv2
-
-unionFVInfos :: [FreeVarsInfo] -> FreeVarsInfo
-unionFVInfos fvs = foldr unionFVInfo emptyFVInfo fvs
-
-minusFVBinders :: [Id] -> FreeVarsInfo -> FreeVarsInfo
-minusFVBinders vs fv = foldr minusFVBinder fv vs
-
-minusFVBinder :: Id -> FreeVarsInfo -> FreeVarsInfo
-minusFVBinder v fv | isId v && opt_RuntimeTypes
-		   = (fv `delVarEnv` v) `unionFVInfo` 
-		     tyvarFVInfo (tyVarsOfType (idType v))
-		   | otherwise = fv `delVarEnv` v
-	-- When removing a binder, remember to add its type variables
-	-- c.f. CoreFVs.delBinderFV
-
-elementOfFVInfo :: Id -> FreeVarsInfo -> Bool
-elementOfFVInfo id fvs = maybeToBool (lookupVarEnv fvs id)
-
-lookupFVInfo :: FreeVarsInfo -> Id -> StgBinderInfo
--- Find how the given Id is used.
--- Externally visible things may be used any old how
-lookupFVInfo fvs id 
-  | isExternalName (idName id) = noBinderInfo
-  | otherwise = case lookupVarEnv fvs id of
-			Nothing         -> noBinderInfo
-			Just (_,_,info) -> info
-
-allFreeIds :: FreeVarsInfo -> [(Id,HowBound)]	-- Both top level and non-top-level Ids
-allFreeIds fvs = [(id,how_bound) | (id,how_bound,_) <- varEnvElts fvs, isId id]
-
--- Non-top-level things only, both type variables and ids
--- (type variables only if opt_RuntimeTypes)
-getFVs :: FreeVarsInfo -> [Var]	
-getFVs fvs = [id | (id, how_bound, _) <- varEnvElts fvs, 
-		    not (topLevelBound how_bound) ]
-
-getFVSet :: FreeVarsInfo -> VarSet
-getFVSet fvs = mkVarSet (getFVs fvs)
-
-plusFVInfo (id1,hb1,info1) (id2,hb2,info2)
-  = ASSERT (id1 == id2 && hb1 `check_eq_how_bound` hb2)
-    (id1, hb1, combineStgBinderInfo info1 info2)
-
-#ifdef DEBUG
--- The HowBound info for a variable in the FVInfo should be consistent
-check_eq_how_bound ImportBound 	      ImportBound 	 = True
-check_eq_how_bound LambdaBound 	      LambdaBound 	 = True
-check_eq_how_bound (LetBound li1 ar1) (LetBound li2 ar2) = ar1 == ar2 && check_eq_li li1 li2
-check_eq_how_bound hb1		      hb2		 = False
-
-check_eq_li (NestedLet _) (NestedLet _) = True
-check_eq_li TopLet        TopLet        = True
-check_eq_li li1 	  li2		= False
-#endif
-\end{code}
-
-Misc.
-\begin{code}
-filterStgBinders :: [Var] -> [Var]
-filterStgBinders bndrs
-  | opt_RuntimeTypes = bndrs
-  | otherwise	     = filter isId bndrs
-\end{code}
-
-
-\begin{code}
-	-- Ignore all notes except SCC
-myCollectBinders expr
-  = go [] expr
-  where
-    go bs (Lam b e)          = go (b:bs) e
-    go bs e@(Note (SCC _) _) = (reverse bs, e) 
-    go bs (Note _ e)         = go bs e
-    go bs e	             = (reverse bs, e)
-
-myCollectArgs :: CoreExpr -> (Id, [CoreArg])
-	-- We assume that we only have variables
-	-- in the function position by now
-myCollectArgs expr
-  = go expr []
-  where
-    go (Var v)          as = (v, as)
-    go (App f a) as        = go f (a:as)
-    go (Note (SCC _) e) as = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
-    go (Note n e)       as = go e as
-    go _		as = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
-\end{code}
-
-\begin{code}
-stgArity :: Id -> HowBound -> Arity
-stgArity f (LetBound _ arity) = arity
-stgArity f ImportBound	      = idArity f
-stgArity f LambdaBound        = 0
-\end{code}
diff --git a/ghc/compiler/stgSyn/StgLint.lhs b/ghc/compiler/stgSyn/StgLint.lhs
deleted file mode 100644
index 326cd44578..0000000000
--- a/ghc/compiler/stgSyn/StgLint.lhs
+++ /dev/null
@@ -1,524 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[StgLint]{A ``lint'' pass to check for Stg correctness}
-
-\begin{code}
-module StgLint ( lintStgBindings ) where
-
-#include "HsVersions.h"
-
-import StgSyn
-
-import Bag		( Bag, emptyBag, isEmptyBag, snocBag, bagToList )
-import Id		( Id, idType, isLocalId )
-import VarSet
-import DataCon		( DataCon, dataConInstArgTys, dataConRepType )
-import CoreSyn		( AltCon(..) )
-import PrimOp		( primOpType )
-import Literal		( literalType )
-import Maybes		( catMaybes )
-import Name		( getSrcLoc )
-import ErrUtils		( Message, mkLocMessage )
-import Type		( mkFunTys, splitFunTys, splitTyConApp_maybe,
-			  isUnLiftedType, isTyVarTy, dropForAlls, Type
-			)
-import TyCon		( isAlgTyCon, isNewTyCon, tyConDataCons )
-import Util		( zipEqual, equalLength )
-import SrcLoc		( srcLocSpan )
-import Outputable
-
-infixr 9 `thenL`, `thenL_`, `thenMaybeL`
-\end{code}
-
-Checks for
-	(a) *some* type errors
-	(b) locally-defined variables used but not defined
-
-
-Note: unless -dverbose-stg is on, display of lint errors will result
-in "panic: bOGUS_LVs".
-
-WARNING: 
-~~~~~~~~
-
-This module has suffered bit-rot; it is likely to yield lint errors
-for Stg code that is currently perfectly acceptable for code
-generation.  Solution: don't use it!  (KSW 2000-05).
-
-
-%************************************************************************
-%*									*
-\subsection{``lint'' for various constructs}
-%*									*
-%************************************************************************
-
-@lintStgBindings@ is the top-level interface function.
-
-\begin{code}
-lintStgBindings :: String -> [StgBinding] -> [StgBinding]
-
-lintStgBindings whodunnit binds
-  = {-# SCC "StgLint" #-}
-    case (initL (lint_binds binds)) of
-      Nothing  -> binds
-      Just msg -> pprPanic "" (vcat [
-			ptext SLIT("*** Stg Lint ErrMsgs: in") <+> text whodunnit <+> ptext SLIT("***"),
-			msg,
-			ptext SLIT("*** Offending Program ***"),
-			pprStgBindings binds,
-			ptext SLIT("*** End of Offense ***")])
-  where
-    lint_binds :: [StgBinding] -> LintM ()
-
-    lint_binds [] = returnL ()
-    lint_binds (bind:binds)
-      = lintStgBinds bind 		`thenL` \ binders ->
-	addInScopeVars binders (
-	    lint_binds binds
-	)
-\end{code}
-
-
-\begin{code}
-lintStgArg :: StgArg -> LintM (Maybe Type)
-lintStgArg (StgLitArg lit) = returnL (Just (literalType lit))
-lintStgArg (StgVarArg v)   = lintStgVar v
-
-lintStgVar v  = checkInScope v	`thenL_`
-		returnL (Just (idType v))
-\end{code}
-
-\begin{code}
-lintStgBinds :: StgBinding -> LintM [Id]		-- Returns the binders
-lintStgBinds (StgNonRec binder rhs)
-  = lint_binds_help (binder,rhs) 	`thenL_`
-    returnL [binder]
-
-lintStgBinds (StgRec pairs)
-  = addInScopeVars binders (
-	mapL lint_binds_help pairs `thenL_`
-	returnL binders
-    )
-  where
-    binders = [b | (b,_) <- pairs]
-
-lint_binds_help (binder, rhs)
-  = addLoc (RhsOf binder) (
-	-- Check the rhs
-	lintStgRhs rhs    `thenL` \ maybe_rhs_ty ->
-
-	-- Check binder doesn't have unlifted type
-	checkL (not (isUnLiftedType binder_ty))
-	       (mkUnLiftedTyMsg binder rhs)		`thenL_`
-
-	-- Check match to RHS type
-	(case maybe_rhs_ty of
-	  Nothing     -> returnL ()
-	  Just rhs_ty -> checkTys  binder_ty
-				   rhs_ty
-				   (mkRhsMsg binder rhs_ty)
-	)			`thenL_`
-
-	returnL ()
-    )
-  where
-    binder_ty = idType binder
-\end{code}
-
-\begin{code}
-lintStgRhs :: StgRhs -> LintM (Maybe Type)
-
-lintStgRhs (StgRhsClosure _ _ _ _ _ [] expr)
-  = lintStgExpr expr
-
-lintStgRhs (StgRhsClosure _ _ _ _ _ binders expr)
-  = addLoc (LambdaBodyOf binders) (
-    addInScopeVars binders (
-	lintStgExpr expr   `thenMaybeL` \ body_ty ->
-	returnL (Just (mkFunTys (map idType binders) body_ty))
-    ))
-
-lintStgRhs (StgRhsCon _ con args)
-  = mapMaybeL lintStgArg args	`thenL` \ maybe_arg_tys ->
-    case maybe_arg_tys of
-      Nothing 	    -> returnL Nothing
-      Just arg_tys  -> checkFunApp con_ty arg_tys (mkRhsConMsg con_ty arg_tys)
-  where
-    con_ty = dataConRepType con
-\end{code}
-
-\begin{code}
-lintStgExpr :: StgExpr -> LintM (Maybe Type)	-- Nothing if error found
-
-lintStgExpr (StgLit l) = returnL (Just (literalType l))
-
-lintStgExpr e@(StgApp fun args)
-  = lintStgVar fun		`thenMaybeL` \ fun_ty  ->
-    mapMaybeL lintStgArg args	`thenL`      \ maybe_arg_tys ->
-    case maybe_arg_tys of
-      Nothing 	    -> returnL Nothing
-      Just arg_tys  -> checkFunApp fun_ty arg_tys (mkFunAppMsg fun_ty arg_tys e)
-
-lintStgExpr e@(StgConApp con args)
-  = mapMaybeL lintStgArg args	`thenL` \ maybe_arg_tys ->
-    case maybe_arg_tys of
-      Nothing 	    -> returnL Nothing
-      Just arg_tys  -> checkFunApp con_ty arg_tys (mkFunAppMsg con_ty arg_tys e)
-  where
-    con_ty = dataConRepType con
-
-lintStgExpr e@(StgOpApp (StgFCallOp _ _) args res_ty)
-  = 	-- We don't have enough type information to check
-	-- the application; ToDo
-    mapMaybeL lintStgArg args	`thenL` \ maybe_arg_tys ->
-    returnL (Just res_ty)
-
-lintStgExpr e@(StgOpApp (StgPrimOp op) args _)
-  = mapMaybeL lintStgArg args	`thenL` \ maybe_arg_tys ->
-    case maybe_arg_tys of
-      Nothing 	    -> returnL Nothing
-      Just arg_tys  -> checkFunApp op_ty arg_tys (mkFunAppMsg op_ty arg_tys e)
-  where
-    op_ty = primOpType op
-
-lintStgExpr (StgLam _ bndrs _)
-  = addErrL (ptext SLIT("Unexpected StgLam") <+> ppr bndrs)	`thenL_`
-    returnL Nothing
-
-lintStgExpr (StgLet binds body)
-  = lintStgBinds binds		`thenL` \ binders ->
-    addLoc (BodyOfLetRec binders) (
-    addInScopeVars binders (
-	lintStgExpr body
-    ))
-
-lintStgExpr (StgLetNoEscape _ _ binds body)
-  = lintStgBinds binds		`thenL` \ binders ->
-    addLoc (BodyOfLetRec binders) (
-    addInScopeVars binders (
-	lintStgExpr body
-    ))
-
-lintStgExpr (StgSCC _ expr)	= lintStgExpr expr
-
-lintStgExpr e@(StgCase scrut _ _ bndr _ alts_type alts)
-  = lintStgExpr scrut		`thenMaybeL` \ _ ->
-
-    (case alts_type of
-	AlgAlt tc    -> check_bndr tc
-	PrimAlt tc   -> check_bndr tc
-	UbxTupAlt tc -> check_bndr tc
-	PolyAlt      -> returnL ()
-    )							`thenL_`
-	
-    (trace (showSDoc (ppr e)) $ 
-	-- we only allow case of tail-call or primop.
-    (case scrut of
-	StgApp _ _    -> returnL ()
-	StgConApp _ _ -> returnL ()
-	StgOpApp _ _ _ -> returnL ()
-	other -> addErrL (mkCaseOfCaseMsg e))   `thenL_`
-
-    addInScopeVars [bndr] (lintStgAlts alts scrut_ty)
-    )
-  where
-    scrut_ty	  = idType bndr
-    bad_bndr      = mkDefltMsg bndr
-    check_bndr tc = case splitTyConApp_maybe scrut_ty of
-			Just (bndr_tc, _) -> checkL (tc == bndr_tc) bad_bndr
-			Nothing		  -> addErrL bad_bndr
-
-
-lintStgAlts :: [StgAlt]
-	    -> Type 		-- Type of scrutinee
-	    -> LintM (Maybe Type)	-- Type of alternatives
-
-lintStgAlts alts scrut_ty
-  = mapL (lintAlt scrut_ty) alts 	`thenL` \ maybe_result_tys ->
-
-	 -- Check the result types
-    case catMaybes (maybe_result_tys) of
-      []	     -> returnL Nothing
-
-      (first_ty:tys) -> mapL check tys	`thenL_`
-			returnL (Just first_ty)
-	where
-	  check ty = checkTys first_ty ty (mkCaseAltMsg alts)
-
-lintAlt scrut_ty (DEFAULT, _, _, rhs)
- = lintStgExpr rhs
-
-lintAlt scrut_ty (LitAlt lit, _, _, rhs)
- = checkTys (literalType lit) scrut_ty (mkAltMsg1 scrut_ty)	`thenL_`
-   lintStgExpr rhs
-
-lintAlt scrut_ty (DataAlt con, args, _, rhs)
-  = (case splitTyConApp_maybe scrut_ty of
-      Just (tycon, tys_applied) | isAlgTyCon tycon && 
-				  not (isNewTyCon tycon) ->
-	 let
-	   cons    = tyConDataCons tycon
-	   arg_tys = dataConInstArgTys con tys_applied
-		-- This almost certainly does not work for existential constructors
-	 in
-	 checkL (con `elem` cons) (mkAlgAltMsg2 scrut_ty con) `thenL_`
-	 checkL (equalLength arg_tys args) (mkAlgAltMsg3 con args)
-								 `thenL_`
-	 mapL check (zipEqual "lintAlgAlt:stg" arg_tys args)	 `thenL_`
-	 returnL ()
-      other ->
-	 addErrL (mkAltMsg1 scrut_ty)
-    )								 `thenL_`
-    addInScopeVars args 	(
-	 lintStgExpr rhs
-    )
-  where
-    check (ty, arg) = checkTys ty (idType arg) (mkAlgAltMsg4 ty arg)
-
-    -- elem: yes, the elem-list here can sometimes be long-ish,
-    -- but as it's use-once, probably not worth doing anything different
-    -- We give it its own copy, so it isn't overloaded.
-    elem _ []	    = False
-    elem x (y:ys)   = x==y || elem x ys
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[lint-monad]{The Lint monad}
-%*									*
-%************************************************************************
-
-\begin{code}
-type LintM a = [LintLocInfo] 	-- Locations
-	    -> IdSet		-- Local vars in scope
-	    -> Bag Message	-- Error messages so far
-	    -> (a, Bag Message)	-- Result and error messages (if any)
-
-data LintLocInfo
-  = RhsOf Id		-- The variable bound
-  | LambdaBodyOf [Id]	-- The lambda-binder
-  | BodyOfLetRec [Id]	-- One of the binders
-
-dumpLoc (RhsOf v) =
-  (srcLocSpan (getSrcLoc v), ptext SLIT(" [RHS of ") <> pp_binders [v] <> char ']' )
-dumpLoc (LambdaBodyOf bs) =
-  (srcLocSpan (getSrcLoc (head bs)), ptext SLIT(" [in body of lambda with binders ") <> pp_binders bs <> char ']' )
-
-dumpLoc (BodyOfLetRec bs) =
-  (srcLocSpan (getSrcLoc (head bs)), ptext SLIT(" [in body of letrec with binders ") <> pp_binders bs <> char ']' )
-
-
-pp_binders :: [Id] -> SDoc
-pp_binders bs
-  = sep (punctuate comma (map pp_binder bs))
-  where
-    pp_binder b
-      = hsep [ppr b, dcolon, ppr (idType b)]
-\end{code}
-
-\begin{code}
-initL :: LintM a -> Maybe Message
-initL m
-  = case (m [] emptyVarSet emptyBag) of { (_, errs) ->
-    if isEmptyBag errs then
-	Nothing
-    else
-	Just (vcat (punctuate (text "") (bagToList errs)))
-    }
-
-returnL :: a -> LintM a
-returnL r loc scope errs = (r, errs)
-
-thenL :: LintM a -> (a -> LintM b) -> LintM b
-thenL m k loc scope errs
-  = case m loc scope errs of
-      (r, errs') -> k r loc scope errs'
-
-thenL_ :: LintM a -> LintM b -> LintM b
-thenL_ m k loc scope errs
-  = case m loc scope errs of
-      (_, errs') -> k loc scope errs'
-
-thenMaybeL :: LintM (Maybe a) -> (a -> LintM (Maybe b)) -> LintM (Maybe b)
-thenMaybeL m k loc scope errs
-  = case m loc scope errs of
-      (Nothing, errs2) -> (Nothing, errs2)
-      (Just r,  errs2) -> k r loc scope errs2
-
-mapL :: (a -> LintM b) -> [a] -> LintM [b]
-mapL f [] = returnL []
-mapL f (x:xs)
-  = f x 	`thenL` \ r ->
-    mapL f xs	`thenL` \ rs ->
-    returnL (r:rs)
-
-mapMaybeL :: (a -> LintM (Maybe b)) -> [a] -> LintM (Maybe [b])
-	-- Returns Nothing if anything fails
-mapMaybeL f [] = returnL (Just [])
-mapMaybeL f (x:xs)
-  = f x	    	    `thenMaybeL` \ r ->
-    mapMaybeL f xs  `thenMaybeL` \ rs ->
-    returnL (Just (r:rs))
-\end{code}
-
-\begin{code}
-checkL :: Bool -> Message -> LintM ()
-checkL True  msg loc scope errs = ((), errs)
-checkL False msg loc scope errs = ((), addErr errs msg loc)
-
-addErrL :: Message -> LintM ()
-addErrL msg loc scope errs = ((), addErr errs msg loc)
-
-addErr :: Bag Message -> Message -> [LintLocInfo] -> Bag Message
-
-addErr errs_so_far msg locs
-  = errs_so_far `snocBag` mk_msg locs
-  where
-    mk_msg (loc:_) = let (l,hdr) = dumpLoc loc 
-		     in  mkLocMessage l (hdr $$ msg)
-    mk_msg []      = msg
-
-addLoc :: LintLocInfo -> LintM a -> LintM a
-addLoc extra_loc m loc scope errs
-  = m (extra_loc:loc) scope errs
-
-addInScopeVars :: [Id] -> LintM a -> LintM a
-addInScopeVars ids m loc scope errs
-  = -- We check if these "new" ids are already
-    -- in scope, i.e., we have *shadowing* going on.
-    -- For now, it's just a "trace"; we may make
-    -- a real error out of it...
-    let
-	new_set = mkVarSet ids
-    in
---  After adding -fliberate-case, Simon decided he likes shadowed
---  names after all.  WDP 94/07
---  (if isEmptyVarSet shadowed
---  then id
---  else pprTrace "Shadowed vars:" (ppr (varSetElems shadowed))) $
-    m loc (scope `unionVarSet` new_set) errs
-\end{code}
-
-Checking function applications: we only check that the type has the
-right *number* of arrows, we don't actually compare the types.  This
-is because we can't expect the types to be equal - the type
-applications and type lambdas that we use to calculate accurate types
-have long since disappeared.
-
-\begin{code}
-checkFunApp :: Type 		    -- The function type
-	    -> [Type]		    -- The arg type(s)
-	    -> Message		    -- Error messgae
-	    -> LintM (Maybe Type)   -- The result type
-
-checkFunApp fun_ty arg_tys msg loc scope errs
-  = cfa res_ty expected_arg_tys arg_tys
-  where
-    (expected_arg_tys, res_ty) = splitFunTys (dropForAlls fun_ty)
-
-    cfa res_ty expected []	-- Args have run out; that's fine
-      = (Just (mkFunTys expected res_ty), errs)
-
-    cfa res_ty [] arg_tys	-- Expected arg tys ran out first;
-				-- first see if res_ty is a tyvar template;
-				-- otherwise, maybe res_ty is a
-				-- dictionary type which is actually a function?
-      | isTyVarTy res_ty
-      = (Just res_ty, errs)
-      | otherwise
-      = case splitFunTys res_ty of
-	  ([], _) 		  -> (Nothing, addErr errs msg loc)	-- Too many args
-	  (new_expected, new_res) -> cfa new_res new_expected arg_tys
-
-    cfa res_ty (expected_arg_ty:expected_arg_tys) (arg_ty:arg_tys)
-      = cfa res_ty expected_arg_tys arg_tys
-\end{code}
-
-\begin{code}
-checkInScope :: Id -> LintM ()
-checkInScope id loc scope errs
-  = if isLocalId id && not (id `elemVarSet` scope) then
-	((), addErr errs (hsep [ppr id, ptext SLIT("is out of scope")]) loc)
-    else
-	((), errs)
-
-checkTys :: Type -> Type -> Message -> LintM ()
-checkTys ty1 ty2 msg loc scope errs
-  = -- if (ty1 == ty2) then
-    ((), errs)
-    -- else ((), addErr errs msg loc)
-\end{code}
-
-\begin{code}
-mkCaseAltMsg :: [StgAlt] -> Message
-mkCaseAltMsg alts
-  = ($$) (text "In some case alternatives, type of alternatives not all same:")
-	    (empty) -- LATER: ppr alts
-
-mkDefltMsg :: Id -> Message
-mkDefltMsg bndr
-  = ($$) (ptext SLIT("Binder of a case expression doesn't match type of scrutinee:"))
-	    (panic "mkDefltMsg")
-
-mkFunAppMsg :: Type -> [Type] -> StgExpr -> Message
-mkFunAppMsg fun_ty arg_tys expr
-  = vcat [text "In a function application, function type doesn't match arg types:",
-	      hang (ptext SLIT("Function type:")) 4 (ppr fun_ty),
-	      hang (ptext SLIT("Arg types:")) 4 (vcat (map (ppr) arg_tys)),
-	      hang (ptext SLIT("Expression:")) 4 (ppr expr)]
-
-mkRhsConMsg :: Type -> [Type] -> Message
-mkRhsConMsg fun_ty arg_tys
-  = vcat [text "In a RHS constructor application, con type doesn't match arg types:",
-	      hang (ptext SLIT("Constructor type:")) 4 (ppr fun_ty),
-	      hang (ptext SLIT("Arg types:")) 4 (vcat (map (ppr) arg_tys))]
-
-mkAltMsg1 :: Type -> Message
-mkAltMsg1 ty
-  = ($$) (text "In a case expression, type of scrutinee does not match patterns")
-	 (ppr ty)
-
-mkAlgAltMsg2 :: Type -> DataCon -> Message
-mkAlgAltMsg2 ty con
-  = vcat [
-	text "In some algebraic case alternative, constructor is not a constructor of scrutinee type:",
-	ppr ty,
-	ppr con
-    ]
-
-mkAlgAltMsg3 :: DataCon -> [Id] -> Message
-mkAlgAltMsg3 con alts
-  = vcat [
-	text "In some algebraic case alternative, number of arguments doesn't match constructor:",
-	ppr con,
-	ppr alts
-    ]
-
-mkAlgAltMsg4 :: Type -> Id -> Message
-mkAlgAltMsg4 ty arg
-  = vcat [
-	text "In some algebraic case alternative, type of argument doesn't match data constructor:",
-	ppr ty,
-	ppr arg
-    ]
-
-mkCaseOfCaseMsg :: StgExpr -> Message
-mkCaseOfCaseMsg e
-  = text "Case of non-tail-call:" $$ ppr e
-
-mkRhsMsg :: Id -> Type -> Message
-mkRhsMsg binder ty
-  = vcat [hsep [ptext SLIT("The type of this binder doesn't match the type of its RHS:"),
-		     ppr binder],
-	      hsep [ptext SLIT("Binder's type:"), ppr (idType binder)],
-	      hsep [ptext SLIT("Rhs type:"), ppr ty]
-	     ]
-
-mkUnLiftedTyMsg binder rhs
-  = (ptext SLIT("Let(rec) binder") <+> quotes (ppr binder) <+> 
-     ptext SLIT("has unlifted type") <+> quotes (ppr (idType binder)))
-    $$
-    (ptext SLIT("RHS:") <+> ppr rhs)
-\end{code}
diff --git a/ghc/compiler/stgSyn/StgSyn.lhs b/ghc/compiler/stgSyn/StgSyn.lhs
deleted file mode 100644
index f1c50cc8fd..0000000000
--- a/ghc/compiler/stgSyn/StgSyn.lhs
+++ /dev/null
@@ -1,786 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[StgSyn]{Shared term graph (STG) syntax for spineless-tagless code generation}
-
-This data type represents programs just before code generation
-(conversion to @AbstractC@): basically, what we have is a stylised
-form of @CoreSyntax@, the style being one that happens to be ideally
-suited to spineless tagless code generation.
-
-\begin{code}
-module StgSyn (
-	GenStgArg(..), 
-	GenStgLiveVars,
-
-	GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),
-	GenStgAlt, AltType(..),
-
-	UpdateFlag(..), isUpdatable,
-
-	StgBinderInfo,
-	noBinderInfo, stgSatOcc, stgUnsatOcc, satCallsOnly,
-	combineStgBinderInfo,
-
-	-- a set of synonyms for the most common (only :-) parameterisation
-	StgArg, StgLiveVars,
-	StgBinding, StgExpr, StgRhs, StgAlt, 
-
-	-- StgOp
-	StgOp(..),
-
-	-- SRTs
-	SRT(..),
-
-	-- utils
-	stgBindHasCafRefs, stgArgHasCafRefs, stgRhsArity,
-	isDllConApp, isStgTypeArg,
-	stgArgType,
-
-	pprStgBinding, pprStgBindings, pprStgBindingsWithSRTs
-
-#ifdef DEBUG
-	, pprStgLVs
-#endif
-    ) where
-
-#include "HsVersions.h"
-
-import CostCentre	( CostCentreStack, CostCentre )
-import VarSet		( IdSet, isEmptyVarSet )
-import Var		( isId )
-import Id		( Id, idName, idType, idCafInfo )
-import IdInfo		( mayHaveCafRefs )
-import Packages		( isDllName )
-import Literal		( Literal, literalType )
-import ForeignCall	( ForeignCall )
-import DataCon		( DataCon, dataConName )
-import CoreSyn		( AltCon )
-import PprCore		( {- instances -} )
-import PrimOp		( PrimOp )
-import Outputable
-import Util             ( count )
-import Type             ( Type )
-import TyCon            ( TyCon )
-import UniqSet		( isEmptyUniqSet, uniqSetToList, UniqSet )
-import Unique		( Unique )
-import Bitmap
-import DynFlags		( DynFlags )
-import Packages		( HomeModules )
-import StaticFlags	( opt_SccProfilingOn )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{@GenStgBinding@}
-%*									*
-%************************************************************************
-
-As usual, expressions are interesting; other things are boring.  Here
-are the boring things [except note the @GenStgRhs@], parameterised
-with respect to binder and occurrence information (just as in
-@CoreSyn@):
-
-There is one SRT for each group of bindings.
-
-\begin{code}
-data GenStgBinding bndr occ
-  = StgNonRec	bndr (GenStgRhs bndr occ)
-  | StgRec	[(bndr, GenStgRhs bndr occ)]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{@GenStgArg@}
-%*									*
-%************************************************************************
-
-\begin{code}
-data GenStgArg occ
-  = StgVarArg	occ
-  | StgLitArg   Literal
-  | StgTypeArg  Type		-- For when we want to preserve all type info
-\end{code}
-
-\begin{code}
-isStgTypeArg (StgTypeArg _) = True
-isStgTypeArg other	    = False
-
-isDllArg :: HomeModules -> StgArg -> Bool
-	-- Does this argument refer to something in a different DLL?
-isDllArg hmods (StgTypeArg v)  = False
-isDllArg hmods (StgVarArg v)   = isDllName hmods (idName v)
-isDllArg hmods (StgLitArg lit) = False
-
-isDllConApp :: HomeModules -> DataCon -> [StgArg] -> Bool
-	-- Does this constructor application refer to 
-	-- anything in a different DLL?
-	-- If so, we can't allocate it statically
-isDllConApp hmods con args
-   = isDllName hmods (dataConName con) || any (isDllArg hmods) args
-
-stgArgType :: StgArg -> Type
-	-- Very half baked becase we have lost the type arguments
-stgArgType (StgVarArg v)   = idType v
-stgArgType (StgLitArg lit) = literalType lit
-stgArgType (StgTypeArg lit) = panic "stgArgType called on stgTypeArg"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{STG expressions}
-%*									*
-%************************************************************************
-
-The @GenStgExpr@ data type is parameterised on binder and occurrence
-info, as before.
-
-%************************************************************************
-%*									*
-\subsubsection{@GenStgExpr@ application}
-%*									*
-%************************************************************************
-
-An application is of a function to a list of atoms [not expressions].
-Operationally, we want to push the arguments on the stack and call the
-function.  (If the arguments were expressions, we would have to build
-their closures first.)
-
-There is no constructor for a lone variable; it would appear as
-@StgApp var [] _@.
-\begin{code}
-type GenStgLiveVars occ = UniqSet occ
-
-data GenStgExpr bndr occ
-  = StgApp
-	occ		-- function
-	[GenStgArg occ]	-- arguments; may be empty
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{@StgConApp@ and @StgPrimApp@---saturated applications}
-%*									*
-%************************************************************************
-
-There are a specialised forms of application, for
-constructors, primitives, and literals.
-\begin{code}
-  | StgLit	Literal
-  
-  | StgConApp	DataCon
-		[GenStgArg occ]	-- Saturated
-
-  | StgOpApp	StgOp		-- Primitive op or foreign call
-		[GenStgArg occ]	-- Saturated
-		Type		-- Result type; we need to know the result type
-				-- so that we can assign result registers.
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{@StgLam@}
-%*									*
-%************************************************************************
-
-StgLam is used *only* during CoreToStg's work.  Before CoreToStg has finished
-it encodes (\x -> e) as (let f = \x -> e in f)
-
-\begin{code}
-  | StgLam
-	Type		-- Type of whole lambda (useful when making a binder for it)
-	[bndr]
-	StgExpr		-- Body of lambda
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{@GenStgExpr@: case-expressions}
-%*									*
-%************************************************************************
-
-This has the same boxed/unboxed business as Core case expressions.
-\begin{code}
-  | StgCase
-	(GenStgExpr bndr occ)
-			-- the thing to examine
-
-	(GenStgLiveVars occ) -- Live vars of whole case expression, 
-			-- plus everything that happens after the case
-			-- i.e., those which mustn't be overwritten
-
-	(GenStgLiveVars occ) -- Live vars of RHSs (plus what happens afterwards)
-			-- i.e., those which must be saved before eval.
-			--
-			-- note that an alt's constructor's
-			-- binder-variables are NOT counted in the
-			-- free vars for the alt's RHS
-
-	bndr		-- binds the result of evaluating the scrutinee
-
-	SRT		-- The SRT for the continuation
-
-	AltType 
-
-	[GenStgAlt bndr occ]	-- The DEFAULT case is always *first* 
-				-- if it is there at all
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{@GenStgExpr@:  @let(rec)@-expressions}
-%*									*
-%************************************************************************
-
-The various forms of let(rec)-expression encode most of the
-interesting things we want to do.
-\begin{enumerate}
-\item
-\begin{verbatim}
-let-closure x = [free-vars] expr [args]
-in e
-\end{verbatim}
-is equivalent to
-\begin{verbatim}
-let x = (\free-vars -> \args -> expr) free-vars
-\end{verbatim}
-\tr{args} may be empty (and is for most closures).  It isn't under
-circumstances like this:
-\begin{verbatim}
-let x = (\y -> y+z)
-\end{verbatim}
-This gets mangled to
-\begin{verbatim}
-let-closure x = [z] [y] (y+z)
-\end{verbatim}
-The idea is that we compile code for @(y+z)@ in an environment in which
-@z@ is bound to an offset from \tr{Node}, and @y@ is bound to an
-offset from the stack pointer.
-
-(A let-closure is an @StgLet@ with a @StgRhsClosure@ RHS.)
-
-\item
-\begin{verbatim}
-let-constructor x = Constructor [args]
-in e
-\end{verbatim}
-
-(A let-constructor is an @StgLet@ with a @StgRhsCon@ RHS.)
-
-\item
-Letrec-expressions are essentially the same deal as
-let-closure/let-constructor, so we use a common structure and
-distinguish between them with an @is_recursive@ boolean flag.
-
-\item
-\begin{verbatim}
-let-unboxed u = an arbitrary arithmetic expression in unboxed values
-in e
-\end{verbatim}
-All the stuff on the RHS must be fully evaluated.  No function calls either!
-
-(We've backed away from this toward case-expressions with
-suitably-magical alts ...)
-
-\item
-~[Advanced stuff here!  Not to start with, but makes pattern matching
-generate more efficient code.]
-
-\begin{verbatim}
-let-escapes-not fail = expr
-in e'
-\end{verbatim}
-Here the idea is that @e'@ guarantees not to put @fail@ in a data structure,
-or pass it to another function.  All @e'@ will ever do is tail-call @fail@.
-Rather than build a closure for @fail@, all we need do is to record the stack
-level at the moment of the @let-escapes-not@; then entering @fail@ is just
-a matter of adjusting the stack pointer back down to that point and entering
-the code for it.
-
-Another example:
-\begin{verbatim}
-f x y = let z = huge-expression in
-	if y==1 then z else
-	if y==2 then z else
-	1
-\end{verbatim}
-
-(A let-escapes-not is an @StgLetNoEscape@.)
-
-\item
-We may eventually want:
-\begin{verbatim}
-let-literal x = Literal
-in e
-\end{verbatim}
-
-(ToDo: is this obsolete?)
-\end{enumerate}
-
-And so the code for let(rec)-things:
-\begin{code}
-  | StgLet
-	(GenStgBinding bndr occ)	-- right hand sides (see below)
-	(GenStgExpr bndr occ)		-- body
-
-  | StgLetNoEscape			-- remember: ``advanced stuff''
-	(GenStgLiveVars occ)		-- Live in the whole let-expression
-					-- Mustn't overwrite these stack slots
-    	    	    	    	    	--  *Doesn't* include binders of the let(rec).
-
-	(GenStgLiveVars occ)		-- Live in the right hand sides (only)
-					-- These are the ones which must be saved on
-					-- the stack if they aren't there already
-    	    	    	    	    	--  *Does* include binders of the let(rec) if recursive.
-
-	(GenStgBinding bndr occ)	-- right hand sides (see below)
-	(GenStgExpr bndr occ)		-- body
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{@GenStgExpr@: @scc@ expressions}
-%*									*
-%************************************************************************
-
-Finally for @scc@ expressions we introduce a new STG construct.
-
-\begin{code}
-  | StgSCC
-	CostCentre		-- label of SCC expression
-	(GenStgExpr bndr occ)	-- scc expression
-  -- end of GenStgExpr
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{STG right-hand sides}
-%*									*
-%************************************************************************
-
-Here's the rest of the interesting stuff for @StgLet@s; the first
-flavour is for closures:
-\begin{code}
-data GenStgRhs bndr occ
-  = StgRhsClosure
-	CostCentreStack		-- CCS to be attached (default is CurrentCCS)
-	StgBinderInfo		-- Info about how this binder is used (see below)
-	[occ]			-- non-global free vars; a list, rather than
-				-- a set, because order is important
-	!UpdateFlag		-- ReEntrant | Updatable | SingleEntry
-	SRT 			-- The SRT reference
-	[bndr]			-- arguments; if empty, then not a function;
-				-- as above, order is important.
-	(GenStgExpr bndr occ)	-- body
-\end{code}
-An example may be in order.  Consider:
-\begin{verbatim}
-let t = \x -> \y -> ... x ... y ... p ... q in e
-\end{verbatim}
-Pulling out the free vars and stylising somewhat, we get the equivalent:
-\begin{verbatim}
-let t = (\[p,q] -> \[x,y] -> ... x ... y ... p ...q) p q
-\end{verbatim}
-Stg-operationally, the @[x,y]@ are on the stack, the @[p,q]@ are
-offsets from @Node@ into the closure, and the code ptr for the closure
-will be exactly that in parentheses above.
-
-The second flavour of right-hand-side is for constructors (simple but important):
-\begin{code}
-  | StgRhsCon
-	CostCentreStack		-- CCS to be attached (default is CurrentCCS).
-				-- Top-level (static) ones will end up with
-				-- DontCareCCS, because we don't count static
-				-- data in heap profiles, and we don't set CCCS
-				-- from static closure.
-	DataCon			-- constructor
-	[GenStgArg occ]	-- args
-\end{code}
-
-\begin{code}
-stgRhsArity :: StgRhs -> Int
-stgRhsArity (StgRhsClosure _ _ _ _ _ bndrs _) = count isId bndrs
-  -- The arity never includes type parameters, so
-  -- when keeping type arguments and binders in the Stg syntax 
-  -- (opt_RuntimeTypes) we have to fliter out the type binders.
-stgRhsArity (StgRhsCon _ _ _) = 0
-\end{code}
-
-\begin{code}
-stgBindHasCafRefs :: GenStgBinding bndr Id -> Bool
-stgBindHasCafRefs (StgNonRec _ rhs) = rhsHasCafRefs rhs
-stgBindHasCafRefs (StgRec binds)    = any rhsHasCafRefs (map snd binds)
-
-rhsHasCafRefs (StgRhsClosure _ _ _ upd srt _ _) 
-  = isUpdatable upd || nonEmptySRT srt
-rhsHasCafRefs (StgRhsCon _ _ args)
-  = any stgArgHasCafRefs args
-
-stgArgHasCafRefs (StgVarArg id) = mayHaveCafRefs (idCafInfo id)
-stgArgHasCafRefs _ = False
-\end{code}
-
-Here's the @StgBinderInfo@ type, and its combining op:
-\begin{code}
-data StgBinderInfo
-  = NoStgBinderInfo
-  | SatCallsOnly	-- All occurrences are *saturated* *function* calls
-			-- This means we don't need to build an info table and 
-			-- slow entry code for the thing
-			-- Thunks never get this value
-
-noBinderInfo = NoStgBinderInfo
-stgUnsatOcc  = NoStgBinderInfo
-stgSatOcc    = SatCallsOnly
-
-satCallsOnly :: StgBinderInfo -> Bool
-satCallsOnly SatCallsOnly    = True
-satCallsOnly NoStgBinderInfo = False
-
-combineStgBinderInfo :: StgBinderInfo -> StgBinderInfo -> StgBinderInfo
-combineStgBinderInfo SatCallsOnly SatCallsOnly = SatCallsOnly
-combineStgBinderInfo info1 info2 	       = NoStgBinderInfo
-
---------------
-pp_binder_info NoStgBinderInfo = empty
-pp_binder_info SatCallsOnly    = ptext SLIT("sat-only")
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Stg-case-alternatives]{STG case alternatives}
-%*									*
-%************************************************************************
-
-Very like in @CoreSyntax@ (except no type-world stuff).
-
-The type constructor is guaranteed not to be abstract; that is, we can
-see its representation.  This is important because the code generator
-uses it to determine return conventions etc.  But it's not trivial
-where there's a moduule loop involved, because some versions of a type
-constructor might not have all the constructors visible.  So
-mkStgAlgAlts (in CoreToStg) ensures that it gets the TyCon from the
-constructors or literals (which are guaranteed to have the Real McCoy)
-rather than from the scrutinee type.
-
-\begin{code}
-type GenStgAlt bndr occ
-  = (AltCon,		-- alts: data constructor,
-     [bndr],		-- constructor's parameters,
-     [Bool],		-- "use mask", same length as
-			-- parameters; a True in a
-			-- param's position if it is
-			-- used in the ...
-     GenStgExpr bndr occ)	-- ...right-hand side.
-
-data AltType
-  = PolyAlt		-- Polymorphic (a type variable)
-  | UbxTupAlt TyCon	-- Unboxed tuple
-  | AlgAlt    TyCon	-- Algebraic data type; the AltCons will be DataAlts
-  | PrimAlt   TyCon	-- Primitive data type; the AltCons will be LitAlts
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Stg]{The Plain STG parameterisation}
-%*									*
-%************************************************************************
-
-This happens to be the only one we use at the moment.
-
-\begin{code}
-type StgBinding     = GenStgBinding	Id Id
-type StgArg         = GenStgArg		Id
-type StgLiveVars    = GenStgLiveVars	Id
-type StgExpr        = GenStgExpr	Id Id
-type StgRhs         = GenStgRhs		Id Id
-type StgAlt	    = GenStgAlt		Id Id
-\end{code}
-
-%************************************************************************
-%*                                                                      *
-\subsubsection[UpdateFlag-datatype]{@UpdateFlag@}
-%*                                                                      *
-%************************************************************************
-
-This is also used in @LambdaFormInfo@ in the @ClosureInfo@ module.
-
-A @ReEntrant@ closure may be entered multiple times, but should not be
-updated or blackholed.  An @Updatable@ closure should be updated after
-evaluation (and may be blackholed during evaluation).  A @SingleEntry@
-closure will only be entered once, and so need not be updated but may
-safely be blackholed.
-
-\begin{code}
-data UpdateFlag = ReEntrant | Updatable | SingleEntry
-
-instance Outputable UpdateFlag where
-    ppr u
-      = char (case u of { ReEntrant -> 'r';  Updatable -> 'u';  SingleEntry -> 's' })
-
-isUpdatable ReEntrant   = False
-isUpdatable SingleEntry = False
-isUpdatable Updatable   = True
-\end{code}
-
-%************************************************************************
-%*                                                                      *
-\subsubsection{StgOp}
-%*                                                                      *
-%************************************************************************
-
-An StgOp allows us to group together PrimOps and ForeignCalls.
-It's quite useful to move these around together, notably
-in StgOpApp and COpStmt.
-
-\begin{code}
-data StgOp = StgPrimOp  PrimOp
-
-	   | StgFCallOp ForeignCall Unique
-		-- The Unique is occasionally needed by the C pretty-printer
-		-- (which lacks a unique supply), notably when generating a
-		-- typedef for foreign-export-dynamic
-\end{code}
-
-
-%************************************************************************
-%*                                                                      *
-\subsubsection[Static Reference Tables]{@SRT@}
-%*                                                                      *
-%************************************************************************
-
-There is one SRT per top-level function group.  Each local binding and
-case expression within this binding group has a subrange of the whole
-SRT, expressed as an offset and length.
-
-In CoreToStg we collect the list of CafRefs at each SRT site, which is later 
-converted into the length and offset form by the SRT pass.
-
-\begin{code}
-data SRT = NoSRT
-	 | SRTEntries IdSet
-		-- generated by CoreToStg
-         | SRT !Int{-offset-} !Int{-length-} !Bitmap{-bitmap-}
-		-- generated by computeSRTs
-
-noSRT :: SRT
-noSRT = NoSRT
-
-nonEmptySRT NoSRT           = False
-nonEmptySRT (SRTEntries vs) = not (isEmptyVarSet vs)
-nonEmptySRT _               = True
-
-pprSRT (NoSRT) = ptext SLIT("_no_srt_")
-pprSRT (SRTEntries ids) = text "SRT:" <> ppr ids
-pprSRT (SRT off length bitmap) = parens (ppr off <> comma <> text "*bitmap*")
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Stg-pretty-printing]{Pretty-printing}
-%*									*
-%************************************************************************
-
-Robin Popplestone asked for semi-colon separators on STG binds; here's
-hoping he likes terminators instead...  Ditto for case alternatives.
-
-\begin{code}
-pprGenStgBinding :: (Outputable bndr, Outputable bdee, Ord bdee)
-		 => GenStgBinding bndr bdee -> SDoc
-
-pprGenStgBinding (StgNonRec bndr rhs)
-  = hang (hsep [ppr bndr, equals])
-    	4 ((<>) (ppr rhs) semi)
-
-pprGenStgBinding (StgRec pairs)
-  = vcat ((ifPprDebug (ptext SLIT("{- StgRec (begin) -}"))) :
-	   (map (ppr_bind) pairs) ++ [(ifPprDebug (ptext SLIT("{- StgRec (end) -}")))])
-  where
-    ppr_bind (bndr, expr)
-      = hang (hsep [ppr bndr, equals])
-	     4 ((<>) (ppr expr) semi)
-
-pprStgBinding  :: StgBinding -> SDoc
-pprStgBinding  bind  = pprGenStgBinding bind
-
-pprStgBindings :: [StgBinding] -> SDoc
-pprStgBindings binds = vcat (map pprGenStgBinding binds)
-
-pprGenStgBindingWithSRT	 
-	:: (Outputable bndr, Outputable bdee, Ord bdee) 
-	=> (GenStgBinding bndr bdee,[(Id,[Id])]) -> SDoc
-
-pprGenStgBindingWithSRT (bind,srts)
-  = vcat (pprGenStgBinding bind : map pprSRT srts)
-  where pprSRT (id,srt) = 
-	   ptext SLIT("SRT") <> parens (ppr id) <> ptext SLIT(": ") <> ppr srt
-
-pprStgBindingsWithSRTs :: [(StgBinding,[(Id,[Id])])] -> SDoc
-pprStgBindingsWithSRTs binds = vcat (map pprGenStgBindingWithSRT binds)
-\end{code}
-
-\begin{code}
-instance (Outputable bdee) => Outputable (GenStgArg bdee) where
-    ppr = pprStgArg
-
-instance (Outputable bndr, Outputable bdee, Ord bdee)
-		=> Outputable (GenStgBinding bndr bdee) where
-    ppr = pprGenStgBinding
-
-instance (Outputable bndr, Outputable bdee, Ord bdee)
-		=> Outputable (GenStgExpr bndr bdee) where
-    ppr = pprStgExpr
-
-instance (Outputable bndr, Outputable bdee, Ord bdee)
-		=> Outputable (GenStgRhs bndr bdee) where
-    ppr rhs = pprStgRhs rhs
-\end{code}
-
-\begin{code}
-pprStgArg :: (Outputable bdee) => GenStgArg bdee -> SDoc
-
-pprStgArg (StgVarArg var) = ppr var
-pprStgArg (StgLitArg con) = ppr con
-pprStgArg (StgTypeArg ty) = char '@' <+> ppr ty
-\end{code}
-
-\begin{code}
-pprStgExpr :: (Outputable bndr, Outputable bdee, Ord bdee)
-	   => GenStgExpr bndr bdee -> SDoc
--- special case
-pprStgExpr (StgLit lit)     = ppr lit
-
--- general case
-pprStgExpr (StgApp func args)
-  = hang (ppr func)
-	 4 (sep (map (ppr) args))
-\end{code}
-
-\begin{code}
-pprStgExpr (StgConApp con args)
-  = hsep [ ppr con, brackets (interppSP args)]
-
-pprStgExpr (StgOpApp op args _)
-  = hsep [ pprStgOp op, brackets (interppSP args)]
-
-pprStgExpr (StgLam _ bndrs body)
-  =sep [ char '\\' <+> ppr bndrs <+> ptext SLIT("->"),
-	 pprStgExpr body ]
-\end{code}
-
-\begin{code}
--- special case: let v = <very specific thing>
---		 in
---		 let ...
---		 in
---		 ...
---
--- Very special!  Suspicious! (SLPJ)
-
-{-
-pprStgExpr (StgLet srt (StgNonRec bndr (StgRhsClosure cc bi free_vars upd_flag args rhs))
-		    	expr@(StgLet _ _))
-  = ($$)
-      (hang (hcat [ptext SLIT("let { "), ppr bndr, ptext SLIT(" = "),
-			  ppr cc,
-			  pp_binder_info bi,
-			  ptext SLIT(" ["), ifPprDebug (interppSP free_vars), ptext SLIT("] \\"),
-			  ppr upd_flag, ptext SLIT(" ["),
-			  interppSP args, char ']'])
-	    8 (sep [hsep [ppr rhs, ptext SLIT("} in")]]))
-      (ppr expr)
--}
-
--- special case: let ... in let ...
-
-pprStgExpr (StgLet bind expr@(StgLet _ _))
-  = ($$)
-      (sep [hang (ptext SLIT("let {"))
-	 	2 (hsep [pprGenStgBinding bind, ptext SLIT("} in")])])
-      (ppr expr)
-
--- general case
-pprStgExpr (StgLet bind expr)
-  = sep [hang (ptext SLIT("let {")) 2 (pprGenStgBinding bind),
-	   hang (ptext SLIT("} in ")) 2 (ppr expr)]
-
-pprStgExpr (StgLetNoEscape lvs_whole lvs_rhss bind expr)
-  = sep [hang (ptext SLIT("let-no-escape {"))
-	    	2 (pprGenStgBinding bind),
-	   hang ((<>) (ptext SLIT("} in "))
-		   (ifPprDebug (
-		    nest 4 (
-		      hcat [ptext  SLIT("-- lvs: ["), interppSP (uniqSetToList lvs_whole),
-			     ptext SLIT("]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
-			     char ']']))))
-		2 (ppr expr)]
-
-pprStgExpr (StgSCC cc expr)
-  = sep [ hsep [ptext SLIT("_scc_"), ppr cc],
-	  pprStgExpr expr ]
-
-pprStgExpr (StgCase expr lvs_whole lvs_rhss bndr srt alt_type alts)
-  = sep [sep [ptext SLIT("case"),
-	   nest 4 (hsep [pprStgExpr expr,
-	     ifPprDebug (dcolon <+> ppr alt_type)]),
-	   ptext SLIT("of"), ppr bndr, char '{'],
-	   ifPprDebug (
-	   nest 4 (
-	     hcat [ptext  SLIT("-- lvs: ["), interppSP (uniqSetToList lvs_whole),
-		    ptext SLIT("]; rhs lvs: ["), interppSP (uniqSetToList lvs_rhss),
-		    ptext SLIT("]; "),
-		    pprMaybeSRT srt])),
-	   nest 2 (vcat (map pprStgAlt alts)),
-	   char '}']
-
-pprStgAlt (con, params, use_mask, expr)
-  = hang (hsep [ppr con, interppSP params, ptext SLIT("->")])
-	 4 (ppr expr <> semi)
-
-pprStgOp (StgPrimOp  op)   = ppr op
-pprStgOp (StgFCallOp op _) = ppr op
-
-instance Outputable AltType where
-  ppr PolyAlt 	     = ptext SLIT("Polymorphic")
-  ppr (UbxTupAlt tc) = ptext SLIT("UbxTup") <+> ppr tc
-  ppr (AlgAlt tc)    = ptext SLIT("Alg")    <+> ppr tc
-  ppr (PrimAlt tc)   = ptext SLIT("Prim")   <+> ppr tc
-\end{code}
-
-\begin{code}
-pprStgLVs :: Outputable occ => GenStgLiveVars occ -> SDoc
-pprStgLVs lvs
-  = getPprStyle $ \ sty ->
-    if userStyle sty || isEmptyUniqSet lvs then
-	empty
-    else
-	hcat [text "{-lvs:", interpp'SP (uniqSetToList lvs), text "-}"]
-\end{code}
-
-\begin{code}
-pprStgRhs :: (Outputable bndr, Outputable bdee, Ord bdee)
-	  => GenStgRhs bndr bdee -> SDoc
-
--- special case
-pprStgRhs (StgRhsClosure cc bi [free_var] upd_flag srt [{-no args-}] (StgApp func []))
-  = hcat [ ppr cc,
-	   pp_binder_info bi,
-	   brackets (ifPprDebug (ppr free_var)),
-	   ptext SLIT(" \\"), ppr upd_flag, pprMaybeSRT srt, ptext SLIT(" [] "), ppr func ]
-
--- general case
-pprStgRhs (StgRhsClosure cc bi free_vars upd_flag srt args body)
-  = hang (hsep [if opt_SccProfilingOn then ppr cc else empty,
-		pp_binder_info bi,
-		ifPprDebug (brackets (interppSP free_vars)),
-		char '\\' <> ppr upd_flag, pprMaybeSRT srt, brackets (interppSP args)])
-	 4 (ppr body)
-
-pprStgRhs (StgRhsCon cc con args)
-  = hcat [ ppr cc,
-	   space, ppr con, ptext SLIT("! "), brackets (interppSP args)]
-
-pprMaybeSRT (NoSRT) = empty
-pprMaybeSRT srt     = ptext SLIT("srt:") <> pprSRT srt
-\end{code}
diff --git a/ghc/compiler/stranal/DmdAnal.lhs b/ghc/compiler/stranal/DmdAnal.lhs
deleted file mode 100644
index c5cfb7b4bd..0000000000
--- a/ghc/compiler/stranal/DmdAnal.lhs
+++ /dev/null
@@ -1,1185 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-
-			-----------------
-			A demand analysis
-			-----------------
-
-\begin{code}
-module DmdAnal ( dmdAnalPgm, dmdAnalTopRhs, 
-		 both {- needed by WwLib -}
-   ) where
-
-#include "HsVersions.h"
-
-import DynFlags		( DynFlags, DynFlag(..) )
-import StaticFlags	( opt_MaxWorkerArgs )
-import NewDemand	-- All of it
-import CoreSyn
-import PprCore	
-import CoreUtils	( exprIsHNF, exprIsTrivial, exprArity )
-import DataCon		( dataConTyCon )
-import TyCon		( isProductTyCon, isRecursiveTyCon )
-import Id		( Id, idType, idInlinePragma,
-			  isDataConWorkId, isGlobalId, idArity,
-#ifdef OLD_STRICTNESS
-			  idDemandInfo,  idStrictness, idCprInfo, idName,
-#endif
-			  idNewStrictness, idNewStrictness_maybe,
-			  setIdNewStrictness, idNewDemandInfo,
-			  idNewDemandInfo_maybe,
-			  setIdNewDemandInfo
-			)
-#ifdef OLD_STRICTNESS
-import IdInfo 		( newStrictnessFromOld, newDemand )
-#endif
-import Var		( Var )
-import VarEnv
-import TysWiredIn	( unboxedPairDataCon )
-import TysPrim		( realWorldStatePrimTy )
-import UniqFM		( plusUFM_C, addToUFM_Directly, lookupUFM_Directly,
-			  keysUFM, minusUFM, ufmToList, filterUFM )
-import Type		( isUnLiftedType, coreEqType )
-import CoreLint		( showPass, endPass )
-import Util		( mapAndUnzip, mapAccumL, mapAccumR, lengthIs )
-import BasicTypes	( Arity, TopLevelFlag(..), isTopLevel, isNeverActive,
-			  RecFlag(..), isRec )
-import Maybes		( orElse, expectJust )
-import Outputable
-\end{code}
-
-To think about
-
-* set a noinline pragma on bottoming Ids
-
-* Consider f x = x+1 `fatbar` error (show x)
-  We'd like to unbox x, even if that means reboxing it in the error case.
-
-
-%************************************************************************
-%*									*
-\subsection{Top level stuff}
-%*									*
-%************************************************************************
-
-\begin{code}
-dmdAnalPgm :: DynFlags -> [CoreBind] -> IO [CoreBind]
-dmdAnalPgm dflags binds
-  = do {
-	showPass dflags "Demand analysis" ;
-	let { binds_plus_dmds = do_prog binds } ;
-
-	endPass dflags "Demand analysis" 
-	 	Opt_D_dump_stranal binds_plus_dmds ;
-#ifdef OLD_STRICTNESS
-	-- Only if OLD_STRICTNESS is on, because only then is the old
-	-- strictness analyser run
-	let { dmd_changes = get_changes binds_plus_dmds } ;
-	printDump (text "Changes in demands" $$ dmd_changes) ;
-#endif
-	return binds_plus_dmds
-    }
-  where
-    do_prog :: [CoreBind] -> [CoreBind]
-    do_prog binds = snd $ mapAccumL dmdAnalTopBind emptySigEnv binds
-
-dmdAnalTopBind :: SigEnv
-	       -> CoreBind 
-	       -> (SigEnv, CoreBind)
-dmdAnalTopBind sigs (NonRec id rhs)
-  = let
-	(    _, _, (_,   rhs1)) = dmdAnalRhs TopLevel NonRecursive sigs (id, rhs)
-	(sigs2, _, (id2, rhs2)) = dmdAnalRhs TopLevel NonRecursive sigs (id, rhs1)
-		-- Do two passes to improve CPR information
-		-- See comments with ignore_cpr_info in mk_sig_ty
-		-- and with extendSigsWithLam
-    in
-    (sigs2, NonRec id2 rhs2)    
-
-dmdAnalTopBind sigs (Rec pairs)
-  = let
-	(sigs', _, pairs')  = dmdFix TopLevel sigs pairs
-		-- We get two iterations automatically
-		-- c.f. the NonRec case above
-    in
-    (sigs', Rec pairs')
-\end{code}
-
-\begin{code}
-dmdAnalTopRhs :: CoreExpr -> (StrictSig, CoreExpr)
--- Analyse the RHS and return
---	a) appropriate strictness info
---	b) the unfolding (decorated with stricntess info)
-dmdAnalTopRhs rhs
-  = (sig, rhs2)
-  where
-    call_dmd	   = vanillaCall (exprArity rhs)
-    (_,      rhs1) = dmdAnal emptySigEnv call_dmd rhs
-    (rhs_ty, rhs2) = dmdAnal emptySigEnv call_dmd rhs1
-    sig		   = mkTopSigTy rhs rhs_ty
-	-- Do two passes; see notes with extendSigsWithLam
-	-- Otherwise we get bogus CPR info for constructors like
-	-- 	newtype T a = MkT a
-	-- The constructor looks like (\x::T a -> x), modulo the coerce
-	-- extendSigsWithLam will optimistically give x a CPR tag the 
-	-- first time, which is wrong in the end.
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The analyser itself}	
-%*									*
-%************************************************************************
-
-\begin{code}
-dmdAnal :: SigEnv -> Demand -> CoreExpr -> (DmdType, CoreExpr)
-
-dmdAnal sigs Abs  e = (topDmdType, e)
-
-dmdAnal sigs dmd e 
-  | not (isStrictDmd dmd)
-  = let 
-	(res_ty, e') = dmdAnal sigs evalDmd e
-    in
-    (deferType res_ty, e')
-	-- It's important not to analyse e with a lazy demand because
-	-- a) When we encounter   case s of (a,b) -> 
-	--	we demand s with U(d1d2)... but if the overall demand is lazy
-	--	that is wrong, and we'd need to reduce the demand on s,
-	--	which is inconvenient
-	-- b) More important, consider
-	--	f (let x = R in x+x), where f is lazy
-	--    We still want to mark x as demanded, because it will be when we
-	--    enter the let.  If we analyse f's arg with a Lazy demand, we'll
-	--    just mark x as Lazy
-	-- c) The application rule wouldn't be right either
-	--    Evaluating (f x) in a L demand does *not* cause
-	--    evaluation of f in a C(L) demand!
-
-
-dmdAnal sigs dmd (Lit lit)
-  = (topDmdType, Lit lit)
-
-dmdAnal sigs dmd (Var var)
-  = (dmdTransform sigs var dmd, Var var)
-
-dmdAnal sigs dmd (Note n e)
-  = (dmd_ty, Note n e')
-  where
-    (dmd_ty, e') = dmdAnal sigs dmd' e	
-    dmd' = case n of
-	     Coerce _ _ -> evalDmd  -- This coerce usually arises from a recursive
-	     other	-> dmd 	    -- newtype, and we don't want to look inside them
-				    -- for exactly the same reason that we don't look
-				    -- inside recursive products -- we might not reach
-				    -- a fixpoint.  So revert to a vanilla Eval demand
-
-dmdAnal sigs dmd (App fun (Type ty))
-  = (fun_ty, App fun' (Type ty))
-  where
-    (fun_ty, fun') = dmdAnal sigs dmd fun
-
--- Lots of the other code is there to make this
--- beautiful, compositional, application rule :-)
-dmdAnal sigs dmd e@(App fun arg)	-- Non-type arguments
-  = let				-- [Type arg handled above]
-	(fun_ty, fun') 	  = dmdAnal sigs (Call dmd) fun
-	(arg_ty, arg') 	  = dmdAnal sigs arg_dmd arg
-	(arg_dmd, res_ty) = splitDmdTy fun_ty
-    in
-    (res_ty `bothType` arg_ty, App fun' arg')
-
-dmdAnal sigs dmd (Lam var body)
-  | isTyVar var
-  = let   
-	(body_ty, body') = dmdAnal sigs dmd body
-    in
-    (body_ty, Lam var body')
-
-  | Call body_dmd <- dmd	-- A call demand: good!
-  = let	
-	sigs'		 = extendSigsWithLam sigs var
-	(body_ty, body') = dmdAnal sigs' body_dmd body
-	(lam_ty, var')   = annotateLamIdBndr body_ty var
-    in
-    (lam_ty, Lam var' body')
-
-  | otherwise	-- Not enough demand on the lambda; but do the body
-  = let		-- anyway to annotate it and gather free var info
-	(body_ty, body') = dmdAnal sigs evalDmd body
-	(lam_ty, var')   = annotateLamIdBndr body_ty var
-    in
-    (deferType lam_ty, Lam var' body')
-
-dmdAnal sigs dmd (Case scrut case_bndr ty [alt@(DataAlt dc,bndrs,rhs)])
-  | let tycon = dataConTyCon dc,
-    isProductTyCon tycon,
-    not (isRecursiveTyCon tycon)
-  = let
-	sigs_alt	      = extendSigEnv NotTopLevel sigs case_bndr case_bndr_sig
-	(alt_ty, alt')	      = dmdAnalAlt sigs_alt dmd alt
-	(alt_ty1, case_bndr') = annotateBndr alt_ty case_bndr
-	(_, bndrs', _)	      = alt'
-	case_bndr_sig	      = cprSig
-		-- Inside the alternative, the case binder has the CPR property.
-		-- Meaning that a case on it will successfully cancel.
-		-- Example:
-		--	f True  x = case x of y { I# x' -> if x' ==# 3 then y else I# 8 }
-		--	f False x = I# 3
-		--	
-		-- We want f to have the CPR property:
-		--	f b x = case fw b x of { r -> I# r }
-		--	fw True  x = case x of y { I# x' -> if x' ==# 3 then x' else 8 }
-		--	fw False x = 3
-
-	-- Figure out whether the demand on the case binder is used, and use
-	-- that to set the scrut_dmd.  This is utterly essential.
-	-- Consider	f x = case x of y { (a,b) -> k y a }
-	-- If we just take scrut_demand = U(L,A), then we won't pass x to the
-	-- worker, so the worker will rebuild 
-	--	x = (a, absent-error)
-	-- and that'll crash.
-	-- So at one stage I had:
-	--	dead_case_bndr		 = isAbsentDmd (idNewDemandInfo case_bndr')
-	--	keepity | dead_case_bndr = Drop
-	--		| otherwise	 = Keep		
-	--
-	-- But then consider
-	--	case x of y { (a,b) -> h y + a }
-	-- where h : U(LL) -> T
-	-- The above code would compute a Keep for x, since y is not Abs, which is silly
-	-- The insight is, of course, that a demand on y is a demand on the
-	-- scrutinee, so we need to `both` it with the scrut demand
-
-        scrut_dmd 	   = Eval (Prod [idNewDemandInfo b | b <- bndrs', isId b])
-				   `both`
-			     idNewDemandInfo case_bndr'
-
-	(scrut_ty, scrut') = dmdAnal sigs scrut_dmd scrut
-    in
-    (alt_ty1 `bothType` scrut_ty, Case scrut' case_bndr' ty [alt'])
-
-dmdAnal sigs dmd (Case scrut case_bndr ty alts)
-  = let
-	(alt_tys, alts')        = mapAndUnzip (dmdAnalAlt sigs dmd) alts
-	(scrut_ty, scrut')      = dmdAnal sigs evalDmd scrut
-	(alt_ty, case_bndr')	= annotateBndr (foldr1 lubType alt_tys) case_bndr
-    in
---    pprTrace "dmdAnal:Case" (ppr alts $$ ppr alt_tys)
-    (alt_ty `bothType` scrut_ty, Case scrut' case_bndr' ty alts')
-
-dmdAnal sigs dmd (Let (NonRec id rhs) body) 
-  = let
-	(sigs', lazy_fv, (id1, rhs')) = dmdAnalRhs NotTopLevel NonRecursive sigs (id, rhs)
-	(body_ty, body') 	      = dmdAnal sigs' dmd body
-	(body_ty1, id2)    	      = annotateBndr body_ty id1
-	body_ty2		      = addLazyFVs body_ty1 lazy_fv
-    in
-	-- If the actual demand is better than the vanilla call
-	-- demand, you might think that we might do better to re-analyse 
-	-- the RHS with the stronger demand.
-	-- But (a) That seldom happens, because it means that *every* path in 
-	-- 	   the body of the let has to use that stronger demand
-	-- (b) It often happens temporarily in when fixpointing, because
-	--     the recursive function at first seems to place a massive demand.
-	--     But we don't want to go to extra work when the function will
-	--     probably iterate to something less demanding.  
-	-- In practice, all the times the actual demand on id2 is more than
-	-- the vanilla call demand seem to be due to (b).  So we don't
-	-- bother to re-analyse the RHS.
-    (body_ty2, Let (NonRec id2 rhs') body')    
-
-dmdAnal sigs dmd (Let (Rec pairs) body) 
-  = let
-	bndrs			 = map fst pairs
-	(sigs', lazy_fv, pairs') = dmdFix NotTopLevel sigs pairs
-	(body_ty, body')         = dmdAnal sigs' dmd body
-	body_ty1		 = addLazyFVs body_ty lazy_fv
-    in
-    sigs' `seq` body_ty `seq`
-    let
-	(body_ty2, _) = annotateBndrs body_ty1 bndrs
-		-- Don't bother to add demand info to recursive
-		-- binders as annotateBndr does; 
-		-- being recursive, we can't treat them strictly.
-		-- But we do need to remove the binders from the result demand env
-    in
-    (body_ty2,  Let (Rec pairs') body')
-
-
-dmdAnalAlt sigs dmd (con,bndrs,rhs) 
-  = let 
-	(rhs_ty, rhs')   = dmdAnal sigs dmd rhs
-	(alt_ty, bndrs') = annotateBndrs rhs_ty bndrs
-	final_alt_ty | io_hack_reqd = alt_ty `lubType` topDmdType
-		     | otherwise    = alt_ty
-
-	-- There's a hack here for I/O operations.  Consider
-	-- 	case foo x s of { (# s, r #) -> y }
-	-- Is this strict in 'y'.  Normally yes, but what if 'foo' is an I/O
-	-- operation that simply terminates the program (not in an erroneous way)?
-	-- In that case we should not evaluate y before the call to 'foo'.
-	-- Hackish solution: spot the IO-like situation and add a virtual branch,
-	-- as if we had
-	-- 	case foo x s of 
-	--	   (# s, r #) -> y 
-	--	   other      -> return ()
-	-- So the 'y' isn't necessarily going to be evaluated
-	--
-	-- A more complete example where this shows up is:
-	--	do { let len = <expensive> ;
-	--	   ; when (...) (exitWith ExitSuccess)
-	--	   ; print len }
-
-	io_hack_reqd = con == DataAlt unboxedPairDataCon &&
-		       idType (head bndrs) `coreEqType` realWorldStatePrimTy
-    in	
-    (final_alt_ty, (con, bndrs', rhs'))
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Bindings}
-%*									*
-%************************************************************************
-
-\begin{code}
-dmdFix :: TopLevelFlag
-       -> SigEnv 		-- Does not include bindings for this binding
-       -> [(Id,CoreExpr)]
-       -> (SigEnv, DmdEnv,
-	   [(Id,CoreExpr)])	-- Binders annotated with stricness info
-
-dmdFix top_lvl sigs orig_pairs
-  = loop 1 initial_sigs orig_pairs
-  where
-    bndrs        = map fst orig_pairs
-    initial_sigs = extendSigEnvList sigs [(id, (initialSig id, top_lvl)) | id <- bndrs]
-    
-    loop :: Int
-	 -> SigEnv			-- Already contains the current sigs
-	 -> [(Id,CoreExpr)] 		
-	 -> (SigEnv, DmdEnv, [(Id,CoreExpr)])
-    loop n sigs pairs
-      | found_fixpoint
-      = (sigs', lazy_fv, pairs')
-		-- Note: use pairs', not pairs.   pairs' is the result of 
-		-- processing the RHSs with sigs (= sigs'), whereas pairs 
-		-- is the result of processing the RHSs with the *previous* 
-		-- iteration of sigs.
-
-      | n >= 10  = pprTrace "dmdFix loop" (ppr n <+> (vcat 
-				[ text "Sigs:" <+> ppr [(id,lookup sigs id, lookup sigs' id) | (id,_) <- pairs],
-				  text "env:" <+> ppr (ufmToList sigs),
-				  text "binds:" <+> pprCoreBinding (Rec pairs)]))
-			      (emptySigEnv, lazy_fv, orig_pairs)	-- Safe output
-			-- The lazy_fv part is really important!  orig_pairs has no strictness
-			-- info, including nothing about free vars.  But if we have
-			--	letrec f = ....y..... in ...f...
-			-- where 'y' is free in f, we must record that y is mentioned, 
-			-- otherwise y will get recorded as absent altogether
-
-      | otherwise    = loop (n+1) sigs' pairs'
-      where
-	found_fixpoint = all (same_sig sigs sigs') bndrs 
-		-- Use the new signature to do the next pair
-		-- The occurrence analyser has arranged them in a good order
-		-- so this can significantly reduce the number of iterations needed
-	((sigs',lazy_fv), pairs') = mapAccumL (my_downRhs top_lvl) (sigs, emptyDmdEnv) pairs
-	
-    my_downRhs top_lvl (sigs,lazy_fv) (id,rhs)
-	= -- pprTrace "downRhs {" (ppr id <+> (ppr old_sig))
-	  -- (new_sig `seq` 
-	  --    pprTrace "downRhsEnd" (ppr id <+> ppr new_sig <+> char '}' ) 
-	  ((sigs', lazy_fv'), pair')
-	  --	 )
- 	where
-	  (sigs', lazy_fv1, pair') = dmdAnalRhs top_lvl Recursive sigs (id,rhs)
-	  lazy_fv'		   = plusUFM_C both lazy_fv lazy_fv1   
-	  -- old_sig   		   = lookup sigs id
-	  -- new_sig  	   	   = lookup sigs' id
-	   
-    same_sig sigs sigs' var = lookup sigs var == lookup sigs' var
-    lookup sigs var = case lookupVarEnv sigs var of
-			Just (sig,_) -> sig
-
-	-- Get an initial strictness signature from the Id
-	-- itself.  That way we make use of earlier iterations
-	-- of the fixpoint algorithm.  (Cunning plan.)
-	-- Note that the cunning plan extends to the DmdEnv too,
-	-- since it is part of the strictness signature
-initialSig id = idNewStrictness_maybe id `orElse` botSig
-
-dmdAnalRhs :: TopLevelFlag -> RecFlag
-	-> SigEnv -> (Id, CoreExpr)
-	-> (SigEnv,  DmdEnv, (Id, CoreExpr))
--- Process the RHS of the binding, add the strictness signature
--- to the Id, and augment the environment with the signature as well.
-
-dmdAnalRhs top_lvl rec_flag sigs (id, rhs)
- = (sigs', lazy_fv, (id', rhs'))
- where
-  arity		     = idArity id   -- The idArity should be up to date
-				    -- The simplifier was run just beforehand
-  (rhs_dmd_ty, rhs') = dmdAnal sigs (vanillaCall arity) rhs
-  (lazy_fv, sig_ty)  = WARN( arity /= dmdTypeDepth rhs_dmd_ty && not (exprIsTrivial rhs), ppr id )
-				-- The RHS can be eta-reduced to just a variable, 
-				-- in which case we should not complain. 
-		       mkSigTy top_lvl rec_flag id rhs rhs_dmd_ty
-  id'		     = id `setIdNewStrictness` sig_ty
-  sigs'		     = extendSigEnv top_lvl sigs id sig_ty
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Strictness signatures and types}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkTopSigTy :: CoreExpr -> DmdType -> StrictSig
-	-- Take a DmdType and turn it into a StrictSig
-	-- NB: not used for never-inline things; hence False
-mkTopSigTy rhs dmd_ty = snd (mk_sig_ty False False rhs dmd_ty)
-
-mkSigTy :: TopLevelFlag -> RecFlag -> Id -> CoreExpr -> DmdType -> (DmdEnv, StrictSig)
-mkSigTy top_lvl rec_flag id rhs dmd_ty 
-  = mk_sig_ty never_inline thunk_cpr_ok rhs dmd_ty
-  where
-    never_inline = isNeverActive (idInlinePragma id)
-    maybe_id_dmd = idNewDemandInfo_maybe id
-	-- Is Nothing the first time round
-
-    thunk_cpr_ok
-	| isTopLevel top_lvl       = False	-- Top level things don't get
-						-- their demandInfo set at all
-	| isRec rec_flag	   = False	-- Ditto recursive things
-	| Just dmd <- maybe_id_dmd = isStrictDmd dmd
-	| otherwise 		   = True	-- Optimistic, first time round
-						-- See notes below
-\end{code}
-
-The thunk_cpr_ok stuff [CPR-AND-STRICTNESS]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-If the rhs is a thunk, we usually forget the CPR info, because
-it is presumably shared (else it would have been inlined, and 
-so we'd lose sharing if w/w'd it into a function.
-
-However, if the strictness analyser has figured out (in a previous 
-iteration) that it's strict, then we DON'T need to forget the CPR info.
-Instead we can retain the CPR info and do the thunk-splitting transform 
-(see WorkWrap.splitThunk).
-
-This made a big difference to PrelBase.modInt, which had something like
-	modInt = \ x -> let r = ... -> I# v in
-			...body strict in r...
-r's RHS isn't a value yet; but modInt returns r in various branches, so
-if r doesn't have the CPR property then neither does modInt
-Another case I found in practice (in Complex.magnitude), looks like this:
-		let k = if ... then I# a else I# b
-		in ... body strict in k ....
-(For this example, it doesn't matter whether k is returned as part of
-the overall result; but it does matter that k's RHS has the CPR property.)  
-Left to itself, the simplifier will make a join point thus:
-		let $j k = ...body strict in k...
-		if ... then $j (I# a) else $j (I# b)
-With thunk-splitting, we get instead
-		let $j x = let k = I#x in ...body strict in k...
-		in if ... then $j a else $j b
-This is much better; there's a good chance the I# won't get allocated.
-
-The difficulty with this is that we need the strictness type to
-look at the body... but we now need the body to calculate the demand
-on the variable, so we can decide whether its strictness type should
-have a CPR in it or not.  Simple solution: 
-	a) use strictness info from the previous iteration
-	b) make sure we do at least 2 iterations, by doing a second
-	   round for top-level non-recs.  Top level recs will get at
-	   least 2 iterations except for totally-bottom functions
-	   which aren't very interesting anyway.
-
-NB: strictly_demanded is never true of a top-level Id, or of a recursive Id.
-
-The Nothing case in thunk_cpr_ok [CPR-AND-STRICTNESS]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Demand info now has a 'Nothing' state, just like strictness info.
-The analysis works from 'dangerous' towards a 'safe' state; so we 
-start with botSig for 'Nothing' strictness infos, and we start with
-"yes, it's demanded" for 'Nothing' in the demand info.  The
-fixpoint iteration will sort it all out.
-
-We can't start with 'not-demanded' because then consider
-	f x = let 
-		  t = ... I# x
-	      in
-	      if ... then t else I# y else f x'
-
-In the first iteration we'd have no demand info for x, so assume
-not-demanded; then we'd get TopRes for f's CPR info.  Next iteration
-we'd see that t was demanded, and so give it the CPR property, but by
-now f has TopRes, so it will stay TopRes.  Instead, with the Nothing
-setting the first time round, we say 'yes t is demanded' the first
-time.
-
-However, this does mean that for non-recursive bindings we must
-iterate twice to be sure of not getting over-optimistic CPR info,
-in the case where t turns out to be not-demanded.  This is handled
-by dmdAnalTopBind.
-
-
-\begin{code}
-mk_sig_ty never_inline thunk_cpr_ok rhs (DmdType fv dmds res) 
-  | never_inline && not (isBotRes res)
-	-- 			HACK ALERT
-	-- Don't strictness-analyse NOINLINE things.  Why not?  Because
-	-- the NOINLINE says "don't expose any of the inner workings at the call 
-	-- site" and the strictness is certainly an inner working.
-	--
-	-- More concretely, the demand analyser discovers the following strictness
-	-- for unsafePerformIO:  C(U(AV))
-	-- But then consider
-	--	unsafePerformIO (\s -> let r = f x in 
-	--			       case writeIORef v r s of (# s1, _ #) ->
-	--			       (# s1, r #)
-	-- The strictness analyser will find that the binding for r is strict,
-	-- (becuase of uPIO's strictness sig), and so it'll evaluate it before 
-	-- doing the writeIORef.  This actually makes tests/lib/should_run/memo002
-	-- get a deadlock!  
-	--
-	-- Solution: don't expose the strictness of unsafePerformIO.
-	--
-	-- But we do want to expose the strictness of error functions, 
-	-- which are also often marked NOINLINE
-	--	{-# NOINLINE foo #-}
-	--	foo x = error ("wubble buggle" ++ x)
-	-- So (hack, hack) we only drop the strictness for non-bottom things
-	-- This is all very unsatisfactory.
-  = (deferEnv fv, topSig)
-
-  | otherwise
-  = (lazy_fv, mkStrictSig dmd_ty)
-  where
-    dmd_ty = DmdType strict_fv final_dmds res'
-
-    lazy_fv   = filterUFM (not . isStrictDmd) fv
-    strict_fv = filterUFM isStrictDmd         fv
-	-- We put the strict FVs in the DmdType of the Id, so 
-	-- that at its call sites we unleash demands on its strict fvs.
-	-- An example is 'roll' in imaginary/wheel-sieve2
-	-- Something like this:
-	--	roll x = letrec 
-	--		     go y = if ... then roll (x-1) else x+1
-	--		 in 
-	--		 go ms
-	-- We want to see that roll is strict in x, which is because
-	-- go is called.   So we put the DmdEnv for x in go's DmdType.
-	--
-	-- Another example:
-	--	f :: Int -> Int -> Int
-	--	f x y = let t = x+1
-	--	    h z = if z==0 then t else 
-	--		  if z==1 then x+1 else
-	--		  x + h (z-1)
-	--	in
-	--	h y
-	-- Calling h does indeed evaluate x, but we can only see
-	-- that if we unleash a demand on x at the call site for t.
-	--
-	-- Incidentally, here's a place where lambda-lifting h would
-	-- lose the cigar --- we couldn't see the joint strictness in t/x
-	--
-	--	ON THE OTHER HAND
-	-- We don't want to put *all* the fv's from the RHS into the
-	-- DmdType, because that makes fixpointing very slow --- the 
-	-- DmdType gets full of lazy demands that are slow to converge.
-
-    final_dmds = setUnpackStrategy dmds
-	-- Set the unpacking strategy
-	
-    res' = case res of
-		RetCPR | ignore_cpr_info -> TopRes
-		other	 		 -> res
-    ignore_cpr_info = not (exprIsHNF rhs || thunk_cpr_ok)
-\end{code}
-
-The unpack strategy determines whether we'll *really* unpack the argument,
-or whether we'll just remember its strictness.  If unpacking would give
-rise to a *lot* of worker args, we may decide not to unpack after all.
-
-\begin{code}
-setUnpackStrategy :: [Demand] -> [Demand]
-setUnpackStrategy ds
-  = snd (go (opt_MaxWorkerArgs - nonAbsentArgs ds) ds)
-  where
-    go :: Int 			-- Max number of args available for sub-components of [Demand]
-       -> [Demand]
-       -> (Int, [Demand])	-- Args remaining after subcomponents of [Demand] are unpacked
-
-    go n (Eval (Prod cs) : ds) 
-	| n' >= 0   = Eval (Prod cs') `cons` go n'' ds
-        | otherwise = Box (Eval (Prod cs)) `cons` go n ds
-	where
-	  (n'',cs') = go n' cs
-	  n' = n + 1 - non_abs_args
-		-- Add one to the budget 'cos we drop the top-level arg
-	  non_abs_args = nonAbsentArgs cs
-		-- Delete # of non-absent args to which we'll now be committed
-				
-    go n (d:ds) = d `cons` go n ds
-    go n []     = (n,[])
-
-    cons d (n,ds) = (n, d:ds)
-
-nonAbsentArgs :: [Demand] -> Int
-nonAbsentArgs []	 = 0
-nonAbsentArgs (Abs : ds) = nonAbsentArgs ds
-nonAbsentArgs (d   : ds) = 1 + nonAbsentArgs ds
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Strictness signatures and types}
-%*									*
-%************************************************************************
-
-\begin{code}
-splitDmdTy :: DmdType -> (Demand, DmdType)
--- Split off one function argument
--- We already have a suitable demand on all
--- free vars, so no need to add more!
-splitDmdTy (DmdType fv (dmd:dmds) res_ty) = (dmd, DmdType fv dmds res_ty)
-splitDmdTy ty@(DmdType fv [] res_ty)      = (resTypeArgDmd res_ty, ty)
-\end{code}
-
-\begin{code}
-unitVarDmd var dmd = DmdType (unitVarEnv var dmd) [] TopRes
-
-addVarDmd top_lvl dmd_ty@(DmdType fv ds res) var dmd
-  | isTopLevel top_lvl = dmd_ty		-- Don't record top level things
-  | otherwise	       = DmdType (extendVarEnv fv var dmd) ds res
-
-addLazyFVs (DmdType fv ds res) lazy_fvs
-  = DmdType both_fv1 ds res
-  where
-    both_fv = (plusUFM_C both fv lazy_fvs)
-    both_fv1 = modifyEnv (isBotRes res) (`both` Bot) lazy_fvs fv both_fv
-	-- This modifyEnv is vital.  Consider
-	--	let f = \x -> (x,y)
-	--	in  error (f 3)
-	-- Here, y is treated as a lazy-fv of f, but we must `both` that L
-	-- demand with the bottom coming up from 'error'
-	-- 
-	-- I got a loop in the fixpointer without this, due to an interaction
-	-- with the lazy_fv filtering in mkSigTy.  Roughly, it was
-	--	letrec f n x 
-	--	    = letrec g y = x `fatbar` 
-	--			   letrec h z = z + ...g...
-	--			   in h (f (n-1) x)
-	-- 	in ...
-	-- In the initial iteration for f, f=Bot
-	-- Suppose h is found to be strict in z, but the occurrence of g in its RHS
-	-- is lazy.  Now consider the fixpoint iteration for g, esp the demands it
-	-- places on its free variables.  Suppose it places none.  Then the
-	-- 	x `fatbar` ...call to h...
-	-- will give a x->V demand for x.  That turns into a L demand for x,
-	-- which floats out of the defn for h.  Without the modifyEnv, that
-	-- L demand doesn't get both'd with the Bot coming up from the inner
-	-- call to f.  So we just get an L demand for x for g.
-	--
-	-- A better way to say this is that the lazy-fv filtering should give the
-	-- same answer as putting the lazy fv demands in the function's type.
-
-annotateBndr :: DmdType -> Var -> (DmdType, Var)
--- The returned env has the var deleted
--- The returned var is annotated with demand info
--- No effect on the argument demands
-annotateBndr dmd_ty@(DmdType fv ds res) var
-  | isTyVar var = (dmd_ty, var)
-  | otherwise   = (DmdType fv' ds res, setIdNewDemandInfo var dmd)
-  where
-    (fv', dmd) = removeFV fv var res
-
-annotateBndrs = mapAccumR annotateBndr
-
-annotateLamIdBndr dmd_ty@(DmdType fv ds res) id
--- For lambdas we add the demand to the argument demands
--- Only called for Ids
-  = ASSERT( isId id )
-    (DmdType fv' (hacked_dmd:ds) res, setIdNewDemandInfo id hacked_dmd)
-  where
-    (fv', dmd) = removeFV fv id res
-    hacked_dmd = argDemand dmd
-	-- This call to argDemand is vital, because otherwise we label
-	-- a lambda binder with demand 'B'.  But in terms of calling
-	-- conventions that's Abs, because we don't pass it.  But
-	-- when we do a w/w split we get
-	--	fw x = (\x y:B -> ...) x (error "oops")
-	-- And then the simplifier things the 'B' is a strict demand
-	-- and evaluates the (error "oops").  Sigh
-
-removeFV fv id res = (fv', zapUnlifted id dmd)
-		where
-		  fv' = fv `delVarEnv` id
-		  dmd = lookupVarEnv fv id `orElse` deflt
-	 	  deflt | isBotRes res = Bot
-		        | otherwise    = Abs
-
--- For unlifted-type variables, we are only 
--- interested in Bot/Abs/Box Abs
-zapUnlifted is Bot = Bot
-zapUnlifted id Abs = Abs
-zapUnlifted id dmd | isUnLiftedType (idType id) = lazyDmd
-		   | otherwise			= dmd
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Strictness signatures}
-%*									*
-%************************************************************************
-
-\begin{code}
-type SigEnv  = VarEnv (StrictSig, TopLevelFlag)
-	-- We use the SigEnv to tell us whether to
-	-- record info about a variable in the DmdEnv
-	-- We do so if it's a LocalId, but not top-level
-	--
-	-- The DmdEnv gives the demand on the free vars of the function
-	-- when it is given enough args to satisfy the strictness signature
-
-emptySigEnv  = emptyVarEnv
-
-extendSigEnv :: TopLevelFlag -> SigEnv -> Id -> StrictSig -> SigEnv
-extendSigEnv top_lvl env var sig = extendVarEnv env var (sig, top_lvl)
-
-extendSigEnvList = extendVarEnvList
-
-extendSigsWithLam :: SigEnv -> Id -> SigEnv
--- Extend the SigEnv when we meet a lambda binder
--- If the binder is marked demanded with a product demand, then give it a CPR 
--- signature, because in the likely event that this is a lambda on a fn defn 
--- [we only use this when the lambda is being consumed with a call demand],
--- it'll be w/w'd and so it will be CPR-ish.  E.g.
---	f = \x::(Int,Int).  if ...strict in x... then
---				x
---			    else
---				(a,b)
--- We want f to have the CPR property because x does, by the time f has been w/w'd
---
--- Also note that we only want to do this for something that
--- definitely has product type, else we may get over-optimistic 
--- CPR results (e.g. from \x -> x!).
-
-extendSigsWithLam sigs id
-  = case idNewDemandInfo_maybe id of
-	Nothing	              -> extendVarEnv sigs id (cprSig, NotTopLevel)
-		-- Optimistic in the Nothing case;
-		-- See notes [CPR-AND-STRICTNESS]
-	Just (Eval (Prod ds)) -> extendVarEnv sigs id (cprSig, NotTopLevel)
-	other                 -> sigs
-
-
-dmdTransform :: SigEnv		-- The strictness environment
-	     -> Id		-- The function
-	     -> Demand		-- The demand on the function
-	     -> DmdType		-- The demand type of the function in this context
-	-- Returned DmdEnv includes the demand on 
-	-- this function plus demand on its free variables
-
-dmdTransform sigs var dmd
-
------- 	DATA CONSTRUCTOR
-  | isDataConWorkId var		-- Data constructor
-  = let 
-	StrictSig dmd_ty    = idNewStrictness var	-- It must have a strictness sig
-	DmdType _ _ con_res = dmd_ty
-	arity		    = idArity var
-    in
-    if arity == call_depth then		-- Saturated, so unleash the demand
-	let 
-		-- Important!  If we Keep the constructor application, then
-		-- we need the demands the constructor places (always lazy)
-		-- If not, we don't need to.  For example:
-		--	f p@(x,y) = (p,y)	-- S(AL)
-		--	g a b     = f (a,b)
-		-- It's vital that we don't calculate Absent for a!
-	   dmd_ds = case res_dmd of
-			Box (Eval ds) -> mapDmds box ds
-			Eval ds	      -> ds
-			other	      -> Poly Top
-
-		-- ds can be empty, when we are just seq'ing the thing
-		-- If so we must make up a suitable bunch of demands
-	   arg_ds = case dmd_ds of
-		      Poly d  -> replicate arity d
-		      Prod ds -> ASSERT( ds `lengthIs` arity ) ds
-
-	in
-	mkDmdType emptyDmdEnv arg_ds con_res
-		-- Must remember whether it's a product, hence con_res, not TopRes
-    else
-	topDmdType
-
------- 	IMPORTED FUNCTION
-  | isGlobalId var,		-- Imported function
-    let StrictSig dmd_ty = idNewStrictness var
-  = if dmdTypeDepth dmd_ty <= call_depth then	-- Saturated, so unleash the demand
-	dmd_ty
-    else
-	topDmdType
-
------- 	LOCAL LET/REC BOUND THING
-  | Just (StrictSig dmd_ty, top_lvl) <- lookupVarEnv sigs var
-  = let
-	fn_ty | dmdTypeDepth dmd_ty <= call_depth = dmd_ty 
-	      | otherwise   		          = deferType dmd_ty
-	-- NB: it's important to use deferType, and not just return topDmdType
-	-- Consider	let { f x y = p + x } in f 1
-	-- The application isn't saturated, but we must nevertheless propagate 
-	--	a lazy demand for p!  
-    in
-    addVarDmd top_lvl fn_ty var dmd
-
------- 	LOCAL NON-LET/REC BOUND THING
-  | otherwise	 		-- Default case
-  = unitVarDmd var dmd
-
-  where
-    (call_depth, res_dmd) = splitCallDmd dmd
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Demands}
-%*									*
-%************************************************************************
-
-\begin{code}
-splitCallDmd :: Demand -> (Int, Demand)
-splitCallDmd (Call d) = case splitCallDmd d of
-			  (n, r) -> (n+1, r)
-splitCallDmd d	      = (0, d)
-
-vanillaCall :: Arity -> Demand
-vanillaCall 0 = evalDmd
-vanillaCall n = Call (vanillaCall (n-1))
-
-deferType :: DmdType -> DmdType
-deferType (DmdType fv _ _) = DmdType (deferEnv fv) [] TopRes
-	-- Notice that we throw away info about both arguments and results
-	-- For example,   f = let ... in \x -> x
-	-- We don't want to get a stricness type V->T for f.
-	-- Peter??
-
-deferEnv :: DmdEnv -> DmdEnv
-deferEnv fv = mapVarEnv defer fv
-
-
-----------------
-argDemand :: Demand -> Demand
--- The 'Defer' demands are just Lazy at function boundaries
--- Ugly!  Ask John how to improve it.
-argDemand Top 	    = lazyDmd
-argDemand (Defer d) = lazyDmd
-argDemand (Eval ds) = Eval (mapDmds argDemand ds)
-argDemand (Box Bot) = evalDmd
-argDemand (Box d)   = box (argDemand d)
-argDemand Bot	    = Abs	-- Don't pass args that are consumed (only) by bottom
-argDemand d	    = d
-\end{code}
-
-\begin{code}
--------------------------
--- Consider (if x then y else []) with demand V
--- Then the first branch gives {y->V} and the second
---  *implicitly* has {y->A}.  So we must put {y->(V `lub` A)}
--- in the result env.
-lubType (DmdType fv1 ds1 r1) (DmdType fv2 ds2 r2)
-  = DmdType lub_fv2 (lub_ds ds1 ds2) (r1 `lubRes` r2)
-  where
-    lub_fv  = plusUFM_C lub fv1 fv2
-    lub_fv1 = modifyEnv (not (isBotRes r1)) absLub fv2 fv1 lub_fv
-    lub_fv2 = modifyEnv (not (isBotRes r2)) absLub fv1 fv2 lub_fv1
-	-- lub is the identity for Bot
-
-	-- Extend the shorter argument list to match the longer
-    lub_ds (d1:ds1) (d2:ds2) = lub d1 d2 : lub_ds ds1 ds2
-    lub_ds []	    []	     = []
-    lub_ds ds1	    []	     = map (`lub` resTypeArgDmd r2) ds1
-    lub_ds []	    ds2	     = map (resTypeArgDmd r1 `lub`) ds2
-
------------------------------------
--- (t1 `bothType` t2) takes the argument/result info from t1,
--- using t2 just for its free-var info
--- NB: Don't forget about r2!  It might be BotRes, which is
---     a bottom demand on all the in-scope variables.
--- Peter: can this be done more neatly?
-bothType (DmdType fv1 ds1 r1) (DmdType fv2 ds2 r2)
-  = DmdType both_fv2 ds1 (r1 `bothRes` r2)
-  where
-    both_fv  = plusUFM_C both fv1 fv2
-    both_fv1 = modifyEnv (isBotRes r1) (`both` Bot) fv2 fv1 both_fv
-    both_fv2 = modifyEnv (isBotRes r2) (`both` Bot) fv1 fv2 both_fv1
-	-- both is the identity for Abs
-\end{code}
-
-
-\begin{code}
-lubRes BotRes r      = r
-lubRes r      BotRes = r
-lubRes RetCPR RetCPR = RetCPR
-lubRes r1     r2     = TopRes
-
--- If either diverges, the whole thing does
--- Otherwise take CPR info from the first
-bothRes r1 BotRes = BotRes
-bothRes r1 r2     = r1
-\end{code}
-
-\begin{code}
-modifyEnv :: Bool			-- No-op if False
-	  -> (Demand -> Demand)		-- The zapper
-	  -> DmdEnv -> DmdEnv		-- Env1 and Env2
-	  -> DmdEnv -> DmdEnv		-- Transform this env
-	-- Zap anything in Env1 but not in Env2
-	-- Assume: dom(env) includes dom(Env1) and dom(Env2)
-
-modifyEnv need_to_modify zapper env1 env2 env
-  | need_to_modify = foldr zap env (keysUFM (env1 `minusUFM` env2))
-  | otherwise	   = env
-  where
-    zap uniq env = addToUFM_Directly env uniq (zapper current_val)
-		 where
-		   current_val = expectJust "modifyEnv" (lookupUFM_Directly env uniq)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{LUB and BOTH}
-%*									*
-%************************************************************************
-
-\begin{code}
-lub :: Demand -> Demand -> Demand
-
-lub Bot  	d2 = d2
-lub Abs  	d2 = absLub d2
-lub Top 	d2 = Top
-lub (Defer ds1) d2 = defer (Eval ds1 `lub` d2)
-
-lub (Call d1)   (Call d2)    = Call (d1 `lub` d2)
-lub d1@(Call _) (Box d2)     = d1 `lub` d2	-- Just strip the box
-lub d1@(Call _) d2@(Eval _)  = d2		-- Presumably seq or vanilla eval
-lub d1@(Call _) d2	     = d2 `lub` d1	-- Bot, Abs, Top
-
--- For the Eval case, we use these approximation rules
--- Box Bot	 <= Eval (Box Bot ...)
--- Box Top	 <= Defer (Box Bot ...)
--- Box (Eval ds) <= Eval (map Box ds)
-lub (Eval ds1)  (Eval ds2)  	  = Eval (ds1 `lubs` ds2)
-lub (Eval ds1)  (Box Bot)   	  = Eval (mapDmds (`lub` Box Bot) ds1)
-lub (Eval ds1)  (Box (Eval ds2)) = Eval (ds1 `lubs` mapDmds box ds2)
-lub (Eval ds1)  (Box Abs)        = deferEval (mapDmds (`lub` Box Bot) ds1)
-lub d1@(Eval _) d2	          = d2 `lub` d1	-- Bot,Abs,Top,Call,Defer
-
-lub (Box d1)   (Box d2) = box (d1 `lub` d2)
-lub d1@(Box _)  d2	= d2 `lub` d1
-
-lubs = zipWithDmds lub
-
----------------------
--- box is the smart constructor for Box
--- It computes <B,bot> & d
--- INVARIANT: (Box d) => d = Bot, Abs, Eval
--- Seems to be no point in allowing (Box (Call d))
-box (Call d)  = Call d	-- The odd man out.  Why?
-box (Box d)   = Box d
-box (Defer _) = lazyDmd
-box Top       = lazyDmd	-- Box Abs and Box Top
-box Abs       = lazyDmd	-- are the same <B,L>
-box d 	      = Box d	-- Bot, Eval
-
----------------
-defer :: Demand -> Demand
-
--- defer is the smart constructor for Defer
--- The idea is that (Defer ds) = <U(ds), L>
---
--- It specifies what happens at a lazy function argument
--- or a lambda; the L* operator
--- Set the strictness part to L, but leave
--- the boxity side unaffected
--- It also ensures that Defer (Eval [LLLL]) = L
-
-defer Bot	 = Abs
-defer Abs	 = Abs
-defer Top	 = Top
-defer (Call _)	 = lazyDmd	-- Approximation here?
-defer (Box _)	 = lazyDmd
-defer (Defer ds) = Defer ds
-defer (Eval ds)  = deferEval ds
-
--- deferEval ds = defer (Eval ds)
-deferEval ds | allTop ds = Top
-	     | otherwise  = Defer ds
-
----------------------
-absLub :: Demand -> Demand
--- Computes (Abs `lub` d)
--- For the Bot case consider
---	f x y = if ... then x else error x
---   Then for y we get Abs `lub` Bot, and we really
---   want Abs overall
-absLub Bot  	  = Abs
-absLub Abs  	  = Abs
-absLub Top 	  = Top
-absLub (Call _)   = Top
-absLub (Box _)    = Top
-absLub (Eval ds)  = Defer (absLubs ds)	-- Or (Defer ds)?
-absLub (Defer ds) = Defer (absLubs ds)	-- Or (Defer ds)?
-
-absLubs = mapDmds absLub
-
----------------
-both :: Demand -> Demand -> Demand
-
-both Abs d2 = d2
-
-both Bot Bot 	   = Bot
-both Bot Abs 	   = Bot 
-both Bot (Eval ds) = Eval (mapDmds (`both` Bot) ds)
-	-- Consider
-	--	f x = error x
-	-- From 'error' itself we get demand Bot on x
-	-- From the arg demand on x we get 
-	--	x :-> evalDmd = Box (Eval (Poly Abs))
-	-- So we get  Bot `both` Box (Eval (Poly Abs))
-	--	    = Seq Keep (Poly Bot)
-	--
-	-- Consider also
-	--	f x = if ... then error (fst x) else fst x
-	-- Then we get (Eval (Box Bot, Bot) `lub` Eval (SA))
-	--	= Eval (SA)
-	-- which is what we want.
-both Bot d = errDmd
-
-both Top Bot 	     = errDmd
-both Top Abs 	     = Top
-both Top Top 	     = Top
-both Top (Box d)    = Box d
-both Top (Call d)   = Call d
-both Top (Eval ds)  = Eval (mapDmds (`both` Top) ds)
-both Top (Defer ds) 	-- = defer (Top `both` Eval ds)
-			-- = defer (Eval (mapDmds (`both` Top) ds))
-		     = deferEval (mapDmds (`both` Top) ds)
-
-
-both (Box d1) 	(Box d2)    = box (d1 `both` d2)
-both (Box d1) 	d2@(Call _) = box (d1 `both` d2)
-both (Box d1) 	d2@(Eval _) = box (d1 `both` d2)
-both (Box d1) 	(Defer d2)  = Box d1
-both d1@(Box _) d2	    = d2 `both` d1
-
-both (Call d1) 	 (Call d2)   = Call (d1 `both` d2)
-both (Call d1) 	 (Eval ds2)  = Call d1	-- Could do better for (Poly Bot)?
-both (Call d1) 	 (Defer ds2) = Call d1	-- Ditto
-both d1@(Call _) d2	     = d1 `both` d1
-
-both (Eval ds1)    (Eval  ds2) = Eval (ds1 `boths` ds2)
-both (Eval ds1)    (Defer ds2) = Eval (ds1 `boths` mapDmds defer ds2)
-both d1@(Eval ds1) d2	       = d2 `both` d1
-
-both (Defer ds1) (Defer ds2) = deferEval (ds1 `boths` ds2)
-both d1@(Defer ds1) d2	     = d2 `both` d1
- 
-boths = zipWithDmds both
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Miscellaneous
-%*									*
-%************************************************************************
-
-
-\begin{code}
-#ifdef OLD_STRICTNESS
-get_changes binds = vcat (map get_changes_bind binds)
-
-get_changes_bind (Rec pairs) = vcat (map get_changes_pr pairs)
-get_changes_bind (NonRec id rhs) = get_changes_pr (id,rhs)
-
-get_changes_pr (id,rhs) 
-  = get_changes_var id $$ get_changes_expr rhs
-
-get_changes_var var
-  | isId var  = get_changes_str var $$ get_changes_dmd var
-  | otherwise = empty
-
-get_changes_expr (Type t)     = empty
-get_changes_expr (Var v)      = empty
-get_changes_expr (Lit l)      = empty
-get_changes_expr (Note n e)   = get_changes_expr e
-get_changes_expr (App e1 e2)  = get_changes_expr e1 $$ get_changes_expr e2
-get_changes_expr (Lam b e)    = {- get_changes_var b $$ -} get_changes_expr e
-get_changes_expr (Let b e)    = get_changes_bind b $$ get_changes_expr e
-get_changes_expr (Case e b a) = get_changes_expr e $$ {- get_changes_var b $$ -} vcat (map get_changes_alt a)
-
-get_changes_alt (con,bs,rhs) = {- vcat (map get_changes_var bs) $$ -} get_changes_expr rhs
-
-get_changes_str id
-  | new_better && old_better = empty
-  | new_better	       	     = message "BETTER"
-  | old_better	       	     = message "WORSE"
-  | otherwise	       	     = message "INCOMPARABLE" 
-  where
-    message word = text word <+> text "strictness for" <+> ppr id <+> info
-    info = (text "Old" <+> ppr old) $$ (text "New" <+> ppr new)
-    new = squashSig (idNewStrictness id)	-- Don't report spurious diffs that the old
-						-- strictness analyser can't track
-    old = newStrictnessFromOld (idName id) (idArity id) (idStrictness id) (idCprInfo id)
-    old_better = old `betterStrictness` new
-    new_better = new `betterStrictness` old
-
-get_changes_dmd id
-  | isUnLiftedType (idType id) = empty	-- Not useful
-  | new_better && old_better = empty
-  | new_better	       	     = message "BETTER"
-  | old_better	       	     = message "WORSE"
-  | otherwise	       	     = message "INCOMPARABLE" 
-  where
-    message word = text word <+> text "demand for" <+> ppr id <+> info
-    info = (text "Old" <+> ppr old) $$ (text "New" <+> ppr new)
-    new = squashDmd (argDemand (idNewDemandInfo id))	-- To avoid spurious improvements
-							-- A bit of a hack
-    old = newDemand (idDemandInfo id)
-    new_better = new `betterDemand` old 
-    old_better = old `betterDemand` new
-
-betterStrictness :: StrictSig -> StrictSig -> Bool
-betterStrictness (StrictSig t1) (StrictSig t2) = betterDmdType t1 t2
-
-betterDmdType t1 t2 = (t1 `lubType` t2) == t2
-
-betterDemand :: Demand -> Demand -> Bool
--- If d1 `better` d2, and d2 `better` d2, then d1==d2
-betterDemand d1 d2 = (d1 `lub` d2) == d2
-
-squashSig (StrictSig (DmdType fv ds res))
-  = StrictSig (DmdType emptyDmdEnv (map squashDmd ds) res)
-  where
-	-- squash just gets rid of call demands
-	-- which the old analyser doesn't track
-squashDmd (Call d)   = evalDmd
-squashDmd (Box d)    = Box (squashDmd d)
-squashDmd (Eval ds)  = Eval (mapDmds squashDmd ds)
-squashDmd (Defer ds) = Defer (mapDmds squashDmd ds)
-squashDmd d          = d
-#endif
-\end{code}
diff --git a/ghc/compiler/stranal/SaAbsInt.lhs b/ghc/compiler/stranal/SaAbsInt.lhs
deleted file mode 100644
index a6a79ec166..0000000000
--- a/ghc/compiler/stranal/SaAbsInt.lhs
+++ /dev/null
@@ -1,925 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[SaAbsInt]{Abstract interpreter for strictness analysis}
-
-\begin{code}
-#ifndef OLD_STRICTNESS
--- If OLD_STRICTNESS is off, omit all exports 
-module SaAbsInt () where
-
-#else
-module SaAbsInt (
-	findStrictness,
-	findDemand, findDemandAlts,
-	absEval,
-	widen,
-	fixpoint,
-	isBot
-    ) where
-
-#include "HsVersions.h"
-
-import StaticFlags	( opt_AllStrict, opt_NumbersStrict )
-import CoreSyn
-import CoreUnfold	( maybeUnfoldingTemplate )
-import Id		( Id, idType, idUnfolding, isDataConWorkId_maybe,
-			  idStrictness,
-			)
-import DataCon		( dataConTyCon, splitProductType_maybe, dataConRepArgTys )
-import IdInfo		( StrictnessInfo(..) )
-import Demand		( Demand(..), wwPrim, wwStrict, wwUnpack, wwLazy,
-			  mkStrictnessInfo, isLazy
-			)
-import SaLib
-import TyCon		( isProductTyCon, isRecursiveTyCon )
-import Type		( splitTyConApp_maybe, 
-		          isUnLiftedType, Type )
-import TyCon		( tyConUnique )
-import PrelInfo		( numericTyKeys )
-import Util		( isIn, nOfThem, zipWithEqual, equalLength )
-import Outputable	
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[AbsVal-ops]{Operations on @AbsVals@}
-%*									*
-%************************************************************************
-
-Least upper bound, greatest lower bound.
-
-\begin{code}
-lub, glb :: AbsVal -> AbsVal -> AbsVal
-
-lub AbsBot val2   = val2	
-lub val1   AbsBot = val1	
-
-lub (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual "lub" lub xs ys)
-
-lub _		  _	      = AbsTop	-- Crude, but conservative
-					-- The crudity only shows up if there
-					-- are functions involved
-
--- Slightly funny glb; for absence analysis only;
--- AbsBot is the safe answer.
---
--- Using anyBot rather than just testing for AbsBot is important.
--- Consider:
---
---   f = \a b -> ...
---
---   g = \x y z -> case x of
---	  	     []     -> f x
---		     (p:ps) -> f p
---
--- Now, the abstract value of the branches of the case will be an
--- AbsFun, but when testing for z's absence we want to spot that it's
--- an AbsFun which can't possibly return AbsBot.  So when glb'ing we
--- mustn't be too keen to bale out and return AbsBot; the anyBot test
--- spots that (f x) can't possibly return AbsBot.
-
--- We have also tripped over the following interesting case:
---	case x of
---	  []     -> \y -> 1
---        (p:ps) -> f
---
--- Now, suppose f is bound to AbsTop.  Does this expression mention z?
--- Obviously not.  But the case will take the glb of AbsTop (for f) and
--- an AbsFun (for \y->1). We should not bale out and give AbsBot, because
--- that would say that it *does* mention z (or anything else for that matter).
--- Nor can we always return AbsTop, because the AbsFun might be something
--- like (\y->z), which obviously does mention z. The point is that we're
--- glbing two functions, and AbsTop is not actually the top of the function
--- lattice.  It is more like (\xyz -> x|y|z); that is, AbsTop returns
--- poison iff any of its arguments do.
-
--- Deal with functions specially, because AbsTop isn't the
--- top of their domain.
-
-glb v1 v2
-  | is_fun v1 || is_fun v2
-  = if not (anyBot v1) && not (anyBot v2)
-    then
-	AbsTop
-    else
-	AbsBot
-  where
-    is_fun (AbsFun _ _)       = True
-    is_fun (AbsApproxFun _ _) = True	-- Not used, but the glb works ok
-    is_fun other              = False
-
--- The non-functional cases are quite straightforward
-
-glb (AbsProd xs) (AbsProd ys) = AbsProd (zipWithEqual "glb" glb xs ys)
-
-glb AbsTop	 v2	      = v2
-glb v1           AbsTop	      = v1
-
-glb _            _            = AbsBot 		-- Be pessimistic
-\end{code}
-
-@isBot@ returns True if its argument is (a representation of) bottom.  The
-``representation'' part is because we need to detect the bottom {\em function}
-too.  To detect the bottom function, bind its args to top, and see if it
-returns bottom.
-
-Used only in strictness analysis:
-\begin{code}
-isBot :: AbsVal -> Bool
-
-isBot AbsBot = True
-isBot other  = False	-- Functions aren't bottom any more
-\end{code}
-
-Used only in absence analysis:
-
-\begin{code}
-anyBot :: AbsVal -> Bool
-
-anyBot AbsBot 		       = True	-- poisoned!
-anyBot AbsTop 		       = False
-anyBot (AbsProd vals) 	       = any anyBot vals
-anyBot (AbsFun bndr_ty abs_fn) = anyBot (abs_fn AbsTop)
-anyBot (AbsApproxFun _ val)    = anyBot val
-\end{code}
-
-@widen@ takes an @AbsVal@, $val$, and returns and @AbsVal@ which is
-approximated by $val$.  Furthermore, the result has no @AbsFun@s in
-it, so it can be compared for equality by @sameVal@.
-
-\begin{code}
-widen :: AnalysisKind -> AbsVal -> AbsVal
-
--- Widening is complicated by the fact that funtions are lifted
-widen StrAnal the_fn@(AbsFun bndr_ty _)
-  = case widened_body of
-	AbsApproxFun ds val -> AbsApproxFun (d : ds) val
-			    where
-			       d = findRecDemand str_fn abs_fn bndr_ty
-			       str_fn val = isBot (foldl (absApply StrAnal) the_fn 
-						         (val : [AbsTop | d <- ds]))
-
-	other		    -> AbsApproxFun [d] widened_body
-			    where
-			       d = findRecDemand str_fn abs_fn bndr_ty
-			       str_fn val = isBot (absApply StrAnal the_fn val)
-  where
-    widened_body = widen StrAnal (absApply StrAnal the_fn AbsTop)
-    abs_fn val   = False	-- Always says poison; so it looks as if
-				-- nothing is absent; safe
-
-{-	OLD comment... 
-	This stuff is now instead handled neatly by the fact that AbsApproxFun 
-	contains an AbsVal inside it.	SLPJ Jan 97
-
-  | isBot abs_body = AbsBot
-    -- It's worth checking for a function which is unconditionally
-    -- bottom.  Consider
-    --
-    --	f x y = let g y = case x of ...
-    --		in (g ..) + (g ..)
-    --
-    -- Here, when we are considering strictness of f in x, we'll
-    -- evaluate the body of f with x bound to bottom.  The current
-    -- strategy is to bind g to its *widened* value; without the isBot
-    -- (...) test above, we'd bind g to an AbsApproxFun, and deliver
-    -- Top, not Bot as the value of f's rhs.  The test spots the
-    -- unconditional bottom-ness of g when x is bottom.  (Another
-    -- alternative here would be to bind g to its exact abstract
-    -- value, but that entails lots of potential re-computation, at
-    -- every application of g.)
--}
-
-widen StrAnal (AbsProd vals) = AbsProd (map (widen StrAnal) vals)
-widen StrAnal other_val	     = other_val
-
-
-widen AbsAnal the_fn@(AbsFun bndr_ty _)
-  | anyBot widened_body = AbsBot
-	-- In the absence-analysis case it's *essential* to check
-	-- that the function has no poison in its body.  If it does,
-	-- anywhere, then the whole function is poisonous.
-
-  | otherwise
-  = case widened_body of
-	AbsApproxFun ds val -> AbsApproxFun (d : ds) val
-			    where
-			       d = findRecDemand str_fn abs_fn bndr_ty
-			       abs_fn val = not (anyBot (foldl (absApply AbsAnal) the_fn 
-								(val : [AbsTop | d <- ds])))
-
-	other		    -> AbsApproxFun [d] widened_body
-			    where
-			       d = findRecDemand str_fn abs_fn bndr_ty
-			       abs_fn val = not (anyBot (absApply AbsAnal the_fn val))
-  where
-    widened_body = widen AbsAnal (absApply AbsAnal the_fn AbsTop)
-    str_fn val   = True		-- Always says non-termination;
-				-- that'll make findRecDemand peer into the
-				-- structure of the value.
-
-widen AbsAnal (AbsProd vals) = AbsProd (map (widen AbsAnal) vals)
-
-	-- It's desirable to do a good job of widening for product
-	-- values.  Consider
-	--
-	--	let p = (x,y)
-	--	in ...(case p of (x,y) -> x)...
-	--
-	-- Now, is y absent in this expression?  Currently the
-	-- analyser widens p before looking at p's scope, to avoid
-	-- lots of recomputation in the case where p is a function.
-	-- So if widening doesn't have a case for products, we'll
-	-- widen p to AbsBot (since when searching for absence in y we
-	-- bind y to poison ie AbsBot), and now we are lost.
-
-widen AbsAnal other_val = other_val
-
--- WAS:	  if anyBot val then AbsBot else AbsTop
--- Nowadays widen is doing a better job on functions for absence analysis.
-\end{code}
-
-@crudeAbsWiden@ is used just for absence analysis, and always
-returns AbsTop or AbsBot, so it widens to a two-point domain
-
-\begin{code}
-crudeAbsWiden :: AbsVal -> AbsVal
-crudeAbsWiden val = if anyBot val then AbsBot else AbsTop
-\end{code}
-
-@sameVal@ compares two abstract values for equality.  It can't deal with
-@AbsFun@, but that should have been removed earlier in the day by @widen@.
-
-\begin{code}
-sameVal :: AbsVal -> AbsVal -> Bool	-- Can't handle AbsFun!
-
-#ifdef DEBUG
-sameVal (AbsFun _ _) _ = panic "sameVal: AbsFun: arg1"
-sameVal _ (AbsFun _ _) = panic "sameVal: AbsFun: arg2"
-#endif
-
-sameVal AbsBot AbsBot = True
-sameVal AbsBot other  = False	-- widen has reduced AbsFun bots to AbsBot
-
-sameVal AbsTop AbsTop = True
-sameVal AbsTop other  = False		-- Right?
-
-sameVal (AbsProd vals1) (AbsProd vals2) = and (zipWithEqual "sameVal" sameVal vals1 vals2)
-sameVal (AbsProd _)	AbsTop 		= False
-sameVal (AbsProd _)	AbsBot 		= False
-
-sameVal (AbsApproxFun str1 v1) (AbsApproxFun str2 v2) = str1 == str2 && sameVal v1 v2
-sameVal (AbsApproxFun _ _)     AbsTop		      = False
-sameVal (AbsApproxFun _ _)     AbsBot 		      = False
-
-sameVal val1 val2 = panic "sameVal: type mismatch or AbsFun encountered"
-\end{code}
-
-
-@evalStrictness@ compares a @Demand@ with an abstract value, returning
-@True@ iff the abstract value is {\em less defined} than the demand.
-(@True@ is the exciting answer; @False@ is always safe.)
-
-\begin{code}
-evalStrictness :: Demand
-	       -> AbsVal
-	       -> Bool		-- True iff the value is sure
-				-- to be less defined than the Demand
-
-evalStrictness (WwLazy _) _   = False
-evalStrictness WwStrict   val = isBot val
-evalStrictness WwEnum	  val = isBot val
-
-evalStrictness (WwUnpack _ demand_info) val
-  = case val of
-      AbsTop	   -> False
-      AbsBot	   -> True
-      AbsProd vals
-	   | not (equalLength vals demand_info) -> pprTrace "TELL SIMON: evalStrictness" (ppr demand_info $$ ppr val)
-						  False
-	   | otherwise -> or (zipWithEqual "evalStrictness" evalStrictness demand_info vals)
-
-      _	    	       -> pprTrace "evalStrictness?" empty False
-
-evalStrictness WwPrim val
-  = case val of
-      AbsTop -> False
-      AbsBot -> True	-- Can happen: consider f (g x), where g is a 
-			-- recursive function returning an Int# that diverges
-
-      other  -> pprPanic "evalStrictness: WwPrim:" (ppr other)
-\end{code}
-
-For absence analysis, we're interested in whether "poison" in the
-argument (ie a bottom therein) can propagate to the result of the
-function call; that is, whether the specified demand can {\em
-possibly} hit poison.
-
-\begin{code}
-evalAbsence (WwLazy True) _ = False	-- Can't possibly hit poison
-					-- with Absent demand
-
-evalAbsence (WwUnpack _ demand_info) val
-  = case val of
-	AbsTop	     -> False		-- No poison in here
-	AbsBot 	     -> True		-- Pure poison
-	AbsProd vals 
-	   | not (equalLength vals demand_info) -> pprTrace "TELL SIMON: evalAbsence" (ppr demand_info $$ ppr val)
-						  True
-	   | otherwise -> or (zipWithEqual "evalAbsence" evalAbsence demand_info vals)
-	_	       -> pprTrace "TELL SIMON: evalAbsence" 
-				(ppr demand_info $$ ppr val)
-			  True
-
-evalAbsence other val = anyBot val
-  -- The demand is conservative; even "Lazy" *might* evaluate the
-  -- argument arbitrarily so we have to look everywhere for poison
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[absEval]{Evaluate an expression in the abstract domain}
-%*									*
-%************************************************************************
-
-\begin{code}
--- The isBottomingId stuf is now dealt with via the Id's strictness info
--- absId anal var env | isBottomingId var
---   = case anal of
---	StrAnal -> AbsBot 	-- See discussion below
---	AbsAnal -> AbsTop	-- Just want to see if there's any poison in
-				-- error's arg
-
-absId anal var env
-  = case (lookupAbsValEnv env var, 
-	  isDataConWorkId_maybe var, 
-	  idStrictness var, 
-	  maybeUnfoldingTemplate (idUnfolding var)) of
-
-	(Just abs_val, _, _, _) ->
-			abs_val	-- Bound in the environment
-
-	(_, Just data_con, _, _) | isProductTyCon tycon &&
-				   not (isRecursiveTyCon tycon)
-		-> 	-- A product.  We get infinite loops if we don't
-			-- check for recursive products!
-			-- The strictness info on the constructor 
-			-- isn't expressive enough to contain its abstract value
-		   productAbsVal (dataConRepArgTys data_con) []
-		where
-		   tycon = dataConTyCon data_con
-
-	(_, _, NoStrictnessInfo, Just unfolding) ->
-			-- We have an unfolding for the expr
-			-- Assume the unfolding has no free variables since it
-			-- came from inside the Id
-			absEval anal unfolding env
-		-- Notice here that we only look in the unfolding if we don't
-		-- have strictness info (an unusual situation).
-		-- We could have chosen to look in the unfolding if it exists,
-		-- and only try the strictness info if it doesn't, and that would
-		-- give more accurate results, at the cost of re-abstract-interpreting
-		-- the unfolding every time.
-		-- We found only one place where the look-at-unfolding-first
-		-- method gave better results, which is in the definition of
-		-- showInt in the Prelude.  In its defintion, fromIntegral is
-		-- not inlined (it's big) but ab-interp-ing its unfolding gave
-		-- a better result than looking at its strictness only.
-		--  showInt :: Integral a => a -> [Char] -> [Char]
-		-- !       {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
-		--         "U(U(U(U(SA)AAAAAAAAL)AA)AAAAASAAASA)" {...} _N_ _N_ #-}
-		-- --- 42,44 ----
-		--   showInt :: Integral a => a -> [Char] -> [Char]
-		-- !       {-# GHC_PRAGMA _A_ 1 _U_ 122 _S_
-		--        "U(U(U(U(SL)LLLLLLLLL)LL)LLLLLSLLLLL)" _N_ _N_ #-}
-
-
-	(_, _, strictness_info, _) ->
-			-- Includes NoUnfolding
-			-- Try the strictness info
-			absValFromStrictness anal strictness_info
-
-productAbsVal []                 rev_abs_args = AbsProd (reverse rev_abs_args)
-productAbsVal (arg_ty : arg_tys) rev_abs_args = AbsFun arg_ty (\ abs_arg -> productAbsVal arg_tys (abs_arg : rev_abs_args))
-\end{code}
-
-\begin{code}
-absEval :: AnalysisKind -> CoreExpr -> AbsValEnv -> AbsVal
-
-absEval anal (Type ty) env = AbsTop
-absEval anal (Var var) env = absId anal var env
-\end{code}
-
-Discussion about error (following/quoting Lennart): Any expression
-'error e' is regarded as bottom (with HBC, with the -ffail-strict
-flag, on with -O).
-
-Regarding it as bottom gives much better strictness properties for
-some functions.	 E.g.
-
-	f [x] y = x+y
-	f (x:xs) y = f xs (x+y)
-i.e.
-	f [] _ = error "no match"
-	f [x] y = x+y
-	f (x:xs) y = f xs (x+y)
-
-is strict in y, which you really want.  But, it may lead to
-transformations that turn a call to \tr{error} into non-termination.
-(The odds of this happening aren't good.)
-
-Things are a little different for absence analysis, because we want
-to make sure that any poison (?????)
-
-\begin{code}
-absEval anal (Lit _) env = AbsTop
-  	-- Literals terminate (strictness) and are not poison (absence)
-\end{code}
-
-\begin{code}
-absEval anal (Lam bndr body) env
-  | isTyVar bndr = absEval anal body env	-- Type lambda
-  | otherwise    = AbsFun (idType bndr) abs_fn	-- Value lambda
-  where
-    abs_fn arg = absEval anal body (addOneToAbsValEnv env bndr arg)
-
-absEval anal (App expr (Type ty)) env
-  = absEval anal expr env			-- Type appplication
-absEval anal (App f val_arg) env
-  = absApply anal (absEval anal f env) 		-- Value applicationn
-		  (absEval anal val_arg env)
-\end{code}
-
-\begin{code}
-absEval anal expr@(Case scrut case_bndr alts) env
-  = let
-	scrut_val  = absEval anal scrut env
-	alts_env   = addOneToAbsValEnv env case_bndr scrut_val
-    in
-    case (scrut_val, alts) of
-	(AbsBot, _) -> AbsBot
-
-	(AbsProd arg_vals, [(con, bndrs, rhs)])
-		| con /= DEFAULT ->
-		-- The scrutinee is a product value, so it must be of a single-constr
-		-- type; so the constructor in this alternative must be the right one
-		-- so we can go ahead and bind the constructor args to the components
-		-- of the product value.
-	    ASSERT(equalLength arg_vals val_bndrs)
-	    absEval anal rhs rhs_env
-	  where
-	    val_bndrs = filter isId bndrs
-	    rhs_env   = growAbsValEnvList alts_env (val_bndrs `zip` arg_vals)
-
-	other -> absEvalAlts anal alts alts_env
-\end{code}
-
-For @Lets@ we widen the value we get.  This is nothing to
-do with fixpointing.  The reason is so that we don't get an explosion
-in the amount of computation.  For example, consider:
-\begin{verbatim}
-      let
-	g a = case a of
-		q1 -> ...
-		q2 -> ...
-	f x = case x of
-		p1 -> ...g r...
-		p2 -> ...g s...
-      in
-	f e
-\end{verbatim}
-If we bind @f@ and @g@ to their exact abstract value, then we'll
-``execute'' one call to @f@ and {\em two} calls to @g@.  This can blow
-up exponentially.  Widening cuts it off by making a fixed
-approximation to @f@ and @g@, so that the bodies of @f@ and @g@ are
-not evaluated again at all when they are called.
-
-Of course, this can lose useful joint strictness, which is sad.  An
-alternative approach would be to try with a certain amount of ``fuel''
-and be prepared to bale out.
-
-\begin{code}
-absEval anal (Let (NonRec binder e1) e2) env
-  = let
-	new_env = addOneToAbsValEnv env binder (widen anal (absEval anal e1 env))
-    in
-	-- The binder of a NonRec should *not* be of unboxed type,
-	-- hence no need to strictly evaluate the Rhs.
-    absEval anal e2 new_env
-
-absEval anal (Let (Rec pairs) body) env
-  = let
-	(binders,rhss) = unzip pairs
-	rhs_vals = cheapFixpoint anal binders rhss env	-- Returns widened values
-	new_env  = growAbsValEnvList env (binders `zip` rhs_vals)
-    in
-    absEval anal body new_env
-
-absEval anal (Note (Coerce _ _) expr) env = AbsTop
-	-- Don't look inside coerces, becuase they
-	-- are usually recursive newtypes
-	-- (Could improve, for the error case, but we're about
-	-- to kill this analyser anyway.)
-absEval anal (Note note expr) env = absEval anal expr env
-\end{code}
-
-\begin{code}
-absEvalAlts :: AnalysisKind -> [CoreAlt] -> AbsValEnv -> AbsVal
-absEvalAlts anal alts env
-  = combine anal (map go alts)
-  where
-    combine StrAnal = foldr1 lub	-- Diverge only if all diverge
-    combine AbsAnal = foldr1 glb	-- Find any poison
-
-    go (con, bndrs, rhs)
-      = absEval anal rhs rhs_env
-      where
-	rhs_env = growAbsValEnvList env (filter isId bndrs `zip` repeat AbsTop)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[absApply]{Apply an abstract function to an abstract argument}
-%*									*
-%************************************************************************
-
-Easy ones first:
-
-\begin{code}
-absApply :: AnalysisKind -> AbsVal -> AbsVal -> AbsVal
-
-absApply anal AbsBot arg = AbsBot
-  -- AbsBot represents the abstract bottom *function* too
-
-absApply StrAnal AbsTop	arg = AbsTop
-absApply AbsAnal AbsTop	arg = if anyBot arg
-			      then AbsBot
-			      else AbsTop
-	-- To be conservative, we have to assume that a function about
-	-- which we know nothing (AbsTop) might look at some part of
-	-- its argument
-\end{code}
-
-An @AbsFun@ with only one more argument needed---bind it and eval the
-result.	 A @Lam@ with two or more args: return another @AbsFun@ with
-an augmented environment.
-
-\begin{code}
-absApply anal (AbsFun bndr_ty abs_fn) arg = abs_fn arg
-\end{code}
-
-\begin{code}
-absApply StrAnal (AbsApproxFun (d:ds) val) arg
-  = case ds of 
-	[]    -> val'
-	other -> AbsApproxFun ds val'	-- Result is non-bot if there are still args
-  where
-    val' | evalStrictness d arg = AbsBot
-	 | otherwise		= val
-
-absApply AbsAnal (AbsApproxFun (d:ds) val) arg
-  = if evalAbsence d arg
-    then AbsBot		-- Poison in arg means poison in the application
-    else case ds of
-		[]    -> val
-		other -> AbsApproxFun ds val
-
-#ifdef DEBUG
-absApply anal f@(AbsProd _) arg 
-  = pprPanic ("absApply: Duff function: AbsProd." ++ show anal) ((ppr f) <+> (ppr arg))
-#endif
-\end{code}
-
-
-
-
-%************************************************************************
-%*									*
-\subsection[findStrictness]{Determine some binders' strictness}
-%*									*
-%************************************************************************
-
-\begin{code}
-findStrictness :: Id
-	       -> AbsVal 		-- Abstract strictness value of function
-	       -> AbsVal		-- Abstract absence value of function
-	       -> StrictnessInfo	-- Resulting strictness annotation
-
-findStrictness id (AbsApproxFun str_ds str_res) (AbsApproxFun abs_ds _)
-  	-- You might think there's really no point in describing detailed
-	-- strictness for a divergent function; 
-	-- If it's fully applied we get bottom regardless of the
-	-- argument.  If it's not fully applied we don't get bottom.
-	-- Finally, we don't want to regard the args of a divergent function
-	-- as 'interesting' for inlining purposes (see Simplify.prepareArgs)
-	--
-	-- HOWEVER, if we make diverging functions appear lazy, they
-	-- don't get wrappers, and then we get dreadful reboxing.
-	-- See notes with WwLib.worthSplitting
-  = find_strictness id str_ds str_res abs_ds
-
-findStrictness id str_val abs_val 
-  | isBot str_val = mkStrictnessInfo ([], True)
-  | otherwise     = NoStrictnessInfo
-
--- The list of absence demands passed to combineDemands 
--- can be shorter than the list of absence demands
---
---	lookup = \ dEq -> letrec {
---			     lookup = \ key ds -> ...lookup...
---			  }
---			  in lookup
--- Here the strictness value takes three args, but the absence value
--- takes only one, for reasons I don't quite understand (see cheapFixpoint)
-
-find_strictness id orig_str_ds orig_str_res orig_abs_ds
-  = mkStrictnessInfo (go orig_str_ds orig_abs_ds, res_bot)
-  where
-    res_bot = isBot orig_str_res
-
-    go str_ds abs_ds = zipWith mk_dmd str_ds (abs_ds ++ repeat wwLazy)
-
-    mk_dmd str_dmd (WwLazy True)
-	 = WARN( not (res_bot || isLazy str_dmd),
-		 ppr id <+> ppr orig_str_ds <+> ppr orig_abs_ds )
-		-- If the arg isn't used we jolly well don't expect the function
-		-- to be strict in it.  Unless the function diverges.
-	   WwLazy True	-- Best of all
-
-    mk_dmd (WwUnpack u str_ds) 
-	   (WwUnpack _ abs_ds) = WwUnpack u (go str_ds abs_ds)
-
-    mk_dmd str_dmd abs_dmd = str_dmd
-\end{code}
-
-
-\begin{code}
-findDemand dmd str_env abs_env expr binder
-  = findRecDemand str_fn abs_fn (idType binder)
-  where
-    str_fn val = evalStrictness   dmd (absEval StrAnal expr (addOneToAbsValEnv str_env binder val))
-    abs_fn val = not (evalAbsence dmd (absEval AbsAnal expr (addOneToAbsValEnv abs_env binder val)))
-
-findDemandAlts dmd str_env abs_env alts binder
-  = findRecDemand str_fn abs_fn (idType binder)
-  where
-    str_fn val = evalStrictness   dmd (absEvalAlts StrAnal alts (addOneToAbsValEnv str_env binder val))
-    abs_fn val = not (evalAbsence dmd (absEvalAlts AbsAnal alts (addOneToAbsValEnv abs_env binder val)))
-\end{code}
-
-@findRecDemand@ is where we finally convert strictness/absence info
-into ``Demands'' which we can pin on Ids (etc.).
-
-NOTE: What do we do if something is {\em both} strict and absent?
-Should \tr{f x y z = error "foo"} says that \tr{f}'s arguments are all
-strict (because of bottoming effect of \tr{error}) or all absent
-(because they're not used)?
-
-Well, for practical reasons, we prefer absence over strictness.  In
-particular, it makes the ``default defaults'' for class methods (the
-ones that say \tr{defm.foo dict = error "I don't exist"}) come out
-nicely [saying ``the dict isn't used''], rather than saying it is
-strict in every component of the dictionary [massive gratuitious
-casing to take the dict apart].
-
-But you could have examples where going for strictness would be better
-than absence.  Consider:
-\begin{verbatim}
-	let x = something big
-	in
-	f x y z + g x
-\end{verbatim}
-
-If \tr{x} is marked absent in \tr{f}, but not strict, and \tr{g} is
-lazy, then the thunk for \tr{x} will be built.  If \tr{f} was strict,
-then we'd let-to-case it:
-\begin{verbatim}
-	case something big of
-	  x -> f x y z + g x
-\end{verbatim}
-Ho hum.
-
-\begin{code}
-findRecDemand :: (AbsVal -> Bool)	-- True => function applied to this value yields Bot
-	      -> (AbsVal -> Bool)	-- True => function applied to this value yields no poison
-	      -> Type 	    -- The type of the argument
-	      -> Demand
-
-findRecDemand str_fn abs_fn ty
-  = if isUnLiftedType ty then -- It's a primitive type!
-       wwPrim
-
-    else if abs_fn AbsBot then -- It's absent
-       -- We prefer absence over strictness: see NOTE above.
-       WwLazy True
-
-    else if not (opt_AllStrict ||
-		 (opt_NumbersStrict && is_numeric_type ty) ||
-		 str_fn AbsBot) then
-	WwLazy False -- It's not strict and we're not pretending
-
-    else -- It's strict (or we're pretending it is)!
-
-       case splitProductType_maybe ty of
-
-	 Nothing -> wwStrict	-- Could have a test for wwEnum, but
-				-- we don't exploit it yet, so don't bother
-
-	 Just (tycon,_,data_con,cmpnt_tys) 	-- Single constructor case
-	   | isRecursiveTyCon tycon		-- Recursive data type; don't unpack
-	   ->	wwStrict			-- 	(this applies to newtypes too:
-						--	e.g.  data Void = MkVoid Void)
-
-	   |  null compt_strict_infos 		-- A nullary data type
-	   ->	wwStrict
-
-	   | otherwise				-- Some other data type
-	   ->	wwUnpack compt_strict_infos
-
-	   where
-	      prod_len = length cmpnt_tys
-	      compt_strict_infos
-		= [ findRecDemand
-			 (\ cmpnt_val ->
-			       str_fn (mkMainlyTopProd prod_len i cmpnt_val)
-			 )
-			 (\ cmpnt_val ->
-			       abs_fn (mkMainlyTopProd prod_len i cmpnt_val)
-			 )
-		     cmpnt_ty
-		  | (cmpnt_ty, i) <- cmpnt_tys `zip` [1..] ]
-
-  where
-    is_numeric_type ty
-      = case (splitTyConApp_maybe ty) of -- NB: duplicates stuff done above
-	  Nothing	  -> False
-	  Just (tycon, _) -> tyConUnique tycon `is_elem` numericTyKeys
-      where
-	is_elem = isIn "is_numeric_type"
-
-    -- mkMainlyTopProd: make an AbsProd that is all AbsTops ("n"-1 of
-    -- them) except for a given value in the "i"th position.
-
-    mkMainlyTopProd :: Int -> Int -> AbsVal -> AbsVal
-
-    mkMainlyTopProd n i val
-      = let
-	    befores = nOfThem (i-1) AbsTop
-	    afters  = nOfThem (n-i) AbsTop
-    	in
-	AbsProd (befores ++ (val : afters))
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[fixpoint]{Fixpointer for the strictness analyser}
-%*									*
-%************************************************************************
-
-The @fixpoint@ functions take a list of \tr{(binder, expr)} pairs, an
-environment, and returns the abstract value of each binder.
-
-The @cheapFixpoint@ function makes a conservative approximation,
-by binding each of the variables to Top in their own right hand sides.
-That allows us to make rapid progress, at the cost of a less-than-wonderful
-approximation.
-
-\begin{code}
-cheapFixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
-
-cheapFixpoint AbsAnal [id] [rhs] env
-  = [crudeAbsWiden (absEval AbsAnal rhs new_env)]
-  where
-    new_env = addOneToAbsValEnv env id AbsTop	-- Unsafe starting point!
-		    -- In the just-one-binding case, we guarantee to
-		    -- find a fixed point in just one iteration,
-		    -- because we are using only a two-point domain.
-		    -- This improves matters in cases like:
-		    --
-		    --	f x y = letrec g = ...g...
-		    --		in g x
-		    --
-		    -- Here, y isn't used at all, but if g is bound to
-		    -- AbsBot we simply get AbsBot as the next
-		    -- iteration too.
-
-cheapFixpoint anal ids rhss env
-  = [widen anal (absEval anal rhs new_env) | rhs <- rhss]
-		-- We do just one iteration, starting from a safe
-		-- approximation.  This won't do a good job in situations
-		-- like:
-		--	\x -> letrec f = ...g...
-		--		     g = ...f...x...
-		--	      in
-		--	      ...f...
-		-- Here, f will end up bound to Top after one iteration,
-		-- and hence we won't spot the strictness in x.
-		-- (A second iteration would solve this.  ToDo: try the effect of
-		--  really searching for a fixed point.)
-  where
-    new_env = growAbsValEnvList env [(id,safe_val) | id <- ids]
-
-    safe_val
-      = case anal of	-- The safe starting point
-	  StrAnal -> AbsTop
-	  AbsAnal -> AbsBot
-\end{code}
-
-\begin{code}
-fixpoint :: AnalysisKind -> [Id] -> [CoreExpr] -> AbsValEnv -> [AbsVal]
-
-fixpoint anal [] _ env = []
-
-fixpoint anal ids rhss env
-  = fix_loop initial_vals
-  where
-    initial_val id
-      = case anal of	-- The (unsafe) starting point
-	  AbsAnal -> AbsTop
-	  StrAnal -> AbsBot
-		-- At one stage for StrAnal we said:
-		--   if (returnsRealWorld (idType id))
-		--   then AbsTop -- this is a massively horrible hack (SLPJ 95/05)
-		-- but no one has the foggiest idea what this hack did,
-		-- and returnsRealWorld was a stub that always returned False
-		-- So this comment is all that is left of the hack!
-
-    initial_vals = [ initial_val id | id <- ids ]
-
-    fix_loop :: [AbsVal] -> [AbsVal]
-
-    fix_loop current_widened_vals
-      = let
-	    new_env  = growAbsValEnvList env (ids `zip` current_widened_vals)
-	    new_vals = [ absEval anal rhs new_env | rhs <- rhss ]
-	    new_widened_vals = map (widen anal) new_vals
-	in
-	if (and (zipWith sameVal current_widened_vals new_widened_vals)) then
-	    current_widened_vals
-
-	    -- NB: I was too chicken to make that a zipWithEqual,
-	    -- lest I jump into a black hole.  WDP 96/02
-
-	    -- Return the widened values.  We might get a slightly
-	    -- better value by returning new_vals (which we used to
-	    -- do, see below), but alas that means that whenever the
-	    -- function is called we have to re-execute it, which is
-	    -- expensive.
-
-	    -- OLD VERSION
-	    -- new_vals
-	    -- Return the un-widened values which may be a bit better
-	    -- than the widened ones, and are guaranteed safe, since
-	    -- they are one iteration beyond current_widened_vals,
-	    -- which itself is a fixed point.
-	else
-	    fix_loop new_widened_vals
-\end{code}
-
-For absence analysis, we make do with a very very simple approach:
-look for convergence in a two-point domain.
-
-We used to use just one iteration, starting with the variables bound
-to @AbsBot@, which is safe.
-
-Prior to that, we used one iteration starting from @AbsTop@ (which
-isn't safe).  Why isn't @AbsTop@ safe?  Consider:
-\begin{verbatim}
-	letrec
-	  x = ...p..d...
-	  d = (x,y)
-	in
-	...
-\end{verbatim}
-Here, if p is @AbsBot@, then we'd better {\em not} end up with a ``fixed
-point'' of @d@ being @(AbsTop, AbsTop)@!  An @AbsBot@ initial value is
-safe because it gives poison more often than really necessary, and
-thus may miss some absence, but will never claim absence when it ain't
-so.
-
-Anyway, one iteration starting with everything bound to @AbsBot@ give
-bad results for
-
-	f = \ x -> ...f...
-
-Here, f would always end up bound to @AbsBot@, which ain't very
-clever, because then it would introduce poison whenever it was
-applied.  Much better to start with f bound to @AbsTop@, and widen it
-to @AbsBot@ if any poison shows up. In effect we look for convergence
-in the two-point @AbsTop@/@AbsBot@ domain.
-
-What we miss (compared with the cleverer strictness analysis) is
-spotting that in this case
-
-	f = \ x y -> ...y...(f x y')...
-
-\tr{x} is actually absent, since it is only passed round the loop, never
-used.  But who cares about missing that?
-
-NB: despite only having a two-point domain, we may still have many
-iterations, because there are several variables involved at once.
-
-\begin{code}
-#endif /* OLD_STRICTNESS */
-\end{code}
diff --git a/ghc/compiler/stranal/SaLib.lhs b/ghc/compiler/stranal/SaLib.lhs
deleted file mode 100644
index 338a351530..0000000000
--- a/ghc/compiler/stranal/SaLib.lhs
+++ /dev/null
@@ -1,130 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[SaLib]{Basic datatypes, functions for the strictness analyser}
-
-See also: the ``library'' for the ``back end'' (@SaBackLib@).
-
-\begin{code}
-#ifndef OLD_STRICTNESS
-module SaLib () where
-#else
-
-module SaLib (
-	AbsVal(..),
-	AnalysisKind(..),
-	AbsValEnv{-abstract-}, StrictEnv, AbsenceEnv,
-	mkAbsApproxFun,
-	nullAbsValEnv, addOneToAbsValEnv, growAbsValEnvList,
-	lookupAbsValEnv,
-	absValFromStrictness
-    ) where
-
-#include "HsVersions.h"
-
-import Type		( Type )
-import VarEnv
-import IdInfo		( StrictnessInfo(..) )
-import Demand		( Demand )
-import Outputable
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[AbsVal-datatype]{@AbsVal@: abstract values (and @AbsValEnv@)}
-%*									*
-%************************************************************************
-
-@AnalysisKind@ tells what kind of analysis is being done.
-
-\begin{code}
-data AnalysisKind
-  = StrAnal 	-- We're doing strictness analysis
-  | AbsAnal	-- We're doing absence analysis
-  deriving Show
-\end{code}
-
-@AbsVal@ is the data type of HNF abstract values.
-
-\begin{code}
-data AbsVal
-  = AbsTop		    -- AbsTop is the completely uninformative
-			    -- value
-
-  | AbsBot		    -- An expression whose abstract value is
-			    -- AbsBot is sure to fail to terminate.
-			    -- AbsBot represents the abstract
-			    --  *function* bottom too.
-
-  | AbsProd [AbsVal]	    -- (Lifted) product of abstract values
-			    -- "Lifted" means that AbsBot is *different* from
-			    --    AbsProd [AbsBot, ..., AbsBot]
-
-  | AbsFun	    	    -- An abstract function, with the given:
-	    Type	   	 -- Type of the *argument* to the function
-	    (AbsVal -> AbsVal)	-- The function
-
-  | AbsApproxFun	    -- This is used to represent a coarse
-	    [Demand]	    -- approximation to a function value.  It's an
-	    AbsVal	    -- abstract function which is strict in its
-			    -- arguments if the  Demand so indicates.
-	-- INVARIANT: the [Demand] is non-empty
-
-	-- AbsApproxFun has to take a *list* of demands, no just one,
-	-- because function spaces are now lifted.  Hence, (f bot top)
-	-- might be bot, but the partial application (f bot) is a *function*,
-	-- not bot.
-
-mkAbsApproxFun :: Demand -> AbsVal -> AbsVal
-mkAbsApproxFun d (AbsApproxFun ds val) = AbsApproxFun (d:ds) val
-mkAbsApproxFun d val	   	       = AbsApproxFun [d]    val
-
-instance Outputable AbsVal where
-    ppr AbsTop = ptext SLIT("AbsTop")
-    ppr AbsBot = ptext SLIT("AbsBot")
-    ppr (AbsProd prod) = hsep [ptext SLIT("AbsProd"), ppr prod]
-    ppr (AbsFun bndr_ty body) = ptext SLIT("AbsFun")
-    ppr (AbsApproxFun demands val)
-      = ptext SLIT("AbsApprox") <+> brackets (interpp'SP demands) <+> ppr val
-\end{code}
-
-%-----------
-
-An @AbsValEnv@ maps @Ids@ to @AbsVals@.  Any unbound @Ids@ are
-implicitly bound to @AbsTop@, the completely uninformative,
-pessimistic value---see @absEval@ of a @Var@.
-
-\begin{code}
-newtype AbsValEnv = AbsValEnv (IdEnv AbsVal)
-
-type StrictEnv  = AbsValEnv	-- Environment for strictness analysis
-type AbsenceEnv = AbsValEnv	-- Environment for absence analysis
-
-nullAbsValEnv -- this is the one and only way to create AbsValEnvs
-  = AbsValEnv emptyVarEnv
-
-addOneToAbsValEnv (AbsValEnv idenv) y z = AbsValEnv (extendVarEnv idenv y z)
-growAbsValEnvList (AbsValEnv idenv) ys  = AbsValEnv (extendVarEnvList idenv ys)
-
-lookupAbsValEnv (AbsValEnv idenv) y
-  = lookupVarEnv idenv y
-\end{code}
-
-\begin{code}
-absValFromStrictness :: AnalysisKind -> StrictnessInfo -> AbsVal
-
-absValFromStrictness anal NoStrictnessInfo = AbsTop
-absValFromStrictness anal (StrictnessInfo args_info bot_result)
-  = case args_info of	-- Check the invariant that the arg list on 
-	[] -> res	-- AbsApproxFun is non-empty
-	_  -> AbsApproxFun args_info res
-  where
-    res | not bot_result = AbsTop
-	| otherwise      = case anal of
-				StrAnal -> AbsBot
-				AbsAnal -> AbsTop
-\end{code}
-
-\begin{code}
-#endif /* OLD_STRICTNESS */
-\end{code}
diff --git a/ghc/compiler/stranal/StrictAnal.lhs b/ghc/compiler/stranal/StrictAnal.lhs
deleted file mode 100644
index 242a947074..0000000000
--- a/ghc/compiler/stranal/StrictAnal.lhs
+++ /dev/null
@@ -1,494 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[StrictAnal]{``Simple'' Mycroft-style strictness analyser}
-
-The original version(s) of all strictness-analyser code (except the
-Semantique analyser) was written by Andy Gill.
-
-\begin{code}
-#ifndef OLD_STRICTNESS
-module StrictAnal ( ) where
-
-#else
-
-module StrictAnal ( saBinds ) where
-
-#include "HsVersions.h"
-
-import DynFlags	( DynFlags, DynFlag(..) )
-import CoreSyn
-import Id		( setIdStrictness, setInlinePragma, 
-			  idDemandInfo, setIdDemandInfo, isBottomingId,
-			  Id
-			)
-import CoreLint		( showPass, endPass )
-import ErrUtils		( dumpIfSet_dyn )
-import SaAbsInt
-import SaLib
-import Demand		( Demand, wwStrict, isStrict, isLazy )
-import Util		( zipWith3Equal, stretchZipWith, compareLength )
-import BasicTypes	( Activation( NeverActive ) )
-import Outputable
-import FastTypes
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Thoughts]{Random thoughts}
-%*									*
-%************************************************************************
-
-A note about worker-wrappering.  If we have
-
-	f :: Int -> Int
-	f = let v = <expensive>
-	    in \x -> <body>
-
-and we deduce that f is strict, it is nevertheless NOT safe to worker-wapper to
-
-	f = \x -> case x of Int x# -> fw x#
-	fw = \x# -> let x = Int x#
-		    in
-		    let v = <expensive>
-		    in <body>
-
-because this obviously loses laziness, since now <expensive>
-is done each time.  Alas.
-
-WATCH OUT!  This can mean that something is unboxed only to be
-boxed again. For example
-
-	g x y = f x
-
-Here g is strict, and *will* split into worker-wrapper.  A call to
-g, with the wrapper inlined will then be
-
-	case arg of Int a# -> gw a#
-
-Now g calls f, which has no wrapper, so it has to box it.
-
-	gw = \a# -> f (Int a#)
-
-Alas and alack.
-
-
-%************************************************************************
-%*									*
-\subsection[iface-StrictAnal]{Interface to the outside world}
-%*									*
-%************************************************************************
-
-@saBinds@ decorates bindings with strictness info.  A later 
-worker-wrapper pass can use this info to create wrappers and
-strict workers.
-
-\begin{code}
-saBinds :: DynFlags -> [CoreBind] -> IO [CoreBind]
-saBinds dflags binds
-  = do {
-	showPass dflags "Strictness analysis";
-
-	-- Mark each binder with its strictness
-#ifndef OMIT_STRANAL_STATS
-	let { (binds_w_strictness, sa_stats) = saTopBinds binds nullSaStats };
-	dumpIfSet_dyn dflags Opt_D_dump_simpl_stats "Strictness analysis statistics"
-		  (pp_stats sa_stats);
-#else
-	let { binds_w_strictness = saTopBindsBinds binds };
-#endif
-
-	endPass dflags "Strictness analysis" Opt_D_dump_stranal
-		binds_w_strictness
-    }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[saBinds]{Strictness analysis of bindings}
-%*									*
-%************************************************************************
-
-[Some of the documentation about types, etc., in \tr{SaLib} may be
-helpful for understanding this module.]
-
-@saTopBinds@ tags each binder in the program with its @Demand@.
-That tells how each binder is {\em used}; if @Strict@, then the binder
-is sure to be evaluated to HNF; if @NonStrict@ it may or may not be;
-if @Absent@, then it certainly is not used. [DATED; ToDo: update]
-
-(The above info is actually recorded for posterity in each binder's
-IdInfo, notably its @DemandInfo@.)
-
-We proceed by analysing the bindings top-to-bottom, building up an
-environment which maps @Id@s to their abstract values (i.e., an
-@AbsValEnv@ maps an @Id@ to its @AbsVal@).
-
-\begin{code}
-saTopBinds :: [CoreBind] -> SaM [CoreBind] -- not exported
-
-saTopBinds binds
-  = let
-	starting_abs_env = nullAbsValEnv
-    in
-    do_it starting_abs_env starting_abs_env binds
-  where
-    do_it _    _    [] = returnSa []
-    do_it senv aenv (b:bs)
-      = saTopBind senv  aenv  b  `thenSa` \ (senv2, aenv2, new_b) ->
-	do_it     senv2 aenv2 bs `thenSa` \ new_bs ->
-	returnSa (new_b : new_bs)
-\end{code}
-
-@saTopBind@ is only used for the top level.  We don't add any demand
-info to these ids because we can't work it out.  In any case, it
-doesn't do us any good to know whether top-level binders are sure to
-be used; we can't turn top-level @let@s into @case@s.
-
-\begin{code}
-saTopBind :: StrictEnv -> AbsenceEnv
-	  -> CoreBind
-	  -> SaM (StrictEnv, AbsenceEnv, CoreBind)
-
-saTopBind str_env abs_env (NonRec binder rhs)
-  = saExpr minDemand str_env abs_env rhs 	`thenSa` \ new_rhs ->
-    let
-	str_rhs = absEval StrAnal rhs str_env
-	abs_rhs = absEval AbsAnal rhs abs_env
-
-	widened_str_rhs = widen StrAnal str_rhs
-	widened_abs_rhs = widen AbsAnal abs_rhs
-		-- The widening above is done for efficiency reasons.
-		-- See notes on Let case in SaAbsInt.lhs
-
-	new_binder
-	  = addStrictnessInfoToTopId
-		widened_str_rhs widened_abs_rhs
-		binder
-
-	  -- Augment environments with a mapping of the
-	  -- binder to its abstract values, computed by absEval
-      	new_str_env = addOneToAbsValEnv str_env binder widened_str_rhs
-      	new_abs_env = addOneToAbsValEnv abs_env binder widened_abs_rhs
-    in
-    returnSa (new_str_env, new_abs_env, NonRec new_binder new_rhs)
-
-saTopBind str_env abs_env (Rec pairs)
-  = let
-	(binders,rhss) = unzip pairs
-	str_rhss    = fixpoint StrAnal binders rhss str_env
-	abs_rhss    = fixpoint AbsAnal binders rhss abs_env
-		      -- fixpoint returns widened values
-      	new_str_env = growAbsValEnvList str_env (binders `zip` str_rhss)
-      	new_abs_env = growAbsValEnvList abs_env (binders `zip` abs_rhss)
-	new_binders = zipWith3Equal "saTopBind" addStrictnessInfoToTopId
-				    str_rhss abs_rhss binders
-    in
-    mapSa (saExpr minDemand new_str_env new_abs_env) rhss	`thenSa` \ new_rhss ->
-    let
-	new_pairs   = new_binders `zip` new_rhss
-    in
-    returnSa (new_str_env, new_abs_env, Rec new_pairs)
-
--- Hack alert!
--- Top level divergent bindings are marked NOINLINE
--- This avoids fruitless inlining of top level error functions
-addStrictnessInfoToTopId str_val abs_val bndr
-  = if isBottomingId new_id then
-	new_id `setInlinePragma` NeverActive
-    else
-	new_id
-  where
-    new_id = addStrictnessInfoToId str_val abs_val bndr
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[saExpr]{Strictness analysis of an expression}
-%*									*
-%************************************************************************
-
-@saExpr@ computes the strictness of an expression within a given
-environment.
-
-\begin{code}
-saExpr :: Demand -> StrictEnv -> AbsenceEnv -> CoreExpr -> SaM CoreExpr
-	-- The demand is the least demand we expect on the
-	-- expression.  WwStrict is the least, because we're only
-	-- interested in the expression at all if it's being evaluated,
-	-- but the demand may be more.  E.g.
-	--	f E
-	-- where f has strictness u(LL), will evaluate E with demand u(LL)
-
-minDemand = wwStrict 
-minDemands = repeat minDemand
-
--- When we find an application, do the arguments
--- with demands gotten from the function
-saApp str_env abs_env (fun, args)
-  = sequenceSa sa_args				`thenSa` \ args' ->
-    saExpr minDemand str_env abs_env fun	`thenSa` \ fun'  -> 
-    returnSa (mkApps fun' args')
-  where
-    arg_dmds = case fun of
-		 Var var -> case lookupAbsValEnv str_env var of
-				Just (AbsApproxFun ds _) 
-				   | compareLength ds args /= LT 
-				              -- 'ds' is at least as long as 'args'.
-					-> ds ++ minDemands
-				other   -> minDemands
-		 other -> minDemands
-
-    sa_args = stretchZipWith isTypeArg (error "saApp:dmd") 
-			     sa_arg args arg_dmds 
-	-- The arg_dmds are for value args only, we need to skip
-	-- over the type args when pairing up with the demands
-	-- Hence the stretchZipWith
-
-    sa_arg arg dmd = saExpr dmd' str_env abs_env arg
-		   where
-			-- Bring arg demand up to minDemand
-			dmd' | isLazy dmd = minDemand
-			     | otherwise  = dmd
-
-saExpr _ _ _ e@(Var _)	= returnSa e
-saExpr _ _ _ e@(Lit _)	= returnSa e
-saExpr _ _ _ e@(Type _)	= returnSa e
-
-saExpr dmd str_env abs_env (Lam bndr body)
-  =	-- Don't bother to set the demand-info on a lambda binder
-	-- We do that only for let(rec)-bound functions
-    saExpr minDemand str_env abs_env body	`thenSa` \ new_body ->
-    returnSa (Lam bndr new_body)
-
-saExpr dmd str_env abs_env e@(App fun arg)
-  = saApp str_env abs_env (collectArgs e)
-
-saExpr dmd str_env abs_env (Note note expr)
-  = saExpr dmd str_env abs_env expr	`thenSa` \ new_expr ->
-    returnSa (Note note new_expr)
-
-saExpr dmd str_env abs_env (Case expr case_bndr alts)
-  = saExpr minDemand str_env abs_env expr	`thenSa` \ new_expr  ->
-    mapSa sa_alt alts				`thenSa` \ new_alts  ->
-    let
-	new_case_bndr = addDemandInfoToCaseBndr dmd str_env abs_env alts case_bndr
-    in
-    returnSa (Case new_expr new_case_bndr new_alts)
-  where
-    sa_alt (con, binders, rhs)
-      = saExpr dmd str_env abs_env rhs  `thenSa` \ new_rhs ->
-	let
-	    new_binders = map add_demand_info binders
-	    add_demand_info bndr | isTyVar bndr = bndr
-			  	 | otherwise	= addDemandInfoToId dmd str_env abs_env rhs bndr
-	in
-	tickCases new_binders	    `thenSa_` -- stats
-	returnSa (con, new_binders, new_rhs)
-
-saExpr dmd str_env abs_env (Let (NonRec binder rhs) body)
-  =	-- Analyse the RHS in the environment at hand
-    let
-	-- Find the demand on the RHS
-	rhs_dmd = findDemand dmd str_env abs_env body binder
-
-	-- Bind this binder to the abstract value of the RHS; analyse
-	-- the body of the `let' in the extended environment.
-      	str_rhs_val  	= absEval StrAnal rhs str_env
-      	abs_rhs_val  	= absEval AbsAnal rhs abs_env
-
-	widened_str_rhs = widen StrAnal str_rhs_val
-	widened_abs_rhs = widen AbsAnal abs_rhs_val
-		-- The widening above is done for efficiency reasons.
-		-- See notes on Let case in SaAbsInt.lhs
-
-      	new_str_env	= addOneToAbsValEnv str_env binder widened_str_rhs
-      	new_abs_env	= addOneToAbsValEnv abs_env binder widened_abs_rhs
-
-	-- Now determine the strictness of this binder; use that info
-	-- to record DemandInfo/StrictnessInfo in the binder.
-	new_binder = addStrictnessInfoToId
-			widened_str_rhs widened_abs_rhs
-			(binder `setIdDemandInfo` rhs_dmd)
-    in
-    tickLet new_binder				`thenSa_` -- stats
-    saExpr rhs_dmd str_env abs_env rhs		`thenSa` \ new_rhs  ->
-    saExpr dmd new_str_env new_abs_env body	`thenSa` \ new_body ->
-    returnSa (Let (NonRec new_binder new_rhs) new_body)
-
-saExpr dmd str_env abs_env (Let (Rec pairs) body)
-  = let
-	(binders,rhss) = unzip pairs
-	str_vals       = fixpoint StrAnal binders rhss str_env
-	abs_vals       = fixpoint AbsAnal binders rhss abs_env
-			 -- fixpoint returns widened values
-      	new_str_env    = growAbsValEnvList str_env (binders `zip` str_vals)
-      	new_abs_env    = growAbsValEnvList abs_env (binders `zip` abs_vals)
-    in
-    saExpr dmd new_str_env new_abs_env body			`thenSa` \ new_body ->
-    mapSa (saExpr minDemand new_str_env new_abs_env) rhss	`thenSa` \ new_rhss ->
-    let
--- 		DON'T add demand info in a Rec!
---		a) it's useless: we can't do let-to-case
---		b) it's incorrect.  Consider
---			letrec x = ...y...
---			       y = ...x...
---			in ...x...
---		   When we ask whether y is demanded we'll bind y to bottom and
---		   evaluate the body of the letrec.  But that will result in our
---		   deciding that y is absent, which is plain wrong!
---		It's much easier simply not to do this.
-
-	improved_binders = zipWith3Equal "saExpr" addStrictnessInfoToId
-				         str_vals abs_vals binders
-
-      	new_pairs   = improved_binders `zip` new_rhss
-    in
-    returnSa (Let (Rec new_pairs) new_body)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[computeInfos]{Add computed info to binders}
-%*									*
-%************************************************************************
-
-Important note (Sept 93).  @addStrictnessInfoToId@ is used only for
-let(rec) bound variables, and is use to attach the strictness (not
-demand) info to the binder.  We are careful to restrict this
-strictness info to the lambda-bound arguments which are actually
-visible, at the top level, lest we accidentally lose laziness by
-eagerly looking for an "extra" argument.  So we "dig for lambdas" in a
-rather syntactic way.
-
-A better idea might be to have some kind of arity analysis to
-tell how many args could safely be grabbed.
-
-\begin{code}
-addStrictnessInfoToId
-	:: AbsVal 		-- Abstract strictness value
-	-> AbsVal		-- Ditto absence
-	-> Id 			-- The id
-	-> Id			-- Augmented with strictness
-
-addStrictnessInfoToId str_val abs_val binder
-  = binder `setIdStrictness` findStrictness binder str_val abs_val
-\end{code}
-
-\begin{code}
-addDemandInfoToId :: Demand -> StrictEnv -> AbsenceEnv
-		  -> CoreExpr 	-- The scope of the id
-		  -> Id
-		  -> Id			-- Id augmented with Demand info
-
-addDemandInfoToId dmd str_env abs_env expr binder
-  = binder `setIdDemandInfo` (findDemand dmd str_env abs_env expr binder)
-
-addDemandInfoToCaseBndr dmd str_env abs_env alts binder
-  = binder `setIdDemandInfo` (findDemandAlts dmd str_env abs_env alts binder)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Monad used herein for stats}
-%*									*
-%************************************************************************
-
-\begin{code}
-data SaStats
-  = SaStats FastInt FastInt	-- total/marked-demanded lambda-bound
-	    FastInt FastInt	-- total/marked-demanded case-bound
-	    FastInt FastInt	-- total/marked-demanded let-bound
-				-- (excl. top-level; excl. letrecs)
-
-nullSaStats = SaStats (_ILIT 0) (_ILIT 0) (_ILIT 0) (_ILIT 0) (_ILIT 0) (_ILIT 0)
-
-thenSa	      :: SaM a -> (a -> SaM b) -> SaM b
-thenSa_	      :: SaM a -> SaM b -> SaM b
-returnSa      :: a -> SaM a
-
-{-# INLINE thenSa #-}
-{-# INLINE thenSa_ #-}
-{-# INLINE returnSa #-}
-
-tickLambda :: Id   -> SaM ()
-tickCases  :: [CoreBndr] -> SaM ()
-tickLet    :: Id   -> SaM ()
-
-#ifndef OMIT_STRANAL_STATS
-type SaM a = SaStats -> (a, SaStats)
-
-thenSa expr cont stats
-  = case (expr stats) of { (result, stats1) ->
-    cont result stats1 }
-
-thenSa_ expr cont stats
-  = case (expr stats) of { (_, stats1) ->
-    cont stats1 }
-
-returnSa x stats = (x, stats)
-
-tickLambda var (SaStats tlam dlam tc dc tlet dlet)
-  = case (tick_demanded var (0,0)) of { (totB, demandedB) ->
-    let tot = iUnbox totB ; demanded = iUnbox demandedB 
-    in
-    ((), SaStats (tlam +# tot) (dlam +# demanded) tc dc tlet dlet) }
-
-tickCases vars (SaStats tlam dlam tc dc tlet dlet)
-  = case (foldr tick_demanded (0,0) vars) of { (totB, demandedB) ->
-    let tot = iUnbox totB ; demanded = iUnbox demandedB 
-    in
-    ((), SaStats tlam dlam (tc +# tot) (dc +# demanded) tlet dlet) }
-
-tickLet var (SaStats tlam dlam tc dc tlet dlet)
-  = case (tick_demanded var (0,0))        of { (totB, demandedB) ->
-    let tot = iUnbox totB ; demanded = iUnbox demandedB 
-    in
-    ((), SaStats tlam dlam tc dc (tlet +# tot) (dlet +# demanded)) }
-
-tick_demanded var (tot, demanded)
-  | isTyVar var = (tot, demanded)
-  | otherwise
-  = (tot + 1,
-     if (isStrict (idDemandInfo var))
-     then demanded + 1
-     else demanded)
-
-pp_stats (SaStats tlam dlam tc dc tlet dlet)
-      = hcat [ptext SLIT("Lambda vars: "), int (iBox dlam), char '/', int (iBox tlam),
-	      ptext SLIT("; Case vars: "), int (iBox dc),   char '/', int (iBox tc),
-	      ptext SLIT("; Let vars: "),  int (iBox dlet), char '/', int (iBox tlet)
-	]
-
-#else /* OMIT_STRANAL_STATS */
--- identity monad
-type SaM a = a
-
-thenSa expr cont = cont expr
-
-thenSa_ expr cont = cont
-
-returnSa x = x
-
-tickLambda var  = panic "OMIT_STRANAL_STATS: tickLambda"
-tickCases  vars = panic "OMIT_STRANAL_STATS: tickCases"
-tickLet    var  = panic "OMIT_STRANAL_STATS: tickLet"
-
-#endif /* OMIT_STRANAL_STATS */
-
-mapSa	      :: (a -> SaM b) -> [a] -> SaM [b]
-
-mapSa f []     = returnSa []
-mapSa f (x:xs) = f x		`thenSa` \ r  ->
-		 mapSa f xs	`thenSa` \ rs ->
-		 returnSa (r:rs)
-
-sequenceSa :: [SaM a] -> SaM [a]
-sequenceSa []     = returnSa []
-sequenceSa (m:ms) = m		  `thenSa` \ r ->
-		    sequenceSa ms `thenSa` \ rs ->
-		    returnSa (r:rs)
-
-#endif /* OLD_STRICTNESS */
-\end{code}
diff --git a/ghc/compiler/stranal/WorkWrap.lhs b/ghc/compiler/stranal/WorkWrap.lhs
deleted file mode 100644
index 64eba89273..0000000000
--- a/ghc/compiler/stranal/WorkWrap.lhs
+++ /dev/null
@@ -1,403 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[WorkWrap]{Worker/wrapper-generating back-end of strictness analyser}
-
-\begin{code}
-module WorkWrap ( wwTopBinds, mkWrapper ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-import CoreUnfold	( certainlyWillInline )
-import CoreLint		( showPass, endPass )
-import CoreUtils	( exprType, exprIsHNF )
-import Id		( Id, idType, isOneShotLambda, 
-			  setIdNewStrictness, mkWorkerId,
-			  setIdWorkerInfo, setInlinePragma,
-			  idInfo )
-import MkId		( lazyIdKey, lazyIdUnfolding )
-import Type		( Type )
-import IdInfo		( WorkerInfo(..), arityInfo,
-			  newDemandInfo, newStrictnessInfo, unfoldingInfo, inlinePragInfo
-			)
-import NewDemand        ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..), 
-			  Demands(..), mkTopDmdType, isBotRes, returnsCPR, topSig, isAbsent
-			)
-import UniqSupply	( UniqSupply, initUs_, returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
-import Unique		( hasKey )
-import BasicTypes	( RecFlag(..), isNonRec, Activation(..) )
-import VarEnv		( isEmptyVarEnv )
-import Maybes		( orElse )
-import DynFlags
-import WwLib
-import Util		( lengthIs, notNull )
-import Outputable
-\end{code}
-
-We take Core bindings whose binders have:
-
-\begin{enumerate}
-
-\item Strictness attached (by the front-end of the strictness
-analyser), and / or
-
-\item Constructed Product Result information attached by the CPR
-analysis pass.
-
-\end{enumerate}
-
-and we return some ``plain'' bindings which have been
-worker/wrapper-ified, meaning: 
-
-\begin{enumerate} 
-
-\item Functions have been split into workers and wrappers where
-appropriate.  If a function has both strictness and CPR properties
-then only one worker/wrapper doing both transformations is produced;
-
-\item Binders' @IdInfos@ have been updated to reflect the existence of
-these workers/wrappers (this is where we get STRICTNESS and CPR pragma
-info for exported values).
-\end{enumerate}
-
-\begin{code}
-
-wwTopBinds :: DynFlags 
-	   -> UniqSupply
-	   -> [CoreBind]
-	   -> IO [CoreBind]
-
-wwTopBinds dflags us binds
-  = do {
-	showPass dflags "Worker Wrapper binds";
-
-	-- Create worker/wrappers, and mark binders with their
-	-- "strictness info" [which encodes their worker/wrapper-ness]
-	let { binds' = workersAndWrappers us binds };
-
-	endPass dflags "Worker Wrapper binds" 
-		Opt_D_dump_worker_wrapper binds'
-    }
-\end{code}
-
-
-\begin{code}
-workersAndWrappers :: UniqSupply -> [CoreBind] -> [CoreBind]
-
-workersAndWrappers us top_binds
-  = initUs_ us $
-    mapUs wwBind top_binds `thenUs` \ top_binds' ->
-    returnUs (concat top_binds')
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[wwBind-wwExpr]{@wwBind@ and @wwExpr@}
-%*									*
-%************************************************************************
-
-@wwBind@ works on a binding, trying each \tr{(binder, expr)} pair in
-turn.  Non-recursive case first, then recursive...
-
-\begin{code}
-wwBind	:: CoreBind
-	-> UniqSM [CoreBind]	-- returns a WwBinding intermediate form;
-				-- the caller will convert to Expr/Binding,
-				-- as appropriate.
-
-wwBind (NonRec binder rhs)
-  = wwExpr rhs				`thenUs` \ new_rhs ->
-    tryWW NonRecursive binder new_rhs 	`thenUs` \ new_pairs ->
-    returnUs [NonRec b e | (b,e) <- new_pairs]
-      -- Generated bindings must be non-recursive
-      -- because the original binding was.
-
-wwBind (Rec pairs)
-  = mapUs do_one pairs		`thenUs` \ new_pairs ->
-    returnUs [Rec (concat new_pairs)]
-  where
-    do_one (binder, rhs) = wwExpr rhs 	`thenUs` \ new_rhs ->
-			   tryWW Recursive binder new_rhs
-\end{code}
-
-@wwExpr@ basically just walks the tree, looking for appropriate
-annotations that can be used. Remember it is @wwBind@ that does the
-matching by looking for strict arguments of the correct type.
-@wwExpr@ is a version that just returns the ``Plain'' Tree.
-
-\begin{code}
-wwExpr :: CoreExpr -> UniqSM CoreExpr
-
-wwExpr e@(Type _)   	      = returnUs e
-wwExpr e@(Lit _)    	      = returnUs e
-wwExpr e@(Note InlineMe expr) = returnUs e
-	-- Don't w/w inside InlineMe's
-
-wwExpr e@(Var v)
-  | v `hasKey` lazyIdKey = returnUs lazyIdUnfolding
-  | otherwise            = returnUs e
-	-- Inline 'lazy' after strictness analysis
-	-- (but not inside InlineMe's)
-
-wwExpr (Lam binder expr)
-  = wwExpr expr			`thenUs` \ new_expr ->
-    returnUs (Lam binder new_expr)
-
-wwExpr (App f a)
-  = wwExpr f			`thenUs` \ new_f ->
-    wwExpr a			`thenUs` \ new_a ->
-    returnUs (App new_f new_a)
-
-wwExpr (Note note expr)
-  = wwExpr expr			`thenUs` \ new_expr ->
-    returnUs (Note note new_expr)
-
-wwExpr (Let bind expr)
-  = wwBind bind			`thenUs` \ intermediate_bind ->
-    wwExpr expr			`thenUs` \ new_expr ->
-    returnUs (mkLets intermediate_bind new_expr)
-
-wwExpr (Case expr binder ty alts)
-  = wwExpr expr				`thenUs` \ new_expr ->
-    mapUs ww_alt alts			`thenUs` \ new_alts ->
-    returnUs (Case new_expr binder ty new_alts)
-  where
-    ww_alt (con, binders, rhs)
-      =	wwExpr rhs			`thenUs` \ new_rhs ->
-	returnUs (con, binders, new_rhs)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[tryWW]{@tryWW@: attempt a worker/wrapper pair}
-%*									*
-%************************************************************************
-
-@tryWW@ just accumulates arguments, converts strictness info from the
-front-end into the proper form, then calls @mkWwBodies@ to do
-the business.
-
-We have to BE CAREFUL that we don't worker-wrapperize an Id that has
-already been w-w'd!  (You can end up with several liked-named Ids
-bouncing around at the same time---absolute mischief.)  So the
-criterion we use is: if an Id already has an unfolding (for whatever
-reason), then we don't w-w it.
-
-The only reason this is monadised is for the unique supply.
-
-\begin{code}
-tryWW	:: RecFlag
-	-> Id				-- The fn binder
-	-> CoreExpr			-- The bound rhs; its innards
-					--   are already ww'd
-	-> UniqSM [(Id, CoreExpr)]	-- either *one* or *two* pairs;
-					-- if one, then no worker (only
-					-- the orig "wrapper" lives on);
-					-- if two, then a worker and a
-					-- wrapper.
-tryWW is_rec fn_id rhs
-  |  isNonRec is_rec && certainlyWillInline unfolding
-	-- No point in worker/wrappering a function that is going to be
-	-- INLINEd wholesale anyway.  If the strictness analyser is run
-	-- twice, this test also prevents wrappers (which are INLINEd)
-	-- from being re-done.
-	--	
-	-- It's very important to refrain from w/w-ing an INLINE function
-	-- If we do so by mistake we transform
-	--	f = __inline (\x -> E)
-	-- into
-	--	f = __inline (\x -> case x of (a,b) -> fw E)
-	--	fw = \ab -> (__inline (\x -> E)) (a,b)
-	-- and the original __inline now vanishes, so E is no longer
-	-- inside its __inline wrapper.  Death!  Disaster!
-  = returnUs [ (new_fn_id, rhs) ]
-
-  | is_thunk && worthSplittingThunk maybe_fn_dmd res_info
-  = ASSERT2( isNonRec is_rec, ppr new_fn_id )	-- The thunk must be non-recursive
-    splitThunk new_fn_id rhs
-
-  | is_fun && worthSplittingFun wrap_dmds res_info
-  = splitFun new_fn_id fn_info wrap_dmds res_info inline_prag rhs
-
-  | otherwise
-  = returnUs [ (new_fn_id, rhs) ]
-
-  where
-    fn_info   	 = idInfo fn_id
-    maybe_fn_dmd = newDemandInfo fn_info
-    unfolding 	 = unfoldingInfo fn_info
-    inline_prag  = inlinePragInfo fn_info
-
-	-- In practice it always will have a strictness 
-	-- signature, even if it's a uninformative one
-    strict_sig  = newStrictnessInfo fn_info `orElse` topSig
-    StrictSig (DmdType env wrap_dmds res_info) = strict_sig
-
-	-- new_fn_id has the DmdEnv zapped.  
-	--	(a) it is never used again
-	--	(b) it wastes space
-	--	(c) it becomes incorrect as things are cloned, because
-	--	    we don't push the substitution into it
-    new_fn_id | isEmptyVarEnv env = fn_id
-	      | otherwise	  = fn_id `setIdNewStrictness` 
-				     StrictSig (mkTopDmdType wrap_dmds res_info)
-
-    is_fun    = notNull wrap_dmds
-    is_thunk  = not is_fun && not (exprIsHNF rhs)
-
----------------------
-splitFun fn_id fn_info wrap_dmds res_info inline_prag rhs
-  = WARN( not (wrap_dmds `lengthIs` arity), ppr fn_id <+> (ppr arity $$ ppr wrap_dmds $$ ppr res_info) )
-	-- The arity should match the signature
-    mkWwBodies fun_ty wrap_dmds res_info one_shots 	`thenUs` \ (work_demands, wrap_fn, work_fn) ->
-    getUniqueUs						`thenUs` \ work_uniq ->
-    let
-	work_rhs = work_fn rhs
-	work_id  = mkWorkerId work_uniq fn_id (exprType work_rhs) 
-			`setInlinePragma` inline_prag
-			`setIdNewStrictness` StrictSig (mkTopDmdType work_demands work_res_info)
-				-- Even though we may not be at top level, 
-				-- it's ok to give it an empty DmdEnv
-
-	wrap_rhs = wrap_fn work_id
-	wrap_id  = fn_id `setIdWorkerInfo` HasWorker work_id arity
-			 `setInlinePragma` AlwaysActive	-- Zap any inline pragma;
-							-- Put it on the worker instead
-    in
-    returnUs ([(work_id, work_rhs), (wrap_id, wrap_rhs)])
-	-- Worker first, because wrapper mentions it
-	-- mkWwBodies has already built a wrap_rhs with an INLINE pragma wrapped around it
-  where
-    fun_ty = idType fn_id
-
-    arity  = arityInfo fn_info	-- The arity is set by the simplifier using exprEtaExpandArity
-				-- So it may be more than the number of top-level-visible lambdas
-
-    work_res_info | isBotRes res_info = BotRes	-- Cpr stuff done by wrapper
-		  | otherwise	      = TopRes
-
-    one_shots = get_one_shots rhs
-
--- If the original function has one-shot arguments, it is important to
--- make the wrapper and worker have corresponding one-shot arguments too.
--- Otherwise we spuriously float stuff out of case-expression join points,
--- which is very annoying.
-get_one_shots (Lam b e)
-  | isId b    = isOneShotLambda b : get_one_shots e
-  | otherwise = get_one_shots e
-get_one_shots (Note _ e) = get_one_shots e
-get_one_shots other	 = noOneShotInfo
-\end{code}
-
-Thunk splitting
-~~~~~~~~~~~~~~~
-Suppose x is used strictly (never mind whether it has the CPR
-property).  
-
-      let
-	x* = x-rhs
-      in body
-
-splitThunk transforms like this:
-
-      let
-	x* = case x-rhs of { I# a -> I# a }
-      in body
-
-Now simplifier will transform to
-
-      case x-rhs of 
-	I# a ->	let x* = I# b 
-	        in body
-
-which is what we want. Now suppose x-rhs is itself a case:
-
-	x-rhs = case e of { T -> I# a; F -> I# b }
-
-The join point will abstract over a, rather than over (which is
-what would have happened before) which is fine.
-
-Notice that x certainly has the CPR property now!
-
-In fact, splitThunk uses the function argument w/w splitting 
-function, so that if x's demand is deeper (say U(U(L,L),L))
-then the splitting will go deeper too.
-
-\begin{code}
--- splitThunk converts the *non-recursive* binding
---	x = e
--- into
---	x = let x = e
---	    in case x of 
---		 I# y -> let x = I# y in x }
--- See comments above. Is it not beautifully short?
-
-splitThunk fn_id rhs
-  = mkWWstr [fn_id]		`thenUs` \ (_, wrap_fn, work_fn) ->
-    returnUs [ (fn_id, Let (NonRec fn_id rhs) (wrap_fn (work_fn (Var fn_id)))) ]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Functions over Demands}
-%*									*
-%************************************************************************
-
-\begin{code}
-worthSplittingFun :: [Demand] -> DmdResult -> Bool
-		-- True <=> the wrapper would not be an identity function
-worthSplittingFun ds res
-  = any worth_it ds || returnsCPR res
-	-- worthSplitting returns False for an empty list of demands,
-	-- and hence do_strict_ww is False if arity is zero and there is no CPR
-
-	-- We used not to split if the result is bottom.
-	-- [Justification:  there's no efficiency to be gained.]
-	-- But it's sometimes bad not to make a wrapper.  Consider
-	--	fw = \x# -> let x = I# x# in case e of
-	--					p1 -> error_fn x
-	--					p2 -> error_fn x
-	--					p3 -> the real stuff
-	-- The re-boxing code won't go away unless error_fn gets a wrapper too.
-	-- [We don't do reboxing now, but in general it's better to pass 
-	--  an unboxed thing to f, and have it reboxed in the error cases....]
-  where
-    worth_it Abs	      = True	-- Absent arg
-    worth_it (Eval (Prod ds)) = True	-- Product arg to evaluate
-    worth_it other	      = False
-
-worthSplittingThunk :: Maybe Demand	-- Demand on the thunk
-		    -> DmdResult	-- CPR info for the thunk
-		    -> Bool
-worthSplittingThunk maybe_dmd res
-  = worth_it maybe_dmd || returnsCPR res
-  where
-	-- Split if the thing is unpacked
-    worth_it (Just (Eval (Prod ds))) = not (all isAbsent ds)
-    worth_it other	   	     = False
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{The worker wrapper core}
-%*									*
-%************************************************************************
-
-@mkWrapper@ is called when importing a function.  We have the type of 
-the function and the name of its worker, and we want to make its body (the wrapper).
-
-\begin{code}
-mkWrapper :: Type		-- Wrapper type
-	  -> StrictSig		-- Wrapper strictness info
-	  -> UniqSM (Id -> CoreExpr)	-- Wrapper body, missing worker Id
-
-mkWrapper fun_ty (StrictSig (DmdType _ demands res_info))
-  = mkWwBodies fun_ty demands res_info noOneShotInfo	`thenUs` \ (_, wrap_fn, _) ->
-    returnUs wrap_fn
-
-noOneShotInfo = repeat False
-\end{code}
diff --git a/ghc/compiler/stranal/WwLib.lhs b/ghc/compiler/stranal/WwLib.lhs
deleted file mode 100644
index e44e521c83..0000000000
--- a/ghc/compiler/stranal/WwLib.lhs
+++ /dev/null
@@ -1,514 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-%
-\section[WwLib]{A library for the ``worker/wrapper'' back-end to the strictness analyser}
-
-\begin{code}
-module WwLib ( mkWwBodies, mkWWstr, mkWorkerArgs ) where
-
-#include "HsVersions.h"
-
-import CoreSyn
-import CoreUtils	( exprType )
-import Id		( Id, idType, mkSysLocal, idNewDemandInfo, setIdNewDemandInfo,
-			  isOneShotLambda, setOneShotLambda, setIdUnfolding,
-                          setIdInfo
-			)
-import IdInfo		( vanillaIdInfo )
-import DataCon		( splitProductType_maybe, splitProductType )
-import NewDemand	( Demand(..), DmdResult(..), Demands(..) ) 
-import MkId		( realWorldPrimId, voidArgId, mkRuntimeErrorApp, rUNTIME_ERROR_ID )
-import TysWiredIn	( tupleCon )
-import Type		( Type, isUnLiftedType, mkFunTys,
-			  splitForAllTys, splitFunTys, splitRecNewType_maybe, isAlgType
-			)
-import BasicTypes	( Boxity(..) )
-import Var              ( Var, isId )
-import UniqSupply	( returnUs, thenUs, getUniquesUs, UniqSM )
-import Util		( zipWithEqual, notNull )
-import Outputable
-import List		( zipWith4 )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[mkWrapperAndWorker]{@mkWrapperAndWorker@}
-%*									*
-%************************************************************************
-
-Here's an example.  The original function is:
-
-\begin{verbatim}
-g :: forall a . Int -> [a] -> a
-
-g = /\ a -> \ x ys ->
-	case x of
-	  0 -> head ys
-	  _ -> head (tail ys)
-\end{verbatim}
-
-From this, we want to produce:
-\begin{verbatim}
--- wrapper (an unfolding)
-g :: forall a . Int -> [a] -> a
-
-g = /\ a -> \ x ys ->
-	case x of
-	  I# x# -> $wg a x# ys
-	    -- call the worker; don't forget the type args!
-
--- worker
-$wg :: forall a . Int# -> [a] -> a
-
-$wg = /\ a -> \ x# ys ->
-	let
-	    x = I# x#
-	in
-	    case x of		    -- note: body of g moved intact
-	      0 -> head ys
-	      _ -> head (tail ys)
-\end{verbatim}
-
-Something we have to be careful about:  Here's an example:
-
-\begin{verbatim}
--- "f" strictness: U(P)U(P)
-f (I# a) (I# b) = a +# b
-
-g = f	-- "g" strictness same as "f"
-\end{verbatim}
-
-\tr{f} will get a worker all nice and friendly-like; that's good.
-{\em But we don't want a worker for \tr{g}}, even though it has the
-same strictness as \tr{f}.  Doing so could break laziness, at best.
-
-Consequently, we insist that the number of strictness-info items is
-exactly the same as the number of lambda-bound arguments.  (This is
-probably slightly paranoid, but OK in practice.)  If it isn't the
-same, we ``revise'' the strictness info, so that we won't propagate
-the unusable strictness-info into the interfaces.
-
-
-%************************************************************************
-%*									*
-\subsection{The worker wrapper core}
-%*									*
-%************************************************************************
-
-@mkWwBodies@ is called when doing the worker/wrapper split inside a module.
-
-\begin{code}
-mkWwBodies :: Type				-- Type of original function
-	   -> [Demand]				-- Strictness of original function
-	   -> DmdResult				-- Info about function result
-	   -> [Bool]				-- One-shot-ness of the function
-	   -> UniqSM ([Demand],			-- Demands for worker (value) args
-		      Id -> CoreExpr,		-- Wrapper body, lacking only the worker Id
-		      CoreExpr -> CoreExpr)	-- Worker body, lacking the original function rhs
-
--- wrap_fn_args E	= \x y -> E
--- work_fn_args E	= E x y
-
--- wrap_fn_str E 	= case x of { (a,b) -> 
---			  case a of { (a1,a2) ->
---			  E a1 a2 b y }}
--- work_fn_str E	= \a2 a2 b y ->
---			  let a = (a1,a2) in
---			  let x = (a,b) in
---			  E
-
-mkWwBodies fun_ty demands res_info one_shots
-  = mkWWargs fun_ty demands one_shots'	`thenUs` \ (wrap_args,   wrap_fn_args, work_fn_args, res_ty) ->
-    mkWWstr wrap_args			`thenUs` \ (work_args,   wrap_fn_str,  work_fn_str) ->
-    let
-	(work_lam_args, work_call_args) = mkWorkerArgs work_args res_ty
-    in
-	-- Don't do CPR if the worker doesn't have any value arguments
-	-- Then the worker is just a constant, so we don't want to unbox it.
-    (if any isId work_args then
-	mkWWcpr res_ty res_info
-     else
-	returnUs (id, id, res_ty)
-    )					`thenUs` \ (wrap_fn_cpr, work_fn_cpr,  cpr_res_ty) ->
-
-    returnUs ([idNewDemandInfo v | v <- work_args, isId v],
-	      Note InlineMe . wrap_fn_args . wrap_fn_cpr . wrap_fn_str . applyToVars work_call_args . Var,
-	      mkLams work_lam_args. work_fn_str . work_fn_cpr . work_fn_args)
-	-- We use an INLINE unconditionally, even if the wrapper turns out to be
-	-- something trivial like
-	--	fw = ...
-	--	f = __inline__ (coerce T fw)
-	-- The point is to propagate the coerce to f's call sites, so even though
-	-- f's RHS is now trivial (size 1) we still want the __inline__ to prevent
-	-- fw from being inlined into f's RHS
-  where
-    one_shots' = one_shots ++ repeat False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Making wrapper args}
-%*									*
-%************************************************************************
-
-During worker-wrapper stuff we may end up with an unlifted thing
-which we want to let-bind without losing laziness.  So we
-add a void argument.  E.g.
-
-	f = /\a -> \x y z -> E::Int#	-- E does not mention x,y,z
-==>
-	fw = /\ a -> \void -> E
-	f  = /\ a -> \x y z -> fw realworld
-
-We use the state-token type which generates no code.
-
-\begin{code}
-mkWorkerArgs :: [Var]
-	     -> Type	-- Type of body
-	     -> ([Var],	-- Lambda bound args
-		 [Var])	-- Args at call site
-mkWorkerArgs args res_ty
-    | any isId args || not (isUnLiftedType res_ty)
-    = (args, args)
-    | otherwise	
-    = (args ++ [voidArgId], args ++ [realWorldPrimId])
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Coercion stuff}
-%*									*
-%************************************************************************
-
-
-We really want to "look through" coerces.
-Reason: I've seen this situation:
-
-	let f = coerce T (\s -> E)
-	in \x -> case x of
-	   	    p -> coerce T' f
-		    q -> \s -> E2
-	   	    r -> coerce T' f
-
-If only we w/w'd f, we'd get
-	let f = coerce T (\s -> fw s)
-	    fw = \s -> E
-	in ...
-
-Now we'll inline f to get
-
-	let fw = \s -> E
-	in \x -> case x of
-	   	    p -> fw
-		    q -> \s -> E2
-	   	    r -> fw
-
-Now we'll see that fw has arity 1, and will arity expand
-the \x to get what we want.
-
-\begin{code}
--- mkWWargs is driven off the function type and arity.
--- It chomps bites off foralls, arrows, newtypes
--- and keeps repeating that until it's satisfied the supplied arity
-
-mkWWargs :: Type
-	 -> [Demand]
-	 -> [Bool]			-- True for a one-shot arg; ** may be infinite **
-	 -> UniqSM  ([Var],		-- Wrapper args
-		     CoreExpr -> CoreExpr,	-- Wrapper fn
-		     CoreExpr -> CoreExpr,	-- Worker fn
-		     Type)			-- Type of wrapper body
-
-mkWWargs fun_ty demands one_shots
-  | Just rep_ty <- splitRecNewType_maybe fun_ty
-   	-- The newtype case is for when the function has
-	-- a recursive newtype after the arrow (rare)
-	-- We check for arity >= 0 to avoid looping in the case
-	-- of a function whose type is, in effect, infinite
-	-- [Arity is driven by looking at the term, not just the type.]
-	--
-	-- It's also important when we have a function returning (say) a pair
-	-- wrapped in a recursive newtype, at least if CPR analysis can look 
-	-- through such newtypes, which it probably can since they are 
-	-- simply coerces.
-  = mkWWargs rep_ty demands one_shots	`thenUs` \ (wrap_args, wrap_fn_args, work_fn_args, res_ty) ->
-    returnUs (wrap_args,
-	      Note (Coerce fun_ty rep_ty) . wrap_fn_args,
-	      work_fn_args . Note (Coerce rep_ty fun_ty),
-	      res_ty)
-
-  | notNull demands
-  = getUniquesUs 		`thenUs` \ wrap_uniqs ->
-    let
-      (tyvars, tau)      = splitForAllTys fun_ty
-      (arg_tys, body_ty) = splitFunTys tau
-
-      n_demands	= length demands
-      n_arg_tys	= length arg_tys
-      n_args    = n_demands `min` n_arg_tys
-
-      new_fun_ty    = mkFunTys (drop n_demands arg_tys) body_ty
-      new_demands   = drop n_arg_tys demands
-      new_one_shots = drop n_args one_shots
-
-      val_args	= zipWith4 mk_wrap_arg wrap_uniqs arg_tys demands one_shots
-      wrap_args = tyvars ++ val_args
-    in
-{-     ASSERT( notNull tyvars || notNull arg_tys ) -}
-    if (null tyvars) && (null arg_tys) then
-	pprTrace "mkWWargs" (ppr fun_ty $$ ppr demands) 
-		returnUs ([], id, id, fun_ty)
-	else
-
-    mkWWargs new_fun_ty
-	     new_demands
-	     new_one_shots	`thenUs` \ (more_wrap_args, wrap_fn_args, work_fn_args, res_ty) ->
-
-    returnUs (wrap_args ++ more_wrap_args,
-	      mkLams wrap_args . wrap_fn_args,
-	      work_fn_args . applyToVars wrap_args,
-	      res_ty)
-
-  | otherwise
-  = returnUs ([], id, id, fun_ty)
-
-
-applyToVars :: [Var] -> CoreExpr -> CoreExpr
-applyToVars vars fn = mkVarApps fn vars
-
-mk_wrap_arg uniq ty dmd one_shot 
-  = set_one_shot one_shot (setIdNewDemandInfo (mkSysLocal FSLIT("w") uniq ty) dmd)
-  where
-    set_one_shot True  id = setOneShotLambda id
-    set_one_shot False id = id
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Strictness stuff}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkWWstr :: [Var]				-- Wrapper args; have their demand info on them
-						--  *Includes type variables*
-        -> UniqSM ([Var],			-- Worker args
-		   CoreExpr -> CoreExpr,	-- Wrapper body, lacking the worker call
-						-- and without its lambdas 
-						-- This fn adds the unboxing
-				
-		   CoreExpr -> CoreExpr)	-- Worker body, lacking the original body of the function,
-						-- and lacking its lambdas.
-						-- This fn does the reboxing
-
-----------------------
-nop_fn body = body
-
-----------------------
-mkWWstr []
-  = returnUs ([], nop_fn, nop_fn)
-
-mkWWstr (arg : args)
-  = mkWWstr_one arg		`thenUs` \ (args1, wrap_fn1, work_fn1) ->
-    mkWWstr args		`thenUs` \ (args2, wrap_fn2, work_fn2) ->
-    returnUs (args1 ++ args2, wrap_fn1 . wrap_fn2, work_fn1 . work_fn2)
-
-
-----------------------
--- mkWWstr_one wrap_arg = (work_args, wrap_fn, work_fn)
---   *  wrap_fn assumes wrap_arg is in scope,
---	  brings into scope work_args (via cases)
---   * work_fn assumes work_args are in scope, a
---	  brings into scope wrap_arg (via lets)
-
-mkWWstr_one arg
-  | isTyVar arg
-  = returnUs ([arg],  nop_fn, nop_fn)
-
-  | otherwise
-  = case idNewDemandInfo arg of
-
-	-- Absent case.  We don't deal with absence for unlifted types,
-	-- though, because it's not so easy to manufacture a placeholder
-	-- We'll see if this turns out to be a problem
-      Abs | not (isUnLiftedType (idType arg)) ->
-	returnUs ([], nop_fn, mk_absent_let arg) 
-
-	-- Unpack case
-      Eval (Prod cs)
-	| Just (arg_tycon, tycon_arg_tys, data_con, inst_con_arg_tys) 
-		<- splitProductType_maybe (idType arg)
-	-> getUniquesUs 		`thenUs` \ uniqs ->
-	   let
-	     unpk_args	    = zipWith mk_ww_local uniqs inst_con_arg_tys
-	     unpk_args_w_ds = zipWithEqual "mkWWstr" set_worker_arg_info unpk_args cs
-	     unbox_fn       = mk_unpk_case arg unpk_args data_con arg_tycon
-	     rebox_fn	    = Let (NonRec arg con_app) 
-	     con_app	    = mkConApp data_con (map Type tycon_arg_tys ++ map Var unpk_args)
-	   in
-	   mkWWstr unpk_args_w_ds		`thenUs` \ (worker_args, wrap_fn, work_fn) ->
-	   returnUs (worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn)
-	  		   -- Don't pass the arg, rebox instead
-
-	-- `seq` demand; evaluate in wrapper in the hope
-	-- of dropping seqs in the worker
-      Eval (Poly Abs)
-	-> let
-		arg_w_unf = arg `setIdUnfolding` evaldUnfolding
-		-- Tell the worker arg that it's sure to be evaluated
-		-- so that internal seqs can be dropped
-	   in
-	   returnUs ([arg_w_unf], mk_seq_case arg, nop_fn)
-	  	-- Pass the arg, anyway, even if it is in theory discarded
-		-- Consider
-		--	f x y = x `seq` y
-		-- x gets a (Eval (Poly Abs)) demand, but if we fail to pass it to the worker
-		-- we ABSOLUTELY MUST record that x is evaluated in the wrapper.
-		-- Something like:
-		--	f x y = x `seq` fw y
-		--	fw y = let x{Evald} = error "oops" in (x `seq` y)
-		-- If we don't pin on the "Evald" flag, the seq doesn't disappear, and
-		-- we end up evaluating the absent thunk.
-		-- But the Evald flag is pretty weird, and I worry that it might disappear
-		-- during simplification, so for now I've just nuked this whole case
-			
-	-- Other cases
-      other_demand -> returnUs ([arg], nop_fn, nop_fn)
-
-  where
-	-- If the wrapper argument is a one-shot lambda, then
-	-- so should (all) the corresponding worker arguments be
-	-- This bites when we do w/w on a case join point
-    set_worker_arg_info worker_arg demand = set_one_shot (setIdNewDemandInfo worker_arg demand)
-
-    set_one_shot | isOneShotLambda arg = setOneShotLambda
-		 | otherwise	       = \x -> x
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{CPR stuff}
-%*									*
-%************************************************************************
-
-
-@mkWWcpr@ takes the worker/wrapper pair produced from the strictness
-info and adds in the CPR transformation.  The worker returns an
-unboxed tuple containing non-CPR components.  The wrapper takes this
-tuple and re-produces the correct structured output.
-
-The non-CPR results appear ordered in the unboxed tuple as if by a
-left-to-right traversal of the result structure.
-
-
-\begin{code}
-mkWWcpr :: Type                              -- function body type
-        -> DmdResult                         -- CPR analysis results
-        -> UniqSM (CoreExpr -> CoreExpr,             -- New wrapper 
-                   CoreExpr -> CoreExpr,	     -- New worker
-		   Type)			-- Type of worker's body 
-
-mkWWcpr body_ty RetCPR
-    | not (isAlgType body_ty)
-    = WARN( True, text "mkWWcpr: non-algebraic body type" <+> ppr body_ty )
-      returnUs (id, id, body_ty)
-
-    | n_con_args == 1 && isUnLiftedType con_arg_ty1
-	-- Special case when there is a single result of unlifted type
-	--
-	-- Wrapper:	case (..call worker..) of x -> C x
-	-- Worker:	case (   ..body..    ) of C x -> x
-    = getUniquesUs 			`thenUs` \ (work_uniq : arg_uniq : _) ->
-      let
-	work_wild = mk_ww_local work_uniq body_ty
-	arg	  = mk_ww_local arg_uniq  con_arg_ty1
-	con_app   = mkConApp data_con (map Type tycon_arg_tys ++ [Var arg])
-      in
-      returnUs (\ wkr_call -> Case wkr_call arg (exprType con_app) [(DEFAULT, [], con_app)],
-		\ body     -> workerCase body work_wild con_arg_ty1 [(DataAlt data_con, [arg], Var arg)],
-		con_arg_ty1)
-
-    | otherwise		-- The general case
-	-- Wrapper: case (..call worker..) of (# a, b #) -> C a b
-	-- Worker:  case (   ...body...  ) of C a b -> (# a, b #)     
-    = getUniquesUs 	  	`thenUs` \ uniqs ->
-      let
-        (wrap_wild : work_wild : args) = zipWith mk_ww_local uniqs (ubx_tup_ty : body_ty : con_arg_tys)
-	arg_vars		       = map Var args
-	ubx_tup_con		       = tupleCon Unboxed n_con_args
-	ubx_tup_ty		       = exprType ubx_tup_app
-	ubx_tup_app		       = mkConApp ubx_tup_con (map Type con_arg_tys   ++ arg_vars)
-        con_app			       = mkConApp data_con    (map Type tycon_arg_tys ++ arg_vars)
-      in
-      returnUs (\ wkr_call -> Case wkr_call wrap_wild (exprType con_app)  [(DataAlt ubx_tup_con, args, con_app)],
-		\ body     -> workerCase body work_wild ubx_tup_ty [(DataAlt data_con,    args, ubx_tup_app)],
-		ubx_tup_ty)
-    where
-      (_, tycon_arg_tys, data_con, con_arg_tys) = splitProductType "mkWWcpr" body_ty
-      n_con_args  = length con_arg_tys
-      con_arg_ty1 = head con_arg_tys
-
-mkWWcpr body_ty other		-- No CPR info
-    = returnUs (id, id, body_ty)
-
--- If the original function looked like
---	f = \ x -> _scc_ "foo" E
---
--- then we want the CPR'd worker to look like
---	\ x -> _scc_ "foo" (case E of I# x -> x)
--- and definitely not
---	\ x -> case (_scc_ "foo" E) of I# x -> x)
---
--- This transform doesn't move work or allocation
--- from one cost centre to another
-
-workerCase (Note (SCC cc) e) arg ty alts = Note (SCC cc) (Case e arg ty alts)
-workerCase e		     arg ty alts = Case e arg ty alts
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Utilities}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-mk_absent_let arg body
-  | not (isUnLiftedType arg_ty)
-  = Let (NonRec arg abs_rhs) body
-  | otherwise
-  = panic "WwLib: haven't done mk_absent_let for primitives yet"
-  where
-    arg_ty = idType arg
-    abs_rhs = mkRuntimeErrorApp rUNTIME_ERROR_ID arg_ty msg
-    msg     = "Oops!  Entered absent arg " ++ showSDocDebug (ppr arg <+> ppr (idType arg))
-
-mk_unpk_case arg unpk_args boxing_con boxing_tycon body
-	-- A data type
-  = Case (Var arg) 
-	 (sanitiseCaseBndr arg)
-         (exprType body)
-	 [(DataAlt boxing_con, unpk_args, body)]
-
-mk_seq_case arg body = Case (Var arg) (sanitiseCaseBndr arg) (exprType body) [(DEFAULT, [], body)]
-
-sanitiseCaseBndr :: Id -> Id
--- The argument we are scrutinising has the right type to be
--- a case binder, so it's convenient to re-use it for that purpose.
--- But we *must* throw away all its IdInfo.  In particular, the argument
--- will have demand info on it, and that demand info may be incorrect for
--- the case binder.  e.g.  	case ww_arg of ww_arg { I# x -> ... }
--- Quite likely ww_arg isn't used in '...'.  The case may get discarded
--- if the case binder says "I'm demanded".  This happened in a situation 
--- like		(x+y) `seq` ....
-sanitiseCaseBndr id = id `setIdInfo` vanillaIdInfo
-
-mk_ww_local uniq ty = mkSysLocal FSLIT("ww") uniq ty
-\end{code}
diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
deleted file mode 100644
index 8768e20250..0000000000
--- a/ghc/compiler/typecheck/Inst.lhs
+++ /dev/null
@@ -1,790 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Inst]{The @Inst@ type: dictionaries or method instances}
-
-\begin{code}
-module Inst ( 
-	Inst, 
-
-	pprInstances, pprDictsTheta, pprDictsInFull,	-- User error messages
-	showLIE, pprInst, pprInsts, pprInstInFull,	-- Debugging messages
-
-	tidyInsts, tidyMoreInsts,
-
-	newDicts, newDictAtLoc, newDictsAtLoc, cloneDict, 
-	shortCutFracLit, shortCutIntLit, newIPDict, 
-	newMethod, newMethodFromName, newMethodWithGivenTy, 
-	tcInstClassOp, tcInstStupidTheta,
-	tcSyntaxName, isHsVar,
-
-	tyVarsOfInst, tyVarsOfInsts, tyVarsOfLIE, 
-	ipNamesOfInst, ipNamesOfInsts, fdPredsOfInst, fdPredsOfInsts,
-	instLoc, getDictClassTys, dictPred,
-
-	lookupInst, LookupInstResult(..), lookupPred, 
-	tcExtendLocalInstEnv, tcGetInstEnvs, getOverlapFlag,
-
-	isDict, isClassDict, isMethod, 
-	isLinearInst, linearInstType, isIPDict, isInheritableInst,
-	isTyVarDict, isMethodFor, 
-
-	zonkInst, zonkInsts,
-	instToId, instName,
-
-	InstOrigin(..), InstLoc(..), pprInstLoc
-    ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-}	TcExpr( tcPolyExpr )
-
-import HsSyn	( HsLit(..), HsOverLit(..), HsExpr(..), LHsExpr, mkHsApp,
-		  nlHsLit, nlHsVar )
-import TcHsSyn	( mkHsTyApp, mkHsDictApp, zonkId )
-import TcRnMonad
-import TcEnv	( tcLookupId, checkWellStaged, topIdLvl, tcMetaTy )
-import InstEnv	( DFunId, InstEnv, Instance(..), OverlapFlag(..),
-		  lookupInstEnv, extendInstEnv, pprInstances, 
-		  instanceHead, instanceDFunId, setInstanceDFunId )
-import FunDeps	( checkFunDeps )
-import TcMType	( zonkTcType, zonkTcTypes, zonkTcPredType, zonkTcThetaType, 
-		  tcInstTyVar, tcInstSkolType
-		)
-import TcType	( Type, TcType, TcThetaType, TcTyVarSet, TcPredType,
-		  BoxyRhoType,
-		  PredType(..), SkolemInfo(..), typeKind, mkSigmaTy,
-		  tcSplitForAllTys, applyTys, 
-		  tcSplitPhiTy, tcSplitDFunHead,
-		  isIntTy,isFloatTy, isIntegerTy, isDoubleTy,
-		  mkPredTy, mkTyVarTys,
-		  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tidyPred,
-		  isClassPred, isTyVarClassPred, isLinearPred, 
-		  getClassPredTys, mkPredName,
-		  isInheritablePred, isIPPred, 
-		  tidyType, tidyTypes, tidyFreeTyVars, tcSplitSigmaTy, 
-		  pprPred, pprParendType, pprTheta 
-		)
-import Type	( TvSubst, substTy, substTyVar, substTyWith, substTheta, zipTopTvSubst,
-		  notElemTvSubst, extendTvSubstList )
-import Unify	( tcMatchTys )
-import Kind	( isSubKind )
-import Packages	( isHomeModule )
-import HscTypes	( ExternalPackageState(..) )
-import CoreFVs	( idFreeTyVars )
-import DataCon	( DataCon, dataConTyVars, dataConStupidTheta, dataConName, dataConWrapId )
-import Id	( Id, idName, idType, mkUserLocal, mkLocalId )
-import Name	( Name, mkMethodOcc, getOccName, getSrcLoc, nameModule,
-		  isInternalName, setNameUnique )
-import NameSet	( addOneToNameSet )
-import Literal	( inIntRange )
-import Var	( TyVar, tyVarKind, setIdType )
-import VarEnv	( TidyEnv, emptyTidyEnv )
-import VarSet	( elemVarSet, emptyVarSet, unionVarSet, mkVarSet )
-import TysWiredIn ( floatDataCon, doubleDataCon )
-import PrelNames	( integerTyConName, fromIntegerName, fromRationalName, rationalTyConName )
-import BasicTypes( IPName(..), mapIPName, ipNameName )
-import UniqSupply( uniqsFromSupply )
-import SrcLoc	( mkSrcSpan, noLoc, unLoc, Located(..) )
-import DynFlags	( DynFlag(..), dopt )
-import Maybes	( isJust )
-import Outputable
-\end{code}
-
-
-Selection
-~~~~~~~~~
-\begin{code}
-instName :: Inst -> Name
-instName inst = idName (instToId inst)
-
-instToId :: Inst -> TcId
-instToId (LitInst nm _ ty _) = mkLocalId nm ty
-instToId (Dict nm pred _)    = mkLocalId nm (mkPredTy pred)
-instToId (Method id _ _ _ _) = id
-
-instLoc (Dict _ _       loc) = loc
-instLoc (Method _ _ _ _ loc) = loc
-instLoc (LitInst _ _ _  loc) = loc
-
-dictPred (Dict _ pred _ ) = pred
-dictPred inst		  = pprPanic "dictPred" (ppr inst)
-
-getDictClassTys (Dict _ pred _) = getClassPredTys pred
-
--- fdPredsOfInst is used to get predicates that contain functional 
--- dependencies *or* might do so.  The "might do" part is because
--- a constraint (C a b) might have a superclass with FDs
--- Leaving these in is really important for the call to fdPredsOfInsts
--- in TcSimplify.inferLoop, because the result is fed to 'grow',
--- which is supposed to be conservative
-fdPredsOfInst (Dict _ pred _) 	     = [pred]
-fdPredsOfInst (Method _ _ _ theta _) = theta
-fdPredsOfInst other		     = []	-- LitInsts etc
-
-fdPredsOfInsts :: [Inst] -> [PredType]
-fdPredsOfInsts insts = concatMap fdPredsOfInst insts
-
-isInheritableInst (Dict _ pred _) 	 = isInheritablePred pred
-isInheritableInst (Method _ _ _ theta _) = all isInheritablePred theta
-isInheritableInst other			 = True
-
-
-ipNamesOfInsts :: [Inst] -> [Name]
-ipNamesOfInst  :: Inst   -> [Name]
--- Get the implicit parameters mentioned by these Insts
--- NB: ?x and %x get different Names
-ipNamesOfInsts insts = [n | inst <- insts, n <- ipNamesOfInst inst]
-
-ipNamesOfInst (Dict _ (IParam n _) _) = [ipNameName n]
-ipNamesOfInst (Method _ _ _ theta _)  = [ipNameName n | IParam n _ <- theta]
-ipNamesOfInst other		      = []
-
-tyVarsOfInst :: Inst -> TcTyVarSet
-tyVarsOfInst (LitInst _ _ ty _)    = tyVarsOfType  ty
-tyVarsOfInst (Dict _ pred _)       = tyVarsOfPred pred
-tyVarsOfInst (Method _ id tys _ _) = tyVarsOfTypes tys `unionVarSet` idFreeTyVars id
-					 -- The id might have free type variables; in the case of
-					 -- locally-overloaded class methods, for example
-
-
-tyVarsOfInsts insts = foldr (unionVarSet . tyVarsOfInst) emptyVarSet insts
-tyVarsOfLIE   lie   = tyVarsOfInsts (lieToList lie)
-\end{code}
-
-Predicates
-~~~~~~~~~~
-\begin{code}
-isDict :: Inst -> Bool
-isDict (Dict _ _ _) = True
-isDict other	    = False
-
-isClassDict :: Inst -> Bool
-isClassDict (Dict _ pred _) = isClassPred pred
-isClassDict other	    = False
-
-isTyVarDict :: Inst -> Bool
-isTyVarDict (Dict _ pred _) = isTyVarClassPred pred
-isTyVarDict other	    = False
-
-isIPDict :: Inst -> Bool
-isIPDict (Dict _ pred _) = isIPPred pred
-isIPDict other		 = False
-
-isMethod :: Inst -> Bool
-isMethod (Method {}) = True
-isMethod other	     = False
-
-isMethodFor :: TcIdSet -> Inst -> Bool
-isMethodFor ids (Method uniq id tys _ loc) = id `elemVarSet` ids
-isMethodFor ids inst			   = False
-
-isLinearInst :: Inst -> Bool
-isLinearInst (Dict _ pred _) = isLinearPred pred
-isLinearInst other	     = False
-	-- We never build Method Insts that have
-	-- linear implicit paramters in them.
-	-- Hence no need to look for Methods
-	-- See TcExpr.tcId 
-
-linearInstType :: Inst -> TcType	-- %x::t  -->  t
-linearInstType (Dict _ (IParam _ ty) _) = ty
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Building dictionaries}
-%*									*
-%************************************************************************
-
-\begin{code}
-newDicts :: InstOrigin
-	 -> TcThetaType
-	 -> TcM [Inst]
-newDicts orig theta
-  = getInstLoc orig		`thenM` \ loc ->
-    newDictsAtLoc loc theta
-
-cloneDict :: Inst -> TcM Inst
-cloneDict (Dict nm ty loc) = newUnique	`thenM` \ uniq ->
-			     returnM (Dict (setNameUnique nm uniq) ty loc)
-
-newDictAtLoc :: InstLoc -> TcPredType -> TcM Inst
-newDictAtLoc inst_loc pred
-  = do	{ uniq <- newUnique
-  	; return (mkDict inst_loc uniq pred) }
-
-newDictsAtLoc :: InstLoc -> TcThetaType -> TcM [Inst]
-newDictsAtLoc inst_loc theta
-  = newUniqueSupply		`thenM` \ us ->
-    returnM (zipWith (mkDict inst_loc) (uniqsFromSupply us) theta)
-
-mkDict inst_loc uniq pred
-  = Dict name pred inst_loc
-  where
-    name = mkPredName uniq (instLocSrcLoc inst_loc) pred 
-
--- For vanilla implicit parameters, there is only one in scope
--- at any time, so we used to use the name of the implicit parameter itself
--- But with splittable implicit parameters there may be many in 
--- scope, so we make up a new name.
-newIPDict :: InstOrigin -> IPName Name -> Type 
-	  -> TcM (IPName Id, Inst)
-newIPDict orig ip_name ty
-  = getInstLoc orig			`thenM` \ inst_loc ->
-    newUnique				`thenM` \ uniq ->
-    let
-	pred = IParam ip_name ty
-        name = mkPredName uniq (instLocSrcLoc inst_loc) pred 
-	dict = Dict name pred inst_loc
-    in
-    returnM (mapIPName (\n -> instToId dict) ip_name, dict)
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Building methods (calls of overloaded functions)}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-tcInstStupidTheta :: DataCon -> [TcType] -> TcM ()
--- Instantiate the "stupid theta" of the data con, and throw 
--- the constraints into the constraint set
-tcInstStupidTheta data_con inst_tys
-  | null stupid_theta
-  = return ()
-  | otherwise
-  = do	{ stupid_dicts <- newDicts (OccurrenceOf (dataConName data_con))
-				   (substTheta tenv stupid_theta)
-	; extendLIEs stupid_dicts }
-  where
-    stupid_theta = dataConStupidTheta data_con
-    tenv = zipTopTvSubst (dataConTyVars data_con) inst_tys
-
-newMethodFromName :: InstOrigin -> BoxyRhoType -> Name -> TcM TcId
-newMethodFromName origin ty name
-  = tcLookupId name		`thenM` \ id ->
-	-- Use tcLookupId not tcLookupGlobalId; the method is almost
-	-- always a class op, but with -fno-implicit-prelude GHC is
-	-- meant to find whatever thing is in scope, and that may
-	-- be an ordinary function. 
-    getInstLoc origin		`thenM` \ loc ->
-    tcInstClassOp loc id [ty]	`thenM` \ inst ->
-    extendLIE inst		`thenM_`
-    returnM (instToId inst)
-
-newMethodWithGivenTy orig id tys
-  = getInstLoc orig		`thenM` \ loc ->
-    newMethod loc id tys	`thenM` \ inst ->
-    extendLIE inst		`thenM_`
-    returnM (instToId inst)
-
---------------------------------------------
--- tcInstClassOp, and newMethod do *not* drop the 
--- Inst into the LIE; they just returns the Inst
--- This is important because they are used by TcSimplify
--- to simplify Insts
-
--- NB: the kind of the type variable to be instantiated
---     might be a sub-kind of the type to which it is applied,
---     notably when the latter is a type variable of kind ??
---     Hence the call to checkKind
--- A worry: is this needed anywhere else?
-tcInstClassOp :: InstLoc -> Id -> [TcType] -> TcM Inst
-tcInstClassOp inst_loc sel_id tys
-  = let
-	(tyvars, _rho) = tcSplitForAllTys (idType sel_id)
-    in
-    zipWithM_ checkKind tyvars tys	`thenM_` 
-    newMethod inst_loc sel_id tys
-
-checkKind :: TyVar -> TcType -> TcM ()
--- Ensure that the type has a sub-kind of the tyvar
-checkKind tv ty
-  = do	{ let ty1 = ty 
-		-- ty1 <- zonkTcType ty
-	; if typeKind ty1 `isSubKind` tyVarKind tv
-	  then return ()
-	  else 
-
-    pprPanic "checkKind: adding kind constraint" 
-	     (vcat [ppr tv <+> ppr (tyVarKind tv), 
-	            ppr ty <+> ppr ty1 <+> ppr (typeKind ty1)])
-	}
---    do	{ tv1 <- tcInstTyVar tv
---	; unifyType ty1 (mkTyVarTy tv1) } }
-
-
----------------------------
-newMethod inst_loc id tys
-  = newUnique		`thenM` \ new_uniq ->
-    let
-	(theta,tau) = tcSplitPhiTy (applyTys (idType id) tys)
-	meth_id	    = mkUserLocal (mkMethodOcc (getOccName id)) new_uniq tau loc
-	inst        = Method meth_id id tys theta inst_loc
-	loc         = instLocSrcLoc inst_loc
-    in
-    returnM inst
-\end{code}
-
-\begin{code}
-shortCutIntLit :: Integer -> TcType -> Maybe (HsExpr TcId)
-shortCutIntLit i ty
-  | isIntTy ty && inIntRange i 		-- Short cut for Int
-  = Just (HsLit (HsInt i))
-  | isIntegerTy ty 			-- Short cut for Integer
-  = Just (HsLit (HsInteger i ty))
-  | otherwise = Nothing
-
-shortCutFracLit :: Rational -> TcType -> Maybe (HsExpr TcId)
-shortCutFracLit f ty
-  | isFloatTy ty 
-  = Just (mk_lit floatDataCon (HsFloatPrim f))
-  | isDoubleTy ty
-  = Just (mk_lit doubleDataCon (HsDoublePrim f))
-  | otherwise = Nothing
-  where
-    mk_lit con lit = HsApp (nlHsVar (dataConWrapId con)) (nlHsLit lit)
-
-mkIntegerLit :: Integer -> TcM (LHsExpr TcId)
-mkIntegerLit i
-  = tcMetaTy integerTyConName 	`thenM` \ integer_ty ->
-    getSrcSpanM			`thenM` \ span -> 
-    returnM (L span $ HsLit (HsInteger i integer_ty))
-
-mkRatLit :: Rational -> TcM (LHsExpr TcId)
-mkRatLit r
-  = tcMetaTy rationalTyConName 	`thenM` \ rat_ty ->
-    getSrcSpanM			`thenM` \ span -> 
-    returnM (L span $ HsLit (HsRat r rat_ty))
-
-isHsVar :: HsExpr Name -> Name -> Bool
-isHsVar (HsVar f) g = f==g
-isHsVar other 	  g = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Zonking}
-%*									*
-%************************************************************************
-
-Zonking makes sure that the instance types are fully zonked.
-
-\begin{code}
-zonkInst :: Inst -> TcM Inst
-zonkInst (Dict name pred loc)
-  = zonkTcPredType pred			`thenM` \ new_pred ->
-    returnM (Dict name new_pred loc)
-
-zonkInst (Method m id tys theta loc) 
-  = zonkId id			`thenM` \ new_id ->
-	-- Essential to zonk the id in case it's a local variable
-	-- Can't use zonkIdOcc because the id might itself be
-	-- an InstId, in which case it won't be in scope
-
-    zonkTcTypes tys		`thenM` \ new_tys ->
-    zonkTcThetaType theta	`thenM` \ new_theta ->
-    returnM (Method m new_id new_tys new_theta loc)
-
-zonkInst (LitInst nm lit ty loc)
-  = zonkTcType ty			`thenM` \ new_ty ->
-    returnM (LitInst nm lit new_ty loc)
-
-zonkInsts insts = mappM zonkInst insts
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Printing}
-%*									*
-%************************************************************************
-
-ToDo: improve these pretty-printing things.  The ``origin'' is really only
-relevant in error messages.
-
-\begin{code}
-instance Outputable Inst where
-    ppr inst = pprInst inst
-
-pprDictsTheta :: [Inst] -> SDoc
--- Print in type-like fashion (Eq a, Show b)
-pprDictsTheta dicts = pprTheta (map dictPred dicts)
-
-pprDictsInFull :: [Inst] -> SDoc
--- Print in type-like fashion, but with source location
-pprDictsInFull dicts 
-  = vcat (map go dicts)
-  where
-    go dict = sep [quotes (ppr (dictPred dict)), nest 2 (pprInstLoc (instLoc dict))]
-
-pprInsts :: [Inst] -> SDoc
--- Debugging: print the evidence :: type
-pprInsts insts  = brackets (interpp'SP insts)
-
-pprInst, pprInstInFull :: Inst -> SDoc
--- Debugging: print the evidence :: type
-pprInst (LitInst nm lit ty loc) = ppr nm <+> dcolon <+> ppr ty
-pprInst (Dict nm pred loc)      = ppr nm <+> dcolon <+> pprPred pred
-
-pprInst m@(Method inst_id id tys theta loc)
-  = ppr inst_id <+> dcolon <+> 
-	braces (sep [ppr id <+> ptext SLIT("at"),
-		     brackets (sep (map pprParendType tys))])
-
-pprInstInFull inst
-  = sep [quotes (pprInst inst), nest 2 (pprInstLoc (instLoc inst))]
-
-tidyInst :: TidyEnv -> Inst -> Inst
-tidyInst env (LitInst nm lit ty loc) 	 = LitInst nm lit (tidyType env ty) loc
-tidyInst env (Dict nm pred loc)     	 = Dict nm (tidyPred env pred) loc
-tidyInst env (Method u id tys theta loc) = Method u id (tidyTypes env tys) theta loc
-
-tidyMoreInsts :: TidyEnv -> [Inst] -> (TidyEnv, [Inst])
--- This function doesn't assume that the tyvars are in scope
--- so it works like tidyOpenType, returning a TidyEnv
-tidyMoreInsts env insts
-  = (env', map (tidyInst env') insts)
-  where
-    env' = tidyFreeTyVars env (tyVarsOfInsts insts)
-
-tidyInsts :: [Inst] -> (TidyEnv, [Inst])
-tidyInsts insts = tidyMoreInsts emptyTidyEnv insts
-
-showLIE :: SDoc -> TcM ()	-- Debugging
-showLIE str
-  = do { lie_var <- getLIEVar ;
-	 lie <- readMutVar lie_var ;
-	 traceTc (str <+> vcat (map pprInstInFull (lieToList lie))) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Extending the instance environment
-%*									*
-%************************************************************************
-
-\begin{code}
-tcExtendLocalInstEnv :: [Instance] -> TcM a -> TcM a
-  -- Add new locally-defined instances
-tcExtendLocalInstEnv dfuns thing_inside
- = do { traceDFuns dfuns
-      ; env <- getGblEnv
-      ; inst_env' <- foldlM addLocalInst (tcg_inst_env env) dfuns
-      ; let env' = env { tcg_insts = dfuns ++ tcg_insts env,
-			 tcg_inst_env = inst_env' }
-      ; setGblEnv env' thing_inside }
-
-addLocalInst :: InstEnv -> Instance -> TcM InstEnv
--- Check that the proposed new instance is OK, 
--- and then add it to the home inst env
-addLocalInst home_ie ispec
-  = do	{ 	-- Instantiate the dfun type so that we extend the instance
-		-- envt with completely fresh template variables
-		-- This is important because the template variables must
-		-- not overlap with anything in the things being looked up
-		-- (since we do unification).  
-		-- We use tcInstSkolType because we don't want to allocate fresh
-		--  *meta* type variables.  
-	  let dfun = instanceDFunId ispec
-	; (tvs', theta', tau') <- tcInstSkolType (InstSkol dfun) (idType dfun)
-	; let	(cls, tys') = tcSplitDFunHead tau'
-		dfun' 	    = setIdType dfun (mkSigmaTy tvs' theta' tau')	    
-	  	ispec'      = setInstanceDFunId ispec dfun'
-
-		-- Load imported instances, so that we report
-		-- duplicates correctly
-	; eps <- getEps
-	; let inst_envs = (eps_inst_env eps, home_ie)
-
-		-- Check functional dependencies
-	; case checkFunDeps inst_envs ispec' of
-		Just specs -> funDepErr ispec' specs
-		Nothing    -> return ()
-
-		-- Check for duplicate instance decls
-	; let { (matches, _) = lookupInstEnv inst_envs cls tys'
-	      ;	dup_ispecs = [ dup_ispec 
-			     | (_, dup_ispec) <- matches
-			     , let (_,_,_,dup_tys) = instanceHead dup_ispec
-			     , isJust (tcMatchTys (mkVarSet tvs') tys' dup_tys)] }
-		-- Find memebers of the match list which ispec itself matches.
-		-- If the match is 2-way, it's a duplicate
-	; case dup_ispecs of
-	    dup_ispec : _ -> dupInstErr ispec' dup_ispec
-	    []            -> return ()
-
-		-- OK, now extend the envt
-	; return (extendInstEnv home_ie ispec') }
-
-getOverlapFlag :: TcM OverlapFlag
-getOverlapFlag 
-  = do 	{ dflags <- getDOpts
-	; let overlap_ok    = dopt Opt_AllowOverlappingInstances dflags
-	      incoherent_ok = dopt Opt_AllowIncoherentInstances  dflags
-	      overlap_flag | incoherent_ok = Incoherent
-			   | overlap_ok    = OverlapOk
-			   | otherwise     = NoOverlap
-			   
-	; return overlap_flag }
-
-traceDFuns ispecs
-  = traceTc (hang (text "Adding instances:") 2 (vcat (map pp ispecs)))
-  where
-    pp ispec = ppr (instanceDFunId ispec) <+> colon <+> ppr ispec
-	-- Print the dfun name itself too
-
-funDepErr ispec ispecs
-  = addDictLoc ispec $
-    addErr (hang (ptext SLIT("Functional dependencies conflict between instance declarations:"))
-	       2 (pprInstances (ispec:ispecs)))
-dupInstErr ispec dup_ispec
-  = addDictLoc ispec $
-    addErr (hang (ptext SLIT("Duplicate instance declarations:"))
-	       2 (pprInstances [ispec, dup_ispec]))
-
-addDictLoc ispec thing_inside
-  = setSrcSpan (mkSrcSpan loc loc) thing_inside
-  where
-   loc = getSrcLoc ispec
-\end{code}
-    
-
-%************************************************************************
-%*									*
-\subsection{Looking up Insts}
-%*									*
-%************************************************************************
-
-\begin{code}
-data LookupInstResult
-  = NoInstance
-  | SimpleInst (LHsExpr TcId)		-- Just a variable, type application, or literal
-  | GenInst    [Inst] (LHsExpr TcId)	-- The expression and its needed insts
-
-lookupInst :: Inst -> TcM LookupInstResult
--- It's important that lookupInst does not put any new stuff into
--- the LIE.  Instead, any Insts needed by the lookup are returned in
--- the LookupInstResult, where they can be further processed by tcSimplify
-
-
--- Methods
-
-lookupInst inst@(Method _ id tys theta loc)
-  = newDictsAtLoc loc theta		`thenM` \ dicts ->
-    returnM (GenInst dicts (mkHsDictApp (mkHsTyApp (L span (HsVar id)) tys) (map instToId dicts)))
-  where
-    span = instLocSrcSpan loc
-
--- Literals
-
--- Look for short cuts first: if the literal is *definitely* a 
--- int, integer, float or a double, generate the real thing here.
--- This is essential (see nofib/spectral/nucleic).
--- [Same shortcut as in newOverloadedLit, but we
---  may have done some unification by now] 		
-
-lookupInst inst@(LitInst _nm (HsIntegral i from_integer_name) ty loc)
-  | Just expr <- shortCutIntLit i ty
-  = returnM (GenInst [] (noLoc expr))	-- GenInst, not SimpleInst, because 
-					-- expr may be a constructor application
-  | otherwise
-  = ASSERT( from_integer_name `isHsVar` fromIntegerName )	-- A LitInst invariant
-    tcLookupId fromIntegerName			`thenM` \ from_integer ->
-    tcInstClassOp loc from_integer [ty]		`thenM` \ method_inst ->
-    mkIntegerLit i				`thenM` \ integer_lit ->
-    returnM (GenInst [method_inst]
-		     (mkHsApp (L (instLocSrcSpan loc)
-			   	 (HsVar (instToId method_inst))) integer_lit))
-
-lookupInst inst@(LitInst _nm (HsFractional f from_rat_name) ty loc)
-  | Just expr <- shortCutFracLit f ty
-  = returnM (GenInst [] (noLoc expr))
-
-  | otherwise
-  = ASSERT( from_rat_name `isHsVar` fromRationalName )	-- A LitInst invariant
-    tcLookupId fromRationalName			`thenM` \ from_rational ->
-    tcInstClassOp loc from_rational [ty]	`thenM` \ method_inst ->
-    mkRatLit f					`thenM` \ rat_lit ->
-    returnM (GenInst [method_inst] (mkHsApp (L (instLocSrcSpan loc) 
-					       (HsVar (instToId method_inst))) rat_lit))
-
--- Dictionaries
-lookupInst (Dict _ pred loc)
-  = do 	{ mb_result <- lookupPred pred
-	; case mb_result of {
-	    Nothing -> return NoInstance ;
-	    Just (tenv, dfun_id) -> do
-
-    -- tenv is a substitution that instantiates the dfun_id 
-    -- to match the requested result type.   
-    -- 
-    -- We ASSUME that the dfun is quantified over the very same tyvars 
-    -- that are bound by the tenv.
-    -- 
-    -- However, the dfun
-    -- might have some tyvars that *only* appear in arguments
-    --	dfun :: forall a b. C a b, Ord b => D [a]
-    -- We instantiate b to a flexi type variable -- it'll presumably
-    -- become fixed later via functional dependencies
-    { use_stage <- getStage
-    ; checkWellStaged (ptext SLIT("instance for") <+> quotes (ppr pred))
-    		      (topIdLvl dfun_id) use_stage
-
- 	-- It's possible that not all the tyvars are in
-	-- the substitution, tenv. For example:
-	--	instance C X a => D X where ...
-	-- (presumably there's a functional dependency in class C)
-	-- Hence the open_tvs to instantiate any un-substituted tyvars.	
-    ; let (tyvars, rho) = tcSplitForAllTys (idType dfun_id)
-	  open_tvs      = filter (`notElemTvSubst` tenv) tyvars
-    ; open_tvs' <- mappM tcInstTyVar open_tvs
-    ; let
- 	tenv' = extendTvSubstList tenv open_tvs (mkTyVarTys open_tvs')
-		-- Since the open_tvs' are freshly made, they cannot possibly be captured by
-		-- any nested for-alls in rho.  So the in-scope set is unchanged
-    	dfun_rho   = substTy tenv' rho
-    	(theta, _) = tcSplitPhiTy dfun_rho
-    	ty_app     = mkHsTyApp (L (instLocSrcSpan loc) (HsVar dfun_id)) 
-			       (map (substTyVar tenv') tyvars)
-    ; if null theta then
-    	returnM (SimpleInst ty_app)
-      else do
-    { dicts <- newDictsAtLoc loc theta
-    ; let rhs = mkHsDictApp ty_app (map instToId dicts)
-    ; returnM (GenInst dicts rhs)
-    }}}}
-
----------------
-lookupPred :: TcPredType -> TcM (Maybe (TvSubst, DFunId))
--- Look up a class constraint in the instance environment
-lookupPred pred@(ClassP clas tys)
-  = do	{ eps     <- getEps
-	; tcg_env <- getGblEnv
-	; let inst_envs = (eps_inst_env eps, tcg_inst_env tcg_env)
-	; case lookupInstEnv inst_envs clas tys of {
-	    ([(tenv, ispec)], []) 
-		-> do	{ let dfun_id = is_dfun ispec
-			; traceTc (text "lookupInst success" <+> 
-				   vcat [text "dict" <+> ppr pred, 
-				         text "witness" <+> ppr dfun_id
-					 <+> ppr (idType dfun_id) ])
-				-- Record that this dfun is needed
-			; record_dfun_usage dfun_id
-			; return (Just (tenv, dfun_id)) } ;
-
-     	    (matches, unifs)
-		-> do	{ traceTc (text "lookupInst fail" <+> 
-				   vcat [text "dict" <+> ppr pred,
-				   	 text "matches" <+> ppr matches,
-				   	 text "unifs" <+> ppr unifs])
-		-- In the case of overlap (multiple matches) we report
-		-- NoInstance here.  That has the effect of making the 
-		-- context-simplifier return the dict as an irreducible one.
-		-- Then it'll be given to addNoInstanceErrs, which will do another
-		-- lookupInstEnv to get the detailed info about what went wrong.
-			; return Nothing }
-	}}
-
-lookupPred ip_pred = return Nothing
-
-record_dfun_usage dfun_id 
-  = do	{ gbl <- getGblEnv
-	; let  dfun_name = idName dfun_id
-	       dfun_mod  = nameModule dfun_name
-	; if isInternalName dfun_name ||    -- Internal name => defined in this module
-	     not (isHomeModule (tcg_home_mods gbl) dfun_mod)
-	  then return () -- internal, or in another package
-	   else do { tcg_env <- getGblEnv
-	  	   ; updMutVar (tcg_inst_uses tcg_env)
-			       (`addOneToNameSet` idName dfun_id) }}
-
-
-tcGetInstEnvs :: TcM (InstEnv, InstEnv)
--- Gets both the external-package inst-env
--- and the home-pkg inst env (includes module being compiled)
-tcGetInstEnvs = do { eps <- getEps; env <- getGblEnv;
-		     return (eps_inst_env eps, tcg_inst_env env) }
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-		Re-mappable syntax
-%*									*
-%************************************************************************
-
-Suppose we are doing the -fno-implicit-prelude thing, and we encounter
-a do-expression.  We have to find (>>) in the current environment, which is
-done by the rename. Then we have to check that it has the same type as
-Control.Monad.(>>).  Or, more precisely, a compatible type. One 'customer' had
-this:
-
-  (>>) :: HB m n mn => m a -> n b -> mn b
-
-So the idea is to generate a local binding for (>>), thus:
-
-	let then72 :: forall a b. m a -> m b -> m b
-	    then72 = ...something involving the user's (>>)...
-	in
-	...the do-expression...
-
-Now the do-expression can proceed using then72, which has exactly
-the expected type.
-
-In fact tcSyntaxName just generates the RHS for then72, because we only
-want an actual binding in the do-expression case. For literals, we can 
-just use the expression inline.
-
-\begin{code}
-tcSyntaxName :: InstOrigin
-	     -> TcType			-- Type to instantiate it at
-	     -> (Name, HsExpr Name)	-- (Standard name, user name)
-	     -> TcM (Name, HsExpr TcId)	-- (Standard name, suitable expression)
---	*** NOW USED ONLY FOR CmdTop (sigh) ***
--- NB: tcSyntaxName calls tcExpr, and hence can do unification.
--- So we do not call it from lookupInst, which is called from tcSimplify
-
-tcSyntaxName orig ty (std_nm, HsVar user_nm)
-  | std_nm == user_nm
-  = newMethodFromName orig ty std_nm	`thenM` \ id ->
-    returnM (std_nm, HsVar id)
-
-tcSyntaxName orig ty (std_nm, user_nm_expr)
-  = tcLookupId std_nm		`thenM` \ std_id ->
-    let	
-	-- C.f. newMethodAtLoc
-	([tv], _, tau)  = tcSplitSigmaTy (idType std_id)
- 	sigma1		= substTyWith [tv] [ty] tau
-	-- Actually, the "tau-type" might be a sigma-type in the
-	-- case of locally-polymorphic methods.
-    in
-    addErrCtxtM (syntaxNameCtxt user_nm_expr orig sigma1)	$
-
-	-- Check that the user-supplied thing has the
-	-- same type as the standard one.  
-	-- Tiresome jiggling because tcCheckSigma takes a located expression
-    getSrcSpanM					`thenM` \ span -> 
-    tcPolyExpr (L span user_nm_expr) sigma1	`thenM` \ expr ->
-    returnM (std_nm, unLoc expr)
-
-syntaxNameCtxt name orig ty tidy_env
-  = getInstLoc orig		`thenM` \ inst_loc ->
-    let
-	msg = vcat [ptext SLIT("When checking that") <+> quotes (ppr name) <+> 
-				ptext SLIT("(needed by a syntactic construct)"),
-		    nest 2 (ptext SLIT("has the required type:") <+> ppr (tidyType tidy_env ty)),
-		    nest 2 (pprInstLoc inst_loc)]
-    in
-    returnM (tidy_env, msg)
-\end{code}
diff --git a/ghc/compiler/typecheck/TcArrows.lhs b/ghc/compiler/typecheck/TcArrows.lhs
deleted file mode 100644
index 3bfa9b4757..0000000000
--- a/ghc/compiler/typecheck/TcArrows.lhs
+++ /dev/null
@@ -1,350 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section{Typecheck arrow notation}
-
-\begin{code}
-module TcArrows ( tcProc ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-}	TcExpr( tcMonoExpr, tcInferRho )
-
-import HsSyn
-import TcHsSyn	(  mkHsDictLet )
-
-import TcMatches ( matchCtxt, tcStmts, tcMDoStmt, tcGuardStmt,
-		   TcMatchCtxt(..), tcMatchesCase )
-
-import TcType	( TcType, TcTauType, BoxyRhoType, mkFunTys, mkTyConApp,
-		  mkTyVarTy, mkAppTys, tcSplitTyConApp_maybe, tcEqType, 
-		  SkolemInfo(..) )
-import TcMType	( newFlexiTyVarTy, tcInstSkolTyVars, zonkTcType )
-import TcBinds	( tcLocalBinds )
-import TcSimplify ( tcSimplifyCheck )
-import TcPat	( tcPat, tcPats, PatCtxt(..) )
-import TcUnify	( checkSigTyVarsWrt, boxySplitAppTy )
-import TcRnMonad
-import Inst	( tcSyntaxName )
-import Name	( Name )
-import TysWiredIn ( boolTy, pairTyCon )
-import VarSet 
-import TysPrim	( alphaTyVar )
-import Type	( Kind, mkArrowKinds, liftedTypeKind, openTypeKind, tyVarsOfTypes )
-
-import SrcLoc	( Located(..) )
-import Outputable
-import Util	( lengthAtLeast )
-
-\end{code}
-
-%************************************************************************
-%*									*
-		Proc	
-%*									*
-%************************************************************************
-
-\begin{code}
-tcProc :: InPat Name -> LHsCmdTop Name		-- proc pat -> expr
-       -> BoxyRhoType				-- Expected type of whole proc expression
-       -> TcM (OutPat TcId, LHsCmdTop TcId)
-
-tcProc pat cmd exp_ty
-  = newArrowScope $
-    do	{ (exp_ty1, res_ty) <- boxySplitAppTy exp_ty 
-	; (arr_ty, arg_ty)  <- boxySplitAppTy exp_ty1
-	; let cmd_env = CmdEnv { cmd_arr = arr_ty }
-	; (pat', cmd') <- tcPat LamPat pat arg_ty res_ty $ \ res_ty' ->
-			  tcCmdTop cmd_env cmd ([], res_ty')
-	; return (pat', cmd') }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Commands
-%*									*
-%************************************************************************
-
-\begin{code}
-type CmdStack = [TcTauType]
-data CmdEnv
-  = CmdEnv {
-	cmd_arr		:: TcType -- arrow type constructor, of kind *->*->*
-    }
-
-mkCmdArrTy :: CmdEnv -> TcTauType -> TcTauType -> TcTauType
-mkCmdArrTy env t1 t2 = mkAppTys (cmd_arr env) [t1, t2]
-
----------------------------------------
-tcCmdTop :: CmdEnv 
-         -> LHsCmdTop Name
-         -> (CmdStack, TcTauType)	-- Expected result type; always a monotype
-					-- We know exactly how many cmd args are expected,
-					-- albeit perhaps not their types; so we can pass 
-					-- in a CmdStack
-        -> TcM (LHsCmdTop TcId)
-
-tcCmdTop env (L loc (HsCmdTop cmd _ _ names)) (cmd_stk, res_ty)
-  = setSrcSpan loc $
-    do	{ cmd'   <- tcCmd env cmd (cmd_stk, res_ty)
-	; names' <- mapM (tcSyntaxName ProcOrigin (cmd_arr env)) names
-	; return (L loc $ HsCmdTop cmd' cmd_stk res_ty names') }
-
-
-----------------------------------------
-tcCmd :: CmdEnv -> LHsExpr Name -> (CmdStack, TcTauType) -> TcM (LHsExpr TcId)
-	-- The main recursive function
-tcCmd env (L loc expr) res_ty
-  = setSrcSpan loc $ do
-	{ expr' <- tc_cmd env expr res_ty
-	; return (L loc expr') }
-
-tc_cmd env (HsPar cmd) res_ty
-  = do	{ cmd' <- tcCmd env cmd res_ty
-	; return (HsPar cmd') }
-
-tc_cmd env (HsLet binds (L body_loc body)) res_ty
-  = do	{ (binds', body') <- tcLocalBinds binds		$
-			     setSrcSpan body_loc 	$
-			     tc_cmd env body res_ty
-	; return (HsLet binds' (L body_loc body')) }
-
-tc_cmd env in_cmd@(HsCase scrut matches) (stk, res_ty)
-  = addErrCtxt (cmdCtxt in_cmd)		$
-    addErrCtxt (caseScrutCtxt scrut)	(
-      tcInferRho scrut 
-    )							`thenM`	\ (scrut', scrut_ty) ->
-    tcMatchesCase match_ctxt scrut_ty matches res_ty	`thenM`	\ matches' ->
-    returnM (HsCase scrut' matches')
-  where
-    match_ctxt = MC { mc_what = CaseAlt,
-                      mc_body = mc_body }
-    mc_body body res_ty' = tcCmd env body (stk, res_ty')
-
-tc_cmd env (HsIf pred b1 b2) res_ty
-  = do 	{ pred' <- tcMonoExpr pred boolTy
-	; b1'   <- tcCmd env b1 res_ty
-	; b2'   <- tcCmd env b2 res_ty
-	; return (HsIf pred' b1' b2')
-    }
-
--------------------------------------------
--- 		Arrow application
---     	    (f -< a)   or   (f -<< a)
-
-tc_cmd env cmd@(HsArrApp fun arg _ ho_app lr) (cmd_stk, res_ty)
-  = addErrCtxt (cmdCtxt cmd)	$
-    do  { arg_ty <- newFlexiTyVarTy openTypeKind
-	; let fun_ty = mkCmdArrTy env (foldl mkPairTy arg_ty cmd_stk) res_ty
-
-	; fun' <- select_arrow_scope (tcMonoExpr fun fun_ty)
-
-	; arg' <- tcMonoExpr arg arg_ty
-
-	; return (HsArrApp fun' arg' fun_ty ho_app lr) }
-  where
-	-- Before type-checking f, use the environment of the enclosing
-	-- proc for the (-<) case.  
-	-- Local bindings, inside the enclosing proc, are not in scope 
-	-- inside f.  In the higher-order case (-<<), they are.
-    select_arrow_scope tc = case ho_app of
-	HsHigherOrderApp -> tc
-	HsFirstOrderApp  -> escapeArrowScope tc
-
--------------------------------------------
--- 		Command application
-
-tc_cmd env cmd@(HsApp fun arg) (cmd_stk, res_ty)
-  = addErrCtxt (cmdCtxt cmd)	$
--- gaw 2004 FIX?
-    do  { arg_ty <- newFlexiTyVarTy openTypeKind
-
-	; fun' <- tcCmd env fun (arg_ty:cmd_stk, res_ty)
-
-	; arg' <- tcMonoExpr arg arg_ty
-
-	; return (HsApp fun' arg') }
-
--------------------------------------------
--- 		Lambda
-
--- gaw 2004
-tc_cmd env cmd@(HsLam (MatchGroup [L mtch_loc (match@(Match pats maybe_rhs_sig grhss))] _))
-       (cmd_stk, res_ty)
-  = addErrCtxt (matchCtxt match_ctxt match)	$
-
-    do	{ 	-- Check the cmd stack is big enough
-	; checkTc (lengthAtLeast cmd_stk n_pats)
-		  (kappaUnderflow cmd)
-
-		-- Check the patterns, and the GRHSs inside
-	; (pats', grhss') <- setSrcSpan mtch_loc		$
-			     tcPats LamPat pats cmd_stk res_ty	$
-			     tc_grhss grhss
-
-	; let match' = L mtch_loc (Match pats' Nothing grhss')
-	; return (HsLam (MatchGroup [match'] res_ty))
-	}
-
-  where
-    n_pats     = length pats
-    stk'       = drop n_pats cmd_stk
-    match_ctxt = LambdaExpr 	-- Maybe KappaExpr?
-    pg_ctxt    = PatGuard match_ctxt
-
-    tc_grhss (GRHSs grhss binds) res_ty
-	= do { (binds', grhss') <- tcLocalBinds binds $
-				   mapM (wrapLocM (tc_grhs res_ty)) grhss
-	     ; return (GRHSs grhss' binds') }
-
-    tc_grhs res_ty (GRHS guards body)
-	= do { (guards', rhs') <- tcStmts pg_ctxt tcGuardStmt
-					  guards res_ty
-					  (\res_ty' -> tcCmd env body (stk', res_ty'))
-	     ; return (GRHS guards' rhs') }
-
--------------------------------------------
--- 		Do notation
-
-tc_cmd env cmd@(HsDo do_or_lc stmts body ty) (cmd_stk, res_ty)
-  = do 	{ checkTc (null cmd_stk) (nonEmptyCmdStkErr cmd)
-	; (stmts', body') <- tcStmts do_or_lc tc_stmt stmts res_ty $ \ res_ty' ->
-			     tcCmd env body ([], res_ty')
-	; return (HsDo do_or_lc stmts' body' res_ty) }
-  where
-    tc_stmt = tcMDoStmt tc_rhs
-    tc_rhs rhs = do { ty <- newFlexiTyVarTy liftedTypeKind
-		    ; rhs' <- tcCmd env rhs ([], ty)
-		    ; return (rhs', ty) }
-
-
------------------------------------------------------------------
---	Arrow ``forms''	      (| e c1 .. cn |)
---
---	G      |-b  c : [s1 .. sm] s
---	pop(G) |-   e : forall w. b ((w,s1) .. sm) s
---			        -> a ((w,t1) .. tn) t
---	e \not\in (s, s1..sm, t, t1..tn)
---	----------------------------------------------
---	G |-a  (| e c |)  :  [t1 .. tn] t
-
-tc_cmd env cmd@(HsArrForm expr fixity cmd_args) (cmd_stk, res_ty)	
-  = addErrCtxt (cmdCtxt cmd)	$
-    do	{ cmds_w_tys <- zipWithM new_cmd_ty cmd_args [1..]
-	; span       <- getSrcSpanM
-	; [w_tv]     <- tcInstSkolTyVars (ArrowSkol span) [alphaTyVar]
-	; let w_ty = mkTyVarTy w_tv 	-- Just a convenient starting point
-
-		--  a ((w,t1) .. tn) t
-	; let e_res_ty = mkCmdArrTy env (foldl mkPairTy w_ty cmd_stk) res_ty
-
-	 	--   b ((w,s1) .. sm) s
-		--   -> a ((w,t1) .. tn) t
-	; let e_ty = mkFunTys [mkAppTys b [tup,s] | (_,_,b,tup,s) <- cmds_w_tys] 
-			      e_res_ty
-
-		-- Check expr
-	; (expr', lie) <- escapeArrowScope (getLIE (tcMonoExpr expr e_ty))
-	; inst_binds <- tcSimplifyCheck sig_msg [w_tv] [] lie
-
-		-- Check that the polymorphic variable hasn't been unified with anything
-		-- and is not free in res_ty or the cmd_stk  (i.e.  t, t1..tn)
-	; checkSigTyVarsWrt (tyVarsOfTypes (res_ty:cmd_stk)) [w_tv] 
-
-		-- OK, now we are in a position to unscramble 
-		-- the s1..sm and check each cmd
-	; cmds' <- mapM (tc_cmd w_tv) cmds_w_tys
-
-	; returnM (HsArrForm (mkHsTyLam [w_tv] (mkHsDictLet inst_binds expr')) fixity cmds')
-	}
-  where
- 	-- Make the types	
-	--	b, ((e,s1) .. sm), s
-    new_cmd_ty :: LHsCmdTop Name -> Int
-	       -> TcM (LHsCmdTop Name, Int, TcType, TcType, TcType)
-    new_cmd_ty cmd i
--- gaw 2004 FIX?
-	  = do	{ b_ty   <- newFlexiTyVarTy arrowTyConKind
-		; tup_ty <- newFlexiTyVarTy liftedTypeKind
-			-- We actually make a type variable for the tuple
-			-- because we don't know how deeply nested it is yet    
-		; s_ty   <- newFlexiTyVarTy liftedTypeKind
-		; return (cmd, i, b_ty, tup_ty, s_ty)
-		}
-
-    tc_cmd w_tv (cmd, i, b, tup_ty, s)
-      = do { tup_ty' <- zonkTcType tup_ty
-	   ; let (corner_ty, arg_tys) = unscramble tup_ty'
-
-		-- Check that it has the right shape:
-		-- 	((w,s1) .. sn)
-		-- where the si do not mention w
-	   ; checkTc (corner_ty `tcEqType` mkTyVarTy w_tv && 
-		      not (w_tv `elemVarSet` tyVarsOfTypes arg_tys))
-		     (badFormFun i tup_ty')
-
-	   ; tcCmdTop (env { cmd_arr = b }) cmd (arg_tys, s) }
-
-    unscramble :: TcType -> (TcType, [TcType])
-    -- unscramble ((w,s1) .. sn)	=  (w, [s1..sn])
-    unscramble ty
-       = case tcSplitTyConApp_maybe ty of
-	    Just (tc, [t,s]) | tc == pairTyCon 
-	       ->  let 
-		      (w,ss) = unscramble t  
-		   in (w, s:ss)
-				    
-	    other -> (ty, [])
-
-    sig_msg  = ptext SLIT("expected type of a command form")
-
------------------------------------------------------------------
---		Base case for illegal commands
--- This is where expressions that aren't commands get rejected
-
-tc_cmd env cmd _
-  = failWithTc (vcat [ptext SLIT("The expression"), nest 2 (ppr cmd), 
-		      ptext SLIT("was found where an arrow command was expected")])
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Helpers
-%*									*
-%************************************************************************
-
-
-\begin{code}
-mkPairTy t1 t2 = mkTyConApp pairTyCon [t1,t2]
-
-arrowTyConKind :: Kind		--  *->*->*
-arrowTyConKind = mkArrowKinds [liftedTypeKind, liftedTypeKind] liftedTypeKind
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Errors
-%*									*
-%************************************************************************
-
-\begin{code}
-cmdCtxt cmd = ptext SLIT("In the command:") <+> ppr cmd
-
-caseScrutCtxt cmd
-  = hang (ptext SLIT("In the scrutinee of a case command:")) 4 (ppr cmd)
-
-nonEmptyCmdStkErr cmd
-  = hang (ptext SLIT("Non-empty command stack at command:"))
-	 4 (ppr cmd)
-
-kappaUnderflow cmd
-  = hang (ptext SLIT("Command stack underflow at command:"))
-	 4 (ppr cmd)
-
-badFormFun i tup_ty'
- = hang (ptext SLIT("The type of the") <+> speakNth i <+> ptext SLIT("argument of a command form has the wrong shape"))
-	4 (ptext SLIT("Argument type:") <+> ppr tup_ty')
-\end{code}
diff --git a/ghc/compiler/typecheck/TcBinds.lhs b/ghc/compiler/typecheck/TcBinds.lhs
deleted file mode 100644
index cffcb9cfb9..0000000000
--- a/ghc/compiler/typecheck/TcBinds.lhs
+++ /dev/null
@@ -1,1117 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcBinds]{TcBinds}
-
-\begin{code}
-module TcBinds ( tcLocalBinds, tcTopBinds, 
-		 tcHsBootSigs, tcMonoBinds, 
-		 TcPragFun, tcSpecPrag, tcPrags, mkPragFun,
-		 TcSigInfo(..),
-		 badBootDeclErr ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TcMatches ( tcGRHSsPat, tcMatchesFun )
-import {-# SOURCE #-} TcExpr  ( tcMonoExpr )
-
-import DynFlags		( DynFlag(Opt_MonomorphismRestriction, Opt_GlasgowExts) )
-import HsSyn		( HsExpr(..), HsBind(..), LHsBinds, LHsBind, Sig(..),
-			  HsLocalBinds(..), HsValBinds(..), HsIPBinds(..),
-			  LSig, Match(..), IPBind(..), Prag(..),
-			  HsType(..), LHsType, HsExplicitForAll(..), hsLTyVarNames, 
-			  isVanillaLSig, sigName, placeHolderNames, isPragLSig,
-			  LPat, GRHSs, MatchGroup(..), pprLHsBinds, mkHsCoerce,
-			  collectHsBindBinders, collectPatBinders, pprPatBind, isBangHsBind
-			)
-import TcHsSyn		( zonkId )
-
-import TcRnMonad
-import Inst		( newDictsAtLoc, newIPDict, instToId )
-import TcEnv		( tcExtendIdEnv, tcExtendIdEnv2, tcExtendTyVarEnv2, 
-			  pprBinders, tcLookupLocalId_maybe, tcLookupId,
-			  tcGetGlobalTyVars )
-import TcUnify		( tcInfer, tcSubExp, unifyTheta, 
-			  bleatEscapedTvs, sigCtxt )
-import TcSimplify	( tcSimplifyInfer, tcSimplifyInferCheck, 
-			  tcSimplifyRestricted, tcSimplifyIPs )
-import TcHsType		( tcHsSigType, UserTypeCtxt(..) )
-import TcPat		( tcPat, PatCtxt(..) )
-import TcSimplify	( bindInstsOfLocalFuns )
-import TcMType		( newFlexiTyVarTy, zonkQuantifiedTyVar, zonkSigTyVar,
-			  tcInstSigTyVars, tcInstSkolTyVars, tcInstType, 
-			  zonkTcType, zonkTcTypes, zonkTcTyVars )
-import TcType		( TcType, TcTyVar, TcThetaType, 
-			  SkolemInfo(SigSkol), UserTypeCtxt(FunSigCtxt), 
-			  TcTauType, TcSigmaType, isUnboxedTupleType,
-			  mkTyVarTy, mkForAllTys, mkFunTys, exactTyVarsOfType, 
-			  mkForAllTy, isUnLiftedType, tcGetTyVar, 
-			  mkTyVarTys, tidyOpenTyVar )
-import Kind		( argTypeKind )
-import VarEnv		( TyVarEnv, emptyVarEnv, lookupVarEnv, extendVarEnv ) 
-import TysWiredIn	( unitTy )
-import TysPrim		( alphaTyVar )
-import Id		( Id, mkLocalId, mkVanillaGlobal )
-import IdInfo		( vanillaIdInfo )
-import Var		( TyVar, idType, idName )
-import Name		( Name )
-import NameSet
-import NameEnv
-import VarSet
-import SrcLoc		( Located(..), unLoc, getLoc )
-import Bag
-import ErrUtils		( Message )
-import Digraph		( SCC(..), stronglyConnComp )
-import Maybes		( expectJust, isJust, isNothing, orElse )
-import Util		( singleton )
-import BasicTypes	( TopLevelFlag(..), isTopLevel, isNotTopLevel,
-			  RecFlag(..), isNonRec, InlineSpec, defaultInlineSpec )
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Type-checking bindings}
-%*									*
-%************************************************************************
-
-@tcBindsAndThen@ typechecks a @HsBinds@.  The "and then" part is because
-it needs to know something about the {\em usage} of the things bound,
-so that it can create specialisations of them.  So @tcBindsAndThen@
-takes a function which, given an extended environment, E, typechecks
-the scope of the bindings returning a typechecked thing and (most
-important) an LIE.  It is this LIE which is then used as the basis for
-specialising the things bound.
-
-@tcBindsAndThen@ also takes a "combiner" which glues together the
-bindings and the "thing" to make a new "thing".
-
-The real work is done by @tcBindWithSigsAndThen@.
-
-Recursive and non-recursive binds are handled in essentially the same
-way: because of uniques there are no scoping issues left.  The only
-difference is that non-recursive bindings can bind primitive values.
-
-Even for non-recursive binding groups we add typings for each binder
-to the LVE for the following reason.  When each individual binding is
-checked the type of its LHS is unified with that of its RHS; and
-type-checking the LHS of course requires that the binder is in scope.
-
-At the top-level the LIE is sure to contain nothing but constant
-dictionaries, which we resolve at the module level.
-
-\begin{code}
-tcTopBinds :: HsValBinds Name -> TcM (LHsBinds TcId, TcLclEnv)
-	-- Note: returning the TcLclEnv is more than we really
-	--       want.  The bit we care about is the local bindings
-	--	 and the free type variables thereof
-tcTopBinds binds
-  = do	{ (ValBindsOut prs _, env) <- tcValBinds TopLevel binds getLclEnv
-	; return (foldr (unionBags . snd) emptyBag prs, env) }
-	-- The top level bindings are flattened into a giant 
-	-- implicitly-mutually-recursive LHsBinds
-
-tcHsBootSigs :: HsValBinds Name -> TcM [Id]
--- A hs-boot file has only one BindGroup, and it only has type
--- signatures in it.  The renamer checked all this
-tcHsBootSigs (ValBindsOut binds sigs)
-  = do	{ checkTc (null binds) badBootDeclErr
-	; mapM (addLocM tc_boot_sig) (filter isVanillaLSig sigs) }
-  where
-    tc_boot_sig (TypeSig (L _ name) ty)
-      = do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
-	   ; return (mkVanillaGlobal name sigma_ty vanillaIdInfo) }
-	-- Notice that we make GlobalIds, not LocalIds
-tcHsBootSigs groups = pprPanic "tcHsBootSigs" (ppr groups)
-
-badBootDeclErr :: Message
-badBootDeclErr = ptext SLIT("Illegal declarations in an hs-boot file")
-
-------------------------
-tcLocalBinds :: HsLocalBinds Name -> TcM thing
-	     -> TcM (HsLocalBinds TcId, thing)
-
-tcLocalBinds EmptyLocalBinds thing_inside 
-  = do	{ thing <- thing_inside
-	; return (EmptyLocalBinds, thing) }
-
-tcLocalBinds (HsValBinds binds) thing_inside
-  = do	{ (binds', thing) <- tcValBinds NotTopLevel binds thing_inside
-	; return (HsValBinds binds', thing) }
-
-tcLocalBinds (HsIPBinds (IPBinds ip_binds _)) thing_inside
-  = do	{ (thing, lie) <- getLIE thing_inside
-	; (avail_ips, ip_binds') <- mapAndUnzipM (wrapLocSndM tc_ip_bind) ip_binds
-
-	-- If the binding binds ?x = E, we  must now 
-	-- discharge any ?x constraints in expr_lie
-	; dict_binds <- tcSimplifyIPs avail_ips lie
-	; return (HsIPBinds (IPBinds ip_binds' dict_binds), thing) }
-  where
-	-- I wonder if we should do these one at at time
-	-- Consider	?x = 4
-	--		?y = ?x + 1
-    tc_ip_bind (IPBind ip expr)
-      = newFlexiTyVarTy argTypeKind		`thenM` \ ty ->
-  	newIPDict (IPBindOrigin ip) ip ty	`thenM` \ (ip', ip_inst) ->
-  	tcMonoExpr expr ty			`thenM` \ expr' ->
-  	returnM (ip_inst, (IPBind ip' expr'))
-
-------------------------
-tcValBinds :: TopLevelFlag 
-	   -> HsValBinds Name -> TcM thing
-	   -> TcM (HsValBinds TcId, thing) 
-
-tcValBinds top_lvl (ValBindsIn binds sigs) thing_inside
-  = pprPanic "tcValBinds" (ppr binds)
-
-tcValBinds top_lvl (ValBindsOut binds sigs) thing_inside
-  = do 	{   	-- Typecheck the signature
-	; let { prag_fn = mkPragFun sigs
-	      ; ty_sigs = filter isVanillaLSig sigs
-	      ; sig_fn  = mkSigFun ty_sigs }
-
-	; poly_ids <- mapM tcTySig ty_sigs
-
-		-- Extend the envt right away with all 
-		-- the Ids declared with type signatures
-  	; (binds', thing) <- tcExtendIdEnv poly_ids $
-			     tc_val_binds top_lvl sig_fn prag_fn 
-					  binds thing_inside
-
-	; return (ValBindsOut binds' sigs, thing) }
-
-------------------------
-tc_val_binds :: TopLevelFlag -> TcSigFun -> TcPragFun
-	     -> [(RecFlag, LHsBinds Name)] -> TcM thing
-	     -> TcM ([(RecFlag, LHsBinds TcId)], thing)
--- Typecheck a whole lot of value bindings,
--- one strongly-connected component at a time
-
-tc_val_binds top_lvl sig_fn prag_fn [] thing_inside
-  = do	{ thing <- thing_inside
-	; return ([], thing) }
-
-tc_val_binds top_lvl sig_fn prag_fn (group : groups) thing_inside
-  = do	{ (group', (groups', thing))
-		<- tc_group top_lvl sig_fn prag_fn group $ 
-		   tc_val_binds top_lvl sig_fn prag_fn groups thing_inside
-	; return (group' ++ groups', thing) }
-
-------------------------
-tc_group :: TopLevelFlag -> TcSigFun -> TcPragFun
-	 -> (RecFlag, LHsBinds Name) -> TcM thing
- 	 -> TcM ([(RecFlag, LHsBinds TcId)], thing)
-
--- Typecheck one strongly-connected component of the original program.
--- We get a list of groups back, because there may 
--- be specialisations etc as well
-
-tc_group top_lvl sig_fn prag_fn (NonRecursive, binds) thing_inside
-  =  	-- A single non-recursive binding
-     	-- We want to keep non-recursive things non-recursive
-        -- so that we desugar unlifted bindings correctly
-    do	{ (binds, thing) <- tcPolyBinds top_lvl NonRecursive NonRecursive
-					sig_fn prag_fn binds thing_inside
-	; return ([(NonRecursive, b) | b <- binds], thing) }
-
-tc_group top_lvl sig_fn prag_fn (Recursive, binds) thing_inside
-  =	-- A recursive strongly-connected component
- 	-- To maximise polymorphism (with -fglasgow-exts), we do a new 
-	-- strongly-connected-component analysis, this time omitting 
-	-- any references to variables with type signatures.
-	--
-	-- Then we bring into scope all the variables with type signatures
-    do	{ traceTc (text "tc_group rec" <+> pprLHsBinds binds)
-	; gla_exts     <- doptM Opt_GlasgowExts
-	; (binds,thing) <- if gla_exts 
-			   then go new_sccs
-			   else tc_binds Recursive binds thing_inside
-	; return ([(Recursive, unionManyBags binds)], thing) }
-		-- Rec them all together
-  where
-    new_sccs :: [SCC (LHsBind Name)]
-    new_sccs = stronglyConnComp (mkEdges sig_fn binds)
-
---  go :: SCC (LHsBind Name) -> TcM ([LHsBind TcId], thing)
-    go (scc:sccs) = do	{ (binds1, (binds2, thing)) <- go1 scc (go sccs)
-			; return (binds1 ++ binds2, thing) }
-    go [] 	  = do	{ thing <- thing_inside; return ([], thing) }
-
-    go1 (AcyclicSCC bind) = tc_binds NonRecursive (unitBag bind)
-    go1 (CyclicSCC binds) = tc_binds Recursive    (listToBag binds)
-
-    tc_binds rec_tc binds = tcPolyBinds top_lvl Recursive rec_tc sig_fn prag_fn binds
-
-------------------------
-mkEdges :: TcSigFun -> LHsBinds Name
-	-> [(LHsBind Name, BKey, [BKey])]
-
-type BKey  = Int -- Just number off the bindings
-
-mkEdges sig_fn binds
-  = [ (bind, key, [key | n <- nameSetToList (bind_fvs (unLoc bind)),
-			 Just key <- [lookupNameEnv key_map n], no_sig n ])
-    | (bind, key) <- keyd_binds
-    ]
-  where
-    no_sig :: Name -> Bool
-    no_sig n = isNothing (sig_fn n)
-
-    keyd_binds = bagToList binds `zip` [0::BKey ..]
-
-    key_map :: NameEnv BKey	-- Which binding it comes from
-    key_map = mkNameEnv [(bndr, key) | (L _ bind, key) <- keyd_binds
-				     , bndr <- bindersOfHsBind bind ]
-
-bindersOfHsBind :: HsBind Name -> [Name]
-bindersOfHsBind (PatBind { pat_lhs = pat })  = collectPatBinders pat
-bindersOfHsBind (FunBind { fun_id = L _ f }) = [f]
-
-------------------------
-tcPolyBinds :: TopLevelFlag 
-	    -> RecFlag			-- Whether the group is really recursive
-	    -> RecFlag			-- Whether it's recursive for typechecking purposes
-	    -> TcSigFun -> TcPragFun
-	    -> LHsBinds Name
- 	    -> TcM thing
-	    -> TcM ([LHsBinds TcId], thing)
-
--- Typechecks a single bunch of bindings all together, 
--- and generalises them.  The bunch may be only part of a recursive
--- group, because we use type signatures to maximise polymorphism
---
--- Deals with the bindInstsOfLocalFuns thing too
---
--- Returns a list because the input may be a single non-recursive binding,
--- in which case the dependency order of the resulting bindings is
--- important.  
-
-tcPolyBinds top_lvl rec_group rec_tc sig_fn prag_fn scc thing_inside
-  =	-- NB: polymorphic recursion means that a function
-	-- may use an instance of itself, we must look at the LIE arising
-	-- from the function's own right hand side.  Hence the getLIE
-	-- encloses the tc_poly_binds. 
-    do	{ traceTc (text "tcPolyBinds" <+> ppr scc)
-	; ((binds1, poly_ids, thing), lie) <- getLIE $ 
-		do { (binds1, poly_ids) <- tc_poly_binds top_lvl rec_group rec_tc
-							 sig_fn prag_fn scc
-		   ; thing <- tcExtendIdEnv poly_ids thing_inside
-		   ; return (binds1, poly_ids, thing) }
-
-	; if isTopLevel top_lvl 
-	  then		-- For the top level don't bother will all this
-			-- bindInstsOfLocalFuns stuff. All the top level 
-			-- things are rec'd together anyway, so it's fine to
-		        -- leave them to the tcSimplifyTop, 
-			-- and quite a bit faster too
-		do { extendLIEs lie; return (binds1, thing) }
-
-	  else do	-- Nested case
-		{ lie_binds <- bindInstsOfLocalFuns lie poly_ids
-	 	; return (binds1 ++ [lie_binds], thing) }}
-
-------------------------
-tc_poly_binds :: TopLevelFlag		-- See comments on tcPolyBinds
-	      -> RecFlag -> RecFlag
-	      -> TcSigFun -> TcPragFun
-	      -> LHsBinds Name
-	      -> TcM ([LHsBinds TcId], [TcId])
--- Typechecks the bindings themselves
--- Knows nothing about the scope of the bindings
-
-tc_poly_binds top_lvl rec_group rec_tc sig_fn prag_fn binds
-  = let 
-        binder_names = collectHsBindBinders binds
-	bind_list    = bagToList binds
-
-	loc = getLoc (head bind_list)
-		-- TODO: location a bit awkward, but the mbinds have been
-		--	 dependency analysed and may no longer be adjacent
-    in
-	-- SET UP THE MAIN RECOVERY; take advantage of any type sigs
-    setSrcSpan loc				$
-    recoverM (recoveryCode binder_names)	$ do 
-
-  { traceTc (ptext SLIT("------------------------------------------------"))
-  ; traceTc (ptext SLIT("Bindings for") <+> ppr binder_names)
-
-   	-- TYPECHECK THE BINDINGS
-  ; ((binds', mono_bind_infos), lie_req) 
-	<- getLIE (tcMonoBinds bind_list sig_fn rec_tc)
-
-	-- CHECK FOR UNLIFTED BINDINGS
-	-- These must be non-recursive etc, and are not generalised
-	-- They desugar to a case expression in the end
-  ; zonked_mono_tys <- zonkTcTypes (map getMonoType mono_bind_infos)
-  ; is_strict <- checkStrictBinds top_lvl rec_group binds' 
-				  zonked_mono_tys mono_bind_infos
-  ; if is_strict then
-    do	{ extendLIEs lie_req
-	; let exports = zipWith mk_export mono_bind_infos zonked_mono_tys
-	      mk_export (name, Nothing,  mono_id) mono_ty = ([], mkLocalId name mono_ty, mono_id, [])
-	      mk_export (name, Just sig, mono_id) mono_ty = ([], sig_id sig,             mono_id, [])
-			-- ToDo: prags for unlifted bindings
-
-	; return ( [unitBag $ L loc $ AbsBinds [] [] exports binds'],
-		   [poly_id | (_, poly_id, _, _) <- exports]) }	-- Guaranteed zonked
-
-    else do	-- The normal lifted case: GENERALISE
-  { is_unres <- isUnRestrictedGroup bind_list sig_fn
-  ; (tyvars_to_gen, dict_binds, dict_ids)
-	<- addErrCtxt (genCtxt (bndrNames mono_bind_infos)) $
-	   generalise top_lvl is_unres mono_bind_infos lie_req
-
-	-- FINALISE THE QUANTIFIED TYPE VARIABLES
-	-- The quantified type variables often include meta type variables
-	-- we want to freeze them into ordinary type variables, and
-	-- default their kind (e.g. from OpenTypeKind to TypeKind)
-  ; tyvars_to_gen' <- mappM zonkQuantifiedTyVar tyvars_to_gen
-
-	-- BUILD THE POLYMORPHIC RESULT IDs
-  ; exports <- mapM (mkExport prag_fn tyvars_to_gen' (map idType dict_ids))
-		    mono_bind_infos
-
-	-- ZONK THE poly_ids, because they are used to extend the type 
-	-- environment; see the invariant on TcEnv.tcExtendIdEnv 
-  ; let	poly_ids = [poly_id | (_, poly_id, _, _) <- exports]
-  ; zonked_poly_ids <- mappM zonkId poly_ids
-
-  ; traceTc (text "binding:" <+> ppr (zonked_poly_ids `zip` map idType zonked_poly_ids))
-
-  ; let abs_bind = L loc $ AbsBinds tyvars_to_gen'
-	 		            dict_ids exports
-	 		    	    (dict_binds `unionBags` binds')
-
-  ; return ([unitBag abs_bind], zonked_poly_ids)
-  } }
-
-
---------------
-mkExport :: TcPragFun -> [TyVar] -> [TcType] -> MonoBindInfo
-	 -> TcM ([TyVar], Id, Id, [Prag])
-mkExport prag_fn inferred_tvs dict_tys (poly_name, mb_sig, mono_id)
-  = case mb_sig of
-      Nothing  -> do { prags <- tcPrags poly_id (prag_fn poly_name)
-		     ; return (inferred_tvs, poly_id, mono_id, prags) }
-	  where
-	    poly_id = mkLocalId poly_name poly_ty
-	    poly_ty = mkForAllTys inferred_tvs
-				       $ mkFunTys dict_tys 
-				       $ idType mono_id
-
-      Just sig -> do { let poly_id = sig_id sig
-		     ; prags <- tcPrags poly_id (prag_fn poly_name)
-		     ; sig_tys <- zonkTcTyVars (sig_tvs sig)
-		     ; let sig_tvs' = map (tcGetTyVar "mkExport") sig_tys
-		     ; return (sig_tvs', poly_id, mono_id, prags) }
-		-- We zonk the sig_tvs here so that the export triple
-		-- always has zonked type variables; 
-		-- a convenient invariant
-
-
-------------------------
-type TcPragFun = Name -> [LSig Name]
-
-mkPragFun :: [LSig Name] -> TcPragFun
-mkPragFun sigs = \n -> lookupNameEnv env n `orElse` []
-	where
-	  prs = [(expectJust "mkPragFun" (sigName sig), sig) 
-		| sig <- sigs, isPragLSig sig]
-	  env = foldl add emptyNameEnv prs
-	  add env (n,p) = extendNameEnv_Acc (:) singleton env n p
-
-tcPrags :: Id -> [LSig Name] -> TcM [Prag]
-tcPrags poly_id prags = mapM tc_prag prags
-  where
-    tc_prag (L loc prag) = setSrcSpan loc $ 
-			   addErrCtxt (pragSigCtxt prag) $ 
-			   tcPrag poly_id prag
-
-pragSigCtxt prag = hang (ptext SLIT("In the pragma")) 2 (ppr prag)
-
-tcPrag :: TcId -> Sig Name -> TcM Prag
-tcPrag poly_id (SpecSig orig_name hs_ty inl) = tcSpecPrag poly_id hs_ty inl
-tcPrag poly_id (SpecInstSig hs_ty)	     = tcSpecPrag poly_id hs_ty defaultInlineSpec
-tcPrag poly_id (InlineSig v inl)             = return (InlinePrag inl)
-
-
-tcSpecPrag :: TcId -> LHsType Name -> InlineSpec -> TcM Prag
-tcSpecPrag poly_id hs_ty inl
-  = do	{ spec_ty <- tcHsSigType (FunSigCtxt (idName poly_id)) hs_ty
-	; (co_fn, lie) <- getLIE (tcSubExp (idType poly_id) spec_ty)
-	; extendLIEs lie
-	; let const_dicts = map instToId lie
-	; return (SpecPrag (mkHsCoerce co_fn (HsVar poly_id)) spec_ty const_dicts inl) }
-  
---------------
--- If typechecking the binds fails, then return with each
--- signature-less binder given type (forall a.a), to minimise 
--- subsequent error messages
-recoveryCode binder_names
-  = do	{ traceTc (text "tcBindsWithSigs: error recovery" <+> ppr binder_names)
-	; poly_ids <- mapM mk_dummy binder_names
-	; return ([], poly_ids) }
-  where
-    mk_dummy name = do { mb_id <- tcLookupLocalId_maybe name
-			; case mb_id of
-    		     	      Just id -> return id		-- Had signature, was in envt
-	    		      Nothing -> return (mkLocalId name forall_a_a) }    -- No signature
-
-forall_a_a :: TcType
-forall_a_a = mkForAllTy alphaTyVar (mkTyVarTy alphaTyVar)
-
-
--- Check that non-overloaded unlifted bindings are
--- 	a) non-recursive,
---	b) not top level, 
---	c) not a multiple-binding group (more or less implied by (a))
-
-checkStrictBinds :: TopLevelFlag -> RecFlag
-		 -> LHsBinds TcId -> [TcType] -> [MonoBindInfo]
-		 -> TcM Bool
-checkStrictBinds top_lvl rec_group mbind mono_tys infos
-  | unlifted || bang_pat
-  = do 	{ checkTc (isNotTopLevel top_lvl)
-	  	  (strictBindErr "Top-level" unlifted mbind)
-	; checkTc (isNonRec rec_group)
-	  	  (strictBindErr "Recursive" unlifted mbind)
-	; checkTc (isSingletonBag mbind)
-	    	  (strictBindErr "Multiple" unlifted mbind) 
-	; mapM_ check_sig infos
-	; return True }
-  | otherwise
-  = return False
-  where
-    unlifted = any isUnLiftedType mono_tys
-    bang_pat = anyBag (isBangHsBind . unLoc) mbind
-    check_sig (_, Just sig, _) = checkTc (null (sig_tvs sig) && null (sig_theta sig))
-					 (badStrictSig unlifted sig)
-    check_sig other	       = return ()
-
-strictBindErr flavour unlifted mbind
-  = hang (text flavour <+> msg <+> ptext SLIT("aren't allowed:")) 4 (ppr mbind)
-  where
-    msg | unlifted  = ptext SLIT("bindings for unlifted types")
-	| otherwise = ptext SLIT("bang-pattern bindings")
-
-badStrictSig unlifted sig
-  = hang (ptext SLIT("Illegal polymorphic signature in") <+> msg)
-	 4 (ppr sig)
-  where
-    msg | unlifted  = ptext SLIT("an unlifted binding")
-	| otherwise = ptext SLIT("a bang-pattern binding")
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{tcMonoBind}
-%*									*
-%************************************************************************
-
-@tcMonoBinds@ deals with a perhaps-recursive group of HsBinds.
-The signatures have been dealt with already.
-
-\begin{code}
-tcMonoBinds :: [LHsBind Name]
-	    -> TcSigFun
-	    -> RecFlag	-- Whether the binding is recursive for typechecking purposes
-			-- i.e. the binders are mentioned in their RHSs, and
-			--	we are not resuced by a type signature
-	    -> TcM (LHsBinds TcId, [MonoBindInfo])
-
-tcMonoBinds [L b_loc (FunBind { fun_id = L nm_loc name, fun_infix = inf, 
-				fun_matches = matches, bind_fvs = fvs })]
-	    sig_fn 		-- Single function binding,
-	    NonRecursive	-- binder isn't mentioned in RHS,
-  | Nothing <- sig_fn name	-- ...with no type signature
-  = 	-- In this very special case we infer the type of the
-	-- right hand side first (it may have a higher-rank type)
-	-- and *then* make the monomorphic Id for the LHS
-	-- e.g.		f = \(x::forall a. a->a) -> <body>
-	-- 	We want to infer a higher-rank type for f
-    setSrcSpan b_loc  	$
-    do	{ ((co_fn, matches'), rhs_ty) <- tcInfer (tcMatchesFun name matches)
-
-		-- Check for an unboxed tuple type
-		--	f = (# True, False #)
-		-- Zonk first just in case it's hidden inside a meta type variable
-		-- (This shows up as a (more obscure) kind error 
-		--  in the 'otherwise' case of tcMonoBinds.)
-	; zonked_rhs_ty <- zonkTcType rhs_ty
-	; checkTc (not (isUnboxedTupleType zonked_rhs_ty))
-		  (unboxedTupleErr name zonked_rhs_ty)
-
-	; mono_name <- newLocalName name
-	; let mono_id = mkLocalId mono_name zonked_rhs_ty
-	; return (unitBag (L b_loc (FunBind { fun_id = L nm_loc mono_id, fun_infix = inf,
-					      fun_matches = matches', bind_fvs = fvs,
-					      fun_co_fn = co_fn })),
-		  [(name, Nothing, mono_id)]) }
-
-tcMonoBinds [L b_loc (FunBind { fun_id = L nm_loc name, fun_infix = inf, 
-				fun_matches = matches, bind_fvs = fvs })]
-	    sig_fn 		-- Single function binding
-	    non_rec	
-  | Just sig <- sig_fn name	-- ...with a type signature
-  = 	-- When we have a single function binding, with a type signature
-	-- we can (a) use genuine, rigid skolem constants for the type variables
-	--	  (b) bring (rigid) scoped type variables into scope
-    setSrcSpan b_loc  	$
-    do	{ tc_sig <- tcInstSig True sig
-	; mono_name <- newLocalName name
-	; let mono_ty = sig_tau tc_sig
-	      mono_id = mkLocalId mono_name mono_ty
-	      rhs_tvs = [ (name, mkTyVarTy tv)
-			| (name, tv) <- sig_scoped tc_sig `zip` sig_tvs tc_sig ]
-
-	; (co_fn, matches') <- tcExtendTyVarEnv2 rhs_tvs    $
-		    	       tcMatchesFun mono_name matches mono_ty
-
-	; let fun_bind' = FunBind { fun_id = L nm_loc mono_id, 
-				    fun_infix = inf, fun_matches = matches',
-			            bind_fvs = placeHolderNames, fun_co_fn = co_fn }
-	; return (unitBag (L b_loc fun_bind'),
-		  [(name, Just tc_sig, mono_id)]) }
-
-tcMonoBinds binds sig_fn non_rec
-  = do	{ tc_binds <- mapM (wrapLocM (tcLhs sig_fn)) binds
-
-	-- Bring the monomorphic Ids, into scope for the RHSs
-	; let mono_info  = getMonoBindInfo tc_binds
-	      rhs_id_env = [(name,mono_id) | (name, Nothing, mono_id) <- mono_info]
-			 	-- A monomorphic binding for each term variable that lacks 
-				-- a type sig.  (Ones with a sig are already in scope.)
-
-	; binds' <- tcExtendIdEnv2    rhs_id_env $
-		    traceTc (text "tcMonoBinds" <+> vcat [ ppr n <+> ppr id <+> ppr (idType id) 
-							 | (n,id) <- rhs_id_env]) `thenM_`
-		    mapM (wrapLocM tcRhs) tc_binds
-	; return (listToBag binds', mono_info) }
-
-------------------------
--- tcLhs typechecks the LHS of the bindings, to construct the environment in which
--- we typecheck the RHSs.  Basically what we are doing is this: for each binder:
---	if there's a signature for it, use the instantiated signature type
---	otherwise invent a type variable
--- You see that quite directly in the FunBind case.
--- 
--- But there's a complication for pattern bindings:
---	data T = MkT (forall a. a->a)
---	MkT f = e
--- Here we can guess a type variable for the entire LHS (which will be refined to T)
--- but we want to get (f::forall a. a->a) as the RHS environment.
--- The simplest way to do this is to typecheck the pattern, and then look up the
--- bound mono-ids.  Then we want to retain the typechecked pattern to avoid re-doing
--- it; hence the TcMonoBind data type in which the LHS is done but the RHS isn't
-
-data TcMonoBind		-- Half completed; LHS done, RHS not done
-  = TcFunBind  MonoBindInfo  (Located TcId) Bool (MatchGroup Name) 
-  | TcPatBind [MonoBindInfo] (LPat TcId) (GRHSs Name) TcSigmaType
-
-type MonoBindInfo = (Name, Maybe TcSigInfo, TcId)
-	-- Type signature (if any), and
-	-- the monomorphic bound things
-
-bndrNames :: [MonoBindInfo] -> [Name]
-bndrNames mbi = [n | (n,_,_) <- mbi]
-
-getMonoType :: MonoBindInfo -> TcTauType
-getMonoType (_,_,mono_id) = idType mono_id
-
-tcLhs :: TcSigFun -> HsBind Name -> TcM TcMonoBind
-tcLhs sig_fn (FunBind { fun_id = L nm_loc name, fun_infix = inf, fun_matches = matches })
-  = do	{ mb_sig <- tcInstSig_maybe (sig_fn name)
-	; mono_name <- newLocalName name
-	; mono_ty   <- mk_mono_ty mb_sig
-	; let mono_id = mkLocalId mono_name mono_ty
-	; return (TcFunBind (name, mb_sig, mono_id) (L nm_loc mono_id) inf matches) }
-  where
-    mk_mono_ty (Just sig) = return (sig_tau sig)
-    mk_mono_ty Nothing    = newFlexiTyVarTy argTypeKind
-
-tcLhs sig_fn bind@(PatBind { pat_lhs = pat, pat_rhs = grhss })
-  = do	{ mb_sigs <- mapM (tcInstSig_maybe . sig_fn) names
-
-	; let nm_sig_prs  = names `zip` mb_sigs
-	      tau_sig_env = mkNameEnv [ (name, sig_tau sig) | (name, Just sig) <- nm_sig_prs]
-	      sig_tau_fn  = lookupNameEnv tau_sig_env
-
-	      tc_pat exp_ty = tcPat (LetPat sig_tau_fn) pat exp_ty unitTy $ \ _ ->
-			      mapM lookup_info nm_sig_prs
-		-- The unitTy is a bit bogus; it's the "result type" for lookup_info.  
-
-		-- After typechecking the pattern, look up the binder
-		-- names, which the pattern has brought into scope.
-	      lookup_info :: (Name, Maybe TcSigInfo) -> TcM MonoBindInfo
-	      lookup_info (name, mb_sig) = do { mono_id <- tcLookupId name
-					      ; return (name, mb_sig, mono_id) }
-
-	; ((pat', infos), pat_ty) <- addErrCtxt (patMonoBindsCtxt pat grhss) $
-				     tcInfer tc_pat
-
-	; return (TcPatBind infos pat' grhss pat_ty) }
-  where
-    names = collectPatBinders pat
-
-
-tcLhs sig_fn other_bind = pprPanic "tcLhs" (ppr other_bind)
-	-- AbsBind, VarBind impossible
-
--------------------
-tcRhs :: TcMonoBind -> TcM (HsBind TcId)
-tcRhs (TcFunBind info fun'@(L _ mono_id) inf matches)
-  = do	{ (co_fn, matches') <- tcMatchesFun (idName mono_id) matches 
-				    	    (idType mono_id)
-	; return (FunBind { fun_id = fun', fun_infix = inf, fun_matches = matches',
-			    bind_fvs = placeHolderNames, fun_co_fn = co_fn }) }
-
-tcRhs bind@(TcPatBind _ pat' grhss pat_ty)
-  = do	{ grhss' <- addErrCtxt (patMonoBindsCtxt pat' grhss) $
-		    tcGRHSsPat grhss pat_ty
-	; return (PatBind { pat_lhs = pat', pat_rhs = grhss', pat_rhs_ty = pat_ty, 
-			    bind_fvs = placeHolderNames }) }
-
-
----------------------
-getMonoBindInfo :: [Located TcMonoBind] -> [MonoBindInfo]
-getMonoBindInfo tc_binds
-  = foldr (get_info . unLoc) [] tc_binds
-  where
-    get_info (TcFunBind info _ _ _)  rest = info : rest
-    get_info (TcPatBind infos _ _ _) rest = infos ++ rest
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Generalisation
-%*									*
-%************************************************************************
-
-\begin{code}
-generalise :: TopLevelFlag -> Bool 
-	   -> [MonoBindInfo] -> [Inst]
-	   -> TcM ([TcTyVar], TcDictBinds, [TcId])
-generalise top_lvl is_unrestricted mono_infos lie_req
-  | not is_unrestricted	-- RESTRICTED CASE
-  = 	-- Check signature contexts are empty 
-    do	{ checkTc (all is_mono_sig sigs)
-	  	  (restrictedBindCtxtErr bndrs)
-
-	-- Now simplify with exactly that set of tyvars
-	-- We have to squash those Methods
-	; (qtvs, binds) <- tcSimplifyRestricted doc top_lvl bndrs 
-						tau_tvs lie_req
-
-   	-- Check that signature type variables are OK
-	; final_qtvs <- checkSigsTyVars qtvs sigs
-
-	; return (final_qtvs, binds, []) }
-
-  | null sigs	-- UNRESTRICTED CASE, NO TYPE SIGS
-  = tcSimplifyInfer doc tau_tvs lie_req
-
-  | otherwise	-- UNRESTRICTED CASE, WITH TYPE SIGS
-  = do	{ sig_lie <- unifyCtxts sigs	-- sigs is non-empty
-	; let	-- The "sig_avails" is the stuff available.  We get that from
-		-- the context of the type signature, BUT ALSO the lie_avail
-		-- so that polymorphic recursion works right (see Note [Polymorphic recursion])
-		local_meths = [mkMethInst sig mono_id | (_, Just sig, mono_id) <- mono_infos]
-		sig_avails = sig_lie ++ local_meths
-
-	-- Check that the needed dicts can be
-	-- expressed in terms of the signature ones
-	; (forall_tvs, dict_binds) <- tcSimplifyInferCheck doc tau_tvs sig_avails lie_req
-	
-   	-- Check that signature type variables are OK
-	; final_qtvs <- checkSigsTyVars forall_tvs sigs
-
-	; returnM (final_qtvs, dict_binds, map instToId sig_lie) }
-  where
-    bndrs   = bndrNames mono_infos
-    sigs    = [sig | (_, Just sig, _) <- mono_infos]
-    tau_tvs = foldr (unionVarSet . exactTyVarsOfType . getMonoType) emptyVarSet mono_infos
-		-- NB: exactTyVarsOfType; see Note [Silly type synonym] 
-		--     near defn of TcType.exactTyVarsOfType
-    is_mono_sig sig = null (sig_theta sig)
-    doc = ptext SLIT("type signature(s) for") <+> pprBinders bndrs
-
-    mkMethInst (TcSigInfo { sig_id = poly_id, sig_tvs = tvs, 
-		            sig_theta = theta, sig_loc = loc }) mono_id
-      = Method mono_id poly_id (mkTyVarTys tvs) theta loc
-\end{code}
-
-unifyCtxts checks that all the signature contexts are the same
-The type signatures on a mutually-recursive group of definitions
-must all have the same context (or none).
-
-The trick here is that all the signatures should have the same
-context, and we want to share type variables for that context, so that
-all the right hand sides agree a common vocabulary for their type
-constraints
-
-We unify them because, with polymorphic recursion, their types
-might not otherwise be related.  This is a rather subtle issue.
-
-\begin{code}
-unifyCtxts :: [TcSigInfo] -> TcM [Inst]
-unifyCtxts (sig1 : sigs) 	-- Argument is always non-empty
-  = do	{ mapM unify_ctxt sigs
-	; newDictsAtLoc (sig_loc sig1) (sig_theta sig1) }
-  where
-    theta1 = sig_theta sig1
-    unify_ctxt :: TcSigInfo -> TcM ()
-    unify_ctxt sig@(TcSigInfo { sig_theta = theta })
-	= setSrcSpan (instLocSrcSpan (sig_loc sig)) 	$
-	  addErrCtxt (sigContextsCtxt sig1 sig)		$
-	  unifyTheta theta1 theta
-
-checkSigsTyVars :: [TcTyVar] -> [TcSigInfo] -> TcM [TcTyVar]
-checkSigsTyVars qtvs sigs 
-  = do	{ gbl_tvs <- tcGetGlobalTyVars
-	; sig_tvs_s <- mappM (check_sig gbl_tvs) sigs
-
-	; let	-- Sigh.  Make sure that all the tyvars in the type sigs
-		-- appear in the returned ty var list, which is what we are
-		-- going to generalise over.  Reason: we occasionally get
-		-- silly types like
-		--	type T a = () -> ()
-		--	f :: T a
-		--	f () = ()
-		-- Here, 'a' won't appear in qtvs, so we have to add it
-	 	sig_tvs = foldl extendVarSetList emptyVarSet sig_tvs_s
-		all_tvs = varSetElems (extendVarSetList sig_tvs qtvs)
-	; returnM all_tvs }
-  where
-    check_sig gbl_tvs (TcSigInfo {sig_id = id, sig_tvs = tvs, 
-				  sig_theta = theta, sig_tau = tau})
-      = addErrCtxt (ptext SLIT("In the type signature for") <+> quotes (ppr id))	$
-	addErrCtxtM (sigCtxt id tvs theta tau)						$
-	do { tvs' <- checkDistinctTyVars tvs
-	   ; ifM (any (`elemVarSet` gbl_tvs) tvs')
-		 (bleatEscapedTvs gbl_tvs tvs tvs') 
-	   ; return tvs' }
-
-checkDistinctTyVars :: [TcTyVar] -> TcM [TcTyVar]
--- (checkDistinctTyVars tvs) checks that the tvs from one type signature
--- are still all type variables, and all distinct from each other.  
--- It returns a zonked set of type variables.
--- For example, if the type sig is
---	f :: forall a b. a -> b -> b
--- we want to check that 'a' and 'b' haven't 
---	(a) been unified with a non-tyvar type
---	(b) been unified with each other (all distinct)
-
-checkDistinctTyVars sig_tvs
-  = do	{ zonked_tvs <- mapM zonkSigTyVar sig_tvs
-	; foldlM check_dup emptyVarEnv (sig_tvs `zip` zonked_tvs)
-	; return zonked_tvs }
-  where
-    check_dup :: TyVarEnv TcTyVar -> (TcTyVar, TcTyVar) -> TcM (TyVarEnv TcTyVar)
-	-- The TyVarEnv maps each zonked type variable back to its
-	-- corresponding user-written signature type variable
-    check_dup acc (sig_tv, zonked_tv)
-	= case lookupVarEnv acc zonked_tv of
-		Just sig_tv' -> bomb_out sig_tv sig_tv'
-
-		Nothing -> return (extendVarEnv acc zonked_tv sig_tv)
-
-    bomb_out sig_tv1 sig_tv2
-       = do { env0 <- tcInitTidyEnv
-	    ; let (env1, tidy_tv1) = tidyOpenTyVar env0 sig_tv1
-		  (env2, tidy_tv2) = tidyOpenTyVar env1 sig_tv2
-	          msg = ptext SLIT("Quantified type variable") <+> quotes (ppr tidy_tv1) 
-		         <+> ptext SLIT("is unified with another quantified type variable") 
-		         <+> quotes (ppr tidy_tv2)
-	    ; failWithTcM (env2, msg) }
-       where
-\end{code}    
-
-
-@getTyVarsToGen@ decides what type variables to generalise over.
-
-For a "restricted group" -- see the monomorphism restriction
-for a definition -- we bind no dictionaries, and
-remove from tyvars_to_gen any constrained type variables
-
-*Don't* simplify dicts at this point, because we aren't going
-to generalise over these dicts.  By the time we do simplify them
-we may well know more.  For example (this actually came up)
-	f :: Array Int Int
-	f x = array ... xs where xs = [1,2,3,4,5]
-We don't want to generate lots of (fromInt Int 1), (fromInt Int 2)
-stuff.  If we simplify only at the f-binding (not the xs-binding)
-we'll know that the literals are all Ints, and we can just produce
-Int literals!
-
-Find all the type variables involved in overloading, the
-"constrained_tyvars".  These are the ones we *aren't* going to
-generalise.  We must be careful about doing this:
-
- (a) If we fail to generalise a tyvar which is not actually
-	constrained, then it will never, ever get bound, and lands
-	up printed out in interface files!  Notorious example:
-		instance Eq a => Eq (Foo a b) where ..
-	Here, b is not constrained, even though it looks as if it is.
-	Another, more common, example is when there's a Method inst in
-	the LIE, whose type might very well involve non-overloaded
-	type variables.
-  [NOTE: Jan 2001: I don't understand the problem here so I'm doing 
-	the simple thing instead]
-
- (b) On the other hand, we mustn't generalise tyvars which are constrained,
-	because we are going to pass on out the unmodified LIE, with those
-	tyvars in it.  They won't be in scope if we've generalised them.
-
-So we are careful, and do a complete simplification just to find the
-constrained tyvars. We don't use any of the results, except to
-find which tyvars are constrained.
-
-Note [Polymorphic recursion]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The game plan for polymorphic recursion in the code above is 
-
-	* Bind any variable for which we have a type signature
-	  to an Id with a polymorphic type.  Then when type-checking 
-	  the RHSs we'll make a full polymorphic call.
-
-This fine, but if you aren't a bit careful you end up with a horrendous
-amount of partial application and (worse) a huge space leak. For example:
-
-	f :: Eq a => [a] -> [a]
-	f xs = ...f...
-
-If we don't take care, after typechecking we get
-
-	f = /\a -> \d::Eq a -> let f' = f a d
-			       in
-			       \ys:[a] -> ...f'...
-
-Notice the the stupid construction of (f a d), which is of course
-identical to the function we're executing.  In this case, the
-polymorphic recursion isn't being used (but that's a very common case).
-This can lead to a massive space leak, from the following top-level defn
-(post-typechecking)
-
-	ff :: [Int] -> [Int]
-	ff = f Int dEqInt
-
-Now (f dEqInt) evaluates to a lambda that has f' as a free variable; but
-f' is another thunk which evaluates to the same thing... and you end
-up with a chain of identical values all hung onto by the CAF ff.
-
-	ff = f Int dEqInt
-
-	   = let f' = f Int dEqInt in \ys. ...f'...
-
-	   = let f' = let f' = f Int dEqInt in \ys. ...f'...
-		      in \ys. ...f'...
-
-Etc.
-
-NOTE: a bit of arity anaysis would push the (f a d) inside the (\ys...),
-which would make the space leak go away in this case
-
-Solution: when typechecking the RHSs we always have in hand the
-*monomorphic* Ids for each binding.  So we just need to make sure that
-if (Method f a d) shows up in the constraints emerging from (...f...)
-we just use the monomorphic Id.  We achieve this by adding monomorphic Ids
-to the "givens" when simplifying constraints.  That's what the "lies_avail"
-is doing.
-
-Then we get
-
-	f = /\a -> \d::Eq a -> letrec
-				 fm = \ys:[a] -> ...fm...
-			       in
-			       fm
-
-
-
-%************************************************************************
-%*									*
-		Signatures
-%*									*
-%************************************************************************
-
-Type signatures are tricky.  See Note [Signature skolems] in TcType
-
-@tcSigs@ checks the signatures for validity, and returns a list of
-{\em freshly-instantiated} signatures.  That is, the types are already
-split up, and have fresh type variables installed.  All non-type-signature
-"RenamedSigs" are ignored.
-
-The @TcSigInfo@ contains @TcTypes@ because they are unified with
-the variable's type, and after that checked to see whether they've
-been instantiated.
-
-\begin{code}
-type TcSigFun = Name -> Maybe (LSig Name)
-
-mkSigFun :: [LSig Name] -> TcSigFun
--- Search for a particular type signature
--- Precondition: the sigs are all type sigs
--- Precondition: no duplicates
-mkSigFun sigs = lookupNameEnv env
-  where
-    env = mkNameEnv [(expectJust "mkSigFun" (sigName sig), sig) | sig <- sigs]
-
----------------
-data TcSigInfo
-  = TcSigInfo {
-	sig_id     :: TcId,		--  *Polymorphic* binder for this value...
-
-	sig_scoped :: [Name],		-- Names for any scoped type variables
-					-- Invariant: correspond 1-1 with an initial
-					-- segment of sig_tvs (see Note [Scoped])
-
-	sig_tvs    :: [TcTyVar],	-- Instantiated type variables
-					-- See Note [Instantiate sig]
-
-	sig_theta  :: TcThetaType,	-- Instantiated theta
-	sig_tau    :: TcTauType,	-- Instantiated tau
-	sig_loc    :: InstLoc	 	-- The location of the signature
-    }
-
--- 	Note [Scoped]
--- There may be more instantiated type variables than scoped 
--- ones.  For example:
---	type T a = forall b. b -> (a,b)
---	f :: forall c. T c
--- Here, the signature for f will have one scoped type variable, c,
--- but two instantiated type variables, c' and b'.  
---
--- We assume that the scoped ones are at the *front* of sig_tvs,
--- and remember the names from the original HsForAllTy in sig_scoped
-
--- 	Note [Instantiate sig]
--- It's vital to instantiate a type signature with fresh variable.
--- For example:
---	type S = forall a. a->a
---	f,g :: S
---	f = ...
---	g = ...
--- Here, we must use distinct type variables when checking f,g's right hand sides.
--- (Instantiation is only necessary because of type synonyms.  Otherwise,
--- it's all cool; each signature has distinct type variables from the renamer.)
-
-instance Outputable TcSigInfo where
-    ppr (TcSigInfo { sig_id = id, sig_tvs = tyvars, sig_theta = theta, sig_tau = tau})
-	= ppr id <+> ptext SLIT("::") <+> ppr tyvars <+> ppr theta <+> ptext SLIT("=>") <+> ppr tau
-\end{code}
-
-\begin{code}
-tcTySig :: LSig Name -> TcM TcId
-tcTySig (L span (TypeSig (L _ name) ty))
-  = setSrcSpan span		$
-    do	{ sigma_ty <- tcHsSigType (FunSigCtxt name) ty
-	; return (mkLocalId name sigma_ty) }
-
--------------------
-tcInstSig_maybe :: Maybe (LSig Name) -> TcM (Maybe TcSigInfo)
--- Instantiate with *meta* type variables; 
--- this signature is part of a multi-signature group
-tcInstSig_maybe Nothing    = return Nothing
-tcInstSig_maybe (Just sig) = do { tc_sig <- tcInstSig False sig
-				; return (Just tc_sig) }
-
-tcInstSig :: Bool -> LSig Name -> TcM TcSigInfo
--- Instantiate the signature, with either skolems or meta-type variables
--- depending on the use_skols boolean
---
--- We always instantiate with freshs uniques,
--- although we keep the same print-name
---	
---	type T = forall a. [a] -> [a]
---	f :: T; 
---	f = g where { g :: T; g = <rhs> }
---
--- We must not use the same 'a' from the defn of T at both places!!
-
-tcInstSig use_skols (L loc (TypeSig (L _ name) hs_ty))
-  = setSrcSpan loc $
-    do	{ poly_id <- tcLookupId name	-- Cannot fail; the poly ids are put into 
-					-- scope when starting the binding group
-	; let skol_info = SigSkol (FunSigCtxt name)
-	      inst_tyvars | use_skols = tcInstSkolTyVars skol_info
-			  | otherwise = tcInstSigTyVars  skol_info
-	; (tvs, theta, tau) <- tcInstType inst_tyvars (idType poly_id)
-	; loc <- getInstLoc (SigOrigin skol_info)
-	; return (TcSigInfo { sig_id = poly_id,
-			      sig_tvs = tvs, sig_theta = theta, sig_tau = tau, 
-			      sig_scoped = scoped_names, sig_loc = loc }) }
-		-- Note that the scoped_names and the sig_tvs will have
-		-- different Names. That's quite ok; when we bring the 
-		-- scoped_names into scope, we just bind them to the sig_tvs
-  where
-	-- The scoped names are the ones explicitly mentioned
-	-- in the HsForAll.  (There may be more in sigma_ty, because
-	-- of nested type synonyms.  See Note [Scoped] with TcSigInfo.)
-	-- We also only have scoped type variables when we are instantiating
-	-- with true skolems
-    scoped_names = case (use_skols, hs_ty) of
-		     (True, L _ (HsForAllTy Explicit tvs _ _)) -> hsLTyVarNames tvs
-		     other 		    		       -> []
-
--------------------
-isUnRestrictedGroup :: [LHsBind Name] -> TcSigFun -> TcM Bool
-isUnRestrictedGroup binds sig_fn
-  = do	{ mono_restriction <- doptM Opt_MonomorphismRestriction
-	; return (not mono_restriction || all_unrestricted) }
-  where 
-    all_unrestricted = all (unrestricted . unLoc) binds
-    has_sig n = isJust (sig_fn n)
-
-    unrestricted (PatBind {})  					 = False
-    unrestricted (VarBind { var_id = v })		         = has_sig v
-    unrestricted (FunBind { fun_id = v, fun_matches = matches }) = unrestricted_match matches 
-								 || has_sig (unLoc v)
-
-    unrestricted_match (MatchGroup (L _ (Match [] _ _) : _) _) = False
-	-- No args => like a pattern binding
-    unrestricted_match other	          = True
-	-- Some args => a function binding
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[TcBinds-errors]{Error contexts and messages}
-%*									*
-%************************************************************************
-
-
-\begin{code}
--- This one is called on LHS, when pat and grhss are both Name 
--- and on RHS, when pat is TcId and grhss is still Name
-patMonoBindsCtxt pat grhss
-  = hang (ptext SLIT("In a pattern binding:")) 4 (pprPatBind pat grhss)
-
------------------------------------------------
-sigContextsCtxt sig1 sig2
-  = vcat [ptext SLIT("When matching the contexts of the signatures for"), 
-	  nest 2 (vcat [ppr id1 <+> dcolon <+> ppr (idType id1),
-			ppr id2 <+> dcolon <+> ppr (idType id2)]),
-	  ptext SLIT("The signature contexts in a mutually recursive group should all be identical")]
-  where
-    id1 = sig_id sig1
-    id2 = sig_id sig2
-
-
------------------------------------------------
-unboxedTupleErr name ty
-  = hang (ptext SLIT("Illegal binding of unboxed tuple"))
-	 4 (ppr name <+> dcolon <+> ppr ty)
-
------------------------------------------------
-restrictedBindCtxtErr binder_names
-  = hang (ptext SLIT("Illegal overloaded type signature(s)"))
-       4 (vcat [ptext SLIT("in a binding group for") <+> pprBinders binder_names,
-		ptext SLIT("that falls under the monomorphism restriction")])
-
-genCtxt binder_names
-  = ptext SLIT("When generalising the type(s) for") <+> pprBinders binder_names
-\end{code}
diff --git a/ghc/compiler/typecheck/TcClassDcl.lhs b/ghc/compiler/typecheck/TcClassDcl.lhs
deleted file mode 100644
index 14682a295d..0000000000
--- a/ghc/compiler/typecheck/TcClassDcl.lhs
+++ /dev/null
@@ -1,790 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcClassDcl]{Typechecking class declarations}
-
-\begin{code}
-module TcClassDcl ( tcClassSigs, tcClassDecl2, 
-		    getGenericInstances, 
-		    MethodSpec, tcMethodBind, mkMethodBind, 
-		    tcAddDeclCtxt, badMethodErr
-		  ) where
-
-#include "HsVersions.h"
-
-import HsSyn
-import RnHsSyn		( maybeGenericMatch, extractHsTyVars )
-import RnExpr		( rnLExpr )
-import RnEnv		( lookupTopBndrRn, lookupImportedName )
-import Inst		( instToId, newDicts, newDictsAtLoc, newMethod, getOverlapFlag )
-import InstEnv		( mkLocalInstance )
-import TcEnv		( tcLookupLocatedClass, 
-			  tcExtendTyVarEnv, tcExtendIdEnv,
-			  InstInfo(..), pprInstInfoDetails,
-			  simpleInstInfoTyCon, simpleInstInfoTy,
-			  InstBindings(..), newDFunName
-			)
-import TcBinds		( TcPragFun, tcMonoBinds, tcPrags, mkPragFun, TcSigInfo(..) )
-import TcHsType		( tcHsKindedType, tcHsSigType )
-import TcSimplify	( tcSimplifyCheck )
-import TcUnify		( checkSigTyVars, sigCtxt )
-import TcMType		( tcSkolSigTyVars )
-import TcType		( Type, SkolemInfo(ClsSkol, InstSkol), UserTypeCtxt( GenPatCtxt ),
-			  TcType, TcThetaType, TcTyVar, mkTyVarTys,
-			  mkClassPred, tcSplitSigmaTy, tcSplitFunTys,
-			  tcIsTyVarTy, tcSplitTyConApp_maybe, tcSplitForAllTys, tcSplitPhiTy,
-			  getClassPredTys_maybe, mkPhiTy, mkTyVarTy
-			)
-import TcRnMonad
-import Generics		( mkGenericRhs, validGenericInstanceType )
-import PrelInfo		( nO_METHOD_BINDING_ERROR_ID )
-import Class		( classTyVars, classBigSig, 
-			  Class, ClassOpItem, DefMeth (..) )
-import TyCon		( TyCon, tyConName, tyConHasGenerics )
-import Type		( substTyWith )
-import MkId		( mkDefaultMethodId, mkDictFunId )
-import Id		( Id, idType, idName, mkUserLocal )
-import Name		( Name, NamedThing(..) )
-import NameEnv		( NameEnv, lookupNameEnv, mkNameEnv )
-import NameSet		( nameSetToList )
-import OccName		( reportIfUnused, mkDefaultMethodOcc )
-import RdrName		( RdrName, mkDerivedRdrName )
-import Outputable
-import PrelNames	( genericTyConNames )
-import DynFlags
-import ErrUtils		( dumpIfSet_dyn )
-import Util		( count, lengthIs, isSingleton, lengthExceeds )
-import Unique		( Uniquable(..) )
-import ListSetOps	( equivClassesByUniq, minusList	)
-import SrcLoc		( Located(..), srcSpanStart, unLoc, noLoc )
-import Maybes		( seqMaybe, isJust, mapCatMaybes )
-import List		( partition )
-import BasicTypes	( RecFlag(..), Boxity(..) )
-import Bag
-import FastString
-\end{code}
-
-
-
-Dictionary handling
-~~~~~~~~~~~~~~~~~~~
-Every class implicitly declares a new data type, corresponding to dictionaries
-of that class. So, for example:
-
-	class (D a) => C a where
-	  op1 :: a -> a
-	  op2 :: forall b. Ord b => a -> b -> b
-
-would implicitly declare
-
-	data CDict a = CDict (D a)	
-			     (a -> a)
-			     (forall b. Ord b => a -> b -> b)
-
-(We could use a record decl, but that means changing more of the existing apparatus.
-One step at at time!)
-
-For classes with just one superclass+method, we use a newtype decl instead:
-
-	class C a where
-	  op :: forallb. a -> b -> b
-
-generates
-
-	newtype CDict a = CDict (forall b. a -> b -> b)
-
-Now DictTy in Type is just a form of type synomym: 
-	DictTy c t = TyConTy CDict `AppTy` t
-
-Death to "ExpandingDicts".
-
-
-%************************************************************************
-%*									*
-		Type-checking the class op signatures
-%*									*
-%************************************************************************
-
-\begin{code}
-tcClassSigs :: Name	    		-- Name of the class
-	    -> [LSig Name]
-	    -> LHsBinds Name
-	    -> TcM [TcMethInfo]
-
-type TcMethInfo = (Name, DefMeth, Type)	-- A temporary intermediate, to communicate 
-					-- between tcClassSigs and buildClass
-tcClassSigs clas sigs def_methods
-  = do { dm_env <- checkDefaultBinds clas op_names def_methods
-       ; mappM (tcClassSig dm_env) op_sigs }
-  where
-    op_sigs  = [sig | sig@(L _ (TypeSig _ _))       <- sigs]
-    op_names = [n   | sig@(L _ (TypeSig (L _ n) _)) <- op_sigs]
-
-
-checkDefaultBinds :: Name -> [Name] -> LHsBinds Name -> TcM (NameEnv Bool)
-  -- Check default bindings
-  -- 	a) must be for a class op for this class
-  --	b) must be all generic or all non-generic
-  -- and return a mapping from class-op to Bool
-  --	where True <=> it's a generic default method
-checkDefaultBinds clas ops binds
-  = do dm_infos <- mapM (addLocM (checkDefaultBind clas ops)) (bagToList binds)
-       return (mkNameEnv dm_infos)
-
-checkDefaultBind clas ops (FunBind {fun_id = L _ op, fun_matches = MatchGroup matches _ })
-  = do {  	-- Check that the op is from this class
-	checkTc (op `elem` ops) (badMethodErr clas op)
-
-   	-- Check that all the defns ar generic, or none are
-    ;	checkTc (all_generic || none_generic) (mixedGenericErr op)
-
-    ;	returnM (op, all_generic)
-    }
-  where
-    n_generic    = count (isJust . maybeGenericMatch) matches
-    none_generic = n_generic == 0
-    all_generic  = matches `lengthIs` n_generic
-
-
-tcClassSig :: NameEnv Bool		-- Info about default methods; 
-	   -> LSig Name
-	   -> TcM TcMethInfo
-
-tcClassSig dm_env (L loc (TypeSig (L _ op_name) op_hs_ty))
-  = setSrcSpan loc $ do
-    { op_ty <- tcHsKindedType op_hs_ty	-- Class tyvars already in scope
-    ; let dm = case lookupNameEnv dm_env op_name of
-		Nothing    -> NoDefMeth
-		Just False -> DefMeth
-		Just True  -> GenDefMeth
-    ; returnM (op_name, dm, op_ty) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Default methods]{Default methods}
-%*									*
-%************************************************************************
-
-The default methods for a class are each passed a dictionary for the
-class, so that they get access to the other methods at the same type.
-So, given the class decl
-\begin{verbatim}
-class Foo a where
-	op1 :: a -> Bool
-	op2 :: Ord b => a -> b -> b -> b
-
-	op1 x = True
-	op2 x y z = if (op1 x) && (y < z) then y else z
-\end{verbatim}
-we get the default methods:
-\begin{verbatim}
-defm.Foo.op1 :: forall a. Foo a => a -> Bool
-defm.Foo.op1 = /\a -> \dfoo -> \x -> True
-
-defm.Foo.op2 :: forall a. Foo a => forall b. Ord b => a -> b -> b -> b
-defm.Foo.op2 = /\ a -> \ dfoo -> /\ b -> \ dord -> \x y z ->
-		  if (op1 a dfoo x) && (< b dord y z) then y else z
-\end{verbatim}
-
-When we come across an instance decl, we may need to use the default
-methods:
-\begin{verbatim}
-instance Foo Int where {}
-\end{verbatim}
-gives
-\begin{verbatim}
-const.Foo.Int.op1 :: Int -> Bool
-const.Foo.Int.op1 = defm.Foo.op1 Int dfun.Foo.Int
-
-const.Foo.Int.op2 :: forall b. Ord b => Int -> b -> b -> b
-const.Foo.Int.op2 = defm.Foo.op2 Int dfun.Foo.Int
-
-dfun.Foo.Int :: Foo Int
-dfun.Foo.Int = (const.Foo.Int.op1, const.Foo.Int.op2)
-\end{verbatim}
-Notice that, as with method selectors above, we assume that dictionary
-application is curried, so there's no need to mention the Ord dictionary
-in const.Foo.Int.op2 (or the type variable).
-
-\begin{verbatim}
-instance Foo a => Foo [a] where {}
-
-dfun.Foo.List :: forall a. Foo a -> Foo [a]
-dfun.Foo.List
-  = /\ a -> \ dfoo_a ->
-    let rec
-	op1 = defm.Foo.op1 [a] dfoo_list
-	op2 = defm.Foo.op2 [a] dfoo_list
-	dfoo_list = (op1, op2)
-    in
-	dfoo_list
-\end{verbatim}
-
-@tcClassDecls2@ generates bindings for polymorphic default methods
-(generic default methods have by now turned into instance declarations)
-
-\begin{code}
-tcClassDecl2 :: LTyClDecl Name		-- The class declaration
-	     -> TcM (LHsBinds Id, [Id])
-
-tcClassDecl2 (L loc (ClassDecl {tcdLName = class_name, tcdSigs = sigs, 
-				tcdMeths = default_binds}))
-  = recoverM (returnM (emptyLHsBinds, []))	$ 
-    setSrcSpan loc		   			$
-    tcLookupLocatedClass class_name			`thenM` \ clas ->
-
-	-- We make a separate binding for each default method.
-	-- At one time I used a single AbsBinds for all of them, thus
-	-- AbsBind [d] [dm1, dm2, dm3] { dm1 = ...; dm2 = ...; dm3 = ... }
-	-- But that desugars into
-	--	ds = \d -> (..., ..., ...)
-	--	dm1 = \d -> case ds d of (a,b,c) -> a
-	-- And since ds is big, it doesn't get inlined, so we don't get good
-	-- default methods.  Better to make separate AbsBinds for each
-    let
-	(tyvars, _, _, op_items) = classBigSig clas
-	prag_fn			 = mkPragFun sigs
-	tc_dm			 = tcDefMeth clas tyvars default_binds prag_fn
-
-	dm_sel_ids		 = [sel_id | (sel_id, DefMeth) <- op_items]
-	-- Generate code for polymorphic default methods only
-	-- (Generic default methods have turned into instance decls by now.)
-	-- This is incompatible with Hugs, which expects a polymorphic 
-	-- default method for every class op, regardless of whether or not 
-	-- the programmer supplied an explicit default decl for the class.  
-	-- (If necessary we can fix that, but we don't have a convenient Id to hand.)
-    in
-    mapAndUnzipM tc_dm dm_sel_ids	`thenM` \ (defm_binds, dm_ids_s) ->
-    returnM (listToBag defm_binds, concat dm_ids_s)
-    
-tcDefMeth clas tyvars binds_in prag_fn sel_id
-  = do	{ dm_name <- lookupTopBndrRn (mkDefMethRdrName sel_id)
-	; let	rigid_info  = ClsSkol clas
-		clas_tyvars = tcSkolSigTyVars rigid_info tyvars
-		inst_tys    = mkTyVarTys clas_tyvars
-		dm_ty       = idType sel_id	-- Same as dict selector!
-	        theta       = [mkClassPred clas inst_tys]
-		local_dm_id = mkDefaultMethodId dm_name dm_ty
-		origin 	    = SigOrigin rigid_info
-
-	; (_, meth_info) <- mkMethodBind origin clas inst_tys binds_in (sel_id, DefMeth)
-	; [this_dict] <- newDicts origin theta
-	; (defm_bind, insts_needed) <- getLIE (tcMethodBind clas_tyvars theta 
-							    [this_dict] prag_fn meth_info)
-    
-	; addErrCtxt (defltMethCtxt clas) $ do
-    
-        -- Check the context
-	{ dict_binds <- tcSimplifyCheck
-			        (ptext SLIT("class") <+> ppr clas)
-				clas_tyvars
-			        [this_dict]
-			        insts_needed
-
-	-- Simplification can do unification
-	; checkSigTyVars clas_tyvars
-    
-	-- Inline pragmas 
-	-- We'll have an inline pragma on the local binding, made by tcMethodBind
-	-- but that's not enough; we want one on the global default method too
-	-- Specialisations, on the other hand, belong on the thing inside only, I think
-	; let (_,dm_inst_id,_) = meth_info
-	      sel_name	       = idName sel_id
-	      inline_prags     = filter isInlineLSig (prag_fn sel_name)
-	; prags <- tcPrags dm_inst_id inline_prags
-
-	; let full_bind = AbsBinds  clas_tyvars
-		    		    [instToId this_dict]
-		    		    [(clas_tyvars, local_dm_id, dm_inst_id, prags)]
-		    		    (dict_binds `unionBags` defm_bind)
-	; returnM (noLoc full_bind, [local_dm_id]) }}
-
-mkDefMethRdrName :: Id -> RdrName
-mkDefMethRdrName sel_id = mkDerivedRdrName (idName sel_id) mkDefaultMethodOcc
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Typechecking a method}
-%*									*
-%************************************************************************
-
-@tcMethodBind@ is used to type-check both default-method and
-instance-decl method declarations.  We must type-check methods one at a
-time, because their signatures may have different contexts and
-tyvar sets.
-
-\begin{code}
-type MethodSpec = (Id, 			-- Global selector Id
-		   Id, 			-- Local Id (class tyvars instantiated)
-		   LHsBind Name)	-- Binding for the method
-
-tcMethodBind 
-	:: [TcTyVar]		-- Skolemised type variables for the
-				--  	enclosing class/instance decl. 
-				--  	They'll be signature tyvars, and we
-				--  	want to check that they don't get bound
-				-- Also they are scoped, so we bring them into scope
-				-- Always equal the range of the type envt
-	-> TcThetaType		-- Available theta; it's just used for the error message
-	-> [Inst]		-- Available from context, used to simplify constraints 
-				-- 	from the method body
-	-> TcPragFun		-- Pragmas (e.g. inline pragmas)
-	-> MethodSpec		-- Details of this method
-	-> TcM (LHsBinds Id)
-
-tcMethodBind inst_tyvars inst_theta avail_insts prag_fn
-	     (sel_id, meth_id, meth_bind)
-  = recoverM (returnM emptyLHsBinds) $
-	-- If anything fails, recover returning no bindings.
-	-- This is particularly useful when checking the default-method binding of
-	-- a class decl. If we don't recover, we don't add the default method to
-	-- the type enviroment, and we get a tcLookup failure on $dmeth later.
-
-    	-- Check the bindings; first adding inst_tyvars to the envt
-	-- so that we don't quantify over them in nested places
-
-	
-    let meth_sig = noLoc (TypeSig (noLoc (idName meth_id)) (noLoc bogus_ty))
-	bogus_ty = HsTupleTy Boxed []	-- *Only* used to extract scoped type
-					-- variables... and there aren't any
-        lookup_sig name = ASSERT( name == idName meth_id ) 
-			  Just meth_sig
-    in
-    tcExtendTyVarEnv inst_tyvars (
-	tcExtendIdEnv [meth_id] 	$	-- In scope for tcInstSig
-	addErrCtxt (methodCtxt sel_id)	$
-	getLIE 				$
-	tcMonoBinds [meth_bind] lookup_sig Recursive
-    )					`thenM` \ ((meth_bind, mono_bind_infos), meth_lie) ->
-
-	-- Now do context reduction.   We simplify wrt both the local tyvars
-	-- and the ones of the class/instance decl, so that there is
-	-- no problem with
-	--	class C a where
-	--	  op :: Eq a => a -> b -> a
-	--
-	-- We do this for each method independently to localise error messages
-
-    let
-	[(_, Just sig, local_meth_id)] = mono_bind_infos
-    in
-
-    addErrCtxtM (sigCtxt sel_id inst_tyvars inst_theta (idType meth_id))	$
-    newDictsAtLoc (sig_loc sig) (sig_theta sig)		`thenM` \ meth_dicts ->
-    let
-	meth_tvs   = sig_tvs sig
-	all_tyvars = meth_tvs ++ inst_tyvars
-	all_insts  = avail_insts ++ meth_dicts
-	sel_name   = idName sel_id
-    in
-    tcSimplifyCheck
-	 (ptext SLIT("class or instance method") <+> quotes (ppr sel_id))
-	 all_tyvars all_insts meth_lie		`thenM` \ lie_binds ->
-
-    checkSigTyVars all_tyvars			`thenM_`
-
-    tcPrags meth_id (prag_fn sel_name)		`thenM` \ prags -> 
-    let
-	poly_meth_bind = noLoc $ AbsBinds meth_tvs
-				  (map instToId meth_dicts)
-     				  [(meth_tvs, meth_id, local_meth_id, prags)]
-				  (lie_binds `unionBags` meth_bind)
-    in
-    returnM (unitBag poly_meth_bind)
-
-
-mkMethodBind :: InstOrigin
-	     -> Class -> [TcType]	-- Class and instance types
-	     -> LHsBinds Name	-- Method binding (pick the right one from in here)
-	     -> ClassOpItem
-	     -> TcM (Maybe Inst,		-- Method inst
-		     MethodSpec)
--- Find the binding for the specified method, or make
--- up a suitable default method if it isn't there
-
-mkMethodBind origin clas inst_tys meth_binds (sel_id, dm_info)
-  = mkMethId origin clas sel_id inst_tys		`thenM` \ (mb_inst, meth_id) ->
-    let
-	meth_name  = idName meth_id
-    in
-	-- Figure out what method binding to use
-	-- If the user suppplied one, use it, else construct a default one
-    getSrcSpanM					`thenM` \ loc -> 
-    (case find_bind (idName sel_id) meth_name meth_binds of
-	Just user_bind -> returnM user_bind 
-	Nothing	       -> 
-	   mkDefMethRhs origin clas inst_tys sel_id loc dm_info	`thenM` \ rhs ->
-		-- Not infix decl
-	   returnM (noLoc $ mkFunBind (noLoc meth_name) [mkSimpleMatch [] rhs])
-    )						`thenM` \ meth_bind ->
-
-    returnM (mb_inst, (sel_id, meth_id, meth_bind))
-
-mkMethId :: InstOrigin -> Class 
-	 -> Id -> [TcType]	-- Selector, and instance types
-	 -> TcM (Maybe Inst, Id)
-	     
--- mkMethId instantiates the selector Id at the specified types
-mkMethId origin clas sel_id inst_tys
-  = let
-	(tyvars,rho) = tcSplitForAllTys (idType sel_id)
-	rho_ty	     = ASSERT( length tyvars == length inst_tys )
-		       substTyWith tyvars inst_tys rho
-	(preds,tau)  = tcSplitPhiTy rho_ty
-        first_pred   = head preds
-    in
-	-- The first predicate should be of form (C a b)
-	-- where C is the class in question
-    ASSERT( not (null preds) && 
-	    case getClassPredTys_maybe first_pred of
-		{ Just (clas1,tys) -> clas == clas1 ; Nothing -> False }
-    )
-    if isSingleton preds then
-	-- If it's the only one, make a 'method'
-	getInstLoc origin			`thenM` \ inst_loc ->
-    	newMethod inst_loc sel_id inst_tys 	`thenM` \ meth_inst ->
-	returnM (Just meth_inst, instToId meth_inst)
-    else
-	-- If it's not the only one we need to be careful
-	-- For example, given 'op' defined thus:
-	--	class Foo a where
-	--	  op :: (?x :: String) => a -> a
-	-- (mkMethId op T) should return an Inst with type
-	--	(?x :: String) => T -> T
-	-- That is, the class-op's context is still there.  
-	-- BUT: it can't be a Method any more, because it breaks
-	-- 	INVARIANT 2 of methods.  (See the data decl for Inst.)
-	newUnique			`thenM` \ uniq ->
-	getSrcSpanM			`thenM` \ loc ->
-	let 
-	    real_tau = mkPhiTy (tail preds) tau
-	    meth_id  = mkUserLocal (getOccName sel_id) uniq real_tau 
-			(srcSpanStart loc) --TODO
-	in
-	returnM (Nothing, meth_id)
-
-     -- The user didn't supply a method binding, 
-     -- so we have to make up a default binding
-     -- The RHS of a default method depends on the default-method info
-mkDefMethRhs origin clas inst_tys sel_id loc DefMeth
-  =  -- An polymorphic default method
-    lookupImportedName (mkDefMethRdrName sel_id)	`thenM` \ dm_name ->
-	-- Might not be imported, but will be an OrigName
-    traceRn (text "mkDefMeth" <+> ppr dm_name)		`thenM_`
-    returnM (nlHsVar dm_name)
-
-mkDefMethRhs origin clas inst_tys sel_id loc NoDefMeth
-  =  	-- No default method
-	-- Warn only if -fwarn-missing-methods
-    doptM Opt_WarnMissingMethods 		`thenM` \ warn -> 
-    warnTc (isInstDecl origin
-	   && warn
-	   && reportIfUnused (getOccName sel_id))
-   	   (omittedMethodWarn sel_id)		`thenM_`
-    returnM error_rhs
-  where
-    error_rhs  = noLoc $ HsLam (mkMatchGroup [mkSimpleMatch wild_pats simple_rhs])
-    simple_rhs = nlHsApp (nlHsVar (getName nO_METHOD_BINDING_ERROR_ID)) 
-	    	       (nlHsLit (HsStringPrim (mkFastString error_msg)))
-    error_msg = showSDoc (hcat [ppr loc, text "|", ppr sel_id ])
-
-	-- When the type is of form t1 -> t2 -> t3
-	-- make a default method like (\ _ _ -> noMethBind "blah")
-	-- rather than simply        (noMethBind "blah")
-	-- Reason: if t1 or t2 are higher-ranked types we get n
-	--	   silly ambiguity messages.
-	-- Example:	f :: (forall a. Eq a => a -> a) -> Int
-	--		f = error "urk"
-	-- Here, tcSub tries to force (error "urk") to have the right type,
-	-- thus:	f = \(x::forall a. Eq a => a->a) -> error "urk" (x t)
-	-- where 't' is fresh ty var.  This leads directly to "ambiguous t".
-	-- 
-	-- NB: technically this changes the meaning of the default-default
-	--     method slightly, because `seq` can see the lambdas.  Oh well.
-    (_,_,tau1)    = tcSplitSigmaTy (idType sel_id)
-    (_,_,tau2)    = tcSplitSigmaTy tau1
-	-- Need two splits because the  selector can have a type like
-	-- 	forall a. Foo a => forall b. Eq b => ...
-    (arg_tys, _) = tcSplitFunTys tau2
-    wild_pats	 = [nlWildPat | ty <- arg_tys]
-
-mkDefMethRhs origin clas inst_tys sel_id loc GenDefMeth 
-  = 	-- A generic default method
-    	-- If the method is defined generically, we can only do the job if the
-	-- instance declaration is for a single-parameter type class with
-	-- a type constructor applied to type arguments in the instance decl
-	-- 	(checkTc, so False provokes the error)
-    ASSERT( isInstDecl origin )	-- We never get here from a class decl
-    do	{ checkTc (isJust maybe_tycon)
-	 	  (badGenericInstance sel_id (notSimple inst_tys))
-	; checkTc (tyConHasGenerics tycon)
-	   	  (badGenericInstance sel_id (notGeneric tycon))
-
-	; dflags <- getDOpts
-	; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body" 
-		   (vcat [ppr clas <+> ppr inst_tys,
-			  nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
-
-		-- Rename it before returning it
-	; (rn_rhs, _) <- rnLExpr rhs
-	; returnM rn_rhs }
-  where
-    rhs = mkGenericRhs sel_id clas_tyvar tycon
-
-	  -- The tycon is only used in the generic case, and in that
-	  -- case we require that the instance decl is for a single-parameter
-	  -- type class with type variable arguments:
-	  --	instance (...) => C (T a b)
-    clas_tyvar    = head (classTyVars clas)
-    Just tycon	  = maybe_tycon
-    maybe_tycon   = case inst_tys of 
-			[ty] -> case tcSplitTyConApp_maybe ty of
-				  Just (tycon, arg_tys) | all tcIsTyVarTy arg_tys -> Just tycon
-				  other						  -> Nothing
-			other -> Nothing
-
-isInstDecl (SigOrigin (InstSkol _)) = True
-isInstDecl (SigOrigin (ClsSkol _))  = False
-\end{code}
-
-
-\begin{code}
--- The renamer just puts the selector ID as the binder in the method binding
--- but we must use the method name; so we substitute it here.  Crude but simple.
-find_bind sel_name meth_name binds
-  = foldlBag seqMaybe Nothing (mapBag f binds)
-  where 
-	f (L loc1 bind@(FunBind { fun_id = L loc2 op_name })) | op_name == sel_name
-		 = Just (L loc1 (bind { fun_id = L loc2 meth_name }))
-	f _other = Nothing
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Extracting generic instance declaration from class declarations}
-%*									*
-%************************************************************************
-
-@getGenericInstances@ extracts the generic instance declarations from a class
-declaration.  For exmaple
-
-	class C a where
-	  op :: a -> a
-	
-	  op{ x+y } (Inl v)   = ...
-	  op{ x+y } (Inr v)   = ...
-	  op{ x*y } (v :*: w) = ...
-	  op{ 1   } Unit      = ...
-
-gives rise to the instance declarations
-
-	instance C (x+y) where
-	  op (Inl v)   = ...
-	  op (Inr v)   = ...
-	
-	instance C (x*y) where
-	  op (v :*: w) = ...
-
-	instance C 1 where
-	  op Unit      = ...
-
-
-\begin{code}
-getGenericInstances :: [LTyClDecl Name] -> TcM [InstInfo] 
-getGenericInstances class_decls
-  = do	{ gen_inst_infos <- mappM (addLocM get_generics) class_decls
-	; let { gen_inst_info = concat gen_inst_infos }
-
-	-- Return right away if there is no generic stuff
-	; if null gen_inst_info then returnM []
-	  else do 
-
-	-- Otherwise print it out
-	{ dflags <- getDOpts
-	; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Generic instances" 
-	 	   (vcat (map pprInstInfoDetails gen_inst_info)))	
-	; returnM gen_inst_info }}
-
-get_generics decl@(ClassDecl {tcdLName = class_name, tcdMeths = def_methods})
-  | null generic_binds
-  = returnM [] -- The comon case: no generic default methods
-
-  | otherwise	-- A source class decl with generic default methods
-  = recoverM (returnM [])				$
-    tcAddDeclCtxt decl					$
-    tcLookupLocatedClass class_name			`thenM` \ clas ->
-
-	-- Group by type, and
-	-- make an InstInfo out of each group
-    let
-	groups = groupWith listToBag generic_binds
-    in
-    mappM (mkGenericInstance clas) groups		`thenM` \ inst_infos ->
-
-	-- Check that there is only one InstInfo for each type constructor
-  	-- The main way this can fail is if you write
-	--	f {| a+b |} ... = ...
-	--	f {| x+y |} ... = ...
-	-- Then at this point we'll have an InstInfo for each
-    let
-	tc_inst_infos :: [(TyCon, InstInfo)]
-	tc_inst_infos = [(simpleInstInfoTyCon i, i) | i <- inst_infos]
-
-	bad_groups = [group | group <- equivClassesByUniq get_uniq tc_inst_infos,
-			      group `lengthExceeds` 1]
-	get_uniq (tc,_) = getUnique tc
-    in
-    mappM (addErrTc . dupGenericInsts) bad_groups	`thenM_`
-
-	-- Check that there is an InstInfo for each generic type constructor
-    let
-	missing = genericTyConNames `minusList` [tyConName tc | (tc,_) <- tc_inst_infos]
-    in
-    checkTc (null missing) (missingGenericInstances missing)	`thenM_`
-
-    returnM inst_infos
-  where
-    generic_binds :: [(HsType Name, LHsBind Name)]
-    generic_binds = getGenericBinds def_methods
-
-
----------------------------------
-getGenericBinds :: LHsBinds Name -> [(HsType Name, LHsBind Name)]
-  -- Takes a group of method bindings, finds the generic ones, and returns
-  -- them in finite map indexed by the type parameter in the definition.
-getGenericBinds binds = concat (map getGenericBind (bagToList binds))
-
-getGenericBind (L loc bind@(FunBind { fun_matches = MatchGroup matches ty }))
-  = groupWith wrap (mapCatMaybes maybeGenericMatch matches)
-  where
-    wrap ms = L loc (bind { fun_matches = MatchGroup ms ty })
-getGenericBind _
-  = []
-
-groupWith :: ([a] -> b) -> [(HsType Name, a)] -> [(HsType Name, b)]
-groupWith op [] 	 = []
-groupWith op ((t,v):prs) = (t, op (v:vs)) : groupWith op rest
-    where
-      vs            = map snd this
-      (this,rest)   = partition same_t prs
-      same_t (t',v) = t `eqPatType` t'
-
-eqPatLType :: LHsType Name -> LHsType Name -> Bool
-eqPatLType t1 t2 = unLoc t1 `eqPatType` unLoc t2
-
-eqPatType :: HsType Name -> HsType Name -> Bool
--- A very simple equality function, only for 
--- type patterns in generic function definitions.
-eqPatType (HsTyVar v1)       (HsTyVar v2)    	= v1==v2
-eqPatType (HsAppTy s1 t1)    (HsAppTy s2 t2) 	= s1 `eqPatLType` s2 && t2 `eqPatLType` t2
-eqPatType (HsOpTy s1 op1 t1) (HsOpTy s2 op2 t2) = s1 `eqPatLType` s2 && t2 `eqPatLType` t2 && unLoc op1 == unLoc op2
-eqPatType (HsNumTy n1)	     (HsNumTy n2)	= n1 == n2
-eqPatType (HsParTy t1)	     t2			= unLoc t1 `eqPatType` t2
-eqPatType t1		     (HsParTy t2)	= t1 `eqPatType` unLoc t2
-eqPatType _ _ = False
-
----------------------------------
-mkGenericInstance :: Class
-		  -> (HsType Name, LHsBinds Name)
-		  -> TcM InstInfo
-
-mkGenericInstance clas (hs_ty, binds)
-  -- Make a generic instance declaration
-  -- For example:	instance (C a, C b) => C (a+b) where { binds }
-
-  = 	-- Extract the universally quantified type variables
-	-- and wrap them as forall'd tyvars, so that kind inference
-	-- works in the standard way
-    let
-	sig_tvs = map (noLoc.UserTyVar) (nameSetToList (extractHsTyVars (noLoc hs_ty)))
-	hs_forall_ty = noLoc $ mkExplicitHsForAllTy sig_tvs (noLoc []) (noLoc hs_ty)
-    in
-	-- Type-check the instance type, and check its form
-    tcHsSigType GenPatCtxt hs_forall_ty		`thenM` \ forall_inst_ty ->
-    let
-	(tyvars, inst_ty) = tcSplitForAllTys forall_inst_ty
-    in
-    checkTc (validGenericInstanceType inst_ty)
-	    (badGenericInstanceType binds)	`thenM_`
-
-	-- Make the dictionary function.
-    getSrcSpanM						`thenM` \ span -> 
-    getOverlapFlag					`thenM` \ overlap_flag -> 
-    newDFunName clas [inst_ty] (srcSpanStart span)	`thenM` \ dfun_name ->
-    let
-	inst_theta = [mkClassPred clas [mkTyVarTy tv] | tv <- tyvars]
-	dfun_id    = mkDictFunId dfun_name tyvars inst_theta clas [inst_ty]
-	ispec	   = mkLocalInstance dfun_id overlap_flag
-    in
-    returnM (InstInfo { iSpec = ispec, iBinds = VanillaInst binds [] })
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Error messages
-%*									*
-%************************************************************************
-
-\begin{code}
-tcAddDeclCtxt decl thing_inside
-  = addErrCtxt ctxt thing_inside
-  where
-     thing = case decl of
-	   	ClassDecl {}		  -> "class"
-		TySynonym {}		  -> "type synonym"
-		TyData {tcdND = NewType}  -> "newtype"
-		TyData {tcdND = DataType} -> "data type"
-
-     ctxt = hsep [ptext SLIT("In the"), text thing, 
-		  ptext SLIT("declaration for"), quotes (ppr (tcdName decl))]
-
-defltMethCtxt clas
-  = ptext SLIT("When checking the default methods for class") <+> quotes (ppr clas)
-
-methodCtxt sel_id
-  = ptext SLIT("In the definition for method") <+> quotes (ppr sel_id)
-
-badMethodErr clas op
-  = hsep [ptext SLIT("Class"), quotes (ppr clas), 
-	  ptext SLIT("does not have a method"), quotes (ppr op)]
-
-omittedMethodWarn sel_id
-  = ptext SLIT("No explicit method nor default method for") <+> quotes (ppr sel_id)
-
-badGenericInstance sel_id because
-  = sep [ptext SLIT("Can't derive generic code for") <+> quotes (ppr sel_id),
-	 because]
-
-notSimple inst_tys
-  = vcat [ptext SLIT("because the instance type(s)"), 
-	  nest 2 (ppr inst_tys),
-	  ptext SLIT("is not a simple type of form (T a b c)")]
-
-notGeneric tycon
-  = vcat [ptext SLIT("because the instance type constructor") <+> quotes (ppr tycon) <+> 
-	  ptext SLIT("was not compiled with -fgenerics")]
-
-badGenericInstanceType binds
-  = vcat [ptext SLIT("Illegal type pattern in the generic bindings"),
-	  nest 4 (ppr binds)]
-
-missingGenericInstances missing
-  = ptext SLIT("Missing type patterns for") <+> pprQuotedList missing
-	  
-dupGenericInsts tc_inst_infos
-  = vcat [ptext SLIT("More than one type pattern for a single generic type constructor:"),
-	  nest 4 (vcat (map ppr_inst_ty tc_inst_infos)),
-	  ptext SLIT("All the type patterns for a generic type constructor must be identical")
-    ]
-  where 
-    ppr_inst_ty (_,inst) = ppr (simpleInstInfoTy inst)
-
-mixedGenericErr op
-  = ptext SLIT("Can't mix generic and non-generic equations for class method") <+> quotes (ppr op)
-\end{code}
diff --git a/ghc/compiler/typecheck/TcDefaults.lhs b/ghc/compiler/typecheck/TcDefaults.lhs
deleted file mode 100644
index 6c9de36a3c..0000000000
--- a/ghc/compiler/typecheck/TcDefaults.lhs
+++ /dev/null
@@ -1,79 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1993-1998
-%
-\section[TcDefaults]{Typechecking \tr{default} declarations}
-
-\begin{code}
-module TcDefaults ( tcDefaults ) where
-
-#include "HsVersions.h"
-
-import HsSyn		( DefaultDecl(..), LDefaultDecl )
-import Name		( Name )
-import TcRnMonad
-import TcEnv		( tcLookupClass )
-import TcHsType		( tcHsSigType, UserTypeCtxt( DefaultDeclCtxt ) )
-import TcSimplify	( tcSimplifyDefault )
-import TcType           ( Type, mkClassPred, isTauTy )
-import PrelNames	( numClassName )
-import SrcLoc		( Located(..) )
-import Outputable
-\end{code}
-
-\begin{code}
-tcDefaults :: [LDefaultDecl Name]
-	   -> TcM (Maybe [Type])    -- Defaulting types to heave
-				    -- into Tc monad for later use
-				    -- in Disambig.
-
-tcDefaults [] 
-  = getDefaultTys		-- No default declaration, so get the
-				-- default types from the envt; 
-				-- i.e. use the curent ones
-				-- (the caller will put them back there)
-	-- It's important not to return defaultDefaultTys here (which
-	-- we used to do) because in a TH program, tcDefaults [] is called
-	-- repeatedly, once for each group of declarations between top-level
-	-- splices.  We don't want to carefully set the default types in
-	-- one group, only for the next group to ignore them and install
-	-- defaultDefaultTys
-
-tcDefaults [L locn (DefaultDecl [])]
-  = returnM (Just [])		-- Default declaration specifying no types
-
-tcDefaults [L locn (DefaultDecl mono_tys)]
-  = setSrcSpan locn 			$
-    addErrCtxt defaultDeclCtxt		$
-    tcLookupClass numClassName		`thenM` \ num_class ->
-    mappM tc_default_ty mono_tys	`thenM` \ tau_tys ->
-    
-    	-- Check that all the types are instances of Num
-    	-- We only care about whether it worked or not
-    tcSimplifyDefault [mkClassPred num_class [ty] | ty <- tau_tys]	`thenM_`
-    
-    returnM (Just tau_tys)
-
-tcDefaults decls@(L locn (DefaultDecl _) : _) =
-    setSrcSpan locn $
-    failWithTc (dupDefaultDeclErr decls)
-
-
-tc_default_ty hs_ty 
- = tcHsSigType DefaultDeclCtxt hs_ty		`thenM` \ ty ->
-   checkTc (isTauTy ty) (polyDefErr hs_ty)	`thenM_`
-   returnM ty
-
-defaultDeclCtxt =  ptext SLIT("when checking that each type in a default declaration")
-		    $$ ptext SLIT("is an instance of class Num")
-
-
-dupDefaultDeclErr (L _ (DefaultDecl _) : dup_things)
-  = hang (ptext SLIT("Multiple default declarations"))
-      4  (vcat (map pp dup_things))
-  where
-    pp (L locn (DefaultDecl _)) = ptext SLIT("here was another default declaration") <+> ppr locn
-
-polyDefErr ty 
-  = hang (ptext SLIT("Illegal polymorphic type in default declaration") <> colon) 4 (ppr ty) 
-\end{code}
-
diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs
deleted file mode 100644
index 472ce6b94d..0000000000
--- a/ghc/compiler/typecheck/TcDeriv.lhs
+++ /dev/null
@@ -1,960 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcDeriv]{Deriving}
-
-Handles @deriving@ clauses on @data@ declarations.
-
-\begin{code}
-module TcDeriv ( tcDeriving ) where
-
-#include "HsVersions.h"
-
-import HsSyn
-import DynFlags	( DynFlag(..) )
-
-import Generics		( mkTyConGenericBinds )
-import TcRnMonad
-import TcEnv		( newDFunName, pprInstInfoDetails, 
-			  InstInfo(..), InstBindings(..), simpleInstInfoClsTy,
-			  tcLookupClass, tcLookupTyCon, tcExtendTyVarEnv
-			)
-import TcGenDeriv	-- Deriv stuff
-import InstEnv		( Instance, OverlapFlag, mkLocalInstance, instanceHead, extendInstEnvList )
-import Inst		( getOverlapFlag )
-import TcHsType		( tcHsDeriv )
-import TcSimplify	( tcSimplifyDeriv )
-
-import RnBinds		( rnMethodBinds, rnTopBinds )
-import RnEnv		( bindLocalNames )
-import HscTypes		( FixityEnv )
-
-import Class		( className, classArity, classKey, classTyVars, classSCTheta, Class )
-import Type		( zipOpenTvSubst, substTheta )
-import ErrUtils		( dumpIfSet_dyn )
-import MkId		( mkDictFunId )
-import DataCon		( isNullarySrcDataCon, isVanillaDataCon, dataConOrigArgTys )
-import Maybes		( catMaybes )
-import RdrName		( RdrName )
-import Name		( Name, getSrcLoc )
-import NameSet		( duDefs )
-import Kind		( splitKindFunTys )
-import TyCon		( tyConTyVars, tyConDataCons, tyConArity, tyConHasGenerics,
-			  tyConStupidTheta, isProductTyCon, isDataTyCon, newTyConRhs,
-			  isEnumerationTyCon, isRecursiveTyCon, TyCon
-			)
-import TcType		( TcType, ThetaType, mkTyVarTys, mkTyConApp, tcTyConAppTyCon,
-			  isUnLiftedType, mkClassPred, tyVarsOfTypes, isArgTypeKind,
-			  tcEqTypes, tcSplitAppTys, mkAppTys )
-import Var		( TyVar, tyVarKind, varName )
-import VarSet		( mkVarSet, subVarSet )
-import PrelNames
-import SrcLoc		( srcLocSpan, Located(..) )
-import Util		( zipWithEqual, sortLe, notNull )
-import ListSetOps	( removeDups,  assocMaybe )
-import Outputable
-import Bag
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TcDeriv-intro]{Introduction to how we do deriving}
-%*									*
-%************************************************************************
-
-Consider
-
-	data T a b = C1 (Foo a) (Bar b)
-		   | C2 Int (T b a)
-		   | C3 (T a a)
-		   deriving (Eq)
-
-[NOTE: See end of these comments for what to do with 
-	data (C a, D b) => T a b = ...
-]
-
-We want to come up with an instance declaration of the form
-
-	instance (Ping a, Pong b, ...) => Eq (T a b) where
-		x == y = ...
-
-It is pretty easy, albeit tedious, to fill in the code "...".  The
-trick is to figure out what the context for the instance decl is,
-namely @Ping@, @Pong@ and friends.
-
-Let's call the context reqd for the T instance of class C at types
-(a,b, ...)  C (T a b).  Thus:
-
-	Eq (T a b) = (Ping a, Pong b, ...)
-
-Now we can get a (recursive) equation from the @data@ decl:
-
-	Eq (T a b) = Eq (Foo a) u Eq (Bar b)	-- From C1
-		   u Eq (T b a) u Eq Int	-- From C2
-		   u Eq (T a a)			-- From C3
-
-Foo and Bar may have explicit instances for @Eq@, in which case we can
-just substitute for them.  Alternatively, either or both may have
-their @Eq@ instances given by @deriving@ clauses, in which case they
-form part of the system of equations.
-
-Now all we need do is simplify and solve the equations, iterating to
-find the least fixpoint.  Notice that the order of the arguments can
-switch around, as here in the recursive calls to T.
-
-Let's suppose Eq (Foo a) = Eq a, and Eq (Bar b) = Ping b.
-
-We start with:
-
-	Eq (T a b) = {}		-- The empty set
-
-Next iteration:
-	Eq (T a b) = Eq (Foo a) u Eq (Bar b)	-- From C1
-		   u Eq (T b a) u Eq Int	-- From C2
-		   u Eq (T a a)			-- From C3
-
-	After simplification:
-		   = Eq a u Ping b u {} u {} u {}
-		   = Eq a u Ping b
-
-Next iteration:
-
-	Eq (T a b) = Eq (Foo a) u Eq (Bar b)	-- From C1
-		   u Eq (T b a) u Eq Int	-- From C2
-		   u Eq (T a a)			-- From C3
-
-	After simplification:
-		   = Eq a u Ping b
-		   u (Eq b u Ping a)
-		   u (Eq a u Ping a)
-
-		   = Eq a u Ping b u Eq b u Ping a
-
-The next iteration gives the same result, so this is the fixpoint.  We
-need to make a canonical form of the RHS to ensure convergence.  We do
-this by simplifying the RHS to a form in which
-
-	- the classes constrain only tyvars
-	- the list is sorted by tyvar (major key) and then class (minor key)
-	- no duplicates, of course
-
-So, here are the synonyms for the ``equation'' structures:
-
-\begin{code}
-type DerivEqn = (Name, Class, TyCon, [TyVar], DerivRhs)
-		-- The Name is the name for the DFun we'll build
-		-- The tyvars bind all the variables in the RHS
-
-pprDerivEqn (n,c,tc,tvs,rhs)
-  = parens (hsep [ppr n, ppr c, ppr tc, ppr tvs] <+> equals <+> ppr rhs)
-
-type DerivRhs  = ThetaType
-type DerivSoln = DerivRhs
-\end{code}
-
-
-[Data decl contexts] A note about contexts on data decls
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-
-	data (RealFloat a) => Complex a = !a :+ !a deriving( Read )
-
-We will need an instance decl like:
-
-	instance (Read a, RealFloat a) => Read (Complex a) where
-	  ...
-
-The RealFloat in the context is because the read method for Complex is bound
-to construct a Complex, and doing that requires that the argument type is
-in RealFloat. 
-
-But this ain't true for Show, Eq, Ord, etc, since they don't construct
-a Complex; they only take them apart.
-
-Our approach: identify the offending classes, and add the data type
-context to the instance decl.  The "offending classes" are
-
-	Read, Enum?
-
-FURTHER NOTE ADDED March 2002.  In fact, Haskell98 now requires that
-pattern matching against a constructor from a data type with a context
-gives rise to the constraints for that context -- or at least the thinned
-version.  So now all classes are "offending".
-
-[Newtype deriving]
-~~~~~~~~~~~~~~~~~~
-Consider this:
-    class C a b
-    instance C [a] Char
-    newtype T = T Char deriving( C [a] )
-
-Notice the free 'a' in the deriving.  We have to fill this out to 
-    newtype T = T Char deriving( forall a. C [a] )
-
-And then translate it to:
-    instance C [a] Char => C [a] T where ...
-    
-	
-
-
-%************************************************************************
-%*									*
-\subsection[TcDeriv-driver]{Top-level function for \tr{derivings}}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcDeriving  :: [LTyClDecl Name]	-- All type constructors
-	    -> TcM ([InstInfo],		-- The generated "instance decls"
-		    HsValBinds Name)	-- Extra generated top-level bindings
-
-tcDeriving tycl_decls
-  = recoverM (returnM ([], emptyValBindsOut)) $
-    do	{   	-- Fish the "deriving"-related information out of the TcEnv
-		-- and make the necessary "equations".
-	  overlap_flag <- getOverlapFlag
-	; (ordinary_eqns, newtype_inst_info) <- makeDerivEqns overlap_flag tycl_decls
-
-	; (ordinary_inst_info, deriv_binds) 
-		<- extendLocalInstEnv (map iSpec newtype_inst_info)  $
-		   deriveOrdinaryStuff overlap_flag ordinary_eqns
-		-- Add the newtype-derived instances to the inst env
-		-- before tacking the "ordinary" ones
-
-	; let inst_info = newtype_inst_info ++ ordinary_inst_info
-
-	-- If we are compiling a hs-boot file, 
-	-- don't generate any derived bindings
-	; is_boot <- tcIsHsBoot
-	; if is_boot then
-		return (inst_info, emptyValBindsOut)
-	  else do
-	{
-
-	-- Generate the generic to/from functions from each type declaration
-	; gen_binds <- mkGenericBinds tycl_decls
-
-	-- Rename these extra bindings, discarding warnings about unused bindings etc
-	-- Set -fglasgow exts so that we can have type signatures in patterns,
-	-- which is used in the generic binds
-	; rn_binds
-		<- discardWarnings $ setOptM Opt_GlasgowExts $ do
-			{ (rn_deriv, _dus1) <- rnTopBinds (ValBindsIn deriv_binds [])
-			; (rn_gen, dus_gen) <- rnTopBinds (ValBindsIn gen_binds   [])
-			; keepAliveSetTc (duDefs dus_gen)	-- Mark these guys to
-								-- be kept alive
-			; return (rn_deriv `plusHsValBinds` rn_gen) }
-
-
-	; dflags <- getDOpts
-	; ioToTcRn (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances" 
-	  	   (ddump_deriving inst_info rn_binds))
-
-	; returnM (inst_info, rn_binds)
-	}}
-  where
-    ddump_deriving :: [InstInfo] -> HsValBinds Name -> SDoc
-    ddump_deriving inst_infos extra_binds
-      = vcat (map pprInstInfoDetails inst_infos) $$ ppr extra_binds
-
------------------------------------------
-deriveOrdinaryStuff overlap_flag []	-- Short cut
-  = returnM ([], emptyLHsBinds)
-
-deriveOrdinaryStuff overlap_flag eqns
-  = do	{	-- Take the equation list and solve it, to deliver a list of
-		-- solutions, a.k.a. the contexts for the instance decls
-		-- required for the corresponding equations.
-	  inst_specs <- solveDerivEqns overlap_flag eqns
-
-	-- Generate the InstInfo for each dfun, 
-	-- plus any auxiliary bindings it needs
-	; (inst_infos, aux_binds_s) <- mapAndUnzipM genInst inst_specs
-
-	-- Generate any extra not-one-inst-decl-specific binds, 
-	-- notably "con2tag" and/or "tag2con" functions.  
-	; extra_binds <- genTaggeryBinds inst_infos
-
-	-- Done
-	; returnM (inst_infos, unionManyBags (extra_binds : aux_binds_s))
-   }
-
------------------------------------------
-mkGenericBinds tycl_decls
-  = do	{ tcs <- mapM tcLookupTyCon 
-			[ tc_name | 
-			  L _ (TyData { tcdLName = L _ tc_name }) <- tycl_decls]
-		-- We are only interested in the data type declarations
-	; return (unionManyBags [ mkTyConGenericBinds tc | 
-				  tc <- tcs, tyConHasGenerics tc ]) }
-		-- And then only in the ones whose 'has-generics' flag is on
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[TcDeriv-eqns]{Forming the equations}
-%*									*
-%************************************************************************
-
-@makeDerivEqns@ fishes around to find the info about needed derived
-instances.  Complicating factors:
-\begin{itemize}
-\item
-We can only derive @Enum@ if the data type is an enumeration
-type (all nullary data constructors).
-
-\item
-We can only derive @Ix@ if the data type is an enumeration {\em
-or} has just one data constructor (e.g., tuples).
-\end{itemize}
-
-[See Appendix~E in the Haskell~1.2 report.] This code here deals w/
-all those.
-
-\begin{code}
-makeDerivEqns :: OverlapFlag
-	      -> [LTyClDecl Name] 
-	      -> TcM ([DerivEqn],	-- Ordinary derivings
-		      [InstInfo])	-- Special newtype derivings
-
-makeDerivEqns overlap_flag tycl_decls
-  = mapAndUnzipM mk_eqn derive_these	 	`thenM` \ (maybe_ordinaries, maybe_newtypes) ->
-    returnM (catMaybes maybe_ordinaries, catMaybes maybe_newtypes)
-  where
-    ------------------------------------------------------------------
-    derive_these :: [(NewOrData, Name, LHsType Name)]
-	-- Find the (nd, TyCon, Pred) pairs that must be `derived'
-    derive_these = [ (nd, tycon, pred) 
-		   | L _ (TyData { tcdND = nd, tcdLName = L _ tycon, 
-			          tcdDerivs = Just preds }) <- tycl_decls,
-		     pred <- preds ]
-
-    ------------------------------------------------------------------
-    mk_eqn :: (NewOrData, Name, LHsType Name) -> TcM (Maybe DerivEqn, Maybe InstInfo)
-	-- We swizzle the tyvars and datacons out of the tycon
-	-- to make the rest of the equation
-	--
-	-- The "deriv_ty" is a LHsType to take account of the fact that for newtype derivign
-	-- we allow deriving (forall a. C [a]).
-
-    mk_eqn (new_or_data, tycon_name, hs_deriv_ty)
-      = tcLookupTyCon tycon_name		`thenM` \ tycon ->
-	setSrcSpan (srcLocSpan (getSrcLoc tycon))		$
-        addErrCtxt (derivCtxt Nothing tycon)	$
-	tcExtendTyVarEnv (tyConTyVars tycon)	$	-- Deriving preds may (now) mention
-							-- the type variables for the type constructor
-	tcHsDeriv hs_deriv_ty			`thenM` \ (deriv_tvs, clas, tys) ->
-	doptM Opt_GlasgowExts			`thenM` \ gla_exts ->
-        mk_eqn_help gla_exts new_or_data tycon deriv_tvs clas tys
-
-    ------------------------------------------------------------------
-    mk_eqn_help gla_exts DataType tycon deriv_tvs clas tys
-      | Just err <- checkSideConditions gla_exts tycon deriv_tvs clas tys
-      = bale_out (derivingThingErr clas tys tycon (tyConTyVars tycon) err)
-      | otherwise 
-      = do { eqn <- mkDataTypeEqn tycon clas
-	   ; returnM (Just eqn, Nothing) }
-
-    mk_eqn_help gla_exts NewType tycon deriv_tvs clas tys
-      | can_derive_via_isomorphism && (gla_exts || std_class_via_iso clas)
-      =		-- Go ahead and use the isomorphism
-	   traceTc (text "newtype deriving:" <+> ppr tycon <+> ppr rep_tys)	`thenM_`
-       	   new_dfun_name clas tycon  		`thenM` \ dfun_name ->
-	   returnM (Nothing, Just (InstInfo { iSpec  = mk_inst_spec dfun_name,
-					      iBinds = NewTypeDerived rep_tys }))
-      | std_class gla_exts clas
-      = mk_eqn_help gla_exts DataType tycon deriv_tvs clas tys	-- Go via bale-out route
-
-      | otherwise 				-- Non-standard instance
-      = bale_out (if gla_exts then	
-		   	cant_derive_err	-- Too hard
-		  else
-			non_std_err)	-- Just complain about being a non-std instance
-      where
-	-- Here is the plan for newtype derivings.  We see
-	--	  newtype T a1...an = T (t ak...an) deriving (.., C s1 .. sm, ...)
-	-- where t is a type,
-	-- 	 ak...an is a suffix of a1..an
-	--	 ak...an do not occur free in t, 
-	-- 	 (C s1 ... sm) is a  *partial applications* of class C 
-	--			with the last parameter missing
-	--
-	-- We generate the instances
-	--	 instance C s1 .. sm (t ak...ap) => C s1 .. sm (T a1...ap)
-	-- where T a1...ap is the partial application of the LHS of the correct kind
-	-- and p >= k
-	--
-	-- Running example: newtype T s a = MkT (ST s a) deriving( Monad )
-	--	instance Monad (ST s) => Monad (T s) where 
-	--	  fail = coerce ... (fail @ ST s)
-	-- (Actually we don't need the coerce, because non-rec newtypes are transparent
-
-	clas_tyvars = classTyVars clas
-	kind = tyVarKind (last clas_tyvars)
-		-- Kind of the thing we want to instance
-		--   e.g. argument kind of Monad, *->*
-
-	(arg_kinds, _) = splitKindFunTys kind
-	n_args_to_drop = length arg_kinds	
-		-- Want to drop 1 arg from (T s a) and (ST s a)
-		-- to get 	instance Monad (ST s) => Monad (T s)
-
-	-- Note [newtype representation]
-	-- Need newTyConRhs *not* newTyConRep to get the representation 
-	-- type, because the latter looks through all intermediate newtypes
-	-- For example
-	--	newtype B = MkB Int
-	--	newtype A = MkA B deriving( Num )
-	-- We want the Num instance of B, *not* the Num instance of Int,
-	-- when making the Num instance of A!
-        (tc_tvs, rep_ty)      = newTyConRhs tycon
-	(rep_fn, rep_ty_args) = tcSplitAppTys rep_ty
-
-	n_tyvars_to_keep = tyConArity tycon  - n_args_to_drop
-	tyvars_to_drop   = drop n_tyvars_to_keep tc_tvs
-	tyvars_to_keep   = take n_tyvars_to_keep tc_tvs
-
-	n_args_to_keep = length rep_ty_args - n_args_to_drop
-	args_to_drop   = drop n_args_to_keep rep_ty_args
- 	args_to_keep   = take n_args_to_keep rep_ty_args
-
-	rep_tys  = tys ++ [mkAppTys rep_fn args_to_keep]
-	rep_pred = mkClassPred clas rep_tys
-		-- rep_pred is the representation dictionary, from where
-		-- we are gong to get all the methods for the newtype dictionary
-
-	inst_tys = (tys ++ [mkTyConApp tycon (mkTyVarTys tyvars_to_keep)])
-		-- The 'tys' here come from the partial application
-		-- in the deriving clause. The last arg is the new
-		-- instance type.
-
-		-- We must pass the superclasses; the newtype might be an instance
-		-- of them in a different way than the representation type
-		-- E.g.		newtype Foo a = Foo a deriving( Show, Num, Eq )
-		-- Then the Show instance is not done via isomprphism; it shows
-		-- 	Foo 3 as "Foo 3"
-		-- The Num instance is derived via isomorphism, but the Show superclass
-		-- dictionary must the Show instance for Foo, *not* the Show dictionary
-		-- gotten from the Num dictionary. So we must build a whole new dictionary
-		-- not just use the Num one.  The instance we want is something like:
-		--	instance (Num a, Show (Foo a), Eq (Foo a)) => Num (Foo a) where
-		--		(+) = ((+)@a)
-		--		...etc...
-		-- There's no 'corece' needed because after the type checker newtypes
-		-- are transparent.
-
-	sc_theta = substTheta (zipOpenTvSubst clas_tyvars inst_tys)
-			      (classSCTheta clas)
-
-		-- If there are no tyvars, there's no need
-		-- to abstract over the dictionaries we need
-	dict_tvs = deriv_tvs ++ tc_tvs
-	dict_args | null dict_tvs = []
-		  | otherwise     = rep_pred : sc_theta
-
-		-- Finally! Here's where we build the dictionary Id
-	mk_inst_spec dfun_name 
-	  = mkLocalInstance dfun overlap_flag
-	  where
-	    dfun = mkDictFunId dfun_name dict_tvs dict_args clas inst_tys
-
-	-------------------------------------------------------------------
-	--  Figuring out whether we can only do this newtype-deriving thing
-
-	right_arity = length tys + 1 == classArity clas
-
-		-- Never derive Read,Show,Typeable,Data this way 
-	non_iso_classes = [readClassKey, showClassKey, typeableClassKey, dataClassKey]
-	can_derive_via_isomorphism
-	   =  not (getUnique clas `elem` non_iso_classes)
-	   && right_arity 			-- Well kinded;
-						-- eg not: newtype T ... deriving( ST )
-						--	because ST needs *2* type params
-	   && n_tyvars_to_keep >= 0		-- Type constructor has right kind:
-						-- eg not: newtype T = T Int deriving( Monad )
-	   && n_args_to_keep   >= 0		-- Rep type has right kind: 
-						-- eg not: newtype T a = T Int deriving( Monad )
-	   && eta_ok				-- Eta reduction works
-	   && not (isRecursiveTyCon tycon)	-- Does not work for recursive tycons:
-						--	newtype A = MkA [A]
-						-- Don't want
-						--	instance Eq [A] => Eq A !!
-			-- Here's a recursive newtype that's actually OK
-			--	newtype S1 = S1 [T1 ()]
-			--	newtype T1 a = T1 (StateT S1 IO a ) deriving( Monad )
-			-- It's currently rejected.  Oh well.
-			-- In fact we generate an instance decl that has method of form
-			--	meth @ instTy = meth @ repTy
-			-- (no coerce's).  We'd need a coerce if we wanted to handle
-			-- recursive newtypes too
-
-	-- Check that eta reduction is OK
-	-- 	(a) the dropped-off args are identical
-	--	(b) the remaining type args mention 
-	--	    only the remaining type variables
-	eta_ok = (args_to_drop `tcEqTypes` mkTyVarTys tyvars_to_drop)
-	      && (tyVarsOfTypes args_to_keep `subVarSet` mkVarSet tyvars_to_keep) 
-
-	cant_derive_err = derivingThingErr clas tys tycon tyvars_to_keep
-				(vcat [ptext SLIT("even with cunning newtype deriving:"),
-					if isRecursiveTyCon tycon then
-					  ptext SLIT("the newtype is recursive")
-					else empty,
-					if not right_arity then 
-					  quotes (ppr (mkClassPred clas tys)) <+> ptext SLIT("does not have arity 1")
-					else empty,
-					if not (n_tyvars_to_keep >= 0) then 
-					  ptext SLIT("the type constructor has wrong kind")
-					else if not (n_args_to_keep >= 0) then
-					  ptext SLIT("the representation type has wrong kind")
-					else if not eta_ok then 
-					  ptext SLIT("the eta-reduction property does not hold")
-					else empty
-				      ])
-
-	non_std_err = derivingThingErr clas tys tycon tyvars_to_keep
-				(vcat [non_std_why clas,
-				       ptext SLIT("Try -fglasgow-exts for GHC's newtype-deriving extension")])
-
-    bale_out err = addErrTc err `thenM_` returnM (Nothing, Nothing) 
-
-std_class gla_exts clas 
-  =  key `elem` derivableClassKeys
-  || (gla_exts && (key == typeableClassKey || key == dataClassKey))
-  where
-     key = classKey clas
-    
-std_class_via_iso clas	-- These standard classes can be derived for a newtype
-			-- using the isomorphism trick *even if no -fglasgow-exts*
-  = classKey clas `elem`  [eqClassKey, ordClassKey, ixClassKey, boundedClassKey]
-	-- Not Read/Show because they respect the type
-	-- Not Enum, becuase newtypes are never in Enum
-
-
-new_dfun_name clas tycon 	-- Just a simple wrapper
-  = newDFunName clas [mkTyConApp tycon []] (getSrcLoc tycon)
-	-- The type passed to newDFunName is only used to generate
-	-- a suitable string; hence the empty type arg list
-
-------------------------------------------------------------------
-mkDataTypeEqn :: TyCon -> Class -> TcM DerivEqn
-mkDataTypeEqn tycon clas
-  | clas `hasKey` typeableClassKey
-  =	-- The Typeable class is special in several ways
-	-- 	  data T a b = ... deriving( Typeable )
-	-- gives
-	--	  instance Typeable2 T where ...
-	-- Notice that:
-	-- 1. There are no constraints in the instance
-	-- 2. There are no type variables either
-	-- 3. The actual class we want to generate isn't necessarily
-	--	Typeable; it depends on the arity of the type
-    do	{ real_clas <- tcLookupClass (typeableClassNames !! tyConArity tycon)
-	; dfun_name <- new_dfun_name real_clas tycon
-  	; return (dfun_name, real_clas, tycon, [], []) }
-
-  | otherwise
-  = do	{ dfun_name <- new_dfun_name clas tycon
-  	; return (dfun_name, clas, tycon, tyvars, constraints) }
-  where
-    tyvars            = tyConTyVars tycon
-    constraints       = extra_constraints ++ ordinary_constraints
-    extra_constraints = tyConStupidTheta tycon
-	 -- "extra_constraints": see note [Data decl contexts] above
-
-    ordinary_constraints
-      = [ mkClassPred clas [arg_ty] 
-        | data_con <- tyConDataCons tycon,
-          arg_ty   <- dataConOrigArgTys data_con,
-          not (isUnLiftedType arg_ty)	-- No constraints for unlifted types?
-        ]
-
-
-------------------------------------------------------------------
--- Check side conditions that dis-allow derivability for particular classes
--- This is *apart* from the newtype-deriving mechanism
-
-checkSideConditions :: Bool -> TyCon -> [TyVar] -> Class -> [TcType] -> Maybe SDoc
-checkSideConditions gla_exts tycon deriv_tvs clas tys
-  | notNull deriv_tvs || notNull tys	
-  = Just ty_args_why	-- e.g. deriving( Foo s )
-  | otherwise
-  = case [cond | (key,cond) <- sideConditions, key == getUnique clas] of
-	[]     -> Just (non_std_why clas)
-	[cond] -> cond (gla_exts, tycon)
-	other  -> pprPanic "checkSideConditions" (ppr clas)
-  where
-    ty_args_why	= quotes (ppr (mkClassPred clas tys)) <+> ptext SLIT("is not a class")
-
-non_std_why clas = quotes (ppr clas) <+> ptext SLIT("is not a derivable class")
-
-sideConditions :: [(Unique, Condition)]
-sideConditions
-  = [	(eqClassKey, 	   cond_std),
-	(ordClassKey,	   cond_std),
-	(readClassKey,	   cond_std),
-	(showClassKey,	   cond_std),
-	(enumClassKey,	   cond_std `andCond` cond_isEnumeration),
-	(ixClassKey,	   cond_std `andCond` (cond_isEnumeration `orCond` cond_isProduct)),
-	(boundedClassKey,  cond_std `andCond` (cond_isEnumeration `orCond` cond_isProduct)),
- 	(typeableClassKey, cond_glaExts `andCond` cond_typeableOK),
-	(dataClassKey,	   cond_glaExts `andCond` cond_std)
-    ]
-
-type Condition = (Bool, TyCon) -> Maybe SDoc	-- Nothing => OK
-
-orCond :: Condition -> Condition -> Condition
-orCond c1 c2 tc 
-  = case c1 tc of
-	Nothing -> Nothing		-- c1 succeeds
-	Just x  -> case c2 tc of	-- c1 fails
-		     Nothing -> Nothing
-		     Just y  -> Just (x $$ ptext SLIT("  and") $$ y)
-					-- Both fail
-
-andCond c1 c2 tc = case c1 tc of
-		     Nothing -> c2 tc	-- c1 succeeds
-		     Just x  -> Just x	-- c1 fails
-
-cond_std :: Condition
-cond_std (gla_exts, tycon)
-  | any (not . isVanillaDataCon) data_cons = Just existential_why     
-  | null data_cons		    	   = Just no_cons_why
-  | otherwise      			   = Nothing
-  where
-    data_cons       = tyConDataCons tycon
-    no_cons_why	    = quotes (ppr tycon) <+> ptext SLIT("has no data constructors")
-    existential_why = quotes (ppr tycon) <+> ptext SLIT("has non-Haskell-98 constructor(s)")
-  
-cond_isEnumeration :: Condition
-cond_isEnumeration (gla_exts, tycon)
-  | isEnumerationTyCon tycon = Nothing
-  | otherwise		     = Just why
-  where
-    why = quotes (ppr tycon) <+> ptext SLIT("has non-nullary constructors")
-
-cond_isProduct :: Condition
-cond_isProduct (gla_exts, tycon)
-  | isProductTyCon tycon = Nothing
-  | otherwise	         = Just why
-  where
-    why = quotes (ppr tycon) <+> ptext SLIT("has more than one constructor")
-
-cond_typeableOK :: Condition
--- OK for Typeable class
--- Currently: (a) args all of kind *
---	      (b) 7 or fewer args
-cond_typeableOK (gla_exts, tycon)
-  | tyConArity tycon > 7				      = Just too_many
-  | not (all (isArgTypeKind . tyVarKind) (tyConTyVars tycon)) = Just bad_kind
-  | otherwise	  				              = Nothing
-  where
-    too_many = quotes (ppr tycon) <+> ptext SLIT("has too many arguments")
-    bad_kind = quotes (ppr tycon) <+> ptext SLIT("has arguments of kind other than `*'")
-
-cond_glaExts :: Condition
-cond_glaExts (gla_exts, tycon) | gla_exts  = Nothing
-			       | otherwise = Just why
-  where
-    why  = ptext SLIT("You need -fglasgow-exts to derive an instance for this class")
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TcDeriv-fixpoint]{Finding the fixed point of \tr{deriving} equations}
-%*									*
-%************************************************************************
-
-A ``solution'' (to one of the equations) is a list of (k,TyVarTy tv)
-terms, which is the final correct RHS for the corresponding original
-equation.
-\begin{itemize}
-\item
-Each (k,TyVarTy tv) in a solution constrains only a type
-variable, tv.
-
-\item
-The (k,TyVarTy tv) pairs in a solution are canonically
-ordered by sorting on type varible, tv, (major key) and then class, k,
-(minor key)
-\end{itemize}
-
-\begin{code}
-solveDerivEqns :: OverlapFlag
-	       -> [DerivEqn]
-	       -> TcM [Instance]-- Solns in same order as eqns.
-				-- This bunch is Absolutely minimal...
-
-solveDerivEqns overlap_flag orig_eqns
-  = iterateDeriv 1 initial_solutions
-  where
-	-- The initial solutions for the equations claim that each
-	-- instance has an empty context; this solution is certainly
-	-- in canonical form.
-    initial_solutions :: [DerivSoln]
-    initial_solutions = [ [] | _ <- orig_eqns ]
-
-    ------------------------------------------------------------------
-	-- iterateDeriv calculates the next batch of solutions,
-	-- compares it with the current one; finishes if they are the
-	-- same, otherwise recurses with the new solutions.
-	-- It fails if any iteration fails
-    iterateDeriv :: Int -> [DerivSoln] -> TcM [Instance]
-    iterateDeriv n current_solns
-      | n > 20 	-- Looks as if we are in an infinite loop
-		-- This can happen if we have -fallow-undecidable-instances
-		-- (See TcSimplify.tcSimplifyDeriv.)
-      = pprPanic "solveDerivEqns: probable loop" 
-		 (vcat (map pprDerivEqn orig_eqns) $$ ppr current_solns)
-      | otherwise
-      =	let 
-	    inst_specs = zipWithEqual "add_solns" mk_inst_spec 
-				      orig_eqns current_solns
-        in
-        checkNoErrs (
-		  -- Extend the inst info from the explicit instance decls
-		  -- with the current set of solutions, and simplify each RHS
-	    extendLocalInstEnv inst_specs $
-	    mappM gen_soln orig_eqns
-	)				`thenM` \ new_solns ->
-	if (current_solns == new_solns) then
-	    returnM inst_specs
-	else
-	    iterateDeriv (n+1) new_solns
-
-    ------------------------------------------------------------------
-    gen_soln (_, clas, tc,tyvars,deriv_rhs)
-      = setSrcSpan (srcLocSpan (getSrcLoc tc))		$
-	addErrCtxt (derivCtxt (Just clas) tc)	$
-	tcSimplifyDeriv tc tyvars deriv_rhs	`thenM` \ theta ->
-	returnM (sortLe (<=) theta)	-- Canonicalise before returning the soluction
-
-    ------------------------------------------------------------------
-    mk_inst_spec (dfun_name, clas, tycon, tyvars, _) theta
-	= mkLocalInstance dfun overlap_flag
-	where
-	  dfun = mkDictFunId dfun_name tyvars theta clas
-			     [mkTyConApp tycon (mkTyVarTys tyvars)]
-
-extendLocalInstEnv :: [Instance] -> TcM a -> TcM a
--- Add new locally-defined instances; don't bother to check
--- for functional dependency errors -- that'll happen in TcInstDcls
-extendLocalInstEnv dfuns thing_inside
- = do { env <- getGblEnv
-      ; let  inst_env' = extendInstEnvList (tcg_inst_env env) dfuns 
-	     env'      = env { tcg_inst_env = inst_env' }
-      ; setGblEnv env' thing_inside }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[TcDeriv-normal-binds]{Bindings for the various classes}
-%*									*
-%************************************************************************
-
-After all the trouble to figure out the required context for the
-derived instance declarations, all that's left is to chug along to
-produce them.  They will then be shoved into @tcInstDecls2@, which
-will do all its usual business.
-
-There are lots of possibilities for code to generate.  Here are
-various general remarks.
-
-PRINCIPLES:
-\begin{itemize}
-\item
-We want derived instances of @Eq@ and @Ord@ (both v common) to be
-``you-couldn't-do-better-by-hand'' efficient.
-
-\item
-Deriving @Show@---also pretty common--- should also be reasonable good code.
-
-\item
-Deriving for the other classes isn't that common or that big a deal.
-\end{itemize}
-
-PRAGMATICS:
-
-\begin{itemize}
-\item
-Deriving @Ord@ is done mostly with the 1.3 @compare@ method.
-
-\item
-Deriving @Eq@ also uses @compare@, if we're deriving @Ord@, too.
-
-\item
-We {\em normally} generate code only for the non-defaulted methods;
-there are some exceptions for @Eq@ and (especially) @Ord@...
-
-\item
-Sometimes we use a @_con2tag_<tycon>@ function, which returns a data
-constructor's numeric (@Int#@) tag.  These are generated by
-@gen_tag_n_con_binds@, and the heuristic for deciding if one of
-these is around is given by @hasCon2TagFun@.
-
-The examples under the different sections below will make this
-clearer.
-
-\item
-Much less often (really just for deriving @Ix@), we use a
-@_tag2con_<tycon>@ function.  See the examples.
-
-\item
-We use the renamer!!!  Reason: we're supposed to be
-producing @LHsBinds Name@ for the methods, but that means
-producing correctly-uniquified code on the fly.  This is entirely
-possible (the @TcM@ monad has a @UniqueSupply@), but it is painful.
-So, instead, we produce @MonoBinds RdrName@ then heave 'em through
-the renamer.  What a great hack!
-\end{itemize}
-
-\begin{code}
--- Generate the InstInfo for the required instance,
--- plus any auxiliary bindings required
-genInst :: Instance -> TcM (InstInfo, LHsBinds RdrName)
-genInst spec
-  = do	{ fix_env <- getFixityEnv
-	; let
-	    (tyvars,_,clas,[ty])    = instanceHead spec
-	    clas_nm		    = className clas
-	    tycon  	      	    = tcTyConAppTyCon ty 
-	    (meth_binds, aux_binds) = genDerivBinds clas fix_env tycon
-
-	-- Bring the right type variables into 
-	-- scope, and rename the method binds
-	-- It's a bit yukky that we return *renamed* InstInfo, but
-	-- *non-renamed* auxiliary bindings
-	; (rn_meth_binds, _fvs) <- discardWarnings $ 
-				   bindLocalNames (map varName tyvars)	$
-			 	   rnMethodBinds clas_nm [] meth_binds
-
-	-- Build the InstInfo
-	; return (InstInfo { iSpec = spec, 
-		  	     iBinds = VanillaInst rn_meth_binds [] }, 
-		  aux_binds)
-	}
-
-genDerivBinds clas fix_env tycon
-  | className clas `elem` typeableClassNames
-  = (gen_Typeable_binds tycon, emptyLHsBinds)
-
-  | otherwise
-  = case assocMaybe gen_list (getUnique clas) of
-	Just gen_fn -> gen_fn fix_env tycon
-	Nothing	    -> pprPanic "genDerivBinds: bad derived class" (ppr clas)
-  where
-    gen_list :: [(Unique, FixityEnv -> TyCon -> (LHsBinds RdrName, LHsBinds RdrName))]
-    gen_list = [(eqClassKey,      no_aux_binds (ignore_fix_env gen_Eq_binds))
- 	       ,(ordClassKey,     no_aux_binds (ignore_fix_env gen_Ord_binds))
- 	       ,(enumClassKey,    no_aux_binds (ignore_fix_env gen_Enum_binds))
- 	       ,(boundedClassKey, no_aux_binds (ignore_fix_env gen_Bounded_binds))
- 	       ,(ixClassKey,      no_aux_binds (ignore_fix_env gen_Ix_binds))
-	       ,(typeableClassKey,no_aux_binds (ignore_fix_env gen_Typeable_binds))
- 	       ,(showClassKey,    no_aux_binds gen_Show_binds)
- 	       ,(readClassKey,    no_aux_binds gen_Read_binds)
-	       ,(dataClassKey,    gen_Data_binds)
- 	       ]
-
-      -- no_aux_binds is used for generators that don't 
-      -- need to produce any auxiliary bindings
-    no_aux_binds f fix_env tc = (f fix_env tc, emptyLHsBinds)
-    ignore_fix_env f fix_env tc = f tc
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[TcDeriv-taggery-Names]{What con2tag/tag2con functions are available?}
-%*									*
-%************************************************************************
-
-
-data Foo ... = ...
-
-con2tag_Foo :: Foo ... -> Int#
-tag2con_Foo :: Int -> Foo ...	-- easier if Int, not Int#
-maxtag_Foo  :: Int		-- ditto (NB: not unlifted)
-
-
-We have a @con2tag@ function for a tycon if:
-\begin{itemize}
-\item
-We're deriving @Eq@ and the tycon has nullary data constructors.
-
-\item
-Or: we're deriving @Ord@ (unless single-constructor), @Enum@, @Ix@
-(enum type only????)
-\end{itemize}
-
-We have a @tag2con@ function for a tycon if:
-\begin{itemize}
-\item
-We're deriving @Enum@, or @Ix@ (enum type only???)
-\end{itemize}
-
-If we have a @tag2con@ function, we also generate a @maxtag@ constant.
-
-\begin{code}
-genTaggeryBinds :: [InstInfo] -> TcM (LHsBinds RdrName)
-genTaggeryBinds infos
-  = do	{ names_so_far <- foldlM do_con2tag []           tycons_of_interest
-	; nm_alist_etc <- foldlM do_tag2con names_so_far tycons_of_interest
-	; return (listToBag (map gen_tag_n_con_monobind nm_alist_etc)) }
-  where
-    all_CTs = [ (cls, tcTyConAppTyCon ty)
-	      | info <- infos, 
-		let (cls,ty) = simpleInstInfoClsTy info ]
-    all_tycons		    = map snd all_CTs
-    (tycons_of_interest, _) = removeDups compare all_tycons
-    
-    do_con2tag acc_Names tycon
-      | isDataTyCon tycon &&
-        ((we_are_deriving eqClassKey tycon
-	    && any isNullarySrcDataCon (tyConDataCons tycon))
-	 || (we_are_deriving ordClassKey  tycon
-	    && not (isProductTyCon tycon))
-	 || (we_are_deriving enumClassKey tycon)
-	 || (we_are_deriving ixClassKey   tycon))
-	
-      = returnM ((con2tag_RDR tycon, tycon, GenCon2Tag)
-		   : acc_Names)
-      | otherwise
-      = returnM acc_Names
-
-    do_tag2con acc_Names tycon
-      | isDataTyCon tycon &&
-         (we_are_deriving enumClassKey tycon ||
-	  we_are_deriving ixClassKey   tycon
-	  && isEnumerationTyCon tycon)
-      = returnM ( (tag2con_RDR tycon, tycon, GenTag2Con)
-		 : (maxtag_RDR  tycon, tycon, GenMaxTag)
-		 : acc_Names)
-      | otherwise
-      = returnM acc_Names
-
-    we_are_deriving clas_key tycon
-      = is_in_eqns clas_key tycon all_CTs
-      where
-	is_in_eqns clas_key tycon [] = False
-	is_in_eqns clas_key tycon ((c,t):cts)
-	  =  (clas_key == classKey c && tycon == t)
-	  || is_in_eqns clas_key tycon cts
-\end{code}
-
-\begin{code}
-derivingThingErr clas tys tycon tyvars why
-  = sep [hsep [ptext SLIT("Can't make a derived instance of"), quotes (ppr pred)],
-	 parens why]
-  where
-    pred = mkClassPred clas (tys ++ [mkTyConApp tycon (mkTyVarTys tyvars)])
-
-derivCtxt :: Maybe Class -> TyCon -> SDoc
-derivCtxt maybe_cls tycon
-  = ptext SLIT("When deriving") <+> cls <+> ptext SLIT("for type") <+> quotes (ppr tycon)
-  where
-    cls = case maybe_cls of
-	    Nothing -> ptext SLIT("instances")
-	    Just c  -> ptext SLIT("the") <+> quotes (ppr c) <+> ptext SLIT("instance")
-\end{code}
-
diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs
deleted file mode 100644
index 497ba235da..0000000000
--- a/ghc/compiler/typecheck/TcEnv.lhs
+++ /dev/null
@@ -1,628 +0,0 @@
-\begin{code}
-module TcEnv(
-	TyThing(..), TcTyThing(..), TcId,
-
-	-- Instance environment, and InstInfo type
-	InstInfo(..), iDFunId, pprInstInfo, pprInstInfoDetails,
-	simpleInstInfoClsTy, simpleInstInfoTy, simpleInstInfoTyCon, 
-	InstBindings(..),
-
-	-- Global environment
-	tcExtendGlobalEnv, 
-	tcExtendGlobalValEnv,
-	tcLookupLocatedGlobal,	tcLookupGlobal, 
-	tcLookupGlobalId, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
-	tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
-	tcLookupLocatedClass, 
-	
-	-- Local environment
-	tcExtendKindEnv, tcExtendKindEnvTvs,
-	tcExtendTyVarEnv, tcExtendTyVarEnv2, 
-	tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2, 
-	tcLookup, tcLookupLocated, tcLookupLocalIds, tcLookupLocalId_maybe,
-	tcLookupId, tcLookupTyVar, getScopedTyVarBinds,
-	lclEnvElts, getInLocalScope, findGlobals, 
-	wrongThingErr, pprBinders,
-	refineEnvironment,
-
-	tcExtendRecEnv,    	-- For knot-tying
-
-	-- Rules
- 	tcExtendRules,
-
-	-- Global type variables
-	tcGetGlobalTyVars,
-
-	-- Template Haskell stuff
-	checkWellStaged, spliceOK, bracketOK, tcMetaTy, thLevel, 
-	topIdLvl, 
-
-	-- New Ids
-	newLocalName, newDFunName
-  ) where
-
-#include "HsVersions.h"
-
-import HsSyn		( LRuleDecl, LHsBinds, LSig, 
-			  LHsTyVarBndr, HsTyVarBndr(..), pprLHsBinds )
-import TcIface		( tcImportDecl )
-import IfaceEnv		( newGlobalBinder )
-import TcRnMonad
-import TcMType		( zonkTcType, zonkTcTyVarsAndFV )
-import TcType		( Type, TcKind, TcTyVar, TcTyVarSet, TcType, TvSubst,
-			  substTy, substTyVar, tyVarsOfType, tcTyVarsOfTypes, mkTyConApp,
-			  getDFunTyKey, tcTyConAppTyCon, tcGetTyVar, mkTyVarTy,
-			  tidyOpenType, isRefineableTy
-			)
-import qualified Type	( getTyVar_maybe )
-import Id		( idName, isLocalId, setIdType )
-import Var		( TyVar, Id, idType, tyVarName )
-import VarSet
-import VarEnv
-import RdrName		( extendLocalRdrEnv )
-import InstEnv		( Instance, DFunId, instanceDFunId, instanceHead )
-import DataCon		( DataCon )
-import TyCon		( TyCon )
-import Class		( Class )
-import Name		( Name, NamedThing(..), getSrcLoc, nameModule, isExternalName )
-import PrelNames	( thFAKE )
-import NameEnv
-import OccName		( mkDFunOcc, occNameString )
-import HscTypes		( extendTypeEnvList, lookupType,
-			  TyThing(..), tyThingId, tyThingDataCon,
-			  ExternalPackageState(..) )
-
-import SrcLoc		( SrcLoc, Located(..) )
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-%*			tcLookupGlobal					*
-%*									*
-%************************************************************************
-
-Using the Located versions (eg. tcLookupLocatedGlobal) is preferred,
-unless you know that the SrcSpan in the monad is already set to the
-span of the Name.
-
-\begin{code}
-tcLookupLocatedGlobal :: Located Name -> TcM TyThing
--- c.f. IfaceEnvEnv.tcIfaceGlobal
-tcLookupLocatedGlobal name
-  = addLocM tcLookupGlobal name
-
-tcLookupGlobal :: Name -> TcM TyThing
--- The Name is almost always an ExternalName, but not always
--- In GHCi, we may make command-line bindings (ghci> let x = True)
--- that bind a GlobalId, but with an InternalName
-tcLookupGlobal name
-  = do	{ env <- getGblEnv
-	
-		-- Try local envt
-	; case lookupNameEnv (tcg_type_env env) name of {
-		Just thing -> return thing ;
-		Nothing	   -> do 
-	 
-		-- Try global envt
-	{ (eps,hpt) <- getEpsAndHpt
-	; case lookupType hpt (eps_PTE eps) name of  {
-	    Just thing -> return thing ;
-	    Nothing    -> do
-
-		-- Should it have been in the local envt?
-	{ let mod = nameModule name
-	; if mod == tcg_mod env || mod == thFAKE then
-		notFound name	-- It should be local, so panic
-				-- The thFAKE possibility is because it
-				-- might be in a declaration bracket
-	  else
-		tcImportDecl name	-- Go find it in an interface
-	}}}}}
-
-tcLookupGlobalId :: Name -> TcM Id
--- Never used for Haskell-source DataCons, hence no ADataCon case
-tcLookupGlobalId name
-  = tcLookupGlobal name		`thenM` \ thing ->
-    return (tyThingId thing)
-
-tcLookupDataCon :: Name -> TcM DataCon
-tcLookupDataCon con_name
-  = tcLookupGlobal con_name	`thenM` \ thing ->
-    return (tyThingDataCon thing)
-
-tcLookupClass :: Name -> TcM Class
-tcLookupClass name
-  = tcLookupGlobal name		`thenM` \ thing ->
-    case thing of
-	AClass cls -> return cls
-	other	   -> wrongThingErr "class" (AGlobal thing) name
-	
-tcLookupTyCon :: Name -> TcM TyCon
-tcLookupTyCon name
-  = tcLookupGlobal name		`thenM` \ thing ->
-    case thing of
-	ATyCon tc -> return tc
-	other	  -> wrongThingErr "type constructor" (AGlobal thing) name
-
-tcLookupLocatedGlobalId :: Located Name -> TcM Id
-tcLookupLocatedGlobalId = addLocM tcLookupId
-
-tcLookupLocatedClass :: Located Name -> TcM Class
-tcLookupLocatedClass = addLocM tcLookupClass
-
-tcLookupLocatedTyCon :: Located Name -> TcM TyCon
-tcLookupLocatedTyCon = addLocM tcLookupTyCon
-\end{code}
-
-%************************************************************************
-%*									*
-		Extending the global environment
-%*									*
-%************************************************************************
-
-
-\begin{code}
-tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
-  -- Given a mixture of Ids, TyCons, Classes, all from the
-  -- module being compiled, extend the global environment
-tcExtendGlobalEnv things thing_inside
-   = do	{ env <- getGblEnv
-	; let ge'  = extendTypeEnvList (tcg_type_env env) things
-	; setGblEnv (env {tcg_type_env = ge'}) thing_inside }
-
-tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
-  -- Same deal as tcExtendGlobalEnv, but for Ids
-tcExtendGlobalValEnv ids thing_inside 
-  = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
-\end{code}
-
-\begin{code}
-tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
--- Extend the global environments for the type/class knot tying game
-tcExtendRecEnv gbl_stuff thing_inside
- = updGblEnv upd thing_inside
- where
-   upd env = env { tcg_type_env = extend (tcg_type_env env) }
-   extend env = extendNameEnvList env gbl_stuff
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The local environment}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcLookupLocated :: Located Name -> TcM TcTyThing
-tcLookupLocated = addLocM tcLookup
-
-tcLookup :: Name -> TcM TcTyThing
-tcLookup name
-  = getLclEnv 		`thenM` \ local_env ->
-    case lookupNameEnv (tcl_env local_env) name of
-	Just thing -> returnM thing
-	Nothing    -> tcLookupGlobal name `thenM` \ thing ->
-		      returnM (AGlobal thing)
-
-tcLookupTyVar :: Name -> TcM TcTyVar
-tcLookupTyVar name
-  = tcLookup name	`thenM` \ thing -> 
-    case thing of
-	ATyVar _ ty -> return (tcGetTyVar "tcLookupTyVar" ty)
-	other	    -> pprPanic "tcLookupTyVar" (ppr name)
-
-tcLookupId :: Name -> TcM Id
--- Used when we aren't interested in the binding level
--- Never a DataCon. (Why does that matter? see TcExpr.tcId)
-tcLookupId name
-  = tcLookup name	`thenM` \ thing -> 
-    case thing of
-	ATcId tc_id _ _	  -> returnM tc_id
-	AGlobal (AnId id) -> returnM id
-	other		  -> pprPanic "tcLookupId" (ppr name)
-
-tcLookupLocalId_maybe :: Name -> TcM (Maybe Id)
-tcLookupLocalId_maybe name
-  = getLclEnv 		`thenM` \ local_env ->
-    case lookupNameEnv (tcl_env local_env) name of
-	Just (ATcId tc_id _ _) -> return (Just tc_id)
-	other	 	       -> return Nothing
-
-tcLookupLocalIds :: [Name] -> TcM [TcId]
--- We expect the variables to all be bound, and all at
--- the same level as the lookup.  Only used in one place...
-tcLookupLocalIds ns
-  = getLclEnv 		`thenM` \ env ->
-    returnM (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
-  where
-    lookup lenv lvl name 
-	= case lookupNameEnv lenv name of
-		Just (ATcId id lvl1 _) -> ASSERT( lvl == lvl1 ) id
-		other		       -> pprPanic "tcLookupLocalIds" (ppr name)
-
-lclEnvElts :: TcLclEnv -> [TcTyThing]
-lclEnvElts env = nameEnvElts (tcl_env env)
-
-getInLocalScope :: TcM (Name -> Bool)
-  -- Ids only
-getInLocalScope = getLclEnv	`thenM` \ env ->
-		  let 
-			lcl_env = tcl_env env
-		  in
-		  return (`elemNameEnv` lcl_env)
-\end{code}
-
-\begin{code}
-tcExtendKindEnv :: [(Name, TcKind)] -> TcM r -> TcM r
-tcExtendKindEnv things thing_inside
-  = updLclEnv upd thing_inside
-  where
-    upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
-    extend env  = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
-
-tcExtendKindEnvTvs :: [LHsTyVarBndr Name] -> TcM r -> TcM r
-tcExtendKindEnvTvs bndrs thing_inside
-  = updLclEnv upd thing_inside
-  where
-    upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
-    extend env  = extendNameEnvList env pairs
-    pairs       = [(n, AThing k) | L _ (KindedTyVar n k) <- bndrs]
-
-tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
-tcExtendTyVarEnv tvs thing_inside
-  = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
-
-tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
-tcExtendTyVarEnv2 binds thing_inside
-  = getLclEnv	   `thenM` \ env@(TcLclEnv {tcl_env = le, 
-					    tcl_tyvars = gtvs, 
-					    tcl_rdr = rdr_env}) ->
-    let
-	rdr_env'   = extendLocalRdrEnv rdr_env (map fst binds)
-	new_tv_set = tcTyVarsOfTypes (map snd binds)
- 	le'        = extendNameEnvList le [(name, ATyVar name ty) | (name, ty) <- binds]
-    in
-	-- It's important to add the in-scope tyvars to the global tyvar set
-	-- as well.  Consider
-	--	f (_::r) = let g y = y::r in ...
-	-- Here, g mustn't be generalised.  This is also important during
-	-- class and instance decls, when we mustn't generalise the class tyvars
-	-- when typechecking the methods.
-    tc_extend_gtvs gtvs new_tv_set		`thenM` \ gtvs' ->
-    setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside
-
-getScopedTyVarBinds :: TcM [(Name, TcType)]
-getScopedTyVarBinds
-  = do	{ lcl_env <- getLclEnv
-	; return [(name, ty) | ATyVar name ty <- nameEnvElts (tcl_env lcl_env)] }
-\end{code}
-
-
-\begin{code}
-tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
--- Invariant: the TcIds are fully zonked. Reasons:
---	(a) The kinds of the forall'd type variables are defaulted
---	    (see Kind.defaultKind, done in zonkQuantifiedTyVar)
---	(b) There are no via-Indirect occurrences of the bound variables
---	    in the types, because instantiation does not look through such things
---	(c) The call to tyVarsOfTypes is ok without looking through refs
-tcExtendIdEnv ids thing_inside = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
-
-tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
-tcExtendIdEnv1 name id thing_inside = tcExtendIdEnv2 [(name,id)] thing_inside
-
-tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
--- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
-tcExtendIdEnv2 names_w_ids thing_inside
-  = getLclEnv		`thenM` \ env ->
-    let
-	extra_global_tyvars = tcTyVarsOfTypes [idType id | (_,id) <- names_w_ids]
-	th_lvl		    = thLevel (tcl_th_ctxt   env)
-	extra_env	    = [ (name, ATcId id th_lvl (isRefineableTy (idType id)))
-			      | (name,id) <- names_w_ids]
-	le'		    = extendNameEnvList (tcl_env env) extra_env
-	rdr_env'	    = extendLocalRdrEnv (tcl_rdr env) [name | (name,_) <- names_w_ids]
-    in
-    traceTc (text "env2") `thenM_`
-    traceTc (text "env3" <+> ppr extra_env) `thenM_`
-    tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars	`thenM` \ gtvs' ->
-    (traceTc (text "env4") `thenM_`
-    setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside)
-\end{code}
-
-
-\begin{code}
------------------------
--- findGlobals looks at the value environment and finds values
--- whose types mention the offending type variable.  It has to be 
--- careful to zonk the Id's type first, so it has to be in the monad.
--- We must be careful to pass it a zonked type variable, too.
-
-findGlobals :: TcTyVarSet
-            -> TidyEnv 
-            -> TcM (TidyEnv, [SDoc])
-
-findGlobals tvs tidy_env
-  = getLclEnv		`thenM` \ lcl_env ->
-    go tidy_env [] (lclEnvElts lcl_env)
-  where
-    go tidy_env acc [] = returnM (tidy_env, acc)
-    go tidy_env acc (thing : things)
-      = find_thing ignore_it tidy_env thing 	`thenM` \ (tidy_env1, maybe_doc) ->
-	case maybe_doc of
-	  Just d  -> go tidy_env1 (d:acc) things
-	  Nothing -> go tidy_env1 acc     things
-
-    ignore_it ty = not (tvs `intersectsVarSet` tyVarsOfType ty)
-
------------------------
-find_thing ignore_it tidy_env (ATcId id _ _)
-  = zonkTcType  (idType id)	`thenM` \ id_ty ->
-    if ignore_it id_ty then
-	returnM (tidy_env, Nothing)
-    else let
-	(tidy_env', tidy_ty) = tidyOpenType tidy_env id_ty
-	msg = sep [ppr id <+> dcolon <+> ppr tidy_ty, 
-		   nest 2 (parens (ptext SLIT("bound at") <+>
-			 	   ppr (getSrcLoc id)))]
-    in
-    returnM (tidy_env', Just msg)
-
-find_thing ignore_it tidy_env (ATyVar tv ty)
-  = zonkTcType ty		`thenM` \ tv_ty ->
-    if ignore_it tv_ty then
-	returnM (tidy_env, Nothing)
-    else let
-	-- The name tv is scoped, so we don't need to tidy it
-	(tidy_env1, tidy_ty) = tidyOpenType  tidy_env tv_ty
-	msg = sep [ptext SLIT("Scoped type variable") <+> quotes (ppr tv) <+> eq_stuff, nest 2 bound_at]
-
-	eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty, 
-		   getOccName tv == getOccName tv' = empty
-		 | otherwise = equals <+> ppr tidy_ty
-		-- It's ok to use Type.getTyVar_maybe because ty is zonked by now
-	bound_at = parens $ ptext SLIT("bound at:") <+> ppr (getSrcLoc tv)
-    in
-    returnM (tidy_env1, Just msg)
-\end{code}
-
-\begin{code}
-refineEnvironment :: TvSubst -> TcM a -> TcM a
-refineEnvironment reft thing_inside
-  = do	{ env <- getLclEnv
-	; let le' = mapNameEnv refine (tcl_env env)
-	; gtvs' <- refineGlobalTyVars reft (tcl_tyvars env) 
- 	; setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs'}) thing_inside }
-  where
-    refine (ATcId id lvl True) = ATcId (setIdType id (substTy reft (idType id))) lvl True
-    refine (ATyVar tv ty)      = ATyVar tv (substTy reft ty)
-    refine elt		       = elt
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The global tyvars}
-%*									*
-%************************************************************************
-
-\begin{code}
-tc_extend_gtvs gtvs extra_global_tvs
-  = readMutVar gtvs		`thenM` \ global_tvs ->
-    newMutVar (global_tvs `unionVarSet` extra_global_tvs)
-
-refineGlobalTyVars :: GadtRefinement -> TcRef TcTyVarSet -> TcM (TcRef TcTyVarSet)
-refineGlobalTyVars reft gtv_var
-  = readMutVar gtv_var				`thenM` \ gbl_tvs ->
-    newMutVar (tcTyVarsOfTypes (map (substTyVar reft) (varSetElems gbl_tvs)))
-\end{code}
-
-@tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
-To improve subsequent calls to the same function it writes the zonked set back into
-the environment.
-
-\begin{code}
-tcGetGlobalTyVars :: TcM TcTyVarSet
-tcGetGlobalTyVars
-  = getLclEnv					`thenM` \ (TcLclEnv {tcl_tyvars = gtv_var}) ->
-    readMutVar gtv_var				`thenM` \ gbl_tvs ->
-    zonkTcTyVarsAndFV (varSetElems gbl_tvs)	`thenM` \ gbl_tvs' ->
-    writeMutVar gtv_var gbl_tvs'		`thenM_` 
-    returnM gbl_tvs'
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Rules}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
-	-- Just pop the new rules into the EPS and envt resp
-	-- All the rules come from an interface file, not soruce
-	-- Nevertheless, some may be for this module, if we read
-	-- its interface instead of its source code
-tcExtendRules lcl_rules thing_inside
- = do { env <- getGblEnv
-      ; let
-	  env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
-      ; setGblEnv env' thing_inside }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Meta level
-%*									*
-%************************************************************************
-
-\begin{code}
-instance Outputable ThStage where
-   ppr Comp	     = text "Comp"
-   ppr (Brack l _ _) = text "Brack" <+> int l
-   ppr (Splice l)    = text "Splice" <+> int l
-
-
-thLevel :: ThStage -> ThLevel
-thLevel Comp	      = topLevel
-thLevel (Splice l)    = l
-thLevel (Brack l _ _) = l
-
-
-checkWellStaged :: SDoc		-- What the stage check is for
-		-> ThLevel 	-- Binding level
-	        -> ThStage	-- Use stage
-		-> TcM ()	-- Fail if badly staged, adding an error
-checkWellStaged pp_thing bind_lvl use_stage
-  | bind_lvl <= use_lvl 	-- OK!
-  = returnM ()	
-
-  | bind_lvl == topLevel	-- GHC restriction on top level splices
-  = failWithTc $ 
-    sep [ptext SLIT("GHC stage restriction:") <+>  pp_thing,
-	 nest 2 (ptext SLIT("is used in a top-level splice, and must be imported, not defined locally"))]
-
-  | otherwise			-- Badly staged
-  = failWithTc $ 
-    ptext SLIT("Stage error:") <+> pp_thing <+> 
-	hsep   [ptext SLIT("is bound at stage") <+> ppr bind_lvl,
-		ptext SLIT("but used at stage") <+> ppr use_lvl]
-  where
-    use_lvl = thLevel use_stage
-
-
-topIdLvl :: Id -> ThLevel
--- Globals may either be imported, or may be from an earlier "chunk" 
--- (separated by declaration splices) of this module.  The former
---  *can* be used inside a top-level splice, but the latter cannot.
--- Hence we give the former impLevel, but the latter topLevel
--- E.g. this is bad:
---	x = [| foo |]
---	$( f x )
--- By the time we are prcessing the $(f x), the binding for "x" 
--- will be in the global env, not the local one.
-topIdLvl id | isLocalId id = topLevel
-	    | otherwise    = impLevel
-
--- Indicates the legal transitions on bracket( [| |] ).
-bracketOK :: ThStage -> Maybe ThLevel
-bracketOK (Brack _ _ _) = Nothing	-- Bracket illegal inside a bracket
-bracketOK stage         = Just (thLevel stage + 1)
-
--- Indicates the legal transitions on splice($).
-spliceOK :: ThStage -> Maybe ThLevel
-spliceOK (Splice _) = Nothing	-- Splice illegal inside splice
-spliceOK stage      = Just (thLevel stage - 1)
-
-tcMetaTy :: Name -> TcM Type
--- Given the name of a Template Haskell data type, 
--- return the type
--- E.g. given the name "Expr" return the type "Expr"
-tcMetaTy tc_name
-  = tcLookupTyCon tc_name	`thenM` \ t ->
-    returnM (mkTyConApp t [])
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The InstInfo type}
-%*									*
-%************************************************************************
-
-The InstInfo type summarises the information in an instance declaration
-
-    instance c => k (t tvs) where b
-
-It is used just for *local* instance decls (not ones from interface files).
-But local instance decls includes
-	- derived ones
-	- generic ones
-as well as explicit user written ones.
-
-\begin{code}
-data InstInfo
-  = InstInfo {
-      iSpec  :: Instance,		-- Includes the dfun id.  Its forall'd type 
-      iBinds :: InstBindings		-- variables scope over the stuff in InstBindings!
-    }
-
-iDFunId :: InstInfo -> DFunId
-iDFunId info = instanceDFunId (iSpec info)
-
-data InstBindings
-  = VanillaInst 		-- The normal case
-	(LHsBinds Name)		-- Bindings
-	[LSig Name]		-- User pragmas recorded for generating 
-				-- specialised instances
-
-  | NewTypeDerived 		-- Used for deriving instances of newtypes, where the
-	[Type]			-- witness dictionary is identical to the argument 
-				-- dictionary.  Hence no bindings, no pragmas
-	-- The [Type] are the representation types
-	-- See notes in TcDeriv
-
-pprInstInfo info = vcat [ptext SLIT("InstInfo:") <+> ppr (idType (iDFunId info))]
-
-pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
-  where
-    details (VanillaInst b _)  = pprLHsBinds b
-    details (NewTypeDerived _) = text "Derived from the representation type"
-
-simpleInstInfoClsTy :: InstInfo -> (Class, Type)
-simpleInstInfoClsTy info = case instanceHead (iSpec info) of
-			  (_, _, cls, [ty]) -> (cls, ty)
-
-simpleInstInfoTy :: InstInfo -> Type
-simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
-
-simpleInstInfoTyCon :: InstInfo -> TyCon
-  -- Gets the type constructor for a simple instance declaration,
-  -- i.e. one of the form 	instance (...) => C (T a b c) where ...
-simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
-\end{code}
-
-Make a name for the dict fun for an instance decl.  It's an *external*
-name, like otber top-level names, and hence must be made with newGlobalBinder.
-
-\begin{code}
-newDFunName :: Class -> [Type] -> SrcLoc -> TcM Name
-newDFunName clas (ty:_) loc
-  = do	{ index   <- nextDFunIndex
-	; is_boot <- tcIsHsBoot
-	; mod     <- getModule
-	; let info_string = occNameString (getOccName clas) ++ 
-			    occNameString (getDFunTyKey ty)
-	      dfun_occ = mkDFunOcc info_string is_boot index
-
-	; newGlobalBinder mod dfun_occ Nothing loc }
-
-newDFunName clas [] loc = pprPanic "newDFunName" (ppr clas <+> ppr loc)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Errors}
-%*									*
-%************************************************************************
-
-\begin{code}
-pprBinders :: [Name] -> SDoc
--- Used in error messages
--- Use quotes for a single one; they look a bit "busy" for several
-pprBinders [bndr] = quotes (ppr bndr)
-pprBinders bndrs  = pprWithCommas ppr bndrs
-
-notFound name 
-  = failWithTc (ptext SLIT("GHC internal error:") <+> quotes (ppr name) <+> 
-		ptext SLIT("is not in scope"))
-
-wrongThingErr expected thing name
-  = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+> 
-		ptext SLIT("used as a") <+> text expected)
-\end{code}
diff --git a/ghc/compiler/typecheck/TcExpr.hi-boot-5 b/ghc/compiler/typecheck/TcExpr.hi-boot-5
deleted file mode 100644
index 14714cd2f6..0000000000
--- a/ghc/compiler/typecheck/TcExpr.hi-boot-5
+++ /dev/null
@@ -1,16 +0,0 @@
-__interface TcExpr 1 0 where
-__export TcExpr tcCheckSigma tcCheckRho tcMonoExpr ;
-1 tcCheckSigma :: 
-	  HsExpr.LHsExpr Name.Name
-       -> TcType.TcType
-       -> TcRnTypes.TcM (HsExpr.LHsExpr Var.Id) ;
-
-1 tcCheckRho :: 
-  	  HsExpr.LHsExpr Name.Name
-       -> TcType.TcType
-       -> TcRnTypes.TcM (HsExpr.LHsExpr Var.Id) ;
-
-1 tcMonoExpr :: 
-  	  HsExpr.LHsExpr Name.Name
-       -> TcUnify.Expected TcType.TcType
-       -> TcRnTypes.TcM (HsExpr.LHsExpr Var.Id) ;
diff --git a/ghc/compiler/typecheck/TcExpr.hi-boot-6 b/ghc/compiler/typecheck/TcExpr.hi-boot-6
deleted file mode 100644
index 5a0fa8cd2c..0000000000
--- a/ghc/compiler/typecheck/TcExpr.hi-boot-6
+++ /dev/null
@@ -1,21 +0,0 @@
-module TcExpr where
-
-tcPolyExpr :: 
-	  HsExpr.LHsExpr Name.Name
-       -> TcType.BoxySigmaType
-       -> TcRnTypes.TcM (HsExpr.LHsExpr Var.Id)
-
-tcMonoExpr :: 
-  	  HsExpr.LHsExpr Name.Name
-       -> TcType.BoxyRhoType
-       -> TcRnTypes.TcM (HsExpr.LHsExpr Var.Id)
-
-tcInferRho :: 
-  	  HsExpr.LHsExpr Name.Name
-       -> TcRnTypes.TcM (HsExpr.LHsExpr Var.Id, TcType.TcType)
-
-tcSyntaxOp :: 
-	  TcRnTypes.InstOrigin
-       -> HsExpr.HsExpr Name.Name
-       -> TcType.TcType
-       -> TcRnTypes.TcM (HsExpr.HsExpr Var.Id)
diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
deleted file mode 100644
index a044f43ef2..0000000000
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ /dev/null
@@ -1,1139 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcExpr]{Typecheck an expression}
-
-\begin{code}
-module TcExpr ( tcPolyExpr, tcPolyExprNC, 
-		tcMonoExpr, tcInferRho, tcSyntaxOp ) where
-
-#include "HsVersions.h"
-
-#ifdef GHCI 	/* Only if bootstrapped */
-import {-# SOURCE #-}	TcSplice( tcSpliceExpr, tcBracket )
-import HsSyn		( nlHsVar )
-import Id		( Id )
-import Name		( isExternalName )
-import TcType		( isTauTy )
-import TcEnv		( checkWellStaged )
-import HsSyn		( nlHsApp )
-import qualified DsMeta
-#endif
-
-import HsSyn		( HsExpr(..), LHsExpr, ArithSeqInfo(..), recBindFields,
-			  HsMatchContext(..), HsRecordBinds, 
-			  mkHsCoerce, mkHsApp, mkHsDictApp, mkHsTyApp )
-import TcHsSyn		( hsLitType )
-import TcRnMonad
-import TcUnify		( tcInfer, tcSubExp, tcFunResTy, tcGen, boxyUnify, subFunTys, zapToMonotype, stripBoxyType,
-			  boxySplitListTy, boxySplitTyConApp, wrapFunResCoercion, boxySubMatchType, 
-			  unBox )
-import BasicTypes	( Arity, isMarkedStrict )
-import Inst		( newMethodFromName, newIPDict, instToId,
-			  newDicts, newMethodWithGivenTy, tcInstStupidTheta )
-import TcBinds		( tcLocalBinds )
-import TcEnv		( tcLookup, tcLookupId,
-			  tcLookupDataCon, tcLookupGlobalId
-			)
-import TcArrows		( tcProc )
-import TcMatches	( tcMatchesCase, tcMatchLambda, tcDoStmts, TcMatchCtxt(..) )
-import TcHsType		( tcHsSigType, UserTypeCtxt(..) )
-import TcPat		( tcOverloadedLit, badFieldCon )
-import TcMType		( tcInstTyVars, newFlexiTyVarTy, newBoxyTyVars, readFilledBox, 
-			  tcInstBoxyTyVar, tcInstTyVar )
-import TcType		( TcType, TcSigmaType, TcRhoType, 
-			  BoxySigmaType, BoxyRhoType, ThetaType,
-			  mkTyVarTys, mkFunTys, tcMultiSplitSigmaTy, tcSplitFunTysN, 
-			  isSigmaTy, mkFunTy, mkTyConApp, isLinearPred,
-			  exactTyVarsOfType, exactTyVarsOfTypes, mkTyVarTy, 
-			  zipTopTvSubst, zipOpenTvSubst, substTys, substTyVar, lookupTyVar
-			)
-import Kind		( argTypeKind )
-
-import Id		( idType, idName, recordSelectorFieldLabel, isRecordSelector, 
-			  isNaughtyRecordSelector, isDataConId_maybe )
-import DataCon		( DataCon, dataConFieldLabels, dataConStrictMarks, dataConSourceArity,
-			  dataConWrapId, isVanillaDataCon, dataConTyVars, dataConOrigArgTys )
-import Name		( Name )
-import TyCon		( FieldLabel, tyConStupidTheta, tyConDataCons )
-import Type		( substTheta, substTy )
-import Var		( TyVar, tyVarKind )
-import VarSet		( emptyVarSet, elemVarSet, unionVarSet )
-import TysWiredIn	( boolTy, parrTyCon, tupleTyCon )
-import PrelNames	( enumFromName, enumFromThenName, 
-			  enumFromToName, enumFromThenToName,
-			  enumFromToPName, enumFromThenToPName, negateName
-			)
-import DynFlags
-import StaticFlags	( opt_NoMethodSharing )
-import HscTypes		( TyThing(..) )
-import SrcLoc		( Located(..), unLoc, noLoc, getLoc )
-import Util
-import ListSetOps	( assocMaybe )
-import Maybes		( catMaybes )
-import Outputable
-import FastString
-
-#ifdef DEBUG
-import TyCon		( tyConArity )
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Main wrappers}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcPolyExpr, tcPolyExprNC
-	 :: LHsExpr Name		-- Expession to type check
-       	 -> BoxySigmaType		-- Expected type (could be a polytpye)
-       	 -> TcM (LHsExpr TcId)	-- Generalised expr with expected type
-
--- tcPolyExpr is a convenient place (frequent but not too frequent) place
--- to add context information.
--- The NC version does not do so, usually because the caller wants
--- to do so himself.
-
-tcPolyExpr expr res_ty 	
-  = addErrCtxt (exprCtxt (unLoc expr)) $
-    tcPolyExprNC expr res_ty
-
-tcPolyExprNC expr res_ty 
-  | isSigmaTy res_ty
-  = do	{ (gen_fn, expr') <- tcGen res_ty emptyVarSet (tcPolyExprNC expr)
-		-- Note the recursive call to tcPolyExpr, because the
-		-- type may have multiple layers of for-alls
-	; return (L (getLoc expr') (mkHsCoerce gen_fn (unLoc expr'))) }
-
-  | otherwise
-  = tcMonoExpr expr res_ty
-
----------------
-tcPolyExprs :: [LHsExpr Name] -> [TcType] -> TcM [LHsExpr TcId]
-tcPolyExprs [] [] = returnM []
-tcPolyExprs (expr:exprs) (ty:tys)
- = do 	{ expr'  <- tcPolyExpr  expr  ty
-	; exprs' <- tcPolyExprs exprs tys
-	; returnM (expr':exprs') }
-tcPolyExprs exprs tys = pprPanic "tcPolyExprs" (ppr exprs $$ ppr tys)
-
----------------
-tcMonoExpr :: LHsExpr Name	-- Expression to type check
-	   -> BoxyRhoType 	-- Expected type (could be a type variable)
-				-- Definitely no foralls at the top
-				-- Can contain boxes, which will be filled in
-	   -> TcM (LHsExpr TcId)
-
-tcMonoExpr (L loc expr) res_ty
-  = ASSERT( not (isSigmaTy res_ty) )
-    setSrcSpan loc $
-    do	{ expr' <- tcExpr expr res_ty
-	; return (L loc expr') }
-
----------------
-tcInferRho :: LHsExpr Name -> TcM (LHsExpr TcId, TcRhoType)
-tcInferRho expr	= tcInfer (tcMonoExpr expr)
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-	tcExpr: the main expression typechecker
-%*									*
-%************************************************************************
-
-\begin{code}
-tcExpr :: HsExpr Name -> BoxyRhoType -> TcM (HsExpr TcId)
-tcExpr (HsVar name)     res_ty = tcId (OccurrenceOf name) name res_ty
-
-tcExpr (HsLit lit) 	res_ty = do { boxyUnify (hsLitType lit) res_ty
-				    ; return (HsLit lit) }
-
-tcExpr (HsPar expr)     res_ty = do { expr' <- tcMonoExpr expr res_ty
-				    ; return (HsPar expr') }
-
-tcExpr (HsSCC lbl expr) res_ty = do { expr' <- tcMonoExpr expr res_ty
-				    ; returnM (HsSCC lbl expr') }
-
-tcExpr (HsCoreAnn lbl expr) res_ty 	 -- hdaume: core annotation
-  = do	{ expr' <- tcMonoExpr expr res_ty
-	; return (HsCoreAnn lbl expr') }
-
-tcExpr (HsOverLit lit) res_ty  
-  = do 	{ lit' <- tcOverloadedLit (LiteralOrigin lit) lit res_ty
-	; return (HsOverLit lit') }
-
-tcExpr (NegApp expr neg_expr) res_ty
-  = do	{ neg_expr' <- tcSyntaxOp (OccurrenceOf negateName) neg_expr
-				  (mkFunTy res_ty res_ty)
-	; expr' <- tcMonoExpr expr res_ty
-	; return (NegApp expr' neg_expr') }
-
-tcExpr (HsIPVar ip) res_ty
-  = do	{ 	-- Implicit parameters must have a *tau-type* not a 
-		-- type scheme.  We enforce this by creating a fresh
-		-- type variable as its type.  (Because res_ty may not
-		-- be a tau-type.)
-	  ip_ty <- newFlexiTyVarTy argTypeKind	-- argTypeKind: it can't be an unboxed tuple
-	; co_fn <- tcSubExp ip_ty res_ty
-	; (ip', inst) <- newIPDict (IPOccOrigin ip) ip ip_ty
-	; extendLIE inst
-	; return (mkHsCoerce co_fn (HsIPVar ip')) }
-
-tcExpr (HsApp e1 e2) res_ty 
-  = go e1 [e2]
-  where
-    go :: LHsExpr Name -> [LHsExpr Name] -> TcM (HsExpr TcId)
-    go (L _ (HsApp e1 e2)) args = go e1 (e2:args)
-    go lfun@(L loc fun) args
-	= do { (fun', args') <- addErrCtxt (callCtxt lfun args) $
-				tcApp fun (length args) (tcArgs lfun args) res_ty
-	     ; return (unLoc (foldl mkHsApp (L loc fun') args')) }
-
-tcExpr (HsLam match) res_ty
-  = do	{ (co_fn, match') <- tcMatchLambda match res_ty
-	; return (mkHsCoerce co_fn (HsLam match')) }
-
-tcExpr in_expr@(ExprWithTySig expr sig_ty) res_ty
- = do	{ sig_tc_ty <- tcHsSigType ExprSigCtxt sig_ty
-	; expr' <- tcPolyExpr expr sig_tc_ty
-	; co_fn <- tcSubExp sig_tc_ty res_ty
-	; return (mkHsCoerce co_fn (ExprWithTySigOut expr' sig_ty)) }
-
-tcExpr (HsType ty) res_ty
-  = failWithTc (text "Can't handle type argument:" <+> ppr ty)
-	-- This is the syntax for type applications that I was planning
-	-- but there are difficulties (e.g. what order for type args)
-	-- so it's not enabled yet.
-	-- Can't eliminate it altogether from the parser, because the
-	-- same parser parses *patterns*.
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Infix operators and sections
-%*									*
-%************************************************************************
-
-\begin{code}
-tcExpr in_expr@(OpApp arg1 lop@(L loc op) fix arg2) res_ty
-  = do	{ (op', [arg1', arg2']) <- tcApp op 2 (tcArgs lop [arg1,arg2]) res_ty
-	; return (OpApp arg1' (L loc op') fix arg2') }
-
--- Left sections, equivalent to
---	\ x -> e op x,
--- or
---	\ x -> op e x,
--- or just
--- 	op e
---
--- We treat it as similar to the latter, so we don't
--- actually require the function to take two arguments
--- at all.  For example, (x `not`) means (not x);
--- you get postfix operators!  Not really Haskell 98
--- I suppose, but it's less work and kind of useful.
-
-tcExpr in_expr@(SectionL arg1 lop@(L loc op)) res_ty
-  = do 	{ (op', [arg1']) <- tcApp op 1 (tcArgs lop [arg1]) res_ty
-	; return (SectionL arg1' (L loc op')) }
-
--- Right sections, equivalent to \ x -> x `op` expr, or
---	\ x -> op x expr
- 
-tcExpr in_expr@(SectionR lop@(L loc op) arg2) res_ty
-  = do	{ (co_fn, (op', arg2')) <- subFunTys doc 1 res_ty $ \ [arg1_ty'] res_ty' ->
-				   tcApp op 2 (tc_args arg1_ty') res_ty'
-	; return (mkHsCoerce co_fn (SectionR (L loc op') arg2')) }
-  where
-    doc = ptext SLIT("The section") <+> quotes (ppr in_expr)
-		<+> ptext SLIT("takes one argument")
-    tc_args arg1_ty' [arg1_ty, arg2_ty] 
-	= do { boxyUnify arg1_ty' arg1_ty
-	     ; tcArg lop (arg2, arg2_ty, 2) }
-\end{code}
-
-\begin{code}
-tcExpr (HsLet binds expr) res_ty
-  = do	{ (binds', expr') <- tcLocalBinds binds $
-			     tcMonoExpr expr res_ty   
-	; return (HsLet binds' expr') }
-
-tcExpr (HsCase scrut matches) exp_ty
-  = do	{  -- We used to typecheck the case alternatives first.
-	   -- The case patterns tend to give good type info to use
-	   -- when typechecking the scrutinee.  For example
-	   --	case (map f) of
-	   --	  (x:xs) -> ...
-	   -- will report that map is applied to too few arguments
-	   --
-	   -- But now, in the GADT world, we need to typecheck the scrutinee
-	   -- first, to get type info that may be refined in the case alternatives
-	  (scrut', scrut_ty) <- addErrCtxt (caseScrutCtxt scrut)
-				 	   (tcInferRho scrut)
-
-	; traceTc (text "HsCase" <+> ppr scrut_ty)
-	; matches' <- tcMatchesCase match_ctxt scrut_ty matches exp_ty
-	; return (HsCase scrut' matches') }
- where
-    match_ctxt = MC { mc_what = CaseAlt,
-		      mc_body = tcPolyExpr }
-
-tcExpr (HsIf pred b1 b2) res_ty
-  = do	{ pred' <- addErrCtxt (predCtxt pred) $
-		   tcMonoExpr pred boolTy
-	; b1' <- tcMonoExpr b1 res_ty
-	; b2' <- tcMonoExpr b2 res_ty
-	; return (HsIf pred' b1' b2') }
-
-tcExpr (HsDo do_or_lc stmts body _) res_ty
-  = tcDoStmts do_or_lc stmts body res_ty
-
-tcExpr in_expr@(ExplicitList _ exprs) res_ty	-- Non-empty list
-  = do 	{ elt_ty <- boxySplitListTy res_ty
-	; exprs' <- mappM (tc_elt elt_ty) exprs
-	; return (ExplicitList elt_ty exprs') }
-  where
-    tc_elt elt_ty expr = tcPolyExpr expr elt_ty
-
-tcExpr in_expr@(ExplicitPArr _ exprs) res_ty	-- maybe empty
-  = do	{ [elt_ty] <- boxySplitTyConApp parrTyCon res_ty
-    	; exprs' <- mappM (tc_elt elt_ty) exprs	
-	; ifM (null exprs) (zapToMonotype elt_ty)
-		-- If there are no expressions in the comprehension
-		-- we must still fill in the box
-		-- (Not needed for [] and () becuase they happen
-		--  to parse as data constructors.)
-	; return (ExplicitPArr elt_ty exprs') }
-  where
-    tc_elt elt_ty expr = tcPolyExpr expr elt_ty
-
-tcExpr (ExplicitTuple exprs boxity) res_ty
-  = do	{ arg_tys <- boxySplitTyConApp (tupleTyCon boxity (length exprs)) res_ty
-	; exprs' <-  tcPolyExprs exprs arg_tys
-	; return (ExplicitTuple exprs' boxity) }
-
-tcExpr (HsProc pat cmd) res_ty
-  = do	{ (pat', cmd') <- tcProc pat cmd res_ty
-	; return (HsProc pat' cmd') }
-
-tcExpr e@(HsArrApp _ _ _ _ _) _
-  = failWithTc (vcat [ptext SLIT("The arrow command"), nest 2 (ppr e), 
-                      ptext SLIT("was found where an expression was expected")])
-
-tcExpr e@(HsArrForm _ _ _) _
-  = failWithTc (vcat [ptext SLIT("The arrow command"), nest 2 (ppr e), 
-                      ptext SLIT("was found where an expression was expected")])
-\end{code}
-
-%************************************************************************
-%*									*
-		Record construction and update
-%*									*
-%************************************************************************
-
-\begin{code}
-tcExpr expr@(RecordCon (L loc con_name) _ rbinds) res_ty
-  = do	{ data_con <- tcLookupDataCon con_name
-
- 	-- Check for missing fields
-	; checkMissingFields data_con rbinds
-
-	; let arity = dataConSourceArity data_con
-	      check_fields arg_tys 
-		  = do	{ rbinds' <- tcRecordBinds data_con arg_tys rbinds
-		 	; mapM unBox arg_tys 
-			; return rbinds' }
-		-- The unBox ensures that all the boxes in arg_tys are indeed
-		-- filled, which is the invariant expected by tcIdApp
-
-	; (con_expr, rbinds') <- tcIdApp con_name arity check_fields res_ty
-
-	; returnM (RecordCon (L loc (dataConWrapId data_con)) con_expr rbinds') }
-
--- The main complication with RecordUpd is that we need to explicitly
--- handle the *non-updated* fields.  Consider:
---
---	data T a b = MkT1 { fa :: a, fb :: b }
---		   | MkT2 { fa :: a, fc :: Int -> Int }
---		   | MkT3 { fd :: a }
---	
---	upd :: T a b -> c -> T a c
---	upd t x = t { fb = x}
---
--- The type signature on upd is correct (i.e. the result should not be (T a b))
--- because upd should be equivalent to:
---
---	upd t x = case t of 
---			MkT1 p q -> MkT1 p x
---			MkT2 a b -> MkT2 p b
---			MkT3 d   -> error ...
---
--- So we need to give a completely fresh type to the result record,
--- and then constrain it by the fields that are *not* updated ("p" above).
---
--- Note that because MkT3 doesn't contain all the fields being updated,
--- its RHS is simply an error, so it doesn't impose any type constraints
---
--- All this is done in STEP 4 below.
---
--- Note about GADTs
--- ~~~~~~~~~~~~~~~~
--- For record update we require that every constructor involved in the
--- update (i.e. that has all the specified fields) is "vanilla".  I
--- don't know how to do the update otherwise.
-
-
-tcExpr expr@(RecordUpd record_expr rbinds _ _) res_ty
-  = 	-- STEP 0
-	-- Check that the field names are really field names
-    ASSERT( notNull rbinds )
-    let 
-	field_names = map fst rbinds
-    in
-    mappM (tcLookupGlobalId.unLoc) field_names	`thenM` \ sel_ids ->
-	-- The renamer has already checked that they
-	-- are all in scope
-    let
-	bad_guys = [ setSrcSpan loc $ addErrTc (notSelector field_name) 
-		   | (L loc field_name, sel_id) <- field_names `zip` sel_ids,
-		     not (isRecordSelector sel_id) 	-- Excludes class ops
-		   ]
-    in
-    checkM (null bad_guys) (sequenceM bad_guys `thenM_` failM)	`thenM_`
-    
-	-- STEP 1
-	-- Figure out the tycon and data cons from the first field name
-    let
-		-- It's OK to use the non-tc splitters here (for a selector)
-	upd_field_lbls  = recBindFields rbinds
-	sel_id : _   	= sel_ids
-	(tycon, _)   	= recordSelectorFieldLabel sel_id	-- We've failed already if
-	data_cons    	= tyConDataCons tycon		-- it's not a field label
-	relevant_cons   = filter is_relevant data_cons
-	is_relevant con = all (`elem` dataConFieldLabels con) upd_field_lbls
-    in
-
-	-- STEP 2
-	-- Check that at least one constructor has all the named fields
-	-- i.e. has an empty set of bad fields returned by badFields
-    checkTc (not (null relevant_cons))
-	    (badFieldsUpd rbinds)	`thenM_`
-
-	-- Check that all relevant data cons are vanilla.  Doing record updates on 
-	-- GADTs and/or existentials is more than my tiny brain can cope with today
-    checkTc (all isVanillaDataCon relevant_cons)
-	    (nonVanillaUpd tycon)	`thenM_`
-
-	-- STEP 4
-	-- Use the un-updated fields to find a vector of booleans saying
-	-- which type arguments must be the same in updatee and result.
-	--
-	-- WARNING: this code assumes that all data_cons in a common tycon
-	-- have FieldLabels abstracted over the same tyvars.
-    let
-		-- A constructor is only relevant to this process if
-		-- it contains *all* the fields that are being updated
-	con1 		= head relevant_cons	-- A representative constructor
-	con1_tyvars 	= dataConTyVars con1
-	con1_flds       = dataConFieldLabels con1
-	con1_arg_tys    = dataConOrigArgTys con1
-	common_tyvars   = exactTyVarsOfTypes [ty | (fld,ty) <- con1_flds `zip` con1_arg_tys
-					 	 , not (fld `elem` upd_field_lbls) ]
-
- 	is_common_tv tv = tv `elemVarSet` common_tyvars
-
-	mk_inst_ty tv result_inst_ty 
-	  | is_common_tv tv = returnM result_inst_ty		-- Same as result type
-	  | otherwise	    = newFlexiTyVarTy (tyVarKind tv)	-- Fresh type, of correct kind
-    in
-    tcInstTyVars con1_tyvars				`thenM` \ (_, result_inst_tys, inst_env) ->
-    zipWithM mk_inst_ty con1_tyvars result_inst_tys	`thenM` \ inst_tys ->
-
-	-- STEP 3
-	-- Typecheck the update bindings.
-	-- (Do this after checking for bad fields in case there's a field that
-	--  doesn't match the constructor.)
-    let
-	result_record_ty = mkTyConApp tycon result_inst_tys
-	con1_arg_tys'    = map (substTy inst_env) con1_arg_tys
-    in
-    tcSubExp result_record_ty res_ty		`thenM` \ co_fn ->
-    tcRecordBinds con1 con1_arg_tys' rbinds	`thenM` \ rbinds' ->
-
-	-- STEP 5
-	-- Typecheck the expression to be updated
-    let
-	record_ty = ASSERT( length inst_tys == tyConArity tycon )
-		    mkTyConApp tycon inst_tys
-	-- This is one place where the isVanilla check is important
-	-- So that inst_tys matches the tycon
-    in
-    tcMonoExpr record_expr record_ty		`thenM` \ record_expr' ->
-
-	-- STEP 6
-	-- Figure out the LIE we need.  We have to generate some 
-	-- dictionaries for the data type context, since we are going to
-	-- do pattern matching over the data cons.
-	--
-	-- What dictionaries do we need?  
-	-- We just take the context of the first data constructor
-	-- This isn't right, but I just can't bear to union up all the relevant ones
-    let
-	theta' = substTheta inst_env (tyConStupidTheta tycon)
-    in
-    newDicts RecordUpdOrigin theta'	`thenM` \ dicts ->
-    extendLIEs dicts			`thenM_`
-
-	-- Phew!
-    returnM (mkHsCoerce co_fn (RecordUpd record_expr' rbinds' record_ty result_record_ty))
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Arithmetic sequences			e.g. [a,b..]
-	and their parallel-array counterparts	e.g. [: a,b.. :]
-		
-%*									*
-%************************************************************************
-
-\begin{code}
-tcExpr (ArithSeq _ seq@(From expr)) res_ty
-  = do	{ elt_ty <- boxySplitListTy res_ty
-	; expr' <- tcPolyExpr expr elt_ty
-	; enum_from <- newMethodFromName (ArithSeqOrigin seq) 
-			      elt_ty enumFromName
-	; return (ArithSeq (HsVar enum_from) (From expr')) }
-
-tcExpr in_expr@(ArithSeq _ seq@(FromThen expr1 expr2)) res_ty
-  = do	{ elt_ty <- boxySplitListTy res_ty
-	; expr1' <- tcPolyExpr expr1 elt_ty
-	; expr2' <- tcPolyExpr expr2 elt_ty
-	; enum_from_then <- newMethodFromName (ArithSeqOrigin seq) 
-			      elt_ty enumFromThenName
-	; return (ArithSeq (HsVar enum_from_then) (FromThen expr1' expr2')) }
-
-
-tcExpr in_expr@(ArithSeq _ seq@(FromTo expr1 expr2)) res_ty
-  = do	{ elt_ty <- boxySplitListTy res_ty
-	; expr1' <- tcPolyExpr expr1 elt_ty
-	; expr2' <- tcPolyExpr expr2 elt_ty
-	; enum_from_to <- newMethodFromName (ArithSeqOrigin seq) 
-		  	      elt_ty enumFromToName
-	; return (ArithSeq (HsVar enum_from_to) (FromTo expr1' expr2')) }
-
-tcExpr in_expr@(ArithSeq _ seq@(FromThenTo expr1 expr2 expr3)) res_ty
-  = do	{ elt_ty <- boxySplitListTy res_ty
-	; expr1' <- tcPolyExpr expr1 elt_ty
-	; expr2' <- tcPolyExpr expr2 elt_ty
-	; expr3' <- tcPolyExpr expr3 elt_ty
-	; eft <- newMethodFromName (ArithSeqOrigin seq) 
-		      elt_ty enumFromThenToName
-	; return (ArithSeq (HsVar eft) (FromThenTo expr1' expr2' expr3')) }
-
-tcExpr in_expr@(PArrSeq _ seq@(FromTo expr1 expr2)) res_ty
-  = do	{ [elt_ty] <- boxySplitTyConApp parrTyCon res_ty
-	; expr1' <- tcPolyExpr expr1 elt_ty
-	; expr2' <- tcPolyExpr expr2 elt_ty
-	; enum_from_to <- newMethodFromName (PArrSeqOrigin seq) 
-				      elt_ty enumFromToPName
-	; return (PArrSeq (HsVar enum_from_to) (FromTo expr1' expr2')) }
-
-tcExpr in_expr@(PArrSeq _ seq@(FromThenTo expr1 expr2 expr3)) res_ty
-  = do	{ [elt_ty] <- boxySplitTyConApp parrTyCon res_ty
-	; expr1' <- tcPolyExpr expr1 elt_ty
-	; expr2' <- tcPolyExpr expr2 elt_ty
-	; expr3' <- tcPolyExpr expr3 elt_ty
-	; eft <- newMethodFromName (PArrSeqOrigin seq)
-		      elt_ty enumFromThenToPName
-	; return (PArrSeq (HsVar eft) (FromThenTo expr1' expr2' expr3')) }
-
-tcExpr (PArrSeq _ _) _ 
-  = panic "TcExpr.tcMonoExpr: Infinite parallel array!"
-    -- the parser shouldn't have generated it and the renamer shouldn't have
-    -- let it through
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Template Haskell
-%*									*
-%************************************************************************
-
-\begin{code}
-#ifdef GHCI	/* Only if bootstrapped */
-	-- Rename excludes these cases otherwise
-tcExpr (HsSpliceE splice) res_ty = tcSpliceExpr splice res_ty
-tcExpr (HsBracket brack)  res_ty = do	{ e <- tcBracket brack res_ty
-					; return (unLoc e) }
-#endif /* GHCI */
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Catch-all
-%*									*
-%************************************************************************
-
-\begin{code}
-tcExpr other _ = pprPanic "tcMonoExpr" (ppr other)
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Applications
-%*									*
-%************************************************************************
-
-\begin{code}
----------------------------
-tcApp :: HsExpr Name				-- Function
-      -> Arity					-- Number of args reqd
-      -> ([BoxySigmaType] -> TcM arg_results)	-- Argument type-checker
-      -> BoxyRhoType				-- Result type
-      -> TcM (HsExpr TcId, arg_results)		
-
--- (tcFun fun n_args arg_checker res_ty)
--- The argument type checker, arg_checker, will be passed exactly n_args types
-
-tcApp (HsVar fun_name) n_args arg_checker res_ty
-  = tcIdApp fun_name n_args arg_checker res_ty
-
-tcApp fun n_args arg_checker res_ty	-- The vanilla case (rula APP)
-  = do	{ arg_boxes <- newBoxyTyVars (replicate n_args argTypeKind)
-	; fun'      <- tcExpr fun (mkFunTys (mkTyVarTys arg_boxes) res_ty)
-	; arg_tys'  <- mapM readFilledBox arg_boxes
-	; args'     <- arg_checker arg_tys'
-	; return (fun', args') }
-
----------------------------
-tcIdApp :: Name					-- Function
-        -> Arity				-- Number of args reqd
-        -> ([BoxySigmaType] -> TcM arg_results)	-- Argument type-checker
-		-- The arg-checker guarantees to fill all boxes in the arg types
-        -> BoxyRhoType				-- Result type
-        -> TcM (HsExpr TcId, arg_results)		
-
--- Call 	(f e1 ... en) :: res_ty
--- Type		f :: forall a b c. theta => fa_1 -> ... -> fa_k -> fres
--- 			(where k <= n; fres has the rest)
--- NB:	if k < n then the function doesn't have enough args, and
---	presumably fres is a type variable that we are going to 
---	instantiate with a function type
---
--- Then		fres <= bx_(k+1) -> ... -> bx_n -> res_ty
-
-tcIdApp fun_name n_args arg_checker res_ty
-  = do	{ fun_id <- lookupFun (OccurrenceOf fun_name) fun_name
-
-	-- Split up the function type
-	; let (tv_theta_prs, rho) = tcMultiSplitSigmaTy (idType fun_id)
-	      (fun_arg_tys, fun_res_ty) = tcSplitFunTysN rho n_args
-
-	      qtvs = concatMap fst tv_theta_prs		-- Quantified tyvars
-	      arg_qtvs = exactTyVarsOfTypes fun_arg_tys
-	      res_qtvs = exactTyVarsOfType fun_res_ty
-		-- NB: exactTyVarsOfType.  See Note [Silly type synonyms in smart-app]
-	      tau_qtvs = arg_qtvs `unionVarSet` res_qtvs
-	      k  	     = length fun_arg_tys	-- k <= n_args
-	      n_missing_args = n_args - k		-- Always >= 0
-
-	-- Match the result type of the function with the
-	-- result type of the context, to get an inital substitution
-	; extra_arg_boxes <- newBoxyTyVars (replicate n_missing_args argTypeKind)
-	; let extra_arg_tys' = mkTyVarTys extra_arg_boxes
-	      res_ty' 	     = mkFunTys extra_arg_tys' res_ty
-	      subst   	     = boxySubMatchType arg_qtvs fun_res_ty res_ty'
-				-- Only bind arg_qtvs, since only they will be
-				-- *definitely* be filled in by arg_checker
-				-- E.g.  error :: forall a. String -> a
-				--	 (error "foo") :: bx5
-				--  Don't make subst [a |-> bx5]
-				--  because then the result subsumption becomes
-				--	 	bx5 ~ bx5
-				--  and the unifer doesn't expect the 
-				--  same box on both sides
-	      inst_qtv tv | Just boxy_ty <- lookupTyVar subst tv = return boxy_ty
-			  | tv `elemVarSet` tau_qtvs = do { tv' <- tcInstBoxyTyVar tv
-					    	          ; return (mkTyVarTy tv') }
-			  | otherwise		     = do { tv' <- tcInstTyVar tv
-					    	          ; return (mkTyVarTy tv') }
-			-- The 'otherwise' case handles type variables that are
-			-- mentioned only in the constraints, not in argument or 
-			-- result types.  We'll make them tau-types
-
-	; qtys' <- mapM inst_qtv qtvs
-	; let arg_subst    = zipOpenTvSubst qtvs qtys'
-	      fun_arg_tys' = substTys arg_subst fun_arg_tys
-
-	-- Typecheck the arguments!
-	-- Doing so will fill arg_qtvs and extra_arg_tys'
-	; args' <- arg_checker (fun_arg_tys' ++ extra_arg_tys')
-
-	; let strip qtv qty' | qtv `elemVarSet` arg_qtvs = stripBoxyType qty'
-			     | otherwise   		 = return qty'
-	; qtys'' <- zipWithM strip qtvs qtys'
-	; extra_arg_tys'' <- mapM readFilledBox extra_arg_boxes
-
-	-- Result subsumption
-	; let res_subst = zipOpenTvSubst qtvs qtys''
-	      fun_res_ty'' = substTy res_subst fun_res_ty
-	      res_ty'' = mkFunTys extra_arg_tys'' res_ty
-	; co_fn <- tcFunResTy fun_name fun_res_ty'' res_ty''
-			    
-	-- And pack up the results
-	-- By applying the coercion just to the *function* we can make
-	-- tcFun work nicely for OpApp and Sections too
-	; fun' <- instFun fun_id qtvs qtys'' tv_theta_prs
-	; co_fn' <- wrapFunResCoercion fun_arg_tys' co_fn
-	; return (mkHsCoerce co_fn' fun', args') }
-\end{code}
-
-Note [Silly type synonyms in smart-app]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-When we call sripBoxyType, all of the boxes should be filled
-in.  But we need to be careful about type synonyms:
-	type T a = Int
-	f :: T a -> Int
-	...(f x)...
-In the call (f x) we'll typecheck x, expecting it to have type
-(T box).  Usually that would fill in the box, but in this case not;
-because 'a' is discarded by the silly type synonym T.  So we must
-use exactTyVarsOfType to figure out which type variables are free 
-in the argument type.
-
-\begin{code}
--- tcId is a specialisation of tcIdApp when there are no arguments
--- tcId f ty = do { (res, _) <- tcIdApp f [] (\[] -> return ()) ty
---		  ; return res }
-
-tcId :: InstOrigin
-     -> Name					-- Function
-     -> BoxyRhoType				-- Result type
-     -> TcM (HsExpr TcId)
-tcId orig fun_name res_ty
-  = do	{ traceTc (text "tcId" <+> ppr fun_name <+> ppr res_ty)
-	; fun_id <- lookupFun orig fun_name
-
-	-- Split up the function type
-	; let (tv_theta_prs, fun_tau) = tcMultiSplitSigmaTy (idType fun_id)
-	      qtvs     = concatMap fst tv_theta_prs	-- Quantified tyvars
-	      tau_qtvs = exactTyVarsOfType fun_tau	-- Mentiond in the tau part
-	      inst_qtv tv | tv `elemVarSet` tau_qtvs = do { tv' <- tcInstBoxyTyVar tv
-					      		  ; return (mkTyVarTy tv') }
-			  | otherwise	  	     = do { tv' <- tcInstTyVar tv
-					                  ; return (mkTyVarTy tv') }
-
-	-- Do the subsumption check wrt the result type
-	; qtv_tys <- mapM inst_qtv qtvs
-	; let res_subst   = zipTopTvSubst qtvs qtv_tys
-	      fun_tau' = substTy res_subst fun_tau
-
-	; co_fn <- tcFunResTy fun_name fun_tau' res_ty
-
-	-- And pack up the results
-	; fun' <- instFun fun_id qtvs qtv_tys tv_theta_prs 
-	; return (mkHsCoerce co_fn fun') }
-
--- 	Note [Push result type in]
---
--- Unify with expected result before (was: after) type-checking the args
--- so that the info from res_ty (was: args) percolates to args (was actual_res_ty).
--- This is when we might detect a too-few args situation.
--- (One can think of cases when the opposite order would give
--- a better error message.)
--- [March 2003: I'm experimenting with putting this first.  Here's an 
---		example where it actually makes a real difference
---    class C t a b | t a -> b
---    instance C Char a Bool
---
---    data P t a = forall b. (C t a b) => MkP b
---    data Q t   = MkQ (forall a. P t a)
-
---    f1, f2 :: Q Char;
---    f1 = MkQ (MkP True)
---    f2 = MkQ (MkP True :: forall a. P Char a)
---
--- With the change, f1 will type-check, because the 'Char' info from
--- the signature is propagated into MkQ's argument. With the check
--- in the other order, the extra signature in f2 is reqd.]
-
----------------------------
-tcSyntaxOp :: InstOrigin -> HsExpr Name -> TcType -> TcM (HsExpr TcId)
--- Typecheck a syntax operator, checking that it has the specified type
--- The operator is always a variable at this stage (i.e. renamer output)
-tcSyntaxOp orig (HsVar op) ty = tcId orig op ty
-tcSyntaxOp orig other 	   ty = pprPanic "tcSyntaxOp" (ppr other)
-
----------------------------
-instFun :: TcId
-	-> [TyVar] -> [TcType] 	-- Quantified type variables and 
-				-- their instantiating types
-	-> [([TyVar], ThetaType)] 	-- Stuff to instantiate
-	-> TcM (HsExpr TcId)	
-instFun fun_id qtvs qtv_tys []
-  = return (HsVar fun_id)	-- Common short cut
-
-instFun fun_id qtvs qtv_tys tv_theta_prs
-  = do 	{ let subst = zipOpenTvSubst qtvs qtv_tys
-	      ty_theta_prs' = map subst_pr tv_theta_prs
-	      subst_pr (tvs, theta) = (map (substTyVar subst) tvs, 
-				       substTheta subst theta)
-
-		-- The ty_theta_prs' is always non-empty
-	      ((tys1',theta1') : further_prs') = ty_theta_prs'
-		
-  		-- First, chuck in the constraints from 
-		-- the "stupid theta" of a data constructor (sigh)
-	; case isDataConId_maybe fun_id of
-		Just con -> tcInstStupidTheta con tys1'
-		Nothing  -> return ()
-
-	; if want_method_inst theta1'
-	  then do { meth_id <- newMethodWithGivenTy orig fun_id tys1'
-			-- See Note [Multiple instantiation]
-		  ; go (HsVar meth_id) further_prs' }
-	  else go (HsVar fun_id) ty_theta_prs'
-	}
-  where
-    orig = OccurrenceOf (idName fun_id)
-
-    go fun [] = return fun
-
-    go fun ((tys, theta) : prs)
-	= do { dicts <- newDicts orig theta
-	     ; extendLIEs dicts
-	     ; let the_app = unLoc $ mkHsDictApp (mkHsTyApp (noLoc fun) tys)
-						 (map instToId dicts)
-	     ; go the_app prs }
-
-	-- 	Hack Alert (want_method_inst)!
-	-- See Note [No method sharing]
-	-- If 	f :: (%x :: T) => Int -> Int
-	-- Then if we have two separate calls, (f 3, f 4), we cannot
-	-- make a method constraint that then gets shared, thus:
-	--	let m = f %x in (m 3, m 4)
-	-- because that loses the linearity of the constraint.
-	-- The simplest thing to do is never to construct a method constraint
-	-- in the first place that has a linear implicit parameter in it.
-    want_method_inst theta =  not (null theta)			-- Overloaded
-			   && not (any isLinearPred theta)	-- Not linear
-		   	   && not opt_NoMethodSharing
-		-- See Note [No method sharing] below
-\end{code}
-
-Note [Multiple instantiation]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We are careful never to make a MethodInst that has, as its meth_id, another MethodInst.
-For example, consider
-	f :: forall a. Eq a => forall b. Ord b => a -> b
-At a call to f, at say [Int, Bool], it's tempting to translate the call to 
-
-	f_m1
-  where
-	f_m1 :: forall b. Ord b => Int -> b
-	f_m1 = f Int dEqInt
-
-	f_m2 :: Int -> Bool
-	f_m2 = f_m1 Bool dOrdBool
-
-But notice that f_m2 has f_m1 as its meth_id.  Now the danger is that if we do
-a tcSimplCheck with a Given f_mx :: f Int dEqInt, we may make a binding
-	f_m1 = f_mx
-But it's entirely possible that f_m2 will continue to float out, because it
-mentions no type variables.  Result, f_m1 isn't in scope.
-
-Here's a concrete example that does this (test tc200):
-
-    class C a where
-      f :: Eq b => b -> a -> Int
-      baz :: Eq a => Int -> a -> Int
-
-    instance C Int where
-      baz = f
-
-Current solution: only do the "method sharing" thing for the first type/dict
-application, not for the iterated ones.  A horribly subtle point.
-
-Note [No method sharing]
-~~~~~~~~~~~~~~~~~~~~~~~~
-The -fno-method-sharing flag controls what happens so far as the LIE
-is concerned.  The default case is that for an overloaded function we 
-generate a "method" Id, and add the Method Inst to the LIE.  So you get
-something like
-	f :: Num a => a -> a
-	f = /\a (d:Num a) -> let m = (+) a d in \ (x:a) -> m x x
-If you specify -fno-method-sharing, the dictionary application 
-isn't shared, so we get
-	f :: Num a => a -> a
-	f = /\a (d:Num a) (x:a) -> (+) a d x x
-This gets a bit less sharing, but
-	a) it's better for RULEs involving overloaded functions
-	b) perhaps fewer separated lambdas
-
-\begin{code}
-tcArgs :: LHsExpr Name				-- The function (for error messages)
-       -> [LHsExpr Name] -> [TcSigmaType]	-- Actual arguments and expected arg types
-       -> TcM [LHsExpr TcId]			-- Resulting args
-
-tcArgs fun args expected_arg_tys
-  = mapM (tcArg fun) (zip3 args expected_arg_tys [1..])
-
-tcArg :: LHsExpr Name				-- The function (for error messages)
-       -> (LHsExpr Name, BoxySigmaType, Int)	-- Actual argument and expected arg type
-       -> TcM (LHsExpr TcId)			-- Resulting argument
-tcArg fun (arg, ty, arg_no) = addErrCtxt (funAppCtxt fun arg arg_no) $
-			      tcPolyExprNC arg ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{@tcId@ typchecks an identifier occurrence}
-%*									*
-%************************************************************************
-
-\begin{code}
-lookupFun :: InstOrigin -> Name -> TcM TcId
-lookupFun orig id_name
-  = do 	{ thing <- tcLookup id_name
-	; case thing of
-    	    AGlobal (ADataCon con) -> return (dataConWrapId con)
-
-    	    AGlobal (AnId id) 
-	    	| isNaughtyRecordSelector id -> failWithTc (naughtyRecordSel id)
-	    	| otherwise		     -> return id
-	    	-- A global cannot possibly be ill-staged
-	    	-- nor does it need the 'lifting' treatment
-
-#ifndef GHCI
-    	    ATcId id th_level _ -> return id			-- Non-TH case
-#else
-	    ATcId id th_level _ -> do { use_stage <- getStage	-- TH case
-				      ; thLocalId orig id_name id th_level use_stage }
-#endif
-
-    	    other -> failWithTc (ppr other <+> ptext SLIT("used where a value identifer was expected"))
-    }
-
-#ifdef GHCI  /* GHCI and TH is on */
---------------------------------------
--- thLocalId : Check for cross-stage lifting
-thLocalId orig id_name id th_bind_lvl (Brack use_lvl ps_var lie_var)
-  | use_lvl > th_bind_lvl
-  = thBrackId orig id_name id ps_var lie_var
-thLocalId orig id_name id th_bind_lvl use_stage
-  = do	{ checkWellStaged (quotes (ppr id)) th_bind_lvl use_stage
-	; return id }
-
---------------------------------------
-thBrackId orig id_name id ps_var lie_var
-  | isExternalName id_name
-  =	-- Top-level identifiers in this module,
-	-- (which have External Names)
-	-- are just like the imported case:
-	-- no need for the 'lifting' treatment
-	-- E.g.  this is fine:
-	--   f x = x
-	--   g y = [| f 3 |]
-	-- But we do need to put f into the keep-alive
-	-- set, because after desugaring the code will
-	-- only mention f's *name*, not f itself.
-    do	{ keepAliveTc id_name; return id }
-
-  | otherwise
-  = 	-- Nested identifiers, such as 'x' in
-	-- E.g. \x -> [| h x |]
-	-- We must behave as if the reference to x was
-	--	h $(lift x)	
-	-- We use 'x' itself as the splice proxy, used by 
-	-- the desugarer to stitch it all back together.
-	-- If 'x' occurs many times we may get many identical
-	-- bindings of the same splice proxy, but that doesn't
-	-- matter, although it's a mite untidy.
-    do 	{ let id_ty = idType id
-	; checkTc (isTauTy id_ty) (polySpliceErr id)
-	       -- If x is polymorphic, its occurrence sites might
-	       -- have different instantiations, so we can't use plain
-	       -- 'x' as the splice proxy name.  I don't know how to 
-	       -- solve this, and it's probably unimportant, so I'm
-	       -- just going to flag an error for now
-   
-	; id_ty' <- zapToMonotype id_ty
-		-- The id_ty might have an OpenTypeKind, but we
-		-- can't instantiate the Lift class at that kind,
-		-- so we zap it to a LiftedTypeKind monotype
-		-- C.f. the call in TcPat.newLitInst
-
-	; setLIEVar lie_var	$ do
-	{ lift <- newMethodFromName orig id_ty' DsMeta.liftName
-		   -- Put the 'lift' constraint into the right LIE
-	   
-		   -- Update the pending splices
-	; ps <- readMutVar ps_var
-	; writeMutVar ps_var ((id_name, nlHsApp (nlHsVar lift) (nlHsVar id)) : ps)
-
-	; return id } }
-#endif /* GHCI */
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Record bindings}
-%*									*
-%************************************************************************
-
-Game plan for record bindings
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-1. Find the TyCon for the bindings, from the first field label.
-
-2. Instantiate its tyvars and unify (T a1 .. an) with expected_ty.
-
-For each binding field = value
-
-3. Instantiate the field type (from the field label) using the type
-   envt from step 2.
-
-4  Type check the value using tcArg, passing the field type as 
-   the expected argument type.
-
-This extends OK when the field types are universally quantified.
-
-	
-\begin{code}
-tcRecordBinds
-	:: DataCon
-	-> [TcType]	-- Expected type for each field
-	-> HsRecordBinds Name
-	-> TcM (HsRecordBinds TcId)
-
-tcRecordBinds data_con arg_tys rbinds
-  = do	{ mb_binds <- mappM do_bind rbinds
-	; return (catMaybes mb_binds) }
-  where
-    flds_w_tys = zipEqual "tcRecordBinds" (dataConFieldLabels data_con) arg_tys
-    do_bind (L loc field_lbl, rhs)
-      | Just field_ty <- assocMaybe flds_w_tys field_lbl
-      = addErrCtxt (fieldCtxt field_lbl)	$
-	do { rhs'   <- tcPolyExprNC rhs field_ty
-	   ; sel_id <- tcLookupId field_lbl
-	   ; ASSERT( isRecordSelector sel_id )
-	     return (Just (L loc sel_id, rhs')) }
-      | otherwise
-      = do { addErrTc (badFieldCon data_con field_lbl)
-	   ; return Nothing }
-
-checkMissingFields :: DataCon -> HsRecordBinds Name -> TcM ()
-checkMissingFields data_con rbinds
-  | null field_labels 	-- Not declared as a record;
-			-- But C{} is still valid if no strict fields
-  = if any isMarkedStrict field_strs then
-	-- Illegal if any arg is strict
-	addErrTc (missingStrictFields data_con [])
-    else
-	returnM ()
-			
-  | otherwise		-- A record
-  = checkM (null missing_s_fields)
-	   (addErrTc (missingStrictFields data_con missing_s_fields))	`thenM_`
-
-    doptM Opt_WarnMissingFields		`thenM` \ warn ->
-    checkM (not (warn && notNull missing_ns_fields))
-	   (warnTc True (missingFields data_con missing_ns_fields))
-
-  where
-    missing_s_fields
-	= [ fl | (fl, str) <- field_info,
-	  	 isMarkedStrict str,
-	  	 not (fl `elem` field_names_used)
-	  ]
-    missing_ns_fields
-	= [ fl | (fl, str) <- field_info,
-	  	 not (isMarkedStrict str),
-	  	 not (fl `elem` field_names_used)
-	  ]
-
-    field_names_used = recBindFields rbinds
-    field_labels     = dataConFieldLabels data_con
-
-    field_info = zipEqual "missingFields"
-			  field_labels
-	  		  field_strs
-
-    field_strs = dataConStrictMarks data_con
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Errors and contexts}
-%*									*
-%************************************************************************
-
-Boring and alphabetical:
-\begin{code}
-caseScrutCtxt expr
-  = hang (ptext SLIT("In the scrutinee of a case expression:")) 4 (ppr expr)
-
-exprCtxt expr
-  = hang (ptext SLIT("In the expression:")) 4 (ppr expr)
-
-fieldCtxt field_name
-  = ptext SLIT("In the") <+> quotes (ppr field_name) <+> ptext SLIT("field of a record")
-
-funAppCtxt fun arg arg_no
-  = hang (hsep [ ptext SLIT("In the"), speakNth arg_no, ptext SLIT("argument of"), 
-		    quotes (ppr fun) <> text ", namely"])
-	 4 (quotes (ppr arg))
-
-predCtxt expr
-  = hang (ptext SLIT("In the predicate expression:")) 4 (ppr expr)
-
-nonVanillaUpd tycon
-  = vcat [ptext SLIT("Record update for the non-Haskell-98 data type") <+> quotes (ppr tycon)
-		<+> ptext SLIT("is not (yet) supported"),
-	  ptext SLIT("Use pattern-matching instead")]
-badFieldsUpd rbinds
-  = hang (ptext SLIT("No constructor has all these fields:"))
-	 4 (pprQuotedList (recBindFields rbinds))
-
-naughtyRecordSel sel_id
-  = ptext SLIT("Cannot use record selector") <+> quotes (ppr sel_id) <+> 
-    ptext SLIT("as a function due to escaped type variables") $$ 
-    ptext SLIT("Probably fix: use pattern-matching syntax instead")
-
-notSelector field
-  = hsep [quotes (ppr field), ptext SLIT("is not a record selector")]
-
-missingStrictFields :: DataCon -> [FieldLabel] -> SDoc
-missingStrictFields con fields
-  = header <> rest
-  where
-    rest | null fields = empty	-- Happens for non-record constructors 
-				-- with strict fields
-	 | otherwise   = colon <+> pprWithCommas ppr fields
-
-    header = ptext SLIT("Constructor") <+> quotes (ppr con) <+> 
-	     ptext SLIT("does not have the required strict field(s)") 
-	  
-missingFields :: DataCon -> [FieldLabel] -> SDoc
-missingFields con fields
-  = ptext SLIT("Fields of") <+> quotes (ppr con) <+> ptext SLIT("not initialised:") 
-	<+> pprWithCommas ppr fields
-
-callCtxt fun args
-  = ptext SLIT("In the call") <+> parens (ppr (foldl mkHsApp fun args))
-
-#ifdef GHCI
-polySpliceErr :: Id -> SDoc
-polySpliceErr id
-  = ptext SLIT("Can't splice the polymorphic local variable") <+> quotes (ppr id)
-#endif
-\end{code}
diff --git a/ghc/compiler/typecheck/TcExpr.lhs-boot b/ghc/compiler/typecheck/TcExpr.lhs-boot
deleted file mode 100644
index 1c4240dcc0..0000000000
--- a/ghc/compiler/typecheck/TcExpr.lhs-boot
+++ /dev/null
@@ -1,28 +0,0 @@
-\begin{code}
-module TcExpr where
-import HsSyn	( HsExpr, LHsExpr )
-import Name	( Name )
-import Var	( Id )
-import TcType	( TcType, BoxySigmaType, BoxyRhoType )
-import TcRnTypes( TcM, InstOrigin )
-
-tcPolyExpr :: 
-	  LHsExpr Name
-       -> BoxySigmaType
-       -> TcM (LHsExpr Id)
-
-tcMonoExpr :: 
-  	  LHsExpr Name
-       -> BoxyRhoType
-       -> TcM (LHsExpr Id)
-
-tcInferRho :: 
-  	  LHsExpr Name
-       -> TcM (LHsExpr Id, TcType)
-
-tcSyntaxOp :: 
-	  InstOrigin
-       -> HsExpr Name
-       -> TcType
-       -> TcM (HsExpr Id)
-\end{code}
diff --git a/ghc/compiler/typecheck/TcForeign.lhs b/ghc/compiler/typecheck/TcForeign.lhs
deleted file mode 100644
index 4be039bd93..0000000000
--- a/ghc/compiler/typecheck/TcForeign.lhs
+++ /dev/null
@@ -1,367 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1998
-%
-\section[TcForeign]{Typechecking \tr{foreign} declarations}
-
-A foreign declaration is used to either give an externally
-implemented function a Haskell type (and calling interface) or
-give a Haskell function an external calling interface. Either way,
-the range of argument and result types these functions can accommodate
-is restricted to what the outside world understands (read C), and this
-module checks to see if a foreign declaration has got a legal type.
-
-\begin{code}
-module TcForeign 
-	( 
-	  tcForeignImports
-        , tcForeignExports
-	) where
-
-#include "HsVersions.h"
-
-import HsSyn
-
-import TcRnMonad
-import TcHsType		( tcHsSigType, UserTypeCtxt(..) )
-import TcExpr		( tcPolyExpr )			
-
-import ForeignCall	( CCallConv(..) )
-import ErrUtils		( Message )
-import Id		( Id, mkLocalId, mkExportedLocalId )
-#if alpha_TARGET_ARCH
-import Type		( typePrimRep )
-import SMRep		( argMachRep, primRepToCgRep, primRepHint )
-#endif
-import OccName		( mkForeignExportOcc )
-import Name		( Name, NamedThing(..), mkExternalName )
-import TcType		( Type, tcSplitFunTys, tcSplitTyConApp_maybe,
-			  tcSplitForAllTys, 
-			  isFFIArgumentTy, isFFIImportResultTy, 
-			  isFFIExportResultTy, isFFILabelTy,
-			  isFFIExternalTy, isFFIDynArgumentTy,
-			  isFFIDynResultTy, isFFIDotnetTy, isFFIDotnetObjTy,
-			  toDNType
-			)
-import ForeignCall	( CExportSpec(..), CCallTarget(..), 
-			  CLabelString, isCLabelString,
-			  isDynamicTarget, withDNTypes, DNKind(..), DNCallSpec(..) ) 
-import PrelNames	( hasKey, ioTyConKey )
-import DynFlags		( DynFlags(..), HscTarget(..) )
-import Outputable
-import SrcLoc		( Located(..), srcSpanStart )
-import Bag		( consBag )
-
-#if alpha_TARGET_ARCH
-import MachOp		( machRepByteWidth, MachHint(FloatHint) )
-#endif
-\end{code}
-
-\begin{code}
--- Defines a binding
-isForeignImport :: LForeignDecl name -> Bool
-isForeignImport (L _ (ForeignImport _ _ _ _)) = True
-isForeignImport _			      = False
-
--- Exports a binding
-isForeignExport :: LForeignDecl name -> Bool
-isForeignExport (L _ (ForeignExport _ _ _ _)) = True
-isForeignExport _	  	              = False
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Imports}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcForeignImports :: [LForeignDecl Name] -> TcM ([Id], [LForeignDecl Id])
-tcForeignImports decls
-  = mapAndUnzipM (wrapLocSndM tcFImport) (filter isForeignImport decls)
-
-tcFImport :: ForeignDecl Name -> TcM (Id, ForeignDecl Id)
-tcFImport fo@(ForeignImport (L loc nm) hs_ty imp_decl isDeprec)
- = addErrCtxt (foreignDeclCtxt fo)	$
-   tcHsSigType (ForSigCtxt nm) hs_ty	`thenM`	\ sig_ty ->
-   let 
-      -- drop the foralls before inspecting the structure
-      -- of the foreign type.
-	(_, t_ty)	  = tcSplitForAllTys sig_ty
-	(arg_tys, res_ty) = tcSplitFunTys t_ty
-	id		  = mkLocalId nm sig_ty
- 		-- Use a LocalId to obey the invariant that locally-defined 
-		-- things are LocalIds.  However, it does not need zonking,
-		-- (so TcHsSyn.zonkForeignExports ignores it).
-   in
-   tcCheckFIType sig_ty arg_tys res_ty imp_decl		`thenM` \ imp_decl' -> 
-   -- can't use sig_ty here because it :: Type and we need HsType Id
-   -- hence the undefined
-   returnM (id, ForeignImport (L loc id) undefined imp_decl' isDeprec)
-\end{code}
-
-
------------- Checking types for foreign import ----------------------
-\begin{code}
-tcCheckFIType _ arg_tys res_ty (DNImport spec)
-  = checkCg checkDotnet  `thenM_`
-    getDOpts		 `thenM`  \ dflags ->
-    checkForeignArgs (isFFIDotnetTy dflags) arg_tys	`thenM_`
-    checkForeignRes True{-non IO ok-} (isFFIDotnetTy dflags) res_ty `thenM_`
-    let (DNCallSpec isStatic kind _ _ _ _) = spec in
-    (case kind of
-       DNMethod | not isStatic ->
-         case arg_tys of
-	   [] -> addErrTc illegalDNMethodSig
-	   _  
-	    | not (isFFIDotnetObjTy (last arg_tys)) -> addErrTc illegalDNMethodSig
-	    | otherwise -> returnM ()
-       _ -> returnM ()) `thenM_`
-    returnM (DNImport (withDNTypes spec (map toDNType arg_tys) (toDNType res_ty)))
-
-tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport _ _ _ _ (CLabel _))
-  = checkCg checkCOrAsm		`thenM_`
-    check (isFFILabelTy sig_ty) (illegalForeignTyErr empty sig_ty) `thenM_`
-    return idecl
-
-tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv _ _ _ CWrapper)
-  = 	-- Foreign wrapper (former f.e.d.)
-   	-- The type must be of the form ft -> IO (FunPtr ft), where ft is a
-   	-- valid foreign type.  For legacy reasons ft -> IO (Ptr ft) as well
-   	-- as ft -> IO Addr is accepted, too.  The use of the latter two forms
-   	-- is DEPRECATED, though.
-    checkCg checkCOrAsmOrInterp `thenM_`
-    checkCConv cconv 		`thenM_`
-    (case arg_tys of
-	[arg1_ty] -> checkForeignArgs isFFIExternalTy arg1_tys		     `thenM_`
-		     checkForeignRes nonIOok  isFFIExportResultTy res1_ty    `thenM_`
-		     checkForeignRes mustBeIO isFFIDynResultTy	  res_ty     `thenM_`
-		     checkFEDArgs arg1_tys
-		  where
-		     (arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
-        other -> addErrTc (illegalForeignTyErr empty sig_ty)	)            `thenM_`
-    return idecl
-
-tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ _ (CFunction target))
-  | isDynamicTarget target	-- Foreign import dynamic
-  = checkCg checkCOrAsmOrInterp		`thenM_`
-    checkCConv cconv 			`thenM_`
-    case arg_tys of		-- The first arg must be Ptr, FunPtr, or Addr
-      []     		-> 
-      	check False (illegalForeignTyErr empty sig_ty) `thenM_`
-      	return idecl
-      (arg1_ty:arg_tys) -> 
-      	getDOpts				                     `thenM` \ dflags ->
-	check (isFFIDynArgumentTy arg1_ty)
-	      (illegalForeignTyErr argument arg1_ty)		     `thenM_`
-        checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys     `thenM_`
-	checkForeignRes nonIOok (isFFIImportResultTy dflags) res_ty  `thenM_`
-	return idecl
-  | otherwise 		-- Normal foreign import
-  = checkCg (checkCOrAsmOrDotNetOrInterp)			`thenM_`
-    checkCConv cconv 						`thenM_`
-    checkCTarget target						`thenM_`
-    getDOpts							`thenM` \ dflags ->
-    checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys	`thenM_`
-    checkForeignRes nonIOok (isFFIImportResultTy dflags) res_ty `thenM_`
-    return idecl
-
--- This makes a convenient place to check
--- that the C identifier is valid for C
-checkCTarget (StaticTarget str) 
-  = checkCg checkCOrAsmOrDotNetOrInterp	 	`thenM_`
-    check (isCLabelString str) (badCName str)
-\end{code}
-
-On an Alpha, with foreign export dynamic, due to a giant hack when
-building adjustor thunks, we only allow 4 integer arguments with
-foreign export dynamic (i.e., 32 bytes of arguments after padding each
-argument to a quadword, excluding floating-point arguments).
-
-The check is needed for both via-C and native-code routes
-
-\begin{code}
-#include "nativeGen/NCG.h"
-#if alpha_TARGET_ARCH
-checkFEDArgs arg_tys
-  = check (integral_args <= 32) err
-  where
-    integral_args = sum [ (machRepByteWidth . argMachRep . primRepToCgRep) prim_rep
-			| prim_rep <- map typePrimRep arg_tys,
-			  primRepHint prim_rep /= FloatHint ]
-    err = ptext SLIT("On Alpha, I can only handle 32 bytes of non-floating-point arguments to foreign export dynamic")
-#else
-checkFEDArgs arg_tys = returnM ()
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Exports}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcForeignExports :: [LForeignDecl Name] 
-    		 -> TcM (LHsBinds TcId, [LForeignDecl TcId])
-tcForeignExports decls
-  = foldlM combine (emptyLHsBinds, []) (filter isForeignExport decls)
-  where
-   combine (binds, fs) fe = 
-       wrapLocSndM tcFExport fe	`thenM` \ (b, f) ->
-       returnM (b `consBag` binds, f:fs)
-
-tcFExport :: ForeignDecl Name -> TcM (LHsBind Id, ForeignDecl Id)
-tcFExport fo@(ForeignExport (L loc nm) hs_ty spec isDeprec) =
-   addErrCtxt (foreignDeclCtxt fo)	$
-
-   tcHsSigType (ForSigCtxt nm) hs_ty	`thenM` \ sig_ty ->
-   tcPolyExpr (nlHsVar nm) sig_ty	`thenM` \ rhs ->
-
-   tcCheckFEType sig_ty spec		`thenM_`
-
-	  -- we're exporting a function, but at a type possibly more
-	  -- constrained than its declared/inferred type. Hence the need
-	  -- to create a local binding which will call the exported function
-	  -- at a particular type (and, maybe, overloading).
-
-   newUnique			`thenM` \ uniq ->
-   getModule			`thenM` \ mod ->
-   let
-        gnm  = mkExternalName uniq mod (mkForeignExportOcc (getOccName nm)) 
-			      Nothing (srcSpanStart loc)
-	id   = mkExportedLocalId gnm sig_ty
-	bind = L loc (VarBind id rhs)
-   in
-   returnM (bind, ForeignExport (L loc id) undefined spec isDeprec)
-\end{code}
-
------------- Checking argument types for foreign export ----------------------
-
-\begin{code}
-tcCheckFEType sig_ty (CExport (CExportStatic str _))
-  = check (isCLabelString str) (badCName str)		`thenM_`
-    checkForeignArgs isFFIExternalTy arg_tys  	        `thenM_`
-    checkForeignRes nonIOok isFFIExportResultTy res_ty
-  where
-      -- Drop the foralls before inspecting n
-      -- the structure of the foreign type.
-    (_, t_ty) = tcSplitForAllTys sig_ty
-    (arg_tys, res_ty) = tcSplitFunTys t_ty
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Miscellaneous}
-%*									*
-%************************************************************************
-
-\begin{code}
------------- Checking argument types for foreign import ----------------------
-checkForeignArgs :: (Type -> Bool) -> [Type] -> TcM ()
-checkForeignArgs pred tys
-  = mappM go tys		`thenM_` 
-    returnM ()
-  where
-    go ty = check (pred ty) (illegalForeignTyErr argument ty)
-
------------- Checking result types for foreign calls ----------------------
--- Check that the type has the form 
---    (IO t) or (t) , and that t satisfies the given predicate.
---
-checkForeignRes :: Bool -> (Type -> Bool) -> Type -> TcM ()
-
-nonIOok  = True
-mustBeIO = False
-
-checkForeignRes non_io_result_ok pred_res_ty ty
- = case tcSplitTyConApp_maybe ty of
-      Just (io, [res_ty]) 
-        | io `hasKey` ioTyConKey && pred_res_ty res_ty 
-	-> returnM ()
-      _   
-        -> check (non_io_result_ok && pred_res_ty ty) 
-		 (illegalForeignTyErr result ty)
-\end{code}
-
-\begin{code}
-checkDotnet HscILX = Nothing
-#if defined(mingw32_TARGET_OS)
-checkDotnet HscC   = Nothing
-checkDotnet _      = Just (text "requires C code generation (-fvia-C)")
-#else
-checkDotnet other  = Just (text "requires .NET support (-filx or win32)")
-#endif
-
-checkCOrAsm HscC   = Nothing
-checkCOrAsm HscAsm = Nothing
-checkCOrAsm other  
-   = Just (text "requires via-C or native code generation (-fvia-C)")
-
-checkCOrAsmOrInterp HscC           = Nothing
-checkCOrAsmOrInterp HscAsm         = Nothing
-checkCOrAsmOrInterp HscInterpreted = Nothing
-checkCOrAsmOrInterp other  
-   = Just (text "requires interpreted, C or native code generation")
-
-checkCOrAsmOrDotNetOrInterp HscC           = Nothing
-checkCOrAsmOrDotNetOrInterp HscAsm         = Nothing
-checkCOrAsmOrDotNetOrInterp HscILX         = Nothing
-checkCOrAsmOrDotNetOrInterp HscInterpreted = Nothing
-checkCOrAsmOrDotNetOrInterp other  
-   = Just (text "requires interpreted, C, native or .NET ILX code generation")
-
-checkCg check
- = getDOpts		`thenM` \ dflags ->
-   let target = hscTarget dflags in
-   case target of
-     HscNothing -> returnM ()
-     otherwise  ->
-       case check target of
-	 Nothing  -> returnM ()
-	 Just err -> addErrTc (text "Illegal foreign declaration:" <+> err)
-\end{code} 
-			   
-Calling conventions
-
-\begin{code}
-checkCConv :: CCallConv -> TcM ()
-checkCConv CCallConv  = return ()
-#if i386_TARGET_ARCH
-checkCConv StdCallConv = return ()
-#else
-checkCConv StdCallConv = addErrTc (text "calling convention not supported on this architecture: stdcall")
-#endif
-\end{code}
-
-Warnings
-
-\begin{code}
-check :: Bool -> Message -> TcM ()
-check True _	   = returnM ()
-check _    the_err = addErrTc the_err
-
-illegalForeignTyErr arg_or_res ty
-  = hang (hsep [ptext SLIT("Unacceptable"), arg_or_res, 
-                ptext SLIT("type in foreign declaration:")])
-	 4 (hsep [ppr ty])
-
--- Used for 'arg_or_res' argument to illegalForeignTyErr
-argument = text "argument"
-result   = text "result"
-
-badCName :: CLabelString -> Message
-badCName target 
-   = sep [quotes (ppr target) <+> ptext SLIT("is not a valid C identifier")]
-
-foreignDeclCtxt fo
-  = hang (ptext SLIT("When checking declaration:"))
-         4 (ppr fo)
-
-illegalDNMethodSig 
-  = ptext SLIT("'This pointer' expected as last argument")
-
-\end{code}
-
diff --git a/ghc/compiler/typecheck/TcGenDeriv.lhs b/ghc/compiler/typecheck/TcGenDeriv.lhs
deleted file mode 100644
index 40e091d475..0000000000
--- a/ghc/compiler/typecheck/TcGenDeriv.lhs
+++ /dev/null
@@ -1,1480 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcGenDeriv]{Generating derived instance declarations}
-
-This module is nominally ``subordinate'' to @TcDeriv@, which is the
-``official'' interface to deriving-related things.
-
-This is where we do all the grimy bindings' generation.
-
-\begin{code}
-module TcGenDeriv (
-	gen_Bounded_binds,
-	gen_Enum_binds,
-	gen_Eq_binds,
-	gen_Ix_binds,
-	gen_Ord_binds,
-	gen_Read_binds,
-	gen_Show_binds,
-	gen_Data_binds,
-	gen_Typeable_binds,
-	gen_tag_n_con_monobind,
-
-	con2tag_RDR, tag2con_RDR, maxtag_RDR,
-
-	TagThingWanted(..)
-    ) where
-
-#include "HsVersions.h"
-
-import HsSyn
-import RdrName		( RdrName, mkVarUnqual, getRdrName, mkRdrUnqual,
-			   mkDerivedRdrName )
-import BasicTypes	( Fixity(..), maxPrecedence, Boxity(..) )
-import DataCon		( isNullarySrcDataCon, dataConTag,
-			  dataConOrigArgTys, dataConSourceArity, fIRST_TAG,
-			  DataCon, dataConName, dataConIsInfix,
-			  dataConFieldLabels )
-import Name		( getOccString, getSrcLoc, Name, NamedThing(..)	)
-
-import HscTypes		( FixityEnv, lookupFixity )
-import PrelInfo
-import PrelNames
-import MkId		( eRROR_ID )
-import PrimOp		( PrimOp(..) )
-import SrcLoc		( Located(..), noLoc, srcLocSpan )
-import TyCon		( TyCon, isNewTyCon, tyConDataCons, isEnumerationTyCon, tyConArity,
-			  maybeTyConSingleCon, tyConFamilySize, tyConTyVars, tyConName
-			)
-import TcType		( isUnLiftedType, tcEqType, Type )
-import TysPrim		( charPrimTy, intPrimTy, wordPrimTy, addrPrimTy, floatPrimTy, doublePrimTy,
-			  intPrimTyCon )
-import TysWiredIn	( charDataCon, intDataCon, floatDataCon, doubleDataCon,
-			  intDataCon_RDR, true_RDR, false_RDR )
-import Util		( zipWithEqual, isSingleton,
-			  zipWith3Equal, nOfThem, zipEqual )
-import Constants
-import List		( partition, intersperse )
-import Outputable
-import FastString
-import OccName
-import Bag
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Generating code, by derivable class}
-%*									*
-%************************************************************************
-
-%************************************************************************
-%*									*
-\subsubsection{Generating @Eq@ instance declarations}
-%*									*
-%************************************************************************
-
-Here are the heuristics for the code we generate for @Eq@:
-\begin{itemize}
-\item
-  Let's assume we have a data type with some (possibly zero) nullary
-  data constructors and some ordinary, non-nullary ones (the rest,
-  also possibly zero of them).  Here's an example, with both \tr{N}ullary
-  and \tr{O}rdinary data cons.
-\begin{verbatim}
-data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
-\end{verbatim}
-
-\item
-  For the ordinary constructors (if any), we emit clauses to do The
-  Usual Thing, e.g.,:
-
-\begin{verbatim}
-(==) (O1 a1 b1)	   (O1 a2 b2)    = a1 == a2 && b1 == b2
-(==) (O2 a1)	   (O2 a2)	 = a1 == a2
-(==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
-\end{verbatim}
-
-  Note: if we're comparing unlifted things, e.g., if \tr{a1} and
-  \tr{a2} are \tr{Float#}s, then we have to generate
-\begin{verbatim}
-case (a1 `eqFloat#` a2) of
-  r -> r
-\end{verbatim}
-  for that particular test.
-
-\item
-  If there are any nullary constructors, we emit a catch-all clause of
-  the form:
-
-\begin{verbatim}
-(==) a b  = case (con2tag_Foo a) of { a# ->
-	    case (con2tag_Foo b) of { b# ->
-	    case (a# ==# b#)	 of {
-	      r -> r
-	    }}}
-\end{verbatim}
-
-  If there aren't any nullary constructors, we emit a simpler
-  catch-all:
-\begin{verbatim}
-(==) a b  = False
-\end{verbatim}
-
-\item
-  For the @(/=)@ method, we normally just use the default method.
-
-  If the type is an enumeration type, we could/may/should? generate
-  special code that calls @con2tag_Foo@, much like for @(==)@ shown
-  above.
-
-\item
-  We thought about doing this: If we're also deriving @Ord@ for this
-  tycon, we generate:
-\begin{verbatim}
-instance ... Eq (Foo ...) where
-  (==) a b  = case (compare a b) of { _LT -> False; _EQ -> True ; _GT -> False}
-  (/=) a b  = case (compare a b) of { _LT -> True ; _EQ -> False; _GT -> True }
-\begin{verbatim}
-  However, that requires that \tr{Ord <whatever>} was put in the context
-  for the instance decl, which it probably wasn't, so the decls
-  produced don't get through the typechecker.
-\end{itemize}
-
-
-\begin{code}
-gen_Eq_binds :: TyCon -> LHsBinds RdrName
-
-gen_Eq_binds tycon
-  = let
-	tycon_loc = getSrcSpan tycon
-
-        (nullary_cons, nonnullary_cons)
-           | isNewTyCon tycon = ([], tyConDataCons tycon)
-           | otherwise	      = partition isNullarySrcDataCon (tyConDataCons tycon)
-
-	rest
-	  = if (null nullary_cons) then
-		case maybeTyConSingleCon tycon of
-		  Just _ -> []
-		  Nothing -> -- if cons don't match, then False
-		     [([nlWildPat, nlWildPat], false_Expr)]
-	    else -- calc. and compare the tags
-		 [([a_Pat, b_Pat],
-		    untag_Expr tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
-		               (genOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))]
-    in
-    listToBag [
-      mk_FunBind tycon_loc eq_RDR ((map pats_etc nonnullary_cons) ++ rest),
-      mk_easy_FunBind tycon_loc ne_RDR [a_Pat, b_Pat] (
-	nlHsApp (nlHsVar not_RDR) (nlHsPar (nlHsVarApps eq_RDR [a_RDR, b_RDR])))
-    ]
-  where
-    ------------------------------------------------------------------
-    pats_etc data_con
-      = let
-	    con1_pat = nlConVarPat data_con_RDR as_needed
-	    con2_pat = nlConVarPat data_con_RDR bs_needed
-
-	    data_con_RDR = getRdrName data_con
-	    con_arity   = length tys_needed
-	    as_needed   = take con_arity as_RDRs
-	    bs_needed   = take con_arity bs_RDRs
-	    tys_needed  = dataConOrigArgTys data_con
-	in
-	([con1_pat, con2_pat], nested_eq_expr tys_needed as_needed bs_needed)
-      where
-	nested_eq_expr []  [] [] = true_Expr
-	nested_eq_expr tys as bs
-	  = foldl1 and_Expr (zipWith3Equal "nested_eq" nested_eq tys as bs)
-	  where
-	    nested_eq ty a b = nlHsPar (eq_Expr tycon ty (nlHsVar a) (nlHsVar b))
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{Generating @Ord@ instance declarations}
-%*									*
-%************************************************************************
-
-For a derived @Ord@, we concentrate our attentions on @compare@
-\begin{verbatim}
-compare :: a -> a -> Ordering
-data Ordering = LT | EQ | GT deriving ()
-\end{verbatim}
-
-We will use the same example data type as above:
-\begin{verbatim}
-data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
-\end{verbatim}
-
-\begin{itemize}
-\item
-  We do all the other @Ord@ methods with calls to @compare@:
-\begin{verbatim}
-instance ... (Ord <wurble> <wurble>) where
-    a <  b  = case (compare a b) of { LT -> True;  EQ -> False; GT -> False }
-    a <= b  = case (compare a b) of { LT -> True;  EQ -> True;  GT -> False }
-    a >= b  = case (compare a b) of { LT -> False; EQ -> True;  GT -> True  }
-    a >  b  = case (compare a b) of { LT -> False; EQ -> False; GT -> True  }
-
-    max a b = case (compare a b) of { LT -> b; EQ -> a;  GT -> a }
-    min a b = case (compare a b) of { LT -> a; EQ -> b;  GT -> b }
-
-    -- compare to come...
-\end{verbatim}
-
-\item
-  @compare@ always has two parts.  First, we use the compared
-  data-constructors' tags to deal with the case of different
-  constructors:
-\begin{verbatim}
-compare a b = case (con2tag_Foo a) of { a# ->
-	      case (con2tag_Foo b) of { b# ->
-	      case (a# ==# b#)     of {
-	       True  -> cmp_eq a b
-	       False -> case (a# <# b#) of
-			 True  -> _LT
-			 False -> _GT
-	      }}}
-  where
-    cmp_eq = ... to come ...
-\end{verbatim}
-
-\item
-  We are only left with the ``help'' function @cmp_eq@, to deal with
-  comparing data constructors with the same tag.
-
-  For the ordinary constructors (if any), we emit the sorta-obvious
-  compare-style stuff; for our example:
-\begin{verbatim}
-cmp_eq (O1 a1 b1) (O1 a2 b2)
-  = case (compare a1 a2) of { LT -> LT; EQ -> compare b1 b2; GT -> GT }
-
-cmp_eq (O2 a1) (O2 a2)
-  = compare a1 a2
-
-cmp_eq (O3 a1 b1 c1) (O3 a2 b2 c2)
-  = case (compare a1 a2) of {
-      LT -> LT;
-      GT -> GT;
-      EQ -> case compare b1 b2 of {
-	      LT -> LT;
-	      GT -> GT;
-	      EQ -> compare c1 c2
-	    }
-    }
-\end{verbatim}
-
-  Again, we must be careful about unlifted comparisons.  For example,
-  if \tr{a1} and \tr{a2} were \tr{Int#}s in the 2nd example above, we'd need to
-  generate:
-
-\begin{verbatim}
-cmp_eq lt eq gt (O2 a1) (O2 a2)
-  = compareInt# a1 a2
-  -- or maybe the unfolded equivalent
-\end{verbatim}
-
-\item
-  For the remaining nullary constructors, we already know that the
-  tags are equal so:
-\begin{verbatim}
-cmp_eq _ _ = EQ
-\end{verbatim}
-\end{itemize}
-
-If there is only one constructor in the Data Type we don't need the WildCard Pattern. 
-JJQC-30-Nov-1997
-
-\begin{code}
-gen_Ord_binds :: TyCon -> LHsBinds RdrName
-
-gen_Ord_binds tycon
-  = unitBag compare 	-- `AndMonoBinds` compare	
-		-- The default declaration in PrelBase handles this
-  where
-    tycon_loc = getSrcSpan tycon
-    --------------------------------------------------------------------
-
-    compare = L tycon_loc (mkFunBind (L tycon_loc compare_RDR) compare_matches)
-    compare_matches = [mkMatch [a_Pat, b_Pat] compare_rhs cmp_eq_binds]
-    cmp_eq_binds    = HsValBinds (ValBindsIn (unitBag cmp_eq) [])
-
-    compare_rhs
-	| single_con_type = cmp_eq_Expr a_Expr b_Expr
- 	| otherwise
-	= untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)]
-		  (cmp_tags_Expr eqInt_RDR ah_RDR bh_RDR
-			(cmp_eq_Expr a_Expr b_Expr)	-- True case
-			-- False case; they aren't equal
-			-- So we need to do a less-than comparison on the tags
-		  	(cmp_tags_Expr ltInt_RDR ah_RDR bh_RDR ltTag_Expr gtTag_Expr))
-
-    tycon_data_cons = tyConDataCons tycon
-    single_con_type = isSingleton tycon_data_cons
-    (nullary_cons, nonnullary_cons)
-       | isNewTyCon tycon = ([], tyConDataCons tycon)
-       | otherwise	  = partition isNullarySrcDataCon tycon_data_cons
-
-    cmp_eq = mk_FunBind tycon_loc cmp_eq_RDR cmp_eq_match
-    cmp_eq_match
-      | isEnumerationTyCon tycon
-			   -- We know the tags are equal, so if it's an enumeration TyCon,
-			   -- then there is nothing left to do
-			   -- Catch this specially to avoid warnings
-			   -- about overlapping patterns from the desugarer,
-			   -- and to avoid unnecessary pattern-matching
-      = [([nlWildPat,nlWildPat], eqTag_Expr)]
-      | otherwise
-      = map pats_etc nonnullary_cons ++
-	(if single_con_type then	-- Omit wildcards when there's just one 
-	      []			-- constructor, to silence desugarer
-	else
-              [([nlWildPat, nlWildPat], default_rhs)])
-
-      where
-	pats_etc data_con
-	  = ([con1_pat, con2_pat],
-	     nested_compare_expr tys_needed as_needed bs_needed)
-	  where
-	    con1_pat = nlConVarPat data_con_RDR as_needed
-	    con2_pat = nlConVarPat data_con_RDR bs_needed
-
-	    data_con_RDR = getRdrName data_con
-	    con_arity   = length tys_needed
-	    as_needed   = take con_arity as_RDRs
-	    bs_needed   = take con_arity bs_RDRs
-	    tys_needed  = dataConOrigArgTys data_con
-
-	    nested_compare_expr [ty] [a] [b]
-	      = careful_compare_Case tycon ty eqTag_Expr (nlHsVar a) (nlHsVar b)
-
-	    nested_compare_expr (ty:tys) (a:as) (b:bs)
-	      = let eq_expr = nested_compare_expr tys as bs
-		in  careful_compare_Case tycon ty eq_expr (nlHsVar a) (nlHsVar b)
-
-	default_rhs | null nullary_cons = impossible_Expr	-- Keep desugarer from complaining about
-								-- inexhaustive patterns
-		    | otherwise		= eqTag_Expr		-- Some nullary constructors;
-								-- Tags are equal, no args => return EQ
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{Generating @Enum@ instance declarations}
-%*									*
-%************************************************************************
-
-@Enum@ can only be derived for enumeration types.  For a type
-\begin{verbatim}
-data Foo ... = N1 | N2 | ... | Nn
-\end{verbatim}
-
-we use both @con2tag_Foo@ and @tag2con_Foo@ functions, as well as a
-@maxtag_Foo@ variable (all generated by @gen_tag_n_con_binds@).
-
-\begin{verbatim}
-instance ... Enum (Foo ...) where
-    succ x   = toEnum (1 + fromEnum x)
-    pred x   = toEnum (fromEnum x - 1)
-
-    toEnum i = tag2con_Foo i
-
-    enumFrom a = map tag2con_Foo [con2tag_Foo a .. maxtag_Foo]
-
-    -- or, really...
-    enumFrom a
-      = case con2tag_Foo a of
-	  a# -> map tag2con_Foo (enumFromTo (I# a#) maxtag_Foo)
-
-   enumFromThen a b
-     = map tag2con_Foo [con2tag_Foo a, con2tag_Foo b .. maxtag_Foo]
-
-    -- or, really...
-    enumFromThen a b
-      = case con2tag_Foo a of { a# ->
-	case con2tag_Foo b of { b# ->
-	map tag2con_Foo (enumFromThenTo (I# a#) (I# b#) maxtag_Foo)
-	}}
-\end{verbatim}
-
-For @enumFromTo@ and @enumFromThenTo@, we use the default methods.
-
-\begin{code}
-gen_Enum_binds :: TyCon -> LHsBinds RdrName
-
-gen_Enum_binds tycon
-  = listToBag [
-	succ_enum,
-	pred_enum,
-	to_enum,
-	enum_from,
-	enum_from_then,
-	from_enum
-    ]
-  where
-    tycon_loc = getSrcSpan tycon
-    occ_nm    = getOccString tycon
-
-    succ_enum
-      = mk_easy_FunBind tycon_loc succ_RDR [a_Pat] $
-	untag_Expr tycon [(a_RDR, ah_RDR)] $
-	nlHsIf (nlHsApps eq_RDR [nlHsVar (maxtag_RDR tycon),
-			       nlHsVarApps intDataCon_RDR [ah_RDR]])
-	     (illegal_Expr "succ" occ_nm "tried to take `succ' of last tag in enumeration")
-	     (nlHsApp (nlHsVar (tag2con_RDR tycon))
-		    (nlHsApps plus_RDR [nlHsVarApps intDataCon_RDR [ah_RDR],
-		 			nlHsIntLit 1]))
-		    
-    pred_enum
-      = mk_easy_FunBind tycon_loc pred_RDR [a_Pat] $
-	untag_Expr tycon [(a_RDR, ah_RDR)] $
-	nlHsIf (nlHsApps eq_RDR [nlHsIntLit 0,
-			       nlHsVarApps intDataCon_RDR [ah_RDR]])
-	     (illegal_Expr "pred" occ_nm "tried to take `pred' of first tag in enumeration")
-	     (nlHsApp (nlHsVar (tag2con_RDR tycon))
-			   (nlHsApps plus_RDR [nlHsVarApps intDataCon_RDR [ah_RDR],
-					       nlHsLit (HsInt (-1))]))
-
-    to_enum
-      = mk_easy_FunBind tycon_loc toEnum_RDR [a_Pat] $
-	nlHsIf (nlHsApps and_RDR
-		[nlHsApps ge_RDR [nlHsVar a_RDR, nlHsIntLit 0],
-                 nlHsApps le_RDR [nlHsVar a_RDR, nlHsVar (maxtag_RDR tycon)]])
-             (nlHsVarApps (tag2con_RDR tycon) [a_RDR])
-	     (illegal_toEnum_tag occ_nm (maxtag_RDR tycon))
-
-    enum_from
-      = mk_easy_FunBind tycon_loc enumFrom_RDR [a_Pat] $
-	  untag_Expr tycon [(a_RDR, ah_RDR)] $
-	  nlHsApps map_RDR 
-		[nlHsVar (tag2con_RDR tycon),
-		 nlHsPar (enum_from_to_Expr
-			    (nlHsVarApps intDataCon_RDR [ah_RDR])
-			    (nlHsVar (maxtag_RDR tycon)))]
-
-    enum_from_then
-      = mk_easy_FunBind tycon_loc enumFromThen_RDR [a_Pat, b_Pat] $
-	  untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)] $
-	  nlHsApp (nlHsVarApps map_RDR [tag2con_RDR tycon]) $
-	    nlHsPar (enum_from_then_to_Expr
-		    (nlHsVarApps intDataCon_RDR [ah_RDR])
-		    (nlHsVarApps intDataCon_RDR [bh_RDR])
-		    (nlHsIf  (nlHsApps gt_RDR [nlHsVarApps intDataCon_RDR [ah_RDR],
-					     nlHsVarApps intDataCon_RDR [bh_RDR]])
-			   (nlHsIntLit 0)
-			   (nlHsVar (maxtag_RDR tycon))
-			   ))
-
-    from_enum
-      = mk_easy_FunBind tycon_loc fromEnum_RDR [a_Pat] $
-	  untag_Expr tycon [(a_RDR, ah_RDR)] $
-	  (nlHsVarApps intDataCon_RDR [ah_RDR])
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{Generating @Bounded@ instance declarations}
-%*									*
-%************************************************************************
-
-\begin{code}
-gen_Bounded_binds tycon
-  = if isEnumerationTyCon tycon then
-	listToBag [ min_bound_enum, max_bound_enum ]
-    else
-	ASSERT(isSingleton data_cons)
-	listToBag [ min_bound_1con, max_bound_1con ]
-  where
-    data_cons = tyConDataCons tycon
-    tycon_loc = getSrcSpan tycon
-
-    ----- enum-flavored: ---------------------------
-    min_bound_enum = mkVarBind tycon_loc minBound_RDR (nlHsVar data_con_1_RDR)
-    max_bound_enum = mkVarBind tycon_loc maxBound_RDR (nlHsVar data_con_N_RDR)
-
-    data_con_1	  = head data_cons
-    data_con_N	  = last data_cons
-    data_con_1_RDR = getRdrName data_con_1
-    data_con_N_RDR = getRdrName data_con_N
-
-    ----- single-constructor-flavored: -------------
-    arity	   = dataConSourceArity data_con_1
-
-    min_bound_1con = mkVarBind tycon_loc minBound_RDR $
-		     nlHsVarApps data_con_1_RDR (nOfThem arity minBound_RDR)
-    max_bound_1con = mkVarBind tycon_loc maxBound_RDR $
-		     nlHsVarApps data_con_1_RDR (nOfThem arity maxBound_RDR)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{Generating @Ix@ instance declarations}
-%*									*
-%************************************************************************
-
-Deriving @Ix@ is only possible for enumeration types and
-single-constructor types.  We deal with them in turn.
-
-For an enumeration type, e.g.,
-\begin{verbatim}
-    data Foo ... = N1 | N2 | ... | Nn
-\end{verbatim}
-things go not too differently from @Enum@:
-\begin{verbatim}
-instance ... Ix (Foo ...) where
-    range (a, b)
-      = map tag2con_Foo [con2tag_Foo a .. con2tag_Foo b]
-
-    -- or, really...
-    range (a, b)
-      = case (con2tag_Foo a) of { a# ->
-	case (con2tag_Foo b) of { b# ->
-	map tag2con_Foo (enumFromTo (I# a#) (I# b#))
-	}}
-
-    -- Generate code for unsafeIndex, becuase using index leads
-    -- to lots of redundant range tests
-    unsafeIndex c@(a, b) d
-      = case (con2tag_Foo d -# con2tag_Foo a) of
-	       r# -> I# r#
-
-    inRange (a, b) c
-      = let
-	    p_tag = con2tag_Foo c
-	in
-	p_tag >= con2tag_Foo a && p_tag <= con2tag_Foo b
-
-    -- or, really...
-    inRange (a, b) c
-      = case (con2tag_Foo a)   of { a_tag ->
-	case (con2tag_Foo b)   of { b_tag ->
-	case (con2tag_Foo c)   of { c_tag ->
-	if (c_tag >=# a_tag) then
-	  c_tag <=# b_tag
-	else
-	  False
-	}}}
-\end{verbatim}
-(modulo suitable case-ification to handle the unlifted tags)
-
-For a single-constructor type (NB: this includes all tuples), e.g.,
-\begin{verbatim}
-    data Foo ... = MkFoo a b Int Double c c
-\end{verbatim}
-we follow the scheme given in Figure~19 of the Haskell~1.2 report
-(p.~147).
-
-\begin{code}
-gen_Ix_binds :: TyCon -> LHsBinds RdrName
-
-gen_Ix_binds tycon
-  = if isEnumerationTyCon tycon
-    then enum_ixes
-    else single_con_ixes
-  where
-    tycon_loc = getSrcSpan tycon
-
-    --------------------------------------------------------------
-    enum_ixes = listToBag [ enum_range, enum_index, enum_inRange ]
-
-    enum_range
-      = mk_easy_FunBind tycon_loc range_RDR [nlTuplePat [a_Pat, b_Pat] Boxed] $
-	  untag_Expr tycon [(a_RDR, ah_RDR)] $
-	  untag_Expr tycon [(b_RDR, bh_RDR)] $
-	  nlHsApp (nlHsVarApps map_RDR [tag2con_RDR tycon]) $
-	      nlHsPar (enum_from_to_Expr
-			(nlHsVarApps intDataCon_RDR [ah_RDR])
-			(nlHsVarApps intDataCon_RDR [bh_RDR]))
-
-    enum_index
-      = mk_easy_FunBind tycon_loc unsafeIndex_RDR 
-		[noLoc (AsPat (noLoc c_RDR) 
-			   (nlTuplePat [a_Pat, nlWildPat] Boxed)), 
-				d_Pat] (
-	   untag_Expr tycon [(a_RDR, ah_RDR)] (
-	   untag_Expr tycon [(d_RDR, dh_RDR)] (
-	   let
-		rhs = nlHsVarApps intDataCon_RDR [c_RDR]
-	   in
-	   nlHsCase
-	     (genOpApp (nlHsVar dh_RDR) minusInt_RDR (nlHsVar ah_RDR))
-	     [mkSimpleHsAlt (nlVarPat c_RDR) rhs]
-	   ))
-	)
-
-    enum_inRange
-      = mk_easy_FunBind tycon_loc inRange_RDR [nlTuplePat [a_Pat, b_Pat] Boxed, c_Pat] $
-	  untag_Expr tycon [(a_RDR, ah_RDR)] (
-	  untag_Expr tycon [(b_RDR, bh_RDR)] (
-	  untag_Expr tycon [(c_RDR, ch_RDR)] (
-	  nlHsIf (genOpApp (nlHsVar ch_RDR) geInt_RDR (nlHsVar ah_RDR)) (
-	     (genOpApp (nlHsVar ch_RDR) leInt_RDR (nlHsVar bh_RDR))
-	  ) {-else-} (
-	     false_Expr
-	  ))))
-
-    --------------------------------------------------------------
-    single_con_ixes 
-      = listToBag [single_con_range, single_con_index, single_con_inRange]
-
-    data_con
-      =	case maybeTyConSingleCon tycon of -- just checking...
-	  Nothing -> panic "get_Ix_binds"
-	  Just dc | any isUnLiftedType (dataConOrigArgTys dc)
-		  -> pprPanic "Can't derive Ix for a single-constructor type with primitive argument types:" (ppr tycon)
-		  | otherwise -> dc
-
-    con_arity    = dataConSourceArity data_con
-    data_con_RDR = getRdrName data_con
-
-    as_needed = take con_arity as_RDRs
-    bs_needed = take con_arity bs_RDRs
-    cs_needed = take con_arity cs_RDRs
-
-    con_pat  xs  = nlConVarPat data_con_RDR xs
-    con_expr     = nlHsVarApps data_con_RDR cs_needed
-
-    --------------------------------------------------------------
-    single_con_range
-      = mk_easy_FunBind tycon_loc range_RDR 
-	  [nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed] $
-	nlHsDo ListComp stmts con_expr
-      where
-	stmts = zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed
-
-	mk_qual a b c = noLoc $ mkBindStmt (nlVarPat c)
-				 (nlHsApp (nlHsVar range_RDR) 
-					(nlTuple [nlHsVar a, nlHsVar b] Boxed))
-
-    ----------------
-    single_con_index
-      = mk_easy_FunBind tycon_loc unsafeIndex_RDR 
-		[nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed, 
-		 con_pat cs_needed] 
-		(mk_index (zip3 as_needed bs_needed cs_needed))
-      where
-	-- index (l1,u1) i1 + rangeSize (l1,u1) * (index (l2,u2) i2 + ...)
-	mk_index [] 	   = nlHsIntLit 0
-	mk_index [(l,u,i)] = mk_one l u i
-	mk_index ((l,u,i) : rest)
-	  = genOpApp (
-		mk_one l u i
-	    ) plus_RDR (
-		genOpApp (
-		    (nlHsApp (nlHsVar unsafeRangeSize_RDR) 
-			   (nlTuple [nlHsVar l, nlHsVar u] Boxed))
-		) times_RDR (mk_index rest)
-	   )
-	mk_one l u i
-	  = nlHsApps unsafeIndex_RDR [nlTuple [nlHsVar l, nlHsVar u] Boxed, nlHsVar i]
-
-    ------------------
-    single_con_inRange
-      = mk_easy_FunBind tycon_loc inRange_RDR 
-		[nlTuplePat [con_pat as_needed, con_pat bs_needed] Boxed, 
-		 con_pat cs_needed] $
-	  foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range as_needed bs_needed cs_needed)
-      where
-    	in_range a b c = nlHsApps inRange_RDR [nlTuple [nlHsVar a, nlHsVar b] Boxed,
-					       nlHsVar c]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{Generating @Read@ instance declarations}
-%*									*
-%************************************************************************
-
-Example
-
-  infix 4 %%
-  data T = Int %% Int
- 	 | T1 { f1 :: Int }
-	 | T2 Int
-
-
-instance Read T where
-  readPrec =
-    parens
-    ( prec 4 (
-        do x           <- ReadP.step Read.readPrec
-           Symbol "%%" <- Lex.lex
-           y           <- ReadP.step Read.readPrec
-           return (x %% y))
-      +++
-      prec appPrec (
-	do Ident "T1" <- Lex.lex
-	   Punc '{' <- Lex.lex
-	   Ident "f1" <- Lex.lex
-	   Punc '=' <- Lex.lex
-	   x	      <- ReadP.reset Read.readPrec
-	   Punc '}' <- Lex.lex
-	   return (T1 { f1 = x }))
-      +++
-      prec appPrec (
-        do Ident "T2" <- Lex.lexP
-           x          <- ReadP.step Read.readPrec
-           return (T2 x))
-    )
-
-  readListPrec = readListPrecDefault
-  readList     = readListDefault
-
-
-\begin{code}
-gen_Read_binds :: FixityEnv -> TyCon -> LHsBinds RdrName
-
-gen_Read_binds get_fixity tycon
-  = listToBag [read_prec, default_readlist, default_readlistprec]
-  where
-    -----------------------------------------------------------------------
-    default_readlist 
-	= mkVarBind loc readList_RDR     (nlHsVar readListDefault_RDR)
-
-    default_readlistprec
-	= mkVarBind loc readListPrec_RDR (nlHsVar readListPrecDefault_RDR)
-    -----------------------------------------------------------------------
-
-    loc       = getSrcSpan tycon
-    data_cons = tyConDataCons tycon
-    (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon data_cons
-    
-    read_prec = mkVarBind loc readPrec_RDR
-	 		      (nlHsApp (nlHsVar parens_RDR) read_cons)
-
-    read_cons 	          = foldr1 mk_alt (read_nullary_cons ++ read_non_nullary_cons)
-    read_non_nullary_cons = map read_non_nullary_con non_nullary_cons
-    
-    read_nullary_cons 
-      = case nullary_cons of
-    	    []    -> []
-    	    [con] -> [nlHsDo DoExpr [bindLex (ident_pat (data_con_str con))]
-				    (result_expr con [])]
-            _     -> [nlHsApp (nlHsVar choose_RDR) 
-    		   	    (nlList (map mk_pair nullary_cons))]
-    
-    mk_pair con = nlTuple [nlHsLit (mkHsString (data_con_str con)),
-    		   		   nlHsApp (nlHsVar returnM_RDR) (nlHsVar (getRdrName con))]
-				   Boxed
-    
-    read_non_nullary_con data_con
-      = nlHsApps prec_RDR [nlHsIntLit prec, nlHsDo DoExpr stmts body]
-      where
-       	stmts | is_infix 	  = infix_stmts
-     	      | length labels > 0 = lbl_stmts
-     	      | otherwise	  = prefix_stmts
-     
-	body = result_expr data_con as_needed
-	con_str = data_con_str data_con
-	
-       	prefix_stmts		-- T a b c
-       	  = [bindLex (ident_pat (wrapOpParens con_str))]
-       	    ++ read_args
-     	 
-       	infix_stmts 		-- a %% b, or  a `T` b 
-       	  = [read_a1]
-   	    ++	(if isSym con_str
-		 then [bindLex (symbol_pat con_str)]
-		 else [read_punc "`", bindLex (ident_pat con_str), read_punc "`"])
-	    ++ [read_a2]
-     
-       	lbl_stmts		-- T { f1 = a, f2 = b }
-       	  = [bindLex (ident_pat (wrapOpParens con_str)),
-       	     read_punc "{"]
-       	    ++ concat (intersperse [read_punc ","] field_stmts)
-       	    ++ [read_punc "}"]
-     
-       	field_stmts  = zipWithEqual "lbl_stmts" read_field labels as_needed
-     
-       	con_arity    = dataConSourceArity data_con
-       	labels       = dataConFieldLabels data_con
-       	dc_nm	     = getName data_con
-       	is_infix     = dataConIsInfix data_con
-       	as_needed    = take con_arity as_RDRs
-	read_args    = zipWithEqual "gen_Read_binds" read_arg as_needed (dataConOrigArgTys data_con)
-       	(read_a1:read_a2:_) = read_args
-       	prec 	     = getPrec is_infix get_fixity dc_nm
-
-    ------------------------------------------------------------------------
-    --		Helpers
-    ------------------------------------------------------------------------
-    mk_alt e1 e2     = genOpApp e1 alt_RDR e2
-    bindLex pat	     = noLoc (mkBindStmt pat (nlHsVar lexP_RDR))
-    con_app c as     = nlHsVarApps (getRdrName c) as
-    result_expr c as = nlHsApp (nlHsVar returnM_RDR) (con_app c as)
-    
-    punc_pat s   = nlConPat punc_RDR   [nlLitPat (mkHsString s)]  -- Punc 'c'
-    ident_pat s  = nlConPat ident_RDR  [nlLitPat (mkHsString s)]  -- Ident "foo"
-    symbol_pat s = nlConPat symbol_RDR [nlLitPat (mkHsString s)]  -- Symbol ">>"
-    
-    data_con_str con = occNameString (getOccName con)
-    
-    read_punc c = bindLex (punc_pat c)
-    read_arg a ty 
-	| isUnLiftedType ty = pprPanic "Error in deriving:" (text "Can't read unlifted types yet:" <+> ppr ty)
-	| otherwise = noLoc (mkBindStmt (nlVarPat a) (nlHsVarApps step_RDR [readPrec_RDR]))
-    
-    read_field lbl a = read_lbl lbl ++
-    		       [read_punc "=",
-    		        noLoc (mkBindStmt (nlVarPat a) (nlHsVarApps reset_RDR [readPrec_RDR]))]
-
-	-- When reading field labels we might encounter
-	-- 	a  = 3
-	-- 	_a = 3
-	-- or	(#) = 4
-	-- Note the parens!
-    read_lbl lbl | isSym lbl_str 
-		 = [read_punc "(", 
-		    bindLex (symbol_pat lbl_str),
-		    read_punc ")"]
-		 | otherwise
-		 = [bindLex (ident_pat lbl_str)]
-		 where	
-		   lbl_str = occNameString (getOccName lbl) 
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsubsection{Generating @Show@ instance declarations}
-%*									*
-%************************************************************************
-
-Example
-
-    infixr 5 :^:
-
-    data Tree a =  Leaf a  |  Tree a :^: Tree a
-
-    instance (Show a) => Show (Tree a) where
-
-        showsPrec d (Leaf m) = showParen (d > app_prec) showStr
-          where
-             showStr = showString "Leaf " . showsPrec (app_prec+1) m
-
-        showsPrec d (u :^: v) = showParen (d > up_prec) showStr
-          where
-             showStr = showsPrec (up_prec+1) u . 
-                       showString " :^: "      .
-                       showsPrec (up_prec+1) v
-                -- Note: right-associativity of :^: ignored
-
-    up_prec  = 5    -- Precedence of :^:
-    app_prec = 10   -- Application has precedence one more than
-		    -- the most tightly-binding operator
-
-\begin{code}
-gen_Show_binds :: FixityEnv -> TyCon -> LHsBinds RdrName
-
-gen_Show_binds get_fixity tycon
-  = listToBag [shows_prec, show_list]
-  where
-    tycon_loc = getSrcSpan tycon
-    -----------------------------------------------------------------------
-    show_list = mkVarBind tycon_loc showList_RDR
-		  (nlHsApp (nlHsVar showList___RDR) (nlHsPar (nlHsApp (nlHsVar showsPrec_RDR) (nlHsIntLit 0))))
-    -----------------------------------------------------------------------
-    shows_prec = mk_FunBind tycon_loc showsPrec_RDR (map pats_etc (tyConDataCons tycon))
-      where
-	pats_etc data_con
-	  | nullary_con =  -- skip the showParen junk...
-	     ASSERT(null bs_needed)
-	     ([nlWildPat, con_pat], mk_showString_app con_str)
-	  | otherwise   =
-	     ([a_Pat, con_pat],
-		  showParen_Expr (nlHsPar (genOpApp a_Expr ge_RDR (nlHsLit (HsInt con_prec_plus_one))))
-				 (nlHsPar (nested_compose_Expr show_thingies)))
-	    where
-	     data_con_RDR  = getRdrName data_con
-	     con_arity     = dataConSourceArity data_con
-	     bs_needed     = take con_arity bs_RDRs
-	     arg_tys       = dataConOrigArgTys data_con		-- Correspond 1-1 with bs_needed
-	     con_pat       = nlConVarPat data_con_RDR bs_needed
-	     nullary_con   = con_arity == 0
-             labels        = dataConFieldLabels data_con
-	     lab_fields    = length labels
-	     record_syntax = lab_fields > 0
-
-	     dc_nm	    = getName data_con
-	     dc_occ_nm	    = getOccName data_con
-             con_str        = occNameString dc_occ_nm
-	     op_con_str     = wrapOpParens con_str
-	     backquote_str  = wrapOpBackquotes con_str
-
-	     show_thingies 
-		| is_infix     	= [show_arg1, mk_showString_app (" " ++ backquote_str ++ " "), show_arg2]
-		| record_syntax = mk_showString_app (op_con_str ++ " {") : 
-				  show_record_args ++ [mk_showString_app "}"]
-		| otherwise	= mk_showString_app (op_con_str ++ " ") : show_prefix_args
-                
-	     show_label l = mk_showString_app (nm ++ " = ")
-			-- Note the spaces around the "=" sign.  If we don't have them
-			-- then we get Foo { x=-1 } and the "=-" parses as a single
-			-- lexeme.  Only the space after the '=' is necessary, but
-			-- it seems tidier to have them both sides.
-		 where
-		   occ_nm   = getOccName l
-		   nm       = wrapOpParens (occNameString occ_nm)
-
-             show_args 		     = zipWith show_arg bs_needed arg_tys
-	     (show_arg1:show_arg2:_) = show_args
-	     show_prefix_args	     = intersperse (nlHsVar showSpace_RDR) show_args
-
-		--  Assumption for record syntax: no of fields == no of labelled fields 
-		--            (and in same order)
-	     show_record_args = concat $
-				intersperse [mk_showString_app ", "] $
-				[ [show_label lbl, arg] 
-				| (lbl,arg) <- zipEqual "gen_Show_binds" 
-							labels show_args ]
-			       
-		-- Generates (showsPrec p x) for argument x, but it also boxes
-		-- the argument first if necessary.  Note that this prints unboxed
-		-- things without any '#' decorations; could change that if need be
-	     show_arg b arg_ty = nlHsApps showsPrec_RDR [nlHsLit (HsInt arg_prec), 
-							 box_if_necy "Show" tycon (nlHsVar b) arg_ty]
-
-		-- Fixity stuff
-	     is_infix = dataConIsInfix data_con
-             con_prec_plus_one = 1 + getPrec is_infix get_fixity dc_nm
-	     arg_prec | record_syntax = 0	-- Record fields don't need parens
-		      | otherwise     = con_prec_plus_one
-
-wrapOpParens :: String -> String
-wrapOpParens s | isSym s   = '(' : s ++ ")"
-	       | otherwise = s
-
-wrapOpBackquotes :: String -> String
-wrapOpBackquotes s | isSym s   = s
-		   | otherwise = '`' : s ++ "`"
-
-isSym :: String -> Bool
-isSym ""     = False
-isSym (c:cs) = startsVarSym c || startsConSym c
-
-mk_showString_app str = nlHsApp (nlHsVar showString_RDR) (nlHsLit (mkHsString str))
-\end{code}
-
-\begin{code}
-getPrec :: Bool -> FixityEnv -> Name -> Integer
-getPrec is_infix get_fixity nm 
-  | not is_infix   = appPrecedence
-  | otherwise      = getPrecedence get_fixity nm
-		  
-appPrecedence :: Integer
-appPrecedence = fromIntegral maxPrecedence + 1
-  -- One more than the precedence of the most 
-  -- tightly-binding operator
-
-getPrecedence :: FixityEnv -> Name -> Integer
-getPrecedence get_fixity nm 
-   = case lookupFixity get_fixity nm of
-        Fixity x _ -> fromIntegral x
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Typeable}
-%*									*
-%************************************************************************
-
-From the data type
-
-	data T a b = ....
-
-we generate
-
-	instance Typeable2 T where
-		typeOf2 _ = mkTyConApp (mkTyConRep "T") []
-
-We are passed the Typeable2 class as well as T
-
-\begin{code}
-gen_Typeable_binds :: TyCon -> LHsBinds RdrName
-gen_Typeable_binds tycon
-  = unitBag $
-	mk_easy_FunBind tycon_loc 
-		(mk_typeOf_RDR tycon) 	-- Name of appropriate type0f function
-		[nlWildPat] 
-		(nlHsApps mkTypeRep_RDR [tycon_rep, nlList []])
-  where
-    tycon_loc = getSrcSpan tycon
-    tycon_rep = nlHsVar mkTyConRep_RDR `nlHsApp` nlHsLit (mkHsString (showSDoc (ppr tycon)))
-
-mk_typeOf_RDR :: TyCon -> RdrName
--- Use the arity of the TyCon to make the right typeOfn function
-mk_typeOf_RDR tycon = varQual_RDR tYPEABLE (mkFastString ("typeOf" ++ suffix))
-		where
-		  arity = tyConArity tycon
-		  suffix | arity == 0 = ""
-			 | otherwise  = show arity
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Data}
-%*									*
-%************************************************************************
-
-From the data type
-
-  data T a b = T1 a b | T2
-
-we generate
-
-  $cT1 = mkDataCon $dT "T1" Prefix
-  $cT2 = mkDataCon $dT "T2" Prefix
-  $dT  = mkDataType "Module.T" [] [$con_T1, $con_T2]
-  -- the [] is for field labels.
-
-  instance (Data a, Data b) => Data (T a b) where
-    gfoldl k z (T1 a b) = z T `k` a `k` b
-    gfoldl k z T2	    = z T2
-    -- ToDo: add gmapT,Q,M, gfoldr
- 
-    gunfold k z c = case conIndex c of
-	    		I# 1# -> k (k (z T1))
-    			I# 2# -> z T2
-
-    toConstr (T1 _ _) = $cT1
-    toConstr T2	      = $cT2
-    
-    dataTypeOf _ = $dT
-
-\begin{code}
-gen_Data_binds :: FixityEnv
-	       -> TyCon 
-	       -> (LHsBinds RdrName,	-- The method bindings
-		   LHsBinds RdrName)	-- Auxiliary bindings
-gen_Data_binds fix_env tycon
-  = (listToBag [gfoldl_bind, gunfold_bind, toCon_bind, dataTypeOf_bind],
-		-- Auxiliary definitions: the data type and constructors
-     datatype_bind `consBag` listToBag (map mk_con_bind data_cons))
-  where
-    tycon_loc  = getSrcSpan tycon
-    tycon_name = tyConName tycon
-    data_cons  = tyConDataCons tycon
-    n_cons     = length data_cons
-    one_constr = n_cons == 1
-
-	------------ gfoldl
-    gfoldl_bind = mk_FunBind tycon_loc gfoldl_RDR (map gfoldl_eqn data_cons)
-    gfoldl_eqn con = ([nlVarPat k_RDR, nlVarPat z_RDR, nlConVarPat con_name as_needed], 
-		       foldl mk_k_app (nlHsVar z_RDR `nlHsApp` nlHsVar con_name) as_needed)
-		   where
-		     con_name ::  RdrName
-		     con_name = getRdrName con
-		     as_needed = take (dataConSourceArity con) as_RDRs
-		     mk_k_app e v = nlHsPar (nlHsOpApp e k_RDR (nlHsVar v))
-
-	------------ gunfold
-    gunfold_bind = mk_FunBind tycon_loc
-                              gunfold_RDR
-                              [([k_Pat, z_Pat, if one_constr then nlWildPat else c_Pat], 
-				gunfold_rhs)]
-
-    gunfold_rhs 
-	| one_constr = mk_unfold_rhs (head data_cons)	-- No need for case
-	| otherwise  = nlHsCase (nlHsVar conIndex_RDR `nlHsApp` c_Expr) 
-			        (map gunfold_alt data_cons)
-
-    gunfold_alt dc = mkSimpleHsAlt (mk_unfold_pat dc) (mk_unfold_rhs dc)
-    mk_unfold_rhs dc = foldr nlHsApp
-                           (nlHsVar z_RDR `nlHsApp` nlHsVar (getRdrName dc))
-                           (replicate (dataConSourceArity dc) (nlHsVar k_RDR))
-
-    mk_unfold_pat dc	-- Last one is a wild-pat, to avoid 
-			-- redundant test, and annoying warning
-      | tag-fIRST_TAG == n_cons-1 = nlWildPat	-- Last constructor
-      | otherwise = nlConPat intDataCon_RDR [nlLitPat (HsIntPrim (toInteger tag))]
-      where 
-	tag = dataConTag dc
-			  
-	------------ toConstr
-    toCon_bind = mk_FunBind tycon_loc toConstr_RDR (map to_con_eqn data_cons)
-    to_con_eqn dc = ([nlWildConPat dc], nlHsVar (mk_constr_name dc))
-    
-	------------ dataTypeOf
-    dataTypeOf_bind = mk_easy_FunBind
-                        tycon_loc
-                        dataTypeOf_RDR
-			[nlWildPat]
-                        (nlHsVar data_type_name)
-
-	------------  $dT
-
-    data_type_name = mkDerivedRdrName tycon_name mkDataTOcc
-    datatype_bind  = mkVarBind
-                       tycon_loc
-                       data_type_name
-		       (           nlHsVar mkDataType_RDR 
-                         `nlHsApp` nlHsLit (mkHsString (showSDoc (ppr tycon)))
-                         `nlHsApp` nlList constrs
-                       )
-    constrs = [nlHsVar (mk_constr_name con) | con <- data_cons]
-
-
-	------------  $cT1 etc
-    mk_constr_name con = mkDerivedRdrName (dataConName con) mkDataCOcc
-    mk_con_bind dc = mkVarBind
-                       tycon_loc
-                       (mk_constr_name dc) 
-		       (nlHsApps mkConstr_RDR (constr_args dc))
-    constr_args dc =
-	 [ -- nlHsIntLit (toInteger (dataConTag dc)),		-- Tag
-	   nlHsVar data_type_name,				-- DataType
-	   nlHsLit (mkHsString (occNameString dc_occ)),	-- String name
-           nlList  labels,					-- Field labels
-	   nlHsVar fixity]					-- Fixity
-	where
-          labels   = map (nlHsLit . mkHsString . getOccString)
-                         (dataConFieldLabels dc)
-	  dc_occ   = getOccName dc
-	  is_infix = isDataSymOcc dc_occ
-	  fixity | is_infix  = infix_RDR
-		 | otherwise = prefix_RDR
-
-gfoldl_RDR     = varQual_RDR gENERICS FSLIT("gfoldl")
-gunfold_RDR    = varQual_RDR gENERICS FSLIT("gunfold")
-toConstr_RDR   = varQual_RDR gENERICS FSLIT("toConstr")
-dataTypeOf_RDR = varQual_RDR gENERICS FSLIT("dataTypeOf")
-mkConstr_RDR   = varQual_RDR gENERICS FSLIT("mkConstr")
-mkDataType_RDR = varQual_RDR gENERICS FSLIT("mkDataType")
-conIndex_RDR   = varQual_RDR gENERICS FSLIT("constrIndex")
-prefix_RDR     = dataQual_RDR gENERICS FSLIT("Prefix")
-infix_RDR      = dataQual_RDR gENERICS FSLIT("Infix")
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Generating extra binds (@con2tag@ and @tag2con@)}
-%*									*
-%************************************************************************
-
-\begin{verbatim}
-data Foo ... = ...
-
-con2tag_Foo :: Foo ... -> Int#
-tag2con_Foo :: Int -> Foo ...	-- easier if Int, not Int#
-maxtag_Foo  :: Int		-- ditto (NB: not unlifted)
-\end{verbatim}
-
-The `tags' here start at zero, hence the @fIRST_TAG@ (currently one)
-fiddling around.
-
-\begin{code}
-data TagThingWanted
-  = GenCon2Tag | GenTag2Con | GenMaxTag
-
-gen_tag_n_con_monobind
-    :: ( RdrName,	    -- (proto)Name for the thing in question
-	TyCon,		    -- tycon in question
-	TagThingWanted)
-    -> LHsBind RdrName
-
-gen_tag_n_con_monobind (rdr_name, tycon, GenCon2Tag)
-  | lots_of_constructors
-  = mk_FunBind tycon_loc rdr_name [([], get_tag_rhs)]
-
-  | otherwise
-  = mk_FunBind tycon_loc rdr_name (map mk_stuff (tyConDataCons tycon))
-
-  where
-    tycon_loc = getSrcSpan tycon
-
-    tvs = map (mkRdrUnqual . getOccName) (tyConTyVars tycon)
-	-- We can't use gerRdrName because that makes an Exact  RdrName
-	-- and we can't put them in the LocalRdrEnv
-
-	-- Give a signature to the bound variable, so 
-	-- that the case expression generated by getTag is
-	-- monomorphic.  In the push-enter model we get better code.
-    get_tag_rhs = noLoc $ ExprWithTySig 
-			(nlHsLam (mkSimpleHsAlt (nlVarPat a_RDR) 
-					      (nlHsApp (nlHsVar getTag_RDR) a_Expr)))
-			(noLoc (mkExplicitHsForAllTy (map (noLoc.UserTyVar) tvs) (noLoc []) con2tag_ty))
-
-    con2tag_ty = foldl nlHsAppTy (nlHsTyVar (getRdrName tycon)) 
-		       (map nlHsTyVar tvs)
-		`nlHsFunTy` 
-		nlHsTyVar (getRdrName intPrimTyCon)
-
-    lots_of_constructors = tyConFamilySize tycon > mAX_FAMILY_SIZE_FOR_VEC_RETURNS
-
-    mk_stuff :: DataCon -> ([LPat RdrName], LHsExpr RdrName)
-    mk_stuff con = ([nlWildConPat con], 
-		    nlHsLit (HsIntPrim (toInteger ((dataConTag con) - fIRST_TAG))))
-
-gen_tag_n_con_monobind (rdr_name, tycon, GenTag2Con)
-  = mk_FunBind (getSrcSpan tycon) rdr_name 
-	[([nlConVarPat intDataCon_RDR [a_RDR]], 
-	   noLoc (ExprWithTySig (nlHsApp (nlHsVar tagToEnum_RDR) a_Expr) 
-			 (nlHsTyVar (getRdrName tycon))))]
-
-gen_tag_n_con_monobind (rdr_name, tycon, GenMaxTag)
-  = mkVarBind (getSrcSpan tycon) rdr_name 
-		  (nlHsApp (nlHsVar intDataCon_RDR) (nlHsLit (HsIntPrim max_tag)))
-  where
-    max_tag =  case (tyConDataCons tycon) of
-		 data_cons -> toInteger ((length data_cons) - fIRST_TAG)
-
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Utility bits for generating bindings}
-%*									*
-%************************************************************************
-
-
-ToDo: Better SrcLocs.
-
-\begin{code}
-compare_gen_Case ::
-	  LHsExpr RdrName	-- What to do for equality
-	  -> LHsExpr RdrName -> LHsExpr RdrName
-	  -> LHsExpr RdrName
-careful_compare_Case :: -- checks for primitive types...
-	  TyCon			-- The tycon we are deriving for
-	  -> Type
-	  -> LHsExpr RdrName	-- What to do for equality
-	  -> LHsExpr RdrName -> LHsExpr RdrName
-	  -> LHsExpr RdrName
-
-cmp_eq_Expr a b = nlHsApp (nlHsApp (nlHsVar cmp_eq_RDR) a) b
-	-- Was: compare_gen_Case cmp_eq_RDR
-
-compare_gen_Case (L _ (HsVar eq_tag)) a b | eq_tag == eqTag_RDR
-  = nlHsApp (nlHsApp (nlHsVar compare_RDR) a) b	-- Simple case 
-compare_gen_Case eq a b				-- General case
-  = nlHsCase (nlHsPar (nlHsApp (nlHsApp (nlHsVar compare_RDR) a) b)) {-of-}
-      [mkSimpleHsAlt (nlNullaryConPat ltTag_RDR) ltTag_Expr,
-       mkSimpleHsAlt (nlNullaryConPat eqTag_RDR) eq,
-       mkSimpleHsAlt (nlNullaryConPat gtTag_RDR) gtTag_Expr]
-
-careful_compare_Case tycon ty eq a b
-  | not (isUnLiftedType ty)
-  = compare_gen_Case eq a b
-  | otherwise      -- We have to do something special for primitive things...
-  = nlHsIf (genOpApp a relevant_eq_op b)
-	 eq
-	 (nlHsIf (genOpApp a relevant_lt_op b) ltTag_Expr gtTag_Expr)
-  where
-    relevant_eq_op = primOpRdrName (assoc_ty_id "Ord" tycon eq_op_tbl ty)
-    relevant_lt_op = primOpRdrName (assoc_ty_id "Ord" tycon lt_op_tbl ty)
-
-
-box_if_necy :: String		-- The class involved
-	    -> TyCon		-- The tycon involved
-	    -> LHsExpr RdrName	-- The argument
-	    -> Type		-- The argument type
-	    -> LHsExpr RdrName	-- Boxed version of the arg
-box_if_necy cls_str tycon arg arg_ty
-  | isUnLiftedType arg_ty = nlHsApp (nlHsVar box_con) arg
-  | otherwise		  = arg
-  where
-    box_con = assoc_ty_id cls_str tycon box_con_tbl arg_ty
-
-assoc_ty_id :: String		-- The class involved
-	    -> TyCon		-- The tycon involved
-	    -> [(Type,a)]	-- The table
-	    -> Type		-- The type
-	    -> a		-- The result of the lookup
-assoc_ty_id cls_str tycon tbl ty 
-  | null res = pprPanic "Error in deriving:" (text "Can't derive" <+> text cls_str <+> 
-					      text "for primitive type" <+> ppr ty)
-  | otherwise = head res
-  where
-    res = [id | (ty',id) <- tbl, ty `tcEqType` ty']
-
-eq_op_tbl :: [(Type, PrimOp)]
-eq_op_tbl =
-    [(charPrimTy,	CharEqOp)
-    ,(intPrimTy,	IntEqOp)
-    ,(wordPrimTy,	WordEqOp)
-    ,(addrPrimTy,	AddrEqOp)
-    ,(floatPrimTy,	FloatEqOp)
-    ,(doublePrimTy,	DoubleEqOp)
-    ]
-
-lt_op_tbl :: [(Type, PrimOp)]
-lt_op_tbl =
-    [(charPrimTy,	CharLtOp)
-    ,(intPrimTy,	IntLtOp)
-    ,(wordPrimTy,	WordLtOp)
-    ,(addrPrimTy,	AddrLtOp)
-    ,(floatPrimTy,	FloatLtOp)
-    ,(doublePrimTy,	DoubleLtOp)
-    ]
-
-box_con_tbl =
-    [(charPrimTy,	getRdrName charDataCon)
-    ,(intPrimTy,	getRdrName intDataCon)
-    ,(wordPrimTy,	wordDataCon_RDR)
-    ,(addrPrimTy,	addrDataCon_RDR)
-    ,(floatPrimTy,	getRdrName floatDataCon)
-    ,(doublePrimTy,	getRdrName doubleDataCon)
-    ]
-
------------------------------------------------------------------------
-
-and_Expr :: LHsExpr RdrName -> LHsExpr RdrName -> LHsExpr RdrName
-and_Expr a b = genOpApp a and_RDR    b
-
------------------------------------------------------------------------
-
-eq_Expr :: TyCon -> Type -> LHsExpr RdrName -> LHsExpr RdrName -> LHsExpr RdrName
-eq_Expr tycon ty a b = genOpApp a eq_op b
- where
-   eq_op
-    | not (isUnLiftedType ty) = eq_RDR
-    | otherwise               = primOpRdrName (assoc_ty_id "Eq" tycon eq_op_tbl ty)
-         -- we have to do something special for primitive things...
-\end{code}
-
-\begin{code}
-untag_Expr :: TyCon -> [( RdrName,  RdrName)] -> LHsExpr RdrName -> LHsExpr RdrName
-untag_Expr tycon [] expr = expr
-untag_Expr tycon ((untag_this, put_tag_here) : more) expr
-  = nlHsCase (nlHsPar (nlHsVarApps (con2tag_RDR tycon) [untag_this])) {-of-}
-      [mkSimpleHsAlt (nlVarPat put_tag_here) (untag_Expr tycon more expr)]
-
-cmp_tags_Expr ::  RdrName 		-- Comparison op
-	     ->  RdrName ->  RdrName	-- Things to compare
-	     -> LHsExpr RdrName 		-- What to return if true
-	     -> LHsExpr RdrName		-- What to return if false
-	     -> LHsExpr RdrName
-
-cmp_tags_Expr op a b true_case false_case
-  = nlHsIf (genOpApp (nlHsVar a) op (nlHsVar b)) true_case false_case
-
-enum_from_to_Expr
-	:: LHsExpr RdrName -> LHsExpr RdrName
-	-> LHsExpr RdrName
-enum_from_then_to_Expr
-	:: LHsExpr RdrName -> LHsExpr RdrName -> LHsExpr RdrName
-	-> LHsExpr RdrName
-
-enum_from_to_Expr      f   t2 = nlHsApp (nlHsApp (nlHsVar enumFromTo_RDR) f) t2
-enum_from_then_to_Expr f t t2 = nlHsApp (nlHsApp (nlHsApp (nlHsVar enumFromThenTo_RDR) f) t) t2
-
-showParen_Expr
-	:: LHsExpr RdrName -> LHsExpr RdrName
-	-> LHsExpr RdrName
-
-showParen_Expr e1 e2 = nlHsApp (nlHsApp (nlHsVar showParen_RDR) e1) e2
-
-nested_compose_Expr :: [LHsExpr RdrName] -> LHsExpr RdrName
-
-nested_compose_Expr [e] = parenify e
-nested_compose_Expr (e:es)
-  = nlHsApp (nlHsApp (nlHsVar compose_RDR) (parenify e)) (nested_compose_Expr es)
-
--- impossible_Expr is used in case RHSs that should never happen.
--- We generate these to keep the desugarer from complaining that they *might* happen!
-impossible_Expr = nlHsApp (nlHsVar error_RDR) (nlHsLit (mkHsString "Urk! in TcGenDeriv"))
-
--- illegal_Expr is used when signalling error conditions in the RHS of a derived
--- method. It is currently only used by Enum.{succ,pred}
-illegal_Expr meth tp msg = 
-   nlHsApp (nlHsVar error_RDR) (nlHsLit (mkHsString (meth ++ '{':tp ++ "}: " ++ msg)))
-
--- illegal_toEnum_tag is an extended version of illegal_Expr, which also allows you
--- to include the value of a_RDR in the error string.
-illegal_toEnum_tag tp maxtag =
-   nlHsApp (nlHsVar error_RDR) 
-           (nlHsApp (nlHsApp (nlHsVar append_RDR)
-	               (nlHsLit (mkHsString ("toEnum{" ++ tp ++ "}: tag ("))))
-	            (nlHsApp (nlHsApp (nlHsApp 
-		           (nlHsVar showsPrec_RDR)
-			   (nlHsIntLit 0))
-   		           (nlHsVar a_RDR))
-			   (nlHsApp (nlHsApp 
-			       (nlHsVar append_RDR)
-			       (nlHsLit (mkHsString ") is outside of enumeration's range (0,")))
-			       (nlHsApp (nlHsApp (nlHsApp 
-					(nlHsVar showsPrec_RDR)
-				        (nlHsIntLit 0))
-					(nlHsVar maxtag))
-					(nlHsLit (mkHsString ")"))))))
-
-parenify e@(L _ (HsVar _)) = e
-parenify e	           = mkHsPar e
-
--- genOpApp wraps brackets round the operator application, so that the
--- renamer won't subsequently try to re-associate it. 
-genOpApp e1 op e2 = nlHsPar (nlHsOpApp e1 op e2)
-\end{code}
-
-\begin{code}
-getSrcSpan = srcLocSpan . getSrcLoc
-\end{code}
-
-\begin{code}
-a_RDR		= mkVarUnqual FSLIT("a")
-b_RDR		= mkVarUnqual FSLIT("b")
-c_RDR		= mkVarUnqual FSLIT("c")
-d_RDR		= mkVarUnqual FSLIT("d")
-k_RDR		= mkVarUnqual FSLIT("k")
-z_RDR		= mkVarUnqual FSLIT("z")
-ah_RDR		= mkVarUnqual FSLIT("a#")
-bh_RDR		= mkVarUnqual FSLIT("b#")
-ch_RDR		= mkVarUnqual FSLIT("c#")
-dh_RDR		= mkVarUnqual FSLIT("d#")
-cmp_eq_RDR	= mkVarUnqual FSLIT("cmp_eq")
-
-as_RDRs		= [ mkVarUnqual (mkFastString ("a"++show i)) | i <- [(1::Int) .. ] ]
-bs_RDRs		= [ mkVarUnqual (mkFastString ("b"++show i)) | i <- [(1::Int) .. ] ]
-cs_RDRs		= [ mkVarUnqual (mkFastString ("c"++show i)) | i <- [(1::Int) .. ] ]
-
-a_Expr		= nlHsVar a_RDR
-b_Expr		= nlHsVar b_RDR
-c_Expr		= nlHsVar c_RDR
-ltTag_Expr	= nlHsVar ltTag_RDR
-eqTag_Expr	= nlHsVar eqTag_RDR
-gtTag_Expr	= nlHsVar gtTag_RDR
-false_Expr	= nlHsVar false_RDR
-true_Expr	= nlHsVar true_RDR
-
-a_Pat		= nlVarPat a_RDR
-b_Pat		= nlVarPat b_RDR
-c_Pat		= nlVarPat c_RDR
-d_Pat		= nlVarPat d_RDR
-k_Pat		= nlVarPat k_RDR
-z_Pat		= nlVarPat z_RDR
-
-con2tag_RDR, tag2con_RDR, maxtag_RDR :: TyCon ->  RdrName
--- Generates Orig s RdrName, for the binding positions
-con2tag_RDR tycon = mk_tc_deriv_name tycon "con2tag_"
-tag2con_RDR tycon = mk_tc_deriv_name tycon "tag2con_"
-maxtag_RDR  tycon = mk_tc_deriv_name tycon "maxtag_"
-
-mk_tc_deriv_name tycon str 
-  = mkDerivedRdrName tc_name mk_occ
-  where
-    tc_name = tyConName tycon
-    mk_occ tc_occ = mkVarOccFS (mkFastString new_str)
-		  where
-		    new_str = str ++ occNameString tc_occ ++ "#"
-\end{code}
-
-s RdrName for PrimOps.  Can't be done in PrelNames, because PrimOp imports
-PrelNames, so PrelNames can't import PrimOp.
-
-\begin{code}
-primOpRdrName op = getRdrName (primOpId op)
-
-minusInt_RDR  = primOpRdrName IntSubOp
-eqInt_RDR     = primOpRdrName IntEqOp
-ltInt_RDR     = primOpRdrName IntLtOp
-geInt_RDR     = primOpRdrName IntGeOp
-leInt_RDR     = primOpRdrName IntLeOp
-tagToEnum_RDR = primOpRdrName TagToEnumOp
-
-error_RDR = getRdrName eRROR_ID
-\end{code}
diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs
deleted file mode 100644
index 6389f34aef..0000000000
--- a/ghc/compiler/typecheck/TcHsSyn.lhs
+++ /dev/null
@@ -1,961 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1996-1998
-%
-\section[TcHsSyn]{Specialisations of the @HsSyn@ syntax for the typechecker}
-
-This module is an extension of @HsSyn@ syntax, for use in the type
-checker.
-
-\begin{code}
-module TcHsSyn (
-	mkHsTyApp, mkHsDictApp, mkHsConApp,
-	mkHsTyLam, mkHsDictLam, mkHsDictLet, mkHsApp,
-	hsLitType, hsPatType, mkHsAppTy, mkSimpleHsAlt,
-	nlHsIntLit, mkVanillaTuplePat,
-	
-
-	-- re-exported from TcMonad
-	TcId, TcIdSet, TcDictBinds,
-
-	zonkTopDecls, zonkTopExpr, zonkTopLExpr,
-	zonkId, zonkTopBndrs
-  ) where
-
-#include "HsVersions.h"
-
--- friends:
-import HsSyn	-- oodles of it
-
--- others:
-import Id	( idType, setIdType, Id )
-
-import TcRnMonad
-import Type	  ( Type )
-import TcType	  ( TcType, TcTyVar, mkTyVarTy, mkTyConApp, isImmutableTyVar )
-import Kind	  ( isLiftedTypeKind, liftedTypeKind, isSubKind )
-import qualified  Type
-import TcMType	  ( zonkQuantifiedTyVar, zonkType, zonkTcType, writeMetaTyVar )
-import TysPrim	  ( charPrimTy, intPrimTy, floatPrimTy,
-		    doublePrimTy, addrPrimTy
-		  )
-import TysWiredIn ( charTy, stringTy, intTy, 
-		    mkListTy, mkPArrTy, mkTupleTy, unitTy,
-		    voidTy, listTyCon, tupleTyCon )
-import TyCon	  ( mkPrimTyCon, tyConKind, PrimRep(..) )
-import Kind	  ( splitKindFunTys )
-import Name	  ( Name, getOccName, mkInternalName, mkDerivedTyConOcc )
-import Var	  ( Var, isId, isLocalVar, tyVarKind )
-import VarSet
-import VarEnv
-import BasicTypes ( Boxity(..), IPName(..), ipNameName, mapIPName )
-import Maybes	  ( orElse )
-import Unique	  ( Uniquable(..) )
-import SrcLoc	  ( noSrcLoc, noLoc, Located(..), unLoc )
-import Util	  ( mapSnd )
-import Bag
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[mkFailurePair]{Code for pattern-matching and other failures}
-%*									*
-%************************************************************************
-
-Note: If @hsPatType@ doesn't bear a strong resemblance to @exprType@,
-then something is wrong.
-\begin{code}
-mkVanillaTuplePat :: [OutPat Id] -> Boxity -> Pat Id
--- A vanilla tuple pattern simply gets its type from its sub-patterns
-mkVanillaTuplePat pats box 
-  = TuplePat pats box (mkTupleTy box (length pats) (map hsPatType pats))
-
-hsPatType :: OutPat Id -> Type
-hsPatType (L _ pat) = pat_type pat
-
-pat_type (ParPat pat)		   = hsPatType pat
-pat_type (WildPat ty)		   = ty
-pat_type (VarPat var)		   = idType var
-pat_type (VarPatOut var _)	   = idType var
-pat_type (BangPat pat)		   = hsPatType pat
-pat_type (LazyPat pat)		   = hsPatType pat
-pat_type (LitPat lit)		   = hsLitType lit
-pat_type (AsPat var pat)	   = idType (unLoc var)
-pat_type (ListPat _ ty)		   = mkListTy ty
-pat_type (PArrPat _ ty)		   = mkPArrTy ty
-pat_type (TuplePat pats box ty)	   = ty
-pat_type (ConPatOut _ _ _ _ _ ty)  = ty
-pat_type (SigPatOut pat ty)	   = ty
-pat_type (NPat lit _ _ ty)	   = ty
-pat_type (NPlusKPat id _ _ _)      = idType (unLoc id)
-pat_type (DictPat ds ms)           = case (ds ++ ms) of
-				       []  -> unitTy
-				       [d] -> idType d
-				       ds  -> mkTupleTy Boxed (length ds) (map idType ds)
-
-
-hsLitType :: HsLit -> TcType
-hsLitType (HsChar c)       = charTy
-hsLitType (HsCharPrim c)   = charPrimTy
-hsLitType (HsString str)   = stringTy
-hsLitType (HsStringPrim s) = addrPrimTy
-hsLitType (HsInt i)	   = intTy
-hsLitType (HsIntPrim i)    = intPrimTy
-hsLitType (HsInteger i ty) = ty
-hsLitType (HsRat _ ty)	   = ty
-hsLitType (HsFloatPrim f)  = floatPrimTy
-hsLitType (HsDoublePrim d) = doublePrimTy
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@}
-%*									*
-%************************************************************************
-
-\begin{code}
--- zonkId is used *during* typechecking just to zonk the Id's type
-zonkId :: TcId -> TcM TcId
-zonkId id
-  = zonkTcType (idType id) `thenM` \ ty' ->
-    returnM (setIdType id ty')
-\end{code}
-
-The rest of the zonking is done *after* typechecking.
-The main zonking pass runs over the bindings
-
- a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc
- b) convert unbound TcTyVar to Void
- c) convert each TcId to an Id by zonking its type
-
-The type variables are converted by binding mutable tyvars to immutable ones
-and then zonking as normal.
-
-The Ids are converted by binding them in the normal Tc envt; that
-way we maintain sharing; eg an Id is zonked at its binding site and they
-all occurrences of that Id point to the common zonked copy
-
-It's all pretty boring stuff, because HsSyn is such a large type, and 
-the environment manipulation is tiresome.
-
-\begin{code}
-data ZonkEnv = ZonkEnv	(TcType -> TcM Type) 	-- How to zonk a type
-			(IdEnv Id)		-- What variables are in scope
-	-- Maps an Id to its zonked version; both have the same Name
-	-- Is only consulted lazily; hence knot-tying
-
-emptyZonkEnv = ZonkEnv zonkTypeZapping emptyVarEnv
-
-extendZonkEnv :: ZonkEnv -> [Id] -> ZonkEnv
-extendZonkEnv (ZonkEnv zonk_ty env) ids 
-  = ZonkEnv zonk_ty (extendVarEnvList env [(id,id) | id <- ids])
-
-extendZonkEnv1 :: ZonkEnv -> Id -> ZonkEnv
-extendZonkEnv1 (ZonkEnv zonk_ty env) id 
-  = ZonkEnv zonk_ty (extendVarEnv env id id)
-
-setZonkType :: ZonkEnv -> (TcType -> TcM Type) -> ZonkEnv
-setZonkType (ZonkEnv _ env) zonk_ty = ZonkEnv zonk_ty env
-
-zonkEnvIds :: ZonkEnv -> [Id]
-zonkEnvIds (ZonkEnv _ env) = varEnvElts env
-
-zonkIdOcc :: ZonkEnv -> TcId -> Id
--- Ids defined in this module should be in the envt; 
--- ignore others.  (Actually, data constructors are also
--- not LocalVars, even when locally defined, but that is fine.)
--- (Also foreign-imported things aren't currently in the ZonkEnv;
---  that's ok because they don't need zonking.)
---
--- Actually, Template Haskell works in 'chunks' of declarations, and
--- an earlier chunk won't be in the 'env' that the zonking phase 
--- carries around.  Instead it'll be in the tcg_gbl_env, already fully
--- zonked.  There's no point in looking it up there (except for error 
--- checking), and it's not conveniently to hand; hence the simple
--- 'orElse' case in the LocalVar branch.
---
--- Even without template splices, in module Main, the checking of
--- 'main' is done as a separate chunk.
-zonkIdOcc (ZonkEnv zonk_ty env) id 
-  | isLocalVar id = lookupVarEnv env id `orElse` id
-  | otherwise	  = id
-
-zonkIdOccs env ids = map (zonkIdOcc env) ids
-
--- zonkIdBndr is used *after* typechecking to get the Id's type
--- to its final form.  The TyVarEnv give 
-zonkIdBndr :: ZonkEnv -> TcId -> TcM Id
-zonkIdBndr env id
-  = zonkTcTypeToType env (idType id)	`thenM` \ ty' ->
-    returnM (setIdType id ty')
-
-zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]
-zonkIdBndrs env ids = mappM (zonkIdBndr env) ids
-
-zonkTopBndrs :: [TcId] -> TcM [Id]
-zonkTopBndrs ids = zonkIdBndrs emptyZonkEnv ids
-\end{code}
-
-
-\begin{code}
-zonkTopExpr :: HsExpr TcId -> TcM (HsExpr Id)
-zonkTopExpr e = zonkExpr emptyZonkEnv e
-
-zonkTopLExpr :: LHsExpr TcId -> TcM (LHsExpr Id)
-zonkTopLExpr e = zonkLExpr emptyZonkEnv e
-
-zonkTopDecls :: LHsBinds TcId -> [LRuleDecl TcId] -> [LForeignDecl TcId]
-	     -> TcM ([Id], 
-		     Bag (LHsBind  Id),
-		     [LForeignDecl Id],
-		     [LRuleDecl    Id])
-zonkTopDecls binds rules fords
-  = do	{ (env, binds') <- zonkRecMonoBinds emptyZonkEnv binds
-			-- Top level is implicitly recursive
-	; rules' <- zonkRules env rules
-	; fords' <- zonkForeignExports env fords
-	; return (zonkEnvIds env, binds', fords', rules') }
-
----------------------------------------------
-zonkLocalBinds :: ZonkEnv -> HsLocalBinds TcId -> TcM (ZonkEnv, HsLocalBinds Id)
-zonkLocalBinds env EmptyLocalBinds
-  = return (env, EmptyLocalBinds)
-
-zonkLocalBinds env (HsValBinds binds)
-  = do	{ (env1, new_binds) <- zonkValBinds env binds
-	; return (env1, HsValBinds new_binds) }
-
-zonkLocalBinds env (HsIPBinds (IPBinds binds dict_binds))
-  = mappM (wrapLocM zonk_ip_bind) binds	`thenM` \ new_binds ->
-    let
-	env1 = extendZonkEnv env [ipNameName n | L _ (IPBind n _) <- new_binds]
-    in
-    zonkRecMonoBinds env1 dict_binds 	`thenM` \ (env2, new_dict_binds) -> 
-    returnM (env2, HsIPBinds (IPBinds new_binds new_dict_binds))
-  where
-    zonk_ip_bind (IPBind n e)
-	= mapIPNameTc (zonkIdBndr env) n	`thenM` \ n' ->
-	  zonkLExpr env e			`thenM` \ e' ->
-	  returnM (IPBind n' e')
-
-
----------------------------------------------
-zonkValBinds :: ZonkEnv -> HsValBinds TcId -> TcM (ZonkEnv, HsValBinds Id)
-zonkValBinds env bs@(ValBindsIn _ _) 
-  = panic "zonkValBinds"	-- Not in typechecker output
-zonkValBinds env (ValBindsOut binds sigs) 
-  = do 	{ (env1, new_binds) <- go env binds
-	; return (env1, ValBindsOut new_binds sigs) }
-  where
-    go env []         = return (env, [])
-    go env ((r,b):bs) = do { (env1, b')  <- zonkRecMonoBinds env b
-			   ; (env2, bs') <- go env1 bs
-			   ; return (env2, (r,b'):bs') }
-
----------------------------------------------
-zonkRecMonoBinds :: ZonkEnv -> LHsBinds TcId -> TcM (ZonkEnv, LHsBinds Id)
-zonkRecMonoBinds env binds 
- = fixM (\ ~(_, new_binds) -> do 
-	{ let env1 = extendZonkEnv env (collectHsBindBinders new_binds)
-        ; binds' <- zonkMonoBinds env1 binds
-        ; return (env1, binds') })
-
----------------------------------------------
-zonkMonoBinds :: ZonkEnv -> LHsBinds TcId -> TcM (LHsBinds Id)
-zonkMonoBinds env binds = mapBagM (wrapLocM (zonk_bind env)) binds
-
-zonk_bind :: ZonkEnv -> HsBind TcId -> TcM (HsBind Id)
-zonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty})
-  = do	{ (_env, new_pat) <- zonkPat env pat		-- Env already extended
-	; new_grhss <- zonkGRHSs env grhss
-	; new_ty    <- zonkTcTypeToType env ty
-	; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss, pat_rhs_ty = new_ty }) }
-
-zonk_bind env (VarBind { var_id = var, var_rhs = expr })
-  = zonkIdBndr env var 			`thenM` \ new_var ->
-    zonkLExpr env expr			`thenM` \ new_expr ->
-    returnM (VarBind { var_id = new_var, var_rhs = new_expr })
-
-zonk_bind env bind@(FunBind { fun_id = var, fun_matches = ms, fun_co_fn = co_fn })
-  = wrapLocM (zonkIdBndr env) var	`thenM` \ new_var ->
-    zonkCoFn env co_fn			`thenM` \ (env1, new_co_fn) ->
-    zonkMatchGroup env1 ms		`thenM` \ new_ms ->
-    returnM (bind { fun_id = new_var, fun_matches = new_ms, fun_co_fn = new_co_fn })
-
-zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_dicts = dicts, 
-			  abs_exports = exports, abs_binds = val_binds })
-  = ASSERT( all isImmutableTyVar tyvars )
-    zonkIdBndrs env dicts		`thenM` \ new_dicts ->
-    fixM (\ ~(new_val_binds, _) ->
-	let
-	  env1 = extendZonkEnv env new_dicts
-	  env2 = extendZonkEnv env1 (collectHsBindBinders new_val_binds)
-	in
-	zonkMonoBinds env2 val_binds 		`thenM` \ new_val_binds ->
-        mappM (zonkExport env2) exports		`thenM` \ new_exports ->
-	returnM (new_val_binds, new_exports)
-    )						`thenM` \ (new_val_bind, new_exports) ->
-    returnM (AbsBinds { abs_tvs = tyvars, abs_dicts = new_dicts, 
-			abs_exports = new_exports, abs_binds = new_val_bind })
-  where
-    zonkExport env (tyvars, global, local, prags)
-	= zonkIdBndr env global			`thenM` \ new_global ->
-	  mapM zonk_prag prags			`thenM` \ new_prags -> 
-	  returnM (tyvars, new_global, zonkIdOcc env local, new_prags)
-    zonk_prag prag@(InlinePrag {})  = return prag
-    zonk_prag (SpecPrag expr ty ds inl) = do { expr' <- zonkExpr env expr 
-					     ; ty'   <- zonkTcTypeToType env ty
-					     ; let ds' = zonkIdOccs env ds
-					     ; return (SpecPrag expr' ty' ds' inl) }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[BackSubst-Match-GRHSs]{Match and GRHSs}
-%*									*
-%************************************************************************
-
-\begin{code}
-zonkMatchGroup :: ZonkEnv -> MatchGroup TcId-> TcM (MatchGroup Id)
-zonkMatchGroup env (MatchGroup ms ty) 
-  = do	{ ms' <- mapM (zonkMatch env) ms
-	; ty' <- zonkTcTypeToType env ty
-	; return (MatchGroup ms' ty') }
-
-zonkMatch :: ZonkEnv -> LMatch TcId-> TcM (LMatch Id)
-zonkMatch env (L loc (Match pats _ grhss))
-  = do	{ (env1, new_pats) <- zonkPats env pats
-	; new_grhss <- zonkGRHSs env1 grhss
-	; return (L loc (Match new_pats Nothing new_grhss)) }
-
--------------------------------------------------------------------------
-zonkGRHSs :: ZonkEnv -> GRHSs TcId -> TcM (GRHSs Id)
-
-zonkGRHSs env (GRHSs grhss binds)
-  = zonkLocalBinds env binds   	`thenM` \ (new_env, new_binds) ->
-    let
-	zonk_grhs (GRHS guarded rhs)
-	  = zonkStmts new_env guarded	`thenM` \ (env2, new_guarded) ->
-	    zonkLExpr env2 rhs		`thenM` \ new_rhs ->
-	    returnM (GRHS new_guarded new_rhs)
-    in
-    mappM (wrapLocM zonk_grhs) grhss 	`thenM` \ new_grhss ->
-    returnM (GRHSs new_grhss new_binds)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr}
-%*									*
-%************************************************************************
-
-\begin{code}
-zonkLExprs :: ZonkEnv -> [LHsExpr TcId] -> TcM [LHsExpr Id]
-zonkLExpr  :: ZonkEnv -> LHsExpr TcId   -> TcM (LHsExpr Id)
-zonkExpr   :: ZonkEnv -> HsExpr TcId    -> TcM (HsExpr Id)
-
-zonkLExprs env exprs = mappM (zonkLExpr env) exprs
-zonkLExpr  env expr  = wrapLocM (zonkExpr env) expr
-
-zonkExpr env (HsVar id)
-  = returnM (HsVar (zonkIdOcc env id))
-
-zonkExpr env (HsIPVar id)
-  = returnM (HsIPVar (mapIPName (zonkIdOcc env) id))
-
-zonkExpr env (HsLit (HsRat f ty))
-  = zonkTcTypeToType env ty	   `thenM` \ new_ty  ->
-    returnM (HsLit (HsRat f new_ty))
-
-zonkExpr env (HsLit lit)
-  = returnM (HsLit lit)
-
-zonkExpr env (HsOverLit lit)
-  = do	{ lit' <- zonkOverLit env lit
-	; return (HsOverLit lit') }
-
-zonkExpr env (HsLam matches)
-  = zonkMatchGroup env matches	`thenM` \ new_matches ->
-    returnM (HsLam new_matches)
-
-zonkExpr env (HsApp e1 e2)
-  = zonkLExpr env e1	`thenM` \ new_e1 ->
-    zonkLExpr env e2	`thenM` \ new_e2 ->
-    returnM (HsApp new_e1 new_e2)
-
-zonkExpr env (HsBracketOut body bs) 
-  = mappM zonk_b bs	`thenM` \ bs' ->
-    returnM (HsBracketOut body bs')
-  where
-    zonk_b (n,e) = zonkLExpr env e	`thenM` \ e' ->
-		   returnM (n,e')
-
-zonkExpr env (HsSpliceE s) = WARN( True, ppr s )	-- Should not happen
-			     returnM (HsSpliceE s)
-
-zonkExpr env (OpApp e1 op fixity e2)
-  = zonkLExpr env e1	`thenM` \ new_e1 ->
-    zonkLExpr env op	`thenM` \ new_op ->
-    zonkLExpr env e2	`thenM` \ new_e2 ->
-    returnM (OpApp new_e1 new_op fixity new_e2)
-
-zonkExpr env (NegApp expr op)
-  = zonkLExpr env expr	`thenM` \ new_expr ->
-    zonkExpr env op	`thenM` \ new_op ->
-    returnM (NegApp new_expr new_op)
-
-zonkExpr env (HsPar e)    
-  = zonkLExpr env e	`thenM` \new_e ->
-    returnM (HsPar new_e)
-
-zonkExpr env (SectionL expr op)
-  = zonkLExpr env expr	`thenM` \ new_expr ->
-    zonkLExpr env op		`thenM` \ new_op ->
-    returnM (SectionL new_expr new_op)
-
-zonkExpr env (SectionR op expr)
-  = zonkLExpr env op		`thenM` \ new_op ->
-    zonkLExpr env expr		`thenM` \ new_expr ->
-    returnM (SectionR new_op new_expr)
-
-zonkExpr env (HsCase expr ms)
-  = zonkLExpr env expr    	`thenM` \ new_expr ->
-    zonkMatchGroup env ms	`thenM` \ new_ms ->
-    returnM (HsCase new_expr new_ms)
-
-zonkExpr env (HsIf e1 e2 e3)
-  = zonkLExpr env e1	`thenM` \ new_e1 ->
-    zonkLExpr env e2	`thenM` \ new_e2 ->
-    zonkLExpr env e3	`thenM` \ new_e3 ->
-    returnM (HsIf new_e1 new_e2 new_e3)
-
-zonkExpr env (HsLet binds expr)
-  = zonkLocalBinds env binds	`thenM` \ (new_env, new_binds) ->
-    zonkLExpr new_env expr	`thenM` \ new_expr ->
-    returnM (HsLet new_binds new_expr)
-
-zonkExpr env (HsDo do_or_lc stmts body ty)
-  = zonkStmts env stmts 	`thenM` \ (new_env, new_stmts) ->
-    zonkLExpr new_env body	`thenM` \ new_body ->
-    zonkTcTypeToType env ty	`thenM` \ new_ty   ->
-    returnM (HsDo (zonkDo env do_or_lc) 
-		  new_stmts new_body new_ty)
-
-zonkExpr env (ExplicitList ty exprs)
-  = zonkTcTypeToType env ty	`thenM` \ new_ty ->
-    zonkLExprs env exprs	`thenM` \ new_exprs ->
-    returnM (ExplicitList new_ty new_exprs)
-
-zonkExpr env (ExplicitPArr ty exprs)
-  = zonkTcTypeToType env ty	`thenM` \ new_ty ->
-    zonkLExprs env exprs	`thenM` \ new_exprs ->
-    returnM (ExplicitPArr new_ty new_exprs)
-
-zonkExpr env (ExplicitTuple exprs boxed)
-  = zonkLExprs env exprs  	`thenM` \ new_exprs ->
-    returnM (ExplicitTuple new_exprs boxed)
-
-zonkExpr env (RecordCon data_con con_expr rbinds)
-  = zonkExpr env con_expr	`thenM` \ new_con_expr ->
-    zonkRbinds env rbinds	`thenM` \ new_rbinds ->
-    returnM (RecordCon data_con new_con_expr new_rbinds)
-
-zonkExpr env (RecordUpd expr rbinds in_ty out_ty)
-  = zonkLExpr env expr		`thenM` \ new_expr ->
-    zonkTcTypeToType env in_ty	`thenM` \ new_in_ty ->
-    zonkTcTypeToType env out_ty	`thenM` \ new_out_ty ->
-    zonkRbinds env rbinds	`thenM` \ new_rbinds ->
-    returnM (RecordUpd new_expr new_rbinds new_in_ty new_out_ty)
-
-zonkExpr env (ExprWithTySigOut e ty) 
-  = do { e' <- zonkLExpr env e
-       ; return (ExprWithTySigOut e' ty) }
-
-zonkExpr env (ExprWithTySig _ _) = panic "zonkExpr env:ExprWithTySig"
-
-zonkExpr env (ArithSeq expr info)
-  = zonkExpr env expr		`thenM` \ new_expr ->
-    zonkArithSeq env info	`thenM` \ new_info ->
-    returnM (ArithSeq new_expr new_info)
-
-zonkExpr env (PArrSeq expr info)
-  = zonkExpr env expr		`thenM` \ new_expr ->
-    zonkArithSeq env info	`thenM` \ new_info ->
-    returnM (PArrSeq new_expr new_info)
-
-zonkExpr env (HsSCC lbl expr)
-  = zonkLExpr env expr	`thenM` \ new_expr ->
-    returnM (HsSCC lbl new_expr)
-
--- hdaume: core annotations
-zonkExpr env (HsCoreAnn lbl expr)
-  = zonkLExpr env expr   `thenM` \ new_expr ->
-    returnM (HsCoreAnn lbl new_expr)
-
-zonkExpr env (TyLam tyvars expr)
-  = ASSERT( all isImmutableTyVar tyvars )
-    zonkLExpr env expr			`thenM` \ new_expr ->
-    returnM (TyLam tyvars new_expr)
-
-zonkExpr env (TyApp expr tys)
-  = zonkLExpr env expr    	`thenM` \ new_expr ->
-    zonkTcTypeToTypes env tys	`thenM` \ new_tys ->
-    returnM (TyApp new_expr new_tys)
-
-zonkExpr env (DictLam dicts expr)
-  = zonkIdBndrs env dicts	`thenM` \ new_dicts ->
-    let
-	env1 = extendZonkEnv env new_dicts
-    in
-    zonkLExpr env1 expr  	`thenM` \ new_expr ->
-    returnM (DictLam new_dicts new_expr)
-
-zonkExpr env (DictApp expr dicts)
-  = zonkLExpr env expr    	    	`thenM` \ new_expr ->
-    returnM (DictApp new_expr (zonkIdOccs env dicts))
-
--- arrow notation extensions
-zonkExpr env (HsProc pat body)
-  = do	{ (env1, new_pat) <- zonkPat env pat
-	; new_body <- zonkCmdTop env1 body
-	; return (HsProc new_pat new_body) }
-
-zonkExpr env (HsArrApp e1 e2 ty ho rl)
-  = zonkLExpr env e1	    	    	`thenM` \ new_e1 ->
-    zonkLExpr env e2	    	    	`thenM` \ new_e2 ->
-    zonkTcTypeToType env ty 		`thenM` \ new_ty ->
-    returnM (HsArrApp new_e1 new_e2 new_ty ho rl)
-
-zonkExpr env (HsArrForm op fixity args)
-  = zonkLExpr env op	    	    	`thenM` \ new_op ->
-    mappM (zonkCmdTop env) args		`thenM` \ new_args ->
-    returnM (HsArrForm new_op fixity new_args)
-
-zonkExpr env (HsCoerce co_fn expr)
-  = zonkCoFn env co_fn	`thenM` \ (env1, new_co_fn) ->
-    zonkExpr env1 expr	`thenM` \ new_expr ->
-    return (HsCoerce new_co_fn new_expr)
-
-zonkExpr env other = pprPanic "zonkExpr" (ppr other)
-
-zonkCmdTop :: ZonkEnv -> LHsCmdTop TcId -> TcM (LHsCmdTop Id)
-zonkCmdTop env cmd = wrapLocM (zonk_cmd_top env) cmd
-
-zonk_cmd_top env (HsCmdTop cmd stack_tys ty ids)
-  = zonkLExpr env cmd	    		`thenM` \ new_cmd ->
-    zonkTcTypeToTypes env stack_tys	`thenM` \ new_stack_tys ->
-    zonkTcTypeToType env ty 		`thenM` \ new_ty ->
-    mapSndM (zonkExpr env) ids		`thenM` \ new_ids ->
-    returnM (HsCmdTop new_cmd new_stack_tys new_ty new_ids)
-
--------------------------------------------------------------------------
-zonkCoFn :: ZonkEnv -> ExprCoFn -> TcM (ZonkEnv, ExprCoFn)
-zonkCoFn env CoHole = return (env, CoHole)
-zonkCoFn env (CoCompose c1 c2) = do { (env1, c1') <- zonkCoFn env c1
-				    ; (env2, c2') <- zonkCoFn env1 c2
-				    ; return (env2, CoCompose c1' c2') }
-zonkCoFn env (CoLams ids c) = do { ids' <- zonkIdBndrs env ids
-				 ; let env1 = extendZonkEnv env ids'
-				 ; (env2, c') <- zonkCoFn env1 c
-				 ; return (env2, CoLams ids' c') }
-zonkCoFn env (CoTyLams tvs c) = ASSERT( all isImmutableTyVar tvs )
-				do { (env1, c') <- zonkCoFn env c
-				   ; return (env1, CoTyLams tvs c') }
-zonkCoFn env (CoApps c ids)   = do { (env1, c') <- zonkCoFn env c
-				   ; return (env1, CoApps c' (zonkIdOccs env ids)) }
-zonkCoFn env (CoTyApps c tys) = do { tys' <- zonkTcTypeToTypes env tys
-				   ; (env1, c') <- zonkCoFn env c
-				   ; return (env1, CoTyApps c' tys') }
-zonkCoFn env (CoLet bs c)     = do { (env1, bs') <- zonkRecMonoBinds env bs
-			 	   ; (env2, c')  <- zonkCoFn env1 c
-				   ; return (env2, CoLet bs' c') }
-
-
--------------------------------------------------------------------------
-zonkDo :: ZonkEnv -> HsStmtContext Name -> HsStmtContext Name
--- Only used for 'do', so the only Ids are in a MDoExpr table
-zonkDo env (MDoExpr tbl) = MDoExpr (mapSnd (zonkIdOcc env) tbl)
-zonkDo env do_or_lc      = do_or_lc
-
--------------------------------------------------------------------------
-zonkOverLit :: ZonkEnv -> HsOverLit TcId -> TcM (HsOverLit Id)
-zonkOverLit env (HsIntegral i e)
-  = do	{ e' <- zonkExpr env e; return (HsIntegral i e') }
-zonkOverLit env (HsFractional r e)
-  = do	{ e' <- zonkExpr env e; return (HsFractional r e') }
-
--------------------------------------------------------------------------
-zonkArithSeq :: ZonkEnv -> ArithSeqInfo TcId -> TcM (ArithSeqInfo Id)
-
-zonkArithSeq env (From e)
-  = zonkLExpr env e		`thenM` \ new_e ->
-    returnM (From new_e)
-
-zonkArithSeq env (FromThen e1 e2)
-  = zonkLExpr env e1	`thenM` \ new_e1 ->
-    zonkLExpr env e2	`thenM` \ new_e2 ->
-    returnM (FromThen new_e1 new_e2)
-
-zonkArithSeq env (FromTo e1 e2)
-  = zonkLExpr env e1	`thenM` \ new_e1 ->
-    zonkLExpr env e2	`thenM` \ new_e2 ->
-    returnM (FromTo new_e1 new_e2)
-
-zonkArithSeq env (FromThenTo e1 e2 e3)
-  = zonkLExpr env e1	`thenM` \ new_e1 ->
-    zonkLExpr env e2	`thenM` \ new_e2 ->
-    zonkLExpr env e3	`thenM` \ new_e3 ->
-    returnM (FromThenTo new_e1 new_e2 new_e3)
-
-
--------------------------------------------------------------------------
-zonkStmts :: ZonkEnv -> [LStmt TcId] -> TcM (ZonkEnv, [LStmt Id])
-zonkStmts env []     = return (env, [])
-zonkStmts env (s:ss) = do { (env1, s')  <- wrapLocSndM (zonkStmt env) s
-			  ; (env2, ss') <- zonkStmts env1 ss
-			  ; return (env2, s' : ss') }
-
-zonkStmt :: ZonkEnv -> Stmt TcId -> TcM (ZonkEnv, Stmt Id)
-zonkStmt env (ParStmt stmts_w_bndrs)
-  = mappM zonk_branch stmts_w_bndrs	`thenM` \ new_stmts_w_bndrs ->
-    let 
-	new_binders = concat (map snd new_stmts_w_bndrs)
-	env1 = extendZonkEnv env new_binders
-    in
-    return (env1, ParStmt new_stmts_w_bndrs)
-  where
-    zonk_branch (stmts, bndrs) = zonkStmts env stmts	`thenM` \ (env1, new_stmts) ->
-				 returnM (new_stmts, zonkIdOccs env1 bndrs)
-
-zonkStmt env (RecStmt segStmts lvs rvs rets binds)
-  = zonkIdBndrs env rvs		`thenM` \ new_rvs ->
-    let
-	env1 = extendZonkEnv env new_rvs
-    in
-    zonkStmts env1 segStmts	`thenM` \ (env2, new_segStmts) ->
-	-- Zonk the ret-expressions in an envt that 
-	-- has the polymorphic bindings in the envt
-    mapM (zonkExpr env2) rets	`thenM` \ new_rets ->
-    let
-	new_lvs = zonkIdOccs env2 lvs
-	env3 = extendZonkEnv env new_lvs	-- Only the lvs are needed
-    in
-    zonkRecMonoBinds env3 binds	`thenM` \ (env4, new_binds) ->
-    returnM (env4, RecStmt new_segStmts new_lvs new_rvs new_rets new_binds)
-
-zonkStmt env (ExprStmt expr then_op ty)
-  = zonkLExpr env expr		`thenM` \ new_expr ->
-    zonkExpr env then_op	`thenM` \ new_then ->
-    zonkTcTypeToType env ty	`thenM` \ new_ty ->
-    returnM (env, ExprStmt new_expr new_then new_ty)
-
-zonkStmt env (LetStmt binds)
-  = zonkLocalBinds env binds	`thenM` \ (env1, new_binds) ->
-    returnM (env1, LetStmt new_binds)
-
-zonkStmt env (BindStmt pat expr bind_op fail_op)
-  = do	{ new_expr <- zonkLExpr env expr
-	; (env1, new_pat) <- zonkPat env pat
-	; new_bind <- zonkExpr env bind_op
-	; new_fail <- zonkExpr env fail_op
-	; return (env1, BindStmt new_pat new_expr new_bind new_fail) }
-
-
--------------------------------------------------------------------------
-zonkRbinds :: ZonkEnv -> HsRecordBinds TcId -> TcM (HsRecordBinds Id)
-
-zonkRbinds env rbinds
-  = mappM zonk_rbind rbinds
-  where
-    zonk_rbind (field, expr)
-      = zonkLExpr env expr	`thenM` \ new_expr ->
-	returnM (fmap (zonkIdOcc env) field, new_expr)
-
--------------------------------------------------------------------------
-mapIPNameTc :: (a -> TcM b) -> IPName a -> TcM (IPName b)
-mapIPNameTc f (Dupable n) = f n  `thenM` \ r -> returnM (Dupable r)
-mapIPNameTc f (Linear  n) = f n  `thenM` \ r -> returnM (Linear r)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[BackSubst-Pats]{Patterns}
-%*									*
-%************************************************************************
-
-\begin{code}
-zonkPat :: ZonkEnv -> OutPat TcId -> TcM (ZonkEnv, OutPat Id)
--- Extend the environment as we go, because it's possible for one
--- pattern to bind something that is used in another (inside or
--- to the right)
-zonkPat env pat = wrapLocSndM (zonk_pat env) pat
-
-zonk_pat env (ParPat p)
-  = do	{ (env', p') <- zonkPat env p
-  	; return (env', ParPat p') }
-
-zonk_pat env (WildPat ty)
-  = do	{ ty' <- zonkTcTypeToType env ty
-	; return (env, WildPat ty') }
-
-zonk_pat env (VarPat v)
-  = do	{ v' <- zonkIdBndr env v
-	; return (extendZonkEnv1 env v', VarPat v') }
-
-zonk_pat env (VarPatOut v binds)
-  = do	{ v' <- zonkIdBndr env v
-	; (env', binds') <- zonkRecMonoBinds (extendZonkEnv1 env v') binds
-  	; returnM (env', VarPatOut v' binds') }
-
-zonk_pat env (LazyPat pat)
-  = do	{ (env', pat') <- zonkPat env pat
-	; return (env',  LazyPat pat') }
-
-zonk_pat env (BangPat pat)
-  = do	{ (env', pat') <- zonkPat env pat
-	; return (env',  BangPat pat') }
-
-zonk_pat env (AsPat (L loc v) pat)
-  = do	{ v' <- zonkIdBndr env v
-	; (env', pat') <- zonkPat (extendZonkEnv1 env v') pat
- 	; return (env', AsPat (L loc v') pat') }
-
-zonk_pat env (ListPat pats ty)
-  = do	{ ty' <- zonkTcTypeToType env ty
-	; (env', pats') <- zonkPats env pats
-	; return (env', ListPat pats' ty') }
-
-zonk_pat env (PArrPat pats ty)
-  = do	{ ty' <- zonkTcTypeToType env ty
-	; (env', pats') <- zonkPats env pats
-	; return (env', PArrPat pats' ty') }
-
-zonk_pat env (TuplePat pats boxed ty)
-  = do	{ ty' <- zonkTcTypeToType env ty
-	; (env', pats') <- zonkPats env pats
-	; return (env', TuplePat pats' boxed ty') }
-
-zonk_pat env (ConPatOut n tvs dicts binds stuff ty)
-  = ASSERT( all isImmutableTyVar tvs )
-    do	{ new_ty <- zonkTcTypeToType env ty
-	; new_dicts <- zonkIdBndrs env dicts
-	; let env1 = extendZonkEnv env new_dicts
-	; (env2, new_binds) <- zonkRecMonoBinds env1 binds
-	; (env', new_stuff) <- zonkConStuff env2 stuff
-	; returnM (env', ConPatOut n tvs new_dicts new_binds new_stuff new_ty) }
-
-zonk_pat env (LitPat lit) = return (env, LitPat lit)
-
-zonk_pat env (SigPatOut pat ty)
-  = do	{ ty' <- zonkTcTypeToType env ty
-	; (env', pat') <- zonkPat env pat
-	; return (env', SigPatOut pat' ty') }
-
-zonk_pat env (NPat lit mb_neg eq_expr ty)
-  = do	{ lit' <- zonkOverLit env lit
- 	; mb_neg' <- case mb_neg of
-			Nothing  -> return Nothing
-			Just neg -> do { neg' <- zonkExpr env neg
-				       ; return (Just neg') }
- 	; eq_expr' <- zonkExpr env eq_expr
-	; ty' <- zonkTcTypeToType env ty
-	; return (env, NPat lit' mb_neg' eq_expr' ty') }
-
-zonk_pat env (NPlusKPat (L loc n) lit e1 e2)
-  = do	{ n' <- zonkIdBndr env n
-	; lit' <- zonkOverLit env lit
- 	; e1' <- zonkExpr env e1
-	; e2' <- zonkExpr env e2
-	; return (extendZonkEnv1 env n', NPlusKPat (L loc n') lit' e1' e2') }
-
-zonk_pat env (DictPat ds ms)
-  = do	{ ds' <- zonkIdBndrs env ds
-	; ms' <- zonkIdBndrs env ms
-	; return (extendZonkEnv env (ds' ++ ms'), DictPat ds' ms') }
-
----------------------------
-zonkConStuff env (PrefixCon pats)
-  = do	{ (env', pats') <- zonkPats env pats
-	; return (env', PrefixCon pats') }
-
-zonkConStuff env (InfixCon p1 p2)
-  = do	{ (env1, p1') <- zonkPat env  p1
-	; (env', p2') <- zonkPat env1 p2
-	; return (env', InfixCon p1' p2') }
-
-zonkConStuff env (RecCon rpats)
-  = do	{ (env', pats') <- zonkPats env pats
-	; returnM (env', RecCon (fields `zip` pats')) }
-  where
-    (fields, pats) = unzip rpats
-
----------------------------
-zonkPats env []		= return (env, [])
-zonkPats env (pat:pats) = do { (env1, pat') <- zonkPat env pat
-			     ; (env', pats') <- zonkPats env1 pats
-			     ; return (env', pat':pats') }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[BackSubst-Foreign]{Foreign exports}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-zonkForeignExports :: ZonkEnv -> [LForeignDecl TcId] -> TcM [LForeignDecl Id]
-zonkForeignExports env ls = mappM (wrapLocM (zonkForeignExport env)) ls
-
-zonkForeignExport :: ZonkEnv -> ForeignDecl TcId -> TcM (ForeignDecl Id)
-zonkForeignExport env (ForeignExport i hs_ty spec isDeprec) =
-   returnM (ForeignExport (fmap (zonkIdOcc env) i) undefined spec isDeprec)
-zonkForeignExport env for_imp 
-  = returnM for_imp	-- Foreign imports don't need zonking
-\end{code}
-
-\begin{code}
-zonkRules :: ZonkEnv -> [LRuleDecl TcId] -> TcM [LRuleDecl Id]
-zonkRules env rs = mappM (wrapLocM (zonkRule env)) rs
-
-zonkRule :: ZonkEnv -> RuleDecl TcId -> TcM (RuleDecl Id)
-zonkRule env (HsRule name act (vars::[RuleBndr TcId]) lhs fv_lhs rhs fv_rhs)
-  = mappM zonk_bndr vars		`thenM` \ new_bndrs ->
-    newMutVar emptyVarSet		`thenM` \ unbound_tv_set ->
-    let
-	env_rhs = extendZonkEnv env [id | b <- new_bndrs, let id = unLoc b, isId id]
-	-- Type variables don't need an envt
-	-- They are bound through the mutable mechanism
-
-	env_lhs = setZonkType env_rhs (zonkTypeCollecting unbound_tv_set)
-	-- We need to gather the type variables mentioned on the LHS so we can 
-	-- quantify over them.  Example:
-	--   data T a = C
-	-- 
-	--   foo :: T a -> Int
-	--   foo C = 1
-	--
-	--   {-# RULES "myrule"  foo C = 1 #-}
-	-- 
-	-- After type checking the LHS becomes (foo a (C a))
-	-- and we do not want to zap the unbound tyvar 'a' to (), because
-	-- that limits the applicability of the rule.  Instead, we
-	-- want to quantify over it!  
-	--
-	-- It's easiest to find the free tyvars here. Attempts to do so earlier
-	-- are tiresome, because (a) the data type is big and (b) finding the 
-	-- free type vars of an expression is necessarily monadic operation.
-	--	(consider /\a -> f @ b, where b is side-effected to a)
-    in
-    zonkLExpr env_lhs lhs		`thenM` \ new_lhs ->
-    zonkLExpr env_rhs rhs		`thenM` \ new_rhs ->
-
-    readMutVar unbound_tv_set		`thenM` \ unbound_tvs ->
-    let
-	final_bndrs :: [Located Var]
-	final_bndrs = map noLoc (varSetElems unbound_tvs) ++ new_bndrs
-    in
-    returnM (HsRule name act (map RuleBndr final_bndrs) new_lhs fv_lhs new_rhs fv_rhs)
-		-- I hate this map RuleBndr stuff
-  where
-   zonk_bndr (RuleBndr v) 
-	| isId (unLoc v) = wrapLocM (zonkIdBndr env)   v
-	| otherwise      = ASSERT( isImmutableTyVar (unLoc v) )
-			   return v
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[BackSubst-Foreign]{Foreign exports}
-%*									*
-%************************************************************************
-
-\begin{code}
-zonkTcTypeToType :: ZonkEnv -> TcType -> TcM Type
-zonkTcTypeToType (ZonkEnv zonk_ty _) ty = zonk_ty ty
-
-zonkTcTypeToTypes :: ZonkEnv -> [TcType] -> TcM [Type]
-zonkTcTypeToTypes env tys = mapM (zonkTcTypeToType env) tys
-
-zonkTypeCollecting :: TcRef TyVarSet -> TcType -> TcM Type
--- This variant collects unbound type variables in a mutable variable
-zonkTypeCollecting unbound_tv_set
-  = zonkType zonk_unbound_tyvar
-  where
-    zonk_unbound_tyvar tv 
-	= zonkQuantifiedTyVar tv				`thenM` \ tv' ->
-	  readMutVar unbound_tv_set				`thenM` \ tv_set ->
-	  writeMutVar unbound_tv_set (extendVarSet tv_set tv')	`thenM_`
-	  return (mkTyVarTy tv')
-
-zonkTypeZapping :: TcType -> TcM Type
--- This variant is used for everything except the LHS of rules
--- It zaps unbound type variables to (), or some other arbitrary type
-zonkTypeZapping ty 
-  = zonkType zonk_unbound_tyvar ty 
-  where
-	-- Zonk a mutable but unbound type variable to an arbitrary type
-	-- We know it's unbound even though we don't carry an environment,
-	-- because at the binding site for a type variable we bind the
-	-- mutable tyvar to a fresh immutable one.  So the mutable store
-	-- plays the role of an environment.  If we come across a mutable
-	-- type variable that isn't so bound, it must be completely free.
-    zonk_unbound_tyvar tv = do { writeMetaTyVar tv ty; return ty }
-			  where 
-			    ty = mkArbitraryType tv
-
-
--- When the type checker finds a type variable with no binding,
--- which means it can be instantiated with an arbitrary type, it
--- usually instantiates it to Void.  Eg.
--- 
--- 	length []
--- ===>
--- 	length Void (Nil Void)
--- 
--- But in really obscure programs, the type variable might have
--- a kind other than *, so we need to invent a suitably-kinded type.
--- 
--- This commit uses
--- 	Void for kind *
--- 	List for kind *->*
--- 	Tuple for kind *->...*->*
--- 
--- which deals with most cases.  (Previously, it only dealt with
--- kind *.)   
--- 
--- In the other cases, it just makes up a TyCon with a suitable
--- kind.  If this gets into an interface file, anyone reading that
--- file won't understand it.  This is fixable (by making the client
--- of the interface file make up a TyCon too) but it is tiresome and
--- never happens, so I am leaving it 
-
-mkArbitraryType :: TcTyVar -> Type
--- Make up an arbitrary type whose kind is the same as the tyvar.
--- We'll use this to instantiate the (unbound) tyvar.
-mkArbitraryType tv 
-  | liftedTypeKind `isSubKind` kind = voidTy		-- The vastly common case
-  | otherwise			    = mkTyConApp tycon []
-  where
-    kind       = tyVarKind tv
-    (args,res) = splitKindFunTys kind
-
-    tycon | kind == tyConKind listTyCon 	--  *->*
-	  = listTyCon				-- No tuples this size
-
-	  | all isLiftedTypeKind args && isLiftedTypeKind res
-	  = tupleTyCon Boxed (length args)	--  *-> ... ->*->*
-
-	  | otherwise
-	  = pprTrace "Urk! Inventing strangely-kinded void TyCon:" (ppr tc_name $$ ppr kind) $
-	    mkPrimTyCon tc_name kind 0 [] VoidRep
-		-- Same name as the tyvar, apart from making it start with a colon (sigh)
-		-- I dread to think what will happen if this gets out into an 
-		-- interface file.  Catastrophe likely.  Major sigh.
-
-    tc_name = mkInternalName (getUnique tv) (mkDerivedTyConOcc (getOccName tv)) noSrcLoc
-\end{code}
diff --git a/ghc/compiler/typecheck/TcHsType.lhs b/ghc/compiler/typecheck/TcHsType.lhs
deleted file mode 100644
index 968ccfb960..0000000000
--- a/ghc/compiler/typecheck/TcHsType.lhs
+++ /dev/null
@@ -1,816 +0,0 @@
-
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcMonoType]{Typechecking user-specified @MonoTypes@}
-
-\begin{code}
-module TcHsType (
-	tcHsSigType, tcHsDeriv,
-	UserTypeCtxt(..), 
-
-		-- Kind checking
-	kcHsTyVars, kcHsSigType, kcHsLiftedSigType, 
-	kcCheckHsType, kcHsContext, kcHsType, 
-	
-		-- Typechecking kinded types
-	tcHsKindedContext, tcHsKindedType, tcHsBangType,
-	tcTyVarBndrs, dsHsType, tcLHsConResTy,
-	tcDataKindSig,
-
-		-- Pattern type signatures
-	tcHsPatSigType, tcPatSig
-   ) where
-
-#include "HsVersions.h"
-
-import HsSyn		( HsType(..), LHsType, HsTyVarBndr(..), LHsTyVarBndr, 
-			  LHsContext, HsPred(..), LHsPred, HsExplicitForAll(..) )
-import RnHsSyn		( extractHsTyVars )
-import TcRnMonad
-import TcEnv		( tcExtendTyVarEnv, tcExtendKindEnvTvs, 
-			  tcLookup, tcLookupClass, tcLookupTyCon,
-		 	  TyThing(..), getInLocalScope, getScopedTyVarBinds,
-			  wrongThingErr
-			)
-import TcMType		( newKindVar, 
-			  zonkTcKindToKind, 
-			  tcInstBoxyTyVar, readFilledBox,
-			  checkValidType
-			)
-import TcUnify		( boxyUnify, unifyFunKind, checkExpectedKind )
-import TcIface		( checkWiredInTyCon )
-import TcType		( Type, PredType(..), ThetaType, BoxySigmaType,
-			  TcType, TcKind, isRigidTy,
-			  UserTypeCtxt(..), pprUserTypeCtxt,
-			  substTyWith, mkTyVarTys, tcEqType,
-		 	  tcIsTyVarTy, mkFunTy, mkSigmaTy, mkPredTy, 
-			  mkTyConApp, mkAppTys, typeKind )
-import Kind 		( Kind, isLiftedTypeKind, liftedTypeKind, ubxTupleKind, 
-			  openTypeKind, argTypeKind, splitKindFunTys )
-import Var		( TyVar, mkTyVar, tyVarName )
-import TyCon		( TyCon, tyConKind )
-import Class		( Class, classTyCon )
-import Name		( Name, mkInternalName )
-import OccName		( mkOccName, tvName )
-import NameSet
-import PrelNames	( genUnitTyConName )
-import TysWiredIn	( mkListTy, listTyCon, mkPArrTy, parrTyCon, tupleTyCon )
-import BasicTypes	( Boxity(..) )
-import SrcLoc		( Located(..), unLoc, noLoc, getLoc, srcSpanStart )
-import UniqSupply	( uniqsFromSupply )
-import Outputable
-\end{code}
-
-
-	----------------------------
-		General notes
-	----------------------------
-
-Generally speaking we now type-check types in three phases
-
-  1.  kcHsType: kind check the HsType
-	*includes* performing any TH type splices;
-	so it returns a translated, and kind-annotated, type
-
-  2.  dsHsType: convert from HsType to Type:
-	perform zonking
-	expand type synonyms [mkGenTyApps]
-	hoist the foralls [tcHsType]
-
-  3.  checkValidType: check the validity of the resulting type
-
-Often these steps are done one after the other (tcHsSigType).
-But in mutually recursive groups of type and class decls we do
-	1 kind-check the whole group
-	2 build TyCons/Classes in a knot-tied way
-	3 check the validity of types in the now-unknotted TyCons/Classes
-
-For example, when we find
-	(forall a m. m a -> m a)
-we bind a,m to kind varibles and kind-check (m a -> m a).  This makes
-a get kind *, and m get kind *->*.  Now we typecheck (m a -> m a) in
-an environment that binds a and m suitably.
-
-The kind checker passed to tcHsTyVars needs to look at enough to
-establish the kind of the tyvar:
-  * For a group of type and class decls, it's just the group, not
-	the rest of the program
-  * For a tyvar bound in a pattern type signature, its the types
-	mentioned in the other type signatures in that bunch of patterns
-  * For a tyvar bound in a RULE, it's the type signatures on other
-	universally quantified variables in the rule
-
-Note that this may occasionally give surprising results.  For example:
-
-	data T a b = MkT (a b)
-
-Here we deduce			a::*->*,       b::*
-But equally valid would be	a::(*->*)-> *, b::*->*
-
-
-Validity checking
-~~~~~~~~~~~~~~~~~
-Some of the validity check could in principle be done by the kind checker, 
-but not all:
-
-- During desugaring, we normalise by expanding type synonyms.  Only
-  after this step can we check things like type-synonym saturation
-  e.g. 	type T k = k Int
-	type S a = a
-  Then (T S) is ok, because T is saturated; (T S) expands to (S Int);
-  and then S is saturated.  This is a GHC extension.
-
-- Similarly, also a GHC extension, we look through synonyms before complaining
-  about the form of a class or instance declaration
-
-- Ambiguity checks involve functional dependencies, and it's easier to wait
-  until knots have been resolved before poking into them
-
-Also, in a mutually recursive group of types, we can't look at the TyCon until we've
-finished building the loop.  So to keep things simple, we postpone most validity
-checking until step (3).
-
-Knot tying
-~~~~~~~~~~
-During step (1) we might fault in a TyCon defined in another module, and it might
-(via a loop) refer back to a TyCon defined in this module. So when we tie a big
-knot around type declarations with ARecThing, so that the fault-in code can get
-the TyCon being defined.
-
-
-%************************************************************************
-%*									*
-\subsection{Checking types}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcHsSigType :: UserTypeCtxt -> LHsType Name -> TcM Type
-  -- Do kind checking, and hoist for-alls to the top
-  -- NB: it's important that the foralls that come from the top-level
-  --	 HsForAllTy in hs_ty occur *first* in the returned type.
-  --     See Note [Scoped] with TcSigInfo
-tcHsSigType ctxt hs_ty 
-  = addErrCtxt (pprHsSigCtxt ctxt hs_ty) $
-    do	{ kinded_ty <- kcTypeType hs_ty
-	; ty <- tcHsKindedType kinded_ty
-	; checkValidType ctxt ty	
-	; returnM ty }
-
--- Used for the deriving(...) items
-tcHsDeriv :: LHsType Name -> TcM ([TyVar], Class, [Type])
-tcHsDeriv = addLocM (tc_hs_deriv [])
-
-tc_hs_deriv tv_names (HsPredTy (HsClassP cls_name hs_tys))
-  = kcHsTyVars tv_names 		$ \ tv_names' ->
-    do	{ cls_kind <- kcClass cls_name
-	; (tys, res_kind) <- kcApps cls_kind (ppr cls_name) hs_tys
-	; tcTyVarBndrs tv_names'	$ \ tyvars ->
-    do	{ arg_tys <- dsHsTypes tys
-	; cls <- tcLookupClass cls_name
-	; return (tyvars, cls, arg_tys) }}
-
-tc_hs_deriv tv_names1 (HsForAllTy _ tv_names2 (L _ []) (L _ ty))
-  = 	-- Funny newtype deriving form
-	-- 	forall a. C [a]
-	-- where C has arity 2.  Hence can't use regular functions
-    tc_hs_deriv (tv_names1 ++ tv_names2) ty
-
-tc_hs_deriv _ other
-  = failWithTc (ptext SLIT("Illegal deriving item") <+> ppr other)
-\end{code}
-
-	These functions are used during knot-tying in
-	type and class declarations, when we have to
- 	separate kind-checking, desugaring, and validity checking
-
-\begin{code}
-kcHsSigType, kcHsLiftedSigType :: LHsType Name -> TcM (LHsType Name)
-	-- Used for type signatures
-kcHsSigType ty 	     = kcTypeType ty
-kcHsLiftedSigType ty = kcLiftedType ty
-
-tcHsKindedType :: LHsType Name -> TcM Type
-  -- Don't do kind checking, nor validity checking, 
-  -- 	but do hoist for-alls to the top
-  -- This is used in type and class decls, where kinding is
-  -- done in advance, and validity checking is done later
-  -- [Validity checking done later because of knot-tying issues.]
-tcHsKindedType hs_ty = dsHsType hs_ty
-
-tcHsBangType :: LHsType Name -> TcM Type
--- Permit a bang, but discard it
-tcHsBangType (L span (HsBangTy b ty)) = tcHsKindedType ty
-tcHsBangType ty 		      = tcHsKindedType ty
-
-tcHsKindedContext :: LHsContext Name -> TcM ThetaType
--- Used when we are expecting a ClassContext (i.e. no implicit params)
--- Does not do validity checking, like tcHsKindedType
-tcHsKindedContext hs_theta = addLocM (mappM dsHsLPred) hs_theta
-\end{code}
-
-
-%************************************************************************
-%*									*
-		The main kind checker: kcHsType
-%*									*
-%************************************************************************
-	
-	First a couple of simple wrappers for kcHsType
-
-\begin{code}
----------------------------
-kcLiftedType :: LHsType Name -> TcM (LHsType Name)
--- The type ty must be a *lifted* *type*
-kcLiftedType ty = kcCheckHsType ty liftedTypeKind
-    
----------------------------
-kcTypeType :: LHsType Name -> TcM (LHsType Name)
--- The type ty must be a *type*, but it can be lifted or 
--- unlifted or an unboxed tuple.
-kcTypeType ty = kcCheckHsType ty openTypeKind
-
----------------------------
-kcCheckHsType :: LHsType Name -> TcKind -> TcM (LHsType Name)
--- Check that the type has the specified kind
--- Be sure to use checkExpectedKind, rather than simply unifying 
--- with OpenTypeKind, because it gives better error messages
-kcCheckHsType (L span ty) exp_kind 
-  = setSrcSpan span				$
-    do	{ (ty', act_kind) <- add_ctxt ty (kc_hs_type ty)
-		-- Add the context round the inner check only
-		-- because checkExpectedKind already mentions
-		-- 'ty' by name in any error message
-
-	; checkExpectedKind ty act_kind exp_kind
-	; return (L span ty') }
-  where
-	-- Wrap a context around only if we want to
-	-- show that contexts.  Omit invisble ones
-	-- and ones user's won't grok (HsPred p).
-    add_ctxt (HsPredTy p)		    	   thing = thing
-    add_ctxt (HsForAllTy Implicit tvs (L _ []) ty) thing = thing
-    add_ctxt other_ty thing = addErrCtxt (typeCtxt ty) thing
-\end{code}
-
-	Here comes the main function
-
-\begin{code}
-kcHsType :: LHsType Name -> TcM (LHsType Name, TcKind)
-kcHsType ty = wrapLocFstM kc_hs_type ty
--- kcHsType *returns* the kind of the type, rather than taking an expected
--- kind as argument as tcExpr does.  
--- Reasons: 
---	(a) the kind of (->) is
---		forall bx1 bx2. Type bx1 -> Type bx2 -> Type Boxed
---  	    so we'd need to generate huge numbers of bx variables.
---	(b) kinds are so simple that the error messages are fine
---
--- The translated type has explicitly-kinded type-variable binders
-
-kc_hs_type (HsParTy ty)
- = kcHsType ty		`thenM` \ (ty', kind) ->
-   returnM (HsParTy ty', kind)
-
-kc_hs_type (HsTyVar name)
-  = kcTyVar name	`thenM` \ kind ->
-    returnM (HsTyVar name, kind)
-
-kc_hs_type (HsListTy ty) 
-  = kcLiftedType ty			`thenM` \ ty' ->
-    returnM (HsListTy ty', liftedTypeKind)
-
-kc_hs_type (HsPArrTy ty)
-  = kcLiftedType ty			`thenM` \ ty' ->
-    returnM (HsPArrTy ty', liftedTypeKind)
-
-kc_hs_type (HsNumTy n)
-   = returnM (HsNumTy n, liftedTypeKind)
-
-kc_hs_type (HsKindSig ty k) 
-  = kcCheckHsType ty k	`thenM` \ ty' ->
-    returnM (HsKindSig ty' k, k)
-
-kc_hs_type (HsTupleTy Boxed tys)
-  = mappM kcLiftedType tys	`thenM` \ tys' ->
-    returnM (HsTupleTy Boxed tys', liftedTypeKind)
-
-kc_hs_type (HsTupleTy Unboxed tys)
-  = mappM kcTypeType tys	`thenM` \ tys' ->
-    returnM (HsTupleTy Unboxed tys', ubxTupleKind)
-
-kc_hs_type (HsFunTy ty1 ty2)
-  = kcCheckHsType ty1 argTypeKind	`thenM` \ ty1' ->
-    kcTypeType ty2			`thenM` \ ty2' ->
-    returnM (HsFunTy ty1' ty2', liftedTypeKind)
-
-kc_hs_type ty@(HsOpTy ty1 op ty2)
-  = addLocM kcTyVar op			`thenM` \ op_kind ->
-    kcApps op_kind (ppr op) [ty1,ty2]	`thenM` \ ([ty1',ty2'], res_kind) ->
-    returnM (HsOpTy ty1' op ty2', res_kind)
-
-kc_hs_type ty@(HsAppTy ty1 ty2)
-  = kcHsType fun_ty			  `thenM` \ (fun_ty', fun_kind) ->
-    kcApps fun_kind (ppr fun_ty) arg_tys  `thenM` \ ((arg_ty':arg_tys'), res_kind) ->
-    returnM (foldl mk_app (HsAppTy fun_ty' arg_ty') arg_tys', res_kind)
-  where
-    (fun_ty, arg_tys) = split ty1 [ty2]
-    split (L _ (HsAppTy f a)) as = split f (a:as)
-    split f       	      as = (f,as)
-    mk_app fun arg = HsAppTy (noLoc fun) arg	-- Add noLocs for inner nodes of
-						-- the application; they are never used
-    
-kc_hs_type (HsPredTy pred)
-  = kcHsPred pred		`thenM` \ pred' ->
-    returnM (HsPredTy pred', liftedTypeKind)
-
-kc_hs_type (HsForAllTy exp tv_names context ty)
-  = kcHsTyVars tv_names		$ \ tv_names' ->
-    kcHsContext context		`thenM`	\ ctxt' ->
-    kcLiftedType ty		`thenM` \ ty' ->
-	-- The body of a forall is usually a type, but in principle
-	-- there's no reason to prohibit *unlifted* types.
-	-- In fact, GHC can itself construct a function with an
-	-- unboxed tuple inside a for-all (via CPR analyis; see 
-	-- typecheck/should_compile/tc170)
-	--
-	-- Still, that's only for internal interfaces, which aren't
-	-- kind-checked, so we only allow liftedTypeKind here
-    returnM (HsForAllTy exp tv_names' ctxt' ty', liftedTypeKind)
-
-kc_hs_type (HsBangTy b ty)
-  = do { (ty', kind) <- kcHsType ty
-       ; return (HsBangTy b ty', kind) }
-
-kc_hs_type ty@(HsSpliceTy _)
-  = failWithTc (ptext SLIT("Unexpected type splice:") <+> ppr ty)
-
-
----------------------------
-kcApps :: TcKind			-- Function kind
-       -> SDoc				-- Function 
-       -> [LHsType Name]		-- Arg types
-       -> TcM ([LHsType Name], TcKind)	-- Kind-checked args
-kcApps fun_kind ppr_fun args
-  = split_fk fun_kind (length args)	`thenM` \ (arg_kinds, res_kind) ->
-    zipWithM kc_arg args arg_kinds	`thenM` \ args' ->
-    returnM (args', res_kind)
-  where
-    split_fk fk 0 = returnM ([], fk)
-    split_fk fk n = unifyFunKind fk	`thenM` \ mb_fk ->
-		    case mb_fk of 
-			Nothing       -> failWithTc too_many_args 
-			Just (ak,fk') -> split_fk fk' (n-1)	`thenM` \ (aks, rk) ->
-					 returnM (ak:aks, rk)
-
-    kc_arg arg arg_kind = kcCheckHsType arg arg_kind
-
-    too_many_args = ptext SLIT("Kind error:") <+> quotes ppr_fun <+>
-		    ptext SLIT("is applied to too many type arguments")
-
----------------------------
-kcHsContext :: LHsContext Name -> TcM (LHsContext Name)
-kcHsContext ctxt = wrapLocM (mappM kcHsLPred) ctxt
-
-kcHsLPred :: LHsPred Name -> TcM (LHsPred Name)
-kcHsLPred = wrapLocM kcHsPred
-
-kcHsPred :: HsPred Name -> TcM (HsPred Name)
-kcHsPred pred	-- Checks that the result is of kind liftedType
-  = kc_pred pred				`thenM` \ (pred', kind) ->
-    checkExpectedKind pred kind liftedTypeKind	`thenM_` 
-    returnM pred'
-    
----------------------------
-kc_pred :: HsPred Name -> TcM (HsPred Name, TcKind)	
-	-- Does *not* check for a saturated
-	-- application (reason: used from TcDeriv)
-kc_pred pred@(HsIParam name ty)
-  = kcHsType ty		`thenM` \ (ty', kind) ->
-    returnM (HsIParam name ty', kind)
-
-kc_pred pred@(HsClassP cls tys)
-  = kcClass cls			`thenM` \ kind ->
-    kcApps kind (ppr cls) tys	`thenM` \ (tys', res_kind) ->
-    returnM (HsClassP cls tys', res_kind)
-
----------------------------
-kcTyVar :: Name -> TcM TcKind
-kcTyVar name	-- Could be a tyvar or a tycon
-  = traceTc (text "lk1" <+> ppr name) 	`thenM_`
-    tcLookup name	`thenM` \ thing ->
-    traceTc (text "lk2" <+> ppr name <+> ppr thing) 	`thenM_`
-    case thing of 
-	ATyVar _ ty	    	-> returnM (typeKind ty)
-	AThing kind		-> returnM kind
-	AGlobal (ATyCon tc) 	-> returnM (tyConKind tc) 
-	other			-> wrongThingErr "type" thing name
-
-kcClass :: Name -> TcM TcKind
-kcClass cls	-- Must be a class
-  = tcLookup cls 				`thenM` \ thing -> 
-    case thing of
-	AThing kind		-> returnM kind
-	AGlobal (AClass cls)    -> returnM (tyConKind (classTyCon cls))
-	other		        -> wrongThingErr "class" thing cls
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Desugaring
-%*									*
-%************************************************************************
-
-The type desugarer
-
-	* Transforms from HsType to Type
-	* Zonks any kinds
-
-It cannot fail, and does no validity checking, except for 
-structural matters, such as
-	(a) spurious ! annotations.
-	(b) a class used as a type
-
-\begin{code}
-dsHsType :: LHsType Name -> TcM Type
--- All HsTyVarBndrs in the intput type are kind-annotated
-dsHsType ty = ds_type (unLoc ty)
-
-ds_type ty@(HsTyVar name)
-  = ds_app ty []
-
-ds_type (HsParTy ty)		-- Remove the parentheses markers
-  = dsHsType ty
-
-ds_type ty@(HsBangTy _ _)	-- No bangs should be here
-  = failWithTc (ptext SLIT("Unexpected strictness annotation:") <+> ppr ty)
-
-ds_type (HsKindSig ty k)
-  = dsHsType ty	-- Kind checking done already
-
-ds_type (HsListTy ty)
-  = dsHsType ty			`thenM` \ tau_ty ->
-    checkWiredInTyCon listTyCon	`thenM_`
-    returnM (mkListTy tau_ty)
-
-ds_type (HsPArrTy ty)
-  = dsHsType ty			`thenM` \ tau_ty ->
-    checkWiredInTyCon parrTyCon	`thenM_`
-    returnM (mkPArrTy tau_ty)
-
-ds_type (HsTupleTy boxity tys)
-  = dsHsTypes tys		`thenM` \ tau_tys ->
-    checkWiredInTyCon tycon	`thenM_`
-    returnM (mkTyConApp tycon tau_tys)
-  where
-    tycon = tupleTyCon boxity (length tys)
-
-ds_type (HsFunTy ty1 ty2)
-  = dsHsType ty1			`thenM` \ tau_ty1 ->
-    dsHsType ty2			`thenM` \ tau_ty2 ->
-    returnM (mkFunTy tau_ty1 tau_ty2)
-
-ds_type (HsOpTy ty1 (L span op) ty2)
-  = dsHsType ty1 		`thenM` \ tau_ty1 ->
-    dsHsType ty2 		`thenM` \ tau_ty2 ->
-    setSrcSpan span (ds_var_app op [tau_ty1,tau_ty2])
-
-ds_type (HsNumTy n)
-  = ASSERT(n==1)
-    tcLookupTyCon genUnitTyConName	`thenM` \ tc ->
-    returnM (mkTyConApp tc [])
-
-ds_type ty@(HsAppTy _ _)
-  = ds_app ty []
-
-ds_type (HsPredTy pred)
-  = dsHsPred pred	`thenM` \ pred' ->
-    returnM (mkPredTy pred')
-
-ds_type full_ty@(HsForAllTy exp tv_names ctxt ty)
-  = tcTyVarBndrs tv_names		$ \ tyvars ->
-    mappM dsHsLPred (unLoc ctxt)	`thenM` \ theta ->
-    dsHsType ty				`thenM` \ tau ->
-    returnM (mkSigmaTy tyvars theta tau)
-
-dsHsTypes arg_tys = mappM dsHsType arg_tys
-\end{code}
-
-Help functions for type applications
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-\begin{code}
-ds_app :: HsType Name -> [LHsType Name] -> TcM Type
-ds_app (HsAppTy ty1 ty2) tys
-  = ds_app (unLoc ty1) (ty2:tys)
-
-ds_app ty tys
-  = dsHsTypes tys			`thenM` \ arg_tys ->
-    case ty of
-	HsTyVar fun -> ds_var_app fun arg_tys
-	other	    -> ds_type ty		`thenM` \ fun_ty ->
-		       returnM (mkAppTys fun_ty arg_tys)
-
-ds_var_app :: Name -> [Type] -> TcM Type
-ds_var_app name arg_tys 
- = tcLookup name			`thenM` \ thing ->
-    case thing of
-	ATyVar _ ty 	    -> returnM (mkAppTys ty arg_tys)
-	AGlobal (ATyCon tc) -> returnM (mkTyConApp tc arg_tys)
-	other		    -> wrongThingErr "type" thing name
-\end{code}
-
-
-Contexts
-~~~~~~~~
-
-\begin{code}
-dsHsLPred :: LHsPred Name -> TcM PredType
-dsHsLPred pred = dsHsPred (unLoc pred)
-
-dsHsPred pred@(HsClassP class_name tys)
-  = dsHsTypes tys			`thenM` \ arg_tys ->
-    tcLookupClass class_name		`thenM` \ clas ->
-    returnM (ClassP clas arg_tys)
-
-dsHsPred (HsIParam name ty)
-  = dsHsType ty					`thenM` \ arg_ty ->
-    returnM (IParam name arg_ty)
-\end{code}
-
-GADT constructor signatures
-
-\begin{code}
-tcLHsConResTy :: LHsType Name -> TcM (TyCon, [TcType])
-tcLHsConResTy ty@(L span _) 
-  = setSrcSpan span $ 
-    addErrCtxt (gadtResCtxt ty) $
-    tc_con_res ty []
-
-tc_con_res (L _ (HsAppTy fun res_ty)) res_tys
-  = do	{ res_ty' <- dsHsType res_ty
-	; tc_con_res fun (res_ty' : res_tys) }
-
-tc_con_res ty@(L _ (HsTyVar name)) res_tys
-  = do	{ thing <- tcLookup name
-	; case thing of
-	    AGlobal (ATyCon tc) -> return (tc, res_tys)
-	    other -> failWithTc (badGadtDecl ty)
-	}
-
-tc_con_res ty _ = failWithTc (badGadtDecl ty)
-
-gadtResCtxt ty
-  = hang (ptext SLIT("In the result type of a data constructor:"))
-       2 (ppr ty)
-badGadtDecl ty
-  = hang (ptext SLIT("Malformed constructor result type:"))
-       2 (ppr ty)
-
-typeCtxt ty = ptext SLIT("In the type") <+> quotes (ppr ty)
-\end{code}
-
-%************************************************************************
-%*									*
-		Type-variable binders
-%*									*
-%************************************************************************
-
-
-\begin{code}
-kcHsTyVars :: [LHsTyVarBndr Name] 
-	   -> ([LHsTyVarBndr Name] -> TcM r) 	-- These binders are kind-annotated
-						-- They scope over the thing inside
-	   -> TcM r
-kcHsTyVars tvs thing_inside 
-  = mappM (wrapLocM kcHsTyVar) tvs	`thenM` \ bndrs ->
-    tcExtendKindEnvTvs bndrs (thing_inside bndrs)
-
-kcHsTyVar :: HsTyVarBndr Name -> TcM (HsTyVarBndr Name)
-	-- Return a *kind-annotated* binder, and a tyvar with a mutable kind in it	
-kcHsTyVar (UserTyVar name)        = newKindVar 	`thenM` \ kind ->
-				    returnM (KindedTyVar name kind)
-kcHsTyVar (KindedTyVar name kind) = returnM (KindedTyVar name kind)
-
-------------------
-tcTyVarBndrs :: [LHsTyVarBndr Name] 	-- Kind-annotated binders, which need kind-zonking
-	     -> ([TyVar] -> TcM r)
-	     -> TcM r
--- Used when type-checking types/classes/type-decls
--- Brings into scope immutable TyVars, not mutable ones that require later zonking
-tcTyVarBndrs bndrs thing_inside
-  = mapM (zonk . unLoc) bndrs	`thenM` \ tyvars ->
-    tcExtendTyVarEnv tyvars (thing_inside tyvars)
-  where
-    zonk (KindedTyVar name kind) = do { kind' <- zonkTcKindToKind kind
-				      ; return (mkTyVar name kind') }
-    zonk (UserTyVar name) = pprTrace "Un-kinded tyvar" (ppr name) $
-			    return (mkTyVar name liftedTypeKind)
-
------------------------------------
-tcDataKindSig :: Maybe Kind -> TcM [TyVar]
--- GADT decls can have a (perhpas partial) kind signature
---	e.g.  data T :: * -> * -> * where ...
--- This function makes up suitable (kinded) type variables for 
--- the argument kinds, and checks that the result kind is indeed *
-tcDataKindSig Nothing = return []
-tcDataKindSig (Just kind)
-  = do	{ checkTc (isLiftedTypeKind res_kind) (badKindSig kind)
-	; span <- getSrcSpanM
-	; us   <- newUniqueSupply 
-	; let loc   = srcSpanStart span
-	      uniqs = uniqsFromSupply us
-	; return [ mk_tv loc uniq str kind 
-		 | ((kind, str), uniq) <- arg_kinds `zip` names `zip` uniqs ] }
-  where
-    (arg_kinds, res_kind) = splitKindFunTys kind
-    mk_tv loc uniq str kind = mkTyVar name kind
-	where
-	   name = mkInternalName uniq occ loc
-	   occ  = mkOccName tvName str
-
-    names :: [String]	-- a,b,c...aa,ab,ac etc
-    names = [ c:cs | cs <- "" : names, c <- ['a'..'z'] ] 
-
-badKindSig :: Kind -> SDoc
-badKindSig kind 
- = hang (ptext SLIT("Kind signature on data type declaration has non-* return kind"))
-	2 (ppr kind)
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Scoped type variables
-%*									*
-%************************************************************************
-
-
-tcAddScopedTyVars is used for scoped type variables added by pattern
-type signatures
-	e.g.  \ ((x::a), (y::a)) -> x+y
-They never have explicit kinds (because this is source-code only)
-They are mutable (because they can get bound to a more specific type).
-
-Usually we kind-infer and expand type splices, and then
-tupecheck/desugar the type.  That doesn't work well for scoped type
-variables, because they scope left-right in patterns.  (e.g. in the
-example above, the 'a' in (y::a) is bound by the 'a' in (x::a).
-
-The current not-very-good plan is to
-  * find all the types in the patterns
-  * find their free tyvars
-  * do kind inference
-  * bring the kinded type vars into scope
-  * BUT throw away the kind-checked type
-  	(we'll kind-check it again when we type-check the pattern)
-
-This is bad because throwing away the kind checked type throws away
-its splices.  But too bad for now.  [July 03]
-
-Historical note:
-    We no longer specify that these type variables must be univerally 
-    quantified (lots of email on the subject).  If you want to put that 
-    back in, you need to
-	a) Do a checkSigTyVars after thing_inside
-	b) More insidiously, don't pass in expected_ty, else
-	   we unify with it too early and checkSigTyVars barfs
-	   Instead you have to pass in a fresh ty var, and unify
-	   it with expected_ty afterwards
-
-\begin{code}
-tcHsPatSigType :: UserTypeCtxt
-	       -> LHsType Name 		-- The type signature
-	       -> TcM ([TyVar], 	-- Newly in-scope type variables
-			Type)		-- The signature
--- Used for type-checking type signatures in
--- (a) patterns 	  e.g  f (x::Int) = e
--- (b) result signatures  e.g. g x :: Int = e
--- (c) RULE forall bndrs  e.g. forall (x::Int). f x = x
-
-tcHsPatSigType ctxt hs_ty 
-  = addErrCtxt (pprHsSigCtxt ctxt hs_ty) $
-    do	{ 	-- Find the type variables that are mentioned in the type
-		-- but not already in scope.  These are the ones that
-		-- should be bound by the pattern signature
- 	  in_scope <- getInLocalScope
-	; let span = getLoc hs_ty
-	      sig_tvs = [ L span (UserTyVar n) 
-			| n <- nameSetToList (extractHsTyVars hs_ty),
-			  not (in_scope n) ]
-
-	-- Behave very like type-checking (HsForAllTy sig_tvs hs_ty),
-	-- except that we want to keep the tvs separate
-	; (kinded_tvs, kinded_ty) <- kcHsTyVars sig_tvs $ \ kinded_tvs -> do
-				    { kinded_ty <- kcTypeType hs_ty
-				    ; return (kinded_tvs, kinded_ty) }
-	; tcTyVarBndrs kinded_tvs $ \ tyvars -> do
-	{ sig_ty <- dsHsType kinded_ty
-	; checkValidType ctxt sig_ty 
-	; return (tyvars, sig_ty)
-      } }
-
-tcPatSig :: UserTypeCtxt
-	 -> LHsType Name
-	 -> BoxySigmaType
-	 -> TcM (TcType,	   -- The type to use for "inside" the signature
-		 [(Name,TcType)])  -- The new bit of type environment, binding
-				   -- the scoped type variables
-tcPatSig ctxt sig res_ty
-  = do	{ (sig_tvs, sig_ty) <- tcHsPatSigType ctxt sig
-
-	; if null sig_tvs then do {
-		-- The type signature binds no type variables, 
-		-- and hence is rigid, so use it to zap the res_ty
-		  boxyUnify sig_ty res_ty
-		; return (sig_ty, [])
-
-	} else do {
-		-- Type signature binds at least one scoped type variable
-	
-		-- A pattern binding cannot bind scoped type variables
-		-- The renamer fails with a name-out-of-scope error 
-		-- if a pattern binding tries to bind a type variable,
-		-- So we just have an ASSERT here
-	; let in_pat_bind = case ctxt of
-				BindPatSigCtxt -> True
-				other	       -> False
-	; ASSERT( not in_pat_bind || null sig_tvs ) return ()
-
-	  	-- Check that pat_ty is rigid
-	; checkTc (isRigidTy res_ty) (wobblyPatSig sig_tvs)
-
-		-- Now match the pattern signature against res_ty
-		-- For convenience, and uniform-looking error messages
-		-- we do the matching by allocating meta type variables, 
-		-- unifying, and reading out the results.
-		-- This is a strictly local operation.
-	; box_tvs <- mapM tcInstBoxyTyVar sig_tvs
-	; boxyUnify (substTyWith sig_tvs (mkTyVarTys box_tvs) sig_ty) res_ty
-	; sig_tv_tys <- mapM readFilledBox box_tvs
-
-		-- Check that each is bound to a distinct type variable,
-		-- and one that is not already in scope
-	; let tv_binds = map tyVarName sig_tvs `zip` sig_tv_tys
-	; binds_in_scope <- getScopedTyVarBinds
-	; check binds_in_scope tv_binds
-	
-		-- Phew!
-	; return (res_ty, tv_binds)
-	} }
-  where
-    check in_scope []		 = return ()
-    check in_scope ((n,ty):rest) = do { check_one in_scope n ty
-				      ; check ((n,ty):in_scope) rest }
-
-    check_one in_scope n ty
-	= do { checkTc (tcIsTyVarTy ty) (scopedNonVar n ty)
-		-- Must bind to a type variable
-
-	     ; checkTc (null dups) (dupInScope n (head dups) ty)
-		-- Must not bind to the same type variable
-		-- as some other in-scope type variable
-
-	     ; return () }
-	where
-	  dups = [n' | (n',ty') <- in_scope, tcEqType ty' ty]
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Scoped type variables
-%*									*
-%************************************************************************
-
-\begin{code}
-pprHsSigCtxt :: UserTypeCtxt -> LHsType Name -> SDoc
-pprHsSigCtxt ctxt hs_ty = vcat [ ptext SLIT("In") <+> pprUserTypeCtxt ctxt <> colon, 
-				 nest 2 (pp_sig ctxt) ]
-  where
-    pp_sig (FunSigCtxt n)  = pp_n_colon n
-    pp_sig (ConArgCtxt n)  = pp_n_colon n
-    pp_sig (ForSigCtxt n)  = pp_n_colon n
-    pp_sig (RuleSigCtxt n) = pp_n_colon n
-    pp_sig other	   = ppr (unLoc hs_ty)
-
-    pp_n_colon n = ppr n <+> dcolon <+> ppr (unLoc hs_ty)
-
-
-wobblyPatSig sig_tvs
-  = hang (ptext SLIT("A pattern type signature cannot bind scoped type variables") 
-		<+> pprQuotedList sig_tvs)
-       2 (ptext SLIT("unless the pattern has a rigid type context"))
-		
-scopedNonVar n ty
-  = vcat [sep [ptext SLIT("The scoped type variable") <+> quotes (ppr n),
-	       nest 2 (ptext SLIT("is bound to the type") <+> quotes (ppr ty))],
-	  nest 2 (ptext SLIT("You can only bind scoped type variables to type variables"))]
-
-dupInScope n n' ty
-  = hang (ptext SLIT("The scoped type variables") <+> quotes (ppr n) <+> ptext SLIT("and") <+> quotes (ppr n'))
-       2 (vcat [ptext SLIT("are bound to the same type (variable)"),
-		ptext SLIT("Distinct scoped type variables must be distinct")])
-\end{code}
-
diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
deleted file mode 100644
index 45338d0a1e..0000000000
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ /dev/null
@@ -1,610 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcInstDecls]{Typechecking instance declarations}
-
-\begin{code}
-module TcInstDcls ( tcInstDecls1, tcInstDecls2 ) where
-
-#include "HsVersions.h"
-
-import HsSyn
-import TcBinds		( mkPragFun, tcPrags, badBootDeclErr )
-import TcClassDcl	( tcMethodBind, mkMethodBind, badMethodErr, 
-			  tcClassDecl2, getGenericInstances )
-import TcRnMonad       
-import TcMType		( tcSkolSigType, checkValidInstance, checkValidInstHead )
-import TcType		( mkClassPred, tcSplitSigmaTy, tcSplitDFunHead, mkTyVarTys,
-			  SkolemInfo(InstSkol), tcSplitDFunTy )
-import Inst		( tcInstClassOp, newDicts, instToId, showLIE, 
-			  getOverlapFlag, tcExtendLocalInstEnv )
-import InstEnv		( mkLocalInstance, instanceDFunId )
-import TcDeriv		( tcDeriving )
-import TcEnv		( InstInfo(..), InstBindings(..), 
-			  newDFunName, tcExtendIdEnv
-			)
-import TcHsType		( kcHsSigType, tcHsKindedType )
-import TcUnify		( checkSigTyVars )
-import TcSimplify	( tcSimplifyCheck, tcSimplifySuperClasses )
-import Type		( zipOpenTvSubst, substTheta, substTys )
-import DataCon		( classDataCon )
-import Class		( classBigSig )
-import Var		( Id, idName, idType )
-import MkId		( mkDictFunId )
-import Name		( Name, getSrcLoc )
-import Maybe		( catMaybes )
-import SrcLoc		( srcLocSpan, unLoc, noLoc, Located(..), srcSpanStart )
-import ListSetOps	( minusList )
-import Outputable
-import Bag
-import BasicTypes	( Activation( AlwaysActive ), InlineSpec(..) )
-import FastString
-\end{code}
-
-Typechecking instance declarations is done in two passes. The first
-pass, made by @tcInstDecls1@, collects information to be used in the
-second pass.
-
-This pre-processed info includes the as-yet-unprocessed bindings
-inside the instance declaration.  These are type-checked in the second
-pass, when the class-instance envs and GVE contain all the info from
-all the instance and value decls.  Indeed that's the reason we need
-two passes over the instance decls.
-
-
-Here is the overall algorithm.
-Assume that we have an instance declaration
-
-    instance c => k (t tvs) where b
-
-\begin{enumerate}
-\item
-$LIE_c$ is the LIE for the context of class $c$
-\item
-$betas_bar$ is the free variables in the class method type, excluding the
-   class variable
-\item
-$LIE_cop$ is the LIE constraining a particular class method
-\item
-$tau_cop$ is the tau type of a class method
-\item
-$LIE_i$ is the LIE for the context of instance $i$
-\item
-$X$ is the instance constructor tycon
-\item
-$gammas_bar$ is the set of type variables of the instance
-\item
-$LIE_iop$ is the LIE for a particular class method instance
-\item
-$tau_iop$ is the tau type for this instance of a class method
-\item
-$alpha$ is the class variable
-\item
-$LIE_cop' = LIE_cop [X gammas_bar / alpha, fresh betas_bar]$
-\item
-$tau_cop' = tau_cop [X gammas_bar / alpha, fresh betas_bar]$
-\end{enumerate}
-
-ToDo: Update the list above with names actually in the code.
-
-\begin{enumerate}
-\item
-First, make the LIEs for the class and instance contexts, which means
-instantiate $thetaC [X inst_tyvars / alpha ]$, yielding LIElistC' and LIEC',
-and make LIElistI and LIEI.
-\item
-Then process each method in turn.
-\item
-order the instance methods according to the ordering of the class methods
-\item
-express LIEC' in terms of LIEI, yielding $dbinds_super$ or an error
-\item
-Create final dictionary function from bindings generated already
-\begin{pseudocode}
-df = lambda inst_tyvars
-       lambda LIEI
-	 let Bop1
-	     Bop2
-	     ...
-	     Bopn
-	 and dbinds_super
-	      in <op1,op2,...,opn,sd1,...,sdm>
-\end{pseudocode}
-Here, Bop1 \ldots Bopn bind the methods op1 \ldots opn,
-and $dbinds_super$ bind the superclass dictionaries sd1 \ldots sdm.
-\end{enumerate}
-
-
-%************************************************************************
-%*									*
-\subsection{Extracting instance decls}
-%*									*
-%************************************************************************
-
-Gather up the instance declarations from their various sources
-
-\begin{code}
-tcInstDecls1	-- Deal with both source-code and imported instance decls
-   :: [LTyClDecl Name]		-- For deriving stuff
-   -> [LInstDecl Name]		-- Source code instance decls
-   -> TcM (TcGblEnv,		-- The full inst env
-	   [InstInfo],		-- Source-code instance decls to process; 
-				-- contains all dfuns for this module
-	   HsValBinds Name)	-- Supporting bindings for derived instances
-
-tcInstDecls1 tycl_decls inst_decls
-  = checkNoErrs $
-	-- Stop if addInstInfos etc discovers any errors
-	-- (they recover, so that we get more than one error each round)
-
-   	-- (1) Do the ordinary instance declarations
-    mappM tcLocalInstDecl1 inst_decls    `thenM` \ local_inst_infos ->
-
-    let
-	local_inst_info = catMaybes local_inst_infos
-	clas_decls	= filter (isClassDecl.unLoc) tycl_decls
-    in
-	-- (2) Instances from generic class declarations
-    getGenericInstances clas_decls	`thenM` \ generic_inst_info -> 
-
-	-- Next, construct the instance environment so far, consisting of
-	--	a) local instance decls
-	--	b) generic instances
-    addInsts local_inst_info	$
-    addInsts generic_inst_info	$
-
-	-- (3) Compute instances from "deriving" clauses; 
-	-- This stuff computes a context for the derived instance decl, so it
-	-- needs to know about all the instances possible; hence inst_env4
-    tcDeriving tycl_decls	`thenM` \ (deriv_inst_info, deriv_binds) ->
-    addInsts deriv_inst_info	$
-
-    getGblEnv			`thenM` \ gbl_env ->
-    returnM (gbl_env, 
-	     generic_inst_info ++ deriv_inst_info ++ local_inst_info,
-	     deriv_binds)
-
-addInsts :: [InstInfo] -> TcM a -> TcM a
-addInsts infos thing_inside
-  = tcExtendLocalInstEnv (map iSpec infos) thing_inside
-\end{code} 
-
-\begin{code}
-tcLocalInstDecl1 :: LInstDecl Name 
-		 -> TcM (Maybe InstInfo)	-- Nothing if there was an error
-	-- A source-file instance declaration
-	-- Type-check all the stuff before the "where"
-	--
-	-- We check for respectable instance type, and context
-tcLocalInstDecl1 decl@(L loc (InstDecl poly_ty binds uprags))
-  =	-- Prime error recovery, set source location
-    recoverM (returnM Nothing)		$
-    setSrcSpan loc			$
-    addErrCtxt (instDeclCtxt1 poly_ty)	$
-
-    do	{ is_boot <- tcIsHsBoot
-	; checkTc (not is_boot || (isEmptyLHsBinds binds && null uprags))
-		  badBootDeclErr
-
-	-- Typecheck the instance type itself.  We can't use 
-	-- tcHsSigType, because it's not a valid user type.
-	; kinded_ty <- kcHsSigType poly_ty
-	; poly_ty'  <- tcHsKindedType kinded_ty
-	; let (tyvars, theta, tau) = tcSplitSigmaTy poly_ty'
-	
-	; (clas, inst_tys) <- checkValidInstHead tau
-	; checkValidInstance tyvars theta clas inst_tys
-
-	; dfun_name <- newDFunName clas inst_tys (srcSpanStart loc)
-	; overlap_flag <- getOverlapFlag
-	; let dfun  = mkDictFunId dfun_name tyvars theta clas inst_tys
-	      ispec = mkLocalInstance dfun overlap_flag
-
-	; return (Just (InstInfo { iSpec = ispec, iBinds = VanillaInst binds uprags })) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Type-checking instance declarations, pass 2}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcInstDecls2 :: [LTyClDecl Name] -> [InstInfo] 
-	     -> TcM (LHsBinds Id, TcLclEnv)
--- (a) From each class declaration, 
---	generate any default-method bindings
--- (b) From each instance decl
---	generate the dfun binding
-
-tcInstDecls2 tycl_decls inst_decls
-  = do	{	-- (a) Default methods from class decls
-	  (dm_binds_s, dm_ids_s) <- mapAndUnzipM tcClassDecl2 $
-			            filter (isClassDecl.unLoc) tycl_decls
-	; tcExtendIdEnv (concat dm_ids_s) 	$ do 
-    
-	 	-- (b) instance declarations
-	; inst_binds_s <- mappM tcInstDecl2 inst_decls
-
-		-- Done
-	; let binds = unionManyBags dm_binds_s `unionBags` 
-		      unionManyBags inst_binds_s
-	; tcl_env <- getLclEnv		-- Default method Ids in here
-	; returnM (binds, tcl_env) }
-\end{code}
-
-======= New documentation starts here (Sept 92)	 ==============
-
-The main purpose of @tcInstDecl2@ is to return a @HsBinds@ which defines
-the dictionary function for this instance declaration.	For example
-\begin{verbatim}
-	instance Foo a => Foo [a] where
-		op1 x = ...
-		op2 y = ...
-\end{verbatim}
-might generate something like
-\begin{verbatim}
-	dfun.Foo.List dFoo_a = let op1 x = ...
-				   op2 y = ...
-			       in
-				   Dict [op1, op2]
-\end{verbatim}
-
-HOWEVER, if the instance decl has no context, then it returns a
-bigger @HsBinds@ with declarations for each method.  For example
-\begin{verbatim}
-	instance Foo [a] where
-		op1 x = ...
-		op2 y = ...
-\end{verbatim}
-might produce
-\begin{verbatim}
-	dfun.Foo.List a = Dict [Foo.op1.List a, Foo.op2.List a]
-	const.Foo.op1.List a x = ...
-	const.Foo.op2.List a y = ...
-\end{verbatim}
-This group may be mutually recursive, because (for example) there may
-be no method supplied for op2 in which case we'll get
-\begin{verbatim}
-	const.Foo.op2.List a = default.Foo.op2 (dfun.Foo.List a)
-\end{verbatim}
-that is, the default method applied to the dictionary at this type.
-
-What we actually produce in either case is:
-
-	AbsBinds [a] [dfun_theta_dicts]
-		 [(dfun.Foo.List, d)] ++ (maybe) [(const.Foo.op1.List, op1), ...]
-		 { d = (sd1,sd2, ..., op1, op2, ...)
-		   op1 = ...
-		   op2 = ...
-	 	 }
-
-The "maybe" says that we only ask AbsBinds to make global constant methods
-if the dfun_theta is empty.
-
-		
-For an instance declaration, say,
-
-	instance (C1 a, C2 b) => C (T a b) where
-		...
-
-where the {\em immediate} superclasses of C are D1, D2, we build a dictionary
-function whose type is
-
-	(C1 a, C2 b, D1 (T a b), D2 (T a b)) => C (T a b)
-
-Notice that we pass it the superclass dictionaries at the instance type; this
-is the ``Mark Jones optimisation''.  The stuff before the "=>" here
-is the @dfun_theta@ below.
-
-First comes the easy case of a non-local instance decl.
-
-
-\begin{code}
-tcInstDecl2 :: InstInfo -> TcM (LHsBinds Id)
-
-tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = binds })
-  = let 
-	dfun_id    = instanceDFunId ispec
-	rigid_info = InstSkol dfun_id
-	inst_ty    = idType dfun_id
-    in
-	 -- Prime error recovery
-    recoverM (returnM emptyLHsBinds)		$
-    setSrcSpan (srcLocSpan (getSrcLoc dfun_id))	$
-    addErrCtxt (instDeclCtxt2 (idType dfun_id))	$
-
-	-- Instantiate the instance decl with skolem constants 
-    tcSkolSigType rigid_info inst_ty	`thenM` \ (inst_tyvars', dfun_theta', inst_head') ->
-		-- These inst_tyvars' scope over the 'where' part
-		-- Those tyvars are inside the dfun_id's type, which is a bit
-		-- bizarre, but OK so long as you realise it!
-    let
-	(clas, inst_tys') = tcSplitDFunHead inst_head'
-        (class_tyvars, sc_theta, _, op_items) = classBigSig clas
-
-        -- Instantiate the super-class context with inst_tys
-	sc_theta' = substTheta (zipOpenTvSubst class_tyvars inst_tys') sc_theta
-	origin	  = SigOrigin rigid_info
-    in
-	 -- Create dictionary Ids from the specified instance contexts.
-    newDicts InstScOrigin sc_theta'			`thenM` \ sc_dicts ->
-    newDicts origin dfun_theta'				`thenM` \ dfun_arg_dicts ->
-    newDicts origin [mkClassPred clas inst_tys'] 	`thenM` \ [this_dict] ->
-		-- Default-method Ids may be mentioned in synthesised RHSs,
-		-- but they'll already be in the environment.
-
-	-- Typecheck the methods
-    let		-- These insts are in scope; quite a few, eh?
-	avail_insts = [this_dict] ++ dfun_arg_dicts ++ sc_dicts
-    in
-    tcMethods origin clas inst_tyvars' 
-	      dfun_theta' inst_tys' avail_insts 
-	      op_items binds		`thenM` \ (meth_ids, meth_binds) ->
-
-	-- Figure out bindings for the superclass context
-	-- Don't include this_dict in the 'givens', else
-	-- sc_dicts get bound by just selecting  from this_dict!!
-    addErrCtxt superClassCtxt
-	(tcSimplifySuperClasses inst_tyvars'
-			 dfun_arg_dicts
-			 sc_dicts)	`thenM` \ sc_binds ->
-
-	-- It's possible that the superclass stuff might unified one
-	-- of the inst_tyavars' with something in the envt
-    checkSigTyVars inst_tyvars' 	`thenM_`
-
-	-- Deal with 'SPECIALISE instance' pragmas 
-    let
-	specs = case binds of
-		  VanillaInst _ prags -> filter isSpecInstLSig prags
-		  other	 	      -> []
-    in
-    tcPrags dfun_id specs			`thenM` \ prags -> 
-    
-	-- Create the result bindings
-    let
-        dict_constr   = classDataCon clas
-	scs_and_meths = map instToId sc_dicts ++ meth_ids
-	this_dict_id  = instToId this_dict
-	inline_prag | null dfun_arg_dicts = []
-		    | otherwise	= [InlinePrag (Inline AlwaysActive True)]
-		-- Always inline the dfun; this is an experimental decision
-		-- because it makes a big performance difference sometimes.
-		-- Often it means we can do the method selection, and then
-		-- inline the method as well.  Marcin's idea; see comments below.
-		--
-		-- BUT: don't inline it if it's a constant dictionary;
-		-- we'll get all the benefit without inlining, and we get
-		-- a **lot** of code duplication if we inline it
-		--
-		--	See Note [Inline dfuns] below
-
-	dict_rhs
-	  = mkHsConApp dict_constr inst_tys' (map HsVar scs_and_meths)
-		-- We don't produce a binding for the dict_constr; instead we
-		-- rely on the simplifier to unfold this saturated application
-		-- We do this rather than generate an HsCon directly, because
-		-- it means that the special cases (e.g. dictionary with only one
-		-- member) are dealt with by the common MkId.mkDataConWrapId code rather
-		-- than needing to be repeated here.
-
-	dict_bind  = noLoc (VarBind this_dict_id dict_rhs)
-	all_binds  = dict_bind `consBag` (sc_binds `unionBags` meth_binds)
-
-	main_bind = noLoc $ AbsBinds
-		 	    inst_tyvars'
-		 	    (map instToId dfun_arg_dicts)
-		 	    [(inst_tyvars', dfun_id, this_dict_id, 
-					    inline_prag ++ prags)] 
-		 	    all_binds
-    in
-    showLIE (text "instance") 		`thenM_`
-    returnM (unitBag main_bind)
-
-
-tcMethods origin clas inst_tyvars' dfun_theta' inst_tys' 
-	  avail_insts op_items (VanillaInst monobinds uprags)
-  = 	-- Check that all the method bindings come from this class
-    let
-	sel_names = [idName sel_id | (sel_id, _) <- op_items]
-	bad_bndrs = collectHsBindBinders monobinds `minusList` sel_names
-    in
-    mappM (addErrTc . badMethodErr clas) bad_bndrs	`thenM_`
-
-	-- Make the method bindings
-    let
-	mk_method_bind = mkMethodBind origin clas inst_tys' monobinds
-    in
-    mapAndUnzipM mk_method_bind op_items 	`thenM` \ (meth_insts, meth_infos) ->
-
-	-- And type check them
-	-- It's really worth making meth_insts available to the tcMethodBind
-	-- Consider	instance Monad (ST s) where
-	--		  {-# INLINE (>>) #-}
-	--		  (>>) = ...(>>=)...
-	-- If we don't include meth_insts, we end up with bindings like this:
-	--	rec { dict = MkD then bind ...
-	--	      then = inline_me (... (GHC.Base.>>= dict) ...)
-	--	      bind = ... }
-	-- The trouble is that (a) 'then' and 'dict' are mutually recursive, 
-	-- and (b) the inline_me prevents us inlining the >>= selector, which
-	-- would unravel the loop.  Result: (>>) ends up as a loop breaker, and
-	-- is not inlined across modules. Rather ironic since this does not
-	-- happen without the INLINE pragma!  
-	--
-	-- Solution: make meth_insts available, so that 'then' refers directly
-	-- 	     to the local 'bind' rather than going via the dictionary.
-	--
-	-- BUT WATCH OUT!  If the method type mentions the class variable, then
-	-- this optimisation is not right.  Consider
-	--	class C a where
-	--	  op :: Eq a => a
-	--
-	--	instance C Int where
-	--	  op = op
-	-- The occurrence of 'op' on the rhs gives rise to a constraint
-	--	op at Int
-	-- The trouble is that the 'meth_inst' for op, which is 'available', also
-	-- looks like 'op at Int'.  But they are not the same.
-    let
-	prag_fn	       = mkPragFun uprags
-	all_insts      = avail_insts ++ catMaybes meth_insts
-	tc_method_bind = tcMethodBind inst_tyvars' dfun_theta' all_insts prag_fn
-	meth_ids       = [meth_id | (_,meth_id,_) <- meth_infos]
-    in
-
-    mapM tc_method_bind meth_infos		`thenM` \ meth_binds_s ->
-   
-    returnM (meth_ids, unionManyBags meth_binds_s)
-
-
--- Derived newtype instances
-tcMethods origin clas inst_tyvars' dfun_theta' inst_tys' 
-	  avail_insts op_items (NewTypeDerived rep_tys)
-  = getInstLoc origin				`thenM` \ inst_loc ->
-    mapAndUnzip3M (do_one inst_loc) op_items	`thenM` \ (meth_ids, meth_binds, rhs_insts) ->
-    
-    tcSimplifyCheck
-	 (ptext SLIT("newtype derived instance"))
-	 inst_tyvars' avail_insts rhs_insts	`thenM` \ lie_binds ->
-
-	-- I don't think we have to do the checkSigTyVars thing
-
-    returnM (meth_ids, lie_binds `unionBags` listToBag meth_binds)
-
-  where
-    do_one inst_loc (sel_id, _)
-	= -- The binding is like "op @ NewTy = op @ RepTy"
-		-- Make the *binder*, like in mkMethodBind
-	  tcInstClassOp inst_loc sel_id inst_tys'	`thenM` \ meth_inst ->
-
-		-- Make the *occurrence on the rhs*
-	  tcInstClassOp inst_loc sel_id rep_tys'	`thenM` \ rhs_inst ->
-	  let
-	     meth_id = instToId meth_inst
-	  in
-	  return (meth_id, noLoc (VarBind meth_id (nlHsVar (instToId rhs_inst))), rhs_inst)
-
-	-- Instantiate rep_tys with the relevant type variables
-	-- This looks a bit odd, because inst_tyvars' are the skolemised version
-	-- of the type variables in the instance declaration; but rep_tys doesn't
-	-- have the skolemised version, so we substitute them in here
-    rep_tys' = substTys subst rep_tys
-    subst    = zipOpenTvSubst inst_tyvars' (mkTyVarTys inst_tyvars')
-\end{code}
-
-
-		------------------------------
-	[Inline dfuns] Inlining dfuns unconditionally
-		------------------------------
-
-The code above unconditionally inlines dict funs.  Here's why.
-Consider this program:
-
-    test :: Int -> Int -> Bool
-    test x y = (x,y) == (y,x) || test y x
-    -- Recursive to avoid making it inline.
-
-This needs the (Eq (Int,Int)) instance.  If we inline that dfun
-the code we end up with is good:
-
-    Test.$wtest =
-	\r -> case ==# [ww ww1] of wild {
-		PrelBase.False -> Test.$wtest ww1 ww;
-		PrelBase.True ->
-		  case ==# [ww1 ww] of wild1 {
-		    PrelBase.False -> Test.$wtest ww1 ww;
-		    PrelBase.True -> PrelBase.True [];
-		  };
-	    };
-    Test.test = \r [w w1]
-	    case w of w2 {
-	      PrelBase.I# ww ->
-		  case w1 of w3 { PrelBase.I# ww1 -> Test.$wtest ww ww1; };
-	    };
-
-If we don't inline the dfun, the code is not nearly as good:
-
-    (==) = case PrelTup.$fEq(,) PrelBase.$fEqInt PrelBase.$fEqInt of tpl {
-	      PrelBase.:DEq tpl1 tpl2 -> tpl2;
-	    };
-    
-    Test.$wtest =
-	\r [ww ww1]
-	    let { y = PrelBase.I#! [ww1]; } in
-	    let { x = PrelBase.I#! [ww]; } in
-	    let { sat_slx = PrelTup.(,)! [y x]; } in
-	    let { sat_sly = PrelTup.(,)! [x y];
-	    } in
-	      case == sat_sly sat_slx of wild {
-		PrelBase.False -> Test.$wtest ww1 ww;
-		PrelBase.True -> PrelBase.True [];
-	      };
-    
-    Test.test =
-	\r [w w1]
-	    case w of w2 {
-	      PrelBase.I# ww ->
-		  case w1 of w3 { PrelBase.I# ww1 -> Test.$wtest ww ww1; };
-	    };
-
-Why doesn't GHC inline $fEq?  Because it looks big:
-
-    PrelTup.zdfEqZ1T{-rcX-}
-	= \ @ a{-reT-} :: * @ b{-reS-} :: *
-            zddEq{-rf6-} _Ks :: {PrelBase.Eq{-23-} a{-reT-}}
-            zddEq1{-rf7-} _Ks :: {PrelBase.Eq{-23-} b{-reS-}} ->
-            let {
-              zeze{-rf0-} _Kl :: (b{-reS-} -> b{-reS-} -> PrelBase.Bool{-3c-})
-              zeze{-rf0-} = PrelBase.zeze{-01L-}@ b{-reS-} zddEq1{-rf7-} } in
-            let {
-              zeze1{-rf3-} _Kl :: (a{-reT-} -> a{-reT-} -> PrelBase.Bool{-3c-})
-              zeze1{-rf3-} = PrelBase.zeze{-01L-} @ a{-reT-} zddEq{-rf6-} } in
-            let {
-              zeze2{-reN-} :: ((a{-reT-}, b{-reS-}) -> (a{-reT-}, b{-reS-})-> PrelBase.Bool{-3c-})
-              zeze2{-reN-} = \ ds{-rf5-} _Ks :: (a{-reT-}, b{-reS-})
-		               ds1{-rf4-} _Ks :: (a{-reT-}, b{-reS-}) ->
-                  	     case ds{-rf5-}
-                  	     of wild{-reW-} _Kd { (a1{-rf2-} _Ks, a2{-reZ-} _Ks) ->
-                  	     case ds1{-rf4-}
-                  	     of wild1{-reX-} _Kd { (b1{-rf1-} _Ks, b2{-reY-} _Ks) ->
-                  	     PrelBase.zaza{-r4e-}
-                  	       (zeze1{-rf3-} a1{-rf2-} b1{-rf1-})
-                  	       (zeze{-rf0-} a2{-reZ-} b2{-reY-})
-                  	     }
-                  	     } } in     
-            let {
-              a1{-reR-} :: ((a{-reT-}, b{-reS-})-> (a{-reT-}, b{-reS-})-> PrelBase.Bool{-3c-})
-              a1{-reR-} = \ a2{-reV-} _Ks :: (a{-reT-}, b{-reS-})
-			    b1{-reU-} _Ks :: (a{-reT-}, b{-reS-}) ->
-                    	  PrelBase.not{-r6I-} (zeze2{-reN-} a2{-reV-} b1{-reU-})
-            } in
-              PrelBase.zdwZCDEq{-r8J-} @ (a{-reT-}, b{-reS-}) a1{-reR-} zeze2{-reN-})
-
-and it's not as bad as it seems, because it's further dramatically
-simplified: only zeze2 is extracted and its body is simplified.
-
-
-%************************************************************************
-%*									*
-\subsection{Error messages}
-%*									*
-%************************************************************************
-
-\begin{code}
-instDeclCtxt1 hs_inst_ty 
-  = inst_decl_ctxt (case unLoc hs_inst_ty of
-			HsForAllTy _ _ _ (L _ (HsPredTy pred)) -> ppr pred
-			HsPredTy pred	                 -> ppr pred
-			other			         -> ppr hs_inst_ty)	-- Don't expect this
-instDeclCtxt2 dfun_ty
-  = inst_decl_ctxt (ppr (mkClassPred cls tys))
-  where
-    (_,_,cls,tys) = tcSplitDFunTy dfun_ty
-
-inst_decl_ctxt doc = ptext SLIT("In the instance declaration for") <+> quotes doc
-
-superClassCtxt = ptext SLIT("When checking the super-classes of an instance declaration")
-\end{code}
diff --git a/ghc/compiler/typecheck/TcMType.lhs b/ghc/compiler/typecheck/TcMType.lhs
deleted file mode 100644
index fa129d3927..0000000000
--- a/ghc/compiler/typecheck/TcMType.lhs
+++ /dev/null
@@ -1,1206 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section{Monadic type operations}
-
-This module contains monadic operations over types that contain mutable type variables
-
-\begin{code}
-module TcMType (
-  TcTyVar, TcKind, TcType, TcTauType, TcThetaType, TcTyVarSet,
-
-  --------------------------------
-  -- Creating new mutable type variables
-  newFlexiTyVar,
-  newFlexiTyVarTy,		-- Kind -> TcM TcType
-  newFlexiTyVarTys,		-- Int -> Kind -> TcM [TcType]
-  newKindVar, newKindVars, 
-  lookupTcTyVar, LookupTyVarResult(..),
-  newMetaTyVar, readMetaTyVar, writeMetaTyVar, 
-
-  --------------------------------
-  -- Boxy type variables
-  newBoxyTyVar, newBoxyTyVars, newBoxyTyVarTys, readFilledBox, 
-
-  --------------------------------
-  -- Instantiation
-  tcInstTyVar, tcInstType, tcInstTyVars, tcInstBoxy, tcInstBoxyTyVar,
-  tcInstSigTyVars, zonkSigTyVar,
-  tcInstSkolTyVar, tcInstSkolTyVars, tcInstSkolType, 
-  tcSkolSigType, tcSkolSigTyVars,
-
-  --------------------------------
-  -- Checking type validity
-  Rank, UserTypeCtxt(..), checkValidType, 
-  SourceTyCtxt(..), checkValidTheta, checkFreeness,
-  checkValidInstHead, checkValidInstance, checkAmbiguity,
-  checkInstTermination,
-  arityErr, 
-
-  --------------------------------
-  -- Zonking
-  zonkType, zonkTcPredType, 
-  zonkTcTyVar, zonkTcTyVars, zonkTcTyVarsAndFV, zonkQuantifiedTyVar,
-  zonkTcType, zonkTcTypes, zonkTcClassConstraints, zonkTcThetaType,
-  zonkTcKindToKind, zonkTcKind,
-
-  readKindVar, writeKindVar
-
-  ) where
-
-#include "HsVersions.h"
-
-
--- friends:
-import TypeRep		( Type(..), PredType(..),  -- Friend; can see representation
-			  ThetaType
-			) 
-import TcType		( TcType, TcThetaType, TcTauType, TcPredType,
-			  TcTyVarSet, TcKind, TcTyVar, TcTyVarDetails(..), 
-			  MetaDetails(..), SkolemInfo(..), BoxInfo(..), 
-			  BoxyTyVar, BoxyType, BoxyThetaType, BoxySigmaType, 
-			  UserTypeCtxt(..),
-			  isMetaTyVar, isSigTyVar, metaTvRef,
-			  tcCmpPred, isClassPred, tcGetTyVar,
-			  tcSplitPhiTy, tcSplitPredTy_maybe, tcSplitAppTy_maybe, 
-			  tcValidInstHeadTy, tcSplitForAllTys,
-			  tcIsTyVarTy, tcSplitSigmaTy, 
-			  isUnLiftedType, isIPPred, 
-			  typeKind, isSkolemTyVar,
-			  mkAppTy, mkTyVarTy, mkTyVarTys, 
-			  tyVarsOfPred, getClassPredTys_maybe,
-			  tyVarsOfType, tyVarsOfTypes, tcView,
-			  pprPred, pprTheta, pprClassPred )
-import Kind		( Kind(..), KindVar, kindVarRef, mkKindVar, 
-			  isLiftedTypeKind, isArgTypeKind, isOpenTypeKind,
-			  liftedTypeKind, defaultKind
-			)
-import Type		( TvSubst, zipTopTvSubst, substTy )
-import Class		( Class, classArity, className )
-import TyCon		( TyCon, isSynTyCon, isUnboxedTupleTyCon, 
-			  tyConArity, tyConName )
-import Var		( TyVar, tyVarKind, tyVarName, isTcTyVar, 
-			  mkTyVar, mkTcTyVar, tcTyVarDetails )
-
-	-- Assertions
-#ifdef DEBUG
-import TcType		( isFlexi, isBoxyTyVar, isImmutableTyVar )
-import Kind		( isSubKind )
-#endif
-
--- others:
-import TcRnMonad          -- TcType, amongst others
-import FunDeps		( grow, checkInstCoverage )
-import Name		( Name, setNameUnique, mkSysTvName )
-import VarSet
-import DynFlags		( dopt, DynFlag(..) )
-import Util		( nOfThem, isSingleton, notNull )
-import ListSetOps	( removeDups )
-import Outputable
-
-import Control.Monad	( when )
-import Data.List	( (\\) )
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Instantiation in general
-%*									*
-%************************************************************************
-
-\begin{code}
-tcInstType :: ([TyVar] -> TcM [TcTyVar]) 		-- How to instantiate the type variables
-	   -> TcType 					-- Type to instantiate
-	   -> TcM ([TcTyVar], TcThetaType, TcType)	-- Result
-tcInstType inst_tyvars ty
-  = case tcSplitForAllTys ty of
-	([],     rho) -> let	-- There may be overloading despite no type variables;
-				-- 	(?x :: Int) => Int -> Int
-			   (theta, tau) = tcSplitPhiTy rho
-			 in
-			 return ([], theta, tau)
-
-	(tyvars, rho) -> do { tyvars' <- inst_tyvars tyvars
-
-			    ; let  tenv = zipTopTvSubst tyvars (mkTyVarTys tyvars')
-				-- Either the tyvars are freshly made, by inst_tyvars,
-				-- or (in the call from tcSkolSigType) any nested foralls
-				-- have different binders.  Either way, zipTopTvSubst is ok
-
-			    ; let  (theta, tau) = tcSplitPhiTy (substTy tenv rho)
-			    ; return (tyvars', theta, tau) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Kind variables
-%*									*
-%************************************************************************
-
-\begin{code}
-newKindVar :: TcM TcKind
-newKindVar = do	{ uniq <- newUnique
-		; ref <- newMutVar Nothing
-		; return (KindVar (mkKindVar uniq ref)) }
-
-newKindVars :: Int -> TcM [TcKind]
-newKindVars n = mappM (\ _ -> newKindVar) (nOfThem n ())
-\end{code}
-
-
-%************************************************************************
-%*									*
-	SkolemTvs (immutable)
-%*									*
-%************************************************************************
-
-\begin{code}
-mkSkolTyVar :: Name -> Kind -> SkolemInfo -> TcTyVar
-mkSkolTyVar name kind info = mkTcTyVar name kind (SkolemTv info)
-
-tcSkolSigType :: SkolemInfo -> Type -> TcM ([TcTyVar], TcThetaType, TcType)
--- Instantiate a type signature with skolem constants, but 
--- do *not* give them fresh names, because we want the name to
--- be in the type environment -- it is lexically scoped.
-tcSkolSigType info ty = tcInstType (\tvs -> return (tcSkolSigTyVars info tvs)) ty
-
-tcSkolSigTyVars :: SkolemInfo -> [TyVar] -> [TcTyVar]
--- Make skolem constants, but do *not* give them new names, as above
-tcSkolSigTyVars info tyvars = [ mkSkolTyVar (tyVarName tv) (tyVarKind tv) info
-			      | tv <- tyvars ]
-
-tcInstSkolType :: SkolemInfo -> TcType -> TcM ([TcTyVar], TcThetaType, TcType)
--- Instantiate a type with fresh skolem constants
-tcInstSkolType info ty = tcInstType (tcInstSkolTyVars info) ty
-
-tcInstSkolTyVar :: SkolemInfo -> TyVar -> TcM TcTyVar
-tcInstSkolTyVar info tyvar
-  = do	{ uniq <- newUnique
-	; let name = setNameUnique (tyVarName tyvar) uniq
-	      kind = tyVarKind tyvar
-	; return (mkSkolTyVar name kind info) }
-
-tcInstSkolTyVars :: SkolemInfo -> [TyVar] -> TcM [TcTyVar]
-tcInstSkolTyVars info tyvars = mapM (tcInstSkolTyVar info) tyvars
-\end{code}
-
-
-%************************************************************************
-%*									*
-	MetaTvs (meta type variables; mutable)
-%*									*
-%************************************************************************
-
-\begin{code}
-newMetaTyVar :: BoxInfo -> Kind -> TcM TcTyVar
--- Make a new meta tyvar out of thin air
-newMetaTyVar box_info kind
-  = do	{ uniq <- newUnique
- 	; ref <- newMutVar Flexi ;
-	; let name = mkSysTvName uniq fs 
-	      fs = case box_info of
-			BoxTv   -> FSLIT("bx")
-			TauTv   -> FSLIT("t")
-			SigTv _ -> FSLIT("a")
-	; return (mkTcTyVar name kind (MetaTv box_info ref)) }
-
-instMetaTyVar :: BoxInfo -> TyVar -> TcM TcTyVar
--- Make a new meta tyvar whose Name and Kind 
--- come from an existing TyVar
-instMetaTyVar box_info tyvar
-  = do	{ uniq <- newUnique
- 	; ref <- newMutVar Flexi ;
-	; let name = setNameUnique (tyVarName tyvar) uniq
-	      kind = tyVarKind tyvar
-	; return (mkTcTyVar name kind (MetaTv box_info ref)) }
-
-readMetaTyVar :: TyVar -> TcM MetaDetails
-readMetaTyVar tyvar = ASSERT2( isMetaTyVar tyvar, ppr tyvar )
-		      readMutVar (metaTvRef tyvar)
-
-writeMetaTyVar :: TcTyVar -> TcType -> TcM ()
-#ifndef DEBUG
-writeMetaTyVar tyvar ty = writeMutVar (metaTvRef tyvar) (Indirect ty)
-#else
-writeMetaTyVar tyvar ty
-  | not (isMetaTyVar tyvar)
-  = pprTrace "writeMetaTyVar" (ppr tyvar) $
-    returnM ()
-
-  | otherwise
-  = ASSERT( isMetaTyVar tyvar )
-    ASSERT2( k2 `isSubKind` k1, (ppr tyvar <+> ppr k1) $$ (ppr ty <+> ppr k2) )
-    do	{ ASSERTM2( do { details <- readMetaTyVar tyvar; return (isFlexi details) }, ppr tyvar )
-	; writeMutVar (metaTvRef tyvar) (Indirect ty) }
-  where
-    k1 = tyVarKind tyvar
-    k2 = typeKind ty
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-	MetaTvs: TauTvs
-%*									*
-%************************************************************************
-
-\begin{code}
-newFlexiTyVar :: Kind -> TcM TcTyVar
-newFlexiTyVar kind = newMetaTyVar TauTv kind
-
-newFlexiTyVarTy  :: Kind -> TcM TcType
-newFlexiTyVarTy kind
-  = newFlexiTyVar kind	`thenM` \ tc_tyvar ->
-    returnM (TyVarTy tc_tyvar)
-
-newFlexiTyVarTys :: Int -> Kind -> TcM [TcType]
-newFlexiTyVarTys n kind = mappM newFlexiTyVarTy (nOfThem n kind)
-
-tcInstTyVar :: TyVar -> TcM TcTyVar
--- Instantiate with a META type variable
-tcInstTyVar tyvar = instMetaTyVar TauTv tyvar
-
-tcInstTyVars :: [TyVar] -> TcM ([TcTyVar], [TcType], TvSubst)
--- Instantiate with META type variables
-tcInstTyVars tyvars
-  = do	{ tc_tvs <- mapM tcInstTyVar tyvars
-	; let tys = mkTyVarTys tc_tvs
-	; returnM (tc_tvs, tys, zipTopTvSubst tyvars tys) }
-		-- Since the tyvars are freshly made,
-		-- they cannot possibly be captured by
-		-- any existing for-alls.  Hence zipTopTvSubst
-\end{code}
-
-
-%************************************************************************
-%*									*
-	MetaTvs: SigTvs
-%*									*
-%************************************************************************
-
-\begin{code}
-tcInstSigTyVars :: SkolemInfo -> [TyVar] -> TcM [TcTyVar]
--- Instantiate with meta SigTvs
-tcInstSigTyVars skol_info tyvars 
-  = mapM (instMetaTyVar (SigTv skol_info)) tyvars
-
-zonkSigTyVar :: TcTyVar -> TcM TcTyVar
-zonkSigTyVar sig_tv 
-  | isSkolemTyVar sig_tv 
-  = return sig_tv	-- Happens in the call in TcBinds.checkDistinctTyVars
-  | otherwise
-  = ASSERT( isSigTyVar sig_tv )
-    do { ty <- zonkTcTyVar sig_tv
-       ; return (tcGetTyVar "zonkSigTyVar" ty) }
-	-- 'ty' is bound to be a type variable, because SigTvs
-	-- can only be unified with type variables
-\end{code}
-
-
-%************************************************************************
-%*									*
-	MetaTvs: BoxTvs
-%*									*
-%************************************************************************
-
-\begin{code}
-newBoxyTyVar :: Kind -> TcM BoxyTyVar
-newBoxyTyVar kind = newMetaTyVar BoxTv kind
-
-newBoxyTyVars :: [Kind] -> TcM [BoxyTyVar]
-newBoxyTyVars kinds = mapM newBoxyTyVar kinds
-
-newBoxyTyVarTys :: [Kind] -> TcM [BoxyType]
-newBoxyTyVarTys kinds = do { tvs <- mapM newBoxyTyVar kinds; return (mkTyVarTys tvs) }
-
-readFilledBox :: BoxyTyVar -> TcM TcType
--- Read the contents of the box, which should be filled in by now
-readFilledBox box_tv = ASSERT( isBoxyTyVar box_tv )
-		       do { cts <- readMetaTyVar box_tv
-		 	  ; case cts of
-				Flexi 	    -> pprPanic "readFilledBox" (ppr box_tv)
-				Indirect ty -> return ty }
-
-tcInstBoxyTyVar :: TyVar -> TcM BoxyTyVar
--- Instantiate with a BOXY type variable
-tcInstBoxyTyVar tyvar = instMetaTyVar BoxTv tyvar
-
-tcInstBoxy :: TcType -> TcM ([BoxyTyVar], BoxyThetaType, BoxySigmaType)
--- tcInstType instantiates the outer-level for-alls of a TcType with
--- fresh BOXY type variables, splits off the dictionary part, 
--- and returns the pieces.
-tcInstBoxy ty = tcInstType (mapM tcInstBoxyTyVar) ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Putting and getting  mutable type variables}
-%*									*
-%************************************************************************
-
-But it's more fun to short out indirections on the way: If this
-version returns a TyVar, then that TyVar is unbound.  If it returns
-any other type, then there might be bound TyVars embedded inside it.
-
-We return Nothing iff the original box was unbound.
-
-\begin{code}
-data LookupTyVarResult	-- The result of a lookupTcTyVar call
-  = DoneTv TcTyVarDetails	-- SkolemTv or virgin MetaTv
-  | IndirectTv TcType
-
-lookupTcTyVar :: TcTyVar -> TcM LookupTyVarResult
-lookupTcTyVar tyvar 
-  = case details of
-      SkolemTv _   -> return (DoneTv details)
-      MetaTv _ ref -> do { meta_details <- readMutVar ref
-			 ; case meta_details of
-			    Indirect ty -> return (IndirectTv ty)
-			    Flexi       -> return (DoneTv details) }
-  where
-    details =  tcTyVarDetails tyvar
-
-{- 
--- gaw 2004 We aren't shorting anything out anymore, at least for now
-getTcTyVar tyvar
-  | not (isTcTyVar tyvar)
-  = pprTrace "getTcTyVar" (ppr tyvar) $
-    returnM (Just (mkTyVarTy tyvar))
-
-  | otherwise
-  = ASSERT2( isTcTyVar tyvar, ppr tyvar )
-    readMetaTyVar tyvar				`thenM` \ maybe_ty ->
-    case maybe_ty of
-	Just ty -> short_out ty				`thenM` \ ty' ->
-		   writeMetaTyVar tyvar (Just ty')	`thenM_`
-		   returnM (Just ty')
-
-	Nothing	   -> returnM Nothing
-
-short_out :: TcType -> TcM TcType
-short_out ty@(TyVarTy tyvar)
-  | not (isTcTyVar tyvar)
-  = returnM ty
-
-  | otherwise
-  = readMetaTyVar tyvar	`thenM` \ maybe_ty ->
-    case maybe_ty of
-	Just ty' -> short_out ty' 			`thenM` \ ty' ->
-		    writeMetaTyVar tyvar (Just ty')	`thenM_`
-		    returnM ty'
-
-	other    -> returnM ty
-
-short_out other_ty = returnM other_ty
--}
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Zonking -- the exernal interfaces}
-%*									*
-%************************************************************************
-
------------------  Type variables
-
-\begin{code}
-zonkTcTyVars :: [TcTyVar] -> TcM [TcType]
-zonkTcTyVars tyvars = mappM zonkTcTyVar tyvars
-
-zonkTcTyVarsAndFV :: [TcTyVar] -> TcM TcTyVarSet
-zonkTcTyVarsAndFV tyvars = mappM zonkTcTyVar tyvars	`thenM` \ tys ->
-			   returnM (tyVarsOfTypes tys)
-
-zonkTcTyVar :: TcTyVar -> TcM TcType
-zonkTcTyVar tyvar = ASSERT( isTcTyVar tyvar )
-		    zonk_tc_tyvar (\ tv -> returnM (TyVarTy tv)) tyvar
-\end{code}
-
------------------  Types
-
-\begin{code}
-zonkTcType :: TcType -> TcM TcType
-zonkTcType ty = zonkType (\ tv -> returnM (TyVarTy tv)) ty
-
-zonkTcTypes :: [TcType] -> TcM [TcType]
-zonkTcTypes tys = mappM zonkTcType tys
-
-zonkTcClassConstraints cts = mappM zonk cts
-    where zonk (clas, tys)
-	    = zonkTcTypes tys	`thenM` \ new_tys ->
-	      returnM (clas, new_tys)
-
-zonkTcThetaType :: TcThetaType -> TcM TcThetaType
-zonkTcThetaType theta = mappM zonkTcPredType theta
-
-zonkTcPredType :: TcPredType -> TcM TcPredType
-zonkTcPredType (ClassP c ts)
-  = zonkTcTypes ts	`thenM` \ new_ts ->
-    returnM (ClassP c new_ts)
-zonkTcPredType (IParam n t)
-  = zonkTcType t	`thenM` \ new_t ->
-    returnM (IParam n new_t)
-\end{code}
-
--------------------  These ...ToType, ...ToKind versions
-		     are used at the end of type checking
-
-\begin{code}
-zonkQuantifiedTyVar :: TcTyVar -> TcM TyVar
--- zonkQuantifiedTyVar is applied to the a TcTyVar when quantifying over it.
--- It might be a meta TyVar, in which case we freeze it into an ordinary TyVar.
--- When we do this, we also default the kind -- see notes with Kind.defaultKind
--- The meta tyvar is updated to point to the new regular TyVar.  Now any 
--- bound occurences of the original type variable will get zonked to 
--- the immutable version.
---
--- We leave skolem TyVars alone; they are immutable.
-zonkQuantifiedTyVar tv
-  | isSkolemTyVar tv = return tv
-	-- It might be a skolem type variable, 
-	-- for example from a user type signature
-
-  | otherwise	-- It's a meta-type-variable
-  = do	{ details <- readMetaTyVar tv
-
-	-- Create the new, frozen, regular type variable
-	; let final_kind = defaultKind (tyVarKind tv)
-	      final_tv   = mkTyVar (tyVarName tv) final_kind
-
-	-- Bind the meta tyvar to the new tyvar
-	; case details of
-	    Indirect ty -> WARN( True, ppr tv $$ ppr ty ) 
-			   return ()
-		-- [Sept 04] I don't think this should happen
-		-- See note [Silly Type Synonym]
-
-	    Flexi -> writeMetaTyVar tv (mkTyVarTy final_tv)
-
-	-- Return the new tyvar
-	; return final_tv }
-\end{code}
-
-[Silly Type Synonyms]
-
-Consider this:
-	type C u a = u	-- Note 'a' unused
-
-	foo :: (forall a. C u a -> C u a) -> u
-	foo x = ...
-
-	bar :: Num u => u
-	bar = foo (\t -> t + t)
-
-* From the (\t -> t+t) we get type  {Num d} =>  d -> d
-  where d is fresh.
-
-* Now unify with type of foo's arg, and we get:
-	{Num (C d a)} =>  C d a -> C d a
-  where a is fresh.
-
-* Now abstract over the 'a', but float out the Num (C d a) constraint
-  because it does not 'really' mention a.  (see exactTyVarsOfType)
-  The arg to foo becomes
-	/\a -> \t -> t+t
-
-* So we get a dict binding for Num (C d a), which is zonked to give
-	a = ()
-  [Note Sept 04: now that we are zonking quantified type variables
-  on construction, the 'a' will be frozen as a regular tyvar on
-  quantification, so the floated dict will still have type (C d a).
-  Which renders this whole note moot; happily!]
-
-* Then the /\a abstraction has a zonked 'a' in it.
-
-All very silly.   I think its harmless to ignore the problem.  We'll end up with
-a /\a in the final result but all the occurrences of a will be zonked to ()
-
-
-%************************************************************************
-%*									*
-\subsection{Zonking -- the main work-horses: zonkType, zonkTyVar}
-%*									*
-%*		For internal use only!					*
-%*									*
-%************************************************************************
-
-\begin{code}
--- For unbound, mutable tyvars, zonkType uses the function given to it
--- For tyvars bound at a for-all, zonkType zonks them to an immutable
---	type variable and zonks the kind too
-
-zonkType :: (TcTyVar -> TcM Type) 	-- What to do with unbound mutable type variables
-					-- see zonkTcType, and zonkTcTypeToType
-         -> TcType
-	 -> TcM Type
-zonkType unbound_var_fn ty
-  = go ty
-  where
-    go (NoteTy _ ty2) 	 = go ty2	-- Discard free-tyvar annotations
-			 
-    go (TyConApp tc tys) = mappM go tys	`thenM` \ tys' ->
-			   returnM (TyConApp tc tys')
-			    
-    go (PredTy p)	 = go_pred p		`thenM` \ p' ->
-			   returnM (PredTy p')
-			 
-    go (FunTy arg res)   = go arg		`thenM` \ arg' ->
-			   go res		`thenM` \ res' ->
-			   returnM (FunTy arg' res')
- 			 
-    go (AppTy fun arg)	 = go fun		`thenM` \ fun' ->
-			   go arg		`thenM` \ arg' ->
-			   returnM (mkAppTy fun' arg')
-		-- NB the mkAppTy; we might have instantiated a
-		-- type variable to a type constructor, so we need
-		-- to pull the TyConApp to the top.
-
-	-- The two interesting cases!
-    go (TyVarTy tyvar) | isTcTyVar tyvar = zonk_tc_tyvar unbound_var_fn tyvar
-		       | otherwise	 = return (TyVarTy tyvar)
-		-- Ordinary (non Tc) tyvars occur inside quantified types
-
-    go (ForAllTy tyvar ty) = ASSERT( isImmutableTyVar tyvar )
-			     go ty		`thenM` \ ty' ->
-			     returnM (ForAllTy tyvar ty')
-
-    go_pred (ClassP c tys) = mappM go tys	`thenM` \ tys' ->
-			     returnM (ClassP c tys')
-    go_pred (IParam n ty)  = go ty		`thenM` \ ty' ->
-			     returnM (IParam n ty')
-
-zonk_tc_tyvar :: (TcTyVar -> TcM Type)		-- What to do for an unbound mutable variable
- 	      -> TcTyVar -> TcM TcType
-zonk_tc_tyvar unbound_var_fn tyvar 
-  | not (isMetaTyVar tyvar)	-- Skolems
-  = returnM (TyVarTy tyvar)
-
-  | otherwise			-- Mutables
-  = do	{ cts <- readMetaTyVar tyvar
-	; case cts of
-	    Flexi       -> unbound_var_fn tyvar    -- Unbound meta type variable
-	    Indirect ty -> zonkType unbound_var_fn ty  }
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-			Zonking kinds
-%*									*
-%************************************************************************
-
-\begin{code}
-readKindVar  :: KindVar -> TcM (Maybe TcKind)
-writeKindVar :: KindVar -> TcKind -> TcM ()
-readKindVar  kv = readMutVar (kindVarRef kv)
-writeKindVar kv val = writeMutVar (kindVarRef kv) (Just val)
-
--------------
-zonkTcKind :: TcKind -> TcM TcKind
-zonkTcKind (FunKind k1 k2) = do { k1' <- zonkTcKind k1
-				; k2' <- zonkTcKind k2
-				; returnM (FunKind k1' k2') }
-zonkTcKind k@(KindVar kv) = do { mb_kind <- readKindVar kv 
-			       ; case mb_kind of
-				    Nothing -> returnM k
-				    Just k  -> zonkTcKind k }
-zonkTcKind other_kind = returnM other_kind
-
--------------
-zonkTcKindToKind :: TcKind -> TcM Kind
-zonkTcKindToKind (FunKind k1 k2) = do { k1' <- zonkTcKindToKind k1
-				      ; k2' <- zonkTcKindToKind k2
-				      ; returnM (FunKind k1' k2') }
-
-zonkTcKindToKind (KindVar kv) = do { mb_kind <- readKindVar kv 
-				   ; case mb_kind of
-				       Nothing -> return liftedTypeKind
-				       Just k  -> zonkTcKindToKind k }
-
-zonkTcKindToKind OpenTypeKind = returnM liftedTypeKind	-- An "Open" kind defaults to *
-zonkTcKindToKind other_kind   = returnM other_kind
-\end{code}
-			
-%************************************************************************
-%*									*
-\subsection{Checking a user type}
-%*									*
-%************************************************************************
-
-When dealing with a user-written type, we first translate it from an HsType
-to a Type, performing kind checking, and then check various things that should 
-be true about it.  We don't want to perform these checks at the same time
-as the initial translation because (a) they are unnecessary for interface-file
-types and (b) when checking a mutually recursive group of type and class decls,
-we can't "look" at the tycons/classes yet.  Also, the checks are are rather
-diverse, and used to really mess up the other code.
-
-One thing we check for is 'rank'.  
-
-	Rank 0: 	monotypes (no foralls)
-	Rank 1:		foralls at the front only, Rank 0 inside
-	Rank 2:		foralls at the front, Rank 1 on left of fn arrow,
-
-	basic ::= tyvar | T basic ... basic
-
-	r2  ::= forall tvs. cxt => r2a
-	r2a ::= r1 -> r2a | basic
-	r1  ::= forall tvs. cxt => r0
-	r0  ::= r0 -> r0 | basic
-	
-Another thing is to check that type synonyms are saturated. 
-This might not necessarily show up in kind checking.
-	type A i = i
-	data T k = MkT (k Int)
-	f :: T A	-- BAD!
-
-	
-\begin{code}
-checkValidType :: UserTypeCtxt -> Type -> TcM ()
--- Checks that the type is valid for the given context
-checkValidType ctxt ty
-  = traceTc (text "checkValidType" <+> ppr ty)	`thenM_`
-    doptM Opt_GlasgowExts	`thenM` \ gla_exts ->
-    let 
-	rank | gla_exts = Arbitrary
-	     | otherwise
-	     = case ctxt of	-- Haskell 98
-		 GenPatCtxt	-> Rank 0
-		 LamPatSigCtxt	-> Rank 0
-		 BindPatSigCtxt	-> Rank 0
-		 DefaultDeclCtxt-> Rank 0
-		 ResSigCtxt	-> Rank 0
-		 TySynCtxt _    -> Rank 0
-		 ExprSigCtxt 	-> Rank 1
-		 FunSigCtxt _   -> Rank 1
-		 ConArgCtxt _   -> Rank 1	-- We are given the type of the entire
-						-- constructor, hence rank 1
-		 ForSigCtxt _	-> Rank 1
-		 RuleSigCtxt _	-> Rank 1
-		 SpecInstCtxt   -> Rank 1
-
-	actual_kind = typeKind ty
-
-	kind_ok = case ctxt of
-			TySynCtxt _  -> True	-- Any kind will do
-			ResSigCtxt   -> isOpenTypeKind 	 actual_kind
-			ExprSigCtxt  -> isOpenTypeKind 	 actual_kind
-			GenPatCtxt   -> isLiftedTypeKind actual_kind
-			ForSigCtxt _ -> isLiftedTypeKind actual_kind
-			other	     -> isArgTypeKind    actual_kind
-	
-	ubx_tup | not gla_exts = UT_NotOk
-		| otherwise    = case ctxt of
-				   TySynCtxt _ -> UT_Ok
-				   ExprSigCtxt -> UT_Ok
-				   other       -> UT_NotOk
-		-- Unboxed tuples ok in function results,
-		-- but for type synonyms we allow them even at
-		-- top level
-    in
-	-- Check that the thing has kind Type, and is lifted if necessary
-    checkTc kind_ok (kindErr actual_kind)	`thenM_`
-
-	-- Check the internal validity of the type itself
-    check_poly_type rank ubx_tup ty		`thenM_`
-
-    traceTc (text "checkValidType done" <+> ppr ty)
-\end{code}
-
-
-\begin{code}
-data Rank = Rank Int | Arbitrary
-
-decRank :: Rank -> Rank
-decRank Arbitrary = Arbitrary
-decRank (Rank n)  = Rank (n-1)
-
-----------------------------------------
-data UbxTupFlag = UT_Ok	| UT_NotOk
-	-- The "Ok" version means "ok if -fglasgow-exts is on"
-
-----------------------------------------
-check_poly_type :: Rank -> UbxTupFlag -> Type -> TcM ()
-check_poly_type (Rank 0) ubx_tup ty 
-  = check_tau_type (Rank 0) ubx_tup ty
-
-check_poly_type rank ubx_tup ty 
-  = let
-	(tvs, theta, tau) = tcSplitSigmaTy ty
-    in
-    check_valid_theta SigmaCtxt theta		`thenM_`
-    check_tau_type (decRank rank) ubx_tup tau 	`thenM_`
-    checkFreeness tvs theta			`thenM_`
-    checkAmbiguity tvs theta (tyVarsOfType tau)
-
-----------------------------------------
-check_arg_type :: Type -> TcM ()
--- The sort of type that can instantiate a type variable,
--- or be the argument of a type constructor.
--- Not an unboxed tuple, but now *can* be a forall (since impredicativity)
--- Other unboxed types are very occasionally allowed as type
--- arguments depending on the kind of the type constructor
--- 
--- For example, we want to reject things like:
---
---	instance Ord a => Ord (forall s. T s a)
--- and
---	g :: T s (forall b.b)
---
--- NB: unboxed tuples can have polymorphic or unboxed args.
---     This happens in the workers for functions returning
---     product types with polymorphic components.
---     But not in user code.
--- Anyway, they are dealt with by a special case in check_tau_type
-
-check_arg_type ty 
-  = check_poly_type Arbitrary UT_NotOk ty	`thenM_` 
-    checkTc (not (isUnLiftedType ty)) (unliftedArgErr ty)
-
-----------------------------------------
-check_tau_type :: Rank -> UbxTupFlag -> Type -> TcM ()
--- Rank is allowed rank for function args
--- No foralls otherwise
-
-check_tau_type rank ubx_tup ty@(ForAllTy _ _)       = failWithTc (forAllTyErr ty)
-check_tau_type rank ubx_tup ty@(FunTy (PredTy _) _) = failWithTc (forAllTyErr ty)
-	-- Reject e.g. (Maybe (?x::Int => Int)), with a decent error message
-
--- Naked PredTys don't usually show up, but they can as a result of
---	{-# SPECIALISE instance Ord Char #-}
--- The Right Thing would be to fix the way that SPECIALISE instance pragmas
--- are handled, but the quick thing is just to permit PredTys here.
-check_tau_type rank ubx_tup (PredTy sty) = getDOpts		`thenM` \ dflags ->
-					   check_source_ty dflags TypeCtxt sty
-
-check_tau_type rank ubx_tup (TyVarTy _)       = returnM ()
-check_tau_type rank ubx_tup ty@(FunTy arg_ty res_ty)
-  = check_poly_type rank UT_NotOk arg_ty	`thenM_`
-    check_poly_type rank UT_Ok    res_ty
-
-check_tau_type rank ubx_tup (AppTy ty1 ty2)
-  = check_arg_type ty1 `thenM_` check_arg_type ty2
-
-check_tau_type rank ubx_tup (NoteTy other_note ty)
-  = check_tau_type rank ubx_tup ty
-
-check_tau_type rank ubx_tup ty@(TyConApp tc tys)
-  | isSynTyCon tc	
-  = do	{ 	-- It's OK to have an *over-applied* type synonym
-		--	data Tree a b = ...
-		--	type Foo a = Tree [a]
-		--	f :: Foo a b -> ...
-	; case tcView ty of
-	     Just ty' -> check_tau_type rank ubx_tup ty'	-- Check expansion
-	     Nothing  -> failWithTc arity_msg
-
-	; gla_exts <- doptM Opt_GlasgowExts
-	; if gla_exts then
-	-- If -fglasgow-exts then don't check the type arguments
-	-- This allows us to instantiate a synonym defn with a 
-	-- for-all type, or with a partially-applied type synonym.
-	-- 	e.g.   type T a b = a
-	--	       type S m   = m ()
-	--	       f :: S (T Int)
-	-- Here, T is partially applied, so it's illegal in H98.
-	-- But if you expand S first, then T we get just 
-	--	       f :: Int
-	-- which is fine.
-		returnM ()
-	  else
-		-- For H98, do check the type args
-		mappM_ check_arg_type tys
-	}
-    
-  | isUnboxedTupleTyCon tc
-  = doptM Opt_GlasgowExts			`thenM` \ gla_exts ->
-    checkTc (ubx_tup_ok gla_exts) ubx_tup_msg	`thenM_`
-    mappM_ (check_tau_type (Rank 0) UT_Ok) tys	
-		-- Args are allowed to be unlifted, or
-		-- more unboxed tuples, so can't use check_arg_ty
-
-  | otherwise
-  = mappM_ check_arg_type tys
-
-  where
-    ubx_tup_ok gla_exts = case ubx_tup of { UT_Ok -> gla_exts; other -> False }
-
-    n_args    = length tys
-    tc_arity  = tyConArity tc
-
-    arity_msg   = arityErr "Type synonym" (tyConName tc) tc_arity n_args
-    ubx_tup_msg = ubxArgTyErr ty
-
-----------------------------------------
-forAllTyErr     ty = ptext SLIT("Illegal polymorphic or qualified type:") <+> ppr ty
-unliftedArgErr  ty = ptext SLIT("Illegal unlifted type argument:") <+> ppr ty
-ubxArgTyErr     ty = ptext SLIT("Illegal unboxed tuple type as function argument:") <+> ppr ty
-kindErr kind       = ptext SLIT("Expecting an ordinary type, but found a type of kind") <+> ppr kind
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Checking a theta or source type}
-%*									*
-%************************************************************************
-
-\begin{code}
--- Enumerate the contexts in which a "source type", <S>, can occur
---	Eq a 
--- or 	?x::Int
--- or 	r <: {x::Int}
--- or 	(N a) where N is a newtype
-
-data SourceTyCtxt
-  = ClassSCCtxt Name	-- Superclasses of clas
-			-- 	class <S> => C a where ...
-  | SigmaCtxt		-- Theta part of a normal for-all type
-			--	f :: <S> => a -> a
-  | DataTyCtxt Name	-- Theta part of a data decl
-			--	data <S> => T a = MkT a
-  | TypeCtxt 		-- Source type in an ordinary type
-			-- 	f :: N a -> N a
-  | InstThetaCtxt	-- Context of an instance decl
-			--	instance <S> => C [a] where ...
-		
-pprSourceTyCtxt (ClassSCCtxt c) = ptext SLIT("the super-classes of class") <+> quotes (ppr c)
-pprSourceTyCtxt SigmaCtxt       = ptext SLIT("the context of a polymorphic type")
-pprSourceTyCtxt (DataTyCtxt tc) = ptext SLIT("the context of the data type declaration for") <+> quotes (ppr tc)
-pprSourceTyCtxt InstThetaCtxt   = ptext SLIT("the context of an instance declaration")
-pprSourceTyCtxt TypeCtxt        = ptext SLIT("the context of a type")
-\end{code}
-
-\begin{code}
-checkValidTheta :: SourceTyCtxt -> ThetaType -> TcM ()
-checkValidTheta ctxt theta 
-  = addErrCtxt (checkThetaCtxt ctxt theta) (check_valid_theta ctxt theta)
-
--------------------------
-check_valid_theta ctxt []
-  = returnM ()
-check_valid_theta ctxt theta
-  = getDOpts					`thenM` \ dflags ->
-    warnTc (notNull dups) (dupPredWarn dups)	`thenM_`
-    mappM_ (check_source_ty dflags ctxt) theta
-  where
-    (_,dups) = removeDups tcCmpPred theta
-
--------------------------
-check_source_ty dflags ctxt pred@(ClassP cls tys)
-  = 	-- Class predicates are valid in all contexts
-    checkTc (arity == n_tys) arity_err		`thenM_`
-
-	-- Check the form of the argument types
-    mappM_ check_arg_type tys				`thenM_`
-    checkTc (check_class_pred_tys dflags ctxt tys)
-	    (predTyVarErr pred $$ how_to_allow)
-
-  where
-    class_name = className cls
-    arity      = classArity cls
-    n_tys      = length tys
-    arity_err  = arityErr "Class" class_name arity n_tys
-    how_to_allow = parens (ptext SLIT("Use -fglasgow-exts to permit this"))
-
-check_source_ty dflags SigmaCtxt (IParam _ ty) = check_arg_type ty
-	-- Implicit parameters only allows in type
-	-- signatures; not in instance decls, superclasses etc
-	-- The reason for not allowing implicit params in instances is a bit subtle
-	-- If we allowed	instance (?x::Int, Eq a) => Foo [a] where ...
-	-- then when we saw (e :: (?x::Int) => t) it would be unclear how to 
-	-- discharge all the potential usas of the ?x in e.   For example, a
-	-- constraint Foo [Int] might come out of e,and applying the
-	-- instance decl would show up two uses of ?x.
-
--- Catch-all
-check_source_ty dflags ctxt sty = failWithTc (badSourceTyErr sty)
-
--------------------------
-check_class_pred_tys dflags ctxt tys 
-  = case ctxt of
-	TypeCtxt      -> True	-- {-# SPECIALISE instance Eq (T Int) #-} is fine
-	InstThetaCtxt -> gla_exts || undecidable_ok || all tcIsTyVarTy tys
-				-- Further checks on head and theta in
-				-- checkInstTermination
-	other	      -> gla_exts || all tyvar_head tys
-  where
-    gla_exts       = dopt Opt_GlasgowExts dflags
-    undecidable_ok = dopt Opt_AllowUndecidableInstances dflags
-
--------------------------
-tyvar_head ty			-- Haskell 98 allows predicates of form 
-  | tcIsTyVarTy ty = True	-- 	C (a ty1 .. tyn)
-  | otherwise			-- where a is a type variable
-  = case tcSplitAppTy_maybe ty of
-	Just (ty, _) -> tyvar_head ty
-	Nothing	     -> False
-\end{code}
-
-Check for ambiguity
-~~~~~~~~~~~~~~~~~~~
-	  forall V. P => tau
-is ambiguous if P contains generic variables
-(i.e. one of the Vs) that are not mentioned in tau
-
-However, we need to take account of functional dependencies
-when we speak of 'mentioned in tau'.  Example:
-	class C a b | a -> b where ...
-Then the type
-	forall x y. (C x y) => x
-is not ambiguous because x is mentioned and x determines y
-
-NB; the ambiguity check is only used for *user* types, not for types
-coming from inteface files.  The latter can legitimately have
-ambiguous types. Example
-
-   class S a where s :: a -> (Int,Int)
-   instance S Char where s _ = (1,1)
-   f:: S a => [a] -> Int -> (Int,Int)
-   f (_::[a]) x = (a*x,b)
-	where (a,b) = s (undefined::a)
-
-Here the worker for f gets the type
-	fw :: forall a. S a => Int -> (# Int, Int #)
-
-If the list of tv_names is empty, we have a monotype, and then we
-don't need to check for ambiguity either, because the test can't fail
-(see is_ambig).
-
-\begin{code}
-checkAmbiguity :: [TyVar] -> ThetaType -> TyVarSet -> TcM ()
-checkAmbiguity forall_tyvars theta tau_tyvars
-  = mappM_ complain (filter is_ambig theta)
-  where
-    complain pred     = addErrTc (ambigErr pred)
-    extended_tau_vars = grow theta tau_tyvars
-
-	-- Only a *class* predicate can give rise to ambiguity
-	-- An *implicit parameter* cannot.  For example:
-	--	foo :: (?x :: [a]) => Int
-	--	foo = length ?x
-	-- is fine.  The call site will suppply a particular 'x'
-    is_ambig pred     = isClassPred  pred &&
-			any ambig_var (varSetElems (tyVarsOfPred pred))
-
-    ambig_var ct_var  = (ct_var `elem` forall_tyvars) &&
-		        not (ct_var `elemVarSet` extended_tau_vars)
-
-ambigErr pred
-  = sep [ptext SLIT("Ambiguous constraint") <+> quotes (pprPred pred),
-	 nest 4 (ptext SLIT("At least one of the forall'd type variables mentioned by the constraint") $$
-		 ptext SLIT("must be reachable from the type after the '=>'"))]
-\end{code}
-    
-In addition, GHC insists that at least one type variable
-in each constraint is in V.  So we disallow a type like
-	forall a. Eq b => b -> b
-even in a scope where b is in scope.
-
-\begin{code}
-checkFreeness forall_tyvars theta
-  = mappM_ complain (filter is_free theta)
-  where    
-    is_free pred     =  not (isIPPred pred)
-		     && not (any bound_var (varSetElems (tyVarsOfPred pred)))
-    bound_var ct_var = ct_var `elem` forall_tyvars
-    complain pred    = addErrTc (freeErr pred)
-
-freeErr pred
-  = sep [ptext SLIT("All of the type variables in the constraint") <+> quotes (pprPred pred) <+>
-		   ptext SLIT("are already in scope"),
-	 nest 4 (ptext SLIT("(at least one must be universally quantified here)"))
-    ]
-\end{code}
-
-\begin{code}
-checkThetaCtxt ctxt theta
-  = vcat [ptext SLIT("In the context:") <+> pprTheta theta,
-	  ptext SLIT("While checking") <+> pprSourceTyCtxt ctxt ]
-
-badSourceTyErr sty = ptext SLIT("Illegal constraint") <+> pprPred sty
-predTyVarErr pred  = sep [ptext SLIT("Non type-variable argument"),
-			  nest 2 (ptext SLIT("in the constraint:") <+> pprPred pred)]
-dupPredWarn dups   = ptext SLIT("Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups)
-
-arityErr kind name n m
-  = hsep [ text kind, quotes (ppr name), ptext SLIT("should have"),
-	   n_arguments <> comma, text "but has been given", int m]
-    where
-	n_arguments | n == 0 = ptext SLIT("no arguments")
-		    | n == 1 = ptext SLIT("1 argument")
-		    | True   = hsep [int n, ptext SLIT("arguments")]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Checking for a decent instance head type}
-%*									*
-%************************************************************************
-
-@checkValidInstHead@ checks the type {\em and} its syntactic constraints:
-it must normally look like: @instance Foo (Tycon a b c ...) ...@
-
-The exceptions to this syntactic checking: (1)~if the @GlasgowExts@
-flag is on, or (2)~the instance is imported (they must have been
-compiled elsewhere). In these cases, we let them go through anyway.
-
-We can also have instances for functions: @instance Foo (a -> b) ...@.
-
-\begin{code}
-checkValidInstHead :: Type -> TcM (Class, [TcType])
-
-checkValidInstHead ty	-- Should be a source type
-  = case tcSplitPredTy_maybe ty of {
-	Nothing -> failWithTc (instTypeErr (ppr ty) empty) ;
-	Just pred -> 
-
-    case getClassPredTys_maybe pred of {
-	Nothing -> failWithTc (instTypeErr (pprPred pred) empty) ;
-        Just (clas,tys) ->
-
-    getDOpts					`thenM` \ dflags ->
-    mappM_ check_arg_type tys			`thenM_`
-    check_inst_head dflags clas tys		`thenM_`
-    returnM (clas, tys)
-    }}
-
-check_inst_head dflags clas tys
-	-- If GlasgowExts then check at least one isn't a type variable
-  | dopt Opt_GlasgowExts dflags
-  = mapM_ check_one tys
-
-	-- WITH HASKELL 98, MUST HAVE C (T a b c)
-  | otherwise
-  = checkTc (isSingleton tys && tcValidInstHeadTy first_ty)
-	    (instTypeErr (pprClassPred clas tys) head_shape_msg)
-
-  where
-    (first_ty : _) = tys
-
-    head_shape_msg = parens (text "The instance type must be of form (T a b c)" $$
-			     text "where T is not a synonym, and a,b,c are distinct type variables")
-
-	-- For now, I only allow tau-types (not polytypes) in 
-	-- the head of an instance decl.  
-	-- 	E.g.  instance C (forall a. a->a) is rejected
-	-- One could imagine generalising that, but I'm not sure
-	-- what all the consequences might be
-    check_one ty = do { check_tau_type (Rank 0) UT_NotOk ty
-		      ; checkTc (not (isUnLiftedType ty)) (unliftedArgErr ty) }
-
-instTypeErr pp_ty msg
-  = sep [ptext SLIT("Illegal instance declaration for") <+> quotes pp_ty, 
-	 nest 4 msg]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Checking instance for termination}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-checkValidInstance :: [TyVar] -> ThetaType -> Class -> [TcType] -> TcM ()
-checkValidInstance tyvars theta clas inst_tys
-  = do	{ gla_exts <- doptM Opt_GlasgowExts
-	; undecidable_ok <- doptM Opt_AllowUndecidableInstances
-
-	; checkValidTheta InstThetaCtxt theta
-	; checkAmbiguity tyvars theta (tyVarsOfTypes inst_tys)
-
-	-- Check that instance inference will terminate (if we care)
-	-- For Haskell 98, checkValidTheta has already done that
-	; when (gla_exts && not undecidable_ok) $
-	       checkInstTermination theta inst_tys
-	
-	-- The Coverage Condition
-	; checkTc (undecidable_ok || checkInstCoverage clas inst_tys)
-	  	  (instTypeErr (pprClassPred clas inst_tys) msg)
-	}
-  where
-    msg  = parens (ptext SLIT("the Coverage Condition fails for one of the functional dependencies"))
-\end{code}
-
-Termination test: each assertion in the context satisfies
- (1) no variable has more occurrences in the assertion than in the head, and
- (2) the assertion has fewer constructors and variables (taken together
-     and counting repetitions) than the head.
-This is only needed with -fglasgow-exts, as Haskell 98 restrictions
-(which have already been checked) guarantee termination. 
-
-The underlying idea is that 
-
-    for any ground substitution, each assertion in the
-    context has fewer type constructors than the head.
-
-
-\begin{code}
-checkInstTermination :: ThetaType -> [TcType] -> TcM ()
-checkInstTermination theta tys
-  = do	{ mappM_ (check_nomore (fvTypes tys))    theta
-	; mappM_ (check_smaller (sizeTypes tys)) theta }
-
-check_nomore :: [TyVar] -> PredType -> TcM ()
-check_nomore fvs pred
-  = checkTc (null (fvPred pred \\ fvs))
-	    (predUndecErr pred nomoreMsg $$ parens undecidableMsg)
-
-check_smaller :: Int -> PredType -> TcM ()
-check_smaller n pred
-  = checkTc (sizePred pred < n)
-	    (predUndecErr pred smallerMsg $$ parens undecidableMsg)
-
-predUndecErr pred msg = sep [msg,
-			nest 2 (ptext SLIT("in the constraint:") <+> pprPred pred)]
-
-nomoreMsg = ptext SLIT("Variable occurs more often in a constraint than in the instance head")
-smallerMsg = ptext SLIT("Constraint is no smaller than the instance head")
-undecidableMsg = ptext SLIT("Use -fallow-undecidable-instances to permit this")
-
--- Free variables of a type, retaining repetitions, and expanding synonyms
-fvType :: Type -> [TyVar]
-fvType ty | Just exp_ty <- tcView ty = fvType exp_ty
-fvType (TyVarTy tv)        = [tv]
-fvType (TyConApp _ tys)    = fvTypes tys
-fvType (NoteTy _ ty)       = fvType ty
-fvType (PredTy pred)       = fvPred pred
-fvType (FunTy arg res)     = fvType arg ++ fvType res
-fvType (AppTy fun arg)     = fvType fun ++ fvType arg
-fvType (ForAllTy tyvar ty) = filter (/= tyvar) (fvType ty)
-
-fvTypes :: [Type] -> [TyVar]
-fvTypes tys                = concat (map fvType tys)
-
-fvPred :: PredType -> [TyVar]
-fvPred (ClassP _ tys')     = fvTypes tys'
-fvPred (IParam _ ty)       = fvType ty
-
--- Size of a type: the number of variables and constructors
-sizeType :: Type -> Int
-sizeType ty | Just exp_ty <- tcView ty = sizeType exp_ty
-sizeType (TyVarTy _)       = 1
-sizeType (TyConApp _ tys)  = sizeTypes tys + 1
-sizeType (NoteTy _ ty)     = sizeType ty
-sizeType (PredTy pred)     = sizePred pred
-sizeType (FunTy arg res)   = sizeType arg + sizeType res + 1
-sizeType (AppTy fun arg)   = sizeType fun + sizeType arg
-sizeType (ForAllTy _ ty)   = sizeType ty
-
-sizeTypes :: [Type] -> Int
-sizeTypes xs               = sum (map sizeType xs)
-
-sizePred :: PredType -> Int
-sizePred (ClassP _ tys')   = sizeTypes tys'
-sizePred (IParam _ ty)     = sizeType ty
-\end{code}
diff --git a/ghc/compiler/typecheck/TcMatches.hi-boot-5 b/ghc/compiler/typecheck/TcMatches.hi-boot-5
deleted file mode 100644
index 43e2330683..0000000000
--- a/ghc/compiler/typecheck/TcMatches.hi-boot-5
+++ /dev/null
@@ -1,10 +0,0 @@
-__interface TcMatches 1 0 where
-__export TcMatches tcGRHSsPat tcMatchesFun;
-1 tcGRHSsPat  :: HsExpr.GRHSs Name.Name
-	      -> TcUnify.Expected TcType.TcType
-	      -> TcRnTypes.TcM (HsExpr.GRHSs Var.Id) ;
-
-1 tcMatchesFun :: Name.Name
-	     -> [HsExpr.LMatch Name.Name]
-	     -> TcUnify.Expected TcType.TcType
-	     -> TcRnTypes.TcM [HsExpr.LMatch Var.Id] ;
diff --git a/ghc/compiler/typecheck/TcMatches.hi-boot-6 b/ghc/compiler/typecheck/TcMatches.hi-boot-6
deleted file mode 100644
index fb723a4527..0000000000
--- a/ghc/compiler/typecheck/TcMatches.hi-boot-6
+++ /dev/null
@@ -1,10 +0,0 @@
-module TcMatches where
-
-tcGRHSsPat    :: HsExpr.GRHSs Name.Name
-	      -> TcType.BoxyRhoType
-	      -> TcRnTypes.TcM (HsExpr.GRHSs Var.Id)
-
-tcMatchesFun :: Name.Name
-	     -> HsExpr.MatchGroup Name.Name
-	     -> TcType.BoxyRhoType
-	     -> TcRnTypes.TcM (HsBinds.ExprCoFn, HsExpr.MatchGroup Var.Id)
diff --git a/ghc/compiler/typecheck/TcMatches.lhs b/ghc/compiler/typecheck/TcMatches.lhs
deleted file mode 100644
index 07a1094d58..0000000000
--- a/ghc/compiler/typecheck/TcMatches.lhs
+++ /dev/null
@@ -1,515 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcMatches]{Typecheck some @Matches@}
-
-\begin{code}
-module TcMatches ( tcMatchesFun, tcGRHSsPat, tcMatchesCase, tcMatchLambda,
-		   matchCtxt, TcMatchCtxt(..), 
-		   tcStmts, tcDoStmts, 
-		   tcDoStmt, tcMDoStmt, tcGuardStmt
-       ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-}	TcExpr( tcSyntaxOp, tcInferRho, tcMonoExpr, tcPolyExpr )
-
-import HsSyn		( HsExpr(..), LHsExpr, MatchGroup(..),
-			  Match(..), LMatch, GRHSs(..), GRHS(..), 
-			  Stmt(..), LStmt, HsMatchContext(..), HsStmtContext(..),
-			  pprMatch, isIrrefutableHsPat, mkHsCoerce,
-			  pprMatchContext, pprStmtContext, 
-			  noSyntaxExpr, matchGroupArity, pprMatches,
-			  ExprCoFn )
-
-import TcRnMonad
-import TcHsType		( tcPatSig, UserTypeCtxt(..) )
-import Inst		( newMethodFromName )
-import TcEnv		( TcId, tcLookupLocalIds, tcLookupId, tcExtendIdEnv, 
-			  tcExtendTyVarEnv2 )
-import TcPat		( PatCtxt(..), tcPats, tcPat )
-import TcMType		( newFlexiTyVarTy, newFlexiTyVarTys ) 
-import TcType		( TcType, TcRhoType, 
-			  BoxySigmaType, BoxyRhoType, 
-			  mkFunTys, mkFunTy, mkAppTy, mkTyConApp,
-			  liftedTypeKind )
-import TcBinds		( tcLocalBinds )
-import TcUnify		( boxySplitAppTy, boxySplitTyConApp, boxySplitListTy,
-			  subFunTys, tcSubExp, withBox )
-import TcSimplify	( bindInstsOfLocalFuns )
-import Name		( Name )
-import TysWiredIn	( stringTy, boolTy, parrTyCon, listTyCon, mkListTy, mkPArrTy )
-import PrelNames	( bindMName, returnMName, mfixName, thenMName, failMName )
-import Id		( idType, mkLocalId )
-import TyCon		( TyCon )
-import Outputable
-import SrcLoc		( Located(..), getLoc )
-import ErrUtils		( Message )
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{tcMatchesFun, tcMatchesCase}
-%*									*
-%************************************************************************
-
-@tcMatchesFun@ typechecks a @[Match]@ list which occurs in a
-@FunMonoBind@.  The second argument is the name of the function, which
-is used in error messages.  It checks that all the equations have the
-same number of arguments before using @tcMatches@ to do the work.
-
-\begin{code}
-tcMatchesFun :: Name
-	     -> MatchGroup Name
-	     -> BoxyRhoType 		-- Expected type of function
-	     -> TcM (ExprCoFn, MatchGroup TcId)	-- Returns type of body
-
-tcMatchesFun fun_name matches exp_ty
-  = do	{  -- Check that they all have the same no of arguments
-	   -- Location is in the monad, set the caller so that 
-	   -- any inter-equation error messages get some vaguely
-	   -- sensible location.	Note: we have to do this odd
-	   -- ann-grabbing, because we don't always have annotations in
-	   -- hand when we call tcMatchesFun...
-	  checkArgs fun_name matches
-
-	-- ToDo: Don't use "expected" stuff if there ain't a type signature
-	-- because inconsistency between branches
-	-- may show up as something wrong with the (non-existent) type signature
-
-		-- This is one of two places places we call subFunTys
-		-- The point is that if expected_y is a "hole", we want 
-		-- to make pat_tys and rhs_ty as "holes" too.
-	; subFunTys doc n_pats exp_ty     $ \ pat_tys rhs_ty -> 
-	  tcMatches match_ctxt pat_tys rhs_ty matches
-	}
-  where
-    doc = ptext SLIT("The equation(s) for") <+> quotes (ppr fun_name)
-	  <+> ptext SLIT("have") <+> speakNOf n_pats (ptext SLIT("argument"))
-    n_pats = matchGroupArity matches
-    match_ctxt = MC { mc_what = FunRhs fun_name, mc_body = tcPolyExpr }
-\end{code}
-
-@tcMatchesCase@ doesn't do the argument-count check because the
-parser guarantees that each equation has exactly one argument.
-
-\begin{code}
-tcMatchesCase :: TcMatchCtxt		-- Case context
-	      -> TcRhoType		-- Type of scrutinee
-	      -> MatchGroup Name	-- The case alternatives
-	      -> BoxyRhoType 		-- Type of whole case expressions
-	      -> TcM (MatchGroup TcId)	-- Translated alternatives
-
-tcMatchesCase ctxt scrut_ty matches res_ty
-  = tcMatches ctxt [scrut_ty] res_ty matches
-
-tcMatchLambda :: MatchGroup Name -> BoxyRhoType -> TcM (ExprCoFn, MatchGroup TcId)
-tcMatchLambda match res_ty 
-  = subFunTys doc n_pats res_ty 	$ \ pat_tys rhs_ty ->
-    tcMatches match_ctxt pat_tys rhs_ty match
-  where
-    n_pats = matchGroupArity match
-    doc = sep [ ptext SLIT("The lambda expression")
-		 <+> quotes (pprSetDepth 1 $ pprMatches LambdaExpr match),
-			-- The pprSetDepth makes the abstraction print briefly
-		ptext SLIT("has") <+> speakNOf n_pats (ptext SLIT("argument"))]
-    match_ctxt = MC { mc_what = LambdaExpr,
-		      mc_body = tcPolyExpr }
-\end{code}
-
-@tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind@.
-
-\begin{code}
-tcGRHSsPat :: GRHSs Name -> BoxyRhoType -> TcM (GRHSs TcId)
-tcGRHSsPat grhss res_ty = tcGRHSs match_ctxt grhss res_ty
-  where
-    match_ctxt = MC { mc_what = PatBindRhs,
-		      mc_body = tcPolyExpr }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{tcMatch}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcMatches :: TcMatchCtxt
-	  -> [BoxySigmaType] 		-- Expected pattern types
-	  -> BoxyRhoType		-- Expected result-type of the Match.
-	  -> MatchGroup Name
-	  -> TcM (MatchGroup TcId)
-
-data TcMatchCtxt 	-- c.f. TcStmtCtxt, also in this module
-  = MC { mc_what :: HsMatchContext Name,	-- What kind of thing this is
-    	 mc_body :: LHsExpr Name 		-- Type checker for a body of an alternative
-		 -> BoxyRhoType 
-		 -> TcM (LHsExpr TcId) }	
-
-tcMatches ctxt pat_tys rhs_ty (MatchGroup matches _)
-  = do	{ matches' <- mapM (tcMatch ctxt pat_tys rhs_ty) matches
-	; return (MatchGroup matches' (mkFunTys pat_tys rhs_ty)) }
-
--------------
-tcMatch :: TcMatchCtxt
-	-> [BoxySigmaType]	-- Expected pattern types
-	-> BoxyRhoType	 	-- Expected result-type of the Match.
-	-> LMatch Name
-	-> TcM (LMatch TcId)
-
-tcMatch ctxt pat_tys rhs_ty match 
-  = wrapLocM (tc_match ctxt pat_tys rhs_ty) match
-  where
-    tc_match ctxt pat_tys rhs_ty match@(Match pats maybe_rhs_sig grhss)
-      = addErrCtxt (matchCtxt (mc_what ctxt) match)	$	
-        do { (pats', grhss') <- tcPats LamPat pats pat_tys rhs_ty $
-    			        tc_grhss ctxt maybe_rhs_sig grhss
-	   ; returnM (Match pats' Nothing grhss') }
-
-    tc_grhss ctxt Nothing grhss rhs_ty 
-      = tcGRHSs ctxt grhss rhs_ty	-- No result signature
-
-    tc_grhss ctxt (Just res_sig) grhss rhs_ty 
-      = do { (inner_ty, sig_tvs) <- tcPatSig ResSigCtxt res_sig rhs_ty
-	   ; tcExtendTyVarEnv2 sig_tvs $
-    	     tcGRHSs ctxt grhss inner_ty }
-
--------------
-tcGRHSs :: TcMatchCtxt -> GRHSs Name -> BoxyRhoType -> TcM (GRHSs TcId)
-
--- Notice that we pass in the full res_ty, so that we get
--- good inference from simple things like
---	f = \(x::forall a.a->a) -> <stuff>
--- We used to force it to be a monotype when there was more than one guard
--- but we don't need to do that any more
-
-tcGRHSs ctxt (GRHSs grhss binds) res_ty
-  = do	{ (binds', grhss') <- tcLocalBinds binds $
-			      mappM (wrapLocM (tcGRHS ctxt res_ty)) grhss
-
-	; returnM (GRHSs grhss' binds') }
-
--------------
-tcGRHS :: TcMatchCtxt -> BoxyRhoType -> GRHS Name -> TcM (GRHS TcId)
-
-tcGRHS ctxt res_ty (GRHS guards rhs)
-  = do  { (guards', rhs') <- tcStmts stmt_ctxt tcGuardStmt guards res_ty $
-			     mc_body ctxt rhs
-	; return (GRHS guards' rhs') }
-  where
-    stmt_ctxt  = PatGuard (mc_what ctxt)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{@tcDoStmts@ typechecks a {\em list} of do statements}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcDoStmts :: HsStmtContext Name 
-	  -> [LStmt Name]
-	  -> LHsExpr Name
-	  -> BoxyRhoType
-	  -> TcM (HsExpr TcId)		-- Returns a HsDo
-tcDoStmts ListComp stmts body res_ty
-  = do	{ elt_ty <- boxySplitListTy res_ty
-	; (stmts', body') <- tcStmts ListComp (tcLcStmt listTyCon) stmts elt_ty $
-			     tcBody (doBodyCtxt ListComp body) body
-	; return (HsDo ListComp stmts' body' (mkListTy elt_ty)) }
-
-tcDoStmts PArrComp stmts body res_ty
-  = do	{ [elt_ty] <- boxySplitTyConApp parrTyCon res_ty
-	; (stmts', body') <- tcStmts PArrComp (tcLcStmt parrTyCon) stmts elt_ty $
-			     tcBody (doBodyCtxt PArrComp body) body
-	; return (HsDo PArrComp stmts' body' (mkPArrTy elt_ty)) }
-
-tcDoStmts DoExpr stmts body res_ty
-  = do	{ (m_ty, elt_ty) <- boxySplitAppTy res_ty
-	; let res_ty' = mkAppTy m_ty elt_ty	-- The boxySplit consumes res_ty
-	; (stmts', body') <- tcStmts DoExpr (tcDoStmt m_ty) stmts res_ty' $
-			     tcBody (doBodyCtxt DoExpr body) body
-	; return (HsDo DoExpr stmts' body' res_ty') }
-
-tcDoStmts ctxt@(MDoExpr _) stmts body res_ty
-  = do	{ (m_ty, elt_ty) <- boxySplitAppTy res_ty
- 	; let res_ty' = mkAppTy m_ty elt_ty	-- The boxySplit consumes res_ty
-	      tc_rhs rhs = withBox liftedTypeKind $ \ pat_ty ->
-			   tcMonoExpr rhs (mkAppTy m_ty pat_ty)
-
-	; (stmts', body') <- tcStmts ctxt (tcMDoStmt tc_rhs) stmts res_ty' $
-			     tcBody (doBodyCtxt ctxt body) body
-
-	; let names = [mfixName, bindMName, thenMName, returnMName, failMName]
-	; insts <- mapM (newMethodFromName DoOrigin m_ty) names
-	; return (HsDo (MDoExpr (names `zip` insts)) stmts' body' res_ty') }
-
-tcDoStmts ctxt stmts body res_ty = pprPanic "tcDoStmts" (pprStmtContext ctxt)
-
-tcBody :: Message -> LHsExpr Name -> BoxyRhoType -> TcM (LHsExpr TcId)
-tcBody ctxt body res_ty
-  = -- addErrCtxt ctxt $	-- This context adds little that is useful
-    tcPolyExpr body res_ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{tcStmts}
-%*									*
-%************************************************************************
-
-\begin{code}
-type TcStmtChecker
-  = forall thing.  HsStmtContext Name
-           	   -> Stmt Name
-		   -> BoxyRhoType			-- Result type for comprehension
-	      	   -> (BoxyRhoType -> TcM thing)	-- Checker for what follows the stmt
-              	   -> TcM (Stmt TcId, thing)
-
-  -- The incoming BoxyRhoType may be refined by type refinements
-  -- before being passed to the thing_inside
-
-tcStmts :: HsStmtContext Name
-	-> TcStmtChecker	-- NB: higher-rank type
-        -> [LStmt Name]
-	-> BoxyRhoType
-	-> (BoxyRhoType -> TcM thing)
-        -> TcM ([LStmt TcId], thing)
-
--- Note the higher-rank type.  stmt_chk is applied at different
--- types in the equations for tcStmts
-
-tcStmts ctxt stmt_chk [] res_ty thing_inside
-  = do	{ thing <- thing_inside res_ty
-	; return ([], thing) }
-
--- LetStmts are handled uniformly, regardless of context
-tcStmts ctxt stmt_chk (L loc (LetStmt binds) : stmts) res_ty thing_inside
-  = do	{ (binds', (stmts',thing)) <- tcLocalBinds binds $
-				      tcStmts ctxt stmt_chk stmts res_ty thing_inside
-	; return (L loc (LetStmt binds') : stmts', thing) }
-
--- For the vanilla case, handle the location-setting part
-tcStmts ctxt stmt_chk (L loc stmt : stmts) res_ty thing_inside
-  = do 	{ (stmt', (stmts', thing)) <- 
-		setSrcSpan loc		 		$
-    		addErrCtxt (stmtCtxt ctxt stmt)		$
-		stmt_chk ctxt stmt res_ty		$ \ res_ty' ->
-		popErrCtxt 				$
-		tcStmts ctxt stmt_chk stmts res_ty'	$
-		thing_inside
-	; return (L loc stmt' : stmts', thing) }
-
---------------------------------
---	Pattern guards
-tcGuardStmt :: TcStmtChecker
-tcGuardStmt ctxt (ExprStmt guard _ _) res_ty thing_inside
-  = do	{ guard' <- tcMonoExpr guard boolTy
-	; thing  <- thing_inside res_ty
-	; return (ExprStmt guard' noSyntaxExpr boolTy, thing) }
-
-tcGuardStmt ctxt (BindStmt pat rhs _ _) res_ty thing_inside
-  = do	{ (rhs', rhs_ty) <- tcInferRho rhs
-	; (pat', thing)  <- tcPat LamPat pat rhs_ty res_ty thing_inside
-	; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
-
-tcGuardStmt ctxt stmt res_ty thing_inside
-  = pprPanic "tcGuardStmt: unexpected Stmt" (ppr stmt)
-
-
---------------------------------
---	List comprehensions and PArrays
-
-tcLcStmt :: TyCon	-- The list/Parray type constructor ([] or PArray)
-	 -> TcStmtChecker
-
--- A generator, pat <- rhs
-tcLcStmt m_tc ctxt (BindStmt pat rhs _ _) res_ty thing_inside 
- = do	{ (rhs', pat_ty) <- withBox liftedTypeKind $ \ ty ->
-			    tcMonoExpr rhs (mkTyConApp m_tc [ty])
-	; (pat', thing)  <- tcPat LamPat pat pat_ty res_ty thing_inside
-	; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
-
--- A boolean guard
-tcLcStmt m_tc ctxt (ExprStmt rhs _ _) res_ty thing_inside
-  = do	{ rhs'  <- tcMonoExpr rhs boolTy
-	; thing <- thing_inside res_ty
-	; return (ExprStmt rhs' noSyntaxExpr boolTy, thing) }
-
--- A parallel set of comprehensions
---	[ (g x, h x) | ... ; let g v = ...
---		     | ... ; let h v = ... ]
---
--- It's possible that g,h are overloaded, so we need to feed the LIE from the
--- (g x, h x) up through both lots of bindings (so we get the bindInstsOfLocalFuns).
--- Similarly if we had an existential pattern match:
---
---	data T = forall a. Show a => C a
---
---	[ (show x, show y) | ... ; C x <- ...
---			   | ... ; C y <- ... ]
---
--- Then we need the LIE from (show x, show y) to be simplified against
--- the bindings for x and y.  
--- 
--- It's difficult to do this in parallel, so we rely on the renamer to 
--- ensure that g,h and x,y don't duplicate, and simply grow the environment.
--- So the binders of the first parallel group will be in scope in the second
--- group.  But that's fine; there's no shadowing to worry about.
-
-tcLcStmt m_tc ctxt (ParStmt bndr_stmts_s) elt_ty thing_inside
-  = do	{ (pairs', thing) <- loop bndr_stmts_s
-	; return (ParStmt pairs', thing) }
-  where
-    -- loop :: [([LStmt Name], [Name])] -> TcM ([([LStmt TcId], [TcId])], thing)
-    loop [] = do { thing <- thing_inside elt_ty	-- No refinement from pattern 
-		 ; return ([], thing) }		-- matching in the branches
-
-    loop ((stmts, names) : pairs)
-      = do { (stmts', (ids, pairs', thing))
-		<- tcStmts ctxt (tcLcStmt m_tc) stmts elt_ty $ \ elt_ty' ->
-		   do { ids <- tcLookupLocalIds names
-		      ; (pairs', thing) <- loop pairs
-		      ; return (ids, pairs', thing) }
-	   ; return ( (stmts', ids) : pairs', thing ) }
-
-tcLcStmt m_tc ctxt stmt elt_ty thing_inside
-  = pprPanic "tcLcStmt: unexpected Stmt" (ppr stmt)
-
---------------------------------
---	Do-notation
--- The main excitement here is dealing with rebindable syntax
-
-tcDoStmt :: TcType		-- Monad type,  m
-	 -> TcStmtChecker
-
-tcDoStmt m_ty ctxt (BindStmt pat rhs bind_op fail_op) res_ty thing_inside
-  = do	{ (rhs', pat_ty) <- withBox liftedTypeKind $ \ pat_ty -> 
-			    tcMonoExpr rhs (mkAppTy m_ty pat_ty)
-		-- We should use type *inference* for the RHS computations, becuase of GADTs. 
-		-- 	do { pat <- rhs; <rest> }
-		-- is rather like
-		--	case rhs of { pat -> <rest> }
-		-- We do inference on rhs, so that information about its type can be refined
-		-- when type-checking the pattern. 
-
-	; (pat', thing) <- tcPat LamPat pat pat_ty res_ty thing_inside
-
-	-- Deal with rebindable syntax; (>>=) :: m a -> (a -> m b) -> m b
-	; let bind_ty = mkFunTys [mkAppTy m_ty pat_ty, 
-				  mkFunTy pat_ty res_ty] res_ty
-	; bind_op' <- tcSyntaxOp DoOrigin bind_op bind_ty
-		-- If (but only if) the pattern can fail, 
-		-- typecheck the 'fail' operator
-	; fail_op' <- if isIrrefutableHsPat pat' 
-		      then return noSyntaxExpr
-		      else tcSyntaxOp DoOrigin fail_op (mkFunTy stringTy res_ty)
-	; return (BindStmt pat' rhs' bind_op' fail_op', thing) }
-
-
-tcDoStmt m_ty ctxt (ExprStmt rhs then_op _) res_ty thing_inside
-  = do	{ 	-- Deal with rebindable syntax; (>>) :: m a -> m b -> m b
-	  a_ty <- newFlexiTyVarTy liftedTypeKind
-	; let rhs_ty  = mkAppTy m_ty a_ty
-	      then_ty = mkFunTys [rhs_ty, res_ty] res_ty
-	; then_op' <- tcSyntaxOp DoOrigin then_op then_ty
-	; rhs' <- tcPolyExpr rhs rhs_ty
-	; thing <- thing_inside res_ty
-	; return (ExprStmt rhs' then_op' rhs_ty, thing) }
-
-tcDoStmt m_ty ctxt stmt res_ty thing_inside
-  = pprPanic "tcDoStmt: unexpected Stmt" (ppr stmt)
-
---------------------------------
---	Mdo-notation
--- The distinctive features here are
---	(a) RecStmts, and
---	(b) no rebindable syntax
-
-tcMDoStmt :: (LHsExpr Name -> TcM (LHsExpr TcId, TcType))	-- RHS inference
-	  -> TcStmtChecker
-tcMDoStmt tc_rhs ctxt (BindStmt pat rhs bind_op fail_op) res_ty thing_inside
-  = do	{ (rhs', pat_ty) <- tc_rhs rhs
-	; (pat', thing)  <- tcPat LamPat pat pat_ty res_ty thing_inside
-	; return (BindStmt pat' rhs' noSyntaxExpr noSyntaxExpr, thing) }
-
-tcMDoStmt tc_rhs ctxt (ExprStmt rhs then_op _) res_ty thing_inside
-  = do	{ (rhs', elt_ty) <- tc_rhs rhs
-	; thing 	 <- thing_inside res_ty
-	; return (ExprStmt rhs' noSyntaxExpr elt_ty, thing) }
-
-tcMDoStmt tc_rhs ctxt (RecStmt stmts laterNames recNames _ _) res_ty thing_inside
-  = do	{ rec_tys <- newFlexiTyVarTys (length recNames) liftedTypeKind
-	; let rec_ids = zipWith mkLocalId recNames rec_tys
-	; tcExtendIdEnv rec_ids			$ do
-    	{ (stmts', (later_ids, rec_rets))
-		<- tcStmts ctxt (tcMDoStmt tc_rhs) stmts res_ty	$ \ res_ty' -> 
-			-- ToDo: res_ty not really right
-		   do { rec_rets <- zipWithM tc_ret recNames rec_tys
-		      ; later_ids <- tcLookupLocalIds laterNames
-		      ; return (later_ids, rec_rets) }
-
-	; (thing,lie) <- tcExtendIdEnv later_ids (getLIE (thing_inside res_ty))
-		-- NB:	The rec_ids for the recursive things 
-		-- 	already scope over this part. This binding may shadow
-		--	some of them with polymorphic things with the same Name
-		--	(see note [RecStmt] in HsExpr)
-	; lie_binds <- bindInstsOfLocalFuns lie later_ids
-  
-	; return (RecStmt stmts' later_ids rec_ids rec_rets lie_binds, thing)
-	}}
-  where 
-    -- Unify the types of the "final" Ids with those of "knot-tied" Ids
-    tc_ret rec_name mono_ty
-	= do { poly_id <- tcLookupId rec_name
-		-- poly_id may have a polymorphic type
-		-- but mono_ty is just a monomorphic type variable
-	     ; co_fn <- tcSubExp (idType poly_id) mono_ty
-	     ; return (mkHsCoerce co_fn (HsVar poly_id)) }
-
-tcMDoStmt tc_rhs ctxt stmt res_ty thing_inside
-  = pprPanic "tcMDoStmt: unexpected Stmt" (ppr stmt)
-
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Errors and contexts}
-%*									*
-%************************************************************************
-
-@sameNoOfArgs@ takes a @[RenamedMatch]@ and decides whether the same
-number of args are used in each equation.
-
-\begin{code}
-checkArgs :: Name -> MatchGroup Name -> TcM ()
-checkArgs fun (MatchGroup (match1:matches) _)
-    | null bad_matches = return ()
-    | otherwise
-    = failWithTc (vcat [ptext SLIT("Equations for") <+> quotes (ppr fun) <+> 
-			  ptext SLIT("have different numbers of arguments"),
-			nest 2 (ppr (getLoc match1)),
-			nest 2 (ppr (getLoc (head bad_matches)))])
-  where
-    n_args1 = args_in_match match1
-    bad_matches = [m | m <- matches, args_in_match m /= n_args1]
-
-    args_in_match :: LMatch Name -> Int
-    args_in_match (L _ (Match pats _ _)) = length pats
-\end{code}
-
-\begin{code}
-matchCtxt ctxt match  = hang (ptext SLIT("In") <+> pprMatchContext ctxt <> colon) 
-			   4 (pprMatch ctxt match)
-
-doBodyCtxt :: HsStmtContext Name -> LHsExpr Name -> SDoc
-doBodyCtxt ctxt body = hang (ptext SLIT("In the result of") <+> pprStmtContext ctxt <> colon) 
-		          4 (ppr body)
-
-stmtCtxt ctxt stmt = hang (ptext SLIT("In") <+> pprStmtContext ctxt <> colon)
-		  	4 (ppr stmt)
-\end{code}
diff --git a/ghc/compiler/typecheck/TcMatches.lhs-boot b/ghc/compiler/typecheck/TcMatches.lhs-boot
deleted file mode 100644
index 18a79fa984..0000000000
--- a/ghc/compiler/typecheck/TcMatches.lhs-boot
+++ /dev/null
@@ -1,17 +0,0 @@
-\begin{code}
-module TcMatches where
-import HsSyn	( GRHSs, MatchGroup, ExprCoFn )
-import Name	( Name )
-import Var	( Id )
-import TcType	( BoxyRhoType )
-import TcRnTypes( TcM )
-
-tcGRHSsPat    :: GRHSs Name
-	      -> BoxyRhoType
-	      -> TcM (GRHSs Id)
-
-tcMatchesFun :: Name
-	     -> MatchGroup Name
-	     -> BoxyRhoType
-	     -> TcM (ExprCoFn, MatchGroup Id)
-\end{code}
diff --git a/ghc/compiler/typecheck/TcPat.lhs b/ghc/compiler/typecheck/TcPat.lhs
deleted file mode 100644
index 4c56b083bb..0000000000
--- a/ghc/compiler/typecheck/TcPat.lhs
+++ /dev/null
@@ -1,816 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcPat]{Typechecking patterns}
-
-\begin{code}
-module TcPat ( tcPat, tcPats, tcOverloadedLit,
-	       PatCtxt(..), badFieldCon, polyPatSig ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-}	TcExpr( tcSyntaxOp )
-import HsSyn		( Pat(..), LPat, HsConDetails(..), HsLit(..), HsOverLit(..), HsExpr(..),
-			  LHsBinds, emptyLHsBinds, isEmptyLHsBinds, 
-			  collectPatsBinders, nlHsLit )
-import TcHsSyn		( TcId, hsLitType )
-import TcRnMonad
-import Inst		( InstOrigin(..), shortCutFracLit, shortCutIntLit, 
-			  newDicts, instToId, tcInstStupidTheta, isHsVar
-			)
-import Id		( Id, idType, mkLocalId )
-import CoreFVs		( idFreeTyVars )
-import Name		( Name, mkSystemVarName )
-import TcSimplify	( tcSimplifyCheck, bindInstsOfLocalFuns )
-import TcEnv		( newLocalName, tcExtendIdEnv1, tcExtendTyVarEnv2,
-			  tcLookupClass, tcLookupDataCon, tcLookupId, refineEnvironment,
-			  tcMetaTy )
-import TcMType 		( newFlexiTyVarTy, arityErr, tcInstSkolTyVars, newBoxyTyVar, zonkTcType )
-import TcType		( TcType, TcTyVar, TcSigmaType, TcRhoType, 
-			  SkolemInfo(PatSkol), 
-			  BoxySigmaType, BoxyRhoType, 
-			  pprSkolTvBinding, isRefineableTy, isRigidTy, tcTyVarsOfTypes, mkTyVarTy, lookupTyVar, 
-			  emptyTvSubst, substTyVar, substTy, mkTopTvSubst, zipTopTvSubst, zipOpenTvSubst,
-			  mkTyVarTys, mkClassPred, mkTyConApp, isOverloadedTy,
-			  mkFunTy, mkFunTys, exactTyVarsOfTypes,
-			  tidyOpenTypes )
-import VarSet		( elemVarSet, mkVarSet )
-import Kind		( liftedTypeKind, openTypeKind )
-import TcUnify		( boxySplitTyConApp, boxySplitListTy, 
-			  unBox, stripBoxyType, zapToMonotype,
-		  	  boxyMatchTypes, boxyUnify, boxyUnifyList, checkSigTyVarsWrt )
-import TcHsType		( UserTypeCtxt(..), tcPatSig )
-import TysWiredIn	( boolTy, parrTyCon, tupleTyCon )
-import Unify		( MaybeErr(..), gadtRefineTys )
-import Type		( substTys, substTheta )
-import StaticFlags	( opt_IrrefutableTuples )
-import TyCon		( TyCon )
-import DataCon		( DataCon, dataConTyCon, isVanillaDataCon, 
-			  dataConFieldLabels, dataConSourceArity, dataConSig )
-import PrelNames	( integralClassName, fromIntegerName, integerTyConName, 
-			  fromRationalName, rationalTyConName )
-import BasicTypes	( isBoxed )
-import SrcLoc		( Located(..), SrcSpan, noLoc )
-import ErrUtils		( Message )
-import Util		( takeList, zipEqual )
-import Outputable
-import FastString
-\end{code}
-
-
-%************************************************************************
-%*									*
-		External interface
-%*									*
-%************************************************************************
-
-\begin{code}
-tcPats	:: PatCtxt
-	-> [LPat Name]			-- Patterns,
-	-> [BoxySigmaType]		--   and their types
-	-> BoxyRhoType 			-- Result type,
-	-> (BoxyRhoType -> TcM a)	--   and the checker for the body
-	-> TcM ([LPat TcId], a)
-
--- This is the externally-callable wrapper function
--- Typecheck the patterns, extend the environment to bind the variables,
--- do the thing inside, use any existentially-bound dictionaries to 
--- discharge parts of the returning LIE, and deal with pattern type
--- signatures
-
---   1. Initialise the PatState
---   2. Check the patterns
---   3. Apply the refinement
---   4. Check the body
---   5. Check that no existentials escape
-
-tcPats ctxt pats tys res_ty thing_inside
-  =  do	{ let init_state = PS { pat_ctxt = ctxt, pat_reft = emptyTvSubst }
-
-	; (pats', ex_tvs, res) <- tc_lpats init_state pats tys $ \ pstate' ->
-				  refineEnvironment (pat_reft pstate') $
-	     			  thing_inside (refineType (pat_reft pstate') res_ty)
-
-	; tcCheckExistentialPat ctxt pats' ex_tvs tys res_ty
-
-	; returnM (pats', res) }
-
-
------------------
-tcPat :: PatCtxt 
-      -> LPat Name -> BoxySigmaType 
-      -> BoxyRhoType		-- Result type
-      -> (BoxyRhoType -> TcM a)	-- Checker for body, given its result type
-      -> TcM (LPat TcId, a)
-tcPat ctxt pat pat_ty res_ty thing_inside
-  = do	{ ([pat'],thing) <- tcPats ctxt [pat] [pat_ty] res_ty thing_inside
-	; return (pat', thing) }
-
-
------------------
-tcCheckExistentialPat :: PatCtxt
-		      -> [LPat TcId]		-- Patterns (just for error message)
-		      -> [TcTyVar]		-- Existentially quantified tyvars bound by pattern
-		      -> [BoxySigmaType]	-- Types of the patterns
-		      -> BoxyRhoType		-- Type of the body of the match
-		      				-- Tyvars in either of these must not escape
-		      -> TcM ()
--- NB: we *must* pass "pats_tys" not just "body_ty" to tcCheckExistentialPat
--- For example, we must reject this program:
---	data C = forall a. C (a -> Int) 
--- 	f (C g) x = g x
--- Here, result_ty will be simply Int, but expected_ty is (C -> a -> Int).
-
-tcCheckExistentialPat ctxt pats [] pat_tys body_ty
-  = return ()	-- Short cut for case when there are no existentials
-
-tcCheckExistentialPat (LetPat _) pats ex_tvs pat_tys body_ty
-	-- Don't know how to deal with pattern-bound existentials yet
-  = failWithTc (existentialExplode pats)
-
-tcCheckExistentialPat ctxt pats ex_tvs pat_tys body_ty
-  = addErrCtxtM (sigPatCtxt (collectPatsBinders pats) ex_tvs pat_tys)	$
-    checkSigTyVarsWrt (tcTyVarsOfTypes (body_ty:pat_tys)) ex_tvs
-
-data PatState = PS {
-	pat_ctxt :: PatCtxt,
-	pat_reft :: GadtRefinement	-- Binds rigid TcTyVars to their refinements
-  }
-
-data PatCtxt 
-  = LamPat 
-  | LetPat (Name -> Maybe TcRhoType)	-- Used for let(rec) bindings
-
-patSigCtxt :: PatState -> UserTypeCtxt
-patSigCtxt (PS { pat_ctxt = LetPat _ }) = BindPatSigCtxt
-patSigCtxt other			= LamPatSigCtxt
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-		Binders
-%*									*
-%************************************************************************
-
-\begin{code}
-tcPatBndr :: PatState -> Name -> BoxySigmaType -> TcM TcId
-tcPatBndr (PS { pat_ctxt = LamPat }) bndr_name pat_ty
-  = do	{ pat_ty' <- unBox pat_ty
-		-- We have an undecorated binder, so we do rule ABS1,
-		-- by unboxing the boxy type, forcing any un-filled-in
-		-- boxes to become monotypes
-		-- NB that pat_ty' can still be a polytype:
-		-- 	data T = MkT (forall a. a->a)
-		-- 	f t = case t of { MkT g -> ... }
-		-- Here, the 'g' must get type (forall a. a->a) from the
-		-- MkT context
-	; return (mkLocalId bndr_name pat_ty') }
-
-tcPatBndr (PS { pat_ctxt = LetPat lookup_sig }) bndr_name pat_ty
-  | Just mono_ty <- lookup_sig bndr_name
-  = do	{ mono_name <- newLocalName bndr_name
-	; boxyUnify mono_ty pat_ty
-	; return (mkLocalId mono_name mono_ty) }
-
-  | otherwise
-  = do	{ pat_ty' <- unBox pat_ty
-	; mono_name <- newLocalName bndr_name
-	; return (mkLocalId mono_name pat_ty') }
-
-
--------------------
-bindInstsOfPatId :: TcId -> TcM a -> TcM (a, LHsBinds TcId)
-bindInstsOfPatId id thing_inside
-  | not (isOverloadedTy (idType id))
-  = do { res <- thing_inside; return (res, emptyLHsBinds) }
-  | otherwise
-  = do	{ (res, lie) <- getLIE thing_inside
-	; binds <- bindInstsOfLocalFuns lie [id]
-	; return (res, binds) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		The main worker functions
-%*									*
-%************************************************************************
-
-Note [Nesting]
-~~~~~~~~~~~~~~
-tcPat takes a "thing inside" over which the patter scopes.  This is partly
-so that tcPat can extend the environment for the thing_inside, but also 
-so that constraints arising in the thing_inside can be discharged by the
-pattern.
-
-This does not work so well for the ErrCtxt carried by the monad: we don't
-want the error-context for the pattern to scope over the RHS. 
-Hence the getErrCtxt/setErrCtxt stuff in tc_lpats.
-
-\begin{code}
---------------------
-tc_lpats :: PatState
-	 -> [LPat Name] 
-	 -> [BoxySigmaType]	
-	 -> (PatState -> TcM a)
-	 -> TcM ([LPat TcId], [TcTyVar], a)
-
-tc_lpats pstate pats pat_tys thing_inside
-  = do	{ err_ctxt <- getErrCtxt
-	; let loop pstate [] [] 
-		= do { res <- thing_inside pstate
-		     ; return ([], [], res) }
-
-	      loop pstate (p:ps) (ty:tys)
-		= do { (p', p_tvs, (ps', ps_tvs, res)) 
-				<- tc_lpat pstate p ty $ \ pstate' ->
-				   setErrCtxt err_ctxt $
-				   loop pstate' ps tys
-		-- setErrCtxt: restore context before doing the next pattern
-		-- See note [Nesting] above
-				
-		     ; return (p':ps', p_tvs ++ ps_tvs, res) }
-
-	      loop _ _ _ = pprPanic "tc_lpats" (ppr pats $$ ppr pat_tys)
-
-	; loop pstate pats pat_tys }
-
---------------------
-tc_lpat :: PatState
-	 -> LPat Name 
-	 -> BoxySigmaType
-	 -> (PatState -> TcM a)
-	 -> TcM (LPat TcId, [TcTyVar], a)
-tc_lpat pstate (L span pat) pat_ty thing_inside
-  = setSrcSpan span		  $
-    maybeAddErrCtxt (patCtxt pat) $
-    do	{ let pat_ty' = refineType (pat_reft pstate) pat_ty
-		-- Make sure the result type reflects the current refinement
-	; (pat', tvs, res) <- tc_pat pstate pat pat_ty' thing_inside
-	; return (L span pat', tvs, res) }
-
-
---------------------
-tc_pat	:: PatState
-	-> Pat Name -> BoxySigmaType	-- Fully refined result type
-	-> (PatState -> TcM a)	-- Thing inside
-	-> TcM (Pat TcId, 	-- Translated pattern
-		[TcTyVar], 	-- Existential binders
-		a)		-- Result of thing inside
-
-tc_pat pstate (VarPat name) pat_ty thing_inside
-  = do	{ id <- tcPatBndr pstate name pat_ty
-	; (res, binds) <- bindInstsOfPatId id $
-			  tcExtendIdEnv1 name id $
-			  (traceTc (text "binding" <+> ppr name <+> ppr (idType id))
-			   >> thing_inside pstate)
-	; let pat' | isEmptyLHsBinds binds = VarPat id
-		   | otherwise		   = VarPatOut id binds
-	; return (pat', [], res) }
-
-tc_pat pstate (ParPat pat) pat_ty thing_inside
-  = do	{ (pat', tvs, res) <- tc_lpat pstate pat pat_ty thing_inside
-	; return (ParPat pat', tvs, res) }
-
-tc_pat pstate (BangPat pat) pat_ty thing_inside
-  = do	{ (pat', tvs, res) <- tc_lpat pstate pat pat_ty thing_inside
-	; return (BangPat pat', tvs, res) }
-
--- There's a wrinkle with irrefuatable patterns, namely that we
--- must not propagate type refinement from them.  For example
---	data T a where { T1 :: Int -> T Int; ... }
---	f :: T a -> Int -> a
---	f ~(T1 i) y = y
--- It's obviously not sound to refine a to Int in the right
--- hand side, because the arugment might not match T1 at all!
---
--- Nor should a lazy pattern bind any existential type variables
--- because they won't be in scope when we do the desugaring
-tc_pat pstate lpat@(LazyPat pat) pat_ty thing_inside
-  = do	{ (pat', pat_tvs, res) <- tc_lpat pstate pat pat_ty $ \ _ ->
-				  thing_inside pstate
-					-- Ignore refined pstate',
-					-- revert to pstate
-	; if (null pat_tvs) then return ()
-	  else lazyPatErr lpat pat_tvs
-	; return (LazyPat pat', [], res) }
-
-tc_pat pstate (WildPat _) pat_ty thing_inside
-  = do	{ pat_ty' <- unBox pat_ty	-- Make sure it's filled in with monotypes
-	; res <- thing_inside pstate
-	; return (WildPat pat_ty', [], res) }
-
-tc_pat pstate (AsPat (L nm_loc name) pat) pat_ty thing_inside
-  = do	{ bndr_id <- setSrcSpan nm_loc (tcPatBndr pstate name pat_ty)
-	; (pat', tvs, res) <- tcExtendIdEnv1 name bndr_id $
-			      tc_lpat pstate pat (idType bndr_id) thing_inside
-	    -- NB: if we do inference on:
-	    --		\ (y@(x::forall a. a->a)) = e
-	    -- we'll fail.  The as-pattern infers a monotype for 'y', which then
-	    -- fails to unify with the polymorphic type for 'x'.  This could 
-	    -- perhaps be fixed, but only with a bit more work.
-	    --
-	    -- If you fix it, don't forget the bindInstsOfPatIds!
-	; return (AsPat (L nm_loc bndr_id) pat', tvs, res) }
-
--- Type signatures in patterns
--- See Note [Pattern coercions] below
-tc_pat pstate (SigPatIn pat sig_ty) pat_ty thing_inside
-  = do	{ (inner_ty, tv_binds) <- tcPatSig (patSigCtxt pstate) sig_ty pat_ty
-	; (pat', tvs, res) <- tcExtendTyVarEnv2 tv_binds $
-			      tc_lpat pstate pat inner_ty thing_inside
-	; return (SigPatOut pat' inner_ty, tvs, res) }
-
-tc_pat pstate pat@(TypePat ty) pat_ty thing_inside
-  = failWithTc (badTypePat pat)
-
-------------------------
--- Lists, tuples, arrays
-tc_pat pstate (ListPat pats _) pat_ty thing_inside
-  = do	{ elt_ty <- boxySplitListTy pat_ty
-	; let elt_tys = takeList pats (repeat elt_ty) 
-	; (pats', pats_tvs, res) <- tc_lpats pstate pats elt_tys thing_inside
- 	; return (ListPat pats' elt_ty, pats_tvs, res) }
-
-tc_pat pstate (PArrPat pats _) pat_ty thing_inside
-  = do	{ [elt_ty] <- boxySplitTyConApp parrTyCon pat_ty
- 	; let elt_tys = takeList pats (repeat elt_ty) 
-	; (pats', pats_tvs, res) <- tc_lpats pstate pats elt_tys thing_inside 
-	; ifM (null pats) (zapToMonotype pat_ty)	-- c.f. ExplicitPArr in TcExpr
-	; return (PArrPat pats' elt_ty, pats_tvs, res) }
-
-tc_pat pstate (TuplePat pats boxity _) pat_ty thing_inside
-  = do	{ arg_tys <- boxySplitTyConApp (tupleTyCon boxity (length pats)) pat_ty
-	; (pats', pats_tvs, res) <- tc_lpats pstate pats arg_tys thing_inside
-
-	-- Under flag control turn a pattern (x,y,z) into ~(x,y,z)
-	-- so that we can experiment with lazy tuple-matching.
-	-- This is a pretty odd place to make the switch, but
-	-- it was easy to do.
-	; let unmangled_result = TuplePat pats' boxity pat_ty
-	      possibly_mangled_result
-	        | opt_IrrefutableTuples && isBoxed boxity = LazyPat (noLoc unmangled_result)
-	        | otherwise			          = unmangled_result
-
- 	; ASSERT( length arg_tys == length pats )	-- Syntactically enforced
-	  return (possibly_mangled_result, pats_tvs, res) }
-
-------------------------
--- Data constructors
-tc_pat pstate pat_in@(ConPatIn (L con_span con_name) arg_pats) pat_ty thing_inside
-  = do	{ data_con <- tcLookupDataCon con_name
-	; let tycon = dataConTyCon data_con
-	; tcConPat pstate con_span data_con tycon pat_ty arg_pats thing_inside }
-
-------------------------
--- Literal patterns
-tc_pat pstate (LitPat simple_lit) pat_ty thing_inside
-  = do	{ boxyUnify (hsLitType simple_lit) pat_ty
-	; res <- thing_inside pstate
-	; returnM (LitPat simple_lit, [], res) }
-
-------------------------
--- Overloaded patterns: n, and n+k
-tc_pat pstate pat@(NPat over_lit mb_neg eq _) pat_ty thing_inside
-  = do	{ let orig = LiteralOrigin over_lit
-	; lit'    <- tcOverloadedLit orig over_lit pat_ty
-	; eq'     <- tcSyntaxOp orig eq (mkFunTys [pat_ty, pat_ty] boolTy)
-	; mb_neg' <- case mb_neg of
-			Nothing  -> return Nothing	-- Positive literal
-			Just neg -> 	-- Negative literal
-					-- The 'negate' is re-mappable syntax
- 			    do { neg' <- tcSyntaxOp orig neg (mkFunTy pat_ty pat_ty)
-			       ; return (Just neg') }
-	; res <- thing_inside pstate
-	; returnM (NPat lit' mb_neg' eq' pat_ty, [], res) }
-
-tc_pat pstate pat@(NPlusKPat (L nm_loc name) lit ge minus) pat_ty thing_inside
-  = do	{ bndr_id <- setSrcSpan nm_loc (tcPatBndr pstate name pat_ty)
- 	; let pat_ty' = idType bndr_id
-	      orig    = LiteralOrigin lit
-	; lit' <- tcOverloadedLit orig lit pat_ty'
-
-	-- The '>=' and '-' parts are re-mappable syntax
-	; ge'    <- tcSyntaxOp orig ge    (mkFunTys [pat_ty', pat_ty'] boolTy)
-	; minus' <- tcSyntaxOp orig minus (mkFunTys [pat_ty', pat_ty'] pat_ty')
-
-	-- The Report says that n+k patterns must be in Integral
-	-- We may not want this when using re-mappable syntax, though (ToDo?)
-	; icls <- tcLookupClass integralClassName
-	; dicts <- newDicts orig [mkClassPred icls [pat_ty']]	
-	; extendLIEs dicts
-    
-	; res <- tcExtendIdEnv1 name bndr_id (thing_inside pstate)
-	; returnM (NPlusKPat (L nm_loc bndr_id) lit' ge' minus', [], res) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Most of the work for constructors is here
-	(the rest is in the ConPatIn case of tc_pat)
-%*									*
-%************************************************************************
-
-\begin{code}
-tcConPat :: PatState -> SrcSpan -> DataCon -> TyCon 
-	 -> BoxySigmaType	-- Type of the pattern
-	 -> HsConDetails Name (LPat Name) -> (PatState -> TcM a)
-	 -> TcM (Pat TcId, [TcTyVar], a)
-tcConPat pstate con_span data_con tycon pat_ty arg_pats thing_inside
-  | isVanillaDataCon data_con
-  = do	{ ty_args <- boxySplitTyConApp tycon pat_ty
-	; let (tvs, _, arg_tys, _, _) = dataConSig data_con
-	      arg_tvs  = exactTyVarsOfTypes arg_tys
-		-- See Note [Silly type synonyms in smart-app] in TcExpr
-		-- for why we must use exactTyVarsOfTypes
-	      inst_prs = zipEqual "tcConPat" tvs ty_args
-	      subst    = mkTopTvSubst inst_prs
-	      arg_tys' = substTys subst arg_tys
-	      unconstrained_ty_args = [ty_arg | (tv,ty_arg) <- inst_prs,
-						not (tv `elemVarSet` arg_tvs)]
-	; mapM unBox unconstrained_ty_args	-- Zap these to monotypes
-	; tcInstStupidTheta data_con ty_args
-	; traceTc (text "tcConPat" <+> vcat [ppr data_con, ppr ty_args, ppr arg_tys'])
-	; (arg_pats', tvs, res) <- tcConArgs pstate data_con arg_pats arg_tys' thing_inside
-	; return (ConPatOut (L con_span data_con) [] [] emptyLHsBinds 
-			    arg_pats' (mkTyConApp tycon ty_args),
-		  tvs, res) }
-
-  | otherwise	-- GADT case
-  = do	{ ty_args <- boxySplitTyConApp tycon pat_ty
-	; span <- getSrcSpanM	-- The whole pattern
-
-	-- Instantiate the constructor type variables and result type
-	; let (tvs, theta, arg_tys, _, res_tys) = dataConSig data_con
-	      arg_tvs = exactTyVarsOfTypes arg_tys
-		-- See Note [Silly type synonyms in smart-app] in TcExpr
-		-- for why we must use exactTyVarsOfTypes
-	      skol_info = PatSkol data_con span
-	      arg_flags = [ tv `elemVarSet` arg_tvs | tv <- tvs ]
-	; tvs' <- tcInstSkolTyVars skol_info tvs
-	; let res_tys' = substTys (zipTopTvSubst tvs (mkTyVarTys tvs')) res_tys
-
-	-- Do type refinement!
-	; traceTc (text "tcGadtPat" <+> vcat [ppr data_con, ppr tvs', ppr res_tys', 
-					      text "ty-args:" <+> ppr ty_args ])
-	; refineAlt pstate data_con tvs' arg_flags res_tys' ty_args 
-			$ \ pstate' tv_tys' -> do
-
-	-- ToDo: arg_tys should be boxy, but I don't think theta' should be,
-	--	 or the tv_tys' in the call to tcInstStupidTheta
-	{ let tenv'    = zipTopTvSubst tvs tv_tys'
-	      theta'   = substTheta tenv' theta
-	      arg_tys' = substTys   tenv' arg_tys	-- Boxy types
-
-	; ((arg_pats', inner_tvs, res), lie_req) <- getLIE $
-		do { tcInstStupidTheta data_con tv_tys'
-			-- The stupid-theta mentions the newly-bound tyvars, so
-			-- it must live inside the getLIE, so that the
-			-- tcSimplifyCheck will apply the type refinement to it
-		   ; tcConArgs pstate' data_con arg_pats arg_tys' thing_inside }
-
-	; dicts <- newDicts (SigOrigin skol_info) theta'
-	; dict_binds <- tcSimplifyCheck doc tvs' dicts lie_req
-
-	; return (ConPatOut (L con_span data_con)
-			    tvs' (map instToId dicts) dict_binds
-			    arg_pats' (mkTyConApp tycon ty_args),
-		  tvs' ++ inner_tvs, res) 
-	} }
-  where
-    doc = ptext SLIT("existential context for") <+> quotes (ppr data_con)
-
-tcConArgs :: PatState -> DataCon 
-	   -> HsConDetails Name (LPat Name) -> [TcSigmaType]
-	   -> (PatState -> TcM a)
-	   -> TcM (HsConDetails TcId (LPat Id), [TcTyVar], a)
-
-tcConArgs pstate data_con (PrefixCon arg_pats) arg_tys thing_inside
-  = do	{ checkTc (con_arity == no_of_args)	-- Check correct arity
-		  (arityErr "Constructor" data_con con_arity no_of_args)
-	; (arg_pats', tvs, res) <- tc_lpats pstate arg_pats arg_tys thing_inside
-	; return (PrefixCon arg_pats', tvs, res) }
-  where
-    con_arity  = dataConSourceArity data_con
-    no_of_args = length arg_pats
-
-tcConArgs pstate data_con (InfixCon p1 p2) arg_tys thing_inside
-  = do	{ checkTc (con_arity == 2)	-- Check correct arity
-	 	  (arityErr "Constructor" data_con con_arity 2)
-	; ([p1',p2'], tvs, res) <- tc_lpats pstate [p1,p2] arg_tys thing_inside
-	; return (InfixCon p1' p2', tvs, res) }
-  where
-    con_arity  = dataConSourceArity data_con
-
-tcConArgs pstate data_con (RecCon rpats) arg_tys thing_inside
-  = do	{ (rpats', tvs, res) <- tc_fields pstate rpats thing_inside
-	; return (RecCon rpats', tvs, res) }
-  where
-    tc_fields :: PatState -> [(Located Name, LPat Name)]
-	      -> (PatState -> TcM a)
-	      -> TcM ([(Located TcId, LPat TcId)], [TcTyVar], a)
-    tc_fields pstate [] thing_inside
-      = do { res <- thing_inside pstate
-	   ; return ([], [], res) }
-
-    tc_fields pstate (rpat : rpats) thing_inside
-      =	do { (rpat', tvs1, (rpats', tvs2, res)) 
-		<- tc_field pstate rpat  $ \ pstate' ->
-		   tc_fields pstate' rpats thing_inside
-	   ; return (rpat':rpats', tvs1 ++ tvs2, res) }
-
-    tc_field pstate (field_lbl, pat) thing_inside
-      = do { (sel_id, pat_ty) <- wrapLocFstM find_field_ty field_lbl
-	   ; (pat', tvs, res) <- tc_lpat pstate pat pat_ty thing_inside
-	   ; return ((sel_id, pat'), tvs, res) }
-
-    find_field_ty field_lbl
-	= case [ty | (f,ty) <- field_tys, f == field_lbl] of
-
-		-- No matching field; chances are this field label comes from some
-		-- other record type (or maybe none).  As well as reporting an
-		-- error we still want to typecheck the pattern, principally to
-		-- make sure that all the variables it binds are put into the
-		-- environment, else the type checker crashes later:
-		--	f (R { foo = (a,b) }) = a+b
-		-- If foo isn't one of R's fields, we don't want to crash when
-		-- typechecking the "a+b".
-	   [] -> do { addErrTc (badFieldCon data_con field_lbl)
-		    ; bogus_ty <- newFlexiTyVarTy liftedTypeKind
-		    ; return (error "Bogus selector Id", bogus_ty) }
-
-		-- The normal case, when the field comes from the right constructor
-	   (pat_ty : extras) -> 
-		ASSERT( null extras )
-		do { sel_id <- tcLookupId field_lbl
-		   ; return (sel_id, pat_ty) }
-
-    field_tys = zip (dataConFieldLabels data_con) arg_tys
-	-- Don't use zipEqual! If the constructor isn't really a record, then
-	-- dataConFieldLabels will be empty (and each field in the pattern
-	-- will generate an error below).
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Type refinement
-%*									*
-%************************************************************************
-
-\begin{code}
-refineAlt :: PatState 
-	  -> DataCon		-- For tracing only
-	  -> [TcTyVar]		-- Type variables from pattern
-	  -> [Bool]		-- Flags indicating which type variables occur
-				--	in the type of at least one argument
-	  -> [TcType]		-- Result types from the pattern
-	  -> [BoxySigmaType] 	-- Result types from the scrutinee (context)
-	  -> (PatState -> [BoxySigmaType] -> TcM a)
-			-- Possibly-refined existentials
-	  -> TcM a
-refineAlt pstate con pat_tvs arg_flags pat_res_tys ctxt_res_tys thing_inside
-  | not (all isRigidTy ctxt_res_tys)
-	-- The context is not a rigid type, so we do no type refinement here.  
-  = do	{ let arg_tvs = mkVarSet [ tv | (tv, True) <- pat_tvs `zip` arg_flags]
-	      subst = boxyMatchTypes arg_tvs pat_res_tys ctxt_res_tys
-	      
-	      res_tvs = tcTyVarsOfTypes pat_res_tys
-		-- The tvs are (already) all fresh skolems. We need a 
-		-- fresh skolem for each type variable (to bind in the pattern)
-		-- even if it's refined away by the type refinement
-	      find_inst tv 
-		| not (tv `elemVarSet` res_tvs)        = return (mkTyVarTy tv)
-		| Just boxy_ty <- lookupTyVar subst tv = return boxy_ty
-		| otherwise			       = do { tv <- newBoxyTyVar openTypeKind
-							    ; return (mkTyVarTy tv) }
-	; pat_tys' <- mapM find_inst pat_tvs
-
-	-- Do the thing inside
-	; res <- thing_inside pstate pat_tys'
-
-	-- Unbox the types that have been filled in by the thing_inside
-	-- I.e. the ones whose type variables are mentioned in at least one arg
-	; let strip ty in_arg_tv | in_arg_tv = stripBoxyType ty
-				 | otherwise = return ty
-	; pat_tys'' <- zipWithM strip pat_tys' arg_flags
-	; let subst = zipOpenTvSubst pat_tvs pat_tys''
-	; boxyUnifyList (substTys subst pat_res_tys) ctxt_res_tys
-
-	; return res }		-- All boxes now filled
-
-  | otherwise	-- The context is rigid, so we can do type refinement
-  = case gadtRefineTys (pat_reft pstate) con pat_tvs pat_res_tys ctxt_res_tys of
-	Failed msg -> failWithTc (inaccessibleAlt msg)
-	Succeeded (new_subst, all_bound_here) 
-	  | all_bound_here 	-- All the new bindings are for pat_tvs, so no need
-				-- to refine the environment or pstate
-	  -> do  { traceTc trace_msg
-		 ; thing_inside pstate pat_tvs' }
-	  | otherwise 	-- New bindings affect the context, so pass down pstate'.  
-			-- DO NOT refine the envt, because we might be inside a
-			-- lazy pattern
-	  -> do { traceTc trace_msg
-		; thing_inside pstate' pat_tvs' }
-	  where
-  	     pat_tvs' = map (substTyVar new_subst) pat_tvs
-	     pstate'  = pstate { pat_reft = new_subst }
-	     trace_msg = text "refineTypes:match" <+> ppr con <+> ppr new_subst
-
-refineType :: GadtRefinement -> BoxyRhoType -> BoxyRhoType
--- Refine the type if it is rigid
-refineType reft ty
-  | isRefineableTy ty = substTy reft ty
-  | otherwise	      = ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Overloaded literals
-%*									*
-%************************************************************************
-
-In tcOverloadedLit we convert directly to an Int or Integer if we
-know that's what we want.  This may save some time, by not
-temporarily generating overloaded literals, but it won't catch all
-cases (the rest are caught in lookupInst).
-
-\begin{code}
-tcOverloadedLit :: InstOrigin
-		 -> HsOverLit Name
-		 -> BoxyRhoType
-		 -> TcM (HsOverLit TcId)
-tcOverloadedLit orig lit@(HsIntegral i fi) res_ty
-  | not (fi `isHsVar` fromIntegerName)	-- Do not generate a LitInst for rebindable syntax.  
-	-- Reason: If we do, tcSimplify will call lookupInst, which
-	--	   will call tcSyntaxName, which does unification, 
-	--	   which tcSimplify doesn't like
-	-- ToDo: noLoc sadness
-  = do	{ integer_ty <- tcMetaTy integerTyConName
-	; fi' <- tcSyntaxOp orig fi (mkFunTy integer_ty res_ty)
-	; return (HsIntegral i (HsApp (noLoc fi') (nlHsLit (HsInteger i integer_ty)))) }
-
-  | Just expr <- shortCutIntLit i res_ty 
-  = return (HsIntegral i expr)
-
-  | otherwise
-  = do 	{ expr <- newLitInst orig lit res_ty
-	; return (HsIntegral i expr) }
-
-tcOverloadedLit orig lit@(HsFractional r fr) res_ty
-  | not (fr `isHsVar` fromRationalName)	-- c.f. HsIntegral case
-  = do	{ rat_ty <- tcMetaTy rationalTyConName
-	; fr' <- tcSyntaxOp orig fr (mkFunTy rat_ty res_ty)
-	 	-- Overloaded literals must have liftedTypeKind, because
-	 	-- we're instantiating an overloaded function here,
-	 	-- whereas res_ty might be openTypeKind. This was a bug in 6.2.2
-		-- However this'll be picked up by tcSyntaxOp if necessary
-	; return (HsFractional r (HsApp (noLoc fr') (nlHsLit (HsRat r rat_ty)))) }
-
-  | Just expr <- shortCutFracLit r res_ty 
-  = return (HsFractional r expr)
-
-  | otherwise
-  = do 	{ expr <- newLitInst orig lit res_ty
-	; return (HsFractional r expr) }
-
-newLitInst :: InstOrigin -> HsOverLit Name -> BoxyRhoType -> TcM (HsExpr TcId)
-newLitInst orig lit res_ty	-- Make a LitInst
-  = do 	{ loc <- getInstLoc orig
-	; res_tau <- zapToMonotype res_ty
-	; new_uniq <- newUnique
-	; let
- 		lit_nm   = mkSystemVarName new_uniq FSLIT("lit")
-		lit_inst = LitInst lit_nm lit res_tau loc
-	; extendLIE lit_inst
-	; return (HsVar (instToId lit_inst)) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Note [Pattern coercions]
-%*									*
-%************************************************************************
-
-In principle, these program would be reasonable:
-	
-	f :: (forall a. a->a) -> Int
-	f (x :: Int->Int) = x 3
-
-	g :: (forall a. [a]) -> Bool
-	g [] = True
-
-In both cases, the function type signature restricts what arguments can be passed
-in a call (to polymorphic ones).  The pattern type signature then instantiates this
-type.  For example, in the first case,  (forall a. a->a) <= Int -> Int, and we
-generate the translated term
-	f = \x' :: (forall a. a->a).  let x = x' Int in x 3
-
-From a type-system point of view, this is perfectly fine, but it's *very* seldom useful.
-And it requires a significant amount of code to implement, becuase we need to decorate
-the translated pattern with coercion functions (generated from the subsumption check 
-by tcSub).  
-
-So for now I'm just insisting on type *equality* in patterns.  No subsumption. 
-
-Old notes about desugaring, at a time when pattern coercions were handled:
-
-A SigPat is a type coercion and must be handled one at at time.  We can't
-combine them unless the type of the pattern inside is identical, and we don't
-bother to check for that.  For example:
-
-	data T = T1 Int | T2 Bool
-	f :: (forall a. a -> a) -> T -> t
-	f (g::Int->Int)   (T1 i) = T1 (g i)
-	f (g::Bool->Bool) (T2 b) = T2 (g b)
-
-We desugar this as follows:
-
-	f = \ g::(forall a. a->a) t::T ->
-	    let gi = g Int
-	    in case t of { T1 i -> T1 (gi i)
-			   other ->
-	    let	gb = g Bool
-	    in case t of { T2 b -> T2 (gb b)
-			   other -> fail }}
-
-Note that we do not treat the first column of patterns as a
-column of variables, because the coerced variables (gi, gb)
-would be of different types.  So we get rather grotty code.
-But I don't think this is a common case, and if it was we could
-doubtless improve it.
-
-Meanwhile, the strategy is:
-	* treat each SigPat coercion (always non-identity coercions)
-		as a separate block
-	* deal with the stuff inside, and then wrap a binding round
-		the result to bind the new variable (gi, gb, etc)
-
-
-%************************************************************************
-%*									*
-\subsection{Errors and contexts}
-%*									*
-%************************************************************************
-
-\begin{code}
-patCtxt :: Pat Name -> Maybe Message	-- Not all patterns are worth pushing a context
-patCtxt (VarPat _)  = Nothing
-patCtxt (ParPat _)  = Nothing
-patCtxt (AsPat _ _) = Nothing
-patCtxt pat 	    = Just (hang (ptext SLIT("In the pattern:")) 
-			       4 (ppr pat))
-
------------------------------------------------
-
-existentialExplode pats
-  = hang (vcat [text "My brain just exploded.",
-	        text "I can't handle pattern bindings for existentially-quantified constructors.",
-		text "In the binding group for"])
-	4 (vcat (map ppr pats))
-
-sigPatCtxt bound_ids bound_tvs tys tidy_env 
-  = 	-- tys is (body_ty : pat_tys)  
-    mapM zonkTcType tys		`thenM` \ tys' ->
-    let
-	(env1,  tidy_tys) = tidyOpenTypes tidy_env (map idType show_ids)
-	(_env2, tidy_body_ty : tidy_pat_tys) = tidyOpenTypes env1 tys'
-    in
-    returnM (env1,
-		 sep [ptext SLIT("When checking an existential match that binds"),
-		      nest 4 (vcat (zipWith ppr_id show_ids tidy_tys)),
-		      ptext SLIT("The pattern(s) have type(s):") <+> vcat (map ppr tidy_pat_tys),
-		      ptext SLIT("The body has type:") <+> ppr tidy_body_ty
-		])
-  where
-    show_ids = filter is_interesting bound_ids
-    is_interesting id = any (`elemVarSet` idFreeTyVars id) bound_tvs
-
-    ppr_id id ty = ppr id <+> dcolon <+> ppr ty
-	-- Don't zonk the types so we get the separate, un-unified versions
-
-badFieldCon :: DataCon -> Name -> SDoc
-badFieldCon con field
-  = hsep [ptext SLIT("Constructor") <+> quotes (ppr con),
-	  ptext SLIT("does not have field"), quotes (ppr field)]
-
-polyPatSig :: TcType -> SDoc
-polyPatSig sig_ty
-  = hang (ptext SLIT("Illegal polymorphic type signature in pattern:"))
-	 4 (ppr sig_ty)
-
-badTypePat pat = ptext SLIT("Illegal type pattern") <+> ppr pat
-
-lazyPatErr pat tvs
-  = failWithTc $
-    hang (ptext SLIT("A lazy (~) pattern connot bind existential type variables"))
-       2 (vcat (map pprSkolTvBinding tvs))
-
-inaccessibleAlt msg
-  = hang (ptext SLIT("Inaccessible case alternative:")) 2 msg
-\end{code}
diff --git a/ghc/compiler/typecheck/TcRnDriver.lhs b/ghc/compiler/typecheck/TcRnDriver.lhs
deleted file mode 100644
index 5f4b487103..0000000000
--- a/ghc/compiler/typecheck/TcRnDriver.lhs
+++ /dev/null
@@ -1,1357 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcModule]{Typechecking a whole module}
-
-\begin{code}
-module TcRnDriver (
-#ifdef GHCI
-	tcRnStmt, tcRnExpr, tcRnType,
-	tcRnLookupRdrName,
-	tcRnLookupName,
-	tcRnGetInfo,
-	getModuleExports, 
-#endif
-	tcRnModule, 
-	tcTopSrcDecls,
-	tcRnExtCore
-    ) where
-
-#include "HsVersions.h"
-
-import IO
-#ifdef GHCI
-import {-# SOURCE #-} TcSplice ( tcSpliceDecls )
-#endif
-
-import DynFlags		( DynFlag(..), DynFlags(..), dopt, GhcMode(..) )
-import StaticFlags	( opt_PprStyle_Debug )
-import Packages		( checkForPackageConflicts, mkHomeModules )
-import HsSyn		( HsModule(..), HsExtCore(..), HsGroup(..), LHsDecl,
-			  SpliceDecl(..), HsBind(..), LHsBinds,
-			  emptyRdrGroup, emptyRnGroup, appendGroups, plusHsValBinds,
-			  nlHsApp, nlHsVar, pprLHsBinds )
-import RdrHsSyn		( findSplice )
-
-import PrelNames	( runMainIOName, rootMainKey, rOOT_MAIN, mAIN,
-			  main_RDR_Unqual )
-import RdrName		( RdrName, mkRdrUnqual, emptyGlobalRdrEnv )
-import TcHsSyn		( zonkTopDecls )
-import TcExpr 		( tcInferRho )
-import TcRnMonad
-import TcType		( tidyTopType, tcEqType, mkTyVarTys, substTyWith )
-import Inst		( showLIE )
-import InstEnv		( extendInstEnvList, Instance, pprInstances, instanceDFunId )
-import TcBinds		( tcTopBinds, tcHsBootSigs )
-import TcDefaults	( tcDefaults )
-import TcEnv		( tcExtendGlobalValEnv, iDFunId )
-import TcRules		( tcRules )
-import TcForeign	( tcForeignImports, tcForeignExports )
-import TcInstDcls	( tcInstDecls1, tcInstDecls2 )
-import TcIface		( tcExtCoreBindings, tcHiBootIface )
-import TcSimplify	( tcSimplifyTop )
-import TcTyClsDecls	( tcTyAndClassDecls )
-import LoadIface	( loadOrphanModules )
-import RnNames		( importsFromLocalDecls, rnImports, rnExports,
-                          mkRdrEnvAndImports, mkExportNameSet,
-			  reportUnusedNames, reportDeprecations )
-import RnEnv		( lookupSrcOcc_maybe )
-import RnSource		( rnSrcDecls, rnTyClDecls, checkModDeprec )
-import PprCore		( pprRules, pprCoreBindings )
-import CoreSyn		( CoreRule, bindersOfBinds )
-import DataCon		( dataConWrapId )
-import ErrUtils		( Messages, mkDumpDoc, showPass )
-import Id		( Id, mkExportedLocalId, isLocalId, idName, idType )
-import Var		( Var )
-import Module           ( Module, ModuleEnv, moduleEnvElts, elemModuleEnv )
-import OccName		( mkVarOccFS )
-import Name		( Name, NamedThing(..), isExternalName, getSrcLoc, isWiredInName,
-			  mkExternalName, isInternalName )
-import NameSet
-import TyCon		( tyConHasGenerics, isSynTyCon, synTyConDefn, tyConKind )
-import SrcLoc		( srcLocSpan, Located(..), noLoc )
-import DriverPhases	( HscSource(..), isHsBoot )
-import HscTypes		( ModGuts(..), ModDetails(..), emptyModDetails,
-			  HscEnv(..), ExternalPackageState(..),
-			  IsBootInterface, noDependencies, 
-			  Deprecs( NoDeprecs ), plusDeprecs,
-			  ForeignStubs(NoStubs), TyThing(..), 
-			  TypeEnv, lookupTypeEnv, hptInstances, 
-			  extendTypeEnvWithIds, typeEnvIds, typeEnvTyCons, typeEnvElts,
-			  emptyFixityEnv
-			)
-import Outputable
-
-#ifdef GHCI
-import HsSyn		( HsStmtContext(..), Stmt(..), HsExpr(..), 
-			  HsLocalBinds(..), HsValBinds(..),
-			  LStmt, LHsExpr, LHsType, mkMatch, emptyLocalBinds,
-			  collectLStmtsBinders, collectLStmtBinders, nlVarPat,
-		   	  mkFunBind, placeHolderType, noSyntaxExpr )
-import RdrName		( GlobalRdrElt(..), globalRdrEnvElts,
-			  unQualOK, lookupLocalRdrEnv, extendLocalRdrEnv )
-import RnSource		( addTcgDUs )
-import TcHsSyn		( mkHsDictLet, zonkTopLExpr, zonkTopBndrs )
-import TcHsType		( kcHsType )
-import TcMType		( zonkTcType, zonkQuantifiedTyVar )
-import TcMatches	( tcStmts, tcDoStmt )
-import TcSimplify	( tcSimplifyInteractive, tcSimplifyInfer )
-import TcType		( Type, mkForAllTys, mkFunTys, mkTyConApp, tyVarsOfType, isTauTy,
-			  isUnLiftedType, tyClsNamesOfDFunHead, tyClsNamesOfType, isUnitTy )
-import TcEnv		( tcLookupTyCon, tcLookupId, tcLookupGlobal )
-import RnTypes		( rnLHsType )
-import Inst		( tcGetInstEnvs )
-import InstEnv		( classInstances, instEnvElts )
-import RnExpr		( rnStmts, rnLExpr )
-import LoadIface	( loadSrcInterface, loadSysInterface )
-import IfaceEnv		( ifaceExportNames )
-import Module		( moduleSetElts, mkModuleSet )
-import RnEnv		( lookupOccRn, dataTcOccs, lookupFixityRn )
-import Id		( setIdType )
-import MkId		( unsafeCoerceId )
-import TyCon		( tyConName )
-import TysWiredIn	( mkListTy, unitTy )
-import IdInfo		( GlobalIdDetails(..) )
-import Kind		( Kind )
-import Var		( globaliseId )
-import Name		( nameOccName, nameModule, isBuiltInSyntax )
-import OccName		( isTcOcc )
-import NameEnv		( delListFromNameEnv )
-import PrelNames	( iNTERACTIVE, ioTyConName, printName, itName, 
-			  bindIOName, thenIOName, returnIOName )
-import HscTypes		( InteractiveContext(..),
-			  ModIface(..), icPrintUnqual,
-			  Dependencies(..) )
-import BasicTypes	( Fixity, RecFlag(..) )
-import SrcLoc		( unLoc )
-#endif
-
-import FastString	( mkFastString )
-import Maybes		( MaybeErr(..) )
-import Util		( sortLe )
-import Bag		( unionBags, snocBag, emptyBag, unitBag, unionManyBags )
-
-import Maybe		( isJust )
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-	Typecheck and rename a module
-%*									*
-%************************************************************************
-
-
-\begin{code}
-tcRnModule :: HscEnv 
-	   -> HscSource
-	   -> Bool 		-- True <=> save renamed syntax
-	   -> Located (HsModule RdrName)
-	   -> IO (Messages, Maybe TcGblEnv)
-
-tcRnModule hsc_env hsc_src save_rn_syntax
-	 (L loc (HsModule maybe_mod export_ies 
-			  import_decls local_decls mod_deprec))
- = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
-
-   let { this_mod = case maybe_mod of
-			Nothing  -> mAIN	  -- 'module M where' is omitted
-			Just (L _ mod) -> mod }	; -- The normal case
-		
-   initTc hsc_env hsc_src this_mod $ 
-   setSrcSpan loc $
-   do {
-		-- Deal with imports;
-	rn_imports <- rnImports import_decls ;
-        (rdr_env, imports) <- mkRdrEnvAndImports rn_imports ;
-
-	let { dep_mods :: ModuleEnv (Module, IsBootInterface)
-	    ; dep_mods = imp_dep_mods imports
-
-		-- We want instance declarations from all home-package
-		-- modules below this one, including boot modules, except
-		-- ourselves.  The 'except ourselves' is so that we don't
-		-- get the instances from this module's hs-boot file
-	    ; want_instances :: Module -> Bool
-	    ; want_instances mod = mod `elemModuleEnv` dep_mods
-				   && mod /= this_mod
-	    ; home_insts = hptInstances hsc_env want_instances
-	    } ;
-
-		-- Record boot-file info in the EPS, so that it's 
-		-- visible to loadHiBootInterface in tcRnSrcDecls,
-		-- and any other incrementally-performed imports
-	updateEps_ (\eps -> eps { eps_is_boot = dep_mods }) ;
-
-	checkConflicts imports this_mod $ do {
-
-		-- Update the gbl env
-	updGblEnv ( \ gbl -> 
-		gbl { tcg_rdr_env  = rdr_env,
-		      tcg_inst_env = extendInstEnvList (tcg_inst_env gbl) home_insts,
-		      tcg_imports  = tcg_imports gbl `plusImportAvails` imports,
-                      tcg_rn_imports = if save_rn_syntax then
-                                         Just rn_imports
-                                       else
-                                         Nothing,
-		      tcg_rn_decls = if save_rn_syntax then
-					Just emptyRnGroup
-				     else
-					Nothing })
-		$ do {
-
-	traceRn (text "rn1" <+> ppr (imp_dep_mods imports)) ;
-		-- Fail if there are any errors so far
-		-- The error printing (if needed) takes advantage 
-		-- of the tcg_env we have now set
-	failIfErrsM ;
-
-		-- Load any orphan-module interfaces, so that
-		-- their rules and instance decls will be found
-	loadOrphanModules (imp_orphs imports) ;
-
-	traceRn (text "rn1a") ;
-		-- Rename and type check the declarations
-	tcg_env <- if isHsBoot hsc_src then
-			tcRnHsBootDecls local_decls
-		   else	
-			tcRnSrcDecls local_decls ;
-	setGblEnv tcg_env		$ do {
-
-	traceRn (text "rn3") ;
-
-		-- Report the use of any deprecated things
-		-- We do this before processsing the export list so
-		-- that we don't bleat about re-exporting a deprecated
-		-- thing (especially via 'module Foo' export item)
-		-- Only uses in the body of the module are complained about
-	reportDeprecations tcg_env ;
-
-		-- Process the export list
-	rn_exports <- rnExports export_ies ;
-        let { liftM2' fn a b = do a' <- a; b' <- b; return (fn a' b') } ;
-        exports <- mkExportNameSet (isJust maybe_mod) (liftM2' (,) rn_exports export_ies) ;
-
-		-- Check whether the entire module is deprecated
-		-- This happens only once per module
-	let { mod_deprecs = checkModDeprec mod_deprec } ;
-
-		-- Add exports and deprecations to envt
-	let { final_env  = tcg_env { tcg_exports = exports,
-                                     tcg_rn_exports = if save_rn_syntax then
-                                                         rn_exports
-                                                      else Nothing,
-				     tcg_dus = tcg_dus tcg_env `plusDU` usesOnly exports,
-				     tcg_deprecs = tcg_deprecs tcg_env `plusDeprecs` 
-						   mod_deprecs }
-		-- A module deprecation over-rides the earlier ones
-	     } ;
-
-		-- Report unused names
- 	reportUnusedNames export_ies final_env ;
-
-		-- Dump output and return
-	tcDump final_env ;
-	return final_env
-    }}}}}
-
-
--- The program is not allowed to contain two modules with the same
--- name, and we check for that here.  It could happen if the home package
--- contains a module that is also present in an external package, for example.
-checkConflicts imports this_mod and_then = do
-   dflags <- getDOpts
-   let 
-	dep_mods = this_mod : map fst (moduleEnvElts (imp_dep_mods imports))
-		-- don't forget to include the current module!
-
-	mb_dep_pkgs = checkForPackageConflicts 
-				dflags dep_mods (imp_dep_pkgs imports)
-   --
-   case mb_dep_pkgs of
-     Failed msg -> 
-	do addErr msg; failM
-     Succeeded _ -> 
-	updGblEnv (\gbl -> gbl{ tcg_home_mods = mkHomeModules dep_mods })
-	   and_then
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Type-checking external-core modules
-%*									*
-%************************************************************************
-
-\begin{code}
-tcRnExtCore :: HscEnv 
-	    -> HsExtCore RdrName
-	    -> IO (Messages, Maybe ModGuts)
-	-- Nothing => some error occurred 
-
-tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
-	-- The decls are IfaceDecls; all names are original names
- = do { showPass (hsc_dflags hsc_env) "Renamer/typechecker" ;
-
-   initTc hsc_env ExtCoreFile this_mod $ do {
-
-   let { ldecls  = map noLoc decls } ;
-
-	-- Deal with the type declarations; first bring their stuff
-	-- into scope, then rname them, then type check them
-   tcg_env  <- importsFromLocalDecls (mkFakeGroup ldecls) ;
-
-   setGblEnv tcg_env $ do {
-
-   rn_decls <- rnTyClDecls ldecls ;
-   failIfErrsM ;
-
-	-- Dump trace of renaming part
-   rnDump (ppr rn_decls) ;
-
-	-- Typecheck them all together so that
-	-- any mutually recursive types are done right
-   tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails rn_decls) ;
-	-- Make the new type env available to stuff slurped from interface files
-
-   setGblEnv tcg_env $ do {
-   
-	-- Now the core bindings
-   core_binds <- initIfaceExtCore (tcExtCoreBindings src_binds) ;
-
-	-- Wrap up
-   let {
-	bndrs 	   = bindersOfBinds core_binds ;
-	my_exports = mkNameSet (map idName bndrs) ;
-		-- ToDo: export the data types also?
-
-	final_type_env = extendTypeEnvWithIds (tcg_type_env tcg_env) bndrs ;
-
-	mod_guts = ModGuts {	mg_module   = this_mod,
-				mg_boot	    = False,
-				mg_usages   = [],		-- ToDo: compute usage
-				mg_dir_imps = [],		-- ??
-				mg_deps     = noDependencies,	-- ??
-				mg_home_mods = mkHomeModules [], -- ?? wrong!!
-				mg_exports  = my_exports,
-				mg_types    = final_type_env,
-				mg_insts    = tcg_insts tcg_env,
-				mg_rules    = [],
-				mg_binds    = core_binds,
-
-				-- Stubs
-				mg_rdr_env  = emptyGlobalRdrEnv,
-				mg_fix_env  = emptyFixityEnv,
-				mg_deprecs  = NoDeprecs,
-				mg_foreign  = NoStubs
-		    } } ;
-
-   tcCoreDump mod_guts ;
-
-   return mod_guts
-   }}}}
-
-mkFakeGroup decls -- Rather clumsy; lots of unused fields
-  = emptyRdrGroup { hs_tyclds = decls }
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Type-checking the top level of a module
-%*									*
-%************************************************************************
-
-\begin{code}
-tcRnSrcDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
-	-- Returns the variables free in the decls
-	-- Reason: solely to report unused imports and bindings
-tcRnSrcDecls decls
- = do { 	-- Load the hi-boot interface for this module, if any
-		-- We do this now so that the boot_names can be passed
-		-- to tcTyAndClassDecls, because the boot_names are 
-		-- automatically considered to be loop breakers
-	mod <- getModule ;
-	boot_iface <- tcHiBootIface mod ;
-
-	  	-- Do all the declarations
-	(tc_envs, lie) <- getLIE (tc_rn_src_decls boot_iface decls) ;
-
-	     -- tcSimplifyTop deals with constant or ambiguous InstIds.  
-	     -- How could there be ambiguous ones?  They can only arise if a
-	     -- top-level decl falls under the monomorphism
-	     -- restriction, and no subsequent decl instantiates its
-	     -- type.  (Usually, ambiguous type variables are resolved
-	     -- during the generalisation step.)
-        traceTc (text "Tc8") ;
-	inst_binds <- setEnvs tc_envs (tcSimplifyTop lie) ;
-		-- Setting the global env exposes the instances to tcSimplifyTop
-		-- Setting the local env exposes the local Ids to tcSimplifyTop, 
-		-- so that we get better error messages (monomorphism restriction)
-
-	    -- Backsubstitution.  This must be done last.
-	    -- Even tcSimplifyTop may do some unification.
-        traceTc (text "Tc9") ;
-	let { (tcg_env, _) = tc_envs ;
-	      TcGblEnv { tcg_type_env = type_env, tcg_binds = binds, 
-		         tcg_rules = rules, tcg_fords = fords } = tcg_env } ;
-
-	tcDump tcg_env ;
-	(bind_ids, binds', fords', rules') <- zonkTopDecls (binds `unionBags` inst_binds)
-							   rules fords ;
-
-	let { final_type_env = extendTypeEnvWithIds type_env bind_ids
-	    ; tcg_env' = tcg_env { tcg_type_env = final_type_env,
-			 	   tcg_binds = binds',
-				   tcg_rules = rules', 
-				   tcg_fords = fords' } } ;
-
-	-- Make the new type env available to stuff slurped from interface files
-	writeMutVar (tcg_type_env_var tcg_env) final_type_env ;
-
-	-- Compare the hi-boot iface (if any) with the real thing
- 	dfun_binds <- checkHiBootIface tcg_env' boot_iface ;
-
-	return (tcg_env' { tcg_binds = tcg_binds tcg_env' `unionBags` dfun_binds }) 
-   }
-
-tc_rn_src_decls :: ModDetails -> [LHsDecl RdrName] -> TcM (TcGblEnv, TcLclEnv)
--- Loops around dealing with each top level inter-splice group 
--- in turn, until it's dealt with the entire module
-tc_rn_src_decls boot_details ds
- = do { let { (first_group, group_tail) = findSplice ds } ;
-		-- If ds is [] we get ([], Nothing)
-
-	-- Type check the decls up to, but not including, the first splice
-	tc_envs@(tcg_env,tcl_env) <- tcRnGroup boot_details first_group ;
-
-	-- Bale out if errors; for example, error recovery when checking
-	-- the RHS of 'main' can mean that 'main' is not in the envt for 
-	-- the subsequent checkMain test
-	failIfErrsM ;
-
-	setEnvs tc_envs $
-
-	-- If there is no splice, we're nearly done
-	case group_tail of {
-	   Nothing -> do { 	-- Last thing: check for `main'
-			   tcg_env <- checkMain ;
-			   return (tcg_env, tcl_env) 
-		      } ;
-
-	-- If there's a splice, we must carry on
-	   Just (SpliceDecl splice_expr, rest_ds) -> do {
-#ifndef GHCI
-	failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
-#else
-
-	-- Rename the splice expression, and get its supporting decls
-	(rn_splice_expr, splice_fvs) <- rnLExpr splice_expr ;
-	failIfErrsM ;	-- Don't typecheck if renaming failed
-
-	-- Execute the splice
-	spliced_decls <- tcSpliceDecls rn_splice_expr ;
-
-	-- Glue them on the front of the remaining decls and loop
-	setGblEnv (tcg_env `addTcgDUs` usesOnly splice_fvs) $
-	tc_rn_src_decls boot_details (spliced_decls ++ rest_ds)
-#endif /* GHCI */
-    }}}
-\end{code}
-
-%************************************************************************
-%*									*
-	Compiling hs-boot source files, and
-	comparing the hi-boot interface with the real thing
-%*									*
-%************************************************************************
-
-\begin{code}
-tcRnHsBootDecls :: [LHsDecl RdrName] -> TcM TcGblEnv
-tcRnHsBootDecls decls
-   = do { let { (first_group, group_tail) = findSplice decls }
-
-	; case group_tail of
-	     Just stuff -> spliceInHsBootErr stuff
-	     Nothing    -> return ()
-
-		-- Rename the declarations
-	; (tcg_env, rn_group) <- rnTopSrcDecls first_group
-	; setGblEnv tcg_env $ do {
-
-	-- Todo: check no foreign decls, no rules, no default decls
-
-		-- Typecheck type/class decls
-	; traceTc (text "Tc2")
-	; let tycl_decls = hs_tyclds rn_group
-	; tcg_env <- checkNoErrs (tcTyAndClassDecls emptyModDetails tycl_decls)
-	; setGblEnv tcg_env	$ do {
-
-		-- Typecheck instance decls
-	; traceTc (text "Tc3")
-	; (tcg_env, inst_infos, _binds) <- tcInstDecls1 tycl_decls (hs_instds rn_group)
-	; setGblEnv tcg_env	$ do {
-
-		-- Typecheck value declarations
-	; traceTc (text "Tc5") 
-	; val_ids <- tcHsBootSigs (hs_valds rn_group)
-
-		-- Wrap up
-		-- No simplification or zonking to do
-	; traceTc (text "Tc7a")
-	; gbl_env <- getGblEnv 
-	
-		-- Make the final type-env
-		-- Include the dfun_ids so that their type sigs get
-		-- are written into the interface file
-	; let { type_env0 = tcg_type_env gbl_env
-	      ; type_env1 = extendTypeEnvWithIds type_env0 val_ids
-	      ; type_env2 = extendTypeEnvWithIds type_env1 dfun_ids 
-	      ; dfun_ids = map iDFunId inst_infos }
-	; return (gbl_env { tcg_type_env = type_env2 }) 
-   }}}}
-
-spliceInHsBootErr (SpliceDecl (L loc _), _)
-  = addErrAt loc (ptext SLIT("Splices are not allowed in hs-boot files"))
-\end{code}
-
-Once we've typechecked the body of the module, we want to compare what
-we've found (gathered in a TypeEnv) with the hi-boot details (if any).
-
-\begin{code}
-checkHiBootIface :: TcGblEnv -> ModDetails -> TcM (LHsBinds Id)
--- Compare the hi-boot file for this module (if there is one)
--- with the type environment we've just come up with
--- In the common case where there is no hi-boot file, the list
--- of boot_names is empty.
---
--- The bindings we return give bindings for the dfuns defined in the
--- hs-boot file, such as 	$fbEqT = $fEqT
-
-checkHiBootIface
-	(TcGblEnv { tcg_insts = local_insts, tcg_type_env = local_type_env })
-	(ModDetails { md_insts = boot_insts, md_types = boot_type_env })
-  = do	{ mapM_ check_one (typeEnvElts boot_type_env)
-	; dfun_binds <- mapM check_inst boot_insts
-	; return (unionManyBags dfun_binds) }
-  where
-    check_one boot_thing
-      | no_check name
-      = return ()	
-      | otherwise	
-      = case lookupTypeEnv local_type_env name of
-	  Nothing 	  -> addErrTc (missingBootThing boot_thing)
-	  Just real_thing -> check_thing boot_thing real_thing
-      where
-	name = getName boot_thing
-
-    no_check name = isWiredInName name	-- No checking for wired-in names.  In particular,
-					-- 'error' is handled by a rather gross hack
-					-- (see comments in GHC.Err.hs-boot)
-		  || name `elem` dfun_names
-    dfun_names = map getName boot_insts
-
-    check_inst boot_inst
-	= case [dfun | inst <- local_insts, 
-		       let dfun = instanceDFunId inst,
-		       idType dfun `tcEqType` boot_inst_ty ] of
-	    [] -> do { addErrTc (instMisMatch boot_inst); return emptyBag }
-	    (dfun:_) -> return (unitBag $ noLoc $ VarBind local_boot_dfun (nlHsVar dfun))
-	where
-	  boot_dfun = instanceDFunId boot_inst
-	  boot_inst_ty = idType boot_dfun
-	  local_boot_dfun = mkExportedLocalId (idName boot_dfun) boot_inst_ty
-
-----------------
-check_thing (ATyCon boot_tc) (ATyCon real_tc)
-  | isSynTyCon boot_tc && isSynTyCon real_tc,
-    defn1 `tcEqType` substTyWith tvs2 (mkTyVarTys tvs1) defn2
-  = return ()
-
-  | tyConKind boot_tc == tyConKind real_tc
-  = return ()
-  where
-    (tvs1, defn1) = synTyConDefn boot_tc
-    (tvs2, defn2) = synTyConDefn boot_tc
-
-check_thing (AnId boot_id) (AnId real_id)
-  | idType boot_id `tcEqType` idType real_id
-  = return ()
-
-check_thing (ADataCon dc1) (ADataCon dc2)
-  | idType (dataConWrapId dc1) `tcEqType` idType (dataConWrapId dc2)
-  = return ()
-
-	-- Can't declare a class in a hi-boot file
-
-check_thing boot_thing real_thing	-- Default case; failure
-  = addErrAt (srcLocSpan (getSrcLoc real_thing))
-	     (bootMisMatch real_thing)
-
-----------------
-missingBootThing thing
-  = ppr thing <+> ptext SLIT("is defined in the hs-boot file, but not in the module")
-bootMisMatch thing
-  = ppr thing <+> ptext SLIT("has conflicting definitions in the module and its hs-boot file")
-instMisMatch inst
-  = hang (ppr inst)
-       2 (ptext SLIT("is defined in the hs-boot file, but not in the module"))
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Type-checking the top level of a module
-%*									*
-%************************************************************************
-
-tcRnGroup takes a bunch of top-level source-code declarations, and
- * renames them
- * gets supporting declarations from interface files
- * typechecks them
- * zonks them
- * and augments the TcGblEnv with the results
-
-In Template Haskell it may be called repeatedly for each group of
-declarations.  It expects there to be an incoming TcGblEnv in the
-monad; it augments it and returns the new TcGblEnv.
-
-\begin{code}
-tcRnGroup :: ModDetails -> HsGroup RdrName -> TcM (TcGblEnv, TcLclEnv)
-	-- Returns the variables free in the decls, for unused-binding reporting
-tcRnGroup boot_details decls
- = do {		-- Rename the declarations
-	(tcg_env, rn_decls) <- rnTopSrcDecls decls ;
-	setGblEnv tcg_env $ do {
-
-		-- Typecheck the declarations
-	tcTopSrcDecls boot_details rn_decls 
-  }}
-
-------------------------------------------------
-rnTopSrcDecls :: HsGroup RdrName -> TcM (TcGblEnv, HsGroup Name)
-rnTopSrcDecls group
- = do { 	-- Bring top level binders into scope
-	tcg_env <- importsFromLocalDecls group ;
-	setGblEnv tcg_env $ do {
-
-	failIfErrsM ;	-- No point in continuing if (say) we have duplicate declarations
-
-		-- Rename the source decls
-	(tcg_env, rn_decls) <- rnSrcDecls group ;
-	failIfErrsM ;
-
-		-- save the renamed syntax, if we want it
-	let { tcg_env'
-	        | Just grp <- tcg_rn_decls tcg_env
-	          = tcg_env{ tcg_rn_decls = Just (appendGroups grp rn_decls) }
-	        | otherwise
-	           = tcg_env };
-
-		-- Dump trace of renaming part
-	rnDump (ppr rn_decls) ;
-
-	return (tcg_env', rn_decls)
-   }}
-
-------------------------------------------------
-tcTopSrcDecls :: ModDetails -> HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
-tcTopSrcDecls boot_details
-	(HsGroup { hs_tyclds = tycl_decls, 
-		   hs_instds = inst_decls,
-		   hs_fords  = foreign_decls,
-		   hs_defds  = default_decls,
-		   hs_ruleds = rule_decls,
-		   hs_valds  = val_binds })
- = do {		-- Type-check the type and class decls, and all imported decls
-		-- The latter come in via tycl_decls
-        traceTc (text "Tc2") ;
-
-	tcg_env <- checkNoErrs (tcTyAndClassDecls boot_details tycl_decls) ;
-	-- tcTyAndClassDecls recovers internally, but if anything gave rise to
-	-- an error we'd better stop now, to avoid a cascade
-	
-	-- Make these type and class decls available to stuff slurped from interface files
-	writeMutVar (tcg_type_env_var tcg_env) (tcg_type_env tcg_env) ;
-
-
-	setGblEnv tcg_env	$ do {
-		-- Source-language instances, including derivings,
-		-- and import the supporting declarations
-        traceTc (text "Tc3") ;
-	(tcg_env, inst_infos, deriv_binds) <- tcInstDecls1 tycl_decls inst_decls ;
-	setGblEnv tcg_env	$ do {
-
-	        -- Foreign import declarations next.  No zonking necessary
-		-- here; we can tuck them straight into the global environment.
-        traceTc (text "Tc4") ;
-	(fi_ids, fi_decls) <- tcForeignImports foreign_decls ;
-	tcExtendGlobalValEnv fi_ids	$ do {
-
-		-- Default declarations
-        traceTc (text "Tc4a") ;
-	default_tys <- tcDefaults default_decls ;
-	updGblEnv (\gbl -> gbl { tcg_default = default_tys }) $ do {
-	
-		-- Value declarations next
-		-- We also typecheck any extra binds that came out 
-		-- of the "deriving" process (deriv_binds)
-        traceTc (text "Tc5") ;
-	(tc_val_binds, tcl_env) <- tcTopBinds (val_binds `plusHsValBinds` deriv_binds) ;
-	setLclTypeEnv tcl_env 	$ do {
-
-	     	-- Second pass over class and instance declarations, 
-        traceTc (text "Tc6") ;
-	(inst_binds, tcl_env) <- tcInstDecls2 tycl_decls inst_infos ;
-	showLIE (text "after instDecls2") ;
-
-		-- Foreign exports
-		-- They need to be zonked, so we return them
-        traceTc (text "Tc7") ;
-	(foe_binds, foe_decls) <- tcForeignExports foreign_decls ;
-
-		-- Rules
-	rules <- tcRules rule_decls ;
-
-		-- Wrap up
-        traceTc (text "Tc7a") ;
-	tcg_env <- getGblEnv ;
-	let { all_binds = tc_val_binds	 `unionBags`
-			  inst_binds	 `unionBags`
-			  foe_binds  ;
-
-		-- Extend the GblEnv with the (as yet un-zonked) 
-		-- bindings, rules, foreign decls
-	      tcg_env' = tcg_env {  tcg_binds = tcg_binds tcg_env `unionBags` all_binds,
-				    tcg_rules = tcg_rules tcg_env ++ rules,
-				    tcg_fords = tcg_fords tcg_env ++ foe_decls ++ fi_decls } } ;
-  	return (tcg_env', tcl_env)
-    }}}}}}
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Checking for 'main'
-%*									*
-%************************************************************************
-
-\begin{code}
-checkMain :: TcM TcGblEnv
--- If we are in module Main, check that 'main' is defined.
-checkMain 
-  = do { ghc_mode <- getGhcMode ;
-	 tcg_env   <- getGblEnv ;
-	 dflags    <- getDOpts ;
-	 let { main_mod = mainModIs dflags ;
-	       main_fn  = case mainFunIs dflags of {
-				Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn)) ;
-				Nothing -> main_RDR_Unqual } } ;
-	
-	 check_main ghc_mode tcg_env main_mod main_fn
-    }
-
-
-check_main ghc_mode tcg_env main_mod main_fn
- | mod /= main_mod
- = traceTc (text "checkMain not" <+> ppr main_mod <+> ppr mod) >>
-   return tcg_env
-
- | otherwise
- = addErrCtxt mainCtxt			$
-   do	{ mb_main <- lookupSrcOcc_maybe main_fn
-		-- Check that 'main' is in scope
-		-- It might be imported from another module!
-	; case mb_main of {
-	     Nothing -> do { traceTc (text "checkMain fail" <+> ppr main_mod <+> ppr main_fn)
-			   ; complain_no_main	
-			   ; return tcg_env } ;
-	     Just main_name -> do
-	{ traceTc (text "checkMain found" <+> ppr main_mod <+> ppr main_fn)
-	; let { rhs = nlHsApp (nlHsVar runMainIOName) (nlHsVar main_name) }
-		   	-- :Main.main :: IO () = runMainIO main 
-
-	; (main_expr, ty) <- setSrcSpan (srcLocSpan (getSrcLoc main_name)) $
-			     tcInferRho rhs
-
-	-- The function that the RTS invokes is always :Main.main,
-	-- which we call root_main_id.  
-	-- (Because GHC allows the user to have a module not called 
-	-- Main as the main module, we can't rely on the main function
-	-- being called "Main.main".  That's why root_main_id has a fixed
-	-- module ":Main".)
-	-- We also make root_main_id an implicit Id, by making main_name
-	-- its parent (hence (Just main_name)).  That has the effect
-	-- of preventing its type and unfolding from getting out into
-	-- the interface file. Otherwise we can end up with two defns
-	-- for 'main' in the interface file!
-
-	; let { root_main_name =  mkExternalName rootMainKey rOOT_MAIN 
-				   (mkVarOccFS FSLIT("main")) 
-				   (Just main_name) (getSrcLoc main_name)
-	      ; root_main_id = mkExportedLocalId root_main_name ty
-	      ; main_bind    = noLoc (VarBind root_main_id main_expr) }
-
-	; return (tcg_env { tcg_binds = tcg_binds tcg_env 
-					`snocBag` main_bind,
-			    tcg_dus   = tcg_dus tcg_env
-				        `plusDU` usesOnly (unitFV main_name)
-			-- Record the use of 'main', so that we don't 
-			-- complain about it being defined but not used
-		 }) 
-    }}}
-  where
-    mod = tcg_mod tcg_env
- 
-    complain_no_main | ghc_mode == Interactive = return ()
-		     | otherwise 		= failWithTc noMainMsg
-	-- In interactive mode, don't worry about the absence of 'main'
-	-- In other modes, fail altogether, so that we don't go on
-	-- and complain a second time when processing the export list.
-
-    mainCtxt  = ptext SLIT("When checking the type of the main function") <+> quotes (ppr main_fn)
-    noMainMsg = ptext SLIT("The main function") <+> quotes (ppr main_fn) 
-		<+> ptext SLIT("is not defined in module") <+> quotes (ppr main_mod)
-\end{code}
-
-%*********************************************************
-%*						 	 *
-		GHCi stuff
-%*							 *
-%*********************************************************
-
-\begin{code}
-#ifdef GHCI
-setInteractiveContext :: HscEnv -> InteractiveContext -> TcRn a -> TcRn a
-setInteractiveContext hsc_env icxt thing_inside 
-  = let 
-	-- Initialise the tcg_inst_env with instances 
-	-- from all home modules.  This mimics the more selective
-	-- call to hptInstances in tcRnModule
-	dfuns = hptInstances hsc_env (\mod -> True)
-    in
-    updGblEnv (\env -> env { 
-	tcg_rdr_env  = ic_rn_gbl_env icxt,
-	tcg_type_env = ic_type_env   icxt,
-	tcg_inst_env = extendInstEnvList (tcg_inst_env env) dfuns }) $
-
-    updLclEnv (\env -> env { tcl_rdr = ic_rn_local_env icxt })	$
-
-    do	{ traceTc (text "setIC" <+> ppr (ic_type_env icxt))
- 	; thing_inside }
-\end{code}
-
-
-\begin{code}
-tcRnStmt :: HscEnv
-	 -> InteractiveContext
-	 -> LStmt RdrName
-	 -> IO (Maybe (InteractiveContext, [Name], LHsExpr Id))
-		-- The returned [Name] is the same as the input except for
-		-- ExprStmt, in which case the returned [Name] is [itName]
-		--
-		-- The returned TypecheckedHsExpr is of type IO [ () ],
-		-- a list of the bound values, coerced to ().
-
-tcRnStmt hsc_env ictxt rdr_stmt
-  = initTcPrintErrors hsc_env iNTERACTIVE $ 
-    setInteractiveContext hsc_env ictxt $ do {
-
-    -- Rename; use CmdLineMode because tcRnStmt is only used interactively
-    (([rn_stmt], _), fvs) <- rnStmts DoExpr [rdr_stmt] (return ((), emptyFVs)) ;
-    traceRn (text "tcRnStmt" <+> vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs]) ;
-    failIfErrsM ;
-    
-    -- The real work is done here
-    (bound_ids, tc_expr) <- mkPlan rn_stmt ;
-    zonked_expr <- zonkTopLExpr tc_expr ;
-    zonked_ids  <- zonkTopBndrs bound_ids ;
-    
-	-- None of the Ids should be of unboxed type, because we
-	-- cast them all to HValues in the end!
-    mappM bad_unboxed (filter (isUnLiftedType . idType) zonked_ids) ;
-
-    traceTc (text "tcs 1") ;
-    let {	-- (a) Make all the bound ids "global" ids, now that
-    		--     they're notionally top-level bindings.  This is
-	    	--     important: otherwise when we come to compile an expression
-	    	--     using these ids later, the byte code generator will consider
-	    	--     the occurrences to be free rather than global.
-		-- 
-		-- (b) Tidy their types; this is important, because :info may
-		--     ask to look at them, and :info expects the things it looks
-		--     up to have tidy types
-	global_ids = map globaliseAndTidy zonked_ids ;
-    
-		-- Update the interactive context
-	rn_env   = ic_rn_local_env ictxt ;
-	type_env = ic_type_env ictxt ;
-
-	bound_names = map idName global_ids ;
-	new_rn_env  = extendLocalRdrEnv rn_env bound_names ;
-
-		-- Remove any shadowed bindings from the type_env;
-		-- they are inaccessible but might, I suppose, cause 
-		-- a space leak if we leave them there
-	shadowed = [ n | name <- bound_names,
-			 let rdr_name = mkRdrUnqual (nameOccName name),
-			 Just n <- [lookupLocalRdrEnv rn_env rdr_name] ] ;
-
-	filtered_type_env = delListFromNameEnv type_env shadowed ;
-	new_type_env = extendTypeEnvWithIds filtered_type_env global_ids ;
-
-	new_ic = ictxt { ic_rn_local_env = new_rn_env, 
-		  	 ic_type_env     = new_type_env }
-    } ;
-
-    dumpOptTcRn Opt_D_dump_tc 
-    	(vcat [text "Bound Ids" <+> pprWithCommas ppr global_ids,
-    	       text "Typechecked expr" <+> ppr zonked_expr]) ;
-
-    returnM (new_ic, bound_names, zonked_expr)
-    }
-  where
-    bad_unboxed id = addErr (sep [ptext SLIT("GHCi can't bind a variable of unlifted type:"),
-				  nest 2 (ppr id <+> dcolon <+> ppr (idType id))])
-
-globaliseAndTidy :: Id -> Id
-globaliseAndTidy id
--- Give the Id a Global Name, and tidy its type
-  = setIdType (globaliseId VanillaGlobal id) tidy_type
-  where
-    tidy_type = tidyTopType (idType id)
-\end{code}
-
-Here is the grand plan, implemented in tcUserStmt
-
-	What you type			The IO [HValue] that hscStmt returns
-	-------------			------------------------------------
-	let pat = expr		==> 	let pat = expr in return [coerce HVal x, coerce HVal y, ...]
-					bindings: [x,y,...]
-
-	pat <- expr		==> 	expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
-					bindings: [x,y,...]
-
-	expr (of IO type)	==>	expr >>= \ it -> return [coerce HVal it]
-	  [NB: result not printed]	bindings: [it]
-	  
-	expr (of non-IO type,	==>	let it = expr in print it >> return [coerce HVal it]
-	  result showable)		bindings: [it]
-
-	expr (of non-IO type, 
-	  result not showable)	==>	error
-
-
-\begin{code}
----------------------------
-type PlanResult = ([Id], LHsExpr Id)
-type Plan = TcM PlanResult
-
-runPlans :: [Plan] -> TcM PlanResult
--- Try the plans in order.  If one fails (by raising an exn), try the next.
--- If one succeeds, take it.
-runPlans []     = panic "runPlans"
-runPlans [p]    = p
-runPlans (p:ps) = tryTcLIE_ (runPlans ps) p
-
---------------------
-mkPlan :: LStmt Name -> TcM PlanResult
-mkPlan (L loc (ExprStmt expr _ _))	-- An expression typed at the prompt 
-  = do	{ uniq <- newUnique		-- is treated very specially
-	; let fresh_it  = itName uniq
-	      the_bind  = L loc $ mkFunBind (L loc fresh_it) matches
-	      matches   = [mkMatch [] expr emptyLocalBinds]
-	      let_stmt  = L loc $ LetStmt (HsValBinds (ValBindsOut [(NonRecursive,unitBag the_bind)] []))
-	      bind_stmt = L loc $ BindStmt (nlVarPat fresh_it) expr
-					   (HsVar bindIOName) noSyntaxExpr 
-	      print_it  = L loc $ ExprStmt (nlHsApp (nlHsVar printName) (nlHsVar fresh_it))
-			          	   (HsVar thenIOName) placeHolderType
-
-	-- The plans are:
-	--	[it <- e; print it]	but not if it::()
-	--	[it <- e]		
-	--	[let it = e; print it]	
-	; runPlans [	-- Plan A
-		    do { stuff@([it_id], _) <- tcGhciStmts [bind_stmt, print_it]
-		       ; it_ty <- zonkTcType (idType it_id)
-		       ; ifM (isUnitTy it_ty) failM
-		       ; return stuff },
-
-			-- Plan B; a naked bind statment
-		    tcGhciStmts [bind_stmt],	
-
-			-- Plan C; check that the let-binding is typeable all by itself.
-			-- If not, fail; if so, try to print it.
-			-- The two-step process avoids getting two errors: one from
-			-- the expression itself, and one from the 'print it' part
-			-- This two-step story is very clunky, alas
-		    do { checkNoErrs (tcGhciStmts [let_stmt]) 
-				--- checkNoErrs defeats the error recovery of let-bindings
-		       ; tcGhciStmts [let_stmt, print_it] }
-	  ]}
-
-mkPlan stmt@(L loc (BindStmt {}))
-  | [L _ v] <- collectLStmtBinders stmt		-- One binder, for a bind stmt 
-  = do	{ let print_v  = L loc $ ExprStmt (nlHsApp (nlHsVar printName) (nlHsVar v))
-			          	   (HsVar thenIOName) placeHolderType
-	-- The plans are:
-	--	[stmt; print v]		but not if v::()
-	--	[stmt]
-	; runPlans [do { stuff@([v_id], _) <- tcGhciStmts [stmt, print_v]
-		       ; v_ty <- zonkTcType (idType v_id)
-		       ; ifM (isUnitTy v_ty || not (isTauTy v_ty)) failM
-		       ; return stuff },
-		    tcGhciStmts [stmt]
-	  ]}
-
-mkPlan stmt
-  = tcGhciStmts [stmt]
-
----------------------------
-tcGhciStmts :: [LStmt Name] -> TcM PlanResult
-tcGhciStmts stmts
- = do { ioTyCon <- tcLookupTyCon ioTyConName ;
-	ret_id  <- tcLookupId returnIOName ;		-- return @ IO
-	let {
-	    io_ty     = mkTyConApp ioTyCon [] ;
-	    ret_ty    = mkListTy unitTy ;
-	    io_ret_ty = mkTyConApp ioTyCon [ret_ty] ;
-
-	    names = map unLoc (collectLStmtsBinders stmts) ;
-
-		-- mk_return builds the expression
-		--	returnIO @ [()] [coerce () x, ..,  coerce () z]
-		--
-		-- Despite the inconvenience of building the type applications etc,
-		-- this *has* to be done in type-annotated post-typecheck form
-		-- because we are going to return a list of *polymorphic* values
-		-- coerced to type (). If we built a *source* stmt
-		--	return [coerce x, ..., coerce z]
-		-- then the type checker would instantiate x..z, and we wouldn't
-		-- get their *polymorphic* values.  (And we'd get ambiguity errs
-		-- if they were overloaded, since they aren't applied to anything.)
-	    mk_return ids = nlHsApp (noLoc $ TyApp (nlHsVar ret_id) [ret_ty]) 
-			 	    (noLoc $ ExplicitList unitTy (map mk_item ids)) ;
-	    mk_item id = nlHsApp (noLoc $ TyApp (nlHsVar unsafeCoerceId) [idType id, unitTy])
-		    	         (nlHsVar id) 
-	 } ;
-
-	-- OK, we're ready to typecheck the stmts
-	traceTc (text "tcs 2") ;
-	((tc_stmts, ids), lie) <- getLIE $ 
-				  tcStmts DoExpr (tcDoStmt io_ty) stmts io_ret_ty $ \ _ ->
-				  mappM tcLookupId names ;
-					-- Look up the names right in the middle,
-					-- where they will all be in scope
-
-	-- Simplify the context
-	const_binds <- checkNoErrs (tcSimplifyInteractive lie) ;
-		-- checkNoErrs ensures that the plan fails if context redn fails
-
-	return (ids, mkHsDictLet const_binds $
-		     noLoc (HsDo DoExpr tc_stmts (mk_return ids) io_ret_ty))
-    }
-\end{code}
-
-
-tcRnExpr just finds the type of an expression
-
-\begin{code}
-tcRnExpr :: HscEnv
-	 -> InteractiveContext
-	 -> LHsExpr RdrName
-	 -> IO (Maybe Type)
-tcRnExpr hsc_env ictxt rdr_expr
-  = initTcPrintErrors hsc_env iNTERACTIVE $ 
-    setInteractiveContext hsc_env ictxt $ do {
-
-    (rn_expr, fvs) <- rnLExpr rdr_expr ;
-    failIfErrsM ;
-
-	-- Now typecheck the expression; 
-	-- it might have a rank-2 type (e.g. :t runST)
-    ((tc_expr, res_ty), lie)	   <- getLIE (tcInferRho rn_expr) ;
-    ((qtvs, _, dict_ids), lie_top) <- getLIE (tcSimplifyInfer smpl_doc (tyVarsOfType res_ty) lie)  ;
-    tcSimplifyInteractive lie_top ;
-    qtvs' <- mappM zonkQuantifiedTyVar qtvs ;
-
-    let { all_expr_ty = mkForAllTys qtvs' $
-    		        mkFunTys (map idType dict_ids)	$
-    		        res_ty } ;
-    zonkTcType all_expr_ty
-    }
-  where
-    smpl_doc = ptext SLIT("main expression")
-\end{code}
-
-tcRnType just finds the kind of a type
-
-\begin{code}
-tcRnType :: HscEnv
-	 -> InteractiveContext
-	 -> LHsType RdrName
-	 -> IO (Maybe Kind)
-tcRnType hsc_env ictxt rdr_type
-  = initTcPrintErrors hsc_env iNTERACTIVE $ 
-    setInteractiveContext hsc_env ictxt $ do {
-
-    rn_type <- rnLHsType doc rdr_type ;
-    failIfErrsM ;
-
-	-- Now kind-check the type
-    (ty', kind) <- kcHsType rn_type ;
-    return kind
-    }
-  where
-    doc = ptext SLIT("In GHCi input")
-
-#endif /* GHCi */
-\end{code}
-
-
-%************************************************************************
-%*									*
-	More GHCi stuff, to do with browsing and getting info
-%*									*
-%************************************************************************
-
-\begin{code}
-#ifdef GHCI
--- ASSUMES that the module is either in the HomePackageTable or is
--- a package module with an interface on disk.  If neither of these is
--- true, then the result will be an error indicating the interface
--- could not be found.
-getModuleExports :: HscEnv -> Module -> IO (Messages, Maybe NameSet)
-getModuleExports hsc_env mod
-  = initTc hsc_env HsSrcFile iNTERACTIVE (tcGetModuleExports mod)
-
-tcGetModuleExports :: Module -> TcM NameSet
-tcGetModuleExports mod = do
-  iface <- load_iface mod
-  loadOrphanModules (dep_orphs (mi_deps iface))
-  		-- Load any orphan-module interfaces,
-  		-- so their instances are visible
-  ifaceExportNames (mi_exports iface)
-
-load_iface mod = loadSrcInterface doc mod False {- Not boot iface -}
-	       where
-		 doc = ptext SLIT("context for compiling statements")
-
-
-tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Maybe [Name])
-tcRnLookupRdrName hsc_env rdr_name 
-  = initTcPrintErrors hsc_env iNTERACTIVE $ 
-    setInteractiveContext hsc_env (hsc_IC hsc_env) $ 
-    lookup_rdr_name rdr_name
-
-lookup_rdr_name rdr_name = do {
-	-- If the identifier is a constructor (begins with an
-	-- upper-case letter), then we need to consider both
-	-- constructor and type class identifiers.
-    let { rdr_names = dataTcOccs rdr_name } ;
-
-	-- results :: [Either Messages Name]
-    results <- mapM (tryTcErrs . lookupOccRn) rdr_names ;
-
-    traceRn (text "xx" <+> vcat [ppr rdr_names, ppr (map snd results)]);
-	-- The successful lookups will be (Just name)
-    let { (warns_s, good_names) = unzip [ (msgs, name) 
-					| (msgs, Just name) <- results] ;
-	  errs_s = [msgs | (msgs, Nothing) <- results] } ;
-
-	-- Fail if nothing good happened, else add warnings
-    if null good_names then
-		-- No lookup succeeded, so
-		-- pick the first error message and report it
-		-- ToDo: If one of the errors is "could be Foo.X or Baz.X",
-		--	 while the other is "X is not in scope", 
-		--	 we definitely want the former; but we might pick the latter
-	do { addMessages (head errs_s) ; failM }
-      else 			-- Add deprecation warnings
-	mapM_ addMessages warns_s ;
-    
-    return good_names
- }
-
-
-tcRnLookupName :: HscEnv -> Name -> IO (Maybe TyThing)
-tcRnLookupName hsc_env name
-  = initTcPrintErrors hsc_env iNTERACTIVE $ 
-    setInteractiveContext hsc_env (hsc_IC hsc_env) $
-    tcLookupGlobal name
-
-
-tcRnGetInfo :: HscEnv
-	    -> Name
-	    -> IO (Maybe (TyThing, Fixity, [Instance]))
-
--- Used to implemnent :info in GHCi
---
--- Look up a RdrName and return all the TyThings it might be
--- A capitalised RdrName is given to us in the DataName namespace,
--- but we want to treat it as *both* a data constructor 
---  *and* as a type or class constructor; 
--- hence the call to dataTcOccs, and we return up to two results
-tcRnGetInfo hsc_env name
-  = initTcPrintErrors hsc_env iNTERACTIVE $ 
-    let ictxt = hsc_IC hsc_env in
-    setInteractiveContext hsc_env ictxt $ do
-
-	-- Load the interface for all unqualified types and classes
-	-- That way we will find all the instance declarations
-	-- (Packages have not orphan modules, and we assume that
-	--  in the home package all relevant modules are loaded.)
-    loadUnqualIfaces ictxt
-
-    thing  <- tcLookupGlobal name
-    fixity <- lookupFixityRn name
-    ispecs <- lookupInsts (icPrintUnqual ictxt) thing
-    return (thing, fixity, ispecs)
-
-
-lookupInsts :: PrintUnqualified -> TyThing -> TcM [Instance]
--- Filter the instances by the ones whose tycons (or clases resp) 
--- are in scope unqualified.  Otherwise we list a whole lot too many!
-lookupInsts print_unqual (AClass cls)
-  = do	{ inst_envs <- tcGetInstEnvs
-	; return [ ispec
-		 | ispec <- classInstances inst_envs cls
-		 , plausibleDFun print_unqual (instanceDFunId ispec) ] }
-
-lookupInsts print_unqual (ATyCon tc)
-  = do 	{ eps <- getEps	-- Load all instances for all classes that are
-			-- in the type environment (which are all the ones
-			-- we've seen in any interface file so far)
-	; (pkg_ie, home_ie) <- tcGetInstEnvs	-- Search all
-	; return [ ispec
-		 | ispec <- instEnvElts home_ie ++ instEnvElts pkg_ie
-		 , let dfun = instanceDFunId ispec
-		 , relevant dfun
-		 , plausibleDFun print_unqual dfun ] }
-  where
-    relevant df = tc_name `elemNameSet` tyClsNamesOfDFunHead (idType df)
-    tc_name     = tyConName tc		  
-
-lookupInsts print_unqual other = return []
-
-plausibleDFun print_unqual dfun	-- Dfun involving only names that print unqualified
-  = all ok (nameSetToList (tyClsNamesOfType (idType dfun)))
-  where
-    ok name | isBuiltInSyntax name = True
-	    | isExternalName name  = print_unqual (nameModule name) (nameOccName name)
-	    | otherwise		   = True
-
-loadUnqualIfaces :: InteractiveContext -> TcM ()
--- Load the home module for everything that is in scope unqualified
--- This is so that we can accurately report the instances for 
--- something
-loadUnqualIfaces ictxt
-  = initIfaceTcRn $
-    mapM_ (loadSysInterface doc) (moduleSetElts (mkModuleSet unqual_mods))
-  where
-    unqual_mods = [ nameModule name
-		  | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt),
-		    let name = gre_name gre,
-                    not (isInternalName name),
-		    isTcOcc (nameOccName name),  -- Types and classes only
-		    unQualOK gre ]		 -- In scope unqualified
-    doc = ptext SLIT("Need interface for module whose export(s) are in scope unqualified")
-#endif /* GHCI */
-\end{code}
-
-%************************************************************************
-%*									*
-		Degugging output
-%*									*
-%************************************************************************
-
-\begin{code}
-rnDump :: SDoc -> TcRn ()
--- Dump, with a banner, if -ddump-rn
-rnDump doc = do { dumpOptTcRn Opt_D_dump_rn (mkDumpDoc "Renamer" doc) }
-
-tcDump :: TcGblEnv -> TcRn ()
-tcDump env
- = do { dflags <- getDOpts ;
-
-	-- Dump short output if -ddump-types or -ddump-tc
-	ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
-	    (dumpTcRn short_dump) ;
-
-	-- Dump bindings if -ddump-tc
-	dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump)
-   }
-  where
-    short_dump = pprTcGblEnv env
-    full_dump  = pprLHsBinds (tcg_binds env)
-	-- NB: foreign x-d's have undefined's in their types; 
-	--     hence can't show the tc_fords
-
-tcCoreDump mod_guts
- = do { dflags <- getDOpts ;
-	ifM (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
- 	    (dumpTcRn (pprModGuts mod_guts)) ;
-
-	-- Dump bindings if -ddump-tc
-	dumpOptTcRn Opt_D_dump_tc (mkDumpDoc "Typechecker" full_dump) }
-  where
-    full_dump = pprCoreBindings (mg_binds mod_guts)
-
--- It's unpleasant having both pprModGuts and pprModDetails here
-pprTcGblEnv :: TcGblEnv -> SDoc
-pprTcGblEnv (TcGblEnv { tcg_type_env = type_env, 
-		        tcg_insts    = dfun_ids, 
-		        tcg_rules    = rules,
-			tcg_imports  = imports })
-  = vcat [ ppr_types dfun_ids type_env
-	 , ppr_insts dfun_ids
-	 , vcat (map ppr rules)
-	 , ppr_gen_tycons (typeEnvTyCons type_env)
-	 , ptext SLIT("Dependent modules:") <+> ppr (moduleEnvElts (imp_dep_mods imports))
-	 , ptext SLIT("Dependent packages:") <+> ppr (imp_dep_pkgs imports)]
-
-pprModGuts :: ModGuts -> SDoc
-pprModGuts (ModGuts { mg_types = type_env,
-		      mg_rules = rules })
-  = vcat [ ppr_types [] type_env,
-	   ppr_rules rules ]
-
-
-ppr_types :: [Instance] -> TypeEnv -> SDoc
-ppr_types ispecs type_env
-  = text "TYPE SIGNATURES" $$ nest 4 (ppr_sigs ids)
-  where
-    dfun_ids = map instanceDFunId ispecs
-    ids = [id | id <- typeEnvIds type_env, want_sig id]
-    want_sig id | opt_PprStyle_Debug = True
-	        | otherwise	     = isLocalId id && 
-				       isExternalName (idName id) && 
-				       not (id `elem` dfun_ids)
-	-- isLocalId ignores data constructors, records selectors etc.
-	-- The isExternalName ignores local dictionary and method bindings
-	-- that the type checker has invented.  Top-level user-defined things 
-	-- have External names.
-
-ppr_insts :: [Instance] -> SDoc
-ppr_insts []     = empty
-ppr_insts ispecs = text "INSTANCES" $$ nest 2 (pprInstances ispecs)
-
-ppr_sigs :: [Var] -> SDoc
-ppr_sigs ids
-	-- Print type signatures; sort by OccName 
-  = vcat (map ppr_sig (sortLe le_sig ids))
-  where
-    le_sig id1 id2 = getOccName id1 <= getOccName id2
-    ppr_sig id = ppr id <+> dcolon <+> ppr (tidyTopType (idType id))
-
-ppr_rules :: [CoreRule] -> SDoc
-ppr_rules [] = empty
-ppr_rules rs = vcat [ptext SLIT("{-# RULES"),
-		      nest 4 (pprRules rs),
-		      ptext SLIT("#-}")]
-
-ppr_gen_tycons []  = empty
-ppr_gen_tycons tcs = vcat [ptext SLIT("Tycons with generics:"),
-			   nest 2 (fsep (map ppr (filter tyConHasGenerics tcs)))]
-\end{code}
diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs
deleted file mode 100644
index ff1979bc06..0000000000
--- a/ghc/compiler/typecheck/TcRnMonad.lhs
+++ /dev/null
@@ -1,1042 +0,0 @@
-\begin{code}
-module TcRnMonad(
-	module TcRnMonad,
-	module TcRnTypes,
-	module IOEnv
-  ) where
-
-#include "HsVersions.h"
-
-import TcRnTypes	-- Re-export all
-import IOEnv		-- Re-export all
-
-#if defined(GHCI) && defined(BREAKPOINT)
-import TypeRep          ( Type(..), liftedTypeKind, TyThing(..) )
-import Var              ( mkTyVar, mkGlobalId )
-import IdInfo           ( GlobalIdDetails(..), vanillaIdInfo )
-import OccName          ( mkOccName, tvName )
-import SrcLoc           ( noSrcLoc  )
-import TysWiredIn       ( intTy, stringTy, mkListTy, unitTy )
-import PrelNames        ( breakpointJumpName )
-import NameEnv          ( mkNameEnv )
-#endif
-
-import HsSyn		( emptyLHsBinds )
-import HscTypes		( HscEnv(..), ModGuts(..), ModIface(..),
-			  TyThing, TypeEnv, emptyTypeEnv, HscSource(..),
-			  isHsBoot, ModSummary(..),
-			  ExternalPackageState(..), HomePackageTable,
-			  Deprecs(..), FixityEnv, FixItem, 
-			  lookupType, unQualInScope )
-import Module		( Module, unitModuleEnv )
-import RdrName		( GlobalRdrEnv, emptyGlobalRdrEnv, 	
-			  LocalRdrEnv, emptyLocalRdrEnv )
-import Name		( Name, isInternalName, mkInternalName, tidyNameOcc, nameOccName, getSrcLoc )
-import Type		( Type )
-import TcType		( tcIsTyVarTy, tcGetTyVar )
-import NameEnv		( extendNameEnvList, nameEnvElts )
-import InstEnv		( emptyInstEnv )
-
-import Var		( setTyVarName )
-import VarSet		( emptyVarSet )
-import VarEnv		( TidyEnv, emptyTidyEnv, extendVarEnv )
-import ErrUtils		( Message, Messages, emptyMessages, errorsFound, 
-			  mkWarnMsg, printErrorsAndWarnings,
-			  mkLocMessage, mkLongErrMsg )
-import Packages		( mkHomeModules )
-import SrcLoc		( mkGeneralSrcSpan, isGoodSrcSpan, SrcSpan, Located(..) )
-import NameEnv		( emptyNameEnv )
-import NameSet		( NameSet, emptyDUs, emptyNameSet, unionNameSets, addOneToNameSet )
-import OccName		( emptyOccEnv, tidyOccName )
-import Bag		( emptyBag )
-import Outputable
-import UniqSupply	( UniqSupply, mkSplitUniqSupply, uniqFromSupply, splitUniqSupply )
-import Unique		( Unique )
-import DynFlags		( DynFlags(..), DynFlag(..), dopt, dopt_set, GhcMode )
-import StaticFlags	( opt_PprStyle_Debug )
-import Bag		( snocBag, unionBags )
-import Panic		( showException )
- 
-import IO		( stderr )
-import DATA_IOREF	( newIORef, readIORef )
-import EXCEPTION	( Exception )
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-			initTc
-%*									*
-%************************************************************************
-
-\begin{code}
-ioToTcRn :: IO r -> TcRn r
-ioToTcRn = ioToIOEnv
-\end{code}
-
-\begin{code}
-initTc :: HscEnv
-       -> HscSource
-       -> Module 
-       -> TcM r
-       -> IO (Messages, Maybe r)
-		-- Nothing => error thrown by the thing inside
-		-- (error messages should have been printed already)
-
-initTc hsc_env hsc_src mod do_this
- = do { errs_var     <- newIORef (emptyBag, emptyBag) ;
-      	tvs_var      <- newIORef emptyVarSet ;
-	type_env_var <- newIORef emptyNameEnv ;
-	dfuns_var    <- newIORef emptyNameSet ;
-	keep_var     <- newIORef emptyNameSet ;
-	th_var	     <- newIORef False ;
-	dfun_n_var   <- newIORef 1 ;
-      	let {
-	     gbl_env = TcGblEnv {
-		tcg_mod      = mod,
-		tcg_src	     = hsc_src,
-		tcg_rdr_env  = emptyGlobalRdrEnv,
-		tcg_fix_env  = emptyNameEnv,
-		tcg_default  = Nothing,
-		tcg_type_env = emptyNameEnv,
-		tcg_type_env_var = type_env_var,
-		tcg_inst_env  = emptyInstEnv,
-		tcg_inst_uses = dfuns_var,
-		tcg_th_used   = th_var,
-		tcg_exports  = emptyNameSet,
-		tcg_imports  = init_imports,
-		tcg_home_mods = home_mods,
-		tcg_dus      = emptyDUs,
-                tcg_rn_imports = Nothing,
-                tcg_rn_exports = Nothing,
-		tcg_rn_decls = Nothing,
-		tcg_binds    = emptyLHsBinds,
-		tcg_deprecs  = NoDeprecs,
-		tcg_insts    = [],
-		tcg_rules    = [],
-		tcg_fords    = [],
-		tcg_dfun_n   = dfun_n_var,
-		tcg_keep     = keep_var
-	     } ;
-	     lcl_env = TcLclEnv {
-		tcl_errs       = errs_var,
-		tcl_loc	       = mkGeneralSrcSpan FSLIT("Top level"),
-		tcl_ctxt       = [],
-		tcl_rdr	       = emptyLocalRdrEnv,
-		tcl_th_ctxt    = topStage,
-		tcl_arrow_ctxt = NoArrowCtxt,
-		tcl_env        = emptyNameEnv,
-		tcl_tyvars     = tvs_var,
-		tcl_lie	       = panic "initTc:LIE"	-- LIE only valid inside a getLIE
-	     } ;
-	} ;
-   
-	-- OK, here's the business end!
-	maybe_res <- initTcRnIf 'a' hsc_env gbl_env lcl_env $
-		     do {
-#if defined(GHCI) && defined(BREAKPOINT)
-                          unique <- newUnique ;
-                          let { var = mkInternalName unique (mkOccName tvName "a") noSrcLoc;
-                                tyvar = mkTyVar var liftedTypeKind;
-                                breakpointJumpType = mkGlobalId
-                                                     (VanillaGlobal)
-                                                     (breakpointJumpName)
-                                                     (FunTy intTy
-                                                      (FunTy (mkListTy unitTy)
-                                                       (FunTy stringTy
-                                                        (ForAllTy tyvar
-                                                         (FunTy (TyVarTy tyvar)
-                                                          (TyVarTy tyvar))))))
-                                                     (vanillaIdInfo);
-                                new_env = mkNameEnv [(breakpointJumpName,AGlobal (AnId breakpointJumpType))];
-                              };
-                          r <- tryM (updLclEnv (\gbl -> gbl{tcl_env=new_env}) do_this)
-#else
-                          r <- tryM do_this
-#endif
-			; case r of
-			  Right res -> return (Just res)
-			  Left _    -> return Nothing } ;
-
-	-- Collect any error messages
-	msgs <- readIORef errs_var ;
-
-	let { dflags = hsc_dflags hsc_env
-	    ; final_res | errorsFound dflags msgs = Nothing
-			| otherwise	   	  = maybe_res } ;
-
-	return (msgs, final_res)
-    }
-  where
-    home_mods = mkHomeModules (map ms_mod (hsc_mod_graph hsc_env))
-	-- A guess at the home modules.  This will be correct in
-	-- --make and GHCi modes, but in one-shot mode we need to 
-	-- fix it up after we know the real dependencies of the current
-	-- module (see tcRnModule).
-	-- Setting it here is necessary for the typechecker entry points
-	-- other than tcRnModule: tcRnGetInfo, for example.  These are
-	-- all called via the GHC module, so hsc_mod_graph will contain
-	-- something sensible.
-
-    init_imports = emptyImportAvails {imp_env = unitModuleEnv mod emptyNameSet}
-	-- Initialise tcg_imports with an empty set of bindings for
-	-- this module, so that if we see 'module M' in the export
-	-- list, and there are no bindings in M, we don't bleat 
-	-- "unknown module M".
-
-initTcPrintErrors	-- Used from the interactive loop only
-       :: HscEnv
-       -> Module 
-       -> TcM r
-       -> IO (Maybe r)
-initTcPrintErrors env mod todo = do
-  (msgs, res) <- initTc env HsSrcFile mod todo
-  printErrorsAndWarnings (hsc_dflags env) msgs
-  return res
-
--- mkImpTypeEnv makes the imported symbol table
-mkImpTypeEnv :: ExternalPackageState -> HomePackageTable
- 	     -> Name -> Maybe TyThing
-mkImpTypeEnv pcs hpt = lookup 
-  where
-    pte = eps_PTE pcs
-    lookup name | isInternalName name = Nothing
-	        | otherwise	      = lookupType hpt pte name
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Initialisation
-%*									*
-%************************************************************************
-
-
-\begin{code}
-initTcRnIf :: Char		-- Tag for unique supply
-	   -> HscEnv
-	   -> gbl -> lcl 
-	   -> TcRnIf gbl lcl a 
-	   -> IO a
-initTcRnIf uniq_tag hsc_env gbl_env lcl_env thing_inside
-   = do	{ us     <- mkSplitUniqSupply uniq_tag ;
-	; us_var <- newIORef us ;
-
-	; let { env = Env { env_top = hsc_env,
-			    env_us  = us_var,
-			    env_gbl = gbl_env,
-			    env_lcl = lcl_env } }
-
-	; runIOEnv env thing_inside
-	}
-\end{code}
-
-%************************************************************************
-%*									*
-		Simple accessors
-%*									*
-%************************************************************************
-
-\begin{code}
-getTopEnv :: TcRnIf gbl lcl HscEnv
-getTopEnv = do { env <- getEnv; return (env_top env) }
-
-getGblEnv :: TcRnIf gbl lcl gbl
-getGblEnv = do { env <- getEnv; return (env_gbl env) }
-
-updGblEnv :: (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
-updGblEnv upd = updEnv (\ env@(Env { env_gbl = gbl }) -> 
-			  env { env_gbl = upd gbl })
-
-setGblEnv :: gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
-setGblEnv gbl_env = updEnv (\ env -> env { env_gbl = gbl_env })
-
-getLclEnv :: TcRnIf gbl lcl lcl
-getLclEnv = do { env <- getEnv; return (env_lcl env) }
-
-updLclEnv :: (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
-updLclEnv upd = updEnv (\ env@(Env { env_lcl = lcl }) -> 
-			  env { env_lcl = upd lcl })
-
-setLclEnv :: lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
-setLclEnv lcl_env = updEnv (\ env -> env { env_lcl = lcl_env })
-
-getEnvs :: TcRnIf gbl lcl (gbl, lcl)
-getEnvs = do { env <- getEnv; return (env_gbl env, env_lcl env) }
-
-setEnvs :: (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
-setEnvs (gbl_env, lcl_env) = updEnv (\ env -> env { env_gbl = gbl_env, env_lcl = lcl_env })
-\end{code}
-
-
-Command-line flags
-
-\begin{code}
-getDOpts :: TcRnIf gbl lcl DynFlags
-getDOpts = do { env <- getTopEnv; return (hsc_dflags env) }
-
-doptM :: DynFlag -> TcRnIf gbl lcl Bool
-doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) }
-
-setOptM :: DynFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
-setOptM flag = updEnv (\ env@(Env { env_top = top }) ->
-			 env { env_top = top { hsc_dflags = dopt_set (hsc_dflags top) flag}} )
-
-ifOptM :: DynFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()	-- Do it flag is true
-ifOptM flag thing_inside = do { b <- doptM flag; 
-				if b then thing_inside else return () }
-
-getGhcMode :: TcRnIf gbl lcl GhcMode
-getGhcMode = do { env <- getTopEnv; return (ghcMode (hsc_dflags env)) }
-\end{code}
-
-\begin{code}
-getEpsVar :: TcRnIf gbl lcl (TcRef ExternalPackageState)
-getEpsVar = do { env <- getTopEnv; return (hsc_EPS env) }
-
-getEps :: TcRnIf gbl lcl ExternalPackageState
-getEps = do { env <- getTopEnv; readMutVar (hsc_EPS env) }
-
--- Updating the EPS.  This should be an atomic operation.
--- Note the delicate 'seq' which forces the EPS before putting it in the
--- variable.  Otherwise what happens is that we get
---	write eps_var (....(unsafeRead eps_var)....)
--- and if the .... is strict, that's obviously bottom.  By forcing it beforehand
--- we make the unsafeRead happen before we update the variable.
-
-updateEps :: (ExternalPackageState -> (ExternalPackageState, a))
-	  -> TcRnIf gbl lcl a
-updateEps upd_fn = do	{ traceIf (text "updating EPS")
-			; eps_var <- getEpsVar
-			; eps <- readMutVar eps_var
-			; let { (eps', val) = upd_fn eps }
-			; seq eps' (writeMutVar eps_var eps')
-			; return val }
-
-updateEps_ :: (ExternalPackageState -> ExternalPackageState)
-	   -> TcRnIf gbl lcl ()
-updateEps_ upd_fn = do	{ traceIf (text "updating EPS_")
-			; eps_var <- getEpsVar
-			; eps <- readMutVar eps_var
-			; let { eps' = upd_fn eps }
-			; seq eps' (writeMutVar eps_var eps') }
-
-getHpt :: TcRnIf gbl lcl HomePackageTable
-getHpt = do { env <- getTopEnv; return (hsc_HPT env) }
-
-getEpsAndHpt :: TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
-getEpsAndHpt = do { env <- getTopEnv; eps <- readMutVar (hsc_EPS env)
-		  ; return (eps, hsc_HPT env) }
-\end{code}
-
-%************************************************************************
-%*									*
-		Unique supply
-%*									*
-%************************************************************************
-
-\begin{code}
-newUnique :: TcRnIf gbl lcl Unique
-newUnique = do { us <- newUniqueSupply ; 
-		 return (uniqFromSupply us) }
-
-newUniqueSupply :: TcRnIf gbl lcl UniqSupply
-newUniqueSupply
- = do { env <- getEnv ;
-	let { u_var = env_us env } ;
-	us <- readMutVar u_var ;
-    	let { (us1, us2) = splitUniqSupply us } ;
-	writeMutVar u_var us1 ;
-	return us2 }
-
-newLocalName :: Name -> TcRnIf gbl lcl Name
-newLocalName name	-- Make a clone
-  = newUnique		`thenM` \ uniq ->
-    returnM (mkInternalName uniq (nameOccName name) (getSrcLoc name))
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Debugging
-%*									*
-%************************************************************************
-
-\begin{code}
-traceTc, traceRn :: SDoc -> TcRn ()
-traceRn      = traceOptTcRn Opt_D_dump_rn_trace
-traceTc      = traceOptTcRn Opt_D_dump_tc_trace
-traceSplice  = traceOptTcRn Opt_D_dump_splices
-
-
-traceIf :: SDoc -> TcRnIf m n ()	
-traceIf      = traceOptIf Opt_D_dump_if_trace
-traceHiDiffs = traceOptIf Opt_D_dump_hi_diffs
-
-
-traceOptIf :: DynFlag -> SDoc -> TcRnIf m n ()  -- No RdrEnv available, so qualify everything
-traceOptIf flag doc = ifOptM flag $
-		     ioToIOEnv (printForUser stderr alwaysQualify doc)
-
-traceOptTcRn :: DynFlag -> SDoc -> TcRn ()
-traceOptTcRn flag doc = ifOptM flag $ do
-			{ ctxt <- getErrCtxt
-			; loc  <- getSrcSpanM
-			; env0 <- tcInitTidyEnv
-			; ctxt_msgs <- do_ctxt env0 ctxt 
-			; let real_doc = mkLocMessage loc (vcat (doc : ctxt_to_use ctxt_msgs))
-			; dumpTcRn real_doc }
-
-dumpTcRn :: SDoc -> TcRn ()
-dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv ;
-		    ioToTcRn (printForUser stderr (unQualInScope rdr_env) doc) }
-
-dumpOptTcRn :: DynFlag -> SDoc -> TcRn ()
-dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc)
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Typechecker global environment
-%*									*
-%************************************************************************
-
-\begin{code}
-getModule :: TcRn Module
-getModule = do { env <- getGblEnv; return (tcg_mod env) }
-
-setModule :: Module -> TcRn a -> TcRn a
-setModule mod thing_inside = updGblEnv (\env -> env { tcg_mod = mod }) thing_inside
-
-tcIsHsBoot :: TcRn Bool
-tcIsHsBoot = do { env <- getGblEnv; return (isHsBoot (tcg_src env)) }
-
-getGlobalRdrEnv :: TcRn GlobalRdrEnv
-getGlobalRdrEnv = do { env <- getGblEnv; return (tcg_rdr_env env) }
-
-getImports :: TcRn ImportAvails
-getImports = do { env <- getGblEnv; return (tcg_imports env) }
-
-getFixityEnv :: TcRn FixityEnv
-getFixityEnv = do { env <- getGblEnv; return (tcg_fix_env env) }
-
-extendFixityEnv :: [(Name,FixItem)] -> RnM a -> RnM a
-extendFixityEnv new_bit
-  = updGblEnv (\env@(TcGblEnv { tcg_fix_env = old_fix_env }) -> 
-		env {tcg_fix_env = extendNameEnvList old_fix_env new_bit})	     
-
-getDefaultTys :: TcRn (Maybe [Type])
-getDefaultTys = do { env <- getGblEnv; return (tcg_default env) }
-\end{code}
-
-%************************************************************************
-%*									*
-		Error management
-%*									*
-%************************************************************************
-
-\begin{code}
-getSrcSpanM :: TcRn SrcSpan
-	-- Avoid clash with Name.getSrcLoc
-getSrcSpanM = do { env <- getLclEnv; return (tcl_loc env) }
-
-setSrcSpan :: SrcSpan -> TcRn a -> TcRn a
-setSrcSpan loc thing_inside
-  | isGoodSrcSpan loc = updLclEnv (\env -> env { tcl_loc = loc }) thing_inside
-  | otherwise	      = thing_inside	-- Don't overwrite useful info with useless
-
-addLocM :: (a -> TcM b) -> Located a -> TcM b
-addLocM fn (L loc a) = setSrcSpan loc $ fn a
-
-wrapLocM :: (a -> TcM b) -> Located a -> TcM (Located b)
-wrapLocM fn (L loc a) = setSrcSpan loc $ do b <- fn a; return (L loc b)
-
-wrapLocFstM :: (a -> TcM (b,c)) -> Located a -> TcM (Located b, c)
-wrapLocFstM fn (L loc a) =
-  setSrcSpan loc $ do
-    (b,c) <- fn a
-    return (L loc b, c)
-
-wrapLocSndM :: (a -> TcM (b,c)) -> Located a -> TcM (b, Located c)
-wrapLocSndM fn (L loc a) =
-  setSrcSpan loc $ do
-    (b,c) <- fn a
-    return (b, L loc c)
-\end{code}
-
-
-\begin{code}
-getErrsVar :: TcRn (TcRef Messages)
-getErrsVar = do { env <- getLclEnv; return (tcl_errs env) }
-
-setErrsVar :: TcRef Messages -> TcRn a -> TcRn a
-setErrsVar v = updLclEnv (\ env -> env { tcl_errs =  v })
-
-addErr :: Message -> TcRn ()
-addErr msg = do { loc <- getSrcSpanM ; addErrAt loc msg }
-
-addLocErr :: Located e -> (e -> Message) -> TcRn ()
-addLocErr (L loc e) fn = addErrAt loc (fn e)
-
-addErrAt :: SrcSpan -> Message -> TcRn ()
-addErrAt loc msg = addLongErrAt loc msg empty
-
-addLongErrAt :: SrcSpan -> Message -> Message -> TcRn ()
-addLongErrAt loc msg extra
-  = do { traceTc (ptext SLIT("Adding error:") <+> (mkLocMessage loc (msg $$ extra))) ;	
-	 errs_var <- getErrsVar ;
-	 rdr_env <- getGlobalRdrEnv ;
-	 let { err = mkLongErrMsg loc (unQualInScope rdr_env) msg extra } ;
-	 (warns, errs) <- readMutVar errs_var ;
-  	 writeMutVar errs_var (warns, errs `snocBag` err) }
-
-addErrs :: [(SrcSpan,Message)] -> TcRn ()
-addErrs msgs = mappM_ add msgs
-	     where
-	       add (loc,msg) = addErrAt loc msg
-
-addReport :: Message -> TcRn ()
-addReport msg = do loc <- getSrcSpanM; addReportAt loc msg
-
-addReportAt :: SrcSpan -> Message -> TcRn ()
-addReportAt loc msg
-  = do { errs_var <- getErrsVar ;
-	 rdr_env <- getGlobalRdrEnv ;
-	 let { warn = mkWarnMsg loc (unQualInScope rdr_env) msg } ;
-	 (warns, errs) <- readMutVar errs_var ;
-  	 writeMutVar errs_var (warns `snocBag` warn, errs) }
-
-addWarn :: Message -> TcRn ()
-addWarn msg = addReport (ptext SLIT("Warning:") <+> msg)
-
-addWarnAt :: SrcSpan -> Message -> TcRn ()
-addWarnAt loc msg = addReportAt loc (ptext SLIT("Warning:") <+> msg)
-
-addLocWarn :: Located e -> (e -> Message) -> TcRn ()
-addLocWarn (L loc e) fn = addReportAt loc (fn e)
-
-checkErr :: Bool -> Message -> TcRn ()
--- Add the error if the bool is False
-checkErr ok msg = checkM ok (addErr msg)
-
-warnIf :: Bool -> Message -> TcRn ()
-warnIf True  msg = addWarn msg
-warnIf False msg = return ()
-
-addMessages :: Messages -> TcRn ()
-addMessages (m_warns, m_errs)
-  = do { errs_var <- getErrsVar ;
-	 (warns, errs) <- readMutVar errs_var ;
-  	 writeMutVar errs_var (warns `unionBags` m_warns,
-			       errs  `unionBags` m_errs) }
-
-discardWarnings :: TcRn a -> TcRn a
--- Ignore warnings inside the thing inside;
--- used to ignore-unused-variable warnings inside derived code
--- With -dppr-debug, the effects is switched off, so you can still see
--- what warnings derived code would give
-discardWarnings thing_inside
-  | opt_PprStyle_Debug = thing_inside
-  | otherwise
-  = do	{ errs_var <- newMutVar emptyMessages
-	; result <- setErrsVar errs_var thing_inside
-	; (_warns, errs) <- readMutVar errs_var
-	; addMessages (emptyBag, errs)
-	; return result }
-\end{code}
-
-
-\begin{code}
-try_m :: TcRn r -> TcRn (Either Exception r)
--- Does try_m, with a debug-trace on failure
-try_m thing 
-  = do { mb_r <- tryM thing ;
-	 case mb_r of 
-	     Left exn -> do { traceTc (exn_msg exn); return mb_r }
-	     Right r  -> return mb_r }
-  where
-    exn_msg exn = text "tryTc/recoverM recovering from" <+> text (showException exn)
-
------------------------
-recoverM :: TcRn r 	-- Recovery action; do this if the main one fails
-	 -> TcRn r	-- Main action: do this first
-	 -> TcRn r
--- Errors in 'thing' are retained
-recoverM recover thing 
-  = do { mb_res <- try_m thing ;
-	 case mb_res of
-	   Left exn  -> recover
-	   Right res -> returnM res }
-
------------------------
-tryTc :: TcRn a -> TcRn (Messages, Maybe a)
--- (tryTc m) executes m, and returns
---	Just r,  if m succeeds (returning r)
---	Nothing, if m fails
--- It also returns all the errors and warnings accumulated by m
--- It always succeeds (never raises an exception)
-tryTc m 
- = do {	errs_var <- newMutVar emptyMessages ;
-	res  <- try_m (setErrsVar errs_var m) ; 
-	msgs <- readMutVar errs_var ;
-	return (msgs, case res of
-			    Left exn  -> Nothing
-			    Right val -> Just val)
-	-- The exception is always the IOEnv built-in
-	-- in exception; see IOEnv.failM
-   }
-
------------------------
-tryTcErrs :: TcRn a -> TcRn (Messages, Maybe a)
--- Run the thing, returning 
---	Just r,  if m succceeds with no error messages
---	Nothing, if m fails, or if it succeeds but has error messages
--- Either way, the messages are returned; even in the Just case
--- there might be warnings
-tryTcErrs thing 
-  = do  { (msgs, res) <- tryTc thing
-	; dflags <- getDOpts
-	; let errs_found = errorsFound dflags msgs
-	; return (msgs, case res of
-			  Nothing -> Nothing
-			  Just val | errs_found -> Nothing
-			 	   | otherwise  -> Just val)
-	}
-
------------------------
-tryTcLIE :: TcM a -> TcM (Messages, Maybe a)
--- Just like tryTcErrs, except that it ensures that the LIE
--- for the thing is propagated only if there are no errors
--- Hence it's restricted to the type-check monad
-tryTcLIE thing_inside
-  = do  { ((msgs, mb_res), lie) <- getLIE (tryTcErrs thing_inside) ;
-	; case mb_res of
-	    Nothing  -> return (msgs, Nothing)
-	    Just val -> do { extendLIEs lie; return (msgs, Just val) }
-	}
-
------------------------
-tryTcLIE_ :: TcM r -> TcM r -> TcM r
--- (tryTcLIE_ r m) tries m; 
---	if m succeeds with no error messages, it's the answer
--- 	otherwise tryTcLIE_ drops everything from m and tries r instead.
-tryTcLIE_ recover main
-  = do	{ (msgs, mb_res) <- tryTcLIE main
-	; case mb_res of
-	     Just val -> do { addMessages msgs	-- There might be warnings
-			     ; return val }
-	     Nothing  -> recover		-- Discard all msgs
-	}
-
------------------------
-checkNoErrs :: TcM r -> TcM r
--- (checkNoErrs m) succeeds iff m succeeds and generates no errors
--- If m fails then (checkNoErrsTc m) fails.
--- If m succeeds, it checks whether m generated any errors messages
---	(it might have recovered internally)
--- 	If so, it fails too.
--- Regardless, any errors generated by m are propagated to the enclosing context.
-checkNoErrs main
-  = do	{ (msgs, mb_res) <- tryTcLIE main
-	; addMessages msgs
-	; case mb_res of
-	    Nothing   -> failM
-	    Just val -> return val
-	} 
-
-ifErrsM :: TcRn r -> TcRn r -> TcRn r
---	ifErrsM bale_out main
--- does 'bale_out' if there are errors in errors collection
--- otherwise does 'main'
-ifErrsM bale_out normal
- = do { errs_var <- getErrsVar ;
-	msgs <- readMutVar errs_var ;
-	dflags <- getDOpts ;
-	if errorsFound dflags msgs then
-	   bale_out
-	else	
-	   normal }
-
-failIfErrsM :: TcRn ()
--- Useful to avoid error cascades
-failIfErrsM = ifErrsM failM (return ())
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Context management and error message generation
-	  	    for the type checker
-%*									*
-%************************************************************************
-
-\begin{code}
-getErrCtxt :: TcM ErrCtxt
-getErrCtxt = do { env <- getLclEnv; return (tcl_ctxt env) }
-
-setErrCtxt :: ErrCtxt -> TcM a -> TcM a
-setErrCtxt ctxt = updLclEnv (\ env -> env { tcl_ctxt = ctxt })
-
-addErrCtxt :: Message -> TcM a -> TcM a
-addErrCtxt msg = addErrCtxtM (\env -> returnM (env, msg))
-
-addErrCtxtM :: (TidyEnv -> TcM (TidyEnv, Message)) -> TcM a -> TcM a
-addErrCtxtM msg = updCtxt (\ msgs -> msg : msgs)
-
--- Helper function for the above
-updCtxt :: (ErrCtxt -> ErrCtxt) -> TcM a -> TcM a
-updCtxt upd = updLclEnv (\ env@(TcLclEnv { tcl_ctxt = ctxt }) -> 
-			   env { tcl_ctxt = upd ctxt })
-
--- Conditionally add an error context
-maybeAddErrCtxt :: Maybe Message -> TcM a -> TcM a
-maybeAddErrCtxt (Just msg) thing_inside = addErrCtxt msg thing_inside
-maybeAddErrCtxt Nothing    thing_inside = thing_inside
-
-popErrCtxt :: TcM a -> TcM a
-popErrCtxt = updCtxt (\ msgs -> case msgs of { [] -> []; (m:ms) -> ms })
-
-getInstLoc :: InstOrigin -> TcM InstLoc
-getInstLoc origin
-  = do { loc <- getSrcSpanM ; env <- getLclEnv ;
-	 return (InstLoc origin loc (tcl_ctxt env)) }
-
-addInstCtxt :: InstLoc -> TcM a -> TcM a
--- Add the SrcSpan and context from the first Inst in the list
--- 	(they all have similar locations)
-addInstCtxt (InstLoc _ src_loc ctxt) thing_inside
-  = setSrcSpan src_loc (updCtxt (\ old_ctxt -> ctxt) thing_inside)
-\end{code}
-
-    The addErrTc functions add an error message, but do not cause failure.
-    The 'M' variants pass a TidyEnv that has already been used to
-    tidy up the message; we then use it to tidy the context messages
-
-\begin{code}
-addErrTc :: Message -> TcM ()
-addErrTc err_msg = do { env0 <- tcInitTidyEnv
-		      ; addErrTcM (env0, err_msg) }
-
-addErrsTc :: [Message] -> TcM ()
-addErrsTc err_msgs = mappM_ addErrTc err_msgs
-
-addErrTcM :: (TidyEnv, Message) -> TcM ()
-addErrTcM (tidy_env, err_msg)
-  = do { ctxt <- getErrCtxt ;
-	 loc  <- getSrcSpanM ;
-	 add_err_tcm tidy_env err_msg loc ctxt }
-\end{code}
-
-The failWith functions add an error message and cause failure
-
-\begin{code}
-failWithTc :: Message -> TcM a		     -- Add an error message and fail
-failWithTc err_msg 
-  = addErrTc err_msg >> failM
-
-failWithTcM :: (TidyEnv, Message) -> TcM a   -- Add an error message and fail
-failWithTcM local_and_msg
-  = addErrTcM local_and_msg >> failM
-
-checkTc :: Bool -> Message -> TcM ()	     -- Check that the boolean is true
-checkTc True  err = returnM ()
-checkTc False err = failWithTc err
-\end{code}
-
-	Warnings have no 'M' variant, nor failure
-
-\begin{code}
-addWarnTc :: Message -> TcM ()
-addWarnTc msg
- = do { ctxt <- getErrCtxt ;
-	env0 <- tcInitTidyEnv ;
-	ctxt_msgs <- do_ctxt env0 ctxt ;
-	addWarn (vcat (msg : ctxt_to_use ctxt_msgs)) }
-
-warnTc :: Bool -> Message -> TcM ()
-warnTc warn_if_true warn_msg
-  | warn_if_true = addWarnTc warn_msg
-  | otherwise	 = return ()
-\end{code}
-
------------------------------------
-	 Tidying
-
-We initialise the "tidy-env", used for tidying types before printing,
-by building a reverse map from the in-scope type variables to the
-OccName that the programmer originally used for them
-
-\begin{code}
-tcInitTidyEnv :: TcM TidyEnv
-tcInitTidyEnv
-  = do	{ lcl_env <- getLclEnv
-	; let nm_tv_prs = [ (name, tcGetTyVar "tcInitTidyEnv" ty)
-			  | ATyVar name ty <- nameEnvElts (tcl_env lcl_env)
-			  , tcIsTyVarTy ty ]
-	; return (foldl add emptyTidyEnv nm_tv_prs) }
-  where
-    add (env,subst) (name, tyvar)
-	= case tidyOccName env (nameOccName name) of
-	    (env', occ') ->  (env', extendVarEnv subst tyvar tyvar')
-		where
-		  tyvar' = setTyVarName tyvar name'
-		  name'  = tidyNameOcc name occ'
-\end{code}
-
------------------------------------
- 	Other helper functions
-
-\begin{code}
-add_err_tcm tidy_env err_msg loc ctxt
- = do { ctxt_msgs <- do_ctxt tidy_env ctxt ;
-	addLongErrAt loc err_msg (vcat (ctxt_to_use ctxt_msgs)) }
-
-do_ctxt tidy_env []
- = return []
-do_ctxt tidy_env (c:cs)
- = do {	(tidy_env', m) <- c tidy_env  ;
-	ms	       <- do_ctxt tidy_env' cs  ;
-	return (m:ms) }
-
-ctxt_to_use ctxt | opt_PprStyle_Debug = ctxt
-		 | otherwise	      = take 3 ctxt
-\end{code}
-
-debugTc is useful for monadic debugging code
-
-\begin{code}
-debugTc :: TcM () -> TcM ()
-#ifdef DEBUG
-debugTc thing = thing
-#else
-debugTc thing = return ()
-#endif
-\end{code}
-
- %************************************************************************
-%*									*
-	     Type constraints (the so-called LIE)
-%*									*
-%************************************************************************
-
-\begin{code}
-nextDFunIndex :: TcM Int	-- Get the next dfun index
-nextDFunIndex = do { env <- getGblEnv
-		   ; let dfun_n_var = tcg_dfun_n env
-		   ; n <- readMutVar dfun_n_var
-		   ; writeMutVar dfun_n_var (n+1)
-		   ; return n }
-
-getLIEVar :: TcM (TcRef LIE)
-getLIEVar = do { env <- getLclEnv; return (tcl_lie env) }
-
-setLIEVar :: TcRef LIE -> TcM a -> TcM a
-setLIEVar lie_var = updLclEnv (\ env -> env { tcl_lie = lie_var })
-
-getLIE :: TcM a -> TcM (a, [Inst])
--- (getLIE m) runs m, and returns the type constraints it generates
-getLIE thing_inside
-  = do { lie_var <- newMutVar emptyLIE ;
-	 res <- updLclEnv (\ env -> env { tcl_lie = lie_var }) 
-			  thing_inside ;
-	 lie <- readMutVar lie_var ;
-	 return (res, lieToList lie) }
-
-extendLIE :: Inst -> TcM ()
-extendLIE inst
-  = do { lie_var <- getLIEVar ;
-	 lie <- readMutVar lie_var ;
-	 writeMutVar lie_var (inst `consLIE` lie) }
-
-extendLIEs :: [Inst] -> TcM ()
-extendLIEs [] 
-  = returnM ()
-extendLIEs insts
-  = do { lie_var <- getLIEVar ;
-	 lie <- readMutVar lie_var ;
-	 writeMutVar lie_var (mkLIE insts `plusLIE` lie) }
-\end{code}
-
-\begin{code}
-setLclTypeEnv :: TcLclEnv -> TcM a -> TcM a
--- Set the local type envt, but do *not* disturb other fields,
--- notably the lie_var
-setLclTypeEnv lcl_env thing_inside
-  = updLclEnv upd thing_inside
-  where
-    upd env = env { tcl_env = tcl_env lcl_env,
-		    tcl_tyvars = tcl_tyvars lcl_env }
-\end{code}
-
-
-%************************************************************************
-%*									*
-	     Template Haskell context
-%*									*
-%************************************************************************
-
-\begin{code}
-recordThUse :: TcM ()
-recordThUse = do { env <- getGblEnv; writeMutVar (tcg_th_used env) True }
-
-keepAliveTc :: Name -> TcM ()  	-- Record the name in the keep-alive set
-keepAliveTc n = do { env <- getGblEnv; 
-		   ; updMutVar (tcg_keep env) (`addOneToNameSet` n) }
-
-keepAliveSetTc :: NameSet -> TcM ()  	-- Record the name in the keep-alive set
-keepAliveSetTc ns = do { env <- getGblEnv; 
-		       ; updMutVar (tcg_keep env) (`unionNameSets` ns) }
-
-getStage :: TcM ThStage
-getStage = do { env <- getLclEnv; return (tcl_th_ctxt env) }
-
-setStage :: ThStage -> TcM a -> TcM a 
-setStage s = updLclEnv (\ env -> env { tcl_th_ctxt = s })
-\end{code}
-
-
-%************************************************************************
-%*									*
-	     Stuff for the renamer's local env
-%*									*
-%************************************************************************
-
-\begin{code}
-getLocalRdrEnv :: RnM LocalRdrEnv
-getLocalRdrEnv = do { env <- getLclEnv; return (tcl_rdr env) }
-
-setLocalRdrEnv :: LocalRdrEnv -> RnM a -> RnM a
-setLocalRdrEnv rdr_env thing_inside 
-  = updLclEnv (\env -> env {tcl_rdr = rdr_env}) thing_inside
-\end{code}
-
-
-%************************************************************************
-%*									*
-	     Stuff for interface decls
-%*									*
-%************************************************************************
-
-\begin{code}
-mkIfLclEnv :: Module -> SDoc -> IfLclEnv
-mkIfLclEnv mod loc = IfLclEnv { if_mod     = mod,
-			        if_loc     = loc,
-			        if_tv_env  = emptyOccEnv,
-			        if_id_env  = emptyOccEnv }
-
-initIfaceTcRn :: IfG a -> TcRn a
-initIfaceTcRn thing_inside
-  = do  { tcg_env <- getGblEnv 
-	; let { if_env = IfGblEnv { if_rec_types = Just (tcg_mod tcg_env, get_type_env) }
-	      ; get_type_env = readMutVar (tcg_type_env_var tcg_env) }
-	; setEnvs (if_env, ()) thing_inside }
-
-initIfaceExtCore :: IfL a -> TcRn a
-initIfaceExtCore thing_inside
-  = do  { tcg_env <- getGblEnv 
-	; let { mod = tcg_mod tcg_env
-	      ; doc = ptext SLIT("External Core file for") <+> quotes (ppr mod)
-	      ; if_env = IfGblEnv { 
-			if_rec_types = Just (mod, return (tcg_type_env tcg_env)) }
-	      ; if_lenv = mkIfLclEnv mod doc
-	  }
-	; setEnvs (if_env, if_lenv) thing_inside }
-
-initIfaceCheck :: HscEnv -> IfG a -> IO a
--- Used when checking the up-to-date-ness of the old Iface
--- Initialise the environment with no useful info at all
-initIfaceCheck hsc_env do_this
- = do	{ let gbl_env = IfGblEnv { if_rec_types = Nothing }
-	; initTcRnIf 'i' hsc_env gbl_env () do_this
-    }
-
-initIfaceTc :: ModIface 
- 	    -> (TcRef TypeEnv -> IfL a) -> TcRnIf gbl lcl a
--- Used when type-checking checking an up-to-date interface file
--- No type envt from the current module, but we do know the module dependencies
-initIfaceTc iface do_this
- = do	{ tc_env_var <- newMutVar emptyTypeEnv
-	; let { gbl_env = IfGblEnv { if_rec_types = Just (mod, readMutVar tc_env_var) } ;
-	      ; if_lenv = mkIfLclEnv mod doc
-	   }
-	; setEnvs (gbl_env, if_lenv) (do_this tc_env_var)
-    }
-  where
-    mod = mi_module iface
-    doc = ptext SLIT("The interface for") <+> quotes (ppr mod)
-
-initIfaceRules :: HscEnv -> ModGuts -> IfG a -> IO a
--- Used when sucking in new Rules in SimplCore
--- We have available the type envt of the module being compiled, and we must use it
-initIfaceRules hsc_env guts do_this
- = do	{ let {
-	     type_info = (mg_module guts, return (mg_types guts))
-	   ; gbl_env = IfGblEnv { if_rec_types = Just type_info } ;
-	   }
-
-	-- Run the thing; any exceptions just bubble out from here
-	; initTcRnIf 'i' hsc_env gbl_env () do_this
-    }
-
-initIfaceLcl :: Module -> SDoc -> IfL a -> IfM lcl a
-initIfaceLcl mod loc_doc thing_inside 
-  = setLclEnv (mkIfLclEnv mod loc_doc) thing_inside
-
-getIfModule :: IfL Module
-getIfModule = do { env <- getLclEnv; return (if_mod env) }
-
---------------------
-failIfM :: Message -> IfL a
--- The Iface monad doesn't have a place to accumulate errors, so we
--- just fall over fast if one happens; it "shouldnt happen".
--- We use IfL here so that we can get context info out of the local env
-failIfM msg
-  = do 	{ env <- getLclEnv
-	; let full_msg = (if_loc env <> colon) $$ nest 2 msg
-	; ioToIOEnv (printErrs (full_msg defaultErrStyle))
-	; failM }
-
---------------------
-forkM_maybe :: SDoc -> IfL a -> IfL (Maybe a)
--- Run thing_inside in an interleaved thread.  
--- It shares everything with the parent thread, so this is DANGEROUS.  
---
--- It returns Nothing if the computation fails
--- 
--- It's used for lazily type-checking interface
--- signatures, which is pretty benign
-
-forkM_maybe doc thing_inside
- = do {	unsafeInterleaveM $
-	do { traceIf (text "Starting fork {" <+> doc)
-	   ; mb_res <- tryM thing_inside ;
-	     case mb_res of
-		Right r  -> do	{ traceIf (text "} ending fork" <+> doc)
-				; return (Just r) }
-		Left exn -> do {
-
-		    -- Bleat about errors in the forked thread, if -ddump-if-trace is on
-		    -- Otherwise we silently discard errors. Errors can legitimately
-		    -- happen when compiling interface signatures (see tcInterfaceSigs)
-		      ifOptM Opt_D_dump_if_trace 
-			     (print_errs (hang (text "forkM failed:" <+> doc)
-				             4 (text (show exn))))
-
-		    ; traceIf (text "} ending fork (badly)" <+> doc)
-	  	    ; return Nothing }
-	}}
-  where
-    print_errs sdoc = ioToIOEnv (printErrs (sdoc defaultErrStyle))
-
-forkM :: SDoc -> IfL a -> IfL a
-forkM doc thing_inside
- = do	{ mb_res <- forkM_maybe doc thing_inside
-	; return (case mb_res of 
-			Nothing -> pgmError "Cannot continue after interface file error"
-				   -- pprPanic "forkM" doc
-			Just r  -> r) }
-\end{code}
-
-
diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs
deleted file mode 100644
index 62281b56a1..0000000000
--- a/ghc/compiler/typecheck/TcRnTypes.lhs
+++ /dev/null
@@ -1,818 +0,0 @@
-%
-% (c) The GRASP Project, Glasgow University, 1992-2002
-%
-\begin{code}
-module TcRnTypes(
-	TcRnIf, TcRn, TcM, RnM,	IfM, IfL, IfG, -- The monad is opaque outside this module
-	TcRef,
-
-	-- The environment types
-	Env(..), 
-	TcGblEnv(..), TcLclEnv(..), 
-	IfGblEnv(..), IfLclEnv(..), 
-
-	-- Ranamer types
-	ErrCtxt,
-	ImportAvails(..), emptyImportAvails, plusImportAvails, 
-	plusAvail, pruneAvails,  
-	AvailEnv, emptyAvailEnv, unitAvailEnv, plusAvailEnv, 
-	mkAvailEnv, lookupAvailEnv, lookupAvailEnv_maybe, availEnvElts, addAvail,
-	WhereFrom(..), mkModDeps,
-
-	-- Typechecker types
-	TcTyThing(..), pprTcTyThingCategory, 
-	GadtRefinement,
-
-	-- Template Haskell
-	ThStage(..), topStage, topSpliceStage,
-	ThLevel, impLevel, topLevel,
-
-	-- Arrows
-	ArrowCtxt(NoArrowCtxt), newArrowScope, escapeArrowScope,
-
-	-- Insts
-	Inst(..), InstOrigin(..), InstLoc(..), pprInstLoc, 
-	instLocSrcLoc, instLocSrcSpan,
-	LIE, emptyLIE, unitLIE, plusLIE, consLIE, 
-	plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE,
-
-	-- Misc other types
-	TcId, TcIdSet, TcDictBinds
-  ) where
-
-#include "HsVersions.h"
-
-import HsSyn		( PendingSplice, HsOverLit, LRuleDecl, LForeignDecl,
-			  ArithSeqInfo, DictBinds, LHsBinds, LImportDecl, HsGroup,
-                          IE )
-import HscTypes		( FixityEnv,
-			  HscEnv, TypeEnv, TyThing, 
-			  GenAvailInfo(..), AvailInfo, HscSource(..),
-			  availName, IsBootInterface, Deprecations )
-import Packages		( PackageId, HomeModules )
-import Type		( Type, pprTyThingCategory )
-import TcType		( TcTyVarSet, TcType, TcThetaType, SkolemInfo, TvSubst,
-			  TcPredType, TcKind, tcCmpPred, tcCmpType, tcCmpTypes, pprSkolInfo )
-import InstEnv		( Instance, InstEnv )
-import IOEnv
-import RdrName		( GlobalRdrEnv, LocalRdrEnv )
-import Name		( Name )
-import NameEnv
-import NameSet		( NameSet, unionNameSets, DefUses )
-import OccName		( OccEnv )
-import Var		( Id, TyVar )
-import VarEnv		( TidyEnv )
-import Module
-import SrcLoc		( SrcSpan, SrcLoc, Located, srcSpanStart )
-import VarSet		( IdSet )
-import ErrUtils		( Messages, Message )
-import UniqSupply	( UniqSupply )
-import BasicTypes	( IPName )
-import Util		( thenCmp )
-import Bag
-import Outputable
-import Maybe		( mapMaybe )
-import ListSetOps	( unionLists )
-\end{code}
-
-
-%************************************************************************
-%*									*
-	       Standard monad definition for TcRn
-    All the combinators for the monad can be found in TcRnMonad
-%*									*
-%************************************************************************
-
-The monad itself has to be defined here, because it is mentioned by ErrCtxt
-
-\begin{code}
-type TcRef a 	 = IORef a
-type TcId    	 = Id 			-- Type may be a TcType
-type TcIdSet 	 = IdSet
-type TcDictBinds = DictBinds TcId	-- Bag of dictionary bindings
-
-
-
-type TcRnIf a b c = IOEnv (Env a b) c
-type IfM lcl a  = TcRnIf IfGblEnv lcl a		-- Iface stuff
-type IfG a  = IfM () a				-- Top level
-type IfL a  = IfM IfLclEnv a			-- Nested
-type TcRn a = TcRnIf TcGblEnv TcLclEnv a
-type RnM  a = TcRn a		-- Historical
-type TcM  a = TcRn a		-- Historical
-\end{code}
-
-
-%************************************************************************
-%*									*
-		The main environment types
-%*									*
-%************************************************************************
-
-\begin{code}
-data Env gbl lcl	-- Changes as we move into an expression
-  = Env {
-	env_top	 :: HscEnv,	-- Top-level stuff that never changes
-				-- Includes all info about imported things
-
-	env_us   :: TcRef UniqSupply,	-- Unique supply for local varibles
-
-	env_gbl  :: gbl,	-- Info about things defined at the top level
-				-- of the module being compiled
-
-	env_lcl  :: lcl		-- Nested stuff; changes as we go into 
-				-- an expression
-    }
-
--- TcGblEnv describes the top-level of the module at the 
--- point at which the typechecker is finished work.
--- It is this structure that is handed on to the desugarer
-
-data TcGblEnv
-  = TcGblEnv {
-	tcg_mod     :: Module,		-- Module being compiled
-	tcg_src     :: HscSource,	-- What kind of module 
-					-- (regular Haskell, hs-boot, ext-core)
-
-	tcg_rdr_env :: GlobalRdrEnv,	-- Top level envt; used during renaming
-	tcg_default :: Maybe [Type],	-- Types used for defaulting
-					-- Nothing => no 'default' decl
-
-	tcg_fix_env  :: FixityEnv,	-- Just for things in this module
-
-	tcg_type_env :: TypeEnv,	-- Global type env for the module we are compiling now
-		-- All TyCons and Classes (for this module) end up in here right away,
-		-- along with their derived constructors, selectors.
-		--
-		-- (Ids defined in this module start in the local envt, 
-		--  though they move to the global envt during zonking)
-
-	tcg_type_env_var :: TcRef TypeEnv,	
-		-- Used only to initialise the interface-file
-		-- typechecker in initIfaceTcRn, so that it can see stuff
-		-- bound in this module when dealing with hi-boot recursions
-		-- Updated at intervals (e.g. after dealing with types and classes)
-	
-	tcg_inst_env :: InstEnv,	-- Instance envt for *home-package* modules
-					-- Includes the dfuns in tcg_insts
-		-- Now a bunch of things about this module that are simply 
-		-- accumulated, but never consulted until the end.  
-		-- Nevertheless, it's convenient to accumulate them along 
-		-- with the rest of the info from this module.
-	tcg_exports :: NameSet,		-- What is exported
-	tcg_imports :: ImportAvails,	-- Information about what was imported 
-					--    from where, including things bound
-					--    in this module
-
-	tcg_home_mods :: HomeModules,
-				-- Calculated from ImportAvails, allows us to
-				-- call Packages.isHomeModule
-
-	tcg_dus :: DefUses,  	-- What is defined in this module and what is used.
-				-- The latter is used to generate 
-				--	(a) version tracking; no need to recompile if these
-				--		things have not changed version stamp
-				-- 	(b) unused-import info
-
-	tcg_keep :: TcRef NameSet,	-- Locally-defined top-level names to keep alive
-		-- "Keep alive" means give them an Exported flag, so
-		-- that the simplifier does not discard them as dead 
-		-- code, and so that they are exposed in the interface file
-		-- (but not to export to the user).
-		--
-		-- Some things, like dict-fun Ids and default-method Ids are 
-		-- "born" with the Exported flag on, for exactly the above reason,
-		-- but some we only discover as we go.  Specifically:
-		--	* The to/from functions for generic data types
-		--	* Top-level variables appearing free in the RHS of an orphan rule
-		--	* Top-level variables appearing free in a TH bracket
-
-	tcg_inst_uses :: TcRef NameSet,	-- Home-package Dfuns actually used 
-		-- Used to generate version dependencies
-		-- This records usages, rather like tcg_dus, but it has to
-		-- be a mutable variable so it can be augmented 
-		-- when we look up an instance.  These uses of dfuns are
-		-- rather like the free variables of the program, but
-		-- are implicit instead of explicit.
-
-	tcg_th_used :: TcRef Bool,	-- True <=> Template Haskell syntax used
-		-- We need this so that we can generate a dependency on the
-		-- Template Haskell package, becuase the desugarer is going to
-		-- emit loads of references to TH symbols.  It's rather like 
-		-- tcg_inst_uses; the reference is implicit rather than explicit,
-		-- so we have to zap a mutable variable.
-
-	tcg_dfun_n  :: TcRef Int,	-- Allows us to number off the names of DFuns
-		-- It's convenient to allocate an External Name for a DFun, with
-		-- a permanently-fixed unique, just like other top-level functions
-		-- defined in this module.  But that means we need a canonical 
-		-- occurrence name, distinct from all other dfuns in this module,
-		-- and this name supply serves that purpose (df1, df2, etc).
-
-		-- The next fields accumulate the payload of the module
-		-- The binds, rules and foreign-decl fiels are collected
-		-- initially in un-zonked form and are finally zonked in tcRnSrcDecls
-
-		-- The next fields accumulate the payload of the
-		-- module The binds, rules and foreign-decl fiels are
-		-- collected initially in un-zonked form and are
-		-- finally zonked in tcRnSrcDecls
-
-        tcg_rn_imports :: Maybe [LImportDecl Name],
-        tcg_rn_exports :: Maybe [Located (IE Name)],
-	tcg_rn_decls :: Maybe (HsGroup Name),	-- renamed decls, maybe
-		-- Nothing <=> Don't retain renamed decls
-
-	tcg_binds   :: LHsBinds Id,		-- Value bindings in this module
-	tcg_deprecs :: Deprecations,		-- ...Deprecations 
-	tcg_insts   :: [Instance],		-- ...Instances
-	tcg_rules   :: [LRuleDecl Id],		-- ...Rules
-	tcg_fords   :: [LForeignDecl Id]	-- ...Foreign import & exports
-    }
-\end{code}
-
-%************************************************************************
-%*									*
-		The interface environments
-  	      Used when dealing with IfaceDecls
-%*									*
-%************************************************************************
-
-\begin{code}
-data IfGblEnv 
-  = IfGblEnv {
-	-- The type environment for the module being compiled,
-	-- in case the interface refers back to it via a reference that
-	-- was originally a hi-boot file.
-	-- We need the module name so we can test when it's appropriate
-	-- to look in this env.
-	if_rec_types :: Maybe (Module, IfG TypeEnv)
-		-- Allows a read effect, so it can be in a mutable
-		-- variable; c.f. handling the external package type env
-		-- Nothing => interactive stuff, no loops possible
-    }
-
-data IfLclEnv
-  = IfLclEnv {
-	-- The module for the current IfaceDecl
-	-- So if we see   f = \x -> x
-	-- it means M.f = \x -> x, where M is the if_mod
-	if_mod :: Module,
-
-	-- The field is used only for error reporting
-	-- if (say) there's a Lint error in it
-	if_loc :: SDoc,
-		-- Where the interface came from:
-		--	.hi file, or GHCi state, or ext core
-		-- plus which bit is currently being examined
-
-	if_tv_env  :: OccEnv TyVar,	-- Nested tyvar bindings
-	if_id_env  :: OccEnv Id		-- Nested id binding
-    }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		The local typechecker environment
-%*									*
-%************************************************************************
-
-The Global-Env/Local-Env story
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-During type checking, we keep in the tcg_type_env
-	* All types and classes
-	* All Ids derived from types and classes (constructors, selectors)
-
-At the end of type checking, we zonk the local bindings,
-and as we do so we add to the tcg_type_env
-	* Locally defined top-level Ids
-
-Why?  Because they are now Ids not TcIds.  This final GlobalEnv is
-	a) fed back (via the knot) to typechecking the 
-	   unfoldings of interface signatures
-	b) used in the ModDetails of this module
-
-\begin{code}
-data TcLclEnv		-- Changes as we move inside an expression
-			-- Discarded after typecheck/rename; not passed on to desugarer
-  = TcLclEnv {
-	tcl_loc  :: SrcSpan,		-- Source span
-	tcl_ctxt :: ErrCtxt,		-- Error context
-	tcl_errs :: TcRef Messages,	-- Place to accumulate errors
-
-	tcl_th_ctxt    :: ThStage,	-- Template Haskell context
-	tcl_arrow_ctxt :: ArrowCtxt,	-- Arrow-notation context
-
-	tcl_rdr :: LocalRdrEnv,		-- Local name envt
-		-- Maintained during renaming, of course, but also during
-		-- type checking, solely so that when renaming a Template-Haskell
-		-- splice we have the right environment for the renamer.
-		-- 
-		--   Does *not* include global name envt; may shadow it
-		--   Includes both ordinary variables and type variables;
-		--   they are kept distinct because tyvar have a different
-		--   occurrence contructor (Name.TvOcc)
-		-- We still need the unsullied global name env so that
-    		--   we can look up record field names
-
-	tcl_env  :: NameEnv TcTyThing,  -- The local type environment: Ids and TyVars
-					-- defined in this module
-					
-	tcl_tyvars :: TcRef TcTyVarSet,	-- The "global tyvars"
-			-- Namely, the in-scope TyVars bound in tcl_env, 
-			-- plus the tyvars mentioned in the types of Ids bound in tcl_lenv
-			-- Why mutable? see notes with tcGetGlobalTyVars
-
-	tcl_lie   :: TcRef LIE		-- Place to accumulate type constraints
-    }
-
-type GadtRefinement = TvSubst
-
-{- Note [Given Insts]
-   ~~~~~~~~~~~~~~~~~~
-Because of GADTs, we have to pass inwards the Insts provided by type signatures 
-and existential contexts. Consider
-	data T a where { T1 :: b -> b -> T [b] }
-	f :: Eq a => T a -> Bool
-	f (T1 x y) = [x]==[y]
-
-The constructor T1 binds an existential variable 'b', and we need Eq [b].
-Well, we have it, because Eq a refines to Eq [b], but we can only spot that if we 
-pass it inwards.
-
--}
-
----------------------------
--- Template Haskell levels 
----------------------------
-
-type ThLevel = Int	
-	-- Indicates how many levels of brackets we are inside
-	-- 	(always >= 0)
-	-- Incremented when going inside a bracket,
-	-- decremented when going inside a splice
-
-impLevel, topLevel :: ThLevel
-topLevel = 1	-- Things defined at top level of this module
-impLevel = 0	-- Imported things; they can be used inside a top level splice
---
--- For example: 
---	f = ...
---	g1 = $(map ...)		is OK
---	g2 = $(f ...)		is not OK; because we havn't compiled f yet
-
-
-data ThStage
-  = Comp   				-- Ordinary compiling, at level topLevel
-  | Splice ThLevel 			-- Inside a splice
-  | Brack  ThLevel 			-- Inside brackets; 
-	   (TcRef [PendingSplice])	--   accumulate pending splices here
-	   (TcRef LIE)			--   and type constraints here
-topStage, topSpliceStage :: ThStage
-topStage       = Comp
-topSpliceStage = Splice (topLevel - 1)	-- Stage for the body of a top-level splice
-
----------------------------
--- Arrow-notation context
----------------------------
-
-{-
-In arrow notation, a variable bound by a proc (or enclosed let/kappa)
-is not in scope to the left of an arrow tail (-<) or the head of (|..|).
-For example
-
-	proc x -> (e1 -< e2)
-
-Here, x is not in scope in e1, but it is in scope in e2.  This can get
-a bit complicated:
-
-	let x = 3 in
-	proc y -> (proc z -> e1) -< e2
-
-Here, x and z are in scope in e1, but y is not.  We implement this by
-recording the environment when passing a proc (using newArrowScope),
-and returning to that (using escapeArrowScope) on the left of -< and the
-head of (|..|).
--}
-
-data ArrowCtxt
-  = NoArrowCtxt
-  | ArrowCtxt (Env TcGblEnv TcLclEnv)
-
--- Record the current environment (outside a proc)
-newArrowScope :: TcM a -> TcM a
-newArrowScope
-  = updEnv $ \env ->
-	env { env_lcl = (env_lcl env) { tcl_arrow_ctxt = ArrowCtxt env } }
-
--- Return to the stored environment (from the enclosing proc)
-escapeArrowScope :: TcM a -> TcM a
-escapeArrowScope
-  = updEnv $ \ env -> case tcl_arrow_ctxt (env_lcl env) of
-	NoArrowCtxt -> env
-	ArrowCtxt env' -> env'
-
----------------------------
--- TcTyThing
----------------------------
-
-data TcTyThing
-  = AGlobal TyThing		-- Used only in the return type of a lookup
-
-  | ATcId   TcId 	 	-- Ids defined in this module; may not be fully zonked
-	    ThLevel 
-	    Bool		-- True <=> apply the type refinement to me
-
-  | ATyVar  Name TcType		-- The type to which the lexically scoped type vaiable
-				-- is currently refined. We only need the Name
-				-- for error-message purposes
-
-  | AThing  TcKind 		-- Used temporarily, during kind checking, for the
-				--	tycons and clases in this recursive group
-
-instance Outputable TcTyThing where	-- Debugging only
-   ppr (AGlobal g)      = ppr g
-   ppr (ATcId g tl rig) = text "Identifier" <> 
-			  ifPprDebug (brackets (ppr g <> comma <> ppr tl <+> ppr rig))
-   ppr (ATyVar tv _)    = text "Type variable" <+> quotes (ppr tv)
-   ppr (AThing k)       = text "AThing" <+> ppr k
-
-pprTcTyThingCategory :: TcTyThing -> SDoc
-pprTcTyThingCategory (AGlobal thing) = pprTyThingCategory thing
-pprTcTyThingCategory (ATyVar {})     = ptext SLIT("Type variable")
-pprTcTyThingCategory (ATcId {})      = ptext SLIT("Local identifier")
-pprTcTyThingCategory (AThing {})     = ptext SLIT("Kinded thing")
-\end{code}
-
-\begin{code}
-type ErrCtxt = [TidyEnv -> TcM (TidyEnv, Message)]	
-			-- Innermost first.  Monadic so that we have a chance
-			-- to deal with bound type variables just before error
-			-- message construction
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Operations over ImportAvails
-%*									*
-%************************************************************************
-
-ImportAvails summarises what was imported from where, irrespective
-of whether the imported things are actually used or not
-It is used 	* when processing the export list
-		* when constructing usage info for the inteface file
-		* to identify the list of directly imported modules
-			for initialisation purposes
-		* when figuring out what things are really unused
-
-\begin{code}
-data ImportAvails 
-   = ImportAvails {
-	imp_env :: ModuleEnv NameSet,
-		-- All the things imported, classified by 
-		-- the *module qualifier* for its import
-		--   e.g.	 import List as Foo
-		-- would add a binding Foo |-> ...stuff from List...
-		-- to imp_env.
-		-- 
-		-- We need to classify them like this so that we can figure out 
-		-- "module M" export specifiers in an export list 
-		-- (see 1.4 Report Section 5.1.1).  Ultimately, we want to find 
-		-- everything that is unambiguously in scope as 'M.x'
-		-- and where plain 'x' is (perhaps ambiguously) in scope.
-		-- So the starting point is all things that are in scope as 'M.x',
-		-- which is what this field tells us.
-
-	imp_mods :: ModuleEnv (Module, Bool, SrcSpan),
-		-- Domain is all directly-imported modules
-		-- Bool means:
-		--   True => import was "import Foo ()"
-		--   False  => import was some other form
-		--
-		-- We need the Module in the range because we can't get
-		-- 	the keys of a ModuleEnv
-		-- Used 
-		--   (a) to help construct the usage information in 
-		--       the interface file; if we import somethign we
-		--       need to recompile if the export version changes
-		--   (b) to specify what child modules to initialise
-
-	imp_dep_mods :: ModuleEnv (Module, IsBootInterface),
-		-- Home-package modules needed by the module being compiled
-		--
-		-- It doesn't matter whether any of these dependencies
-		-- are actually *used* when compiling the module; they
-		-- are listed if they are below it at all.  For
-		-- example, suppose M imports A which imports X.  Then
-		-- compiling M might not need to consult X.hi, but X
-		-- is still listed in M's dependencies.
-
-	imp_dep_pkgs :: [PackageId],
-		-- Packages needed by the module being compiled, whether
-		-- directly, or via other modules in this package, or via
-		-- modules imported from other packages.
-
- 	imp_orphs :: [Module]
-		-- Orphan modules below us in the import tree
-      }
-
-mkModDeps :: [(Module, IsBootInterface)]
-	  -> ModuleEnv (Module, IsBootInterface)
-mkModDeps deps = foldl add emptyModuleEnv deps
-	       where
-		 add env elt@(m,_) = extendModuleEnv env m elt
-
-emptyImportAvails :: ImportAvails
-emptyImportAvails = ImportAvails { imp_env 	= emptyModuleEnv, 
-				   imp_mods   	= emptyModuleEnv,
-				   imp_dep_mods = emptyModuleEnv,
-				   imp_dep_pkgs = [],
-				   imp_orphs    = [] }
-
-plusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails
-plusImportAvails
-  (ImportAvails { imp_env = env1, imp_mods = mods1,
-		  imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1, imp_orphs = orphs1 })
-  (ImportAvails { imp_env = env2, imp_mods = mods2,
-		  imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2, imp_orphs = orphs2 })
-  = ImportAvails { imp_env      = plusModuleEnv_C unionNameSets env1 env2, 
-		   imp_mods     = mods1  `plusModuleEnv` mods2,	
-		   imp_dep_mods = plusModuleEnv_C plus_mod_dep dmods1 dmods2,	
-		   imp_dep_pkgs = dpkgs1 `unionLists` dpkgs2,
-		   imp_orphs    = orphs1 `unionLists` orphs2 }
-  where
-    plus_mod_dep (m1, boot1) (m2, boot2) 
-	= WARN( not (m1 == m2), (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )
-		-- Check mod-names match
-	  (m1, boot1 && boot2)	-- If either side can "see" a non-hi-boot interface, use that
-\end{code}
-
-%************************************************************************
-%*									*
-	Avails, AvailEnv, etc
-%*									*
-v%************************************************************************
-
-\begin{code}
-plusAvail (Avail n1)	   (Avail n2)	    = Avail n1
-plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (ns1 `unionLists` ns2)
--- Added SOF 4/97
-#ifdef DEBUG
-plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
-#endif
-
--------------------------
-pruneAvails :: (Name -> Bool)	-- Keep if this is True
-	    -> [AvailInfo]
-	    -> [AvailInfo]
-pruneAvails keep avails
-  = mapMaybe del avails
-  where
-    del :: AvailInfo -> Maybe AvailInfo	-- Nothing => nothing left!
-    del (Avail n) | keep n    = Just (Avail n)
-    	          | otherwise = Nothing
-    del (AvailTC n ns) | null ns'  = Nothing
-		       | otherwise = Just (AvailTC n ns')
-		       where
-		         ns' = filter keep ns
-\end{code}
-
----------------------------------------
-	AvailEnv and friends
----------------------------------------
-
-\begin{code}
-type AvailEnv = NameEnv AvailInfo	-- Maps a Name to the AvailInfo that contains it
-
-emptyAvailEnv :: AvailEnv
-emptyAvailEnv = emptyNameEnv
-
-unitAvailEnv :: AvailInfo -> AvailEnv
-unitAvailEnv a = unitNameEnv (availName a) a
-
-plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
-plusAvailEnv = plusNameEnv_C plusAvail
-
-lookupAvailEnv_maybe :: AvailEnv -> Name -> Maybe AvailInfo
-lookupAvailEnv_maybe = lookupNameEnv
-
-lookupAvailEnv :: AvailEnv -> Name -> AvailInfo
-lookupAvailEnv env n = case lookupNameEnv env n of
-			 Just avail -> avail
-			 Nothing    -> pprPanic "lookupAvailEnv" (ppr n)
-
-availEnvElts = nameEnvElts
-
-addAvail :: AvailEnv -> AvailInfo -> AvailEnv
-addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
-
-mkAvailEnv :: [AvailInfo] -> AvailEnv
-	-- 'avails' may have several items with the same availName
-	-- E.g  import Ix( Ix(..), index )
-	-- will give Ix(Ix,index,range) and Ix(index)
-	-- We want to combine these; addAvail does that
-mkAvailEnv avails = foldl addAvail emptyAvailEnv avails
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Where from}
-%*									*
-%************************************************************************
-
-The @WhereFrom@ type controls where the renamer looks for an interface file
-
-\begin{code}
-data WhereFrom 
-  = ImportByUser IsBootInterface	-- Ordinary user import (perhaps {-# SOURCE #-})
-  | ImportBySystem			-- Non user import.
-
-instance Outputable WhereFrom where
-  ppr (ImportByUser is_boot) | is_boot     = ptext SLIT("{- SOURCE -}")
-			     | otherwise   = empty
-  ppr ImportBySystem     		   = ptext SLIT("{- SYSTEM -}")
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Inst-types]{@Inst@ types}
-%*									*
-v%************************************************************************
-
-An @Inst@ is either a dictionary, an instance of an overloaded
-literal, or an instance of an overloaded value.  We call the latter a
-``method'' even though it may not correspond to a class operation.
-For example, we might have an instance of the @double@ function at
-type Int, represented by
-
-	Method 34 doubleId [Int] origin
-
-\begin{code}
-data Inst
-  = Dict
-	Name
-	TcPredType
-	InstLoc
-
-  | Method
-	Id
-
-	TcId	-- The overloaded function
-			-- This function will be a global, local, or ClassOpId;
-			--   inside instance decls (only) it can also be an InstId!
-			-- The id needn't be completely polymorphic.
-			-- You'll probably find its name (for documentation purposes)
-			--	  inside the InstOrigin
-
-	[TcType]	-- The types to which its polymorphic tyvars
-			--	should be instantiated.
-			-- These types must saturate the Id's foralls.
-
-	TcThetaType	-- The (types of the) dictionaries to which the function
-			-- must be applied to get the method
-
-	InstLoc
-
-	-- INVARIANT 1: in (Method u f tys theta tau loc)
-	--	type of (f tys dicts(from theta)) = tau
-
-	-- INVARIANT 2: tau must not be of form (Pred -> Tau)
-	--   Reason: two methods are considered equal if the 
-	--   	     base Id matches, and the instantiating types
-	--	     match.  The TcThetaType should then match too.
-	--   This only bites in the call to tcInstClassOp in TcClassDcl.mkMethodBind
-
-  | LitInst
-	Name
-	(HsOverLit Name)	-- The literal from the occurrence site
-				-- INVARIANT: never a rebindable-syntax literal
-				-- Reason: tcSyntaxName does unification, and we
-				--	   don't want to deal with that during tcSimplify,
-				--	   when resolving LitInsts
-	TcType		-- The type at which the literal is used
-	InstLoc
-\end{code}
-
-@Insts@ are ordered by their class/type info, rather than by their
-unique.  This allows the context-reduction mechanism to use standard finite
-maps to do their stuff.
-
-\begin{code}
-instance Ord Inst where
-  compare = cmpInst
-
-instance Eq Inst where
-  (==) i1 i2 = case i1 `cmpInst` i2 of
-	         EQ    -> True
-		 other -> False
-
-cmpInst (Dict _ pred1 _)     	(Dict _ pred2 _)	= pred1 `tcCmpPred` pred2
-cmpInst (Dict _ _ _)	     	other 		    	= LT
-
-cmpInst (Method _ _ _ _ _) 	(Dict _ _ _)	  	= GT
-cmpInst (Method _ id1 tys1 _ _) (Method _ id2 tys2 _ _) = (id1 `compare` id2) `thenCmp` (tys1 `tcCmpTypes` tys2)
-cmpInst (Method _ _ _ _ _)      other			= LT
-
-cmpInst (LitInst _ _ _ _)	(Dict _ _ _) 		= GT
-cmpInst (LitInst _ _ _ _)	(Method _ _ _ _ _)	= GT
-cmpInst (LitInst _ lit1 ty1 _)	(LitInst _ lit2 ty2 _)  = (lit1 `compare` lit2) `thenCmp` (ty1 `tcCmpType` ty2)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Inst-collections]{LIE: a collection of Insts}
-%*									*
-%************************************************************************
-
-\begin{code}
--- FIXME: Rename this. It clashes with (Located (IE ...))
-type LIE = Bag Inst
-
-isEmptyLIE	  = isEmptyBag
-emptyLIE          = emptyBag
-unitLIE inst 	  = unitBag inst
-mkLIE insts	  = listToBag insts
-plusLIE lie1 lie2 = lie1 `unionBags` lie2
-consLIE inst lie  = inst `consBag` lie
-plusLIEs lies	  = unionManyBags lies
-lieToList	  = bagToList
-listToLIE	  = listToBag
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Inst-origin]{The @InstOrigin@ type}
-%*									*
-%************************************************************************
-
-The @InstOrigin@ type gives information about where a dictionary came from.
-This is important for decent error message reporting because dictionaries
-don't appear in the original source code.  Doubtless this type will evolve...
-
-It appears in TcMonad because there are a couple of error-message-generation
-functions that deal with it.
-
-\begin{code}
-data InstLoc = InstLoc InstOrigin SrcSpan ErrCtxt
-
-instLocSrcLoc :: InstLoc -> SrcLoc
-instLocSrcLoc (InstLoc _ src_span _) = srcSpanStart src_span
-
-instLocSrcSpan :: InstLoc -> SrcSpan
-instLocSrcSpan (InstLoc _ src_span _) = src_span
-
-data InstOrigin
-  = SigOrigin SkolemInfo	-- Pattern, class decl, inst decl etc;
-				-- Places that bind type variables and introduce
-				-- available constraints
-
-  | IPBindOrigin (IPName Name)	-- Binding site of an implicit parameter
-
-	-------------------------------------------------------
-	-- The rest are all occurrences: Insts that are 'wanted'
-	-------------------------------------------------------
-  | OccurrenceOf Name		-- Occurrence of an overloaded identifier
-
-  | IPOccOrigin  (IPName Name)	-- Occurrence of an implicit parameter
-
-  | LiteralOrigin (HsOverLit Name)	-- Occurrence of a literal
-
-  | ArithSeqOrigin (ArithSeqInfo Name) -- [x..], [x..y] etc
-  | PArrSeqOrigin  (ArithSeqInfo Name) -- [:x..y:] and [:x,y..z:]
-
-  | InstSigOrigin	-- A dict occurrence arising from instantiating
-			-- a polymorphic type during a subsumption check
-
-  | RecordUpdOrigin
-  | InstScOrigin	-- Typechecking superclasses of an instance declaration
-  | DerivOrigin		-- Typechecking deriving
-  | DefaultOrigin	-- Typechecking a default decl
-  | DoOrigin		-- Arising from a do expression
-  | ProcOrigin		-- Arising from a proc expression
-\end{code}
-
-\begin{code}
-pprInstLoc :: InstLoc -> SDoc
-pprInstLoc (InstLoc orig locn _)
-  = hsep [text "arising from", pp_orig orig, text "at", ppr locn]
-  where
-    pp_orig (OccurrenceOf name)  = hsep [ptext SLIT("use of"), quotes (ppr name)]
-    pp_orig (IPOccOrigin name)   = hsep [ptext SLIT("use of implicit parameter"), quotes (ppr name)]
-    pp_orig (IPBindOrigin name)  = hsep [ptext SLIT("binding for implicit parameter"), quotes (ppr name)]
-    pp_orig RecordUpdOrigin 	 = ptext SLIT("a record update")
-    pp_orig (LiteralOrigin lit)	 = hsep [ptext SLIT("the literal"), quotes (ppr lit)]
-    pp_orig (ArithSeqOrigin seq) = hsep [ptext SLIT("the arithmetic sequence"), quotes (ppr seq)]
-    pp_orig (PArrSeqOrigin seq)	 = hsep [ptext SLIT("the parallel array sequence"), quotes (ppr seq)]
-    pp_orig InstSigOrigin	 = ptext SLIT("instantiating a type signature")
-    pp_orig InstScOrigin	 = ptext SLIT("the superclasses of an instance declaration")
-    pp_orig DerivOrigin	 	 = ptext SLIT("the 'deriving' clause of a data type declaration")
-    pp_orig DefaultOrigin	 = ptext SLIT("a 'default' declaration")
-    pp_orig DoOrigin		 = ptext SLIT("a do statement")
-    pp_orig ProcOrigin		 = ptext SLIT("a proc expression")
-    pp_orig (SigOrigin info) 	 = pprSkolInfo info
-\end{code}
diff --git a/ghc/compiler/typecheck/TcRules.lhs b/ghc/compiler/typecheck/TcRules.lhs
deleted file mode 100644
index b14c2c9449..0000000000
--- a/ghc/compiler/typecheck/TcRules.lhs
+++ /dev/null
@@ -1,116 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1993-1998
-%
-\section[TcRules]{Typechecking transformation rules}
-
-\begin{code}
-module TcRules ( tcRules ) where
-
-#include "HsVersions.h"
-
-import HsSyn		( RuleDecl(..), LRuleDecl, RuleBndr(..), mkHsDictLet )
-import TcRnMonad
-import TcSimplify	( tcSimplifyToDicts, tcSimplifyInferCheck )
-import TcMType		( newFlexiTyVarTy, zonkQuantifiedTyVar, tcSkolSigTyVars )
-import TcType		( tyVarsOfTypes, openTypeKind, SkolemInfo(..), substTyWith, mkTyVarTys )
-import TcHsType		( UserTypeCtxt(..), tcHsPatSigType )
-import TcExpr		( tcMonoExpr )
-import TcEnv		( tcExtendIdEnv, tcExtendTyVarEnv )
-import Inst		( instToId )
-import Id		( idType, mkLocalId )
-import Name		( Name )
-import SrcLoc		( noLoc, unLoc )
-import Outputable
-\end{code}
-
-\begin{code}
-tcRules :: [LRuleDecl Name] -> TcM [LRuleDecl TcId]
-tcRules decls = mappM (wrapLocM tcRule) decls
-
-tcRule :: RuleDecl Name -> TcM (RuleDecl TcId)
-tcRule (HsRule name act vars lhs fv_lhs rhs fv_rhs)
-  = addErrCtxt (ruleCtxt name)			$
-    traceTc (ptext SLIT("---- Rule ------")
-		 <+> ppr name)			`thenM_` 
-    newFlexiTyVarTy openTypeKind		`thenM` \ rule_ty ->
-
-	-- Deal with the tyvars mentioned in signatures
-    tcRuleBndrs vars (\ ids ->
-		-- Now LHS and RHS
-	getLIE (tcMonoExpr lhs rule_ty)	`thenM` \ (lhs', lhs_lie) ->
-	getLIE (tcMonoExpr rhs rule_ty)	`thenM` \ (rhs', rhs_lie) ->
-	returnM (ids, lhs', rhs', lhs_lie, rhs_lie)
-    )				`thenM` \ (ids, lhs', rhs', lhs_lie, rhs_lie) ->
-
-		-- Check that LHS has no overloading at all
-    getLIE (tcSimplifyToDicts lhs_lie)	`thenM` \ (lhs_binds, lhs_dicts) ->
-
-	-- Gather the template variables and tyvars
-    let
-	tpl_ids = map instToId lhs_dicts ++ ids
-
-	-- IMPORTANT!  We *quantify* over any dicts that appear in the LHS
-	-- Reason: 
-	--	a) The particular dictionary isn't important, because its value
-	--	   depends only on the type
-	--		e.g	gcd Int $fIntegralInt
-	--         Here we'd like to match against (gcd Int any_d) for any 'any_d'
-	--
-	--	b) We'd like to make available the dictionaries bound 
-	--	   on the LHS in the RHS, so quantifying over them is good
-	--	   See the 'lhs_dicts' in tcSimplifyAndCheck for the RHS
-
-	-- We initially quantify over any tyvars free in *either* the rule
-	--  *or* the bound variables.  The latter is important.  Consider
-	--	ss (x,(y,z)) = (x,z)
-	--	RULE:  forall v. fst (ss v) = fst v
-	-- The type of the rhs of the rule is just a, but v::(a,(b,c))
-	--
-	-- We also need to get the free tyvars of the LHS; but we do that
-	-- during zonking (see TcHsSyn.zonkRule)
-	--
-	forall_tvs = tyVarsOfTypes (rule_ty : map idType tpl_ids)
-    in
-	-- RHS can be a bit more lenient.  In particular,
-	-- we let constant dictionaries etc float outwards
-	--
-	-- NB: tcSimplifyInferCheck zonks the forall_tvs, and 
-	--     knocks out any that are constrained by the environment
-    tcSimplifyInferCheck (text "tcRule")
-			 forall_tvs
-			 lhs_dicts rhs_lie	`thenM` \ (forall_tvs1, rhs_binds) ->
-    mappM zonkQuantifiedTyVar forall_tvs1 	`thenM` \ forall_tvs2 ->
-	-- This zonk is exactly the same as the one in TcBinds.tcBindWithSigs
-
-    returnM (HsRule name act
-		    (map (RuleBndr . noLoc) (forall_tvs2 ++ tpl_ids))	-- yuk
-		    (mkHsDictLet lhs_binds lhs') fv_lhs
-		    (mkHsDictLet rhs_binds rhs') fv_rhs)
-  where
-
-tcRuleBndrs [] thing_inside = thing_inside []
-tcRuleBndrs (RuleBndr var : vars) thing_inside
-  = do 	{ ty <- newFlexiTyVarTy openTypeKind
-	; let id = mkLocalId (unLoc var) ty
-	; tcExtendIdEnv [id] $
-	  tcRuleBndrs vars (\ids -> thing_inside (id:ids)) }
-tcRuleBndrs (RuleBndrSig var rn_ty : vars) thing_inside
---  e.g 	x :: a->a
---  The tyvar 'a' is brought into scope first, just as if you'd written
---		a::*, x :: a->a
-  = do	{ let ctxt = RuleSigCtxt (unLoc var)
-	; (tyvars, ty) <- tcHsPatSigType ctxt rn_ty
-	; let skol_tvs = tcSkolSigTyVars (SigSkol ctxt) tyvars
-	      id_ty = substTyWith tyvars (mkTyVarTys skol_tvs) ty
-	      id = mkLocalId (unLoc var) id_ty
-	; tcExtendTyVarEnv skol_tvs $
-	  tcExtendIdEnv [id] $
-	  tcRuleBndrs vars (\ids -> thing_inside (id:ids)) }
-
-ruleCtxt name = ptext SLIT("When checking the transformation rule") <+> 
-		doubleQuotes (ftext name)
-\end{code}
-
-
-
-
diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
deleted file mode 100644
index 7656198a25..0000000000
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ /dev/null
@@ -1,2534 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcSimplify]{TcSimplify}
-
-
-
-\begin{code}
-module TcSimplify (
-	tcSimplifyInfer, tcSimplifyInferCheck,
-	tcSimplifyCheck, tcSimplifyRestricted,
-	tcSimplifyToDicts, tcSimplifyIPs, 
-	tcSimplifySuperClasses,
-	tcSimplifyTop, tcSimplifyInteractive,
-	tcSimplifyBracket,
-
-	tcSimplifyDeriv, tcSimplifyDefault,
-	bindInstsOfLocalFuns
-    ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TcUnify( unifyType )
-import TypeRep		( Type(..) )
-import HsSyn		( HsBind(..), HsExpr(..), LHsExpr, emptyLHsBinds )
-import TcHsSyn		( mkHsApp, mkHsTyApp, mkHsDictApp )
-
-import TcRnMonad
-import Inst		( lookupInst, LookupInstResult(..),
-			  tyVarsOfInst, fdPredsOfInsts, newDicts, 
-			  isDict, isClassDict, isLinearInst, linearInstType,
-			  isMethodFor, isMethod,
-			  instToId, tyVarsOfInsts,  cloneDict,
-			  ipNamesOfInsts, ipNamesOfInst, dictPred,
-			  fdPredsOfInst,
-			  newDictsAtLoc, tcInstClassOp,
-			  getDictClassTys, isTyVarDict, instLoc,
-			  zonkInst, tidyInsts, tidyMoreInsts,
-			  pprInsts, pprDictsInFull, pprInstInFull, tcGetInstEnvs,
-			  isInheritableInst, pprDictsTheta
-			)
-import TcEnv		( tcGetGlobalTyVars, tcLookupId, findGlobals, pprBinders,
-			  lclEnvElts, tcMetaTy )
-import InstEnv		( lookupInstEnv, classInstances, pprInstances )
-import TcMType		( zonkTcTyVarsAndFV, tcInstTyVars, zonkTcPredType,
-			  checkAmbiguity, checkInstTermination )
-import TcType		( TcTyVar, TcTyVarSet, ThetaType, TcPredType, tidyPred,
-                          mkClassPred, isOverloadedTy, mkTyConApp, isSkolemTyVar,
-			  mkTyVarTy, tcGetTyVar, isTyVarClassPred, mkTyVarTys,
-			  tyVarsOfPred, tcEqType, pprPred, mkPredTy, tcIsTyVarTy )
-import TcIface		( checkWiredInTyCon )
-import Id		( idType, mkUserLocal )
-import Var		( TyVar )
-import TyCon		( TyCon )
-import Name		( Name, getOccName, getSrcLoc )
-import NameSet		( NameSet, mkNameSet, elemNameSet )
-import Class		( classBigSig, classKey )
-import FunDeps		( oclose, grow, improve, pprEquation )
-import PrelInfo		( isNumericClass, isStandardClass ) 
-import PrelNames	( splitName, fstName, sndName, integerTyConName,
-			  showClassKey, eqClassKey, ordClassKey )
-import Type		( zipTopTvSubst, substTheta, substTy )
-import TysWiredIn	( pairTyCon, doubleTy, doubleTyCon )
-import ErrUtils		( Message )
-import BasicTypes	( TopLevelFlag, isNotTopLevel )
-import VarSet
-import VarEnv		( TidyEnv )
-import FiniteMap
-import Bag
-import Outputable
-import ListSetOps	( equivClasses )
-import Util		( zipEqual, isSingleton )
-import List		( partition )
-import SrcLoc		( Located(..) )
-import DynFlags		( DynFlag(..) )
-import StaticFlags
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{NOTES}
-%*									*
-%************************************************************************
-
-	--------------------------------------
-	Notes on functional dependencies (a bug)
-	--------------------------------------
-
-| > class Foo a b | a->b
-| >
-| > class Bar a b | a->b
-| >
-| > data Obj = Obj
-| >
-| > instance Bar Obj Obj
-| >
-| > instance (Bar a b) => Foo a b
-| >
-| > foo:: (Foo a b) => a -> String
-| > foo _ = "works"
-| >
-| > runFoo:: (forall a b. (Foo a b) => a -> w) -> w
-| > runFoo f = f Obj
-| 
-| *Test> runFoo foo
-| 
-| <interactive>:1:
-|     Could not deduce (Bar a b) from the context (Foo a b)
-|       arising from use of `foo' at <interactive>:1
-|     Probable fix:
-|         Add (Bar a b) to the expected type of an expression
-|     In the first argument of `runFoo', namely `foo'
-|     In the definition of `it': it = runFoo foo
-| 
-| Why all of the sudden does GHC need the constraint Bar a b? The
-| function foo didn't ask for that... 
-
-The trouble is that to type (runFoo foo), GHC has to solve the problem:
-
-	Given constraint	Foo a b
-	Solve constraint	Foo a b'
-
-Notice that b and b' aren't the same.  To solve this, just do
-improvement and then they are the same.  But GHC currently does
-	simplify constraints
-	apply improvement
-	and loop
-
-That is usually fine, but it isn't here, because it sees that Foo a b is
-not the same as Foo a b', and so instead applies the instance decl for
-instance Bar a b => Foo a b.  And that's where the Bar constraint comes
-from.
-
-The Right Thing is to improve whenever the constraint set changes at
-all.  Not hard in principle, but it'll take a bit of fiddling to do.  
-
-
-
-	--------------------------------------
-		Notes on quantification
-	--------------------------------------
-
-Suppose we are about to do a generalisation step.
-We have in our hand
-
-	G	the environment
-	T	the type of the RHS
-	C	the constraints from that RHS
-
-The game is to figure out
-
-	Q	the set of type variables over which to quantify
-	Ct	the constraints we will *not* quantify over
-	Cq	the constraints we will quantify over
-
-So we're going to infer the type
-
-	forall Q. Cq => T
-
-and float the constraints Ct further outwards.
-
-Here are the things that *must* be true:
-
- (A)	Q intersect fv(G) = EMPTY			limits how big Q can be
- (B)	Q superset fv(Cq union T) \ oclose(fv(G),C)	limits how small Q can be
-
-(A) says we can't quantify over a variable that's free in the
-environment.  (B) says we must quantify over all the truly free
-variables in T, else we won't get a sufficiently general type.  We do
-not *need* to quantify over any variable that is fixed by the free
-vars of the environment G.
-
-	BETWEEN THESE TWO BOUNDS, ANY Q WILL DO!
-
-Example:	class H x y | x->y where ...
-
-	fv(G) = {a}	C = {H a b, H c d}
-			T = c -> b
-
-	(A)  Q intersect {a} is empty
-	(B)  Q superset {a,b,c,d} \ oclose({a}, C) = {a,b,c,d} \ {a,b} = {c,d}
-
-	So Q can be {c,d}, {b,c,d}
-
-Other things being equal, however, we'd like to quantify over as few
-variables as possible: smaller types, fewer type applications, more
-constraints can get into Ct instead of Cq.
-
-
------------------------------------------
-We will make use of
-
-  fv(T)	 	the free type vars of T
-
-  oclose(vs,C)	The result of extending the set of tyvars vs
-		using the functional dependencies from C
-
-  grow(vs,C)	The result of extend the set of tyvars vs
-		using all conceivable links from C.
-
-		E.g. vs = {a}, C = {H [a] b, K (b,Int) c, Eq e}
-		Then grow(vs,C) = {a,b,c}
-
-		Note that grow(vs,C) `superset` grow(vs,simplify(C))
-		That is, simplfication can only shrink the result of grow.
-
-Notice that
-   oclose is conservative one way:      v `elem` oclose(vs,C) => v is definitely fixed by vs
-   grow is conservative the other way:  if v might be fixed by vs => v `elem` grow(vs,C)
-
-
------------------------------------------
-
-Choosing Q
-~~~~~~~~~~
-Here's a good way to choose Q:
-
-	Q = grow( fv(T), C ) \ oclose( fv(G), C )
-
-That is, quantify over all variable that that MIGHT be fixed by the
-call site (which influences T), but which aren't DEFINITELY fixed by
-G.  This choice definitely quantifies over enough type variables,
-albeit perhaps too many.
-
-Why grow( fv(T), C ) rather than fv(T)?  Consider
-
-	class H x y | x->y where ...
-
-	T = c->c
-	C = (H c d)
-
-  If we used fv(T) = {c} we'd get the type
-
-	forall c. H c d => c -> b
-
-  And then if the fn was called at several different c's, each of
-  which fixed d differently, we'd get a unification error, because
-  d isn't quantified.  Solution: quantify d.  So we must quantify
-  everything that might be influenced by c.
-
-Why not oclose( fv(T), C )?  Because we might not be able to see
-all the functional dependencies yet:
-
-	class H x y | x->y where ...
-	instance H x y => Eq (T x y) where ...
-
-	T = c->c
-	C = (Eq (T c d))
-
-  Now oclose(fv(T),C) = {c}, because the functional dependency isn't
-  apparent yet, and that's wrong.  We must really quantify over d too.
-
-
-There really isn't any point in quantifying over any more than
-grow( fv(T), C ), because the call sites can't possibly influence
-any other type variables.
-
-
-
-	--------------------------------------
-		Notes on ambiguity
-	--------------------------------------
-
-It's very hard to be certain when a type is ambiguous.  Consider
-
-	class K x
-	class H x y | x -> y
-	instance H x y => K (x,y)
-
-Is this type ambiguous?
-	forall a b. (K (a,b), Eq b) => a -> a
-
-Looks like it!  But if we simplify (K (a,b)) we get (H a b) and
-now we see that a fixes b.  So we can't tell about ambiguity for sure
-without doing a full simplification.  And even that isn't possible if
-the context has some free vars that may get unified.  Urgle!
-
-Here's another example: is this ambiguous?
-	forall a b. Eq (T b) => a -> a
-Not if there's an insance decl (with no context)
-	instance Eq (T b) where ...
-
-You may say of this example that we should use the instance decl right
-away, but you can't always do that:
-
-	class J a b where ...
-	instance J Int b where ...
-
-	f :: forall a b. J a b => a -> a
-
-(Notice: no functional dependency in J's class decl.)
-Here f's type is perfectly fine, provided f is only called at Int.
-It's premature to complain when meeting f's signature, or even
-when inferring a type for f.
-
-
-
-However, we don't *need* to report ambiguity right away.  It'll always
-show up at the call site.... and eventually at main, which needs special
-treatment.  Nevertheless, reporting ambiguity promptly is an excellent thing.
-
-So here's the plan.  We WARN about probable ambiguity if
-
-	fv(Cq) is not a subset of  oclose(fv(T) union fv(G), C)
-
-(all tested before quantification).
-That is, all the type variables in Cq must be fixed by the the variables
-in the environment, or by the variables in the type.
-
-Notice that we union before calling oclose.  Here's an example:
-
-	class J a b c | a b -> c
-	fv(G) = {a}
-
-Is this ambiguous?
-	forall b c. (J a b c) => b -> b
-
-Only if we union {a} from G with {b} from T before using oclose,
-do we see that c is fixed.
-
-It's a bit vague exactly which C we should use for this oclose call.  If we
-don't fix enough variables we might complain when we shouldn't (see
-the above nasty example).  Nothing will be perfect.  That's why we can
-only issue a warning.
-
-
-Can we ever be *certain* about ambiguity?  Yes: if there's a constraint
-
-	c in C such that fv(c) intersect (fv(G) union fv(T)) = EMPTY
-
-then c is a "bubble"; there's no way it can ever improve, and it's
-certainly ambiguous.  UNLESS it is a constant (sigh).  And what about
-the nasty example?
-
-	class K x
-	class H x y | x -> y
-	instance H x y => K (x,y)
-
-Is this type ambiguous?
-	forall a b. (K (a,b), Eq b) => a -> a
-
-Urk.  The (Eq b) looks "definitely ambiguous" but it isn't.  What we are after
-is a "bubble" that's a set of constraints
-
-	Cq = Ca union Cq'  st  fv(Ca) intersect (fv(Cq') union fv(T) union fv(G)) = EMPTY
-
-Hence another idea.  To decide Q start with fv(T) and grow it
-by transitive closure in Cq (no functional dependencies involved).
-Now partition Cq using Q, leaving the definitely-ambiguous and probably-ok.
-The definitely-ambiguous can then float out, and get smashed at top level
-(which squashes out the constants, like Eq (T a) above)
-
-
-	--------------------------------------
-		Notes on principal types
-	--------------------------------------
-
-    class C a where
-      op :: a -> a
-
-    f x = let g y = op (y::Int) in True
-
-Here the principal type of f is (forall a. a->a)
-but we'll produce the non-principal type
-    f :: forall a. C Int => a -> a
-
-
-	--------------------------------------
-	The need for forall's in constraints
-	--------------------------------------
-
-[Exchange on Haskell Cafe 5/6 Dec 2000]
-
-  class C t where op :: t -> Bool
-  instance C [t] where op x = True
-
-  p y = (let f :: c -> Bool; f x = op (y >> return x) in f, y ++ [])
-  q y = (y ++ [], let f :: c -> Bool; f x = op (y >> return x) in f)
-
-The definitions of p and q differ only in the order of the components in
-the pair on their right-hand sides.  And yet:
-
-  ghc and "Typing Haskell in Haskell" reject p, but accept q;
-  Hugs rejects q, but accepts p;
-  hbc rejects both p and q;
-  nhc98 ... (Malcolm, can you fill in the blank for us!).
-
-The type signature for f forces context reduction to take place, and
-the results of this depend on whether or not the type of y is known,
-which in turn depends on which component of the pair the type checker
-analyzes first.  
-
-Solution: if y::m a, float out the constraints
-	Monad m, forall c. C (m c)
-When m is later unified with [], we can solve both constraints.
-
-
-	--------------------------------------
-		Notes on implicit parameters
-	--------------------------------------
-
-Question 1: can we "inherit" implicit parameters
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider this:
-
-	f x = (x::Int) + ?y
-
-where f is *not* a top-level binding.
-From the RHS of f we'll get the constraint (?y::Int).
-There are two types we might infer for f:
-
-	f :: Int -> Int
-
-(so we get ?y from the context of f's definition), or
-
-	f :: (?y::Int) => Int -> Int
-
-At first you might think the first was better, becuase then
-?y behaves like a free variable of the definition, rather than
-having to be passed at each call site.  But of course, the WHOLE
-IDEA is that ?y should be passed at each call site (that's what
-dynamic binding means) so we'd better infer the second.
-
-BOTTOM LINE: when *inferring types* you *must* quantify 
-over implicit parameters. See the predicate isFreeWhenInferring.
-
-
-Question 2: type signatures
-~~~~~~~~~~~~~~~~~~~~~~~~~~~
-BUT WATCH OUT: When you supply a type signature, we can't force you
-to quantify over implicit parameters.  For example:
-
-	(?x + 1) :: Int
-
-This is perfectly reasonable.  We do not want to insist on
-
-	(?x + 1) :: (?x::Int => Int)
-
-That would be silly.  Here, the definition site *is* the occurrence site,
-so the above strictures don't apply.  Hence the difference between
-tcSimplifyCheck (which *does* allow implicit paramters to be inherited)
-and tcSimplifyCheckBind (which does not).
-
-What about when you supply a type signature for a binding?
-Is it legal to give the following explicit, user type 
-signature to f, thus:
-
-	f :: Int -> Int
-	f x = (x::Int) + ?y
-
-At first sight this seems reasonable, but it has the nasty property
-that adding a type signature changes the dynamic semantics.
-Consider this:
-
-	(let f x = (x::Int) + ?y
- 	 in (f 3, f 3 with ?y=5))  with ?y = 6
-
-		returns (3+6, 3+5)
-vs
-	(let f :: Int -> Int
-	     f x = x + ?y
-	 in (f 3, f 3 with ?y=5))  with ?y = 6
-
-		returns (3+6, 3+6)
-
-Indeed, simply inlining f (at the Haskell source level) would change the
-dynamic semantics.
-
-Nevertheless, as Launchbury says (email Oct 01) we can't really give the
-semantics for a Haskell program without knowing its typing, so if you 
-change the typing you may change the semantics.
-
-To make things consistent in all cases where we are *checking* against
-a supplied signature (as opposed to inferring a type), we adopt the
-rule: 
-
-	a signature does not need to quantify over implicit params.
-
-[This represents a (rather marginal) change of policy since GHC 5.02,
-which *required* an explicit signature to quantify over all implicit
-params for the reasons mentioned above.]
-
-But that raises a new question.  Consider 
-
-	Given (signature)	?x::Int
-	Wanted (inferred)	?x::Int, ?y::Bool
-
-Clearly we want to discharge the ?x and float the ?y out.  But
-what is the criterion that distinguishes them?  Clearly it isn't
-what free type variables they have.  The Right Thing seems to be
-to float a constraint that
-	neither mentions any of the quantified type variables
-	nor any of the quantified implicit parameters
-
-See the predicate isFreeWhenChecking.
-
-
-Question 3: monomorphism
-~~~~~~~~~~~~~~~~~~~~~~~~
-There's a nasty corner case when the monomorphism restriction bites:
-
-	z = (x::Int) + ?y
-
-The argument above suggests that we *must* generalise
-over the ?y parameter, to get
-	z :: (?y::Int) => Int,
-but the monomorphism restriction says that we *must not*, giving
-	z :: Int.
-Why does the momomorphism restriction say this?  Because if you have
-
-	let z = x + ?y in z+z
-
-you might not expect the addition to be done twice --- but it will if
-we follow the argument of Question 2 and generalise over ?y.
-
-
-Question 4: top level
-~~~~~~~~~~~~~~~~~~~~~
-At the top level, monomorhism makes no sense at all.
-
-    module Main where
-	main = let ?x = 5 in print foo
-
-	foo = woggle 3
-
-	woggle :: (?x :: Int) => Int -> Int
-	woggle y = ?x + y
-
-We definitely don't want (foo :: Int) with a top-level implicit parameter
-(?x::Int) becuase there is no way to bind it.  
-
-
-Possible choices
-~~~~~~~~~~~~~~~~
-(A) Always generalise over implicit parameters
-    Bindings that fall under the monomorphism restriction can't
-	be generalised
-
-    Consequences:
-	* Inlining remains valid
-	* No unexpected loss of sharing
-	* But simple bindings like
-		z = ?y + 1
-	  will be rejected, unless you add an explicit type signature
-	  (to avoid the monomorphism restriction)
-		z :: (?y::Int) => Int
-		z = ?y + 1
-	  This seems unacceptable
-
-(B) Monomorphism restriction "wins"
-    Bindings that fall under the monomorphism restriction can't
-	be generalised
-    Always generalise over implicit parameters *except* for bindings
-	that fall under the monomorphism restriction
-
-    Consequences
-	* Inlining isn't valid in general
-	* No unexpected loss of sharing
-	* Simple bindings like
-		z = ?y + 1
-	  accepted (get value of ?y from binding site)
-
-(C) Always generalise over implicit parameters
-    Bindings that fall under the monomorphism restriction can't
-	be generalised, EXCEPT for implicit parameters
-    Consequences
-	* Inlining remains valid
-	* Unexpected loss of sharing (from the extra generalisation)
-	* Simple bindings like
-		z = ?y + 1
-	  accepted (get value of ?y from occurrence sites)
-
-
-Discussion
-~~~~~~~~~~
-None of these choices seems very satisfactory.  But at least we should
-decide which we want to do.
-
-It's really not clear what is the Right Thing To Do.  If you see
-
-	z = (x::Int) + ?y
-
-would you expect the value of ?y to be got from the *occurrence sites*
-of 'z', or from the valuue of ?y at the *definition* of 'z'?  In the
-case of function definitions, the answer is clearly the former, but
-less so in the case of non-fucntion definitions.   On the other hand,
-if we say that we get the value of ?y from the definition site of 'z',
-then inlining 'z' might change the semantics of the program.
-
-Choice (C) really says "the monomorphism restriction doesn't apply
-to implicit parameters".  Which is fine, but remember that every
-innocent binding 'x = ...' that mentions an implicit parameter in
-the RHS becomes a *function* of that parameter, called at each
-use of 'x'.  Now, the chances are that there are no intervening 'with'
-clauses that bind ?y, so a decent compiler should common up all
-those function calls.  So I think I strongly favour (C).  Indeed,
-one could make a similar argument for abolishing the monomorphism
-restriction altogether.
-
-BOTTOM LINE: we choose (B) at present.  See tcSimplifyRestricted
-
-
-
-%************************************************************************
-%*									*
-\subsection{tcSimplifyInfer}
-%*									*
-%************************************************************************
-
-tcSimplify is called when we *inferring* a type.  Here's the overall game plan:
-
-    1. Compute Q = grow( fvs(T), C )
-
-    2. Partition C based on Q into Ct and Cq.  Notice that ambiguous
-       predicates will end up in Ct; we deal with them at the top level
-
-    3. Try improvement, using functional dependencies
-
-    4. If Step 3 did any unification, repeat from step 1
-       (Unification can change the result of 'grow'.)
-
-Note: we don't reduce dictionaries in step 2.  For example, if we have
-Eq (a,b), we don't simplify to (Eq a, Eq b).  So Q won't be different
-after step 2.  However note that we may therefore quantify over more
-type variables than we absolutely have to.
-
-For the guts, we need a loop, that alternates context reduction and
-improvement with unification.  E.g. Suppose we have
-
-	class C x y | x->y where ...
-
-and tcSimplify is called with:
-	(C Int a, C Int b)
-Then improvement unifies a with b, giving
-	(C Int a, C Int a)
-
-If we need to unify anything, we rattle round the whole thing all over
-again.
-
-
-\begin{code}
-tcSimplifyInfer
-	:: SDoc
-	-> TcTyVarSet		-- fv(T); type vars
-	-> [Inst]		-- Wanted
-	-> TcM ([TcTyVar],	-- Tyvars to quantify (zonked)
-		TcDictBinds,	-- Bindings
-		[TcId])		-- Dict Ids that must be bound here (zonked)
-	-- Any free (escaping) Insts are tossed into the environment
-\end{code}
-
-
-\begin{code}
-tcSimplifyInfer doc tau_tvs wanted_lie
-  = inferLoop doc (varSetElems tau_tvs)
-	      wanted_lie		`thenM` \ (qtvs, frees, binds, irreds) ->
-
-    extendLIEs frees							`thenM_`
-    returnM (qtvs, binds, map instToId irreds)
-
-inferLoop doc tau_tvs wanteds
-  =   	-- Step 1
-    zonkTcTyVarsAndFV tau_tvs		`thenM` \ tau_tvs' ->
-    mappM zonkInst wanteds		`thenM` \ wanteds' ->
-    tcGetGlobalTyVars			`thenM` \ gbl_tvs ->
-    let
- 	preds = fdPredsOfInsts wanteds'
-	qtvs  = grow preds tau_tvs' `minusVarSet` oclose preds gbl_tvs
-
-	try_me inst
-	  | isFreeWhenInferring qtvs inst = Free
-	  | isClassDict inst 		  = DontReduceUnlessConstant	-- Dicts
-	  | otherwise	    		  = ReduceMe NoSCs		-- Lits and Methods
-    in
-    traceTc (text "infloop" <+> vcat [ppr tau_tvs', ppr wanteds', ppr preds, 
-				      ppr (grow preds tau_tvs'), ppr qtvs])	`thenM_`
-		-- Step 2
-    reduceContext doc try_me [] wanteds'    `thenM` \ (no_improvement, frees, binds, irreds) ->
-
-		-- Step 3
-    if no_improvement then
-	returnM (varSetElems qtvs, frees, binds, irreds)
-    else
-	-- If improvement did some unification, we go round again.  There
-	-- are two subtleties:
-	--   a) We start again with irreds, not wanteds
-	-- 	Using an instance decl might have introduced a fresh type variable
-	--	which might have been unified, so we'd get an infinite loop
-	--	if we started again with wanteds!  See example [LOOP]
-	--
-	--   b) It's also essential to re-process frees, because unification
-	--      might mean that a type variable that looked free isn't now.
-	--
-	-- Hence the (irreds ++ frees)
-
-	-- However, NOTICE that when we are done, we might have some bindings, but
-	-- the final qtvs might be empty.  See [NO TYVARS] below.
-				
-	inferLoop doc tau_tvs (irreds ++ frees)	`thenM` \ (qtvs1, frees1, binds1, irreds1) ->
-	returnM (qtvs1, frees1, binds `unionBags` binds1, irreds1)
-\end{code}
-
-Example [LOOP]
-
-	class If b t e r | b t e -> r
-	instance If T t e t
-	instance If F t e e
-	class Lte a b c | a b -> c where lte :: a -> b -> c
-	instance Lte Z b T
-	instance (Lte a b l,If l b a c) => Max a b c
-
-Wanted:	Max Z (S x) y
-
-Then we'll reduce using the Max instance to:
-	(Lte Z (S x) l, If l (S x) Z y)
-and improve by binding l->T, after which we can do some reduction
-on both the Lte and If constraints.  What we *can't* do is start again
-with (Max Z (S x) y)!
-
-[NO TYVARS]
-
-	class Y a b | a -> b where
-	    y :: a -> X b
-	
-	instance Y [[a]] a where
-	    y ((x:_):_) = X x
-	
-	k :: X a -> X a -> X a
-
-	g :: Num a => [X a] -> [X a]
-	g xs = h xs
-	    where
-	    h ys = ys ++ map (k (y [[0]])) xs
-
-The excitement comes when simplifying the bindings for h.  Initially
-try to simplify {y @ [[t1]] t2, 0 @ t1}, with initial qtvs = {t2}.
-From this we get t1:=:t2, but also various bindings.  We can't forget
-the bindings (because of [LOOP]), but in fact t1 is what g is
-polymorphic in.  
-
-The net effect of [NO TYVARS] 
-
-\begin{code}
-isFreeWhenInferring :: TyVarSet -> Inst	-> Bool
-isFreeWhenInferring qtvs inst
-  =  isFreeWrtTyVars qtvs inst		-- Constrains no quantified vars
-  && isInheritableInst inst		-- And no implicit parameter involved
-					-- (see "Notes on implicit parameters")
-
-isFreeWhenChecking :: TyVarSet	-- Quantified tyvars
-	 	   -> NameSet	-- Quantified implicit parameters
-		   -> Inst -> Bool
-isFreeWhenChecking qtvs ips inst
-  =  isFreeWrtTyVars qtvs inst
-  && isFreeWrtIPs    ips inst
-
-isFreeWrtTyVars qtvs inst = not (tyVarsOfInst inst `intersectsVarSet` qtvs)
-isFreeWrtIPs     ips inst = not (any (`elemNameSet` ips) (ipNamesOfInst inst))
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{tcSimplifyCheck}
-%*									*
-%************************************************************************
-
-@tcSimplifyCheck@ is used when we know exactly the set of variables
-we are going to quantify over.  For example, a class or instance declaration.
-
-\begin{code}
-tcSimplifyCheck
-	 :: SDoc
-	 -> [TcTyVar]		-- Quantify over these
-	 -> [Inst]		-- Given
-	 -> [Inst]		-- Wanted
-	 -> TcM TcDictBinds	-- Bindings
-
--- tcSimplifyCheck is used when checking expression type signatures,
--- class decls, instance decls etc.
---
--- NB: tcSimplifyCheck does not consult the
---	global type variables in the environment; so you don't
---	need to worry about setting them before calling tcSimplifyCheck
-tcSimplifyCheck doc qtvs givens wanted_lie
-  = ASSERT( all isSkolemTyVar qtvs )
-    do	{ (qtvs', frees, binds) <- tcSimplCheck doc get_qtvs AddSCs givens wanted_lie
-	; extendLIEs frees
-	; return binds }
-  where
---  get_qtvs = zonkTcTyVarsAndFV qtvs
-    get_qtvs = return (mkVarSet qtvs)	-- All skolems
-
-
--- tcSimplifyInferCheck is used when we know the constraints we are to simplify
--- against, but we don't know the type variables over which we are going to quantify.
--- This happens when we have a type signature for a mutually recursive group
-tcSimplifyInferCheck
-	 :: SDoc
-	 -> TcTyVarSet		-- fv(T)
-	 -> [Inst]		-- Given
-	 -> [Inst]		-- Wanted
-	 -> TcM ([TcTyVar],	-- Variables over which to quantify
-		 TcDictBinds)	-- Bindings
-
-tcSimplifyInferCheck doc tau_tvs givens wanted_lie
-  = do	{ (qtvs', frees, binds) <- tcSimplCheck doc get_qtvs AddSCs givens wanted_lie
-	; extendLIEs frees
-	; return (qtvs', binds) }
-  where
-	-- Figure out which type variables to quantify over
-	-- You might think it should just be the signature tyvars,
-	-- but in bizarre cases you can get extra ones
-	-- 	f :: forall a. Num a => a -> a
-	--	f x = fst (g (x, head [])) + 1
-	--	g a b = (b,a)
-	-- Here we infer g :: forall a b. a -> b -> (b,a)
-	-- We don't want g to be monomorphic in b just because
-	-- f isn't quantified over b.
-    all_tvs = varSetElems (tau_tvs `unionVarSet` tyVarsOfInsts givens)
-
-    get_qtvs = zonkTcTyVarsAndFV all_tvs	`thenM` \ all_tvs' ->
-	       tcGetGlobalTyVars		`thenM` \ gbl_tvs ->
-	       let
-	          qtvs = all_tvs' `minusVarSet` gbl_tvs
-			-- We could close gbl_tvs, but its not necessary for
-			-- soundness, and it'll only affect which tyvars, not which
-			-- dictionaries, we quantify over
-	       in
-	       returnM qtvs
-\end{code}
-
-Here is the workhorse function for all three wrappers.
-
-\begin{code}
-tcSimplCheck doc get_qtvs want_scs givens wanted_lie
-  = do	{ (qtvs, frees, binds, irreds) <- check_loop givens wanted_lie
-
-		-- Complain about any irreducible ones
-	; if not (null irreds)
-	  then do { givens' <- mappM zonkInst given_dicts_and_ips
-		  ; groupErrs (addNoInstanceErrs (Just doc) givens') irreds }
-	  else return ()
-
-	; returnM (qtvs, frees, binds) }
-  where
-    given_dicts_and_ips = filter (not . isMethod) givens
-	-- For error reporting, filter out methods, which are 
-	-- only added to the given set as an optimisation
-
-    ip_set = mkNameSet (ipNamesOfInsts givens)
-
-    check_loop givens wanteds
-      =		-- Step 1
-    	mappM zonkInst givens	`thenM` \ givens' ->
-    	mappM zonkInst wanteds	`thenM` \ wanteds' ->
-    	get_qtvs 		`thenM` \ qtvs' ->
-
- 		    -- Step 2
-    	let
- 	    -- When checking against a given signature we always reduce
- 	    -- until we find a match against something given, or can't reduce
- 	    try_me inst | isFreeWhenChecking qtvs' ip_set inst = Free
- 			| otherwise  			       = ReduceMe want_scs
-    	in
-    	reduceContext doc try_me givens' wanteds'	`thenM` \ (no_improvement, frees, binds, irreds) ->
-
- 		    -- Step 3
-    	if no_improvement then
- 	    returnM (varSetElems qtvs', frees, binds, irreds)
-    	else
- 	    check_loop givens' (irreds ++ frees) 	`thenM` \ (qtvs', frees1, binds1, irreds1) ->
- 	    returnM (qtvs', frees1, binds `unionBags` binds1, irreds1)
-\end{code}
-
-
-%************************************************************************
-%*									*
-		tcSimplifySuperClasses
-%*									*
-%************************************************************************
-
-Note [SUPERCLASS-LOOP 1]
-~~~~~~~~~~~~~~~~~~~~~~~~
-We have to be very, very careful when generating superclasses, lest we
-accidentally build a loop. Here's an example:
-
-  class S a
-
-  class S a => C a where { opc :: a -> a }
-  class S b => D b where { opd :: b -> b }
-  
-  instance C Int where
-     opc = opd
-  
-  instance D Int where
-     opd = opc
-
-From (instance C Int) we get the constraint set {ds1:S Int, dd:D Int}
-Simplifying, we may well get:
-	$dfCInt = :C ds1 (opd dd)
-	dd  = $dfDInt
-	ds1 = $p1 dd
-Notice that we spot that we can extract ds1 from dd.  
-
-Alas!  Alack! We can do the same for (instance D Int):
-
-	$dfDInt = :D ds2 (opc dc)
-	dc  = $dfCInt
-	ds2 = $p1 dc
-
-And now we've defined the superclass in terms of itself.
-
-Solution: never generate a superclass selectors at all when
-satisfying the superclass context of an instance declaration.
-
-Two more nasty cases are in
-	tcrun021
-	tcrun033
-
-\begin{code}
-tcSimplifySuperClasses qtvs givens sc_wanteds
-  = ASSERT( all isSkolemTyVar qtvs )
-    do	{ (_, frees, binds1) <- tcSimplCheck doc get_qtvs NoSCs givens sc_wanteds
-	; binds2	     <- tc_simplify_top doc False NoSCs frees
-	; return (binds1 `unionBags` binds2) }
-  where
-    get_qtvs = return (mkVarSet qtvs)
-    doc = ptext SLIT("instance declaration superclass context")
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{tcSimplifyRestricted}
-%*									*
-%************************************************************************
-
-tcSimplifyRestricted infers which type variables to quantify for a 
-group of restricted bindings.  This isn't trivial.
-
-Eg1:	id = \x -> x
-	We want to quantify over a to get id :: forall a. a->a
-	
-Eg2:	eq = (==)
-	We do not want to quantify over a, because there's an Eq a 
-	constraint, so we get eq :: a->a->Bool	(notice no forall)
-
-So, assume:
-	RHS has type 'tau', whose free tyvars are tau_tvs
-	RHS has constraints 'wanteds'
-
-Plan A (simple)
-  Quantify over (tau_tvs \ ftvs(wanteds))
-  This is bad. The constraints may contain (Monad (ST s))
-  where we have 	instance Monad (ST s) where...
-  so there's no need to be monomorphic in s!
-
-  Also the constraint might be a method constraint,
-  whose type mentions a perfectly innocent tyvar:
-	  op :: Num a => a -> b -> a
-  Here, b is unconstrained.  A good example would be
-	foo = op (3::Int)
-  We want to infer the polymorphic type
-	foo :: forall b. b -> b
-
-
-Plan B (cunning, used for a long time up to and including GHC 6.2)
-  Step 1: Simplify the constraints as much as possible (to deal 
-  with Plan A's problem).  Then set
-	qtvs = tau_tvs \ ftvs( simplify( wanteds ) )
-
-  Step 2: Now simplify again, treating the constraint as 'free' if 
-  it does not mention qtvs, and trying to reduce it otherwise.
-  The reasons for this is to maximise sharing.
-
-  This fails for a very subtle reason.  Suppose that in the Step 2
-  a constraint (Foo (Succ Zero) (Succ Zero) b) gets thrown upstairs as 'free'.
-  In the Step 1 this constraint might have been simplified, perhaps to
-  (Foo Zero Zero b), AND THEN THAT MIGHT BE IMPROVED, to bind 'b' to 'T'.
-  This won't happen in Step 2... but that in turn might prevent some other
-  constraint (Baz [a] b) being simplified (e.g. via instance Baz [a] T where {..}) 
-  and that in turn breaks the invariant that no constraints are quantified over.
-
-  Test typecheck/should_compile/tc177 (which failed in GHC 6.2) demonstrates
-  the problem.
-
-
-Plan C (brutal)
-  Step 1: Simplify the constraints as much as possible (to deal 
-  with Plan A's problem).  Then set
-	qtvs = tau_tvs \ ftvs( simplify( wanteds ) )
-  Return the bindings from Step 1.
-  
-
-A note about Plan C (arising from "bug" reported by George Russel March 2004)
-Consider this:
-
-      instance (HasBinary ty IO) => HasCodedValue ty
-
-      foo :: HasCodedValue a => String -> IO a
-
-      doDecodeIO :: HasCodedValue a => () -> () -> IO a
-      doDecodeIO codedValue view  
-        = let { act = foo "foo" } in  act
-
-You might think this should work becuase the call to foo gives rise to a constraint
-(HasCodedValue t), which can be satisfied by the type sig for doDecodeIO.  But the
-restricted binding act = ... calls tcSimplifyRestricted, and PlanC simplifies the
-constraint using the (rather bogus) instance declaration, and now we are stuffed.
-
-I claim this is not really a bug -- but it bit Sergey as well as George.  So here's
-plan D
-
-
-Plan D (a variant of plan B)
-  Step 1: Simplify the constraints as much as possible (to deal 
-  with Plan A's problem), BUT DO NO IMPROVEMENT.  Then set
-	qtvs = tau_tvs \ ftvs( simplify( wanteds ) )
-
-  Step 2: Now simplify again, treating the constraint as 'free' if 
-  it does not mention qtvs, and trying to reduce it otherwise.
-
-  The point here is that it's generally OK to have too few qtvs; that is,
-  to make the thing more monomorphic than it could be.  We don't want to
-  do that in the common cases, but in wierd cases it's ok: the programmer
-  can always add a signature.  
-
-  Too few qtvs => too many wanteds, which is what happens if you do less
-  improvement.
-
-
-\begin{code}
-tcSimplifyRestricted 	-- Used for restricted binding groups
-			-- i.e. ones subject to the monomorphism restriction
-	:: SDoc
-	-> TopLevelFlag
-	-> [Name]		-- Things bound in this group
-	-> TcTyVarSet		-- Free in the type of the RHSs
-	-> [Inst]		-- Free in the RHSs
-	-> TcM ([TcTyVar],	-- Tyvars to quantify (zonked)
-		TcDictBinds)	-- Bindings
-	-- tcSimpifyRestricted returns no constraints to
-	-- quantify over; by definition there are none.
-	-- They are all thrown back in the LIE
-
-tcSimplifyRestricted doc top_lvl bndrs tau_tvs wanteds
-	-- Zonk everything in sight
-  = mappM zonkInst wanteds			`thenM` \ wanteds' ->
-    zonkTcTyVarsAndFV (varSetElems tau_tvs)	`thenM` \ tau_tvs' ->
-    tcGetGlobalTyVars				`thenM` \ gbl_tvs' ->
-
-   	-- 'reduceMe': Reduce as far as we can.  Don't stop at
-	-- dicts; the idea is to get rid of as many type
-	-- variables as possible, and we don't want to stop
-	-- at (say) Monad (ST s), because that reduces
-	-- immediately, with no constraint on s.
-	--
-	-- BUT do no improvement!  See Plan D above
-    reduceContextWithoutImprovement 
-	doc reduceMe wanteds' 		`thenM` \ (_frees, _binds, constrained_dicts) ->
-
-	-- Next, figure out the tyvars we will quantify over
-    let
-	constrained_tvs = tyVarsOfInsts constrained_dicts
-	qtvs = (tau_tvs' `minusVarSet` oclose (fdPredsOfInsts constrained_dicts) gbl_tvs')
-			 `minusVarSet` constrained_tvs
-    in
-    traceTc (text "tcSimplifyRestricted" <+> vcat [
-		pprInsts wanteds, pprInsts _frees, pprInsts constrained_dicts,
-		ppr _binds,
-		ppr constrained_tvs, ppr tau_tvs', ppr qtvs ])	`thenM_`
-
-	-- The first step may have squashed more methods than
-	-- necessary, so try again, this time more gently, knowing the exact
-	-- set of type variables to quantify over.
-	--
-	-- We quantify only over constraints that are captured by qtvs;
-	-- these will just be a subset of non-dicts.  This in contrast
-	-- to normal inference (using isFreeWhenInferring) in which we quantify over
-	-- all *non-inheritable* constraints too.  This implements choice
-	-- (B) under "implicit parameter and monomorphism" above.
-	--
-	-- Remember that we may need to do *some* simplification, to
-	-- (for example) squash {Monad (ST s)} into {}.  It's not enough
-	-- just to float all constraints
-	--
-	-- At top level, we *do* squash methods becuase we want to 
-	-- expose implicit parameters to the test that follows
-    let
-	is_nested_group = isNotTopLevel top_lvl
-        try_me inst | isFreeWrtTyVars qtvs inst,
-		      (is_nested_group || isDict inst) = Free
-	            | otherwise  		       = ReduceMe AddSCs
-    in
-    reduceContextWithoutImprovement 
-	doc try_me wanteds' 		`thenM` \ (frees, binds, irreds) ->
-    ASSERT( null irreds )
-
-	-- See "Notes on implicit parameters, Question 4: top level"
-    if is_nested_group then
-	extendLIEs frees	`thenM_`
-        returnM (varSetElems qtvs, binds)
-    else
-	let
-    	    (non_ips, bad_ips) = partition isClassDict frees
-	in    
-	addTopIPErrs bndrs bad_ips	`thenM_`
-	extendLIEs non_ips		`thenM_`
-        returnM (varSetElems qtvs, binds)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{tcSimplifyToDicts}
-%*									*
-%************************************************************************
-
-On the LHS of transformation rules we only simplify methods and constants,
-getting dictionaries.  We want to keep all of them unsimplified, to serve
-as the available stuff for the RHS of the rule.
-
-The same thing is used for specialise pragmas. Consider
-
-	f :: Num a => a -> a
-	{-# SPECIALISE f :: Int -> Int #-}
-	f = ...
-
-The type checker generates a binding like:
-
-	f_spec = (f :: Int -> Int)
-
-and we want to end up with
-
-	f_spec = _inline_me_ (f Int dNumInt)
-
-But that means that we must simplify the Method for f to (f Int dNumInt)!
-So tcSimplifyToDicts squeezes out all Methods.
-
-IMPORTANT NOTE:  we *don't* want to do superclass commoning up.  Consider
-
-	fromIntegral :: (Integral a, Num b) => a -> b
-	{-# RULES "foo"  fromIntegral = id :: Int -> Int #-}
-
-Here, a=b=Int, and Num Int is a superclass of Integral Int. But we *dont*
-want to get
-
-	forall dIntegralInt.
-	fromIntegral Int Int dIntegralInt (scsel dIntegralInt) = id Int
-
-because the scsel will mess up RULE matching.  Instead we want
-
-	forall dIntegralInt, dNumInt.
-	fromIntegral Int Int dIntegralInt dNumInt = id Int
-
-Hence "WithoutSCs"
-
-\begin{code}
-tcSimplifyToDicts :: [Inst] -> TcM (TcDictBinds)
-tcSimplifyToDicts wanteds
-  = simpleReduceLoop doc try_me wanteds		`thenM` \ (frees, binds, irreds) ->
-	-- Since try_me doesn't look at types, we don't need to
-	-- do any zonking, so it's safe to call reduceContext directly
-    ASSERT( null frees )
-    extendLIEs irreds		`thenM_`
-    returnM binds
-
-  where
-    doc = text "tcSimplifyToDicts"
-
-	-- Reduce methods and lits only; stop as soon as we get a dictionary
-    try_me inst	| isDict inst = KeepDictWithoutSCs	-- See notes above re "WithoutSCs"
-		| otherwise   = ReduceMe NoSCs
-\end{code}
-
-
-
-tcSimplifyBracket is used when simplifying the constraints arising from
-a Template Haskell bracket [| ... |].  We want to check that there aren't
-any constraints that can't be satisfied (e.g. Show Foo, where Foo has no
-Show instance), but we aren't otherwise interested in the results.
-Nor do we care about ambiguous dictionaries etc.  We will type check
-this bracket again at its usage site.
-
-\begin{code}
-tcSimplifyBracket :: [Inst] -> TcM ()
-tcSimplifyBracket wanteds
-  = simpleReduceLoop doc reduceMe wanteds	`thenM_`
-    returnM ()
-  where
-    doc = text "tcSimplifyBracket"
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Filtering at a dynamic binding}
-%*									*
-%************************************************************************
-
-When we have
-	let ?x = R in B
-
-we must discharge all the ?x constraints from B.  We also do an improvement
-step; if we have ?x::t1 and ?x::t2 we must unify t1, t2.
-
-Actually, the constraints from B might improve the types in ?x. For example
-
-	f :: (?x::Int) => Char -> Char
-	let ?x = 3 in f 'c'
-
-then the constraint (?x::Int) arising from the call to f will
-force the binding for ?x to be of type Int.
-
-\begin{code}
-tcSimplifyIPs :: [Inst]		-- The implicit parameters bound here
-	      -> [Inst]		-- Wanted
-	      -> TcM TcDictBinds
-tcSimplifyIPs given_ips wanteds
-  = simpl_loop given_ips wanteds	`thenM` \ (frees, binds) ->
-    extendLIEs frees			`thenM_`
-    returnM binds
-  where
-    doc	     = text "tcSimplifyIPs" <+> ppr given_ips
-    ip_set   = mkNameSet (ipNamesOfInsts given_ips)
-
-	-- Simplify any methods that mention the implicit parameter
-    try_me inst | isFreeWrtIPs ip_set inst = Free
-		| otherwise		   = ReduceMe NoSCs
-
-    simpl_loop givens wanteds
-      = mappM zonkInst givens		`thenM` \ givens' ->
-        mappM zonkInst wanteds		`thenM` \ wanteds' ->
-
-        reduceContext doc try_me givens' wanteds'    `thenM` \ (no_improvement, frees, binds, irreds) ->
-
-        if no_improvement then
-	    ASSERT( null irreds )
-	    returnM (frees, binds)
-	else
-	    simpl_loop givens' (irreds ++ frees)	`thenM` \ (frees1, binds1) ->
-	    returnM (frees1, binds `unionBags` binds1)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[binds-for-local-funs]{@bindInstsOfLocalFuns@}
-%*									*
-%************************************************************************
-
-When doing a binding group, we may have @Insts@ of local functions.
-For example, we might have...
-\begin{verbatim}
-let f x = x + 1	    -- orig local function (overloaded)
-    f.1 = f Int	    -- two instances of f
-    f.2 = f Float
- in
-    (f.1 5, f.2 6.7)
-\end{verbatim}
-The point is: we must drop the bindings for @f.1@ and @f.2@ here,
-where @f@ is in scope; those @Insts@ must certainly not be passed
-upwards towards the top-level.	If the @Insts@ were binding-ified up
-there, they would have unresolvable references to @f@.
-
-We pass in an @init_lie@ of @Insts@ and a list of locally-bound @Ids@.
-For each method @Inst@ in the @init_lie@ that mentions one of the
-@Ids@, we create a binding.  We return the remaining @Insts@ (in an
-@LIE@), as well as the @HsBinds@ generated.
-
-\begin{code}
-bindInstsOfLocalFuns ::	[Inst] -> [TcId] -> TcM TcDictBinds
--- Simlifies only MethodInsts, and generate only bindings of form 
---	fm = f tys dicts
--- We're careful not to even generate bindings of the form
---	d1 = d2
--- You'd think that'd be fine, but it interacts with what is
--- arguably a bug in Match.tidyEqnInfo (see notes there)
-
-bindInstsOfLocalFuns wanteds local_ids
-  | null overloaded_ids
-	-- Common case
-  = extendLIEs wanteds		`thenM_`
-    returnM emptyLHsBinds
-
-  | otherwise
-  = simpleReduceLoop doc try_me for_me	`thenM` \ (frees, binds, irreds) ->
-    ASSERT( null irreds )
-    extendLIEs not_for_me	`thenM_`
-    extendLIEs frees		`thenM_`
-    returnM binds
-  where
-    doc		     = text "bindInsts" <+> ppr local_ids
-    overloaded_ids   = filter is_overloaded local_ids
-    is_overloaded id = isOverloadedTy (idType id)
-    (for_me, not_for_me) = partition (isMethodFor overloaded_set) wanteds
-
-    overloaded_set = mkVarSet overloaded_ids	-- There can occasionally be a lot of them
-						-- so it's worth building a set, so that
-						-- lookup (in isMethodFor) is faster
-    try_me inst | isMethod inst = ReduceMe NoSCs
-		| otherwise	= Free
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Data types for the reduction mechanism}
-%*									*
-%************************************************************************
-
-The main control over context reduction is here
-
-\begin{code}
-data WhatToDo
- = ReduceMe WantSCs	-- Try to reduce this
-			-- If there's no instance, behave exactly like
-			-- DontReduce: add the inst to the irreductible ones, 
-			-- but don't produce an error message of any kind.
-			-- It might be quite legitimate such as (Eq a)!
-
- | KeepDictWithoutSCs	-- Return as irreducible; don't add its superclasses
-			-- Rather specialised: see notes with tcSimplifyToDicts
-
- | DontReduceUnlessConstant	-- Return as irreducible unless it can
-				-- be reduced to a constant in one step
-
- | Free			  -- Return as free
-
-reduceMe :: Inst -> WhatToDo
-reduceMe inst = ReduceMe AddSCs
-
-data WantSCs = NoSCs | AddSCs	-- Tells whether we should add the superclasses
-				-- of a predicate when adding it to the avails
-	-- The reason for this flag is entirely the super-class loop problem
-	-- Note [SUPER-CLASS LOOP 1]
-\end{code}
-
-
-
-\begin{code}
-type Avails = FiniteMap Inst Avail
-emptyAvails = emptyFM
-
-data Avail
-  = IsFree		-- Used for free Insts
-  | Irred		-- Used for irreducible dictionaries,
-			-- which are going to be lambda bound
-
-  | Given TcId 		-- Used for dictionaries for which we have a binding
-			-- e.g. those "given" in a signature
-	  Bool		-- True <=> actually consumed (splittable IPs only)
-
-  | Rhs 		-- Used when there is a RHS
-	(LHsExpr TcId) 	-- The RHS
-	[Inst]		-- Insts free in the RHS; we need these too
-
-  | Linear 		-- Splittable Insts only.
-	Int		-- The Int is always 2 or more; indicates how
-			-- many copies are required
-	Inst 		-- The splitter
-	Avail		-- Where the "master copy" is
-
-  | LinRhss		-- Splittable Insts only; this is used only internally
-			-- 	by extractResults, where a Linear 
-			--	is turned into an LinRhss
-	[LHsExpr TcId]	-- A supply of suitable RHSs
-
-pprAvails avails = vcat [sep [ppr inst, nest 2 (equals <+> pprAvail avail)]
-			| (inst,avail) <- fmToList avails ]
-
-instance Outputable Avail where
-    ppr = pprAvail
-
-pprAvail IsFree	       	= text "Free"
-pprAvail Irred	       	= text "Irred"
-pprAvail (Given x b)   	= text "Given" <+> ppr x <+> 
-		 	  if b then text "(used)" else empty
-pprAvail (Rhs rhs bs)   = text "Rhs" <+> ppr rhs <+> braces (ppr bs)
-pprAvail (Linear n i a) = text "Linear" <+> ppr n <+> braces (ppr i) <+> ppr a
-pprAvail (LinRhss rhss) = text "LinRhss" <+> ppr rhss
-\end{code}
-
-Extracting the bindings from a bunch of Avails.
-The bindings do *not* come back sorted in dependency order.
-We assume that they'll be wrapped in a big Rec, so that the
-dependency analyser can sort them out later
-
-The loop startes
-\begin{code}
-extractResults :: Avails
-	       -> [Inst]		-- Wanted
-	       -> TcM (TcDictBinds, 	-- Bindings
-			[Inst],		-- Irreducible ones
-			[Inst])		-- Free ones
-
-extractResults avails wanteds
-  = go avails emptyBag [] [] wanteds
-  where
-    go avails binds irreds frees [] 
-      = returnM (binds, irreds, frees)
-
-    go avails binds irreds frees (w:ws)
-      = case lookupFM avails w of
-	  Nothing    -> pprTrace "Urk: extractResults" (ppr w) $
-			go avails binds irreds frees ws
-
-	  Just IsFree -> go (add_free avails w)  binds irreds     (w:frees) ws
-	  Just Irred  -> go (add_given avails w) binds (w:irreds) frees     ws
-
-	  Just (Given id _) -> go avails new_binds irreds frees ws
-			    where
-			       new_binds | id == instToId w = binds
-					 | otherwise        = addBind binds w (L (instSpan w) (HsVar id))
-		-- The sought Id can be one of the givens, via a superclass chain
-		-- and then we definitely don't want to generate an x=x binding!
-
-	  Just (Rhs rhs ws') -> go (add_given avails w) new_binds irreds frees (ws' ++ ws)
-			     where
-				new_binds = addBind binds w rhs
-
-	  Just (Linear n split_inst avail)	-- Transform Linear --> LinRhss
-	    -> get_root irreds frees avail w		`thenM` \ (irreds', frees', root_id) ->
-	       split n (instToId split_inst) root_id w	`thenM` \ (binds', rhss) ->
-	       go (addToFM avails w (LinRhss rhss))
-		  (binds `unionBags` binds')
-		  irreds' frees' (split_inst : w : ws)
-
-	  Just (LinRhss (rhs:rhss))		-- Consume one of the Rhss
-		-> go new_avails new_binds irreds frees ws
-		where		
-		   new_binds  = addBind binds w rhs
-		   new_avails = addToFM avails w (LinRhss rhss)
-
-    get_root irreds frees (Given id _) w = returnM (irreds, frees, id)
-    get_root irreds frees Irred	       w = cloneDict w	`thenM` \ w' ->
-					   returnM (w':irreds, frees, instToId w')
-    get_root irreds frees IsFree       w = cloneDict w	`thenM` \ w' ->
-					   returnM (irreds, w':frees, instToId w')
-
-    add_given avails w = addToFM avails w (Given (instToId w) True)
-
-    add_free avails w | isMethod w = avails
-		      | otherwise  = add_given avails w
-	-- NB: Hack alert!  
-	-- Do *not* replace Free by Given if it's a method.
-	-- The following situation shows why this is bad:
-	--	truncate :: forall a. RealFrac a => forall b. Integral b => a -> b
-	-- From an application (truncate f i) we get
-	--	t1 = truncate at f
-	--	t2 = t1 at i
-	-- If we have also have a second occurrence of truncate, we get
-	--	t3 = truncate at f
-	--	t4 = t3 at i
-	-- When simplifying with i,f free, we might still notice that
-	--   t1=t3; but alas, the binding for t2 (which mentions t1)
-	--   will continue to float out!
-	-- (split n i a) returns: n rhss
-	--			  auxiliary bindings
-	--			  1 or 0 insts to add to irreds
-
-
-split :: Int -> TcId -> TcId -> Inst 
-      -> TcM (TcDictBinds, [LHsExpr TcId])
--- (split n split_id root_id wanted) returns
---	* a list of 'n' expressions, all of which witness 'avail'
---	* a bunch of auxiliary bindings to support these expressions
---	* one or zero insts needed to witness the whole lot
---	  (maybe be zero if the initial Inst is a Given)
---
--- NB: 'wanted' is just a template
-
-split n split_id root_id wanted
-  = go n
-  where
-    ty      = linearInstType wanted
-    pair_ty = mkTyConApp pairTyCon [ty,ty]
-    id      = instToId wanted
-    occ     = getOccName id
-    loc     = getSrcLoc id
-    span    = instSpan wanted
-
-    go 1 = returnM (emptyBag, [L span $ HsVar root_id])
-
-    go n = go ((n+1) `div` 2)		`thenM` \ (binds1, rhss) ->
-	   expand n rhss		`thenM` \ (binds2, rhss') ->
-	   returnM (binds1 `unionBags` binds2, rhss')
-
-	-- (expand n rhss) 
-	-- Given ((n+1)/2) rhss, make n rhss, using auxiliary bindings
-	--  e.g.  expand 3 [rhs1, rhs2]
-	--	  = ( { x = split rhs1 },
-	--	      [fst x, snd x, rhs2] )
-    expand n rhss
-	| n `rem` 2 == 0 = go rhss 	-- n is even
-	| otherwise  	 = go (tail rhss)	`thenM` \ (binds', rhss') ->
-			   returnM (binds', head rhss : rhss')
-	where
-	  go rhss = mapAndUnzipM do_one rhss	`thenM` \ (binds', rhss') ->
-		    returnM (listToBag binds', concat rhss')
-
-	  do_one rhs = newUnique 			`thenM` \ uniq -> 
-		       tcLookupId fstName		`thenM` \ fst_id ->
-		       tcLookupId sndName		`thenM` \ snd_id ->
-		       let 
-			  x = mkUserLocal occ uniq pair_ty loc
-		       in
-		       returnM (L span (VarBind x (mk_app span split_id rhs)),
-				[mk_fs_app span fst_id ty x, mk_fs_app span snd_id ty x])
-
-mk_fs_app span id ty var = L span (HsVar id) `mkHsTyApp` [ty,ty] `mkHsApp` (L span (HsVar var))
-
-mk_app span id rhs = L span (HsApp (L span (HsVar id)) rhs)
-
-addBind binds inst rhs = binds `unionBags` unitBag (L (instLocSrcSpan (instLoc inst)) 
-						      (VarBind (instToId inst) rhs))
-instSpan wanted = instLocSrcSpan (instLoc wanted)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[reduce]{@reduce@}
-%*									*
-%************************************************************************
-
-When the "what to do" predicate doesn't depend on the quantified type variables,
-matters are easier.  We don't need to do any zonking, unless the improvement step
-does something, in which case we zonk before iterating.
-
-The "given" set is always empty.
-
-\begin{code}
-simpleReduceLoop :: SDoc
-	 	 -> (Inst -> WhatToDo)		-- What to do, *not* based on the quantified type variables
-		 -> [Inst]			-- Wanted
-		 -> TcM ([Inst],		-- Free
-			 TcDictBinds,
-			 [Inst])		-- Irreducible
-
-simpleReduceLoop doc try_me wanteds
-  = mappM zonkInst wanteds			`thenM` \ wanteds' ->
-    reduceContext doc try_me [] wanteds'	`thenM` \ (no_improvement, frees, binds, irreds) ->
-    if no_improvement then
-	returnM (frees, binds, irreds)
-    else
-	simpleReduceLoop doc try_me (irreds ++ frees)	`thenM` \ (frees1, binds1, irreds1) ->
-	returnM (frees1, binds `unionBags` binds1, irreds1)
-\end{code}
-
-
-
-\begin{code}
-reduceContext :: SDoc
-	      -> (Inst -> WhatToDo)
-	      -> [Inst]			-- Given
-	      -> [Inst]			-- Wanted
-	      -> TcM (Bool, 		-- True <=> improve step did no unification
-			 [Inst],	-- Free
-			 TcDictBinds,	-- Dictionary bindings
-			 [Inst])	-- Irreducible
-
-reduceContext doc try_me givens wanteds
-  =
-    traceTc (text "reduceContext" <+> (vcat [
-	     text "----------------------",
-	     doc,
-	     text "given" <+> ppr givens,
-	     text "wanted" <+> ppr wanteds,
-	     text "----------------------"
-	     ]))					`thenM_`
-
-        -- Build the Avail mapping from "givens"
-    foldlM addGiven emptyAvails givens			`thenM` \ init_state ->
-
-        -- Do the real work
-    reduceList (0,[]) try_me wanteds init_state		`thenM` \ avails ->
-
-	-- Do improvement, using everything in avails
-	-- In particular, avails includes all superclasses of everything
-    tcImprove avails					`thenM` \ no_improvement ->
-
-    extractResults avails wanteds			`thenM` \ (binds, irreds, frees) ->
-
-    traceTc (text "reduceContext end" <+> (vcat [
-	     text "----------------------",
-	     doc,
-	     text "given" <+> ppr givens,
-	     text "wanted" <+> ppr wanteds,
-	     text "----",
-	     text "avails" <+> pprAvails avails,
-	     text "frees" <+> ppr frees,
-	     text "no_improvement =" <+> ppr no_improvement,
-	     text "----------------------"
-	     ])) 					`thenM_`
-
-    returnM (no_improvement, frees, binds, irreds)
-
--- reduceContextWithoutImprovement differs from reduceContext
---	(a) no improvement
---	(b) 'givens' is assumed empty
-reduceContextWithoutImprovement doc try_me wanteds
-  =
-    traceTc (text "reduceContextWithoutImprovement" <+> (vcat [
-	     text "----------------------",
-	     doc,
-	     text "wanted" <+> ppr wanteds,
-	     text "----------------------"
-	     ]))					`thenM_`
-
-        -- Do the real work
-    reduceList (0,[]) try_me wanteds emptyAvails	`thenM` \ avails ->
-    extractResults avails wanteds			`thenM` \ (binds, irreds, frees) ->
-
-    traceTc (text "reduceContextWithoutImprovement end" <+> (vcat [
-	     text "----------------------",
-	     doc,
-	     text "wanted" <+> ppr wanteds,
-	     text "----",
-	     text "avails" <+> pprAvails avails,
-	     text "frees" <+> ppr frees,
-	     text "----------------------"
-	     ])) 					`thenM_`
-
-    returnM (frees, binds, irreds)
-
-tcImprove :: Avails -> TcM Bool		-- False <=> no change
--- Perform improvement using all the predicates in Avails
-tcImprove avails
- =  tcGetInstEnvs 			`thenM` \ inst_envs -> 
-    let
-	preds = [ (pred, pp_loc)
-		| (inst, avail) <- fmToList avails,
-		  pred <- get_preds inst avail,
-		  let pp_loc = pprInstLoc (instLoc inst)
-		]
-		-- Avails has all the superclasses etc (good)
-		-- It also has all the intermediates of the deduction (good)
-		-- It does not have duplicates (good)
-		-- NB that (?x::t1) and (?x::t2) will be held separately in avails
-		--    so that improve will see them separate
-
-	-- For free Methods, we want to take predicates from their context,
-	-- but for Methods that have been squished their context will already
-	-- be in Avails, and we don't want duplicates.  Hence this rather
-	-- horrid get_preds function
-	get_preds inst IsFree = fdPredsOfInst inst
-	get_preds inst other | isDict inst = [dictPred inst]
-			     | otherwise   = []
-
-	eqns = improve get_insts preds
-	get_insts clas = classInstances inst_envs clas
-     in
-     if null eqns then
-	returnM True
-     else
-	traceTc (ptext SLIT("Improve:") <+> vcat (map pprEquationDoc eqns))	`thenM_`
-        mappM_ unify eqns	`thenM_`
-	returnM False
-  where
-    unify ((qtvs, pairs), what1, what2)
-	 = addErrCtxtM (mkEqnMsg what1 what2)	$
-	   tcInstTyVars (varSetElems qtvs)	`thenM` \ (_, _, tenv) ->
-	   mapM_ (unif_pr tenv) pairs
-    unif_pr tenv (ty1,ty2) =  unifyType (substTy tenv ty1) (substTy tenv ty2)
-
-pprEquationDoc (eqn, (p1,w1), (p2,w2)) = vcat [pprEquation eqn, nest 2 (ppr p1), nest 2 (ppr p2)]
-
-mkEqnMsg (pred1,from1) (pred2,from2) tidy_env
-  = do	{ pred1' <- zonkTcPredType pred1; pred2' <- zonkTcPredType pred2
-	; let { pred1'' = tidyPred tidy_env pred1'; pred2'' = tidyPred tidy_env pred2' }
-	; let msg = vcat [ptext SLIT("When using functional dependencies to combine"),
-			  nest 2 (sep [ppr pred1'' <> comma, nest 2 from1]), 
-			  nest 2 (sep [ppr pred2'' <> comma, nest 2 from2])]
-	; return (tidy_env, msg) }
-\end{code}
-
-The main context-reduction function is @reduce@.  Here's its game plan.
-
-\begin{code}
-reduceList :: (Int,[Inst])		-- Stack (for err msgs)
-					-- along with its depth
-       	   -> (Inst -> WhatToDo)
-       	   -> [Inst]
-       	   -> Avails
-       	   -> TcM Avails
-\end{code}
-
-@reduce@ is passed
-     try_me:	given an inst, this function returns
-		  Reduce       reduce this
-		  DontReduce   return this in "irreds"
-		  Free	       return this in "frees"
-
-     wanteds:	The list of insts to reduce
-     state:	An accumulating parameter of type Avails
-		that contains the state of the algorithm
-
-  It returns a Avails.
-
-The (n,stack) pair is just used for error reporting.
-n is always the depth of the stack.
-The stack is the stack of Insts being reduced: to produce X
-I had to produce Y, to produce Y I had to produce Z, and so on.
-
-\begin{code}
-reduceList (n,stack) try_me wanteds state
-  | n > opt_MaxContextReductionDepth
-  = failWithTc (reduceDepthErr n stack)
-
-  | otherwise
-  =
-#ifdef DEBUG
-   (if n > 8 then
-	pprTrace "Interesting! Context reduction stack deeper than 8:" 
-		(int n $$ ifPprDebug (nest 2 (pprStack stack)))
-    else (\x->x))
-#endif
-    go wanteds state
-  where
-    go []     state = returnM state
-    go (w:ws) state = reduce (n+1, w:stack) try_me w state	`thenM` \ state' ->
-		      go ws state'
-
-    -- Base case: we're done!
-reduce stack try_me wanted avails
-    -- It's the same as an existing inst, or a superclass thereof
-  | Just avail <- isAvailable avails wanted
-  = if isLinearInst wanted then
-	addLinearAvailable avails avail wanted	`thenM` \ (avails', wanteds') ->
-	reduceList stack try_me wanteds' avails'
-    else
-	returnM avails		-- No op for non-linear things
-
-  | otherwise
-  = case try_me wanted of {
-
-      KeepDictWithoutSCs -> addIrred NoSCs avails wanted
-
-    ; DontReduceUnlessConstant ->    -- It's irreducible (or at least should not be reduced)
-  				     -- First, see if the inst can be reduced to a constant in one step
-	try_simple (addIrred AddSCs)	-- Assume want superclasses
-
-    ; Free ->	-- It's free so just chuck it upstairs
-  		-- First, see if the inst can be reduced to a constant in one step
-	try_simple addFree
-
-    ; ReduceMe want_scs ->	-- It should be reduced
-	lookupInst wanted	      `thenM` \ lookup_result ->
-	case lookup_result of
-	    GenInst wanteds' rhs -> addIrred NoSCs avails wanted		`thenM` \ avails1 ->
-				    reduceList stack try_me wanteds' avails1	`thenM` \ avails2 ->
-				    addWanted want_scs avails2 wanted rhs wanteds'
-		-- Experiment with temporarily doing addIrred *before* the reduceList, 
-		-- which has the effect of adding the thing we are trying
-		-- to prove to the database before trying to prove the things it
-		-- needs.  See note [RECURSIVE DICTIONARIES]
-		-- NB: we must not do an addWanted before, because that adds the
-		--     superclasses too, and thaat can lead to a spurious loop; see
-		--     the examples in [SUPERCLASS-LOOP]
-		-- So we do an addIrred before, and then overwrite it afterwards with addWanted
-
-	    SimpleInst rhs -> addWanted want_scs avails wanted rhs []
-
-	    NoInstance ->    -- No such instance!
-			     -- Add it and its superclasses
-		    	     addIrred want_scs avails wanted
-    }
-  where
-    try_simple do_this_otherwise
-      = lookupInst wanted	  `thenM` \ lookup_result ->
-	case lookup_result of
-	    SimpleInst rhs -> addWanted AddSCs avails wanted rhs []
-	    other	   -> do_this_otherwise avails wanted
-\end{code}
-
-
-\begin{code}
--------------------------
-isAvailable :: Avails -> Inst -> Maybe Avail
-isAvailable avails wanted = lookupFM avails wanted
-	-- NB 1: the Ord instance of Inst compares by the class/type info
-	--  *not* by unique.  So
-	--	d1::C Int ==  d2::C Int
-
-addLinearAvailable :: Avails -> Avail -> Inst -> TcM (Avails, [Inst])
-addLinearAvailable avails avail wanted
-	-- avails currently maps [wanted -> avail]
-	-- Extend avails to reflect a neeed for an extra copy of avail
-
-  | Just avail' <- split_avail avail
-  = returnM (addToFM avails wanted avail', [])
-
-  | otherwise
-  = tcLookupId splitName			`thenM` \ split_id ->
-    tcInstClassOp (instLoc wanted) split_id 
-		  [linearInstType wanted]	`thenM` \ split_inst ->
-    returnM (addToFM avails wanted (Linear 2 split_inst avail), [split_inst])
-
-  where
-    split_avail :: Avail -> Maybe Avail
-	-- (Just av) if there's a modified version of avail that
-	-- 	     we can use to replace avail in avails
-	-- Nothing   if there isn't, so we need to create a Linear
-    split_avail (Linear n i a)		    = Just (Linear (n+1) i a)
-    split_avail (Given id used) | not used  = Just (Given id True)
-				| otherwise = Nothing
-    split_avail Irred			    = Nothing
-    split_avail IsFree			    = Nothing
-    split_avail other = pprPanic "addLinearAvailable" (ppr avail $$ ppr wanted $$ ppr avails)
-		  
--------------------------
-addFree :: Avails -> Inst -> TcM Avails
-	-- When an Inst is tossed upstairs as 'free' we nevertheless add it
-	-- to avails, so that any other equal Insts will be commoned up right
-	-- here rather than also being tossed upstairs.  This is really just
-	-- an optimisation, and perhaps it is more trouble that it is worth,
-	-- as the following comments show!
-	--
-	-- NB: do *not* add superclasses.  If we have
-	--	df::Floating a
-	--	dn::Num a
-	-- but a is not bound here, then we *don't* want to derive
-	-- dn from df here lest we lose sharing.
-	--
-addFree avails free = returnM (addToFM avails free IsFree)
-
-addWanted :: WantSCs -> Avails -> Inst -> LHsExpr TcId -> [Inst] -> TcM Avails
-addWanted want_scs avails wanted rhs_expr wanteds
-  = addAvailAndSCs want_scs avails wanted avail
-  where
-    avail = Rhs rhs_expr wanteds
-
-addGiven :: Avails -> Inst -> TcM Avails
-addGiven avails given = addAvailAndSCs AddSCs avails given (Given (instToId given) False)
-	-- Always add superclasses for 'givens'
-	--
-	-- No ASSERT( not (given `elemFM` avails) ) because in an instance
-	-- decl for Ord t we can add both Ord t and Eq t as 'givens', 
-	-- so the assert isn't true
-
-addIrred :: WantSCs -> Avails -> Inst -> TcM Avails
-addIrred want_scs avails irred = ASSERT2( not (irred `elemFM` avails), ppr irred $$ ppr avails )
-    	      		         addAvailAndSCs want_scs avails irred Irred
-
-addAvailAndSCs :: WantSCs -> Avails -> Inst -> Avail -> TcM Avails
-addAvailAndSCs want_scs avails inst avail
-  | not (isClassDict inst) = return avails_with_inst
-  | NoSCs <- want_scs	   = return avails_with_inst
-  | otherwise		   = do { traceTc (text "addAvailAndSCs" <+> vcat [ppr inst, ppr deps])
-				; addSCs is_loop avails_with_inst inst }
-  where
-    avails_with_inst = addToFM avails inst avail
-
-    is_loop pred = any (`tcEqType` mkPredTy pred) dep_tys
-			-- Note: this compares by *type*, not by Unique
-    deps         = findAllDeps (unitVarSet (instToId inst)) avail
-    dep_tys	 = map idType (varSetElems deps)
-
-    findAllDeps :: IdSet -> Avail -> IdSet
-    -- Find all the Insts that this one depends on
-    -- See Note [SUPERCLASS-LOOP 2]
-    -- Watch out, though.  Since the avails may contain loops 
-    -- (see Note [RECURSIVE DICTIONARIES]), so we need to track the ones we've seen so far
-    findAllDeps so_far (Rhs _ kids) = foldl find_all so_far kids
-    findAllDeps so_far other	    = so_far
-
-    find_all :: IdSet -> Inst -> IdSet
-    find_all so_far kid
-      | kid_id `elemVarSet` so_far	  = so_far
-      | Just avail <- lookupFM avails kid = findAllDeps so_far' avail
-      | otherwise			  = so_far'
-      where
-	so_far' = extendVarSet so_far kid_id	-- Add the new kid to so_far
-	kid_id = instToId kid
-
-addSCs :: (TcPredType -> Bool) -> Avails -> Inst -> TcM Avails
-	-- Add all the superclasses of the Inst to Avails
-	-- The first param says "dont do this because the original thing
-	--	depends on this one, so you'd build a loop"
-	-- Invariant: the Inst is already in Avails.
-
-addSCs is_loop avails dict
-  = do	{ sc_dicts <- newDictsAtLoc (instLoc dict) sc_theta'
-	; foldlM add_sc avails (zipEqual "add_scs" sc_dicts sc_sels) }
-  where
-    (clas, tys) = getDictClassTys dict
-    (tyvars, sc_theta, sc_sels, _) = classBigSig clas
-    sc_theta' = substTheta (zipTopTvSubst tyvars tys) sc_theta
-
-    add_sc avails (sc_dict, sc_sel)
-      | is_loop (dictPred sc_dict) = return avails 	-- See Note [SUPERCLASS-LOOP 2]
-      | is_given sc_dict 	   = return avails
-      | otherwise		   = addSCs is_loop avails' sc_dict
-      where
-	sc_sel_rhs = mkHsDictApp (mkHsTyApp (L (instSpan dict) (HsVar sc_sel)) tys) [instToId dict]
-	avails'    = addToFM avails sc_dict (Rhs sc_sel_rhs [dict])
-
-    is_given :: Inst -> Bool
-    is_given sc_dict = case lookupFM avails sc_dict of
-			  Just (Given _ _) -> True	-- Given is cheaper than superclass selection
-			  other		   -> False	
-\end{code}
-
-Note [SUPERCLASS-LOOP 2]
-~~~~~~~~~~~~~~~~~~~~~~~~
-But the above isn't enough.  Suppose we are *given* d1:Ord a,
-and want to deduce (d2:C [a]) where
-
-	class Ord a => C a where
-	instance Ord [a] => C [a] where ...
-
-Then we'll use the instance decl to deduce C [a] from Ord [a], and then add the
-superclasses of C [a] to avails.  But we must not overwrite the binding
-for Ord [a] (which is obtained from Ord a) with a superclass selection or we'll just
-build a loop! 
-
-Here's another variant, immortalised in tcrun020
-	class Monad m => C1 m
-	class C1 m => C2 m x
-	instance C2 Maybe Bool
-For the instance decl we need to build (C1 Maybe), and it's no good if
-we run around and add (C2 Maybe Bool) and its superclasses to the avails 
-before we search for C1 Maybe.
-
-Here's another example 
- 	class Eq b => Foo a b
-	instance Eq a => Foo [a] a
-If we are reducing
-	(Foo [t] t)
-
-we'll first deduce that it holds (via the instance decl).  We must not
-then overwrite the Eq t constraint with a superclass selection!
-
-At first I had a gross hack, whereby I simply did not add superclass constraints
-in addWanted, though I did for addGiven and addIrred.  This was sub-optimal,
-becuase it lost legitimate superclass sharing, and it still didn't do the job:
-I found a very obscure program (now tcrun021) in which improvement meant the
-simplifier got two bites a the cherry... so something seemed to be an Irred
-first time, but reducible next time.
-
-Now we implement the Right Solution, which is to check for loops directly 
-when adding superclasses.  It's a bit like the occurs check in unification.
-
-
-Note [RECURSIVE DICTIONARIES]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider 
-    data D r = ZeroD | SuccD (r (D r));
-    
-    instance (Eq (r (D r))) => Eq (D r) where
-        ZeroD     == ZeroD     = True
-        (SuccD a) == (SuccD b) = a == b
-        _         == _         = False;
-    
-    equalDC :: D [] -> D [] -> Bool;
-    equalDC = (==);
-
-We need to prove (Eq (D [])).  Here's how we go:
-
-	d1 : Eq (D [])
-
-by instance decl, holds if
-	d2 : Eq [D []]
-	where 	d1 = dfEqD d2
-
-by instance decl of Eq, holds if
-	d3 : D []
-	where	d2 = dfEqList d3
-		d1 = dfEqD d2
-
-But now we can "tie the knot" to give
-
-	d3 = d1
-	d2 = dfEqList d3
-	d1 = dfEqD d2
-
-and it'll even run!  The trick is to put the thing we are trying to prove
-(in this case Eq (D []) into the database before trying to prove its
-contributing clauses.
-	
-
-%************************************************************************
-%*									*
-\section{tcSimplifyTop: defaulting}
-%*									*
-%************************************************************************
-
-
-@tcSimplifyTop@ is called once per module to simplify all the constant
-and ambiguous Insts.
-
-We need to be careful of one case.  Suppose we have
-
-	instance Num a => Num (Foo a b) where ...
-
-and @tcSimplifyTop@ is given a constraint (Num (Foo x y)).  Then it'll simplify
-to (Num x), and default x to Int.  But what about y??
-
-It's OK: the final zonking stage should zap y to (), which is fine.
-
-
-\begin{code}
-tcSimplifyTop, tcSimplifyInteractive :: [Inst] -> TcM TcDictBinds
-tcSimplifyTop wanteds
-  = tc_simplify_top doc False {- Not interactive loop -} AddSCs wanteds
-  where 
-    doc = text "tcSimplifyTop"
-
-tcSimplifyInteractive wanteds
-  = tc_simplify_top doc True  {- Interactive loop -}     AddSCs wanteds
-  where 
-    doc = text "tcSimplifyTop"
-
--- The TcLclEnv should be valid here, solely to improve
--- error message generation for the monomorphism restriction
-tc_simplify_top doc is_interactive want_scs wanteds
-  = do	{ lcl_env <- getLclEnv
-	; traceTc (text "tcSimplifyTop" <+> ppr (lclEnvElts lcl_env))
-
-	; let try_me inst = ReduceMe want_scs
-	; (frees, binds, irreds) <- simpleReduceLoop doc try_me wanteds
-
-	; let
-		-- First get rid of implicit parameters
-    	    (non_ips, bad_ips) = partition isClassDict irreds
-
-		-- All the non-tv or multi-param ones are definite errors
-	    (unary_tv_dicts, non_tvs) = partition is_unary_tyvar_dict non_ips
-	    bad_tyvars = unionVarSets (map tyVarsOfInst non_tvs)
-
-		-- Group by type variable
-	    tv_groups = equivClasses cmp_by_tyvar unary_tv_dicts
-
-		-- Pick the ones which its worth trying to disambiguate
-		-- namely, the ones whose type variable isn't bound
-		-- up with one of the non-tyvar classes
-	    (default_gps, non_default_gps) = partition defaultable_group tv_groups
-	    defaultable_group ds
-		=  not (bad_tyvars `intersectsVarSet` tyVarsOfInst (head ds))
-		&& defaultable_classes (map get_clas ds)
-	    defaultable_classes clss 
-		| is_interactive = any isInteractiveClass clss
-		| otherwise	 = all isStandardClass clss && any isNumericClass clss
-
-	    isInteractiveClass cls = isNumericClass cls
-				  || (classKey cls `elem` [showClassKey, eqClassKey, ordClassKey])
-		 	-- In interactive mode, we default Show a to Show ()
-			-- to avoid graututious errors on "show []"
-
-    
-		    -- Collect together all the bad guys
-	    bad_guys 	       = non_tvs ++ concat non_default_gps
-    	    (ambigs, no_insts) = partition isTyVarDict bad_guys
-	    -- If the dict has no type constructors involved, it must be ambiguous,
-	    -- except I suppose that another error with fundeps maybe should have
-	    -- constrained those type variables
-
-	-- Report definite errors
-	; ASSERT( null frees )
-	  groupErrs (addNoInstanceErrs Nothing []) no_insts
-	; strangeTopIPErrs bad_ips
-
-	-- Deal with ambiguity errors, but only if
-	-- if there has not been an error so far:
-	-- errors often give rise to spurious ambiguous Insts.
-	-- For example:
-	--   f = (*)	-- Monomorphic
-	--   g :: Num a => a -> a
-	--   g x = f x x
-	-- Here, we get a complaint when checking the type signature for g,
-	-- that g isn't polymorphic enough; but then we get another one when
-	-- dealing with the (Num a) context arising from f's definition;
-	-- we try to unify a with Int (to default it), but find that it's
-	-- already been unified with the rigid variable from g's type sig
-	; binds_ambig <- ifErrsM (returnM []) $
-	    do	{ -- Complain about the ones that don't fall under
-		  -- the Haskell rules for disambiguation
-		  -- This group includes both non-existent instances
-		  --	e.g. Num (IO a) and Eq (Int -> Int)
-		  -- and ambiguous dictionaries
-		  --	e.g. Num a
-		  addTopAmbigErrs ambigs
-
-		  -- Disambiguate the ones that look feasible
-		; mappM disambigGroup default_gps }
-
-	; return (binds `unionBags` unionManyBags binds_ambig) }
-
-----------------------------------
-d1 `cmp_by_tyvar` d2 = get_tv d1 `compare` get_tv d2
-
-is_unary_tyvar_dict :: Inst -> Bool	-- Dicts of form (C a)
-  -- Invariant: argument is a ClassDict, not IP or method
-is_unary_tyvar_dict d = case getDictClassTys d of
-			  (_, [ty]) -> tcIsTyVarTy ty
-			  other	    -> False
-
-get_tv d   = case getDictClassTys d of
-		   (clas, [ty]) -> tcGetTyVar "tcSimplify" ty
-get_clas d = case getDictClassTys d of
-		   (clas, _) -> clas
-\end{code}
-
-If a dictionary constrains a type variable which is
-	* not mentioned in the environment
-	* and not mentioned in the type of the expression
-then it is ambiguous. No further information will arise to instantiate
-the type variable; nor will it be generalised and turned into an extra
-parameter to a function.
-
-It is an error for this to occur, except that Haskell provided for
-certain rules to be applied in the special case of numeric types.
-Specifically, if
-	* at least one of its classes is a numeric class, and
-	* all of its classes are numeric or standard
-then the type variable can be defaulted to the first type in the
-default-type list which is an instance of all the offending classes.
-
-So here is the function which does the work.  It takes the ambiguous
-dictionaries and either resolves them (producing bindings) or
-complains.  It works by splitting the dictionary list by type
-variable, and using @disambigOne@ to do the real business.
-
-@disambigOne@ assumes that its arguments dictionaries constrain all
-the same type variable.
-
-ADR Comment 20/6/94: I've changed the @CReturnable@ case to default to
-@()@ instead of @Int@.  I reckon this is the Right Thing to do since
-the most common use of defaulting is code like:
-\begin{verbatim}
-	_ccall_ foo	`seqPrimIO` bar
-\end{verbatim}
-Since we're not using the result of @foo@, the result if (presumably)
-@void@.
-
-\begin{code}
-disambigGroup :: [Inst]	-- All standard classes of form (C a)
-	      -> TcM TcDictBinds
-
-disambigGroup dicts
-  = 	-- THE DICTS OBEY THE DEFAULTABLE CONSTRAINT
-	-- SO, TRY DEFAULT TYPES IN ORDER
-
-	-- Failure here is caused by there being no type in the
-	-- default list which can satisfy all the ambiguous classes.
-	-- For example, if Real a is reqd, but the only type in the
-	-- default list is Int.
-    get_default_tys			`thenM` \ default_tys ->
-    let
-      try_default [] 	-- No defaults work, so fail
-	= failM
-
-      try_default (default_ty : default_tys)
-	= tryTcLIE_ (try_default default_tys) $	-- If default_ty fails, we try
-						-- default_tys instead
-	  tcSimplifyDefault theta		`thenM` \ _ ->
-	  returnM default_ty
-        where
-	  theta = [mkClassPred clas [default_ty] | clas <- classes]
-    in
-	-- See if any default works
-    tryM (try_default default_tys)	`thenM` \ mb_ty ->
-    case mb_ty of
-	Left  _ 		-> bomb_out
-	Right chosen_default_ty -> choose_default chosen_default_ty
-  where
-    tyvar   = get_tv (head dicts)	-- Should be non-empty
-    classes = map get_clas dicts
-
-    choose_default default_ty	-- Commit to tyvar = default_ty
-      =	-- Bind the type variable 
-	unifyType default_ty (mkTyVarTy tyvar)	`thenM_`
-	-- and reduce the context, for real this time
-	simpleReduceLoop (text "disambig" <+> ppr dicts)
-		         reduceMe dicts			`thenM` \ (frees, binds, ambigs) ->
-	WARN( not (null frees && null ambigs), ppr frees $$ ppr ambigs )
-	warnDefault dicts default_ty			`thenM_`
-	returnM binds
-
-    bomb_out = addTopAmbigErrs dicts	`thenM_`
-	       returnM emptyBag
-
-get_default_tys
-  = do 	{ mb_defaults <- getDefaultTys
-	; case mb_defaults of
-		Just tys -> return tys
-		Nothing  -> 	-- No use-supplied default;
-				-- use [Integer, Double]
-			    do { integer_ty <- tcMetaTy integerTyConName
-			       ; checkWiredInTyCon doubleTyCon
-			       ; return [integer_ty, doubleTy] } }
-\end{code}
-
-[Aside - why the defaulting mechanism is turned off when
- dealing with arguments and results to ccalls.
-
-When typechecking _ccall_s, TcExpr ensures that the external
-function is only passed arguments (and in the other direction,
-results) of a restricted set of 'native' types.
-
-The interaction between the defaulting mechanism for numeric
-values and CC & CR can be a bit puzzling to the user at times.
-For example,
-
-    x <- _ccall_ f
-    if (x /= 0) then
-       _ccall_ g x
-     else
-       return ()
-
-What type has 'x' got here? That depends on the default list
-in operation, if it is equal to Haskell 98's default-default
-of (Integer, Double), 'x' has type Double, since Integer
-is not an instance of CR. If the default list is equal to
-Haskell 1.4's default-default of (Int, Double), 'x' has type
-Int.
-
-End of aside]
-
-
-%************************************************************************
-%*									*
-\subsection[simple]{@Simple@ versions}
-%*									*
-%************************************************************************
-
-Much simpler versions when there are no bindings to make!
-
-@tcSimplifyThetas@ simplifies class-type constraints formed by
-@deriving@ declarations and when specialising instances.  We are
-only interested in the simplified bunch of class/type constraints.
-
-It simplifies to constraints of the form (C a b c) where
-a,b,c are type variables.  This is required for the context of
-instance declarations.
-
-\begin{code}
-tcSimplifyDeriv :: TyCon
-		-> [TyVar]	
-		-> ThetaType		-- Wanted
-	        -> TcM ThetaType	-- Needed
-
-tcSimplifyDeriv tc tyvars theta
-  = tcInstTyVars tyvars			`thenM` \ (tvs, _, tenv) ->
-	-- The main loop may do unification, and that may crash if 
-	-- it doesn't see a TcTyVar, so we have to instantiate. Sigh
-	-- ToDo: what if two of them do get unified?
-    newDicts DerivOrigin (substTheta tenv theta)	`thenM` \ wanteds ->
-    simpleReduceLoop doc reduceMe wanteds		`thenM` \ (frees, _, irreds) ->
-    ASSERT( null frees )			-- reduceMe never returns Free
-
-    doptM Opt_GlasgowExts			`thenM` \ gla_exts ->
-    doptM Opt_AllowUndecidableInstances		`thenM` \ undecidable_ok ->
-    let
- 	tv_set      = mkVarSet tvs
-
- 	(bad_insts, ok_insts) = partition is_bad_inst irreds
-	is_bad_inst dict 
-	   = let pred = dictPred dict	-- reduceMe squashes all non-dicts
-	     in isEmptyVarSet (tyVarsOfPred pred)
-		  -- Things like (Eq T) are bad
-	     || (not gla_exts && not (isTyVarClassPred pred))
-  
-	simpl_theta = map dictPred ok_insts
-	weird_preds = [pred | pred <- simpl_theta
-			    , not (tyVarsOfPred pred `subVarSet` tv_set)]  
-	  -- Check for a bizarre corner case, when the derived instance decl should
-	  -- have form 	instance C a b => D (T a) where ...
-	  -- Note that 'b' isn't a parameter of T.  This gives rise to all sorts
-	  -- of problems; in particular, it's hard to compare solutions for
-	  -- equality when finding the fixpoint.  So I just rule it out for now.
-  
-	rev_env = zipTopTvSubst tvs (mkTyVarTys tyvars)
-		-- This reverse-mapping is a Royal Pain, 
-		-- but the result should mention TyVars not TcTyVars
-
-	head_ty = TyConApp tc (map TyVarTy tvs)
-    in
-   
-    addNoInstanceErrs Nothing [] bad_insts		`thenM_`
-    mapM_ (addErrTc . badDerivedPred) weird_preds	`thenM_`
-    checkAmbiguity tvs simpl_theta tv_set		`thenM_`
-      -- Check instance termination as for user-declared instances.
-      -- unless we had -fallow-undecidable-instances (which risks
-      -- non-termination in the 'deriving' context-inference fixpoint
-      -- loop).
-    ifM (gla_exts && not undecidable_ok)
-	(checkInstTermination simpl_theta [head_ty])	`thenM_`
-    returnM (substTheta rev_env simpl_theta)
-  where
-    doc    = ptext SLIT("deriving classes for a data type")
-\end{code}
-
-@tcSimplifyDefault@ just checks class-type constraints, essentially;
-used with \tr{default} declarations.  We are only interested in
-whether it worked or not.
-
-\begin{code}
-tcSimplifyDefault :: ThetaType	-- Wanted; has no type variables in it
-		  -> TcM ()
-
-tcSimplifyDefault theta
-  = newDicts DefaultOrigin theta		`thenM` \ wanteds ->
-    simpleReduceLoop doc reduceMe wanteds	`thenM` \ (frees, _, irreds) ->
-    ASSERT( null frees )	-- try_me never returns Free
-    addNoInstanceErrs Nothing []  irreds 	`thenM_`
-    if null irreds then
-	returnM ()
-    else
-	failM
-  where
-    doc = ptext SLIT("default declaration")
-\end{code}
-
-
-%************************************************************************
-%*									*
-\section{Errors and contexts}
-%*									*
-%************************************************************************
-
-ToDo: for these error messages, should we note the location as coming
-from the insts, or just whatever seems to be around in the monad just
-now?
-
-\begin{code}
-groupErrs :: ([Inst] -> TcM ())	-- Deal with one group
-	  -> [Inst]		-- The offending Insts
-          -> TcM ()
--- Group together insts with the same origin
--- We want to report them together in error messages
-
-groupErrs report_err [] 
-  = returnM ()
-groupErrs report_err (inst:insts) 
-  = do_one (inst:friends)		`thenM_`
-    groupErrs report_err others
-
-  where
-	-- (It may seem a bit crude to compare the error messages,
-	--  but it makes sure that we combine just what the user sees,
-	--  and it avoids need equality on InstLocs.)
-   (friends, others) = partition is_friend insts
-   loc_msg	     = showSDoc (pprInstLoc (instLoc inst))
-   is_friend friend  = showSDoc (pprInstLoc (instLoc friend)) == loc_msg
-   do_one insts = addInstCtxt (instLoc (head insts)) (report_err insts)
-		-- Add location and context information derived from the Insts
-
--- Add the "arising from..." part to a message about bunch of dicts
-addInstLoc :: [Inst] -> Message -> Message
-addInstLoc insts msg = msg $$ nest 2 (pprInstLoc (instLoc (head insts)))
-
-addTopIPErrs :: [Name] -> [Inst] -> TcM ()
-addTopIPErrs bndrs [] 
-  = return ()
-addTopIPErrs bndrs ips
-  = addErrTcM (tidy_env, mk_msg tidy_ips)
-  where
-    (tidy_env, tidy_ips) = tidyInsts ips
-    mk_msg ips = vcat [sep [ptext SLIT("Implicit parameters escape from"),
-			    nest 2 (ptext SLIT("the monomorphic top-level binding(s) of")
-					    <+> pprBinders bndrs <> colon)],
-		       nest 2 (vcat (map ppr_ip ips)),
-		       monomorphism_fix]
-    ppr_ip ip = pprPred (dictPred ip) <+> pprInstLoc (instLoc ip)
-
-strangeTopIPErrs :: [Inst] -> TcM ()
-strangeTopIPErrs dicts	-- Strange, becuase addTopIPErrs should have caught them all
-  = groupErrs report tidy_dicts
-  where
-    (tidy_env, tidy_dicts) = tidyInsts dicts
-    report dicts = addErrTcM (tidy_env, mk_msg dicts)
-    mk_msg dicts = addInstLoc dicts (ptext SLIT("Unbound implicit parameter") <> 
-				     plural tidy_dicts <+> pprDictsTheta tidy_dicts)
-
-addNoInstanceErrs :: Maybe SDoc	-- Nothing => top level
-				-- Just d => d describes the construct
-		  -> [Inst]	-- What is given by the context or type sig
-		  -> [Inst]	-- What is wanted
-		  -> TcM ()	
-addNoInstanceErrs mb_what givens [] 
-  = returnM ()
-addNoInstanceErrs mb_what givens dicts
-  =	-- Some of the dicts are here because there is no instances
-	-- and some because there are too many instances (overlap)
-    tcGetInstEnvs	`thenM` \ inst_envs ->
-    let
-    	(tidy_env1, tidy_givens) = tidyInsts givens
-	(tidy_env2, tidy_dicts)  = tidyMoreInsts tidy_env1 dicts
-
-	-- Run through the dicts, generating a message for each
-	-- overlapping one, but simply accumulating all the 
-	-- no-instance ones so they can be reported as a group
-	(overlap_doc, no_inst_dicts) = foldl check_overlap (empty, []) tidy_dicts
-    	check_overlap (overlap_doc, no_inst_dicts) dict 
-	  | not (isClassDict dict) = (overlap_doc, dict : no_inst_dicts)
-	  | otherwise
-	  = case lookupInstEnv inst_envs clas tys of
-		-- The case of exactly one match and no unifiers means
-		-- a successful lookup.  That can't happen here, becuase
-		-- dicts only end up here if they didn't match in Inst.lookupInst
-#ifdef DEBUG
-		([m],[]) -> pprPanic "addNoInstanceErrs" (ppr dict)
-#endif
-		([], _)  -> (overlap_doc, dict : no_inst_dicts) 	-- No match
-		res	 -> (mk_overlap_msg dict res $$ overlap_doc, no_inst_dicts)
-	  where
-	    (clas,tys) = getDictClassTys dict
-    in
-	
-	-- Now generate a good message for the no-instance bunch
-    mk_probable_fix tidy_env2 no_inst_dicts	`thenM` \ (tidy_env3, probable_fix) ->
-    let
-    	no_inst_doc | null no_inst_dicts = empty
-		    | otherwise = vcat [addInstLoc no_inst_dicts heading, probable_fix]
-	heading | null givens = ptext SLIT("No instance") <> plural no_inst_dicts <+> 
-				ptext SLIT("for") <+> pprDictsTheta no_inst_dicts
-		| otherwise   = sep [ptext SLIT("Could not deduce") <+> pprDictsTheta no_inst_dicts,
-				     nest 2 $ ptext SLIT("from the context") <+> pprDictsTheta tidy_givens]
-    in
-	-- And emit both the non-instance and overlap messages
-    addErrTcM (tidy_env3, no_inst_doc $$ overlap_doc)
-  where
-    mk_overlap_msg dict (matches, unifiers)
-      = vcat [	addInstLoc [dict] ((ptext SLIT("Overlapping instances for") 
-					<+> pprPred (dictPred dict))),
-    		sep [ptext SLIT("Matching instances") <> colon,
-    		     nest 2 (vcat [pprInstances ispecs, pprInstances unifiers])],
-		ASSERT( not (null matches) )
-		if not (isSingleton matches)
-    		then 	-- Two or more matches
-		     empty
-    		else 	-- One match, plus some unifiers
-		ASSERT( not (null unifiers) )
-		parens (vcat [ptext SLIT("The choice depends on the instantiation of") <+>
-	    		         quotes (pprWithCommas ppr (varSetElems (tyVarsOfInst dict))),
-			      ptext SLIT("Use -fallow-incoherent-instances to use the first choice above")])]
-      where
-    	ispecs = [ispec | (_, ispec) <- matches]
-
-    mk_probable_fix tidy_env dicts	
-      = returnM (tidy_env, sep [ptext SLIT("Possible fix:"), nest 2 (vcat fixes)])
-      where
-	fixes = add_ors (fix1 ++ fix2)
-
-    	fix1 = case mb_what of
-		 Nothing   -> []	-- Top level
-		 Just what -> -- Nested (type signatures, instance decls)
-			      [ sep [ ptext SLIT("add") <+> pprDictsTheta dicts,
-			        ptext SLIT("to the") <+> what] ]
-
-    	fix2 | null instance_dicts = []
-	     | otherwise	   = [ ptext SLIT("add an instance declaration for")
-				       <+> pprDictsTheta instance_dicts ]
-	instance_dicts = [d | d <- dicts, isClassDict d, not (isTyVarDict d)]
-		-- Insts for which it is worth suggesting an adding an instance declaration
-		-- Exclude implicit parameters, and tyvar dicts
-
-	add_ors :: [SDoc] -> [SDoc]	-- The empty case should not happen
-	add_ors []      = [ptext SLIT("[No suggested fixes]")]	-- Strange
-	add_ors (f1:fs) = f1 : map (ptext SLIT("or") <+>) fs
-
-addTopAmbigErrs dicts
--- Divide into groups that share a common set of ambiguous tyvars
-  = mapM report (equivClasses cmp [(d, tvs_of d) | d <- tidy_dicts])
-  where
-    (tidy_env, tidy_dicts) = tidyInsts dicts
-
-    tvs_of :: Inst -> [TcTyVar]
-    tvs_of d = varSetElems (tyVarsOfInst d)
-    cmp (_,tvs1) (_,tvs2) = tvs1 `compare` tvs2
-    
-    report :: [(Inst,[TcTyVar])] -> TcM ()
-    report pairs@((inst,tvs) : _)	-- The pairs share a common set of ambiguous tyvars
-	= mkMonomorphismMsg tidy_env tvs	`thenM` \ (tidy_env, mono_msg) ->
-	  setSrcSpan (instLocSrcSpan (instLoc inst)) $
-		-- the location of the first one will do for the err message
-	  addErrTcM (tidy_env, msg $$ mono_msg)
-	where
-	  dicts = map fst pairs
-	  msg = sep [text "Ambiguous type variable" <> plural tvs <+> 
-			  pprQuotedList tvs <+> in_msg,
-		     nest 2 (pprDictsInFull dicts)]
-	  in_msg = text "in the constraint" <> plural dicts <> colon
-
-
-mkMonomorphismMsg :: TidyEnv -> [TcTyVar] -> TcM (TidyEnv, Message)
--- There's an error with these Insts; if they have free type variables
--- it's probably caused by the monomorphism restriction. 
--- Try to identify the offending variable
--- ASSUMPTION: the Insts are fully zonked
-mkMonomorphismMsg tidy_env inst_tvs
-  = findGlobals (mkVarSet inst_tvs) tidy_env	`thenM` \ (tidy_env, docs) ->
-    returnM (tidy_env, mk_msg docs)
-  where
-    mk_msg []   = ptext SLIT("Probable fix: add a type signature that fixes these type variable(s)")
-			-- This happens in things like
-			--	f x = show (read "foo")
-			-- whre monomorphism doesn't play any role
-    mk_msg docs = vcat [ptext SLIT("Possible cause: the monomorphism restriction applied to the following:"),
-			nest 2 (vcat docs),
-			monomorphism_fix
-		       ]
-monomorphism_fix :: SDoc
-monomorphism_fix = ptext SLIT("Probable fix:") <+> 
-		   (ptext SLIT("give these definition(s) an explicit type signature")
-		    $$ ptext SLIT("or use -fno-monomorphism-restriction"))
-    
-warnDefault dicts default_ty
-  = doptM Opt_WarnTypeDefaults  `thenM` \ warn_flag ->
-    addInstCtxt (instLoc (head dicts)) (warnTc warn_flag warn_msg)
-  where
-	-- Tidy them first
-    (_, tidy_dicts) = tidyInsts dicts
-    warn_msg  = vcat [ptext SLIT("Defaulting the following constraint(s) to type") <+>
-				quotes (ppr default_ty),
-		      pprDictsInFull tidy_dicts]
-
--- Used for the ...Thetas variants; all top level
-badDerivedPred pred
-  = vcat [ptext SLIT("Can't derive instances where the instance context mentions"),
-	  ptext SLIT("type variables that are not data type parameters"),
-	  nest 2 (ptext SLIT("Offending constraint:") <+> ppr pred)]
-
-reduceDepthErr n stack
-  = vcat [ptext SLIT("Context reduction stack overflow; size =") <+> int n,
-	  ptext SLIT("Use -fcontext-stack20 to increase stack size to (e.g.) 20"),
-	  nest 4 (pprStack stack)]
-
-pprStack stack = vcat (map pprInstInFull stack)
-\end{code}
diff --git a/ghc/compiler/typecheck/TcSplice.hi-boot-6 b/ghc/compiler/typecheck/TcSplice.hi-boot-6
deleted file mode 100644
index aa73980e5a..0000000000
--- a/ghc/compiler/typecheck/TcSplice.hi-boot-6
+++ /dev/null
@@ -1,15 +0,0 @@
-module TcSplice where
-
-tcSpliceExpr :: HsExpr.HsSplice Name.Name
-	     -> TcType.BoxyRhoType
-	     -> TcRnTypes.TcM (HsExpr.HsExpr Var.Id)
-
-kcSpliceType :: HsExpr.HsSplice Name.Name
-	     -> TcRnTypes.TcM (HsTypes.HsType Name.Name, TcType.TcKind)
-
-tcBracket :: HsExpr.HsBracket Name.Name 
-	  -> TcType.BoxyRhoType
-	  -> TcRnTypes.TcM (HsExpr.LHsExpr Var.Id)
-
-tcSpliceDecls :: HsExpr.LHsExpr Name.Name
-	      -> TcRnTypes.TcM [HsDecls.LHsDecl RdrName.RdrName]
diff --git a/ghc/compiler/typecheck/TcSplice.lhs b/ghc/compiler/typecheck/TcSplice.lhs
deleted file mode 100644
index beb72f1932..0000000000
--- a/ghc/compiler/typecheck/TcSplice.lhs
+++ /dev/null
@@ -1,694 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcSplice]{Template Haskell splices}
-
-\begin{code}
-module TcSplice( tcSpliceExpr, tcSpliceDecls, tcBracket ) where
-
-#include "HsVersions.h"
-
-import HscMain		( compileExpr )
-import TcRnDriver	( tcTopSrcDecls )
-	-- These imports are the reason that TcSplice 
-	-- is very high up the module hierarchy
-
-import qualified Language.Haskell.TH as TH
--- THSyntax gives access to internal functions and data types
-import qualified Language.Haskell.TH.Syntax as TH
-
-import HsSyn		( HsBracket(..), HsExpr(..), HsSplice(..), LHsExpr, LHsDecl, 
-		   	  HsType, LHsType )
-import Convert		( convertToHsExpr, convertToHsDecls, convertToHsType, thRdrName )
-import RnExpr		( rnLExpr )
-import RnEnv		( lookupFixityRn, lookupSrcOcc_maybe, lookupImportedName )
-import RdrName		( RdrName, lookupLocalRdrEnv, isSrcRdrName )
-import RnTypes		( rnLHsType )
-import TcExpr		( tcMonoExpr )
-import TcHsSyn		( mkHsDictLet, zonkTopLExpr )
-import TcSimplify	( tcSimplifyTop, tcSimplifyBracket )
-import TcUnify		( boxyUnify, unBox )
-import TcType		( TcType, TcKind, BoxyRhoType, liftedTypeKind, mkAppTy, tcSplitSigmaTy )
-import TcEnv		( spliceOK, tcMetaTy, bracketOK )
-import TcMType		( newFlexiTyVarTy, newKindVar, UserTypeCtxt(ExprSigCtxt), zonkTcType )
-import TcHsType		( tcHsSigType, kcHsType )
-import TcIface		( tcImportDecl )
-import TypeRep		( Type(..), PredType(..), TyThing(..) )	-- For reification
-import PrelNames	( thFAKE )
-import Name		( Name, NamedThing(..), nameOccName, nameModule, isExternalName, 
-			  nameIsLocalOrFrom )
-import NameEnv		( lookupNameEnv )
-import HscTypes		( lookupType, ExternalPackageState(..), emptyModDetails )
-import OccName
-import Var		( Id, TyVar, idType )
-import Module		( moduleString )
-import TcRnMonad
-import IfaceEnv		( lookupOrig )
-import Class		( Class, classExtraBigSig )
-import TyCon		( TyCon, tyConTyVars, synTyConDefn, 
-			  isSynTyCon, isNewTyCon, tyConDataCons, isPrimTyCon, isFunTyCon,
-			  tyConArity, tyConStupidTheta, isUnLiftedTyCon )
-import DataCon		( DataCon, dataConTyCon, dataConOrigArgTys, dataConStrictMarks, 
-			  dataConName, dataConFieldLabels, dataConWrapId, dataConIsInfix, 
-			  isVanillaDataCon )
-import Id		( idName, globalIdDetails )
-import IdInfo		( GlobalIdDetails(..) )
-import TysWiredIn	( mkListTy )
-import DsMeta		( expQTyConName, typeQTyConName, decTyConName, qTyConName, nameTyConName )
-import ErrUtils		( Message )
-import SrcLoc		( SrcSpan, noLoc, unLoc, getLoc )
-import Outputable
-import Unique		( Unique, Uniquable(..), getKey, mkUniqueGrimily )
-
-import BasicTypes	( StrictnessMark(..), Fixity(..), FixityDirection(..) )
-import Panic		( showException )
-import FastString	( LitString )
-
-import GHC.Base		( unsafeCoerce#, Int#, Int(..) )	-- Should have a better home in the module hierarchy
-import Monad 		( liftM )
-
-#ifdef GHCI
-import FastString	( mkFastString )
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Main interface + stubs for the non-GHCI case
-%*									*
-%************************************************************************
-
-\begin{code}
-tcSpliceDecls :: LHsExpr Name -> TcM [LHsDecl RdrName]
-tcSpliceExpr  :: HsSplice Name -> BoxyRhoType -> TcM (HsExpr TcId)
-kcSpliceType  :: HsSplice Name -> TcM (HsType Name, TcKind)
-
-#ifndef GHCI
-tcSpliceExpr n e ty = pprPanic "Cant do tcSpliceExpr without GHCi" (ppr e)
-tcSpliceDecls e     = pprPanic "Cant do tcSpliceDecls without GHCi" (ppr e)
-#else
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Quoting an expression}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcBracket :: HsBracket Name -> BoxyRhoType -> TcM (LHsExpr Id)
-tcBracket brack res_ty
-  = getStage 				`thenM` \ level ->
-    case bracketOK level of {
-	Nothing         -> failWithTc (illegalBracket level) ;
-	Just next_level ->
-
-   	-- Typecheck expr to make sure it is valid,
-	-- but throw away the results.  We'll type check
-	-- it again when we actually use it.
-    recordThUse				`thenM_`
-    newMutVar []	 		`thenM` \ pending_splices ->
-    getLIEVar				`thenM` \ lie_var ->
-
-    setStage (Brack next_level pending_splices lie_var) (
-	getLIE (tc_bracket brack)
-    )					`thenM` \ (meta_ty, lie) ->
-    tcSimplifyBracket lie 		`thenM_`  
-
-	-- Make the expected type have the right shape
-    boxyUnify meta_ty res_ty		`thenM_`
-
-	-- Return the original expression, not the type-decorated one
-    readMutVar pending_splices		`thenM` \ pendings ->
-    returnM (noLoc (HsBracketOut brack pendings))
-    }
-
-tc_bracket :: HsBracket Name -> TcM TcType
-tc_bracket (VarBr v) 
-  = tcMetaTy nameTyConName 	-- Result type is Var (not Q-monadic)
-
-tc_bracket (ExpBr expr) 
-  = newFlexiTyVarTy liftedTypeKind	`thenM` \ any_ty ->
-    tcMonoExpr expr any_ty		`thenM_`
-    tcMetaTy expQTyConName
-	-- Result type is Expr (= Q Exp)
-
-tc_bracket (TypBr typ) 
-  = tcHsSigType ExprSigCtxt typ		`thenM_`
-    tcMetaTy typeQTyConName
-	-- Result type is Type (= Q Typ)
-
-tc_bracket (DecBr decls)
-  = do	{  tcTopSrcDecls emptyModDetails decls
-	-- Typecheck the declarations, dicarding the result
-	-- We'll get all that stuff later, when we splice it in
-
-	; decl_ty <- tcMetaTy decTyConName
-	; q_ty    <- tcMetaTy qTyConName
-	; return (mkAppTy q_ty (mkListTy decl_ty))
-	-- Result type is Q [Dec]
-    }
-
-tc_bracket (PatBr _)
-  = failWithTc (ptext SLIT("Tempate Haskell pattern brackets are not supported yet"))
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Splicing an expression}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcSpliceExpr (HsSplice name expr) res_ty
-  = setSrcSpan (getLoc expr) 	$
-    getStage		`thenM` \ level ->
-    case spliceOK level of {
-	Nothing 	-> failWithTc (illegalSplice level) ;
-	Just next_level -> 
-
-    case level of {
-	Comp 		       -> do { e <- tcTopSplice expr res_ty
-				     ; returnM (unLoc e) } ;
-	Brack _ ps_var lie_var ->  
-
-	-- A splice inside brackets
-  	-- NB: ignore res_ty, apart from zapping it to a mono-type
-	-- e.g.   [| reverse $(h 4) |]
-	-- Here (h 4) :: Q Exp
-	-- but $(h 4) :: forall a.a 	i.e. anything!
-
-    unBox res_ty				`thenM_`
-    tcMetaTy expQTyConName			`thenM` \ meta_exp_ty ->
-    setStage (Splice next_level) (
-	setLIEVar lie_var	   $
-	tcMonoExpr expr meta_exp_ty
-    )						`thenM` \ expr' ->
-
-	-- Write the pending splice into the bucket
-    readMutVar ps_var				`thenM` \ ps ->
-    writeMutVar ps_var ((name,expr') : ps) 	`thenM_`
-
-    returnM (panic "tcSpliceExpr")	-- The returned expression is ignored
-    }} 
-
--- tcTopSplice used to have this:
--- Note that we do not decrement the level (to -1) before 
--- typechecking the expression.  For example:
---	f x = $( ...$(g 3) ... )
--- The recursive call to tcMonoExpr will simply expand the 
--- inner escape before dealing with the outer one
-
-tcTopSplice :: LHsExpr Name -> BoxyRhoType -> TcM (LHsExpr Id)
-tcTopSplice expr res_ty
-  = tcMetaTy expQTyConName		`thenM` \ meta_exp_ty ->
-
-	-- Typecheck the expression
-    tcTopSpliceExpr expr meta_exp_ty	`thenM` \ zonked_q_expr ->
-
-	-- Run the expression
-    traceTc (text "About to run" <+> ppr zonked_q_expr) 	`thenM_`
-    runMetaE convertToHsExpr zonked_q_expr	`thenM` \ expr2 ->
-  
-    traceTc (text "Got result" <+> ppr expr2) 	`thenM_`
-
-    showSplice "expression" 
-	       zonked_q_expr (ppr expr2)	`thenM_`
-
-	-- Rename it, but bale out if there are errors
-	-- otherwise the type checker just gives more spurious errors
-    checkNoErrs (rnLExpr expr2)			`thenM` \ (exp3, fvs) ->
-
-    tcMonoExpr exp3 res_ty
-
-
-tcTopSpliceExpr :: LHsExpr Name -> TcType -> TcM (LHsExpr Id)
--- Type check an expression that is the body of a top-level splice
---   (the caller will compile and run it)
-tcTopSpliceExpr expr meta_ty
-  = checkNoErrs $	-- checkNoErrs: must not try to run the thing
-			--	        if the type checker fails!
-
-    setStage topSpliceStage $ do
-
-	
-    do	{ recordThUse	-- Record that TH is used (for pkg depdendency)
-
-	-- Typecheck the expression
-	; (expr', lie) <- getLIE (tcMonoExpr expr meta_ty)
-	
-	-- Solve the constraints
-	; const_binds <- tcSimplifyTop lie
-	
-	-- And zonk it
-	; zonkTopLExpr (mkHsDictLet const_binds expr') }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Splicing a type
-%*									*
-%************************************************************************
-
-Very like splicing an expression, but we don't yet share code.
-
-\begin{code}
-kcSpliceType (HsSplice name hs_expr)
-  = setSrcSpan (getLoc hs_expr) $ do 	
-	{ level <- getStage
-	; case spliceOK level of {
-		Nothing 	-> failWithTc (illegalSplice level) ;
-		Just next_level -> do 
-
-	{ case level of {
-		Comp 		       -> do { (t,k) <- kcTopSpliceType hs_expr 
-					     ; return (unLoc t, k) } ;
-		Brack _ ps_var lie_var -> do
-
-	{ 	-- A splice inside brackets
-	; meta_ty <- tcMetaTy typeQTyConName
-	; expr' <- setStage (Splice next_level) $
-		   setLIEVar lie_var	   	$
-		   tcMonoExpr hs_expr meta_ty
-
-		-- Write the pending splice into the bucket
-	; ps <- readMutVar ps_var
-	; writeMutVar ps_var ((name,expr') : ps)
-
-	-- e.g.   [| Int -> $(h 4) |]
-	-- Here (h 4) :: Q Type
-	-- but $(h 4) :: forall a.a 	i.e. any kind
-	; kind <- newKindVar
-	; returnM (panic "kcSpliceType", kind)	-- The returned type is ignored
-    }}}}}
-
-kcTopSpliceType :: LHsExpr Name -> TcM (LHsType Name, TcKind)
-kcTopSpliceType expr
-  = do	{ meta_ty <- tcMetaTy typeQTyConName
-
-	-- Typecheck the expression
-	; zonked_q_expr <- tcTopSpliceExpr expr meta_ty
-
-	-- Run the expression
-	; traceTc (text "About to run" <+> ppr zonked_q_expr)
-	; hs_ty2 <- runMetaT convertToHsType zonked_q_expr
-  
-	; traceTc (text "Got result" <+> ppr hs_ty2)
-
-	; showSplice "type" zonked_q_expr (ppr hs_ty2)
-
-	-- Rename it, but bale out if there are errors
-	-- otherwise the type checker just gives more spurious errors
-	; let doc = ptext SLIT("In the spliced type") <+> ppr hs_ty2
-	; hs_ty3 <- checkNoErrs (rnLHsType doc hs_ty2)
-
-	; kcHsType hs_ty3 }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Splicing an expression}
-%*									*
-%************************************************************************
-
-\begin{code}
--- Always at top level
--- Type sig at top of file:
--- 	tcSpliceDecls :: LHsExpr Name -> TcM [LHsDecl RdrName]
-tcSpliceDecls expr
-  = do	{ meta_dec_ty <- tcMetaTy decTyConName
-	; meta_q_ty <- tcMetaTy qTyConName
-	; let list_q = mkAppTy meta_q_ty (mkListTy meta_dec_ty)
-	; zonked_q_expr <- tcTopSpliceExpr expr list_q
-
-		-- Run the expression
-	; traceTc (text "About to run" <+> ppr zonked_q_expr)
-	; decls <- runMetaD convertToHsDecls zonked_q_expr
-
-	; traceTc (text "Got result" <+> vcat (map ppr decls))
-	; showSplice "declarations"
-	  	     zonked_q_expr 
-		     (ppr (getLoc expr) $$ (vcat (map ppr decls)))
-	; returnM decls }
-
-  where handleErrors :: [Either a Message] -> TcM [a]
-        handleErrors [] = return []
-        handleErrors (Left x:xs) = liftM (x:) (handleErrors xs)
-        handleErrors (Right m:xs) = do addErrTc m
-                                       handleErrors xs
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Running an expression}
-%*									*
-%************************************************************************
-
-\begin{code}
-runMetaE :: (SrcSpan -> TH.Exp -> Either Message (LHsExpr RdrName))
-	 -> LHsExpr Id 		-- Of type (Q Exp)
-	 -> TcM (LHsExpr RdrName)
-runMetaE  = runMeta
-
-runMetaT :: (SrcSpan -> TH.Type -> Either Message (LHsType RdrName))
-	 -> LHsExpr Id 		-- Of type (Q Type)
-	 -> TcM (LHsType RdrName)	
-runMetaT = runMeta
-
-runMetaD :: (SrcSpan -> [TH.Dec] -> Either Message [LHsDecl RdrName])
-	 -> LHsExpr Id 		-- Of type Q [Dec]
-	 -> TcM [LHsDecl RdrName]
-runMetaD = runMeta 
-
-runMeta :: (SrcSpan -> th_syn -> Either Message hs_syn)
-	-> LHsExpr Id 		-- Of type X
-	-> TcM hs_syn		-- Of type t
-runMeta convert expr
-  = do	{ hsc_env <- getTopEnv
-	; tcg_env <- getGblEnv
-	; this_mod <- getModule
-	; let type_env = tcg_type_env tcg_env
-	      rdr_env  = tcg_rdr_env tcg_env
-
-	-- Compile and link it; might fail if linking fails
-	; either_hval <- tryM $ ioToTcRn $
-			 HscMain.compileExpr 
-				      hsc_env this_mod 
-			              rdr_env type_env expr
-	; case either_hval of {
-	    Left exn   -> failWithTc (mk_msg "compile and link" exn) ;
-	    Right hval -> do
-
-	{ 	-- Coerce it to Q t, and run it
-		-- Running might fail if it throws an exception of any kind (hence tryAllM)
-		-- including, say, a pattern-match exception in the code we are running
-		--
-		-- We also do the TH -> HS syntax conversion inside the same
-		-- exception-cacthing thing so that if there are any lurking 
-		-- exceptions in the data structure returned by hval, we'll
-		-- encounter them inside the tryALlM
-	  either_tval <- tryAllM $ do
-		{ th_syn <- TH.runQ (unsafeCoerce# hval)
-		; case convert (getLoc expr) th_syn of
-		    Left err     -> do { addErrTc err; return Nothing }
-		    Right hs_syn -> return (Just hs_syn) }
-
-	; case either_tval of
-	      Right (Just v) -> return v
-	      Right Nothing  -> failM	-- Error already in Tc monad
-	      Left exn       -> failWithTc (mk_msg "run" exn)	-- Exception
-	}}}
-  where
-    mk_msg s exn = vcat [text "Exception when trying to" <+> text s <+> text "compile-time code:",
-			 nest 2 (text (Panic.showException exn)),
-			 nest 2 (text "Code:" <+> ppr expr)]
-\end{code}
-
-To call runQ in the Tc monad, we need to make TcM an instance of Quasi:
-
-\begin{code}
-instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
-  qNewName s = do { u <- newUnique 
-		  ; let i = getKey u
-		  ; return (TH.mkNameU s i) }
-
-  qReport True msg  = addErr (text msg)
-  qReport False msg = addReport (text msg)
-
-  qCurrentModule = do { m <- getModule; return (moduleString m) }
-  qReify v = reify v
-  qRecover = recoverM
-
-  qRunIO io = ioToTcRn io
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Errors and contexts}
-%*									*
-%************************************************************************
-
-\begin{code}
-showSplice :: String -> LHsExpr Id -> SDoc -> TcM ()
-showSplice what before after
-  = getSrcSpanM		`thenM` \ loc ->
-    traceSplice (vcat [ppr loc <> colon <+> text "Splicing" <+> text what, 
-		       nest 2 (sep [nest 2 (ppr before),
-				    text "======>",
-				    nest 2 after])])
-
-illegalBracket level
-  = ptext SLIT("Illegal bracket at level") <+> ppr level
-
-illegalSplice level
-  = ptext SLIT("Illegal splice at level") <+> ppr level
-
-#endif 	/* GHCI */
-\end{code}
-
-
-%************************************************************************
-%*									*
-			Reification
-%*									*
-%************************************************************************
-
-
-\begin{code}
-reify :: TH.Name -> TcM TH.Info
-reify th_name
-  = do	{ name <- lookupThName th_name
-	; thing <- tcLookupTh name
-		-- ToDo: this tcLookup could fail, which would give a
-		-- 	 rather unhelpful error message
-	; traceIf (text "reify" <+> text (show th_name) <+> brackets (ppr_ns th_name) <+> ppr name)
-	; reifyThing thing
-    }
-  where
-    ppr_ns (TH.Name _ (TH.NameG TH.DataName mod)) = text "data"
-    ppr_ns (TH.Name _ (TH.NameG TH.TcClsName mod)) = text "tc"
-    ppr_ns (TH.Name _ (TH.NameG TH.VarName mod)) = text "var"
-
-lookupThName :: TH.Name -> TcM Name
-lookupThName th_name@(TH.Name occ flavour)
-  =  do { let rdr_name = thRdrName guessed_ns occ_str flavour
-
-	-- Repeat much of lookupOccRn, becase we want
-	-- to report errors in a TH-relevant way
-	; rdr_env <- getLocalRdrEnv
-	; case lookupLocalRdrEnv rdr_env rdr_name of
-	    Just name -> return name
-	    Nothing | not (isSrcRdrName rdr_name)	-- Exact, Orig
-		    -> lookupImportedName rdr_name
-		    | otherwise				-- Unqual, Qual
-		    -> do { 
-				  mb_name <- lookupSrcOcc_maybe rdr_name
-			  ; case mb_name of
-			      Just name -> return name
-			      Nothing   -> failWithTc (notInScope th_name) }
-	}
-  where
-	-- guessed_ns is the name space guessed from looking at the TH name
-    guessed_ns | isLexCon (mkFastString occ_str) = OccName.dataName
-	       | otherwise			 = OccName.varName
-    occ_str = TH.occString occ
-
-tcLookupTh :: Name -> TcM TcTyThing
--- This is a specialised version of TcEnv.tcLookup; specialised mainly in that
--- it gives a reify-related error message on failure, whereas in the normal
--- tcLookup, failure is a bug.
-tcLookupTh name
-  = do	{ (gbl_env, lcl_env) <- getEnvs
-	; case lookupNameEnv (tcl_env lcl_env) name of {
-		Just thing -> returnM thing;
-		Nothing    -> do
-	{ if nameIsLocalOrFrom (tcg_mod gbl_env) name
-	  then	-- It's defined in this module
-	      case lookupNameEnv (tcg_type_env gbl_env) name of
-		Just thing -> return (AGlobal thing)
-		Nothing	   -> failWithTc (notInEnv name)
-	 
-	  else do 		-- It's imported
-	{ (eps,hpt) <- getEpsAndHpt
-	; case lookupType hpt (eps_PTE eps) name of 
-	    Just thing -> return (AGlobal thing)
-	    Nothing    -> do { thing <- tcImportDecl name
-			     ; return (AGlobal thing) }
-		-- Imported names should always be findable; 
-		-- if not, we fail hard in tcImportDecl
-    }}}}
-
-notInScope :: TH.Name -> SDoc
-notInScope th_name = quotes (text (TH.pprint th_name)) <+> 
-		     ptext SLIT("is not in scope at a reify")
-	-- Ugh! Rather an indirect way to display the name
-
-notInEnv :: Name -> SDoc
-notInEnv name = quotes (ppr name) <+> 
-		     ptext SLIT("is not in the type environment at a reify")
-
-------------------------------
-reifyThing :: TcTyThing -> TcM TH.Info
--- The only reason this is monadic is for error reporting,
--- which in turn is mainly for the case when TH can't express
--- some random GHC extension
-
-reifyThing (AGlobal (AnId id))
-  = do	{ ty <- reifyType (idType id)
-	; fix <- reifyFixity (idName id)
-	; let v = reifyName id
-	; case globalIdDetails id of
-	    ClassOpId cls    -> return (TH.ClassOpI v ty (reifyName cls) fix)
-	    other	     -> return (TH.VarI     v ty Nothing fix)
-    }
-
-reifyThing (AGlobal (ATyCon tc))  = reifyTyCon tc
-reifyThing (AGlobal (AClass cls)) = reifyClass cls
-reifyThing (AGlobal (ADataCon dc))
-  = do	{ let name = dataConName dc
-	; ty <- reifyType (idType (dataConWrapId dc))
-	; fix <- reifyFixity name
-	; return (TH.DataConI (reifyName name) ty (reifyName (dataConTyCon dc)) fix) }
-
-reifyThing (ATcId id _ _) 
-  = do	{ ty1 <- zonkTcType (idType id)	-- Make use of all the info we have, even
-					-- though it may be incomplete
-	; ty2 <- reifyType ty1
-	; fix <- reifyFixity (idName id)
-	; return (TH.VarI (reifyName id) ty2 Nothing fix) }
-
-reifyThing (ATyVar tv ty) 
-  = do	{ ty1 <- zonkTcType ty
-	; ty2 <- reifyType ty1
-	; return (TH.TyVarI (reifyName tv) ty2) }
-
-------------------------------
-reifyTyCon :: TyCon -> TcM TH.Info
-reifyTyCon tc
-  | isFunTyCon tc  = return (TH.PrimTyConI (reifyName tc) 2 		  False)
-  | isPrimTyCon tc = return (TH.PrimTyConI (reifyName tc) (tyConArity tc) (isUnLiftedTyCon tc))
-  | isSynTyCon tc
-  = do	{ let (tvs, rhs) = synTyConDefn tc
-	; rhs' <- reifyType rhs
-	; return (TH.TyConI $ TH.TySynD (reifyName tc) (reifyTyVars tvs) rhs') }
-
-reifyTyCon tc
-  = do 	{ cxt <- reifyCxt (tyConStupidTheta tc)
-	; cons <- mapM reifyDataCon (tyConDataCons tc)
-	; let name = reifyName tc
-	      tvs  = reifyTyVars (tyConTyVars tc)
-	      deriv = []	-- Don't know about deriving
-	      decl | isNewTyCon tc = TH.NewtypeD cxt name tvs (head cons) deriv
-		   | otherwise	   = TH.DataD    cxt name tvs cons 	  deriv
-	; return (TH.TyConI decl) }
-
-reifyDataCon :: DataCon -> TcM TH.Con
-reifyDataCon dc
-  | isVanillaDataCon dc
-  = do 	{ arg_tys <- reifyTypes (dataConOrigArgTys dc)
-	; let stricts = map reifyStrict (dataConStrictMarks dc)
-	      fields  = dataConFieldLabels dc
-	      name    = reifyName dc
-	      [a1,a2] = arg_tys
-	      [s1,s2] = stricts
-	; ASSERT( length arg_tys == length stricts )
-          if not (null fields) then
-	     return (TH.RecC name (zip3 (map reifyName fields) stricts arg_tys))
-	  else
-	  if dataConIsInfix dc then
-	     ASSERT( length arg_tys == 2 )
-	     return (TH.InfixC (s1,a1) name (s2,a2))
-	  else
-	     return (TH.NormalC name (stricts `zip` arg_tys)) }
-  | otherwise
-  = failWithTc (ptext SLIT("Can't reify a non-Haskell-98 data constructor:") 
-		<+> quotes (ppr dc))
-
-------------------------------
-reifyClass :: Class -> TcM TH.Info
-reifyClass cls 
-  = do	{ cxt <- reifyCxt theta
-	; ops <- mapM reify_op op_stuff
-	; return (TH.ClassI $ TH.ClassD cxt (reifyName cls) (reifyTyVars tvs) fds' ops) }
-  where
-    (tvs, fds, theta, _, op_stuff) = classExtraBigSig cls
-    fds' = map reifyFunDep fds
-    reify_op (op, _) = do { ty <- reifyType (idType op)
-			  ; return (TH.SigD (reifyName op) ty) }
-
-------------------------------
-reifyType :: TypeRep.Type -> TcM TH.Type
-reifyType (TyVarTy tv)	    = return (TH.VarT (reifyName tv))
-reifyType (TyConApp tc tys) = reify_tc_app (reifyName tc) tys
-reifyType (NoteTy _ ty)     = reifyType ty
-reifyType (AppTy t1 t2)     = do { [r1,r2] <- reifyTypes [t1,t2] ; return (r1 `TH.AppT` r2) }
-reifyType (FunTy t1 t2)     = do { [r1,r2] <- reifyTypes [t1,t2] ; return (TH.ArrowT `TH.AppT` r1 `TH.AppT` r2) }
-reifyType ty@(ForAllTy _ _) = do { cxt' <- reifyCxt cxt; 
-				 ; tau' <- reifyType tau 
-				 ; return (TH.ForallT (reifyTyVars tvs) cxt' tau') }
-			    where
-				(tvs, cxt, tau) = tcSplitSigmaTy ty
-reifyTypes = mapM reifyType
-reifyCxt   = mapM reifyPred
-
-reifyFunDep :: ([TyVar], [TyVar]) -> TH.FunDep
-reifyFunDep (xs, ys) = TH.FunDep (map reifyName xs) (map reifyName ys)
-
-reifyTyVars :: [TyVar] -> [TH.Name]
-reifyTyVars = map reifyName
-
-reify_tc_app :: TH.Name -> [TypeRep.Type] -> TcM TH.Type
-reify_tc_app tc tys = do { tys' <- reifyTypes tys 
-			 ; return (foldl TH.AppT (TH.ConT tc) tys') }
-
-reifyPred :: TypeRep.PredType -> TcM TH.Type
-reifyPred (ClassP cls tys) = reify_tc_app (reifyName cls) tys
-reifyPred p@(IParam _ _)   = noTH SLIT("implicit parameters") (ppr p)
-
-
-------------------------------
-reifyName :: NamedThing n => n -> TH.Name
-reifyName thing
-  | isExternalName name = mk_varg mod occ_str
-  | otherwise	        = TH.mkNameU occ_str (getKey (getUnique name))
-	-- Many of the things we reify have local bindings, and 
-	-- NameL's aren't supposed to appear in binding positions, so
-	-- we use NameU.  When/if we start to reify nested things, that
-	-- have free variables, we may need to generate NameL's for them.
-  where
-    name    = getName thing
-    mod     = moduleString (nameModule name)
-    occ_str = occNameString occ
-    occ     = nameOccName name
-    mk_varg | OccName.isDataOcc occ = TH.mkNameG_d
-	    | OccName.isVarOcc  occ = TH.mkNameG_v
-	    | OccName.isTcOcc   occ = TH.mkNameG_tc
-	    | otherwise		    = pprPanic "reifyName" (ppr name)
-
-------------------------------
-reifyFixity :: Name -> TcM TH.Fixity
-reifyFixity name
-  = do	{ fix <- lookupFixityRn name
-	; return (conv_fix fix) }
-    where
-      conv_fix (BasicTypes.Fixity i d) = TH.Fixity i (conv_dir d)
-      conv_dir BasicTypes.InfixR = TH.InfixR
-      conv_dir BasicTypes.InfixL = TH.InfixL
-      conv_dir BasicTypes.InfixN = TH.InfixN
-
-reifyStrict :: BasicTypes.StrictnessMark -> TH.Strict
-reifyStrict MarkedStrict    = TH.IsStrict
-reifyStrict MarkedUnboxed   = TH.IsStrict
-reifyStrict NotMarkedStrict = TH.NotStrict
-
-------------------------------
-noTH :: LitString -> SDoc -> TcM a
-noTH s d = failWithTc (hsep [ptext SLIT("Can't represent") <+> ptext s <+> 
-				ptext SLIT("in Template Haskell:"),
-		 	     nest 2 d])
-\end{code}
diff --git a/ghc/compiler/typecheck/TcSplice.lhs-boot b/ghc/compiler/typecheck/TcSplice.lhs-boot
deleted file mode 100644
index d161770672..0000000000
--- a/ghc/compiler/typecheck/TcSplice.lhs-boot
+++ /dev/null
@@ -1,21 +0,0 @@
-\begin{code}
-module TcSplice where
-import HsSyn	( HsSplice, HsBracket, HsExpr, LHsExpr, HsType, LHsDecl )
-import Var	( Id )
-import Name	( Name )
-import RdrName	( RdrName )
-import TcRnTypes( TcM )
-import TcType	( TcKind, BoxyRhoType )
-
-tcSpliceExpr :: HsSplice Name
-	     -> BoxyRhoType
-	     -> TcM (HsExpr Id)
-
-kcSpliceType :: HsSplice Name -> TcM (HsType Name, TcKind)
-
-tcBracket :: HsBracket Name 
-	  -> BoxyRhoType
-	  -> TcM (LHsExpr Id)
-
-tcSpliceDecls :: LHsExpr Name -> TcM [LHsDecl RdrName]
-\end{code}
diff --git a/ghc/compiler/typecheck/TcTyClsDecls.lhs b/ghc/compiler/typecheck/TcTyClsDecls.lhs
deleted file mode 100644
index 9e0b6cc6ed..0000000000
--- a/ghc/compiler/typecheck/TcTyClsDecls.lhs
+++ /dev/null
@@ -1,829 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1996-1998
-%
-\section[TcTyClsDecls]{Typecheck type and class declarations}
-
-\begin{code}
-module TcTyClsDecls (
-	tcTyAndClassDecls
-    ) where
-
-#include "HsVersions.h"
-
-import HsSyn		( TyClDecl(..),  HsConDetails(..), HsTyVarBndr(..),
-			  ConDecl(..),   Sig(..), , NewOrData(..), ResType(..),
-			  tyClDeclTyVars, isSynDecl, hsConArgs,
-			  LTyClDecl, tcdName, hsTyVarName, LHsTyVarBndr
-			)
-import HsTypes          ( HsBang(..), getBangStrictness )
-import BasicTypes	( RecFlag(..), StrictnessMark(..) )
-import HscTypes		( implicitTyThings, ModDetails )
-import BuildTyCl	( buildClass, buildAlgTyCon, buildSynTyCon, buildDataCon,
-			  mkDataTyConRhs, mkNewTyConRhs )
-import TcRnMonad
-import TcEnv		( TyThing(..), 
-			  tcLookupLocated, tcLookupLocatedGlobal, 
-			  tcExtendGlobalEnv, tcExtendKindEnv, tcExtendKindEnvTvs,
-			  tcExtendRecEnv, tcLookupTyVar )
-import TcTyDecls	( calcTyConArgVrcs, calcRecFlags, calcClassCycles, calcSynCycles )
-import TcClassDcl	( tcClassSigs, tcAddDeclCtxt )
-import TcHsType		( kcHsTyVars, kcHsLiftedSigType, kcHsType, 
-			  kcHsContext, tcTyVarBndrs, tcHsKindedType, tcHsKindedContext,
-			  kcHsSigType, tcHsBangType, tcLHsConResTy, tcDataKindSig )
-import TcMType		( newKindVar, checkValidTheta, checkValidType, 
-			  -- checkFreeness, 
-			  UserTypeCtxt(..), SourceTyCtxt(..) ) 
-import TcType		( TcKind, TcType, tyVarsOfType, mkPhiTy,
-			  mkArrowKind, liftedTypeKind, mkTyVarTys, 
-			  tcSplitSigmaTy, tcEqTypes, tcGetTyVar_maybe )
-import Type		( splitTyConApp_maybe, 
-			  -- pprParendType, pprThetaArrow
-			)
-import Kind		( mkArrowKinds, splitKindFunTys )
-import Generics		( validGenericMethodType, canDoGenerics )
-import Class		( Class, className, classTyCon, DefMeth(..), classBigSig, classTyVars )
-import TyCon		( TyCon, ArgVrcs, AlgTyConRhs( AbstractTyCon ),
-			  tyConDataCons, mkForeignTyCon, isProductTyCon, isRecursiveTyCon,
-			  tyConStupidTheta, synTyConRhs, isSynTyCon, tyConName )
-import DataCon		( DataCon, dataConWrapId, dataConName, 
-			  dataConFieldLabels, dataConTyCon,
-			  dataConTyVars, dataConFieldType, dataConResTys )
-import Var		( TyVar, idType, idName )
-import VarSet		( elemVarSet, mkVarSet )
-import Name		( Name, getSrcLoc )
-import Outputable
-import Maybe		( isJust )
-import Maybes		( expectJust )
-import Unify		( tcMatchTys, tcMatchTyX )
-import Util		( zipLazy, isSingleton, notNull, sortLe )
-import List		( partition )
-import SrcLoc		( Located(..), unLoc, getLoc, srcLocSpan )
-import ListSetOps	( equivClasses )
-import List		( delete )
-import Digraph		( SCC(..) )
-import DynFlags		( DynFlag( Opt_GlasgowExts, Opt_Generics, 
-					Opt_UnboxStrictFields ) )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Type checking for type and class declarations}
-%*									*
-%************************************************************************
-
-Dealing with a group
-~~~~~~~~~~~~~~~~~~~~
-Consider a mutually-recursive group, binding 
-a type constructor T and a class C.
-
-Step 1: 	getInitialKind
-	Construct a KindEnv by binding T and C to a kind variable 
-
-Step 2: 	kcTyClDecl
-	In that environment, do a kind check
-
-Step 3: Zonk the kinds
-
-Step 4: 	buildTyConOrClass
-	Construct an environment binding T to a TyCon and C to a Class.
-	a) Their kinds comes from zonking the relevant kind variable
-	b) Their arity (for synonyms) comes direct from the decl
-	c) The funcional dependencies come from the decl
-	d) The rest comes a knot-tied binding of T and C, returned from Step 4
-	e) The variances of the tycons in the group is calculated from 
-		the knot-tied stuff
-
-Step 5: 	tcTyClDecl1
-	In this environment, walk over the decls, constructing the TyCons and Classes.
-	This uses in a strict way items (a)-(c) above, which is why they must
-	be constructed in Step 4. Feed the results back to Step 4.
-	For this step, pass the is-recursive flag as the wimp-out flag
-	to tcTyClDecl1.
-	
-
-Step 6:		Extend environment
-	We extend the type environment with bindings not only for the TyCons and Classes,
-	but also for their "implicit Ids" like data constructors and class selectors
-
-Step 7:		checkValidTyCl
-	For a recursive group only, check all the decls again, just
-	to check all the side conditions on validity.  We could not
-	do this before because we were in a mutually recursive knot.
-
-
-The knot-tying parameters: @rec_details_list@ is an alist mapping @Name@s to
-@TyThing@s.  @rec_vrcs@ is a finite map from @Name@s to @ArgVrcs@s.
-
-\begin{code}
-tcTyAndClassDecls :: ModDetails -> [LTyClDecl Name]
-   	           -> TcM TcGblEnv 	-- Input env extended by types and classes 
-					-- and their implicit Ids,DataCons
-tcTyAndClassDecls boot_details decls
-  = do	{ 	-- First check for cyclic type synonysm or classes
-		-- See notes with checkCycleErrs
-	  checkCycleErrs decls
-	; mod <- getModule
-	; traceTc (text "tcTyAndCl" <+> ppr mod)
-	; (syn_tycons, alg_tyclss) <- fixM (\ ~(rec_syn_tycons, rec_alg_tyclss) ->
-	  do	{ let {	-- Calculate variances and rec-flag
-		      ; (syn_decls, alg_decls) = partition (isSynDecl . unLoc) decls }
-
-			-- Extend the global env with the knot-tied results
-			-- for data types and classes
-			-- 
-			-- We must populate the environment with the loop-tied T's right
-			-- away, because the kind checker may "fault in" some type 
-			-- constructors that recursively mention T
-		; let { gbl_things = mkGlobalThings alg_decls rec_alg_tyclss }
-		; tcExtendRecEnv gbl_things $ do
-
-			-- Kind-check the declarations
-		{ (kc_syn_decls, kc_alg_decls) <- kcTyClDecls syn_decls alg_decls
-
-		; let {	calc_vrcs = calcTyConArgVrcs (rec_syn_tycons ++ rec_alg_tyclss)
-		      ; calc_rec  = calcRecFlags boot_details rec_alg_tyclss
-		      ; tc_decl   = addLocM (tcTyClDecl calc_vrcs calc_rec) }
-			-- Type-check the type synonyms, and extend the envt
-		; syn_tycons <- tcSynDecls calc_vrcs kc_syn_decls
-		; tcExtendGlobalEnv syn_tycons $ do
-
-			-- Type-check the data types and classes
-		{ alg_tyclss <- mappM tc_decl kc_alg_decls
-		; return (syn_tycons, alg_tyclss)
-	    }}})
-	-- Finished with knot-tying now
-	-- Extend the environment with the finished things
-	; tcExtendGlobalEnv (syn_tycons ++ alg_tyclss) $ do
-
-	-- Perform the validity check
-	{ traceTc (text "ready for validity check")
-	; mappM_ (addLocM checkValidTyCl) decls
- 	; traceTc (text "done")
-   
-	-- Add the implicit things;
-	-- we want them in the environment because 
-	-- they may be mentioned in interface files
-	; let {	implicit_things = concatMap implicitTyThings alg_tyclss }
-	; traceTc ((text "Adding" <+> ppr alg_tyclss) $$ (text "and" <+> ppr implicit_things))
-  	; tcExtendGlobalEnv implicit_things getGblEnv
-    }}
-
-mkGlobalThings :: [LTyClDecl Name] 	-- The decls
-	       -> [TyThing]		-- Knot-tied, in 1-1 correspondence with the decls
-	       -> [(Name,TyThing)]
--- Driven by the Decls, and treating the TyThings lazily
--- make a TypeEnv for the new things
-mkGlobalThings decls things
-  = map mk_thing (decls `zipLazy` things)
-  where
-    mk_thing (L _ (ClassDecl {tcdLName = L _ name}), ~(AClass cl))
-	 = (name, AClass cl)
-    mk_thing (L _ decl, ~(ATyCon tc))
-         = (tcdName decl, ATyCon tc)
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Kind checking
-%*									*
-%************************************************************************
-
-We need to kind check all types in the mutually recursive group
-before we know the kind of the type variables.  For example:
-
-class C a where
-   op :: D b => a -> b -> b
-
-class D c where
-   bop :: (Monad c) => ...
-
-Here, the kind of the locally-polymorphic type variable "b"
-depends on *all the uses of class D*.  For example, the use of
-Monad c in bop's type signature means that D must have kind Type->Type.
-
-However type synonyms work differently.  They can have kinds which don't
-just involve (->) and *:
-	type R = Int#		-- Kind #
-	type S a = Array# a	-- Kind * -> #
-	type T a b = (# a,b #)	-- Kind * -> * -> (# a,b #)
-So we must infer their kinds from their right-hand sides *first* and then
-use them, whereas for the mutually recursive data types D we bring into
-scope kind bindings D -> k, where k is a kind variable, and do inference.
-
-\begin{code}
-kcTyClDecls syn_decls alg_decls
-  = do	{ 	-- First extend the kind env with each data 
-		-- type and class, mapping them to a type variable
-	  alg_kinds <- mappM getInitialKind alg_decls
-	; tcExtendKindEnv alg_kinds $ do
-
-		-- Now kind-check the type synonyms, in dependency order
-		-- We do these differently to data type and classes,
-		-- because a type synonym can be an unboxed type
-		--	type Foo = Int#
-		-- and a kind variable can't unify with UnboxedTypeKind
-		-- So we infer their kinds in dependency order
-	{ (kc_syn_decls, syn_kinds) <- kcSynDecls (calcSynCycles syn_decls)
-	; tcExtendKindEnv syn_kinds $  do
-
-		-- Now kind-check the data type and class declarations, 
-		-- returning kind-annotated decls
-	{ kc_alg_decls <- mappM (wrapLocM kcTyClDecl) alg_decls
-
-	; return (kc_syn_decls, kc_alg_decls) }}}
-
-------------------------------------------------------------------------
-getInitialKind :: LTyClDecl Name -> TcM (Name, TcKind)
--- Only for data type and class declarations
--- Get as much info as possible from the data or class decl,
--- so as to maximise usefulness of error messages
-getInitialKind (L _ decl)
-  = do 	{ arg_kinds <- mapM (mk_arg_kind . unLoc) (tyClDeclTyVars decl)
-	; res_kind  <- mk_res_kind decl
-	; return (tcdName decl, mkArrowKinds arg_kinds res_kind) }
-  where
-    mk_arg_kind (UserTyVar _)        = newKindVar
-    mk_arg_kind (KindedTyVar _ kind) = return kind
-
-    mk_res_kind (TyData { tcdKindSig = Just kind }) = return kind
-	-- On GADT-style declarations we allow a kind signature
-	--	data T :: *->* where { ... }
-    mk_res_kind other = return liftedTypeKind
-
-
-----------------
-kcSynDecls :: [SCC (LTyClDecl Name)] 
-	   -> TcM ([LTyClDecl Name], 	-- Kind-annotated decls
-		   [(Name,TcKind)])	-- Kind bindings
-kcSynDecls []
-  = return ([], [])
-kcSynDecls (group : groups)
-  = do	{ (decl,  nk)  <- kcSynDecl group
-	; (decls, nks) <- tcExtendKindEnv [nk] (kcSynDecls groups)
-	; return (decl:decls, nk:nks) }
-			
-----------------
-kcSynDecl :: SCC (LTyClDecl Name) 
-	   -> TcM (LTyClDecl Name, 	-- Kind-annotated decls
-		   (Name,TcKind))	-- Kind bindings
-kcSynDecl (AcyclicSCC ldecl@(L loc decl))
-  = tcAddDeclCtxt decl	$
-    kcHsTyVars (tcdTyVars decl) (\ k_tvs ->
-    do { traceTc (text "kcd1" <+> ppr (unLoc (tcdLName decl)) <+> brackets (ppr (tcdTyVars decl)) 
-			<+> brackets (ppr k_tvs))
-       ; (k_rhs, rhs_kind) <- kcHsType (tcdSynRhs decl)
-       ; traceTc (text "kcd2" <+> ppr (unLoc (tcdLName decl)))
-       ; let tc_kind = foldr (mkArrowKind . kindedTyVarKind) rhs_kind k_tvs
-       ; return (L loc (decl { tcdTyVars = k_tvs, tcdSynRhs = k_rhs }),
-		 (unLoc (tcdLName decl), tc_kind)) })
-
-kcSynDecl (CyclicSCC decls)
-  = do { recSynErr decls; failM }	-- Fail here to avoid error cascade
-					-- of out-of-scope tycons
-
-kindedTyVarKind (L _ (KindedTyVar _ k)) = k
-
-------------------------------------------------------------------------
-kcTyClDecl :: TyClDecl Name -> TcM (TyClDecl Name)
-	-- Not used for type synonyms (see kcSynDecl)
-
-kcTyClDecl decl@(TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdCons = cons})
-  = kcTyClDeclBody decl	$ \ tvs' ->
-    do	{ ctxt' <- kcHsContext ctxt	
-	; cons' <- mappM (wrapLocM kc_con_decl) cons
-	; return (decl {tcdTyVars = tvs', tcdCtxt = ctxt', tcdCons = cons'}) }
-  where
-    kc_con_decl (ConDecl name expl ex_tvs ex_ctxt details res) = do
-      kcHsTyVars ex_tvs $ \ex_tvs' -> do
-        ex_ctxt' <- kcHsContext ex_ctxt
-        details' <- kc_con_details details 
-        res'     <- case res of
-          ResTyH98 -> return ResTyH98
-          ResTyGADT ty -> return . ResTyGADT =<< kcHsSigType ty
-        return (ConDecl name expl ex_tvs' ex_ctxt' details' res')
-
-    kc_con_details (PrefixCon btys) 
-	= do { btys' <- mappM kc_larg_ty btys ; return (PrefixCon btys') }
-    kc_con_details (InfixCon bty1 bty2) 
-	= do { bty1' <- kc_larg_ty bty1; bty2' <- kc_larg_ty bty2; return (InfixCon bty1' bty2') }
-    kc_con_details (RecCon fields) 
-	= do { fields' <- mappM kc_field fields; return (RecCon fields') }
-
-    kc_field (fld, bty) = do { bty' <- kc_larg_ty bty ; return (fld, bty') }
-
-    kc_larg_ty bty = case new_or_data of
-			DataType -> kcHsSigType bty
-			NewType  -> kcHsLiftedSigType bty
-	-- Can't allow an unlifted type for newtypes, because we're effectively
-	-- going to remove the constructor while coercing it to a lifted type.
-	-- And newtypes can't be bang'd
-
-kcTyClDecl decl@(ClassDecl {tcdCtxt = ctxt,  tcdSigs = sigs})
-  = kcTyClDeclBody decl	$ \ tvs' ->
-    do	{ is_boot <- tcIsHsBoot
-	; checkTc (not is_boot) badBootClassDeclErr
-	; ctxt' <- kcHsContext ctxt	
-	; sigs' <- mappM (wrapLocM kc_sig) sigs
-	; return (decl {tcdTyVars = tvs', tcdCtxt = ctxt', tcdSigs = sigs'}) }
-  where
-    kc_sig (TypeSig nm op_ty) = do { op_ty' <- kcHsLiftedSigType op_ty
-				   ; return (TypeSig nm op_ty') }
-    kc_sig other_sig	      = return other_sig
-
-kcTyClDecl decl@(ForeignType {})
-  = return decl
-
-kcTyClDeclBody :: TyClDecl Name
-	       -> ([LHsTyVarBndr Name] -> TcM a)
-	       -> TcM a
--- getInitialKind has made a suitably-shaped kind for the type or class
--- Unpack it, and attribute those kinds to the type variables
--- Extend the env with bindings for the tyvars, taken from
--- the kind of the tycon/class.  Give it to the thing inside, and 
- -- check the result kind matches
-kcTyClDeclBody decl thing_inside
-  = tcAddDeclCtxt decl		$
-    do 	{ tc_ty_thing <- tcLookupLocated (tcdLName decl)
-	; let tc_kind	 = case tc_ty_thing of { AThing k -> k }
-	      (kinds, _) = splitKindFunTys tc_kind
-	      hs_tvs 	 = tcdTyVars decl
-	      kinded_tvs = ASSERT( length kinds >= length hs_tvs )
-			   [ L loc (KindedTyVar (hsTyVarName tv) k)
-			   | (L loc tv, k) <- zip hs_tvs kinds]
-	; tcExtendKindEnvTvs kinded_tvs (thing_inside kinded_tvs) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Type checking}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcSynDecls :: (Name -> ArgVrcs) -> [LTyClDecl Name] -> TcM [TyThing]
-tcSynDecls calc_vrcs [] = return []
-tcSynDecls calc_vrcs (decl : decls) 
-  = do { syn_tc <- addLocM (tcSynDecl calc_vrcs) decl
-       ; syn_tcs <- tcExtendGlobalEnv [syn_tc] (tcSynDecls calc_vrcs decls)
-       ; return (syn_tc : syn_tcs) }
-
-tcSynDecl calc_vrcs 
-  (TySynonym {tcdLName = L _ tc_name, tcdTyVars = tvs, tcdSynRhs = rhs_ty})
-  = tcTyVarBndrs tvs		$ \ tvs' -> do 
-    { traceTc (text "tcd1" <+> ppr tc_name) 
-    ; rhs_ty' <- tcHsKindedType rhs_ty
-    ; return (ATyCon (buildSynTyCon tc_name tvs' rhs_ty' (calc_vrcs tc_name))) }
-
---------------------
-tcTyClDecl :: (Name -> ArgVrcs) -> (Name -> RecFlag) 
-	   -> TyClDecl Name -> TcM TyThing
-
-tcTyClDecl calc_vrcs calc_isrec decl
-  = tcAddDeclCtxt decl (tcTyClDecl1 calc_vrcs calc_isrec decl)
-
-tcTyClDecl1 calc_vrcs calc_isrec 
-  (TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdTyVars = tvs,
-	   tcdLName = L _ tc_name, tcdKindSig = mb_ksig, tcdCons = cons})
-  = tcTyVarBndrs tvs	$ \ tvs' -> do 
-  { extra_tvs <- tcDataKindSig mb_ksig
-  ; let final_tvs = tvs' ++ extra_tvs
-  ; stupid_theta <- tcHsKindedContext ctxt
-  ; want_generic <- doptM Opt_Generics
-  ; unbox_strict <- doptM Opt_UnboxStrictFields
-  ; gla_exts     <- doptM Opt_GlasgowExts
-  ; is_boot	 <- tcIsHsBoot	-- Are we compiling an hs-boot file?
-
-	-- Check that we don't use GADT syntax in H98 world
-  ; checkTc (gla_exts || h98_syntax) (badGadtDecl tc_name)
-
-	-- Check that there's at least one condecl,
-	-- or else we're reading an interface file, or -fglasgow-exts
-  ; checkTc (not (null cons) || gla_exts || is_boot)
-	    (emptyConDeclsErr tc_name)
-    
-	-- Check that a newtype has exactly one constructor
-  ; checkTc (new_or_data == DataType || isSingleton cons) 
-	    (newtypeConError tc_name (length cons))
-
-  ; tycon <- fixM (\ tycon -> do 
-	{ data_cons <- mappM (addLocM (tcConDecl unbox_strict new_or_data 
-						 tycon final_tvs)) 
-			     cons
-	; let tc_rhs 
-		| null cons && is_boot 	-- In a hs-boot file, empty cons means
-		= AbstractTyCon		-- "don't know"; hence Abstract
-		| otherwise
-		= case new_or_data of
-			DataType -> mkDataTyConRhs data_cons
-			NewType  -> ASSERT( isSingleton data_cons )
-				    mkNewTyConRhs tycon (head data_cons)
-	; buildAlgTyCon tc_name final_tvs stupid_theta tc_rhs arg_vrcs is_rec
-			(want_generic && canDoGenerics data_cons)
-	})
-  ; return (ATyCon tycon)
-  }
-  where
-    arg_vrcs = calc_vrcs tc_name
-    is_rec   = calc_isrec tc_name
-    h98_syntax = case cons of 	-- All constructors have same shape
-			L _ (ConDecl { con_res = ResTyGADT _ }) : _ -> False
-			other -> True
-
-tcTyClDecl1 calc_vrcs calc_isrec 
-  (ClassDecl {tcdLName = L _ class_name, tcdTyVars = tvs, 
-	      tcdCtxt = ctxt, tcdMeths = meths,
-	      tcdFDs = fundeps, tcdSigs = sigs} )
-  = tcTyVarBndrs tvs		$ \ tvs' -> do 
-  { ctxt' <- tcHsKindedContext ctxt
-  ; fds' <- mappM (addLocM tc_fundep) fundeps
-  ; sig_stuff <- tcClassSigs class_name sigs meths
-  ; clas <- fixM (\ clas ->
-		let 	-- This little knot is just so we can get
-			-- hold of the name of the class TyCon, which we
-			-- need to look up its recursiveness and variance
-		    tycon_name = tyConName (classTyCon clas)
-		    tc_isrec = calc_isrec tycon_name
-		    tc_vrcs  = calc_vrcs  tycon_name
-		in
-		buildClass class_name tvs' ctxt' fds' 
-			   sig_stuff tc_isrec tc_vrcs)
-  ; return (AClass clas) }
-  where
-    tc_fundep (tvs1, tvs2) = do { tvs1' <- mappM tcLookupTyVar tvs1 ;
-				; tvs2' <- mappM tcLookupTyVar tvs2 ;
-				; return (tvs1', tvs2') }
-
-
-tcTyClDecl1 calc_vrcs calc_isrec 
-  (ForeignType {tcdLName = L _ tc_name, tcdExtName = tc_ext_name})
-  = returnM (ATyCon (mkForeignTyCon tc_name tc_ext_name liftedTypeKind 0 []))
-
------------------------------------
-tcConDecl :: Bool 		-- True <=> -funbox-strict_fields
-	  -> NewOrData -> TyCon -> [TyVar]
-	  -> ConDecl Name -> TcM DataCon
-
-tcConDecl unbox_strict NewType tycon tc_tvs	-- Newtypes
-	  (ConDecl name _ ex_tvs ex_ctxt details ResTyH98)
-  = do	{ let tc_datacon field_lbls arg_ty
-		= do { arg_ty' <- tcHsKindedType arg_ty	-- No bang on newtype
-		     ; buildDataCon (unLoc name) False {- Prefix -} 
-				    True {- Vanilla -} [NotMarkedStrict]
-		    		    (map unLoc field_lbls)
-			   	    tc_tvs [] [arg_ty']
-				    tycon (mkTyVarTys tc_tvs) }
-
-		-- Check that a newtype has no existential stuff
-	; checkTc (null ex_tvs && null (unLoc ex_ctxt)) (newtypeExError name)
-
-	; case details of
-	    PrefixCon [arg_ty] -> tc_datacon [] arg_ty
-	    RecCon [(field_lbl, arg_ty)] -> tc_datacon [field_lbl] arg_ty
-	    other -> failWithTc (newtypeFieldErr name (length (hsConArgs details)))
-			-- Check that the constructor has exactly one field
-	}
-
-tcConDecl unbox_strict DataType tycon tc_tvs	-- Data types
-	  (ConDecl name _ tvs ctxt details res_ty)
-  = tcTyVarBndrs tvs		$ \ tvs' -> do 
-    { ctxt' <- tcHsKindedContext ctxt
-    ; (data_tc, res_ty_args) <- tcResultType tycon tc_tvs res_ty
-    ; let 
-	con_tvs = case res_ty of
-		    ResTyH98    -> tc_tvs ++ tvs'
-		    ResTyGADT _ -> tryVanilla tvs' res_ty_args
-
-	-- Vanilla iff result type matches the quantified vars exactly,
-	-- and there is no existential context
-	-- Must check the context too because of implicit params; e.g.
-	--  	data T = (?x::Int) => MkT Int
-	is_vanilla = res_ty_args `tcEqTypes` mkTyVarTys con_tvs
-		     && null (unLoc ctxt)
-
-	tc_datacon is_infix field_lbls btys
-	  = do { let bangs = map getBangStrictness btys
-	       ; arg_tys <- mappM tcHsBangType btys
-    	       ; buildDataCon (unLoc name) is_infix is_vanilla
-    		    (argStrictness unbox_strict tycon bangs arg_tys)
-    		    (map unLoc field_lbls)
-    		    con_tvs ctxt' arg_tys
-		    data_tc res_ty_args }
-		-- NB:	we put data_tc, the type constructor gotten from the constructor 
-		--	type signature into the data constructor; that way 
-		--	checkValidDataCon can complain if it's wrong.
-
-    ; case details of
-	PrefixCon btys     -> tc_datacon False [] btys
-	InfixCon bty1 bty2 -> tc_datacon True  [] [bty1,bty2]
-	RecCon fields      -> tc_datacon False field_names btys
-			   where
-			      (field_names, btys) = unzip fields
-                              
-    }
-
-tcResultType :: TyCon -> [TyVar] -> ResType Name -> TcM (TyCon, [TcType])
-tcResultType tycon tvs ResTyH98           = return (tycon, mkTyVarTys tvs)
-tcResultType _     _   (ResTyGADT res_ty) = tcLHsConResTy res_ty
-
-tryVanilla :: [TyVar] -> [TcType] -> [TyVar]
--- (tryVanilla tvs tys) returns a permutation of tvs.
--- It tries to re-order the tvs so that it exactly 
--- matches the [Type], if that is possible
-tryVanilla tvs (ty:tys) | Just tv <- tcGetTyVar_maybe ty	-- The type is a tyvar
-			, tv `elem` tvs				-- That tyvar is in the list
-			= tv : tryVanilla (delete tv tvs) tys
-tryVanilla tvs tys = tvs	-- Fall through case
-
-
--------------------
-argStrictness :: Bool		-- True <=> -funbox-strict_fields
-	      -> TyCon -> [HsBang]
-	      -> [TcType] -> [StrictnessMark]
-argStrictness unbox_strict tycon bangs arg_tys
- = ASSERT( length bangs == length arg_tys )
-   zipWith (chooseBoxingStrategy unbox_strict tycon) arg_tys bangs
-
--- We attempt to unbox/unpack a strict field when either:
---   (i)  The field is marked '!!', or
---   (ii) The field is marked '!', and the -funbox-strict-fields flag is on.
-
-chooseBoxingStrategy :: Bool -> TyCon -> TcType -> HsBang -> StrictnessMark
-chooseBoxingStrategy unbox_strict_fields tycon arg_ty bang
-  = case bang of
-	HsNoBang				    -> NotMarkedStrict
-	HsStrict | unbox_strict_fields && can_unbox -> MarkedUnboxed
-	HsUnbox  | can_unbox			    -> MarkedUnboxed
-	other					    -> MarkedStrict
-  where
-    can_unbox = case splitTyConApp_maybe arg_ty of
-		   Nothing 	       -> False
-		   Just (arg_tycon, _) -> not (isRecursiveTyCon tycon) &&
-					  isProductTyCon arg_tycon
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Dependency analysis}
-%*									*
-%************************************************************************
-
-Validity checking is done once the mutually-recursive knot has been
-tied, so we can look at things freely.
-
-\begin{code}
-checkCycleErrs :: [LTyClDecl Name] -> TcM ()
-checkCycleErrs tyclss
-  | null cls_cycles
-  = return ()
-  | otherwise
-  = do	{ mappM_ recClsErr cls_cycles
-	; failM	}	-- Give up now, because later checkValidTyCl
-			-- will loop if the synonym is recursive
-  where
-    cls_cycles = calcClassCycles tyclss
-
-checkValidTyCl :: TyClDecl Name -> TcM ()
--- We do the validity check over declarations, rather than TyThings
--- only so that we can add a nice context with tcAddDeclCtxt
-checkValidTyCl decl
-  = tcAddDeclCtxt decl $
-    do	{ thing <- tcLookupLocatedGlobal (tcdLName decl)
-	; traceTc (text "Validity of" <+> ppr thing)	
-	; case thing of
-	    ATyCon tc -> checkValidTyCon tc
-	    AClass cl -> checkValidClass cl 
-	; traceTc (text "Done validity of" <+> ppr thing)	
-	}
-
--------------------------
--- For data types declared with record syntax, we require
--- that each constructor that has a field 'f' 
---	(a) has the same result type
---	(b) has the same type for 'f'
--- module alpha conversion of the quantified type variables
--- of the constructor.
-
-checkValidTyCon :: TyCon -> TcM ()
-checkValidTyCon tc
-  | isSynTyCon tc 
-  = checkValidType syn_ctxt syn_rhs
-  | otherwise
-  = 	-- Check the context on the data decl
-    checkValidTheta (DataTyCtxt name) (tyConStupidTheta tc)	`thenM_` 
-	
-	-- Check arg types of data constructors
-    mappM_ (checkValidDataCon tc) data_cons			`thenM_`
-
-	-- Check that fields with the same name share a type
-    mappM_ check_fields groups
-
-  where
-    syn_ctxt  = TySynCtxt name
-    name      = tyConName tc
-    syn_rhs   = synTyConRhs tc
-    data_cons = tyConDataCons tc
-
-    groups = equivClasses cmp_fld (concatMap get_fields data_cons)
-    cmp_fld (f1,_) (f2,_) = f1 `compare` f2
-    get_fields con = dataConFieldLabels con `zip` repeat con
-	-- dataConFieldLabels may return the empty list, which is fine
-
-    -- XXX - autrijus - Make this far more complex to acommodate 
-    --       for different return types.  Add res_ty to the mix,
-    --       comparing them in two steps, all for good error messages.
-    --       Plan: Use Unify.tcMatchTys to compare the first candidate's
-    --             result type against other candidates' types (check bothways).
-    --             If they magically agrees, take the substitution and
-    --             apply them to the latter ones, and see if they match perfectly.
-    -- check_fields fields@((first_field_label, field_ty) : other_fields)
-    check_fields fields@((label, con1) : other_fields)
-	-- These fields all have the same name, but are from
-	-- different constructors in the data type
-	= recoverM (return ()) $ mapM_ checkOne other_fields
-                -- Check that all the fields in the group have the same type
-		-- NB: this check assumes that all the constructors of a given
-		-- data type use the same type variables
-        where
-        tvs1 = mkVarSet (dataConTyVars con1)
-        res1 = dataConResTys con1
-        fty1 = dataConFieldType con1 label
-
-        checkOne (_, con2)    -- Do it bothways to ensure they are structurally identical
-	    = do { checkFieldCompat label con1 con2 tvs1 res1 res2 fty1 fty2
-		 ; checkFieldCompat label con2 con1 tvs2 res2 res1 fty2 fty1 }
-	    where        
-                tvs2 = mkVarSet (dataConTyVars con2)
-		res2 = dataConResTys con2 
-                fty2 = dataConFieldType con2 label
-
-checkFieldCompat fld con1 con2 tvs1 res1 res2 fty1 fty2
-  = do	{ checkTc (isJust mb_subst1) (resultTypeMisMatch fld con1 con2)
-	; checkTc (isJust mb_subst2) (fieldTypeMisMatch fld con1 con2) }
-  where
-    mb_subst1 = tcMatchTys tvs1 res1 res2
-    mb_subst2 = tcMatchTyX tvs1 (expectJust "checkFieldCompat" mb_subst1) fty1 fty2
-
--------------------------------
-checkValidDataCon :: TyCon -> DataCon -> TcM ()
-checkValidDataCon tc con
-  = setSrcSpan (srcLocSpan (getSrcLoc con))	$
-    addErrCtxt (dataConCtxt con)		$ 
-    do	{ checkTc (dataConTyCon con == tc) (badDataConTyCon con)
-	; checkValidType ctxt (idType (dataConWrapId con)) }
-
-		-- This checks the argument types and
-		-- ambiguity of the existential context (if any)
-		-- 
-		-- Note [Sept 04] Now that tvs is all the tvs, this
-		-- test doesn't actually check anything
---	; checkFreeness tvs ex_theta }
-  where
-    ctxt = ConArgCtxt (dataConName con) 
---    (tvs, ex_theta, _, _, _) = dataConSig con
-
-
--------------------------------
-checkValidClass :: Class -> TcM ()
-checkValidClass cls
-  = do	{ 	-- CHECK ARITY 1 FOR HASKELL 1.4
-	  gla_exts <- doptM Opt_GlasgowExts
-
-    	-- Check that the class is unary, unless GlaExs
-	; checkTc (notNull tyvars) (nullaryClassErr cls)
-	; checkTc (gla_exts || unary) (classArityErr cls)
-
-   	-- Check the super-classes
-	; checkValidTheta (ClassSCCtxt (className cls)) theta
-
-	-- Check the class operations
-	; mappM_ (check_op gla_exts) op_stuff
-
-  	-- Check that if the class has generic methods, then the
-	-- class has only one parameter.  We can't do generic
-	-- multi-parameter type classes!
-	; checkTc (unary || no_generics) (genericMultiParamErr cls)
-	}
-  where
-    (tyvars, theta, _, op_stuff) = classBigSig cls
-    unary 	= isSingleton tyvars
-    no_generics = null [() | (_, GenDefMeth) <- op_stuff]
-
-    check_op gla_exts (sel_id, dm) 
-      = addErrCtxt (classOpCtxt sel_id tau) $ do
-	{ checkValidTheta SigmaCtxt (tail theta)
-		-- The 'tail' removes the initial (C a) from the
-		-- class itself, leaving just the method type
-
-	; checkValidType (FunSigCtxt op_name) tau
-
-		-- Check that the type mentions at least one of
-		-- the class type variables
-	; checkTc (any (`elemVarSet` tyVarsOfType tau) tyvars)
-	          (noClassTyVarErr cls sel_id)
-
-		-- Check that for a generic method, the type of 
-		-- the method is sufficiently simple
-	; checkTc (dm /= GenDefMeth || validGenericMethodType tau)
-		  (badGenericMethodType op_name op_ty)
-	}
-	where
-	  op_name = idName sel_id
-	  op_ty   = idType sel_id
-	  (_,theta1,tau1) = tcSplitSigmaTy op_ty
-	  (_,theta2,tau2)  = tcSplitSigmaTy tau1
-	  (theta,tau) | gla_exts  = (theta1 ++ theta2, tau2)
-		      | otherwise = (theta1, 	       mkPhiTy (tail theta1) tau1)
-		-- Ugh!  The function might have a type like
-		-- 	op :: forall a. C a => forall b. (Eq b, Eq a) => tau2
-		-- With -fglasgow-exts, we want to allow this, even though the inner 
-		-- forall has an (Eq a) constraint.  Whereas in general, each constraint 
-		-- in the context of a for-all must mention at least one quantified
-		-- type variable.  What a mess!
-
-
----------------------------------------------------------------------
-resultTypeMisMatch field_name con1 con2
-  = vcat [sep [ptext SLIT("Constructors") <+> ppr con1 <+> ptext SLIT("and") <+> ppr con2, 
-		ptext SLIT("have a common field") <+> quotes (ppr field_name) <> comma],
-	  nest 2 $ ptext SLIT("but have different result types")]
-fieldTypeMisMatch field_name con1 con2
-  = sep [ptext SLIT("Constructors") <+> ppr con1 <+> ptext SLIT("and") <+> ppr con2, 
-	 ptext SLIT("give different types for field"), quotes (ppr field_name)]
-
-dataConCtxt con = ptext SLIT("In the definition of data constructor") <+> quotes (ppr con)
-
-classOpCtxt sel_id tau = sep [ptext SLIT("When checking the class method:"),
-			      nest 2 (ppr sel_id <+> dcolon <+> ppr tau)]
-
-nullaryClassErr cls
-  = ptext SLIT("No parameters for class")  <+> quotes (ppr cls)
-
-classArityErr cls
-  = vcat [ptext SLIT("Too many parameters for class") <+> quotes (ppr cls),
-	  parens (ptext SLIT("Use -fglasgow-exts to allow multi-parameter classes"))]
-
-noClassTyVarErr clas op
-  = sep [ptext SLIT("The class method") <+> quotes (ppr op),
-	 ptext SLIT("mentions none of the type variables of the class") <+> 
-		ppr clas <+> hsep (map ppr (classTyVars clas))]
-
-genericMultiParamErr clas
-  = ptext SLIT("The multi-parameter class") <+> quotes (ppr clas) <+> 
-    ptext SLIT("cannot have generic methods")
-
-badGenericMethodType op op_ty
-  = hang (ptext SLIT("Generic method type is too complex"))
-       4 (vcat [ppr op <+> dcolon <+> ppr op_ty,
-		ptext SLIT("You can only use type variables, arrows, lists, and tuples")])
-
-recSynErr syn_decls
-  = setSrcSpan (getLoc (head sorted_decls)) $
-    addErr (sep [ptext SLIT("Cycle in type synonym declarations:"),
-		 nest 2 (vcat (map ppr_decl sorted_decls))])
-  where
-    sorted_decls = sortLocated syn_decls
-    ppr_decl (L loc decl) = ppr loc <> colon <+> ppr decl
-
-recClsErr cls_decls
-  = setSrcSpan (getLoc (head sorted_decls)) $
-    addErr (sep [ptext SLIT("Cycle in class declarations (via superclasses):"),
-		 nest 2 (vcat (map ppr_decl sorted_decls))])
-  where
-    sorted_decls = sortLocated cls_decls
-    ppr_decl (L loc decl) = ppr loc <> colon <+> ppr (decl { tcdSigs = [] })
-
-sortLocated :: [Located a] -> [Located a]
-sortLocated things = sortLe le things
-  where
-    le (L l1 _) (L l2 _) = l1 <= l2
-
-badDataConTyCon data_con
-  = hang (ptext SLIT("Data constructor") <+> quotes (ppr data_con) <+>
-		ptext SLIT("returns type") <+> quotes (ppr (dataConTyCon data_con)))
-       2 (ptext SLIT("instead of its parent type"))
-
-badGadtDecl tc_name
-  = vcat [ ptext SLIT("Illegal generalised algebraic data declaration for") <+> quotes (ppr tc_name)
-	 , nest 2 (parens $ ptext SLIT("Use -fglasgow-exts to allow GADTs")) ]
-
-newtypeConError tycon n
-  = sep [ptext SLIT("A newtype must have exactly one constructor,"),
-	 nest 2 $ ptext SLIT("but") <+> quotes (ppr tycon) <+> ptext SLIT("has") <+> speakN n ]
-
-newtypeExError con
-  = sep [ptext SLIT("A newtype constructor cannot have an existential context,"),
-	 nest 2 $ ptext SLIT("but") <+> quotes (ppr con) <+> ptext SLIT("does")]
-
-newtypeFieldErr con_name n_flds
-  = sep [ptext SLIT("The constructor of a newtype must have exactly one field"), 
-	 nest 2 $ ptext SLIT("but") <+> quotes (ppr con_name) <+> ptext SLIT("has") <+> speakN n_flds]
-
-emptyConDeclsErr tycon
-  = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
-	 nest 2 $ ptext SLIT("(-fglasgow-exts permits this)")]
-
-badBootClassDeclErr = ptext SLIT("Illegal class declaration in hs-boot file")
-\end{code}
diff --git a/ghc/compiler/typecheck/TcTyDecls.lhs b/ghc/compiler/typecheck/TcTyDecls.lhs
deleted file mode 100644
index 4ce5fed3f3..0000000000
--- a/ghc/compiler/typecheck/TcTyDecls.lhs
+++ /dev/null
@@ -1,473 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1999
-%
-
-Analysis functions over data types.  Specficially
-	a) detecting recursive types
-	b) computing argument variances
-
-This stuff is only used for source-code decls; it's recorded in interface
-files for imported data types.
-
-
-\begin{code}
-module TcTyDecls(
-        calcTyConArgVrcs,
-	calcRecFlags, 
-	calcClassCycles, calcSynCycles
-    ) where
-
-#include "HsVersions.h"
-
-import TypeRep          ( Type(..), TyNote(..), PredType(..) )  -- friend
-import HsSyn		( TyClDecl(..), HsPred(..), LTyClDecl, isClassDecl )
-import RnHsSyn		( extractHsTyNames )
-import Type		( predTypeRep, tcView )
-import HscTypes		( TyThing(..), ModDetails(..) )
-import TyCon            ( TyCon, ArgVrcs, tyConArity, tyConDataCons, tyConTyVars,
-                          synTyConDefn, isSynTyCon, isAlgTyCon, 
-			  tyConName, isNewTyCon, isProductTyCon, tyConArgVrcs, newTyConRhs )
-import Class		( classTyCon )
-import DataCon          ( dataConOrigArgTys )
-import Var              ( TyVar )
-import VarSet
-import Name		( Name, isTyVarName )
-import NameEnv
-import NameSet
-import Digraph 		( SCC(..), stronglyConnComp, stronglyConnCompR )
-import BasicTypes	( RecFlag(..) )
-import SrcLoc		( Located(..), unLoc )
-import Outputable
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Cycles in class and type synonym declarations
-%*									*
-%************************************************************************
-
-Checking for class-decl loops is easy, because we don't allow class decls
-in interface files.
-
-We allow type synonyms in hi-boot files, but we *trust* hi-boot files, 
-so we don't check for loops that involve them.  So we only look for synonym
-loops in the module being compiled.
-
-We check for type synonym and class cycles on the *source* code.
-Main reasons: 
-
-  a) Otherwise we'd need a special function to extract type-synonym tycons
-	from a type, whereas we have extractHsTyNames already
-
-  b) If we checked for type synonym loops after building the TyCon, we
-	can't do a hoistForAllTys on the type synonym rhs, (else we fall into
-	a black hole) which seems unclean.  Apart from anything else, it'd mean 
-	that a type-synonym rhs	could have for-alls to the right of an arrow, 
-	which means adding new cases to the validity checker
-
-	Indeed, in general, checking for cycles beforehand means we need to
-	be less careful about black holes through synonym cycles.
-
-The main disadvantage is that a cycle that goes via a type synonym in an 
-.hi-boot file can lead the compiler into a loop, because it assumes that cycles
-only occur entirely within the source code of the module being compiled.  
-But hi-boot files are trusted anyway, so this isn't much worse than (say) 
-a kind error.
-
-[  NOTE ----------------------------------------------
-If we reverse this decision, this comment came from tcTyDecl1, and should
- go back there
-	-- dsHsType, not tcHsKindedType, to avoid a loop.  tcHsKindedType does hoisting,
-	-- which requires looking through synonyms... and therefore goes into a loop
-	-- on (erroneously) recursive synonyms.
-	-- Solution: do not hoist synonyms, because they'll be hoisted soon enough
-	-- 	     when they are substituted
-
-We'd also need to add back in this definition
-
-synTyConsOfType :: Type -> [TyCon]
--- Does not look through type synonyms at all
--- Return a list of synonym tycons
-synTyConsOfType ty
-  = nameEnvElts (go ty)
-  where
-     go :: Type -> NameEnv TyCon  -- The NameEnv does duplicate elim
-     go (TyVarTy v)	  	  = emptyNameEnv
-     go (TyConApp tc tys) 	  = go_tc tc tys
-     go (AppTy a b)	  	  = go a `plusNameEnv` go b
-     go (FunTy a b)	  	  = go a `plusNameEnv` go b
-     go (PredTy (IParam _ ty))    = go ty	
-     go (PredTy (ClassP cls tys)) = go_s tys	-- Ignore class
-     go (NoteTy _ ty)		  = go ty	
-     go (ForAllTy _ ty)	  	  = go ty
-
-     go_tc tc tys | isSynTyCon tc = extendNameEnv (go_s tys) (tyConName tc) tc
-		  | otherwise	  = go_s tys
-     go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys
----------------------------------------- END NOTE ]
-
-\begin{code}
-calcSynCycles :: [LTyClDecl Name] -> [SCC (LTyClDecl Name)]
-calcSynCycles decls
-  = stronglyConnComp syn_edges
-  where
-    syn_edges = [ (ldecl, unLoc (tcdLName decl), 
-			  mk_syn_edges (tcdSynRhs decl))
-		| ldecl@(L _ decl) <- decls ]
-
-    mk_syn_edges rhs = [ tc | tc <- nameSetToList (extractHsTyNames rhs), 
-			      not (isTyVarName tc) ]
-
-
-calcClassCycles :: [LTyClDecl Name] -> [[LTyClDecl Name]]
-calcClassCycles decls
-  = [decls | CyclicSCC decls <- stronglyConnComp cls_edges]
-  where
-    cls_edges = [ (ldecl, unLoc (tcdLName decl), 	
-			  mk_cls_edges (unLoc (tcdCtxt decl)))
-		| ldecl@(L _ decl) <- decls, isClassDecl decl ]
-
-    mk_cls_edges ctxt = [ cls | L _ (HsClassP cls _) <- ctxt ]
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Deciding which type constructors are recursive
-%*									*
-%************************************************************************
-
-For newtypes, we label some as "recursive" such that
-
-    INVARIANT: there is no cycle of non-recursive newtypes
-
-In any loop, only one newtype need be marked as recursive; it is
-a "loop breaker".  Labelling more than necessary as recursive is OK,
-provided the invariant is maintained.
-
-A newtype M.T is defined to be "recursive" iff
-	(a) it is declared in an hi-boot file (see RdrHsSyn.hsIfaceDecl)
-	(b) it is declared in a source file, but that source file has a
-	    companion hi-boot file which declares the type
-   or	(c) one can get from T's rhs to T via type 
-	    synonyms, or non-recursive newtypes *in M*
-	     e.g.  newtype T = MkT (T -> Int)
-
-(a) is conservative; declarations in hi-boot files are always 
-	made loop breakers. That's why in (b) we can restrict attention
-	to tycons in M, because any loops through newtypes outside M
-	will be broken by those newtypes
-(b) ensures that a newtype is not treated as a loop breaker in one place
-and later as a non-loop-breaker.  This matters in GHCi particularly, when
-a newtype T might be embedded in many types in the environment, and then
-T's source module is compiled.  We don't want T's recursiveness to change.
-
-The "recursive" flag for algebraic data types is irrelevant (never consulted)
-for types with more than one constructor.
-
-An algebraic data type M.T is "recursive" iff
-	it has just one constructor, and 
-	(a) it is declared in an hi-boot file (see RdrHsSyn.hsIfaceDecl)
-	(b) it is declared in a source file, but that source file has a
-	    companion hi-boot file which declares the type
- or	(c) one can get from its arg types to T via type synonyms, 
-	    or by non-recursive newtypes or non-recursive product types in M
-	     e.g.  data T = MkT (T -> Int) Bool
-Just like newtype in fact
-
-A type synonym is recursive if one can get from its
-right hand side back to it via type synonyms.  (This is
-reported as an error.)
-
-A class is recursive if one can get from its superclasses
-back to it.  (This is an error too.)
-
-Hi-boot types
-~~~~~~~~~~~~~
-A data type read from an hi-boot file will have an AbstractTyCon as its AlgTyConRhs
-and will respond True to isHiBootTyCon. The idea is that we treat these as if one
-could get from these types to anywhere.  So when we see
-
-  	module Baz where
-	import {-# SOURCE #-} Foo( T )
-	newtype S = MkS T
-
-then we mark S as recursive, just in case. What that means is that if we see
-
-	import Baz( S )
-	newtype R = MkR S
-
-then we don't need to look inside S to compute R's recursiveness.  Since S is imported
-(not from an hi-boot file), one cannot get from R back to S except via an hi-boot file,
-and that means that some data type will be marked recursive along the way.  So R is
-unconditionly non-recursive (i.e. there'll be a loop breaker elsewhere if necessary)
-
-This in turn means that we grovel through fewer interface files when computing 
-recursiveness, because we need only look at the type decls in the module being
-compiled, plus the outer structure of directly-mentioned types.
-
-\begin{code}
-calcRecFlags :: ModDetails -> [TyThing] -> (Name -> RecFlag)
--- The 'boot_names' are the things declared in M.hi-boot, if M is the current module.
--- Any type constructors in boot_names are automatically considered loop breakers
-calcRecFlags boot_details tyclss
-  = is_rec
-  where
-    is_rec n | n `elemNameSet` rec_names = Recursive
-	     | otherwise		 = NonRecursive
-
-    boot_name_set = md_exports boot_details
-    rec_names = boot_name_set	  `unionNameSets` 
-		nt_loop_breakers  `unionNameSets`
-	        prod_loop_breakers
-
-    all_tycons = [ tc | tycls <- tyclss,
-			   -- Recursion of newtypes/data types can happen via 
-			   -- the class TyCon, so tyclss includes the class tycons
-			let tc = getTyCon tycls,
-			not (tyConName tc `elemNameSet` boot_name_set) ]
-			   -- Remove the boot_name_set because they are going 
-			   -- to be loop breakers regardless.
-
-	-------------------------------------------------
-	-- 			NOTE
-	-- These edge-construction loops rely on
-	-- every loop going via tyclss, the types and classes
-	-- in the module being compiled.  Stuff in interface 
-	-- files should be correctly marked.  If not (e.g. a
-	-- type synonym in a hi-boot file) we can get an infinite
-	-- loop.  We could program round this, but it'd make the code
-	-- rather less nice, so I'm not going to do that yet.
-
-	--------------- Newtypes ----------------------
-    new_tycons = filter isNewTyCon all_tycons
-    nt_loop_breakers = mkNameSet (findLoopBreakers nt_edges)
-    is_rec_nt tc = tyConName tc  `elemNameSet` nt_loop_breakers
-	-- is_rec_nt is a locally-used helper function
-
-    nt_edges = [(t, mk_nt_edges t) | t <- new_tycons]
-
-    mk_nt_edges nt 	-- Invariant: nt is a newtype
-	= concatMap (mk_nt_edges1 nt) (tcTyConsOfType (new_tc_rhs nt))
-			-- tyConsOfType looks through synonyms
-
-    mk_nt_edges1 nt tc 
-	| tc `elem` new_tycons = [tc]		-- Loop
-		-- At this point we know that either it's a local *data* type,
-		-- or it's imported.  Either way, it can't form part of a newtype cycle
-	| otherwise = []
-
-	--------------- Product types ----------------------
-	-- The "prod_tycons" are the non-newtype products
-    prod_tycons = [tc | tc <- all_tycons, 
-			not (isNewTyCon tc), isProductTyCon tc]
-    prod_loop_breakers = mkNameSet (findLoopBreakers prod_edges)
-
-    prod_edges = [(tc, mk_prod_edges tc) | tc <- prod_tycons]
-	
-    mk_prod_edges tc 	-- Invariant: tc is a product tycon
-	= concatMap (mk_prod_edges1 tc) (dataConOrigArgTys (head (tyConDataCons tc)))
-
-    mk_prod_edges1 ptc ty = concatMap (mk_prod_edges2 ptc) (tcTyConsOfType ty)
-
-    mk_prod_edges2 ptc tc 
- 	| tc `elem` prod_tycons   = [tc]		-- Local product
- 	| tc `elem` new_tycons    = if is_rec_nt tc 	-- Local newtype
-				    then []
-				    else mk_prod_edges1 ptc (new_tc_rhs tc)
-		-- At this point we know that either it's a local non-product data type,
-		-- or it's imported.  Either way, it can't form part of a cycle
-	| otherwise = []
-			
-new_tc_rhs tc = snd (newTyConRhs tc)	-- Ignore the type variables
-
-getTyCon (ATyCon tc) = tc
-getTyCon (AClass cl) = classTyCon cl
-
-findLoopBreakers :: [(TyCon, [TyCon])] -> [Name]
--- Finds a set of tycons that cut all loops
-findLoopBreakers deps
-  = go [(tc,tc,ds) | (tc,ds) <- deps]
-  where
-    go edges = [ name
-	       | CyclicSCC ((tc,_,_) : edges') <- stronglyConnCompR edges,
-		 name <- tyConName tc : go edges']
-\end{code}
-
-These two functions know about type representations, so they could be
-in Type or TcType -- but they are very specialised to this module, so 
-I've chosen to put them here.
-
-\begin{code}
-tcTyConsOfType :: Type -> [TyCon]
--- tcTyConsOfType looks through all synonyms, but not through any newtypes.  
--- When it finds a Class, it returns the class TyCon.  The reaons it's here
--- (not in Type.lhs) is because it is newtype-aware.
-tcTyConsOfType ty 
-  = nameEnvElts (go ty)
-  where
-     go :: Type -> NameEnv TyCon  -- The NameEnv does duplicate elim
-     go ty | Just ty' <- tcView ty = go ty'
-     go (TyVarTy v)	  	   = emptyNameEnv
-     go (TyConApp tc tys) 	   = go_tc tc tys
-     go (AppTy a b)	  	   = go a `plusNameEnv` go b
-     go (FunTy a b)	  	   = go a `plusNameEnv` go b
-     go (PredTy (IParam _ ty))     = go ty
-     go (PredTy (ClassP cls tys))  = go_tc (classTyCon cls) tys
-     go (ForAllTy _ ty)	  	   = go ty
-
-     go_tc tc tys = extendNameEnv (go_s tys) (tyConName tc) tc
-     go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Compuing TyCon argument variances
-%*									*
-%************************************************************************
-
-Computing the tyConArgVrcs info
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-@tyConArgVrcs@ gives a list of (occPos,occNeg) flags, one for each
-tyvar.  For @AlgTyCon@s and @SynTyCon@s, this info must be precomputed
-separately.  Note that this is information about occurrences of type
-variables, not usages of term variables.
-
-The function @calcTyConArgVrcs@ must be passed a list of *algebraic or
-syntycons only* such that all tycons referred to (by mutual recursion)
-appear in the list.  The fixpointing will be done on this set of
-tycons as a whole.  It returns a list of @tyconVrcInfo@ data, ready to
-be (knot-tyingly?) stuck back into the appropriate fields.
-
-\begin{code}
-calcTyConArgVrcs :: [TyThing] -> Name -> ArgVrcs
--- Gives arg variances for TyCons, 
--- including the class TyCon of a class
-calcTyConArgVrcs tyclss
-  = get_vrc
-  where
-    tycons = map getTyCon tyclss
-
-	-- We should only look up things that are in the map
-    get_vrc n = case lookupNameEnv final_oi n of
-		  Just (_, pms) -> pms
-		  Nothing -> pprPanic "calcVrcs" (ppr n)
-
-	-- We are going to fold over this map,
-	-- so we need the TyCon in the range
-    final_oi :: NameEnv (TyCon, ArgVrcs)
-    final_oi = tcaoFix initial_oi
-
-    initial_oi :: NameEnv (TyCon, ArgVrcs)
-    initial_oi = mkNameEnv [(tyConName tc, (tc, initial tc))
-			   | tc <- tycons]
-    initial tc = replicate (tyConArity tc) (False,False)
-
-    tcaoFix :: NameEnv (TyCon, ArgVrcs)   -- initial ArgVrcs per tycon
-	    -> NameEnv (TyCon, ArgVrcs)   -- fixpointed ArgVrcs per tycon
-    tcaoFix oi 
-	| changed   = tcaoFix oi'
-	| otherwise = oi'
-	where
-	 (changed,oi') = foldNameEnv iterate (False,oi) oi
-
-    iterate (tc, pms) (changed,oi')
-      =	(changed || (pms /= pms'),
-	 extendNameEnv oi' (tyConName tc) (tc, pms'))
-      where
-	pms' = tcaoIter oi' tc  -- seq not simult
-
-    tcaoIter :: NameEnv (TyCon, ArgVrcs)  -- reference ArgVrcs (initial)
-	     -> TyCon                     -- tycon to update
-	     -> ArgVrcs                   -- new ArgVrcs for tycon
-
-    tcaoIter oi tc | isAlgTyCon tc
-      = map (\v -> anyVrc (vrcInTy (lookup oi) v) argtys) vs
-      where
-       	data_cons = tyConDataCons tc
-       	vs        = tyConTyVars tc
-       	argtys    = concatMap dataConOrigArgTys data_cons	-- Rep? or Orig?
-
-    tcaoIter oi tc | isSynTyCon tc
-      = let (tyvs,ty) = synTyConDefn tc
-                        -- we use the already-computed result for tycons not in this SCC
-        in  map (\v -> vrcInTy (lookup oi) v ty) tyvs
-
-    lookup oi tc = case lookupNameEnv oi (tyConName tc) of
-			Just (_, pms) -> pms
-			Nothing	      -> tyConArgVrcs tc
-	 -- We use the already-computed result for tycons not in this SCC
-\end{code}
-
-
-Variance of tyvars in a type
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-A general variance-check function.  We pass a function for determining
-the @ArgVrc@s of a tycon; when fixpointing this refers to the current
-value; otherwise this should be looked up from the tycon's own
-tyConArgVrcs.  Again, it knows the representation of Types.
-
-\begin{code}
-vrcInTy :: (TyCon -> ArgVrcs)  -- function to get argVrcs of a tycon (break out of recursion)
-        -> TyVar               -- tyvar to check Vrcs of
-        -> Type                -- type to check for occ in
-        -> (Bool,Bool)         -- (occurs positively, occurs negatively)
-
-vrcInTy fao v (NoteTy (FTVNote ftv) ty) = if elemVarSet v ftv
-    					  then vrcInTy fao v ty
-    					  else (False,False)
-    			-- note that ftv cannot be calculated as occPos||occNeg,
-    			-- since if a tyvar occurs only as unused tyconarg,
-    			-- occPos==occNeg==False, but ftv=True
-
-vrcInTy fao v (TyVarTy v')              = if v==v'
-    					  then (True,False)
-    					  else (False,False)
-
-vrcInTy fao v (AppTy ty1 ty2)           = if vrcInTy fao v ty2 /= (False,False)
-                                          then (True,True)
-                                          else vrcInTy fao v ty1
-                        -- ty1 is probably unknown (or it would have been beta-reduced);
-                        -- hence if v occurs in ty2 at all then it could occur with
-                        -- either variance.  Otherwise it occurs as it does in ty1.
-
-vrcInTy fao v (FunTy ty1 ty2)           = negVrc (vrcInTy fao v ty1)
-                                          `orVrc`
-                                          vrcInTy fao v ty2
-					 
-vrcInTy fao v (ForAllTy v' ty)          = if v==v'
-					  then (False,False)
-    					  else vrcInTy fao v ty
-
-vrcInTy fao v (TyConApp tc tys)         = let pms1 = map (vrcInTy fao v) tys
-    					      pms2 = fao tc
-    				          in  orVrcs (zipWith timesVrc pms1 pms2)
-
-vrcInTy fao v (PredTy st) = vrcInTy fao v (predTypeRep st)
-\end{code}
-
-Variance algebra
-~~~~~~~~~~~~~~~~
-
-\begin{code}
-orVrc :: (Bool,Bool) -> (Bool,Bool) -> (Bool,Bool)
-orVrc (p1,m1) (p2,m2) = (p1||p2,m1||m2)
-
-orVrcs :: [(Bool,Bool)] -> (Bool,Bool)
-orVrcs = foldl orVrc (False,False)
-
-negVrc :: (Bool,Bool) -> (Bool,Bool)
-negVrc (p1,m1) = (m1,p1)
-
-anyVrc :: (a -> (Bool,Bool)) -> [a] -> (Bool,Bool)
-anyVrc p as = foldl (\ pm a -> pm `orVrc` p a)
-                    (False,False) as
-
-timesVrc :: (Bool,Bool) -> (Bool,Bool) -> (Bool,Bool)
-timesVrc (p1,m1) (p2,m2) = (p1 && p2 || m1 && m2,
-    			    p1 && m2 || m1 && p2)
-\end{code}
diff --git a/ghc/compiler/typecheck/TcType.hi-boot-5 b/ghc/compiler/typecheck/TcType.hi-boot-5
deleted file mode 100644
index 23b3a9c963..0000000000
--- a/ghc/compiler/typecheck/TcType.hi-boot-5
+++ /dev/null
@@ -1,3 +0,0 @@
-__interface TcType 1 0 where
-__export TcType TyVarDetails;
-1 data TyVarDetails ;
diff --git a/ghc/compiler/typecheck/TcType.hi-boot-6 b/ghc/compiler/typecheck/TcType.hi-boot-6
deleted file mode 100644
index d1fc721c64..0000000000
--- a/ghc/compiler/typecheck/TcType.hi-boot-6
+++ /dev/null
@@ -1,5 +0,0 @@
-module TcType where
-
-data TcTyVarDetails 
-
-pprTcTyVarDetails :: TcTyVarDetails -> Outputable.SDoc
\ No newline at end of file
diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs
deleted file mode 100644
index 4b6e7b814e..0000000000
--- a/ghc/compiler/typecheck/TcType.lhs
+++ /dev/null
@@ -1,1202 +0,0 @@
-
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TcType]{Types used in the typechecker}
-
-This module provides the Type interface for front-end parts of the 
-compiler.  These parts 
-
-	* treat "source types" as opaque: 
-		newtypes, and predicates are meaningful. 
-	* look through usage types
-
-The "tc" prefix is for "typechechecker", because the type checker
-is the principal client.
-
-\begin{code}
-module TcType (
-  --------------------------------
-  -- Types 
-  TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType, 
-  TcTyVar, TcTyVarSet, TcKind, 
-
-  BoxyTyVar, BoxySigmaType, BoxyRhoType, BoxyThetaType, BoxyType,
-
-  --------------------------------
-  -- MetaDetails
-  UserTypeCtxt(..), pprUserTypeCtxt,
-  TcTyVarDetails(..), BoxInfo(..), pprTcTyVarDetails,
-  MetaDetails(Flexi, Indirect), SkolemInfo(..), pprSkolTvBinding, pprSkolInfo,
-  isImmutableTyVar, isSkolemTyVar, isMetaTyVar, isBoxyTyVar, isSigTyVar, isExistentialTyVar, 
-  metaTvRef, 
-  isFlexi, isIndirect, 
-
-  --------------------------------
-  -- Builders
-  mkPhiTy, mkSigmaTy, 
-
-  --------------------------------
-  -- Splitters  
-  -- These are important because they do not look through newtypes
-  tcView,
-  tcSplitForAllTys, tcSplitPhiTy, 
-  tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
-  tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
-  tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, 
-  tcValidInstHeadTy, tcGetTyVar_maybe, tcGetTyVar,
-  tcSplitSigmaTy, tcMultiSplitSigmaTy, 
-
-  ---------------------------------
-  -- Predicates. 
-  -- Again, newtypes are opaque
-  tcEqType, tcEqTypes, tcEqPred, tcCmpType, tcCmpTypes, tcCmpPred, tcEqTypeX,
-  isSigmaTy, isOverloadedTy, isRigidTy, isBoxyTy,
-  isDoubleTy, isFloatTy, isIntTy, isStringTy,
-  isIntegerTy, isAddrTy, isBoolTy, isUnitTy,
-  isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, 
-
-  ---------------------------------
-  -- Misc type manipulators
-  deNoteType, classesOfTheta,
-  tyClsNamesOfType, tyClsNamesOfDFunHead, 
-  getDFunTyKey,
-
-  ---------------------------------
-  -- Predicate types  
-  getClassPredTys_maybe, getClassPredTys, 
-  isClassPred, isTyVarClassPred, 
-  mkDictTy, tcSplitPredTy_maybe, 
-  isPredTy, isDictTy, tcSplitDFunTy, tcSplitDFunHead, predTyUnique, 
-  mkClassPred, isInheritablePred, isLinearPred, isIPPred, mkPredName, 
-  dataConsStupidTheta, isRefineableTy,
-
-  ---------------------------------
-  -- Foreign import and export
-  isFFIArgumentTy,     -- :: DynFlags -> Safety -> Type -> Bool
-  isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
-  isFFIExportResultTy, -- :: Type -> Bool
-  isFFIExternalTy,     -- :: Type -> Bool
-  isFFIDynArgumentTy,  -- :: Type -> Bool
-  isFFIDynResultTy,    -- :: Type -> Bool
-  isFFILabelTy,        -- :: Type -> Bool
-  isFFIDotnetTy,       -- :: DynFlags -> Type -> Bool
-  isFFIDotnetObjTy,    -- :: Type -> Bool
-  isFFITy,	       -- :: Type -> Bool
-  
-  toDNType,            -- :: Type -> DNType
-
-  --------------------------------
-  -- Rexported from Type
-  Kind, 	-- Stuff to do with kinds is insensitive to pre/post Tc
-  unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds, 
-  isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind, 
-  isArgTypeKind, isSubKind, defaultKind, 
-
-  Type, PredType(..), ThetaType, 
-  mkForAllTy, mkForAllTys, 
-  mkFunTy, mkFunTys, zipFunTys, 
-  mkTyConApp, mkAppTy, mkAppTys, applyTy, applyTys,
-  mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys, 
-
-  -- Type substitutions
-  TvSubst(..), 	-- Representation visible to a few friends
-  TvSubstEnv, emptyTvSubst,
-  mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
-  getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope, lookupTyVar,
-  extendTvSubst, extendTvSubstList, isInScope, mkTvSubst, zipTyEnv,
-  substTy, substTys, substTyWith, substTheta, substTyVar, substTyVarBndr,
-
-  isUnLiftedType,	-- Source types are always lifted
-  isUnboxedTupleType,	-- Ditto
-  isPrimitiveType, 
-
-  tidyTopType, tidyType, tidyPred, tidyTypes, tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
-  tidyTyVarBndr, tidyOpenTyVar, tidyOpenTyVars, tidySkolemTyVar,
-  typeKind, tidyKind,
-
-  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
-  tcTyVarsOfType, tcTyVarsOfTypes, exactTyVarsOfType, exactTyVarsOfTypes,
-
-  pprKind, pprParendKind,
-  pprType, pprParendType, pprTyThingCategory,
-  pprPred, pprTheta, pprThetaArrow, pprClassPred
-
-  ) where
-
-#include "HsVersions.h"
-
--- friends:
-import TypeRep		( Type(..), funTyCon )  -- friend
-
-import Type		(	-- Re-exports
-			  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
-			  tyVarsOfTheta, Kind, PredType(..),
-			  ThetaType, unliftedTypeKind, 
-			  liftedTypeKind, openTypeKind, mkArrowKind,
-		  	  isLiftedTypeKind, isUnliftedTypeKind, 
-			  mkArrowKinds, mkForAllTy, mkForAllTys,
-			  defaultKind, isArgTypeKind, isOpenTypeKind,
-			  mkFunTy, mkFunTys, zipFunTys, 
-			  mkTyConApp, mkAppTy,
-			  mkAppTys, applyTy, applyTys,
-			  mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy,
-			  mkPredTys, isUnLiftedType, 
-			  isUnboxedTupleType, isPrimitiveType,
-			  splitTyConApp_maybe,
-			  tidyTopType, tidyType, tidyPred, tidyTypes,
-			  tidyFreeTyVars, tidyOpenType, tidyOpenTypes,
-			  tidyTyVarBndr, tidyOpenTyVar,
-			  tidyOpenTyVars, tidyKind,
-			  isSubKind, tcView,
-
-			  tcEqType, tcEqTypes, tcCmpType, tcCmpTypes, 
-			  tcEqPred, tcCmpPred, tcEqTypeX, 
-
-			  TvSubst(..),
-			  TvSubstEnv, emptyTvSubst, mkTvSubst, zipTyEnv,
-			  mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst,
-			  getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
-			  extendTvSubst, extendTvSubstList, isInScope, notElemTvSubst,
-		  	  substTy, substTys, substTyWith, substTheta, 
-			  substTyVar, substTyVarBndr, substPred, lookupTyVar,
-
-			  typeKind, repType,
-			  pprKind, pprParendKind,
-			  pprType, pprParendType, pprTyThingCategory,
-			  pprPred, pprTheta, pprThetaArrow, pprClassPred
-			)
-import TyCon		( TyCon, isUnLiftedTyCon, isSynTyCon, synTyConDefn, tyConUnique )
-import DataCon		( DataCon, dataConStupidTheta, dataConResTys )
-import Class		( Class )
-import Var		( TyVar, Id, isTcTyVar, mkTcTyVar, tyVarName, tyVarKind, tcTyVarDetails )
-import ForeignCall	( Safety, playSafe, DNType(..) )
-import Unify		( tcMatchTys )
-import VarSet
-
--- others:
-import DynFlags		( DynFlags, DynFlag( Opt_GlasgowExts ), dopt )
-import Name		( Name, NamedThing(..), mkInternalName, getSrcLoc )
-import NameSet
-import VarEnv		( TidyEnv )
-import OccName		( OccName, mkDictOcc )
-import PrelNames	-- Lots (e.g. in isFFIArgumentTy)
-import TysWiredIn	( unitTyCon, charTyCon, listTyCon )
-import BasicTypes	( IPName(..), Arity, ipNameName )
-import SrcLoc		( SrcLoc, SrcSpan )
-import Util		( snocView, equalLength )
-import Maybes		( maybeToBool, expectJust, mapCatMaybes )
-import ListSetOps	( hasNoDups )
-import List		( nubBy )
-import Outputable
-import DATA_IOREF
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Types}
-%*									*
-%************************************************************************
-
-The type checker divides the generic Type world into the 
-following more structured beasts:
-
-sigma ::= forall tyvars. phi
-	-- A sigma type is a qualified type
-	--
-	-- Note that even if 'tyvars' is empty, theta
-	-- may not be: e.g.   (?x::Int) => Int
-
-	-- Note that 'sigma' is in prenex form:
-	-- all the foralls are at the front.
-	-- A 'phi' type has no foralls to the right of
-	-- an arrow
-
-phi :: theta => rho
-
-rho ::= sigma -> rho
-     |  tau
-
--- A 'tau' type has no quantification anywhere
--- Note that the args of a type constructor must be taus
-tau ::= tyvar
-     |  tycon tau_1 .. tau_n
-     |  tau_1 tau_2
-     |  tau_1 -> tau_2
-
--- In all cases, a (saturated) type synonym application is legal,
--- provided it expands to the required form.
-
-\begin{code}
-type TcTyVar = TyVar  	-- Used only during type inference
-type TcType = Type 	-- A TcType can have mutable type variables
-	-- Invariant on ForAllTy in TcTypes:
-	-- 	forall a. T
-	-- a cannot occur inside a MutTyVar in T; that is,
-	-- T is "flattened" before quantifying over a
-
--- These types do not have boxy type variables in them
-type TcPredType     = PredType
-type TcThetaType    = ThetaType
-type TcSigmaType    = TcType
-type TcRhoType      = TcType
-type TcTauType      = TcType
-type TcKind         = Kind
-type TcTyVarSet     = TyVarSet
-
--- These types may have boxy type variables in them
-type BoxyTyVar	    = TcTyVar
-type BoxyRhoType    = TcType	
-type BoxyThetaType  = TcThetaType	
-type BoxySigmaType  = TcType		
-type BoxyType       = TcType		
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{TyVarDetails}
-%*									*
-%************************************************************************
-
-TyVarDetails gives extra info about type variables, used during type
-checking.  It's attached to mutable type variables only.
-It's knot-tied back to Var.lhs.  There is no reason in principle
-why Var.lhs shouldn't actually have the definition, but it "belongs" here.
-
-
-Note [Signature skolems]
-~~~~~~~~~~~~~~~~~~~~~~~~
-Consider this
-
-  x :: [a]
-  y :: b
-  (x,y,z) = ([y,z], z, head x)
-
-Here, x and y have type sigs, which go into the environment.  We used to
-instantiate their types with skolem constants, and push those types into
-the RHS, so we'd typecheck the RHS with type
-	( [a*], b*, c )
-where a*, b* are skolem constants, and c is an ordinary meta type varible.
-
-The trouble is that the occurrences of z in the RHS force a* and b* to 
-be the *same*, so we can't make them into skolem constants that don't unify
-with each other.  Alas.
-
-On the other hand, we *must* use skolems for signature type variables, 
-becuase GADT type refinement refines skolems only.  
-
-One solution would be insist that in the above defn the programmer uses
-the same type variable in both type signatures.  But that takes explanation.
-
-The alternative (currently implemented) is to have a special kind of skolem
-constant, SigSkokTv, which can unify with other SigSkolTvs.  
-
-
-\begin{code}
--- A TyVarDetails is inside a TyVar
-data TcTyVarDetails
-  = SkolemTv SkolemInfo			-- A skolem constant
-
-  | MetaTv BoxInfo (IORef MetaDetails)
-
-data BoxInfo 
-   = BoxTv	-- The contents is a (non-boxy) sigma-type
-		-- That is, this MetaTv is a "box"
-
-   | TauTv	-- The contents is a (non-boxy) tau-type
-		-- That is, this MetaTv is an ordinary unification variable
-
-   | SigTv SkolemInfo	-- A variant of TauTv, except that it should not be
-			-- unified with a type, only with a type variable
-			-- SigTvs are only distinguished to improve error messages
-			--      see Note [Signature skolems]        
-			--      The MetaDetails, if filled in, will 
-			--      always be another SigTv or a SkolemTv
-
--- INVARIANTS:
---  	A TauTv is always filled in with a tau-type, which
---	never contains any BoxTvs, nor any ForAlls 
---
---	However, a BoxTv can contain a type that contains further BoxTvs
---	Notably, when typechecking an explicit list, say [e1,e2], with
---	expected type being a box b1, we fill in b1 with (List b2), where
---	b2 is another (currently empty) box.
-
-data MetaDetails
-  = Flexi          -- Flexi type variables unify to become 
-                   -- Indirects.  
-
-  | Indirect TcType  -- INVARIANT:
-		     --   For a BoxTv, this type must be non-boxy
-                     --   For a TauTv, this type must be a tau-type
-
-data SkolemInfo
-  = SigSkol UserTypeCtxt	-- A skolem that is created by instantiating
-				-- a programmer-supplied type signature
-				-- Location of the binding site is on the TyVar
-
-	-- The rest are for non-scoped skolems
-  | ClsSkol Class	-- Bound at a class decl
-  | InstSkol Id		-- Bound at an instance decl
-  | PatSkol DataCon	-- An existential type variable bound by a pattern for
-	    SrcSpan	-- a data constructor with an existential type. E.g.
-			--	data T = forall a. Eq a => MkT a
-			-- 	f (MkT x) = ...
-			-- The pattern MkT x will allocate an existential type
-			-- variable for 'a'.  
-  | ArrowSkol SrcSpan	-- An arrow form (see TcArrows)
-
-  | GenSkol [TcTyVar]	-- Bound when doing a subsumption check for 
-	    TcType	-- 	(forall tvs. ty)
-	    SrcSpan
-
-  | UnkSkol		-- Unhelpful info (until I improve it)
-
--------------------------------------
--- UserTypeCtxt describes the places where a 
--- programmer-written type signature can occur
-data UserTypeCtxt 
-  = FunSigCtxt Name	-- Function type signature
-			-- Also used for types in SPECIALISE pragmas
-  | ExprSigCtxt		-- Expression type signature
-  | ConArgCtxt Name	-- Data constructor argument
-  | TySynCtxt Name	-- RHS of a type synonym decl
-  | GenPatCtxt		-- Pattern in generic decl
-			-- 	f{| a+b |} (Inl x) = ...
-  | LamPatSigCtxt		-- Type sig in lambda pattern
-			-- 	f (x::t) = ...
-  | BindPatSigCtxt	-- Type sig in pattern binding pattern
-			--	(x::t, y) = e
-  | ResSigCtxt		-- Result type sig
-			-- 	f x :: t = ....
-  | ForSigCtxt Name	-- Foreign inport or export signature
-  | RuleSigCtxt Name 	-- Signature on a forall'd variable in a RULE
-  | DefaultDeclCtxt	-- Types in a default declaration
-  | SpecInstCtxt	-- SPECIALISE instance pragma
-
--- Notes re TySynCtxt
--- We allow type synonyms that aren't types; e.g.  type List = []
---
--- If the RHS mentions tyvars that aren't in scope, we'll 
--- quantify over them:
---	e.g. 	type T = a->a
--- will become	type T = forall a. a->a
---
--- With gla-exts that's right, but for H98 we should complain. 
-\end{code}
-
-%************************************************************************
-%*									*
-		Pretty-printing
-%*									*
-%************************************************************************
-
-\begin{code}
-pprTcTyVarDetails :: TcTyVarDetails -> SDoc
--- For debugging
-pprTcTyVarDetails (SkolemTv _)         = ptext SLIT("sk")
-pprTcTyVarDetails (MetaTv BoxTv _)     = ptext SLIT("box")
-pprTcTyVarDetails (MetaTv TauTv _)     = ptext SLIT("tau")
-pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext SLIT("sig")
-
-pprUserTypeCtxt :: UserTypeCtxt -> SDoc
-pprUserTypeCtxt (FunSigCtxt n)  = ptext SLIT("the type signature for") <+> quotes (ppr n)
-pprUserTypeCtxt ExprSigCtxt     = ptext SLIT("an expression type signature")
-pprUserTypeCtxt (ConArgCtxt c)  = ptext SLIT("the type of the constructor") <+> quotes (ppr c)
-pprUserTypeCtxt (TySynCtxt c)   = ptext SLIT("the RHS of the type synonym") <+> quotes (ppr c)
-pprUserTypeCtxt GenPatCtxt      = ptext SLIT("the type pattern of a generic definition")
-pprUserTypeCtxt LamPatSigCtxt   = ptext SLIT("a pattern type signature")
-pprUserTypeCtxt BindPatSigCtxt  = ptext SLIT("a pattern type signature")
-pprUserTypeCtxt ResSigCtxt      = ptext SLIT("a result type signature")
-pprUserTypeCtxt (ForSigCtxt n)  = ptext SLIT("the foreign declaration for") <+> quotes (ppr n)
-pprUserTypeCtxt (RuleSigCtxt n) = ptext SLIT("the type signature for") <+> quotes (ppr n)
-pprUserTypeCtxt DefaultDeclCtxt = ptext SLIT("a type in a `default' declaration")
-pprUserTypeCtxt SpecInstCtxt    = ptext SLIT("a SPECIALISE instance pragma")
-
-
---------------------------------
-tidySkolemTyVar :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
--- Tidy the type inside a GenSkol, preparatory to printing it
-tidySkolemTyVar env tv
-  = ASSERT( isSkolemTyVar tv )
-    (env1, mkTcTyVar (tyVarName tv) (tyVarKind tv) info1)
-  where
-    (env1, info1) = case tcTyVarDetails tv of
-		      SkolemTv (GenSkol tvs ty loc) -> (env2, SkolemTv (GenSkol tvs1 ty1 loc))
-			    where
-			      (env1, tvs1) = tidyOpenTyVars env tvs
-			      (env2, ty1)  = tidyOpenType env1 ty
-		      info -> (env, info)
-		     
-pprSkolTvBinding :: TcTyVar -> SDoc
--- Print info about the binding of a skolem tyvar, 
--- or nothing if we don't have anything useful to say
-pprSkolTvBinding tv
-  = ppr_details (tcTyVarDetails tv)
-  where
-    ppr_details (MetaTv TauTv _)   = quotes (ppr tv) <+> ptext SLIT("is a meta type variable")
-    ppr_details (MetaTv BoxTv _)   = quotes (ppr tv) <+> ptext SLIT("is a boxy type variable")
-    ppr_details (MetaTv (SigTv info) _) = ppr_skol info
-    ppr_details (SkolemTv info)		= ppr_skol info
-
-    ppr_skol UnkSkol 	     = empty	-- Unhelpful; omit
-    ppr_skol (SigSkol ctxt)  = sep [quotes (ppr tv) <+> ptext SLIT("is bound by") <+> pprUserTypeCtxt ctxt,
-				    nest 2 (ptext SLIT("at") <+> ppr (getSrcLoc tv))]
-    ppr_skol info            = quotes (ppr tv) <+> pprSkolInfo info
- 
-pprSkolInfo :: SkolemInfo -> SDoc
-pprSkolInfo (SigSkol ctxt)   = ptext SLIT("is bound by") <+> pprUserTypeCtxt ctxt
-pprSkolInfo (ClsSkol cls)    = ptext SLIT("is bound by the class declaration for") <+> quotes (ppr cls)
-pprSkolInfo (InstSkol df)    = ptext SLIT("is bound by the instance declaration at") <+> ppr (getSrcLoc df)
-pprSkolInfo (ArrowSkol loc)  = ptext SLIT("is bound by the arrow form at") <+> ppr loc
-pprSkolInfo (PatSkol dc loc) = sep [ptext SLIT("is bound by the pattern for") <+> quotes (ppr dc),
-           		            nest 2 (ptext SLIT("at") <+> ppr loc)]
-pprSkolInfo (GenSkol tvs ty loc) = sep [sep [ptext SLIT("is bound by the polymorphic type"), 
-				   	     nest 2 (quotes (ppr (mkForAllTys tvs ty)))],
-				        nest 2 (ptext SLIT("at") <+> ppr loc)]
--- UnkSkol, SigSkol
--- For type variables the others are dealt with by pprSkolTvBinding.  
--- For Insts, these cases should not happen
-pprSkolInfo UnkSkol = panic "UnkSkol"
-
-instance Outputable MetaDetails where
-  ppr Flexi 	    = ptext SLIT("Flexi")
-  ppr (Indirect ty) = ptext SLIT("Indirect") <+> ppr ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Predicates
-%*									*
-%************************************************************************
-
-\begin{code}
-isImmutableTyVar, isSkolemTyVar, isExistentialTyVar, isBoxyTyVar, isMetaTyVar :: TyVar -> Bool
-isImmutableTyVar tv
-  | isTcTyVar tv = isSkolemTyVar tv
-  | otherwise    = True
-
-isSkolemTyVar tv 
-  = ASSERT( isTcTyVar tv )
-    case tcTyVarDetails tv of
-	SkolemTv _         -> True
- 	MetaTv _ _         -> False
-
-isExistentialTyVar tv 	-- Existential type variable, bound by a pattern
-  = ASSERT( isTcTyVar tv )
-    case tcTyVarDetails tv of
-	SkolemTv (PatSkol _ _) -> True
-	other 		       -> False
-
-isMetaTyVar tv 
-  = ASSERT2( isTcTyVar tv, ppr tv )
-    case tcTyVarDetails tv of
-	MetaTv _ _ -> True
-	other      -> False
-
-isBoxyTyVar tv 
-  = ASSERT( isTcTyVar tv )
-    case tcTyVarDetails tv of
-	MetaTv BoxTv _ -> True
-	other          -> False
-
-isSigTyVar tv 
-  = ASSERT( isTcTyVar tv )
-    case tcTyVarDetails tv of
-	MetaTv (SigTv _) _ -> True
-	other              -> False
-
-metaTvRef :: TyVar -> IORef MetaDetails
-metaTvRef tv 
-  = ASSERT( isTcTyVar tv )
-    case tcTyVarDetails tv of
-	MetaTv _ ref -> ref
-	other	   -> pprPanic "metaTvRef" (ppr tv)
-
-isFlexi, isIndirect :: MetaDetails -> Bool
-isFlexi Flexi = True
-isFlexi other = False
-
-isIndirect (Indirect _) = True
-isIndirect other        = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Tau, sigma and rho}
-%*									*
-%************************************************************************
-
-\begin{code}
-mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
-
-mkPhiTy :: [PredType] -> Type -> Type
-mkPhiTy theta ty = foldr (\p r -> FunTy (mkPredTy p) r) ty theta
-\end{code}
-
-@isTauTy@ tests for nested for-alls.  It should not be called on a boxy type.
-
-\begin{code}
-isTauTy :: Type -> Bool
-isTauTy ty | Just ty' <- tcView ty = isTauTy ty'
-isTauTy (TyVarTy tv)	 = ASSERT( not (isTcTyVar tv && isBoxyTyVar tv) )
-			   True
-isTauTy (TyConApp tc tys) = all isTauTy tys && isTauTyCon tc
-isTauTy (AppTy a b)	  = isTauTy a && isTauTy b
-isTauTy (FunTy a b)	  = isTauTy a && isTauTy b
-isTauTy (PredTy p)	  = True		-- Don't look through source types
-isTauTy other		  = False
-
-
-isTauTyCon :: TyCon -> Bool
--- Returns False for type synonyms whose expansion is a polytype
-isTauTyCon tc | isSynTyCon tc = isTauTy (snd (synTyConDefn tc))
-	      | otherwise     = True
-
----------------
-isBoxyTy :: TcType -> Bool
-isBoxyTy ty = any isBoxyTyVar (varSetElems (tcTyVarsOfType ty))
-
-isRigidTy :: TcType -> Bool
--- A type is rigid if it has no meta type variables in it
-isRigidTy ty = all isSkolemTyVar (varSetElems (tcTyVarsOfType ty))
-
-isRefineableTy :: TcType -> Bool
--- A type should have type refinements applied to it if it has
--- free type variables, and they are all rigid
-isRefineableTy ty = not (null tc_tvs) && all isSkolemTyVar tc_tvs
-		    where
-		      tc_tvs = varSetElems (tcTyVarsOfType ty)
-
----------------
-getDFunTyKey :: Type -> OccName	-- Get some string from a type, to be used to 
-				-- construct a dictionary function name
-getDFunTyKey ty | Just ty' <- tcView ty = getDFunTyKey ty'
-getDFunTyKey (TyVarTy tv)    = getOccName tv
-getDFunTyKey (TyConApp tc _) = getOccName tc
-getDFunTyKey (AppTy fun _)   = getDFunTyKey fun
-getDFunTyKey (FunTy arg _)   = getOccName funTyCon
-getDFunTyKey (ForAllTy _ t)  = getDFunTyKey t
-getDFunTyKey ty		     = pprPanic "getDFunTyKey" (pprType ty)
--- PredTy shouldn't happen
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Expanding and splitting}
-%*									*
-%************************************************************************
-
-These tcSplit functions are like their non-Tc analogues, but
-	a) they do not look through newtypes
-	b) they do not look through PredTys
-	c) [future] they ignore usage-type annotations
-
-However, they are non-monadic and do not follow through mutable type
-variables.  It's up to you to make sure this doesn't matter.
-
-\begin{code}
-tcSplitForAllTys :: Type -> ([TyVar], Type)
-tcSplitForAllTys ty = split ty ty []
-   where
-     split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
-     split orig_ty (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
-     split orig_ty t		    tvs = (reverse tvs, orig_ty)
-
-tcIsForAllTy ty | Just ty' <- tcView ty = tcIsForAllTy ty'
-tcIsForAllTy (ForAllTy tv ty) = True
-tcIsForAllTy t		      = False
-
-tcSplitPhiTy :: Type -> ([PredType], Type)
-tcSplitPhiTy ty = split ty ty []
- where
-  split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
-  split orig_ty (FunTy arg res) ts = case tcSplitPredTy_maybe arg of
-					Just p  -> split res res (p:ts)
-					Nothing -> (reverse ts, orig_ty)
-  split orig_ty ty		ts = (reverse ts, orig_ty)
-
-tcSplitSigmaTy ty = case tcSplitForAllTys ty of
-			(tvs, rho) -> case tcSplitPhiTy rho of
-					(theta, tau) -> (tvs, theta, tau)
-
------------------------
-tcMultiSplitSigmaTy
-	:: TcSigmaType
-	-> ( [([TyVar], ThetaType)],	-- forall as.C => forall bs.D
-	     TcSigmaType)		-- The rest of the type
-
--- We need a loop here because we are now prepared to entertain
--- types like
--- 	f:: forall a. Eq a => forall b. Baz b => tau
--- We want to instantiate this to
--- 	f2::tau		{f2 = f1 b (Baz b), f1 = f a (Eq a)}
-
-tcMultiSplitSigmaTy sigma
-  = case (tcSplitSigmaTy sigma) of
-	([],[],ty) -> ([], sigma)
-	(tvs, theta, ty) -> case tcMultiSplitSigmaTy ty of
-				(pairs, rest) -> ((tvs,theta):pairs, rest)
-
------------------------
-tcTyConAppTyCon :: Type -> TyCon
-tcTyConAppTyCon ty = fst (tcSplitTyConApp ty)
-
-tcTyConAppArgs :: Type -> [Type]
-tcTyConAppArgs ty = snd (tcSplitTyConApp ty)
-
-tcSplitTyConApp :: Type -> (TyCon, [Type])
-tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
-			Just stuff -> stuff
-			Nothing	   -> pprPanic "tcSplitTyConApp" (pprType ty)
-
-tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
-tcSplitTyConApp_maybe ty | Just ty' <- tcView ty = tcSplitTyConApp_maybe ty'
-tcSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
-tcSplitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
-	-- Newtypes are opaque, so they may be split
-	-- However, predicates are not treated
-	-- as tycon applications by the type checker
-tcSplitTyConApp_maybe other	      	= Nothing
-
------------------------
-tcSplitFunTys :: Type -> ([Type], Type)
-tcSplitFunTys ty = case tcSplitFunTy_maybe ty of
-			Nothing	       -> ([], ty)
-			Just (arg,res) -> (arg:args, res')
-				       where
-					  (args,res') = tcSplitFunTys res
-
-tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
-tcSplitFunTy_maybe ty | Just ty' <- tcView ty = tcSplitFunTy_maybe ty'
-tcSplitFunTy_maybe (FunTy arg res)  = Just (arg, res)
-tcSplitFunTy_maybe other	    = Nothing
-
-tcSplitFunTysN
-	:: TcRhoType 
-	-> Arity		-- N: Number of desired args
-	-> ([TcSigmaType], 	-- Arg types (N or fewer)
-	    TcSigmaType)	-- The rest of the type
-
-tcSplitFunTysN ty n_args
-  | n_args == 0
-  = ([], ty)
-  | Just (arg,res) <- tcSplitFunTy_maybe ty
-  = case tcSplitFunTysN res (n_args - 1) of
-	(args, res) -> (arg:args, res)
-  | otherwise
-  = ([], ty)
-
-tcFunArgTy    ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> arg }
-tcFunResultTy ty = case tcSplitFunTy_maybe ty of { Just (arg,res) -> res }
-
-
------------------------
-tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
-tcSplitAppTy_maybe ty | Just ty' <- tcView ty = tcSplitAppTy_maybe ty'
-tcSplitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
-tcSplitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
-tcSplitAppTy_maybe (TyConApp tc tys) = case snocView tys of
-					Just (tys', ty') -> Just (TyConApp tc tys', ty')
-					Nothing		 -> Nothing
-tcSplitAppTy_maybe other	     = Nothing
-
-tcSplitAppTy ty = case tcSplitAppTy_maybe ty of
-		    Just stuff -> stuff
-		    Nothing    -> pprPanic "tcSplitAppTy" (pprType ty)
-
-tcSplitAppTys :: Type -> (Type, [Type])
-tcSplitAppTys ty
-  = go ty []
-  where
-    go ty args = case tcSplitAppTy_maybe ty of
-		   Just (ty', arg) -> go ty' (arg:args)
-		   Nothing	   -> (ty,args)
-
------------------------
-tcGetTyVar_maybe :: Type -> Maybe TyVar
-tcGetTyVar_maybe ty | Just ty' <- tcView ty = tcGetTyVar_maybe ty'
-tcGetTyVar_maybe (TyVarTy tv) 	= Just tv
-tcGetTyVar_maybe other	        = Nothing
-
-tcGetTyVar :: String -> Type -> TyVar
-tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)
-
-tcIsTyVarTy :: Type -> Bool
-tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
-
------------------------
-tcSplitDFunTy :: Type -> ([TyVar], [PredType], Class, [Type])
--- Split the type of a dictionary function
-tcSplitDFunTy ty 
-  = case tcSplitSigmaTy ty   of { (tvs, theta, tau) ->
-    case tcSplitDFunHead tau of { (clas, tys) -> 
-    (tvs, theta, clas, tys) }}
-
-tcSplitDFunHead :: Type -> (Class, [Type])
-tcSplitDFunHead tau  
-  = case tcSplitPredTy_maybe tau of 
-	Just (ClassP clas tys) -> (clas, tys)
-
-tcValidInstHeadTy :: Type -> Bool
--- Used in Haskell-98 mode, for the argument types of an instance head
--- These must not be type synonyms, but everywhere else type synonyms
--- are transparent, so we need a special function here
-tcValidInstHeadTy ty
-  = case ty of
-	NoteTy _ ty     -> tcValidInstHeadTy ty
-	TyConApp tc tys -> not (isSynTyCon tc) && ok tys
-	FunTy arg res   -> ok [arg, res]
-	other		-> False
-  where
-	-- Check that all the types are type variables,
-	-- and that each is distinct
-    ok tys = equalLength tvs tys && hasNoDups tvs
-	   where
-	     tvs = mapCatMaybes get_tv tys
-
-    get_tv (NoteTy _ ty) = get_tv ty 	-- Again, do not look
-    get_tv (TyVarTy tv)  = Just tv	-- through synonyms
-    get_tv other  	 = Nothing
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Predicate types}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcSplitPredTy_maybe :: Type -> Maybe PredType
-   -- Returns Just for predicates only
-tcSplitPredTy_maybe ty | Just ty' <- tcView ty = tcSplitPredTy_maybe ty'
-tcSplitPredTy_maybe (PredTy p)    = Just p
-tcSplitPredTy_maybe other	  = Nothing
-	
-predTyUnique :: PredType -> Unique
-predTyUnique (IParam n _)      = getUnique (ipNameName n)
-predTyUnique (ClassP clas tys) = getUnique clas
-
-mkPredName :: Unique -> SrcLoc -> PredType -> Name
-mkPredName uniq loc (ClassP cls tys) = mkInternalName uniq (mkDictOcc (getOccName cls)) loc
-mkPredName uniq loc (IParam ip ty)   = mkInternalName uniq (getOccName (ipNameName ip)) loc
-\end{code}
-
-
---------------------- Dictionary types ---------------------------------
-
-\begin{code}
-mkClassPred clas tys = ClassP clas tys
-
-isClassPred :: PredType -> Bool
-isClassPred (ClassP clas tys) = True
-isClassPred other	      = False
-
-isTyVarClassPred (ClassP clas tys) = all tcIsTyVarTy tys
-isTyVarClassPred other		   = False
-
-getClassPredTys_maybe :: PredType -> Maybe (Class, [Type])
-getClassPredTys_maybe (ClassP clas tys) = Just (clas, tys)
-getClassPredTys_maybe _		        = Nothing
-
-getClassPredTys :: PredType -> (Class, [Type])
-getClassPredTys (ClassP clas tys) = (clas, tys)
-
-mkDictTy :: Class -> [Type] -> Type
-mkDictTy clas tys = mkPredTy (ClassP clas tys)
-
-isDictTy :: Type -> Bool
-isDictTy ty | Just ty' <- tcView ty = isDictTy ty'
-isDictTy (PredTy p)   = isClassPred p
-isDictTy other		= False
-\end{code}
-
---------------------- Implicit parameters ---------------------------------
-
-\begin{code}
-isIPPred :: PredType -> Bool
-isIPPred (IParam _ _) = True
-isIPPred other	      = False
-
-isInheritablePred :: PredType -> Bool
--- Can be inherited by a context.  For example, consider
---	f x = let g y = (?v, y+x)
---	      in (g 3 with ?v = 8, 
---		  g 4 with ?v = 9)
--- The point is that g's type must be quantifed over ?v:
---	g :: (?v :: a) => a -> a
--- but it doesn't need to be quantified over the Num a dictionary
--- which can be free in g's rhs, and shared by both calls to g
-isInheritablePred (ClassP _ _) = True
-isInheritablePred other	     = False
-
-isLinearPred :: TcPredType -> Bool
-isLinearPred (IParam (Linear n) _) = True
-isLinearPred other		   = False
-\end{code}
-
---------------------- The stupid theta (sigh) ---------------------------------
-
-\begin{code}
-dataConsStupidTheta :: [DataCon] -> ThetaType
--- Union the stupid thetas from all the specified constructors (non-empty)
--- All the constructors should have the same result type, modulo alpha conversion
--- The resulting ThetaType uses type variables from the *first* constructor in the list
---
--- It's here because it's used in MkId.mkRecordSelId, and in TcExpr
-dataConsStupidTheta (con1:cons)
-  = nubBy tcEqPred all_preds
-  where
-    all_preds 	  = dataConStupidTheta con1 ++ other_stupids
-    res_tys1  	  = dataConResTys con1
-    tvs1      	  = tyVarsOfTypes res_tys1
-    other_stupids = [ substPred subst pred
-		    | con <- cons
-		    , let Just subst = tcMatchTys tvs1 res_tys1 (dataConResTys con)
-		    , pred <- dataConStupidTheta con ]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Predicates}
-%*									*
-%************************************************************************
-
-isSigmaTy returns true of any qualified type.  It doesn't *necessarily* have 
-any foralls.  E.g.
-	f :: (?x::Int) => Int -> Int
-
-\begin{code}
-isSigmaTy :: Type -> Bool
-isSigmaTy ty | Just ty' <- tcView ty = isSigmaTy ty'
-isSigmaTy (ForAllTy tyvar ty) = True
-isSigmaTy (FunTy a b)	      = isPredTy a
-isSigmaTy _		      = False
-
-isOverloadedTy :: Type -> Bool
-isOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'
-isOverloadedTy (ForAllTy tyvar ty) = isOverloadedTy ty
-isOverloadedTy (FunTy a b)	   = isPredTy a
-isOverloadedTy _		   = False
-
-isPredTy :: Type -> Bool	-- Belongs in TcType because it does 
-				-- not look through newtypes, or predtypes (of course)
-isPredTy ty | Just ty' <- tcView ty = isPredTy ty'
-isPredTy (PredTy sty)  = True
-isPredTy _	       = False
-\end{code}
-
-\begin{code}
-isFloatTy      = is_tc floatTyConKey
-isDoubleTy     = is_tc doubleTyConKey
-isIntegerTy    = is_tc integerTyConKey
-isIntTy        = is_tc intTyConKey
-isAddrTy       = is_tc addrTyConKey
-isBoolTy       = is_tc boolTyConKey
-isUnitTy       = is_tc unitTyConKey
-
-is_tc :: Unique -> Type -> Bool
--- Newtypes are opaque to this
-is_tc uniq ty = case tcSplitTyConApp_maybe ty of
-			Just (tc, _) -> uniq == getUnique tc
-			Nothing	     -> False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Misc}
-%*									*
-%************************************************************************
-
-\begin{code}
-deNoteType :: Type -> Type
--- Remove all *outermost* type synonyms and other notes
-deNoteType ty | Just ty' <- tcView ty = deNoteType ty'
-deNoteType ty = ty
-\end{code}
-
-\begin{code}
-tcTyVarsOfType :: Type -> TcTyVarSet
--- Just the tc type variables free in the type
-tcTyVarsOfType (TyVarTy tv)	    = if isTcTyVar tv then unitVarSet tv
-						      else emptyVarSet
-tcTyVarsOfType (TyConApp tycon tys) = tcTyVarsOfTypes tys
-tcTyVarsOfType (NoteTy _ ty)	    = tcTyVarsOfType ty
-tcTyVarsOfType (PredTy sty)	    = tcTyVarsOfPred sty
-tcTyVarsOfType (FunTy arg res)	    = tcTyVarsOfType arg `unionVarSet` tcTyVarsOfType res
-tcTyVarsOfType (AppTy fun arg)	    = tcTyVarsOfType fun `unionVarSet` tcTyVarsOfType arg
-tcTyVarsOfType (ForAllTy tyvar ty)  = tcTyVarsOfType ty `delVarSet` tyvar
-	-- We do sometimes quantify over skolem TcTyVars
-
-tcTyVarsOfTypes :: [Type] -> TyVarSet
-tcTyVarsOfTypes tys = foldr (unionVarSet.tcTyVarsOfType) emptyVarSet tys
-
-tcTyVarsOfPred :: PredType -> TyVarSet
-tcTyVarsOfPred (IParam _ ty)  = tcTyVarsOfType ty
-tcTyVarsOfPred (ClassP _ tys) = tcTyVarsOfTypes tys
-\end{code}
-
-Note [Silly type synonym]
-~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-	type T a = Int
-What are the free tyvars of (T x)?  Empty, of course!  
-Here's the example that Ralf Laemmel showed me:
-	foo :: (forall a. C u a -> C u a) -> u
-	mappend :: Monoid u => u -> u -> u
-
-	bar :: Monoid u => u
-	bar = foo (\t -> t `mappend` t)
-We have to generalise at the arg to f, and we don't
-want to capture the constraint (Monad (C u a)) because
-it appears to mention a.  Pretty silly, but it was useful to him.
-
-exactTyVarsOfType is used by the type checker to figure out exactly
-which type variables are mentioned in a type.  It's also used in the
-smart-app checking code --- see TcExpr.tcIdApp
-
-\begin{code}
-exactTyVarsOfType :: TcType -> TyVarSet
--- Find the free type variables (of any kind)
--- but *expand* type synonyms.  See Note [Silly type synonym] belos.
-exactTyVarsOfType ty
-  = go ty
-  where
-    go ty | Just ty' <- tcView ty = go ty'	-- This is the key line
-    go (TyVarTy tv)         	  = unitVarSet tv
-    go (TyConApp tycon tys) 	  = exactTyVarsOfTypes tys
-    go (PredTy ty)	    	  = go_pred ty
-    go (FunTy arg res)	    	  = go arg `unionVarSet` go res
-    go (AppTy fun arg)	    	  = go fun `unionVarSet` go arg
-    go (ForAllTy tyvar ty)  	  = delVarSet (go ty) tyvar
-
-    go_pred (IParam _ ty)  = go ty
-    go_pred (ClassP _ tys) = exactTyVarsOfTypes tys
-
-exactTyVarsOfTypes :: [TcType] -> TyVarSet
-exactTyVarsOfTypes tys = foldr (unionVarSet . exactTyVarsOfType) emptyVarSet tys
-\end{code}
-
-Find the free tycons and classes of a type.  This is used in the front
-end of the compiler.
-
-\begin{code}
-tyClsNamesOfType :: Type -> NameSet
-tyClsNamesOfType (TyVarTy tv)		    = emptyNameSet
-tyClsNamesOfType (TyConApp tycon tys)	    = unitNameSet (getName tycon) `unionNameSets` tyClsNamesOfTypes tys
-tyClsNamesOfType (NoteTy _ ty2) 	    = tyClsNamesOfType ty2
-tyClsNamesOfType (PredTy (IParam n ty))     = tyClsNamesOfType ty
-tyClsNamesOfType (PredTy (ClassP cl tys))   = unitNameSet (getName cl) `unionNameSets` tyClsNamesOfTypes tys
-tyClsNamesOfType (FunTy arg res)	    = tyClsNamesOfType arg `unionNameSets` tyClsNamesOfType res
-tyClsNamesOfType (AppTy fun arg)	    = tyClsNamesOfType fun `unionNameSets` tyClsNamesOfType arg
-tyClsNamesOfType (ForAllTy tyvar ty)	    = tyClsNamesOfType ty
-
-tyClsNamesOfTypes tys = foldr (unionNameSets . tyClsNamesOfType) emptyNameSet tys
-
-tyClsNamesOfDFunHead :: Type -> NameSet
--- Find the free type constructors and classes 
--- of the head of the dfun instance type
--- The 'dfun_head_type' is because of
---	instance Foo a => Baz T where ...
--- The decl is an orphan if Baz and T are both not locally defined,
---	even if Foo *is* locally defined
-tyClsNamesOfDFunHead dfun_ty 
-  = case tcSplitSigmaTy dfun_ty of
-	(tvs,_,head_ty) -> tyClsNamesOfType head_ty
-
-classesOfTheta :: ThetaType -> [Class]
--- Looks just for ClassP things; maybe it should check
-classesOfTheta preds = [ c | ClassP c _ <- preds ]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[TysWiredIn-ext-type]{External types}
-%*									*
-%************************************************************************
-
-The compiler's foreign function interface supports the passing of a
-restricted set of types as arguments and results (the restricting factor
-being the )
-
-\begin{code}
-isFFITy :: Type -> Bool
--- True for any TyCon that can possibly be an arg or result of an FFI call
-isFFITy ty = checkRepTyCon legalFFITyCon ty
-
-isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
--- Checks for valid argument type for a 'foreign import'
-isFFIArgumentTy dflags safety ty 
-   = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
-
-isFFIExternalTy :: Type -> Bool
--- Types that are allowed as arguments of a 'foreign export'
-isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
-
-isFFIImportResultTy :: DynFlags -> Type -> Bool
-isFFIImportResultTy dflags ty 
-  = checkRepTyCon (legalFIResultTyCon dflags) ty
-
-isFFIExportResultTy :: Type -> Bool
-isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
-
-isFFIDynArgumentTy :: Type -> Bool
--- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
--- or a newtype of either.
-isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
-
-isFFIDynResultTy :: Type -> Bool
--- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
--- or a newtype of either.
-isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
-
-isFFILabelTy :: Type -> Bool
--- The type of a foreign label must be Ptr, FunPtr, Addr,
--- or a newtype of either.
-isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey, addrTyConKey]
-
-isFFIDotnetTy :: DynFlags -> Type -> Bool
-isFFIDotnetTy dflags ty
-  = checkRepTyCon (\ tc -> not (isByteArrayLikeTyCon tc) &&
-  			   (legalFIResultTyCon dflags tc || 
-			   isFFIDotnetObjTy ty || isStringTy ty)) ty
-
--- Support String as an argument or result from a .NET FFI call.
-isStringTy ty = 
-  case tcSplitTyConApp_maybe (repType ty) of
-    Just (tc, [arg_ty])
-      | tc == listTyCon ->
-        case tcSplitTyConApp_maybe (repType arg_ty) of
-	  Just (cc,[]) -> cc == charTyCon
-	  _ -> False
-    _ -> False
-
--- Support String as an argument or result from a .NET FFI call.
-isFFIDotnetObjTy ty = 
-  let
-   (_, t_ty) = tcSplitForAllTys ty
-  in
-  case tcSplitTyConApp_maybe (repType t_ty) of
-    Just (tc, [arg_ty]) | getName tc == objectTyConName -> True
-    _ -> False
-
-toDNType :: Type -> DNType
-toDNType ty
-  | isStringTy ty = DNString
-  | isFFIDotnetObjTy ty = DNObject
-  | Just (tc,argTys) <- tcSplitTyConApp_maybe ty = 
-     case lookup (getUnique tc) dn_assoc of
-       Just x  -> x
-       Nothing 
-         | tc `hasKey` ioTyConKey -> toDNType (head argTys)
-	 | otherwise -> pprPanic ("toDNType: unsupported .NET type") (pprType ty <+> parens (hcat (map pprType argTys)) <+> ppr tc)
-    where
-      dn_assoc :: [ (Unique, DNType) ]
-      dn_assoc = [ (unitTyConKey,   DNUnit)
-      		 , (intTyConKey,    DNInt)
-      	         , (int8TyConKey,   DNInt8)
-		 , (int16TyConKey,  DNInt16)
-		 , (int32TyConKey,  DNInt32)
-		 , (int64TyConKey,  DNInt64)
-		 , (wordTyConKey,   DNInt)
-		 , (word8TyConKey,  DNWord8)
-		 , (word16TyConKey, DNWord16)
-		 , (word32TyConKey, DNWord32)
-		 , (word64TyConKey, DNWord64)
-		 , (floatTyConKey,  DNFloat)
-		 , (doubleTyConKey, DNDouble)
-		 , (addrTyConKey,   DNPtr)
-		 , (ptrTyConKey,    DNPtr)
-		 , (funPtrTyConKey, DNPtr)
-		 , (charTyConKey,   DNChar)
-		 , (boolTyConKey,   DNBool)
-		 ]
-
-checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
-	-- Look through newtypes
-	-- Non-recursive ones are transparent to splitTyConApp,
-	-- but recursive ones aren't.  Manuel had:
-	--	newtype T = MkT (Ptr T)
-	-- and wanted it to work...
-checkRepTyCon check_tc ty 
-  | Just (tc,_) <- splitTyConApp_maybe (repType ty) = check_tc tc
-  | otherwise				  	    = False
-
-checkRepTyConKey :: [Unique] -> Type -> Bool
--- Like checkRepTyCon, but just looks at the TyCon key
-checkRepTyConKey keys
-  = checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
-\end{code}
-
-----------------------------------------------
-These chaps do the work; they are not exported
-----------------------------------------------
-
-\begin{code}
-legalFEArgTyCon :: TyCon -> Bool
--- It's illegal to return foreign objects and (mutable)
--- bytearrays from a _ccall_ / foreign declaration
--- (or be passed them as arguments in foreign exported functions).
-legalFEArgTyCon tc
-  | isByteArrayLikeTyCon tc
-  = False
-  -- It's also illegal to make foreign exports that take unboxed
-  -- arguments.  The RTS API currently can't invoke such things.  --SDM 7/2000
-  | otherwise
-  = boxedMarshalableTyCon tc
-
-legalFIResultTyCon :: DynFlags -> TyCon -> Bool
-legalFIResultTyCon dflags tc
-  | isByteArrayLikeTyCon tc = False
-  | tc == unitTyCon         = True
-  | otherwise	            = marshalableTyCon dflags tc
-
-legalFEResultTyCon :: TyCon -> Bool
-legalFEResultTyCon tc
-  | isByteArrayLikeTyCon tc = False
-  | tc == unitTyCon         = True
-  | otherwise               = boxedMarshalableTyCon tc
-
-legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
--- Checks validity of types going from Haskell -> external world
-legalOutgoingTyCon dflags safety tc
-  | playSafe safety && isByteArrayLikeTyCon tc
-  = False
-  | otherwise
-  = marshalableTyCon dflags tc
-
-legalFFITyCon :: TyCon -> Bool
--- True for any TyCon that can possibly be an arg or result of an FFI call
-legalFFITyCon tc
-  = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
-
-marshalableTyCon dflags tc
-  =  (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
-  || boxedMarshalableTyCon tc
-
-boxedMarshalableTyCon tc
-   = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
-			 , int32TyConKey, int64TyConKey
-			 , wordTyConKey, word8TyConKey, word16TyConKey
-			 , word32TyConKey, word64TyConKey
-			 , floatTyConKey, doubleTyConKey
-			 , addrTyConKey, ptrTyConKey, funPtrTyConKey
-			 , charTyConKey
-			 , stablePtrTyConKey
-			 , byteArrayTyConKey, mutableByteArrayTyConKey
-			 , boolTyConKey
-			 ]
-
-isByteArrayLikeTyCon :: TyCon -> Bool
-isByteArrayLikeTyCon tc = 
-  getUnique tc `elem` [byteArrayTyConKey, mutableByteArrayTyConKey]
-\end{code}
diff --git a/ghc/compiler/typecheck/TcType.lhs-boot b/ghc/compiler/typecheck/TcType.lhs-boot
deleted file mode 100644
index 191badd943..0000000000
--- a/ghc/compiler/typecheck/TcType.lhs-boot
+++ /dev/null
@@ -1,7 +0,0 @@
-\begin{code}
-module TcType where
-import Outputable( SDoc )
-
-data TcTyVarDetails 
-pprTcTyVarDetails :: TcTyVarDetails -> SDoc
-\end{code}
diff --git a/ghc/compiler/typecheck/TcUnify.hi-boot-5 b/ghc/compiler/typecheck/TcUnify.hi-boot-5
deleted file mode 100644
index b88d3abeb0..0000000000
--- a/ghc/compiler/typecheck/TcUnify.hi-boot-5
+++ /dev/null
@@ -1,8 +0,0 @@
--- This boot file exists only to tie the knot between
---		TcUnify and TcSimplify
-
-__interface TcUnify 1 0 where
-__export TcUnify unifyTauTy ;
-1 unifyTauTy :: TcType.TcTauType -> TcType.TcTauType -> TcRnTypes.TcM PrelBase.Z0T ;
-
-
diff --git a/ghc/compiler/typecheck/TcUnify.hi-boot-6 b/ghc/compiler/typecheck/TcUnify.hi-boot-6
deleted file mode 100644
index eb286359e2..0000000000
--- a/ghc/compiler/typecheck/TcUnify.hi-boot-6
+++ /dev/null
@@ -1,7 +0,0 @@
-module TcUnify where
-
--- This boot file exists only to tie the knot between
---		TcUnify and TcSimplify
-
-unifyType :: TcType.TcTauType -> TcType.TcTauType -> TcRnTypes.TcM ()
-zapToMonotype :: TcType.BoxyType -> TcRnTypes.TcM TcType.TcTauType
diff --git a/ghc/compiler/typecheck/TcUnify.lhs b/ghc/compiler/typecheck/TcUnify.lhs
deleted file mode 100644
index 23cc9e2176..0000000000
--- a/ghc/compiler/typecheck/TcUnify.lhs
+++ /dev/null
@@ -1,1724 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section{Type subsumption and unification}
-
-\begin{code}
-module TcUnify (
-	-- Full-blown subsumption
-  tcSubExp, tcFunResTy, tcGen, 
-  checkSigTyVars, checkSigTyVarsWrt, bleatEscapedTvs, sigCtxt, 
-
-	-- Various unifications
-  unifyType, unifyTypeList, unifyTheta,
-  unifyKind, unifyKinds, unifyFunKind, 
-  checkExpectedKind, 
-  boxySubMatchType, boxyMatchTypes,
-
-  --------------------------------
-  -- Holes
-  tcInfer, subFunTys, unBox, stripBoxyType, withBox, 
-  boxyUnify, boxyUnifyList, zapToMonotype,
-  boxySplitListTy, boxySplitTyConApp, boxySplitAppTy,
-  wrapFunResCoercion
-  ) where
-
-#include "HsVersions.h"
-
-import HsSyn		( ExprCoFn(..), idCoercion, isIdCoercion, (<.>) )
-import TypeRep		( Type(..), PredType(..) )
-
-import TcMType		( lookupTcTyVar, LookupTyVarResult(..),
-                          tcInstSkolType, newKindVar, newMetaTyVar,
-			  tcInstBoxy, newBoxyTyVar, newBoxyTyVarTys, readFilledBox, 
-			  readMetaTyVar, writeMetaTyVar, newFlexiTyVarTy,
-			  tcInstSkolTyVars, 
-			  zonkTcKind, zonkType, zonkTcType,  zonkTcTyVarsAndFV, 
-			  readKindVar, writeKindVar )
-import TcSimplify	( tcSimplifyCheck )
-import TcEnv		( tcGetGlobalTyVars, findGlobals )
-import TcIface		( checkWiredInTyCon )
-import TcRnMonad         -- TcType, amongst others
-import TcType		( TcKind, TcType, TcTyVar, TcTauType,
-			  BoxySigmaType, BoxyRhoType, BoxyType, 
-			  TcTyVarSet, TcThetaType, TcTyVarDetails(..), BoxInfo(..), 
-			  SkolemInfo( GenSkol, UnkSkol ), MetaDetails(..), isImmutableTyVar,
-			  pprSkolTvBinding, isTauTy, isTauTyCon, isSigmaTy, 
-			  mkFunTy, mkFunTys, mkTyConApp, isMetaTyVar,
-			  tcSplitForAllTys, tcSplitAppTy_maybe, tcSplitFunTys, mkTyVarTys,
-			  tyVarsOfType, mkPhiTy, mkTyVarTy, mkPredTy, 
-			  typeKind, mkForAllTys, mkAppTy, isBoxyTyVar,
-			  tidyOpenType, tidyOpenTyVar, tidyOpenTyVars,
-			  pprType, tidyKind, tidySkolemTyVar, isSkolemTyVar, tcView, 
-			  TvSubst, mkTvSubst, zipTyEnv, substTy, emptyTvSubst, 
-			  lookupTyVar, extendTvSubst )
-import Kind		( Kind(..), SimpleKind, KindVar, isArgTypeKind,
-			  openTypeKind, liftedTypeKind, mkArrowKind, defaultKind,
-			  isOpenTypeKind, argTypeKind, isLiftedTypeKind, isUnliftedTypeKind,
-			  isSubKind, pprKind, splitKindFunTys )
-import TysPrim		( alphaTy, betaTy )
-import Inst		( newDicts, instToId )
-import TyCon		( TyCon, tyConArity, tyConTyVars, isSynTyCon )
-import TysWiredIn	( listTyCon )
-import Id		( Id, mkSysLocal )
-import Var		( Var, varName, tyVarKind, isTcTyVar, tcTyVarDetails )
-import VarSet		( emptyVarSet, mkVarSet, unitVarSet, unionVarSet, elemVarSet, varSetElems,
-			  extendVarSet, intersectsVarSet )
-import VarEnv
-import Name		( Name, isSystemName )
-import ErrUtils		( Message )
-import Maybes		( expectJust, isNothing )
-import BasicTypes	( Arity )
-import UniqSupply	( uniqsFromSupply )
-import Util		( notNull, equalLength )
-import Outputable
-
--- Assertion imports
-#ifdef DEBUG
-import TcType		( isBoxyTy, isFlexi )
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{'hole' type variables}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcInfer :: (BoxyType -> TcM a) -> TcM (a, TcType)
-tcInfer tc_infer
-  = do	{ box <- newBoxyTyVar openTypeKind
-	; res <- tc_infer (mkTyVarTy box)
-	; res_ty <- readFilledBox box	-- Guaranteed filled-in by now
-	; return (res, res_ty) }
-\end{code}		   
-
-
-%************************************************************************
-%*									*
-	subFunTys
-%*									*
-%************************************************************************
-
-\begin{code}
-subFunTys :: SDoc  -- Somthing like "The function f has 3 arguments"
-		   -- or "The abstraction (\x.e) takes 1 argument"
-	  -> Arity		-- Expected # of args
-	  -> BoxyRhoType	-- res_ty
-	  -> ([BoxySigmaType] -> BoxyRhoType -> TcM a)
-	  -> TcM (ExprCoFn, a)
--- Attempt to decompse res_ty to have enough top-level arrows to
--- match the number of patterns in the match group
--- 
--- If (subFunTys n_args res_ty thing_inside) = (co_fn, res)
--- and the inner call to thing_inside passes args: [a1,...,an], b
--- then co_fn :: (a1 -> ... -> an -> b) -> res_ty
---
--- Note that it takes a BoxyRho type, and guarantees to return a BoxyRhoType
-
-
-{-	Error messages from subFunTys
-
-   The abstraction `\Just 1 -> ...' has two arguments
-   but its type `Maybe a -> a' has only one
-
-   The equation(s) for `f' have two arguments
-   but its type `Maybe a -> a' has only one
-
-   The section `(f 3)' requires 'f' to take two arguments
-   but its type `Int -> Int' has only one
-
-   The function 'f' is applied to two arguments
-   but its type `Int -> Int' has only one
--}
-
-
-subFunTys error_herald n_pats res_ty thing_inside
-  = loop n_pats [] res_ty
-  where
-	-- In 'loop', the parameter 'arg_tys' accumulates 
-	-- the arg types so far, in *reverse order*
-    loop n args_so_far res_ty
-	| Just res_ty' <- tcView res_ty  = loop n args_so_far res_ty'
-
-    loop n args_so_far res_ty
-	| isSigmaTy res_ty 	-- Do this before checking n==0, because we 
-				-- guarantee to return a BoxyRhoType, not a BoxySigmaType
-	= do { (gen_fn, (co_fn, res)) <- tcGen res_ty emptyVarSet $ \ res_ty' ->
-					 loop n args_so_far res_ty'
-	     ; return (gen_fn <.> co_fn, res) }
-
-    loop 0 args_so_far res_ty 
-	= do { res <- thing_inside (reverse args_so_far) res_ty
-	     ; return (idCoercion, res) }
-
-    loop n args_so_far (FunTy arg_ty res_ty) 
-	= do { (co_fn, res) <- loop (n-1) (arg_ty:args_so_far) res_ty
-	     ; co_fn' <- wrapFunResCoercion [arg_ty] co_fn
-	     ; return (co_fn', res) }
-
-	-- res_ty might have a type variable at the head, such as (a b c),
-	-- in which case we must fill in with (->).  Simplest thing to do
-	-- is to use boxyUnify, but we catch failure and generate our own
-	-- error message on failure
-    loop n args_so_far res_ty@(AppTy _ _)
-	= do { [arg_ty',res_ty'] <- newBoxyTyVarTys [argTypeKind, openTypeKind]
-	     ; (_, mb_unit) <- tryTcErrs $ boxyUnify res_ty (FunTy arg_ty' res_ty')
-	     ; if isNothing mb_unit then bale_out args_so_far res_ty
-	       else loop n args_so_far (FunTy arg_ty' res_ty') }
-
-    loop n args_so_far (TyVarTy tv)
-        | not (isImmutableTyVar tv)
-	= do { cts <- readMetaTyVar tv 
-	     ; case cts of
-		 Indirect ty -> loop n args_so_far ty
-		 Flexi -> do { (res_ty:arg_tys) <- withMetaTvs tv kinds mk_res_ty
-			     ; res <- thing_inside (reverse args_so_far ++ arg_tys) res_ty
-			     ; return (idCoercion, res) } }
-	where
-	  mk_res_ty (res_ty' : arg_tys') = mkFunTys arg_tys' res_ty'
-	  kinds = openTypeKind : take n (repeat argTypeKind)
-		-- Note argTypeKind: the args can have an unboxed type,
-		-- but not an unboxed tuple.
-
-    loop n args_so_far res_ty = bale_out args_so_far res_ty
-
-    bale_out args_so_far res_ty
-	= do { env0 <- tcInitTidyEnv
-	     ; res_ty' <- zonkTcType res_ty
-	     ; let (env1, res_ty'') = tidyOpenType env0 res_ty'
-	     ; failWithTcM (env1, mk_msg res_ty'' (length args_so_far)) }
-
-    mk_msg res_ty n_actual 
-      = error_herald <> comma $$ 
-	sep [ptext SLIT("but its type") <+> quotes (pprType res_ty), 
-	     if n_actual == 0 then ptext SLIT("has none") 
-	     else ptext SLIT("has only") <+> speakN n_actual]
-\end{code}
-
-\begin{code}
-----------------------
-boxySplitTyConApp :: TyCon			-- T :: k1 -> ... -> kn -> *
-	          -> BoxyRhoType 		-- Expected type (T a b c)
-		  -> TcM [BoxySigmaType]	-- Element types, a b c
-  -- It's used for wired-in tycons, so we call checkWiredInTyCOn
-  -- Precondition: never called with FunTyCon
-  -- Precondition: input type :: *
-
-boxySplitTyConApp tc orig_ty
-  = do	{ checkWiredInTyCon tc 
-	; loop (tyConArity tc) [] orig_ty }
-  where
-    loop n_req args_so_far ty 
-      | Just ty' <- tcView ty = loop n_req args_so_far ty'
-
-    loop n_req args_so_far (TyConApp tycon args)
-      | tc == tycon
-      = ASSERT( n_req == length args) 	-- ty::*
-	return (args ++ args_so_far)
-
-    loop n_req args_so_far (AppTy fun arg)
-      = loop (n_req - 1) (arg:args_so_far) fun
-
-    loop n_req args_so_far (TyVarTy tv)
-      | not (isImmutableTyVar tv)
-      = do { cts <- readMetaTyVar tv
-	   ; case cts of
-	       Indirect ty -> loop n_req args_so_far ty
-	       Flexi 	   -> do { arg_tys <- withMetaTvs tv arg_kinds mk_res_ty
-				 ; return (arg_tys ++ args_so_far) }
-	}
-      where
-	mk_res_ty arg_tys' = mkTyConApp tc arg_tys'
-	arg_kinds = map tyVarKind (take n_req (tyConTyVars tc))
-
-    loop _ _ _ = boxySplitFailure (mkTyConApp tc (mkTyVarTys (tyConTyVars tc))) orig_ty
-
-----------------------
-boxySplitListTy :: BoxyRhoType -> TcM BoxySigmaType	-- Special case for lists
-boxySplitListTy exp_ty = do { [elt_ty] <- boxySplitTyConApp listTyCon exp_ty
-			    ; return elt_ty }
-
-
-----------------------
-boxySplitAppTy :: BoxyRhoType				-- Type to split: m a
-	       -> TcM (BoxySigmaType, BoxySigmaType)	-- Returns m, a
--- Assumes (m: * -> k), where k is the kind of the incoming type
--- If the incoming type is boxy, then so are the result types; and vice versa
-
-boxySplitAppTy orig_ty
-  = loop orig_ty
-  where
-    loop ty 
-      | Just ty' <- tcView ty = loop ty'
-
-    loop ty 
-      | Just (fun_ty, arg_ty) <- tcSplitAppTy_maybe ty
-      = return (fun_ty, arg_ty)
-
-    loop (TyVarTy tv)
-      | not (isImmutableTyVar tv)
-      = do { cts <- readMetaTyVar tv
-	   ; case cts of
-	       Indirect ty -> loop ty
-	       Flexi       -> do { [fun_ty,arg_ty] <- withMetaTvs tv kinds mk_res_ty
-				 ; return (fun_ty, arg_ty) } }
-      where
-        mk_res_ty [fun_ty', arg_ty'] = mkAppTy fun_ty' arg_ty'
-	tv_kind = tyVarKind tv
-	kinds = [mkArrowKind liftedTypeKind (defaultKind tv_kind),
-					 	-- m :: * -> k
-		 liftedTypeKind]		-- arg type :: *
-	-- The defaultKind is a bit smelly.  If you remove it,
-	-- try compiling	f x = do { x }
-	-- and you'll get a kind mis-match.  It smells, but
-	-- not enough to lose sleep over.
-	
-    loop _ = boxySplitFailure (mkAppTy alphaTy betaTy) orig_ty
-
-------------------
-boxySplitFailure actual_ty expected_ty
-  = unifyMisMatch False False actual_ty expected_ty
-	-- "outer" is False, so we don't pop the context
-	-- which is what we want since we have not pushed one!
-\end{code}
-
-
---------------------------------
--- withBoxes: the key utility function
---------------------------------
-
-\begin{code}
-withMetaTvs :: TcTyVar	-- An unfilled-in, non-skolem, meta type variable
-	    -> [Kind] 	-- Make fresh boxes (with the same BoxTv/TauTv setting as tv)
-	    -> ([BoxySigmaType] -> BoxySigmaType)
-					-- Constructs the type to assign 
-					-- to the original var
-	    -> TcM [BoxySigmaType]  	-- Return the fresh boxes
-
--- It's entirely possible for the [kind] to be empty.  
--- For example, when pattern-matching on True, 
--- we call boxySplitTyConApp passing a boolTyCon
-
--- Invariant: tv is still Flexi
-
-withMetaTvs tv kinds mk_res_ty
-  | isBoxyTyVar tv
-  = do	{ box_tvs <- mapM (newMetaTyVar BoxTv) kinds
-	; let box_tys = mkTyVarTys box_tvs
-	; writeMetaTyVar tv (mk_res_ty box_tys)
-	; return box_tys }
-
-  | otherwise			-- Non-boxy meta type variable
-  = do	{ tau_tys <- mapM newFlexiTyVarTy kinds
-	; writeMetaTyVar tv (mk_res_ty tau_tys)	-- Write it *first*
-						-- Sure to be a tau-type
-	; return tau_tys }
-
-withBox :: Kind -> (BoxySigmaType -> TcM a) -> TcM (a, TcType)
--- Allocate a *boxy* tyvar
-withBox kind thing_inside
-  = do	{ box_tv <- newMetaTyVar BoxTv kind
-	; res <- thing_inside (mkTyVarTy box_tv)
-	; ty  <- readFilledBox box_tv
-  	; return (res, ty) }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Approximate boxy matching
-%*									*
-%************************************************************************
-
-\begin{code}
-boxySubMatchType 
-	:: TcTyVarSet -> TcType	-- The "template"; the tyvars are skolems
-	-> BoxyRhoType		-- Type to match (note a *Rho* type)
-	-> TvSubst 		-- Substitution of the [TcTyVar] to BoxySigmaTypes
-
-boxyMatchTypes 
-	:: TcTyVarSet -> [TcType] -- The "template"; the tyvars are skolems
-	-> [BoxySigmaType]	  -- Type to match
-	-> TvSubst 		  -- Substitution of the [TcTyVar] to BoxySigmaTypes
-
--- Find a *boxy* substitution that makes the template look as much 
--- 	like the BoxySigmaType as possible.  
--- It's always ok to return an empty substitution; 
---	anything more is jam on the pudding
--- 
--- NB1: This is a pure, non-monadic function.  
---	It does no unification, and cannot fail
---
--- Note [Matching kinds]
--- 	The target type might legitimately not be a sub-kind of template.  
---	For example, suppose the target is simply a box with an OpenTypeKind, 
---	and the template is a type variable with LiftedTypeKind.  
---	Then it's ok (because the target type will later be refined).
---	We simply don't bind the template type variable.
---
---	It might also be that the kind mis-match is an error. For example,
---	suppose we match the template (a -> Int) against (Int# -> Int),
---	where the template type variable 'a' has LiftedTypeKind.  This
---	matching function does not fail; it simply doesn't bind the template.
---	Later stuff will fail.
--- 
--- Precondition: the arg lengths are equal
--- Precondition: none of the template type variables appear in the [BoxySigmaType]
--- Precondition: any nested quantifiers in either type differ from 
--- 		 the template type variables passed as arguments
---
--- Note [Sub-match]
--- ~~~~~~~~~~~~~~~~
--- Consider this
--- 	head :: [a] -> a
--- 	|- head xs : <rhobox>
--- We will do a boxySubMatchType between 	a ~ <rhobox>
--- But we *don't* want to match [a |-> <rhobox>] because 
---     (a)	The box should be filled in with a rho-type, but
--- 	but the returned substitution maps TyVars to boxy *sigma*
--- 	types
---     (b) In any case, the right final answer might be *either*
--- 	instantiate 'a' with a rho-type or a sigma type
--- 	   head xs : Int   vs   head xs : forall b. b->b
--- So the matcher MUST NOT make a choice here.   In general, we only
--- bind a template type variable in boxyMatchType, not in boxySubMatchType.
-	
-boxySubMatchType tmpl_tvs tmpl_ty boxy_ty
-  = go tmpl_ty boxy_ty
-  where
-    go t_ty b_ty 
-	| Just t_ty' <- tcView t_ty = go t_ty' b_ty
-	| Just b_ty' <- tcView b_ty = go t_ty b_ty'
-
-    go (FunTy arg1 res1) (FunTy arg2 res2)
-	= do_match arg1 arg2 (go res1 res2)
-		-- Match the args, and sub-match the results
-
-    go (TyVarTy _) b_ty = emptyTvSubst	-- Do not bind!  See Note [Sub-match]
-
-    go t_ty b_ty = do_match t_ty b_ty emptyTvSubst	-- Otherwise we are safe to bind
-
-    do_match t_ty b_ty subst = boxy_match tmpl_tvs t_ty emptyVarSet b_ty subst
-
-------------
-boxyMatchTypes tmpl_tvs tmpl_tys boxy_tys
-  = ASSERT( length tmpl_tys == length boxy_tys )
-    boxy_match_s tmpl_tvs tmpl_tys emptyVarSet boxy_tys emptyTvSubst
-	-- ToDo: add error context?
-
-boxy_match_s tmpl_tvs [] boxy_tvs [] subst
-  = subst
-boxy_match_s tmpl_tvs (t_ty:t_tys) boxy_tvs (b_ty:b_tys) subst
-  = boxy_match_s tmpl_tvs t_tys boxy_tvs b_tys $
-    boxy_match tmpl_tvs t_ty boxy_tvs b_ty subst
-
-------------
-boxy_match :: TcTyVarSet -> TcType	-- Template
-	   -> TcTyVarSet 		-- boxy_tvs: do not bind template tyvars to any of these
-	   -> BoxySigmaType		-- Match against this type
-	   -> TvSubst
-	   -> TvSubst
-
--- The boxy_tvs argument prevents this match:
---	[a]  forall b. a  ~  forall b. b
--- We don't want to bind the template variable 'a'
--- to the quantified type variable 'b'!
-
-boxy_match tmpl_tvs orig_tmpl_ty boxy_tvs orig_boxy_ty subst
-  = go orig_tmpl_ty orig_boxy_ty
-  where
-    go t_ty b_ty 
-	| Just t_ty' <- tcView t_ty = go t_ty' b_ty
-	| Just b_ty' <- tcView b_ty = go t_ty b_ty'
-
-    go (ForAllTy _ ty1) (ForAllTy tv2 ty2)
-	= boxy_match tmpl_tvs ty1 (boxy_tvs `extendVarSet` tv2) ty2 subst
-
-    go (TyConApp tc1 tys1) (TyConApp tc2 tys2)
-	| tc1 == tc2 = go_s tys1 tys2
-
-    go (FunTy arg1 res1) (FunTy arg2 res2)
-	= go_s [arg1,res1] [arg2,res2]
-
-    go t_ty b_ty
-	| Just (s1,t1) <- tcSplitAppTy_maybe t_ty,
-	  Just (s2,t2) <- tcSplitAppTy_maybe b_ty,
-	  typeKind t2 `isSubKind` typeKind t1	-- Maintain invariant
-	= go_s [s1,t1] [s2,t2]
-
-    go (TyVarTy tv) b_ty
- 	| tv `elemVarSet` tmpl_tvs	-- Template type variable in the template
-	, not (intersectsVarSet boxy_tvs (tyVarsOfType orig_boxy_ty))
-	, typeKind b_ty `isSubKind` tyVarKind tv
-	= extendTvSubst subst tv boxy_ty'
-	where
-	  boxy_ty' = case lookupTyVar subst tv of
-			Nothing -> orig_boxy_ty
-			Just ty -> ty `boxyLub` orig_boxy_ty
-
-    go _ _ = subst	-- Always safe
-
-    --------
-    go_s tys1 tys2 = boxy_match_s tmpl_tvs tys1 boxy_tvs tys2 subst
-
-
-boxyLub :: BoxySigmaType -> BoxySigmaType -> BoxySigmaType
--- Combine boxy information from the two types
--- If there is a conflict, return the first
-boxyLub orig_ty1 orig_ty2
-  = go orig_ty1 orig_ty2
-  where
-    go (AppTy f1 a1) (AppTy f2 a2) = AppTy (boxyLub f1 f2) (boxyLub a1 a2)
-    go (FunTy f1 a1) (FunTy f2 a2) = FunTy (boxyLub f1 f2) (boxyLub a1 a2)
-    go (TyConApp tc1 ts1) (TyConApp tc2 ts2) 
-      | tc1 == tc2, length ts1 == length ts2
-      = TyConApp tc1 (zipWith boxyLub ts1 ts2)
-
-    go (TyVarTy tv1) ty2		-- This is the whole point; 
-      | isTcTyVar tv1, isMetaTyVar tv1 	-- choose ty2 if ty2 is a box
-      = ty2	
-
-	-- Look inside type synonyms, but only if the naive version fails
-    go ty1 ty2 | Just ty1' <- tcView ty1 = go ty1' ty2
-	       | Just ty2' <- tcView ty1 = go ty1 ty2'
-
-    -- For now, we don't look inside ForAlls, PredTys
-    go ty1 ty2 = orig_ty1	-- Default
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Subsumption checking
-%*									*
-%************************************************************************
-
-All the tcSub calls have the form
-	
-		tcSub expected_ty offered_ty
-which checks
-		offered_ty <= expected_ty
-
-That is, that a value of type offered_ty is acceptable in
-a place expecting a value of type expected_ty.
-
-It returns a coercion function 
-	co_fn :: offered_ty -> expected_ty
-which takes an HsExpr of type offered_ty into one of type
-expected_ty.
-
-\begin{code}
------------------
-tcSubExp :: BoxySigmaType -> BoxySigmaType -> TcM ExprCoFn	-- Locally used only
-	-- (tcSub act exp) checks that 
-	--	act <= exp
-tcSubExp actual_ty expected_ty
-  = addErrCtxtM (unifyCtxt actual_ty expected_ty)
-		(tc_sub True actual_ty actual_ty expected_ty expected_ty)
-
-tcFunResTy :: Name -> BoxySigmaType -> BoxySigmaType -> TcM ExprCoFn	-- Locally used only
-tcFunResTy fun actual_ty expected_ty
-  = addErrCtxtM (checkFunResCtxt fun actual_ty expected_ty) $
-		(tc_sub True actual_ty actual_ty expected_ty expected_ty)
-		   
------------------
-tc_sub :: Outer			-- See comments with uTys
-       -> BoxySigmaType		-- actual_ty, before expanding synonyms
-       -> BoxySigmaType		-- 		..and after
-       -> BoxySigmaType		-- expected_ty, before
-       -> BoxySigmaType		-- 		..and after
-       -> TcM ExprCoFn
-
-tc_sub outer act_sty act_ty exp_sty exp_ty
-  | Just exp_ty' <- tcView exp_ty = tc_sub False act_sty act_ty exp_sty exp_ty'
-tc_sub outer act_sty act_ty exp_sty exp_ty
-  | Just act_ty' <- tcView act_ty = tc_sub False act_sty act_ty' exp_sty exp_ty
-
------------------------------------
--- Rule SBOXY, plus other cases when act_ty is a type variable
--- Just defer to boxy matching
--- This rule takes precedence over SKOL!
-tc_sub outer act_sty (TyVarTy tv) exp_sty exp_ty
-  = do	{ uVar outer False tv False exp_sty exp_ty
-	; return idCoercion }
-
------------------------------------
--- Skolemisation case (rule SKOL)
--- 	actual_ty:   d:Eq b => b->b
---	expected_ty: forall a. Ord a => a->a
---	co_fn e      /\a. \d2:Ord a. let d = eqFromOrd d2 in e
-
--- It is essential to do this *before* the specialisation case
--- Example:  f :: (Eq a => a->a) -> ...
---	     g :: Ord b => b->b
--- Consider  f g !
-
-tc_sub outer act_sty act_ty exp_sty exp_ty
-  | isSigmaTy exp_ty
-  = do	{ (gen_fn, co_fn) <- tcGen exp_ty act_tvs $ \ body_exp_ty ->
-			     tc_sub False act_sty act_ty body_exp_ty body_exp_ty
-	; return (gen_fn <.> co_fn) }
-  where
-    act_tvs = tyVarsOfType act_ty
-		-- It's really important to check for escape wrt the free vars of
-		-- both expected_ty *and* actual_ty
-
------------------------------------
--- Specialisation case (rule ASPEC):
---	actual_ty:   forall a. Ord a => a->a
---	expected_ty: Int -> Int
---	co_fn e =    e Int dOrdInt
-
-tc_sub outer act_sty actual_ty exp_sty expected_ty
-  | isSigmaTy actual_ty
-  = do	{ (tyvars, theta, tau) <- tcInstBoxy actual_ty
-	; dicts <- newDicts InstSigOrigin theta
-	; extendLIEs dicts
-	; let inst_fn = CoApps (CoTyApps CoHole (mkTyVarTys tyvars)) 
-			       (map instToId dicts)
-	; co_fn <- tc_sub False tau tau exp_sty expected_ty
-	; return (co_fn <.> inst_fn) }
-
------------------------------------
--- Function case (rule F1)
-tc_sub _ _ (FunTy act_arg act_res) _ (FunTy exp_arg exp_res)
-  = tc_sub_funs act_arg act_res exp_arg exp_res
-
--- Function case (rule F2)
-tc_sub outer act_sty act_ty@(FunTy act_arg act_res) exp_sty (TyVarTy exp_tv)
-  | isBoxyTyVar exp_tv
-  = do	{ cts <- readMetaTyVar exp_tv
-	; case cts of
-	    Indirect ty -> do { u_tys outer False act_sty act_ty True exp_sty ty
-			      ; return idCoercion }
-	    Flexi       -> do { [arg_ty,res_ty] <- withMetaTvs exp_tv fun_kinds mk_res_ty
- 			      ; tc_sub_funs act_arg act_res arg_ty res_ty } }
- where
-    mk_res_ty [arg_ty', res_ty'] = mkFunTy arg_ty' res_ty'
-    fun_kinds = [argTypeKind, openTypeKind]
-
--- Everything else: defer to boxy matching
-tc_sub outer act_sty actual_ty exp_sty expected_ty
-  = do	{ u_tys outer False act_sty actual_ty False exp_sty expected_ty
-	; return idCoercion }
-
-
------------------------------------
-tc_sub_funs act_arg act_res exp_arg exp_res
-  = do	{ uTys False act_arg False exp_arg
-	; co_fn_res <- tc_sub False act_res act_res exp_res exp_res
-	; wrapFunResCoercion [exp_arg] co_fn_res }
-
------------------------------------
-wrapFunResCoercion 
-	:: [TcType]	-- Type of args
-	-> ExprCoFn 	-- HsExpr a -> HsExpr b
-	-> TcM ExprCoFn	-- HsExpr (arg_tys -> a) -> HsExpr (arg_tys -> b)
-wrapFunResCoercion arg_tys co_fn_res
-  | isIdCoercion co_fn_res = return idCoercion
-  | null arg_tys	   = return co_fn_res
-  | otherwise 	       
-  = do	{ us <- newUniqueSupply
-	; let arg_ids = zipWith (mkSysLocal FSLIT("sub")) (uniqsFromSupply us) arg_tys
-	; return (CoLams arg_ids (co_fn_res <.> (CoApps CoHole arg_ids))) }
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Generalisation}
-%*									*
-%************************************************************************
-
-\begin{code}
-tcGen :: BoxySigmaType				-- expected_ty
-      -> TcTyVarSet				-- Extra tyvars that the universally
-						--	quantified tyvars of expected_ty
-						-- 	must not be unified
-      -> (BoxyRhoType -> TcM result)		-- spec_ty
-      -> TcM (ExprCoFn, result)
-	-- The expression has type: spec_ty -> expected_ty
-
-tcGen expected_ty extra_tvs thing_inside	-- We expect expected_ty to be a forall-type
-						-- If not, the call is a no-op
-  = do	{	-- We want the GenSkol info in the skolemised type variables to 
-		-- mention the *instantiated* tyvar names, so that we get a
-		-- good error message "Rigid variable 'a' is bound by (forall a. a->a)"
-		-- Hence the tiresome but innocuous fixM
-	  ((forall_tvs, theta, rho_ty), skol_info) <- fixM (\ ~(_, skol_info) ->
-		do { (forall_tvs, theta, rho_ty) <- tcInstSkolType skol_info expected_ty
-		   ; span <- getSrcSpanM
-		   ; let skol_info = GenSkol forall_tvs (mkPhiTy theta rho_ty) span
-		   ; return ((forall_tvs, theta, rho_ty), skol_info) })
-
-#ifdef DEBUG
-	; traceTc (text "tcGen" <+> vcat [text "extra_tvs" <+> ppr extra_tvs,
-				    text "expected_ty" <+> ppr expected_ty,
-				    text "inst ty" <+> ppr forall_tvs <+> ppr theta <+> ppr rho_ty,
-				    text "free_tvs" <+> ppr free_tvs,
-				    text "forall_tvs" <+> ppr forall_tvs])
-#endif
-
-	-- Type-check the arg and unify with poly type
-	; (result, lie) <- getLIE (thing_inside rho_ty)
-
-	-- Check that the "forall_tvs" havn't been constrained
-	-- The interesting bit here is that we must include the free variables
-	-- of the expected_ty.  Here's an example:
-	--	 runST (newVar True)
-	-- Here, if we don't make a check, we'll get a type (ST s (MutVar s Bool))
-	-- for (newVar True), with s fresh.  Then we unify with the runST's arg type
-	-- forall s'. ST s' a. That unifies s' with s, and a with MutVar s Bool.
-	-- So now s' isn't unconstrained because it's linked to a.
-	-- Conclusion: include the free vars of the expected_ty in the
-	-- list of "free vars" for the signature check.
-
-	; dicts <- newDicts (SigOrigin skol_info) theta
-	; inst_binds <- tcSimplifyCheck sig_msg forall_tvs dicts lie
-
-	; checkSigTyVarsWrt free_tvs forall_tvs
-	; traceTc (text "tcGen:done")
-
-	; let
-	    -- This HsLet binds any Insts which came out of the simplification.
-	    -- It's a bit out of place here, but using AbsBind involves inventing
-	    -- a couple of new names which seems worse.
-		dict_ids   = map instToId dicts
-		co_fn = CoTyLams forall_tvs $ CoLams dict_ids $ CoLet inst_binds CoHole 
-	; returnM (co_fn, result) }
-  where
-    free_tvs = tyVarsOfType expected_ty `unionVarSet` extra_tvs
-    sig_msg  = ptext SLIT("expected type of an expression")
-\end{code}    
-
-    
-
-%************************************************************************
-%*									*
-		Boxy unification
-%*									*
-%************************************************************************
-
-The exported functions are all defined as versions of some
-non-exported generic functions.
-
-\begin{code}
-boxyUnify :: BoxyType -> BoxyType -> TcM ()
--- Acutal and expected, respectively
-boxyUnify ty1 ty2 
-  = addErrCtxtM (unifyCtxt ty1 ty2) $
-    uTysOuter False ty1 False ty2
-
----------------
-boxyUnifyList :: [BoxyType] -> [BoxyType] -> TcM ()
--- Arguments should have equal length
--- Acutal and expected types
-boxyUnifyList tys1 tys2 = uList boxyUnify tys1 tys2
-
----------------
-unifyType :: TcTauType -> TcTauType -> TcM ()
--- No boxes expected inside these types
--- Acutal and expected types
-unifyType ty1 ty2 	-- ty1 expected, ty2 inferred
-  = ASSERT2( not (isBoxyTy ty1), ppr ty1 )
-    ASSERT2( not (isBoxyTy ty2), ppr ty2 )
-    addErrCtxtM (unifyCtxt ty1 ty2) $
-    uTysOuter True ty1 True ty2
-
----------------
-unifyPred :: PredType -> PredType -> TcM ()
--- Acutal and expected types
-unifyPred p1 p2 = addErrCtxtM (unifyCtxt (mkPredTy p1) (mkPredTy p2)) $
-		  uPred True True p1 True p2
-
-unifyTheta :: TcThetaType -> TcThetaType -> TcM ()
--- Acutal and expected types
-unifyTheta theta1 theta2
-  = do	{ checkTc (equalLength theta1 theta2)
-		  (ptext SLIT("Contexts differ in length"))
-	; uList unifyPred theta1 theta2 }
-
----------------
-uList :: (a -> a -> TcM ())
-       -> [a] -> [a] -> TcM ()
--- Unify corresponding elements of two lists of types, which
--- should be f equal length.  We charge down the list explicitly so that
--- we can complain if their lengths differ.
-uList unify []         []	  = return ()
-uList unify (ty1:tys1) (ty2:tys2) = do { unify ty1 ty2; uList unify tys1 tys2 }
-uList unify ty1s ty2s = panic "Unify.uList: mismatched type lists!"
-\end{code}
-
-@unifyTypeList@ takes a single list of @TauType@s and unifies them
-all together.  It is used, for example, when typechecking explicit
-lists, when all the elts should be of the same type.
-
-\begin{code}
-unifyTypeList :: [TcTauType] -> TcM ()
-unifyTypeList []		 = returnM ()
-unifyTypeList [ty]		 = returnM ()
-unifyTypeList (ty1:tys@(ty2:_)) = do { unifyType ty1 ty2
-				      ; unifyTypeList tys }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Unify-uTys]{@uTys@: getting down to business}
-%*									*
-%************************************************************************
-
-@uTys@ is the heart of the unifier.  Each arg happens twice, because
-we want to report errors in terms of synomyms if poss.  The first of
-the pair is used in error messages only; it is always the same as the
-second, except that if the first is a synonym then the second may be a
-de-synonym'd version.  This way we get better error messages.
-
-We call the first one \tr{ps_ty1}, \tr{ps_ty2} for ``possible synomym''.
-
-\begin{code}
-type NoBoxes = Bool	-- True  <=> definitely no boxes in this type
-			-- False <=> there might be boxes (always safe)
-
-type Outer = Bool	-- True <=> this is the outer level of a unification
-			--	    so that the types being unified are the
-			--	    very ones we began with, not some sub
-			--	    component or synonym expansion
--- The idea is that if Outer is true then unifyMisMatch should
--- pop the context to remove the "Expected/Acutal" context
-
-uTysOuter, uTys
-     :: NoBoxes -> TcType	-- ty1 is the *expected* type
-     -> NoBoxes -> TcType	-- ty2 is the *actual* type
-     -> TcM ()
-uTysOuter nb1 ty1 nb2 ty2 = u_tys True nb1 ty1 ty1 nb2 ty2 ty2
-uTys      nb1 ty1 nb2 ty2 = u_tys False nb1 ty1 ty1 nb2 ty2 ty2
-
-
---------------
-uTys_s :: NoBoxes -> [TcType]	-- ty1 is the *actual* types
-       -> NoBoxes -> [TcType]	-- ty2 is the *expected* types
-       -> TcM ()
-uTys_s nb1 []	 	nb2 []	       = returnM ()
-uTys_s nb1 (ty1:tys1) nb2 (ty2:tys2) = do { uTys nb1 ty1 nb2 ty2
-					  ; uTys_s nb1 tys1 nb2 tys2 }
-uTys_s nb1 ty1s nb2 ty2s = panic "Unify.uTys_s: mismatched type lists!"
-
---------------
-u_tys :: Outer
-      -> NoBoxes -> TcType -> TcType	-- ty1 is the *actual* type
-      -> NoBoxes -> TcType -> TcType	-- ty2 is the *expected* type
-      -> TcM ()
-
-u_tys outer nb1 orig_ty1 ty1 nb2 orig_ty2 ty2
-  = go outer ty1 ty2
-  where 
-
-	-- Always expand synonyms (see notes at end)
-        -- (this also throws away FTVs)
-    go outer ty1 ty2 
-      | Just ty1' <- tcView ty1 = go False ty1' ty2
-      | Just ty2' <- tcView ty2 = go False ty1 ty2'
-
-	-- Variables; go for uVar
-    go outer (TyVarTy tyvar1) ty2 = uVar outer False tyvar1 nb2 orig_ty2 ty2
-    go outer ty1 (TyVarTy tyvar2) = uVar outer True  tyvar2 nb1 orig_ty1 ty1
-				-- "True" means args swapped
-	-- Predicates
-    go outer (PredTy p1) (PredTy p2) = uPred outer nb1 p1 nb2 p2
-
-	-- Type constructors must match
-    go _ (TyConApp con1 tys1) (TyConApp con2 tys2)
-      | con1 == con2 = uTys_s nb1 tys1 nb2 tys2
-	-- See Note [TyCon app]
-
-	-- Functions; just check the two parts
-    go _ (FunTy fun1 arg1) (FunTy fun2 arg2)
-      = do { uTys nb1 fun1 nb2 fun2
-	   ; uTys nb1 arg1 nb2 arg2 }
-
-	-- Applications need a bit of care!
-	-- They can match FunTy and TyConApp, so use splitAppTy_maybe
-	-- NB: we've already dealt with type variables and Notes,
-	-- so if one type is an App the other one jolly well better be too
-    go outer (AppTy s1 t1) ty2
-      | Just (s2,t2) <- tcSplitAppTy_maybe ty2
-      = do { uTys nb1 s1 nb2 s2; uTys nb1 t1 nb2 t2 }
-
-	-- Now the same, but the other way round
-	-- Don't swap the types, because the error messages get worse
-    go outer ty1 (AppTy s2 t2)
-      | Just (s1,t1) <- tcSplitAppTy_maybe ty1
-      = do { uTys nb1 s1 nb2 s2; uTys nb1 t1 nb2 t2 }
-
-    go _ ty1@(ForAllTy _ _) ty2@(ForAllTy _ _)
-      | length tvs1 == length tvs2
-      = do   { tvs <- tcInstSkolTyVars UnkSkol tvs1	-- Not a helpful SkolemInfo
-	     ; let tys      = mkTyVarTys tvs
-	           in_scope = mkInScopeSet (mkVarSet tvs)
- 	           subst1   = mkTvSubst in_scope (zipTyEnv tvs1 tys)
-	           subst2   = mkTvSubst in_scope (zipTyEnv tvs2 tys)
-	     ; uTys nb1 (substTy subst1 body1) nb2 (substTy subst2 body2)
-
-		-- If both sides are inside a box, we should not have
-		-- a polytype at all.  This check comes last, because
-		-- the error message is extremely unhelpful.
-	     ; ifM (nb1 && nb2) (notMonoType ty1)
-	     }
-      where
-	(tvs1, body1) = tcSplitForAllTys ty1
-	(tvs2, body2) = tcSplitForAllTys ty2
-
-	-- Anything else fails
-    go outer _ _ = unifyMisMatch outer False orig_ty1 orig_ty2
-
-----------
-uPred outer nb1 (IParam n1 t1) nb2 (IParam n2 t2)
-  | n1 == n2 = uTys nb1 t1 nb2 t2
-uPred outer nb1 (ClassP c1 tys1) nb2 (ClassP c2 tys2)
-  | c1 == c2 = uTys_s nb1 tys1 nb2 tys2		-- Guaranteed equal lengths because the kinds check
-uPred outer _ p1 _ p2 = unifyMisMatch outer False (mkPredTy p1) (mkPredTy p2)
-\end{code}
-
-Note [Tycon app]
-~~~~~~~~~~~~~~~~
-When we find two TyConApps, the argument lists are guaranteed equal
-length.  Reason: intially the kinds of the two types to be unified is
-the same. The only way it can become not the same is when unifying two
-AppTys (f1 a1):=:(f2 a2).  In that case there can't be a TyConApp in
-the f1,f2 (because it'd absorb the app).  If we unify f1:=:f2 first,
-which we do, that ensures that f1,f2 have the same kind; and that
-means a1,a2 have the same kind.  And now the argument repeats.
-
-
-Notes on synonyms
-~~~~~~~~~~~~~~~~~
-If you are tempted to make a short cut on synonyms, as in this
-pseudocode...
-
-\begin{verbatim}
--- NO	uTys (SynTy con1 args1 ty1) (SynTy con2 args2 ty2)
--- NO     = if (con1 == con2) then
--- NO	-- Good news!  Same synonym constructors, so we can shortcut
--- NO	-- by unifying their arguments and ignoring their expansions.
--- NO	unifyTypepeLists args1 args2
--- NO    else
--- NO	-- Never mind.  Just expand them and try again
--- NO	uTys ty1 ty2
-\end{verbatim}
-
-then THINK AGAIN.  Here is the whole story, as detected and reported
-by Chris Okasaki \tr{<Chris_Okasaki@loch.mess.cs.cmu.edu>}:
-\begin{quotation}
-Here's a test program that should detect the problem:
-
-\begin{verbatim}
-	type Bogus a = Int
-	x = (1 :: Bogus Char) :: Bogus Bool
-\end{verbatim}
-
-The problem with [the attempted shortcut code] is that
-\begin{verbatim}
-	con1 == con2
-\end{verbatim}
-is not a sufficient condition to be able to use the shortcut!
-You also need to know that the type synonym actually USES all
-its arguments.  For example, consider the following type synonym
-which does not use all its arguments.
-\begin{verbatim}
-	type Bogus a = Int
-\end{verbatim}
-
-If you ever tried unifying, say, \tr{Bogus Char} with \tr{Bogus Bool},
-the unifier would blithely try to unify \tr{Char} with \tr{Bool} and
-would fail, even though the expanded forms (both \tr{Int}) should
-match.
-
-Similarly, unifying \tr{Bogus Char} with \tr{Bogus t} would
-unnecessarily bind \tr{t} to \tr{Char}.
-
-... You could explicitly test for the problem synonyms and mark them
-somehow as needing expansion, perhaps also issuing a warning to the
-user.
-\end{quotation}
-
-
-%************************************************************************
-%*									*
-\subsection[Unify-uVar]{@uVar@: unifying with a type variable}
-%*									*
-%************************************************************************
-
-@uVar@ is called when at least one of the types being unified is a
-variable.  It does {\em not} assume that the variable is a fixed point
-of the substitution; rather, notice that @uVar@ (defined below) nips
-back into @uTys@ if it turns out that the variable is already bound.
-
-\begin{code}
-uVar :: Outer
-     -> Bool		-- False => tyvar is the "expected"
-			-- True  => ty    is the "expected" thing
-     -> TcTyVar
-     -> NoBoxes		-- True <=> definitely no boxes in t2
-     -> TcTauType -> TcTauType	-- printing and real versions
-     -> TcM ()
-
-uVar outer swapped tv1 nb2 ps_ty2 ty2
-  = do 	{ let expansion | showSDoc (ppr ty2) == showSDoc (ppr ps_ty2) = empty
-			| otherwise = brackets (equals <+> ppr ty2)
-	; traceTc (text "uVar" <+> ppr swapped <+> 
-			sep [ppr tv1 <+> dcolon <+> ppr (tyVarKind tv1 ),
-				nest 2 (ptext SLIT(" :=: ")),
-			     ppr ps_ty2 <+> dcolon <+> ppr (typeKind ty2) <+> expansion])
-	; details <- lookupTcTyVar tv1
-	; case details of
-	    IndirectTv ty1 
-		| swapped   -> u_tys outer nb2  ps_ty2 ty2 True ty1    ty1	-- Swap back
-		| otherwise -> u_tys outer True ty1    ty1 nb2  ps_ty2 ty2	-- Same order
-			-- The 'True' here says that ty1 
-			-- is definitely box-free
-	    DoneTv details1 -> uUnfilledVar outer swapped tv1 details1 nb2 ps_ty2 ty2
-	}
-
-----------------
-uUnfilledVar :: Outer
-	     -> Bool 				-- Args are swapped
-     	     -> TcTyVar -> TcTyVarDetails		-- Tyvar 1
-     	     -> NoBoxes -> TcTauType -> TcTauType	-- Type 2
-     	     -> TcM ()
--- Invariant: tyvar 1 is not unified with anything
-
-uUnfilledVar outer swapped tv1 details1 nb2 ps_ty2 ty2
-  | Just ty2' <- tcView ty2
-  = 	-- Expand synonyms; ignore FTVs
-    uUnfilledVar False swapped tv1 details1 nb2 ps_ty2 ty2'
-
-uUnfilledVar outer swapped tv1 details1 nb2 ps_ty2 ty2@(TyVarTy tv2)
-	-- Same type variable => no-op
-  | tv1 == tv2
-  = returnM ()
-
-	-- Distinct type variables
-  | otherwise
-  = do	{ lookup2 <- lookupTcTyVar tv2
-	; case lookup2 of
-	    IndirectTv ty2' -> uUnfilledVar  outer swapped tv1 details1 True ty2' ty2'
-	    DoneTv details2 -> uUnfilledVars outer swapped tv1 details1 tv2 details2
-	}
-
-uUnfilledVar outer swapped tv1 details1 nb2 ps_ty2 non_var_ty2	-- ty2 is not a type variable
-  = case details1 of
-	MetaTv (SigTv _) ref1 -> mis_match	-- Can't update a skolem with a non-type-variable
-	MetaTv info ref1      -> uMetaVar swapped tv1 info ref1 nb2 ps_ty2 non_var_ty2
-	skolem_details        -> mis_match
-  where
-    mis_match = unifyMisMatch outer swapped (TyVarTy tv1) ps_ty2
-
-----------------
-uMetaVar :: Bool
-	 -> TcTyVar -> BoxInfo -> IORef MetaDetails
-	 -> NoBoxes -> TcType -> TcType
-	 -> TcM ()
--- tv1 is an un-filled-in meta type variable (maybe boxy, maybe tau)
--- ty2 is not a type variable
-
-uMetaVar swapped tv1 info1 ref1 nb2 ps_ty2 non_var_ty2
-  = do	{ final_ty <- case info1 of
-			BoxTv -> unBox ps_ty2			-- No occurs check
-			other -> checkTauTvUpdate tv1 ps_ty2	-- Occurs check + monotype check
-	; checkUpdateMeta swapped tv1 ref1 final_ty }
-
-----------------
-uUnfilledVars :: Outer
-	      -> Bool 			-- Args are swapped
-      	      -> TcTyVar -> TcTyVarDetails	-- Tyvar 1
-      	      -> TcTyVar -> TcTyVarDetails	-- Tyvar 2
-      	      -> TcM ()
--- Invarant: The type variables are distinct, 
--- 	     Neither is filled in yet
---    	     They might be boxy or not
-
-uUnfilledVars outer swapped tv1 (SkolemTv _) tv2 (SkolemTv _)
-  = unifyMisMatch outer swapped (mkTyVarTy tv1) (mkTyVarTy tv2)
-
-uUnfilledVars outer swapped tv1 (MetaTv info1 ref1) tv2 (SkolemTv _)
-  = checkUpdateMeta swapped tv1 ref1 (mkTyVarTy tv2)
-uUnfilledVars outer swapped tv1 (SkolemTv _) tv2 (MetaTv info2 ref2)
-  = checkUpdateMeta (not swapped) tv2 ref2 (mkTyVarTy tv1)
-
--- ToDo: this function seems too long for what it acutally does!
-uUnfilledVars outer swapped tv1 (MetaTv info1 ref1) tv2 (MetaTv info2 ref2)
-  = case (info1, info2) of
-	(BoxTv,   BoxTv)   -> box_meets_box
-
-	-- If a box meets a TauTv, but the fomer has the smaller kind
-	-- then we must create a fresh TauTv with the smaller kind
-	(_,       BoxTv)   | k1_sub_k2 -> update_tv2
-			   | otherwise -> box_meets_box
-	(BoxTv,   _    )   | k2_sub_k1 -> update_tv1
-			   | otherwise -> box_meets_box
-
-	-- Avoid SigTvs if poss
-	(SigTv _, _      ) | k1_sub_k2 -> update_tv2
-	(_,       SigTv _) | k2_sub_k1 -> update_tv1
-
-	(_,   _) | k1_sub_k2 -> if k2_sub_k1 && nicer_to_update_tv1
-				then update_tv1 	-- Same kinds
-				else update_tv2
-		 | k2_sub_k1 -> update_tv1
-		 | otherwise -> kind_err 
-
-	-- Update the variable with least kind info
-	-- See notes on type inference in Kind.lhs
-	-- The "nicer to" part only applies if the two kinds are the same,
-	-- so we can choose which to do.
-  where
-	-- Kinds should be guaranteed ok at this point
-    update_tv1 = updateMeta tv1 ref1 (mkTyVarTy tv2)
-    update_tv2 = updateMeta tv2 ref2 (mkTyVarTy tv1)
-
-    box_meets_box | k1_sub_k2 = fill_with k1
-		  | k2_sub_k1 = fill_with k2
-		  | otherwise = kind_err
-
-    fill_with kind = do { tau_ty <- newFlexiTyVarTy kind
-		        ; updateMeta tv1 ref1 tau_ty
-		        ; updateMeta tv2 ref2 tau_ty }
-
-    kind_err = addErrCtxtM (unifyKindCtxt swapped tv1 (mkTyVarTy tv2))	$
-	       unifyKindMisMatch k1 k2
-
-    k1 = tyVarKind tv1
-    k2 = tyVarKind tv2
-    k1_sub_k2 = k1 `isSubKind` k2
-    k2_sub_k1 = k2 `isSubKind` k1
-
-    nicer_to_update_tv1 = isSystemName (varName tv1)
-	-- Try to update sys-y type variables in preference to ones
-	-- gotten (say) by instantiating a polymorphic function with
-	-- a user-written type sig
-	
-----------------
-checkUpdateMeta :: Bool -> TcTyVar -> IORef MetaDetails -> TcType -> TcM ()
--- Update tv1, which is flexi; occurs check is alrady done
--- The 'check' version does a kind check too
--- We do a sub-kind check here: we might unify (a b) with (c d) 
---	where b::*->* and d::*; this should fail
-
-checkUpdateMeta swapped tv1 ref1 ty2
-  = do	{ checkKinds swapped tv1 ty2
-	; updateMeta tv1 ref1 ty2 }
-
-updateMeta :: TcTyVar -> IORef MetaDetails -> TcType -> TcM ()
-updateMeta tv1 ref1 ty2
-  = ASSERT( isMetaTyVar tv1 )
-    ASSERT( isBoxyTyVar tv1 || isTauTy ty2 )
-    do	{ ASSERTM2( do { details <- readMetaTyVar tv1; return (isFlexi details) }, ppr tv1 )
-	; traceTc (text "updateMeta" <+> ppr tv1 <+> text ":=" <+> ppr ty2)
-	; writeMutVar ref1 (Indirect ty2) }
-
-----------------
-checkKinds swapped tv1 ty2
--- We're about to unify a type variable tv1 with a non-tyvar-type ty2.
--- ty2 has been zonked at this stage, which ensures that
--- its kind has as much boxity information visible as possible.
-  | tk2 `isSubKind` tk1 = returnM ()
-
-  | otherwise
-	-- Either the kinds aren't compatible
-	--	(can happen if we unify (a b) with (c d))
-	-- or we are unifying a lifted type variable with an
-	-- 	unlifted type: e.g.  (id 3#) is illegal
-  = addErrCtxtM (unifyKindCtxt swapped tv1 ty2)	$
-    unifyKindMisMatch k1 k2
-  where
-    (k1,k2) | swapped   = (tk2,tk1)
-	    | otherwise = (tk1,tk2)
-    tk1 = tyVarKind tv1
-    tk2 = typeKind ty2
-
-----------------
-checkTauTvUpdate :: TcTyVar -> TcType -> TcM TcType
---    (checkTauTvUpdate tv ty)
--- We are about to update the TauTv tv with ty.
--- Check (a) that tv doesn't occur in ty (occurs check)
---	 (b) that ty is a monotype
--- Furthermore, in the interest of (b), if you find an
--- empty box (BoxTv that is Flexi), fill it in with a TauTv
--- 
--- Returns the (non-boxy) type to update the type variable with, or fails
-
-checkTauTvUpdate orig_tv orig_ty
-  = go orig_ty
-  where
-    go (TyConApp tc tys)
-	| isSynTyCon tc  = go_syn tc tys
-	| otherwise	 = do { tys' <- mappM go tys; return (TyConApp tc tys') }
-    go (NoteTy _ ty2) 	 = go ty2	-- Discard free-tyvar annotations
-    go (PredTy p)	 = do { p' <- go_pred p; return (PredTy p') }
-    go (FunTy arg res)   = do { arg' <- go arg; res' <- go res; return (FunTy arg' res') }
-    go (AppTy fun arg)	 = do { fun' <- go fun; arg' <- go arg; return (mkAppTy fun' arg') }
-		-- NB the mkAppTy; we might have instantiated a
-		-- type variable to a type constructor, so we need
-		-- to pull the TyConApp to the top.
-    go (ForAllTy tv ty) = notMonoType orig_ty		-- (b)
-
-    go (TyVarTy tv)
-	| orig_tv == tv = occurCheck tv orig_ty		-- (a)
-	| isTcTyVar tv  = go_tyvar tv (tcTyVarDetails tv)
-	| otherwise     = return (TyVarTy tv)
-		 -- Ordinary (non Tc) tyvars
-		 -- occur inside quantified types
-
-    go_pred (ClassP c tys) = do { tys' <- mapM go tys; return (ClassP c tys') }
-    go_pred (IParam n ty)  = do { ty' <- go ty;        return (IParam n ty') }
-
-    go_tyvar tv (SkolemTv _) = return (TyVarTy tv)
-    go_tyvar tv (MetaTv box ref)
-	= do { cts <- readMutVar ref
-	     ; case cts of
-		  Indirect ty -> go ty 
-		  Flexi -> case box of
-				BoxTv -> do { tau <- newFlexiTyVarTy (tyVarKind tv)
-				   	    ; writeMutVar ref (Indirect tau)
-					    ; return tau }
-				other -> return (TyVarTy tv)
-	     }
-
-	-- go_syn is called for synonyms only
-	-- See Note [Type synonyms and the occur check]
-    go_syn tc tys
-	| not (isTauTyCon tc)
-	= notMonoType orig_ty	-- (b) again
-	| otherwise
-	= do { (msgs, mb_tys') <- tryTc (mapM go tys)
-	     ; case mb_tys' of
-		Just tys' -> return (TyConApp tc tys')
-				-- Retain the synonym (the common case)
-		Nothing   -> go (expectJust "checkTauTvUpdate" 
-					(tcView (TyConApp tc tys)))
-				-- Try again, expanding the synonym
-	     }
-\end{code}
-
-Note [Type synonyms and the occur check]
-~~~~~~~~~~~~~~~~~~~~
-Basically we want to update     tv1 := ps_ty2
-because ps_ty2 has type-synonym info, which improves later error messages
-
-But consider 
-	type A a = ()
-
-	f :: (A a -> a -> ()) -> ()
-	f = \ _ -> ()
-
-	x :: ()
-	x = f (\ x p -> p x)
-
-In the application (p x), we try to match "t" with "A t".  If we go
-ahead and bind t to A t (= ps_ty2), we'll lead the type checker into 
-an infinite loop later.
-But we should not reject the program, because A t = ().
-Rather, we should bind t to () (= non_var_ty2).
-
-\begin{code}
-stripBoxyType :: BoxyType -> TcM TcType
--- Strip all boxes from the input type, returning a non-boxy type.
--- It's fine for there to be a polytype inside a box (c.f. unBox)
--- All of the boxes should have been filled in by now; 
--- hence we return a TcType
-stripBoxyType ty = zonkType strip_tv ty
-  where
-    strip_tv tv = ASSERT( not (isBoxyTyVar tv) ) return (TyVarTy tv)
-	-- strip_tv will be called for *Flexi* meta-tyvars
-	-- There should not be any Boxy ones; hence the ASSERT
-
-zapToMonotype :: BoxySigmaType -> TcM TcTauType
--- Subtle... we must zap the boxy res_ty
--- to kind * before using it to instantiate a LitInst
--- Calling unBox instead doesn't do the job, because the box
--- often has an openTypeKind, and we don't want to instantiate
--- with that type.
-zapToMonotype res_ty
-  = do 	{ res_tau <- newFlexiTyVarTy liftedTypeKind
-	; boxyUnify res_tau res_ty
-	; return res_tau }
-
-unBox :: BoxyType -> TcM TcType
--- unBox implements the judgement 
---	|- s' ~ box(s)
--- with input s', and result s
--- 
--- It remove all boxes from the input type, returning a non-boxy type.
--- A filled box in the type can only contain a monotype; unBox fails if not
--- The type can have empty boxes, which unBox fills with a monotype
---
--- Compare this wth checkTauTvUpdate
---
--- For once, it's safe to treat synonyms as opaque!
-
-unBox (NoteTy n ty) 	= do { ty' <- unBox ty; return (NoteTy n ty') }
-unBox (TyConApp tc tys) = do { tys' <- mapM unBox tys; return (TyConApp tc tys') }
-unBox (AppTy f a)       = do { f' <- unBox f; a' <- unBox a; return (mkAppTy f' a') }
-unBox (FunTy f a)       = do { f' <- unBox f; a' <- unBox a; return (FunTy f' a') }
-unBox (PredTy p)	= do { p' <- unBoxPred p; return (PredTy p') }
-unBox (ForAllTy tv ty)  = ASSERT( isImmutableTyVar tv )
-			  do { ty' <- unBox ty; return (ForAllTy tv ty') }
-unBox (TyVarTy tv)
-  | isTcTyVar tv				-- It's a boxy type variable
-  , MetaTv BoxTv ref <- tcTyVarDetails tv	-- NB: non-TcTyVars are possible
-  = do	{ cts <- readMutVar ref			--     under nested quantifiers
-	; case cts of
-	    Indirect ty -> do { non_boxy_ty <- unBox ty
-			      ; if isTauTy non_boxy_ty 
-				then return non_boxy_ty
-				else notMonoType non_boxy_ty }
-	    Flexi -> do { tau <- newFlexiTyVarTy (tyVarKind tv)
-			; writeMutVar ref (Indirect tau)
-			; return tau }
-	}
-  | otherwise 	-- Skolems, and meta-tau-variables
-  = return (TyVarTy tv)
-
-unBoxPred (ClassP cls tys) = do { tys' <- mapM unBox tys; return (ClassP cls tys') }
-unBoxPred (IParam ip ty)   = do { ty' <- unBox ty; return (IParam ip ty') }
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection[Unify-context]{Errors and contexts}
-%*									*
-%************************************************************************
-
-Errors
-~~~~~~
-
-\begin{code}
-unifyCtxt act_ty exp_ty tidy_env
-  = do	{ act_ty' <- zonkTcType act_ty
-	; exp_ty' <- zonkTcType exp_ty
-	; let (env1, exp_ty'') = tidyOpenType tidy_env exp_ty'
-	      (env2, act_ty'') = tidyOpenType env1     act_ty'
-	; return (env2, mkExpectedActualMsg act_ty'' exp_ty'') }
-
-----------------
-mkExpectedActualMsg act_ty exp_ty
-  = nest 2 (vcat [ text "Expected type" <> colon <+> ppr exp_ty,
-		   text "Inferred type" <> colon <+> ppr act_ty ])
-
-----------------
--- If an error happens we try to figure out whether the function
--- function has been given too many or too few arguments, and say so.
-checkFunResCtxt fun actual_res_ty expected_res_ty tidy_env
-  = do	{ exp_ty' <- zonkTcType expected_res_ty
-	; act_ty' <- zonkTcType actual_res_ty
-	; let
-	      (env1, exp_ty'') = tidyOpenType tidy_env exp_ty'
-	      (env2, act_ty'') = tidyOpenType env1     act_ty'
-	      (exp_args, _)    = tcSplitFunTys exp_ty''
-	      (act_args, _)    = tcSplitFunTys act_ty''
-	
-	      len_act_args     = length act_args
-	      len_exp_args     = length exp_args
-
-	      message | len_exp_args < len_act_args = wrongArgsCtxt "too few"  fun
-	              | len_exp_args > len_act_args = wrongArgsCtxt "too many" fun
-		      | otherwise		    = mkExpectedActualMsg act_ty'' exp_ty''
-	; return (env2, message) }
-
-  where
-    wrongArgsCtxt too_many_or_few fun
-      = ptext SLIT("Probable cause:") <+> quotes (ppr fun)
-	<+> ptext SLIT("is applied to") <+> text too_many_or_few 
-	<+> ptext SLIT("arguments")
-
-------------------
-unifyKindCtxt swapped tv1 ty2 tidy_env	-- not swapped => tv1 expected, ty2 inferred
-	-- tv1 and ty2 are zonked already
-  = returnM msg
-  where
-    msg = (env2, ptext SLIT("When matching the kinds of") <+> 
-		 sep [quotes pp_expected <+> ptext SLIT("and"), quotes pp_actual])
-
-    (pp_expected, pp_actual) | swapped   = (pp2, pp1)
-		             | otherwise = (pp1, pp2)
-    (env1, tv1') = tidyOpenTyVar tidy_env tv1
-    (env2, ty2') = tidyOpenType  env1 ty2
-    pp1 = ppr tv1' <+> dcolon <+> ppr (tyVarKind tv1)
-    pp2 = ppr ty2' <+> dcolon <+> ppr (typeKind ty2)
-
-unifyMisMatch outer swapped ty1 ty2
-  = do	{ (env, msg) <- if swapped then misMatchMsg ty1 ty2
-				   else misMatchMsg ty2 ty1
-
-	-- This is the whole point of the 'outer' stuff
-	; if outer then popErrCtxt (failWithTcM (env, msg))
-	  	   else failWithTcM (env, msg)
-	} 
-
-misMatchMsg ty1 ty2
-  = do	{ env0 <- tcInitTidyEnv
-	; (env1, pp1, extra1) <- ppr_ty env0 ty1
-	; (env2, pp2, extra2) <- ppr_ty env1 ty2
-	; return (env2, sep [sep [ptext SLIT("Couldn't match expected type") <+> pp1, 
-				  nest 7 (ptext SLIT("against inferred type") <+> pp2)],
-			     nest 2 extra1, nest 2 extra2]) }
-
-ppr_ty :: TidyEnv -> TcType -> TcM (TidyEnv, SDoc, SDoc)
-ppr_ty env ty
-  = do { ty' <- zonkTcType ty
-       ; let (env1,tidy_ty) = tidyOpenType env ty'
-	     simple_result  = (env1, quotes (ppr tidy_ty), empty)
-       ; case tidy_ty of
-	   TyVarTy tv 
-		| isSkolemTyVar tv -> return (env2, pp_rigid tv',
-					      pprSkolTvBinding tv')
-		| otherwise -> return simple_result
-		where
-		  (env2, tv') = tidySkolemTyVar env1 tv
-	   other -> return simple_result }
-  where
-    pp_rigid tv = quotes (ppr tv) <+> parens (ptext SLIT("a rigid variable"))
-
-
-notMonoType ty
-  = do	{ ty' <- zonkTcType ty
-	; env0 <- tcInitTidyEnv
-	; let (env1, tidy_ty) = tidyOpenType env0 ty'
-	      msg = ptext SLIT("Cannot match a monotype with") <+> ppr tidy_ty
-	; failWithTcM (env1, msg) }
-
-occurCheck tyvar ty
-  = do	{ env0 <- tcInitTidyEnv
-	; ty'  <- zonkTcType ty
-	; let (env1, tidy_tyvar) = tidyOpenTyVar env0 tyvar
-	      (env2, tidy_ty)    = tidyOpenType  env1 ty'
-	      extra = sep [ppr tidy_tyvar, char '=', ppr tidy_ty]
-	; failWithTcM (env2, hang msg 2 extra) }
-  where
-    msg = ptext SLIT("Occurs check: cannot construct the infinite type:")
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Kind unification
-%*									*
-%************************************************************************
-
-Unifying kinds is much, much simpler than unifying types.
-
-\begin{code}
-unifyKind :: TcKind		    -- Expected
-	  -> TcKind		    -- Actual
-	  -> TcM ()
-unifyKind LiftedTypeKind   LiftedTypeKind   = returnM ()
-unifyKind UnliftedTypeKind UnliftedTypeKind = returnM ()
-
-unifyKind OpenTypeKind k2 | isOpenTypeKind k2 = returnM ()
-unifyKind ArgTypeKind  k2 | isArgTypeKind k2    = returnM ()
-  -- Respect sub-kinding
-
-unifyKind (FunKind a1 r1) (FunKind a2 r2)
- = do { unifyKind a2 a1; unifyKind r1 r2 }
-		-- Notice the flip in the argument,
-		-- so that the sub-kinding works right
-
-unifyKind (KindVar kv1) k2 = uKVar False kv1 k2
-unifyKind k1 (KindVar kv2) = uKVar True kv2 k1
-unifyKind k1 k2 = unifyKindMisMatch k1 k2
-
-unifyKinds :: [TcKind] -> [TcKind] -> TcM ()
-unifyKinds []       []       = returnM ()
-unifyKinds (k1:ks1) (k2:ks2) = unifyKind k1 k2 	`thenM_`
-			       unifyKinds ks1 ks2
-unifyKinds _ _ 		     = panic "unifyKinds: length mis-match"
-
-----------------
-uKVar :: Bool -> KindVar -> TcKind -> TcM ()
-uKVar swapped kv1 k2
-  = do 	{ mb_k1 <- readKindVar kv1
-	; case mb_k1 of
-	    Nothing -> uUnboundKVar swapped kv1 k2
-	    Just k1 | swapped   -> unifyKind k2 k1
-		    | otherwise -> unifyKind k1 k2 }
-
-----------------
-uUnboundKVar :: Bool -> KindVar -> TcKind -> TcM ()
-uUnboundKVar swapped kv1 k2@(KindVar kv2)
-  | kv1 == kv2 = returnM ()
-  | otherwise	-- Distinct kind variables
-  = do	{ mb_k2 <- readKindVar kv2
-	; case mb_k2 of
-	    Just k2 -> uUnboundKVar swapped kv1 k2
-	    Nothing -> writeKindVar kv1 k2 }
-
-uUnboundKVar swapped kv1 non_var_k2
-  = do	{ k2' <- zonkTcKind non_var_k2
-	; kindOccurCheck kv1 k2'
-	; k2'' <- kindSimpleKind swapped k2'
-		-- KindVars must be bound only to simple kinds
-		-- Polarities: (kindSimpleKind True ?) succeeds 
-		-- returning *, corresponding to unifying
-		--	expected: ?
-		--	actual:   kind-ver
-	; writeKindVar kv1 k2'' }
-
-----------------
-kindOccurCheck kv1 k2	-- k2 is zonked
-  = checkTc (not_in k2) (kindOccurCheckErr kv1 k2)
-  where
-    not_in (KindVar kv2)   = kv1 /= kv2
-    not_in (FunKind a2 r2) = not_in a2 && not_in r2
-    not_in other	   = True
-
-kindSimpleKind :: Bool -> Kind -> TcM SimpleKind
--- (kindSimpleKind True k) returns a simple kind sk such that sk <: k
--- If the flag is False, it requires k <: sk
--- E.g. 	kindSimpleKind False ?? = *
--- What about (kv -> *) :=: ?? -> *
-kindSimpleKind orig_swapped orig_kind
-  = go orig_swapped orig_kind
-  where
-    go sw (FunKind k1 k2) = do { k1' <- go (not sw) k1
-			       ; k2' <- go sw k2
-			       ; return (FunKind k1' k2') }
-    go True OpenTypeKind = return liftedTypeKind
-    go True ArgTypeKind  = return liftedTypeKind
-    go sw LiftedTypeKind  = return liftedTypeKind
-    go sw k@(KindVar _)	  = return k	-- KindVars are always simple
-    go swapped kind = failWithTc (ptext SLIT("Unexpected kind unification failure:")
-				  <+> ppr orig_swapped <+> ppr orig_kind)
-	-- I think this can't actually happen
-
--- T v = MkT v		 v must be a type 
--- T v w = MkT (v -> w)	 v must not be an umboxed tuple
-
-----------------
-kindOccurCheckErr tyvar ty
-  = hang (ptext SLIT("Occurs check: cannot construct the infinite kind:"))
-       2 (sep [ppr tyvar, char '=', ppr ty])
-
-unifyKindMisMatch ty1 ty2
-  = zonkTcKind ty1	`thenM` \ ty1' ->
-    zonkTcKind ty2	`thenM` \ ty2' ->
-    let
-	msg = hang (ptext SLIT("Couldn't match kind"))
-		   2 (sep [quotes (ppr ty1'), 
-			   ptext SLIT("against"), 
-			   quotes (ppr ty2')])
-    in
-    failWithTc msg
-\end{code}
-
-\begin{code}
-unifyFunKind :: TcKind -> TcM (Maybe (TcKind, TcKind))
--- Like unifyFunTy, but does not fail; instead just returns Nothing
-
-unifyFunKind (KindVar kvar)
-  = readKindVar kvar	`thenM` \ maybe_kind ->
-    case maybe_kind of
-	Just fun_kind -> unifyFunKind fun_kind
-	Nothing       -> do { arg_kind <- newKindVar
-			    ; res_kind <- newKindVar
-			    ; writeKindVar kvar (mkArrowKind arg_kind res_kind)
-			    ; returnM (Just (arg_kind,res_kind)) }
-    
-unifyFunKind (FunKind arg_kind res_kind) = returnM (Just (arg_kind,res_kind))
-unifyFunKind other	   	         = returnM Nothing
-\end{code}
-
-%************************************************************************
-%*									*
-	Checking kinds
-%*									*
-%************************************************************************
-
----------------------------
--- We would like to get a decent error message from
---   (a) Under-applied type constructors
---		f :: (Maybe, Maybe)
---   (b) Over-applied type constructors
---		f :: Int x -> Int x
---
-
-\begin{code}
-checkExpectedKind :: Outputable a => a -> TcKind -> TcKind -> TcM ()
--- A fancy wrapper for 'unifyKind', which tries 
--- to give decent error messages.
-checkExpectedKind ty act_kind exp_kind
-  | act_kind `isSubKind` exp_kind -- Short cut for a very common case
-  = returnM ()
-  | otherwise
-  = tryTc (unifyKind exp_kind act_kind)	`thenM` \ (_errs, mb_r) ->
-    case mb_r of {
-	Just r  -> returnM () ;	-- Unification succeeded
-	Nothing ->
-
-	-- So there's definitely an error
-	-- Now to find out what sort
-    zonkTcKind exp_kind		`thenM` \ exp_kind ->
-    zonkTcKind act_kind		`thenM` \ act_kind ->
-
-    tcInitTidyEnv		`thenM` \ env0 -> 
-    let (exp_as, _) = splitKindFunTys exp_kind
-        (act_as, _) = splitKindFunTys act_kind
-	n_exp_as = length exp_as
-	n_act_as = length act_as
-	
-	(env1, tidy_exp_kind) = tidyKind env0 exp_kind
-	(env2, tidy_act_kind) = tidyKind env1 act_kind
-
-	err | n_exp_as < n_act_as	-- E.g. [Maybe]
-	    = quotes (ppr ty) <+> ptext SLIT("is not applied to enough type arguments")
-
-		-- Now n_exp_as >= n_act_as. In the next two cases, 
-		-- n_exp_as == 0, and hence so is n_act_as
-	    | isLiftedTypeKind exp_kind && isUnliftedTypeKind act_kind
-	    = ptext SLIT("Expecting a lifted type, but") <+> quotes (ppr ty)
-		<+> ptext SLIT("is unlifted")
-
-	    | isUnliftedTypeKind exp_kind && isLiftedTypeKind act_kind
-	    = ptext SLIT("Expecting an unlifted type, but") <+> quotes (ppr ty)
-		<+> ptext SLIT("is lifted")
-
-	    | otherwise 		-- E.g. Monad [Int]
-	    = ptext SLIT("Kind mis-match")
-
-	more_info = sep [ ptext SLIT("Expected kind") <+> 
-				quotes (pprKind tidy_exp_kind) <> comma,
-		   	  ptext SLIT("but") <+> quotes (ppr ty) <+> 
-			  	ptext SLIT("has kind") <+> quotes (pprKind tidy_act_kind)]
-   in
-   failWithTcM (env2, err $$ more_info)
-   }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Checking signature type variables}
-%*									*
-%************************************************************************
-
-@checkSigTyVars@ checks that a set of universally quantified type varaibles
-are not mentioned in the environment.  In particular:
-
-	(a) Not mentioned in the type of a variable in the envt
-		eg the signature for f in this:
-
-			g x = ... where
-					f :: a->[a]
-					f y = [x,y]
-
-		Here, f is forced to be monorphic by the free occurence of x.
-
-	(d) Not (unified with another type variable that is) in scope.
-		eg f x :: (r->r) = (\y->y) :: forall a. a->r
-	    when checking the expression type signature, we find that
-	    even though there is nothing in scope whose type mentions r,
-	    nevertheless the type signature for the expression isn't right.
-
-	    Another example is in a class or instance declaration:
-		class C a where
-		   op :: forall b. a -> b
-		   op x = x
-	    Here, b gets unified with a
-
-Before doing this, the substitution is applied to the signature type variable.
-
-\begin{code}
-checkSigTyVars :: [TcTyVar] -> TcM ()
-checkSigTyVars sig_tvs = check_sig_tyvars emptyVarSet sig_tvs
-
-checkSigTyVarsWrt :: TcTyVarSet -> [TcTyVar] -> TcM ()
--- The extra_tvs can include boxy type variables; 
--- 	e.g. TcMatches.tcCheckExistentialPat
-checkSigTyVarsWrt extra_tvs sig_tvs
-  = do	{ extra_tvs' <- zonkTcTyVarsAndFV (varSetElems extra_tvs)
-	; check_sig_tyvars extra_tvs' sig_tvs }
-
-check_sig_tyvars
-	:: TcTyVarSet	-- Global type variables. The universally quantified
-			-- 	tyvars should not mention any of these
-			--	Guaranteed already zonked.
-	-> [TcTyVar]	-- Universally-quantified type variables in the signature
-			--	Guaranteed to be skolems
-	-> TcM ()
-check_sig_tyvars extra_tvs []
-  = returnM ()
-check_sig_tyvars extra_tvs sig_tvs 
-  = ASSERT( all isSkolemTyVar sig_tvs )
-    do	{ gbl_tvs <- tcGetGlobalTyVars
-	; traceTc (text "check_sig_tyvars" <+> (vcat [text "sig_tys" <+> ppr sig_tvs,
-				      text "gbl_tvs" <+> ppr gbl_tvs,
-				      text "extra_tvs" <+> ppr extra_tvs]))
-
-	; let env_tvs = gbl_tvs `unionVarSet` extra_tvs
-	; ifM (any (`elemVarSet` env_tvs) sig_tvs)
-	      (bleatEscapedTvs env_tvs sig_tvs sig_tvs)
-	}
-
-bleatEscapedTvs :: TcTyVarSet	-- The global tvs
-	        -> [TcTyVar]	-- The possibly-escaping type variables
-		-> [TcTyVar]	-- The zonked versions thereof
-		-> TcM ()
--- Complain about escaping type variables
--- We pass a list of type variables, at least one of which
--- escapes.  The first list contains the original signature type variable,
--- while the second  contains the type variable it is unified to (usually itself)
-bleatEscapedTvs globals sig_tvs zonked_tvs
-  = do	{ env0 <- tcInitTidyEnv
-	; let (env1, tidy_tvs)        = tidyOpenTyVars env0 sig_tvs
-	      (env2, tidy_zonked_tvs) = tidyOpenTyVars env1 zonked_tvs
-
-	; (env3, msgs) <- foldlM check (env2, []) (tidy_tvs `zip` tidy_zonked_tvs)
-	; failWithTcM (env3, main_msg $$ nest 2 (vcat msgs)) }
-  where
-    main_msg = ptext SLIT("Inferred type is less polymorphic than expected")
-
-    check (tidy_env, msgs) (sig_tv, zonked_tv)
-      | not (zonked_tv `elemVarSet` globals) = return (tidy_env, msgs)
-      | otherwise
-      = do { (tidy_env1, globs) <- findGlobals (unitVarSet zonked_tv) tidy_env
-	   ; returnM (tidy_env1, escape_msg sig_tv zonked_tv globs : msgs) }
-
------------------------
-escape_msg sig_tv zonked_tv globs
-  | notNull globs 
-  = vcat [sep [msg, ptext SLIT("is mentioned in the environment:")], 
-	  nest 2 (vcat globs)]
-  | otherwise
-  = msg <+> ptext SLIT("escapes")
-	-- Sigh.  It's really hard to give a good error message
-	-- all the time.   One bad case is an existential pattern match.
-	-- We rely on the "When..." context to help.
-  where
-    msg = ptext SLIT("Quantified type variable") <+> quotes (ppr sig_tv) <+> is_bound_to
-    is_bound_to 
-	| sig_tv == zonked_tv = empty
-	| otherwise = ptext SLIT("is unified with") <+> quotes (ppr zonked_tv) <+> ptext SLIT("which")
-\end{code}
-
-These two context are used with checkSigTyVars
-    
-\begin{code}
-sigCtxt :: Id -> [TcTyVar] -> TcThetaType -> TcTauType
-	-> TidyEnv -> TcM (TidyEnv, Message)
-sigCtxt id sig_tvs sig_theta sig_tau tidy_env
-  = zonkTcType sig_tau		`thenM` \ actual_tau ->
-    let
-	(env1, tidy_sig_tvs)    = tidyOpenTyVars tidy_env sig_tvs
-	(env2, tidy_sig_rho)	= tidyOpenType env1 (mkPhiTy sig_theta sig_tau)
-	(env3, tidy_actual_tau) = tidyOpenType env2 actual_tau
-	sub_msg = vcat [ptext SLIT("Signature type:    ") <+> pprType (mkForAllTys tidy_sig_tvs tidy_sig_rho),
-		        ptext SLIT("Type to generalise:") <+> pprType tidy_actual_tau
-		   ]
- 	msg = vcat [ptext SLIT("When trying to generalise the type inferred for") <+> quotes (ppr id),
-		    nest 2 sub_msg]
-    in
-    returnM (env3, msg)
-\end{code}
diff --git a/ghc/compiler/typecheck/TcUnify.lhs-boot b/ghc/compiler/typecheck/TcUnify.lhs-boot
deleted file mode 100644
index 8a1847e671..0000000000
--- a/ghc/compiler/typecheck/TcUnify.lhs-boot
+++ /dev/null
@@ -1,11 +0,0 @@
-\begin{code}
-module TcUnify where
-import TcType	( TcTauType, BoxyType )
-import TcRnTypes( TcM )
-
--- This boot file exists only to tie the knot between
---		TcUnify and TcSimplify
-
-unifyType :: TcTauType -> TcTauType -> TcM ()
-zapToMonotype :: BoxyType -> TcM TcTauType
-\end{code}
diff --git a/ghc/compiler/types/Class.lhs b/ghc/compiler/types/Class.lhs
deleted file mode 100644
index 016ce1bfbe..0000000000
--- a/ghc/compiler/types/Class.lhs
+++ /dev/null
@@ -1,164 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Class]{The @Class@ datatype}
-
-\begin{code}
-module Class (
-	Class, ClassOpItem, FunDep,
-	DefMeth (..),
-
-	mkClass, classTyVars, classArity,
-	classKey, className, classSelIds, classTyCon, classMethods,
-	classBigSig, classExtraBigSig, classTvsFds, classSCTheta
-    ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TyCon	( TyCon )
-import {-# SOURCE #-} TypeRep	( PredType )
-
-import Var		( Id, TyVar )
-import Name		( NamedThing(..), Name )
-import BasicTypes	( Arity )
-import Unique		( Unique, Uniquable(..) )
-import Outputable
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Class-basic]{@Class@: basic definition}
-%*									*
-%************************************************************************
-
-A @Class@ corresponds to a Greek kappa in the static semantics:
-
-\begin{code}
-data Class
-  = Class {
-	classKey  :: Unique,			-- Key for fast comparison
-	className :: Name,
-	
-	classTyVars  :: [TyVar],		-- The class type variables
-	classFunDeps :: [FunDep TyVar],		-- The functional dependencies
-
-	classSCTheta :: [PredType],		-- Immediate superclasses, and the
-	classSCSels  :: [Id],			-- corresponding selector functions to
-						-- extract them from a dictionary of this
-						-- class
-
-	classOpStuff :: [ClassOpItem],		-- Ordered by tag
-
-	classTyCon :: TyCon		-- The data type constructor for dictionaries
-  }					-- of this class
-
-type FunDep a	  = ([a],[a])	--  e.g. class C a b c |  a b -> c, a c -> b  where ...
-				--  Here fun-deps are [([a,b],[c]), ([a,c],[b])]
-
-type ClassOpItem = (Id, DefMeth)
-	-- Selector function; contains unfolding
-	-- Default-method info
-
-data DefMeth = NoDefMeth 		-- No default method
-	     | DefMeth  		-- A polymorphic default method
-	     | GenDefMeth 		-- A generic default method
-             deriving Eq  
-\end{code}
-
-The @mkClass@ function fills in the indirect superclasses.
-
-\begin{code}
-mkClass :: Name -> [TyVar]
-	-> [([TyVar], [TyVar])]
-	-> [PredType] -> [Id]
-	-> [ClassOpItem]
-	-> TyCon
-	-> Class
-
-mkClass name tyvars fds super_classes superdict_sels
-	op_stuff tycon
-  = Class {	classKey = getUnique name, 
-		className = name,
-		classTyVars = tyvars,
-		classFunDeps = fds,
-		classSCTheta = super_classes,
-		classSCSels = superdict_sels,
-		classOpStuff = op_stuff,
-		classTyCon = tycon }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Class-selectors]{@Class@: simple selectors}
-%*									*
-%************************************************************************
-
-The rest of these functions are just simple selectors.
-
-\begin{code}
-classArity :: Class -> Arity
-classArity clas = length (classTyVars clas)
-	-- Could memoise this
-
-classSelIds :: Class -> [Id]
-classSelIds c@(Class {classSCSels = sc_sels})
-  = sc_sels ++ classMethods c
-
-classMethods :: Class -> [Id]
-classMethods (Class {classOpStuff = op_stuff})
-  = [op_sel | (op_sel, _) <- op_stuff]
-
-classTvsFds c
-  = (classTyVars c, classFunDeps c)
-
-classBigSig (Class {classTyVars = tyvars, classSCTheta = sc_theta, 
-	 	    classSCSels = sc_sels, classOpStuff = op_stuff})
-  = (tyvars, sc_theta, sc_sels, op_stuff)
-classExtraBigSig (Class {classTyVars = tyvars, classFunDeps = fundeps,
-			 classSCTheta = sc_theta, classSCSels = sc_sels,
-			 classOpStuff = op_stuff})
-  = (tyvars, fundeps, sc_theta, sc_sels, op_stuff)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Class-instances]{Instance declarations for @Class@}
-%*									*
-%************************************************************************
-
-We compare @Classes@ by their keys (which include @Uniques@).
-
-\begin{code}
-instance Eq Class where
-    c1 == c2 = classKey c1 == classKey c2
-    c1 /= c2 = classKey c1 /= classKey c2
-
-instance Ord Class where
-    c1 <= c2 = classKey c1 <= classKey c2
-    c1 <  c2 = classKey c1 <  classKey c2
-    c1 >= c2 = classKey c1 >= classKey c2
-    c1 >  c2 = classKey c1 >  classKey c2
-    compare c1 c2 = classKey c1 `compare` classKey c2
-\end{code}
-
-\begin{code}
-instance Uniquable Class where
-    getUnique c = classKey c
-
-instance NamedThing Class where
-    getName clas = className clas
-
-instance Outputable Class where
-    ppr c = ppr (getName c)
-
-instance Show Class where
-    showsPrec p c = showsPrecSDoc p (ppr c)
-
-instance Outputable DefMeth where
-    ppr DefMeth     =  text "{- has default method -}"
-    ppr GenDefMeth  =  text "{- has generic method -}"
-    ppr NoDefMeth   =  empty   -- No default method
-\end{code}
-
-
diff --git a/ghc/compiler/types/FunDeps.lhs b/ghc/compiler/types/FunDeps.lhs
deleted file mode 100644
index 9347f5f665..0000000000
--- a/ghc/compiler/types/FunDeps.lhs
+++ /dev/null
@@ -1,500 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 2000
-%
-\section[FunDeps]{FunDeps - functional dependencies}
-
-It's better to read it as: "if we know these, then we're going to know these"
-
-\begin{code}
-module FunDeps (
- 	Equation, pprEquation,
-	oclose, grow, improve, 
-	checkInstCoverage, checkFunDeps,
-	pprFundeps
-    ) where
-
-#include "HsVersions.h"
-
-import Name		( Name, getSrcLoc )
-import Var		( TyVar )
-import Class		( Class, FunDep, classTvsFds )
-import Unify		( tcUnifyTys, BindFlag(..) )
-import Type		( substTys, notElemTvSubst )
-import TcType		( Type, PredType(..), tcEqType, 
-			  predTyUnique, mkClassPred, tyVarsOfTypes, tyVarsOfPred )
-import InstEnv		( Instance(..), InstEnv, instanceHead, classInstances,
-			  instanceCantMatch, roughMatchTcs )
-import VarSet
-import VarEnv
-import Outputable
-import Util             ( notNull )
-import List		( tails )
-import Maybe		( isJust )
-import ListSetOps	( equivClassesByUniq )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Close type variables}
-%*									*
-%************************************************************************
-
-(oclose preds tvs) closes the set of type variables tvs, 
-wrt functional dependencies in preds.  The result is a superset
-of the argument set.  For example, if we have
-	class C a b | a->b where ...
-then
-	oclose [C (x,y) z, C (x,p) q] {x,y} = {x,y,z}
-because if we know x and y then that fixes z.
-
-Using oclose
-~~~~~~~~~~~~
-oclose is used
-
-a) When determining ambiguity.  The type
-	forall a,b. C a b => a
-is not ambiguous (given the above class decl for C) because
-a determines b.  
-
-b) When generalising a type T.  Usually we take FV(T) \ FV(Env),
-but in fact we need
-	FV(T) \ (FV(Env)+)
-where the '+' is the oclosure operation.  Notice that we do not 
-take FV(T)+.  This puzzled me for a bit.  Consider
-
-	f = E
-
-and suppose e have that E :: C a b => a, and suppose that b is
-free in the environment. Then we quantify over 'a' only, giving
-the type forall a. C a b => a.  Since a->b but we don't have b->a,
-we might have instance decls like
-	instance C Bool Int where ...
-	instance C Char Int where ...
-so knowing that b=Int doesn't fix 'a'; so we quantify over it.
-
-		---------------
-		A WORRY: ToDo!
-		---------------
-If we have	class C a b => D a b where ....
-     		class D a b | a -> b where ...
-and the preds are [C (x,y) z], then we want to see the fd in D,
-even though it is not explicit in C, giving [({x,y},{z})]
-
-Similarly for instance decls?  E.g. Suppose we have
-	instance C a b => Eq (T a b) where ...
-and we infer a type t with constraints Eq (T a b) for a particular
-expression, and suppose that 'a' is free in the environment.  
-We could generalise to
-	forall b. Eq (T a b) => t
-but if we reduced the constraint, to C a b, we'd see that 'a' determines
-b, so that a better type might be
-	t (with free constraint C a b) 
-Perhaps it doesn't matter, because we'll still force b to be a
-particular type at the call sites.  Generalising over too many
-variables (provided we don't shadow anything by quantifying over a
-variable that is actually free in the envt) may postpone errors; it
-won't hide them altogether.
-
-
-\begin{code}
-oclose :: [PredType] -> TyVarSet -> TyVarSet
-oclose preds fixed_tvs
-  | null tv_fds = fixed_tvs	-- Fast escape hatch for common case
-  | otherwise   = loop fixed_tvs
-  where
-    loop fixed_tvs
-	| new_fixed_tvs `subVarSet` fixed_tvs = fixed_tvs
-	| otherwise		  	      = loop new_fixed_tvs
-	where
-	  new_fixed_tvs = foldl extend fixed_tvs tv_fds
-
-    extend fixed_tvs (ls,rs) | ls `subVarSet` fixed_tvs = fixed_tvs `unionVarSet` rs
-			     | otherwise		= fixed_tvs
-
-    tv_fds  :: [(TyVarSet,TyVarSet)]
-	-- In our example, tv_fds will be [ ({x,y}, {z}), ({x,p},{q}) ]
-	-- Meaning "knowing x,y fixes z, knowing x,p fixes q"
-    tv_fds  = [ (tyVarsOfTypes xs, tyVarsOfTypes ys)
-	      | ClassP cls tys <- preds,		-- Ignore implicit params
-		let (cls_tvs, cls_fds) = classTvsFds cls,
-		fd <- cls_fds,
-		let (xs,ys) = instFD fd cls_tvs tys
-	      ]
-\end{code}
-
-\begin{code}
-grow :: [PredType] -> TyVarSet -> TyVarSet
-grow preds fixed_tvs 
-  | null preds = fixed_tvs
-  | otherwise  = loop fixed_tvs
-  where
-    loop fixed_tvs
-	| new_fixed_tvs `subVarSet` fixed_tvs = fixed_tvs
-	| otherwise		  	      = loop new_fixed_tvs
-	where
-	  new_fixed_tvs = foldl extend fixed_tvs pred_sets
-
-    extend fixed_tvs pred_tvs 
-	| fixed_tvs `intersectsVarSet` pred_tvs = fixed_tvs `unionVarSet` pred_tvs
-	| otherwise			        = fixed_tvs
-
-    pred_sets = [tyVarsOfPred pred | pred <- preds]
-\end{code}
-    
-%************************************************************************
-%*									*
-\subsection{Generate equations from functional dependencies}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-----------
-type Equation = (TyVarSet, [(Type, Type)])
--- These pairs of types should be equal, for some
--- substitution of the tyvars in the tyvar set
--- INVARIANT: corresponding types aren't already equal
-
--- It's important that we have a *list* of pairs of types.  Consider
--- 	class C a b c | a -> b c where ...
---	instance C Int x x where ...
--- Then, given the constraint (C Int Bool v) we should improve v to Bool,
--- via the equation ({x}, [(Bool,x), (v,x)])
--- This would not happen if the class had looked like
---	class C a b c | a -> b, a -> c
-
--- To "execute" the equation, make fresh type variable for each tyvar in the set,
--- instantiate the two types with these fresh variables, and then unify.
---
--- For example, ({a,b}, (a,Int,b), (Int,z,Bool))
--- We unify z with Int, but since a and b are quantified we do nothing to them
--- We usually act on an equation by instantiating the quantified type varaibles
--- to fresh type variables, and then calling the standard unifier.
-
-pprEquation (qtvs, pairs) 
-  = vcat [ptext SLIT("forall") <+> braces (pprWithCommas ppr (varSetElems qtvs)),
-	  nest 2 (vcat [ ppr t1 <+> ptext SLIT(":=:") <+> ppr t2 | (t1,t2) <- pairs])]
-
-----------
-type Pred_Loc = (PredType, SDoc)	-- SDoc says where the Pred comes from
-
-improve :: (Class -> [Instance])		-- Gives instances for given class
-	-> [Pred_Loc]				-- Current constraints; 
-	-> [(Equation,Pred_Loc,Pred_Loc)]	-- Derived equalities that must also hold
-						-- (NB the above INVARIANT for type Equation)
-						-- The Pred_Locs explain which two predicates were
-						-- combined (for error messages)
-\end{code}
-
-Given a bunch of predicates that must hold, such as
-
-	C Int t1, C Int t2, C Bool t3, ?x::t4, ?x::t5
-
-improve figures out what extra equations must hold.
-For example, if we have
-
-	class C a b | a->b where ...
-
-then improve will return
-
-	[(t1,t2), (t4,t5)]
-
-NOTA BENE:
-
-  * improve does not iterate.  It's possible that when we make
-    t1=t2, for example, that will in turn trigger a new equation.
-    This would happen if we also had
-	C t1 t7, C t2 t8
-    If t1=t2, we also get t7=t8.
-
-    improve does *not* do this extra step.  It relies on the caller
-    doing so.
-
-  * The equations unify types that are not already equal.  So there
-    is no effect iff the result of improve is empty
-
-
-
-\begin{code}
-improve inst_env preds
-  = [ eqn | group <- equivClassesByUniq (predTyUnique . fst) preds,
-	    eqn   <- checkGroup inst_env group ]
-
-----------
-checkGroup :: (Class -> [Instance])
-	   -> [Pred_Loc]
-	   -> [(Equation, Pred_Loc, Pred_Loc)]
-  -- The preds are all for the same class or implicit param
-
-checkGroup inst_env (p1@(IParam _ ty, _) : ips)
-  = 	-- For implicit parameters, all the types must match
-    [ ((emptyVarSet, [(ty,ty')]), p1, p2) 
-    | p2@(IParam _ ty', _) <- ips, not (ty `tcEqType` ty')]
-
-checkGroup inst_env clss@((ClassP cls _, _) : _)
-  = 	-- For classes life is more complicated  
-   	-- Suppose the class is like
-	--	classs C as | (l1 -> r1), (l2 -> r2), ... where ...
-	-- Then FOR EACH PAIR (ClassP c tys1, ClassP c tys2) in the list clss
-	-- we check whether
-	--	U l1[tys1/as] = U l2[tys2/as]
-	--  (where U is a unifier)
-	-- 
-	-- If so, we return the pair
-	--	U r1[tys1/as] = U l2[tys2/as]
-	--
-	-- We need to do something very similar comparing each predicate
-	-- with relevant instance decls
-
-    instance_eqns ++ pairwise_eqns
-	-- NB: we put the instance equations first.   This biases the 
-	-- order so that we first improve individual constraints against the
-	-- instances (which are perhaps in a library and less likely to be
-	-- wrong; and THEN perform the pairwise checks.
-	-- The other way round, it's possible for the pairwise check to succeed
-	-- and cause a subsequent, misleading failure of one of the pair with an
-	-- instance declaration.  See tcfail143.hs for an exmample
-
-  where
-    (cls_tvs, cls_fds) = classTvsFds cls
-    instances	       = inst_env cls
-
-	-- NOTE that we iterate over the fds first; they are typically
-	-- empty, which aborts the rest of the loop.
-    pairwise_eqns :: [(Equation,Pred_Loc,Pred_Loc)]
-    pairwise_eqns	-- This group comes from pairwise comparison
-      = [ (eqn, p1, p2)
-	| fd <- cls_fds,
-	  p1@(ClassP _ tys1, _) : rest <- tails clss,
-	  p2@(ClassP _ tys2, _)	<- rest,
-	  eqn <- checkClsFD emptyVarSet fd cls_tvs tys1 tys2
-	]
-
-    instance_eqns :: [(Equation,Pred_Loc,Pred_Loc)]
-    instance_eqns	-- This group comes from comparing with instance decls
-      = [ (eqn, p1, p2)
-	| fd <- cls_fds,	-- Iterate through the fundeps first, 
-				-- because there often are none!
-	  p2@(ClassP _ tys2, _) <- clss,
-	  let rough_tcs2 = trimRoughMatchTcs cls_tvs fd (roughMatchTcs tys2),
-	  ispec@(Instance { is_tvs = qtvs, is_tys = tys1, 
-		 	    is_tcs = mb_tcs1 }) <- instances,
-	  not (instanceCantMatch mb_tcs1 rough_tcs2),
-	  eqn <- checkClsFD qtvs fd cls_tvs tys1 tys2,
-	  let p1 = (mkClassPred cls tys1, 
-		    ptext SLIT("arising from the instance declaration at") <+> 
-			ppr (getSrcLoc ispec))
-	]
-----------
-checkClsFD :: TyVarSet 			-- Quantified type variables; see note below
-	   -> FunDep TyVar -> [TyVar] 	-- One functional dependency from the class
-	   -> [Type] -> [Type]
-	   -> [Equation]
-
-checkClsFD qtvs fd clas_tvs tys1 tys2
--- 'qtvs' are the quantified type variables, the ones which an be instantiated 
--- to make the types match.  For example, given
---	class C a b | a->b where ...
---	instance C (Maybe x) (Tree x) where ..
---
--- and an Inst of form (C (Maybe t1) t2), 
--- then we will call checkClsFD with
---
---	qtvs = {x}, tys1 = [Maybe x,  Tree x]
---		    tys2 = [Maybe t1, t2]
---
--- We can instantiate x to t1, and then we want to force
--- 	(Tree x) [t1/x]  :=:   t2
---
--- This function is also used when matching two Insts (rather than an Inst
--- against an instance decl. In that case, qtvs is empty, and we are doing
--- an equality check
--- 
--- This function is also used by InstEnv.badFunDeps, which needs to *unify*
--- For the one-sided matching case, the qtvs are just from the template,
--- so we get matching
---
-  = ASSERT2( length tys1 == length tys2     && 
-	     length tys1 == length clas_tvs 
-	    , ppr tys1 <+> ppr tys2 )
-
-    case tcUnifyTys bind_fn ls1 ls2 of
-	Nothing  -> []
-	Just subst | isJust (tcUnifyTys bind_fn rs1' rs2') 
-			-- Don't include any equations that already hold. 
-			-- Reason: then we know if any actual improvement has happened,
-			-- 	   in which case we need to iterate the solver
-			-- In making this check we must taking account of the fact that any 
-			-- qtvs that aren't already instantiated can be instantiated to anything 
-			-- at all
-		  -> []
-
-		  | otherwise	-- Aha!  A useful equation
-		  -> [ (qtvs', zip rs1' rs2')]
-		  	-- We could avoid this substTy stuff by producing the eqn
-		  	-- (qtvs, ls1++rs1, ls2++rs2)
-		  	-- which will re-do the ls1/ls2 unification when the equation is
-		  	-- executed.  What we're doing instead is recording the partial
-		  	-- work of the ls1/ls2 unification leaving a smaller unification problem
-		  where
-		    rs1'  = substTys subst rs1 
-	 	    rs2'  = substTys subst rs2
-		    qtvs' = filterVarSet (`notElemTvSubst` subst) qtvs
-			-- qtvs' are the quantified type variables
-			-- that have not been substituted out
-			--	
-			-- Eg. 	class C a b | a -> b
-			--	instance C Int [y]
-			-- Given constraint C Int z
-			-- we generate the equation
-			--	({y}, [y], z)
-  where
-    bind_fn tv | tv `elemVarSet` qtvs = BindMe
-	       | otherwise	      = Skolem
-
-    (ls1, rs1) = instFD fd clas_tvs tys1
-    (ls2, rs2) = instFD fd clas_tvs tys2
-
-instFD :: FunDep TyVar -> [TyVar] -> [Type] -> FunDep Type
-instFD (ls,rs) tvs tys
-  = (map lookup ls, map lookup rs)
-  where
-    env       = zipVarEnv tvs tys
-    lookup tv = lookupVarEnv_NF env tv
-\end{code}
-
-\begin{code}
-checkInstCoverage :: Class -> [Type] -> Bool
--- Check that the Coverage Condition is obeyed in an instance decl
--- For example, if we have 
---	class theta => C a b | a -> b
--- 	instance C t1 t2 
--- Then we require fv(t2) `subset` fv(t1)
--- See Note [Coverage Condition] below
-
-checkInstCoverage clas inst_taus
-  = all fundep_ok fds
-  where
-    (tyvars, fds) = classTvsFds clas
-    fundep_ok fd  = tyVarsOfTypes rs `subVarSet` tyVarsOfTypes ls
-		 where
-		   (ls,rs) = instFD fd tyvars inst_taus
-\end{code}
-
-Note [Coverage condition]
-~~~~~~~~~~~~~~~~~~~~~~~~~
-For the coverage condition, we used to require only that 
-	fv(t2) `subset` oclose(fv(t1), theta)
-
-Example:
-	class Mul a b c | a b -> c where
-		(.*.) :: a -> b -> c
-
-	instance Mul Int Int Int where (.*.) = (*)
-	instance Mul Int Float Float where x .*. y = fromIntegral x * y
-	instance Mul a b c => Mul a [b] [c] where x .*. v = map (x.*.) v
-
-In the third instance, it's not the case that fv([c]) `subset` fv(a,[b]).
-But it is the case that fv([c]) `subset` oclose( theta, fv(a,[b]) )
-
-But it is a mistake to accept the instance because then this defn:
-	f = \ b x y -> if b then x .*. [y] else y
-makes instance inference go into a loop, because it requires the constraint
-	Mul a [b] b
-
-
-%************************************************************************
-%*									*
-	Check that a new instance decl is OK wrt fundeps
-%*									*
-%************************************************************************
-
-Here is the bad case:
-	class C a b | a->b where ...
-	instance C Int Bool where ...
-	instance C Int Char where ...
-
-The point is that a->b, so Int in the first parameter must uniquely
-determine the second.  In general, given the same class decl, and given
-
-	instance C s1 s2 where ...
-	instance C t1 t2 where ...
-
-Then the criterion is: if U=unify(s1,t1) then U(s2) = U(t2).
-
-Matters are a little more complicated if there are free variables in
-the s2/t2.  
-
-	class D a b c | a -> b
-	instance D a b => D [(a,a)] [b] Int
-	instance D a b => D [a]     [b] Bool
-
-The instance decls don't overlap, because the third parameter keeps
-them separate.  But we want to make sure that given any constraint
-	D s1 s2 s3
-if s1 matches 
-
-
-\begin{code}
-checkFunDeps :: (InstEnv, InstEnv) -> Instance
-	     -> Maybe [Instance]	-- Nothing  <=> ok
-					-- Just dfs <=> conflict with dfs
--- Check wheher adding DFunId would break functional-dependency constraints
--- Used only for instance decls defined in the module being compiled
-checkFunDeps inst_envs ispec
-  | null bad_fundeps = Nothing
-  | otherwise	     = Just bad_fundeps
-  where
-    (ins_tvs, _, clas, ins_tys) = instanceHead ispec
-    ins_tv_set   = mkVarSet ins_tvs
-    cls_inst_env = classInstances inst_envs clas
-    bad_fundeps  = badFunDeps cls_inst_env clas ins_tv_set ins_tys
-
-badFunDeps :: [Instance] -> Class
-	   -> TyVarSet -> [Type]	-- Proposed new instance type
-	   -> [Instance]
-badFunDeps cls_insts clas ins_tv_set ins_tys 
-  = [ ispec | fd <- fds,	-- fds is often empty
-	      let trimmed_tcs = trimRoughMatchTcs clas_tvs fd rough_tcs,
-	      ispec@(Instance { is_tcs = mb_tcs, is_tvs = tvs, 
-				is_tys = tys }) <- cls_insts,
-		-- Filter out ones that can't possibly match, 
-		-- based on the head of the fundep
-	      not (instanceCantMatch trimmed_tcs mb_tcs),	
-	      notNull (checkClsFD (tvs `unionVarSet` ins_tv_set) 
-				   fd clas_tvs tys ins_tys)
-    ]
-  where
-    (clas_tvs, fds) = classTvsFds clas
-    rough_tcs = roughMatchTcs ins_tys
-
-trimRoughMatchTcs :: [TyVar] -> FunDep TyVar -> [Maybe Name] -> [Maybe Name]
--- Computing rough_tcs for a particular fundep
---	class C a b c | a c -> b where ... 
--- For each instance .... => C ta tb tc
--- we want to match only on the types ta, tb; so our
--- rough-match thing must similarly be filtered.  
--- Hence, we Nothing-ise the tb type right here
-trimRoughMatchTcs clas_tvs (ltvs,_) mb_tcs
-  = zipWith select clas_tvs mb_tcs
-  where
-    select clas_tv mb_tc | clas_tv `elem` ltvs = mb_tc
-			 | otherwise	       = Nothing
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Miscellaneous}
-%*									*
-%************************************************************************
-
-\begin{code}
-pprFundeps :: Outputable a => [FunDep a] -> SDoc
-pprFundeps [] = empty
-pprFundeps fds = hsep (ptext SLIT("|") : punctuate comma (map ppr_fd fds))
-
-ppr_fd (us, vs) = hsep [interppSP us, ptext SLIT("->"), interppSP vs]
-\end{code}
-
diff --git a/ghc/compiler/types/Generics.lhs b/ghc/compiler/types/Generics.lhs
deleted file mode 100644
index 2c973649cf..0000000000
--- a/ghc/compiler/types/Generics.lhs
+++ /dev/null
@@ -1,546 +0,0 @@
-\begin{code}
-module Generics ( canDoGenerics, mkTyConGenericBinds,
-		  mkGenericRhs, 
-		  validGenericInstanceType, validGenericMethodType
-    ) where
-
-
-import HsSyn
-import Type             ( Type, isUnLiftedType, tyVarsOfType, tyVarsOfTypes,
-			  isTyVarTy, getTyVar_maybe, funTyCon
-			)
-import TcHsSyn		( mkSimpleHsAlt )
-import TcType		( tcSplitTyConApp_maybe, tcSplitSigmaTy, tcSplitPhiTy, applyTy, 
-			  isTauTy, mkTyVarTy )
-import DataCon          ( DataCon, dataConOrigArgTys, isVanillaDataCon,
-			  dataConSourceArity )
-
-import TyCon            ( TyCon, tyConName, tyConDataCons, 
-			  isBoxedTupleTyCon
-			)
-import Name		( nameModule, nameOccName, getSrcLoc )
-import OccName		( mkGenOcc1, mkGenOcc2 )
-import RdrName		( RdrName, getRdrName, mkVarUnqual, mkOrig )
-import BasicTypes       ( EP(..), Boxity(..) )
-import Var              ( TyVar )
-import VarSet		( varSetElems )
-import Id               ( Id, idType )
-import TysWiredIn	( listTyCon )
-import PrelNames
-	
-import SrcLoc		( srcLocSpan, noLoc, Located(..) )
-import Util             ( takeList, isSingleton )
-import Bag
-import Outputable 
-import FastString
-
-#include "HsVersions.h"
-\end{code}
-
-Roadmap of what's where in the Generics work.
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Parser
-No real checks.
-
-RnSource.rnHsType
-  Checks that HsNumTy has a "1" in it.
-
-TcInstDcls.mkGenericInstance:
-  Checks for invalid type patterns, such as f {| Int |}
-
-TcClassDcl.tcClassSig
-  Checks for a method type that is too complicated;
-	e.g. has for-alls or lists in it
-  We could lift this restriction
-
-TcClassDecl.mkDefMethRhs
-  Checks that the instance type is simple, in an instance decl 
-  where we let the compiler fill in a generic method.
-	e.g.  instance C (T Int)
-  	is not valid if C has generic methods.
-
-TcClassDecl.checkGenericClassIsUnary
-  Checks that we don't have generic methods in a multi-parameter class
-
-TcClassDecl.checkDefaultBinds
-  Checks that all the equations for a method in a class decl
-  are generic, or all are non-generic
-
-
-			
-Checking that the type constructors which are present in Generic
-patterns (not Unit, this is done differently) is done in mk_inst_info
-(TcInstDecls) in a call to tcHsType (TcMonoBinds). This means that
-HsOpTy is tied to Generic definitions which is not a very good design
-feature, indeed a bug. However, the check is easy to move from
-tcHsType back to mk_inst_info and everything will be fine. Also see
-bug #5. [I don't think that this is the case anymore after SPJ's latest
-changes in that regard.  Delete this comment?  -=chak/7Jun2]
-
-Generics.lhs
-
-Making generic information to put into a tycon. Constructs the
-representation type, which, I think, are not used later. Perhaps it is
-worth removing them from the GI datatype. Although it does get used in
-the construction of conversion functions (internally).
-
-TyCon.lhs
-
-Just stores generic information, accessible by tyConGenInfo or tyConGenIds.
-
-TysWiredIn.lhs
-
-Defines generic and other type and data constructors.
-
-This is sadly incomplete, but will be added to.
-
-
-Bugs & shortcomings of existing implementation:
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-2. Another pretty big bug I dscovered at the last minute when I was
-testing the code is that at the moment the type variable of the class
-is scoped over the entire declaration, including the patterns. For
-instance, if I have the following code,
-
-class Er a where
- ...
-  er {| Plus a b |} (Inl x) (Inl y) = er x y 
-  er {| Plus a b |} (Inr x) (Inr y) = er x y 
-  er {| Plus a b |} _ _ = False
- 
-and I print out the types of the generic patterns, I get the
-following.  Note that all the variable names for "a" are the same,
-while for "b" they are all different.
-
-check_ty
-    [std.Generics.Plus{-33u,i-} a{-r6Z-} b{-r7g-},
-     std.Generics.Plus{-33u,i-} a{-r6Z-} b{-r7m-},
-     std.Generics.Plus{-33u,i-} a{-r6Z-} b{-r7p-}]
-
-This is a bug as if I change the code to
-
- er {| Plus c b |} (Inl x)  (Inl y) = er x y 
-
-all the names come out to be different.
-
-Thus, all the types (Plus a b) come out to be different, so I cannot
-compare them and test whether they are all the same and thus cannot
-return an error if the type variables are different.
-
-Temporary fix/hack. I am not checking for this, I just assume they are
-the same, see line "check_ty = True" in TcInstDecls. When we resolve
-the issue with variables, though - I assume that we will make them to
-be the same in all the type patterns, jus uncomment the check and
-everything should work smoothly.
-
-Hence, I have also left the rather silly construction of:
-* extracting all the type variables from all the types
-* putting them *all* into the environment
-* typechecking all the types
-* selecting one of them and using it as the instance_ty.
-
-(the alternative is to make sure that all the types are the same,
-taking one, extracting its variables, putting them into the environment,
-type checking it, using it as the instance_ty)
- 
-6. What happens if we do not supply all of the generic patterns? At
-the moment, the compiler crashes with an error message "Non-exhaustive
-patterns in a generic declaration" 
-
-
-What has not been addressed:
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Contexts. In the generated instance declarations for the 3 primitive
-type constructors, we need contexts. It is unclear what those should
-be. At the moment, we always say eg. (Eq a, Eq b) => Eq (Plus a b)
-
-Type application. We have type application in expressions
-(essentially) on the lhs of an equation. Do we want to allow it on the
-RHS?
-
-Scoping of type variables in a generic definition. At the moment, (see
-TcInstDecls) we extract the type variables inside the type patterns
-and add them to the environment. See my bug #2 above. This seems pretty
-important.
-
-
-
-%************************************************************************
-%*									*
-\subsection{Getting the representation type out}
-%*									*
-%************************************************************************
-
-\begin{code}
-validGenericInstanceType :: Type -> Bool
-  -- Checks for validity of the type pattern in a generic
-  -- declaration.  It's ok to have  
-  --	f {| a + b |} ...
-  -- but it's not OK to have
-  --	f {| a + Int |}
-
-validGenericInstanceType inst_ty
-  = case tcSplitTyConApp_maybe inst_ty of
-	Just (tycon, tys) ->  all isTyVarTy tys && tyConName tycon `elem` genericTyConNames
-	Nothing		  ->  False
-
-validGenericMethodType :: Type -> Bool
-  -- At the moment we only allow method types built from
-  -- 	* type variables
-  --	* function arrow
-  --	* boxed tuples
-  --    * lists
-  --	* an arbitrary type not involving the class type variables
-  --		e.g. this is ok: 	forall b. Ord b => [b] -> a
-  --	             where a is the class variable
-validGenericMethodType ty 
-  = valid tau
-  where
-    (local_tvs, _, tau) = tcSplitSigmaTy ty
-
-    valid ty
-      | isTyVarTy ty    = True
-      | no_tyvars_in_ty	= True
-      | otherwise	= case tcSplitTyConApp_maybe ty of
-				Just (tc,tys) -> valid_tycon tc && all valid tys
-				Nothing	      -> False
-      where
-	no_tyvars_in_ty = all (`elem` local_tvs) (varSetElems (tyVarsOfType ty))
-
-    valid_tycon tc = tc == funTyCon || tc == listTyCon || isBoxedTupleTyCon tc 
-	-- Compare bimapApp, below
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Generating representation types}
-%*									*
-%************************************************************************
-
-\begin{code}
-canDoGenerics :: [DataCon] -> Bool
--- Called on source-code data types, to see if we should generate
--- generic functions for them.  (This info is recorded in the interface file for
--- imported data types.)
-
-canDoGenerics data_cons
-  =  not (any bad_con data_cons) 	-- See comment below
-  && not (null data_cons)		-- No values of the type
-  where
-    bad_con dc = any bad_arg_type (dataConOrigArgTys dc) || not (isVanillaDataCon dc)
-  	-- If any of the constructor has an unboxed type as argument,
-	-- then we can't build the embedding-projection pair, because
-	-- it relies on instantiating *polymorphic* sum and product types
-	-- at the argument types of the constructors
-
-	-- Nor can we do the job if it's an existential data constructor,
-
-	-- Nor if the args are polymorphic types (I don't think)
-    bad_arg_type ty = isUnLiftedType ty || not (isTauTy ty)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Generating the RHS of a generic default method}
-%*									*
-%************************************************************************
-
-\begin{code}
-type US = Int	-- Local unique supply, just a plain Int
-type FromAlt = (LPat RdrName, LHsExpr RdrName)
-
-mkTyConGenericBinds :: TyCon -> LHsBinds RdrName
-mkTyConGenericBinds tycon
-  = unitBag (L loc (mkFunBind (L loc from_RDR) from_matches))
-	`unionBags`
-    unitBag (L loc (mkFunBind (L loc to_RDR) to_matches))
-  where
-    from_matches = [mkSimpleHsAlt pat rhs | (pat,rhs) <- from_alts]
-    to_matches   = [mkSimpleHsAlt to_pat to_body]
-    loc	     = srcLocSpan (getSrcLoc tycon)
-    datacons = tyConDataCons tycon
-    (from_RDR, to_RDR) = mkGenericNames tycon
-
-    -- Recurse over the sum first
-    from_alts :: [FromAlt]
-    (from_alts, to_pat, to_body) = mk_sum_stuff init_us datacons
-    init_us = 1::Int		-- Unique supply
-
-----------------------------------------------------
---	Dealing with sums
-----------------------------------------------------
-
-mk_sum_stuff :: US 			-- Base for generating unique names
-	     -> [DataCon]	 	-- The data constructors
-	     -> ([FromAlt],				-- Alternatives for the T->Trep "from" function
-		 InPat RdrName, LHsExpr RdrName)	-- Arg and body of the Trep->T "to" function
-
--- For example, given
---	data T = C | D Int Int Int
--- 
--- mk_sum_stuff v [C,D] = ([C -> Inl Unit, D a b c -> Inr (a :*: (b :*: c))],
---			   case cd of { Inl u -> C; 
---  					Inr abc -> case abc of { a :*: bc ->
---						   case bc  of { b :*: c ->
---						   D a b c }} },
---			   cd)
-
-mk_sum_stuff us [datacon]
-   = ([from_alt], to_pat, to_body_fn app_exp)
-   where
-     n_args = dataConSourceArity datacon	-- Existentials already excluded
-
-     datacon_vars = map mkGenericLocal [us .. us+n_args-1]
-     us'          = us + n_args
-
-     datacon_rdr  = getRdrName datacon
-     app_exp      = nlHsVarApps datacon_rdr datacon_vars
-     from_alt     = (nlConVarPat datacon_rdr datacon_vars, from_alt_rhs)
-
-     (_, from_alt_rhs, to_pat, to_body_fn) = mk_prod_stuff us' datacon_vars
-
-mk_sum_stuff us datacons
-  = (wrap inlDataCon_RDR l_from_alts ++ wrap inrDataCon_RDR r_from_alts,
-     nlVarPat to_arg,
-     noLoc (HsCase (nlHsVar to_arg) 
-	    (mkMatchGroup [mkSimpleHsAlt (nlConPat inlDataCon_RDR [l_to_pat]) l_to_body,
-			   mkSimpleHsAlt (nlConPat inrDataCon_RDR [r_to_pat]) r_to_body])))
-  where
-    (l_datacons, r_datacons)		= splitInHalf datacons
-    (l_from_alts, l_to_pat, l_to_body)	= mk_sum_stuff us' l_datacons
-    (r_from_alts, r_to_pat, r_to_body)	= mk_sum_stuff us' r_datacons
-
-    to_arg = mkGenericLocal us
-    us'	   = us+1
-
-    wrap :: RdrName -> [FromAlt] -> [FromAlt]
-	-- Wrap an application of the Inl or Inr constructor round each alternative
-    wrap dc alts = [(pat, noLoc (HsApp (nlHsVar dc) rhs)) | (pat,rhs) <- alts]
-
-
-----------------------------------------------------
---	Dealing with products
-----------------------------------------------------
-mk_prod_stuff :: US			-- Base for unique names
-	      -> [RdrName]		-- arg-ids; args of the original user-defined constructor
-					-- 	They are bound enclosing from_rhs
-					-- 	Please bind these in the to_body_fn 
-	      -> (US,			-- Depleted unique-name supply
-		  LHsExpr RdrName, 			-- from-rhs: puts together the representation from the arg_ids
-		  InPat RdrName,			-- to_pat: 
-		  LHsExpr RdrName -> LHsExpr RdrName)	-- to_body_fn: takes apart the representation
-
--- For example:
--- mk_prod_stuff abc [a,b,c] = ( a :*: (b :*: c),
---				 abc,
---			         \<body-code> -> case abc of { a :*: bc ->
---				 	         case bc  of { b :*: c  -> 
---					         <body-code> )
-
--- We need to use different uniques in the branches 
--- because the returned to_body_fns are nested.  
--- Hence the returned unqique-name supply
-
-mk_prod_stuff us []		-- Unit case
-  = (us+1,
-     nlHsVar genUnitDataCon_RDR,
-     noLoc (SigPatIn (nlVarPat (mkGenericLocal us)) 
-	    	     (noLoc (HsTyVar (getRdrName genUnitTyConName)))),
-	-- Give a signature to the pattern so we get 
-	--	data S a = Nil | S a
-	--	toS = \x -> case x of { Inl (g :: Unit) -> Nil
-	--				Inr x -> S x }
-	-- The (:: Unit) signature ensures that we'll infer the right
-	-- type for toS. If we leave it out, the type is too polymorphic
-
-     \x -> x)
-
-mk_prod_stuff us [arg_var]	-- Singleton case
-  = (us, nlHsVar arg_var, nlVarPat arg_var, \x -> x)
-
-mk_prod_stuff us arg_vars	-- Two or more
-  = (us'', 
-     nlHsApps crossDataCon_RDR [l_alt_rhs, r_alt_rhs],
-     nlVarPat to_arg, 
--- gaw 2004 FIX?
-     \x -> noLoc (HsCase (nlHsVar to_arg) 
-		  (mkMatchGroup [mkSimpleHsAlt pat (l_to_body_fn (r_to_body_fn x))])))
-  where
-    to_arg = mkGenericLocal us
-    (l_arg_vars, r_arg_vars) 		      = splitInHalf arg_vars
-    (us',  l_alt_rhs, l_to_pat, l_to_body_fn) = mk_prod_stuff (us+1)  l_arg_vars
-    (us'', r_alt_rhs, r_to_pat, r_to_body_fn) = mk_prod_stuff us' r_arg_vars
-    pat = nlConPat crossDataCon_RDR [l_to_pat, r_to_pat]
-
-splitInHalf :: [a] -> ([a],[a])
-splitInHalf list = (left, right)
-		 where
-		   half  = length list `div` 2
-		   left  = take half list
-		   right = drop half list
-
-mkGenericLocal :: US -> RdrName
-mkGenericLocal u = mkVarUnqual (mkFastString ("g" ++ show u))
-
-mkGenericNames tycon
-  = (from_RDR, to_RDR)
-  where
-    tc_name  = tyConName tycon
-    tc_occ   = nameOccName tc_name
-    tc_mod   = nameModule tc_name
-    from_RDR = mkOrig tc_mod (mkGenOcc1 tc_occ)
-    to_RDR   = mkOrig tc_mod (mkGenOcc2 tc_occ)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Generating the RHS of a generic default method}
-%*									*
-%************************************************************************
-
-Generating the Generic default method.  Uses the bimaps to generate the
-actual method. All of this is rather incomplete, but it would be nice
-to make even this work.  Example
-
- 	class Foo a where
-	  op :: Op a
-
-	instance Foo T
-
-Then we fill in the RHS for op, RenamedHsExpr, by calling mkGenericRhs:
-
-	instance Foo T where
-	   op = <mkGenericRhs op a T>
-
-To do this, we generate a pair of RenamedHsExprs (EP toOp fromOp), where
-
-	toOp   :: Op Trep -> Op T
-	fromOp :: Op T    -> Op Trep
-
-(the bimap) and then fill in the RHS with
-
-	instance Foo T where
-	   op = toOp op
-
-Remember, we're generating a RenamedHsExpr, so the result of all this
-will be fed to the type checker.  So the 'op' on the RHS will be 
-at the representation type for T, Trep.
-
-
-Note [Polymorphic methods]
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-Suppose the class op is polymorphic:
-
-	class Baz a where
-	  op :: forall b. Ord b => a -> b -> b
-
-Then we can still generate a bimap with
-
-	toOP :: forall b. (Trep -> b -> b) -> (T -> b -> b)
-
-and fill in the instance decl thus
-
-	instance Foo T where
-	   op = toOp op
-
-By the time the type checker has done its stuff we'll get
-
-	instance Foo T where
-	   op = \b. \dict::Ord b. toOp b (op Trep b dict)
-
-\begin{code}
-mkGenericRhs :: Id -> TyVar -> TyCon -> LHsExpr RdrName
-mkGenericRhs sel_id tyvar tycon
-  = ASSERT( isSingleton ctxt ) 	-- Checks shape of selector-id context
---    pprTrace "mkGenericRhs" (vcat [ppr sel_id, ppr (idType sel_id), ppr tyvar, ppr tycon, ppr local_tvs, ppr final_ty]) $
-    mkHsApp (toEP bimap) (nlHsVar (getRdrName sel_id))
-  where 
-	-- Initialising the "Environment" with the from/to functions
-	-- on the datatype (actually tycon) in question
-	(from_RDR, to_RDR) = mkGenericNames tycon 
-
-        -- Instantiate the selector type, and strip off its class context
-	(ctxt, op_ty) = tcSplitPhiTy (applyTy (idType sel_id) (mkTyVarTy tyvar))
-
-        -- Do it again!  This deals with the case where the method type 
-	-- is polymorphic -- see Note [Polymorphic methods] above
-	(local_tvs,_,final_ty) = tcSplitSigmaTy op_ty
-
-	-- Now we probably have a tycon in front
-        -- of us, quite probably a FunTyCon.
-        ep    = EP (nlHsVar from_RDR) (nlHsVar to_RDR) 
-        bimap = generate_bimap (tyvar, ep, local_tvs) final_ty
-
-type EPEnv = (TyVar,			-- The class type variable
-	      EP (LHsExpr RdrName),	-- The EP it maps to
-	      [TyVar]			-- Other in-scope tyvars; they have an identity EP
-	     )
-
--------------------
-generate_bimap :: EPEnv
-	       -> Type
-	       -> EP (LHsExpr RdrName)
--- Top level case - splitting the TyCon.
-generate_bimap env@(tv,ep,local_tvs) ty 
-  = case getTyVar_maybe ty of
-	Just tv1 |  tv == tv1 -> ep				-- The class tyvar
-		 |  otherwise -> ASSERT( tv1 `elem` local_tvs)	-- One of the polymorphic tyvars of the method
-				 idEP	
-	Nothing	 -> bimapApp env (tcSplitTyConApp_maybe ty)
-
--------------------
-bimapApp :: EPEnv -> Maybe (TyCon, [Type]) -> EP (LHsExpr RdrName)
-bimapApp env Nothing		    = panic "TcClassDecl: Type Application!"
-bimapApp env (Just (tycon, ty_args)) 
-  | tycon == funTyCon       = bimapArrow arg_eps
-  | tycon == listTyCon      = bimapList arg_eps
-  | isBoxedTupleTyCon tycon = bimapTuple arg_eps
-  | otherwise		    =	-- Otherwise validGenericMethodType will 
-				-- have checked that the type is a constant type
-			      ASSERT( all (`elem` local_tvs) (varSetElems (tyVarsOfTypes ty_args)) )
-			      idEP
-    where
-      arg_eps = map (generate_bimap env) ty_args
-      (_,_,local_tvs) = env
-
--------------------
--- bimapArrow :: [EP a a', EP b b'] -> EP (a->b) (a'->b')
-bimapArrow [ep1, ep2]
-  = EP { fromEP = mkHsLam [nlVarPat a_RDR, nlVarPat b_RDR] from_body, 
-	 toEP   = mkHsLam [nlVarPat a_RDR, nlVarPat b_RDR] to_body }
-  where
-    from_body = fromEP ep2 `mkHsApp` (mkHsPar $ nlHsVar a_RDR `mkHsApp` (mkHsPar $ toEP   ep1 `mkHsApp` nlHsVar b_RDR))
-    to_body   = toEP   ep2 `mkHsApp` (mkHsPar $ nlHsVar a_RDR `mkHsApp` (mkHsPar $ fromEP ep1 `mkHsApp` nlHsVar b_RDR))
-
--------------------
--- bimapTuple :: [EP a1 b1, ... EP an bn] -> EP (a1,...an) (b1,..bn)
-bimapTuple eps 
-  = EP { fromEP = mkHsLam [noLoc tuple_pat] (noLoc from_body),
-	 toEP   = mkHsLam [noLoc tuple_pat] (noLoc to_body) }
-  where
-    names	= takeList eps gs_RDR
-    tuple_pat	= TuplePat (map nlVarPat names) Boxed placeHolderType
-    eps_w_names = eps `zip` names
-    to_body     = ExplicitTuple [toEP   ep `mkHsApp` nlHsVar g | (ep,g) <- eps_w_names] Boxed
-    from_body   = ExplicitTuple [fromEP ep `mkHsApp` nlHsVar g | (ep,g) <- eps_w_names] Boxed
-
--------------------
--- bimapList :: EP a b -> EP [a] [b]
-bimapList [ep]
-  = EP { fromEP = nlHsApp (nlHsVar map_RDR) (fromEP ep),
-	 toEP   = nlHsApp (nlHsVar map_RDR) (toEP ep) }
-
--------------------
-a_RDR	= mkVarUnqual FSLIT("a")
-b_RDR	= mkVarUnqual FSLIT("b")
-gs_RDR	= [ mkVarUnqual (mkFastString ("g"++show i)) | i <- [(1::Int) .. ] ]
-
-idEP :: EP (LHsExpr RdrName)
-idEP = EP idexpr idexpr
-     where
-       idexpr = mkHsLam [nlVarPat a_RDR] (nlHsVar a_RDR)
-\end{code}
diff --git a/ghc/compiler/types/InstEnv.lhs b/ghc/compiler/types/InstEnv.lhs
deleted file mode 100644
index d4a7b771b7..0000000000
--- a/ghc/compiler/types/InstEnv.lhs
+++ /dev/null
@@ -1,566 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[InstEnv]{Utilities for typechecking instance declarations}
-
-The bits common to TcInstDcls and TcDeriv.
-
-\begin{code}
-module InstEnv (
-	DFunId, OverlapFlag(..),
-	Instance(..), pprInstance, pprInstanceHdr, pprInstances, 
-	instanceHead, mkLocalInstance, mkImportedInstance,
-	instanceDFunId, setInstanceDFunId, instanceRoughTcs,
-
-	InstEnv, emptyInstEnv, extendInstEnv, 
-	extendInstEnvList, lookupInstEnv, instEnvElts,
-	classInstances, 
-	instanceCantMatch, roughMatchTcs
-    ) where
-
-#include "HsVersions.h"
-
-import Class		( Class )
-import Var		( Id, TyVar, isTcTyVar )
-import VarSet
-import Name		( Name, NamedThing(..), getSrcLoc, nameIsLocalOrFrom, nameModule )
-import OccName		( OccName )
-import NameSet		( unionNameSets, unitNameSet, nameSetToList )
-import Type		( TvSubst )
-import TcType		( Type, PredType, tcEqType,
-			  tcSplitDFunTy, tyVarsOfTypes, isExistentialTyVar,
-			  pprThetaArrow, pprClassPred,
-			  tyClsNamesOfType, tcSplitTyConApp_maybe
-			)
-import TyCon		( tyConName )
-import Unify		( tcMatchTys, tcUnifyTys, BindFlag(..) )
-import Outputable
-import UniqFM		( UniqFM, lookupUFM, emptyUFM, addToUFM_C, eltsUFM )
-import Id		( idType, idName )
-import SrcLoc		( pprDefnLoc )
-import Maybe		( isJust, isNothing )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The key types}
-%*									*
-%************************************************************************
-
-\begin{code}
-type DFunId = Id
-data Instance 
-  = Instance { is_cls  :: Name		-- Class name
-	
-		-- Used for "rough matching"; see note below
-	     , is_tcs  :: [Maybe Name]	-- Top of type args
-
-		-- Used for "proper matching"; see note
-	     , is_tvs  :: TyVarSet	-- Template tyvars for full match
-	     , is_tys  :: [Type]	-- Full arg types
-
-	     , is_dfun :: DFunId
-	     , is_flag :: OverlapFlag
-
-	     , is_orph :: Maybe OccName }
-
--- The "rough-match" fields
--- ~~~~~~~~~~~~~~~~~~~~~~~~~
--- The is_cls, is_args fields allow a "rough match" to be done
--- without poking inside the DFunId.  Poking the DFunId forces
--- us to suck in all the type constructors etc it involves,
--- which is a total waste of time if it has no chance of matching
--- So the Name, [Maybe Name] fields allow us to say "definitely
--- does not match", based only on the Name.
---
--- In is_tcs, 
---     Nothing  means that this type arg is a type variable
---
---     (Just n) means that this type arg is a
--- 		TyConApp with a type constructor of n.
---		This is always a real tycon, never a synonym!
---		(Two different synonyms might match, but two
---		different real tycons can't.)
---		NB: newtypes are not transparent, though!
---
--- The "proper-match" fields
--- ~~~~~~~~~~~~~~~~~~~~~~~~~
--- The is_tvs, is_tys fields are simply cahced values, pulled
--- out (lazily) from the dfun id. They are cached here simply so 
--- that we don't need to decompose the DFunId each time we want 
--- to match it.  The hope is that the fast-match fields mean
--- that we often never poke th proper-match fields
---
--- However, note that:
---  * is_tvs must be a superset of the free vars of is_tys
---
---  * The is_dfun must itself be quantified over exactly is_tvs
---    (This is so that we can use the matching substitution to
---     instantiate the dfun's context.)
---
--- The "orphan" field
--- ~~~~~~~~~~~~~~~~~~
--- An instance is an orphan if its head (after the =>) mentions
--- nothing defined in this module.  
---
---    Just n	The head mentions n, which is defined in this module
---		This is used for versioning; the instance decl is
---		considered part of the defn of n when computing versions
---
---    Nothing 	The head mentions nothing defined in this modle
---
--- If a module contains any orphans, then its interface file is read 
--- regardless, so that its instances are not missed. 
--- 
--- Functional dependencies worsen the situation a bit. Consider
---	class C a b | a -> b
--- In some other module we might have
---    module M where
---	data T = ...
---	instance C Int T where ...
--- This isn't considered an orphan, so we will only read M's interface
--- if something from M is used (e.g. T).  So there's a risk we'll
--- miss the improvement from the instance.  Workaround: import M.
-
-instanceDFunId :: Instance -> DFunId
-instanceDFunId = is_dfun
-
-setInstanceDFunId :: Instance -> DFunId -> Instance
-setInstanceDFunId ispec dfun
-   = ASSERT( idType dfun `tcEqType` idType (is_dfun ispec) )
-	-- We need to create the cached fields afresh from
-	-- the new dfun id.  In particular, the is_tvs in
-	-- the Instance must match those in the dfun!
-	-- We assume that the only thing that changes is
-	-- the quantified type variables, so the other fields
-	-- are ok; hence the assert
-     ispec { is_dfun = dfun, is_tvs = mkVarSet tvs, is_tys = tys }
-   where 
-     (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
-
-instanceRoughTcs :: Instance -> [Maybe Name]
-instanceRoughTcs = is_tcs
-\end{code}
-
-\begin{code}
-instance NamedThing Instance where
-   getName ispec = getName (is_dfun ispec)
-
-instance Outputable Instance where
-   ppr = pprInstance
-
-pprInstance :: Instance -> SDoc
--- Prints the Instance as an instance declaration
-pprInstance ispec@(Instance { is_flag = flag })
-  = hang (pprInstanceHdr ispec)
-	2 (ptext SLIT("--") <+> (pprDefnLoc (getSrcLoc ispec)))
-
--- * pprInstanceHdr is used in VStudio to populate the ClassView tree
-pprInstanceHdr :: Instance -> SDoc
--- Prints the Instance as an instance declaration
-pprInstanceHdr ispec@(Instance { is_flag = flag })
-  = ptext SLIT("instance") <+> ppr flag
-    <+> sep [pprThetaArrow theta, pprClassPred clas tys]
-  where
-    (_, theta, clas, tys) = instanceHead ispec
-	-- Print without the for-all, which the programmer doesn't write
-
-pprInstances :: [Instance] -> SDoc
-pprInstances ispecs = vcat (map pprInstance ispecs)
-
-instanceHead :: Instance -> ([TyVar], [PredType], Class, [Type])
-instanceHead ispec = tcSplitDFunTy (idType (is_dfun ispec))
-
-mkLocalInstance :: DFunId -> OverlapFlag -> Instance
--- Used for local instances, where we can safely pull on the DFunId
-mkLocalInstance dfun oflag
-  = Instance {	is_flag = oflag, is_dfun = dfun,
-		is_tvs = mkVarSet tvs, is_tys = tys,
-		is_cls = cls_name, is_tcs = roughMatchTcs tys,
-		is_orph = orph }
-  where
-    (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun)
-    mod = nameModule (idName dfun)
-    cls_name = getName cls
-    tycl_names = foldr (unionNameSets . tyClsNamesOfType) 
-		       (unitNameSet cls_name) tys
-    orph = case filter (nameIsLocalOrFrom mod) (nameSetToList tycl_names) of
-		[]     -> Nothing
-		(n:ns) -> Just (getOccName n)
-
-mkImportedInstance :: Name -> [Maybe Name] -> Maybe OccName
-		   -> DFunId -> OverlapFlag -> Instance
--- Used for imported instances, where we get the rough-match stuff
--- from the interface file
-mkImportedInstance cls mb_tcs orph dfun oflag
-  = Instance {	is_flag = oflag, is_dfun = dfun,
-		is_tvs = mkVarSet tvs, is_tys = tys,
-		is_cls = cls, is_tcs = mb_tcs, is_orph = orph }
-  where
-    (tvs, _, _, tys) = tcSplitDFunTy (idType dfun)
-
-roughMatchTcs :: [Type] -> [Maybe Name]
-roughMatchTcs tys = map rough tys
-  where
-    rough ty = case tcSplitTyConApp_maybe ty of
-		  Just (tc,_) -> Just (tyConName tc)
-		  Nothing     -> Nothing
-
-instanceCantMatch :: [Maybe Name] -> [Maybe Name] -> Bool
--- (instanceCantMatch tcs1 tcs2) returns True if tcs1 cannot
--- possibly be instantiated to actual, nor vice versa; 
--- False is non-committal
-instanceCantMatch (Just t : ts) (Just a : as) = t/=a || instanceCantMatch ts as
-instanceCantMatch ts		as	      =  False	-- Safe
-
----------------------------------------------------
-data OverlapFlag
-  = NoOverlap	-- This instance must not overlap another
-
-  | OverlapOk	-- Silently ignore this instance if you find a 
-		-- more specific one that matches the constraint
-		-- you are trying to resolve
-		--
-		-- Example: constraint (Foo [Int])
-		-- 	    instances  (Foo [Int])
-		--		       (Foo [a])	OverlapOk
-		-- Since the second instance has the OverlapOk flag,
-		-- the first instance will be chosen (otherwise 
-		-- its ambiguous which to choose)
-
-  | Incoherent	-- Like OverlapOk, but also ignore this instance 
-		-- if it doesn't match the constraint you are
-		-- trying to resolve, but could match if the type variables
-		-- in the constraint were instantiated
-		--
-		-- Example: constraint (Foo [b])
-		--	    instances  (Foo [Int])	Incoherent
-		--		       (Foo [a])
-		-- Without the Incoherent flag, we'd complain that
-		-- instantiating 'b' would change which instance 
-		-- was chosen
-
-instance Outputable OverlapFlag where
-   ppr NoOverlap  = empty
-   ppr OverlapOk  = ptext SLIT("[overlap ok]")
-   ppr Incoherent = ptext SLIT("[incoherent]")
-\end{code}
-
-
-Note [Overlapping instances]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Overlap is permitted, but only in such a way that one can make
-a unique choice when looking up.  That is, overlap is only permitted if
-one template matches the other, or vice versa.  So this is ok:
-
-  [a]  [Int]
-
-but this is not
-
-  (Int,a)  (b,Int)
-
-If overlap is permitted, the list is kept most specific first, so that
-the first lookup is the right choice.
-
-
-For now we just use association lists.
-
-\subsection{Avoiding a problem with overlapping}
-
-Consider this little program:
-
-\begin{pseudocode}
-     class C a        where c :: a
-     class C a => D a where d :: a
-
-     instance C Int where c = 17
-     instance D Int where d = 13
-
-     instance C a => C [a] where c = [c]
-     instance ({- C [a], -} D a) => D [a] where d = c
-
-     instance C [Int] where c = [37]
-
-     main = print (d :: [Int])
-\end{pseudocode}
-
-What do you think `main' prints  (assuming we have overlapping instances, and
-all that turned on)?  Well, the instance for `D' at type `[a]' is defined to
-be `c' at the same type, and we've got an instance of `C' at `[Int]', so the
-answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because
-the `C [Int]' instance is more specific).
-
-Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong.  That
-was easy ;-)  Let's just consult hugs for good measure.  Wait - if I use old
-hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it
-doesn't even compile!  What's going on!?
-
-What hugs complains about is the `D [a]' instance decl.
-
-\begin{pseudocode}
-     ERROR "mj.hs" (line 10): Cannot build superclass instance
-     *** Instance            : D [a]
-     *** Context supplied    : D a
-     *** Required superclass : C [a]
-\end{pseudocode}
-
-You might wonder what hugs is complaining about.  It's saying that you
-need to add `C [a]' to the context of the `D [a]' instance (as appears
-in comments).  But there's that `C [a]' instance decl one line above
-that says that I can reduce the need for a `C [a]' instance to the
-need for a `C a' instance, and in this case, I already have the
-necessary `C a' instance (since we have `D a' explicitly in the
-context, and `C' is a superclass of `D').
-
-Unfortunately, the above reasoning indicates a premature commitment to the
-generic `C [a]' instance.  I.e., it prematurely rules out the more specific
-instance `C [Int]'.  This is the mistake that ghc-4.06 makes.  The fix is to
-add the context that hugs suggests (uncomment the `C [a]'), effectively
-deferring the decision about which instance to use.
-
-Now, interestingly enough, 4.04 has this same bug, but it's covered up
-in this case by a little known `optimization' that was disabled in
-4.06.  Ghc-4.04 silently inserts any missing superclass context into
-an instance declaration.  In this case, it silently inserts the `C
-[a]', and everything happens to work out.
-
-(See `basicTypes/MkId:mkDictFunId' for the code in question.  Search for
-`Mark Jones', although Mark claims no credit for the `optimization' in
-question, and would rather it stopped being called the `Mark Jones
-optimization' ;-)
-
-So, what's the fix?  I think hugs has it right.  Here's why.  Let's try
-something else out with ghc-4.04.  Let's add the following line:
-
-    d' :: D a => [a]
-    d' = c
-
-Everyone raise their hand who thinks that `d :: [Int]' should give a
-different answer from `d' :: [Int]'.  Well, in ghc-4.04, it does.  The
-`optimization' only applies to instance decls, not to regular
-bindings, giving inconsistent behavior.
-
-Old hugs had this same bug.  Here's how we fixed it: like GHC, the
-list of instances for a given class is ordered, so that more specific
-instances come before more generic ones.  For example, the instance
-list for C might contain:
-    ..., C Int, ..., C a, ...  
-When we go to look for a `C Int' instance we'll get that one first.
-But what if we go looking for a `C b' (`b' is unconstrained)?  We'll
-pass the `C Int' instance, and keep going.  But if `b' is
-unconstrained, then we don't know yet if the more specific instance
-will eventually apply.  GHC keeps going, and matches on the generic `C
-a'.  The fix is to, at each step, check to see if there's a reverse
-match, and if so, abort the search.  This prevents hugs from
-prematurely chosing a generic instance when a more specific one
-exists.
-
---Jeff
-
-BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in
-this test.  Suppose the instance envt had
-    ..., forall a b. C a a b, ..., forall a b c. C a b c, ...
-(still most specific first)
-Now suppose we are looking for (C x y Int), where x and y are unconstrained.
-	C x y Int  doesn't match the template {a,b} C a a b
-but neither does 
-	C a a b  match the template {x,y} C x y Int
-But still x and y might subsequently be unified so they *do* match.
-
-Simple story: unify, don't match.
-
-
-%************************************************************************
-%*									*
-		InstEnv, ClsInstEnv
-%*									*
-%************************************************************************
-
-A @ClsInstEnv@ all the instances of that class.  The @Id@ inside a
-ClsInstEnv mapping is the dfun for that instance.
-
-If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then
-
-	forall a b, C t1 t2 t3  can be constructed by dfun
-
-or, to put it another way, we have
-
-	instance (...) => C t1 t2 t3,  witnessed by dfun
-
-\begin{code}
----------------------------------------------------
-type InstEnv = UniqFM ClsInstEnv	-- Maps Class to instances for that class
-
-data ClsInstEnv 
-  = ClsIE [Instance]	-- The instances for a particular class, in any order
-  	  Bool 		-- True <=> there is an instance of form C a b c
-			-- 	If *not* then the common case of looking up
-			--	(C a b c) can fail immediately
-
--- INVARIANTS:
---  * The is_tvs are distinct in each Instance
---	of a ClsInstEnv (so we can safely unify them)
-
--- Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry:
---	[a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a]
--- The "a" in the pattern must be one of the forall'd variables in
--- the dfun type.
-
-emptyInstEnv :: InstEnv
-emptyInstEnv = emptyUFM
-
-instEnvElts :: InstEnv -> [Instance]
-instEnvElts ie = [elt | ClsIE elts _ <- eltsUFM ie, elt <- elts]
-
-classInstances :: (InstEnv,InstEnv) -> Class -> [Instance]
-classInstances (pkg_ie, home_ie) cls 
-  = get home_ie ++ get pkg_ie
-  where
-    get env = case lookupUFM env cls of
-		Just (ClsIE insts _) -> insts
-		Nothing		     -> []
-
-extendInstEnvList :: InstEnv -> [Instance] -> InstEnv
-extendInstEnvList inst_env ispecs = foldl extendInstEnv inst_env ispecs
-
-extendInstEnv :: InstEnv -> Instance -> InstEnv
-extendInstEnv inst_env ins_item@(Instance { is_cls = cls_nm, is_tcs = mb_tcs })
-  = addToUFM_C add inst_env cls_nm (ClsIE [ins_item] ins_tyvar)
-  where
-    add (ClsIE cur_insts cur_tyvar) _ = ClsIE (ins_item : cur_insts)
-					      (ins_tyvar || cur_tyvar)
-    ins_tyvar = not (any isJust mb_tcs)
-\end{code}		      
-
-
-%************************************************************************
-%*									*
-\subsection{Looking up an instance}
-%*									*
-%************************************************************************
-
-@lookupInstEnv@ looks up in a @InstEnv@, using a one-way match.  Since
-the env is kept ordered, the first match must be the only one.  The
-thing we are looking up can have an arbitrary "flexi" part.
-
-\begin{code}
-lookupInstEnv :: (InstEnv 	-- External package inst-env
-		 ,InstEnv) 	-- Home-package inst-env
-	      -> Class -> [Type]		-- What we are looking for
-	      -> ([(TvSubst, Instance)], 	-- Successful matches
-		  [Instance])			-- These don't match but do unify
-	-- The second component of the tuple happens when we look up
-	--	Foo [a]
-	-- in an InstEnv that has entries for
-	--	Foo [Int]
-	--	Foo [b]
-	-- Then which we choose would depend on the way in which 'a'
-	-- is instantiated.  So we report that Foo [b] is a match (mapping b->a)
-	-- but Foo [Int] is a unifier.  This gives the caller a better chance of
-	-- giving a suitable error messagen
-
-lookupInstEnv (pkg_ie, home_ie) cls tys
-  = (pruned_matches, all_unifs)
-  where
-    rough_tcs  = roughMatchTcs tys
-    all_tvs    = all isNothing rough_tcs
-    (home_matches, home_unifs) = lookup home_ie 
-    (pkg_matches,  pkg_unifs)  = lookup pkg_ie  
-    all_matches = home_matches ++ pkg_matches
-    all_unifs   = home_unifs   ++ pkg_unifs
-    pruned_matches 
-	| null all_unifs = foldr insert_overlapping [] all_matches
-	| otherwise	 = all_matches	-- Non-empty unifs is always an error situation,
-					-- so don't attempt to pune the matches
-
-    --------------
-    lookup env = case lookupUFM env cls of
-		   Nothing -> ([],[])	-- No instances for this class
-		   Just (ClsIE insts has_tv_insts)
-			| all_tvs && not has_tv_insts
-			-> ([],[])	-- Short cut for common case
-			-- The thing we are looking up is of form (C a b c), and
-			-- the ClsIE has no instances of that form, so don't bother to search
-	
-			| otherwise
-			-> find [] [] insts
-
-    --------------
-    find ms us [] = (ms, us)
-    find ms us (item@(Instance { is_tcs = mb_tcs, is_tvs = tpl_tvs, 
-				 is_tys = tpl_tys, is_flag = oflag,
-				 is_dfun = dfun }) : rest)
-	-- Fast check for no match, uses the "rough match" fields
-      | instanceCantMatch rough_tcs mb_tcs
-      = find ms us rest
-
-      | Just subst <- tcMatchTys tpl_tvs tpl_tys tys
-      = find ((subst,item):ms) us rest
-
-	-- Does not match, so next check whether the things unify
-	-- See Note [overlapping instances] above
-      | Incoherent <- oflag
-      = find ms us rest
-
-      | otherwise
-      = ASSERT2( not (tyVarsOfTypes tys `intersectsVarSet` tpl_tvs),
-		       (ppr cls <+> ppr tys <+> ppr all_tvs) $$
-		       (ppr dfun <+> ppr tpl_tvs <+> ppr tpl_tys)
-		)
-		-- Unification will break badly if the variables overlap
-		-- They shouldn't because we allocate separate uniques for them
-        case tcUnifyTys bind_fn tpl_tys tys of
-	    Just _   -> find ms (item:us) rest
-	    Nothing  -> find ms us	   rest
-
----------------
-bind_fn tv | isTcTyVar tv && isExistentialTyVar tv = Skolem
-	   | otherwise	 		 	   = BindMe
-	-- The key_tys can contain skolem constants, and we can guarantee that those
-	-- are never going to be instantiated to anything, so we should not involve
-	-- them in the unification test.  Example:
-	--	class Foo a where { op :: a -> Int }
-	--	instance Foo a => Foo [a] 	-- NB overlap
-	--	instance Foo [Int]		-- NB overlap
-	-- 	data T = forall a. Foo a => MkT a
-	--	f :: T -> Int
-	--	f (MkT x) = op [x,x]
-	-- The op [x,x] means we need (Foo [a]).  Without the filterVarSet we'd
-	-- complain, saying that the choice of instance depended on the instantiation
-	-- of 'a'; but of course it isn't *going* to be instantiated.
-	--
-	-- We do this only for pattern-bound skolems.  For example we reject
-	--	g :: forall a => [a] -> Int
-	--	g x = op x
-	-- on the grounds that the correct instance depends on the instantiation of 'a'
-
----------------
-insert_overlapping :: (TvSubst, Instance) -> [(TvSubst, Instance)] 
-		   -> [(TvSubst, Instance)]
--- Add a new solution, knocking out strictly less specific ones
-insert_overlapping new_item [] = [new_item]
-insert_overlapping new_item (item:items)
-  | new_beats_old && old_beats_new = item : insert_overlapping new_item items
-	-- Duplicate => keep both for error report
-  | new_beats_old = insert_overlapping new_item items
-	-- Keep new one
-  | old_beats_new = item : items
-	-- Keep old one
-  | otherwise	  = item : insert_overlapping new_item items
-	-- Keep both
-  where
-    new_beats_old = new_item `beats` item
-    old_beats_new = item `beats` new_item
-
-    (_, instA) `beats` (_, instB)
-	= overlap_ok && 
-	  isJust (tcMatchTys (is_tvs instB) (is_tys instB) (is_tys instA))
-		-- A beats B if A is more specific than B, and B admits overlap
-		-- I.e. if B can be instantiated to match A
-	where
-	  overlap_ok = case is_flag instB of
-			NoOverlap -> False
-			other	  -> True
-\end{code}
-
diff --git a/ghc/compiler/types/Kind.lhs b/ghc/compiler/types/Kind.lhs
deleted file mode 100644
index fa24fec144..0000000000
--- a/ghc/compiler/types/Kind.lhs
+++ /dev/null
@@ -1,228 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-
-\begin{code}
-module Kind (
-	Kind(..), SimpleKind, 
-	openTypeKind, liftedTypeKind, unliftedTypeKind, 
-	argTypeKind, ubxTupleKind,
-
-	isLiftedTypeKind, isUnliftedTypeKind, 
-	isArgTypeKind, isOpenTypeKind,
-	mkArrowKind, mkArrowKinds,
-
-        isSubKind, defaultKind, 
-	kindFunResult, splitKindFunTys, 
-
-	KindVar, mkKindVar, kindVarRef, kindVarUniq, 
-	kindVarOcc, setKindVarOcc,
-
-	pprKind, pprParendKind
-     ) where
-
-#include "HsVersions.h"
-
-import Unique	( Unique )
-import OccName  ( OccName, mkOccName, tvName )
-import Outputable
-import DATA_IOREF
-\end{code}
-
-Kinds
-~~~~~
-There's a little subtyping at the kind level:  
-
-		 ?
-		/ \
-	       /   \
-	      ??   (#)
-	     /  \
-            *   #
-
-where	*    [LiftedTypeKind]   means boxed type
-	#    [UnliftedTypeKind] means unboxed type
-	(#)  [UbxTupleKind]     means unboxed tuple
-	??   [ArgTypeKind]      is the lub of *,#
-	?    [OpenTypeKind]	means any type at all
-
-In particular:
-
-	error :: forall a:?. String -> a
-	(->)  :: ?? -> ? -> *
-	(\(x::t) -> ...)	Here t::?? (i.e. not unboxed tuple)
-
-\begin{code}
-data Kind 
-  = LiftedTypeKind 	--  *
-  | OpenTypeKind	-- ?
-  | UnliftedTypeKind	--  #
-  | UbxTupleKind	-- (##)
-  | ArgTypeKind		-- ??
-  | FunKind Kind Kind	-- k1 -> k2
-  | KindVar KindVar
-  deriving( Eq )
-
-data KindVar = KVar Unique OccName (IORef (Maybe SimpleKind))
-  -- INVARIANT: a KindVar can only be instantiated by a SimpleKind
-
-type SimpleKind = Kind	
-  -- A SimpleKind has no ? or # kinds in it:
-  -- sk ::= * | sk1 -> sk2 | kvar
-
-instance Eq KindVar where
-  (KVar u1 _ _) == (KVar u2 _ _) = u1 == u2
-
-mkKindVar :: Unique -> IORef (Maybe Kind) -> KindVar
-mkKindVar u r = KVar u kind_var_occ r
-
-kindVarRef :: KindVar -> IORef (Maybe Kind)
-kindVarRef (KVar _ _ ref) = ref
-
-kindVarUniq :: KindVar -> Unique
-kindVarUniq (KVar uniq _ _) = uniq
-
-kindVarOcc :: KindVar -> OccName
-kindVarOcc (KVar _ occ _) = occ
-
-setKindVarOcc :: KindVar -> OccName -> KindVar
-setKindVarOcc (KVar u _ r) occ = KVar u occ r
-
-kind_var_occ :: OccName	-- Just one for all KindVars
-			-- They may be jiggled by tidying
-kind_var_occ = mkOccName tvName "k"
-\end{code}
-
-Kind inference
-~~~~~~~~~~~~~~
-During kind inference, a kind variable unifies only with 
-a "simple kind", sk
-	sk ::= * | sk1 -> sk2
-For example 
-	data T a = MkT a (T Int#)
-fails.  We give T the kind (k -> *), and the kind variable k won't unify
-with # (the kind of Int#).
-
-Type inference
-~~~~~~~~~~~~~~
-When creating a fresh internal type variable, we give it a kind to express 
-constraints on it.  E.g. in (\x->e) we make up a fresh type variable for x, 
-with kind ??.  
-
-During unification we only bind an internal type variable to a type
-whose kind is lower in the sub-kind hierarchy than the kind of the tyvar.
-
-When unifying two internal type variables, we collect their kind constraints by
-finding the GLB of the two.  Since the partial order is a tree, they only
-have a glb if one is a sub-kind of the other.  In that case, we bind the
-less-informative one to the more informative one.  Neat, eh?
-
-
-\begin{code}
-liftedTypeKind   = LiftedTypeKind
-unliftedTypeKind = UnliftedTypeKind
-openTypeKind     = OpenTypeKind
-argTypeKind      = ArgTypeKind
-ubxTupleKind	 = UbxTupleKind
-
-mkArrowKind :: Kind -> Kind -> Kind
-mkArrowKind k1 k2 = k1 `FunKind` k2
-
-mkArrowKinds :: [Kind] -> Kind -> Kind
-mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds
-\end{code}
-
-%************************************************************************
-%*									*
-	Functions over Kinds		
-%*									*
-%************************************************************************
-
-\begin{code}
-kindFunResult :: Kind -> Kind
-kindFunResult (FunKind _ k) = k
-kindFunResult k = pprPanic "kindFunResult" (ppr k)
-
-splitKindFunTys :: Kind -> ([Kind],Kind)
-splitKindFunTys (FunKind k1 k2) = case splitKindFunTys k2 of
-				    (as, r) -> (k1:as, r)
-splitKindFunTys k = ([], k)
-
-isLiftedTypeKind, isUnliftedTypeKind :: Kind -> Bool
-isLiftedTypeKind LiftedTypeKind = True
-isLiftedTypeKind other		= False
-
-isUnliftedTypeKind UnliftedTypeKind = True
-isUnliftedTypeKind other	    = False
-
-isArgTypeKind :: Kind -> Bool
--- True of any sub-kind of ArgTypeKind 
-isArgTypeKind LiftedTypeKind   = True
-isArgTypeKind UnliftedTypeKind = True
-isArgTypeKind ArgTypeKind      = True
-isArgTypeKind other	       = False
-
-isOpenTypeKind :: Kind -> Bool
--- True of any sub-kind of OpenTypeKind (i.e. anything except arrow)
-isOpenTypeKind (FunKind _ _) = False
-isOpenTypeKind (KindVar _)   = False	-- This is a conservative answer
-					-- It matters in the call to isSubKind in
-					-- checkExpectedKind.
-isOpenTypeKind other	     = True
-
-isSubKind :: Kind -> Kind -> Bool
--- (k1 `isSubKind` k2) checks that k1 <: k2
-isSubKind LiftedTypeKind   LiftedTypeKind   = True
-isSubKind UnliftedTypeKind UnliftedTypeKind = True
-isSubKind UbxTupleKind     UbxTupleKind     = True
-isSubKind k1 		   OpenTypeKind     = isOpenTypeKind k1
-isSubKind k1 		   ArgTypeKind      = isArgTypeKind k1
-isSubKind (FunKind a1 r1) (FunKind a2 r2)   = (a2 `isSubKind` a1) && (r1 `isSubKind` r2)
-isSubKind k1		  k2		    = False
-
-defaultKind :: Kind -> Kind
--- Used when generalising: default kind '?' and '??' to '*'
--- 
--- When we generalise, we make generic type variables whose kind is
--- simple (* or *->* etc).  So generic type variables (other than
--- built-in constants like 'error') always have simple kinds.  This is important;
--- consider
---	f x = True
--- We want f to get type
---	f :: forall (a::*). a -> Bool
--- Not 
---	f :: forall (a::??). a -> Bool
--- because that would allow a call like (f 3#) as well as (f True),
---and the calling conventions differ.  This defaulting is done in TcMType.zonkTcTyVarBndr.
-defaultKind OpenTypeKind = LiftedTypeKind
-defaultKind ArgTypeKind  = LiftedTypeKind
-defaultKind kind	 = kind
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Pretty printing
-%*									*
-%************************************************************************
-
-\begin{code}
-instance Outputable KindVar where
-  ppr (KVar uniq occ _) = ppr occ <> ifPprDebug (ppr uniq)
-
-instance Outputable Kind where
-  ppr k = pprKind k
-
-pprParendKind :: Kind -> SDoc
-pprParendKind k@(FunKind _ _) = parens (pprKind k)
-pprParendKind k		      = pprKind k
-
-pprKind (KindVar v)      = ppr v
-pprKind LiftedTypeKind   = ptext SLIT("*")
-pprKind UnliftedTypeKind = ptext SLIT("#")
-pprKind OpenTypeKind     = ptext SLIT("?")
-pprKind ArgTypeKind      = ptext SLIT("??")
-pprKind UbxTupleKind     = ptext SLIT("(#)")
-pprKind (FunKind k1 k2)  = sep [ pprParendKind k1, arrow <+> pprKind k2]
-
-\end{code}
diff --git a/ghc/compiler/types/TyCon.hi-boot-5 b/ghc/compiler/types/TyCon.hi-boot-5
deleted file mode 100644
index 1f040d73e1..0000000000
--- a/ghc/compiler/types/TyCon.hi-boot-5
+++ /dev/null
@@ -1,6 +0,0 @@
-__interface TyCon 1 0 where
-__export TyCon TyCon isTupleTyCon isUnboxedTupleTyCon isFunTyCon setTyConName ;
-1 data TyCon ;
-1 isTupleTyCon :: TyCon -> PrelBase.Bool ;
-1 isUnboxedTupleTyCon :: TyCon -> PrelBase.Bool ;
-1 isFunTyCon :: TyCon -> PrelBase.Bool ;
diff --git a/ghc/compiler/types/TyCon.hi-boot-6 b/ghc/compiler/types/TyCon.hi-boot-6
deleted file mode 100644
index 08975621f0..0000000000
--- a/ghc/compiler/types/TyCon.hi-boot-6
+++ /dev/null
@@ -1,7 +0,0 @@
-module TyCon where
-
-data TyCon
-
-isTupleTyCon :: TyCon -> GHC.Base.Bool
-isUnboxedTupleTyCon :: TyCon -> GHC.Base.Bool
-isFunTyCon :: TyCon -> GHC.Base.Bool
diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs
deleted file mode 100644
index fcd32c6974..0000000000
--- a/ghc/compiler/types/TyCon.lhs
+++ /dev/null
@@ -1,683 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[TyCon]{The @TyCon@ datatype}
-
-\begin{code}
-module TyCon(
-	TyCon, ArgVrcs, FieldLabel,
-
-	PrimRep(..),
-	tyConPrimRep,
-
-	AlgTyConRhs(..), visibleDataCons,
-
-	isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
-	isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
-	isEnumerationTyCon, 
-	isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
-	isRecursiveTyCon, newTyConRep, newTyConRhs, 
-	isHiBootTyCon,
-
-	tcExpandTyCon_maybe, coreExpandTyCon_maybe,
-
-	makeTyConAbstract, isAbstractTyCon,
-
-	mkForeignTyCon, isForeignTyCon,
-
-	mkAlgTyCon,
-	mkClassTyCon,
-	mkFunTyCon,
-	mkPrimTyCon,
-	mkLiftedPrimTyCon,
-	mkTupleTyCon,
-	mkSynTyCon,
-
-	tyConName,
-	tyConKind,
-	tyConUnique,
-	tyConTyVars,
-	tyConArgVrcs,
-	algTyConRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize,
-	tyConSelIds,
-	tyConStupidTheta,
-	tyConArity,
-	isClassTyCon, tyConClass_maybe,
-	synTyConDefn, synTyConRhs,
-	tyConExtName,		-- External name for foreign types
-
-        maybeTyConSingleCon,
-
-	-- Generics
-        tyConHasGenerics
-) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} TypeRep ( Type, PredType )
- -- Should just be Type(Type), but this fails due to bug present up to
- -- and including 4.02 involving slurping of hi-boot files.  Bug is now fixed.
-
-import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
-
-
-import Var   		( TyVar, Id )
-import Class		( Class )
-import Kind		( Kind )
-import BasicTypes	( Arity, RecFlag(..), Boxity(..), isBoxed )
-import Name		( Name, nameUnique, NamedThing(getName) )
-import PrelNames	( Unique, Uniquable(..) )
-import Maybes		( orElse )
-import Outputable
-import FastString
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The data type}
-%*									*
-%************************************************************************
-
-\begin{code}
-data TyCon
-  = FunTyCon {
-	tyConUnique :: Unique,
-	tyConName   :: Name,
-	tyConKind   :: Kind,
-	tyConArity  :: Arity
-    }
-
-
-  | AlgTyCon {		-- Data type, and newtype decls.
-			-- All lifted, all boxed
-	tyConUnique :: Unique,
-	tyConName   :: Name,
-	tyConKind   :: Kind,
-	tyConArity  :: Arity,
-	
-	tyConTyVars :: [TyVar],		-- Scopes over (a) the [PredType] in AlgTyConRhs.DataTyCon
-					--	       (b) the cached types in AlgTyConRhs.NewTyCon
-					-- But not over the data constructors
-	argVrcs     :: ArgVrcs,
-
-	algTcSelIds :: [Id],  		-- Its record selectors (empty if none): 
-
-	algTcStupidTheta :: [PredType],	-- The "stupid theta" for the data type
-					-- (always empty for GADTs)
-
-	algTcRhs :: AlgTyConRhs,	-- Data constructors in here
-
-	algTcRec :: RecFlag,		-- Tells whether the data type is part of 
-					-- a mutually-recursive group or not
-
-	hasGenerics :: Bool,		-- True <=> generic to/from functions are available
-					-- (in the exports of the data type's source module)
-
-	algTcClass :: Maybe Class
-		-- Just cl if this tycon came from a class declaration
-    }
-
-  | PrimTyCon {			-- Primitive types; cannot be defined in Haskell
-				-- Now includes foreign-imported types
-	tyConUnique   :: Unique,
-	tyConName     :: Name,
-	tyConKind     :: Kind,
-	tyConArity    :: Arity,
-	argVrcs       :: ArgVrcs,
-
-	primTyConRep  :: PrimRep,
-			-- Many primitive tycons are unboxed, but some are
-			-- boxed (represented by pointers). The CgRep tells.
-
-	isUnLifted   :: Bool,		-- Most primitive tycons are unlifted, 
-					-- but foreign-imported ones may not be
-	tyConExtName :: Maybe FastString	-- Just xx for foreign-imported types
-    }
-
-  | TupleTyCon {
-	tyConUnique :: Unique,
-	tyConName   :: Name,
-	tyConKind   :: Kind,
-	tyConArity  :: Arity,
-	tyConBoxed  :: Boxity,
-	tyConTyVars :: [TyVar],
-	dataCon     :: DataCon,
-	hasGenerics :: Bool
-    }
-
-  | SynTyCon {
-	tyConUnique :: Unique,
-	tyConName   :: Name,
-	tyConKind   :: Kind,
-	tyConArity  :: Arity,
-
-	tyConTyVars     :: [TyVar],	-- Bound tyvars
-	synTcRhs    :: Type,	-- Right-hand side, mentioning these type vars.
-					-- Acts as a template for the expansion when
-					-- the tycon is applied to some types.
-	argVrcs :: ArgVrcs
-    }
-
-type FieldLabel = Name
-
-type ArgVrcs = [(Bool,Bool)]  -- Tyvar variance info: [(occPos,occNeg)]
-	-- [] means "no information, assume the worst"
-
-data AlgTyConRhs
-  = AbstractTyCon	-- We know nothing about this data type, except 
-			-- that it's represented by a pointer
-			-- Used when we export a data type abstractly into
-			-- an hi file
-
-  | DataTyCon {
-	data_cons :: [DataCon],
-			-- The constructors; can be empty if the user declares
-			--   the type to have no constructors
-			-- INVARIANT: Kept in order of increasing tag
-			--	      (see the tag assignment in DataCon.mkDataCon)
-	is_enum :: Bool 	-- Cached: True <=> an enumeration type
-    }			--	   Includes data types with no constructors.
-
-  | NewTyCon {
-	data_con :: DataCon,	-- The unique constructor; it has no existentials
-
-	nt_rhs :: Type,		-- Cached: the argument type of the constructor
-				--  = the representation type of the tycon
-
-	nt_etad_rhs :: ([TyVar], Type) ,
-			-- The same again, but this time eta-reduced
-			-- hence the [TyVar] which may be shorter than the declared 
-			-- arity of the TyCon.  See Note [Newtype eta]
-
-	nt_rep :: Type	-- Cached: the *ultimate* representation type
-			-- By 'ultimate' I mean that the top-level constructor
-			-- of the rep type is not itself a newtype or type synonym.
-			-- The rep type isn't entirely simple:
-			--  for a recursive newtype we pick () as the rep type
-			--	newtype T = MkT T
-			-- 
-			-- This one does not need to be eta reduced; hence its
-			-- free type variables are conveniently tyConTyVars
-			-- Thus:
-			-- 	newtype T a = MkT [(a,Int)]
-			-- The rep type is [(a,Int)]
-			-- NB: the rep type isn't necessarily the original RHS of the
-			--     newtype decl, because the rep type looks through other
-    }			--     newtypes.
-
-visibleDataCons :: AlgTyConRhs -> [DataCon]
-visibleDataCons AbstractTyCon      	      = []
-visibleDataCons (DataTyCon{ data_cons = cs }) = cs
-visibleDataCons (NewTyCon{ data_con = c })    = [c]
-\end{code}
-
-Note [Newtype eta]
-~~~~~~~~~~~~~~~~~~
-Consider
-	newtype Parser m a = MkParser (Foogle m a)
-Are these two types equal (to Core)?
-	Monad (Parser m) 
-	Monad (Foogle m)
-Well, yes.  But to see that easily we eta-reduce the RHS type of
-Parser, in this case to ([], Froogle), so that even unsaturated applications
-of Parser will work right.  This eta reduction is done when the type 
-constructor is built, and cached in NewTyCon.  The cached field is
-only used in coreExpandTyCon_maybe.
- 
-Here's an example that I think showed up in practice
-Source code:
-	newtype T a = MkT [a]
-	newtype Foo m = MkFoo (forall a. m a -> Int)
-
-	w1 :: Foo []
-	w1 = ...
-	
-	w2 :: Foo T
-	w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)
-
-After desugaring, and discading the data constructors for the newtypes,
-we get:
-	w2 :: Foo T
-	w2 = w1
-And now Lint complains unless Foo T == Foo [], and that requires T==[]
-
-
-%************************************************************************
-%*									*
-\subsection{PrimRep}
-%*									*
-%************************************************************************
-
-A PrimRep is an abstraction of a type.  It contains information that
-the code generator needs in order to pass arguments, return results,
-and store values of this type.
-
-A PrimRep is somewhat similar to a CgRep (see codeGen/SMRep) and a
-MachRep (see cmm/MachOp), although each of these types has a distinct
-and clearly defined purpose:
-
-  - A PrimRep is a CgRep + information about signedness + information
-    about primitive pointers (AddrRep).  Signedness and primitive
-    pointers are required when passing a primitive type to a foreign
-    function, but aren't needed for call/return conventions of Haskell
-    functions.
-
-  - A MachRep is a basic machine type (non-void, doesn't contain
-    information on pointerhood or signedness, but contains some
-    reps that don't have corresponding Haskell types).
-
-\begin{code}
-data PrimRep
-  = VoidRep
-  | PtrRep
-  | IntRep		-- signed, word-sized
-  | WordRep		-- unsinged, word-sized
-  | Int64Rep		-- signed, 64 bit (32-bit words only)
-  | Word64Rep		-- unsigned, 64 bit (32-bit words only)
-  | AddrRep		-- a pointer, but not to a Haskell value
-  | FloatRep
-  | DoubleRep
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{TyCon Construction}
-%*									*
-%************************************************************************
-
-Note: the TyCon constructors all take a Kind as one argument, even though
-they could, in principle, work out their Kind from their other arguments.
-But to do so they need functions from Types, and that makes a nasty
-module mutual-recursion.  And they aren't called from many places.
-So we compromise, and move their Kind calculation to the call site.
-
-\begin{code}
-mkFunTyCon :: Name -> Kind -> TyCon
-mkFunTyCon name kind 
-  = FunTyCon { 
-	tyConUnique = nameUnique name,
-	tyConName   = name,
-	tyConKind   = kind,
-	tyConArity  = 2
-    }
-
--- This is the making of a TyCon. Just the same as the old mkAlgTyCon,
--- but now you also have to pass in the generic information about the type
--- constructor - you can get hold of it easily (see Generics module)
-mkAlgTyCon name kind tyvars argvrcs stupid rhs sel_ids is_rec gen_info
-  = AlgTyCon {	
-	tyConName 	 = name,
-	tyConUnique	 = nameUnique name,
-	tyConKind	 = kind,
-	tyConArity	 = length tyvars,
-	tyConTyVars	 = tyvars,
-	argVrcs		 = argvrcs,
-	algTcStupidTheta = stupid,
-	algTcRhs         = rhs,
-	algTcSelIds	 = sel_ids,
-	algTcClass	 = Nothing,
-	algTcRec	 = is_rec,
-	hasGenerics = gen_info
-    }
-
-mkClassTyCon name kind tyvars argvrcs rhs clas is_rec
-  = AlgTyCon {	
-	tyConName 	 = name,
-	tyConUnique	 = nameUnique name,
-	tyConKind	 = kind,
-	tyConArity	 = length tyvars,
-	tyConTyVars	 = tyvars,
-	argVrcs		 = argvrcs,
-	algTcStupidTheta = [],
-	algTcRhs	 = rhs,
-	algTcSelIds	 = [],
-	algTcClass	 = Just clas,
-	algTcRec	 = is_rec,
-	hasGenerics = False
-    }
-
-
-mkTupleTyCon name kind arity tyvars con boxed gen_info
-  = TupleTyCon {
-	tyConUnique = nameUnique name,
-	tyConName = name,
-	tyConKind = kind,
-	tyConArity = arity,
-	tyConBoxed = boxed,
-	tyConTyVars = tyvars,
-	dataCon = con,
-	hasGenerics = gen_info
-    }
-
--- Foreign-imported (.NET) type constructors are represented
--- as primitive, but *lifted*, TyCons for now. They are lifted
--- because the Haskell type T representing the (foreign) .NET
--- type T is actually implemented (in ILX) as a thunk<T>
-mkForeignTyCon name ext_name kind arity arg_vrcs
-  = PrimTyCon {
-	tyConName    = name,
-	tyConUnique  = nameUnique name,
-	tyConKind    = kind,
-	tyConArity   = arity,
-        argVrcs      = arg_vrcs,
-	primTyConRep = PtrRep, -- they all do
-	isUnLifted   = False,
-	tyConExtName = ext_name
-    }
-
-
--- most Prim tycons are lifted
-mkPrimTyCon name kind arity arg_vrcs rep
-  = mkPrimTyCon' name kind arity arg_vrcs rep True  
-
--- but RealWorld is lifted
-mkLiftedPrimTyCon name kind arity arg_vrcs rep
-  = mkPrimTyCon' name kind arity arg_vrcs rep False
-
-mkPrimTyCon' name kind arity arg_vrcs rep is_unlifted
-  = PrimTyCon {
-	tyConName    = name,
-	tyConUnique  = nameUnique name,
-	tyConKind    = kind,
-	tyConArity   = arity,
-        argVrcs      = arg_vrcs,
-	primTyConRep = rep,
-	isUnLifted   = is_unlifted,
-	tyConExtName = Nothing
-    }
-
-mkSynTyCon name kind tyvars rhs argvrcs
-  = SynTyCon {	
-	tyConName = name,
-	tyConUnique = nameUnique name,
-	tyConKind = kind,
-	tyConArity = length tyvars,
-	tyConTyVars = tyvars,
-	synTcRhs = rhs,
-	argVrcs      = argvrcs
-    }
-\end{code}
-
-\begin{code}
-isFunTyCon :: TyCon -> Bool
-isFunTyCon (FunTyCon {}) = True
-isFunTyCon _             = False
-
-isAbstractTyCon :: TyCon -> Bool
-isAbstractTyCon (AlgTyCon { algTcRhs = AbstractTyCon }) = True
-isAbstractTyCon _ = False
-
-makeTyConAbstract :: TyCon -> TyCon
-makeTyConAbstract tc@(AlgTyCon {}) = tc { algTcRhs = AbstractTyCon }
-makeTyConAbstract tc = pprPanic "makeTyConAbstract" (ppr tc)
-
-isPrimTyCon :: TyCon -> Bool
-isPrimTyCon (PrimTyCon {}) = True
-isPrimTyCon _              = False
-
-isUnLiftedTyCon :: TyCon -> Bool
-isUnLiftedTyCon (PrimTyCon  {isUnLifted = is_unlifted}) = is_unlifted
-isUnLiftedTyCon (TupleTyCon {tyConBoxed = boxity})      = not (isBoxed boxity)
-isUnLiftedTyCon _    				        = False
-
--- isAlgTyCon returns True for both @data@ and @newtype@
-isAlgTyCon :: TyCon -> Bool
-isAlgTyCon (AlgTyCon {})   = True
-isAlgTyCon (TupleTyCon {}) = True
-isAlgTyCon other 	   = False
-
-isDataTyCon :: TyCon -> Bool
--- isDataTyCon returns True for data types that are represented by
--- heap-allocated constructors.
--- These are srcutinised by Core-level @case@ expressions, and they
--- get info tables allocated for them.
---	True for all @data@ types
---	False for newtypes
---		  unboxed tuples
-isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})  
-  = case rhs of
-	DataTyCon {}  -> True
-	NewTyCon {}   -> False
-	AbstractTyCon -> pprPanic "isDataTyCon" (ppr tc)
-
-isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
-isDataTyCon other = False
-
-isNewTyCon :: TyCon -> Bool
-isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True 
-isNewTyCon other			       = False
-
-isProductTyCon :: TyCon -> Bool
--- A "product" tycon
---	has *one* constructor, 
---	is *not* existential
--- but
---	may be  DataType or NewType, 
--- 	may be  unboxed or not, 
---	may be  recursive or not
-isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
-				    DataTyCon{ data_cons = [data_con] } 
-						-> isVanillaDataCon data_con
-				    NewTyCon {}	-> True
-				    other	-> False
-isProductTyCon (TupleTyCon {})  = True   
-isProductTyCon other		= False
-
-isSynTyCon :: TyCon -> Bool
-isSynTyCon (SynTyCon {}) = True
-isSynTyCon _		 = False
-
-isEnumerationTyCon :: TyCon -> Bool
-isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
-isEnumerationTyCon other				       	       = False
-
-isTupleTyCon :: TyCon -> Bool
--- The unit tycon didn't used to be classed as a tuple tycon
--- but I thought that was silly so I've undone it
--- If it can't be for some reason, it should be a AlgTyCon
---
--- NB: when compiling Data.Tuple, the tycons won't reply True to
--- isTupleTyCon, becuase they are built as AlgTyCons.  However they
--- get spat into the interface file as tuple tycons, so I don't think
--- it matters.
-isTupleTyCon (TupleTyCon {}) = True
-isTupleTyCon other 	     = False
-
-isUnboxedTupleTyCon :: TyCon -> Bool
-isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
-isUnboxedTupleTyCon other = False
-
-isBoxedTupleTyCon :: TyCon -> Bool
-isBoxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
-isBoxedTupleTyCon other = False
-
-tupleTyConBoxity tc = tyConBoxed tc
-
-isRecursiveTyCon :: TyCon -> Bool
-isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True
-isRecursiveTyCon other				      = False
-
-isHiBootTyCon :: TyCon -> Bool
--- Used for knot-tying in hi-boot files
-isHiBootTyCon (AlgTyCon {algTcRhs = AbstractTyCon}) = True
-isHiBootTyCon other			            = False
-
-isForeignTyCon :: TyCon -> Bool
--- isForeignTyCon identifies foreign-imported type constructors
-isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
-isForeignTyCon other				   = False
-\end{code}
-
-
------------------------------------------------
---	Expand type-constructor applications
------------------------------------------------
-
-\begin{code}
-tcExpandTyCon_maybe, coreExpandTyCon_maybe 
-	:: TyCon 
-	-> [Type]			-- Args to tycon
-	-> Maybe ([(TyVar,Type)], 	-- Substitution
-		  Type,			-- Body type (not yet substituted)
-		  [Type])		-- Leftover args
-
--- For the *typechecker* view, we expand synonyms only
-tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs, synTcRhs = rhs }) tys
-   = expand tvs rhs tys
-tcExpandTyCon_maybe other_tycon tys = Nothing
-
----------------
--- For the *Core* view, we expand synonyms *and* non-recursive newtypes
-coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive,	-- Not recursive
-         algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs }}) tys
-   = case etad_rhs of	-- Don't do this in the pattern match, lest we accidentally
-			-- match the etad_rhs of a *recursive* newtype
-	(tvs,rhs) -> expand tvs rhs tys
-	
-coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys
-
-----------------
-expand	:: [TyVar] -> Type 			-- Template
-	-> [Type]				-- Args
-	-> Maybe ([(TyVar,Type)], Type, [Type])	-- Expansion
-expand tvs rhs tys
-  = case n_tvs `compare` length tys of
-	LT -> Just (tvs `zip` tys, rhs, drop n_tvs tys)
-	EQ -> Just (tvs `zip` tys, rhs, [])
-	GT -> Nothing
-   where
-     n_tvs = length tvs
-\end{code}
-
-\begin{code}
-tyConHasGenerics :: TyCon -> Bool
-tyConHasGenerics (AlgTyCon {hasGenerics = hg})   = hg
-tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg
-tyConHasGenerics other				 = False	-- Synonyms
-
-tyConDataCons :: TyCon -> [DataCon]
--- It's convenient for tyConDataCons to return the
--- empty list for type synonyms etc
-tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` []
-
-tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
-tyConDataCons_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = Just cons
-tyConDataCons_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = con }})    = Just [con]
-tyConDataCons_maybe (TupleTyCon {dataCon = con})	       		   = Just [con]
-tyConDataCons_maybe other			               		   = Nothing
-
-tyConFamilySize  :: TyCon -> Int
-tyConFamilySize (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = length cons
-tyConFamilySize (AlgTyCon {algTcRhs = NewTyCon {}}) = 1
-tyConFamilySize (TupleTyCon {})	 		    = 1
-#ifdef DEBUG
-tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
-#endif
-
-tyConSelIds :: TyCon -> [Id]
-tyConSelIds (AlgTyCon {algTcSelIds = fs}) = fs
-tyConSelIds other_tycon		          = []
-
-algTyConRhs :: TyCon -> AlgTyConRhs
-algTyConRhs (AlgTyCon {algTcRhs = rhs})  = rhs
-algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon { data_cons = [con], is_enum = False }
-algTyConRhs other = pprPanic "algTyConRhs" (ppr other)
-\end{code}
-
-\begin{code}
-newTyConRhs :: TyCon -> ([TyVar], Type)
-newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs)
-newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)
-
-newTyConRep :: TyCon -> ([TyVar], Type)
-newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
-newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
-
-tyConPrimRep :: TyCon -> PrimRep
-tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
-tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep
-\end{code}
-
-\begin{code}
-tyConStupidTheta :: TyCon -> [PredType]
-tyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid
-tyConStupidTheta (TupleTyCon {})			= []
-tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
-\end{code}
-
-@tyConArgVrcs_maybe@ gives a list of (occPos,occNeg) flags, one for
-each tyvar, if available.  See @calcAlgTyConArgVrcs@ for how this is
-actually computed (in another file).
-
-\begin{code}
-tyConArgVrcs :: TyCon -> ArgVrcs
-tyConArgVrcs (FunTyCon   {})		       = [(False,True),(True,False)]
-tyConArgVrcs (AlgTyCon   {argVrcs = oi})       = oi
-tyConArgVrcs (PrimTyCon  {argVrcs = oi})       = oi
-tyConArgVrcs (TupleTyCon {tyConArity = arity}) = (replicate arity (True,False))
-tyConArgVrcs (SynTyCon   {argVrcs = oi})       = oi
-\end{code}
-
-\begin{code}
-synTyConDefn :: TyCon -> ([TyVar], Type)
-synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = ty}) = (tyvars,ty)
-synTyConDefn tycon = pprPanic "getSynTyConDefn" (ppr tycon)
-
-synTyConRhs :: TyCon -> Type
-synTyConRhs tc = synTcRhs tc
-\end{code}
-
-\begin{code}
-maybeTyConSingleCon :: TyCon -> Maybe DataCon
-maybeTyConSingleCon (AlgTyCon {algTcRhs = DataTyCon {data_cons = [c] }}) = Just c
-maybeTyConSingleCon (AlgTyCon {algTcRhs = NewTyCon { data_con = c }})    = Just c
-maybeTyConSingleCon (AlgTyCon {})	         = Nothing
-maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con
-maybeTyConSingleCon (PrimTyCon {})               = Nothing
-maybeTyConSingleCon (FunTyCon {})                = Nothing  -- case at funty
-maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $ ppr tc
-\end{code}
-
-\begin{code}
-isClassTyCon :: TyCon -> Bool
-isClassTyCon (AlgTyCon {algTcClass = Just _}) = True
-isClassTyCon other_tycon			 = False
-
-tyConClass_maybe :: TyCon -> Maybe Class
-tyConClass_maybe (AlgTyCon {algTcClass = maybe_clas}) = maybe_clas
-tyConClass_maybe ther_tycon				 = Nothing
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[TyCon-instances]{Instance declarations for @TyCon@}
-%*									*
-%************************************************************************
-
-@TyCon@s are compared by comparing their @Unique@s.
-
-The strictness analyser needs @Ord@. It is a lexicographic order with
-the property @(a<=b) || (b<=a)@.
-
-\begin{code}
-instance Eq TyCon where
-    a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
-    a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }
-
-instance Ord TyCon where
-    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
-    a <	 b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
-    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
-    a >	 b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
-    compare a b = getUnique a `compare` getUnique b
-
-instance Uniquable TyCon where
-    getUnique tc = tyConUnique tc
-
-instance Outputable TyCon where
-    ppr tc  = ppr (getName tc) 
-
-instance NamedThing TyCon where
-    getName = tyConName
-\end{code}
diff --git a/ghc/compiler/types/TyCon.lhs-boot b/ghc/compiler/types/TyCon.lhs-boot
deleted file mode 100644
index 83b4b7d07a..0000000000
--- a/ghc/compiler/types/TyCon.lhs-boot
+++ /dev/null
@@ -1,9 +0,0 @@
-\begin{code}
-module TyCon where
-
-data TyCon
-
-isTupleTyCon	    :: TyCon -> Bool
-isUnboxedTupleTyCon :: TyCon -> Bool
-isFunTyCon	    :: TyCon -> Bool
-\end{code}
diff --git a/ghc/compiler/types/Type.lhs b/ghc/compiler/types/Type.lhs
deleted file mode 100644
index 872feb06f5..0000000000
--- a/ghc/compiler/types/Type.lhs
+++ /dev/null
@@ -1,1232 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-\section[Type]{Type - public interface}
-
-\begin{code}
-module Type (
-        -- re-exports from TypeRep
-	TyThing(..), Type, PredType(..), ThetaType, 
-	funTyCon,
-
-	-- Re-exports from Kind
-	module Kind,
-
-	-- Re-exports from TyCon
-	PrimRep(..),
-
-	mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, isTyVarTy,
-
-	mkAppTy, mkAppTys, splitAppTy, splitAppTys, splitAppTy_maybe,
-
-	mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, 
-	splitFunTys, splitFunTysN,
-	funResultTy, funArgTy, zipFunTys, isFunTy,
-
-	mkTyConApp, mkTyConTy, 
-	tyConAppTyCon, tyConAppArgs, 
-	splitTyConApp_maybe, splitTyConApp,
-
-	repType, typePrimRep, coreView, tcView,
-
-	mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, 
-	applyTy, applyTys, isForAllTy, dropForAlls,
-
-	-- Source types
-	predTypeRep, mkPredTy, mkPredTys,
-
-	-- Newtypes
-	splitRecNewType_maybe,
-
-	-- Lifting and boxity
-	isUnLiftedType, isUnboxedTupleType, isAlgType, isPrimitiveType,
-	isStrictType, isStrictPred, 
-
-	-- Free variables
-	tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
-	typeKind, addFreeTyVars,
-
-	-- Tidying up for printing
-	tidyType,      tidyTypes,
-	tidyOpenType,  tidyOpenTypes,
-	tidyTyVarBndr, tidyFreeTyVars,
-	tidyOpenTyVar, tidyOpenTyVars,
-	tidyTopType,   tidyPred,
-	tidyKind,
-
-	-- Comparison
-	coreEqType, tcEqType, tcEqTypes, tcCmpType, tcCmpTypes, 
-	tcEqPred, tcCmpPred, tcEqTypeX, 
-
-	-- Seq
-	seqType, seqTypes,
-
-	-- Type substitutions
-	TvSubstEnv, emptyTvSubstEnv,	-- Representation widely visible
-	TvSubst(..), emptyTvSubst,	-- Representation visible to a few friends
-	mkTvSubst, mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
-	getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
- 	extendTvSubst, extendTvSubstList, isInScope, composeTvSubst, zipTyEnv,
-
-	-- Performing substitution on types
-	substTy, substTys, substTyWith, substTheta, 
-	substPred, substTyVar, substTyVarBndr, deShadowTy, lookupTyVar,
-
-	-- Pretty-printing
-	pprType, pprParendType, pprTyThingCategory,
-	pprPred, pprTheta, pprThetaArrow, pprClassPred
-    ) where
-
-#include "HsVersions.h"
-
--- We import the representation and primitive functions from TypeRep.
--- Many things are reexported, but not the representation!
-
-import TypeRep
-
--- friends:
-import Kind
-import Var	( Var, TyVar, tyVarKind, tyVarName, setTyVarName, mkTyVar )
-import VarEnv
-import VarSet
-
-import OccName	( tidyOccName )
-import Name	( NamedThing(..), mkInternalName, tidyNameOcc )
-import Class	( Class, classTyCon )
-import TyCon	( TyCon, isRecursiveTyCon, isPrimTyCon,
-		  isUnboxedTupleTyCon, isUnLiftedTyCon,
-		  isFunTyCon, isNewTyCon, newTyConRep, newTyConRhs,
-		  isAlgTyCon, tyConArity, 
-		  tcExpandTyCon_maybe, coreExpandTyCon_maybe,
-	          tyConKind, PrimRep(..), tyConPrimRep,
-		)
-
--- others
-import StaticFlags	( opt_DictsStrict )
-import SrcLoc		( noSrcLoc )
-import Util		( mapAccumL, seqList, lengthIs, snocView, thenCmp, isEqual, all2 )
-import Outputable
-import UniqSet		( sizeUniqSet )		-- Should come via VarSet
-import Maybe		( isJust )
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Type representation
-%*									*
-%************************************************************************
-
-In Core, we "look through" non-recursive newtypes and PredTypes.
-
-\begin{code}
-{-# INLINE coreView #-}
-coreView :: Type -> Maybe Type
--- Srips off the *top layer only* of a type to give 
--- its underlying representation type. 
--- Returns Nothing if there is nothing to look through.
---
--- In the case of newtypes, it returns
---	*either* a vanilla TyConApp (recursive newtype, or non-saturated)
---	*or*     the newtype representation (otherwise), meaning the
---			type written in the RHS of the newtype decl,
---			which may itself be a newtype
---
--- Example: newtype R = MkR S
---	    newtype S = MkS T
---	    newtype T = MkT (T -> T)
---   expandNewTcApp on R gives Just S
---	            on S gives Just T
---		    on T gives Nothing	 (no expansion)
-
--- By being non-recursive and inlined, this case analysis gets efficiently
--- joined onto the case analysis that the caller is already doing
-coreView (NoteTy _ ty) 	   = Just ty
-coreView (PredTy p)    	   = Just (predTypeRep p)
-coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- coreExpandTyCon_maybe tc tys 
-			   = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
-				-- Its important to use mkAppTys, rather than (foldl AppTy),
-				-- because the function part might well return a 
-				-- partially-applied type constructor; indeed, usually will!
-coreView ty		   = Nothing
-
------------------------------------------------
-{-# INLINE tcView #-}
-tcView :: Type -> Maybe Type
--- Same, but for the type checker, which just looks through synonyms
-tcView (NoteTy _ ty) 	 = Just ty
-tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys 
-			 = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
-tcView ty		 = Nothing
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Constructor-specific functions}
-%*									*
-%************************************************************************
-
-
----------------------------------------------------------------------
-				TyVarTy
-				~~~~~~~
-\begin{code}
-mkTyVarTy  :: TyVar   -> Type
-mkTyVarTy  = TyVarTy
-
-mkTyVarTys :: [TyVar] -> [Type]
-mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
-
-getTyVar :: String -> Type -> TyVar
-getTyVar msg ty = case getTyVar_maybe ty of
-		    Just tv -> tv
-		    Nothing -> panic ("getTyVar: " ++ msg)
-
-isTyVarTy :: Type -> Bool
-isTyVarTy ty = isJust (getTyVar_maybe ty)
-
-getTyVar_maybe :: Type -> Maybe TyVar
-getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
-getTyVar_maybe (TyVarTy tv) 	 	    = Just tv  
-getTyVar_maybe other	         	    = Nothing
-\end{code}
-
-
----------------------------------------------------------------------
-				AppTy
-				~~~~~
-We need to be pretty careful with AppTy to make sure we obey the 
-invariant that a TyConApp is always visibly so.  mkAppTy maintains the
-invariant: use it.
-
-\begin{code}
-mkAppTy orig_ty1 orig_ty2
-  = mk_app orig_ty1
-  where
-    mk_app (NoteTy _ ty1)    = mk_app ty1
-    mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ [orig_ty2])
-    mk_app ty1		     = AppTy orig_ty1 orig_ty2
-	-- Note that the TyConApp could be an 
-	-- under-saturated type synonym.  GHC allows that; e.g.
-	--	type Foo k = k a -> k a
-	--	type Id x = x
-	--	foo :: Foo Id -> Foo Id
-	--
-	-- Here Id is partially applied in the type sig for Foo,
-	-- but once the type synonyms are expanded all is well
-
-mkAppTys :: Type -> [Type] -> Type
-mkAppTys orig_ty1 []	    = orig_ty1
-	-- This check for an empty list of type arguments
-	-- avoids the needless loss of a type synonym constructor.
-	-- For example: mkAppTys Rational []
-	--   returns to (Ratio Integer), which has needlessly lost
-	--   the Rational part.
-mkAppTys orig_ty1 orig_tys2
-  = mk_app orig_ty1
-  where
-    mk_app (NoteTy _ ty1)    = mk_app ty1
-    mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2)
-				-- mkTyConApp: see notes with mkAppTy
-    mk_app ty1		     = foldl AppTy orig_ty1 orig_tys2
-
-splitAppTy_maybe :: Type -> Maybe (Type, Type)
-splitAppTy_maybe ty | Just ty' <- coreView ty = splitAppTy_maybe ty'
-splitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
-splitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
-splitAppTy_maybe (TyConApp tc tys) = case snocView tys of
-					Nothing         -> Nothing
-					Just (tys',ty') -> Just (TyConApp tc tys', ty')
-splitAppTy_maybe other	     	   = Nothing
-
-splitAppTy :: Type -> (Type, Type)
-splitAppTy ty = case splitAppTy_maybe ty of
-			Just pr -> pr
-			Nothing -> panic "splitAppTy"
-
-splitAppTys :: Type -> (Type, [Type])
-splitAppTys ty = split ty ty []
-  where
-    split orig_ty ty args | Just ty' <- coreView ty = split orig_ty ty' args
-    split orig_ty (AppTy ty arg)        args = split ty ty (arg:args)
-    split orig_ty (TyConApp tc tc_args) args = (TyConApp tc [], tc_args ++ args)
-    split orig_ty (FunTy ty1 ty2)       args = ASSERT( null args )
-					       (TyConApp funTyCon [], [ty1,ty2])
-    split orig_ty ty		        args = (orig_ty, args)
-\end{code}
-
-
----------------------------------------------------------------------
-				FunTy
-				~~~~~
-
-\begin{code}
-mkFunTy :: Type -> Type -> Type
-mkFunTy arg res = FunTy arg res
-
-mkFunTys :: [Type] -> Type -> Type
-mkFunTys tys ty = foldr FunTy ty tys
-
-isFunTy :: Type -> Bool 
-isFunTy ty = isJust (splitFunTy_maybe ty)
-
-splitFunTy :: Type -> (Type, Type)
-splitFunTy ty | Just ty' <- coreView ty = splitFunTy ty'
-splitFunTy (FunTy arg res)   = (arg, res)
-splitFunTy other	     = pprPanic "splitFunTy" (ppr other)
-
-splitFunTy_maybe :: Type -> Maybe (Type, Type)
-splitFunTy_maybe ty | Just ty' <- coreView ty = splitFunTy_maybe ty'
-splitFunTy_maybe (FunTy arg res)   = Just (arg, res)
-splitFunTy_maybe other	           = Nothing
-
-splitFunTys :: Type -> ([Type], Type)
-splitFunTys ty = split [] ty ty
-  where
-    split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'
-    split args orig_ty (FunTy arg res) 	 = split (arg:args) res res
-    split args orig_ty ty                = (reverse args, orig_ty)
-
-splitFunTysN :: Int -> Type -> ([Type], Type)
--- Split off exactly n arg tys
-splitFunTysN 0 ty = ([], ty)
-splitFunTysN n ty = case splitFunTy ty of { (arg, res) ->
-		    case splitFunTysN (n-1) res of { (args, res) ->
-		    (arg:args, res) }}
-
-zipFunTys :: Outputable a => [a] -> Type -> ([(a,Type)], Type)
-zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
-  where
-    split acc []     nty ty  	           = (reverse acc, nty)
-    split acc xs     nty ty 
-	  | Just ty' <- coreView ty 	   = split acc xs nty ty'
-    split acc (x:xs) nty (FunTy arg res)   = split ((x,arg):acc) xs res res
-    split acc (x:xs) nty ty                = pprPanic "zipFunTys" (ppr orig_xs <+> ppr orig_ty)
-    
-funResultTy :: Type -> Type
-funResultTy ty | Just ty' <- coreView ty = funResultTy ty'
-funResultTy (FunTy arg res)   = res
-funResultTy ty		      = pprPanic "funResultTy" (ppr ty)
-
-funArgTy :: Type -> Type
-funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
-funArgTy (FunTy arg res)   = arg
-funArgTy ty		   = pprPanic "funArgTy" (ppr ty)
-\end{code}
-
-
----------------------------------------------------------------------
-				TyConApp
-				~~~~~~~~
-@mkTyConApp@ is a key function, because it builds a TyConApp, FunTy or PredTy,
-as apppropriate.
-
-\begin{code}
-mkTyConApp :: TyCon -> [Type] -> Type
-mkTyConApp tycon tys
-  | isFunTyCon tycon, [ty1,ty2] <- tys
-  = FunTy ty1 ty2
-
-  | otherwise
-  = TyConApp tycon tys
-
-mkTyConTy :: TyCon -> Type
-mkTyConTy tycon = mkTyConApp tycon []
-
--- splitTyConApp "looks through" synonyms, because they don't
--- mean a distinct type, but all other type-constructor applications
--- including functions are returned as Just ..
-
-tyConAppTyCon :: Type -> TyCon
-tyConAppTyCon ty = fst (splitTyConApp ty)
-
-tyConAppArgs :: Type -> [Type]
-tyConAppArgs ty = snd (splitTyConApp ty)
-
-splitTyConApp :: Type -> (TyCon, [Type])
-splitTyConApp ty = case splitTyConApp_maybe ty of
-			Just stuff -> stuff
-			Nothing	   -> pprPanic "splitTyConApp" (ppr ty)
-
-splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
-splitTyConApp_maybe ty | Just ty' <- coreView ty = splitTyConApp_maybe ty'
-splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
-splitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
-splitTyConApp_maybe other	      = Nothing
-\end{code}
-
-
----------------------------------------------------------------------
-				SynTy
-				~~~~~
-
-Notes on type synonyms
-~~~~~~~~~~~~~~~~~~~~~~
-The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
-to return type synonyms whereever possible. Thus
-
-	type Foo a = a -> a
-
-we want 
-	splitFunTys (a -> Foo a) = ([a], Foo a)
-not			           ([a], a -> a)
-
-The reason is that we then get better (shorter) type signatures in 
-interfaces.  Notably this plays a role in tcTySigs in TcBinds.lhs.
-
-
-		Representation types
-		~~~~~~~~~~~~~~~~~~~~
-repType looks through 
-	(a) for-alls, and
-	(b) synonyms
-	(c) predicates
-	(d) usage annotations
-	(e) all newtypes, including recursive ones
-It's useful in the back end.
-
-\begin{code}
-repType :: Type -> Type
--- Only applied to types of kind *; hence tycons are saturated
-repType ty | Just ty' <- coreView ty = repType ty'
-repType (ForAllTy _ ty)  = repType ty
-repType (TyConApp tc tys)
-  | isNewTyCon tc 	 = -- Recursive newtypes are opaque to coreView
-			   -- but we must expand them here.  Sure to
-			   -- be saturated because repType is only applied
-			   -- to types of kind *
-			   ASSERT( isRecursiveTyCon tc && 
-				   tys `lengthIs` tyConArity tc )
-			   repType (new_type_rep tc tys)
-repType ty = ty
-
--- new_type_rep doesn't ask any questions: 
--- it just expands newtype, whether recursive or not
-new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
-			     case newTyConRep new_tycon of
-				 (tvs, rep_ty) -> substTyWith tvs tys rep_ty
-
--- ToDo: this could be moved to the code generator, using splitTyConApp instead
--- of inspecting the type directly.
-typePrimRep :: Type -> PrimRep
-typePrimRep ty = case repType ty of
-		   TyConApp tc _ -> tyConPrimRep tc
-		   FunTy _ _	 -> PtrRep
-		   AppTy _ _	 -> PtrRep	-- See note below
-		   TyVarTy _	 -> PtrRep
-		   other	 -> pprPanic "typePrimRep" (ppr ty)
-	-- Types of the form 'f a' must be of kind *, not *#, so
-	-- we are guaranteed that they are represented by pointers.
-	-- The reason is that f must have kind *->*, not *->*#, because
-	-- (we claim) there is no way to constrain f's kind any other
-	-- way.
-
-\end{code}
-
-
----------------------------------------------------------------------
-				ForAllTy
-				~~~~~~~~
-
-\begin{code}
-mkForAllTy :: TyVar -> Type -> Type
-mkForAllTy tyvar ty
-  = mkForAllTys [tyvar] ty
-
-mkForAllTys :: [TyVar] -> Type -> Type
-mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
-
-isForAllTy :: Type -> Bool
-isForAllTy (NoteTy _ ty)  = isForAllTy ty
-isForAllTy (ForAllTy _ _) = True
-isForAllTy other_ty	  = False
-
-splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
-splitForAllTy_maybe ty = splitFAT_m ty
-  where
-    splitFAT_m ty | Just ty' <- coreView ty = splitFAT_m ty'
-    splitFAT_m (ForAllTy tyvar ty)	    = Just(tyvar, ty)
-    splitFAT_m _			    = Nothing
-
-splitForAllTys :: Type -> ([TyVar], Type)
-splitForAllTys ty = split ty ty []
-   where
-     split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
-     split orig_ty (ForAllTy tv ty)  tvs = split ty ty (tv:tvs)
-     split orig_ty t		     tvs = (reverse tvs, orig_ty)
-
-dropForAlls :: Type -> Type
-dropForAlls ty = snd (splitForAllTys ty)
-\end{code}
-
--- (mkPiType now in CoreUtils)
-
-applyTy, applyTys
-~~~~~~~~~~~~~~~~~
-Instantiate a for-all type with one or more type arguments.
-Used when we have a polymorphic function applied to type args:
-	f t1 t2
-Then we use (applyTys type-of-f [t1,t2]) to compute the type of
-the expression. 
-
-\begin{code}
-applyTy :: Type -> Type -> Type
-applyTy ty arg | Just ty' <- coreView ty = applyTy ty' arg
-applyTy (ForAllTy tv ty) arg = substTyWith [tv] [arg] ty
-applyTy other		 arg = panic "applyTy"
-
-applyTys :: Type -> [Type] -> Type
--- This function is interesting because 
---	a) the function may have more for-alls than there are args
---	b) less obviously, it may have fewer for-alls
--- For case (b) think of 
---	applyTys (forall a.a) [forall b.b, Int]
--- This really can happen, via dressing up polymorphic types with newtype
--- clothing.  Here's an example:
---	newtype R = R (forall a. a->a)
---	foo = case undefined :: R of
---		R f -> f ()
-
-applyTys orig_fun_ty []      = orig_fun_ty
-applyTys orig_fun_ty arg_tys 
-  | n_tvs == n_args 	-- The vastly common case
-  = substTyWith tvs arg_tys rho_ty
-  | n_tvs > n_args 	-- Too many for-alls
-  = substTyWith (take n_args tvs) arg_tys 
-		(mkForAllTys (drop n_args tvs) rho_ty)
-  | otherwise		-- Too many type args
-  = ASSERT2( n_tvs > 0, ppr orig_fun_ty )	-- Zero case gives infnite loop!
-    applyTys (substTyWith tvs (take n_tvs arg_tys) rho_ty)
-	     (drop n_tvs arg_tys)
-  where
-    (tvs, rho_ty) = splitForAllTys orig_fun_ty 
-    n_tvs = length tvs
-    n_args = length arg_tys     
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Source types}
-%*									*
-%************************************************************************
-
-A "source type" is a type that is a separate type as far as the type checker is
-concerned, but which has low-level representation as far as the back end is concerned.
-
-Source types are always lifted.
-
-The key function is predTypeRep which gives the representation of a source type:
-
-\begin{code}
-mkPredTy :: PredType -> Type
-mkPredTy pred = PredTy pred
-
-mkPredTys :: ThetaType -> [Type]
-mkPredTys preds = map PredTy preds
-
-predTypeRep :: PredType -> Type
--- Convert a PredType to its "representation type";
--- the post-type-checking type used by all the Core passes of GHC.
--- Unwraps only the outermost level; for example, the result might
--- be a newtype application
-predTypeRep (IParam _ ty)     = ty
-predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
-	-- Result might be a newtype application, but the consumer will
-	-- look through that too if necessary
-\end{code}
-
-
-%************************************************************************
-%*									*
-		NewTypes
-%*									*
-%************************************************************************
-
-\begin{code}
-splitRecNewType_maybe :: Type -> Maybe Type
--- Sometimes we want to look through a recursive newtype, and that's what happens here
--- It only strips *one layer* off, so the caller will usually call itself recursively
--- Only applied to types of kind *, hence the newtype is always saturated
-splitRecNewType_maybe ty | Just ty' <- coreView ty = splitRecNewType_maybe ty'
-splitRecNewType_maybe (TyConApp tc tys)
-  | isNewTyCon tc
-  = ASSERT( tys `lengthIs` tyConArity tc )	-- splitRecNewType_maybe only be applied 
-						-- 	to *types* (of kind *)
-    ASSERT( isRecursiveTyCon tc ) 		-- Guaranteed by coreView
-    case newTyConRhs tc of
-	(tvs, rep_ty) -> ASSERT( length tvs == length tys )
-			 Just (substTyWith tvs tys rep_ty)
-	
-splitRecNewType_maybe other = Nothing
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Kinds and free variables}
-%*									*
-%************************************************************************
-
----------------------------------------------------------------------
-		Finding the kind of a type
-		~~~~~~~~~~~~~~~~~~~~~~~~~~
-\begin{code}
-typeKind :: Type -> Kind
-
-typeKind (TyVarTy tyvar)	= tyVarKind tyvar
-typeKind (TyConApp tycon tys)	= foldr (\_ k -> kindFunResult k) (tyConKind tycon) tys
-typeKind (NoteTy _ ty)		= typeKind ty
-typeKind (PredTy _)		= liftedTypeKind -- Predicates are always 
-						 -- represented by lifted types
-typeKind (AppTy fun arg)	= kindFunResult (typeKind fun)
-typeKind (FunTy arg res)	= liftedTypeKind
-typeKind (ForAllTy tv ty)	= typeKind ty
-\end{code}
-
-
----------------------------------------------------------------------
-		Free variables of a type
-		~~~~~~~~~~~~~~~~~~~~~~~~
-\begin{code}
-tyVarsOfType :: Type -> TyVarSet
--- NB: for type synonyms tyVarsOfType does *not* expand the synonym
-tyVarsOfType (TyVarTy tv)		= unitVarSet tv
-tyVarsOfType (TyConApp tycon tys)	= tyVarsOfTypes tys
-tyVarsOfType (NoteTy (FTVNote tvs) ty2) = tvs
-tyVarsOfType (PredTy sty)		= tyVarsOfPred sty
-tyVarsOfType (FunTy arg res)		= tyVarsOfType arg `unionVarSet` tyVarsOfType res
-tyVarsOfType (AppTy fun arg)		= tyVarsOfType fun `unionVarSet` tyVarsOfType arg
-tyVarsOfType (ForAllTy tyvar ty)	= delVarSet (tyVarsOfType ty) tyvar
-
-tyVarsOfTypes :: [Type] -> TyVarSet
-tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys
-
-tyVarsOfPred :: PredType -> TyVarSet
-tyVarsOfPred (IParam _ ty)  = tyVarsOfType ty
-tyVarsOfPred (ClassP _ tys) = tyVarsOfTypes tys
-
-tyVarsOfTheta :: ThetaType -> TyVarSet
-tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet
-
--- Add a Note with the free tyvars to the top of the type
-addFreeTyVars :: Type -> Type
-addFreeTyVars ty@(NoteTy (FTVNote _) _)      = ty
-addFreeTyVars ty			     = NoteTy (FTVNote (tyVarsOfType ty)) ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{TidyType}
-%*									*
-%************************************************************************
-
-tidyTy tidies up a type for printing in an error message, or in
-an interface file.
-
-It doesn't change the uniques at all, just the print names.
-
-\begin{code}
-tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
-tidyTyVarBndr (tidy_env, subst) tyvar
-  = case tidyOccName tidy_env (getOccName name) of
-      (tidy', occ') -> 	((tidy', subst'), tyvar')
-		    where
-			subst' = extendVarEnv subst tyvar tyvar'
-			tyvar' = setTyVarName tyvar name'
-			name'  = tidyNameOcc name occ'
-  where
-    name = tyVarName tyvar
-
-tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
--- Add the free tyvars to the env in tidy form,
--- so that we can tidy the type they are free in
-tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
-
-tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
-tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
-
-tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
--- Treat a new tyvar as a binder, and give it a fresh tidy name
-tidyOpenTyVar env@(tidy_env, subst) tyvar
-  = case lookupVarEnv subst tyvar of
-	Just tyvar' -> (env, tyvar')		-- Already substituted
-	Nothing	    -> tidyTyVarBndr env tyvar	-- Treat it as a binder
-
-tidyType :: TidyEnv -> Type -> Type
-tidyType env@(tidy_env, subst) ty
-  = go ty
-  where
-    go (TyVarTy tv)	    = case lookupVarEnv subst tv of
-				Nothing  -> TyVarTy tv
-				Just tv' -> TyVarTy tv'
-    go (TyConApp tycon tys) = let args = map go tys
-			      in args `seqList` TyConApp tycon args
-    go (NoteTy note ty)     = (NoteTy $! (go_note note)) $! (go ty)
-    go (PredTy sty)	    = PredTy (tidyPred env sty)
-    go (AppTy fun arg)	    = (AppTy $! (go fun)) $! (go arg)
-    go (FunTy fun arg)	    = (FunTy $! (go fun)) $! (go arg)
-    go (ForAllTy tv ty)	    = ForAllTy tvp $! (tidyType envp ty)
-			      where
-			        (envp, tvp) = tidyTyVarBndr env tv
-
-    go_note note@(FTVNote ftvs) = note	-- No need to tidy the free tyvars
-
-tidyTypes env tys = map (tidyType env) tys
-
-tidyPred :: TidyEnv -> PredType -> PredType
-tidyPred env (IParam n ty)     = IParam n (tidyType env ty)
-tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
-\end{code}
-
-
-@tidyOpenType@ grabs the free type variables, tidies them
-and then uses @tidyType@ to work over the type itself
-
-\begin{code}
-tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
-tidyOpenType env ty
-  = (env', tidyType env' ty)
-  where
-    env' = tidyFreeTyVars env (tyVarsOfType ty)
-
-tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
-tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
-
-tidyTopType :: Type -> Type
-tidyTopType ty = tidyType emptyTidyEnv ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Tidying Kinds
-%*									*
-%************************************************************************
-
-We use a grevious hack for tidying KindVars.  A TidyEnv contains
-a (VarEnv Var) substitution, to express the renaming; but
-KindVars are not Vars.  The Right Thing ultimately is to make them
-into Vars (and perhaps make Kinds into Types), but I just do a hack
-here: I make up a TyVar just to remember the new OccName for the
-renamed KindVar
-
-\begin{code}
-tidyKind :: TidyEnv -> Kind -> (TidyEnv, Kind)
-tidyKind env@(tidy_env, subst) (KindVar kvar)
-  | Just tv <- lookupVarEnv_Directly subst uniq
-  = (env, KindVar (setKindVarOcc kvar (getOccName tv)))
-  | otherwise
-  = ((tidy', subst'), KindVar kvar')
-  where
-    uniq = kindVarUniq kvar
-    (tidy', occ') = tidyOccName tidy_env (kindVarOcc kvar)
-    kvar'   = setKindVarOcc kvar occ'
-    fake_tv = mkTyVar tv_name (panic "tidyKind:fake tv kind")
-    tv_name = mkInternalName uniq occ' noSrcLoc
-    subst'  = extendVarEnv subst fake_tv fake_tv
-
-tidyKind env (FunKind k1 k2) 
-  = (env2, FunKind k1' k2')
-  where
-    (env1, k1') = tidyKind env  k1
-    (env2, k2') = tidyKind env1 k2
-
-tidyKind env k = (env, k)	-- Atomic kinds
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Liftedness}
-%*									*
-%************************************************************************
-
-\begin{code}
-isUnLiftedType :: Type -> Bool
-	-- isUnLiftedType returns True for forall'd unlifted types:
-	--	x :: forall a. Int#
-	-- I found bindings like these were getting floated to the top level.
-	-- They are pretty bogus types, mind you.  It would be better never to
-	-- construct them
-
-isUnLiftedType ty | Just ty' <- coreView ty = isUnLiftedType ty'
-isUnLiftedType (ForAllTy tv ty)  = isUnLiftedType ty
-isUnLiftedType (TyConApp tc _)   = isUnLiftedTyCon tc
-isUnLiftedType other		 = False	
-
-isUnboxedTupleType :: Type -> Bool
-isUnboxedTupleType ty = case splitTyConApp_maybe ty of
-			   Just (tc, ty_args) -> isUnboxedTupleTyCon tc
-			   other	      -> False
-
--- Should only be applied to *types*; hence the assert
-isAlgType :: Type -> Bool
-isAlgType ty = case splitTyConApp_maybe ty of
-			Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
-					      isAlgTyCon tc
-			other		   -> False
-\end{code}
-
-@isStrictType@ computes whether an argument (or let RHS) should
-be computed strictly or lazily, based only on its type.
-Works just like isUnLiftedType, except that it has a special case 
-for dictionaries.  Since it takes account of ClassP, you might think
-this function should be in TcType, but isStrictType is used by DataCon,
-which is below TcType in the hierarchy, so it's convenient to put it here.
-
-\begin{code}
-isStrictType (PredTy pred)     = isStrictPred pred
-isStrictType ty | Just ty' <- coreView ty = isStrictType ty'
-isStrictType (ForAllTy tv ty)  = isStrictType ty
-isStrictType (TyConApp tc _)   = isUnLiftedTyCon tc
-isStrictType other	       = False	
-
-isStrictPred (ClassP clas _) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
-isStrictPred other	     = False
-	-- We may be strict in dictionary types, but only if it 
-	-- has more than one component.
-	-- [Being strict in a single-component dictionary risks
-	--  poking the dictionary component, which is wrong.]
-\end{code}
-
-\begin{code}
-isPrimitiveType :: Type -> Bool
--- Returns types that are opaque to Haskell.
--- Most of these are unlifted, but now that we interact with .NET, we
--- may have primtive (foreign-imported) types that are lifted
-isPrimitiveType ty = case splitTyConApp_maybe ty of
-			Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
-					      isPrimTyCon tc
-			other		   -> False
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Sequencing on types
-%*									*
-%************************************************************************
-
-\begin{code}
-seqType :: Type -> ()
-seqType (TyVarTy tv) 	  = tv `seq` ()
-seqType (AppTy t1 t2) 	  = seqType t1 `seq` seqType t2
-seqType (FunTy t1 t2) 	  = seqType t1 `seq` seqType t2
-seqType (NoteTy note t2)  = seqNote note `seq` seqType t2
-seqType (PredTy p) 	  = seqPred p
-seqType (TyConApp tc tys) = tc `seq` seqTypes tys
-seqType (ForAllTy tv ty)  = tv `seq` seqType ty
-
-seqTypes :: [Type] -> ()
-seqTypes []       = ()
-seqTypes (ty:tys) = seqType ty `seq` seqTypes tys
-
-seqNote :: TyNote -> ()
-seqNote (FTVNote set) = sizeUniqSet set `seq` ()
-
-seqPred :: PredType -> ()
-seqPred (ClassP c tys) = c  `seq` seqTypes tys
-seqPred (IParam n ty)  = n  `seq` seqType ty
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Equality for Core types 
-	(We don't use instances so that we know where it happens)
-%*									*
-%************************************************************************
-
-Note that eqType works right even for partial applications of newtypes.
-See Note [Newtype eta] in TyCon.lhs
-
-\begin{code}
-coreEqType :: Type -> Type -> Bool
-coreEqType t1 t2
-  = eq rn_env t1 t2
-  where
-    rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType t1 `unionVarSet` tyVarsOfType t2))
-
-    eq env (TyVarTy tv1)       (TyVarTy tv2)     = rnOccL env tv1 == rnOccR env tv2
-    eq env (ForAllTy tv1 t1)   (ForAllTy tv2 t2) = eq (rnBndr2 env tv1 tv2) t1 t2
-    eq env (AppTy s1 t1)       (AppTy s2 t2)     = eq env s1 s2 && eq env t1 t2
-    eq env (FunTy s1 t1)       (FunTy s2 t2)     = eq env s1 s2 && eq env t1 t2
-    eq env (TyConApp tc1 tys1) (TyConApp tc2 tys2) 
-	| tc1 == tc2, all2 (eq env) tys1 tys2 = True
-			-- The lengths should be equal because
-			-- the two types have the same kind
-	-- NB: if the type constructors differ that does not 
-	--     necessarily mean that the types aren't equal
-	--     (synonyms, newtypes)
-	-- Even if the type constructors are the same, but the arguments
-	-- differ, the two types could be the same (e.g. if the arg is just
-	-- ignored in the RHS).  In both these cases we fall through to an 
-	-- attempt to expand one side or the other.
-
-	-- Now deal with newtypes, synonyms, pred-tys
-    eq env t1 t2 | Just t1' <- coreView t1 = eq env t1' t2
-		 | Just t2' <- coreView t2 = eq env t1 t2'
-
-	-- Fall through case; not equal!
-    eq env t1 t2 = False
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Comparision for source types 
-	(We don't use instances so that we know where it happens)
-%*									*
-%************************************************************************
-
-Note that 
-	tcEqType, tcCmpType 
-do *not* look through newtypes, PredTypes
-
-\begin{code}
-tcEqType :: Type -> Type -> Bool
-tcEqType t1 t2 = isEqual $ cmpType t1 t2
-
-tcEqTypes :: [Type] -> [Type] -> Bool
-tcEqTypes tys1 tys2 = isEqual $ cmpTypes tys1 tys2
-
-tcCmpType :: Type -> Type -> Ordering
-tcCmpType t1 t2 = cmpType t1 t2
-
-tcCmpTypes :: [Type] -> [Type] -> Ordering
-tcCmpTypes tys1 tys2 = cmpTypes tys1 tys2
-
-tcEqPred :: PredType -> PredType -> Bool
-tcEqPred p1 p2 = isEqual $ cmpPred p1 p2
-
-tcCmpPred :: PredType -> PredType -> Ordering
-tcCmpPred p1 p2 = cmpPred p1 p2
-
-tcEqTypeX :: RnEnv2 -> Type -> Type -> Bool
-tcEqTypeX env t1 t2 = isEqual $ cmpTypeX env t1 t2
-\end{code}
-
-Now here comes the real worker
-
-\begin{code}
-cmpType :: Type -> Type -> Ordering
-cmpType t1 t2 = cmpTypeX rn_env t1 t2
-  where
-    rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType t1 `unionVarSet` tyVarsOfType t2))
-
-cmpTypes :: [Type] -> [Type] -> Ordering
-cmpTypes ts1 ts2 = cmpTypesX rn_env ts1 ts2
-  where
-    rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfTypes ts1 `unionVarSet` tyVarsOfTypes ts2))
-
-cmpPred :: PredType -> PredType -> Ordering
-cmpPred p1 p2 = cmpPredX rn_env p1 p2
-  where
-    rn_env = mkRnEnv2 (mkInScopeSet (tyVarsOfPred p1 `unionVarSet` tyVarsOfPred p2))
-
-cmpTypeX :: RnEnv2 -> Type -> Type -> Ordering	-- Main workhorse
-cmpTypeX env t1 t2 | Just t1' <- tcView t1 = cmpTypeX env t1' t2
-		   | Just t2' <- tcView t2 = cmpTypeX env t1 t2'
-
-cmpTypeX env (TyVarTy tv1)       (TyVarTy tv2)       = rnOccL env tv1 `compare` rnOccR env tv2
-cmpTypeX env (ForAllTy tv1 t1)   (ForAllTy tv2 t2)   = cmpTypeX (rnBndr2 env tv1 tv2) t1 t2
-cmpTypeX env (AppTy s1 t1)       (AppTy s2 t2)       = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
-cmpTypeX env (FunTy s1 t1)       (FunTy s2 t2)       = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
-cmpTypeX env (PredTy p1)         (PredTy p2)         = cmpPredX env p1 p2
-cmpTypeX env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` cmpTypesX env tys1 tys2
-cmpTypeX env t1			(NoteTy _ t2)	     = cmpTypeX env t1 t2
-
-    -- Deal with the rest: TyVarTy < AppTy < FunTy < TyConApp < ForAllTy < PredTy
-cmpTypeX env (AppTy _ _) (TyVarTy _) = GT
-    
-cmpTypeX env (FunTy _ _) (TyVarTy _) = GT
-cmpTypeX env (FunTy _ _) (AppTy _ _) = GT
-    
-cmpTypeX env (TyConApp _ _) (TyVarTy _) = GT
-cmpTypeX env (TyConApp _ _) (AppTy _ _) = GT
-cmpTypeX env (TyConApp _ _) (FunTy _ _) = GT
-    
-cmpTypeX env (ForAllTy _ _) (TyVarTy _)    = GT
-cmpTypeX env (ForAllTy _ _) (AppTy _ _)    = GT
-cmpTypeX env (ForAllTy _ _) (FunTy _ _)    = GT
-cmpTypeX env (ForAllTy _ _) (TyConApp _ _) = GT
-
-cmpTypeX env (PredTy _)   t2		= GT
-
-cmpTypeX env _ _ = LT
-
--------------
-cmpTypesX :: RnEnv2 -> [Type] -> [Type] -> Ordering
-cmpTypesX env []        []        = EQ
-cmpTypesX env (t1:tys1) (t2:tys2) = cmpTypeX env t1 t2 `thenCmp` cmpTypesX env tys1 tys2
-cmpTypesX env []        tys       = LT
-cmpTypesX env ty        []        = GT
-
--------------
-cmpPredX :: RnEnv2 -> PredType -> PredType -> Ordering
-cmpPredX env (IParam n1 ty1) (IParam n2 ty2) = (n1 `compare` n2) `thenCmp` cmpTypeX env ty1 ty2
-	-- Compare types as well as names for implicit parameters
-	-- This comparison is used exclusively (I think) for the
-	-- finite map built in TcSimplify
-cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` cmpTypesX env tys1 tys2
-cmpPredX env (IParam _ _)     (ClassP _ _)     = LT
-cmpPredX env (ClassP _ _)     (IParam _ _)     = GT
-\end{code}
-
-PredTypes are used as a FM key in TcSimplify, 
-so we take the easy path and make them an instance of Ord
-
-\begin{code}
-instance Eq  PredType where { (==)    = tcEqPred }
-instance Ord PredType where { compare = tcCmpPred }
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Type substitutions
-%*									*
-%************************************************************************
-
-\begin{code}
-data TvSubst 		
-  = TvSubst InScopeSet 	-- The in-scope type variables
-	    TvSubstEnv	-- The substitution itself
-			-- See Note [Apply Once]
-
-{- ----------------------------------------------------------
-	 	Note [Apply Once]
-
-We use TvSubsts to instantiate things, and we might instantiate
-	forall a b. ty
-\with the types
-	[a, b], or [b, a].
-So the substition might go [a->b, b->a].  A similar situation arises in Core
-when we find a beta redex like
-	(/\ a /\ b -> e) b a
-Then we also end up with a substition that permutes type variables. Other
-variations happen to; for example [a -> (a, b)].  
-
-	***************************************************
-	*** So a TvSubst must be applied precisely once ***
-	***************************************************
-
-A TvSubst is not idempotent, but, unlike the non-idempotent substitution
-we use during unifications, it must not be repeatedly applied.
--------------------------------------------------------------- -}
-
-
-type TvSubstEnv = TyVarEnv Type
-	-- A TvSubstEnv is used both inside a TvSubst (with the apply-once
-	-- invariant discussed in Note [Apply Once]), and also independently
-	-- in the middle of matching, and unification (see Types.Unify)
-	-- So you have to look at the context to know if it's idempotent or
-	-- apply-once or whatever
-emptyTvSubstEnv :: TvSubstEnv
-emptyTvSubstEnv = emptyVarEnv
-
-composeTvSubst :: InScopeSet -> TvSubstEnv -> TvSubstEnv -> TvSubstEnv
--- (compose env1 env2)(x) is env1(env2(x)); i.e. apply env2 then env1
--- It assumes that both are idempotent
--- Typically, env1 is the refinement to a base substitution env2
-composeTvSubst in_scope env1 env2
-  = env1 `plusVarEnv` mapVarEnv (substTy subst1) env2
-	-- First apply env1 to the range of env2
-	-- Then combine the two, making sure that env1 loses if
-	-- both bind the same variable; that's why env1 is the
-	--  *left* argument to plusVarEnv, because the right arg wins
-  where
-    subst1 = TvSubst in_scope env1
-
-emptyTvSubst = TvSubst emptyInScopeSet emptyVarEnv
-
-isEmptyTvSubst :: TvSubst -> Bool
-isEmptyTvSubst (TvSubst _ env) = isEmptyVarEnv env
-
-mkTvSubst :: InScopeSet -> TvSubstEnv -> TvSubst
-mkTvSubst = TvSubst
-
-getTvSubstEnv :: TvSubst -> TvSubstEnv
-getTvSubstEnv (TvSubst _ env) = env
-
-getTvInScope :: TvSubst -> InScopeSet
-getTvInScope (TvSubst in_scope _) = in_scope
-
-isInScope :: Var -> TvSubst -> Bool
-isInScope v (TvSubst in_scope _) = v `elemInScopeSet` in_scope
-
-notElemTvSubst :: TyVar -> TvSubst -> Bool
-notElemTvSubst tv (TvSubst _ env) = not (tv `elemVarEnv` env)
-
-setTvSubstEnv :: TvSubst -> TvSubstEnv -> TvSubst
-setTvSubstEnv (TvSubst in_scope _) env = TvSubst in_scope env
-
-extendTvInScope :: TvSubst -> [Var] -> TvSubst
-extendTvInScope (TvSubst in_scope env) vars = TvSubst (extendInScopeSetList in_scope vars) env
-
-extendTvSubst :: TvSubst -> TyVar -> Type -> TvSubst
-extendTvSubst (TvSubst in_scope env) tv ty = TvSubst in_scope (extendVarEnv env tv ty)
-
-extendTvSubstList :: TvSubst -> [TyVar] -> [Type] -> TvSubst
-extendTvSubstList (TvSubst in_scope env) tvs tys 
-  = TvSubst in_scope (extendVarEnvList env (tvs `zip` tys))
-
--- mkOpenTvSubst and zipOpenTvSubst generate the in-scope set from
--- the types given; but it's just a thunk so with a bit of luck
--- it'll never be evaluated
-
-mkOpenTvSubst :: TvSubstEnv -> TvSubst
-mkOpenTvSubst env = TvSubst (mkInScopeSet (tyVarsOfTypes (varEnvElts env))) env
-
-zipOpenTvSubst :: [TyVar] -> [Type] -> TvSubst
-zipOpenTvSubst tyvars tys 
-#ifdef DEBUG
-  | length tyvars /= length tys
-  = pprTrace "zipOpenTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst
-  | otherwise
-#endif
-  = TvSubst (mkInScopeSet (tyVarsOfTypes tys)) (zipTyEnv tyvars tys)
-
--- mkTopTvSubst is called when doing top-level substitutions.
--- Here we expect that the free vars of the range of the
--- substitution will be empty.
-mkTopTvSubst :: [(TyVar, Type)] -> TvSubst
-mkTopTvSubst prs = TvSubst emptyInScopeSet (mkVarEnv prs)
-
-zipTopTvSubst :: [TyVar] -> [Type] -> TvSubst
-zipTopTvSubst tyvars tys 
-#ifdef DEBUG
-  | length tyvars /= length tys
-  = pprTrace "zipOpenTvSubst" (ppr tyvars $$ ppr tys) emptyTvSubst
-  | otherwise
-#endif
-  = TvSubst emptyInScopeSet (zipTyEnv tyvars tys)
-
-zipTyEnv :: [TyVar] -> [Type] -> TvSubstEnv
-zipTyEnv tyvars tys
-#ifdef DEBUG
-  | length tyvars /= length tys
-  = pprTrace "mkTopTvSubst" (ppr tyvars $$ ppr tys) emptyVarEnv
-  | otherwise
-#endif
-  = zip_ty_env tyvars tys emptyVarEnv
-
--- Later substitutions in the list over-ride earlier ones, 
--- but there should be no loops
-zip_ty_env []       []       env = env
-zip_ty_env (tv:tvs) (ty:tys) env = zip_ty_env tvs tys (extendVarEnv env tv ty)
-	-- There used to be a special case for when 
-	--	ty == TyVarTy tv
-	-- (a not-uncommon case) in which case the substitution was dropped.
-	-- But the type-tidier changes the print-name of a type variable without
-	-- changing the unique, and that led to a bug.   Why?  Pre-tidying, we had 
-	-- a type {Foo t}, where Foo is a one-method class.  So Foo is really a newtype.
-	-- And it happened that t was the type variable of the class.  Post-tiding, 
-	-- it got turned into {Foo t2}.  The ext-core printer expanded this using
-	-- sourceTypeRep, but that said "Oh, t == t2" because they have the same unique,
-	-- and so generated a rep type mentioning t not t2.  
-	--
-	-- Simplest fix is to nuke the "optimisation"
-zip_ty_env tvs      tys      env   = pprTrace "Var/Type length mismatch: " (ppr tvs $$ ppr tys) env
--- zip_ty_env _ _ env = env
-
-instance Outputable TvSubst where
-  ppr (TvSubst ins env) 
-    = sep[ ptext SLIT("<TvSubst"),
-	   nest 2 (ptext SLIT("In scope:") <+> ppr ins), 
-	   nest 2 (ptext SLIT("Env:") <+> ppr env) ]
-\end{code}
-
-%************************************************************************
-%*									*
-		Performing type substitutions
-%*									*
-%************************************************************************
-
-\begin{code}
-substTyWith :: [TyVar] -> [Type] -> Type -> Type
-substTyWith tvs tys = ASSERT( length tvs == length tys )
-		      substTy (zipOpenTvSubst tvs tys)
-
-substTy :: TvSubst -> Type  -> Type
-substTy subst ty | isEmptyTvSubst subst = ty
-		 | otherwise	        = subst_ty subst ty
-
-substTys :: TvSubst -> [Type] -> [Type]
-substTys subst tys | isEmptyTvSubst subst = tys
-	           | otherwise	          = map (subst_ty subst) tys
-
-substTheta :: TvSubst -> ThetaType -> ThetaType
-substTheta subst theta
-  | isEmptyTvSubst subst = theta
-  | otherwise	         = map (substPred subst) theta
-
-substPred :: TvSubst -> PredType -> PredType
-substPred subst (IParam n ty)     = IParam n (subst_ty subst ty)
-substPred subst (ClassP clas tys) = ClassP clas (map (subst_ty subst) tys)
-
-deShadowTy :: TyVarSet -> Type -> Type	-- Remove any nested binders mentioning tvs
-deShadowTy tvs ty 
-  = subst_ty (mkTvSubst in_scope emptyTvSubstEnv) ty
-  where
-    in_scope = mkInScopeSet tvs
-
--- Note that the in_scope set is poked only if we hit a forall
--- so it may often never be fully computed 
-subst_ty subst ty
-   = go ty
-  where
-    go (TyVarTy tv)   		   = substTyVar subst tv
-    go (TyConApp tc tys)	   = let args = map go tys
-				     in  args `seqList` TyConApp tc args
-
-    go (PredTy p)  		   = PredTy $! (substPred subst p)
-
-    go (NoteTy (FTVNote _) ty2)    = go ty2		-- Discard the free tyvar note
-
-    go (FunTy arg res)   	   = (FunTy $! (go arg)) $! (go res)
-    go (AppTy fun arg)   	   = mkAppTy (go fun) $! (go arg)
-		-- The mkAppTy smart constructor is important
-		-- we might be replacing (a Int), represented with App
-		-- by [Int], represented with TyConApp
-    go (ForAllTy tv ty)		   = case substTyVarBndr subst tv of
-					(subst', tv') -> ForAllTy tv' $! (subst_ty subst' ty)
-
-substTyVar :: TvSubst -> TyVar  -> Type
-substTyVar subst tv
-  = case lookupTyVar subst tv of
-	Nothing  -> TyVarTy tv
-       	Just ty' -> ty'	-- See Note [Apply Once]
-
-lookupTyVar :: TvSubst -> TyVar  -> Maybe Type
-lookupTyVar (TvSubst in_scope env) tv = lookupVarEnv env tv
-
-substTyVarBndr :: TvSubst -> TyVar -> (TvSubst, TyVar)	
-substTyVarBndr subst@(TvSubst in_scope env) old_var
-  | old_var == new_var	-- No need to clone
-			-- But we *must* zap any current substitution for the variable.
-			--  For example:
-			--	(\x.e) with id_subst = [x |-> e']
-			-- Here we must simply zap the substitution for x
-			--
-			-- The new_id isn't cloned, but it may have a different type
-			-- etc, so we must return it, not the old id
-  = (TvSubst (in_scope `extendInScopeSet` new_var) 
-	     (delVarEnv env old_var),
-     new_var)
-
-  | otherwise	-- The new binder is in scope so
-		-- we'd better rename it away from the in-scope variables
-		-- Extending the substitution to do this renaming also
-		-- has the (correct) effect of discarding any existing
-		-- substitution for that variable
-  = (TvSubst (in_scope `extendInScopeSet` new_var) 
-	     (extendVarEnv env old_var (TyVarTy new_var)),
-     new_var)
-  where
-    new_var = uniqAway in_scope old_var
-	-- The uniqAway part makes sure the new variable is not already in scope
-\end{code}
diff --git a/ghc/compiler/types/TypeRep.hi-boot-5 b/ghc/compiler/types/TypeRep.hi-boot-5
deleted file mode 100644
index 80452e4d2f..0000000000
--- a/ghc/compiler/types/TypeRep.hi-boot-5
+++ /dev/null
@@ -1,9 +0,0 @@
-__interface TypeRep 1 0 where
-__export TypeRep Type SourceType PredType Kind SuperKind TyThing ;
-1 data Type ;
-1 data SourceType ;
-1 data TyThing ;
-1 type PredType = SourceType ;
-1 type Kind = Type ;
-1 type SuperKind = Type ;
-
diff --git a/ghc/compiler/types/TypeRep.hi-boot-6 b/ghc/compiler/types/TypeRep.hi-boot-6
deleted file mode 100644
index 55d80a6acc..0000000000
--- a/ghc/compiler/types/TypeRep.hi-boot-6
+++ /dev/null
@@ -1,6 +0,0 @@
-module TypeRep where
-
-data Type
-data PredType
-data TyThing
-
diff --git a/ghc/compiler/types/TypeRep.lhs b/ghc/compiler/types/TypeRep.lhs
deleted file mode 100644
index 7bb863a210..0000000000
--- a/ghc/compiler/types/TypeRep.lhs
+++ /dev/null
@@ -1,409 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1998
-%
-\section[TypeRep]{Type - friends' interface}
-
-\begin{code}
-module TypeRep (
-	TyThing(..), 
-	Type(..), TyNote(..), 		-- Representation visible 
-	PredType(..),	 		-- to friends
-	
- 	Kind, ThetaType,		-- Synonyms
-
-	funTyCon,
-
-	-- Pretty-printing
-	pprType, pprParendType, pprTyThingCategory,
-	pprPred, pprTheta, pprThetaArrow, pprClassPred,
-
-	-- Re-export fromKind
-	liftedTypeKind, unliftedTypeKind, openTypeKind,
-	isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind, 
-	mkArrowKind, mkArrowKinds,
-	pprKind, pprParendKind
-    ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} DataCon( DataCon, dataConName )
-
--- friends:
-import Kind
-import Var	  ( Var, Id, TyVar, tyVarKind )
-import VarSet     ( TyVarSet )
-import Name	  ( Name, NamedThing(..), BuiltInSyntax(..), mkWiredInName )
-import OccName	  ( mkOccNameFS, tcName, parenSymOcc )
-import BasicTypes ( IPName, tupleParens )
-import TyCon	  ( TyCon, mkFunTyCon, tyConArity, tupleTyConBoxity, isTupleTyCon, isRecursiveTyCon, isNewTyCon )
-import Class	  ( Class )
-
--- others
-import PrelNames  ( gHC_PRIM, funTyConKey, listTyConKey, parrTyConKey, hasKey )
-import Outputable
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Type Classifications}
-%*									*
-%************************************************************************
-
-A type is
-
-	*unboxed*	iff its representation is other than a pointer
-			Unboxed types are also unlifted.
-
-	*lifted*	A type is lifted iff it has bottom as an element.
-			Closures always have lifted types:  i.e. any
-			let-bound identifier in Core must have a lifted
-			type.  Operationally, a lifted object is one that
-			can be entered.
-
-			Only lifted types may be unified with a type variable.
-
-	*algebraic*	A type with one or more constructors, whether declared
-			with "data" or "newtype".   
-			An algebraic type is one that can be deconstructed
-			with a case expression.  
-			*NOT* the same as lifted types,  because we also 
-			include unboxed tuples in this classification.
-
-	*data*		A type declared with "data".  Also boxed tuples.
-
-	*primitive*	iff it is a built-in type that can't be expressed
-			in Haskell.
-
-Currently, all primitive types are unlifted, but that's not necessarily
-the case.  (E.g. Int could be primitive.)
-
-Some primitive types are unboxed, such as Int#, whereas some are boxed
-but unlifted (such as ByteArray#).  The only primitive types that we
-classify as algebraic are the unboxed tuples.
-
-examples of type classifications:
-
-Type		primitive	boxed		lifted		algebraic    
------------------------------------------------------------------------------
-Int#,		Yes		No		No		No
-ByteArray#	Yes		Yes		No		No
-(# a, b #)	Yes		No		No		Yes
-(  a, b  )	No		Yes		Yes		Yes
-[a]		No		Yes		Yes		Yes
-
-
-
-	----------------------
-	A note about newtypes
-	----------------------
-
-Consider
-	newtype N = MkN Int
-
-Then we want N to be represented as an Int, and that's what we arrange.
-The front end of the compiler [TcType.lhs] treats N as opaque, 
-the back end treats it as transparent [Type.lhs].
-
-There's a bit of a problem with recursive newtypes
-	newtype P = MkP P
-	newtype Q = MkQ (Q->Q)
-
-Here the 'implicit expansion' we get from treating P and Q as transparent
-would give rise to infinite types, which in turn makes eqType diverge.
-Similarly splitForAllTys and splitFunTys can get into a loop.  
-
-Solution: 
-
-* Newtypes are always represented using TyConApp.
-
-* For non-recursive newtypes, P, treat P just like a type synonym after 
-  type-checking is done; i.e. it's opaque during type checking (functions
-  from TcType) but transparent afterwards (functions from Type).  
-  "Treat P as a type synonym" means "all functions expand NewTcApps 
-  on the fly".
-
-  Applications of the data constructor P simply vanish:
-	P x = x
-  
-
-* For recursive newtypes Q, treat the Q and its representation as 
-  distinct right through the compiler.  Applications of the data consructor
-  use a coerce:
-	Q = \(x::Q->Q). coerce Q x
-  They are rare, so who cares if they are a tiny bit less efficient.
-
-The typechecker (TcTyDecls) identifies enough type construtors as 'recursive'
-to cut all loops.  The other members of the loop may be marked 'non-recursive'.
-
-
-%************************************************************************
-%*									*
-\subsection{The data type}
-%*									*
-%************************************************************************
-
-
-\begin{code}
-data Type
-  = TyVarTy TyVar	
-
-  | AppTy
-	Type		-- Function is *not* a TyConApp
-	Type		-- It must be another AppTy, or TyVarTy
-			-- (or NoteTy of these)
-
-  | TyConApp		-- Application of a TyCon, including newtypes *and* synonyms
-	TyCon		--  *Invariant* saturated appliations of FunTyCon and
-			-- 	synonyms have their own constructors, below.
-			-- However, *unsaturated* FunTyCons do appear as TyConApps.  
-			-- 
-	[Type]		-- Might not be saturated.
-			-- Even type synonyms are not necessarily saturated;
-			-- for example unsaturated type synonyms can appear as the 
-			-- RHS of a type synonym.
-
-  | FunTy		-- Special case of TyConApp: TyConApp FunTyCon [t1,t2]
-	Type
-	Type
-
-  | ForAllTy		-- A polymorphic type
-	TyVar
-	Type	
-
-  | PredTy		-- A high level source type 
-	PredType	-- ...can be expanded to a representation type...
-
-  | NoteTy 		-- A type with a note attached
-	TyNote
-	Type		-- The expanded version
-
-data TyNote = FTVNote TyVarSet	-- The free type variables of the noted expression
-\end{code}
-
--------------------------------------
- 		Source types
-
-A type of the form
-	PredTy p
-represents a value whose type is the Haskell predicate p, 
-where a predicate is what occurs before the '=>' in a Haskell type.
-It can be expanded into its representation, but: 
-
-	* The type checker must treat it as opaque
-	* The rest of the compiler treats it as transparent
-
-Consider these examples:
-	f :: (Eq a) => a -> Int
-	g :: (?x :: Int -> Int) => a -> Int
-	h :: (r\l) => {r} => {l::Int | r}
-
-Here the "Eq a" and "?x :: Int -> Int" and "r\l" are all called *predicates*
-Predicates are represented inside GHC by PredType:
-
-\begin{code}
-data PredType 
-  = ClassP Class [Type]		-- Class predicate
-  | IParam (IPName Name) Type	-- Implicit parameter
-
-type ThetaType = [PredType]
-\end{code}
-
-(We don't support TREX records yet, but the setup is designed
-to expand to allow them.)
-
-A Haskell qualified type, such as that for f,g,h above, is
-represented using 
-	* a FunTy for the double arrow
-	* with a PredTy as the function argument
-
-The predicate really does turn into a real extra argument to the
-function.  If the argument has type (PredTy p) then the predicate p is
-represented by evidence (a dictionary, for example, of type (predRepTy p).
-
-
-%************************************************************************
-%*									*
-			TyThing
-%*									*
-%************************************************************************
-
-Despite the fact that DataCon has to be imported via a hi-boot route, 
-this module seems the right place for TyThing, because it's needed for
-funTyCon and all the types in TysPrim.
-
-\begin{code}
-data TyThing = AnId     Id
-	     | ADataCon DataCon
-	     | ATyCon   TyCon
-	     | AClass   Class
-
-instance Outputable TyThing where
-  ppr thing = pprTyThingCategory thing <+> quotes (ppr (getName thing))
-
-pprTyThingCategory :: TyThing -> SDoc
-pprTyThingCategory (ATyCon _) 	= ptext SLIT("Type constructor")
-pprTyThingCategory (AClass _)   = ptext SLIT("Class")
-pprTyThingCategory (AnId   _)   = ptext SLIT("Identifier")
-pprTyThingCategory (ADataCon _) = ptext SLIT("Data constructor")
-
-instance NamedThing TyThing where	-- Can't put this with the type
-  getName (AnId id)     = getName id	-- decl, because the DataCon instance
-  getName (ATyCon tc)   = getName tc	-- isn't visible there
-  getName (AClass cl)   = getName cl
-  getName (ADataCon dc) = dataConName dc
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Wired-in type constructors
-%*									*
-%************************************************************************
-
-We define a few wired-in type constructors here to avoid module knots
-
-\begin{code}
-funTyCon = mkFunTyCon funTyConName (mkArrowKinds [argTypeKind, openTypeKind] liftedTypeKind)
-	-- You might think that (->) should have type (?? -> ? -> *), and you'd be right
-	-- But if we do that we get kind errors when saying
-	--	instance Control.Arrow (->)
-	-- becuase the expected kind is (*->*->*).  The trouble is that the
-	-- expected/actual stuff in the unifier does not go contra-variant, whereas
-	-- the kind sub-typing does.  Sigh.  It really only matters if you use (->) in
-	-- a prefix way, thus:  (->) Int# Int#.  And this is unusual.
-
-funTyConName = mkWiredInName gHC_PRIM
-			(mkOccNameFS tcName FSLIT("(->)"))
-			funTyConKey
-			Nothing 		-- No parent object
-			(ATyCon funTyCon)	-- Relevant TyCon
-			BuiltInSyntax
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The external interface}
-%*									*
-%************************************************************************
-
-@pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is
-defined to use this.  @pprParendType@ is the same, except it puts
-parens around the type, except for the atomic cases.  @pprParendType@
-works just by setting the initial context precedence very high.
-
-\begin{code}
-data Prec = TopPrec 	-- No parens
-	  | FunPrec 	-- Function args; no parens for tycon apps
-	  | TyConPrec 	-- Tycon args; no parens for atomic
-	  deriving( Eq, Ord )
-
-maybeParen :: Prec -> Prec -> SDoc -> SDoc
-maybeParen ctxt_prec inner_prec pretty
-  | ctxt_prec < inner_prec = pretty
-  | otherwise		   = parens pretty
-
-------------------
-pprType, pprParendType :: Type -> SDoc
-pprType       ty = ppr_type TopPrec   ty
-pprParendType ty = ppr_type TyConPrec ty
-
-------------------
-pprPred :: PredType -> SDoc
-pprPred (ClassP cls tys) = pprClassPred cls tys
-pprPred (IParam ip ty)   = ppr ip <> dcolon <> pprType ty
-
-pprClassPred :: Class -> [Type] -> SDoc
-pprClassPred clas tys = parenSymOcc (getOccName clas) (ppr clas) 
-			<+> sep (map pprParendType tys)
-
-pprTheta :: ThetaType -> SDoc
-pprTheta theta = parens (sep (punctuate comma (map pprPred theta)))
-
-pprThetaArrow :: ThetaType -> SDoc
-pprThetaArrow theta 
-  | null theta = empty
-  | otherwise  = parens (sep (punctuate comma (map pprPred theta))) <+> ptext SLIT("=>")
-
-------------------
-instance Outputable Type where
-    ppr ty = pprType ty
-
-instance Outputable PredType where
-    ppr = pprPred
-
-instance Outputable name => OutputableBndr (IPName name) where
-    pprBndr _ n = ppr n	-- Simple for now
-
-------------------
-	-- OK, here's the main printer
-
-ppr_type :: Prec -> Type -> SDoc
-ppr_type p (TyVarTy tv)       = ppr tv
-ppr_type p (PredTy pred)      = braces (ppr pred)
-ppr_type p (NoteTy other ty2) = ppr_type p ty2
-ppr_type p (TyConApp tc tys)  = ppr_tc_app p tc tys
-
-ppr_type p (AppTy t1 t2) = maybeParen p TyConPrec $
-			   pprType t1 <+> ppr_type TyConPrec t2
-
-ppr_type p ty@(ForAllTy _ _)       = ppr_forall_type p ty
-ppr_type p ty@(FunTy (PredTy _) _) = ppr_forall_type p ty
-
-ppr_type p (FunTy ty1 ty2)
-  = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
-    maybeParen p FunPrec $
-    sep (ppr_type FunPrec ty1 : ppr_fun_tail ty2)
-  where
-    ppr_fun_tail (FunTy ty1 ty2) = (arrow <+> ppr_type FunPrec ty1) : ppr_fun_tail ty2
-    ppr_fun_tail other_ty        = [arrow <+> pprType other_ty]
-
-ppr_forall_type :: Prec -> Type -> SDoc
-ppr_forall_type p ty
-  = maybeParen p FunPrec $
-    sep [pprForAll tvs, pprThetaArrow ctxt, pprType tau]
-  where
-    (tvs,  rho) = split1 [] ty
-    (ctxt, tau) = split2 [] rho
-
-    split1 tvs (ForAllTy tv ty) = split1 (tv:tvs) ty
-    split1 tvs (NoteTy _ ty)    = split1 tvs ty
-    split1 tvs ty		= (reverse tvs, ty)
- 
-    split2 ps (NoteTy _ arg 	-- Rather a disgusting case
-	       `FunTy` res) 	      = split2 ps (arg `FunTy` res)
-    split2 ps (PredTy p `FunTy` ty)   = split2 (p:ps) ty
-    split2 ps (NoteTy _ ty) 	      = split2 ps ty
-    split2 ps ty		      = (reverse ps, ty)
-
-ppr_tc_app :: Prec -> TyCon -> [Type] -> SDoc
-ppr_tc_app p tc [] 
-  = ppr_tc tc
-ppr_tc_app p tc [ty] 
-  | tc `hasKey` listTyConKey = brackets (pprType ty)
-  | tc `hasKey` parrTyConKey = ptext SLIT("[:") <> pprType ty <> ptext SLIT(":]")
-ppr_tc_app p tc tys
-  | isTupleTyCon tc && tyConArity tc == length tys
-  = tupleParens (tupleTyConBoxity tc) (sep (punctuate comma (map pprType tys)))
-  | otherwise
-  = maybeParen p TyConPrec $
-    ppr_tc tc <+> sep (map (ppr_type TyConPrec) tys)
-
-ppr_tc :: TyCon -> SDoc
-ppr_tc tc = parenSymOcc (getOccName tc) (pp_nt_debug <> ppr tc)
-  where
-   pp_nt_debug | isNewTyCon tc = ifPprDebug (if isRecursiveTyCon tc 
-				             then ptext SLIT("<recnt>")
-					     else ptext SLIT("<nt>"))
-	       | otherwise     = empty
-
--------------------
-pprForAll []  = empty
-pprForAll tvs = ptext SLIT("forall") <+> sep (map pprTvBndr tvs) <> dot
-
-pprTvBndr tv | isLiftedTypeKind kind = ppr tv
-	     | otherwise	     = parens (ppr tv <+> dcolon <+> pprKind kind)
-	     where
-	       kind = tyVarKind tv
-\end{code}
-
diff --git a/ghc/compiler/types/TypeRep.lhs-boot b/ghc/compiler/types/TypeRep.lhs-boot
deleted file mode 100644
index b99fdd3321..0000000000
--- a/ghc/compiler/types/TypeRep.lhs-boot
+++ /dev/null
@@ -1,8 +0,0 @@
-\begin{code}
-module TypeRep where
-
-data Type
-data PredType
-data TyThing
-\end{code}
-
diff --git a/ghc/compiler/types/Unify.lhs b/ghc/compiler/types/Unify.lhs
deleted file mode 100644
index f60c7bee61..0000000000
--- a/ghc/compiler/types/Unify.lhs
+++ /dev/null
@@ -1,536 +0,0 @@
-\begin{code}
-module Unify ( 
-	-- Matching and unification
-	tcMatchTys, tcMatchTyX, ruleMatchTyX, tcMatchPreds, MatchEnv(..), 
-
-	tcUnifyTys, 
-
-	gadtRefineTys, BindFlag(..),
-
-	coreRefineTys, TypeRefinement,
-
-	-- Re-export
-	MaybeErr(..)
-   ) where
-
-#include "HsVersions.h"
-
-import Var		( Var, TyVar, tyVarKind )
-import VarEnv
-import VarSet
-import Kind		( isSubKind )
-import Type		( typeKind, tyVarsOfType, tyVarsOfTypes, tyVarsOfTheta, mkTyVarTys,
-			  TvSubstEnv, emptyTvSubstEnv, TvSubst(..), substTy, tcEqTypeX,
-			  mkOpenTvSubst, tcView )
-import TypeRep          ( Type(..), PredType(..), funTyCon )
-import DataCon 		( DataCon, dataConInstResTy )
-import Util		( snocView )
-import ErrUtils		( Message )
-import Outputable
-import Maybes
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Matching
-%*									*
-%************************************************************************
-
-
-Matching is much tricker than you might think.
-
-1. The substitution we generate binds the *template type variables*
-   which are given to us explicitly.
-
-2. We want to match in the presence of foralls; 
-	e.g 	(forall a. t1) ~ (forall b. t2)
-
-   That is what the RnEnv2 is for; it does the alpha-renaming
-   that makes it as if a and b were the same variable.
-   Initialising the RnEnv2, so that it can generate a fresh
-   binder when necessary, entails knowing the free variables of
-   both types.
-
-3. We must be careful not to bind a template type variable to a
-   locally bound variable.  E.g.
-	(forall a. x) ~ (forall b. b)
-   where x is the template type variable.  Then we do not want to
-   bind x to a/b!  This is a kind of occurs check.
-   The necessary locals accumulate in the RnEnv2.
-
-
-\begin{code}
-data MatchEnv
-  = ME	{ me_tmpls :: VarSet	-- Template tyvars
- 	, me_env   :: RnEnv2	-- Renaming envt for nested foralls
-	}			--   In-scope set includes template tyvars
-
-tcMatchTys :: TyVarSet		-- Template tyvars
-	 -> [Type]		-- Template
-	 -> [Type]		-- Target
-	 -> Maybe TvSubst	-- One-shot; in principle the template
-				-- variables could be free in the target
-
-tcMatchTys tmpls tys1 tys2
-  = case match_tys menv emptyTvSubstEnv tys1 tys2 of
-	Just subst_env -> Just (TvSubst in_scope subst_env)
-	Nothing	       -> Nothing
-  where
-    menv     = ME { me_tmpls = tmpls, me_env = mkRnEnv2 in_scope }
-    in_scope = mkInScopeSet (tmpls `unionVarSet` tyVarsOfTypes tys2)
-	-- We're assuming that all the interesting 
-	-- tyvars in tys1 are in tmpls
-
--- This is similar, but extends a substitution
-tcMatchTyX :: TyVarSet 		-- Template tyvars
-	   -> TvSubst		-- Substitution to extend
-	   -> Type		-- Template
-	   -> Type		-- Target
-	   -> Maybe TvSubst
-tcMatchTyX tmpls (TvSubst in_scope subst_env) ty1 ty2
-  = case match menv subst_env ty1 ty2 of
-	Just subst_env -> Just (TvSubst in_scope subst_env)
-	Nothing	       -> Nothing
-  where
-    menv = ME {me_tmpls = tmpls, me_env = mkRnEnv2 in_scope}
-
-tcMatchPreds
-	:: [TyVar]			-- Bind these
-	-> [PredType] -> [PredType]
-   	-> Maybe TvSubstEnv
-tcMatchPreds tmpls ps1 ps2
-  = match_list (match_pred menv) emptyTvSubstEnv ps1 ps2
-  where
-    menv = ME { me_tmpls = mkVarSet tmpls, me_env = mkRnEnv2 in_scope_tyvars }
-    in_scope_tyvars = mkInScopeSet (tyVarsOfTheta ps1 `unionVarSet` tyVarsOfTheta ps2)
-
--- This one is called from the expression matcher, which already has a MatchEnv in hand
-ruleMatchTyX :: MatchEnv 
-	 -> TvSubstEnv		-- Substitution to extend
-	 -> Type		-- Template
-	 -> Type		-- Target
-	 -> Maybe TvSubstEnv
-
-ruleMatchTyX menv subst ty1 ty2 = match menv subst ty1 ty2	-- Rename for export
-\end{code}
-
-Now the internals of matching
-
-\begin{code}
-match :: MatchEnv	-- For the most part this is pushed downwards
-      -> TvSubstEnv 	-- Substitution so far:
-			--   Domain is subset of template tyvars
-			--   Free vars of range is subset of 
-			--	in-scope set of the RnEnv2
-      -> Type -> Type	-- Template and target respectively
-      -> Maybe TvSubstEnv
--- This matcher works on source types; that is, 
--- it respects NewTypes and PredType
-
-match menv subst ty1 ty2 | Just ty1' <- tcView ty1 = match menv subst ty1' ty2
-match menv subst ty1 ty2 | Just ty2' <- tcView ty2 = match menv subst ty1 ty2'
-
-match menv subst (TyVarTy tv1) ty2
-  | tv1 `elemVarSet` me_tmpls menv
-  = case lookupVarEnv subst tv1' of
-	Nothing | any (inRnEnvR rn_env) (varSetElems (tyVarsOfType ty2))
-		-> Nothing	-- Occurs check
-		| not (typeKind ty2 `isSubKind` tyVarKind tv1)
-		-> Nothing	-- Kind mis-match
-		| otherwise
-		-> Just (extendVarEnv subst tv1 ty2)
-
-	Just ty1' | tcEqTypeX (nukeRnEnvL rn_env) ty1' ty2
-		-- ty1 has no locally-bound variables, hence nukeRnEnvL
-		-- Note tcEqType...we are doing source-type matching here
-		  -> Just subst
-
-	other -> Nothing
-
-   | otherwise	-- tv1 is not a template tyvar
-   = case ty2 of
-	TyVarTy tv2 | tv1' == rnOccR rn_env tv2 -> Just subst
-	other					-> Nothing
-  where
-    rn_env = me_env menv
-    tv1' = rnOccL rn_env tv1
-
-match menv subst (ForAllTy tv1 ty1) (ForAllTy tv2 ty2) 
-  = match menv' subst ty1 ty2
-  where		-- Use the magic of rnBndr2 to go under the binders
-    menv' = menv { me_env = rnBndr2 (me_env menv) tv1 tv2 }
-
-match menv subst (PredTy p1) (PredTy p2) 
-  = match_pred menv subst p1 p2
-match menv subst (TyConApp tc1 tys1) (TyConApp tc2 tys2) 
-  | tc1 == tc2 = match_tys menv subst tys1 tys2
-match menv subst (FunTy ty1a ty1b) (FunTy ty2a ty2b) 
-  = do { subst' <- match menv subst ty1a ty2a
-       ; match menv subst' ty1b ty2b }
-match menv subst (AppTy ty1a ty1b) ty2
-  | Just (ty2a, ty2b) <- repSplitAppTy_maybe ty2
-  = do { subst' <- match menv subst ty1a ty2a
-       ; match menv subst' ty1b ty2b }
-
-match menv subst ty1 ty2
-  = Nothing
-
---------------
-match_tys menv subst tys1 tys2 = match_list (match menv) subst tys1 tys2
-
---------------
-match_list :: (TvSubstEnv -> a -> a -> Maybe TvSubstEnv)
-	   -> TvSubstEnv -> [a] -> [a] -> Maybe TvSubstEnv
-match_list fn subst []         []	  = Just subst
-match_list fn subst (ty1:tys1) (ty2:tys2) = do	{ subst' <- fn subst ty1 ty2
-						; match_list fn subst' tys1 tys2 }
-match_list fn subst tys1       tys2 	  = Nothing	
-
---------------
-match_pred menv subst (ClassP c1 tys1) (ClassP c2 tys2)
-  | c1 == c2 = match_tys menv subst tys1 tys2
-match_pred menv subst (IParam n1 t1) (IParam n2 t2)
-  | n1 == n2 = match menv subst t1 t2
-match_pred menv subst p1 p2 = Nothing
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Unification
-%*									*
-%************************************************************************
-
-\begin{code}
-tcUnifyTys :: (TyVar -> BindFlag)
-	   -> [Type] -> [Type]
-	   -> Maybe TvSubst	-- A regular one-shot substitution
--- The two types may have common type variables, and indeed do so in the
--- second call to tcUnifyTys in FunDeps.checkClsFD
-tcUnifyTys bind_fn tys1 tys2
-  = maybeErrToMaybe $ initUM bind_fn $
-    do { subst_env <- unify_tys emptyTvSubstEnv tys1 tys2
-
-	-- Find the fixed point of the resulting non-idempotent substitution
-	; let in_scope	      = mkInScopeSet (tvs1 `unionVarSet` tvs2)
-	      subst  	      = TvSubst in_scope subst_env_fixpt
-	      subst_env_fixpt = mapVarEnv (substTy subst) subst_env
-	; return subst }
-  where
-    tvs1 = tyVarsOfTypes tys1
-    tvs2 = tyVarsOfTypes tys2
-
-----------------------------
-coreRefineTys :: DataCon -> [TyVar]	-- Case pattern (con tv1 .. tvn ...)
-	      -> Type			-- Type of scrutinee
-	      -> Maybe TypeRefinement
-
-type TypeRefinement = (TvSubstEnv, Bool)
-	-- The Bool is True iff all the bindings in the 
-	-- env are for the pattern type variables
-	-- In this case, there is no type refinement 
-	-- for already-in-scope type variables
-
--- Used by Core Lint and the simplifier.
-coreRefineTys con tvs scrut_ty
-  = maybeErrToMaybe $ initUM (tryToBind tv_set) $
-    do	{ 	-- Run the unifier, starting with an empty env
-	; subst_env <- unify emptyTvSubstEnv pat_res_ty scrut_ty
-
-	-- Find the fixed point of the resulting non-idempotent substitution
-	; let subst  	      = mkOpenTvSubst subst_env_fixpt
-	      subst_env_fixpt = mapVarEnv (substTy subst) subst_env
-		
-	; return (subst_env_fixpt, all_bound_here subst_env) }
-  where
-    pat_res_ty = dataConInstResTy con (mkTyVarTys tvs)
-
-	-- 'tvs' are the tyvars bound by the pattern
-    tv_set 	       = mkVarSet tvs
-    all_bound_here env = all bound_here (varEnvKeys env)
-    bound_here uniq    = elemVarSetByKey uniq tv_set
-
--- This version is used by the type checker
-gadtRefineTys :: TvSubst 
-	      -> DataCon -> [TyVar]
-	      -> [Type] -> [Type]	
-	      -> MaybeErr Message (TvSubst, Bool)
--- The bool is True <=> the only *new* bindings are for pat_tvs
-
-gadtRefineTys (TvSubst in_scope env1) con pat_tvs pat_tys ctxt_tys
-  = initUM (tryToBind tv_set) $
-    do	{ 	-- Run the unifier, starting with an empty env
-	; env2 <- unify_tys env1 pat_tys ctxt_tys
-
-	-- Find the fixed point of the resulting non-idempotent substitution
-	; let subst2  	      = TvSubst in_scope subst_env_fixpt
-	      subst_env_fixpt = mapVarEnv (substTy subst2) env2
-		
-	; return (subst2, all_bound_here env2) }
-  where
-	-- 'tvs' are the tyvars bound by the pattern
-    tv_set 	       = mkVarSet pat_tvs
-    all_bound_here env = all bound_here (varEnvKeys env)
-    bound_here uniq    = elemVarEnvByKey uniq env1 || elemVarSetByKey uniq tv_set
-	-- The bool is True <=> the only *new* bindings are for pat_tvs
-
-----------------------------
-tryToBind :: TyVarSet -> TyVar -> BindFlag
-tryToBind tv_set tv | tv `elemVarSet` tv_set = BindMe
-		    | otherwise	             = AvoidMe
-\end{code}
-
-
-%************************************************************************
-%*									*
-		The workhorse
-%*									*
-%************************************************************************
-
-\begin{code}
-unify :: TvSubstEnv		-- An existing substitution to extend
-      -> Type -> Type           -- Types to be unified
-      -> UM TvSubstEnv		-- Just the extended substitution, 
-				-- Nothing if unification failed
--- We do not require the incoming substitution to be idempotent,
--- nor guarantee that the outgoing one is.  That's fixed up by
--- the wrappers.
-
--- Respects newtypes, PredTypes
-
-unify subst ty1 ty2 = -- pprTrace "unify" (ppr subst <+> pprParendType ty1 <+> pprParendType ty2) $
-		      unify_ subst ty1 ty2
-
--- in unify_, any NewTcApps/Preds should be taken at face value
-unify_ subst (TyVarTy tv1) ty2  = uVar False subst tv1 ty2
-unify_ subst ty1 (TyVarTy tv2)  = uVar True  subst tv2 ty1
-
-unify_ subst ty1 ty2 | Just ty1' <- tcView ty1 = unify subst ty1' ty2
-unify_ subst ty1 ty2 | Just ty2' <- tcView ty2 = unify subst ty1 ty2'
-
-unify_ subst (PredTy p1) (PredTy p2) = unify_pred subst p1 p2
-
-unify_ subst t1@(TyConApp tyc1 tys1) t2@(TyConApp tyc2 tys2) 
-  | tyc1 == tyc2 = unify_tys subst tys1 tys2
-
-unify_ subst (FunTy ty1a ty1b) (FunTy ty2a ty2b) 
-  = do { subst' <- unify subst ty1a ty2a
-       ; unify subst' ty1b ty2b }
-
-	-- Applications need a bit of care!
-	-- They can match FunTy and TyConApp, so use splitAppTy_maybe
-	-- NB: we've already dealt with type variables and Notes,
-	-- so if one type is an App the other one jolly well better be too
-unify_ subst (AppTy ty1a ty1b) ty2
-  | Just (ty2a, ty2b) <- repSplitAppTy_maybe ty2
-  = do	{ subst' <- unify subst ty1a ty2a
-        ; unify subst' ty1b ty2b }
-
-unify_ subst ty1 (AppTy ty2a ty2b)
-  | Just (ty1a, ty1b) <- repSplitAppTy_maybe ty1
-  = do	{ subst' <- unify subst ty1a ty2a
-        ; unify subst' ty1b ty2b }
-
-unify_ subst ty1 ty2 = failWith (misMatch ty1 ty2)
-
-------------------------------
-unify_pred subst (ClassP c1 tys1) (ClassP c2 tys2)
-  | c1 == c2 = unify_tys subst tys1 tys2
-unify_pred subst (IParam n1 t1) (IParam n2 t2)
-  | n1 == n2 = unify subst t1 t2
-unify_pred subst p1 p2 = failWith (misMatch (PredTy p1) (PredTy p2))
- 
-------------------------------
-unify_tys = unifyList unify
-
-unifyList :: Outputable a 
-	  => (TvSubstEnv -> a -> a -> UM TvSubstEnv)
-	  -> TvSubstEnv -> [a] -> [a] -> UM TvSubstEnv
-unifyList unifier subst orig_xs orig_ys
-  = go subst orig_xs orig_ys
-  where
-    go subst []     []     = return subst
-    go subst (x:xs) (y:ys) = do { subst' <- unifier subst x y
-			        ; go subst' xs ys }
-    go subst _      _      = failWith (lengthMisMatch orig_xs orig_ys)
-
-------------------------------
-uVar :: Bool            -- Swapped
-     -> TvSubstEnv	-- An existing substitution to extend
-     -> TyVar           -- Type variable to be unified
-     -> Type            -- with this type
-     -> UM TvSubstEnv
-
-uVar swap subst tv1 ty
- = -- Check to see whether tv1 is refined by the substitution
-   case (lookupVarEnv subst tv1) of
-     -- Yes, call back into unify'
-     Just ty' | swap      -> unify subst ty ty' 
-              | otherwise -> unify subst ty' ty
-     -- No, continue
-     Nothing          -> uUnrefined subst tv1 ty ty
-
-
-uUnrefined :: TvSubstEnv          -- An existing substitution to extend
-           -> TyVar               -- Type variable to be unified
-           -> Type                -- with this type
-           -> Type                -- (de-noted version)
-           -> UM TvSubstEnv
-
--- We know that tv1 isn't refined
-
-uUnrefined subst tv1 ty2 ty2'
-  | Just ty2'' <- tcView ty2'
-  = uUnrefined subst tv1 ty2 ty2''	-- Unwrap synonyms
-		-- This is essential, in case we have
-		--	type Foo a = a
-		-- and then unify a :=: Foo a
-
-uUnrefined subst tv1 ty2 (TyVarTy tv2)
-  | tv1 == tv2		-- Same type variable
-  = return subst
-
-    -- Check to see whether tv2 is refined
-  | Just ty' <- lookupVarEnv subst tv2
-  = uUnrefined subst tv1 ty' ty'
-
-  -- So both are unrefined; next, see if the kinds force the direction
-  | k1 == k2	-- Can update either; so check the bind-flags
-  = do	{ b1 <- tvBindFlag tv1
-	; b2 <- tvBindFlag tv2
-	; case (b1,b2) of
-	    (BindMe, _) 	 -> bind tv1 ty2
-
-	    (AvoidMe, BindMe)	 -> bind tv2 ty1
-	    (AvoidMe, _)	 -> bind tv1 ty2
-
-	    (WildCard, WildCard) -> return subst
-	    (WildCard, Skolem)   -> return subst
-	    (WildCard, _)	 -> bind tv2 ty1
-
-	    (Skolem, WildCard)	 -> return subst
-	    (Skolem, Skolem)	 -> failWith (misMatch ty1 ty2)
-	    (Skolem, _)		 -> bind tv2 ty1
-	}
-
-  | k1 `isSubKind` k2 = bindTv subst tv2 ty1	-- Must update tv2
-  | k2 `isSubKind` k1 = bindTv subst tv1 ty2	-- Must update tv1
-
-  | otherwise = failWith (kindMisMatch tv1 ty2)
-  where
-    ty1 = TyVarTy tv1
-    k1 = tyVarKind tv1
-    k2 = tyVarKind tv2
-    bind tv ty = return (extendVarEnv subst tv ty)
-
-uUnrefined subst tv1 ty2 ty2'	-- ty2 is not a type variable
-  | tv1 `elemVarSet` substTvSet subst (tyVarsOfType ty2')
-  = failWith (occursCheck tv1 ty2)	-- Occurs check
-  | not (k2 `isSubKind` k1)
-  = failWith (kindMisMatch tv1 ty2)	-- Kind check
-  | otherwise
-  = bindTv subst tv1 ty2		-- Bind tyvar to the synonym if poss
-  where
-    k1 = tyVarKind tv1
-    k2 = typeKind ty2'
-
-substTvSet :: TvSubstEnv -> TyVarSet -> TyVarSet
--- Apply the non-idempotent substitution to a set of type variables,
--- remembering that the substitution isn't necessarily idempotent
-substTvSet subst tvs
-  = foldVarSet (unionVarSet . get) emptyVarSet tvs
-  where
-    get tv = case lookupVarEnv subst tv of
-		Nothing -> unitVarSet tv
-		Just ty -> substTvSet subst (tyVarsOfType ty)
-
-bindTv subst tv ty	-- ty is not a type variable
-  = do	{ b <- tvBindFlag tv
-	; case b of
-	    Skolem   -> failWith (misMatch (TyVarTy tv) ty)
-	    WildCard -> return subst
-	    other    -> return (extendVarEnv subst tv ty)
-	}
-\end{code}
-
-%************************************************************************
-%*									*
-		Unification monad
-%*									*
-%************************************************************************
-
-\begin{code}
-data BindFlag 
-  = BindMe	-- A regular type variable
-  | AvoidMe	-- Like BindMe but, given the choice, avoid binding it
-
-  | Skolem	-- This type variable is a skolem constant
-		-- Don't bind it; it only matches itself
-
-  | WildCard 	-- This type variable matches anything,
-		-- and does not affect the substitution
-
-newtype UM a = UM { unUM :: (TyVar -> BindFlag)
-		         -> MaybeErr Message a }
-
-instance Monad UM where
-  return a = UM (\tvs -> Succeeded a)
-  fail s   = UM (\tvs -> Failed (text s))
-  m >>= k  = UM (\tvs -> case unUM m tvs of
-			   Failed err -> Failed err
-			   Succeeded v  -> unUM (k v) tvs)
-
-initUM :: (TyVar -> BindFlag) -> UM a -> MaybeErr Message a
-initUM badtvs um = unUM um badtvs
-
-tvBindFlag :: TyVar -> UM BindFlag
-tvBindFlag tv = UM (\tv_fn -> Succeeded (tv_fn tv))
-
-failWith :: Message -> UM a
-failWith msg = UM (\tv_fn -> Failed msg)
-
-maybeErrToMaybe :: MaybeErr fail succ -> Maybe succ
-maybeErrToMaybe (Succeeded a) = Just a
-maybeErrToMaybe (Failed m)    = Nothing
-
-------------------------------
-repSplitAppTy_maybe :: Type -> Maybe (Type,Type)
--- Like Type.splitAppTy_maybe, but any coreView stuff is already done
-repSplitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
-repSplitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
-repSplitAppTy_maybe (TyConApp tc tys) = case snocView tys of
-						Just (tys', ty') -> Just (TyConApp tc tys', ty')
-						Nothing		 -> Nothing
-repSplitAppTy_maybe other = Nothing
-\end{code}
-
-
-%************************************************************************
-%*									*
-		Error reporting
-	We go to a lot more trouble to tidy the types
-	in TcUnify.  Maybe we'll end up having to do that
-	here too, but I'll leave it for now.
-%*									*
-%************************************************************************
-
-\begin{code}
-misMatch t1 t2
-  = ptext SLIT("Can't match types") <+> quotes (ppr t1) <+> 
-    ptext SLIT("and") <+> quotes (ppr t2)
-
-lengthMisMatch tys1 tys2
-  = sep [ptext SLIT("Can't match unequal length lists"), 
-	 nest 2 (ppr tys1), nest 2 (ppr tys2) ]
-
-kindMisMatch tv1 t2
-  = vcat [ptext SLIT("Can't match kinds") <+> quotes (ppr (tyVarKind tv1)) <+> 
-	    ptext SLIT("and") <+> quotes (ppr (typeKind t2)),
-	  ptext SLIT("when matching") <+> quotes (ppr tv1) <+> 
-		ptext SLIT("with") <+> quotes (ppr t2)]
-
-occursCheck tv ty
-  = hang (ptext SLIT("Can't construct the infinite type"))
-       2 (ppr tv <+> equals <+> ppr ty)
-\end{code}
\ No newline at end of file
diff --git a/ghc/compiler/utils/Bag.lhs b/ghc/compiler/utils/Bag.lhs
deleted file mode 100644
index b107f84a3a..0000000000
--- a/ghc/compiler/utils/Bag.lhs
+++ /dev/null
@@ -1,177 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Bags]{@Bag@: an unordered collection with duplicates}
-
-\begin{code}
-module Bag (
-	Bag,	-- abstract type
-
-	emptyBag, unitBag, unionBags, unionManyBags,
-	mapBag,
-	elemBag,
-	filterBag, partitionBag, concatBag, foldBag, foldrBag, foldlBag,
-	isEmptyBag, isSingletonBag, consBag, snocBag, anyBag,
-	listToBag, bagToList, 
-	mapBagM, mapAndUnzipBagM
-    ) where
-
-#include "HsVersions.h"
-
-import Outputable
-import Util		( isSingleton )
-import List		( partition )
-\end{code}
-
-
-\begin{code}
-data Bag a
-  = EmptyBag
-  | UnitBag	a
-  | TwoBags	(Bag a) (Bag a)	-- INVARIANT: neither branch is empty
-  | ListBag	[a]		-- INVARIANT: the list is non-empty
-
-emptyBag = EmptyBag
-unitBag  = UnitBag
-
-elemBag :: Eq a => a -> Bag a -> Bool
-
-elemBag x EmptyBag        = False
-elemBag x (UnitBag y)     = x==y
-elemBag x (TwoBags b1 b2) = x `elemBag` b1 || x `elemBag` b2
-elemBag x (ListBag ys)    = any (x ==) ys
-
-unionManyBags :: [Bag a] -> Bag a
-unionManyBags xs = foldr unionBags EmptyBag xs
-
--- This one is a bit stricter! The bag will get completely evaluated.
-
-unionBags :: Bag a -> Bag a -> Bag a
-unionBags EmptyBag b = b
-unionBags b EmptyBag = b
-unionBags b1 b2      = TwoBags b1 b2
-
-consBag :: a -> Bag a -> Bag a
-snocBag :: Bag a -> a -> Bag a
-
-consBag elt bag = (unitBag elt) `unionBags` bag
-snocBag bag elt = bag `unionBags` (unitBag elt)
-
-isEmptyBag EmptyBag = True
-isEmptyBag other    = False	-- NB invariants
-
-isSingletonBag :: Bag a -> Bool
-isSingletonBag EmptyBag	    	= False
-isSingletonBag (UnitBag x)	= True
-isSingletonBag (TwoBags b1 b2)  = False		-- Neither is empty
-isSingletonBag (ListBag xs)     = isSingleton xs
-
-filterBag :: (a -> Bool) -> Bag a -> Bag a
-filterBag pred EmptyBag = EmptyBag
-filterBag pred b@(UnitBag val) = if pred val then b else EmptyBag
-filterBag pred (TwoBags b1 b2) = sat1 `unionBags` sat2
-			       where
-				 sat1 = filterBag pred b1
-				 sat2 = filterBag pred b2
-filterBag pred (ListBag vs)    = listToBag (filter pred vs)
-
-anyBag :: (a -> Bool) -> Bag a -> Bool
-anyBag p EmptyBag        = False
-anyBag p (UnitBag v)     = p v
-anyBag p (TwoBags b1 b2) = anyBag p b1 || anyBag p b2
-anyBag p (ListBag xs)    = any p xs
-
-concatBag :: Bag (Bag a) -> Bag a
-concatBag EmptyBag 	    = EmptyBag
-concatBag (UnitBag b)       = b
-concatBag (TwoBags b1 b2)   = concatBag b1 `unionBags` concatBag b2
-concatBag (ListBag bs)	    = unionManyBags bs
-
-partitionBag :: (a -> Bool) -> Bag a -> (Bag a {- Satisfy predictate -},
-					 Bag a {- Don't -})
-partitionBag pred EmptyBag = (EmptyBag, EmptyBag)
-partitionBag pred b@(UnitBag val) = if pred val then (b, EmptyBag) else (EmptyBag, b)
-partitionBag pred (TwoBags b1 b2) = (sat1 `unionBags` sat2, fail1 `unionBags` fail2)
-				  where
-				    (sat1,fail1) = partitionBag pred b1
-				    (sat2,fail2) = partitionBag pred b2
-partitionBag pred (ListBag vs)	  = (listToBag sats, listToBag fails)
-				  where
-				    (sats,fails) = partition pred vs
-
-
-foldBag :: (r -> r -> r)	-- Replace TwoBags with this; should be associative
-	-> (a -> r)		-- Replace UnitBag with this
-	-> r			-- Replace EmptyBag with this
-	-> Bag a
-	-> r
-
-{- Standard definition
-foldBag t u e EmptyBag        = e
-foldBag t u e (UnitBag x)     = u x
-foldBag t u e (TwoBags b1 b2) = (foldBag t u e b1) `t` (foldBag t u e b2)
-foldBag t u e (ListBag xs)    = foldr (t.u) e xs
--}
-
--- More tail-recursive definition, exploiting associativity of "t"
-foldBag t u e EmptyBag        = e
-foldBag t u e (UnitBag x)     = u x `t` e
-foldBag t u e (TwoBags b1 b2) = foldBag t u (foldBag t u e b2) b1
-foldBag t u e (ListBag xs)    = foldr (t.u) e xs
-
-foldrBag :: (a -> r -> r) -> r
-	 -> Bag a
-	 -> r
-
-foldrBag k z EmptyBag        = z
-foldrBag k z (UnitBag x)     = k x z
-foldrBag k z (TwoBags b1 b2) = foldrBag k (foldrBag k z b2) b1
-foldrBag k z (ListBag xs)    = foldr k z xs
-
-foldlBag :: (r -> a -> r) -> r
-	 -> Bag a
-	 -> r
-
-foldlBag k z EmptyBag        = z
-foldlBag k z (UnitBag x)     = k z x
-foldlBag k z (TwoBags b1 b2) = foldlBag k (foldlBag k z b1) b2
-foldlBag k z (ListBag xs)    = foldl k z xs
-
-
-mapBag :: (a -> b) -> Bag a -> Bag b
-mapBag f EmptyBag 	 = EmptyBag
-mapBag f (UnitBag x)     = UnitBag (f x)
-mapBag f (TwoBags b1 b2) = TwoBags (mapBag f b1) (mapBag f b2) 
-mapBag f (ListBag xs)    = ListBag (map f xs)
-
-mapBagM :: Monad m => (a -> m b) -> Bag a -> m (Bag b)
-mapBagM f EmptyBag 	  = return EmptyBag
-mapBagM f (UnitBag x)     = do { r <- f x; return (UnitBag r) }
-mapBagM f (TwoBags b1 b2) = do { r1 <- mapBagM f b1; r2 <- mapBagM f b2; return (TwoBags r1 r2) }
-mapBagM f (ListBag    xs) = do { rs <- mapM    f xs; return (ListBag rs) }
-
-mapAndUnzipBagM :: Monad m => (a -> m (b,c)) -> Bag a -> m (Bag b, Bag c)
-mapAndUnzipBagM f EmptyBag 	  = return (EmptyBag, EmptyBag)
-mapAndUnzipBagM f (UnitBag x)     = do { (r,s) <- f x; return (UnitBag r, UnitBag s) }
-mapAndUnzipBagM f (TwoBags b1 b2) = do	{ (r1,s1) <- mapAndUnzipBagM f b1
-					; (r2,s2) <- mapAndUnzipBagM f b2
-					; return (TwoBags r1 r2, TwoBags s1 s2) }
-mapAndUnzipBagM f (ListBag    xs) = do	{ ts <- mapM f xs
-					; let (rs,ss) = unzip ts
-					; return (ListBag rs, ListBag ss) }
-
-listToBag :: [a] -> Bag a
-listToBag [] = EmptyBag
-listToBag vs = ListBag vs
-
-bagToList :: Bag a -> [a]
-bagToList b = foldrBag (:) [] b
-\end{code}
-
-\begin{code}
-instance (Outputable a) => Outputable (Bag a) where
-    ppr EmptyBag	= ptext SLIT("emptyBag")
-    ppr (UnitBag a)     = ppr a
-    ppr (TwoBags b1 b2) = hsep [ppr b1 <> comma, ppr b2]
-    ppr (ListBag as)    = interpp'SP as
-\end{code}
diff --git a/ghc/compiler/utils/Binary.hs b/ghc/compiler/utils/Binary.hs
deleted file mode 100644
index 7a1ca515b7..0000000000
--- a/ghc/compiler/utils/Binary.hs
+++ /dev/null
@@ -1,756 +0,0 @@
-{-# OPTIONS -cpp #-}
---
--- (c) The University of Glasgow 2002
---
--- Binary I/O library, with special tweaks for GHC
---
--- Based on the nhc98 Binary library, which is copyright
--- (c) Malcolm Wallace and Colin Runciman, University of York, 1998.
--- Under the terms of the license for that software, we must tell you
--- where you can obtain the original version of the Binary library, namely
---     http://www.cs.york.ac.uk/fp/nhc98/
-
-module Binary
-  ( {-type-}  Bin,
-    {-class-} Binary(..),
-    {-type-}  BinHandle,
-
-   openBinIO, openBinIO_,
-   openBinMem,
---   closeBin,
-
-   seekBin,
-   tellBin,
-   castBin,
-
-   writeBinMem,
-   readBinMem,
-
-   isEOFBin,
-
-   -- for writing instances:
-   putByte,
-   getByte,
-
-   -- lazy Bin I/O
-   lazyGet,
-   lazyPut,
-
-   -- GHC only:
-   ByteArray(..),
-   getByteArray,
-   putByteArray,
-
-   getBinFileWithDict,	-- :: Binary a => FilePath -> IO a
-   putBinFileWithDict,	-- :: Binary a => FilePath -> ModuleName -> a -> IO ()
-
-  ) where
-
-#include "HsVersions.h"
-
--- The *host* architecture version:
-#include "MachDeps.h"
-
-import FastString
-import Unique
-import Panic
-import UniqFM
-import FastMutInt
-import PackageConfig		( PackageId, packageIdFS, fsToPackageId )
-
-import Foreign
-import Data.Array.IO
-import Data.Array
-import Data.Bits
-import Data.Int
-import Data.Word
-import Data.IORef
-import Data.Char		( ord, chr )
-import Data.Array.Base  	( unsafeRead, unsafeWrite )
-import Control.Monad		( when )
-import Control.Exception	( throwDyn )
-import System.IO as IO
-import System.IO.Unsafe		( unsafeInterleaveIO )
-import System.IO.Error		( mkIOError, eofErrorType )
-import GHC.Real			( Ratio(..) )
-import GHC.Exts
-import GHC.IOBase	 	( IO(..) )
-import GHC.Word			( Word8(..) )
-#if __GLASGOW_HASKELL__ < 601
--- openFileEx is available from the lang package, but we want to 
--- be independent of hslibs libraries.
-import GHC.Handle		( openFileEx, IOModeEx(..) )
-#else
-import System.IO		( openBinaryFile )
-#endif
-
-#if __GLASGOW_HASKELL__ < 601
-openBinaryFile f mode = openFileEx f (BinaryMode mode)
-#endif
-
-type BinArray = IOUArray Int Word8
-
----------------------------------------------------------------
---		BinHandle
----------------------------------------------------------------
-
-data BinHandle
-  = BinMem {		-- binary data stored in an unboxed array
-     bh_usr :: UserData,	-- sigh, need parameterized modules :-)
-     off_r :: !FastMutInt,		-- the current offset
-     sz_r  :: !FastMutInt,		-- size of the array (cached)
-     arr_r :: !(IORef BinArray) 	-- the array (bounds: (0,size-1))
-    }
-	-- XXX: should really store a "high water mark" for dumping out
-	-- the binary data to a file.
-
-  | BinIO {		-- binary data stored in a file
-     bh_usr :: UserData,
-     off_r :: !FastMutInt,		-- the current offset (cached)
-     hdl   :: !IO.Handle		-- the file handle (must be seekable)
-   }
-	-- cache the file ptr in BinIO; using hTell is too expensive
-	-- to call repeatedly.  If anyone else is modifying this Handle
-	-- at the same time, we'll be screwed.
-
-getUserData :: BinHandle -> UserData
-getUserData bh = bh_usr bh
-
-setUserData :: BinHandle -> UserData -> BinHandle
-setUserData bh us = bh { bh_usr = us }
-
-
----------------------------------------------------------------
---		Bin
----------------------------------------------------------------
-
-newtype Bin a = BinPtr Int 
-  deriving (Eq, Ord, Show, Bounded)
-
-castBin :: Bin a -> Bin b
-castBin (BinPtr i) = BinPtr i
-
----------------------------------------------------------------
---		class Binary
----------------------------------------------------------------
-
-class Binary a where
-    put_   :: BinHandle -> a -> IO ()
-    put    :: BinHandle -> a -> IO (Bin a)
-    get    :: BinHandle -> IO a
-
-    -- define one of put_, put.  Use of put_ is recommended because it
-    -- is more likely that tail-calls can kick in, and we rarely need the
-    -- position return value.
-    put_ bh a = do put bh a; return ()
-    put bh a  = do p <- tellBin bh; put_ bh a; return p
-
-putAt  :: Binary a => BinHandle -> Bin a -> a -> IO ()
-putAt bh p x = do seekBin bh p; put bh x; return ()
-
-getAt  :: Binary a => BinHandle -> Bin a -> IO a
-getAt bh p = do seekBin bh p; get bh
-
-openBinIO_ :: IO.Handle -> IO BinHandle
-openBinIO_ h = openBinIO h 
-
-openBinIO :: IO.Handle -> IO BinHandle
-openBinIO h = do
-  r <- newFastMutInt
-  writeFastMutInt r 0
-  return (BinIO noUserData r h)
-
-openBinMem :: Int -> IO BinHandle
-openBinMem size
- | size <= 0 = error "Data.Binary.openBinMem: size must be >= 0"
- | otherwise = do
-   arr <- newArray_ (0,size-1)
-   arr_r <- newIORef arr
-   ix_r <- newFastMutInt
-   writeFastMutInt ix_r 0
-   sz_r <- newFastMutInt
-   writeFastMutInt sz_r size
-   return (BinMem noUserData ix_r sz_r arr_r)
-
-tellBin :: BinHandle -> IO (Bin a)
-tellBin (BinIO  _ r _)   = do ix <- readFastMutInt r; return (BinPtr ix)
-tellBin (BinMem _ r _ _) = do ix <- readFastMutInt r; return (BinPtr ix)
-
-seekBin :: BinHandle -> Bin a -> IO ()
-seekBin (BinIO _ ix_r h) (BinPtr p) = do 
-  writeFastMutInt ix_r p
-  hSeek h AbsoluteSeek (fromIntegral p)
-seekBin h@(BinMem _ ix_r sz_r a) (BinPtr p) = do
-  sz <- readFastMutInt sz_r
-  if (p >= sz)
-	then do expandBin h p; writeFastMutInt ix_r p
-	else writeFastMutInt ix_r p
-
-isEOFBin :: BinHandle -> IO Bool
-isEOFBin (BinMem _ ix_r sz_r a) = do
-  ix <- readFastMutInt ix_r
-  sz <- readFastMutInt sz_r
-  return (ix >= sz)
-isEOFBin (BinIO _ ix_r h) = hIsEOF h
-
-writeBinMem :: BinHandle -> FilePath -> IO ()
-writeBinMem (BinIO _ _ _) _ = error "Data.Binary.writeBinMem: not a memory handle"
-writeBinMem (BinMem _ ix_r sz_r arr_r) fn = do
-  h <- openBinaryFile fn WriteMode
-  arr <- readIORef arr_r
-  ix  <- readFastMutInt ix_r
-  hPutArray h arr ix
-#if __GLASGOW_HASKELL__ <= 500
-  -- workaround a bug in old implementation of hPutBuf (it doesn't
-  -- set the FILEOBJ_RW_WRITTEN flag on the file object, so the file doens't
-  -- get flushed properly).  Adding an extra '\0' doens't do any harm.
-  hPutChar h '\0'
-#endif
-  hClose h
-
-readBinMem :: FilePath -> IO BinHandle
--- Return a BinHandle with a totally undefined State
-readBinMem filename = do
-  h <- openBinaryFile filename ReadMode
-  filesize' <- hFileSize h
-  let filesize = fromIntegral filesize'
-  arr <- newArray_ (0,filesize-1)
-  count <- hGetArray h arr filesize
-  when (count /= filesize)
-	(error ("Binary.readBinMem: only read " ++ show count ++ " bytes"))
-  hClose h
-  arr_r <- newIORef arr
-  ix_r <- newFastMutInt
-  writeFastMutInt ix_r 0
-  sz_r <- newFastMutInt
-  writeFastMutInt sz_r filesize
-  return (BinMem noUserData ix_r sz_r arr_r)
-
--- expand the size of the array to include a specified offset
-expandBin :: BinHandle -> Int -> IO ()
-expandBin (BinMem _ ix_r sz_r arr_r) off = do
-   sz <- readFastMutInt sz_r
-   let sz' = head (dropWhile (<= off) (iterate (* 2) sz))
-   arr <- readIORef arr_r
-   arr' <- newArray_ (0,sz'-1)
-   sequence_ [ unsafeRead arr i >>= unsafeWrite arr' i
- 	     | i <- [ 0 .. sz-1 ] ]
-   writeFastMutInt sz_r sz'
-   writeIORef arr_r arr'
-#ifdef DEBUG
-   hPutStrLn stderr ("Binary: expanding to size: " ++ show sz')
-#endif
-   return ()
-expandBin (BinIO _ _ _) _ = return ()
-	-- no need to expand a file, we'll assume they expand by themselves.
-
--- -----------------------------------------------------------------------------
--- Low-level reading/writing of bytes
-
-putWord8 :: BinHandle -> Word8 -> IO ()
-putWord8 h@(BinMem _ ix_r sz_r arr_r) w = do
-    ix <- readFastMutInt ix_r
-    sz <- readFastMutInt sz_r
-	-- double the size of the array if it overflows
-    if (ix >= sz) 
-	then do expandBin h ix
-		putWord8 h w
-	else do arr <- readIORef arr_r
-		unsafeWrite arr ix w
-    		writeFastMutInt ix_r (ix+1)
-    		return ()
-putWord8 (BinIO _ ix_r h) w = do
-    ix <- readFastMutInt ix_r
-    hPutChar h (chr (fromIntegral w))	-- XXX not really correct
-    writeFastMutInt ix_r (ix+1)
-    return ()
-
-getWord8 :: BinHandle -> IO Word8
-getWord8 (BinMem _ ix_r sz_r arr_r) = do
-    ix <- readFastMutInt ix_r
-    sz <- readFastMutInt sz_r
-    when (ix >= sz)  $
-#if __GLASGOW_HASKELL__ <= 408
-	throw (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing)
-#else
-	ioError (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing)
-#endif
-    arr <- readIORef arr_r
-    w <- unsafeRead arr ix
-    writeFastMutInt ix_r (ix+1)
-    return w
-getWord8 (BinIO _ ix_r h) = do
-    ix <- readFastMutInt ix_r
-    c <- hGetChar h
-    writeFastMutInt ix_r (ix+1)
-    return $! (fromIntegral (ord c))	-- XXX not really correct
-
-putByte :: BinHandle -> Word8 -> IO ()
-putByte bh w = put_ bh w
-
-getByte :: BinHandle -> IO Word8
-getByte = getWord8
-
--- -----------------------------------------------------------------------------
--- Primitve Word writes
-
-instance Binary Word8 where
-  put_ = putWord8
-  get  = getWord8
-
-instance Binary Word16 where
-  put_ h w = do -- XXX too slow.. inline putWord8?
-    putByte h (fromIntegral (w `shiftR` 8))
-    putByte h (fromIntegral (w .&. 0xff))
-  get h = do
-    w1 <- getWord8 h
-    w2 <- getWord8 h
-    return $! ((fromIntegral w1 `shiftL` 8) .|. fromIntegral w2)
-
-
-instance Binary Word32 where
-  put_ h w = do
-    putByte h (fromIntegral (w `shiftR` 24))
-    putByte h (fromIntegral ((w `shiftR` 16) .&. 0xff))
-    putByte h (fromIntegral ((w `shiftR` 8)  .&. 0xff))
-    putByte h (fromIntegral (w .&. 0xff))
-  get h = do
-    w1 <- getWord8 h
-    w2 <- getWord8 h
-    w3 <- getWord8 h
-    w4 <- getWord8 h
-    return $! ((fromIntegral w1 `shiftL` 24) .|. 
-	       (fromIntegral w2 `shiftL` 16) .|. 
-	       (fromIntegral w3 `shiftL`  8) .|. 
-	       (fromIntegral w4))
-
-
-instance Binary Word64 where
-  put_ h w = do
-    putByte h (fromIntegral (w `shiftR` 56))
-    putByte h (fromIntegral ((w `shiftR` 48) .&. 0xff))
-    putByte h (fromIntegral ((w `shiftR` 40) .&. 0xff))
-    putByte h (fromIntegral ((w `shiftR` 32) .&. 0xff))
-    putByte h (fromIntegral ((w `shiftR` 24) .&. 0xff))
-    putByte h (fromIntegral ((w `shiftR` 16) .&. 0xff))
-    putByte h (fromIntegral ((w `shiftR`  8) .&. 0xff))
-    putByte h (fromIntegral (w .&. 0xff))
-  get h = do
-    w1 <- getWord8 h
-    w2 <- getWord8 h
-    w3 <- getWord8 h
-    w4 <- getWord8 h
-    w5 <- getWord8 h
-    w6 <- getWord8 h
-    w7 <- getWord8 h
-    w8 <- getWord8 h
-    return $! ((fromIntegral w1 `shiftL` 56) .|. 
-	       (fromIntegral w2 `shiftL` 48) .|. 
-	       (fromIntegral w3 `shiftL` 40) .|. 
-	       (fromIntegral w4 `shiftL` 32) .|. 
-	       (fromIntegral w5 `shiftL` 24) .|. 
-	       (fromIntegral w6 `shiftL` 16) .|. 
-	       (fromIntegral w7 `shiftL`  8) .|. 
-	       (fromIntegral w8))
-
--- -----------------------------------------------------------------------------
--- Primitve Int writes
-
-instance Binary Int8 where
-  put_ h w = put_ h (fromIntegral w :: Word8)
-  get h    = do w <- get h; return $! (fromIntegral (w::Word8))
-
-instance Binary Int16 where
-  put_ h w = put_ h (fromIntegral w :: Word16)
-  get h    = do w <- get h; return $! (fromIntegral (w::Word16))
-
-instance Binary Int32 where
-  put_ h w = put_ h (fromIntegral w :: Word32)
-  get h    = do w <- get h; return $! (fromIntegral (w::Word32))
-
-instance Binary Int64 where
-  put_ h w = put_ h (fromIntegral w :: Word64)
-  get h    = do w <- get h; return $! (fromIntegral (w::Word64))
-
--- -----------------------------------------------------------------------------
--- Instances for standard types
-
-instance Binary () where
-    put_ bh () = return ()
-    get  _     = return ()
---    getF bh p  = case getBitsF bh 0 p of (_,b) -> ((),b)
-
-instance Binary Bool where
-    put_ bh b = putByte bh (fromIntegral (fromEnum b))
-    get  bh   = do x <- getWord8 bh; return $! (toEnum (fromIntegral x))
---    getF bh p = case getBitsF bh 1 p of (x,b) -> (toEnum x,b)
-
-instance Binary Char where
-    put_  bh c = put_ bh (fromIntegral (ord c) :: Word32)
-    get  bh   = do x <- get bh; return $! (chr (fromIntegral (x :: Word32)))
---    getF bh p = case getBitsF bh 8 p of (x,b) -> (toEnum x,b)
-
-instance Binary Int where
-#if SIZEOF_HSINT == 4
-    put_ bh i = put_ bh (fromIntegral i :: Int32)
-    get  bh = do
-	x <- get bh
-	return $! (fromIntegral (x :: Int32))
-#elif SIZEOF_HSINT == 8
-    put_ bh i = put_ bh (fromIntegral i :: Int64)
-    get  bh = do
-	x <- get bh
-	return $! (fromIntegral (x :: Int64))
-#else
-#error "unsupported sizeof(HsInt)"
-#endif
---    getF bh   = getBitsF bh 32
-
-instance Binary a => Binary [a] where
-    put_ bh l = do 
-	let len = length l
-	if (len < 0xff) 
-	  then putByte bh (fromIntegral len :: Word8)
-	  else do putByte bh 0xff; put_ bh (fromIntegral len :: Word32)
-	mapM_ (put_ bh) l
-    get bh = do
-	b <- getByte bh
-	len <- if b == 0xff 
-	  	  then get bh
-		  else return (fromIntegral b :: Word32)
-	let loop 0 = return []
-	    loop n = do a <- get bh; as <- loop (n-1); return (a:as)
-	loop len
-
-instance (Binary a, Binary b) => Binary (a,b) where
-    put_ bh (a,b) = do put_ bh a; put_ bh b
-    get bh        = do a <- get bh
-                       b <- get bh
-                       return (a,b)
-
-instance (Binary a, Binary b, Binary c) => Binary (a,b,c) where
-    put_ bh (a,b,c) = do put_ bh a; put_ bh b; put_ bh c
-    get bh          = do a <- get bh
-                         b <- get bh
-                         c <- get bh
-                         return (a,b,c)
-
-instance (Binary a, Binary b, Binary c, Binary d) => Binary (a,b,c,d) where
-    put_ bh (a,b,c,d) = do put_ bh a; put_ bh b; put_ bh c; put_ bh d
-    get bh          = do a <- get bh
-                         b <- get bh
-                         c <- get bh
-                         d <- get bh
-                         return (a,b,c,d)
-
-instance Binary a => Binary (Maybe a) where
-    put_ bh Nothing  = putByte bh 0
-    put_ bh (Just a) = do putByte bh 1; put_ bh a
-    get bh           = do h <- getWord8 bh
-                          case h of
-                            0 -> return Nothing
-                            _ -> do x <- get bh; return (Just x)
-
-instance (Binary a, Binary b) => Binary (Either a b) where
-    put_ bh (Left  a) = do putByte bh 0; put_ bh a
-    put_ bh (Right b) = do putByte bh 1; put_ bh b
-    get bh            = do h <- getWord8 bh
-                           case h of
-                             0 -> do a <- get bh ; return (Left a)
-                             _ -> do b <- get bh ; return (Right b)
-
-#ifdef __GLASGOW_HASKELL__
-instance Binary Integer where
-    put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#)
-    put_ bh (J# s# a#) = do
- 	p <- putByte bh 1;
-	put_ bh (I# s#)
-	let sz# = sizeofByteArray# a#  -- in *bytes*
-	put_ bh (I# sz#)  -- in *bytes*
-	putByteArray bh a# sz#
-   
-    get bh = do 
-	b <- getByte bh
-	case b of
-	  0 -> do (I# i#) <- get bh
-		  return (S# i#)
-	  _ -> do (I# s#) <- get bh
-		  sz <- get bh
-		  (BA a#) <- getByteArray bh sz
-		  return (J# s# a#)
-
-putByteArray :: BinHandle -> ByteArray# -> Int# -> IO ()
-putByteArray bh a s# = loop 0#
-  where loop n# 
-	   | n# ==# s# = return ()
-	   | otherwise = do
-	   	putByte bh (indexByteArray a n#)
-		loop (n# +# 1#)
-
-getByteArray :: BinHandle -> Int -> IO ByteArray
-getByteArray bh (I# sz) = do
-  (MBA arr) <- newByteArray sz 
-  let loop n
-	   | n ==# sz = return ()
-	   | otherwise = do
-		w <- getByte bh 
-		writeByteArray arr n w
-		loop (n +# 1#)
-  loop 0#
-  freezeByteArray arr
-
-
-data ByteArray = BA ByteArray#
-data MBA = MBA (MutableByteArray# RealWorld)
-
-newByteArray :: Int# -> IO MBA
-newByteArray sz = IO $ \s ->
-  case newByteArray# sz s of { (# s, arr #) ->
-  (# s, MBA arr #) }
-
-freezeByteArray :: MutableByteArray# RealWorld -> IO ByteArray
-freezeByteArray arr = IO $ \s ->
-  case unsafeFreezeByteArray# arr s of { (# s, arr #) ->
-  (# s, BA arr #) }
-
-writeByteArray :: MutableByteArray# RealWorld -> Int# -> Word8 -> IO ()
-
-#if __GLASGOW_HASKELL__ < 503
-writeByteArray arr i w8 = IO $ \s ->
-  case word8ToWord w8 of { W# w# -> 
-  case writeCharArray# arr i (chr# (word2Int# w#)) s  of { s ->
-  (# s , () #) }}
-#else
-writeByteArray arr i (W8# w) = IO $ \s ->
-  case writeWord8Array# arr i w s of { s ->
-  (# s, () #) }
-#endif
-
-#if __GLASGOW_HASKELL__ < 503
-indexByteArray a# n# = fromIntegral (I# (ord# (indexCharArray# a# n#)))
-#else
-indexByteArray a# n# = W8# (indexWord8Array# a# n#)
-#endif
-
-instance (Integral a, Binary a) => Binary (Ratio a) where
-    put_ bh (a :% b) = do put_ bh a; put_ bh b
-    get bh = do a <- get bh; b <- get bh; return (a :% b)
-#endif
-
-instance Binary (Bin a) where
-  put_ bh (BinPtr i) = put_ bh i
-  get bh = do i <- get bh; return (BinPtr i)
-
--- -----------------------------------------------------------------------------
--- Lazy reading/writing
-
-lazyPut :: Binary a => BinHandle -> a -> IO ()
-lazyPut bh a = do
-	-- output the obj with a ptr to skip over it:
-    pre_a <- tellBin bh
-    put_ bh pre_a	-- save a slot for the ptr
-    put_ bh a		-- dump the object
-    q <- tellBin bh 	-- q = ptr to after object
-    putAt bh pre_a q 	-- fill in slot before a with ptr to q
-    seekBin bh q	-- finally carry on writing at q
-
-lazyGet :: Binary a => BinHandle -> IO a
-lazyGet bh = do
-    p <- get bh		-- a BinPtr
-    p_a <- tellBin bh
-    a <- unsafeInterleaveIO (getAt bh p_a)
-    seekBin bh p -- skip over the object for now
-    return a
-
--- --------------------------------------------------------------
--- 	Main wrappers: getBinFileWithDict, putBinFileWithDict
---
---	This layer is built on top of the stuff above, 
---	and should not know anything about BinHandles
--- --------------------------------------------------------------
-
-initBinMemSize       = (1024*1024) :: Int
-
-#if   WORD_SIZE_IN_BITS == 32
-binaryInterfaceMagic = 0x1face :: Word32
-#elif WORD_SIZE_IN_BITS == 64
-binaryInterfaceMagic = 0x1face64 :: Word32
-#endif
-
-getBinFileWithDict :: Binary a => FilePath -> IO a
-getBinFileWithDict file_path = do
-  bh <- Binary.readBinMem file_path
-
-	-- Read the magic number to check that this really is a GHC .hi file
-	-- (This magic number does not change when we change 
-	--  GHC interface file format)
-  magic <- get bh
-  when (magic /= binaryInterfaceMagic) $
-	throwDyn (ProgramError (
-	   "magic number mismatch: old/corrupt interface file?"))
-
-	-- Read the dictionary
-	-- The next word in the file is a pointer to where the dictionary is
-	-- (probably at the end of the file)
-  dict_p <- Binary.get bh	-- Get the dictionary ptr
-  data_p <- tellBin bh		-- Remember where we are now
-  seekBin bh dict_p
-  dict <- getDictionary bh
-  seekBin bh data_p		-- Back to where we were before
-
-	-- Initialise the user-data field of bh
-  let bh' = setUserData bh (initReadState dict)
-	
-	-- At last, get the thing 
-  get bh'
-
-putBinFileWithDict :: Binary a => FilePath -> a -> IO ()
-putBinFileWithDict file_path the_thing = do
-  bh <- openBinMem initBinMemSize
-  put_ bh binaryInterfaceMagic
-
-	-- Remember where the dictionary pointer will go
-  dict_p_p <- tellBin bh
-  put_ bh dict_p_p	-- Placeholder for ptr to dictionary
-
-	-- Make some intial state
-  usr_state <- newWriteState
-
-	-- Put the main thing, 
-  put_ (setUserData bh usr_state) the_thing
-
-	-- Get the final-state
-  j <- readIORef  (ud_next usr_state)
-  fm <- readIORef (ud_map  usr_state)
-  dict_p <- tellBin bh	-- This is where the dictionary will start
-
-	-- Write the dictionary pointer at the fornt of the file
-  putAt bh dict_p_p dict_p	-- Fill in the placeholder
-  seekBin bh dict_p		-- Seek back to the end of the file
-
-	-- Write the dictionary itself
-  putDictionary bh j (constructDictionary j fm)
-
-	-- And send the result to the file
-  writeBinMem bh file_path
-  
--- -----------------------------------------------------------------------------
--- UserData
--- -----------------------------------------------------------------------------
-
-data UserData = 
-   UserData { 	-- This field is used only when reading
-	      ud_dict :: Dictionary,
-
-		-- The next two fields are only used when writing
-	      ud_next :: IORef Int,	-- The next index to use
-	      ud_map  :: IORef (UniqFM (Int,FastString))
-	}
-
-noUserData = error "Binary.UserData: no user data"
-
-initReadState :: Dictionary -> UserData
-initReadState dict = UserData{ ud_dict = dict,
-			       ud_next = undef "next",
-			       ud_map  = undef "map" }
-
-newWriteState :: IO UserData
-newWriteState = do
-  j_r <- newIORef 0
-  out_r <- newIORef emptyUFM
-  return (UserData { ud_dict = panic "dict",
-		     ud_next = j_r,
-		     ud_map  = out_r })
-
-
-undef s = panic ("Binary.UserData: no " ++ s)
-
----------------------------------------------------------
---		The Dictionary 
----------------------------------------------------------
-
-type Dictionary = Array Int FastString	-- The dictionary
-					-- Should be 0-indexed
-
-putDictionary :: BinHandle -> Int -> Dictionary -> IO ()
-putDictionary bh sz dict = do
-  put_ bh sz
-  mapM_ (putFS bh) (elems dict)
-
-getDictionary :: BinHandle -> IO Dictionary
-getDictionary bh = do 
-  sz <- get bh
-  elems <- sequence (take sz (repeat (getFS bh)))
-  return (listArray (0,sz-1) elems)
-
-constructDictionary :: Int -> UniqFM (Int,FastString) -> Dictionary
-constructDictionary j fm = array (0,j-1) (eltsUFM fm)
-
----------------------------------------------------------
---		Reading and writing FastStrings
----------------------------------------------------------
-
-putFS bh (FastString id l _ buf _) = do
-  put_ bh l
-  withForeignPtr buf $ \ptr -> 
-    let 
-	go n | n == l    = return ()
-	     | otherwise = do
-		b <- peekElemOff ptr n
-		putByte bh b
-		go (n+1)
-   in 
-   go 0
-  
-{- -- possible faster version, not quite there yet:
-getFS bh@BinMem{} = do
-  (I# l) <- get bh
-  arr <- readIORef (arr_r bh)
-  off <- readFastMutInt (off_r bh)
-  return $! (mkFastSubStringBA# arr off l)
--}
-getFS bh = do
-  l <- get bh
-  fp <- mallocForeignPtrBytes l
-  withForeignPtr fp $ \ptr -> do
-  let 
-	go n | n == l = mkFastStringForeignPtr ptr fp l
-	     | otherwise = do
-		b <- getByte bh
-		pokeElemOff ptr n b
-		go (n+1)
-  --
-  go 0
-
-#if __GLASGOW_HASKELL__ < 600
-mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
-mallocForeignPtrBytes n = do
-  r <- mallocBytes n
-  newForeignPtr r (finalizerFree r)
-
-foreign import ccall unsafe "stdlib.h free" 
-  finalizerFree :: Ptr a -> IO ()
-#endif
-
-instance Binary PackageId where
-  put_ bh pid = put_ bh (packageIdFS pid)
-  get bh = do { fs <- get bh; return (fsToPackageId fs) }
-
-instance Binary FastString where
-  put_ bh f@(FastString id l _ fp _) =
-    case getUserData bh of { 
-	UserData { ud_next = j_r, ud_map = out_r, ud_dict = dict} -> do
-    out <- readIORef out_r
-    let uniq = getUnique f
-    case lookupUFM out uniq of
-	Just (j,f)  -> put_ bh j
-	Nothing -> do
-	   j <- readIORef j_r
-	   put_ bh j
-	   writeIORef j_r (j+1)
-	   writeIORef out_r (addToUFM out uniq (j,f))
-    }
-
-  get bh = do 
-	j <- get bh
-	return $! (ud_dict (getUserData bh) ! j)
diff --git a/ghc/compiler/utils/BitSet.lhs b/ghc/compiler/utils/BitSet.lhs
deleted file mode 100644
index a108136af3..0000000000
--- a/ghc/compiler/utils/BitSet.lhs
+++ /dev/null
@@ -1,205 +0,0 @@
-%
-% (c) The GRASP Project, Glasgow University, 1994-1998
-%
-\section[BitSet]{An implementation of very small sets}
-
-Bit sets are a fast implementation of sets of integers ranging from 0
-to one less than the number of bits in a machine word (typically 31).
-If any element exceeds the maximum value for a particular machine
-architecture, the results of these operations are undefined.  You have
-been warned.  If you put any safety checks in this code, I will have
-to kill you.
-
-Note: the Yale Haskell implementation won't provide a full 32 bits.
-However, if you can handle the performance loss, you could change to
-Integer and get virtually unlimited sets.
-
-\begin{code}
-
-module BitSet (
-	BitSet,		-- abstract type
-	mkBS, listBS, emptyBS, unitBS,
-	unionBS, minusBS, intBS
-    ) where
-
-#include "HsVersions.h"
-
-#ifdef __GLASGOW_HASKELL__
-import GLAEXTS
--- nothing to import
-#elif defined(__YALE_HASKELL__)
-{-hide import from mkdependHS-}
-import
-	LogOpPrims
-#else
-{-hide import from mkdependHS-}
-import
-	Word
-#endif
-
-#ifdef __GLASGOW_HASKELL__
-
-data BitSet = MkBS Word#
-
-emptyBS :: BitSet
-emptyBS = MkBS (int2Word# 0#)
-
-mkBS :: [Int] -> BitSet
-mkBS xs = foldr (unionBS . unitBS) emptyBS xs
-
-unitBS :: Int -> BitSet
-unitBS x = case x of
-#if __GLASGOW_HASKELL__ >= 503
-    I# i# -> MkBS ((int2Word# 1#) `uncheckedShiftL#` i#)
-#else
-    I# i# -> MkBS ((int2Word# 1#) `shiftL#` i#)
-#endif
-
-unionBS :: BitSet -> BitSet -> BitSet
-unionBS (MkBS x#) (MkBS y#) = MkBS (x# `or#` y#)
-
-minusBS :: BitSet -> BitSet -> BitSet
-minusBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` (not# y#))
-
-#if 0
--- not used in GHC
-isEmptyBS :: BitSet -> Bool
-isEmptyBS (MkBS s#)
-  = case word2Int# s# of
-    	0# -> True
-    	_  -> False
-
-intersectBS :: BitSet -> BitSet -> BitSet
-intersectBS (MkBS x#) (MkBS y#) = MkBS (x# `and#` y#)
-
-elementBS :: Int -> BitSet -> Bool
-elementBS x (MkBS s#) = case x of
-    I# i# -> case word2Int# (((int2Word# 1#) `shiftL#` i#) `and#` s#) of
-    	    	    0# -> False
-    	    	    _  -> True
-#endif
-
-listBS :: BitSet -> [Int]
-listBS s = listify s 0
-    where listify (MkBS s#) n =
-    	    case word2Int# s# of
-    	        0# -> []
-    	        _  -> let s' = (MkBS (s# `shiftr` 1#))
-    	    	    	  more = listify s' (n + 1)
-    	    	      in case word2Int# (s# `and#` (int2Word# 1#)) of
-    	    	    	  0# -> more
-    	    	    	  _  -> n : more
-#if __GLASGOW_HASKELL__ >= 503
-	  shiftr x y = uncheckedShiftRL# x y
-#else
-	  shiftr x y = shiftRL# x y
-#endif
-
--- intBS is a bit naughty.
-intBS :: BitSet -> Int
-intBS (MkBS w#) = I# (word2Int# w#)
-
-#elif defined(__YALE_HASKELL__)
-
-data BitSet = MkBS Int
-
-emptyBS :: BitSet
-emptyBS = MkBS 0
-
-mkBS :: [Int] -> BitSet
-mkBS xs = foldr (unionBS . unitBS) emptyBS xs
-
-unitBS :: Int -> BitSet
-unitBS x = MkBS (1 `ashInt` x)
-
-unionBS :: BitSet -> BitSet -> BitSet
-unionBS (MkBS x) (MkBS y) = MkBS (x `logiorInt` y)
-
-#if 0
--- not used in GHC
-isEmptyBS :: BitSet -> Bool
-isEmptyBS (MkBS s)
-  = case s of
-    	0 -> True
-    	_ -> False
-
-intersectBS :: BitSet -> BitSet -> BitSet
-intersectBS (MkBS x) (MkBS y) = MkBS (x `logandInt` y)
-
-elementBS :: Int -> BitSet -> Bool
-elementBS x (MkBS s)
-  = case logbitpInt x s of
-    	0 -> False
-    	_ -> True
-#endif
-
-minusBS :: BitSet -> BitSet -> BitSet
-minusBS (MkBS x) (MkBS y) = MkBS (x `logandc2Int` y)
-
--- rewritten to avoid right shifts (which would give nonsense on negative
--- values.
-listBS :: BitSet -> [Int]
-listBS (MkBS s) = listify s 0 1
-    where listify s n m =
-    	    case s of
-    	        0 -> []
-    	        _ -> let n' = n+1; m' = m+m in
-		     case logbitpInt s m of
-		     0 -> listify s n' m'
-		     _ -> n : listify (s `logandc2Int` m) n' m'
-
-#else	/* HBC, perhaps? */
-
-data BitSet = MkBS Word
-
-emptyBS :: BitSet
-emptyBS = MkBS 0
-
-mkBS :: [Int] -> BitSet
-mkBS xs = foldr (unionBS . unitBS) emptyBS xs
-
-unitBS :: Int -> BitSet
-unitBS x = MkBS (1 `bitLsh` x)
-
-unionBS :: BitSet -> BitSet -> BitSet
-unionBS (MkBS x) (MkBS y) = MkBS (x `bitOr` y)
-
-#if 0
--- not used in GHC
-isEmptyBS :: BitSet -> Bool
-isEmptyBS (MkBS s)
-  = case s of
-    	0 -> True
-    	_ -> False
-
-intersectBS :: BitSet -> BitSet -> BitSet
-intersectBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` y)
-
-elementBS :: Int -> BitSet -> Bool
-elementBS x (MkBS s)
-  = case (1 `bitLsh` x) `bitAnd` s of
-    	0 -> False
-    	_ -> True
-#endif
-
-minusBS :: BitSet -> BitSet -> BitSet
-minusBS (MkBS x) (MkBS y) = MkBS (x `bitAnd` (bitCompl y))
-
-listBS :: BitSet -> [Int]
-listBS (MkBS s) = listify s 0
-    where listify s n =
-    	    case s of
-    	        0 -> []
-    	        _ -> let s' = s `bitRsh` 1
-    	    	         more = listify s' (n + 1)
-    	    	     in case (s `bitAnd` 1) of
-    	    	    	    0 -> more
-    	    	    	    _ -> n : more
-
-#endif
-
-\end{code}
-
-
-
-
diff --git a/ghc/compiler/utils/BufWrite.hs b/ghc/compiler/utils/BufWrite.hs
deleted file mode 100644
index a03db3d084..0000000000
--- a/ghc/compiler/utils/BufWrite.hs
+++ /dev/null
@@ -1,124 +0,0 @@
------------------------------------------------------------------------------
---
--- Fast write-buffered Handles
---
--- (c) The University of Glasgow 2005
---
--- This is a simple abstraction over Handles that offers very fast write
--- buffering, but without the thread safety that Handles provide.  It's used
--- to save time in Pretty.printDoc.
---
------------------------------------------------------------------------------
-
-module BufWrite (
-	BufHandle(..),
-	newBufHandle,
-	bPutChar,
-	bPutStr,
-	bPutFS,
-	bPutLitString,
-	bFlush,
-  ) where
-
-#include "HsVersions.h"
-
-import FastString
-import FastMutInt
-import Panic		( panic )
-
-import Monad		( when )
-import Char		( ord )
-import Foreign
-import IO
-
-import GHC.IOBase	( IO(..) )
-import System.IO	( hPutBuf )
-import GHC.Ptr		( Ptr(..) )
-
-import GLAEXTS		( Int(..), Int#, Addr# )
-
--- -----------------------------------------------------------------------------
-
-data BufHandle = BufHandle {-#UNPACK#-}!(Ptr Word8)
-			   {-#UNPACK#-}!FastMutInt
-			   Handle
-
-newBufHandle :: Handle -> IO BufHandle
-newBufHandle hdl = do
-  ptr <- mallocBytes buf_size
-  r <- newFastMutInt
-  writeFastMutInt r 0
-  return (BufHandle ptr r hdl)
-
-buf_size = 8192 :: Int
-
-#define STRICT2(f) f a b | a `seq` b `seq` False = undefined
-#define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined
-
-bPutChar :: BufHandle -> Char -> IO ()
-STRICT2(bPutChar)
-bPutChar b@(BufHandle buf r hdl) c = do
-  i <- readFastMutInt r
-  if (i >= buf_size)
-	then do hPutBuf hdl buf buf_size
-		writeFastMutInt r 0
-		bPutChar b c
-	else do pokeElemOff buf i (fromIntegral (ord c) :: Word8)
-		writeFastMutInt r (i+1)
-
-bPutStr :: BufHandle -> String -> IO ()
-STRICT2(bPutStr)
-bPutStr b@(BufHandle buf r hdl) str = do
-  i <- readFastMutInt r
-  loop str i
-  where loop _ i | i `seq` False = undefined
-	loop "" i = do writeFastMutInt r i; return ()
-	loop (c:cs) i
-	   | i >= buf_size = do
-		hPutBuf hdl buf buf_size
-		loop (c:cs) 0
-	   | otherwise = do
-		pokeElemOff buf i (fromIntegral (ord c))
-		loop cs (i+1)
-  
-bPutFS :: BufHandle -> FastString -> IO ()
-bPutFS b@(BufHandle buf r hdl) fs@(FastString _ len _ fp _) =
- withForeignPtr fp $ \ptr -> do
-  i <- readFastMutInt r
-  if (i + len) >= buf_size
-	then do hPutBuf hdl buf i
-		writeFastMutInt r 0
-		if (len >= buf_size) 
-		    then hPutBuf hdl ptr len
-		    else bPutFS b fs
-	else do
-		copyBytes (buf `plusPtr` i) ptr len
-		writeFastMutInt r (i+len)
-
-bPutLitString :: BufHandle -> Addr# -> Int# -> IO ()
-bPutLitString b@(BufHandle buf r hdl) a# len# = do
-  let len = I# len#
-  i <- readFastMutInt r
-  if (i+len) >= buf_size
-	then do hPutBuf hdl buf i
-		writeFastMutInt r 0
-		if (len >= buf_size) 
-		    then hPutBuf hdl (Ptr a#) len
-		    else bPutLitString b a# len#
-	else do
-		copyBytes (buf `plusPtr` i) (Ptr a#) len
-		writeFastMutInt r (i+len)
-
-bFlush :: BufHandle -> IO ()
-bFlush b@(BufHandle buf r hdl) = do
-  i <- readFastMutInt r
-  when (i > 0) $ hPutBuf hdl buf i
-  free buf
-  return ()
-
-#if 0
-myPutBuf s hdl buf i = 
-  modifyIOError (\e -> ioeSetErrorString e (ioeGetErrorString e ++ ':':s ++ " (" ++ show buf ++ "," ++ show i ++ ")")) $
-
-  hPutBuf hdl buf i
-#endif
diff --git a/ghc/compiler/utils/Digraph.lhs b/ghc/compiler/utils/Digraph.lhs
deleted file mode 100644
index c49087c8f3..0000000000
--- a/ghc/compiler/utils/Digraph.lhs
+++ /dev/null
@@ -1,426 +0,0 @@
-\begin{code}
-module Digraph(
-
-	-- At present the only one with a "nice" external interface
-	stronglyConnComp, stronglyConnCompR, SCC(..), flattenSCC, flattenSCCs,
-
-	Graph, Vertex, 
-	graphFromEdges, graphFromEdges', 
-	buildG, transposeG, reverseE, outdegree, indegree,
-
-	Tree(..), Forest,
-	showTree, showForest,
-
-	dfs, dff,
-	topSort,
-	components,
-	scc,
-	back, cross, forward,
-	reachable, path,
-	bcc
-
-    ) where
-
-# include "HsVersions.h"
-
-------------------------------------------------------------------------------
--- A version of the graph algorithms described in:
--- 
--- ``Lazy Depth-First Search and Linear Graph Algorithms in Haskell''
---   by David King and John Launchbury
--- 
--- Also included is some additional code for printing tree structures ...
-------------------------------------------------------------------------------
-
-
-import Util	( sortLe )
-
--- Extensions
-import MONAD_ST
-
--- std interfaces
-import Maybe
-import Array
-import List
-import Outputable
-
-#if __GLASGOW_HASKELL__ >= 504
-import Data.Array.ST  hiding ( indices, bounds )
-#else
-import ST
-#endif
-\end{code}
-
-
-%************************************************************************
-%*									*
-%*	External interface
-%*									*
-%************************************************************************
-
-\begin{code}
-data SCC vertex = AcyclicSCC vertex
-	        | CyclicSCC  [vertex]
-
-flattenSCCs :: [SCC a] -> [a]
-flattenSCCs = concatMap flattenSCC
-
-flattenSCC (AcyclicSCC v) = [v]
-flattenSCC (CyclicSCC vs) = vs
-
-instance Outputable a => Outputable (SCC a) where
-   ppr (AcyclicSCC v) = text "NONREC" $$ (nest 3 (ppr v))
-   ppr (CyclicSCC vs) = text "REC" $$ (nest 3 (vcat (map ppr vs)))
-\end{code}
-
-\begin{code}
-stronglyConnComp
-	:: Ord key
-	=> [(node, key, [key])]		-- The graph; its ok for the
-					-- out-list to contain keys which arent
-					-- a vertex key, they are ignored
-	-> [SCC node]	-- Returned in topologically sorted order
-			-- Later components depend on earlier ones, but not vice versa
-
-stronglyConnComp edges
-  = map get_node (stronglyConnCompR edges)
-  where
-    get_node (AcyclicSCC (n, _, _)) = AcyclicSCC n
-    get_node (CyclicSCC triples)     = CyclicSCC [n | (n,_,_) <- triples]
-
--- The "R" interface is used when you expect to apply SCC to
--- the (some of) the result of SCC, so you dont want to lose the dependency info
-stronglyConnCompR
-	:: Ord key
-	=> [(node, key, [key])]		-- The graph; its ok for the
-					-- out-list to contain keys which arent
-					-- a vertex key, they are ignored
-	-> [SCC (node, key, [key])]	-- Topologically sorted
-
-stronglyConnCompR [] = []  -- added to avoid creating empty array in graphFromEdges -- SOF
-stronglyConnCompR edges
-  = map decode forest
-  where
-    (graph, vertex_fn) = _scc_ "graphFromEdges" graphFromEdges edges
-    forest	       = _scc_ "Digraph.scc" scc graph
-    decode (Node v []) | mentions_itself v = CyclicSCC [vertex_fn v]
-		       | otherwise	   = AcyclicSCC (vertex_fn v)
-    decode other = CyclicSCC (dec other [])
-		 where
-		   dec (Node v ts) vs = vertex_fn v : foldr dec vs ts
-    mentions_itself v = v `elem` (graph ! v)
-\end{code}
-
-%************************************************************************
-%*									*
-%*	Graphs
-%*									*
-%************************************************************************
-
-
-\begin{code}
-type Vertex  = Int
-type Table a = Array Vertex a
-type Graph   = Table [Vertex]
-type Bounds  = (Vertex, Vertex)
-type Edge    = (Vertex, Vertex)
-\end{code}
-
-\begin{code}
-vertices :: Graph -> [Vertex]
-vertices  = indices
-
-edges    :: Graph -> [Edge]
-edges g   = [ (v, w) | v <- vertices g, w <- g!v ]
-
-mapT    :: (Vertex -> a -> b) -> Table a -> Table b
-mapT f t = array (bounds t) [ (,) v (f v (t!v)) | v <- indices t ]
-
-buildG :: Bounds -> [Edge] -> Graph
-buildG bounds edges = accumArray (flip (:)) [] bounds edges
-
-transposeG  :: Graph -> Graph
-transposeG g = buildG (bounds g) (reverseE g)
-
-reverseE    :: Graph -> [Edge]
-reverseE g   = [ (w, v) | (v, w) <- edges g ]
-
-outdegree :: Graph -> Table Int
-outdegree  = mapT numEdges
-             where numEdges v ws = length ws
-
-indegree :: Graph -> Table Int
-indegree  = outdegree . transposeG
-\end{code}
-
-
-\begin{code}
-graphFromEdges 
-	:: Ord key
-	=> [(node, key, [key])]
-	-> (Graph, Vertex -> (node, key, [key]))
-graphFromEdges edges = 
-  case graphFromEdges' edges of (graph, vertex_fn, _) -> (graph, vertex_fn) 
-
-graphFromEdges'
-	:: Ord key
-	=> [(node, key, [key])]
-	-> (Graph, Vertex -> (node, key, [key]), key -> Maybe Vertex)
-graphFromEdges' edges
-  = (graph, \v -> vertex_map ! v, key_vertex)
-  where
-    max_v      	    = length edges - 1
-    bounds          = (0,max_v) :: (Vertex, Vertex)
-    sorted_edges    = let
-			 (_,k1,_) `le` (_,k2,_) = case k1 `compare` k2 of { GT -> False; other -> True }
-		      in
-			sortLe le edges
-    edges1	    = zipWith (,) [0..] sorted_edges
-
-    graph	    = array bounds [(,) v (mapMaybe key_vertex ks) | (,) v (_,    _, ks) <- edges1]
-    key_map	    = array bounds [(,) v k			   | (,) v (_,    k, _ ) <- edges1]
-    vertex_map	    = array bounds edges1
-
-
-    -- key_vertex :: key -> Maybe Vertex
-    -- 	returns Nothing for non-interesting vertices
-    key_vertex k   = find 0 max_v 
-		   where
-		     find a b | a > b 
-			      = Nothing
-		     find a b = case compare k (key_map ! mid) of
-				   LT -> find a (mid-1)
-				   EQ -> Just mid
-				   GT -> find (mid+1) b
-			      where
-			 	mid = (a + b) `div` 2
-\end{code}
-
-%************************************************************************
-%*									*
-%*	Trees and forests
-%*									*
-%************************************************************************
-
-\begin{code}
-data Tree a   = Node a (Forest a)
-type Forest a = [Tree a]
-
-mapTree              :: (a -> b) -> (Tree a -> Tree b)
-mapTree f (Node x ts) = Node (f x) (map (mapTree f) ts)
-\end{code}
-
-\begin{code}
-instance Show a => Show (Tree a) where
-  showsPrec p t s = showTree t ++ s
-
-showTree :: Show a => Tree a -> String
-showTree  = drawTree . mapTree show
-
-showForest :: Show a => Forest a -> String
-showForest  = unlines . map showTree
-
-drawTree        :: Tree String -> String
-drawTree         = unlines . draw
-
-draw (Node x ts) = grp this (space (length this)) (stLoop ts)
- where this          = s1 ++ x ++ " "
-
-       space n       = replicate n ' '
-
-       stLoop []     = [""]
-       stLoop [t]    = grp s2 "  " (draw t)
-       stLoop (t:ts) = grp s3 s4 (draw t) ++ [s4] ++ rsLoop ts
-
-       rsLoop [t]    = grp s5 "  " (draw t)
-       rsLoop (t:ts) = grp s6 s4 (draw t) ++ [s4] ++ rsLoop ts
-
-       grp fst rst   = zipWith (++) (fst:repeat rst)
-
-       [s1,s2,s3,s4,s5,s6] = ["- ", "--", "-+", " |", " `", " +"]
-\end{code}
-
-
-%************************************************************************
-%*									*
-%*	Depth first search
-%*									*
-%************************************************************************
-
-\begin{code}
-#if __GLASGOW_HASKELL__ >= 504
-newSTArray :: Ix i => (i,i) -> e -> ST s (STArray s i e)
-newSTArray = newArray
-
-readSTArray :: Ix i => STArray s i e -> i -> ST s e
-readSTArray = readArray
-
-writeSTArray :: Ix i => STArray s i e -> i -> e -> ST s ()
-writeSTArray = writeArray
-#endif
-
-type Set s    = STArray s Vertex Bool
-
-mkEmpty      :: Bounds -> ST s (Set s)
-mkEmpty bnds  = newSTArray bnds False
-
-contains     :: Set s -> Vertex -> ST s Bool
-contains m v  = readSTArray m v
-
-include      :: Set s -> Vertex -> ST s ()
-include m v   = writeSTArray m v True
-\end{code}
-
-\begin{code}
-dff          :: Graph -> Forest Vertex
-dff g         = dfs g (vertices g)
-
-dfs          :: Graph -> [Vertex] -> Forest Vertex
-dfs g vs      = prune (bounds g) (map (generate g) vs)
-
-generate     :: Graph -> Vertex -> Tree Vertex
-generate g v  = Node v (map (generate g) (g!v))
-
-prune        :: Bounds -> Forest Vertex -> Forest Vertex
-prune bnds ts = runST (mkEmpty bnds  >>= \m ->
-                       chop m ts)
-
-chop         :: Set s -> Forest Vertex -> ST s (Forest Vertex)
-chop m []     = return []
-chop m (Node v ts : us)
-              = contains m v >>= \visited ->
-                if visited then
-                  chop m us
-                else
-                  include m v >>= \_  ->
-                  chop m ts   >>= \as ->
-                  chop m us   >>= \bs ->
-                  return (Node v as : bs)
-\end{code}
-
-
-%************************************************************************
-%*									*
-%*	Algorithms
-%*									*
-%************************************************************************
-
-------------------------------------------------------------
--- Algorithm 1: depth first search numbering
-------------------------------------------------------------
-
-\begin{code}
---preorder            :: Tree a -> [a]
-preorder (Node a ts) = a : preorderF ts
-
-preorderF           :: Forest a -> [a]
-preorderF ts         = concat (map preorder ts)
-
-tabulate        :: Bounds -> [Vertex] -> Table Int
-tabulate bnds vs = array bnds (zipWith (,) vs [1..])
-
-preArr          :: Bounds -> Forest Vertex -> Table Int
-preArr bnds      = tabulate bnds . preorderF
-\end{code}
-
-
-------------------------------------------------------------
--- Algorithm 2: topological sorting
-------------------------------------------------------------
-
-\begin{code}
---postorder :: Tree a -> [a]
-postorder (Node a ts) = postorderF ts ++ [a]
-
-postorderF   :: Forest a -> [a]
-postorderF ts = concat (map postorder ts)
-
-postOrd      :: Graph -> [Vertex]
-postOrd       = postorderF . dff
-
-topSort      :: Graph -> [Vertex]
-topSort       = reverse . postOrd
-\end{code}
-
-
-------------------------------------------------------------
--- Algorithm 3: connected components
-------------------------------------------------------------
-
-\begin{code}
-components   :: Graph -> Forest Vertex
-components    = dff . undirected
-
-undirected   :: Graph -> Graph
-undirected g  = buildG (bounds g) (edges g ++ reverseE g)
-\end{code}
-
-
--- Algorithm 4: strongly connected components
-
-\begin{code}
-scc  :: Graph -> Forest Vertex
-scc g = dfs g (reverse (postOrd (transposeG g)))
-\end{code}
-
-
-------------------------------------------------------------
--- Algorithm 5: Classifying edges
-------------------------------------------------------------
-
-\begin{code}
-back              :: Graph -> Table Int -> Graph
-back g post        = mapT select g
- where select v ws = [ w | w <- ws, post!v < post!w ]
-
-cross             :: Graph -> Table Int -> Table Int -> Graph
-cross g pre post   = mapT select g
- where select v ws = [ w | w <- ws, post!v > post!w, pre!v > pre!w ]
-
-forward           :: Graph -> Graph -> Table Int -> Graph
-forward g tree pre = mapT select g
- where select v ws = [ w | w <- ws, pre!v < pre!w ] \\ tree!v
-\end{code}
-
-
-------------------------------------------------------------
--- Algorithm 6: Finding reachable vertices
-------------------------------------------------------------
-
-\begin{code}
-reachable    :: Graph -> Vertex -> [Vertex]
-reachable g v = preorderF (dfs g [v])
-
-path         :: Graph -> Vertex -> Vertex -> Bool
-path g v w    = w `elem` (reachable g v)
-\end{code}
-
-
-------------------------------------------------------------
--- Algorithm 7: Biconnected components
-------------------------------------------------------------
-
-\begin{code}
-bcc :: Graph -> Forest [Vertex]
-bcc g = (concat . map bicomps . map (do_label g dnum)) forest
- where forest = dff g
-       dnum   = preArr (bounds g) forest
-
-do_label :: Graph -> Table Int -> Tree Vertex -> Tree (Vertex,Int,Int)
-do_label g dnum (Node v ts) = Node (v,dnum!v,lv) us
- where us = map (do_label g dnum) ts
-       lv = minimum ([dnum!v] ++ [dnum!w | w <- g!v]
-                     ++ [lu | Node (u,du,lu) xs <- us])
-
-bicomps :: Tree (Vertex,Int,Int) -> Forest [Vertex]
-bicomps (Node (v,dv,lv) ts)
-      = [ Node (v:vs) us | (l,Node vs us) <- map collect ts]
-
-collect :: Tree (Vertex,Int,Int) -> (Int, Tree [Vertex])
-collect (Node (v,dv,lv) ts) = (lv, Node (v:vs) cs)
- where collected = map collect ts
-       vs = concat [ ws | (lw, Node ws us) <- collected, lw<dv]
-       cs = concat [ if lw<dv then us else [Node (v:ws) us]
-                        | (lw, Node ws us) <- collected ]
-\end{code}
-
diff --git a/ghc/compiler/utils/Encoding.hs b/ghc/compiler/utils/Encoding.hs
deleted file mode 100644
index 152bf3c60e..0000000000
--- a/ghc/compiler/utils/Encoding.hs
+++ /dev/null
@@ -1,373 +0,0 @@
--- -----------------------------------------------------------------------------
---
--- (c) The University of Glasgow, 1997-2006
---
--- Character encodings 
---
--- -----------------------------------------------------------------------------
-
-module Encoding ( 
-	-- * UTF-8
-	utf8DecodeChar#,
-	utf8PrevChar,
-	utf8CharStart,
-	utf8DecodeChar,
-	utf8DecodeString,
-	utf8EncodeChar,
-	utf8EncodeString,
-	utf8EncodedLength,
-	countUTF8Chars,
-
-	-- * Z-encoding
-	zEncodeString,
-	zDecodeString
-  ) where
-
-#define COMPILING_FAST_STRING
-#include "HsVersions.h"
-import Foreign
-import Data.Char	( ord, chr, isDigit, digitToInt, isHexDigit )
-import Numeric		( showHex )
-
-import Data.Bits
-import GHC.Ptr		( Ptr(..) )
-import GHC.Base
-
--- -----------------------------------------------------------------------------
--- UTF-8
-
--- We can't write the decoder as efficiently as we'd like without
--- resorting to unboxed extensions, unfortunately.  I tried to write
--- an IO version of this function, but GHC can't eliminate boxed
--- results from an IO-returning function.
---
--- We assume we can ignore overflow when parsing a multibyte character here.
--- To make this safe, we add extra sentinel bytes to unparsed UTF-8 sequences
--- before decoding them (see StringBuffer.hs).
-
-{-# INLINE utf8DecodeChar# #-}
-utf8DecodeChar# :: Addr# -> (# Char#, Addr# #)
-utf8DecodeChar# a# =
-  let ch0 = word2Int# (indexWord8OffAddr# a# 0#) in
-  case () of 
-    _ | ch0 <=# 0x7F# -> (# chr# ch0, a# `plusAddr#` 1# #)
-
-      | ch0 >=# 0xC0# && ch0 <=# 0xDF# ->
-	let ch1 = word2Int# (indexWord8OffAddr# a# 1#) in
-	if ch1 <# 0x80# || ch1 >=# 0xC0# then fail 1# else
-	(# chr# (((ch0 -# 0xC0#) `uncheckedIShiftL#` 6#) +#
-	   	  (ch1 -# 0x80#)),
-	   a# `plusAddr#` 2# #)
-
-      | ch0 >=# 0xE0# && ch0 <=# 0xEF# ->
-	let ch1 = word2Int# (indexWord8OffAddr# a# 1#) in
-	if ch1 <# 0x80# || ch1 >=# 0xC0# then fail 1# else
-	let ch2 = word2Int# (indexWord8OffAddr# a# 2#) in
-	if ch2 <# 0x80# || ch2 >=# 0xC0# then fail 2# else
-	(# chr# (((ch0 -# 0xE0#) `uncheckedIShiftL#` 12#) +#
-	   	 ((ch1 -# 0x80#) `uncheckedIShiftL#` 6#)  +#
-	    	  (ch2 -# 0x80#)),
-	   a# `plusAddr#` 3# #)
-
-     | ch0 >=# 0xF0# && ch0 <=# 0xF8# ->
-	let ch1 = word2Int# (indexWord8OffAddr# a# 1#) in
-	if ch1 <# 0x80# || ch1 >=# 0xC0# then fail 1# else
-	let ch2 = word2Int# (indexWord8OffAddr# a# 2#) in
-	if ch2 <# 0x80# || ch2 >=# 0xC0# then fail 2# else
-	let ch3 = word2Int# (indexWord8OffAddr# a# 3#) in
-	if ch3 <# 0x80# || ch3 >=# 0xC0# then fail 3# else
-	(# chr# (((ch0 -# 0xF0#) `uncheckedIShiftL#` 18#) +#
-		 ((ch1 -# 0x80#) `uncheckedIShiftL#` 12#) +#
-		 ((ch2 -# 0x80#) `uncheckedIShiftL#` 6#)  +#
-		  (ch3 -# 0x80#)),
-	   a# `plusAddr#` 4# #)
-
-      | otherwise -> fail 1#
-  where
-	-- all invalid sequences end up here:
-	fail n = (# '\0'#, a# `plusAddr#` n #)
-	-- '\xFFFD' would be the usual replacement character, but
-	-- that's a valid symbol in Haskell, so will result in a
-	-- confusing parse error later on.  Instead we use '\0' which
-	-- will signal a lexer error immediately.
-
-utf8DecodeChar :: Ptr Word8 -> (Char, Ptr Word8)
-utf8DecodeChar (Ptr a#) = 
-  case utf8DecodeChar# a# of (# c#, b# #) -> ( C# c#, Ptr b# )
-
--- UTF-8 is cleverly designed so that we can always figure out where
--- the start of the current character is, given any position in a
--- stream.  This function finds the start of the previous character,
--- assuming there *is* a previous character.
-utf8PrevChar :: Ptr Word8 -> IO (Ptr Word8)
-utf8PrevChar p = utf8CharStart (p `plusPtr` (-1))
-
-utf8CharStart :: Ptr Word8 -> IO (Ptr Word8)
-utf8CharStart p = go p
- where go p = do w <- peek p
-		 if w >= 0x80 && w < 0xC0
-			then go (p `plusPtr` (-1))
-			else return p
-
-utf8DecodeString :: Ptr Word8 -> Int -> IO [Char]
-STRICT2(utf8DecodeString)
-utf8DecodeString (Ptr a#) (I# len#)
-  = unpack a#
-  where
-    end# = addr2Int# (a# `plusAddr#` len#)
-
-    unpack p#
-	| addr2Int# p# >=# end# = return []
-	| otherwise  =
-	case utf8DecodeChar# p# of
-	   (# c#, q# #) -> do
-		chs <- unpack q#
-		return (C# c# : chs)
-
-countUTF8Chars :: Ptr Word8 -> Int -> IO Int
-countUTF8Chars ptr bytes = go ptr 0
-  where
-	end = ptr `plusPtr` bytes
-
-	STRICT2(go)
-	go ptr n 
-	   | ptr >= end = return n
-	   | otherwise  = do
-		case utf8DecodeChar# (unPtr ptr) of
-		  (# c, a #) -> go (Ptr a) (n+1)
-
-unPtr (Ptr a) = a
-
-utf8EncodeChar c ptr =
-  let x = ord c in
-  case () of
-    _ | x > 0 && x <= 0x007f -> do
-	  poke ptr (fromIntegral x)
-	  return (ptr `plusPtr` 1)
-	-- NB. '\0' is encoded as '\xC0\x80', not '\0'.  This is so that we
-	-- can have 0-terminated UTF-8 strings (see GHC.Base.unpackCStringUtf8).
-      | x <= 0x07ff -> do
-	  poke ptr (fromIntegral (0xC0 .|. ((x `shiftR` 6) .&. 0x1F)))
-	  pokeElemOff ptr 1 (fromIntegral (0x80 .|. (x .&. 0x3F)))
-	  return (ptr `plusPtr` 2)
-      | x <= 0xffff -> do
-	  poke ptr (fromIntegral (0xE0 .|. (x `shiftR` 12) .&. 0x0F))
-	  pokeElemOff ptr 1 (fromIntegral (0x80 .|. (x `shiftR` 6) .&. 0x3F))
-	  pokeElemOff ptr 2 (fromIntegral (0x80 .|. (x .&. 0x3F)))
-	  return (ptr `plusPtr` 3)
-      | otherwise -> do
-	  poke ptr (fromIntegral (0xF0 .|. (x `shiftR` 18)))
-	  pokeElemOff ptr 1 (fromIntegral (0x80 .|. ((x `shiftR` 12) .&. 0x3F)))
-	  pokeElemOff ptr 2 (fromIntegral (0x80 .|. ((x `shiftR` 6) .&. 0x3F)))
-	  pokeElemOff ptr 3 (fromIntegral (0x80 .|. (x .&. 0x3F)))
-	  return (ptr `plusPtr` 4)
-
-utf8EncodeString :: Ptr Word8 -> String -> IO ()
-utf8EncodeString ptr str = go ptr str
-  where STRICT2(go)
-	go ptr [] = return ()
-	go ptr (c:cs) = do
-	  ptr' <- utf8EncodeChar c ptr
-	  go ptr' cs
-
-utf8EncodedLength :: String -> Int
-utf8EncodedLength str = go 0 str
-  where STRICT2(go)
-	go n [] = n
-        go n (c:cs)
-	  | ord c > 0 && ord c <= 0x007f = go (n+1) cs
-	  | ord c <= 0x07ff = go (n+2) cs
-	  | ord c <= 0xffff = go (n+3) cs	
-	  | otherwise       = go (n+4) cs	
-
--- -----------------------------------------------------------------------------
--- The Z-encoding
-
-{-
-This is the main name-encoding and decoding function.  It encodes any
-string into a string that is acceptable as a C name.  This is done
-right before we emit a symbol name into the compiled C or asm code.
-Z-encoding of strings is cached in the FastString interface, so we
-never encode the same string more than once.
-
-The basic encoding scheme is this.  
-
-* Tuples (,,,) are coded as Z3T
-
-* Alphabetic characters (upper and lower) and digits
-	all translate to themselves; 
-	except 'Z', which translates to 'ZZ'
-	and    'z', which translates to 'zz'
-  We need both so that we can preserve the variable/tycon distinction
-
-* Most other printable characters translate to 'zx' or 'Zx' for some
-	alphabetic character x
-
-* The others translate as 'znnnU' where 'nnn' is the decimal number
-        of the character
-
-	Before		After
-	--------------------------
-	Trak		Trak
-	foo_wib		foozuwib
-	>		zg
-	>1		zg1
-	foo#		foozh
-	foo##		foozhzh
-	foo##1		foozhzh1
-	fooZ		fooZZ	
-	:+		ZCzp
-	()		Z0T	0-tuple
-	(,,,,)		Z5T	5-tuple  
-	(# #)           Z1H     unboxed 1-tuple	(note the space)
-	(#,,,,#)	Z5H	unboxed 5-tuple
-		(NB: There is no Z1T nor Z0H.)
--}
-
-type UserString = String	-- As the user typed it
-type EncodedString = String	-- Encoded form
-
-
-zEncodeString :: UserString -> EncodedString
-zEncodeString cs = case maybe_tuple cs of
-		Just n  -> n		-- Tuples go to Z2T etc
-		Nothing -> go cs
-	  where
-		go []     = []
-		go (c:cs) = encode_ch c ++ go cs
-
-unencodedChar :: Char -> Bool	-- True for chars that don't need encoding
-unencodedChar 'Z' = False
-unencodedChar 'z' = False
-unencodedChar c   =  c >= 'a' && c <= 'z'
-	          || c >= 'A' && c <= 'Z'
-		  || c >= '0' && c <= '9'
-
-encode_ch :: Char -> EncodedString
-encode_ch c | unencodedChar c = [c]	-- Common case first
-
--- Constructors
-encode_ch '('  = "ZL"	-- Needed for things like (,), and (->)
-encode_ch ')'  = "ZR"	-- For symmetry with (
-encode_ch '['  = "ZM"
-encode_ch ']'  = "ZN"
-encode_ch ':'  = "ZC"
-encode_ch 'Z'  = "ZZ"
-
--- Variables
-encode_ch 'z'  = "zz"
-encode_ch '&'  = "za"
-encode_ch '|'  = "zb"
-encode_ch '^'  = "zc"
-encode_ch '$'  = "zd"
-encode_ch '='  = "ze"
-encode_ch '>'  = "zg"
-encode_ch '#'  = "zh"
-encode_ch '.'  = "zi"
-encode_ch '<'  = "zl"
-encode_ch '-'  = "zm"
-encode_ch '!'  = "zn"
-encode_ch '+'  = "zp"
-encode_ch '\'' = "zq"
-encode_ch '\\' = "zr"
-encode_ch '/'  = "zs"
-encode_ch '*'  = "zt"
-encode_ch '_'  = "zu"
-encode_ch '%'  = "zv"
-encode_ch c    = 'z' : if isDigit (head hex_str) then hex_str
-					         else '0':hex_str
-  where hex_str = showHex (ord c) "U"
-  -- ToDo: we could improve the encoding here in various ways.
-  -- eg. strings of unicode characters come out as 'z1234Uz5678U', we
-  -- could remove the 'U' in the middle (the 'z' works as a separator).
-
-zDecodeString :: EncodedString -> UserString
-zDecodeString [] = []
-zDecodeString ('Z' : d : rest) 
-  | isDigit d = decode_tuple   d rest
-  | otherwise = decode_upper   d : zDecodeString rest
-zDecodeString ('z' : d : rest)
-  | isDigit d = decode_num_esc d rest
-  | otherwise = decode_lower   d : zDecodeString rest
-zDecodeString (c   : rest) = c : zDecodeString rest
-
-decode_upper, decode_lower :: Char -> Char
-
-decode_upper 'L' = '('
-decode_upper 'R' = ')'
-decode_upper 'M' = '['
-decode_upper 'N' = ']'
-decode_upper 'C' = ':'
-decode_upper 'Z' = 'Z'
-decode_upper ch  = {-pprTrace "decode_upper" (char ch)-} ch
-	     	
-decode_lower 'z' = 'z'
-decode_lower 'a' = '&'
-decode_lower 'b' = '|'
-decode_lower 'c' = '^'
-decode_lower 'd' = '$'
-decode_lower 'e' = '='
-decode_lower 'g' = '>'
-decode_lower 'h' = '#'
-decode_lower 'i' = '.'
-decode_lower 'l' = '<'
-decode_lower 'm' = '-'
-decode_lower 'n' = '!'
-decode_lower 'p' = '+'
-decode_lower 'q' = '\''
-decode_lower 'r' = '\\'
-decode_lower 's' = '/'
-decode_lower 't' = '*'
-decode_lower 'u' = '_'
-decode_lower 'v' = '%'
-decode_lower ch  = {-pprTrace "decode_lower" (char ch)-} ch
-
--- Characters not having a specific code are coded as z224U (in hex)
-decode_num_esc d rest
-  = go (digitToInt d) rest
-  where
-    go n (c : rest) | isHexDigit c = go (16*n + digitToInt c) rest
-    go n ('U' : rest)           = chr n : zDecodeString rest
-    go n other = error ("decode_num_esc: " ++ show n ++  ' ':other)
-
-decode_tuple :: Char -> EncodedString -> UserString
-decode_tuple d rest
-  = go (digitToInt d) rest
-  where
-	-- NB. recurse back to zDecodeString after decoding the tuple, because
-	-- the tuple might be embedded in a longer name.
-    go n (c : rest) | isDigit c = go (10*n + digitToInt c) rest
-    go 0 ('T':rest)	= "()" ++ zDecodeString rest
-    go n ('T':rest)	= '(' : replicate (n-1) ',' ++ ")" ++ zDecodeString rest
-    go 1 ('H':rest)	= "(# #)" ++ zDecodeString rest
-    go n ('H':rest)	= '(' : '#' : replicate (n-1) ',' ++ "#)" ++ zDecodeString rest
-    go n other = error ("decode_tuple: " ++ show n ++ ' ':other)
-
-{-
-Tuples are encoded as
-	Z3T or Z3H
-for 3-tuples or unboxed 3-tuples respectively.  No other encoding starts 
-	Z<digit>
-
-* "(# #)" is the tycon for an unboxed 1-tuple (not 0-tuple)
-  There are no unboxed 0-tuples.  
-
-* "()" is the tycon for a boxed 0-tuple.
-  There are no boxed 1-tuples.
--}
-
-maybe_tuple :: UserString -> Maybe EncodedString
-
-maybe_tuple "(# #)" = Just("Z1H")
-maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
-				 (n, '#' : ')' : cs) -> Just ('Z' : shows (n+1) "H")
-				 other		     -> Nothing
-maybe_tuple "()" = Just("Z0T")
-maybe_tuple ('(' : cs)       = case count_commas (0::Int) cs of
-				 (n, ')' : cs) -> Just ('Z' : shows (n+1) "T")
-				 other	       -> Nothing
-maybe_tuple other    	     = Nothing
-
-count_commas :: Int -> String -> (Int, String)
-count_commas n (',' : cs) = count_commas (n+1) cs
-count_commas n cs	  = (n,cs)
diff --git a/ghc/compiler/utils/FastMutInt.lhs b/ghc/compiler/utils/FastMutInt.lhs
deleted file mode 100644
index b483a1428e..0000000000
--- a/ghc/compiler/utils/FastMutInt.lhs
+++ /dev/null
@@ -1,54 +0,0 @@
-{-# OPTIONS -cpp #-}
---
--- (c) The University of Glasgow 2002
---
--- Unboxed mutable Ints
-
-\begin{code}
-module FastMutInt(
-	FastMutInt, newFastMutInt,
-	readFastMutInt, writeFastMutInt
-  ) where
-
-#include "MachDeps.h"
-
-#ifndef SIZEOF_HSINT
-#define SIZEOF_HSINT  INT_SIZE_IN_BYTES
-#endif
-
-
-#if __GLASGOW_HASKELL__ < 503
-import GlaExts
-import PrelIOBase
-#else
-import GHC.Base
-import GHC.IOBase
-#endif
-
-#if __GLASGOW_HASKELL__ < 411
-newByteArray# = newCharArray#
-#endif
-\end{code}
-
-\begin{code}
-#ifdef __GLASGOW_HASKELL__
-data FastMutInt = FastMutInt (MutableByteArray# RealWorld)
-
-newFastMutInt :: IO FastMutInt
-newFastMutInt = IO $ \s ->
-  case newByteArray# size s of { (# s, arr #) ->
-  (# s, FastMutInt arr #) }
-  where I# size = SIZEOF_HSINT
-
-readFastMutInt :: FastMutInt -> IO Int
-readFastMutInt (FastMutInt arr) = IO $ \s ->
-  case readIntArray# arr 0# s of { (# s, i #) ->
-  (# s, I# i #) }
-
-writeFastMutInt :: FastMutInt -> Int -> IO ()
-writeFastMutInt (FastMutInt arr) (I# i) = IO $ \s ->
-  case writeIntArray# arr 0# i s of { s ->
-  (# s, () #) }
-\end{code}
-#endif
-
diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs
deleted file mode 100644
index ea307799c4..0000000000
--- a/ghc/compiler/utils/FastString.lhs
+++ /dev/null
@@ -1,499 +0,0 @@
-%
-% (c) The University of Glasgow, 1997-2006
-%
-\begin{code}
-{-
-FastString:	A compact, hash-consed, representation of character strings.
-		Comparison is O(1), and you can get a Unique from them.
-		Generated by the FSLIT macro
-		Turn into SDoc with Outputable.ftext
-
-LitString:	Just a wrapper for the Addr# of a C string (Ptr CChar).
-		Practically no operations
-		Outputing them is fast
-		Generated by the SLIT macro
-		Turn into SDoc with Outputable.ptext
-
-Use LitString unless you want the facilities of FastString
--}
-module FastString
-       (
-	-- * FastStrings
-	FastString(..),     -- not abstract, for now.
-
-	-- ** Construction
-        mkFastString,
-	mkFastStringBytes,
-	mkFastStringForeignPtr,
-	mkFastString#,
-	mkZFastString,
-	mkZFastStringBytes,
-
-	-- ** Deconstruction
-	unpackFS,	    -- :: FastString -> String
-	bytesFS,	    -- :: FastString -> [Word8]
-
-	-- ** Encoding
-	isZEncoded,
-	zEncodeFS,
-
-	-- ** Operations
-        uniqueOfFS,
-	lengthFS,
-	nullFS,
-	appendFS,
-        headFS,
-        tailFS,
-	concatFS,
-        consFS,
-	nilFS,
-
-	-- ** Outputing
-        hPutFS,
-
-	-- ** Internal
-	getFastStringTable,
-	hasZEncoding,
-
-	-- * LitStrings
-	LitString, 
-	mkLitString#,
-	strLength
-       ) where
-
--- This #define suppresses the "import FastString" that
--- HsVersions otherwise produces
-#define COMPILING_FAST_STRING
-#include "HsVersions.h"
-
-import Encoding
-
-import Foreign
-import Foreign.C
-import GHC.Exts
-import System.IO.Unsafe ( unsafePerformIO )
-import Control.Monad.ST	( stToIO )
-import Data.IORef	( IORef, newIORef, readIORef, writeIORef )
-import System.IO	( hPutBuf )
-import Data.Maybe	( isJust )
-
-import GHC.Arr		( STArray(..), newSTArray )
-import GHC.IOBase	( IO(..) )
-import GHC.Ptr		( Ptr(..) )
-
-#define hASH_TBL_SIZE  4091
-
-
-{-|
-A 'FastString' is an array of bytes, hashed to support fast O(1)
-comparison.  It is also associated with a character encoding, so that
-we know how to convert a 'FastString' to the local encoding, or to the
-Z-encoding used by the compiler internally.
-
-'FastString's support a memoized conversion to the Z-encoding via zEncodeFS.
--}
-
-data FastString = FastString {
-      uniq    :: {-# UNPACK #-} !Int,       -- unique id
-      n_bytes :: {-# UNPACK #-} !Int,       -- number of bytes
-      n_chars :: {-# UNPACK #-} !Int,	  -- number of chars
-      buf     :: {-# UNPACK #-} !(ForeignPtr Word8),
-      enc     :: FSEncoding
-  }
-
-data FSEncoding
-  = ZEncoded
- 	-- including strings that don't need any encoding
-  | UTF8Encoded {-# UNPACK #-} !(IORef (Maybe FastString))
-	-- A UTF-8 string with a memoized Z-encoding
-
-instance Eq FastString where
-  f1 == f2  =  uniq f1 == uniq f2
-
-instance Ord FastString where
-	-- Compares lexicographically, not by unique
-    a <= b = case cmpFS a b of { LT -> True;  EQ -> True;  GT -> False }
-    a <	 b = case cmpFS a b of { LT -> True;  EQ -> False; GT -> False }
-    a >= b = case cmpFS a b of { LT -> False; EQ -> True;  GT -> True  }
-    a >	 b = case cmpFS a b of { LT -> False; EQ -> False; GT -> True  }
-    max x y | x >= y	=  x
-            | otherwise	=  y
-    min x y | x <= y	=  x
-            | otherwise	=  y
-    compare a b = cmpFS a b
-
-instance Show FastString where
-   show fs = show (unpackFS fs)
-
-cmpFS :: FastString -> FastString -> Ordering
-cmpFS (FastString u1 l1 _ buf1 _) (FastString u2 l2 _ buf2 _) =
-  if u1 == u2 then EQ else
-  let l = if l1 <= l2 then l1 else l2 in
-  inlinePerformIO $
-    withForeignPtr buf1 $ \p1 ->
-    withForeignPtr buf2 $ \p2 -> do
-      res <- memcmp p1 p2 l
-      case () of
-       _ | res <  0  -> return LT
-	 | res == 0  -> if l1 == l2 then return EQ 
-				    else if l1 < l2 then return LT
-						    else return GT
- 	 | otherwise -> return GT
-
-#ifndef __HADDOCK__
-foreign import ccall unsafe "ghc_memcmp" 
-  memcmp :: Ptr a -> Ptr b -> Int -> IO Int
-#endif
-
--- -----------------------------------------------------------------------------
--- Construction
-
-{-
-Internally, the compiler will maintain a fast string symbol
-table, providing sharing and fast comparison. Creation of
-new @FastString@s then covertly does a lookup, re-using the
-@FastString@ if there was a hit.
--}
-
-data FastStringTable = 
- FastStringTable
-    {-# UNPACK #-} !Int
-    (MutableArray# RealWorld [FastString])
-
-string_table :: IORef FastStringTable
-string_table = 
- unsafePerformIO $ do
-   (STArray _ _ arr#) <- stToIO (newSTArray (0::Int,hASH_TBL_SIZE) [])
-   newIORef (FastStringTable 0 arr#)
-
-lookupTbl :: FastStringTable -> Int -> IO [FastString]
-lookupTbl (FastStringTable _ arr#) (I# i#) =
-  IO $ \ s# -> readArray# arr# i# s#
-
-updTbl :: IORef FastStringTable -> FastStringTable -> Int -> [FastString] -> IO ()
-updTbl fs_table_var (FastStringTable uid arr#) (I# i#) ls = do
-  (IO $ \ s# -> case writeArray# arr# i# ls s# of { s2# -> (# s2#, () #) })
-  writeIORef fs_table_var (FastStringTable (uid+1) arr#)
-
-mkFastString# :: Addr# -> FastString
-mkFastString# a# = mkFastStringBytes ptr (strLength ptr)
-  where ptr = Ptr a#
-
-mkFastStringBytes :: Ptr Word8 -> Int -> FastString
-mkFastStringBytes ptr len = unsafePerformIO $ do
-  ft@(FastStringTable uid tbl#) <- readIORef string_table
-  let
-   h = hashStr ptr len
-   add_it ls = do
-	fs <- copyNewFastString uid ptr len
-	updTbl string_table ft h (fs:ls)
-	{- _trace ("new: " ++ show f_str)   $ -}
-	return fs
-  --
-  lookup_result <- lookupTbl ft h
-  case lookup_result of
-    [] -> add_it []
-    ls -> do
-       b <- bucket_match ls len ptr
-       case b of
-	 Nothing -> add_it ls
-	 Just v  -> {- _trace ("re-use: "++show v) $ -} return v
-
-mkZFastStringBytes :: Ptr Word8 -> Int -> FastString
-mkZFastStringBytes ptr len = unsafePerformIO $ do
-  ft@(FastStringTable uid tbl#) <- readIORef string_table
-  let
-   h = hashStr ptr len
-   add_it ls = do
-	fs <- copyNewZFastString uid ptr len
-	updTbl string_table ft h (fs:ls)
-	{- _trace ("new: " ++ show f_str)   $ -}
-	return fs
-  --
-  lookup_result <- lookupTbl ft h
-  case lookup_result of
-    [] -> add_it []
-    ls -> do
-       b <- bucket_match ls len ptr
-       case b of
-	 Nothing -> add_it ls
-	 Just v  -> {- _trace ("re-use: "++show v) $ -} return v
-
--- | Create a 'FastString' from an existing 'ForeignPtr'; the difference
--- between this and 'mkFastStringBytes' is that we don't have to copy
--- the bytes if the string is new to the table.
-mkFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString
-mkFastStringForeignPtr ptr fp len = do
-  ft@(FastStringTable uid tbl#) <- readIORef string_table
---  _trace ("hashed: "++show (I# h)) $
-  let
-    h = hashStr ptr len
-    add_it ls = do
-	fs <- mkNewFastString uid ptr fp len
-	updTbl string_table ft h (fs:ls)
-	{- _trace ("new: " ++ show f_str)   $ -}
-	return fs
-  --
-  lookup_result <- lookupTbl ft h
-  case lookup_result of
-    [] -> add_it []
-    ls -> do
-       b <- bucket_match ls len ptr
-       case b of
-	 Nothing -> add_it ls
-	 Just v  -> {- _trace ("re-use: "++show v) $ -} return v
-
-mkZFastStringForeignPtr :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO FastString
-mkZFastStringForeignPtr ptr fp len = do
-  ft@(FastStringTable uid tbl#) <- readIORef string_table
---  _trace ("hashed: "++show (I# h)) $
-  let
-    h = hashStr ptr len
-    add_it ls = do
-	fs <- mkNewZFastString uid ptr fp len
-	updTbl string_table ft h (fs:ls)
-	{- _trace ("new: " ++ show f_str)   $ -}
-	return fs
-  --
-  lookup_result <- lookupTbl ft h
-  case lookup_result of
-    [] -> add_it []
-    ls -> do
-       b <- bucket_match ls len ptr
-       case b of
-	 Nothing -> add_it ls
-	 Just v  -> {- _trace ("re-use: "++show v) $ -} return v
-
-
--- | Creates a UTF-8 encoded 'FastString' from a 'String'
-mkFastString :: String -> FastString
-mkFastString str = 
-  inlinePerformIO $ do
-    let l = utf8EncodedLength str
-    buf <- mallocForeignPtrBytes l
-    withForeignPtr buf $ \ptr -> do
-      utf8EncodeString ptr str
-      mkFastStringForeignPtr ptr buf l 
-
-
--- | Creates a Z-encoded 'FastString' from a 'String'
-mkZFastString :: String -> FastString
-mkZFastString str = 
-  inlinePerformIO $ do
-    let l = Prelude.length str
-    buf <- mallocForeignPtrBytes l
-    withForeignPtr buf $ \ptr -> do
-      pokeCAString (castPtr ptr) str
-      mkZFastStringForeignPtr ptr buf l 
-
-bucket_match [] _ _ = return Nothing
-bucket_match (v@(FastString _ l _ buf _):ls) len ptr
-      | len == l  =  do
-	 b <- cmpStringPrefix ptr buf len
-	 if b then return (Just v)
-	      else bucket_match ls len ptr
-      | otherwise = 
-	 bucket_match ls len ptr
-
-mkNewFastString uid ptr fp len = do
-  ref <- newIORef Nothing
-  n_chars <- countUTF8Chars ptr len
-  return (FastString uid len n_chars fp (UTF8Encoded ref))
-
-mkNewZFastString uid ptr fp len = do
-  return (FastString uid len len fp ZEncoded)
-
-
-copyNewFastString uid ptr len = do
-  fp <- copyBytesToForeignPtr ptr len
-  ref <- newIORef Nothing
-  n_chars <- countUTF8Chars ptr len
-  return (FastString uid len n_chars fp (UTF8Encoded ref))
-
-copyNewZFastString uid ptr len = do
-  fp <- copyBytesToForeignPtr ptr len
-  return (FastString uid len len fp ZEncoded)
-
-
-copyBytesToForeignPtr ptr len = do
-  fp <- mallocForeignPtrBytes len
-  withForeignPtr fp $ \ptr' -> copyBytes ptr' ptr len
-  return fp
-
-cmpStringPrefix :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO Bool
-cmpStringPrefix ptr fp len =
-  withForeignPtr fp $ \ptr' -> do
-    r <- memcmp ptr ptr' len
-    return (r == 0)
-
-
-hashStr  :: Ptr Word8 -> Int -> Int
- -- use the Addr to produce a hash value between 0 & m (inclusive)
-hashStr (Ptr a#) (I# len#) = loop 0# 0#
-   where 
-    loop h n | n ==# len# = I# h
-	     | otherwise  = loop h2 (n +# 1#)
-	  where c = ord# (indexCharOffAddr# a# n)
-		h2 = (c +# (h *# 128#)) `remInt#` hASH_TBL_SIZE#
-
--- -----------------------------------------------------------------------------
--- Operations
-
--- | Returns the length of the 'FastString' in characters
-lengthFS :: FastString -> Int
-lengthFS f = n_chars f
-
--- | Returns 'True' if the 'FastString' is Z-encoded
-isZEncoded :: FastString -> Bool
-isZEncoded fs | ZEncoded <- enc fs = True
-		| otherwise          = False
-
--- | Returns 'True' if this 'FastString' is not Z-encoded but already has
--- a Z-encoding cached (used in producing stats).
-hasZEncoding :: FastString -> Bool
-hasZEncoding fs@(FastString uid n_bytes _ fp enc) =
-  case enc of
-    ZEncoded -> False
-    UTF8Encoded ref ->
-      inlinePerformIO $ do
-        m <- readIORef ref
-	return (isJust m)
-
--- | Returns 'True' if the 'FastString' is empty
-nullFS :: FastString -> Bool
-nullFS f  =  n_bytes f == 0
-
--- | unpacks and decodes the FastString
-unpackFS :: FastString -> String
-unpackFS (FastString _ n_bytes _ buf enc) = 
-  inlinePerformIO $ withForeignPtr buf $ \ptr ->
-    case enc of
-	ZEncoded      -> peekCAStringLen (castPtr ptr,n_bytes)
-	UTF8Encoded _ -> utf8DecodeString ptr n_bytes
-
-bytesFS :: FastString -> [Word8]
-bytesFS (FastString _ n_bytes _ buf enc) = 
-  inlinePerformIO $ withForeignPtr buf $ \ptr ->
-    peekArray n_bytes ptr
-
--- | returns a Z-encoded version of a 'FastString'.  This might be the
--- original, if it was already Z-encoded.  The first time this
--- function is applied to a particular 'FastString', the results are
--- memoized.
---
-zEncodeFS :: FastString -> FastString
-zEncodeFS fs@(FastString uid n_bytes _ fp enc) =
-  case enc of
-    ZEncoded -> fs
-    UTF8Encoded ref ->
-      inlinePerformIO $ do
-        m <- readIORef ref
-        case m of
-	  Just fs -> return fs
-	  Nothing -> do
-            let efs = mkZFastString (zEncodeString (unpackFS fs))
-	    writeIORef ref (Just efs)
-	    return efs
-
-appendFS :: FastString -> FastString -> FastString
-appendFS fs1 fs2 = mkFastString (unpackFS fs1 ++ unpackFS fs2)
-
-concatFS :: [FastString] -> FastString
-concatFS ls = mkFastString (Prelude.concat (map unpackFS ls)) -- ToDo: do better
-
-headFS :: FastString -> Char
-headFS (FastString _ n_bytes _ buf enc) = 
-  inlinePerformIO $ withForeignPtr buf $ \ptr -> do
-    case enc of
-      ZEncoded -> do 
-	 w <- peek (castPtr ptr)
-	 return (castCCharToChar w)
-      UTF8Encoded _ -> 
-	 return (fst (utf8DecodeChar ptr))
-
-tailFS :: FastString -> FastString
-tailFS (FastString _ n_bytes _ buf enc) = 
-  inlinePerformIO $ withForeignPtr buf $ \ptr -> do
-    case enc of
-      ZEncoded -> do
-	return $! mkZFastStringBytes (ptr `plusPtr` 1) (n_bytes - 1)
-      UTF8Encoded _ -> do
-	 let (_,ptr') = utf8DecodeChar ptr
-	 let off = ptr' `minusPtr` ptr
-	 return $! mkFastStringBytes (ptr `plusPtr` off) (n_bytes - off)
-
-consFS :: Char -> FastString -> FastString
-consFS c fs = mkFastString (c : unpackFS fs)
-
-uniqueOfFS :: FastString -> Int#
-uniqueOfFS (FastString (I# u#) _ _ _ _) = u#
-
-nilFS = mkFastString ""
-
--- -----------------------------------------------------------------------------
--- Stats
-
-getFastStringTable :: IO [[FastString]]
-getFastStringTable = do
-  tbl <- readIORef string_table
-  buckets <- mapM (lookupTbl tbl) [0 .. hASH_TBL_SIZE]
-  return buckets
-
--- -----------------------------------------------------------------------------
--- Outputting 'FastString's
-
--- |Outputs a 'FastString' with /no decoding at all/, that is, you
--- get the actual bytes in the 'FastString' written to the 'Handle'.
-hPutFS handle (FastString _ len _ fp _)
-  | len == 0  = return ()
-  | otherwise = do withForeignPtr fp $ \ptr -> hPutBuf handle ptr len
-
--- ToDo: we'll probably want an hPutFSLocal, or something, to output
--- in the current locale's encoding (for error messages and suchlike).
-
--- -----------------------------------------------------------------------------
--- LitStrings, here for convenience only.
-
-type LitString = Ptr ()
-
-mkLitString# :: Addr# -> LitString
-mkLitString# a# = Ptr a#
-
-foreign import ccall unsafe "ghc_strlen" 
-  strLength :: Ptr () -> Int
-
--- -----------------------------------------------------------------------------
--- under the carpet
-
--- Just like unsafePerformIO, but we inline it.
-{-# INLINE inlinePerformIO #-}
-inlinePerformIO :: IO a -> a
-inlinePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
-
--- NB. does *not* add a '\0'-terminator.
-pokeCAString :: Ptr CChar -> String -> IO ()
-pokeCAString ptr str =
-  let
-	go [] n     = return ()
-    	go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
-  in
-  go str 0
-
-#if __GLASGOW_HASKELL__ < 600
-
-mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
-mallocForeignPtrBytes n = do
-  r <- mallocBytes n
-  newForeignPtr r (finalizerFree r)
-
-foreign import ccall unsafe "stdlib.h free" 
-  finalizerFree :: Ptr a -> IO ()
-
-peekCAStringLen = peekCStringLen
-
-#elif __GLASGOW_HASKELL__ <= 602
-
-peekCAStringLen = peekCStringLen
-
-#endif
-\end{code}
diff --git a/ghc/compiler/utils/FastTypes.lhs b/ghc/compiler/utils/FastTypes.lhs
deleted file mode 100644
index bb92c8c02f..0000000000
--- a/ghc/compiler/utils/FastTypes.lhs
+++ /dev/null
@@ -1,65 +0,0 @@
-%
-% (c) The University of Glasgow, 2000
-%
-\section{Fast integers and booleans}
-
-\begin{code}
-module FastTypes (
-    FastInt, _ILIT, iBox, iUnbox,
-    (+#), (-#), (*#), quotFastInt, negateFastInt,
-    (==#), (<#), (<=#), (>=#), (>#),
-
-    FastBool, fastBool, isFastTrue, fastOr, fastAnd
-  ) where
-
-#include "HsVersions.h"
-
-#if defined(__GLASGOW_HASKELL__)
-
--- Import the beggars
-import GLAEXTS
-	( Int(..), Int#, (+#), (-#), (*#), 
-	  quotInt#, negateInt#, (==#), (<#), (<=#), (>=#), (>#)
-	)
-
-type FastInt = Int#
-_ILIT (I# x) = x
-iBox x = I# x
-iUnbox (I# x) = x
-quotFastInt   = quotInt#
-negateFastInt = negateInt#
-
-type FastBool = Int#
-fastBool True  = 1#
-fastBool False = 0#
-isFastTrue x = x ==# 1#
-
-fastOr 1# _ = 1#
-fastOr 0# x = x
-
-fastAnd 0# x = 0#
-fastAnd 1# x = x
-
-#else /* ! __GLASGOW_HASKELL__ */
-
-type FastInt = Int
-_ILIT x = x
-iBox x = x
-iUnbox x = x
-(+#) = (+)
-(-#) = (-)
-(*#) = (*)
-quotFastInt   = quot
-negateFastInt = negate
-(==#) = (==)
-(<#)  = (<)
-(<=#) = (<=)
-(>=#) = (>=)
-(>#)  = (>)
-
-type FastBool = Bool
-fastBool x = x
-_IS_TRUE_ x = x
-
-#endif /* ! __GLASGOW_HASKELL__ */
-\end{code}
diff --git a/ghc/compiler/utils/FiniteMap.lhs b/ghc/compiler/utils/FiniteMap.lhs
deleted file mode 100644
index 9168d3656f..0000000000
--- a/ghc/compiler/utils/FiniteMap.lhs
+++ /dev/null
@@ -1,749 +0,0 @@
-
-% (c) The AQUA Project, Glasgow University, 1994-1998
-%
-\section[FiniteMap]{An implementation of finite maps}
-
-``Finite maps'' are the heart of the compiler's
-lookup-tables/environments and its implementation of sets.  Important
-stuff!
-
-This code is derived from that in the paper:
-\begin{display}
-	S Adams
-	"Efficient sets: a balancing act"
-	Journal of functional programming 3(4) Oct 1993, pp553-562
-\end{display}
-
-The code is SPECIALIZEd to various highly-desirable types (e.g., Id)
-near the end.
-
-\begin{code}
-
-module FiniteMap (
-	FiniteMap,		-- abstract type
-
-	emptyFM, unitFM, listToFM,
-
-	addToFM,
-	addToFM_C,
-	addListToFM,
-	addListToFM_C,
-	delFromFM,
-	delListFromFM,
-
-	plusFM,
-	plusFM_C,
-	minusFM,
-	foldFM,
-
-	intersectFM,
-	intersectFM_C,
-	mapFM, filterFM, 
-
-	sizeFM, isEmptyFM, elemFM, lookupFM, lookupWithDefaultFM,
-
-	fmToList, keysFM, eltsFM
-
-	, bagToFM
-
-    ) where
-
-#include "HsVersions.h"
-#define IF_NOT_GHC(a) {--}
-
-#if defined(DEBUG_FINITEMAPS)/* NB NB NB */
-#define OUTPUTABLE_key , Outputable key
-#else
-#define OUTPUTABLE_key {--}
-#endif
-
-import Maybes
-import Bag	  ( Bag, foldrBag )
-import Util
-import Outputable
-
-import GLAEXTS
-
-#if ! OMIT_NATIVE_CODEGEN
-#  define IF_NCG(a) a
-#else
-#  define IF_NCG(a) {--}
-#endif
-
-
--- SIGH: but we use unboxed "sizes"...
-#if __GLASGOW_HASKELL__
-#define IF_GHC(a,b) a
-#else /* not GHC */
-#define IF_GHC(a,b) b
-#endif /* not GHC */
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The signature of the module}
-%*									*
-%************************************************************************
-
-\begin{code}
---	BUILDING
-emptyFM		:: FiniteMap key elt
-unitFM		:: key -> elt -> FiniteMap key elt
-listToFM	:: (Ord key OUTPUTABLE_key) => [(key,elt)] -> FiniteMap key elt
-			-- In the case of duplicates, the last is taken
-bagToFM		:: (Ord key OUTPUTABLE_key) => Bag (key,elt) -> FiniteMap key elt
-			-- In the case of duplicates, who knows which is taken
-
---	ADDING AND DELETING
-		   -- Throws away any previous binding
-		   -- In the list case, the items are added starting with the
-		   -- first one in the list
-addToFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key -> elt  -> FiniteMap key elt
-addListToFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> [(key,elt)] -> FiniteMap key elt
-
-		   -- Combines with previous binding
-		   -- The combining fn goes (old -> new -> new)
-addToFM_C	:: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt)
-			   -> FiniteMap key elt -> key -> elt
-			   -> FiniteMap key elt
-addListToFM_C	:: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt)
-			   -> FiniteMap key elt -> [(key,elt)]
-			   -> FiniteMap key elt
-
-		   -- Deletion doesn't complain if you try to delete something
-		   -- which isn't there
-delFromFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key   -> FiniteMap key elt
-delListFromFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> [key] -> FiniteMap key elt
-
---	COMBINING
-		   -- Bindings in right argument shadow those in the left
-plusFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt
-			   -> FiniteMap key elt
-
-		   -- Combines bindings for the same thing with the given function
-plusFM_C	:: (Ord key OUTPUTABLE_key) => (elt -> elt -> elt)
-			   -> FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
-
-minusFM		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
-		   -- (minusFM a1 a2) deletes from a1 any bindings which are bound in a2
-
-intersectFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt -> FiniteMap key elt
-intersectFM_C	:: (Ord key OUTPUTABLE_key) => (elt1 -> elt2 -> elt3)
-			   -> FiniteMap key elt1 -> FiniteMap key elt2 -> FiniteMap key elt3
-
---	MAPPING, FOLDING, FILTERING
-foldFM		:: (key -> elt -> a -> a) -> a -> FiniteMap key elt -> a
-mapFM		:: (key -> elt1 -> elt2) -> FiniteMap key elt1 -> FiniteMap key elt2
-filterFM	:: (Ord key OUTPUTABLE_key) => (key -> elt -> Bool)
-			   -> FiniteMap key elt -> FiniteMap key elt
-
-
---	INTERROGATING
-sizeFM		:: FiniteMap key elt -> Int
-isEmptyFM	:: FiniteMap key elt -> Bool
-
-elemFM		:: (Ord key OUTPUTABLE_key) => key -> FiniteMap key elt -> Bool
-lookupFM	:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key -> Maybe elt
-lookupWithDefaultFM
-		:: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> elt -> key -> elt
-		-- lookupWithDefaultFM supplies a "default" elt
-		-- to return for an unmapped key
-
---	LISTIFYING
-fmToList	:: FiniteMap key elt -> [(key,elt)]
-keysFM		:: FiniteMap key elt -> [key]
-eltsFM		:: FiniteMap key elt -> [elt]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The @FiniteMap@ data type, and building of same}
-%*									*
-%************************************************************************
-
-Invariants about @FiniteMap@:
-\begin{enumerate}
-\item
-all keys in a FiniteMap are distinct
-\item
-all keys in left  subtree are $<$ key in Branch and
-all keys in right subtree are $>$ key in Branch
-\item
-size field of a Branch gives number of Branch nodes in the tree
-\item
-size of left subtree is differs from size of right subtree by a
-factor of at most \tr{sIZE_RATIO}
-\end{enumerate}
-
-\begin{code}
-data FiniteMap key elt
-  = EmptyFM
-  | Branch key elt	    	-- Key and elt stored here
-    IF_GHC(Int#,Int{-STRICT-})	-- Size >= 1
-    (FiniteMap key elt)	    	-- Children
-    (FiniteMap key elt)
-\end{code}
-
-\begin{code}
-emptyFM = EmptyFM
-{-
-emptyFM
-  = Branch bottom bottom IF_GHC(0#,0) bottom bottom
-  where
-    bottom = panic "emptyFM"
--}
-
---  #define EmptyFM (Branch _ _ IF_GHC(0#,0) _ _)
-
-unitFM key elt = Branch key elt IF_GHC(1#,1) emptyFM emptyFM
-
-listToFM = addListToFM emptyFM
-
-bagToFM = foldrBag (\(k,v) fm -> addToFM fm k v) emptyFM
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Adding to and deleting from @FiniteMaps@}
-%*									*
-%************************************************************************
-
-\begin{code}
-addToFM fm key elt = addToFM_C (\ old new -> new) fm key elt
-
-addToFM_C combiner EmptyFM key elt = unitFM key elt
-addToFM_C combiner (Branch key elt size fm_l fm_r) new_key new_elt
-  = case compare new_key key of
-	LT -> mkBalBranch key elt (addToFM_C combiner fm_l new_key new_elt) fm_r
-	GT -> mkBalBranch key elt fm_l (addToFM_C combiner fm_r new_key new_elt)
-	EQ -> Branch new_key (combiner elt new_elt) size fm_l fm_r
-
-addListToFM fm key_elt_pairs = addListToFM_C (\ old new -> new) fm key_elt_pairs
-
-addListToFM_C combiner fm key_elt_pairs
-  = foldl' add fm key_elt_pairs	-- foldl adds from the left
-  where
-    add fmap (key,elt) = addToFM_C combiner fmap key elt
-\end{code}
-
-\begin{code}
-delFromFM EmptyFM del_key = emptyFM
-delFromFM (Branch key elt size fm_l fm_r) del_key
-  = case compare del_key key of
-	GT -> mkBalBranch key elt fm_l (delFromFM fm_r del_key)
-	LT -> mkBalBranch key elt (delFromFM fm_l del_key) fm_r
-	EQ -> glueBal fm_l fm_r
-
-delListFromFM fm keys = foldl' delFromFM fm keys
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Combining @FiniteMaps@}
-%*									*
-%************************************************************************
-
-\begin{code}
-plusFM_C combiner EmptyFM fm2 = fm2
-plusFM_C combiner fm1 EmptyFM = fm1
-plusFM_C combiner fm1 (Branch split_key elt2 _ left right)
-  = mkVBalBranch split_key new_elt
-		 (plusFM_C combiner lts left)
-		 (plusFM_C combiner gts right)
-  where
-    lts     = splitLT fm1 split_key
-    gts     = splitGT fm1 split_key
-    new_elt = case lookupFM fm1 split_key of
-		Nothing   -> elt2
-		Just elt1 -> combiner elt1 elt2
-
--- It's worth doing plusFM specially, because we don't need
--- to do the lookup in fm1.
--- FM2 over-rides FM1.
-
-plusFM EmptyFM fm2 = fm2
-plusFM fm1 EmptyFM = fm1
-plusFM fm1 (Branch split_key elt1 _ left right)
-  = mkVBalBranch split_key elt1 (plusFM lts left) (plusFM gts right)
-  where
-    lts     = splitLT fm1 split_key
-    gts     = splitGT fm1 split_key
-
-minusFM EmptyFM fm2 = emptyFM
-minusFM fm1 EmptyFM = fm1
-minusFM fm1 (Branch split_key elt _ left right)
-  = glueVBal (minusFM lts left) (minusFM gts right)
-	-- The two can be way different, so we need glueVBal
-  where
-    lts = splitLT fm1 split_key		-- NB gt and lt, so the equal ones
-    gts = splitGT fm1 split_key		-- are not in either.
-
-intersectFM fm1 fm2 = intersectFM_C (\ left right -> right) fm1 fm2
-
-intersectFM_C combiner fm1 EmptyFM = emptyFM
-intersectFM_C combiner EmptyFM fm2 = emptyFM
-intersectFM_C combiner fm1 (Branch split_key elt2 _ left right)
-
-  | maybeToBool maybe_elt1	-- split_elt *is* in intersection
-  = mkVBalBranch split_key (combiner elt1 elt2) (intersectFM_C combiner lts left)
-						(intersectFM_C combiner gts right)
-
-  | otherwise			-- split_elt is *not* in intersection
-  = glueVBal (intersectFM_C combiner lts left) (intersectFM_C combiner gts right)
-
-  where
-    lts = splitLT fm1 split_key		-- NB gt and lt, so the equal ones
-    gts = splitGT fm1 split_key		-- are not in either.
-
-    maybe_elt1 = lookupFM fm1 split_key
-    Just elt1  = maybe_elt1
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Mapping, folding, and filtering with @FiniteMaps@}
-%*									*
-%************************************************************************
-
-\begin{code}
-foldFM k z EmptyFM = z
-foldFM k z (Branch key elt _ fm_l fm_r)
-  = foldFM k (k key elt (foldFM k z fm_r)) fm_l
-
-mapFM f EmptyFM = emptyFM
-mapFM f (Branch key elt size fm_l fm_r)
-  = Branch key (f key elt) size (mapFM f fm_l) (mapFM f fm_r)
-
-filterFM p EmptyFM = emptyFM
-filterFM p (Branch key elt _ fm_l fm_r)
-  | p key elt		-- Keep the item
-  = mkVBalBranch key elt (filterFM p fm_l) (filterFM p fm_r)
-
-  | otherwise		-- Drop the item
-  = glueVBal (filterFM p fm_l) (filterFM p fm_r)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Interrogating @FiniteMaps@}
-%*									*
-%************************************************************************
-
-\begin{code}
---{-# INLINE sizeFM #-}
-sizeFM EmptyFM		     = 0
-sizeFM (Branch _ _ size _ _) = IF_GHC(I# size, size)
-
-isEmptyFM fm = sizeFM fm == 0
-
-lookupFM EmptyFM key = Nothing
-lookupFM (Branch key elt _ fm_l fm_r) key_to_find
-  = case compare key_to_find key of
-	LT -> lookupFM fm_l key_to_find
-	GT -> lookupFM fm_r key_to_find
-	EQ -> Just elt
-
-key `elemFM` fm
-  = case (lookupFM fm key) of { Nothing -> False; Just elt -> True }
-
-lookupWithDefaultFM fm deflt key
-  = case (lookupFM fm key) of { Nothing -> deflt; Just elt -> elt }
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Listifying @FiniteMaps@}
-%*									*
-%************************************************************************
-
-\begin{code}
-fmToList fm = foldFM (\ key elt rest -> (key,elt) : rest) [] fm
-keysFM fm   = foldFM (\ key elt rest -> key : rest)       [] fm
-eltsFM fm   = foldFM (\ key elt rest -> elt : rest)       [] fm
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The implementation of balancing}
-%*									*
-%************************************************************************
-
-%************************************************************************
-%*									*
-\subsubsection{Basic construction of a @FiniteMap@}
-%*									*
-%************************************************************************
-
-@mkBranch@ simply gets the size component right.  This is the ONLY
-(non-trivial) place the Branch object is built, so the ASSERTion
-recursively checks consistency.  (The trivial use of Branch is in
-@unitFM@.)
-
-\begin{code}
-sIZE_RATIO :: Int
-sIZE_RATIO = 5
-
-mkBranch :: (Ord key OUTPUTABLE_key) 		-- Used for the assertion checking only
-	 => Int
-	 -> key -> elt
-	 -> FiniteMap key elt -> FiniteMap key elt
-	 -> FiniteMap key elt
-
-mkBranch which key elt fm_l fm_r
-  = --ASSERT( left_ok && right_ok && balance_ok )
-#if defined(DEBUG_FINITEMAPS)
-    if not ( left_ok && right_ok && balance_ok ) then
-	pprPanic ("mkBranch:"++show which) (vcat [ppr [left_ok, right_ok, balance_ok],
-				       ppr key,
-				       ppr fm_l,
-				       ppr fm_r])
-    else
-#endif
-    let
-	result = Branch key elt (unbox (1 + left_size + right_size)) fm_l fm_r
-    in
---    if sizeFM result <= 8 then
-	result
---    else
---	pprTrace ("mkBranch:"++(show which)) (ppr result) (
---	result
---	)
-  where
-    left_ok  = case fm_l of
-		EmptyFM		         -> True
-		Branch left_key _ _ _ _  -> let
-						biggest_left_key = fst (findMax fm_l)
-					    in
-					    biggest_left_key < key
-    right_ok = case fm_r of
-		EmptyFM		         -> True
-		Branch right_key _ _ _ _ -> let
-						smallest_right_key = fst (findMin fm_r)
-					    in
-					    key < smallest_right_key
-    balance_ok = True -- sigh
-{- LATER:
-    balance_ok
-      = -- Both subtrees have one or no elements...
-	(left_size + right_size <= 1)
--- NO	      || left_size == 0  -- ???
--- NO	      || right_size == 0 -- ???
-    	-- ... or the number of elements in a subtree does not exceed
-	-- sIZE_RATIO times the number of elements in the other subtree
-      || (left_size  * sIZE_RATIO >= right_size &&
-    	  right_size * sIZE_RATIO >= left_size)
--}
-
-    left_size  = sizeFM fm_l
-    right_size = sizeFM fm_r
-
-#ifdef __GLASGOW_HASKELL__
-    unbox :: Int -> Int#
-    unbox (I# size) = size
-#else
-    unbox :: Int -> Int
-    unbox x = x
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{{\em Balanced} construction of a @FiniteMap@}
-%*									*
-%************************************************************************
-
-@mkBalBranch@ rebalances, assuming that the subtrees aren't too far
-out of whack.
-
-\begin{code}
-mkBalBranch :: (Ord key OUTPUTABLE_key)
-	    => key -> elt
-	    -> FiniteMap key elt -> FiniteMap key elt
-	    -> FiniteMap key elt
-
-mkBalBranch key elt fm_L fm_R
-
-  | size_l + size_r < 2
-  = mkBranch 1{-which-} key elt fm_L fm_R
-
-  | size_r > sIZE_RATIO * size_l	-- Right tree too big
-  = case fm_R of
-	Branch _ _ _ fm_rl fm_rr
-		| sizeFM fm_rl < 2 * sizeFM fm_rr -> single_L fm_L fm_R
-		| otherwise	   	          -> double_L fm_L fm_R
-	-- Other case impossible
-
-  | size_l > sIZE_RATIO * size_r	-- Left tree too big
-  = case fm_L of
-	Branch _ _ _ fm_ll fm_lr
-		| sizeFM fm_lr < 2 * sizeFM fm_ll -> single_R fm_L fm_R
-		| otherwise		          -> double_R fm_L fm_R
-	-- Other case impossible
-
-  | otherwise				-- No imbalance
-  = mkBranch 2{-which-} key elt fm_L fm_R
-
-  where
-    size_l   = sizeFM fm_L
-    size_r   = sizeFM fm_R
-
-    single_L fm_l (Branch key_r elt_r _ fm_rl fm_rr)
-	= mkBranch 3{-which-} key_r elt_r (mkBranch 4{-which-} key elt fm_l fm_rl) fm_rr
-
-    double_L fm_l (Branch key_r elt_r _ (Branch key_rl elt_rl _ fm_rll fm_rlr) fm_rr)
-	= mkBranch 5{-which-} key_rl elt_rl (mkBranch 6{-which-} key   elt   fm_l   fm_rll)
-				 (mkBranch 7{-which-} key_r elt_r fm_rlr fm_rr)
-
-    single_R (Branch key_l elt_l _ fm_ll fm_lr) fm_r
-	= mkBranch 8{-which-} key_l elt_l fm_ll (mkBranch 9{-which-} key elt fm_lr fm_r)
-
-    double_R (Branch key_l elt_l _ fm_ll (Branch key_lr elt_lr _ fm_lrl fm_lrr)) fm_r
-	= mkBranch 10{-which-} key_lr elt_lr (mkBranch 11{-which-} key_l elt_l fm_ll  fm_lrl)
-				 (mkBranch 12{-which-} key   elt   fm_lrr fm_r)
-\end{code}
-
-
-\begin{code}
-mkVBalBranch :: (Ord key OUTPUTABLE_key)
-	     => key -> elt
-	     -> FiniteMap key elt -> FiniteMap key elt
-	     -> FiniteMap key elt
-
--- Assert: in any call to (mkVBalBranch_C comb key elt l r),
---	   (a) all keys in l are < all keys in r
---	   (b) all keys in l are < key
---	   (c) all keys in r are > key
-
-mkVBalBranch key elt EmptyFM fm_r = addToFM fm_r key elt
-mkVBalBranch key elt fm_l EmptyFM = addToFM fm_l key elt
-
-mkVBalBranch key elt fm_l@(Branch key_l elt_l _ fm_ll fm_lr)
-		     fm_r@(Branch key_r elt_r _ fm_rl fm_rr)
-  | sIZE_RATIO * size_l < size_r
-  = mkBalBranch key_r elt_r (mkVBalBranch key elt fm_l fm_rl) fm_rr
-
-  | sIZE_RATIO * size_r < size_l
-  = mkBalBranch key_l elt_l fm_ll (mkVBalBranch key elt fm_lr fm_r)
-
-  | otherwise
-  = mkBranch 13{-which-} key elt fm_l fm_r
-
-  where
-    size_l = sizeFM fm_l
-    size_r = sizeFM fm_r
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{Gluing two trees together}
-%*									*
-%************************************************************************
-
-@glueBal@ assumes its two arguments aren't too far out of whack, just
-like @mkBalBranch@.  But: all keys in first arg are $<$ all keys in
-second.
-
-\begin{code}
-glueBal :: (Ord key OUTPUTABLE_key)
-	=> FiniteMap key elt -> FiniteMap key elt
-	-> FiniteMap key elt
-
-glueBal EmptyFM fm2 = fm2
-glueBal fm1 EmptyFM = fm1
-glueBal fm1 fm2
-	-- The case analysis here (absent in Adams' program) is really to deal
-	-- with the case where fm2 is a singleton. Then deleting the minimum means
-	-- we pass an empty tree to mkBalBranch, which breaks its invariant.
-  | sizeFM fm2 > sizeFM fm1
-  = mkBalBranch mid_key2 mid_elt2 fm1 (deleteMin fm2)
-
-  | otherwise
-  = mkBalBranch mid_key1 mid_elt1 (deleteMax fm1) fm2
-  where
-    (mid_key1, mid_elt1) = findMax fm1
-    (mid_key2, mid_elt2) = findMin fm2
-\end{code}
-
-@glueVBal@ copes with arguments which can be of any size.
-But: all keys in first arg are $<$ all keys in second.
-
-\begin{code}
-glueVBal :: (Ord key OUTPUTABLE_key)
-	 => FiniteMap key elt -> FiniteMap key elt
-	 -> FiniteMap key elt
-
-glueVBal EmptyFM fm2 = fm2
-glueVBal fm1 EmptyFM = fm1
-glueVBal fm_l@(Branch key_l elt_l _ fm_ll fm_lr)
-	 fm_r@(Branch key_r elt_r _ fm_rl fm_rr)
-  | sIZE_RATIO * size_l < size_r
-  = mkBalBranch key_r elt_r (glueVBal fm_l fm_rl) fm_rr
-
-  | sIZE_RATIO * size_r < size_l
-  = mkBalBranch key_l elt_l fm_ll (glueVBal fm_lr fm_r)
-
-  | otherwise		-- We now need the same two cases as in glueBal above.
-  = glueBal fm_l fm_r
-  where
-    size_l = sizeFM fm_l
-    size_r = sizeFM fm_r
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Local utilities}
-%*									*
-%************************************************************************
-
-\begin{code}
-splitLT, splitGT :: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> key -> FiniteMap key elt
-
--- splitLT fm split_key  =  fm restricted to keys <  split_key
--- splitGT fm split_key  =  fm restricted to keys >  split_key
-
-splitLT EmptyFM split_key = emptyFM
-splitLT (Branch key elt _ fm_l fm_r) split_key
-  = case compare split_key key of
-	LT -> splitLT fm_l split_key
-	GT -> mkVBalBranch key elt fm_l (splitLT fm_r split_key)
-	EQ -> fm_l
-
-splitGT EmptyFM split_key = emptyFM
-splitGT (Branch key elt _ fm_l fm_r) split_key
-  = case compare split_key key of
-	GT -> splitGT fm_r split_key
-	LT -> mkVBalBranch key elt (splitGT fm_l split_key) fm_r
-	EQ -> fm_r
-
-findMin :: FiniteMap key elt -> (key,elt)
-findMin (Branch key elt _ EmptyFM _) = (key,elt)
-findMin (Branch key elt _ fm_l    _) = findMin fm_l
-
-deleteMin :: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt
-deleteMin (Branch key elt _ EmptyFM fm_r) = fm_r
-deleteMin (Branch key elt _ fm_l    fm_r) = mkBalBranch key elt (deleteMin fm_l) fm_r
-
-findMax :: FiniteMap key elt -> (key,elt)
-findMax (Branch key elt _ _ EmptyFM) = (key,elt)
-findMax (Branch key elt _ _    fm_r) = findMax fm_r
-
-deleteMax :: (Ord key OUTPUTABLE_key) => FiniteMap key elt -> FiniteMap key elt
-deleteMax (Branch key elt _ fm_l EmptyFM) = fm_l
-deleteMax (Branch key elt _ fm_l    fm_r) = mkBalBranch key elt fm_l (deleteMax fm_r)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Output-ery}
-%*									*
-%************************************************************************
-
-\begin{code}
-#if defined(DEBUG_FINITEMAPS)
-
-instance (Outputable key) => Outputable (FiniteMap key elt) where
-    ppr fm = pprX fm
-
-pprX EmptyFM = char '!'
-pprX (Branch key elt sz fm_l fm_r)
- = parens (hcat [pprX fm_l, space,
-		      ppr key, space, int (IF_GHC(I# sz, sz)), space,
-		      pprX fm_r])
-#else
--- and when not debugging the package itself...
-instance (Outputable key, Outputable elt) => Outputable (FiniteMap key elt) where
-    ppr fm = ppr (fmToList fm)
-#endif
-
-#if 0
-instance (Eq key, Eq elt) => Eq (FiniteMap key elt) where
-  fm_1 == fm_2 = (sizeFM   fm_1 == sizeFM   fm_2) &&   -- quick test
-		 (fmToList fm_1 == fmToList fm_2)
-
-{- NO: not clear what The Right Thing to do is:
-instance (Ord key, Ord elt) => Ord (FiniteMap key elt) where
-  fm_1 <= fm_2 = (sizeFM   fm_1 <= sizeFM   fm_2) &&   -- quick test
-		 (fmToList fm_1 <= fmToList fm_2)
--}
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Efficiency pragmas for GHC}
-%*									*
-%************************************************************************
-
-When the FiniteMap module is used in GHC, we specialise it for
-\tr{Uniques}, for dastardly efficiency reasons.
-
-\begin{code}
-#if 0
-
-#if __GLASGOW_HASKELL__
-
-{-# SPECIALIZE addListToFM
-		:: FiniteMap (FastString, FAST_STRING) elt -> [((FAST_STRING, FAST_STRING),elt)] -> FiniteMap (FAST_STRING, FAST_STRING) elt
-		 , FiniteMap RdrName elt -> [(RdrName,elt)] -> FiniteMap RdrName elt
-    IF_NCG(COMMA   FiniteMap Reg elt -> [(Reg COMMA elt)] -> FiniteMap Reg elt)
-    #-}
-{-# SPECIALIZE addListToFM_C
-		:: (elt -> elt -> elt) -> FiniteMap TyCon elt -> [(TyCon,elt)] -> FiniteMap TyCon elt
-		 , (elt -> elt -> elt) -> FiniteMap FastString elt -> [(FAST_STRING,elt)] -> FiniteMap FAST_STRING elt
-    IF_NCG(COMMA   (elt -> elt -> elt) -> FiniteMap Reg elt -> [(Reg COMMA elt)] -> FiniteMap Reg elt)
-    #-}
-{-# SPECIALIZE addToFM
-		:: FiniteMap CLabel elt -> CLabel -> elt  -> FiniteMap CLabel elt
-		 , FiniteMap FastString elt -> FAST_STRING -> elt  -> FiniteMap FAST_STRING elt
-		 , FiniteMap (FastString, FAST_STRING) elt -> (FAST_STRING, FAST_STRING) -> elt  -> FiniteMap (FAST_STRING, FAST_STRING) elt
-		 , FiniteMap RdrName elt -> RdrName -> elt  -> FiniteMap RdrName elt
-    IF_NCG(COMMA   FiniteMap Reg elt -> Reg -> elt  -> FiniteMap Reg elt)
-    #-}
-{-# SPECIALIZE addToFM_C
-		:: (elt -> elt -> elt) -> FiniteMap (RdrName, RdrName) elt -> (RdrName, RdrName) -> elt -> FiniteMap (RdrName, RdrName) elt
-		 , (elt -> elt -> elt) -> FiniteMap FastString elt -> FAST_STRING -> elt -> FiniteMap FAST_STRING elt
-    IF_NCG(COMMA   (elt -> elt -> elt) -> FiniteMap Reg elt -> Reg -> elt -> FiniteMap Reg elt)
-    #-}
-{-# SPECIALIZE bagToFM
-		:: Bag (FastString,elt) -> FiniteMap FAST_STRING elt
-    #-}
-{-# SPECIALIZE delListFromFM
-		:: FiniteMap RdrName elt -> [RdrName]   -> FiniteMap RdrName elt
-		 , FiniteMap FastString elt -> [FAST_STRING]   -> FiniteMap FAST_STRING elt
-    IF_NCG(COMMA   FiniteMap Reg elt -> [Reg]   -> FiniteMap Reg elt)
-    #-}
-{-# SPECIALIZE listToFM
-		:: [([Char],elt)] -> FiniteMap [Char] elt
-		 , [(FastString,elt)] -> FiniteMap FAST_STRING elt
-		 , [((FastString,FAST_STRING),elt)] -> FiniteMap (FAST_STRING, FAST_STRING) elt
-    IF_NCG(COMMA   [(Reg COMMA elt)] -> FiniteMap Reg elt)
-    #-}
-{-# SPECIALIZE lookupFM
-		:: FiniteMap CLabel elt -> CLabel -> Maybe elt
-		 , FiniteMap [Char] elt -> [Char] -> Maybe elt
-		 , FiniteMap FastString elt -> FAST_STRING -> Maybe elt
-		 , FiniteMap (FastString,FAST_STRING) elt -> (FAST_STRING,FAST_STRING) -> Maybe elt
-		 , FiniteMap RdrName elt -> RdrName -> Maybe elt
-		 , FiniteMap (RdrName,RdrName) elt -> (RdrName,RdrName) -> Maybe elt
-    IF_NCG(COMMA   FiniteMap Reg elt -> Reg -> Maybe elt)
-    #-}
-{-# SPECIALIZE lookupWithDefaultFM
-		:: FiniteMap FastString elt -> elt -> FAST_STRING -> elt
-    IF_NCG(COMMA   FiniteMap Reg elt -> elt -> Reg -> elt)
-    #-}
-{-# SPECIALIZE plusFM
-		:: FiniteMap RdrName elt -> FiniteMap RdrName elt -> FiniteMap RdrName elt
-		 , FiniteMap FastString elt -> FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt
-    IF_NCG(COMMA   FiniteMap Reg elt -> FiniteMap Reg elt -> FiniteMap Reg elt)
-    #-}
-{-# SPECIALIZE plusFM_C
-		:: (elt -> elt -> elt) -> FiniteMap FastString elt -> FiniteMap FAST_STRING elt -> FiniteMap FAST_STRING elt
-    IF_NCG(COMMA   (elt -> elt -> elt) -> FiniteMap Reg elt -> FiniteMap Reg elt -> FiniteMap Reg elt)
-    #-}
-
-#endif /* compiling with ghc and have specialiser */
-
-#endif /* 0 */
-\end{code}
diff --git a/ghc/compiler/utils/IOEnv.hs b/ghc/compiler/utils/IOEnv.hs
deleted file mode 100644
index e1dfdb400b..0000000000
--- a/ghc/compiler/utils/IOEnv.hs
+++ /dev/null
@@ -1,208 +0,0 @@
--- (c) The University of Glasgow 2002
---
--- The IO Monad with an environment
---
-
-module IOEnv (
-	IOEnv,	-- Instance of Monad
-
-	-- Standard combinators, specialised
-	returnM, thenM, thenM_, failM, failWithM,
-	mappM, mappM_, mapSndM, sequenceM, sequenceM_, 
-	foldlM, foldrM,
-	mapAndUnzipM, mapAndUnzip3M, 
-	checkM, ifM, zipWithM, zipWithM_,
-
-	-- Getting at the environment
-	getEnv, setEnv, updEnv,
-
-	runIOEnv, unsafeInterleaveM,			
-	tryM, tryAllM, fixM, 
-
-	-- I/O operations
-	ioToIOEnv,
-	IORef, newMutVar, readMutVar, writeMutVar, updMutVar
-  ) where
-#include "HsVersions.h"
-
-import Panic		( try, tryUser, Exception(..) )
-import DATA_IOREF	( IORef, newIORef, readIORef, writeIORef )
-import UNSAFE_IO	( unsafeInterleaveIO )
-import FIX_IO		( fixIO )
-
-
-----------------------------------------------------------------------
---		Defining the monad type
-----------------------------------------------------------------------
-
-
-newtype IOEnv env a = IOEnv (env -> IO a)
-unIOEnv (IOEnv m) = m
-
-instance Monad (IOEnv m) where
-  (>>=)  = thenM
-  (>>)   = thenM_
-  return = returnM
-  fail s = failM	-- Ignore the string
-
-returnM :: a -> IOEnv env a
-returnM a = IOEnv (\ env -> return a)
-
-thenM :: IOEnv env a -> (a -> IOEnv env b) -> IOEnv env b
-thenM (IOEnv m) f = IOEnv (\ env -> do { r <- m env ;
-				       unIOEnv (f r) env })
-
-thenM_ :: IOEnv env a -> IOEnv env b -> IOEnv env b
-thenM_ (IOEnv m) f = IOEnv (\ env -> do { m env ; unIOEnv f env })
-
-failM :: IOEnv env a
-failM = IOEnv (\ env -> ioError (userError "IOEnv failure"))
-
-failWithM :: String -> IOEnv env a
-failWithM s = IOEnv (\ env -> ioError (userError s))
-
-
-
-----------------------------------------------------------------------
---	Fundmantal combinators specific to the monad
-----------------------------------------------------------------------
-
-
----------------------------
-runIOEnv :: env -> IOEnv env a -> IO a
-runIOEnv env (IOEnv m) = m env
-
-
----------------------------
-{-# NOINLINE fixM #-}
-  -- Aargh!  Not inlining fixTc alleviates a space leak problem.
-  -- Normally fixTc is used with a lazy tuple match: if the optimiser is
-  -- shown the definition of fixTc, it occasionally transforms the code
-  -- in such a way that the code generator doesn't spot the selector
-  -- thunks.  Sigh.
-
-fixM :: (a -> IOEnv env a) -> IOEnv env a
-fixM f = IOEnv (\ env -> fixIO (\ r -> unIOEnv (f r) env))
-
-
----------------------------
-tryM :: IOEnv env r -> IOEnv env (Either Exception r)
--- Reflect UserError exceptions into IOEnv monad
--- The idea is that errors in the program being compiled will give rise
--- to UserErrors.  But, say, pattern-match failures in GHC itself should
--- not be caught here, else they'll be reported as errors in the program 
--- begin compiled!
-tryM (IOEnv thing) = IOEnv (\ env -> tryUser (thing env))
-
-tryAllM :: IOEnv env r -> IOEnv env (Either Exception r)
--- Catch *all* exceptions
--- This is used when running a Template-Haskell splice, when
--- even a pattern-match failure is a programmer error
-tryAllM (IOEnv thing) = IOEnv (\ env -> try (thing env))
-
----------------------------
-unsafeInterleaveM :: IOEnv env a -> IOEnv env a
-unsafeInterleaveM (IOEnv m) = IOEnv (\ env -> unsafeInterleaveIO (m env))
-
-
-----------------------------------------------------------------------
---	Accessing input/output
-----------------------------------------------------------------------
-
-ioToIOEnv :: IO a -> IOEnv env a
-ioToIOEnv io = IOEnv (\ env -> io)
-
-newMutVar :: a -> IOEnv env (IORef a)
-newMutVar val = IOEnv (\ env -> newIORef val)
-
-writeMutVar :: IORef a -> a -> IOEnv env ()
-writeMutVar var val = IOEnv (\ env -> writeIORef var val)
-
-readMutVar :: IORef a -> IOEnv env a
-readMutVar var = IOEnv (\ env -> readIORef var)
-
-updMutVar :: IORef a -> (a->a) -> IOEnv env ()
-updMutVar var upd_fn = IOEnv (\ env -> do { v <- readIORef var; writeIORef var (upd_fn v) })
-
-
-----------------------------------------------------------------------
---	Accessing the environment
-----------------------------------------------------------------------
-
-getEnv :: IOEnv env env
-{-# INLINE getEnv #-}
-getEnv = IOEnv (\ env -> return env)
-
-setEnv :: env' -> IOEnv env' a -> IOEnv env a
-{-# INLINE setEnv #-}
-setEnv new_env (IOEnv m) = IOEnv (\ env -> m new_env)
-
-updEnv :: (env -> env') -> IOEnv env' a -> IOEnv env a
-{-# INLINE updEnv #-}
-updEnv upd (IOEnv m) = IOEnv (\ env -> m (upd env))
-
-
-----------------------------------------------------------------------
---	Standard combinators, but specialised for this monad
---			(for efficiency)
-----------------------------------------------------------------------
-
-mappM  	      :: (a -> IOEnv env b) -> [a] -> IOEnv env [b]
-mappM_ 	      :: (a -> IOEnv env b) -> [a] -> IOEnv env ()
-mapSndM       :: (b -> IOEnv env c) -> [(a,b)] -> IOEnv env [(a,c)]
-	-- Funny names to avoid clash with Prelude
-sequenceM     :: [IOEnv env a] -> IOEnv env [a]
-sequenceM_    :: [IOEnv env a] -> IOEnv env ()
-foldlM        :: (a -> b -> IOEnv env a)  -> a -> [b] -> IOEnv env a
-foldrM        :: (b -> a -> IOEnv env a)  -> a -> [b] -> IOEnv env a
-mapAndUnzipM  :: (a -> IOEnv env (b,c))   -> [a] -> IOEnv env ([b],[c])
-mapAndUnzip3M :: (a -> IOEnv env (b,c,d)) -> [a] -> IOEnv env ([b],[c],[d])
-checkM	      :: Bool -> IOEnv env a -> IOEnv env ()	-- Perform arg if bool is False
-ifM	      :: Bool -> IOEnv env a -> IOEnv env ()	-- Perform arg if bool is True
-
-mappM f []     = return []
-mappM f (x:xs) = do { r <- f x; rs <- mappM f xs; return (r:rs) }
-
-mapSndM f []     = return []
-mapSndM f ((a,b):xs) = do { c <- f b; rs <- mapSndM f xs; return ((a,c):rs) }
-
-mappM_ f []     = return ()
-mappM_ f (x:xs) = f x >> mappM_ f xs
-
-zipWithM :: (a -> b -> IOEnv env c) -> [a] -> [b] -> IOEnv env [c]
-zipWithM f [] bs = return []
-zipWithM f as [] = return []
-zipWithM f (a:as) (b:bs) = do { r <- f a b; rs <- zipWithM f as bs; return (r:rs) } 
-
-zipWithM_ :: (a -> b -> IOEnv env c) -> [a] -> [b] -> IOEnv env ()
-zipWithM_ f [] bs = return ()
-zipWithM_ f as [] = return ()
-zipWithM_ f (a:as) (b:bs) = do { f a b; zipWithM_ f as bs } 
-
-sequenceM [] = return []
-sequenceM (x:xs) = do { r <- x; rs <- sequenceM xs; return (r:rs) }
-
-sequenceM_ []     = return ()
-sequenceM_ (x:xs) = do { x; sequenceM_ xs }
-
-foldlM k z [] = return z
-foldlM k z (x:xs) = do { r <- k z x; foldlM k r xs }
-
-foldrM k z [] = return z
-foldrM k z (x:xs) = do { r <- foldrM k z xs; k x r }
-
-mapAndUnzipM f []     = return ([],[])
-mapAndUnzipM f (x:xs) = do { (r,s) <- f x; 
-			     (rs,ss) <- mapAndUnzipM f xs; 
-			     return (r:rs, s:ss) }
-
-mapAndUnzip3M f []     = return ([],[], [])
-mapAndUnzip3M f (x:xs) = do { (r,s,t) <- f x; 
-			      (rs,ss,ts) <- mapAndUnzip3M f xs; 
-			      return (r:rs, s:ss, t:ts) }
-
-checkM True  err = return ()
-checkM False err = do { err; return () }
-
-ifM True  do_it = do { do_it; return () }
-ifM False do_it = return ()
diff --git a/ghc/compiler/utils/ListSetOps.lhs b/ghc/compiler/utils/ListSetOps.lhs
deleted file mode 100644
index 02950722a2..0000000000
--- a/ghc/compiler/utils/ListSetOps.lhs
+++ /dev/null
@@ -1,227 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[ListSetOps]{Set-like operations on lists}
-
-\begin{code}
-module ListSetOps (
-	unionLists, minusList, insertList,
-
-	-- Association lists
-	Assoc, assoc, assocMaybe, assocUsing, assocDefault, assocDefaultUsing,
-	emptyAssoc, unitAssoc, mapAssoc, plusAssoc_C, extendAssoc_C,
-	mkLookupFun, findInList, assocElts,
-
-	-- Duplicate handling
-	hasNoDups, runs, removeDups, findDupsEq, 
-	equivClasses, equivClassesByUniq
-
-   ) where
-
-#include "HsVersions.h"
-
-import Outputable
-import Unique	( Unique )
-import UniqFM	( eltsUFM, emptyUFM, addToUFM_C )
-import Util	( isn'tIn, isIn, mapAccumR, sortLe )
-import List	( partition )
-\end{code}
-
-
-%************************************************************************
-%*									*
-	Treating lists as sets
-	Assumes the lists contain no duplicates, but are unordered
-%*									*
-%************************************************************************
-
-\begin{code}
-insertList :: Eq a => a -> [a] -> [a]
--- Assumes the arg list contains no dups; guarantees the result has no dups
-insertList x xs | isIn "insert" x xs = xs
-	    | otherwise		 = x : xs
-
-unionLists :: (Eq a) => [a] -> [a] -> [a]
--- Assumes that the arguments contain no duplicates
-unionLists xs ys = [x | x <- xs, isn'tIn "unionLists" x ys] ++ ys
-
-minusList :: (Eq a) => [a] -> [a] -> [a]
--- Everything in the first list that is not in the second list:
-minusList xs ys = [ x | x <- xs, isn'tIn "minusList" x ys]
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Utils-assoc]{Association lists}
-%*									*
-%************************************************************************
-
-Inefficient finite maps based on association lists and equality.
-
-\begin{code}
-type Assoc a b = [(a,b)]	-- A finite mapping based on equality and association lists
-
-emptyAssoc	  :: Assoc a b
-unitAssoc	  :: a -> b -> Assoc a b
-assocElts	  :: Assoc a b -> [(a,b)]
-assoc		  :: (Eq a) => String -> Assoc a b -> a -> b
-assocDefault	  :: (Eq a) => b -> Assoc a b -> a -> b
-assocUsing	  :: (a -> a -> Bool) -> String -> Assoc a b -> a -> b
-assocMaybe	  :: (Eq a) => Assoc a b -> a -> Maybe b
-assocDefaultUsing :: (a -> a -> Bool) -> b -> Assoc a b -> a -> b
-mapAssoc	  :: (b -> c) -> Assoc a b -> Assoc a c
-extendAssoc_C	  :: (Eq a) => (b -> b -> b) -> Assoc a b -> (a,b)     -> Assoc a b
-plusAssoc_C	  :: (Eq a) => (b -> b -> b) -> Assoc a b -> Assoc a b -> Assoc a b
-	-- combining fn takes (old->new->result)
-
-emptyAssoc    = []
-unitAssoc a b = [(a,b)]
-assocElts xs  = xs
-
-assocDefaultUsing eq deflt ((k,v) : rest) key
-  | k `eq` key = v
-  | otherwise  = assocDefaultUsing eq deflt rest key
-
-assocDefaultUsing eq deflt [] key = deflt
-
-assoc crash_msg         list key = assocDefaultUsing (==) (panic ("Failed in assoc: " ++ crash_msg)) list key
-assocDefault deflt      list key = assocDefaultUsing (==) deflt list key
-assocUsing eq crash_msg list key = assocDefaultUsing eq (panic ("Failed in assoc: " ++ crash_msg)) list key
-
-assocMaybe alist key
-  = lookup alist
-  where
-    lookup []		  = Nothing
-    lookup ((tv,ty):rest) = if key == tv then Just ty else lookup rest
-
-mapAssoc f alist = [(key, f val) | (key,val) <- alist]
-
-plusAssoc_C combine []  new = new	-- Shortcut for common case
-plusAssoc_C combine old new = foldl (extendAssoc_C combine) old new
-
-extendAssoc_C combine old_list (new_key, new_val)
-  = go old_list
-  where
-    go [] = [(new_key, new_val)]
-    go ((old_key, old_val) : old_list) 
-	| new_key == old_key = ((old_key, old_val `combine` new_val) : old_list)
-	| otherwise	     = (old_key, old_val) : go old_list
-\end{code}
-
-
-@mkLookupFun eq alist@ is a function which looks up
-its argument in the association list @alist@, returning a Maybe type.
-@mkLookupFunDef@ is similar except that it is given a value to return
-on failure.
-
-\begin{code}
-mkLookupFun :: (key -> key -> Bool)	-- Equality predicate
-	    -> [(key,val)] 		-- The assoc list
-	    -> key 			-- The key
-	    -> Maybe val		-- The corresponding value
-
-mkLookupFun eq alist s
-  = case [a | (s',a) <- alist, s' `eq` s] of
-      []    -> Nothing
-      (a:_) -> Just a
-
-findInList :: (a -> Bool) -> [a] -> Maybe a
-findInList p [] = Nothing
-findInList p (x:xs) | p x	= Just x
-		    | otherwise = findInList p xs
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Utils-dups]{Duplicate-handling}
-%*									*
-%************************************************************************
-
-\begin{code}
-hasNoDups :: (Eq a) => [a] -> Bool
-
-hasNoDups xs = f [] xs
-  where
-    f seen_so_far []     = True
-    f seen_so_far (x:xs) = if x `is_elem` seen_so_far then
-				False
-			   else
-				f (x:seen_so_far) xs
-
-    is_elem = isIn "hasNoDups"
-\end{code}
-
-\begin{code}
-equivClasses :: (a -> a -> Ordering) 	-- Comparison
-	     -> [a]
-	     -> [[a]]
-
-equivClasses cmp stuff@[]     = []
-equivClasses cmp stuff@[item] = [stuff]
-equivClasses cmp items
-  = runs eq (sortLe le items)
-  where
-    eq a b = case cmp a b of { EQ -> True; _ -> False }
-    le a b = case cmp a b of { LT -> True; EQ -> True; GT -> False }
-\end{code}
-
-The first cases in @equivClasses@ above are just to cut to the point
-more quickly...
-
-@runs@ groups a list into a list of lists, each sublist being a run of
-identical elements of the input list. It is passed a predicate @p@ which
-tells when two elements are equal.
-
-\begin{code}
-runs :: (a -> a -> Bool) 	-- Equality
-     -> [a]
-     -> [[a]]
-
-runs p []     = []
-runs p (x:xs) = case (span (p x) xs) of
-		  (first, rest) -> (x:first) : (runs p rest)
-\end{code}
-
-\begin{code}
-removeDups :: (a -> a -> Ordering) 	-- Comparison function
-	   -> [a]
-	   -> ([a], 	-- List with no duplicates
-	       [[a]])	-- List of duplicate groups.  One representative from
-			-- each group appears in the first result
-
-removeDups cmp []  = ([], [])
-removeDups cmp [x] = ([x],[])
-removeDups cmp xs
-  = case (mapAccumR collect_dups [] (equivClasses cmp xs)) of { (dups, xs') ->
-    (xs', dups) }
-  where
-    collect_dups dups_so_far [x]         = (dups_so_far,      x)
-    collect_dups dups_so_far dups@(x:xs) = (dups:dups_so_far, x)
-
-findDupsEq :: (a->a->Bool) -> [a] -> [[a]]
-findDupsEq eq [] = []
-findDupsEq eq (x:xs) | null eq_xs  = findDupsEq eq xs
-		     | otherwise   = (x:eq_xs) : findDupsEq eq neq_xs
-		     where
-		       (eq_xs, neq_xs) = partition (eq x) xs
-\end{code}
-
-
-\begin{code}
-equivClassesByUniq :: (a -> Unique) -> [a] -> [[a]]
-	-- NB: it's *very* important that if we have the input list [a,b,c],
-	-- where a,b,c all have the same unique, then we get back the list
-	-- 	[a,b,c]
-	-- not
-	--	[c,b,a]
-	-- Hence the use of foldr, plus the reversed-args tack_on below
-equivClassesByUniq get_uniq xs
-  = eltsUFM (foldr add emptyUFM xs)
-  where
-    add a ufm = addToUFM_C tack_on ufm (get_uniq a) [a]
-    tack_on old new = new++old
-\end{code}
-
-
diff --git a/ghc/compiler/utils/Maybes.lhs b/ghc/compiler/utils/Maybes.lhs
deleted file mode 100644
index 3c9bd693e6..0000000000
--- a/ghc/compiler/utils/Maybes.lhs
+++ /dev/null
@@ -1,123 +0,0 @@
-%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-%
-\section[Maybes]{The `Maybe' types and associated utility functions}
-
-\begin{code}
-module Maybes (
-	module Maybe,		-- Re-export all of Maybe
-
-	MaybeErr(..),	-- Instance of Monad
-	failME,
-
-	orElse, 
-	mapCatMaybes,
-	allMaybes,
-	firstJust,
-	expectJust,
-	maybeToBool,
-
-	thenMaybe, seqMaybe, returnMaybe, failMaybe
-    ) where
-
-#include "HsVersions.h"
-
-import Maybe
-
-
-infixr 4 `orElse`
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Maybe type]{The @Maybe@ type}
-%*									*
-%************************************************************************
-
-\begin{code}
-maybeToBool :: Maybe a -> Bool
-maybeToBool Nothing  = False
-maybeToBool (Just x) = True
-\end{code}
-
-@catMaybes@ takes a list of @Maybe@s and returns a list of
-the contents of all the @Just@s in it.	@allMaybes@ collects
-a list of @Justs@ into a single @Just@, returning @Nothing@ if there
-are any @Nothings@.
-
-\begin{code}
-allMaybes :: [Maybe a] -> Maybe [a]
-allMaybes [] = Just []
-allMaybes (Nothing : ms) = Nothing
-allMaybes (Just x  : ms) = case (allMaybes ms) of
-			     Nothing -> Nothing
-			     Just xs -> Just (x:xs)
-
-\end{code}
-
-@firstJust@ takes a list of @Maybes@ and returns the
-first @Just@ if there is one, or @Nothing@ otherwise.
-
-\begin{code}
-firstJust :: [Maybe a] -> Maybe a
-firstJust [] = Nothing
-firstJust (Just x  : ms) = Just x
-firstJust (Nothing : ms) = firstJust ms
-\end{code}
-
-\begin{code}
-expectJust :: String -> Maybe a -> a
-{-# INLINE expectJust #-}
-expectJust err (Just x) = x
-expectJust err Nothing  = error ("expectJust " ++ err)
-\end{code}
-
-\begin{code}
-mapCatMaybes :: (a -> Maybe b) -> [a] -> [b]
-mapCatMaybes f [] = []
-mapCatMaybes f (x:xs) = case f x of
-			  Just y  -> y : mapCatMaybes f xs
-			  Nothing -> mapCatMaybes f xs
-\end{code}
-
-The Maybe monad
-~~~~~~~~~~~~~~~
-\begin{code}
-seqMaybe :: Maybe a -> Maybe a -> Maybe a
-seqMaybe (Just x) _  = Just x
-seqMaybe Nothing  my = my
-
-thenMaybe :: Maybe a -> (a -> Maybe b) -> Maybe b
-thenMaybe ma mb = case ma of
-		    Just x  -> mb x
-		    Nothing -> Nothing
-
-returnMaybe :: a -> Maybe a
-returnMaybe = Just
-
-failMaybe :: Maybe a
-failMaybe = Nothing
-
-orElse :: Maybe a -> a -> a
-(Just x) `orElse` y = x
-Nothing  `orElse` y = y
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[MaybeErr type]{The @MaybeErr@ type}
-%*									*
-%************************************************************************
-
-\begin{code}
-data MaybeErr err val = Succeeded val | Failed err
-
-instance Monad (MaybeErr err) where
-  return v = Succeeded v
-  Succeeded v >>= k = k v
-  Failed e    >>= k = Failed e
-
-failME :: err -> MaybeErr err val
-failME e = Failed e
-\end{code}
diff --git a/ghc/compiler/utils/OrdList.lhs b/ghc/compiler/utils/OrdList.lhs
deleted file mode 100644
index 7f22b38e49..0000000000
--- a/ghc/compiler/utils/OrdList.lhs
+++ /dev/null
@@ -1,83 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1993-1998
-%
-
-This is useful, general stuff for the Native Code Generator.
-
-Provide trees (of instructions), so that lists of instructions
-can be appended in linear time.
-
-\begin{code}
-module OrdList (
-	OrdList, 
-        nilOL, isNilOL, unitOL, appOL, consOL, snocOL, concatOL,
-        fromOL, toOL, foldrOL, foldlOL
-) where
-
-infixl 5  `appOL`
-infixl 5  `snocOL`
-infixr 5  `consOL`
-
-data OrdList a
-  = Many [a]
-  | Two (OrdList a) (OrdList a)
-  | One  a
-  | None
-
-nilOL    :: OrdList a
-isNilOL  :: OrdList a -> Bool
-
-unitOL   :: a           -> OrdList a
-snocOL   :: OrdList a   -> a         -> OrdList a
-consOL   :: a           -> OrdList a -> OrdList a
-appOL    :: OrdList a   -> OrdList a -> OrdList a
-concatOL :: [OrdList a] -> OrdList a
-
-nilOL        = None
-unitOL as    = One as
-snocOL as b  = Two as (One b)
-consOL a  bs = Two (One a) bs
-concatOL aas = foldr Two None aas
-
-isNilOL None        = True
-isNilOL (One _)     = False
-isNilOL (Two as bs) = isNilOL as && isNilOL bs
-isNilOL (Many xs)   = null xs
-
-appOL None bs   = bs
-appOL as   None = as
-appOL as   bs   = Two as bs
-
-mapOL :: (a -> b) -> OrdList a -> OrdList b
-mapOL f None = None
-mapOL f (One x) = One (f x)
-mapOL f (Two x y) = Two (mapOL f x) (mapOL f y)
-mapOL f (Many xs) = Many (map f xs)
-
-instance Functor OrdList where
-  fmap = mapOL
-
-foldrOL :: (a->b->b) -> b -> OrdList a -> b
-foldrOL k z None        = z
-foldrOL k z (One x)     = k x z
-foldrOL k z (Two b1 b2) = foldrOL k (foldrOL k z b2) b1
-foldrOL k z (Many xs)   = foldr k z xs
-
-foldlOL :: (b->a->b) -> b -> OrdList a -> b
-foldlOL k z None        = z
-foldlOL k z (One x)     = k z x
-foldlOL k z (Two b1 b2) = foldlOL k (foldlOL k z b1) b2
-foldlOL k z (Many xs)   = foldl k z xs
-
-fromOL :: OrdList a -> [a]
-fromOL ol 
-   = flat ol []
-     where
-        flat None      rest = rest
-        flat (One x)   rest = x:rest
-        flat (Two a b) rest = flat a (flat b rest)
-	flat (Many xs) rest = xs ++ rest
-
-toOL :: [a] -> OrdList a
-toOL xs = Many xs
-\end{code}
diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs
deleted file mode 100644
index cf99e12bcf..0000000000
--- a/ghc/compiler/utils/Outputable.lhs
+++ /dev/null
@@ -1,540 +0,0 @@
-%
-% (c) The GRASP Project, Glasgow University, 1992-1998
-%
-\section[Outputable]{Classes for pretty-printing}
-
-Defines classes for pretty-printing and forcing, both forms of
-``output.''
-
-\begin{code}
-
-module Outputable (
-	Outputable(..), OutputableBndr(..),	-- Class
-
-	BindingSite(..),
-
-	PprStyle, CodeStyle(..), PrintUnqualified, alwaysQualify,
-	getPprStyle, withPprStyle, withPprStyleDoc, pprDeeper, pprSetDepth,
-	codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
-	ifPprDebug, unqualStyle, 
-	mkErrStyle, defaultErrStyle, defaultDumpStyle, defaultUserStyle,
-
-	SDoc, 		-- Abstract
-	docToSDoc,
-	interppSP, interpp'SP, pprQuotedList, pprWithCommas,
-	empty, nest,
-	text, char, ftext, ptext,
-	int, integer, float, double, rational,
-	parens, brackets, braces, quotes, doubleQuotes, angleBrackets,
-	semi, comma, colon, dcolon, space, equals, dot, arrow,
-	lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
-	(<>), (<+>), hcat, hsep, 
-	($$), ($+$), vcat, 
-	sep, cat, 
-	fsep, fcat, 
-	hang, punctuate,
-	speakNth, speakNTimes, speakN, speakNOf, plural,
-
-	printSDoc, printErrs, printDump,
-	printForC, printForAsm, printForUser,
-	pprCode, mkCodeStyle,
-	showSDoc, showSDocForUser, showSDocDebug, showSDocDump,
-	showSDocUnqual, showsPrecSDoc,
-	pprHsChar, pprHsString,
-
-	-- error handling
-	pprPanic, assertPprPanic, pprPanic#, pprPgmError, 
-	pprTrace, warnPprTrace,
-	trace, pgmError, panic, panic#, assertPanic
-    ) where
-
-#include "HsVersions.h"
-
-
-import {-# SOURCE #-} 	Module( Module )
-import {-# SOURCE #-} 	OccName( OccName )
-
-import StaticFlags	( opt_PprStyle_Debug, opt_PprUserLength )
-import PackageConfig	( PackageId, packageIdString )
-import FastString
-import qualified Pretty
-import Pretty		( Doc, Mode(..) )
-import Panic
-
-import DATA_WORD	( Word32 )
-
-import IO		( Handle, stderr, stdout, hFlush )
-import Char             ( ord )
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The @PprStyle@ data type}
-%*									*
-%************************************************************************
-
-\begin{code}
-data PprStyle
-  = PprUser PrintUnqualified Depth
-		-- Pretty-print in a way that will make sense to the
-		-- ordinary user; must be very close to Haskell
-		-- syntax, etc.
-		-- Assumes printing tidied code: non-system names are
-		-- printed without uniques.
-
-  | PprCode CodeStyle
-		-- Print code; either C or assembler
-
-  | PprDump	-- For -ddump-foo; less verbose than PprDebug.
-		-- Does not assume tidied code: non-external names
-		-- are printed with uniques.
-
-  | PprDebug	-- Full debugging output
-
-data CodeStyle = CStyle		-- The format of labels differs for C and assembler
-	       | AsmStyle
-
-data Depth = AllTheWay
-           | PartWay Int	-- 0 => stop
-
-
-type PrintUnqualified = Module -> OccName -> Bool
-	-- This function tells when it's ok to print 
-	-- a (Global) name unqualified
-
-alwaysQualify,neverQualify :: PrintUnqualified
-alwaysQualify m n = False
-neverQualify  m n = True
-
-defaultUserStyle = mkUserStyle alwaysQualify AllTheWay
-
-defaultDumpStyle |  opt_PprStyle_Debug = PprDebug
-		 |  otherwise          = PprDump
-
-mkErrStyle :: PrintUnqualified -> PprStyle
--- Style for printing error messages
-mkErrStyle print_unqual = mkUserStyle print_unqual (PartWay opt_PprUserLength)
-
-defaultErrStyle :: PprStyle
--- Default style for error messages
--- It's a bit of a hack because it doesn't take into account what's in scope
--- Only used for desugarer warnings, and typechecker errors in interface sigs
-defaultErrStyle 
-  | opt_PprStyle_Debug = mkUserStyle alwaysQualify AllTheWay
-  | otherwise	       = mkUserStyle alwaysQualify  (PartWay opt_PprUserLength)
-
-mkUserStyle unqual depth |  opt_PprStyle_Debug = PprDebug
-	          	 |  otherwise          = PprUser unqual depth
-\end{code}
-
-Orthogonal to the above printing styles are (possibly) some
-command-line flags that affect printing (often carried with the
-style).  The most likely ones are variations on how much type info is
-shown.
-
-The following test decides whether or not we are actually generating
-code (either C or assembly), or generating interface files.
-
-%************************************************************************
-%*									*
-\subsection{The @SDoc@ data type}
-%*									*
-%************************************************************************
-
-\begin{code}
-type SDoc = PprStyle -> Doc
-
-withPprStyle :: PprStyle -> SDoc -> SDoc
-withPprStyle sty d sty' = d sty
-
-withPprStyleDoc :: PprStyle -> SDoc -> Doc
-withPprStyleDoc sty d = d sty
-
-pprDeeper :: SDoc -> SDoc
-pprDeeper d (PprUser unqual (PartWay 0)) = Pretty.text "..."
-pprDeeper d (PprUser unqual (PartWay n)) = d (PprUser unqual (PartWay (n-1)))
-pprDeeper d other_sty        		 = d other_sty
-
-pprSetDepth :: Int -> SDoc -> SDoc
-pprSetDepth n d (PprUser unqual _) = d (PprUser unqual (PartWay n))
-pprSetDepth n d other_sty	   = d other_sty
-
-getPprStyle :: (PprStyle -> SDoc) -> SDoc
-getPprStyle df sty = df sty sty
-\end{code}
-
-\begin{code}
-unqualStyle :: PprStyle -> PrintUnqualified
-unqualStyle (PprUser    unqual _) m n = unqual m n
-unqualStyle other		  m n = False
-
-codeStyle :: PprStyle -> Bool
-codeStyle (PprCode _)	  = True
-codeStyle _		  = False
-
-asmStyle :: PprStyle -> Bool
-asmStyle (PprCode AsmStyle)  = True
-asmStyle other               = False
-
-dumpStyle :: PprStyle -> Bool
-dumpStyle PprDump = True
-dumpStyle other   = False
-
-debugStyle :: PprStyle -> Bool
-debugStyle PprDebug	  = True
-debugStyle other	  = False
-
-userStyle ::  PprStyle -> Bool
-userStyle (PprUser _ _) = True
-userStyle other         = False
-
-ifPprDebug :: SDoc -> SDoc	  -- Empty for non-debug style
-ifPprDebug d sty@PprDebug = d sty
-ifPprDebug d sty	  = Pretty.empty
-\end{code}
-
-\begin{code}
--- Unused [7/02 sof]
-printSDoc :: SDoc -> PprStyle -> IO ()
-printSDoc d sty = do
-  Pretty.printDoc PageMode stdout (d sty)
-  hFlush stdout
-
--- I'm not sure whether the direct-IO approach of Pretty.printDoc
--- above is better or worse than the put-big-string approach here
-printErrs :: Doc -> IO ()
-printErrs doc = do Pretty.printDoc PageMode stderr doc
-		   hFlush stderr
-
-printDump :: SDoc -> IO ()
-printDump doc = do
-   Pretty.printDoc PageMode stdout (better_doc defaultDumpStyle)
-   hFlush stdout
- where
-   better_doc = doc $$ text ""
-
-printForUser :: Handle -> PrintUnqualified -> SDoc -> IO ()
-printForUser handle unqual doc 
-  = Pretty.printDoc PageMode handle (doc (mkUserStyle unqual AllTheWay))
-
--- printForC, printForAsm do what they sound like
-printForC :: Handle -> SDoc -> IO ()
-printForC handle doc = Pretty.printDoc LeftMode handle (doc (PprCode CStyle))
-
-printForAsm :: Handle -> SDoc -> IO ()
-printForAsm handle doc = Pretty.printDoc LeftMode handle (doc (PprCode AsmStyle))
-
-pprCode :: CodeStyle -> SDoc -> SDoc
-pprCode cs d = withPprStyle (PprCode cs) d
-
-mkCodeStyle :: CodeStyle -> PprStyle
-mkCodeStyle = PprCode
-
--- Can't make SDoc an instance of Show because SDoc is just a function type
--- However, Doc *is* an instance of Show
--- showSDoc just blasts it out as a string
-showSDoc :: SDoc -> String
-showSDoc d = show (d defaultUserStyle)
-
-showSDocForUser :: PrintUnqualified -> SDoc -> String
-showSDocForUser unqual doc = show (doc (mkUserStyle unqual AllTheWay))
-
-showSDocUnqual :: SDoc -> String
--- Only used in the gruesome HsExpr.isOperator
-showSDocUnqual d = show (d (mkUserStyle neverQualify AllTheWay))
-
-showsPrecSDoc :: Int -> SDoc -> ShowS
-showsPrecSDoc p d = showsPrec p (d defaultUserStyle)
-
-showSDocDump :: SDoc -> String
-showSDocDump d = show (d PprDump)
-
-showSDocDebug :: SDoc -> String
-showSDocDebug d = show (d PprDebug)
-\end{code}
-
-\begin{code}
-docToSDoc :: Doc -> SDoc
-docToSDoc d = \_ -> d
-
-empty sty      = Pretty.empty
-text s sty     = Pretty.text s
-char c sty     = Pretty.char c
-ftext s sty    = Pretty.ftext s
-ptext s sty    = Pretty.ptext s
-int n sty      = Pretty.int n
-integer n sty  = Pretty.integer n
-float n sty    = Pretty.float n
-double n sty   = Pretty.double n
-rational n sty = Pretty.rational n
-
-parens d sty       = Pretty.parens (d sty)
-braces d sty       = Pretty.braces (d sty)
-brackets d sty     = Pretty.brackets (d sty)
-doubleQuotes d sty = Pretty.doubleQuotes (d sty)
-angleBrackets d    = char '<' <> d <> char '>'
-
--- quotes encloses something in single quotes...
--- but it omits them if the thing ends in a single quote
--- so that we don't get `foo''.  Instead we just have foo'.
-quotes d sty = case show pp_d of
-		 ('\'' : _) -> pp_d
-		 other	    -> Pretty.quotes pp_d
-	     where
-	       pp_d = d sty
-
-semi sty   = Pretty.semi
-comma sty  = Pretty.comma
-colon sty  = Pretty.colon
-equals sty = Pretty.equals
-space sty  = Pretty.space
-lparen sty = Pretty.lparen
-rparen sty = Pretty.rparen
-lbrack sty = Pretty.lbrack
-rbrack sty = Pretty.rbrack
-lbrace sty = Pretty.lbrace
-rbrace sty = Pretty.rbrace
-dcolon sty = Pretty.ptext SLIT("::")
-arrow  sty = Pretty.ptext SLIT("->")
-underscore = char '_'
-dot	   = char '.'
-
-nest n d sty    = Pretty.nest n (d sty)
-(<>) d1 d2 sty  = (Pretty.<>)  (d1 sty) (d2 sty)
-(<+>) d1 d2 sty = (Pretty.<+>) (d1 sty) (d2 sty)
-($$) d1 d2 sty  = (Pretty.$$)  (d1 sty) (d2 sty)
-($+$) d1 d2 sty = (Pretty.$+$) (d1 sty) (d2 sty)
-
-hcat ds sty = Pretty.hcat [d sty | d <- ds]
-hsep ds sty = Pretty.hsep [d sty | d <- ds]
-vcat ds sty = Pretty.vcat [d sty | d <- ds]
-sep ds sty  = Pretty.sep  [d sty | d <- ds]
-cat ds sty  = Pretty.cat  [d sty | d <- ds]
-fsep ds sty = Pretty.fsep [d sty | d <- ds]
-fcat ds sty = Pretty.fcat [d sty | d <- ds]
-
-hang d1 n d2 sty   = Pretty.hang (d1 sty) n (d2 sty)
-
-punctuate :: SDoc -> [SDoc] -> [SDoc]
-punctuate p []     = []
-punctuate p (d:ds) = go d ds
-		   where
-		     go d [] = [d]
-		     go d (e:es) = (d <> p) : go e es
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Outputable-class]{The @Outputable@ class}
-%*									*
-%************************************************************************
-
-\begin{code}
-class Outputable a where
-	ppr :: a -> SDoc
-\end{code}
-
-\begin{code}
-instance Outputable Bool where
-    ppr True  = ptext SLIT("True")
-    ppr False = ptext SLIT("False")
-
-instance Outputable Int where
-   ppr n = int n
-
-instance Outputable () where
-   ppr _ = text "()"
-
-instance (Outputable a) => Outputable [a] where
-    ppr xs = brackets (fsep (punctuate comma (map ppr xs)))
-
-instance (Outputable a, Outputable b) => Outputable (a, b) where
-    ppr (x,y) = parens (sep [ppr x <> comma, ppr y])
-
-instance Outputable a => Outputable (Maybe a) where
-  ppr Nothing = ptext SLIT("Nothing")
-  ppr (Just x) = ptext SLIT("Just") <+> ppr x
-
--- ToDo: may not be used
-instance (Outputable a, Outputable b, Outputable c) => Outputable (a, b, c) where
-    ppr (x,y,z) =
-      parens (sep [ppr x <> comma,
-		   ppr y <> comma,
-		   ppr z ])
-
-instance (Outputable a, Outputable b, Outputable c, Outputable d) =>
-	 Outputable (a, b, c, d) where
-    ppr (x,y,z,w) =
-      parens (sep [ppr x <> comma,
-		   ppr y <> comma,
-		   ppr z <> comma,
-		   ppr w])
-
-instance Outputable FastString where
-    ppr fs = ftext fs		-- Prints an unadorned string,
-				-- no double quotes or anything
-
-instance Outputable PackageId where
-   ppr pid = text (packageIdString pid)
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{The @OutputableBndr@ class}
-%*									*
-%************************************************************************
-
-When we print a binder, we often want to print its type too.
-The @OutputableBndr@ class encapsulates this idea.
-
-@BindingSite@ is used to tell the thing that prints binder what
-language construct is binding the identifier.  This can be used
-to decide how much info to print.
-
-\begin{code}
-data BindingSite = LambdaBind | CaseBind | LetBind
-
-class Outputable a => OutputableBndr a where
-   pprBndr :: BindingSite -> a -> SDoc
-   pprBndr b x = ppr x
-\end{code}
-
-
-
-%************************************************************************
-%*									*
-\subsection{Random printing helpers}
-%*									*
-%************************************************************************
-
-\begin{code}
--- We have 31-bit Chars and will simply use Show instances
--- of Char and String.
-
-pprHsChar :: Char -> SDoc
-pprHsChar c | c > '\x10ffff' = char '\\' <> text (show (fromIntegral (ord c) :: Word32))
-            | otherwise      = text (show c)
-
-pprHsString :: FastString -> SDoc
-pprHsString fs = text (show (unpackFS fs))
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Other helper functions}
-%*									*
-%************************************************************************
-
-\begin{code}
-pprWithCommas :: (a -> SDoc) -> [a] -> SDoc
-pprWithCommas pp xs = fsep (punctuate comma (map pp xs))
-
-interppSP  :: Outputable a => [a] -> SDoc
-interppSP  xs = sep (map ppr xs)
-
-interpp'SP :: Outputable a => [a] -> SDoc
-interpp'SP xs = sep (punctuate comma (map ppr xs))
-
-pprQuotedList :: Outputable a => [a] -> SDoc
--- [x,y,z]  ==>  `x', `y', `z'
-pprQuotedList xs = hsep (punctuate comma (map (quotes . ppr) xs))
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Printing numbers verbally}
-%*									*
-%************************************************************************
-
-@speakNth@ converts an integer to a verbal index; eg 1 maps to
-``first'' etc.
-
-\begin{code}
-speakNth :: Int -> SDoc
-speakNth 1 = ptext SLIT("first")
-speakNth 2 = ptext SLIT("second")
-speakNth 3 = ptext SLIT("third")
-speakNth 4 = ptext SLIT("fourth")
-speakNth 5 = ptext SLIT("fifth")
-speakNth 6 = ptext SLIT("sixth")
-speakNth n = hcat [ int n, text suffix ]
-  where
-    suffix | n <= 20       = "th"	-- 11,12,13 are non-std
-	   | last_dig == 1 = "st"
-	   | last_dig == 2 = "nd"
-	   | last_dig == 3 = "rd"
-	   | otherwise     = "th"
-
-    last_dig = n `rem` 10
-
-speakN :: Int -> SDoc
-speakN 0 = ptext SLIT("none")	-- E.g.  "he has none"
-speakN 1 = ptext SLIT("one")	-- E.g.  "he has one"
-speakN 2 = ptext SLIT("two")
-speakN 3 = ptext SLIT("three")
-speakN 4 = ptext SLIT("four")
-speakN 5 = ptext SLIT("five")
-speakN 6 = ptext SLIT("six")
-speakN n = int n
-
-speakNOf :: Int -> SDoc -> SDoc
-speakNOf 0 d = ptext SLIT("no") <+> d <> char 's'	-- E.g. "no arguments"
-speakNOf 1 d = ptext SLIT("one") <+> d			-- E.g. "one argument"
-speakNOf n d = speakN n <+> d <> char 's'		-- E.g. "three arguments"
-
-speakNTimes :: Int {- >=1 -} -> SDoc
-speakNTimes t | t == 1 	   = ptext SLIT("once")
-              | t == 2 	   = ptext SLIT("twice")
-              | otherwise  = speakN t <+> ptext SLIT("times")
-
-plural [x] = empty
-plural xs  = char 's'
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection{Error handling}
-%*									*
-%************************************************************************
-
-\begin{code}
-pprPanic, pprPgmError :: String -> SDoc -> a
-pprTrace :: String -> SDoc -> a -> a
-pprPanic    = pprAndThen panic		-- Throw an exn saying "bug in GHC"
-
-pprPgmError = pprAndThen pgmError	-- Throw an exn saying "bug in pgm being compiled"
-					--	(used for unusual pgm errors)
-pprTrace    = pprAndThen trace
-
-pprPanic# heading pretty_msg = panic# (show (doc PprDebug))
-			     where
-			       doc = text heading <+> pretty_msg
-
-pprAndThen :: (String -> a) -> String -> SDoc -> a
-pprAndThen cont heading pretty_msg = cont (show (doc PprDebug))
-    where
-     doc = sep [text heading, nest 4 pretty_msg]
-
-assertPprPanic :: String -> Int -> SDoc -> a
-assertPprPanic file line msg
-  = panic (show (doc PprDebug))
-  where
-    doc = sep [hsep[text "ASSERT failed! file", 
-		 	   text file, 
-			   text "line", int line], 
-		    msg]
-
-warnPprTrace :: Bool -> String -> Int -> SDoc -> a -> a
-warnPprTrace False file line msg x = x
-warnPprTrace True  file line msg x
-  = trace (show (doc PprDebug)) x
-  where
-    doc = sep [hsep [text "WARNING: file", text file, text "line", int line],
-	       msg]
-\end{code}
diff --git a/ghc/compiler/utils/Panic.lhs b/ghc/compiler/utils/Panic.lhs
deleted file mode 100644
index 1a74d5db32..0000000000
--- a/ghc/compiler/utils/Panic.lhs
+++ /dev/null
@@ -1,250 +0,0 @@
-%
-% (c) The GRASP Project, Glasgow University, 1992-2000
-%
-\section{Panic error messages}
-
-Defines basic funtions for printing error messages.
-
-It's hard to put these functions anywhere else without causing
-some unnecessary loops in the module dependency graph.
-
-\begin{code}
-module Panic  
-   ( 
-     GhcException(..), showGhcException, ghcError, progName, 
-     pgmError,
-
-     panic, panic#, assertPanic, trace,
-     
-     Exception.Exception(..), showException, try, tryJust, tryMost, tryUser,
-     catchJust, ioErrors, throwTo,
-
-     installSignalHandlers, interruptTargetThread
-   ) where
-
-#include "HsVersions.h"
-
-import Config
-import FastTypes
-
-#ifndef mingw32_HOST_OS
-# if __GLASGOW_HASKELL__ > 504
-import System.Posix.Signals
-# else
-import Posix		( Handler(Catch), installHandler, sigINT, sigQUIT )
-# endif /* GHC > 504 */
-#endif /* mingw32_HOST_OS */
-
-#if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 603
-import GHC.ConsoleHandler
-#endif
-
-# if __GLASGOW_HASKELL__ < 500
-import EXCEPTION        ( raiseInThread )
-# else
-import EXCEPTION	( throwTo )
-# endif /* GHC < 500 */
-
-#if __GLASGOW_HASKELL__ > 408
-import EXCEPTION	( catchJust, tryJust, ioErrors )
-#endif
-
-import CONCURRENT	( myThreadId, MVar, ThreadId, withMVar, newEmptyMVar )
-import DYNAMIC
-import qualified EXCEPTION as Exception
-import TRACE		( trace )
-import UNSAFE_IO	( unsafePerformIO )
-import IO		( isUserError )
-
-import System
-\end{code}
-
-GHC's own exception type.
-
-\begin{code}
-ghcError :: GhcException -> a
-ghcError e = Exception.throwDyn e
-
--- error messages all take the form
---
---	<location>: <error>
---
--- If the location is on the command line, or in GHC itself, then 
--- <location>="ghc".  All of the error types below correspond to 
--- a <location> of "ghc", except for ProgramError (where the string is
--- assumed to contain a location already, so we don't print one).
-
-data GhcException
-  = PhaseFailed String		-- name of phase 
-  		ExitCode	-- an external phase (eg. cpp) failed
-  | Interrupted			-- someone pressed ^C
-  | UsageError String		-- prints the short usage msg after the error
-  | CmdLineError String		-- cmdline prob, but doesn't print usage
-  | Panic String		-- the `impossible' happened
-  | InstallationError String	-- an installation problem
-  | ProgramError String		-- error in the user's code, probably
-  deriving Eq
-
-progName = unsafePerformIO (getProgName)
-{-# NOINLINE progName #-}
-
-short_usage = "Usage: For basic information, try the `--help' option."
-   
-showException :: Exception.Exception -> String
--- Show expected dynamic exceptions specially
-showException (Exception.DynException d) | Just e <- fromDynamic d 
-					 = show (e::GhcException)
-showException other_exn	       	 	 = show other_exn
-
-instance Show GhcException where
-  showsPrec _ e@(ProgramError _) = showGhcException e
-  showsPrec _ e = showString progName . showString ": " . showGhcException e
-
-showGhcException (UsageError str)
-   = showString str . showChar '\n' . showString short_usage
-showGhcException (PhaseFailed phase code)
-   = showString "phase `" . showString phase . 
-     showString "' failed (exitcode = " . shows int_code . 
-     showString ")"
-  where
-    int_code = 
-      case code of
-        ExitSuccess   -> (0::Int)
-	ExitFailure x -> x
-showGhcException (CmdLineError str)
-   = showString str
-showGhcException (ProgramError str)
-   = showString str
-showGhcException (InstallationError str)
-   = showString str
-showGhcException (Interrupted)
-   = showString "interrupted"
-showGhcException (Panic s)
-   = showString ("panic! (the 'impossible' happened)\n"
-		 ++ "  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
-	         ++ s ++ "\n\n"
-	         ++ "Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n")
-
-#if __GLASGOW_HASKELL__ < 603
-myMkTyConApp = mkAppTy
-#else 
-myMkTyConApp = mkTyConApp
-#endif
-
-ghcExceptionTc = mkTyCon "GhcException"
-{-# NOINLINE ghcExceptionTc #-}
-instance Typeable GhcException where
-  typeOf _ = myMkTyConApp ghcExceptionTc []
-\end{code}
-
-Panics and asserts.
-
-\begin{code}
-panic, pgmError :: String -> a
-panic    x = Exception.throwDyn (Panic x)
-pgmError x = Exception.throwDyn (ProgramError x)
-
---  #-versions because panic can't return an unboxed int, and that's
--- what TAG_ is with GHC at the moment.  Ugh. (Simon)
--- No, man -- Too Beautiful! (Will)
-
-panic# :: String -> FastInt
-panic# s = case (panic s) of () -> _ILIT 0
-
-assertPanic :: String -> Int -> a
-assertPanic file line = 
-  Exception.throw (Exception.AssertionFailed 
-           ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
-\end{code}
-
-\begin{code}
--- | tryMost is like try, but passes through Interrupted and Panic
--- exceptions.  Used when we want soft failures when reading interface
--- files, for example.
-
-tryMost :: IO a -> IO (Either Exception.Exception a)
-tryMost action = do r <- try action; filter r
-  where
-   filter (Left e@(Exception.DynException d))
-	    | Just ghc_ex <- fromDynamic d
-		= case ghc_ex of
-		    Interrupted -> Exception.throw e
-		    Panic _     -> Exception.throw e
-		    _other      -> return (Left e)
-   filter other 
-     = return other
-
--- | tryUser is like try, but catches only UserErrors.
--- These are the ones that are thrown by the TcRn monad 
--- to signal an error in the program being compiled
-tryUser :: IO a -> IO (Either Exception.Exception a)
-tryUser action = tryJust tc_errors action
-  where 
-#if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500
-	tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
-#elif __GLASGOW_HASKELL__ == 502
-	tc_errors e@(UserError _) = Just e
-#else 
-	tc_errors e@(Exception.IOException ioe) | isUserError e = Just e
-#endif
-	tc_errors _other = Nothing
-\end{code}	
-
-Compatibility stuff:
-
-\begin{code}
-#if __GLASGOW_HASKELL__ <= 408
-try = Exception.tryAllIO
-#else
-try = Exception.try
-#endif
-
-#if __GLASGOW_HASKELL__ <= 408
-catchJust = Exception.catchIO
-tryJust   = Exception.tryIO
-ioErrors  = Exception.justIoErrors
-throwTo   = Exception.raiseInThread
-#endif
-\end{code}
-
-Standard signal handlers for catching ^C, which just throw an
-exception in the target thread.  The current target thread is
-the thread at the head of the list in the MVar passed to
-installSignalHandlers.
-
-\begin{code}
-installSignalHandlers :: IO ()
-installSignalHandlers = do
-  let
-      interrupt_exn = Exception.DynException (toDyn Interrupted)
-
-      interrupt = do
-	withMVar interruptTargetThread $ \targets ->
-	  case targets of
-	   [] -> return ()
-	   (thread:_) -> throwTo thread interrupt_exn
-  --
-#if !defined(mingw32_HOST_OS)
-  installHandler sigQUIT (Catch interrupt) Nothing 
-  installHandler sigINT  (Catch interrupt) Nothing
-  return ()
-#elif __GLASGOW_HASKELL__ >= 603
-  -- GHC 6.3+ has support for console events on Windows
-  -- NOTE: running GHCi under a bash shell for some reason requires
-  -- you to press Ctrl-Break rather than Ctrl-C to provoke
-  -- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know
-  -- why --SDM 17/12/2004
-  let sig_handler ControlC = interrupt
-      sig_handler Break    = interrupt
-      sig_handler _        = return ()
-
-  installHandler (Catch sig_handler)
-  return ()
-#else
-  return () -- nothing
-#endif
-
-{-# NOINLINE interruptTargetThread #-}
-interruptTargetThread :: MVar [ThreadId]
-interruptTargetThread = unsafePerformIO newEmptyMVar
-\end{code}
diff --git a/ghc/compiler/utils/Pretty.lhs b/ghc/compiler/utils/Pretty.lhs
deleted file mode 100644
index ec8f1e75ad..0000000000
--- a/ghc/compiler/utils/Pretty.lhs
+++ /dev/null
@@ -1,1075 +0,0 @@
-*********************************************************************************
-*                                                                               *
-*       John Hughes's and Simon Peyton Jones's Pretty Printer Combinators       *
-*                                                                               *
-*               based on "The Design of a Pretty-printing Library"              *
-*               in Advanced Functional Programming,                             *
-*               Johan Jeuring and Erik Meijer (eds), LNCS 925                   *
-*               http://www.cs.chalmers.se/~rjmh/Papers/pretty.ps                *
-*                                                                               *
-*               Heavily modified by Simon Peyton Jones, Dec 96                  *
-*                                                                               *
-*********************************************************************************
-
-Version 3.0     28 May 1997
-  * Cured massive performance bug.  If you write
-
-        foldl <> empty (map (text.show) [1..10000])
-
-    you get quadratic behaviour with V2.0.  Why?  For just the same reason as you get
-    quadratic behaviour with left-associated (++) chains.
-
-    This is really bad news.  One thing a pretty-printer abstraction should
-    certainly guarantee is insensivity to associativity.  It matters: suddenly
-    GHC's compilation times went up by a factor of 100 when I switched to the
-    new pretty printer.
- 
-    I fixed it with a bit of a hack (because I wanted to get GHC back on the
-    road).  I added two new constructors to the Doc type, Above and Beside:
- 
-         <> = Beside
-         $$ = Above
- 
-    Then, where I need to get to a "TextBeside" or "NilAbove" form I "force"
-    the Doc to squeeze out these suspended calls to Beside and Above; but in so
-    doing I re-associate. It's quite simple, but I'm not satisfied that I've done
-    the best possible job.  I'll send you the code if you are interested.
-
-  * Added new exports:
-        punctuate, hang
-        int, integer, float, double, rational,
-        lparen, rparen, lbrack, rbrack, lbrace, rbrace,
-
-  * fullRender's type signature has changed.  Rather than producing a string it
-    now takes an extra couple of arguments that tells it how to glue fragments
-    of output together:
-
-        fullRender :: Mode
-                   -> Int                       -- Line length
-                   -> Float                     -- Ribbons per line
-                   -> (TextDetails -> a -> a)   -- What to do with text
-                   -> a                         -- What to do at the end
-                   -> Doc
-                   -> a                         -- Result
-
-    The "fragments" are encapsulated in the TextDetails data type:
-        data TextDetails = Chr  Char
-                         | Str  String
-                         | PStr FastString
-
-    The Chr and Str constructors are obvious enough.  The PStr constructor has a packed
-    string (FastString) inside it.  It's generated by using the new "ptext" export.
-
-    An advantage of this new setup is that you can get the renderer to do output
-    directly (by passing in a function of type (TextDetails -> IO () -> IO ()),
-    rather than producing a string that you then print.
-
-
-Version 2.0     24 April 1997
-  * Made empty into a left unit for <> as well as a right unit;
-    it is also now true that
-        nest k empty = empty
-    which wasn't true before.
-
-  * Fixed an obscure bug in sep that occassionally gave very wierd behaviour
-
-  * Added $+$
-
-  * Corrected and tidied up the laws and invariants
-
-======================================================================
-Relative to John's original paper, there are the following new features:
-
-1.  There's an empty document, "empty".  It's a left and right unit for 
-    both <> and $$, and anywhere in the argument list for
-    sep, hcat, hsep, vcat, fcat etc.
-
-    It is Really Useful in practice.
-
-2.  There is a paragraph-fill combinator, fsep, that's much like sep,
-    only it keeps fitting things on one line until itc can't fit any more.
-
-3.  Some random useful extra combinators are provided.  
-        <+> puts its arguments beside each other with a space between them,
-            unless either argument is empty in which case it returns the other
-
-
-        hcat is a list version of <>
-        hsep is a list version of <+>
-        vcat is a list version of $$
-
-        sep (separate) is either like hsep or like vcat, depending on what fits
-
-        cat  is behaves like sep,  but it uses <> for horizontal conposition
-        fcat is behaves like fsep, but it uses <> for horizontal conposition
-
-        These new ones do the obvious things:
-                char, semi, comma, colon, space,
-                parens, brackets, braces, 
-                quotes, doubleQuotes
-        
-4.      The "above" combinator, $$, now overlaps its two arguments if the
-        last line of the top argument stops before the first line of the second begins.
-        For example:  text "hi" $$ nest 5 "there"
-        lays out as
-                        hi   there
-        rather than
-                        hi
-                             there
-
-        There are two places this is really useful
-
-        a) When making labelled blocks, like this:
-                Left ->   code for left
-                Right ->  code for right
-                LongLongLongLabel ->
-                          code for longlonglonglabel
-           The block is on the same line as the label if the label is
-           short, but on the next line otherwise.
-
-        b) When laying out lists like this:
-                [ first
-                , second
-                , third
-                ]
-           which some people like.  But if the list fits on one line
-           you want [first, second, third].  You can't do this with
-           John's original combinators, but it's quite easy with the
-           new $$.
-
-        The combinator $+$ gives the original "never-overlap" behaviour.
-
-5.      Several different renderers are provided:
-                * a standard one
-                * one that uses cut-marks to avoid deeply-nested documents 
-                        simply piling up in the right-hand margin
-                * one that ignores indentation (fewer chars output; good for machines)
-                * one that ignores indentation and newlines (ditto, only more so)
-
-6.      Numerous implementation tidy-ups
-        Use of unboxed data types to speed up the implementation
-
-
-
-\begin{code}
-module Pretty (
-        Doc,            -- Abstract
-        Mode(..), TextDetails(..),
-
-        empty, isEmpty, nest,
-
-        text, char, ftext, ptext,
-        int, integer, float, double, rational,
-        parens, brackets, braces, quotes, doubleQuotes,
-        semi, comma, colon, space, equals,
-        lparen, rparen, lbrack, rbrack, lbrace, rbrace,
-
-        (<>), (<+>), hcat, hsep, 
-        ($$), ($+$), vcat, 
-        sep, cat, 
-        fsep, fcat, 
-
-        hang, punctuate,
-        
---      renderStyle,            -- Haskell 1.3 only
-        render, fullRender, printDoc, showDocWith
-  ) where
-
-#include "HsVersions.h"
-
-import BufWrite
-import FastString
-
-import GLAEXTS
-
-import Numeric (fromRat)
-import IO
-
-import System.IO	( hPutBuf )
-
-import GHC.Base		( unpackCString# )
-import GHC.Ptr		( Ptr(..) )
-
--- Don't import Util( assertPanic ) because it makes a loop in the module structure
-
-infixl 6 <> 
-infixl 6 <+>
-infixl 5 $$, $+$
-\end{code}
-
-
-
-*********************************************************
-*                                                       *
-\subsection{CPP magic so that we can compile with both GHC and Hugs}
-*                                                       *
-*********************************************************
-
-The library uses unboxed types to get a bit more speed, but these CPP macros
-allow you to use either GHC or Hugs.  To get GHC, just set the CPP variable
-        __GLASGOW_HASKELL__
-
-\begin{code}
-
-#if defined(__GLASGOW_HASKELL__)
-
--- Glasgow Haskell
-
--- Disable ASSERT checks; they are expensive!
-#define LOCAL_ASSERT(x)
-
-#define ILIT(x) (x#)
-#define IBOX(x) (I# (x))
-#define INT     Int#
-#define MINUS   -#
-#define NEGATE  negateInt#
-#define PLUS    +#
-#define GR      >#
-#define GREQ    >=#
-#define LT      <#
-#define DIV     `quotInt#`
-
-
-#define SHOW    Show
-#define MAXINT  maxBound
-
-#else
-
--- Standard Haskell
-
-#define LOCAL_ASSERT(x)
-
-#define INT     Int
-#define IBOX(x) x
-#define MINUS   -
-#define NEGATE  negate
-#define PLUS    +
-#define GR      >
-#define GREQ    >=
-#define LT      <
-#define DIV     `quot`
-#define ILIT(x) x
-
-#define SHOW    Show
-#define MAXINT  maxBound
-
-#endif
-
-\end{code}
-
-
-*********************************************************
-*                                                       *
-\subsection{The interface}
-*                                                       *
-*********************************************************
-
-The primitive @Doc@ values
-
-\begin{code}
-empty                     :: Doc
-isEmpty                   :: Doc    -> Bool
-text                      :: String -> Doc 
-char                      :: Char -> Doc
-
-semi, comma, colon, space, equals              :: Doc
-lparen, rparen, lbrack, rbrack, lbrace, rbrace :: Doc
-
-parens, brackets, braces  :: Doc -> Doc 
-quotes, doubleQuotes      :: Doc -> Doc
-
-int      :: Int -> Doc
-integer  :: Integer -> Doc
-float    :: Float -> Doc
-double   :: Double -> Doc
-rational :: Rational -> Doc
-\end{code}
-
-Combining @Doc@ values
-
-\begin{code}
-(<>)   :: Doc -> Doc -> Doc     -- Beside
-hcat   :: [Doc] -> Doc          -- List version of <>
-(<+>)  :: Doc -> Doc -> Doc     -- Beside, separated by space
-hsep   :: [Doc] -> Doc          -- List version of <+>
-
-($$)   :: Doc -> Doc -> Doc     -- Above; if there is no
-                                -- overlap it "dovetails" the two
-vcat   :: [Doc] -> Doc          -- List version of $$
-
-cat    :: [Doc] -> Doc          -- Either hcat or vcat
-sep    :: [Doc] -> Doc          -- Either hsep or vcat
-fcat   :: [Doc] -> Doc          -- ``Paragraph fill'' version of cat
-fsep   :: [Doc] -> Doc          -- ``Paragraph fill'' version of sep
-
-nest   :: Int -> Doc -> Doc     -- Nested
-\end{code}
-
-GHC-specific ones.
-
-\begin{code}
-hang :: Doc -> Int -> Doc -> Doc
-punctuate :: Doc -> [Doc] -> [Doc]      -- punctuate p [d1, ... dn] = [d1 <> p, d2 <> p, ... dn-1 <> p, dn]
-\end{code}
-
-Displaying @Doc@ values. 
-
-\begin{code}
-instance SHOW Doc where
-  showsPrec prec doc cont = showDoc doc cont
-
-render     :: Doc -> String             -- Uses default style
-fullRender :: Mode
-           -> Int                       -- Line length
-           -> Float                     -- Ribbons per line
-           -> (TextDetails -> a -> a)   -- What to do with text
-           -> a                         -- What to do at the end
-           -> Doc
-           -> a                         -- Result
-
-{-      When we start using 1.3 
-renderStyle  :: Style -> Doc -> String
-data Style = Style { lineLength     :: Int,     -- In chars
-                     ribbonsPerLine :: Float,   -- Ratio of ribbon length to line length
-                     mode :: Mode
-             }
-style :: Style          -- The default style
-style = Style { lineLength = 100, ribbonsPerLine = 2.5, mode = PageMode }
--}
-
-data Mode = PageMode            -- Normal 
-          | ZigZagMode          -- With zig-zag cuts
-          | LeftMode            -- No indentation, infinitely long lines
-          | OneLineMode         -- All on one line
-
-\end{code}
-
-
-*********************************************************
-*                                                       *
-\subsection{The @Doc@ calculus}
-*                                                       *
-*********************************************************
-
-The @Doc@ combinators satisfy the following laws:
-\begin{verbatim}
-Laws for $$
-~~~~~~~~~~~
-<a1>    (x $$ y) $$ z   = x $$ (y $$ z)
-<a2>    empty $$ x      = x
-<a3>    x $$ empty      = x
-
-        ...ditto $+$...
-
-Laws for <>
-~~~~~~~~~~~
-<b1>    (x <> y) <> z   = x <> (y <> z)
-<b2>    empty <> x      = empty
-<b3>    x <> empty      = x
-
-        ...ditto <+>...
-
-Laws for text
-~~~~~~~~~~~~~
-<t1>    text s <> text t        = text (s++t)
-<t2>    text "" <> x            = x, if x non-empty
-
-Laws for nest
-~~~~~~~~~~~~~
-<n1>    nest 0 x                = x
-<n2>    nest k (nest k' x)      = nest (k+k') x
-<n3>    nest k (x <> y)         = nest k z <> nest k y
-<n4>    nest k (x $$ y)         = nest k x $$ nest k y
-<n5>    nest k empty            = empty
-<n6>    x <> nest k y           = x <> y, if x non-empty
-
-** Note the side condition on <n6>!  It is this that
-** makes it OK for empty to be a left unit for <>.
-
-Miscellaneous
-~~~~~~~~~~~~~
-<m1>    (text s <> x) $$ y = text s <> ((text "" <> x)) $$ 
-                                         nest (-length s) y)
-
-<m2>    (x $$ y) <> z = x $$ (y <> z)
-        if y non-empty
-
-
-Laws for list versions
-~~~~~~~~~~~~~~~~~~~~~~
-<l1>    sep (ps++[empty]++qs)   = sep (ps ++ qs)
-        ...ditto hsep, hcat, vcat, fill...
-
-<l2>    nest k (sep ps) = sep (map (nest k) ps)
-        ...ditto hsep, hcat, vcat, fill...
-
-Laws for oneLiner
-~~~~~~~~~~~~~~~~~
-<o1>    oneLiner (nest k p) = nest k (oneLiner p)
-<o2>    oneLiner (x <> y)   = oneLiner x <> oneLiner y 
-\end{verbatim}
-
-
-You might think that the following verion of <m1> would
-be neater:
-\begin{verbatim}
-<3 NO>  (text s <> x) $$ y = text s <> ((empty <> x)) $$ 
-                                         nest (-length s) y)
-\end{verbatim}
-But it doesn't work, for if x=empty, we would have
-\begin{verbatim}
-        text s $$ y = text s <> (empty $$ nest (-length s) y)
-                    = text s <> nest (-length s) y
-\end{verbatim}
-
-
-
-*********************************************************
-*                                                       *
-\subsection{Simple derived definitions}
-*                                                       *
-*********************************************************
-
-\begin{code}
-semi  = char ';'
-colon = char ':'
-comma = char ','
-space = char ' '
-equals = char '='
-lparen = char '('
-rparen = char ')'
-lbrack = char '['
-rbrack = char ']'
-lbrace = char '{'
-rbrace = char '}'
-
-int      n = text (show n)
-integer  n = text (show n)
-float    n = text (show n)
-double   n = text (show n)
-rational n = text (show (fromRat n))
---rational n = text (show (fromRationalX n)) -- _showRational 30 n)
-
-quotes p        = char '`' <> p <> char '\''
-doubleQuotes p  = char '"' <> p <> char '"'
-parens p        = char '(' <> p <> char ')'
-brackets p      = char '[' <> p <> char ']'
-braces p        = char '{' <> p <> char '}'
-
-
-hcat = foldr (<>)  empty
-hsep = foldr (<+>) empty
-vcat = foldr ($$)  empty
-
-hang d1 n d2 = sep [d1, nest n d2]
-
-punctuate p []     = []
-punctuate p (d:ds) = go d ds
-                   where
-                     go d [] = [d]
-                     go d (e:es) = (d <> p) : go e es
-\end{code}
-
-
-*********************************************************
-*                                                       *
-\subsection{The @Doc@ data type}
-*                                                       *
-*********************************************************
-
-A @Doc@ represents a {\em set} of layouts.  A @Doc@ with
-no occurrences of @Union@ or @NoDoc@ represents just one layout.
-\begin{code}
-data Doc
- = Empty                                -- empty
- | NilAbove Doc                         -- text "" $$ x
- | TextBeside !TextDetails INT Doc       -- text s <> x  
- | Nest INT Doc                         -- nest k x
- | Union Doc Doc                        -- ul `union` ur
- | NoDoc                                -- The empty set of documents
- | Beside Doc Bool Doc                  -- True <=> space between
- | Above  Doc Bool Doc                  -- True <=> never overlap
-
-type RDoc = Doc         -- RDoc is a "reduced Doc", guaranteed not to have a top-level Above or Beside
-
-
-reduceDoc :: Doc -> RDoc
-reduceDoc (Beside p g q) = beside p g (reduceDoc q)
-reduceDoc (Above  p g q) = above  p g (reduceDoc q)
-reduceDoc p              = p
-
-
-data TextDetails = Chr  {-#UNPACK#-}!Char
-                 | Str  String
-                 | PStr FastString	-- a hashed string
-		 | LStr Addr# Int#	-- a '\0'-terminated array of bytes
-
-space_text = Chr ' '
-nl_text    = Chr '\n'
-\end{code}
-
-Here are the invariants:
-\begin{itemize}
-\item
-The argument of @NilAbove@ is never @Empty@. Therefore
-a @NilAbove@ occupies at least two lines.
-
-\item
-The arugment of @TextBeside@ is never @Nest@.
-
-\item 
-The layouts of the two arguments of @Union@ both flatten to the same string.
-
-\item 
-The arguments of @Union@ are either @TextBeside@, or @NilAbove@.
-
-\item
-The right argument of a union cannot be equivalent to the empty set (@NoDoc@).
-If the left argument of a union is equivalent to the empty set (@NoDoc@),
-then the @NoDoc@ appears in the first line.
-
-\item 
-An empty document is always represented by @Empty@.
-It can't be hidden inside a @Nest@, or a @Union@ of two @Empty@s.
-
-\item 
-The first line of every layout in the left argument of @Union@
-is longer than the first line of any layout in the right argument.
-(1) ensures that the left argument has a first line.  In view of (3),
-this invariant means that the right argument must have at least two
-lines.
-\end{itemize}
-
-\begin{code}
-        -- Arg of a NilAbove is always an RDoc
-nilAbove_ p = LOCAL_ASSERT( ok p ) NilAbove p
-            where
-              ok Empty = False
-              ok other = True
-
-        -- Arg of a TextBeside is always an RDoc
-textBeside_ s sl p = TextBeside s sl (LOCAL_ASSERT( ok p ) p)
-                   where
-                     ok (Nest _ _) = False
-                     ok other      = True
-
-        -- Arg of Nest is always an RDoc
-nest_ k p = Nest k (LOCAL_ASSERT( ok p ) p)
-          where
-            ok Empty = False
-            ok other = True
-
-        -- Args of union are always RDocs
-union_ p q = Union (LOCAL_ASSERT( ok p ) p) (LOCAL_ASSERT( ok q ) q)
-           where
-             ok (TextBeside _ _ _) = True
-             ok (NilAbove _)       = True
-             ok (Union _ _)        = True
-             ok other              = False
-\end{code}
-
-
-Notice the difference between
-        * NoDoc (no documents)
-        * Empty (one empty document; no height and no width)
-        * text "" (a document containing the empty string;
-                   one line high, but has no width)
-
-
-
-*********************************************************
-*                                                       *
-\subsection{@empty@, @text@, @nest@, @union@}
-*                                                       *
-*********************************************************
-
-\begin{code}
-empty = Empty
-
-isEmpty Empty = True
-isEmpty _     = False
-
-char  c = textBeside_ (Chr c) 1# Empty
-text  s = case length   s of {IBOX(sl) -> textBeside_ (Str s)  sl Empty}
-ftext s = case lengthFS s of {IBOX(sl) -> textBeside_ (PStr s) sl Empty}
-ptext (Ptr s) = case strLength (Ptr s) of {IBOX(sl) -> textBeside_ (LStr s sl) sl Empty}
-
--- RULE that turns (text "abc") into (ptext (A# "abc"#)) to avoid the
--- intermediate packing/unpacking of the string.
-{-# RULES 
-  "text/str" forall a. text (unpackCString# a) = ptext (Ptr a)
- #-}
-
-nest IBOX(k)  p = mkNest k (reduceDoc p)        -- Externally callable version
-
--- mkNest checks for Nest's invariant that it doesn't have an Empty inside it
-mkNest k       (Nest k1 p) = mkNest (k PLUS k1) p
-mkNest k       NoDoc       = NoDoc
-mkNest k       Empty       = Empty
-mkNest ILIT(0) p           = p                  -- Worth a try!
-mkNest k       p           = nest_ k p
-
--- mkUnion checks for an empty document
-mkUnion Empty q = Empty
-mkUnion p q     = p `union_` q
-\end{code}
-
-*********************************************************
-*                                                       *
-\subsection{Vertical composition @$$@}
-*                                                       *
-*********************************************************
-
-
-\begin{code}
-p $$  q = Above p False q
-p $+$ q = Above p True q
-
-above :: Doc -> Bool -> RDoc -> RDoc
-above (Above p g1 q1)  g2 q2 = above p g1 (above q1 g2 q2)
-above p@(Beside _ _ _) g  q  = aboveNest (reduceDoc p) g ILIT(0) (reduceDoc q)
-above p g q                  = aboveNest p             g ILIT(0) (reduceDoc q)
-
-aboveNest :: RDoc -> Bool -> INT -> RDoc -> RDoc
--- Specfication: aboveNest p g k q = p $g$ (nest k q)
-
-aboveNest NoDoc               g k q = NoDoc
-aboveNest (p1 `Union` p2)     g k q = aboveNest p1 g k q `union_` 
-                                      aboveNest p2 g k q
-                                
-aboveNest Empty               g k q = mkNest k q
-aboveNest (Nest k1 p)         g k q = nest_ k1 (aboveNest p g (k MINUS k1) q)
-                                  -- p can't be Empty, so no need for mkNest
-                                
-aboveNest (NilAbove p)        g k q = nilAbove_ (aboveNest p g k q)
-aboveNest (TextBeside s sl p) g k q = textBeside_ s sl rest
-                                    where
-                                      k1   = k MINUS sl
-                                      rest = case p of
-                                                Empty -> nilAboveNest g k1 q
-                                                other -> aboveNest  p g k1 q
-\end{code}
-
-\begin{code}
-nilAboveNest :: Bool -> INT -> RDoc -> RDoc
--- Specification: text s <> nilaboveNest g k q 
---              = text s <> (text "" $g$ nest k q)
-
-nilAboveNest g k Empty       = Empty    -- Here's why the "text s <>" is in the spec!
-nilAboveNest g k (Nest k1 q) = nilAboveNest g (k PLUS k1) q
-
-nilAboveNest g k q           | (not g) && (k GR ILIT(0))        -- No newline if no overlap
-                             = textBeside_ (Str (spaces k)) k q
-                             | otherwise                        -- Put them really above
-                             = nilAbove_ (mkNest k q)
-\end{code}
-
-
-*********************************************************
-*                                                       *
-\subsection{Horizontal composition @<>@}
-*                                                       *
-*********************************************************
-
-\begin{code}
-p <>  q = Beside p False q
-p <+> q = Beside p True  q
-
-beside :: Doc -> Bool -> RDoc -> RDoc
--- Specification: beside g p q = p <g> q
- 
-beside NoDoc               g q   = NoDoc
-beside (p1 `Union` p2)     g q   = (beside p1 g q) `union_` (beside p2 g q)
-beside Empty               g q   = q
-beside (Nest k p)          g q   = nest_ k $! beside p g q       -- p non-empty
-beside p@(Beside p1 g1 q1) g2 q2 
-           {- (A `op1` B) `op2` C == A `op1` (B `op2` C)  iff op1 == op2 
-                                                 [ && (op1 == <> || op1 == <+>) ] -}
-         | g1 == g2              = beside p1 g1 $! beside q1 g2 q2
-         | otherwise             = beside (reduceDoc p) g2 q2
-beside p@(Above _ _ _)     g q   = let d = reduceDoc p in d `seq` beside d g q
-beside (NilAbove p)        g q   = nilAbove_ $! beside p g q
-beside (TextBeside s sl p) g q   = textBeside_ s sl $! rest
-                               where
-                                  rest = case p of
-                                           Empty -> nilBeside g q
-                                           other -> beside p g q
-\end{code}
-
-\begin{code}
-nilBeside :: Bool -> RDoc -> RDoc
--- Specification: text "" <> nilBeside g p 
---              = text "" <g> p
-
-nilBeside g Empty      = Empty  -- Hence the text "" in the spec
-nilBeside g (Nest _ p) = nilBeside g p
-nilBeside g p          | g         = textBeside_ space_text ILIT(1) p
-                       | otherwise = p
-\end{code}
-
-*********************************************************
-*                                                       *
-\subsection{Separate, @sep@, Hughes version}
-*                                                       *
-*********************************************************
-
-\begin{code}
--- Specification: sep ps  = oneLiner (hsep ps)
---                         `union`
---                          vcat ps
-
-sep = sepX True         -- Separate with spaces
-cat = sepX False        -- Don't
-
-sepX x []     = empty
-sepX x (p:ps) = sep1 x (reduceDoc p) ILIT(0) ps
-
-
--- Specification: sep1 g k ys = sep (x : map (nest k) ys)
---                            = oneLiner (x <g> nest k (hsep ys))
---                              `union` x $$ nest k (vcat ys)
-
-sep1 :: Bool -> RDoc -> INT -> [Doc] -> RDoc
-sep1 g NoDoc               k ys = NoDoc
-sep1 g (p `Union` q)       k ys = sep1 g p k ys
-                                  `union_`
-                                  (aboveNest q False k (reduceDoc (vcat ys)))
-
-sep1 g Empty               k ys = mkNest k (sepX g ys)
-sep1 g (Nest n p)          k ys = nest_ n (sep1 g p (k MINUS n) ys)
-
-sep1 g (NilAbove p)        k ys = nilAbove_ (aboveNest p False k (reduceDoc (vcat ys)))
-sep1 g (TextBeside s sl p) k ys = textBeside_ s sl (sepNB g p (k MINUS sl) ys)
-
--- Specification: sepNB p k ys = sep1 (text "" <> p) k ys
--- Called when we have already found some text in the first item
--- We have to eat up nests
-
-sepNB g (Nest _ p)  k ys  = sepNB g p k ys
-
-sepNB g Empty k ys        = oneLiner (nilBeside g (reduceDoc rest))
-                                `mkUnion` 
-                            nilAboveNest False k (reduceDoc (vcat ys))
-                          where
-                            rest | g         = hsep ys
-                                 | otherwise = hcat ys
-
-sepNB g p k ys            = sep1 g p k ys
-\end{code}
-
-*********************************************************
-*                                                       *
-\subsection{@fill@}
-*                                                       *
-*********************************************************
-
-\begin{code}
-fsep = fill True
-fcat = fill False
-
--- Specification: 
---   fill []  = empty
---   fill [p] = p
---   fill (p1:p2:ps) = oneLiner p1 <#> nest (length p1) 
---                                          (fill (oneLiner p2 : ps))
---                     `union`
---                      p1 $$ fill ps
-
-fill g []     = empty
-fill g (p:ps) = fill1 g (reduceDoc p) ILIT(0) ps
-
-
-fill1 :: Bool -> RDoc -> INT -> [Doc] -> Doc
-fill1 g NoDoc               k ys = NoDoc
-fill1 g (p `Union` q)       k ys = fill1 g p k ys
-                                   `union_`
-                                   (aboveNest q False k (fill g ys))
-
-fill1 g Empty               k ys = mkNest k (fill g ys)
-fill1 g (Nest n p)          k ys = nest_ n (fill1 g p (k MINUS n) ys)
-
-fill1 g (NilAbove p)        k ys = nilAbove_ (aboveNest p False k (fill g ys))
-fill1 g (TextBeside s sl p) k ys = textBeside_ s sl (fillNB g p (k MINUS sl) ys)
-
-fillNB g (Nest _ p)  k ys  = fillNB g p k ys
-fillNB g Empty k []        = Empty
-fillNB g Empty k (y:ys)    = nilBeside g (fill1 g (oneLiner (reduceDoc y)) k1 ys)
-                             `mkUnion` 
-                             nilAboveNest False k (fill g (y:ys))
-                           where
-                             k1 | g         = k MINUS ILIT(1)
-                                | otherwise = k
-
-fillNB g p k ys            = fill1 g p k ys
-\end{code}
-
-
-*********************************************************
-*                                                       *
-\subsection{Selecting the best layout}
-*                                                       *
-*********************************************************
-
-\begin{code}
-best :: Int             -- Line length
-     -> Int             -- Ribbon length
-     -> RDoc
-     -> RDoc            -- No unions in here!
-
-best IBOX(w) IBOX(r) p
-  = get w p
-  where
-    get :: INT          -- (Remaining) width of line
-        -> Doc -> Doc
-    get w Empty               = Empty
-    get w NoDoc               = NoDoc
-    get w (NilAbove p)        = nilAbove_ (get w p)
-    get w (TextBeside s sl p) = textBeside_ s sl (get1 w sl p)
-    get w (Nest k p)          = nest_ k (get (w MINUS k) p)
-    get w (p `Union` q)       = nicest w r (get w p) (get w q)
-
-    get1 :: INT         -- (Remaining) width of line
-         -> INT         -- Amount of first line already eaten up
-         -> Doc         -- This is an argument to TextBeside => eat Nests
-         -> Doc         -- No unions in here!
-
-    get1 w sl Empty               = Empty
-    get1 w sl NoDoc               = NoDoc
-    get1 w sl (NilAbove p)        = nilAbove_ (get (w MINUS sl) p)
-    get1 w sl (TextBeside t tl p) = textBeside_ t tl (get1 w (sl PLUS tl) p)
-    get1 w sl (Nest k p)          = get1 w sl p
-    get1 w sl (p `Union` q)       = nicest1 w r sl (get1 w sl p) 
-                                                   (get1 w sl q)
-
-nicest w r p q = nicest1 w r ILIT(0) p q
-nicest1 w r sl p q | fits ((w `minn` r) MINUS sl) p = p
-                   | otherwise                   = q
-
-fits :: INT     -- Space available
-     -> Doc
-     -> Bool    -- True if *first line* of Doc fits in space available
- 
-fits n p    | n LT ILIT(0) = False
-fits n NoDoc               = False
-fits n Empty               = True
-fits n (NilAbove _)        = True
-fits n (TextBeside _ sl p) = fits (n MINUS sl) p
-
-minn x y | x LT y    = x
-         | otherwise = y
-\end{code}
-
-@first@ and @nonEmptySet@ are similar to @nicest@ and @fits@, only simpler.
-@first@ returns its first argument if it is non-empty, otherwise its second.
-
-\begin{code}
-first p q | nonEmptySet p = p 
-          | otherwise     = q
-
-nonEmptySet NoDoc              = False
-nonEmptySet (p `Union` q)      = True
-nonEmptySet Empty              = True
-nonEmptySet (NilAbove p)       = True           -- NoDoc always in first line
-nonEmptySet (TextBeside _ _ p) = nonEmptySet p
-nonEmptySet (Nest _ p)         = nonEmptySet p
-\end{code}
-
-@oneLiner@ returns the one-line members of the given set of @Doc@s.
-
-\begin{code}
-oneLiner :: Doc -> Doc
-oneLiner NoDoc               = NoDoc
-oneLiner Empty               = Empty
-oneLiner (NilAbove p)        = NoDoc
-oneLiner (TextBeside s sl p) = textBeside_ s sl (oneLiner p)
-oneLiner (Nest k p)          = nest_ k (oneLiner p)
-oneLiner (p `Union` q)       = oneLiner p
-\end{code}
-
-
-
-*********************************************************
-*                                                       *
-\subsection{Displaying the best layout}
-*                                                       *
-*********************************************************
-
-
-\begin{code}
-{-
-renderStyle Style{mode, lineLength, ribbonsPerLine} doc 
-  = fullRender mode lineLength ribbonsPerLine doc ""
--}
-
-render doc       = showDocWith PageMode doc
-showDoc doc rest = showDocWithAppend PageMode doc rest
-
-showDocWithAppend :: Mode -> Doc -> String -> String
-showDocWithAppend mode doc rest = fullRender mode 100 1.5 string_txt rest doc
-
-showDocWith :: Mode -> Doc -> String
-showDocWith mode doc = showDocWithAppend mode doc ""
-
-string_txt (Chr c)   s  = c:s
-string_txt (Str s1)  s2 = s1 ++ s2
-string_txt (PStr s1) s2 = unpackFS s1 ++ s2
-string_txt (LStr s1 _) s2 = unpackLitString s1 ++ s2
-
-unpackLitString addr =
- unpack 0#
- where
-    unpack nh
-      | ch `eqChar#` '\0'# = []
-      | otherwise   = C# ch : unpack (nh +# 1#)
-      where
-	ch = indexCharOffAddr# addr nh
-\end{code}
-
-\begin{code}
-
-fullRender OneLineMode _ _ txt end doc 
-  = lay (reduceDoc doc)
-  where
-    lay NoDoc               = cant_fail
-    lay (Union p q)         = (lay q)			-- Second arg can't be NoDoc
-    lay (Nest k p)          = lay p
-    lay Empty               = end
-    lay (NilAbove p)        = space_text `txt` lay p	-- NoDoc always on first line
-    lay (TextBeside s sl p) = s `txt` lay p
-
-fullRender LeftMode    _ _ txt end doc 
-  = lay (reduceDoc doc)
-  where
-    lay NoDoc               	= cant_fail
-    lay (Union p q) 		= lay (first p q)
-    lay (Nest k p)          	= lay p
-    lay Empty               	= end
-    lay (NilAbove p)        	= nl_text `txt` lay p	-- NoDoc always on first line
-    lay (TextBeside s sl p) 	= s `txt` lay p
-
-fullRender mode line_length ribbons_per_line txt end doc
-  = display mode line_length ribbon_length txt end best_doc
-  where 
-    best_doc = best hacked_line_length ribbon_length (reduceDoc doc)
-
-    hacked_line_length, ribbon_length :: Int
-    ribbon_length = round (fromIntegral line_length / ribbons_per_line)
-    hacked_line_length = case mode of { ZigZagMode -> MAXINT; other -> line_length }
-
-display mode IBOX(page_width) IBOX(ribbon_width) txt end doc
-  = case page_width MINUS ribbon_width of { gap_width ->
-    case gap_width DIV ILIT(2) of { shift ->
-    let
-        lay k (Nest k1 p)  = lay (k PLUS k1) p
-        lay k Empty        = end
-    
-        lay k (NilAbove p) = nl_text `txt` lay k p
-    
-        lay k (TextBeside s sl p)
-            = case mode of
-                    ZigZagMode |  k GREQ gap_width
-                               -> nl_text `txt` (
-                                  Str (multi_ch shift '/') `txt` (
-                                  nl_text `txt` (
-                                  lay1 (k MINUS shift) s sl p)))
-
-                               |  k LT ILIT(0)
-                               -> nl_text `txt` (
-                                  Str (multi_ch shift '\\') `txt` (
-                                  nl_text `txt` (
-                                  lay1 (k PLUS shift) s sl p )))
-
-                    other -> lay1 k s sl p
-    
-        lay1 k s sl p = Str (indent k) `txt` (s `txt` lay2 (k PLUS sl) p)
-    
-        lay2 k (NilAbove p)        = nl_text `txt` lay k p
-        lay2 k (TextBeside s sl p) = s `txt` (lay2 (k PLUS sl) p)
-        lay2 k (Nest _ p)          = lay2 k p
-        lay2 k Empty               = end
-    in
-    lay ILIT(0) doc
-    }}
-
-cant_fail = error "easy_display: NoDoc"
-
-indent n | n GREQ ILIT(8) = '\t' : indent (n MINUS ILIT(8))
-         | otherwise      = spaces n
-
-multi_ch ILIT(0) ch = ""
-multi_ch n       ch = ch : multi_ch (n MINUS ILIT(1)) ch
-
-spaces ILIT(0) = ""
-spaces n       = ' ' : spaces (n MINUS ILIT(1))
-\end{code}
-
-\begin{code}
-pprCols = (120 :: Int) -- could make configurable
-
-printDoc :: Mode -> Handle -> Doc -> IO ()
-printDoc LeftMode hdl doc
-  = do { printLeftRender hdl doc; hFlush hdl }
-printDoc mode hdl doc
-  = do { fullRender mode pprCols 1.5 put done doc ;
-	 hFlush hdl }
-  where
-    put (Chr c)  next = hPutChar hdl c >> next 
-    put (Str s)  next = hPutStr  hdl s >> next 
-    put (PStr s) next = hPutFS   hdl s >> next 
-    put (LStr s l) next = hPutLitString hdl s l >> next 
-
-    done = hPutChar hdl '\n'
-
-  -- some versions of hPutBuf will barf if the length is zero
-hPutLitString handle a# 0# = return ()
-hPutLitString handle a# l#
-#if __GLASGOW_HASKELL__ < 411
-  = hPutBuf handle (A# a#) (I# l#)
-#else
-  = hPutBuf handle (Ptr a#) (I# l#)
-#endif
-
--- Printing output in LeftMode is performance critical: it's used when
--- dumping C and assembly output, so we allow ourselves a few dirty
--- hacks:
---
---	(1) we specialise fullRender for LeftMode with IO output.
---
---	(2) we add a layer of buffering on top of Handles.  Handles
---	    don't perform well with lots of hPutChars, which is mostly
---	    what we're doing here, because Handles have to be thread-safe
---	    and async exception-safe.  We only have a single thread and don't
---	    care about exceptions, so we add a layer of fast buffering
---	    over the Handle interface.
---
---	(3) a few hacks in layLeft below to convince GHC to generate the right
---	    code.
-
-printLeftRender :: Handle -> Doc -> IO ()
-printLeftRender hdl doc = do
-  b <- newBufHandle hdl
-  layLeft b (reduceDoc doc)
-  bFlush b
-
--- HACK ALERT!  the "return () >>" below convinces GHC to eta-expand
--- this function with the IO state lambda.  Otherwise we end up with
--- closures in all the case branches.
-layLeft b _ | b `seq` False = undefined	-- make it strict in b
-layLeft b NoDoc               	= cant_fail
-layLeft b (Union p q) 		= return () >> layLeft b (first p q)
-layLeft b (Nest k p)          	= return () >> layLeft b p
-layLeft b Empty               	= bPutChar b '\n'
-layLeft b (NilAbove p)        	= bPutChar b '\n' >> layLeft b p
-layLeft b (TextBeside s sl p) 	= put b s >> layLeft b p
- where
-    put b _ | b `seq` False = undefined
-    put b (Chr c)    = bPutChar b c
-    put b (Str s)    = bPutStr  b s
-    put b (PStr s)   = bPutFS   b s
-    put b (LStr s l) = bPutLitString b s l
-
-#if __GLASGOW_HASKELL__ < 503
-hPutBuf = hPutBufFull
-#endif
-
-\end{code}
diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs
deleted file mode 100644
index e52e7e78da..0000000000
--- a/ghc/compiler/utils/StringBuffer.lhs
+++ /dev/null
@@ -1,240 +0,0 @@
-%
-% (c) The University of Glasgow, 1997-2006
-%
-\section{String buffers}
-
-Buffers for scanning string input stored in external arrays.
-
-\begin{code}
-module StringBuffer
-       (
-        StringBuffer(..),
-	-- non-abstract for vs\/HaskellService
-
-	 -- * Creation\/destruction
-        hGetStringBuffer,
-        hGetStringBufferBlock,
-        appendStringBuffers,
-	stringToStringBuffer,
-
-	-- * Inspection
-	nextChar,
-	currentChar,
-	prevChar,
-	atEnd,
-
-	-- * Moving and comparison
-	stepOn,
-	offsetBytes,
-	byteDiff,
-
-        -- * Conversion
-        lexemeToString,
-        lexemeToFastString,
-
-	 -- * Parsing integers
-	parseInteger,
-       ) where
-
-#include "HsVersions.h"
-
-import Encoding
-import FastString		( FastString,mkFastString,mkFastStringBytes )
-
-import Foreign
-import System.IO		( hGetBuf, hFileSize,IOMode(ReadMode), hClose
-                                , Handle, hTell )
-
-import GHC.Ptr			( Ptr(..) )
-import GHC.Exts
-import GHC.IOBase		( IO(..) )
-import GHC.Base			( unsafeChr )
-
-#if __GLASGOW_HASKELL__ >= 601
-import System.IO		( openBinaryFile )
-#else
-import IOExts                   ( openFileEx, IOModeEx(..) )
-#endif
-
-#if __GLASGOW_HASKELL__ < 601
-openBinaryFile fp mode = openFileEx fp (BinaryMode mode)
-#endif
-
--- -----------------------------------------------------------------------------
--- The StringBuffer type
-
--- |A StringBuffer is an internal pointer to a sized chunk of bytes.
--- The bytes are intended to be *immutable*.  There are pure
--- operations to read the contents of a StringBuffer.
---
--- A StringBuffer may have a finalizer, depending on how it was
--- obtained.
---
-data StringBuffer
- = StringBuffer {
-     buf :: {-# UNPACK #-} !(ForeignPtr Word8),
-     len :: {-# UNPACK #-} !Int, 	-- length
-     cur :: {-# UNPACK #-} !Int		-- current pos
-  }
-	-- The buffer is assumed to be UTF-8 encoded, and furthermore
-	-- we add three '\0' bytes to the end as sentinels so that the
-	-- decoder doesn't have to check for overflow at every single byte
-	-- of a multibyte sequence.
-
-instance Show StringBuffer where
-	showsPrec _ s = showString "<stringbuffer(" 
-		      . shows (len s) . showString "," . shows (cur s)
-		      . showString ">"
-
--- -----------------------------------------------------------------------------
--- Creation / Destruction
-
-hGetStringBuffer :: FilePath -> IO StringBuffer
-hGetStringBuffer fname = do
-   h <- openBinaryFile fname ReadMode
-   size_i <- hFileSize h
-   let size = fromIntegral size_i
-   buf <- mallocForeignPtrArray (size+3)
-   withForeignPtr buf $ \ptr -> do
-     r <- if size == 0 then return 0 else hGetBuf h ptr size
-     hClose h
-     if (r /= size)
-	then ioError (userError "short read of file")
-	else do
-	  pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0]
-		 -- sentinels for UTF-8 decoding
-	  return (StringBuffer buf size 0)
-
-hGetStringBufferBlock :: Handle -> Int -> IO StringBuffer
-hGetStringBufferBlock handle wanted
-    = do size_i <- hFileSize handle
-         offset_i <- hTell handle
-         let size = min wanted (fromIntegral $ size_i-offset_i)
-         buf <- mallocForeignPtrArray (size+3)
-         withForeignPtr buf $ \ptr ->
-             do r <- if size == 0 then return 0 else hGetBuf handle ptr size
-                if r /= size
-                   then ioError (userError $ "short read of file: "++show(r,size,fromIntegral size_i,handle))
-                   else do pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0]
-                           return (StringBuffer buf size 0)
-
-appendStringBuffers :: StringBuffer -> StringBuffer -> IO StringBuffer
-appendStringBuffers sb1 sb2
-    = do newBuf <- mallocForeignPtrArray (size+3)
-         withForeignPtr newBuf $ \ptr ->
-          withForeignPtr (buf sb1) $ \sb1Ptr ->
-           withForeignPtr (buf sb2) $ \sb2Ptr ->
-             do copyArray (sb1Ptr `advancePtr` cur sb1) ptr (calcLen sb1)
-                copyArray (sb2Ptr `advancePtr` cur sb2) (ptr `advancePtr` cur sb1) (calcLen sb2)
-                pokeArray (ptr `advancePtr` size) [0,0,0]
-                return (StringBuffer newBuf size 0)
-    where calcLen sb = len sb - cur sb
-          size = calcLen sb1 + calcLen sb2
-
-stringToStringBuffer :: String -> IO StringBuffer
-stringToStringBuffer str = do
-  let size = utf8EncodedLength str
-  buf <- mallocForeignPtrArray (size+3)
-  withForeignPtr buf $ \ptr -> do
-    utf8EncodeString ptr str
-    pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0]
-	 -- sentinels for UTF-8 decoding
-  return (StringBuffer buf size 0)
-
--- -----------------------------------------------------------------------------
--- Grab a character
-
--- Getting our fingers dirty a little here, but this is performance-critical
-{-# INLINE nextChar #-}
-nextChar :: StringBuffer -> (Char,StringBuffer)
-nextChar (StringBuffer buf len (I# cur#)) =
-  inlinePerformIO $ do
-    withForeignPtr buf $ \(Ptr a#) -> do
-	case utf8DecodeChar# (a# `plusAddr#` cur#) of
-	  (# c#, b# #) ->
-	     let cur' = I# (b# `minusAddr#` a#) in
-	     return (C# c#, StringBuffer buf len cur')
-
-currentChar :: StringBuffer -> Char
-currentChar = fst . nextChar
-
-prevChar :: StringBuffer -> Char -> Char
-prevChar (StringBuffer buf len 0)   deflt = deflt
-prevChar (StringBuffer buf len cur) deflt = 
-  inlinePerformIO $ do
-    withForeignPtr buf $ \p -> do
-      p' <- utf8PrevChar (p `plusPtr` cur)
-      return (fst (utf8DecodeChar p'))
-
--- -----------------------------------------------------------------------------
--- Moving
-
-stepOn :: StringBuffer -> StringBuffer
-stepOn s = snd (nextChar s)
-
-offsetBytes :: Int -> StringBuffer -> StringBuffer
-offsetBytes i s = s { cur = cur s + i }
-
-byteDiff :: StringBuffer -> StringBuffer -> Int
-byteDiff s1 s2 = cur s2 - cur s1
-
-atEnd :: StringBuffer -> Bool
-atEnd (StringBuffer _ l c) = l == c
-
--- -----------------------------------------------------------------------------
--- Conversion
-
-lexemeToString :: StringBuffer -> Int {-bytes-} -> String
-lexemeToString _ 0 = ""
-lexemeToString (StringBuffer buf _ cur) bytes =
-  inlinePerformIO $ 
-    withForeignPtr buf $ \ptr -> 
-      utf8DecodeString (ptr `plusPtr` cur) bytes
-
-lexemeToFastString :: StringBuffer -> Int {-bytes-} -> FastString
-lexemeToFastString _ 0 = mkFastString ""
-lexemeToFastString (StringBuffer buf _ cur) len =
-   inlinePerformIO $
-     withForeignPtr buf $ \ptr ->
-       return $! mkFastStringBytes (ptr `plusPtr` cur) len
-
--- -----------------------------------------------------------------------------
--- Parsing integer strings in various bases
-
-byteOff :: StringBuffer -> Int -> Char
-byteOff (StringBuffer buf _ cur) i = 
-  inlinePerformIO $ withForeignPtr buf $ \ptr -> do
-    w <- peek (ptr `plusPtr` (cur+i))
-    return (unsafeChr (fromIntegral (w::Word8)))
-
--- | XXX assumes ASCII digits only
-parseInteger :: StringBuffer -> Int -> Integer -> (Char->Int) -> Integer
-parseInteger buf len radix to_int 
-  = go 0 0
-  where go i x | i == len  = x
-	       | otherwise = go (i+1) (x * radix + toInteger (to_int (byteOff buf i)))
-
--- -----------------------------------------------------------------------------
--- under the carpet
-
--- Just like unsafePerformIO, but we inline it.
-{-# INLINE inlinePerformIO #-}
-inlinePerformIO :: IO a -> a
-inlinePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
-
-#if __GLASGOW_HASKELL__ < 600
-mallocForeignPtrArray :: Storable a => Int -> IO (ForeignPtr a)
-mallocForeignPtrArray  = doMalloc undefined
-  where
-    doMalloc            :: Storable b => b -> Int -> IO (ForeignPtr b)
-    doMalloc dummy size  = mallocForeignPtrBytes (size * sizeOf dummy)
-
-mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
-mallocForeignPtrBytes n = do
-  r <- mallocBytes n
-  newForeignPtr r (finalizerFree r)
-
-foreign import ccall unsafe "stdlib.h free" 
-  finalizerFree :: Ptr a -> IO ()
-#endif
-\end{code}
diff --git a/ghc/compiler/utils/UniqFM.lhs b/ghc/compiler/utils/UniqFM.lhs
deleted file mode 100644
index 84294aae0d..0000000000
--- a/ghc/compiler/utils/UniqFM.lhs
+++ /dev/null
@@ -1,847 +0,0 @@
-%ilter
-% (c) The AQUA Project, Glasgow University, 1994-1998
-%
-\section[UniqFM]{Specialised finite maps, for things with @Uniques@}
-
-Based on @FiniteMaps@ (as you would expect).
-
-Basically, the things need to be in class @Uniquable@, and we use the
-@getUnique@ method to grab their @Uniques@.
-
-(A similar thing to @UniqSet@, as opposed to @Set@.)
-
-\begin{code}
-module UniqFM (
-	UniqFM,   -- abstract type
-
-	emptyUFM,
-	unitUFM,
-	unitDirectlyUFM,
-	listToUFM,
-	listToUFM_Directly,
-	addToUFM,addToUFM_C,addToUFM_Acc,
-	addListToUFM,addListToUFM_C,
-	addToUFM_Directly,
-	addListToUFM_Directly,
-	delFromUFM,
-	delFromUFM_Directly,
-	delListFromUFM,
-	plusUFM,
-	plusUFM_C,
-	minusUFM,
-	intersectUFM,
-	intersectUFM_C,
-	foldUFM,
-	mapUFM,
-	elemUFM, elemUFM_Directly,
-	filterUFM, filterUFM_Directly,
-	sizeUFM,
-	hashUFM,
-	isNullUFM,
-	lookupUFM, lookupUFM_Directly,
-	lookupWithDefaultUFM, lookupWithDefaultUFM_Directly,
-	eltsUFM, keysUFM,
-	ufmToList 
-    ) where
-
-#include "HsVersions.h"
-
-import Unique		( Uniquable(..), Unique, getKey#, mkUniqueGrimily )
-import Maybes		( maybeToBool )
-import FastTypes
-import Outputable
-
-import GLAEXTS		-- Lots of Int# operations
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The @UniqFM@ type, and signatures for the functions}
-%*									*
-%************************************************************************
-
-We use @FiniteMaps@, with a (@getUnique@-able) @Unique@ as ``key''.
-
-\begin{code}
-emptyUFM	:: UniqFM elt
-isNullUFM	:: UniqFM elt -> Bool
-unitUFM		:: Uniquable key => key -> elt -> UniqFM elt
-unitDirectlyUFM -- got the Unique already
-		:: Unique -> elt -> UniqFM elt
-listToUFM	:: Uniquable key => [(key,elt)] -> UniqFM elt
-listToUFM_Directly
-		:: [(Unique, elt)] -> UniqFM elt
-
-addToUFM	:: Uniquable key => UniqFM elt -> key -> elt  -> UniqFM elt
-addListToUFM	:: Uniquable key => UniqFM elt -> [(key,elt)] -> UniqFM elt
-addToUFM_Directly
-		:: UniqFM elt -> Unique -> elt -> UniqFM elt
-
-addToUFM_C	:: Uniquable key => (elt -> elt -> elt)	-- old -> new -> result
-			   -> UniqFM elt 		-- old
-			   -> key -> elt 		-- new
-			   -> UniqFM elt		-- result
-
-addToUFM_Acc	:: Uniquable key =>
-			      (elt -> elts -> elts)	-- Add to existing
-			   -> (elt -> elts)		-- New element
-			   -> UniqFM elts 		-- old
-			   -> key -> elt 		-- new
-			   -> UniqFM elts		-- result
-
-addListToUFM_C	:: Uniquable key => (elt -> elt -> elt)
-			   -> UniqFM elt -> [(key,elt)]
-			   -> UniqFM elt
-
-delFromUFM	:: Uniquable key => UniqFM elt -> key	 -> UniqFM elt
-delListFromUFM	:: Uniquable key => UniqFM elt -> [key] -> UniqFM elt
-delFromUFM_Directly :: UniqFM elt -> Unique -> UniqFM elt
-
-plusUFM		:: UniqFM elt -> UniqFM elt -> UniqFM elt
-
-plusUFM_C	:: (elt -> elt -> elt)
-		-> UniqFM elt -> UniqFM elt -> UniqFM elt
-
-minusUFM	:: UniqFM elt1 -> UniqFM elt2 -> UniqFM elt1
-
-intersectUFM	:: UniqFM elt -> UniqFM elt -> UniqFM elt
-intersectUFM_C	:: (elt1 -> elt2 -> elt3)
-		-> UniqFM elt1 -> UniqFM elt2 -> UniqFM elt3
-foldUFM		:: (elt -> a -> a) -> a -> UniqFM elt -> a
-mapUFM		:: (elt1 -> elt2) -> UniqFM elt1 -> UniqFM elt2
-filterUFM	:: (elt -> Bool) -> UniqFM elt -> UniqFM elt
-filterUFM_Directly :: (Unique -> elt -> Bool) -> UniqFM elt -> UniqFM elt
-
-sizeUFM		:: UniqFM elt -> Int
-hashUFM		:: UniqFM elt -> Int
-elemUFM		:: Uniquable key => key -> UniqFM elt -> Bool
-elemUFM_Directly:: Unique -> UniqFM elt -> Bool
-
-lookupUFM	:: Uniquable key => UniqFM elt -> key -> Maybe elt
-lookupUFM_Directly  -- when you've got the Unique already
-		:: UniqFM elt -> Unique -> Maybe elt
-lookupWithDefaultUFM
-		:: Uniquable key => UniqFM elt -> elt -> key -> elt
-lookupWithDefaultUFM_Directly
-		:: UniqFM elt -> elt -> Unique -> elt
-
-keysUFM		:: UniqFM elt -> [Unique]	-- Get the keys
-eltsUFM		:: UniqFM elt -> [elt]
-ufmToList	:: UniqFM elt -> [(Unique, elt)]
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The @IdFinMap@ and @TyVarFinMap@ specialisations for Ids/TyVars}
-%*									*
-%************************************************************************
-
-\begin{code}
--- Turn off for now, these need to be updated (SDM 4/98)
-
-#if 0
-#ifdef __GLASGOW_HASKELL__
--- I don't think HBC was too happy about this (WDP 94/10)
-
-{-# SPECIALIZE
-    addListToUFM :: UniqFM elt -> [(Name,   elt)] -> UniqFM elt
-  #-}
-{-# SPECIALIZE
-    addListToUFM_C :: (elt -> elt -> elt) -> UniqFM elt -> [(Name,  elt)] -> UniqFM elt
-  #-}
-{-# SPECIALIZE
-    addToUFM	:: UniqFM elt -> Unique -> elt  -> UniqFM elt
-  #-}
-{-# SPECIALIZE
-    listToUFM	:: [(Unique, elt)]     -> UniqFM elt
-  #-}
-{-# SPECIALIZE
-    lookupUFM	:: UniqFM elt -> Name   -> Maybe elt
-		 , UniqFM elt -> Unique -> Maybe elt
-  #-}
-
-#endif /* __GLASGOW_HASKELL__ */
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Andy Gill's underlying @UniqFM@ machinery}
-%*									*
-%************************************************************************
-
-``Uniq Finite maps'' are the heart and soul of the compiler's
-lookup-tables/environments.  Important stuff!  It works well with
-Dense and Sparse ranges.
-Both @Uq@ Finite maps and @Hash@ Finite Maps
-are built ontop of Int Finite Maps.
-
-This code is explained in the paper:
-\begin{display}
-	A Gill, S Peyton Jones, B O'Sullivan, W Partain and Aqua Friends
-	"A Cheap balancing act that grows on a tree"
-	Glasgow FP Workshop, Sep 1994, pp??-??
-\end{display}
-
-%************************************************************************
-%*									*
-\subsubsection{The @UniqFM@ type, and signatures for the functions}
-%*									*
-%************************************************************************
-
-@UniqFM a@ is a mapping from Unique to a.
-
-First, the DataType itself; which is either a Node, a Leaf, or an Empty.
-
-\begin{code}
-data UniqFM ele
-  = EmptyUFM
-  | LeafUFM FastInt ele
-  | NodeUFM FastInt	    -- the switching
-	    FastInt	    -- the delta
-	    (UniqFM ele)
-	    (UniqFM ele)
--- INVARIANT: the children of a NodeUFM are never EmptyUFMs
-
-{-
--- for debugging only :-)
-instance Outputable (UniqFM a) where
-	ppr(NodeUFM a b t1 t2) =
-		sep [text "NodeUFM " <+> int IBOX(a) <+> int IBOX(b),
-		     nest 1 (parens (ppr t1)),
-		     nest 1 (parens (ppr t2))]
-	ppr (LeafUFM x a) = text "LeafUFM " <+> int IBOX(x)
-	ppr (EmptyUFM)    = empty
--}
--- and when not debugging the package itself...
-instance Outputable a => Outputable (UniqFM a) where
-    ppr ufm = ppr (ufmToList ufm)
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{The @UniqFM@ functions}
-%*									*
-%************************************************************************
-
-First the ways of building a UniqFM.
-
-\begin{code}
-emptyUFM		     = EmptyUFM
-unitUFM	     key elt = mkLeafUFM (getKey# (getUnique key)) elt
-unitDirectlyUFM key elt = mkLeafUFM (getKey# key) elt
-
-listToUFM key_elt_pairs
-  = addListToUFM_C use_snd EmptyUFM key_elt_pairs
-
-listToUFM_Directly uniq_elt_pairs
-  = addListToUFM_directly_C use_snd EmptyUFM uniq_elt_pairs
-\end{code}
-
-Now ways of adding things to UniqFMs.
-
-There is an alternative version of @addListToUFM_C@, that uses @plusUFM@,
-but the semantics of this operation demands a linear insertion;
-perhaps the version without the combinator function
-could be optimised using it.
-
-\begin{code}
-addToUFM fm key elt = addToUFM_C use_snd fm key elt
-
-addToUFM_Directly fm u elt = insert_ele use_snd fm (getKey# u) elt
-
-addToUFM_C combiner fm key elt
-  = insert_ele combiner fm (getKey# (getUnique key)) elt
-
-addToUFM_Acc add unit fm key item
-  = insert_ele combiner fm (getKey# (getUnique key)) (unit item)
-  where
-    combiner old _unit_item = add item old
-
-addListToUFM fm key_elt_pairs = addListToUFM_C use_snd fm key_elt_pairs
-addListToUFM_Directly fm uniq_elt_pairs = addListToUFM_directly_C use_snd fm uniq_elt_pairs
-
-addListToUFM_C combiner fm key_elt_pairs
- = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# (getUnique k)) e)
-	 fm key_elt_pairs
-
-addListToUFM_directly_C combiner fm uniq_elt_pairs
- = foldl (\ fm (k, e) -> insert_ele combiner fm (getKey# k) e)
-	 fm uniq_elt_pairs
-\end{code}
-
-Now ways of removing things from UniqFM.
-
-\begin{code}
-delListFromUFM fm lst = foldl delFromUFM fm lst
-
-delFromUFM          fm key = delete fm (getKey# (getUnique key))
-delFromUFM_Directly fm u   = delete fm (getKey# u)
-
-delete EmptyUFM _   = EmptyUFM
-delete fm       key = del_ele fm
-  where
-    del_ele :: UniqFM a -> UniqFM a
-
-    del_ele lf@(LeafUFM j _)
-      | j ==# key	= EmptyUFM
-      | otherwise	= lf	-- no delete!
-
-    del_ele nd@(NodeUFM j p t1 t2)
-      | j ># key
-      = mkSLNodeUFM (NodeUFMData j p) (del_ele t1) t2
-      | otherwise
-      = mkLSNodeUFM (NodeUFMData j p) t1 (del_ele t2)
-
-    del_ele _ = panic "Found EmptyUFM FM when rec-deleting"
-\end{code}
-
-Now ways of adding two UniqFM's together.
-
-\begin{code}
-plusUFM tr1 tr2 = plusUFM_C use_snd tr1 tr2
-
-plusUFM_C f EmptyUFM tr	= tr
-plusUFM_C f tr EmptyUFM	= tr
-plusUFM_C f fm1 fm2	= mix_trees fm1 fm2
-    where
-	mix_trees (LeafUFM i a) t2 = insert_ele (flip f) t2 i a
-	mix_trees t1 (LeafUFM i a) = insert_ele f	 t1 i a
-
-	mix_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
-	  = mix_branches
-		(ask_about_common_ancestor
-			(NodeUFMData j p)
-			(NodeUFMData j' p'))
-	  where
-		-- Given a disjoint j,j' (p >^ p' && p' >^ p):
-		--
-		--	  j		j'			(C j j')
-		--	 / \	+      / \	==>		/	\
-		--     t1   t2	    t1'	  t2'		       j	 j'
-		--					      / \	/ \
-		--					     t1	 t2   t1'  t2'
-		-- Fast, Ehh !
-		--
-	  mix_branches (NewRoot nd False)
-		= mkLLNodeUFM nd left_t right_t
-	  mix_branches (NewRoot nd True)
-		= mkLLNodeUFM nd right_t left_t
-
-		-- Now, if j == j':
-		--
-		--	  j		j'			 j
-		--	 / \	+      / \	==>		/ \
-		--     t1   t2	    t1'	  t2'		t1 + t1'   t2 + t2'
-		--
-	  mix_branches (SameRoot)
-		= mkSSNodeUFM (NodeUFMData j p)
-			(mix_trees t1 t1')
-			(mix_trees t2 t2')
-		-- Now the 4 different other ways; all like this:
-		--
-		-- Given j >^ j' (and, say,  j > j')
-		--
-		--	  j		j'			 j
-		--	 / \	+      / \	==>		/ \
-		--     t1   t2	    t1'	  t2'		      t1   t2 + j'
-		--						       / \
-		--						     t1'  t2'
-	  mix_branches (LeftRoot Leftt) --  | trace "LL" True
-	    = mkSLNodeUFM
-		(NodeUFMData j p)
-		(mix_trees t1 right_t)
-		t2
-
-	  mix_branches (LeftRoot Rightt) --  | trace "LR" True
-	    = mkLSNodeUFM
-		(NodeUFMData j p)
-		t1
-		(mix_trees t2 right_t)
-
-	  mix_branches (RightRoot Leftt) --  | trace "RL" True
-	    = mkSLNodeUFM
-		(NodeUFMData j' p')
-		(mix_trees left_t t1')
-		t2'
-
-	  mix_branches (RightRoot Rightt) --  | trace "RR" True
-	    = mkLSNodeUFM
-		(NodeUFMData j' p')
-		t1'
-		(mix_trees left_t t2')
-
-	mix_trees _ _ = panic "EmptyUFM found when inserting into plusInt"
-\end{code}
-
-And ways of subtracting them. First the base cases,
-then the full D&C approach.
-
-\begin{code}
-minusUFM EmptyUFM _  = EmptyUFM
-minusUFM t1 EmptyUFM = t1
-minusUFM fm1 fm2     = minus_trees fm1 fm2
-    where
-	--
-	-- Notice the asymetry of subtraction
-	--
-	minus_trees lf@(LeafUFM i a) t2 =
-		case lookUp t2 i of
-		  Nothing -> lf
-		  Just b -> EmptyUFM
-
-	minus_trees t1 (LeafUFM i _) = delete t1 i
-
-	minus_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
-	  = minus_branches
-		(ask_about_common_ancestor
-			(NodeUFMData j p)
-			(NodeUFMData j' p'))
-	  where
-		-- Given a disjoint j,j' (p >^ p' && p' >^ p):
-		--
-		--	  j		j'		   j
-		--	 / \	+      / \	==>	  / \
-		--     t1   t2	    t1'	  t2'		 t1  t2
-		--
-		--
-		-- Fast, Ehh !
-		--
-	  minus_branches (NewRoot nd _) = left_t
-
-		-- Now, if j == j':
-		--
-		--	  j		j'			 j
-		--	 / \	+      / \	==>		/ \
-		--     t1   t2	    t1'	  t2'		t1 + t1'   t2 + t2'
-		--
-	  minus_branches (SameRoot)
-		= mkSSNodeUFM (NodeUFMData j p)
-			(minus_trees t1 t1')
-			(minus_trees t2 t2')
-		-- Now the 4 different other ways; all like this:
-		-- again, with asymatry
-
-		--
-		-- The left is above the right
-		--
-	  minus_branches (LeftRoot Leftt)
-	    = mkSLNodeUFM
-		(NodeUFMData j p)
-		(minus_trees t1 right_t)
-		t2
-	  minus_branches (LeftRoot Rightt)
-	    = mkLSNodeUFM
-		(NodeUFMData j p)
-		t1
-		(minus_trees t2 right_t)
-
-		--
-		-- The right is above the left
-		--
-	  minus_branches (RightRoot Leftt)
-	    = minus_trees left_t t1'
-	  minus_branches (RightRoot Rightt)
-	    = minus_trees left_t t2'
-
-	minus_trees _ _ = panic "EmptyUFM found when insering into plusInt"
-\end{code}
-
-And taking the intersection of two UniqFM's.
-
-\begin{code}
-intersectUFM t1 t2 = intersectUFM_C use_snd t1 t2
-
-intersectUFM_C f EmptyUFM _ = EmptyUFM
-intersectUFM_C f _ EmptyUFM = EmptyUFM
-intersectUFM_C f fm1 fm2    = intersect_trees fm1 fm2
-    where
-	intersect_trees (LeafUFM i a) t2 =
-		case lookUp t2 i of
-		  Nothing -> EmptyUFM
-		  Just b -> mkLeafUFM i (f a b)
-
-	intersect_trees t1 (LeafUFM i a) =
-		case lookUp t1 i of
-		  Nothing -> EmptyUFM
-		  Just b -> mkLeafUFM i (f b a)
-
-	intersect_trees left_t@(NodeUFM j p t1 t2) right_t@(NodeUFM j' p' t1' t2')
-	  = intersect_branches
-		(ask_about_common_ancestor
-			(NodeUFMData j p)
-			(NodeUFMData j' p'))
-	  where
-		-- Given a disjoint j,j' (p >^ p' && p' >^ p):
-		--
-		--	  j		j'
-		--	 / \	+      / \	==>		EmptyUFM
-		--     t1   t2	    t1'	  t2'
-		--
-		-- Fast, Ehh !
-		--
-	  intersect_branches (NewRoot nd _) = EmptyUFM
-
-		-- Now, if j == j':
-		--
-		--	  j		j'			 j
-		--	 / \	+      / \	==>		/ \
-		--     t1   t2	    t1'	  t2'		t1 x t1'   t2 x t2'
-		--
-	  intersect_branches (SameRoot)
-		= mkSSNodeUFM (NodeUFMData j p)
-			(intersect_trees t1 t1')
-			(intersect_trees t2 t2')
-		-- Now the 4 different other ways; all like this:
-		--
-		-- Given j >^ j' (and, say,  j > j')
-		--
-		--	  j		j'		       t2 + j'
-		--	 / \	+      / \	==>		   / \
-		--     t1   t2	    t1'	  t2'			 t1'  t2'
-		--
-		-- This does cut down the search space quite a bit.
-
-	  intersect_branches (LeftRoot Leftt)
-	    = intersect_trees t1 right_t
-	  intersect_branches (LeftRoot Rightt)
-	    = intersect_trees t2 right_t
-	  intersect_branches (RightRoot Leftt)
-	    = intersect_trees left_t t1'
-	  intersect_branches (RightRoot Rightt)
-	    = intersect_trees left_t t2'
-
-	intersect_trees x y = panic ("EmptyUFM found when intersecting trees")
-\end{code}
-
-Now the usual set of `collection' operators, like map, fold, etc.
-
-\begin{code}
-foldUFM f a (NodeUFM _ _ t1 t2) = foldUFM f (foldUFM f a t2) t1
-foldUFM f a (LeafUFM _ obj)     = f obj a
-foldUFM f a EmptyUFM	        = a
-\end{code}
-
-\begin{code}
-mapUFM fn EmptyUFM    = EmptyUFM
-mapUFM fn fm	      = map_tree fn fm
-
-filterUFM fn EmptyUFM = EmptyUFM
-filterUFM fn fm	      = filter_tree pred fm
-	where
-	  pred (i::FastInt) e = fn e
-
-filterUFM_Directly fn EmptyUFM = EmptyUFM
-filterUFM_Directly fn fm       = filter_tree pred fm
-	where
-	  pred i e = fn (mkUniqueGrimily (iBox i)) e
-\end{code}
-
-Note, this takes a long time, O(n), but
-because we dont want to do this very often, we put up with this.
-O'rable, but how often do we look at the size of
-a finite map?
-
-\begin{code}
-sizeUFM EmptyUFM	    = 0
-sizeUFM (NodeUFM _ _ t1 t2) = sizeUFM t1 + sizeUFM t2
-sizeUFM (LeafUFM _ _)	    = 1
-
-isNullUFM EmptyUFM = True
-isNullUFM _	   = False
-
--- hashing is used in VarSet.uniqAway, and should be fast
--- We use a cheap and cheerful method for now
-hashUFM EmptyUFM          = 0
-hashUFM (NodeUFM n _ _ _) = iBox n
-hashUFM (LeafUFM n _)     = iBox n
-\end{code}
-
-looking up in a hurry is the {\em whole point} of this binary tree lark.
-Lookup up a binary tree is easy (and fast).
-
-\begin{code}
-elemUFM          key fm = maybeToBool (lookupUFM fm key)
-elemUFM_Directly key fm = maybeToBool (lookupUFM_Directly fm key)
-
-lookupUFM	   fm key = lookUp fm (getKey# (getUnique key))
-lookupUFM_Directly fm key = lookUp fm (getKey# key)
-
-lookupWithDefaultUFM fm deflt key
-  = case lookUp fm (getKey# (getUnique key)) of
-      Nothing  -> deflt
-      Just elt -> elt
-
-lookupWithDefaultUFM_Directly fm deflt key
-  = case lookUp fm (getKey# key) of
-      Nothing  -> deflt
-      Just elt -> elt
-
-lookUp EmptyUFM _   = Nothing
-lookUp fm i	    = lookup_tree fm
-  where
-	lookup_tree :: UniqFM a -> Maybe a
-
-	lookup_tree (LeafUFM j b)
-	  | j ==# i	= Just b
-	  | otherwise	= Nothing
-	lookup_tree (NodeUFM j p t1 t2)
-	  | j ># i	= lookup_tree t1
-	  | otherwise	= lookup_tree t2
-
-	lookup_tree EmptyUFM = panic "lookup Failed"
-\end{code}
-
-folds are *wonderful* things.
-
-\begin{code}
-eltsUFM fm = foldUFM (:) [] fm
-
-ufmToList fm = fold_tree (\ iu elt rest -> (mkUniqueGrimily (iBox iu), elt) : rest) [] fm
-
-keysUFM fm = fold_tree (\ iu elt rest -> mkUniqueGrimily (iBox iu) : rest) [] fm
-
-fold_tree f a (NodeUFM _ _ t1 t2) = fold_tree f (fold_tree f a t2) t1
-fold_tree f a (LeafUFM iu obj)    = f iu obj a
-fold_tree f a EmptyUFM		  = a
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{The @UniqFM@ type, and its functions}
-%*									*
-%************************************************************************
-
-You should always use these to build the tree.
-There are 4 versions of mkNodeUFM, depending on
-the strictness of the two sub-tree arguments.
-The strictness is used *both* to prune out
-empty trees, *and* to improve performance,
-stoping needless thunks lying around.
-The rule of thumb (from experence with these trees)
-is make thunks strict, but data structures lazy.
-If in doubt, use mkSSNodeUFM, which has the `strongest'
-functionality, but may do a few needless evaluations.
-
-\begin{code}
-mkLeafUFM :: FastInt -> a -> UniqFM a
-mkLeafUFM i a	  = LeafUFM i a
-
--- The *ONLY* ways of building a NodeUFM.
-
-mkSSNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
-mkSSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
-mkSSNodeUFM (NodeUFMData j p) t1 t2
-  = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
-    NodeUFM j p t1 t2
-
-mkSLNodeUFM (NodeUFMData j p) EmptyUFM t2 = t2
-mkSLNodeUFM (NodeUFMData j p) t1 t2
-  = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
-    NodeUFM j p t1 t2
-
-mkLSNodeUFM (NodeUFMData j p) t1 EmptyUFM = t1
-mkLSNodeUFM (NodeUFMData j p) t1 t2
-  = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
-    NodeUFM j p t1 t2
-
-mkLLNodeUFM (NodeUFMData j p) t1 t2
-  = ASSERT(correctNodeUFM (iBox j) (iBox p) t1 t2)
-    NodeUFM j p t1 t2
-
-correctNodeUFM
-	:: Int
-	-> Int
-	-> UniqFM a
-	-> UniqFM a
-	-> Bool
-
-correctNodeUFM j p t1 t2
-  = correct (j-p) (j-1) p t1 && correct j ((j-1)+p) p t2
-  where
-    correct low high _ (LeafUFM i _)
-      = low <= iBox i && iBox i <= high
-    correct low high above_p (NodeUFM j p _ _)
-      = low <= iBox j && iBox j <= high && above_p > iBox p
-    correct _ _ _ EmptyUFM = panic "EmptyUFM stored inside a tree"
-\end{code}
-
-Note: doing SAT on this by hand seems to make it worse. Todo: Investigate,
-and if necessary do $\lambda$ lifting on our functions that are bound.
-
-\begin{code}
-insert_ele
-	:: (a -> a -> a)	-- old -> new -> result
-	-> UniqFM a
-	-> FastInt
-	-> a
-	-> UniqFM a
-
-insert_ele f EmptyUFM i new = mkLeafUFM i new
-
-insert_ele f (LeafUFM j old) i new
-  | j ># i =
-	  mkLLNodeUFM (getCommonNodeUFMData
-			  (indexToRoot i)
-			  (indexToRoot j))
-		 (mkLeafUFM i new)
-		 (mkLeafUFM j old)
-  | j ==# i  = mkLeafUFM j (f old new)
-  | otherwise =
-	  mkLLNodeUFM (getCommonNodeUFMData
-			  (indexToRoot i)
-			  (indexToRoot j))
-		 (mkLeafUFM j old)
-		 (mkLeafUFM i new)
-
-insert_ele f n@(NodeUFM j p t1 t2) i a
-  | i <# j
-    = if (i >=# (j -# p))
-      then mkSLNodeUFM (NodeUFMData j p) (insert_ele f t1 i a) t2
-      else mkLLNodeUFM (getCommonNodeUFMData
-			  (indexToRoot i)
-			  ((NodeUFMData j p)))
-		  (mkLeafUFM i a)
-		  n
-  | otherwise
-    = if (i <=# ((j -# _ILIT(1)) +# p))
-      then mkLSNodeUFM (NodeUFMData j p) t1 (insert_ele f t2 i a)
-      else mkLLNodeUFM (getCommonNodeUFMData
-			  (indexToRoot i)
-			  ((NodeUFMData j p)))
-		  n
-		  (mkLeafUFM i a)
-\end{code}
-
-
-
-\begin{code}
-map_tree f (NodeUFM j p t1 t2)
-  = mkLLNodeUFM (NodeUFMData j p) (map_tree f t1) (map_tree f t2)
-	-- NB. lazy! we know the tree is well-formed.
-map_tree f (LeafUFM i obj)
-  = mkLeafUFM i (f obj)
-map_tree f _ = panic "map_tree failed"
-\end{code}
-
-\begin{code}
-filter_tree :: (FastInt -> a -> Bool) -> UniqFM a -> UniqFM a
-filter_tree f nd@(NodeUFM j p t1 t2)
-  = mkSSNodeUFM (NodeUFMData j p) (filter_tree f t1) (filter_tree f t2)
-
-filter_tree f lf@(LeafUFM i obj)
-  | f i obj = lf
-  | otherwise = EmptyUFM
-filter_tree f _ = panic "filter_tree failed"
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection{The @UniqFM@ type, and signatures for the functions}
-%*									*
-%************************************************************************
-
-Now some Utilities;
-
-This is the information that is held inside a NodeUFM, packaged up for
-consumer use.
-
-\begin{code}
-data NodeUFMData
-  = NodeUFMData FastInt
-		FastInt
-\end{code}
-
-This is the information used when computing new NodeUFMs.
-
-\begin{code}
-data Side = Leftt | Rightt -- NB: avoid 1.3 names "Left" and "Right"
-data CommonRoot
-  = LeftRoot  Side	-- which side is the right down ?
-  | RightRoot Side	-- which side is the left down ?
-  | SameRoot		-- they are the same !
-  | NewRoot NodeUFMData	-- here's the new, common, root
-	    Bool	-- do you need to swap left and right ?
-\end{code}
-
-This specifies the relationship between NodeUFMData and CalcNodeUFMData.
-
-\begin{code}
-indexToRoot :: FastInt -> NodeUFMData
-
-indexToRoot i
-  = let
-	l = (_ILIT(1) :: FastInt)
-    in
-    NodeUFMData (((i `shiftR_` l) `shiftL_` l) +# _ILIT(1)) l
-
-getCommonNodeUFMData :: NodeUFMData -> NodeUFMData -> NodeUFMData
-
-getCommonNodeUFMData (NodeUFMData i p) (NodeUFMData i2 p2)
-  | p ==# p2	= getCommonNodeUFMData_ p j j2
-  | p <# p2	= getCommonNodeUFMData_ p2 (j `quotFastInt` (p2 `quotFastInt` p)) j2
-  | otherwise	= getCommonNodeUFMData_ p j (j2 `quotFastInt` (p `quotFastInt` p2))
-  where
-    l  = (_ILIT(1) :: FastInt)
-    j  = i  `quotFastInt` (p  `shiftL_` l)
-    j2 = i2 `quotFastInt` (p2 `shiftL_` l)
-
-    getCommonNodeUFMData_ :: FastInt -> FastInt -> FastInt -> NodeUFMData
-
-    getCommonNodeUFMData_ p j j_
-      | j ==# j_
-      = NodeUFMData (((j `shiftL_` l) +# l) *# p) p
-      | otherwise
-      = getCommonNodeUFMData_ (p `shiftL_`  l) (j `shiftR_` l) (j_ `shiftR_` l)
-
-ask_about_common_ancestor :: NodeUFMData -> NodeUFMData -> CommonRoot
-
-ask_about_common_ancestor x@(NodeUFMData j p) y@(NodeUFMData j2 p2)
-  | j ==# j2 = SameRoot
-  | otherwise
-  = case getCommonNodeUFMData x y of
-      nd@(NodeUFMData j3 p3)
-	| j3 ==# j  -> LeftRoot (decideSide (j ># j2))
-	| j3 ==# j2 -> RightRoot (decideSide (j <# j2))
-	| otherwise   -> NewRoot nd (j ># j2)
-    where
-	decideSide :: Bool -> Side
-	decideSide True	 = Leftt
-	decideSide False = Rightt
-\end{code}
-
-This might be better in Util.lhs ?
-
-
-Now the bit twiddling functions.
-\begin{code}
-shiftL_ :: FastInt -> FastInt -> FastInt
-shiftR_ :: FastInt -> FastInt -> FastInt
-
-#if __GLASGOW_HASKELL__
-{-# INLINE shiftL_ #-}
-{-# INLINE shiftR_ #-}
-#if __GLASGOW_HASKELL__ >= 503
-shiftL_ n p = word2Int#((int2Word# n) `uncheckedShiftL#` p)
-#else
-shiftL_ n p = word2Int#((int2Word# n) `shiftL#` p)
-#endif
-shiftR_ n p = word2Int#((int2Word# n) `shiftr` p)
-  where
-#if __GLASGOW_HASKELL__ >= 503
-    shiftr x y = uncheckedShiftRL# x y
-#else
-    shiftr x y = shiftRL# x y
-#endif
-
-#else /* not GHC */
-shiftL_ n p = n * (2 ^ p)
-shiftR_ n p = n `quot` (2 ^ p)
-
-#endif /* not GHC */
-\end{code}
-
-\begin{code}
-use_snd :: a -> b -> b
-use_snd a b = b
-\end{code}
diff --git a/ghc/compiler/utils/UniqSet.lhs b/ghc/compiler/utils/UniqSet.lhs
deleted file mode 100644
index 129e333eb5..0000000000
--- a/ghc/compiler/utils/UniqSet.lhs
+++ /dev/null
@@ -1,138 +0,0 @@
-%
-% (c) The AQUA Project, Glasgow University, 1994-1998
-%
-\section[UniqSet]{Specialised sets, for things with @Uniques@}
-
-Based on @UniqFMs@ (as you would expect).
-
-Basically, the things need to be in class @Uniquable@.
-
-\begin{code}
-module UniqSet (
-	UniqSet,    -- abstract type: NOT
-
-	mkUniqSet, uniqSetToList, emptyUniqSet, unitUniqSet,
-	addOneToUniqSet, addListToUniqSet, delOneFromUniqSet, delListFromUniqSet,
-	unionUniqSets, unionManyUniqSets, minusUniqSet,
-	elementOfUniqSet, mapUniqSet, intersectUniqSets,
-	isEmptyUniqSet, filterUniqSet, sizeUniqSet, foldUniqSet,
-	elemUniqSet_Directly, lookupUniqSet, hashUniqSet
-    ) where
-
-#include "HsVersions.h"
-
-import {-# SOURCE #-} Name ( Name )
-
-import Maybes		( maybeToBool )
-import UniqFM
-import Unique		( Unique, Uniquable(..) )
-
-#if ! OMIT_NATIVE_CODEGEN
-#define IF_NCG(a) a
-#else
-#define IF_NCG(a) {--}
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The @UniqSet@ type}
-%*									*
-%************************************************************************
-
-We use @UniqFM@, with a (@getUnique@-able) @Unique@ as ``key''
-and the thing itself as the ``value'' (for later retrieval).
-
-\begin{code}
---data UniqSet a = MkUniqSet (FiniteMap Unique a) : NOT
-
-type UniqSet a = UniqFM a
-#define MkUniqSet {--}
-
-emptyUniqSet :: UniqSet a
-emptyUniqSet = MkUniqSet emptyUFM
-
-unitUniqSet :: Uniquable a => a -> UniqSet a
-unitUniqSet x = MkUniqSet (unitUFM x x)
-
-uniqSetToList :: UniqSet a -> [a]
-uniqSetToList (MkUniqSet set) = eltsUFM set
-
-foldUniqSet :: (a -> b -> b) -> b -> UniqSet a -> b
-foldUniqSet k z (MkUniqSet set) = foldUFM k z set 
-
-mkUniqSet :: Uniquable a => [a]  -> UniqSet a
-mkUniqSet xs = MkUniqSet (listToUFM [ (x, x) | x <- xs])
-
-addOneToUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
-addOneToUniqSet (MkUniqSet set) x = MkUniqSet (addToUFM set x x)
-
-delOneFromUniqSet :: Uniquable a => UniqSet a -> a -> UniqSet a
-delOneFromUniqSet (MkUniqSet set) x = MkUniqSet (delFromUFM set x)
-
-delListFromUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
-delListFromUniqSet (MkUniqSet set) xs = MkUniqSet (delListFromUFM set xs)
-
-addListToUniqSet :: Uniquable a => UniqSet a -> [a] -> UniqSet a
-addListToUniqSet (MkUniqSet set) xs = MkUniqSet (addListToUFM set [(x,x) | x<-xs])
-
-unionUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
-unionUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (plusUFM set1 set2)
-
-unionManyUniqSets :: [UniqSet a] -> UniqSet a
-	-- = foldr unionUniqSets emptyUniqSet ss
-unionManyUniqSets []	 = emptyUniqSet
-unionManyUniqSets [s]	 = s
-unionManyUniqSets (s:ss) = s `unionUniqSets` unionManyUniqSets ss
-
-minusUniqSet  :: UniqSet a -> UniqSet a -> UniqSet a
-minusUniqSet (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (minusUFM set1 set2)
-
-filterUniqSet :: (a -> Bool) -> UniqSet a -> UniqSet a
-filterUniqSet pred (MkUniqSet set) = MkUniqSet (filterUFM pred set)
-
-intersectUniqSets :: UniqSet a -> UniqSet a -> UniqSet a
-intersectUniqSets (MkUniqSet set1) (MkUniqSet set2) = MkUniqSet (intersectUFM set1 set2)
-
-elementOfUniqSet :: Uniquable a => a -> UniqSet a -> Bool
-elementOfUniqSet x (MkUniqSet set) = maybeToBool (lookupUFM set x)
-
-lookupUniqSet :: Uniquable a => UniqSet a -> a -> Maybe a
-lookupUniqSet (MkUniqSet set) x = lookupUFM set x
-
-elemUniqSet_Directly :: Unique -> UniqSet a -> Bool
-elemUniqSet_Directly x (MkUniqSet set) = maybeToBool (lookupUFM_Directly set x)
-
-sizeUniqSet :: UniqSet a -> Int
-sizeUniqSet (MkUniqSet set) = sizeUFM set
-
-hashUniqSet :: UniqSet a -> Int
-hashUniqSet (MkUniqSet set) = hashUFM set
-
-isEmptyUniqSet :: UniqSet a -> Bool
-isEmptyUniqSet (MkUniqSet set) = isNullUFM set {-SLOW: sizeUFM set == 0-}
-
-mapUniqSet :: (a -> a) -> UniqSet a -> UniqSet a
-  -- VERY IMPORTANT: *assumes* that the function doesn't change the unique
-mapUniqSet f (MkUniqSet set) = MkUniqSet (mapUFM f set)
-\end{code}
-
-\begin{code}
-#if __GLASGOW_HASKELL__
-{-# SPECIALIZE
-    addOneToUniqSet :: UniqSet Unique -> Unique -> UniqSet Unique
-    #-}
-{- SPECIALIZE
-    elementOfUniqSet :: Name -> UniqSet Name -> Bool
-		      , Unique -> UniqSet Unique -> Bool
-    -}
-{- SPECIALIZE
-    mkUniqSet :: [Name] -> UniqSet Name
-    -}
-
-{- SPECIALIZE
-    unitUniqSet :: Name -> UniqSet Name
-		 , Unique -> UniqSet Unique
-    -}
-#endif
-\end{code}
diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
deleted file mode 100644
index e692ff1aa3..0000000000
--- a/ghc/compiler/utils/Util.lhs
+++ /dev/null
@@ -1,1029 +0,0 @@
-%
-% (c) The University of Glasgow 1992-2002
-%
-\section[Util]{Highly random utility functions}
-
-\begin{code}
-module Util (
-
-	-- general list processing
-	zipEqual, zipWithEqual, zipWith3Equal, zipWith4Equal,
-        zipLazy, stretchZipWith,
-	mapFst, mapSnd,
-	mapAndUnzip, mapAndUnzip3,
-	nOfThem, filterOut,
-	lengthExceeds, lengthIs, lengthAtLeast, listLengthCmp, atLength,
-	isSingleton, only, singleton,
-	notNull, snocView,
-
-	isIn, isn'tIn,
-
-	-- for-loop
-	nTimes,
-
-	-- sorting
-	sortLe, sortWith,
-
-	-- transitive closures
-	transitiveClosure,
-
-	-- accumulating
-	mapAccumL, mapAccumR, mapAccumB, 
-	foldl2, count, all2,
-	
-	takeList, dropList, splitAtList, split,
-
-	-- comparisons
-	isEqual, eqListBy, equalLength, compareLength,
-	thenCmp, cmpList, prefixMatch, suffixMatch, maybePrefixMatch,
-	removeSpaces,
-
-	-- strictness
-	foldl', seqList,
-
-	-- pairs
-	unzipWith,
-
-	global, consIORef,
-
-	-- module names
-	looksLikeModuleName,
-	
-	toArgs,
-
-	-- Floating point stuff
-	readRational,
-
-	-- IO-ish utilities
-	createDirectoryHierarchy,
-	doesDirNameExist,
-	modificationTimeIfExists,
-
-	later, handleDyn, handle,
-
-	-- Filename utils
-	Suffix,
-	splitFilename, suffixOf, basenameOf, joinFileExt,
-	splitFilenameDir, joinFileName,
-	splitFilename3,
-	splitLongestPrefix,
-	replaceFilenameSuffix, directoryOf, filenameOf,
-	replaceFilenameDirectory,
-	escapeSpaces, isPathSeparator,
-	parseSearchPath,
-	normalisePath, platformPath, pgmPath,
-    ) where
-
-#include "HsVersions.h"
-
-import Panic		( panic, trace )
-import FastTypes
-
-import EXCEPTION	( Exception(..), finally, throwDyn, catchDyn, throw )
-import qualified EXCEPTION as Exception
-import DYNAMIC		( Typeable )
-import DATA_IOREF	( IORef, newIORef )
-import UNSAFE_IO	( unsafePerformIO )
-import DATA_IOREF	( readIORef, writeIORef )
-
-import qualified List	( elem, notElem )
-
-#ifndef DEBUG
-import List		( zipWith4 )
-#endif
-
-import Monad		( when )
-import IO		( catch, isDoesNotExistError )
-import Directory	( doesDirectoryExist, createDirectory )
-import Char		( isUpper, isAlphaNum, isSpace, ord, isDigit )
-import Ratio		( (%) )
-import Time		( ClockTime )
-import Directory	( getModificationTime )
-
-infixr 9 `thenCmp`
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{The Eager monad}
-%*									*
-%************************************************************************
-
-The @Eager@ monad is just an encoding of continuation-passing style,
-used to allow you to express "do this and then that", mainly to avoid
-space leaks. It's done with a type synonym to save bureaucracy.
-
-\begin{code}
-#if NOT_USED
-
-type Eager ans a = (a -> ans) -> ans
-
-runEager :: Eager a a -> a
-runEager m = m (\x -> x)
-
-appEager :: Eager ans a -> (a -> ans) -> ans
-appEager m cont = m cont
-
-thenEager :: Eager ans a -> (a -> Eager ans b) -> Eager ans b
-thenEager m k cont = m (\r -> k r cont)
-
-returnEager :: a -> Eager ans a
-returnEager v cont = cont v
-
-mapEager :: (a -> Eager ans b) -> [a] -> Eager ans [b]
-mapEager f [] = returnEager []
-mapEager f (x:xs) = f x			`thenEager` \ y ->
-		    mapEager f xs	`thenEager` \ ys ->
-		    returnEager (y:ys)
-#endif
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{A for loop}
-%*									*
-%************************************************************************
-
-\begin{code}
--- Compose a function with itself n times.  (nth rather than twice)
-nTimes :: Int -> (a -> a) -> (a -> a)
-nTimes 0 _ = id
-nTimes 1 f = f
-nTimes n f = f . nTimes (n-1) f
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Utils-lists]{General list processing}
-%*									*
-%************************************************************************
-
-\begin{code}
-filterOut :: (a->Bool) -> [a] -> [a]
--- Like filter, only reverses the sense of the test
-filterOut p [] = []
-filterOut p (x:xs) | p x       = filterOut p xs
-		   | otherwise = x : filterOut p xs
-\end{code}
-
-A paranoid @zip@ (and some @zipWith@ friends) that checks the lists
-are of equal length.  Alastair Reid thinks this should only happen if
-DEBUGging on; hey, why not?
-
-\begin{code}
-zipEqual	:: String -> [a] -> [b] -> [(a,b)]
-zipWithEqual	:: String -> (a->b->c) -> [a]->[b]->[c]
-zipWith3Equal	:: String -> (a->b->c->d) -> [a]->[b]->[c]->[d]
-zipWith4Equal	:: String -> (a->b->c->d->e) -> [a]->[b]->[c]->[d]->[e]
-
-#ifndef DEBUG
-zipEqual      _ = zip
-zipWithEqual  _ = zipWith
-zipWith3Equal _ = zipWith3
-zipWith4Equal _ = zipWith4
-#else
-zipEqual msg []     []     = []
-zipEqual msg (a:as) (b:bs) = (a,b) : zipEqual msg as bs
-zipEqual msg as     bs     = panic ("zipEqual: unequal lists:"++msg)
-
-zipWithEqual msg z (a:as) (b:bs)=  z a b : zipWithEqual msg z as bs
-zipWithEqual msg _ [] []	=  []
-zipWithEqual msg _ _ _		=  panic ("zipWithEqual: unequal lists:"++msg)
-
-zipWith3Equal msg z (a:as) (b:bs) (c:cs)
-				=  z a b c : zipWith3Equal msg z as bs cs
-zipWith3Equal msg _ [] []  []	=  []
-zipWith3Equal msg _ _  _   _	=  panic ("zipWith3Equal: unequal lists:"++msg)
-
-zipWith4Equal msg z (a:as) (b:bs) (c:cs) (d:ds)
-				=  z a b c d : zipWith4Equal msg z as bs cs ds
-zipWith4Equal msg _ [] [] [] []	=  []
-zipWith4Equal msg _ _  _  _  _	=  panic ("zipWith4Equal: unequal lists:"++msg)
-#endif
-\end{code}
-
-\begin{code}
--- zipLazy is lazy in the second list (observe the ~)
-
-zipLazy :: [a] -> [b] -> [(a,b)]
-zipLazy [] ys = []
-zipLazy (x:xs) ~(y:ys) = (x,y) : zipLazy xs ys
-\end{code}
-
-
-\begin{code}
-stretchZipWith :: (a -> Bool) -> b -> (a->b->c) -> [a] -> [b] -> [c]
--- (stretchZipWith p z f xs ys) stretches ys by inserting z in 
--- the places where p returns *True*
-
-stretchZipWith p z f [] ys = []
-stretchZipWith p z f (x:xs) ys
-  | p x       = f x z : stretchZipWith p z f xs ys
-  | otherwise = case ys of
-		  []     -> []
-		  (y:ys) -> f x y : stretchZipWith p z f xs ys
-\end{code}
-
-
-\begin{code}
-mapFst :: (a->c) -> [(a,b)] -> [(c,b)]
-mapSnd :: (b->c) -> [(a,b)] -> [(a,c)]
-
-mapFst f xys = [(f x, y) | (x,y) <- xys]
-mapSnd f xys = [(x, f y) | (x,y) <- xys]
-
-mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])
-
-mapAndUnzip f [] = ([],[])
-mapAndUnzip f (x:xs)
-  = let
-	(r1,  r2)  = f x
-	(rs1, rs2) = mapAndUnzip f xs
-    in
-    (r1:rs1, r2:rs2)
-
-mapAndUnzip3 :: (a -> (b, c, d)) -> [a] -> ([b], [c], [d])
-
-mapAndUnzip3 f [] = ([],[],[])
-mapAndUnzip3 f (x:xs)
-  = let
-	(r1,  r2,  r3)  = f x
-	(rs1, rs2, rs3) = mapAndUnzip3 f xs
-    in
-    (r1:rs1, r2:rs2, r3:rs3)
-\end{code}
-
-\begin{code}
-nOfThem :: Int -> a -> [a]
-nOfThem n thing = replicate n thing
-
--- 'atLength atLen atEnd ls n' unravels list 'ls' to position 'n';
--- specification:
---
---  atLength atLenPred atEndPred ls n
---   | n < 0         = atLenPred n
---   | length ls < n = atEndPred (n - length ls)
---   | otherwise     = atLenPred (drop n ls)
---
-atLength :: ([a] -> b)
-         -> (Int -> b)
-         -> [a]
-         -> Int
-         -> b
-atLength atLenPred atEndPred ls n 
-  | n < 0     = atEndPred n 
-  | otherwise = go n ls
-  where
-    go n [] = atEndPred n
-    go 0 ls = atLenPred ls
-    go n (_:xs) = go (n-1) xs
-
--- special cases.
-lengthExceeds :: [a] -> Int -> Bool
--- (lengthExceeds xs n) = (length xs > n)
-lengthExceeds = atLength notNull (const False)
-
-lengthAtLeast :: [a] -> Int -> Bool
-lengthAtLeast = atLength notNull (== 0)
-
-lengthIs :: [a] -> Int -> Bool
-lengthIs = atLength null (==0)
-
-listLengthCmp :: [a] -> Int -> Ordering 
-listLengthCmp = atLength atLen atEnd 
- where
-  atEnd 0      = EQ
-  atEnd x
-   | x > 0     = LT -- not yet seen 'n' elts, so list length is < n.
-   | otherwise = GT
-
-  atLen []     = EQ
-  atLen _      = GT
-
-singleton :: a -> [a]
-singleton x = [x]
-
-isSingleton :: [a] -> Bool
-isSingleton [x] = True
-isSingleton  _  = False
-
-notNull :: [a] -> Bool
-notNull [] = False
-notNull _  = True
-
-snocView :: [a] -> Maybe ([a],a)
-	-- Split off the last element
-snocView [] = Nothing
-snocView xs = go [] xs
-	    where
-		-- Invariant: second arg is non-empty
-	      go acc [x]    = Just (reverse acc, x)
-	      go acc (x:xs) = go (x:acc) xs
-
-only :: [a] -> a
-#ifdef DEBUG
-only [a] = a
-#else
-only (a:_) = a
-#endif
-\end{code}
-
-Debugging/specialising versions of \tr{elem} and \tr{notElem}
-
-\begin{code}
-isIn, isn'tIn :: (Eq a) => String -> a -> [a] -> Bool
-
-# ifndef DEBUG
-isIn    msg x ys = elem__    x ys
-isn'tIn msg x ys = notElem__ x ys
-
---these are here to be SPECIALIZEd (automagically)
-elem__ _ []	= False
-elem__ x (y:ys)	= x==y || elem__ x ys
-
-notElem__ x []	   =  True
-notElem__ x (y:ys) =  x /= y && notElem__ x ys
-
-# else /* DEBUG */
-isIn msg x ys
-  = elem (_ILIT 0) x ys
-  where
-    elem i _ []	    = False
-    elem i x (y:ys)
-      | i ># _ILIT 100 = trace ("Over-long elem in " ++ msg) $
-			 x `List.elem` (y:ys)
-      | otherwise      = x == y || elem (i +# _ILIT(1)) x ys
-
-isn'tIn msg x ys
-  = notElem (_ILIT 0) x ys
-  where
-    notElem i x [] =  True
-    notElem i x (y:ys)
-      | i ># _ILIT 100 = trace ("Over-long notElem in " ++ msg) $
-		         x `List.notElem` (y:ys)
-      | otherwise      =  x /= y && notElem (i +# _ILIT(1)) x ys
-# endif /* DEBUG */
-\end{code}
-
-%************************************************************************
-%*									*
-\subsubsection[Utils-Carsten-mergesort]{A mergesort from Carsten}
-%*									*
-%************************************************************************
-
-\begin{display}
-Date: Mon, 3 May 93 20:45:23 +0200
-From: Carsten Kehler Holst <kehler@cs.chalmers.se>
-To: partain@dcs.gla.ac.uk
-Subject: natural merge sort beats quick sort [ and it is prettier ]
-
-Here is a piece of Haskell code that I'm rather fond of. See it as an
-attempt to get rid of the ridiculous quick-sort routine. group is
-quite useful by itself I think it was John's idea originally though I
-believe the lazy version is due to me [surprisingly complicated].
-gamma [used to be called] is called gamma because I got inspired by
-the Gamma calculus. It is not very close to the calculus but does
-behave less sequentially than both foldr and foldl. One could imagine
-a version of gamma that took a unit element as well thereby avoiding
-the problem with empty lists.
-
-I've tried this code against
-
-   1) insertion sort - as provided by haskell
-   2) the normal implementation of quick sort
-   3) a deforested version of quick sort due to Jan Sparud
-   4) a super-optimized-quick-sort of Lennart's
-
-If the list is partially sorted both merge sort and in particular
-natural merge sort wins. If the list is random [ average length of
-rising subsequences = approx 2 ] mergesort still wins and natural
-merge sort is marginally beaten by Lennart's soqs. The space
-consumption of merge sort is a bit worse than Lennart's quick sort
-approx a factor of 2. And a lot worse if Sparud's bug-fix [see his
-fpca article ] isn't used because of group.
-
-have fun
-Carsten
-\end{display}
-
-\begin{code}
-group :: (a -> a -> Bool) -> [a] -> [[a]]
--- Given a <= function, group finds maximal contiguous up-runs 
--- or down-runs in the input list.
--- It's stable, in the sense that it never re-orders equal elements
---
--- Date: Mon, 12 Feb 1996 15:09:41 +0000
--- From: Andy Gill <andy@dcs.gla.ac.uk>
--- Here is a `better' definition of group.
-
-group p []     = []
-group p (x:xs) = group' xs x x (x :)
-  where
-    group' []     _     _     s  = [s []]
-    group' (x:xs) x_min x_max s 
-	|      x_max `p` x  = group' xs x_min x (s . (x :)) 
-	| not (x_min `p` x) = group' xs x x_max ((x :) . s) 
-	| otherwise         = s [] : group' xs x x (x :) 
-	-- NB: the 'not' is essential for stablity
-	--	x `p` x_min would reverse equal elements
-
-generalMerge :: (a -> a -> Bool) -> [a] -> [a] -> [a]
-generalMerge p xs [] = xs
-generalMerge p [] ys = ys
-generalMerge p (x:xs) (y:ys) | x `p` y   = x : generalMerge p xs (y:ys)
-			     | otherwise = y : generalMerge p (x:xs) ys
-
--- gamma is now called balancedFold
-
-balancedFold :: (a -> a -> a) -> [a] -> a
-balancedFold f [] = error "can't reduce an empty list using balancedFold"
-balancedFold f [x] = x
-balancedFold f l  = balancedFold f (balancedFold' f l)
-
-balancedFold' :: (a -> a -> a) -> [a] -> [a]
-balancedFold' f (x:y:xs) = f x y : balancedFold' f xs
-balancedFold' f xs = xs
-
-generalNaturalMergeSort p [] = []
-generalNaturalMergeSort p xs = (balancedFold (generalMerge p) . group p) xs
-
-#if NOT_USED
-generalMergeSort p [] = []
-generalMergeSort p xs = (balancedFold (generalMerge p) . map (: [])) xs
-
-mergeSort, naturalMergeSort :: Ord a => [a] -> [a]
-
-mergeSort = generalMergeSort (<=)
-naturalMergeSort = generalNaturalMergeSort (<=)
-
-mergeSortLe le = generalMergeSort le
-#endif
-
-sortLe :: (a->a->Bool) -> [a] -> [a]
-sortLe le = generalNaturalMergeSort le
-
-sortWith :: Ord b => (a->b) -> [a] -> [a]
-sortWith get_key xs = sortLe le xs
-  where
-    x `le` y = get_key x < get_key y	
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Utils-transitive-closure]{Transitive closure}
-%*									*
-%************************************************************************
-
-This algorithm for transitive closure is straightforward, albeit quadratic.
-
-\begin{code}
-transitiveClosure :: (a -> [a])		-- Successor function
-		  -> (a -> a -> Bool)	-- Equality predicate
-		  -> [a]
-		  -> [a]		-- The transitive closure
-
-transitiveClosure succ eq xs
- = go [] xs
- where
-   go done [] 			   = done
-   go done (x:xs) | x `is_in` done = go done xs
-   		  | otherwise      = go (x:done) (succ x ++ xs)
-
-   x `is_in` []                 = False
-   x `is_in` (y:ys) | eq x y    = True
-  		    | otherwise = x `is_in` ys
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Utils-accum]{Accumulating}
-%*									*
-%************************************************************************
-
-@mapAccumL@ behaves like a combination
-of  @map@ and @foldl@;
-it applies a function to each element of a list, passing an accumulating
-parameter from left to right, and returning a final value of this
-accumulator together with the new list.
-
-\begin{code}
-mapAccumL :: (acc -> x -> (acc, y)) 	-- Function of elt of input list
-					-- and accumulator, returning new
-					-- accumulator and elt of result list
-	    -> acc 		-- Initial accumulator
-	    -> [x] 		-- Input list
-	    -> (acc, [y])		-- Final accumulator and result list
-
-mapAccumL f b []     = (b, [])
-mapAccumL f b (x:xs) = (b'', x':xs') where
-					  (b', x') = f b x
-					  (b'', xs') = mapAccumL f b' xs
-\end{code}
-
-@mapAccumR@ does the same, but working from right to left instead.  Its type is
-the same as @mapAccumL@, though.
-
-\begin{code}
-mapAccumR :: (acc -> x -> (acc, y)) 	-- Function of elt of input list
-					-- and accumulator, returning new
-					-- accumulator and elt of result list
-	    -> acc 		-- Initial accumulator
-	    -> [x] 		-- Input list
-	    -> (acc, [y])		-- Final accumulator and result list
-
-mapAccumR f b []     = (b, [])
-mapAccumR f b (x:xs) = (b'', x':xs') where
-					  (b'', x') = f b' x
-					  (b', xs') = mapAccumR f b xs
-\end{code}
-
-Here is the bi-directional version, that works from both left and right.
-
-\begin{code}
-mapAccumB :: (accl -> accr -> x -> (accl, accr,y))
-      				-- Function of elt of input list
-      				-- and accumulator, returning new
-      				-- accumulator and elt of result list
-	  -> accl 			-- Initial accumulator from left
-	  -> accr 			-- Initial accumulator from right
-	  -> [x] 			-- Input list
-	  -> (accl, accr, [y])	-- Final accumulators and result list
-
-mapAccumB f a b []     = (a,b,[])
-mapAccumB f a b (x:xs) = (a'',b'',y:ys)
-   where
-	(a',b'',y)  = f a b' x
-	(a'',b',ys) = mapAccumB f a' b xs
-\end{code}
-
-A strict version of foldl.
-
-\begin{code}
-foldl'        :: (a -> b -> a) -> a -> [b] -> a
-foldl' f z xs = lgo z xs
-	     where
-		lgo z []     =  z
-		lgo z (x:xs) = (lgo $! (f z x)) xs
-\end{code}
-
-A combination of foldl with zip.  It works with equal length lists.
-
-\begin{code}
-foldl2 :: (acc -> a -> b -> acc) -> acc -> [a] -> [b] -> acc
-foldl2 k z [] [] = z
-foldl2 k z (a:as) (b:bs) = foldl2 k (k z a b) as bs
-
-all2 :: (a -> b -> Bool) -> [a] -> [b] -> Bool
--- True if the lists are the same length, and 
--- all corresponding elements satisfy the predicate
-all2 p []     []     = True
-all2 p (x:xs) (y:ys) = p x y && all2 p xs ys
-all2 p xs     ys     = False
-\end{code}
-
-Count the number of times a predicate is true
-
-\begin{code}
-count :: (a -> Bool) -> [a] -> Int
-count p [] = 0
-count p (x:xs) | p x       = 1 + count p xs
-	       | otherwise = count p xs
-\end{code}
-
-@splitAt@, @take@, and @drop@ but with length of another
-list giving the break-off point:
-
-\begin{code}
-takeList :: [b] -> [a] -> [a]
-takeList [] _ = []
-takeList (_:xs) ls = 
-   case ls of
-     [] -> []
-     (y:ys) -> y : takeList xs ys
-
-dropList :: [b] -> [a] -> [a]
-dropList [] xs    = xs
-dropList _  xs@[] = xs
-dropList (_:xs) (_:ys) = dropList xs ys
-
-
-splitAtList :: [b] -> [a] -> ([a], [a])
-splitAtList [] xs     = ([], xs)
-splitAtList _ xs@[]   = (xs, xs)
-splitAtList (_:xs) (y:ys) = (y:ys', ys'')
-    where
-      (ys', ys'') = splitAtList xs ys
-
-split :: Char -> String -> [String]
-split c s = case rest of
-		[]     -> [chunk] 
-		_:rest -> chunk : split c rest
-  where (chunk, rest) = break (==c) s
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Utils-comparison]{Comparisons}
-%*									*
-%************************************************************************
-
-\begin{code}
-isEqual :: Ordering -> Bool
--- Often used in (isEqual (a `compare` b))
-isEqual GT = False
-isEqual EQ = True
-isEqual LT = False
-
-thenCmp :: Ordering -> Ordering -> Ordering
-{-# INLINE thenCmp #-}
-thenCmp EQ   any = any
-thenCmp other any = other
-
-eqListBy :: (a->a->Bool) -> [a] -> [a] -> Bool
-eqListBy eq []     []     = True
-eqListBy eq (x:xs) (y:ys) = eq x y && eqListBy eq xs ys
-eqListBy eq xs     ys     = False
-
-equalLength :: [a] -> [b] -> Bool
-equalLength [] []         = True
-equalLength (_:xs) (_:ys) = equalLength xs ys
-equalLength xs    ys      = False
-
-compareLength :: [a] -> [b] -> Ordering
-compareLength [] []         = EQ
-compareLength (_:xs) (_:ys) = compareLength xs ys
-compareLength [] _ys        = LT
-compareLength _xs []        = GT
-
-cmpList :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
-    -- `cmpList' uses a user-specified comparer
-
-cmpList cmp []     [] = EQ
-cmpList cmp []     _  = LT
-cmpList cmp _      [] = GT
-cmpList cmp (a:as) (b:bs)
-  = case cmp a b of { EQ -> cmpList cmp as bs; xxx -> xxx }
-\end{code}
-
-\begin{code}
-prefixMatch :: Eq a => [a] -> [a] -> Bool
-prefixMatch [] _str = True
-prefixMatch _pat [] = False
-prefixMatch (p:ps) (s:ss) | p == s    = prefixMatch ps ss
-			  | otherwise = False
-
-maybePrefixMatch :: String -> String -> Maybe String
-maybePrefixMatch []    rest = Just rest
-maybePrefixMatch (_:_) []   = Nothing
-maybePrefixMatch (p:pat) (r:rest)
-  | p == r    = maybePrefixMatch pat rest
-  | otherwise = Nothing
-
-suffixMatch :: Eq a => [a] -> [a] -> Bool
-suffixMatch pat str = prefixMatch (reverse pat) (reverse str)
-
-removeSpaces :: String -> String
-removeSpaces = reverse . dropWhile isSpace . reverse . dropWhile isSpace
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection[Utils-pairs]{Pairs}
-%*									*
-%************************************************************************
-
-The following are curried versions of @fst@ and @snd@.
-
-\begin{code}
-#if NOT_USED
-cfst :: a -> b -> a	-- stranal-sem only (Note)
-cfst x y = x
-#endif
-\end{code}
-
-The following provide us higher order functions that, when applied
-to a function, operate on pairs.
-
-\begin{code}
-#if NOT_USED
-applyToPair :: ((a -> c),(b -> d)) -> (a,b) -> (c,d)
-applyToPair (f,g) (x,y) = (f x, g y)
-
-applyToFst :: (a -> c) -> (a,b)-> (c,b)
-applyToFst f (x,y) = (f x,y)
-
-applyToSnd :: (b -> d) -> (a,b) -> (a,d)
-applyToSnd f (x,y) = (x,f y)
-#endif
-\end{code}
-
-\begin{code}
-unzipWith :: (a -> b -> c) -> [(a, b)] -> [c]
-unzipWith f pairs = map ( \ (a, b) -> f a b ) pairs
-\end{code}
-
-\begin{code}
-seqList :: [a] -> b -> b
-seqList [] b = b
-seqList (x:xs) b = x `seq` seqList xs b
-\end{code}
-
-Global variables:
-
-\begin{code}
-global :: a -> IORef a
-global a = unsafePerformIO (newIORef a)
-\end{code}
-
-\begin{code}
-consIORef :: IORef [a] -> a -> IO ()
-consIORef var x = do
-  xs <- readIORef var
-  writeIORef var (x:xs)
-\end{code}
-
-Module names:
-
-\begin{code}
-looksLikeModuleName [] = False
-looksLikeModuleName (c:cs) = isUpper c && go cs
-  where go [] = True
-	go ('.':cs) = looksLikeModuleName cs
-	go (c:cs)   = (isAlphaNum c || c == '_') && go cs
-\end{code}
-
-Akin to @Prelude.words@, but sensitive to dquoted entities treating
-them as single words.
-
-\begin{code}
-toArgs :: String -> [String]
-toArgs "" = []
-toArgs s  =
-  case break (\ ch -> isSpace ch || ch == '"') (dropWhile isSpace s) of -- "
-    (w,aft) ->
-       (\ ws -> if null w then ws else w : ws) $
-       case aft of
-	 []           -> []
-	 (x:xs)
-	   | x /= '"'  -> toArgs xs
-	   | otherwise ->
-             case lex aft of
-	       ((str,rs):_) -> stripQuotes str : toArgs rs
-	       _            -> [aft]
- where
-    -- strip away dquotes; assume first and last chars contain quotes.
-   stripQuotes :: String -> String
-   stripQuotes ('"':xs)  = init xs
-   stripQuotes xs        = xs
-\end{code}
-
--- -----------------------------------------------------------------------------
--- Floats
-
-\begin{code}
-readRational__ :: ReadS Rational -- NB: doesn't handle leading "-"
-readRational__ r = do 
-     (n,d,s) <- readFix r
-     (k,t)   <- readExp s
-     return ((n%1)*10^^(k-d), t)
- where
-     readFix r = do
-	(ds,s)  <- lexDecDigits r
-	(ds',t) <- lexDotDigits s
-	return (read (ds++ds'), length ds', t)
-
-     readExp (e:s) | e `elem` "eE" = readExp' s
-     readExp s			   = return (0,s)
-
-     readExp' ('+':s) = readDec s
-     readExp' ('-':s) = do
-			(k,t) <- readDec s
-			return (-k,t)
-     readExp' s	      = readDec s
-
-     readDec s = do
-        (ds,r) <- nonnull isDigit s
-        return (foldl1 (\n d -> n * 10 + d) [ ord d - ord '0' | d <- ds ],
-                r)
-
-     lexDecDigits = nonnull isDigit
-
-     lexDotDigits ('.':s) = return (span isDigit s)
-     lexDotDigits s       = return ("",s)
-
-     nonnull p s = do (cs@(_:_),t) <- return (span p s)
-                      return (cs,t)
-
-readRational :: String -> Rational -- NB: *does* handle a leading "-"
-readRational top_s
-  = case top_s of
-      '-' : xs -> - (read_me xs)
-      xs       -> read_me xs
-  where
-    read_me s
-      = case (do { (x,"") <- readRational__ s ; return x }) of
-	  [x] -> x
-	  []  -> error ("readRational: no parse:"        ++ top_s)
-	  _   -> error ("readRational: ambiguous parse:" ++ top_s)
-
-
------------------------------------------------------------------------------
--- Create a hierarchy of directories
-
-createDirectoryHierarchy :: FilePath -> IO ()
-createDirectoryHierarchy dir = do
-  b <- doesDirectoryExist dir
-  when (not b) $ do
-	createDirectoryHierarchy (directoryOf dir)
-	createDirectory dir
-
------------------------------------------------------------------------------
--- Verify that the 'dirname' portion of a FilePath exists.
--- 
-doesDirNameExist :: FilePath -> IO Bool
-doesDirNameExist fpath = doesDirectoryExist (directoryOf fpath)
-
--- -----------------------------------------------------------------------------
--- Exception utils
-
-later = flip finally
-
-handleDyn :: Typeable ex => (ex -> IO a) -> IO a -> IO a
-handleDyn = flip catchDyn
-
-handle :: (Exception -> IO a) -> IO a -> IO a
-#if __GLASGOW_HASKELL__ < 501
-handle = flip Exception.catchAllIO
-#else
-handle h f = f `Exception.catch` \e -> case e of
-    ExitException _ -> throw e
-    _               -> h e
-#endif
-
--- --------------------------------------------------------------
--- check existence & modification time at the same time
-
-modificationTimeIfExists :: FilePath -> IO (Maybe ClockTime)
-modificationTimeIfExists f = do
-  (do t <- getModificationTime f; return (Just t))
-	`IO.catch` \e -> if isDoesNotExistError e 
-			then return Nothing 
-			else ioError e
-
--- --------------------------------------------------------------
--- Filename manipulation
-		
--- Filenames are kept "normalised" inside GHC, using '/' as the path
--- separator.  On Windows these functions will also recognise '\\' as
--- the path separator, but will generally construct paths using '/'.
-
-type Suffix = String
-
-splitFilename :: String -> (String,Suffix)
-splitFilename f = splitLongestPrefix f (=='.')
-
-basenameOf :: FilePath -> String
-basenameOf = fst . splitFilename
-
-suffixOf :: FilePath -> Suffix
-suffixOf = snd . splitFilename
-
-joinFileExt :: String -> String -> FilePath
-joinFileExt path ""  = path
-joinFileExt path ext = path ++ '.':ext
-
--- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy.ext")
-splitFilenameDir :: String -> (String,String)
-splitFilenameDir str
-   = let (dir, rest) = splitLongestPrefix str isPathSeparator
-	 (dir', rest') | null rest = (".", dir)
-		       | otherwise = (dir, rest)
-     in  (dir', rest')
-
--- "foo/bar/xyzzy.ext" -> ("foo/bar", "xyzzy", ".ext")
-splitFilename3 :: String -> (String,String,Suffix)
-splitFilename3 str
-   = let (dir, rest) = splitFilenameDir str
-	 (name, ext) = splitFilename rest
-     in  (dir, name, ext)
-
-joinFileName :: String -> String -> FilePath
-joinFileName ""  fname = fname
-joinFileName "." fname = fname
-joinFileName dir ""    = dir
-joinFileName dir fname = dir ++ '/':fname
-
--- split a string at the last character where 'pred' is True,
--- returning a pair of strings. The first component holds the string
--- up (but not including) the last character for which 'pred' returned
--- True, the second whatever comes after (but also not including the
--- last character).
---
--- If 'pred' returns False for all characters in the string, the original
--- string is returned in the first component (and the second one is just
--- empty).
-splitLongestPrefix :: String -> (Char -> Bool) -> (String,String)
-splitLongestPrefix str pred
-  | null r_pre = (str,           [])
-  | otherwise  = (reverse (tail r_pre), reverse r_suf)
-	-- 'tail' drops the char satisfying 'pred'
-  where 
-    (r_suf, r_pre) = break pred (reverse str)
-
-replaceFilenameSuffix :: FilePath -> Suffix -> FilePath
-replaceFilenameSuffix file suf = basenameOf file `joinFileExt` suf
-
--- directoryOf strips the filename off the input string, returning
--- the directory.
-directoryOf :: FilePath -> String
-directoryOf = fst . splitFilenameDir
-
--- filenameOf strips the directory off the input string, returning
--- the filename.
-filenameOf :: FilePath -> String
-filenameOf = snd . splitFilenameDir
-
-replaceFilenameDirectory :: FilePath -> String -> FilePath
-replaceFilenameDirectory path dir = dir `joinFileName` filenameOf path
-
-escapeSpaces :: String -> String
-escapeSpaces = foldr (\c s -> if isSpace c then '\\':c:s else c:s) ""
-
-isPathSeparator :: Char -> Bool
-isPathSeparator ch =
-#ifdef mingw32_TARGET_OS
-  ch == '/' || ch == '\\'
-#else
-  ch == '/'
-#endif
-
---------------------------------------------------------------
--- * Search path
---------------------------------------------------------------
-
--- | The function splits the given string to substrings
--- using the 'searchPathSeparator'.
-parseSearchPath :: String -> [FilePath]
-parseSearchPath path = split path
-  where
-    split :: String -> [String]
-    split s =
-      case rest' of
-        []     -> [chunk] 
-        _:rest -> chunk : split rest
-      where
-        chunk = 
-          case chunk' of
-#ifdef mingw32_HOST_OS
-            ('\"':xs@(_:_)) | last xs == '\"' -> init xs
-#endif
-            _                                 -> chunk'
-
-        (chunk', rest') = break (==searchPathSeparator) s
-
--- | A platform-specific character used to separate search path strings in 
--- environment variables. The separator is a colon (\":\") on Unix and Macintosh, 
--- and a semicolon (\";\") on the Windows operating system.
-searchPathSeparator :: Char
-#if mingw32_HOST_OS || mingw32_TARGET_OS
-searchPathSeparator = ';'
-#else
-searchPathSeparator = ':'
-#endif
-
------------------------------------------------------------------------------
--- Convert filepath into platform / MSDOS form.
-
--- We maintain path names in Unix form ('/'-separated) right until 
--- the last moment.  On Windows we dos-ify them just before passing them
--- to the Windows command.
--- 
--- The alternative, of using '/' consistently on Unix and '\' on Windows,
--- proved quite awkward.  There were a lot more calls to platformPath,
--- and even on Windows we might invoke a unix-like utility (eg 'sh'), which
--- interpreted a command line 'foo\baz' as 'foobaz'.
-
-normalisePath :: String -> String
--- Just changes '\' to '/'
-
-pgmPath :: String		-- Directory string in Unix format
-	-> String		-- Program name with no directory separators
-				--	(e.g. copy /y)
-	-> String		-- Program invocation string in native format
-
-#if defined(mingw32_HOST_OS)
---------------------- Windows version ------------------
-normalisePath xs = subst '\\' '/' xs
-pgmPath dir pgm  = platformPath dir ++ '\\' : pgm
-platformPath p   = subst '/' '\\' p
-
-subst a b ls = map (\ x -> if x == a then b else x) ls
-#else
---------------------- Non-Windows version --------------
-normalisePath xs   = xs
-pgmPath dir pgm    = dir ++ '/' : pgm
-platformPath stuff = stuff
---------------------------------------------------------
-#endif
-\end{code}
diff --git a/ghc/docs/building/Makefile b/ghc/docs/building/Makefile
deleted file mode 100644
index fb9cce6ff5..0000000000
--- a/ghc/docs/building/Makefile
+++ /dev/null
@@ -1,7 +0,0 @@
-TOP = ../..
-include $(TOP)/mk/boilerplate.mk
-
-XML_DOC = building
-INSTALL_XML_DOC = building
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/docs/building/building.xml b/ghc/docs/building/building.xml
deleted file mode 100644
index e1967e9fec..0000000000
--- a/ghc/docs/building/building.xml
+++ /dev/null
@@ -1,4279 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
-   "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
-  <!ENTITY hacking SYSTEM "../../HACKING">
-]>
-
-<article id="building-guide">
-
-<articleinfo>
-
-<title>Building and developing GHC</title>
-<author><othername>The GHC Team</othername></author>
-<address><email>glasgow-haskell-&lcub;users,bugs&rcub;@haskell.org</email></address>
-
-    <abstract>
-      <para>This Guide is primarily aimed at those who want to build and/or
-	hack on GHC.  It describes how to get started with building GHC on your
-	machine, and how to tweak the settings to get the kind of build you
-	want.  It also describes the inner workings of the build system, so you
-	can extend it, modify it, and use it to build your code.</para>
-
-      <para>The bulk of this guide applies to building on Unix
-      systems; see <xref linkend="winbuild"/> for Windows notes.</para>
-    </abstract>
-
-</articleinfo>
-
-
-  <sect1 id="sec-getting">
-    <title>Getting the sources</title>
-    
-    <para>You can get your hands on the GHC sources in two ways:</para>
-
-    <variablelist>
-
-      <varlistentry>
-	<term><indexterm><primary>Source
-	distributions</primary></indexterm>Source distributions</term>
-	<listitem>
-	  <para>You have a supported platform, but (a)&nbsp;you like
-          the warm fuzzy feeling of compiling things yourself;
-          (b)&nbsp;you want to build something ``extra&rdquo;&mdash;e.g., a
-          set of libraries with strictness-analysis turned off; or
-          (c)&nbsp;you want to hack on GHC yourself.</para>
-
-	  <para>A source distribution contains complete sources for
-          GHC.  Not only that, but the more awkward
-          machine-independent steps are done for you.  For example, if
-          you don't have
-          <command>happy</command><indexterm><primary>happy</primary></indexterm>
-          you'll find it convenient that the source distribution
-          contains the result of running <command>happy</command> on
-          the parser specifications.  If you don't want to alter the
-          parser then this saves you having to find and install
-          <command>happy</command>. You will still need a working
-          version of GHC (version 5.x or later) on your machine in
-          order to compile (most of) the sources, however.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>The darcs repository.<indexterm><primary>darcs repository</primary></indexterm></term>
-	<listitem>
-	  <para>We make releases infrequently.  If you want more
-          up-to-the minute (but less tested) source code then you need
-          to get access to our darcs repository.</para>
-
-	  <para>Information on accessing the darcs repository is on
-	    the wiki: <ulink
-	    url="http://hackage.haskell.org/trac/ghc/wiki/GhcDarcs"
-	    />.</para>
-
-	  <para>The repository holds source code only. It holds no
-          mechanically generated files at all.  So if you check out a
-          source tree from darcs you will need to install every utility
-          so that you can build all the derived files from
-          scratch.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-  </sect1>
-
-  <sect1 id="sec-build-checks">
-    <title>Things to check before you start</title>
-
-    <para>Here's a list of things to check before you get
-    started.</para>
-
-    <orderedlist>
-
-      <listitem><para><indexterm><primary>Disk space needed</primary></indexterm>Disk
-        space needed: from about 100Mb for a basic GHC
-	build, up to probably 500Mb for a GHC build with everything
-	included (libraries built several different ways,
-	etc.).</para>
-      </listitem>
-
-      <listitem>
-	<para>Use an appropriate machine / operating system.  <xref
-	linkend="sec-port-info"/> lists the supported platforms; if
-	yours isn't amongst these then you can try porting GHC (see
-	<xref linkend="sec-porting-ghc"/>).</para>
-      </listitem>
-
-      <listitem>
-	<para>Be sure that the &ldquo;pre-supposed&rdquo; utilities are
-        installed.  <xref linkend="sec-pre-supposed"/>
-        elaborates.</para>
-      </listitem>
-
-      <listitem>
-	<para>If you have any problem when building or installing the
-        Glasgow tools, please check the &ldquo;known pitfalls&rdquo; (<xref
-        linkend="sec-build-pitfalls"/>).  Also check the FAQ for the
-        version you're building, which is part of the User's Guide and
-        available on the <ulink url="http://www.haskell.org/ghc/" >GHC web
-        site</ulink>.</para>
-
-	<indexterm><primary>bugs</primary><secondary>known</secondary></indexterm>
-
-	<para>If you feel there is still some shortcoming in our
-        procedure or instructions, please report it.</para>
-
-	<para>For GHC, please see the <ulink
-	url="http://www.haskell.org/ghc/docs/latest/set/bug-reporting.html">bug-reporting
-	section of the GHC Users' Guide</ulink>, to maximise the
-	usefulness of your report.</para>
-
-	<indexterm><primary>bugs</primary><secondary>seporting</secondary></indexterm>
-	<para>If in doubt, please send a message to
-	<email>glasgow-haskell-bugs@haskell.org</email>.
-	<indexterm><primary>bugs</primary><secondary>mailing
-	list</secondary></indexterm></para>
-      </listitem>
-    </orderedlist>
-  </sect1>
-
-  <sect1 id="sec-port-info">
-    <title>What machines GHC runs on</title>
-
-<indexterm><primary>ports</primary><secondary>GHC</secondary></indexterm>
-<indexterm><primary>GHC</primary><secondary>ports</secondary></indexterm>
-<indexterm><primary>platforms</primary><secondary>supported</secondary></indexterm>
-
-    <para>A &ldquo;platform&rdquo; is a
-    architecture/manufacturer/operating-system combination, such as
-    <literal>sparc-sun-solaris2</literal>.  Other common ones are
-    <literal>alpha-dec-osf2</literal>,
-    <literal>hppa1.1-hp-hpux9</literal>,
-    <literal>i386-unknown-linux</literal>,
-    <literal>i386-unknown-solaris2</literal>,
-    <literal>i386-unknown-freebsd</literal>,
-    <literal>i386-unknown-cygwin32</literal>,
-    <literal>m68k-sun-sunos4</literal>,
-    <literal>mips-sgi-irix5</literal>,
-    <literal>sparc-sun-sunos4</literal>,
-    <literal>sparc-sun-solaris2</literal>,
-    <literal>powerpc-ibm-aix</literal>.</para>
-
-    <para>Some libraries may only work on a limited number of
-    platforms; for example, a sockets library is of no use unless the
-    operating system supports the underlying BSDisms.</para>
-
-    <indexterm><primary>fully-supported platforms</primary></indexterm>
-    <indexterm><primary>native-code generator</primary></indexterm>
-    <indexterm><primary>registerised ports</primary></indexterm>
-    <indexterm><primary>unregisterised ports</primary></indexterm>
-
-      <para>The GHC hierarchy of Porting Goodness: (a)&nbsp;Best is a
-      native-code generator; (b)&nbsp;next best is a
-      &ldquo;registerised&rdquo; port; (c)&nbsp;the bare minimum is an
-      &ldquo;unregisterised&rdquo; port.
-      (&ldquo;Unregisterised&rdquo; is so terrible that we won't say
-      more about it).</para>
-
-      <para>Here's everything that's known about GHC ports.  We
-      identify platforms by their &ldquo;canonical&rdquo;
-      CPU/Manufacturer/OS triple.</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term>alpha-dec-{osf,linux,freebsd,openbsd,netbsd}:
-	  <indexterm><primary>alpha-dec-osf</primary></indexterm>
-	  <indexterm><primary>alpha-dec-linux</primary></indexterm>
-	  <indexterm><primary>alpha-dec-freebsd</primary></indexterm>
-	  <indexterm><primary>alpha-dec-openbsd</primary></indexterm>
-	  <indexterm><primary>alpha-dec-netbsd</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>The OSF port is currently working (as of GHC version
-	    5.02.1) and well supported.  The native code generator is
-	    currently non-working.  Other operating systems will
-	    require some minor porting.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>sparc-sun-sunos4
-	    <indexterm><primary>sparc-sun-sunos4</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Probably works with minor tweaks, hasn't been tested
-	    for a while.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>sparc-sun-solaris2
-            <indexterm><primary>sparc-sun-solaris2</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Fully supported (at least for Solaris 2.7 and 2.6),
-	    including native-code generator.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>sparc-unknown-openbsd
-            <indexterm><primary>sparc-unknown-openbsd</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Supported, including native-code generator. The
-	    same should also be true of NetBSD</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>hppa1.1-hp-hpux (HP-PA boxes running HPUX 9.x)
-            <indexterm><primary>hppa1.1-hp-hpux</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>A registerised port is available for version 4.08,
-	    but GHC hasn't been built on that platform since (as far
-	    as we know).  No native-code generator.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>i386-unknown-linux (PCs running Linux, ELF binary format)
-            <indexterm><primary>i386-*-linux</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>GHC works registerised and has a native code
-            generator.  You <emphasis>must</emphasis> have GCC 2.7.x
-            or later.  NOTE about <literal>glibc</literal> versions:
-            GHC binaries built on a system running <literal>glibc
-            2.0</literal> won't work on a system running
-            <literal>glibc 2.1</literal>, and vice versa.  In general,
-            don't expect compatibility between
-            <literal>glibc</literal> versions, even if the shared
-            library version hasn't changed.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>i386-unknown-freebsd (PCs running FreeBSD 2.2 or higher)
-            <indexterm><primary>i386-unknown-freebsd</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>GHC works registerised.  Pre-built packages are
-            available in the native package format, so if you just
-            need binaries you're better off just installing the
-            package (it might even be on your installation
-            CD!).</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>i386-unknown-openbsd (PCs running OpenBSD)
-            <indexterm><primary>i386-unknown-openbsd</primary></indexterm> 
-          </term>
-	  <listitem>
-	    <para>Supported, with native code generator.  Packages are
-	    available through the ports system in the native package
-	    format.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>i386-unknown-netbsd (PCs running NetBSD)
-            <indexterm><primary>i386-unknown-netbsd</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Will require some minor porting effort, but should
-	    work registerised.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>i386-unknown-mingw32 (PCs running Windows)
-            <indexterm><primary>i386-unknown-mingw32</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Fully supported under Win9x, WinNT, Win2k, and
-            WinXP.  Includes a native code generator.  Building from
-            source requires a recent <ulink
-            url="http://www.cygwin.com/">Cygwin</ulink> distribution
-            to be installed.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>ia64-unknown-linux
-            <indexterm><primary>ia64-unknown-linux</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Supported, except there is no native code
-	    generator.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>x86_64-unknown-linux
-            <indexterm><primary>x86_64-unknown-linux</primary></indexterm>
-          </term>
-<term>amd64-unknown-openbsd
-            <indexterm><primary>amd64-unknown-linux</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Fully supported, with a native code generator and GHCi.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>mips-sgi-irix5
-            <indexterm><primary>mips-sgi-irix[5-6]</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Port has worked in the past, but hasn't been tested
-            for some time (and will certainly have rotted in various
-            ways).  As usual, we don't have access to machines and
-            there hasn't been an overwhelming demand for this port,
-            but feel free to get in touch.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>mips64-sgi-irix6
-            <indexterm><primary>mips-sgi-irix6</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>GHC currently works unregisterised.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>powerpc-ibm-aix
-            <indexterm><primary>powerpc-ibm-aix</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Port currently doesn't work, needs some minimal
-            porting effort.  As usual, we don't have access to
-            machines and there hasn't been an overwhelming demand for
-            this port, but feel free to get in touch.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>powerpc-apple-darwin
-            <indexterm><primary>powerpc-apple-darwin</primary></indexterm> 
-          </term>
-	  <listitem>
-	    <para>Supported registerised.  Native code generator is
-	    almost working.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>powerpc-apple-linux
-            <indexterm><primary>powerpc-apple-linux</primary></indexterm> 
-          </term>
-	  <listitem>
-	    <para>Not supported (yet).</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>Various other systems have had GHC ported to them in the
-      distant past, including various Motorola 68k boxes.  The 68k
-      support still remains, but porting to one of these systems will
-      certainly be a non-trivial task.</para>
-  </sect1>
-
-  <sect1 id="sec-pre-supposed">
-    <title>Installing pre-supposed utilities</title>
-
-    <indexterm><primary>pre-supposed utilities</primary></indexterm>
-    <indexterm><primary>utilities, pre-supposed</primary></indexterm>
-
-    <para>Here are the gory details about some utility programs you
-    may need; <command>perl</command>, <command>gcc</command> and
-    <command>happy</command> are the only important
-    ones. (PVM<indexterm><primary>PVM</primary></indexterm> is
-    important if you're going for Parallel Haskell.)  The
-    <command>configure</command><indexterm><primary>configure</primary></indexterm>
-    script will tell you if you are missing something.</para>
-
-    <variablelist>
-
-      <varlistentry>
-	<term>GHC
-          <indexterm><primary>pre-supposed: GHC</primary></indexterm>
-          <indexterm><primary>GHC, pre-supposed</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>GHC is required to build many of the tools, including
-	  GHC itself.  If you need to port GHC to your platform
-	  because there isn't a binary distribution of GHC available,
-	  then see <xref linkend="sec-porting-ghc"/>.</para>
-
-	  <para>Which version of GHC you need will depend on the
-	  packages you intend to build.  GHC itself will normally
-	  build using one of several older versions of itself - check
-	  the announcement or release notes for details.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Perl
-          <indexterm><primary>pre-supposed: Perl</primary></indexterm>
-          <indexterm><primary>Perl, pre-supposed</primary></indexterm>
-        </term>
-	<listitem>
-	  <para><emphasis>You have to have Perl to proceed!</emphasis>
-          Perl version 5 at least is required.  GHC has been known to
-          tickle bugs in Perl, so if you find that Perl crashes when
-          running GHC try updating (or downgrading) your Perl
-          installation.  Versions of Perl before 5.6 have been known to have
-          various bugs tickled by GHC, so the configure script
-          will look for version 5.6 or later.</para>
-
-	  <para>For Win32 platforms, you should use the binary
-          supplied in the InstallShield (copy it to
-          <filename>/bin</filename>).  The Cygwin-supplied Perl seems
-          not to work.</para>
-
-	  <para>Perl should be put somewhere so that it can be invoked
-          by the <literal>&num;!</literal> script-invoking
-          mechanism. The full pathname may need to be less than 32
-          characters long on some systems.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>GNU C (<command>gcc</command>)
-          <indexterm><primary>pre-supposed: GCC (GNU C compiler)</primary></indexterm>
-          <indexterm><primary>GCC (GNU C compiler), pre-supposed</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Most GCC versions should work with the most recent GHC
-	    sources.  Expect trouble if you use a recent GCC with
-	    an older GHC, though (trouble in the form of mis-compiled code,
-	    link errors, and errors from the <literal>ghc-asm</literal>
-	    script).</para>
-
-	  <para>If your GCC dies with &ldquo;internal error&rdquo; on
-          some GHC source file, please let us know, so we can report
-          it and get things improved.  (Exception: on x86
-          boxes&mdash;you may need to fiddle with GHC's
-          <option>-monly-N-regs</option> option; see the User's
-          Guide)</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>GNU Make
-          <indexterm><primary>make</primary><secondary>GNU</secondary></indexterm>
-        </term>
-	<listitem>
-	  <para>The fptools build system makes heavy use of features
-	  specific to GNU <command>make</command>, so you must have
-	  this installed in order to build any of the fptools
-	  suite.</para>
-
-	  <para>NB. it has been reported that version 3.79 no longer
-	  works to build GHC, and 3.80 is required.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><ulink url="http://www.haskell.org/happy">Happy</ulink>
-          <indexterm><primary>Happy</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Happy is a parser generator tool for Haskell, and is
-          used to generate GHC's parsers.</para>
-
-	  <para>If you start from a source tarball of GHC (i.e. not a darcs
-	    checkout), then you don't need Happy, because we supply the
-	    pre-processed versions of the Happy parsers.  If you intend to
-	    modify the compiler and/or you're using a darcs checkout, then you
-	    need Happy.</para>
-
-	  <para>Happy version 1.15 is currently required to build GHC.</para>
-
-	  <para>Happy is written in
-          Haskell, and is a project in the CVS repository
-          (<literal>fptools/happy</literal>).  It can be built from
-          source, but bear in mind that you'll need GHC installed in
-          order to build it.  To avoid the chicken/egg problem,
-          install a binary distribution of either Happy or GHC to get
-          started.  Happy distributions are available from <ulink url="http://www.haskell.org/happy/">Happy's Web
-          Page</ulink>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Alex
-          <indexterm><primary>Alex</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Alex is a lexical-analyser generator for Haskell,
-	  which GHC uses to generate its lexer.</para>
-
-	  <para>Like Happy, you don't need Alex if you're building GHC from a
-	    source tarball, but you do need it if you're modifying GHC and/or
-	    building a darcs checkout.</para>
-
-	  <para>Alex is
-	  written in Haskell and is a project in the darcs repository.
-	  Alex distributions are available from <ulink url="http://www.haskell.org/alex/">Alex's Web
-	  Page</ulink>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>autoconf
-          <indexterm><primary>pre-supposed: autoconf</primary></indexterm>
-          <indexterm><primary>autoconf, pre-supposed</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>GNU autoconf is needed if you intend to build from the
-          darcs sources, it is <emphasis>not</emphasis> needed if you
-          just intend to build a standard source distribution.</para>
-
-	  <para>Version 2.52 or later of the autoconf package is required.
-	  NB. version 2.13 will no longer work, as of GHC version
-	  6.1.</para>
-
-	  <para><command>autoreconf</command> (from the autoconf package)
-          recursively builds <command>configure</command> scripts from
-          the corresponding <filename>configure.ac</filename> and
-          <filename>aclocal.m4</filename> files.  If you modify one of
-          the latter files, you'll need <command>autoreconf</command> to
-          rebuild the corresponding <filename>configure</filename>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><command>sed</command>
-          <indexterm><primary>pre-supposed: sed</primary></indexterm>
-          <indexterm><primary>sed, pre-supposed</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>You need a working <command>sed</command> if you are
-          going to build from sources.  The build-configuration stuff
-          needs it.  GNU sed version 2.0.4 is no good!  It has a bug
-          in it that is tickled by the build-configuration.  2.0.5 is
-          OK. Others are probably OK too (assuming we don't create too
-          elaborate configure scripts.)</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-    <para>One <literal>fptools</literal> project is worth a quick note
-    at this point, because it is useful for all the others:
-    <literal>glafp-utils</literal> contains several utilities which
-    aren't particularly Glasgow-ish, but Occasionally Indispensable.
-    Like <command>lndir</command> for creating symbolic link
-    trees.</para>
-
-    <sect2 id="pre-supposed-gph-tools">
-      <title>Tools for building parallel GHC (GPH)</title>
-
-      <variablelist>
-	<varlistentry>
-	  <term>PVM version 3:
-	  <indexterm><primary>pre-supposed: PVM3 (Parallel Virtual Machine)</primary></indexterm>
-            <indexterm><primary>PVM3 (Parallel Virtual Machine), pre-supposed</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>PVM is the Parallel Virtual Machine on which
-            Parallel Haskell programs run.  (You only need this if you
-            plan to run Parallel Haskell.  Concurrent Haskell, which
-            runs concurrent threads on a uniprocessor doesn't need
-            it.)  Underneath PVM, you can have (for example) a network
-            of workstations (slow) or a multiprocessor box
-            (faster).</para>
-
-	    <para>The current version of PVM is 3.3.11; we use 3.3.7.
-            It is readily available on the net; I think I got it from
-            <literal>research.att.com</literal>, in
-            <filename>netlib</filename>.</para>
-
-	    <para>A PVM installation is slightly quirky, but easy to
-            do.  Just follow the <filename>Readme</filename>
-            instructions.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><command>bash</command>:
-            <indexterm><primary>bash, presupposed (Parallel Haskell only)</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Sadly, the <command>gr2ps</command> script, used to
-            convert &ldquo;parallelism profiles&rdquo; to PostScript,
-            is written in Bash (GNU's Bourne Again shell).  This bug
-            will be fixed (someday).</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-    </sect2>
-
-    <sect2 id="pre-supposed-other-tools">
-      <title>Other useful tools</title>
-
-      <variablelist>
-	<varlistentry>
-	  <term>Flex
-            <indexterm><primary>pre-supposed: flex</primary></indexterm> 
-            <indexterm><primary>flex, pre-supposed</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>This is a quite-a-bit-better-than-Lex lexer.  Used
-            to build a couple of utilities in
-            <literal>glafp-utils</literal>.  Depending on your
-            operating system, the supplied <command>lex</command> may
-            or may not work; you should get the GNU version.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>More tools are required if you want to format the documentation
-      that comes with GHC and other fptools projects.  See <xref
-      linkend="building-docs"/>.</para>
-    </sect2>
-  </sect1>
-
-  <sect1 id="sec-building-from-source">
-    <title>Building from source</title>
-
-    <indexterm><primary>Building from source</primary></indexterm>
-    <indexterm><primary>Source, building from</primary></indexterm>
-
-    <para>&ldquo;I just want to build it!&rdquo;</para>
-
-    <para>No problem.  This recipe should build and install a working GHC with
-      all the default settings.  (unless you're
-      on Windows, in which case go to <xref linkend="winbuild" />).</para>
-
-<screen>$ autoreconf<footnote><para>not necessary if you started from a source tarball</para>
-      </footnote>
-$ ./configure
-$ make
-$ make install</screen>
-
-      <para>For GHC, this will do a 2-stage bootstrap build of the
-      compiler, with profiling libraries, and install the
-      results in the default location (under <filename>/usr/local</filename> on
-      Unix, for example).</para>
-
-    <para>The <literal>configure</literal> script is a standard GNU
-      <literal>autoconf</literal> script, and accepts the usual options for
-      changing install locations and the like.  Run
-      <literal>./configure&nbsp;--help</literal> for a list of options.</para>
-
-      <para>If you want to do anything at all non-standard, or you
-      want to do some development, read on...</para>
-    </sect1>
-    
-    <sect1 id="quick-start">
-      <title>Quick start for GHC developers</title>
-      
-      <para>This section is a copy of the file
-	<literal>ghc/HACKING</literal> from the GHC source tree.  It describes
-	how to get started with setting up your build tree for developing GHC
-	or its libraries, and how to start building.</para>
-
-<screen>     
-&hacking;
-      </screen>
-    </sect1>
-
-  <sect1 id="sec-working-with-the-build-system">
-    <title>Working with the build system</title>
-    
-    <para>This rest of this guide is intended for duffers like me, who
-    aren't really interested in Makefiles and systems configurations,
-    but who need a mental model of the interlocking pieces so that
-    they can make them work, extend them consistently when adding new
-    software, and lay hands on them gently when they don't
-    work.</para>
-
-    <sect2 id="sec-source-tree">
-      <title>Your source tree</title>
-
-      <para>The source code is held in your <emphasis>source
-      tree</emphasis>.  The root directory of your source tree
-      <emphasis>must</emphasis> contain the following directories and
-      files:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para><filename>Makefile</filename>: the root
-	  Makefile.</para>
-	</listitem>
-
-	<listitem>
-	  <para><filename>mk/</filename>: the directory that contains
-          the main Makefile code, shared by all the
-          <literal>fptools</literal> software.</para>
-	</listitem>
-
-	<listitem>
-	  <para><filename>configure.ac</filename>,
-          <filename>config.sub</filename>,
-          <filename>config.guess</filename>: these files support the
-          configuration process.</para>
-	</listitem>
-
-	<listitem>
-	  <para><filename>install-sh</filename>.</para>
-	</listitem>
-      </itemizedlist>
-
-      <para>All the other directories are individual
-      <emphasis>projects</emphasis> of the <literal>fptools</literal>
-      system&mdash;for example, the Glasgow Haskell Compiler
-      (<literal>ghc</literal>), the Happy parser generator
-      (<literal>happy</literal>), the <literal>nofib</literal>
-      benchmark suite, and so on.  You can have zero or more of these.
-      Needless to say, some of them are needed to build others.</para>
-
-      <para>The important thing to remember is that even if you want
-      only one project (<literal>happy</literal>, say), you must have
-      a source tree whose root directory contains
-      <filename>Makefile</filename>, <filename>mk/</filename>,
-      <filename>configure.ac</filename>, and the project(s) you want
-      (<filename>happy/</filename> in this case).  You cannot get by
-      with just the <filename>happy/</filename> directory.</para>
-    </sect2>
-
-    <sect2>
-      <title>Build trees</title>
-      <indexterm><primary>build trees</primary></indexterm>
-      <indexterm><primary>link trees, for building</primary></indexterm>
-
-      <para>If you just want to build the software once on a single
-      platform, then your source tree can also be your build tree, and
-      you can skip the rest of this section.</para>
-
-      <para>We often want to build multiple versions of our software
-      for different architectures, or with different options
-      (e.g. profiling).  It's very desirable to share a single copy of
-      the source code among all these builds.</para>
-
-      <para>So for every source tree we have zero or more
-      <emphasis>build trees</emphasis>.  Each build tree is initially
-      an exact copy of the source tree, except that each file is a
-      symbolic link to the source file, rather than being a copy of
-      the source file.  There are &ldquo;standard&rdquo; Unix
-      utilities that make such copies, so standard that they go by
-      different names:
-      <command>lndir</command><indexterm><primary>lndir</primary></indexterm>,
-      <command>mkshadowdir</command><indexterm><primary>mkshadowdir</primary></indexterm>
-      are two (If you don't have either, the source distribution
-      includes sources for the X11
-      <command>lndir</command>&mdash;check out
-      <filename>fptools/glafp-utils/lndir</filename>). See <xref
-      linkend="sec-storysofar"/> for a typical invocation.</para>
-
-      <para>The build tree does not need to be anywhere near the
-      source tree in the file system.  Indeed, one advantage of
-      separating the build tree from the source is that the build tree
-      can be placed in a non-backed-up partition, saving your systems
-      support people from backing up untold megabytes of
-      easily-regenerated, and rapidly-changing, gubbins.  The golden
-      rule is that (with a single exception&mdash;<xref
-      linkend="sec-build-config"/>) <emphasis>absolutely everything in
-      the build tree is either a symbolic link to the source tree, or
-      else is mechanically generated</emphasis>.  It should be
-      perfectly OK for your build tree to vanish overnight; an hour or
-      two compiling and you're on the road again.</para>
-
-      <para>You need to be a bit careful, though, that any new files
-      you create (if you do any development work) are in the source
-      tree, not a build tree!</para>
-
-      <para>Remember, that the source files in the build tree are
-      <emphasis>symbolic links</emphasis> to the files in the source
-      tree.  (The build tree soon accumulates lots of built files like
-      <filename>Foo.o</filename>, as well.)  You can
-      <emphasis>delete</emphasis> a source file from the build tree
-      without affecting the source tree (though it's an odd thing to
-      do).  On the other hand, if you <emphasis>edit</emphasis> a
-      source file from the build tree, you'll edit the source-tree
-      file directly.  (You can set up Emacs so that if you edit a
-      source file from the build tree, Emacs will silently create an
-      edited copy of the source file in the build tree, leaving the
-      source file unchanged; but the danger is that you think you've
-      edited the source file whereas actually all you've done is edit
-      the build-tree copy.  More commonly you do want to edit the
-      source file.)</para>
-
-      <para>Like the source tree, the top level of your build tree
-      must be (a linked copy of) the root directory of the
-      <literal>fptools</literal> suite.  Inside Makefiles, the root of
-      your build tree is called
-      <constant>&dollar;(FPTOOLS&lowbar;TOP)</constant><indexterm><primary>FPTOOLS&lowbar;TOP</primary></indexterm>.
-      In the rest of this document path names are relative to
-      <constant>&dollar;(FPTOOLS&lowbar;TOP)</constant> unless
-      otherwise stated.  For example, the file
-      <filename>ghc/mk/target.mk</filename> is actually
-      <filename>&dollar;(FPTOOLS&lowbar;TOP)/ghc/mk/target.mk</filename>.</para>
-    </sect2>
-
-    <sect2 id="sec-build-config">
-      <title>Getting the build you want</title>
-
-      <para>When you build <literal>fptools</literal> you will be
-      compiling code on a particular <emphasis>host
-      platform</emphasis>, to run on a particular <emphasis>target
-      platform</emphasis> (usually the same as the host
-      platform)<indexterm><primary>platform</primary></indexterm>.
-      The difficulty is that there are minor differences between
-      different platforms; minor, but enough that the code needs to be
-      a bit different for each.  There are some big differences too:
-      for a different architecture we need to build GHC with a
-      different native-code generator.</para>
-
-      <para>There are also knobs you can turn to control how the
-      <literal>fptools</literal> software is built.  For example, you
-      might want to build GHC optimised (so that it runs fast) or
-      unoptimised (so that you can compile it fast after you've
-      modified it.  Or, you might want to compile it with debugging on
-      (so that extra consistency-checking code gets included) or off.
-      And so on.</para>
-
-      <para>All of this stuff is called the
-      <emphasis>configuration</emphasis> of your build.  You set the
-      configuration using a three-step process.</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term>Step 1: get ready for configuration.</term>
-	  <listitem>
-	    <para>NOTE: if you're starting from a source distribution,
-	    rather than darcs sources, you can skip this step.</para>
-
-	    <para>Change directory to
-            <constant>&dollar;(FPTOOLS&lowbar;TOP)</constant> and
-            issue the command</para>
-<screen>$ autoreconf</screen>
-            <indexterm><primary>autoreconf</primary></indexterm>
-            <para>(with no arguments). This GNU program (recursively) converts
-            <filename>&dollar;(FPTOOLS&lowbar;TOP)/configure.ac</filename> and
-            <filename>&dollar;(FPTOOLS&lowbar;TOP)/aclocal.m4</filename>
-            to a shell script called
-            <filename>&dollar;(FPTOOLS&lowbar;TOP)/configure</filename>.
-	      If <command>autoreconf</command> bleats that it can't write the file <filename>configure</filename>,
-	      then delete the latter and try again.  Note that you must use <command>autoreconf</command>,
-	      and not the old <command>autoconf</command>!  If you erroneously use the latter, you'll get 
-	      a message like "No rule to make target 'mk/config.h.in'".
-            </para>
-
-	    <para>Some projects, including GHC, have their own configure script.
-            <command>autoreconf</command> takes care of that, too, so all you have
-             to do is calling <command>autoreconf</command> in the top-level directory
-            <filename>&dollar;(FPTOOLS&lowbar;TOP)</filename>.</para>
-
-	    <para>These steps are completely platform-independent; they just mean
-            that the human-written files (<filename>configure.ac</filename> and
-            <filename>aclocal.m4</filename>) can be short, although the resulting
-            files (the <command>configure</command> shell scripts and the C header
-            template <filename>mk/config.h.in</filename>) are long.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>Step 2: system configuration.</term>
-	  <listitem>
-	    <para>Runs the newly-created <command>configure</command>
-	    script, thus:</para>
-
-<screen>$ ./configure <optional><parameter>args</parameter></optional></screen>
-
-	    <para><command>configure</command>'s mission is to scurry
-            round your computer working out what architecture it has,
-            what operating system, whether it has the
-            <function>vfork</function> system call, where
-            <command>tar</command> is kept, whether
-            <command>gcc</command> is available, where various obscure
-            <literal>&num;include</literal> files are, whether it's a
-            leap year, and what the systems manager had for lunch.  It
-            communicates these snippets of information in two
-            ways:</para>
-
-	    <itemizedlist>
-	      <listitem>
-		
-		<para>It translates
-                <filename>mk/config.mk.in</filename><indexterm><primary>config.mk.in</primary></indexterm>
-                to
-                <filename>mk/config.mk</filename><indexterm><primary>config.mk</primary></indexterm>,
-                substituting for things between
-                &ldquo;<literal>@</literal>&rdquo; brackets.  So,
-                &ldquo;<literal>@HaveGcc@</literal>&rdquo; will be
-                replaced by &ldquo;<literal>YES</literal>&rdquo; or
-                &ldquo;<literal>NO</literal>&rdquo; depending on what
-                <command>configure</command> finds.
-                <filename>mk/config.mk</filename> is included by every
-                Makefile (directly or indirectly), so the
-                configuration information is thereby communicated to
-                all Makefiles.</para>
-		</listitem>
-
-	      <listitem>
-		<para> It translates
-                <filename>mk/config.h.in</filename><indexterm><primary>config.h.in</primary></indexterm>
-                to
-                <filename>mk/config.h</filename><indexterm><primary>config.h</primary></indexterm>.
-                The latter is <literal>&num;include</literal>d by
-                various C programs, which can thereby make use of
-                configuration information.</para>
-	      </listitem>
-	    </itemizedlist>
-
-	    <para><command>configure</command> takes some optional
-	    arguments.  Use <literal>./configure --help</literal> to
-	    get a list of the available arguments.  Here are some of
-	    the ones you might need:</para>
-
-	    <variablelist>
-	      <varlistentry>
-		<term><literal>--with-ghc=<parameter>path</parameter></literal>
-                  <indexterm><primary><literal>--with-ghc</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>Specifies the path to an installed GHC which
-		  you would like to use.  This compiler will be used
-		  for compiling GHC-specific code (eg. GHC itself).
-		  This option <emphasis>cannot</emphasis> be specified
-		  using <filename>build.mk</filename> (see later),
-		  because <command>configure</command> needs to
-		  auto-detect the version of GHC you're using.  The
-		  default is to look for a compiler named
-		  <literal>ghc</literal> in your path.</para>
-		</listitem>
-	      </varlistentry>
-	      
-	      <varlistentry>
-		<term><literal>--with-hc=<parameter>path</parameter></literal>
-                  <indexterm><primary><literal>--with-hc</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>Specifies the path to any installed Haskell
-		  compiler.  This compiler will be used for compiling
-		  generic Haskell code.  The default is to use
-		  <literal>ghc</literal>.</para>
-		</listitem>
-	      </varlistentry>
-	      
-	      <varlistentry>
-		<term><literal>--with-gcc=<parameter>path</parameter></literal>
-                  <indexterm><primary><literal>--with-gcc</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>Specifies the path to the installed GCC. This
-		  compiler will be used to compile all C files,
-		  <emphasis>except</emphasis> any generated by the
-		  installed Haskell compiler, which will have its own
-		  idea of which C compiler (if any) to use.  The
-		  default is to use <literal>gcc</literal>.</para>
-		</listitem>
-	      </varlistentry>
-	    </variablelist>
-	  </listitem>
-	</varlistentry>
-	
-	<varlistentry>
-	  <term>Step 3: build configuration.</term>
-	  <listitem>
-	    <para>Next, you say how this build of
-            <literal>fptools</literal> is to differ from the standard
-            defaults by creating a new file
-            <filename>mk/build.mk</filename><indexterm><primary>build.mk</primary></indexterm>
-            <emphasis>in the build tree</emphasis>.  This file is the
-            one and only file you edit in the build tree, precisely
-            because it says how this build differs from the source.
-            (Just in case your build tree does die, you might want to
-            keep a private directory of <filename>build.mk</filename>
-            files, and use a symbolic link in each build tree to point
-            to the appropriate one.)  So
-            <filename>mk/build.mk</filename> never exists in the
-            source tree&mdash;you create one in each build tree from
-            the template.  We'll discuss what to put in it
-            shortly.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>And that's it for configuration. Simple, eh?</para>
-
-      <para>What do you put in your build-specific configuration file
-      <filename>mk/build.mk</filename>?  <emphasis>For almost all
-      purposes all you will do is put make variable definitions that
-      override those in</emphasis>
-      <filename>mk/config.mk.in</filename>.  The whole point of
-      <filename>mk/config.mk.in</filename>&mdash;and its derived
-      counterpart <filename>mk/config.mk</filename>&mdash;is to define
-      the build configuration. It is heavily commented, as you will
-      see if you look at it.  So generally, what you do is look at
-      <filename>mk/config.mk.in</filename>, and add definitions in
-      <filename>mk/build.mk</filename> that override any of the
-      <filename>config.mk</filename> definitions that you want to
-      change.  (The override occurs because the main boilerplate file,
-      <filename>mk/boilerplate.mk</filename><indexterm><primary>boilerplate.mk</primary></indexterm>,
-      includes <filename>build.mk</filename> after
-      <filename>config.mk</filename>.)</para>
-
-     <para>For your convenience, there's a file called <filename>build.mk.sample</filename>
-     that can serve as a starting point for your <filename>build.mk</filename>.</para>
-
-      <para>For example, <filename>config.mk.in</filename> contains
-      the definition:</para>
-
-<programlisting>GhcHcOpts=-O -Rghc-timing</programlisting>
-
-      <para>The accompanying comment explains that this is the list of
-      flags passed to GHC when building GHC itself.  For doing
-      development, it is wise to add <literal>-DDEBUG</literal>, to
-      enable debugging code.  So you would add the following to
-      <filename>build.mk</filename>:</para>
-      
-      <para>or, if you prefer,</para>
-
-<programlisting>GhcHcOpts += -DDEBUG</programlisting>
-
-      <para>GNU <command>make</command> allows existing definitions to
-      have new text appended using the &ldquo;<literal>+=</literal>&rdquo;
-      operator, which is quite a convenient feature.)</para>
-
-      <para>If you want to remove the <literal>-O</literal> as well (a
-      good idea when developing, because the turn-around cycle gets a
-      lot quicker), you can just override
-      <literal>GhcLibHcOpts</literal> altogether:</para>
-
-<programlisting>GhcHcOpts=-DDEBUG -Rghc-timing</programlisting>
-
-      <para>When reading <filename>config.mk.in</filename>, remember
-      that anything between &ldquo;@...@&rdquo; signs is going to be substituted
-      by <command>configure</command> later.  You
-      <emphasis>can</emphasis> override the resulting definition if
-      you want, but you need to be a bit surer what you are doing.
-      For example, there's a line that says:</para>
-
-<programlisting>TAR = @TarCmd@</programlisting>
-
-      <para>This defines the Make variables <constant>TAR</constant>
-      to the pathname for a <command>tar</command> that
-      <command>configure</command> finds somewhere.  If you have your
-      own pet <command>tar</command> you want to use instead, that's
-      fine. Just add this line to <filename>mk/build.mk</filename>:</para>
-
-<programlisting>TAR = mytar</programlisting>
-
-      <para>You do not <emphasis>have</emphasis> to have a
-      <filename>mk/build.mk</filename> file at all; if you don't,
-      you'll get all the default settings from
-      <filename>mk/config.mk.in</filename>.</para>
-
-      <para>You can also use <filename>build.mk</filename> to override
-      anything that <command>configure</command> got wrong.  One place
-      where this happens often is with the definition of
-      <constant>FPTOOLS&lowbar;TOP&lowbar;ABS</constant>: this
-      variable is supposed to be the canonical path to the top of your
-      source tree, but if your system uses an automounter then the
-      correct directory is hard to find automatically.  If you find
-      that <command>configure</command> has got it wrong, just put the
-      correct definition in <filename>build.mk</filename>.</para>
-
-    </sect2>
-
-    <sect2 id="sec-storysofar">
-      <title>The story so far</title>
-
-      <para>Let's summarise the steps you need to carry to get
-      yourself a fully-configured build tree from scratch.</para>
-
-      <orderedlist>
-	<listitem>
-	  <para> Get your source tree from somewhere (darcs repository
-          or source distribution).  Say you call the root directory
-          <filename>myfptools</filename> (it does not have to be
-          called <filename>fptools</filename>).  Make sure that you
-          have the essential files (see <xref
-          linkend="sec-source-tree"/>).</para>
-	</listitem>
-
-	<listitem>
-
-	  <para>(Optional) Use <command>lndir</command> or
-	  <command>mkshadowdir</command> to create a build tree.</para>
-
-<screen>$ cd myfptools
-$ mkshadowdir . /scratch/joe-bloggs/myfptools-sun4</screen>
-
-	  <para>(N.B. <command>mkshadowdir</command>'s first argument
-          is taken relative to its second.) You probably want to give
-          the build tree a name that suggests its main defining
-          characteristic (in your mind at least), in case you later
-          add others.</para>
-	</listitem>
-
-	<listitem>
-	  <para>Change directory to the build tree.  Everything is
-          going to happen there now.</para>
-
-<screen>$ cd /scratch/joe-bloggs/myfptools-sun4</screen>
-
-	</listitem>
-
-	<listitem>
-	  <para>Prepare for system configuration:</para>
-
-<screen>$ autoreconf</screen>
-
-	  <para>(You can skip this step if you are starting from a
-          source distribution, and you already have
-          <filename>configure</filename> and
-          <filename>mk/config.h.in</filename>.)</para>
-	</listitem>
-
-	<listitem>
-	  <para>Do system configuration:</para>
-
-<screen>$ ./configure</screen>
-
-	  <para>Don't forget to check whether you need to add any
-	  arguments to <literal>configure</literal>; for example, a
-	  common requirement is to specify which GHC to use with
-	  <option>--with-ghc=<replaceable>ghc</replaceable></option>.</para>
-	</listitem>
-
-	<listitem>
-	  <para>Create the file <filename>mk/build.mk</filename>,
-          adding definitions for your desired configuration
-          options.</para>
-
-<screen>$ emacs mk/build.mk</screen>
-	</listitem>
-      </orderedlist>
-
-      <para>You can make subsequent changes to
-      <filename>mk/build.mk</filename> as often as you like.  You do
-      not have to run any further configuration programs to make these
-      changes take effect. In theory you should, however, say
-      <command>gmake clean</command>, <command>gmake all</command>,
-      because configuration option changes could affect
-      anything&mdash;but in practice you are likely to know what's
-      affected.</para>
-    </sect2>
-
-    <sect2>
-      <title>Making things</title>
-
-      <para>At this point you have made yourself a fully-configured
-      build tree, so you are ready to start building real
-      things.</para>
-
-      <para>The first thing you need to know is that <emphasis>you
-      must use GNU <command>make</command>, usually called
-      <command>gmake</command>, not standard Unix
-      <command>make</command></emphasis>.  If you use standard Unix
-      <command>make</command> you will get all sorts of error messages
-      (but no damage) because the <literal>fptools</literal>
-      <command>Makefiles</command> use GNU <command>make</command>'s
-      facilities extensively.</para>
-
-      <para>To just build the whole thing, <command>cd</command> to
-      the top of your <literal>fptools</literal> tree and type
-      <command>gmake</command>.  This will prepare the tree and build
-      the various projects in the correct order.</para>
-    </sect2>
-
-    <sect2 id="sec-bootstrapping">
-      <title>Bootstrapping GHC</title>
-
-      <para>GHC requires a 2-stage bootstrap in order to provide 
-      full functionality, including GHCi.  By a 2-stage bootstrap, we
-      mean that the compiler is built once using the installed GHC,
-      and then again using the compiler built in the first stage.  You
-      can also build a stage 3 compiler, but this normally isn't
-      necessary except to verify that the stage 2 compiler is working
-      properly.</para>
-
-      <para>Note that when doing a bootstrap, the stage 1 compiler
-      must be built, followed by the runtime system and libraries, and
-      then the stage 2 compiler.  The correct ordering is implemented
-      by the top-level fptools <filename>Makefile</filename>, so if
-      you want everything to work automatically it's best to start
-      <command>make</command> from the top of the tree.  When building
-      GHC, the top-level fptools <filename>Makefile</filename> is set
-      up to do a 2-stage bootstrap by default (when you say
-      <command>make</command>).  Some other targets it supports
-      are:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term>stage1</term>
-	  <listitem>
-	    <para>Build everything as normal, including the stage 1
-	    compiler.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>stage2</term>
-	  <listitem>
-	    <para>Build the stage 2 compiler only.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>stage3</term>
-	  <listitem>
-	    <para>Build the stage 3 compiler only.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>bootstrap</term> <term>bootstrap2</term>
-	  <listitem>
-	    <para>Build stage 1 followed by stage 2.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>bootstrap3</term>
-	  <listitem>
-	    <para>Build stages 1, 2 and 3.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>install</term>
-	  <listitem>
-	    <para>Install everything, including the compiler built in
-	    stage 2.  To override the stage, say <literal>make install
-	    stage=<replaceable>n</replaceable></literal> where
-	    <replaceable>n</replaceable> is the stage to install.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>The top-level <filename>Makefile</filename> also arranges
-      to do the appropriate <literal>make boot</literal> steps (see
-      below) before actually building anything.</para>
-
-      <para>The <literal>stage1</literal>, <literal>stage2</literal>
-      and <literal>stage3</literal> targets also work in the
-      <literal>ghc/compiler</literal> directory, but don't forget that
-      each stage requires its own <literal>make boot</literal> step:
-      for example, you must do</para>
-
-      <screen>$ make boot stage=2</screen>
-
-      <para>before <literal>make stage2</literal> in
-      <literal>ghc/compiler</literal>.</para>
-    </sect2>
-
-    <sect2 id="sec-standard-targets">
-      <title>Standard Targets</title>
-      <indexterm><primary>targets, standard makefile</primary></indexterm>
-      <indexterm><primary>makefile targets</primary></indexterm>
-
-      <para>In any directory you should be able to make the following:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term><literal>boot</literal></term>
-	  <listitem>
-	    <para>does the one-off preparation required to get ready
-            for the real work.  Notably, it does <command>gmake
-            depend</command> in all directories that contain programs.
-            It also builds the necessary tools for compilation to
-            proceed.</para>
-
-	    <para>Invoking the <literal>boot</literal> target
-            explicitly is not normally necessary.  From the top-level
-            <literal>fptools</literal> directory, invoking
-            <literal>gmake</literal> causes <literal>gmake boot
-            all</literal> to be invoked in each of the project
-            subdirectories, in the order specified by
-            <literal>&dollar;(AllTargets)</literal> in
-            <literal>config.mk</literal>.</para>
-
-	    <para>If you're working in a subdirectory somewhere and
-            need to update the dependencies, <literal>gmake
-            boot</literal> is a good way to do it.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>all</literal></term>
-	  <listitem>
-	    <para>makes all the final target(s) for this Makefile.
-            Depending on which directory you are in a &ldquo;final
-            target&rdquo; may be an executable program, a library
-            archive, a shell script, or a Postscript file.  Typing
-            <command>gmake</command> alone is generally the same as
-            typing <command>gmake all</command>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>install</literal></term>
-	  <listitem>
-	    <para>installs the things built by <literal>all</literal>
-            (except for the documentation).  Where does it install
-            them?  That is specified by
-            <filename>mk/config.mk.in</filename>; you can override it
-            in <filename>mk/build.mk</filename>, or by running
-            <command>configure</command> with command-line arguments
-            like <literal>--bindir=/home/simonpj/bin</literal>; see
-            <literal>./configure --help</literal> for the full
-            details.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>install-docs</literal></term>
-	  <listitem>
-	    <para>installs the documentation. Otherwise behaves just
-	    like <literal>install</literal>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>uninstall</literal></term>
-	  <listitem>
-	    <para>reverses the effect of
-            <literal>install</literal>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>clean</literal></term>
-	  <listitem>
-	    <para>Delete all files from the current directory that are
-            normally created by building the program.  Don't delete
-            the files that record the configuration, or files
-            generated by <command>gmake boot</command>.  Also preserve
-            files that could be made by building, but normally aren't
-            because the distribution comes with them.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>distclean</literal></term>
-	  <listitem>
-	    <para>Delete all files from the current directory that are
-            created by configuring or building the program. If you
-            have unpacked the source and built the program without
-            creating any other files, <literal>make
-            distclean</literal> should leave only the files that were
-            in the distribution.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>mostlyclean</literal></term>
-	  <listitem>
-	    <para>Like <literal>clean</literal>, but may refrain from
-            deleting a few files that people normally don't want to
-            recompile.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>maintainer-clean</literal></term>
-	  <listitem>
-	    <para>Delete everything from the current directory that
-            can be reconstructed with this Makefile.  This typically
-            includes everything deleted by
-            <literal>distclean</literal>, plus more: C source files
-            produced by Bison, tags tables, Info files, and so
-            on.</para>
-
-	    <para>One exception, however: <literal>make
-            maintainer-clean</literal> should not delete
-            <filename>configure</filename> even if
-            <filename>configure</filename> can be remade using a rule
-            in the <filename>Makefile</filename>. More generally,
-            <literal>make maintainer-clean</literal> should not delete
-            anything that needs to exist in order to run
-            <filename>configure</filename> and then begin to build the
-            program.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>check</literal></term>
-	  <listitem>
-	    <para>run the test suite.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>All of these standard targets automatically recurse into
-      sub-directories.  Certain other standard targets do not:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term><literal>configure</literal></term>
-	  <listitem>
-	    <para>is only available in the root directory
-            <constant>&dollar;(FPTOOLS&lowbar;TOP)</constant>; it has
-            been discussed in <xref
-            linkend="sec-build-config"/>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>depend</literal></term>
-	  <listitem>
-	    <para>make a <filename>.depend</filename> file in each
-            directory that needs it. This <filename>.depend</filename>
-            file contains mechanically-generated dependency
-            information; for example, suppose a directory contains a
-            Haskell source module <filename>Foo.lhs</filename> which
-            imports another module <literal>Baz</literal>.  Then the
-            generated <filename>.depend</filename> file will contain
-            the dependency:</para>
-
-<programlisting>Foo.o : Baz.hi</programlisting>
-
-	    <para>which says that the object file
-            <filename>Foo.o</filename> depends on the interface file
-            <filename>Baz.hi</filename> generated by compiling module
-            <literal>Baz</literal>.  The <filename>.depend</filename>
-            file is automatically included by every Makefile.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>binary-dist</literal></term>
-	  <listitem>
-	    <para>make a binary distribution.  This is the target we
-            use to build the binary distributions of GHC and
-            Happy.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>dist</literal></term>
-	  <listitem>
-	    <para>make a source distribution.  Note that this target
-            does &ldquo;make distclean&rdquo; as part of its work;
-            don't use it if you want to keep what you've built.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>Most <filename>Makefile</filename>s have targets other
-      than these.  You can discover them by looking in the
-      <filename>Makefile</filename> itself.</para>
-    </sect2>
-
-    <sect2>
-      <title>Using a project from the build tree</title> 
-
-      <para>If you want to build GHC (say) and just use it direct from
-      the build tree without doing <literal>make install</literal>
-      first, you can run the in-place driver script:
-      <filename>ghc/compiler/ghc-inplace</filename>.</para>
-
-      <para> Do <emphasis>NOT</emphasis> use
-      <filename>ghc/compiler/ghc</filename>, or
-      <filename>ghc/compiler/ghc-6.xx</filename>, as these are the
-      scripts intended for installation, and contain hard-wired paths
-      to the installed libraries, rather than the libraries in the
-      build tree.</para>
-
-      <para>Happy can similarly be run from the build tree, using
-      <filename>happy/src/happy-inplace</filename>, and similarly for
-      Alex and Haddock.</para>
-    </sect2>
-
-    <sect2>
-      <title>Fast Making</title>
-
-      <indexterm><primary>fastmake</primary></indexterm>
-      <indexterm><primary>dependencies, omitting</primary></indexterm>
-      <indexterm><primary>FAST, makefile variable</primary></indexterm>
-
-      <para>Sometimes the dependencies get in the way: if you've made
-      a small change to one file, and you're absolutely sure that it
-      won't affect anything else, but you know that
-      <command>make</command> is going to rebuild everything anyway,
-      the following hack may be useful:</para>
-
-<screen>$ gmake FAST=YES</screen>
-
-      <para>This tells the make system to ignore dependencies and just
-      build what you tell it to.  In other words, it's equivalent to
-      temporarily removing the <filename>.depend</filename> file in
-      the current directory (where <command>mkdependHS</command> and
-      friends store their dependency information).</para>
-
-      <para>A bit of history: GHC used to come with a
-      <command>fastmake</command> script that did the above job, but
-      GNU make provides the features we need to do it without
-      resorting to a script.  Also, we've found that fastmaking is
-      less useful since the advent of GHC's recompilation checker (see
-      the User's Guide section on "Separate Compilation").</para>
-    </sect2>
-  </sect1>
-
-  <sect1 id="sec-makefile-arch">
-    <title>The <filename>Makefile</filename> architecture</title>
-    <indexterm><primary>makefile architecture</primary></indexterm>
-
-    <para><command>make</command> is great if everything
-    works&mdash;you type <command>gmake install</command> and lo! the
-    right things get compiled and installed in the right places.  Our
-    goal is to make this happen often, but somehow it often doesn't;
-    instead some weird error message eventually emerges from the
-    bowels of a directory you didn't know existed.</para>
-
-    <para>The purpose of this section is to give you a road-map to
-    help you figure out what is going right and what is going
-    wrong.</para>
-
-    <sect2>
-      <title>Debugging</title>
-      
-      <para>Debugging <filename>Makefile</filename>s is something of a
-      black art, but here's a couple of tricks that we find
-      particularly useful.  The following command allows you to see
-      the contents of any make variable in the context of the current
-      <filename>Makefile</filename>:</para>
-
-<screen>$ make show VALUE=HS_SRCS</screen>
-
-      <para>where you can replace <literal>HS_SRCS</literal> with the
-      name of any variable you wish to see the value of.</para>
-      
-      <para>GNU make has a <option>-d</option> option which generates
-      a dump of the decision procedure used to arrive at a conclusion
-      about which files should be recompiled.  Sometimes useful for
-      tracking down problems with superfluous or missing
-      recompilations.</para>
-    </sect2>
-
-    <sect2>
-      <title>A small project</title>
-
-      <para>To get started, let us look at the
-      <filename>Makefile</filename> for an imaginary small
-      <literal>fptools</literal> project, <literal>small</literal>.
-      Each project in <literal>fptools</literal> has its own directory
-      in <constant>FPTOOLS&lowbar;TOP</constant>, so the
-      <literal>small</literal> project will have its own directory
-      <constant>FPOOLS&lowbar;TOP/small/</constant>.  Inside the
-      <filename>small/</filename> directory there will be a
-      <filename>Makefile</filename>, looking something like
-      this:</para>
-
-<indexterm><primary>Makefile, minimal</primary></indexterm>
-
-<programlisting># Makefile for fptools project "small"
-
-TOP = ..
-include $(TOP)/mk/boilerplate.mk
-
-SRCS = $(wildcard *.lhs) $(wildcard *.c)
-HS_PROG = small
-
-include $(TOP)/target.mk</programlisting>
-
-      <para>this <filename>Makefile</filename> has three
-      sections:</para>
-
-      <orderedlist>
-	<listitem>
-	  <para>The first section includes
-<footnote>
-<para>
-One of the most important
-features of GNU <command>make</command> that we use is the ability for a <filename>Makefile</filename> to
-include another named file, very like <command>cpp</command>'s <literal>&num;include</literal>
-directive.
-</para>
-</footnote>
-
-          a file of &ldquo;boilerplate&rdquo; code from the level
-          above (which in this case will be
-          <filename>FPTOOLS&lowbar;TOP/mk/boilerplate.mk</filename><indexterm><primary>boilerplate.mk</primary></indexterm>).
-          As its name suggests, <filename>boilerplate.mk</filename>
-          consists of a large quantity of standard
-          <filename>Makefile</filename> code.  We discuss this
-          boilerplate in more detail in <xref linkend="sec-boiler"/>.
-          <indexterm><primary>include, directive in
-          Makefiles</primary></indexterm> <indexterm><primary>Makefile
-          inclusion</primary></indexterm></para>
-
-          <para>Before the <literal>include</literal> statement, you
-          must define the <command>make</command> variable
-          <constant>TOP</constant><indexterm><primary>TOP</primary></indexterm>
-          to be the directory containing the <filename>mk</filename>
-          directory in which the <filename>boilerplate.mk</filename>
-          file is.  It is <emphasis>not</emphasis> OK to simply say</para>
-
-<programlisting>include ../mk/boilerplate.mk  # NO NO NO</programlisting>
-
-
-          <para>Why?  Because the <filename>boilerplate.mk</filename>
-          file needs to know where it is, so that it can, in turn,
-          <literal>include</literal> other files.  (Unfortunately,
-          when an <literal>include</literal>d file does an
-          <literal>include</literal>, the filename is treated relative
-          to the directory in which <command>gmake</command> is being
-          run, not the directory in which the
-          <literal>include</literal>d sits.)  In general,
-          <emphasis>every file <filename>foo.mk</filename> assumes
-          that
-          <filename>&dollar;(TOP)/mk/foo.mk</filename>
-          refers to itself.</emphasis> It is up to the
-          <filename>Makefile</filename> doing the
-          <literal>include</literal> to ensure this is the case.</para>
-
-          <para>Files intended for inclusion in other
-          <filename>Makefile</filename>s are written to have the
-          following property: <emphasis>after
-          <filename>foo.mk</filename> is <literal>include</literal>d,
-          it leaves <constant>TOP</constant> containing the same value
-          as it had just before the <literal>include</literal>
-          statement</emphasis>.  In our example, this invariant
-          guarantees that the <literal>include</literal> for
-          <filename>target.mk</filename> will look in the same
-          directory as that for <filename>boilerplate.mk</filename>.</para>
-	</listitem>
-
-	<listitem>
-	  <para> The second section defines the following standard
-          <command>make</command> variables:
-          <constant>SRCS</constant><indexterm><primary>SRCS</primary></indexterm>
-          (the source files from which is to be built), and
-          <constant>HS&lowbar;PROG</constant><indexterm><primary>HS&lowbar;PROG</primary></indexterm>
-          (the executable binary to be built).  We will discuss in
-          more detail what the &ldquo;standard variables&rdquo; are,
-          and how they affect what happens, in <xref
-          linkend="sec-targets"/>.</para>
-
-	  <para>The definition for <constant>SRCS</constant> uses the
-          useful GNU <command>make</command> construct
-          <literal>&dollar;(wildcard&nbsp;$pat$)</literal><indexterm><primary>wildcard</primary></indexterm>,
-          which expands to a list of all the files matching the
-          pattern <literal>pat</literal> in the current directory.  In
-          this example, <constant>SRCS</constant> is set to the list
-          of all the <filename>.lhs</filename> and
-          <filename>.c</filename> files in the directory.  (Let's
-          suppose there is one of each, <filename>Foo.lhs</filename>
-          and <filename>Baz.c</filename>.)</para>
-	</listitem>
-
-	<listitem>
-	  <para>The last section includes a second file of standard
-          code, called
-          <filename>target.mk</filename><indexterm><primary>target.mk</primary></indexterm>.
-          It contains the rules that tell <command>gmake</command> how
-          to make the standard targets (<xref
-          linkend="sec-standard-targets"/>).  Why, you ask, can't this
-          standard code be part of
-          <filename>boilerplate.mk</filename>?  Good question.  We
-          discuss the reason later, in <xref
-          linkend="sec-boiler-arch"/>.</para>
-
-          <para>You do not <emphasis>have</emphasis> to
-          <literal>include</literal> the
-          <filename>target.mk</filename> file.  Instead, you can write
-          rules of your own for all the standard targets.  Usually,
-          though, you will find quite a big payoff from using the
-          canned rules in <filename>target.mk</filename>; the price
-          tag is that you have to understand what canned rules get
-          enabled, and what they do (<xref
-          linkend="sec-targets"/>).</para>
-	</listitem>
-      </orderedlist>
-
-      <para>In our example <filename>Makefile</filename>, most of the
-      work is done by the two <literal>include</literal>d files.  When
-      you say <command>gmake all</command>, the following things
-      happen:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para><command>gmake</command> figures out that the object
-          files are <filename>Foo.o</filename> and
-          <filename>Baz.o</filename>.</para>
-	</listitem>
-
-	<listitem>
-	  <para>It uses a boilerplate pattern rule to compile
-          <filename>Foo.lhs</filename> to <filename>Foo.o</filename>
-          using a Haskell compiler.  (Which one?  That is set in the
-          build configuration.)</para>
-	</listitem>
-
-	<listitem>
-	  <para>It uses another standard pattern rule to compile
-          <filename>Baz.c</filename> to <filename>Baz.o</filename>,
-          using a C compiler.  (Ditto.)</para>
-	</listitem>
-
-	<listitem>
-	  <para>It links the resulting <filename>.o</filename> files
-          together to make <literal>small</literal>, using the Haskell
-          compiler to do the link step.  (Why not use
-          <command>ld</command>?  Because the Haskell compiler knows
-          what standard libraries to link in.  How did
-          <command>gmake</command> know to use the Haskell compiler to
-          do the link, rather than the C compiler?  Because we set the
-          variable <constant>HS&lowbar;PROG</constant> rather than
-          <constant>C&lowbar;PROG</constant>.)</para>
-	</listitem>
-      </itemizedlist>
-
-      <para>All <filename>Makefile</filename>s should follow the above
-      three-section format.</para>
-    </sect2>
-
-    <sect2>
-      <title>A larger project</title>
-
-      <para>Larger projects are usually structured into a number of
-      sub-directories, each of which has its own
-      <filename>Makefile</filename>.  (In very large projects, this
-      sub-structure might be iterated recursively, though that is
-      rare.)  To give you the idea, here's part of the directory
-      structure for the (rather large) GHC project:</para>
-
-<programlisting>$(FPTOOLS_TOP)/ghc/
-  Makefile
-  mk/
-    boilerplate.mk
-    rules.mk
-   docs/
-    Makefile
-    ...source files for documentation...
-   driver/
-    Makefile
-    ...source files for driver...
-   compiler/
-    Makefile
-    parser/...source files for parser...
-    renamer/...source files for renamer...
-    ...etc...</programlisting>
-
-      <para>The sub-directories <filename>docs</filename>,
-      <filename>driver</filename>, <filename>compiler</filename>, and
-      so on, each contains a sub-component of GHC, and each has its
-      own <filename>Makefile</filename>.  There must also be a
-      <filename>Makefile</filename> in
-      <filename>&dollar;(FPTOOLS&lowbar;TOP)/ghc</filename>.
-      It does most of its work by recursively invoking
-      <command>gmake</command> on the <filename>Makefile</filename>s
-      in the sub-directories.  We say that
-      <filename>ghc/Makefile</filename> is a <emphasis>non-leaf
-      <filename>Makefile</filename></emphasis>, because it does little
-      except organise its children, while the
-      <filename>Makefile</filename>s in the sub-directories are all
-      <emphasis>leaf <filename>Makefile</filename>s</emphasis>.  (In
-      principle the sub-directories might themselves contain a
-      non-leaf <filename>Makefile</filename> and several
-      sub-sub-directories, but that does not happen in GHC.)</para>
-
-      <para>The <filename>Makefile</filename> in
-      <filename>ghc/compiler</filename> is considered a leaf
-      <filename>Makefile</filename> even though the
-      <filename>ghc/compiler</filename> has sub-directories, because
-      these sub-directories do not themselves have
-      <filename>Makefile</filename>s in them.  They are just used to
-      structure the collection of modules that make up GHC, but all
-      are managed by the single <filename>Makefile</filename> in
-      <filename>ghc/compiler</filename>.</para>
-
-      <para>You will notice that <filename>ghc/</filename> also
-      contains a directory <filename>ghc/mk/</filename>.  It contains
-      GHC-specific <filename>Makefile</filename> boilerplate code.
-      More precisely:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para><filename>ghc/mk/boilerplate.mk</filename> is included
-          at the top of <filename>ghc/Makefile</filename>, and of all
-          the leaf <filename>Makefile</filename>s in the
-          sub-directories.  It in turn <literal>include</literal>s the
-          main boilerplate file
-          <filename>mk/boilerplate.mk</filename>.</para>
-	</listitem>
-
-	<listitem>
-	  <para><filename>ghc/mk/target.mk</filename> is
-          <literal>include</literal>d at the bottom of
-          <filename>ghc/Makefile</filename>, and of all the leaf
-          <filename>Makefile</filename>s in the sub-directories.  It
-          in turn <literal>include</literal>s the file
-          <filename>mk/target.mk</filename>.</para>
-	</listitem>
-      </itemizedlist>
-
-      <para>So these two files are the place to look for GHC-wide
-      customisation of the standard boilerplate.</para>
-    </sect2>
-
-    <sect2 id="sec-boiler-arch">
-      <title>Boilerplate architecture</title>
-      <indexterm><primary>boilerplate architecture</primary></indexterm>
-
-      <para>Every <filename>Makefile</filename> includes a
-      <filename>boilerplate.mk</filename><indexterm><primary>boilerplate.mk</primary></indexterm>
-      file at the top, and
-      <filename>target.mk</filename><indexterm><primary>target.mk</primary></indexterm>
-      file at the bottom.  In this section we discuss what is in these
-      files, and why there have to be two of them.  In general:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para><filename>boilerplate.mk</filename> consists of:</para>
-
-	  <itemizedlist>
-	    <listitem>
-	      <para><emphasis>Definitions of millions of
-              <command>make</command> variables</emphasis> that
-              collectively specify the build configuration.  Examples:
-              <constant>HC&lowbar;OPTS</constant><indexterm><primary>HC&lowbar;OPTS</primary></indexterm>,
-              the options to feed to the Haskell compiler;
-              <constant>NoFibSubDirs</constant><indexterm><primary>NoFibSubDirs</primary></indexterm>,
-              the sub-directories to enable within the
-              <literal>nofib</literal> project;
-              <constant>GhcWithHc</constant><indexterm><primary>GhcWithHc</primary></indexterm>,
-              the name of the Haskell compiler to use when compiling
-              GHC in the <literal>ghc</literal> project.</para>
-	    </listitem>
-
-	    <listitem>
-	      <para><emphasis>Standard pattern rules</emphasis> that
-              tell <command>gmake</command> how to construct one file
-              from another.</para>
-	    </listitem>
-	  </itemizedlist>
-
-	  <para><filename>boilerplate.mk</filename> needs to be
-          <literal>include</literal>d at the <emphasis>top</emphasis>
-          of each <filename>Makefile</filename>, so that the user can
-          replace the boilerplate definitions or pattern rules by
-          simply giving a new definition or pattern rule in the
-          <filename>Makefile</filename>.  <command>gmake</command>
-          simply takes the last definition as the definitive one.</para>
-
-	  <para>Instead of <emphasis>replacing</emphasis> boilerplate
-          definitions, it is also quite common to
-          <emphasis>augment</emphasis> them. For example, a
-          <filename>Makefile</filename> might say:</para>
-
-<programlisting>SRC_HC_OPTS += -O</programlisting>
-
-	  <para>thereby adding &ldquo;<option>-O</option>&rdquo; to
-	  the end of
-	  <constant>SRC&lowbar;HC&lowbar;OPTS</constant><indexterm><primary>SRC&lowbar;HC&lowbar;OPTS</primary></indexterm>.</para>
-	</listitem>
-
-	<listitem>
-	  <para><filename>target.mk</filename> contains
-          <command>make</command> rules for the standard targets
-          described in <xref linkend="sec-standard-targets"/>.  These
-          rules are selectively included, depending on the setting of
-          certain <command>make</command> variables.  These variables
-          are usually set in the middle section of the
-          <filename>Makefile</filename> between the two
-          <literal>include</literal>s.</para>
-
-	  <para><filename>target.mk</filename> must be included at the
-          end (rather than being part of
-          <filename>boilerplate.mk</filename>) for several tiresome
-          reasons:</para>
-
-	  <itemizedlist>
-	    <listitem>
-
-	      <para><command>gmake</command> commits target and
-              dependency lists earlier than it should.  For example,
-              <filename>target.mk</filename> has a rule that looks
-              like this:</para>
-
-<programlisting>$(HS_PROG) : $(OBJS)
-      $(HC) $(LD_OPTS) $&#60; -o $@</programlisting>
-
-	      <para>If this rule was in
-              <filename>boilerplate.mk</filename> then
-              <constant>&dollar;(HS&lowbar;PROG)</constant><indexterm><primary>HS&lowbar;PROG</primary></indexterm>
-              and
-              <constant>&dollar;(OBJS)</constant><indexterm><primary>OBJS</primary></indexterm>
-              would not have their final values at the moment
-              <command>gmake</command> encountered the rule.  Alas,
-              <command>gmake</command> takes a snapshot of their
-              current values, and wires that snapshot into the rule.
-              (In contrast, the commands executed when the rule
-              &ldquo;fires&rdquo; are only substituted at the moment
-              of firing.)  So, the rule must follow the definitions
-              given in the <filename>Makefile</filename> itself.</para>
-	    </listitem>
-
-	    <listitem>
-	      <para>Unlike pattern rules, ordinary rules cannot be
-              overriden or replaced by subsequent rules for the same
-              target (at least, not without an error message).
-              Including ordinary rules in
-              <filename>boilerplate.mk</filename> would prevent the
-              user from writing rules for specific targets in specific
-              cases.</para>
-	    </listitem>
-
-	    <listitem>
-	      <para>There are a couple of other reasons I've
-              forgotten, but it doesn't matter too much.</para>
-	    </listitem>
-	  </itemizedlist>
-	</listitem>
-      </itemizedlist>
-    </sect2>
-
-    <sect2 id="sec-boiler">
-      <title>The main <filename>mk/boilerplate.mk</filename> file</title>
-      <indexterm><primary>boilerplate.mk</primary></indexterm>
-
-      <para>If you look at
-      <filename>&dollar;(FPTOOLS&lowbar;TOP)/mk/boilerplate.mk</filename>
-      you will find that it consists of the following sections, each
-      held in a separate file:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term><filename>config.mk</filename>
-            <indexterm><primary>config.mk</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>is the build configuration file we discussed at
-            length in <xref linkend="sec-build-config"/>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><filename>paths.mk</filename>
-            <indexterm><primary>paths.mk</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>defines <command>make</command> variables for
-            pathnames and file lists.  This file contains code for
-            automatically compiling lists of source files and deriving
-            lists of object files from those.  The results can be
-            overriden in the <filename>Makefile</filename>, but in
-            most cases the automatic setup should do the right
-            thing.</para>
-	    
-	    <para>The following variables may be set in the
-	    <filename>Makefile</filename> to affect how the automatic
-	    source file search is done:</para>
-
-	    <variablelist>
-	      <varlistentry>
-		<term><literal>ALL_DIRS</literal>
-                  <indexterm><primary><literal>ALL_DIRS</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>Set to a list of directories to search in
-		  addition to the current directory for source
-		  files.</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>EXCLUDED_SRCS</literal>
-                  <indexterm><primary><literal>EXCLUDED_SRCS</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>Set to a list of source files (relative to the
-		  current directory) to omit from the automatic
-		  search.  The source searching machinery is clever
-		  enough to know that if you exclude a source file
-		  from which other sources are derived, then the
-		  derived sources should also be excluded.  For
-		  example, if you set <literal>EXCLUDED_SRCS</literal>
-		  to include <filename>Foo.y</filename>, then
-		  <filename>Foo.hs</filename> will also be
-		  excluded.</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>EXTRA_SRCS</literal>
-                  <indexterm><primary><literal>EXTRA_SRCS</literal></primary></indexterm>
-                </term>
-		  <listitem>
-		  <para>Set to a list of extra source files (perhaps
-		  in directories not listed in
-		  <literal>ALL_DIRS</literal>) that should be
-		  considered.</para>
-		</listitem>
-	      </varlistentry>
-	    </variablelist>
-
-	    <para>The results of the automatic source file search are
-	    placed in the following make variables:</para>
-
-	    <variablelist>
-	      <varlistentry>
-		<term><literal>SRCS</literal>
-                  <indexterm><primary><literal>SRCS</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>All source files found, sorted and without
-		  duplicates, including those which might not exist
-		  yet but will be derived from other existing sources.
-		  <literal>SRCS</literal> <emphasis>can</emphasis> be
-		  overriden if necessary, in which case the variables
-		  below will follow suit.</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>HS_SRCS</literal>
-                  <indexterm><primary><literal>HS_SRCS</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>all Haskell source files in the current
-                  directory, including those derived from other source
-                  files (eg. Happy sources also give rise to Haskell
-                  sources).</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>HS_OBJS</literal>
-                  <indexterm><primary><literal>HS_OBJS</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>Object files derived from
-		  <literal>HS_SRCS</literal>.</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>HS_IFACES</literal>
-                  <indexterm><primary><literal>HS_IFACES</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>Interface files (<literal>.hi</literal> files)
-		  derived from <literal>HS_SRCS</literal>.</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>C_SRCS</literal>
-		<indexterm><primary><literal>C_SRCS</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>All C source files found.</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>C_OBJS</literal>
-		<indexterm><primary><literal>C_OBJS</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>Object files derived from
-		  <literal>C_SRCS</literal>.</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>SCRIPT_SRCS</literal>
-		<indexterm><primary><literal>SCRIPT_SRCS</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>All script source files found
-		  (<literal>.lprl</literal> files).</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>SCRIPT_OBJS</literal>
-		<indexterm><primary><literal>SCRIPT_OBJS</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para><quote>object</quote> files derived from
-		  <literal>SCRIPT_SRCS</literal>
-		  (<literal>.prl</literal> files).</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>HSC_SRCS</literal>
-		<indexterm><primary><literal>HSC_SRCS</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>All <literal>hsc2hs</literal> source files
-		  (<literal>.hsc</literal> files).</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>HAPPY_SRCS</literal>
-		<indexterm><primary><literal>HAPPY_SRCS</literal></primary></indexterm>
-                </term>
-		<listitem>
-		  <para>All <literal>happy</literal> source files
-		  (<literal>.y</literal> or <literal>.hy</literal> files).</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>OBJS</literal>
-		<indexterm><primary>OBJS</primary></indexterm>
-                </term>
-		<listitem>
-		  <para>the concatenation of
-		  <literal>&dollar;(HS_OBJS)</literal>,
-		  <literal>&dollar;(C_OBJS)</literal>, and
-		  <literal>&dollar;(SCRIPT_OBJS)</literal>.</para>
-		</listitem>
-	      </varlistentry>
-	    </variablelist>
-
-	    <para>Any or all of these definitions can easily be
-            overriden by giving new definitions in your
-            <filename>Makefile</filename>.</para>
-
-	    <para>What, exactly, does <filename>paths.mk</filename>
-            consider a <quote>source file</quote> to be?  It's based
-            on the file's suffix (e.g. <filename>.hs</filename>,
-            <filename>.lhs</filename>, <filename>.c</filename>,
-            <filename>.hy</filename>, etc), but this is the kind of
-            detail that changes, so rather than enumerate the source
-            suffices here the best thing to do is to look in
-            <filename>paths.mk</filename>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><filename>opts.mk</filename>
-            <indexterm><primary>opts.mk</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>defines <command>make</command> variables for option
-            strings to pass to each program. For example, it defines
-            <constant>HC&lowbar;OPTS</constant><indexterm><primary>HC&lowbar;OPTS</primary></indexterm>,
-            the option strings to pass to the Haskell compiler.  See
-            <xref linkend="sec-suffix"/>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><filename>suffix.mk</filename>
-            <indexterm><primary>suffix.mk</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>defines standard pattern rules&mdash;see <xref
-	    linkend="sec-suffix"/>.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>Any of the variables and pattern rules defined by the
-      boilerplate file can easily be overridden in any particular
-      <filename>Makefile</filename>, because the boilerplate
-      <literal>include</literal> comes first.  Definitions after this
-      <literal>include</literal> directive simply override the default
-      ones in <filename>boilerplate.mk</filename>.</para>
-    </sect2>
-
-    <sect2 id="sec-platforms">
-      <title>Platform settings</title>
-      <indexterm><primary>Platform settings</primary>
-      </indexterm>
-
-      <para>There are three platforms of interest when building GHC:</para>
-      
-      <variablelist>
-	<varlistentry>
-	  <term>The <emphasis>build</emphasis> platform</term>
-	  <listitem>
-	    <para>The platform on which we are doing this build.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>The <emphasis>host</emphasis> platform</term>
-	  <listitem>
-	    <para>The platform on which these binaries will run.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>The <emphasis>target</emphasis> platform</term>
-	  <listitem>
-	    <para>The platform for which this compiler will generate code.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-      
-      <para>These platforms are set when running the
-	<literal>configure</literal> script, using the
-	<option>--build</option>, <option>--host</option>, and
-	<option>--target</option> options.  The <filename>mk/config.mk</filename>
-	file defines several symbols related to the platform settings (see
-	<filename>mk/config.mk</filename> for details).</para>
-
-      <para>We don't currently support build &amp; host being different, because
-	the build process creates binaries that are both run during the build,
-	and also installed.</para>
-
-      <para>If host and target are different, then we are building a
-	cross-compiler.  For GHC, this means a compiler
-	which will generate intermediate .hc files to port to the target
-	architecture for bootstrapping.  The libraries and stage 2 compiler
-	will be built as HC files for the target system (see <xref
-	  linkend="sec-porting-ghc" /> for details.</para>
-
-      <para>More details on when to use BUILD, HOST or TARGET can be found in
-	the comments in <filename>config.mk</filename>.</para>
-    </sect2>
-
-    <sect2 id="sec-suffix">
-      <title>Pattern rules and options</title>
-      <indexterm><primary>Pattern rules</primary></indexterm>
-
-      <para>The file
-      <filename>suffix.mk</filename><indexterm><primary>suffix.mk</primary></indexterm>
-      defines standard <emphasis>pattern rules</emphasis> that say how
-      to build one kind of file from another, for example, how to
-      build a <filename>.o</filename> file from a
-      <filename>.c</filename> file.  (GNU <command>make</command>'s
-      <emphasis>pattern rules</emphasis> are more powerful and easier
-      to use than Unix <command>make</command>'s <emphasis>suffix
-      rules</emphasis>.)</para>
-
-      <para>Almost all the rules look something like this:</para>
-
-<programlisting>%.o : %.c
-      $(RM) $@
-      $(CC) $(CC_OPTS) -c $&#60; -o $@</programlisting>
-
-      <para>Here's how to understand the rule.  It says that
-      <emphasis>something</emphasis><filename>.o</filename> (say
-      <filename>Foo.o</filename>) can be built from
-      <emphasis>something</emphasis><filename>.c</filename>
-      (<filename>Foo.c</filename>), by invoking the C compiler (path
-      name held in <constant>&dollar;(CC)</constant>), passing to it
-      the options <constant>&dollar;(CC&lowbar;OPTS)</constant> and
-      the rule's dependent file of the rule
-      <literal>&dollar;&lt;</literal> (<filename>Foo.c</filename> in
-      this case), and putting the result in the rule's target
-      <literal>&dollar;@</literal> (<filename>Foo.o</filename> in this
-      case).</para>
-
-      <para>Every program is held in a <command>make</command>
-      variable defined in <filename>mk/config.mk</filename>&mdash;look
-      in <filename>mk/config.mk</filename> for the complete list.  One
-      important one is the Haskell compiler, which is called
-      <constant>&dollar;(HC)</constant>.</para>
-
-      <para>Every program's options are are held in a
-      <command>make</command> variables called
-      <constant>&lt;prog&gt;&lowbar;OPTS</constant>.  the
-      <constant>&lt;prog&gt;&lowbar;OPTS</constant> variables are
-      defined in <filename>mk/opts.mk</filename>.  Almost all of them
-      are defined like this:</para>
-
-<programlisting>CC_OPTS = \
-  $(SRC_CC_OPTS) $(WAY$(_way)_CC_OPTS) $($*_CC_OPTS) $(EXTRA_CC_OPTS)</programlisting>
-
-      <para>The four variables from which
-       <constant>CC&lowbar;OPTS</constant> is built have the following
-      meaning:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term><constant>SRC&lowbar;CC&lowbar;OPTS</constant><indexterm><primary>SRC&lowbar;CC&lowbar;OPTS</primary></indexterm>:</term>
-	  <listitem>
-	    <para>options passed to all C compilations.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><constant>WAY&lowbar;&lt;way&gt;&lowbar;CC&lowbar;OPTS</constant>:</term>
-	  <listitem>
-	    <para>options passed to C compilations for way
-            <literal>&lt;way&gt;</literal>. For example,
-            <constant>WAY&lowbar;mp&lowbar;CC&lowbar;OPTS</constant>
-            gives options to pass to the C compiler when compiling way
-            <literal>mp</literal>.  The variable
-            <constant>WAY&lowbar;CC&lowbar;OPTS</constant> holds
-            options to pass to the C compiler when compiling the
-            standard way.  (<xref linkend="sec-ways"/> dicusses
-            multi-way compilation.)</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><constant>&lt;module&gt;&lowbar;CC&lowbar;OPTS</constant>:</term>
-	  <listitem>
-	    <para>options to pass to the C compiler that are specific
-            to module <literal>&lt;module&gt;</literal>.  For example,
-            <constant>SMap&lowbar;CC&lowbar;OPTS</constant> gives the
-            specific options to pass to the C compiler when compiling
-            <filename>SMap.c</filename>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><constant>EXTRA&lowbar;CC&lowbar;OPTS</constant><indexterm><primary>EXTRA&lowbar;CC&lowbar;OPTS</primary></indexterm>:</term>
-	  <listitem>
-	    <para>extra options to pass to all C compilations.  This
-            is intended for command line use, thus:</para>
-
-<screen>$ gmake libHS.a EXTRA_CC_OPTS="-v"</screen>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-    </sect2>
-
-    <sect2 id="sec-targets">
-      <title>The main <filename>mk/target.mk</filename> file</title>
-      <indexterm><primary>target.mk</primary></indexterm>
-
-      <para><filename>target.mk</filename> contains canned rules for
-      all the standard targets described in <xref
-      linkend="sec-standard-targets"/>.  It is complicated by the fact
-      that you don't want all of these rules to be active in every
-      <filename>Makefile</filename>.  Rather than have a plethora of
-      tiny files which you can include selectively, there is a single
-      file, <filename>target.mk</filename>, which selectively includes
-      rules based on whether you have defined certain variables in
-      your <filename>Makefile</filename>.  This section explains what
-      rules you get, what variables control them, and what the rules
-      do.  Hopefully, you will also get enough of an idea of what is
-      supposed to happen that you can read and understand any weird
-      special cases yourself.</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term><constant>HS&lowbar;PROG</constant><indexterm><primary>HS&lowbar;PROG</primary></indexterm>.</term>
-	  <listitem>
-	    <para>If <constant>HS&lowbar;PROG</constant> is defined,
-            you get rules with the following targets:</para>
-
-	    <variablelist>
-	      <varlistentry>
-		<term><filename>HS&lowbar;PROG</filename><indexterm><primary>HS&lowbar;PROG</primary></indexterm></term>
-		<listitem>
-		  <para>itself.  This rule links
-                  <constant>&dollar;(OBJS)</constant> with the Haskell
-                  runtime system to get an executable called
-                  <constant>&dollar;(HS&lowbar;PROG)</constant>.</para>
-		</listitem>
-	      </varlistentry>
-
-	      <varlistentry>
-		<term><literal>install</literal><indexterm><primary>install</primary></indexterm></term>
-		<listitem>
-		  <para>installs
-                  <constant>&dollar;(HS&lowbar;PROG)</constant> in
-                  <constant>&dollar;(bindir)</constant>.</para>
-		</listitem>
-	      </varlistentry>
-	    </variablelist>
-
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><constant>C&lowbar;PROG</constant><indexterm><primary>C&lowbar;PROG</primary></indexterm></term>
-	  <listitem>
-	    <para>is similar to <constant>HS&lowbar;PROG</constant>,
-            except that the link step links
-            <constant>&dollar;(C&lowbar;OBJS)</constant> with the C
-            runtime system.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><constant>LIBRARY</constant><indexterm><primary>LIBRARY</primary></indexterm></term>
-	  <listitem>
-	    <para>is similar to <constant>HS&lowbar;PROG</constant>,
-            except that it links
-            <constant>&dollar;(LIB&lowbar;OBJS)</constant> to make the
-            library archive <constant>&dollar;(LIBRARY)</constant>,
-            and <literal>install</literal> installs it in
-            <constant>&dollar;(libdir)</constant>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><constant>LIB&lowbar;DATA</constant><indexterm><primary>LIB&lowbar;DATA</primary></indexterm></term>
-	  <listitem>
-	    <para>&hellip;</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><constant>LIB&lowbar;EXEC</constant><indexterm><primary>LIB&lowbar;EXEC</primary></indexterm></term>
-	  <listitem>
-	    <para>&hellip;</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><constant>HS&lowbar;SRCS</constant><indexterm><primary>HS&lowbar;SRCS</primary></indexterm>, <constant>C&lowbar;SRCS</constant><indexterm><primary>C&lowbar;SRCS</primary></indexterm>.</term>
-	  <listitem>
-	    <para>If <constant>HS&lowbar;SRCS</constant> is defined
-            and non-empty, a rule for the target
-            <literal>depend</literal> is included, which generates
-            dependency information for Haskell programs.  Similarly
-            for <constant>C&lowbar;SRCS</constant>.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>All of these rules are &ldquo;double-colon&rdquo; rules,
-      thus</para>
-
-<programlisting>install :: $(HS_PROG)
-      ...how to install it...</programlisting>
-
-      <para>GNU <command>make</command> treats double-colon rules as
-      separate entities.  If there are several double-colon rules for
-      the same target it takes each in turn and fires it if its
-      dependencies say to do so.  This means that you can, for
-      example, define both <constant>HS&lowbar;PROG</constant> and
-      <constant>LIBRARY</constant>, which will generate two rules for
-      <literal>install</literal>.  When you type <command>gmake
-      install</command> both rules will be fired, and both the program
-      and the library will be installed, just as you wanted.</para>
-    </sect2>
-
-    <sect2 id="sec-subdirs">
-      <title>Recursion</title>
-      <indexterm><primary>recursion, in makefiles</primary></indexterm>
-      <indexterm><primary>Makefile, recursing into subdirectories</primary></indexterm>
-
-      <para>In leaf <filename>Makefile</filename>s the variable
-      <constant>SUBDIRS</constant><indexterm><primary>SUBDIRS</primary></indexterm>
-      is undefined.  In non-leaf <filename>Makefile</filename>s,
-      <constant>SUBDIRS</constant> is set to the list of
-      sub-directories that contain subordinate
-      <filename>Makefile</filename>s.  <emphasis>It is up to you to
-      set <constant>SUBDIRS</constant> in the
-      <filename>Makefile</filename>.</emphasis> There is no automation
-      here&mdash;<constant>SUBDIRS</constant> is too important to
-      automate.</para>
-
-      <para>When <constant>SUBDIRS</constant> is defined,
-      <filename>target.mk</filename> includes a rather neat rule for
-      the standard targets (<xref linkend="sec-standard-targets"/> that
-      simply invokes <command>make</command> recursively in each of
-      the sub-directories.</para>
-
-      <para><emphasis>These recursive invocations are guaranteed to
-      occur in the order in which the list of directories is specified
-      in <constant>SUBDIRS</constant>. </emphasis>This guarantee can
-      be important.  For example, when you say <command>gmake
-      boot</command> it can be important that the recursive invocation
-      of <command>make boot</command> is done in one sub-directory
-      (the include files, say) before another (the source files).
-      Generally, put the most independent sub-directory first, and the
-      most dependent last.</para>
-    </sect2>
-
-    <sect2 id="sec-ways">
-      <title>Way management</title>
-      <indexterm><primary>way management</primary></indexterm>
-
-      <para>We sometimes want to build essentially the same system in
-      several different &ldquo;ways&rdquo;.  For example, we want to build GHC's
-      <literal>Prelude</literal> libraries with and without profiling,
-      so that there is an appropriately-built library archive to link
-      with when the user compiles his program.  It would be possible
-      to have a completely separate build tree for each such &ldquo;way&rdquo;,
-      but it would be horribly bureaucratic, especially since often
-      only parts of the build tree need to be constructed in multiple
-      ways.</para>
-
-      <para>Instead, the
-      <filename>target.mk</filename><indexterm><primary>target.mk</primary></indexterm>
-      contains some clever magic to allow you to build several
-      versions of a system; and to control locally how many versions
-      are built and how they differ.  This section explains the
-      magic.</para>
-
-      <para>The files for a particular way are distinguished by
-      munging the suffix.  The <quote>normal way</quote> is always
-      built, and its files have the standard suffices
-      <filename>.o</filename>, <filename>.hi</filename>, and so on.
-      In addition, you can build one or more extra ways, each
-      distinguished by a <emphasis>way tag</emphasis>.  The object
-      files and interface files for one of these extra ways are
-      distinguished by their suffix.  For example, way
-      <literal>mp</literal> has files
-      <filename>.mp&lowbar;o</filename> and
-      <filename>.mp&lowbar;hi</filename>.  Library archives have their
-      way tag the other side of the dot, for boring reasons; thus,
-      <filename>libHS&lowbar;mp.a</filename>.</para>
-
-      <para>A <command>make</command> variable called
-      <constant>way</constant> holds the current way tag.
-      <emphasis><constant>way</constant> is only ever set on the
-      command line of <command>gmake</command></emphasis> (usually in
-      a recursive invocation of <command>gmake</command> by the
-      system).  It is never set inside a
-      <filename>Makefile</filename>.  So it is a global constant for
-      any one invocation of <command>gmake</command>.  Two other
-      <command>make</command> variables,
-      <constant>way&lowbar;</constant> and
-      <constant>&lowbar;way</constant> are immediately derived from
-      <constant>&dollar;(way)</constant> and never altered.  If
-      <constant>way</constant> is not set, then neither are
-      <constant>way&lowbar;</constant> and
-      <constant>&lowbar;way</constant>, and the invocation of
-      <command>make</command> will build the <quote>normal
-      way</quote>.  If <constant>way</constant> is set, then the other
-      two variables are set in sympathy.  For example, if
-      <constant>&dollar;(way)</constant> is &ldquo;<literal>mp</literal>&rdquo;,
-      then <constant>way&lowbar;</constant> is set to
-      &ldquo;<literal>mp&lowbar;</literal>&rdquo; and
-      <constant>&lowbar;way</constant> is set to
-      &ldquo;<literal>&lowbar;mp</literal>&rdquo;.  These three variables are
-      then used when constructing file names.</para>
-
-      <para>So how does <command>make</command> ever get recursively
-      invoked with <constant>way</constant> set?  There are two ways
-      in which this happens:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para>For some (but not all) of the standard targets, when
-          in a leaf sub-directory, <command>make</command> is
-          recursively invoked for each way tag in
-          <constant>&dollar;(WAYS)</constant>.  You set
-          <constant>WAYS</constant> in the
-          <filename>Makefile</filename> to the list of way tags you
-          want these targets built for.  The mechanism here is very
-          much like the recursive invocation of
-          <command>make</command> in sub-directories (<xref
-          linkend="sec-subdirs"/>).  It is up to you to set
-          <constant>WAYS</constant> in your
-          <filename>Makefile</filename>; this is how you control what
-          ways will get built.</para>
-	</listitem>
-
-	<listitem>
-	  <para>For a useful collection of targets (such as
-          <filename>libHS&lowbar;mp.a</filename>,
-          <filename>Foo.mp&lowbar;o</filename>) there is a rule which
-          recursively invokes <command>make</command> to make the
-          specified target, setting the <constant>way</constant>
-          variable.  So if you say <command>gmake
-          Foo.mp&lowbar;o</command> you should see a recursive
-          invocation <command>gmake Foo.mp&lowbar;o way=mp</command>,
-          and <emphasis>in this recursive invocation the pattern rule
-          for compiling a Haskell file into a <filename>.o</filename>
-          file will match</emphasis>.  The key pattern rules (in
-          <filename>suffix.mk</filename>) look like this:
-
-<programlisting>%.$(way_)o : %.lhs
-      $(HC) $(HC_OPTS) $&#60; -o $@</programlisting>
-
-          Neat, eh?</para>
-	</listitem>
-
-	<listitem>
-	  <para>You can invoke <command>make</command> with a
-	  particular <literal>way</literal> setting yourself, in order
-	  to build files related to a particular
-	  <literal>way</literal> in the current directory.  eg.
-
-<screen>$ make way=p</screen>
-
-          will build files for the profiling way only in the current
-          directory. </para>
-	</listitem>
-      </itemizedlist>
-    </sect2>
-
-    <sect2>
-      <title>When the canned rule isn't right</title>
-
-      <para>Sometimes the canned rule just doesn't do the right thing.
-      For example, in the <literal>nofib</literal> suite we want the
-      link step to print out timing information.  The thing to do here
-      is <emphasis>not</emphasis> to define
-      <constant>HS&lowbar;PROG</constant> or
-      <constant>C&lowbar;PROG</constant>, and instead define a special
-      purpose rule in your own <filename>Makefile</filename>.  By
-      using different variable names you will avoid the canned rules
-      being included, and conflicting with yours.</para>
-    </sect2>
-  </sect1>
-
-  <sect1 id="building-docs">
-    <title>Building the documentation</title>
-
-    <sect2 id="pre-supposed-doc-tools">
-      <title>Tools for building the Documentation</title>
-
-      <para>The following additional tools are required if you want to
-      format the documentation that comes with the
-      <literal>fptools</literal> projects:</para>
-      
-      <variablelist>
-	<varlistentry>
-	  <term>DocBook
-            <indexterm><primary>pre-supposed: DocBook</primary></indexterm>
-            <indexterm><primary>DocBook, pre-supposed</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Much of our documentation is written in DocBook XML, instructions
-            on installing and configuring the DocBook tools are below.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>TeX
-            <indexterm><primary>pre-supposed: TeX</primary></indexterm>
-            <indexterm><primary>TeX, pre-supposed</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>A decent TeX distribution is required if you want to
-            produce printable documentation.  We recomment teTeX,
-            which includes just about everything you need.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>Haddock
-            <indexterm><primary>Haddock</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Haddock is a Haskell documentation tool that we use
-	    for automatically generating documentation from the
-	    library source code.  It is an <literal>fptools</literal>
-	    project in itself.  To build documentation for the
-	    libraries (<literal>fptools/libraries</literal>) you
-	    should check out and build Haddock in
-	    <literal>fptools/haddock</literal>.  Haddock requires GHC
-	    to build.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-    </sect2>
-
-    <sect2>
-      <title>Installing the DocBook tools</title>
-
-      <sect3>
-	<title>Installing the DocBook tools on Linux</title>
-
-	<para>If you're on a recent RedHat (7.0+) or SuSE (8.1+) system,
-        you probably have working DocBook tools already installed. The
-        configure script should detect your setup and you're away.</para>
-
-	<para>If you don't have DocBook tools installed, and you are
-        using a system that can handle RPM packages, you can use <ulink
-        url="http://rpmfind.net/">Rpmfind.net</ulink> to find suitable
-        packages for your system. Search for the packages
-        <literal>docbook-dtd</literal>,
-        <literal>docbook-xsl-stylesheets</literal>,
-        <literal>libxslt</literal>,
-        <literal>libxml2</literal>,
-        <literal>fop</literal>,
-        <literal>xmltex</literal>, and
-        <literal>dvips</literal>.</para>
-      </sect3>
-    
-      <sect3>
-	<title>Installing DocBook on FreeBSD</title>
-
-	<para>On FreeBSD systems, the easiest way to get DocBook up
-        and running is to install it from the ports tree or a
-        pre-compiled package (packages are available from your local
-        FreeBSD mirror site).</para>
-
-	<para>To use the ports tree, do this:
-<screen>$ cd /usr/ports/textproc/docproj
-$ make install</screen>
-        This installs the FreeBSD documentation project tools, which
-        includes everything needed to format the GHC
-        documentation.</para>
-      </sect3>
-
-      <sect3>
-	<title>Installing from binaries on Windows</title>
-	
-	<para>Probably the fastest route to a working DocBook environment on
-	Windows is to install <ulink url="http://www.cygwin.com/">Cygwin</ulink>
-	with the complete <literal>Doc</literal> category. If you are using
-	<ulink url="http://www.mingw.org/">MinGW</ulink> for compilation, you
-	have to help <command>configure</command> a little bit: Set the
-	environment variables <envar>XmllintCmd</envar> and
-	<envar>XsltprocCmd</envar> to the paths of the Cygwin executables
-	<command>xmllint</command> and <command>xsltproc</command>,
-	respectively, and set <envar>fp_cv_dir_docbook_xsl</envar> to the path
-	of the directory where the XSL stylesheets are installed,
-	e.g. <filename>c:/cygwin/usr/share/docbook-xsl</filename>.
-        </para>
-
-	<para>If you want to build HTML Help, you have to install the
-        <ulink url="http://msdn.microsoft.com/library/default.asp?url=/library/en-us/htmlhelp/html/hworiHTMLHelpStartPage.asp">HTML Help SDK</ulink>,
-        too, and make sure that <command>hhc</command> is in your <envar>PATH</envar>.</para>
-      </sect3>
-
-    </sect2>
-
-    <sect2>
-      <title>Configuring the DocBook tools</title>
-
-      <para>Once the DocBook tools are installed, the configure script
-      will detect them and set up the build system accordingly. If you
-      have a system that isn't supported, let us know, and we'll try
-      to help.</para>
-    </sect2>
-
-    <sect2>
-      <title>Building the documentation</title>
-
-      <para>To build documentation in a certain format, you can
-      say, for example,</para>
-
-<screen>$ make html</screen>
-
-      <para>to build HTML documentation below the current directory.
-      The available formats are: <literal>dvi</literal>,
-      <literal>ps</literal>, <literal>pdf</literal>,
-      <literal>html</literal>, and <literal>rtf</literal>.  Note that
-      not all documentation can be built in all of these formats: HTML
-      documentation is generally supported everywhere, and DocBook
-      documentation might support the other formats (depending on what
-      other tools you have installed).</para>
-
-      <para>All of these targets are recursive; that is, saying
-      <literal>make html</literal> will make HTML docs for all the
-      documents recursively below the current directory.</para>
-
-      <para>Because there are many different formats that the DocBook
-      documentation can be generated in, you have to select which ones
-      you want by setting the <literal>XMLDocWays</literal> variable
-      to a list of them.  For example, in
-      <filename>build.mk</filename> you might have a line:</para>
-
-<screen>XMLDocWays = html ps</screen>
-
-      <para>This will cause the documentation to be built in the requested
-      formats as part of the main build (the default is not to build
-      any documentation at all).</para>
-    </sect2>
-
-    <sect2>
-      <title>Installing the documentation</title>
-
-      <para>To install the documentation, use:</para>
-
-<screen>$ make install-docs</screen>
-
-      <para>This will install the documentation into
-      <literal>$(datadir)</literal> (which defaults to
-      <literal>$(prefix)/share</literal>).  The exception is HTML
-      documentation, which goes into
-      <literal>$(datadir)/html</literal>, to keep things tidy.</para>
-
-      <para>Note that unless you set <literal>$(XMLDocWays)</literal>
-      to a list of formats, the <literal>install-docs</literal> target
-      won't do anything for DocBook XML documentation.</para>
-    </sect2>
-
-  </sect1>
-    
-
-  <sect1 id="sec-porting-ghc">
-    <title>Porting GHC</title>
-
-    <para>This section describes how to port GHC to a currenly
-    unsupported platform.  There are two distinct
-    possibilities:</para>
-
-    <itemizedlist>
-      <listitem>
-	<para>The hardware architecture for your system is already
-	supported by GHC, but you're running an OS that isn't
-	supported (or perhaps has been supported in the past, but
-	currently isn't).  This is the easiest type of porting job,
-	but it still requires some careful bootstrapping.  Proceed to
-	<xref linkend="sec-booting-from-hc"/>.</para>
-      </listitem>
-      
-      <listitem>
-	<para>Your system's hardware architecture isn't supported by
-	GHC.  This will be a more difficult port (though by comparison
-	perhaps not as difficult as porting gcc).  Proceed to <xref
-	linkend="unregisterised-porting"/>.</para>
-      </listitem>
-    </itemizedlist>
-    
-    <sect2 id="sec-booting-from-hc">
-      <title>Booting/porting from C (<filename>.hc</filename>) files</title>
-
-      <indexterm><primary>building GHC from .hc files</primary></indexterm>
-      <indexterm><primary>booting GHC from .hc files</primary></indexterm>
-      <indexterm><primary>porting GHC</primary></indexterm>
-
-      <para>Bootstrapping GHC on a system without GHC already
-      installed is achieved by taking the intermediate C files (known
-      as HC files) from another GHC compilation, compiling them using gcc to
-	get a working GHC.</para>
-
-      <para><emphasis>NOTE: GHC versions 5.xx were hard to bootstrap
-      from C.  We recommend using GHC 6.0.1 or
-      later.</emphasis></para>
-
-      <para>HC files are platform-dependent, so you have to get a set
-	that were generated on <emphasis>the same platform</emphasis>.  There
-	may be some supplied on the GHC download page, otherwise you'll have to
-	compile some up yourself, or start from
-	<emphasis>unregisterised</emphasis> HC files - see <xref
-	  linkend="unregisterised-porting"/>.</para>
-
-      <para>The following steps should result in a working GHC build
-      with full libraries:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para>Unpack the HC files on top of a fresh source tree
-          (make sure the source tree version matches the version of
-          the HC files <emphasis>exactly</emphasis>!).  This will
-          place matching <filename>.hc</filename> files next to the
-          corresponding Haskell source (<filename>.hs</filename> or
-          <filename>.lhs</filename>) in the compiler subdirectory
-          <filename>ghc/compiler</filename> and in the libraries
-          (subdirectories of 
-          <literal>libraries</literal>).</para>
-	</listitem>
-
-	<listitem>
-	  <para>The actual build process is fully automated by the
-          <filename>hc-build</filename> script located in the
-          <filename>distrib</filename> directory.  If you eventually
-          want to install GHC into the directory
-          <replaceable>dir</replaceable>, the following
-          command will execute the whole build process (it won't
-          install yet):</para>
-
-<screen>$ distrib/hc-build --prefix=<replaceable>dir</replaceable></screen>
-<indexterm><primary>--hc-build</primary></indexterm>
-
-	  <para>By default, the installation directory is
-          <filename>/usr/local</filename>.  If that is what you want,
-          you may omit the argument to <filename>hc-build</filename>.
-          Generally, any option given to <filename>hc-build</filename>
-          is passed through to the configuration script
-          <filename>configure</filename>.  If
-          <filename>hc-build</filename> successfully completes the
-          build process, you can install the resulting system, as
-          normal, with</para>
-
-<screen>$ make install</screen>
-	</listitem>
-      </itemizedlist>
-    </sect2>
-
-    <sect2 id="unregisterised-porting">
-      <title>Porting GHC to a new architecture</title>
-      
-      <para>The first step in porting to a new architecture is to get
-      an <firstterm>unregisterised</firstterm> build working.  An
-      unregisterised build is one that compiles via vanilla C only.
-      By contrast, a registerised build uses the following
-      architecture-specific hacks for speed:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para>Global register variables: certain abstract machine
-	  <quote>registers</quote> are mapped to real machine
-	  registers, depending on how many machine registers are
-	  available (see
-	  <filename>ghc/includes/MachRegs.h</filename>).</para>
-	</listitem>
-
-	<listitem>
-	  <para>Assembly-mangling: when compiling via C, we feed the
-	  assembly generated by gcc though a Perl script known as the
-	  <firstterm>mangler</firstterm> (see
-	  <filename>ghc/driver/mangler/ghc-asm.lprl</filename>).  The
-	  mangler rearranges the assembly to support tail-calls and
-	  various other optimisations.</para>
-	</listitem>
-      </itemizedlist>
-
-      <para>In an unregisterised build, neither of these hacks are
-      used &mdash; the idea is that the C code generated by the
-      compiler should compile using gcc only.  The lack of these
-      optimisations costs about a factor of two in performance, but
-      since unregisterised compilation is usually just a step on the
-      way to a full registerised port, we don't mind too much.</para>
-
-      <para>Notes on GHC portability in general: we've tried to stick
-      to writing portable code in most parts of the system, so it
-      should compile on any POSIXish system with gcc, but in our
-      experience most systems differ from the standards in one way or
-      another.  Deal with any problems as they arise - if you get
-      stuck, ask the experts on
-      <email>glasgow-haskell-users@haskell.org</email>.</para>
-	
-      <para>Lots of useful information about the innards of GHC is
-      available in the <ulink
-      url="http://www.cse.unsw.edu.au/~chak/haskell/ghc/comm/">GHC
-      Commentary</ulink>, which might be helpful if you run into some
-      code which needs tweaking for your system.</para>
-
-      <sect3>
-	<title>Cross-compiling to produce an unregisterised GHC</title>
-
-	<para>NOTE!  These instructions apply to GHC 6.4 and (hopefully)
-	  later.  If you need instructions for an earlier version of GHC, try
-	  to get hold of the version of this document that was current at the
-	  time.  It should be available from the appropriate download page on
-	  the <ulink
-	    url="http://www.haskell.org/ghc/">GHC&nbsp;homepage</ulink>.</para>  
-
-	<para>In this section, we explain how to bootstrap GHC on a
-	new platform, using unregisterised intermediate C files.  We
-	haven't put a great deal of effort into automating this
-	process, for two reasons: it is done very rarely, and the
-	process usually requires human intervention to cope with minor
-	porting issues anyway.</para>
-
-	<para>The following step-by-step instructions should result in
-	a fully working, albeit unregisterised, GHC.  Firstly, you
-	need a machine that already has a working GHC (we'll call this
-	the <firstterm>host</firstterm> machine), in order to
-	cross-compile the intermediate C files that we will use to
-	bootstrap the compiler on the <firstterm>target</firstterm>
-	machine.</para>
-
-	<itemizedlist>
-	  <listitem>
-	    <para>On the target machine:</para>
-
-	  <itemizedlist>
-	    <listitem>
-	      <para>Unpack a source tree (preferably a released
-	      version).  We will call the path to the root of this
-	      tree <replaceable>T</replaceable>.</para>
-	    </listitem>
-
-	    <listitem>
-<screen>$ cd <replaceable>T</replaceable>
-$ ./configure --enable-hc-boot --enable-hc-boot-unregisterised</screen>
-
-	      <para>You might need to update
-              <filename>configure.in</filename> to recognise the new
-              architecture, and re-generate
-              <filename>configure</filename> with
-              <literal>autoreconf</literal>.</para>
-	    </listitem>
-  
-	    <listitem>
-<screen>$ cd <replaceable>T</replaceable>/ghc/includes
-$ make</screen>
-	    </listitem>
-	  </itemizedlist>
-	  </listitem>
-
-	  <listitem>
-	    <para>On the host machine:</para>
-	      
-	  <itemizedlist>
-	    <listitem>
-	      <para>Unpack a source tree (same released version).  Call
-              this directory <replaceable>H</replaceable>.</para>
-	    </listitem>
- 
-	    <listitem>
-<screen>$ cd <replaceable>H</replaceable>
-$ ./configure</screen>
-	    </listitem>
-
-	    <listitem>
-	      <para>Create
-	      <filename><replaceable>H</replaceable>/mk/build.mk</filename>,
-	      with the following contents:</para>
-
-<programlisting>GhcUnregisterised = YES
-GhcLibHcOpts = -O -fvia-C -keep-hc-files
-GhcRtsHcOpts = -keep-hc-files
-GhcLibWays =
-SplitObjs = NO
-GhcWithNativeCodeGen = NO
-GhcWithInterpreter = NO
-GhcStage1HcOpts = -O
-GhcStage2HcOpts = -O -fvia-C -keep-hc-files
-SRC_HC_OPTS += -H32m
-GhcBootLibs = YES</programlisting>
-	    </listitem>
-
-	    <listitem>
-	      <para>Edit
-	      <filename><replaceable>H</replaceable>/mk/config.mk</filename>:</para>
-	      <itemizedlist>
-		<listitem>
-		  <para>change <literal>TARGETPLATFORM</literal>
-                  appropriately, and set the variables involving
-                  <literal>TARGET</literal> to the correct values for
-                  the target platform.  This step is necessary because
-                  currently <literal>configure</literal> doesn't cope
-                  with specifying different values for the
-                  <literal>--host</literal> and
-                  <literal>--target</literal> flags.</para>
-		</listitem>
-		<listitem>
-		  <para>copy <literal>LeadingUnderscore</literal>
-		  setting from target.</para>
-		</listitem>
-	      </itemizedlist>
-	    </listitem>
-
-	    <listitem>
-	      <para>Copy
-	      <filename><replaceable>T</replaceable>/ghc/includes/ghcautoconf.h</filename>, <filename><replaceable>T</replaceable>/ghc/includes/DerivedConstants.h</filename>, and <filename><replaceable>T</replaceable>/ghc/includes/GHCConstants.h</filename>
-	      to
-	      <filename><replaceable>H</replaceable>/ghc/includes</filename>.
-	      Note that we are building on the host machine, using the
-	      target machine's configuration files.  This
-	      is so that the intermediate C files generated here will
-	      be suitable for compiling on the target system.</para>
-	    </listitem>
-
-	      <listitem>
-		<para>Touch the generated configuration files, just to make
-		sure they don't get replaced during the build:</para>
-<screen>$ cd <filename><replaceable>H</replaceable></filename>/ghc/includes
-$ touch ghcautoconf.h DerivedConstants.h GHCConstants.h mkDerivedConstants.c
-$ touch mkDerivedConstantsHdr mkDerivedConstants.o mkGHCConstants mkGHCConstants.o</screen>
-
-		<para>Note: it has been reported that these files still get
-		  overwritten during the next stage.  We have installed a fix
-		  for this in GHC 6.4.2, but if you are building a version
-		  before that you need to watch out for these files getting
-		  overwritte by the <literal>Makefile</literal> in
-		  <literal>ghc/includes</literal>.  If your system supports
-		  it, you might be able to prevent it by making them
-		  immutable:</para>
-<screen>$ chflags uchg  ghc/includes/{ghcautoconf.h,DerivedConstants.h,GHCConstants.h}</screen>
-	      </listitem>
-
-	    <listitem>
-		<para>Now build the compiler:</para>
-<screen>$ cd <replaceable>H</replaceable>/glafp-utils &amp;&amp; make boot &amp;&amp; make
-$ cd <replaceable>H</replaceable>/ghc &amp;&amp; make boot &amp;&amp; make</screen>
-	      <para>Don't worry if the build falls over in the RTS, we
-              don't need the RTS yet.</para>
-	    </listitem>
-
-	    <listitem>
-<screen>$ cd <replaceable>H</replaceable>/libraries
-$ make boot &amp;&amp; make</screen>
-	    </listitem>
-
-	    <listitem>
-<screen>$ cd <replaceable>H</replaceable>/ghc/compiler
-$ make boot stage=2 &amp;&amp; make stage=2</screen>
-	    </listitem>
-
-	    <listitem>
-<screen>$ cd <replaceable>H</replaceable>/ghc/lib/compat
-$ make clean
-$ rm .depend
-$ make boot UseStage1=YES
-$ make -k UseStage1=YES EXTRA_HC_OPTS='-O -fvia-C -keep-hc-files'
-$ cd <replaceable>H</replaceable>/ghc/utils
-$ make clean
-$ make -k UseStage1=YES EXTRA_HC_OPTS='-O -fvia-C -keep-hc-files'</screen>
-	    </listitem>
-	    
-	    <listitem>
-<screen>$ cd <replaceable>H</replaceable>
-$ make hc-file-bundle Project=Ghc</screen>
-	    </listitem>
-
-	    <listitem>
-	      <para>copy
-	      <filename><replaceable>H</replaceable>/*-hc.tar.gz</filename>
-	      to <filename><replaceable>T</replaceable>/..</filename>.</para>
-	    </listitem>
-	  </itemizedlist>
-	  </listitem>
-
-	  <listitem>
-	    <para>On the target machine:</para>
-
-	    <para>At this stage we simply need to bootstrap a compiler
-	    from the intermediate C files we generated above.  The
-	    process of bootstrapping from C files is automated by the
-	    script in <literal>distrib/hc-build</literal>, and is
-	    described in <xref linkend="sec-booting-from-hc"/>.</para>
-
-<screen>$ ./distrib/hc-build --enable-hc-boot-unregisterised</screen>
-
-	    <para>However, since this is a bootstrap on a new machine,
-	    the automated process might not run to completion the
-	    first time.  For that reason, you might want to treat the
-	    <literal>hc-build</literal> script as a list of
-	    instructions to follow, rather than as a fully automated
-	    script.  This way you'll be able to restart the process
-	    part-way through if you need to fix anything on the
-	    way.</para>
-
-	    <para>Don't bother with running
-	    <literal>make&nbsp;install</literal> in the newly
-	    bootstrapped tree; just use the compiler in that tree to
-	    build a fresh compiler from scratch, this time without
-	    booting from C files.  Before doing this, you might want
-	    to check that the bootstrapped compiler is generating
-	    working binaries:</para>
-
-<screen>$ cat >hello.hs
-main = putStrLn "Hello World!\n"
-^D
-$ <replaceable>T</replaceable>/ghc/compiler/ghc-inplace hello.hs -o hello
-$ ./hello
-Hello World!</screen>
-
-	    <para>Once you have the unregisterised compiler up and
-	    running, you can use it to start a registerised port.  The
-	    following sections describe the various parts of the
-	    system that will need architecture-specific tweaks in
-	    order to get a registerised build going.</para>
-
-	  </listitem>
-	</itemizedlist>
-      </sect3>
-
-      <sect3>
-	<title>Porting the RTS</title>
-	
-	<para>The following files need architecture-specific code for a
-	registerised build:</para>
-
-	<variablelist>
-	  <varlistentry>
-	    <term><filename>ghc/includes/MachRegs.h</filename>
-	    <indexterm><primary><filename>MachRegs.h</filename></primary></indexterm>
-            </term>
-	    <listitem>
-	      <para>Defines the STG-register to machine-register
-	      mapping.  You need to know your platform's C calling
-	      convention, and which registers are generally available
-	      for mapping to global register variables.  There are
-	      plenty of useful comments in this file.</para>
-	    </listitem>
-	  </varlistentry>
-	  <varlistentry>
-	    <term><filename>ghc/includes/TailCalls.h</filename>
-	    <indexterm><primary><filename>TailCalls.h</filename></primary></indexterm>
-            </term>
-	    <listitem>
-	      <para>Macros that cooperate with the mangler (see <xref
-	      linkend="sec-mangler"/>) to make proper tail-calls
-	      work.</para>
-	    </listitem>
-	  </varlistentry>
-	  <varlistentry>
-	    <term><filename>ghc/rts/Adjustor.c</filename>
-	    <indexterm><primary><filename>Adjustor.c</filename></primary></indexterm>
-            </term>
-	    <listitem>
-	      <para>Support for
-	      <literal>foreign&nbsp;import&nbsp;"wrapper"</literal>
-	      (aka
-	      <literal>foreign&nbsp;export&nbsp;dynamic</literal>).
-	      Not essential for getting GHC bootstrapped, so this file
-	      can be deferred until later if necessary.</para>
-	    </listitem>
-	  </varlistentry>
-	  <varlistentry>
-	    <term><filename>ghc/rts/StgCRun.c</filename>
-	    <indexterm><primary><filename>StgCRun.c</filename></primary></indexterm>
-            </term>
-	    <listitem>
-	      <para>The little assembly layer between the C world and
-	      the Haskell world.  See the comments and code for the
-	      other architectures in this file for pointers.</para>
-	    </listitem>
-	  </varlistentry>
-	  <varlistentry>
-	    <term><filename>ghc/rts/MBlock.h</filename>
-              <indexterm><primary><filename>MBlock.h</filename></primary></indexterm>
-            </term>
-	    <term><filename>ghc/rts/MBlock.c</filename>
-              <indexterm><primary><filename>MBlock.c</filename></primary></indexterm>
-            </term>
-	    <listitem>
-	      <para>These files are really OS-specific rather than
-	      architecture-specific.  In <filename>MBlock.h</filename>
-	      is specified the absolute location at which the RTS
-	      should try to allocate memory on your platform (try to
-	      find an area which doesn't conflict with code or dynamic
-	      libraries).  In <filename>Mblock.c</filename> you might
-	      need to tweak the call to <literal>mmap()</literal> for
-	      your OS.</para>
-	    </listitem>
-	  </varlistentry>
-	</variablelist>
-      </sect3>
-
-      <sect3 id="sec-mangler">
-	<title>The mangler</title>
-	
-	<para>The mangler is an evil Perl-script
-	(<filename>ghc/driver/mangler/ghc-asm.lprl</filename>) that
-	rearranges the assembly code output from gcc to do two main
-	things:</para>
-
-	<itemizedlist>
-	  <listitem>
-	    <para>Remove function prologues and epilogues, and all
-	    movement of the C stack pointer.  This is to support
-	    tail-calls: every code block in Haskell code ends in an
-	    explicit jump, so we don't want the C-stack overflowing
-	    while we're jumping around between code blocks.</para>
-	  </listitem>
-	  <listitem>
-	    <para>Move the <firstterm>info table</firstterm> for a
-	    closure next to the entry code for that closure.  In
-	    unregisterised code, info tables contain a pointer to the
-	    entry code, but in registerised compilation we arrange
-	    that the info table is shoved right up against the entry
-	    code, and addressed backwards from the entry code pointer
-	    (this saves a word in the info table and an extra
-	    indirection when jumping to the closure entry
-	    code).</para>
-	  </listitem>
-	</itemizedlist>
-
-	<para>The mangler is abstracted to a certain extent over some
-	architecture-specific things such as the particular assembler
-	directives used to herald symbols.  Take a look at the
-	definitions for other architectures and use these as a
-	starting point.</para>
-      </sect3>
-
-      <sect3>
-	<title>The splitter</title>
-
-	<para>The splitter is another evil Perl script
-	(<filename>ghc/driver/split/ghc-split.lprl</filename>).  It
-	cooperates with the mangler to support object splitting.
-	Object splitting is what happens when the
-	<option>-split-objs</option> option is passed to GHC: the
-	object file is split into many smaller objects.  This feature
-	is used when building libraries, so that a program statically
-	linked against the library will pull in less of the
-	library.</para>
-
-	<para>The splitter has some platform-specific stuff; take a
-	look and tweak it for your system.</para>
-      </sect3>
-
-      <sect3>
-	<title>The native code generator</title>
-
-	<para>The native code generator isn't essential to getting a
-	registerised build going, but it's a desirable thing to have
-	because it can cut compilation times in half.  The native code
-	generator is described in some detail in the <ulink
-	url="http://www.cse.unsw.edu.au/~chak/haskell/ghc/comm/">GHC
-	commentary</ulink>.</para>
-      </sect3>
-
-      <sect3>
-	<title>GHCi</title>
-
-	<para>To support GHCi, you need to port the dynamic linker
-	(<filename>fptools/ghc/rts/Linker.c</filename>).  The linker
-	currently supports the ELF and PEi386 object file formats - if
-	your platform uses one of these then things will be
-	significantly easier.  The majority of Unix platforms use the
-	ELF format these days.  Even so, there are some
-	machine-specific parts of the ELF linker: for example, the
-	code for resolving particular relocation types is
-	machine-specific, so some porting of this code to your
-	architecture will probaly be necessary.</para>
-	
-	<para>If your system uses a different object file format, then
-	you have to write a linker &mdash; good luck!</para>
-      </sect3>
-    </sect2>
-
-  </sect1>
-
-<sect1 id="sec-build-pitfalls">
-<title>Known pitfalls in building Glasgow Haskell
-
-<indexterm><primary>problems, building</primary></indexterm>
-<indexterm><primary>pitfalls, in building</primary></indexterm>
-<indexterm><primary>building pitfalls</primary></indexterm></title>
-
-<para>
-WARNINGS about pitfalls and known &ldquo;problems&rdquo;:
-</para>
-
-<para>
-
-<orderedlist>
-<listitem>
-
-<para>
-One difficulty that comes up from time to time is running out of space
-in <literal>TMPDIR</literal>.  (It is impossible for the configuration stuff to
-compensate for the vagaries of different sysadmin approaches to temp
-space.)
-<indexterm><primary>tmp, running out of space in</primary></indexterm>
-
-The quickest way around it is <command>setenv TMPDIR /usr/tmp</command><indexterm><primary>TMPDIR</primary></indexterm> or
-even <command>setenv TMPDIR .</command> (or the equivalent incantation with your shell
-of choice).
-
-The best way around it is to say
-
-<programlisting>export TMPDIR=&#60;dir&#62;</programlisting>
-
-in your <filename>build.mk</filename> file.
-Then GHC and the other <literal>fptools</literal> programs will use the appropriate directory
-in all cases.
-
-
-</para>
-</listitem>
-<listitem>
-
-<para>
-In compiling some support-code bits, e.g., in <filename>ghc/rts/gmp</filename> and even
-in <filename>ghc/lib</filename>, you may get a few C-compiler warnings.  We think these
-are OK.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
-When compiling via C, you'll sometimes get &ldquo;warning: assignment from
-incompatible pointer type&rdquo; out of GCC.  Harmless.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
-Similarly, <command>ar</command>chiving warning messages like the following are not
-a problem:
-
-<screen>ar: filename GlaIOMonad__1_2s.o truncated to GlaIOMonad_
-ar: filename GlaIOMonad__2_2s.o truncated to GlaIOMonad_
-...</screen>
-
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- In compiling the compiler proper (in <filename>compiler/</filename>), you <emphasis>may</emphasis>
-get an &ldquo;Out of heap space&rdquo; error message.  These can vary with the
-vagaries of different systems, it seems.  The solution is simple:
-
-
-<itemizedlist>
-<listitem>
-
-<para>
- If you're compiling with GHC 4.00 or later, then the
-<emphasis>maximum</emphasis> heap size must have been reached.  This
-is somewhat unlikely, since the maximum is set to 64M by default.
-Anyway, you can raise it with the
-<option>-optCrts-M&lt;size&gt;</option> flag (add this flag to
-<constant>&lt;module&gt;&lowbar;HC&lowbar;OPTS</constant>
-<command>make</command> variable in the appropriate
-<filename>Makefile</filename>).
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- For GHC &#60; 4.00, add a suitable <option>-H</option> flag to the <filename>Makefile</filename>, as
-above.
-
-</para>
-</listitem>
-
-</itemizedlist>
-
-
-and try again: <command>gmake</command>.  (see <xref linkend="sec-suffix"/> for information about
-<constant>&lt;module&gt;&lowbar;HC&lowbar;OPTS</constant>.)
-
-Alternatively, just cut to the chase:
-
-<screen>$ cd ghc/compiler
-$ make EXTRA_HC_OPTS=-optCrts-M128M</screen>
-
-
-</para>
-</listitem>
-<listitem>
-
-<para>
-If you try to compile some Haskell, and you get errors from GCC about
-lots of things from <filename>/usr/include/math.h</filename>, then your GCC was
-mis-installed.  <command>fixincludes</command> wasn't run when it should've been.
-
-As <command>fixincludes</command> is now automagically run as part of GCC installation,
-this bug also suggests that you have an old GCC.
-
-
-</para>
-</listitem>
-<listitem>
-
-<para>
-You <emphasis>may</emphasis> need to re-<command>ranlib</command><indexterm><primary>ranlib</primary></indexterm> your libraries (on Sun4s).
-
-
-<screen>$ cd $(libdir)/ghc-x.xx/sparc-sun-sunos4
-$ foreach i ( `find . -name '*.a' -print` ) # or other-shell equiv...
-?    ranlib $i
-?    # or, on some machines: ar s $i
-? end</screen>
-
-
-We'd be interested to know if this is still necessary.
-
-
-</para>
-</listitem>
-<listitem>
-
-<para>
-GHC's sources go through <command>cpp</command> before being compiled, and <command>cpp</command> varies
-a bit from one Unix to another.  One particular gotcha is macro calls
-like this:
-
-
-<programlisting>SLIT("Hello, world")</programlisting>
-
-
-Some <command>cpp</command>s treat the comma inside the string as separating two macro
-arguments, so you get
-
-
-<screen>:731: macro `SLIT' used with too many (2) args</screen>
-
-
-Alas, <command>cpp</command> doesn't tell you the offending file!
-
-Workaround: don't put weird things in string args to <command>cpp</command> macros.
-</para>
-</listitem>
-
-</orderedlist>
-
-</para>
-
-</sect1>
-
-
-<sect1 id="platforms"><title>Platforms, scripts, and file names</title>
-<para>
-GHC is designed both to be built, and to run, on both Unix and Windows.  This flexibility
-gives rise to a good deal of brain-bending detail, which we have tried to collect in this chapter.
-</para>
-
-<sect2 id="cygwin-and-mingw"><title>Windows platforms: Cygwin, MSYS, and MinGW</title>
-
-<para> The build system is built around Unix-y makefiles.  Because it's not native,
-the Windows situation for building GHC is particularly confusing.  This section
-tries to clarify, and to establish terminology.</para>
-
-<sect3 id="ghc-mingw"><title>MinGW</title>
-
-<para> <ulink url="http://www.mingw.org">MinGW (Minimalist GNU for Windows)</ulink> 
-is a collection of header
-files and import libraries that allow one to use <command>gcc</command> and produce
-native Win32 programs that do not rely on any third-party DLLs. The
-current set of tools include GNU Compiler Collection (<command>gcc</command>), GNU Binary
-Utilities (Binutils), GNU debugger (Gdb), GNU make, and a assorted
-other utilities. 
-</para>
-
-<para> The down-side of MinGW is that the MinGW libraries do not support anything like the full
-Posix interface.  
-</para>
-</sect3>
-
-<sect3 id="ghc-cygwin"><title>Cygwin and MSYS</title>
-
-<para>You can't use the MinGW to <emphasis>build</emphasis> GHC, because MinGW doesn't have a shell,
-or the standard Unix commands such as <command>mv</command>, <command>rm</command>,
-<command>ls</command>, nor build-system stuff such as <command>make</command> and <command>darcs</command>.
-For that, there are two choices: <ulink url="http://www.cygwin.com">Cygwin</ulink> 
-and <ulink url="http://www.mingw.org/msys.shtml">MSYS</ulink>:
-
-<itemizedlist>
-<listitem><para>
-Cygwin comes with compilation tools (<command>gcc</command>, <command>ld</command> and so on), which
-compile code that has access to all of Posix.  The price is that the executables must be 
-dynamically linked with the Cygwin DLL, so that <emphasis>you cannot run a Cywin-compiled program on a machine
-that doesn't have Cygwin</emphasis>.  Worse, Cygwin is a moving target.  The name of the main DLL, <literal>cygwin1.dll</literal>
-does not change, but the implementation certainly does.  Even the interfaces to functions
-it exports seem to change occasionally. </para>
-</listitem>
-
-<listitem><para>
-MSYS is a fork of the Cygwin tree, so they
-are fundamentally similar.  However, MSYS is by design much smaller and simpler.  Access to the file system goes
-through fewer layers, so MSYS is quite a bit faster too.
-</para>
-
-<para>Furthermore, MSYS provides no compilation tools; it relies instead on the MinGW tools. These
-compile binaries that run with no DLL support, on any Win32 system.
-However, MSYS does come with all the make-system tools, such as <command>make</command>, <command>autoconf</command>, 
-<command>darcs</command>, <command>ssh</command> etc.  To get these, you have to download the 
-MsysDTK (Developer Tool Kit) package, as well as the base MSYS package.
-</para>
-<para>MSYS does have a DLL, but it's only used by MSYS commands (<command>sh</command>, <command>rm</command>, 
-<command>ssh</command> and so on),
-not by programs compiled under MSYS.
-</para></listitem>
-
-</itemizedlist>
-
-</para>
-</sect3>
-
-<sect3><title>Targeting MinGW</title>
-
-<para>We want GHC to compile programs that work on any Win32 system.  Hence:
-<itemizedlist>
-<listitem><para>
-GHC does invoke a C compiler, assembler, linker and so on, but we ensure that it only
-invokes the MinGW tools, not the Cygwin ones.  That means that the programs GHC compiles
-will work on any system, but it also means that the programs GHC compiles do not have access
-to all of Posix.  In particular, they cannot import the (Haskell) Posix 
-library; they have to do
-their input output using standard Haskell I/O libraries, or native Win32 bindings.</para>
-<para> We will call a GHC that targets MinGW in this way <emphasis>GHC-mingw</emphasis>.</para>
-</listitem>
-
-<listitem><para>
-To make the GHC distribution self-contained, the GHC distribution includes the MinGW <command>gcc</command>,
-<command>as</command>, <command>ld</command>, and a bunch of input/output libraries.  
-</para></listitem>
-</itemizedlist>
-So <emphasis>GHC targets MinGW</emphasis>, not Cygwin.
-It is in principle possible to build a version of GHC, <emphasis>GHC-cygwin</emphasis>, 
-that targets Cygwin instead.  The up-side of GHC-cygwin is
-that Haskell programs compiled by GHC-cygwin can import the (Haskell) Posix library.
-<emphasis>We do not support GHC-cygwin, however; it is beyond our resources.</emphasis>
-</para>
-
-<para>While GHC <emphasis>targets</emphasis> MinGW, that says nothing about 
-how GHC is <emphasis>built</emphasis>.  We use both MSYS and Cygwin as build environments for
-GHC; both work fine, though MSYS is rather lighter weight.</para>
-
-<para>In your build tree, you build a compiler called <command>ghc-inplace</command>.  It
-uses the <command>gcc</command> that you specify using the
-<option>--with-gcc</option> flag when you run
-<command>configure</command> (see below).
-The makefiles are careful to use <command>ghc-inplace</command> (not <command>gcc</command>)
-to compile any C files, so that it will in turn invoke the correct <command>gcc</command> rather that
-whatever one happens to be in your path.  However, the makefiles do use whatever <command>ld</command> 
-and <command>ar</command> happen to be in your path. This is a bit naughty, but (a) they are only
-used to glom together .o files into a bigger .o file, or a .a file, 
-so they don't ever get libraries (which would be bogus; they might be the wrong libraries), and (b)
-Cygwin and MinGW use the same .o file format.  So its ok.
-</para>
-</sect3>
-
-<sect3><title> File names </title>
-
-<para>Cygwin, MSYS, and the underlying Windows file system all understand file paths of form <literal>c:/tmp/foo</literal>.
-However:
-<itemizedlist>
-<listitem><para>
-MSYS programs understand <filename>/bin</filename>, <filename>/usr/bin</filename>, and map Windows's lettered drives as
-<filename>/c/tmp/foo</filename> etc.  The exact mount table is given in the doc subdirectory of the MSYS distribution.
-</para>
-<para> When it invokes a command, the MSYS shell sees whether the invoked binary lives in the MSYS <filename>/bin</filename>
-directory.  If so, it just invokes it.  If not, it assumes the program is no an MSYS program, and walks over the command-line
-arguments changing MSYS paths into native-compatible paths.  It does this inside sub-arguments and inside quotes. For example,
-if you invoke
-<programlisting>foogle -B/c/tmp/baz</programlisting>
-the MSYS shell will actually call <literal>foogle</literal> with argument <literal>-Bc:/tmp/baz</literal>.
-</para></listitem>
-
-<listitem><para>
-Cygwin programs have a more complicated mount table, and map the lettered drives as <filename>/cygdrive/c/tmp/foo</filename>.
-</para>
-<para>The Cygwin shell does no argument processing when invoking non-Cygwin programs.
-</para></listitem>
-</itemizedlist>
-</para>
-</sect3>
-
-<sect3><title>Crippled <command>ld</command></title>
-
-<para>
-It turns out that on both Cygwin and MSYS, the <command>ld</command> has a
-limit of 32kbytes on its command line.  Especially when using split object
-files, the make system can emit calls to <command>ld</command> with thousands
-of files on it.  Then you may see something like this:
-<programlisting>
-(cd Graphics/Rendering/OpenGL/GL/QueryUtils_split &amp;&amp; /mingw/bin/ld -r -x -o ../QueryUtils.o *.o)
-/bin/sh: /mingw/bin/ld: Invalid argument
-</programlisting>
-The solution is either to switch off object file splitting (set
-<option>SplitObjs</option> to <literal>NO</literal> in your
-<filename>build.mk</filename>),
-or to make the module smaller.
-</para>
-</sect3>
-
-<sect3><title>Host System vs Target System</title>
-
-<para>
-In the source code you'll find various ifdefs looking like:
-<programlisting>#ifdef mingw32_HOST_OS
-  ...blah blah...
-#endif</programlisting>
-and 
-<programlisting>#ifdef mingw32_TARGET_OS
-  ...blah blah...
-#endif</programlisting>
-These macros are set by the configure script (via the file config.h).
-Which is which?  The criterion is this.  In the ifdefs in GHC's source code:
-<itemizedlist>
-  <listitem>
-    <para>The "host" system is the one on which GHC itself will be run.</para>
-  </listitem>
-  <listitem>
-    <para>The "target" system is the one for which the program compiled by GHC will be run.</para>
-  </listitem>
-</itemizedlist>
-For a stage-2 compiler, in which GHCi is available, the "host" and "target" systems must be the same.
-So then it doesn't really matter whether you use the HOST_OS or TARGET_OS cpp macros.
-
-</para>
-</sect3>
-
-</sect2>
-
-<sect2><title>Wrapper scripts</title>
-
-<para>
-Many programs, including GHC itself and hsc2hs, need to find associated binaries and libraries.
-For <emphasis>installed</emphasis> programs, the strategy depends on the platform.  We'll use
-GHC itself as an example:
-<itemizedlist>
-  <listitem> <para>
-  On Unix, the command <command>ghc</command> is a shell script, generated by adding installation
-  paths to the front of the source file <filename>ghc.sh</filename>, 
-  that invokes the real binary, passing "-B<emphasis>path</emphasis>" as an argument to tell <command>ghc</command>
-  where to find its supporting files. 
-  </para> </listitem>
-
-  <listitem> <para>
-  On vanilla Windows, it turns out to be much harder to make reliable script to be run by the
-  native Windows shell <command>cmd</command> (e.g. limits on the length
-   of the command line).  So instead we invoke the GHC binary directly, with no -B flag.
-  GHC uses the Windows <literal>getExecDir</literal> function to find where the executable is,
-  and from that figures out where the supporting files are.
-  </para> </listitem>
-</itemizedlist>
-(You can find the layout of GHC's supporting files in the
-  section "Layout of installed files" of Section 2 of the GHC user guide.)
-</para>
-<para>
-Things work differently for <emphasis>in-place</emphasis> execution, where you want to
-execute a program that has just been built in a build tree. The difference is that the
-layout of the supporting files is different.
-In this case, whether on Windows or Unix, we always use a shell script. This works OK
-on Windows because the script is executed by MSYS or Cygwin, which don't have the
-shortcomings of the native Windows <command>cmd</command> shell.
-</para>
-
-</sect2>
-
-</sect1>
-
-<sect1 id="winbuild"><title>Instructions for building under Windows</title>
-
-<para>
-This section gives detailed instructions for how to build 
-GHC from source on your Windows machine. Similar instructions for
-installing and running GHC may be found in the user guide. In general,
-Win95/Win98 behave the same, and WinNT/Win2k behave the same.
-</para>
-<para>
-Make sure you read the preceding section on platforms (<xref linkend="platforms"/>)
-before reading section.
-You don't need Cygwin or MSYS to <emphasis>use</emphasis> GHC, 
-but you do need one or the other to <emphasis>build</emphasis> GHC.</para>
-
-
-<sect2 id="msys-install"><title>Installing and configuring MSYS</title>
-
-<para>
-MSYS is a lightweight alternative to Cygwin.  
-You don't need MSYS to <emphasis>use</emphasis> GHC, 
-but you do need it or Cygwin to <emphasis>build</emphasis> GHC.
-Here's how to install MSYS.
-<itemizedlist>
-<listitem><para>
-Go to <ulink url="http://www.mingw.org/download.shtml">http://www.mingw.org/download.shtml</ulink> and 
-download the following (of course, the version numbers will differ):
-<itemizedlist>
-  <listitem><para>The main MSYS package (binary is sufficient): <literal>MSYS-1.0.9.exe</literal>
-  </para></listitem>
-  <listitem><para>The MSYS developer's toolkit (binary is sufficient): <literal>msysDTK-1.0.1.exe</literal>.
-		    This provides <command>make</command>, <command>autoconf</command>, 
-		    <command>ssh</command> and probably more besides.
-  </para></listitem>
-</itemizedlist>
-Run both executables (in the order given above) to install them.  I put them in <literal>c:/msys</literal>
-</para></listitem>
-
-<listitem><para>
-Set the following environment variables
-<itemizedlist>
-   <listitem><para><literal>PATH</literal>: add <literal>c:/msys/1.0/bin</literal> and 
- 		    <literal>c:/msys/1.0/local/bin</literal>
- 		    to your path.  (Of course, the version number may differ.)
- 		    MSYS mounts the former as both <literal>/bin</literal> and 
- 		    <literal>/usr/bin</literal> and the latter as <literal>/usr/local/bin</literal>.
-  </para></listitem>
-
-  <listitem><para><literal>HOME</literal>: set to your home directory (e.g. <literal>c:/userid</literal>).
-  This is where, among other things, <command>ssh</command> will look for your <literal>.ssh</literal> directory.
-  </para></listitem>  
-
-  <listitem><para><literal>SHELL</literal>: set to <literal>c:/msys/1.0/bin/sh.exe</literal>
-  </para></listitem>
-
-  <listitem><para><literal>CVS_RSH</literal>: set to <literal>c:/msys/1.0/bin/ssh.exe</literal>.  Only necessary if
-	      you are using CVS.
-  </para></listitem>
-
-  <listitem><para><literal>MAKE_MODE</literal>: set to <literal>UNIX</literal>.  (I'm not certain this is necessary for MSYS.)
-  </para></listitem>
-
-</itemizedlist>
-</para></listitem>
-
-<listitem><para>
-Check that the <literal>CYGWIN</literal> environment variable is <emphasis>not</emphasis> set.  It's a bad bug
-that MSYS is affected by this, but if you have CYGWIN set to "ntsec ntea", which is right for Cygwin, it
-causes the MSYS <command>ssh</command> to bogusly fail complaining that your <filename>.ssh/identity</filename>
-file has too-liberal permissinos.
-</para></listitem>
-
-</itemizedlist>
-</para>
-<para>Here are some points to bear in mind when using MSYS:
-<itemizedlist>
-<listitem> <para> MSYS does some kind of special magic to binaries stored in 
-<filename>/bin</filename> and <filename>/usr/bin</filename>, which are by default both mapped
-to <filename>c:/msys/1.0/bin</filename> (assuming you installed MSYS in <filename>c:/msys</filename>).
-Do not put any other binaries (such as GHC or Alex) in this directory or its sub-directories: 
-they fail in mysterious ways.  However, it's fine to put other binaries in <filename>/usr/local/bin</filename>,
-which maps to <filename>c:/msys/1.0/local/bin</filename>.</para></listitem>
-
-<listitem> <para> MSYS seems to implement symbolic links by copying, so sharing is lost.
-</para></listitem>
-
-<listitem> <para>
-Win32 has a <command>find</command> command which is not the same as MSYS's find.
-You will probably discover that the Win32 <command>find</command> appears in your <constant>PATH</constant>
-before the MSYS one, because it's in the <emphasis>system</emphasis> <constant>PATH</constant> 
-environment variable, whereas you have probably modified the <emphasis>user</emphasis> <constant>PATH</constant> 
-variable.  You can always invoke <command>find</command> with an absolute path, or rename it.
-</para></listitem>
-
-<listitem> <para>
-MSYS comes with <command>bzip</command>, and MSYS's <command>tar</command>'s <literal>-j</literal> 
-will bunzip an archive (e.g. <literal>tar xvjf foo.tar.bz2</literal>).  Useful when you get a
-bzip'd dump.</para></listitem>
-
-</itemizedlist>
-</para>
-</sect2>
-
-<sect2 id="install-cygwin"><title>Installing and configuring Cygwin</title>
-
-<para> Install Cygwin from <ulink url="http://www.cygwin.com/">http://www.cygwin.com/</ulink>.
-The installation process is straightforward; we install it in
-<filename>c:/cygwin</filename>.</para>
-<para>
-You must install enough Cygwin <emphasis>packages</emphasis> to support
-building GHC.  If you miss out any of these, strange things will happen to you.   There are two ways to do this:
-<itemizedlist>
-<listitem><para>The direct, but laborious way is to 
-select all of the following packages in the installation dialogue:
-	      <command>cvs</command>, 
-	      <command>openssh</command>,
-	      <command>autoconf</command>,
-	      <command>binutils</command> (includes ld and (I think) ar),
-	      <command>gcc</command>,
-	      <command>flex</command>,
-	      <command>make</command>.
-To see thse packages, 
-click on the "View" button in the "Select Packages" 
-stage of Cygwin's installation dialogue, until the view says "Full".  The default view, which is
-"Category" isn't very helpful, and the "View" button is rather unobtrousive.
-</para>
-</listitem>
-
-<listitem><para>The clever way is to point the Cygwin installer at the
-<command>ghc-depends</command> package, which is kept at <ulink
-url="http://haskell.org/ghc/cygwin">http://haskell.org/ghc/cygwin</ulink>.
-When the Cygwin installer asks you to "Choose a Download Site", choose one of
-the
-offered mirror sites; and then type "http://haskell.org/ghc/cygwin" into the
-"User URL" box and click "Add"; now two sites are selected. (The Cygwin
-installer remembers this for next time.)
-Click "Next".</para>
-<para>In the "Select Packages" dialogue box that follows, click the "+" sign by
-"Devel", scroll down to the end of the "Devel" packages, and choose
-<command>ghc-depends</command>.
-The package <command>ghc-depends</command> will not actually install anything itself, 
-but forces additional packages to be added by the Cygwin installer.
-</para>
-</listitem>
-</itemizedlist>
-</para>
-
-<para> Now set the following user environment variables:
-<itemizedlist>
-
-<listitem><para> Add <filename>c:/cygwin/bin</filename> and <filename>c:/cygwin/usr/bin</filename> to your 
-<constant>PATH</constant></para></listitem>
-
-<listitem>
-<para>
-Set <constant>MAKE_MODE</constant> to <literal>UNIX</literal>. If you
-don't do this you get very weird messages when you type
-<command>make</command>, such as:
-<screen>/c: /c: No such file or directory</screen>
-</para>
-</listitem>
-
-<listitem><para> Set <constant>SHELL</constant> to
-<filename>c:/cygwin/bin/bash</filename>. When you invoke a shell in Emacs, this
-<constant>SHELL</constant> is what you get.
-</para></listitem>
-
-<listitem><para> Set <constant>HOME</constant> to point to your 
-home directory.  This is where, for example,
-<command>bash</command> will look for your <filename>.bashrc</filename>
-file.  Ditto <command>emacs</command> looking for <filename>.emacsrc</filename>
-</para></listitem>
-</itemizedlist>
-</para>
-
-<para>Here are some things to be aware of when using Cygwin:
-<itemizedlist>
-<listitem> <para>Cygwin doesn't deal well with filenames that include
-spaces. "<filename>Program Files</filename>" and "<filename>Local files</filename>" are
-common gotchas.
-</para></listitem>
-
-<listitem> <para> Cygwin implements a symbolic link as a text file with some
-magical text in it.  So other programs that don't use Cygwin's
-I/O libraries won't recognise such files as symlinks.  
-In particular, programs compiled by GHC are meant to be runnable
-without having Cygwin, so they don't use the Cygwin library, so
-they don't recognise symlinks.
-</para></listitem>
-
-<listitem> <para>
-See the notes in <xref linkend="msys-install"/> about <command>find</command> and <command>bzip</command>,
-which apply to Cygwin too.
-</para></listitem>
-
-<listitem>
-<para>
-Some script files used in the make system start with "<command>#!/bin/perl</command>",
-(and similarly for <command>sh</command>).  Notice the hardwired path!
-So you need to ensure that your <filename>/bin</filename> directory has at least
-<command>sh</command>, <command>perl</command>, and <command>cat</command> in it.
-All these come in Cygwin's <filename>bin</filename> directory, which you probably have
-installed as <filename>c:/cygwin/bin</filename>.  By default Cygwin mounts "<filename>/</filename>" as
-<filename>c:/cygwin</filename>, so if you just take the defaults it'll all work ok.
-(You can discover where your Cygwin
-root directory <filename>/</filename> is by typing <command>mount</command>.)
-Provided <filename>/bin</filename> points to the Cygwin <filename>bin</filename>
-directory, there's no need to copy anything.  If not, copy these binaries from the <filename>cygwin/bin</filename>
-directory (after fixing the <filename>sh.exe</filename> stuff mentioned in the previous bullet).
-</para>
-</listitem>
-
-<listitem>
-<para>
-By default, cygwin provides the command shell <filename>ash</filename>
-as <filename>sh.exe</filename>.   It seems to be fine now, but in the past we
-saw build-system problems that turned out to be due to bugs in <filename>ash</filename>
-(to do with quoting and length of command lines).  On the other hand <filename>bash</filename> seems
-to be rock solid.
-If this happens to you (which it shouldn't), in <filename>cygwin/bin</filename>
-remove the supplied <filename>sh.exe</filename> (or rename it as <filename>ash.exe</filename>),
-and copy <filename>bash.exe</filename> to  <filename>sh.exe</filename>.
-You'll need to do this in Windows Explorer or the Windows <command>cmd</command> shell, because
-you can't rename a running program!
-</para>
-</listitem>
-</itemizedlist>
-</para>
-
-</sect2>
-
-
-<sect2 id="configure-ssh"><title>Configuring SSH</title>
-
-<para><command>ssh</command> comes with both Cygwin and MSYS. 
-(Cygwin note: you need to ask for package <command>openssh</command> (not ssh)
-in the Cygwin list of packages; or use the <command>ghc-depends</command>
-package -- see <xref linkend="install-cygwin"/>.)</para>
-
-<para>There are several strange things about <command>ssh</command> on Windows that you need to know.
-<itemizedlist>
-<listitem>
-<para>
-       The programs <command>ssh-keygen1</command>, <command>ssh1</command>, and <command>cvs</command>,
-       seem to lock up <command>bash</command> entirely if they try to get user input (e.g. if
-       they ask for a password).  To solve this, start up <filename>cmd.exe</filename> 
-       and run it as follows:
-<screen>c:\tmp> set CYGWIN32=tty
-c:\tmp> c:/user/local/bin/ssh-keygen1</screen> </para>
-</listitem>
-
-<listitem><para> (Cygwin-only problem, I think.)
-<command>ssh</command> needs to access your directory <filename>.ssh</filename>, in your home directory.  
-To determine your home directory <command>ssh</command> first looks in 
-<filename>c:/cygwin/etc/passwd</filename> (or wherever you have Cygwin installed).  If there's an entry
-there with your userid, it'll use that entry to determine your home directory, <emphasis>ignoring
-the setting of the environment variable $HOME</emphasis>.  If the home directory is
-bogus, <command>ssh</command> fails horribly.   The best way to see what is going on is to say
-<screen>ssh -v cvs.haskell.org</screen>
-which makes <command>ssh</command> print out information about its activity.
-</para>
-<para> You can fix this problem, either by correcting the home-directory field in 
-<filename>c:/cygwin/etc/passwd</filename>, or by simply deleting the entire entry for your userid. If
-you do that, <command>ssh</command> uses the $HOME environment variable instead.
-</para>
-
-</listitem>
-
-<listitem>
-	    <para>To protect your
-            <literal>.ssh</literal> from access by anyone else,
-            right-click your <literal>.ssh</literal> directory, and
-            select <literal>Properties</literal>.  If you are not on
-            the access control list, add yourself, and give yourself
-            full permissions (the second panel).  Remove everyone else
-            from the access control list.  Don't leave them there but
-            deny them access, because 'they' may be a list that
-            includes you!</para>
-</listitem>
-
-<listitem>
-	    <para>In fact <command>ssh</command> 3.6.1 now seems to <emphasis>require</emphasis>
-	      you to have Unix permissions 600 (read/write for owner only) 
-	      on the <literal>.ssh/identity</literal> file, else it 
-	      bombs out.  For your local C drive, it seems that <literal>chmod 600 identity</literal> works,
-	      but on Windows NT/XP, it doesn't work on a network drive (exact dteails obscure).  
-	      The solution seems to be to set the $CYGWIN environment
-	      variable to "<literal>ntsec neta</literal>".  The $CYGWIN environment variable is discussed
-	      in <ulink url="http://cygwin.com/cygwin-ug-net/using-cygwinenv.html">the Cygwin User's Guide</ulink>,
-	      and there are more details in <ulink url="http://cygwin.com/faq/faq_4.html#SEC44">the Cygwin FAQ</ulink>.
-	      </para>
-</listitem>
-</itemizedlist>
-</para>
-</sect2>
-
-<sect2><title>Other things you need to install</title>
-
-<para>You have to install the following other things to build GHC, listed below.</para>
-
-<para>On Windows you often install executables in directories with spaces, such as 
-"<filename>Program Files</filename>". However, the <literal>make</literal> system for fptools doesn't 
-deal with this situation (it'd have to do more quoting of binaries), so you are strongly advised
-to put binaries for all tools in places with no spaces in their path.
-On both MSYS and Cygwin, it's perfectly OK to install such programs in the standard Unixy places,
-<filename>/usr/local/bin</filename> and <filename>/usr/local/lib</filename>.  But it doesn't matter,
-provided they are in your path.
-<itemizedlist>
-<listitem>
-<para>
-Install an executable GHC, from <ulink url="http://www.haskell.org/ghc">http://www.haskell.org/ghc</ulink>.
-This is what you will use to compile GHC.  Add it in your
-<constant>PATH</constant>: the installer tells you the path element
-you need to add upon completion.
-</para>
-</listitem>
-
-<listitem>
-<para>
-Install an executable Happy, from <ulink url="http://www.haskell.org/happy">http://www.haskell.org/happy</ulink>.
-Happy is a parser generator used to compile the Haskell grammar.  Under MSYS or Cygwin you can easily
-build it from the source distribution using
-<screen>$ ./configure
-$ make
-$ make install</screen>
-This should install it in <filename>/usr/local/bin</filename> (which maps to <filename>c:/msys/1.0/local/bin</filename>
-on MSYS).
-Make sure the installation directory is in your
-<constant>PATH</constant>.
-</para>
-</listitem>
-
-	  <listitem>
-	    <para>Install an executable Alex.  This can be done by building from the
-	    source distribution in the same way as Happy.  Sources are
-	    available from <ulink
-	    url="http://www.haskell.org/alex">http://www.haskell.org/alex</ulink>.</para>
-	  </listitem>
-
-<listitem>
-<para>GHC uses the <emphasis>mingw</emphasis> C compiler to
-generate code, so you have to install that (see <xref linkend="cygwin-and-mingw"/>). 
-Just pick up a mingw bundle at
-<ulink url="http://www.mingw.org/">http://www.mingw.org/</ulink>.
-We install it in <filename>c:/mingw</filename>.
-</para>
-
-<para><emphasis>On MSYS</emphasis>, add <literal>c:/mingw/bin</literal> to your PATH. MSYS does not provide <command>gcc</command>,
-<command>ld</command>, <command>ar</command>, and so on, because it just uses the MinGW ones.  So you need them
-in your path.
-</para>
-
-<para><emphasis>On Cygwin, do not</emphasis> add any of the <emphasis>mingw</emphasis> binaries to your  path.
-They are only going to get used by explicit access (via the --with-gcc flag you
-give to <command>configure</command> later).  If you do add them to your path
-you are likely to get into a mess because their names overlap with Cygwin
-binaries.
-On the other hand, you <emphasis>do</emphasis> need <command>ld</command>, <command>ar</command>
-(and perhaps one or two other things) in your path.  The Cygwin ones are fine,
-but you must have them; hence needing the  Cygwin binutils package.
-</para>
-</listitem>
-
-
-<listitem>
-<para>We use <command>emacs</command> a lot, so we install that too.
-When you are in <filename>fptools/ghc/compiler</filename>, you can use
-"<literal>make tags</literal>" to make a TAGS file for emacs.  That uses the utility
-<filename>fptools/ghc/utils/hasktags/hasktags</filename>, so you need to make that first.
-The most convenient way to do this is by going <literal>make boot</literal> in <filename>fptools/ghc</filename>.
-The <literal>make tags</literal> command also uses <command>etags</command>, which comes with <command>emacs</command>,
-so you will need to add <filename>emacs/bin</filename> to your <literal>PATH</literal>.
-</para>
-</listitem>
-
-	  <listitem>
-	    <para>You might want to install GLUT in your MSYS/Cygwin
-	      installation, otherwise the GLUT package will not be built with
-	      GHC.</para>
-	  </listitem>
-
-<listitem>
-<para> Finally, check out a copy of GHC sources from
-the darcs repository, following the instructions at <ulink url="http://hackage.haskell.org/trac/ghc/wiki/GhcDarcs" />.</para>
-</listitem>
-</itemizedlist>
-</para>
-</sect2>
-
-<sect2><title>Building GHC</title>
-
-<para>OK!  
-Now go read the documentation above on building from source (<xref linkend="sec-building-from-source"/>); 
-the bullets below only tell
-you about Windows-specific wrinkles.</para>
-<itemizedlist>
-<listitem>
-<para>
-If you used <command>autoconf</command> instead of <command>autoreconf</command>,
-you'll get an error when you run <filename>./configure</filename>:
-<screen>
-...lots of stuff...
-creating mk/config.h
-mk/config.h is unchanged
-configuring in ghc
-running /bin/sh ./configure  --cache-file=.././config.cache --srcdir=.
-./configure: ./configure: No such file or directory
-configure: error: ./configure failed for ghc</screen>
-</para>
-</listitem>
-
-<listitem> <para><command>autoreconf</command> seems to create the file <filename>configure</filename>
-read-only.  So if you need to run autoreconf again (which I sometimes do for safety's sake),
-you get
-<screen>/usr/bin/autoconf: cannot create configure: permission denied</screen>
-Solution: delete <filename>configure</filename> first.
-</para></listitem>
-
-<listitem>
-  <para> 
-    After <command>autoreconf</command> run <command>./configure</command> in
-    <filename>fptools/</filename> thus:
-
-<screen>$ ./configure --host=i386-unknown-mingw32 --with-gcc=c:/mingw/bin/gcc</screen>
-This is the point at which you specify that you are building GHC-mingw
-(see <xref linkend="ghc-mingw"/>). </para>
-
-<para> Both these options are important! It's possible to get into
-trouble using the wrong C compiler!</para>
-<para>
-Furthermore, it's <emphasis>very important</emphasis> that you specify a 
-full MinGW path for <command>gcc</command>, not a Cygwin path, because GHC (which
-uses this path to invoke <command>gcc</command>) is a MinGW program and won't
-understand a Cygwin path.  For example, if you 
-say <literal>--with-gcc=/mingw/bin/gcc</literal>, it'll be interpreted as
-<filename>/cygdrive/c/mingw/bin/gcc</filename>, and GHC will fail the first
-time it tries to invoke it.   Worse, the failure comes with
-no error message whatsoever.  GHC simply fails silently when first invoked, 
-typically leaving you with this:
-<screen>make[4]: Leaving directory `/cygdrive/e/fptools-stage1/ghc/rts/gmp'
-../../ghc/compiler/ghc-inplace -optc-mno-cygwin -optc-O 
-  -optc-Wall -optc-W -optc-Wstrict-prototypes -optc-Wmissing-prototypes 
-  -optc-Wmissing-declarations -optc-Winline -optc-Waggregate-return 
-  -optc-Wbad-function-cast -optc-Wcast-align -optc-I../includes 
-  -optc-I. -optc-Iparallel -optc-DCOMPILING_RTS 
-  -optc-fomit-frame-pointer -O2 -static 
-  -package-name rts -O -dcore-lint -c Adjustor.c -o Adjustor.o
-make[2]: *** [Adjustor.o] Error 1
-make[1]: *** [all] Error 1
-make[1]: Leaving directory `/cygdrive/e/fptools-stage1/ghc'
-make: *** [all] Error 1</screen>
-Be warned!
-</para>
-
-<para>
-If you want to build GHC-cygwin (<xref linkend="ghc-cygwin"/>)
-you'll have to do something more like:
-<screen>$ ./configure --with-gcc=...the Cygwin gcc...</screen>
-</para>
-</listitem>
-
-<listitem><para>
-If you are paranoid, delete <filename>config.cache</filename> if it exists.
-This file occasionally remembers out-of-date configuration information, which 
-can be really confusing.
-</para>
-</listitem>
-
-<listitem><para> You almost certainly want to set
-<programlisting>SplitObjs = NO</programlisting>
-in your <filename>build.mk</filename> configuration file (see <xref linkend="sec-build-config"/>).
-This tells the build system not to split each library into a myriad of little object files, one
-for each function.  Doing so reduces binary sizes for statically-linked binaries, but on Windows
-it dramatically increases the time taken to build the libraries in the first place.
-</para>
-</listitem>
-
-<listitem><para> Do not attempt to build the documentation.
-It needs all kinds of wierd Jade stuff that we haven't worked out for
-Win32.</para></listitem>
-</itemizedlist>
-</sect2>
-
-
-<sect2><title>A Windows build log using Cygwin</title>
-
-<para>Here is a complete, from-scratch, log of all you need to build GHC using
-Cygwin, kindly provided by Claus Reinke.  It does not discuss alternative
-choices, but it gives a single path that works.</para>
-<programlisting>- Install some editor (vim, emacs, whatever)
-
-- Install cygwin (http://www.cygwin.com)
-    ; i used 1.5.16-1, installed in c:\cygwin
-  - run 'setup.exe'
-    Choose a Download Source:
-	select 'download from internet';
-    Select Root Install Directory:
-	root dir: c:\cygwin; 
-	install for: all users;
-	default file type: unix
-    Select Local Package Directory
-	choose a spare temporary home
-    Select Your Internet Connection
-	Use IE5 settings
-    Choose a Download Site
-	Choose your preferred main mirror and
-        Add 'http://www.haskell.org/ghc/cygwin'
-    Select Packages
-	In addition to 'Base' (default install), 
-	select 'Devel->ghc-depends'
-
-- Install mingw (http://www.mingw.org/)
-    ; i used MinGW-3.1.0-1.exe
-    ; installed in c:\mingw
-  - you probably want to add GLUT 
-    ; (http://www.xmission.com/~nate/glut.html)
-    ; i used glut-3.7.3-mingw32.tar
-
-- Get recent binary snapshot of ghc-6.4.1 for mingw 
-    ; (http://www.haskell.org/ghc/dist/stable/dist/)
-  - unpack in c:/ghc
-  - add C:\ghc\ghc-6.4.1\bin to %PATH%
-    (Start->Control Panel->System->Advanced->Environment Variables)
-
-- Get darcs version of ghc
-    ; also, subscribe to cvs-all@haskell.org, or follow the mailing list
-    ; archive, in case you checkout a version with problems
-    ; http://www.haskell.org//pipermail/cvs-all/
-  - mkdir c:/fptools; cd c:/fptools 
-    ; (or whereever you want your darcs tree to be)
-  - darcs get http://darcs.haskell.org/ghc
-  - cd ghc
-  - chmod +x darcs-all
-  - ./darcs-all get
-
-- Build ghc, using cygwin and mingw, targetting mingw
-  - export PATH=/cygdrive/c/ghc/ghc-6.4.1:$PATH
-    ; for haddock, alex, happy (*)
-  - export PATH=/cygdrive/c/mingw/bin:$PATH
-    ; without, we pick up some cygwin tools at best!
-  - cd c:/fptools/fptools
-    ; (if you aren't there already)
-  - autoreconf
-  - ./configure --host=i386-unknown-mingw32 --with-gcc=C:/Mingw/bin/gcc.exe
-    ; we use cygwin, but build for windows
-  - cp mk/build.mk.sample mk/build.mk
-  - in mk/build.mk:
-    add line:       SplitObjs = NO
-	(MSYS seems slow when there are zillions of object files)
-    uncomment line: BuildFlavour = perf
-	(or BuildFlavour = devel, if you are doing development)
-    add line:       BIN_DIST=1
-  - make 2>&amp;1 | tee make.log
-    ; always useful to have a log around
-
-- Package up binary distribution
-  - make binary-dist Project=Ghc 2>&amp;1 | tee make-bin-dist.log
-    ; always useful to have a log around
-  - cd ghc-6.5
-  - chmod +x ../distrib/prep-bin-dist-mingw
-    ; if you're happy with the script's contents (*)
-  - ../distrib/prep-bin-dist-mingw
-    ; then tar up, unpack where wanted, and enjoy</programlisting>
-</sect2>
-</sect1>
-
-<index/>
-
-</article>
diff --git a/ghc/docs/comm/exts/ndp.html b/ghc/docs/comm/exts/ndp.html
deleted file mode 100644
index 0c94c3960b..0000000000
--- a/ghc/docs/comm/exts/ndp.html
+++ /dev/null
@@ -1,360 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Parallel Arrays</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Parallel Arrays</h1>
-    <p>
-      This section describes an experimental extension by high-performance
-      arrays, which comprises special syntax for array types and array
-      comprehensions, a set of optimising program transformations, and a set
-      of special purpose libraries.  The extension is currently only partially
-      implemented, but the development will be tracked here.
-    <p>
-      Parallel arrays originally got their name from the aim to provide an
-      architecture-independent programming model for a range of parallel
-      computers.  However, since experiments showed that the approach is also
-      worthwhile for sequential array code, the emphasis has shifted to their
-      parallel evaluation semantics: As soon as any element in a parallel
-      array is demanded, all the other elements are evaluated, too.  This
-      makes parallel arrays more strict than <a
-      href="http://haskell.org/onlinelibrary/array.html">standard Haskell 98
-      arrays</a>, but also opens the door for a loop-based implementation
-      strategy that leads to significantly more efficient code.
-    <p>
-      The programming model as well as the use of the <em>flattening
-      transformation</em>, which is central to the approach, has its origin in
-      the programming language <a
-      href="http://www.cs.cmu.edu/~scandal/nesl.html">Nesl</a>.
-
-    <h2>More Sugar: Special Syntax for Array Comprehensions</h2>
-    <p>
-      The option <code>-fparr</code>, which is a dynamic hsc option that can
-      be reversed with <code>-fno-parr</code>, enables special syntax for
-      parallel arrays, which is not essential to using parallel arrays, but
-      makes for significantly more concise programs.  The switch works by
-      making the lexical analyser (located in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/parser/Lex.lhs"><code>Lex.lhs</code></a>) 
-      recognise the tokens <code>[:</code> and <code>:]</code>.   Given that
-      the additional productions in the parser (located in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/parser/Parser.y"><code>Parser.y</code></a>) 
-      cannot be triggered without the lexer generating the necessary tokens,
-      there is no need to alter the behaviour of the parser.
-    <p>
-      The following additional syntax is accepted (the non-terminals are those
-      from the <a href="http://haskell.org/onlinereport/">Haskell 98 language
-      definition</a>):
-    <p>
-      <blockquote><pre>
-atype -> '[:' type ':]				     (parallel array type)
-
-aexp  -> '[:' exp1 ',' ... ',' expk ':]'             (explicit array, k >= 0)
-      |  '[:' exp1 [',' exp2] '..' exp3 ':]'	     (arithmetic array sequence)
-      |  '[:' exp '|' quals1 '|' ... '|' qualsn ':]' (array comprehension, n >= 1)
-
-quals -> qual1 ',' ... ',' qualn	             (qualifier list, n >= 1)
-
-apat  -> '[:' pat1 ',' ... ',' patk ':]'	     (array pattern, k >= 0)
-</pre>
-    </blockquote>
-    <p>
-      Moreover, the extended comprehension syntax that allows for <em>parallel
-      qualifiers</em> (i.e., qualifiers separated by "<code>|</code>") is also
-      supported in list comprehensions.  In general, the similarity to the
-      special syntax for list is obvious.  The two main differences are that
-      (a) arithmetic array sequences are always finite and (b)
-      <code>[::]</code> is not treated as a constructor in expressions and
-      patterns, but rather as a special case of the explicit array syntax.
-      The former is a simple consequence of the parallel evaluation semantics
-      of parallel arrays and the latter is due to arrays not being a
-      constructor-based data type.
-    <p>
-      As a naming convention, types and functions that are concerned with
-      parallel arrays usually contain the string <code>parr</code> or
-      <code>PArr</code> (often as a prefix), and where corresponding types or
-      functions for handling lists exist, the name is identical, except for
-      containing the substring <code>parr</code> instead of <code>list</code>
-      (possibly in caps).
-    <p>
-      The following implications are worth noting explicitly:
-    <ul>
-      <li>As the value and pattern <code>[::]</code> is an empty explicit
-	parallel array (i.e., something of the form <code>ExplicitPArr ty
-	[]</code> in the AST).  This is in contrast to lists, which use the
-	nil-constructor instead.  In the case of parallel arrays, using a
-	constructor would be rather awkward, as it is not a constructor-based
-	type. (This becomes rather clear in the desugarer.)
-      <li>As a consequence, array patterns have the general form <code>[:p1,
-	  p2, ..., pn:]</code>, where <code>n</code> >= 0.  Thus, two array
-	patterns overlap iff they have the same length -- an important property
-	for the pattern matching compiler.
-    </ul>
-
-    <h2>Prelude Support for Parallel Arrays</h2>
-    <p>
-      The Prelude module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/lib/std/PrelPArr.lhs"><code>PrelPArr</code></a>
-      defines the standard operations and their types on parallel arrays and
-      provides a basic implementation based on boxed arrays.  The interface of
-      <code>PrelPArr</code> is oriented by H98's <code>PrelList</code>, but
-      leaving out all functions that require infinite structures and adding
-      frequently needed array operations, such as permutations.  Parallel
-      arrays are quite unqiue in that they use an entirely different
-      representation as soon as the flattening transformation is activated,
-      which is described further below.  In particular, <code>PrelPArr</code>
-      defines the type <code>[::]</code> and operations to create, process,
-      and inspect parallel arrays.  The type as well as the names of some of
-      the operations are also hardwired in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/TysWiredIn.lhs"><code>TysWiredIn</code></a>
-      (see the definition of <code>parrTyCon</code> in this module) and <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/PrelNames.lhs"><code>PrelNames</code></a>.
-      This is again very much like the case of lists, where the type is
-      defined in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/lib/std/PrelBase.lhs"><code>PrelBase</code></a>
-      and similarly wired in; however, for lists the entirely
-      constructor-based definition is exposed to user programs, which is not
-      the case for parallel arrays.
-
-    <h2>Desugaring Parallel Arrays</h2>
-    <p>
-      The parallel array extension requires the desugarer to replace all
-      occurrences of (1) explicit parallel arrays, (2) array patterns, and (3)
-      array comprehensions by a suitable combination of invocations of
-      operations defined in <code>PrelPArr</code>.
-
-    <h4>Explicit Parallel Arrays</h4>
-    <p>
-      These are by far the simplest to remove.  We simply replace every
-      occurrence of <code>[:<i>e<sub>1</sub></i>, ...,
-      <i>e<sub>n</sub></i>:]</code> by
-    <blockquote>
-      <code>
-	toP [<i>e<sub>1</sub></i>, ..., <i>e<sub>n</sub></i>]
-      </code>
-    </blockquote>
-    <p>
-      i.e., we build a list of the array elements, which is, then, converted
-      into a parallel array.
-
-    <h4>Parallel Array Patterns</h4>
-    <p>
-      Array patterns are much more tricky as element positions may contain
-      further patterns and the <a
-      href="../the-beast/desugar.html#patmat">pattern matching compiler</a>
-      requires us to flatten all those out.  But before we turn to the gory
-      details, here first the basic idea: A flat array pattern matches exactly
-      iff it's length corresponds to the length of the matched array.  Hence,
-      if we have a set of flat array patterns matching an array value
-      <code>a</code>, it suffices to generate a Core <code>case</code>
-      expression that scrutinises <code>lengthP a</code> and has one
-      alternative for every length of array occuring in one of the patterns.
-      Moreover, there needs to be a default case catching all other array
-      lengths.  In each alternative, array indexing (i.e., the functions
-      <code>!:</code>) is used to bind array elements to the corresponding
-      pattern variables.  This sounds easy enough and is essentially what the
-      parallel array equation of the function <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsUtils.lhs"><code>DsUtils</code></a><code>.mkCoAlgCaseMatchResult</code>
-      does.
-    <p>
-      Unfortunately, however, the pattern matching compiler expects that it
-      can turn (almost) any pattern into variable patterns, literals, or
-      constructor applications by way of the functions <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/Match.lhs"><code>Match</code></a><code>.tidy1</code>.
-      And to make matters worse, some weird machinery in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/Check.lhs"><code>Check</code></a> 
-      insists on being able to reverse the process (essentially to pretty
-      print patterns in warnings for incomplete or overlapping patterns).
-    <p>
-      The solution to this is an (unlimited) set of <em>fake</em> constructors
-      for parallel arrays, courtesy of <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/TysWiredIn.lhs"><code>TysWiredIn</code></a><code>.parrFakeCon</code>.  
-      In other words, any pattern of the form <code>[:<i>p<sub>1</sub></i>,
-      ..., <i>p<sub>n</sub></i>:]</code> is transformed into 
-    <blockquote>
-      <code>
-	MkPArray<i>n</i> <i>p<sub>1</sub></i> ... <i>p<sub>n</sub></i>
-      </code>
-    </blockquote>
-    <p>
-      by <code>Match.tidy1</code>, then, run through the rest of the pattern
-      matching compiler, and finally, picked up by
-      <code>DsUtils.mkCoAlgCaseMatchResult</code>, which converts it into a
-      <code>case</code> expression as outlined above.
-    <p>
-      As an example consider the source expression
-    <blockquote><pre>
-case v of
-  [:x1:]         -> e1
-  [:x2, x3, x4:] -> e2
-  _		 -> e3</pre>
-    </blockquote>
-    <p>
-      <code>Match.tidy1</code> converts it into a form that is equivalent to
-    <blockquote><pre>
-case v of {
-  MkPArr1 x1       -> e1;
-  MkPArr2 x2 x3 x4 -> e2;
-  _	           -> e3;
-}</pre>
-    </blockquote>
-    <p>
-      which <code>DsUtils.mkCoAlgCaseMatchResult</code> turns into the
-      following Core code:
-    <blockquote><pre>
-      case lengthP v of
-        Int# i# -> 
-	  case i# of l {
-	    DFT ->					  e3
-	    1   -> let x1 = v!:0                       in e1
-	    3   -> let x2 = v!:0; x2 = v!:1; x3 = v!:2 in e2
-	  }</pre>
-    </blockquote>
-
-    <h4>Parallel Array Comprehensions</h4>
-    <p>
-      The most challenging construct of the three are array comprehensions.
-      In principle, it would be possible to transform them in essentially the
-      same way as list comprehensions, but this would lead to abysmally slow
-      code as desugaring of list comprehensions generates code that is
-      optimised for sequential, constructor-based structures.  In contrast,
-      array comprehensions need to be transformed into code that solely relies
-      on collective operations and avoids the creation of many small
-      intermediate arrays.  
-    <p>
-      The transformation is implemented by the function <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsListComp.lhs"><code>DsListComp</code></a><code>.dsPArrComp</code>.
-      In the following, we denote this transformation function by the form
-      <code>&lt;&lt;<i>e</i>&gt;&gt; pa ea</code>, where <code><i>e</i></code>
-      is the comprehension to be compiled and the arguments <code>pa</code>
-      and <code>ea</code> denote a pattern and the currently processed array
-      expression, respectively.  The invariant constraining these two
-      arguments is that all elements in the array produced by <code>ea</code>
-      will <em>successfully</em> match against <code>pa</code>.
-    <p>
-      Given a source-level comprehensions <code>[:e | qss:]</code>, we compile
-      it with <code>&lt;&lt;[:e | qss:]&gt;&gt; () [:():]</code> using the
-      rules 
-    <blockquote><pre>
-<<[:e' |           :]>> pa ea = mapP (\pa -> e') ea
-<<[:e' | b     , qs:]>> pa ea = <<[:e' | qs:]>> pa (filterP (\pa -> b) ea)
-<<[:e' | p <- e, qs:]>> pa ea = 
-  let ef = filterP (\x -> case x of {p -> True; _ -> False}) e
-  in
-  <<[:e' | qs:]>> (pa, p) (crossP ea ef)
-<<[:e' | let ds, qs:]>> pa ea = 
-  <<[:e' | qs:]>> (pa, (x_1, ..., x_n)) 
-    	      (mapP (\v@pa -> (v, let ds in (x_1, ..., x_n))) ea)
-where
-  {x_1, ..., x_n} = DV (ds)		-- Defined Variables
-<<[:e' | qs | qss:]>>   pa ea = 
-  <<[:e' | qss:]>> (pa, (x_1, ..., x_n)) 
-    	       (zipP ea <<[:(x_1, ..., x_n) | qs:]>>)
-where
-  {x_1, ..., x_n} = DV (qs)</pre>
-    </blockquote>
-    <p>
-      We assume the denotation of <code>crossP</code> to be given by
-    <blockquote><pre>
-crossP       :: [:a:] -> [:b:] -> [:(a, b):]
-crossP a1 a2  = let
-  		len1 = lengthP a1
-  		len2 = lengthP a2
-  		x1   = concatP $ mapP (replicateP len2) a1
-  		x2   = concatP $ replicateP len1 a2
-  	      in
-  	      zipP x1 x2</pre>
-    </blockquote>
-    <p>
-      For a more efficient implementation of <code>crossP</code>, see
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/lib/std/PrelPArr.lhs"><code>PrelPArr</code></a>.
-    <p>
-      Moreover, the following optimisations are important:
-    <ul>
-      <li>In the <code>p &lt;- e</code> rule, if <code>pa == ()</code>, drop
-	it and simplify the <code>crossP ea e</code> to <code>e</code>.
-      <li>We assume that fusion will optimise sequences of array processing
-	combinators.
-      <li>FIXME: Do we want to have the following function?
-	<blockquote><pre>
-mapFilterP :: (a -> Maybe b) -> [:a:] -> [:b:]</pre>
-	</blockquote>
-	<p>
-	  Even with fusion <code>(mapP (\p -&gt; e) . filterP (\p -&gt;
-	  b))</code> may still result in redundant pattern matching
-	  operations.  (Let's wait with this until we have seen what the
-	  Simplifier does to the generated code.)
-    </ul>
-
-    <h2>Doing Away With Nested Arrays: The Flattening Transformation</h2>
-    <p>
-      On the quest towards an entirely unboxed representation of parallel
-      arrays, the flattening transformation is the essential ingredient.  GHC
-      uses a <a
-      href="http://www.cse.unsw.edu.au/~chak/papers/CK00.html">substantially
-      improved version</a> of the transformation whose original form was
-      described by Blelloch &amp; Sabot.  The flattening transformation
-      replaces values of type <code>[:a:]</code> as well as functions
-      operating on these values by alternative, more efficient data structures
-      and functions.
-    <p>
-      The flattening machinery is activated by the option
-      <code>-fflatten</code>, which is a static hsc option.  It consists of
-      two steps: function vectorisation and array specialisation.  Only the
-      first of those is implemented so far.  If selected, the transformation
-      is applied to a module in Core form immediately after the <a
-      href="../the-beast/desugar.html">desugarer,</a> before the <a
-      href="../the-beast/simplifier.html">Mighty Simplifier</a> gets to do its
-      job.  After vectorisation, the Core program can be dumped using the
-      option <code>-ddump-vect</code>.  The is a good reason for us to perform
-      flattening immediately after the desugarer.  In <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/HscMain.lhs"><code>HscMain</code></a><code>.hscRecomp</code>
-      the so-called <em>persistent compiler state</em> is maintained, which
-      contains all the information about imported interface files needed to
-      lookup the details of imported names (e.g., during renaming and type
-      checking).  However, all this information is zapped before the
-      simplifier is invoked (supposedly to reduce the space-consumption of
-      GHC).  As flattening has to get at all kinds of identifiers from Prelude
-      modules, we need to do it before the relevant information in the
-      persistent compiler state is gone.
-
-    <p>
-      As flattening generally requires all libraries to be compiled for
-      flattening (just like profiling does), there is a <em>compiler way</em>
-      <code>"ndp"</code>, which can be selected using the way option code
-      <code>-ndp</code>.  This option will automagically select
-      <code>-fparr</code> and <code>-fflatten</code>. 
-
-    <h4><code>FlattenMonad</code></h4>
-    <p>
-      The module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/ndpFlatten/FlattenMonad.lhs"><code>FlattenMonad</code></a>
-      implements the monad <code>Flatten</code> that is used during
-      vectorisation to keep track of various sets of bound variables and a
-      variable substitution map; moreover, it provides a supply of new uniques
-      and allows us to look up names in the persistent compiler state (i.e.,
-      imported identifiers).
-    <p>
-      In order to be able to look up imported identifiers in the persistent
-      compiler state, it is important that these identifies are included into
-      the free variable lists computed by the renamer.  More precisely, all
-      names needed by flattening are included in the names produced by
-      <code>RnEnv.getImplicitModuleFVs</code>.  To avoid putting
-      flattening-dependent lists of names into the renamer, the module
-      <code>FlattenInfo</code> exports <code>namesNeededForFlattening</code>.
-
-      [FIXME: It might be worthwhile to document in the non-Flattening part of
-      the Commentary that the persistent compiler state is zapped after
-      desugaring and how the free variables determined by the renamer imply
-      which names are imported.]
-    
-    <p><small>
-<!-- hhmts start -->
-Last modified: Tue Feb 12 01:44:21 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/exts/th.html b/ghc/docs/comm/exts/th.html
deleted file mode 100644
index dbb168aa0e..0000000000
--- a/ghc/docs/comm/exts/th.html
+++ /dev/null
@@ -1,197 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Template Haskell</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Template Haskell</h1>
-    <p>
-      The Template Haskell (TH) extension to GHC adds a meta-programming
-      facility in which all meta-level code is executed at compile time.  The
-      design of this extension is detailed in "Template Meta-programming for
-      Haskell", Tim Sheard and Simon Peyton Jones, <a
-      href="http://portal.acm.org/toc.cfm?id=581690&type=proceeding&coll=portal&dl=ACM&part=series&WantType=proceedings&idx=unknown&title=unknown">ACM
-      SIGPLAN 2002 Haskell Workshop,</a> 2002.  However, some of the details
-      changed after the paper was published.
-    </p>
-
-    <h2>Meta Sugar</h2>
-    <p>
-      The extra syntax of TH (quasi-quote brackets, splices, and reification)
-      is handled in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsMeta.hs"><code>DsMeta</code></a>.
-      In particular, the function <code>dsBracket</code> desugars the four
-      types of quasi-quote brackets (<code>[|...|]</code>,
-      <code>[p|...|]</code>, <code>[d|...|]</code>, and <code>[t|...|]</code>)
-      and <code>dsReify</code> desugars the three types of reification
-      operations (<code>reifyType</code>, <code>reifyDecl</code>, and
-      <code>reifyFixity</code>).
-    </p>
-
-    <h3>Desugaring of Quasi-Quote Brackets</h3>
-    <p>
-      A term in quasi-quote brackets needs to be translated into Core code
-      that, when executed, yields a <em>representation</em> of that term in
-      the form of the abstract syntax trees defined in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/libraries/template-haskell/Language/Haskell/TH/Syntax.hs"><code>Language.Haskell.TH.Syntax</code></a>.
-      Within <code>DsMeta</code>, this is achieved by four functions
-      corresponding to the four types of quasi-quote brackets:
-      <code>repE</code> (for <code>[|...|]</code>), <code>repP</code> (for
-      <code>[p|...|]</code>), <code>repTy</code> (for <code>[t|...|]</code>),
-      and <code>repTopDs</code> (for <code>[d|...|]</code>).  All four of
-      these functions receive as an argument the GHC-internal Haskell AST of
-      the syntactic form that they quote (i.e., arguments of type <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/hsSyn/HsExpr.lhs"><code>HsExpr</code></a><code>.HsExpr
-	Name</code>, <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/hsSyn/HsPat.lhs"><code>HsPat</code></a><code>.HsPat Name</code>, 
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/hsSyn/HsTypes.lhs"><code>HsType</code></a><code>.HsType 
-	Name</code>, and <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/hsSyn/HsDecls.lhs"><code>HsDecls</code></a><code>.HsGroup 
-	Name</code>, respectively). 
-    </p>
-    <p>
-      To increase the static type safety in <code>DsMeta</code>, the functions
-      constructing representations do not just return plain values of type <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/coreSyn/CoreSyn.lhs"><code>CoreSyn</code></a>
-      <code>.CoreExpr</code>; instead, <code>DsMeta</code> introduces a
-      parametrised type <code>Core</code> whose dummy type parameter indicates
-      the source-level type of the value computed by the corresponding Core
-      expression.  All construction of Core fragments in <code>DsMeta</code>
-      is performed by smart constructors whose type signatures use the dummy
-      type parameter to constrain the contexts in which they are applicable.
-      For example, a function that builds a Core expression that evaluates to
-      a TH type representation, which has type
-      <code>Language.Haskell.TH.Syntax.Type</code>, would return a value of
-      type 
-    </p>
-    <blockquote>
-      <pre>
-Core Language.Haskell.TH.Syntax.Type</pre>
-    </blockquote>
-
-    <h3>Desugaring of Reification Operators</h3>
-    <p>
-      The TH paper introduces four reification operators:
-      <code>reifyType</code>, <code>reifyDecl</code>,
-      <code>reifyFixity</code>, and <code>reifyLocn</code>.  Of these,
-      currently (= 9 Nov 2002), only the former two are implemented.
-    </p>
-    <p>
-      The operator <code>reifyType</code> receives the name of a function or
-      data constructor as its argument and yields a representation of this
-      entity's type in the form of a value of type
-      <code>TH.Syntax.Type</code>.  Similarly, <code>reifyDecl</code> receives
-      the name of a type and yields a representation of the type's declaration
-      as a value of type <code>TH.Syntax.Decl</code>.  The name of the reified
-      entity is mapped to the GHC-internal representation of the entity by
-      using the function <code>lookupOcc</code> on the name.
-    </p>
-    
-    <h3>Representing Binding Forms</h3>
-    <p>
-      Care needs to be taken when constructing TH representations of Haskell
-      terms that include binding forms, such as lambda abstractions or let
-      bindings.  To avoid name clashes, fresh names need to be generated for
-      all defined identifiers.  This is achieved via the routine
-      <code>DsMeta.mkGenSym</code>, which, given a <code>Name</code>, produces
-      a <code>Name</code> / <code>Id</code> pair (of type
-      <code>GenSymBind</code>) that associates the given <code>Name</code>
-      with a Core identifier that at runtime will be bound to a string that
-      contains the fresh name.  Notice the two-level nature of this
-      arrangement.  It is necessary, as the Core code that constructs the
-      Haskell term representation may be executed multiple types at runtime
-      and it must be ensured that different names are generated in each run.
-    </p>
-    <p>
-      Such fresh bindings need to be entered into the meta environment (of
-      type <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsMonad.lhs"><code>DsMonad</code></a><code>.DsMetaEnv</code>),
-      which is part of the state (of type <code>DsMonad.DsEnv</code>)
-      maintained in the desugarer monad (of type <code>DsMonad.DsM</code>).
-      This is done using the function <code>DsMeta.addBinds</code>, which
-      extends the current environment by a list of <code>GenSymBind</code>s
-      and executes a subcomputation in this extended environment.  Names can
-      be looked up in the meta environment by way of the functions
-      <code>DsMeta.lookupOcc</code> and <code>DsMeta.lookupBinder</code>; more
-      details about the difference between these two functions can be found in
-      the next subsection.
-    </p>
-    <p>
-      NB: <code>DsMeta</code> uses <code>mkGenSym</code> only when
-      representing terms that may be embedded into a context where names can
-      be shadowed.  For example, a lambda abstraction embedded into an
-      expression can potentially shadow names defined in the context it is
-      being embedded into.  In contrast, this can never be the case for
-      top-level declarations, such as data type declarations; hence, the type
-      variables that a parametric data type declaration abstracts over are not
-      being gensym'ed.  As a result, variables in defining positions are
-      handled differently depending on the syntactic construct in which they
-      appear. 
-    </p>
-
-    <h3>Binders Versus Occurences</h3>
-    <p>
-      Name lookups in the meta environment of the desugarer use two functions
-      with slightly different behaviour, namely <code>DsMeta.lookupOcc</code>
-      and <code>lookupBinder</code>.  The module <code>DsMeta</code> contains
-      the following explanation as to the difference of these functions:
-    </p>
-    <blockquote>
-      <pre>
-When we desugar [d| data T = MkT |]
-we want to get
-	Data "T" [] [Con "MkT" []] []
-and *not*
-	Data "Foo:T" [] [Con "Foo:MkT" []] []
-That is, the new data decl should fit into whatever new module it is
-asked to fit in.   We do *not* clone, though; no need for this:
-	Data "T79" ....
-
-But if we see this:
-	data T = MkT 
-	foo = reifyDecl T
-
-then we must desugar to
-	foo = Data "Foo:T" [] [Con "Foo:MkT" []] []
-
-So in repTopDs we bring the binders into scope with mkGenSyms and addBinds,
-but in dsReify we do not.  And we use lookupOcc, rather than lookupBinder
-in repTyClD and repC.</pre>
-    </blockquote>
-    <p>
-      This implies that <code>lookupOcc</code>, when it does not find the name
-      in the meta environment, uses the function <code>DsMeta.globalVar</code>
-      to construct the <em>original name</em> of the entity (cf. the TH paper
-      for more details regarding original names).  This name uniquely
-      identifies the entity in the whole program and is in scope
-      <em>independent</em> of whether the user name of the same entity is in
-      scope or not (i.e., it may be defined in a different module without
-      being explicitly imported) and has the form &lt;module&gt;:&lt;name&gt;.
-      <strong>NB:</strong> Incidentally, the current implementation of this
-      mechanisms facilitates breaking any abstraction barrier.
-    </p>
-    
-    <h3>Known-key Names for Template Haskell</h3>
-    <p>
-      During the construction of representations, the desugarer needs to use a
-      large number of functions defined in the library
-      <code>Language.Haskell.TH.Syntax</code>.  The names of these functions
-      need to be made available to the compiler in the way outlined <a
-      href="../the-beast/prelude.html">Primitives and the Prelude.</a>
-      Unfortunately, any change to <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/PrelNames.lhs"><code>PrelNames</code></a>
-      triggers a significant amount of recompilation.  Hence, the names needed
-      for TH are defined in <code>DsMeta</code> instead (at the end of the
-      module).  All library functions needed by TH are contained in the name
-      set <code>DsMeta.templateHaskellNames</code>.
-    </p>
-    
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Nov 13 18:01:48 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/feedback.html b/ghc/docs/comm/feedback.html
deleted file mode 100644
index 1da8b10f29..0000000000
--- a/ghc/docs/comm/feedback.html
+++ /dev/null
@@ -1,34 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Feedback</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>Feedback</h1>
-    <p>
-      <a href="mailto:chak@cse.unsw.edu.au">I</a> welcome any feedback on the
-      material and in particular would appreciated comments on which parts of
-      the document are incomprehensible or miss explanation -- e.g., due to
-      the use of GHC speak that is explained nowhere (words like infotable or
-      so).  Moreover, I would be interested to know which areas of GHC you
-      would like to see covered here.
-    <p>
-      For the moment is probably best if feedback is directed to 
-    <p>
-    <blockquote>
-      <a
-	 href="mailto:chak@cse.unsw.edu.au"><code>chak@cse.unsw.edu.au</code></a>
-    </blockquote>
-    <p>
-      However, if there is sufficient interest, we might consider setting up a
-      mailing list.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug  8 00:11:42 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/genesis/genesis.html b/ghc/docs/comm/genesis/genesis.html
deleted file mode 100644
index 30b16fec46..0000000000
--- a/ghc/docs/comm/genesis/genesis.html
+++ /dev/null
@@ -1,82 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Outline of the Genesis</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Outline of the Genesis</h1>
-    <p>
-      Building GHC happens in two stages: First you have to prepare the tree
-      with <code>make boot</code>; and second, you build the compiler and
-      associated libraries with <code>make all</code>.  The <code>boot</code>
-      stage builds some tools used during the main build process, generates
-      parsers and other pre-computed source, and finally computes dependency
-      information.  There is considerable detail on the build process in GHC's
-      <a
-	href="http://haskell.cs.yale.edu/ghc/docs/latest/building/building-guide.html">Building Guide.</a>
-
-    <h4>Debugging the Beast</h4>
-    <p>
-      If you are hacking the compiler or like to play with unstable
-      development versions, chances are that the compiler someday just crashes
-      on you.  Then, it is a good idea to load the <code>core</code> into
-      <code>gdb</code> as usual, but unfortunately there is usually not too
-      much useful information.
-    <p>
-      The next step, then, is somewhat tedious.  You should build a compiler
-      producing programs with a runtime system that has debugging turned on
-      and use that to build the crashing compiler.  There are many sanity
-      checks in the RTS, which may detect inconsistency before they lead to a
-      crash and you may include more debugging information, which helps
-      <code>gdb.</code>  For a RTS with debugging turned on, add the following
-      to <code>build.mk</code> (see also the comment in
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/mk/config.mk.in"><code>config.mk.in</code></a> that you find when searching for
-      <code>GhcRtsHcOpts</code>):
-<blockquote><pre>
-GhcRtsHcOpts+=-optc-DDEBUG
-GhcRtsCcOpts+=-g
-EXTRA_LD_OPTS=-lbfd -liberty</pre></blockquote>
-    <p>
-      Then go into <code>fptools/ghc/rts</code> and <code>make clean boot &&
-      make all</code>.  With the resulting runtime system, you have to re-link
-      the compiler.  Go into <code>fptools/ghc/compiler</code>, delete the
-      file <code>hsc</code> (up to version 4.08) or
-      <code>ghc-&lt;version&gt;</code>, and execute <code>make all</code>.
-    <p>
-      The <code>EXTRA_LD_OPTS</code> are necessary as some of the debugging
-      code uses the BFD library, which in turn requires <code>liberty</code>.
-      I would also recommend (in 4.11 and from 5.0 upwards) adding these linker
-      options to the files <code>package.conf</code> and
-      <code>package.conf.inplace</code> in the directory
-      <code>fptools/ghc/driver/</code> to the <code>extra_ld_opts</code> entry
-      of the package <code>RTS</code>.  Otherwise, you have to supply them
-      whenever you compile and link a program with a compiler that uses the
-      debugging RTS for the programs it produces.
-    <p>
-      To run GHC up to version 4.08 in <code>gdb</code>, first invoke the
-      compiler as usual, but pass it the option <code>-v</code>.  This will
-      show you the exact invocation of the compiler proper <code>hsc</code>.
-      Run <code>hsc</code> with these options in <code>gdb</code>.  The
-      development version 4.11 and stable releases from 5.0 on do no longer
-      use the Perl driver; so, you can run them directly with gdb.
-    <p>
-      <strong>Debugging a compiler during building from HC files.</strong> 
-      If you are boot strapping the compiler on new platform from HC files and
-      it crashes somewhere during the build (e.g., when compiling the
-      libraries), do as explained above, but you may have to re-configure the
-      build system with <code>--enable-hc-boot</code> before re-making the
-      code in <code>fptools/ghc/driver/</code>.
-      If you do this with a compiler up to version 4.08, run the build process
-      with <code>make EXTRA_HC_OPTS=-v</code> to get the exact arguments with
-      which you have to invoke <code>hsc</code> in <code>gdb</code>.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Sun Apr 24 22:16:30 CEST 2005
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/genesis/makefiles.html b/ghc/docs/comm/genesis/makefiles.html
deleted file mode 100644
index 957a82eb85..0000000000
--- a/ghc/docs/comm/genesis/makefiles.html
+++ /dev/null
@@ -1,51 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Mindboggling Makefiles</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Mindboggling Makefiles</h1>
-    <p>
-      The size and structure of GHC's makefiles makes it quite easy to scream
-      out loud - in pain - during the process of tracking down problems in the
-      make system or when attempting to alter it.  GHC's <a
-	href="http://haskell.cs.yale.edu/ghc/docs/latest/building/building-guide.html">Building
-	Guide</a> has valuable information on <a
-	href="http://haskell.cs.yale.edu/ghc/docs/latest/building/sec-makefile-arch.html">the
-	makefile architecture.</a>
-
-    <h4>A maze of twisty little passages, all alike</h4>
-    <p>
-      The <code>fptools/</code> toplevel and the various project directories
-      contain not only a <code>Makefile</code> each, but there are
-      subdirectories of name <code>mk/</code> at various levels that contain
-      rules, targets, and so on specific to a project - or, in the case of the
-      toplevel, the default rules for the whole system.  Each <code>mk/</code>
-      directory contains a file <code>boilerplate.mk</code> that ties the
-      various other makefiles together.  Files called <code>target.mk</code>,
-      <code>paths.mk</code>, and <code>suffix.mk</code> contain make targets,
-      definitions of variables containing paths, and suffix rules,
-      respectively.
-    <p>
-      One particularly nasty trick used in this hierarchy of makefiles is the
-      way in which the variable <code>$(TOP)</code> is used.  AFAIK,
-      <code>$(TOP)</code> always points to a directory containing an
-      <code>mk/</code> subdirectory; however, it not necessarily points to the
-      toplevel <code>fptools/</code> directory.  For example, within the GHC
-      subtree, <code>$(TOP)</code> points to <code>fptools/ghc/</code>.
-      However, some of the makefiles in <code>fptools/ghc/mk/</code> will then
-      <em>temporarily</em> redefine <code>$(TOP)</code> to point a level
-      higher (i.e., to <code>fptools/</code>) while they are including the
-      toplevel boilerplate.  After that <code>$(TOP)</code> is redefined to
-      whatever value it had before including makefiles from higher up in the
-      hierarchy. 
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug 22 16:46:33 GMT Daylight Time 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/genesis/modules.html b/ghc/docs/comm/genesis/modules.html
deleted file mode 100644
index de59cce6d3..0000000000
--- a/ghc/docs/comm/genesis/modules.html
+++ /dev/null
@@ -1,164 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Marvellous Module Structure of GHC </title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Marvellous Module Structure of GHC </h1>
-    <p>
-
-GHC is built out of about 245 Haskell modules.  It can be quite tricky
-to figure out what the module dependency graph looks like.  It can be
-important, too, because loops in the module dependency graph need to 
-be broken carefully using <tt>.hi-boot</tt> interface files.
-<p>
-This section of the commentary documents the subtlest part of
-the module dependency graph, namely the part near the bottom.
-<ul>
-<li> The list is given in compilation order: that is,
-module near the top are more primitive, and are compiled earlier.
-<li> Each module is listed together with its most critical 
-dependencies in parentheses; that is, the dependencies that prevent it being
-compiled earlier.  
-<li> Modules in the same bullet don't depend on each other.
-<li> Loops are documented by a dependency such as "<tt>loop Type.Type</tt>".
-This means tha the module imports <tt>Type.Type</tt>, but module <tt>Type</tt>
-has not yet been compiled, so the import comes from <tt>Type.hi-boot</tt>.
-</ul>
-
-Compilation order is as follows:
-<ul>
-<li>
-<strong>First comes a layer of modules that have few interdependencies,
-and which implement very basic data types</strong>:
-<tt> <ul>
-<li> Util
-<li> OccName
-<li> Pretty
-<li> Outputable
-<li> StringBuffer
-<li> ListSetOps
-<li> Maybes
-<li> etc
-</ul> </tt>
-
-<p> 
-<li> <strong> Now comes the main subtle layer, involving types, classes, type constructors
-identifiers, expressions, rules, and their operations.</strong>
-
-<tt>
-<ul>
-<li>	Name <br> PrimRep
-<p><li>
-	PrelNames
-<p><li>
-	Var (Name, loop IdInfo.IdInfo, 
-	     loop Type.Type, loop Type.Kind)
-<p><li>
-	VarEnv, VarSet, ThinAir
-<p><li>
-	Class (loop TyCon.TyCon, loop Type.Type)
-<p><li>
-	TyCon (loop Type.Type, loop Type.Kind, loop DataCon.DataCon, loop Generics.GenInfo)
-<p><li>
-	TypeRep (loop DataCon.DataCon, loop Subst.substTyWith)
-<p><li>
-	Type (loop PprType.pprType, loop Subst.substTyWith)
-<p><li>
-	FieldLabel(Type) <br> 
-	TysPrim(Type) <br> 
-<p><li>
-	Literal (TysPrim, PprType) <br> 
-	DataCon (loop PprType, loop Subst.substTyWith, FieldLabel.FieldLabel)
-<p><li>
-	TysWiredIn (loop MkId.mkDataConIds)
-<p><li>
-	TcType( lots of TysWiredIn stuff)
-<p><li>
-	PprType( lots of TcType stuff )
-<p><li>
-	PrimOp (PprType, TysWiredIn)
-<p><li>
-	CoreSyn [does not import Id]
-<p><li>
-	IdInfo (CoreSyn.Unfolding, CoreSyn.CoreRules)
-<p><li>
-	Id (lots from IdInfo)
-<p><li>
-	CoreFVs <br>
-	PprCore
-<p><li>
-	CoreUtils (PprCore.pprCoreExpr, CoreFVs.exprFreeVars,
-		   CoreSyn.isEvaldUnfolding CoreSyn.maybeUnfoldingTemplate)
-<p><li>	
-	CoreLint( CoreUtils ) <br>
-	OccurAnal (CoreUtils.exprIsTrivial) <br>
-	CoreTidy (CoreUtils.exprArity ) <br>
-<p><li>
-	CoreUnfold (OccurAnal.occurAnalyseGlobalExpr)
-<p><li>
-	Subst (CoreUnfold.Unfolding, CoreFVs)  <br>
-	Generics (CoreUnfold.mkTopUnfolding) <br>
-	Rules (CoreUnfold.Unfolding, PprCore.pprTidyIdRules)
-<p><li>
-	MkId (CoreUnfold.mkUnfolding, Subst, Rules.addRule)
-<p><li>
-	PrelInfo (MkId)  <br>
-	HscTypes( Rules.RuleBase )
-</ul></tt>
-
-<p><li> <strong>That is the end of the infrastructure. Now we get the 
-	main layer of mdoules that perform useful work.</strong>
-
-<tt><ul>
-<p><li>
-	CoreTidy (HscTypes.PersistentCompilerState)
-</ul></tt>
-</ul>
-
-HsSyn stuff
-<ul> 
-<li> HsPat.hs-boot
-<li> HsExpr.hs-boot (loop HsPat.LPat)
-<li> HsTypes (loop HsExpr.HsSplice)
-<li> HsBinds (HsTypes.LHsType, loop HsPat.LPat, HsExpr.pprFunBind and others)
-     HsLit (HsTypes.SyntaxName)
-<li> HsPat (HsBinds, HsLit)
-     HsDecls (HsBinds)
-<li> HsExpr (HsDecls, HsPat)
-</ul>
-
-
-
-<h2>Library stuff: base package</h2>
-
-<ul> 
-<li> GHC.Base
-<li> Data.Tuple (GHC.Base), GHC.Ptr (GHC.Base)
-<li> GHC.Enum (Data.Tuple)
-<li> GHC.Show (GHC.Enum)
-<li> GHC.Num (GHC.Show)
-<li> GHC.ST (GHC.Num), GHC.Real (GHC.Num)
-<li> GHC.Arr (GHC.ST) GHC.STRef (GHC.ST)
-<li> GHC.IOBase (GHC.Arr)
-<li> Data.Bits (GHC.Real)
-<li> Data.HashTable (Data.Bits, Control.Monad)
-<li> Data.Typeable (GHC.IOBase, Data.HashTable)
-<li> GHC.Weak (Data.Typeable, GHC.IOBase)
-</ul>
-
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug 22 16:46:33 GMT Daylight Time 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
-
-
-
-
-
diff --git a/ghc/docs/comm/index.html b/ghc/docs/comm/index.html
deleted file mode 100644
index 5ccd5f0ca9..0000000000
--- a/ghc/docs/comm/index.html
+++ /dev/null
@@ -1,121 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Beast Explained</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The Glasgow Haskell Compiler (GHC) Commentary [v0.17]</h1>
-    <p>
-      <!-- Contributors: Whoever makes substantial additions or changes to the
-      document, please add your name and keep the order alphabetic.  Moreover,
-      please bump the version number for any substantial modification that you
-      check into CVS.
-      -->
-      <strong>Manuel M. T. Chakravarty</strong><br>
-      <strong>Sigbjorn Finne</strong><br>
-      <strong>Simon Marlow</strong><br>
-      <strong>Simon Peyton Jones</strong><br>
-      <strong>Julian Seward</strong><br>
-      <strong>Reuben Thomas</strong><br>
-      &nbsp;<br>
-    <p>
-      This document started as a collection of notes describing what <a
-      href="mailto:chak@cse.unsw.edu.au">I</a> learnt when poking around in
-      the <a href="http://haskell.org/ghc/">GHC</a> sources.  During the
-      <i>Haskell Implementers Workshop</i> in January 2001, it was decided to
-      put the commentary into 
-      <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/">GHC's CVS
-	repository</a>
-      to allow the whole developer community to add their wizardly insight to
-      the document.
-    <p>
-      <strong>The document is still far from being complete - help it
-      grow!</strong> 
-
-    <h2>Before the Show Begins</h2>
-    <p>
-    <ul>
-      <li><a href="feedback.html">Feedback</a>
-      <li><a href="others.html">Other Sources of Wisdom</a>
-    </ul>
-
-    <h2>Genesis</h2>
-    <p>
-    <ul>
-      <li><a href="genesis/genesis.html">Outline of the Genesis</a>
-      <li><a href="genesis/makefiles.html">Mindboggling Makefiles</a>
-      <li><a href="genesis/modules.html">GHC's Marvellous Module Structure</a>
-    </ul>
-
-    <h2>The Beast Dissected</h2>
-    <p>
-    <ul>
-      <li><a href="the-beast/coding-style.html">Coding style used in
-      the compiler</a>
-      <li><a href="the-beast/driver.html">The Glorious Driver</a>
-      <li><a href="the-beast/prelude.html">Primitives and the Prelude</a>
-      <li><a href="the-beast/syntax.html">Just Syntax</a>
-      <li><a href="the-beast/basicTypes.html">The Basics</a>
-      <li><a href="the-beast/modules.html">Modules, ModuleNames and
-	  Packages</a> 
-      <li><a href="the-beast/names.html">The truth about names: Names and OccNames</a> 
-      <li><a href="the-beast/vars.html">The Real Story about Variables, Ids,
-	  TyVars, and the like</a> 
-      <li><a href="the-beast/data-types.html">Data types and constructors</a> 
-      <li><a href="the-beast/renamer.html">The Glorious Renamer</a>
-      <li><a href="the-beast/types.html">Hybrid Types</a>
-      <li><a href="the-beast/typecheck.html">Checking Types</a>
-      <li><a href="the-beast/desugar.html">Sugar Free: From Haskell To Core</a>
-      <li><a href="the-beast/simplifier.html">The Mighty Simplifier</a>
-      <li><a href="the-beast/mangler.html">The Evil Mangler</a>
-      <li><a href="the-beast/alien.html">Alien Functions</a>
-      <li><a href="the-beast/stg.html">You Got Control: The STG-language</a>
-      <li><a href="the-beast/ncg.html">The Native Code Generator</a>
-      <li><a href="the-beast/ghci.html">GHCi</a>
-      <li><a href="the-beast/fexport.html">Implementation of
-                                           <code>foreign export</code></a>
-      <li><a href="the-beast/main.html">Compiling and running the Main module</code></a>
-    </ul>
-
-    <h2>RTS &amp; Libraries</h2>
-    <p>
-    <ul>
-      <li><a href="rts-libs/coding-style.html">Coding Style Guidelines</a>
-      <li><a href="rts-libs/stgc.html">Spineless Tagless C</a>
-      <li><a href="rts-libs/primitives.html">Primitives</a>
-      <li><a href="rts-libs/prelfound.html">Prelude Foundations</a>
-      <li><a href="rts-libs/prelude.html">Cunning Prelude Code</a>
-      <li><a href="rts-libs/foreignptr.html">On why we have <tt>ForeignPtr</tt></a> 
-      <li><a href="rts-libs/non-blocking.html">Non-blocking I/O for Win32</a>
-      <li><a href="rts-libs/multi-thread.html">Supporting multi-threaded interoperation</a>
-    </ul>
-
-    <h2>Extensions, or Making a Complicated System More Complicated</h2>
-    <p>
-    <ul>
-      <li><a href="exts/th.html">Template Haskell</a>
-      <li><a href="exts/ndp.html">Parallel Arrays</a>
-    </ul>
-
-    <h2>The Source</h2>
-    <p>
-      The online master copy of the Commentary is at
-    <blockquote>
-      <a href="http://www.cse.unsw.edu.au/~chak/haskell/ghc/comm/">http://www.cse.unsw.edu.au/~chak/haskell/ghc/comm/</a>
-    </blockquote>
-    <p>
-      This online version is updated 
-      <a
-	 href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/docs/comm/">from 
-	CVS</a>
-      daily.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Thu May 12 19:03:42 EST 2005
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/others.html b/ghc/docs/comm/others.html
deleted file mode 100644
index 52d87e9419..0000000000
--- a/ghc/docs/comm/others.html
+++ /dev/null
@@ -1,60 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Other Sources of Wisdom</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>Other Sources of Wisdom</h1>
-    <p>
-      Believe it or not, but there are other people besides you who are
-      masochistic enough to study the innards of the beast.  Some of the have
-      been kind (or cruel?) enough to share their insights with us.  Here is a
-      probably incomplete list:
-    <p>
-    <ul>
-
-      <li>The <a
-      href="http://www.cee.hw.ac.uk/~dsg/gph/docs/StgSurvival.ps.gz">STG
-	  Survival Sheet</a> has -- according to its header -- been written by
-	  `a poor wee soul',<sup><a href="#footnote1">1</a></sup> which
-	  probably has been pushed into the torments of madness by the very
-	  act of contemplating the inner workings of the STG runtime system.
-	  This document discusses GHC's runtime system with a focus on
-	  support for parallel processing (aka GUM).
-
-      <li>Instructions on <a
-      href="http://www-users.cs.york.ac.uk/~olaf/PUBLICATIONS/extendGHC.html">Adding 
-	  an Optimisation Pass to the Glasgow Haskell Compiler</a> 
-	have been compiled by <a
-	href="http://www-users.cs.york.ac.uk/~olaf/">Olaf Chitil</a>.
-	Unfortunately, this document is already a little aged.
-
-      <li><a href="http://www.cs.pdx.edu/~apt/">Andrew Tolmach</a> has defined 
-	<a href="http://www.haskell.org/ghc/docs/papers/core.ps.gz">an external
-	  representation of
-	  GHC's <em>Core</em> language</a> and also implemented a GHC pass
-	that emits the intermediate form into <code>.hcr</code> files.  The
-	option <code>-fext-core</code> triggers GHC to emit Core code after
-	optimisation; in addition, <code>-fno-code</code> is often used to
-	stop compilation after Core has been emitted.
-
-	<!-- Add references to other background texts listed on the GHC docu
-	page 
-	-->
-
-    </ul>
-
-    <p><hr><p>
-      <sup><a name="footnote1">1</a></sup>Usually reliable sources have it that
-      the poor soul in question is no one less than GUM hardcore hacker <a
-      href="http://www.cee.hw.ac.uk/~hwloidl/">Hans-Wolfgang Loidl</a>.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Tue Nov 13 10:56:57 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/rts-libs/coding-style.html b/ghc/docs/comm/rts-libs/coding-style.html
deleted file mode 100644
index 58f5b4f9bb..0000000000
--- a/ghc/docs/comm/rts-libs/coding-style.html
+++ /dev/null
@@ -1,516 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Style Guidelines for RTS C code</title>
-  </head>
-
-<body>
-<H1>The GHC Commentary - Style Guidelines for RTS C code</h1>
-
-<h2>Comments</h2>
-
-<p>These coding style guidelines are mainly intended for use in
-<tt>ghc/rts</tt> and <tt>ghc/includes</tt>.
-
-<p>NB These are just suggestions.  They're not set in stone.  Some of
-them are probably misguided.  If you disagree with them, feel free to
-modify this document (and make your commit message reasonably
-informative) or mail someone (eg. <a
-href="glasgow-haskell-users@haskell.org">The GHC mailing list</a>)
-
-<h2>References</h2>
-
-If you haven't read them already, you might like to check the following.
-Where they conflict with our suggestions, they're probably right.
-
-<ul>
-
-<li>
-The C99 standard.  One reasonable reference is <a
-href="http://home.tiscalinet.ch/t_wolf/tw/c/c9x_changes.html">here</a>.
-
-<p><li>
-Writing Solid Code, Microsoft Press.  (Highly recommended.  Possibly
-the only Microsoft Press book that's worth reading.)
-
-<p><li>
-Autoconf documentation.
-See also <a href="http://peti.gmd.de/autoconf-archive/">The autoconf macro archive</a> and 
-<a href="http://www.cyclic.com/cyclic-pages/autoconf.html">Cyclic Software's description</a>
-
-<p><li> <a
-href="http://www.cs.umd.edu/users/cml/cstyle/indhill-cstyle.html">Indian
-Hill C Style and Coding Standards</a>.
-
-<p><li>
-<a href="http://www.cs.umd.edu/users/cml/cstyle/">A list of C programming style links</a>
-
-<p><li>
-<a href="http://www.lysator.liu.se/c/c-www.html">A very large list of C programming links</a>
-
-<p><li>
-<a href="http://www.geek-girl.com/unix.html">A list of Unix programming links</a>
-
-</ul>
-
-
-<h2>Portability issues</h2>
-
-<ul>
-<p><li> We try to stick to C99 where possible.  We use the following
-C99 features relative to C89, some of which were previously GCC
-extensions (possibly with different syntax):
-
-<ul>
-<p><li>Variable length arrays as the last field of a struct.  GCC has
-a similar extension, but the syntax is slightly different: in GCC you
-would declare the array as <tt>arr[0]</tt>, whereas in C99 it is
-declared as <tt>arr[]</tt>.
-
-<p><li>Inline annotations on functions (see later)
-
-<p><li>Labeled elements in initialisers.  Again, GCC has a slightly
-different syntax from C99 here, and we stick with the GCC syntax until
-GCC implements the C99 proposal.
-
-<p><li>C++-style comments.  These are part of the C99 standard, and we
-prefer to use them whenever possible.
-</ul>
-
-<p>In addition we use ANSI-C-style function declarations and
-prototypes exclusively.  Every function should have a prototype;
-static function prototypes may be placed near the top of the file in
-which they are declared, and external prototypes are usually placed in
-a header file with the same basename as the source file (although there
-are exceptions to this rule, particularly when several source files
-together implement a subsystem which is described by a single external
-header file).
-
-<p><li>We use the following GCC extensions, but surround them with
-<tt>#ifdef __GNUC__</tt>:
-
-<ul>
-<p><li>Function attributes (mostly just <code>no_return</code> and
-<code>unused</code>)
-<p><li>Inline assembly.
-</ul>
-
-<p><li>
-char can be signed or unsigned - always say which you mean
-
-<p><li>Our POSIX policy: try to write code that only uses POSIX (IEEE
-Std 1003.1) interfaces and APIs.  We used to define
-<code>POSIX_SOURCE</code> by default, but found that this caused more
-problems than it solved, so now we require any code that is
-POSIX-compliant to explicitly say so by having <code>#include
-"PosixSource.h"</code> at the top.  Try to do this whenever possible.
-
-<p><li> Some architectures have memory alignment constraints.  Others
-don't have any constraints but go faster if you align things.  These
-macros (from <tt>ghcconfig.h</tt>) tell you which alignment to use
-
-<pre>
-  /* minimum alignment of unsigned int */
-  #define ALIGNMENT_UNSIGNED_INT 4
-
-  /* minimum alignment of long */
-  #define ALIGNMENT_LONG 4
-
-  /* minimum alignment of float */
-  #define ALIGNMENT_FLOAT 4
-
-  /* minimum alignment of double */
-  #define ALIGNMENT_DOUBLE 4
-</pre>
-
-<p><li> Use <tt>StgInt</tt>, <tt>StgWord</tt> and <tt>StgPtr</tt> when
-reading/writing ints and ptrs to the stack or heap.  Note that, by
-definition, <tt>StgInt</tt>, <tt>StgWord</tt> and <tt>StgPtr</tt> are
-the same size and have the same alignment constraints even if
-<code>sizeof(int) != sizeof(ptr)</code> on that platform.
-
-<p><li> Use <tt>StgInt8</tt>, <tt>StgInt16</tt>, etc when you need a
-certain minimum number of bits in a type.  Use <tt>int</tt> and
-<tt>nat</tt> when there's no particular constraint.  ANSI C only
-guarantees that ints are at least 16 bits but within GHC we assume
-they are 32 bits.
-
-<p><li> Use <tt>StgFloat</tt> and <tt>StgDouble</tt> for floating
-point values which will go on/have come from the stack or heap.  Note
-that <tt>StgDouble</tt> may occupy more than one <tt>StgWord</tt>, but
-it will always be a whole number multiple.
-
-<p>
-Use <code>PK_FLT(addr)</code>, <code>PK_DBL(addr)</code> to read
-<tt>StgFloat</tt> and <tt>StgDouble</tt> values from the stack/heap,
-and <code>ASSIGN_FLT(val,addr)</code> /
-<code>ASSIGN_DBL(val,addr)</code> to assign StgFloat/StgDouble values
-to heap/stack locations.  These macros take care of alignment
-restrictions.
-
-<p>
-Heap/Stack locations are always <tt>StgWord</tt> aligned; the
-alignment requirements of an <tt>StgDouble</tt> may be more than that
-of <tt>StgWord</tt>, but we don't pad misaligned <tt>StgDoubles</tt>
-because doing so would be too much hassle (see <code>PK_DBL</code> &
-co above).
-
-<p><li>
-Avoid conditional code like this:
-
-<pre>
-  #ifdef solaris_host_OS
-  // do something solaris specific
-  #endif
-</pre>
-
-Instead, add an appropriate test to the configure.ac script and use
-the result of that test instead. 
-
-<pre>
-  #ifdef HAVE_BSD_H
-  // use a BSD library
-  #endif
-</pre>
-
-<p>The problem is that things change from one version of an OS to another
-- things get added, things get deleted, things get broken, some things
-are optional extras.  Using "feature tests" instead of "system tests"
-makes things a lot less brittle.  Things also tend to get documented
-better.
-
-</ul>
-
-<h2>Debugging/robustness tricks</h2>
-
-
-Anyone who has tried to debug a garbage collector or code generator
-will tell you: "If a program is going to crash, it should crash as
-soon, as noisily and as often as possible."  There's nothing worse
-than trying to find a bug which only shows up when running GHC on
-itself and doesn't manifest itself until 10 seconds after the actual
-cause of the problem.
-
-<p>We put all our debugging code inside <tt>#ifdef DEBUG</tt>.  The
-general policy is we don't ship code with debugging checks and
-assertions in it, but we do run with those checks in place when
-developing and testing.  Anything inside <tt>#ifdef DEBUG</tt> should
-not slow down the code by more than a factor of 2.
-
-<p>We also have more expensive "sanity checking" code for hardcore
-debugging - this can slow down the code by a large factor, but is only
-enabled on demand by a command-line flag.  General sanity checking in
-the RTS is currently enabled with the <tt>-DS</tt> RTS flag.
-
-<p>There are a number of RTS flags which control debugging output and
-sanity checking in various parts of the system when <tt>DEBUG</tt> is
-defined.  For example, to get the scheduler to be verbose about what
-it is doing, you would say <tt>+RTS -Ds -RTS</tt>.  See
-<tt>includes/RtsFlags.h</tt> and <tt>rts/RtsFlags.c</tt> for the full
-set of debugging flags.  To check one of these flags in the code,
-write:
-
-<pre>
-  IF_DEBUG(gc, fprintf(stderr, "..."));
-</pre>
-
-would check the <tt>gc</tt> flag before generating the output (and the
-code is removed altogether if <tt>DEBUG</tt> is not defined).
-
-<p>All debugging output should go to <tt>stderr</tt>.
-
-<p>
-Particular guidelines for writing robust code:
-
-<ul>
-<p><li>
-Use assertions.  Use lots of assertions.  If you write a comment
-that says "takes a +ve number" add an assertion.  If you're casting
-an int to a nat, add an assertion.  If you're casting an int to a char,
-add an assertion.  We use the <tt>ASSERT</tt> macro for writing
-assertions; it goes away when <tt>DEBUG</tt> is not defined.
-
-<p><li>
-Write special debugging code to check the integrity of your data structures.
-(Most of the runtime checking code is in <tt>rts/Sanity.c</tt>)
-Add extra assertions which call this code at the start and end of any
-code that operates on your data structures.
-
-<p><li>
-When you find a hard-to-spot bug, try to think of some assertions,
-sanity checks or whatever that would have made the bug easier to find.
-
-<p><li>
-When defining an enumeration, it's a good idea not to use 0 for normal
-values.  Instead, make 0 raise an internal error.  The idea here is to
-make it easier to detect pointer-related errors on the assumption that
-random pointers are more likely to point to a 0 than to anything else.
-
-<pre>
-typedef enum
-    { i_INTERNAL_ERROR  /* Instruction 0 raises an internal error */
-    , i_PANIC           /* irrefutable pattern match failed! */
-    , i_ERROR           /* user level error */
-
-    ...
-</pre>
-
-<p><li> Use <tt>#warning</tt> or <tt>#error</tt> whenever you write a
-piece of incomplete/broken code.
-
-<p><li> When testing, try to make infrequent things happen often.
-     For example, make a context switch/gc/etc happen every time a 
-     context switch/gc/etc can happen.  The system will run like a 
-     pig but it'll catch a lot of bugs.
-
-</ul>
-
-<h2>Syntactic details</h2>
-
-<ul>
-<p><li><b>Important:</b> Put "redundant" braces or parens in your code.
-Omitting braces and parens leads to very hard to spot bugs -
-especially if you use macros (and you might have noticed that GHC does
-this a lot!)
-
-<p>
-In particular:
-<ul>
-<p><li>
-Put braces round the body of for loops, while loops, if statements, etc.
-even if they "aren't needed" because it's really hard to find the resulting
-bug if you mess up.  Indent them any way you like but put them in there!
-</ul>
-
-<p><li>
-When defining a macro, always put parens round args - just in case.
-For example, write:
-<pre>
-  #define add(x,y) ((x)+(y))
-</pre>
-instead of
-<pre>
-  #define add(x,y) x+y
-</pre>
-
-<p><li> Don't declare and initialize variables at the same time.
-Separating the declaration and initialization takes more lines, but
-make the code clearer.
-
-<p><li>
-Use inline functions instead of macros if possible - they're a lot
-less tricky to get right and don't suffer from the usual problems
-of side effects, evaluation order, multiple evaluation, etc.
-
-<ul>
-<p><li>Inline functions get the naming issue right.  E.g. they
-  can have local variables which (in an expression context)
-  macros can't.
-
-<p><li> Inline functions have call-by-value semantics whereas macros
-  are call-by-name.  You can be bitten by duplicated computation
-  if you aren't careful.
-
-<p><li> You can use inline functions from inside gdb if you compile with
-  -O0 or -fkeep-inline-functions.  If you use macros, you'd better
-  know what they expand to.
-</ul>
-
-However, note that macros can serve as both l-values and r-values and
-can be "polymorphic" as these examples show:
-<pre>
-  // you can use this as an l-value or an l-value
-  #define PROF_INFO(cl) (((StgClosure*)(cl))->header.profInfo)
-
-  // polymorphic case
-  // but note that min(min(1,2),3) does 3 comparisions instead of 2!!
-  #define min(x,y) (((x)<=(y)) ? (x) : (y))
-</pre>
-
-<p><li>
-Inline functions should be "static inline" because:
-<ul>
-<p><li>
-gcc will delete static inlines if not used or theyre always inlined.
-
-<p><li>
-  if they're externed, we could get conflicts between 2 copies of the 
-  same function if, for some reason, gcc is unable to delete them.
-  If they're static, we still get multiple copies but at least they don't conflict.
-</ul>
-
-OTOH, the gcc manual says this
-so maybe we should use extern inline?
-
-<pre>
-   When a function is both inline and `static', if all calls to the
-function are integrated into the caller, and the function's address is
-never used, then the function's own assembler code is never referenced.
-In this case, GNU CC does not actually output assembler code for the
-function, unless you specify the option `-fkeep-inline-functions'.
-Some calls cannot be integrated for various reasons (in particular,
-calls that precede the function's definition cannot be integrated, and
-neither can recursive calls within the definition).  If there is a
-nonintegrated call, then the function is compiled to assembler code as
-usual.  The function must also be compiled as usual if the program
-refers to its address, because that can't be inlined.
-
-   When an inline function is not `static', then the compiler must
-assume that there may be calls from other source files; since a global
-symbol can be defined only once in any program, the function must not
-be defined in the other source files, so the calls therein cannot be
-integrated.  Therefore, a non-`static' inline function is always
-compiled on its own in the usual fashion.
-
-   If you specify both `inline' and `extern' in the function
-definition, then the definition is used only for inlining.  In no case
-is the function compiled on its own, not even if you refer to its
-address explicitly.  Such an address becomes an external reference, as
-if you had only declared the function, and had not defined it.
-
-   This combination of `inline' and `extern' has almost the effect of a
-macro.  The way to use it is to put a function definition in a header
-file with these keywords, and put another copy of the definition
-(lacking `inline' and `extern') in a library file.  The definition in
-the header file will cause most calls to the function to be inlined.
-If any uses of the function remain, they will refer to the single copy
-in the library.
-</pre>
-
-<p><li>
-Don't define macros that expand to a list of statements.  
-You could just use braces as in:
-
-<pre>
-  #define ASSIGN_CC_ID(ccID)              \
-        {                                 \
-        ccID = CC_ID;                     \
-        CC_ID++;                          \
-        }
-</pre>
-
-(but it's usually better to use an inline function instead - see above).
-
-<p><li>
-Don't even write macros that expand to 0 statements - they can mess you 
-up as well.  Use the doNothing macro instead.
-<pre>
-  #define doNothing() do { } while (0)
-</pre>
-
-<p><li>
-This code
-<pre>
-int* p, q;
-</pre>
-looks like it declares two pointers but, in fact, only p is a pointer.
-It's safer to write this:
-<pre>
-int* p;
-int* q;
-</pre>
-You could also write this:
-<pre>
-int *p, *q;
-</pre>
-but it is preferrable to split the declarations.
-
-<p><li>
-Try to use ANSI C's enum feature when defining lists of constants of
-the same type.  Among other benefits, you'll notice that gdb uses the
-name instead of its (usually inscrutable) number when printing values
-with enum types and gdb will let you use the name in expressions you
-type.  
-
-<p>
-Examples:
-<pre>
-    typedef enum { /* N.B. Used as indexes into arrays */
-     NO_HEAP_PROFILING,		
-     HEAP_BY_CC,		
-     HEAP_BY_MOD,		
-     HEAP_BY_GRP,		
-     HEAP_BY_DESCR,		
-     HEAP_BY_TYPE,		
-     HEAP_BY_TIME		
-    } ProfilingFlags;
-</pre>
-instead of
-<pre>
-    # define NO_HEAP_PROFILING	0	/* N.B. Used as indexes into arrays */
-    # define HEAP_BY_CC		1
-    # define HEAP_BY_MOD	2
-    # define HEAP_BY_GRP	3
-    # define HEAP_BY_DESCR	4
-    # define HEAP_BY_TYPE	5
-    # define HEAP_BY_TIME	6
-</pre>
-and 
-<pre>
-    typedef enum {
-     CCchar    = 'C',
-     MODchar   = 'M',
-     GRPchar   = 'G',
-     DESCRchar = 'D',
-     TYPEchar  = 'Y',
-     TIMEchar  = 'T'
-    } ProfilingTag;
-</pre>
-instead of
-<pre>
-    # define CCchar    'C'
-    # define MODchar   'M'
-    # define GRPchar   'G'
-    # define DESCRchar 'D'
-    # define TYPEchar  'Y'
-    # define TIMEchar  'T'
-</pre>
-
-<p><li> Please keep to 80 columns: the line has to be drawn somewhere,
-and by keeping it to 80 columns we can ensure that code looks OK on
-everyone's screen.  Long lines are hard to read, and a sign that the
-code needs to be restructured anyway.
-
-<p><li> When commenting out large chunks of code, use <code>#ifdef 0
-... #endif</code> rather than <code>/* ... */</code> because C doesn't
-have nested comments.
-
-<p><li>When declaring a typedef for a struct, give the struct a name
-as well, so that other headers can forward-reference the struct name
-and it becomes possible to have opaque pointers to the struct.  Our
-convention is to name the struct the same as the typedef, but add a
-leading underscore.  For example:
-
-<pre>
-  typedef struct _Foo {
-    ...
-  } Foo;
-</pre>
-
-<p><li>Do not use <tt>!</tt> instead of explicit comparison against
-<tt>NULL</tt> or <tt>'\0'</tt>;  the latter is much clearer.
-
-<p><li> We don't care too much about your indentation style but, if
-you're modifying a function, please try to use the same style as the
-rest of the function (or file).  If you're writing new code, a
-tab width of 4 is preferred.
-
-</ul>
-
-<h2>CVS issues</h2>
-
-<ul>
-<p><li>
-Don't be tempted to reindent or reorganise large chunks of code - it
-generates large diffs in which it's hard to see whether anything else
-was changed.
-<p>
-If you must reindent or reorganise, don't include any functional
-changes that commit and give advance warning that you're about to do
-it in case anyone else is changing that file.
-</ul>
-
-
-</body>
-</html>
diff --git a/ghc/docs/comm/rts-libs/foreignptr.html b/ghc/docs/comm/rts-libs/foreignptr.html
deleted file mode 100644
index febe9fe422..0000000000
--- a/ghc/docs/comm/rts-libs/foreignptr.html
+++ /dev/null
@@ -1,68 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - why we have <tt>ForeignPtr</tt></title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-
-    <h1>On why we have <tt>ForeignPtr</tt></h1>
-
-    <p>Unfortunately it isn't possible to add a finalizer to a normal
-    <tt>Ptr a</tt>.  We already have a generic finalization mechanism:
-    see the Weak module in package lang.  But the only reliable way to
-    use finalizers is to attach one to an atomic heap object - that
-    way the compiler's optimiser can't interfere with the lifetime of
-    the object.
-
-    <p>The <tt>Ptr</tt> type is really just a boxed address - it's
-    defined like
-
-    <pre>
-data Ptr a = Ptr Addr#
-</pre>
-
-    <p>where <tt>Addr#</tt> is an unboxed native address (just a 32-
-    or 64- bit word).  Putting a finalizer on a <tt>Ptr</tt> is
-    dangerous, because the compiler's optimiser might remove the box
-    altogether.
-
-    <p><tt>ForeignPtr</tt> is defined like this
-
-    <pre>
-data ForeignPtr a = ForeignPtr ForeignObj#
-</pre>
-
-    <p>where <tt>ForeignObj#</tt> is a *boxed* address, it corresponds
-    to a real heap object.  The heap object is primitive from the
-    point of view of the compiler - it can't be optimised away.  So it
-    works to attach a finalizer to the <tt>ForeignObj#</tt> (but not
-    to the <tt>ForeignPtr</tt>!).
-
-    <p>There are several primitive objects to which we can attach
-    finalizers: <tt>MVar#</tt>, <tt>MutVar#</tt>, <tt>ByteArray#</tt>,
-    etc.  We have special functions for some of these: eg.
-    <tt>MVar.addMVarFinalizer</tt>.
-
-    <p>So a nicer interface might be something like
-
-<pre>
-class Finalizable a where
-   addFinalizer :: a -> IO () -> IO ()
-
-instance Finalizable (ForeignPtr a) where ...
-instance Finalizable (MVar a) where ...
-</pre>
-
-    <p>So you might ask why we don't just get rid of <tt>Ptr</tt> and
-    rename <tt>ForeignPtr</tt> to <tt>Ptr</tt>.  The reason for that
-    is just efficiency, I think.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Sep 26 09:49:37 BST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/rts-libs/multi-thread.html b/ghc/docs/comm/rts-libs/multi-thread.html
deleted file mode 100644
index 67a544be85..0000000000
--- a/ghc/docs/comm/rts-libs/multi-thread.html
+++ /dev/null
@@ -1,445 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-<head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-<title>The GHC Commentary - Supporting multi-threaded interoperation</title>
-</head>
-<body>
-<h1>The GHC Commentary - Supporting multi-threaded interoperation</h1>
-<em>
-<p>
-Authors: sof@galois.com, simonmar@microsoft.com<br>
-Date:    April 2002
-</p>
-</em>
-<p>
-This document presents the implementation of an extension to
-Concurrent Haskell that provides two enhancements:
-</p>
-<ul>
-<li>A Concurrent Haskell thread may call an external (e.g., C)
-function in a manner that's transparent to the execution/evaluation of
-other Haskell threads. Section <a href="#callout">Calling out"</a> covers this.
-</li>
-<li>
-OS threads may safely call Haskell functions concurrently. Section
-<a href="#callin">"Calling in"</a> covers this.
-</li>
-</ul>
-
-<!---- ***************************************  ----->
-<h2 id="callout">The problem: foreign calls that block</h2>
-<p>
-When a Concurrent Haskell(CH) thread calls a 'foreign import'ed
-function, the runtime system(RTS) has to handle this in a manner
-transparent to other CH threads. That is, they shouldn't be blocked
-from making progress while the CH thread executes the external
-call. Presently, all threads will block.
-</p>
-<p>
-Clearly, we have to rely on OS-level threads in order to support this
-kind of concurrency. The implementation described here defines the 
-(abstract) OS threads interface that the RTS assumes. The implementation
-currently provides two instances of this interface, one for POSIX
-threads (pthreads) and one for the Win32 threads.
-</p>
-
-<!---- ***************************************  ----->
-<h3>Multi-threading the RTS</h3>
-
-<p>
-A simple and efficient way to implement non-blocking foreign calls is like this:
-<ul>
-<li> Invariant: only one OS thread is allowed to
-execute code inside of the GHC runtime system. [There are alternate
-designs, but I won't go into details on their pros and cons here.]
-We'll call the OS thread that is currently running Haskell threads
-the <em>Current Haskell Worker Thread</em>.
-<p>
-The Current Haskell Worker Thread repeatedly grabs a Haskell thread, executes it until its
-time-slice expires or it blocks on an MVar, then grabs another, and executes
-that, and so on.
-</p>
-<li>
-<p>
-When the Current Haskell Worker comes to execute a potentially blocking 'foreign
-import', it leaves the RTS and ceases being the Current Haskell Worker, but before doing so it makes certain that
-another OS worker thread is available to become the Current Haskell Worker.
-Consequently, even if the external call blocks, the new Current Haskell Worker
-continues execution of the other Concurrent Haskell threads.
-When the external call eventually completes, the Concurrent Haskell
-thread that made the call is passed the result and made runnable
-again.
-</p>
-<p>
-<li>
-A pool of OS threads are constantly trying to become the Current Haskell Worker.
-Only one succeeds at any moment.   If the pool becomes empty, the RTS creates more workers.
-<p><li>
-The OS worker threads are regarded as interchangeable.  A given Haskell thread
-may, during its lifetime, be executed entirely by one OS worker thread, or by more than one.
-There's just no way to tell.
-
-<p><li>If a foreign program wants to call a Haskell function, there is always a thread switch involved.
-The foreign program uses thread-safe mechanisms to create a Haskell thread and make it runnable; and
-the current Haskell Worker Thread exectutes it. See Section <a href="#callin">Calling in</a>.
-</ul>
-<p>
-The rest of this section describes the mechanics of implementing all
-this. There's two parts to it, one that describes how a native (OS) thread
-leaves the RTS to service the external call, the other how the same
-thread handles returning the result of the external call back to the
-Haskell thread.
-</p>
-
-<!---- ***************************************  ----->
-<h3>Making the external call</h3>
-
-<p>
-Presently, GHC handles 'safe' C calls by effectively emitting the
-following code sequence:
-</p>  
-
-<pre>
-    ...save thread state...
-    t = suspendThread();
-    r = foo(arg1,...,argn);
-    resumeThread(t);
-    ...restore thread state...
-    return r;
-</pre>
-
-<p>
-After having squirreled away the state of a Haskell thread,
-<tt>Schedule.c:suspendThread()</tt> is called which puts the current
-thread on a list [<tt>Schedule.c:suspended_ccalling_threads</tt>]
-containing threads that are currently blocked waiting for external calls
-to complete (this is done for the purposes of finding roots when
-garbage collecting).
-</p>
-
-<p>
-In addition to putting the Haskell thread on
-<tt>suspended_ccalling_threads</tt>, <tt>suspendThread()</tt> now also
-does the following:
-</p>
-<ul>
-<li>Instructs the <em>Task Manager</em> to make sure that there's a
-another native thread waiting in the wings to take over the execution
-of Haskell threads. This might entail creating a new
-<em>worker thread</em> or re-using one that's currently waiting for
-more work to do. The <a href="#taskman">Task Manager</a> section
-presents the functionality provided by this subsystem.
-</li>
-
-<li>Releases its capability to execute within the RTS. By doing
-so, another worker thread will become unblocked and start executing
-code within the RTS. See the <a href="#capability">Capability</a>
-section for details.
-</li>
-
-<li><tt>suspendThread()</tt> returns a token which is used to
-identify the Haskell thread that was added to
-<tt>suspended_ccalling_threads</tt>. This is done so that once the
-external call has completed, we know what Haskell thread to pull off
-the <tt>suspended_ccalling_threads</tt> list.
-</li>
-</ul>
-
-<p>
-Upon return from <tt>suspendThread()</tt>, the OS thread is free of
-its RTS executing responsibility, and can now invoke the external
-call. Meanwhile, the other worker thread that have now gained access
-to the RTS will continue executing Concurrent Haskell code. Concurrent
-'stuff' is happening!
-</p>
-
-<!---- ***************************************  ----->
-<h3>Returning the external result</h3>
-
-<p>
-When the native thread eventually returns from the external call,
-the result needs to be communicated back to the Haskell thread that
-issued the external call. The following steps takes care of this:
-</p>
-
-<ul>
-<li>The returning OS thread calls <tt>Schedule.c:resumeThread()</tt>,
-passing along the token referring to the Haskell thread that made the
-call we're returning from.
-</li>
-
-<li>
-The OS thread then tries to grab hold of a <em>returning worker
-capability</em>, via <tt>Capability.c:grabReturnCapability()</tt>.
-Until granted, the thread blocks waiting for RTS permissions. Clearly we
-don't want the thread to be blocked longer than it has to, so whenever
-a thread that is executing within the RTS enters the Scheduler (which
-is quite often, e.g., when a Haskell thread context switch is made),
-it checks to see whether it can give up its RTS capability to a
-returning worker, which is done by calling
-<tt>Capability.c:yieldToReturningWorker()</tt>.
-</li>
-
-<li>
-If a returning worker is waiting (the code in <tt>Capability.c</tt>
-keeps a counter of the number of returning workers that are currently
-blocked waiting), it is woken up and the given the RTS execution
-priviledges/capabilities of the worker thread that gave up its.
-</li>
-
-<li>
-The thread that gave up its capability then tries to re-acquire
-the capability to execute RTS code; this is done by calling
-<tt>Capability.c:waitForWorkCapability()</tt>.
-</li>
-
-<li>
-The returning worker that was woken up will continue execution in
-<tt>resumeThread()</tt>, removing its associated Haskell thread
-from the <tt>suspended_ccalling_threads</tt> list and start evaluating
-that thread, passing it the result of the external call.
-</li>
-</ul>
-
-<!---- ***************************************  ----->
-<h3 id="rts-exec">RTS execution</h3>
-
-<p>
-If a worker thread inside the RTS runs out of runnable Haskell
-threads, it goes to sleep waiting for the external calls to complete.
-It does this by calling <tt>waitForWorkCapability</tt>
-</p>
-
-<p>
-The availability of new runnable Haskell threads is signalled when:
-</p>
-
-<ul>
-<li>When an external call is set up in <tt>suspendThread()</tt>.</li>
-<li>When a new Haskell thread is created (e.g., whenever
-<tt>Concurrent.forkIO</tt> is called from within Haskell); this is
-signalled in <tt>Schedule.c:scheduleThread_()</tt>.
-</li>
-<li>Whenever a Haskell thread is removed from a 'blocking queue'
-attached to an MVar (only?).
-</li>
-</ul>
-
-<!---- ***************************************  ----->
-<h2 id="callin">Calling in</h2>
-
-Providing robust support for having multiple OS threads calling into
-Haskell is not as involved as its dual. 
-
-<ul>
-<li>The OS thread issues the call to a Haskell function by going via
-the <em>Rts API</em> (as specificed in <tt>RtsAPI.h</tt>). 
-<li>Making the function application requires the construction of a
-closure on the heap. This is done in a thread-safe manner by having
-the OS thread lock a designated block of memory (the 'Rts API' block,
-which is part of the GC's root set) for the short period of time it
-takes to construct the application.
-<li>The OS thread then creates a new Haskell thread to execute the
-function application, which (eventually) boils down to calling
-<tt>Schedule.c:createThread()</tt> 
-<li>
-Evaluation is kicked off by calling <tt>Schedule.c:scheduleExtThread()</tt>,
-which asks the Task Manager to possibly create a new worker (OS)
-thread to execute the Haskell thread.
-<li>
-After the OS thread has done this, it blocks waiting for the 
-Haskell thread to complete the evaluation of the Haskell function.
-<p>
-The reason why a separate worker thread is made to evaluate the Haskell
-function and not the OS thread that made the call-in via the
-Rts API, is that we want that OS thread to return as soon as possible.
-We wouldn't be able to guarantee that if the OS thread entered the 
-RTS to (initially) just execute its function application, as the
-Scheduler may side-track it and also ask it to evaluate other Haskell threads.
-</li>
-</ul>
-
-<p>
-<strong>Note:</strong> As of 20020413, the implementation of the RTS API
-only serializes access to the allocator between multiple OS threads wanting
-to call into Haskell (via the RTS API.) It does not coordinate this access
-to the allocator with that of the OS worker thread that's currently executing
-within the RTS. This weakness/bug is scheduled to be tackled as part of an
-overhaul/reworking of the RTS API itself.
-
-
-<!---- ***************************************  ----->
-<h2>Subsystems introduced/modified</h2>
-
-<p>
-These threads extensions affect the Scheduler portions of the runtime
-system. To make it more manageable to work with, the changes
-introduced a couple of new RTS 'sub-systems'. This section presents
-the functionality and API of these sub-systems.
-</p>
-
-<!---- ***************************************  ----->
-<h3 id="#capability">Capabilities</h3>
-
-<p>
-A Capability represent the token required to execute STG code,
-and all the state an OS thread/task needs to run Haskell code:
-its STG registers, a pointer to its TSO, a nursery etc. During
-STG execution, a pointer to the capabilitity is kept in a
-register (BaseReg).
-</p>
-<p>
-Only in an SMP build will there be multiple capabilities, for
-the threaded RTS and other non-threaded builds, there is only
-one global capability, namely <tt>MainCapability</tt>.
-
-<p>
-The Capability API is as follows:
-<pre>
-/* Capability.h */
-extern void initCapabilities(void);
-
-extern void grabReturnCapability(Mutex* pMutex, Capability** pCap);
-extern void waitForWorkCapability(Mutex* pMutex, Capability** pCap, rtsBool runnable);
-extern void releaseCapability(Capability* cap);
-
-extern void yieldToReturningWorker(Mutex* pMutex, Capability* cap);
-
-extern void grabCapability(Capability** cap);
-</pre>
-
-<ul>
-<li><tt>initCapabilities()</tt> initialises the subsystem.
-
-<li><tt>grabReturnCapability()</tt> is called by worker threads
-returning from an external call. It blocks them waiting to gain
-permissions to do so.
-
-<li><tt>waitForWorkCapability()</tt> is called by worker threads
-already inside the RTS, but without any work to do. It blocks them
-waiting for there to new work to become available.
-
-<li><tt>releaseCapability()</tt> hands back a capability. If a
-'returning worker' is waiting, it is signalled that a capability
-has become available. If not, <tt>releaseCapability()</tt> tries
-to signal worker threads that are blocked waiting inside
-<tt>waitForWorkCapability()</tt> that new work might now be
-available.
-
-<li><tt>yieldToReturningWorker()</tt> is called by the worker thread
-that's currently inside the Scheduler. It checks whether there are other
-worker threads waiting to return from making an external call. If so,
-they're given preference and a capability is transferred between worker
-threads. One of the waiting 'returning worker' threads is signalled and made
-runnable, with the other, yielding, worker blocking to re-acquire
-a capability.
-</ul>
-
-<p>
-The condition variables used to implement the synchronisation between
-worker consumers and providers are local to the Capability
-implementation. See source for details and comments.
-</p>
-
-<!---- ***************************************  ----->
-<h3 id="taskman">The Task Manager</h3>
-
-<p>
-The Task Manager API is responsible for managing the creation of
-OS worker RTS threads. When a Haskell thread wants to make an
-external call, the Task Manager is asked to possibly create a
-new worker thread to take over the RTS-executing capability of
-the worker thread that's exiting the RTS to execute the external call.
-
-<p>
-The Capability subsystem keeps track of idle worker threads, so
-making an informed decision about whether or not to create a new OS
-worker thread is easy work for the task manager. The Task manager
-provides the following API:
-</p>
-
-<pre>
-/* Task.h */
-extern void startTaskManager ( nat maxTasks, void (*taskStart)(void) );
-extern void stopTaskManager ( void );
-
-extern void startTask ( void (*taskStart)(void) );
-</pre>
-
-<ul>
-<li><tt>startTaskManager()</tt> and <tt>stopTaskManager()</tt> starts
-up and shuts down the subsystem. When starting up, you have the option
-to limit the overall number of worker threads that can be
-created. An unbounded (modulo OS thread constraints) number of threads
-is created if you pass '0'.
-<li><tt>startTask()</tt> is called when a worker thread calls
-<tt>suspendThread()</tt> to service an external call, asking another
-worker thread to take over its RTS-executing capability. It is also
-called when an external OS thread invokes a Haskell function via the
-<em>Rts API</em>.
-</ul>
-
-<!---- ***************************************  ----->
-<h3>Native threads API</h3>
-
-To hide OS details, the following API is used by the task manager and
-the scheduler to interact with an OS' threads API:
-
-<pre>
-/* OSThreads.h */
-typedef <em>..OS specific..</em> Mutex;
-extern void initMutex    ( Mutex* pMut );
-extern void grabMutex    ( Mutex* pMut );
-extern void releaseMutex ( Mutex* pMut );
-  
-typedef <em>..OS specific..</em> Condition;
-extern void    initCondition      ( Condition* pCond );
-extern void    closeCondition     ( Condition* pCond );
-extern rtsBool broadcastCondition ( Condition* pCond );
-extern rtsBool signalCondition    ( Condition* pCond );
-extern rtsBool waitCondition      ( Condition* pCond, 
-				    Mutex* pMut );
-
-extern OSThreadId osThreadId      ( void );
-extern void shutdownThread        ( void );
-extern void yieldThread           ( void );
-extern int  createOSThread        ( OSThreadId* tid,
-				    void (*startProc)(void) );
-</pre>
-
-
-
-<!---- ***************************************  ----->
-<h2>User-level interface</h2>
-
-To signal that you want an external call to be serviced by a separate
-OS thread, you have to add the attribute <tt>threadsafe</tt> to
-a foreign import declaration, i.e.,
-
-<pre>
-foreign import "bigComp" threadsafe largeComputation :: Int -> IO ()
-</pre>
-
-<p>
-The distinction between 'safe' and thread-safe C calls is made
-so that we may call external functions that aren't re-entrant but may
-cause a GC to occur.
-<p>
-The <tt>threadsafe</tt> attribute subsumes <tt>safe</tt>.
-</p>
-
-<!---- ***************************************  ----->
-<h2>Building the GHC RTS</h2>
-
-The multi-threaded extension isn't currently enabled by default. To
-have it built, you need to run the <tt>fptools</tt> configure script
-with the extra option <tt>--enable-threaded-rts</tt> turned on, and
-then proceed to build the compiler as per normal.
-
-<hr>
-<small>
-<!-- hhmts start --> Last modified: Wed Apr 10 14:21:57 Pacific Daylight Time 2002 <!-- hhmts end -->
-</small>
-</body> </html>
-
diff --git a/ghc/docs/comm/rts-libs/non-blocking.html b/ghc/docs/comm/rts-libs/non-blocking.html
deleted file mode 100644
index 627bde8d88..0000000000
--- a/ghc/docs/comm/rts-libs/non-blocking.html
+++ /dev/null
@@ -1,133 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Non-blocking I/O on Win32</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Non-blocking I/O on Win32</h1>
-    <p>
-
-This note discusses the implementation of non-blocking I/O on
-Win32 platforms.   It is not implemented yet (Apr 2002), but it seems worth
-capturing the ideas.  Thanks to Sigbjorn for writing them.
-
-<h2> Background</h2>
-
-GHC has provided non-blocking I/O support for Concurrent Haskell
-threads on platforms that provide 'UNIX-style' non-blocking I/O for
-quite a while. That is, platforms that let you alter the property of a
-file descriptor to instead of having a thread block performing an I/O
-operation that cannot be immediately satisfied, the operation returns
-back a special error code (EWOULDBLOCK.) When that happens, the CH
-thread that made the blocking I/O request is put into a blocked-on-IO
-state (see Foreign.C.Error.throwErrnoIfRetryMayBlock). The RTS will
-in a timely fashion check to see whether I/O is again possible
-(via a call to select()), and if it is, unblock the thread & have it
-re-try the I/O operation. The result is that other Concurrent Haskell
-threads won't be affected, but can continue operating while a thread
-is blocked on I/O.
-<p>
-Non-blocking I/O hasn't been supported by GHC on Win32 platforms, for
-the simple reason that it doesn't provide the OS facilities described
-above. 
-
-<h2>Win32 non-blocking I/O, attempt 1</h2>
-
-Win32 does provide something select()-like, namely the
-WaitForMultipleObjects() API. It takes an array of kernel object
-handles plus a timeout interval, and waits for either one (or all) of
-them to become 'signalled'. A handle representing an open file (for
-reading) becomes signalled once there is input available.
-<p>
-So, it is possible to observe that I/O is possible using this
-function, but not whether there's "enough" to satisfy the I/O request.
-So, if we were to mimic select() usage with WaitForMultipleObjects(),
-we'd correctly avoid blocking initially, but a thread may very well 
-block waiting for their I/O requests to be satisified once the file
-handle has become signalled. [There is a fix for this -- only read
-and write one byte at a the time -- but I'm not advocating that.]
-
-
-<h2>Win32 non-blocking I/O, attempt 2</h2>
-
-Asynchronous I/O on Win32 is supported via 'overlapped I/O'; that is,
-asynchronous read and write requests can be made via the ReadFile() /
-WriteFile () APIs, specifying position and length of the operation.
-If the I/O requests cannot be handled right away, the APIs won't
-block, but return immediately (and report ERROR_IO_PENDING as their
-status code.)
-<p>
-The completion of the request can be reported in a number of ways:
-<ul>
-  <li> synchronously, by blocking inside Read/WriteFile().  (this is the
-    non-overlapped case, really.)
-<p>
-
-  <li> as part of the overlapped I/O request, pass a HANDLE to an event
-    object. The I/O system will signal this event once the request
-    completed, which a waiting thread will then be able to see.
-<p>
-
-  <li> by supplying a pointer to a completion routine, which will be
-    called as an Asynchronous Procedure Call (APC) whenever a thread
-    calls a select bunch of 'alertable' APIs.
-<p>
-
-  <li> by associating the file handle with an I/O completion port.  Once
-    the request completes, the thread servicing the I/O completion
-    port will be notified.
-</ul>
-The use of I/O completion port looks the most interesting to GHC,
-as it provides a central point where all I/O requests are reported.
-<p>
-Note: asynchronous I/O is only fully supported by OSes based on
-the NT codebase, i.e., Win9x don't permit async I/O on files and
-pipes. However, Win9x does support async socket operations, and
-I'm currently guessing here, console I/O. In my view, it would
-be acceptable to provide non-blocking I/O support for NT-based
-OSes only.
-<p>
-Here's the design I currently have in mind:
-<ul>
-<li> Upon startup, an RTS helper thread whose only purpose is to service
-  an I/O completion port, is created.
-<p>
-<li> All files are opened in 'overlapping' mode, and associated
-  with an I/O completion port.
-<p>
-<li> Overlapped I/O requests are used to implement read() and write().
-<p>
-<li> If the request cannot be satisified without blocking, the Haskell
-  thread is put on the blocked-on-I/O thread list & a re-schedule
-  is made.
-<p>
-<li> When the completion of a request is signalled via the I/O completion
-  port, the RTS helper thread will move the associated Haskell thread
-  from the blocked list onto the runnable list. (Clearly, care
-  is required here to have another OS thread mutate internal Scheduler
-  data structures.)
-  
-<p>
-<li> In the event all Concurrent Haskell threads are blocked waiting on
-  I/O, the main RTS thread blocks waiting on an event synchronisation
-  object, which the helper thread will signal whenever it makes
-  a Haskell thread runnable.
-
-</ul>
-
-I might do the communication between the RTS helper thread and the 
-main RTS thread differently though: rather than have the RTS helper 
-thread manipluate thread queues itself, thus requiring careful 
-locking, just have it change a bit on the relevant TSO, which the main 
-RTS thread can check at regular intervals (in some analog of 
-awaitEvent(), for example).
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug  8 19:30:18 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/rts-libs/prelfound.html b/ghc/docs/comm/rts-libs/prelfound.html
deleted file mode 100644
index 25407eed43..0000000000
--- a/ghc/docs/comm/rts-libs/prelfound.html
+++ /dev/null
@@ -1,57 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Prelude Foundations</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Prelude Foundations</h1>
-    <p>
-      The standard Haskell Prelude as well as GHC's Prelude extensions are
-      constructed from GHC's <a href="primitives.html">primitives</a> in a
-      couple of layers.  
-
-    <h4><code>PrelBase.lhs</code></h4>
-    <p>
-      Some most elementary Prelude definitions are collected in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/lib/std/PrelBase.lhs"><code>PrelBase.lhs</code></a>.
-      In particular, it defines the boxed versions of Haskell primitive types
-      - for example, <code>Int</code> is defined as
-    <blockquote><pre>
-data Int = I# Int#</pre>
-    </blockquote>
-    <p>
-      Saying that a boxed integer <code>Int</code> is formed by applying the
-      data constructor <code>I#</code> to an <em>unboxed</em> integer of type
-      <code>Int#</code>.  Unboxed types are hardcoded in the compiler and
-      exported together with the <a href="primitives.html">primitive
-	operations</a> understood by GHC.
-    <p>
-      <code>PrelBase.lhs</code> similarly defines basic types, such as,
-      boolean values
-    <blockquote><pre>
-data  Bool  =  False | True  deriving (Eq, Ord)</pre>
-    </blockquote>
-    <p>
-      the unit type
-    <blockquote><pre>
-data  ()  =  ()</pre>
-    </blockquote>
-    <p>
-      and lists
-    <blockquote><pre>
-data [] a = [] | a : [a]</pre>
-    </blockquote>
-    <p>
-      It also contains instance delarations for these types.  In addition,
-      <code>PrelBase.lhs</code> contains some <a href="prelude.html">tricky
-      machinery</a> for efficient list handling.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug  8 19:30:18 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/rts-libs/prelude.html b/ghc/docs/comm/rts-libs/prelude.html
deleted file mode 100644
index 4ad6c20338..0000000000
--- a/ghc/docs/comm/rts-libs/prelude.html
+++ /dev/null
@@ -1,121 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Cunning Prelude Code</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Cunning Prelude Code</h1>
-    <p>
-      GHC's uses a many optimsations and GHC specific techniques (unboxed
-      values, RULES pragmas, and so on) to make the heavily used Prelude code
-      as fast as possible.
-
-    <hr>
-    <h4>Par, seq, and lazy</h4>
-
-    In GHC.Conc you will dinf
-<blockquote><pre>
-  pseq a b = a `seq` lazy b
-</pre></blockquote>
-   What's this "lazy" thing.  Well, <tt>pseq</tt> is a <tt>seq</tt> for a parallel setting.
-   We really mean "evaluate a, then b".  But if the strictness analyser sees that pseq is strict
-   in b, then b might be evaluated <em>before</em> a, which is all wrong. 
-<p>
-Solution: wrap the 'b' in a call to <tt>GHC.Base.lazy</tt>.  This function is just the identity function,
-except that it's put into the built-in environment in MkId.lhs.  That is, the MkId.lhs defn over-rides the
-inlining and strictness information that comes in from GHC.Base.hi.  And that makes <tt>lazy</tt> look
-lazy, and have no inlining.  So the strictness analyser gets no traction.
-<p>
-In the worker/wrapper phase, after strictness analysis, <tt>lazy</tt> is "manually" inlined (see WorkWrap.lhs),
-so we get all the efficiency back.
-<p>
-This supersedes an earlier scheme involving an even grosser hack in which par# and seq# returned an
-Int#.  Now there is no seq# operator at all.
-
-
-    <hr>
-    <h4>fold/build</h4>
-    <p>
-      There is a lot of magic in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/lib/std/PrelBase.lhs"><code>PrelBase.lhs</code></a> -
-      among other things, the <a
-	href="http://haskell.cs.yale.edu/ghc/docs/latest/set/rewrite-rules.html">RULES
-      pragmas</a> implementing the <a
-	href="http://research.microsoft.com/Users/simonpj/Papers/deforestation-short-cut.ps.Z">fold/build</a>
-	optimisation.  The code for <code>map</code> is
-      a good example for how it all works. In the prelude code for version
-      5.03 it reads as follows:
-    <blockquote><pre>
-map :: (a -> b) -> [a] -> [b]
-map _ []     = []
-map f (x:xs) = f x : map f xs
-
--- Note eta expanded
-mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
-{-# INLINE [0] mapFB #-}
-mapFB c f x ys = c (f x) ys
-
-{-# RULES
-"map"	    [~1] forall f xs.	map f xs		= build (\c n -> foldr (mapFB c f) n xs)
-"mapList"   [1]  forall f.	foldr (mapFB (:) f) []	= map f
-"mapFB"	    forall c f g.	mapFB (mapFB c f) g	= mapFB c (f.g) 
-  #-}</pre>
-    </blockquote>
-    <p>
-      Up to (but not including) phase 1, we use the <code>"map"</code> rule to
-      rewrite all saturated applications of <code>map</code> with its
-      build/fold form, hoping for fusion to happen.  In phase 1 and 0, we
-      switch off that rule, inline build, and switch on the
-      <code>"mapList"</code> rule, which rewrites the foldr/mapFB thing back
-      into plain map.
-    <p>
-      It's important that these two rules aren't both active at once 
-      (along with build's unfolding) else we'd get an infinite loop 
-      in the rules.  Hence the activation control using explicit phase numbers.
-    <p>
-      The "mapFB" rule optimises compositions of map.
-    <p>
-      The mechanism as described above is new in 5.03 since January 2002,
-      where the <code>[~</code><i>N</i><code>]</code> syntax for phase number
-      annotations at rules was introduced.  Before that the whole arrangement
-      was more complicated, as the corresponding prelude code for version
-      4.08.1 shows:
-    <blockquote><pre>
-map :: (a -> b) -> [a] -> [b]
-map = mapList
-
--- Note eta expanded
-mapFB ::  (elt -> lst -> lst) -> (a -> elt) -> a -> lst -> lst
-mapFB c f x ys = c (f x) ys
-
-mapList :: (a -> b) -> [a] -> [b]
-mapList _ []     = []
-mapList f (x:xs) = f x : mapList f xs
-
-{-# RULES
-"map"	  forall f xs.  map f xs	       = build (\c n -> foldr (mapFB c f) n xs)
-"mapFB"	  forall c f g. mapFB (mapFB c f) g    = mapFB c (f.g) 
-"mapList" forall f.	foldr (mapFB (:) f) [] = mapList f
- #-}</pre>
-    </blockquote>
-    <p>
-      This code is structured as it is, because the "map" rule first
-      <em>breaks</em> the map <em>open,</em> which exposes it to the various
-      foldr/build rules, and if no foldr/build rule matches, the "mapList"
-      rule <em>closes</em> it again in a later phase of optimisation - after
-      build was inlined.  As a consequence, the whole thing depends a bit on
-      the timing of the various optimsations (the map might be closed again
-      before any of the foldr/build rules fires).  To make the timing
-      deterministic, <code>build</code> gets a <code>{-# INLINE 2 build
-      #-}</code> pragma, which delays <code>build</code>'s inlining, and thus,
-      the closing of the map. [NB: Phase numbering was forward at that time.]
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Mon Feb 11 20:00:49 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/rts-libs/primitives.html b/ghc/docs/comm/rts-libs/primitives.html
deleted file mode 100644
index 28abc79426..0000000000
--- a/ghc/docs/comm/rts-libs/primitives.html
+++ /dev/null
@@ -1,70 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Primitives</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Primitives</h1>
-    <p>
-      Most user-level Haskell types and functions provided by GHC (in
-      particular those from the Prelude and GHC's Prelude extensions) are
-      internally constructed from even more elementary types and functions.
-      Most notably, GHC understands a notion of <em>unboxed types,</em> which
-      are the Haskell representation of primitive bit-level integer, float,
-      etc. types (as opposed to their boxed, heap allocated counterparts) -
-      cf. <a
-	href="http://research.microsoft.com/Users/simonpj/Papers/unboxed-values.ps.Z">"Unboxed
-	Values as First Class Citizens."</a>
-
-    <h4>The Ultimate Source of Primitives</h4>
-    <p>
-      The hardwired types of GHC are brought into scope by the module
-      <code>PrelGHC</code>.  This modules only exists in the form of a
-      handwritten interface file <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/lib/std/PrelGHC.hi-boot"><code>PrelGHC.hi-boot</code>,</a>
-      which lists the type and function names, as well as instance
-      declarations.  The actually types of these names as well as their
-      implementation is hardwired into GHC.  Note that the names in this file
-      are z-encoded, and in particular, identifiers ending on <code>zh</code>
-      denote user-level identifiers ending in a hash mark (<code>#</code>),
-      which is used to flag unboxed values or functions operating on unboxed
-      values.  For example, we have <code>Char#</code>, <code>ord#</code>, and
-      so on. 
-
-    <h4>The New Primitive Definition Scheme</h4>
-    <p>
-      As of (about) the development version 4.11, the types and various
-      properties of primitive operations are defined in the file <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/primops.txt.pp"><code>primops.txt.pp</code></a>.
-      (Personally, I don't think that the <code>.txt</code> suffix is really
-      appropriate, as the file is used for automatic code generation; the
-      recent addition of <code>.pp</code> means that the file is now mangled
-      by cpp.)
-    <p>
-      The utility <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/utils/genprimopcode/"><code>genprimopcode</code></a> 
-      generates a series of Haskell files from <code>primops.txt</code>, which
-      encode the types and various properties of the primitive operations as
-      compiler internal data structures.  These Haskell files are not complete
-      modules, but program fragments, which are included into compiler modules
-      during the GHC build process.  The generated include files can be found
-      in the directory <code>fptools/ghc/compiler/</code> and carry names
-      matching the pattern <code>primop-*.hs-incl</code>.  They are generate
-      during the execution of the <code>boot</code> target in the
-      <code>fptools/ghc/</code> directory.  This scheme significantly
-      simplifies the maintenance of primitive operations.
-    <p> 
-      As of development version 5.02, the <code>primops.txt</code> file also allows the
-      recording of documentation about intended semantics of the primitives.  This can
-      be extracted into a latex document (or rather, into latex document fragments)
-      via an appropriate switch to <code>genprimopcode</code>. In particular, see <code>primops.txt</code>
-      for full details of how GHC is configured to cope with different machine word sizes.
-    <p><small>
-<!-- hhmts start -->
-Last modified: Mon Nov 26 18:03:16 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/rts-libs/stgc.html b/ghc/docs/comm/rts-libs/stgc.html
deleted file mode 100644
index 196ec9150d..0000000000
--- a/ghc/docs/comm/rts-libs/stgc.html
+++ /dev/null
@@ -1,45 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Spineless Tagless C</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Spineless Tagless C</h1>
-    <p>
-      The C code generated by GHC doesn't use higher-level features of C to be
-      able to control as precisely as possible what code is generated.
-      Moreover, it uses special features of gcc (such as, first class labels)
-      to produce more efficient code.
-    <p>
-      STG C makes ample use of C's macro language to define idioms, which also
-      reduces the size of the generated C code (thus, reducing I/O times).
-      These macros are defined in the C headers located in GHC's <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/includes/"><code>includes</code></a>
-      directory.
-
-    <h4><code>TailCalls.h</code></h4>
-    <p>
-      <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/includes/TailCalls.h"><code>TailCalls.h</code></a>
-      defines how tail calls are implemented - and in particular - optimised
-      in GHC generated code.  The default case, for an architecture for which
-      GHC is not optimised, is to use the mini interpreter described in the <a
-	href="http://research.microsoft.com/copyright/accept.asp?path=/users/simonpj/papers/spineless-tagless-gmachine.ps.gz&pub=34">STG paper.</a>
-    <p>
-      For supported architectures, various tricks are used to generate
-      assembler implementing proper tail calls.  On i386, gcc's first class
-      labels are used to directly jump to a function pointer.  Furthermore,
-      markers of the form <code>--- BEGIN ---</code> and <code>--- END
-      ---</code> are added to the assembly right after the function prologue
-      and before the epilogue.  These markers are used by <a
-	href="../the-beast/mangler.html">the Evil Mangler.</a>
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug  8 19:28:29 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/rts-libs/threaded-rts.html b/ghc/docs/comm/rts-libs/threaded-rts.html
deleted file mode 100644
index 499aeec767..0000000000
--- a/ghc/docs/comm/rts-libs/threaded-rts.html
+++ /dev/null
@@ -1,126 +0,0 @@
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-      <title>The GHC Commentary - The Multi-threaded runtime, and multiprocessor execution</title>
-  </head>
-
-  <body>
-    <h1>The GHC Commentary - The Multi-threaded runtime, and multiprocessor execution</h1>
-    
-    <p>This section of the commentary explains the structure of the runtime system
-      when used in threaded or SMP mode.</p>
-
-    <p>The <em>threaded</em> version of the runtime supports
-      bound threads and non-blocking foreign calls, and an overview of its
-      design can be found in the paper <a
-	href="http://www.haskell.org/~simonmar/papers/conc-ffi.pdf">Extending
-	the Haskell Foreign Function Interface with Concurrency</a>.  To
-      compile the runtime with threaded support, add the line
-
-<pre>GhcRTSWays += thr</pre>
-
-    to <tt>mk/build.mk</tt>.  When building C code in the runtime for the threaded way,
-      the symbol <tt>THREADED_RTS</tt> is defined (this is arranged by the
-      build system when building for way <tt>thr</tt>, see
-      <tt>mk/config.mk</tt>).  To build a Haskell program
-      with the threaded runtime, pass the flag <tt>-threaded</tt> to GHC (this
-      can be used in conjunction with <tt>-prof</tt>, and possibly
-      <tt>-debug</tt> and others depending on which versions of the RTS have
-      been built.</p>
-
-    <p>The <em>SMP</em> version runtime supports the same facilities as the
-      threaded version, and in addition supports execution of Haskell code by
-      multiple simultaneous OS threads.  For SMP support, both the runtime and
-      the libraries must be built a special way: add the lines
-
-   <pre>
-GhcRTSWays += thr
-GhcLibWays += s</pre>
-
-    to <tt>mk/build.mk</tt>.  To build Haskell code for
-      SMP execution, use the flag <tt>-smp</tt> to GHC (this can be used in
-      conjunction with <tt>-debug</tt>, but no other way-flags at this time).
-      When building C code in the runtime for SMP
-      support, the symbol <tt>SMP</tt> is defined (this is arranged by the
-      compiler when the <tt>-smp</tt> flag is given, see
-      <tt>ghc/compiler/main/StaticFlags.hs</tt>).</p>
-
-    <p>When building the runtime in either the threaded or SMP ways, the symbol
-      <tt>RTS_SUPPORTS_THREADS</tt> will be defined (see <tt>Rts.h</tt>).</p>
-
-    <h2>Overall design</h2>
-
-    <p>The system is based around the notion of a <tt>Capability</tt>.  A
-      <tt>Capability</tt> is an object that represents both the permission to
-      execute some Haskell code, and the state required to do so.  In order
-      to execute some Haskell code, a thread must therefore hold a
-      <tt>Capability</tt>.  The available pool of capabilities is managed by
-      the <tt>Capability</tt> API, described below.</p>
-
-    <p>In the threaded runtime, there is only a single <tt>Capabililty</tt> in the
-      system, indicating that only a single thread can be executing Haskell
-      code at any one time.  In the SMP runtime, there can be an arbitrary
-      number of capabilities selectable at runtime with the <tt>+RTS -N<em>n</em></tt>
-      flag; in practice the number is best chosen to be the same as the number of
-      processors on the host machine.</p>
-
-    <p>There are a number of OS threads running code in the runtime.  We call
-      these <em>tasks</em> to avoid confusion with Haskell <em>threads</em>.
-      Tasks are managed by the <tt>Task</tt> subsystem, which is mainly
-      concerned with keeping track of statistics such as how much time each
-      task spends executing Haskell code, and also keeping track of how many
-      tasks are around when we want to shut down the runtime.</p>
-
-    <p>Some tasks are created by the runtime itself, and some may be here
-      as a result of a call to Haskell from foreign code (we
-      call this an in-call).  The
-      runtime can support any number of concurrent foreign in-calls, but the
-      number of these calls that will actually run Haskell code in parallel is
-      determined by the number of available capabilities.  Each in-call creates
-      a <em>bound thread</em>, as described in the FFI/Concurrency paper (cited
-      above).</p>
-
-    <p>In the future we may want to bind a <tt>Capability</tt> to a particular
-      processor, so that we can support a notion of affinity - avoiding
-      accidental migration of work from one CPU to another, so that we can make
-      best use of a CPU's local cache.  For now, the design ignores this
-      issue.</p>
-
-    <h2>The <tt>OSThreads</tt> interface</h2>
-
-    <p>This interface is merely an abstraction layer over the OS-specific APIs
-      for managing threads.  It has two main implementations: Win32 and
-      POSIX.</p>
-
-    <p>This is the entirety of the interface:</p>
-
-<pre>
-/* Various abstract types */
-typedef Mutex;
-typedef Condition;
-typedef OSThreadId;
-
-extern OSThreadId osThreadId      ( void );
-extern void shutdownThread        ( void );
-extern void yieldThread           ( void );
-extern int  createOSThread        ( OSThreadId* tid,
-				    void (*startProc)(void) );
-
-extern void initCondition         ( Condition* pCond );
-extern void closeCondition        ( Condition* pCond );
-extern rtsBool broadcastCondition ( Condition* pCond );
-extern rtsBool signalCondition    ( Condition* pCond );
-extern rtsBool waitCondition      ( Condition* pCond, 
-				    Mutex* pMut );
-
-extern void initMutex             ( Mutex* pMut );
-    </pre>
-
-    <h2>The Task interface</h2>
-
-    <h2>The Capability interface</h2>
-
-    <h2>Multiprocessor Haskell Execution</h2>
-
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/alien.html b/ghc/docs/comm/the-beast/alien.html
deleted file mode 100644
index 3d4776ebc9..0000000000
--- a/ghc/docs/comm/the-beast/alien.html
+++ /dev/null
@@ -1,56 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Alien Functions</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Alien Functions</h1>
-    <p>
-      GHC implements experimental (by now it is actually quite well tested)
-      support for access to foreign functions and generally the interaction
-      between Haskell code and code written in other languages.  Code
-      generation in this context can get quite tricky.  This section attempts
-      to cast some light on this aspect of the compiler.
-
-    <h4>FFI Stub Files</h4>
-    <p>
-      For each Haskell module that contains a <code>foreign export
-      dynamic</code> declaration, GHC generates a <code>_stub.c</code> file
-      that needs to be linked with any program that imports the Haskell
-      module.  When asked about it <a
-      href="mailto:simonmar@microsoft.com">Simon Marlow</a> justified the
-      existence of these files as follows:
-    <blockquote>
-      The stub files contain the helper function which invokes the Haskell
-      code when called from C.
-      <p>
-	Each time the foreign export dynamic is invoked to create a new
-	callback function, a small piece of code has to be dynamically
-	generated (by code in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/rts/Adjustor.c"><code>Adjustor.c</code></a>).  It is the address of this dynamically generated bit of
-	code that is returned as the <code>Addr</code> (or <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/hslibs/lang/Ptr.lhs"><code>Ptr</code></a>).
-	When called from C, the dynamically generated code must somehow invoke
-	the Haskell function which was originally passed to the
-	f.e.d. function -- it does this by invoking the helper function,
-	passing it a <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/hslibs/lang/StablePtr.lhs"><code>StablePtr</code></a>
-	to the Haskell function.  It's split this way for two reasons: the
-	same helper function can be used each time the f.e.d. function is
-	called, and to keep the amount of dynamically generated code to a
-	minimum.
-    </blockquote>
-    <p>
-      The stub code is generated by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsForeign.lhs"><code>DSForeign</code></a><code>.fexportEntry</code>.
-
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Fri Aug 10 11:47:41 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/basicTypes.html b/ghc/docs/comm/the-beast/basicTypes.html
deleted file mode 100644
index ca56d6b6a8..0000000000
--- a/ghc/docs/comm/the-beast/basicTypes.html
+++ /dev/null
@@ -1,132 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Basics</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Basics</h1>
-    <p>
-      The directory <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/"><code>fptools/ghc/compiler/basicTypes/</code></a> 
-      contains modules that define some of the essential types definition for
-      the compiler - such as, identifiers, variables, modules, and unique
-      names.  Some of those are discussed in the following.  See elsewhere for more
-      detailed information on:
-      <ul>
-      <li> <a href="vars.html"><code>Var</code>s, <code>Id</code>s, and <code>TyVar</code>s</a>
-      <li> <a href="renamer.html"><code>OccName</code>s, <code>RdrName</code>s, and <code>Names</code>s</a>
-      </ul>
-
-    <h2>Elementary Types</h2>
-
-    <h4><code>Id</code>s</h4>
-    <p>
-      An <code>Id</code> (defined in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/Id.lhs"><code>Id.lhs</code></a>
-      essentially records information about value and data constructor
-      identifiers -- to be precise, in the case of data constructors, two
-      <code>Id</code>s are used to represent the worker and wrapper functions
-      for the data constructor, respectively.  The information maintained in
-      the <code>Id</code> abstraction includes among other items strictness,
-      occurrence, specialisation, and unfolding information.
-    <p>
-      Due to the way <code>Id</code>s are used for data constructors,
-      all <code>Id</code>s are represented as variables, which contain a
-      <code>varInfo</code> field of abstract type <code><a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/IdInfo.lhs">IdInfo</a>.IdInfo</code>.  
-      This is where the information about <code>Id</code>s is really stored.
-      The following is a (currently, partial) list of the various items in an
-      <code>IdInfo</code>:
-    <p>
-    <dl>
-      <dt><a name="occInfo">Occurence information</a>
-      <dd>The <code>OccInfo</code> data type is defined in the module <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/BasicTypes.lhs"><code>BasicTypes.lhs</code></a>.
-	Apart from the trivial <code>NoOccInfo</code>, it distinguishes
-	between variables that do not occur at all (<code>IAmDead</code>),
-	occur just once (<code>OneOcc</code>), or a <a
-	  href="simplifier.html#loopBreaker">loop breakers</a>
-	(<code>IAmALoopBreaker</code>).
-    </dl>
-
-    <h2>Sets, Finite Maps, and Environments</h2>
-    <p>
-      Sets of variables, or more generally names, which are needed throughout
-      the compiler, are provided by the modules <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/VarSet.lhs"><code>VarSet.lhs</code></a>
-      and <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/NameSet.lhs"><code>NameSet.lhs</code></a>,
-      respectively.  Moreover, frequently maps from variables (or names) to
-      other data is needed.  For example, a substitution is represented by a
-      finite map from variable names to expressions.  Jobs like this are
-      solved by means of variable and name environments implemented by the
-      modules <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/VarEnv.lhs"><code>VarEnv.lhs</code></a>
-      and <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/NameEnv.lhs"><code>NameEnv.lhs</code></a>.
-
-    <h4>The Module <code>VarSet</code></h4>
-    <p>
-      The Module <code>VarSet</code> provides the types <code>VarSet</code>,
-      <code>IdSet</code>, and <code>TyVarSet</code>, which are synonyms in the
-      current implementation, as <code>Var</code>, <code>Id</code>, and
-      <code>TyVar</code> are synonyms.  The module provides all the operations
-      that one would expect including the creating of sets from individual
-      variables and lists of variables, union and intersection operations,
-      element checks, deletion, filter, fold, and map functions.
-    <p>
-      The implementation is based on <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/utils/UniqSet.lhs"><code>UniqSet</code></a>s, 
-      which in turn are simply <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/utils/UniqFM.lhs"><code>UniqFM</code></a>s
-      (i.e., finite maps with uniques as keys) that map each unique to the
-      variable that it represents.
-      
-    <h4>The Module <code>NameSet</code></h4>
-    <p>
-      The Module <code>NameSet</code> provides the same functionality as
-      <code>VarSet</code> only for <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/Name.lhs"><code>Name</code></a>s.
-      As for the difference between <code>Name</code>s and <code>Var</code>s,
-      a <code>Var</code> is built from a <code>Name</code> plus additional
-      information (mostly importantly type information).
-
-    <h4>The Module <code>VarEnv</code></h4>
-    <p>
-      The module <code>VarEnv</code> provides the types <code>VarEnv</code>,
-      <code>IdEnv</code>, and <code>TyVarEnv</code>, which are again
-      synonyms.  The provided base functionality is similar to
-      <code>VarSet</code> with the main difference that a type <code>VarEnv
-      T</code> associates a value of type <code>T</code> with each variable in
-      the environment, thus effectively implementing a finite map from
-      variables to values of type <code>T</code>.
-    <p>
-      The implementation of <code>VarEnv</code> is also by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/utils/UniqFM.lhs"><code>UniqFM</code></a>,
-      which entails the slightly surprising implication that it is
-      <em>not</em> possible to retrieve the domain of a variable environment.
-      In other words, there is no function corresponding to
-      <code>VarSet.varSetElems :: VarSet -> [Var]</code> in
-      <code>VarEnv</code>.  This is because the <code>UniqFM</code> used to
-      implement <code>VarEnv</code> stores only the unique corresponding to a
-      variable in the environment, but not the entire variable (and there is
-      no mapping from uniques to variables).
-    <p>
-      In addition to plain variable environments, the module also contains
-      special substitution environments - the type <code>SubstEnv</code> -
-      that associates variables with a special purpose type
-      <code>SubstResult</code>.
-
-    <h4>The Module <code>NameEnv</code></h4>
-    <p>
-      The type <code>NameEnv.NameEnv</code> is like <code>VarEnv</code> only
-      for <code>Name</code>s.
-
-    <p><hr><small>
-<!-- hhmts start -->
-Last modified: Tue Jan  8 18:29:52 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/coding-style.html b/ghc/docs/comm/the-beast/coding-style.html
deleted file mode 100644
index 41347c6902..0000000000
--- a/ghc/docs/comm/the-beast/coding-style.html
+++ /dev/null
@@ -1,230 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Coding Style Guidelines</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Coding Style Guidelines</h1>
-    
-    <p>This is a rough description of some of the coding practices and
-    style that we use for Haskell code inside <tt>ghc/compiler</tt>.
-
-    <p>The general rule is to stick to the same coding style as is
-    already used in the file you're editing.  If you must make
-    stylistic changes, commit them separately from functional changes,
-    so that someone looking back through the change logs can easily
-    distinguish them.
-
-    <h2>To literate or not to literate?</h2>
-
-    <p>In GHC we use a mixture of literate (<tt>.lhs</tt>) and
-    non-literate (<tt>.hs</tt>) source.  I (Simon M.) prefer to use
-    non-literate style, because I think the
-    <tt>\begin{code}..\end{code}</tt> clutter up the source too much,
-    and I like to use Haddock-style comments (we haven't tried
-    processing the whole of GHC with Haddock yet, though).
-
-    <h2>To CPP or not to CPP?</h2>
-
-    <p>We pass all the compiler sources through CPP.  The
-    <tt>-cpp</tt> flag is always added by the build system.  
-
-    <p>The following CPP symbols are used throughout the compiler:
-    
-    <dl>
-      <dt><tt>DEBUG</tt></dt>
-
-      <dd>Used to enables extra checks and debugging output in the
-      compiler.  The <tt>ASSERT</tt> macro (see <tt>HsVersions.h</tt>)
-      provides assertions which disappear when <tt>DEBUG</tt> is not
-      defined.
-
-      <p>All debugging output should be placed inside <tt>#ifdef
-      DEBUG</tt>; we generally use this to provide warnings about
-      strange cases and things that might warrant investigation.  When
-      <tt>DEBUG</tt> is off, the compiler should normally be silent
-      unless something goes wrong (exception when the verbosity level
-      is greater than zero).
-
-      <p>A good rule of thumb is that <tt>DEBUG</tt> shouldn't add
-      more than about 10-20% to the compilation time.  This is the case
-      at the moment.  If it gets too expensive, we won't use it.  For
-      more expensive runtime checks, consider adding a flag - see for
-      example <tt>-dcore-lint</tt>.
-      </dd>
-
-      <dt><tt>GHCI</tt></dt>
-      
-      <dd>Enables GHCi support, including the byte code generator and
-      interactive user interface.  This isn't the default, because the
-      compiler needs to be bootstrapped with itself in order for GHCi
-      to work properly.  The reason is that the byte-code compiler and
-      linker are quite closely tied to the runtime system, so it is
-      essential that GHCi is linked with the most up-to-date RTS.
-      Another reason is that the representation of certain datatypes
-      must be consistent between GHCi and its libraries, and if these
-      were inconsistent then disaster could follow.
-      </dd>
-
-    </dl>
-
-    <h2>Platform tests</h2>
-
-    <p>There are three platforms of interest to GHC:
- 
-    <ul>
-      <li>The <b>Build</b> platform.  This is the platform on which we
-      are building GHC.</li>
-      <li>The <b>Host</b> platform.  This is the platform on which we
-      are going to run this GHC binary, and associated tools.</li>
-      <li>The <b>Target</b> platform.  This is the platform for which
-      this GHC binary will generate code.</li>
-    </ul>
-
-    <p>At the moment, there is very limited support for having
-    different values for buil, host, and target.  In particular:</p>
-
-    <ul>
-      <li>The build platform is currently always the same as the host
-      platform.  The build process needs to use some of the tools in
-      the source tree, for example <tt>ghc-pkg</tt> and
-      <tt>hsc2hs</tt>.</li>
-      
-      <li>If the target platform differs from the host platform, then
-      this is generally for the purpose of building <tt>.hc</tt> files
-      from Haskell source for porting GHC to the target platform.
-      Full cross-compilation isn't supported (yet).</li>
-    </ul>
-
-    <p>In the compiler's source code, you may make use of the
-    following CPP symbols:</p>
-
-    <ul>
-      <li><em>xxx</em><tt>_TARGET_ARCH</tt></li>
-      <li><em>xxx</em><tt>_TARGET_VENDOR</tt></li>
-      <li><em>xxx</em><tt>_TARGET_OS</tt></li>
-      <li><em>xxx</em><tt>_HOST_ARCH</tt></li>
-      <li><em>xxx</em><tt>_HOST_VENDOR</tt></li>
-      <li><em>xxx</em><tt>_HOST_OS</tt></li>
-    </ul>
-    
-    <p>where <em>xxx</em> is the appropriate value:
-    eg. <tt>i386_TARGET_ARCH</tt>.
-
-    <h2>Compiler versions</h2>
-
-    <p>GHC must be compilable by every major version of GHC from 5.02
-    onwards, and itself.  It isn't necessary for it to be compilable
-    by every intermediate development version (that includes last
-    week's CVS sources).
-
-    <p>To maintain compatibility, use <tt>HsVersions.h</tt> (see
-    below) where possible, and try to avoid using <tt>#ifdef</tt> in
-    the source itself.
-
-    <h2>The source file</h2>
-
-    <p>We now describe a typical source file, annotating stylistic
-    choices as we go.
-
-<pre>
-{-# OPTIONS ... #-}
-</pre>
-
-    <p>An <tt>OPTIONS</tt> pragma is optional, but if present it
-    should go right at the top of the file.  Things you might want to
-    put in <tt>OPTIONS</tt> include:
-
-    <ul>
-      <li><tt>-#include</tt> options to bring into scope prototypes
-      for FFI declarations</li>
-      <li><tt>-fvia-C</tt> if you know that
-      this module won't compile with the native code generator.
-    </ul>
-
-    <p>Don't bother putting <tt>-cpp</tt> or <tt>-fglasgow-exts</tt>
-    in the <tt>OPTIONS</tt> pragma; these are already added to the
-    command line by the build system.
-
-
-<pre>
-module Foo (
-   T(..),
-   foo,	     -- :: T -> T
- ) where
-</pre>
-
-    <p>We usually (99% of the time) include an export list.  The only
-    exceptions are perhaps where the export list would list absolutely
-    everything in the module, and even then sometimes we do it anyway.
-
-    <p>It's helpful to give type signatures inside comments in the
-    export list, but hard to keep them consistent, so we don't always
-    do that.
-
-<pre>
-#include "HsVersions.h"
-</pre>
-
-    <p><tt>HsVersions.h</tt> is a CPP header file containing a number
-    of macros that help smooth out the differences between compiler
-    versions.  It defines, for example, macros for library module
-    names which have moved between versions.  Take a look.
-
-<pre>
--- friends
-import SimplMonad
-
--- GHC
-import CoreSyn
-import Id           ( idName, idType )
-import BasicTypes
-
--- libraries
-import DATA_IOREF   ( newIORef, readIORef )
-
--- std
-import List         ( partition )
-import Maybe        ( fromJust )
-</pre>
-
-   <p>List imports in the following order:
-   
-   <ul>
-     <li>Local to this subsystem (or directory) first</li>
-
-     <li>Compiler imports, generally ordered from specific to generic
-       (ie. modules from <tt>utils/</tt> and <tt>basicTypes/</tt>
-       usually come last)</li>
-
-     <li>Library imports</li>
-
-     <li>Standard Haskell 98 imports last</li>
-   </ul>
-
-   <p>Import library modules from the <tt>base</tt> and
-   <tt>haskell98</tt> packages only.  Use <tt>#defines</tt> in
-   <tt>HsVersions.h</tt> when the modules names differ between
-   versions of GHC (eg. <tt>DATA_IOREF</tt> in the example above).
-   For code inside <tt>#ifdef GHCI</tt>, don't need to worry about GHC
-   versioning (because we are bootstrapped).
-
-   <p>We usually use import specs to give an explicit list of the
-   entities imported from a module.  The main reason for doing this is
-   so that you can search the file for an entity and find which module
-   it comes from.  However, huge import lists can be a pain to
-   maintain, so we often omit the import specs when they start to get
-   long (actually I start omitting them when they don't fit on one
-   line --Simon M.).  Tip: use GHC's <tt>-fwarn-unused-imports</tt>
-   flag so that you get notified when an import isn't being used any
-   more.
-
-   <p>If the module can be compiled multiple ways (eg. GHCI
-   vs. non-GHCI), make sure the imports are properly <tt>#ifdefed</tt>
-   too, so as to avoid spurious unused import warnings.
-
-   <p><em>ToDo: finish this</em>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/data-types.html b/ghc/docs/comm/the-beast/data-types.html
deleted file mode 100644
index fef4852d4d..0000000000
--- a/ghc/docs/comm/the-beast/data-types.html
+++ /dev/null
@@ -1,242 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Data types and data constructors</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Data types and data constructors</h1>
-    <p>
-
-This chapter was thoroughly changed Feb 2003.
-
-<h2>Data types</h2>
-
-Consider the following data type declaration:
-
-<pre>
-  data T a = MkT !(a,a) !(T a) | Nil
-
-  f x = case x of
-          MkT p q -> MkT p (q+1)
-	  Nil     -> Nil
-</pre>
-The user's source program mentions only the constructors <tt>MkT</tt>
-and <tt>Nil</tt>.  However, these constructors actually <em>do</em> something
-in addition to building a data value.  For a start, <tt>MkT</tt> evaluates
-its arguments.  Secondly, with the flag <tt>-funbox-strict-fields</tt> GHC
-will flatten (or unbox) the strict fields.  So we may imagine that there's the
-<em>source</em> constructor <tt>MkT</tt> and the <em>representation</em> constructor
-<tt>MkT</tt>, and things start to get pretty confusing.
-<p>
-GHC now generates three unique <tt>Name</tt>s for each data constructor:
-<pre>
-                                 ---- OccName ------
-			         String  Name space	Used for
-  ---------------------------------------------------------------------------
-  The "source data con" 	   MkT	  DataName	The DataCon itself
-  The "worker data con"		   MkT	  VarName	Its worker Id
-    aka "representation data con"
-  The "wrapper data con"	   $WMkT  VarName	Its wrapper Id (optional)
-</pre>
-Recall that each occurrence name (OccName) is a pair of a string and a
-name space (see <a href="names.html">The truth about names</a>), and
-two OccNames are considered the same only if both components match.
-That is what distinguishes the name of the name of the DataCon from
-the name of its worker Id.  To keep things unambiguous, in what
-follows we'll write "MkT{d}" for the source data con, and "MkT{v}" for
-the worker Id.  (Indeed, when you dump stuff with "-ddumpXXX", if you
-also add "-dppr-debug" you'll get stuff like "Foo {- d rMv -}". The
-"d" part is the name space; the "rMv" is the unique key.)
-<p>
-Each of these three names gets a distinct unique key in GHC's name cache.
-
-<h2>The life cycle of a data type</h2>
-
-Suppose the Haskell source looks like this:
-<pre>
-  data T a = MkT !(a,a) !Int | Nil
-
-  f x = case x of
-          Nil     -> Nil
-          MkT p q -> MkT p (q+1)
-</pre>
-When the parser reads it in, it decides which name space each lexeme comes
-from, thus:
-<pre>
-  data T a = MkT{d} !(a,a) !Int | Nil{d}
-
-  f x = case x of
-          Nil{d}     -> Nil{d}
-          MkT{d} p q -> MkT{d} p (q+1)
-</pre>
-Notice that in the Haskell source <em>all data contructors are named via the "source data con" MkT{d}</em>,
-whether in pattern matching or in expressions.
-<p>
-In the translated source produced by the type checker (-ddump-tc), the program looks like this:
-<pre>
-  f x = case x of
-          Nil{d}     -> Nil{v}
-          MkT{d} p q -> $WMkT p (q+1)
-	  
-</pre>
-Notice that the type checker replaces the occurrence of MkT by the <em>wrapper</em>, but
-the occurrence of Nil by the <em>worker</em>.  Reason: Nil doesn't have a wrapper because there is
-nothing to do in the wrapper (this is the vastly common case).
-<p>
-Though they are not printed out by "-ddump-tc", behind the scenes, there are
-also the following: the data type declaration and the wrapper function for MkT.
-<pre>
-  data T a = MkT{d} a a Int# | Nil{d}
- 
-  $WMkT :: (a,a) -> T a -> T a
-  $WMkT p t = case p of 
-                (a,b) -> seq t (MkT{v} a b t)
-</pre>
-Here, the <em>wrapper</em> <tt>$WMkT</tt> evaluates and takes apart the argument <tt>p</tt>,
-evaluates the argument <tt>t</tt>, and builds a three-field data value
-with the <em>worker</em> constructor <tt>MkT{v}</tt>.  (There are more notes below
-about the unboxing of strict fields.)  The worker $WMkT is called an <em>implicit binding</em>,
-because it's introduced implicitly by the data type declaration (record selectors
-are also implicit bindings, for example).  Implicit bindings are injected into the code
-just before emitting code or External Core.
-<p>
-After desugaring into Core (-ddump-ds), the definition of <tt>f</tt> looks like this:
-<pre>
-  f x = case x of
-          Nil{d}       -> Nil{v}
-          MkT{d} a b r -> let { p = (a,b); q = I# r } in 
-	                  $WMkT p (q+1)
-</pre>
-Notice the way that pattern matching has been desugared to take account of the fact
-that the "real" data constructor MkT has three fields.  
-<p>
-By the time the simplifier has had a go at it, <tt>f</tt> will be transformed to:
-<pre>
-  f x = case x of
-          Nil{d}       -> Nil{v}
-          MkT{d} a b r -> MkT{v} a b (r +# 1#)
-</pre>
-Which is highly cool.
-
-
-<h2> The constructor wrapper functions </h2>
-
-The wrapper functions are automatically generated by GHC, and are
-really emitted into the result code (albeit only after CorePre; see
-<tt>CorePrep.mkImplicitBinds</tt>).  
-The wrapper functions are inlined very
-vigorously, so you will not see many occurrences of the wrapper
-functions in an optimised program, but you may see some.  For example,
-if your Haskell source has
-<pre>
-    map MkT xs
-</pre>
-then <tt>$WMkT</tt> will not be inlined (because it is not applied to anything).
-That is why we generate real top-level bindings for the wrapper functions,
-and generate code for them.
-
-
-<h2> The constructor worker functions </h2>
-
-Saturated applications of the constructor worker function MkT{v} are
-treated specially by the code generator; they really do allocation.
-However, we do want a single, shared, top-level definition for
-top-level nullary constructors (like True and False).  Furthermore,
-what if the code generator encounters a non-saturated application of a
-worker?  E.g. <tt>(map Just xs)</tt>.  We could declare that to be an
-error (CorePrep should saturate them). But instead we currently
-generate a top-level defintion for each constructor worker, whether
-nullary or not.  It takes the form:
-<pre>
-  MkT{v} = \ p q r -> MkT{v} p q r
-</pre>
-This is a real hack. The occurrence on the RHS is saturated, so the code generator (both the
-one that generates abstract C and the byte-code generator) treats it as a special case and
-allocates a MkT; it does not make a recursive call!  So now there's a top-level curried
-version of the worker which is available to anyone who wants it.
-<p>
-This strange defintion is not emitted into External Core.  Indeed, you might argue that
-we should instead pass the list of <tt>TyCon</tt>s to the code generator and have it 
-generate magic bindings directly.  As it stands, it's a real hack: see the code in
-CorePrep.mkImplicitBinds.
-
-
-<h2> External Core </h2>
-
-When emitting External Core, we should see this for our running example:
-
-<pre>
-  data T a = MkT a a Int# | Nil{d}
- 
-  $WMkT :: (a,a) -> T a -> T a
-  $WMkT p t = case p of 
-                (a,b) -> seq t (MkT a b t)
-
-  f x = case x of
-          Nil       -> Nil
-          MkT a b r -> MkT a b (r +# 1#)
-</pre>
-Notice that it makes perfect sense as a program all by itself.   Constructors
-look like constructors (albeit not identical to the original Haskell ones).
-<p>
-When reading in External Core, the parser is careful to read it back in just
-as it was before it was spat out, namely:
-<pre>
-  data T a = MkT{d} a a Int# | Nil{d}
- 
-  $WMkT :: (a,a) -> T a -> T a
-  $WMkT p t = case p of 
-                (a,b) -> seq t (MkT{v} a b t)
-
-  f x = case x of
-          Nil{d}       -> Nil{v}
-          MkT{d} a b r -> MkT{v} a b (r +# 1#)
-</pre>
-
-
-<h2> Unboxing strict fields </h2>
-
-If GHC unboxes strict fields (as in the first argument of <tt>MkT</tt> above), 
-it also transforms
-source-language case expressions.  Suppose you write this in your Haskell source:
-<pre>
-   case e of 
-     MkT p t -> ..p..t..
-</pre>
-GHC will desugar this to the following Core code:
-<pre>
-   case e of
-     MkT a b t -> let p = (a,b) in ..p..t..
-</pre>
-The local let-binding reboxes the pair because it may be mentioned in
-the case alternative.  This may well be a bad idea, which is why
-<tt>-funbox-strict-fields</tt> is an experimental feature.
-<p>
-It's essential that when importing a type <tt>T</tt> defined in some
-external module <tt>M</tt>, GHC knows what representation was used for
-that type, and that in turn depends on whether module <tt>M</tt> was
-compiled with <tt>-funbox-strict-fields</tt>.  So when writing an
-interface file, GHC therefore records with each data type whether its
-strict fields (if any) should be unboxed.
-
-<h2> Labels and info tables </h2>
-
-<em>Quick rough notes: SLPJ March 2003</em>.
-<p>
-Every data constructor <tt>C</tt>has two info tables:
-<ul>
-<li> The static info table (label <tt>C_static_info</tt>), used for statically-allocated constructors.
-
-<li> The dynamic info table (label <tt>C_con_info</tt>), used for dynamically-allocated constructors.
-</ul>
-Statically-allocated constructors are not moved by the garbage collector, and therefore have a different closure
-type from dynamically-allocated constructors; hence they need
-a distinct info table.  
-Both info tables share the same entry code, but since the entry code is phyiscally juxtaposed with the
-info table, it must be duplicated (<tt>C_static_entry</tt> and <tt>C_con_entry</tt> respectively).
-
-  </body>
-</html>
-
diff --git a/ghc/docs/comm/the-beast/desugar.html b/ghc/docs/comm/the-beast/desugar.html
deleted file mode 100644
index a66740259b..0000000000
--- a/ghc/docs/comm/the-beast/desugar.html
+++ /dev/null
@@ -1,156 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Sugar Free: From Haskell To Core</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Sugar Free: From Haskell To Core</h1>
-    <p>
-      Up until after type checking, GHC keeps the source program in an
-      abstract representation of Haskell source without removing any of the
-      syntactic sugar (such as, list comprehensions) that could easily be
-      represented by more primitive Haskell.  This complicates part of the
-      front-end considerably as the abstract syntax of Haskell (as exported by
-      the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/hsSyn/HsSyn.lhs"><code>HsSyn</code></a>)
-      is much more complex than a simplified representation close to, say, the
-      <a href="http://haskell.org/onlinereport/intro.html#sect1.2">Haskell
-      Kernel</a> would be.  However, having a representation that is as close
-      as possible to the surface syntax simplifies the generation of clear
-      error messages.  As GHC (quite in contrast to "conventional" compilers)
-      prints code fragments as part of error messages, the choice of
-      representation is especially important.
-    <p>
-      Nonetheless, as soon as the input has passed all static checks, it is
-      transformed into GHC's principal intermediate language that goes by the
-      name of <em>Core</em> and whose representation is exported by the
-      module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/coreSyn/CoreSyn.lhs"><code>CoreSyn</code></a>.  
-      All following compiler phases, except code generation operate on Core.
-      Due to Andrew Tolmach's effort, there is also an <a
-      href="http://www.haskell.org/ghc/docs/papers/core.ps.gz">external
-      representation for Core.</a>
-    <p>
-      The conversion of the compiled module from <code>HsSyn</code> into that
-      of <code>CoreSyn</code> is performed by a phase called the
-      <em>desugarer</em>, which is located in
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/"><code>fptools/ghc/compiler/deSugar/</code></a>.
-      It's operation is detailed in the following.
-    </p>
-
-    <h2>Auxilliary Functions</h2>
-    <p>
-      The modules <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsMonad.lhs"><code>DsMonad</code></a>
-      defines the desugarer monad (of type <code>DsM</code>) which maintains
-      the environment needed for desugaring.  In particular, it encapsulates a
-      unique supply for generating new variables, a map to lookup standard
-      names (such as functions from the prelude), a source location for error
-      messages, and a pool to collect warning messages generated during
-      desugaring.  Initialisation of the environment happens in the function <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/Desugar.lhs"><code>Desugar</code></a><code>.desugar</code>, 
-      which is also the main entry point into the desugarer.
-    <p>
-      The generation of Core code often involves the use of standard functions
-      for which proper identifiers (i.e., values of type <code>Id</code> that
-      actually refer to the definition in the right Prelude) need to be
-      obtained.  This is supported by the function
-      <code>DsMonad.dsLookupGlobalValue :: Name -> DsM Id</code>.
-
-    <h2><a name="patmat">Pattern Matching</a></h2>
-    <p>
-      Nested pattern matching with guards and everything is translated into
-      the simple, flat case expressions of Core by the following modules:
-    <dl>
-      <dt><a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/Match.lhs"><code>Match</code></a>:
-      <dd>This modules contains the main pattern-matching compiler in the form
-	of a function called <code>match</code>.  There is some documentation
-	as to how <code>match</code> works contained in the module itself.
-	Generally, the implemented algorithm is similar to the one described
-	in Phil Wadler's Chapter ? of Simon Peyton Jones' <em>The
-	Implementation of Functional Programming Languages</em>.
-	<code>Match</code> exports a couple of functions with not really
-	intuitive names.  In particular, it exports <code>match</code>,
-	<code>matchWrapper</code>, <code>matchExport</code>, and
-	<code>matchSimply</code>.  The function <code>match</code>, which is
-	the main work horse, is only used by the other matching modules.  The
-	function <code>matchExport</code> - despite it's name - is merely used
-	internally in <code>Match</code> and handles warning messages (see
-	below for more details).  The actual interface to the outside is
-	<code>matchWrapper</code>, which converts the output of the type
-	checker into the form needed by the pattern matching compiler (i.e., a
-	list of <code>EquationInfo</code>).  Similar in function to
-	<code>matchWrapper</code> is <code>matchSimply</code>, which provides
-	an interface for the case where a single expression is to be matched
-	against a single pattern (as, for example, is the case in bindings in
-	a <code>do</code> expression).
-      <dt><a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/MatchCon.lhs"><code>MatchCon</code></a>:
-      <dd>This module generates code for a set of alternative constructor
-	patterns that belong to a single type by means of the routine
-	<code>matchConFamily</code>.  More precisely, the routine gets a set
-	of equations where the left-most pattern of each equation is a
-	constructor pattern with a head symbol from the same type as that of
-	all the other equations.  A Core case expression is generated that
-	distinguihes between all these constructors.  The routine is clever
-	enough to generate a sparse case expression and to add a catch-all
-	default case only when needed (i.e., if the case expression isn't
-	exhaustive already).  There is also an explanation at the start of the
-	modules.
-      <dt><a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/MatchLit.lhs"><code>MatchLit</code></a>:
-      <dd>Generates code for a set of alternative literal patterns by means of
-	the routine <code>matchLiterals</code>.  The principle is similar to
-	that of <code>matchConFamily</code>, but all left-most patterns are
-	literals of the same type.
-      <dt><a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/DsUtils.lhs"><code>DsUtils</code></a>:
-      <dd>This module provides a set of auxilliary definitions as well as the
-      data types <code>EquationInfo</code> and <code>MatchResult</code> that
-      form the input and output, respectively, of the pattern matching
-      compiler.
-      <dt><a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/deSugar/Check.lhs"><code>Check</code></a>:
-      <dd>This module does not really contribute the compiling pattern
-      matching, but it inspects sets of equations to find whether there are
-      any overlapping patterns or non-exhaustive pattern sets.  This task is
-      implemented by the function <code>check</code>, which returns a list of
-      patterns that are part of a non-exhaustive case distinction as well as a
-      set of equation labels that can be reached during execution of the code;
-      thus, the remaining equations are shadowed due to overlapping patterns.
-      The function <code>check</code> is invoked and its result converted into
-      suitable warning messages by the function <code>Match.matchExport</code>
-      (which is a wrapper for <code>Match.match</code>).
-    </dl>
-    <p>
-      The central function <code>match</code>, given a set of equations,
-      proceeds in a number of steps:
-      <ol>
-      <li>It starts by desugaring the left-most pattern of each equation using
-	the function <code>tidy1</code> (indirectly via
-	<code>tidyEqnInfo</code>).  During this process, non-elementary
-	pattern (e.g., those using explicit list syntax <code>[x, y, ...,
-	z]</code>) are converted to a standard constructor pattern and also
-	irrefutable pattern are removed.
-      <li>Then, a process called <em>unmixing</em> clusters the equations into
-	blocks (without re-ordering them), such that the left-most pattern of
-	all equations in a block are either all variables, all literals, or
-	all constructors.
-      <li>Each block is, then, compiled by <code>matchUnmixedEqns</code>,
-	which forwards the handling of literal pattern blocks to
-	<code>MatchLit.matchLiterals</code>, of constructor pattern blocks to
-	<code>MatchCon.matchConFamily</code>, and hands variable pattern
-	blocks back to <code>match</code>.
-      </ol>
-
-    <p><hr><small>
-<!-- hhmts start -->
-Last modified: Mon Feb 11 22:35:25 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/driver.html b/ghc/docs/comm/the-beast/driver.html
deleted file mode 100644
index fbf65e33e7..0000000000
--- a/ghc/docs/comm/the-beast/driver.html
+++ /dev/null
@@ -1,179 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Glorious Driver</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Glorious Driver</h1>
-    <p>
-      The Glorious Driver (GD) is the part of GHC that orchestrates the
-      interaction of all the other pieces that make up GHC.  It supersedes the
-      <em>Evil Driver (ED),</em> which was a Perl script that served the same
-      purpose and was in use until version 4.08.1 of GHC.  Simon Marlow
-      eventually slayed the ED and instated the GD.  The GD is usually called
-      the <em>Compilation Manager</em> these days.
-    </p>
-    <p>
-      The GD has been substantially extended for GHCi, i.e., the interactive
-      variant of GHC that integrates the compiler with a (meta-circular)
-      interpreter since version 5.00.  Most of the driver is located in the
-      directory 
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/"><code>fptools/ghc/compiler/main/</code></a>.
-    </p>
-
-    <h2>Command Line Options</h2>
-    <p>
-      GHC's many flavours of command line options make the code interpreting
-      them rather involved.  The following provides a brief overview of the
-      processing of these options.  Since the addition of the interactive
-      front-end to GHC, there are two kinds of options: <em>static
-      options</em> and <em>dynamic options.</em> The former can only be set
-      when the system is invoked, whereas the latter can be altered in the
-      course of an interactive session.  A brief explanation on the difference
-      between these options and related matters is at the start of the module
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/CmdLineOpts.lhs"><code>CmdLineOpts</code></a>.
-      The same module defines the enumeration <code>DynFlag</code>, which
-      contains all dynamic flags.  Moreover, there is the labelled record
-      <code>DynFlags</code> that collects all the flag-related information
-      that is passed by the compilation manager to the compiler proper,
-      <code>hsc</code>, whenever a compilation is triggered.  If you like to
-      find out whether an option is static, use the predicate
-      <code>isStaticHscFlag</code> in the same module.
-    <p>
-      The second module that contains a lot of code related to the management
-      of flags is <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/DriverFlags.hs"><code>DriverFlags.hs</code></a>.
-      In particular, the module contains two association lists that map the
-      textual representation of the various flags to a data structure that
-      tells the driver how to parse the flag (e.g., whether it has any
-      arguments) and provides its internal representation.  All static flags
-      are contained in <code>static_flags</code>.  A whole range of
-      <code>-f</code> flags can be negated by adding a <code>-f-no-</code>
-      prefix.  These flags are contained in the association list
-      <code>fFlags</code>.
-    <p>
-      The driver uses a nasty hack based on <code>IORef</code>s that permits
-      the rest of the compiler to access static flags as CAFs; i.e., there is
-      a family of toplevel variable definitions in 
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/CmdLineOpts.lhs"><code>CmdLineOpts</code></a>,
-      below the literate section heading <i>Static options</i>, each of which
-      contains the value of one static option.  This is essentially realised
-      via global variables (in the sense of C-style, updatable, global
-      variables) defined via an evil pre-processor macro named
-      <code>GLOBAL_VAR</code>, which is defined in a particularly ugly corner
-      of GHC, namely the C header file 
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/HsVersions.h"><code>HsVersions.h</code></a>. 
-
-    <h2>What Happens When</h2>
-    <p>
-      Inside the Haskell compiler proper (<code>hsc</code>), a whole series of
-      stages (``passes'') are executed in order to transform your Haskell program
-      into C or native code.  This process is orchestrated by
-      <code>main/HscMain.hscMain</code> and its relative
-      <code>hscReComp</code>.  The latter directly invokes, in order,
-      the parser, the renamer, the typechecker, the desugarer, the
-      simplifier (Core2Core), the CoreTidy pass, the CorePrep pass,
-      conversion to STG (CoreToStg), the interface generator
-      (MkFinalIface), the code generator, and code output.  The
-      simplifier is the most complex of these, and is made up of many
-      sub-passes.  These are controlled by <code>buildCoreToDo</code>,
-      as described below.
-
-    <h2>Scheduling Optimisations Phases</h2>
-    <p>
-      GHC has a large variety of optimisations at its disposal, many of which
-      have subtle interdependencies.  The overall plan for program
-      optimisation is fixed in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/DriverState.hs"><code>DriverState.hs</code></a>.
-      First of all, there is the variable <code>hsc_minusNoO_flags</code> that
-      determines the <code>-f</code> options that you get without
-      <code>-O</code> (aka optimisation level 0) as well as
-      <code>hsc_minusO_flags</code> and <code>hsc_minusO2_flags</code> for
-      <code>-O</code> and <code>-O2</code>.
-    <p>
-      However, most of the strategic decisions about optimisations on the
-      intermediate language Core are encoded in the value produced by
-      <code>buildCoreToDo</code>, which is a list with elements of type
-      <code>CoreToDo</code>.  Each element of this list specifies one step in
-      the sequence of core optimisations executed by the <a
-      href="simplifier.html">Mighty Simplifier</a>.  The type
-      <code>CoreToDo</code> is defined in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/CmdLineOpts.lhs"><code>CmdLineOpts.lhs</code></a>.
-      The actual execution of the optimisation plan produced by
-      <code>buildCoreToDo</code> is performed by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/simplCore/SimplCore.lhs"><code>SimpleCore</code></a><code>.doCorePasses</code>.
-      Core optimisation plans consist of a number of simplification phases
-      (currently, three for optimisation levels of 1 or higher) with
-      decreasing phase numbers (the lowest, corresponding to the last phase,
-      namely 0).  Before and after these phases, optimisations such as
-      specialisation, let floating, worker/wrapper, and so on are executed.
-      The sequence of phases is such that the synergistic effect of the phases
-      is maximised -- however, this is a fairly fragile arrangement.
-    <p>
-      There is a similar construction for optimisations on STG level stored in
-      the variable <code>buildStgToDo :: [StgToDo]</code>.  However, this is a
-      lot less complex than the arrangement for Core optimisations.
-
-    <h2>Linking the <code>RTS</code> and <code>libHSstd</code></h2>
-    <p>
-      Since the RTS and HSstd refer to each other, there is a Cunning
-      Hack to avoid putting them each on the command-line twice or
-      thrice (aside: try asking for `plaice and chips thrice' in a
-      fish and chip shop; bet you only get two lots).  The hack involves 
-      adding
-      the symbols that the RTS needs from libHSstd, such as
-      <code>PrelWeak_runFinalizzerBatch_closure</code> and
-      <code>__stginit_Prelude</code>, to the link line with the
-      <code>-u</code> flag.  The standard library appears before the
-      RTS on the link line, and these options cause the corresponding
-      symbols to be picked up even so the linked might not have seen them
-      being used as the RTS appears later on the link line.  As a result,
-      when the RTS is also scanned, these symbols are already resolved. This
-      avoids the linker having to read the standard library and RTS
-      multiple times.
-    </p>
-    <p>
-      This does, however, leads to a complication.  Normal Haskell
-      programs do not have a <code>main()</code> function, so this is
-      supplied by the RTS (in the file 
-      <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/rts/Main.c"><code>Main.c</code></a>).
-      It calls <code>startupHaskell</code>, which
-      itself calls <code>__stginit_PrelMain</code>, which is therefore,
-      since it occurs in the standard library, one of the symbols
-      passed to the linker using the <code>-u</code> option.  This is fine
-      for standalone Haskell programs, but as soon as the Haskell code is only
-      used as part of a program implemented in a foreign language, the
-      <code>main()</code> function of that foreign language should be used
-      instead of that of the Haskell runtime.  In this case, the previously
-      described arrangement unfortunately fails as 
-      <code>__stginit_PrelMain</code> had better not be linked in,
-      because it tries to call <code>__stginit_Main</code>, which won't
-      exist.  In other words, the RTS's <code>main()</code> refers to 
-      <code>__stginit_PrelMain</code> which in turn refers to
-      <code>__stginit_Main</code>.  Although the RTS's <code>main()</code> 
-      might not be linked in if the program provides its own, the driver 
-      will normally force <code>__stginit_PrelMain</code> to be linked in anyway,
-      using <code>-u</code>, because it's a back-reference from the
-      RTS to HSstd.  This case is coped with by the <code>-no-hs-main</code>
-      flag, which suppresses passing the corresonding <code>-u</code> option
-      to the linker -- although in some versions of the compiler (e.g., 5.00.2)
-      it didn't work.  In addition, the driver generally places the C program 
-      providing the <code>main()</code> that we want to use before the RTS
-      on the link line.  Therefore, the RTS's main is never used and
-      without the <code>-u</code> the label <code>__stginit_PrelMain</code> 
-      will not be linked.
-    </p>
-    
-    <p><small>
-<!-- hhmts start -->
-Last modified: Tue Feb 19 11:09:00 UTC 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/fexport.html b/ghc/docs/comm/the-beast/fexport.html
deleted file mode 100644
index 956043bafb..0000000000
--- a/ghc/docs/comm/the-beast/fexport.html
+++ /dev/null
@@ -1,231 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - foreign export</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - foreign export</h1>
-
-    The implementation scheme for foreign export, as of 27 Feb 02, is
-    as follows.  There are four cases, of which the first two are easy.
-    <p>
-    <b>(1) static export of an IO-typed function from some module <code>MMM</code></b>
-    <p>
-    <code>foreign export foo :: Int -> Int -> IO Int</code>
-    <p>
-    For this we generate no Haskell code.  However, a C stub is
-    generated, and it looks like this:
-    <p>
-    <pre>
-extern StgClosure* MMM_foo_closure;
-
-HsInt foo (HsInt a1, HsInt a2)
-{
-   SchedulerStatus rc;
-   HaskellObj ret;
-   rc = rts_evalIO(
-           rts_apply(rts_apply(MMM_foo_closure,rts_mkInt(a1)),
-                     rts_mkInt(a2)
-                    ),
-           &ret
-        );
-   rts_checkSchedStatus("foo",rc);
-   return(rts_getInt(ret));
-}
-</pre>
-    <p>
-    This does the obvious thing: builds in the heap the expression
-    <code>(foo a1 a2)</code>, calls <code>rts_evalIO</code> to run it,
-    and uses <code>rts_getInt</code> to fish out the result.
-
-    <p>
-    <b>(2) static export of a non-IO-typed function from some module <code>MMM</code></b>
-    <p>
-    <code>foreign export foo :: Int -> Int -> Int</code>
-    <p>
-    This is identical to case (1), with the sole difference that the
-    stub calls <code>rts_eval</code> rather than
-    <code>rts_evalIO</code>.
-    <p>
-
-    <b>(3) dynamic export of an IO-typed function from some module <code>MMM</code></b>
-    <p>
-    <code>foreign export mkCallback :: (Int -> Int -> IO Int) -> IO (FunPtr a)</code>
-    <p>
-    Dynamic exports are a whole lot more complicated than their static
-    counterparts.
-    <p>
-    First of all, we get some Haskell code, which, when given a
-    function <code>callMe :: (Int -> Int -> IO Int)</code> to be made
-    C-callable, IO-returns a <code>FunPtr a</code>, which is the
-    address of the resulting C-callable code.  This address can now be
-    handed out to the C-world, and callers to it will get routed
-    through to <code>callMe</code>.
-    <p>
-    The generated Haskell function looks like this:
-    <p>
-<pre>
-mkCallback f
-  = do sp <- mkStablePtr f
-       r  <- ccall "createAdjustorThunk" sp (&"run_mkCallback")
-       return r
-</pre>
-    <p>
-    <code>createAdjustorThunk</code> is a gruesome,
-    architecture-specific function in the RTS.  It takes a stable
-    pointer to the Haskell function to be run, and the address of the
-    associated C wrapper, and returns a piece of machine code,
-    which, when called from the outside (C) world, eventually calls
-    through to <code>f</code>.
-    <p>
-    This machine code fragment is called the "Adjustor Thunk" (don't
-    ask me why).  What it does is simply to call onwards to the C
-    helper
-    function <code>run_mkCallback</code>, passing all the args given
-    to it but also conveying <code>sp</code>, which is a stable
-    pointer
-    to the Haskell function to run.  So:
-    <p>
-<pre>
-createAdjustorThunk ( StablePtr sp, CCodeAddress addr_of_helper_C_fn ) 
-{
-   create malloc'd piece of machine code "mc", behaving thusly:
-
-   mc ( args_to_mc ) 
-   { 
-      jump to addr_of_helper_C_fn, passing sp as an additional
-      argument
-   }
-</pre>
-    <p>
-    This is a horrible hack, because there is no portable way, even at
-    the machine code level, to function which adds one argument and
-    then transfers onwards to another C function.  On x86s args are
-    pushed R to L onto the stack, so we can just push <code>sp</code>,
-    fiddle around with return addresses, and jump onwards to the
-    helper C function.  However, on architectures which use register
-    windows and/or pass args extensively in registers (Sparc, Alpha,
-    MIPS, IA64), this scheme borders on the unviable.  GHC has a
-    limited <code>createAdjustorThunk</code> implementation for Sparc
-    and Alpha, which handles only the cases where all args, including
-    the extra one, fit in registers.
-    <p>
-    Anyway: the other lump of code generated as a result of a
-    f-x-dynamic declaration is the C helper stub.  This is basically
-    the same as in the static case, except that it only ever gets
-    called from the adjustor thunk, and therefore must accept 
-    as an extra argument, a stable pointer to the Haskell function
-    to run, naturally enough, as this is not known until run-time.
-    It then dereferences the stable pointer and does the call in
-    the same way as the f-x-static case:
-<pre>
-HsInt Main_d1kv ( StgStablePtr the_stableptr, 
-                  void* original_return_addr, 
-                  HsInt a1, HsInt a2 )
-{
-   SchedulerStatus rc;
-   HaskellObj ret;
-   rc = rts_evalIO(
-           rts_apply(rts_apply((StgClosure*)deRefStablePtr(the_stableptr),
-                               rts_mkInt(a1)
-                     ),
-                     rts_mkInt(a2)
-           ),
-           &ret
-        );
-   rts_checkSchedStatus("Main_d1kv",rc);
-   return(rts_getInt(ret));
-}
-</pre>
-    <p>
-    Note how this function has a purely made-up name
-    <code>Main_d1kv</code>, since unlike the f-x-static case, this
-    function is never called from user code, only from the adjustor
-    thunk.
-    <p>
-    Note also how the function takes a bogus parameter
-    <code>original_return_addr</code>, which is part of this extra-arg
-    hack.  The usual scheme is to leave the original caller's return
-    address in place and merely push the stable pointer above that,
-    hence the spare parameter.
-    <p>
-    Finally, there is some extra trickery, detailed in
-    <code>ghc/rts/Adjustor.c</code>, to get round the following
-    problem: the adjustor thunk lives in mallocville.  It is
-    quite possible that the Haskell code will actually
-    call <code>free()</code> on the adjustor thunk used to get to it
-    -- because otherwise there is no way to reclaim the space used
-    by the adjustor thunk.  That's all very well, but it means that
-    the C helper cannot return to the adjustor thunk in the obvious
-    way, since we've already given it back using <code>free()</code>.
-    So we leave, on the C stack, the address of whoever called the
-    adjustor thunk, and before calling the helper, mess with the stack
-    such that when the helper returns, it returns directly to the
-    adjustor thunk's caller.  
-    <p>
-    That's how the <code>stdcall</code> convention works.  If the
-    adjustor thunk has been called using the <code>ccall</code>
-    convention, we return indirectly, via a statically-allocated
-    yet-another-magic-piece-of-code, which takes care of removing the
-    extra argument that the adjustor thunk pushed onto the stack.
-    This is needed because in <code>ccall</code>-world, it is the
-    caller who removes args after the call, and the original caller of
-    the adjustor thunk has no way to know about the extra arg pushed
-    by the adjustor thunk.
-    <p>
-    You didn't really want to know all this stuff, did you?
-    <p>
-
-
-
-    <b>(4) dynamic export of an non-IO-typed function from some module <code>MMM</code></b>
-    <p>
-    <code>foreign export mkCallback :: (Int -> Int -> Int) -> IO (FunPtr a)</code>
-    <p>
-    (4) relates to (3) as (2) relates to (1), that is, it's identical,
-    except the C stub uses <code>rts_eval</code> instead of
-    <code>rts_evalIO</code>.
-    <p>
-
-
-   <h2>Some perspective on f-x-dynamic</h2>
-
-   The only really horrible problem with f-x-dynamic is how the
-   adjustor thunk should pass to the C helper the stable pointer to
-   use.  Ideally we would like this to be conveyed via some invisible
-   side channel, since then the adjustor thunk could simply jump
-   directly to the C helper, with no non-portable stack fiddling.
-   <p>
-   Unfortunately there is no obvious candidate for the invisible
-   side-channel.  We've chosen to pass it on the stack, with the
-   bad consequences detailed above.  Another possibility would be to
-   park it in a global variable, but this is non-reentrant and
-   non-(OS-)thread-safe.  A third idea is to put it into a callee-saves
-   register, but that has problems too: the C helper may not use that
-   register and therefore we will have trashed any value placed there
-   by the caller; and there is no C-level portable way to read from
-   the register inside the C helper.
-   <p>
-   In short, we can't think of a really satisfactory solution.  I'd
-   vote for introducing some kind of OS-thread-local-state and passing
-   it in there, but that introduces complications of its own.
-   <p>
-   <b>OS-thread-safety</b> is of concern in the C stubs, whilst
-   building up the expressions to run.  These need to have exclusive
-   access to the heap whilst allocating in it.  Also, there needs to
-   be some guarantee that no GC will happen in between the
-   <code>deRefStablePtr</code> call and when <code>rts_eval[IO]</code>
-   starts running.  At the moment there are no guarantees for
-   either property.  This needs to be sorted out before the
-   implementation can be regarded as fully safe to use.
-
-<p><small>
-   
-<!-- hhmts start -->
-Last modified: Weds 27 Feb 02
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/ghci.html b/ghc/docs/comm/the-beast/ghci.html
deleted file mode 100644
index b893acdeb4..0000000000
--- a/ghc/docs/comm/the-beast/ghci.html
+++ /dev/null
@@ -1,407 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - GHCi</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - GHCi</h1>
-
-    This isn't a coherent description of how GHCi works, sorry.  What
-    it is (currently) is a dumping ground for various bits of info
-    pertaining to GHCi, which ought to be recorded somewhere.
-
-    <h2>Debugging the interpreter</h2>
-
-    The usual symptom is that some expression / program crashes when
-    running on the interpreter (commonly), or gets wierd results
-    (rarely).  Unfortunately, finding out what the problem really is
-    has proven to be extremely difficult.  In retrospect it may be
-    argued a design flaw that GHC's implementation of the STG
-    execution mechanism provides only the weakest of support for
-    automated internal consistency checks.  This makes it hard to
-    debug.
-    <p>
-    Execution failures in the interactive system can be due to
-    problems with the bytecode interpreter, problems with the bytecode
-    generator, or problems elsewhere.  From the bugs seen so far, 
-    the bytecode generator is often the culprit, with the interpreter
-    usually being correct.
-    <p>
-    Here are some tips for tracking down interactive nonsense:
-    <ul>
-      <li>Find the smallest source fragment which causes the problem.
-      <p>
-      <li>Using an RTS compiled with <code>-DDEBUG</code> (nb, that
-          means the RTS from the previous stage!), run with <code>+RTS
-          -D2</code> to get a listing in great detail from the
-          interpreter.  Note that the listing is so voluminous that
-          this is impractical unless you have been diligent in
-          the previous step.
-      <p>
-      <li>At least in principle, using the trace and a bit of GDB
-          poking around at the time of death, you can figure out what
-          the problem is.  In practice you quickly get depressed at
-          the hopelessness of ever making sense of the mass of
-          details.  Well, I do, anyway.
-      <p>
-      <li><code>+RTS -D2</code> tries hard to print useful
-          descriptions of what's on the stack, and often succeeds.
-          However, it has no way to map addresses to names in
-          code/data loaded by our runtime linker.  So the C function
-          <code>ghci_enquire</code> is provided.  Given an address, it
-          searches the loaded symbol tables for symbols close to that
-          address.  You can run it from inside GDB:
-      <pre>
-      (gdb) p ghci_enquire ( 0x50a406f0 )
-      0x50a406f0 + -48  ==  `PrelBase_Czh_con_info'
-      0x50a406f0 + -12  ==  `PrelBase_Izh_static_info'
-      0x50a406f0 + -48  ==  `PrelBase_Czh_con_entry'
-      0x50a406f0 + -24  ==  `PrelBase_Izh_con_info'
-      0x50a406f0 +  16  ==  `PrelBase_ZC_con_entry'
-      0x50a406f0 +   0  ==  `PrelBase_ZMZN_static_entry'
-      0x50a406f0 + -36  ==  `PrelBase_Czh_static_entry'
-      0x50a406f0 + -24  ==  `PrelBase_Izh_con_entry'
-      0x50a406f0 +  64  ==  `PrelBase_EQ_static_info'
-      0x50a406f0 +   0  ==  `PrelBase_ZMZN_static_info'
-      0x50a406f0 +  48  ==  `PrelBase_LT_static_entry'
-      $1 = void
-      </pre>
-         In this case the enquired-about address is
-         <code>PrelBase_ZMZN_static_entry</code>.  If no symbols are
-         close to the given addr, nothing is printed.  Not a great
-         mechanism, but better than nothing.
-      <p>
-      <li>We have had various problems in the past due to the bytecode
-          generator (<code>compiler/ghci/ByteCodeGen.lhs</code>) being
-          confused about the true set of free variables of an
-          expression.  The compilation scheme for <code>let</code>s
-          applies the BCO for the RHS of the let to its free
-          variables, so if the free-var annotation is wrong or
-          misleading, you end up with code which has wrong stack
-          offsets, which is usually fatal.
-      <p>
-      <li>The baseline behaviour of the interpreter is to interpret
-          BCOs, and hand all other closures back to the scheduler for
-          evaluation.  However, this causes a huge number of expensive
-          context switches, so the interpreter knows how to enter the
-          most common non-BCO closure types by itself.
-          <p>
-          These optimisations complicate the interpreter.
-          If you think you have an interpreter problem, re-enable the
-          define <code>REFERENCE_INTERPRETER</code> in
-          <code>ghc/rts/Interpreter.c</code>.  All optimisations are
-          thereby disabled, giving the baseline
-          I-only-know-how-to-enter-BCOs behaviour.
-      <p>
-      <li>Following the traces is often problematic because execution
-          hops back and forth between the interpreter, which is
-          traced, and compiled code, which you can't see.
-          Particularly annoying is when the stack looks OK in the
-          interpreter, then compiled code runs for a while, and later
-          we arrive back in the interpreter, with the stack corrupted,
-          and usually in a completely different place from where we
-          left off.
-          <p>
-          If this is biting you baaaad, it may be worth copying
-          sources for the compiled functions causing the problem, into
-          your interpreted module, in the hope that you stay in the
-          interpreter more of the time.  Of course this doesn't work
-          very well if you've defined
-          <code>REFERENCE_INTERPRETER</code> in
-          <code>ghc/rts/Interpreter.c</code>.
-      <p>
-      <li>There are various commented-out pieces of code in
-          <code>Interpreter.c</code> which can be used to get the
-          stack sanity-checked after every entry, and even after after
-          every bytecode instruction executed.  Note that some
-          bytecodes (<code>PUSH_UBX</code>) leave the stack in
-          an unwalkable state, so the <code>do_print_stack</code>
-          local variable is used to suppress the stack walk after
-          them.
-    </ul>
-
-
-    <h2>Useful stuff to know about the interpreter</h2>
-
-    The code generation scheme is straightforward (naive, in fact).
-    <code>-ddump-bcos</code> prints each BCO along with the Core it
-    was generated from, which is very handy.
-    <ul>
-    <li>Simple lets are compiled in-line.  For the general case, let
-        v = E in ..., E is compiled into a new BCO which takes as
-        args its free variables, and v is bound to AP(the new BCO,
-        free vars of E).
-    <p>
-    <li><code>case</code>s as usual, become: push the return
-        continuation, enter the scrutinee.  There is some magic to
-        make all combinations of compiled/interpreted calls and
-        returns work, described below.  In the interpreted case, all
-        case alts are compiled into a single big return BCO, which
-        commences with instructions implementing a switch tree.
-    </ul>
-    <p>
-    <b>ARGCHECK magic</b>
-    <p>
-    You may find ARGCHECK instructions at the start of BCOs which
-    don't appear to need them; case continuations in particular.
-    These play an important role: they force objects which should
-    evaluated to BCOs to actually be BCOs.
-    <p>
-    Typically, there may be an application node somewhere in the heap.
-    This is a thunk which when leant on turns into a BCO for a return
-    continuation.  The thunk may get entered with an update frame on
-    top of the stack.  This is legitimate since from one viewpoint
-    this is an AP which simply reduces to a data object, so does not
-    have functional type.  However, once the AP turns itself into a
-    BCO (so to speak) we cannot simply enter the BCO, because that
-    expects to see args on top of the stack, not an update frame.
-    Therefore any BCO which expects something on the stack above an
-    update frame, even non-function BCOs, start with an ARGCHECK.  In
-    this case it fails, the update is done, the update frame is
-    removed, and the BCO re-entered.  Subsequent entries of the BCO of
-    course go unhindered.
-    <p>
-    The optimised (<code>#undef REFERENCE_INTERPRETER</code>) handles
-    this case specially, so that a trip through the scheduler is
-    avoided.  When reading traces from <code>+RTS -D2 -RTS</code>, you
-    may see BCOs which appear to execute their initial ARGCHECK insn
-    twice.  The first time it fails; the interpreter does the update
-    immediately and re-enters with no further comment.
-    <p>
-    This is all a bit ugly, and, as SimonM correctly points out, it
-    would have been cleaner to make BCOs unpointed (unthunkable)
-    objects, so that a pointer to something <code>:: BCO#</code>
-    really points directly at a BCO.
-    <p>
-    <b>Stack management</b>
-    <p>
-    There isn't any attempt to stub the stack, minimise its growth, or
-    generally remove unused pointers ahead of time.  This is really
-    due to lazyness on my part, although it does have the minor
-    advantage that doing something cleverer would almost certainly
-    increase the number of bytecodes that would have to be executed.
-    Of course we SLIDE out redundant stuff, to get the stack back to
-    the sequel depth, before returning a HNF, but that's all.  As
-    usual this is probably a cause of major space leaks.
-    <p>
-    <b>Building constructors</b>
-    <p>
-    Constructors are built on the stack and then dumped into the heap
-    with a single PACK instruction, which simply copies the top N
-    words of the stack verbatim into the heap, adds an info table, and zaps N
-    words from the stack.  The constructor args are pushed onto the
-    stack one at a time.  One upshot of this is that unboxed values
-    get pushed untaggedly onto the stack (via PUSH_UBX), because that's how they
-    will be in the heap.  That in turn means that the stack is not 
-    always walkable at arbitrary points in BCO execution, although
-    naturally it is whenever GC might occur.
-    <p>
-    Function closures created by the interpreter use the AP-node
-    (tagged) format, so although their fields are similarly
-    constructed on the stack, there is never a stack walkability
-    problem.
-    <p>
-    <b>Unpacking constructors</b>
-    <p>
-    At the start of a case continuation, the returned constructor is
-    unpacked onto the stack, which means that unboxed fields have to
-    be tagged.  Rather than burdening all such continuations with a
-    complex, general mechanism, I split it into two.  The
-    allegedly-common all-pointers case uses a single UNPACK insn
-    to fish out all fields with no further ado.  The slow case uses a
-    sequence of more complex UPK_TAG insns, one for each field (I
-    think).  This seemed like a good compromise to me.
-    <p>
-    <b>Perspective</b>
-    <p>
-    I designed the bytecode mechanism with the experience of both STG
-    hugs and Classic Hugs in mind.  The latter has an small
-    set of bytecodes, a small interpreter loop, and runs amazingly
-    fast considering the cruddy code it has to interpret.  The former
-    had a large interpretative loop with many different opcodes,
-    including multiple minor variants of the same thing, which
-    made it difficult to optimise and maintain, yet it performed more
-    or less comparably with Classic Hugs.
-    <p>
-    My design aims were therefore to minimise the interpreter's
-    complexity whilst maximising performance.  This means reducing the
-    number of opcodes implemented, whilst reducing the number of insns
-    despatched.  In particular there are only two opcodes, PUSH_UBX
-    and UPK_TAG, which deal with tags.  STG Hugs had dozens of opcodes
-    for dealing with tagged data.  In cases where the common
-    all-pointers case is significantly simpler (UNPACK) I deal with it
-    specially.  Finally, the number of insns executed is reduced a
-    little by merging multiple pushes, giving PUSH_LL and PUSH_LLL.
-    These opcode pairings were determined by using the opcode-pair
-    frequency profiling stuff which is ifdef-d out in
-    <code>Interpreter.c</code>.  These significantly improve
-    performance without having much effect on the uglyness or
-    complexity of the interpreter.
-    <p>
-    Overall, the interpreter design is something which turned out
-    well, and I was pleased with it.  Unfortunately I cannot say the
-    same of the bytecode generator.
-
-    <h2><code>case</code> returns between interpreted and compiled code</h2>
-
-    Variants of the following scheme have been drifting around in GHC
-    RTS documentation for several years.  Since what follows is
-    actually what is implemented, I guess it supersedes all other
-    documentation.  Beware; the following may make your brain melt.
-    In all the pictures below, the stack grows downwards.
-    <p>
-    <b>Returning to interpreted code</b>.
-    <p>
-    Interpreted returns employ a set of polymorphic return infotables.
-    Each element in the set corresponds to one of the possible return
-    registers (R1, D1, F1) that compiled code will place the returned
-    value in.  In fact this is a bit misleading, since R1 can be used
-    to return either a pointer or an int, and we need to distinguish
-    these cases.  So, supposing the set of return registers is {R1p,
-    R1n, D1, F1}, there would be four corresponding infotables,
-    <code>stg_ctoi_ret_R1p_info</code>, etc.  In the pictures below we
-    call them <code>stg_ctoi_ret_REP_info</code>.  
-    <p>
-    These return itbls are polymorphic, meaning that all 8 vectored
-    return codes and the direct return code are identical.
-    <p>
-    Before the scrutinee is entered, the stack is arranged like this:
-    <pre>
-   |        |
-   +--------+
-   |  BCO   | -------> the return contination BCO
-   +--------+
-   | itbl * | -------> stg_ctoi_ret_REP_info, with all 9 codes as follows:
-   +--------+
-                          BCO* bco = Sp[1];
-                          push R1/F1/D1 depending on REP
-                          push bco
-                          yield to sched
-    </pre>
-    On entry, the interpreted contination BCO expects the stack to look
-    like this:
-    <pre>
-   |        |
-   +--------+
-   |  BCO   | -------> the return contination BCO
-   +--------+
-   | itbl * | -------> ret_REP_ctoi_info, with all 9 codes as follows:
-   +--------+
-   : VALUE  :  (the returned value, shown with : since it may occupy
-   +--------+   multiple stack words)
-    </pre>
-    A machine code return will park the returned value in R1/F1/D1,
-    and enter the itbl on the top of the stack.  Since it's our magic
-    itbl, this pushes the returned value onto the stack, which is
-    where the interpreter expects to find it.  It then pushes the BCO
-    (again) and yields.  The scheduler removes the BCO from the top,
-    and enters it, so that the continuation is interpreted with the
-    stack as shown above.
-    <p>
-    An interpreted return will create the value to return at the top
-    of the stack.  It then examines the return itbl, which must be
-    immediately underneath the return value, to see if it is one of
-    the magic <code>stg_ctoi_ret_REP_info</code> set.  Since this is so,
-    it knows it is returning to an interpreted contination.  It
-    therefore simply enters the BCO which it assumes it immediately
-    underneath the itbl on the stack.
-
-    <p>
-    <b>Returning to compiled code</b>.
-    <p>
-    Before the scrutinee is entered, the stack is arranged like this:
-    <pre>
-                        ptr to vec code 8 ------> return vector code 8
-   |        |           ....
-   +--------+           ptr to vec code 1 ------> return vector code 1
-   | itbl * | --        Itbl end
-   +--------+   \       ....   
-                 \      Itbl start
-                  ----> direct return code
-    </pre>
-    The scrutinee value is then entered.
-    The case continuation(s) expect the stack to look the same, with
-    the returned HNF in a suitable return register, R1, D1, F1 etc.
-    <p>
-    A machine code return knows whether it is doing a vectored or
-    direct return, and, if the former, which vector element it is.
-    So, for a direct return we jump to <code>Sp[0]</code>, and for a
-    vectored return, jump to <code>((CodePtr*)(Sp[0]))[ - ITBL_LENGTH
-    - vector number ]</code>.  This is (of course) the scheme that
-    compiled code has been using all along.
-    <p>
-    An interpreted return will, as described just above, have examined
-    the itbl immediately beneath the return value it has just pushed,
-    and found it not to be one of the <code>ret_REP_ctoi_info</code> set,
-    so it knows this must be a return to machine code.  It needs to
-    pop the return value, currently on the stack, into R1/F1/D1, and
-    jump through the info table.  Unfortunately the first part cannot
-    be accomplished directly since we are not in Haskellised-C world.
-    <p>
-    We therefore employ a second family of magic infotables, indexed,
-    like the first, on the return representation, and therefore with
-    names of the form <code>stg_itoc_ret_REP_info</code>.  (Note:
-    <code>itoc</code>; the previous bunch were <code>ctoi</code>).
-    This is pushed onto the stack (note, tagged values have their tag
-    zapped), giving:
-    <pre>
-   |        |
-   +--------+
-   | itbl * | -------> arbitrary machine code return itbl
-   +--------+
-   : VALUE  :  (the returned value, possibly multiple words)
-   +--------+
-   | itbl * | -------> stg_itoc_ret_REP_info, with code:
-   +--------+
-                          pop myself (stg_itoc_ret_REP_info) off the stack
-                          pop return value into R1/D1/F1
-                          do standard machine code return to itbl at t.o.s.
-    </pre>
-    We then return to the scheduler, asking it to enter the itbl at
-    t.o.s.  When entered, <code>stg_itoc_ret_REP_info</code> removes
-    itself from the stack, pops the return value into the relevant
-    return register, and returns to the itbl to which we were trying
-    to return in the first place.  
-    <p>
-    Amazingly enough, this stuff all actually works!  Well, mostly ...
-    <p>
-    <b>Unboxed tuples: a Right Royal Spanner In The Works</b>
-    <p>
-    The above scheme depends crucially on having magic infotables
-    <code>stg_{itoc,ctoi}_ret_REP_info</code> for each return
-    representation <code>REP</code>.  It unfortunately fails miserably
-    in the face of unboxed tuple returns, because the set of required
-    tables would be infinite; this despite the fact that for any given
-    unboxed tuple return type, the scheme could be made to work fine.
-    <p>
-    This is a serious problem, because it prevents interpreted
-    code from doing <code>IO</code>-typed returns, since <code>IO
-    t</code> is implemented as <code>(# t, RealWorld# #)</code> or
-    thereabouts.  This restriction in turn rules out FFI stuff in the
-    interpreter.  Not good.
-    <p>
-    Although we have no way to make general unboxed tuples work, we
-    can at least make <code>IO</code>-types work using the following
-    ultra-kludgey observation: <code>RealWorld#</code> doesn't really
-    exist and so has zero size, in compiled code.  In turn this means
-    that a type of the form <code>(# t, RealWorld# #)</code> has the
-    same representation as plain <code>t</code> does.  So the bytecode
-    generator, whilst rejecting code with general unboxed tuple
-    returns, recognises and accepts this special case.  Which means
-    that <code>IO</code>-typed stuff works in the interpreter.  Just.
-    <p>
-    If anyone asks, I will claim I was out of radio contact, on a
-    6-month walking holiday to the south pole, at the time this was
-    ... er ... dreamt up.
-
-
-<p><small>
-   
-<!-- hhmts start -->
-Last modified: Thursday February  7 15:33:49 GMT 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/main.html b/ghc/docs/comm/the-beast/main.html
deleted file mode 100644
index 332ffaa501..0000000000
--- a/ghc/docs/comm/the-beast/main.html
+++ /dev/null
@@ -1,35 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Compiling and running the Main module</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>Compiling and running the Main module</h1>
-
-GHC allows you to determine which module contains the "main" function, and
-what that function is called, via the <code>-fmain-is</code> flag.   The trouble is
-that the runtime system is fixed, so what symbol should it link to?
-<p>
-The current solution is this.  Suppose the main function is <code>Foo.run</code>.
-<ul>
-<li>
-Then, when compiling module <code>Foo</code>, GHC adds an extra definition:
-<pre>
-  :Main.main = runIO Foo.run
-</pre>
-Now the RTS can invoke <code>:Main.main</code> to start the program.  (This extra
-definition is inserted in TcRnDriver.checkMain.)
-<p><li>
-Before starting the program, though, the RTS also initialises the module tree
-by calling <code>init_:Main</code>, so when compiling the main module (Foo in this case),
-as well as generating <code>init_Foo</code> as usual, GHC also generates
-<pre>
-  init_zcMain() { init_Foo; }
-</pre>
-This extra initialisation code is generated in CodeGen.mkModuleInit.
-</ul>
-
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/mangler.html b/ghc/docs/comm/the-beast/mangler.html
deleted file mode 100644
index 1ad80f0d5c..0000000000
--- a/ghc/docs/comm/the-beast/mangler.html
+++ /dev/null
@@ -1,79 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Evil Mangler</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Evil Mangler</h1>
-    <p>
-      The Evil Mangler (EM) is a Perl script invoked by the <a
-	href="driver.html">Glorious Driver</a> after the C compiler (gcc) has
-      translated the GHC-produced C code into assembly.  Consequently, it is
-      only of interest if <code>-fvia-C</code> is in effect (either explicitly
-      or implicitly).
-
-    <h4>Its purpose</h4>
-    <p>
-      The EM reads the assembly produced by gcc and re-arranges code blocks as
-      well as nukes instructions that it considers <em>non-essential.</em> It
-      derives it evilness from its utterly ad hoc, machine, compiler, and
-      whatnot dependent design and implementation.  More precisely, the EM
-      performs the following tasks:
-    <ul>
-      <li>The code executed when a closure is entered is moved adjacent to
-	that closure's infotable.  Moreover, the order of the info table
-	entries is reversed.  Also, SRT pointers are removed from closures that
-        don't need them (non-FUN, RET and THUNK ones).
-      <li>Function prologue and epilogue code is removed.  (GHC generated code
-	manages its own stack and uses the system stack only for return
-	addresses and during calls to C code.)
-      <li>Certain code patterns are replaced by simpler code (eg, loads of
-	fast entry points followed by indirect jumps are replaced by direct
-	jumps to the fast entry point).
-    </ul>
-
-    <h4>Implementation</h4>
-    <p>
-      The EM is located in the Perl script <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/driver/mangler/ghc-asm.lprl"><code>ghc-asm.lprl</code></a>.
-      The script reads the <code>.s</code> file and chops it up into
-      <em>chunks</em> (that's how they are actually called in the script) that
-      roughly correspond to basic blocks.  Each chunk is annotated with an
-      educated guess about what kind of code it contains (e.g., infotable,
-      fast entry point, slow entry point, etc.).  The annotations also contain
-      the symbol introducing the chunk of assembly and whether that chunk has
-      already been processed or not.
-    <p>
-      The parsing of the input into chunks as well as recognising assembly
-      instructions that are to be removed or altered is based on a large
-      number of Perl regular expressions sprinkled over the whole code.  These
-      expressions are rather fragile as they heavily rely on the structure of
-      the generated code - in fact, they even rely on the right amount of
-      white space and thus on the formatting of the assembly.
-    <p>
-      Afterwards, the chunks are reordered, some of them purged, and some
-      stripped of some useless instructions.  Moreover, some instructions are
-      manipulated (eg, loads of fast entry points followed by indirect jumps
-      are replaced by direct jumps to the fast entry point).
-    <p>
-      The EM knows which part of the code belongs to function prologues and
-      epilogues as <a href="../rts-libs/stgc.html">STG C</a> adds tags of the
-      form <code>--- BEGIN ---</code> and <code>--- END ---</code> the
-      assembler just before and after the code proper of a function starts.
-      It adds these tags using gcc's <code>__asm__</code> feature.
-    <p>
-      <strong>Update:</strong> Gcc 2.96 upwards performs more aggressive basic
-      block re-ordering and dead code elimination.  This seems to make the
-      whole <code>--- END ---</code> tag business redundant -- in fact, if
-      proper code is generated, no <code>--- END ---</code> tags survive gcc
-      optimiser. 
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Sun Feb 17 17:55:47 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/modules.html b/ghc/docs/comm/the-beast/modules.html
deleted file mode 100644
index a6655a68a7..0000000000
--- a/ghc/docs/comm/the-beast/modules.html
+++ /dev/null
@@ -1,80 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Modules, ModuleNames and Packages</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>Modules, ModuleNames and Packages</h1>
-
-    <p>This section describes the datatypes <code>ModuleName</code>
-    <code>Module</code> and <code>PackageName</code> all available
-    from the module <a
-    href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/Module.lhs"><code>Module</code></a>.<p>
-
-    <h2>Packages</h2>
-
-    <p>A package is a collection of (zero or more) Haskell modules,
-    together with some information about external libraries, extra C
-    compiler options, and other things that this collection of modules
-    requires.  When using DLLs on windows (or shared libraries on a
-    Unix system; currently unsupported), a package can consist of only
-    a single shared library of Haskell code; the reason for this is
-    described below.
-
-    <p>Packages are further described in the User's Guide <a
-    href="http://www.haskell.org/ghc/docs/latest/packages.html">here</a>.
-
-    <h2>The ModuleName type</h2>
-
-    <p>At the bottom of the hierarchy is a <code>ModuleName</code>,
-    which, as its name suggests, is simply the name of a module.  It
-    is represented as a Z-encoded FastString, and is an instance of
-    <code>Uniquable</code> so we can build <code>FiniteMap</code>s
-    with <code>ModuleName</code>s as the keys.
-
-    <p>A <code>ModuleName</code> can be built from a
-    <code>String</code>, using the <code>mkModuleName</code> function.
-
-    <h2>The Module type</h2>
-
-    <p>For a given module, the compiler also needs to know whether the
-    module is in the <em>home package</em>, or in another package.
-    This distinction is important for two reasons:
-
-    <ul>
-    <li><p>When generating code to call a function in another package,
-    the compiler might have to generate a cross-DLL call, which is
-    different from an intra-DLL call (hence the restriction that the
-    code in a package can only reside in a single DLL).
-
-    <li><p>We avoid putting version information in an interface file
-    for entities defined in another package, on the grounds that other
-    packages are generally "stable".  This also helps keep the size of
-    interface files down.
-    </ul>
-
-    <p>The <code>Module</code> type contains a <code>ModuleName</code>
-    and a <code>PackageInfo</code> field.  The
-    <code>PackageInfo</code> indicates whether the given
-    <code>Module</code> comes from the current package or from another
-    package.
-
-    <p>To get the actual package in which a given module resides, you
-    have to read the interface file for that module, which contains
-    the package name (actually the value of the
-    <code>-package-name</code> flag when that module was built).  This
-    information is currently unused inside the compiler, but we might
-    make use of it in the future, especially with the advent of
-    hierarchical modules, to allow the compiler to automatically
-    figure out which packages a program should be linked with, and
-    thus avoid the need to specify <code>-package</code> options on
-    the command line.
-
-    <p><code>Module</code>s are also instances of
-    <code>Uniquable</code>, and indeed the unique of a
-    <code>Module</code> is the same as the unique of the underlying
-    <code>ModuleName</code>.
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/names.html b/ghc/docs/comm/the-beast/names.html
deleted file mode 100644
index 061fae3ebf..0000000000
--- a/ghc/docs/comm/the-beast/names.html
+++ /dev/null
@@ -1,169 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The truth about names: OccNames, and Names</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The truth about names: OccNames, and Names</h1>
-    <p>
-      Every entity (type constructor, class, identifier, type variable) has a
-      <code>Name</code>.  The <code>Name</code> type is pervasive in GHC, and
-      is defined in <code>basicTypes/Name.lhs</code>.  Here is what a Name
-      looks like, though it is private to the Name module.
-    </p>
-    <blockquote>
-      <pre>
-data Name = Name {
-	      n_sort :: NameSort,	-- What sort of name it is
-	      n_occ  :: !OccName,	-- Its occurrence name
-	      n_uniq :: Unique,		-- Its identity
-	      n_loc  :: !SrcLoc		-- Definition site
-	  }</pre>
-    </blockquote>
-    <ul>
-      <li> The <code>n_sort</code> field says what sort of name this is: see
-	<a href="#sort">NameSort below</a>.
-      <li> The <code>n_occ</code> field gives the "occurrence name" of the
-	Name; see 
-	<a href="#occname">OccName below</a>.
-      <li> The <code>n_uniq</code> field allows fast tests for equality of
-	Names. 
-      <li> The <code>n_loc</code> field gives some indication of where the
-	name was bound. 
-    </ul>
-    
-    <h2><a name="sort">The <code>NameSort</code> of a <code>Name</code></a></h2>
-    <p>
-      There are four flavours of <code>Name</code>:
-    </p>
-    <blockquote>
-      <pre>
-data NameSort
-  = External Module (Maybe Name)
-	-- (Just parent) => this Name is a subordinate name of 'parent'
-	-- e.g. data constructor of a data type, method of a class
-	-- Nothing => not a subordinate
- 
-  | WiredIn Module (Maybe Name) TyThing BuiltInSyntax
-	-- A variant of External, for wired-in things
-
-  | Internal		-- A user-defined Id or TyVar
-			-- defined in the module being compiled
-
-  | System		-- A system-defined Id or TyVar.  Typically the
-			-- OccName is very uninformative (like 's')</pre>
-    </blockquote>
-    <ul>
-      <li>Here are the sorts of Name an entity can have:
-	<ul>
-	  <li> Class, TyCon: External.
-	  <li> Id: External, Internal, or System.
-	  <li> TyVar: Internal, or System.
-	</ul>
-      </li>
-      <li>An <code>External</code> name has a globally-unique
-	(module name, occurrence name) pair, namely the 
-	<em>original name</em> of the entity,
-	describing where the thing was originally defined.  So for example,
-	if we have
-	<blockquote>
-	  <pre>
-module M where
-  f = e1
-  g = e2
-
-module A where
-  import qualified M as Q
-  import M
-  a = Q.f + g</pre>
-	</blockquote>
-	<p>
-	  then the RdrNames for "a", "Q.f" and "g" get replaced (by the
-	  Renamer)  by the Names "A.a", "M.f", and "M.g" respectively.
-	</p>
-      </li>
-      <li>An <code>InternalName</code> 
-	has only an occurrence name.  Distinct InternalNames may have the same
-	occurrence name; use the Unique to distinguish them.
-      </li>
-      <li>An <code>ExternalName</code> has a unique that never changes.  It
-	is never cloned.  This is important, because the simplifier invents
-	new names pretty freely, but we don't want to lose the connnection
-	with the type environment (constructed earlier).  An
-	<code>InternalName</code> name can be cloned freely.
-      </li>
-      <li><strong>Before CoreTidy</strong>: the Ids that were defined at top
-	level in the original source program get <code>ExternalNames</code>,
-	whereas extra top-level bindings generated (say) by the type checker
-	get <code>InternalNames</code>. q This distinction is occasionally
-	useful for filtering diagnostic output; e.g.  for -ddump-types.
-      </li>
-      <li><strong>After CoreTidy</strong>: An Id with an
-	<code>ExternalName</code> will generate symbols that 
-	appear as external symbols in the object file.  An Id with an
-	<code>InternalName</code> cannot be referenced from outside the
-	module, and so generates a local symbol in the object file.  The
-	CoreTidy pass makes the decision about which names should be External
-	and which Internal.
-      </li>
-      <li>A <code>System</code> name is for the most part the same as an
-	<code>Internal</code>.  Indeed, the differences are purely cosmetic:
-	<ul>
-	  <li>Internal names usually come from some name the
-	    user wrote, whereas a System name has an OccName like "a", or "t".
-	    Usually there are masses of System names with the same OccName but
-	    different uniques, whereas typically there are only a handful of
-	    distince Internal names with the same OccName.
-	  </li>
-	  <li>Another difference is that when unifying the type checker tries
-	    to  unify away type variables with System names, leaving ones with
-	    Internal names (to improve error messages).
-	  </li>
-	</ul>
-      </li>
-    </ul>
-
-    <h2><a name="occname">Occurrence names: <code>OccName</code></a></h2>
-    <p>
-      An <code>OccName</code> is more-or-less just a string, like "foo" or
-      "Tree", giving the (unqualified) name of an entity.
-    </p>
-    <p>
-      Well, not quite just a string, because in Haskell a name like "C" could
-      mean a type constructor or data constructor, depending on context.  So
-      GHC defines a type <tt>OccName</tt> (defined in
-      <tt>basicTypes/OccName.lhs</tt>) that is a pair of a <tt>FastString</tt>
-      and a <tt>NameSpace</tt> indicating which name space the name is drawn
-      from:
-      <blockquote>
-      <pre>
-data OccName = OccName NameSpace EncodedFS</pre>
-    </blockquote>
-    <p>
-      The <tt>EncodedFS</tt> is a synonym for <tt>FastString</tt> indicating
-      that the string is Z-encoded.  (Details in <tt>OccName.lhs</tt>.)
-      Z-encoding encodes funny characters like '%' and '$' into alphabetic
-      characters, like "zp" and "zd", so that they can be used in object-file
-      symbol tables without confusing linkers and suchlike.
-    </p>
-    <p>
-      The name spaces are:
-    </p>
-    <ul>
-      <li> <tt>VarName</tt>: ordinary variables</li>
-      <li> <tt>TvName</tt>: type variables</li>
-      <li> <tt>DataName</tt>: data constructors</li>
-      <li> <tt>TcClsName</tt>: type constructors and classes (in Haskell they
-	share a name space) </li>
-    </ul>
-
-    <small>
-<!-- hhmts start -->
-Last modified: Wed May  4 14:57:55 EST 2005
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
-
diff --git a/ghc/docs/comm/the-beast/ncg.html b/ghc/docs/comm/the-beast/ncg.html
deleted file mode 100644
index 5810a35212..0000000000
--- a/ghc/docs/comm/the-beast/ncg.html
+++ /dev/null
@@ -1,749 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Native Code Generator</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Native Code Generator</h1>
-    <p>
-      On some platforms (currently x86 and PowerPC, with bitrotted
-      support for Sparc and Alpha), GHC can generate assembly code
-      directly, without having to go via C.  This can sometimes almost
-      halve compilation time, and avoids the fragility and
-      horribleness of the <a href="mangler.html">mangler</a>.  The NCG
-      is enabled by default for
-      non-optimising compilation on supported platforms.  For most programs
-      it generates code which runs only 1-3% slower
-      (depending on platform and type of code) than that
-      created by gcc on x86s, so it is well worth using even with
-      optimised compilation.  FP-intensive x86 programs see a bigger
-      slowdown, and all Sparc code runs about 5% slower due to
-      us not filling branch delay slots.
-    <p>
-      The NCG has always been something of a second-class citizen
-      inside GHC, an unloved child, rather.  This means that its
-      integration into the compiler as a whole is rather clumsy, which
-      brings some problems described below.  That apart, the NCG
-      proper is fairly cleanly designed, as target-independent as it
-      reasonably can be, and so should not be difficult to retarget.
-    <p>
-      <b>NOTE!</b> The native code generator was largely rewritten as part
-      of the C-- backend changes, around May 2004.  Unfortunately the
-      rest of this document still refers to the old version, and was written
-      with relation to the CVS head as of end-Jan 2002.  Some of it is relevant,
-      some of it isn't.
-
-    <h2>Overview</h2>
-      The top-level code generator fn is
-    <p>
-    <code>absCtoNat :: AbstractC -> UniqSM (SDoc, Pretty.Doc)</code>
-    <p>
-    The returned <code>SDoc</code> is for debugging, so is empty unless
-    you specify <code>-ddump-stix</code>.  The <code>Pretty.Doc</code>
-    bit is the final assembly code.  Translation involves three main
-    phases, the first and third of which are target-independent.
-    <ul>
-    <li><b>Translation into the <code>Stix</code> representation.</b>  Stix
-        is a simple tree-like RTL-style language, in which you can
-        mention:
-        <p>
-        <ul>
-        <li>An infinite number of temporary, virtual registers.
-        <li>The STG "magic" registers (<code>MagicId</code>), such as
-            the heap and stack pointers.
-        <li>Literals and low-level machine ops (<code>MachOp</code>).
-        <li>Simple address computations.
-        <li>Reads and writes of: memory, virtual regs, and various STG
-            regs. 
-        <li>Labels and <code>if ... goto ...</code> style control-flow.
-        </ul>
-        <p>
-        Stix has two main associated types:
-        <p>
-        <ul>
-        <li><code>StixStmt</code> -- trees executed for their side
-        effects: assignments, control transfers, and auxiliary junk
-        such as segment changes and literal data.
-        <li><code>StixExpr</code> -- trees which denote a value.
-        </ul>
-        <p>
-        Translation into Stix is almost completely
-        target-independent.  Needed dependencies are knowledge of
-        word size and endianness, used when generating code to do 
-        deal with half-word fields in info tables.  This could be
-        abstracted out easily enough.  Also, the Stix translation
-        needs to know which <code>MagicId</code>s map to registers
-        on the given target, and which are stored in offsets from
-        <code>BaseReg</code>.
-        <p>
-        After initial Stix generation, the trees are cleaned up with
-        constant-folding and a little copy-propagation ("Stix
-        inlining", as the code misleadingly calls it).  We take
-        the opportunity to translate <code>MagicId</code>s which are
-        stored in memory on the given target, into suitable memory
-        references.  Those which are stored in registers are left
-        alone.  There is also a half-hearted attempt to lift literal
-        strings to the top level in cases where nested strings have
-        been observed to give incorrect code in the past.
-        <p>
-        Primitive machine-level operations will already be phrased in
-        terms of <code>MachOp</code>s in the presented Abstract C, and
-        these are passed through unchanged.  We comment only that the
-        <code>MachOp</code>s have been chosen so as to be easy to
-        implement on all targets, and their meaning is intended to be
-        unambiguous, and the same on all targets, regardless of word
-        size or endianness.
-        <p>
-        <b>A note on <code>MagicId</code>s.</b>
-        Those which are assigned to
-        registers on the current target are left unmodified.  Those
-        which are not are stored in memory as offsets from
-        <code>BaseReg</code> (which is assumed to permanently have the
-        value <code>(&MainCapability.r)</code>), so the constant folder
-        calculates the offsets and inserts suitable loads/stores.  One
-        complication is that not all archs have <code>BaseReg</code>
-        itself in a register, so for those (sparc), we instead
-        generate the address as an offset from the static symbol
-        <code>MainCapability</code>, since the register table lives in
-        there.
-        <p>
-        Finally, <code>BaseReg</code> does occasionally itself get
-        mentioned in Stix expression trees, and in this case what is
-        denoted is precisely <code>(&MainCapability.r)</code>, not, as
-        in all other cases, the value of memory at some offset from
-        the start of the register table.  Since what it denotes is an
-        r-value and not an l-value, assigning <code>BaseReg</code> is
-        meaningless, so the machinery checks to ensure this never
-        happens.  All these details are taken into account by the
-        constant folder.
-    <p>
-    <li><b>Instruction selection.</b>  This is the only majorly
-        target-specific phase.  It turns Stix statements and
-        expressions into sequences of <code>Instr</code>, a data
-        type which is different for each architecture.
-        <code>Instr</code>, unsurprisingly, has various supporting
-        types, such as <code>Reg</code>, <code>Operand</code>,
-        <code>Imm</code>, etc.  The generated instructions may refer
-        to specific machine registers, or to arbitrary virtual
-        registers, either those created within the instruction
-        selector, or those mentioned in the Stix passed to it.
-        <p>
-        The instruction selectors live in <code>MachCode.lhs</code>.
-        The core functions, for each target, are:
-        <p>
-        <code>
-        getAmode :: StixExpr -> NatM Amode
-        <br>getRegister :: StixExpr -> NatM Register
-        <br>assignMem_IntCode :: PrimRep -> StixExpr -> StixExpr -> NatM InstrBlock
-        <br>assignReg_IntCode :: PrimRep -> StixReg  -> StixExpr -> NatM InstrBlock
-        </code>
-        <p>
-        The insn selectors use the "maximal munch" algorithm.  The
-        bizarrely-misnamed <code>getRegister</code> translates
-        expressions.  A simplified version of its type is:
-        <p>
-        <code>getRegister :: StixExpr -> NatM (OrdList Instr, Reg)</code>
-        <p>
-        That is: it (monadically) turns a <code>StixExpr</code> into a
-        sequence of instructions, and a register, with the meaning
-        that after executing the (possibly empty) sequence of
-        instructions, the (possibly virtual) register will
-        hold the resulting value.  The real situation is complicated
-        by the presence of fixed registers, and is detailed below.
-        <p>
-        Maximal munch is a greedy algorithm and is known not to give
-        globally optimal code sequences, but it is good enough, and
-        fast and simple.  Early incarnations of the NCG used something
-        more sophisticated, but that is long gone now.
-        <p>
-        Similarly, <code>getAmode</code> translates a value, intended
-        to denote an address, into a sequence of insns leading up to
-        a (processor-specific) addressing mode.  This stuff could be
-        done using the general <code>getRegister</code> selector, but
-        would necessarily generate poorer code, because the calculated
-        address would be forced into a register, which might be
-        unnecessary if it could partially or wholly be calculated
-        using an addressing mode.
-        <p>
-        Finally, <code>assignMem_IntCode</code> and
-        <code>assignReg_IntCode</code> create instruction sequences to
-        calculate a value and store it in the given register, or at
-        the given address.  Because these guys translate a statement,
-        not a value, they just return a sequence of insns and no
-        associated register.  Floating-point and 64-bit integer
-        assignments have analogous selectors.
-        <p>
-        Apart from the complexities of fixed vs floating registers,
-        discussed below, the instruction selector is as simple
-        as it can be.  It looks long and scary but detailed
-        examination reveals it to be fairly straightforward.
-    <p>
-    <li><b>Register allocation.</b> The register allocator,
-        <code>AsmRegAlloc.lhs</code> takes sequences of
-        <code>Instr</code>s which mention a mixture of real and
-        virtual registers, and returns a modified sequence referring
-        only to real ones.  It is gloriously and entirely
-        target-independent.  Well, not exactly true.  Instead it
-        regards <code>Instr</code> (instructions) and <code>Reg</code>
-        (virtual and real registers) as abstract types, to which it has
-        the following interface:
-        <p>
-        <code>
-        insnFuture :: Instr -> InsnFuture
-        <br>regUsage :: Instr -> RegUsage
-        <br>patchRegs :: Instr -> (Reg -> Reg) -> Instr
-        </code>
-        <p>
-        <code>insnFuture</code> is used to (re)construct the graph of
-        all possible control transfers between the insns to be
-        allocated.  <code>regUsage</code> returns the sets of registers
-        read and written by an instruction.  And
-        <code>patchRegs</code> is used to apply the allocator's final
-        decision on virtual-to-real reg mapping to an instruction.
-        <p>
-        Clearly these 3 fns have to be written anew for each
-        architecture.  They are defined in
-        <code>RegAllocInfo.lhs</code>.  Think twice, no, thrice,
-        before modifying them: making false claims about insn
-        behaviour will lead to hard-to-find register allocation
-        errors.
-        <p>
-        <code>AsmRegAlloc.lhs</code> contains detailed comments about
-	how the allocator works.  Here is a summary.  The head honcho
-        <p>
-        <code>allocUsingTheseRegs :: [Instr] -> [Reg] -> (Bool, [Instr])</code>
-        <p>
-        takes a list of instructions and a list of real registers
-        available for allocation, and maps as many of the virtual regs
-        in the input into real ones as it can.  The returned
-        <code>Bool</code> indicates whether or not it was
-        successful.  If so, that's the end of it.  If not, the caller
-        of <code>allocUsingTheseRegs</code> will attempt spilling.
-        More of that later.  What <code>allocUsingTheseRegs</code>
-        does is:
-        <p>
-        <ul>
-        <li>Implicitly number each instruction by its position in the
-            input list.
-        <p>
-        <li>Using <code>insnFuture</code>, create the set of all flow
-            edges -- possible control transfers -- within this set of
-            insns.
-        <p>
-        <li>Using <code>regUsage</code> and iterating around the flow
-            graph from the previous step, calculate, for each virtual
-            register, the set of flow edges on which it is live.
-        <p>
-        <li>Make a real-register committment map, which gives the set
-            of edges for which each real register is committed (in
-            use).  These sets are initially empty.  For each virtual
-            register, attempt to find a real register whose current
-            committment does not intersect that of the virtual
-            register -- ie, is uncommitted on all edges that the
-            virtual reg is live.  If successful, this means the vreg
-            can be assigned to the realreg, so add the vreg's set to
-            the realreg's committment.  
-        <p>
-        <li>If all the vregs were assigned to a realreg, use
-            <code>patchInstr</code> to apply the mapping to the insns themselves.
-        </ul>
-        <p>
-        <b>Spilling</b>
-        <p>
-        If <code>allocUsingTheseRegs</code> fails, a baroque
-        mechanism comes into play.  We now know that much simpler
-        schemes are available to do the same thing and give better
-        results.  
-        Anyways:
-        <p>
-        The logic above <code>allocUsingTheseRegs</code>, in
-        <code>doGeneralAlloc</code> and <code>runRegAllocate</code>,
-        observe that allocation has failed with some set R of real
-        registers.  So they apply <code>runRegAllocate</code> a second
-        time to the code, but remove (typically) two registers from R
-        before doing so.  This naturally fails too, but returns a
-        partially-allocated sequence.  <code>doGeneralAlloc</code>
-        then inserts spill code into the sequence, and finally re-runs
-        <code>allocUsingTheseRegs</code>, but supplying the original,
-        unadulterated R.  This is guaranteed to succeed since the two
-        registers previously removed from R are sufficient to allocate
-        all the spill/restore instructions added.
-        <p>
-        Because x86 is very short of registers, and in the worst case
-        needs three removed from R, a softly-softly approach is used.
-        <code>doGeneralAlloc</code> first tries with zero regs removed
-        from R, then if that fails one, then two, etc.  This means
-        <code>allocUsingTheseRegs</code> may get run several times
-        before a successful arrangement is arrived at.
-        <code>findReservedRegs</code> cooks up the sets of spill
-        registers to try with.
-        <p>
-        The resulting machinery is complicated and the generated spill
-        code is appalling.  The saving grace is that spills are very
-        rare so it doesn't matter much.  I did not invent this -- I inherited it.
-        <p>
-        <b>Dealing with common cases fast</b>
-        <p>
-        The entire reg-alloc mechanism described so far is general and
-        correct, but expensive overkill for many simple code blocks.
-        So to begin with we use
-        <code>doSimpleAlloc</code>, which attempts to do something
-        simple.  It exploits the observation that if the total number
-        of virtual registers does not exceed the number of real ones
-        available, we can simply dole out a new realreg each time we
-        see mention of a new vreg, with no regard for control flow.
-        <code>doSimpleAlloc</code> therefore attempts this in a
-        single pass over the code.  It gives up if it runs out of real
-        regs or sees any condition which renders the above observation
-        invalid (fixed reg uses, for example).  
-        <p>
-        This clever hack handles the majority of code blocks quickly.
-        It was copied from the previous reg-allocator (the
-        Mattson/Partain/Marlow/Gill one).
-    </ul>
-
-<p>
-<h2>Complications, observations, and possible improvements</h2>
-
-<h3>Real vs virtual registers in the instruction selectors</h3>
-
-The instruction selectors for expression trees, namely
-<code>getRegister</code>, are complicated by the fact that some 
-expressions can only be computed into a specific register, whereas
-the majority can be computed into any register.  We take x86 as an
-example, but the problem applies to all archs.
-<p>
-Terminology: <em>rreg</em> means real register, a real machine
-register.  <em>vreg</em> means one of an infinite set of virtual
-registers.  The type <code>Reg</code> is the sum of <em>rreg</em> and
-<em>vreg</em>.  The instruction selector generates sequences with
-unconstrained use of vregs, leaving the register allocator to map them
-all into rregs.
-<p>
-Now, where was I ?  Oh yes.  We return to the type of
-<code>getRegister</code>, which despite its name, selects instructions
-to compute the value of an expression tree.  
-<pre>
-   getRegister :: StixExpr -> NatM Register
-
-   data Register
-     = Fixed   PrimRep Reg InstrBlock
-     | Any     PrimRep (Reg -> InstrBlock)
-
-   type InstrBlock -- sequence of instructions
-</pre>
-At first this looks eminently reasonable (apart from the stupid
-name).  <code>getRegister</code>, and nobody else, knows whether or
-not a given expression has to be computed into a fixed rreg or can be
-computed into any rreg or vreg.  In the first case, it returns
-<code>Fixed</code> and indicates which rreg the result is in.  In the
-second case it defers committing to any specific target register by
-returning a function from <code>Reg</code> to <code>InstrBlock</code>,
-and the caller can specify the target reg as it sees fit.
-<p>
-Unfortunately, that forces <code>getRegister</code>'s callers (usually
-itself) to use a clumsy and confusing idiom in the common case where
-they do not care what register the result winds up in.  The reason is
-that although a value might be computed into a fixed rreg, we are
-forbidden (on pain of segmentation fault :) from subsequently
-modifying the fixed reg.  This and other rules are record in "Rules of
-the game" inside <code>MachCode.lhs</code>.
-<p>
-Why can't fixed registers be modified post-hoc?  Consider a simple
-expression like <code>Hp+1</code>.  Since the heap pointer
-<code>Hp</code> is definitely in a fixed register, call it R,
-<code>getRegister</code> on subterm <code>Hp</code> will simply return
-<code>Fixed</code> with an empty sequence and R.  But we can't just
-emit an increment instruction for R, because that trashes
-<code>Hp</code>; instead we first have to copy it into a fresh vreg
-and increment that.
-<p>
-With all that in mind, consider now writing a <code>getRegister</code>
-clause for terms of the form <code>(1 + E)</code>.  Contrived, yes,
-but illustrates the matter.  First we do
-<code>getRegister</code> on E.  Now we are forced to examine what 
-comes back.
-<pre>
-   getRegister (OnePlus e)
-      = getRegister e           `thenNat`   \ e_result ->
-        case e_result of
-           Fixed e_code e_fixed 
-              -> returnNat (Any IntRep (\dst -> e_code ++ [MOV e_fixed dst, INC dst]))
-           Any e_any 
-              -> Any (\dst -> e_any dst ++ [INC dst])
-</pre>
-This seems unreasonably cumbersome, yet the instruction selector is
-full of such idioms.  A good example of the complexities induced by
-this scheme is shown by <code>trivialCode</code> for x86 in
-<code>MachCode.lhs</code>.  This deals with general integer dyadic
-operations on x86 and has numerous cases.  It was difficult to get
-right.
-<p>
-An alternative suggestion is to simplify the type of
-<code>getRegister</code> to this:
-<pre>
-   getRegister :: StixExpr -> NatM (InstrBloc, VReg)
-   type VReg = .... a vreg ...
-</pre>
-and then we could safely write
-<pre>
-   getRegister (OnePlus e)
-      = getRegister e        `thenNat`  \ (e_code, e_vreg) ->
-        returnNat (e_code ++ [INC e_vreg], e_vreg)
-</pre>
-which is about as straightforward as you could hope for.
-Unfortunately, it requires <code>getRegister</code> to insert moves of
-values which naturally compute into an rreg, into a vreg.  Consider:
-<pre>
-   1 + ccall some-C-fn
-</pre>
-On x86 the ccall result is returned in rreg <code>%eax</code>.  The
-resulting sequence, prior to register allocation, would be:
-<pre>
-   # push args
-   call some-C-fn
-   # move %esp to nuke args
-   movl   %eax, %vreg
-   incl   %vreg
-</pre>
-If, as is likely, <code>%eax</code> is not held live beyond this point
-for any other purpose, the move into a fresh register is pointless;
-we'd have been better off leaving the value in <code>%eax</code> as
-long as possible.
-<p>
-The simplified <code>getRegister</code> story is attractive.  It would
-clean up the instruction selectors significantly and make it simpler
-to write new ones.  The only drawback is that it generates redundant
-register moves.  I suggest that eliminating these should be the job
-of the register allocator.  Indeed:
-<ul>
-<li>There has been some work on this already ("Iterated register
-    coalescing" ?), so this isn't a new idea.
-<p>
-<li>You could argue that the existing scheme inappropriately blurs the
-    boundary between the instruction selector and the register
-    allocator.  The instruction selector should .. well .. just
-    select instructions, without having to futz around worrying about
-    what kind of registers subtrees get generated into.  Register
-    allocation should be <em>entirely</em> the domain of the register
-    allocator, with the proviso that it should endeavour to allocate
-    registers so as to minimise the number of non-redundant reg-reg
-    moves in the final output.
-</ul>
-
-
-<h3>Selecting insns for 64-bit values/loads/stores on 32-bit platforms</h3>
-
-Note that this stuff doesn't apply on 64-bit archs, since the
-<code>getRegister</code> mechanism applies there.
-
-The relevant functions are:
-<pre>
-   assignMem_I64Code :: StixExpr -> StixExpr -> NatM InstrBlock
-   assignReg_I64Code :: StixReg  -> StixExpr -> NatM InstrBlock
-   iselExpr64        :: StixExpr -> NatM ChildCode64
-
-   data ChildCode64     -- a.k.a "Register64"
-      = ChildCode64 
-           InstrBlock   -- code
-           VRegUnique   -- unique for the lower 32-bit temporary
-</pre>
-<code>iselExpr64</code> is the 64-bit, plausibly-named analogue of
-<code>getRegister</code>, and <code>ChildCode64</code> is the analogue
-of <code>Register</code>.  The aim here was to generate working 64
-bit code as simply as possible.  To this end, I used the 
-simplified <code>getRegister</code> scheme described above, in which
-<code>iselExpr64</code>generates its results into two vregs which
-can always safely be modified afterwards.
-<p>
-Virtual registers are, unsurprisingly, distinguished by their
-<code>Unique</code>s.  There is a small difficulty in how to
-know what the vreg for the upper 32 bits of a value is, given the vreg
-for the lower 32 bits.  The simple solution adopted is to say that
-any low-32 vreg may also have a hi-32 counterpart which shares the
-same unique, but is otherwise regarded as a separate entity.
-<code>getHiVRegFromLo</code> gets one from the other.
-<pre>
-   data VRegUnique
-      = VRegUniqueLo Unique          -- lower part of a split quantity
-      | VRegUniqueHi Unique          -- upper part thereof
-</pre>
-Apart from that, 64-bit code generation is really simple.  The sparc
-and x86 versions are almost copy-n-pastes of each other, with minor
-adjustments for endianness.  The generated code isn't wonderful but
-is certainly acceptable, and it works.
-
-
-
-<h3>Shortcomings and inefficiencies in the register allocator</h3>
-
-<h4>Redundant reconstruction of the control flow graph</h4>
-
-The allocator goes to considerable computational expense to construct
-all the flow edges in the group of instructions it's allocating for,
-by using the <code>insnFuture</code> function in the
-<code>Instr</code> pseudo-abstract type.
-<p>
-This is really silly, because all that information is present at the
-abstract C stage, but is thrown away in the translation to Stix.
-So a good thing to do is to modify that translation to
-produce a directed graph of Stix straight-line code blocks,
-and to preserve that structure through the insn selector, so the
-allocator can see it.  
-<p>
-This would eliminate the fragile, hacky, arch-specific
-<code>insnFuture</code> mechanism, and probably make the whole
-compiler run measurably faster.  Register allocation is a fair chunk
-of the time of non-optimising compilation (10% or more), and
-reconstructing the flow graph is an expensive part of reg-alloc.
-It would probably accelerate the vreg liveness computation too.
-
-<h4>Really ridiculous method for doing spilling</h4>
-
-This is a more ambitious suggestion, but ... reg-alloc should be
-reimplemented, using the scheme described in "Quality and speed in
-linear-scan register allocation."  (Traub?)  For straight-line code
-blocks, this gives an elegant one-pass algorithm for assigning
-registers and creating the minimal necessary spill code, without the
-need for reserving spill registers ahead of time.
-<p>
-I tried it in Rigr, replacing the previous spiller which used the
-current GHC scheme described above, and it cut the number of spill
-loads and stores by a factor of eight.  Not to mention being simpler,
-easier to understand and very fast.
-<p>
-The Traub paper also describes how to extend their method to multiple
-basic blocks, which will be needed for GHC.  It comes down to
-reconciling multiple vreg-to-rreg mappings at points where control
-flow merges.
-
-<h4>Redundant-move support for revised instruction selector suggestion</h4>
-
-As mentioned above, simplifying the instruction selector will require
-the register allocator to try and allocate source and destination
-vregs to the same rreg in reg-reg moves, so as to make as many as
-possible go away.  Without that, the revised insn selector would
-generate worse code than at present.  I know this stuff has been done
-but know nothing about it.  The Linear-scan reg-alloc paper mentioned
-above does indeed mention a bit about it in the context of single
-basic blocks, but I don't know if that's sufficient.
-
-
-   
-<h3>x86 arcana that you should know about</h3>
-
-The main difficulty with x86 is that many instructions have fixed
-register constraints, which can occasionally make reg-alloc fail
-completely.  And the FPU doesn't have the flat register model which
-the reg-alloc abstraction (implicitly) assumes.
-<p>
-Our strategy is: do a good job for the common small subset, that is
-integer loads, stores, address calculations, basic ALU ops (+, -,
-and, or, xor), and jumps.  That covers the vast majority of 
-executed insns.  And indeed we do do a good job, with a loss of
-less than 2% compared with gcc.
-<p>
-Initially we tried to handle integer instructions with awkward
-register constraints (mul, div, shifts by non-constant amounts) via
-various jigglings of the spiller et al.  This never worked robustly,
-and putting platform-specific tweaks in the generic infrastructure is
-a big No-No.  (Not quite true; shifts by a non-constant amount are
-still done by a giant kludge, and should be moved into this new
-framework.)
-<p>
-Fortunately, all such insns are rare.  So the current scheme is to 
-pretend that they don't have any such constraints.  This fiction is
-carried all the way through the register allocator.  When the insn
-finally comes to be printed, we emit a sequence which copies the
-operands through memory (<code>%esp</code>-relative), satisfying the
-constraints of the real instruction.  This localises the gruesomeness
-to just one place.  Here, for example, is the code generated for
-integer divison of <code>%esi</code> by <code>%ecx</code>:
-<pre>
-   # BEGIN IQUOT %ecx, %esi
-   pushl $0
-   pushl %eax  
-   pushl %edx
-   pushl %ecx
-   movl  %esi,% eax
-   cltd
-   idivl 0(%esp)
-   movl %eax, 12(%esp)
-   popl %edx  
-   popl %edx
-   popl %eax
-   popl %esi
-   # END   IQUOT %ecx, %esi
-</pre>
-This is not quite as appalling as it seems, if you consider that the
-division itself typically takes 16+ cycles, whereas the rest of the
-insns probably go through in about 1 cycle each.
-<p>
-This trick is taken to extremes for FP operations.
-<p>
-All notions of the x86 FP stack and its insns have been removed.
-Instead, we pretend, to the instruction selector and register
-allocator, that x86 has six floating point registers,
-<code>%fake0</code> .. <code>%fake5</code>, which can be used in the
-usual flat manner.  We further claim that x86 has floating point
-instructions very similar to SPARC and Alpha, that is, a simple
-3-operand register-register arrangement.  Code generation and register
-allocation proceed on this basis.
-<p>
-When we come to print out the final assembly, our convenient fiction
-is converted to dismal reality.  Each fake instruction is
-independently converted to a series of real x86 instructions.
-<code>%fake0</code> .. <code>%fake5</code> are mapped to
-<code>%st(0)</code> .. <code>%st(5)</code>.  To do reg-reg arithmetic
-operations, the two operands are pushed onto the top of the FP stack,
-the operation done, and the result copied back into the relevant
-register.  When one of the operands is also the destination, we emit a
-slightly less scummy translation.  There are only six
-<code>%fake</code> registers because 2 are needed for the translation,
-and x86 has 8 in total.
-<p>
-The translation is inefficient but is simple and it works.  A cleverer
-translation would handle a sequence of insns, simulating the FP stack
-contents, would not impose a fixed mapping from <code>%fake</code> to
-<code>%st</code> regs, and hopefully could avoid most of the redundant
-reg-reg moves of the current translation.
-<p>
-There are, however, two unforeseen bad side effects:
-<ul>
-<li>This doesn't work properly, because it doesn't observe the normal
-    conventions for x86 FP code generation.  It turns out that each of
-    the 8 elements in the x86 FP register stack has a tag bit which
-    indicates whether or not that register is notionally in use or
-    not.  If you do a FPU operation which happens to read a
-    tagged-as-empty register, you get an x87 FPU (stack invalid)
-    exception, which is normally handled by the FPU without passing it
-    to the OS: the program keeps going, but the resulting FP values
-    are garbage.  The OS can ask for the FPU to pass it FP
-    stack-invalid exceptions, but it usually doesn't.
-    <p>
-    Anyways: inside NCG created x86 FP code this all works fine.
-    However, the NCG's fiction of a flat register set does not operate
-    the x87 register stack in the required stack-like way.  When
-    control returns to a gcc-generated world, the stack tag bits soon
-    cause stack exceptions, and thus garbage results.
-    <p>
-    The only fix I could think of -- and it is horrible -- is to clear
-    all the tag bits just before the next STG-level entry, in chunks
-    of code which use FP insns.  <code>i386_insert_ffrees</code>
-    inserts the relevant <code>ffree</code> insns into such code
-    blocks.  It depends critically on <code>is_G_instr</code> to
-    detect such blocks.
-<p>
-<li>It's very difficult to read the generated assembly and
-    reason about it when debugging, because there's so much clutter.
-    We print the fake insns as comments in the output, and that helps
-    a bit. 
-</ul>
-
-
-
-<h3>Generating code for ccalls</h3>
-
-For reasons I don't really understand, the instruction selectors for
-generating calls to C (<code>genCCall</code>) have proven surprisingly
-difficult to get right, and soaked up a lot of debugging time.  As a
-result, I have once again opted for schemes which are simple and not
-too difficult to argue as correct, even if they don't generate
-excellent code.
-<p>
-The sparc ccall generator in particular forces all arguments into
-temporary virtual registers before moving them to the final
-out-registers (<code>%o0</code> .. <code>%o5</code>).  This creates
-some unnecessary reg-reg moves.  The reason is explained in a
-comment in the code.
-
-
-<h3>Duplicate implementation for many STG macros</h3>
-
-This has been discussed at length already.  It has caused a couple of
-nasty bugs due to subtle untracked divergence in the macro
-translations.  The macro-expander really should be pushed up into the
-Abstract C phase, so the problem can't happen.
-<p>
-Doing so would have the added benefit that the NCG could be used to
-compile more "ways" -- well, at least the 'p' profiling way.
-
-
-<h3>How to debug the NCG without losing your sanity/hair/cool</h3>
-
-Last, but definitely not least ...
-<p>
-The usual syndrome is that some program, when compiled via C, works,
-but not when compiled via the NCG.  Usually the problem is fairly 
-simple to fix, once you find the specific code block which has been
-mistranslated.  But the latter can be nearly impossible, since most
-modules generate at least hundreds and often thousands of them.
-<p>
-My solution: cheat.
-<p>
-Because the via-C and native routes diverge only late in the day,
-it is not difficult to construct a 1-1 correspondence between basic
-blocks on the two routes.  So, if the program works via C but not on
-the NCG, do the following:
-<ul>
-<li>Recompile <code>AsmCodeGen.lhs</code> in the afflicted compiler
-    with <code>-DDEBUG_NCG</code>, so that it inserts
-    <code>___ncg_debug_marker</code>s
-    into the assembly it emits.
-<p>
-<li>Using a binary search on modules, find the module which is causing
-    the problem.
-<p>
-<li>Compile that module to assembly code, with identical flags, twice,
-    once via C and once via NCG.
-    Call the outputs <code>ModuleName.s-gcc</code> and
-    <code>ModuleName.s-nat</code>.  Check that the latter does indeed have 
-    <code>___ncg_debug_marker</code>s in it; otherwise the next steps fail.
-<p>
-<li>Build (with a working compiler) the program
-    <code>fptools/ghc/utils/debugNCG/diff_gcc_nat</code>.
-<p>
-<li>Run: <code>diff_gcc_nat ModuleName.s</code>.  This will
-    construct the 1-1 correspondence, and emits on stdout 
-    a cppable assembly output.  Place this in a file -- I always
-    call it <code>synth.S</code>.  Note, the capital S is important;
-    otherwise it won't get cpp'd.  You can feed this file directly to
-    ghc and it will automatically get cpp'd; you don't have to do so
-    yourself.
-<p>
-<li>By messing with the <code>#define</code>s at the top of
-    <code>synth.S</code>, do a binary search to find the incorrect
-    block.  Keep a careful record of where you are in the search; it
-    is easy to get confused.  Remember also that multiple blocks may
-    be wrong, which also confuses matters.  Finally, I usually start
-    off by re-checking that I can build the executable with all the
-    <code>#define</code>s set to 0 and then all to 1.  This ensures
-    you won't get halfway through the search and then get stuck due to
-    some snafu with gcc-specific literals.  Usually I set
-    <code>UNMATCHED_GCC</code> to 1 all the time, and this bit should
-    contain only literal data.
-    <code>UNMATCHED_NAT</code> should be empty.
-</ul>
-<p>
-<code>diff_gcc_nat</code> was known to work correctly last time I used
-it, in December 01, for both x86 and sparc.  If it doesn't work, due
-to changes in assembly syntax, or whatever, make it work.  The
-investment is well worth it.  Searching for the incorrect block(s) any
-other way is a total time waster.
-
-
-
-</ul>
-
-
-
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Fri Feb  1 16:14:11 GMT 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/optimistic.html b/ghc/docs/comm/the-beast/optimistic.html
deleted file mode 100644
index 4d158022e8..0000000000
--- a/ghc/docs/comm/the-beast/optimistic.html
+++ /dev/null
@@ -1,65 +0,0 @@
-<h2> Architectural stuff </h2>
-
-New fields in the TSO:
-<ul>
-<li> New global speculation-depth register; always counts the number of specuation frames
-on the stack; incremented when 
-starting speculation, decremented when finishing.
-<li> Profiling stuff
-</ul>
-
-
-<h2> Speculation frames </h2>
-
-The info table for a speculation frame points to the static spec-depth configuration
-for that speculation point. (Points to, because the config is mutable, and the info
-table has to be adjacent to the (immutable) code.)
-
- 
-
-<h2> Abortion</h2>
-
-Abortion is modelled by a special asynchronous exception ThreadAbort.
-
-<ul>
-<li> In the scheduler, if a thread returns with ThreadBlocked, and non-zero SpecDepth, send it
-an asynchronous exception.
-
-<li> In the implementation of the <tt>catch#</tt> primop, raise an asynchonous exception if 
-SpecDepth is nonzero.
-
-<li> Timeout, administered by scheduler.  Current story: abort if a speculation frame lasts from
-one minor GC to the next.  We detect this by seeing if there's a profiling frame on the stack --- a 
-profiling frame is added at a minor GC in place of a speculation frame (see Online Profiling).
-</ul>
-
-
-When tearing frames off the stack, we start a new chunk at every speculation frame, as well as every
-update frame.  We proceed down to the deepest speculation frame.  
-<p>
-The <tt>AP_STACK</tt> closure built for a speculation frame must be careful <em>not</em> to enter the 
-next <tt>AP_STACK</tt> closure up, because that would re-enter a possible loop.
-<p>
-Delivering an asynch exception to a thread that is speculating.  Invariant: there can be no catch frames
-inside speculation (we abort in <tt>catch#</tt> when speculating.  So the asynch exception just 
-tears off frames in the standard way until it gets to a catch frame, just as it would usually do.
-<p>
-Abortion can punish one or more of the speculation frames by decrementing their static config variables.
-
-<h3>Synchronous exceptions</h3>
- 
-Synchronous exceptions are treated similarly as before.  The stack is discarded up to an update frame; the
-thunk to be updated is overwritten with "raise x", and the process continues.  Until a catch frame.
-<p>
-When we find a spec frame, we allocate a "raise x" object, and resume execution with the return address
-in the spec frame.  In that way the spec frame is like a catch frame; it stops the unwinding process.
-<p>
-It's essential that every hard failure is caught, else speculation is unsafe.  In particular, divide by zero
-is hard to catch using OS support, so we test explicitly in library code.  You can shoot yourself in the foot 
-by writing <tt>x `div#` 0</tt>, side-stepping the test.
-
-
-<h3> Online profiling </h3>
-
-Sampling can be more frequent than minor GC (by jiggling the end-of-block code) but cannot
-be less frequent, because GC doesn't expect to see profiling frames.
\ No newline at end of file
diff --git a/ghc/docs/comm/the-beast/prelude.html b/ghc/docs/comm/the-beast/prelude.html
deleted file mode 100644
index 64b607def5..0000000000
--- a/ghc/docs/comm/the-beast/prelude.html
+++ /dev/null
@@ -1,207 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Primitives and the Prelude</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Primitives and the Prelude</h1>
-    <p>
-      One of the trickiest aspects of GHC is the delicate interplay
-      between what knowledge is baked into the compiler, and what
-      knowledge it gets by reading the interface files of library
-      modules.  In general, the less that is baked in, the better.
-<p>
-      Most of what the compiler has to have wired in about primitives and
-      prelude definitions is in
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/"><code>fptools/ghc/compiler/prelude/</code></a>.
-    </p>
-
-GHC recognises these main classes of baked-in-ness:
-<dl>
-<dt><strong>Primitive types.</strong>
-<dd>Primitive types cannot be defined in Haskell, and are utterly baked into the compiler.
-They are notionally defined in the fictional module <tt>GHC.Prim</tt>.   The <tt>TyCon</tt>s for these types are all defined
-in module <tt>TysPrim</tt>; for example,
-<pre>
-  intPrimTyCon :: TyCon 
-  intPrimTyCon = ....
-</pre>
-Examples:
-<tt>Int#, Float#, Addr#, State#</tt>.  
-<p>
-<dt><strong>Wired-in types.</strong>
-<dd>Wired-in types can be defined in Haskell, and indeed are (many are defined in </tt>GHC.Base</tt>).
-However, it's very convenient for GHC to be able to use the type constructor for (say) <tt>Int</tt>
-without looking it up in any environment.  So module <tt>TysWiredIn</tt> contains many definitions
-like this one:
-<pre>
-  intTyCon :: TyCon
-  intTyCon = ....
-
-  intDataCon :: DataCon 
-  intDataCon = ....
-</pre>
-However, since a <tt>TyCon</tt> value contains the entire type definition inside it, it follows
-that the complete definition of <tt>Int</tt> is thereby baked into the compiler.  
-<p>
-Nevertheless, the library module <tt>GHC.Base</tt> still contains a definition for <tt>Int</tt> 
-just so that its info table etc get generated somewhere.  Chaos will result if the wired-in definition
-in <tt>TysWiredIn</tt> differs from that in <tt>GHC.Base</tt>.
-<p>
-The rule is that only very simple types should be wired in (for example, <tt>Ratio</tt> is not,
-and <tt>IO</tt> is certainly not).  No class is wired in: classes are just too complicated.
-<p>
-Examples: <tt>Int</tt>, <tt>Float</tt>, <tt>List</tt>, tuples.
-
-<p>
-<dt><strong>Known-key things.</strong>
-<dd>GHC knows of the existence of many, many other types, classes and values.  <em>But all it knows is
-their <tt>Name</tt>.</em>  Remember, a <tt>Name</tt> includes a unique key that identifies the 
-thing, plus its defining module and occurrence name 
-(see <a href="names.html">The truth about Names</a>).  Knowing a <tt>Name</tt>, therefore, GHC can
-run off to the interface file for the module and find out everything else it might need.
-<p>
-Most of these known-key names are defined in module <tt>PrelNames</tt>; a further swathe concerning
-Template Haskell are defined in <tt>DsMeta</tt>.  The allocation of unique keys is done manually;
-chaotic things happen if you make a mistake here, which is why they are all together.
-</dl>
-
-All the <tt>Name</tt>s from all the above categories are used to initialise the global name cache,
-which maps (module,occurrence-name) pairs to the globally-unique <tt>Name</tt> for that
-thing.  (See <tt>HscMain.initOrigNames</tt>.)
-
-<p>
-The next sections elaborate these three classes a bit.
-
-
-    <h2>Primitives (module <tt>TysPrim</tt>)</h2>
-    <p>
-      Some types and functions have to be hardwired into the compiler as they
-      are atomic; all other code is essentially built around this primitive
-      functionality.  This includes basic arithmetic types, such as integers,
-      and their elementary operations as well as pointer types.  Primitive
-      types and functions often receive special treatment in the code
-      generator, which means that these entities have to be explicitly
-      represented in the compiler.  Moreover, many of these types receive some
-      explicit treatment in the runtime system, and so, there is some further
-      information about <a href="../rts-libs/primitives.html">primitives in
-      the RTS section</a> of this document.
-    <p>
-      The module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/TysPrim.lhs"><code>TysPrim</code></a>
-      exports a list of all primitive type constructors as <code>primTyCons ::
-      [TyCon]</code>.  All of these type constructors (of type
-      <code>TyCon</code>) are also exported as <code>intPrimTyCon</code>,
-      <code>stablePtrPrimTyCon</code>, and so on.  In addition, for each
-      nullary type constructor the corresponding type (of type
-      <code>Type</code>) is also exported; for example, we have
-      <code>intPrimTy :: Type</code>.  For all other type constructors, a
-      function is exported that constructs the type obtained by applying the
-      type constructors to an argument type (of type <code>Type</code>); for
-      example, we have <code>mkStablePtrPrimTy :: Type -> Type</code>.
-    <p>
-      As it is inconvenient to identify type that receive a special treatment
-      by the code generator by looking at their name, the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/PrimRep.lhs"><code>PrimRep</code></a>
-      exports a data type <code>PrimRep</code>, which lists all
-      machine-manipulable implementation types.  The module also exports a set
-      of query functions on <code>PrimRep</code> that define properties, such
-      as a type's byte size or whether a primitive type is a pointer type.
-      Moreover, the function <code>TysPrim.primRepTyCon :: PrimRep ->
-      TyCon</code> converts <code>PrimRep</code> values into the corresponding
-      type constructor.
-
-    <h2>Wired in types (module <tt>TysWiredIn</tt>)</h2>
-    <p>
-      In addition to entities that are primitive, as the compiler has to treat
-      them specially in the backend, there is a set of types, functions,
-      etc. that the Haskell language definition flags as essential to the
-      language by placing them into the special module <code>Prelude</code>
-      that is implicitly imported into each Haskell module.  For some of these
-      entities it suffices to define them (by standard Haskell definitions) in
-      a <code>Prelude</code> module and ensuring that this module is treated
-      specially by being always imported .
-    <p>
-      However, there is a set of entities (such as, for example, the list type
-      and the corresponding data constructors) that have an inbetween status:
-      They are not truly primitive (lists, for example, can easily be defined
-      by a <code>data</code> declaration), but the compiler has to have extra
-      knowledge about them, as they are associated with some particular
-      features of the language (in the case of lists, there is special syntax,
-      such as list comprehensions, associated with the type).  Another
-      example, for a special kind of entity are type classes that can be used
-      in a <code>deriving</code> clause.  All types that are not-primitive,
-      but about which the compiler nonetheless has to have some extra
-      knowledge are defined in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/TysWiredIn.lhs"><code>TysWiredIn</code></a>.
-    <p>
-      All wired in type constructors are contained in <code>wiredInTyCons ::
-      [TyCon]</code>.  In addition to that list, <code>TysWiredIn</code>
-      exports variables bound to representations of all listed type
-      constructors and their data constructors.  So, for example, we have
-      <code>listTyCon</code> together with <code>nilDataCon</cons> and
-      </code>consDataCon</code>.  There are also convenience functions, such
-      as <code>mkListTy</code> and <code>mkTupleTy</code>, which construct
-      compound types.
-    <p>
-
-    <h2>Known-key names (module <tt>PrelNames</tt>)</h2>
-
-      All names of types, functions, etc. known to the compiler are defined in
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/PrelNames.lhs"><code>PrelNames</code></a>.
-      This includes the names of types and functions exported from
-      <code>TysWiredIn</code>, but also others.  In particular, this module
-      also fixes the names of all prelude modules; i.e., of the modules whose
-      name starts with <code>Prel</code>, which GHC's library uses to bring
-      some structure into the quite large number of <code>Prelude</code>
-      definitions.
-    <p>
-      <code>PrelNames.knownKeyNames :: [Name]</code> contains all names known
-      to the compiler, but the elements of the list are also exported
-      individually as variables, such as <code>floatTyConName</code> (having
-      the lexeme <code>Float</code>) and <code>floatDataConName</code> (having
-      the lexeme <code>F#</code>).  For each of these names,
-      <code>PrelNames</code> derfines a unique key with a definition, such as
-    <p>
-<blockquote><pre>
-floatPrimTyConKey = mkPreludeTyConUnique 11</pre>
-</blockquote>
-    <p>
-      that is, all unique keys for known prelude names are hardcoded into
-      <code>PrelNames</code> (and uniqueness has to be manually ensured in
-      that module).  To simplify matching the types of important groups of
-      type constructors, <code>PrelNames</code> also exports lists, such as
-      <code>numericTyKeys</code> (keys of all numeric types), that contain the
-      unique keys of all names in that group.  In addition, derivable type
-      classes and their structure is defined by
-      <code>derivableClassKeys</code> and related definitions.
-    <p>
-      In addition to names that have unique keys, <code>PrelNames</code> also
-      defines a set of names without uniqueness information.  These names end
-      on the suffix <code>_RDR</code> and are of type <code>RdrName</code> (an
-      example, is <code>times_RDR</code>, which represents the lexeme
-      <code>*</code>).  The names are used in locations where they pass
-      through the renamer anyway (e.g., special constructors encountered by
-      the parser, such as [], and code generated from deriving clauses), which
-      will take care of adding uniqueness information.
-    <p>
-
-<h2>Gathering it all together (module <tt>PrelInfo</tt>)</h2>
-      The module
-      <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/prelude/PrelInfo.lhs"><code>PrelInfo</code></a>
-      in some sense ties all the above together and provides a reasonably
-      restricted interface to these definition to the rest of the compiler.
-      However, from what I have seen, this doesn't quite work out and the
-      earlier mentioned modules are directly imported in many places.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Tue Dec 11 17:54:07 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/renamer.html b/ghc/docs/comm/the-beast/renamer.html
deleted file mode 100644
index 828b569bb9..0000000000
--- a/ghc/docs/comm/the-beast/renamer.html
+++ /dev/null
@@ -1,249 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Glorious Renamer</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Glorious Renamer</h1>
-    <p>
-      The <em>renamer</em> sits between the parser and the typechecker.
-      However, its operation is quite tightly interwoven with the
-      typechecker.  This is partially due to support for Template Haskell,
-      where spliced code has to be renamed and type checked.  In particular,
-      top-level splices lead to multiple rounds of renaming and type
-      checking.
-    </p>
-    <p>
-      The main externally used functions of the renamer are provided by the
-      module <code>rename/RnSource.lhs</code>.  In particular, we have
-    </p>
-    <blockquote>
-      <pre>
-rnSrcDecls  :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
-rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
-rnSplice    :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)</pre>
-    </blockquote>
-    <p>
-      All of which execute in the renamer monad <code>RnM</code>.  The first
-      function, <code>rnSrcDecls</code> renames a binding group; the second,
-      <code>rnTyClDecls</code> renames a list of (toplevel) type and class
-      declarations; and the third, <code>rnSplice</code> renames a Template
-      Haskell splice.  As the types indicate, the main task of the renamer is
-      to convert converts all the <tt>RdrNames</tt> to <a
-      href="names.html"><tt>Names</tt></a>, which includes a number of
-      well-formedness checks (no duplicate declarations, all names are in
-      scope, and so on).  In addition, the renamer performs other, not
-      strictly name-related, well-formedness checks, which includes checking
-      that the appropriate flags have been supplied whenever language
-      extensions are used in the source.
-    </p>
-
-    <h2>RdrNames</h2>
-    <p>
-      A <tt>RdrName.RdrName</tt> is pretty much just a string (for an
-      unqualified name like "<tt>f</tt>") or a pair of strings (for a
-      qualified name like "<tt>M.f</tt>"):
-    </p>
-    <blockquote>
-      <pre>
-data RdrName 
-  = Unqual OccName
-	-- Used for ordinary, unqualified occurrences 
-
-  | Qual Module OccName
-	-- A qualified name written by the user in 
-	--  *source* code.  The module isn't necessarily 
-	-- the module where the thing is defined; 
-	-- just the one from which it is imported
-
-  | Orig Module OccName
-	-- An original name; the module is the *defining* module.
-	-- This is used when GHC generates code that will be fed
-	-- into the renamer (e.g. from deriving clauses), but where
-	-- we want to say "Use Prelude.map dammit".  
- 
-  | Exact Name
-	-- We know exactly the Name. This is used 
-	--  (a) when the parser parses built-in syntax like "[]" 
-	--	and "(,)", but wants a RdrName from it
-	--  (b) when converting names to the RdrNames in IfaceTypes
-	--	Here an Exact RdrName always contains an External Name
-	--	(Internal Names are converted to simple Unquals)
-	--  (c) by Template Haskell, when TH has generated a unique name</pre>
-    </blockquote>
-    <p> 
-      The OccName type is described in <a href="names.html#occname">The
-	truth about names</a>.
-    </p>
-
-    <h2>The Renamer Monad</h2>
-    <p>
-      Due to the tight integration of the renamer with the typechecker, both
-      use the same monad in recent versions of GHC.  So, we have
-    </p>
-    <blockquote>
-      <pre>
-type RnM  a = TcRn a		-- Historical
-type TcM  a = TcRn a		-- Historical</pre>
-    </blockquote>
-    <p>
-      with the combined monad defined as
-    </p>
-    <blockquote>
-      <pre>
-type TcRn a       = TcRnIf TcGblEnv TcLclEnv a
-type TcRnIf a b c = IOEnv (Env a b) c
-
-data Env gbl lcl	-- Changes as we move into an expression
-  = Env {
-	env_top	 :: HscEnv,	-- Top-level stuff that never changes
-				-- Includes all info about imported things
-
-	env_us   :: TcRef UniqSupply,	-- Unique supply for local varibles
-
-	env_gbl  :: gbl,	-- Info about things defined at the top level
-				-- of the module being compiled
-
-	env_lcl  :: lcl		-- Nested stuff; changes as we go into 
-				-- an expression
-    }</pre>
-    </blockquote>
-    <p>
-      the details of the global environment type <code>TcGblEnv</code> and
-      local environment type <code>TcLclEnv</code> are also defined in the
-      module <code>typecheck/TcRnTypes.lhs</code>.   The monad
-      <code>IOEnv</code> is defined in <code>utils/IOEnv.hs</code> and extends
-      the vanilla <code>IO</code> monad with an additional state parameter
-      <code>env</code> that is treated as in a reader monad.  (Side effecting
-      operations, such as updating the unique supply, are done with
-      <code>TcRef</code>s, which are simply a synonym for <code>IORef</code>s.)
-    </p>
-
-    <h2>Name Space Management</h2>
-    <p>
-      As anticipated by the variants <code>Orig</code> and <code>Exact</code>
-      of <code>RdrName</code> some names should not change during renaming,
-      whereas others need to be turned into unique names.  In this context,
-      the two functions <code>RnEnv.newTopSrcBinder</code> and
-      <code>RnEnv.newLocals</code> are important:
-    </p>
-    <blockquote>
-      <pre>
-newTopSrcBinder :: Module -> Maybe Name -> Located RdrName -> RnM Name
-newLocalsRn     :: [Located RdrName] -> RnM [Name]</pre>
-    </blockquote>
-    <p>
-      The two functions introduces new toplevel and new local names,
-      respectively, where the first two arguments to
-      <code>newTopSrcBinder</code> determine the currently compiled module and
-      the parent construct of the newly defined name.  Both functions create
-      new names only for <code>RdrName</code>s that are neither exact nor
-      original.
-    </p>
-
-    <h3>Introduction of Toplevel Names: Global RdrName Environment</h3>
-    <p>
-      A global <code>RdrName</code> environment
-      <code>RdrName.GlobalRdrEnv</code> is a map from <code>OccName</code>s to
-      lists of qualified names.  More precisely, the latter are
-      <code>Name</code>s with an associated <code>Provenance</code>:
-    </p>
-    <blockquote>
-      <pre>
-data Provenance
-  = LocalDef		-- Defined locally
-	Module
-
-  | Imported 		-- Imported
-	[ImportSpec]	-- INVARIANT: non-empty
-	Bool		-- True iff the thing was named *explicitly* 
-			-- in *any* of the import specs rather than being 
-			-- imported as part of a group; 
-	-- e.g.
-	--	import B
-	--	import C( T(..) )
-	-- Here, everything imported by B, and the constructors of T
-	-- are not named explicitly; only T is named explicitly.
-	-- This info is used when warning of unused names.</pre>
-    </blockquote>
-    <p>
-      The part of the global <code>RdrName</code> environment for a module
-      that contains the local definitions is created by the function
-      <code>RnNames.importsFromLocalDecls</code>, which also computes a data
-      structure recording all imported declarations in the form of a value of
-      type <code>TcRnTypes.ImportAvails</code>.
-    </p>
-    <p>
-      The function <code>importsFromLocalDecls</code>, in turn, makes use of
-      <code>RnNames.getLocalDeclBinders :: Module -> HsGroup RdrName -> RnM
-      [AvailInfo]</code> to extract all declared names from a binding group,
-      where <code>HscTypes.AvailInfo</code> is essentially a collection of
-      <code>Name</code>s; i.e., <code>getLocalDeclBinders</code>, on the fly,
-      generates <code>Name</code>s from the <code>RdrName</code>s of all
-      top-level binders of the module represented by the <code>HsGroup
-      RdrName</code> argument.
-    </p>
-    <p>
-      It is important to note that all this happens before the renamer
-      actually descends into the toplevel bindings of a module.  In other
-      words, before <code>TcRnDriver.rnTopSrcDecls</code> performs the
-      renaming of a module by way of <code>RnSource.rnSrcDecls</code>, it uses
-      <code>importsFromLocalDecls</code> to set up the global
-      <code>RdrName</code> environment, which contains <code>Name</code>s for
-      all imported <em>and</em> all locally defined toplevel binders.  Hence,
-      when the helpers of <code>rnSrcDecls</code> come across the
-      <em>defining</em> occurences of a toplevel <code>RdrName</code>, they
-      don't rename it by generating a new name, but they simply look up its
-      name in the global <code>RdrName</code> environment.
-    </p>
-
-    <h2>Rebindable syntax</h2>
-    <p>
-      In Haskell when one writes "3" one gets "fromInteger 3", where
-      "fromInteger" comes from the Prelude (regardless of whether the
-      Prelude is in scope).  If you want to completely redefine numbers,
-      that becomes inconvenient.  So GHC lets you say
-      "-fno-implicit-prelude"; in that case, the "fromInteger" comes from
-      whatever is in scope.  (This is documented in the User Guide.)
-    </p>
-    <p>
-      This feature is implemented as follows (I always forget).
-    <ul>
-      <li>Names that are implicitly bound by the Prelude, are marked by the
-	type <code>HsExpr.SyntaxExpr</code>.  Moreover, the association list
-	<code>HsExpr.SyntaxTable</code> is set up by the renamer to map
-	rebindable names to the value they are bound to.
-      </li>
-      <li>Currently, five constructs related to numerals
-	(<code>HsExpr.NegApp</code>, <code>HsPat.NPat</code>,
-	<code>HsPat.NPlusKPat</code>,  	<code>HsLit.HsIntegral</code>, and
-	<code>HsLit.HsFractional</code>)  and 
-	two constructs related to code>do</code> expressions
-	(<code>HsExpr.BindStmt</code> and 
-	<code>HsExpr.ExprStmt</code>) have rebindable syntax.
-      </li> 
-      <li> When the parser builds these constructs, it puts in the
-	built-in Prelude Name (e.g. PrelNum.fromInteger).
-      </li>
-      <li> When the renamer encounters these constructs, it calls
-      <tt>RnEnv.lookupSyntaxName</tt>. 
-	This checks for <tt>-fno-implicit-prelude</tt>; if not, it just
-	returns the same Name; otherwise it takes the occurrence name of the
-	Name, turns it into an unqualified RdrName, and looks it up in the
-	environment.  The returned name is plugged back into the construct.
-      </li>
-      <li> The typechecker uses the Name to generate the appropriate typing
-	constraints. 
-      </li>
-    </ul>
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed May  4 17:16:15 EST 2005
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
-
diff --git a/ghc/docs/comm/the-beast/simplifier.html b/ghc/docs/comm/the-beast/simplifier.html
deleted file mode 100644
index 40cf7cf892..0000000000
--- a/ghc/docs/comm/the-beast/simplifier.html
+++ /dev/null
@@ -1,86 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Mighty Simplifier</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Mighty Simplifier</h1>
-    <p>
-      Most of the optimising program transformations applied by GHC are
-      performed on an intermediate language called <em>Core,</em> which
-      essentially is a compiler-friendly formulation of rank-2 polymorphic
-      lambda terms defined in the module <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/coreSyn/CoreSyn.lhs/"><code>CoreSyn.lhs</code>.</a>
-      The transformation engine optimising Core programs is called the
-      <em>Simplifier</em> and composed from a couple of modules located in the
-      directory <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/simplCore/"><code>fptools/ghc/compiler/simplCore/</code>.</a>
-      The main engine of the simplifier is contained in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/simplCore/Simplify.lhs"><code>Simplify.lhs</code>.</a>
-      and its driver is the routine <code>core2core</code> in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/simplCore/SimplCore.lhs"><code>SimplCore.lhs</code>.</a>
-    <p>
-      The program that the simplifier has produced after applying its various
-      optimisations can be obtained by passing the option
-      <code>-ddump-simpl</code> to GHC.  Moreover, the various intermediate
-      stages of the optimisation process is printed when passing
-      <code>-dverbose-core2core</code>.
-
-    <h4><a name="loopBreaker">Recursive Definitions</a></h4>
-    <p>
-      The simplification process has to take special care when handling
-      recursive binding groups; otherwise, the compiler might loop.
-      Therefore, the routine <code>reOrderRec</code> in <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/simplCore/OccurAnal.lhs"><code>OccurAnal.lhs</code></a>
-      computes a set of <em>loop breakers</em> - a set of definitions that
-      together cut any possible loop in the binding group.  It marks the
-      identifiers bound by these definitions as loop breakers by enriching
-      their <a href="basicTypes.html#occInfo">occurence information.</a>  Loop
-      breakers will <em>never</em> be inlined by the simplifier; thus,
-      guaranteeing termination of the simplification procedure.  (This is not
-      entirely accurate -- see <a href="#rules">rewrite rules</a> below.)
-
-      The processes finding loop breakers works as follows: First, the
-      strongly connected components (SCC) of the graph representing all
-      function dependencies is computed.  Then, each SCC is inspected in turn.
-      If it contains only a single binding (self-recursive function), this is
-      the loop breaker.  In case of multiple recursive bindings, the function
-      attempts to select bindings where the decision not to inline them does
-      cause the least harm - in the sense of inhibiting optimisations in the
-      code.  This is achieved by considering each binding in turn and awarding
-      a <em>score</em> between 0 and 4, where a lower score means that the
-      function is less useful for inlining - and thus, a better loop breaker.
-      The evaluation of bingings is performed by the function
-      <code>score</code> locally defined in <code>OccurAnal</code>.
-      
-      Note that, because core programs represent function definitions as
-      <em>one</em> binding choosing between the possibly many equations in the
-      source program with a <code>case</code> construct, a loop breaker cannot
-      inline any of its possibly many alternatives (not even the non-recursive
-      alternatives).
-
-    <h4><a name="rules">Rewrite Rules</a></h4>
-    <p>
-      The application of rewrite rules is controlled in the module <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/simplCore/Simplify.lhs"><code>Simplify.lhs</code></a>
-      by the function <code>completeCall</code>.  This function first checks
-      whether it should inline the function applied at the currently inspected
-      call site, then simplifies the arguments, and finally, checks whether
-      any rewrite rule can be applied (and also whether there is a matching
-      specialised version of the applied function).  The actual check for rule
-      application is performed by the function <code><a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/specialise/Rules.lhs">Rules</a>.lookupRule</code>.
-    <p>
-      It should be note that the application of rewrite rules is not subject
-      to the loop breaker check - i.e., rules of loop breakers will be applied
-      regardless of whether this may cause the simplifier to diverge.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Aug  8 19:25:33 EST 2001
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/stg.html b/ghc/docs/comm/the-beast/stg.html
deleted file mode 100644
index 4581da7d1f..0000000000
--- a/ghc/docs/comm/the-beast/stg.html
+++ /dev/null
@@ -1,164 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - You Got Control: The STG-language</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - You Got Control: The STG-language</h1>
-    <p>
-      GHC contains two completely independent backends: the byte code
-      generator and the machine code generator.  The decision over which of
-      the two is invoked is made in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/HscMain.lhs"><code>HscMain</code></a><code>.hscCodeGen</code>.
-      The machine code generator proceeds itself in a number of phases: First,
-      the <a href="desugar.html">Core</a> intermediate language is translated
-      into <em>STG-language</em>; second, STG-language is transformed into a
-      GHC-internal variant of <a href="http://www.cminusminus.org/">C--</a>;
-      and thirdly, this is either emitted as concrete C--, converted to GNU C,
-      or translated to native code (by the <a href="ncg.html">native code
-      generator</a> which targets IA32, Sparc, and PowerPC [as of March '5]).
-    </p>
-    <p>
-      In the following, we will have a look at the first step of machine code
-      generation, namely the translation steps involving the STG-language.
-      Details about the underlying abstract machine, the <em>Spineless Tagless
-      G-machine</em>, are in <a
-      href="http://research.microsoft.com/copyright/accept.asp?path=/users/simonpj/papers/spineless-tagless-gmachine.ps.gz&pub=34">Implementing
-      lazy functional languages on stock hardware: the Spineless Tagless
-      G-machine</a>, SL Peyton Jones, Journal of Functional Programming 2(2),
-      Apr 1992, pp127-202. (Some details have changed since the publication of
-      this article, but it still gives a good introduction to the main
-      concepts.)
-    </p>
-
-    <h2>The STG Language</h2>
-    <p>
-      The AST of the STG-language and the generation of STG code from Core is
-      both located in the <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/"><code>stgSyn/</code></a>
-      directory; in the modules <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/StgSyn.lhs"><code>StgSyn</code></a>
-      and <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/CoreToStg.lhs"><code>CoreToStg</code></a>,
-      respectively.
-    </p>
-    <p>
-      Conceptually, the STG-language is a lambda calculus (including data
-      constructors and case expressions) whose syntax is restricted to make
-      all control flow explicit.  As such, it can be regarded as a variant of
-      <em>administrative normal form (ANF).</em> (C.f., <a
-      href="http://doi.acm.org/10.1145/173262.155113">The essence of compiling
-      with continuations.</a> Cormac Flanagan, Amr Sabry, Bruce F. Duba, and
-      Matthias Felleisen. <em>ACM SIGPLAN Conference on Programming Language
-	Design and Implementation,</em> ACM Press, 1993.)  Each syntactic from
-      has a precise operational interpretation, in addition to the
-      denotational interpretation inherited from the lambda calculus.  The
-      concrete representation of the STG language inside GHC also includes
-      auxiliary attributes, such as <em>static reference tables (SRTs),</em>
-      which determine the top-level bindings referenced by each let binding
-      and case expression.
-    </p>
-    <p>
-      As usual in ANF, arguments to functions etc. are restricted to atoms
-      (i.e., constants or variables), which implies that all sub-expressions
-      are explicitly named and evaluation order is explicit.  Specific to the
-      STG language is that all let bindings correspond to closure allocation
-      (thunks, function closures, and data constructors) and that case
-      expressions encode both computation and case selection.  There are two
-      flavours of case expressions scrutinising boxed and unboxed values,
-      respectively.  The former perform function calls including demanding the
-      evaluation of thunks, whereas the latter execute primitive operations
-      (such as arithmetic on fixed size integers and floating-point numbers).
-    </p>
-    <p>
-      The representation of STG language defined in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/StgSyn.lhs"><code>StgSyn</code></a>
-      abstracts over both binders and occurences of variables.  The type names
-      involved in this generic definition all carry the prefix
-      <code>Gen</code> (such as in <code>GenStgBinding</code>).  Instances of
-      these generic definitions, where both binders and occurences are of type
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/basicTypes/Id.lhs"><code>Id</code></a><code>.Id</code>
-      are defined as type synonyms and use type names that drop the
-      <code>Gen</code> prefix (i.e., becoming plain <code>StgBinding</code>).
-      Complete programs in STG form are represented by values of type
-      <code>[StgBinding]</code>.
-    </p>
-
-    <h2>From Core to STG</h2>
-    <p>
-      Although, the actual translation from Core AST into STG AST is performed
-      by the function <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/CoreToStg.lhs"><code>CoreToStg</code></a><code>.coreToStg</code>
-      (or <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/CoreToStg.lhs"><code>CoreToStg</code></a><code>.coreExprToStg</code>
-      for individual expressions), the translation crucial depends on <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/coreSyn/CorePrep.lhs"><code>CorePrep</code></a><code>.corePrepPgm</code>
-      (resp. <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/coreSyn/CorePrep.lhs"><code>CorePrep</code></a><code>.corePrepExpr</code>),
-      which prepares Core code for code generation (for both byte code and
-      machine code generation).  <code>CorePrep</code> saturates primitive and
-      constructor applications, turns the code into A-normal form, renames all
-      identifiers into globally unique names, generates bindings for
-      constructor workers, constructor wrappers, and record selectors plus
-      some further cleanup.
-    </p>
-    <p>
-      In other words, after Core code is prepared for code generation it is
-      structurally already in the form required by the STG language.  The main
-      work performed by the actual transformation from Core to STG, as
-      performed by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/CoreToStg.lhs"><code>CoreToStg</code></a><code>.coreToStg</code>,
-      is to compute the live and free variables as well as live CAFs (constant
-      applicative forms) at each let binding and case alternative.  In
-      subsequent phases, the live CAF information is used to compute SRTs.
-      The live variable information is used to determine which stack slots
-      need to be zapped (to avoid space leaks) and the free variable
-      information is need to construct closures.  Moreover, hints for
-      optimised code generation are computed, such as whether a closure needs
-      to be updated after is has been evaluated.
-    </p>
-
-    <h2>STG Passes</h2>
-    <p>
-      These days little actual work is performed on programs in STG form; in
-      particular, the code is not further optimised.  All serious optimisation
-      (except low-level optimisations which are performed during native code
-      generation) has already been done on Core.  The main task of <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/stgSyn/CoreToStg.lhs"><code>CoreToStg</code></a><code>.stg2stg</code>
-      is to compute SRTs from the live CAF information determined during STG
-      generation.  Other than that, <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/profiling/SCCfinal.lhs"><code>SCCfinal</code></a><code>.stgMassageForProfiling</code>
-      is executed when compiling for profiling and information may be dumped
-      for debugging purposes.
-    </p>
-
-    <h2>Towards C--</h2>
-    <p>
-      GHC's internal form of C-- is defined in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/cmm/Cmm.hs"><code>Cmm</code></a>.
-      The definition is generic in that it abstracts over the type of static
-      data and of the contents of basic blocks (i.e., over the concrete
-      representation of constant data and instructions).  These generic
-      definitions have names carrying the prefix <code>Gen</code> (such as
-      <code>GenCmm</code>).  The same module also instantiates the generic
-      form to a concrete form where data is represented by
-      <code>CmmStatic</code> and instructions are represented by
-      <code>CmmStmt</code> (giving us, e.g., <code>Cmm</code> from
-      <code>GenCmm</code>).  The concrete form more or less follows the
-      external <a href="http://www.cminusminus.org/">C--</a> language.
-    </p>
-    <p>
-      Programs in STG form are translated to <code>Cmm</code> by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/codeGen/CodeGen.lhs"><code>CodeGen</code></a><code>.codeGen</code>
-    </p>
-
-    <p><hr><small>
-<!-- hhmts start -->
-Last modified: Sat Mar  5 22:55:25 EST 2005
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/syntax.html b/ghc/docs/comm/the-beast/syntax.html
deleted file mode 100644
index be5bbefa17..0000000000
--- a/ghc/docs/comm/the-beast/syntax.html
+++ /dev/null
@@ -1,99 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Just Syntax</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Just Syntax</h1>
-    <p>
-      The lexical and syntactic analyser for Haskell programs are located in
-      <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/parser/"><code>fptools/ghc/compiler/parser/</code></a>.
-    </p>
-
-    <h2>The Lexer</h2>
-    <p>
-      The lexer is a rather tedious piece of Haskell code contained in the
-      module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/parser/Lex.lhs"><code>Lex</code></a>.
-      Its complexity partially stems from covering, in addition to Haskell 98, 
-      also the whole range of GHC language extensions plus its ability to
-      analyse interface files in addition to normal Haskell source.  The lexer
-      defines a parser monad <code>P a</code>, where <code>a</code> is the
-      type of the result expected from a successful parse.  More precisely, a
-      result of type
-<blockquote><pre>
-data ParseResult a = POk PState a
-		   | PFailed Message</pre>
-</blockquote>
-    <p>
-      is produced with <code>Message</code> being from <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/ErrUtils.lhs"><code>ErrUtils</code></a>
-      (and currently is simply a synonym for <code>SDoc</code>).
-    <p>
-      The record type <code>PState</code> contains information such as the
-      current source location, buffer state, contexts for layout processing,
-      and whether Glasgow extensions are accepted (either due to
-      <code>-fglasgow-exts</code> or due to reading an interface file).  Most
-      of the fields of <code>PState</code> store unboxed values; in fact, even
-      the flag indicating whether Glasgow extensions are enabled is
-      represented by an unboxed integer instead of by a <code>Bool</code>.  My
-      (= chak's) guess is that this is to avoid having to perform a
-      <code>case</code> on a boxed value in the inner loop of the lexer.
-    <p>
-      The same lexer is used by the Haskell source parser, the Haskell
-      interface parser, and the package configuration parser.
-    
-    <h2>The Haskell Source Parser</h2>
-    <p>
-      The parser for Haskell source files is defined in the form of a parser
-      specification for the parser generator <a
-      href="http://haskell.org/happy/">Happy</a> in the file <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/parser/Parser.y"><code>Parser.y</code></a>. 
-      The parser exports three entry points for parsing entire modules
-      (<code>parseModule</code>, individual statements
-      (<code>parseStmt</code>), and individual identifiers
-      (<code>parseIdentifier</code>), respectively.  The last two are needed
-      for GHCi.  All three require a parser state (of type
-      <code>PState</code>) and are invoked from <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/HscMain.lhs"><code>HscMain</code></a>.
-    <p>
-      Parsing of Haskell is a rather involved process.  The most challenging
-      features are probably the treatment of layout and expressions that
-      contain infix operators.  The latter may be user-defined and so are not
-      easily captured in a static syntax specification.  Infix operators may
-      also appear in the right hand sides of value definitions, and so, GHC's
-      parser treats those in the same way as expressions.  In other words, as
-      general expressions are a syntactic superset of expressions - ok, they
-      <em>nearly</em> are - the parser simply attempts to parse a general
-      expression in such positions.  Afterwards, the generated parse tree is
-      inspected to ensure that the accepted phrase indeed forms a legal
-      pattern.  This and similar checks are performed by the routines from <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/parser/ParseUtil.lhs"><code>ParseUtil</code></a>. In
-      some cases, these routines do, in addition to checking for
-      wellformedness, also transform the parse tree, such that it fits into
-      the syntactic context in which it has been parsed; in fact, this happens
-      for patterns, which are transformed from a representation of type
-      <code>RdrNameHsExpr</code> into a representation of type
-      <code>RdrNamePat</code>.
-
-    <h2>The Haskell Interface Parser</h2>
-    <p>
-      The parser for interface files is also generated by Happy from <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/rename/ParseIface.y"><code>ParseIface.y</code></a>.
-      It's main routine <code>parseIface</code> is invoked from <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/rename/RnHiFiles.lhs"><code>RnHiFiles</code></a><code>.readIface</code>.
-
-    <h2>The Package Configuration Parser</h2>
-    <p>
-      The parser for configuration files is by far the smallest of the three
-      and defined in <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/ParsePkgConf.y"><code>ParsePkgConf.y</code></a>.
-      It exports <code>loadPackageConfig</code>, which is used by <a href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/main/DriverState.hs"><code>DriverState</code></a><code>.readPackageConf</code>.
-    
-    <p><small>
-<!-- hhmts start -->
-Last modified: Wed Jan 16 00:30:14 EST 2002
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/typecheck.html b/ghc/docs/comm/the-beast/typecheck.html
deleted file mode 100644
index 8d22784b8a..0000000000
--- a/ghc/docs/comm/the-beast/typecheck.html
+++ /dev/null
@@ -1,316 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Checking Types</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Checking Types</h1>
-    <p>
-      Probably the most important phase in the frontend is the type checker,
-      which is located at <a
-	href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/"><code>fptools/ghc/compiler/typecheck/</code>.</a>
-      GHC type checks programs in their original Haskell form before the
-      desugarer converts them into Core code.  This complicates the type
-      checker as it has to handle the much more verbose Haskell AST, but it
-      improves error messages, as those message are based on the same
-      structure that the user sees.
-    </p>
-    <p>
-      GHC defines the abstract syntax of Haskell programs in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/hsSyn/HsSyn.lhs"><code>HsSyn</code></a>
-      using a structure that abstracts over the concrete representation of
-      bound occurences of identifiers and patterns.  The module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcHsSyn.lhs"><code>TcHsSyn</code></a>
-      defines a number of helper function required by the type checker.  Note
-      that the type <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcRnTypes.lhs"><code>TcRnTypes</code></a>.<code>TcId</code>
-      used to represent identifiers in some signatures during type checking
-      is, in fact, nothing but a synonym for a <a href="vars.html">plain
-      <code>Id</code>.</a>  
-    </p>
-    <p>
-      It is also noteworthy, that the representations of types changes during
-      type checking from <code>HsType</code> to <code>TypeRep.Type</code>.
-      The latter is a <a href="types.html">hybrid type representation</a> that
-      is used to type Core, but still contains sufficient information to
-      recover source types.  In particular, the type checker maintains and
-      compares types in their <code>Type</code> form.
-    </p>
-
-    <h2>The Overall Flow of Things</h2>
-
-    <h4>Entry Points Into the Type Checker</h4>
-    <p>
-      The interface of the type checker (and <a
-      href="renamer.html">renamer</a>) to the rest of the compiler is provided
-      by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcRnDriver.lhs"><code>TcRnDriver</code></a>.
-      Entire modules are processed by calling <code>tcRnModule</code> and GHCi
-      uses <code>tcRnStmt</code>, <code>tcRnExpr</code>, and
-      <code>tcRnType</code> to typecheck statements and expressions, and to
-      kind check types, respectively.  Moreover, <code>tcRnExtCore</code> is
-      provided to typecheck external Core code.  Moreover,
-      <code>tcTopSrcDecls</code> is used by Template Haskell - more
-      specifically by <code>TcSplice.tc_bracket</code>
-      - to type check the contents of declaration brackets.
-    </p>
-
-    <h4>Renaming and Type Checking a Module</h4>
-    <p>
-      The function <code>tcRnModule</code> controls the complete static
-      analysis of a Haskell module.  It sets up the combined renamer and type
-      checker monad, resolves all import statements, initiates the actual
-      renaming and type checking process, and finally, wraps off by processing
-      the export list.
-    </p>
-    <p>
-      The actual type checking and renaming process is initiated via
-      <code>TcRnDriver.tcRnSrcDecls</code>, which uses a helper called
-      <code>tc_rn_src_decls</code> to implement the iterative renaming and
-      type checking process required by <a href="../exts/th.html">Template
-      Haskell</a>.  However, before it invokes <code>tc_rn_src_decls</code>,
-      it takes care of hi-boot files; afterwards, it simplifies type
-      constraints and zonking (see below regarding the later).
-    </p>
-    <p>
-      The function <code>tc_rn_src_decls</code> partitions static analysis of
-      a whole module into multiple rounds, where the initial round is followed
-      by an additional one for each toplevel splice.  It collects all
-      declarations up to the next splice into an <code>HsDecl.HsGroup</code>
-      to rename and type check that <em>declaration group</em> by calling
-      <code>TcRnDriver.tcRnGroup</code>.  Afterwards, it executes the
-      splice (if there are any left) and proceeds to the next group, which
-      includes the declarations produced by the splice.
-    </p>
-    <p>
-      The function <code>tcRnGroup</code>, finally, gets down to invoke the
-      actual renaming and type checking via
-      <code>TcRnDriver.rnTopSrcDecls</code> and
-      <code>TcRnDriver.tcTopSrcDecls</code>, respectively.  The renamer, apart
-      from renaming, computes the global type checking environment, of type
-      <code>TcRnTypes.TcGblEnv</code>, which is stored in the type checking
-      monad before type checking commences.
-    </p>
-
-    <h2>Type Checking a Declaration Group</h2>
-    <p>
-      The type checking of a declaration group, performed by
-      <code>tcTopSrcDecls</code> starts by processing of the type and class
-      declarations of the current module, using the function
-      <code>TcTyClsDecls.tcTyAndClassDecls</code>.  This is followed by a
-      first round over instance declarations using
-      <code>TcInstDcls.tcInstDecls1</code>, which in particular generates all
-      additional bindings due to the deriving process.  Then come foreign
-      import declarations (<code>TcForeign.tcForeignImports</code>) and
-      default declarations (<code>TcDefaults.tcDefaults</code>).
-    </p>
-    <p>
-      Now, finally, toplevel value declarations (including derived ones) are
-      type checked using <code>TcBinds.tcTopBinds</code>.  Afterwards,
-      <code>TcInstDcls.tcInstDecls2</code> traverses instances for the second
-      time.  Type checking concludes with processing foreign exports
-      (<code>TcForeign.tcForeignExports</code>) and rewrite rules
-      (<code>TcRules.tcRules</code>).  Finally, the global environment is
-      extended with the new bindings.
-    </p>
-
-    <h2>Type checking Type and Class Declarations</h2>
-    <p>
-      Type and class declarations are type checked in a couple of phases that
-      contain recursive dependencies - aka <em>knots.</em> The first knot
-      encompasses almost the whole type checking of these declarations and
-      forms the main piece of <code>TcTyClsDecls.tcTyAndClassDecls</code>.
-    </p>
-    <p>
-      Inside this big knot, the first main operation is kind checking, which
-      again involves a knot.  It is implemented by <code>kcTyClDecls</code>,
-      which performs kind checking of potentially recursively-dependent type
-      and class declarations using kind variables for initially unknown kinds.
-      During processing the individual declarations some of these variables
-      will be instantiated depending on the context; the rest gets by default
-      kind <code>*</code> (during <em>zonking</em> of the kind signatures).
-      Type synonyms are treated specially in this process, because they can
-      have an unboxed type, but they cannot be recursive.  Hence, their kinds
-      are inferred in dependency order.  Moreover, in contrast to class
-      declarations and other type declarations, synonyms are not entered into
-      the global environment as a global <code>TyThing</code>.
-      (<code>TypeRep.TyThing</code> is a sum type that combines the various
-      flavours of typish entities, such that they can be stuck into type
-      environments and similar.)
-    </p>
-
-    <h2>More Details</h2>
-
-    <h4>Types Variables and Zonking</h4>
-    <p>
-      During type checking type variables are represented by mutable variables
-      - cf. the <a href="vars.html#TyVar">variable story.</a>  Consequently,
-      unification can instantiate type variables by updating those mutable
-      variables.  This process of instantiation is (for reasons that elude me)
-      called <a
-      href="http://www.dictionary.com/cgi-bin/dict.pl?term=zonk&db=*">zonking</a>
-      in GHC's sources.  The zonking routines for the various forms of Haskell
-      constructs are responsible for most of the code in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcHsSyn.lhs"><code>TcHsSyn</code>,</a>
-      whereas the routines that actually operate on mutable types are defined
-      in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcMType.lhs"><code>TcMType</code></a>;
-      this includes the zonking of type variables and type terms, routines to
-      create mutable structures and update them as well as routines that check
-      constraints, such as that type variables in function signatures have not
-      been instantiated during type checking.  The actual type unification
-      routine is <code>uTys</code> in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcUnify.lhs"><code>TcUnify</code></a>.
-    </p>
-    <p>
-      All type variables that may be instantiated (those in signatures
-      may not), but haven't been instantiated during type checking, are zonked
-      to <code>()</code>, so that after type checking all mutable variables
-      have been eliminated.
-    </p>
-
-    <h4>Type Representation</h4>
-    <p>
-      The representation of types is fixed in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcRep.lhs"><code>TcRep</code></a>
-      and exported as the data type <code>Type</code>.  As explained in <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcType.lhs"><code>TcType</code></a>,
-      GHC supports rank-N types, but, in the type checker, maintains the
-      restriction that type variables cannot be instantiated to quantified
-      types (i.e., the type system is predicative).  The type checker floats
-      universal quantifiers outside and maintains types in prenex form.
-      (However, quantifiers can, of course, not float out of negative
-      positions.)  Overall, we have
-    </p>
-    <blockquote>
-      <pre>
-sigma -> forall tyvars. phi
-phi   -> theta => rho
-rho   -> sigma -> rho
-       | tau
-tau   -> tyvar
-       | tycon tau_1 .. tau_n
-       | tau_1 tau_2
-       | tau_1 -> tau_2</pre>
-    </blockquote>
-    <p>
-      where <code>sigma</code> is in prenex form; i.e., there is never a
-      forall to the right of an arrow in a <code>phi</code> type.  Moreover, a
-      type of the form <code>tau</code> never contains a quantifier (which
-      includes arguments to type constructors).
-    </p>
-    <p>
-      Of particular interest are the variants <code>SourceTy</code> and
-      <code>NoteTy</code> of <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TypeRep.lhs"><code>TypeRep</code></a>.<code>Type</code>.
-      The constructor <code>SourceTy :: SourceType -> Type</code> represents a
-      type constraint; that is, a predicate over types represented by a
-      dictionary.  The type checker treats a <code>SourceTy</code> as opaque,
-      but during the translation to core it will be expanded into its concrete
-      representation (i.e., a dictionary type) by the function <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/types/Type.lhs"><code>Type</code></a>.<code>sourceTypeRep</code>.  
-      Note that newtypes are not covered by <code>SourceType</code>s anymore,
-      even if some comments in GHC still suggest this.  Instead, all newtype
-      applications are initially represented as a <code>NewTcApp</code>, until
-      they are eliminated by calls to <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/types/Type.lhs"><code>Type</code></a>.<code>newTypeRep</code>.
-    </p>
-    <p>
-      The <code>NoteTy</code> constructor is used to add non-essential
-      information to a type term.  Such information has the type
-      <code>TypeRep.TyNote</code> and is either the set of free type variables
-      of the annotated expression or the unexpanded version of a type synonym.
-      Free variables sets are cached as notes to save the overhead of
-      repeatedly computing the same set for a given term.  Unexpanded type
-      synonyms are useful for generating comprehensible error messages, but
-      have no influence on the process of type checking.
-    </p>
-
-    <h4>Type Checking Environment</h4>
-    <p>
-      During type checking, GHC maintains a <em>type environment</em> whose
-      type definitions are fixed in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcRnTypes.lhs"><code>TcRnTypes</code></a> with the operations defined in
-<a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcEnv.lhs"><code>TcEnv</code></a>.
-      Among other things, the environment contains all imported and local
-      instances as well as a list of <em>global</em> entities (imported and
-      local types and classes together with imported identifiers) and
-      <em>local</em> entities (locally defined identifiers).  This environment
-      is threaded through the type checking monad, whose support functions
-      including initialisation can be found in the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcRnMonad.lhs"><code>TcRnMonad</code>.</a>
-
-    <h4>Expressions</h4>
-    <p>
-      Expressions are type checked by <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/TcExpr.lhs"><code>TcExpr</code>.</a>  
-    <p>
-      Usage occurences of identifiers are processed by the function
-      <code>tcId</code> whose main purpose is to <a href="#inst">instantiate
-      overloaded identifiers.</a> It essentially calls
-      <code>TcInst.instOverloadedFun</code> once for each universally
-      quantified set of type constraints.  It should be noted that overloaded
-      identifiers are replaced by new names that are first defined in the LIE
-      (Local Instance Environment?) and later promoted into top-level
-      bindings.
-      
-    <h4><a name="inst">Handling of Dictionaries and Method Instances</a></h4>
-    <p>
-      GHC implements overloading using so-called <em>dictionaries.</em> A
-      dictionary is a tuple of functions -- one function for each method in
-      the class of which the dictionary implements an instance.  During type
-      checking, GHC replaces each type constraint of a function with one
-      additional argument.  At runtime, the extended function gets passed a
-      matching class dictionary by way of these additional arguments.
-      Whenever the function needs to call a method of such a class, it simply
-      extracts it from the dictionary.
-    <p>
-      This sounds simple enough; however, the actual implementation is a bit
-      more tricky as it wants to keep track of all the instances at which
-      overloaded functions are used in a module.  This information is useful
-      to optimise the code.  The implementation is the module <a
-      href="http://cvs.haskell.org/cgi-bin/cvsweb.cgi/fptools/ghc/compiler/typecheck/Inst.lhs"><code>Inst.lhs</code>.</a>
-    <p>
-      The function <code>instOverloadedFun</code> is invoked for each
-      overloaded usage occurence of an identifier, where overloaded means that
-      the type of the idendifier contains a non-trivial type constraint.  It
-      proceeds in two steps: (1) Allocation of a method instance
-      (<code>newMethodWithGivenTy</code>) and (2) instantiation of functional
-      dependencies.  The former implies allocating a new unique identifier,
-      which replaces the original (overloaded) identifier at the currently
-      type-checked usage occurrence.
-    <p>
-      The new identifier (after being threaded through the LIE) eventually
-      will be bound by a top-level binding whose rhs contains a partial
-      application of the original overloaded identifier.  This papp applies
-      the overloaded function to the dictionaries needed for the current
-      instance.  In GHC lingo, this is called a <em>method.</em>  Before
-      becoming a top-level binding, the method is first represented as a value
-      of type <code>Inst.Inst</code>, which makes it easy to fold multiple
-      instances of the same identifier at the same types into one global
-      definition.  (And probably other things, too, which I haven't
-      investigated yet.)
-
-    <p>
-      <strong>Note:</strong> As of 13 January 2001 (wrt. to the code in the
-      CVS HEAD), the above mechanism interferes badly with RULES pragmas
-      defined over overloaded functions.  During instantiation, a new name is
-      created for an overloaded function partially applied to the dictionaries
-      needed in a usage position of that function.  As the rewrite rule,
-      however, mentions the original overloaded name, it won't fire anymore
-      -- unless later phases remove the intermediate definition again.  The
-      latest CVS version of GHC has an option
-      <code>-fno-method-sharing</code>, which avoids sharing instantiation
-      stubs.  This is usually/often/sometimes sufficient to make the rules
-      fire again.
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Thu May 12 22:52:46 EST 2005
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/types.html b/ghc/docs/comm/the-beast/types.html
deleted file mode 100644
index 383b71f054..0000000000
--- a/ghc/docs/comm/the-beast/types.html
+++ /dev/null
@@ -1,179 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - Hybrid Types</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - Hybrid Types</h1>
-    <p>
-      GHC essentially supports two type systems: (1) the <em>source type
-	system</em> (which is a heavily extended version of the type system of
-      Haskell 98) and (2) the <em>Core type system,</em> which is the type system
-      used by the intermediate language (see also <a
-      href="desugar.html">Sugar Free: From Haskell To Core</a>).
-    </p>
-    <p>
-      During parsing and renaming, type information is represented in a form
-      that is very close to Haskell's concrete syntax; it is defined by
-      <code>HsTypes.HsType</code>.  In addition, type, class, and instance
-      declarations are maintained in their source form as defined in the
-      module <code>HsDecl</code>.  The situation changes during type checking,
-      where types are translated into a second representation, which is
-      defined in the module <code>types/TypeRep.lhs</code>, as type
-      <code>Type</code>.  This second representation is peculiar in that it is
-      a hybrid between the source representation of types and the Core
-      representation of types.  Using functions, such as
-      <code>Type.coreView</code> and <code>Type.deepCoreView</code>, a value
-      of type <code>Type</code> exhibits its Core representation.  On the
-      other hand, pretty printing a <code>Type</code> with
-      <code>TypeRep.pprType</code> yields the type's source representation.
-    </p>
-    <p>
-      In fact, the <a href="typecheck.html">type checker</a> maintains type
-      environments based on <code>Type</code>, but needs to perform type
-      checking on source-level types.  As a result, we have functions
-      <code>Type.tcEqType</code> and <code>Type.tcCmpType</code>, which
-      compare types based on their source representation, as well as the
-      function <code>coreEqType</code>, which compares them based on their
-      core representation.  The latter is needed during type checking of Core
-      (as performed by the functions in the module
-      <code>coreSyn/CoreLint.lhs</code>). 
-    </p>
-
-    <h2>Type Synonyms</h2>
-    <p>
-      Type synonyms in Haskell are essentially a form of macro definitions on
-      the type level.  For example, when the type checker compares two type
-      terms, synonyms are always compared in their expanded form.  However, to
-      produce good error messages, we like to avoid expanding type synonyms
-      during pretty printing.  Hence, <code>Type</code> has a variant
-      <code>NoteTy TyNote Type</code>, where
-    </p>
-    <blockquote>
-      <pre>
-data TyNote
-  = FTVNote TyVarSet	-- The free type variables of the noted expression
-
-  | SynNote Type	-- Used for type synonyms
-			-- The Type is always a TyConApp, and is the un-expanded form.
-			-- The type to which the note is attached is the expanded form.</pre>
-    </blockquote>
-    <p>
-      In other words, a <code>NoteTy</code> represents the expanded form of a
-      type synonym together with a note stating its source form.
-    </p>
-
-    <h3>Creating Representation Types of Synonyms</h3>
-    <p>
-      During translation from <code>HsType</code> to <code>Type</code> the
-      function <code>Type.mkSynTy</code> is used to construct representations
-      of applications of type synonyms.  It creates a <code>NoteTy</code> node
-      if the synonym is applied to a sufficient number of arguments;
-      otherwise, it builds a simple <code>TyConApp</code> and leaves it to
-      <code>TcMType.checkValidType</code> to pick up invalid unsaturated
-      synonym applications.  While creating a <code>NoteTy</code>,
-      <code>mkSynTy</code> also expands the synonym by substituting the type
-      arguments for the parameters of the synonym definition, using
-      <code>Type.substTyWith</code>.
-    </p>
-    <p>
-      The function <code>mkSynTy</code> is used indirectly via
-      <code>mkGenTyConApp</code>, <code>mkAppTy</code>, and
-      <code>mkAppTy</code>, which construct type representations involving
-      type applications.  The function <code>mkSynTy</code> is also used
-      directly during type checking interface files; this is for tedious
-      reasons to do with forall hoisting - see the comment at
-      <code>TcIface.mkIfTcApp</code>. 
-    </p>
-
-    <h2>Newtypes</h2>
-    <p>
-      Data types declared by a <code>newtype</code> declarations constitute new
-      type constructors---i.e., they are not just type macros, but introduce
-      new type names.  However, provided that a newtype is not recursive, we
-      still want to implement it by its representation type.  GHC realises this
-      by providing two flavours of type equality: (1) <code>tcEqType</code> is
-      source-level type equality, which compares newtypes and
-      <code>PredType</code>s by name, and (2) <code>coreEqType</code> compares
-      them structurally (by using <code>deepCoreView</code> to expand the
-      representation before comparing).  The function
-      <code>deepCoreView</code> (via <code>coreView</code>) invokes
-      <code>expandNewTcApp</code> for every type constructor application
-      (<code>TyConApp</code>) to determine whether we are looking at a newtype
-      application that needs to be expanded to its representation type.
-    </p>
-
-    <h2>Predicates</h2>
-    <p>
-      The dictionary translation of type classes, translates each predicate in
-      a type context of a type signature into an additional argument, which
-      carries a dictionary with the functions overloaded by the corresponding
-      class.  The <code>Type</code> data type has a special variant
-      <code>PredTy PredType</code> for predicates, where
-    </p>
-    <blockquote>
-      <pre>
-data PredType 
-  = ClassP Class [Type]		-- Class predicate
-  | IParam (IPName Name) Type	-- Implicit parameter</pre>
-    </blockquote>
-    <p>
-      These types need to be handled as source type during type checking, but
-      turn into their representations when inspected through
-      <code>coreView</code>.  The representation is determined by
-      <code>Type.predTypeRep</code>.
-    </p>
-
-    <h2>Representation of Type Constructors</h2>
-    <p>
-      Type constructor applications are represented in <code>Type</code> by
-      the variant <code>TyConApp :: TyCon -> [Type] -> Type</code>.  The first
-      argument to <code>TyConApp</code>, namely <code>TyCon.TyCon</code>,
-      distinguishes between function type constructors (variant
-      <code>FunTyCon</code>) and algebraic type constructors (variant
-      <code>AlgTyCon</code>), which arise from data and newtype declarations.
-      The variant <code>AlgTyCon</code> contains all the information available
-      from the data/newtype declaration as well as derived information, such
-      as the <code>Unique</code> and argument variance information.  This
-      includes a field <code>algTcRhs :: AlgTyConRhs</code>, where
-      <code>AlgTyConRhs</code> distinguishes three kinds of algebraic data
-      type declarations: (1) declarations that have been exported abstractly,
-      (2) <code>data</code> declarations, and (3) <code>newtype</code>
-      declarations.  The last two both include their original right hand side;
-      in addition, the third variant also caches the "ultimate" representation
-      type, which is the right hand side after expanding all type synonyms and
-      non-recursive newtypes.
-    </p>
-    <p>
-      Both data and newtype declarations refer to their data constructors
-      represented as <code>DataCon.DataCon</code>, which include all details
-      of their signature (as derived from the original declaration) as well
-      information for code generation, such as their tag value.
-    </p>
-
-    <h2>Representation of Classes and Instances</h2>
-    <p>
-      Class declarations turn into values of type <code>Class.Class</code>.
-      They represent methods as the <code>Id</code>s of the dictionary
-      selector functions.  Similar selector functions are available for
-      superclass dictionaries.
-    </p>
-    <p>
-      Instance declarations turn into values of type
-      <code>InstEnv.Instance</code>, which in interface files are represented
-      as <code>IfaceSyn.IfaceInst</code>.  Moreover, the type
-      <code>InstEnv.InstEnv</code>, which is a synonym for <code>UniqFM
-      ClsInstEnv</code>, provides a mapping of classes to their
-      instances---<code>ClsInstEnv</code> is essentially a list of instance
-      declarations.
-    </p>
-
-    <p><small>
-<!-- hhmts start -->
-Last modified: Sun Jun 19 13:07:22 EST 2005
-<!-- hhmts end -->
-    </small></p>
-  </body>
-</html>
diff --git a/ghc/docs/comm/the-beast/vars.html b/ghc/docs/comm/the-beast/vars.html
deleted file mode 100644
index 9bbd310c60..0000000000
--- a/ghc/docs/comm/the-beast/vars.html
+++ /dev/null
@@ -1,235 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
-<html>
-  <head>
-    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=ISO-8859-1">
-    <title>The GHC Commentary - The Real Story about Variables, Ids, TyVars, and the like</title>
-  </head>
-
-  <body BGCOLOR="FFFFFF">
-    <h1>The GHC Commentary - The Real Story about Variables, Ids, TyVars, and the like</h1>
-    <p>
-
-
-<h2>Variables</h2>
-
-The <code>Var</code> type, defined in <code>basicTypes/Var.lhs</code>,
-represents variables, both term variables and type variables:
-<pre>
-    data Var
-      = Var {
-	    varName    :: Name,
-	    realUnique :: FastInt,
-	    varType    :: Type,
-	    varDetails :: VarDetails,
-	    varInfo    :: IdInfo		
-	}
-</pre>
-<ul>
-<li> The <code>varName</code> field contains the identity of the variable:
-its unique number, and its print-name.  See "<a href="names.html">The truth about names</a>".
-
-<p><li> The <code>realUnique</code> field caches the unique number in the
-<code>varName</code> field, just to make comparison of <code>Var</code>s a little faster.
-
-<p><li> The <code>varType</code> field gives the type of a term variable, or the kind of a
-type variable.  (Types and kinds are both represented by a <code>Type</code>.)
-
-<p><li> The <code>varDetails</code> field distinguishes term variables from type variables,
-and makes some further distinctions (see below).
-
-<p><li> For term variables (only) the <code>varInfo</code> field contains lots of useful
-information: strictness, unfolding, etc.  However, this information is all optional;
-you can always throw away the <code>IdInfo</code>.  In contrast, you can't safely throw away
-the <code>VarDetails</code> of a <code>Var</code>
-</ul>
-<p>
-It's often fantastically convenient to have term variables and type variables
-share a single data type.  For example, 
-<pre>
-  exprFreeVars :: CoreExpr -> VarSet
-</pre>
-If there were two types, we'd need to return two sets.  Simiarly, big lambdas and
-little lambdas use the same constructor in Core, which is extremely convenient.
-<p>
-We define a couple of type synonyms:
-<pre>
-  type Id    = Var  -- Term variables
-  type TyVar = Var  -- Type variables
-</pre>
-just to help us document the occasions when we are expecting only term variables,
-or only type variables.
-
-
-<h2> The <code>VarDetails</code> field </h2>
-
-The <code>VarDetails</code> field tells what kind of variable this is:
-<pre>
-data VarDetails
-  = LocalId 		-- Used for locally-defined Ids (see NOTE below)
-	LocalIdDetails
-
-  | GlobalId 		-- Used for imported Ids, dict selectors etc
-	GlobalIdDetails
-
-  | TyVar
-  | MutTyVar (IORef (Maybe Type)) 	-- Used during unification;
-	     TyVarDetails
-</pre>
-
-<a name="TyVar">
-<h2>Type variables (<code>TyVar</code>)</h2>
-</a>
-<p>
-The <code>TyVar</code> case is self-explanatory.  The <code>MutTyVar</code>
-case is used only during type checking.  Then a type variable can be unified,
-using an imperative update, with a type, and that is what the
-<code>IORef</code> is for.  The <code>TcType.TyVarDetails</code> field records
-the sort of type variable we are dealing with.  It is defined as
-<pre>
-data TyVarDetails = SigTv | ClsTv | InstTv | VanillaTv
-</pre>
-<code>SigTv</code> marks type variables that were introduced when
-instantiating a type signature prior to matching it against the inferred type
-of a definition.  The variants <code>ClsTv</code> and <code>InstTv</code> mark
-scoped type variables introduced by class and instance heads, respectively.
-These first three sorts of type variables are skolem variables (tested by the
-predicate <code>isSkolemTyVar</code>); i.e., they must <em>not</em> be
-instantiated. All other type variables are marked as <code>VanillaTv</code>.
-<p>
-For a long time I tried to keep mutable Vars statically type-distinct
-from immutable Vars, but I've finally given up.   It's just too painful.
-After type checking there are no MutTyVars left, but there's no static check
-of that fact.
-
-<h2>Term variables (<code>Id</code>)</h2>
-
-A term variable (of type <code>Id</code>) is represented either by a
-<code>LocalId</code> or a <code>GlobalId</code>:
-<p>
-A <code>GlobalId</code> is
-<ul>
-<li> Always bound at top-level.
-<li> Always has a <code>GlobalName</code>, and hence has 
-     a <code>Unique</code> that is globally unique across the whole
-     GHC invocation (a single invocation may compile multiple modules).
-<li> Has <code>IdInfo</code> that is absolutely fixed, forever.
-</ul>
-
-<p>
-A <code>LocalId</code> is:
-<ul> 
-<li> Always bound in the module being compiled:
-<ul>
-<li> <em>either</em> bound within an expression (lambda, case, local let(rec))
-<li> <em>or</em> defined at top level in the module being compiled.
-</ul>
-<li> Has IdInfo that changes as the simpifier bashes repeatedly on it.
-</ul>
-<p>
-The key thing about <code>LocalId</code>s is that the free-variable finder
-typically treats them as candidate free variables. That is, it ignores
-<code>GlobalId</code>s such as imported constants, data contructors, etc.
-<p>
-An important invariant is this: <em>All the bindings in the module
-being compiled (whether top level or not) are <code>LocalId</code>s
-until the CoreTidy phase.</em> In the CoreTidy phase, all
-externally-visible top-level bindings are made into GlobalIds.  This
-is the point when a <code>LocalId</code> becomes "frozen" and becomes
-a fixed, immutable <code>GlobalId</code>.
-<p>
-(A binding is <em>"externally-visible"</em> if it is exported, or
-mentioned in the unfolding of an externally-visible Id.  An
-externally-visible Id may not have an unfolding, either because it is
-too big, or because it is the loop-breaker of a recursive group.)
-
-<h3>Global Ids and implicit Ids</h3>
-
-<code>GlobalId</code>s are further categorised by their <code>GlobalIdDetails</code>.
-This type is defined in <code>basicTypes/IdInfo</code>, because it mentions other
-structured types like <code>DataCon</code>.  Unfortunately it is *used* in <code>Var.lhs</code>
-so there's a <code>hi-boot</code> knot to get it there.  Anyway, here's the declaration:
-<pre>
-data GlobalIdDetails
-  = NotGlobalId			-- Used as a convenient extra return value 
-                                -- from globalIdDetails
-
-  | VanillaGlobal		-- Imported from elsewhere
-
-  | PrimOpId PrimOp		-- The Id for a primitive operator
-  | FCallId ForeignCall		-- The Id for a foreign call
-
-  -- These next ones are all "implicit Ids"
-  | RecordSelId FieldLabel	-- The Id for a record selector
-  | DataConId DataCon		-- The Id for a data constructor *worker*
-  | DataConWrapId DataCon	-- The Id for a data constructor *wrapper*
-				-- [the only reasons we need to know is so that
-				--  a) we can  suppress printing a definition in the interface file
-				--  b) when typechecking a pattern we can get from the
-				--     Id back to the data con]
-</pre>
-The <code>GlobalIdDetails</code> allows us to go from the <code>Id</code> for 
-a record selector, say, to its field name; or the <code>Id</code> for a primitive
-operator to the <code>PrimOp</code> itself.
-<p>
-Certain <code>GlobalId</code>s are called <em>"implicit"</em> Ids.  An implicit
-Id is derived by implication from some other declaration.  So a record selector is
-derived from its data type declaration, for example.  An implicit Ids is always 
-a <code>GlobalId</code>.  For most of the compilation, the implicit Ids are just
-that: implicit.  If you do -ddump-simpl you won't see their definition.  (That's
-why it's true to say that until CoreTidy all Ids in this compilation unit are
-LocalIds.)  But at CorePrep, a binding is added for each implicit Id defined in
-this module, so that the code generator will generate code for the (curried) function.
-<p>
-Implicit Ids carry their unfolding inside them, of course, so they may well have
-been inlined much earlier; but we generate the curried top-level defn just in
-case its ever needed.
-
-<h3>LocalIds</h3>
-
-The <code>LocalIdDetails</code> gives more info about a <code>LocalId</code>:
-<pre>
-data LocalIdDetails 
-  = NotExported	-- Not exported
-  | Exported	-- Exported
-  | SpecPragma	-- Not exported, but not to be discarded either
-		-- It's unclean that this is so deeply built in
-</pre>
-From this we can tell whether the <code>LocalId</code> is exported, and that
-tells us whether we can drop an unused binding as dead code. 
-<p>
-The <code>SpecPragma</code> thing is a HACK.  Suppose you write a SPECIALIZE pragma:
-<pre>
-   foo :: Num a => a -> a
-   {-# SPECIALIZE foo :: Int -> Int #-}
-   foo = ...
-</pre>
-The type checker generates a dummy call to <code>foo</code> at the right types:
-<pre>
-   $dummy = foo Int dNumInt
-</pre>
-The Id <code>$dummy</code> is marked <code>SpecPragma</code>.  Its role is to hang
-onto that call to <code>foo</code> so that the specialiser can see it, but there
-are no calls to <code>$dummy</code>.
-The simplifier is careful not to discard <code>SpecPragma</code> Ids, so that it
-reaches the specialiser.  The specialiser processes the right hand side of a <code>SpecPragma</code> Id
-to find calls to overloaded functions, <em>and then discards the <code>SpecPragma</code> Id</em>.
-So <code>SpecPragma</code> behaves a like <code>Exported</code>, at least until the specialiser.
-
-
-<h3> ExternalNames and InternalNames </h3>
-
-Notice that whether an Id is a <code>LocalId</code> or <code>GlobalId</code> is 
-not the same as whether the Id has an <code>ExternaName</code> or an <code>InternalName</code>
-(see "<a href="names.html#sort">The truth about Names</a>"):
-<ul>
-<li> Every <code>GlobalId</code> has an <code>ExternalName</code>.
-<li> A <code>LocalId</code> might have either kind of <code>Name</code>.
-</ul>
-
-<!-- hhmts start -->
-Last modified: Fri Sep 12 15:17:18 BST 2003
-<!-- hhmts end -->
-    </small>
-  </body>
-</html>
-
diff --git a/ghc/docs/ext-core/Makefile b/ghc/docs/ext-core/Makefile
deleted file mode 100644
index 8c32a7bb25..0000000000
--- a/ghc/docs/ext-core/Makefile
+++ /dev/null
@@ -1,42 +0,0 @@
-#	General makefile for Latex stuff
-
-dvi: core.dvi
-ps: core.ps
-
-core.dvi:	core.tex prims.tex
-		latex core.tex
-		latex core.tex
-
-../../compiler/prelude/primops.txt: ../../compiler/prelude/primops.txt.pp
-		(cd ../../compiler/prelude; gcc -E -I../../includes -traditional -x c primops.txt.pp | /bin/sed -e '/^#/d' > primops.txt)
-
-prims.tex:	../../compiler/prelude/primops.txt
-		../../utils/genprimopcode/genprimopcode --make-latex-doc < ../../compiler/prelude/primops.txt > prims.tex
-
-
-######## General rules
-.SUFFIXES:
-.PRECIOUS: %.tex %.ps %.bbl
-
-
-%.ps: %.dvi
-	dvips -f < $< > $@
-
-clean:
-	$(RM) *.aux *.log
-
-distclean: clean
-	$(RM) prims.tex *.dvi *.ps *.bbl *.blg *.gz
-
-maintainer-clean: distclean
-
-# dummy targets
-all:
-boot:
-install:
-install-docs:
-html:
-chm:
-HxS:
-
-# End of file
diff --git a/ghc/docs/ext-core/a4wide.sty b/ghc/docs/ext-core/a4wide.sty
deleted file mode 100644
index 9f651505d7..0000000000
--- a/ghc/docs/ext-core/a4wide.sty
+++ /dev/null
@@ -1,39 +0,0 @@
-%NAME: a4wide.sty
-% "moretext" document style option.
-% Jean-Francois Lamy, July 86
-%
-% Redefines the margins so that they are more in line with 
-% what we are used to see.
-%
-% [Minimally modified for LaTeX2e, Alexander Holt, August 1994]
-
-\NeedsTeXFormat{LaTeX2e}
-\ProvidesPackage{a4wide}[1994/08/30]
-\RequirePackage{a4}
-
-\ifcase \@ptsize
-    % mods for 10 pt
-    \oddsidemargin  0.15 in     %   Left margin on odd-numbered pages.
-    \evensidemargin 0.35 in     %   Left margin on even-numbered pages.
-    \marginparwidth 1 in        %   Width of marginal notes.
-    \oddsidemargin 0.25 in      %   Note that \oddsidemargin = \evensidemargin
-    \evensidemargin 0.25 in
-    \marginparwidth 0.75 in
-    \textwidth 5.875 in % Width of text line.
-\or % mods for 11 pt
-    \oddsidemargin 0.1 in      %   Left margin on odd-numbered pages.
-    \evensidemargin 0.15 in    %   Left margin on even-numbered pages.
-    \marginparwidth 1 in       %   Width of marginal notes.
-    \oddsidemargin 0.125 in    %   Note that \oddsidemargin = \evensidemargin
-    \evensidemargin 0.125 in
-    \marginparwidth 0.75 in
-    \textwidth 6.125 in % Width of text line.
-\or % mods for 12 pt
-    \oddsidemargin -10 pt      %   Left margin on odd-numbered pages.
-    \evensidemargin 10 pt      %   Left margin on even-numbered pages.
-    \marginparwidth 1 in       %   Width of marginal notes.
-    \oddsidemargin 0 in      %   Note that \oddsidemargin = \evensidemargin
-    \evensidemargin 0 in
-    \marginparwidth 0.75 in
-    \textwidth 6.375 true in % Width of text line.
-\fi
diff --git a/ghc/docs/ext-core/code.sty b/ghc/docs/ext-core/code.sty
deleted file mode 100644
index 3b62685057..0000000000
--- a/ghc/docs/ext-core/code.sty
+++ /dev/null
@@ -1,83 +0,0 @@
-
-% I have enclosed code.sty, which achieves 99% of what you want without
-% the need for a separate preprocessor. At the start of your document
-% you write "\makeatactive". From then on, inline code is written as @\x
-% -> x_1 & y@. The only difference with what you are used to, is that
-% instead of
-% 
-% @
-%   foo :: Int -> Int
-%   foo = \n -> n+1
-% @
-% 
-% you have to write
-% 
-% \begin{code}
-%   foo :: Int -> Int
-%   foo = \n -> n+1
-% \end{code}
-% 
-% and that you cannot use @ in \section{} and \caption{}. For the paper that occured twice, in which case I had to replace @...@ b y \texttt{...}.
-% 
-% 
-% code.sty  --- nice verbatim mode for code
-
-\def\icode{%
-    \relax\ifmmode\hbox\else\leavevmode\null\fi
-    \bgroup
-    %\begingroup
-    \@noligs
-    \verbatim@font
-    \verb@eol@error
-    \let\do\@makeother \dospecials
-    \@vobeyspaces
-    \frenchspacing
-    \@icode}
-\def\@icode#1{%
-    \catcode`#1\active
-    \lccode`\~`#1%
-    \lowercase{\let~\icode@egroup}}
-\def\icode@egroup{%
-    %\endgroup}
-    \egroup}
-
-% The \makeatactive command:
-% makes @ active, in such a way that @...@ behaves as \icode@...@:
-{
-\catcode`@=\active
-\gdef\makeatactive{
-     \catcode`@=\active \def@{\icode@}
-     % Since @ becomes active, it has to be taken care of in verbatim-modes:
-     \let\olddospecials\dospecials \def\dospecials{\do\@\olddospecials}}
-}
-% \gdef\makeatother{\g@remfrom@specials{\@}\@makeother\@}
-\gdef\makeatother{\@makeother\@}
-
-\newcommand\codetabwidth{42pt}
-{\catcode`\^^I=\active%
-\gdef\@vobeytab{\catcode`\^^I\active\let^^I\@xobeytab}}
-\def\@xobeytab{\leavevmode\penalty10000\hskip\codetabwidth}
-
-\begingroup \catcode `|=0 \catcode `[= 1
-\catcode`]=2 \catcode `\{=12 \catcode `\}=12
-\catcode`\\=12 |gdef|@xcode#1\end{code}[#1|end[code]]
-|endgroup
-\def\@code{\trivlist \item\relax
-  \if@minipage\else\vskip\parskip\fi
-  \leftskip\@totalleftmargin\rightskip\z@skip
-  \parindent\z@\parfillskip\@flushglue\parskip\z@skip
-  \@@par
-  \@tempswafalse
-  \def\par{%
-    \if@tempswa
-      \leavevmode \null \@@par\penalty\interlinepenalty
-    \else
-      \@tempswatrue
-      \ifhmode\@@par\penalty\interlinepenalty\fi
-    \fi}%
-  \obeylines \verbatim@font \@noligs
-  \let\do\@makeother \dospecials
-  \everypar \expandafter{\the\everypar \unpenalty}%
-}
-\def\code{\@code \frenchspacing\@vobeytab\@vobeyspaces \@xcode}
-\def\endcode{\if@newlist \leavevmode\fi\endtrivlist}
diff --git a/ghc/docs/ext-core/core.tex b/ghc/docs/ext-core/core.tex
deleted file mode 100644
index 266d857c46..0000000000
--- a/ghc/docs/ext-core/core.tex
+++ /dev/null
@@ -1,926 +0,0 @@
-\documentclass[10pt]{article}
-\usepackage{a4wide}
-\usepackage{code}
-
-
-\sloppy
-\setlength{\parskip}{0.5\baselineskip plus 0.2\baselineskip minus 0.1\baselineskip}
-\setlength{\parsep}{\parskip}
-\setlength{\topsep}{0cm}
-\setlength{\parindent}{0cm}
-%\oddsidemargin -0.5 in
-%\evensidemargin -0.5 in
-%\textwidth 7.375 in
-
-\newcommand{\derives}{\mbox{$\rightarrow$}}
-\newcommand{\orderives}{\mbox{$\mid$}}
-\newcommand{\many}[1]{\{ {#1} \}}
-\newcommand{\oneormore}[1]{\{ {#1} \}$^{+}$}
-\newcommand{\optional}[1]{[ {#1} ]}
-
-\newcommand{\at}{\texttt{@}}
-\newcommand{\att}{@}
-\newcommand{\lam}{\texttt{\char`\\}}
-
-\newcommand{\workingnote}[1]%
-        {\begin{quote}
-          \framebox{\parbox{.8 \linewidth}
-                           {\textbf{\textsl{Working note:}} \textsl{#1}}}
-          \end{quote}}
-
-\begin{document}
-
-\title{An External Representation for the GHC Core Language (DRAFT for GHC5.02)}
-\author{Andrew Tolmach ({\tt apt@cs.pdx.edu})\\and The GHC Team}
-
-\maketitle
-\makeatactive
-
-\abstract{
-This document provides a precise definition for the GHC Core language,
-so that it can be used to communicate between GHC and new stand-alone
-compilation tools such as back-ends or optimizers.
-The definition includes a formal grammar and an informal semantics.
-An executable typechecker and interpreter (in Haskell), 
-which formally embody the static and dynamic semantics,
-are available separately.
-
-Note: This is a draft document, which attempts to describe GHC's current
-behavior as precisely as possible.  Working notes scattered throughout indicate
-areas where further work is needed.  Constructive comments are very welcome, 
-both on  the presentation, and on ways in which GHC could be improved in order
-to simplify the Core story.
-}
-
-\section{Introduction}
-
-The Glasgow Haskell Compiler (GHC) uses an intermediate language, called
-``Core,''  as its internal program representation during
-several key stages of compiling.
-Core resembles a subset of Haskell, but with explicit type annotations
-in the style of the polymorphic lambda calculus (F$_\omega$).
-GHC's front end translates full Haskell 98 (plus some extensions) into
-well-typed Core, which is then repeatedly rewritten by the GHC optimizer.
-Ultimately, GHC translates Core into STG-machine code and then into
-C or native code.  The rationale for the design of Core and its use are discussed
-in existing papers~\cite{ghc-inliner,comp-by-trans-scp}, although the (two different)
-idealized versions of Core described therein differ in significant ways
-from the actual Core language in current GHC.
-
-Researchers interested in writing just {\it part} of a Haskell compiler,
-such as a new back-end or a new optimizer pass, might like to make
-use of GHC to provide the other parts of the compiler.  For example, they
-might like to use GHC's front end to parse, desugar, and type-check source Haskell,
-then feeding the resulting code to their own back-end tool.
-Currently, they can only do this by linking their code into the
-GHC executable, which is an arduous process (and essentially requires
-the new code to be written in Haskell).   It would be much easier for
-external developers if GHC could be made to produce Core files in
-an agreed-upon external format.  To allow the widest range of interoperability,
-the external format should be text-based; pragmatically, it should
-also be human-readable. (It may ultimately be desirable to use a
-standard interchange base format such as ASDL or XML.)
-
-In the past, Core has had no rigorously defined external representation, although 
-by setting certain compiler flags, one can get a (rather ad-hoc) textual
-representation to be printed at various points in the compilation process;
-this is usually done to help debug the compiler.  To make Core fully useable
-a bi-directional communication format, it will be necssary to
-
-\begin{enumerate}
-\item define precisely the external format of Core;
-
-\item modify GHC to produce external Core files, if so requested, at one or more
-useful points in the compilation sequence -- e.g., just before optimization,
-or just after;
-
-\item modify GHC to accept external Core files in place of Haskell 
-source files, again at one or more useful points.
-
-\end{enumerate}
-
-The first two facilities will let one couple GHC's front-end (parser,
-type-checker, etc.), and optionally its optimizer, with new back-end tools.
-Adding the last facility will let one implement new Core-to-Core 
-transformations in an external tool and integrate them into GHC. It will also
-allow new front-ends to generate Core that can be fed into GHC's optimizer or 
-back end; however, because there are many (undocumented)
-idiosynracies in the way GHC produces Core from source Haskell, it will be hard
-for an external tool to produce Core that can be integrated with GHC-produced core 
-(e.g., for the Prelude), and we don't aim to support this.
-
-This document addresses the first requirement, a formal Core definition,
-by proposing  a formal grammar for an external representation of Core
-(Section~\ref{sec:external}, and 
-an informal semantics (Section~\ref{sec:informal}.
-
-Beginning in GHC5.02, external Core (post-optimization) adhering to this definition
-can be generated using the compiler flag @-fext-core@.
-
-Formal static and dynamic semantics in the form of an executable typechecker and interpreter
-are available separately in the GHC source tree under @fptools/ghc/utils/ext-core@.
-
-\section{External Grammar of Core}
-\label{sec:external}
-
-In designing the external grammar, we have tried to strike a balance among
-a number of competing goals, including easy parseability by machines,
-easy readability by humans, and adequate structural simplicity to 
-allow straightforward presentations of the semantics. This has inevitably
-led to certain compromise. In particular:
-
-\begin{itemize}
-\item In order to avoid explosion of parentheses, various standard precedences
-and short-cuts are supported for expressions, types, and kinds; this led to the introduction
-of multiple non-terminals for each of these syntactic categories, which
-makes the concrete grammar longer and more complex than the underlying abstract syntax.
-
-\item On the other hand, the grammar has been kept simpler by avoiding special syntax for 
-tuple types and terms; tuples (both boxed and unboxed) are treated 
-as ordinary constructors. 
-
-\item All type abstractions and applications are given in full, even though
-some of them (e.g., for tuples) could be reconstructed; this permits Core to
-be parsed without the necessity of performing any type reconstruction.
-
-\item The syntax of identifiers is heavily restricted (essentially to just
-alphanumerics); this again makes Core easier to parse but harder to read.
-\end{itemize}
-
-\workingnote{These choices are certainly debatable.  In particular, keeping 
-type applications on tuples and case arms considerably increases the size of core files and
-makes them less human-readable, though it allows a Core parser to be simpler.}
-
-We use the following notational conventions for syntax:
-
-\begin{tabular}{ll}
-{\it [ pat ]} & optional \\
-{\it \{ pat \}} & zero or more repetitions \\
-{\it \{ pat \}$^{+}$} & one or more repetitions \\
-{\it pat$_1$ \orderives\ pat$_2$} & choice \\
-@fibonacci@ & terminal syntax in typewriter font \\
-\end{tabular}
-
-{\it
-\begin{tabular}{lrclr}
-{\rm Module} &	 module &	 \derives &	 
-	\multicolumn{2}{l}{@\%module@ mident \many{tdef @;@} \many{\optional{@\%local@} vdefg @;@}} \\
-\\
-{\rm Type defn.} &	 tdef &	 \derives &	@%data@ qtycon \many{tbind} @=@ @{@ cdef \many{@;@ cdef} @}@ & {\rm algebraic type}\\
-   		 &	 &	 \orderives &	 @%newtype@ qtycon \many{tbind} \optional{@=@ ty} &	 {\rm newtype} \\
-\\
-{\rm Constr. defn.} &	cdef &	 \derives &	 qdcon \many{@\at@ tbind} \many{aty} \\
-\\
-{\rm Value defn.}  &	vdefg &	 \derives &	 @%rec@ @{@ vdef \many{@;@ vdef} @}@ &			 {\rm recursive} \\
-      		   &	&	 \orderives &	 vdef &	 						 {\rm non-recursive} \\
-		   &    vdef  &  \derives & qvar @::@ ty @=@ exp & \\
-\\
-{\rm Atomic expr.} &     aexp &  \derives &	 qvar &	 						{\rm variable} \\
-		 &	&	 \orderives &	 qdcon &	 					{\rm data constructor}\\ 
-		 &	&	 \orderives &	 lit &	 						{\rm literal} \\
-		 &	&	 \orderives &	 @(@ exp @)@ &						{\rm nested expr.}\\
-\\
-{\rm Expression} &	exp   &  \derives    &   aexp & 						{\rm atomic expresion}\\
-	         &	&	\orderives  &    aexp \oneormore{arg} & 				{\rm application}\\
-		 &	&	 \orderives &	 @\@ \oneormore{binder} @->@ exp &		 	{\rm abstraction}\\
-		 &	&	 \orderives &	 @%let@ vdefg @%in@ exp &	 			{\rm local definition}\\
-		 &	&	 \orderives &	 @%case@ exp @%of@ vbind @{@ alt \many{@;@ alt} @}@ &	{\rm case expression}\\
-		 &	&	 \orderives &	 @%coerce@ aty exp &					{\rm type coercion}\\
-		 &	&	 \orderives &	 @%note@  @"@ \many{char} @"@ exp &			{\rm expression note}\\
-		 &	&	 \orderives &	 @%external@ @"@ \many{char} @"@ aty &			{\rm external reference}\\
-\\
-{\rm Argument}   &	arg & 	\derives &	 \at\ aty &						{\rm type argument}\\
-		 &	&	 \orderives &	 aexp &							{\rm value argument} \\
-\\
-{\rm Case alt.} &	alt &	 \derives &	qdcon  \many {@\at@ tbind} \many{vbind} @->@ exp &{\rm constructor alternative}\\
-		&	&	 \orderives &	 lit @->@ exp &	 			{\rm literal alternative} \\
-		&	&	 \orderives &	 @%_@ @->@ exp & 				{\rm default alternative} \\
-\\
-{\rm Binder}	 & 	binder & \derives & \at\ tbind	&					{\rm type binder}\\
-		 & 		& \orderives & 	vbind	&						{\rm value binder}\\
-\\
-{\rm Type binder} &	tbind & \derives   & tyvar & {\rm implicitly of  kind @*@} \\
-                  &           & \orderives & @(@ tyvar @::@ kind @)@ & {\rm explicitly kinded} \\
-\\
-{\rm Value binder} & 	vbind & \derives &   @(@ var @::@ ty @)@ \\
-\\
-{\rm Literal} &	 lit &	 \derives &	 @(@ [@-@] \oneormore{digit} @::@ ty @)@ & {\rm integer} \\
-	    &	&	 \orderives &	 @(@ [@-@] \oneormore{digit} @.@ \oneormore{digit} @::@ ty @)@ & {\rm rational} \\
-	    &	&	 \orderives &	 @(@ @'@ char @'@ @::@ ty @)@ & {\rm character} \\
-	    &	&	 \orderives &	 @(@ @"@ \many{char} @"@ @::@ ty @)@ & {\rm string} \\
-\\
-{\rm Character}  & char & \derives & \multicolumn{2}{l}{any ASCII character in range 0x20-0x7E except 0x22,0x27,0x5c}\\
-		&	& \orderives & @\x@ hex hex  & {\rm ASCII code escape sequence} \\
-		&  hex   & \derives & @0@ \orderives  \ldots \orderives  @9@ \orderives  @a@ \orderives  \ldots \orderives  @f@ \\
-\end{tabular}
-
-\begin{tabular}{lrclr}
-{\rm Atomic type} & aty & \derives &	 tyvar &	 				{\rm type variable} \\
- 	  &	&	 \orderives &	 qtycon &					{\rm type constructor}\\
-	  & 	&  	 \orderives &	 @(@ ty @)@ &					{\rm nested type}\\
-\\
-{\rm Basic type} & bty  & \derives & 	aty  & 						{\rm atomic type}\\
-	          &      & \orderives & bty aty &	 				{\rm type application}\\
-\\
-{\rm Type} &	 ty &	 \derives   & 	bty & 						{\rm basic type}\\
-	  &	&	 \orderives &	@%forall@ \oneormore{tbind} @.@ ty  &		{\rm type abstraction}\\
-	  &	&	 \orderives &	bty @->@ ty  &	 				{\rm arrow type construction} \\
-\\
-{\rm Atomic kind} & akind & \derives &   @*@ &				{\rm lifted kind}\\
-		& 	& \orderives &	 @#@ &				{\rm unlifted kind}\\
-		& 	& \orderives &   @?@ &				{\rm open kind}\\
-		& 	& \orderives &   @(@ kind @)@&			{\rm nested kind}\\
-\\
-{\rm Kind} &	kind &	 \derives &	 akind & 			{\rm atomic kind}\\
- 	   &	&	 \orderives &	 akind @->@ kind 	 &	{\rm arrow kind} \\
-\\
-{\rm Identifier}	&	mident & \derives &uname &	{\rm module} \\
-	&	tycon &	 \derives &	 uname &	 	{\rm type constr.}  \\
-	&	qtycon & \derives &	 mident @.@  tycon &	{\rm qualified type constr.} \\
-	&	tyvar &	 \derives &	 lname &		{\rm type variable} \\
-	&	dcon &	 \derives &	 uname &	 	{\rm data constr.} \\
-	&	qdcon &	 \derives &	 mident @.@  dcon & 	{\rm qualified data constr.} \\
-	&	var &	 \derives &	 lname &		{\rm variable} \\
-	&	qvar &	 \derives &	 [ mident @.@ ] var &	{\rm optionally qualified variable} \\
-\\
-{\rm Name} 	&	lname  &  \derives & 	 lower \many{namechar} \\
- 	&       uname &  \derives & 	 upper \many{namechar} & \\
-	&	namechar & \derives &	 lower \orderives\  upper \orderives\  digit \orderives\  @'@ \\
-	&	lower &  \derives &      @a@ \orderives\  @b@ \orderives\  \ldots \orderives\  @z@ \orderives\  @_@ \\
-	&	upper &  \derives &      @A@ \orderives\  @B@ \orderives\  \ldots \orderives\  @Z@ \\
-	& 	digit &  \derives & 	 @0@ \orderives\  @1@ \orderives\  \ldots \orderives\  @9@ \\
-\\
-\end{tabular}
-}
-
-\workingnote{Should add some provision for comments.}
-
-\section{Informal Semantics}
-\label{sec:informal}
-
-Core resembles a explicitly-typed polymorphic lambda calculus (F$_\omega$), with the addition
-of local @let@ bindings, algebraic type definitions, constructors, and @case@ expressions,
-and primitive types, literals and operators.
-It is hoped that this makes it easy to obtain an informal understanding of Core programs
-without elaborate description.   This section therefore concentrates on the less obvious points.
-
-\subsection{Program Organization and Modules}
-
-Core programs are organized into {\em modules}, corresponding directly to source-level Haskell modules.
-Each module has a identifying name {\it mident}.
-
-Each module may contain the following kinds of top-level declarations:
-\begin{itemize}
-\item Algebraic data type declarations, each defining a type constructor and one or more data constructors;
-\item Newtype declarations,  corresponding to Haskell @newtype@ declarations, each defining a type constructor; and
-\item Value declarations, defining the types and values of top-level variables.
-\end{itemize}
-No type constructor, data constructor, or top-level value may be declared more than once within a given module.
-All the type declarations are (potentially) mutually recursive. Value declarations must be
-in dependency order, with explicit grouping of mutually recursive declarations.
-
-Identifiers defined in top-level declarations may be {\it external} or {\it internal}.
-External identifiers can be referenced from any other module in
-the program, using conventional dot notation (e.g., @PrelBase.Bool@, @PrelBase.True@).  
-Internal identifiers are visible only within the defining module.
-All type and data constructors are external, and are always defined and referenced using
-fully qualified names (with dots).  A top-level value is external if it is defined and referenced 
-using a fully qualified name with a dot (e.g., @MyModule.foo = ...@); otherwise, it is internal
-(e.g., @bar = ...@).  
-Note that the notion of external identifier does not necessarily coincide with that of ``exported''
-identifier in a Haskell source module: all constructors are external, even if not exported, and
-non-exported values may be external if they are referenced from potentially in-lineable exported values.
-Core modules have no explicit import or export lists. 
-Modules may be mutually recursive.
-
-\workingnote{But in the presence of inter-module recursion, is there much point in
-keeping track of recursive groups within modules? Options: (1) don't worry about it;
-(2) put all declarations in module (indeed whole program) into one huge recursive pot;
-(3) abandon general module recursion, and introduce some kind of import declaration to define the 
-types (only) of things from external modules that currently introduce module recursion.}
-
-There is also an implicitly-defined module @PrelGHC@, which exports the ``built-in'' types and values
-that must be provided by any implementation of Core (including GHC).   Details of this
-module are in Section~\ref{sec:prims}.
-
-A Core {\em program} is a collection of distinctly-named modules that includes a module
-called @Main@ having an exported value called @main@ of type @PrelIOBase.IO a@ (for some type @a@).
-
-Many modules of interest derive from library modules, such as @PrelBase@, which implement parts of
-the Haskell basis library.  In principle, these modules have no special status.  In practice, the
-requirement on the type of @Main.main@ implies that every program will contain a large subset of
-the Prelude library modules.
-
-\subsection{Namespaces}
-
-There are five distinct name spaces: 
-\begin{enumerate}
-\item module identifiers (@mident@),
-\item type constructors (@tycon@),
-\item type variables (@tyvar@),
-\item data constructors (@dcon@),
-\item term variables (@var@).
-\end{enumerate}  
-Spaces (1), (2+3), and (4+5) can be distinguished from each other by context.
-To distinguish (2) from (3) and (4) from (5), we require that 
-(both sorts of) constructors begin with an upper-case character
-and that (both sorts of) variables begin with a lower-case character (or @_@).
-Primitive types and operators are not syntactically distinguished.
-
-A given variable (type or term) may have multiple (local) definitions within a module.
-However, definitions never ``shadow'' one another; that is, the scope of the definition
-of a given variable never contains a redefinition of the same variable.  The only exception
-to this is that (necessarily closed) types labelling @%external@ expressions may contain 
-@tyvar@ bindings that shadow outer bindings.
-
-Core generated by GHC makes heavy use of encoded names, in which the characters @Z@ and @z@ are
-used to introduce escape sequences for non-alphabetic characters such as dollar sign @$@ (@zd@),
-hash @#@ (@zh@), plus @+@ (@zp@), etc.  This is the same encoding used in @.hi@ files and in the
-back-end of GHC itself, except that we sometimes change an initial @z@ to @Z@, or vice-versa, 
-in order to maintain case distinctions.
-
-\subsection{Types and Kinds}
-
-In Core, all type abstractions and applications are explicit.  This make it easy to 
-typecheck any (closed) fragment.  An full executable typechecker is available separately.
-
-Types are described by type expressions, which 
-are built from named type constructors and type variables
-using type application and universal quantification.  
-Each type constructor has a fixed arity $\geq 0$.  
-Because it is so widely used, there is
-special infix syntax for the fully-applied function type constructor (@->@).
-(The prefix identifier for this constructor is @PrelGHC.ZLzmzgZR@; this should
-only appear in unapplied or partially applied form.)
-There are also a number of other primitive type constructors (e.g., @Intzh@) that
-are predefined in the @PrelGHC@ module, but have no special syntax.
-Additional type constructors are
-introduced by @%data@ and @%newtype@ declarations, as described below.
-Type constructors are distinguished solely by name.
-
-As described in the Haskell definition, it is necessary to distinguish 
-well-formed type-expressions by classifying them into different {\it kinds}.
-In particular, Core explicitly records the kind of every bound type variable.
-Base kinds (@*@,@#@, and @?@) represent actual types, i.e., those that can be assigned
-to term variables; all the nullary type constructors have one of these kinds.
-Non-nullary type constructors have higher kinds of the form $k_1 @->@ k_2$,
-where $k_1$ and $k_2$ are kinds.   For example, the function type constructor
-@->@ has kind @* -> (* -> *)@.  Since Haskell allows abstracting over type
-constructors, it is possible for type variables to have higher kinds; however,
-it is much more common for them to have kind @*@, so this is the default if
-the kind is omitted in a type binder.
-
-The three base kinds distinguish the {\it liftedness} of the types they classify:
-@*@ represents lifted types; @#@ represents unlifted types; and @?@ represents
-``open'' types, which may be either lifted or unlifted.  Of these, only @*@ ever
-appears in Core code generated from user code; the other two are needed to describe
-certain types in primitive (or otherwise specially-generated) code.
-Semantically, a type is lifted if and only if it has bottom as an element. 
-Operationally, lifted types may be represented by closures; hence, any unboxed
-value is necessarily unlifted.  
-In particular, no top-level identifier (except in @PrelGHC@) has a type of kind @#@ or @?@.
-Currently, all the primitive types are unlifted 
-(including a few boxed primitive types such as @ByteArrayzh@).
-The ideas behind the use of unboxed and unlifted types are described in ~\cite{pj:unboxed}.
-
-There is no mechanism for defining type synonyms (corresponding to
-Haskell @type@ declarations).
-Type equivalence is just syntactic equivalence on type expressions
-(of base kinds) modulo:
-
-\begin{itemize} 
-\item alpha-renaming of variables bound in @%forall@ types;
-\item the identity $a$ @->@ $b$ $\equiv$ @PrelGHC.ZLzmzgZR@ $a$ $b$
-\item the substitution of representation types for {\it fully applied} instances of newtypes
-(see Section~\ref{sec:newtypes}).
-\end{itemize}
-
-\subsection{Algebraic data types}
-
-Each @data@ declaration introduces a new type constructor and a set of one or
-more data constructors, normally corresponding directly to a source Haskell @data@ declaration.
-For example, the source declaration
-\begin{code}
-data Bintree a =
-   Fork (Bintree a) (Bintree a)
-|  Leaf a
-\end{code}
-might induce the following Core declaration
-\begin{code}
-%data Bintree a = {
-   Fork (Bintree a) (Bintree a);
-   Leaf a)}
-\end{code}
-which introduces the unary type constructor @Bintree@ of kind @*->*@  and two data constructors with types
-\begin{code}
-Fork :: %forall a . Bintree a -> Bintree a -> Bintree a
-Leaf :: %forall a . a -> Bintree a
-\end{code}
-We define the {\it arity} of each data constructor to be the number of value arguments it takes;
-e.g. @Fork@ has arity 2 and @Leaf@ has arity 1.
-
-For a less conventional example illustrating the possibility of higher-order kinds, the Haskell source declaration
-\begin{code}
-data A f a = MkA (f a)
-\end{code}
-might induce the core declaration
-\begin{code}
-%data A (f::*->*) (a::*) = { MkA (f a) }
-\end{code}
-which introduces the constructor
-\begin{code}
-MkA :: %forall (f::*->*) (a::*) . (f a) -> (A f) a
-\end{code}
-
-
-GHC (like some other Haskell implementations) supports an extension to Haskell98 
-for existential types such as 
-\begin{code}
-data T = forall a . MkT a (a -> Bool)
-\end{code}
-This is represented by the Core declaration
-\begin{code}
-%data T = {MkT @a a (a -> Bool)}
-\end{code}
-which introduces the nullary type constructor @T@ and the data constructor
-\begin{code}
-MkT :: %forall a . a -> (a -> Bool) -> T
-\end{code}
-In general, existentially quantified variables appear as extra univerally
-quantified variables in the data contructor types.
-An example of how to construct and deconstruct values of type @T@ is shown in 
-Section~\ref{sec:exprs}.
-
-\subsection{Newtypes}
-\label{sec:newtypes}
-
-
-Each Core @%newtype@ declaration introduces a new type constructor and (usually) an associated
-representation type, corresponding to a source Haskell @newtype@
-declaration.  However, unlike in source Haskell, no data constructors are introduced.
-In fact, newtypes seldom appear in value types
-in Core programs, because GHC usually replaces them with their representation type.
-For example, the Haskell fragment
-\begin{code}
-newtype U = MkU Bool
-u = MkU True
-v = case u of
-  MkU b -> not b
-\end{code}
-might induce the Core fragment
-\begin{code}
-%newtype U = Bool;
-u :: Bool = True;
-v :: Bool = 
-   %let b :: Bool = u
-   %in not b;
-\end{code}
-The main purpose of including @%newtype@ declarations in Core is to permit checking of
-type expressions in which partially-applied newtype constructors are used to instantiate higher-kinded
-type variables.  For example:
-\begin{code}
-newtype W a = MkW (Bool -> a)
-data S k = MkS (k Bool)
-a :: S W = MkS (MkW(\x -> not x))
-\end{code}
-might generate this Core:
-\begin{code}
-%newtype W a = Bool -> a;
-%data S (k::(*->*)) = MkS (k Bool);
-a :: S W = MkS @ W (\(x::Bool) -> not x)
-\end{code}
-The type application @(S W)@ cannot be checked without a definition for @W@.
-
-Very rarely, source @newtype@ declarations may be (directly or indirectly) recursive. In such
-cases, it is not possible to subsitute the representation type for the new type;
-in fact, the representation type is omitted from the corresponding Core @%newtype@ declaration.
-Elements of the new
-type can only be created or examined by first explicitly coercing them from/to
-the representation type, using a @%coerce@ expression.  For example, the silly
-Haskell fragment
-\begin{code}
-newtype U = MkU (U -> Bool)
-u = MkU (\x -> True)
-v = case u of
-  MkU f -> f u
-\end{code}
-might induce the Core fragment
-\begin{code}
-%newtype U; 
-u :: U = %coerce U (\ (x::U) -> True);
-v :: Bool = 
-   %let f :: U -> Bool = %coerce (U -> Bool) u 
-   %in f u;
-\end{code}
-
-\workingnote{The treatment of newtypes is still very unattractive: acres of explanation for
-very rare phenomena.}
-
-\subsection{Expression Forms}
-\label{sec:exprs}
-
-Variables and data constructors are straightforward.
-
-Literal ({\it lit}) expressions consist of a literal value, in one of four different formats,
-and a (primitive) type annotation.   Only certain combinations of format and type
-are permitted; see Section~\ref{sec:prims}.  The character and string formats can describe only
-8-bit ASCII characters.  Moreover, because strings are interpreted as C-style null-terminated
-strings, they should not contain embedded nulls.
-
-Both value applications and type applications are made explicit, and similarly
-for value and type abstractions.  To tell them apart, type arguments in applications
-and formal type arguments in abstractions are preceded by an \at\ symbol. (In abstractions,
-the \at\ plays essentially the same role as the more usual $\Lambda$ symbol.)
-For example, the Haskell source declaration
-\begin{code}
-f x = Leaf (Leaf x)
-\end{code}
-might induce the Core declaration
-\begin{code}
-f :: %forall a . a -> BinTree (BinTree a) =
-  \ @a (x::a) -> Leaf @(Bintree a) (Leaf @a x)
-\end{code}
-
-Value applications may be of user-defined functions, data constructors, or primitives.
-None of these sorts of applications are necessarily saturated (although previously published variants
-of Core did require the latter two sorts to be).
-
-Note that the arguments of type applications are not always of kind @*@.  For example,
-given our previous definition of type @A@:
-\begin{code}
-data A f a = MkA (f a)
-\end{code}
-the source code
-\begin{code}
-MkA (Leaf True)
-\end{code}
-becomes
-\begin{code}
-(MkA @Bintree @Bool) (Leaf @Bool True)
-\end{code}
-
-Local bindings, of a single variable or of a set of mutually recursive variables,
-are represented by @%let@ expressions in the usual way. 
-
-By far the most complicated expression form is @%case@.
-@%case@ expressions are permitted over values of any type, although they will normally
-be algebraic or primitive types (with literal values).
-Evaluating a @%case@ forces the evaluation of the expression being
-tested (the ``scrutinee''). The value of the scrutinee is bound to the variable
-following the @%of@ keyword, which is in scope in all alternatives; 
-this is useful when the scrutinee is a non-atomic
-expression (see next example).
-
-In an algebraic @%case@, all the case alternatives must be
-labeled with distinct data constructors from the algebraic type, followed by
-any existential type variable bindings (see below), and 
-typed term variable bindings corresponding to the data constructor's
-arguments. The number of variables must match the data constructor's arity.
-
-For example, the following Haskell source expression
-\begin{code}
-case g x of
-  Fork l r -> Fork r l
-  t@(Leaf v) -> Fork t t
-\end{code}
-might induce the Core expression
-\begin{code}
-%case g x %of (t::Bintree a)
-   Fork (l::Bintree a) (r::Bintree a) ->
-      Fork @a r l
-   Leaf (v::a) ->
-      Fork @a t t
-\end{code}
-
-When performing a @%case@ over a value of an existentially-quantified algebraic
-type, the alternative must include extra local type bindings 
-for the existentially-quantified variables.  For example, given 
-\begin{code}
-data T = forall a . MkT a (a -> Bool)
-\end{code}
-the source
-\begin{code}
-case x of
-  MkT w g -> g w
-\end{code}
-becomes
-\begin{code}
-%case x %of (x'::T) 
-  MkT @b (w::b) (g::b->Bool) -> g w
-\end{code}
-
-In a @%case@ over literal alternatives,
-all the case alternatives must be distinct literals of the same primitive type.
-
-The list of alternatives may begin with a 
-default alternative labeled with an underscore (@%_@), which will be chosen if
-none of the other alternative match.  The default is optional except for a case
-over a primitive type, or when there are no other alternatives.
-If the case is over neither an
-algebraic type nor a primitive type, the default alternative is the {\it only}
-one that can appear.
-For algebraic cases, the set of alternatives
-need not be exhaustive, even if no default is given; if alternatives are missing,
-this implies that GHC has deduced that they cannot occur. 
-
-The @%coerce@ expression is primarily used in conjunction with manipulation of
-newtypes, as described in Section~\ref{sec:newtypes}. 
-However, @%coerce@ is sometimes used for
-other purposes, e.g. to coerce the return type of a function (such as @error@)
-that is guaranteed never to return.  By their natures, uses of @%coerce@ cannot
-be independently justified, and must be taken on faith by a type-checker for Core.
-
-A @%note@ expression is used to carry arbitrary internal information of interest to
-GHC.  The information must be encoded as a string.  Expression notes currently generated by GHC
-include the inlining pragma (@InlineMe@) and cost-center labels for profiling.
-
-A @%external@ expression denotes an external identifier, which has
-the indicated type (always expressed in terms of Haskell primitive types).
-\workingnote{The present syntax is sufficient for describing C functions and labels.
-Interfacing to other languages may require additional information or a different interpretation
-of the name string.}
-
-
-\subsection{Expression Evaluation}  
-
-The dynamic semantics of Core are defined on the type-erasure of the program;
-ie. we ignore all type abstractions and applications.  The denotational semantics
-the resulting type-free program are just the conventional ones for a call-by-name
-language, in which expressions are only evaluated on demand.
-But Core is intended to be a call-by-{\it{need}} language, in which
-expressions are only evaluated {\it once}.  To express the sharing behavior
-of call-by-need, we give an operational model in the style of Launchbury.
-This section describes the model informally; a more formal semantics is
-separately available in the form of an executable interpreter.
-
-To simplify the semantics, we consider only ``well-behaved'' Core programs in which
-constructor and primitive applications are fully saturated, and in which
-non-trivial expresssions of unlifted kind (@#@) appear only as scrutinees
-in @%case@ expressions.  Any program can easily be put into this form;
-a separately available executable preprocessor illustrates how.
-In the remainder of this section, we use ``Core'' to mean ``well-behaved'' Core.
-
-Evaluating a Core expression means reducing it to {\it weak-head normal form (WHNF)},
-i.e., a primitive value, lambda abstraction, or fully-applied data constructor.
-Evaluation of a program is evaluation of the expression @Main.main@.
-
-To make sure that expression evaluation is shared, we
-make use of a {\it heap}, which can contain
-\begin{itemize}
-\item {\em Thunks} representing suspended (i.e., as yet unevaluated) expressions.
-
-\item {\em WHNF}s representing the result of evaluating such thunks. Computations over
-primitive types are never suspended, so these results are always closures (representing
-lambda abstractions) or data constructions.
-\end{itemize}
-Thunks are allocated when it
-is necessary to suspend a computation whose result may be shared.
-This occurs when evaluating three different kinds of expressions:
-\begin{itemize}
-\item Value definitions at top-level or within a local @let@ expression.
-Here, the defining expressions are suspended and the defined names
-are bound to heap pointers to the suspensions.
-
-\item User function applications.  Here, the actual argument expression is
-suspended and the formal argument is bound to a heap pointer to the suspension.
-
-\item Constructor applications. Here, the actual argument expression is
-suspended and a heap pointer to the suspension is embedded in the constructed value.
-\end{itemize}
-
-As computation proceeds, copies of the heap pointer propagate. 
-When the computation is eventually forced, the heap entry is overwritten with the resulting
-WHNF, so all copies of the pointer now point to this WHNF.   Forcing occurs
-only in the context of
-\begin{itemize}
-\item evaluating the operator expression of an application; 
-
-\item evaluating the ``scrutinee'' of a @case@ expression; or 
-
-\item evaluating an argument to a primitive or external function application
-\end{itemize}
-
-Ultimately, if there are no remaining pointers to the heap entry (whether suspended or evaluated),
-the entry can be garbage-collected; this is assumed to happen implicitly.
-
-With the exception of functions, arrays, and mutable variables, the intention is that values of all primitive types
-should be held {\it unboxed}, i.e., not heap-allocated.  This causes no problems for laziness because all
-primitive types are {\it unlifted}.  Unboxed tuple types are not heap-allocated either.
-
-Certain primitives and @%external@ functions cause side-effects to state threads or to the real world.
-Where the ordering of these side-effects matters, Core already forces this order
-by means of data dependencies on the psuedo-values representing the threads.
-
-The @raisezh@ and @handlezh@ primitives requires special support in an implementation, such as a handler stack; 
-again, real-world threading guarantees that they will execute in the correct order.
-
-\section{Primitive Module}
-\label{sec:prims}
-
-This section describes the contents and informal semantics of the primitive module @PrimGHC@.
-Nearly all the primitives are required in order to cover GHC's implementation of the Haskell98
-standard prelude; the only operators that can be completely omitted are those supporting the byte-code interpreter, 
-parallelism, and foreign objects.  Some of the concurrency primitives are needed, but can be
-given degenerate implementations if it desired to target a purely sequential backend; see Section~\ref{sec:sequential}.
-
-In addition to these primitives, a large number of C library functions are required to implement
-the full standard Prelude, particularly to handle I/O and arithmetic on less usual types.
-% We list these separately in section~\ref{sec:ccalls}.
-
-\subsection{Types}
-
-\begin{tabular}{|l|l|l|}
-\hline
-Type & Kind & Description \\
-\hline
-@ZLzmzgZR@ & @* -> * -> *@ & functions (@->@) \\
-@Z1H@ & @? -> #@    & unboxed 1-tuple \\
-@Z2H@	   & @? -> ? -> #@ & unboxed 2-tuple \\
-\ldots   & \ldots & \ldots \\
-@Z100H@	   & @? -> ? -> ? -> ... -> ? -> #@ & unboxed 100-tuple \\
-@Addrzh@    & @#@	   & machine address (pointer) \\
-@Charzh@	   & @#@	   & unicode character (31 bits) \\
-@Doublezh@  & @#@	   & double-precision float \\
-@Floatzh@   & @#@	   & float \\
-@Intzh@	   & @#@	   & int (30+ bits) \\
-@Int32zh@   & @#@	   & int (32 bits) \\
-@Int64zh@   & @#@	   & int (64 bits) \\
-@Wordzh@	   & @#@	   & unsigned word (30+ bits) \\
-@Word32zh@   & @#@	   & unsigned word (32 bits) \\
-@Word64zh@   & @#@	   & unsigned word (64 bits) \\
-@RealWorld@ & @*@          & pseudo-type for real world state \\
-@Statezh@    & @* -> #@     & mutable state \\
-@Arrayzh@   & @* -> #@     & immutable arrays \\
-@ByteArrayzh@   & @#@     & immutable byte arrays \\
-@MutableArrayzh@   & @* -> * -> #@     & mutable arrays \\
-@MutableByteArrayzh@   & @* -> #@     & mutable byte arrays \\
-@MutVarzh@ & @* -> * -> #@  & mutable variables \\
-@MVarzh@  & @* -> * -> #@  & synchronized mutable variables \\
-@Weakzh@  & @* -> #@      & weak pointers \\
-@StablePtrzh@ & @* -> #@  & stable pointers \\
-@ForeignObjzh@ & @#@	& foreign object \\
-@ThreadIdzh@ & @#@	 & thread id \\
-@ZCTCCallable@ & @? -> *@ & dictionaries for CCallable pseudo-class \\
-@ZCTCReturnable@ & @? -> *@ & dictionaries for CReturnable pseudo-class \\
-\hline
-\end{tabular}
-
-In addition, the types @PrelBase.Bool@ and @PrelBase.Unit@, which are non-primitive
-and are defined as ordinary algebraic types in module @PrelBase@, are used in
-the types of some operators in @PrelGHC@.
-
-The unboxed tuple types are quite special: they hold sets of values in an unlifted
-context, i.e., to be manipulated directly rather than being stored in the heap.  They can only
-appear in limited contexts in programs; in particular, they cannot be bound by a
-lambda abstraction or case alternative pattern. Note that they can hold either lifted
-or unlifted values.  The limitation to 100-tuples is an arbitrary one set by GHC.
-
-The type of arbitrary precision integers (@Integer@) is not primitive; it is made
-up of an ordinary primitive integer (@Intzh@) and a byte array (@ByteArrzh@).
-The components of an @Integer@ are passed to primitive operators as two separate
-arguments and returned as an unboxed pair.
-
-The @Statezh@ type constructor takes a dummy type argument that is used only 
-to distinguish different state {\it threads}~\cite{Launchbury94}.
-The @RealWorld@ type is used only as an argument to @Statezh@, and represents
-the thread of real-world state; it contains just the single value @realWorldzh@.
-The mutable data types @MutableArrayzh@,@MutableByteArrayzh@,@MutVarzh@
-take an initial type argument of the form @(Statezh@ $t$@)@ for some thread $t$.
-The synchronized mutable variable type constructor @MVarzh@ always takes an argument of type
-@Statezh RealWorld@.
-
-@Weakzh@ is the type of weak pointers.
-
-@StablePtrzh@ is the type of stable pointers, which are guaranteed not to move
-during garbage collections; these are useful in connection with foreign functions.
-
-@ForeignPtrzh@ is the type of foreign pointers.
-
-The dictionary types @ZCTCCallable@ and @ZCTCReturnable@ are just placeholders
-which can be represented by a void type;
-any code they appear in should be unreachable.
-
-\subsubsection{Non-concurrent Back End}
-\label{sec:sequential}
-
-The Haskell98 standard prelude doesn't include any concurrency support, but GHC's
-implementation of it relies on the existence of some concurrency primitives.  However,
-it never actually forks multiple threads.  Hence, the concurrency primitives can
-be given degenerate implementations that will work in a non-concurrent setting,
-as follows:
-\begin{itemize}
-\item  @ThreadIdzh@ can be represented
-by a singleton type, whose (unique) value is returned by @myThreadIdzh@.
-
-\item @forkzh@ can just die with an ``unimplemented'' message.
-
-\item @killThreadzh@ and @yieldzh@ can also just die ``unimplemented'' since
-in a one-thread world, the only thread a thread can kill is itself, and
-if a thread yields the program hangs.
-
-\item @MVarzh a@ can be represented by @MutVarzh (Maybe a)@;
-where a concurrent implementation would block, the sequential implementation can
-just die with a suitable message (since no other thread exists to unblock it).
-
-\item @waitReadzh@ and @waitWritezh@ can be implemented using a @select@ with no timeout. 
-\end{itemize}
-
-\subsection{Literals}
-
-Only the following combination of literal forms and types are permitted:
-
-\begin{tabular}{|l|l|l|}
-\hline
-Literal form & Type & Description \\
-\hline 
-integer	&  @Intzh@ & Int \\
-%	&  @Int32zh@ & Int32 \\
-%	&  @Int64zh@ & Int64 \\
-	&  @Wordzh@ & Word \\
-%	&  @Word32zh@ & Word32 \\
-%	&  @Word64zh@ & Word64 \\
-	&  @Addrzh@ & Address \\
-	&  @Charzh@ & Unicode character code \\
-rational & @Floatzh@ & Float \\
-	 & @Doublezh@ & Double \\
-character & @Charzh@ & Unicode character specified by ASCII character\\
-string &  @Addrzh@  & Address of specified C-format string \\
-\hline
-\end{tabular}
-
-\subsection{Data Constructors}
-
-The only primitive data constructors are for unboxed tuples:
-
-\begin{tabular}{|l|l|l|}
-\hline
-Constructor & Type & Description \\
-\hline
-@ZdwZ1H@ & @%forall (a::?).a -> Z1H a@ & unboxed 1-tuple \\
-@ZdwZ2H@ & @%forall (a1::?) (a2::?).a1 -> a2 -> Z2H a1 a2@ & unboxed 2-tuple \\
-\ldots & \ldots & \ldots \\
-@ZdwZ100H@ & @%forall (a1::?) (a2::?)... (a100::?) .@ & \\
-& \ \ \ @a1 -> a2 -> ... -> a100 -> Z100H a1 a2 ... a100@ & unboxed 100-tuple \\
-\hline
-\end{tabular}
-
-\subsection{Values}
-
-Operators are (roughly) divided into collections according to the primary
-type on which they operate.
-
-\workingnote{How do primitives fail, e.g., on division by zero or
-attempting an invalid narrowing coercion?}
-
-\workingnote{The following primop descriptions are automatically generated.
-The exact set of primops and their types presented here 
-depends on the underlying word size at the time of generation; these
-were done for 32 bit words.  This is a bit stupid.
-More importantly, the word size has a big impact on just what gets produced
-in a Core file, but this isn't documented anywhere in the file itself.
-Perhaps there should be a global flag in the file?}
-
-\newcommand{\primoptions}[7]{{#1} {#2} {#3} {#4} {#5}}
-
-\newcommand{\primopsection}[2]{\subsubsection{#1}{#2}\vspace*{0.1in}}
-\newcommand{\primopdefaults}[1]{Unless otherwise noted, each primop has the following default characteristics: {#1}}
-
-\newcommand{\primopdesc}[8]{
-\par\noindent{\texttt{{{#3} :: {#6}}}}
-\\{#7} {#8}\\} 
-
-\input{prims.tex}
-
-\subsubsection{RealWorld}
-
-There is just one value of type @RealWorld@, namely @realWorldzh@. It is used
-only for dependency threading of side-effecting operations.
-
-\begin{thebibliography}{}
-
-\bibitem[Launchbury and {Peyton~Jones}, 1994]{Launchbury94}
-Launchbury, J. and {Peyton~Jones}, S. (1994).
-\newblock Lazy functional state threads.
-\newblock Technical report FP-94-05, Department of Computing Science,
-  University of Glasgow.
-
-\bibitem[{Peyton~Jones} and Launchbury, 1991]{pj:unboxed}
-{Peyton~Jones}, S. and Launchbury, J. (1991).
-\newblock Unboxed values as first class citizens.
-\newblock In {\em ACM Conference on Functional Programming and Computer
-  Architecture (FPCA'91)}, pages 636--666, Boston. ACM.
-
-\bibitem[{Peyton~Jones} and Marlow, 1999]{ghc-inliner}
-{Peyton~Jones}, S. and Marlow, S. (1999).
-\newblock Secrets of the {Glasgow Haskell Compiler} inliner.
-\newblock In {\em Workshop on Implementing Declarative Languages}, Paris,
-  France.
-
-\bibitem[Peyton~Jones and Santos, 1998]{comp-by-trans-scp}
-Peyton~Jones, S. and Santos, A. (1998).
-\newblock A transformation-based optimiser for {Haskell}.
-\newblock {\em Science of Computer Programming}, 32(1-3):3--47.
-
-\end{thebibliography}
-
-\end{document}
diff --git a/ghc/docs/ghci/ghci.tex b/ghc/docs/ghci/ghci.tex
deleted file mode 100644
index c4638a6719..0000000000
--- a/ghc/docs/ghci/ghci.tex
+++ /dev/null
@@ -1,1598 +0,0 @@
-%
-% (c) The OBFUSCATION-THROUGH-GRATUITOUS-PREPROCESSOR-ABUSE Project,
-%     Glasgow University, 1990-2000
-%
-
-% \documentstyle[preprint]{acmconf}
-\documentclass[11pt]{article}
-\oddsidemargin 0.1 in       %   Note that \oddsidemargin = \evensidemargin
-\evensidemargin 0.1 in
-\marginparwidth 0.85in    %   Narrow margins require narrower marginal notes
-\marginparsep 0 in 
-\sloppy
-
-%\usepackage{epsfig}
-\usepackage{shortvrb}
-\MakeShortVerb{\@}
-
-%\newcommand{\note}[1]{{\em Note: #1}}
-\newcommand{\note}[1]{{{\bf Note:}\sl #1}}
-\newcommand{\ToDo}[1]{{{\bf ToDo:}\sl #1}}
-\newcommand{\Arg}[1]{\mbox{${\tt arg}_{#1}$}}
-\newcommand{\bottom}{\perp}
-
-\newcommand{\secref}[1]{Section~\ref{sec:#1}}
-\newcommand{\figref}[1]{Figure~\ref{fig:#1}}
-\newcommand{\Section}[2]{\section{#1}\label{sec:#2}}
-\newcommand{\Subsection}[2]{\subsection{#1}\label{sec:#2}}
-\newcommand{\Subsubsection}[2]{\subsubsection{#1}\label{sec:#2}}
-
-% DIMENSION OF TEXT:
-\textheight 8.5 in
-\textwidth 6.25 in
-
-\topmargin 0 in
-\headheight 0 in
-\headsep .25 in
-
-
-\setlength{\parskip}{0.15cm}
-\setlength{\parsep}{0.15cm}
-\setlength{\topsep}{0cm}	% Reduces space before and after verbatim,
-				% which is implemented using trivlist 
-\setlength{\parindent}{0cm}
-
-\renewcommand{\textfraction}{0.2}
-\renewcommand{\floatpagefraction}{0.7}
-
-\begin{document}
-
-\title{The GHCi Draft Design, round 2}
-\author{MSR Cambridge Haskell Crew \\
-        Microsoft Research Ltd., Cambridge}
-
-\maketitle
-
-%%%\tableofcontents
-%%%\newpage
-
-%%-----------------------------------------------------------------%%
-\section{Details}
-
-\subsection{Outline of the design}
-\label{sec:details-intro}
-
-The design falls into three major parts:
-\begin{itemize}
-\item The compilation manager (CM), which coordinates the 
-      system and supplies a HEP-like interface to clients.
-\item The module compiler (@compile@), which translates individual
-      modules to interpretable or machine code.
-\item The linker (@link@),
-      which maintains the executable image in interpreted mode.
-\end{itemize}
-
-There are also three auxiliary parts: the finder, which locates
-source, object and interface files, the summariser, which quickly
-finds dependency information for modules, and the static info
-(compiler flags and package details), which is unchanged over the
-course of a session.
-
-This section continues with an overview of the session-lifetime data
-structures.  Then follows the finder (section~\ref{sec:finder}),
-summariser (section~\ref{sec:summariser}), 
-static info (section~\ref{sec:staticinfo}),
-and finally the three big sections
-(\ref{sec:manager},~\ref{sec:compiler},~\ref{sec:linker})
-on the compilation manager, compiler and linker respectively.
-
-\subsubsection*{Some terminology}
-
-Lifetimes: the phrase {\bf session lifetime} covers a complete run of
-GHCI, encompassing multiple recompilation runs.  {\bf Module lifetime}
-is a lot shorter, being that of data needed to translate a single
-module, but then discarded, for example Core, AbstractC, Stix trees.
-
-Data structures with module lifetime are well documented and understood.
-This document is mostly concerned with session-lifetime data.
-Most of these structures are ``owned'' by CM, since that's
-the only major component of GHCI which deals with session-lifetime
-issues. 
-
-Modules and packages: {\bf home} refers to modules in this package,
-precisely the ones tracked and updated by the compilation manager.
-{\bf Package} refers to all other packages, which are assumed static.
-
-\subsubsection*{A summary of all session-lifetime data structures}
-
-These structures have session lifetime but not necessarily global
-visibility.  Subsequent sections elaborate who can see what.
-\begin{itemize}
-\item {\bf Home Symbol Table (HST)} (owner: CM) holds the post-renaming
-      environments created by compiling each home module.
-\item {\bf Home Interface Table (HIT)} (owner: CM) holds in-memory
-      representations of the interface file created by compiling 
-      each home module.
-\item {\bf Unlinked Images (UI)} (owner: CM) are executable but as-yet
-      unlinked translations of home modules only.
-\item {\bf Module Graph (MG)} (owner: CM) is the current module graph.
-\item {\bf Static Info (SI)} (owner: CM) is the package configuration
-      information (PCI) and compiler flags (FLAGS).
-\item {\bf Persistent Compiler State (PCS)} (owner: @compile@)
-      is @compile@'s private cache of information about package
-      modules.
-\item {\bf Persistent Linker State (PLS)} (owner: @link@) is
-      @link@'s private information concerning the the current 
-      state of the (in-memory) executable image.
-\end{itemize}
-
-
-%%-- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --%%
-\subsection{The finder (\mbox{\tt type Finder})}
-\label{sec:finder}
-
-@Path@ could be an indication of a location in a filesystem, or it
-could be some more generic kind of resource identifier, a URL for
-example.
-\begin{verbatim}
-   data Path = ...
-\end{verbatim}
-
-And some names.  @Module@s are now used as primary keys for various
-maps, so they are given a @Unique@.
-\begin{verbatim}
-   type ModName = String      -- a module name
-   type PkgName = String      -- a package name
-   type Module  = -- contains ModName and a Unique, at least
-\end{verbatim}
-
-A @ModLocation@ says where a module is, what it's called and in what
-form it is.
-\begin{verbatim}
-   data ModLocation = SourceOnly Module Path         -- .hs
-                    | ObjectCode Module Path Path    -- .o, .hi
-                    | InPackage  Module PkgName
-                          -- examine PCI to determine package Path
-\end{verbatim}
-
-The module finder generates @ModLocation@s from @ModName@s.  We expect
-it will assume packages to be static, but we want to be able to track
-changes in home modules during the session.  Specifically, we want to
-be able to notice that a module's object and interface have been
-updated, presumably by a compile run outside of the GHCI session.
-Hence the two-stage type:
-\begin{verbatim}
-   type Finder = ModName -> IO ModLocation
-   newFinder :: PCI -> IO Finder
-\end{verbatim}
-@newFinder@ examines the package information right at the start, but 
-returns an @IO@-typed function which can inspect home module changes
-later in the session.
-
-
-%%-- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --%%
-\subsection{The summariser (\mbox{\tt summarise})}
-\label{sec:summariser}
-
-A @ModSummary@ records the minimum information needed to establish the
-module graph and determine whose source has changed.  @ModSummary@s
-can be created quickly.
-\begin{verbatim}
-   data ModSummary = ModSummary 
-                        ModLocation   -- location and kind
-                        (Maybe (String, Fingerprint))
-                                      -- source and fingerprint if .hs
-                        (Maybe [ModName])     -- imports if .hs or .hi
-
-   type Fingerprint = ...  -- file timestamp, or source checksum?
-
-   summarise :: ModLocation -> IO ModSummary
-\end{verbatim}
-
-The summary contains the location and source text, and the location
-contains the name.  We would like to remove the assumption that
-sources live on disk, but I'm not sure this is good enough yet.
-
-\ToDo{Should @ModSummary@ contain source text for interface files too?}
-\ToDo{Also say that @ModIFace@ contains its module's @ModSummary@  (why?).}
-
-
-%%-- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --%%
-\subsection{Static information (SI)}
-\label{sec:staticinfo}
-
-PCI, the package configuration information, is a list of @PkgInfo@,
-each containing at least the following:
-\begin{verbatim}
-   data PkgInfo
-      = PkgInfo PkgName    -- my name
-                Path       -- path to my base location
-                [PkgName]  -- who I depend on
-                [ModName]  -- modules I supply
-                [Unlinked] -- paths to my object files
-
-   type PCI = [PkgInfo]
-\end{verbatim}
-The @Path@s in it, including those in the @Unlinked@s, are set up
-when GHCI starts.  
-
-FLAGS is a bunch of compiler options.  We haven't figured out yet how
-to partition them into those for the whole session vs those for
-specific source files, so currently the best we can do is:
-\begin{verbatim}
-   data FLAGS = ...
-\end{verbatim}
-
-The static information (SI) is the both of these:
-\begin{verbatim}
-   data SI = SI PCI
-                FLAGS
-\end{verbatim}
-
-
-
-%%-- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --%%
-\subsection{The Compilation Manager (CM)}
-\label{sec:manager}
-
-\subsubsection{Data structures owned by CM}
-
-CM maintains two maps (HST, HIT) and a set (UI).  It's important to
-realise that CM only knows about the map/set-ness, and has no idea
-what a @ModDetails@, @ModIFace@ or @Linkable@ is.  Only @compile@ and
-@link@ know that, and CM passes these types around without
-inspecting them.
-
-\begin{itemize}
-\item
-   {\bf Home Symbol Table (HST)} @:: FiniteMap Module ModDetails@
-
-   The @ModDetails@ (a couple of layers down) contain tycons, classes,
-   instances, etc, collectively known as ``entities''.  Referrals from
-   other modules to these entities is direct, with no intervening
-   indirections of any kind; conversely, these entities refer directly
-   to other entities, regardless of module boundaries.  HST only holds
-   information for home modules; the corresponding wired-up details
-   for package (non-home) modules are created on demand in the package
-   symbol table (PST) inside the persistent compiler's state (PCS).
-
-   CM maintains the HST, which is passed to, but not modified by,
-   @compile@.  If compilation of a module is successful, @compile@
-   returns the resulting @ModDetails@ (inside the @CompResult@) which
-   CM then adds to HST.
-
-   CM throws away arbitrarily large parts of HST at the start of a
-   rebuild, and uses @compile@ to incrementally reconstruct it.
-
-\item
-   {\bf Home Interface Table (HIT)} @:: FiniteMap Module ModIFace@
-
-   (Completely private to CM; nobody else sees this).
-
-   Compilation of a module always creates a @ModIFace@, which contains
-   the unlinked symbol table entries.  CM maintains this @FiniteMap@
-   @ModName@ @ModIFace@, with session lifetime.  CM never throws away
-   @ModIFace@s, but it does update them, by passing old ones to
-   @compile@ if they exist, and getting new ones back.
-
-   CM acquires @ModuleIFace@s from @compile@, which it only applies
-   to modules in the home package.  As a result, HIT only contains
-   @ModuleIFace@s for modules in the home package.  Those from other
-   packages reside in the package interface table (PIT) which is a
-   component of PCS.
-
-\item
-   {\bf Unlinked Images (UI)} @:: Set Linkable@
-
-   The @Linkable@s in UI represent executable but as-yet unlinked
-   module translations.  A @Linkable@ can contain the name of an
-   object, archive or DLL file.  In interactive mode, it may also be
-   the STG trees derived from translating a module.  So @compile@
-   returns a @Linkable@ from each successful run, namely that of
-   translating the module at hand.  
-
-   At link-time, CM supplies @Linkable@s for the upwards closure of
-   all packages which have changed, to @link@.  It also examines the
-   @ModSummary@s for all home modules, and by examining their imports
-   and the SI.PCI (package configuration info) it can determine the
-   @Linkable@s from all required imported packages too.
-
-   @Linkable@s and @ModIFace@s have a close relationship.  Each
-   translated module has a corresponding @Linkable@ somewhere.
-   However, there may be @Linkable@s with no corresponding modules
-   (the RTS, for example).  Conversely, multiple modules may share a
-   single @Linkable@ -- as is the case for any module from a
-   multi-module package.  For these reasons it seems appropriate to
-   keep the two concepts distinct.  @Linkable@s also provide
-   information about the sequence in which individual package
-   components should be linked, and that isn't the business of any
-   specific module to know.
-
-   CM passes @compile@ a module's old @ModIFace@, if it has one, in
-   the hope that the module won't need recompiling.  If so, @compile@
-   can just return the new @ModDetails@ created from it, and CM will
-   re-use the old @ModIFace@.  If the module {\em is} recompiled (or 
-   scheduled to be loaded from disk), @compile@ returns both the 
-   new @ModIFace@ and new @Linkable@.
-
-\item 
-   {\bf Module Graph (MG)} @:: known-only-to-CM@
-
-   Records, for CM's purposes, the current module graph,
-   up-to-dateness and summaries.  More details when I get to them.
-   Only contains home modules.
-\end{itemize}
-Probably all this stuff is rolled together into the Persistent CM
-State (PCMS):
-\begin{verbatim}
-  data PCMS = PCMS HST HIT UI MG
-  emptyPCMS :: IO PCMS
-\end{verbatim}
-
-\subsubsection{What CM implements}
-It pretty much implements the HEP interface.  First, though, define a 
-containing structure for the state of the entire CM system and its
-subsystems @compile@ and @link@:
-\begin{verbatim}
-   data CmState 
-      = CmState PCMS      -- CM's stuff
-                PCS       -- compile's stuff
-                PLS       -- link's stuff
-                SI        -- the static info, never changes
-                Finder    -- the finder
-\end{verbatim}
-
-The @CmState@ is threaded through the HEP interface.  In reality
-this might be done using @IORef@s, but for clarity:
-\begin{verbatim}
-  type ModHandle = ... (opaque to CM/HEP clients) ...
-  type HValue    = ... (opaque to CM/HEP clients) ...
-
-  cmInit       :: FLAGS 
-               -> [PkgInfo]
-               -> IO CmState
-
-  cmLoadModule :: CmState 
-               -> ModName 
-               -> IO (CmState, Either [SDoc] ModHandle)
-
-  cmGetExpr    :: ModHandle 
-               -> CmState 
-               -> String -> IO (CmState, Either [SDoc] HValue)
-
-  cmRunExpr    :: HValue -> IO ()   -- don't need CmState here
-\end{verbatim}
-Almost all the huff and puff in this document pertains to @cmLoadModule@.
-
-
-\subsubsection{Implementing \mbox{\tt cmInit}}
-@cmInit@ creates an empty @CmState@ using @emptyPCMS@, @emptyPCS@,
-@emptyPLS@, making SI from the supplied flags and package info, and 
-by supplying the package info the @newFinder@.
-
-
-\subsubsection{Implementing \mbox{\tt cmLoadModule}}
-
-\begin{enumerate}
-\item {\bf Downsweep:} using @finder@ and @summarise@, chase from 
-      the given module to
-      establish the new home module graph (MG).  Do not chase into
-      package modules.
-\item Remove from HIT, HST, UI any modules in the old MG which are
-      not in the new one.  The old MG is then replaced by the new one.
-\item Topologically sort MG to generate a bottom-to-top traversal
-      order, giving a worklist.
-\item {\bf Upsweep:} call @compile@ on each module in the worklist in 
-      turn, passing it
-      the ``correct'' HST, PCS, the old @ModIFace@ if
-      available, and the summary.  ``Correct'' HST in the sense that
-      HST contains only the modules in the this module's downward
-      closure, so that @compile@ can construct the correct instance
-      and rule environments simply as the union of those in 
-      the module's downward closure.
-
-      If @compile@ doesn't return a new interface/linkable pair,
-      compilation wasn't necessary.  Either way, update HST with
-      the new @ModDetails@, and UI and HIT respectively if a 
-      compilation {\em did} occur.
-
-      Keep going until the root module is successfully done, or
-      compilation fails.
-      
-\item If the previous step terminated because compilation failed,
-      define the successful set as those modules in successfully
-      completed SCCs, i.e. all @Linkable@s returned by @compile@ excluding
-      those from modules in any cycle which includes the module which failed.
-      Remove from HST, HIT, UI and MG all modules mentioned in MG which 
-      are not in the successful set.  Call @link@ with the successful
-      set,
-      which should succeed.  The net effect is to back off to a point
-      in which those modules which are still aboard are correctly
-      compiled and linked.
-
-      If the previous step terminated successfully, 
-      call @link@ passing it the @Linkable@s in the upward closure of
-      all those modules for which @compile@ produced a new @Linkable@.
-\end{enumerate}
-As a small optimisation, do this:
-\begin{enumerate}
-\item[3a.] Remove from the worklist any module M where M's source
-     hasn't changed and neither has the source of any module in M's
-     downward closure.  This has the effect of not starting the upsweep
-     right at the bottom of the graph when that's not needed.
-     Source-change checking can be done quickly by CM by comparing
-     summaries of modules in MG against corresponding 
-     summaries from the old MG.
-\end{enumerate}
-
-
-%%-- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --%%
-\subsection{The compiler (\mbox{\tt compile})}
-\label{sec:compiler}
-
-\subsubsection{Data structures owned by \mbox{\tt compile}}
-
-{\bf Persistent Compiler State (PCS)} @:: known-only-to-compile@
-
-This contains info about foreign packages only, acting as a cache,
-which is private to @compile@.  The cache never becomes out of
-date.  There are three parts to it:
-
-   \begin{itemize}
-   \item
-      {\bf Package Interface Table (PIT)} @:: FiniteMap Module ModIFace@
-
-   @compile@ reads interfaces from modules in foreign packages, and
-   caches them in the PIT.  Subsequent imports of the same module get
-   them directly out of the PIT, avoiding slow lexing/parsing phases.
-   Because foreign packages are assumed never to become out of date,
-   all contents of PIT remain valid forever.  @compile@ of course
-   tries to find package interfaces in PIT in preference to reading
-   them from files.  
-
-   Both successful and failed runs of @compile@ can add arbitrary
-   numbers of new interfaces to the PIT.  The failed runs don't matter
-   because we assume that packages are static, so the data cached even
-   by a failed run is valid forever (ie for the rest of the session).
-
-   \item
-      {\bf Package Symbol Table (PST)} @:: FiniteMap Module ModDetails@
-
-   Adding an package interface to PIT doesn't make it directly usable
-   to @compile@, because it first needs to be wired (renamed +
-   typechecked) into the sphagetti of the HST.  On the other hand,
-   most modules only use a few entities from any imported interface,
-   so wiring-in the interface at PIT-entry time might be a big time
-   waster.  Also, wiring in an interface could mean reading other
-   interfaces, and we don't want to do that unnecessarily.
-
-   The PST avoids these problems by allowing incremental wiring-in to
-   happen.  Pieces of foreign interfaces are copied out of the holding
-   pen (HP), renamed, typechecked, and placed in the PST, but only as
-   @compile@ discovers it needs them.  In the process of incremental
-   renaming/typechecking, @compile@ may need to read more package
-   interfaces, which are added to the PIT and hence to 
-   HP.~\ToDo{How? When?}
-
-   CM passes the PST to @compile@ and is returned an updated version
-   on both success and failure.
-
-   \item 
-      {\bf Holding Pen (HP)} @:: HoldingPen@ 
-
-   HP holds parsed but not-yet renamed-or-typechecked fragments of
-   package interfaces.  As typechecking of other modules progresses,
-   fragments are removed (``slurped'') from HP, renamed and
-   typechecked, and placed in PCS.PST (see above).  Slurping a
-   fragment may require new interfaces to be read into HP.  The hope
-   is, though, that many fragments will never get slurped, reducing
-   the total number of interfaces read (as compared to eager slurping).
-
-   \end{itemize}
-
-   PCS is opaque to CM; only @compile@ knows what's in it, and how to
-   update it.  Because packages are assumed static, PCS never becomes
-   out of date.  So CM only needs to be able to create an empty PCS,
-   with @emptyPCS@, and thence just passes it through @compile@ with
-   no further ado.
-
-   In return, @compile@ must promise not to store in PCS any
-   information pertaining to the home modules.  If it did so, CM would
-   need to have a way to remove this information prior to commencing a
-   rebuild, which conflicts with PCS's opaqueness to CM.
-
-
-
-
-\subsubsection{What {\tt compile} does}
-@compile@ is necessarily somewhat complex.  We've decided to do away
-with private global variables -- they make the design specification
-less clear, although the implementation might use them.  Without
-further ado:
-\begin{verbatim}
-   compile :: SI          -- obvious
-           -> Finder      -- to find modules
-           -> ModSummary  -- summary, including source
-           -> Maybe ModIFace
-                          -- former summary, if avail
-           -> HST         -- for home module ModDetails
-           -> PCS         -- IN: the persistent compiler state
-
-           -> IO CompResult
-
-   data CompResult
-      = CompOK  ModDetails   -- new details (== HST additions)
-                (Maybe (ModIFace, Linkable))
-                             -- summary and code; Nothing => compilation
-                             -- not needed (old summary and code are still valid)
-                PCS          -- updated PCS
-                [SDoc]       -- warnings
-
-      | CompErrs PCS         -- updated PCS
-                 [SDoc]      -- warnings and errors
-
-   data PCS
-      = MkPCS PIT         -- package interfaces
-              PST         -- post slurping global symtab contribs
-              HoldingPen  -- pre slurping interface bits and pieces
-
-   emptyPCS :: IO PCS     -- since CM has no other way to make one
-\end{verbatim}
-Although @compile@ is passed three of the global structures (FLAGS,
-HST and PCS), it only modifies PCS.  The rest are modified by CM as it
-sees fit, from the stuff returned in the @CompResult@.
-
-@compile@ is allowed to return an updated PCS even if compilation
-errors occur, since the information in it pertains only to foreign
-packages and is assumed to be always-correct.
-
-What @compile@ does: \ToDo{A bit vague ... needs refining.  How does
-                           @finder@ come into the game?}
-\begin{itemize}
-\item Figure out if this module needs recompilation.
-   \begin{itemize}
-   \item If there's no old @ModIFace@, it does.  Else:
-   \item Compare the @ModSummary@ supplied with that in the
-         old @ModIFace@.  If the source has changed, recompilation
-         is needed.  Else:
-   \item Compare the usage version numbers in the old @ModIFace@ with
-         those in the imported @ModIFace@s.  All needed interfaces
-         for this should be in either HIT or PIT.  If any version
-         numbers differ, recompilation is needed.
-   \item Otherwise it isn't needed.   
-   \end{itemize}
-
-\item
-   If recompilation is not needed, create a new @ModDetails@ from the
-   old @ModIFace@, looking up information in HST and PCS.PST as
-   necessary.  Return the new details, a @Nothing@ denoting
-   compilation was not needed, the PCS \ToDo{I don't think the PCS
-   should be updated, but who knows?}, and an empty warning list.
-
-\item
-   Otherwise, compilation is needed.  
-
-   If the module is only available in object+interface form, read the
-   interface, make up details, create a linkable pointing at the
-   object code.  \ToDo{Does this involve reading any more interfaces?  Does
-   it involve updating PST?}
-   
-   Otherwise, translate from source, then create and return: an
-   details, interface, linkable, updated PST, and warnings.
-
-   When looking for a new interface, search HST, then PCS.PIT, and only
-   then read from disk.  In which case add the new interface(s) to
-   PCS.PIT.  
-   
-   \ToDo{If compiling a module with a boot-interface file, check the 
-   boot interface against the inferred interface.}
-\end{itemize}
-
-
-\subsubsection{Contents of \mbox{\tt ModDetails}, 
-               \mbox{\tt ModIFace} and \mbox{\tt HoldingPen}}
-Only @compile@ can see inside these three types -- they are opaque to
-everyone else.  @ModDetails@ holds the post-renaming,
-post-typechecking environment created by compiling a module.
-
-\begin{verbatim}
-   data ModDetails
-      = ModDetails {
-           moduleExports :: Avails
-           moduleEnv     :: GlobalRdrEnv    -- == FM RdrName [Name]
-           typeEnv       :: FM Name TyThing -- TyThing is in TcEnv.lhs
-           instEnv       :: InstEnv
-           fixityEnv     :: FM Name Fixity
-           ruleEnv       :: FM Id [Rule]
-        }
-\end{verbatim}
-
-@ModIFace@ is nearly the same as @ParsedIFace@ from @RnMonad.lhs@:
-\begin{verbatim}
-   type ModIFace = ParsedIFace    -- not really, but ...
-   data ParsedIface
-      = ParsedIface {
-           pi_mod       :: Module,                   -- Complete with package info
-           pi_vers      :: Version,                  -- Module version number
-           pi_orphan    :: WhetherHasOrphans,        -- Whether this module has orphans
-           pi_usages    :: [ImportVersion OccName],  -- Usages
-           pi_exports   :: [ExportItem],             -- Exports
-           pi_insts     :: [RdrNameInstDecl],        -- Local instance declarations
-           pi_decls     :: [(Version, RdrNameHsDecl)],    -- Local definitions
-           pi_fixity    :: (Version, [RdrNameFixitySig]), -- Local fixity declarations, 
-                                                          -- with their version
-           pi_rules     :: (Version, [RdrNameRuleDecl]),  -- Rules, with their version
-           pi_deprecs   :: [RdrNameDeprecation]           -- Deprecations
-       }
-\end{verbatim}
-
-@HoldingPen@ is a cleaned-up version of that found in @RnMonad.lhs@, 
-retaining just the 3 pieces actually comprising the holding pen:
-\begin{verbatim}
-   data HoldingPen 
-      = HoldingPen {
-           iDecls :: DeclsMap,     -- A single, global map of Names to decls
-
-           iInsts :: IfaceInsts,
-           -- The as-yet un-slurped instance decls; this bag is depleted when we
-           -- slurp an instance decl so that we don't slurp the same one twice.
-           -- Each is 'gated' by the names that must be available before
-           -- this instance decl is needed.
-
-           iRules :: IfaceRules
-           -- Similar to instance decls, only for rules
-        }
-\end{verbatim}
-
-%%-- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --%%
-\subsection{The linker (\mbox{\tt link})}
-\label{sec:linker}
-
-\subsubsection{Data structures owned by the linker}
-
-In the same way that @compile@ has a persistent compiler state (PCS),
-the linker has a persistent (session-lifetime) state, PLS, the
-Linker's Persistent State.  In batch mode PLS is entirely irrelevant,
-because there is only a single link step, and can be a unit value
-ignored by everybody.  In interactive mode PLS is composed of the
-following three parts:
-
-\begin{itemize}
-\item 
-\textbf{The Source Symbol Table (SST)}@ :: FiniteMap RdrName HValue@   
-  The source symbol table is used when linking interpreted code.
-  Unlinked interpreted code consists of an STG  tree where
-  the leaves are @RdrNames@.  The linker's job is to resolve these to
-  actual addresses (the alternative is to resolve these lazily when
-  the code is run, but this requires passing the full symbol table
-  through the interpreter and the repeated lookups will probably be
-  expensive).
-
-  The source symbol table therefore maps @RdrName@s to @HValue@s, for
-  every @RdrName@ that currently \emph{has} an @HValue@, including all
-  exported functions from object code modules that are currently
-  linked in.  Linking therefore turns a @StgTree RdrName@ into an
-  @StgTree HValue@.
-
-  It is important that we can prune this symbol table by throwing away
-  the mappings for an entire module, whenever we recompile/relink a
-  given module.  The representation is therefore probably a two-level
-  mapping, from module names, to function/constructor names, to
-  @HValue@s.
-
-\item \textbf{The Object Symbol Table (OST)}@ :: FiniteMap String Addr@
-  This is a lower level symbol table, mapping symbol names in object
-  modules to their addresses in memory.  It is used only when
-  resolving the external references in an object module, and contains
-  only entries that are defined in object modules.
-
-  Why have two symbol tables?  Well, there is a clear distinction
-  between the two: the source symbol table maps Haskell symbols to
-  Haskell values, and the object symbol table maps object symbols to
-  addresses.  There is some overlap, in that Haskell symbols certainly
-  have addresses, and we could look up a Haskell symbol's address by
-  manufacturing the right object symbol and looking that up in the
-  object symbol table, but this is likely to be slow and would force
-  us to extend the object symbol table with all the symbols
-  ``exported'' by interpreted code.  Doing it this way enables us to
-  decouple the object management subsystem from the rest of the linker
-  with a minimal interface; something like
-
-  \begin{verbatim}
-  loadObject   :: Unlinked -> IO Object
-  unloadModule :: Unlinked -> IO ()
-  lookupSymbol :: String   -> IO Addr
-  \end{verbatim}
-
-  Rather unfortunately we need @lookupSymbol@ in order to populate the
-  source symbol table when linking in a new compiled module.  Our
-  object management subsystem is currently written in C, so decoupling
-  this interface as much as possible is highly desirable.
-
-\item
-   {\bf Linked Image (LI)} @:: no-explicit-representation@
-
-   LI isn't explicitly represented in the system, but we record it
-   here for completeness anyway.  LI is the current set of
-   linked-together module, package and other library fragments
-   constituting the current executable mass.  LI comprises:
-   \begin{itemize}
-   \item Machine code (@.o@, @.a@, @.DLL@ file images) in memory.
-         These are loaded from disk when needed, and stored in
-         @malloc@ville.  To simplify storage management, they are
-         never freed or reused, since this creates serious
-         complications for storage management.  When no longer needed,
-         they are simply abandoned.  New linkings of the same object
-         code produces new copies in memory.  We hope this not to be
-         too much of a space leak.
-   \item STG trees, which live in the GHCI heap and are managed by the
-         storage manager in the usual way.  They are held alive (are 
-         reachable) via the @HValue@s in the OST.  Such @HValue@s are
-         applications of the interpreter function to the trees
-         themselves.  Linking a tree comprises travelling over the 
-         tree, replacing all the @Id@s with pointers directly to the
-         relevant @_closure@ labels, as determined by searching the
-         OST.  Once the leaves are linked, trees are wrapped with the
-         interpreter function.  The resulting @HValue@s then behave
-         indistinguishably from compiled versions of the same code.
-   \end{itemize}
-   Because object code is outside the heap and never deallocated,
-   whilst interpreted code is held alive via the HST, there's no need
-   to have a data structure which ``is'' the linked image.
-
-   For batch compilation, LI doesn't exist because OST doesn't exist,
-   and because @link@ doesn't load code into memory, instead just
-   invokes the system linker.
-
-   \ToDo{Do we need to say anything about CAFs and SRTs?  Probably ...}
-\end{itemize}
-As with PCS, CM has no way to create an initial PLS, so we supply
-@emptyPLS@ for that purpose.
-
-\subsubsection{The linker's interface}
-
-In practice, the PLS might be hidden in the I/O monad rather
-than passed around explicitly.  (The same might be true for PCS).
-Anyway:
-
-\begin{verbatim}
-   data PLS -- as described above; opaque to everybody except the linker
-
-   link :: PCI -> ??? -> [[Linkable]] -> PLS -> IO LinkResult
-
-   data LinkResult = LinkOK   PLS
-                   | LinkErrs PLS [SDoc]
-
-   emptyPLS :: IO PLS     -- since CM has no other way to make one
-\end{verbatim}
-
-CM uses @link@ as follows:
-
-After repeatedly using @compile@ to compile all modules which are
-out-of-date, the @link@ is invoked.  The @[[Linkable]]@ argument to
-@link@ represents the list of (recursive groups of) home modules which
-have been newly compiled, along with @Linkable@s for each of
-the packages in use (the compilation manager knows which external
-packages are referenced by the home package).  The order of the list
-is important: it is sorted in such a way that linking any prefix of
-the list will result in an image with no unresolved references.  Note
-that for batch linking there may be further restrictions; for example
-it may not be possible to link recursive groups containing libraries.
-
-@link@ does the following:
-
-\begin{itemize}
-  \item 
-  In batch mode, do nothing.  In interactive mode,
-  examine the supplied @[[Linkable]]@ to determine which home 
-  module @Unlinked@s are new.  Remove precisely these @Linkable@s 
-  from PLS.  (In fact we really need to remove their upwards
-  transitive closure, but I think it is an invariant that CM will
-  supply an upwards transitive closure of new modules).
-  See below for descriptions of @Linkable@ and @Unlinked@.
-
-  \item 
-  Batch system: invoke the external linker to link everything in one go.
-  Interactive: bind the @Unlinked@s for the newly compiled modules,
-  plus those for any newly required packages, into PLS.
-
-  Note that it is the linker's responsibility to remember which
-  objects and packages have already been linked.  By comparing this
-  with the @Linkable@s supplied to @link@, it can determine which
-  of the linkables in LI are out of date
-\end{itemize}
-
-If linking in of a group should fail for some reason, @link@ should
-not modify its PLS at all.  In other words, linking each group
-is atomic; it either succeeds or fails.
-
-\subsubsection*{\mbox{\tt Unlinked} and \mbox{\tt Linkable}}
-
-Two important types: @Unlinked@ and @Linkable@.  The latter is a 
-higher-level representation involving multiple of the former.
-An @Unlinked@ is a reference to unlinked executable code, something
-a linker could take as input:
-
-\begin{verbatim}
-   data Unlinked = DotO   Path
-                 | DotA   Path            
-                 | DotDLL Path
-                 | Trees  [StgTree RdrName]
-\end{verbatim}
-
-The first three describe the location of a file (presumably)
-containing the code to link.  @Trees@, which only exists in
-interactive mode, gives a list of @StgTrees@, in which the unresolved
-references are @RdrNames@ -- hence it's non-linkedness.  Once linked,
-those @RdrNames@ are replaced with pointers to the machine code
-implementing them.
-
-A @Linkable@ gathers together several @Unlinked@s and associates them
-with either a module or package:
-
-\begin{verbatim}
-   data Linkable = LM Module  [Unlinked]   -- a module
-                 | LP PkgName              -- a package
-\end{verbatim}
-
-The order of the @Unlinked@s in the list is important, as
-they are linked in left-to-right order.  The @Unlinked@ objects for a
-particular package can be obtained from the package configuration (see
-Section \ref{sec:staticinfo}).
-
-\ToDo{When adding @Addr@s from an object module to SST, we need to
-      somehow find out the @RdrName@s of the symbols exported by that
-      module. 
-      So we'd need to pass in the @ModDetails@ or @ModIFace@ or some such?}
-
-
-
-%%-----------------------------------------------------------------%%
-\section{Background ideas}
-\subsubsection*{Out of date, but correct in spirit}
-
-\subsection{Restructuring the system}
-
-At the moment @hsc@ compiles one source module into C or assembly.
-This functionality is pushed inside a function called @compile@,
-introduced shortly.  The main new chunk of code is CM, the compilation manager,
-which supervises multiple runs of @compile@ so as to create up-to-date
-translations of a whole bunch of modules, as quickly as possible.
-CM also employs some minor helper functions, @finder@, @summarise@ and
-@link@, to do its work.
-
-Our intent is to allow CM to be used as the basis either of a 
-multi-module, batch mode compilation system, or to supply an
-interactive environment similar to that of Hugs.
-Only minor modifications to the behaviour of @compile@ and @link@ 
-are needed to give these different behaviours.
-
-CM and @compile@, and, for interactive use, an interpreter, are the
-main code components.  The most important data structure is the global
-symbol table; much design effort has been expended thereupon.
-
-
-\subsection{How the global symbol table is implemented}
-
-The top level symbol table is a @FiniteMap@ @ModuleName@
-@ModuleDetails@.  @ModuleDetails@ contains essentially the environment
-created by compiling a module.  CM manages this finite map, adding and
-deleting module entries as required.
-
-The @ModuleDetails@ for a module @M@ contains descriptions of all
-tycons, classes, instances, values, unfoldings, etc (henceforth
-referred to as ``entities''), available from @M@.  These are just
-trees in the GHCI heap.  References from other modules to these
-entities is direct -- when you have a @TyCon@ in your hand, you really
-have a pointer directly to the @TyCon@ structure in the defining module,
-rather than some kind of index into a global symbol table.  So there
-is a global symbol table, but it has a distributed (sphagetti-like?)
-nature.
-
-This gives fast and convenient access to tycon, class, instance,
-etc, information.  But because there are no levels of indirection,
-there's a problem when we replace @M@ with an updated version of @M@.
-We then need to find all references to entities in the old @M@'s
-sphagetti, and replace them with pointers to the new @M@'s sphagetti.
-This problem motivates a large part of the design.
-
-
-
-\subsection{Implementing incremental recompilation -- simple version}
-Given the following module graph
-\begin{verbatim}
-         D
-       /   \
-      /     \
-     B       C
-      \     /
-       \   /
-         A
-\end{verbatim}
-(@D@ imports @B@ and @C@, @B@ imports @A@, @C@ imports @A@) the aim is to do the
-least possible amount of compilation to bring @D@ back up to date.  The
-simplest scheme we can think of is:
-\begin{itemize}
-\item {\bf Downsweep}: 
-  starting with @D@, re-establish what the current module graph is
-  (it might have changed since last time).  This means getting a
-  @ModuleSummary@ of @D@.  The summary can be quickly generated,
-  contains @D@'s import lists, and gives some way of knowing whether
-  @D@'s source has changed since the last time it was summarised.
-
-  Transitively follow summaries from @D@, thereby establishing the
-  module graph.
-\item
-  Remove from the global symbol table (the @FiniteMap@ @ModuleName@
-  @ModuleDetails@) the upwards closure of all modules in this package
-  which are out-of-date with respect to their previous versions.  Also
-  remove all modules no longer reachable from @D@.
-\item {\bf Upsweep}:
-  Starting at the lowest point in the still-in-date module graph,
-  start compiling upwards, towards @D@.  At each module, call
-  @compile@, passing it a @FiniteMap@ @ModuleName@ @ModuleDetails@,
-  and getting a new @ModuleDetails@ for the module, which is added to
-  the map.
-
-  When compiling a module, the compiler must be able to know which
-  entries in the map are for modules in its strict downwards closure,
-  and which aren't, so that it can manufacture the instance
-  environment correctly (as union of instances in its downwards
-  closure).
-\item
-  Once @D@ has been compiled, invoke some kind of linking phase
-  if batch compilation.  For interactive use, can either do it all
-  at the end, or as you go along.
-\end{itemize}
-In this simple world, recompilation visits the upwards closure of
-all changed modules.  That means when a module @M@ is recompiled,
-we can be sure no-one has any references to entities in the old @M@,
-because modules importing @M@ will have already been removed from the 
-top-level finite map in the second step above.
-
-The upshot is that we don't need to worry about updating links to @M@ in
-the global symbol table -- there shouldn't be any to update.
-\ToDo{What about mutually recursive modules?}
-
-CM will happily chase through module interfaces in other packages in
-the downsweep.  But it will only process modules in this package
-during the upsweep.  So it assumes that modules in other packages
-never become out of date.  This is a design decision -- we could have
-decided otherwise.
-
-In fact we go further, and require other packages to be compiled,
-i.e. to consist of a collection of interface files, and one or more
-source files.  CM will never apply @compile@ to a foreign package
-module, so there's no way a package can be built on the fly from source.
-
-We require @compile@ to cache foreign package interfaces it reads, so
-that subsequent uses don't have to re-read them.  The cache never
-becomes out of date, since we've assumed that the source of foreign
-packages doesn't change during the course of a session (run of GHCI).
-As well as caching interfaces, @compile@ must cache, in some sense,
-the linkable code for modules.  In batch compilation this might simply
-mean remembering the names of object files to link, whereas in
-interactive mode @compile@ probably needs to load object code into
-memory in preparation for in-memory linking.
-
-Important signatures for this simple scheme are:
-\begin{verbatim}
-   finder :: ModuleName -> ModLocation
-
-   summarise :: ModLocation -> IO ModSummary
-
-   compile :: ModSummary 
-              -> FM ModName ModDetails
-              -> IO CompileResult
-
-   data CompileResult = CompOK  ModDetails
-                      | CompErr [ErrMsg]
-
-   link :: [ModLocation] -> [PackageLocation] -> IO Bool  -- linked ok?
-\end{verbatim}
-
-
-\subsection{Implementing incremental recompilation -- clever version}
-
-So far, our upsweep, which is the computationally expensive bit,
-recompiles a module if either its source is out of date, or it 
-imports a module which has been recompiled.  Sometimes we know
-we can do better than this:
-\begin{verbatim}
-   module B where                module A 
-   import A ( f )                {-# NOINLINE f #-}
-   ... f ...                     f x = x + 42
-\end{verbatim}
-If the definition of @f@ is changed to @f x = x + 43@, the simple
-upsweep would recompile @B@ unnecessarily.  We would like to detect
-this situation and avoid propagating recompilation all the way to the
-top.  There are two parts to this: detecting when a module doesn't
-need recompilation, and managing inter-module references in the
-global symbol table.
-
-\subsubsection*{Detecting when a module doesn't need recompilation}
-
-To do this, we introduce a new concept: the @ModuleIFace@.  This is
-effectively an in-memory interface file.  References to entities in
-other modules are done via strings, rather than being pointers
-directly to those entities.  Recall that, by comparison,
-@ModuleDetails@ do contain pointers directly to the entities they
-refer to.  So a @ModuleIFace@ is not part of the global symbol table.
-
-As before, compiling a module produces a @ModuleDetails@ (inside the
-@CompileResult@), but it also produces a @ModuleIFace@.  The latter
-records, amongst things, the version numbers of all imported entities
-needed for the compilation of that module.  @compile@ optionally also
-takes the old @ModuleIFace@ as input during compilation:
-\begin{verbatim}
-   data CompileResult = CompOK  ModDetails ModIFace
-                      | CompErr [ErrMsg]
-
-   compile :: ModSummary 
-              -> FM ModName ModDetails
-              -> Maybe ModuleIFace
-              -> IO CompileResult
-\end{verbatim}
-Now, if the @ModuleSummary@ indicates this module's source hasn't
-changed, we only need to recompile it if something it depends on has
-changed.  @compile@ can detect this by inspecting the imported entity
-version numbers in the module's old @ModuleIFace@, and comparing them
-with the version numbers from the entities in the modules being
-imported.  If they are all the same, nothing it depends on has
-changed, so there's no point in recompiling.
-
-\subsubsection*{Managing inter-module references in the global symbol table}
-
-In the above example with @A@, @B@ and @f@, the specified change to @f@ would
-require @A@ but not @B@ to be recompiled.  That generates a new
-@ModuleDetails@ for @A@.  Problem is, if we leave @B@'s @ModuleDetails@ 
-unchanged, they continue to refer (directly) to the @f@ in @A@'s old
-@ModuleDetails@.  This is not good, especially if equality between
-entities is implemented using pointer equality.
-
-One solution is to throw away @B@'s @ModuleDetails@ and recompile @B@.
-But this is precisely what we're trying to avoid, as it's expensive.
-Instead, a cheaper mechanism achieves the same thing: recreate @B@'s
-details directly from the old @ModuleIFace@.  The @ModuleIFace@ will
-(textually) mention @f@; @compile@ can then find a pointer to the 
-up-to-date global symbol table entry for @f@, and place that pointer
-in @B@'s @ModuleDetails@.  The @ModuleDetails@ are, therefore,
-regenerated just by a quick lookup pass over the module's former
-@ModuleIFace@.  All this applies, of course, only when @compile@ has
-concluded it doesn't need to recompile @B@.
-
-Now @compile@'s signature becomes a little clearer.  @compile@ has to
-recompile the module, generating a fresh @ModuleDetails@ and
-@ModuleIFace@, if any of the following hold:
-\begin{itemize}
-\item
-  The old @ModuleIFace@ wasn't supplied, for some reason (perhaps
-  we've never compiled this module before?)
-\item
-  The module's source has changed.
-\item
-  The module's source hasn't changed, but inspection of @ModuleIFaces@ 
-  for this and its imports indicates that an imported entity has
-  changed.
-\end{itemize}
-If none of those are true, we're in luck: quickly knock up a new
-@ModuleDetails@ from the old @ModuleIFace@, and return them both.
-
-As a result, the upsweep still visits all modules in the upwards
-closure of those whose sources have changed.  However, at some point
-we hopefully make a transition from generating new @ModuleDetails@ the
-expensive way (recompilation) to a cheap way (recycling old
-@ModuleIFaces@).  Either way, all modules still get new
-@ModuleDetails@, so the global symbol table is correctly
-reconstructed.
-
-
-\subsection{How linking works, roughly}
-
-When @compile@ translates a module, it produces a @ModuleDetails@,
-@ModuleIFace@ and a @Linkable@.  The @Linkable@ contains the
-translated but un-linked code for the module.  And when @compile@
-ventures into an interface in package it hasn't seen so far, it
-copies the package's object code into memory, producing one or more
-@Linkable@s.  CM keeps track of these linkables.  
-
-Once all modules have been @compile@d, CM invokes @link@, supplying
-the all the @Linkable@s it knows about.  If @compile@ had also been
-linking incrementally as it went along, @link@ doesn't have to do
-anything.  On the other hand, @compile@ could choose not to be
-incremental, and leave @link@ to do all the work.
-
-@Linkable@s are opaque to CM.  For batch compilation, a @Linkable@
-can record just the name of an object file, DLL, archive, or whatever,
-in which case the CM's call to @link@ supplies exactly the set of
-file names to be linked.  @link@ can pass these verbatim to the
-standard system linker.
-
-
-
-
-%%-----------------------------------------------------------------%%
-\section{Ancient stuff}
-\subsubsection*{Should be selectively merged into ``Background ideas''}
-
-\subsection{Overall}
-Top level structure is:
-\begin{itemize}
-\item The Compilation Manager (CM) calculates and maintains module
-      dependencies, and knows how create up-to-date object or bytecode
-      for a given module.  In doing so it may need to recompile 
-      arbitrary other modules, based on its knowledge of the module
-      dependencies.  
-\item On top of the CM are the ``user-level'' services.  We envisage
-      both a HEP-like interface, for interactive use, and an
-      @hmake@ style batch compiler facility.
-\item The CM only deals with inter-module issues.  It knows nothing
-      about how to recompile an individual module, nor where the compiled
-      result for a module lives, nor how to tell if 
-      a module is up to date, nor how to find the dependencies of a module.
-      Instead, these services are supplied abstractly to CM via a
-      @Compiler@ record.  To a first approximation, a @Compiler@
-      contains
-      the same functionality as @hsc@ has had until now -- the ability to
-      translate a single Haskell module to C/assembly/object/bytecode.
-
-      Different clients of CM (HEP vs @hmake@) may supply different
-      @Compiler@s, since they need slightly different behaviours.
-      Specifically, HEP needs a @Compiler@ which creates bytecode
-      in memory, and knows how to link it, whereas @hmake@ wants
-      the traditional behaviour of emitting assembly code to disk,
-      and making no attempt at linkage.
-\end{itemize}
-
-\subsection{Open questions}
-\begin{itemize}
-\item
-  Error reporting from @open@ and @compile@.
-\item
-  Instance environment management
-\item
-  We probably need to make interface files say what
-  packages they depend on (so that we can figure out
-  which packages to load/link).
-\item 
-  CM is parameterised both by the client uses and the @Compiler@
-  supplied.  But it doesn't make sense to have a HEP-style client
-  attached to a @hmake@-style @Compiler@.  So, really, the 
-  parameterising entity should contain both aspects, not just the
-  current @Compiler@ contents.
-\end{itemize}
-
-\subsection{Assumptions}
-
-\begin{itemize}
-\item Packages other than the "current" one are assumed to be 
-  already compiled.  
-\item
-  The "current" package is usually "MAIN",
-  but we can set it with a command-line flag.
-  One invocation of ghci has only one "current" package.
-\item
-  Packages are not mutually recursive
-\item
-  All the object code for a package P is in libP.a or libP.dll
-\end{itemize}
-
-\subsection{Stuff we need to be able to do}
-\begin{itemize}
-\item Create the environment in which a module has been translated,
-      so that interactive queries can be satisfied as if ``in'' that
-      module.
-\end{itemize}
-
-%%-----------------------------------------------------------------%%
-\section{The Compilation Manager}
-
-CM (@compilationManager@) is a functor, thus:
-\begin{verbatim}
-compilationManager :: Compiler -> IO HEP  -- IO so that it can create 
-                                          -- global vars (IORefs)
-
-data HEP = HEP {
-        load          :: ModuleName -> IO (),
-        compileString :: ModuleName -> String -> IO HValue,
-        ....
-   }
-
-newCompiler :: IO Compiler   -- ??? this is a peer of compilationManager?
-
-run :: HValue -> IO ()       -- Run an HValue of type IO ()
-                             -- In HEP?
-\end{verbatim}
-
-@load@ is the central action of CM: its job is to bring a module and
-all its descendents into an executable state, by doing the following:
-\begin{enumerate}
-\item 
-   Use @summarise@ to descend the module hierarchy, starting from the
-   nominated root, creating @ModuleSummary@s, and
-   building a map @ModuleName@ @->@ @ModuleSummary@.  @summarise@ 
-   expects to be passed absolute paths to files.  Use @finder@ to 
-   convert module names to file paths.
-\item
-   Topologically sort the map, 
-   using dependency info in the @ModuleSummary@s.
-\item
-   Clean up the symbol table by deleting the upward closure of 
-   changed modules.
-\item 
-   Working bottom to top, call @compile@ on the upward closure of 
-   all modules whose source has changed.  A module's source has
-   changed when @sourceHasChanged@ indicates there is a difference
-   between old and new summaries for the module.  Update the running
-   @FiniteMap@ @ModuleName@ @ModuleDetails@ with the new details
-   for this module.  Ditto for the running
-   @FiniteMap@ @ModuleName@ @ModuleIFace@.
-\item
-   Call @compileDone@ to signify that we've reached the top, so
-   that the batch system can now link.
-\end{enumerate}
-
-
-%%-----------------------------------------------------------------%%
-\section{A compiler}
-
-Most of the system's complexity is hidden inside the functions
-supplied in the @Compiler@ record:
-\begin{verbatim}        
-data Compiler = Compiler {        
-
-        finder :: PackageConf -> [Path] -> IO (ModuleName -> ModuleLocation)
-
-        summarise :: ModuleLocation -> IO ModuleSummary
-
-        compile :: ModuleSummary
-                -> Maybe ModuleIFace 
-                -> FiniteMap ModuleName ModuleDetails
-                -> IO CompileResult
-
-        compileDone     :: IO ()
-        compileStarting :: IO ()   -- still needed?  I don't think so.
-    }
-
-type ModuleName = String (or some such)
-type Path = String  -- an absolute file name
-\end{verbatim}
-
-\subsection{The module \mbox{\tt finder}}
-The @finder@, given a package configuration file and a list of
-directories to look in, will map module names to @ModuleLocation@s,
-in which the @Path@s are filenames, probably with an absolute path
-to them.
-\begin{verbatim}
-data ModuleLocation = SourceOnly Path        -- .hs
-                    | ObjectCode Path Path   -- .o & .hi
-                    | InPackage  Path        -- .hi
-\end{verbatim}
-@SourceOnly@ and @ObjectCode@ are unremarkable.  For sanity,
-we require that a module's object and interface be in the same
-directory.  @InPackage@ indicates that the module is in a 
-different package.
-
-@Module@ values -- perhaps all @Name@ish things -- contain the name of
-their package.  That's so that 
-\begin{itemize}
-\item Correct code can be generated for in-DLL vs out-of-DLL refs.
-\item We don't have version number dependencies for symbols
-      imported from different packages.
-\end{itemize}
-
-Somehow or other, it will be possible to know all the packages
-required, so that the for the linker can load them.
-We could detect package dependencies by recording them in the
-@compile@r's @ModuleIFace@ cache, and with that and the 
-package config info, figure out the complete set of packages
-to link.  Or look at the command line args on startup.
-
-\ToDo{Need some way to tell incremental linkers about packages,
-      since in general we'll need to load and link them before
-      linking any modules in the current package.}
-
-
-\subsection{The module \mbox{\tt summarise}r}
-Given a filename of a module (\ToDo{presumably source or iface}),
-create a summary of it.  A @ModuleSummary@ should contain only enough
-information for CM to construct an up-to-date picture of the
-dependency graph.  Rather than expose CM to details of timestamps,
-etc, @summarise@ merely provides an up-to-date summary of any module.
-CM can extract the list of dependencies from a @ModuleSummary@, but
-other than that has no idea what's inside it.
-\begin{verbatim}
-data ModuleSummary = ... (abstract) ...
-
-depsFromSummary :: ModuleSummary -> [ModuleName]   -- module names imported
-sourceHasChanged :: ModuleSummary -> ModuleSummary -> Bool
-\end{verbatim}
-@summarise@ is intended to be fast -- a @stat@ of the source or
-interface to see if it has changed, and, if so, a quick semi-parse to
-determine the new imports.
-
-\subsection{The module \mbox{\tt compile}r}
-@compile@ traffics in @ModuleIFace@s and @ModuleDetails@.  
-
-A @ModuleIFace@ is an in-memory representation of the contents of an
-interface file, including version numbers, unfoldings and pragmas, and
-the linkable code for the module.  @ModuleIFace@s are un-renamed,
-using @HsSym@/@RdrNames@ rather than (globally distinct) @Names@.
-
-@ModuleDetails@, by contrast, is an in-memory representation of the
-static environment created by compiling a module.  It is phrased in
-terms of post-renaming @Names@, @TyCon@s, etc, so it's basically a
-renamed-to-global-uniqueness rendition of a @ModuleIFace@.
-
-In an interactive session, we'll want to be able to evaluate
-expressions as if they had been compiled in the scope of some
-specified module.  This means that the @ModuleDetails@ must contain
-the type of everything defined in the module, rather than just the
-types of exported stuff.  As a consequence, @ModuleIFace@ must also
-contain the type of everything, because it should always be possible
-to generate a module's @ModuleDetails@ from its @ModuleIFace@.
-
-CM maintains two mappings, one from @ModuleName@s to @ModuleIFace@s,
-the other from @ModuleName@s to @ModuleDetail@s.  It passes the former
-to each call of @compile@.  This is used to supply information about
-modules compiled prior to this one (lower down in the graph).  The
-returned @CompileResult@ supplies a new @ModuleDetails@ for the module
-if compilation succeeded, and CM adds this to the mapping.  The
-@CompileResult@ also supplies a new @ModuleIFace@, which is either the
-same as that supplied to @compile@, if @compile@ decided not to
-retranslate the module, or is the result of a fresh translation (from
-source).  So these mappings are an explicitly-passed-around part of
-the global system state.
-
-@compile@ may also {\em optionally} also accumulate @ModuleIFace@s for
-modules in different packages -- that is, interfaces which we read,
-but never attempt to recompile source for.  Such interfaces, being
-from foreign packages, never change, so @compile@ can accumulate them
-in perpetuity in a private global variable.  Indeed, a major motivator
-of this design is to facilitate this caching of interface files,
-reading of which is a serious bottleneck for the current compiler.
-
-When CM restarts compilation down at the bottom of the module graph,
-it first needs to throw away all \ToDo{all?} @ModuleDetails@ in the
-upward closure of the out-of-date modules.  So @ModuleDetails@ don't
-persist across recompilations.  But @ModuleIFace@s do, since they
-are conceptually equivalent to interface files.
-
-
-\subsubsection*{What @compile@ returns}
-@compile@ returns a @CompileResult@ to CM.
-Note that the @compile@'s foreign-package interface cache can
-become augmented even as a result of reading interfaces for a
-compilation attempt which ultimately fails, although it will not be
-augmented with a new @ModuleIFace@ for the failed module.
-\begin{verbatim}
--- CompileResult is not abstract to the Compilation Manager
-data CompileResult
-   = CompOK   ModuleIFace 
-              ModuleDetails    -- compiled ok, here are new details
-                               -- and new iface
-
-   | CompErr  [SDoc]           -- compilation gave errors
-
-   | NoChange                  -- no change required, meaning:
-                               -- exports, unfoldings, strictness, etc,
-                               -- unchanged, and executable code unchanged
-\end{verbatim}
-
-
-
-\subsubsection*{Re-establishing local-to-global name mappings}
-Consider
-\begin{verbatim}
-module Upper where                         module Lower ( f ) where
-import Lower ( f )                         f = ...
-g = ... f ...
-\end{verbatim}
-When @Lower@ is first compiled, @f@ is allocated a @Unique@
-(presumably inside an @Id@ or @Name@?).  When @Upper@ is then
-compiled, its reference to @f@ is attached directly to the
-@Id@ created when compiling @Lower@.
-
-If the definition of @f@ is now changed, but not the type,
-unfolding, strictness, or any other thing which affects the way
-it should be called, we will have to recompile @Lower@, but not
-@Upper@.  This creates a problem -- @g@ will then refer to the
-the old @Id@ for @f@, not the new one.  This may or may not
-matter, but it seems safer to ensure that all @Unique@-based
-references into child modules are always up to date.
-
-So @compile@ recreates the @ModuleDetails@ for @Upper@ from 
-the @ModuleIFace@ of @Upper@ and the @ModuleDetails@ of @Lower@.
-
-The rule is: if a module is up to date with respect to its
-source, but a child @C@ has changed, then either:
-\begin{itemize}
-\item On examination of the version numbers in @C@'s
-      interface/@ModuleIFace@ that we used last time, we discover that
-      an @Id@/@TyCon@/class/instance we depend on has changed.  So 
-      we need to retranslate the module from its source, generating
-      a new @ModuleIFace@ and @ModuleDetails@.
-\item Or: there's nothing in @C@'s interface that we depend on.
-      So we quickly recreate a new @ModuleDetails@ from the existing
-      @ModuleIFace@, creating fresh links to the new @Unique@-world
-      entities in @C@'s new @ModuleDetails@.
-\end{itemize}
-
-Upshot: we need to redo @compile@ on all modules all the way up,
-rather than just the ones that need retranslation.  However, we hope
-that most modules won't need retranslation -- just regeneration of the
-@ModuleDetails@ from the @ModuleIFace@.  In effect, the @ModuleIFace@
-is a quickly-compilable representation of the module's contents, just
-enough to create the @ModuleDetails@.
-
-\ToDo{Is there anything in @ModuleDetails@ which can't be
-      recreated from @ModuleIFace@ ?}
-
-So the @ModuleIFace@s persist across calls to @HEP.load@, whereas
-@ModuleDetails@ are reconstructed on every compilation pass.  This
-means that @ModuleIFace@s have the same lifetime as the byte/object
-code, and so should somehow contain their code.
-
-The behind-the-scenes @ModuleIFace@ cache has some kind of holding-pen
-arrangement, to lazify the copying-out of stuff from it, and thus to
-minimise redundant interface reading.  \ToDo{Burble burble.  More
-details.}.
-
-When CM starts working back up the module graph with @compile@, it
-needs to remove from the travelling @FiniteMap@ @ModuleName@
-@ModuleDetails@ the details for all modules in the upward closure of
-the compilation start points.  However, since we're going to visit
-precisely those modules and no others on the way back up, we might as
-well just zap them the old @ModuleDetails@ incrementally.  This does
-mean that the @FiniteMap@ @ModuleName@ @ModuleDetails@ will be
-inconsistent until we reach the top.
-
-In interactive mode, each @compile@ call on a module for which no
-object code is available, or for which it is out of date wrt source,
-emit bytecode into memory, update the resulting @ModuleIFace@ with the
-address of the bytecode image, and link the image.
-
-In batch mode, emit assembly or object code onto disk.  Record
-somewhere \ToDo{where?} that this object file needs to go into the
-final link.
-
-When we reach the top, @compileDone@ is called, to signify that batch
-linking can now proceed, if need be.
-
-Modules in other packages never get a @ModuleIFace@ or @ModuleDetails@
-entry in CM's maps -- those maps are only for modules in this package.
-As previously mentioned, @compile@ may optionally cache @ModuleIFace@s
-for foreign package modules.  When reading such an interface, we don't
-need to read the version info for individual symbols, since foreign
-packages are assumed static.
-
-\subsubsection*{What's in a \mbox{\tt ModuleIFace}?}
-
-Current interface file contents?
-
-
-\subsubsection*{What's in a \mbox{\tt ModuleDetails}?}
-
-There is no global symbol table @:: Name -> ???@.  To look up a
-@Name@, first extract the @ModuleName@ from it, look that up in
-the passed-in @FiniteMap@ @ModuleName@ @ModuleDetails@, 
-and finally look in the relevant @Env@.
-
-\ToDo{Do we still have the @HoldingPen@, or is it now composed from
-per-module bits too?}
-\begin{verbatim}
-data ModuleDetails = ModuleDetails {
-
-        moduleExports :: what it exports (Names)
-                         -- roughly a subset of the .hi file contents
-
-        moduleEnv     :: RdrName -> Name
-                         -- maps top-level entities in this module to
-                         -- globally distinct (Uniq-ified) Names
-  
-        moduleDefs    :: Bag Name -- All the things in the global symbol table
-                                  -- defined by this module
-
-        package       :: Package -- what package am I in?
-
-        lastCompile   :: Date -- of last compilation
-
-        instEnv       :: InstEnv                 -- local inst env
-        typeEnv       :: Name -> TyThing         -- local tycon env?
-   }
-
--- A (globally unique) symbol table entry. Note that Ids contain
--- unfoldings. 
-data TyThing = AClass Class
-             | ATyCon TyCon
-             | AnId Id 
-\end{verbatim}
-What's the stuff in @ModuleDetails@ used for?
-\begin{itemize}
-\item @moduleExports@ so that the stuff which is visible from outside
-      the module can be calculated.
-\item @moduleEnv@: \ToDo{umm err}
-\item @moduleDefs@: one reason we want this is so that we can nuke the
-      global symbol table contribs from this module when it leaves the
-      system.  \ToDo{except ... we don't have a global symbol table any
-      more.}
-\item @package@: we will need to chase arbitrarily deep into the
-      interfaces of other packages.  Of course we don't want to 
-      recompile those, but as we've read their interfaces, we may
-      as well cache that info.  So @package@ indicates whether this
-      module is in the default package, or, if not, which it is in.
-
-      Also, when we come to linking, we'll need to know which
-      packages are demanded, so we know to load their objects.
-
-\item @lastCompile@: When the module was last compiled.  If the 
-      source is older than that, then a recompilation can only be
-      required if children have changed.
-\item @typeEnv@: obvious??
-\item @instEnv@: the instances contributed by this module only.  The
-      Report allegedly says that when a module is translated, the
-      available
-      instance env is all the instances in the downward closure of
-      itself in the module graph.
-      
-      We choose to use this simple representation -- each module 
-      holds just its own instances -- and do the naive thing when
-      creating an inst env for compilation with.  If this turns out
-      to be a performance problem we'll revisit the design.
-\end{itemize}
-
-
-
-%%-----------------------------------------------------------------%%
-\section{Misc text looking for a home}
-
-\subsection*{Linking}
-
-\ToDo{All this linking stuff is now bogus.}
-
-There's an abstract @LinkState@, which is threaded through the linkery
-bits.  CM can call @addpkgs@ to notify the linker of packages
-required, and it can call @addmods@ to announce modules which need to
-be linked.  Finally, CM calls @endlink@, after which an executable
-image should be ready.  The linker may link incrementally, during each
-call of @addpkgs@ and @addmods@, or it can just store up names and do
-all the linking when @endlink@ is called.
-
-In order that incremental linking is possible, CM should specify
-packages and module groups in dependency order, ie, from the bottom up.
-
-\subsection*{In-memory linking of bytecode}
-When being HEP-like, @compile@ will translate sources to bytecodes
-in memory, with all the bytecode for a module as a contiguous lump
-outside the heap.  It needs to communicate the addresses of these
-lumps to the linker.  The linker also needs to know whether a 
-given module is available as in-memory bytecode, or whether it
-needs to load machine code from a file.
-
-I guess @LinkState@ needs to map module names to base addresses
-of their loaded images, + the nature of the image, + whether or not
-the image has been linked.
-
-\subsection*{On disk linking of object code, to give an executable}
-The @LinkState@ in this case is just a list of module and package
-names, which @addpkgs@ and @addmods@ add to.  The final @endlink@
-call can invoke the system linker.
-
-\subsection{Finding out about packages, dependencies, and auxiliary 
-            objects}
-
-Ask the @packages.conf@ file that lives with the driver at the mo.
-
-\ToDo{policy about upward closure?}
-
-
-
-\ToDo{record story about how in memory linking is done.}
-
-\ToDo{linker start/stop/initialisation/persistence.  Need to
-      say more about @LinkState@.}
-
-
-\end{document}
-
-
diff --git a/ghc/docs/rts/closure.ps b/ghc/docs/rts/closure.ps
deleted file mode 100644
index 241bf9b404..0000000000
--- a/ghc/docs/rts/closure.ps
+++ /dev/null
@@ -1,129 +0,0 @@
-%!
-%%Title: closure.fig
-%%Creator: fig2dev
-%%CreationDate: Wed May 28 08:22:23 1997
-%%For: sigbjorn@lassi (Sigbjorn Finne,,,)
-%%Pages: 0
-%%BoundingBox: 0 0 259 171
-%%EndComments
-/$F2psDict 32 dict def 
-$F2psDict begin
-	$F2psDict /mtrx matrix put
-
- /DrawEllipse {
-	/endangle exch def
-	/startangle exch def
-	/yrad exch def
-	/xrad exch def
-	/y exch def
-	/x exch def
-	/savematrix mtrx currentmatrix def
-	x y translate xrad yrad scale 0 0 1 startangle endangle arc
-	savematrix setmatrix
-	} def newpath 0 0 0 0 0 1 DrawEllipse stroke
-
-	end
-	/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def
-	/$F2psEnd {$F2psEnteredState restore end} def
-	%%EndProlog
-
-$F2psBegin
-1 setlinecap 1 setlinejoin
--18 18 translate
-0.000000 171.000000 translate 0.900 -0.900 scale
-1.000 setlinewidth
-% Ellipse
-newpath 57 47 3 3 0 360 DrawEllipse gsave  0.000 setgray fill grestore stroke
-% Polyline
-newpath 57 48 moveto 57 92 lineto 88 92 lineto  stroke
-newpath 80.000 90.000 moveto 88.000 92.000 lineto 80.000 94.000 lineto stroke
-% Polyline
-newpath 184 31 moveto 184 57 lineto  stroke
-% Polyline
-newpath 260 31 moveto 298 31 lineto 298 57 lineto 260 57 lineto  stroke
-	[1 3.000000] 0 setdash
-% Polyline
-newpath 209 31 moveto 260 31 lineto  stroke
-	[] 0 setdash
-	[1 3.000000] 0 setdash
-% Polyline
-newpath 209 57 moveto 260 57 lineto  stroke
-	[] 0 setdash
-% Polyline
-newpath 158 57 moveto 209 57 lineto  stroke
-% Polyline
-newpath 158 31 moveto 209 31 lineto  stroke
-	[1 3.000000] 0 setdash
-% Polyline
-newpath 107 57 moveto 158 57 lineto  stroke
-	[] 0 setdash
-	[1 3.000000] 0 setdash
-% Polyline
-newpath 107 31 moveto 158 31 lineto  stroke
-	[] 0 setdash
-% Polyline
-newpath 107 31 moveto 31 31 lineto 31 57 lineto 107 57 lineto  stroke
-% Polyline
-newpath 95 31 moveto 95 57 lineto  stroke
-% Polyline
-newpath 19 19 moveto 307 19 lineto 307 209 lineto 19 209 lineto closepath  stroke
-% Polyline
-newpath 91 98 moveto 156 98 lineto  stroke
-% Polyline
-newpath 91 113 moveto 156 113 lineto  stroke
-% Polyline
-newpath 92 129 moveto 156 129 lineto  stroke
-% Polyline
-newpath 124 105 moveto 206 105 lineto  stroke
-newpath 198.000 103.000 moveto 206.000 105.000 lineto 198.000 107.000 lineto stroke
-% Polyline
-newpath 91 82 moveto 155 82 lineto 155 147 lineto 91 147 lineto closepath  stroke
-% Polyline
-newpath 124 88 moveto 206 88 lineto  stroke
-newpath 198.000 86.000 moveto 206.000 88.000 lineto 198.000 90.000 lineto stroke
-% Polyline
-newpath 282 167 moveto 282 112 lineto 211 112 lineto 211 167 lineto closepath  stroke
-% Polyline
-newpath 125 138 moveto 125 188 lineto 153 188 lineto  stroke
-newpath 145.000 186.000 moveto 153.000 188.000 lineto 145.000 190.000 lineto stroke
-/Times-Roman findfont 8.000 scalefont setfont
-107 77 moveto 
-1 -1 scale
-(Info table) gsave  0.000 rotate show grestore 1 -1 scale
-/Times-Roman findfont 8.000 scalefont setfont
-104 48 moveto 
-1 -1 scale
-(Pointer words) gsave  0.000 rotate show grestore 1 -1 scale
-/Times-Roman findfont 8.000 scalefont setfont
-209 48 moveto 
-1 -1 scale
-(Non-pointer words) gsave  0.000 rotate show grestore 1 -1 scale
-/Times-Roman findfont 8.000 scalefont setfont
-37 41 moveto 
-1 -1 scale
-(Info pointer) gsave  0.000 rotate show grestore 1 -1 scale
-/Times-Roman findfont 8.000 scalefont setfont
-99 124 moveto 
-1 -1 scale
-(Constructor tag) gsave  0.000 rotate show grestore 1 -1 scale
-/Times-Roman findfont 8.000 scalefont setfont
-215 154 moveto 
-1 -1 scale
-(Size and shape info) gsave  0.000 rotate show grestore 1 -1 scale
-/Times-Roman findfont 8.000 scalefont setfont
-232 163 moveto 
-1 -1 scale
-(for GC) gsave  0.000 rotate show grestore 1 -1 scale
-/Times-Roman findfont 8.000 scalefont setfont
-156 191 moveto 
-1 -1 scale
-(Update code) gsave  0.000 rotate show grestore 1 -1 scale
-/Times-Roman findfont 8.000 scalefont setfont
-213 108 moveto 
-1 -1 scale
-(Representation table) gsave  0.000 rotate show grestore 1 -1 scale
-/Times-Roman findfont 8.000 scalefont setfont
-213 91 moveto 
-1 -1 scale
-(Entry code) gsave  0.000 rotate show grestore 1 -1 scale
-$F2psEnd
diff --git a/ghc/docs/rts/closure.tex b/ghc/docs/rts/closure.tex
deleted file mode 100644
index 572a8516cf..0000000000
--- a/ghc/docs/rts/closure.tex
+++ /dev/null
@@ -1,7 +0,0 @@
-\makebox[3.597in][l]{
-  \vbox to 2.375in{
-    \vfill
-    \special{psfile=closure.ps}
-  }
-  \vspace{-\baselineskip}
-}
diff --git a/ghc/docs/rts/hugs_ret.pstex b/ghc/docs/rts/hugs_ret.pstex
deleted file mode 100644
index 9a7ed98456..0000000000
--- a/ghc/docs/rts/hugs_ret.pstex
+++ /dev/null
@@ -1,145 +0,0 @@
-%!PS-Adobe-2.0 EPSF-2.0
-%%Title: /tmp/xfig-fig007314
-%%Creator: fig2dev Version 3.1 Patchlevel 2
-%%CreationDate: Wed Oct 15 13:06:42 1997
-%%For: simonm@solander.dcs.gla.ac.uk (Simon Marlow,SM,,,,OCT99, )
-%%Orientation: Portrait
-%%BoundingBox: 0 0 204 214
-%%Pages: 0
-%%BeginSetup
-%%IncludeFeature: *PageSize Letter
-%%EndSetup
-%Magnification: 0.80
-%%EndComments
-/$F2psDict 200 dict def
-$F2psDict begin
-$F2psDict /mtrx matrix put
-/col-1 {0 setgray} bind def
-/col0 {0.000 0.000 0.000 srgb} bind def
-/col1 {0.000 0.000 1.000 srgb} bind def
-/col2 {0.000 1.000 0.000 srgb} bind def
-/col3 {0.000 1.000 1.000 srgb} bind def
-/col4 {1.000 0.000 0.000 srgb} bind def
-/col5 {1.000 0.000 1.000 srgb} bind def
-/col6 {1.000 1.000 0.000 srgb} bind def
-/col7 {1.000 1.000 1.000 srgb} bind def
-/col8 {0.000 0.000 0.560 srgb} bind def
-/col9 {0.000 0.000 0.690 srgb} bind def
-/col10 {0.000 0.000 0.820 srgb} bind def
-/col11 {0.530 0.810 1.000 srgb} bind def
-/col12 {0.000 0.560 0.000 srgb} bind def
-/col13 {0.000 0.690 0.000 srgb} bind def
-/col14 {0.000 0.820 0.000 srgb} bind def
-/col15 {0.000 0.560 0.560 srgb} bind def
-/col16 {0.000 0.690 0.690 srgb} bind def
-/col17 {0.000 0.820 0.820 srgb} bind def
-/col18 {0.560 0.000 0.000 srgb} bind def
-/col19 {0.690 0.000 0.000 srgb} bind def
-/col20 {0.820 0.000 0.000 srgb} bind def
-/col21 {0.560 0.000 0.560 srgb} bind def
-/col22 {0.690 0.000 0.690 srgb} bind def
-/col23 {0.820 0.000 0.820 srgb} bind def
-/col24 {0.500 0.190 0.000 srgb} bind def
-/col25 {0.630 0.250 0.000 srgb} bind def
-/col26 {0.750 0.380 0.000 srgb} bind def
-/col27 {1.000 0.500 0.500 srgb} bind def
-/col28 {1.000 0.630 0.630 srgb} bind def
-/col29 {1.000 0.750 0.750 srgb} bind def
-/col30 {1.000 0.880 0.880 srgb} bind def
-/col31 {1.000 0.840 0.000 srgb} bind def
-
-end
-save
--42.0 271.0 translate
-1 -1 scale
-
-/cp {closepath} bind def
-/ef {eofill} bind def
-/gr {grestore} bind def
-/gs {gsave} bind def
-/sa {save} bind def
-/rs {restore} bind def
-/l {lineto} bind def
-/m {moveto} bind def
-/rm {rmoveto} bind def
-/n {newpath} bind def
-/s {stroke} bind def
-/sh {show} bind def
-/slc {setlinecap} bind def
-/slj {setlinejoin} bind def
-/slw {setlinewidth} bind def
-/srgb {setrgbcolor} bind def
-/rot {rotate} bind def
-/sc {scale} bind def
-/sd {setdash} bind def
-/ff {findfont} bind def
-/sf {setfont} bind def
-/scf {scalefont} bind def
-/sw {stringwidth} bind def
-/tr {translate} bind def
-/tnt {dup dup currentrgbcolor
-  4 -2 roll dup 1 exch sub 3 -1 roll mul add
-  4 -2 roll dup 1 exch sub 3 -1 roll mul add
-  4 -2 roll dup 1 exch sub 3 -1 roll mul add srgb}
-  bind def
-/shd {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll mul
-  4 -2 roll mul srgb} bind def
-/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def
-/$F2psEnd {$F2psEnteredState restore end} def
-%%EndProlog
-
-$F2psBegin
-10 setmiterlimit
-n 0 792 m 0 0 l 612 0 l 612 792 l cp clip
- 0.04800 0.04800 sc
-/Helvetica ff 180.00 scf sf
-3405 3885 m
-gs 1 -1 sc (Info) col-1 sh gr
-7.500 slw
-% Polyline
-n 900 3000 m 2100 3000 l gs col-1 s gr 
-% Polyline
-n 900 2700 m 2100 2700 l gs col-1 s gr 
-% Polyline
-gs  clippath
-3003 4545 m 3123 4575 l 3003 4605 l 3165 4605 l 3165 4545 l  cp clip
-n 1425 3150 m 2550 3150 l 2550 4575 l 3150 4575 l gs col-1 s gr gr
-
-% arrowhead
-n 3003 4545 m 3123 4575 l 3003 4605 l  col-1 s
-% Polyline
- [15 50.0] 50.0 sd
-n 3150 4575 m 3150 5625 l gs col-1 s gr  [] 0 sd
-% Polyline
-n 3150 4575 m 3975 4575 l 3975 3600 l 3150 3600 l cp gs col-1 s gr 
-% Polyline
- [15 50.0] 50.0 sd
-n 3975 4575 m 3975 5625 l gs col-1 s gr  [] 0 sd
-% Polyline
-gs  clippath
-3003 2820 m 3123 2850 l 3003 2880 l 3165 2880 l 3165 2820 l  cp clip
-n 1425 2850 m 3150 2850 l gs col-1 s gr gr
-
-% arrowhead
-n 3003 2820 m 3123 2850 l 3003 2880 l  col-1 s
-% Polyline
-n 3150 2700 m 4500 2700 l 4500 3075 l 3150 3075 l cp gs col-1 s gr 
-/Helvetica ff 180.00 scf sf
-3585 2955 m
-gs 1 -1 sc (BCO) col-1 sh gr
-/Helvetica ff 180.00 scf sf
-1170 1530 m
-gs 1 -1 sc (Stack) col-1 sh gr
-/Helvetica ff 180.00 scf sf
-3300 4125 m
-gs 1 -1 sc (Table) col-1 sh gr
-/Helvetica ff 180.00 scf sf
-3315 5070 m
-gs 1 -1 sc (Code) col-1 sh gr
-/Helvetica ff 180.00 scf sf
-4140 4650 m
-gs 1 -1 sc (HUGS_RET) col-1 sh gr
-% Polyline
-n 900 1200 m 900 3300 l 2100 3300 l 2100 1200 l gs col-1 s gr 
-$F2psEnd
-rs
diff --git a/ghc/docs/rts/hugs_ret.pstex_t b/ghc/docs/rts/hugs_ret.pstex_t
deleted file mode 100644
index 3b844da3f0..0000000000
--- a/ghc/docs/rts/hugs_ret.pstex_t
+++ /dev/null
@@ -1,13 +0,0 @@
-\begin{picture}(0,0)%
-\epsfig{file=hugs_ret.pstex}%
-\end{picture}%
-\setlength{\unitlength}{0.00066700in}%
-%
-\begingroup\makeatletter\ifx\SetFigFont\undefined%
-\gdef\SetFigFont#1#2#3#4#5{%
-  \reset@font\fontsize{#1}{#2pt}%
-  \fontfamily{#3}\fontseries{#4}\fontshape{#5}%
-  \selectfont}%
-\fi\endgroup%
-\begin{picture}(3624,4449)(889,-4798)
-\end{picture}
diff --git a/ghc/docs/rts/hugs_ret2.pstex b/ghc/docs/rts/hugs_ret2.pstex
deleted file mode 100644
index 74d081c40c..0000000000
--- a/ghc/docs/rts/hugs_ret2.pstex
+++ /dev/null
@@ -1,130 +0,0 @@
-%!PS-Adobe-2.0 EPSF-2.0
-%%Title: /tmp/xfig-fig007314
-%%Creator: fig2dev Version 3.1 Patchlevel 2
-%%CreationDate: Wed Oct 15 13:18:31 1997
-%%For: simonm@solander.dcs.gla.ac.uk (Simon Marlow,SM,,,,OCT99, )
-%%Orientation: Portrait
-%%BoundingBox: 0 0 185 139
-%%Pages: 0
-%%BeginSetup
-%%IncludeFeature: *PageSize Letter
-%%EndSetup
-%Magnification: 0.80
-%%EndComments
-/$F2psDict 200 dict def
-$F2psDict begin
-$F2psDict /mtrx matrix put
-/col-1 {0 setgray} bind def
-/col0 {0.000 0.000 0.000 srgb} bind def
-/col1 {0.000 0.000 1.000 srgb} bind def
-/col2 {0.000 1.000 0.000 srgb} bind def
-/col3 {0.000 1.000 1.000 srgb} bind def
-/col4 {1.000 0.000 0.000 srgb} bind def
-/col5 {1.000 0.000 1.000 srgb} bind def
-/col6 {1.000 1.000 0.000 srgb} bind def
-/col7 {1.000 1.000 1.000 srgb} bind def
-/col8 {0.000 0.000 0.560 srgb} bind def
-/col9 {0.000 0.000 0.690 srgb} bind def
-/col10 {0.000 0.000 0.820 srgb} bind def
-/col11 {0.530 0.810 1.000 srgb} bind def
-/col12 {0.000 0.560 0.000 srgb} bind def
-/col13 {0.000 0.690 0.000 srgb} bind def
-/col14 {0.000 0.820 0.000 srgb} bind def
-/col15 {0.000 0.560 0.560 srgb} bind def
-/col16 {0.000 0.690 0.690 srgb} bind def
-/col17 {0.000 0.820 0.820 srgb} bind def
-/col18 {0.560 0.000 0.000 srgb} bind def
-/col19 {0.690 0.000 0.000 srgb} bind def
-/col20 {0.820 0.000 0.000 srgb} bind def
-/col21 {0.560 0.000 0.560 srgb} bind def
-/col22 {0.690 0.000 0.690 srgb} bind def
-/col23 {0.820 0.000 0.820 srgb} bind def
-/col24 {0.500 0.190 0.000 srgb} bind def
-/col25 {0.630 0.250 0.000 srgb} bind def
-/col26 {0.750 0.380 0.000 srgb} bind def
-/col27 {1.000 0.500 0.500 srgb} bind def
-/col28 {1.000 0.630 0.630 srgb} bind def
-/col29 {1.000 0.750 0.750 srgb} bind def
-/col30 {1.000 0.880 0.880 srgb} bind def
-/col31 {1.000 0.840 0.000 srgb} bind def
-
-end
-save
--28.0 181.0 translate
-1 -1 scale
-
-/cp {closepath} bind def
-/ef {eofill} bind def
-/gr {grestore} bind def
-/gs {gsave} bind def
-/sa {save} bind def
-/rs {restore} bind def
-/l {lineto} bind def
-/m {moveto} bind def
-/rm {rmoveto} bind def
-/n {newpath} bind def
-/s {stroke} bind def
-/sh {show} bind def
-/slc {setlinecap} bind def
-/slj {setlinejoin} bind def
-/slw {setlinewidth} bind def
-/srgb {setrgbcolor} bind def
-/rot {rotate} bind def
-/sc {scale} bind def
-/sd {setdash} bind def
-/ff {findfont} bind def
-/sf {setfont} bind def
-/scf {scalefont} bind def
-/sw {stringwidth} bind def
-/tr {translate} bind def
-/tnt {dup dup currentrgbcolor
-  4 -2 roll dup 1 exch sub 3 -1 roll mul add
-  4 -2 roll dup 1 exch sub 3 -1 roll mul add
-  4 -2 roll dup 1 exch sub 3 -1 roll mul add srgb}
-  bind def
-/shd {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll mul
-  4 -2 roll mul srgb} bind def
-/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def
-/$F2psEnd {$F2psEnteredState restore end} def
-%%EndProlog
-
-$F2psBegin
-10 setmiterlimit
-n 0 792 m 0 0 l 612 0 l 612 792 l cp clip
- 0.04800 0.04800 sc
-/Helvetica ff 180.00 scf sf
-975 1350 m
-gs 1 -1 sc (Stack) col-1 sh gr
-7.500 slw
-% Polyline
-n 600 3000 m 1800 3000 l gs col-1 s gr 
-% Polyline
-n 600 2700 m 1800 2700 l gs col-1 s gr 
-% Polyline
-gs  clippath
-2928 3495 m 3048 3525 l 2928 3555 l 3090 3555 l 3090 3495 l  cp clip
-n 1200 3150 m 2400 3150 l 2400 3525 l 3075 3525 l gs col-1 s gr gr
-
-% arrowhead
-n 2928 3495 m 3048 3525 l 2928 3555 l  col-1 s
-% Polyline
-gs  clippath
-2928 2820 m 3048 2850 l 2928 2880 l 3090 2880 l 3090 2820 l  cp clip
-n 1200 2850 m 3075 2850 l gs col-1 s gr gr
-
-% arrowhead
-n 2928 2820 m 3048 2850 l 2928 2880 l  col-1 s
-% Polyline
-n 3075 2700 m 4425 2700 l 4425 3075 l 3075 3075 l cp gs col-1 s gr 
-% Polyline
-n 3075 3375 m 4425 3375 l 4425 3750 l 3075 3750 l cp gs col-1 s gr 
-/Helvetica ff 180.00 scf sf
-3555 2955 m
-gs 1 -1 sc (BCO) col-1 sh gr
-/Helvetica ff 180.00 scf sf
-3195 3630 m
-gs 1 -1 sc (Return Value) col-1 sh gr
-% Polyline
-n 600 900 m 600 3300 l 1800 3300 l 1800 900 l gs col-1 s gr 
-$F2psEnd
-rs
diff --git a/ghc/docs/rts/hugs_ret2.pstex_t b/ghc/docs/rts/hugs_ret2.pstex_t
deleted file mode 100644
index 13208a3de1..0000000000
--- a/ghc/docs/rts/hugs_ret2.pstex_t
+++ /dev/null
@@ -1,13 +0,0 @@
-\begin{picture}(0,0)%
-\epsfig{file=hugs_ret2.pstex}%
-\end{picture}%
-\setlength{\unitlength}{0.00066700in}%
-%
-\begingroup\makeatletter\ifx\SetFigFont\undefined%
-\gdef\SetFigFont#1#2#3#4#5{%
-  \reset@font\fontsize{#1}{#2pt}%
-  \fontfamily{#3}\fontseries{#4}\fontshape{#5}%
-  \selectfont}%
-\fi\endgroup%
-\begin{picture}(3849,2874)(589,-2923)
-\end{picture}
diff --git a/ghc/docs/rts/rts.tex b/ghc/docs/rts/rts.tex
deleted file mode 100644
index 158ae7e79a..0000000000
--- a/ghc/docs/rts/rts.tex
+++ /dev/null
@@ -1,4683 +0,0 @@
-%
-% (c) The OBFUSCATION-THROUGH-GRATUITOUS-PREPROCESSOR-ABUSE Project,
-%     Glasgow University, 1990-1994
-%
-
-% TODO:
-%
-% o I (ADR) think it would be worth making the connection with CPS explicit.
-%   Now that we have explicit activation records (on the stack), we can
-%   explain the whole system in terms of CPS and tail calls --- with the
-%   one requirement that we carefuly distinguish stack-allocated objects
-%   from heap-allocated objects.
-
-% \documentstyle[preprint]{acmconf}
-\documentclass[11pt]{article}
-\oddsidemargin 0.1 in       %   Note that \oddsidemargin = \evensidemargin
-\evensidemargin 0.1 in
-\marginparwidth 0.85in    %   Narrow margins require narrower marginal notes
-\marginparsep 0 in 
-\sloppy
-
-%\usepackage{epsfig}
-\usepackage{shortvrb}
-\MakeShortVerb{\@}
-
-%\newcommand{\note}[1]{{\em Note: #1}}
-\newcommand{\note}[1]{{{\bf Note:}\sl #1}}
-\newcommand{\ToDo}[1]{{{\bf ToDo:}\sl #1}}
-\newcommand{\Arg}[1]{\mbox{${\tt arg}_{#1}$}}
-\newcommand{\bottom}{\perp}
-
-\newcommand{\secref}[1]{Section~\ref{sec:#1}}
-\newcommand{\figref}[1]{Figure~\ref{fig:#1}}
-\newcommand{\Section}[2]{\section{#1}\label{sec:#2}}
-\newcommand{\Subsection}[2]{\subsection{#1}\label{sec:#2}}
-\newcommand{\Subsubsection}[2]{\subsubsection{#1}\label{sec:#2}}
-
-% DIMENSION OF TEXT:
-\textheight 8.5 in
-\textwidth 6.25 in
-
-\topmargin 0 in
-\headheight 0 in
-\headsep .25 in
-
-
-\setlength{\parskip}{0.15cm}
-\setlength{\parsep}{0.15cm}
-\setlength{\topsep}{0cm}	% Reduces space before and after verbatim,
-				% which is implemented using trivlist 
-\setlength{\parindent}{0cm}
-
-\renewcommand{\textfraction}{0.2}
-\renewcommand{\floatpagefraction}{0.7}
-
-\begin{document}
-
-\title{The STG runtime system (revised)}
-\author{Simon Peyton Jones \\ Microsoft Research Ltd., Cambridge \and
-Simon Marlow \\ Microsoft Research Ltd., Cambridge \and
-Alastair Reid \\ Yale University} 
-
-\maketitle
-
-\tableofcontents
-\newpage
-
-\part{Introduction}
-\Section{Overview}{overview}
-
-This document describes the GHC/Hugs run-time system.  It serves as 
-a Glasgow/Yale/Nottingham ``contract'' about what the RTS does.
-
-\Subsection{New features compared to GHC 3.xx}{new-features}
-
-\begin{itemize}
-\item The RTS supports mixed compiled/interpreted execution, so
-that a program can consist of a mixture of GHC-compiled and Hugs-interpreted
-code.
-
-\item The RTS supports concurrency by default.
-This has some costs (eg we can't do hardware stack checks) but
-reduces the number of different configurations we need to support.
-
-\item CAFs are only retained if they are
-reachable.  Since they are referred to by implicit references buried
-in code, this means that the garbage collector must traverse the whole
-accessible code tree.  This feature eliminates a whole class of painful
-space leaks.
-
-\item A running thread has only one stack, which contains a mixture of
-pointers and non-pointers.  \secref{TSO} describes how we find out
-which is which.  (GHC has used two stacks for some while.  Using one
-stack instead of two reduces register pressure, reduces the size of
-update frames, and eliminates ``stack-stubbing'' instructions.)
-
-\item The ``return in registers'' return convention has been dropped
-because it was complicated and doesn't work well on register-poor
-architectures.  It has been partly replaced by unboxed tuples
-(\secref{unboxed-tuples}) which allow the programmer to
-explicitly state where results should be returned in registers (or on
-the stack) instead of on the heap.
-
-\item Exceptions are supported by the RTS.
-
-\item Weak Pointers generalise the previously available Foreign Object
-interface.
-
-\item The garbage collector supports a number of new features,
-including a dynamically resizable heap and multiple generations with
-aging within a generation.
-
-\end{itemize}
-
-\Subsection{Wish list}{wish-list}
-
-Here's a list of things we'd like to support in the future.
-\begin{itemize}
-\item Interrupts, speculative computation.
-
-\item
-The SM could tune the size of the allocation arena, the number of
-generations, etc taking into account residency, GC rate and page fault
-rate.
-
-\item 
-We could trigger a GC when all threads are blocked waiting for IO if
-the allocation arena (or some of the generations) are nearly full.
-
-\end{itemize}
-
-\Subsection{Configuration}{configuration}
-
-Some of the above features are expensive or less portable, so we
-envision building a number of different configurations supporting
-different subsets of the above features.
-
-You can make the following choices:
-\begin{itemize}
-\item
-Support for parallelism.  There are three mutually-exclusive choices.
-
-\begin{description}
-\item[@SEQUENTIAL@] Support for concurrency but not for parallelism.
-\item[@GRANSIM@]    Concurrency support and simulated parallelism.
-\item[@PARALLEL@]   Concurrency support and real parallelism.
-\end{description}
-
-\item @PROFILING@ adds cost-centre profiling.
-
-\item @TICKY@ gathers internal statistics (often known as ``ticky-ticky'' code).
-
-\item @DEBUG@ does internal consistency checks.
-
-\item Persistence. (well, not yet).
-
-\item
-Which garbage collector to use.  At the moment we
-only anticipate one, however.
-\end{itemize}
-
-\Subsection{Glossary}{glossary}
-
-\ToDo{This terminology is not used consistently within the document.
-If you find something which disagrees with this terminology, fix the
-usage.}
-
-In the type system, we have boxed and unboxed types.
-
-\begin{itemize}
-
-\item A \emph{pointed} type is one that contains $\bot$.  Variables with
-pointed types are the only things which can be lazily evaluated.  In
-the STG machine, this means that they are the only things that can be 
-\emph{entered} or \emph{updated} and it requires that they be boxed.
-
-\item An \emph{unpointed} type is one that does not contain $\bot$.
-Variables with unpointed types are never delayed --- they are always
-evaluated when they are constructed.  In the STG machine, this means
-that they cannot be \emph{entered} or \emph{updated}.  Unpointed objects
-may be boxed (like @Array#@) or unboxed (like @Int#@).
-
-\end{itemize}
-
-In the implementation, we have different kinds of objects:
-
-\begin{itemize}
-
-\item \emph{boxed} objects are heap objects used by the evaluators
-
-\item \emph{unboxed} objects are not heap allocated
-
-\item \emph{stack} objects are allocated on the stack
-
-\item \emph{closures} are objects which can be \emph{entered}. 
-They are always boxed and always have boxed types.
-They may be in WHNF or they may be unevaluated.  
-
-\item A \emph{thunk} is a (representation of) a value of a \emph{pointed}
-type which is \emph{not} in WHNF.
-
-\item A \emph{value} is an object in WHNF.  It can be pointed or unpointed.
-
-\end{itemize}
-
-
-
-At the hardware level, we have \emph{word}s and \emph{pointer}s.
-
-\begin{itemize}
-
-\item A \emph{word} is (at least) 32 bits and can hold either a signed
-or an unsigned int.
-
-\item A \emph{pointer} is (at least) 32 bits and big enough to hold a
-function pointer or a data pointer.  
-
-\end{itemize}
-
-Occasionally, a field of a data structure must hold either a word or a
-pointer.  In such circumstances, it is \emph{not safe} to assume that
-words and pointers are the same size.  \ToDo{GHC currently makes words
-the same size as pointers to reduce complexity in the code
-generator/RTS.  It would be useful to relax this restriction, and have
-eg. 32-bit Ints on a 64-bit machine.}
-
-% should define terms like SRT, CAF, PAP, etc. here?  --KSW 1999-03
-
-\subsection{Subtle Dependencies}
-
-Some decisions have very subtle consequences which should be written
-down in case we want to change our minds.  
-
-\begin{itemize}
-
-\item
-
-If the garbage collector is allowed to shrink the stack of a thread,
-we cannot omit the stack check in return continuations
-(\secref{heap-and-stack-checks}).
-
-\item
-
-When we return to the scheduler, the top object on the stack is a closure.
-The scheduler restarts the thread by entering the closure.
-
-\secref{hugs-return-convention} discusses how Hugs returns an
-unboxed value to GHC and how GHC returns an unboxed value to Hugs.
-
-\item 
-
-When we return to the scheduler, we need a few empty words on the stack
-to store a closure to reenter.  \secref{heap-and-stack-checks}
-discusses who does the stack check and how much space they need.
-
-\item
-
-Heap objects never contain slop --- this is required if we want to
-support mostly-copying garbage collection.
-
-This is a big problem when updating since the updatee is usually
-bigger than an indirection object.  The fix is to overwrite the end of
-the updatee with ``slop objects'' (described in
-\secref{slop-objects}).  This is hard to arrange if we do
-\emph{lazy} blackholing (\secref{lazy-black-holing}) so we
-currently plan to blackhole an object when we push the update frame.
-
-% Idea: have specialised update code for various common sizes of
-% updatee, the update frame hence encodes the length of the object.
-% Specialised indirections will also encode the length of the object.  A
-% generic version of the update code will overwrite the slop with a slop
-% object.  We can do the same thing for blackhole objects, or just have
-% a generic version that is the same size as an indirection and
-% overwrite the slop with a slop object when blackholing.  So: does this
-% avoid the need to do eager black holing?
-
-\item
-
-Info tables for constructors contain enough information to decide which
-return convention they use.  This allows Hugs to use a single piece of
-entry code for all constructors and insulates Hugs from changes in the
-choice of return convention.
-
-\end{itemize}
-
-\Section{Source Language}{source-language}
-
-\Subsection{Explicit Allocation}{explicit-allocation}
-
-As in the original STG machine, (almost) all heap allocation is caused
-by executing a let(rec).  Since we no longer support the return in
-registers convention for data constructors, constructors now cause heap
-allocation and so they should be let-bound.
-
-For example, we now write
-\begin{verbatim}
-> cons = \ x xs -> let r = (:) x xs in r
-@
-instead of
-\begin{verbatim}
-> cons = \ x xs -> (:) x xs
-\end{verbatim}
-
-\note{For historical reasons, GHC doesn't use this syntax --- but it should.}
-
-\Subsection{Unboxed tuples}{unboxed-tuples}
-
-Functions can take multiple arguments as easily as they can take one
-argument: there's no cost for adding another argument.  But functions
-can only return one result: the cost of adding a second ``result'' is
-that the function must construct a tuple of ``results'' on the heap.
-The assymetry is rather galling and can make certain programming
-styles quite expensive.  For example, consider a simple state transformer
-monad:
-\begin{verbatim}
-> type S a     = State -> (a,State)
-> bindS m k s0 = case m s0 of { (a,s1) -> k a s1 }
-> returnS a s  = (a,s)
-> getS s       = (s,s)
-> setS s _     = ((),s)
-\end{verbatim}
-Here, every use of @returnS@, @getS@ or @setS@ constructs a new tuple
-in the heap which is instantly taken apart (and becomes garbage) by
-the case analysis in @bind@.  Even a short state-transformer program
-will construct a lot of these temporary tuples.
-
-Unboxed tuples provide a way for the programmer to indicate that they
-do not expect a tuple to be shared and that they do not expect it to
-be allocated in the heap.  Syntactically, unboxed tuples are just like
-single constructor datatypes except for the annotation @unboxed@.
-\begin{verbatim}
-> data unboxed AAndState# a = AnS a State
-> type S a = State -> AAndState# a
-> bindS m k s0 = case m s0 of { AnS a s1 -> k a s1 }
-> returnS a s  = AnS a s
-> getS s       = AnS s s
-> setS s _     = AnS () s
-\end{verbatim}
-Semantically, unboxed tuples are just unlifted tuples and are subject
-to the same restrictions as other unpointed types.
-
-Operationally, unboxed tuples are never built on the heap.  When
-an unboxed tuple is returned, it is returned in multiple registers
-or multiple stack slots.  At first sight, this seems a little strange
-but it's no different from passing double precision floats in two
-registers.
-
-Notes:
-\begin{itemize}
-\item
-Unboxed tuples can only have one constructor and that
-thunks never have unboxed types --- so we'll never try to update an
-unboxed constructor.  The restriction to a single constructor is
-largely to avoid garbage collection complications.
-
-\item
-The core syntax does not allow variables to be bound to
-unboxed tuples (ie in default case alternatives or as function arguments)
-and does not allow unboxed tuples to be fields of other constructors.
-However, there's no harm in allowing it in the source syntax as a
-convenient, but easily removed, syntactic sugar.
-
-\item
-The compiler generates a closure of the form
-\begin{verbatim}
-> c = \ x y z -> C x y z
-\end{verbatim}
-for every constructor (whether boxed or unboxed).  
-
-This closure is normally used during desugaring to ensure that
-constructors are saturated and to apply any strictness annotations.
-They are also used when returning unboxed constructors to the machine
-code evaluator from the bytecode evaluator and when a heap check fails
-in a return continuation for an unboxed-tuple scrutinee.
-
-\end{itemize}
-
-\Subsection{STG Syntax}{stg-syntax}
-
-
-\ToDo{Insert STG syntax with appropriate changes.}
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\part{System Overview}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-This part is concerned with defining the external interfaces of the
-major components of the system; the next part is concerned with their
-inner workings.
-
-The major components of the system are:
-\begin{itemize}
-
-\item 
-
-The evaluators (\secref{sm-overview}) are responsible for
-evaluating heap objects.  The system supports two evaluators: the
-machine code evaluator; and the bytecode evaluator.
-
-\item 
-
-The scheduler (\secref{scheduler-overview}) acts as the
-coordinator for the whole system.  It is responsible for switching
-between evaluators, switching between threads, garbage collection,
-communication between multiple processors, etc.
-
-\item 
-
-The storage manager (\secref{evaluators-overview}) is
-responsible for allocating blocks of contiguous memory and for garbage
-collection.
-
-\item 
-
-The loader (\secref{loader-overview}) is responsible for
-loading machine code and bytecode files from the file system and for
-resolving references between separately compiled modules.
-
-\item 
-
-The compilers (\secref{compilers-overview}) generate machine
-code and bytecode files which can be loaded by the loader.
-
-\end{itemize}
-
-\ToDo{Insert diagram showing all components underneath the scheduler
-and communicating only with the scheduler}
-
-
-\Section{The Evaluators}{evaluators-overview}
-
-There are two evaluators: a machine code evaluator and a bytecode
-evaluator.  The evaluators task is to evaluate code within a thread
-until one of the following happens:
-
-\begin{itemize}
-\item heap overflow
-\item stack overflow
-\item it is preempted
-\item it blocks in one of the concurrency primitives
-\item it performs a safe ccall
-\item it needs to switch to the other evaluator.
-\end{itemize}
-
-The evaluators expect to find a closure on top of the thread's stack
-and terminate with a closure on top of the thread's stack.
-
-\Subsection{Evaluation Model}{evaluation-model}
-
-Whilst the evaluators differ internally, they share a common
-evaluation model and many object representations.
-
-\Subsubsection{Heap objects}{heap-objects-overview}
-
-The choice of heap and stack objects used by the evaluators is tightly
-bound to the evaluation model.  This section provides an overview of
-the most important heap and stack objects; further details are given
-later.
-
-All heap objects look like this:
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-\emph{Header} & \emph{Payload} \\ \hline
-\end{tabular}
-\end{center}
-
-The headers vary between different kinds of object but they all start
-with a pointer to a pair consisting of an \emph{info table} and some
-\emph{entry code}.  The info table is used both by the evaluators and
-by the storage manager and contains a @type@ field which identifies
-which kind of heap object uses it and determines the interpretation of
-the payload and of the other fields of the info table.  The entry code
-is some machine code used by the machine code evaluator to evaluate
-closures and raises an error for other kinds of objects.
-
-The major kinds of heap object used are as follows.  (For simplicity,
-this description omits certain optimisations and extra fields required
-by the garbage collector.)
-
-\begin{description}
-
-\item[Constructors] are used to represent data constructors.  Their
-payload consists of the fields of the constructor; the tag of the
-constructor is stored in the info table.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@CONSTR@ & \emph{Fields} \\ \hline
-\end{tabular}
-\end{center}
-
-\item[Primitive objects] are used to represent objects with unlifted
-types which are too large to fit in a register (or stack slot) or for
-which sharing must be preserved.  Primitive objects include large
-objects such as multiple precision integers and immutable arrays and
-mutable objects such as mutable arrays, mutable variables, MVar's,
-IVar's and foreign object pointers.  Since primitive objects are not
-lifted, they cannot be entered.  Their payload varies according to the
-kind of object.
-
-\item[Function closures] are used to represent functions.  Their
-payload (if any) consists of the free variables of the function.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@FUN@ & \emph{Free Variables} \\ \hline
-\end{tabular}
-\end{center}
-
-Function closures are only generated by the machine code compiler.
-
-\item[Thunks] are used to represent unevaluated expressions which will
-be updated with their result.  Their payload (if any) consists of the
-free variables of the function.  The entry code for a thunk starts by
-pushing an \emph{update frame} onto the stack.  When evaluation of the
-thunk completes, the update frame will cause the thunk to be
-overwritten again with an \emph{indirection} to the result of the
-thunk, which is always a constructor or a partial application.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@THUNK@ & \emph{Free Variables} \\ \hline
-\end{tabular}
-\end{center}
-
-Thunks are only generated by the machine code evaluator.
-
-\item[Byte-code Objects (@BCO@s)] are generated by the bytecode
-compiler.  In conjunction with \emph{updatable applications} and
-\emph{non-updatable applications} they are used to represent
-functions, unevaluated expressions and return addresses.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@BCO@ & \emph{Constant Pool} & \emph{Bytecodes} \\ \hline
-\end{tabular}
-\end{center}
-
-\item[Non-updatable (Partial) Applications] are used to represent the
-application of a function to an insufficient number of arguments.
-Their payload consists of the function and the arguments received so far.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@PAP@ & \emph{Function Closure} & \emph{Arguments} \\ \hline
-\end{tabular}
-\end{center}
-
-@PAP@s are used when a function is applied to too few arguments and by
-code generated by the lambda-lifting phase of the bytecode compiler.
-
-\item[Updatable Applications] are used to represent the application of
-a function to a sufficient number of arguments.  Their payload
-consists of the function and its arguments.  
-
-Updateable applications are like thunks: on entering an updateable
-application, the evaluators push an \emph{update frame} onto the stack
-and overwrite the application with a \emph{black hole}; when
-evaluation completes, the evaluators overwrite the application with an
-\emph{indirection} to the result of the application.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@AP@ & \emph{Function Closure} & \emph{Arguments} \\ \hline
-\end{tabular}
-\end{center}
-
-@AP@s are only generated by the bytecode compiler.
-
-\item[Black holes] are used to mark updateable closures which are
-currently being evaluated.  ``Black holing'' an object cures a
-potential space leak and detects certain classes of infinite loops.
-More imporantly, black holes act as synchronisation objects between
-separate threads: if a second thread tries to enter an updateable
-closure which is already being evaluated, the second thread is added
-to a list of blocked threads and the thread is suspended.
-
-When evaluation of the black-holed closure completes, the black hole
-is overwritten with an indirection to the result of the closure and
-any blocked threads are restored to the runnable queue.
-
-Closures are overwritten by black-holes during a ``lazy black-holing''
-phase which runs on each thread when it returns to the scheduler.
-\ToDo{section describing lazy black-holing}.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@BLACKHOLE@ & \emph{Blocked threads} \\ \hline
-\end{tabular}
-\end{center}
-
-\ToDo{In a single threaded system, it's trivial to detect infinite
-loops: reentering a BLACKHOLE is always an error.  How easy is it in a
-multi-threaded system?}
-
-\item[Indirections] are used to update an unevaluated closure with its
-(usually fully evaluated) result in situations where it isn't possible
-to perform an update in place.  (In the current system, we always
-update with an indirection to avoid duplicating the result when doing
-an update in place.)
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@IND@ & \emph{Closure} \\ \hline
-\end{tabular}
-\end{center}
-
-Indirections needn't always point to a closure in WHNF.  They can
-point to a chain of indirections which point to an evaluated closure.
-
-\item[Thread State Objects (@TSO@s)] represent Haskell threads.  Their
-payload consists of some per-thread information such as the Thread ID
-and the status of the thread (runnable, blocked etc.), and the
-thread's stack.  See @TSO.h@ for the full story.  @TSO@s may be
-resized by the scheduler if its stack is too small or too large.
-
-The thread stack grows downwards from higher to lower addresses.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@TSO@ & \emph{Thread info} & \emph{Stack} \\ \hline
-\end{tabular}
-\end{center}
-
-\end{description}
-
-\Subsubsection{Stack objects}{stack-objects-overview}
-
-The stack contains a mixture of \emph{pending arguments} and 
-\emph{stack objects}.
-
-Pending arguments are arguments to curried functions which have not
-yet been incorporated into an activation frame.  For example, when
-evaluating @let { g x y = x + y; f x = g{x} } in f{3,4}@, the
-evaluator pushes both arguments onto the stack and enters @f@.  @f@
-only requires one argument so it leaves the second argument as a
-\emph{pending argument}.  The pending argument remains on the stack
-until @f@ calls @g@ which requires two arguments: the argument passed
-to it by @f@ and the pending argument which was passed to @f@.
-
-Unboxed pending arguments are always preceeded by a ``tag'' which says
-how large the argument is.  This allows the garbage collector to
-locate pointers within the stack.
-
-There are three kinds of stack object: return addresses, update frames
-and seq frames.  All stack objects look like this
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-\emph{Header} & \emph{Payload} \\ \hline
-\end{tabular}
-\end{center}
-
-As with heap objects, the header starts with a pointer to a pair
-consisting of an \emph{info table} and some \emph{entry code}.
-
-\begin{description}
-
-\item[Return addresses] are used to cause selection and execution of
-case alternatives when a constructor is returned.  Return addresses
-generated by the machine code compiler look like this:
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@RET_XXX@ & \emph{Free Variables of the case alternatives} \\ \hline
-\end{tabular}
-\end{center}
-
-The free variables are a mixture of pointers and non-pointers whose
-layout is described by a bitmask in the info table.
-
-There are several kinds of @RET_XXX@ return address - see
-\secref{activation-records} for the details.
-
-Return addresses generated by the bytecode compiler look like this:
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@BCO_RET@ & \emph{BCO} & \emph{Free Variables of the case alternatives} \\ \hline
-\end{tabular}
-\end{center}
-
-There is just one @BCO_RET@ info pointer.  We avoid needing different
-@BCO_RET@s for each stack layout by tagging unboxed free variables as
-though they were pending arguments.
-
-\item[Update frames] are used to trigger updates.  When an update
-frame is entered, it overwrites the updatee with an indirection to the
-result, restarts any threads blocked on the @BLACKHOLE@ and returns to
-the stack object underneath the update frame.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@UPDATE_FRAME@ & \emph{Next Update Frame} & \emph{Updatee} \\ \hline
-\end{tabular}
-\end{center}
-
-\item[Seq frames] are used to implement the polymorphic @seq@
-primitive.  They are a special kind of update frame, and are linked on
-the update frame list.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@SEQ_FRAME@ & \emph{Next Update Frame} \\ \hline
-\end{tabular}
-\end{center}
-
-\item[Stop frames] are put on the bottom of each thread's stack, and
-act as sentinels for the update frame list (i.e. the last update frame
-points to the stop frame).  Returning to a stop frame terminates the
-thread.  Stop frames have no payload:
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-@SEQ_FRAME@ \\ \hline
-\end{tabular}
-\end{center}
-
-\end{description}
-
-\Subsubsection{Case expressions}{case-expr-overview}
-
-In the STG language, all evaluation is triggered by evaluating a case
-expression.  When evaluating a case expression @case e of alts@, the
-evaluators pushes a return address onto the stack and evaluate the
-expression @e@.  When @e@ eventually reduces to a constructor, the
-return address on the stack is entered.  The details of how the
-constructor is passed to the return address and how the appropriate
-case alternative is selected vary between evaluators.
-
-Case expressions for unboxed data types are essentially the same: the
-case expression pushes a return address onto the stack before
-evaluating the scrutinee; when a function returns an unboxed value, it
-enters the return address on top of the stack.
-
-
-\Subsubsection{Function applications}{fun-app-overview}
-
-In the STG language, all function calls are tail calls.  The arguments
-are pushed onto the stack and the function closure is entered.  If any
-arguments are unboxed, they must be tagged as unboxed pending
-arguments.  Entering a closure is just a special case of calling a
-function with no arguments.
-
-
-\Subsubsection{Let expressions}{let-expr-overview}
-
-In the STG language, almost all heap allocation is caused by let
-expressions.  Filling in the contents of a set of mutually recursive
-heap objects is simple enough; the only difficulty is that once the
-heap space has been allocated, the thread must not return to the
-scheduler until after the objects are filled in.
-
-
-\Subsubsection{Primitive operations}{primop-overview}
-
-\ToDo{}
-
-Most primops are simple, some aren't.
-
-
-
-
-
-
-\Section{Scheduler}{scheduler-overview}
-
-The Scheduler is the heart of the run-time system.  A running program
-consists of a single running thread, and a list of runnable and
-blocked threads.  A thread is represented by a \emph{Thread Status
-Object} (TSO), which contains a few words status information and a
-stack.  Except for the running thread, all threads have a closure on
-top of their stack; the scheduler restarts a thread by entering an
-evaluator which performs some reduction and returns to the scheduler.
-
-\Subsection{The scheduler's main loop}{scheduler-main-loop}
-
-The scheduler consists of a loop which chooses a runnable thread and
-invokes one of the evaluators which performs some reduction and
-returns.
-
-The scheduler also takes care of system-wide issues such as heap
-overflow or communication with other processors (in the parallel
-system) and thread-specific problems such as stack overflow.
-
-\Subsection{Creating a thread}{create-thread}
-
-Threads are created:
-
-\begin{itemize}
-
-\item
-
-When the scheduler is first invoked.
-
-\item
-
-When a message is received from another processor (I think). (Parallel
-system only.)
-
-\item
-
-When a C program calls some Haskell code.
-
-\item
-
-By @forkIO@, @takeMVar@ and (maybe) other Concurrent Haskell primitives.
-
-\end{itemize}
-
-
-\Subsection{Restarting a thread}{thread-restart}
-
-When the scheduler decides to run a thread, it has to decide which
-evaluator to use.  It does this by looking at the type of the closure
-on top of the stack.
-\begin{itemize}
-\item @BCO@ $\Rightarrow$ bytecode evaluator
-\item @FUN@ or @THUNK@ $\Rightarrow$ machine code evaluator
-\item @CONSTR@ $\Rightarrow$ machine code evaluator
-\item other $\Rightarrow$ either evaluator.
-\end{itemize}
-
-The only surprise in the above is that the scheduler must enter the
-machine code evaluator if there's a constructor on top of the stack.
-This allows the bytecode evaluator to return a constructor to a
-machine code return address by pushing the constructor on top of the
-stack and returning to the scheduler.  If the return address under the
-constructor is @HUGS_RET@, the entry code for @HUGS_RET@ will
-rearrange the stack so that the return @BCO@ is on top of the stack
-and return to the scheduler which will then call the bytecode
-evaluator.  There is little point in trying to shorten this slightly
-indirect route since it is will happen very rarely if at all.
-
-\note{As an optimisation, we could store the choice of evaluator in
-the TSO status whenever we leave the evaluator.  This is required for
-any thread, no matter what state it is in (blocked, stack overflow,
-etc).  It isn't clear whether this would accomplish anything.}
-
-\Subsection{Returning from a thread}{thread-return}
-
-The evaluators return to the scheduler when any of the following
-conditions arise:
-
-\begin{itemize}
-\item A heap check fails, and a garbage collection is required.
-
-\item A stack check fails, and the scheduler must either enlarge the
-current thread's stack, or flag an out of memory condition.
-
-\item A thread enters a closure built by the other evaluator.  That
-is, when the bytecode interpreter enters a closure compiled by GHC or
-when the machine code evaluator enters a BCO.
-
-\item A thread returns to a return continuation built by the other
-evaluator.  That is, when the machine code evaluator returns to a
-continuation built by Hugs or when the bytecode evaluator returns to a
-continuation built by GHC.
-
-\item The evaluator needs to perform a ``safe'' C call
-(\secref{c-calls}).
-
-\item The thread becomes blocked.  This happens when a thread requires
-the result of a computation currently being performed by another
-thread, or it reads a synchronisation variable that is currently empty
-(\secref{MVAR}).
-
-\item The thread is preempted (the preemption mechanism is described
-in \secref{thread-preemption}).
-
-\item The thread terminates.
-\end{itemize}
-
-Except when the thread terminates, the thread always terminates with a
-closure on the top of the stack.  The mechanism used to trigger the
-world switch and the choice of closure left on top of the stack varies
-according to which world is being left and what is being returned.
-
-\Subsubsection{Leaving the bytecode evaluator}{hugs-to-ghc-switch}
-
-\paragraph{Entering a machine code closure}
-
-When it enters a closure, the bytecode evaluator performs a switch
-based on the type of closure (@AP@, @PAP@, @Ind@, etc).  On entering a
-machine code closure, it returns to the scheduler with the closure on
-top of the stack.
-
-\paragraph{Returning a constructor}
-
-When it enters a constructor, the bytecode evaluator tests the return
-continuation on top of the stack.  If it is a machine code
-continuation, it returns to the scheduler with the constructor on top
-of the stack.
-
-\note{This is why the scheduler must enter the machine code evaluator
-if it finds a constructor on top of the stack.}
-
-\paragraph{Returning an unboxed value}
-
-\note{Hugs doesn't support unboxed values in source programs but they
-are used for a few complex primops.}
-
-When it returns an unboxed value, the bytecode evaluator tests the
-return continuation on top of the stack.  If it is a machine code
-continuation, it returns to the scheduler with the tagged unboxed
-value and a special closure on top of the stack.  When the closure is
-entered (by the machine code evaluator), it returns the unboxed value
-on top of the stack to the return continuation under it.
-
-The runtime library for GHC provides one of these closures for each unboxed
-type.  Hugs cannot generate them itself since the entry code is really
-very tricky.
-
-\paragraph{Heap/Stack overflow and preemption}
-
-The bytecode evaluator tests for heap/stack overflow and preemption
-when entering a BCO and simply returns with the BCO on top of the
-stack.
-
-\Subsubsection{Leaving the machine code evaluator}{ghc-to-hugs-switch}
-
-\paragraph{Entering a BCO}
-
-The entry code for a BCO pushes the BCO onto the stack and returns to
-the scheduler.
-
-\paragraph{Returning a constructor}
-
-We avoid the need to test return addresses in the machine code
-evaluator by pushing a special return address on top of a pointer to
-the bytecode return continuation.  \figref{hugs-return-stack1}
-shows the state of the stack just before evaluating the scrutinee.
-
-\begin{figure}[ht]
-\begin{center}
-\begin{verbatim}
-| stack    |
-+----------+
-| bco      |--> BCO
-+----------+
-| HUGS_RET |
-+----------+
-\end{verbatim}
-%\input{hugs_return1.pstex_t}
-\end{center}
-\caption{Stack layout for evaluating a scrutinee}
-\label{fig:hugs-return-stack1}
-\end{figure}
-
-This return address rearranges the stack so that the bco pointer is
-above the constructor on the stack (as shown in
-\figref{hugs-boxed-return}) and returns to the scheduler.
-
-\begin{figure}[ht]
-\begin{center}
-\begin{verbatim}
-| stack    |
-+----------+
-| con      |--> Constructor
-+----------+
-| bco      |--> BCO
-+----------+
-\end{verbatim}
-%\input{hugs_return2.pstex_t}
-\end{center}
-\caption{Stack layout for entering a Hugs return address}
-\label{fig:hugs-boxed-return}
-\end{figure}
-
-\paragraph{Returning an unboxed value}
-
-We avoid the need to test return addresses in the machine code
-evaluator by pushing a special return address on top of a pointer to
-the bytecode return continuation.  This return address rearranges the
-stack so that the bco pointer is above the tagged unboxed value (as
-shown in \figref{hugs-entering-unboxed-return}) and returns to the
-scheduler.
-
-\begin{figure}[ht]
-\begin{center}
-\begin{verbatim}
-| stack    |
-+----------+
-| 1#       |
-+----------+
-| I#       |
-+----------+
-| bco      |--> BCO
-+----------+
-\end{verbatim}
-%\input{hugs_return2.pstex_t}
-\end{center}
-\caption{Stack layout for returning an unboxed value}
-\label{fig:hugs-entering-unboxed-return}
-\end{figure}
-
-\paragraph{Heap/Stack overflow and preemption}
-
-\ToDo{}
-
-
-\Subsection{Preempting a thread}{thread-preemption}
-
-Strictly speaking, threads cannot be preempted --- the scheduler
-merely sets a preemption request flag which the thread must arrange to
-test on a regular basis.  When an evaluator finds that the preemption
-request flag is set, it pushes an appropriate closure onto the stack
-and returns to the scheduler.
-
-In the bytecode interpreter, the flag is tested whenever we enter a
-closure.  If the preemption flag is set, it leaves the closure on top
-of the stack and returns to the scheduler.
-
-In the machine code evaluator, the flag is only tested when a heap or
-stack check fails.  This is less expensive than testing the flag on
-entering every closure but runs the risk that a thread will enter an
-infinite loop which does not allocate any space.  If the flag is set,
-the evaluator returns to the scheduler exactly as if a heap check had
-failed.
-
-\Subsection{``Safe'' and ``unsafe'' C calls}{c-calls}
-
-There are two ways of calling C: 
-
-\begin{description}
-
-\item[``Unsafe'' C calls] are used if the programer is certain that
-the C function will not do anything dangerous.  Unsafe C calls are
-faster but must be hand-checked by the programmer.
-
-Dangerous things include:
-
-\begin{itemize}
-
-\item 
-
-Call a system function such as @getchar@ which might block
-indefinitely.  This is dangerous because we don't want the entire
-runtime system to block just because one thread blocks.
-
-\item
-
-Call an RTS function which will block on the RTS access semaphore.
-This would lead to deadlock.
-
-\item
-
-Call a Haskell function.  This is just a special case of calling an
-RTS function.
-
-\end{itemize}
-
-Unsafe C calls are performed by pushing the arguments onto the C stack
-and jumping to the C function's entry point.  On exit, the result of
-the function is in a register which is returned to the Haskell code as
-an unboxed value.
-
-\item[``Safe'' C calls] are used if the programmer suspects that the
-thread may do something dangerous.  Safe C calls are relatively slow
-but are less problematic.
-
-Safe C calls are performed by pushing the arguments onto the Haskell
-stack, pushing a return continuation and returning a \emph{C function
-descriptor} to the scheduler.  The scheduler suspends the Haskell thread,
-spawns a new operating system thread which pops the arguments off the
-Haskell stack onto the C stack, calls the C function, pushes the
-function result onto the Haskell stack and informs the scheduler that
-the C function has completed and the Haskell thread is now runnable.
-
-\end{description}
-
-The bytecode evaluator will probably treat all C calls as being safe.
-
-\ToDo{It might be good for the programmer to indicate how the program
-is unsafe.  For example, if we distinguish between C functions which
-might call Haskell functions and those which might block, we could
-perform an unsafe call for blocking functions in a single-threaded
-system or, perhaps, in a multi-threaded system which only happens to
-have a single thread at the moment.}
-
-
-
-\Section{The Storage Manager}{sm-overview}
-
-The storage manager is responsible for managing the heap and all
-objects stored in it.  It provides special support for lazy evaluation
-and for foreign function calls.
-
-\Subsection{SM support for lazy evaluation}{sm-lazy-evaluation}
-
-\begin{itemize}
-\item
-
-Indirections are shorted out.
-
-\item
-
-Update frames pointing to unreachable objects are squeezed out.
-
-\ToDo{Part IV suggests this doesn't happen.}
-
-\item
-
-Adjacent update frames (for different closures) are compressed to a
-single update frame pointing to a single black hole.
-
-\end{itemize}
-
-
-\Subsection{SM support for foreign function calls}{sm-foreign-calls}
-
-\begin{itemize}
-
-\item
-
-Stable pointers allow other languages to access Haskell objects.
-
-\item
-
-Weak pointers and foreign objects provide finalisation support for
-Haskell references to external objects.
-
-\end{itemize}
-
-\Subsection{Misc}{sm-misc}
-
-\begin{itemize}
-
-\item
-
-If the stack contains a large amount of free space, the storage
-manager may shrink the stack.  If it shrinks the stack, it guarantees
-never to leave less than @MIN_SIZE_SHRUNKEN_STACK@ empty words on the
-stack when it does so.
-
-\item
-
-For efficiency reasons, very large objects (eg large arrays and TSOs)
-are not moved if possible.
-
-\end{itemize}
-
-
-\Section{The Compilers}{compilers-overview}
-
-Need to describe interface files, format of bytecode files, symbols
-defined by machine code files.
-
-\Subsection{Interface Files}{interface-files}
-
-Here's an example - but I don't know the grammar - ADR.
-\begin{verbatim}
-_interface_ Main 1
-_exports_
-Main main ;
-_declarations_
-1 main _:_ IOBase.IO PrelBase.();;
-\end{verbatim}
-
-\Subsection{Bytecode files}{bytecode-files}
-
-(All that matters here is what the loader sees.)
-
-\Subsection{Machine code files}{asm-files}
-
-(Again, all that matters is what the loader sees.)
-
-\Section{The Loader}{loader-overview}
-
-In a batch mode system, we can statically link all the modules
-together.  In an interactive system we need a loader which will
-explicitly load and unload individual modules (or, perhaps, blocks of
-mutually dependent modules) and resolve references between modules.
-
-While many operating systems provide support for dynamic loading and
-will automatically resolve cross-module references for us, we generally
-cannot rely on being able to load mutually dependent modules.
-
-A portable solution is to perform some of the linking ourselves.  Each module
-should provide three global symbols: 
-\begin{itemize}
-\item
-An initialisation routine.  (Might also be used for finalisation.)
-\item
-A table of symbols it exports.
-Entries in this table consist of the symbol name and the address of the
-name's value.
-\item
-A table of symbols it imports.
-Entries in this table consist of the symbol name and a list of references
-to that symbol.
-\end{itemize}
-
-On loading a group of modules, the loader adds the contents of the
-export lists to a symbol table and then fills in all the references in the
-import lists.
-
-References in import lists are of two types:
-\begin{description}
-\item[ References in machine code ]
-
-The most efficient approach is to patch the machine code directly, but
-this will be a lot of work, very painful to port and rather fragile.
-
-Alternatively, the loader could store the value of each symbol in the
-import table for each module and the compiled code can access all
-external objects through the import table.  This requires that the
-import table be writable but does not require that the machine code or
-info tables be writable.
-
-\item[ References in data structures (SRTs and static data constructors) ]
-
-Either we patch the SRTs and constructors directly or we somehow use
-indirections through the symbol table.  Patching the SRTs requires
-that we make them writable and prevents us from making effective use
-of virtual memories that use copy-on-write policies (this only makes a
-difference if we want to run several copies of the same program
-simultaneously).  Using an indirection is possible but tricky.
-
-Note: We could avoid patching machine code if all references to
-external references went through the SRT --- then we just have one
-thing to patch.  But the SRT always contains a pointer to the closure
-rather than the fast entry point (say), so we'd take a big performance
-hit for doing this.
-
-\end{description}
-
-Using the above scheme, all accesses to ``external'' objects involve a
-layer of indirection.  To avoid this overhead, the machine code
-compiler might provide a way for the programmer to specify which
-modules will be statically linked and which will be dynamically linked
---- the idea being that statically linked code and data will be
-accessed directly.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\part{Internal details}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-This part is concerned with the internal details of the components
-described in the previous part.
-
-The major components of the system are:
-\begin{itemize}
-\item The scheduler (\secref{scheduler-internals})
-\item The storage manager (\secref{storage-manager-internals})
-\item The evaluators
-\item The loader
-\item The compilers
-\end{itemize}
-
-\Section{The Scheduler}{scheduler-internals}
-
-\ToDo{Detailed description of scheduler}
-
-Many heap objects contain fields allowing them to be inserted onto lists
-during evaluation or during garbage collection. The lists required by
-the evaluator and storage manager are as follows.
-
-\begin{itemize}
-
-\item 4 lists of threads: runnable threads, sleeping threads, threads
-waiting for timeout and threads waiting for I/O.
-
-\item The \emph{mutables list} is a list of all objects in the old
-generation which might contain pointers into the new generation.  Most
-of the objects on this list are indirections (\secref{IND})
-or ``mutable.''  (\secref{mutables}.)
-
-\item The \emph{Foreign Object list} is a list of all foreign objects
- which have not yet been deallocated. (\secref{FOREIGN}.)
-
-\item The \emph{Spark pool} is a doubly(?) linked list of Spark objects
-maintained by the parallel system.  (\secref{SPARK}.)
-
-\item The \emph{Blocked Fetch list} (or
-lists?). (\secref{BLOCKED_FETCH}.)
-
-\item For each thread, there is a list of all update frames on the
-stack.  (\secref{data-updates}.)
-
-\item The Stable Pointer Table is a table of pointers to objects which
-are known to the outside world and must be retained by the garbage
-collector even if they are not accessible from within the heap.
-
-\end{itemize}
-
-\ToDo{The links for these fields are usually inserted immediately
-after the fixed header except ...}
-
-
-
-\Section{The Storage Manager}{storage-manager-internals}
-
-\subsection{Misc Text looking for a home}
-
-A \emph{value} may be:
-\begin{itemize}
-\item \emph{Boxed}, i.e.~represented indirectly by a pointer to a heap object (e.g.~foreign objects, arrays); or
-\item \emph{Unboxed}, i.e.~represented directly by a bit-pattern in one or more registers (e.g.~@Int#@ and @Float#@).
-\end{itemize}
-All \emph{pointed} values are \emph{boxed}.  
-
-
-\Subsection{Heap Objects}{heap-objects}
-\label{sec:fixed-header}
-
-\begin{figure}
-\begin{center}
-\input{closure}
-\end{center}
-\ToDo{Fix this picture}
-\caption{A closure}
-\label{fig:closure}
-\end{figure}
-
-Every \emph{heap object} is a contiguous block of memory, consisting
-of a fixed-format \emph{header} followed by zero or more \emph{data
-words}.
-
-The header consists of the following fields:
-\begin{itemize}
-\item A one-word \emph{info pointer}, which points to
-the object's static \emph{info table}.
-\item Zero or more \emph{admin words} that support
-\begin{itemize}
-\item Profiling (notably a \emph{cost centre} word).
-  \note{We could possibly omit the cost centre word from some 
-  administrative objects.}
-\item Parallelism (e.g. GranSim keeps the object's global address here,
-though GUM keeps a separate hash table).
-\item Statistics (e.g. a word to track how many times a thunk is entered.).
-
-We add a Ticky word to the fixed-header part of closures.  This is
-used to indicate if a closure has been updated but not yet entered. It
-is set when the closure is updated and cleared when subsequently
-entered.  \footnote{% NB: It is \emph{not} an ``entry count'', it is
-an ``entries-after-update count.''  The commoning up of @CONST@,
-@CHARLIKE@ and @INTLIKE@ closures is turned off(?) if this is
-required. This has only been done for 2s collection.  }
-
-\end{itemize}
-\end{itemize}
-
-Most of the RTS is completely insensitive to the number of admin
-words.  The total size of the fixed header is given by
-@sizeof(StgHeader)@.
-
-\Subsection{Info Tables}{info-tables}
-
-An \emph{info table} is a contiguous block of memory, laid out as follows:
-
-\begin{center}
-\begin{tabular}{|r|l|}
-   \hline Parallelism Info 	& variable
-\\ \hline Profile Info 		& variable
-\\ \hline Debug Info		& variable
-\\ \hline Static reference table  & pointer word (optional)
-\\ \hline Storage manager layout info & pointer word
-\\ \hline Closure flags		& 8 bits
-\\ \hline Closure type 		& 8 bits
-\\ \hline Constructor Tag / SRT length    	& 16 bits
-\\ \hline entry code
-\\       \vdots
-\end{tabular}
-\end{center}
-
-On a 64-bit machine the tag, type and flags fields will all be doubled
-in size, so the info table is a multiple of 64 bits.
-
-An info table has the following contents (working backwards in memory
-addresses):
-
-\begin{itemize}
-
-\item The \emph{entry code} for the closure.  This code appears
-literally as the (large) last entry in the info table, immediately
-preceded by the rest of the info table.  An \emph{info pointer} always
-points to the first byte of the entry code.
-
-\item A 16-bit constructor tag / SRT length.  For a constructor info
-table this field contains the tag of the constructor, in the range
-$0..n-1$ where $n$ is the number of constructors in the datatype.
-Otherwise, it contains the number of entries in this closure's Static
-Reference Table (\secref{srt}).
-
-\item An 8-bit {\em closure type field}, which identifies what kind of
-closure the object is.  The various types of closure are described in
-\secref{closures}.
-
-\item an 8-bit flags field, which holds various flags pertaining to
-the closure type.
-
-\item A single pointer or word --- the {\em storage manager info
-field}, contains auxiliary information describing the closure's
-precise layout, for the benefit of the garbage collector and the code
-that stuffs graph into packets for transmission over the network.
-There are three kinds of layout information:
-
-\begin{itemize}
-\item Standard layout information is for closures which place pointers
-before non-pointers in instances of the closure (this applies to most
-heap-based and static closures, but not activation records).  The
-layout information for standard closures is
-
-	\begin{itemize}
-	\item Number of pointer fields (16 bits).
-	\item Number of non-pointer fields (16 bits).
-	\end{itemize}
-
-\item Activation records don't have pointers before non-pointers,
-since stack-stubbing requires that the record has holes in it.  The
-layout is therefore represented by a bitmap in which each '1' bit
-represents a non-pointer word.  This kind of layout info is used for
-@RET_SMALL@ and @RET_VEC_SMALL@ closures.
-
-\item If an activation record is longer than 32 words, then the layout
-field contains a pointer to a bitmap record, consisting of a length
-field followed by two or more bitmap words.  This layout information
-is used for @RET_BIG@ and @RET_VEC_BIG@ closures.
-
-\item Selector Thunks (\secref{THUNK_SELECTOR}) use the closure
-layout field to hold the selector index, since the layout is always
-known (the closure contains a single pointer field).
-\end{itemize}
-
-\item A one-word {\em Static Reference Table} field.  This field
-points to the static reference table for the closure (\secref{srt}),
-and is only present for the following closure types:
-
-	\begin{itemize}
-	\item @FUN_*@
-	\item @THUNK_*@
-	\item @RET_*@
-	\end{itemize}
-
-\ToDo{Expand the following explanation.}
-
-An SRT is basically a vector of pointers to static closures.  A
-top-level function or thunk will have an SRT (which might be empty),
-which points to all the static closures referenced by that function or
-thunk.  Every non-top-level thunk or function also has an SRT, but
-it'll be a sub-sequence of the top-level SRT, so we just store a
-pointer and a length in the info table - the pointer points into the
-middle of the larger SRT.
-
-At GC time, the garbage collector traverses the transitive closure of
-all the SRTs reachable from the roots, and thereby discovers which
-CAFs are live.
-  
-\item \emph{Profiling info\/}
-
-\ToDo{The profiling info is completely bogus.  I've not deleted it
-from the document but I've commented it all out.}
-
-% change to \iftrue to uncomment this section
-\iffalse
-
-Closure category records are attached to the info table of the
-closure. They are declared with the info table. We put pointers to
-these ClCat things in info tables.  We need these ClCat things because
-they are mutable, whereas info tables are immutable.  Hashing will map
-similar categories to the same hash value allowing statistics to be
-grouped by closure category.
-
-Cost Centres and Closure Categories are hashed to provide indexes
-against which arbitrary information can be stored. These indexes are
-memoised in the appropriate cost centre or category record and
-subsequent hashes avoided by the index routine (it simply returns the
-memoised index).
-
-There are different features which can be hashed allowing information
-to be stored for different groupings. Cost centres have the cost
-centre recorded (using the pointer), module and group. Closure
-categories have the closure description and the type
-description. Records with the same feature will be hashed to the same
-index value.
-
-The initialisation routines, @init_index_<feature>@, allocate a hash
-table in which the cost centre / category records are stored. The
-lower bound for the table size is taken from @max_<feature>_no@. They
-return the actual table size used (the next power of 2). Unused
-locations in the hash table are indicated by a 0 entry. Successive
-@init_index_<feature>@ calls just return the actual table size.
-
-Calls to @index_<feature>@ will insert the cost centre / category
-record in the @<feature>@ hash table, if not already inserted. The hash
-index is memoised in the record and returned. 
-
-CURRENTLY ONLY ONE MEMOISATION SLOT IS AVILABLE IN EACH RECORD SO
-HASHING CAN ONLY BE DONE ON ONE FEATURE FOR EACH RECORD. This can be
-easily relaxed at the expense of extra memoisation space or continued
-rehashing.
-
-The initialisation routines must be called before initialisation of
-the stacks and heap as they require to allocate storage. It is also
-expected that the caller may want to allocate additional storage in
-which to store profiling information based on the return table size
-value(s).
-
-\begin{center}
-\begin{tabular}{|l|}
-   \hline Hash Index
-\\ \hline Selected
-\\ \hline Kind
-\\ \hline Description String
-\\ \hline Type String
-\\ \hline
-\end{tabular}
-\end{center}
-
-\begin{description}
-\item[Hash Index] Memoised copy
-\item[Selected] 
-  Is this category selected (-1 == not memoised, selected? 0 or 1)
-\item[Kind]
-One of the following values (defined in CostCentre.lh):
-
-\begin{description}
-\item[@CON_K@]
-A constructor.
-\item[@FN_K@]
-A literal function.
-\item[@PAP_K@]
-A partial application.
-\item[@THK_K@]
-A thunk, or suspension.
-\item[@BH_K@]
-A black hole.
-\item[@ARR_K@]
-An array.
-\item[@ForeignObj_K@]
-A Foreign object (non-Haskell heap resident).
-\item[@SPT_K@]
-The Stable Pointer table.  (There should only be one of these but it
-represents a form of weak space leak since it can't shrink to meet
-non-demand so it may be worth watching separately? ADR)
-\item[@INTERNAL_KIND@]
-Something internal to the runtime system.
-\end{description}
-
-
-\item[Description] Source derived string detailing closure description.
-\item[Type] Source derived string detailing closure type.
-\end{description}
-
-\fi % end of commented out stuff
-
-\item \emph{Parallelism info\/}
-\ToDo{}
-
-\item \emph{Debugging info\/}
-\ToDo{}
-
-\end{itemize}
-
-
-%-----------------------------------------------------------------------------
-\Subsection{Kinds of Heap Object}{closures}
-
-Heap objects can be classified in several ways, but one useful one is
-this:
-\begin{itemize}
-\item 
-\emph{Static closures} occupy fixed, statically-allocated memory
-locations, with globally known addresses.
-
-\item 
-\emph{Dynamic closures} are individually allocated in the heap.
-
-\item 
-\emph{Stack closures} are closures allocated within a thread's stack
-(which is itself a heap object).  Unlike other closures, there are
-never any pointers to stack closures.  Stack closures are discussed in
-\secref{TSO}.
-
-\end{itemize}
-A second useful classification is this:
-\begin{itemize}
-
-\item \emph{Executive objects}, such as thunks and data constructors,
-participate directly in a program's execution.  They can be subdivided
-into three kinds of objects according to their type: \begin{itemize}
-
-\item \emph{Pointed objects}, represent values of a \emph{pointed}
-type (<.pointed types launchbury.>) --i.e.~a type that includes
-$\bottom$ such as @Int@ or @Int# -> Int#@.
-
-\item \emph{Unpointed objects}, represent values of a \emph{unpointed}
-type --i.e.~a type that does not include $\bottom$ such as @Int#@ or
-@Array#@.
-
-\item \emph{Activation frames}, represent ``continuations''.  They are
-always stored on the stack and are never pointed to by heap objects or
-passed as arguments.  \note{It's not clear if this will still be true
-once we support speculative evaluation.}
-
-\end{itemize}
-
-\item \emph{Administrative objects}, such as stack objects and thread
-state objects, do not represent values in the original program.
-\end{itemize}
-
-Only pointed objects can be entered.  If an unpointed object is
-entered the program will usually terminate with a fatal error.
-
-This section enumerates all the kinds of heap objects in the system.
-Each is identified by a distinct closure type field in its info table.
-
-\begin{tabular}{|l|l|l|l|l|l|l|l|l|l|l|}
-\hline
-
-closure type          & Section \\
-		      
-\hline                          
-\emph{Pointed} \\      
-\hline 		      
-		      
-@CONSTR@              & \ref{sec:CONSTR}    \\
-@CONSTR_p_n@	      & \ref{sec:CONSTR}    \\
-@CONSTR_STATIC@       & \ref{sec:CONSTR}    \\
-@CONSTR_NOCAF_STATIC@ & \ref{sec:CONSTR}    \\
-		      
-@FUN@                 & \ref{sec:FUN}       \\
-@FUN_p_n@             & \ref{sec:FUN}       \\
-@FUN_STATIC@          & \ref{sec:FUN}       \\
-		      
-@THUNK@               & \ref{sec:THUNK}     \\
-@THUNK_p_n@           & \ref{sec:THUNK}     \\
-@THUNK_STATIC@        & \ref{sec:THUNK}     \\
-@THUNK_SELECTOR@      & \ref{sec:THUNK_SELECTOR} \\
-		      
-@BCO@		      & \ref{sec:BCO}       \\
-		      
-@AP_UPD@      	      & \ref{sec:AP_UPD}    \\
-@PAP@                 & \ref{sec:PAP}       \\
-		      
-@IND@                 & \ref{sec:IND}       \\
-@IND_OLDGEN@          & \ref{sec:IND}       \\
-@IND_PERM@            & \ref{sec:IND}       \\
-@IND_OLDGEN_PERM@     & \ref{sec:IND}       \\
-@IND_STATIC@          & \ref{sec:IND}       \\
-		      
-@CAF_UNENTERED@	      & \ref{sec:CAF}       \\
-@CAF_ENTERED@	      & \ref{sec:CAF}       \\
-@CAF_BLACKHOLE@	      & \ref{sec:CAF}       \\
-
-\hline		      
-\emph{Unpointed} \\    
-\hline		      
-		      		      
-@BLACKHOLE@           & \ref{sec:BLACKHOLE} \\
-@BLACKHOLE_BQ@        & \ref{sec:BLACKHOLE_BQ} \\
-
-@MVAR@ 		      & \ref{sec:MVAR}      \\
-
-@ARR_WORDS@           & \ref{sec:ARR_WORDS} \\
-
-@MUTARR_PTRS@         & \ref{sec:MUT_ARR_PTRS} \\
-@MUTARR_PTRS_FROZEN@  & \ref{sec:MUT_ARR_PTRS_FROZEN} \\
-
-@MUT_VAR@              & \ref{sec:MUT_VAR}    \\
-
-@WEAK@		      & \ref{sec:WEAK}   \\
-@FOREIGN@             & \ref{sec:FOREIGN}   \\
-@STABLE_NAME@	      & \ref{sec:STABLE_NAME}   \\
-\hline
-\end{tabular}
-
-Activation frames do not live (directly) on the heap --- but they have
-a similar organisation.
-
-\begin{tabular}{|l|l|}\hline
-closure type		& Section			\\ \hline
-@RET_SMALL@ 		& \ref{sec:activation-records}	\\
-@RET_VEC_SMALL@ 	& \ref{sec:activation-records}	\\
-@RET_BIG@		& \ref{sec:activation-records}	\\
-@RET_VEC_BIG@		& \ref{sec:activation-records}	\\
-@UPDATE_FRAME@ 		& \ref{sec:activation-records}	\\
-@CATCH_FRAME@ 		& \ref{sec:activation-records}	\\
-@SEQ_FRAME@ 		& \ref{sec:activation-records}	\\
-@STOP_FRAME@ 		& \ref{sec:activation-records}	\\
-\hline
-\end{tabular}
-
-There are also a number of administrative objects.  It is an error to
-enter one of these objects.
-
-\begin{tabular}{|l|l|}\hline
-closure type		& Section 			\\ \hline
-@TSO@                   & \ref{sec:TSO} 		\\
-@SPARK_OBJECT@          & \ref{sec:SPARK}		\\
-@BLOCKED_FETCH@       	& \ref{sec:BLOCKED_FETCH} 	\\
-@FETCHME@               & \ref{sec:FETCHME}   \\
-\hline
-\end{tabular}
-
-\Subsection{Predicates}{closure-predicates}
-
-The runtime system sometimes needs to be able to distinguish objects
-according to their properties: is the object updateable? is it in weak
-head normal form? etc.  These questions can be answered by examining
-the closure type field of the object's info table.  
-
-We define the following predicates to detect families of related
-info types.  They are mutually exclusive and exhaustive.
-
-\begin{itemize}
-\item @isCONSTR@ is true for @CONSTR@s.
-\item @isFUN@ is true for @FUN@s.
-\item @isTHUNK@ is true for @THUNK@s.
-\item @isBCO@ is true for @BCO@s.
-\item @isAP@ is true for @AP@s.
-\item @isPAP@ is true for @PAP@s.
-\item @isINDIRECTION@ is true for indirection objects. 
-\item @isBH@ is true for black holes.
-\item @isFOREIGN_OBJECT@ is true for foreign objects.
-\item @isARRAY@ is true for array objects.
-\item @isMVAR@ is true for @MVAR@s.
-\item @isIVAR@ is true for @IVAR@s.
-\item @isFETCHME@ is true for @FETCHME@s.
-\item @isSLOP@ is true for slop objects.
-\item @isRET_ADDR@ is true for return addresses.
-\item @isUPD_ADDR@ is true for update frames.
-\item @isTSO@ is true for @TSO@s.
-\item @isSTABLE_PTR_TABLE@ is true for the stable pointer table.
-\item @isSPARK_OBJECT@ is true for spark objects.
-\item @isBLOCKED_FETCH@ is true for blocked fetch objects.
-\item @isINVALID_INFOTYPE@ is true for all other info types.
-
-\end{itemize}
-
-The following predicates detect other interesting properties:
-
-\begin{itemize}
-
-\item @isPOINTED@ is true if an object has a pointed type.
-
-If an object is pointed, the following predicates may be true
-(otherwise they are false).  @isWHNF@ and @isUPDATEABLE@ are
-mutually exclusive.
-
-\begin{itemize} 
-\item @isWHNF@ is true if the object is in Weak Head Normal Form.  
-Note that unpointed objects are (arbitrarily) not considered to be in WHNF.
-
-@isWHNF@ is true for @PAP@s, @CONSTR@s, @FUN@s and all @BCO@s.
-
-\ToDo{Need to distinguish between whnf BCOs and non-whnf BCOs in their
-closure type}
-
-\item @isUPDATEABLE@ is true if the object may be overwritten with an
- indirection object.
-
-@isUPDATEABLE@ is true for @THUNK@s, @AP@s and @BH@s.
-
-\end{itemize}
-
-It is possible for a pointed object to be neither updatable nor in
-WHNF.  For example, indirections.
-
-\item @isUNPOINTED@ is true if an object has an unpointed type.
-All such objects are boxed since only boxed objects have info pointers.
-
-It is true for @ARR_WORDS@, @ARR_PTRS@, @MUTVAR@, @MUTARR_PTRS@,
-@MUTARR_PTRS_FROZEN@, @FOREIGN@ objects, @MVAR@s and @IVAR@s.
-
-\item @isACTIVATION_FRAME@ is true for activation frames of all sorts.
-
-It is true for return addresses and update frames.
-\begin{itemize}
-\item @isVECTORED_RETADDR@ is true for vectored return addresses.
-\item @isDIRECT_RETADDR@ is true for direct return addresses.
-\end{itemize}
-
-\item @isADMINISTRATIVE@ is true for administrative objects:
-@TSO@s, the stable pointer table, spark objects and blocked fetches.
-
-\item @hasSRT@ is true if the info table for the object contains an
-SRT pointer.  
-
-@hasSRT@ is true for @THUNK@s, @FUN@s, and @RET@s.
-
-\end{itemize}
-
-\begin{itemize}
-
-\item @isSTATIC@ is true for any statically allocated closure.
-
-\item @isMUTABLE@ is true for objects with mutable pointer fields:
-  @MUT_ARR@s, @MUTVAR@s, @MVAR@s and @IVAR@s.
-
-\item @isSparkable@ is true if the object can (and should) be sparked.
-It is true of updateable objects which are not in WHNF with the
-exception of @THUNK_SELECTOR@s and black holes.
-
-\end{itemize}
-
-As a minor optimisation, we might use the top bits of the @INFO_TYPE@
-field to ``cache'' the answers to some of these predicates.
-
-An indirection either points to HNF (post update); or is result of
-overwriting a FetchMe, in which case the thing fetched is either under
-evaluation (BLACKHOLE), or by now an HNF.  Thus, indirections get
-NoSpark flag.
-
-\subsection{Closures (aka Pointed Objects)}
-
-An object can be entered iff it is a closure.
-
-\Subsubsection{Function closures}{FUN}
-
-Function closures represent lambda abstractions.  For example,
-consider the top-level declaration:
-\begin{verbatim}
-  f = \x -> let g = \y -> x+y
-	    in g x
-\end{verbatim}
-Both @f@ and @g@ are represented by function closures.  The closure
-for @f@ is \emph{static} while that for @g@ is \emph{dynamic}.
-
-The layout of a function closure is as follows:
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-\emph{Fixed header}  & \emph{Pointers} & \emph{Non-pointers} \\ \hline
-\end{tabular}
-\end{center}
-
-The data words (pointers and non-pointers) are the free variables of
-the function closure.  The number of pointers and number of
-non-pointers are stored in @info->layout.ptrs@ and
-@info->layout.nptrs@ respecively.
-
-There are several different sorts of function closure, distinguished
-by their closure type field:
-
-\begin{itemize}
-
-\item @FUN@: a vanilla, dynamically allocated on the heap.
-
-\item $@FUN_@p@_@np$: to speed up garbage collection a number of
-specialised forms of @FUN@ are provided, for particular $(p,np)$
-pairs, where $p$ is the number of pointers and $np$ the number of
-non-pointers.
-
-\item @FUN_STATIC@.  Top-level, static, function closures (such as @f@
-above) have a different layout than dynamic ones:
-
-\begin{center}
-\begin{tabular}{|l|l|l|}\hline
-\emph{Fixed header}  & \emph{Static object link} \\ \hline
-\end{tabular}
-\end{center}
-
-Static function closures have no free variables.  (However they may
-refer to other static closures; these references are recorded in the
-function closure's SRT.)  They have one field that is not present in
-dynamic closures, the \emph{static object link} field.  This is used
-by the garbage collector in the same way that to-space is, to gather
-closures that have been determined to be live but that have not yet
-been scavenged.
-
-\note{Static function closures that have no static references, and
-hence a null SRT pointer, don't need the static object link field.  We
-don't take advantage of this at the moment, but we could.  See
-@CONSTR\_NOCAF\_STATIC@.}  
-\end{itemize}
-
-Each lambda abstraction, $f$, in the STG program has its own private
-info table.  The following labels are relevant:
-
-\begin{itemize}
-
-\item $f$@_info@  is $f$'s info table.
-
-\item $f$@_entry@ is $f$'s slow entry point (i.e. the entry code of
-its info table; so it will label the same byte as $f$@_info@).
-
-\item $f@_fast_@k$ is $f$'s fast entry point.  $k$ is the number of
-arguments $f$ takes; encoding this number in the fast-entry label
-occasionally catches some nasty code-generation errors.
-
-\end{itemize}
-
-\Subsubsection{Data constructors}{CONSTR}
-
-Data-constructor closures represent values constructed with algebraic
-data type constructors.  The general layout of data constructors is
-the same as that for function closures.  That is
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-\emph{Fixed header}  & \emph{Pointers} & \emph{Non-pointers} \\ \hline
-\end{tabular}
-\end{center}
-
-There are several different sorts of constructor:
-
-\begin{itemize}
-
-\item @CONSTR@: a vanilla, dynamically allocated constructor.
-
-\item @CONSTR_@$p$@_@$np$: just like $@FUN_@p@_@np$.
-
-\item @CONSTR_INTLIKE@.  A dynamically-allocated heap object that
-looks just like an @Int@.  The garbage collector checks to see if it
-can common it up with one of a fixed set of static int-like closures,
-thus getting it out of the dynamic heap altogether.
-
-\item @CONSTR_CHARLIKE@:  same deal, but for @Char@.
-
-\item @CONSTR_STATIC@ is similar to @FUN_STATIC@, with the
-complication that the layout of the constructor must mimic that of a
-dynamic constructor, because a static constructor might be returned to
-some code that unpacks it.  So its layout is like this:
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|l|}\hline
-\emph{Fixed header}  & \emph{Pointers} & \emph{Non-pointers} & \emph{Static object link}\\ \hline
-\end{tabular}
-\end{center}
-
-The static object link, at the end of the closure, serves the same purpose
-as that for @FUN_STATIC@.  The pointers in the static constructor can point
-only to other static closures.
-
-The static object link occurs last in the closure so that static
-constructors can store their data fields in exactly the same place as
-dynamic constructors.
-
-\item @CONSTR_NOCAF_STATIC@.  A statically allocated data constructor
-that guarantees not to point (directly or indirectly) to any CAF
-(\secref{CAF}).  This means it does not need a static object
-link field.  Since we expect that there might be quite a lot of static
-constructors this optimisation makes sense.  Furthermore, the @NOCAF@
-tag allows the compiler to indicate that no CAFs can be reached
-anywhere \emph{even indirectly}.
-
-\end{itemize}
-
-For each data constructor $Con$, two info tables are generated:
-
-\begin{itemize}
-\item $Con$@_con_info@ labels $Con$'s dynamic info table, 
-shared by all dynamic instances of the constructor.
-\item $Con$@_static@ labels $Con$'s static info table, 
-shared by all static instances of the constructor.
-\end{itemize}
-
-Each constructor also has a \emph{constructor function}, which is a
-curried function which builds an instance of the constructor.  The
-constructor function has an info table labelled as @$Con$_info@, and
-entry code pointed to by @$Con$_entry@.
-
-Nullary constructors are represented by a single static info table,
-which everyone points to.  Thus for a nullary constructor we can omit
-the dynamic info table and the constructor function.
-
-\subsubsection{Thunks}
-\label{sec:THUNK}
-\label{sec:THUNK_SELECTOR}
-
-A thunk represents an expression that is not obviously in head normal 
-form.  For example, consider the following top-level definitions:
-\begin{verbatim}
-  range = between 1 10
-  f = \x -> let ys = take x range
-	    in sum ys
-\end{verbatim}
-Here the right-hand sides of @range@ and @ys@ are both thunks; the former
-is static while the latter is dynamic.
-
-The layout of a thunk is the same as that for a function closure.
-However, thunks must have a payload of at least @MIN_UPD_SIZE@
-words to allow it to be overwritten with a black hole and an
-indirection.  The compiler may have to add extra non-pointer fields to
-satisfy this constraint.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|l|}\hline
-\emph{Fixed header}  & \emph{Pointers} & \emph{Non-pointers} \\ \hline
-\end{tabular}
-\end{center}
-
-The layout word in the info table contains the same information as for
-function closures; that is, number of pointers and number of
-non-pointers.
-
-A thunk differs from a function closure in that it can be updated.
-
-There are several forms of thunk:
-
-\begin{itemize}
-
-\item @THUNK@ and $@THUNK_@p@_@np$: vanilla, dynamically allocated
-thunks.  Dynamic thunks are overwritten with normal indirections
-(@IND@), or old generation indirections (@IND_OLDGEN@): see
-\secref{IND}.
-
-\item @THUNK_STATIC@.  A static thunk is also known as a
-\emph{constant applicative form}, or \emph{CAF}.  Static thunks are
-overwritten with static indirections.
-
-\begin{center}
-\begin{tabular}{|l|l|}\hline
-\emph{Fixed header}  & \emph{Static object link}\\ \hline
-\end{tabular}
-\end{center}
-
-\item @THUNK_SELECTOR@ is a (dynamically allocated) thunk whose entry
-code performs a simple selection operation from a data constructor
-drawn from a single-constructor type.  For example, the thunk
-\begin{verbatim}
-	x = case y of (a,b) -> a
-\end{verbatim}
-is a selector thunk.  A selector thunk is laid out like this:
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-\emph{Fixed header}  & \emph{Selectee pointer} \\ \hline
-\end{tabular}
-\end{center}
-
-The layout word contains the byte offset of the desired word in the
-selectee.  Note that this is different from all other thunks.
-
-The garbage collector ``peeks'' at the selectee's tag (in its info
-table).  If it is evaluated, then it goes ahead and does the
-selection, and then behaves just as if the selector thunk was an
-indirection to the selected field.  If it is not evaluated, it treats
-the selector thunk like any other thunk of that shape.
-[Implementation notes.  Copying: only the evacuate routine needs to be
-special.  Compacting: only the PRStart (marking) routine needs to be
-special.]
-
-There is a fixed set of pre-compiled selector thunks built into the
-RTS, representing offsets from 0 to @MAX_SPEC_SELECTOR_THUNK@.  The
-info tables are labelled @__sel_$n$_upd_info@ where $n$ is the offset.
-Non-updating versions are also built in, with info tables labelled
-@__sel_$n$_noupd_info@.
-
-\end{itemize}
-
-The only label associated with a thunk is its info table:
-
-\begin{description}
-\item[$f$@\_info@] is $f$'s info table.
-\end{description}
-
-
-\Subsubsection{Byte-code objects}{BCO}
-
-A Byte-Code Object (BCO) is a container for a a chunk of byte-code,
-which can be executed by Hugs.  The byte-code represents a
-supercombinator in the program: when Hugs compiles a module, it
-performs lambda lifting and each resulting supercombinator becomes a
-byte-code object in the heap.
-
-BCOs are not updateable; the bytecode compiler represents updatable
-thunks using a combination of @AP@s and @BCO@s.
-
-The semantics of BCOs are described in \secref{hugs-heap-objects}.  A
-BCO has the following structure:
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|l|l|}
-\hline 
-\emph{Fixed Header} & \emph{Layout} & \emph{Offset} & \emph{Size} &
-\emph{Literals} & \emph{Byte code} \\
-\hline
-\end{tabular}
-\end{center}
-
-\noindent where:
-\begin{itemize}
-\item The entry code is a static code fragment/info table that returns
-to the scheduler to invoke Hugs (\secref{ghc-to-hugs-switch}).
-\item \emph{Layout} contains the number of pointer literals in the
-\emph{Literals} field.
-\item \emph{Offset} is the offset to the byte code from the start of
-the object.
-\item \emph{Size} is the number of words of byte code in the object.
-\item \emph{Literals} contains any pointer and non-pointer literals used in
-the byte-codes (including jump addresses), pointers first.
-\item \emph{Byte code} contains \emph{Size} words of non-pointer byte
-code.
-\end{itemize}
-
-
-\Subsubsection{Partial applications}{PAP}
-
-A partial application (PAP) represents a function applied to too few
-arguments.  It is only built as a result of updating after an
-argument-satisfaction check failure.  A PAP has the following shape:
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-\emph{Fixed header}  & \emph{No of words of stack} & \emph{Function closure} & \emph{Stack chunk ...} \\ \hline
-\end{tabular}
-\end{center}
-
-The ``Stack chunk'' is a copy of the chunk of stack above the update
-frame; ``No of words of stack'' tells how many words it consists of.
-The function closure is (a pointer to) the closure for the function
-whose argument-satisfaction check failed.
-
-In the normal case where a PAP is built as a result of an argument
-satisfaction check failure, the stack chunk will just contain
-``pending arguments'', ie. pointers and tagged non-pointers.  It may
-in fact also contain activation records, but not update frames, seq
-frames, or catch frames.  The reason is the garbage collector uses the
-same code to scavenge a stack as it does to scavenge the payload of a
-PAP, but an update frame contains a link to the next update frame in
-the chain and this link would need to be relocated during garbage
-collection.  Revertible black holes and asynchronous exceptions use
-the more general form of PAPs (see Section \ref{revertible-bh}).
-
-There is just one standard form of PAP. There is just one info table
-too, called @PAP_info@.  Its entry code simply copies the arg stack
-chunk back on top of the stack and enters the function closure.  (It
-has to do a stack overflow test first.)
-
-There is just one way to build a PAP: by calling @stg_update_PAP@ with
-the function closure in register @R1@ and the pending arguments on the
-stack.  The @stg_update_PAP@ function will build the PAP, perform the
-update, and return to the next activation record on the stack.  If
-there are \emph{no} pending arguments on the stack, then no PAP need
-be built: in this case @stg_update_PAP@ just overwrites the updatee
-with an indirection to the function closure.
-
-PAPs are also used to implement Hugs functions (where the arguments
-are free variables).  PAPs generated by Hugs can be static so we need
-both @PAP@ and @PAP_STATIC@.
-
-\Subsubsection{\texttt{AP\_UPD} objects}{AP_UPD}
-
-@AP_UPD@ objects are used to represent thunks built by Hugs, and to
-save the currently-active computations when performing @raiseAsync()@.
-The only
-distinction between an @AP_UPD@ and a @PAP@ is that an @AP_UPD@ is
-updateable.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}
-\hline
-\emph{Fixed Header} & \emph{No of stack words} & \emph{Function closure} & \emph{Stack chunk} \\
-\hline
-\end{tabular}
-\end{center}
-
-The entry code pushes an update frame, copies the arg stack chunk on
-top of the stack, and enters the function closure.  (It has to do a
-stack overflow test first.)
-
-The ``stack chunk'' is a block of stack not containing update frames,
-seq frames or catch frames (just like a PAP).  In the case of Hugs,
-the stack chunk will contain the free variables of the thunk, and the
-function closure is (a pointer to) the closure for the thunk.  The
-argument stack may be empty if the thunk has no free variables.
-
-\note{Since @AP\_UPD@s are updateable, the @MIN\_UPD\_SIZE@ constraint applies here too.}
-
-\Subsubsection{Indirections}{IND}
-
-Indirection closures just point to other closures. They are introduced
-when a thunk is updated to point to its value.  The entry code for all
-indirections simply enters the closure it points to.
-
-There are several forms of indirection:
-
-\begin{description}
-\item[@IND@] is the vanilla, dynamically-allocated indirection.
-It is removed by the garbage collector. It has the following
-shape:
-\begin{center}
-\begin{tabular}{|l|l|l|}\hline
-\emph{Fixed header} & \emph{Target closure} \\ \hline
-\end{tabular}
-\end{center}
-
-An @IND@ only exists in the youngest generation.  In older
-generations, we have @IND_OLDGEN@s.  The update code
-(@Upd_frame_$n$_entry@) checks whether the updatee is in the youngest
-generation before deciding which kind of indirection to use.
-
-\item[@IND\_OLDGEN@] is the vanilla, dynamically-allocated indirection.
-It is removed by the garbage collector. It has the following
-shape:
-\begin{center}
-\begin{tabular}{|l|l|l|}\hline
-\emph{Fixed header} & \emph{Target closure} & \emph{Mutable link field} \\ \hline
-\end{tabular}
-\end{center}
-It contains a \emph{mutable link field} that is used to string together
-mutable objects in each old generation.
-
-\item[@IND\_PERM@]
-For lexical profiling, it is necessary to maintain cost centre
-information in an indirection, so ``permanent indirections'' are
-retained forever.  Otherwise they are just like vanilla indirections.
-\note{If a permanent indirection points to another permanent
-indirection or a @CONST@ closure, it is possible to elide the indirection
-since it will have no effect on the profiler.}
-
-\note{Do we still need @IND@ in the profiling build, or do we just
-need @IND@ but its behaviour changes when profiling is on?}
-
-\item[@IND\_OLDGEN\_PERM@]
-Just like an @IND_OLDGEN@, but sticks around like an @IND_PERM@.
-
-\item[@IND\_STATIC@] is used for overwriting CAFs when they have been
-evaluated.  Static indirections are not removed by the garbage
-collector; and are statically allocated outside the heap (and should
-stay there).  Their static object link field is used just as for
-@FUN_STATIC@ closures.
-
-\begin{center}
-\begin{tabular}{|l|l|l|}
-\hline
-\emph{Fixed header} & \emph{Target closure} & \emph{Static link field} \\
-\hline
-\end{tabular}
-\end{center}
-
-\end{description}
-
-\subsubsection{Black holes and blocking queues}
-\label{sec:BLACKHOLE}
-\label{sec:BLACKHOLE_BQ}
-
-Black hole closures are used to overwrite closures currently being
-evaluated. They inform the garbage collector that there are no live
-roots in the closure, thus removing a potential space leak.  
-
-Black holes also become synchronization points in the concurrent
-world.  When a thread attempts to enter a blackhole, it must wait for
-the result of the computation, which is presumably in progress in
-another thread.
-
-\note{In a single-threaded system, entering a black hole indicates an
-infinite loop.  In a concurrent system, entering a black hole
-indicates an infinite loop only if the hole is being entered by the
-same thread that originally entered the closure.  It could also bring
-about a deadlock situation where several threads are waiting
-circularly on computations in progress.}
-
-There are two types of black hole:
-
-\begin{description}
-
-\item[@BLACKHOLE@]
-A straightforward blackhole just consists of an info pointer and some
-padding to allow updating with an @IND_OLDGEN@ if necessary.  This
-type of blackhole has no waiting threads.
-
-\begin{center}
-\begin{tabular}{|l|l|l|}
-\hline 
-\emph{Fixed header} & \emph{Padding} & \emph{Padding} \\
-\hline
-\end{tabular}
-\end{center}
-
-If we're doing \emph{eager blackholing} then a thunk's info pointer is
-overwritten with @BLACKHOLE_info@ at the time of entry; hence the need
-for blackholes to be small, otherwise we'd be overwriting part of the
-thunk itself.
-
-\item[@BLACKHOLE\_BQ@] 
-When a thread enters a @BLACKHOLE@, it is turned into a @BLACKHOLE_BQ@
-(blocking queue), which contains a linked list of blocked threads in
-addition to the info pointer.
-
-\begin{center}
-\begin{tabular}{|l|l|l|}
-\hline 
-\emph{Fixed header} & \emph{Blocked thread link} & \emph{Mutable link field} \\
-\hline
-\end{tabular}
-\end{center}
-
-The \emph{Blocked thread link} points to the TSO of the first thread
-waiting for the value of this thunk.  All subsequent TSOs in the list
-are linked together using their @tso->link@ field, ending in
-@END_TSO_QUEUE_closure@.
-
-Because new threads can be added to the \emph{Blocked thread link}, a
-blocking queue is \emph{mutable}, so we need a mutable link field in
-order to chain it on to a mutable list for the generational garbage
-collector.
-
-\end{description}
-
-\Subsubsection{FetchMes}{FETCHME} 
-
-In the parallel systems, FetchMes are used to represent pointers into
-the global heap.  When evaluated, the value they point to is read from
-the global heap.
-
-\ToDo{Describe layout}
-
-Because there may be offsets into these arrays, a primitive array
-cannot be handled as a FetchMe in the parallel system, but must be
-shipped in its entirety if its parent closure is shipped.
-
-
-
-\Subsection{Unpointed Objects}{unpointed-objects}
-
-A variable of unpointed type is always bound to a \emph{value}, never
-to a \emph{thunk}.  For this reason, unpointed objects cannot be
-entered.
-
-\subsubsection{Immutable objects}
-\label{sec:ARR_WORDS}
-
-\begin{description}
-\item[@ARR\_WORDS@] is a variable-sized object consisting solely of
-non-pointers.  It is used for arrays of all sorts of things (bytes,
-words, floats, doubles... it doesn't matter).
-
-Strictly speaking, an @ARR_WORDS@ could be mutable, but because it
-only contains non-pointers we don't need to track this fact.
-
-\begin{center}
-\begin{tabular}{|c|c|c|c|}
-\hline
-\emph{Fixed Hdr} & \emph{No of non-pointers} & \emph{Non-pointers\ldots}	\\ \hline
-\end{tabular}
-\end{center}
-\end{description}
-
-\subsubsection{Mutable objects}
-\label{sec:mutables}
-\label{sec:MUT_VAR}
-\label{sec:MUT_ARR_PTRS}
-\label{sec:MUT_ARR_PTRS_FROZEN}
-\label{sec:MVAR}
-
-Some of these objects are \emph{mutable}; they represent objects which
-are explicitly mutated by Haskell code through the @ST@ or @IO@
-monads.  They're not used for thunks which are updated precisely once.
-Depending on the garbage collector, mutable closures may contain extra
-header information which allows a generational collector to implement
-the ``write barrier.''
-
-Notice that mutable objects all have the same general layout: there is
-a mutable link field as the second word after the header.  This is so
-that code to process old-generation mutable lists doesn't need to look
-at the type of the object to determine where its link field is.
-
-\begin{description}
-
-\item[@MUT\_VAR@] is a mutable variable.
-\begin{center}
-\begin{tabular}{|c|c|c|}
-\hline
-\emph{Fixed Hdr} \emph{Pointer} & \emph{Mutable link} & \\ \hline
-\end{tabular}
-\end{center}
-
-\item[@MUT\_ARR\_PTRS@] is a mutable array of pointers.  Such an array
-may be \emph{frozen}, becoming an @MUT_ARR_PTRS_FROZEN@, with a
-different info-table.
-
-\begin{center}
-\begin{tabular}{|c|c|c|c|}
-\hline
-\emph{Fixed Hdr} & \emph{No of ptrs} & \emph{Mutable link} & \emph{Pointers\ldots} \\ \hline
-\end{tabular}
-\end{center}
-
-\item[@MUT\_ARR\_PTRS\_FROZEN@] This is the immutable version of
-@MUT_ARR_PTRS@.  It still has a mutable link field for two reasons: we
-need to keep it on the mutable list for an old generation at least
-until the next garbage collection, and it may become mutable again via
-@thawArray@.
-
-\begin{center}
-\begin{tabular}{|c|c|c|c|}
-\hline
-\emph{Fixed Hdr} & \emph{No of ptrs} & \emph{Mutable link} & \emph{Pointers\ldots} \\ \hline
-\end{tabular}
-\end{center}
-
-\item[@MVAR@]
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|l|}
-\hline 
-\emph{Fixed header} & \emph{Head} & \emph{Mutable link} & \emph{Tail}
-& \emph{Value}\\
-\hline
-\end{tabular}
-\end{center}
-
-\ToDo{MVars}
-
-\end{description}
-
-
-\Subsubsection{Foreign objects}{FOREIGN}
-
-Here's what a ForeignObj looks like:
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}
-\hline 
-\emph{Fixed header} & \emph{Data} \\
-\hline
-\end{tabular}
-\end{center}
-
-A foreign object is simple a boxed pointer to an address outside the
-Haskell heap, possible to @malloc@ed data.  The only reason foreign
-objects exist is so that we can track the lifetime of one using weak
-pointers (see \secref{WEAK}) and run a finaliser when the foreign
-object is unreachable.
-
-\subsubsection{Weak pointers}
-\label{sec:WEAK}
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|l|}
-\hline 
-\emph{Fixed header} & \emph{Key} & \emph{Value} & \emph{Finaliser}
-& \emph{Link}\\
-\hline
-\end{tabular}
-\end{center}
-
-\ToDo{Weak poitners}
-
-\subsubsection{Stable names}
-\label{sec:STABLE_NAME}
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}
-\hline 
-\emph{Fixed header} & \emph{Index} \\
-\hline
-\end{tabular}
-\end{center}
-
-\ToDo{Stable names}
-
-The remaining objects types are all administrative --- none of them
-may be entered.
-
-\subsection{Other weird objects}
-\label{sec:SPARK}
-\label{sec:BLOCKED_FETCH}
-
-\begin{description}
-\item[@BlockedFetch@ heap objects (`closures')] (parallel only)
-
-@BlockedFetch@s are inbound fetch messages blocked on local closures.
-They arise as entries in a local blocking queue when a fetch has been
-received for a local black hole.  When awakened, we look at their
-contents to figure out where to send a resume.
-
-A @BlockedFetch@ closure has the form:
-\begin{center}
-\begin{tabular}{|l|l|l|l|l|l|}\hline
-\emph{Fixed header} & link & node & gtid & slot & weight \\ \hline
-\end{tabular}
-\end{center}
-
-\item[Spark Closures] (parallel only)
-
-Spark closures are used to link together all closures in the spark pool.  When
-the current processor is idle, it may choose to speculatively evaluate some of
-the closures in the pool.  It may also choose to delete sparks from the pool.
-\begin{center}
-\begin{tabular}{|l|l|l|l|l|l|}\hline
-\emph{Fixed header} & \emph{Spark pool link} & \emph{Sparked closure} \\ \hline
-\end{tabular}
-\end{center}
-
-\item[Slop Objects]\label{sec:slop-objects}
-
-Slop objects are used to overwrite the end of an updatee if it is
-larger than an indirection.  Normal slop objects consist of an info
-pointer a size word and a number of slop words.  
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|l|l|}\hline
-\emph{Info Pointer} & \emph{Size} & \emph{Slop Words} \\ \hline
-\end{tabular}
-\end{center}
-
-This is too large for single word slop objects which consist of a
-single info table.
-
-Note that slop objects only contain an info pointer, not a standard
-fixed header.  This doesn't cause problems because slop objects are
-always unreachable --- they can only be accessed by linearly scanning
-the heap.
-
-\note{Currently we don't use slop objects because the storage manager
-isn't reliant on objects being adjacent, but if we move to a ``mostly
-copying'' style collector, this will become an issue.}
-
-\end{description}
-
-\Subsection{Thread State Objects (TSOs)}{TSO}
-
-In the multi-threaded system, the state of a suspended thread is
-packed up into a Thread State Object (TSO) which contains all the
-information needed to restart the thread and for the garbage collector
-to find all reachable objects.  When a thread is running, it may be
-``unpacked'' into machine registers and various other memory locations
-to provide faster access.
-
-Single-threaded systems don't really \emph{need\/} TSOs --- but they do
-need some way to tell the storage manager about live roots so it is
-convenient to use a single TSO to store the mutator state even in
-single-threaded systems.
-
-Rather than manage TSOs' alloc/dealloc, etc., in some \emph{ad hoc}
-way, we instead alloc/dealloc/etc them in the heap; then we can use
-all the standard garbage-collection/fetching/flushing/etc machinery on
-them.  So that's why TSOs are ``heap objects,'' albeit very special
-ones.
-\begin{center}
-\begin{tabular}{|l|l|}
-   \hline \emph{Fixed header}
-\\ \hline \emph{Link field}
-\\ \hline \emph{Mutable link field}
-\\ \hline \emph{What next}
-\\ \hline \emph{State}
-\\ \hline \emph{Thread Id}
-\\ \hline \emph{Exception Handlers}
-\\ \hline \emph{Ticky Info}
-\\ \hline \emph{Profiling Info}
-\\ \hline \emph{Parallel Info}
-\\ \hline \emph{GranSim Info}
-\\ \hline \emph{Stack size}
-\\ \hline \emph{Max Stack size}
-\\ \hline \emph{Sp}
-\\ \hline \emph{Su}
-\\ \hline \emph{SpLim}
-\\ \hline 
-\\
-          \emph{Stack}
-\\
-\\ \hline 
-\end{tabular}
-\end{center}
-The contents of a TSO are:
-\begin{description}
-
-\item[\emph{Link field}] This is a pointer used to maintain a list of
-threads with a similar state (e.g.~all runnable, all sleeping, all
-blocked on the same black hole, all blocked on the same MVar,
-etc.)
-
-\item[\emph{Mutable link field}] Because the stack is mutable by
-definition, the generational collector needs to track TSOs in older
-generations that may point into younger ones (which is just about any
-TSO for a thread that has run recently).  Hence the need for a mutable
-link field (see \secref{mutables}).
-
-\item[\emph{What next}]
-This field has five values:  
-\begin{description}
-\item[@ThreadEnterGHC@]  The thread can be started by entering the
-closure pointed to by the word on the top of the stack.
-\item[@ThreadRunGHC@]  The thread can be started by jumping to the
-address on the top of the stack.
-\item[@ThreadEnterHugs@]  The stack has a pointer to a Hugs-built
-closure on top of the stack: enter the closure to run the thread.
-\item[@ThreadKilled@] The thread has been killed (by @killThread#@).
-It is probably still around because it is on some queue somewhere and
-hasn't been garbage collected yet.
-\item[@ThreadComplete@] The thread has finished.  Its @TSO@ hasn't
-been garbage collected yet.
-\end{description}
-
-\item[\emph{Thread Id}]
-This field contains a (not necessarily unique) integer that identifies
-the thread.  It can be used eg. for hashing.
-
-\item[\emph{Ticky Info}] Optional information for ``Ticky Ticky''
-statistics: @TSO_STK_HWM@ is the maximum number of words allocated to
-this thread.
-
-\item[\emph{Profiling Info}] Optional information for profiling:
-@TSO_CCC@ is the current cost centre.
-
-\item[\emph{Parallel Info}]
-Optional information for parallel execution.
-
-% \begin{itemize}
-% 
-% \item The types of threads (@TSO_TYPE@):
-% \begin{description}
-% \item[@T_MAIN@]     Must be executed locally.
-% \item[@T_REQUIRED@] A required thread  -- may be exported.
-% \item[@T_ADVISORY@] An advisory thread -- may be exported.
-% \item[@T_FAIL@]     A failure thread   -- may be exported.
-% \end{description}
-% 
-% \item I've no idea what else
-% 
-% \end{itemize}
-
-\item[\emph{GranSim Info}]
-Optional information for gransim execution.
-
-% \item Optional information for GranSim execution:
-% \begin{itemize}
-% \item locked         
-% \item sparkname	 
-% \item started at	 
-% \item exported	 
-% \item basic blocks	 
-% \item allocs	 
-% \item exectime	 
-% \item fetchtime	 
-% \item fetchcount	 
-% \item blocktime	 
-% \item blockcount	 
-% \item global sparks	 
-% \item local sparks	 
-% \item queue		 
-% \item priority	 
-% \item clock          (gransim light only)
-% \end{itemize}
-% 
-% 
-% Here are the various queues for GrAnSim-type events.
-% 
-% Q_RUNNING   
-% Q_RUNNABLE  
-% Q_BLOCKED   
-% Q_FETCHING  
-% Q_MIGRATING 
-% 
-
-\item[\emph{Stack Info}] Various fields contain information on the
-stack: its current size, its maximum size (to avoid infinite loops
-overflowing the memory), the current stack pointer (\emph{Sp}), the
-current stack update frame pointer (\emph{Su}), and the stack limit
-(\emph{SpLim}).  The latter three fields are loaded into the relevant
-registers when the thread is run.
-
-\item[\emph{Stack}] This is the actual stack for the thread,
-\emph{Stack size} words long.  It grows downwards from higher
-addresses to lower addresses.  When the stack overflows, it will
-generally be relocated into larger premises unless \emph{Max stack
-size} is reached.
-
-\end{description}
-
-The garbage collector needs to be able to find all the
-pointers in a stack.  How does it do this?
-
-\begin{itemize}
-
-\item Within the stack there are return addresses, pushed
-by @case@ expressions.  Below a return address (i.e. at higher
-memory addresses, since the stack grows downwards) is a chunk
-of stack that the return address ``knows about'', namely the
-activation record of the currently running function.
-
-\item Below each such activation record is a \emph{pending-argument
-section}, a chunk of
-zero or more words that are the arguments to which the result
-of the function should be applied.  The return address does not
-statically
-``know'' how many pending arguments there are, or their types.
-(For example, the function might return a result of type $\alpha$.)
-
-\item Below each pending-argument section is another return address,
-and so on.  Actually, there might be an update frame instead, but we
-can consider update frames as a special case of a return address with
-a well-defined activation record.
-
-\end{itemize}
-
-The game plan is this.  The garbage collector walks the stack from the
-top, traversing pending-argument sections and activation records
-alternately.  Next we discuss how it finds the pointers in each of
-these two stack regions.
-
-
-\Subsubsection{Activation records}{activation-records}
-
-An \emph{activation record} is a contiguous chunk of stack,
-with a return address as its first word, followed by as many
-data words as the return address ``knows about''.  The return
-address is actually a fully-fledged info pointer.  It points
-to an info table, replete with:
-
-\begin{itemize}
-\item entry code (i.e. the code to return to).
-
-\item closure type is either @RET_SMALL/RET_VEC_SMALL@ or
-@RET_BIG/RET_VEC_BIG@, depending on whether the activation record has
-more than 32 data words (\note{64 for 8-byte-word architectures}) and
-on whether to use a direct or a vectored return.
-
-\item the layout info for @RET_SMALL@ is a bitmap telling the layout
-of the activation record, one bit per word.  The least-significant bit
-describes the first data word of the record (adjacent to the fixed
-header) and so on.  A ``@1@'' indicates a non-pointer, a ``@0@''
-indicates a pointer.  We don't need to indicate exactly how many words
-there are, because when we get to all zeros we can treat the rest of
-the activation record as part of the next pending-argument region.
-
-For @RET_BIG@ the layout field points to a block of bitmap words,
-starting with a word that tells how many words are in the block.
-
-\item the info table contains a Static Reference Table pointer for the
-return address (\secref{srt}).
-\end{itemize}
-
-The activation record is a fully fledged closure too.  As well as an
-info pointer, it has all the other attributes of a fixed header
-(\secref{fixed-header}) including a saved cost centre which
-is reloaded when the return address is entered.
-
-In other words, all the attributes of closures are needed for
-activation records, so it's very convenient to make them look alike.
-
-
-\Subsubsection{Pending arguments}{pending-args}
-
-So that the garbage collector can correctly identify pointers in
-pending-argument sections we explicitly tag all non-pointers.  Every
-non-pointer in a pending-argument section is preceded (at the next
-lower memory word) by a one-word byte count that says how many bytes
-to skip over (excluding the tag word).
-
-The garbage collector traverses a pending argument section from the
-top (i.e. lowest memory address).  It looks at each word in turn:
-
-\begin{itemize}
-\item If it is less than or equal to a small constant @ARGTAG_MAX@
-then it treats it as a tag heralding zero or more words of
-non-pointers, so it just skips over them.
-
-\item If it points to the code segment, it must be a return
-address, so we have come to the end of the pending-argument section.
-
-\item Otherwise it must be a bona fide heap pointer.
-\end{itemize}
-
-
-\Subsection{The Stable Pointer Table}{STABLEPTR_TABLE}
-
-A stable pointer is a name for a Haskell object which can be passed to
-the external world.  It is ``stable'' in the sense that the name does
-not change when the Haskell garbage collector runs---in contrast to
-the address of the object which may well change.
-
-A stable pointer is represented by an index into the
-@StablePointerTable@.  The Haskell garbage collector treats the
-@StablePointerTable@ as a source of roots for GC.
-
-In order to provide efficient access to stable pointers and to be able
-to cope with any number of stable pointers (eg $0 \ldots 100000$), the
-table of stable pointers is an array stored on the heap and can grow
-when it overflows.  (Since we cannot compact the table by moving
-stable pointers about, it seems unlikely that a half-empty table can
-be reduced in size---this could be fixed if necessary by using a
-hash table of some sort.)
-
-In general a stable pointer table closure looks like this:
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|l|l|l|l|l|l|l|}
-\hline
-\emph{Fixed header} & \emph{No of pointers} & \emph{Free} & $SP_0$ & \ldots & $SP_{n-1}$ 
-\\\hline
-\end{tabular}
-\end{center}
-
-The fields are:
-\begin{description}
-
-\item[@NPtrs@:] number of (stable) pointers.
-
-\item[@Free@:] the byte offset (from the first byte of the object) of the first free stable pointer.
-
-\item[$SP_i$:] A stable pointer slot.  If this entry is in use, it is
-an ``unstable'' pointer to a closure.  If this entry is not in use, it
-is a byte offset of the next free stable pointer slot.
-
-\end{description}
-
-When a stable pointer table is evacuated
-\begin{enumerate}
-\item the free list entries are all set to @NULL@ so that the evacuation
-  code knows they're not pointers;
-
-\item The stable pointer slots are scanned linearly: non-@NULL@ slots
-are evacuated and @NULL@-values are chained together to form a new free list.
-\end{enumerate}
-
-There's no need to link the stable pointer table onto the mutable
-list because we always treat it as a root.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\Subsection{Garbage Collecting CAFs}{CAF}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-% begin{direct quote from current paper}
-A CAF (constant applicative form) is a top-level expression with no
-arguments.  The expression may need a large, even unbounded, amount of
-storage when it is fully evaluated.
-
-CAFs are represented by closures in static memory that are updated
-with indirections to objects in the heap space once the expression is
-evaluated.  Previous version of GHC maintained a list of all evaluated
-CAFs and traversed them during GC, the result being that the storage
-allocated by a CAF would reside in the heap until the program ended.
-% end{direct quote from current paper}
-
-% begin{elaboration on why CAFs are very very bad}
-Treating CAFs this way has two problems:
-\begin{itemize}
-\item
-It can cause a very large space leak.  For example, this program
-should run in constant space but, instead, will run out of memory.
-\begin{verbatim}
-> main :: IO ()
-> main = print nats
->
-> nats :: [Int]
-> nats = [0..maxInt]
-\end{verbatim}
-
-\item
-Expressions with no arguments have very different space behaviour
-depending on whether or not they occur at the top level.  For example, 
-if we make \verb+nats+ a local definition, the space leak goes away 
-and the resulting program runs in constant space, as expected.
-\begin{verbatim}
-> main :: IO ()
-> main = print nats
->  where
->   nats :: [Int]
->   nats = [0..maxInt]
-\end{verbatim}
-
-This huge change in the operational behaviour of the program 
-is a problem for optimising compilers and for programmers.
-For example, GHC will normally flatten a set of let bindings using
-this transformation:
-\begin{verbatim}
-let x1 = let x2 = e2 in e1   ==>   let x2 = e2 in let x1 = e1
-\end{verbatim}
-but it does not do so if this would raise \verb+x2+ to the top level
-since that may create a CAF.  Many Haskell programmers avoid creating
-large CAFs by adding a dummy argument to a CAF or by moving a CAF away
-from the top level.
-
-\end{itemize}
-% end{elaboration on why CAFs are very very bad}
-
-Solving the CAF problem requires different treatment in interactive
-systems such as Hugs than in batch-mode systems such as GHC 
-\begin{itemize}
-\item
-In a batch-mode the program the runtime system is terminated
-after every execution of the runtime system.  In such systems,
-the garbage collector can completely ``destroy'' a CAF when it 
-is no longer live --- in much the same way as it ``destroys''
-normal closures when they are no longer live.
-
-\item
-In an interactive system, many expressions are evaluated without
-restarting the runtime system between each evaluation.  In such
-systems, the garbage collector cannot completely ``destroy'' a CAF
-when it is no longer live because, whilst it might not be required in
-the evaluation of the current expression, it might be required in the
-next evaluation.
-
-There are two possible behaviours we might want:
-\begin{enumerate}
-\item
-When a CAF is no longer required for the current evaluation, the CAF
-should be reverted to its original form.  This behaviour ensures that
-the operational behaviour of the interactive system is a reasonable
-predictor of the operational behaviour of the batch-mode system.  This
-allows us to use Hugs for performance debugging (in particular, trying
-to understand and reduce the heap usage of a program) --- an area of
-increasing importance as Haskell is used more and more to solve ``real
-problems'' in ``real problem domains''.
-
-\item
-Even if a CAF is no longer required for the current evaluation, we might
-choose to hang onto it by collecting it in the normal way.  This keeps
-the space leak but might be useful in a teaching environment when
-trying to teach the difference between call by name evaluation (which
-doesn't share work) and lazy evaluation (which does share work).
-
-\end{enumerate}
-
-It turns out that it is easy to support both styles of use, so the
-runtime system provides a switch which lets us turn this on and off
-during execution.  \ToDo{What is this switch called?}  It would also
-be easy to provide a function \verb+RevertCAF+ to let the interpreter
-revert any CAF it wanted between (but not during) executions, if we so
-desired.  Running \verb+RevertCAF+ during execution would lose some sharing
-but is otherwise harmless.
-
-\end{itemize}
-
-% % begin{even more pointless observation?}
-% The simplest fix would be to remove the special treatment of 
-% top level variables.  This works but is very inefficient.
-% ToDo: say why.
-% (Note: delete this paragraph from final version.)
-% % end{even more pointless observation?}
-
-% begin{pointless observation?}
-An easy but inefficient fix to the CAF problem would be to make a
-complete copy of the heap before every evaluation and discard the copy
-after evaluation.  This works but is inefficient.
-% end{pointless observation?}
-
-An efficient way to achieve a similar effect is to revert all
-updatable thunks to their original form as they become unnecessary for
-the current evaluation.  To do this, we modify the compiler to ensure
-that the only updatable thunks generated by the compiler are CAFs and
-we modify the garbage collector to revert entered CAFs to unentered
-CAFs as their value becomes unnecessary.
-
-
-\subsubsection{New Heap Objects}
-
-We add three new kinds of heap object: unentered CAF closures, entered
-CAF objects and CAF blackholes.  We first describe how they are
-evaluated and then how they are garbage collected.
-\begin{itemize}
-\item
-Unentered CAF closures contain a pointer to closure representing the
-body of the CAF.  The ``body closure'' is not updatable.
-
-Unentered CAF closures contain two unused fields to make them the same
-size as entered CAF closures --- which allows us to perform an inplace
-update.  \ToDo{Do we have to add another kind of inplace update operation
-to the storage manager interface or do we consider this to be internal
-to the SM?}
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-\verb+CAF_unentered+ & \emph{body closure} & \emph{unused} & \emph{unused} \\ \hline
-\end{tabular}
-\end{center}
-When an unentered CAF is entered, we do the following:
-\begin{itemize}
-\item
-allocate a CAF black hole;
-
-\item
-push an update frame (to update the CAF black hole) onto the stack;
-
-\item
-overwrite the CAF with an entered CAF object (see below) with the same
-body and whose value field points to the black hole;
-
-\item
-add the CAF to a list of all entered CAFs (called ``the CAF list'');
-and
-
-\item
-the closure representing the value of the CAF is entered.
-
-\end{itemize}
-
-When evaluation of the CAF body returns a value, the update frame
-causes the CAF black hole to be updated with the value in the normal
-way.
-
-\ToDo{Add a picture}
-
-\item
-Entered CAF closures contain two pointers: a pointer to the CAF body
-(the same as for unentered CAF closures); a pointer to the CAF value
-(this is initialised with a CAF blackhole, as previously described);
-and a link to the next CAF in the CAF list 
-
-\ToDo{How is the end of the list marked?  Null pointer or sentinel value?}.
-
-\begin{center}
-\begin{tabular}{|l|l|l|l|}\hline
-\verb+CAF_entered+ & \emph{body closure} & \emph{value} & \emph{link} \\ \hline
-\end{tabular}
-\end{center}
-When an entered CAF is entered, it enters its value closure.
-
-\item
-CAF blackholes are identical to normal blackholes except that they
-have a different infotable.  The only reason for having CAF blackholes
-is to allow an optimisation of lazy blackholing where we stop scanning
-the stack when we see the first {\em normal blackhole} but not
-when we see a {\em CAF blackhole.}
-\ToDo{The optimisation we want to allow should be described elsewhere
-so that all we have to do here is describe the difference.}
-
-Instead of allocating a blackhole to update with the value of the CAF,
-it might seem simpler to update the CAF directly.  This would require
-a new kind of update frame which would update the value field of the
-CAF with a pointer to the value and wouldn't catch blackholes caused
-by CAFs that depend on themselves so we chose not to do so.
-
-\end{itemize}
-
-\subsubsection{Garbage Collection}
-
-To avoid the space leak, each run of the garbage collector must revert
-the entered CAFs which are not required to complete the current
-evaluation (that is all the closures reachable from the set of
-runnable threads and the stable pointer table).
-
-It does this by performing garbage collection in three phases:
-\begin{enumerate}
-\item
-During the first phase, we ``mark'' all closures reachable from the
-scheduler state.  
-
-How we ``mark'' closures depends on the garbage collector.  For
-example, in a 2-space collector, closures are ``marked'' by copying
-them into ``to-space'', overwriting them with a forwarding node and
-``marking'' all the closures reachable from the copy.  The only
-requirements are that we can test whether a closure is marked and if a
-closure is marked then so are all closures reachable from it.
-
-\ToDo{At present we say that the scheduler state includes any state
-that Hugs may have.  This is not true anymore.}
-
-Performing this phase first provides us with a cheap test for
-execution closures: at this stage in execution, the execution closures
-are precisely the marked closures.
-
-\item
-During the second phase, we revert all unmarked CAFs on the CAF list
-and remove them from the CAF list.
-
-Since the CAF list is exactly the set of all entered CAFs, this reverts
-all entered CAFs which are not execution closures.
-
-\item
-During the third phase, we mark all top level objects (including CAFs)
-by calling \verb+MarkHugsRoots+ which will call \verb+MarkRoot+ for
-each top level object known to Hugs.
-
-\end{enumerate}
-
-To implement the second style of interactive behaviour (where we
-deliberately keep the CAF-related space leak), we simply omit the
-second phase.  Omitting the second phase causes the third phase to
-mark any unmarked CAF value closures.
-
-So far, we have been describing a pure Hugs system which contains no
-machine generated code.  The main difference in a hybrid system is
-that GHC-generated code is statically allocated in memory instead of
-being dynamically allocated on the heap.  We split both
-\verb+CAF_unentered+ and \verb+CAF_entered+ into two versions: a
-static and a dynamic version.  The static and dynamic versions of each
-CAF differ only in whether they are moved during garbage collection.
-When reverting CAFs, we revert dynamic entered CAFs to dynamic
-unentered CAFs and static entered CAFs to static unentered CAFs.
-
-
-
-
-\Section{The Bytecode Evaluator}{bytecode-evaluator}
-
-This section describes how the Hugs interpreter interprets code in the
-same environment as compiled code executes.  Both evaluation models
-use a common garbage collector, so they must agree on the form of
-objects in the heap.
-
-Hugs interprets code by converting it to byte-code and applying a
-byte-code interpreter to it.  Wherever possible, we try to ensure that
-the byte-code is all that is required to interpret a section of code.
-This means not dynamically generating info tables, and hence we can
-only have a small number of possible heap objects each with a statically
-compiled info table.  Similarly for stack objects: in fact we only
-have one Hugs stack object, in which all information is tagged for the
-garbage collector.
-
-There is, however, one exception to this rule.  Hugs must generate
-info tables for any constructors it is asked to compile, since the
-alternative is to force a context-switch each time compiled code
-enters a Hugs-built constructor, which would be prohibitively
-expensive.
-
-We achieve this simplicity by forgoing some of the optimisations used
-by compiled code:
-\begin{itemize}
-\item
-
-Whereas compiled code has five different ways of entering a closure
-(\secref{ghc-fun-call}), interpreted code has only one.
-The entry point for interpreted code behaves like slow entry points for
-compiled code.
-
-\item
-
-We use just one info table for \emph{all\/} direct returns.  
-This introduces two problems:
-\begin{enumerate}
-\item How does the interpreter know what code to execute?
-
-Instead of pushing just a return address, we push a return BCO and a 
-trivial return address which just enters the return BCO.
-
-(In a purely interpreted system, we could avoid pushing the trivial
-return address.)
-
-\item How can the garbage collector follow pointers within the
-activation record?
-
-We could push a third word ---a bitmask describing the location of any
-pointers within the record--- but, since we're already tagging unboxed
-function arguments on the stack, we use the same mechanism for unboxed
-values within the activation record.
-
-\ToDo{Do we have to stub out dead variables in the activation frame?}
-
-\end{enumerate}
-
-\item
-
-We trivially support vectored returns by pushing a return vector whose
-entries are all the same.
-
-\item
-
-We avoid the need to build SRTs by putting bytecode objects on the
-heap and restricting BCOs to a single basic block.
-
-\end{itemize}
-
-\Subsection{Hugs Info Tables}{hugs-info-tables}
-
-Hugs requires the following info tables and closures:
-\begin{description}
-\item [@HUGS\_RET@].
-
-Contains both a vectored return table and a direct entry point.  All
-entry points are the same: they rearrange the stack to match the Hugs
-return convention (\secref{hugs-return-convention}) and return to the
-scheduler.  When the scheduler restarts the thread, it will find a BCO
-on top of the stack and will enter the Hugs interpreter.
-
-\item [@UPD\_RET@].
-
-This is just the standard info table for an update frame.
-
-\item [Constructors].
-
-The entry code for a constructor jumps to a generic entry point in the
-runtime system which decides whether to do a vectored or unvectored
-return depending on the shape of the constructor/type.  This implies that
-info tables must have enough info to make that decision.
-
-\item [@AP@ and @PAP@].
-
-\item [Indirections].
-
-\item [Selectors].
-
-Hugs doesn't generate them itself but it ought to recognise them
-
-\item [Complex primops].
-
-Some of the primops are too complex for GHC to generate inline.
-Instead, these primops are hand-written and called as normal functions.
-Hugs only needs to know their names and types but doesn't care whether
-they are generated by GHC or by hand.  Two things to watch:
-
-\begin{enumerate}
-\item
-Hugs must be able to enter these primops even if it is working on a
-standalone system that does not support genuine GHC generated code.
-
-\item The complex primops often involve unboxed tuple types (which
-Hugs does not support at the source level) so we cannot specify their
-types in a Haskell source file.
-
-\end{enumerate}
-
-\end{description}
-
-\Subsection{Hugs Heap Objects}{hugs-heap-objects}
-
-\subsubsection{Byte-code objects}
-
-Compiled byte code lives on the global heap, in objects called
-Byte-Code Objects (or BCOs).  The layout of BCOs is described in
-detail in \secref{BCO}, in this section we will describe
-their semantics.
-
-Since byte-code lives on the heap, it can be garbage collected just
-like any other heap-resident data.  Hugs arranges that any BCO's
-referred to by the Hugs symbol tables are treated as live objects by
-the garbage collector.  When a module is unloaded, the pointers to its
-BCOs are removed from the symbol table, and the code will be garbage
-collected some time later.
-
-A BCO represents a basic block of code --- the (only) entry points is
-at the beginning of a BCO, and it is impossible to jump into the
-middle of one.  A BCO represents not only the code for a function, but
-also its closure; a BCO can be entered just like any other closure.
-Hugs performs lambda-lifting during compilation to byte-code, and each
-top-level combinator becomes a BCO in the heap.
-
-
-\subsubsection{Thunks and partial applications}
-
-A thunk consists of a code pointer, and values for the free variables
-of that code.  Since Hugs byte-code is lambda-lifted, free variables
-become arguments and are expected to be on the stack by the called
-function.
-
-Hugs represents updateable thunks with @AP_UPD@ objects applying a closure
-to a list of arguments.  (As for @PAP@s, unboxed arguments should be
-preceded by a tag.)  When it is entered, it pushes an update frame
-followed by its payload on the stack, and enters the first word (which
-will be a pointer to a BCO).  The layout of @AP_UPD@ objects is described
-in more detail in \secref{AP_UPD}.
-
-Partial applications are represented by @PAP@ objects, which are
-non-updatable.
-
-\ToDo{Hugs Constructors}.
-
-\Subsection{Calling conventions}{hugs-calling-conventions}
-
-The calling convention for any byte-code function is straightforward:
-\begin{itemize}
-\item Push any arguments on the stack.
-\item Push a pointer to the BCO.
-\item Begin interpreting the byte code.
-\end{itemize}
-
-In a system containing both GHC and Hugs, the bytecode interpreter
-only has to be able to enter BCOs: everything else can be handled by
-returning to the compiled world (as described in
-\secref{hugs-to-ghc-switch}) and entering the closure
-there.
-
-This would work but it would obviously be very inefficient if we
-entered a @AP@ by switching worlds, entering the @AP@, pushing the
-arguments and function onto the stack, and entering the function
-which, likely as not, will be a byte-code object which we will enter
-by \emph{returning} to the byte-code interpreter.  To avoid such
-gratuitious world switching, we choose to recognise certain closure
-types as being ``standard'' --- and duplicate the entry code for the
-``standard closures'' in the bytecode interpreter.
-
-A closure is said to be ``standard'' if its entry code is entirely
-determined by its info table.  \emph{Standard Closures} have the
-desirable property that the byte-code interpreter can enter the
-closure by simply ``interpreting'' the info table instead of switching
-to the compiled world.  The standard closures include:
-
-\begin{description}
-\item[Constructor] To enter a constructor, we simply return (see
-\secref{hugs-return-convention}).
-
-\item[Indirection]
-To enter an indirection, we simply enter the object it points to
-after possibly adjusting the current cost centre.
-
-\item[@AP@] 
-
-To enter an @AP@, we push an update frame, push the
-arguments, push the function and enter the function.
-(Not forgetting a stack check at the start.)
-
-\item[@PAP@]
-
-To enter a @PAP@, we push the arguments, push the function and enter
-the function.  (Not forgetting a stack check at the start.)
-
-\item[Selector]
-
-To enter a selector (\secref{THUNK_SELECTOR}), we test whether the
-selectee is a value.  If so, we simply select the appropriate
-component; if not, it's simplest to treat it as a GHC-built closure
---- though we could interpret it if we wanted.
-
-\end{description}
-
-The most obvious omissions from the above list are @BCO@s (which we
-dealt with above) and GHC-built closures (which are covered in
-\secref{hugs-to-ghc-switch}).
-
-
-\Subsection{Return convention}{hugs-return-convention}
-
-When Hugs pushes a return address, it pushes both a pointer to the BCO
-to return to, and a pointer to a static code fragment @HUGS_RET@ (this
-is described in \secref{ghc-to-hugs-switch}).  The
-stack layout is shown in \figref{hugs-return-stack}.
-
-\begin{figure}[ht]
-\begin{center}
-\begin{verbatim}
-| stack    |
-+----------+
-| bco      |--> BCO
-+----------+
-| HUGS_RET |
-+----------+
-\end{verbatim}
-%\input{hugs_ret.pstex_t}
-\end{center}
-\caption{Stack layout for a Hugs return address}
-\label{fig:hugs-return-stack}
-% this figure apparently duplicates {fig:hugs-return-stack1} earlier.
-\end{figure}
-
-\begin{figure}[ht]
-\begin{center}
-\begin{verbatim}
-| stack    |
-+----------+
-| con      |--> CON
-+----------+
-\end{verbatim}
-%\input{hugs_ret2.pstex_t}
-\end{center}
-\caption{Stack layout on enterings a Hugs return address}
-\label{fig:hugs-return2}
-\end{figure}
-
-\begin{figure}[ht]
-\begin{center}
-\begin{verbatim}
-| stack    |
-+----------+
-| 3#       |
-+----------+
-| I#       |
-+----------+
-\end{verbatim}
-%\input{hugs_ret2.pstex_t}
-\end{center}
-\caption{Stack layout on entering a Hugs return address with an unboxed value}
-\label{fig:hugs-return-int1}
-\end{figure}
-
-\begin{figure}[ht]
-\begin{center}
-\begin{verbatim}
-| stack    |
-+----------+
-| ghc_ret  |
-+----------+
-| con      |--> CON
-+----------+
-\end{verbatim}
-%\input{hugs_ret3.pstex_t}
-\end{center}
-\caption{Stack layout on enterings a GHC return address}
-\label{fig:hugs-return3}
-\end{figure}
-
-\begin{figure}[ht]
-\begin{center}
-\begin{verbatim}
-| stack    |
-+----------+
-| ghc_ret  |
-+----------+
-| 3#       |
-+----------+
-| I#       |
-+----------+
-| restart  |--> id_Int#_closure
-+----------+
-\end{verbatim}
-%\input{hugs_ret2.pstex_t}
-\end{center}
-\caption{Stack layout on enterings a GHC return address with an unboxed value}
-\label{fig:hugs-return-int}
-\end{figure}
-
-When a Hugs byte-code sequence enters a closure, it examines the 
-return address on top of the stack.
-
-\begin{itemize}
-
-\item If the return address is @HUGS_RET@, pop the @HUGS_RET@ and the
-bco for the continuation off the stack, push a pointer to the constructor onto
-the stack and enter the BCO with the current object pointer set to the BCO
-(\figref{hugs-return2}).
-
-\item If the top of the stack is not @HUGS_RET@, we need to do a world
-switch as described in \secref{hugs-to-ghc-switch}.
-
-\end{itemize}
-
-\ToDo{This duplicates what we say about switching worlds
-(\secref{switching-worlds}) - kill one or t'other.}
-
-
-\ToDo{This was in the evaluation model part but it really belongs in
-this part which is about the internal details of each of the major
-sections.}
-
-\Subsection{Addressing Modes}{hugs-addressing-modes}
-
-To avoid potential alignment problems and simplify garbage collection,
-all literal constants are stored in two tables (one boxed, the other
-unboxed) within each BCO and are referred to by offsets into the tables.
-Slots in the constant tables are word aligned.
-
-\ToDo{How big can the offsets be?  Is the offset specified in the
-address field or in the instruction?}
-
-Literals can have the following types: char, int, nat, float, double,
-and pointer to boxed object.  There is no real difference between
-char, int, nat and float since they all occupy 32 bits --- but it
-costs almost nothing to distinguish them and may improve portability
-and simplify debugging.
-
-\Subsection{Compilation}{hugs-compilation}
-
-
-\def\is{\mbox{\it is}}
-\def\ts{\mbox{\it ts}}
-\def\as{\mbox{\it as}}
-\def\bs{\mbox{\it bs}}
-\def\cs{\mbox{\it cs}}
-\def\rs{\mbox{\it rs}}
-\def\us{\mbox{\it us}}
-\def\vs{\mbox{\it vs}}
-\def\ws{\mbox{\it ws}}
-\def\xs{\mbox{\it xs}}
-
-\def\e{\mbox{\it e}}
-\def\alts{\mbox{\it alts}}
-\def\fail{\mbox{\it fail}}
-\def\panic{\mbox{\it panic}}
-\def\ua{\mbox{\it ua}}
-\def\obj{\mbox{\it obj}}
-\def\bco{\mbox{\it bco}}
-\def\tag{\mbox{\it tag}}
-\def\entry{\mbox{\it entry}}
-\def\su{\mbox{\it su}}
-
-\def\Ind#1{{\mbox{\it Ind}\ {#1}}}
-\def\update#1{{\mbox{\it update}\ {#1}}}
-
-\def\next{$\Longrightarrow$}
-\def\append{\mathrel{+\mkern-6mu+}}
-\def\reverse{\mbox{\it reverse}}
-\def\size#1{{\vert {#1} \vert}}
-\def\arity#1{{\mbox{\it arity}{#1}}}
-
-\def\AP{\mbox{\it AP}}
-\def\PAP{\mbox{\it PAP}}
-\def\GHCRET{\mbox{\it GHCRET}}
-\def\GHCOBJ{\mbox{\it GHCOBJ}}
-
-To make sense of the instructions, we need a sense of how they will be
-used.  Here is a small compiler for the STG language.
-
-\begin{verbatim}
-> cg (f{a1, ... am}) = do
->   pushAtom am; ... pushAtom a1
->   pushVar f
->   SLIDE (m+1) |env|
->   ENTER
-> cg (let {x1=rhs1; ... xm=rhsm} in e) = do
->   ALLOC x1 |rhs1|, ... ALLOC xm |rhsm|
->   build x1 rhs1,   ... build xm rhsm
->   cg e
-> cg (case e of alts) = do
->   PUSHALTS (cgAlts alts)
->   cg e
-
-> cgAlts { alt1; ... altm }  = cgAlt alt1 $ ... $ cgAlt altm pmFail
->
-> cgAlt (x@C{xs} -> e) fail = do
->   TEST C fail
->   HEAPCHECK (heapUse e)
->   UNPACK xs
->   cg e
-
-> build x (C{a1, ... am}) = do 
->   pushUntaggedAtom am; ... pushUntaggedAtom a1
->   PACK x C
-> -- A useful optimisation
-> build x ({v1, ... vm} \ {}. f{a1, ... am}) = do 
->   pushVar am; ... pushVar a1
->   pushVar f
->   MKAP x m
-> build x ({v1, ... vm} \ {}. e) = do 
->   pushVar vm; ... pushVar v1
->   PUSHBCO (cgRhs ({v1, ... vm} \ {}. e))
->   MKAP x m
-> build x ({v1, ... vm} \ {x1, ... xm}. e) = do 
->   pushVar vm; ... pushVar v1
->   PUSHBCO (cgRhs ({v1, ... vm} \ {x1, ... xm}. e))
->   MKPAP x m
-
-> cgRhs (vs \ xs. e) = do
->   ARGCHECK   (xs ++ vs)  -- can be omitted if xs == {}
->   STACKCHECK min(stackUse e,heapOverflowSlop)
->   HEAPCHECK  (heapUse e)
->   cg e
-
-> pushAtom x  = pushVar x
-> pushAtom i# = PUSHINT i#
-
-> pushVar x = if isGlobalVar x then PUSHGLOBAL x else PUSHLOCAL x 
-
-> pushUntaggedAtom x  = pushVar x
-> pushUntaggedAtom i# = PUSHUNTAGGEDINT i#
-
-> pushVar x = if isGlobalVar x then PUSHGLOBAL x else PUSHLOCAL x 
-\end{verbatim}
-
-\ToDo{Is there an easy way to add semi-tagging?  Would it be that different?}
-
-\ToDo{Optimise thunks of the form @f{x1,...xm}@ so that we build an AP directly}
-
-\Subsection{Instructions}{hugs-instructions}
-
-We specify the semantics of instructions using transition rules of
-the form:
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& $\is$		& $s$ 	& $\su$ 	& $h$  & $hp$  & $\sigma$ \\
-\next	& $\is'$	& $s'$ 	& $\su'$	& $h'$ & $hp'$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-where $\is$ is an instruction stream, $s$ is the stack, $\su$ is the 
-update frame pointer and $h$ is the heap.
-
-
-\Subsection{Stack manipulation}{hugs-stack-manipulation}
-
-\begin{description}
-
-\item[ Push a global variable ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& PUSHGLOBAL $o$ : $\is$ & $s$ 		& $su$ & $h$ & $hp$ & $\sigma$ \\
-\next	& $\is$			 & $\sigma!o:s$ & $su$ & $h$ & $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-\item[ Push a local variable ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& PUSHLOCAL $o$ : $\is$	& $s$ 		& $su$ & $h$ & $hp$ & $\sigma$ \\
-\next	& $\is$			& $s!o : s$ 	& $su$ & $h$ & $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-\item[ Push an unboxed int ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& PUSHINT $o$ : $\is$	& $s$ 		        & $su$ & $h$ & $hp$ & $\sigma$ \\
-\next	& $\is$			& $I\# : \sigma!o : s$ 	& $su$ & $h$ & $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-The $I\#$ is a tag included for the benefit of the garbage collector.
-Similar rules exist for floats, doubles, chars, etc.
-
-\item[ Push an unboxed int ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& PUSHUNTAGGEDINT $o$ : $\is$	& $s$ 		        & $su$ & $h$ & $hp$ & $\sigma$ \\
-\next	& $\is$			& $\sigma!o : s$ 	& $su$ & $h$ & $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-Similar rules exist for floats, doubles, chars, etc.
-
-\item[ Delete environment from stack --- ready for tail call ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& SLIDE $m$ $n$ : $\is$	& $\as \append \bs \append \cs$		& $su$ & $h$ & $hp$ & $\sigma$ \\
-\next	& $\is$			& $\as \append \cs$			& $su$ & $h$ & $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-\\
-where $\size{\as} = m$ and $\size{\bs} = n$.
-
-
-\item[ Push a return address ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& PUSHALTS $o$:$\is$	& $s$ 			& $su$ & $h$ & $hp$ & $\sigma$ \\
-\next	& $\is$			& $@HUGS_RET@:\sigma!o:s$ 	& $su$ & $h$ & $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-\item[ Push a BCO ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& PUSHBCO $o$ : $\is$	& $s$ 			& $su$ & $h$ & $hp$ & $\sigma$ \\
-\next	& $\is$			& $\sigma!o : s$ 	& $su$ & $h$ & $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-\end{description}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\Subsection{Heap manipulation}{hugs-heap-manipulation}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-\begin{description}
-
-\item[ Allocate a heap object ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& ALLOC $m$ : $\is$	& $s$    & $su$ & $h$ & $hp$   & $\sigma$ \\
-\next	& $\is$			& $hp:s$ & $su$ & $h$ & $hp+m$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-\item[ Build a constructor ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& PACK $o$ $o'$ : $\is$	& $\ws \append s$ 	& $su$ & $h$ 				& $hp$ & $\sigma$ \\
-\next	& $\is$			& $s$ 			& $su$ & $h[s!o \mapsto Pack C\{\ws\}]$	& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-\\
-where $C = \sigma!o'$ and $\size{\ws} = \arity{C}$.
-
-\item[ Build an AP or  PAP ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& MKAP $o$ $m$:$\is$	& $f : \ws \append s$	& $su$ & $h$ 				& $hp$ & $\sigma$ \\
-\next	& $\is$			& $s$ 			& $su$ & $h[s!o \mapsto \AP(f,\ws)]$ 	& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-\\
-where $\size{\ws} = m$.
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& MKPAP $o$ $m$:$\is$	& $f : \ws \append s$	& $su$ & $h$ 				& $hp$ & $\sigma$ \\
-\next	& $\is$			& $s$ 			& $su$ & $h[s!o \mapsto \PAP(f,\ws)]$ 	& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-\\
-where $\size{\ws} = m$.
-
-\item[ Unpacking a constructor ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& UNPACK : $is$ 	& $a : s$ 				& $su$ & $h[a \mapsto C\ \ws]$  	& $hp$ & $\sigma$ \\
-\next	& $is'$			& $(\reverse\ \ws) \append a : s$ 	& $su$ & $h$ 				& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-The $\reverse\ \ws$ looks expensive but, since the stack grows down
-and the heap grows up, that's actually the cheap way of copying from
-heap to stack.  Looking at the compilation rules, you'll see that we
-always push the args in reverse order.
-
-\end{description}
-
-
-\Subsection{Entering a closure}{hugs-entering}
-
-\begin{description}
-
-\item[ Enter a BCO ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& [ENTER]	& $a : s$ 	& $su$ & $h[a \mapsto BCO\{\is\} ]$  	& $hp$ & $\sigma$ \\
-\next	& $\is$ 	& $a : s$ 	& $su$ & $h$ 				& $hp$ & $a$ \\
-\hline
-\end{tabular}
-
-\item[ Enter a PAP closure ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& [ENTER]	& $a : s$ 		& $su$ & $h[a \mapsto \PAP(f,\ws)]$  	& $hp$ & $\sigma$ \\
-\next	& [ENTER] 	& $f : \ws \append s$ 	& $su$ & $h$ 				& $hp$ & $???$ \\
-\hline
-\end{tabular}
-
-\item[ Entering an AP closure ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& [ENTER]	& $a : s$ 				& $su$ 	& $h[a \mapsto \AP(f,ws)]$  	& $hp$ & $\sigma$ \\
-\next	& [ENTER] 	& $f : \ws \append @UPD_RET@:\su:a:s$ 	& $su'$	& $h$ 				& $hp$ & $???$ \\
-\hline
-\end{tabular}
-
-Optimisations:
-\begin{itemize}
-\item Instead of blindly pushing an update frame for $a$, we can first test whether there's already
- an update frame there.  If so, overwrite the existing updatee with an indirection to $a$ and
- overwrite the updatee field with $a$.  (Overwriting $a$ with an indirection to the updatee also
- works.)  This results in update chains of maximum length 2. 
-\end{itemize}
-
-
-\item[ Returning a constructor ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& [ENTER]		& $a : @HUGS_RET@ : \alts : s$ 	& $su$ & $h[a \mapsto C\{\ws\}]$  	& $hp$ & $\sigma$ \\
-\next	& $\alts.\entry$	& $a:s$ 			& $su$ & $h$ 				& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-
-\item[ Entering an indirection node ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& [ENTER]	& $a  : s$ 	& $su$ & $h[a \mapsto \Ind{a'}]$ 	& $hp$ & $\sigma$ \\
-\next	& [ENTER]	& $a' : s$ 	& $su$ & $h$ 				& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-\item[Entering GHC closure].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& [ENTER]	& $a : s$ 	& $su$ & $h[a \mapsto \GHCOBJ]$  	& $hp$ & $\sigma$ \\
-\next	& [ENTERGHC] 	& $a : s$ 	& $su$ & $h$ 				& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-\item[Returning a constructor to GHC].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& [ENTER]	& $a : \GHCRET : s$ 	& $su$ & $h[a \mapsto C \ws]$  	& $hp$ & $\sigma$ \\
-\next	& [ENTERGHC]	& $a : \GHCRET : s$ 	& $su$ & $h$ 			& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-\end{description}
-
-
-\Subsection{Updates}{hugs-updates}
-
-\begin{description}
-
-\item[ Updating with a constructor].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& [ENTER]	& $a : @UPD_RET@ : ua : s$ 	& $su$ & $h[a \mapsto C\{\ws\}]$  & $hp$ & $\sigma$ \\
-\next	& [ENTER]	& $a \append s$ 		& $su$ & $h[au \mapsto \Ind{a}$   & $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-
-\item[ Argument checks].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& ARGCHECK $m$:$\is$	& $a : \as \append s$ 	& $su$ & $h$ 	& $hp$ & $\sigma$ \\
-\next	& $\is$			& $a : \as \append s$ 	& $su$ & $h'$ 	& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-\\
-where $m \ge (su - sp)$
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& ARGCHECK $m$:$\is$	& $a : \as \append @UPD_RET@:su:ua:s$ 	& $su$ & $h$ 	& $hp$ & $\sigma$ \\
-\next	& $\is$			& $a : \as \append s$ 			& $su$ & $h'$ 	& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-\\
-where $m < (su - sp)$ and
-      $h' = h[ua \mapsto \Ind{a'}, a' \mapsto \PAP(a,\reverse\ \as) ]$
-
-Again, we reverse the list of values as we transfer them from the
-stack to the heap --- reflecting the fact that the stack and heap grow
-in different directions.
-
-\end{description}
-
-\Subsection{Branches}{hugs-branches}
-
-\begin{description}
-
-\item[ Testing a constructor ].
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& TEST $tag$ $is'$ : $is$ 	& $a : s$ 	& $su$ & $h[a \mapsto C\ \ws]$ 	& $hp$ & $\sigma$ \\
-\next	& $is$				& $a : s$ 	& $su$ & $h$ 			& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-\\
-where $C.\tag = tag$
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& TEST $tag$ $is'$ : $is$ 	& $a : s$ 	& $su$ & $h[a \mapsto C\ \ws]$  & $hp$ & $\sigma$ \\
-\next	& $is'$				& $a : s$ 	& $su$ & $h$ 			& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-\\
-where $C.\tag \neq tag$
-
-\end{description}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\Subsection{Heap and stack checks}{hugs-heap-stack-checks}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& STACKCHECK $stk$:$\is$	& $s$ 	& $su$ & $h$  	& $hp$ & $\sigma$ \\
-\next	& $\is$ 			& $s$ 	& $su$ & $h$	& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-\\
-if $s$ has $stk$ free slots.
-
-\begin{tabular}{|llrrrrr|}
-\hline
-	& HEAPCHECK $hp$:$\is$		& $s$ 	& $su$ & $h$  	& $hp$ & $\sigma$ \\
-\next	& $\is$ 			& $s$ 	& $su$ & $h$	& $hp$ & $\sigma$ \\
-\hline
-\end{tabular}
-\\
-if $h$ has $hp$ free slots.
-
-If either check fails, we push the current bco ($\sigma$) onto the
-stack and return to the scheduler.  When the scheduler has fixed the
-problem, it pops the top object off the stack and reenters it.
-
-
-Optimisations:
-\begin{itemize}
-\item The bytecode CHECK1000 conservatively checks for 1000 words of heap space and 1000 words of stack space.
-      We use it to reduce code space and instruction decoding time.
-\item The bytecode HEAPCHECK1000 conservatively checks for 1000 words of heap space.
-      It is used in case alternatives.
-\end{itemize}
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\Subsection{Primops}{hugs-primops}
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-\ToDo{primops take m words and return n words. The expect boxed arguments on the stack.}
-
-
-\Section{The Machine Code Evaluator}{asm-evaluator}
-
-This section describes the framework in which compiled code evaluates
-expressions.  Only at certain points will compiled code need to be
-able to talk to the interpreted world; these are discussed in
-\secref{switching-worlds}.
-
-\Subsection{Calling conventions}{ghc-calling-conventions}
-
-\Subsubsection{The call/return registers}{ghc-regs}
-
-One of the problems in designing a virtual machine is that we want it
-abstract away from tedious machine details but still reveal enough of
-the underlying hardware that we can make sensible decisions about code
-generation.  A major problem area is the use of registers in
-call/return conventions.  On a machine with lots of registers, it's
-cheaper to pass arguments and results in registers than to pass them
-on the stack.  On a machine with very few registers, it's cheaper to
-pass arguments and results on the stack than to use ``virtual
-registers'' in memory.  We therefore use a hybrid system: the first
-$n$ arguments or results are passed in registers; and the remaining
-arguments or results are passed on the stack.  For register-poor
-architectures, it is important that we allow $n=0$.
-
-We'll label the arguments and results \Arg{1} \ldots \Arg{m} --- with
-the understanding that \Arg{1} \ldots \Arg{n} are in registers and
-\Arg{n+1} \ldots \Arg{m} are on top of the stack.
-
-Note that the mapping of arguments \Arg{1} \ldots \Arg{n} to machine
-registers depends on the \emph{kinds} of the arguments.  For example,
-if the first argument is a Float, we might pass it in a different
-register from if it is an Int.  In fact, we might find that a given
-architecture lets us pass varying numbers of arguments according to
-their types.  For example, if a CPU has 2 Int registers and 2 Float
-registers then we could pass between 2 and 4 arguments in machine
-registers --- depending on whether they all have the same kind or they
-have different kinds.
-
-\Subsubsection{Entering closures}{entering-closures}
-
-To evaluate a closure we jump to the entry code for the closure
-passing a pointer to the closure in \Arg{1} so that the entry code can
-access its environment.
-
-\Subsubsection{Function call}{ghc-fun-call}
-
-The function-call mechanism is obviously crucial.  There are five different
-cases to consider:
-\begin{enumerate}
-
-\item \emph{Known combinator (function with no free variables) and
-enough arguments.}
-
-A fast call can be made: push excess arguments onto stack and jump to
-function's \emph{fast entry point} passing arguments in \Arg{1} \ldots
-\Arg{m}.
-
-The \emph{fast entry point} is only called with exactly the right
-number of arguments (in \Arg{1} \ldots \Arg{m}) so it can instantly
-start doing useful work without first testing whether it has enough
-registers or having to pop them off the stack first.
-
-\item \emph{Known combinator and insufficient arguments.}
-
-A slow call can be made: push all arguments onto stack and jump to
-function's \emph{slow entry point}.
-
-Any unpointed arguments which are pushed on the stack must be tagged.
-This means pushing an extra word on the stack below the unpointed
-words, containing the number of unpointed words above it.
-
-%Todo: forward ref about tagging?
-%Todo: picture?
-
-The \emph{slow entry point} might be called with insufficient arguments
-and so it must test whether there are enough arguments on the stack.
-This \emph{argument satisfaction check} consists of checking that
-@Su-Sp@ is big enough to hold all the arguments (including any tags).
-
-\begin{itemize} 
-
-\item If the argument satisfaction check fails, it is because there is
-one or more update frames on the stack before the rest of the
-arguments that the function needs.  In this case, we construct a PAP
-(partial application, \secref{PAP}) containing the arguments
-which are on the stack.  The PAP construction code will return to the
-update frame with the address of the PAP in \Arg{1}.
-
-\item If the argument satisfaction check succeeds, we jump to the fast
-entry point with the arguments in \Arg{1} \ldots \Arg{arity}.
-
-If the fast entry point expects to receive some of \Arg{i} on the
-stack, we can reduce the amount of movement required by making the
-stack layout for the fast entry point look like the stack layout for
-the slow entry point.  Since the slow entry point is entered with the
-first argument on the top of the stack and with tags in front of any
-unpointed arguments, this means that if \Arg{i} is unpointed, there
-should be space below it for a tag and that the highest numbered
-argument should be passed on the top of the stack.
-
-We usually arrange that the fast entry point is placed immediately
-after the slow entry point --- so we can just ``fall through'' to the
-fast entry point without performing a jump.
-
-\end{itemize}
-
-
-\item \emph{Known function closure (function with free variables) and
-enough arguments.}
-
-A fast call can be made: push excess arguments onto stack and jump to
-function's \emph{fast entry point} passing a pointer to closure in
-\Arg{1} and arguments in \Arg{2} \ldots \Arg{m+1}.
-
-Like the fast entry point for a combinator, the fast entry point for a
-closure is only called with appropriate values in \Arg{1} \ldots
-\Arg{m+1} so we can start work straight away.  The pointer to the
-closure is used to access the free variables of the closure.
-
-
-\item \emph{Known function closure and insufficient arguments.}
-
-A slow call can be made: push all arguments onto stack and jump to the
-closure's slow entry point passing a pointer to the closure in \Arg{1}.
-
-Again, the slow entry point performs an argument satisfaction check
-and either builds a PAP or pops the arguments off the stack into
-\Arg{2} \ldots \Arg{m+1} and jumps to the fast entry point.
-
-
-\item \emph{Unknown function closure, thunk or constructor.}
-
-Sometimes, the function being called is not statically identifiable.
-Consider, for example, the @compose@ function:
-\begin{verbatim}
-  compose f g x = f (g x)
-\end{verbatim}
-Since @f@ and @g@ are passed as arguments to @compose@, the latter has
-to make a heap call.  In a heap call the arguments are pushed onto the
-stack, and the closure bound to the function is entered.  In the
-example, a thunk for @(g x)@ will be allocated, (a pointer to it)
-pushed on the stack, and the closure bound to @f@ will be
-entered. That is, we will jump to @f@s entry point passing @f@ in
-\Arg{1}.  If \Arg{1} is passed on the stack, it is pushed on top of
-the thunk for @(g x)@.
-
-The \emph{entry code} for an updateable thunk (which must have arity 0)
-pushes an update frame on the stack and starts executing the body of
-the closure --- using \Arg{1} to access any free variables.  This is
-described in more detail in \secref{data-updates}.
-
-The \emph{entry code} for a non-updateable closure is just the
-closure's slow entry point.
-
-\end{enumerate}
-
-In addition to the above considerations, if there are \emph{too many}
-arguments then the extra arguments are simply pushed on the stack with
-appropriate tags.
-
-To summarise, a closure's standard (slow) entry point performs the
-following:
-
-\begin{description}
-\item[Argument satisfaction check.] (function closure only)
-\item[Stack overflow check.]
-\item[Heap overflow check.]
-\item[Copy free variables out of closure.] %Todo: why?
-\item[Eager black holing.] (updateable thunk only) %Todo: forward ref.
-\item[Push update frame.]
-\item[Evaluate body of closure.]
-\end{description}
-
-
-\Subsection{Case expressions and return conventions}{return-conventions}
-
-The \emph{evaluation} of a thunk is always initiated by
-a @case@ expression.  For example:
-\begin{verbatim}
-  case x of (a,b) -> E
-\end{verbatim}
-
-The code for a @case@ expression looks like this:
-
-\begin{itemize}
-\item Push the free variables of the branches on the stack (fv(@E@) in
-this case).
-\item  Push a \emph{return address} on the stack.
-\item  Evaluate the scrutinee (@x@ in this case).
-\end{itemize}
-
-Once evaluation of the scrutinee is complete, execution resumes at the
-return address, which points to the code for the expression @E@.
-
-When execution resumes at the return point, there must be some {\em
-return convention} that defines where the components of the pair, @a@
-and @b@, can be found.  The return convention varies according to the
-type of the scrutinee @x@:
-
-\begin{itemize}
-
-\item 
-
-(A space for) the return address is left on the top of the stack.
-Leaving the return address on the stack ensures that the top of the
-stack contains a valid activation record
-(\secref{activation-records}) --- should a garbage
-collection be required.
-
-\item If @x@ has a boxed type (e.g.~a data constructor or a function),
-a pointer to @x@ is returned in \Arg{1}.
-
-\ToDo{Warn that components of E should be extracted as soon as
-possible to avoid a space leak.}
-
-\item If @x@ is an unboxed type (e.g.~@Int#@ or @Float#@), @x@ is
-returned in \Arg{1}
-
-\item If @x@ is an unboxed tuple constructor, the components of @x@
-are returned in \Arg{1} \ldots \Arg{n} but no object is constructed in
-the heap.  
-
-When passing an unboxed tuple to a function, the components are
-flattened out and passed in \Arg{1} \ldots \Arg{n} as usual.
-
-\end{itemize}
-
-\Subsection{Vectored Returns}{vectored-returns}
-
-Many algebraic data types have more than one constructor.  For
-example, the @Maybe@ type is defined like this:
-\begin{verbatim}
-  data Maybe a = Nothing | Just a
-\end{verbatim}
-How does the return convention encode which of the two constructors is
-being returned?  A @case@ expression scrutinising a value of @Maybe@
-type would look like this: 
-\begin{verbatim}
-  case E of 
-    Nothing -> ...
-    Just a  -> ...
-\end{verbatim}
-Rather than pushing a return address before evaluating the scrutinee,
-@E@, the @case@ expression pushes (a pointer to) a \emph{return
-vector}, a static table consisting of two code pointers: one for the
-@Just@ alternative, and one for the @Nothing@ alternative.  
-
-\begin{itemize}
-
-\item
-
-The constructor @Nothing@ returns by jumping to the first item in the
-return vector with a pointer to a (statically built) Nothing closure
-in \Arg{1}.  
-
-It might seem that we could avoid loading \Arg{1} in this case since the
-first item in the return vector will know that @Nothing@ was returned
-(and can easily access the Nothing closure in the (unlikely) event
-that it needs it.  The only reason we load \Arg{1} is in case we have to
-perform an update (\secref{data-updates}).
-
-\item 
-
-The constructor @Just@ returns by jumping to the second element of the
-return vector with a pointer to the closure in \Arg{1}.  
-
-\end{itemize}
-
-In this way no test need be made to see which constructor returns;
-instead, execution resumes immediately in the appropriate branch of
-the @case@.
-
-\Subsection{Direct Returns}{direct-returns}
-
-When a datatype has a large number of constructors, it may be
-inappropriate to use vectored returns.  The vector tables may be
-large and sparse, and it may be better to identify the constructor
-using a test-and-branch sequence on the tag.  For this reason, we
-provide an alternative return convention, called a \emph{direct
-return}.
-
-In a direct return, the return address pushed on the stack really is a
-code pointer.  The returning code loads a pointer to the closure being
-returned in \Arg{1} as usual, and also loads the tag into \Arg{2}.
-The code at the return address will test the tag and jump to the
-appropriate code for the case branch.  If \Arg{2} isn't mapped to a
-real machine register on this architecture, then we don't load it on a
-return, instead using the tag directly from the info table.
-
-The choice of whether to use a vectored return or a direct return is
-made on a type-by-type basis --- up to a certain maximum number of
-constructors imposed by the update mechanism
-(\secref{data-updates}).
-
-Single-constructor data types also use direct returns, although in
-that case there is no need to return a tag in \Arg{2}.
-
-\ToDo{for a nullary constructor we needn't return a pointer to the
-constructor in \Arg{1}.}
-
-\Subsection{Updates}{data-updates}
-
-The entry code for an updatable thunk (which must be of arity 0):
-
-\begin{itemize}
-\item copies the free variables out of the thunk into registers or
-  onto the stack.
-\item pushes an \emph{update frame} onto the stack.
-
-An update frame is a small activation record consisting of
-\begin{center}
-\begin{tabular}{|l|l|l|}
-\hline
-\emph{Fixed header} & \emph{Update Frame link} & \emph{Updatee} \\
-\hline
-\end{tabular}
-\end{center}
-
-\note{In the semantics part of the STG paper (section 5.6), an update
-frame consists of everything down to the last update frame on the
-stack.  This would make sense too --- and would fit in nicely with
-what we're going to do when we add support for speculative
-evaluation.}
-\ToDo{I think update frames contain cost centres sometimes}
-
-\item If we are doing ``eager blackholing,'' we then overwrite the
-thunk with a black hole (\secref{BLACKHOLE}).  Otherwise, we leave it
-to the garbage collector to black hole the thunk.
-
-\item 
-Start evaluating the body of the expression.
-
-\end{itemize}
-
-When the expression finishes evaluation, it will enter the update
-frame on the top of the stack.  Since the returner doesn't know
-whether it is entering a normal return address/vector or an update
-frame, we follow exactly the same conventions as return addresses and
-return vectors.  That is, on entering the update frame:
-
-\begin{itemize} 
-\item The value of the thunk is in \Arg{1}.  (Recall that only thunks
-are updateable and that thunks return just one value.)
-
-\item If the data type is a direct-return type rather than a
-vectored-return type, then the tag is in \Arg{2}.
-
-\item The update frame is still on the stack.
-\end{itemize}
-
-We can safely share a single statically-compiled update function
-between all types.  However, the code must be able to handle both
-vectored and direct-return datatypes.  This is done by arranging that
-the update code looks like this:
-
-\begin{verbatim}
-                |       ^       |
-                | return vector |
-                |---------------|
-                |  fixed-size   |
-                |  info table   |
-                |---------------|  <- update code pointer
-                |  update code  |
-                |       v       |
-\end{verbatim}
-
-Each entry in the return vector (which is large enough to cover the
-largest vectored-return type) points to the update code.
-
-The update code:
-\begin{itemize}
-\item overwrites the \emph{updatee} with an indirection to \Arg{1};
-\item loads @Su@ from the Update Frame link;
-\item removes the update frame from the stack; and 
-\item enters \Arg{1}.
-\end{itemize}
-
-We enter \Arg{1} again, having probably just come from there, because
-it knows whether to perform a direct or vectored return.  This could
-be optimised by compiling special update code for each slot in the
-return vector, which performs the correct return.
-
-\Subsection{Semi-tagging}{semi-tagging}
-
-When a @case@ expression evaluates a variable that might be bound
-to a thunk it is often the case that the scrutinee is already evaluated.
-In this case we have paid the penalty of (a) pushing the return address (or
-return vector address) on the stack, (b) jumping through the info pointer
-of the scrutinee, and (c) returning by an indirect jump through the
-return address on the stack.
-
-If we knew that the scrutinee was already evaluated we could generate
-(better) code which simply jumps to the appropriate branch of the
-@case@ with a pointer to the scrutinee in \Arg{1}.  (For direct
-returns to multiconstructor datatypes, we might also load the tag into
-\Arg{2}).
-
-An obvious idea, therefore, is to test dynamically whether the heap
-closure is a value (using the tag in the info table).  If not, we
-enter the closure as usual; if so, we jump straight to the appropriate
-alternative.  Here, for example, is pseudo-code for the expression
-@(case x of { (a,_,c) -> E }@:
-\begin{verbatim}
-      \Arg{1} = <pointer to x>;
-      tag = \Arg{1}->entry->tag;
-      if (isWHNF(tag)) {
-          Sp--;  \\ insert space for return address
-          goto ret;
-      }
-      push(ret);           
-      goto \Arg{1}->entry;
-      
-      <info table for return address goes here>
-ret:  a = \Arg{1}->data1; \\ suck out a and c to avoid space leak
-      c = \Arg{1}->data3;
-      <code for E2>
-\end{verbatim}
-and here is the code for the expression @(case x of { [] -> E1; x:xs -> E2 }@:
-\begin{verbatim}
-      \Arg{1} = <pointer to x>;
-      tag = \Arg{1}->entry->tag;
-      if (isWHNF(tag)) {
-          Sp--;  \\ insert space for return address
-          goto retvec[tag];
-      }
-      push(retinfo);          
-      goto \Arg{1}->entry;
-      
-      .addr ret2
-      .addr ret1
-retvec:           \\ reversed return vector
-      <return info table for case goes here>
-retinfo:
-      panic("Direct return into vectored case");
-      
-ret1: <code for E1>
-
-ret2: x  = \Arg{1}->head;
-      xs = \Arg{1}->tail;
-      <code for E2>
-\end{verbatim}
-There is an obvious cost in compiled code size (but none in the size
-of the bytecodes).  There is also a cost in execution time if we enter
-more thunks than data constructors.
-
-Both the direct and vectored returns are easily modified to chase chains
-of indirections too.  In the vectored case, this is most easily done by
-making sure that @IND = TAG_1 - 1@, and adding an extra field to every
-return vector.  In the above example, the indirection code would be
-\begin{verbatim}
-ind:  \Arg{1} = \Arg{1}->next;
-      goto ind_loop;
-\end{verbatim}
-where @ind_loop@ is the second line of code.
-
-Note that we have to leave space for a return address since the return
-address expects to find one.  If the body of the expression requires a
-heap check, we will actually have to write the return address before
-entering the garbage collector.
-
-
-\Subsection{Heap and Stack Checks}{heap-and-stack-checks}
-
-The storage manager detects that it needs to garbage collect the old
-generation when the evaluator requests a garbage collection without
-having moved the heap pointer since the last garbage collection.  It
-is therefore important that the GC routines \emph{not} move the heap
-pointer unless the heap check fails.  This is different from what
-happens in the current STG implementation.
-
-Assuming that the stack can never shrink, we perform a stack check
-when we enter a closure but not when we return to a return
-continuation.  This doesn't work for heap checks because we cannot
-predict what will happen to the heap if we call a function.
-
-If we wish to allow the stack to shrink, we need to perform a stack
-check whenever we enter a return continuation.  Most of these checks
-could be eliminated if the storage manager guaranteed that a stack
-would always have 1000 words (say) of space after it was shrunk.  Then
-we can omit stack checks for less than 1000 words in return
-continuations.
-
-When an argument satisfaction check fails, we need to push the closure
-(in R1) onto the stack - so we need to perform a stack check.  The
-problem is that the argument satisfaction check occurs \emph{before}
-the stack check.  The solution is that the caller of a slow entry
-point or closure will guarantee that there is at least one word free
-on the stack for the callee to use.  
-
-Similarily, if a heap or stack check fails, we need to push the arguments
-and closure onto the stack.  If we just came from the slow entry point, 
-there's certainly enough space and it is the responsibility of anyone
-using the fast entry point to guarantee that there is enough space.
-
-\ToDo{Be more precise about how much space is required - document it
-in the calling convention section.}
-
-\Subsection{Handling interrupts/signals}{signals}
-
-\begin{verbatim}
-May have to keep C stack pointer in register to placate OS?
-May have to revert black holes - ouch!
-\end{verbatim}
-
-
-
-\section{The Loader}
-\section{The Compilers}
-
-\iffalse
-\part{Old stuff - needs to be mined for useful info}
-
-\section{The Scheduler}
-
-The Scheduler is the heart of the run-time system.  A running program
-consists of a single running thread, and a list of runnable and
-blocked threads.  The running thread returns to the scheduler when any
-of the following conditions arises:
-
-\begin{itemize}
-\item A heap check fails, and a garbage collection is required
-\item Compiled code needs to switch to interpreted code, and vice
-versa.
-\item The thread becomes blocked.
-\item The thread is preempted.
-\end{itemize}
-
-A running system has a global state, consisting of
-
-\begin{itemize}
-\item @Hp@, the current heap pointer, which points to the next
-available address in the Heap.
-\item @HpLim@, the heap limit pointer, which points to the end of the
-heap.
-\item The Thread Preemption Flag, which is set whenever the currently
-running thread should be preempted at the next opportunity.
-\item A list of runnable threads. 
-\item A list of blocked threads.
-\end{itemize}
-
-Each thread is represented by a Thread State Object (TSO), which is
-described in detail in \secref{TSO}.
-
-The following is pseudo-code for the inner loop of the scheduler
-itself.
-
-\begin{verbatim}
-while (threads_exist) {
-  // handle global problems: GC, parallelism, etc
-  if (need_gc) gc();  
-  if (external_message) service_message();
-  // deal with other urgent stuff
-
-  pick a runnable thread;
-  do {
-    // enter object on top of stack
-    // if the top object is a BCO, we must enter it
-    // otherwise appply any heuristic we wish.
-    if (thread->stack[thread->sp]->info.type == BCO) {
-	status = runHugs(thread,&smInfo);
-    } else {
-	status = runGHC(thread,&smInfo);
-    }
-    switch (status) {  // handle local problems
-      case (StackOverflow): enlargeStack; break;
-      case (Error e)      : error(thread,e); break;
-      case (ExitWith e)   : exit(e); break;
-      case (Yield)        : break;
-    }
-  } while (thread_runnable);
-}
-\end{verbatim}
-
-\Subsection{Invoking the garbage collector}{ghc-invoking-gc}
-
-\Subsection{Putting the thread to sleep}{ghc-thread-sleeps}
-
-\Subsection{Calling C from Haskell}{ghc-ccall}
-
-We distinguish between "safe calls" where the programmer guarantees
-that the C function will not call a Haskell function or, in a
-multithreaded system, block for a long period of time and "unsafe
-calls" where the programmer cannot make that guarantee.  
-
-Safe calls are performed without returning to the scheduler and are
-discussed elsewhere (\ToDo{discuss elsewhere}).
-
-Unsafe calls are performed by returning an array (outside the Haskell
-heap) of arguments and a C function pointer to the scheduler.  The
-scheduler allocates a new thread from the operating system
-(multithreaded system only), spawns a call to the function and
-continues executing another thread.  When the ccall completes, the
-thread informs the scheduler and the scheduler adds the thread to the
-runnable threads list.  
-
-\ToDo{Describe this in more detail.}
-
-
-\Subsection{Calling Haskell from C}{ghc-c-calls-haskell}
-
-When C calls a Haskell closure, it sends a message to the scheduler
-thread.  On receiving the message, the scheduler creates a new Haskell
-thread, pushes the arguments to the C function onto the thread's stack
-(with tags for unboxed arguments) pushes the Haskell closure and adds
-the thread to the runnable list so that it can be entered in the
-normal way.
-
-When the closure returns, the scheduler sends back a message which
-awakens the (C) thread.  
-
-\ToDo{Do we need to worry about the garbage collector deallocating the
-thread if it gets blocked?}
-
-\Subsection{Switching Worlds}{switching-worlds}
-
-\ToDo{This has all changed: we always leave a closure on top of the
-stack if we mean to continue executing it.  The scheduler examines the
-top of the stack and tries to guess which world we want to be in.  If
-it finds a @BCO@, it certainly enters Hugs, if it finds a @GHC@
-closure, it certainly enters GHC and if it finds a standard closure,
-it is free to choose either one but it's probably best to enter GHC
-for everything except @BCO@s and perhaps @AP@s.}
-
-Because this is a combined compiled/interpreted system, the
-interpreter will sometimes encounter compiled code, and vice-versa.
-
-All world-switches go via the scheduler, ensuring that the world is in
-a known state ready to enter either compiled code or the interpreter.
-When a thread is run from the scheduler, the @whatNext@ field in the
-TSO (\secref{TSO}) is checked to find out how to execute the
-thread.
-
-\begin{itemize}
-\item If @whatNext@ is set to @ReturnGHC@, we load up the required
-registers from the TSO and jump to the address at the top of the user
-stack.
-\item If @whatNext@ is set to @EnterGHC@, we load up the required
-registers from the TSO and enter the closure pointed to by the top
-word of the stack.
-\item If @whatNext@ is set to @EnterHugs@, we enter the top thing on
-the stack, using the interpreter.
-\end{itemize}
-
-There are four cases we need to consider:
-
-\begin{enumerate}
-\item A GHC thread enters a Hugs-built closure.
-\item A GHC thread returns to a Hugs-compiled return address.
-\item A Hugs thread enters a GHC-built closure.
-\item A Hugs thread returns to a Hugs-compiled return address.
-\end{enumerate}
-
-GHC-compiled modules cannot call functions in a Hugs-compiled module
-directly, because the compiler has no information about arities in the
-external module.  Therefore it must assume any top-level objects are
-CAFs, and enter their closures.
-
-\ToDo{Hugs-built constructors?}
-
-We now examine the various cases one by one and describe how the
-switch happens in each situation.
-
-\subsection{A GHC thread enters a Hugs-built closure}
-\label{sec:ghc-to-hugs-switch}
-
-There is three possibilities: GHC has entered a @PAP@, or it has
-entered a @AP@, or it has entered the BCO directly (for a top-level
-function closure).  @AP@s and @PAP@s are ``standard closures'' and
-so do not require us to enter the bytecode interpreter.
-
-The entry code for a BCO does the following:
-
-\begin{itemize}
-\item Push the address of the object entered on the stack.
-\item Save the current state of the thread in its TSO.
-\item Return to the scheduler, setting @whatNext@ to @EnterHugs@.
-\end{itemize}
-
-BCO's for thunks and functions have the same entry conventions as
-slow entry points: they expect to find their arguments on the stac
-with unboxed arguments preceded by appropriate tags.
-
-\subsection{A GHC thread returns to a Hugs-compiled return address}
-\label{sec:ghc-to-hugs-switch}
-
-Hugs return addresses are laid out as in \figref{hugs-return-stack}.
-If GHC is returning, it will return to the address at the top of the
-stack, namely @HUGS_RET@.  The code at @HUGS_RET@ performs the
-following:
-
-\begin{itemize}
-\item pushes \Arg{1} (the return value) on the stack.
-\item saves the thread state in the TSO
-\item returns to the scheduler with @whatNext@ set to @EnterHugs@.
-\end{itemize}
-
-\noindent When Hugs runs, it will enter the return value, which will
-return using the correct Hugs convention
-(\secref{hugs-return-convention}) to the return address underneath it
-on the stack.
-
-\subsection{A Hugs thread enters a GHC-compiled closure}
-\label{sec:hugs-to-ghc-switch}
-
-Hugs can recognise a GHC-built closure as not being one of the
-following types of object:
-
-\begin{itemize}
-\item A @BCO@,
-\item A @AP@,
-\item A @PAP@,
-\item An indirection, or
-\item A constructor.
-\end{itemize}
-
-When Hugs is called on to enter a GHC closure, it executes the
-following sequence of instructions:
-
-\begin{itemize}
-\item Push the address of the closure on the stack.
-\item Save the current state of the thread in the TSO.
-\item Return to the scheduler, with the @whatNext@ field set to
-@EnterGHC@.
-\end{itemize}
-
-\subsection{A Hugs thread returns to a GHC-compiled return address}
-\label{sec:hugs-to-ghc-switch}
-
-When Hugs encounters a return address on the stack that is not
-@HUGS_RET@, it knows that a world-switch is required.  At this point
-the stack contains a pointer to the return value, followed by the GHC
-return address.  The following sequence is then performed:
-
-\begin{itemize}
-\item save the state of the thread in the TSO.
-\item return to the scheduler, setting @whatNext@ to @EnterGHC@.
-\end{itemize}
-
-The first thing that GHC will do is enter the object on the top of the
-stack, which is a pointer to the return value.  This value will then
-return itself to the return address using the GHC return convention.
-
-
-\fi
-
-
-\part{History}
-
-We're nuking the following:
-
-\begin{itemize}
-\item
-  Two stacks
-
-\item
-  Return in registers.
-  This lets us remove update code pointers from info tables,
-  removes the need for phantom info tables, simplifies 
-  semi-tagging, etc.
-
-\item
-  Threaded GC.
-  Careful analysis suggests that it doesn't buy us very much
-  and it is hard to work with.
-
-  Eliminating threaded GCs eliminates the desire to share SMReps
-  so they are (once more) part of the Info table.
-
-\item
-  RetReg.
-  Doesn't buy us anything on a register-poor architecture and
-  isn't so important if we have semi-tagging.
-
-\begin{verbatim}
-    - Probably bad on register poor architecture 
-    - Can avoid need to write return address to stack on reg rich arch.
-      - when a function does a small amount of work, doesn't 
-  	enter any other thunks and then returns.
-  	eg entering a known constructor (but semitagging will catch this)
-    - Adds complications
-\end{verbatim}
-
-\item
-  Update in place
-
-  This lets us drop CONST closures and CHARLIKE closures (assuming we
-  don't support Unicode).  The only point of these closures was to 
-  avoid updating with an indirection.
-
-  We also drop @MIN_UPD_SIZE@ --- all we need is space to insert an
-  indirection or a black hole.
-
-\item
-  STATIC SMReps are now called CONST
-
-\item
-  @MUTVAR@ is new
-
-\item The profiling ``kind'' field is now encoded in the @INFO_TYPE@ field.
-This identifies the general sort of the closure for profiling purposes.
-
-\item Various papers describe deleting update frames for unreachable objects.
-  This has never been implemented and we don't plan to anytime soon.
-
-\end{itemize}
-
-
-\end{document}
-
-
diff --git a/ghc/docs/storage-mgt/Makefile b/ghc/docs/storage-mgt/Makefile
deleted file mode 100644
index 871766d4fc..0000000000
--- a/ghc/docs/storage-mgt/Makefile
+++ /dev/null
@@ -1,37 +0,0 @@
-#	General makefile for Latex stuff
-
-dvi: sm.dvi rp.dvi ldv.dvi
-ps: sm.ps rp.ps ldv.ps
-
-######## General rules
-.SUFFIXES:
-.PRECIOUS: %.tex %.ps %.bbl
-
-#%.dvi: %.tex $(addsuffix .tex, $(basename $(wildcard *.verb *.fig))) $(wildcard *.bib)
-%.dvi: %.tex $(addsuffix .tex, $(basename $(wildcard *.verb))) $(wildcard *.bib)
-	latex $<
-	@if grep -s "\citation" $*.aux; then bibtex $*; fi
-	latex $<
-	latex $<
-
-%.ps: %.dvi
-	dvips -f < $< > $@
-
-clean:
-	$(RM) *.aux *.log
-
-distclean: clean
-	$(RM) *.dvi *.ps *.bbl *.blg *.gz
-
-maintainer-clean: distclean
-
-# dummy targets
-all:
-boot:
-install:
-install-docs:
-html:
-chm:
-HxS:
-
-# End of file
diff --git a/ghc/docs/storage-mgt/architecture.eepic b/ghc/docs/storage-mgt/architecture.eepic
deleted file mode 100644
index 57ffd8fc99..0000000000
--- a/ghc/docs/storage-mgt/architecture.eepic
+++ /dev/null
@@ -1,55 +0,0 @@
-\setlength{\unitlength}{0.00054167in}
-%
-\begingroup\makeatletter\ifx\SetFigFont\undefined%
-\gdef\SetFigFont#1#2#3#4#5{%
-  \reset@font\fontsize{#1}{#2pt}%
-  \fontfamily{#3}\fontseries{#4}\fontshape{#5}%
-  \selectfont}%
-\fi\endgroup%
-{\renewcommand{\dashlinestretch}{30}
-\begin{picture}(5787,4014)(0,-10)
-\path(2700,912)(5325,912)(5325,1212)
-	(2700,1212)(2700,912)
-\path(2850,12)(5100,12)(5100,312)
-	(2850,312)(2850,12)
-\path(2700,1812)(5325,1812)(5325,2112)
-	(2700,2112)(2700,1812)
-\path(3825,2712)(5700,2712)(5700,3012)
-	(3825,3012)(3825,2712)
-\path(3825,3687)(5625,3687)(5625,3987)
-	(3825,3987)(3825,3687)
-\path(2625,3687)(3825,3687)(3825,3987)
-	(2625,3987)(2625,3687)
-\path(3795.000,3357.000)(3825.000,3237.000)(3855.000,3357.000)
-\path(3825,3237)(3825,3687)
-\path(3855.000,3567.000)(3825.000,3687.000)(3795.000,3567.000)
-\path(3795.000,1332.000)(3825.000,1212.000)(3855.000,1332.000)
-\path(3825,1212)(3825,1812)
-\path(3855.000,1692.000)(3825.000,1812.000)(3795.000,1692.000)
-\path(1875,3237)(5775,3237)(5775,762)
-	(1875,762)(1875,3237)
-\path(3855.000,642.000)(3825.000,762.000)(3795.000,642.000)
-\path(3825,762)(3825,312)
-\path(3795.000,432.000)(3825.000,312.000)(3855.000,432.000)
-\path(2025,2712)(3525,2712)(3525,3012)
-	(2025,3012)(2025,2712)
-\path(3195.000,2232.000)(3225.000,2112.000)(3255.000,2232.000)
-\path(3225,2112)(3225,2712)
-\path(3255.000,2592.000)(3225.000,2712.000)(3195.000,2592.000)
-\path(4320.000,2232.000)(4350.000,2112.000)(4380.000,2232.000)
-\path(4350,2112)(4350,2712)
-\path(4380.000,2592.000)(4350.000,2712.000)(4320.000,2592.000)
-\path(3525,2937)(3825,2937)
-\path(3705.000,2907.000)(3825.000,2937.000)(3705.000,2967.000)
-\path(3825,2787)(3525,2787)
-\path(3645.000,2817.000)(3525.000,2787.000)(3645.000,2757.000)
-\put(3225,1887){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}block allocator}}}}}
-\put(3000,987){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}megablock allocator}}}}}
-\put(3150,87){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}operating system}}}}}
-\put(2700,3762){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}mutatator}}}}}
-\put(3900,3762){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}runtime system}}}}}
-\put(2100,2787){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}heap allocator}}}}}
-\put(3975,2787){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}garbage collector}}}}}
-\put(0,1962){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}storage manager}}}}}
-\end{picture}
-}
diff --git a/ghc/docs/storage-mgt/architecture.fig b/ghc/docs/storage-mgt/architecture.fig
deleted file mode 100644
index 563da78a53..0000000000
--- a/ghc/docs/storage-mgt/architecture.fig
+++ /dev/null
@@ -1,59 +0,0 @@
-#FIG 3.2
-Landscape
-Center
-Inches
-Letter  
-65.00
-Single
--2
-1200 2
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 2400 4200 5025 4200 5025 3900 2400 3900 2400 4200
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 2550 5100 4800 5100 4800 4800 2550 4800 2550 5100
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 2400 3300 5025 3300 5025 3000 2400 3000 2400 3300
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 3525 2400 5400 2400 5400 2100 3525 2100 3525 2400
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 3525 1425 5325 1425 5325 1125 3525 1125 3525 1425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 2325 1425 3525 1425 3525 1125 2325 1125 2325 1425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 3525 1875 3525 1425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 3525 3900 3525 3300
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 1575 1875 5475 1875 5475 4350 1575 4350 1575 1875
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 3525 4350 3525 4800
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 1725 2400 3225 2400 3225 2100 1725 2100 1725 2400
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 2925 3000 2925 2400
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 4050 3000 4050 2400
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 3225 2175 3525 2175
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 3525 2325 3225 2325
-4 0 0 50 0 0 12 0.0000 4 135 1110 2925 3225 block allocator\001
-4 0 0 50 0 0 12 0.0000 4 180 1515 2700 4125 megablock allocator\001
-4 0 0 50 0 0 12 0.0000 4 180 1305 2850 5025 operating system\001
-4 0 0 50 0 0 12 0.0000 4 105 735 2400 1350 mutatator\001
-4 0 0 50 0 0 12 0.0000 4 180 1170 3600 1350 runtime system\001
-4 0 0 50 0 0 12 0.0000 4 180 1065 1800 2325 heap allocator\001
-4 0 0 50 0 0 12 0.0000 4 180 1305 3675 2325 garbage collector\001
-4 0 0 50 0 0 12 0.0000 4 150 1260 -300 3150 storage manager\001
diff --git a/ghc/docs/storage-mgt/cacheprof_p.eps b/ghc/docs/storage-mgt/cacheprof_p.eps
deleted file mode 100644
index 94d3a5d0c2..0000000000
--- a/ghc/docs/storage-mgt/cacheprof_p.eps
+++ /dev/null
@@ -1,2083 +0,0 @@
-%!PS-Adobe-2.0 EPSF-1.2
-%%Title: cacheprof_p -ghc-timing +RTS -H10m -K10m -p -hR -i1.0 -sstderr 
-%%Creator: Ghostscript ps2epsi from cacheprof_p.ps
-%%CreationDate: Aug 23 18:51
-%%For:t-spark t-spark
-%%Pages: 1
-%%DocumentFonts: Helvetica
-%%BoundingBox: 72 107 505 756
-%%BeginPreview: 433 649 1 649
-% ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff80
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000080
-% 8000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001ffffffffff080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000108000000084000000022000000022000000008000000000000000010000100001080
-% 800000000000000000000000100000000100000001cc0000000e600000006300000006300000000e000000000000000010420103c01080
-% 800000000000000000000000100000000100000001440000000a200000004900000004900000000b000000000000000010738106601080
-% 800000000000000000000003f80000003f800000012400000009200000004900000004900000003f800000000000000010588104201080
-% 8000000000000000000000000000000000000000011800000008c00000003e00000003e000000008000000000000000010488104201080
-% 800000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000104c8106601080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010478102401080
-% 800000000000000000000006000000006000000003000000001800000000c00000000c0000000060000000000000000010000100001080
-% 800000000000002c00000001e00000001600000000f000000005800000003c00000002c00000001e000000000000000010420107201080
-% 800000000000006f000000031800000037800000018c0000000de00000006300000006f000000031800000000000000010738105a01080
-% 8000000000000045000000020800000022800000010400000008a000000041000000045000000020800000000000000010588105a01080
-% 8000000000000045000000021800000022800000010c00000008a000000043000000045000000021800000000000000010488104a01080
-% 800000000000003900000001f00000001c80000000f800000007200000003e00000003900000001f0000000000000000104c8107e01080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010478104001080
-% 800000000000003c00000001e00000001e00000000f000000007800000003c00000003c00000001e000000000000000010000103c01080
-% 8000000000000063000000031800000031800000018c0000000c6000000063000000063000000031800000000000000011c00106601080
-% 80000000000000410000000208000000208000000104000000082000000041000000041000000020800000000000000010800104201080
-% 8000000000000043000000021800000021800000010c000000086000000043000000043000000021800000000000000010000104201080
-% 800000000000003e00000001f00000001f00000000f800000007c00000003e00000003e00000001f000000000000000010000106601080
-% 800007800000003c00000001e00000001e00000000f000000007800000003c00000003c00000001e000000000000000010010102401080
-% 80000c6000000063000000031800000031800000018c0000000c6000000063000000063000000031800000000000000010010100001080
-% 800008200000004100000002080000002080000001040000000820000000410000000410000000208000000000000000107f8107fc1080
-% 8000086000000043000000021800000021800000010c000000086000000043000000043000000021800000000000000010000100201080
-% 800007c00000003e00000001f00000001f00000000f800000007c00000003e00000003e00000001f000000000200200010000100201080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000200200010070100201080
-% 80000fe00000007f00000003f80000003f80000001fc0000000fe00000007f00000007f00000003f8000000003c8ff7c106d8107e01080
-% 800003000000001800000000c00000000c000000006000000003000000001800000001800000000c000000000225396010488101801080
-% 800003000000001800000000c00000000c000000006000000003000000001800000001800000000c0000000002253f3810488103c01080
-% 83c006800000003400000001a00000001a00000000d000000006800000003400000003400000001a0000000003273944106d8104a01080
-% 863008000000004000000002000000002000000001000000000800000000400000000400000000200000000003c23f78103f0104a01080
-% 84100000000000000000000000000000000000000000000000000000000000000000000000000000000000000002000010000104e01080
-% 8430080000000080000000040000000020000000010000000010000000008000000004000000002000000000000c000010000102c01080
-% 83e00800000000800000000400000000200000000100000000100000000080000000040000000020000000000000000010010100001080
-% 80000800000000800000000400000000200000000100000000100000000080000000040000000020000000000000000010010100001080
-% 800008000000008000000004000000002000000001000000001000000000800000000400000000200000000000000000107f813fe01080
-% 8400fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffe10000106601080
-% 83c00f00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000104201080
-% 86300e80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000106601080
-% 84100f60000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000103c01080
-% 84300f98000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011c00100001080
-% 83e00fd6000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010800100001080
-% 80000f61800000000000000000000000000000000000000000000000000000000000000000000000000000000000000010180107e01080
-% 80000ff14000000000000000000000000000000000000000000000000000000000000000000000000000000000000000101c0100201080
-% 80000f68300000000000000000000000000000000000000000000000000000000000000000000000000000000000000010120100201080
-% 80000fd55c0000000000000000000000000000000000000000000000000000000000000000000000000000000000000010118103c01080
-% 80000baa0300000000000000000000000000000000000000000000000000000000000000000000000000000000000000107fc106601080
-% 80000b7591c000000000000000000000000000000000000000000000000000000000000000000000000000000000000010100104201080
-% 80000fd2c02000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000104201080
-% 80000ff7755800000000000000000000000000000000000000000000000000000000000000000000000000000000000010180106601080
-% 80000da9b006000000000000000000000000000000000000000000000000000000000000000000000000000000000000101c0103c01080
-% 80000dd5d95180000000000000000000000000000000000000000000000000000000000000000000000000000000000010120100201080
-% 80000df46c0040000000000000000000000000000000000000000000000000000000000000000000000000000000000010118107fc1080
-% 80000ddb7755700000000000000000000000000000000000000000000000000000000000000000000000000000000000107fc100241080
-% 80000dea2b000c000000000000000000000000000000000000000000000000000000000000000000000000000000000010100100001080
-% 80000df5559113000000000000000000000000000000000000000000000000000000000000000000000000000000000010180110001080
-% 80000cfcaac000c000000000000000000000000000000000000000000000000000000000000000000000000000000000101c0110001080
-% 80000dd4d57555600000000000000000000000000000000000000000000000000000000000000000000000000000000010120110001080
-% 80000cbe42b000180000000000000000000000000000000000000000000000000000000000000000000000000000000010118110001080
-% 80000d765759511600000000000000000000000000000000000000000000000000000000000000000000000000000000107fc110001080
-% 80000c7b21ac00018000000000000000000000000000000000000000000000000000000000000000000000000000000010100110001080
-% 80000f5d15d755556000000000000000000000000000000000000000000000000000000000000000000000000000000010000110001080
-% 80000e7a906b0000100000000000000000000000000000000000000000000000000000000000000000000000000000001000013fe01080
-% 80000f558d7591111c00000000000000000000000000000000000000000000000000000000000000000000000000000010000106601080
-% 80000e3fca2ac0000300000000000000000000000000000000000000000000000000000000000000000000000000000010000104201080
-% 80000f7d4555755555c0000000000000000000000000000000000000000000000000000000000000000000000000000010000106601080
-% 80000e2ee20ab00000300000000000000000000000000000000000000000000000000000000000000000000000000000107fc103c01080
-% 80000f7f635559515158000000000000000000000000000000000000000000000000000000000000000000000000000010660100001080
-% 80000e27b122ac000006000000000000000000000000000000000000000000000000000000000000000000000000000010420100001080
-% 80000f55515757555555800000000000000000000000000000000000000000000000000000000000000000000000000010660100001080
-% 80000e1ff081ab0000006000000000000000000000000000000000000000000000000000000000000000000000000000103c0100001080
-% 80000f155855d5d11111180000000000000000000000000000000000000000000000000000000000000000000000000010000100801080
-% 80000e13b8626aa00000040000000000000000000000000000000000000000000000000000000000000000000000000010020100801080
-% 80000f5fd435755555555700000000000000000000000000000000000000000000000000000000000000000000000000121e0100801080
-% 80000f0bac201aa8000000c000000000000000000000000000000000000000000000000000000000000000000000000011f00100001080
-% 80000f1f561555555111513000000000000000000000000000000000000000000000000000000000000000000000000010700103c01080
-% 80001f0bfa122aaa0000000c000000000000000000000000000000000000000000000000000000000000000000000000101e0136601080
-% 80002d5d550d55555555555600000000000000000000000000000000000000000000000000000000000000000000000010020124201080
-% 80004d05eb0402aa8000000180000000000000000000000000000000000000000000000000000000000000000000000010020124201080
-% 80008d15f585555511111111600000000000000000000000000000000000000000000000000000000000000000000000107f813fe01080
-% 80008d07bb8223aaa00000001000000000000000000000000000000000000000000000000000000000000000000000001042011fe01080
-% 80004f55758355557555555558000000000000000000000000000000000000000000000000000000000000000000000010180100001080
-% 80002f0bee8200aab0000000060000000000000000000000000000000000000000000000000000000000000000000000103c0100001080
-% 80001f5d758355d559515151510000000000000000000000000000000000000000000000000000000000000000000000104a0107fc1080
-% 80000f0bfb81206aa8000000008000000000000000000000000000000000000000000000000000000000000000000000104a0100201080
-% 80000f5d7581555555555555556000000000000000000000000000000000000000000000000000000000000000000000104e0100201080
-% 80000f09ea81002aaa000000001000000000000000000000000000000000000000000000000000000000000000000000102c0100201080
-% 80000f1d758155755711111111180000000000000000000000000000000000000000000000000000000000000000000010000107e01080
-% 80000f0bbb80a23aab00000000060000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000f5d7580d55555d55555555500000000000000000000000000000000000000000000000000000000000000000000106e0103c01080
-% 80000f19eec0801aaa8000000000c0000000000000000000000000000000000000000000000000000000000000000000104a0106601080
-% 80000f157540d55d55515111511160000000000000000000000000000000000000000000000000000000000000000000105a0104201080
-% 80000f13fbc0602aaaa0000000001000000000000000000000000000000000000000000000000000000000000000000010720104201080
-% 80000f57754055555575555555555c00000000000000000000000000000000000000000000000000000000000000000010000106601080
-% 80000f1beac04006aab0000000000200000000000000000000000000000000000000000000000000000000000000000010000102401080
-% 80000f17554055575559111111111100000000000000000000000000000000000000000000000000000000000000000010000100801080
-% 80000f93fbc02222aaa80000000000c0000000000000000000000000000000000000000000000000000000000000000010000100801080
-% 80000fd7554035555555555555555560000000000000000000000000000000000000000000000000000000000000000010400100801080
-% 80000fabeec02001aaaa000000000010000000000000000000000000000000000000000000000000000000000000000010660100001080
-% 80000ff755403555555551515151515c0000000000000000000000000000000000000000000000000000000000000000101c0100201080
-% 80000fa3fbc01020aaab0000000000020000000000000000000000000000000000000000000000000000000000000000103c0107f81080
-% 80000ff755401555d555d55555555555000000000000000000000000000000000000000000000000000000000000000010660104201080
-% 80000fabeac010006aaac00000000000c00000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000fb5556015555555511111111111200000000000000000000000000000000000000000000000000000000000000010000107e41080
-% 80000fa7fba00a222aaaa00000000000100000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000ff555600d5575555555555555555c0000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000fcfeee008001aaab00000000000020000000000000000000000000000000000000000000000000000000000000010000107e01080
-% 80000fd555600d555555591151115111510000000000000000000000000000000000000000000000000000000000000010000100201080
-% 80000fe7fba004223aaaac000000000000c0000000000000000000000000000000000000000000000000000000000000106e0100201080
-% 80000fd5556005555d555555555555555560000000000000000000000000000000000000000000000000000000000000104a0107e01080
-% 80000fefeae004000aaaaa00000000000010000000000000000000000000000000000000000000000000000000000000105a0100201080
-% 80000fd5556005555555551111111111111c00000000000000000000000000000000000000000000000000000000000010720100201080
-% 80001fe7fba0022226aaab0000000000000200000000000000000000000000000000000000000000000000000000000010000100201080
-% 80002ed555600355575555d555555555555500000000000000000000000000000000000000000000000000000000000010180107e01080
-% 80004e8feea0020002aaaac0000000000000c00000000000000000000000000000000000000000000000000000000000103c0100001080
-% 80008edd5560035557555551515151515151600000000000000000000000000000000000000000000000000000000000104a0100001080
-% 80008eabfbb0012021aaaaa0000000000000100000000000000000000000000000000000000000000000000000000000104a0107e41080
-% 80004edd5550015555d555555555555555555c0000000000000000000000000000000000000000000000000000000000104e0100001080
-% 80002eafeaf0008000aaaaa8000000000000020000000000000000000000000000000000000000000000000000000000102c0107e01080
-% 80001fdd555000d555555559111111111111118000000000000000000000000000000000000000000000000000000000103c0100201080
-% 84200fabfbb00062226aaaac00000000000000400000000000000000000000000000000000000000000000000000000010660100201080
-% 87300fdd555800555575555755555555555555600000000000000000000000000000000000000000000000000000000010420100201080
-% 85100f8feee80040001aaaab00000000000000180000000000000000000000000000000000000000000000000000000010420107e01080
-% 84900fd5555800355555555551115111511151140000000000000000000000000000000000000000000000000000000010660100001080
-% 84600fa7fbb80022202aaaaa80000000000000020000000000000000000000000000000000000000000000000000000010240103c01080
-% 80000fd55558001555555555555555555555555580000000000000000000000000000000000000000000000000000000103c0136601080
-% 8400ffafeae800100006aaaaa0000000000000004000000000000000000000000000000000000000000000000000000010660124201080
-% 80000fd57554000d5557555551111111111111113000000000000000000000000000000000000000000000000000000010420124201080
-% 83c00fa7bbbc000a2222aaaab000000000000000080000000000000000000000000000000000000000000000000000001042013fe01080
-% 86300fd57554000d555555555d55555555555555540000000000000000000000000000000000000000000000000000001066011fe01080
-% 84100f8feeac00040000aaaaac0000000000000003000000000000000000000000000000000000000000000000000000103c0100001080
-% 84300fd5755400055555d55557515151515151515180000000000000000000000000000000000000000000000000000010000100001080
-% 83e00fa7fbba000220206aaaaa000000000000000040000000000000000000000000000000000000000000000000000010000100001080
-% 80000fd57556000355557555555555555555555555700000000000000000000000000000000000000000000000000000107e0100001080
-% 80000fafeaea000100002aaaaa800000000000000008000000000000000000000000000000000000000000000000000010020101001080
-% 80000fd5755600015555555555511111111111111116000000000000000000000000000000000000000000000000000010020101001080
-% 80000fa7bbba000122223aaaaac00000000000000001000000000000000000000000000000000000000000000000000010020101001080
-% 80000fd575550000d5555d55557555555555555555558000000000000000000000000000000000000000000000000000107e0107e01080
-% 80000f8feeef0000800006aaaab00000000000000000600000000000000000000000000000000000000000000000000010000101001080
-% 80000fd57555000055555555555951115111511151115000000000000000000000000000000000000000000000000000103c0101001080
-% 80000fa7fbbb0000602222aaaaa80000000000000000080000000000000000000000000000000000000000000000000010660101001080
-% 80000fd5555500003555555555555555555555555555560000000000000000000000000000000000000000000000000010420100001080
-% 80000daffaeb0000200001aaaaaa0000000000000000010000000000000000000000000000000000000000000000000010420107fc1080
-% 80000dd555558000155555d55555111111111111111111c000000000000000000000000000000000000000000000000010660100441080
-% 80000da7bbbb8000122222aaaaab00000000000000000020000000000000000000000000000000000000000000000000107fc100441080
-% 80000dd555558000155555555555d555555555555555555000000000000000000000000000000000000000000000000010000100441080
-% 80000d8ffeae80000800002aaaaac000000000000000000c000000000000000000000000000000000000000000000000106e0100441080
-% 80000dd5555580000d555575555571515151515151515152000000000000000000000000000000000000000000000000104a0103cc1080
-% 80001da7fbbbc0000420203aaaaaa0000000000000000001000000000000000000000000000000000000000000000000105a0107b81080
-% 80002dd55555400005555555555555555555555555555555c0000000000000000000000000000000000000000000000010720100001080
-% 80004faffaeac0000200000aaaaaa800000000000000000020000000000000000000000000000000000000000000000010000100041080
-% 80008fd5555540000355555555555511111111111111111118000000000000000000000000000000000000000000000010000100041080
-% 80008fa3bbbba00001222222aaaaaa00000000000000000004000000000000000000000000000000000000000000000010000100041080
-% 80004d575d5560000155555755555555555555555555555557000000000000000000000000000000000000000000000010000107fc1080
-% 80002d4bfeeea00000800001aaaaab00000000000000000000800000000000000000000000000000000000000000000010000100041080
-% 80001d575555500000555555d5555591511151115111511151600000000000000000000000000000000000000000000010000100041080
-% 80000d63ffbbb000006220226aaaaac00000000000000000001800000000000000000000000000000000000000000000107f0100041080
-% 80000d7555555800003555557555557555555555555555555554000000000000000000000000000000000000000000001183c101001080
-% 80000f29feeae800001000002aaaaab0000000000000000000030000000000000000000000000000000000000000000010000103381080
-% 80000f35d755540000155555555555591111111111111111111180000000000000000000000000000000000000000000100001046c1080
-% 80000fa2bbbbbc00000a22222aaaaaac0000000000000000000060000000000000000000000000000000000000000000107fc104441080
-% 80000fd5d5555400000555555555555755555555555555555555580000000000000000000000000000000000000000001003c104441080
-% 80000f9affaeee000004000002aaaaab0000000000000000000004000000000000000000000000000000000000000000101e0104cc1080
-% 80000fd5555556000003555557555555d15151515151515151515300000000000000000000000000000000000000000010700107981080
-% 80000f927bbbbb000001202021aaaaaac00000000000000000000080000000000000000000000000000000000000000010700100001080
-% 80000fdd55d555000001555555d555557555555555555555555555600000000000000000000000000000000000000000101e0100001080
-% 80000f88bfeaea8000008000006aaaaab0000000000000000000001800000000000000000000000000000000000000001003c100001080
-% 80000f9d75d5558000005555557555555911111111111111111111140000000000000000000000000000000000000000107fc100001080
-% 80000f8a3bfbbb8000006222223aaaaaa80000000000000000000003000000000000000000000000000000000000000010000100801080
-% 80000fd5555555400000355555555555555555555555555555555555800000000000000000000000000000000000000010000100801080
-% 80000f849feeaec000001000000aaaaaaa00000000000000000000006000000000000000000000000000000000000000103fc100801080
-% 80000f95557555600000155555555555551151115111511151115111580000000000000000000000000000000000000010600100001080
-% 80000f863bbbbba0000008222022aaaaaa8000000000000000000000040000000000000000000000000000000000000010400100001080
-% 80000fd75d7555500000055555555555555555555555555555555555570000000000000000000000000000000000000010400107fc1080
-% 80000f82affaeaf0000004000001aaaaaaa000000000000000000000008000000000000000000000000000000000000010400100401080
-% 80000f935d555550000003555555d555555111111111111111111111116000000000000000000000000000000000000010600100401080
-% 80000e8227bbbbb80000012222226aaaaaa8000000000000000000000018000000000000000000000000000000000000103fc100401080
-% 80000ed5555d55580000015555557555555555555555555555555555555400000000000000000000000000000000000010004100401080
-% 80000ec18ffeeeac0000008000001aaaaaaa00000000000000000000000300000000000000000000000000000000000010004100401080
-% 80001ed1555d55540000005555555555555551515151515151515151515180000000000000000000000000000000000010004107fc1080
-% 80002ec123ffbbbc0000006020202aaaaaaa800000000000000000000000600000000000000000000000000000000000107fc100001080
-% 80004dd5d75555560000003555555555555555555555555555555555555558000000000000000000000000000000000010004100001080
-% 80008dc0abfeeaea00000010000002aaaaaac0000000000000000000000004000000000000000000000000000000000010004100101080
-% 80008dd1d75555550000001555555555555571111111111111111111111112000000000000000000000000000000000010004100101080
-% 80004fc0a3bfbbbb0000000a222223aaaaaab0000000000000000000000001000000000000000000000000000000000010000107f81080
-% 80002dd5d75555550000000d555555d555555d555555555555555555555555c00000000000000000000000000000000010000100001080
-% 80001fc08bfeaeef00000008000000aaaaaaa8000000000000000000000000200000000000000000000000000000000011c3c100001080
-% 80000dd15755555500000005555555555555551151115111511151115111511000000000000000000000000000000000107f0100001080
-% 80000fc123bfbbbb000000062022206aaaaaaa000000000000000000000000080000000000000000000000000000000010000100001080
-% 80000dd5575555550000000555555575555557555555555555555555555555540000000000000000000000000000000010000103f81080
-% 80000dc1abfeeaeb000000020000002aaaaaab000000000000000000000000020000000000000000000000000000000010000106181080
-% 80000dd1575555550000000355555555555555911111111111111111111111118000000000000000000000000000000010000104081080
-% 80000fc123bfbbbb000000022222223aaaaaaa800000000000000000000000004000000000000000000000000000000010000106181080
-% 80000dd557555555000000015555555d555555555555555555555555555555556000000000000000000000000000000010000103f01080
-% 80000dc18bfeeeae800000010000000aaaaaaac00000000000000000000000001000000000000000000000000000000010000100001080
-% 80000dd1575555558000000155555555555555715151515151515151515151515800000000000000000000000000000010000107e01080
-% 80000fc223ffbbbb80000000a0202026aaaaaab00000000000000000000000000400000000000000000000000000000010000100201080
-% 80000dd75755555580000000d5555557555555555555555555555555555555555700000000000000000000000000000010000100201080
-% 80000dc2abfeeaea8000000080000002aaaaaaa80000000000000000000000000080000000000000000000000000000010000107e01080
-% 80000dd3575555558000000055555555555555551111111111111111111111111140000000000000000000000000000010000100201080
-% 80000fc223bfbbbb8000000062222223aaaaaaac0000000000000000000000000020000000000000000000000000000010000100201080
-% 80000dd7575555558000000055555555d55555575555555555555555555555555550000000000000000000000000000010000100201080
-% 80000fc28bfeaeee8000000020000000aaaaaaab0000000000000000000000000008000000000000000000000000000010000107e01080
-% 80000dd3575555558000000035555555555555555111511151115111511151115116000000000000000000000000000010000100001080
-% 80000fc223bfbbbb80000000202220226aaaaaaa8000000000000000000000000001000000000000000000000000000010000100001080
-% 80000dd5575555554000000035555555755555555555555555555555555555555555800000000000000000000000000010000100001080
-% 80000dc4abfeeaeac0000000100000002aaaaaaac000000000000000000000000000400000000000000000000000000010000100001080
-% 80000dd5575555554000000015555555555555557111111111111111111111111111200000000000000000000000000010000100001080
-% 80000fc627bfbbbbc0000000122222223aaaaaaab000000000000000000000000000180000000000000000000000000010000100801080
-% 80001dd555555555400000000d5555555d5555555555555555555555555555555555540000000000000000000000000010000100801080
-% 81002dc68ffeeeaec0000000080000000aaaaaaaa800000000000000000000000000020000000000000000000000000010000100801080
-% 81c04dd555555555400000000d555555555555555551515151515151515151515151510000000000000000000000000010000100001080
-% 81608fc627ffbbbbc00000000420202026aaaaaaac00000000000000000000000000008000000000000000000000000010000100001080
-% 87f08dd5555555554000000005555555575555555755555555555555555555555555554000000000000000000000000010000107fc1080
-% 81004dc4affeeaeac00000000400000002aaaaaaab00000000000000000000000000003000000000000000000000000010000100401080
-% 80002dd5555555556000000003555555555555555511111111111111111111111111111800000000000000000000000010000100601080
-% 80001fca27bfbbbba00000000222222223aaaaaaaa80000000000000000000000000000400000000000000000000000010000100f01080
-% 8400fddd55555555600000000155555555d555555555555555555555555555555555555600000000000000000000000010000103981080
-% 80000fc88ffeaeeea00000000100000000aaaaaaaac0000000000000000000000000000180000000000000000000000010000106041080
-% 83c00ddd555555556000000001555555555555555571511151115111511151115111511140000000000000000000000010000104001080
-% 86300fca27bfbbbba000000000a22022206aaaaaaab0000000000000000000000000000020000000000000000000000010000100001080
-% 84100ddd555555556000000000d55555557555555555555555555555555555555555555550000000000000000000000010000100101080
-% 84300dc8affeeaeae000000000800000002aaaaaaaa800000000000000000000000000000c000000000000000000000010000100101080
-% 83e00ddd555555555000000000555555555555555555111111111111111111111111111112000000000000000000000010000107f81080
-% 80000fca27bfbbbbb000000000622222223aaaaaaaaa000000000000000000000000000001000000000000000000000010000100001080
-% 80000ddd555555555000000000555555555d55555557555555555555555555555555555555800000000000000000000010000100001080
-% 80000dca8ffeeeaef000000000200000000aaaaaaaab000000000000000000000000000000600000000000000000000010000100001080
-% 80000ddd555555555000000000355555555555555555d15151515151515151515151515151500000000000000000000010000103f81080
-% 80000fd227ffbbbbb0000000002020202022aaaaaaaa800000000000000000000000000000080000000000000000000010000106181080
-% 80000dd5555555555000000000155555555755555555555555555555555555555555555555540000000000000000000010000104081080
-% 80000dd8affeeaeae8000000001000000001aaaaaaaaa00000000000000000000000000000030000000000000000000010000106181080
-% 80000dd5555555555800000000155555555555555555711111111111111111111111111111118000000000000000000010000103f01080
-% 80000fd227bfbbbbb8000000000a22222222aaaaaaaab00000000000000000000000000000004000000000000000000010000100001080
-% 80000dd55555555558000000000d55555555d55555555d5555555555555555555555555555556000000000000000000010000100001080
-% 80000fd88ffeaeeea80000000004000000006aaaaaaaa80000000000000000000000000000001800000000000000000010000107e01080
-% 80000dd5555755555800000000055555555555555555551151115111511151115111511151115400000000000000000010000100201080
-% 80000fd227bbbbbbb80000000006202220222aaaaaaaaa0000000000000000000000000000000200000000000000000010000100201080
-% 80001dd5555755555800000000035555555575555555575555555555555555555555555555555500000000000000000010000107e01080
-% 80002db8affeeaeaec0000000002000000001aaaaaaaab00000000000000000000000000000000c0000000000000000010000100201080
-% 80004df5555755555400000000035555555555555555559111111111111111111111111111111120000000000000000010000100201080
-% 80008fb227bbbbbbbc0000000001222222222aaaaaaaaac000000000000000000000000000000010000000000000000010000100201080
-% 80008df557575555540000000001555555555555555555555555555555555555555555555555555c000000000000000010000107e01080
-% 80004dba8bfeeeaeee00000000008000000002aaaaaaaaa000000000000000000000000000000002000000000000000010000100001080
-% 80002df5575555555600000000005555555557555555555151515151515151515151515151515151800000000000000010000100001080
-% 80001fb223fbbbbbba00000000006020202021aaaaaaaaa800000000000000000000000000000000400000000000000010000100001080
-% 80000dfd555555555500000000003555555555d55555555555555555555555555555555555555555600000000000000010000100001080
-% 80000da8a9ffeaeaeb000000000010000000006aaaaaaaaa00000000000000000000000000000000180000000000000010000100801080
-% 80000dfd5555d5555580000000001555555555755555555511111111111111111111111111111111140000000000000010000100801080
-% 80000faa23bbbbbbbb80000000000a222222223aaaaaaaaa80000000000000000000000000000000030000000000000010000100801080
-% 80000df555d5d5555580000000000555555555555555555555555555555555555555555555555555558000000000000010000100001080
-% 80000fa48affeeeeaec00000000004000000000aaaaaaaaaa0000000000000000000000000000000006000000000000010000100001080
-% 80000df555d55555554000000000035555555555555555555111511151115111511151115111511151100000000000001000013fe01080
-% 80000fa622bbfbbbbba000000000012220222022aaaaaaaaa8000000000000000000000000000000000c00000000000010000106601080
-% 80000df5555555555560000000000155555555555555555555555555555555555555555555555555555600000000000010000104201080
-% 80000da2a8ffeaeaeae000000000008000000000aaaaaaaaaa000000000000000000000000000000000180000000000010000106601080
-% 80000df355557555555000000000005555555555d555555555111111111111111111111111111111111140000000000010000103c01080
-% 80000fa2227bbbbbbbb0000000000022222222226aaaaaaaaa800000000000000000000000000000000030000000000010000100001080
-% 80000df7557555555558000000000035555555557555555555555555555555555555555555555555555558000000000010000100001080
-% 80000da188bffeaeeea8000000000010000000001aaaaaaaaaa00000000000000000000000000000000004000000000010000100001080
-% 80000df155755555555800000000000d555555555d55555555515151515151515151515151515151515153000000000010000100001080
-% 80000fa1223bfbbbbbbc0000000000082020202026aaaaaaaaa80000000000000000000000000000000000800000000010000100801080
-% 80000df555555d555554000000000005555555555555555555555555555555555555555555555555555555600000000010000100801080
-% 80001da1a8bffaeaeaea0000000000020000000002aaaaaaaaaa0000000000000000000000000000000000100000000010000100801080
-% 80002df1d5555d5555560000000000035555555555555555555511111111111111111111111111111111111c0000000010000100001080
-% 80004fa0a22bbfbbbbba0000000000012222222222aaaaaaaaaa8000000000000000000000000000000000020000000010000100001080
-% 80008df5d55d55555555000000000000d55555555555555555555555555555555555555555555555555555558000000010000107fc1080
-% 80008fa08a8ffeeeaeef00000000000080000000002aaaaaaaaaa000000000000000000000000000000000004000000010000100201080
-% 80004df1d55d55555555000000000000555555555575555555555111511151115111511151115111511151116000000010000100201080
-% 80002fa0a22bffbbbbbb00000000000060222022203aaaaaaaaab000000000000000000000000000000000001800000010000100201080
-% 80001df5d55d57555555800000000000355555555555555555555d55555555555555555555555555555555555400000010000107e01080
-% 80000da0a8affeeaeaea80000000000020000000000aaaaaaaaaac00000000000000000000000000000000000200000010000100001080
-% 80000df1d55d5755555580000000000035555555555d555555555511111111111111111111111111111111111100000010000100001080
-% 80000fa0a22bbbbbbbbb800000000000122222222226aaaaaaaaaa00000000000000000000000000000000000080000010000107fc1080
-% 80000df5d55d57555555800000000000155555555555555555555555555555555555555555555555555555555560000010000100441080
-% 80000da0888ffeaeeeae800000000000080000000002aaaaaaaaaa80000000000000000000000000000000000010000010000100441080
-% 80000df1d55d575555554000000000000d55555555575555555555d1515151515151515151515151515151515158000010000100441080
-% 80000fa0a22bfbbbbbbbc00000000000082020202021aaaaaaaaaac0000000000000000000000000000000000004000010000100441080
-% 80000df5d55d57555555400000000000055555555555d55555555575555555555555555555555555555555555557000010000103cc1080
-% 80000da0a8affeeaeaeac00000000000040000000000aaaaaaaaaaa0000000000000000000000000000000000000800010000107b81080
-% 80000df1d55557555555400000000000035555555555555555555551111111111111111111111111111111111111400010000100001080
-% 80000fa0a227bbbbbbbbc000000000000222222222226aaaaaaaaaa8000000000000000000000000000000000000200010000100001080
-% 80000df5d5555755555560000000000003555555555575555555555d555555555555555555555555555555555555580010000100001080
-% 80000fa08a8ffeeeaeeea000000000000100000000002aaaaaaaaaac000000000000000000000000000000000000040010000100001080
-% 80000df1d55555555555600000000000015555555555555555555557511151115111511151115111511151115111520010000100801080
-% 80000fa0a227fbbbbbbba0000000000000a2202220223aaaaaaaaaab000000000000000000000000000000000000010010000100801080
-% 80000df5d5555555555560000000000000d5555555555d555555555555555555555555555555555555555555555555c010000100801080
-% 80001da0a8afffeaeaeae000000000000080000000000aaaaaaaaaaa800000000000000000000000000000000000002010000100001080
-% 80002df1d55555555555500000000000005555555555555555555555511111111111111111111111111111111111111010000100001080
-% 80004fa0a227bbbbbbbbb0000000000000622222222222aaaaaaaaaac00000000000000000000000000000000000000810000107e41080
-% 80008df5d55555d555555800000000000035555555555755555555557d5555555555555555555555555555555555555410000100001080
-% 80008fd0688bff7eeeaeee000000000000400000000002aaaaaaaaaaabf000000000000000000000000000000000001810000100001080
-% 80004fb97d55559d555555800000000000d555555555555555555555555ff1515151515151515151515151515151516010000100101080
-% 80002ee43e22fbc3bbbbbbf0000000000120202020202aaaaaaaaaaaaaaabf800000000000000000000000000000018010000100101080
-% 80001ff57dd555407555555c000000000155555555555d55555555555555557f5555555555555555555555555555560010000107f81080
-% 80000ffa1fe8bfe00eeaeaeb000000000200000000001aaaaaaaaaaaaaaaaaaafc00000000000000000000000000080010000100001080
-% 80000fdd1f7d5d7111d55555e00000000555555555555555555555555555555557f9111111111111111111111111300010000100001080
-% 80000ffe8ffe27b0003bbbbbb80000000622222222222aaaaaaaaaaaaaaaaaaaaaafe00000000000000000000000c00010000100001080
-% 80000fd55ff7575404075555570000000d55555555557555555555555555555555555fd555555555555555555557000010000104001080
-% 80000fff27ffcbf80000eeeeaec000001000000000006aaaaaaaaaaaaaaaaaaaaaaaaabf0000000000000000000c000010000100001080
-% 80000ff5f7ff75d911113d5555700000155555555555d555555555555555555555555555ff115111511151115130000010000100001080
-% 80000ffbf3fffe7c000007bbbbbe0000202220222022aaaaaaaaaaaaaaaaaaaaaaaaaaaaabf800000000000000c0000010000100001080
-% 83c00ff57fff5776404040f55555800055555555555555555555555555555555555555555557f555555555555700000010000103f81080
-% 86f00ffff5ffffbe0000001eeaeae000800000000001aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaafc0000000000c00000010000106181080
-% 84501ff56ffff77d11111113d5555c00d5555555555755555555555555555555555555555555557f111111113000000010000104081080
-% 84502ffbbbfffffb000000007bbbbb01222222222222aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaafe0000004000000010000106181080
-% 83a04ffd5dfff557c40444044d5555e355555555555555555555555555555555555555555555555555fd55558000000010000103f01080
-% 80008ffffeffffff8000000003aeeeba00000000000aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaff0060000000010000100001080
-% 80008ffd577ffd75d11111111155555d555555555575555555555555555555555555555555555555555ff9780000000010000100001080
-% 8400cffbfdffffff80000000007bbbb02020202021eaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaabffe007800000000010000100001080
-% 80002ff55ffff5574040404040d555d555555555575555555555555555555555555555555555fffd5555f8000000000010000100001080
-% 83c01ffff7fffffe0000000001eaeb00000000003aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaabfff0000000f00000000000010000100801080
-% 86300ff5fffff77f1111111111555d5555555555d55555555555555555555555555557fff111111111f000000000000010000100801080
-% 84100ffbbffffffc0000000003bbb2222222222eaaaaaaaaaaaaaaaaaaaaaaaaaafff800000000001f0000000000000010000100801080
-% 84300fd77ffd555c040404040555d5555555557555555555555555555555555fff55555555555555e00000000000000010000100001080
-% 83e00ffefffffff80000000006ef0000000001aaaaaaaaaaaaaaaaaaaaafffe0000000000000001e000000000000000010000100001080
-% 80000fddfff77751111111111d5d555555555f555555555555555555fff9511151115111511153e0000000000000000010000106e01080
-% 80000fb7ffffffa0000000000bb2202220227aaaaaaaaaaaaaaabfff000000000000000000003c00000000000000000010000104a01080
-% 80001f7fffd55d404040404055d555555557d5555555555557ffd55555555555555555555557c000000000000000000010000105a01080
-% 80002fdfffffffc0000000002b000000001eaaaaaaaaaafff80000000000000000000000007c0000000000000000000010000107201080
-% 80004fffff777591111111113d55555555755555557fff1111111111111111111111111117800000000000000000000010000100001080
-% 80008fbfffffbb00000000007222222223aaaaafffc0000000000000000000000000000078000000000000000000000010000100001080
-% 80008d7ff555550444044404d55555555d5555fd5555555555555555555555555555555780000000000000000000000010000106e01080
-% 80004dfffffffe0000000000800000001aaaab000000000000000000000000000000001800000000000000000000000010000104a01080
-% 80002d7ff5755711111111115555555575555751515151515151515151515151515151e000000000000000000000000010000105a01080
-% 80001dfffffffa0000000003202020206aaaac000000000000000000000000000000070000000000000000000000000010000107201080
-% 80000d7ff55556404040404755555555d5555d555555555555555555555555555555780000000000000000000000000010000100001080
-% 80000dbffffffc000000000400000003aaaaa0000000000000000000000000000000c00000000000000000000000000010000100201080
-% 80000d7fff7755111111111d55555555555551111111111111111111111111111117000000000000000000000000000010000107f81080
-% 80000fbfffffbc000000001a2222222aaaaa80000000000000000000000000000038000000000000000000000000000010000104201080
-% 80000d7ffd57540404040415555555555555555555555555555555555555555555c0000000000000000000000000000010000103c01080
-% 80000dbffffff800000000300000002aaaaa00000000000000000000000000000600000000000000000000000000000010000106601080
-% 80000d7ffd7759111111117555555555555551115111511151115111511151117800000000000000000000000000000010000104201080
-% 80000dbffffff800000000e2202220aaaab80000000000000000000000000001c000000000000000000000000000000010000104201080
-% 80000d7ffd575840404040d555555755557555555555555555555555555555560000000000000000000000000000000010000106601080
-% 80000dbffffff80000000180000006aaaac000000000000000000000000000380000000000000000000000000000000010000107fc1080
-% 80000d7fff7751111111135555555d55559111111111111111111111111111c00000000000000000000000000000000010000100001080
-% 80000fbfffffb0000000032222223aaaab000000000000000000000000000e000000000000000000000000000000000010000101801080
-% 80000d5ffd5554044404475555557555575555555555555555555555555570000000000000000000000000000000000010000103c01080
-% 80000dbffffff00000000c0000006aaaac00000000000000000000000001c0000000000000000000000000000000000010000104a01080
-% 80000d5ffd757111111115555555d555595151515151515151515151515e00000000000000000000000000000000000010000104a01080
-% 80000dbfffffe000000018202022aaaaa00000000000000000000000007000000000000000000000000000000000000010000104e01080
-% 80000d5ffd5560404040755555555555555555555555555555555555558000000000000000000000000000000000000010000102c01080
-% 80000dbfffffe00000006000000aaaaa8000000000000000000000000e0000000000000000000000000000000000000010000100001080
-% 80001d5fff7551111111755555555555111111111111111111111111700000000000000000000000000000000000000010000107e01080
-% 80002fbfffffc0000000e222222aaaaa000000000000000000000003800000000000000000000000000000000000000010000100201080
-% 80004f5ffd5d44040405d5555555555d55555555555555555555555c000000000000000000000000000000000000000010000100201080
-% 80008eafffffc0000002800001aaaab0000000000000000000000070000000000000000000000000000000000000000010000100001080
-% 80008f5ffd7d91111113555557555571511151115111511151115380000000000000000000000000000000000000000010000107e01080
-% 80004eaffffb80000006202226aaaac0000000000000000000000c00000000000000000000000000000000000000000010000100201080
-% 80002f5ffd5dc040404b55555d5555d5555555555555555555557000000000000000000000000000000000000000000010000100201080
-% 80001eafffff8000000c00001aaaab00000000000000000000018000000000000000000000000000000000000000000010000100001080
-% 80000f5fff7d1111111d5555755557111111111111111111111e0000000000000000000000000000000000000000000010000100001080
-% 80000eaffffb0000002a22226aaaac00000000000000000000300000000000000000000000000000000000000000000010000100001080
-% 80000f5ffd55440444355555d5555d55555555555555555555c00000000000000000000000000000000000000000000010000100001080
-% 80000eafffff000000600001aaaab000000000000000000006000000000000000000000000000000000000000000000010000100001080
-% 80000f5ff577111111d5555755557151515151515151515158000000000000000000000000000000000000000000000010000100001080
-% 80000eaffffa000001602026aaaac0000000000000000000e0000000000000000000000000000000000000000000000010000100001080
-% 80000f57f576404041d5555d55555555555555555555555700000000000000000000000000000000000000000000000010000100001080
-% 80000eaffffe00000300002aaaaa0000000000000000001c00000000000000000000000000000000000000000000000010000100001080
-% 80000f57f77711111555555555551111111111111111116000000000000000000000000000000000000000000000000010000100001080
-% 80000eaffffc0000062222aaaaa80000000000000000038000000000000000000000000000000000000000000000000010000100001080
-% 80000f57f57404040d555555555555555555555555555c0000000000000000000000000000000000000000000000000010000100001080
-% 80000eaffffc0000180002aaaaa00000000000000000700000000000000000000000000000000000000000000000000010000100001080
-% 80000f57f55511111d55555555515111511151115111800000000000000000000000000000000000000000000000000010000100001080
-% 80000eaffff8000030222aaaaa80000000000000000e000000000000000000000000000000000000000000000000000010000100001080
-% 80000f57f55840407555555555555555555555555570000000000000000000000000000000000000000000000000000010000100001080
-% 80000eabfff80000a0002aaaae0000000000000001c0000000000000000000000000000000000000000000000000000010000100001080
-% 80000f57f7591111d555555559111111111111111600000000000000000000000000000000000000000000000000000010000100001080
-% 80000eabfff00001a223aaaab0000000000000003800000000000000000000000000000000000000000000000000000010000100001080
-% 80000f57f5d44406d55755557555555555555555c000000000000000000000000000000000000000000000000000000010000100001080
-% 80000eabfff000030006aaaac0000000000000070000000000000000000000000000000000000000000000000000000010000100001080
-% 80000f57f5d11117555d5555d1515151515151580000000000000000000000000000000000000000000000000000000010000100001080
-% 80000eabffe0000c203aaaab00000000000000e00000000000000000000000000000000000000000000000000000000010000100001080
-% 80000f57f5e0404d5575555755555555555557000000000000000000000000000000000000000000000000000000000010000100001080
-% 80001eabffe00018006aaaac0000000000001c000000000000000000000000000000000000000000000000000000000010000100001080
-% 80002f55f771113555d5555911111111111160000000000000000000000000000000000000000000000000000000000010000100001080
-% 80004eabffa0005223aaaab000000000000380000000000000000000000000000000000000000000000000000000000010000100001080
-% 80008f55f54404755755557555555555555c00000000000000000000000000000000000000000000000000000000000010000100001080
-% 80008eabffc000a006aaaac000000000003000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80004f55f55111d55d5555915111511151c000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80002faaffc001623aaaab0000000000070000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80001fd5f54041d57555575555555555580000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000faaffc001802aaaaa0000000000600000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000fd57f5113555555551111111111800000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000feaffc00322aaaaa8000000000e000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000f757dc447555555555555555570000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000efabfc00602aaaab000000000c0000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000f757dd11d575555715151515300000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000fbabfc00c26aaaac00000000c00000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000f5d5dc04d5d5555d55555557000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000feebfc0181aaaaa800000018000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000f5f5fd11d755555111111160000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000fbeafc0322aaaaa000000180000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000fd75fe435555555555555e00000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000fefafe060aaaaac000003000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000fd5dff17555555951115c000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000ffbafa061aaaab0000030000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000fd5d760d75555755555c0000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000feaefe086aaaaa0000700000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 86c00fd57771dd555551111800000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 85c00ffbbbe13aaaaa80006000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 85400ff577e755555555558000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 85400feefbe22aaaab00060000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 82400ff55df355555751780000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 83800ffbbfe6aaaaac00c00000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 87c00ff557e555555d57000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 85400ffaeeedaaaab00c000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 85400ff557ff55555170000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 87c01ffbbbfeaaaaa180000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80002ffd55fd55555600000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 83804ffeaefaaaaa9800000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 86408ffd55f55555e000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 84408ffbbbeaaaab8000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 84404ffd557555550000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 82c02ffaeaeaaaaa0000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 83801ffd55d555560000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 86400ff7bbeaaaaa0000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 84400ff555d555540000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 84400ff6efaaaaac0000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 83800ff555d555540000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000ff7bbaaaaac0000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 87c00fe5555555580000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80400fe6ebaaaaa80000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80400ff5575555580000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 87c00fe7baaaaab00000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000fe5575555500000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 83800fc6aeaaaab00000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 86400fd5575555600000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 84400fc7beaaaaa00000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 84400fc55d5555600000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 87f00f86eeaaaac00000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 86c00f955d5555400000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 85c00f87baaaaac00000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 85400f875d5555800000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 85400f82faaaaa800000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 82400f13555555800000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000f03baaaab000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000f43755555000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000f02faaaab000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000f13755555000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 8fe00e03eaaaaa000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 98300e07755556000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000e02eaaaaa000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 87f00f13d55554000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80600c03eaaaac000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 87800c43d55554000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 86000c02aaaaa8000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 81c01d13d55558000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80702c03aaaaa8000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 87f04c07555550000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80008801aaaab0000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80008913555560000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 83f04806aaab80000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 84002845555600000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 8400180aaab800000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 8400091d556000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 83f0081aab8000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000c35560000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 8010086aac0000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80100955700000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 801008aac00000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 87f009d7000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 801009ac000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80100b70000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 90100ec0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 98700d00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 87c00e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000800000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000003fff9fffcfffe7fff1fffcfffe7fff3fff8fffe7fff3fff9fffc7fff3fff9fffcfffe3fff9fffcfffe7fff00010000100001080
-% 80000003fff95554d556555514044d556400135558d55655553fff955545555355590404d556200095554d556555500010000100001080
-% 80000003fff9fffc8a8a7fff10004eeea400120008aaaa40013fff9fffc48a93fff90004aeee200090004aaaa400100010000100001080
-% 80000003fff97574d556555511114d556400135558d55651513fff977545555355591114d556200095554d556511500010000100001080
-% 80000003fff9fffca2227bbb10004bbba400122228aaaa40013fff9fffc62233fbb90004bbba200090224aaaa400100010000100001080
-% 80000003fff95554d556555510404d556400135558d55655553fff955545555355594044d556200095554d556555500010000100001080
-% 80000003fff9fffca8aa7fff10004aeae400120008aaaa40013fff9fffc4a8b3fff90004eaea200090004aaaa400100010000100001080
-% 80000003fff97774d556555511114d556400135558d55651113fff977745555355591114d556200095554d556511100010000100001080
-% 80000003fff9fffca2227bbb10004bbba400122228aaaa40013fff9fffc62233bbb90004bbba200092224aaaa400100010000100001080
-% 80000003fff95554d556555514044d556400135558d55655553fff955545555355594404d556200095554d556555500010000100001080
-% 80000003fff9fffc888a7fff10004eaee400120008aaaa40013fff9fffc68893fff90004eeae200090004aaaa400100010000100001080
-% 80000003fff97574d556555511114d556400135558d55651513fff957545555355591114d556200095554d556551500010000100001080
-% 80000003fff9fffca2227bfb10004bbba400122028aaaa40013fff9fffc62233fbf90004bbba200090204aaaa400100010000100001080
-% 80000003fff95554d556555510404d556400135558d55655553fff955545555355594044d556200095554d556555500010000100001080
-% 80000003fff9fffcfffe7fff1fffcfffe7fff3fff8fffe7fff3fff9fffc7fff3fff9fffcfffe3fff9fffcfffe7fff00010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000380000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 800000004400fe003f801fc00fe007f001fc00fe007f003f800fe007f003f801fc007f003f801fc00fe003f801fc000010000100001080
-% 800000008201830060c0306018300c180306018300c18060c018300c18060c030600c18060c030601830060c0306000010000100001080
-% 80000000820000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 8000000082002c00000001c0000000000084002c00000010800000000000b000580000000f000200010000000020000010000100001080
-% 80000000c6006f0000800f200020001000e6006f0001001cc00020001001bc00de0001001bc0038001c000080038000010000100001080
-% 800000007c00450000800a200020001000a200450001001440002000100114008a000100114002c001600008002c000010000100001080
-% 80000000000045001fc00f2007f003f800920045003f80124007f003f80114008a003f8011400fe007f001fc00fe000010000100001080
-% 8000000002003900000007c000000000008c003900000011800000000000e400720000000e800200010000000020000010000100001080
-% 80000000020001000b00058003c00110001c002c0000000040000000000038008400000010800440030004040058000010000100001080
-% 80000000020041001bc00de006f0031800f2006f00010010400020001001e400e60001001cc00c6004f0061c00de000010000100001080
-% 80000000fe007900114008a00450024800a200450001001e4000200010014400a200010014400920049001f0008a000010000100001080
-% 8000000002000d00114008a00450024800f20045003f80034007f003f801e40092003f801240092004900000008a000010004100001080
-% 80000000020003000e40072003a001f0007c003900000000c00000000000f8008c000000118007c003e000800072000010004100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000001980000000010004100001080
-% 80000000fe01010040402020010001100202010100000040400010008004040202002100404020201010013402020000107fc100001080
-% 800000001001870061c030e001c00318030e018700010061c0041000e0061c030e00398061c030e018700124030e000010004100001080
-% 8000000010007c001f000f800160024800f8007c0001001f00079000b001f000f80028801f000f8007c0012400f8000010004100001080
-% 8000000010006c00ff00040007f0024800000064003f80ff0000d003f8019000d800248008000c80000001c800d8000010004100001080
-% 80000000fe005c001b000cc0010001f000f80054000000190000300080015000b800230019800a8007c0000400b8000010000100001080
-% 8000000000005400110009a01010080800080054008080110010100808015000a800808013400a800400000c00a80000107fc100001080
-% 80000000000054001100092018700c380008005400c380110018700c38015000a800c38012400a800400003000a8000010020100001080
-% 80000000fe0024001f00092007c003e000f8007c003e000e0007c003e001f00048003e0012400f8007c001e00048000010020100001080
-% 800000009201040000000e400000000000080000000000000000000000000002080000001c800000000000380208000010020100001080
-% 800000009201380019000000000000000008000000360000000000036000e002700036000000070006c0000c02700000107e0100001080
-% 800000009200e0001500002007c003e000f8007c002e001f0007c002e0019001c0002e0000400c8005c0000001c0000010000100001080
-% 8000000092003800150000600400002000c80004002a000100040002a001100070002a0000c00880054000800070000010000100001080
-% 8000000000000400150001800400002000a80004002a000e00040002a001100008002a00030008800540019800080000107e0100001080
-% 80000000000000001f000f0007c003e000a8007c0012001f0007c0012001fc00000012001e000fe0024001340000000010400100001080
-% 80000000fe007c00000001c006c0002000a80000008200150006c0082000e000f8008200038007000380012400f8000010400100001080
-% 80000000120004001f00006005c0002000f8007c009c00150005c009c001900008009c0000c00c8007c001240008000010600100001080
-% 800000001200040001000400054003e0000000040070001f00054007000110000800700008000880054001c800080000107e0100001080
-% 8000000012007c0000000cc00540032000000004001c000000054001c0011000f8001c00198008800540000000f8000010000100001080
-% 80000000f20000001b0009a0024002a000fa007c000200ff000240002001fc000000020013400fe007c000040000000010000100001080
-% 80000000ee00040017000920038002a0000000000000001900038000000000000800000012400000100000040008000010000100001080
-% 8000000000007f001500092007c002a000f80038003e00110007c003e0007000fe003e00124003801000000400fe000010000100001080
-% 800000000000440015000e40054003e000080064000200110005400020008800880002001c800440100001fc0088000010400100001080
-% 8000000000007f000900000005400000000800440002000e0005400020010400fe000200000008201000000400fe000010780100001080
-% 80000000000004000e00002007c003f800f80044003e00190007c003e001040008003e00004008201000000400080000100f0100001080
-% 80000000000004001f000020000000c000000038000200150000000020010400080002000040082010000000000800001009c100001080
-% 8000000000007c001500002001c000c000000004003f801500100003f8018c00f8003f8000400c6007f001fc00f800001009c100001080
-% 800000000000000015000fe0022001a00000007f00220015001000022000c800000022001fc006400640012400000000100f0100001080
-% 80000000000100001f00002004100200000000440000001f00100000000070020000000000400380044001240200000010780100001080
-% 800000000001000000000020041001c000000064003f800000100003f800880200003f8000400440044001240200000010400100001080
-% 800000000001000000000000041003e0000000540002000000100000200104020000020000000820038001240200000010000100001080
-% 800000000001000000000fe0063002a0000000540002001f0017f00020010402000002001fc0082007f0000002000000107e0100001080
-% 800000000001000000000920032002a000000054003e000100064003e001040200003e0012400820064001fc0200000010400100001080
-% 80000000000100000000092001c003e00000007c0000001b0004400000018c020000000012400c60044000180200000010400100001080
-% 800000000000420000000920022000e00000000000800017000440080000c8008400000012400640044001e00084000010600100001080
-% 800000000000730000000920041001100000000400800015000380080001b000e6003f8012400d800380018000e60000107e0100001080
-% 800000000000510000000000041002080000007f008000150000000800017000a200200000000b800000007000a20000103c0100001080
-% 800000000000490000000000041002080000007c008000090007f008000150009200200000000a800000001c0092000013660100001080
-% 800000000000460000000fe0063002080000007c0080000e00064008000150008c0020001fc00a80000001fc008c000012420100001080
-% 8000000000000000000000c0032003180000005400a1001f0004400a100090000000000001800480000000000000000012420100001080
-% 800000000000c00000000f00038001900000005400398015000440039804000180003e801e002000000000000000000013fe0100001080
-% 800000000000000000000c00064000e00000007c0028801500038002880400000000000018002000000000000000000011fe0100001080
-% 80000000000064000000038004400110000000000024801f000000024804000000003e0007002000000000000000000010000100001080
-% 8000000000005400000000e0044002080000010000230000000c000230040000f800020001c02000000000000000000010000100001080
-% 800000000000540000000fe007f0020800000100000000000000000000040000800002001fc02000000000000000000010000100001080
-% 8000000000005400000000000000020800000100000000000006c0000004000080003e0000002000000000000000000010000100001080
-% 8000000000007c00000018000380031800000100006000000005c00600003000f800000030000180000000000000000010420100001080
-% 80000000000038000000000007c001900000010000000000000540000001e000d8001c0000000f00000000000000000010738100001080
-% 8000000000006400000000000540000000000100003e000000054003e001c000b8003e001b000e00000000000000000010588100001080
-% 800000000000440000000f80054001c000000000000200000002400020003000a8002a0017000180000000000000000010488100001080
-% 80000000000044000000080007c003200000007d00020000001040002001e000a8002a0015000f000000000000000000104c8100001080
-% 8000000000007f000000080006c0022000000000003e000000138003e001c00048003e0015000e00000000000000000010478100001080
-% 800000000000000000000f8005c002200000007c00020000000e0000200030007000000009000180000000000000000010000100001080
-% 800000000000380000000000054003f800000004000200000003800020000000f800000041000000000000000000000010210100001080
-% 800000000000640000000d80054001c000000004003e000000004003e001f000a80000004e000f80000000000000000010718100001080
-% 800000000000440000000b80024003e00000007c000000000000000000001000a800000038000080000000000000000010408100001080
-% 800000000000440000000a80038002a00000006c003200000007c0032001fc00f80000000e000fe0000000000000000010448100001080
-% 8000000000007f0000000a80064002a00000005c002a000000004002a000600000000000010003000000000000000000104c8100001080
-% 800000000000000000000480044003e000000054002a000000004002a000600200000000000003000000000000000000103b0100001080
-% 8000000000001c00000007000440000000000054002a00000007c002a000d002000000001f000680000000000000000010000100001080
-% 800000000000220000000f8002c0036000000024003e000000000003e00100020000000001000800000000000000000010000100001080
-% 800000000000410000000a80000002e000000000003f800000004003f80000020000000001000000000000000000000010000100001080
-% 800000000000410000000a8007c002a00000007c000c00000007f000c0030002000000001f000000000000000000000010000100001080
-% 800000000000410000000f80004002a000000004000c000000044000c00000020000000000000000000000000000000010000100001080
-% 8000000000006300000020000000012000000004001a000000000001a0000000fe00000001000000000000000000000010010100001080
-% 800000000000320000002000000001c00000007c002000000007f0020001f000c80000001fc00000000000000000000010010100001080
-% 8000000000001c000000200007d0032000000000001c000000004001c001000088000000110000000000000000000000107f8100001080
-% 8000000000002200000020003fc0022000000000003e000000004003e0010000880000001fc00000000000000000000010000100001080
-% 8000000000004100000020000640022000000000002a00000007c002a001f0007000000001000000000000000000000010000100001080
-% 8000000000004100000020000440016000000000002a000000000002a0000000fe00000001000000000000000000000010000100001080
-% 800000000000410000000fe00440000000000000003e00000007f003e001b000c80000001f000000000000000000000010008100001080
-% 800000000000630000000c80038003e0000000000000000000040000000170008800000000000000000000000000000010008100001080
-% 8000000000003200000008800040002000000000000e000000040000e00150008800000040000000000000000000000010708100001080
-% 8000000000006c000000088007f000000000000000110000000400011001500070000000400000000000000000000000101c8100001080
-% 8000000000005c0000000700044003e8000000000020800000000002080090000000000040000000000000000000000010028100001080
-% 800000000000540000000fe003801fe00000000000208000000000020800e0000000000040000000000000000000000010018100001080
-% 800000000000540000000c800640032000000000002080000007d0020801f0000000000040000000000000000000000010000100001080
-% 80000000000024000000088004400220000000000031800000000003180150000000000050800000000000000000000010420100001080
-% 8000000000010000000008800440022000000000001900000007c00190015000000000001cc00000000000000000000010000100001080
-% 800000000001000000000700038001c000000000000e000000004000e001f0000000000014400000000000000000000010000100001080
-% 80000000000100000000000000000000000000000011000000004001100400000000000012400000000000000000000010210100001080
-% 8000000000010000000000000000002000000000002080000007c002080400000000000011800000000000000000000010718100001080
-% 80000000000100000000000007c003f8000000000020800000038002080400000000000000000000000000000000000010408100001080
-% 8000000000010000000000000040022000000000002080000007c002080400000000000000000000000000000000000010448100001080
-% 8000000000000c000000000006c001c00000000000318000000540031804000000000000000000000000000000000000104c8100001080
-% 80000000000078000000000005c003200000000000190000000540019004000000000000000000000000000000000000103b0100001080
-% 8000000000007000000000000540022000000000001c00000007c001c001fc000000000000000000000000000000000010008100001080
-% 8000000000000c000000000005400220000000000032000000000003200190000000000000000000000000000000000010008100001080
-% 800000000000780000000000024001c0000000000022000000000002200110000000000000000000000000000000000010708100001080
-% 800000000000700000000000000000000000000000220000000000022001100000000000000000000000000000000000101c8100001080
-% 8000000000000c0000000000000003e000000000003f800000000003f800e0000000000000000000000000000000000010028100001080
-% 800000000000000000000000000000200000000000000000000000000001fc000000000000000000000000000000000010018100001080
-% 8000000000007c00000000000000036000000000001c000000000001c00190000000000000000000000000000000000010000100001080
-% 800000000000040000000000000002e000000000003e000000000003e00110000000000000000000000000000000000010000100001080
-% 8000000000007f0000000000000002a000000000002a000000000002a00110000000000000000000000000000000000010000100001080
-% 800000000000180000000000000002a000000000002a000000000002a000e0000000000000000000000000000000000010000100001080
-% 8000000000001800000000000000012000000000003e000000000003e00000000000000000000000000000000000000010420100001080
-% 80000000000034000000000000000000000000000036000000000003600000000000000000000000000000000000000010738100001080
-% 8000000000004000000000000000000000000000002e000000000002e00000000000000000000000000000000000000010588100001080
-% 8000000000000000000000000000000000000000002a000000000002a00000000000000000000000000000000000000010488100001080
-% 8000000000000000000000000000000000000000002a000000000002a000000000000000000000000000000000000000104c8100001080
-% 80000000000000000000000000000000000000000012000000000001200000000000000000000000000000000000000010478100001080
-% 8000000000000000000000000000000000000000001c000000000001c00000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000032000000000003200000000000000000000000000000000000000010000100001080
-% 800000000000000000000000000000000000000000220000000000022000000000000000000000000000000000000000103f8100001080
-% 80000000000000000000000000000000000000000022000000000002200000000000000000000000000000000000000010618100001080
-% 80000000000000000000000000000000000000000016000000000001600000000000000000000000000000000000000010408100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010618100001080
-% 8000000000000000000000000000000000000000003e000000000003e000000000000000000000000000000000000000103f0100001080
-% 80000000000000000000000000000000000000000002000000000000200000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 800000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000103f8100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010618100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010408100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010618100001080
-% 800000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000103f0100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010010100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010010100001080
-% 800000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000107f8100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010000100001080
-% 8000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001ffffffffff080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000080
-% 80000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000080
-% ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff80
-%%EndImage
-%%EndPreview
-save
-countdictstack
-mark
-newpath
-/showpage {} def
-/setpagedevice {pop} def
-%%EndProlog
-%%Page 1 1
-
--90 rotate
--756.000000 72.000000 translate
-/HE10 /Helvetica findfont 10 scalefont def
-/HE12 /Helvetica findfont 12 scalefont def
-newpath
-0 0 moveto
-0 432.000000 rlineto
-648.000000 0 rlineto
-0 -432.000000 rlineto
-closepath
-0.500000 setlinewidth
-stroke
-newpath
-5.000000 387.000000 moveto
-0 40.000000 rlineto
-638.000000 0 rlineto
-0 -40.000000 rlineto
-closepath
-0.500000 setlinewidth
-stroke
-5.000000 407.000000 moveto
-638.000000 0 rlineto
-stroke
-HE12 setfont
-11.000000 413.000000 moveto
-(cacheprof_p -ghc-timing +RTS -H10m -K10m -p -hR -i1.0 -sstderr 
-) show
-HE12 setfont
-11.000000 393.000000 moveto
-(22,191,444 bytes x seconds (MUT))
-show
-HE12 setfont
-(Thu Aug 23 17:37 2001)
-dup stringwidth pop
-637.000000
-exch sub
-393.000000 moveto
-show
-45.000000 20.000000 moveto
-431.338567 0 rlineto
-0.500000 setlinewidth
-stroke
-HE10 setfont
-(seconds (MUT))
-dup stringwidth pop
-476.338567
-exch sub
-5.000000 moveto
-show
-45.000000 20.000000 moveto
-0 -4 rlineto
-stroke
-HE10 setfont
-(0.0)
-dup stringwidth pop
-2 div
-45.000000 exch sub
-5.000000 moveto
-show
-135.712632 20.000000 moveto
-0 -4 rlineto
-stroke
-HE10 setfont
-(2.0)
-dup stringwidth pop
-2 div
-135.712632 exch sub
-5.000000 moveto
-show
-226.425265 20.000000 moveto
-0 -4 rlineto
-stroke
-HE10 setfont
-(4.0)
-dup stringwidth pop
-2 div
-226.425265 exch sub
-5.000000 moveto
-show
-317.137897 20.000000 moveto
-0 -4 rlineto
-stroke
-HE10 setfont
-(6.0)
-dup stringwidth pop
-2 div
-317.137897 exch sub
-5.000000 moveto
-show
-45.000000 20.000000 moveto
-0 362.000000 rlineto
-0.500000 setlinewidth
-stroke
-gsave
-HE10 setfont
-(bytes)
-dup stringwidth pop
-382.000000
-exch sub
-40.000000 exch
-translate
-90 rotate
-0 0 moveto
-show
-grestore
-45.000000 20.000000 moveto
--4 0 rlineto
-stroke
-HE10 setfont
-(0k)
-dup stringwidth
-2 div
-20.000000 exch sub
-exch
-40.000000 exch sub
-exch
-moveto
-show
-45.000000 56.751299 moveto
--4 0 rlineto
-stroke
-HE10 setfont
-(500k)
-dup stringwidth
-2 div
-56.751299 exch sub
-exch
-40.000000 exch sub
-exch
-moveto
-show
-45.000000 93.502598 moveto
--4 0 rlineto
-stroke
-HE10 setfont
-(1,000k)
-dup stringwidth
-2 div
-93.502598 exch sub
-exch
-40.000000 exch sub
-exch
-moveto
-show
-45.000000 130.253897 moveto
--4 0 rlineto
-stroke
-HE10 setfont
-(1,500k)
-dup stringwidth
-2 div
-130.253897 exch sub
-exch
-40.000000 exch sub
-exch
-moveto
-show
-45.000000 167.005196 moveto
--4 0 rlineto
-stroke
-HE10 setfont
-(2,000k)
-dup stringwidth
-2 div
-167.005196 exch sub
-exch
-40.000000 exch sub
-exch
-moveto
-show
-45.000000 203.756494 moveto
--4 0 rlineto
-stroke
-HE10 setfont
-(2,500k)
-dup stringwidth
-2 div
-203.756494 exch sub
-exch
-40.000000 exch sub
-exch
-moveto
-show
-45.000000 240.507793 moveto
--4 0 rlineto
-stroke
-HE10 setfont
-(3,000k)
-dup stringwidth
-2 div
-240.507793 exch sub
-exch
-40.000000 exch sub
-exch
-moveto
-show
-45.000000 277.259092 moveto
--4 0 rlineto
-stroke
-HE10 setfont
-(3,500k)
-dup stringwidth
-2 div
-277.259092 exch sub
-exch
-40.000000 exch sub
-exch
-moveto
-show
-45.000000 314.010391 moveto
--4 0 rlineto
-stroke
-HE10 setfont
-(4,000k)
-dup stringwidth
-2 div
-314.010391 exch sub
-exch
-40.000000 exch sub
-exch
-moveto
-show
-481.338567 30.238095 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.000000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 32.238095 moveto
-(OTHER) show
-481.338567 47.476190 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.200000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 49.476190 moveto
-((57)synth_2,addCCs_wrk) show
-481.338567 64.714286 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.600000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 66.714286 moveto
-((15)parse) show
-481.338567 81.952381 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.300000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 83.952381 moveto
-((95)SYSTEM,use_bb) show
-481.338567 99.190476 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.900000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 101.190476 moveto
-((164)useCCdescriptors) show
-481.338567 116.428571 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.400000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 118.428571 moveto
-((133)makeCCdescriptors) show
-481.338567 133.666667 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-1.000000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 135.666667 moveto
-((29)main) show
-481.338567 150.904762 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.700000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 152.904762 moveto
-((55)annotate_insn) show
-481.338567 168.142857 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.500000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 170.142857 moveto
-((111)synth_2,makeCCdescr) show
-481.338567 185.380952 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.800000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 187.380952 moveto
-((27)preparse) show
-481.338567 202.619048 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.000000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 204.619048 moveto
-((117)use_bb,synthLine) show
-481.338567 219.857143 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.200000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 221.857143 moveto
-((114)synth_2,makeCCdescr) show
-481.338567 237.095238 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.600000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 239.095238 moveto
-((59)addCCs_wrk,use_bb) show
-481.338567 254.333333 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.300000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 256.333333 moveto
-((52)synth_2,use_bb) show
-481.338567 271.571429 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.900000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 273.571429 moveto
-((112)synthLine) show
-481.338567 288.809524 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.400000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 290.809524 moveto
-((62)SYSTEM,synth_2) show
-481.338567 306.047619 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-1.000000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 308.047619 moveto
-((43)addCCs_wrk) show
-481.338567 323.285714 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.700000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 325.285714 moveto
-((48)use_bb) show
-481.338567 340.523810 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.500000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 342.523810 moveto
-((1)SYSTEM) show
-481.338567 357.761905 moveto
-0 14 rlineto
-14 0 rlineto
-0 -14 rlineto
-closepath
-gsave
-0.800000 setgray
-fill
-grestore
-stroke
-HE10 setfont
-500.338567 359.761905 moveto
-((45)synth_2) show
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 20.000000 lineto
-125.280680 20.000000 lineto
-160.658606 20.000000 lineto
-191.954465 20.000000 lineto
-221.889633 20.000000 lineto
-249.556986 20.000000 lineto
-275.410086 20.000000 lineto
-298.541808 20.000000 lineto
-316.230771 20.000000 lineto
-330.291229 20.000000 lineto
-356.144329 20.000000 lineto
-386.533061 20.000000 lineto
-421.457425 20.000000 lineto
-459.556730 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 20.618304 lineto
-421.457425 28.827368 lineto
-386.533061 20.618304 lineto
-356.144329 20.618304 lineto
-330.291229 20.618304 lineto
-316.230771 28.577459 lineto
-298.541808 20.618304 lineto
-275.410086 20.618304 lineto
-249.556986 20.618304 lineto
-221.889633 20.618304 lineto
-191.954465 20.618304 lineto
-160.658606 20.618304 lineto
-125.280680 20.618304 lineto
-88.542064 20.618304 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.000000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 20.618304 lineto
-125.280680 20.618304 lineto
-160.658606 20.618304 lineto
-191.954465 20.618304 lineto
-221.889633 20.618304 lineto
-249.556986 20.618304 lineto
-275.410086 20.618304 lineto
-298.541808 20.618304 lineto
-316.230771 28.577459 lineto
-330.291229 20.618304 lineto
-356.144329 20.618304 lineto
-386.533061 20.618304 lineto
-421.457425 28.827368 lineto
-459.556730 20.618304 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 20.618304 lineto
-421.457425 28.827368 lineto
-386.533061 20.618304 lineto
-356.144329 20.654467 lineto
-330.291229 21.323929 lineto
-316.230771 28.577459 lineto
-298.541808 21.736719 lineto
-275.410086 21.736719 lineto
-249.556986 21.736719 lineto
-221.889633 21.736719 lineto
-191.954465 21.736719 lineto
-160.658606 21.700556 lineto
-125.280680 21.571780 lineto
-88.542064 20.955240 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.200000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 20.955240 lineto
-125.280680 21.571780 lineto
-160.658606 21.700556 lineto
-191.954465 21.736719 lineto
-221.889633 21.736719 lineto
-249.556986 21.736719 lineto
-275.410086 21.736719 lineto
-298.541808 21.736719 lineto
-316.230771 28.577459 lineto
-330.291229 21.323929 lineto
-356.144329 20.654467 lineto
-386.533061 20.618304 lineto
-421.457425 28.827368 lineto
-459.556730 20.618304 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 20.618304 lineto
-421.457425 28.827368 lineto
-386.533061 20.618304 lineto
-356.144329 20.654467 lineto
-330.291229 21.323929 lineto
-316.230771 28.577459 lineto
-298.541808 23.214416 lineto
-275.410086 23.213534 lineto
-249.556986 23.213534 lineto
-221.889633 23.074761 lineto
-191.954465 23.074761 lineto
-160.658606 21.700556 lineto
-125.280680 22.833966 lineto
-88.542064 21.955757 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.600000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 21.955757 lineto
-125.280680 22.833966 lineto
-160.658606 21.700556 lineto
-191.954465 23.074761 lineto
-221.889633 23.074761 lineto
-249.556986 23.213534 lineto
-275.410086 23.213534 lineto
-298.541808 23.214416 lineto
-316.230771 28.577459 lineto
-330.291229 21.323929 lineto
-356.144329 20.654467 lineto
-386.533061 20.618304 lineto
-421.457425 28.827368 lineto
-459.556730 20.618304 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 20.618304 lineto
-421.457425 28.827368 lineto
-386.533061 20.618304 lineto
-356.144329 20.654467 lineto
-330.291229 21.323929 lineto
-316.230771 38.031951 lineto
-298.541808 23.214416 lineto
-275.410086 23.213534 lineto
-249.556986 23.213534 lineto
-221.889633 23.074761 lineto
-191.954465 23.074761 lineto
-160.658606 21.700556 lineto
-125.280680 22.833966 lineto
-88.542064 21.955757 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.300000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 21.955757 lineto
-125.280680 22.833966 lineto
-160.658606 21.700556 lineto
-191.954465 23.074761 lineto
-221.889633 23.074761 lineto
-249.556986 23.213534 lineto
-275.410086 23.213534 lineto
-298.541808 23.214416 lineto
-316.230771 38.031951 lineto
-330.291229 21.323929 lineto
-356.144329 20.654467 lineto
-386.533061 20.618304 lineto
-421.457425 28.827368 lineto
-459.556730 20.618304 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.040972 lineto
-421.457425 28.827368 lineto
-386.533061 20.618304 lineto
-356.144329 20.654467 lineto
-330.291229 21.323929 lineto
-316.230771 38.031951 lineto
-298.541808 23.214416 lineto
-275.410086 23.213534 lineto
-249.556986 23.213534 lineto
-221.889633 23.074761 lineto
-191.954465 23.074761 lineto
-160.658606 21.700556 lineto
-125.280680 22.833966 lineto
-88.542064 21.955757 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.900000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 21.955757 lineto
-125.280680 22.833966 lineto
-160.658606 21.700556 lineto
-191.954465 23.074761 lineto
-221.889633 23.074761 lineto
-249.556986 23.213534 lineto
-275.410086 23.213534 lineto
-298.541808 23.214416 lineto
-316.230771 38.031951 lineto
-330.291229 21.323929 lineto
-356.144329 20.654467 lineto
-386.533061 20.618304 lineto
-421.457425 28.827368 lineto
-459.556730 31.040972 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.040972 lineto
-421.457425 41.485985 lineto
-386.533061 20.620068 lineto
-356.144329 20.656231 lineto
-330.291229 21.325693 lineto
-316.230771 38.031951 lineto
-298.541808 23.214416 lineto
-275.410086 23.213534 lineto
-249.556986 23.213534 lineto
-221.889633 23.074761 lineto
-191.954465 23.074761 lineto
-160.658606 21.700556 lineto
-125.280680 22.833966 lineto
-88.542064 21.955757 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.400000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 21.955757 lineto
-125.280680 22.833966 lineto
-160.658606 21.700556 lineto
-191.954465 23.074761 lineto
-221.889633 23.074761 lineto
-249.556986 23.213534 lineto
-275.410086 23.213534 lineto
-298.541808 23.214416 lineto
-316.230771 38.031951 lineto
-330.291229 21.325693 lineto
-356.144329 20.656231 lineto
-386.533061 20.620068 lineto
-421.457425 41.485985 lineto
-459.556730 31.040972 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.679269 lineto
-421.457425 42.124282 lineto
-386.533061 21.258364 lineto
-356.144329 21.294528 lineto
-330.291229 21.963989 lineto
-316.230771 39.278849 lineto
-298.541808 24.455433 lineto
-275.410086 24.454551 lineto
-249.556986 24.454551 lineto
-221.889633 24.315779 lineto
-191.954465 24.315779 lineto
-160.658606 22.941574 lineto
-125.280680 24.074984 lineto
-88.542064 23.196775 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-1.000000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 23.196775 lineto
-125.280680 24.074984 lineto
-160.658606 22.941574 lineto
-191.954465 24.315779 lineto
-221.889633 24.315779 lineto
-249.556986 24.454551 lineto
-275.410086 24.454551 lineto
-298.541808 24.455433 lineto
-316.230771 39.278849 lineto
-330.291229 21.963989 lineto
-356.144329 21.294528 lineto
-386.533061 21.258364 lineto
-421.457425 42.124282 lineto
-459.556730 31.679269 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.679269 lineto
-421.457425 42.124282 lineto
-386.533061 22.023968 lineto
-356.144329 22.922757 lineto
-330.291229 23.872705 lineto
-316.230771 41.524501 lineto
-298.541808 26.559960 lineto
-275.410086 26.340334 lineto
-249.556986 26.038679 lineto
-221.889633 25.642353 lineto
-191.954465 25.245439 lineto
-160.658606 23.546647 lineto
-125.280680 24.593618 lineto
-88.542064 23.493137 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.700000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 23.493137 lineto
-125.280680 24.593618 lineto
-160.658606 23.546647 lineto
-191.954465 25.245439 lineto
-221.889633 25.642353 lineto
-249.556986 26.038679 lineto
-275.410086 26.340334 lineto
-298.541808 26.559960 lineto
-316.230771 41.524501 lineto
-330.291229 23.872705 lineto
-356.144329 22.922757 lineto
-386.533061 22.023968 lineto
-421.457425 42.124282 lineto
-459.556730 31.679269 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.679269 lineto
-421.457425 42.278637 lineto
-386.533061 31.368500 lineto
-356.144329 28.080582 lineto
-330.291229 25.593548 lineto
-316.230771 41.524501 lineto
-298.541808 26.559960 lineto
-275.410086 26.340334 lineto
-249.556986 26.038679 lineto
-221.889633 25.642353 lineto
-191.954465 25.245439 lineto
-160.658606 23.546647 lineto
-125.280680 24.593618 lineto
-88.542064 23.493137 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.500000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 23.493137 lineto
-125.280680 24.593618 lineto
-160.658606 23.546647 lineto
-191.954465 25.245439 lineto
-221.889633 25.642353 lineto
-249.556986 26.038679 lineto
-275.410086 26.340334 lineto
-298.541808 26.559960 lineto
-316.230771 41.524501 lineto
-330.291229 25.593548 lineto
-356.144329 28.080582 lineto
-386.533061 31.368500 lineto
-421.457425 42.278637 lineto
-459.556730 31.679269 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.679269 lineto
-421.457425 42.278637 lineto
-386.533061 31.368500 lineto
-356.144329 28.080582 lineto
-330.291229 25.593548 lineto
-316.230771 41.524501 lineto
-298.541808 32.677140 lineto
-275.410086 32.867659 lineto
-249.556986 27.036551 lineto
-221.889633 29.209581 lineto
-191.954465 32.384894 lineto
-160.658606 24.587738 lineto
-125.280680 24.605379 lineto
-88.542064 29.373933 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.800000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 29.373933 lineto
-125.280680 24.605379 lineto
-160.658606 24.587738 lineto
-191.954465 32.384894 lineto
-221.889633 29.209581 lineto
-249.556986 27.036551 lineto
-275.410086 32.867659 lineto
-298.541808 32.677140 lineto
-316.230771 41.524501 lineto
-330.291229 25.593548 lineto
-356.144329 28.080582 lineto
-386.533061 31.368500 lineto
-421.457425 42.278637 lineto
-459.556730 31.679269 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.679269 lineto
-421.457425 42.278637 lineto
-386.533061 35.123306 lineto
-356.144329 36.264949 lineto
-330.291229 35.930071 lineto
-316.230771 53.392818 lineto
-298.541808 32.677140 lineto
-275.410086 32.867659 lineto
-249.556986 27.036551 lineto
-221.889633 29.209581 lineto
-191.954465 32.384894 lineto
-160.658606 24.587738 lineto
-125.280680 24.605379 lineto
-88.542064 29.373933 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.000000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 29.373933 lineto
-125.280680 24.605379 lineto
-160.658606 24.587738 lineto
-191.954465 32.384894 lineto
-221.889633 29.209581 lineto
-249.556986 27.036551 lineto
-275.410086 32.867659 lineto
-298.541808 32.677140 lineto
-316.230771 53.392818 lineto
-330.291229 35.930071 lineto
-356.144329 36.264949 lineto
-386.533061 35.123306 lineto
-421.457425 42.278637 lineto
-459.556730 31.679269 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.679269 lineto
-421.457425 42.278637 lineto
-386.533061 39.445259 lineto
-356.144329 44.770669 lineto
-330.291229 47.872773 lineto
-316.230771 65.212036 lineto
-298.541808 32.677140 lineto
-275.410086 32.867659 lineto
-249.556986 27.036551 lineto
-221.889633 29.209581 lineto
-191.954465 32.384894 lineto
-160.658606 24.587738 lineto
-125.280680 24.605379 lineto
-88.542064 29.373933 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.200000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 29.373933 lineto
-125.280680 24.605379 lineto
-160.658606 24.587738 lineto
-191.954465 32.384894 lineto
-221.889633 29.209581 lineto
-249.556986 27.036551 lineto
-275.410086 32.867659 lineto
-298.541808 32.677140 lineto
-316.230771 65.212036 lineto
-330.291229 47.872773 lineto
-356.144329 44.770669 lineto
-386.533061 39.445259 lineto
-421.457425 42.278637 lineto
-459.556730 31.679269 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.679269 lineto
-421.457425 42.278637 lineto
-386.533061 39.445259 lineto
-356.144329 44.770669 lineto
-330.291229 47.872773 lineto
-316.230771 65.212036 lineto
-298.541808 45.475412 lineto
-275.410086 44.560452 lineto
-249.556986 37.761462 lineto
-221.889633 37.820558 lineto
-191.954465 38.949558 lineto
-160.658606 29.876397 lineto
-125.280680 28.824428 lineto
-88.542064 32.072361 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.600000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 32.072361 lineto
-125.280680 28.824428 lineto
-160.658606 29.876397 lineto
-191.954465 38.949558 lineto
-221.889633 37.820558 lineto
-249.556986 37.761462 lineto
-275.410086 44.560452 lineto
-298.541808 45.475412 lineto
-316.230771 65.212036 lineto
-330.291229 47.872773 lineto
-356.144329 44.770669 lineto
-386.533061 39.445259 lineto
-421.457425 42.278637 lineto
-459.556730 31.679269 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.679269 lineto
-421.457425 42.278637 lineto
-386.533061 41.769117 lineto
-356.144329 48.957965 lineto
-330.291229 55.205392 lineto
-316.230771 65.212036 lineto
-298.541808 55.455301 lineto
-275.410086 53.812665 lineto
-249.556986 46.138112 lineto
-221.889633 45.465122 lineto
-191.954465 45.850276 lineto
-160.658606 35.922721 lineto
-125.280680 33.236054 lineto
-88.542064 34.512353 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.300000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 34.512353 lineto
-125.280680 33.236054 lineto
-160.658606 35.922721 lineto
-191.954465 45.850276 lineto
-221.889633 45.465122 lineto
-249.556986 46.138112 lineto
-275.410086 53.812665 lineto
-298.541808 55.455301 lineto
-316.230771 65.212036 lineto
-330.291229 55.205392 lineto
-356.144329 48.957965 lineto
-386.533061 41.769117 lineto
-421.457425 42.278637 lineto
-459.556730 31.679269 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.679269 lineto
-421.457425 42.278637 lineto
-386.533061 57.202311 lineto
-356.144329 78.538645 lineto
-330.291229 96.945459 lineto
-316.230771 105.991277 lineto
-298.541808 55.455301 lineto
-275.410086 53.812665 lineto
-249.556986 46.138112 lineto
-221.889633 45.465122 lineto
-191.954465 45.850276 lineto
-160.658606 35.922721 lineto
-125.280680 33.236054 lineto
-88.542064 34.512353 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.900000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 34.512353 lineto
-125.280680 33.236054 lineto
-160.658606 35.922721 lineto
-191.954465 45.850276 lineto
-221.889633 45.465122 lineto
-249.556986 46.138112 lineto
-275.410086 53.812665 lineto
-298.541808 55.455301 lineto
-316.230771 105.991277 lineto
-330.291229 96.945459 lineto
-356.144329 78.538645 lineto
-386.533061 57.202311 lineto
-421.457425 42.278637 lineto
-459.556730 31.679269 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.679269 lineto
-421.457425 42.279519 lineto
-386.533061 57.202311 lineto
-356.144329 78.538645 lineto
-330.291229 96.945459 lineto
-316.230771 125.536500 lineto
-298.541808 83.504186 lineto
-275.410086 79.552981 lineto
-249.556986 69.332298 lineto
-221.889633 65.722732 lineto
-191.954465 63.020776 lineto
-160.658606 49.723863 lineto
-125.280680 43.050415 lineto
-88.542064 40.162351 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.400000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 40.162351 lineto
-125.280680 43.050415 lineto
-160.658606 49.723863 lineto
-191.954465 63.020776 lineto
-221.889633 65.722732 lineto
-249.556986 69.332298 lineto
-275.410086 79.552981 lineto
-298.541808 83.504186 lineto
-316.230771 125.536500 lineto
-330.291229 96.945459 lineto
-356.144329 78.538645 lineto
-386.533061 57.202311 lineto
-421.457425 42.279519 lineto
-459.556730 31.679269 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.679269 lineto
-421.457425 42.353610 lineto
-386.533061 58.459793 lineto
-356.144329 79.759964 lineto
-330.291229 97.497317 lineto
-316.230771 125.675567 lineto
-298.541808 138.035176 lineto
-275.410086 128.812658 lineto
-249.556986 111.126757 lineto
-221.889633 101.413535 lineto
-191.954465 91.637396 lineto
-160.658606 70.610949 lineto
-125.280680 55.169523 lineto
-88.542064 45.801764 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-1.000000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 45.801764 lineto
-125.280680 55.169523 lineto
-160.658606 70.610949 lineto
-191.954465 91.637396 lineto
-221.889633 101.413535 lineto
-249.556986 111.126757 lineto
-275.410086 128.812658 lineto
-298.541808 138.035176 lineto
-316.230771 125.675567 lineto
-330.291229 97.497317 lineto
-356.144329 79.759964 lineto
-386.533061 58.459793 lineto
-421.457425 42.353610 lineto
-459.556730 31.679269 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 31.679269 lineto
-421.457425 42.353610 lineto
-386.533061 70.083200 lineto
-356.144329 103.293144 lineto
-330.291229 132.934977 lineto
-316.230771 172.460852 lineto
-298.541808 182.646548 lineto
-275.410086 169.982933 lineto
-249.556986 148.411390 lineto
-221.889633 133.790548 lineto
-191.954465 118.811600 lineto
-160.658606 93.317371 lineto
-125.280680 71.339506 lineto
-88.542064 55.072500 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.700000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 55.072500 lineto
-125.280680 71.339506 lineto
-160.658606 93.317371 lineto
-191.954465 118.811600 lineto
-221.889633 133.790548 lineto
-249.556986 148.411390 lineto
-275.410086 169.982933 lineto
-298.541808 182.646548 lineto
-316.230771 172.460852 lineto
-330.291229 132.934977 lineto
-356.144329 103.293144 lineto
-386.533061 70.083200 lineto
-421.457425 42.353610 lineto
-459.556730 31.679269 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 51.559663 lineto
-421.457425 63.454442 lineto
-386.533061 89.964183 lineto
-356.144329 123.181477 lineto
-330.291229 152.819782 lineto
-316.230771 341.486250 lineto
-298.541808 226.567291 lineto
-275.410086 210.440821 lineto
-249.556986 185.053905 lineto
-221.889633 166.048486 lineto
-191.954465 146.420940 lineto
-160.658606 117.332434 lineto
-125.280680 90.502222 lineto
-88.542064 65.399909 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.500000 setgray
-fill
-grestore
-stroke
-45.000000 20.000000 moveto
-45.000000 20.000000 lineto
-88.542064 65.399909 lineto
-125.280680 90.502222 lineto
-160.658606 117.332434 lineto
-191.954465 146.420940 lineto
-221.889633 166.048486 lineto
-249.556986 185.053905 lineto
-275.410086 210.440821 lineto
-298.541808 226.567291 lineto
-316.230771 341.486250 lineto
-330.291229 152.819782 lineto
-356.144329 123.181477 lineto
-386.533061 89.964183 lineto
-421.457425 63.454442 lineto
-459.556730 51.559663 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-476.338567 20.000000 lineto
-459.556730 51.559663 lineto
-421.457425 63.528532 lineto
-386.533061 140.979690 lineto
-356.144329 216.546240 lineto
-330.291229 287.298665 lineto
-316.230771 348.276126 lineto
-298.541808 382.000000 lineto
-275.410086 353.331635 lineto
-249.556986 315.505140 lineto
-221.889633 281.057412 lineto
-191.954465 246.046949 lineto
-160.658606 196.150446 lineto
-125.280680 147.445272 lineto
-88.542064 98.116209 lineto
-45.000000 20.000000 lineto
-closepath
-gsave
-0.800000 setgray
-fill
-grestore
-stroke
-84.542064 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-121.280680 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-156.658606 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-187.954465 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-217.889633 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-245.556986 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-271.410086 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-294.541808 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-312.230771 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-326.291229 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-352.144329 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-382.533061 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-417.457425 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-455.556730 20.000000 moveto
-4.000000 -4.000000 rlineto
-4.000000 4.000000 rlineto
-closepath
-gsave
-1.0 setgray
-fill
-grestore
-stroke
-showpage
-%%Trailer
-cleartomark
-countdictstack exch sub { end } repeat
-restore
-%%EOF
diff --git a/ghc/docs/storage-mgt/code.sty b/ghc/docs/storage-mgt/code.sty
deleted file mode 100644
index f5ec2f59ee..0000000000
--- a/ghc/docs/storage-mgt/code.sty
+++ /dev/null
@@ -1,83 +0,0 @@
-

-% I have enclosed code.sty, which achieves 99% of what you want without

-% the need for a separate preprocessor. At the start of your document

-% you write "\makeatactive". From then on, inline code is written as @\x

-% -> x_1 & y@. The only difference with what you are used to, is that

-% instead of

-% 

-% @

-%   foo :: Int -> Int

-%   foo = \n -> n+1

-% @

-% 

-% you have to write

-% 

-% \begin{code}

-%   foo :: Int -> Int

-%   foo = \n -> n+1

-% \end{code}

-% 

-% and that you cannot use @ in \section{} and \caption{}. For the paper that occured twice, in which case I had to replace @...@ b y \texttt{...}.

-% 

-% 

-% code.sty  --- nice verbatim mode for code

-

-\def\icode{%

-    \relax\ifmmode\hbox\else\leavevmode\null\fi

-    \bgroup

-    %\begingroup

-    \@noligs

-    \verbatim@font

-    \verb@eol@error

-    \let\do\@makeother \dospecials

-    \@vobeyspaces

-    \frenchspacing

-    \@icode}

-\def\@icode#1{%

-    \catcode`#1\active

-    \lccode`\~`#1%

-    \lowercase{\let~\icode@egroup}}

-\def\icode@egroup{%

-    %\endgroup}

-    \egroup}

-

-% The \makeatactive command:

-% makes @ active, in such a way that @...@ behaves as \icode@...@:

-{

-\catcode`@=\active

-\gdef\makeatactive{

-     \catcode`@=\active \def@{\icode@}

-     % Since @ becomes active, it has to be taken care of in verbatim-modes:

-     \let\olddospecials\dospecials \def\dospecials{\do\@\olddospecials}}

-}

-% \gdef\makeatother{\g@remfrom@specials{\@}\@makeother\@}

-\gdef\makeatother{\@makeother\@}

-

-\newcommand\codetabwidth{42pt}

-{\catcode`\^^I=\active%

-\gdef\@vobeytab{\catcode`\^^I\active\let^^I\@xobeytab}}

-\def\@xobeytab{\leavevmode\penalty10000\hskip\codetabwidth}

-

-\begingroup \catcode `|=0 \catcode `[= 1

-\catcode`]=2 \catcode `\{=12 \catcode `\}=12

-\catcode`\\=12 |gdef|@xcode#1\end{code}[#1|end[code]]

-|endgroup

-\def\@code{\trivlist \item\relax

-  \if@minipage\else\vskip\parskip\fi

-  \leftskip\@totalleftmargin\rightskip\z@skip

-  \parindent\z@\parfillskip\@flushglue\parskip\z@skip

-  \@@par

-  \@tempswafalse

-  \def\par{%

-    \if@tempswa

-      \leavevmode \null \@@par\penalty\interlinepenalty

-    \else

-      \@tempswatrue

-      \ifhmode\@@par\penalty\interlinepenalty\fi

-    \fi}%

-  \obeylines \verbatim@font \@noligs

-  \let\do\@makeother \dospecials

-  \everypar \expandafter{\the\everypar \unpenalty}%

-}

-\def\code{\@code \frenchspacing\@vobeytab\@vobeyspaces \@xcode}

-\def\endcode{\if@newlist \leavevmode\fi\endtrivlist}

diff --git a/ghc/docs/storage-mgt/freelist.eepic b/ghc/docs/storage-mgt/freelist.eepic
deleted file mode 100644
index f87d939649..0000000000
--- a/ghc/docs/storage-mgt/freelist.eepic
+++ /dev/null
@@ -1,104 +0,0 @@
-\setlength{\unitlength}{0.00050000in}
-%
-\begingroup\makeatletter\ifx\SetFigFont\undefined%
-\gdef\SetFigFont#1#2#3#4#5{%
-  \reset@font\fontsize{#1}{#2pt}%
-  \fontfamily{#3}\fontseries{#4}\fontshape{#5}%
-  \selectfont}%
-\fi\endgroup%
-{\renewcommand{\dashlinestretch}{30}
-\begin{picture}(9912,7369)(0,-10)
-\path(1125,6067)(2100,6067)
-\path(1980.000,6037.000)(2100.000,6067.000)(1980.000,6097.000)
-\path(5025,6367)(6000,6367)(6000,5167)
-	(5025,5167)(5025,6367)
-\path(4650,6367)(5025,6367)(5025,5167)
-	(4650,5167)(4650,6367)
-\path(3675,6367)(4650,6367)(4650,5167)
-	(3675,5167)(3675,6367)
-\path(6600,6367)(7575,6367)(7575,5167)
-	(6600,5167)(6600,6367)
-\path(8925,6367)(9900,6367)(9900,5167)
-	(8925,5167)(8925,6367)
-\path(7575,6367)(8550,6367)(8550,5167)
-	(7575,5167)(7575,6367)
-\path(8550,6367)(8925,6367)(8925,5167)
-	(8550,5167)(8550,6367)
-\path(2100,6367)(3675,6367)(3675,5167)
-	(2100,5167)(2100,6367)
-\path(2850,6217)(2850,6667)(6600,6667)(6600,6367)
-\path(6570.000,6487.000)(6600.000,6367.000)(6630.000,6487.000)
-\path(4425,6217)(4425,6967)(7575,6967)(7575,6367)
-\path(7545.000,6487.000)(7575.000,6367.000)(7605.000,6487.000)
-\path(5700,6217)(5700,7342)(8925,7342)(8925,6367)
-\path(8895.000,6487.000)(8925.000,6367.000)(8955.000,6487.000)
-\path(4350,5317)(4350,4792)(2100,4792)(2100,5167)
-\path(2130.000,5047.000)(2100.000,5167.000)(2070.000,5047.000)
-\path(5625,5317)(5625,4492)(2100,4492)(2100,5167)
-\path(2130.000,5047.000)(2100.000,5167.000)(2070.000,5047.000)
-\path(3000,5917)(3000,6667)
-\path(5025,2842)(6000,2842)(6000,1642)
-	(5025,1642)(5025,2842)
-\path(4650,2842)(5025,2842)(5025,1642)
-	(4650,1642)(4650,2842)
-\path(3675,2842)(4650,2842)(4650,1642)
-	(3675,1642)(3675,2842)
-\path(6600,2842)(7575,2842)(7575,1642)
-	(6600,1642)(6600,2842)
-\path(8925,2842)(9900,2842)(9900,1642)
-	(8925,1642)(8925,2842)
-\path(7575,2842)(8550,2842)(8550,1642)
-	(7575,1642)(7575,2842)
-\path(8550,2842)(8925,2842)(8925,1642)
-	(8550,1642)(8550,2842)
-\path(2100,2842)(3675,2842)(3675,1642)
-	(2100,1642)(2100,2842)
-\path(2850,2692)(2850,3142)(6600,3142)(6600,2842)
-\path(6570.000,2962.000)(6600.000,2842.000)(6630.000,2962.000)
-\path(4425,2692)(4425,3442)(7575,3442)(7575,2842)
-\path(7545.000,2962.000)(7575.000,2842.000)(7605.000,2962.000)
-\path(5700,2692)(5700,3817)(8925,3817)(8925,2842)
-\path(8895.000,2962.000)(8925.000,2842.000)(8955.000,2962.000)
-\path(4350,1792)(4350,1267)(2100,1267)(2100,1642)
-\path(2130.000,1522.000)(2100.000,1642.000)(2070.000,1522.000)
-\path(5625,1792)(5625,967)(2100,967)(2100,1642)
-\path(2130.000,1522.000)(2100.000,1642.000)(2070.000,1522.000)
-\path(3000,2392)(3000,3142)
-\path(2250,5317)(1650,5317)(1650,2542)(2100,2542)
-\path(1980.000,2512.000)(2100.000,2542.000)(1980.000,2572.000)
-\path(2250,1792)(1650,1792)(1650,142)(2325,142)
-\path(2205.000,112.000)(2325.000,142.000)(2205.000,172.000)
-\put(0,5992){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free\_list}}}}}
-\put(8625,5917){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}...}}}}}
-\put(4725,5767){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}...}}}}}
-\put(3750,5242){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(5100,5242){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(2175,6142){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(2175,5842){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(3750,6142){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(5100,6142){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(7800,6442){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}block}}}}}
-\put(6825,6442){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}block}}}}}
-\put(9150,6442){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}block}}}}}
-\put(2175,5542){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=$n_1$}}}}}
-\put(3750,5842){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free=0}}}}}
-\put(5100,5842){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free=0}}}}}
-\put(8625,2392){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}...}}}}}
-\put(4725,2242){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}...}}}}}
-\put(3750,1717){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(5100,1717){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(2175,2617){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(2175,2317){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(3750,2617){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(5100,2617){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(7800,2917){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}block}}}}}
-\put(6825,2917){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}block}}}}}
-\put(9150,2917){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}block}}}}}
-\put(3750,2317){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free=0}}}}}
-\put(5100,2317){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free=0}}}}}
-\put(2325,5242){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(2325,1717){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(2475,67){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}next block group}}}}}
-\put(2175,2017){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=$n_2$}}}}}
-\end{picture}
-}
diff --git a/ghc/docs/storage-mgt/freelist.fig b/ghc/docs/storage-mgt/freelist.fig
deleted file mode 100644
index d8debffd7c..0000000000
--- a/ghc/docs/storage-mgt/freelist.fig
+++ /dev/null
@@ -1,116 +0,0 @@
-#FIG 3.2
-Landscape
-Center
-Inches
-Letter  
-60.00
-Single
--2
-1200 2
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 5325 1725 6300 1725
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9225 1425 10200 1425 10200 2625 9225 2625 9225 1425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8850 1425 9225 1425 9225 2625 8850 2625 8850 1425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 7875 1425 8850 1425 8850 2625 7875 2625 7875 1425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 10800 1425 11775 1425 11775 2625 10800 2625 10800 1425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 13125 1425 14100 1425 14100 2625 13125 2625 13125 1425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 11775 1425 12750 1425 12750 2625 11775 2625 11775 1425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 12750 1425 13125 1425 13125 2625 12750 2625 12750 1425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6300 1425 7875 1425 7875 2625 6300 2625 6300 1425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7050 1575 7050 1125 10800 1125 10800 1425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 8625 1575 8625 825 11775 825 11775 1425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 9900 1575 9900 450 13125 450 13125 1425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 8550 2475 8550 3000 6300 3000 6300 2625
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 9825 2475 9825 3300 6300 3300 6300 2625
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 7200 1875 7200 1125
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9225 4950 10200 4950 10200 6150 9225 6150 9225 4950
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8850 4950 9225 4950 9225 6150 8850 6150 8850 4950
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 7875 4950 8850 4950 8850 6150 7875 6150 7875 4950
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 10800 4950 11775 4950 11775 6150 10800 6150 10800 4950
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 13125 4950 14100 4950 14100 6150 13125 6150 13125 4950
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 11775 4950 12750 4950 12750 6150 11775 6150 11775 4950
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 12750 4950 13125 4950 13125 6150 12750 6150 12750 4950
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6300 4950 7875 4950 7875 6150 6300 6150 6300 4950
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7050 5100 7050 4650 10800 4650 10800 4950
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 8625 5100 8625 4350 11775 4350 11775 4950
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 9900 5100 9900 3975 13125 3975 13125 4950
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 8550 6000 8550 6525 6300 6525 6300 6150
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 9825 6000 9825 6825 6300 6825 6300 6150
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 7200 5400 7200 4650
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 4
-	0 0 1.00 60.00 120.00
-	 6450 2475 5850 2475 5850 5250 6300 5250
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 4
-	0 0 1.00 60.00 120.00
-	 6450 6000 5850 6000 5850 7650 6525 7650
-4 0 0 50 0 0 17 0.0000 4 195 825 4200 1800 free_list\001
-4 0 0 50 0 0 17 0.0000 4 30 180 12825 1875 ...\001
-4 0 0 50 0 0 17 0.0000 4 30 180 8925 2025 ...\001
-4 0 0 50 0 0 17 0.0000 4 165 390 7950 2550 link\001
-4 0 0 50 0 0 17 0.0000 4 165 390 9300 2550 link\001
-4 0 0 50 0 0 17 0.0000 4 150 435 6375 1650 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6375 1950 free\001
-4 0 0 50 0 0 17 0.0000 4 150 435 7950 1650 start\001
-4 0 0 50 0 0 17 0.0000 4 150 435 9300 1650 start\001
-4 0 0 50 0 0 17 0.0000 4 165 540 12000 1350 block\001
-4 0 0 50 0 0 17 0.0000 4 165 540 11025 1350 block\001
-4 0 0 50 0 0 17 0.0000 4 165 540 13350 1350 block\001
-4 0 0 50 0 0 17 0.0000 4 195 1125 6375 2250 blocks=n_1\001
-4 0 0 50 0 0 17 0.0000 4 165 645 7950 1950 free=0\001
-4 0 0 50 0 0 17 0.0000 4 165 645 9300 1950 free=0\001
-4 0 0 50 0 0 17 0.0000 4 30 180 12825 5400 ...\001
-4 0 0 50 0 0 17 0.0000 4 30 180 8925 5550 ...\001
-4 0 0 50 0 0 17 0.0000 4 165 390 7950 6075 link\001
-4 0 0 50 0 0 17 0.0000 4 165 390 9300 6075 link\001
-4 0 0 50 0 0 17 0.0000 4 150 435 6375 5175 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6375 5475 free\001
-4 0 0 50 0 0 17 0.0000 4 150 435 7950 5175 start\001
-4 0 0 50 0 0 17 0.0000 4 150 435 9300 5175 start\001
-4 0 0 50 0 0 17 0.0000 4 165 540 12000 4875 block\001
-4 0 0 50 0 0 17 0.0000 4 165 540 11025 4875 block\001
-4 0 0 50 0 0 17 0.0000 4 165 540 13350 4875 block\001
-4 0 0 50 0 0 17 0.0000 4 165 645 7950 5475 free=0\001
-4 0 0 50 0 0 17 0.0000 4 165 645 9300 5475 free=0\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6525 2550 link\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6525 6075 link\001
-4 0 0 50 0 0 17 0.0000 4 225 1650 6675 7725 next block group\001
-4 0 0 50 0 0 17 0.0000 4 195 1125 6375 5775 blocks=n_2\001
diff --git a/ghc/docs/storage-mgt/gen.eepic b/ghc/docs/storage-mgt/gen.eepic
deleted file mode 100644
index b50d691395..0000000000
--- a/ghc/docs/storage-mgt/gen.eepic
+++ /dev/null
@@ -1,57 +0,0 @@
-\setlength{\unitlength}{0.00050000in}
-%
-\begingroup\makeatletter\ifx\SetFigFont\undefined%
-\gdef\SetFigFont#1#2#3#4#5{%
-  \reset@font\fontsize{#1}{#2pt}%
-  \fontfamily{#3}\fontseries{#4}\fontshape{#5}%
-  \selectfont}%
-\fi\endgroup%
-{\renewcommand{\dashlinestretch}{30}
-\begin{picture}(9849,5907)(0,-10)
-\path(3237,5562)(4212,5562)(4212,4062)
-	(3237,4062)(3237,5562)
-\path(4212,5562)(5187,5562)(5187,4062)
-	(4212,4062)(4212,5562)
-\path(5187,5562)(6162,5562)(6162,4062)
-	(5187,4062)(5187,5562)
-\path(6162,5562)(7137,5562)(7137,4062)
-	(6162,4062)(6162,5562)
-\put(5487,4737){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(4812,5712){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}step[]}}}}}
-\path(7812,2712)(9837,2712)(9837,2112)
-	(7812,2112)(7812,2712)
-\put(7887,2862){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}END\_MUT\_LIST}}}}}
-\path(6687,312)(7812,2412)
-\path(7781.778,2292.056)(7812.000,2412.000)(7728.889,2320.389)
-\path(6687,2412)(7812,2412)
-\path(7692.000,2382.000)(7812.000,2412.000)(7692.000,2442.000)
-\put(6012,312){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(6012,2412){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\path(4662,312)(5787,312)
-\path(5667.000,282.000)(5787.000,312.000)(5667.000,342.000)
-\path(3237,612)(5262,612)(5262,12)
-	(3237,12)(3237,612)
-\path(4662,2412)(5787,2412)
-\path(5667.000,2382.000)(5787.000,2412.000)(5667.000,2442.000)
-\path(3237,2712)(5262,2712)(5262,2112)
-	(3237,2112)(3237,2712)
-\put(3387,237){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}mut\_link}}}}}
-\put(3312,762){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}StgMutClosure}}}}}
-\put(3387,2337){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}mut\_link}}}}}
-\put(3312,2862){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}StgMutClosure}}}}}
-\path(912,3012)(2487,3012)(2487,4887)(3237,4887)
-\path(3117.000,4857.000)(3237.000,4887.000)(3117.000,4917.000)
-\path(1212,2412)(3237,2412)
-\path(3117.000,2382.000)(3237.000,2412.000)(3117.000,2442.000)
-\path(1737,2112)(2487,2112)(2487,312)(3237,312)
-\path(3117.000,282.000)(3237.000,312.000)(3117.000,342.000)
-\path(12,3462)(1887,3462)(1887,1962)
-	(12,1962)(12,3462)
-\put(87,3237){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}no}}}}}
-\put(237,3612){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}generation}}}}}
-\put(87,2937){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}steps}}}}}
-\put(87,2637){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}n\_steps}}}}}
-\put(87,2337){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}mut\_list}}}}}
-\put(87,2052){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}mut\_once\_list}}}}}
-\end{picture}
-}
diff --git a/ghc/docs/storage-mgt/gen.fig b/ghc/docs/storage-mgt/gen.fig
deleted file mode 100644
index 086a335819..0000000000
--- a/ghc/docs/storage-mgt/gen.fig
+++ /dev/null
@@ -1,71 +0,0 @@
-#FIG 3.2
-Landscape
-Center
-Inches
-Letter  
-60.00
-Single
--2
-1200 2
-6 5250 900 9150 2775
-6 5250 1275 9150 2775
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 5250 1275 6225 1275 6225 2775 5250 2775 5250 1275
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6225 1275 7200 1275 7200 2775 6225 2775 6225 1275
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 7200 1275 8175 1275 8175 2775 7200 2775 7200 1275
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8175 1275 9150 1275 9150 2775 8175 2775 8175 1275
-4 0 0 50 0 0 17 0.0000 4 30 360 7500 2100 ......\001
--6
-4 0 0 50 0 0 17 0.0000 4 225 540 6825 1125 step[]\001
--6
-6 5250 3750 11850 6825
-6 8025 3750 11850 6525
-6 9825 3750 11850 4725
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9825 4125 11850 4125 11850 4725 9825 4725 9825 4125
-4 0 0 50 0 0 17 0.0000 4 195 1815 9900 3975 END_MUT_LIST\001
--6
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 8700 6525 9825 4425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 8700 4425 9825 4425
-4 0 0 50 0 0 17 0.0000 4 30 360 8025 6525 ......\001
-4 0 0 50 0 0 17 0.0000 4 30 360 8025 4425 ......\001
--6
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 6675 6525 7800 6525
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 5250 6225 7275 6225 7275 6825 5250 6825 5250 6225
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 6675 4425 7800 4425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 5250 4125 7275 4125 7275 4725 5250 4725 5250 4125
-4 0 0 50 0 0 17 0.0000 4 195 900 5400 6600 mut_link\001
-4 0 0 50 0 0 17 0.0000 4 225 1515 5325 6075 StgMutClosure\001
-4 0 0 50 0 0 17 0.0000 4 195 900 5400 4500 mut_link\001
-4 0 0 50 0 0 17 0.0000 4 225 1515 5325 3975 StgMutClosure\001
--6
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 4
-	0 0 1.00 60.00 120.00
-	 2925 3825 4500 3825 4500 1950 5250 1950
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 3225 4425 5250 4425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 4
-	0 0 1.00 60.00 120.00
-	 3750 4725 4500 4725 4500 6525 5250 6525
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 2025 3375 3900 3375 3900 4875 2025 4875 2025 3375
-4 0 0 50 0 0 17 0.0000 4 120 240 2100 3600 no\001
-4 0 0 50 0 0 17 0.0000 4 225 1035 2250 3225 generation\001
-4 0 0 50 0 0 17 0.0000 4 210 480 2100 3900 steps\001
-4 0 0 50 0 0 17 0.0000 4 210 720 2100 4200 n_steps\001
-4 0 0 50 0 0 17 0.0000 4 195 825 2100 4500 mut_list\001
-4 0 0 50 0 0 17 0.0000 4 195 1395 2100 4785 mut_once_list\001
diff --git a/ghc/docs/storage-mgt/generation.eepic b/ghc/docs/storage-mgt/generation.eepic
deleted file mode 100644
index bea5a8c6ec..0000000000
--- a/ghc/docs/storage-mgt/generation.eepic
+++ /dev/null
@@ -1,62 +0,0 @@
-\setlength{\unitlength}{0.00050000in}
-%
-\begingroup\makeatletter\ifx\SetFigFont\undefined%
-\gdef\SetFigFont#1#2#3#4#5{%
-  \reset@font\fontsize{#1}{#2pt}%
-  \fontfamily{#3}\fontseries{#4}\fontshape{#5}%
-  \selectfont}%
-\fi\endgroup%
-{\renewcommand{\dashlinestretch}{30}
-\begin{picture}(8153,4017)(0,-10)
-\path(5025,3687)(6375,3687)
-\path(6255.000,3657.000)(6375.000,3687.000)(6255.000,3717.000)
-\path(2775,3687)(4125,3687)
-\path(4005.000,3657.000)(4125.000,3687.000)(4005.000,3717.000)
-\path(1875,3912)(2775,3912)(2775,3462)
-	(1875,3462)(1875,3912)
-\path(4125,3912)(5025,3912)(5025,3462)
-	(4125,3462)(4125,3912)
-\path(6375,3912)(7275,3912)(7275,3462)
-	(6375,3462)(6375,3912)
-\path(5025,2187)(6375,2187)
-\path(6255.000,2157.000)(6375.000,2187.000)(6255.000,2217.000)
-\path(2775,2187)(4125,2187)
-\path(4005.000,2157.000)(4125.000,2187.000)(4005.000,2217.000)
-\path(4125,2412)(5025,2412)(5025,1962)
-	(4125,1962)(4125,2412)
-\path(6375,2412)(7275,2412)(7275,1962)
-	(6375,1962)(6375,2412)
-\path(1875,2412)(2775,2412)(2775,1962)
-	(1875,1962)(1875,2412)
-\path(1875,912)(2775,912)(2775,462)
-	(1875,462)(1875,912)
-\path(7275,3687)(8025,3687)(8025,3012)
-	(2325,3012)(2325,2412)
-\path(2295.000,2532.000)(2325.000,2412.000)(2355.000,2532.000)
-\path(7275,2187)(8025,2187)(8025,1512)(5025,1512)
-\path(5145.000,1542.000)(5025.000,1512.000)(5145.000,1482.000)
-\path(4125,1512)(2325,1512)(2325,912)
-\path(2295.000,1032.000)(2325.000,912.000)(2355.000,1032.000)
-\path(2895.000,717.000)(2775.000,687.000)(2895.000,657.000)
-\path(2775,687)(3525,687)(3525,12)
-	(2325,12)(2325,462)
-\put(5550,3837){\makebox(0,0)[lb]{\smash{{{\SetFigFont{7}{8.4}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(3225,3837){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}GC}}}}}
-\put(1950,3612){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}step 0}}}}}
-\put(4200,3612){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}step 1}}}}}
-\put(6450,3612){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}step $S$}}}}}
-\put(5550,2337){\makebox(0,0)[lb]{\smash{{{\SetFigFont{7}{8.4}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(3225,2337){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}GC}}}}}
-\put(4200,2112){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}step 1}}}}}
-\put(6450,2112){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}step $S$}}}}}
-\put(1950,2112){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}step 0}}}}}
-\put(1950,612){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}step 0}}}}}
-\put(7800,3837){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}GC}}}}}
-\put(3225,837){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}GC}}}}}
-\put(4500,1512){\makebox(0,0)[lb]{\smash{{{\SetFigFont{7}{8.4}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(0,3612){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}generation 0}}}}}
-\put(0,2112){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}generation 1}}}}}
-\put(0,612){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}generation $G$}}}}}
-\put(450,1512){\makebox(0,0)[lb]{\smash{{{\SetFigFont{7}{8.4}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\end{picture}
-}
diff --git a/ghc/docs/storage-mgt/generation.fig b/ghc/docs/storage-mgt/generation.fig
deleted file mode 100644
index e91ed6d4c6..0000000000
--- a/ghc/docs/storage-mgt/generation.fig
+++ /dev/null
@@ -1,65 +0,0 @@
-#FIG 3.2
-Landscape
-Center
-Inches
-Letter  
-60.00
-Single
--2
-1200 2
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 9150 3150 10500 3150
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 6900 3150 8250 3150
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6000 2925 6900 2925 6900 3375 6000 3375 6000 2925
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8250 2925 9150 2925 9150 3375 8250 3375 8250 2925
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 10500 2925 11400 2925 11400 3375 10500 3375 10500 2925
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 9150 4650 10500 4650
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 6900 4650 8250 4650
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8250 4425 9150 4425 9150 4875 8250 4875 8250 4425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 10500 4425 11400 4425 11400 4875 10500 4875 10500 4425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6000 4425 6900 4425 6900 4875 6000 4875 6000 4425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6000 5925 6900 5925 6900 6375 6000 6375 6000 5925
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 5
-	0 0 1.00 60.00 120.00
-	 11400 3150 12150 3150 12150 3825 6450 3825 6450 4425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 4
-	0 0 1.00 60.00 120.00
-	 11400 4650 12150 4650 12150 5325 9150 5325
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 3
-	0 0 1.00 60.00 120.00
-	 8250 5325 6450 5325 6450 5925
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 0 1 5
-	0 0 1.00 60.00 120.00
-	 6900 6150 7650 6150 7650 6825 6450 6825 6450 6375
-4 0 0 50 0 0 12 0.0000 4 15 270 9675 3000 ......\001
-4 0 0 50 0 0 17 0.0000 4 165 345 7350 3000 GC\001
-4 0 0 50 0 0 17 0.0000 4 225 570 6075 3225 step 0\001
-4 0 0 50 0 0 17 0.0000 4 225 570 8325 3225 step 1\001
-4 0 0 50 0 0 17 0.0000 4 225 585 10575 3225 step S\001
-4 0 0 50 0 0 12 0.0000 4 15 270 9675 4500 ......\001
-4 0 0 50 0 0 17 0.0000 4 165 345 7350 4500 GC\001
-4 0 0 50 0 0 17 0.0000 4 225 570 8325 4725 step 1\001
-4 0 0 50 0 0 17 0.0000 4 225 585 10575 4725 step S\001
-4 0 0 50 0 0 17 0.0000 4 225 570 6075 4725 step 0\001
-4 0 0 50 0 0 17 0.0000 4 225 570 6075 6225 step 0\001
-4 0 0 50 0 0 17 0.0000 4 165 345 11925 3000 GC\001
-4 0 0 50 0 0 17 0.0000 4 165 345 7350 6000 GC\001
-4 0 0 50 0 0 12 0.0000 4 15 270 8625 5325 ......\001
-4 0 0 50 0 0 17 0.0000 4 225 1215 4125 3225 generation 0\001
-4 0 0 50 0 0 17 0.0000 4 225 1215 4125 4725 generation 1\001
-4 0 0 50 0 0 17 0.0000 4 225 1275 4125 6225 generation G\001
-4 0 0 50 0 0 12 0.0000 4 15 270 4575 5325 ......\001
diff --git a/ghc/docs/storage-mgt/largeobjectpool.eepic b/ghc/docs/storage-mgt/largeobjectpool.eepic
deleted file mode 100644
index 9c198fd279..0000000000
--- a/ghc/docs/storage-mgt/largeobjectpool.eepic
+++ /dev/null
@@ -1,70 +0,0 @@
-\setlength{\unitlength}{0.00050000in}
-%
-\begingroup\makeatletter\ifx\SetFigFont\undefined%
-\gdef\SetFigFont#1#2#3#4#5{%
-  \reset@font\fontsize{#1}{#2pt}%
-  \fontfamily{#3}\fontseries{#4}\fontshape{#5}%
-  \selectfont}%
-\fi\endgroup%
-{\renewcommand{\dashlinestretch}{30}
-\begin{picture}(10212,4689)(0,-10)
-\path(6900,4362)(10200,4362)(10200,3162)
-	(6900,3162)(6900,4362)
-\path(7020.000,3792.000)(6900.000,3762.000)(7020.000,3732.000)
-\path(6900,3762)(10050,3762)
-\path(9930.000,3732.000)(10050.000,3762.000)(9930.000,3792.000)
-\path(10050,4362)(10050,3162)
-\put(8100,4437){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks}}}}}
-\put(7875,3912){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}single object}}}}}
-\path(6900,2262)(10200,2262)(10200,1062)
-	(6900,1062)(6900,2262)
-\path(7020.000,1692.000)(6900.000,1662.000)(7020.000,1632.000)
-\path(6900,1662)(10050,1662)
-\path(9930.000,1632.000)(10050.000,1662.000)(9930.000,1692.000)
-\path(10050,2262)(10050,1062)
-\put(8100,2337){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks}}}}}
-\put(7875,1812){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}single object}}}}}
-\path(2550,4062)(3375,4062)
-\path(3255.000,4032.000)(3375.000,4062.000)(3255.000,4092.000)
-\path(3405.000,1182.000)(3525.000,1212.000)(3405.000,1242.000)
-\path(3525,1212)(2925,1212)(2925,12)(3375,12)
-\path(3255.000,-18.000)(3375.000,12.000)(3255.000,42.000)
-\path(3405.000,3282.000)(3525.000,3312.000)(3405.000,3342.000)
-\path(3525,3312)(2925,3312)(2925,2112)(3375,2112)
-\path(3255.000,2082.000)(3375.000,2112.000)(3255.000,2142.000)
-\path(3375,4362)(4950,4362)(4950,3162)
-	(3375,3162)(3375,4362)
-\path(4275,3912)(4275,4662)
-\path(4950,4362)(5400,4362)(5400,3162)
-	(4950,3162)(4950,4362)
-\path(5400,4362)(5850,4362)(5850,3162)
-	(5400,3162)(5400,4362)
-\path(5850,4362)(6300,4362)(6300,3162)
-	(5850,3162)(5850,4362)
-\path(3375,2262)(4950,2262)(4950,1062)
-	(3375,1062)(3375,2262)
-\path(4125,2112)(4125,2562)(6900,2562)(6900,2262)
-\path(6870.000,2382.000)(6900.000,2262.000)(6930.000,2382.000)
-\path(4275,1812)(4275,2562)
-\path(4950,2262)(5400,2262)(5400,1062)
-	(4950,1062)(4950,2262)
-\path(5400,2262)(5850,2262)(5850,1062)
-	(5400,1062)(5400,2262)
-\path(5850,2262)(6300,2262)(6300,1062)
-	(5850,1062)(5850,2262)
-\path(4125,4212)(4125,4662)(6900,4662)(6900,4362)
-\path(6870.000,4482.000)(6900.000,4362.000)(6930.000,4482.000)
-\put(3600,12){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(3450,4137){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(3450,3837){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(3450,3537){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=$n_1$}}}}}
-\put(3600,3237){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(5550,3762){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}...}}}}}
-\put(3450,2037){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(3450,1737){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(3600,1137){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(5550,1662){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}...}}}}}
-\put(3450,1437){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=$n_2$}}}}}
-\put(0,3987){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}g0s0-$>$large\_objects}}}}}
-\end{picture}
-}
diff --git a/ghc/docs/storage-mgt/largeobjectpool.fig b/ghc/docs/storage-mgt/largeobjectpool.fig
deleted file mode 100644
index 6c49ff03f1..0000000000
--- a/ghc/docs/storage-mgt/largeobjectpool.fig
+++ /dev/null
@@ -1,82 +0,0 @@
-#FIG 3.2
-Landscape
-Center
-Inches
-Letter  
-60.00
-Single
--2
-1200 2
-6 9825 1125 13125 2625
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9825 1425 13125 1425 13125 2625 9825 2625 9825 1425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 9825 2025 12975 2025
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 12975 1425 12975 2625
-4 0 0 50 0 0 17 0.0000 4 165 630 11025 1350 blocks\001
-4 0 0 50 0 0 17 0.0000 4 225 1230 10800 1875 single object\001
--6
-6 9825 3225 13125 4725
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9825 3525 13125 3525 13125 4725 9825 4725 9825 3525
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 9825 4125 12975 4125
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 12975 3525 12975 4725
-4 0 0 50 0 0 17 0.0000 4 165 630 11025 3450 blocks\001
-4 0 0 50 0 0 17 0.0000 4 225 1230 10800 3975 single object\001
--6
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 5475 1725 6300 1725
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 4
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 6450 4575 5850 4575 5850 5775 6300 5775
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 4
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 6450 2475 5850 2475 5850 3675 6300 3675
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6300 1425 7875 1425 7875 2625 6300 2625 6300 1425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 7200 1875 7200 1125
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 7875 1425 8325 1425 8325 2625 7875 2625 7875 1425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8325 1425 8775 1425 8775 2625 8325 2625 8325 1425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8775 1425 9225 1425 9225 2625 8775 2625 8775 1425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6300 3525 7875 3525 7875 4725 6300 4725 6300 3525
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7050 3675 7050 3225 9825 3225 9825 3525
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 7200 3975 7200 3225
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 7875 3525 8325 3525 8325 4725 7875 4725 7875 3525
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8325 3525 8775 3525 8775 4725 8325 4725 8325 3525
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8775 3525 9225 3525 9225 4725 8775 4725 8775 3525
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7050 1575 7050 1125 9825 1125 9825 1425
-4 0 0 50 0 0 17 0.0000 4 30 360 6525 5775 ......\001
-4 0 0 50 0 0 17 0.0000 4 150 435 6375 1650 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6375 1950 free\001
-4 0 0 50 0 0 17 0.0000 4 195 1125 6375 2250 blocks=n_1\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6525 2550 link\001
-4 0 0 50 0 0 17 0.0000 4 30 180 8475 2025 ...\001
-4 0 0 50 0 0 17 0.0000 4 150 435 6375 3750 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6375 4050 free\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6525 4650 link\001
-4 0 0 50 0 0 17 0.0000 4 30 180 8475 4125 ...\001
-4 0 0 50 0 0 17 0.0000 4 195 1125 6375 4350 blocks=n_2\001
-4 0 0 50 0 0 17 0.0000 4 225 2010 2925 1800 g0s0->large_objects\001
diff --git a/ghc/docs/storage-mgt/ldv.eepic b/ghc/docs/storage-mgt/ldv.eepic
deleted file mode 100644
index aa41327aa5..0000000000
--- a/ghc/docs/storage-mgt/ldv.eepic
+++ /dev/null
@@ -1,41 +0,0 @@
-\setlength{\unitlength}{0.00050000in}
-%
-\begingroup\makeatletter\ifx\SetFigFont\undefined%
-\gdef\SetFigFont#1#2#3#4#5{%
-  \reset@font\fontsize{#1}{#2pt}%
-  \fontfamily{#3}\fontseries{#4}\fontshape{#5}%
-  \selectfont}%
-\fi\endgroup%
-{\renewcommand{\dashlinestretch}{30}
-\begin{picture}(6036,3169)(0,-10)
-\path(1692,3142)(1692,2692)(3342,2692)
-\path(1692,2317)(1692,2692)
-\path(1722.000,2572.000)(1692.000,2692.000)(1662.000,2572.000)
-\path(4992,2317)(4992,2692)
-\path(5022.000,2572.000)(4992.000,2692.000)(4962.000,2572.000)
-\path(4992,2692)(4992,3142)
-\path(3342,3142)(3342,2692)(4992,2692)
-\path(3342,2317)(3342,2692)
-\path(3372.000,2572.000)(3342.000,2692.000)(3312.000,2572.000)
-\path(42,3142)(42,2692)(1692,2692)
-\path(42,2317)(42,2692)
-\path(72.000,2572.000)(42.000,2692.000)(12.000,2572.000)
-\put(1992,2767){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}use}}}}}
-\put(342,2767){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}lag}}}}}
-\put(117,2092){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}created}}}}}
-\put(3642,2767){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}drag}}}}}
-\put(1767,2092){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}first used}}}}}
-\put(3417,2092){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}last used}}}}}
-\put(5067,2092){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}destroyed}}}}}
-\path(4992,292)(4992,667)
-\path(5022.000,547.000)(4992.000,667.000)(4962.000,547.000)
-\path(4992,667)(4992,1117)
-\path(1692,667)(3342,667)(4992,667)
-\path(42,1117)(42,667)(1692,667)
-\path(42,292)(42,667)
-\path(72.000,547.000)(42.000,667.000)(12.000,547.000)
-\put(117,67){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}created}}}}}
-\put(5067,67){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}destroyed}}}}}
-\put(1992,742){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}void}}}}}
-\end{picture}
-}
diff --git a/ghc/docs/storage-mgt/ldv.fig b/ghc/docs/storage-mgt/ldv.fig
deleted file mode 100644
index 772411c289..0000000000
--- a/ghc/docs/storage-mgt/ldv.fig
+++ /dev/null
@@ -1,53 +0,0 @@
-#FIG 3.2
-Landscape
-Center
-Inches
-Letter  
-60.00
-Single
--2
-1200 2
-6 3600 3375 9675 4500
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 3
-	 5325 3375 5325 3825 6975 3825
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 5325 4200 5325 3825
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 8625 4200 8625 3825
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 0 0 2
-	 8625 3825 8625 3375
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 3
-	 6975 3375 6975 3825 8625 3825
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 6975 4200 6975 3825
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 3
-	 3675 3375 3675 3825 5325 3825
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 3675 4200 3675 3825
-4 0 0 50 0 0 17 0.0000 4 120 315 5625 3750 use\001
-4 0 0 50 0 0 17 0.0000 4 225 300 3975 3750 lag\001
-4 0 0 50 0 0 17 0.0000 4 165 705 3750 4425 created\001
-4 0 0 50 0 0 17 0.0000 4 225 435 7275 3750 drag\001
-4 0 0 50 0 0 17 0.0000 4 165 915 5400 4425 first used\001
-4 0 0 50 0 0 17 0.0000 4 165 840 7050 4425 last used\001
-4 0 0 50 0 0 17 0.0000 4 225 945 8700 4425 destroyed\001
--6
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 8625 6225 8625 5850
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 0 0 2
-	 8625 5850 8625 5400
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 3
-	 5325 5850 6975 5850 8625 5850
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 3
-	 3675 5400 3675 5850 5325 5850
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 3675 6225 3675 5850
-4 0 0 50 0 0 17 0.0000 4 165 705 3750 6450 created\001
-4 0 0 50 0 0 17 0.0000 4 225 945 8700 6450 destroyed\001
-4 0 0 50 0 0 17 0.0000 4 165 435 5625 5775 void\001
diff --git a/ghc/docs/storage-mgt/ldv.tex b/ghc/docs/storage-mgt/ldv.tex
deleted file mode 100644
index 936407c701..0000000000
--- a/ghc/docs/storage-mgt/ldv.tex
+++ /dev/null
@@ -1,695 +0,0 @@
-\documentclass{article}
-\usepackage{code,a4wide}
-
-\usepackage{graphics,epsfig,epic,eepic,epsfig}
-
-\setlength{\parskip}{0.25cm}
-\setlength{\parsep}{0.25cm}
-\setlength{\topsep}{0cm}
-\setlength{\parindent}{0cm}
-\renewcommand{\textfraction}{0.2}
-\renewcommand{\floatpagefraction}{0.7}
-
-
-% Terminology
-\newcommand{\block}{block}
-\newcommand{\Block}{Block}
-\newcommand{\segment}{segment}
-\newcommand{\Segment}{Segment}
-\newcommand{\step}{step}
-\newcommand{\Step}{Step}
-
-\newcommand{\note}[1]{{\em $\spadesuit$ #1}}
-
-\begin{document}
-\title{Implementation of Lag/Drag/Void/Use Profiling}
-\author{Sungwoo Park \\ Simon Marlow}
-
-\makeatactive
-\maketitle
-
-\section{Lag/Drag/Void/Use Profiling}
-
-\emph{Lag/Drag/Void/Use} (LDVU) profiling~\cite{RR} is a profiling technique 
-which yields a summary of the biography of all the dynamic closures created
-during program execution.
-In this profiling scheme,
-the biography of a closure is determined by four important events associated
-with the closure: \emph{creation}, \emph{first use}, 
-\emph{last use}, and \emph{destruction} (see Figure~\ref{fig-ldv}).
-The intervals between these successive events correspond to three phases
-for the closure: \emph{lag} (between creation and first use), 
-\emph{use} (between first use and last use), and 
-\emph{drag} (between last use and destruction).
-If the closure is never used, it is considered to remain in the \emph{void}
-phase all its lifetime.
-
-\begin{figure}[ht]
-\begin{center}
-\input{ldv.eepic}
-\caption{The biography of a closure}
-\label{fig-ldv}
-\end{center}
-\end{figure}
-
-The LDVU profiler regularly performs heap censuses during program execution.
-Each time a heap census is performed, the LDVU profiler increments a global
-time, which is used for timing all the events (such as creation and destruction
-of a closure) occurring during program execution.
-Hence, for instance, all closures creating between two successive heap censuses
-have the same creation time and belong to the same \emph{generation}.\footnote{In
-this document, a generation is related with heap censuses, not garbage collections
-as in other profiling schemes.}
-After the program terminates, it yields a post-mortem report on how much 
-of the \emph{live} graph is in one of the four phases at the moment of each 
-heap census.
-
-It must be emphasized that the LDVU profiler considers only live closures;
-it should not take into consideration dead closures which do not constitute
-the graph. Therefore, the result of LDVU profiling does not depend on the
-frequency of garbage collections.
-
-This document describes the implementation of LDVU profiling on the Glasgow
-Haskell Compiler runtime system.\footnote{Unless otherwise noted, all identifiers
-are defined in @LdvProfile.c@}.
-
-\section{An Overview of the Implementation}
-
-Every closure is augmented with an additional word in its profiling header
-to accommodate three additional pieces of information: 
-1) state flag indicating whether the closure has been used at least once or not.
-2) creation time; 3) time of most recent use if any so far.
-We refer to such a word as an LDV word.
-
-The LDVU profiler maintains a global time, stored in @ldvTime@.
-It is incremented each time a heap census is performed.
-During a heap census, the profiler scans all live closures and computes the 
-following: 
-1) the total size of all closures which have never been used; 
-2) the total size of all closures which have been used at least once 
-in the past.\footnote{There is another category of closures, namely, 
-\emph{inherently used} closures. We will explain 
-in Section~\ref{sec-heap-censuses}.}
-It is not until the whole program execution finishes that the profiler 
-can actually decide the total size corresponding to each of the four phases for
-a particular heap census. It is only when a closure is destroyed that the profiler
-can determine how long the closure has been in a specific phase. 
-Therefore, it is not sufficient to perform heap censuses periodically in order to
-compute the profiling statistics: the runtime system needs to intercept
-all events associated with any closures and update necessary information.
-
-All events associated with closures are handled by one of the three 
-macros defined
-in @includes/StgLdv.h@: @LDV_recordCreate()@, @LDV_recordUse()@, and 
-@LDV_recordDead()@.
-
-\begin{itemize}
-\item{@LDV_recordCreate()@} is called when a closure is created and updates its 
-creation time field.
-
-\item{@LDV_recordUse()@} is called when a closure is used and updates its most recent
-use time field.
-
-\item{@LDV_recordDead()@} is called when a closure @c@ is removed from the graph.
-It does not update its LDV word (because @c@ is about to be destroyed).
-Instead, it updates the statistics on LDVU profiling according to the following
-observation:
-if @c@ has never been used (which is indicated by the state flag in its LDV 
-word), 
-@c@ contributes to the void phase from its creation time to the last census
-time; if @c@ was used at least once (which is also indicated by the state flag),
-@c@ contributes to the @drag@ phase after its last use time. 
-\end{itemize}
-
-At the end of the program execution, the profiler performs a last census during
-which all closures in the heap are declared to be dead and @LDV_recordDead()@
-is invoked on each of them. 
-Then, the profiler computes the final statistics. 
-
-\section{LDV Words}
-
-We choose to share the LDV word for both retainer profiling and LDVU 
-profiling, which cannot take place simultaneously. 
-This is the reason why there is a
-union structure inside the @StgProHeader@ structure.
-The field @hp.ldvw@ in the @StgProfHeader@ structure corresponds to the LDV 
-word:
-\begin{code}
-typedef struct {
-  ...
-  union {
-    retainerSet *rs;          // Retainer Set
-    StgWord ldvw;             // Lag/Drag/Void Word
-  } hp;
-} StgProfHeader;
-\end{code}
-For instance, the LDV word of a closure @c@ can now be accessed with 
-@c->header.prof.hp.ldvw@ (or by @LDVW(c)@ where @LDVW()@ is a macro in 
-@includes/StgLdvProf.h@).
-
-An LDV word is divided into three fields, whose position is specified
-by three constants in @includes/StgLdvProf.h@:
-\begin{itemize}
-\item{@LDV_STATE_MASK@} corresponds to the state flag. 
-\item{@LDV_CREATE_MASK@} corresponds to the creation time.
-\item{@LDV_LAST_MASK@} corresponds to the most recent use time.
-\end{itemize}
-The constant @LDV_SHIFT@ specifies how many bits are allocated for 
-creation time or most recent use time.
-For instance, the creation time of a closure @c@ can be obtained by
-@(LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT@.
-
-The creation time field and the most recent use time field can be set only by the 
-macros @LDV_recordCreate()@ and @LDV_recordUse()@. 
-@LDV_recordCreate()@ must be called whenever a new dynamic closure is created,
-and this is handily accomplished by rewriting the macro @SET_PROF_HDR()@ 
-(in @includes/ClosureMacros.h@) (we do not need to change @SET_STATIC_PROF_HDR()@
-because static closures are not involved in LDVU profiling at all):
-
-\begin{code}
-#define SET_PROF_HDR(c,ccs_)            \
-        ((c)->header.prof.ccs = ccs_,   \
-        LDV_recordCreate((c)))
-\end{code}
-
-There are a few cases in which the info table of a closure changes through
-an explicit invocation of @SET_INFO()@ or a direct assignment to its @header.info@
-field: 1) an indirection closure is replaced by an old-generation 
-indirection closure; 2) a thunk is replaced by a blackhole; 3) a thunk is replaced 
-by an indirection closure when its evaluation result becomes available.
-
-\emph{We regard such a situation as
-the destruction of an old closure followed by the creation of a new closure
-at the same memory address.}\footnote{This would be unnecessary if the two closures
-are of the same size, but it is not always the case. We choose to distinguish
-the two closures for the sake of consistency.}
-For instance, when an @IND_PERM@ closure is replaced by an @IND_OLDGEN_PERM@
-closures (during scavenging in @GC.c@), we wrap the invocation of @SET_INFO()@ with 
-the invocations of @LDV_recordDead()@ and @LDV_recordCreate()@ as follows 
-(@LDV_recordDead()@ requires the actual size of the closures being destroyed):
-
-\begin{code}
-  LDV_recordDead((StgClosure *)p, sizeofW(StgInd) - sizeofW(StgProfHeader));
-  SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
-  LDV_recordCreate((StgClosure *)p);
-\end{code}
-
-\textbf{To do:}
-A direct assignment to the @header.info@ field implies that its cost centre 
-field is not initialized. This is no problem in the case of @EVACUATED@ closures 
-because they will 
-not be used again after a garbage collection. However, I am not sure if this is safe
-for @BLACKHOLE_BQ@ closures (in @StgMiscClosures.hc@) when retainer profiling, 
-which employs cost centre stacks, is going on. 
-If it is safe, please leave a comment there.
-
-@LDV_recordUse()@ is called on a closure whenever it is used, or \emph{entered}.
-Its state flag changes if necessary to indicate that it has been used, and
-the current global time is stored in its last use time field. 
-
-\section{Global Time \texttt{ldvTime} and Retainer Profiling}
-
-The global time, stored in @ldvTime@, records the current time period.
-It is initialized to $1$ and incremented after each time a heap census
-is completed through an invocation of @LdvCensus()@.  Note that each
-value of @ldvTime@ represents a time \emph{period}, not a point in
-time.
-
-All closures created between two successive invocations of
-@LdvCensus()@ have the same creation time.  If a closure is used at
-least once between two successive heap censuses, we consider the
-closure to be in the use phase during the corresponding time period
-(because we just set its last use time field to the current value of
-@ldvTime@ whenever it is used).  Notice that a closure with a creation
-time $t_c$ may be destroyed before the actual heap census for time
-$t_c$ and thus may \emph{not} be observed during the heap census for
-time $t_c$.  Such a closure does not show up in the profile at all.
-
-In addition, the value of @ldvTime@ indicates which of LDVU profiling
-and retainer profiling is currently active: during LDVU profiling, it
-is initialized to $1$ in @initLdvProfiling()@ and then increments as
-LDVU profiling proceeds; during retainer profiling, however, it is
-always fixed to $0$.  Thus, wherever a piece of code shared by both
-retainer profiling and LDVU profiling comes to play, we usually need
-to first examine the value of @ldvTime@ if necessary. For instance,
-consider the macro @LDV_recordUse()@:
-
-\begin{code}
-#define LDV_recordUse(c)                              \
-  if (ldvTime > 0)                                    \
-    LDVW((c)) = (LDVW((c)) & LDV_CREATE_MASK) | ldvTime | LDV_STATE_USE; 
-\end{code}
-
-If retainer profiling is being performed, @ldvTime@ is equal to $0$,
-and @LDV_recordUse()@ causes no side effect.\footnote{Due to this
-interference with LDVU profiling, retainer profiling slows down a bit;
-for instance, checking @ldvTime@ against $0$ in the above example
-would always evaluate to @rtsFalse@ during retainer profiling.
-However, this is the price to be paid for our decision not to employ a
-separate field for LDVU profiling.}
-
-As another example, consider @LDV_recordCreate()@:
-
-\begin{code}
-#define LDV_recordCreate(c)   \
-  LDVW((c)) = (ldvTime << LDV_SHIFT) | LDV_STATE_CREATE
-\end{code}
-
-The above definition of @LDV_recordCreate()@ works without any problem
-even for retainer profiling: during retainer profiling, 
-a retainer set field (@hp.ldvw@) must be initialized to a null pointer.
-Since @ldvTime@ is fixed to $0$, @LDV_recordCreate()@ initializes 
-retainer set fields correctly.
-
-\section{Heap Censuses}
-\label{sec-heap-censuses}
-
-The LDVU profiler performs heap censuses periodically by invoking the
-function @LdvCensus()@.  Because we need to know exactly which
-closures in the heap are live at census time, we always precede the
-census with a major garbage collection.
-
-During a census, we examine each closure one by one and compute the
-following three quantities:
-
-\begin{enumerate}
-\item the total size of all \emph{inherently used} closures.
-\item the total size of all closures which have not been used (yet).
-\item the total size of all closures which have been used at least once. 
-\end{enumerate}
-
-For most closures, a \emph{use} consists of entering the closure.  For
-unlifted objects which are never entered (eg. @ARR_WORDS@), it would
-be difficult to determine their points of use because such points are
-scattered around the implementation in various primitive operations.
-For this reason we consider all unlifted objects as ``inherently
-used''.  The following types of closures are considered to be
-inherently used: @TSO@, @MVAR@, @MUT_ARR_PTRS@, @MUT_ARR_PTRS_FROZEN@,
-@ARR_WORDS@, @WEAK@, @MUT_VAR@, @MUT_CONS@, @FOREIGN@, @BCO@, and
-@STABLE_NAME@.
-
-The three quantities are stored in an @LdvGenInfo@ array @gi[]@.
-@gi[]@ is indexed by time period.  For instance, @gi[ldvTime]@ stores
-the three quantaties for the current global time period.  The
-structure @LdvGenInfo@ is defined as follows:
-
-\begin{code}
-typedef struct {
-  ...
-  int inherentlyUsed;   // total size of 'inherently used' closures
-  int notUsed;          // total size of 'not used yet' closures
-  int used;             // total size of 'used at least once' closures
-  ...
-} LdvGenInfo;
-\end{code} 
-
-The above three quantities account for mutually exclusive sets of closures.
-In other words, if a closure is not inherently used, it belongs to 
-either the second or the third.
-
-\subsection{Taking a Census of the Live Heap}
-
-During a heap census, we need to visit every live closure once, so we
-perform a linear scan of the live heap after a major GC.  We can take
-advantage of the following facts to implement a linear scan for heap
-censuses:
-
-\begin{itemize}
-\item The nursery is empty. The small object pool and the large object pool, 
-      however, may \emph{not} be empty. This is because the garbage collector
-      invokes @scheduleFinalizer()@ after removing dead closures, and
-      @scheduleFinalizer()@ may create new closures through @allocate()@.
-\item @IND@, @IND_OLDGEN@, and @EVACUATED@ closures do not appear in
-the live heap.
-\end{itemize}
-
-There is one small complication when traversing the live heap: the
-garbage collector may have replaced @WEAK@ objects with @DEAD_WEAK@
-objects, which have a smaller size and hence leave some space before
-the next object.  To avoid this problem we change the size of
-@DEAD_WEAK@ objects to match that of @WEAK@ objects when profiling is
-enabled (see @StgMiscClosures.hc@).
-
-\section{Destruction of Closures}
-
-In order to compute the total size of closures for each of the four
-phases, we must report the destruction of every closure (except
-inherently used closures) to the LDVU profiler by invoking
-@LDV_recordDead()@.  @LDV_recordDead()@ must not be called on any
-inherently used closure because any invocation of @LDV_recordDead()@
-affects the statistics regarding void and drag phases, which no
-inherently used closure can be in.
-
-@LDV_recordDead()@ updates two fields @voidNew@ and @dragNew@ in the
-@LdvGenInfo@ array @gi[]@:
-
-\begin{code}
-typedef struct {
-  ...
-  int voidNew; 
-  int dragnew;
-  ...
-} LdvGenInfo;
-\end{code} 
-
-@gi[ldvTime].voidNew@ accumulates the size of all closures satisfying
-the following two conditions: 1) observed during the heap census at
-time @ldvTime@; 2) now known to have been in the void phase at time
-@ldvTime@.  It is updated when a closure which has never been used is
-destroyed.  Suppose that a closure @c@ which has never been used is
-about to be destroyed.  If its creation time is $t_c$, we judge that
-@c@ has been in the void phase all its lifetime, namely, from time
-$t_c$ to @ldvTime@.  Since @c@ will not be observed during the next
-heap census, which corresponds to time @ldvTime@, @c@ contributes to
-the void phase of times $t_c$ through @ldvTime@ - 1.  Therefore, we
-increase the @voidNew@ field of @gi[@$t_c$@]@ through @gi[ldvTime - 1]@
- by the size of @c@.\footnote{In the actual implementation, we
-update @gi[$t_c$]@ and @gi[ldvTime]@ (not @gi[ldvTime@$ - $1@]@) only:
-@gi[$t_c$]@ and @gi[ldvTime]@ are increased and decreased by the size
-of @c@, respectively.  After finishing the program execution, we can
-correctly adjust all the fields as follows: @gi[$t_c$]@ is computed as
-$\sum_{i=0}^{t_c}$@gi[$i$]@.  }
-
-@gi[ldvTime].dragNew@ accumulates the size of all closures satisfying the following
-two conditions: 1) observed during the heap census at time @ldvTime@;
-2) now known to have been in the drag phase at time @ldvTime@.
-It is updated when a closure which has been used at least once is destroyed.
-Suppose that a closure @c@ which has been used last at time $t_l$ is about to
-be destroyed.
-We judge that @c@ has been in the drag phase from time $t_l + 1$ to 
-time @ldvTime@$ - 1$ (if $t_l + 1 > $@ldvTime@$ - 1$, nothing happens).
-Therefore, we increase the @dragNew@ field of @gi[@$t_l + 1$@]@ through 
-@gi[ldvTime@$ - 1$@]@
-by the size of @c@.\footnote{As in the case of @voidNew@, we update
-@gi[@$t_l + 1$@]@ and @gi[ldvTime]@ only.}
-
-Now we need to find out all the cases of closure destruction.
-There are four cases in which a closure is destroyed:
-
-\begin{enumerate}
-\item A closure is overwritten with a blackhole: 
-  @UPD_BH_UPDATABLE()@ and @UPD_BH_SINGLE_ENTRY()@ in @includes/StgMacros.h@,
-  @threadLazyBlackHole()@ and @threadSqueezeStack()@ in @GC.c@,
-  the entry code for @BLACKHOLE@ closures in @StgMiscClosures.hc@ (a 
-  @BLACKHOLE@ closure is changed into a @BLACKHOLE_BQ@ closure).
-  We call either @LDV_recordDead()@ or @LDV_recordDead_FILL_SLOP_DYNAMIC()@.
-
-\item A weak pointer is overwritten with a dead weak pointer:
-  @finalizzeWeakzh_fast()@ in @PrimOps.hc@, 
-  @finalizeWeakPointersNow()@ and @scheduleFinalizers()@ in @Weak.c@.
-  Since a weak pointer is inherently used, we do not call @LDV_recordDead()@.
-
-\item A closure is overwritten with an indirection closure:
-  @updateWithIndirection()@ and @updateWithPermIndirection()@ in @Storage.h@,
-  @scavenge()@ in @GC.c@, in which an @IND_PERM@ closure is explicitly replaced
-  with an @IND_OLDGEN_PERM@ closure during scavenging.
-  We call either @LDV_recordDead()@ or @LDV_recordDead_FILL_SLOP_DYNAMIC()@.
-  
-\item Closures are removed permanently from the graph during garbage
-collections.  We locate and dispose of all dead closures by linearly
-scanning the from-space right before tidying up.  This is feasible
-because any closures which is about to be removed from the graph still
-remains in the from-space until tidying up is completed.  The next
-subsection explains how to implement this idea.
-\end{enumerate}
-
-\subsection{Linear scan of the from-space during garbage collections}
-
-In order to implement linear scan of the from-space during a garbage collection 
-(before tidying up),
-we need to take into consideration the following facts:
-
-\begin{itemize}
-\item The pointer @free@ of a block in the nursery may incorrectly point to
-a byte past its actual boundary.
-This happens because 
-the Haskell mutator first increases @hpLim@ without comparing it with the
-actual boundary when allocating fresh memory for a new closure.
-@hpLim@ is later assigned to the pointer @free@ of the corresponding memory
-block, which means that during a heap census, the pointer @hpLim@ may not
-be trusted. 
-Notice that @hpLim@ is not available during LDVU profiling; it is valid
-only during the Haskell mutator time.
-
-\item The from-space may well contain a good number of @EVACUATED@ closures,
-and they must be skipped over.
-
-\item The from-space includes the nursery. 
-Furthermore, a closure in the nursery may not necessarily be adjacent to the next 
-closure because slop words may lie between the two closures;
-the Haskell mutator may allocate more space than actually needed in the
-nursery when creating a closure, potentially leaving slop words. 
-\end{itemize}
-
-The first problem is easily solved by limiting the scan up to the
-actual block boundary for each nursery block (see
-@processNurseryForDead()@).  In other words, for a nursery block
-descriptor @bd@, whichever of @bd->start@$ + $@BLOCK_SIZE_W@ and
-@bd->free@ is smaller is used as the actual boundary.
-
-We solve the second problem by exploiting LDV words of @EVACUATED@
-closures: we store the size of an evacuated closure, which now resides
-in the to-space, in the LDV word of the new @EVACUATED@ closure
-occupying its memory.  This is easily implemented by inserting a call
-to the macro @SET_EVACUAEE_FOR_LDV()@ in @copy()@ and @copyPart()@ (in
-@GC.c@).  Thus, when we encounter an @EVACUATED@ closure while
-linearly scanning the nursery, we can skip a correct number of words
-by referring to its LDV word.
-
-The third problem could be partially solved by always monitoring @Hp@
-during the Haskell mutator time: whenever @Hp@ is increased, we fill
-with zeroes as many words as the change of @HP@. Then, we could skip
-any trailing zero words when linearly scanning the nursery.
-Alternatively we could initialize the entire nursery with zeroes after
-each garbage collection and not worry about any change made to @Hp@
-during the Haskell mutator time.  The number of zero words to be
-written to the nursery could be reduced in the first approach, for we
-do not have to fill the header for a new closure.  Nevertheless we
-choose to employ the second approach because it simplifies the
-implementation code significantly (see @resetNurseries()@ in
-@Storage.c@).  Moreover, the second approach compensates for its
-redundant initialization cost by providing faster execution (due to a
-single memory write loop in contrast to frequent memory write loops in
-the first approach).  Also, we attribute the initialization cost to
-the runtime system and thus the Haskell mutator behavior is little
-affected.
-
-There is further complication though: occasionally a closure is
-overwritten with a closure of a smaller size, leaving some slop
-between itself and the next closure in the heap.  There are two cases:
-
-\begin{enumerate}
-\item A closure is overwritten with a blackhole. 
-\item A closure is overwritten with an indirection closure.
-\end{enumerate}
-
-In either case, an existing closure is destroyed after being replaced
-with a new closure.  If the two closures are of the same size, no slop
-words are introduced and we only need to invoke @LDV_recordDead()@ on
-the existing closure, which cannot be an inherently used closure.  If
-not, that is, the new closure is smaller than the existing closure
-(the opposite cannot happen), we need to fill one or more slop words
-with zeroes as well as invoke @LDV_recordDead()@ on the existing
-closure.  The macro @LDV_recordDead_FILL_SLOP_DYNAMIC()@ accomplishes
-these two tasks: it determines the size of the existing closure,
-invokes @LDV_recordDead()@, and fills the slop words with zeroes.
-After excluding all cases in which the two closures are of the same
-size, we invoke @LDV_recordDead_FILL_SLOP_DYNAMIC()@ only from:
-
-\begin{enumerate}
-\item @threadLazyBlackHole()@ and @threadSqueezeStack()@ in @GC.c@
-(for lazy blackholing),
-\item @UPD_BH_UPDATABLE()@ and @UPD_BH_SINGLE_ENTRY()@ in
-@includes/StgMacros.h@ (for eager blackholing, which isn't the
-default),
-\item @updateWithIndirection()@ and @updateWithPermIndirection()@ 
-in @Storage.h@.\footnote{Actually slop words created in 
-@updateWithIndirection()@ cannot survive major garbage collections.
-Still we invoke @LDV\_recordDead\_FILL\_SLOP\_DYNAMIC()@ to support linear
-scan of the heap during a garbage collection, which is discussed in the next
-section.}
-\end{enumerate}
-
-The linear scan of the from-space is initiated by the garbage
-collector.  From the function @LdvCensusForDead()@, every dead closure
-in the from-space is visited through an invocation of
-@processHeapClosureForDead()@.
-
-\subsection{Final scan of the heap}
-
-Since a closure surviving the final garbage collection is implicitly destroyed
-when the runtime system shuts down, we must invoke @processHeapClosureForDead@
-on \emph{every} closure in the heap once more after the final garbage collection.
-The function @LdvCensusKillAll()@, which is invoked from @shutdownHaskell()@
-in @RtsStartup.c@, traverses the entire heap and visits each closure.
-It also stops LDVU profiling by resetting @ldvTime@ to $0$. 
-
-It may be that after LDVU profiling stops, new closures may be created
-and even garbage collections may be performed.
-We choose to ignore these closures because they are all concerned about
-finalizing weak pointers (in @finalizeWeakPointersNow()@).
-It can be catastrophic to invoke @LdvCensusKillAll()@ after finishing
-@finalizeWeakPointersNow()@: @finalizeWeakPointersNow()@ calls
-@rts_evalIO()@, which is essentially initiating a new program execution,
-and no assumptions made upon LDVU profiling hold any longer. 
-
-\section{Time of Use}
-
-In order to yield correct LDVU profiling results, we must make sure
-that @LDV_recordUse()@ be called on a closure whenever it is used;
-otherwise, most of closures would be reported to be in the void phase.
-@includes/StgLdvProf.h@ provides an entry macro @LDV_ENTER@ which
-expands to @LDV_recordUse()@.  The compiler arranges to invoke
-@LDV_ENTER@ in the entry code for every dynamic closure it generates
-code for (constructors, thunks and functions).  We also have to add
-@LDV_ENTER@ calls to the closures statically compiled into the RTS:
-@PAP@s, @AP_UPD@s, standard thunk forms (in @StgStdThunks.hc@, and
-several others in @StgMiscClosures.hc@.
-
-\section{Computing Final Statistics}
-
-After the final scan of the heap, we can accurately determine the total
-size of closures in one of the four phases at the moment of each heap census.
-The structure @LdvGenInfo@ is augmented with two additional fields 
-@voidTotal@ and @dragTotal@:
-
-\begin{code}
-typedef struct {
-  ...
-  int voidTotal;
-  int dragTotal;
-  ...
-} LdvGenInfo;
-\end{code} 
-
-@gi[@$i$@].voidTotal@ and @gi[@$i$@].dragTotal@ are computed
-from @gi[@$i$@].voidNew@ and @gi[@$i$@].dragNew@, respectively.\footnote{Due
-to a slight optimization described before, @gi[@$i$@].voidTotal@ is actually
-computed as $\sum_{1 \leq j \leq i}$@gi[@$j$@].voidNew@. 
-@gi[@$i$@].dragTotal@ is computed in a similar way.}
-Then, the total size of closures in the lag phase @gi[@$i$@].lagTotal@ is computed
-as @gi[@$i$@].notUsed@$-$@gi[@$i$@].voidTotal@ (because any unused closure
-is either in the void phase or in the lag phase).
-Similarly, 
-the total size of closures in the use phase @gi[@$i$@].useTotal@ is computed
-as @gi[@$i$@].used@$-$@gi[@$i$@].dragTotal@ (because any used closure
-is either in the use phase or in the drag phase).
-@endLdvProfiling()@, called from @endHeapProfiling@ in @ProfHeap.c@, computes these 
-final statistics.
-
-\section{Usage}
-
-The runtime system option @-hL@ tells the executable program to
-perform LDVU profiling and produce a @.hp@ file:
-
-\begin{code}
-$ Foo.out +RTS -hL
-\end{code}
-
-The option @-i@ can be used to 
-specify a desired interval at which LDVU profiling is performed.
-The default and minimum value is half a second:
-
-\begin{code}
-$ Foo.out +RTS -hL -i2.5 -RTS
-\end{code}
-
-The @.hp@ file can be supplied to the @hp2ps@ program to create a postscript
-file showing the progress of LDVU profiling in a graph:
-
-\begin{code}
-$ hp2ps Foo.hs
-$ gv Foo.ps
-\end{code}
-
-The horizontal axis of the graph is in the Haskell mutator time, which excludes
-the runtime system time such as garbage collection time and LDVU profiling
-time. 
-The Haskell mutator runs a bit slower than it would without performing
-LDVU profiling, but the difference is minute.
-Also, the timer employed to periodically perform retainer profiling
-is not perfectly accurate. Therefore, the result may slightly vary for each
-execution of retainer profiling.
-
-\textbf{To do:} Currently the LDVU profiling is not supported with @-G1@ option.
-
-\textbf{To do:} When we perform LDVU profiling, the Haskell mutator time seems to
-be affected by @-S@ or @-s@ runtime option. For instance, the following 
-two options should result in nearly same profiling outputs, but
-the second run (without @-Sstderr@ option) spends almost twice as
-long in the Haskell mutator as the first run:
-1) @+RTS -Sstderr -hL -RTS@; 2) @+RTS -hL -RTS@.
-This is quite a subtle bug because this wierd phenomenon is not 
-observed in retainer profiling, yet the implementation of 
-@mut_user_time_during_LDV()@ is completely analogous to that of 
-@mut_user_time_during_RP()@. The overall shapes of the resultant graphs 
-are almost the same, though.
-
-\section{Files}
-
-This section gives a summary of changes made to the GHC in 
-implementing LDVU profiling.
-Only three files (@includes/StgLdvProf.h@, @LdvProfile.c@, and 
-@LdvProfile.h@) are new, and all others exist in the GHC.
-
-@\includes@ directory:
-
-\begin{description}
-\item[StgLdvProf.h] defines type @LdvGenInfo@, constants, and macros related
-with LDVU profiling.
-\item[ClosureMacros.h] changes macro @SET_PROF_HDR()@.
-\item[Stg.h] includes th header file @StgLdvProf.h@.
-\item[StgMacros.h] changes macros @UPD_BH_UPDATABLE()@ and @UPD_BH_SINGLE_ENTRY()@.
-\end{description}
-
-@\rts@ directory:
-
-\begin{description}
-\item[GC.c] invokes @LdvCensusForDead()@ before tidying up, sets @hasBeenAnyGC@ to 
-  @rtsTrue@, and changes @copy()@ and @copyPart()@.
-  Invokes @LDV_recordDead()@ and @LDV_recordDead_FILL_SLOP_DYNAMIC()@.
-\item[Itimer.c] changes @handle_tick()@.
-\item[LdvProfile.c] implements the LDVU profiling engine. 
-\item[LdvProfile.h] is the header for @LdvProfile.c@.
-\item[PrimOps.hc] changes @finalizzeWeakzh_fast()@.
-\item[ProfHeap.c] changes @initHeapProfiling()@ and @endHeapProfiling()@.
-\item[Profiling.c] changes @initProfilingLogFile@ and @report_ccs_profiling()@.
-\item[Proftimer.c] declares @ticks_to_retainer_ldv_profiling@,
-  @performRetainerLdvProfiling@, and @doContextSwitch@.
-\item[Proftimer.h] is the header for @Proftimer.c@. Defines @PROFILING_MIN_PERIOD@,
-  which specifies the minimum profiling period and the default profiling period.
-%\item[RtsAPI.c] implements @setProfileHeader()@.
-\item[RtsFlags.c]
-  sets @RtsFlags.ProfFlags.doHeapProfile@,
-  adds a string to @usage_text[]@ in @setupRtsFlags()@.
-\item[RtsFlags.h] defines constants @HEAP_BY_LDV@ and @LDVchar@.
-\item[RtsStartup.c] changes @shutDownHaskell()@.
-\item[Schedule.c] changes @schedule()@.
-\item[Stats.c] 
-  declares @LDV_start_time@, @LDV_tot_time@, @LDVe_start_time@, 
-  @LDVe_tot_time@.
-  Changes @mut_user_time_during_GC()@, @mut_user_time()@,
-  @stat_startExit()@,
-  @stat_endExit()@, and
-  @stat_exit()@.
-  Defines
-  @mut_user_time_during_LDV()@,
-  @stat_startLDV()@, and
-  @stat_endLDV()@.
-\item[Stats.h] is hte header for @Stats.c@.
-\item[StgMiscClosures.hc] inserts entry macros in 
-  @stg_IND_entry()@, @stg_IND_PERM_entry()@, @stg_IND_OLDGEN_entry()@,
-  @stg_IND_OLDGEN_PERM_entry()@, @stg_BLACKHOLE_entry()@, @stg_BLACKHOLE_BQ_entry()@,
-  and @stg_CAF_BLACKHOLE_entry()@.
-  Invokes @LDV_recordDead()@ in @stg_BLACKHOLE_entry@.
-  Redefines @stg_DEAD_WEAK_info@.
-\item[Storage.c] changes @initStorage()@, @resetNurseries()@, and @allocNursery()@.
-\item[Storage.h] changes @updateWithIndirection()@ and @updateWithPermIndirection()@.
-\item[Updates.hc] inserts entry macros in @stg_PAP_entry()@ and @stg_AP_UPD_entry()@.
-\item[Weak.c] changes @scheduleFinalizers()@.
-\end{description}
-
-\bibliographystyle{plain}
-\bibliography{reference}
-
-\end{document}
diff --git a/ghc/docs/storage-mgt/megablock.eepic b/ghc/docs/storage-mgt/megablock.eepic
deleted file mode 100644
index 922226945b..0000000000
--- a/ghc/docs/storage-mgt/megablock.eepic
+++ /dev/null
@@ -1,35 +0,0 @@
-\setlength{\unitlength}{0.00054167in}
-%
-\begingroup\makeatletter\ifx\SetFigFont\undefined%
-\gdef\SetFigFont#1#2#3#4#5{%
-  \reset@font\fontsize{#1}{#2pt}%
-  \fontfamily{#3}\fontseries{#4}\fontshape{#5}%
-  \selectfont}%
-\fi\endgroup%
-{\renewcommand{\dashlinestretch}{30}
-\begin{picture}(6849,1539)(0,-10)
-\put(687,1062){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}block}}}}}
-\put(687,837){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}descriptor}}}}}
-\path(612,1512)(1737,1512)(1737,462)
-	(612,462)(612,1512)
-\path(4062,1512)(5187,1512)(5187,462)
-	(4062,462)(4062,1512)
-\path(12,1512)(6837,1512)(6837,462)
-	(12,462)(12,1512)
-\path(2337,1512)(2337,462)
-\path(132.000,192.000)(12.000,162.000)(132.000,132.000)
-\path(12,162)(2337,162)
-\path(2217.000,132.000)(2337.000,162.000)(2217.000,192.000)
-\path(2457.000,192.000)(2337.000,162.000)(2457.000,132.000)
-\path(2337,162)(6837,162)
-\path(6717.000,132.000)(6837.000,162.000)(6717.000,192.000)
-\path(2337,12)(2337,312)
-\put(237,912){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}...}}}}}
-\put(1962,912){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}...}}}}}
-\put(2862,912){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(5637,912){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(4362,912){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}block}}}}}
-\put(312,237){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}block descriptors}}}}}
-\put(4212,237){\makebox(0,0)[lb]{\smash{{{\SetFigFont{8}{9.6}{\rmdefault}{\mddefault}{\updefault}blocks}}}}}
-\end{picture}
-}
diff --git a/ghc/docs/storage-mgt/megablock.fig b/ghc/docs/storage-mgt/megablock.fig
deleted file mode 100644
index 8116c841b5..0000000000
--- a/ghc/docs/storage-mgt/megablock.fig
+++ /dev/null
@@ -1,40 +0,0 @@
-#FIG 3.2
-Landscape
-Center
-Inches
-Letter  
-65.00
-Single
--2
-1200 2
-6 3000 3675 4125 4725
-6 3075 3975 3900 4425
-4 0 0 50 0 0 12 0.0000 4 135 405 3075 4125 block\001
-4 0 0 50 0 0 12 0.0000 4 180 765 3075 4350 descriptor\001
--6
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 3000 3675 4125 3675 4125 4725 3000 4725 3000 3675
--6
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6450 3675 7575 3675 7575 4725 6450 4725 6450 3675
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 2400 3675 9225 3675 9225 4725 2400 4725 2400 3675
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 4725 3675 4725 4725
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 2400 5025 4725 5025
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 4725 5025 9225 5025
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 4725 5175 4725 4875
-4 0 0 50 0 0 12 0.0000 4 15 135 2625 4275 ...\001
-4 0 0 50 0 0 12 0.0000 4 15 135 4350 4275 ...\001
-4 0 0 50 0 0 12 0.0000 4 15 270 5250 4275 ......\001
-4 0 0 50 0 0 12 0.0000 4 15 270 8025 4275 ......\001
-4 0 0 50 0 0 12 0.0000 4 135 405 6750 4275 block\001
-4 0 0 50 0 0 12 0.0000 4 180 1305 2700 4950 block descriptors\001
-4 0 0 50 0 0 12 0.0000 4 135 495 6600 4950 blocks\001
diff --git a/ghc/docs/storage-mgt/nursery.eepic b/ghc/docs/storage-mgt/nursery.eepic
deleted file mode 100644
index 9b06c6e0a3..0000000000
--- a/ghc/docs/storage-mgt/nursery.eepic
+++ /dev/null
@@ -1,89 +0,0 @@
-\setlength{\unitlength}{0.00050000in}
-%
-\begingroup\makeatletter\ifx\SetFigFont\undefined%
-\gdef\SetFigFont#1#2#3#4#5{%
-  \reset@font\fontsize{#1}{#2pt}%
-  \fontfamily{#3}\fontseries{#4}\fontshape{#5}%
-  \selectfont}%
-\fi\endgroup%
-{\renewcommand{\dashlinestretch}{30}
-\begin{picture}(11262,7914)(0,-10)
-\path(4575,7137)(6150,7137)(6150,5937)
-	(4575,5937)(4575,7137)
-\path(5325,6987)(5325,7437)(7950,7437)(7950,7137)
-\path(7920.000,7257.000)(7950.000,7137.000)(7980.000,7257.000)
-\path(11025,7137)(11025,5937)
-\path(5475,6687)(5475,7437)
-\path(7950,7137)(11250,7137)(11250,5937)
-	(7950,5937)(7950,7137)
-\path(5475,6687)(5475,7887)(11025,7887)(11025,7137)
-\path(10995.000,7257.000)(11025.000,7137.000)(11055.000,7257.000)
-\path(4725,6087)(4125,6087)(4125,5562)
-\path(4095.000,5682.000)(4125.000,5562.000)(4155.000,5682.000)
-\path(8070.000,6567.000)(7950.000,6537.000)(8070.000,6507.000)
-\path(7950,6537)(11025,6537)
-\path(10905.000,6507.000)(11025.000,6537.000)(10905.000,6567.000)
-\path(4125,5112)(4125,4587)(4500,4587)
-\path(4380.000,4557.000)(4500.000,4587.000)(4380.000,4617.000)
-\path(4500,4662)(6075,4662)(6075,3462)
-	(4500,3462)(4500,4662)
-\path(5250,4512)(5250,4962)(7875,4962)(7875,4662)
-\path(7845.000,4782.000)(7875.000,4662.000)(7905.000,4782.000)
-\path(5400,4212)(5400,4962)
-\path(7875,4662)(11175,4662)(11175,3462)
-	(7875,3462)(7875,4662)
-\path(4650,3612)(4050,3612)(4050,2112)
-\path(4020.000,2232.000)(4050.000,2112.000)(4080.000,2232.000)
-\path(5400,4212)(5400,5412)(7875,5412)(7875,4662)
-\path(7845.000,4782.000)(7875.000,4662.000)(7905.000,4782.000)
-\path(7995.000,4092.000)(7875.000,4062.000)(7995.000,4032.000)
-\path(7875,4062)(9750,4062)
-\path(9630.000,4032.000)(9750.000,4062.000)(9630.000,4092.000)
-\path(9750,4662)(9750,3462)
-\path(9150,2787)(9750,2787)(9750,3462)
-\path(9780.000,3342.000)(9750.000,3462.000)(9720.000,3342.000)
-\path(9525,2337)(11175,2337)(11175,3462)
-\path(11205.000,3342.000)(11175.000,3462.000)(11145.000,3342.000)
-\path(3300,4737)(3300,4362)(4500,4362)
-\path(4380.000,4332.000)(4500.000,4362.000)(4380.000,4392.000)
-\path(3375,7212)(3375,6837)(4575,6837)
-\path(4455.000,6807.000)(4575.000,6837.000)(4455.000,6867.000)
-\path(4050,1662)(4050,1137)(4425,1137)
-\path(4305.000,1107.000)(4425.000,1137.000)(4305.000,1167.000)
-\path(4425,1212)(6000,1212)(6000,12)
-	(4425,12)(4425,1212)
-\path(5175,1062)(5175,1512)(7800,1512)(7800,1212)
-\path(7770.000,1332.000)(7800.000,1212.000)(7830.000,1332.000)
-\path(5325,762)(5325,1512)
-\path(7800,1212)(11100,1212)(11100,12)
-	(7800,12)(7800,1212)
-\path(5325,762)(5325,1962)(7800,1962)(7800,1212)
-\path(7770.000,1332.000)(7800.000,1212.000)(7830.000,1332.000)
-\put(4650,6912){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(4650,6612){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(4800,6012){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(4650,6312){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=1}}}}}
-\put(8625,7287){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}single block}}}}}
-\put(8625,6687){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}used memory}}}}}
-\put(3900,5337){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(4575,4437){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(4575,4137){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(4725,3537){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(4575,3837){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=1}}}}}
-\put(8550,4812){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}single block}}}}}
-\put(8025,4212){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}used memory}}}}}
-\put(9975,4212){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(9975,3927){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}memory}}}}}
-\put(8625,2712){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}Hp}}}}}
-\put(8625,2262){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}HpLim}}}}}
-\put(0,4887){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}MainRegTable.rCurrentNursery}}}}}
-\put(750,7362){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}MainRegTable.rNursery}}}}}
-\put(3825,1887){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(4500,987){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(4500,687){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(4500,387){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=1}}}}}
-\put(8475,1362){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}single block}}}}}
-\put(8775,762){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free memory}}}}}
-\put(4500,87){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link=NULL}}}}}
-\end{picture}
-}
diff --git a/ghc/docs/storage-mgt/nursery.fig b/ghc/docs/storage-mgt/nursery.fig
deleted file mode 100644
index 6a4b60fb82..0000000000
--- a/ghc/docs/storage-mgt/nursery.fig
+++ /dev/null
@@ -1,107 +0,0 @@
-#FIG 3.2
-Landscape
-Center
-Inches
-Letter  
-60.00
-Single
--2
-1200 2
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6300 1425 7875 1425 7875 2625 6300 2625 6300 1425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7050 1575 7050 1125 9675 1125 9675 1425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 12750 1425 12750 2625
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 7200 1875 7200 1125
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9675 1425 12975 1425 12975 2625 9675 2625 9675 1425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7200 1875 7200 675 12750 675 12750 1425
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 3
-	0 0 1.00 60.00 120.00
-	 6450 2475 5850 2475 5850 3000
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 9675 2025 12750 2025
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 3
-	0 0 1.00 60.00 120.00
-	 5850 3450 5850 3975 6225 3975
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6225 3900 7800 3900 7800 5100 6225 5100 6225 3900
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 6975 4050 6975 3600 9600 3600 9600 3900
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 7125 4350 7125 3600
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9600 3900 12900 3900 12900 5100 9600 5100 9600 3900
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 3
-	0 0 1.00 60.00 120.00
-	 6375 4950 5775 4950 5775 6450
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7125 4350 7125 3150 9600 3150 9600 3900
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 9600 4500 11475 4500
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 11475 3900 11475 5100
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 3
-	0 0 1.00 60.00 120.00
-	 10875 5775 11475 5775 11475 5100
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 3
-	0 0 1.00 60.00 120.00
-	 11250 6225 12900 6225 12900 5100
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 3
-	0 0 1.00 60.00 120.00
-	 5025 3825 5025 4200 6225 4200
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 3
-	0 0 1.00 60.00 120.00
-	 5100 1350 5100 1725 6300 1725
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 3
-	0 0 1.00 60.00 120.00
-	 5775 6900 5775 7425 6150 7425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6150 7350 7725 7350 7725 8550 6150 8550 6150 7350
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 6900 7500 6900 7050 9525 7050 9525 7350
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 7050 7800 7050 7050
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9525 7350 12825 7350 12825 8550 9525 8550 9525 7350
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7050 7800 7050 6600 9525 6600 9525 7350
-4 0 0 50 0 0 17 0.0000 4 150 435 6375 1650 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6375 1950 free\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6525 2550 link\001
-4 0 0 50 0 0 17 0.0000 4 165 885 6375 2250 blocks=1\001
-4 0 0 50 0 0 17 0.0000 4 225 1185 10350 1275 single block\001
-4 0 0 50 0 0 17 0.0000 4 225 1320 10350 1875 used memory\001
-4 0 0 50 0 0 17 0.0000 4 30 360 5625 3225 ......\001
-4 0 0 50 0 0 17 0.0000 4 150 435 6300 4125 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6300 4425 free\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6450 5025 link\001
-4 0 0 50 0 0 17 0.0000 4 165 885 6300 4725 blocks=1\001
-4 0 0 50 0 0 17 0.0000 4 225 1185 10275 3750 single block\001
-4 0 0 50 0 0 17 0.0000 4 225 1320 9750 4350 used memory\001
-4 0 0 50 0 0 17 0.0000 4 165 390 11700 4350 free\001
-4 0 0 50 0 0 17 0.0000 4 180 825 11700 4635 memory\001
-4 0 0 50 0 0 17 0.0000 4 225 300 10350 5850 Hp\001
-4 0 0 50 0 0 17 0.0000 4 225 720 10350 6300 HpLim\001
-4 0 0 50 0 0 17 0.0000 4 225 3180 1725 3675 MainRegTable.rCurrentNursery\001
-4 0 0 50 0 0 17 0.0000 4 225 2415 2475 1200 MainRegTable.rNursery\001
-4 0 0 50 0 0 17 0.0000 4 30 360 5550 6675 ......\001
-4 0 0 50 0 0 17 0.0000 4 150 435 6225 7575 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6225 7875 free\001
-4 0 0 50 0 0 17 0.0000 4 165 885 6225 8175 blocks=1\001
-4 0 0 50 0 0 17 0.0000 4 225 1185 10200 7200 single block\001
-4 0 0 50 0 0 17 0.0000 4 225 1275 10500 7800 free memory\001
-4 0 0 50 0 0 17 0.0000 4 165 1185 6225 8475 link=NULL\001
diff --git a/ghc/docs/storage-mgt/reference.bib b/ghc/docs/storage-mgt/reference.bib
deleted file mode 100644
index 48fa520b27..0000000000
--- a/ghc/docs/storage-mgt/reference.bib
+++ /dev/null
@@ -1,14 +0,0 @@
-@inproceedings {CN,
-  author =  {Colin Runciman and Niklas Rojemo},
-  title  =  {New Dimensions in heap profiling},
-  booktitle = "",
-  pages = "",
-  year = "1994" }
-
-@inproceedings {RR,
-  author =  {Niklas Rojemo and Colin Runciman},
-  title  =  {Lag, drag, void and use - heap profiling and space-efficient compilation revisited},
-  booktitle = "",
-  pages = "",
-  year = "1996" }
-
diff --git a/ghc/docs/storage-mgt/rp.tex b/ghc/docs/storage-mgt/rp.tex
deleted file mode 100644
index 2055894282..0000000000
--- a/ghc/docs/storage-mgt/rp.tex
+++ /dev/null
@@ -1,1102 +0,0 @@
-\documentclass{article}
-\usepackage{code,a4wide}
-
-\usepackage{graphics,epsfig,epic,eepic,epsfig}
-
-\setlength{\parskip}{0.25cm}
-\setlength{\parsep}{0.25cm}
-\setlength{\topsep}{0cm}
-\setlength{\parindent}{0cm}
-\renewcommand{\textfraction}{0.2}
-\renewcommand{\floatpagefraction}{0.7}
-
-
-% Terminology
-\newcommand{\block}{block}
-\newcommand{\Block}{Block}
-\newcommand{\segment}{segment}
-\newcommand{\Segment}{Segment}
-\newcommand{\step}{step}
-\newcommand{\Step}{Step}
-
-\newcommand{\note}[1]{{\em $\spadesuit$ #1}}
-
-\begin{document}
-\title{Implementation of Retainer Profiling}
-\author{Sungwoo Park and Simon Peyton-Jones}
-
-\makeatactive
-\maketitle
-
-\section{Retainer Profiling}
-
-Retainer profiling~\cite{CN} is a profiling technique which is based upon a 
-special view of production and consumption of heap objects at runtime:
-while producers build heap objects to form new pieces of graph,
-consumers hold pointers to these heap objects, or \emph{retain} them, so 
-that they are not freed during garbage collections. 
-On this basis, we refereed to such consumers as \emph{retainers}.
-Notice that an object can have more than one retainer because it can
-be pointed to by multiple objects.
-
-For each live object in the heap, retainer profiling computes 
-all its retainers, or its \emph{retainer set}.
-A naive implementation of retainer profiling could consider every
-immediate ancestor of an object as its retainer.
-Although this approach appears to provide an accurate report on the 
-relationship between retainers and retainees, the result can hardly be useful.
-For instance, it is pointless to scrutinize a list and treat each cons
-cell as a retainer of the following cons cell.
-This observation suggests that we need to have a way of designating only 
-certain types of objects as candidates for retainers.
-In other words, we need to employ an oracle which tells whether a given
-object can be a retainer or not.
-
-Since no retainer of a particular object needs to be using the
-object actively, we can find all its retainers simply by traversing
-the graph. In other words, we do not have to distinguish those retainers
-actively exploiting it from other retainers just holding pointers
-to it (either directly or indirectly).
-Thus, retainer profiling can be accomplished simply by traversing the
-graph.
-
-Figure~\ref{fig-retaineralgorithm} shows the algorithm for retainer
-profiling. The traversal begins at every root, and proceeds 
-in a depth first manner (or a breadth first manner).
-The function @R()@ returns the \emph{identity} of a given retainer such
-as its information table address or
-the name of the module which creates it.
-Notice that the retainer identity function does not need to be a 
-one-to-one mapping:
-multiple objects can share the same identity.
-Such a retainer identity function reduces the cost of traversal.
-For instance, when an object
-is reached from several retainers which share the same identity, we need to
-consider only the first visit to the object.
-In other words, whichever retainer (among those sharing the same identity) 
-leads to the object for the first time affects the retainer set of the object
-in consideration
-and all the other retainers can be ignored.
-Thus, the more coarse the function @R()@ is, the less
-it costs to traverse the graph for retainer profiling.
-The function @isRetainer()@ tells whether a given object is a retainer or not.
-Hence, the behavior of the retainer profiling algorithm is parameterized
-over: 1) the set of roots; 2) the function @R()@; 3) the function
-@isRetainer()@.
-
-One important invariant on the function @R()@ is that its return value
-must be consistent for a given retainer. In other words, @R()@ must return
-the same value for a given retainer no matter it is invoked.
-For this reason, the memory address of a retainer, for instance, cannot be used as
-its retainer identity because its location may change during garbage collections.
-
-\begin{figure}[ht]
-\begin{center}
-\begin{code}
-for every root r
-  retain(r, r)
-
-R(r) =
-  the identity of r
-
-isRetainer(c) =
-  if c is a retainer then   
-    true 
-  else 
-    false
-
-retain(c, r) =
-  if R(r) is a member of c.retainerSet then 
-    return
-  add R(r) to c.retainerSet
-  if isRetainer(c) then 
-    r' := c
-  else 
-    r' := r
-  for every successor c' of c
-    retain(c', r')
-\end{code}
-\caption{Retainer profiling algorithm}
-\label{fig-retaineralgorithm}
-\end{center}
-\end{figure}
-
-Another way of formulating retainer profiling is in terms of fixed point
-equations on retainer sets.
-To be specific, given the two functions @isRetainer()@ and @R()@,
-the retainer set of every object is computed as the least fixed point
-solution of the following equations:
-\begin{itemize}
-\item For every root @r@, 
-\begin{center}
-  @R(r)@ $\in$ @r.retainerSet@.
-\end{center}
-\item For every reachable object @c@, 
-\begin{center}
-$\bigcup_{\mathit{each\ ancestor\ @a@\ of\ @c@}}$ @from(a)@ $\subseteq$ 
-@c.retainerSet@ 
-\end{center}
-where @from(a)@ returns retainer(s) obtainable from @a@:
-\begin{center}
-@from(a)@ = if @isRetainer(a)@ then $\{@a@\}$ else @a.retainerSet@.
-\end{center}
-\end{itemize}
-
-This document describes the implementation of retainer profiling on
-the Glasgow Haskell Compiler runtime system. 
-It explains every detail of the development so that it can be (hopefully)
-a complete maintenance guide.
-A secondary goal is to help (hopefully) those who wish to extend the system 
-to implement another profiling scheme.\footnote{Unless otherwise mentioned,
-all identifiers are defined in @RetainerProfile.c@ or @RetainerSet.c@.}
-
-\section{Installing the GHC}
-
-Installing the GHC is done as follows:
-
-\begin{enumerate}
-\item Get the source code from the CVS repository.
-\begin{code}
-./              cvs checkout fpconfig
-./fptools/      cvs update -d CONTRIB common-rts distrib docs ghc glafp-utils 
-                    hslibs literate mhms mk nofib testsuite
-\end{code}
-
-\item Set up the basic configuration.
-\begin{code}
-./fptools/      autoconf                    
-./fptools/ghc/  autoconf
-./fptools/      configure
-\end{code}
-
-\item Set up the configuration for development and debugging.
-\begin{code}
-./fptools/mk    vi build.mk
-    GhcHcOpts = -O -fasm -Rghc-timing
-    SplitObjs = NO
-    GhcRtsHcOpts = 
-    GhcRtsCcOpts = -g
-    STRIP =:
-\end{code}
-@GhcLibWays@ tells the compiler to build the code for profiling as well.
-@GhcRtsHcOpts@ has additional flags for @gcc@ when compiling @.hc@ files.
-@GhcRtsCcOpts@ has additional flags for @gcc@ when compiling @.c@ files.
-Since we will implement retainer profiling in @.c@ files, we turn on the 
-debugging flag @-g@. 
-The empty setting for @STRIP@ tells the compiler not to remove source code
-information (generated due to the @-g@ option) from executable files so that
-they can be examined with @gdb@.
-
-\item Remove unnecessary files if needed and build everything.
-\begin{code}
-./fptools/      make
-\end{code}
-\end{enumerate}
-
-\section{Adding Retainer Set Fields}
-
-Since every Haskell closure now needs to store its retainer set at runtime, 
-it must be augmented with a new field,
-namely, a \emph{retainer set field}.
-This section explains how to add such a field to Haskell closures.
-It should be clear how to generalize the idea for adding 
-any number of new fields.\footnote{The GHC provides two 
-ways of building executable programs from 
-source files: normal way and profiling way. 
-We are concerned only about profiling way, and all the pieces of code 
-implementing profiling way are wrapped by the @PROFILING@ 
-pre-processing directive (as in @\#ifdef PROFILING@).
-Therefore, all the additions and changes that we make to the source code 
-are assumed to be wrapped by the @PROFILING@ pre-processing 
-directive as well unless otherwise mentioned.}
-
-\subsection{Adding a new field to Haskell closures} 
-
-We want to add a retainer set field of type @retainerSet@ to every 
-closure, so we create a new file @includes/StgRetainerProf.h@ where
-we define the type @retainerSet@.
-The actual definition of @retainerSet@ will be given later.
-
-\begin{code}
-/* includes/StgRetainerProf.h */
-typedef ... retainerSet;
-\end{code}
-
-We make type @retainerSet@ to be publicly available by including
-@includes/StgRetainerProf.h@ itself to @includes/Stg.h@ (not wrapped
-by @PROFILING@).
-
-\begin{code}
-/* includes/Stg.h */
-#include "StgRetainerProf.h"
-\end{code}
-
-Then we add a retainer set field @rs@ to the @StgProfHeader@ structure.
-
-\begin{code}
-/* include/Closures.h */
-typedef struct {
-   CostCentreStack *ccs;
-   retainerSet *rs;
-} StgProfHeader;
-\end{code}
-
-Now every closure @c@ (including static closures) has a retainer set field,
-which can be accessed with @c->header.prof.rs@ (where @c@ denotes the 
-address of the closure).
-
-\subsection{Changing constants}
-
-We are ready to reflect the new size of Haskell closures to other part
-of the source code.
-This is accomplished by changing a few constants which specify the size
-of certain types of closures and their layout.
-
-When building the runtime system, the @gcc@ compiler correctly figures out
-the size of every structure on its own.
-However, 
-GHC simply reads @includes/Constants.h@ to to determine the size of 
-closures assumed by the runtime system.
-Thus, we must change the constants used by the GHC itself (as opposed to
-the runtime system). They are all found in @includes/Constants.h@.
-We increase each of them by 1 to reflect the retainer set field which is one 
-word long:
-\begin{code}
-/* includes/Constants.h */
-#define PROF_HDR_SIZE       2
-#define SCC_UF_SIZE         5
-#define SCC_SEQ_FRAME_SIZE  4
-\end{code}
-@PROF_HDR_SIZE@ denotes the size of the structure @StgProfHeader@, which
-is now two words long. 
-@SCC_UF_SIZE@ and @SCC_SEQ_FRAME_SIZE@ denote the size of the structures
-@StgUpdateFrame@ and @StgSeqFrame@ (in @includes/Closures.h@) in
-words.
-
-Now we must rebuild the GHC so that, when executed, the code generated by 
-the GHC must now allocate one more word for the retainer set field than before.
-
-\begin{code}
-./fptools/ghc/  make boot
-./fptools/ghc/  make
-\end{code}
-
-The second command @make boot@ instructs the build system to analyze
-the source code dependency so that the next execution of @make@ correctly
-finds all required files.
-
-Next we change four bitmap constants which specify the layout of
-certain types of closures.
-As an example, let us consider @RET_BITMAP@, which specifies the layout
-of thunk selectors (corresponding to closure type @THUNK_SELECTOR@).
-Without a retainer set field, there is only one non-pointer (represented
-by $1$) followed by one or more pointers (represented by $0$) in the closure 
-body and the bitmap representation is $0b1$, or $1$. 
-With a retainer set field, which is not a pointer to another closure and thus
-represented by $1$, there are two non-pointers, and the bitmap representation
-is $0b11$, or $3$. Notice that the bitmap is interpreted in reverse order:
-the least significant bit corresponds to the first word in the closure body,
-and the second least significant bit to the second word, and so forth.
-The same rule applies to the other three bitmap constants:
-@CATCH_FRAME_BITMAP@ (for closure type @CATCH_FRAME@ and structure 
-@StgCatchFrame@),
-@STOP_THREAD_BITMAP@ (for closure type @STOP_FRAME@ and structure 
-@StgStopFrame@), and
-@UPD_FRAME_BITMAP@ (for closure type @UPDATE_FRAME@ and structure
-@StgUpdateFrame@).
-
-\begin{code}
-/* rts/StgStdThunks.hc */
-#define RET_BITMAP          3
-/* rts/Exception.hc */
-#define CATCH_FRAME_BITMAP  15
-/* rts/StgStartup.hc */
-#define STOP_THREAD_BITMAP  3
-/* rts/updates.hc */
-#define UPD_FRAME_BITMAP    7
-\end{code}
-
-For most closure types, the new definition of @StgProfHeader@ is
-automatically propagated to their corresponding structures.
-However, there are six closures types which are not affected by 
-@StgProfHeader@. They are all stack closures:
-@RET_DYN@, @RET_BCO@, @RET_SMALL@, @RET_VEC_SMALL@, @RET_BIG@, and
-@RET_VEC_BIG@. 
-If you want a new field to be added to these closures, you may
-have to modify their corresponding structures.
-
-\textbf{To do:} Presently the above changes introduce two bug in the 
-runtime system. 
-First, @nofib/real/symalg@ ends up with a division-by-zero
-exception if we add a new field. 
-Second, the runtime system option @-auto-all@ clashes in some test files
-in the @nofib@ testing suite (e.g., @spectral/expert@).
-
-\subsection{Initialization code}
-
-When a new closure is allocated, its retainer set field may have to be 
-initialized according to the way that retainer profiling is implemented.
-For instance, we could use as an initial value a pointer to an empty retainer 
-set. 
-Alternatively we could assign a null pointer to indicate that its retainer
-set has not been computed yet, which we adopt in our implementation.
-In either case, we have to visit the new closure and execute some initialization
-code on it so that its retainer set field is set to an appropriate value.
-
-There are three parts in the source code which need to be modified.
-dynamic closure initialization, static closure initialization,  
-and update frame initialization.
-The first is accomplished by modifying the macro @SET_PROF_HDR()@ (in 
-@include/ClosureMacros.h@). When a closure  @c@ is created at runtime, 
-@SET_PROF_HDR()@ is invoked immediately with @c@ as its first argument.
-Thus, the following code initializes the retainer set field of every
-dynamic closure to a null pointer.
-
-\begin{code}
-/* include/ClosureMacros.h */
-#define SET_PROF_HDR(c,ccs_)            \
-        ((c)->header.prof.ccs = ccs_, (c)->header.prof.rs = NULL)
-\end{code}
-
-Similarly, the macro @SET_STATIC_PROF_HDR()@ (in the
-same file) specifies how the retainer set field of every static closure
-is initialized, which is rewritten as follows:
-
-\begin{code}
-/* include/ClosureMacros.h */
-#define SET_STATIC_PROF_HDR(ccs_)       \
-        prof : { ccs : ccs_, rs : NULL },
-\end{code}
-
-\textbf{Obsolete:} Dynamic closures created through explicit C function invocations
-(in @RtsAPI.c@) are now initialized by @SET_HDR()@.
-
-%There is another way of creating dynamic closures through explicit C 
-%function invocations at runtime. 
-%Such functions are all defined in @RtsAPI.c@: @rts_mkChar()@, @rts_mkInt()@,
-%@rts_mkWord()@, and so forth.
-%Each function allocates memory for a new closure, 
-%initializes it, and returns its address. 
-%Therefore, we can simply insert in each function another initialization code 
-%for retainer set fields.
-%To this end, we define a macro @setRetainerField()@ and insert it 
-%in each function:
-%
-%\begin{code}
-%#define setRetainerField(p)             \
-%  (p)->header.prof.rs = NULL
-%\end{code}
-%
-%For instance, @rts_mkChar()@ is now defined as follows:
-%
-%\begin{code}
-%/* RtsAPI.c */
-%HaskellObj
-%rts_mkChar (HsChar c)
-%{
-%  StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
-%  ...
-%  setRetainerField(p);
-%  return p;
-%}
-%\end{code}
-
-Finally we may need to initialize the retainer set field of an update frame 
-(stack closure) when it is pushed onto the stack for the first time. 
-For instance, if we want to initialize the retainer set field of update
-frames to a null pointer, we can rewrite the macro @PUSH_STD_CCCS()@ 
-(in @includes/Updates.h@) as follows:
-
-\begin{code}
-/* includes/Updates.h */
-#define PUSH_STD_CCCS(frame)            \
-  (frame->header.prof.ccs = CCCS, frame->header.prof.rs = NULL)
-\end{code}
-
-In our implementation of retainer profiling, however, the retainer set field is not 
-used for any stack closure.
-Hence, the above modification is entirely unnecessary.
-Also, update frames are the only exception to the standard way of creating
-stack closures: all the other types of stack closures with a retainer set 
-field are eventually initialized by
-the macro @SET\_HDR()@ (in @includes/ClosureMacros.h@), which in turn
-invokes @SET\_PROF\_HDR()@. This is not the case for update frames.
-Compare @PUSH\_UPD\_FRAME()@ (in @includes/Updates.h@) and  
-@PUSH\_SEQ\_FRAME()@ (in @includes/StgMacros.h@) for clarification.
-
-\section{Retainer Sets}
-
-At the end of retainer profiling, every live closure (except stack
-closures, for which we do not compute retainer sets) is associated with
-a retainer set; there can be no closure without an associated retainer set
-because every live closure is visited during traversal.
-Since many closures may well be associated with a common retainer set,
-we want to avoid creating any particular retainer set more than once.
-This section presents the details of manipulating retainer sets in our
-implementation.
-
-\subsection{Identity of a retainer}
-
-The function @R()@ in Figure~\ref{fig-retaineralgorithm} returns
-the identity of a retainer. In order to implement it, we need 
-a type for retainer identity.
-The type @retainer@ (in @includes/StgRetainerProf.h@) is introduced for
-this purpose. 
-
-There are various ways of defining the type @retainer@. 
-For instance, we can designate the information table address of a retainer as
-its identity as follows:
-
-\begin{code}
-struct _StgInfoTable;
-typedef struct _StgInfoTable *retainer;
-\end{code}
-
-We can also use the cost centre stack associated with the retainer:
-
-\begin{code}
-typedef CostCentreStack *retainer;
-\end{code}
-
-The function @R()@ is embodied as the function @getRetainerFrom()@ in the 
-implementation, whose type is @(StgClosure *)@ $\rightarrow$ @retainer@.
-It is straightforward to define @getRetainerFrom()@ according to the definition
-of @retainer@, as illustrated below:
-
-\begin{code}
-retainer getRetainerFrom(StgClosure *c) { return get_itbl(c); }
-retainer getRetainerFrom(StgClosure *c) { return c->header.prof.ccs; }
-\end{code}
-
-\subsection{Retainer sets and the cost function}
-
-A retainer set is stored in the structure @retainerSet@ 
-(in @includes/StgRetainerProf.h@):
-
-\begin{code}
-typedef struct _retainerSet {
-  nat num;
-  nat cost;
-  ...
-  int id;
-  retainer element[0];
-} retainerSet;
-\end{code}
-
-The field @num@ gives the number of retainers in the retainer set, which
-are all stored in the array @element[]@. Thus, the size of @element[]@
-is assumed to be @num@.
-The field @cost@ gives the sum of the \emph{costs} of those closures 
-associated with the retainer set: if a closure @c@ is
-associated with the retainer set, that is, if @c@ is retained by each
-retainer in the retainer set and none else,
-the cost of @c@ is added to the field @cost@. 
-The field @id@ gives a unique identification number for the retainer set.
-
-The interface to @retainerSet@ is as follows 
-(see @RetainerSet.h@):
-
-\begin{description}
-\item[@void initializeAllRetainerSet(void)@] initializes the store for retainer sets.
-\item[@void refreshAllRetainerSet(void)@] refreshes each retainer set by setting
-its @cost@ field to zero. This function does destroy any retainer set.
-\item[@void closeAllRetainerSet(void)@] destroys all retainer sets and closes
-the store for retainer sets.
-\item[@retainerSet *singleton(retainer r)@] returns a singleton retainer set
-consisting of @r@ alone. If such a retainer set already exists, no new retainer
-set is created. Otherwise, a new retainer set is created.
-\item[@retainerSet *addElement(retainer r, retainerSet *rs)@] returns a retainer set
-@rs@ augmented with @r@. If such a retainer set already exists, no new retainer set
-is created. Otherwise, a new retainer set is created.
-\item[@rtsBool isMember(retainer r, retainerSet *rs)@] returns a boolean value
-indicating whether @r@ is a member of @rs@.
-\item[@void traverseAllRetainerSet(void (*f)(retainerSet *))@] invokes the function
-@f@ on every retainer set created.
-\item[@void printRetainerSetShort(FILE *, retainerSet *)@] prints a single retainer
-set.
-\item[@void outputRetainerSet(FILE *, nat *allCost, nat *numSet)@] prints all 
-retainer sets. Stores the sum of all their costs in @*allCost@ and the number
-of them in @*numSet@.
-\item[@void outputAllRetainerSet(FILE *)@] prints all retainer sets.
-\end{description}
-
-We also define a \emph{cost function}, which returns the cost of a given closure, 
-in order to compute the field @cost@. 
-The cost function can be defined in several ways.
-A typical definition is on the size of a closure, which results in
-the field @cost@ accumulating the size of all the closures retained by a
-retainer set.
-If we just want to count the number of closures retained by the
-retainer set, we can simply set the cost of every closure to one regardless
-of its closure type.
-Furthermore, we can define the cost function flexibly according to
-the closure type. 
-For instance, we can set the size of any static closure to zero so that
-it is not taken into account at all in computing the field @cost@. 
-Notice that static closures are also visited during traversal because they 
-may lead to other dynamic closures (e.g., static indirection closures of 
-closure type @IND_STATIC@).
-This is especially desirable because we usually focus on the heap use.
-We can also selectively choose certain dynamic closure types not to contribute 
-to the field @cost@.
-
-In our implementation, there are two functions related with the cost function:
-@cost()@ and @costPure()@. 
-@cost()@ returns the size of the entire memory allocated for a given closure
-(even including the two fields in the structure @StgProfHeader@). 
-It returns zero for static closures. 
-@costPure()@ returns the size of the memory which would be allocated for
-a given closure with no profiling.
-It is defined in terms of @cost()@, and it suffices to change only @cost()@
-when a new scheme for the cost function is desired.
-@costPure()@ is put to actual use in computing the field @cost@ because it 
-effectively hides the memory overhead incurred by profiling.
-
-\subsection{Implementation}
-
-The algorithm for retainer profiling in Figure~\ref{fig-retaineralgorithm} 
-adds at most one retainer to an existing retainer set (or an empty retainer set)
-at any moment; it does not require a retainer set union operation.
-This observation simplifies the implementation, and
-we employ the following two functions for creating new retainer sets: 
-@singleton()@, which creates a singleton retainer set, and 
-@addElement()@, which adds an element to an existing retainer set. 
-
-It is a frequent operation during retainer profiling to search for a retainer
-set, which may or may not exist, built from a given retainer set and a
-particular retainer.
-To efficiently implement this operation,
-we choose to store all retainer sets in a hash table and 
-the structure @retainerSet@ is now extended with two new fields
-@hashKey@ and @link@.
-The field @hashKey@ stores the hash key which is obtained
-from the retainers in a retainer set.
-The field @link@ points to the next retainer set in the same bucket:
-
-\begin{code}
-typedef struct _retainerSet {
-  ...
-  StgWord hashKey;
-  struct _retainerSet *link;
-  ...
-} retainerSet;
-\end{code}
-
-The hashing function must be defined in such a way that a retainer set
-can have only one unique hash key regardless of the order its elements
-are stored, i.e., the hashing function must be additive.
-
-It is often observed that two successive executions of retainer profiling share
-a number of retainer sets in common, especially if the two executions are
-close in time.
-This also implies that the number of all retainer sets which can be created
-at any moment does not grow indefinitely regardless of the interval at which
-retainer profiling is performed; it does not grow commensurately with the
-number of times retainer profiling is executed.
-This observation eliminates the need to free the memory allocated for
-retainer sets; we can simply set the @cost@ field of every retainer set
-to zero after each retainer profiling and reuse it during the next time.
-
-\section{Graph Traversal}
-
-At the heart of retainer profiling lies \emph{graph traversal};
-the algorithm in Figure~\ref{fig-retaineralgorithm} is supposed to visit
-every closure in the graph at least once and yield statistics on the heap use.
-Since only live closures are reachable from the root, the algorithm
-does not deal with dead closures.
-
-This section presents details on how to achieve an efficient implementation of 
-graph traversal without incurring extra memory overhead and compromising speed.
-
-\subsection{Goal}
-
-Traversing a graph itself can be done in a straightforward way;
-we choose either depth first search or breadth first search, and traverse
-the graph starting from a given set of roots.
-After a complete traversal, each live closure @c@ (including static closures)
-has an associated retainer set, whose address is stored in the field
-@c->header.prof.rs@. 
-
-A real complication arises when retainer profiling is performed once again:
-all live closures which have survived all garbage collections since 
-the previous retainer profiling 
-still have an associated retainer set (indicated by
-a non-null pointer in their retainer set field), which is no longer
-valid. Any new closure created since then has
-a null pointer in its retainer set field at the beginning of retainer 
-profiling and will become associated with a retainer set.
-Thus, we can no longer distinguish valid retainer set fields
-from invalid ones. 
-
-A simple remedy is to linearly scan the heap at the beginning of each 
-retainer profiling and set all retainer set fields to a null pointer.
-It resets the retainer set field of each dynamic closure, whether it is
-live or not with respect to the given set of root.
-This is feasible because any closure in the heap directly adjoins the
-next closure, if any.
-The problem is that we have no way of visiting all live static closures,
-for which we compute retainer sets.
-
-A moment of thought, however, reveals that we can completely avoid computing 
-retainer sets for static closures. This is because retainer profiling is 
-concerned only about the heap, which consists of dynamic closures and no
-static closures. In other words, we can treat every static closure as
-a bridge connecting two dynamic closures. 
-For instance, if a dynamic closure @c@$_1$ has a pointer to a static
-closure @s@ and @c@ has a pointer to another dynamic closure @c@$_2$,
-we can think of the pointer in @c@$_1$ as a direct pointer to @c@$_2$.
-The big problem is that if the graph has a cycle containing static closures,
-an infinite loop occurs. In other words, we have no way of telling whether
-a static closure has been visited or not and are forced to compute
-retainer sets for static closures as well.\footnote{For instance, 
-a static closure is allowed to have a self-reference in its SRT, which
-is also followed during retainer profiling.}
-
-Another remedy is to stores in every closure a time stamp for the
-retainer set field. The time stamp indicates whether the retainer
-set field is valid or no longer valid (i.e., it is for the previous
-retainer profiling). 
-At the cost of one extra field in each closure, we can achieve an
-elegant implementation with little complication.
-However, it turns out that the memory overhead is too big.\footnote{A typical
-dynamic closure is only two or three words long.}
-Thus, our goal is to stick to the definition of the structure @StgProfHeader@
-given earlier and yet to achieve an elegant solution.
-
-\subsection{Basic plan}
-
-Since we visit every live object and update its retainer set field,
-any retainer set field can either be valid (the corresponding retainer
-set is valid) or point to a retainer set created during the previous
-retainer profiling. 
-In order to distinguish valid retainer set fields
-from invalid ones, we exploit the least significant bit of the retainer
-set field: we maintain a one bit mark which flips over every time
-retainer profiling is performed, and judge that a retainer set field is
-valid only if its least significant bit matches the mark.
-The variable @flip@ serves for this purpose. 
-The macros @isRetainerSetFieldValid()@ tests if the retainer set field
-of a give closure @c@ is valid:
-
-\begin{code}
-#define isRetainerSetFieldValid(c) \
-  ((((StgWord)(c)->header.prof.rs & 1) ^ flip) == 0)
-\end{code}
-
-As an example, a retainer set field can be set to a null value conforming
-the current value of @flip@ by the macro @setRetainerSetToNull()@:
-
-\begin{code}
-#define setRetainerSetToNull(c)   \
-  (c)->header.prof.rs = (retainerSet *)((StgWord)NULL | flip)
-\end{code}
-
-Now, when a dynamic closure @c@ is created, its retainer set field is
-initialized to a null value conforming to the current value of 
-@flip@:\footnote{Actually this is not mandatory: even when the null
-value does not conform to the current value of @flip@, it will be replaced
-by a correct null value when @c@ is visited later.}
-
-\begin{code}
-extern StgWord flip;
-#define SET_PROF_HDR(c,ccs_)            \
-        ((c)->header.prof.ccs = ccs_, (c)->header.prof.rs = (retainerSet *)((StgWord)NULL | flip))
-\end{code}
-
-We do not need to revise @SET_STATIC_PROF_HDR()@ if the initial value of
-@flip@ is set to $0$.\footnote{For the same reason, an initial value $1$
-does not compromise the correctness of the implementation.}
-
-\subsection{Set of roots}
-
-The set of roots consists of all thread closures (running, sleeping, or 
-blocked) existing at the beginning of a retainer profiling. 
-It is handily obtained in an indirect way by invoking the function
-@GetRoots()@ (in @Schedule.c@) with an appropriate argument, which must be
-a function:
-@GetRoots()@ invokes on each root known to the runtime system its argument.
-Thus, we implement a function @retainClosure()@, which initiates traversal
-from a given root and updates the retainer set of every closure reachable
-from the root,
-and invokes @GetRoots()@ with @retainClosure@ as an argument.
-
-In addition to the thread closures, weak pointers are also considered
-as roots; they may not be reachable from any thread closure yet are still
-being in used.
-A weak pointer has three pointer fields: @key@, @value@, and 
-@finalizer@ (see the structure @StgWeak@ in @includes/Closures.h@).
-It turns out that these pointers may not be valid all the time:
-at a certain point during execution, for instance, the pointer @key@ may point 
-to a dead closure. 
-However, right after a major garbage collection, all the three pointers are
-guaranteed to be valid, i.e., they all point to live closures. 
-This facilitates the handling of weak pointers if we choose to
-perform retainer profiling immediately after a major garbage collection.
-All weak pointers are found in the linked list @weak_ptr_list@ 
-(in @Weak.c@).
-
-See the function @computeRetainerSet()@ for details.
-
-\subsection{Static closures}
-
-When a live dynamic closure @c@ is visited for the first time during traversal,
-its retainer set field is checked against the current value of @flip@.
-If it was created at some point since the previous retainer profiling, 
-its retainer set field is already set to a correct null value. 
-Otherwise, it must have been visited 
-during the previous retainer profiling and thus its retainer set field is
-invalid and will be set to a correct null value. 
-Therefore it is unnecessary to visit all dynamic closures and set their
-retainer set field to a correct null value at the beginning of each retainer 
-profiling.
-
-However, this operation is required for static closures. 
-The reason is that a static closure, which is never garbage collected,
-may appear alternately in the set of live closures.
-In other words, a currently live static closure may become dead and 
-be resuscitated again.
-Therefore, for a static closure, it does not help to check if its
-retainer set field conforms to the current value of @flip@. 
-For instance, 
-if a static closure happens to belong to the set of live closures every other 
-retainer profiling, its retainer set field will never set to a null value,
-which is disastrous.
-Therefore, we choose to visit all live static closures at the beginning
-of each retainer profiling and set their retainer set field to a 
-correct null value. 
-
-In order to find all live static closures, we have each retainer 
-profiling preceded by a major garbage collection, which knows all live
-static closures.\footnote{This is a heavy 
-restriction on retainer profiling, which makes retainer profiling partially
-dependent on garbage collection. 
-However, it does not affect any retainer profiling result because 
-retainer profiling considers only live closures, which survive any
-garbage collection.} 
-To be specific, the garbage collector builds a linked list
-@scavenged_static_objects@ (in @GC.c@) during a major garbage collection,
-which stores all live static closures of our interest.
-\footnote{
-A static closure of closure type @IND\_STATIC@ may be put in the
-list @mut\_once\_list@ of the oldest generation, instead of the list
-@scavenged\_static\_objects@. 
-In our implementation, such a closure is just skipped over because it
-contains only a pointer to a dynamic closure, and we do not compute
-its retainer set.
-Thus, there is no need to traverse the list @mut\_once\_list@ of the oldest 
-generation.}
-Since it destroys the linked list after finishing the major garbage collection
-(by invoking the function @zero_static_object_list()@ with 
-@scavenged_static_objects@ as its argument),
-we traverse the linked list to set the retainer set field of each
-live static closure to a correct null value before its destruction.
-This is done by invoking the function 
-@resetStaticObjectForRetainerProfiling()@.
-
-\textbf{To do:} In the current implemenation, if a static closure has no child
-(e.g., @CONSTR_NOCAF_STATIC@, @THUNK_STATIC@ with an empty SRT, and
-@FUN_STATIC@ with an empty SRT), we do not compute its retainer set (because
-there is no need to do). This slight optimization allows us to render 
-retainer profiling no longer dependent on garbage collection due to the
-following propoerty: 
-
-\begin{center}
-A static closure can alternately appear and disappear in the set of live 
-closures across multiple executions of retainer profiling if and only if
-it has an empty SRT and no child.
-\end{center}
-
-Then we can completely eliminate the function 
-@resetStaticObjectForRetainerProfiling()@. 
-
-\subsection{Traversal}
-
-The traversal proceeds in a depth first manner and is implemented
-with two mutually recursive functions: @retainStack()@ and @retainerClosure()@.
-@retainerStack()@ can be invoked on dynamic closures holding a stack chunk:
-closure types @TSO@, @PAP@, and @AP_UPD@. 
-It in turn invokes @retainerClosure()@ on each closure reachable from
-stack closures in the stack chunk. Notice that it does not invoke
-@retainerClosure()@ on those stack closures because we do not compute 
-retainer sets for stack closures.
-@retainerClosure()@ iteratively traverses all live closures reachable
-from a given closure.
-It maintains its own stack to record the next scan position in every closure
-currently under consideration.\footnote{A recursive version of 
-@retainerClosure()@ could be implemented easily. 
-@retainerClosure()@ in our implementation is an iterative version.}
-When it encounters a closure holding a stack chunk, it invokes @retainerStack()@
-on that closure. 
-Hence,
-the traversal is triggered simply by invoking @retainerClosure()@ on every root.
-
-\textbf{To do:} 
-The correctness of retainer profiling is subject to the correctness
-of the two macros @IS_ARG_TAG()@ and @LOOKS_LIKE_GHC_INFO()@
-(see @retainStack()@). Since
-@LOOKS_LIKE_GHC_INFO()@ is a bit precarious macro, so I believe that
-the current implementation may not be quite safe. Also, @scavenge_stack()@
-in @GC.c@ also exploits this macro in order to identify shallow pointers.
-This can be a serious problem if a stack chunk contains some
-word which looks like a pointer but is actually not a pointer.
-
-\subsection{Sanity check}
-
-Since we assume that a retainer profiling is preceded by a major garbage
-collection,
-we expect that the size of all the dynamic closures visited during 
-any retainer profiling adds up exactly to the total size of the heap.
-In fact, this is not the case; there can be closures not reachable from
-the set of roots yet residing in the heap even after a major garbage
-collection.
-
-First, a dead weak pointer remains in the heap until its finalizer
-finishes. Although its finalizer thread closure is part of the set of roots,
-the dead weak pointer itself is not reachable from any root.
-Since it cannot be visited during retainer profiling anyhow, we do not
-need to located it and set its retainer set field 
-appropriately.\footnote{Dead weak pointers are identified with their 
-information table @stg\_DEAD\_WEAK\_info@ (in @StgMiscClosures.hc@). 
-Notice that their closure type is @CONSTR@, \emph{not} @WEAK@;
-their information table is replaced by @stg\_DEAD\_WEAK\_info@ in the 
-function @scheduleFinalizers()@ (in @GC.c@).} 
-
-Second, 
-mutable variables (of closure type @MUT_VAR@) may remain in the heap
-even when they are not reachable from the set of roots while
-dynamic closures pointed to by them must be live.\footnote{I do not 
-understand clearly why this happens :(} 
-Since such mutable variables may become live again (in the sense that
-they become reachable from the set of roots), we must locate them
-and set their retainer set field appropriately after each retainer
-profiling. This is handily accomplished by traversing the list
-@mut_once_list@ in every generation.
-
-\section{Retainer Profiling Schemes}
-
-A retainer profiling scheme specifies \emph{what} retainer profiling
-yields (as opposed to \emph{how} retainer profiling computes the retainer
-set for every live object).
-It is determined primarily by the meaning of retainer identity,
-that is, the type @retainer@ (in @includes/StgRetainerProf.h@). 
-The function @getRetainerFrom()@ must be defined according to the
-definition of the type @retainer@.
-
-In order for a new retain profiling scheme to fully work, we need to follow
-four steps:
-
-\begin{enumerate}
-\item Define the type @retainer@ as desired.
-\item Write @getRetainerFrom()@.
-\item Write two hashing functions @hashkeySingletone()@ and 
-      @hashKeyAddElement()@, which return the hash key from a single
-      retainer and a retainer set with another retainer, respectively.
-\item Write two printing functions @printRetainer()@ and 
-      @printRetainerSetShort()@.
-      These functions are employed when a retainer or a retainer set is
-      printed in the output file. 
-\end{enumerate}
-
-In our implementation, we use cost centre stacks for retainer identity:
-
-\begin{code}
-typedef CostCentreStack *retainer;
-\end{code}
-\begin{code}
-retainer getRetainerFrom(StgClosure *c) { return c->header.prof.ccs; }
-\end{code}
-\begin{code}
-void printRetainer(FILE *f, retainer cc)
-{
-  fprintf(f,"%s[%s]", cc->label, cc->module);
-}
-\end{code}
-
-\textbf{To do:} All the closures created by @rts_mk...()@ in @RtsAPI.c@ are given 
-@CCS_SYSTEM@ as their cost centre stacks. This may not be accurate indeed,
-and, for instance, @CCCS@ may be a better choice than @CCS_SYSTEM@. 
-
-\section{Usage}
-
-Since cost centre stacks are used as retainer identity, a source program
-must be given proper cost centre annotations by programmers. 
-Alternatively,
-we can ask the compiler to automatically insert cost centre annotations.
-For instance, the compiler option @-auto-all@ inserts a cost centre
-annotation around every top-level function as shown below 
-(the @-p@ option is a must
-because we must build the executable file in a profiling way):
-
-\begin{code}
-$ ghc-inplace -o Foo.out -p -auto-all Foo.hs
-\end{code}
-
-The runtime system option @-hR@ tells the executable program to
-gather profiling statistics and report them in a @.prof@ file:
-
-\begin{code}
-$ Foo.out +RTS -hR -RTS
-\end{code}
-
-The option @-i@ can be used to 
-specify a desired interval at which retainer profiling is performed.
-The default and minimum value is half a second:
-
-\begin{code}
-$ Foo.out +RTS -hR -i2.5 -RTS
-\end{code}
-
-Then, two text files are generated: a @.prof@ file and a @.hp@ file.
-The @.prof@ file records the progress of retainer profiling:
-for each retainer profiling performed during program execution, 
-it shows
-the Haskell mutator time (as opposed to the user time) at which 
-the retainer profiling starts,
-the average number of times a closure is visited, 
-the sum of costs assigned to all retainer sets (obtained from the field
-@cost@ in each retainer set),
-and the number of all retainer sets created \emph{since} the beginning
-of program execution.
-A typical entry in a @.prof@ file looks like:
-
-\begin{code}
-Retainer Profiling: 3, at 3.530000 seconds
-  Average number of visits per object = 1.687765
-  Current total costs = 801844
-  Number of retainer sets = 118
-\end{code}
-
-The sum of costs assigned to all retainer sets may \emph{not} be equal to the
-size of the heap. 
-The discrepancy is attributed to those live object which are not reachable
-from the set of roots. 
-Still it is a good estimate of the size of the heap at the moment when
-the retainer profiling was performed.
-
-The @.prof@ file also shows the contents of every retainer set which 
-has been assigned a positive cost (i.e., the field @cost@) at least once;
-not every retainer set created is assigned a positive cost because quite
-a few retainer sets are created as intermediate retainer sets before
-creating a real retainer set. This results from the restriction on the way
-retainer sets are created (only one retainer can be added to an existing
-retainer set at a time).
-
-An example of the contents of a retainer set is:
-
-\begin{code}
-SET 71 = {<doFile[Main],main[Main],MAIN[MAIN]>, <synth_2[Main],doFile[Main],main[Main],MAIN[MAIN]>}
-\end{code}
-
-The retainer set has an identification number $71$.
-It is associated with two retainers, whose retainer identities are shown 
-inside angle brackets @<...>@.
-For instance, the first retainer is created when the cost centre stack
-is @doFile[Main],main[Main],MAIN[MAIN]@, shown from the top to the bottom.
-Each entry in angle brackets consists of a cost centre name (e.g., @doFile@) 
-and its module name (e.g., @Main@).
-
-The @.hp@ file can be supplied to the @hp2ps@ program to create a postscript 
-file showing the progress of retainer profiling in a graph:
-
-\begin{code}
-$ hp2ps Foo.hs
-$ gv Foo.ps
-\end{code}
-
-An example of such a graph is shown in Figure~\ref{fig-cacheprof}.
-It shows the cost assigned to each retainer set at the point 
-when a retainer profiling is performed (marked by a corresponding inverted 
-triangles on the horizontal axis). 
-The abbreviated contents of each retainer set is displayed in the right column.
-Due to the space limitation,
-it shows only topmost cost centres (without module names)
-instead of printing the full contents.
-For instance, @(71)doFile,synth_2@ corresponds to a retainer set shown above 
-(@71@ is its identification number).
-The contents may be truncated if it is too long. 
-
-Notice that the time is in the Haskell mutator time, which excludes 
-the runtime system time such as garbage collection time and retainer profiling
-time. Thus, the actual execution takes longer than indicated in the
-graph. Also, the timer employed to periodically perform retainer profiling
-is not perfectly accurate. Therefore, the result may slightly vary for each
-execution of retainer profiling.
-
-\begin{figure}[ht]
-\centering
-\epsfig{file=cacheprof_p.eps,width=5in}
-\caption{A graph showing the progress of retainer profiling}
-\label{fig-cacheprof}
-\end{figure}
-
-\section{Comparision with nhc}
-
-\section{Files}
-
-This section gives a summary of changes made to the GHC in 
-implementing retainer profiling.
-Only three files (@includes/StgRetainerProf.h@, @RetainerProfile.c@, and 
-@RetainerProfile.h@) are new, and all others exist in the GHC.
-
-@\includes@ directory:
-
-\begin{description}
-\item[StgRetainerProf.h] defines types @retainer@ and @retainerSet@. 
-\item[Stg.h] includes the header file @StgRetainerProf.h@.
-\item[Closures.h] changes structure @StgProfHeader@.
-\item[Constants.h] changes constants @PROF_HDR_SIZE@, @SCC_UF_SIZE@, and
-  @SCC_SEQ_FRAME_SIZE@.
-\item[ClosureMacros.h] changes macros @SET_PROF_HDR()@ and 
-  @SET_STATIC_PROF_HDR()@.
-\item[Updates.h] changes macro @PUSH_STD_CCCS()@.
-\end{description}
-
-@\rts@ directory:
-
-\begin{description}
-\item[Exception.hc] changes constant @CATCH_FRAME_BITMAP@, 
-\item[StgStartup.hc] changes constant @STOP_THREAD_BITMAP@.
-\item[StgStdThunks.hc] changes constant @RET_BITMAP@.
-\item[Updates.hc] changes constant @UPD_FRAME_BITMAP@.
-\item[RetainerProfile.c] implements the retainer profiling engine.
-\item[RetainerProfile.h] is the header for @RetainerProfile.c@.
-\item[RetainerSet.c] implements the abstract datatype @retainerSet@.
-\item[RetainerSet.h] defines the interface for @retainerSet@.
-\item[GC.c] invokes @resetStaticObjectForRetainerProfiling()@ in 
-  @GarbageCollect()@.
-\item[Itimer.c] changes @handle_tick()@.
-\item[ProfHeap.c] changes @initHeapProfiling()@ and @endHeapProfiling()@.
-\item[Profiling.c] changes @initProfilingLogFile()@ and 
-  @report_ccs_profiling()@.
-\item[Proftimer.c] declares @ticks_to_retainer_profiling@, 
-  @performRetainerProfiling@, and @doContextSwitch@.
-\item[Proftimer.h] is the header for @Proftimer.c@. Defines @PROFILING_MIN_PERIOD@,
-  which specifies the minimum profiling period and the default profiling period.
-%\item[RtsAPI.c] implements @setRetainerField()@.
-\item[RtsFlags.c] 
-  sets @RtsFlags.ProfFlags.doHeapProfile@ and
-  adds a string to  @usage_text[]@ in @setupRtsFlags()@.      
-\item[RtsFlags.h] defines constants @HEAP_BY_RETAINER@ and @RETAINERchar@.
-\item[RtsStartup.c] includes the header file @RetainerProfile.h@.
-  Changes @shutdownHaskell()@.
-\item[Schedule.c] changes @schedule()@. 
-\item[Stats.c] 
-  declares @RP_start_time@, @RP_tot_time@, @RPe_start_time@, 
-  @RPe_tot_time@.
-  Changes @mut_user_time_during_GC()@, @mut_user_time()@, 
-  @stat_startExit()@, 
-  @stat_endExit()@, and
-  @stat_exit()@.
-  Defines
-  @mut_user_time_during_RP()@, 
-  @stat_startRP()@, and
-  @stat_endRP()@.
-\item[Stats.h] is the header for @Stats.c@.
-\item[StgMiscClosures.hc] redefines @stg_DEAD_WEAK_info@.
-\item[Storage.c] changes @initStorage()@, @memInventory()@.
-\end{description}
-
-\bibliographystyle{plain}
-\bibliography{reference}
-
-\end{document}
diff --git a/ghc/docs/storage-mgt/sm.tex b/ghc/docs/storage-mgt/sm.tex
deleted file mode 100644
index 9dee565c7d..0000000000
--- a/ghc/docs/storage-mgt/sm.tex
+++ /dev/null
@@ -1,995 +0,0 @@
-\documentclass{article}
-\usepackage{code,a4wide}
-
-\usepackage{graphics,epsfig,epic,eepic}
-
-\setlength{\parskip}{0.25cm}
-\setlength{\parsep}{0.25cm}
-\setlength{\topsep}{0cm}
-\setlength{\parindent}{0cm}
-\renewcommand{\textfraction}{0.2}
-\renewcommand{\floatpagefraction}{0.7}
-
-
-% Terminology
-\newcommand{\block}{block}
-\newcommand{\Block}{Block}
-\newcommand{\segment}{segment}
-\newcommand{\Segment}{Segment}
-\newcommand{\step}{step}
-\newcommand{\Step}{Step}
-
-\newcommand{\note}[1]{{\em $\spadesuit$ #1}}
-
-\begin{document}
-\title{The GHC Storage Manager}
-\author{Simon Peyton-Jones and Sungwoo Park}
-
-\makeatactive
-\maketitle
-\section{Introduction}
-
-This document describes the details of the GHC storage manager, including
-the interface and implementation of each of its components.
-
-\section{Goals}
-
-Storage management goals are:
-\begin{itemize}
-\item Generational collection, supporting multiple generations.
-\item The ability to pin the allocation
-area into a few pages that we hope will fit entirely in the cache.
-\item Allows objects to age within a generation before getting promoted.
-\item Heap can grow as needed, rather than having to be pre-sized
-  by the programmer.
-\item We support mark/sweep/compact collection for older generations.
-This is a Good Thing when the live memory approaches the available
-physical memory, because it reduces paging.
-\item Little OS support needed.  No @mmap()@ etc. All that we require is
-  the ability to call @malloc()@ to allocate a new chunk of memory.
-  There can be intervening ``sandbars'' allocated by other programs
-  (e.g. DLLs or other @malloc()@'d structures) between chunks of heap.
-\end{itemize}
-
-Language-support goals are:
-\begin{itemize}
-\item The garbage collector ``shorts out'' indirection objects introduced
-by the mutator (notably when overwriting a thunk with an indirection).
-\item The garbage collector executes selector thunks.
-For example, a thunk for
-@(fst x)@ where @x@ is a pointer to a pair @(a,b)@ would be
-evaluated by the garbage collector to just @a@.  This is an important
-strategy for plugging space leaks.
-\item The garbage collector traversese the code tree, as well as
-the heap data structures, to find which CAFs are live. This is a royal pain.
-\item The garbage collector finalises some objects (typically a tiny minority).
-At the moment ``finalisation'' means ``call a C routine when this thing
-dies'' but it would be more general to schedule a call to a Haskell
-procedure.
-\end{itemize}
-
-Instrumentation goals are:
-\begin{itemize}
-\item The garbage collector can gather heap-census information for profiling.
-To this end we can force GC to happen more often than it otherwise would,
-and the collector can gather information about the type and cost-centre
-associated with each heap object.
-\end{itemize}
-
-\section{The architecture of the storage manager}
-
-The storage manager is a component of the GHC system which is responsible
-for allocating fresh memory for new objects and reclaiming memory 
-that is no longer used.
-It is built on a layered architecture and consists of four main parts:
-\emph{megablock allocator}, \emph{block allocator}, \emph{heap allocator}, 
-and \emph{garbage collector} (Figure~\ref{fig-architecture}). 
-The megablock allocator communicates directly with the underlying 
-operating system and forms the lowest level of the storage manager.
-The heap allocator and garbage collector lie in the topmost level of
-the storage manager and process requests from 
-the mutator (the Haskell realm at the runtime) and the runtime system.
-The block allocator lies between the two levels. 
-
-\begin{figure}[ht]
-\begin{center}
-\input{architecture.eepic}
-\caption{The overall architecture of the storage manager}
-\label{fig-architecture}
-\end{center}
-\end{figure}
-
-\section{The megablock allocator}
-
-% need more elaboration - Sung
-The megablock allocator implements a direct interface to the underlying 
-operating system. 
-It can request a chunk of physical memory of a fixed size,
-which is called a \emph{megablock}, from the operating system and returns it
-to the block allocator. A new megablock is not initialized by the
-megablock allocator; it is later initialized by the block allocator.
-
-\subsection{Interface}
-
-\begin{description}
-\item[@void *getMBlock()@] allocates a single megablock and returns its 
-starting address. 
-\item[@void *getMBlocks(nat n)@] allocates @n@ contiguous megablocks 
-and returns their starting address. 
-\end{description}
-
-\subsection{Implementation}
-
-Since the megablock allocator communicates directly with the underlying
-operating system, its implementation relies on memory allocation functions
-provided by the operating system; thus, the implementation varies between
-platforms. 
-However, every megablock is always of a fixed size $2^M$ and aligned on a 
-$2^M$ boundary, regardless of the platform 
-(@MBLOCK_SIZE@ in @include/Constants.h@ defines the size of megablocks).
-@mblocks_allocated@ in @MBlock.c@ stores the number of megablocks allocated.
-
-For implementation details, see @MBlock.c@, @MBlock.h@, @include/Block.h@. 
-
-\section{The block allocator}
-
-The block allocator divides a megablock returned by the megablock allocator
-into a contiguous group of \emph{block descriptors} followed by another 
-contiguous group of \emph{blocks}. 
-
-A block is a contiguous chunk of $2^K$ bytes, starting on 
-a $2^K$-byte boundary (@BLOCK_SIZE@ in 
-@include/Constants.h@ defines the size of blocks). 
-Each block has its own associated block descriptor, which records the
-current state of the block. 
-
-Figure~\ref{fig-megablock} shows a megablock after initialization by the 
-megablock allocator. 
-Block descriptors occupy the lower address space and blocks the higher address 
-space in the megablock. 
-A block is the unit of allocation for the block allocator. 
-That is, the block allocator hands over store to the heap allocator in multiples of 
-one block, where multiple heap objects may be allocated.
-A contiguous group of blocks, which is called a \emph{block group}, can be 
-directly handed over to the heap allocator to reduce inter-block 
-linkage costs.
-The first block of a block group is called the \emph{group head}.\footnote{
-An alternative design has the block descriptor at the start of each block.
-This makes it easy to locate the block descriptor corresponding to a particular
-block, but is pessimistic for cache locality when fiddling with block descriptors.
-It also means that only the first block in a contiguous chunk of blocks can
-have a block descriptor. This in turn makes it difficult to achieve an
-efficient mostly-copying conservative (MCC) garbage collector.}
-Since block descriptors are ordered linearly, we can always locate a block 
-descriptor corresponding to a particular block from the starting address 
-of the block.
-
-\begin{figure}[ht]
-\begin{center}
-\input{megablock.eepic}
-\caption{A megablock after initialization}
-\label{fig-megablock}
-\end{center}
-\end{figure}
-
-\subsection{Interface}
-
-\begin{description}
-\item[@typedef struct bdescr@] is the type of block descriptors.
-\item[@void initBlockAllocator(void)@] initializes the block allocator. 
-\item[@bdescr *allocBlock(void)@] requests a single block and returns 
-the address of its block descriptor. 
-\item[@bdescr *allocGroup(nat n)@] allocates a block group of size @n@ 
-and returns the address of the block descriptor for the group head.
-\item[@void freeGroup(bdescr *p)@] frees the block group where @p@ points
-to the block descriptor of the group head, and places it in a pool of
-free block groups. 
-\item[@bdescr *Bdescr(StgPtr p)@] takes a pointer @p@ to any byte within
-a block and returns a pointer to its block descriptor. It is implemented as
-an @inline@ procedure.
-\end{description}
-
-\subsection{Block descriptors}
-
-A block descriptor has the following structure, defined in 
-@include/Blocks.h@:
-
-\begin{code}
-typedef struct _bdescr {
-  StgPtr          start;
-  StgPtr          free; 
-  StgWord32       blocks;
-  struct _bdescr  *link;
-  /* additional fields */
-} bdescr;
-\end{code}
-
-The fields of a block descriptor have the following purposes:
-
-\begin{description}
-\item[@start@] points to the first byte of the corresponding block.
-\item[@free@] For a group head, @free@ points to the first free byte in 
-the block group. For a non-group head, @free@ is set to zero to identify
-the corresponding block as a non-group head.
-\item[@blocks@] For a group head, @blocks@ stores the number of blocks
-in the block group. It is not used for non-group heads.
-\item[@link@] For a group head, @link@ is used to chain all individual 
-blocks or block groups together. For a non-group head, @link@ points
-to the block descriptor of the group head.
-\end{description}
-
-\subsection{Implementation}
-
-The block allocator maintains a linked list of free block groups, whose head
-is stored in @free_list@ in @BlockAlloc.c@ (Figure~\ref{fig-freelist}).
-When @allocBlock()@ or @allocGroup()@ is called, the block allocator
-scans the linked list from @free_list@ and finds the first block group
-which can handle the request.
-If such a block group exists, it takes off the requested number of blocks
-from the block group, creates a new block group from them, 
-initializes it if needed, and returns it to the caller. 
-The rest of the old block group, if any, is linked back to the list of free block 
-groups as another block group. 
-If such a block group does not exist, the block allocator requests a megablock
-from the megablock allocator and processes the request using the new megablock.
-
-For implementation details, see @BlockAlloc.c@ and @include/Block.h@.
-
-\begin{figure}[ht]
-\begin{center}
-\input{freelist.eepic}
-\caption{Linked list of free block groups}
-\label{fig-freelist}
-\end{center}
-\end{figure}
-
-\section{Heap allocator}
-
-The role of the heap allocator in the storage manager is to allocate fresh
-memory upon requests from the mutator and the runtime system.
-Memory allocation takes place frequently during the execution of Haskell 
-programs, and hence its efficiency is crucial to the overall performance.
-To handle requests from the mutator and the runtime system efficiently,
-the heap allocator maintains three different memory stores,
-each of which has its own purpose.
-
-The first store is the \emph{nursery}, where typical Haskell 
-objects are born.
-The mutator itself can allocate fresh memory directly in the nursery 
-without invoking an interface function:
-the configuration of the nursery is always revealed to the mutator and can even
-be changed by the mutator when it allocates fresh memory from the nursery
-on its own.
-Thus, although the small overhead in manipulating the nursery results in fast
-memory allocation, it is up to the mutator to keep the nursery in an 
-uncorrupted state.
-
-The second and the third are the \emph{small object pool} and the
-\emph{large object pool}.
-The heap allocator provides a common interface function to be shared by both stores:
-the size of fresh memory requested, which is passed as an argument to the 
-interface function, determines which of the two stores to be used.
-The interface function can be called by both the mutator and the runtime system.
-
-\subsection{Interface}
-
-\begin{description}
-\item[@void initStorage(void)@] initializes the storage manager. @Storage.c@.
-\item[@void allocNurseries(void)@] creates and initializes the nursery. 
-@Storage.c@.
-\item[@void resetNurseries(void)@] re-initializes the nursery. @Storage.c@.
-\item[@OpenNursery(hp, hplim)@] opens an allocation area in the nursery and sets 
-@hp@ and @hplim@ appropriately. 
-Then the caller can freely use the memory from @hp@ to @hpLim@. 
-A macro in @include/StgStorage.h@.
-\item[@CloseNursery(hp)@] closes the current allocation area beginning at @hp@
-and returns it to the storage manager.
-A macro in @include/StgStorage.h@.
-\item[@ExtendNursery(hp, hplim)@] closes the current allocation area and 
-tries to find a new allocation area in the nursery. 
-If it succeeds, it sets @hp@ and @hplim@ appropriately and returns @rtsTrue@; 
-otherwise, it returns @rtsFalse@,
-which means that the nursery has been exhausted. 
-The new allocation area is not necessarily contiguous with the old one.
-A macro in @Storage.h@.
-\item[@StgPtr allocate(nat n)@] allocates @n@ words from either the small
-object pool or the large object pool, depending on the argument @n@, 
-and returns a pointer to the first byte. It \emph{always} succeeds.
-@Storage.c@.
-\end{description}
-
-\subsection{Implementation}
-
-The nursery is implemented with a fixed number of blocks (@nursery_blocks@
-in @Storage.c@ specifies the number of blocks). 
-Each of these blocks forms its own block group, and they are all linked together
-by @allocNurseries()@. 
-The blocks in the nursery are carefully allocated in a contiguous address
-range so that they fit next to each other in the cache.
-They are never freed. 
-
-A single block called the \emph{active block} provides the allocation area for
-the mutator at any moment.
-When the free space left in the active block is not enough for the request from 
-the mutator, the heap allocator sets the @free@ field in the corresponding
-block descriptor to the first free byte in the block and moves the allocation
-area to the next block. 
-
-Figure~\ref{fig-nursery} shows the configuration of the nursery during
-the mutator time.
-The head of the linked list is stored in @MainRegTable.rNursery@, and
-the address of the block descriptor of the active block is stored 
-in @MainRegTable.rCurrentNursery@.
-@Hp@, defined as @MainRegTable.rHp@, points to the byte before the first byte of 
-the current allocation area in the active block.
-@HpLim@, defines as @MainRegTable.rHpLim@, marks the boundary of the current 
-allocation area:
-it points to the last byte in the current allocation area, and thus
-all the bytes of memory addresses from @Hp@$ + 1$ to @HpLim@ are free.
-The mutator can obtain fresh memory simply by adjusting @Hp@ as long as the new
-value of @Hp@ does not exceed @HpLim@. For instance, if the mutator 
-increases @Hp@ by @n@, it can now store an object of size up to @n@ at the 
-address pointed to by the old value of @Hp@$ + 1$.
-
-When the runtime system runs, none of the above four pointers 
-(@MainRegTable.rNursery@, @MainRegTable.rCurrentNursery@, @Hp@ and @HpLim@) are 
-valid; they are simply aliases to registers.
-Instead @g0s0->blocks@\footnote{@g0s0->blocks@ is valid all the time, even during
-the mutator time.  The meaning of @g0s0@ is explained in the next section.} 
-can be used to retrieve the head of the linked list, and
-the @free@ field in each block descriptor points to the first free byte
-in its corresponding block.\footnote{To be precise, this is \emph{not} the
-case: a @free@ field may point to a byte past its actual boundary.
-This happens because
-the mutator first increases @hpLim@ without comparing it with the
-actual boundary when allocating fresh memory,
-and later assigns @hpLim@ to the @free@ of the corresponding block.}
-@Hp@ and @HpLim@ are not saved because they can be inferred from @free@ fields
-of the blocks descriptors in the nursery.
-
-\begin{figure}[ht]
-\begin{center}
-\input{nursery.eepic}
-\caption{Nursery during the mutator time}
-\label{fig-nursery}
-\end{center}
-\end{figure}
-
-The small object pool is implemented with a linked list of block groups, 
-each of which consists of a single block (Figure~\ref{fig-smallobjectpool}).
-The head of the linked list is stored in @small_alloc_list@ in @Storage.c@.
-
-\begin{figure}[ht]
-\begin{center}
-\input{smallobjectpool.eepic}
-\caption{Small object pool}
-\label{fig-smallobjectpool}
-\end{center}
-\end{figure}
-
-The allocation in the small object pool is done in the same way as in the
-nursery; @alloc_Hp@ and @alloc_HpLim@ (both defined in @Storage.c@) 
-point to the first free byte and the boundary of the small object pool, 
-respectively.
-Thus, when @allocate()@ is called and the heap allocator decides to 
-allocate fresh memory in the small object pool, it simply increases @alloc_Hp@
-by the size of memory requested. 
-If the allocation cannot be done in the current small object pool, the 
-heap allocator calls @allocBlock()@ to obtain a new block from the block
-allocator, puts it to the head of the linked list, and 
-sets @alloc_Hp@ and @alloc_HpLim@ appropriately.
-
-The large object pool is also implemented with a (doubly) linked list of block
-groups (Figure~\ref{fig-largeobjectpool}). 
-The difference from the small object pool is that each block group stores only 
-a single object: each time the argument to @allocate()@ is
-greater than a threshold value (computed from @LARGE_OBJECT_THRESHOLD@ 
-in @include/Constants.h@), a new block group accommodating the requested size 
-is created to store a single object. 
-The new block group is put to the head of the list. 
-The head of the linked list is available as @g0s0->large_objects@.
-
-\begin{figure}[ht]
-\begin{center}
-\input{largeobjectpool.eepic}
-\caption{Large object pool}
-\label{fig-largeobjectpool}
-\end{center}
-\end{figure}
-
-For implementation details, see @Storage.c@ and @include/StgStorage.h@.
-
-\section{Garbage collector}
-
-The garbage collector finds all the objects unreachable from a given set of
-roots and frees the memory allocated to them. By invoking the
-garbage collector regularly, the storage manager prevents the heap from
-growing indefinitely and allows Haskell programs to be executed at a 
-reasonable memory cost.
-
-The garbage collector in the storage manager is based upon the generational 
-garbage collection algorithm.
-The storage manager records the age for every object in the heap.
-An object surviving one garbage collection grows old by one \emph{step},
-and an object surviving a certain number of garbage collections 
-is promoted to the next \emph{generation}.
-That is, a step can be defined as a collection of objects which have survived
-the same number of garbage collections (or a collection of objects which are
-born at some point between two particular successive garbage collections),
-and a generation as a group of steps belonging to a certain range of ages.
-Notice that the unit of garbage collections is not step but generation: 
-a garbage collection applies to all the steps in a generation, and we cannot 
-perform a garbage collection just on part of a generation.
-Furthermore, if a particular generation is garbage collected, so are 
-all the younger generations.\footnote{Some 
-authors define a generation as the set of 
-all the objects created between two particular garbage collection and
-an object cannot change its generation (e.g., 1960's, 1970's, and so on).
-In this document, 
-an object can change its generation as it survives garbage collections
-(e.g., teenagers, 20's, and so on).}
-
-Figure~\ref{fig-generation} illustrates how an object grows old.
-Every object is created in step $0$ of generation $0$. 
-As it survives garbage collections, it is moved to the next step of the
-same generation until it is finally promoted to 
-step $0$ of the next generation:
-during a garbage collection of generation $g < G$, live objects from 
-step $s < S_g$ are moved to step $s + 1$, and live objects from
-the last step $S_g$ are promoted to step $0$ in generation $g + 1$.
-Live objects in step $0$ of generation $G$ stay in the same step;
-the oldest generation maintains only one step because there is no point
-in aging objects in the oldest generation.
-In this way, objects are given a decent chance of dying before being
-promoted to the next generation.
-
-\begin{figure}[ht]
-\begin{center}
-\input{generation.eepic}
-\caption{Evolution of objects through garbage collections}
-\label{fig-generation}
-\end{center}
-\end{figure}
-
-The main reason that we separate steps from generations is to
-reduce the cost of maintaining \emph{backward inter-generational pointers},
-that is, pointers from older generations to younger generations.
-Suppose that a garbage collection applies to all generations $0$
-through $g$. If an object @O@ in one of these generations is pointed to
-by another object in generation $g' > g$, we cannot free the object @O@
-even though generation $g'$ is out of consideration. Consequently
-we have to track backward inter-generational pointers to perform garbage
-collections correctly.
-Since maintaining backward pointers is costly, we
-choose to track backward inter-generational pointers only;
-we do not track backward inter-step pointers.
-
-By grouping all the objects created between two garbage collections
-and grouping multiple age groups into one generation, the garbage
-collector makes an efficient use of heap memory.
-
-\subsection{Interface}
-
-\begin{description}
-%\item[@StgClosure *MarkRoot(StgClosure *root)@] informs the garbage collector
-%that @root@ is an object in the root set. It returns the new location of 
-%the object. @GC.c@.
-\item[@void *mark\_root(StgClosure **root)@] informs the garbage collector
-that @*root@ is an object in the root set. It replaces @*root@ by 
-the new location of the object. @GC.c@.
-\item[@void GarbageCollect(void (*get\_roots)(evac\_fn), rtsBool force\_major\_gc)@]
-performs a garbage collection. 
-@get_roots()@ is a function which is called by the garbage collector when
-it wishes to find all the objects in the root set (other than those
-it can find itself).
-Therefore it is incumbent on the caller to find the root set.
-@force_major_gc@ specifies whether a major garbage collection is required
-or not. If a major garbage collection is not required, the garbage collector
-decides an oldest generation $g$ to garbage collect on its own.
-@GC.c@.
-\item[@rtsBool doYouWantToGC(void)@] returns @rtsTrue@ if the garbage
-collector is ready to perform a garbage collection. Specifically, it returns
-@rtsTrue@ if the number of allocated blocks since the last garbage collection
-(@alloc_blocks@ in @Storage.c@) exceeds an approximate limit 
-(@alloc_blocks_lim@ in @Storage.c@).
-@Storage.h@.
-\item[@void recordMutable(StgMutClosure *p)@] informs the garbage collector
-that a previously immutable object @p@ has become mutable.
-The garbage collector then puts the object @p@ in the list @mut_list@ of the 
-generation to which it belongs.\footnote{It is easy to 
-locate the generation to which a dynamic object belongs from its address: 
-we can identify the block in which the object resides from its address,
-and the corresponding block descriptor stores pointers 
-to the step and the generation (@gen@ and @step@ fields in the @bdescr@ 
-structure) to which it belongs.}
-It suffices to call @RecordMutable()@ only once for any object. 
-
-For an object which is genuinely mutable (e.g., mutable arrays), 
-it is permanently recorded as mutable. 
-On the other hand, 
-an object which is temporarily mutable (e.g., frozen arrays),
-can be dropped from the list @mut_list@ once its pointer has been dealt with
-during garbage collections. @Storage.h@.
-\item[@void recordOldToNewPtrs(StgMutClosure *p)@] puts the object @p@ in the
-list @mut_once_list@ of the generation to which it belongs.
-\item[@void newCAF(StgClosure *caf)@] puts the CAF @caf@ either 
-in the list @caf_list@ or
-in the list @mut_once_list@ of the oldest generation,
-depending on whether it is dynamically loaded or not.
-\end{description}
-
-\subsection{Steps}
-
-A step has the following structure, defined in 
-@include/StgStorage.h@:
-
-\begin{code}
-typedef struct _step {
-  unsigned int no;
-  bdescr *blocks;
-  unsigned int n_blocks;
-  bdescr *large_objects;
-  /* additional fields */
-} step;
-\end{code}
-
-The fields of a step have the following purposes (Figure~\ref{fig-step}):
-
-\begin{description}
-\item[@no@] indicates the age within its generation. 
-$0$ indicates the youngest step in a generation.
-\item[@blocks@] is a linked list of all the blocks in this step 
-which contain small objects.
-Each block forms its own block group.
-\item[@n\_blocks@] is the number of blocks in the linked list @blocks@.
-\item[@large\_objects@] is a (doubly) linked list of all the block groups 
-in this step which contain large objects. 
-Each block group stores only a single object.
-\end{description}
-
-\begin{figure}[ht]
-\begin{center}
-\input{step.eepic}
-\caption{Memory layout of a step}
-\label{fig-step}
-\end{center}
-\end{figure}
-
-The linked list @blocks@ of step $s$ in generation $g$ is created 
-during a garbage collection
-from live small objects of step $s - 1$ in the same generation 
-(or the last step in the previous generation if $s = 0$).
-The @free@ field in every block descriptor never changes because
-no objects are added after the garbage collection; new objects are created 
-only in step $0$ in generation $0$.
-Likewise, the linked list @large_objects@ is created during a
-garbage collection from live large objects of the previous step. 
-
-There are three exceptions to the above rules. 
-First, both @blocks@ and @large_objects@ of
-step $0$ in generation $0$ are not filled with new objects during a garbage 
-collection. 
-They are simply re-initialized by the garbage collector and 
-grow during during the execution of a program as new objects are
-created.
-Step $0$ in generation $0$ is accessible via a global variable @g0s0@, 
-and this is the reason why the large object pool (described in the previous 
-section) is indeed stored in @g0s0->large_objects@. 
-For the same reason, @MainRegTable.rNursery@ holds the same address as 
-@g0s0->blocks@ during the mutator time.
-Second, @blocks@ of step $1$ in generation $0$ is created not only from
-the nursery (@blocks@ of step $0$ in the same generation) but also from the 
-small object pool. In other words, all the live small objects created since
-the previous garbage collection, either directly by the mutator or indirectly
-through @allocate()@, are gathered together in the same linked list.
-Finally, step $0$ of the oldest generation serves the source for itself during
-any garbage collection, i.e., $S_G = 1$, because there exists no older step.
-
-\subsection{Generations}
-
-A generation has the following structure, defined in 
-@include/StgStorage.h@:
-
-\begin{code}
-typedef struct _generation {
-  unsigned int no;
-  step *steps;
-  unsigned int n_steps;
-  unsigned int max_blocks;
-  StgMutClosure *mut_list;
-  StgMutClosure *mut_once_list;
-  /* additional fields */
-} generation;
-\end{code}
-
-The fields of a generation have the following purposes (Figure~\ref{fig-gen}):
-
-\begin{description}
-\item[@no@] is the generation number.
-\item[@steps@] points to an array of @step@ structures. @steps[@$i$@]@ 
-corresponds to step $i$ in this generation, i.e., 
-@steps[@$i$@].no@ is equal to $i$.
-\item[@n\_steps@] is the number of @step@ structures in the array pointed to 
-by @steps@.
-\item[@max\_blocks@] is the maximum number of blocks allowed in step $0$ of
-this generation. If the number of blocks allocated 
-in step @0@ exceeds @max_blocks@,
-this generation is garbage collected during the next garbage collection.
-\item[@mut\_list@] links all mutable objects in this generation, that is,
-objects whose contents can be updated and hence may contain pointers to
-younger generations. 
-Every object in this linked list is a dynamic object residing in the heap 
-and has a structure compatible with @StgMutClosure@.
-The structure @StgMutClosure@ (@includes/Closures.h@) has a field 
-@mut_link@ (called a mutable link field) of type @StgMutClosure *@, which
-points to the next object in this linked list.
-The end mark of this linked list is a pointer to a statically allocated object 
-@END_MUT_LIST@ (@StoragePriv.h@).
-\item[@mut\_once\_list@] links objects in this generation whose contents 
-cannot be updated any more but may already have pointers to younger generations.
-As with @mut_list@, it links only those objects whose structure is compatible
-with @StgMutClosure@ and ends with @END_MUT_LIST@.
-\end{description}
-
-\begin{figure}[ht]
-\begin{center}
-\input{gen.eepic}
-\caption{Memory layout of a generation}
-\label{fig-gen}
-\end{center}
-\end{figure}
-
-The garbage collector maintains an array @generations@ of @generation@ structure
-(defined in @Storage.c@), whose size is stored in a runtime system flag 
-(@RtsFlags.GcFlags.generations@). 
-The generation number of each generation coincides with its index into
-the array @generations@, i.e.,  @generations[@$i$@].no@ is equal to $i$.
-
-As mentioned before, lists of objects which may have pointers to younger
-generations are kept per generation, not per step. The youngest generation,
-accessible via a global variable @g0@, does not keep such a list because it
-does not have younger generations.
-
-The oldest generation, accessible via a global variable @oldest_gen@, may
-contain static objects (as opposed to dynamic objects residing in the heap)
-in its list @mut_once_list@. This happens when a static
-thunk, also known as a \emph{constant applicative form} (CAF), is entered.
-When a CAF (corresponding to closure type @THUNK_STATIC@, defined
-in @includes/ClosureTypes.h@) is entered, 
-it is first put in the list @mut_once_list@ of the oldest generation
-and then overwritten with an appropriate static indirection object 
-(corresponding to closure type @IND_STATIC@).\footnote{Actually a static 
-indirection object does not have a @mut\_link@ field.
-We use its @static\_link@ field as a substitute for @mut\_link@.
-See the structure @StgIndStatic@ in @include/Closures.h@.}\footnote{For
-details of this operation, see the macro @UPD\_CAF()@ in @includes/Updates.h@}
-If the CAF is dynamically loaded (e.g., in an interactive environment), it is 
-instead put in a separate linked list @caf_list@ 
-(declared in @Storage.c@). 
-
-The evaluation result of the 
-CAF is stored in a separate dynamic object in the heap and the static 
-indirection object has a pointer to the dynamic object.
-Thus, the new static indirection object is put in the list 
-@mut_once_list@ of the oldest generation (or the list @caf_list@) so that the 
-dynamic object is not removed during the next garbage collection.
-Once it is created, the static indirection object remains unaltered, which
-is the reason why it is put in the @mut_once_list@ list, not in the 
-@mut_list@ list.
-Since the static indirection object survives any garbage collection (because
-it comes from a static object) and would be eventually moved to the oldest 
-generation,
-we put it in the @mut_once_list@ of the oldest generation as soon
-as it is created.
-
-\subsection{Implementation}
-
-The overall structure of a garbage collection is as follows:
-
-\begin{enumerate}
-\item[(1)] Initialize.
-\item[(2)] Scavenge lists @mut_once_list@ and @mut_list@ if necessary.
-\item[(3)] Scavenge CAFs.
-\item[(4)] Evacuate roots.
-\item[(5)] Scavenge objects.
-\item[(6)] Tidy up.
-\end{enumerate}
-
-\subsubsection{(1) Initialization}
-
-During initialization, the garbage collector first decides which generation
-to garbage collect.
-Specifically, 
-if the argument @force_major_gc@ to @GarbageCollect()@ is @rtsFalse@,
-it decides the greatest generation number $N$ such
-that the number of blocks allocated in step $0$ of generation $N$ exceeds
-@generations[@$N$@].max_blocks@. 
-If the argument @force_major_gc@ to @GarbageCollect()@ is @rtsTrue@,
-$N$ is set to the greatest generation number, namely, 
-$@RtsFlags.GcFlags.generations@ - 1$.
-The garbage collector considers up to generation $N$ for garbage collection.
-A major garbage collection takes place if $N$ is set to 
-$@RtsFlags.GcFlags.generations@ - 1$ during this process.
-
-Then, the garbage collector initialize the \emph{to-space} (as opposed to
-\emph{from-space}) for each step of 
-each generation, which is complete with an \emph{allocation pointer} and
-an \emph{sweep pointer}.
-The to-space of a step is the memory to which any object belonging to the
-step can be copied when it survives a garbage collection.
-For instance, a live object in step $s$ of generation $g$ can first be copied
-to the to-space associated with step $s$, which eventually becomes 
-associated with the next step $s + 1$ (or step $0$ of the next generation)
-during tidying up.
-This operation effectively moves an object to the next step if it survives
-a garbage collection. 
-The allocation pointer points to the next free in the to-space while 
-the sweep pointer points to the next object considered for scavenging.
-
-During major garbage collections,
-the static link field of every static object indicates whether it has
-been visited by the garbage collector or not.
-Therefore, the static link field of every static object must have
-a null value before a major garbage collection starts. 
-The list @mut_once_list@ of the oldest generation may contain static 
-indirection objects, and thus 
-the garbage collector invokes @zero_mutable_list()@ on the list,
-Although this breaks up the list, it does not cause any problem because 
-the list is not employed during major garbage collections.
-
-\subsubsection{\tt evacuate()}
-
-The function @evacuate()@ (defined in @GC.c@), which 
-is called eventually for every live object 
-(including even static objects reachable from roots),
-moves an object to
-a safe place so as not to be garbage collected.
-Before invoking the function @evacuate()@ on an object @o@, the caller specifies
-a \emph{desired generation} for @o@ in a variable @evac_gen@
-(declared in @GC.c@).
-The desired generation is the youngest generation to which the caller wishes 
-@o@ to be evacuated; the garbage collector should evacuate @o@ to a 
-generation no younger than the desired generation.
-
-Depending on @evac_gen@ and the generation $M$ where @o@ currently resides,
-@evacuate()@ behaves itself as follows:
-\begin{itemize}
-\item If @evac_gen@ $\leq M$ and $N < M$, it does nothing because @o@ is already
-      in a generation no younger than @evac_gen@.
-\item If @evac_gen@ $\leq M \leq N$, it evacuates @o@ to the to-space of the 
-step to which @o@ currently belongs. @o@ will be moved to the next step later.
-@recordMutable()@ may be invoked on @o@ depending on its type (e.g., @MVAR@).
-\item If $M <$ @evac_gen@, @o@ is evacuated to the to-space of step $0$
-      of generation @even_gen@, which accomplishes the request.
-      This happens even when $N \leq$ @evac_gen@. Therefore, those generations
-      which are not considered for garbage collection may still be augmented
-      with new objects during garbage collection.
-      @recordMutable()@ may be invoked on @o@ depending on its type.
-\end{itemize}
-If @o@ has already been evacuated, @evacuate()@ either does nothing (when
-@even_gen@ $\leq M$) or reports
-a failure to evacuate @o@ by setting the flag @failed_to_evac@ (declared
-in @GC.c@). 
-
-Evacuating a large object is handled by @evacuate_large()@.  
-Since it is costly to allocate new memory blocks and copy all the contents
-of the object, the garbage collector simply removes the object form
-the list @large_alloc_list@ of its step and links it to another list,
-from which it will be scavenged later.
-
-\subsubsection{Set of roots for garbage collection}
-Part of the set of roots for garbage collection is obtained indirectly by 
-invoking the function
-@get_roots()@, an argument to @GarbageCollect()@: the garbage collector
-invokes @get_roots()@ with @mark_root()@ as an argument, and @get_roots()@
-in turn invokes @mark_root()@ on each of known roots.
-The rest of the set of roots is obtained from the lists @mut_list@ and
-@mut_once_list@ of generation $N + 1$ through the oldest generation:
-any objects in these lists may have pointers to objects in generations
-$0$ to $N$, and thus must be considered as a root.
-If a major garbage collection takes place, no @mut_list@ and @mut_once_list@
-lists are consider for scavenging and step (2) is skipped.
-The entire set of roots is now specified by @get_roots()@ alone.
-
-\subsubsection{(2) Scavenging lists {\tt mut\_once\_list} and {\tt mut\_list}}
-
-Since the roots obtained from the lists @mut_list@ and @mut_once_list@ are
-already in generations $N' > N$, we only have to scavenge them.
-That is, it suffices to invoke @evacuate()@ once on each object 
-which is currently pointed to by an object in these lists. 
-
-When scavenging an object @r@ in the list @mut_once_list@ of generation $M$,
-the desired generation is set to $M$ for each object @o@ pointed
-to by @r@ before invoking @evacuate()@. 
-The rationale is that the contents of @r@ cannot be updated any more,
-and thus @r@ is always survived by @o@; @o@ is live as long as @r@ is.
-Therefore, we wish @r@ to be evacuated to the same generation $M$ as @r@
-currently resides (not to its next step).
-If the evacuation succeeds (indicated by a @rtsFalse@ value of a variable
-@failed_to_evac@, declared in @GC.c@) for every object @o@, @r@ is removed 
-from the list @mut_once_list@ because it does not hold any backward 
-inter-generational pointers.\footnote{It turns out that @r@ can have only
-one such object @o@. The type of @r@ is one of the following:
-@IND\_OLDGEN@, @IND\_OLDGEN\_PERM@, @IND\_STATIC@, and @MUT\_VAR@.}
-
-Scavenging a list @mut_list@ is similar to the case of @mut_once_list@.
-When scavenging an object @r@ in the list @mut_list@ of generation $M$,
-the desired generation is set to $M$ for each object pointed to by @r@
-if @r@ is known to be immutable (e.g., @MUT_ARR_PTRS_FROZEN@, 
-@IND_OLDGEN@)
-or to $0$ if @r@ is still mutable (e.g., @MUT_ARR_PTRS@, @MUT_VAR@).
-The list @mut_once_list@ is also adjusted if it is safe to remove @r@ from
-@mut_list@. 
-
-\subsubsection{(3) Scavenging CAFs}
-
-When a dynamically loaded CAF is entered, it it first put to the list 
-@caf_list@ and then overwritten with a static indirection object.
-The evaluation result of the CAF is stored in a dynamic object in the heap
-and the static indirection object stores a pointer to the dynamic object.
-Although the static indirection object (or the CAF) itself is never freed, 
-it may be removed later from the @caf_list@ when it is reverted to the 
-original CAF, and the dynamic object may not be live afterwards.
-Hence, we treat the dynamic object just as normal dynamic objects and
-set the desired generation to $0$.
-
-\subsubsection{(4) Evacuating roots}
-
-Evacuating roots (other than those in the lists @mut_once_list@ and 
-@mut_list@) is simply done by invoking @get_roots()@ with @mark_root()@
-as an argument. 
-Since these roots are normal dynamic objects, we set the desired generation
-to $0$.
-
-\subsubsection{(5) Scavenging}
-
-The garbage collector scavenges all the objects in the to-space of
-each step (by invoking @evacuate()@ on each object reachable from them) 
-until every sweep pointer has reached its corresponding 
-allocation pointer. 
-It repeatedly examines all the to-spaces because not only sweep pointers
-but also allocation pointers change during scavenging:
-when an object @r@ is scavenged, each object reachable from 
-@r@ is evacuated to a certain to-space, which increases the corresponding
-allocation pointer, and
-the sweep pointer of the to-space which currently contains @r@
-increases as well upon finishing scavenging the object @r@.
-Thus, the garbage collector cannot anticipate in advance how many times 
-it needs to scan through all the to-spaces; it keeps scavenging until
-no objects are left to be scavenged.
-
-\subsubsection{Scavenging static objects}
-
-Since it is possible for dynamic objects to point to static objects,
-the garbage collector may invoke @evacuate()@ on static objects 
-while scavenging dynamic objects in to-spaces.
-This complicates the garbage collector because 
-static objects cannot be evacuated in general yet
-they may have pointers to dynamic objects, which must be evacuated.
-Thus the garbage collector needs to at least scavenge live static objects
-(as opposed to those static objects currently not reachable from roots).
-
-When a minor garbage collection is performed, any invocation of
-@evacuate()@ on static objects is simply ignored. 
-Furthermore, no static object is considered for scavenging
-(except those in the list @mut_once_list@ of the oldest generation during).
-Still all dynamic objects which are marked as live due to static objects
-are safely evacuated.
-The reason is that we can reach all such dynamic objects from 
-indirection static objects stored in the list 
-@mut_once_list@ of the oldest generation, which is scavenged during step (2),
-and the list @caf_list@.
-In other words, in order to evacuate all such dynamic objects, it is 
-sufficient to evacuate all dynamic objects reachable from 
-static indirection objects in 
-the list @mut_once_list@ of the oldest generation and the list @caf_list@.
-However, the garbage collector may unnecessarily scavenge certain static 
-indirection objects which are no longer used.
-They are not scavenged during a major garbage collection, however.
-
-During a major garbage collection,
-if an invocation of @evacuate()@ on a static object @r@ is made,
-the garbage collector first checks whether @r@ needs to be scavenged or not.
-If its SRT (Static Reference Table) is empty and it has no other pointers, 
-no dynamic objects are reachable from @r@ and it is ignored.\footnote{If 
-no dynamic objects are reachable from a static object @r@ (even indirectly
-via multiple static objects),
-@r@ is not stored in \emph{any} SRT table because it would be no use attempting
-to follow any pointers in @r@.}
-Otherwise, it is put in the list @static_objects@.
-At the beginning of each scavenging loop in step (5), 
-the garbage collector invokes @scavenge_static()@ if the list @static_objects@
-is not empty.
-@scavenge_static()@ scavenges the static objects in the list @static_objects@
-by invoking @evacuate()@ on every object reachable from them.
-The desired generation is set to the oldest generation (because any
-dynamic object directly pointed to by a static object lives 
-forever).
-These static objects are then put in another list @scavenged_static_objects@
-and removed from the list @static_objects@.
-For a static indirection object, if the evacuation 
-fails, it is put back to the list @mut_once_list@ of the oldest generation;
-it can be thought of as a CAF just entered.
-
-After a major garbage collection, therefore, the list @scavenged_static_objects@
-links all live static objects except for static indirection objects put back
-to the list @mut_once_list@ of the oldest generation. 
-Dynamically loaded CAFs are found in the list @caf_list@.
-
-\subsubsection{(6) Tidying up}
-
-The garbage collector tidies up the heap by 
-moving the to-space of each step to the next step. 
-It also re-initialize the small object pool (which now does not contain
-any live objects), frees any large objects which have not been scavenged,
-and invokes @resetNurseries()@.
-If a major garbage collection has been performed, it 
-invokes @zero_static_object_list()@ on the list @scavenged_static_objects@ 
-so that all static objects
-(other than those in the list @mut_once_list@ of the oldest generation)
-have a null static link field again.
-
-At this point, both the small allocation pool and the large object pool are
-empty. Upon the exit from @GarbageCollect()@, however, they may not
-be empty any more because the garbage collector invokes @scheduleFinalizer()@
-before exiting, which tries to run pending finalizers on dead weak pointers and 
-may create new objects through @allocate()@.
-The nursery still remains intact.
-
-The heap may contain extra objects which are not reachable from the roots
-used during the garbage collection: 1) weak head pointers; 2) dead
-weak head pointers. Weak head pointers can be tracked from 
-the list @weak_ptr_list@ (declared in @Weak.c@). However, there is no way
-of reaching dead weak pointers; they will be garbage collected during the
-next garbage collection.
-
-For implementation details, see @GC.c@.
-
-\section{State of the heap allocator and the garbage collector}
-
-The state of the heap allocator and the garbage collector is fully specified by the 
-following variables:
-
-\begin{description}
-\item[@small\_alloc\_list@] is the header of the small object pool.
-\item[@alloc\_Hp@] points to the first free byte in the small object pool.
-\item[@alloc\_HpLim@] points to the boundary of the small object pool.
-\item[@generations@] is the array of @generation@ structures.
-\item[@RtsFlags.GcFlags.generations@] specifies the number of elements in 
-the array @generations@.
-\item[@caf\_list@] links dynamically loaded CAFs.
-\end{description}
-
-\textbf{To do:} check if this is a complete list.
-
-The following variables are derivable, but they are given special purposes:
-
-\begin{description}
-\item[@g0s0@] points to step 0 of the youngest generation.
-\item[@oldest\_gen@] points to the oldest generation.
-\item[@g0s0->blocks@] is the header of the nursery.
-\item[@g0s0->large\_blocks@] is the header of the large object pool.
-\end{description}
-
-\section{Miscellaneous notes}
-
-\begin{itemize}
-\item To see how to add new fields to Haskell closures, 
-see the document on the implementation of retainer profiling 
-(section `Adding Retainer Set Fields').
-
-\item To see how to traverse the graph and visit every live closure,
-see the document on the implementation of retainer profiling
-(section `Graph Traversal').
-
-\item To see how to linearly scan the heap at any random moment during
-program execution, see the document on the implementation of LDVU profiling
-(section `Heap Censuses').
-
-\item To see how to linearly scan the from-space during garbage collections,
-see the document on the implementation of LDVU profiling
-(section `Destruction of Closures').
-
-\end{itemize}
-
-\end{document}
diff --git a/ghc/docs/storage-mgt/smallobjectpool.eepic b/ghc/docs/storage-mgt/smallobjectpool.eepic
deleted file mode 100644
index 0ccf61c3fb..0000000000
--- a/ghc/docs/storage-mgt/smallobjectpool.eepic
+++ /dev/null
@@ -1,65 +0,0 @@
-\setlength{\unitlength}{0.00050000in}
-%
-\begingroup\makeatletter\ifx\SetFigFont\undefined%
-\gdef\SetFigFont#1#2#3#4#5{%
-  \reset@font\fontsize{#1}{#2pt}%
-  \fontfamily{#3}\fontseries{#4}\fontshape{#5}%
-  \selectfont}%
-\fi\endgroup%
-{\renewcommand{\dashlinestretch}{30}
-\begin{picture}(10062,5607)(0,-10)
-\path(3375,5262)(4950,5262)(4950,4062)
-	(3375,4062)(3375,5262)
-\path(4125,5112)(4125,5562)(6750,5562)(6750,5262)
-\path(6720.000,5382.000)(6750.000,5262.000)(6780.000,5382.000)
-\path(6750,5262)(10050,5262)(10050,4062)
-	(6750,4062)(6750,5262)
-\path(6870.000,4692.000)(6750.000,4662.000)(6870.000,4632.000)
-\path(6750,4662)(8625,4662)
-\path(8505.000,4632.000)(8625.000,4662.000)(8505.000,4692.000)
-\path(8625,5262)(8625,4062)
-\path(8025,3387)(8625,3387)(8625,4062)
-\path(8655.000,3942.000)(8625.000,4062.000)(8595.000,3942.000)
-\path(8400,2937)(10050,2937)(10050,4062)
-\path(10080.000,3942.000)(10050.000,4062.000)(10020.000,3942.000)
-\path(3525,4212)(2925,4212)(2925,2712)
-\path(2895.000,2832.000)(2925.000,2712.000)(2955.000,2832.000)
-\path(1950,4962)(3375,4962)
-\path(3255.000,4932.000)(3375.000,4962.000)(3255.000,4992.000)
-\path(2925,2262)(2925,1737)(3300,1737)
-\path(3180.000,1707.000)(3300.000,1737.000)(3180.000,1767.000)
-\path(3300,1812)(4875,1812)(4875,612)
-	(3300,612)(3300,1812)
-\path(4050,1662)(4050,2112)(6675,2112)(6675,1812)
-\path(6645.000,1932.000)(6675.000,1812.000)(6705.000,1932.000)
-\path(9750,1812)(9750,612)
-\path(6675,1812)(9975,1812)(9975,612)
-	(6675,612)(6675,1812)
-\path(3450,762)(2850,762)(2850,237)
-\path(2820.000,357.000)(2850.000,237.000)(2880.000,357.000)
-\path(6795.000,1242.000)(6675.000,1212.000)(6795.000,1182.000)
-\path(6675,1212)(9750,1212)
-\path(9630.000,1182.000)(9750.000,1212.000)(9630.000,1242.000)
-\path(3900,1362)(5850,1362)(5850,12)
-	(9750,12)(9750,612)
-\path(9780.000,492.000)(9750.000,612.000)(9720.000,492.000)
-\put(3450,5037){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(3600,4137){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(3450,4437){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=1}}}}}
-\put(7425,5412){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}single block}}}}}
-\put(6900,4812){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}used memory}}}}}
-\put(8850,4812){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(8850,4527){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}memory}}}}}
-\put(2700,2487){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(0,4887){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}small\_alloc\_list}}}}}
-\put(6825,3312){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}alloc\_Hp}}}}}
-\put(6600,2862){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}alloc\_HpLim}}}}}
-\put(3375,1587){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(3525,687){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(3375,987){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=1}}}}}
-\put(7350,1962){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}single block}}}}}
-\put(7350,1362){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}used memory}}}}}
-\put(2625,12){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(3375,1302){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\end{picture}
-}
diff --git a/ghc/docs/storage-mgt/smallobjectpool.fig b/ghc/docs/storage-mgt/smallobjectpool.fig
deleted file mode 100644
index afcfe9862d..0000000000
--- a/ghc/docs/storage-mgt/smallobjectpool.fig
+++ /dev/null
@@ -1,74 +0,0 @@
-#FIG 3.2
-Landscape
-Center
-Inches
-Letter  
-60.00
-Single
--2
-1200 2
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6225 3900 7800 3900 7800 5100 6225 5100 6225 3900
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 6975 4050 6975 3600 9600 3600 9600 3900
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9600 3900 12900 3900 12900 5100 9600 5100 9600 3900
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 9600 4500 11475 4500
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 11475 3900 11475 5100
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 3
-	0 0 1.00 60.00 120.00
-	 10875 5775 11475 5775 11475 5100
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 3
-	0 0 1.00 60.00 120.00
-	 11250 6225 12900 6225 12900 5100
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 3
-	0 0 1.00 60.00 120.00
-	 6375 4950 5775 4950 5775 6450
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 2
-	0 0 1.00 60.00 120.00
-	 4800 4200 6225 4200
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 3
-	0 0 1.00 60.00 120.00
-	 5775 6900 5775 7425 6150 7425
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6150 7350 7725 7350 7725 8550 6150 8550 6150 7350
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 6900 7500 6900 7050 9525 7050 9525 7350
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 12600 7350 12600 8550
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9525 7350 12825 7350 12825 8550 9525 8550 9525 7350
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 3
-	0 0 1.00 60.00 120.00
-	 6300 8400 5700 8400 5700 8925
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 9525 7950 12600 7950
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 5
-	0 0 1.00 60.00 120.00
-	 6750 7800 8700 7800 8700 9150 12600 9150 12600 8550
-4 0 0 50 0 0 17 0.0000 4 150 435 6300 4125 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6450 5025 link\001
-4 0 0 50 0 0 17 0.0000 4 165 885 6300 4725 blocks=1\001
-4 0 0 50 0 0 17 0.0000 4 225 1185 10275 3750 single block\001
-4 0 0 50 0 0 17 0.0000 4 225 1320 9750 4350 used memory\001
-4 0 0 50 0 0 17 0.0000 4 165 390 11700 4350 free\001
-4 0 0 50 0 0 17 0.0000 4 180 825 11700 4635 memory\001
-4 0 0 50 0 0 17 0.0000 4 30 360 5550 6675 ......\001
-4 0 0 50 0 0 17 0.0000 4 195 1575 2850 4275 small_alloc_list\001
-4 0 0 50 0 0 17 0.0000 4 225 900 9675 5850 alloc_Hp\001
-4 0 0 50 0 0 17 0.0000 4 225 1320 9450 6300 alloc_HpLim\001
-4 0 0 50 0 0 17 0.0000 4 150 435 6225 7575 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6375 8475 link\001
-4 0 0 50 0 0 17 0.0000 4 165 885 6225 8175 blocks=1\001
-4 0 0 50 0 0 17 0.0000 4 225 1185 10200 7200 single block\001
-4 0 0 50 0 0 17 0.0000 4 225 1320 10200 7800 used memory\001
-4 0 0 50 0 0 17 0.0000 4 30 360 5475 9150 ......\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6225 7860 free\001
diff --git a/ghc/docs/storage-mgt/step.eepic b/ghc/docs/storage-mgt/step.eepic
deleted file mode 100644
index d5af2b7b04..0000000000
--- a/ghc/docs/storage-mgt/step.eepic
+++ /dev/null
@@ -1,121 +0,0 @@
-\setlength{\unitlength}{0.00050000in}
-%
-\begingroup\makeatletter\ifx\SetFigFont\undefined%
-\gdef\SetFigFont#1#2#3#4#5{%
-  \reset@font\fontsize{#1}{#2pt}%
-  \fontfamily{#3}\fontseries{#4}\fontshape{#5}%
-  \selectfont}%
-\fi\endgroup%
-{\renewcommand{\dashlinestretch}{30}
-\begin{picture}(10749,10689)(0,-10)
-\path(7437,4362)(10737,4362)(10737,3162)
-	(7437,3162)(7437,4362)
-\path(7557.000,3792.000)(7437.000,3762.000)(7557.000,3732.000)
-\path(7437,3762)(10587,3762)
-\path(10467.000,3732.000)(10587.000,3762.000)(10467.000,3792.000)
-\path(10587,4362)(10587,3162)
-\put(8637,4437){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks}}}}}
-\put(8412,3912){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}single object}}}}}
-\path(7437,2262)(10737,2262)(10737,1062)
-	(7437,1062)(7437,2262)
-\path(7557.000,1692.000)(7437.000,1662.000)(7557.000,1632.000)
-\path(7437,1662)(10587,1662)
-\path(10467.000,1632.000)(10587.000,1662.000)(10467.000,1692.000)
-\path(10587,2262)(10587,1062)
-\put(8637,2337){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks}}}}}
-\put(8412,1812){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}single object}}}}}
-\path(3912,2262)(5487,2262)(5487,1062)
-	(3912,1062)(3912,2262)
-\path(4662,2112)(4662,2562)(7437,2562)(7437,2262)
-\path(7407.000,2382.000)(7437.000,2262.000)(7467.000,2382.000)
-\path(4812,1812)(4812,2562)
-\path(5487,2262)(5937,2262)(5937,1062)
-	(5487,1062)(5487,2262)
-\path(5937,2262)(6387,2262)(6387,1062)
-	(5937,1062)(5937,2262)
-\path(6387,2262)(6837,2262)(6837,1062)
-	(6387,1062)(6387,2262)
-\put(3987,2037){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(3987,1737){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(4137,1137){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(6087,1662){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}...}}}}}
-\put(3987,1437){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=$n_2$}}}}}
-\path(3912,9912)(5487,9912)(5487,8712)
-	(3912,8712)(3912,9912)
-\path(4662,9762)(4662,10212)(7287,10212)(7287,9912)
-\path(7257.000,10032.000)(7287.000,9912.000)(7317.000,10032.000)
-\path(10362,9912)(10362,8712)
-\path(4812,9462)(4812,10212)
-\path(7287,9912)(10587,9912)(10587,8712)
-	(7287,8712)(7287,9912)
-\path(4812,9462)(4812,10662)(10362,10662)(10362,9912)
-\path(10332.000,10032.000)(10362.000,9912.000)(10392.000,10032.000)
-\path(7407.000,9342.000)(7287.000,9312.000)(7407.000,9282.000)
-\path(7287,9312)(10362,9312)
-\path(10242.000,9282.000)(10362.000,9312.000)(10242.000,9342.000)
-\put(3987,9687){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(3987,9387){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(4137,8787){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(3987,9087){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=1}}}}}
-\put(7962,10062){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}single block}}}}}
-\put(7962,9462){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}used memory}}}}}
-\path(3462,7587)(3462,7062)(3837,7062)
-\path(3717.000,7032.000)(3837.000,7062.000)(3717.000,7092.000)
-\path(3912,7362)(5487,7362)(5487,6162)
-	(3912,6162)(3912,7362)
-\path(4662,7212)(4662,7662)(7287,7662)(7287,7362)
-\path(7257.000,7482.000)(7287.000,7362.000)(7317.000,7482.000)
-\path(10362,7362)(10362,6162)
-\path(4812,6912)(4812,7662)
-\path(7287,7362)(10587,7362)(10587,6162)
-	(7287,6162)(7287,7362)
-\path(4812,6912)(4812,8112)(10362,8112)(10362,7362)
-\path(10332.000,7482.000)(10362.000,7362.000)(10392.000,7482.000)
-\path(7407.000,6792.000)(7287.000,6762.000)(7407.000,6732.000)
-\path(7287,6762)(10362,6762)
-\path(10242.000,6732.000)(10362.000,6762.000)(10242.000,6792.000)
-\put(3237,7812){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(3987,7137){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(3987,6837){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(3987,6537){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=1}}}}}
-\put(7962,7512){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}single block}}}}}
-\put(7962,6912){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}used memory}}}}}
-\put(3987,6237){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link=NULL}}}}}
-\path(4062,8862)(3462,8862)(3462,8112)
-\path(3432.000,8232.000)(3462.000,8112.000)(3492.000,8232.000)
-\path(3942.000,1182.000)(4062.000,1212.000)(3942.000,1242.000)
-\path(4062,1212)(3462,1212)(3462,12)(3912,12)
-\path(3792.000,-18.000)(3912.000,12.000)(3792.000,42.000)
-\path(3942.000,3282.000)(4062.000,3312.000)(3942.000,3342.000)
-\path(4062,3312)(3462,3312)(3462,2112)(3912,2112)
-\path(3792.000,2082.000)(3912.000,2112.000)(3792.000,2142.000)
-\path(3912,4362)(5487,4362)(5487,3162)
-	(3912,3162)(3912,4362)
-\path(4812,3912)(4812,4662)
-\path(5487,4362)(5937,4362)(5937,3162)
-	(5487,3162)(5487,4362)
-\path(5937,4362)(6387,4362)(6387,3162)
-	(5937,3162)(5937,4362)
-\path(6387,4362)(6837,4362)(6837,3162)
-	(6387,3162)(6387,4362)
-\path(4662,4212)(4662,4662)(7437,4662)(7437,4362)
-\path(7407.000,4482.000)(7437.000,4362.000)(7467.000,4482.000)
-\path(12,6087)(1737,6087)(1737,4887)
-	(12,4887)(12,6087)
-\path(987,5637)(2637,5637)(2637,9612)(3912,9612)
-\path(3792.000,9582.000)(3912.000,9612.000)(3792.000,9642.000)
-\path(1587,5037)(2637,5037)(2637,4062)(3912,4062)
-\path(3792.000,4032.000)(3912.000,4062.000)(3792.000,4092.000)
-\put(4137,12){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}......}}}}}
-\put(3987,4137){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}start}}}}}
-\put(3987,3837){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}free}}}}}
-\put(3987,3537){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks=$n_1$}}}}}
-\put(4137,3237){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}link}}}}}
-\put(6087,3762){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}...}}}}}
-\put(462,6237){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}step}}}}}
-\put(87,5562){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}blocks}}}}}
-\put(87,5862){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}no}}}}}
-\put(87,5262){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}n\_blocks}}}}}
-\put(87,4962){\makebox(0,0)[lb]{\smash{{{\SetFigFont{10}{12.0}{\rmdefault}{\mddefault}{\updefault}large\_object}}}}}
-\end{picture}
-}
diff --git a/ghc/docs/storage-mgt/step.fig b/ghc/docs/storage-mgt/step.fig
deleted file mode 100644
index af9661f2be..0000000000
--- a/ghc/docs/storage-mgt/step.fig
+++ /dev/null
@@ -1,154 +0,0 @@
-#FIG 3.2
-Landscape
-Center
-Inches
-Letter  
-60.00
-Single
--2
-1200 2
-6 9825 1650 13125 3150
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9825 1950 13125 1950 13125 3150 9825 3150 9825 1950
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 9825 2550 12975 2550
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 12975 1950 12975 3150
-4 0 0 50 0 0 17 0.0000 4 165 630 11025 1875 blocks\001
-4 0 0 50 0 0 17 0.0000 4 225 1230 10800 2400 single object\001
--6
-6 6300 3750 13125 5250
-6 9825 3750 13125 5250
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9825 4050 13125 4050 13125 5250 9825 5250 9825 4050
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 9825 4650 12975 4650
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 12975 4050 12975 5250
-4 0 0 50 0 0 17 0.0000 4 165 630 11025 3975 blocks\001
-4 0 0 50 0 0 17 0.0000 4 225 1230 10800 4500 single object\001
--6
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6300 4050 7875 4050 7875 5250 6300 5250 6300 4050
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7050 4200 7050 3750 9825 3750 9825 4050
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 7200 4500 7200 3750
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 7875 4050 8325 4050 8325 5250 7875 5250 7875 4050
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8325 4050 8775 4050 8775 5250 8325 5250 8325 4050
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8775 4050 9225 4050 9225 5250 8775 5250 8775 4050
-4 0 0 50 0 0 17 0.0000 4 150 435 6375 4275 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6375 4575 free\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6525 5175 link\001
-4 0 0 50 0 0 17 0.0000 4 30 180 8475 4650 ...\001
-4 0 0 50 0 0 17 0.0000 4 195 1125 6375 4875 blocks=n_2\001
--6
-6 5625 -4350 12975 150
-6 6300 -4350 12975 -2400
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6300 -3600 7875 -3600 7875 -2400 6300 -2400 6300 -3600
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7050 -3450 7050 -3900 9675 -3900 9675 -3600
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 12750 -3600 12750 -2400
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 7200 -3150 7200 -3900
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9675 -3600 12975 -3600 12975 -2400 9675 -2400 9675 -3600
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7200 -3150 7200 -4350 12750 -4350 12750 -3600
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 9675 -3000 12750 -3000
-4 0 0 50 0 0 17 0.0000 4 150 435 6375 -3375 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6375 -3075 free\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6525 -2475 link\001
-4 0 0 50 0 0 17 0.0000 4 165 885 6375 -2775 blocks=1\001
-4 0 0 50 0 0 17 0.0000 4 225 1185 10350 -3750 single block\001
-4 0 0 50 0 0 17 0.0000 4 225 1320 10350 -3150 used memory\001
--6
-6 5625 -1800 12975 150
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 3
-	0 0 1.00 60.00 120.00
-	 5850 -1275 5850 -750 6225 -750
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6300 -1050 7875 -1050 7875 150 6300 150 6300 -1050
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7050 -900 7050 -1350 9675 -1350 9675 -1050
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 12750 -1050 12750 150
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 7200 -600 7200 -1350
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 9675 -1050 12975 -1050 12975 150 9675 150 9675 -1050
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7200 -600 7200 -1800 12750 -1800 12750 -1050
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 2
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 9675 -450 12750 -450
-4 0 0 50 0 0 17 0.0000 4 30 360 5625 -1500 ......\001
-4 0 0 50 0 0 17 0.0000 4 150 435 6375 -825 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6375 -525 free\001
-4 0 0 50 0 0 17 0.0000 4 165 885 6375 -225 blocks=1\001
-4 0 0 50 0 0 17 0.0000 4 225 1185 10350 -1200 single block\001
-4 0 0 50 0 0 17 0.0000 4 225 1320 10350 -600 used memory\001
-4 0 0 50 0 0 17 0.0000 4 165 1185 6375 75 link=NULL\001
--6
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 3
-	0 0 1.00 60.00 120.00
-	 6450 -2550 5850 -2550 5850 -1800
--6
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 4
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 6450 5100 5850 5100 5850 6300 6300 6300
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 1 4
-	0 0 1.00 60.00 120.00
-	0 0 1.00 60.00 120.00
-	 6450 3000 5850 3000 5850 4200 6300 4200
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 6300 1950 7875 1950 7875 3150 6300 3150 6300 1950
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 2
-	 7200 2400 7200 1650
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 7875 1950 8325 1950 8325 3150 7875 3150 7875 1950
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8325 1950 8775 1950 8775 3150 8325 3150 8325 1950
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 8775 1950 9225 1950 9225 3150 8775 3150 8775 1950
-2 1 0 1 0 7 50 0 -1 0.000 0 0 7 1 0 4
-	0 0 1.00 60.00 120.00
-	 7050 2100 7050 1650 9825 1650 9825 1950
-2 2 0 1 0 7 50 0 -1 0.000 0 0 -1 0 0 5
-	 2400 225 4125 225 4125 1425 2400 1425 2400 225
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 4
-	0 0 1.00 60.00 120.00
-	 3375 675 5025 675 5025 -3300 6300 -3300
-2 1 0 1 0 7 50 0 -1 0.000 0 0 -1 1 0 4
-	0 0 1.00 60.00 120.00
-	 3975 1275 5025 1275 5025 2250 6300 2250
-4 0 0 50 0 0 17 0.0000 4 30 360 6525 6300 ......\001
-4 0 0 50 0 0 17 0.0000 4 150 435 6375 2175 start\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6375 2475 free\001
-4 0 0 50 0 0 17 0.0000 4 195 1125 6375 2775 blocks=n_1\001
-4 0 0 50 0 0 17 0.0000 4 165 390 6525 3075 link\001
-4 0 0 50 0 0 17 0.0000 4 30 180 8475 2550 ...\001
-4 0 0 50 0 0 17 0.0000 4 210 390 2850 75 step\001
-4 0 0 50 0 0 17 0.0000 4 165 630 2475 750 blocks\001
-4 0 0 50 0 0 17 0.0000 4 120 240 2475 450 no\001
-4 0 0 50 0 0 17 0.0000 4 195 870 2475 1050 n_blocks\001
-4 0 0 50 0 0 17 0.0000 4 225 1200 2475 1350 large_object\001
diff --git a/ghc/docs/users_guide/5-00-notes.xml b/ghc/docs/users_guide/5-00-notes.xml
deleted file mode 100644
index 28712472c6..0000000000
--- a/ghc/docs/users_guide/5-00-notes.xml
+++ /dev/null
@@ -1,207 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<sect1 id="release-5-00">
-  <title>Release notes for version 5.00 (April 2001)</title>
-
-  <sect2>
-    <title>User-visible compiler changes</title>
-    <itemizedlist>
-      <listitem>
-	<para>GHCi, the new interactive environment on top of GHC, has
-	been added (<xref linkend="ghci">).</para>
-      </listitem>
-      <listitem>
-	<para>New <option>&ndash;&ndash;make</option> flag added (<xref
-	linkend="make-mode">).</para>
-      </listitem>
-      <listitem>
-	<para>The native code generator now supports Sparc in addition
-	to x86.</para>
-      </listitem>
-      <listitem>
-	<para>We now make it clear which options can be placed in an
-	OPTIONS pragma.  See <xref
-	linkend="static-dynamic-flags">.</para>
-      </listitem>
-      <listitem>
-	<para><option>-fglasgow-exts</option> no longer implies
-	<option>-package lang</option>.</para>
-      </listitem>
-      <listitem>
-	<para><option>-noC</option> is no more.</para>
-      </listitem>
-      <listitem>
-	<para><option>-hi</option> and <option>-nohi</option> are no more.</para>
-      </listitem>
-      <listitem>
-	<para>The concept of &ldquo;packages&rdquo; has been
-	generalised and extended.  Packages may be installed or
-	removed from an existing GHC installation using the new
-	<command>ghc-pkg</command> tool.  See <xref
-	linkend="packages">.</para>
-      </listitem>
-      <listitem>
-	<para>Initial unicode support: the <literal>Char</literal>
-	type is now 31 bits.  We don't yet have support for unicode
-	I/O.</para>
-      </listitem>
-      <listitem>
-	<para><option>-v</option> now takes an optional numeric
-        argument indicating the level of verbosity (<xref
-        linkend="options-help">).  <option>-dshow-passes</option> has
-        been removed.</para>
-      </listitem>
-      <listitem>
-	<para>Parallel list comprehensions added.  See <xref
-	linkend="parallel-list-comprehensions">.</para>
-      </listitem>
-      <listitem>
-	<para>Functional dependencies are now fully implemented.
-	</para>
-      </listitem>
-      <listitem>
-	<para>Profiling: please use 
-              <literal>{-# SCC ".." #-}</literal> 
-              rather than <literal>_scc_ "..."</literal>.  The latter
-              will be phased out in due course.</para>
-      </listitem>
-      <listitem>
-	<para>A new experimental optimisation, SpecConstr, is turned
-	on with <literal>-O2</literal>.</para>
-      </listitem>
-      <listitem>
-	<para>Please report bugs using the <ulink
-	url="http://sourceforge.net/projects/ghc/">SourceForge bug
-	tracker</ulink> instead of
-	<email>glasgow-haskell-bugs@haskell.org</email> if
-	possible.</para>
-      </listitem>
-      <listitem>
-	<para>Documentation changes: there's now a useful Flag
-	Reference section, see <xref linkend="flag-reference">.</para>
-      </listitem>
-      <listitem>
-	<para>Many, many, bugfixes.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>New experimental features</title>
-
-    <itemizedlist>
-      <listitem>
-	<para>A &ldquo;front panel&rdquo; for GHC-compiled programs
-	displays real-time graphs of memory behaviour in a GTK+
-	window.  You need to recompile the RTS with front panel
-	support to use this.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>FFI changes</title>
-    <itemizedlist>
-      <listitem>
-	<para><command>hsc2hs</command> added (<xref linkend="hsc2hs">).</para>
-      </listitem>
-      <listitem>
-	<para>FFI libraries have been updated to the latest proposal
-	from the FFI task force.  Too many changes to list here, see
-	the docs: <xref linkend="sec-Foreign">.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>User-visible library changes</title>
-    <itemizedlist>
-      <listitem>
-	<para><function>putMVar</function> now blocks if the
-	<literal>MVar</literal> is already full.  The
-	<literal>PutFullMVar</literal> exception no longer exists.
-	A non-blocking version of <function>putMVar</function>,
-	<function>tryPutMVar</function>, has been added (<xref
-	linkend="sec-MVars">).</para>
-      </listitem>
-      <listitem>
-	<para>The <literal>Int</literal> and
-        <literal>Integer</literal> types now have instances of
-        <literal>Bits</literal> (<xref linkend="sec-Bits">).</para>
-      </listitem>
-      <listitem>
-	<para>Package <literal>hssource</literal> has been added.  It
-	contains a Haskell 98 abstract syntax, parser, lexer and pretty
-	printer.  No documentation yet.</para>
-      </listitem>
-      <listitem>
-	<para>The methods <literal>fromInt</literal> and
-	<literal>toInt</literal>, which used to be in class
-	<literal>Num</literal> but exported from module
-	<literal>Int</literal>, are no longer in class
-	<literal>Num</literal>.  They're still available from module
-	<literal>Int</literal>, however.</para> 
-
-	<para>In most cases, there should be no benefit from using
-	<literal>fromInt</literal> instead of
-	<literal>fromIntegral</literal>, which is specialised for all
-	integral types.</para>
-      </listitem>
-      <listitem>
-	<para>New modules: DiffArray (<xref linkend="sec-DiffArray">),
-	StorableArray (<xref linkend="sec-StorableArray">),
-	MonadList, MonadCont (no documentation yet).</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>Build system changes</title>
-    
-    <itemizedlist>
-      <listitem>
-	<para>The <literal>WithGhcHc</literal> setting in
-	<literal>build.mk</literal> has been replaced by the
-	<literal>&ndash;&ndash;with-ghc=<replaceable>ghc</replaceable></literal>
-	option to <literal>configure</literal>.  The new option
-	<emphasis>must</emphasis> be used if you intend to use
-	anything except &ldquo;<literal>ghc</literal>&rdquo; to
-	bootstrap GHC, in order that the build system can figure out
-	what version of GHC you're using.</para>
-      </listitem>
-      <listitem>
-	<para>Source distributions are now made by doing <literal>make
-	distclean</literal> in a build tree, instead of requiring a
-	linked build tree.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>Internal changes</title>
-    <itemizedlist>
-      <listitem>
-	<para>Many internal compiler changes: too many to list
-	here.</para>
-      </listitem>
-      <listitem>
-	<para>The old perl driver has been removed and replaced by a
-	driver in the compiler proper.</para>
-      </listitem>
-      <listitem>
-	<para>We now use GMP 3 instead of GMP 2 for
-	arbitrary-precision integer support.</para>
-      </listitem>
-      <listitem>
-	<para>Several libraries rewritten to use the FFI.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-</sect1>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter" "sect1") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/5-02-notes.xml b/ghc/docs/users_guide/5-02-notes.xml
deleted file mode 100644
index a8bc83a4ba..0000000000
--- a/ghc/docs/users_guide/5-02-notes.xml
+++ /dev/null
@@ -1,57 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<sect1 id="release-5-04">
-  <title>Release notes for version 5.04</title>
-
-  <sect2>
-    <title>User-visible compiler changes</title>
-    <itemizedlist>
-      <listitem>
-	<para></para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>User-visible interpreter (GHCi) changes</title>
-    <itemizedlist>
-      <listitem>
-	<para></para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>User-visible library changes</title>
-    <itemizedlist>
-      <listitem>
-	<para></para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>New experimental features</title>
-    <itemizedlist>
-      <listitem>
-	<para></para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>Internal changes</title>
-    <itemizedlist>
-      <listitem>
-	<para></para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-</sect1>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter" "sect1") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/5-04-notes.xml b/ghc/docs/users_guide/5-04-notes.xml
deleted file mode 100644
index 91b8dcf606..0000000000
--- a/ghc/docs/users_guide/5-04-notes.xml
+++ /dev/null
@@ -1,288 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<sect1 id="release-5-04">
-  <title>Release notes for version 5.04</title>
-
-  <sect2>
-    <title>User-visible compiler changes</title>
-    <itemizedlist>
-      <listitem>
-	<para>Full support for MacOS X, including fully optimized compilation, has been added. Only a native
-	code generator and support for <option>-split-objs</option> is still missing.
-	Everything else needs more testing, but should work.</para>
-      </listitem>
-      <listitem>
-	<para><literal>ghc-pkg</literal>: new options
-	<option>--auto-ghci-libs</option>,
-	<option>-u</option>/<option>--update-package</option>,
-	<option>--force</option>, and
-	<option>-i</option>/<option>--input-file</option>, and
-	suppport for expanding environment variables in package
-	descriptions.  See <xref linkend="packages">).</para>
-      </listitem>
-      <listitem>
-	<para>The latest version of the FFI spec is fully supported.
-	The syntax of FFI declarations has changed accordingly.  The
-	old syntax is still accepted for the time being, but will
-	elicit a warning from the compiler.</para>
-      </listitem>
-      <listitem>
-	<para>New option: <option>-F</option> specifies a user-defined
-	preprocessing phase (see <xref linkend="pre-processor">).</para>
-      </listitem>
-      <listitem>
-	<para>Major overhaul of the heap profiling subsystem, with new
-	facilities for retainer profiling and biographical profiling
-	(ala nhc98, albeit with a couple of omissions).  The syntax of
-	the runtime heap-profiling options has changed.  See <xref
-	linkend="prof-heap">.</para>
-      </listitem>
-      <listitem>
-	<para>The type system now supports full rank-N types
-	(previously only limited rank-2 types were supported).  See
-	<xref linkend="universal-quantification">.</para>
-      </listitem>
-      <listitem>
-	<para>Explicit kind annotations can now be given on any
-        binding occurrence of a type variable.  See <xref
-        linkend="sec-kinding">.</para>
-      </listitem>
-      <listitem>
-	<para>The handling of type synonyms has been rationalised.
-	See <xref linkend="type-synonyms">.</para>
-      </listitem>
-      <listitem>
-	<para>Fixes for several space leaks in the compiler itself
-	(these fixes were also merged into 5.02.3).</para>
-      </listitem>
-      <listitem>
-	<para>It is now possible to derive arbitrary classes for
-	newtypes.  See <xref linkend="newtype-deriving">.</para>
-      </listitem>
-      <listitem>
-	<para>Deadlock is now an exception, rather than a return
-	status from the scheduler.  See the module
-	<literal>Control.Exception</literal> in the library
-	documentation for more details.</para>
-      </listitem>
-      <listitem>
-	<para>The syntax and behaviour of <literal>RULE</literal>
-	pragmas has changed slightly.  See <xref
-	linkend="rewrite-rules">.</para>
-      </listitem>
-      <listitem>
-	<para>Interface files are now in a binary format to reduce
-	compilation times.  To view an interface file in plain text,
-	use the <option>--show-iface</option> flag.</para>
-      </listitem>
-      <listitem>
-	<para>A restriction on the form of class declarations has been
-	lifted.  In Haskell 98, it is illegal for class method types
-	to mention constraints on the class type variable.  eg.</para>
-
-<programlisting>
-   class Seq s a where
-      elem     :: Eq a => a -> s a -> Bool
-</programlisting>
-	
-	<para>This restriction has now been lifted in GHC.</para>
-      </listitem>
-      <listitem>
-	<para>Main threads can now receive the
-	<literal>BlockedOnDeadMVar</literal> exception in the same way
-	as other threads.</para>
-      </listitem>
-      <listitem>
-	<para>The <option>-fall-strict</option> flag never really
-	worked, and has been removed.</para>
-      </listitem>
-      <listitem>
-	<para>The syntax of <literal>.hi-boot</literal> files is now
-	much clearer and Haskell-like.  See <xref
-	linkend="mutual-recursion">.</para>
-      </listitem>
-      <listitem>
-	<para>There is a new flag <option>-fffi</option> which enables
-	FFI support without turning on the rest of the GHC
-	extensions.</para>
-      </listitem>
-      <listitem>
-	<para>The syntax for implicit parameter bindings has changed.
-	Previously the keyword <literal>with</literal> was used to
-	introduce implicit bindings, but now implicit bindings may be
-	introduced using <literal>let</literal> (see <xref
-	linkend="implicit-parameters">).  As a result of this,
-	<literal>with</literal> is no longer a keyword when
-	<option>-fglasgow-exts</option> is turned on.</para>
-	
-	<para>The option <literal>-fwith</literal> may be used to
-	restore the old behaviour.</para>
-      </listitem>
-      <listitem>
-	<para>Infix type constructors are now allowed, and must begin
-	with a colon (as with data constructors).  See <xref
-	linkend="infix-tycons">.</para>
-      </listitem>
-      <listitem>
-	<para>The <literal>do</literal>-notation syntax is now
-	rebindable in the same way as other built-in syntax.  See
-	<xref linkend="rebindable-syntax">.</para>
-      </listitem>
-      <listitem>
-	<para>Support for using &ldquo;frameworks&rdquo; on
-	Darwin/MacOS X has been added.  See the
-	<option>-framework</option> option in <xref
-	linkend="options-linker">, and the
-	<literal>framework_dirs</literal> field of a package spec in
-	<xref linkend="package-management">.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-  
-  <sect2>
-    <title>User-visible interpreter (GHCi) changes</title>
-    <itemizedlist>
-      <listitem>
-	<para>New commands: <literal>:browse</literal>, <literal>:set
-	args</literal>, <literal>:set prog</literal>, <literal>:show
-	bindings</literal>, and <literal>:show modules</literal> (see
-	<xref linkend="ghci-commands">).</para>
-      </listitem>
-      <listitem>
-	<para>There is a much more flexible mechanism for manipulating
-	the scope for expressions typed at the prompt.  For example,
-	one can now have both the <literal>Prelude</literal> and the
-	exports of several compiled modules in scope at the same
-	time.  See <xref linkend="ghci-scope">.</para>
-      </listitem>
-      <listitem>
-	<para>GHCi now supports <literal>foreign import
-	"wrapper"</literal> FFI declarations.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-  
-  <sect2>
-    <title>User-visible library changes</title>
-    <itemizedlist>
-      <listitem>
-	<para>GHC is in the process of moving to a new hierarchical
-	set of libraries.  At the moment, we have two sets of
-	libraries, both described in accompanying documents:</para>
-	<itemizedlist>
-	  <listitem>
-	    <para>The &ldquo;new libraries&rdquo; which are
-	    hierarchical and consist of the following packages:
-	    <literal>base</literal>, <literal>haskell98</literal>,
-	    <literal>haskell-src</literal>, and
-	    <literal>network</literal>.  Broadly speaking,
-	    <literal>base</literal> contains the
-	    <literal>Prelude</literal>, standard libraries and most of
-	    the contents of the old <literal>lang</literal>
-	    package.  By default, the <literal>base</literal> and
-	    <literal>haskell98</literal> packages are enabled.</para>
-	  </listitem>
-
-	  <listitem>
-	    <para>The <literal>hslibs</literal>, most of which are now
-  	    deprecated.  Where possible, new code should be written to
-  	    use the new libraries instead. </para>
-
-	    <para>The following libraries in <literal>hslibs</literal>
-	    have not moved yet:</para>
-	    <itemizedlist>
-	      <listitem>
-		<para>The packages <literal>win32</literal>,
-                <literal>xlib</literal>, <literal>graphics</literal>,
-                and <literal>posix</literal>.</para>
-	      </listitem>
-	      <listitem>
-		<para>The Edison libraries in the
-		<literal>data</literal> package.</para>
-	      </listitem>
-	      <listitem>
-		<para>In the <literal>lang</literal> package, the
-		modules <literal>TimeExts</literal>,
-		<literal>DirectoryExts</literal>,
-		<literal>SystemExts</literal>, and
-		<literal>NumExts</literal>.</para>
-	      </listitem>
-	      <listitem>
-		<para>The HaXml libraries in the
-		<literal>text</literal> package.</para>
-	      </listitem>
-	      <listitem>
-		<para>In the <literal>util</literal> package, the
-                modules <literal>MD5</literal>,
-                <literal>Select</literal>, <literal>Memo</literal>,
-                <literal>Observe</literal>, and
-                <literal>Readline</literal>.</para>
-	      </listitem>
-	    </itemizedlist>
-
-	    <para>All other libraries from <literal>hslibs</literal>
-	    either have equivalents in the new libraries (see the
-	    <literal>hslibs</literal> docs for details), or were
-	    already deprecated and hence were not moved into the new
-	    hierarchy.</para>
-	  </listitem>
-	</itemizedlist>
-      </listitem>
-      
-      <listitem>
-	<para>The <literal>Read</literal> class is now based on a
-	parsing combinator library which is vastly more efficient than
-	the previous one.  See the modules
-	<literal>Text.Read</literal>.
-	<literal>Text.ParserCombinators.ReadP</literal>, and
-	<literal>Text.ParserCombinators.ReadPrec</literal> in the
-	library documentation.</para>
-
-	<para>The code generated by the compiler for derived
-	<literal>Read</literal> instances should be much shorter than
-	before.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>New experimental features</title>
-    <itemizedlist>
-      <listitem>
-	<para>Linear implicit parameters.  See <xref
-	linkend="linear-implicit-parameters">.</para>
-      </listitem>
-      <listitem>
-	<para>The RTS has support for running in a multi-threaded
-	environment and making non-blocking (from Haskell's point of
-	view) calls to foreign C functions which would normally block.
-	To enable this behaviour, configure with the
-	<option>--enable-threaded-rts</option> option.</para>
-      </listitem>
-      <listitem>
-	<para>The compiler can now read in files containing Core
-	syntax (such as those produced by the
-	<option>-fext-core</option> option) and compile them. Input
-	files with the <literal>.hcr</literal> file extension are
-	assumed to contain Core syntax.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>Internal changes</title>
-    <itemizedlist>
-      <listitem>
-	<para>Happy 1.13 is now required to build GHC, because of the
-	change in names of certain libraries.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-</sect1>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter" "sect1") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/6.0-notes.xml b/ghc/docs/users_guide/6.0-notes.xml
deleted file mode 100644
index e07bc890f2..0000000000
--- a/ghc/docs/users_guide/6.0-notes.xml
+++ /dev/null
@@ -1,319 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<sect1 id="release-6-0">
-  <title>Release notes for version 6.0</title>
-
-  <sect2>
-    <title>User-visible compiler changes</title>
-    <itemizedlist>
-      <listitem>
-	<para>Template Haskell, a new feature for compile-time
-	metaprogramming has been introduced.  See <xref
-	linkend="template-haskell"/>.</para>
-      </listitem>
-      <listitem>
-	<para>INLINE pragmas on methods in class or instance
-	declarations now work properly.</para>
-      </listitem>
-      <listitem>
-	<para>Recursive do-notation (aka <literal>mdo</literal>) is
-	now supported.  See <xref linkend="mdo-notation"/>.</para>
-      </listitem>
-      <listitem>
-	<para>There is now a native code generator for PowerPC
-	platforms.</para>
-      </listitem>
-      <listitem>
-	<para>Profiling: the <option>-xt</option> RTS option enables
-	inclusion of thread stacks in a heap profile.  See <xref
-	linkend="rts-options-heap-prof"/>.</para>
-      </listitem>
-      <listitem>
-	<para>Non-blocking I/O is now supported on Windows.</para>
-      </listitem>
-      <listitem>
-	<para>The <ulink url="../libraries/base/Data.Dynamic.html#Typeable"><literal>Typeable</literal></ulink> class can now be
-	derived, and the implementation of <literal>Typeable</literal>
-	is now more efficient.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-  
-  <sect2>
-    <title>User-visible interpreter (GHCi) changes</title>
-    <itemizedlist>
-      <listitem>
-	<para>Loading a <literal>Main</literal> module that does not
-	define <literal>main</literal> is no longer an error, although
-	GHCi will still emit a warning in this case.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>User-visible library changes</title>
-    <itemizedlist>
-      <listitem>
-	<para>Hierarchical libraries are now available without needing
-	to specify an explicit <option>-package</option> flag.  There
-	are some exceptions to this rule (see <xref
-	linkend="using-packages"/>), but if you stick to GHCi and
-	<option>--make</option> mode then there will normally be no
-	need to specify <option>-package</option> options at
-	all.</para>
-
-	<para>Non-hierarchical libraries
-	(i.e. <literal>hslibs</literal> libraries) still need to be
-	explicitly requested with <option>-package</option>
-	options.</para>
-      </listitem>
-
-      <listitem>
-	<para>The <literal>Posix</literal> library has been rewritten.
-	It is now a hierarchical library rooted at
-	<literal>System.Posix</literal>, and has some additions aimed
-	at supporting the latest revision of the POSIX standard (IEEE
-	Std 1003.1-2001).  See the <ulink
-	url="../libraries/unix/index.html"><literal>unix</literal>
-	package</ulink> for details.</para>
-
-	<para>The old <literal>posix</literal> package is still
-	available for backwards compatibility, but is deprecated and
-	will be removed in a future release.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink url="../libraries/base/Data.IORef.html"><literal>Data.IORef</literal></ulink>: Added <literal>atomicModifyIORef</literal>.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink url="../libraries/base/System.Cmd.html"><literal>System.Cmd</literal></ulink>: Added <literal>rawSystem</literal>.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/base/System.Environment.html"><literal>System.Environment</literal></ulink>:
-	Added <literal>withArgs</literal> and <literal>withProgName</literal>.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/network/Network.Socket.html"><literal>Network.Socket</literal></ulink>:
-	Added <literal>sendFd</literal> and <literal>recvFd</literal>.</para>
-      </listitem>
-
-      <listitem>
-	<para>The <literal>Readline</literal> library has moved to
-	<ulink
-	url="../libraries/readline/System.Console.Readline.html"><literal>System.Console.Readline</literal></ulink>,
-	and is in a package of its own
-	(<literal>readline</literal>).</para>
-      </listitem>
-
-      <listitem>
-	<para>The non-hierarchical versions of the FFI libraries are
-	now all available without needing to specify <literal>-package
-	lang</literal> (they are actually now in the
-	<literal>haskell98</literal> package, which is available by
-	default).</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/network/Network.BSD.html"><literal>Network.BSD</literal></ulink>:
-	<literal>symlink</literal> and <literal>readline</literal> are
-	now deprecated; use
-	<literal>System.Posix.createSymbolicLink</literal> and
-	<literal>System.Posix.readSymbolicLink</literal>
-	respectively.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/base/Control.Exception.html"><literal>Control.Exception</literal></ulink>:
-	Added <literal>mapException</literal>.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/base/Data.Dynamic.html"><literal>Data.Dynamic</literal></ulink>:
-	various changes to make the implementation of
-	<literal>Typeable</literal> more efficient.  This entails some
-	changes to the interface, and affects how instances of
-	<literal>Typeable</literal> are defined.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/base/Data.Tree.html"><literal>Data.Tree</literal></ulink>
-	is a new library for trees.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/base/Data.Graph.html"><literal>Data.Graph</literal></ulink>
-	is a new library for graphs.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/base/System.IO.html"><literal>System.IO</literal></ulink>:
-	Removed <literal>bracket</literal> and
-	<literal>bracket_</literal> (use the versions from
-	<literal>Control.Exception</literal> instead).</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/base/System.IO.html"><literal>System.IO</literal></ulink>:
-	The <literal>IOError</literal> type is now a synonym for
-	<literal>IOException</literal>, whereas previously it was a
-	synonym for <literal>Exception</literal>.  This has various
-	consequences, one of which is that the types of
-	<literal>System.IO.catch</literal> and
-	<literal>Control.Exception.catch</literal> are now different
-	(useful, because they do different things).</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/base/System.IO.Error.html"><literal>System.IO.Error</literal></ulink>:
-	added <literal>annotateIOError</literal>,
-	<literal>modifyIOError</literal>, and <literal>ioeSet{ErrorType,ErrorString,Handle,FileName}</literal>.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/base/Text.ParserCombinators.ReadP.html"><literal>Text.ParserCombinators.ReadP</literal></ulink>:
-	lots of updates.</para>
-      </listitem>
-
-      <listitem>
-	<para><literal>Control.Monad.Monoid</literal> is now <ulink url="../libraries/base/Data.Monoid.html"><literal>Data.Monoid</literal></ulink>.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/base/Data.PackedString.html"><literal>Data.PackedString</literal></ulink>:
-	added <literal>joinPS</literal>, <literal>unwordsPS</literal>
-	and <literal>unlinesPS</literal>.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/base/Data.HashTable.html"><literal>Data.HashTable</literal></ulink>
-	is a new dynamic hash-table implementation.</para>
-      </listitem>
-
-      <listitem>
-	<para>Added <ulink
-	url="../libraries/unix/System.Sendfile.html"><literal>System.Sendfile</literal></ulink>.</para>
-      </listitem>
-
-      <listitem>
-	<para>Added <ulink
-	url="../libraries/base/Foreign.Marshal.Pool.html"><literal>Foreign.Marshal.Pool</literal></ulink>.</para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="../libraries/base/Data.Bits.html"><literal>Data.Bits</literal></ulink>:
-	<literal>shiftL</literal>, <literal>shiftR</literal>,
-	<literal>rotateL</literal>, and <literal>rotateR</literal> are
-	now methods of the <literal>Bite</literal> class.</para>
-      </listitem>
-
-      <listitem>
-	<para>The FFI libraries now conform to the latest version of
-	the FFI spec:</para>
-	<itemizedlist>
-	  <listitem>
-	    <para>Added <ulink
-	    url="../libraries/base/Foreign.ForeignPtr.html#mallocForeignPtr"><literal>Foreign.ForeignPtr.mallocForeignPtr</literal></ulink>
-	    and friends.</para>
-	  </listitem>
-	  <listitem>
-	    <para>Finalizers added to a <literal>ForeignPtr</literal>
-	    with <literal>addForeignPtrFinalizer</literal> are now run
-	    in strict order; namely the reverse of the order they were
-	    added.</para>
-	  </listitem>
-	  <listitem>
-	    <para><literal>Foreign.C.TypesISO</literal> has been
-	    merged into <ulink
-	    url="../libraries/base/Foreign.C.Types.html"><literal>Foreign.C.Types</literal></ulink>.</para>
-	  </listitem>
-	</itemizedlist>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>Experimental features</title>
-    <itemizedlist>
-      <listitem>
-	<para>The <literal>Data</literal> class provides for generic
-	data traversals and folds; see <ulink
-	url="../libraries/base/Data.Generics.html"><literal>Data.Generics</literal></ulink>.
-	<literal>Data</literal> can be derived for arbitrary
-	datatypes.  The <literal>Data</literal> class is still
-	experimental, so its contents may change in the future.</para>
-      </listitem>
-      <listitem>
-	<para>Several bugs have been fixed in the threaded RTS, and it
-	should now be rather more robust (it should still be
-	considered experimental, however).</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-  <sect2>
-    <title>Internal changes</title>
-    <itemizedlist>
-      <listitem>
-	<para>Sweeping changes to the compiler and runtime system to
-	change the evaluation model from <quote>push/enter</quote> to
-	<quote>eval/apply</quote>.  The bottom line is that the
-	compiler is now more portable and some of the complexity is
-	now more centralised, while performance and binary sizes
-	remain about the same.</para>
-	
-	<para>A paper describing these changes can be found <ulink
-	url="http://research.microsoft.com/~simonpj/papers/eval-apply">here</ulink>.</para>
-      </listitem>
-      <listitem>
-	<para>The test suite is now driven by a Python script and is
-	rather more flexible and robust.  It now supports building
-	tests several different "ways", and as a result we now run
-	each test with optimisation, profiling, native code
-	generation, and GHCi in addition to the vanilla way.</para>
-      </listitem>
-      <listitem>
-	<para>The build system now supports bootstrapping the compiler
-	in a single build tree.  By default, typing
-	<literal>make</literal> at the top level will bootstrap the
-	compiler once to create a stage-2 compiler.  See the Building
-	Guide for more details.</para>
-      </listitem>
-      <listitem>
-	<para>The RTS debugging flags are no longer represented by a
-	bitfield and now have single-character names.  For example, to
-	turn on scheduler debugging output, use <literal>-Ds</literal>
-	rather than <literal>-D1</literal>.</para>
-      </listitem>
-      <listitem>
-	<para>The compiler no longer requires any packages from
-	<literal>hslibs</literal> to bootstrap.  It is enough to
-	compile <literal>fptools/libraries</literal> before building
-	the stage 2 compiler.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-
-</sect1>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter" "sect1") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/Makefile b/ghc/docs/users_guide/Makefile
deleted file mode 100644
index f0a31fb705..0000000000
--- a/ghc/docs/users_guide/Makefile
+++ /dev/null
@@ -1,7 +0,0 @@
-TOP = ../..
-include $(TOP)/mk/boilerplate.mk
-
-XML_DOC = users_guide
-INSTALL_XML_DOC = users_guide
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/docs/users_guide/bugs.xml b/ghc/docs/users_guide/bugs.xml
deleted file mode 100644
index ab0b9be7b9..0000000000
--- a/ghc/docs/users_guide/bugs.xml
+++ /dev/null
@@ -1,400 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<chapter id="bugs-and-infelicities">
-  <title>Known bugs and infelicities</title>
-
-  <sect1 id="vs-Haskell-defn">
-    <title>Haskell&nbsp;98 vs.&nbsp;Glasgow Haskell: language non-compliance
-</title>
-    
-    <indexterm><primary>GHC vs the Haskell 98 language</primary></indexterm>
-    <indexterm><primary>Haskell 98 language vs GHC</primary></indexterm>
-
-  <para>This section lists Glasgow Haskell infelicities in its
-  implementation of Haskell&nbsp;98.  See also the &ldquo;when things
-  go wrong&rdquo; section (<xref linkend="wrong"/>) for information
-  about crashes, space leaks, and other undesirable phenomena.</para>
-
-  <para>The limitations here are listed in Haskell Report order
-  (roughly).</para>
-
-  <sect2 id="haskell98-divergence">
-    <title>Divergence from Haskell&nbsp;98</title>
-    
-      
-    <sect3 id="infelicities-lexical">
-      <title>Lexical syntax</title>
-      
-      <itemizedlist>
-	<listitem>
-	  <para>The Haskell report specifies that programs may be
-	  written using Unicode.  GHC only accepts the ISO-8859-1
-	  character set at the moment.</para>
-	</listitem>
-
-	<listitem>
-	  <para>Certain lexical rules regarding qualified identifiers
-	  are slightly different in GHC compared to the Haskell
-	  report.  When you have
-	  <replaceable>module</replaceable><literal>.</literal><replaceable>reservedop</replaceable>,
-	  such as <literal>M.\</literal>, GHC will interpret it as a
-	  single qualified operator rather than the two lexemes
-	  <literal>M</literal> and <literal>.\</literal>.</para>
-	</listitem>
-      </itemizedlist>
-    </sect3>
-      
-      <sect3 id="infelicities-syntax">
-	<title>Context-free syntax</title>
-	
-	<itemizedlist>
-	  <listitem>
-	    <para>GHC is a little less strict about the layout rule when used
-	      in <literal>do</literal> expressions.  Specifically, the
-	      restriction that "a nested context must be indented further to
-	      the right than the enclosing context" is relaxed to allow the
-	      nested context to be at the same level as the enclosing context,
-	      if the enclosing context is a <literal>do</literal>
-	      expression.</para>
-
-	    <para>For example, the following code is accepted by GHC:
-
-<programlisting>
-main = do args &lt;- getArgs
-	  if null args then return [] else do
-          ps &lt;- mapM process args
-          mapM print ps</programlisting>
-
-	      </para>
-	  </listitem>
-
-	<listitem>
-	  <para>GHC doesn't do fixity resolution in expressions during
-	  parsing.  For example, according to the Haskell report, the
-	  following expression is legal Haskell:
-<programlisting>
-    let x = 42 in x == 42 == True</programlisting>
-	and parses as:
-<programlisting>
-    (let x = 42 in x == 42) == True</programlisting>
-
-          because according to the report, the <literal>let</literal>
-	  expression <quote>extends as far to the right as
-	  possible</quote>.  Since it can't extend past the second
-	  equals sign without causing a parse error
-	  (<literal>==</literal> is non-fix), the
-	  <literal>let</literal>-expression must terminate there.  GHC
-	  simply gobbles up the whole expression, parsing like this:
-<programlisting>
-    (let x = 42 in x == 42 == True)</programlisting>
-
-          The Haskell report is arguably wrong here, but nevertheless
-          it's a difference between GHC &amp; Haskell 98.</para>
-	</listitem>
-      </itemizedlist>
-    </sect3>
-
-  <sect3 id="infelicities-exprs-pats">
-      <title>Expressions and patterns</title>
-
-	<para>None known.</para>
-    </sect3>
-
-    <sect3 id="infelicities-decls">
-      <title>Declarations and bindings</title>
-
-      <para>None known.</para>
-    </sect3>
-      
-      <sect3 id="infelicities-Modules">
-	<title>Module system and interface files</title>
-	
-	<para>None known.</para>
-    </sect3>
-
-    <sect3 id="infelicities-numbers">
-      <title>Numbers, basic types, and built-in classes</title>
-
-      <variablelist>
-	<varlistentry>
-	  <term>Multiply-defined array elements&mdash;not checked:</term>
-	  <listitem>
-	    <para>This code fragment should
-	    elicit a fatal error, but it does not:
-
-<programlisting>
-main = print (array (1,1) [(1,2), (1,3)])</programlisting>
-GHC's implementation of <literal>array</literal> takes the value of an
-array slot from the last (index,value) pair in the list, and does no
-checking for duplicates.  The reason for this is efficiency, pure and simple.
-            </para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-      
-    </sect3>
-
-      <sect3 id="infelicities-Prelude">
-	<title>In <literal>Prelude</literal> support</title>
-
-      <variablelist>
-	<varlistentry>
-	  <term>Arbitrary-sized tuples</term>
-	  <listitem>
-	    <para>Tuples are currently limited to size 100.  HOWEVER:
-            standard instances for tuples (<literal>Eq</literal>,
-            <literal>Ord</literal>, <literal>Bounded</literal>,
-            <literal>Ix</literal> <literal>Read</literal>, and
-            <literal>Show</literal>) are available
-            <emphasis>only</emphasis> up to 16-tuples.</para>
-
-	    <para>This limitation is easily subvertible, so please ask
-            if you get stuck on it.</para>
-	    </listitem>
-	  </varlistentry>
-
-	  <varlistentry>
-	    <term><literal>Read</literal>ing integers</term>
-	    <listitem>
-	      <para>GHC's implementation of the
-	      <literal>Read</literal> class for integral types accepts
-	      hexadecimal and octal literals (the code in the Haskell
-	      98 report doesn't).  So, for example,
-<programlisting>read "0xf00" :: Int</programlisting>
-              works in GHC.</para>
-	      <para>A possible reason for this is that <literal>readLitChar</literal> accepts hex and
-		octal escapes, so it seems inconsistent not to do so for integers too.</para>
-	    </listitem>
-	  </varlistentry>
-
-	  <varlistentry>
-	    <term><literal>isAlpha</literal></term>
-	    <listitem>
-	      <para>The Haskell 98 definition of <literal>isAlpha</literal>
-              is:</para>
-
-<programlisting>isAlpha c = isUpper c || isLower c</programlisting>
-
-	      <para>GHC's implementation diverges from the Haskell 98
-              definition in the sense that Unicode alphabetic characters which
-              are neither upper nor lower case will still be identified as
-              alphabetic by <literal>isAlpha</literal>.</para>
-	    </listitem>
-	  </varlistentry>
-	</variablelist>
-    </sect3>
-  </sect2>
-
-  <sect2 id="haskell98-undefined">
-    <title>GHC's interpretation of undefined behaviour in
-    Haskell&nbsp;98</title>
-
-    <para>This section documents GHC's take on various issues that are
-    left undefined or implementation specific in Haskell 98.</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>
-          The <literal>Char</literal> type
-          <indexterm><primary><literal>Char</literal></primary><secondary>size of</secondary></indexterm>
-        </term>
-	<listitem>
-	  <para>Following the ISO-10646 standard,
-	  <literal>maxBound :: Char</literal> in GHC is
-	  <literal>0x10FFFF</literal>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          Sized integral types
-          <indexterm><primary><literal>Int</literal></primary><secondary>size of</secondary></indexterm>
-	</term>
-	<listitem>
-	  <para>In GHC the <literal>Int</literal> type follows the
-	  size of an address on the host architecture; in other words
-	  it holds 32 bits on a 32-bit machine, and 64-bits on a
-	  64-bit machine.</para>
-
-	  <para>Arithmetic on <literal>Int</literal> is unchecked for
-	  overflow<indexterm><primary>overflow</primary><secondary><literal>Int</literal></secondary>
-	    </indexterm>, so all operations on <literal>Int</literal> happen
-	  modulo
-	  2<superscript><replaceable>n</replaceable></superscript>
-	  where <replaceable>n</replaceable> is the size in bits of
-	  the <literal>Int</literal> type.</para>
-
-	  <para>The <literal>fromInteger</literal><indexterm><primary><literal>fromInteger</literal></primary>
-	    </indexterm>function (and hence
-	  also <literal>fromIntegral</literal><indexterm><primary><literal>fromIntegral</literal></primary>
-	    </indexterm>) is a special case when
-	  converting to <literal>Int</literal>.  The value of
-	  <literal>fromIntegral x :: Int</literal> is given by taking
-	  the lower <replaceable>n</replaceable> bits of <literal>(abs
-	  x)</literal>, multiplied by the sign of <literal>x</literal>
-	  (in 2's complement <replaceable>n</replaceable>-bit
-	  arithmetic).  This behaviour was chosen so that for example
-	  writing <literal>0xffffffff :: Int</literal> preserves the
-	  bit-pattern in the resulting <literal>Int</literal>.</para>
-
-
-	   <para>Negative literals, such as <literal>-3</literal>, are
-             specified by (a careful reading of) the Haskell Report as 
-             meaning <literal>Prelude.negate (Prelude.fromInteger 3)</literal>.
-	     So <literal>-2147483648</literal> means <literal>negate (fromInteger 2147483648)</literal>.
-	     Since <literal>fromInteger</literal> takes the lower 32 bits of the representation,
-	     <literal>fromInteger (2147483648::Integer)</literal>, computed at type <literal>Int</literal> is
-	     <literal>-2147483648::Int</literal>.  The <literal>negate</literal> operation then
-	     overflows, but it is unchecked, so <literal>negate (-2147483648::Int)</literal> is just
-	     <literal>-2147483648</literal>.  In short, one can write <literal>minBound::Int</literal> as
-	     a literal with the expected meaning (but that is not in general guaranteed.
-             </para>
-
-	  <para>The <literal>fromIntegral</literal> function also
-	  preserves bit-patterns when converting between the sized
-	  integral types (<literal>Int8</literal>,
-	  <literal>Int16</literal>, <literal>Int32</literal>,
-	  <literal>Int64</literal> and the unsigned
-	  <literal>Word</literal> variants), see the modules
-	  <literal>Data.Int</literal> and <literal>Data.Word</literal>
-	  in the library documentation.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Unchecked float arithmetic</term>
-	<listitem>
-	  <para>Operations on <literal>Float</literal> and
-          <literal>Double</literal> numbers are
-          <emphasis>unchecked</emphasis> for overflow, underflow, and
-          other sad occurrences.  (note, however that some
-          architectures trap floating-point overflow and
-          loss-of-precision and report a floating-point exception,
-          probably terminating the
-          program)<indexterm><primary>floating-point
-          exceptions</primary></indexterm>.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-      
-    </sect2>
-  </sect1>
-
-
-  <sect1 id="bugs">
-    <title>Known bugs or infelicities</title>
-
-    <para>The bug tracker lists bugs that have been reported in GHC but not
-      yet fixed: see the <ulink url="http://sourceforge.net/projects/ghc/">SourceForge GHC
-    page</ulink>.  In addition to those, GHC also has the following known bugs
-      or  infelicities.  These bugs are more permanent; it is unlikely that
-      any of them will be fixed in the short term.</para>
-
-  <sect2 id="bugs-ghc">
-    <title>Bugs in GHC</title>
-
-    <itemizedlist>
-      <listitem>
-	<para> GHC can warn about non-exhaustive or overlapping
-        patterns (see <xref linkend="options-sanity"/>), and usually
-        does so correctly.  But not always.  It gets confused by
-        string patterns, and by guards, and can then emit bogus
-        warnings.  The entire overlap-check code needs an overhaul
-        really.</para>
-      </listitem>
-
-      <listitem>
-	<para>GHC does not allow you to have a data type with a context 
-	   that mentions type variables that are not data type parameters.
-	  For example:
-<programlisting>
-  data C a b => T a = MkT a
-</programlisting>
-	  so that <literal>MkT</literal>'s type is
-<programlisting>
-  MkT :: forall a b. C a b => a -> T a
-</programlisting>
-        In principle, with a suitable class declaration with a functional dependency,
-	 it's possible that this type is not ambiguous; but GHC nevertheless rejects
-	  it.  The type variables mentioned in the context of the data type declaration must
-	be among the type parameters of the data type.</para>
-      </listitem>
-
-      <listitem>
-	<para>GHC's inliner can be persuaded into non-termination
-        using the standard way to encode recursion via a data type:</para>
-<programlisting>
-  data U = MkU (U -> Bool)
-       
-  russel :: U -> Bool
-  russel u@(MkU p) = not $ p u
-  
-  x :: Bool
-  x = russel (MkU russel)
-</programlisting>
-
-        <para>We have never found another class of programs, other
-        than this contrived one, that makes GHC diverge, and fixing
-        the problem would impose an extra overhead on every
-        compilation.  So the bug remains un-fixed.  There is more
-        background in <ulink
-        url="http://research.microsoft.com/~simonpj/Papers/inlining">
-        Secrets of the GHC inliner</ulink>.</para>
-      </listitem>
-
-      <listitem>
-	<para>GHC does not keep careful track of
-	    what instance declarations are 'in scope' if they come from other packages.
-        Instead, all instance declarations that GHC has seen in other
-        packages are all in scope everywhere, whether or not the
-        module from that package is used by the command-line
-        expression.  This bug affects only the <option>--make</option> mode and
-	  GHCi.</para>
-      </listitem>
-
-    </itemizedlist>
-  </sect2>
-
-  <sect2 id="bugs-ghci">
-    <title>Bugs in GHCi (the interactive GHC)</title>
-    <itemizedlist>
-      <listitem>
-	<para>GHCi does not respect the <literal>default</literal>
-        declaration in the module whose scope you are in.  Instead,
-        for expressions typed at the command line, you always get the
-        default default-type behaviour; that is,
-        <literal>default(Int,Double)</literal>.</para>
-
-	<para>It would be better for GHCi to record what the default
-        settings in each module are, and use those of the 'current'
-        module (whatever that is).</para>
-      </listitem>
-
-      <listitem> 
-      <para>On Windows, there's a GNU ld/BFD bug
-      whereby it emits bogus PE object files that have more than
-      0xffff relocations. When GHCi tries to load a package affected by this
-      bug, you get an error message of the form
-<screen>
-Loading package javavm ... linking ... WARNING: Overflown relocation field (# relocs found: 30765)
-</screen>
-      The last time we looked, this bug still
-      wasn't fixed in the BFD codebase, and there wasn't any
-      noticeable interest in fixing it when we reported the bug
-      back in 2001 or so.
-      </para>
-      <para>The workaround is to split up the .o files that make up
-      your package into two or more .o's, along the lines of
-      how the "base" package does it.</para>
-      </listitem>
-    </itemizedlist>
-  </sect2>
-  </sect1>
-
-</chapter>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/debugging.xml b/ghc/docs/users_guide/debugging.xml
deleted file mode 100644
index a325389d46..0000000000
--- a/ghc/docs/users_guide/debugging.xml
+++ /dev/null
@@ -1,599 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<sect1 id="options-debugging">
-  <title>Debugging the compiler</title>
-
-  <indexterm><primary>debugging options (for GHC)</primary></indexterm>
-
-  <para>HACKER TERRITORY. HACKER TERRITORY.  (You were warned.)</para>
-
-  <sect2 id="dumping-output">
-    <title>Dumping out compiler intermediate structures</title>
-    
-    <indexterm><primary>dumping GHC intermediates</primary></indexterm>
-    <indexterm><primary>intermediate passes, output</primary></indexterm>
-    
-    <variablelist>
-      <varlistentry>
-	<term>
-          <option>-ddump-</option><replaceable>pass</replaceable>
-          <indexterm><primary><option>-ddump</option> options</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Make a debugging dump after pass
-        <literal>&lt;pass&gt;</literal> (may be common enough to need
-        a short form&hellip;).  You can get all of these at once
-        (<emphasis>lots</emphasis> of output) by using
-        <option>-v5</option>, or most of them with
-        <option>-v4</option>.  Some of the most useful ones
-        are:</para>
-
-	  <variablelist>
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-parsed</option>:
-                <indexterm><primary><option>-ddump-parsed</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>parser output</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-rn</option>:
-                <indexterm><primary><option>-ddump-rn</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>renamer output</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-tc</option>:
-                <indexterm><primary><option>-ddump-tc</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>typechecker output</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-types</option>:
-                <indexterm><primary><option>-ddump-types</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>Dump a type signature for each value defined at
-              the top level of the module.  The list is sorted
-              alphabetically.  Using <option>-dppr-debug</option>
-              dumps a type signature for all the imported and
-              system-defined things as well; useful for debugging the
-              compiler.</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-deriv</option>:
-                <indexterm><primary><option>-ddump-deriv</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>derived instances</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-ds</option>:
-                <indexterm><primary><option>-ddump-ds</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>desugarer output</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-spec</option>:
-                <indexterm><primary><option>-ddump-spec</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>output of specialisation pass</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-rules</option>:
-                <indexterm><primary><option>-ddump-rules</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>dumps all rewrite rules (including those generated
-	      by the specialisation pass)</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-simpl</option>:
-                <indexterm><primary><option>-ddump-simpl</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>simplifier output (Core-to-Core passes)</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-inlinings</option>:
-                <indexterm><primary><option>-ddump-inlinings</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>inlining info from the simplifier</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-usagesp</option>:
-                <indexterm><primary><option>-ddump-usagesp</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>UsageSP inference pre-inf and output</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-cpranal</option>:
-                <indexterm><primary><option>-ddump-cpranal</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>CPR analyser output</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-stranal</option>:
-                <indexterm><primary><option>-ddump-stranal</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>strictness analyser output</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-cse</option>:
-                <indexterm><primary><option>-ddump-cse</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>CSE pass output</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-workwrap</option>:
-                <indexterm><primary><option>-ddump-workwrap</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>worker/wrapper split output</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-occur-anal</option>:
-                <indexterm><primary><option>-ddump-occur-anal</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>`occurrence analysis' output</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-sat</option>:
-                <indexterm><primary><option>-ddump-sat</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>output of &ldquo;saturate&rdquo; pass</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-stg</option>:
-                <indexterm><primary><option>-ddump-stg</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>output of STG-to-STG passes</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-absC</option>:
-                <indexterm><primary><option>-ddump-absC</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para><emphasis>un</emphasis>flattened Abstract&nbsp;C</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-flatC</option>:
-                <indexterm><primary><option>-ddump-flatC</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para><emphasis>flattened</emphasis> Abstract&nbsp;C</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-realC</option>:
-                <indexterm><primary><option>-ddump-realC</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>same as what goes to the C compiler</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-stix</option>:
-                <indexterm><primary><option>-ddump-stix</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>native-code generator intermediate form</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-asm</option>:
-                <indexterm><primary><option>-ddump-asm</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>assembly language from the native-code generator</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-bcos</option>:
-                <indexterm><primary><option>-ddump-bcos</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>byte code compiler output</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>
-	        <option>-ddump-foreign</option>:
-                <indexterm><primary><option>-ddump-foreign</option></primary></indexterm>
-	      </term>
-	      <listitem>
-		<para>dump foreign export stubs</para>
-	      </listitem>
-	    </varlistentry>
-	  </variablelist>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term>
-          <option>-dverbose-core2core</option>
-          <indexterm><primary><option>-dverbose-core2core</option></primary></indexterm>
-        </term>
-	<term>
-          <option>-dverbose-stg2stg</option>
-          <indexterm><primary><option>-dverbose-stg2stg</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Show the output of the intermediate Core-to-Core and
-        STG-to-STG passes, respectively.  (<emphasis>Lots</emphasis>
-        of output!) So: when we're really desperate:</para>
-
-	  <screen>
-% ghc -noC -O -ddump-simpl -dverbose-simpl -dcore-lint Foo.hs
-</screen>
-
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term>
-          <option>-ddump-simpl-iterations</option>:
-          <indexterm><primary><option>-ddump-simpl-iterations</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Show the output of each <emphasis>iteration</emphasis>
-        of the simplifier (each run of the simplifier has a maximum
-        number of iterations, normally 4).  Used when even
-        <option>-dverbose-simpl</option> doesn't cut it.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-dppr-debug</option>
-          <indexterm><primary><option>-dppr-debug</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Debugging output is in one of several
-          &ldquo;styles.&rdquo; Take the printing of types, for
-          example.  In the &ldquo;user&rdquo; style (the default), the
-          compiler's internal ideas about types are presented in
-          Haskell source-level syntax, insofar as possible.  In the
-          &ldquo;debug&rdquo; style (which is the default for
-          debugging output), the types are printed in with explicit
-          foralls, and variables have their unique-id attached (so you
-          can check for things that look the same but aren't).  This
-          flag makes debugging output appear in the more verbose debug
-          style.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-dppr-user-length</option>
-          <indexterm><primary><option>-dppr-user-length</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>In error messages, expressions are printed to a
-	  certain &ldquo;depth&rdquo;, with subexpressions beyond the
-	  depth replaced by ellipses.  This flag sets the
-	  depth.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-ddump-simpl-stats</option>
-          <indexterm><primary><option>-ddump-simpl-stats option</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Dump statistics about how many of each kind of
-        transformation too place.  If you add
-        <option>-dppr-debug</option> you get more detailed
-        information.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-ddump-rn-trace</option>
-          <indexterm><primary><option>-ddump-rn-trace</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Make the renamer be *real* chatty about what it is
-	upto.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-ddump-rn-stats</option>
-          <indexterm><primary><option>-dshow-rn-stats</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Print out summary of what kind of information the renamer
-        had to bring in.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-dshow-unused-imports</option>
-          <indexterm><primary><option>-dshow-unused-imports</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Have the renamer report what imports does not
-	contribute.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-  </sect2>
-
-  <sect2 id="checking-consistency">
-    <title>Checking for consistency</title>
-
-    <indexterm><primary>consistency checks</primary></indexterm>
-    <indexterm><primary>lint</primary></indexterm>
-
-    <variablelist>
-
-      <varlistentry>
-	<term>
-          <option>-dcore-lint</option>
-          <indexterm><primary><option>-dcore-lint</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Turn on heavyweight intra-pass sanity-checking within
-          GHC, at Core level.  (It checks GHC's sanity, not yours.)</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-dstg-lint</option>:
-          <indexterm><primary><option>-dstg-lint</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Ditto for STG level. (NOTE: currently doesn't work).</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-dusagesp-lint</option>:
-          <indexterm><primary><option>-dstg-lint</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Turn on checks around UsageSP inference
-          (<option>-fusagesp</option>).  This verifies various simple
-          properties of the results of the inference, and also warns
-          if any identifier with a used-once annotation before the
-          inference has a used-many annotation afterwards; this could
-          indicate a non-worksafe transformation is being
-          applied.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-  </sect2>
-
-  <sect2>
-    <title>How to read Core syntax (from some <option>-ddump</option>
-    flags)</title>
-
-    <indexterm><primary>reading Core syntax</primary></indexterm>
-    <indexterm><primary>Core syntax, how to read</primary></indexterm>
-
-    <para>Let's do this by commenting an example.  It's from doing
-    <option>-ddump-ds</option> on this code:
-
-<programlisting>
-skip2 m = m : skip2 (m+2)
-</programlisting>
-
-    Before we jump in, a word about names of things.  Within GHC,
-    variables, type constructors, etc., are identified by their
-    &ldquo;Uniques.&rdquo; These are of the form `letter' plus
-    `number' (both loosely interpreted).  The `letter' gives some idea
-    of where the Unique came from; e.g., <literal>&lowbar;</literal>
-    means &ldquo;built-in type variable&rdquo;; <literal>t</literal>
-    means &ldquo;from the typechecker&rdquo;; <literal>s</literal>
-    means &ldquo;from the simplifier&rdquo;; and so on.  The `number'
-    is printed fairly compactly in a `base-62' format, which everyone
-    hates except me (WDP).</para>
-
-    <para>Remember, everything has a &ldquo;Unique&rdquo; and it is
-    usually printed out when debugging, in some form or another.  So
-    here we go&hellip;</para>
-
-<programlisting>
-Desugared:
-Main.skip2{-r1L6-} :: _forall_ a$_4 =&#62;{{Num a$_4}} -&#62; a$_4 -&#62; [a$_4]
-
---# `r1L6' is the Unique for Main.skip2;
---# `_4' is the Unique for the type-variable (template) `a'
---# `{{Num a$_4}}' is a dictionary argument
-
-_NI_
-
---# `_NI_' means "no (pragmatic) information" yet; it will later
---# evolve into the GHC_PRAGMA info that goes into interface files.
-
-Main.skip2{-r1L6-} =
-    /\ _4 -&#62; \ d.Num.t4Gt -&#62;
-        let {
-          {- CoRec -}
-          +.t4Hg :: _4 -&#62; _4 -&#62; _4
-          _NI_
-          +.t4Hg = (+{-r3JH-} _4) d.Num.t4Gt
-
-          fromInt.t4GS :: Int{-2i-} -&#62; _4
-          _NI_
-          fromInt.t4GS = (fromInt{-r3JX-} _4) d.Num.t4Gt
-
---# The `+' class method (Unique: r3JH) selects the addition code
---# from a `Num' dictionary (now an explicit lambda'd argument).
---# Because Core is 2nd-order lambda-calculus, type applications
---# and lambdas (/\) are explicit.  So `+' is first applied to a
---# type (`_4'), then to a dictionary, yielding the actual addition
---# function that we will use subsequently...
-
---# We play the exact same game with the (non-standard) class method
---# `fromInt'.  Unsurprisingly, the type `Int' is wired into the
---# compiler.
-
-          lit.t4Hb :: _4
-          _NI_
-          lit.t4Hb =
-              let {
-                ds.d4Qz :: Int{-2i-}
-                _NI_
-                ds.d4Qz = I#! 2#
-              } in  fromInt.t4GS ds.d4Qz
-
---# `I# 2#' is just the literal Int `2'; it reflects the fact that
---# GHC defines `data Int = I# Int#', where Int# is the primitive
---# unboxed type.  (see relevant info about unboxed types elsewhere...)
-
---# The `!' after `I#' indicates that this is a *saturated*
---# application of the `I#' data constructor (i.e., not partially
---# applied).
-
-          skip2.t3Ja :: _4 -&#62; [_4]
-          _NI_
-          skip2.t3Ja =
-              \ m.r1H4 -&#62;
-                  let { ds.d4QQ :: [_4]
-                        _NI_
-                        ds.d4QQ =
-                    let {
-                      ds.d4QY :: _4
-                      _NI_
-                      ds.d4QY = +.t4Hg m.r1H4 lit.t4Hb
-                    } in  skip2.t3Ja ds.d4QY
-                  } in
-                  :! _4 m.r1H4 ds.d4QQ
-
-          {- end CoRec -}
-        } in  skip2.t3Ja
-</programlisting>
-
-    <para>(&ldquo;It's just a simple functional language&rdquo; is an
-    unregisterised trademark of Peyton Jones Enterprises, plc.)</para>
-
-  </sect2>
-
-  <sect2 id="unreg">
-    <title>Unregisterised compilation</title>
-    <indexterm><primary>unregisterised compilation</primary></indexterm>
-
-    <para>The term "unregisterised" really means "compile via vanilla
-    C", disabling some of the platform-specific tricks that GHC
-    normally uses to make programs go faster.  When compiling
-    unregisterised, GHC simply generates a C file which is compiled
-    via gcc.</para>
-
-    <para>Unregisterised compilation can be useful when porting GHC to
-    a new machine, since it reduces the prerequisite tools to
-    <command>gcc</command>, <command>as</command>, and
-    <command>ld</command> and nothing more, and furthermore the amount
-    of platform-specific code that needs to be written in order to get
-    unregisterised compilation going is usually fairly small.</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>
-          <option>-unreg</option>:
-          <indexterm><primary><option>-unreg</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Compile via vanilla ANSI C only, turning off
-	  platform-specific optimisations.  NOTE: in order to use
-	  <option>-unreg</option>, you need to have a set of libraries
-	  (including the RTS) built for unregisterised compilation.
-	  This amounts to building GHC with way "u" enabled.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-  </sect2>
-
-</sect1>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter" "sect1") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/ffi-chap.xml b/ghc/docs/users_guide/ffi-chap.xml
deleted file mode 100644
index e1374c4610..0000000000
--- a/ghc/docs/users_guide/ffi-chap.xml
+++ /dev/null
@@ -1,411 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<!-- FFI docs as a chapter -->
-
-<chapter id="ffi">
- <title>
-Foreign function interface (FFI)
- </title>
-
-  <para>GHC (mostly) conforms to the Haskell 98 Foreign Function Interface
-  Addendum 1.0, whose definition is available from <ulink url="http://haskell.org/"><literal>http://haskell.org/</literal></ulink>.</para>
-
-  <para>To enable FFI support in GHC, give the <option>-fffi</option><indexterm><primary><option>-fffi</option></primary>
-    </indexterm>flag, or
-the <option>-fglasgow-exts</option><indexterm><primary><option>-fglasgow-exts</option></primary>
-    </indexterm> flag which implies <option>-fffi</option>
-.</para>
-
-  <para>The FFI support in GHC diverges from the Addendum in the following ways:</para>
-
-  <itemizedlist>
-    <listitem>
-      <para>Syntactic forms and library functions proposed in earlier versions
-      of the FFI are still supported for backwards compatibility.</para>
-    </listitem>
-
-    <listitem>
-      <para>GHC implements a number of GHC-specific extensions to the FFI
-      Addendum.  These extensions are described in <xref linkend="sec-ffi-ghcexts" />, but please note that programs using
-      these features are not portable.  Hence, these features should be
-      avoided where possible.</para>
-    </listitem>
-  </itemizedlist>
-
-  <para>The FFI libraries are documented in the accompanying library
-  documentation; see for example the <literal>Foreign</literal>
-  module.</para>
-
-  <sect1 id="sec-ffi-ghcexts">
-    <title>GHC extensions to the FFI Addendum</title>
-
-    <para>The FFI features that are described in this section are specific to
-    GHC.  Avoid them where possible to not compromise the portability of the
-    resulting code.</para>
-
-    <sect2>
-      <title>Unboxed types</title>
-
-      <para>The following unboxed types may be used as basic foreign types
-      (see FFI Addendum, Section 3.2): <literal>Int#</literal>,
-      <literal>Word#</literal>, <literal>Char#</literal>,
-      <literal>Float#</literal>, <literal>Double#</literal>,
-      <literal>Addr#</literal>, <literal>StablePtr# a</literal>,
-      <literal>MutableByteArray#</literal>, <literal>ForeignObj#</literal>,
-      and <literal>ByteArray#</literal>.</para>
-    </sect2>
-
-  </sect1>
-
-  <sect1 id="sec-ffi-ghc">
-    <title>Using the FFI with GHC</title>
-
-    <para>The following sections also give some hints and tips on the
-    use of the foreign function interface in GHC.</para>
-
-    <sect2 id="foreign-export-ghc">
-      <title>Using <literal>foreign export</literal> and <literal>foreign import ccall "wrapper"</literal> with GHC</title>
-
-      <indexterm><primary><literal>foreign export
-      </literal></primary><secondary>with GHC</secondary>
-      </indexterm>
-
-      <para>When GHC compiles a module (say <filename>M.hs</filename>)
-      which uses <literal>foreign export</literal> or 
-      <literal>foreign import "wrapper"</literal>, it generates two
-      additional files, <filename>M_stub.c</filename> and
-      <filename>M_stub.h</filename>.  GHC will automatically compile
-      <filename>M_stub.c</filename> to generate
-      <filename>M_stub.o</filename> at the same time.</para>
-
-      <para>For a plain <literal>foreign export</literal>, the file
-      <filename>M_stub.h</filename> contains a C prototype for the
-      foreign exported function, and <filename>M_stub.c</filename>
-      contains its definition.  For example, if we compile the
-      following module:</para>
-
-<programlisting>
-module Foo where
-
-foreign export ccall foo :: Int -> IO Int
-
-foo :: Int -> IO Int
-foo n = return (length (f n))
-
-f :: Int -> [Int]
-f 0 = []
-f n = n:(f (n-1))</programlisting>
-
-      <para>Then <filename>Foo_stub.h</filename> will contain
-      something like this:</para>
-
-<programlisting>
-#include "HsFFI.h"
-extern HsInt foo(HsInt a0);</programlisting>
-
-      <para>and <filename>Foo_stub.c</filename> contains the
-      compiler-generated definition of <literal>foo()</literal>.  To
-      invoke <literal>foo()</literal> from C, just <literal>#include
-      "Foo_stub.h"</literal> and call <literal>foo()</literal>.</para>
-
-      <para>The <filename>foo_stub.c</filename> and
-	<filename>foo_stub.h</filename> files can be redirected using the
-	<option>-stubdir</option> option; see <xref linkend="options-output"
-	  />.</para>
-
-      <sect3 id="using-own-main"> 
-	<title>Using your own <literal>main()</literal></title>
-
-	<para>Normally, GHC's runtime system provides a
-	<literal>main()</literal>, which arranges to invoke
-	<literal>Main.main</literal> in the Haskell program.  However,
-	you might want to link some Haskell code into a program which
-	has a main function written in another language, say C.  In
-	order to do this, you have to initialize the Haskell runtime
-	system explicitly.</para>
-
-	<para>Let's take the example from above, and invoke it from a
-	standalone C program.  Here's the C code:</para>
-
-<programlisting>
-#include &lt;stdio.h&gt;
-#include "HsFFI.h"
-
-#ifdef __GLASGOW_HASKELL__
-#include "foo_stub.h"
-#endif
-
-#ifdef __GLASGOW_HASKELL__
-extern void __stginit_Foo ( void );
-#endif
-
-int main(int argc, char *argv[])
-{
-  int i;
-
-  hs_init(&amp;argc, &amp;argv);
-#ifdef __GLASGOW_HASKELL__
-  hs_add_root(__stginit_Foo);
-#endif
-
-  for (i = 0; i &lt; 5; i++) {
-    printf("%d\n", foo(2500));
-  }
-
-  hs_exit();
-  return 0;
-}</programlisting>
-
-	<para>We've surrounded the GHC-specific bits with
-	<literal>#ifdef __GLASGOW_HASKELL__</literal>; the rest of the
-	code should be portable across Haskell implementations that
-	support the FFI standard.</para>
-
-	<para>The call to <literal>hs_init()</literal>
-	initializes GHC's runtime system.  Do NOT try to invoke any
-	Haskell functions before calling
-	<literal>hs_init()</literal>: strange things will
-	undoubtedly happen.</para>
-
-	<para>We pass <literal>argc</literal> and
-	<literal>argv</literal> to <literal>hs_init()</literal>
-	so that it can separate out any arguments for the RTS
-	(i.e. those arguments between
-	<literal>+RTS...-RTS</literal>).</para>
-
-	<para>Next, we call
-	<function>hs_add_root</function><indexterm><primary><function>hs_add_root</function></primary>
-	</indexterm>, a GHC-specific interface which is required to
-	initialise the Haskell modules in the program.  The argument
-	to <function>hs_add_root</function> should be the name of the
-	initialization function for the "root" module in your program
-	- in other words, the module which directly or indirectly
-	imports all the other Haskell modules in the program.  In a
-	standalone Haskell program the root module is normally
-	<literal>Main</literal>, but when you are using Haskell code
-	from a library it may not be.  If your program has multiple
-	root modules, then you can call
-	<function>hs_add_root</function> multiple times, one for each
-	root.  The name of the initialization function for module
-	<replaceable>M</replaceable> is
-	<literal>__stginit_<replaceable>M</replaceable></literal>, and
-	it may be declared as an external function symbol as in the
-	code above.</para>
-
-	<para>After we've finished invoking our Haskell functions, we
-	can call <literal>hs_exit()</literal>, which
-	terminates the RTS.  It runs any outstanding finalizers and
-	generates any profiling or stats output that might have been
-	requested.</para>
-
-	<para>There can be multiple calls to
-	<literal>hs_init()</literal>, but each one should be matched
-	by one (and only one) call to
-	<literal>hs_exit()</literal><footnote><para>The outermost
-	<literal>hs_exit()</literal> will actually de-initialise the
-	system.  NOTE that currently GHC's runtime cannot reliably
-	re-initialise after this has happened.</para>
-	</footnote>.</para>
-
-	<para>NOTE: when linking the final program, it is normally
-	easiest to do the link using GHC, although this isn't
-	essential.  If you do use GHC, then don't forget the flag
-	<option>-no-hs-main</option><indexterm><primary><option>-no-hs-main</option></primary>
-	  </indexterm>, otherwise GHC will try to link
-	to the <literal>Main</literal> Haskell module.</para>
-      </sect3>
-
-      <sect3 id="foreign-export-dynamic-ghc">
-	<title>Using <literal>foreign import ccall "wrapper"</literal> with GHC</title>
-
-	<indexterm><primary><literal>foreign import
-	ccall "wrapper"</literal></primary><secondary>with GHC</secondary>
-	</indexterm>
-
-	<para>When <literal>foreign import ccall "wrapper"</literal> is used
-        in a Haskell module, The C stub file <filename>M_stub.c</filename>
-        generated by GHC contains small helper functions used by the code
-        generated for the imported wrapper, so it must be linked in to the
-        final program.  When linking the program, remember to include
-        <filename>M_stub.o</filename> in the final link command line, or
-        you'll get link errors for the missing function(s) (this isn't
-        necessary when building your program with <literal>ghc
-        &ndash;&ndash;make</literal>, as GHC will automatically link in the
-        correct bits).</para>
-      </sect3>
-    </sect2>
-    
-    <sect2 id="glasgow-foreign-headers">
-      <title>Using function headers</title>
-
-      <indexterm><primary>C calls, function headers</primary></indexterm>
-
-      <para>When generating C (using the <option>-fvia-C</option>
-      directive), one can assist the C compiler in detecting type
-      errors by using the <option>-&num;include</option> directive
-      (<xref linkend="options-C-compiler"/>) to provide
-      <filename>.h</filename> files containing function
-      headers.</para>
-
-      <para>For example,</para>
-
-<programlisting>
-#include "HsFFI.h"
-
-void         initialiseEFS (HsInt size);
-HsInt        terminateEFS (void);
-HsForeignObj emptyEFS(void);
-HsForeignObj updateEFS (HsForeignObj a, HsInt i, HsInt x);
-HsInt        lookupEFS (HsForeignObj a, HsInt i);
-</programlisting>
-
-      <para>The types <literal>HsInt</literal>,
-      <literal>HsForeignObj</literal> etc. are described in the H98 FFI
-      Addendum.</para>
-
-      <para>Note that this approach is only
-      <emphasis>essential</emphasis> for returning
-      <literal>float</literal>s (or if <literal>sizeof(int) !=
-      sizeof(int *)</literal> on your architecture) but is a Good
-      Thing for anyone who cares about writing solid code.  You're
-      crazy not to do it.</para>
-
-<para>
-What if you are importing a module from another package, and
-a cross-module inlining exposes a foreign call that needs a supporting
-<option>-&num;include</option>?  If the imported module is from the same package as
-the module being compiled, you should supply all the <option>-&num;include</option>
-that you supplied when compiling the imported module.  If the imported module comes
-from another package, you won't necessarily know what the appropriate 
-<option>-&num;include</option> options are; but they should be in the package 
-configuration, which GHC knows about.  So if you are building a package, remember
-to put all those <option>-&num;include</option> options into the package configuration.
-See the <literal>c_includes</literal> field in <xref linkend="package-management"/>.
-</para>
-
-<para>
-It is also possible, according the FFI specification, to put the 
-<option>-&num;include</option> option in the foreign import 
-declaration itself:
-<programlisting>
-  foreign import "foo.h f" f :: Int -> IO Int
-</programlisting>
-When compiling this module, GHC will generate a C file that includes
-the specified <option>-&num;include</option>.  However, GHC
-<emphasis>disables</emphasis> cross-module inlining for such foreign
-calls, because it doesn't transport the <option>-&num;include</option>
-information across module boundaries.  (There is no fundamental reason for this;
-it was just tiresome to implement.  The wrapper, which unboxes the arguments
-etc, is still inlined across modules.)  So if you want the foreign call itself
-to be inlined across modules, use the command-line and package-configuration
-<option>-&num;include</option> mechanism.
-</para>
-
-      <sect3 id="finding-header-files">
-	<title>Finding Header files</title>
-
-	<para>Header files named by the <option>-&num;include</option>
-	option or in a <literal>foreign import</literal> declaration
-	are searched for using the C compiler's usual search path.
-	You can add directories to this search path using the
-	<option>-I</option> option (see <xref
-	linkend="c-pre-processor"/>).</para>
-
-	<para>Note: header files are ignored unless compiling via C.
-	If you had been compiling your code using the native code
-	generator (the default) and suddenly switch to compiling via
-	C, then you can get unexpected errors about missing include
-	files.  Compiling via C is enabled automatically when certain
-	options are given (eg. <option>-O</option> and
-	<option>-prof</option> both enable
-	<option>-fvia-C</option>).</para>
-      </sect3>
-
-    </sect2>
-
-    <sect2>
-      <title>Memory Allocation</title>
-
-      <para>The FFI libraries provide several ways to allocate memory
-      for use with the FFI, and it isn't always clear which way is the
-      best.  This decision may be affected by how efficient a
-      particular kind of allocation is on a given compiler/platform,
-      so this section aims to shed some light on how the different
-      kinds of allocation perform with GHC.</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term><literal>alloca</literal> and friends</term>
-	  <listitem>
-	    <para>Useful for short-term allocation when the allocation
-	    is intended to scope over a given <literal>IO</literal>
-	    computation.  This kind of allocation is commonly used
-	    when marshalling data to and from FFI functions.</para>
-
-	    <para>In GHC, <literal>alloca</literal> is implemented
-	    using <literal>MutableByteArray#</literal>, so allocation
-	    and deallocation are fast: much faster than C's
-	    <literal>malloc/free</literal>, but not quite as fast as
-	    stack allocation in C.  Use <literal>alloca</literal>
-	    whenever you can.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>mallocForeignPtr</literal></term>
-	  <listitem>
-	    <para>Useful for longer-term allocation which requires
-	    garbage collection.  If you intend to store the pointer to
-	    the memory in a foreign data structure, then
-	    <literal>mallocForeignPtr</literal> is
-	    <emphasis>not</emphasis> a good choice, however.</para>
-
-	    <para>In GHC, <literal>mallocForeignPtr</literal> is also
-	    implemented using <literal>MutableByteArray#</literal>.
-	    Although the memory is pointed to by a
-	    <literal>ForeignPtr</literal>, there are no actual
-	    finalizers involved (unless you add one with
-	    <literal>addForeignPtrFinalizer</literal>), and the
-	    deallocation is done using GC, so
-	    <literal>mallocForeignPtr</literal> is normally very
-	    cheap.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>malloc/free</literal></term>
-	  <listitem>
-	    <para>If all else fails, then you need to resort to
-	    <literal>Foreign.malloc</literal> and
-	    <literal>Foreign.free</literal>.  These are just wrappers
-	    around the C functions of the same name, and their
-	    efficiency will depend ultimately on the implementations
-	    of these functions in your platform's C library.  We
-	    usually find <literal>malloc</literal> and
-	    <literal>free</literal> to be significantly slower than
-	    the other forms of allocation above.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>Foreign.Marshal.Pool</literal></term>
-	  <listitem>
-	    <para>Pools are currently implemented using
-	    <literal>malloc/free</literal>, so while they might be a
-	    more convenient way to structure your memory allocation
-	    than using one of the other forms of allocation, they
-	    won't be any more efficient.  We do plan to provide an
-	    improved-performance implementation of Pools in the
-	    future, however.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-    </sect2>
-  </sect1>
-</chapter>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/flags.xml b/ghc/docs/users_guide/flags.xml
deleted file mode 100644
index e288da2fb2..0000000000
--- a/ghc/docs/users_guide/flags.xml
+++ /dev/null
@@ -1,1894 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-  <sect1 id="flag-reference">
-    <title>Flag reference</title>
-
-    <para>This section is a quick-reference for GHC's command-line
-    flags.  For each flag, we also list its static/dynamic status (see
-    <xref linkend="static-dynamic-flags"/>), and the flag's opposite
-    (if available).</para>
-
-    <sect2>
-      <title>Help and verbosity options</title>
-
-      <para><xref linkend="options-help"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-?</option></entry>
-	      <entry>help</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-help</option></entry>
-	      <entry>help</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-v</option></entry>
-	      <entry>verbose mode (equivalent to <option>-v3</option>)</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-v</option><replaceable>n</replaceable></entry>
-	      <entry>set verbosity level</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-V</option></entry>
-	      <entry>display GHC version</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>&ndash;&ndash;version</option></entry>
-	      <entry>display GHC version</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>&ndash;&ndash;numeric-version</option></entry>
-	      <entry>display GHC version (numeric only)</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>&ndash;&ndash;print-libdir</option></entry>
-	      <entry>display GHC library directory</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ferror-spans</option></entry>
-	      <entry>output full span in error messages</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-Rghc-timing</option></entry>
-	      <entry>Summarise timing stats for GHC (same as <literal>+RTS -tstderr</literal>)</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-
-    </sect2>
-    <sect2>
-      <title>Which phases to run</title>
-      
-      <para><xref linkend="options-order"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-E</option></entry>
-	      <entry>Stop after preprocessing (<literal>.hspp</literal> file)</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-C</option></entry>
-	      <entry>Stop after generating C (<literal>.hc</literal> file)</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-S</option></entry>
-	      <entry>Stop after generating assembly (<literal>.s</literal> file)</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-c</option></entry>
-	      <entry>Do not link</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-x</option> <replaceable>suffix</replaceable></entry>
-	      <entry>Override default behaviour for source files</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-     <sect2>
-      <title>Alternative modes of operation</title>
-      
-      <para><xref linkend="modes"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>--interactive</option></entry>
-	      <entry>Interactive mode - normally used by just running <command>ghci</command></entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>--make</option></entry>
-	      <entry>Build a multi-module Haskell program, automatically figuring out dependencies. Likely to be much easier, and faster, than using <command>make</command>.</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-e <replaceable>expr</replaceable></option></entry>
-	      <entry>Evaluate <replaceable>expr</replaceable></entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-M</option></entry>
-	      <entry>Generate dependency information suitable for use in a <filename>Makefile</filename>.</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Redirecting output</title>
-      
-      <para><xref linkend="options-output"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-hcsuf</option> <replaceable>suffix</replaceable></entry>
-	      <entry>set the suffix to use for intermediate C files</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-hidir</option> <replaceable>dir</replaceable></entry>
-	      <entry>set directory for interface files</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-hisuf</option> <replaceable>suffix</replaceable></entry>
-	      <entry>set the suffix to use for interface files</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-o</option> <replaceable>filename</replaceable></entry>
-	      <entry>set output filename</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-odir</option> <replaceable>dir</replaceable></entry>
-	      <entry>set output directory</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ohi</option> <replaceable>filename</replaceable></entry>
-	      <entry>set the filename in which to put the interface</entry>
-	      <entry>dynamic</entry>
-	      <entry></entry>
-	    </row>
-	    <row>
-	      <entry><option>-osuf</option> <replaceable>suffix</replaceable></entry>
-	      <entry>set the output file suffix</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-stubdir</option> <replaceable>dir</replaceable></entry>
-	      <entry>redirect FFi stub files</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Keeping intermediate files</title>
-      
-      <para><xref linkend="keeping-intermediates"/></para>
-      
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-keep-hc-file</option></entry>
-	      <entry>retain intermediate <literal>.hc</literal> files</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-keep-s-file</option></entry>
-	      <entry>retain intermediate <literal>.s</literal> files</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-keep-raw-s-file</option></entry>
-	      <entry>retain intermediate <literal>.raw_s</literal> files</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-keep-tmp-files</option></entry>
-	      <entry>retain all intermediate temporary files</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Temporary files</title>
-      
-      <para><xref linkend="temp-files"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-tmpdir</option></entry>
-	      <entry>set the directory for temporary files</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Finding imports</title>
-
-      <para><xref linkend="search-path"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-i</option><replaceable>dir1</replaceable>:<replaceable>dir2</replaceable>:...</entry>
-	      <entry>add <replaceable>dir</replaceable>,
-	          <replaceable>dir2</replaceable>, etc. to import path</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-i</option></entry>
-	      <entry>Empty the import directory list</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Interface file options</title>
-
-      <para><xref linkend="hi-options"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-ddump-hi</option></entry>
-	      <entry>Dump the new interface to stdout</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-hi-diffs</option></entry>
-	      <entry>Show the differences vs. the old interface</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-minimal-imports</option></entry>
-	      <entry>Dump a minimal set of imports</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>--show-iface</option> <replaceable>file</replaceable></entry>
-	      <entry>Read the interface in
-	      <replaceable>file</replaceable> and dump it as text to
-	      <literal>stdout</literal>.</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-    
-    <sect2>
-      <title>Recompilation checking</title>
-
-      <para><xref linkend="recomp"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-no-recomp</option></entry>
-	      <entry>Turn off recompilation checking; implied by any
-	      <option>-ddump-X</option> option</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-recomp</option></entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Interactive-mode options</title>
-      
-      <para><xref linkend="ghci-dot-files"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-ignore-dot-ghci</option></entry>
-	      <entry>Disable reading of <filename>.ghci</filename> files</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-read-dot-ghci</option></entry>
-	      <entry>Enable reading of <filename>.ghci</filename> files</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Packages</title>
-
-      <para><xref linkend="packages"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-    	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-package</option> <replaceable>P</replaceable></entry>
-	      <entry>Expose package <replaceable>P</replaceable></entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-hide-all-packages</option></entry>
-	      <entry>Hide all packages by default</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-hide-package</option> <replaceable>name</replaceable></entry>
-	      <entry>Hide package <replaceable>P</replaceable></entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ignore-package</option> <replaceable>name</replaceable></entry>
-	      <entry>Ignore package <replaceable>P</replaceable></entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-package-conf</option> <replaceable>file</replaceable></entry>
-	      <entry>Load more packages from <replaceable>file</replaceable></entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-no-user-package-conf</option></entry>
-	      <entry>Don't load the user's package config file.</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Language options</title>
-
-      <para><xref linkend="options-language"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-    	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-fallow-overlapping-instances</option></entry>
-	      <entry>Enable overlapping instances</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-allow-overlapping-instances</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-fallow-undecidable-instances</option></entry>
-	      <entry>Enable undecidable instances</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-allow-undecidable-instances</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-fallow-incoherent-instances</option></entry>
-	      <entry>Enable incoherent instances.  
-	      Implies <option>-fallow-overlapping-instances</option> </entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-allow-incoherent-instances</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-farrows</option></entry>
-	      <entry>Enable arrow notation extension</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-arrows</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-fcontext-stack</option><replaceable>n</replaceable></entry>
-	      <entry>set the limit for context reduction</entry>
-	      <entry>static</entry>
-	      <entry><option>-</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-ffi</option> or <option>-fffi</option></entry>
-	      <entry>Enable foreign function interface (implied by
-	      <option>-fglasgow-exts</option>)</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-ffi</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-fgenerics</option></entry>
-	      <entry>Enable generics</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-fgenerics</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-fglasgow-exts</option></entry>
-	      <entry>Enable most language extensions</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-glasgow-exts</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-fimplicit-params</option></entry>
-	      <entry>Enable Implicit Parameters.
-	      Implied by <option>-fglasgow-exts</option>.</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-implicit-params</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-firrefutable-tuples</option></entry>
-	      <entry>Make tuple pattern matching irrefutable</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-irrefutable-tuples</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-fno-implicit-prelude</option></entry>
-	      <entry>Don't implicitly <literal>import Prelude</literal></entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fimplicit-prelude</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-fno-monomorphism-restriction</option></entry>
-	      <entry>Disable the monomorphism restriction</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fmonomorphism-restriction</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-fscoped-type-variables</option></entry>
-	      <entry>Enable lexically-scoped type variables.
-	      Implied by <option>-fglasgow-exts</option>.</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-scoped-type-variables</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-fth</option></entry>
-	      <entry>Enable Template Haskell. 
-		Implied by <option>-fglasgow-exts</option>.</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-th</option></entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Warnings</title>
-      
-      <para>(<xref linkend="options-sanity"/></para>
-
-    <informaltable>
-      <tgroup cols="4" align="left" colsep="1" rowsep="1">
-	<thead>
-	  <row>
-	    <entry>Flag</entry>
-	    <entry>Description</entry>
-	    <entry>Static/Dynamic</entry>
-	    <entry>Reverse</entry>
-	  </row>
-	</thead>
-	<tbody>
-	  <row>
-	    <entry><option>-W</option></entry>
-	    <entry>enable normal warnings</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-w</option></entry>
-	  </row>
-	  <row>
-	    <entry><option>-w</option></entry>
-	    <entry>disable all warnings</entry>
-	    <entry>dynamic</entry>
-	    <entry>-</entry>
-	  </row>
-	  <row>
-	    <entry><option>-Wall</option></entry>
-	    <entry>enable all warnings</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-w</option></entry>
-	  </row>
-	  <row>
-	    <entry><option>-Werror</option></entry>
-	    <entry>make warnings fatal</entry>
-	    <entry>dynamic</entry>
-	    <entry></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-deprecations</option></entry>
-	    <entry>warn about uses of functions &amp; types that are deprecated</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-deprecations</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-duplicate-exports</option></entry>
-	    <entry>warn when an entity is exported multiple times</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-duplicate-exports</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-hi-shadowing</option></entry>
-	    <entry>warn when a <literal>.hi</literal> file in the
-	    current directory shadows a library</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-hi-shadowing</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-incomplete-patterns</option></entry>
-	    <entry>warn when a pattern match could fail</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-incomplete-patterns</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-incomplete-record-updates</option></entry>
-	    <entry>warn when a record update could fail</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-incomplete-record-updates</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-misc</option></entry>
-	    <entry>enable miscellaneous warnings</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-misc</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-missing-fields</option></entry>
-	    <entry>warn when fields of a record are uninitialised</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-missing-fields</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-missing-methods</option></entry>
-	    <entry>warn when class methods are undefined</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-missing-methods</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-missing-signatures</option></entry>
-	    <entry>warn about top-level functions without signatures</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-missing-signatures</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-name-shadowing</option></entry>
-	    <entry>warn when names are shadowed</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-name-shadowing</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-oprhans</option></entry>
-	    <entry>warn when the module contains "orphan" instance declarations
-	    or rewrite rules</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-orphans</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-overlapping-patterns</option></entry>
-	    <entry>warn about overlapping patterns</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-overlapping-patterns</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-simple-patterns</option></entry>
-	    <entry>warn about lambda-patterns that can fail</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-simple-patterns</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-type-defaults</option></entry>
-	    <entry>warn when defaulting happens</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-type-defaults</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-unused-binds</option></entry>
-	    <entry>warn about bindings that are unused</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-unused-binds</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-unused-imports</option></entry>
-	    <entry>warn about unnecessary imports</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-unused-imports</option></entry>
-	  </row>
-
-	  <row>
-	    <entry><option>-fwarn-unused-matches</option></entry>
-	    <entry>warn about variables in patterns that aren't used</entry>
-	    <entry>dynamic</entry>
-	    <entry><option>-fno-warn-unused-matches</option></entry>
-	  </row>
-
-	  </tbody>
-	</tgroup>
-      </informaltable>
-
-    </sect2>
-    <sect2>
-      <title>Optimisation levels</title>
-
-      <para><xref linkend="options-optimise"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-O</option></entry>
-	      <entry>Enable default optimisation (level 1)</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-O0</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-O</option><replaceable>n</replaceable></entry>
-	      <entry>Set optimisation level <replaceable>n</replaceable></entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-O0</option></entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-	      
-    </sect2>
-    <sect2>
-      <title>Individual optimisations</title>
-
-      <para><xref linkend="options-f"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-fcase-merge</option></entry>
-	      <entry>Enable case-merging</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-case-merge</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fdicts-strict</option></entry>
-	      <entry>Make dictionaries strict</entry>
-	      <entry>static</entry>
-	      <entry><option>-fno-dicts-strict</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fdo-eta-reduction</option></entry>
-	      <entry>Enable eta-reduction</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-do-eta-reduction</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fdo-lambda-eta-expansion</option></entry>
-	      <entry>Enable lambda eta-reduction</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-do-lambda-eta-expansion</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fexcess-precision</option></entry>
-	      <entry>Enable excess intermediate precision</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-excess-precision</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-frules-off</option></entry>
-	      <entry>Switch off all rewrite rules (including rules
-	      generated by automatic specialisation of overloaded functions)</entry>
-	      <entry>static</entry>
-	      <entry><option>-frules-off</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fignore-asserts</option></entry>
-	      <entry>Ignore assertions in the source</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-ignore-asserts</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fignore-interface-pragmas</option></entry>
-	      <entry>Ignore pragmas in interface files</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-ignore-interface-pragmas</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fliberate-case-threshold</option></entry>
-	      <entry>Tweak the liberate-case optimisation (default: 10)</entry>
-	      <entry>static</entry>
-	      <entry><option>-fno-liberate-case-threshold</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fomit-interface-pragmas</option></entry>
-	      <entry>Don't generate interface pragmas</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-omit-interface-pragmas</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fmax-worker-args</option></entry>
-	      <entry>If a worker has that many arguments, none will be
-	        unpacked anymore (default: 10)</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fmax-simplifier-iterations</option></entry>
-	      <entry>Set the max iterations for the simplifier</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fno-state-hack</option></entry>
-	      <entry>Turn off the "state hack" whereby any lambda with a real-world state token
-	      as argument is considered to be single-entry.  Hence OK to inline things inside it.</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fno-cse</option></entry>
-	      <entry>Turn off common sub-expression</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fno-full-laziness</option></entry>
-	      <entry>Turn off full laziness (floating bindings outwards).</entry>
-	      <entry>dynamic</entry>
-	      <entry>-ffull-laziness</entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fno-pre-inlining</option></entry>
-	      <entry>Turn off pre-inlining</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-fno-strictness</option></entry>
-	      <entry>Turn off strictness analysis</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-funbox-strict-fields</option></entry>
-	      <entry>Flatten strict constructor fields</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-fno-unbox-strict-fields</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-funfolding-creation-threshold</option></entry>
-	      <entry>Tweak unfolding settings</entry>
-	      <entry>static</entry>
-	      <entry><option>-fno-unfolding-creation-threshold</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-funfolding-fun-discount</option></entry>
-	      <entry>Tweak unfolding settings</entry>
-	      <entry>static</entry>
-	      <entry><option>-fno-unfolding-fun-discount</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-funfolding-keeness-factor</option></entry>
-	      <entry>Tweak unfolding settings</entry>
-	      <entry>static</entry>
-	      <entry><option>-fno-unfolding-keeness-factor</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-funfolding-update-in-place</option></entry>
-	      <entry>Tweak unfolding settings</entry>
-	      <entry>static</entry>
-	      <entry><option>-fno-unfolding-update-in-place</option></entry>
-	    </row>
-
-	    <row>
-	      <entry><option>-funfolding-use-threshold</option></entry>
-	      <entry>Tweak unfolding settings</entry>
-	      <entry>static</entry>
-	      <entry><option>-fno-unfolding-use-threshold</option></entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Profiling options</title>
-      
-      <para><xref linkend="profiling"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-auto</option></entry>
-	      <entry>Auto-add <literal>_scc_</literal>s to all
-	      exported functions</entry>
-	      <entry>static</entry>
-	      <entry><option>-no-auto</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-auto-all</option></entry>
-	      <entry>Auto-add <literal>_scc_</literal>s to all
-	      top-level functions</entry>
-	      <entry>static</entry>
-	      <entry><option>-no-auto-all</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-auto-dicts</option></entry>
-	      <entry>Auto-add <literal>_scc_</literal>s to all dictionaries</entry>
-	      <entry>static</entry>
-	      <entry><option>-no-auto-dicts</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-caf-all</option></entry>
-	      <entry>Auto-add <literal>_scc_</literal>s to all CAFs</entry>
-	      <entry>static</entry>
-	      <entry><option>-no-caf-all</option></entry>
-	    </row>
-	    <row>
-	      <entry><option>-prof</option></entry>
-	      <entry>Turn on profiling</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ticky</option></entry>
-	      <entry>Turn on ticky-ticky profiling</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Parallelism options</title>
-
-      <para><xref linkend="sec-using-parallel"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-gransim</option></entry>
-	      <entry>Enable GRANSIM</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-parallel</option></entry>
-	      <entry>Enable Parallel Haskell</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-smp</option></entry>
-	      <entry>Enable SMP support</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>C pre-processor options</title>
-
-      <para><xref linkend="c-pre-processor"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-cpp</option></entry>
-	      <entry>Run the C pre-processor on Haskell source files</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-D</option><replaceable>symbol</replaceable><optional>=<replaceable>value</replaceable></optional></entry>
-	      <entry>Define a symbol in the C pre-processor</entry>
-	      <entry>dynamic</entry>
-	      <entry><option>-U</option><replaceable>symbol</replaceable></entry>
-	    </row>
-	    <row>
-	      <entry><option>-U</option><replaceable>symbol</replaceable></entry>
-	      <entry>Undefine a symbol in the C pre-processor</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-I</option><replaceable>dir</replaceable></entry>
-	      <entry>Add <replaceable>dir</replaceable> to the
-	      directory search list for <literal>#include</literal> files</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>C compiler options</title>
-
-      <para><xref linkend="options-C-compiler"/></para>
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-#include</option> <replaceable>file</replaceable></entry>
-	      <entry>Include <replaceable>file</replaceable> when
-	      compiling the <filename>.hc</filename> file</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Code generation options</title>
-
-      <para><xref linkend="options-codegen"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-fasm</option></entry>
-	      <entry>Use the native code generator</entry>
-	      <entry>dynamic</entry>
-	      <entry>-fvia-C</entry>
-	    </row>
-	    <row>
-	      <entry><option>-fvia-C</option></entry>
-	      <entry>Compile via C</entry>
-	      <entry>dynamic</entry>
-	      <entry>-fasm</entry>
-	    </row>
-	    <row>
-	      <entry><option>-fno-code</option></entry>
-	      <entry>Omit code generation</entry>
-	      <entry>mode</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Linking options</title>
-
-      <para><xref linkend="options-linker"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-dynamic</option></entry>
-	      <entry>Use dynamic Haskell libraries (if available)</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-framework</option> <replaceable>name</replaceable></entry>
-	      <entry>On Darwin/MacOS X only, link in the framework <replaceable>name</replaceable>.
-		This option corresponds to the <option>-framework</option> option for Apple's Linker.</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-framework-path</option> <replaceable>name</replaceable></entry>
-	      <entry>On Darwin/MacOS X only, add <replaceable>dir</replaceable> to the list of
-	        directories searched for frameworks.
-		This option corresponds to the <option>-F</option> option for Apple's Linker.</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-l</option><replaceable>lib</replaceable></entry>
-	      <entry>Link in library <replaceable>lib</replaceable></entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-L</option><replaceable>dir</replaceable></entry>
-	      <entry>Add <replaceable>dir</replaceable> to the list of
-	      directories searched for libraries</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-main-is</option></entry>
-	      <entry>Set main function</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>--mk-dll</option></entry>
-	      <entry>DLL-creation mode (Windows only)</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-no-hs-main</option></entry>
-	      <entry>Don't assume this program contains <literal>main</literal></entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-no-link</option></entry>
-	      <entry>Omit linking</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-package</option> <replaceable>name</replaceable></entry>
-	      <entry>Link in package <replaceable>name</replaceable></entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-split-objs</option></entry>
-	      <entry>Split objects (for libraries)</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-static</option></entry>
-	      <entry>Use static Haskell libraries</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-threaded</option></entry>
-	      <entry>Use the threaded runtime</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-debug</option></entry>
-	      <entry>Use the debugging runtime</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Replacing phases</title>
-
-      <para><xref linkend="replacing-phases"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-pgmL</option> <replaceable>cmd</replaceable></entry>
-	      <entry>Use <replaceable>cmd</replaceable> as the literate pre-processor</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-pgmP</option> <replaceable>cmd</replaceable></entry>
-	      <entry>Use <replaceable>cmd</replaceable> as the C
-	      pre-processor (with <option>-cpp</option> only)</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-pgmc</option> <replaceable>cmd</replaceable></entry>
-	      <entry>Use <replaceable>cmd</replaceable> as the C compiler</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-pgma</option> <replaceable>cmd</replaceable></entry>
-	      <entry>Use <replaceable>cmd</replaceable> as the assembler</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-pgml</option> <replaceable>cmd</replaceable></entry>
-	      <entry>Use <replaceable>cmd</replaceable> as the linker</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-pgmdll</option> <replaceable>cmd</replaceable></entry>
-	      <entry>Use <replaceable>cmd</replaceable> as the DLL generator</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-pgmdep</option> <replaceable>cmd</replaceable></entry>
-	      <entry>Use <replaceable>cmd</replaceable> as the dependency generator</entry>
-	      <entry>dyanmic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-pgmF</option> <replaceable>cmd</replaceable></entry>
-	      <entry>Use <replaceable>cmd</replaceable> as the pre-processor
-	      (with <option>-F</option> only)</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-      <indexterm><primary><option>-pgmL</option></primary></indexterm>
-      <indexterm><primary><option>-pgmP</option></primary></indexterm>
-      <indexterm><primary><option>-pgmc</option></primary></indexterm>
-      <indexterm><primary><option>-pgma</option></primary></indexterm>
-      <indexterm><primary><option>-pgml</option></primary></indexterm>
-      <indexterm><primary><option>-pgmdll</option></primary></indexterm>
-      <indexterm><primary><option>-pgmdep</option></primary></indexterm>
-      <indexterm><primary><option>-pgmF</option></primary></indexterm>
-
-    </sect2>
-
-    <sect2>
-      <title>Forcing options to particular phases</title>
-
-      <para><xref linkend="forcing-options-through"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-optL</option> <replaceable>option</replaceable></entry>
-	      <entry>pass <replaceable>option</replaceable> to the literate pre-processor</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-optP</option> <replaceable>option</replaceable></entry>
-	      <entry>pass <replaceable>option</replaceable> to cpp (with
-	      <option>-cpp</option> only)</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-optF</option> <replaceable>option</replaceable></entry>
-	      <entry>pass <replaceable>option</replaceable> to the
-	      custom pre-processor</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-optc</option> <replaceable>option</replaceable></entry>
-	      <entry>pass <replaceable>option</replaceable> to the C compiler</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-opta</option> <replaceable>option</replaceable></entry>
-	      <entry>pass <replaceable>option</replaceable> to the assembler</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-optl</option> <replaceable>option</replaceable></entry>
-	      <entry>pass <replaceable>option</replaceable> to the linker</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-optdll</option> <replaceable>option</replaceable></entry>
-	      <entry>pass <replaceable>option</replaceable> to the DLL generator</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-optdep</option> <replaceable>option</replaceable></entry>
-	      <entry>pass <replaceable>option</replaceable> to the dependency generator</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-    <sect2>
-      <title>Platform-specific options</title>
-      
-      <para><xref linkend="options-platform"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-mv8</option></entry>
-	      <entry>(SPARC only) enable version 8 support</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-monly-[32]-regs</option></entry>
-	      <entry>(x86 only) give some registers back to the C compiler</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-         
-    <sect2>
-      <title>External core file options</title>
-
-      <para><xref linkend="ext-core"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-fext-core</option></entry>
-	      <entry>Generate <filename>.hcr</filename> external Core files</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-
-
-    <sect2>
-      <title>Compiler debugging options</title>
-
-      <para><xref linkend="options-debugging"/></para>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-dcore-lint</option></entry>
-	      <entry>Turn on internal sanity checking</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-absC</option></entry>
-	      <entry>Dump abstract C</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-asm</option></entry>
-	      <entry>Dump assembly</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-bcos</option></entry>
-	      <entry>Dump interpreter byte code</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-cpranal</option></entry>
-	      <entry>Dump output from CPR analysis</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-cse</option></entry>
-	      <entry>Dump CSE output</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-deriv</option></entry>
-	      <entry>Dump deriving output</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-ds</option></entry>
-	      <entry>Dump desugarer output</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-flatC</option></entry>
-	      <entry>Dump &ldquo;flat&rdquo; C</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-foreign</option></entry>
-	      <entry>Dump <literal>foreign export</literal> stubs</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-inlinings</option></entry>
-	      <entry>Dump inlining info</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-occur-anal</option></entry>
-	      <entry>Dump occurrence analysis output</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-parsed</option></entry>
-	      <entry>Dump parse tree</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-realC</option></entry>
-	      <entry>Dump &ldquo;real&rdquo; C</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-rn</option></entry>
-	      <entry>Dump renamer output</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-rules</option></entry>
-	      <entry>Dump rules</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-sat</option></entry>
-	      <entry>Dump saturated output</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-simpl</option></entry>
-	      <entry>Dump final simplifier output</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-simpl-iterations</option></entry>
-	      <entry>Dump output from each simplifier iteration</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-spec</option></entry>
-	      <entry>Dump specialiser output</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-stg</option></entry>
-	      <entry>Dump final STG</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-stranal</option></entry>
-	      <entry>Dump strictness analyser output</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-tc</option></entry>
-	      <entry>Dump typechecker output</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-types</option></entry>
-	      <entry>Dump type signatures</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-usagesp</option></entry>
-	      <entry>Dump UsageSP analysis output</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-worker-wrapper</option></entry>
-	      <entry>Dump worker-wrapper output</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-rn-trace</option></entry>
-	      <entry>Trace renamer</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-rn-stats</option></entry>
-	      <entry>Renamer stats</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-stix</option></entry>
-	      <entry>Native code generator intermediate form</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-ddump-simpl-stats</option></entry>
-	      <entry>Dump simplifier stats</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-dppr-debug</option></entry>
-	      <entry>Turn on debug printing (more verbose)</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-dppr-noprags</option></entry>
-	      <entry>Don't output pragma info in dumps</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-dppr-user-length</option></entry>
-	      <entry>Set the depth for printing expressions in error msgs</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-dsource-stats</option></entry>
-	      <entry>Dump haskell source stats</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-dstg-lint</option></entry>
-	      <entry>STG pass sanity checking</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-dstg-stats</option></entry>
-	      <entry>Dump STG stats</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-dusagesp-lint</option></entry>
-	      <entry>UsageSP sanity checker</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-dverbose-core2core</option></entry>
-	      <entry>Show output from each core-to-core pass</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-dverbose-stg2stg</option></entry>
-	      <entry>Show output from each STG-to-STG pass</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-unreg</option></entry>
-	      <entry>Enable unregisterised compilation</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-      
-    <sect2>
-      <title>Misc compiler options</title>
-
-      <informaltable>
-	<tgroup cols="4" align="left" colsep="1" rowsep="1">
-	  <thead>
-	    <row>
-	      <entry>Flag</entry>
-	      <entry>Description</entry>
-	      <entry>Static/Dynamic</entry>
-	      <entry>Reverse</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry><option>-femit-extern-decls</option></entry>
-	      <entry>???</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-fno-hi-version-check</option></entry>
-	      <entry>Don't complain about <literal>.hi</literal> file mismatches</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-dno-black-holing</option></entry>
-	      <entry>Turn off black holing (probably doesn't work)</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-fno-method-sharing</option></entry>
-	      <entry>Don't share specialisations of overloaded functions</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-fhistory-size</option></entry>
-	      <entry>Set simplification history size</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-funregisterised</option></entry>
-	      <entry>Unregisterised compilation (use <option>-unreg</option> instead)</entry>
-	      <entry>static</entry>
-	      <entry>-</entry>
-	    </row>
-	    <row>
-	      <entry><option>-fno-asm-mangling</option></entry>
-	      <entry>Turn off assembly mangling (use <option>-unreg</option> instead)</entry>
-	      <entry>dynamic</entry>
-	      <entry>-</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-    </sect2>
-  </sect1>
-
-
-<!--
-Still to document:
-
-Misc:
-  ,  ( "H"                 , HasArg (setHeapSize . fromIntegral . decodeSize) )
-
-  -Bdir
--->
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/ghci.xml b/ghc/docs/users_guide/ghci.xml
deleted file mode 100644
index 786815d484..0000000000
--- a/ghc/docs/users_guide/ghci.xml
+++ /dev/null
@@ -1,1500 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<chapter id="ghci">
-  <title>Using GHCi</title>
-  <indexterm><primary>GHCi</primary></indexterm>
-  <indexterm><primary>interpreter</primary><see>GHCi</see></indexterm>
-  <indexterm><primary>interactive</primary><see>GHCi</see></indexterm>
-  
-  <para>GHCi<footnote>
-      <para>The &lsquo;i&rsquo; stands for &ldquo;Interactive&rdquo;</para>
-    </footnote>
-  is GHC's interactive environment, in which Haskell expressions can
-  be interactively evaluated and programs can be interpreted.  If
-  you're familiar with <ulink url="http://www.haskell.org/hugs/">Hugs</ulink><indexterm><primary>Hugs</primary>
-  </indexterm>, then you'll be right at home with GHCi.  However, GHCi
-  also has support for interactively loading compiled code, as well as
-  supporting all<footnote><para>except <literal>foreign export</literal>, at the moment</para>
-  </footnote> the language extensions that GHC provides.</para>
-  <indexterm><primary>FFI</primary><secondary>GHCi support</secondary></indexterm>
-  <indexterm><primary>Foreign Function Interface</primary><secondary>GHCi support</secondary></indexterm>
-
-  <sect1>
-    <title>Introduction to GHCi</title>
-
-    <para>Let's start with an example GHCi session.  You can fire up
-    GHCi with the command <literal>ghci</literal>:</para>
-
-<screen>
-$ ghci
-   ___         ___ _
-  / _ \ /\  /\/ __(_)
- / /_\// /_/ / /  | |      GHC Interactive, version 5.04, for Haskell 98.
-/ /_\\/ __  / /___| |      http://www.haskell.org/ghc/
-\____/\/ /_/\____/|_|      Type :? for help.
-
-Loading package base ... linking ... done.
-Loading package haskell98 ... linking ... done.
-Prelude> 
-</screen>
-
-    <para>There may be a short pause while GHCi loads the prelude and
-    standard libraries, after which the prompt is shown.  If we follow
-    the instructions and type <literal>:?</literal> for help, we
-    get:</para>
-
-<screen>
- Commands available from the prompt:
-
-   &lt;stmt&gt;                     evaluate/run &lt;stmt&gt;
-   :add &lt;filename&gt; ...        add module(s) to the current target set
-   :browse [*]&lt;module&gt;        display the names defined by &lt;module&gt;
-   :cd &lt;dir&gt;                  change directory to &lt;dir&gt;
-   :def &lt;cmd&gt; &lt;expr&gt;          define a command :&lt;cmd&gt;
-   :help, :?                  display this list of commands
-   :info [&lt;name&gt; ...]         display information about the given names
-   :load &lt;filename&gt; ...       load module(s) and their dependents
-   :module [+/-] [*]&lt;mod&gt; ... set the context for expression evaluation
-   :reload                    reload the current module set
-
-   :set &lt;option&gt; ...          set options
-   :set args &lt;arg&gt; ...        set the arguments returned by System.getArgs
-   :set prog &lt;progname&gt;       set the value returned by System.getProgName
-   :set prompt &lt;prompt&gt;       set the prompt used in GHCi
- 
-   :show modules              show the currently loaded modules
-   :show bindings             show the current bindings made at the prompt
-
-   :ctags [&lt;file&gt;]            create tags file for Vi (default: "tags")
-   :etags [&lt;file&gt;]            create tags file for Emacs (defauilt: "TAGS")
-   :type &lt;expr&gt;               show the type of &lt;expr&gt;
-   :kind &lt;type&gt;               show the kind of &lt;type&gt;
-   :undef &lt;cmd&gt;               undefine user-defined command :&lt;cmd&gt;
-   :unset &lt;option&gt; ...        unset options
-   :quit                      exit GHCi
-   :!&lt;command&gt;                run the shell command &lt;command&gt;
-
- Options for `:set' and `:unset':
-
-    +r                 revert top-level expressions after each evaluation
-    +s                 print timing/memory stats after each evaluation
-    +t                 print type after evaluation
-    -&lt;flags&gt;           most GHC command line flags can also be set here
-                         (eg. -v2, -fglasgow-exts, etc.)
-</screen>
-
-    <para>We'll explain most of these commands as we go along.  For
-    Hugs users: many things work the same as in Hugs, so you should be
-    able to get going straight away.</para>
-
-    <para>Haskell expressions can be typed at the prompt:</para>
-    <indexterm><primary>prompt</primary><secondary>GHCi</secondary>
-  </indexterm>
-
-<screen>
-Prelude> 1+2
-3
-Prelude> let x = 42 in x / 9
-4.666666666666667
-Prelude> 
-</screen>
-
-    <para>GHCi interprets the whole line as an expression to evaluate.
-    The expression may not span several lines - as soon as you press
-    enter, GHCi will attempt to evaluate it.</para>
-  </sect1>
-
-  <sect1>
-    <title>Loading source files</title>
-
-    <para>Suppose we have the following Haskell source code, which we
-    place in a file <filename>Main.hs</filename>:</para>
-
-<programlisting>
-main = print (fac 20)
-
-fac 0 = 1
-fac n = n * fac (n-1)
-</programlisting>
-
-    <para>You can save <filename>Main.hs</filename> anywhere you like,
-    but if you save it somewhere other than the current
-    directory<footnote><para>If you started up GHCi from the command
-    line then GHCi's current directory is the same as the current
-    directory of the shell from which it was started.  If you started
-    GHCi from the &ldquo;Start&rdquo; menu in Windows, then the
-    current directory is probably something like
-    <filename>C:\Documents and Settings\<replaceable>user
-    name</replaceable></filename>.</para> </footnote> then we will
-    need to change to the right directory in GHCi:</para>
-
-<screen>
-Prelude> :cd <replaceable>dir</replaceable>
-</screen>
-
-    <para>where <replaceable>dir</replaceable> is the directory (or
-    folder) in which you saved <filename>Main.hs</filename>.</para>
-
-    <para>To load a Haskell source file into GHCi, use the
-    <literal>:load</literal> command:</para>
-    <indexterm><primary><literal>:load</literal></primary></indexterm>
-
-<screen>
-Prelude> :load Main
-Compiling Main             ( Main.hs, interpreted )
-Ok, modules loaded: Main.
-*Main>
-</screen>
-
-    <para>GHCi has loaded the <literal>Main</literal> module, and the
-    prompt has changed to &ldquo;<literal>*Main></literal>&rdquo; to
-    indicate that the current context for expressions typed at the
-    prompt is the <literal>Main</literal> module we just loaded (we'll
-    explain what the <literal>*</literal> means later in <xref
-    linkend="ghci-scope"/>).  So we can now type expressions involving
-    the functions from <filename>Main.hs</filename>:</para>
-
-<screen>
-*Main> fac 17
-355687428096000
-</screen>
-
-    <para>Loading a multi-module program is just as straightforward;
-    just give the name of the &ldquo;topmost&rdquo; module to the
-    <literal>:load</literal> command (hint: <literal>:load</literal>
-    can be abbreviated to <literal>:l</literal>).  The topmost module
-    will normally be <literal>Main</literal>, but it doesn't have to
-    be.  GHCi will discover which modules are required, directly or
-    indirectly, by the topmost module, and load them all in dependency
-    order.</para>
-
-    <sect2 id="ghci-modules-filenames">
-      <title>Modules vs. filenames</title>
-      <indexterm><primary>modules</primary><secondary>and filenames</secondary></indexterm>
-      <indexterm><primary>filenames</primary><secondary>of modules</secondary></indexterm>
-      
-      <para>Question: How does GHC find the filename which contains
-      module <replaceable>M</replaceable>?  Answer: it looks for the
-      file <literal><replaceable>M</replaceable>.hs</literal>, or
-      <literal><replaceable>M</replaceable>.lhs</literal>.  This means
-      that for most modules, the module name must match the filename.
-      If it doesn't, GHCi won't be able to find it.</para>
-
-      <para>There is one exception to this general rule: when you load
-      a program with <literal>:load</literal>, or specify it when you
-      invoke <literal>ghci</literal>, you can give a filename rather
-      than a module name.  This filename is loaded if it exists, and
-      it may contain any module you like.  This is particularly
-      convenient if you have several <literal>Main</literal> modules
-      in the same directory and you can't call them all
-      <filename>Main.hs</filename>.</para>
-
-      <para>The search path for finding source files is specified with
-      the <option>-i</option> option on the GHCi command line, like
-      so:</para>
-<screen>ghci -i<replaceable>dir<subscript>1</subscript></replaceable>:...:<replaceable>dir<subscript>n</subscript></replaceable></screen>
-
-      <para>or it can be set using the <literal>:set</literal> command
-      from within GHCi (see <xref
-      linkend="ghci-cmd-line-options"/>)<footnote><para>Note that in
-      GHCi, and <option>&ndash;&ndash;make</option> mode, the <option>-i</option>
-      option is used to specify the search path for
-      <emphasis>source</emphasis> files, whereas in standard
-      batch-compilation mode the <option>-i</option> option is used to
-      specify the search path for interface files, see <xref
-      linkend="search-path"/>.</para> </footnote></para>
-
-      <para>One consequence of the way that GHCi follows dependencies
-      to find modules to load is that every module must have a source
-      file.  The only exception to the rule is modules that come from
-      a package, including the <literal>Prelude</literal> and standard
-      libraries such as <literal>IO</literal> and
-      <literal>Complex</literal>.  If you attempt to load a module for
-      which GHCi can't find a source file, even if there are object
-      and interface files for the module, you'll get an error
-      message.</para>
-    </sect2>
-
-    <sect2>
-      <title>Making changes and recompilation</title>
-      <indexterm><primary><literal>:reload</literal></primary></indexterm>
-
-      <para>If you make some changes to the source code and want GHCi
-      to recompile the program, give the <literal>:reload</literal>
-      command.  The program will be recompiled as necessary, with GHCi
-      doing its best to avoid actually recompiling modules if their
-      external dependencies haven't changed.  This is the same
-      mechanism we use to avoid re-compiling modules in the batch
-      compilation setting (see <xref linkend="recomp"/>).</para>
-    </sect2>
-  </sect1>
-
-  <sect1 id="ghci-compiled">
-    <title>Loading compiled code</title>
-    <indexterm><primary>compiled code</primary><secondary>in GHCi</secondary></indexterm>
-
-    <para>When you load a Haskell source module into GHCi, it is
-    normally converted to byte-code and run using the interpreter.
-    However, interpreted code can also run alongside compiled code in
-    GHCi; indeed, normally when GHCi starts, it loads up a compiled
-    copy of the <literal>base</literal> package, which contains the
-    <literal>Prelude</literal>.</para>
-
-    <para>Why should we want to run compiled code?  Well, compiled
-    code is roughly 10x faster than interpreted code, but takes about
-    2x longer to produce (perhaps longer if optimisation is on).  So
-    it pays to compile the parts of a program that aren't changing
-    very often, and use the interpreter for the code being actively
-    developed.</para>
-
-    <para>When loading up source files with <literal>:load</literal>,
-    GHCi looks for any corresponding compiled object files, and will
-    use one in preference to interpreting the source if possible.  For
-    example, suppose we have a 4-module program consisting of modules
-    A, B, C, and D.  Modules B and C both import D only,
-    and A imports both B &amp; C:</para>
-<screen>
-      A
-     / \
-    B   C
-     \ /
-      D
-</screen>
-    <para>We can compile D, then load the whole program, like this:</para>
-<screen>
-Prelude> :! ghc -c D.hs
-Prelude> :load A
-Skipping  D                ( D.hs, D.o )
-Compiling C                ( C.hs, interpreted )
-Compiling B                ( B.hs, interpreted )
-Compiling A                ( A.hs, interpreted )
-Ok, modules loaded: A, B, C, D.
-*Main>
-</screen>
-
-    <para>In the messages from the compiler, we see that it skipped D,
-    and used the object file <filename>D.o</filename>.  The message
-    <literal>Skipping</literal> <replaceable>module</replaceable>
-    indicates that compilation for <replaceable>module</replaceable>
-    isn't necessary, because the source and everything it depends on
-    is unchanged since the last compilation.</para>
-
-    <para>At any time you can use the command 
-    <literal>:show modules</literal>
-    to get a list of the modules currently loaded
-    into GHCi:</para>
-
-<screen>
-*Main> :show modules
-D                ( D.hs, D.o )
-C                ( C.hs, interpreted )
-B                ( B.hs, interpreted )
-A                ( A.hs, interpreted )
-*Main></screen>
-
-    <para>If we now modify the source of D (or pretend to: using Unix
-    command <literal>touch</literal> on the source file is handy for
-    this), the compiler will no longer be able to use the object file,
-    because it might be out of date:</para>
-
-<screen>
-*Main> :! touch D.hs
-*Main> :reload
-Compiling D                ( D.hs, interpreted )
-Skipping  C                ( C.hs, interpreted )
-Skipping  B                ( B.hs, interpreted )
-Skipping  A                ( A.hs, interpreted )
-Ok, modules loaded: A, B, C, D.
-*Main> 
-</screen>
-
-    <para>Note that module D was compiled, but in this instance
-    because its source hadn't really changed, its interface remained
-    the same, and the recompilation checker determined that A, B and C
-    didn't need to be recompiled.</para>
-
-    <para>So let's try compiling one of the other modules:</para>
-
-<screen>
-*Main> :! ghc -c C.hs
-*Main> :load A
-Compiling D                ( D.hs, interpreted )
-Compiling C                ( C.hs, interpreted )
-Compiling B                ( B.hs, interpreted )
-Compiling A                ( A.hs, interpreted )
-Ok, modules loaded: A, B, C, D.
-</screen>
-
-    <para>We didn't get the compiled version of C!  What happened?
-    Well, in GHCi a compiled module may only depend on other compiled
-    modules, and in this case C depends on D, which doesn't have an
-    object file, so GHCi also rejected C's object file.  Ok, so let's
-    also compile D:</para>
-
-<screen>
-*Main> :! ghc -c D.hs
-*Main> :reload
-Ok, modules loaded: A, B, C, D.
-</screen>
-
-    <para>Nothing happened!  Here's another lesson: newly compiled
-    modules aren't picked up by <literal>:reload</literal>, only
-    <literal>:load</literal>:</para>
-
-<screen>
-*Main> :load A
-Skipping  D                ( D.hs, D.o )
-Skipping  C                ( C.hs, C.o )
-Compiling B                ( B.hs, interpreted )
-Compiling A                ( A.hs, interpreted )
-Ok, modules loaded: A, B, C, D.
-</screen>
-
-    <para>HINT: since GHCi will only use a compiled object file if it
-    can sure that the compiled version is up-to-date, a good technique
-    when working on a large program is to occasionally run
-    <literal>ghc &ndash;&ndash;make</literal> to compile the whole project (say
-    before you go for lunch :-), then continue working in the
-    interpreter.  As you modify code, the new modules will be
-    interpreted, but the rest of the project will remain
-    compiled.</para>
-
-  </sect1>
-
-  <sect1>
-    <title>Interactive evaluation at the prompt</title>
-
-    <para>When you type an expression at the prompt, GHCi immediately
-    evaluates and prints the result:
-<screen>
-Prelude> reverse "hello"
-"olleh"
-Prelude> 5+5
-10
-</screen>
-</para>
-
-<sect2><title>I/O actions at the prompt</title>
-
-<para>GHCi does more than simple expression evaluation at the prompt.
-If you type something of type <literal>IO a</literal> for some
-    <literal>a</literal>, then GHCi <emphasis>executes</emphasis> it
-    as an IO-computation.
-<screen>
-Prelude> "hello"
-"hello"
-Prelude> putStrLn "hello"
-hello
-</screen>
-Furthermore, GHCi will print the result of the I/O action if (and only
-if):
-<itemizedlist>
-  <listitem><para>The result type is an instance of <literal>Show</literal>.</para></listitem>
-  <listitem><para>The result type is not
-  <literal>()</literal>.</para></listitem>
-</itemizedlist>
-For example, remembering that <literal>putStrLn :: String -> IO ()</literal>:
-<screen>
-Prelude> putStrLn "hello"
-hello
-Prelude> do { putStrLn "hello"; return "yes" }
-hello
-"yes"
-</screen>
-</para></sect2>
-
-    <sect2>
-      <title>Using <literal>do-</literal>notation at the prompt</title>
-      <indexterm><primary>do-notation</primary><secondary>in GHCi</secondary></indexterm>
-      <indexterm><primary>statements</primary><secondary>in GHCi</secondary></indexterm>
-      
-      <para>GHCi actually accepts <firstterm>statements</firstterm>
-      rather than just expressions at the prompt.  This means you can
-      bind values and functions to names, and use them in future
-      expressions or statements.</para>
-
-      <para>The syntax of a statement accepted at the GHCi prompt is
-      exactly the same as the syntax of a statement in a Haskell
-      <literal>do</literal> expression.  However, there's no monad
-      overloading here: statements typed at the prompt must be in the
-      <literal>IO</literal> monad.
-<screen>
-Prelude> x &lt;- return 42
-42
-Prelude> print x
-42
-Prelude>
-</screen>
-      The statement <literal>x &lt;- return 42</literal> means
-      &ldquo;execute <literal>return 42</literal> in the
-      <literal>IO</literal> monad, and bind the result to
-      <literal>x</literal>&rdquo;.  We can then use
-      <literal>x</literal> in future statements, for example to print
-      it as we did above.</para>
-
-      <para>GHCi will print the result of a statement if and only if: 
-	<itemizedlist>
-	  <listitem>
-	    <para>The statement is not a binding, or it is a monadic binding 
-	      (<literal>p &lt;- e</literal>) that binds exactly one
-	      variable.</para>
-	  </listitem>
-	  <listitem>
-	    <para>The variable's type is not polymorphic, is not
-	      <literal>()</literal>, and is an instance of
-	      <literal>Show</literal></para>
-	  </listitem>
-	</itemizedlist>
-      </para>
-
-      <para>Of course, you can also bind normal non-IO expressions
-      using the <literal>let</literal>-statement:</para>
-<screen>
-Prelude> let x = 42
-Prelude> x
-42
-Prelude>
-</screen>
-      <para>Another important difference between the two types of binding
-      is that the monadic bind (<literal>p &lt;- e</literal>) is
-      <emphasis>strict</emphasis> (it evaluates <literal>e</literal>),
-      whereas with the <literal>let</literal> form, the expression
-      isn't evaluated immediately:</para>
-<screen>
-Prelude> let x = error "help!"
-Prelude> print x
-*** Exception: help!
-Prelude>
-</screen>
-
-      <para>Note that <literal>let</literal> bindings do not automatically
-	print the value bound, unlike monadic bindings.</para>
-
-      <para>Any exceptions raised during the evaluation or execution
-      of the statement are caught and printed by the GHCi command line
-      interface (for more information on exceptions, see the module
-      <literal>Control.Exception</literal> in the libraries
-      documentation).</para>
-
-      <para>Every new binding shadows any existing bindings of the
-      same name, including entities that are in scope in the current
-      module context.</para>
-
-      <para>WARNING: temporary bindings introduced at the prompt only
-      last until the next <literal>:load</literal> or
-      <literal>:reload</literal> command, at which time they will be
-      simply lost.  However, they do survive a change of context with
-      <literal>:module</literal>: the temporary bindings just move to
-      the new location.</para>
-
-      <para>HINT: To get a list of the bindings currently in scope, use the
-      <literal>:show bindings</literal> command:</para>
-
-<screen>
-Prelude> :show bindings
-x :: Int
-Prelude></screen>
-
-      <para>HINT: if you turn on the <literal>+t</literal> option,
-      GHCi will show the type of each variable bound by a statement.
-      For example:</para>
-      <indexterm><primary><literal>+t</literal></primary></indexterm>
-<screen>
-Prelude> :set +t
-Prelude> let (x:xs) = [1..]
-x :: Integer
-xs :: [Integer]
-</screen>
-
-    </sect2>
-
-    <sect2 id="ghci-scope">
-      <title>What's really in scope at the prompt?</title> 
-
-      <para>When you type an expression at the prompt, what
-      identifiers and types are in scope?  GHCi provides a flexible
-      way to control exactly how the context for an expression is
-      constructed.  Let's start with the simple cases; when you start
-      GHCi the prompt looks like this:</para>
-
-<screen>Prelude></screen>
-
-      <para>Which indicates that everything from the module
-      <literal>Prelude</literal> is currently in scope.  If we now
-      load a file into GHCi, the prompt will change:</para>
-
-<screen>
-Prelude> :load Main.hs
-Compiling Main             ( Main.hs, interpreted )
-*Main>
-</screen>
-
-      <para>The new prompt is <literal>*Main</literal>, which
-      indicates that we are typing expressions in the context of the
-      top-level of the <literal>Main</literal> module.  Everything
-      that is in scope at the top-level in the module
-      <literal>Main</literal> we just loaded is also in scope at the
-      prompt (probably including <literal>Prelude</literal>, as long
-      as <literal>Main</literal> doesn't explicitly hide it).</para>
-
-      <para>The syntax
-      <literal>*<replaceable>module</replaceable></literal> indicates
-      that it is the full top-level scope of
-      <replaceable>module</replaceable> that is contributing to the
-      scope for expressions typed at the prompt.  Without the
-      <literal>*</literal>, just the exports of the module are
-      visible.</para>
-
-      <para>We're not limited to a single module: GHCi can combine
-      scopes from multiple modules, in any mixture of
-      <literal>*</literal> and non-<literal>*</literal> forms.  GHCi
-      combines the scopes from all of these modules to form the scope
-      that is in effect at the prompt.  For technical reasons, GHCi
-      can only support the <literal>*</literal>-form for modules which
-      are interpreted, so compiled modules and package modules can
-      only contribute their exports to the current scope.</para>
-
-      <para>The scope is manipulated using the
-      <literal>:module</literal> command.  For example, if the current
-      scope is <literal>Prelude</literal>, then we can bring into
-      scope the exports from the module <literal>IO</literal> like
-      so:</para>
-
-<screen>
-Prelude> :module +IO
-Prelude,IO> hPutStrLn stdout "hello\n"
-hello
-Prelude,IO>
-</screen>
-
-      <para>(Note: <literal>:module</literal> can be shortened to
-      <literal>:m</literal>). The full syntax of the
-      <literal>:module</literal> command is:</para>
-
-<screen>
-:module <optional>+|-</optional> <optional>*</optional><replaceable>mod<subscript>1</subscript></replaceable> ... <optional>*</optional><replaceable>mod<subscript>n</subscript></replaceable>
-</screen>
-
-      <para>Using the <literal>+</literal> form of the
-      <literal>module</literal> commands adds modules to the current
-      scope, and <literal>-</literal> removes them.  Without either
-      <literal>+</literal> or <literal>-</literal>, the current scope
-      is replaced by the set of modules specified.  Note that if you
-      use this form and leave out <literal>Prelude</literal>, GHCi
-      will assume that you really wanted the
-      <literal>Prelude</literal> and add it in for you (if you don't
-      want the <literal>Prelude</literal>, then ask to remove it with
-      <literal>:m -Prelude</literal>).</para>
-
-      <para>The scope is automatically set after a
-      <literal>:load</literal> command, to the most recently loaded
-      "target" module, in a <literal>*</literal>-form if possible.
-      For example, if you say <literal>:load foo.hs bar.hs</literal>
-      and <filename>bar.hs</filename> contains module
-      <literal>Bar</literal>, then the scope will be set to
-      <literal>*Bar</literal> if <literal>Bar</literal> is
-      interpreted, or if <literal>Bar</literal> is compiled it will be
-      set to <literal>Prelude,Bar</literal> (GHCi automatically adds
-      <literal>Prelude</literal> if it isn't present and there aren't
-      any <literal>*</literal>-form modules).</para>
-
-      <para>With multiple modules in scope, especially multiple
-      <literal>*</literal>-form modules, it is likely that name
-      clashes will occur.  Haskell specifies that name clashes are
-      only reported when an ambiguous identifier is used, and GHCi
-      behaves in the same way for expressions typed at the
-      prompt.</para>
-
-      <sect3>
-	<title>Qualified names</title>
-
-	<para>To make life slightly easier, the GHCi prompt also
-        behaves as if there is an implicit <literal>import
-        qualified</literal> declaration for every module in every
-        package, and every module currently loaded into GHCi.</para>
-      </sect3>
-    </sect2>
-  
-
-    <sect2>
-      <title>The <literal>it</literal> variable</title>
-      <indexterm><primary><literal>it</literal></primary>
-      </indexterm>
-      
-      <para>Whenever an expression (or a non-binding statement, to be
-      precise) is typed at the prompt, GHCi implicitly binds its value
-      to the variable <literal>it</literal>.  For example:</para>
-<screen>
-Prelude> 1+2
-3
-Prelude> it * 2
-6
-</screen>
-    <para>What actually happens is that GHCi typechecks the
-    expression, and if it doesn't have an <literal>IO</literal> type,
-    then it transforms it as follows: an expression
-    <replaceable>e</replaceable> turns into 
-<screen>     
-             let it = <replaceable>e</replaceable>;
-             print it
-</screen>
-    which is then run as an IO-action.</para>
-
-    <para>Hence, the original expression must have a type which is an
-    instance of the <literal>Show</literal> class, or GHCi will
-    complain:</para>
-
-<screen>
-Prelude> id
-No instance for `Show (a -> a)'
-arising from use of `print'
-in a `do' expression pattern binding: print it
-</screen>
-
-    <para>The error message contains some clues as to the
-    transformation happening internally.</para>
-
-      <para>If the expression was instead of type <literal>IO a</literal> for
-      some <literal>a</literal>, then <literal>it</literal> will be
-      bound to the result of the <literal>IO</literal> computation,
-      which is of type <literal>a</literal>.  eg.:</para>
-<screen>
-Prelude> Time.getClockTime
-Prelude> print it
-Wed Mar 14 12:23:13 GMT 2001
-</screen>
-
-      <para>The corresponding translation for an IO-typed
-      <replaceable>e</replaceable> is
-<screen>     
-             it &lt;- <replaceable>e</replaceable>
-</screen>
-      </para>
-
-      <para>Note that <literal>it</literal> is shadowed by the new
-      value each time you evaluate a new expression, and the old value
-      of <literal>it</literal> is lost.</para>
-
-    </sect2>
-
-    <sect2>
-      <title>Type defaulting in GHCi</title>
-    <indexterm><primary>Type default</primary></indexterm>
-    <indexterm><primary><literal>Show</literal> class</primary></indexterm>
-      <para>
-      Consider this GHCi session:
-<programlisting>
-  ghci> reverse []
-</programlisting>
-      What should GHCi do?  Strictly speaking, the program is ambiguous.  <literal>show (reverse [])</literal>
-      (which is what GHCi computes here) has type <literal>Show a => a</literal> and how that displays depends 
-      on the type <literal>a</literal>.  For example:
-<programlisting>
-  ghci> (reverse []) :: String
-  ""
-  ghci> (reverse []) :: [Int]
-  []
-</programlisting>
-    However, it is tiresome for the user to have to specify the type, so GHCi extends Haskell's type-defaulting
-    rules (Section 4.3.4 of the Haskell 98 Report (Revised)) as follows.  The
-    standard rules take each group of constraints <literal>(C1 a, C2 a, ..., Cn
-    a)</literal> for each type variable <literal>a</literal>, and defaults the
-    type variable if 
-	<itemizedlist>
-	    <listitem><para> The type variable <literal>a</literal>
-	appears in no other constraints </para></listitem>
-	    <listitem><para> All the classes <literal>Ci</literal> are standard.</para></listitem>
-	    <listitem><para> At least one of the classes <literal>Ci</literal> is
-	    numeric.</para></listitem>
-      </itemizedlist>
-   At the GHCi prompt, the second and third rules are relaxed as follows
-   (differences italicised):
-	<itemizedlist>
-	    <listitem><para> <emphasis>All</emphasis> of the classes
-	    <literal>Ci</literal> are single-parameter type classes.</para></listitem>
-	    <listitem><para> At least one of the classes <literal>Ci</literal> is
-	    numeric, <emphasis>or is <literal>Show</literal>, 
-		<literal>Eq</literal>, or <literal>Ord</literal></emphasis>.</para></listitem>
-      </itemizedlist>
-   </para>
-    </sect2>
-  </sect1>
-
-  <sect1 id="ghci-invocation">
-    <title>Invoking GHCi</title>
-    <indexterm><primary>invoking</primary><secondary>GHCi</secondary></indexterm>
-    <indexterm><primary><option>&ndash;&ndash;interactive</option></primary></indexterm>
-
-    <para>GHCi is invoked with the command <literal>ghci</literal> or
-    <literal>ghc &ndash;&ndash;interactive</literal>.  One or more modules or
-    filenames can also be specified on the command line; this
-    instructs GHCi to load the specified modules or filenames (and all
-    the modules they depend on), just as if you had said
-    <literal>:load <replaceable>modules</replaceable></literal> at the
-    GHCi prompt (see <xref linkend="ghci-commands"/>).  For example, to
-    start GHCi and load the program whose topmost module is in the
-    file <literal>Main.hs</literal>, we could say:</para>
-
-<screen>
-$ ghci Main.hs
-</screen>
-
-    <para>Most of the command-line options accepted by GHC (see <xref
-    linkend="using-ghc"/>) also make sense in interactive mode.  The ones
-    that don't make sense are mostly obvious; for example, GHCi
-    doesn't generate interface files, so options related to interface
-    file generation won't have any effect.</para>
-
-    <sect2>
-      <title>Packages</title>
-      <indexterm><primary>packages</primary><secondary>with GHCi</secondary></indexterm>
-
-      <para>Most packages (see <xref linkend="using-packages"/>) are
-      available without needing to specify any extra flags at all:
-      they will be automatically loaded the first time they are
-      needed.</para>
-
-      <para>For non-auto packages, however, you need to request the
-      package be loaded by using the <literal>-package</literal> flag:</para>
-
-<screen>
-$ ghci -package data
-   ___         ___ _
-  / _ \ /\  /\/ __(_)
- / /_\// /_/ / /  | |      GHC Interactive, version 5.05, for Haskell 98.
-/ /_\\/ __  / /___| |      http://www.haskell.org/ghc/
-\____/\/ /_/\____/|_|      Type :? for help.
-
-Loading package base ... linking ... done.
-Loading package haskell98 ... linking ... done.
-Loading package lang ... linking ... done.
-Loading package concurrent ... linking ... done.
-Loading package readline ... linking ... done.
-Loading package unix ... linking ... done.
-Loading package posix ... linking ... done.
-Loading package util ... linking ... done.
-Loading package data ... linking ... done.
-Prelude> 
-</screen>
-
-      <para>The following command works to load new packages into a
-      running GHCi:</para>
-
-<screen>
-Prelude> :set -package <replaceable>name</replaceable>
-</screen>
-
-      <para>But note that doing this will cause all currently loaded
-      modules to be unloaded, and you'll be dumped back into the
-      <literal>Prelude</literal>.</para>
-    </sect2>
-
-    <sect2>
-      <title>Extra libraries</title>
-      <indexterm><primary>libraries</primary><secondary>with GHCi</secondary></indexterm>
-      
-      <para>Extra libraries may be specified on the command line using
-      the normal <literal>-l<replaceable>lib</replaceable></literal>
-      option.  (The term <emphasis>library</emphasis> here refers to
-      libraries of foreign object code; for using libraries of Haskell
-      source code, see <xref linkend="ghci-modules-filenames"/>.) For
-      example, to load the &ldquo;m&rdquo; library:</para>
-
-<screen>
-$ ghci -lm
-</screen>
-
-      <para>On systems with <literal>.so</literal>-style shared
-      libraries, the actual library loaded will the
-      <filename>lib<replaceable>lib</replaceable>.so</filename>.  GHCi
-      searches the following places for libraries, in this order:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para>Paths specified using the
-          <literal>-L<replaceable>path</replaceable></literal>
-          command-line option,</para>
-	</listitem>
-	<listitem>
-	  <para>the standard library search path for your system,
-	  which on some systems may be overridden by setting the
-	  <literal>LD_LIBRARY_PATH</literal> environment
-	  variable.</para>
-	</listitem>
-      </itemizedlist>
-
-      <para>On systems with <literal>.dll</literal>-style shared
-      libraries, the actual library loaded will be
-      <filename><replaceable>lib</replaceable>.dll</filename>.  Again,
-      GHCi will signal an error if it can't find the library.</para>
-
-      <para>GHCi can also load plain object files
-      (<literal>.o</literal> or <literal>.obj</literal> depending on
-      your platform) from the command-line.  Just add the name the
-      object file to the command line.</para>
-
-      <para>Ordering of <option>-l</option> options matters: a library
-      should be mentioned <emphasis>before</emphasis> the libraries it
-      depends on (see <xref linkend="options-linker"/>).</para>
-    </sect2>
-
-  </sect1>
-
-  <sect1 id="ghci-commands">
-    <title>GHCi commands</title>
-
-    <para>GHCi commands all begin with
-    &lsquo;<literal>:</literal>&rsquo; and consist of a single command
-    name followed by zero or more parameters.  The command name may be
-    abbreviated, as long as the abbreviation is not ambiguous.  All of
-    the builtin commands, with the exception of
-    <literal>:unset</literal> and <literal>:undef</literal>, may be
-    abbreviated to a single letter.</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>
-          <literal>:add</literal> <replaceable>module</replaceable> ...
-          <indexterm><primary><literal>:add</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Add <replaceable>module</replaceable>(s) to the
-	  current <firstterm>target set</firstterm>, and perform a
-	  reload.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:browse</literal> <optional><literal>*</literal></optional><replaceable>module</replaceable> ...
-          <indexterm><primary><literal>:browse</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Displays the identifiers defined by the module
-	  <replaceable>module</replaceable>, which must be either
-	  loaded into GHCi or be a member of a package.  If the
-	  <literal>*</literal> symbol is placed before the module
-	  name, then <emphasis>all</emphasis> the identifiers defined
-	  in <replaceable>module</replaceable> are shown; otherwise
-	  the list is limited to the exports of
-	  <replaceable>module</replaceable>.  The
-	  <literal>*</literal>-form is only available for modules
-	  which are interpreted; for compiled modules (including
-	  modules from packages) only the non-<literal>*</literal>
-	  form of <literal>:browse</literal> is available.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:cd</literal> <replaceable>dir</replaceable>
-          <indexterm><primary><literal>:cd</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Changes the current working directory to
-	  <replaceable>dir</replaceable>.  A
-	  &lsquo;<literal>&tilde;</literal>&rsquo; symbol at the
-	  beginning of <replaceable>dir</replaceable> will be replaced
-	  by the contents of the environment variable
-	  <literal>HOME</literal>.</para>
-
-	  <para>NOTE: changing directories causes all currently loaded
-	  modules to be unloaded.  This is because the search path is
-	  usually expressed using relative directories, and changing
-	  the search path in the middle of a session is not
-	  supported.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:def</literal> <replaceable>name</replaceable> <replaceable>expr</replaceable>
-          <indexterm><primary><literal>:def</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>The command <literal>:def</literal>
-	  <replaceable>name</replaceable>
-	  <replaceable>expr</replaceable> defines a new GHCi command
-	  <literal>:<replaceable>name</replaceable></literal>,
-	  implemented by the Haskell expression
-	  <replaceable>expr</replaceable>, which must have type
-	  <literal>String -> IO String</literal>.  When
-	  <literal>:<replaceable>name</replaceable>
-	  <replaceable>args</replaceable></literal> is typed at the
-	  prompt, GHCi will run the expression
-	  <literal>(<replaceable>name</replaceable>
-	  <replaceable>args</replaceable>)</literal>, take the
-	  resulting <literal>String</literal>, and feed it back into
-	  GHCi as a new sequence of commands.  Separate commands in
-	  the result must be separated by
-	  &lsquo;<literal>\n</literal>&rsquo;.</para>
-
-	  <para>That's all a little confusing, so here's a few
-	  examples.  To start with, here's a new GHCi command which
-	  doesn't take any arguments or produce any results, it just
-	  outputs the current date &amp; time:</para>
-
-<screen>
-Prelude> let date _ = Time.getClockTime >>= print >> return ""
-Prelude> :def date date
-Prelude> :date
-Fri Mar 23 15:16:40 GMT 2001
-</screen>
-
-	  <para>Here's an example of a command that takes an argument.
-	  It's a re-implementation of <literal>:cd</literal>:</para>
-
-<screen>
-Prelude> let mycd d = Directory.setCurrentDirectory d >> return ""
-Prelude> :def mycd mycd
-Prelude> :mycd ..
-</screen>
-
-	  <para>Or I could define a simple way to invoke
-	  &ldquo;<literal>ghc &ndash;&ndash;make Main</literal>&rdquo; in the
-	  current directory:</para>
-
-<screen>
-Prelude> :def make (\_ -> return ":! ghc &ndash;&ndash;make Main")
-</screen>
-
-          <para>We can define a command that reads GHCi input from a
-          file.  This might be useful for creating a set of bindings
-          that we want to repeatedly load into the GHCi session:</para>
-
-<screen>
-Prelude> :def . readFile
-Prelude> :. cmds.ghci
-</screen>
-
-          <para>Notice that we named the command
-          <literal>:.</literal>, by analogy with the
-          &lsquo;<literal>.</literal>&rsquo; Unix shell command that
-          does the same thing.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:help</literal>
-          <indexterm><primary><literal>:help</literal></primary></indexterm>
-        </term>
-	<term>
-          <literal>:?</literal>
-          <indexterm><primary><literal>:?</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Displays a list of the available commands.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:info</literal> <replaceable>name</replaceable> ...
-          <indexterm><primary><literal>:info</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Displays information about the given name(s).  For
-	  example, if <replaceable>name</replaceable> is a class, then
-	  the class methods and their types will be printed;  if
-	  <replaceable>name</replaceable> is a type constructor, then
-	  its definition will be printed;  if
-	  <replaceable>name</replaceable> is a function, then its type
-	  will be printed.  If <replaceable>name</replaceable> has
-	  been loaded from a source file, then GHCi will also display
-	  the location of its definition in the source.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:load</literal> <replaceable>module</replaceable> ...
-          <indexterm><primary><literal>:load</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Recursively loads the specified
-	  <replaceable>module</replaceable>s, and all the modules they
-	  depend on.  Here, each <replaceable>module</replaceable>
-	  must be a module name or filename, but may not be the name
-	  of a module in a package.</para>
-
-	  <para>All previously loaded modules, except package modules,
-	  are forgotten.  The new set of modules is known as the
-	  <firstterm>target set</firstterm>.  Note that
-	  <literal>:load</literal> can be used without any arguments
-	  to unload all the currently loaded modules and
-	  bindings.</para>
-
-	  <para>After a <literal>:load</literal> command, the current
-	  context is set to:</para>
-
-	  <itemizedlist>
-	    <listitem>
-	      <para><replaceable>module</replaceable>, if it was loaded
-	      successfully, or</para>
-	    </listitem>
-	    <listitem>
-	      <para>the most recently successfully loaded module, if
-	      any other modules were loaded as a result of the current
-	      <literal>:load</literal>, or</para>
-	    </listitem>
-	    <listitem>
-	      <para><literal>Prelude</literal> otherwise.</para>
-	    </listitem>
-	  </itemizedlist>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:module <optional>+|-</optional> <optional>*</optional><replaceable>mod<subscript>1</subscript></replaceable> ... <optional>*</optional><replaceable>mod<subscript>n</subscript></replaceable></literal>
-          <indexterm><primary><literal>:module</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Sets or modifies the current context for statements
-	  typed at the prompt.  See <xref linkend="ghci-scope"/> for
-	  more details.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:quit</literal>
-          <indexterm><primary><literal>:quit</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Quits GHCi.  You can also quit by typing a control-D
-	  at the prompt.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:reload</literal>
-          <indexterm><primary><literal>:reload</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Attempts to reload the current target set (see
-	  <literal>:load</literal>) if any of the modules in the set,
-	  or any dependent module, has changed.  Note that this may
-	  entail loading new modules, or dropping modules which are no
-	  longer indirectly required by the target.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:set</literal> <optional><replaceable>option</replaceable>...</optional>
-          <indexterm><primary><literal>:set</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Sets various options.  See <xref linkend="ghci-set"/>
-	  for a list of available options.  The
-	  <literal>:set</literal> command by itself shows which
-	  options are currently set.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:set</literal> <literal>args</literal> <replaceable>arg</replaceable> ...
-          <indexterm><primary><literal>:set args</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Sets the list of arguments which are returned when the
-	  program calls <literal>System.getArgs</literal><indexterm><primary>getArgs</primary>
-	    </indexterm>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-           <literal>:set</literal> <literal>prog</literal> <replaceable>prog</replaceable>
-           <indexterm><primary><literal>:set prog</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Sets the string to be returned when the program calls
-	  <literal>System.getProgName</literal><indexterm><primary>getProgName</primary>
-	    </indexterm>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-           <literal>:set</literal> <literal>prompt</literal> <replaceable>prompt</replaceable>
-        </term>
-	<listitem>
-	  <para>Sets the string to be used as the prompt in GHCi.
-	  Inside <replaceable>prompt</replaceable>, the sequence
-	  <literal>%s</literal> is replaced by the names of the
-	  modules currently in scope, and <literal>%%</literal> is
-	  replaced by <literal>%</literal>.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:show bindings</literal>
-          <indexterm><primary><literal>:show bindings</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Show the bindings made at the prompt and their
-	  types.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:show modules</literal>
-          <indexterm><primary><literal>:show modules</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Show the list of modules currently load.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-	  <literal>:ctags</literal> <optional><replaceable>filename</replaceable></optional>
-	  <literal>:etags</literal> <optional><replaceable>filename</replaceable></optional>
-	  <indexterm><primary><literal>:etags</literal></primary>
-	  </indexterm>
-	  <indexterm><primary><literal>:etags</literal></primary>
-	  </indexterm>
-	</term>
-	<listitem>
-	  <para>Generates a &ldquo;tags&rdquo; file for Vi-style editors
-	    (<literal>:ctags</literal>) or Emacs-style editors (<literal>etags</literal>).  If
-	    no filename is specified, the defaulit <filename>tags</filename> or
-	    <filename>TAGS</filename> is
-	    used, respectively.  Tags for all the functions, constructors and
-	    types in the currently loaded modules are created.  All modules must
-	    be interpreted for these commands to work.</para>
-          <para>See also <xref linkend="hasktags" />.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-         <literal>:type</literal> <replaceable>expression</replaceable>
-         <indexterm><primary><literal>:type</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Infers and prints the type of
-	  <replaceable>expression</replaceable>, including explicit
-	  forall quantifiers for polymorphic types.  The monomorphism
-	  restriction is <emphasis>not</emphasis> applied to the
-	  expression during type inference.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:kind</literal> <replaceable>type</replaceable>
-          <indexterm><primary><literal>:kind</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Infers and prints the kind of
-	  <replaceable>type</replaceable>. The latter can be an arbitrary
-	    type expression, including a partial application of a type constructor,
-	    such as <literal>Either Int</literal>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:undef</literal> <replaceable>name</replaceable>
-          <indexterm><primary><literal>:undef</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Undefines the user-defined command
-	  <replaceable>name</replaceable> (see <literal>:def</literal>
-	  above).</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:unset</literal> <replaceable>option</replaceable>...
-          <indexterm><primary><literal>:unset</literal></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Unsets certain options.  See <xref linkend="ghci-set"/>
-	  for a list of available options.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>:!</literal> <replaceable>command</replaceable>...
-          <indexterm><primary><literal>:!</literal></primary></indexterm>
-          <indexterm><primary>shell commands</primary><secondary>in GHCi</secondary></indexterm>
-        </term>
-	<listitem>
-	  <para>Executes the shell command
-	  <replaceable>command</replaceable>.</para>
-	</listitem>
-      </varlistentry>
-
-    </variablelist>
-  </sect1>
-
-  <sect1 id="ghci-set">
-    <title>The <literal>:set</literal> command</title>
-    <indexterm><primary><literal>:set</literal></primary></indexterm>
-
-    <para>The <literal>:set</literal> command sets two types of
-    options: GHCi options, which begin with
-    &lsquo;<literal>+</literal>&rdquo; and &ldquo;command-line&rdquo;
-    options, which begin with &lsquo;-&rsquo;.  </para>
-
-    <para>NOTE: at the moment, the <literal>:set</literal> command
-    doesn't support any kind of quoting in its arguments: quotes will
-    not be removed and cannot be used to group words together.  For
-    example, <literal>:set -DFOO='BAR BAZ'</literal> will not do what
-    you expect.</para>
-
-    <sect2>
-      <title>GHCi options</title>
-      <indexterm><primary>options</primary><secondary>GHCi</secondary>
-      </indexterm>
-
-      <para>GHCi options may be set using <literal>:set</literal> and
-      unset using <literal>:unset</literal>.</para>
-
-      <para>The available GHCi options are:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term>
-            <literal>+r</literal>
-            <indexterm><primary><literal>+r</literal></primary></indexterm>
-            <indexterm><primary>CAFs</primary><secondary>in GHCi</secondary></indexterm>
-            <indexterm><primary>Constant Applicative Form</primary><see>CAFs</see></indexterm>
-          </term>
-	  <listitem>
-	    <para>Normally, any evaluation of top-level expressions
-	    (otherwise known as CAFs or Constant Applicative Forms) in
-	    loaded modules is retained between evaluations.  Turning
-	    on <literal>+r</literal> causes all evaluation of
-	    top-level expressions to be discarded after each
-	    evaluation (they are still retained
-	    <emphasis>during</emphasis> a single evaluation).</para>
-	  
-	    <para>This option may help if the evaluated top-level
-	    expressions are consuming large amounts of space, or if
-	    you need repeatable performance measurements.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>+s</literal>
-            <indexterm><primary><literal>+s</literal></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Display some stats after evaluating each expression,
-	    including the elapsed time and number of bytes allocated.
-	    NOTE: the allocation figure is only accurate to the size
-	    of the storage manager's allocation area, because it is
-	    calculated at every GC.  Hence, you might see values of
-	    zero if no GC has occurred.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>+t</literal>
-            <indexterm><primary><literal>+t</literal></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Display the type of each variable bound after a
-	    statement is entered at the prompt.  If the statement is a
-	    single expression, then the only variable binding will be
-	    for the variable
-	    &lsquo;<literal>it</literal>&rsquo;.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-    </sect2>
-
-    <sect2 id="ghci-cmd-line-options">
-      <title>Setting GHC command-line options in GHCi</title>
-
-      <para>Normal GHC command-line options may also be set using
-      <literal>:set</literal>.  For example, to turn on
-      <option>-fglasgow-exts</option>, you would say:</para>
-
-<screen>
-Prelude> :set -fglasgow-exts
-</screen>
-      
-      <para>Any GHC command-line option that is designated as
-      <firstterm>dynamic</firstterm> (see the table in <xref
-      linkend="flag-reference"/>), may be set using
-      <literal>:set</literal>.  To unset an option, you can set the
-      reverse option:</para>
-      <indexterm><primary>dynamic</primary><secondary>options</secondary></indexterm>
-
-<screen>
-Prelude> :set -fno-glasgow-exts
-</screen>
-
-      <para><xref linkend="flag-reference"/> lists the reverse for each
-      option where applicable.</para>
-
-      <para>Certain static options (<option>-package</option>,
-      <option>-I</option>, <option>-i</option>, and
-      <option>-l</option> in particular) will also work, but some may
-      not take effect until the next reload.</para>
-      <indexterm><primary>static</primary><secondary>options</secondary></indexterm>
-    </sect2>
-  </sect1>
-
-  <sect1 id="ghci-dot-files">
-    <title>The <filename>.ghci</filename> file</title>
-    <indexterm><primary><filename>.ghci</filename></primary><secondary>file</secondary>
-    </indexterm>
-    <indexterm><primary>startup</primary><secondary>files, GHCi</secondary>
-    </indexterm>
-
-    <para>When it starts, GHCi always reads and executes commands from
-    <filename>$HOME/.ghci</filename>, followed by
-    <filename>./.ghci</filename>.</para>
-
-    <para>The <filename>.ghci</filename> in your home directory is
-    most useful for turning on favourite options (eg. <literal>:set
-    +s</literal>), and defining useful macros.  Placing a
-    <filename>.ghci</filename> file in a directory with a Haskell
-    project is a useful way to set certain project-wide options so you
-    don't have to type them everytime you start GHCi: eg. if your
-    project uses GHC extensions and CPP, and has source files in three
-    subdirectories A B and C, you might put the following lines in
-    <filename>.ghci</filename>:</para>
-
-<screen>
-:set -fglasgow-exts -cpp
-:set -iA:B:C
-</screen>
-
-    <para>(Note that strictly speaking the <option>-i</option> flag is
-    a static one, but in fact it works to set it using
-    <literal>:set</literal> like this.  The changes won't take effect
-    until the next <literal>:load</literal>, though.)</para>
-
-    <para>Two command-line options control whether the
-    <filename>.ghci</filename> files are read:</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>
-          <option>-ignore-dot-ghci</option>
-          <indexterm><primary><option>-ignore-dot-ghci</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Don't read either <filename>./.ghci</filename> or
-	  <filename>$HOME/.ghci</filename> when starting up.</para>
-	</listitem>
-      </varlistentry>
-      <varlistentry>
-	<term>
-          <option>-read-dot-ghci</option>
-          <indexterm><primary><option>-read-dot-ghci</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Read <filename>.ghci</filename> and
-	  <filename>$HOME/.ghci</filename>.  This is normally the
-	  default, but the <option>-read-dot-ghci</option> option may
-	  be used to override a previous
-	  <option>-ignore-dot-ghci</option> option.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-  </sect1>
-
-  <sect1>
-    <title>FAQ and Things To Watch Out For</title>
-    
-    <variablelist>
-      <varlistentry>
-	<term>The interpreter can't load modules with foreign export
-	declarations!</term>
-	<listitem>
-	  <para>Unfortunately not.  We haven't implemented it yet.
-	  Please compile any offending modules by hand before loading
-	  them into GHCi.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <literal>-O</literal> doesn't work with GHCi!
-          <indexterm><primary><option>-O</option></primary></indexterm>
-         </term>
-	<listitem>
-	  <para>For technical reasons, the bytecode compiler doesn't
-	  interact well with one of the optimisation passes, so we
-	  have disabled optimisation when using the interpreter.  This
-	  isn't a great loss: you'll get a much bigger win by
-	  compiling the bits of your code that need to go fast, rather
-	  than interpreting them with optimisation turned on.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Unboxed tuples don't work with GHCi</term>
-	<listitem>
-	  <para>That's right.  You can always compile a module that
-	  uses unboxed tuples and load it into GHCi, however.
-	  (Incidentally the previous point, namely that
-	  <literal>-O</literal> is incompatible with GHCi, is because
-	  the bytecode compiler can't deal with unboxed
-	  tuples).</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Concurrent threads don't carry on running when GHCi is
-        waiting for input.</term>
-	<listitem>
-	  <para>No, they don't.  This is because the Haskell binding
-	  to the GNU readline library doesn't support reading from the
-	  terminal in a non-blocking way, which is required to work
-	  properly with GHC's concurrency model.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>After using <literal>getContents</literal>, I can't use
-	<literal>stdin</literal> again until I do
-	<literal>:load</literal> or <literal>:reload</literal>.</term>
-
-	<listitem>
-	  <para>This is the defined behaviour of
-	  <literal>getContents</literal>: it puts the stdin Handle in
-	  a state known as <firstterm>semi-closed</firstterm>, wherein
-	  any further I/O operations on it are forbidden.  Because I/O
-	  state is retained between computations, the semi-closed
-	  state persists until the next <literal>:load</literal> or
-	  <literal>:reload</literal> command.</para>
-
-	  <para>You can make <literal>stdin</literal> reset itself
-	  after every evaluation by giving GHCi the command
-	  <literal>:set +r</literal>.  This works because
-	  <literal>stdin</literal> is just a top-level expression that
-	  can be reverted to its unevaluated state in the same way as
-	  any other top-level expression (CAF).</para>
-	</listitem>
-      </varlistentry>
-
-    </variablelist>
-  </sect1>
-
-</chapter>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/glasgow_exts.xml b/ghc/docs/users_guide/glasgow_exts.xml
deleted file mode 100644
index beaaad616a..0000000000
--- a/ghc/docs/users_guide/glasgow_exts.xml
+++ /dev/null
@@ -1,6264 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<para>
-<indexterm><primary>language, GHC</primary></indexterm>
-<indexterm><primary>extensions, GHC</primary></indexterm>
-As with all known Haskell systems, GHC implements some extensions to
-the language.  They are all enabled by options; by default GHC
-understands only plain Haskell 98.
-</para>
-
-<para>
-Some of the Glasgow extensions serve to give you access to the
-underlying facilities with which we implement Haskell.  Thus, you can
-get at the Raw Iron, if you are willing to write some non-portable
-code at a more primitive level.  You need not be &ldquo;stuck&rdquo;
-on performance because of the implementation costs of Haskell's
-&ldquo;high-level&rdquo; features&mdash;you can always code
-&ldquo;under&rdquo; them.  In an extreme case, you can write all your
-time-critical code in C, and then just glue it together with Haskell!
-</para>
-
-<para>
-Before you get too carried away working at the lowest level (e.g.,
-sloshing <literal>MutableByteArray&num;</literal>s around your
-program), you may wish to check if there are libraries that provide a
-&ldquo;Haskellised veneer&rdquo; over the features you want.  The
-separate <ulink url="../libraries/index.html">libraries
-documentation</ulink> describes all the libraries that come with GHC.
-</para>
-
-<!-- LANGUAGE OPTIONS -->
-  <sect1 id="options-language">
-    <title>Language options</title>
-
-    <indexterm><primary>language</primary><secondary>option</secondary>
-    </indexterm>
-    <indexterm><primary>options</primary><secondary>language</secondary>
-    </indexterm>
-    <indexterm><primary>extensions</primary><secondary>options controlling</secondary>
-    </indexterm>
-
-    <para>These flags control what variation of the language are
-    permitted.  Leaving out all of them gives you standard Haskell
-    98.</para>
-
-    <para>NB. turning on an option that enables special syntax
-    <emphasis>might</emphasis> cause working Haskell 98 code to fail
-    to compile, perhaps because it uses a variable name which has
-    become a reserved word.  So, together with each option below, we
-    list the special syntax which is enabled by this option.  We use
-    notation and nonterminal names from the Haskell 98 lexical syntax
-    (see the Haskell 98 Report).  There are two classes of special
-    syntax:</para>
-
-    <itemizedlist>
-      <listitem>
-	<para>New reserved words and symbols: character sequences
-        which are no longer available for use as identifiers in the
-        program.</para>
-      </listitem>
-      <listitem>
-	<para>Other special syntax: sequences of characters that have
-	a different meaning when this particular option is turned
-	on.</para>
-      </listitem>
-    </itemizedlist>
-
-    <para>We are only listing syntax changes here that might affect
-    existing working programs (i.e. "stolen" syntax).  Many of these
-    extensions will also enable new context-free syntax, but in all
-    cases programs written to use the new syntax would not be
-    compilable without the option enabled.</para>
-
-    <variablelist>
-
-      <varlistentry>
-	<term>
-          <option>-fglasgow-exts</option>:
-          <indexterm><primary><option>-fglasgow-exts</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>This simultaneously enables all of the extensions to
-          Haskell 98 described in <xref
-          linkend="ghc-language-features"/>, except where otherwise
-          noted. </para>
-
-	  <para>New reserved words: <literal>forall</literal> (only in
-	  types), <literal>mdo</literal>.</para>
-
-	  <para>Other syntax stolen:
-	      <replaceable>varid</replaceable>{<literal>&num;</literal>},
-	      <replaceable>char</replaceable><literal>&num;</literal>,	    
-	      <replaceable>string</replaceable><literal>&num;</literal>,    
-	      <replaceable>integer</replaceable><literal>&num;</literal>,    
-	      <replaceable>float</replaceable><literal>&num;</literal>,    
-	      <replaceable>float</replaceable><literal>&num;&num;</literal>,    
-	      <literal>(&num;</literal>, <literal>&num;)</literal>,	    
-	      <literal>|)</literal>, <literal>{|</literal>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-ffi</option> and <option>-fffi</option>:
-          <indexterm><primary><option>-ffi</option></primary></indexterm>
-          <indexterm><primary><option>-fffi</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>This option enables the language extension defined in the
-	  Haskell 98 Foreign Function Interface Addendum plus deprecated
-	  syntax of previous versions of the FFI for backwards
-	  compatibility.</para> 
-
-	  <para>New reserved words: <literal>foreign</literal>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-fno-monomorphism-restriction</option>:
-          <indexterm><primary><option>-fno-monomorphism-restriction</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para> Switch off the Haskell 98 monomorphism restriction.
-          Independent of the <option>-fglasgow-exts</option>
-          flag. </para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-fallow-overlapping-instances</option>
-          <indexterm><primary><option>-fallow-overlapping-instances</option></primary></indexterm>
-        </term>
-	<term>
-          <option>-fallow-undecidable-instances</option>
-          <indexterm><primary><option>-fallow-undecidable-instances</option></primary></indexterm>
-        </term>
-	<term>
-          <option>-fallow-incoherent-instances</option>
-          <indexterm><primary><option>-fallow-incoherent-instances</option></primary></indexterm>
-        </term>
-	<term>
-          <option>-fcontext-stack</option>
-          <indexterm><primary><option>-fcontext-stack</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para> See <xref linkend="instance-decls"/>.  Only relevant
-          if you also use <option>-fglasgow-exts</option>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-finline-phase</option>
-          <indexterm><primary><option>-finline-phase</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>See <xref linkend="rewrite-rules"/>.  Only relevant if
-          you also use <option>-fglasgow-exts</option>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-farrows</option>
-          <indexterm><primary><option>-farrows</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>See <xref linkend="arrow-notation"/>.  Independent of
-          <option>-fglasgow-exts</option>.</para>
-
-	  <para>New reserved words/symbols: <literal>rec</literal>,
-	  <literal>proc</literal>, <literal>-&lt;</literal>,
-	  <literal>&gt;-</literal>, <literal>-&lt;&lt;</literal>,
-	  <literal>&gt;&gt;-</literal>.</para>
-
-	  <para>Other syntax stolen: <literal>(|</literal>,
-	  <literal>|)</literal>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-fgenerics</option>
-          <indexterm><primary><option>-fgenerics</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>See <xref linkend="generic-classes"/>.  Independent of
-          <option>-fglasgow-exts</option>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fno-implicit-prelude</option></term>
-	<listitem>
-	  <para><indexterm><primary>-fno-implicit-prelude
-          option</primary></indexterm> GHC normally imports
-          <filename>Prelude.hi</filename> files for you.  If you'd
-          rather it didn't, then give it a
-          <option>-fno-implicit-prelude</option> option.  The idea is
-          that you can then import a Prelude of your own.  (But don't
-          call it <literal>Prelude</literal>; the Haskell module
-          namespace is flat, and you must not conflict with any
-          Prelude module.)</para>
-
-	  <para>Even though you have not imported the Prelude, most of
-          the built-in syntax still refers to the built-in Haskell
-          Prelude types and values, as specified by the Haskell
-          Report.  For example, the type <literal>[Int]</literal>
-          still means <literal>Prelude.[] Int</literal>; tuples
-          continue to refer to the standard Prelude tuples; the
-          translation for list comprehensions continues to use
-          <literal>Prelude.map</literal> etc.</para>
-
-	  <para>However, <option>-fno-implicit-prelude</option> does
-	  change the handling of certain built-in syntax: see <xref
-	  linkend="rebindable-syntax"/>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fimplicit-params</option></term>
-	<listitem>
-	  <para>Enables implicit parameters (see <xref
-	  linkend="implicit-parameters"/>).  Currently also implied by 
-	  <option>-fglasgow-exts</option>.</para>
-
-	  <para>Syntax stolen:
-	  <literal>?<replaceable>varid</replaceable></literal>,
-	  <literal>%<replaceable>varid</replaceable></literal>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fscoped-type-variables</option></term>
-	<listitem>
-	  <para>Enables lexically-scoped type variables (see <xref
-	  linkend="scoped-type-variables"/>).  Implied by
-	  <option>-fglasgow-exts</option>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fth</option></term>
-	<listitem>
-	  <para>Enables Template Haskell (see <xref
-	  linkend="template-haskell"/>).  Currently also implied by
-	  <option>-fglasgow-exts</option>.</para>
-
-	  <para>Syntax stolen: <literal>[|</literal>,
-	  <literal>[e|</literal>, <literal>[p|</literal>,
-	  <literal>[d|</literal>, <literal>[t|</literal>,
-	  <literal>$(</literal>,
-	  <literal>$<replaceable>varid</replaceable></literal>.</para>
-	</listitem>
-      </varlistentry>
-
-    </variablelist>
-  </sect1>
-
-<!-- UNBOXED TYPES AND PRIMITIVE OPERATIONS -->
-<!--    included from primitives.sgml  -->
-<!-- &primitives; -->
-<sect1 id="primitives">
-  <title>Unboxed types and primitive operations</title>
-
-<para>GHC is built on a raft of primitive data types and operations.
-While you really can use this stuff to write fast code,
-  we generally find it a lot less painful, and more satisfying in the
-  long run, to use higher-level language features and libraries.  With
-  any luck, the code you write will be optimised to the efficient
-  unboxed version in any case.  And if it isn't, we'd like to know
-  about it.</para>
-
-<para>We do not currently have good, up-to-date documentation about the
-primitives, perhaps because they are mainly intended for internal use.
-There used to be a long section about them here in the User Guide, but it
-became out of date, and wrong information is worse than none.</para>
-
-<para>The Real Truth about what primitive types there are, and what operations
-work over those types, is held in the file
-<filename>fptools/ghc/compiler/prelude/primops.txt.pp</filename>.
-This file is used directly to generate GHC's primitive-operation definitions, so
-it is always correct!  It is also intended for processing into text.</para>
-
-<para> Indeed,
-the result of such processing is part of the description of the 
- <ulink
-      url="http://haskell.cs.yale.edu/ghc/docs/papers/core.ps.gz">External
-	 Core language</ulink>.
-So that document is a good place to look for a type-set version.
-We would be very happy if someone wanted to volunteer to produce an SGML
-back end to the program that processes <filename>primops.txt</filename> so that
-we could include the results here in the User Guide.</para>
-
-<para>What follows here is a brief summary of some main points.</para>
-  
-<sect2 id="glasgow-unboxed">
-<title>Unboxed types
-</title>
-
-<para>
-<indexterm><primary>Unboxed types (Glasgow extension)</primary></indexterm>
-</para>
-
-<para>Most types in GHC are <firstterm>boxed</firstterm>, which means
-that values of that type are represented by a pointer to a heap
-object.  The representation of a Haskell <literal>Int</literal>, for
-example, is a two-word heap object.  An <firstterm>unboxed</firstterm>
-type, however, is represented by the value itself, no pointers or heap
-allocation are involved.
-</para>
-
-<para>
-Unboxed types correspond to the &ldquo;raw machine&rdquo; types you
-would use in C: <literal>Int&num;</literal> (long int),
-<literal>Double&num;</literal> (double), <literal>Addr&num;</literal>
-(void *), etc.  The <emphasis>primitive operations</emphasis>
-(PrimOps) on these types are what you might expect; e.g.,
-<literal>(+&num;)</literal> is addition on
-<literal>Int&num;</literal>s, and is the machine-addition that we all
-know and love&mdash;usually one instruction.
-</para>
-
-<para>
-Primitive (unboxed) types cannot be defined in Haskell, and are
-therefore built into the language and compiler.  Primitive types are
-always unlifted; that is, a value of a primitive type cannot be
-bottom.  We use the convention that primitive types, values, and
-operations have a <literal>&num;</literal> suffix.
-</para>
-
-<para>
-Primitive values are often represented by a simple bit-pattern, such
-as <literal>Int&num;</literal>, <literal>Float&num;</literal>,
-<literal>Double&num;</literal>.  But this is not necessarily the case:
-a primitive value might be represented by a pointer to a
-heap-allocated object.  Examples include
-<literal>Array&num;</literal>, the type of primitive arrays.  A
-primitive array is heap-allocated because it is too big a value to fit
-in a register, and would be too expensive to copy around; in a sense,
-it is accidental that it is represented by a pointer.  If a pointer
-represents a primitive value, then it really does point to that value:
-no unevaluated thunks, no indirections&hellip;nothing can be at the
-other end of the pointer than the primitive value.
-A numerically-intensive program using unboxed types can
-go a <emphasis>lot</emphasis> faster than its &ldquo;standard&rdquo;
-counterpart&mdash;we saw a threefold speedup on one example.
-</para>
-
-<para>
-There are some restrictions on the use of primitive types:
-<itemizedlist>
-<listitem><para>The main restriction
-is that you can't pass a primitive value to a polymorphic
-function or store one in a polymorphic data type.  This rules out
-things like <literal>[Int&num;]</literal> (i.e. lists of primitive
-integers).  The reason for this restriction is that polymorphic
-arguments and constructor fields are assumed to be pointers: if an
-unboxed integer is stored in one of these, the garbage collector would
-attempt to follow it, leading to unpredictable space leaks.  Or a
-<function>seq</function> operation on the polymorphic component may
-attempt to dereference the pointer, with disastrous results.  Even
-worse, the unboxed value might be larger than a pointer
-(<literal>Double&num;</literal> for instance).
-</para>
-</listitem>
-<listitem><para> You cannot bind a variable with an unboxed type
-in a <emphasis>top-level</emphasis> binding.
-</para></listitem>
-<listitem><para> You cannot bind a variable with an unboxed type
-in a <emphasis>recursive</emphasis> binding.
-</para></listitem>
-<listitem><para> You may bind unboxed variables in a (non-recursive,
-non-top-level) pattern binding, but any such variable causes the entire
-pattern-match
-to become strict.  For example:
-<programlisting>
-  data Foo = Foo Int Int#
-
-  f x = let (Foo a b, w) = ..rhs.. in ..body..
-</programlisting>
-Since <literal>b</literal> has type <literal>Int#</literal>, the entire pattern
-match
-is strict, and the program behaves as if you had written
-<programlisting>
-  data Foo = Foo Int Int#
-
-  f x = case ..rhs.. of { (Foo a b, w) -> ..body.. }
-</programlisting>
-</para>
-</listitem>
-</itemizedlist>
-</para>
-
-</sect2>
-
-<sect2 id="unboxed-tuples">
-<title>Unboxed Tuples
-</title>
-
-<para>
-Unboxed tuples aren't really exported by <literal>GHC.Exts</literal>,
-they're available by default with <option>-fglasgow-exts</option>.  An
-unboxed tuple looks like this:
-</para>
-
-<para>
-
-<programlisting>
-(# e_1, ..., e_n #)
-</programlisting>
-
-</para>
-
-<para>
-where <literal>e&lowbar;1..e&lowbar;n</literal> are expressions of any
-type (primitive or non-primitive).  The type of an unboxed tuple looks
-the same.
-</para>
-
-<para>
-Unboxed tuples are used for functions that need to return multiple
-values, but they avoid the heap allocation normally associated with
-using fully-fledged tuples.  When an unboxed tuple is returned, the
-components are put directly into registers or on the stack; the
-unboxed tuple itself does not have a composite representation.  Many
-of the primitive operations listed in <literal>primops.txt.pp</literal> return unboxed
-tuples.
-In particular, the <literal>IO</literal> and <literal>ST</literal> monads use unboxed
-tuples to avoid unnecessary allocation during sequences of operations.
-</para>
-
-<para>
-There are some pretty stringent restrictions on the use of unboxed tuples:
-<itemizedlist>
-<listitem>
-
-<para>
-Values of unboxed tuple types are subject to the same restrictions as
-other unboxed types; i.e. they may not be stored in polymorphic data
-structures or passed to polymorphic functions.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
-No variable can have an unboxed tuple type, nor may a constructor or function
-argument have an unboxed tuple type.  The following are all illegal:
-
-
-<programlisting>
-  data Foo = Foo (# Int, Int #)
-
-  f :: (# Int, Int #) -&#62; (# Int, Int #)
-  f x = x
-
-  g :: (# Int, Int #) -&#62; Int
-  g (# a,b #) = a
-
-  h x = let y = (# x,x #) in ...
-</programlisting>
-</para>
-</listitem>
-</itemizedlist>
-</para>
-<para>
-The typical use of unboxed tuples is simply to return multiple values,
-binding those multiple results with a <literal>case</literal> expression, thus:
-<programlisting>
-  f x y = (# x+1, y-1 #)
-  g x = case f x x of { (# a, b #) -&#62; a + b }
-</programlisting>
-You can have an unboxed tuple in a pattern binding, thus
-<programlisting>
-  f x = let (# p,q #) = h x in ..body..
-</programlisting>
-If the types of <literal>p</literal> and <literal>q</literal> are not unboxed,
-the resulting binding is lazy like any other Haskell pattern binding.  The 
-above example desugars like this:
-<programlisting>
-  f x = let t = case h x o f{ (# p,q #) -> (p,q)
-            p = fst t
-            q = snd t
-        in ..body..
-</programlisting>
-Indeed, the bindings can even be recursive.
-</para>
-
-</sect2>
-</sect1>
-
-
-<!-- ====================== SYNTACTIC EXTENSIONS =======================  -->
-
-<sect1 id="syntax-extns">
-<title>Syntactic extensions</title>
- 
-    <!-- ====================== HIERARCHICAL MODULES =======================  -->
-
-    <sect2 id="hierarchical-modules">
-      <title>Hierarchical Modules</title>
-
-      <para>GHC supports a small extension to the syntax of module
-      names: a module name is allowed to contain a dot
-      <literal>&lsquo;.&rsquo;</literal>.  This is also known as the
-      &ldquo;hierarchical module namespace&rdquo; extension, because
-      it extends the normally flat Haskell module namespace into a
-      more flexible hierarchy of modules.</para>
-
-      <para>This extension has very little impact on the language
-      itself; modules names are <emphasis>always</emphasis> fully
-      qualified, so you can just think of the fully qualified module
-      name as <quote>the module name</quote>.  In particular, this
-      means that the full module name must be given after the
-      <literal>module</literal> keyword at the beginning of the
-      module; for example, the module <literal>A.B.C</literal> must
-      begin</para>
-
-<programlisting>module A.B.C</programlisting>
-
-
-      <para>It is a common strategy to use the <literal>as</literal>
-      keyword to save some typing when using qualified names with
-      hierarchical modules.  For example:</para>
-
-<programlisting>
-import qualified Control.Monad.ST.Strict as ST
-</programlisting>
-
-      <para>For details on how GHC searches for source and interface
-      files in the presence of hierarchical modules, see <xref
-      linkend="search-path"/>.</para>
-
-      <para>GHC comes with a large collection of libraries arranged
-      hierarchically; see the accompanying library documentation.
-      There is an ongoing project to create and maintain a stable set
-      of <quote>core</quote> libraries used by several Haskell
-      compilers, and the libraries that GHC comes with represent the
-      current status of that project.  For more details, see <ulink
-      url="http://www.haskell.org/~simonmar/libraries/libraries.html">Haskell
-      Libraries</ulink>.</para>
-
-    </sect2>
-
-    <!-- ====================== PATTERN GUARDS =======================  -->
-
-<sect2 id="pattern-guards">
-<title>Pattern guards</title>
-
-<para>
-<indexterm><primary>Pattern guards (Glasgow extension)</primary></indexterm>
-The discussion that follows is an abbreviated version of Simon Peyton Jones's original <ulink url="http://research.microsoft.com/~simonpj/Haskell/guards.html">proposal</ulink>. (Note that the proposal was written before pattern guards were implemented, so refers to them as unimplemented.)
-</para>
-
-<para>
-Suppose we have an abstract data type of finite maps, with a
-lookup operation:
-
-<programlisting>
-lookup :: FiniteMap -> Int -> Maybe Int
-</programlisting>
-
-The lookup returns <function>Nothing</function> if the supplied key is not in the domain of the mapping, and <function>(Just v)</function> otherwise,
-where <varname>v</varname> is the value that the key maps to.  Now consider the following definition:
-</para>
-
-<programlisting>
-clunky env var1 var2 | ok1 &amp;&amp; ok2 = val1 + val2
-| otherwise  = var1 + var2
-where
-  m1 = lookup env var1
-  m2 = lookup env var2
-  ok1 = maybeToBool m1
-  ok2 = maybeToBool m2
-  val1 = expectJust m1
-  val2 = expectJust m2
-</programlisting>
-
-<para>
-The auxiliary functions are 
-</para>
-
-<programlisting>
-maybeToBool :: Maybe a -&gt; Bool
-maybeToBool (Just x) = True
-maybeToBool Nothing  = False
-
-expectJust :: Maybe a -&gt; a
-expectJust (Just x) = x
-expectJust Nothing  = error "Unexpected Nothing"
-</programlisting>
-
-<para>
-What is <function>clunky</function> doing? The guard <literal>ok1 &amp;&amp;
-ok2</literal> checks that both lookups succeed, using
-<function>maybeToBool</function> to convert the <function>Maybe</function>
-types to booleans. The (lazily evaluated) <function>expectJust</function>
-calls extract the values from the results of the lookups, and binds the
-returned values to <varname>val1</varname> and <varname>val2</varname>
-respectively.  If either lookup fails, then clunky takes the
-<literal>otherwise</literal> case and returns the sum of its arguments.
-</para>
-
-<para>
-This is certainly legal Haskell, but it is a tremendously verbose and
-un-obvious way to achieve the desired effect.  Arguably, a more direct way
-to write clunky would be to use case expressions:
-</para>
-
-<programlisting>
-clunky env var1 var1 = case lookup env var1 of
-  Nothing -&gt; fail
-  Just val1 -&gt; case lookup env var2 of
-    Nothing -&gt; fail
-    Just val2 -&gt; val1 + val2
-where
-  fail = val1 + val2
-</programlisting>
-
-<para>
-This is a bit shorter, but hardly better.  Of course, we can rewrite any set
-of pattern-matching, guarded equations as case expressions; that is
-precisely what the compiler does when compiling equations! The reason that
-Haskell provides guarded equations is because they allow us to write down
-the cases we want to consider, one at a time, independently of each other. 
-This structure is hidden in the case version.  Two of the right-hand sides
-are really the same (<function>fail</function>), and the whole expression
-tends to become more and more indented. 
-</para>
-
-<para>
-Here is how I would write clunky:
-</para>
-
-<programlisting>
-clunky env var1 var1
-  | Just val1 &lt;- lookup env var1
-  , Just val2 &lt;- lookup env var2
-  = val1 + val2
-...other equations for clunky...
-</programlisting>
-
-<para>
-The semantics should be clear enough.  The qualifiers are matched in order. 
-For a <literal>&lt;-</literal> qualifier, which I call a pattern guard, the
-right hand side is evaluated and matched against the pattern on the left. 
-If the match fails then the whole guard fails and the next equation is
-tried.  If it succeeds, then the appropriate binding takes place, and the
-next qualifier is matched, in the augmented environment.  Unlike list
-comprehensions, however, the type of the expression to the right of the
-<literal>&lt;-</literal> is the same as the type of the pattern to its
-left.  The bindings introduced by pattern guards scope over all the
-remaining guard qualifiers, and over the right hand side of the equation.
-</para>
-
-<para>
-Just as with list comprehensions, boolean expressions can be freely mixed
-with among the pattern guards.  For example:
-</para>
-
-<programlisting>
-f x | [y] &lt;- x
-    , y > 3
-    , Just z &lt;- h y
-    = ...
-</programlisting>
-
-<para>
-Haskell's current guards therefore emerge as a special case, in which the
-qualifier list has just one element, a boolean expression.
-</para>
-</sect2>
-
-    <!-- ===================== Recursive do-notation ===================  -->
-
-<sect2 id="mdo-notation">
-<title>The recursive do-notation
-</title>
-
-<para> The recursive do-notation (also known as mdo-notation) is implemented as described in
-"A recursive do for Haskell",
-Levent Erkok, John Launchbury",
-Haskell Workshop 2002, pages: 29-37. Pittsburgh, Pennsylvania. 
-</para>
-<para>
-The do-notation of Haskell does not allow <emphasis>recursive bindings</emphasis>,
-that is, the variables bound in a do-expression are visible only in the textually following 
-code block. Compare this to a let-expression, where bound variables are visible in the entire binding
-group. It turns out that several applications can benefit from recursive bindings in
-the do-notation, and this extension provides the necessary syntactic support.
-</para>
-<para>
-Here is a simple (yet contrived) example:
-</para>
-<programlisting>
-import Control.Monad.Fix
-
-justOnes = mdo xs &lt;- Just (1:xs)
-               return xs
-</programlisting>
-<para>
-As you can guess <literal>justOnes</literal> will evaluate to <literal>Just [1,1,1,...</literal>.
-</para>
-
-<para>
-The Control.Monad.Fix library introduces the <literal>MonadFix</literal> class. It's definition is:
-</para>
-<programlisting>
-class Monad m => MonadFix m where
-   mfix :: (a -> m a) -> m a
-</programlisting>
-<para>
-The function <literal>mfix</literal>
-dictates how the required recursion operation should be performed. If recursive bindings are required for a monad,
-then that monad must be declared an instance of the <literal>MonadFix</literal> class.
-For details, see the above mentioned reference.
-</para>
-<para>
-The following instances of <literal>MonadFix</literal> are automatically provided: List, Maybe, IO. 
-Furthermore, the Control.Monad.ST and Control.Monad.ST.Lazy modules provide the instances of the MonadFix class 
-for Haskell's internal state monad (strict and lazy, respectively).
-</para>
-<para>
-There are three important points in using the recursive-do notation:
-<itemizedlist>
-<listitem><para>
-The recursive version of the do-notation uses the keyword <literal>mdo</literal> (rather
-than <literal>do</literal>).
-</para></listitem>
-
-<listitem><para>
-You should <literal>import Control.Monad.Fix</literal>.
-(Note: Strictly speaking, this import is required only when you need to refer to the name
-<literal>MonadFix</literal> in your program, but the import is always safe, and the programmers
-are encouraged to always import this module when using the mdo-notation.)
-</para></listitem>
-
-<listitem><para>
-As with other extensions, ghc should be given the flag <literal>-fglasgow-exts</literal>
-</para></listitem>
-</itemizedlist>
-</para>
-
-<para>
-The web page: <ulink url="http://www.cse.ogi.edu/PacSoft/projects/rmb">http://www.cse.ogi.edu/PacSoft/projects/rmb</ulink>
-contains up to date information on recursive monadic bindings.
-</para>
-
-<para>
-Historical note: The old implementation of the mdo-notation (and most
-of the existing documents) used the name
-<literal>MonadRec</literal> for the class and the corresponding library.
-This name is not supported by GHC.
-</para>
-
-</sect2>
-
-
-   <!-- ===================== PARALLEL LIST COMPREHENSIONS ===================  -->
-
-  <sect2 id="parallel-list-comprehensions">
-    <title>Parallel List Comprehensions</title>
-    <indexterm><primary>list comprehensions</primary><secondary>parallel</secondary>
-    </indexterm>
-    <indexterm><primary>parallel list comprehensions</primary>
-    </indexterm>
-
-    <para>Parallel list comprehensions are a natural extension to list
-    comprehensions.  List comprehensions can be thought of as a nice
-    syntax for writing maps and filters.  Parallel comprehensions
-    extend this to include the zipWith family.</para>
-
-    <para>A parallel list comprehension has multiple independent
-    branches of qualifier lists, each separated by a `|' symbol.  For
-    example, the following zips together two lists:</para>
-
-<programlisting>
-   [ (x, y) | x &lt;- xs | y &lt;- ys ] 
-</programlisting>
-
-    <para>The behavior of parallel list comprehensions follows that of
-    zip, in that the resulting list will have the same length as the
-    shortest branch.</para>
-
-    <para>We can define parallel list comprehensions by translation to
-    regular comprehensions.  Here's the basic idea:</para>
-
-    <para>Given a parallel comprehension of the form: </para>
-
-<programlisting>
-   [ e | p1 &lt;- e11, p2 &lt;- e12, ... 
-       | q1 &lt;- e21, q2 &lt;- e22, ... 
-       ... 
-   ] 
-</programlisting>
-
-    <para>This will be translated to: </para>
-
-<programlisting>
-   [ e | ((p1,p2), (q1,q2), ...) &lt;- zipN [(p1,p2) | p1 &lt;- e11, p2 &lt;- e12, ...] 
-                                         [(q1,q2) | q1 &lt;- e21, q2 &lt;- e22, ...] 
-                                         ... 
-   ] 
-</programlisting>
-
-    <para>where `zipN' is the appropriate zip for the given number of
-    branches.</para>
-
-  </sect2>
-
-<sect2 id="rebindable-syntax">
-<title>Rebindable syntax</title>
-
-
-      <para>GHC allows most kinds of built-in syntax to be rebound by
-      the user, to facilitate replacing the <literal>Prelude</literal>
-      with a home-grown version, for example.</para>
-
-            <para>You may want to define your own numeric class
-            hierarchy.  It completely defeats that purpose if the
-            literal "1" means "<literal>Prelude.fromInteger
-            1</literal>", which is what the Haskell Report specifies.
-            So the <option>-fno-implicit-prelude</option> flag causes
-            the following pieces of built-in syntax to refer to
-            <emphasis>whatever is in scope</emphasis>, not the Prelude
-            versions:
-
-	    <itemizedlist>
-	      <listitem>
-		<para>An integer literal <literal>368</literal> means
-                "<literal>fromInteger (368::Integer)</literal>", rather than
-                "<literal>Prelude.fromInteger (368::Integer)</literal>".
-</para> </listitem>	    
-
-      <listitem><para>Fractional literals are handed in just the same way,
-	  except that the translation is 
-	      <literal>fromRational (3.68::Rational)</literal>.
-</para> </listitem>	    
-
-	  <listitem><para>The equality test in an overloaded numeric pattern
-	      uses whatever <literal>(==)</literal> is in scope.
-</para> </listitem>	    
-
-	  <listitem><para>The subtraction operation, and the
-	  greater-than-or-equal test, in <literal>n+k</literal> patterns
-	      use whatever <literal>(-)</literal> and <literal>(>=)</literal> are in scope.
-	      </para></listitem>
-
-	      <listitem>
-		<para>Negation (e.g. "<literal>- (f x)</literal>")
-		means "<literal>negate (f x)</literal>", both in numeric
-		patterns, and expressions.
-	      </para></listitem>
-
-	      <listitem>
-	  <para>"Do" notation is translated using whatever
-	      functions <literal>(>>=)</literal>,
-	      <literal>(>>)</literal>, and <literal>fail</literal>,
-	      are in scope (not the Prelude
-	      versions).  List comprehensions, mdo (<xref linkend="mdo-notation"/>), and parallel array
-	      comprehensions, are unaffected.  </para></listitem>
-
-	      <listitem>
-		<para>Arrow
-		notation (see <xref linkend="arrow-notation"/>)
-		uses whatever <literal>arr</literal>,
-		<literal>(>>>)</literal>, <literal>first</literal>,
-		<literal>app</literal>, <literal>(|||)</literal> and
-		<literal>loop</literal> functions are in scope. But unlike the
-		other constructs, the types of these functions must match the
-		Prelude types very closely.  Details are in flux; if you want
-		to use this, ask!
-	      </para></listitem>
-	    </itemizedlist>
-In all cases (apart from arrow notation), the static semantics should be that of the desugared form,
-even if that is a little unexpected. For emample, the 
-static semantics of the literal <literal>368</literal>
-is exactly that of <literal>fromInteger (368::Integer)</literal>; it's fine for
-<literal>fromInteger</literal> to have any of the types:
-<programlisting>
-fromInteger :: Integer -> Integer
-fromInteger :: forall a. Foo a => Integer -> a
-fromInteger :: Num a => a -> Integer
-fromInteger :: Integer -> Bool -> Bool
-</programlisting>
-</para>
-	        
-	     <para>Be warned: this is an experimental facility, with
-	     fewer checks than usual.  Use <literal>-dcore-lint</literal>
-	     to typecheck the desugared program.  If Core Lint is happy
-	     you should be all right.</para>
-
-</sect2>
-</sect1>
-
-
-<!-- TYPE SYSTEM EXTENSIONS -->
-<sect1 id="type-extensions">
-<title>Type system extensions</title>
-
-
-<sect2>
-<title>Data types and type synonyms</title>
-
-<sect3 id="nullary-types">
-<title>Data types with no constructors</title>
-
-<para>With the <option>-fglasgow-exts</option> flag, GHC lets you declare
-a data type with no constructors.  For example:</para>
-
-<programlisting>
-  data S      -- S :: *
-  data T a    -- T :: * -> *
-</programlisting>
-
-<para>Syntactically, the declaration lacks the "= constrs" part.  The 
-type can be parameterised over types of any kind, but if the kind is
-not <literal>*</literal> then an explicit kind annotation must be used
-(see <xref linkend="sec-kinding"/>).</para>
-
-<para>Such data types have only one value, namely bottom.
-Nevertheless, they can be useful when defining "phantom types".</para>
-</sect3>
-
-<sect3 id="infix-tycons">
-<title>Infix type constructors, classes, and type variables</title>
-
-<para>
-GHC allows type constructors, classes, and type variables to be operators, and
-to be written infix, very much like expressions.  More specifically:
-<itemizedlist>
-<listitem><para>
-  A type constructor or class can be an operator, beginning with a colon; e.g. <literal>:*:</literal>.
-  The lexical syntax is the same as that for data constructors.
-  </para></listitem>
-<listitem><para>
-  Data type and type-synonym declarations can be written infix, parenthesised
-  if you want further arguments.  E.g.
-<screen>
-  data a :*: b = Foo a b
-  type a :+: b = Either a b
-  class a :=: b where ...
-
-  data (a :**: b) x = Baz a b x
-  type (a :++: b) y = Either (a,b) y
-</screen>
-  </para></listitem>
-<listitem><para>
-  Types, and class constraints, can be written infix.  For example
-  <screen>
-	x :: Int :*: Bool
-        f :: (a :=: b) => a -> b
-  </screen>
-  </para></listitem>
-<listitem><para>
-  A type variable can be an (unqualified) operator e.g. <literal>+</literal>.
-  The lexical syntax is the same as that for variable operators, excluding "(.)",
-  "(!)", and "(*)".  In a binding position, the operator must be
-  parenthesised.  For example:
-<programlisting>
-   type T (+) = Int + Int
-   f :: T Either
-   f = Left 3
- 
-   liftA2 :: Arrow (~>)
-	  => (a -> b -> c) -> (e ~> a) -> (e ~> b) -> (e ~> c)
-   liftA2 = ...
-</programlisting>
-  </para></listitem>
-<listitem><para>
-  Back-quotes work
-  as for expressions, both for type constructors and type variables;  e.g. <literal>Int `Either` Bool</literal>, or
-  <literal>Int `a` Bool</literal>.  Similarly, parentheses work the same; e.g.  <literal>(:*:) Int Bool</literal>.
-  </para></listitem>
-<listitem><para>
-  Fixities may be declared for type constructors, or classes, just as for data constructors.  However,
-  one cannot distinguish between the two in a fixity declaration; a fixity declaration
-  sets the fixity for a data constructor and the corresponding type constructor.  For example:
-<screen>
-  infixl 7 T, :*:
-</screen>
-  sets the fixity for both type constructor <literal>T</literal> and data constructor <literal>T</literal>,
-  and similarly for <literal>:*:</literal>.
-  <literal>Int `a` Bool</literal>.
-  </para></listitem>
-<listitem><para>
-  Function arrow is <literal>infixr</literal> with fixity 0.  (This might change; I'm not sure what it should be.)
-  </para></listitem>
-
-</itemizedlist>
-</para>
-</sect3>
-
-<sect3 id="type-synonyms">
-<title>Liberalised type synonyms</title>
-
-<para>
-Type synonyms are like macros at the type level, and
-GHC does validity checking on types <emphasis>only after expanding type synonyms</emphasis>.
-That means that GHC can be very much more liberal about type synonyms than Haskell 98:
-<itemizedlist>
-<listitem> <para>You can write a <literal>forall</literal> (including overloading)
-in a type synonym, thus:
-<programlisting>
-  type Discard a = forall b. Show b => a -> b -> (a, String)
-
-  f :: Discard a
-  f x y = (x, show y)
-
-  g :: Discard Int -> (Int,Bool)    -- A rank-2 type
-  g f = f Int True
-</programlisting>
-</para>
-</listitem>
-
-<listitem><para>
-You can write an unboxed tuple in a type synonym:
-<programlisting>
-  type Pr = (# Int, Int #)
-
-  h :: Int -> Pr
-  h x = (# x, x #)
-</programlisting>
-</para></listitem>
-
-<listitem><para>
-You can apply a type synonym to a forall type:
-<programlisting>
-  type Foo a = a -> a -> Bool
- 
-  f :: Foo (forall b. b->b)
-</programlisting>
-After expanding the synonym, <literal>f</literal> has the legal (in GHC) type:
-<programlisting>
-  f :: (forall b. b->b) -> (forall b. b->b) -> Bool
-</programlisting>
-</para></listitem>
-
-<listitem><para>
-You can apply a type synonym to a partially applied type synonym:
-<programlisting>
-  type Generic i o = forall x. i x -> o x
-  type Id x = x
-  
-  foo :: Generic Id []
-</programlisting>
-After expanding the synonym, <literal>foo</literal> has the legal (in GHC) type:
-<programlisting>
-  foo :: forall x. x -> [x]
-</programlisting>
-</para></listitem>
-
-</itemizedlist>
-</para>
-
-<para>
-GHC currently does kind checking before expanding synonyms (though even that
-could be changed.)
-</para>
-<para>
-After expanding type synonyms, GHC does validity checking on types, looking for
-the following mal-formedness which isn't detected simply by kind checking:
-<itemizedlist>
-<listitem><para>
-Type constructor applied to a type involving for-alls.
-</para></listitem>
-<listitem><para>
-Unboxed tuple on left of an arrow.
-</para></listitem>
-<listitem><para>
-Partially-applied type synonym.
-</para></listitem>
-</itemizedlist>
-So, for example,
-this will be rejected:
-<programlisting>
-  type Pr = (# Int, Int #)
-
-  h :: Pr -> Int
-  h x = ...
-</programlisting>
-because GHC does not allow  unboxed tuples on the left of a function arrow.
-</para>
-</sect3>
-
-
-<sect3 id="existential-quantification">
-<title>Existentially quantified data constructors
-</title>
-
-<para>
-The idea of using existential quantification in data type declarations
-was suggested by Perry, and implemented in Hope+ (Nigel Perry, <emphasis>The Implementation
-of Practical Functional Programming Languages</emphasis>, PhD Thesis, University of
-London, 1991). It was later formalised by Laufer and Odersky
-(<emphasis>Polymorphic type inference and abstract data types</emphasis>,
-TOPLAS, 16(5), pp1411-1430, 1994).
-It's been in Lennart
-Augustsson's <command>hbc</command> Haskell compiler for several years, and
-proved very useful.  Here's the idea.  Consider the declaration:
-</para>
-
-<para>
-
-<programlisting>
-  data Foo = forall a. MkFoo a (a -> Bool)
-           | Nil
-</programlisting>
-
-</para>
-
-<para>
-The data type <literal>Foo</literal> has two constructors with types:
-</para>
-
-<para>
-
-<programlisting>
-  MkFoo :: forall a. a -> (a -> Bool) -> Foo
-  Nil   :: Foo
-</programlisting>
-
-</para>
-
-<para>
-Notice that the type variable <literal>a</literal> in the type of <function>MkFoo</function>
-does not appear in the data type itself, which is plain <literal>Foo</literal>.
-For example, the following expression is fine:
-</para>
-
-<para>
-
-<programlisting>
-  [MkFoo 3 even, MkFoo 'c' isUpper] :: [Foo]
-</programlisting>
-
-</para>
-
-<para>
-Here, <literal>(MkFoo 3 even)</literal> packages an integer with a function
-<function>even</function> that maps an integer to <literal>Bool</literal>; and <function>MkFoo 'c'
-isUpper</function> packages a character with a compatible function.  These
-two things are each of type <literal>Foo</literal> and can be put in a list.
-</para>
-
-<para>
-What can we do with a value of type <literal>Foo</literal>?.  In particular,
-what happens when we pattern-match on <function>MkFoo</function>?
-</para>
-
-<para>
-
-<programlisting>
-  f (MkFoo val fn) = ???
-</programlisting>
-
-</para>
-
-<para>
-Since all we know about <literal>val</literal> and <function>fn</function> is that they
-are compatible, the only (useful) thing we can do with them is to
-apply <function>fn</function> to <literal>val</literal> to get a boolean.  For example:
-</para>
-
-<para>
-
-<programlisting>
-  f :: Foo -> Bool
-  f (MkFoo val fn) = fn val
-</programlisting>
-
-</para>
-
-<para>
-What this allows us to do is to package heterogenous values
-together with a bunch of functions that manipulate them, and then treat
-that collection of packages in a uniform manner.  You can express
-quite a bit of object-oriented-like programming this way.
-</para>
-
-<sect4 id="existential">
-<title>Why existential?
-</title>
-
-<para>
-What has this to do with <emphasis>existential</emphasis> quantification?
-Simply that <function>MkFoo</function> has the (nearly) isomorphic type
-</para>
-
-<para>
-
-<programlisting>
-  MkFoo :: (exists a . (a, a -> Bool)) -> Foo
-</programlisting>
-
-</para>
-
-<para>
-But Haskell programmers can safely think of the ordinary
-<emphasis>universally</emphasis> quantified type given above, thereby avoiding
-adding a new existential quantification construct.
-</para>
-
-</sect4>
-
-<sect4>
-<title>Type classes</title>
-
-<para>
-An easy extension is to allow
-arbitrary contexts before the constructor.  For example:
-</para>
-
-<para>
-
-<programlisting>
-data Baz = forall a. Eq a => Baz1 a a
-         | forall b. Show b => Baz2 b (b -> b)
-</programlisting>
-
-</para>
-
-<para>
-The two constructors have the types you'd expect:
-</para>
-
-<para>
-
-<programlisting>
-Baz1 :: forall a. Eq a => a -> a -> Baz
-Baz2 :: forall b. Show b => b -> (b -> b) -> Baz
-</programlisting>
-
-</para>
-
-<para>
-But when pattern matching on <function>Baz1</function> the matched values can be compared
-for equality, and when pattern matching on <function>Baz2</function> the first matched
-value can be converted to a string (as well as applying the function to it).
-So this program is legal:
-</para>
-
-<para>
-
-<programlisting>
-  f :: Baz -> String
-  f (Baz1 p q) | p == q    = "Yes"
-               | otherwise = "No"
-  f (Baz2 v fn)            = show (fn v)
-</programlisting>
-
-</para>
-
-<para>
-Operationally, in a dictionary-passing implementation, the
-constructors <function>Baz1</function> and <function>Baz2</function> must store the
-dictionaries for <literal>Eq</literal> and <literal>Show</literal> respectively, and
-extract it on pattern matching.
-</para>
-
-<para>
-Notice the way that the syntax fits smoothly with that used for
-universal quantification earlier.
-</para>
-
-</sect4>
-
-<sect4>
-<title>Record Constructors</title>
-
-<para>
-GHC allows existentials to be used with records syntax as well.  For example:
-
-<programlisting>
-data Counter a = forall self. NewCounter
-    { _this    :: self
-    , _inc     :: self -> self
-    , _display :: self -> IO ()
-    , tag      :: a
-    }
-</programlisting>
-Here <literal>tag</literal> is a public field, with a well-typed selector
-function <literal>tag :: Counter a -> a</literal>.  The <literal>self</literal>
-type is hidden from the outside; any attempt to apply <literal>_this</literal>,
-<literal>_inc</literal> or <literal>_output</literal> as functions will raise a
-compile-time error.  In other words, <emphasis>GHC defines a record selector function
-only for fields whose type does not mention the existentially-quantified variables</emphasis>.
-(This example used an underscore in the fields for which record selectors
-will not be defined, but that is only programming style; GHC ignores them.)
-</para>
-
-<para>
-To make use of these hidden fields, we need to create some helper functions:
-
-<programlisting>
-inc :: Counter a -> Counter a
-inc (NewCounter x i d t) = NewCounter
-    { _this = i x, _inc = i, _display = d, tag = t } 
-
-display :: Counter a -> IO ()
-display NewCounter{ _this = x, _display = d } = d x
-</programlisting>
-
-Now we can define counters with different underlying implementations:
-
-<programlisting>
-counterA :: Counter String 
-counterA = NewCounter
-    { _this = 0, _inc = (1+), _display = print, tag = "A" }
-
-counterB :: Counter String 
-counterB = NewCounter
-    { _this = "", _inc = ('#':), _display = putStrLn, tag = "B" }
-
-main = do
-    display (inc counterA)         -- prints "1"
-    display (inc (inc counterB))   -- prints "##"
-</programlisting>
-
-In GADT declarations (see <xref linkend="gadt"/>), the explicit
-<literal>forall</literal> may be omitted.  For example, we can express
-the same <literal>Counter a</literal> using GADT:
-
-<programlisting>
-data Counter a where
-    NewCounter { _this    :: self
-               , _inc     :: self -> self
-               , _display :: self -> IO ()
-               , tag      :: a
-               }
-        :: Counter a
-</programlisting>
-
-At the moment, record update syntax is only supported for Haskell 98 data types,
-so the following function does <emphasis>not</emphasis> work:
-
-<programlisting>
--- This is invalid; use explicit NewCounter instead for now
-setTag :: Counter a -> a -> Counter a
-setTag obj t = obj{ tag = t }
-</programlisting>
-
-</para>
-
-</sect4>
-
-
-<sect4>
-<title>Restrictions</title>
-
-<para>
-There are several restrictions on the ways in which existentially-quantified
-constructors can be use.
-</para>
-
-<para>
-
-<itemizedlist>
-<listitem>
-
-<para>
- When pattern matching, each pattern match introduces a new,
-distinct, type for each existential type variable.  These types cannot
-be unified with any other type, nor can they escape from the scope of
-the pattern match.  For example, these fragments are incorrect:
-
-
-<programlisting>
-f1 (MkFoo a f) = a
-</programlisting>
-
-
-Here, the type bound by <function>MkFoo</function> "escapes", because <literal>a</literal>
-is the result of <function>f1</function>.  One way to see why this is wrong is to
-ask what type <function>f1</function> has:
-
-
-<programlisting>
-  f1 :: Foo -> a             -- Weird!
-</programlisting>
-
-
-What is this "<literal>a</literal>" in the result type? Clearly we don't mean
-this:
-
-
-<programlisting>
-  f1 :: forall a. Foo -> a   -- Wrong!
-</programlisting>
-
-
-The original program is just plain wrong.  Here's another sort of error
-
-
-<programlisting>
-  f2 (Baz1 a b) (Baz1 p q) = a==q
-</programlisting>
-
-
-It's ok to say <literal>a==b</literal> or <literal>p==q</literal>, but
-<literal>a==q</literal> is wrong because it equates the two distinct types arising
-from the two <function>Baz1</function> constructors.
-
-
-</para>
-</listitem>
-<listitem>
-
-<para>
-You can't pattern-match on an existentially quantified
-constructor in a <literal>let</literal> or <literal>where</literal> group of
-bindings. So this is illegal:
-
-
-<programlisting>
-  f3 x = a==b where { Baz1 a b = x }
-</programlisting>
-
-Instead, use a <literal>case</literal> expression:
-
-<programlisting>
-  f3 x = case x of Baz1 a b -> a==b
-</programlisting>
-
-In general, you can only pattern-match
-on an existentially-quantified constructor in a <literal>case</literal> expression or
-in the patterns of a function definition.
-
-The reason for this restriction is really an implementation one.
-Type-checking binding groups is already a nightmare without
-existentials complicating the picture.  Also an existential pattern
-binding at the top level of a module doesn't make sense, because it's
-not clear how to prevent the existentially-quantified type "escaping".
-So for now, there's a simple-to-state restriction.  We'll see how
-annoying it is.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
-You can't use existential quantification for <literal>newtype</literal>
-declarations.  So this is illegal:
-
-
-<programlisting>
-  newtype T = forall a. Ord a => MkT a
-</programlisting>
-
-
-Reason: a value of type <literal>T</literal> must be represented as a
-pair of a dictionary for <literal>Ord t</literal> and a value of type
-<literal>t</literal>.  That contradicts the idea that
-<literal>newtype</literal> should have no concrete representation.
-You can get just the same efficiency and effect by using
-<literal>data</literal> instead of <literal>newtype</literal>.  If
-there is no overloading involved, then there is more of a case for
-allowing an existentially-quantified <literal>newtype</literal>,
-because the <literal>data</literal> version does carry an
-implementation cost, but single-field existentially quantified
-constructors aren't much use.  So the simple restriction (no
-existential stuff on <literal>newtype</literal>) stands, unless there
-are convincing reasons to change it.
-
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- You can't use <literal>deriving</literal> to define instances of a
-data type with existentially quantified data constructors.
-
-Reason: in most cases it would not make sense. For example:&num;
-
-<programlisting>
-data T = forall a. MkT [a] deriving( Eq )
-</programlisting>
-
-To derive <literal>Eq</literal> in the standard way we would need to have equality
-between the single component of two <function>MkT</function> constructors:
-
-<programlisting>
-instance Eq T where
-  (MkT a) == (MkT b) = ???
-</programlisting>
-
-But <varname>a</varname> and <varname>b</varname> have distinct types, and so can't be compared.
-It's just about possible to imagine examples in which the derived instance
-would make sense, but it seems altogether simpler simply to prohibit such
-declarations.  Define your own instances!
-</para>
-</listitem>
-
-</itemizedlist>
-
-</para>
-
-</sect4>
-</sect3>
-
-</sect2>
-
-
-
-<sect2 id="multi-param-type-classes">
-<title>Class declarations</title>
-
-<para>
-This section, and the next one, documents GHC's type-class extensions.
-There's lots of background in the paper <ulink
-url="http://research.microsoft.com/~simonpj/Papers/type-class-design-space" >Type
-classes: exploring the design space</ulink > (Simon Peyton Jones, Mark
-Jones, Erik Meijer).
-</para>
-<para>
-All the extensions are enabled by the <option>-fglasgow-exts</option> flag.
-</para>
-
-<sect3>
-<title>Multi-parameter type classes</title>
-<para>
-Multi-parameter type classes are permitted. For example:
-
-
-<programlisting>
-  class Collection c a where
-    union :: c a -> c a -> c a
-    ...etc.
-</programlisting>
-
-</para>
-</sect3>
-
-<sect3>
-<title>The superclasses of a class declaration</title>
-
-<para>
-There are no restrictions on the context in a class declaration
-(which introduces superclasses), except that the class hierarchy must
-be acyclic.  So these class declarations are OK:
-
-
-<programlisting>
-  class Functor (m k) => FiniteMap m k where
-    ...
-
-  class (Monad m, Monad (t m)) => Transform t m where
-    lift :: m a -> (t m) a
-</programlisting>
-
-
-</para>
-<para>
-As in Haskell 98, The class hierarchy must be acyclic.  However, the definition
-of "acyclic" involves only the superclass relationships.  For example,
-this is OK:
-
-
-<programlisting>
-  class C a where {
-    op :: D b => a -> b -> b
-  }
-
-  class C a => D a where { ... }
-</programlisting>
-
-
-Here, <literal>C</literal> is a superclass of <literal>D</literal>, but it's OK for a
-class operation <literal>op</literal> of <literal>C</literal> to mention <literal>D</literal>.  (It
-would not be OK for <literal>D</literal> to be a superclass of <literal>C</literal>.)
-</para>
-</sect3>
-
-
-
-
-<sect3 id="class-method-types">
-<title>Class method types</title>
-
-<para>
-Haskell 98 prohibits class method types to mention constraints on the
-class type variable, thus:
-<programlisting>
-  class Seq s a where
-    fromList :: [a] -> s a
-    elem     :: Eq a => a -> s a -> Bool
-</programlisting>
-The type of <literal>elem</literal> is illegal in Haskell 98, because it
-contains the constraint <literal>Eq a</literal>, constrains only the 
-class type variable (in this case <literal>a</literal>).
-GHC lifts this restriction.
-</para>
-
-
-</sect3>
-</sect2>
-
-<sect2 id="functional-dependencies">
-<title>Functional dependencies
-</title>
-
-<para> Functional dependencies are implemented as described by Mark Jones
-in &ldquo;<ulink url="http://www.cse.ogi.edu/~mpj/pubs/fundeps.html">Type Classes with Functional Dependencies</ulink>&rdquo;, Mark P. Jones, 
-In Proceedings of the 9th European Symposium on Programming, 
-ESOP 2000, Berlin, Germany, March 2000, Springer-Verlag LNCS 1782,
-.
-</para>
-<para>
-Functional dependencies are introduced by a vertical bar in the syntax of a 
-class declaration;  e.g. 
-<programlisting>
-  class (Monad m) => MonadState s m | m -> s where ...
-
-  class Foo a b c | a b -> c where ...
-</programlisting>
-There should be more documentation, but there isn't (yet).  Yell if you need it.
-</para>
-
-<sect3><title>Rules for functional dependencies </title>
-<para>
-In a class declaration, all of the class type variables must be reachable (in the sense 
-mentioned in <xref linkend="type-restrictions"/>)
-from the free variables of each method type.
-For example:
-
-<programlisting>
-  class Coll s a where
-    empty  :: s
-    insert :: s -> a -> s
-</programlisting>
-
-is not OK, because the type of <literal>empty</literal> doesn't mention
-<literal>a</literal>.  Functional dependencies can make the type variable
-reachable:
-<programlisting>
-  class Coll s a | s -> a where
-    empty  :: s
-    insert :: s -> a -> s
-</programlisting>
-
-Alternatively <literal>Coll</literal> might be rewritten
-
-<programlisting>
-  class Coll s a where
-    empty  :: s a
-    insert :: s a -> a -> s a
-</programlisting>
-
-
-which makes the connection between the type of a collection of
-<literal>a</literal>'s (namely <literal>(s a)</literal>) and the element type <literal>a</literal>.
-Occasionally this really doesn't work, in which case you can split the
-class like this:
-
-
-<programlisting>
-  class CollE s where
-    empty  :: s
-
-  class CollE s => Coll s a where
-    insert :: s -> a -> s
-</programlisting>
-</para>
-</sect3>
-
-
-<sect3>
-<title>Background on functional dependencies</title>
-
-<para>The following description of the motivation and use of functional dependencies is taken
-from the Hugs user manual, reproduced here (with minor changes) by kind
-permission of Mark Jones.
-</para>
-<para> 
-Consider the following class, intended as part of a
-library for collection types:
-<programlisting>
-   class Collects e ce where
-       empty  :: ce
-       insert :: e -> ce -> ce
-       member :: e -> ce -> Bool
-</programlisting>
-The type variable e used here represents the element type, while ce is the type
-of the container itself. Within this framework, we might want to define
-instances of this class for lists or characteristic functions (both of which
-can be used to represent collections of any equality type), bit sets (which can
-be used to represent collections of characters), or hash tables (which can be
-used to represent any collection whose elements have a hash function). Omitting
-standard implementation details, this would lead to the following declarations: 
-<programlisting>
-   instance Eq e => Collects e [e] where ...
-   instance Eq e => Collects e (e -> Bool) where ...
-   instance Collects Char BitSet where ...
-   instance (Hashable e, Collects a ce)
-              => Collects e (Array Int ce) where ...
-</programlisting>
-All this looks quite promising; we have a class and a range of interesting
-implementations. Unfortunately, there are some serious problems with the class
-declaration. First, the empty function has an ambiguous type: 
-<programlisting>
-   empty :: Collects e ce => ce
-</programlisting>
-By "ambiguous" we mean that there is a type variable e that appears on the left
-of the <literal>=&gt;</literal> symbol, but not on the right. The problem with
-this is that, according to the theoretical foundations of Haskell overloading,
-we cannot guarantee a well-defined semantics for any term with an ambiguous
-type.
-</para>
-<para>
-We can sidestep this specific problem by removing the empty member from the
-class declaration. However, although the remaining members, insert and member,
-do not have ambiguous types, we still run into problems when we try to use
-them. For example, consider the following two functions: 
-<programlisting>
-   f x y = insert x . insert y
-   g     = f True 'a'
-</programlisting>
-for which GHC infers the following types: 
-<programlisting>
-   f :: (Collects a c, Collects b c) => a -> b -> c -> c
-   g :: (Collects Bool c, Collects Char c) => c -> c
-</programlisting>
-Notice that the type for f allows the two parameters x and y to be assigned
-different types, even though it attempts to insert each of the two values, one
-after the other, into the same collection. If we're trying to model collections
-that contain only one type of value, then this is clearly an inaccurate
-type. Worse still, the definition for g is accepted, without causing a type
-error. As a result, the error in this code will not be flagged at the point
-where it appears. Instead, it will show up only when we try to use g, which
-might even be in a different module.
-</para>
-
-<sect4><title>An attempt to use constructor classes</title>
-
-<para>
-Faced with the problems described above, some Haskell programmers might be
-tempted to use something like the following version of the class declaration: 
-<programlisting>
-   class Collects e c where
-      empty  :: c e
-      insert :: e -> c e -> c e
-      member :: e -> c e -> Bool
-</programlisting>
-The key difference here is that we abstract over the type constructor c that is
-used to form the collection type c e, and not over that collection type itself,
-represented by ce in the original class declaration. This avoids the immediate
-problems that we mentioned above: empty has type <literal>Collects e c => c
-e</literal>, which is not ambiguous. 
-</para>
-<para>
-The function f from the previous section has a more accurate type: 
-<programlisting>
-   f :: (Collects e c) => e -> e -> c e -> c e
-</programlisting>
-The function g from the previous section is now rejected with a type error as
-we would hope because the type of f does not allow the two arguments to have
-different types. 
-This, then, is an example of a multiple parameter class that does actually work
-quite well in practice, without ambiguity problems.
-There is, however, a catch. This version of the Collects class is nowhere near
-as general as the original class seemed to be: only one of the four instances
-for <literal>Collects</literal>
-given above can be used with this version of Collects because only one of
-them---the instance for lists---has a collection type that can be written in
-the form c e, for some type constructor c, and element type e.
-</para>
-</sect4>
-
-<sect4><title>Adding functional dependencies</title>
-
-<para>
-To get a more useful version of the Collects class, Hugs provides a mechanism
-that allows programmers to specify dependencies between the parameters of a
-multiple parameter class (For readers with an interest in theoretical
-foundations and previous work: The use of dependency information can be seen
-both as a generalization of the proposal for `parametric type classes' that was
-put forward by Chen, Hudak, and Odersky, or as a special case of Mark Jones's
-later framework for "improvement" of qualified types. The
-underlying ideas are also discussed in a more theoretical and abstract setting
-in a manuscript [implparam], where they are identified as one point in a
-general design space for systems of implicit parameterization.).
-
-To start with an abstract example, consider a declaration such as: 
-<programlisting>
-   class C a b where ...
-</programlisting>
-which tells us simply that C can be thought of as a binary relation on types
-(or type constructors, depending on the kinds of a and b). Extra clauses can be
-included in the definition of classes to add information about dependencies
-between parameters, as in the following examples: 
-<programlisting>
-   class D a b | a -> b where ...
-   class E a b | a -> b, b -> a where ...
-</programlisting>
-The notation <literal>a -&gt; b</literal> used here between the | and where
-symbols --- not to be
-confused with a function type --- indicates that the a parameter uniquely
-determines the b parameter, and might be read as "a determines b." Thus D is
-not just a relation, but actually a (partial) function. Similarly, from the two
-dependencies that are included in the definition of E, we can see that E
-represents a (partial) one-one mapping between types.
-</para>
-<para>
-More generally, dependencies take the form <literal>x1 ... xn -&gt; y1 ... ym</literal>,
-where x1, ..., xn, and y1, ..., yn are type variables with n&gt;0 and
-m&gt;=0, meaning that the y parameters are uniquely determined by the x
-parameters. Spaces can be used as separators if more than one variable appears
-on any single side of a dependency, as in <literal>t -&gt; a b</literal>. Note that a class may be
-annotated with multiple dependencies using commas as separators, as in the
-definition of E above. Some dependencies that we can write in this notation are
-redundant, and will be rejected because they don't serve any useful
-purpose, and may instead indicate an error in the program. Examples of
-dependencies like this include  <literal>a -&gt; a </literal>,  
-<literal>a -&gt; a a </literal>,  
-<literal>a -&gt; </literal>, etc. There can also be
-some redundancy if multiple dependencies are given, as in  
-<literal>a-&gt;b</literal>, 
- <literal>b-&gt;c </literal>,  <literal>a-&gt;c </literal>, and
-in which some subset implies the remaining dependencies. Examples like this are
-not treated as errors. Note that dependencies appear only in class
-declarations, and not in any other part of the language. In particular, the
-syntax for instance declarations, class constraints, and types is completely
-unchanged.
-</para>
-<para>
-By including dependencies in a class declaration, we provide a mechanism for
-the programmer to specify each multiple parameter class more precisely. The
-compiler, on the other hand, is responsible for ensuring that the set of
-instances that are in scope at any given point in the program is consistent
-with any declared dependencies. For example, the following pair of instance
-declarations cannot appear together in the same scope because they violate the
-dependency for D, even though either one on its own would be acceptable: 
-<programlisting>
-   instance D Bool Int where ...
-   instance D Bool Char where ...
-</programlisting>
-Note also that the following declaration is not allowed, even by itself: 
-<programlisting>
-   instance D [a] b where ...
-</programlisting>
-The problem here is that this instance would allow one particular choice of [a]
-to be associated with more than one choice for b, which contradicts the
-dependency specified in the definition of D. More generally, this means that,
-in any instance of the form: 
-<programlisting>
-   instance D t s where ...
-</programlisting>
-for some particular types t and s, the only variables that can appear in s are
-the ones that appear in t, and hence, if the type t is known, then s will be
-uniquely determined.
-</para>
-<para>
-The benefit of including dependency information is that it allows us to define
-more general multiple parameter classes, without ambiguity problems, and with
-the benefit of more accurate types. To illustrate this, we return to the
-collection class example, and annotate the original definition of <literal>Collects</literal>
-with a simple dependency: 
-<programlisting>
-   class Collects e ce | ce -> e where
-      empty  :: ce
-      insert :: e -> ce -> ce
-      member :: e -> ce -> Bool
-</programlisting>
-The dependency <literal>ce -&gt; e</literal> here specifies that the type e of elements is uniquely
-determined by the type of the collection ce. Note that both parameters of
-Collects are of kind *; there are no constructor classes here. Note too that
-all of the instances of Collects that we gave earlier can be used
-together with this new definition.
-</para>
-<para>
-What about the ambiguity problems that we encountered with the original
-definition? The empty function still has type Collects e ce => ce, but it is no
-longer necessary to regard that as an ambiguous type: Although the variable e
-does not appear on the right of the => symbol, the dependency for class
-Collects tells us that it is uniquely determined by ce, which does appear on
-the right of the => symbol. Hence the context in which empty is used can still
-give enough information to determine types for both ce and e, without
-ambiguity. More generally, we need only regard a type as ambiguous if it
-contains a variable on the left of the => that is not uniquely determined
-(either directly or indirectly) by the variables on the right.
-</para>
-<para>
-Dependencies also help to produce more accurate types for user defined
-functions, and hence to provide earlier detection of errors, and less cluttered
-types for programmers to work with. Recall the previous definition for a
-function f: 
-<programlisting>
-   f x y = insert x y = insert x . insert y
-</programlisting>
-for which we originally obtained a type: 
-<programlisting>
-   f :: (Collects a c, Collects b c) => a -> b -> c -> c
-</programlisting>
-Given the dependency information that we have for Collects, however, we can
-deduce that a and b must be equal because they both appear as the second
-parameter in a Collects constraint with the same first parameter c. Hence we
-can infer a shorter and more accurate type for f: 
-<programlisting>
-   f :: (Collects a c) => a -> a -> c -> c
-</programlisting>
-In a similar way, the earlier definition of g will now be flagged as a type error.
-</para>
-<para>
-Although we have given only a few examples here, it should be clear that the
-addition of dependency information can help to make multiple parameter classes
-more useful in practice, avoiding ambiguity problems, and allowing more general
-sets of instance declarations.
-</para>
-</sect4>
-</sect3>
-</sect2>
-
-<sect2 id="instance-decls">
-<title>Instance declarations</title>
-
-<sect3 id="instance-rules">
-<title>Relaxed rules for instance declarations</title>
-
-<para>An instance declaration has the form
-<screen>
-  instance ( <replaceable>assertion</replaceable><subscript>1</subscript>, ..., <replaceable>assertion</replaceable><subscript>n</subscript>) =&gt; <replaceable>class</replaceable> <replaceable>type</replaceable><subscript>1</subscript> ... <replaceable>type</replaceable><subscript>m</subscript> where ...
-</screen>
-The part before the "<literal>=&gt;</literal>" is the
-<emphasis>context</emphasis>, while the part after the
-"<literal>=&gt;</literal>" is the <emphasis>head</emphasis> of the instance declaration.
-</para>
-
-<para>
-In Haskell 98 the head of an instance declaration
-must be of the form <literal>C (T a1 ... an)</literal>, where
-<literal>C</literal> is the class, <literal>T</literal> is a type constructor,
-and the <literal>a1 ... an</literal> are distinct type variables.
-Furthermore, the assertions in the context of the instance declaration
-must be of the form <literal>C a</literal> where <literal>a</literal>
-is a type variable that occurs in the head.
-</para>
-<para>
-The <option>-fglasgow-exts</option> flag loosens these restrictions
-considerably.  Firstly, multi-parameter type classes are permitted.  Secondly,
-the context and head of the instance declaration can each consist of arbitrary
-(well-kinded) assertions <literal>(C t1 ... tn)</literal> subject only to the
-following rules:
-<orderedlist>
-<listitem><para>
-For each assertion in the context:
-<orderedlist>
-<listitem><para>No type variable has more occurrences in the assertion than in the head</para></listitem>
-<listitem><para>The assertion has fewer constructors and variables (taken together
-      and counting repetitions) than the head</para></listitem>
-</orderedlist>
-</para></listitem>
-
-<listitem><para>The coverage condition.  For each functional dependency,
-<replaceable>tvs</replaceable><subscript>left</subscript> <literal>-&gt;</literal>
-<replaceable>tvs</replaceable><subscript>right</subscript>,  of the class,
-every type variable in
-S(<replaceable>tvs</replaceable><subscript>right</subscript>) must appear in 
-S(<replaceable>tvs</replaceable><subscript>left</subscript>), where S is the
-substitution mapping each type variable in the class declaration to the
-corresponding type in the instance declaration.
-</para></listitem>
-</orderedlist>
-These restrictions ensure that context reduction terminates: each reduction
-step makes the problem smaller by at least one
-constructor.  For example, the following would make the type checker
-loop if it wasn't excluded:
-<programlisting>
-  instance C a => C a where ...
-</programlisting>
-For example, these are OK:
-<programlisting>
-  instance C Int [a]          -- Multiple parameters
-  instance Eq (S [a])         -- Structured type in head
-
-      -- Repeated type variable in head
-  instance C4 a a => C4 [a] [a] 
-  instance Stateful (ST s) (MutVar s)
-
-      -- Head can consist of type variables only
-  instance C a
-  instance (Eq a, Show b) => C2 a b
-
-      -- Non-type variables in context
-  instance Show (s a) => Show (Sized s a)
-  instance C2 Int a => C3 Bool [a]
-  instance C2 Int a => C3 [a] b
-</programlisting>
-But these are not:
-<programlisting>
-      -- Context assertion no smaller than head
-  instance C a => C a where ...
-      -- (C b b) has more more occurrences of b than the head
-  instance C b b => Foo [b] where ...
-</programlisting>
-</para>
-
-<para>
-The same restrictions apply to instances generated by
-<literal>deriving</literal> clauses.  Thus the following is accepted:
-<programlisting>
-  data MinHeap h a = H a (h a)
-    deriving (Show)
-</programlisting>
-because the derived instance
-<programlisting>
-  instance (Show a, Show (h a)) => Show (MinHeap h a)
-</programlisting>
-conforms to the above rules.
-</para>
-
-<para>
-A useful idiom permitted by the above rules is as follows.
-If one allows overlapping instance declarations then it's quite
-convenient to have a "default instance" declaration that applies if
-something more specific does not:
-<programlisting>
-  instance C a where
-    op = ... -- Default
-</programlisting>
-</para>
-</sect3>
-
-<sect3 id="undecidable-instances">
-<title>Undecidable instances</title>
-
-<para>
-Sometimes even the rules of <xref linkend="instance-rules"/> are too onerous.
-For example, sometimes you might want to use the following to get the
-effect of a "class synonym":
-<programlisting>
-  class (C1 a, C2 a, C3 a) => C a where { }
-
-  instance (C1 a, C2 a, C3 a) => C a where { }
-</programlisting>
-This allows you to write shorter signatures:
-<programlisting>
-  f :: C a => ...
-</programlisting>
-instead of
-<programlisting>
-  f :: (C1 a, C2 a, C3 a) => ...
-</programlisting>
-The restrictions on functional dependencies (<xref
-linkend="functional-dependencies"/>) are particularly troublesome.
-It is tempting to introduce type variables in the context that do not appear in
-the head, something that is excluded by the normal rules. For example:
-<programlisting>
-  class HasConverter a b | a -> b where
-     convert :: a -> b
-   
-  data Foo a = MkFoo a
-
-  instance (HasConverter a b,Show b) => Show (Foo a) where
-     show (MkFoo value) = show (convert value)
-</programlisting>
-This is dangerous territory, however. Here, for example, is a program that would make the
-typechecker loop:
-<programlisting>
-  class D a
-  class F a b | a->b
-  instance F [a] [[a]]
-  instance (D c, F a c) => D [a]   -- 'c' is not mentioned in the head
-</programlisting>  
-Similarly, it can be tempting to lift the coverage condition:
-<programlisting>
-  class Mul a b c | a b -> c where
-  	(.*.) :: a -> b -> c
-
-  instance Mul Int Int Int where (.*.) = (*)
-  instance Mul Int Float Float where x .*. y = fromIntegral x * y
-  instance Mul a b c => Mul a [b] [c] where x .*. v = map (x.*.) v
-</programlisting>
-The third instance declaration does not obey the coverage condition;
-and indeed the (somewhat strange) definition:
-<programlisting>
-  f = \ b x y -> if b then x .*. [y] else y
-</programlisting>
-makes instance inference go into a loop, because it requires the constraint
-<literal>(Mul a [b] b)</literal>.
-</para>
-<para>
-Nevertheless, GHC allows you to experiment with more liberal rules.  If you use
-the experimental flag <option>-fallow-undecidable-instances</option>
-<indexterm><primary>-fallow-undecidable-instances
-option</primary></indexterm>, you can use arbitrary
-types in both an instance context and instance head.  Termination is ensured by having a
-fixed-depth recursion stack.  If you exceed the stack depth you get a
-sort of backtrace, and the opportunity to increase the stack depth
-with <option>-fcontext-stack</option><emphasis>N</emphasis>.
-</para>
-
-</sect3>
-
-
-<sect3 id="instance-overlap">
-<title>Overlapping instances</title>
-<para>
-In general, <emphasis>GHC requires that that it be unambiguous which instance
-declaration
-should be used to resolve a type-class constraint</emphasis>. This behaviour
-can be modified by two flags: <option>-fallow-overlapping-instances</option>
-<indexterm><primary>-fallow-overlapping-instances
-</primary></indexterm> 
-and <option>-fallow-incoherent-instances</option>
-<indexterm><primary>-fallow-incoherent-instances
-</primary></indexterm>, as this section discusses.</para>
-<para>
-When GHC tries to resolve, say, the constraint <literal>C Int Bool</literal>,
-it tries to match every instance declaration against the
-constraint,
-by instantiating the head of the instance declaration.  For example, consider
-these declarations:
-<programlisting>
-  instance context1 => C Int a     where ...  -- (A)
-  instance context2 => C a   Bool  where ...  -- (B)
-  instance context3 => C Int [a]   where ...  -- (C)
-  instance context4 => C Int [Int] where ...  -- (D)
-</programlisting>
-The instances (A) and (B) match the constraint <literal>C Int Bool</literal>, 
-but (C) and (D) do not.  When matching, GHC takes
-no account of the context of the instance declaration
-(<literal>context1</literal> etc).
-GHC's default behaviour is that <emphasis>exactly one instance must match the
-constraint it is trying to resolve</emphasis>.  
-It is fine for there to be a <emphasis>potential</emphasis> of overlap (by
-including both declarations (A) and (B), say); an error is only reported if a 
-particular constraint matches more than one.
-</para>
-
-<para>
-The <option>-fallow-overlapping-instances</option> flag instructs GHC to allow
-more than one instance to match, provided there is a most specific one.  For
-example, the constraint <literal>C Int [Int]</literal> matches instances (A),
-(C) and (D), but the last is more specific, and hence is chosen.  If there is no
-most-specific match, the program is rejected.
-</para>
-<para>
-However, GHC is conservative about committing to an overlapping instance.  For example:
-<programlisting>
-  f :: [b] -> [b]
-  f x = ...
-</programlisting>
-Suppose that from the RHS of <literal>f</literal> we get the constraint
-<literal>C Int [b]</literal>.  But
-GHC does not commit to instance (C), because in a particular
-call of <literal>f</literal>, <literal>b</literal> might be instantiate 
-to <literal>Int</literal>, in which case instance (D) would be more specific still.
-So GHC rejects the program.  If you add the flag <option>-fallow-incoherent-instances</option>,
-GHC will instead pick (C), without complaining about 
-the problem of subsequent instantiations.
-</para>
-<para>
-The willingness to be overlapped or incoherent is a property of 
-the <emphasis>instance declaration</emphasis> itself, controlled by the
-presence or otherwise of the <option>-fallow-overlapping-instances</option> 
-and <option>-fallow-incoherent-instances</option> flags when that mdodule is
-being defined.  Neither flag is required in a module that imports and uses the
-instance declaration.  Specifically, during the lookup process:
-<itemizedlist>
-<listitem><para>
-An instance declaration is ignored during the lookup process if (a) a more specific
-match is found, and (b) the instance declaration was compiled with 
-<option>-fallow-overlapping-instances</option>.  The flag setting for the
-more-specific instance does not matter.
-</para></listitem>
-<listitem><para>
-Suppose an instance declaration does not matche the constraint being looked up, but
-does unify with it, so that it might match when the constraint is further 
-instantiated.  Usually GHC will regard this as a reason for not committing to
-some other constraint.  But if the instance declaration was compiled with
-<option>-fallow-incoherent-instances</option>, GHC will skip the "does-it-unify?" 
-check for that declaration.
-</para></listitem>
-</itemizedlist>
-All this makes it possible for a library author to design a library that relies on 
-overlapping instances without the library client having to know.
-</para>
-<para>The <option>-fallow-incoherent-instances</option> flag implies the
-<option>-fallow-overlapping-instances</option> flag, but not vice versa.
-</para>
-</sect3>
-
-<sect3>
-<title>Type synonyms in the instance head</title>
-
-<para>
-<emphasis>Unlike Haskell 98, instance heads may use type
-synonyms</emphasis>.  (The instance "head" is the bit after the "=>" in an instance decl.)
-As always, using a type synonym is just shorthand for
-writing the RHS of the type synonym definition.  For example:
-
-
-<programlisting>
-  type Point = (Int,Int)
-  instance C Point   where ...
-  instance C [Point] where ...
-</programlisting>
-
-
-is legal.  However, if you added
-
-
-<programlisting>
-  instance C (Int,Int) where ...
-</programlisting>
-
-
-as well, then the compiler will complain about the overlapping
-(actually, identical) instance declarations.  As always, type synonyms
-must be fully applied.  You cannot, for example, write:
-
-
-<programlisting>
-  type P a = [[a]]
-  instance Monad P where ...
-</programlisting>
-
-
-This design decision is independent of all the others, and easily
-reversed, but it makes sense to me.
-
-</para>
-</sect3>
-
-
-</sect2>
-
-<sect2 id="type-restrictions">
-<title>Type signatures</title>
-
-<sect3><title>The context of a type signature</title>
-<para>
-Unlike Haskell 98, constraints in types do <emphasis>not</emphasis> have to be of
-the form <emphasis>(class type-variable)</emphasis> or
-<emphasis>(class (type-variable type-variable ...))</emphasis>.  Thus,
-these type signatures are perfectly OK
-<programlisting>
-  g :: Eq [a] => ...
-  g :: Ord (T a ()) => ...
-</programlisting>
-</para>
-<para>
-GHC imposes the following restrictions on the constraints in a type signature.
-Consider the type:
-
-<programlisting>
-  forall tv1..tvn (c1, ...,cn) => type
-</programlisting>
-
-(Here, we write the "foralls" explicitly, although the Haskell source
-language omits them; in Haskell 98, all the free type variables of an
-explicit source-language type signature are universally quantified,
-except for the class type variables in a class declaration.  However,
-in GHC, you can give the foralls if you want.  See <xref linkend="universal-quantification"/>).
-</para>
-
-<para>
-
-<orderedlist>
-<listitem>
-
-<para>
- <emphasis>Each universally quantified type variable
-<literal>tvi</literal> must be reachable from <literal>type</literal></emphasis>.
-
-A type variable <literal>a</literal> is "reachable" if it it appears
-in the same constraint as either a type variable free in in
-<literal>type</literal>, or another reachable type variable.  
-A value with a type that does not obey 
-this reachability restriction cannot be used without introducing
-ambiguity; that is why the type is rejected.
-Here, for example, is an illegal type:
-
-
-<programlisting>
-  forall a. Eq a => Int
-</programlisting>
-
-
-When a value with this type was used, the constraint <literal>Eq tv</literal>
-would be introduced where <literal>tv</literal> is a fresh type variable, and
-(in the dictionary-translation implementation) the value would be
-applied to a dictionary for <literal>Eq tv</literal>.  The difficulty is that we
-can never know which instance of <literal>Eq</literal> to use because we never
-get any more information about <literal>tv</literal>.
-</para>
-<para>
-Note
-that the reachability condition is weaker than saying that <literal>a</literal> is
-functionally dependent on a type variable free in
-<literal>type</literal> (see <xref
-linkend="functional-dependencies"/>).  The reason for this is there
-might be a "hidden" dependency, in a superclass perhaps.  So
-"reachable" is a conservative approximation to "functionally dependent".
-For example, consider:
-<programlisting>
-  class C a b | a -> b where ...
-  class C a b => D a b where ...
-  f :: forall a b. D a b => a -> a
-</programlisting>
-This is fine, because in fact <literal>a</literal> does functionally determine <literal>b</literal>
-but that is not immediately apparent from <literal>f</literal>'s type.
-</para>
-</listitem>
-<listitem>
-
-<para>
- <emphasis>Every constraint <literal>ci</literal> must mention at least one of the
-universally quantified type variables <literal>tvi</literal></emphasis>.
-
-For example, this type is OK because <literal>C a b</literal> mentions the
-universally quantified type variable <literal>b</literal>:
-
-
-<programlisting>
-  forall a. C a b => burble
-</programlisting>
-
-
-The next type is illegal because the constraint <literal>Eq b</literal> does not
-mention <literal>a</literal>:
-
-
-<programlisting>
-  forall a. Eq b => burble
-</programlisting>
-
-
-The reason for this restriction is milder than the other one.  The
-excluded types are never useful or necessary (because the offending
-context doesn't need to be witnessed at this point; it can be floated
-out).  Furthermore, floating them out increases sharing. Lastly,
-excluding them is a conservative choice; it leaves a patch of
-territory free in case we need it later.
-
-</para>
-</listitem>
-
-</orderedlist>
-
-</para>
-</sect3>
-
-<sect3 id="hoist">
-<title>For-all hoisting</title>
-<para>
-It is often convenient to use generalised type synonyms (see <xref linkend="type-synonyms"/>) at the right hand
-end of an arrow, thus:
-<programlisting>
-  type Discard a = forall b. a -> b -> a
-
-  g :: Int -> Discard Int
-  g x y z = x+y
-</programlisting>
-Simply expanding the type synonym would give
-<programlisting>
-  g :: Int -> (forall b. Int -> b -> Int)
-</programlisting>
-but GHC "hoists" the <literal>forall</literal> to give the isomorphic type
-<programlisting>
-  g :: forall b. Int -> Int -> b -> Int
-</programlisting>
-In general, the rule is this: <emphasis>to determine the type specified by any explicit
-user-written type (e.g. in a type signature), GHC expands type synonyms and then repeatedly
-performs the transformation:</emphasis>
-<programlisting>
-  <emphasis>type1</emphasis> -> forall a1..an. <emphasis>context2</emphasis> => <emphasis>type2</emphasis>
-==>
-  forall a1..an. <emphasis>context2</emphasis> => <emphasis>type1</emphasis> -> <emphasis>type2</emphasis>
-</programlisting>
-(In fact, GHC tries to retain as much synonym information as possible for use in
-error messages, but that is a usability issue.)  This rule applies, of course, whether
-or not the <literal>forall</literal> comes from a synonym. For example, here is another
-valid way to write <literal>g</literal>'s type signature:
-<programlisting>
-  g :: Int -> Int -> forall b. b -> Int
-</programlisting>
-</para>
-<para>
-When doing this hoisting operation, GHC eliminates duplicate constraints.  For
-example:
-<programlisting>
-  type Foo a = (?x::Int) => Bool -> a
-  g :: Foo (Foo Int)
-</programlisting>
-means
-<programlisting>
-  g :: (?x::Int) => Bool -> Bool -> Int
-</programlisting>
-</para>
-</sect3>
-
-
-</sect2>
-
-<sect2 id="implicit-parameters">
-<title>Implicit parameters</title>
-
-<para> Implicit parameters are implemented as described in 
-"Implicit parameters: dynamic scoping with static types", 
-J Lewis, MB Shields, E Meijer, J Launchbury,
-27th ACM Symposium on Principles of Programming Languages (POPL'00),
-Boston, Jan 2000.
-</para>
-
-<para>(Most of the following, stil rather incomplete, documentation is
-due to Jeff Lewis.)</para>
-
-<para>Implicit parameter support is enabled with the option
-<option>-fimplicit-params</option>.</para>
-
-<para>
-A variable is called <emphasis>dynamically bound</emphasis> when it is bound by the calling
-context of a function and <emphasis>statically bound</emphasis> when bound by the callee's
-context. In Haskell, all variables are statically bound. Dynamic
-binding of variables is a notion that goes back to Lisp, but was later
-discarded in more modern incarnations, such as Scheme. Dynamic binding
-can be very confusing in an untyped language, and unfortunately, typed
-languages, in particular Hindley-Milner typed languages like Haskell,
-only support static scoping of variables.
-</para>
-<para>
-However, by a simple extension to the type class system of Haskell, we
-can support dynamic binding. Basically, we express the use of a
-dynamically bound variable as a constraint on the type. These
-constraints lead to types of the form <literal>(?x::t') => t</literal>, which says "this
-function uses a dynamically-bound variable <literal>?x</literal> 
-of type <literal>t'</literal>". For
-example, the following expresses the type of a sort function,
-implicitly parameterized by a comparison function named <literal>cmp</literal>.
-<programlisting>
-  sort :: (?cmp :: a -> a -> Bool) => [a] -> [a]
-</programlisting>
-The dynamic binding constraints are just a new form of predicate in the type class system.
-</para>
-<para>
-An implicit parameter occurs in an expression using the special form <literal>?x</literal>, 
-where <literal>x</literal> is
-any valid identifier (e.g. <literal>ord ?x</literal> is a valid expression). 
-Use of this construct also introduces a new
-dynamic-binding constraint in the type of the expression. 
-For example, the following definition
-shows how we can define an implicitly parameterized sort function in
-terms of an explicitly parameterized <literal>sortBy</literal> function:
-<programlisting>
-  sortBy :: (a -> a -> Bool) -> [a] -> [a]
-
-  sort   :: (?cmp :: a -> a -> Bool) => [a] -> [a]
-  sort    = sortBy ?cmp
-</programlisting>
-</para>
-
-<sect3>
-<title>Implicit-parameter type constraints</title>
-<para>
-Dynamic binding constraints behave just like other type class
-constraints in that they are automatically propagated. Thus, when a
-function is used, its implicit parameters are inherited by the
-function that called it. For example, our <literal>sort</literal> function might be used
-to pick out the least value in a list:
-<programlisting>
-  least   :: (?cmp :: a -> a -> Bool) => [a] -> a
-  least xs = fst (sort xs)
-</programlisting>
-Without lifting a finger, the <literal>?cmp</literal> parameter is
-propagated to become a parameter of <literal>least</literal> as well. With explicit
-parameters, the default is that parameters must always be explicit
-propagated. With implicit parameters, the default is to always
-propagate them.
-</para>
-<para>
-An implicit-parameter type constraint differs from other type class constraints in the
-following way: All uses of a particular implicit parameter must have
-the same type. This means that the type of <literal>(?x, ?x)</literal> 
-is <literal>(?x::a) => (a,a)</literal>, and not 
-<literal>(?x::a, ?x::b) => (a, b)</literal>, as would be the case for type
-class constraints.
-</para>
-
-<para> You can't have an implicit parameter in the context of a class or instance
-declaration.  For example, both these declarations are illegal:
-<programlisting>
-  class (?x::Int) => C a where ...
-  instance (?x::a) => Foo [a] where ...
-</programlisting>
-Reason: exactly which implicit parameter you pick up depends on exactly where
-you invoke a function. But the ``invocation'' of instance declarations is done
-behind the scenes by the compiler, so it's hard to figure out exactly where it is done.
-Easiest thing is to outlaw the offending types.</para>
-<para>
-Implicit-parameter constraints do not cause ambiguity.  For example, consider:
-<programlisting>
-   f :: (?x :: [a]) => Int -> Int
-   f n = n + length ?x
-
-   g :: (Read a, Show a) => String -> String
-   g s = show (read s)
-</programlisting>
-Here, <literal>g</literal> has an ambiguous type, and is rejected, but <literal>f</literal>
-is fine.  The binding for <literal>?x</literal> at <literal>f</literal>'s call site is 
-quite unambiguous, and fixes the type <literal>a</literal>.
-</para>
-</sect3>
-
-<sect3>
-<title>Implicit-parameter bindings</title>
-
-<para>
-An implicit parameter is <emphasis>bound</emphasis> using the standard
-<literal>let</literal> or <literal>where</literal> binding forms.
-For example, we define the <literal>min</literal> function by binding
-<literal>cmp</literal>.
-<programlisting>
-  min :: [a] -> a
-  min  = let ?cmp = (&lt;=) in least
-</programlisting>
-</para>
-<para>
-A group of implicit-parameter bindings may occur anywhere a normal group of Haskell
-bindings can occur, except at top level.  That is, they can occur in a <literal>let</literal> 
-(including in a list comprehension, or do-notation, or pattern guards), 
-or a <literal>where</literal> clause.
-Note the following points:
-<itemizedlist>
-<listitem><para>
-An implicit-parameter binding group must be a
-collection of simple bindings to implicit-style variables (no
-function-style bindings, and no type signatures); these bindings are
-neither polymorphic or recursive.  
-</para></listitem>
-<listitem><para>
-You may not mix implicit-parameter bindings with ordinary bindings in a 
-single <literal>let</literal>
-expression; use two nested <literal>let</literal>s instead.
-(In the case of <literal>where</literal> you are stuck, since you can't nest <literal>where</literal> clauses.)
-</para></listitem>
-
-<listitem><para>
-You may put multiple implicit-parameter bindings in a
-single binding group; but they are <emphasis>not</emphasis> treated
-as a mutually recursive group (as ordinary <literal>let</literal> bindings are).
-Instead they are treated as a non-recursive group, simultaneously binding all the implicit
-parameter.  The bindings are not nested, and may be re-ordered without changing
-the meaning of the program.
-For example, consider:
-<programlisting>
-  f t = let { ?x = t; ?y = ?x+(1::Int) } in ?x + ?y
-</programlisting>
-The use of <literal>?x</literal> in the binding for <literal>?y</literal> does not "see"
-the binding for <literal>?x</literal>, so the type of <literal>f</literal> is
-<programlisting>
-  f :: (?x::Int) => Int -> Int
-</programlisting>
-</para></listitem>
-</itemizedlist>
-</para>
-
-</sect3>
-
-<sect3><title>Implicit parameters and polymorphic recursion</title>
-
-<para>
-Consider these two definitions:
-<programlisting>
-  len1 :: [a] -> Int
-  len1 xs = let ?acc = 0 in len_acc1 xs
-
-  len_acc1 [] = ?acc
-  len_acc1 (x:xs) = let ?acc = ?acc + (1::Int) in len_acc1 xs
-
-  ------------
-
-  len2 :: [a] -> Int
-  len2 xs = let ?acc = 0 in len_acc2 xs
-
-  len_acc2 :: (?acc :: Int) => [a] -> Int
-  len_acc2 [] = ?acc
-  len_acc2 (x:xs) = let ?acc = ?acc + (1::Int) in len_acc2 xs
-</programlisting>
-The only difference between the two groups is that in the second group
-<literal>len_acc</literal> is given a type signature.
-In the former case, <literal>len_acc1</literal> is monomorphic in its own
-right-hand side, so the implicit parameter <literal>?acc</literal> is not
-passed to the recursive call.  In the latter case, because <literal>len_acc2</literal>
-has a type signature, the recursive call is made to the
-<emphasis>polymoprhic</emphasis> version, which takes <literal>?acc</literal>
-as an implicit parameter.  So we get the following results in GHCi:
-<programlisting>
-  Prog> len1 "hello"
-  0
-  Prog> len2 "hello"
-  5
-</programlisting>
-Adding a type signature dramatically changes the result!  This is a rather
-counter-intuitive phenomenon, worth watching out for.
-</para>
-</sect3>
-
-<sect3><title>Implicit parameters and monomorphism</title>
-
-<para>GHC applies the dreaded Monomorphism Restriction (section 4.5.5 of the
-Haskell Report) to implicit parameters.  For example, consider:
-<programlisting>
- f :: Int -> Int
-  f v = let ?x = 0     in
-        let y = ?x + v in
-        let ?x = 5     in
-        y
-</programlisting>
-Since the binding for <literal>y</literal> falls under the Monomorphism
-Restriction it is not generalised, so the type of <literal>y</literal> is
-simply <literal>Int</literal>, not <literal>(?x::Int) => Int</literal>.
-Hence, <literal>(f 9)</literal> returns result <literal>9</literal>.
-If you add a type signature for <literal>y</literal>, then <literal>y</literal>
-will get type <literal>(?x::Int) => Int</literal>, so the occurrence of
-<literal>y</literal> in the body of the <literal>let</literal> will see the
-inner binding of <literal>?x</literal>, so <literal>(f 9)</literal> will return
-<literal>14</literal>.
-</para>
-</sect3>
-</sect2>
-
-<sect2 id="linear-implicit-parameters">
-<title>Linear implicit parameters</title>
-<para>
-Linear implicit parameters are an idea developed by Koen Claessen,
-Mark Shields, and Simon PJ.  They address the long-standing
-problem that monads seem over-kill for certain sorts of problem, notably:
-</para>
-<itemizedlist>
-<listitem> <para> distributing a supply of unique names </para> </listitem>
-<listitem> <para> distributing a supply of random numbers </para> </listitem>
-<listitem> <para> distributing an oracle (as in QuickCheck) </para> </listitem>
-</itemizedlist>
-
-<para>
-Linear implicit parameters are just like ordinary implicit parameters,
-except that they are "linear" -- that is, they cannot be copied, and
-must be explicitly "split" instead.  Linear implicit parameters are
-written '<literal>%x</literal>' instead of '<literal>?x</literal>'.  
-(The '/' in the '%' suggests the split!)
-</para>
-<para>
-For example:
-<programlisting>
-    import GHC.Exts( Splittable )
-
-    data NameSupply = ...
-    
-    splitNS :: NameSupply -> (NameSupply, NameSupply)
-    newName :: NameSupply -> Name
-
-    instance Splittable NameSupply where
-	split = splitNS
-
-
-    f :: (%ns :: NameSupply) => Env -> Expr -> Expr
-    f env (Lam x e) = Lam x' (f env e)
-		    where
-		      x'   = newName %ns
-		      env' = extend env x x'
-    ...more equations for f...
-</programlisting>
-Notice that the implicit parameter %ns is consumed 
-<itemizedlist>
-<listitem> <para> once by the call to <literal>newName</literal> </para> </listitem>
-<listitem> <para> once by the recursive call to <literal>f</literal> </para></listitem>
-</itemizedlist>
-</para>
-<para>
-So the translation done by the type checker makes
-the parameter explicit:
-<programlisting>
-    f :: NameSupply -> Env -> Expr -> Expr
-    f ns env (Lam x e) = Lam x' (f ns1 env e)
-		       where
-	 		 (ns1,ns2) = splitNS ns
-			 x' = newName ns2
-			 env = extend env x x'
-</programlisting>
-Notice the call to 'split' introduced by the type checker.
-How did it know to use 'splitNS'?  Because what it really did
-was to introduce a call to the overloaded function 'split',
-defined by the class <literal>Splittable</literal>:
-<programlisting>
-	class Splittable a where
-	  split :: a -> (a,a)
-</programlisting>
-The instance for <literal>Splittable NameSupply</literal> tells GHC how to implement
-split for name supplies.  But we can simply write
-<programlisting>
-	g x = (x, %ns, %ns)
-</programlisting>
-and GHC will infer
-<programlisting>
-	g :: (Splittable a, %ns :: a) => b -> (b,a,a)
-</programlisting>
-The <literal>Splittable</literal> class is built into GHC.  It's exported by module 
-<literal>GHC.Exts</literal>.
-</para>
-<para>
-Other points:
-<itemizedlist>
-<listitem> <para> '<literal>?x</literal>' and '<literal>%x</literal>' 
-are entirely distinct implicit parameters: you 
-  can use them together and they won't intefere with each other. </para>
-</listitem>
-
-<listitem> <para> You can bind linear implicit parameters in 'with' clauses. </para> </listitem>
-
-<listitem> <para>You cannot have implicit parameters (whether linear or not)
-  in the context of a class or instance declaration. </para></listitem>
-</itemizedlist>
-</para>
-
-<sect3><title>Warnings</title>
-
-<para>
-The monomorphism restriction is even more important than usual.
-Consider the example above:
-<programlisting>
-    f :: (%ns :: NameSupply) => Env -> Expr -> Expr
-    f env (Lam x e) = Lam x' (f env e)
-		    where
-		      x'   = newName %ns
-		      env' = extend env x x'
-</programlisting>
-If we replaced the two occurrences of x' by (newName %ns), which is
-usually a harmless thing to do, we get:
-<programlisting>
-    f :: (%ns :: NameSupply) => Env -> Expr -> Expr
-    f env (Lam x e) = Lam (newName %ns) (f env e)
-		    where
-		      env' = extend env x (newName %ns)
-</programlisting>
-But now the name supply is consumed in <emphasis>three</emphasis> places
-(the two calls to newName,and the recursive call to f), so
-the result is utterly different.  Urk!  We don't even have 
-the beta rule.
-</para>
-<para>
-Well, this is an experimental change.  With implicit
-parameters we have already lost beta reduction anyway, and
-(as John Launchbury puts it) we can't sensibly reason about
-Haskell programs without knowing their typing.
-</para>
-
-</sect3>
-
-<sect3><title>Recursive functions</title>
-<para>Linear implicit parameters can be particularly tricky when you have a recursive function
-Consider
-<programlisting>
-        foo :: %x::T => Int -> [Int]
-        foo 0 = []
-        foo n = %x : foo (n-1)
-</programlisting>
-where T is some type in class Splittable.</para>
-<para>
-Do you get a list of all the same T's or all different T's
-(assuming that split gives two distinct T's back)?
-</para><para>
-If you supply the type signature, taking advantage of polymorphic
-recursion, you get what you'd probably expect.  Here's the
-translated term, where the implicit param is made explicit:
-<programlisting>
-        foo x 0 = []
-        foo x n = let (x1,x2) = split x
-                  in x1 : foo x2 (n-1)
-</programlisting>
-But if you don't supply a type signature, GHC uses the Hindley
-Milner trick of using a single monomorphic instance of the function
-for the recursive calls. That is what makes Hindley Milner type inference
-work.  So the translation becomes
-<programlisting>
-        foo x = let
-                  foom 0 = []
-                  foom n = x : foom (n-1)
-                in
-                foom
-</programlisting>
-Result: 'x' is not split, and you get a list of identical T's.  So the
-semantics of the program depends on whether or not foo has a type signature.
-Yikes!
-</para><para>
-You may say that this is a good reason to dislike linear implicit parameters
-and you'd be right.  That is why they are an experimental feature. 
-</para>
-</sect3>
-
-</sect2>
-
-<sect2 id="sec-kinding">
-<title>Explicitly-kinded quantification</title>
-
-<para>
-Haskell infers the kind of each type variable.  Sometimes it is nice to be able
-to give the kind explicitly as (machine-checked) documentation, 
-just as it is nice to give a type signature for a function.  On some occasions,
-it is essential to do so.  For example, in his paper "Restricted Data Types in Haskell" (Haskell Workshop 1999)
-John Hughes had to define the data type:
-<screen>
-     data Set cxt a = Set [a]
-                    | Unused (cxt a -> ())
-</screen>
-The only use for the <literal>Unused</literal> constructor was to force the correct
-kind for the type variable <literal>cxt</literal>.
-</para>
-<para>
-GHC now instead allows you to specify the kind of a type variable directly, wherever
-a type variable is explicitly bound.  Namely:
-<itemizedlist>
-<listitem><para><literal>data</literal> declarations:
-<screen>
-  data Set (cxt :: * -> *) a = Set [a]
-</screen></para></listitem>
-<listitem><para><literal>type</literal> declarations:
-<screen>
-  type T (f :: * -> *) = f Int
-</screen></para></listitem>
-<listitem><para><literal>class</literal> declarations:
-<screen>
-  class (Eq a) => C (f :: * -> *) a where ...
-</screen></para></listitem>
-<listitem><para><literal>forall</literal>'s in type signatures:
-<screen>
-  f :: forall (cxt :: * -> *). Set cxt Int
-</screen></para></listitem>
-</itemizedlist>
-</para>
-
-<para>
-The parentheses are required.  Some of the spaces are required too, to
-separate the lexemes.  If you write <literal>(f::*->*)</literal> you
-will get a parse error, because "<literal>::*->*</literal>" is a
-single lexeme in Haskell.
-</para>
-
-<para>
-As part of the same extension, you can put kind annotations in types
-as well.  Thus:
-<screen>
-   f :: (Int :: *) -> Int
-   g :: forall a. a -> (a :: *)
-</screen>
-The syntax is
-<screen>
-   atype ::= '(' ctype '::' kind ')
-</screen>
-The parentheses are required.
-</para>
-</sect2>
-
-
-<sect2 id="universal-quantification">
-<title>Arbitrary-rank polymorphism
-</title>
-
-<para>
-Haskell type signatures are implicitly quantified.  The new keyword <literal>forall</literal>
-allows us to say exactly what this means.  For example:
-</para>
-<para>
-<programlisting>
-        g :: b -> b
-</programlisting>
-means this:
-<programlisting>
-        g :: forall b. (b -> b)
-</programlisting>
-The two are treated identically.
-</para>
-
-<para>
-However, GHC's type system supports <emphasis>arbitrary-rank</emphasis> 
-explicit universal quantification in
-types. 
-For example, all the following types are legal:
-<programlisting>
-    f1 :: forall a b. a -> b -> a
-    g1 :: forall a b. (Ord a, Eq  b) => a -> b -> a
-
-    f2 :: (forall a. a->a) -> Int -> Int
-    g2 :: (forall a. Eq a => [a] -> a -> Bool) -> Int -> Int
-
-    f3 :: ((forall a. a->a) -> Int) -> Bool -> Bool
-</programlisting>
-Here, <literal>f1</literal> and <literal>g1</literal> are rank-1 types, and
-can be written in standard Haskell (e.g. <literal>f1 :: a->b->a</literal>).
-The <literal>forall</literal> makes explicit the universal quantification that
-is implicitly added by Haskell.
-</para>
-<para>
-The functions <literal>f2</literal> and <literal>g2</literal> have rank-2 types;
-the <literal>forall</literal> is on the left of a function arrow.  As <literal>g2</literal>
-shows, the polymorphic type on the left of the function arrow can be overloaded.
-</para>
-<para>
-The function <literal>f3</literal> has a rank-3 type;
-it has rank-2 types on the left of a function arrow.
-</para>
-<para>
-GHC allows types of arbitrary rank; you can nest <literal>forall</literal>s
-arbitrarily deep in function arrows.   (GHC used to be restricted to rank 2, but
-that restriction has now been lifted.)
-In particular, a forall-type (also called a "type scheme"),
-including an operational type class context, is legal:
-<itemizedlist>
-<listitem> <para> On the left of a function arrow </para> </listitem>
-<listitem> <para> On the right of a function arrow (see <xref linkend="hoist"/>) </para> </listitem>
-<listitem> <para> As the argument of a constructor, or type of a field, in a data type declaration. For
-example, any of the <literal>f1,f2,f3,g1,g2</literal> above would be valid
-field type signatures.</para> </listitem>
-<listitem> <para> As the type of an implicit parameter </para> </listitem>
-<listitem> <para> In a pattern type signature (see <xref linkend="scoped-type-variables"/>) </para> </listitem>
-</itemizedlist>
-There is one place you cannot put a <literal>forall</literal>:
-you cannot instantiate a type variable with a forall-type.  So you cannot 
-make a forall-type the argument of a type constructor.  So these types are illegal:
-<programlisting>
-    x1 :: [forall a. a->a]
-    x2 :: (forall a. a->a, Int)
-    x3 :: Maybe (forall a. a->a)
-</programlisting>
-Of course <literal>forall</literal> becomes a keyword; you can't use <literal>forall</literal> as
-a type variable any more!
-</para>
-
-
-<sect3 id="univ">
-<title>Examples
-</title>
-
-<para>
-In a <literal>data</literal> or <literal>newtype</literal> declaration one can quantify
-the types of the constructor arguments.  Here are several examples:
-</para>
-
-<para>
-
-<programlisting>
-data T a = T1 (forall b. b -> b -> b) a
-
-data MonadT m = MkMonad { return :: forall a. a -> m a,
-                          bind   :: forall a b. m a -> (a -> m b) -> m b
-                        }
-
-newtype Swizzle = MkSwizzle (Ord a => [a] -> [a])
-</programlisting>
-
-</para>
-
-<para>
-The constructors have rank-2 types:
-</para>
-
-<para>
-
-<programlisting>
-T1 :: forall a. (forall b. b -> b -> b) -> a -> T a
-MkMonad :: forall m. (forall a. a -> m a)
-                  -> (forall a b. m a -> (a -> m b) -> m b)
-                  -> MonadT m
-MkSwizzle :: (Ord a => [a] -> [a]) -> Swizzle
-</programlisting>
-
-</para>
-
-<para>
-Notice that you don't need to use a <literal>forall</literal> if there's an
-explicit context.  For example in the first argument of the
-constructor <function>MkSwizzle</function>, an implicit "<literal>forall a.</literal>" is
-prefixed to the argument type.  The implicit <literal>forall</literal>
-quantifies all type variables that are not already in scope, and are
-mentioned in the type quantified over.
-</para>
-
-<para>
-As for type signatures, implicit quantification happens for non-overloaded
-types too.  So if you write this:
-
-<programlisting>
-  data T a = MkT (Either a b) (b -> b)
-</programlisting>
-
-it's just as if you had written this:
-
-<programlisting>
-  data T a = MkT (forall b. Either a b) (forall b. b -> b)
-</programlisting>
-
-That is, since the type variable <literal>b</literal> isn't in scope, it's
-implicitly universally quantified.  (Arguably, it would be better
-to <emphasis>require</emphasis> explicit quantification on constructor arguments
-where that is what is wanted.  Feedback welcomed.)
-</para>
-
-<para>
-You construct values of types <literal>T1, MonadT, Swizzle</literal> by applying
-the constructor to suitable values, just as usual.  For example,
-</para>
-
-<para>
-
-<programlisting>
-    a1 :: T Int
-    a1 = T1 (\xy->x) 3
-    
-    a2, a3 :: Swizzle
-    a2 = MkSwizzle sort
-    a3 = MkSwizzle reverse
-    
-    a4 :: MonadT Maybe
-    a4 = let r x = Just x
-	     b m k = case m of
-		       Just y -> k y
-		       Nothing -> Nothing
-         in
-         MkMonad r b
-
-    mkTs :: (forall b. b -> b -> b) -> a -> [T a]
-    mkTs f x y = [T1 f x, T1 f y]
-</programlisting>
-
-</para>
-
-<para>
-The type of the argument can, as usual, be more general than the type
-required, as <literal>(MkSwizzle reverse)</literal> shows.  (<function>reverse</function>
-does not need the <literal>Ord</literal> constraint.)
-</para>
-
-<para>
-When you use pattern matching, the bound variables may now have
-polymorphic types.  For example:
-</para>
-
-<para>
-
-<programlisting>
-    f :: T a -> a -> (a, Char)
-    f (T1 w k) x = (w k x, w 'c' 'd')
-
-    g :: (Ord a, Ord b) => Swizzle -> [a] -> (a -> b) -> [b]
-    g (MkSwizzle s) xs f = s (map f (s xs))
-
-    h :: MonadT m -> [m a] -> m [a]
-    h m [] = return m []
-    h m (x:xs) = bind m x          $ \y ->
-                 bind m (h m xs)   $ \ys ->
-                 return m (y:ys)
-</programlisting>
-
-</para>
-
-<para>
-In the function <function>h</function> we use the record selectors <literal>return</literal>
-and <literal>bind</literal> to extract the polymorphic bind and return functions
-from the <literal>MonadT</literal> data structure, rather than using pattern
-matching.
-</para>
-</sect3>
-
-<sect3>
-<title>Type inference</title>
-
-<para>
-In general, type inference for arbitrary-rank types is undecidable.
-GHC uses an algorithm proposed by Odersky and Laufer ("Putting type annotations to work", POPL'96)
-to get a decidable algorithm by requiring some help from the programmer.
-We do not yet have a formal specification of "some help" but the rule is this:
-</para>
-<para>
-<emphasis>For a lambda-bound or case-bound variable, x, either the programmer
-provides an explicit polymorphic type for x, or GHC's type inference will assume
-that x's type has no foralls in it</emphasis>.
-</para>
-<para>
-What does it mean to "provide" an explicit type for x?  You can do that by 
-giving a type signature for x directly, using a pattern type signature
-(<xref linkend="scoped-type-variables"/>), thus:
-<programlisting>
-     \ f :: (forall a. a->a) -> (f True, f 'c')
-</programlisting>
-Alternatively, you can give a type signature to the enclosing
-context, which GHC can "push down" to find the type for the variable:
-<programlisting>
-     (\ f -> (f True, f 'c')) :: (forall a. a->a) -> (Bool,Char)
-</programlisting>
-Here the type signature on the expression can be pushed inwards
-to give a type signature for f.  Similarly, and more commonly,
-one can give a type signature for the function itself:
-<programlisting>
-     h :: (forall a. a->a) -> (Bool,Char)
-     h f = (f True, f 'c')
-</programlisting>
-You don't need to give a type signature if the lambda bound variable
-is a constructor argument.  Here is an example we saw earlier:
-<programlisting>
-    f :: T a -> a -> (a, Char)
-    f (T1 w k) x = (w k x, w 'c' 'd')
-</programlisting>
-Here we do not need to give a type signature to <literal>w</literal>, because
-it is an argument of constructor <literal>T1</literal> and that tells GHC all
-it needs to know.
-</para>
-
-</sect3>
-
-
-<sect3 id="implicit-quant">
-<title>Implicit quantification</title>
-
-<para>
-GHC performs implicit quantification as follows.  <emphasis>At the top level (only) of 
-user-written types, if and only if there is no explicit <literal>forall</literal>,
-GHC finds all the type variables mentioned in the type that are not already
-in scope, and universally quantifies them.</emphasis>  For example, the following pairs are 
-equivalent:
-<programlisting>
-  f :: a -> a
-  f :: forall a. a -> a
-
-  g (x::a) = let
-                h :: a -> b -> b
-                h x y = y
-             in ...
-  g (x::a) = let
-                h :: forall b. a -> b -> b
-                h x y = y
-             in ...
-</programlisting>
-</para>
-<para>
-Notice that GHC does <emphasis>not</emphasis> find the innermost possible quantification
-point.  For example:
-<programlisting>
-  f :: (a -> a) -> Int
-           -- MEANS
-  f :: forall a. (a -> a) -> Int
-           -- NOT
-  f :: (forall a. a -> a) -> Int
-
-
-  g :: (Ord a => a -> a) -> Int
-           -- MEANS the illegal type
-  g :: forall a. (Ord a => a -> a) -> Int
-           -- NOT
-  g :: (forall a. Ord a => a -> a) -> Int
-</programlisting>
-The latter produces an illegal type, which you might think is silly,
-but at least the rule is simple.  If you want the latter type, you
-can write your for-alls explicitly.  Indeed, doing so is strongly advised
-for rank-2 types.
-</para>
-</sect3>
-</sect2>
-
-
-
-
-<sect2 id="scoped-type-variables">
-<title>Scoped type variables
-</title>
-
-<para>
-A <emphasis>lexically scoped type variable</emphasis> can be bound by:
-<itemizedlist>
-<listitem><para>A declaration type signature (<xref linkend="decl-type-sigs"/>)</para></listitem>
-<listitem><para>A pattern type signature (<xref linkend="pattern-type-sigs"/>)</para></listitem>
-<listitem><para>A result type signature (<xref linkend="result-type-sigs"/>)</para></listitem>
-</itemizedlist>
-For example:
-<programlisting>
-f (xs::[a]) = ys ++ ys
-           where
-              ys :: [a]
-              ys = reverse xs
-</programlisting>
-The pattern <literal>(xs::[a])</literal> includes a type signature for <varname>xs</varname>.
-This brings the type variable <literal>a</literal> into scope; it scopes over
-all the patterns and right hand sides for this equation for <function>f</function>.
-In particular, it is in scope at the type signature for <varname>y</varname>.
-</para>
-
-<para>
-At ordinary type signatures, such as that for <varname>ys</varname>, any type variables
-mentioned in the type signature <emphasis>that are not in scope</emphasis> are
-implicitly universally quantified.  (If there are no type variables in
-scope, all type variables mentioned in the signature are universally
-quantified, which is just as in Haskell 98.)  In this case, since <varname>a</varname>
-is in scope, it is not universally quantified, so the type of <varname>ys</varname> is
-the same as that of <varname>xs</varname>.  In Haskell 98 it is not possible to declare
-a type for <varname>ys</varname>; a major benefit of scoped type variables is that
-it becomes possible to do so.
-</para>
-
-<para>
-Scoped type variables are implemented in both GHC and Hugs.  Where the
-implementations differ from the specification below, those differences
-are noted.
-</para>
-
-<para>
-So much for the basic idea.  Here are the details.
-</para>
-
-<sect3>
-<title>What a scoped type variable means</title>
-<para>
-A lexically-scoped type variable is simply
-the name for a type.   The restriction it expresses is that all occurrences
-of the same name mean the same type.  For example:
-<programlisting>
-  f :: [Int] -> Int -> Int
-  f (xs::[a]) (y::a) = (head xs + y) :: a
-</programlisting>
-The pattern type signatures on the left hand side of
-<literal>f</literal> express the fact that <literal>xs</literal>
-must be a list of things of some type <literal>a</literal>; and that <literal>y</literal>
-must have this same type.  The type signature on the expression <literal>(head xs)</literal>
-specifies that this expression must have the same type <literal>a</literal>.
-<emphasis>There is no requirement that the type named by "<literal>a</literal>" is
-in fact a type variable</emphasis>.  Indeed, in this case, the type named by "<literal>a</literal>" is
-<literal>Int</literal>.  (This is a slight liberalisation from the original rather complex
-rules, which specified that a pattern-bound type variable should be universally quantified.)
-For example, all of these are legal:</para>
-
-<programlisting>
-  t (x::a) (y::a) = x+y*2
-
-  f (x::a) (y::b) = [x,y]       -- a unifies with b
-
-  g (x::a) = x + 1::Int         -- a unifies with Int
-
-  h x = let k (y::a) = [x,y]    -- a is free in the
-        in k x                  -- environment
-
-  k (x::a) True    = ...        -- a unifies with Int
-  k (x::Int) False = ...
-
-  w :: [b] -> [b]
-  w (x::a) = x                  -- a unifies with [b]
-</programlisting>
-
-</sect3>
-
-<sect3>
-<title>Scope and implicit quantification</title>
-
-<para>
-
-<itemizedlist>
-<listitem>
-
-<para>
-All the type variables mentioned in a pattern,
-that are not already in scope,
-are brought into scope by the pattern.  We describe this set as
-the <emphasis>type variables bound by the pattern</emphasis>.
-For example:
-<programlisting>
-  f (x::a) = let g (y::(a,b)) = fst y
-             in
-             g (x,True)
-</programlisting>
-The pattern <literal>(x::a)</literal> brings the type variable
-<literal>a</literal> into scope, as well as the term 
-variable <literal>x</literal>.  The pattern <literal>(y::(a,b))</literal>
-contains an occurrence of the already-in-scope type variable <literal>a</literal>,
-and brings into scope the type variable <literal>b</literal>.
-</para>
-</listitem>
-
-<listitem>
-<para>
-The type variable(s) bound by the pattern have the same scope
-as the term variable(s) bound by the pattern.  For example:
-<programlisting>
-  let
-    f (x::a) = &lt;...rhs of f...>
-    (p::b, q::b) = (1,2)
-  in &lt;...body of let...>
-</programlisting>
-Here, the type variable <literal>a</literal> scopes over the right hand side of <literal>f</literal>,
-just like <literal>x</literal> does; while the type variable <literal>b</literal> scopes over the
-body of the <literal>let</literal>, and all the other definitions in the <literal>let</literal>,
-just like <literal>p</literal> and <literal>q</literal> do.
-Indeed, the newly bound type variables also scope over any ordinary, separate
-type signatures in the <literal>let</literal> group.
-</para>
-</listitem>
-
-
-<listitem>
-<para>
-The type variables bound by the pattern may be 
-mentioned in ordinary type signatures or pattern 
-type signatures anywhere within their scope.
-
-</para>
-</listitem>
-
-<listitem>
-<para>
- In ordinary type signatures, any type variable mentioned in the
-signature that is in scope is <emphasis>not</emphasis> universally quantified.
-
-</para>
-</listitem>
-
-<listitem>
-
-<para>
- Ordinary type signatures do not bring any new type variables
-into scope (except in the type signature itself!). So this is illegal:
-
-<programlisting>
-  f :: a -> a
-  f x = x::a
-</programlisting>
-
-It's illegal because <varname>a</varname> is not in scope in the body of <function>f</function>,
-so the ordinary signature <literal>x::a</literal> is equivalent to <literal>x::forall a.a</literal>;
-and that is an incorrect typing.
-
-</para>
-</listitem>
-
-<listitem>
-<para>
-The pattern type signature is a monotype:
-</para>
-
-<itemizedlist>
-<listitem> <para> 
-A pattern type signature cannot contain any explicit <literal>forall</literal> quantification.
-</para> </listitem>
-
-<listitem>  <para> 
-The type variables bound by a pattern type signature can only be instantiated to monotypes,
-not to type schemes.
-</para> </listitem>
-
-<listitem>  <para> 
-There is no implicit universal quantification on pattern type signatures (in contrast to
-ordinary type signatures).
-</para> </listitem>
-
-</itemizedlist>
-
-</listitem>
-
-<listitem>
-<para>
-
-The type variables in the head of a <literal>class</literal> or <literal>instance</literal> declaration
-scope over the methods defined in the <literal>where</literal> part.  For example:
-
-
-<programlisting>
-  class C a where
-    op :: [a] -> a
-
-    op xs = let ys::[a]
-                ys = reverse xs
-            in
-            head ys
-</programlisting>
-
-
-(Not implemented in Hugs yet, Dec 98).
-</para>
-</listitem>
-
-</itemizedlist>
-
-</para>
-
-</sect3>
-
-<sect3 id="decl-type-sigs">
-<title>Declaration type signatures</title>
-<para>A declaration type signature that has <emphasis>explicit</emphasis>
-quantification (using <literal>forall</literal>) brings into scope the
-explicitly-quantified
-type variables, in the definition of the named function(s).  For example:
-<programlisting>
-  f :: forall a. [a] -> [a]
-  f (x:xs) = xs ++ [ x :: a ]
-</programlisting>
-The "<literal>forall a</literal>" brings "<literal>a</literal>" into scope in
-the definition of "<literal>f</literal>".
-</para>
-<para>This only happens if the quantification in <literal>f</literal>'s type
-signature is explicit.  For example:
-<programlisting>
-  g :: [a] -> [a]
-  g (x:xs) = xs ++ [ x :: a ]
-</programlisting>
-This program will be rejected, because "<literal>a</literal>" does not scope
-over the definition of "<literal>f</literal>", so "<literal>x::a</literal>"
-means "<literal>x::forall a. a</literal>" by Haskell's usual implicit
-quantification rules.
-</para>
-</sect3>
-
-<sect3 id="pattern-type-sigs">
-<title>Where a pattern type signature can occur</title>
-
-<para>
-A pattern type signature can occur in any pattern.  For example:
-<itemizedlist>
-
-<listitem>
-<para>
-A pattern type signature can be on an arbitrary sub-pattern, not
-just on a variable:
-
-
-<programlisting>
-  f ((x,y)::(a,b)) = (y,x) :: (b,a)
-</programlisting>
-
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- Pattern type signatures, including the result part, can be used
-in lambda abstractions:
-
-<programlisting>
-  (\ (x::a, y) :: a -> x)
-</programlisting>
-</para>
-</listitem>
-<listitem>
-
-<para>
- Pattern type signatures, including the result part, can be used
-in <literal>case</literal> expressions:
-
-<programlisting>
-  case e of { ((x::a, y) :: (a,b)) -> x }
-</programlisting>
-
-Note that the <literal>-&gt;</literal> symbol in a case alternative
-leads to difficulties when parsing a type signature in the pattern: in
-the absence of the extra parentheses in the example above, the parser
-would try to interpret the <literal>-&gt;</literal> as a function
-arrow and give a parse error later.
-
-</para>
-
-</listitem>
-
-<listitem>
-<para>
-To avoid ambiguity, the type after the &ldquo;<literal>::</literal>&rdquo; in a result
-pattern signature on a lambda or <literal>case</literal> must be atomic (i.e. a single
-token or a parenthesised type of some sort).  To see why,
-consider how one would parse this:
-
-
-<programlisting>
-  \ x :: a -> b -> x
-</programlisting>
-
-
-</para>
-</listitem>
-
-<listitem>
-
-<para>
- Pattern type signatures can bind existential type variables.
-For example:
-
-
-<programlisting>
-  data T = forall a. MkT [a]
-
-  f :: T -> T
-  f (MkT [t::a]) = MkT t3
-                 where
-                   t3::[a] = [t,t,t]
-</programlisting>
-
-
-</para>
-</listitem>
-
-
-<listitem>
-
-<para>
-Pattern type signatures 
-can be used in pattern bindings:
-
-<programlisting>
-  f x = let (y, z::a) = x in ...
-  f1 x                = let (y, z::Int) = x in ...
-  f2 (x::(Int,a))     = let (y, z::a)   = x in ...
-  f3 :: (b->b)        = \x -> x
-</programlisting>
-
-In all such cases, the binding is not generalised over the pattern-bound
-type variables.  Thus <literal>f3</literal> is monomorphic; <literal>f3</literal>
-has type <literal>b -&gt; b</literal> for some type <literal>b</literal>, 
-and <emphasis>not</emphasis> <literal>forall b. b -&gt; b</literal>.
-In contrast, the binding
-<programlisting>
-  f4 :: b->b
-  f4 = \x -> x
-</programlisting>
-makes a polymorphic function, but <literal>b</literal> is not in scope anywhere
-in <literal>f4</literal>'s scope.
-
-</para>
-</listitem>
-</itemizedlist>
-</para>
-<para>Pattern type signatures are completely orthogonal to ordinary, separate
-type signatures.  The two can be used independently or together.</para>
-
-</sect3>
-
-<sect3 id="result-type-sigs">
-<title>Result type signatures</title>
-
-<para>
-The result type of a function can be given a signature, thus:
-
-
-<programlisting>
-  f (x::a) :: [a] = [x,x,x]
-</programlisting>
-
-
-The final <literal>:: [a]</literal> after all the patterns gives a signature to the
-result type.  Sometimes this is the only way of naming the type variable
-you want:
-
-
-<programlisting>
-  f :: Int -> [a] -> [a]
-  f n :: ([a] -> [a]) = let g (x::a, y::a) = (y,x)
-                        in \xs -> map g (reverse xs `zip` xs)
-</programlisting>
-
-</para>
-<para>
-The type variables bound in a result type signature scope over the right hand side
-of the definition. However, consider this corner-case:
-<programlisting>
-  rev1 :: [a] -> [a] = \xs -> reverse xs
-
-  foo ys = rev (ys::[a])
-</programlisting>
-The signature on <literal>rev1</literal> is considered a pattern type signature, not a result
-type signature, and the type variables it binds have the same scope as <literal>rev1</literal>
-itself (i.e. the right-hand side of <literal>rev1</literal> and the rest of the module too).
-In particular, the expression <literal>(ys::[a])</literal> is OK, because the type variable <literal>a</literal>
-is in scope (otherwise it would mean <literal>(ys::forall a.[a])</literal>, which would be rejected).  
-</para>
-<para>
-As mentioned above, <literal>rev1</literal> is made monomorphic by this scoping rule.
-For example, the following program would be rejected, because it claims that <literal>rev1</literal>
-is polymorphic:
-<programlisting>
-  rev1 :: [b] -> [b]
-  rev1 :: [a] -> [a] = \xs -> reverse xs
-</programlisting>
-</para>
-
-<para>
-Result type signatures are not yet implemented in Hugs.
-</para>
-
-</sect3>
-
-</sect2>
-
-<sect2 id="deriving-typeable">
-<title>Deriving clause for classes <literal>Typeable</literal> and <literal>Data</literal></title>
-
-<para>
-Haskell 98 allows the programmer to add "<literal>deriving( Eq, Ord )</literal>" to a data type 
-declaration, to generate a standard instance declaration for classes specified in the <literal>deriving</literal> clause.  
-In Haskell 98, the only classes that may appear in the <literal>deriving</literal> clause are the standard
-classes <literal>Eq</literal>, <literal>Ord</literal>, 
-<literal>Enum</literal>, <literal>Ix</literal>, <literal>Bounded</literal>, <literal>Read</literal>, and <literal>Show</literal>.
-</para>
-<para>
-GHC extends this list with two more classes that may be automatically derived 
-(provided the <option>-fglasgow-exts</option> flag is specified):
-<literal>Typeable</literal>, and <literal>Data</literal>.  These classes are defined in the library
-modules <literal>Data.Typeable</literal> and <literal>Data.Generics</literal> respectively, and the
-appropriate class must be in scope before it can be mentioned in the <literal>deriving</literal> clause.
-</para>
-<para>An instance of <literal>Typeable</literal> can only be derived if the
-data type has seven or fewer type parameters, all of kind <literal>*</literal>.
-The reason for this is that the <literal>Typeable</literal> class is derived using the scheme
-described in
-<ulink url="http://research.microsoft.com/%7Esimonpj/papers/hmap/gmap2.ps">
-Scrap More Boilerplate: Reflection, Zips, and Generalised Casts
-</ulink>.
-(Section 7.4 of the paper describes the multiple <literal>Typeable</literal> classes that
-are used, and only <literal>Typeable1</literal> up to
-<literal>Typeable7</literal> are provided in the library.)
-In other cases, there is nothing to stop the programmer writing a <literal>TypableX</literal>
-class, whose kind suits that of the data type constructor, and
-then writing the data type instance by hand.
-</para>
-</sect2>
-
-<sect2 id="newtype-deriving">
-<title>Generalised derived instances for newtypes</title>
-
-<para>
-When you define an abstract type using <literal>newtype</literal>, you may want
-the new type to inherit some instances from its representation. In
-Haskell 98, you can inherit instances of <literal>Eq</literal>, <literal>Ord</literal>,
-<literal>Enum</literal> and <literal>Bounded</literal> by deriving them, but for any
-other classes you have to write an explicit instance declaration. For
-example, if you define
-
-<programlisting> 
-  newtype Dollars = Dollars Int 
-</programlisting> 
-
-and you want to use arithmetic on <literal>Dollars</literal>, you have to
-explicitly define an instance of <literal>Num</literal>:
-
-<programlisting> 
-  instance Num Dollars where
-    Dollars a + Dollars b = Dollars (a+b)
-    ...
-</programlisting>
-All the instance does is apply and remove the <literal>newtype</literal>
-constructor. It is particularly galling that, since the constructor
-doesn't appear at run-time, this instance declaration defines a
-dictionary which is <emphasis>wholly equivalent</emphasis> to the <literal>Int</literal>
-dictionary, only slower!
-</para>
-
-
-<sect3> <title> Generalising the deriving clause </title>
-<para>
-GHC now permits such instances to be derived instead, so one can write 
-<programlisting> 
-  newtype Dollars = Dollars Int deriving (Eq,Show,Num)
-</programlisting> 
-
-and the implementation uses the <emphasis>same</emphasis> <literal>Num</literal> dictionary
-for <literal>Dollars</literal> as for <literal>Int</literal>. Notionally, the compiler
-derives an instance declaration of the form
-
-<programlisting> 
-  instance Num Int => Num Dollars
-</programlisting> 
-
-which just adds or removes the <literal>newtype</literal> constructor according to the type.
-</para>
-<para>
-
-We can also derive instances of constructor classes in a similar
-way. For example, suppose we have implemented state and failure monad
-transformers, such that
-
-<programlisting> 
-  instance Monad m => Monad (State s m) 
-  instance Monad m => Monad (Failure m)
-</programlisting> 
-In Haskell 98, we can define a parsing monad by 
-<programlisting> 
-  type Parser tok m a = State [tok] (Failure m) a
-</programlisting> 
-
-which is automatically a monad thanks to the instance declarations
-above. With the extension, we can make the parser type abstract,
-without needing to write an instance of class <literal>Monad</literal>, via
-
-<programlisting> 
-  newtype Parser tok m a = Parser (State [tok] (Failure m) a)
-                         deriving Monad
-</programlisting>
-In this case the derived instance declaration is of the form 
-<programlisting> 
-  instance Monad (State [tok] (Failure m)) => Monad (Parser tok m) 
-</programlisting> 
-
-Notice that, since <literal>Monad</literal> is a constructor class, the
-instance is a <emphasis>partial application</emphasis> of the new type, not the
-entire left hand side. We can imagine that the type declaration is
-``eta-converted'' to generate the context of the instance
-declaration.
-</para>
-<para>
-
-We can even derive instances of multi-parameter classes, provided the
-newtype is the last class parameter. In this case, a ``partial
-application'' of the class appears in the <literal>deriving</literal>
-clause. For example, given the class
-
-<programlisting> 
-  class StateMonad s m | m -> s where ... 
-  instance Monad m => StateMonad s (State s m) where ... 
-</programlisting> 
-then we can derive an instance of <literal>StateMonad</literal> for <literal>Parser</literal>s by 
-<programlisting> 
-  newtype Parser tok m a = Parser (State [tok] (Failure m) a)
-                         deriving (Monad, StateMonad [tok])
-</programlisting>
-
-The derived instance is obtained by completing the application of the
-class to the new type:
-
-<programlisting> 
-  instance StateMonad [tok] (State [tok] (Failure m)) =>
-           StateMonad [tok] (Parser tok m)
-</programlisting>
-</para>
-<para>
-
-As a result of this extension, all derived instances in newtype
- declarations are treated uniformly (and implemented just by reusing
-the dictionary for the representation type), <emphasis>except</emphasis>
-<literal>Show</literal> and <literal>Read</literal>, which really behave differently for
-the newtype and its representation.
-</para>
-</sect3>
-
-<sect3> <title> A more precise specification </title>
-<para>
-Derived instance declarations are constructed as follows. Consider the
-declaration (after expansion of any type synonyms)
-
-<programlisting> 
-  newtype T v1...vn = T' (S t1...tk vk+1...vn) deriving (c1...cm) 
-</programlisting> 
-
-where 
- <itemizedlist>
-<listitem><para>
-  <literal>S</literal> is a type constructor, 
-</para></listitem>
-<listitem><para>
-  The <literal>t1...tk</literal> are types,
-</para></listitem>
-<listitem><para>
-  The <literal>vk+1...vn</literal> are type variables which do not occur in any of
-  the <literal>ti</literal>, and
-</para></listitem>
-<listitem><para>
-  The <literal>ci</literal> are partial applications of
-  classes of the form <literal>C t1'...tj'</literal>, where the arity of <literal>C</literal>
-  is exactly <literal>j+1</literal>.  That is, <literal>C</literal> lacks exactly one type argument.
-</para></listitem>
-<listitem><para>
-  None of the <literal>ci</literal> is <literal>Read</literal>, <literal>Show</literal>, 
-		<literal>Typeable</literal>, or <literal>Data</literal>.  These classes
-		should not "look through" the type or its constructor.  You can still
-		derive these classes for a newtype, but it happens in the usual way, not 
-		via this new mechanism.  
-</para></listitem>
-</itemizedlist>
-Then, for each <literal>ci</literal>, the derived instance
-declaration is:
-<programlisting> 
-  instance ci (S t1...tk vk+1...v) => ci (T v1...vp)
-</programlisting>
-where <literal>p</literal> is chosen so that <literal>T v1...vp</literal> is of the 
-right <emphasis>kind</emphasis> for the last parameter of class <literal>Ci</literal>.
-</para>
-<para>
-
-As an example which does <emphasis>not</emphasis> work, consider 
-<programlisting> 
-  newtype NonMonad m s = NonMonad (State s m s) deriving Monad 
-</programlisting> 
-Here we cannot derive the instance 
-<programlisting> 
-  instance Monad (State s m) => Monad (NonMonad m) 
-</programlisting> 
-
-because the type variable <literal>s</literal> occurs in <literal>State s m</literal>,
-and so cannot be "eta-converted" away. It is a good thing that this
-<literal>deriving</literal> clause is rejected, because <literal>NonMonad m</literal> is
-not, in fact, a monad --- for the same reason. Try defining
-<literal>>>=</literal> with the correct type: you won't be able to.
-</para>
-<para>
-
-Notice also that the <emphasis>order</emphasis> of class parameters becomes
-important, since we can only derive instances for the last one. If the
-<literal>StateMonad</literal> class above were instead defined as
-
-<programlisting> 
-  class StateMonad m s | m -> s where ... 
-</programlisting>
-
-then we would not have been able to derive an instance for the
-<literal>Parser</literal> type above. We hypothesise that multi-parameter
-classes usually have one "main" parameter for which deriving new
-instances is most interesting.
-</para>
-<para>Lastly, all of this applies only for classes other than
-<literal>Read</literal>, <literal>Show</literal>, <literal>Typeable</literal>, 
-and <literal>Data</literal>, for which the built-in derivation applies (section
-4.3.3. of the Haskell Report).
-(For the standard classes <literal>Eq</literal>, <literal>Ord</literal>,
-<literal>Ix</literal>, and <literal>Bounded</literal> it is immaterial whether
-the standard method is used or the one described here.)
-</para>
-</sect3>
-
-</sect2>
-
-<sect2 id="typing-binds">
-<title>Generalised typing of mutually recursive bindings</title>
-
-<para>
-The Haskell Report specifies that a group of bindings (at top level, or in a
-<literal>let</literal> or <literal>where</literal>) should be sorted into
-strongly-connected components, and then type-checked in dependency order
-(<ulink url="http://haskell.org/onlinereport/decls.html#sect4.5.1">Haskell
-Report, Section 4.5.1</ulink>).  
-As each group is type-checked, any binders of the group that
-have
-an explicit type signature are put in the type environment with the specified
-polymorphic type,
-and all others are monomorphic until the group is generalised 
-(<ulink url="http://haskell.org/onlinereport/decls.html#sect4.5.2">Haskell Report, Section 4.5.2</ulink>).
-</para>
-
-<para>Following a suggestion of Mark Jones, in his paper
-<ulink url="http://www.cse.ogi.edu/~mpj/thih/">Typing Haskell in
-Haskell</ulink>,
-GHC implements a more general scheme.  If <option>-fglasgow-exts</option> is
-specified:
-<emphasis>the dependency analysis ignores references to variables that have an explicit
-type signature</emphasis>.
-As a result of this refined dependency analysis, the dependency groups are smaller, and more bindings will
-typecheck.  For example, consider:
-<programlisting>
-  f :: Eq a =&gt; a -> Bool
-  f x = (x == x) || g True || g "Yes"
-  
-  g y = (y &lt;= y) || f True
-</programlisting>
-This is rejected by Haskell 98, but under Jones's scheme the definition for
-<literal>g</literal> is typechecked first, separately from that for
-<literal>f</literal>,
-because the reference to <literal>f</literal> in <literal>g</literal>'s right
-hand side is ingored by the dependency analysis.  Then <literal>g</literal>'s
-type is generalised, to get
-<programlisting>
-  g :: Ord a =&gt; a -> Bool
-</programlisting>
-Now, the defintion for <literal>f</literal> is typechecked, with this type for
-<literal>g</literal> in the type environment.
-</para>
-
-<para>
-The same refined dependency analysis also allows the type signatures of 
-mutually-recursive functions to have different contexts, something that is illegal in
-Haskell 98 (Section 4.5.2, last sentence).  With
-<option>-fglasgow-exts</option>
-GHC only insists that the type signatures of a <emphasis>refined</emphasis> group have identical
-type signatures; in practice this means that only variables bound by the same
-pattern binding must have the same context.  For example, this is fine:
-<programlisting>
-  f :: Eq a =&gt; a -> Bool
-  f x = (x == x) || g True
-  
-  g :: Ord a =&gt; a -> Bool
-  g y = (y &lt;= y) || f True
-</programlisting>
-</para>
-</sect2>
-
-</sect1>
-<!-- ==================== End of type system extensions =================  -->
-  
-<!-- ====================== Generalised algebraic data types =======================  -->
-
-<sect1 id="gadt">
-<title>Generalised Algebraic Data Types</title>
-
-<para>Generalised Algebraic Data Types (GADTs) generalise ordinary algebraic data types by allowing you
-to give the type signatures of constructors explicitly.  For example:
-<programlisting>
-  data Term a where
-      Lit    :: Int -> Term Int
-      Succ   :: Term Int -> Term Int
-      IsZero :: Term Int -> Term Bool	
-      If     :: Term Bool -> Term a -> Term a -> Term a
-      Pair   :: Term a -> Term b -> Term (a,b)
-</programlisting>
-Notice that the return type of the constructors is not always <literal>Term a</literal>, as is the
-case with ordinary vanilla data types.  Now we can write a well-typed <literal>eval</literal> function
-for these <literal>Terms</literal>:
-<programlisting>
-  eval :: Term a -> a
-  eval (Lit i) 	    = i
-  eval (Succ t)     = 1 + eval t
-  eval (IsZero t)   = eval t == 0
-  eval (If b e1 e2) = if eval b then eval e1 else eval e2
-  eval (Pair e1 e2) = (eval e1, eval e2)
-</programlisting>
-These and many other examples are given in papers by Hongwei Xi, and Tim Sheard.
-</para>
-<para> The extensions to GHC are these:
-<itemizedlist>
-<listitem><para>
-  Data type declarations have a 'where' form, as exemplified above.  The type signature of
-each constructor is independent, and is implicitly universally quantified as usual. Unlike a normal
-Haskell data type declaration, the type variable(s) in the "<literal>data Term a where</literal>" header 
-have no scope.  Indeed, one can write a kind signature instead:
-<programlisting>
-  data Term :: * -> * where ...
-</programlisting>
-or even a mixture of the two:
-<programlisting>
-  data Foo a :: (* -> *) -> * where ...
-</programlisting>
-The type variables (if given) may be explicitly kinded, so we could also write the header for <literal>Foo</literal>
-like this:
-<programlisting>
-  data Foo a (b :: * -> *) where ...
-</programlisting>
-</para></listitem>
-
-<listitem><para>
-There are no restrictions on the type of the data constructor, except that the result
-type must begin with the type constructor being defined.  For example, in the <literal>Term</literal> data
-type above, the type of each constructor must end with <literal> ... -> Term ...</literal>.
-</para></listitem>
-
-<listitem><para>
-You can use record syntax on a GADT-style data type declaration:
-
-<programlisting>
-  data Term a where
-      Lit    { val  :: Int }      :: Term Int
-      Succ   { num  :: Term Int } :: Term Int
-      Pred   { num  :: Term Int } :: Term Int
-      IsZero { arg  :: Term Int } :: Term Bool	
-      Pair   { arg1 :: Term a
-             , arg2 :: Term b
-             }                    :: Term (a,b)
-      If     { cnd  :: Term Bool
-             , tru  :: Term a
-             , fls  :: Term a
-             }                    :: Term a
-</programlisting>
-For every constructor that has a field <literal>f</literal>, (a) the type of
-field <literal>f</literal> must be the same; and (b) the
-result type of the constructor must be the same; both modulo alpha conversion.
-Hence, in our example, we cannot merge the <literal>num</literal> and <literal>arg</literal>
-fields above into a 
-single name.  Although their field types are both <literal>Term Int</literal>,
-their selector functions actually have different types:
-
-<programlisting>
-  num :: Term Int -> Term Int
-  arg :: Term Bool -> Term Int
-</programlisting>
-
-At the moment, record updates are not yet possible with GADT, so support is 
-limited to record construction, selection and pattern matching:
-
-<programlisting>
-  someTerm :: Term Bool
-  someTerm = IsZero { arg = Succ { num = Lit { val = 0 } } }
-
-  eval :: Term a -> a
-  eval Lit    { val = i } = i
-  eval Succ   { num = t } = eval t + 1
-  eval Pred   { num = t } = eval t - 1
-  eval IsZero { arg = t } = eval t == 0
-  eval Pair   { arg1 = t1, arg2 = t2 } = (eval t1, eval t2)
-  eval t@If{} = if eval (cnd t) then eval (tru t) else eval (fls t)
-</programlisting>
-
-</para></listitem>
-
-<listitem><para>
-You can use strictness annotations, in the obvious places
-in the constructor type:
-<programlisting>
-  data Term a where
-      Lit    :: !Int -> Term Int
-      If     :: Term Bool -> !(Term a) -> !(Term a) -> Term a
-      Pair   :: Term a -> Term b -> Term (a,b)
-</programlisting>
-</para></listitem>
-
-<listitem><para>
-You can use a <literal>deriving</literal> clause on a GADT-style data type
-declaration, but only if the data type could also have been declared in
-Haskell-98 syntax.   For example, these two declarations are equivalent
-<programlisting>
-  data Maybe1 a where {
-      Nothing1 :: Maybe a ;
-      Just1    :: a -> Maybe a
-    } deriving( Eq, Ord )
-
-  data Maybe2 a = Nothing2 | Just2 a 
-       deriving( Eq, Ord )
-</programlisting>
-This simply allows you to declare a vanilla Haskell-98 data type using the
-<literal>where</literal> form without losing the <literal>deriving</literal> clause.
-</para></listitem>
-
-<listitem><para>
-Pattern matching causes type refinement.  For example, in the right hand side of the equation
-<programlisting>
-  eval :: Term a -> a
-  eval (Lit i) =  ...
-</programlisting>
-the type <literal>a</literal> is refined to <literal>Int</literal>.  (That's the whole point!)
-A precise specification of the type rules is beyond what this user manual aspires to, but there is a paper
-about the ideas: "Wobbly types: practical type inference for generalised algebraic data types", on Simon PJ's home page.</para>
-
-<para> The general principle is this: <emphasis>type refinement is only carried out based on user-supplied type annotations</emphasis>.
-So if no type signature is supplied for <literal>eval</literal>, no type refinement happens, and lots of obscure error messages will
-occur.  However, the refinement is quite general.  For example, if we had:
-<programlisting>
-  eval :: Term a -> a -> a
-  eval (Lit i) j =  i+j
-</programlisting>
-the pattern match causes the type <literal>a</literal> to be refined to <literal>Int</literal> (because of the type
-of the constructor <literal>Lit</literal>, and that refinement also applies to the type of <literal>j</literal>, and
-the result type of the <literal>case</literal> expression.  Hence the addition <literal>i+j</literal> is legal.
-</para>
-</listitem>
-</itemizedlist>
-</para>
-
-<para>Notice that GADTs generalise existential types.  For example, these two declarations are equivalent:
-<programlisting>
-  data T a = forall b. MkT b (b->a)
-  data T' a where { MKT :: b -> (b->a) -> T' a }
-</programlisting>
-</para>
-</sect1>
-
-<!-- ====================== End of Generalised algebraic data types =======================  -->
-
-<!-- ====================== TEMPLATE HASKELL =======================  -->
-
-<sect1 id="template-haskell">
-<title>Template Haskell</title>
-
-<para>Template Haskell allows you to do compile-time meta-programming in Haskell.  There is a "home page" for
-Template Haskell at <ulink url="http://www.haskell.org/th/">
-http://www.haskell.org/th/</ulink>, while
-the background to
-the main technical innovations is discussed in "<ulink
-url="http://research.microsoft.com/~simonpj/papers/meta-haskell">
-Template Meta-programming for Haskell</ulink>" (Proc Haskell Workshop 2002).
-The details of the Template Haskell design are still in flux.  Make sure you
-consult the <ulink url="http://www.haskell.org/ghc/docs/latest/html/libraries/index.html">online library reference material</ulink> 
-(search for the type ExpQ).
-[Temporary: many changes to the original design are described in 
-      <ulink url="http://research.microsoft.com/~simonpj/tmp/notes2.ps">"http://research.microsoft.com/~simonpj/tmp/notes2.ps"</ulink>.
-Not all of these changes are in GHC 6.2.]
-</para>
-
-<para> The first example from that paper is set out below as a worked example to help get you started. 
-</para>
-
-<para>
-The documentation here describes the realisation in GHC.  (It's rather sketchy just now;
-Tim Sheard is going to expand it.)
-</para>
-
-    <sect2>
-      <title>Syntax</title>
-
-      <para> Template Haskell has the following new syntactic
-      constructions.  You need to use the flag
-      <option>-fth</option><indexterm><primary><option>-fth</option></primary>
-      </indexterm>to switch these syntactic extensions on
-      (<option>-fth</option> is currently implied by
-      <option>-fglasgow-exts</option>, but you are encouraged to
-      specify it explicitly).</para>
-
-	<itemizedlist>
-	      <listitem><para>
-		  A splice is written <literal>$x</literal>, where <literal>x</literal> is an
-		  identifier, or <literal>$(...)</literal>, where the "..." is an arbitrary expression.
-		  There must be no space between the "$" and the identifier or parenthesis.  This use
-		  of "$" overrides its meaning as an infix operator, just as "M.x" overrides the meaning
-		  of "." as an infix operator.  If you want the infix operator, put spaces around it.
-		  </para>
-	      <para> A splice can occur in place of 
-		  <itemizedlist>
-		    <listitem><para> an expression; the spliced expression must
-		    have type <literal>Q Exp</literal></para></listitem>
-		    <listitem><para> a list of top-level declarations; ; the spliced expression must have type <literal>Q [Dec]</literal></para></listitem>
-		    <listitem><para> [Planned, but not implemented yet.] a
-		    type; the spliced expression must have type <literal>Q Typ</literal>.</para></listitem>
-		    </itemizedlist>
-	   (Note that the syntax for a declaration splice uses "<literal>$</literal>" not "<literal>splice</literal>" as in
-	the paper. Also the type of the enclosed expression must be  <literal>Q [Dec]</literal>, not  <literal>[Q Dec]</literal>
-	as in the paper.)
-		</para></listitem>
-
-
-	      <listitem><para>
-		  A expression quotation is written in Oxford brackets, thus:
-		  <itemizedlist>
-		    <listitem><para> <literal>[| ... |]</literal>, where the "..." is an expression; 
-                             the quotation has type <literal>Expr</literal>.</para></listitem>
-		    <listitem><para> <literal>[d| ... |]</literal>, where the "..." is a list of top-level declarations;
-                             the quotation has type <literal>Q [Dec]</literal>.</para></listitem>
-		    <listitem><para>  [Planned, but not implemented yet.]  <literal>[t| ... |]</literal>, where the "..." is a type; 
-                             the quotation has type <literal>Type</literal>.</para></listitem>
-		  </itemizedlist></para></listitem>
-
-	      <listitem><para>
-		  Reification is written thus:
-		  <itemizedlist>
-		    <listitem><para> <literal>reifyDecl T</literal>, where <literal>T</literal> is a type constructor; this expression
-		      has type <literal>Dec</literal>. </para></listitem>
-		    <listitem><para> <literal>reifyDecl C</literal>, where <literal>C</literal> is a class; has type <literal>Dec</literal>.</para></listitem>
-		    <listitem><para> <literal>reifyType f</literal>, where <literal>f</literal> is an identifier; has type <literal>Typ</literal>.</para></listitem>
-		    <listitem><para> Still to come: fixities </para></listitem>
-		    
-		  </itemizedlist></para>
-		</listitem>
-
-		  
-	</itemizedlist>
-</sect2>
-
-<sect2>  <title> Using Template Haskell </title>
-<para>
-<itemizedlist>
-    <listitem><para>
-    The data types and monadic constructor functions for Template Haskell are in the library
-    <literal>Language.Haskell.THSyntax</literal>.
-    </para></listitem>
-
-    <listitem><para>
-    You can only run a function at compile time if it is imported from another module.  That is,
-	    you can't define a function in a module, and call it from within a splice in the same module.
-	    (It would make sense to do so, but it's hard to implement.)
-   </para></listitem>
-
-    <listitem><para>
-	    The flag <literal>-ddump-splices</literal> shows the expansion of all top-level splices as they happen.
-   </para></listitem>
-    <listitem><para>
-	    If you are building GHC from source, you need at least a stage-2 bootstrap compiler to
-	      run Template Haskell.  A stage-1 compiler will reject the TH constructs.  Reason: TH
-	      compiles and runs a program, and then looks at the result.  So it's important that
-	      the program it compiles produces results whose representations are identical to
-	      those of the compiler itself.
-   </para></listitem>
-</itemizedlist>
-</para>
-<para> Template Haskell works in any mode (<literal>--make</literal>, <literal>--interactive</literal>,
-	or file-at-a-time).  There used to be a restriction to the former two, but that restriction 
-	has been lifted.
-</para>
-</sect2>
- 
-<sect2>  <title> A Template Haskell Worked Example </title>
-<para>To help you get over the confidence barrier, try out this skeletal worked example.
-  First cut and paste the two modules below into "Main.hs" and "Printf.hs":</para>
-
-<programlisting>
-
-{- Main.hs -}
-module Main where
-
--- Import our template "pr"
-import Printf ( pr )
-
--- The splice operator $ takes the Haskell source code
--- generated at compile time by "pr" and splices it into
--- the argument of "putStrLn".
-main = putStrLn ( $(pr "Hello") )
-
-
-{- Printf.hs -}
-module Printf where
-
--- Skeletal printf from the paper.
--- It needs to be in a separate module to the one where
--- you intend to use it.
-
--- Import some Template Haskell syntax
-import Language.Haskell.TH
-
--- Describe a format string
-data Format = D | S | L String
-
--- Parse a format string.  This is left largely to you
--- as we are here interested in building our first ever
--- Template Haskell program and not in building printf.
-parse :: String -> [Format]
-parse s   = [ L s ]
-
--- Generate Haskell source code from a parsed representation
--- of the format string.  This code will be spliced into
--- the module which calls "pr", at compile time.
-gen :: [Format] -> ExpQ
-gen [D]   = [| \n -> show n |]
-gen [S]   = [| \s -> s |]
-gen [L s] = stringE s
-
--- Here we generate the Haskell code for the splice
--- from an input format string.
-pr :: String -> ExpQ
-pr s      = gen (parse s)
-</programlisting>
-
-<para>Now run the compiler (here we are a Cygwin prompt on Windows):
-</para>
-<programlisting>
-$ ghc --make -fth main.hs -o main.exe
-</programlisting>
-
-<para>Run "main.exe" and here is your output:</para>
-
-<programlisting>
-$ ./main
-Hello
-</programlisting>
-
-</sect2>
- 
-</sect1>
-
-<!-- ===================== Arrow notation ===================  -->
-
-<sect1 id="arrow-notation">
-<title>Arrow notation
-</title>
-
-<para>Arrows are a generalization of monads introduced by John Hughes.
-For more details, see
-<itemizedlist>
-
-<listitem>
-<para>
-&ldquo;Generalising Monads to Arrows&rdquo;,
-John Hughes, in <citetitle>Science of Computer Programming</citetitle> 37,
-pp67&ndash;111, May 2000.
-</para>
-</listitem>
-
-<listitem>
-<para>
-&ldquo;<ulink url="http://www.soi.city.ac.uk/~ross/papers/notation.html">A New Notation for Arrows</ulink>&rdquo;,
-Ross Paterson, in <citetitle>ICFP</citetitle>, Sep 2001.
-</para>
-</listitem>
-
-<listitem>
-<para>
-&ldquo;<ulink url="http://www.soi.city.ac.uk/~ross/papers/fop.html">Arrows and Computation</ulink>&rdquo;,
-Ross Paterson, in <citetitle>The Fun of Programming</citetitle>,
-Palgrave, 2003.
-</para>
-</listitem>
-
-</itemizedlist>
-and the arrows web page at
-<ulink url="http://www.haskell.org/arrows/"><literal>http://www.haskell.org/arrows/</literal></ulink>.
-With the <option>-farrows</option> flag, GHC supports the arrow
-notation described in the second of these papers.
-What follows is a brief introduction to the notation;
-it won't make much sense unless you've read Hughes's paper.
-This notation is translated to ordinary Haskell,
-using combinators from the
-<ulink url="../libraries/base/Control-Arrow.html"><literal>Control.Arrow</literal></ulink>
-module.
-</para>
-
-<para>The extension adds a new kind of expression for defining arrows:
-<screen>
-<replaceable>exp</replaceable><superscript>10</superscript> ::= ...
-       |  proc <replaceable>apat</replaceable> -> <replaceable>cmd</replaceable>
-</screen>
-where <literal>proc</literal> is a new keyword.
-The variables of the pattern are bound in the body of the 
-<literal>proc</literal>-expression,
-which is a new sort of thing called a <firstterm>command</firstterm>.
-The syntax of commands is as follows:
-<screen>
-<replaceable>cmd</replaceable>   ::= <replaceable>exp</replaceable><superscript>10</superscript> -&lt;  <replaceable>exp</replaceable>
-       |  <replaceable>exp</replaceable><superscript>10</superscript> -&lt;&lt; <replaceable>exp</replaceable>
-       |  <replaceable>cmd</replaceable><superscript>0</superscript>
-</screen>
-with <replaceable>cmd</replaceable><superscript>0</superscript> up to
-<replaceable>cmd</replaceable><superscript>9</superscript> defined using
-infix operators as for expressions, and
-<screen>
-<replaceable>cmd</replaceable><superscript>10</superscript> ::= \ <replaceable>apat</replaceable> ... <replaceable>apat</replaceable> -> <replaceable>cmd</replaceable>
-       |  let <replaceable>decls</replaceable> in <replaceable>cmd</replaceable>
-       |  if <replaceable>exp</replaceable> then <replaceable>cmd</replaceable> else <replaceable>cmd</replaceable>
-       |  case <replaceable>exp</replaceable> of { <replaceable>calts</replaceable> }
-       |  do { <replaceable>cstmt</replaceable> ; ... <replaceable>cstmt</replaceable> ; <replaceable>cmd</replaceable> }
-       |  <replaceable>fcmd</replaceable>
-
-<replaceable>fcmd</replaceable>  ::= <replaceable>fcmd</replaceable> <replaceable>aexp</replaceable>
-       |  ( <replaceable>cmd</replaceable> )
-       |  (| <replaceable>aexp</replaceable> <replaceable>cmd</replaceable> ... <replaceable>cmd</replaceable> |)
-
-<replaceable>cstmt</replaceable> ::= let <replaceable>decls</replaceable>
-       |  <replaceable>pat</replaceable> &lt;- <replaceable>cmd</replaceable>
-       |  rec { <replaceable>cstmt</replaceable> ; ... <replaceable>cstmt</replaceable> [;] }
-       |  <replaceable>cmd</replaceable>
-</screen>
-where <replaceable>calts</replaceable> are like <replaceable>alts</replaceable>
-except that the bodies are commands instead of expressions.
-</para>
-
-<para>
-Commands produce values, but (like monadic computations)
-may yield more than one value,
-or none, and may do other things as well.
-For the most part, familiarity with monadic notation is a good guide to
-using commands.
-However the values of expressions, even monadic ones,
-are determined by the values of the variables they contain;
-this is not necessarily the case for commands.
-</para>
-
-<para>
-A simple example of the new notation is the expression
-<screen>
-proc x -> f -&lt; x+1
-</screen>
-We call this a <firstterm>procedure</firstterm> or
-<firstterm>arrow abstraction</firstterm>.
-As with a lambda expression, the variable <literal>x</literal>
-is a new variable bound within the <literal>proc</literal>-expression.
-It refers to the input to the arrow.
-In the above example, <literal>-&lt;</literal> is not an identifier but an
-new reserved symbol used for building commands from an expression of arrow
-type and an expression to be fed as input to that arrow.
-(The weird look will make more sense later.)
-It may be read as analogue of application for arrows.
-The above example is equivalent to the Haskell expression
-<screen>
-arr (\ x -> x+1) >>> f
-</screen>
-That would make no sense if the expression to the left of
-<literal>-&lt;</literal> involves the bound variable <literal>x</literal>.
-More generally, the expression to the left of <literal>-&lt;</literal>
-may not involve any <firstterm>local variable</firstterm>,
-i.e. a variable bound in the current arrow abstraction.
-For such a situation there is a variant <literal>-&lt;&lt;</literal>, as in
-<screen>
-proc x -> f x -&lt;&lt; x+1
-</screen>
-which is equivalent to
-<screen>
-arr (\ x -> (f x, x+1)) >>> app
-</screen>
-so in this case the arrow must belong to the <literal>ArrowApply</literal>
-class.
-Such an arrow is equivalent to a monad, so if you're using this form
-you may find a monadic formulation more convenient.
-</para>
-
-<sect2>
-<title>do-notation for commands</title>
-
-<para>
-Another form of command is a form of <literal>do</literal>-notation.
-For example, you can write
-<screen>
-proc x -> do
-        y &lt;- f -&lt; x+1
-        g -&lt; 2*y
-        let z = x+y
-        t &lt;- h -&lt; x*z
-        returnA -&lt; t+z
-</screen>
-You can read this much like ordinary <literal>do</literal>-notation,
-but with commands in place of monadic expressions.
-The first line sends the value of <literal>x+1</literal> as an input to
-the arrow <literal>f</literal>, and matches its output against
-<literal>y</literal>.
-In the next line, the output is discarded.
-The arrow <function>returnA</function> is defined in the
-<ulink url="../libraries/base/Control-Arrow.html"><literal>Control.Arrow</literal></ulink>
-module as <literal>arr id</literal>.
-The above example is treated as an abbreviation for
-<screen>
-arr (\ x -> (x, x)) >>>
-        first (arr (\ x -> x+1) >>> f) >>>
-        arr (\ (y, x) -> (y, (x, y))) >>>
-        first (arr (\ y -> 2*y) >>> g) >>>
-        arr snd >>>
-        arr (\ (x, y) -> let z = x+y in ((x, z), z)) >>>
-        first (arr (\ (x, z) -> x*z) >>> h) >>>
-        arr (\ (t, z) -> t+z) >>>
-        returnA
-</screen>
-Note that variables not used later in the composition are projected out.
-After simplification using rewrite rules (see <xref linkend="rewrite-rules"/>)
-defined in the
-<ulink url="../libraries/base/Control-Arrow.html"><literal>Control.Arrow</literal></ulink>
-module, this reduces to
-<screen>
-arr (\ x -> (x+1, x)) >>>
-        first f >>>
-        arr (\ (y, x) -> (2*y, (x, y))) >>>
-        first g >>>
-        arr (\ (_, (x, y)) -> let z = x+y in (x*z, z)) >>>
-        first h >>>
-        arr (\ (t, z) -> t+z)
-</screen>
-which is what you might have written by hand.
-With arrow notation, GHC keeps track of all those tuples of variables for you.
-</para>
-
-<para>
-Note that although the above translation suggests that
-<literal>let</literal>-bound variables like <literal>z</literal> must be
-monomorphic, the actual translation produces Core,
-so polymorphic variables are allowed.
-</para>
-
-<para>
-It's also possible to have mutually recursive bindings,
-using the new <literal>rec</literal> keyword, as in the following example:
-<programlisting>
-counter :: ArrowCircuit a => a Bool Int
-counter = proc reset -> do
-        rec     output &lt;- returnA -&lt; if reset then 0 else next
-                next &lt;- delay 0 -&lt; output+1
-        returnA -&lt; output
-</programlisting>
-The translation of such forms uses the <function>loop</function> combinator,
-so the arrow concerned must belong to the <literal>ArrowLoop</literal> class.
-</para>
-
-</sect2>
-
-<sect2>
-<title>Conditional commands</title>
-
-<para>
-In the previous example, we used a conditional expression to construct the
-input for an arrow.
-Sometimes we want to conditionally execute different commands, as in
-<screen>
-proc (x,y) ->
-        if f x y
-        then g -&lt; x+1
-        else h -&lt; y+2
-</screen>
-which is translated to
-<screen>
-arr (\ (x,y) -> if f x y then Left x else Right y) >>>
-        (arr (\x -> x+1) >>> f) ||| (arr (\y -> y+2) >>> g)
-</screen>
-Since the translation uses <function>|||</function>,
-the arrow concerned must belong to the <literal>ArrowChoice</literal> class.
-</para>
-
-<para>
-There are also <literal>case</literal> commands, like
-<screen>
-case input of
-    [] -> f -&lt; ()
-    [x] -> g -&lt; x+1
-    x1:x2:xs -> do
-        y &lt;- h -&lt; (x1, x2)
-        ys &lt;- k -&lt; xs
-        returnA -&lt; y:ys
-</screen>
-The syntax is the same as for <literal>case</literal> expressions,
-except that the bodies of the alternatives are commands rather than expressions.
-The translation is similar to that of <literal>if</literal> commands.
-</para>
-
-</sect2>
-
-<sect2>
-<title>Defining your own control structures</title>
-
-<para>
-As we're seen, arrow notation provides constructs,
-modelled on those for expressions,
-for sequencing, value recursion and conditionals.
-But suitable combinators,
-which you can define in ordinary Haskell,
-may also be used to build new commands out of existing ones.
-The basic idea is that a command defines an arrow from environments to values.
-These environments assign values to the free local variables of the command.
-Thus combinators that produce arrows from arrows
-may also be used to build commands from commands.
-For example, the <literal>ArrowChoice</literal> class includes a combinator
-<programlisting>
-ArrowChoice a => (&lt;+>) :: a e c -> a e c -> a e c
-</programlisting>
-so we can use it to build commands:
-<programlisting>
-expr' = proc x -> do
-                returnA -&lt; x
-        &lt;+> do
-                symbol Plus -&lt; ()
-                y &lt;- term -&lt; ()
-                expr' -&lt; x + y
-        &lt;+> do
-                symbol Minus -&lt; ()
-                y &lt;- term -&lt; ()
-                expr' -&lt; x - y
-</programlisting>
-(The <literal>do</literal> on the first line is needed to prevent the first
-<literal>&lt;+> ...</literal> from being interpreted as part of the
-expression on the previous line.)
-This is equivalent to
-<programlisting>
-expr' = (proc x -> returnA -&lt; x)
-        &lt;+> (proc x -> do
-                symbol Plus -&lt; ()
-                y &lt;- term -&lt; ()
-                expr' -&lt; x + y)
-        &lt;+> (proc x -> do
-                symbol Minus -&lt; ()
-                y &lt;- term -&lt; ()
-                expr' -&lt; x - y)
-</programlisting>
-It is essential that this operator be polymorphic in <literal>e</literal>
-(representing the environment input to the command
-and thence to its subcommands)
-and satisfy the corresponding naturality property
-<screen>
-arr k >>> (f &lt;+> g) = (arr k >>> f) &lt;+> (arr k >>> g)
-</screen>
-at least for strict <literal>k</literal>.
-(This should be automatic if you're not using <function>seq</function>.)
-This ensures that environments seen by the subcommands are environments
-of the whole command,
-and also allows the translation to safely trim these environments.
-The operator must also not use any variable defined within the current
-arrow abstraction.
-</para>
-
-<para>
-We could define our own operator
-<programlisting>
-untilA :: ArrowChoice a => a e () -> a e Bool -> a e ()
-untilA body cond = proc x ->
-        if cond x then returnA -&lt; ()
-        else do
-                body -&lt; x
-                untilA body cond -&lt; x
-</programlisting>
-and use it in the same way.
-Of course this infix syntax only makes sense for binary operators;
-there is also a more general syntax involving special brackets:
-<screen>
-proc x -> do
-        y &lt;- f -&lt; x+1
-        (|untilA (increment -&lt; x+y) (within 0.5 -&lt; x)|)
-</screen>
-</para>
-
-</sect2>
-
-<sect2>
-<title>Primitive constructs</title>
-
-<para>
-Some operators will need to pass additional inputs to their subcommands.
-For example, in an arrow type supporting exceptions,
-the operator that attaches an exception handler will wish to pass the
-exception that occurred to the handler.
-Such an operator might have a type
-<screen>
-handleA :: ... => a e c -> a (e,Ex) c -> a e c
-</screen>
-where <literal>Ex</literal> is the type of exceptions handled.
-You could then use this with arrow notation by writing a command
-<screen>
-body `handleA` \ ex -> handler
-</screen>
-so that if an exception is raised in the command <literal>body</literal>,
-the variable <literal>ex</literal> is bound to the value of the exception
-and the command <literal>handler</literal>,
-which typically refers to <literal>ex</literal>, is entered.
-Though the syntax here looks like a functional lambda,
-we are talking about commands, and something different is going on.
-The input to the arrow represented by a command consists of values for
-the free local variables in the command, plus a stack of anonymous values.
-In all the prior examples, this stack was empty.
-In the second argument to <function>handleA</function>,
-this stack consists of one value, the value of the exception.
-The command form of lambda merely gives this value a name.
-</para>
-
-<para>
-More concretely,
-the values on the stack are paired to the right of the environment.
-So operators like <function>handleA</function> that pass
-extra inputs to their subcommands can be designed for use with the notation
-by pairing the values with the environment in this way.
-More precisely, the type of each argument of the operator (and its result)
-should have the form
-<screen>
-a (...(e,t1), ... tn) t
-</screen>
-where <replaceable>e</replaceable> is a polymorphic variable
-(representing the environment)
-and <replaceable>ti</replaceable> are the types of the values on the stack,
-with <replaceable>t1</replaceable> being the <quote>top</quote>.
-The polymorphic variable <replaceable>e</replaceable> must not occur in
-<replaceable>a</replaceable>, <replaceable>ti</replaceable> or
-<replaceable>t</replaceable>.
-However the arrows involved need not be the same.
-Here are some more examples of suitable operators:
-<screen>
-bracketA :: ... => a e b -> a (e,b) c -> a (e,c) d -> a e d
-runReader :: ... => a e c -> a' (e,State) c
-runState :: ... => a e c -> a' (e,State) (c,State)
-</screen>
-We can supply the extra input required by commands built with the last two
-by applying them to ordinary expressions, as in
-<screen>
-proc x -> do
-        s &lt;- ...
-        (|runReader (do { ... })|) s
-</screen>
-which adds <literal>s</literal> to the stack of inputs to the command
-built using <function>runReader</function>.
-</para>
-
-<para>
-The command versions of lambda abstraction and application are analogous to
-the expression versions.
-In particular, the beta and eta rules describe equivalences of commands.
-These three features (operators, lambda abstraction and application)
-are the core of the notation; everything else can be built using them,
-though the results would be somewhat clumsy.
-For example, we could simulate <literal>do</literal>-notation by defining
-<programlisting>
-bind :: Arrow a => a e b -> a (e,b) c -> a e c
-u `bind` f = returnA &amp;&amp;&amp; u >>> f
-
-bind_ :: Arrow a => a e b -> a e c -> a e c
-u `bind_` f = u `bind` (arr fst >>> f)
-</programlisting>
-We could simulate <literal>if</literal> by defining
-<programlisting>
-cond :: ArrowChoice a => a e b -> a e b -> a (e,Bool) b
-cond f g = arr (\ (e,b) -> if b then Left e else Right e) >>> f ||| g
-</programlisting>
-</para>
-
-</sect2>
-
-<sect2>
-<title>Differences with the paper</title>
-
-<itemizedlist>
-
-<listitem>
-<para>Instead of a single form of arrow application (arrow tail) with two
-translations, the implementation provides two forms
-<quote><literal>-&lt;</literal></quote> (first-order)
-and <quote><literal>-&lt;&lt;</literal></quote> (higher-order).
-</para>
-</listitem>
-
-<listitem>
-<para>User-defined operators are flagged with banana brackets instead of
-a new <literal>form</literal> keyword.
-</para>
-</listitem>
-
-</itemizedlist>
-
-</sect2>
-
-<sect2>
-<title>Portability</title>
-
-<para>
-Although only GHC implements arrow notation directly,
-there is also a preprocessor
-(available from the 
-<ulink url="http://www.haskell.org/arrows/">arrows web page</ulink>)
-that translates arrow notation into Haskell 98
-for use with other Haskell systems.
-You would still want to check arrow programs with GHC;
-tracing type errors in the preprocessor output is not easy.
-Modules intended for both GHC and the preprocessor must observe some
-additional restrictions:
-<itemizedlist>
-
-<listitem>
-<para>
-The module must import
-<ulink url="../libraries/base/Control-Arrow.html"><literal>Control.Arrow</literal></ulink>.
-</para>
-</listitem>
-
-<listitem>
-<para>
-The preprocessor cannot cope with other Haskell extensions.
-These would have to go in separate modules.
-</para>
-</listitem>
-
-<listitem>
-<para>
-Because the preprocessor targets Haskell (rather than Core),
-<literal>let</literal>-bound variables are monomorphic.
-</para>
-</listitem>
-
-</itemizedlist>
-</para>
-
-</sect2>
-
-</sect1>
-
-<!-- ==================== ASSERTIONS =================  -->
-
-<sect1 id="sec-assertions">
-<title>Assertions
-<indexterm><primary>Assertions</primary></indexterm>
-</title>
-
-<para>
-If you want to make use of assertions in your standard Haskell code, you
-could define a function like the following:
-</para>
-
-<para>
-
-<programlisting>
-assert :: Bool -> a -> a
-assert False x = error "assertion failed!"
-assert _     x = x
-</programlisting>
-
-</para>
-
-<para>
-which works, but gives you back a less than useful error message --
-an assertion failed, but which and where?
-</para>
-
-<para>
-One way out is to define an extended <function>assert</function> function which also
-takes a descriptive string to include in the error message and
-perhaps combine this with the use of a pre-processor which inserts
-the source location where <function>assert</function> was used.
-</para>
-
-<para>
-Ghc offers a helping hand here, doing all of this for you. For every
-use of <function>assert</function> in the user's source:
-</para>
-
-<para>
-
-<programlisting>
-kelvinToC :: Double -> Double
-kelvinToC k = assert (k &gt;= 0.0) (k+273.15)
-</programlisting>
-
-</para>
-
-<para>
-Ghc will rewrite this to also include the source location where the
-assertion was made,
-</para>
-
-<para>
-
-<programlisting>
-assert pred val ==> assertError "Main.hs|15" pred val
-</programlisting>
-
-</para>
-
-<para>
-The rewrite is only performed by the compiler when it spots
-applications of <function>Control.Exception.assert</function>, so you
-can still define and use your own versions of
-<function>assert</function>, should you so wish. If not, import
-<literal>Control.Exception</literal> to make use
-<function>assert</function> in your code.
-</para>
-
-<para>
-GHC ignores assertions when optimisation is turned on with the
-      <option>-O</option><indexterm><primary><option>-O</option></primary></indexterm> flag.  That is, expressions of the form
-<literal>assert pred e</literal> will be rewritten to
-<literal>e</literal>.  You can also disable assertions using the
-      <option>-fignore-asserts</option>
-      option<indexterm><primary><option>-fignore-asserts</option></primary>
-      </indexterm>.</para>
-
-<para>
-Assertion failures can be caught, see the documentation for the
-<literal>Control.Exception</literal> library for the details.
-</para>
-
-</sect1>
-
-
-<!-- =============================== PRAGMAS ===========================  -->
-
-  <sect1 id="pragmas">
-    <title>Pragmas</title>
-
-    <indexterm><primary>pragma</primary></indexterm>
-
-    <para>GHC supports several pragmas, or instructions to the
-    compiler placed in the source code.  Pragmas don't normally affect
-    the meaning of the program, but they might affect the efficiency
-    of the generated code.</para>
-
-    <para>Pragmas all take the form
-
-<literal>{-# <replaceable>word</replaceable> ... #-}</literal>  
-
-    where <replaceable>word</replaceable> indicates the type of
-    pragma, and is followed optionally by information specific to that
-    type of pragma.  Case is ignored in
-    <replaceable>word</replaceable>.  The various values for
-    <replaceable>word</replaceable> that GHC understands are described
-    in the following sections; any pragma encountered with an
-    unrecognised <replaceable>word</replaceable> is (silently)
-    ignored.</para>
-
-    <sect2 id="deprecated-pragma">
-      <title>DEPRECATED pragma</title>
-      <indexterm><primary>DEPRECATED</primary>
-      </indexterm>
-
-      <para>The DEPRECATED pragma lets you specify that a particular
-      function, class, or type, is deprecated.  There are two
-      forms.
-
-      <itemizedlist>
-	<listitem>
-	  <para>You can deprecate an entire module thus:</para>
-<programlisting>
-   module Wibble {-# DEPRECATED "Use Wobble instead" #-} where
-     ...
-</programlisting>
-	  <para>When you compile any module that import
-          <literal>Wibble</literal>, GHC will print the specified
-          message.</para>
-	</listitem>
-
-	<listitem>
-	  <para>You can deprecate a function, class, type, or data constructor, with the
-	  following top-level declaration:</para>
-<programlisting>
-   {-# DEPRECATED f, C, T "Don't use these" #-}
-</programlisting>
-	  <para>When you compile any module that imports and uses any
-          of the specified entities, GHC will print the specified
-          message.</para>
-	  <para> You can only depecate entities declared at top level in the module
-	  being compiled, and you can only use unqualified names in the list of
-	  entities being deprecated.  A capitalised name, such as <literal>T</literal>
-	  refers to <emphasis>either</emphasis> the type constructor <literal>T</literal>
-	  <emphasis>or</emphasis> the data constructor <literal>T</literal>, or both if
-	  both are in scope.  If both are in scope, there is currently no way to deprecate 
-	  one without the other (c.f. fixities <xref linkend="infix-tycons"/>).</para>
-	</listitem>
-      </itemizedlist>
-      Any use of the deprecated item, or of anything from a deprecated
-      module, will be flagged with an appropriate message.  However,
-      deprecations are not reported for
-      (a) uses of a deprecated function within its defining module, and
-      (b) uses of a deprecated function in an export list.
-      The latter reduces spurious complaints within a library
-      in which one module gathers together and re-exports 
-      the exports of several others.
-      </para>
-      <para>You can suppress the warnings with the flag
-      <option>-fno-warn-deprecations</option>.</para>
-    </sect2>
-
-    <sect2 id="include-pragma">
-      <title>INCLUDE pragma</title>
-
-      <para>The <literal>INCLUDE</literal> pragma is for specifying the names
-	of C header files that should be <literal>#include</literal>'d into
-	the C source code generated by the compiler for the current module (if
-	compiling via C).  For example:</para>
-
-<programlisting>
-{-# INCLUDE "foo.h" #-}
-{-# INCLUDE &lt;stdio.h&gt; #-}</programlisting>
-
-      <para>The <literal>INCLUDE</literal> pragma(s) must appear at the top of
-	your source file with any <literal>OPTIONS_GHC</literal>
-	pragma(s).</para>
-
-      <para>An <literal>INCLUDE</literal> pragma is  the preferred alternative
-	to the <option>-#include</option> option (<xref
-	  linkend="options-C-compiler" />), because the
-	<literal>INCLUDE</literal> pragma is understood by other
-	compilers.  Yet another alternative is to add the include file to each
-	<literal>foreign import</literal> declaration in your code, but we
-	don't recommend using this approach with GHC.</para>
-    </sect2>
-
-    <sect2 id="inline-noinline-pragma">
-      <title>INLINE and NOINLINE pragmas</title>
-
-      <para>These pragmas control the inlining of function
-      definitions.</para>
-
-      <sect3 id="inline-pragma">
-	<title>INLINE pragma</title>
-	<indexterm><primary>INLINE</primary></indexterm>
-
-	<para>GHC (with <option>-O</option>, as always) tries to
-        inline (or &ldquo;unfold&rdquo;) functions/values that are
-        &ldquo;small enough,&rdquo; thus avoiding the call overhead
-        and possibly exposing other more-wonderful optimisations.
-        Normally, if GHC decides a function is &ldquo;too
-        expensive&rdquo; to inline, it will not do so, nor will it
-        export that unfolding for other modules to use.</para>
-
-        <para>The sledgehammer you can bring to bear is the
-        <literal>INLINE</literal><indexterm><primary>INLINE
-        pragma</primary></indexterm> pragma, used thusly:</para>
-
-<programlisting>
-key_function :: Int -> String -> (Bool, Double)
-
-#ifdef __GLASGOW_HASKELL__
-{-# INLINE key_function #-}
-#endif
-</programlisting>
-
-	<para>(You don't need to do the C pre-processor carry-on
-        unless you're going to stick the code through HBC&mdash;it
-        doesn't like <literal>INLINE</literal> pragmas.)</para>
-
-        <para>The major effect of an <literal>INLINE</literal> pragma
-        is to declare a function's &ldquo;cost&rdquo; to be very low.
-        The normal unfolding machinery will then be very keen to
-        inline it.</para>
-
-	<para>Syntactically, an <literal>INLINE</literal> pragma for a
-        function can be put anywhere its type signature could be
-        put.</para>
-
-	<para><literal>INLINE</literal> pragmas are a particularly
-        good idea for the
-        <literal>then</literal>/<literal>return</literal> (or
-        <literal>bind</literal>/<literal>unit</literal>) functions in
-        a monad.  For example, in GHC's own
-        <literal>UniqueSupply</literal> monad code, we have:</para>
-
-<programlisting>
-#ifdef __GLASGOW_HASKELL__
-{-# INLINE thenUs #-}
-{-# INLINE returnUs #-}
-#endif
-</programlisting>
-
-	<para>See also the <literal>NOINLINE</literal> pragma (<xref
-        linkend="noinline-pragma"/>).</para>
-      </sect3>
-
-      <sect3 id="noinline-pragma">
-	<title>NOINLINE pragma</title>
-	
-	<indexterm><primary>NOINLINE</primary></indexterm>
-	<indexterm><primary>NOTINLINE</primary></indexterm>
-
-	<para>The <literal>NOINLINE</literal> pragma does exactly what
-        you'd expect: it stops the named function from being inlined
-        by the compiler.  You shouldn't ever need to do this, unless
-        you're very cautious about code size.</para>
-
-	<para><literal>NOTINLINE</literal> is a synonym for
-        <literal>NOINLINE</literal> (<literal>NOINLINE</literal> is
-        specified by Haskell 98 as the standard way to disable
-        inlining, so it should be used if you want your code to be
-        portable).</para>
-      </sect3>
-
-      <sect3 id="phase-control">
-	<title>Phase control</title>
-
-	<para> Sometimes you want to control exactly when in GHC's
-        pipeline the INLINE pragma is switched on.  Inlining happens
-        only during runs of the <emphasis>simplifier</emphasis>.  Each
-        run of the simplifier has a different <emphasis>phase
-        number</emphasis>; the phase number decreases towards zero.
-        If you use <option>-dverbose-core2core</option> you'll see the
-        sequence of phase numbers for successive runs of the
-        simplifier.  In an INLINE pragma you can optionally specify a
-        phase number, thus:</para>
-
-	<itemizedlist>
-	  <listitem>
-	    <para>You can say "inline <literal>f</literal> in Phase 2
-            and all subsequent phases":
-<programlisting>
-  {-# INLINE [2] f #-}
-</programlisting>
-            </para>
-	  </listitem>
-
-	  <listitem>
-	    <para>You can say "inline <literal>g</literal> in all
-            phases up to, but not including, Phase 3":
-<programlisting>
-  {-# INLINE [~3] g #-}
-</programlisting>
-            </para>
-	  </listitem>
-
-	  <listitem>
-	    <para>If you omit the phase indicator, you mean "inline in
-            all phases".</para>
-	  </listitem>
-	</itemizedlist>
-
-	<para>You can use a phase number on a NOINLINE pragma too:</para>
-
-	<itemizedlist>
-	  <listitem>
-	    <para>You can say "do not inline <literal>f</literal>
-            until Phase 2; in Phase 2 and subsequently behave as if
-            there was no pragma at all":
-<programlisting>
-  {-# NOINLINE [2] f #-}
-</programlisting>
-            </para>
-	  </listitem>
-
-	  <listitem>
-	    <para>You can say "do not inline <literal>g</literal> in
-            Phase 3 or any subsequent phase; before that, behave as if
-            there was no pragma":
-<programlisting>
-  {-# NOINLINE [~3] g #-}
-</programlisting>
-            </para>
-	  </listitem>
-
-	  <listitem>
-	    <para>If you omit the phase indicator, you mean "never
-            inline this function".</para>
-	  </listitem>
-	</itemizedlist>
-
-	<para>The same phase-numbering control is available for RULES
-	(<xref linkend="rewrite-rules"/>).</para>
-      </sect3>
-    </sect2>
-
-    <sect2 id="language-pragma">
-      <title>LANGUAGE pragma</title>
-
-      <indexterm><primary>LANGUAGE</primary><secondary>pragma</secondary></indexterm>
-      <indexterm><primary>pragma</primary><secondary>LANGUAGE</secondary></indexterm>
-
-      <para>This allows language extensions to be enabled in a portable way.
-	It is the intention that all Haskell compilers support the
-	<literal>LANGUAGE</literal> pragma with the same syntax, although not
-	all extensions are supported by all compilers, of
-	course.  The <literal>LANGUAGE</literal> pragma should be used instead
-	of <literal>OPTIONS_GHC</literal>, if possible.</para>
-
-      <para>For example, to enable the FFI and preprocessing with CPP:</para>
-
-<programlisting>{-# LANGUAGE ForeignFunctionInterface, CPP #-}</programlisting>
-
-      <para>Any extension from the <literal>Extension</literal> type defined in
-	<ulink
-	  url="../libraries/Cabal/Language-Haskell-Extension.html"><literal>Language.Haskell.Extension</literal></ulink> may be used.  GHC will report an error if any of the requested extensions are not supported.</para>
-    </sect2>
-
-
-    <sect2 id="line-pragma">
-      <title>LINE pragma</title>
-
-      <indexterm><primary>LINE</primary><secondary>pragma</secondary></indexterm>
-      <indexterm><primary>pragma</primary><secondary>LINE</secondary></indexterm>
-      <para>This pragma is similar to C's <literal>&num;line</literal>
-      pragma, and is mainly for use in automatically generated Haskell
-      code.  It lets you specify the line number and filename of the
-      original code; for example</para>
-
-<programlisting>{-# LINE 42 "Foo.vhs" #-}</programlisting>
-
-      <para>if you'd generated the current file from something called
-      <filename>Foo.vhs</filename> and this line corresponds to line
-      42 in the original.  GHC will adjust its error messages to refer
-      to the line/file named in the <literal>LINE</literal>
-      pragma.</para>
-    </sect2>
-
-    <sect2 id="options-pragma">
-      <title>OPTIONS_GHC pragma</title>
-      <indexterm><primary>OPTIONS_GHC</primary>
-      </indexterm>
-      <indexterm><primary>pragma</primary><secondary>OPTIONS_GHC</secondary>
-      </indexterm>
-
-      <para>The <literal>OPTIONS_GHC</literal> pragma is used to specify
-      additional options that are given to the compiler when compiling
-      this source file.  See <xref linkend="source-file-options"/> for
-      details.</para>
-
-      <para>Previous versions of GHC accepted <literal>OPTIONS</literal> rather
-	than <literal>OPTIONS_GHC</literal>, but that is now deprecated.</para>
-    </sect2>
-
-    <sect2 id="rules">
-      <title>RULES pragma</title>
-
-      <para>The RULES pragma lets you specify rewrite rules.  It is
-      described in <xref linkend="rewrite-rules"/>.</para>
-    </sect2>
-
-    <sect2 id="specialize-pragma">
-      <title>SPECIALIZE pragma</title>
-
-      <indexterm><primary>SPECIALIZE pragma</primary></indexterm>
-      <indexterm><primary>pragma, SPECIALIZE</primary></indexterm>
-      <indexterm><primary>overloading, death to</primary></indexterm>
-
-      <para>(UK spelling also accepted.)  For key overloaded
-      functions, you can create extra versions (NB: more code space)
-      specialised to particular types.  Thus, if you have an
-      overloaded function:</para>
-
-<programlisting>
-  hammeredLookup :: Ord key => [(key, value)] -> key -> value
-</programlisting>
-
-      <para>If it is heavily used on lists with
-      <literal>Widget</literal> keys, you could specialise it as
-      follows:</para>
-
-<programlisting>
-  {-# SPECIALIZE hammeredLookup :: [(Widget, value)] -> Widget -> value #-}
-</programlisting>
-
-      <para>A <literal>SPECIALIZE</literal> pragma for a function can
-      be put anywhere its type signature could be put.</para>
-
-      <para>A <literal>SPECIALIZE</literal> has the effect of generating
-      (a) a specialised version of the function and (b) a rewrite rule
-      (see <xref linkend="rewrite-rules"/>) that rewrites a call to the
-      un-specialised function into a call to the specialised one.</para>
-
-      <para>The type in a SPECIALIZE pragma can be any type that is less
-	polymorphic than the type of the original function.  In concrete terms,
-	if the original function is <literal>f</literal> then the pragma
-<programlisting>
-  {-# SPECIALIZE f :: &lt;type&gt; #-}
-</programlisting>
-      is valid if and only if the defintion
-<programlisting>
-  f_spec :: &lt;type&gt;
-  f_spec = f
-</programlisting>
-      is valid.  Here are some examples (where we only give the type signature
-      for the original function, not its code):
-<programlisting>
-  f :: Eq a => a -> b -> b
-  {-# SPECIALISE f :: Int -> b -> b #-}
-
-  g :: (Eq a, Ix b) => a -> b -> b
-  {-# SPECIALISE g :: (Eq a) => a -> Int -> Int #-}
-
-  h :: Eq a => a -> a -> a
-  {-# SPECIALISE h :: (Eq a) => [a] -> [a] -> [a] #-}
-</programlisting>  
-The last of these examples will generate a 
-RULE with a somewhat-complex left-hand side (try it yourself), so it might not fire very
-well.  If you use this kind of specialisation, let us know how well it works.
-</para>
-
-<para>A <literal>SPECIALIZE</literal> pragma can optionally be followed with a
-<literal>INLINE</literal> or <literal>NOINLINE</literal> pragma, optionally 
-followed by a phase, as described in <xref linkend="inline-noinline-pragma"/>.
-The <literal>INLINE</literal> pragma affects the specialised verison of the
-function (only), and applies even if the function is recursive.  The motivating
-example is this:
-<programlisting>
--- A GADT for arrays with type-indexed representation
-data Arr e where
-  ArrInt :: !Int -> ByteArray# -> Arr Int
-  ArrPair :: !Int -> Arr e1 -> Arr e2 -> Arr (e1, e2)
-
-(!:) :: Arr e -> Int -> e
-{-# SPECIALISE INLINE (!:) :: Arr Int -> Int -> Int #-}
-{-# SPECIALISE INLINE (!:) :: Arr (a, b) -> Int -> (a, b) #-}
-(ArrInt _ ba)     !: (I# i) = I# (indexIntArray# ba i)
-(ArrPair _ a1 a2) !: i      = (a1 !: i, a2 !: i)
-</programlisting>
-Here, <literal>(!:)</literal> is a recursive function that indexes arrays
-of type <literal>Arr e</literal>.  Consider a call to  <literal>(!:)</literal>
-at type <literal>(Int,Int)</literal>.  The second specialisation will fire, and
-the specialised function will be inlined.  It has two calls to
-<literal>(!:)</literal>,
-both at type <literal>Int</literal>.  Both these calls fire the first
-specialisation, whose body is also inlined.  The result is a type-based
-unrolling of the indexing function.</para>
-<para>Warning: you can make GHC diverge by using <literal>SPECIALISE INLINE</literal>
-on an ordinarily-recursive function.</para>
-
-      <para>Note: In earlier versions of GHC, it was possible to provide your own
-      specialised function for a given type:
-
-<programlisting>
-{-# SPECIALIZE hammeredLookup :: [(Int, value)] -> Int -> value = intLookup #-}
-</programlisting>
-
-      This feature has been removed, as it is now subsumed by the
-      <literal>RULES</literal> pragma (see <xref linkend="rule-spec"/>).</para>
-
-    </sect2>
-
-<sect2 id="specialize-instance-pragma">
-<title>SPECIALIZE instance pragma
-</title>
-
-<para>
-<indexterm><primary>SPECIALIZE pragma</primary></indexterm>
-<indexterm><primary>overloading, death to</primary></indexterm>
-Same idea, except for instance declarations.  For example:
-
-<programlisting>
-instance (Eq a) => Eq (Foo a) where { 
-   {-# SPECIALIZE instance Eq (Foo [(Int, Bar)]) #-}
-   ... usual stuff ...
- }
-</programlisting>
-The pragma must occur inside the <literal>where</literal> part
-of the instance declaration.
-</para>
-<para>
-Compatible with HBC, by the way, except perhaps in the placement
-of the pragma.
-</para>
-
-</sect2>
-
-    <sect2 id="unpack-pragma">
-      <title>UNPACK pragma</title>
-
-      <indexterm><primary>UNPACK</primary></indexterm>
-      
-      <para>The <literal>UNPACK</literal> indicates to the compiler
-      that it should unpack the contents of a constructor field into
-      the constructor itself, removing a level of indirection.  For
-      example:</para>
-
-<programlisting>
-data T = T {-# UNPACK #-} !Float
-           {-# UNPACK #-} !Float
-</programlisting>
-
-      <para>will create a constructor <literal>T</literal> containing
-      two unboxed floats.  This may not always be an optimisation: if
-      the <function>T</function> constructor is scrutinised and the
-      floats passed to a non-strict function for example, they will
-      have to be reboxed (this is done automatically by the
-      compiler).</para>
-
-      <para>Unpacking constructor fields should only be used in
-      conjunction with <option>-O</option>, in order to expose
-      unfoldings to the compiler so the reboxing can be removed as
-      often as possible.  For example:</para>
-
-<programlisting>
-f :: T -&#62; Float
-f (T f1 f2) = f1 + f2
-</programlisting>
-
-      <para>The compiler will avoid reboxing <function>f1</function>
-      and <function>f2</function> by inlining <function>+</function>
-      on floats, but only when <option>-O</option> is on.</para>
-
-      <para>Any single-constructor data is eligible for unpacking; for
-      example</para>
-
-<programlisting>
-data T = T {-# UNPACK #-} !(Int,Int)
-</programlisting>
-
-      <para>will store the two <literal>Int</literal>s directly in the
-      <function>T</function> constructor, by flattening the pair.
-      Multi-level unpacking is also supported:</para>
-
-<programlisting>
-data T = T {-# UNPACK #-} !S
-data S = S {-# UNPACK #-} !Int {-# UNPACK #-} !Int
-</programlisting>
-
-      <para>will store two unboxed <literal>Int&num;</literal>s
-      directly in the <function>T</function> constructor.  The
-      unpacker can see through newtypes, too.</para>
-
-      <para>If a field cannot be unpacked, you will not get a warning,
-      so it might be an idea to check the generated code with
-      <option>-ddump-simpl</option>.</para>
-
-      <para>See also the <option>-funbox-strict-fields</option> flag,
-      which essentially has the effect of adding
-      <literal>{-#&nbsp;UNPACK&nbsp;#-}</literal> to every strict
-      constructor field.</para>
-    </sect2>
-
-</sect1>
-
-<!--  ======================= REWRITE RULES ======================== -->
-
-<sect1 id="rewrite-rules">
-<title>Rewrite rules
-
-<indexterm><primary>RULES pragma</primary></indexterm>
-<indexterm><primary>pragma, RULES</primary></indexterm>
-<indexterm><primary>rewrite rules</primary></indexterm></title>
-
-<para>
-The programmer can specify rewrite rules as part of the source program
-(in a pragma).  GHC applies these rewrite rules wherever it can, provided (a) 
-the <option>-O</option> flag (<xref linkend="options-optimise"/>) is on, 
-and (b) the <option>-frules-off</option> flag
-(<xref linkend="options-f"/>) is not specified.
-</para>
-
-<para>
-Here is an example:
-
-<programlisting>
-  {-# RULES
-        "map/map"       forall f g xs. map f (map g xs) = map (f.g) xs
-  #-}
-</programlisting>
-
-</para>
-
-<sect2>
-<title>Syntax</title>
-
-<para>
-From a syntactic point of view:
-
-<itemizedlist>
-<listitem>
-
-<para>
- There may be zero or more rules in a <literal>RULES</literal> pragma.
-</para>
-</listitem>
-
-<listitem>
-
-<para>
- Each rule has a name, enclosed in double quotes.  The name itself has
-no significance at all.  It is only used when reporting how many times the rule fired.
-</para>
-</listitem>
-
-<listitem>
-<para>
-A rule may optionally have a phase-control number (see <xref linkend="phase-control"/>),
-immediately after the name of the rule.  Thus:
-<programlisting>
-  {-# RULES
-        "map/map" [2]  forall f g xs. map f (map g xs) = map (f.g) xs
-  #-}
-</programlisting>
-The "[2]" means that the rule is active in Phase 2 and subsequent phases.  The inverse
-notation "[~2]" is also accepted, meaning that the rule is active up to, but not including,
-Phase 2.
-</para>
-</listitem>
-
-
-<listitem>
-
-<para>
- Layout applies in a <literal>RULES</literal> pragma.  Currently no new indentation level
-is set, so you must lay out your rules starting in the same column as the
-enclosing definitions.
-</para>
-</listitem>
-
-<listitem>
-
-<para>
- Each variable mentioned in a rule must either be in scope (e.g. <function>map</function>),
-or bound by the <literal>forall</literal> (e.g. <function>f</function>, <function>g</function>, <function>xs</function>).  The variables bound by
-the <literal>forall</literal> are called the <emphasis>pattern</emphasis> variables.  They are separated
-by spaces, just like in a type <literal>forall</literal>.
-</para>
-</listitem>
-<listitem>
-
-<para>
- A pattern variable may optionally have a type signature.
-If the type of the pattern variable is polymorphic, it <emphasis>must</emphasis> have a type signature.
-For example, here is the <literal>foldr/build</literal> rule:
-
-<programlisting>
-"fold/build"  forall k z (g::forall b. (a->b->b) -> b -> b) .
-              foldr k z (build g) = g k z
-</programlisting>
-
-Since <function>g</function> has a polymorphic type, it must have a type signature.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
-The left hand side of a rule must consist of a top-level variable applied
-to arbitrary expressions.  For example, this is <emphasis>not</emphasis> OK:
-
-<programlisting>
-"wrong1"   forall e1 e2.  case True of { True -> e1; False -> e2 } = e1
-"wrong2"   forall f.      f True = True
-</programlisting>
-
-In <literal>"wrong1"</literal>, the LHS is not an application; in <literal>"wrong2"</literal>, the LHS has a pattern variable
-in the head.
-</para>
-</listitem>
-<listitem>
-
-<para>
- A rule does not need to be in the same module as (any of) the
-variables it mentions, though of course they need to be in scope.
-</para>
-</listitem>
-<listitem>
-
-<para>
- Rules are automatically exported from a module, just as instance declarations are.
-</para>
-</listitem>
-
-</itemizedlist>
-
-</para>
-
-</sect2>
-
-<sect2>
-<title>Semantics</title>
-
-<para>
-From a semantic point of view:
-
-<itemizedlist>
-<listitem>
-
-<para>
-Rules are only applied if you use the <option>-O</option> flag.
-</para>
-</listitem>
-
-<listitem>
-<para>
- Rules are regarded as left-to-right rewrite rules.
-When GHC finds an expression that is a substitution instance of the LHS
-of a rule, it replaces the expression by the (appropriately-substituted) RHS.
-By "a substitution instance" we mean that the LHS can be made equal to the
-expression by substituting for the pattern variables.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- The LHS and RHS of a rule are typechecked, and must have the
-same type.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- GHC makes absolutely no attempt to verify that the LHS and RHS
-of a rule have the same meaning.  That is undecidable in general, and
-infeasible in most interesting cases.  The responsibility is entirely the programmer's!
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- GHC makes no attempt to make sure that the rules are confluent or
-terminating.  For example:
-
-<programlisting>
-  "loop"        forall x,y.  f x y = f y x
-</programlisting>
-
-This rule will cause the compiler to go into an infinite loop.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- If more than one rule matches a call, GHC will choose one arbitrarily to apply.
-
-</para>
-</listitem>
-<listitem>
-<para>
- GHC currently uses a very simple, syntactic, matching algorithm
-for matching a rule LHS with an expression.  It seeks a substitution
-which makes the LHS and expression syntactically equal modulo alpha
-conversion.  The pattern (rule), but not the expression, is eta-expanded if
-necessary.  (Eta-expanding the expression can lead to laziness bugs.)
-But not beta conversion (that's called higher-order matching).
-</para>
-
-<para>
-Matching is carried out on GHC's intermediate language, which includes
-type abstractions and applications.  So a rule only matches if the
-types match too.  See <xref linkend="rule-spec"/> below.
-</para>
-</listitem>
-<listitem>
-
-<para>
- GHC keeps trying to apply the rules as it optimises the program.
-For example, consider:
-
-<programlisting>
-  let s = map f
-      t = map g
-  in
-  s (t xs)
-</programlisting>
-
-The expression <literal>s (t xs)</literal> does not match the rule <literal>"map/map"</literal>, but GHC
-will substitute for <varname>s</varname> and <varname>t</varname>, giving an expression which does match.
-If <varname>s</varname> or <varname>t</varname> was (a) used more than once, and (b) large or a redex, then it would
-not be substituted, and the rule would not fire.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- In the earlier phases of compilation, GHC inlines <emphasis>nothing
-that appears on the LHS of a rule</emphasis>, because once you have substituted
-for something you can't match against it (given the simple minded
-matching).  So if you write the rule
-
-<programlisting>
-        "map/map"       forall f,g.  map f . map g = map (f.g)
-</programlisting>
-
-this <emphasis>won't</emphasis> match the expression <literal>map f (map g xs)</literal>.
-It will only match something written with explicit use of ".".
-Well, not quite.  It <emphasis>will</emphasis> match the expression
-
-<programlisting>
-wibble f g xs
-</programlisting>
-
-where <function>wibble</function> is defined:
-
-<programlisting>
-wibble f g = map f . map g
-</programlisting>
-
-because <function>wibble</function> will be inlined (it's small).
-
-Later on in compilation, GHC starts inlining even things on the
-LHS of rules, but still leaves the rules enabled.  This inlining
-policy is controlled by the per-simplification-pass flag <option>-finline-phase</option><emphasis>n</emphasis>.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- All rules are implicitly exported from the module, and are therefore
-in force in any module that imports the module that defined the rule, directly
-or indirectly.  (That is, if A imports B, which imports C, then C's rules are
-in force when compiling A.)  The situation is very similar to that for instance
-declarations.
-</para>
-</listitem>
-
-</itemizedlist>
-
-</para>
-
-</sect2>
-
-<sect2>
-<title>List fusion</title>
-
-<para>
-The RULES mechanism is used to implement fusion (deforestation) of common list functions.
-If a "good consumer" consumes an intermediate list constructed by a "good producer", the
-intermediate list should be eliminated entirely.
-</para>
-
-<para>
-The following are good producers:
-
-<itemizedlist>
-<listitem>
-
-<para>
- List comprehensions
-</para>
-</listitem>
-<listitem>
-
-<para>
- Enumerations of <literal>Int</literal> and <literal>Char</literal> (e.g. <literal>['a'..'z']</literal>).
-</para>
-</listitem>
-<listitem>
-
-<para>
- Explicit lists (e.g. <literal>[True, False]</literal>)
-</para>
-</listitem>
-<listitem>
-
-<para>
- The cons constructor (e.g <literal>3:4:[]</literal>)
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>++</function>
-</para>
-</listitem>
-
-<listitem>
-<para>
- <function>map</function>
-</para>
-</listitem>
-
-<listitem>
-<para>
- <function>filter</function>
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>iterate</function>, <function>repeat</function>
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>zip</function>, <function>zipWith</function>
-</para>
-</listitem>
-
-</itemizedlist>
-
-</para>
-
-<para>
-The following are good consumers:
-
-<itemizedlist>
-<listitem>
-
-<para>
- List comprehensions
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>array</function> (on its second argument)
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>length</function>
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>++</function> (on its first argument)
-</para>
-</listitem>
-
-<listitem>
-<para>
- <function>foldr</function>
-</para>
-</listitem>
-
-<listitem>
-<para>
- <function>map</function>
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>filter</function>
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>concat</function>
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>unzip</function>, <function>unzip2</function>, <function>unzip3</function>, <function>unzip4</function>
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>zip</function>, <function>zipWith</function> (but on one argument only; if both are good producers, <function>zip</function>
-will fuse with one but not the other)
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>partition</function>
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>head</function>
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>and</function>, <function>or</function>, <function>any</function>, <function>all</function>
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>sequence&lowbar;</function>
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>msum</function>
-</para>
-</listitem>
-<listitem>
-
-<para>
- <function>sortBy</function>
-</para>
-</listitem>
-
-</itemizedlist>
-
-</para>
-
- <para>
-So, for example, the following should generate no intermediate lists:
-
-<programlisting>
-array (1,10) [(i,i*i) | i &#60;- map (+ 1) [0..9]]
-</programlisting>
-
-</para>
-
-<para>
-This list could readily be extended; if there are Prelude functions that you use
-a lot which are not included, please tell us.
-</para>
-
-<para>
-If you want to write your own good consumers or producers, look at the
-Prelude definitions of the above functions to see how to do so.
-</para>
-
-</sect2>
-
-<sect2 id="rule-spec">
-<title>Specialisation
-</title>
-
-<para>
-Rewrite rules can be used to get the same effect as a feature
-present in earlier versions of GHC.
-For example, suppose that:
-
-<programlisting>
-genericLookup :: Ord a => Table a b   -> a   -> b
-intLookup     ::          Table Int b -> Int -> b
-</programlisting>
-
-where <function>intLookup</function> is an implementation of
-<function>genericLookup</function> that works very fast for
-keys of type <literal>Int</literal>.  You might wish
-to tell GHC to use <function>intLookup</function> instead of
-<function>genericLookup</function> whenever the latter was called with
-type <literal>Table Int b -&gt; Int -&gt; b</literal>.
-It used to be possible to write
-
-<programlisting>
-{-# SPECIALIZE genericLookup :: Table Int b -> Int -> b = intLookup #-}
-</programlisting>
-
-This feature is no longer in GHC, but rewrite rules let you do the same thing:
-
-<programlisting>
-{-# RULES "genericLookup/Int" genericLookup = intLookup #-}
-</programlisting>
-
-This slightly odd-looking rule instructs GHC to replace
-<function>genericLookup</function> by <function>intLookup</function>
-<emphasis>whenever the types match</emphasis>.
-What is more, this rule does not need to be in the same
-file as <function>genericLookup</function>, unlike the
-<literal>SPECIALIZE</literal> pragmas which currently do (so that they
-have an original definition available to specialise).
-</para>
-
-<para>It is <emphasis>Your Responsibility</emphasis> to make sure that
-<function>intLookup</function> really behaves as a specialised version
-of <function>genericLookup</function>!!!</para>
-
-<para>An example in which using <literal>RULES</literal> for
-specialisation will Win Big:
-
-<programlisting>
-toDouble :: Real a => a -> Double
-toDouble = fromRational . toRational
-
-{-# RULES "toDouble/Int" toDouble = i2d #-}
-i2d (I# i) = D# (int2Double# i) -- uses Glasgow prim-op directly
-</programlisting>
-
-The <function>i2d</function> function is virtually one machine
-instruction; the default conversion&mdash;via an intermediate
-<literal>Rational</literal>&mdash;is obscenely expensive by
-comparison.
-</para>
-
-</sect2>
-
-<sect2>
-<title>Controlling what's going on</title>
-
-<para>
-
-<itemizedlist>
-<listitem>
-
-<para>
- Use <option>-ddump-rules</option> to see what transformation rules GHC is using.
-</para>
-</listitem>
-<listitem>
-
-<para>
- Use <option>-ddump-simpl-stats</option> to see what rules are being fired.
-If you add <option>-dppr-debug</option> you get a more detailed listing.
-</para>
-</listitem>
-<listitem>
-
-<para>
- The definition of (say) <function>build</function> in <filename>GHC/Base.lhs</filename> looks llike this:
-
-<programlisting>
-        build   :: forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
-        {-# INLINE build #-}
-        build g = g (:) []
-</programlisting>
-
-Notice the <literal>INLINE</literal>!  That prevents <literal>(:)</literal> from being inlined when compiling
-<literal>PrelBase</literal>, so that an importing module will &ldquo;see&rdquo; the <literal>(:)</literal>, and can
-match it on the LHS of a rule.  <literal>INLINE</literal> prevents any inlining happening
-in the RHS of the <literal>INLINE</literal> thing.  I regret the delicacy of this.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- In <filename>libraries/base/GHC/Base.lhs</filename> look at the rules for <function>map</function> to
-see how to write rules that will do fusion and yet give an efficient
-program even if fusion doesn't happen.  More rules in <filename>GHC/List.lhs</filename>.
-</para>
-</listitem>
-
-</itemizedlist>
-
-</para>
-
-</sect2>
-
-<sect2 id="core-pragma">
-  <title>CORE pragma</title>
-
-  <indexterm><primary>CORE pragma</primary></indexterm>
-  <indexterm><primary>pragma, CORE</primary></indexterm>
-  <indexterm><primary>core, annotation</primary></indexterm>
-
-<para>
-  The external core format supports <quote>Note</quote> annotations;
-  the <literal>CORE</literal> pragma gives a way to specify what these
-  should be in your Haskell source code.  Syntactically, core
-  annotations are attached to expressions and take a Haskell string
-  literal as an argument.  The following function definition shows an
-  example:
-
-<programlisting>
-f x = ({-# CORE "foo" #-} show) ({-# CORE "bar" #-} x)
-</programlisting>
-
-  Semantically, this is equivalent to:
-
-<programlisting>
-g x = show x
-</programlisting>
-</para>
-
-<para>
-  However, when external for is generated (via
-  <option>-fext-core</option>), there will be Notes attached to the
-  expressions <function>show</function> and <varname>x</varname>.
-  The core function declaration for <function>f</function> is:
-</para>
-
-<programlisting>
-  f :: %forall a . GHCziShow.ZCTShow a ->
-                   a -> GHCziBase.ZMZN GHCziBase.Char =
-    \ @ a (zddShow::GHCziShow.ZCTShow a) (eta::a) ->
-        (%note "foo"
-         %case zddShow %of (tpl::GHCziShow.ZCTShow a)
-           {GHCziShow.ZCDShow
-            (tpl1::GHCziBase.Int ->
-                   a ->
-                   GHCziBase.ZMZN GHCziBase.Char -> GHCziBase.ZMZN GHCziBase.Cha
-r)
-            (tpl2::a -> GHCziBase.ZMZN GHCziBase.Char)
-            (tpl3::GHCziBase.ZMZN a ->
-                   GHCziBase.ZMZN GHCziBase.Char -> GHCziBase.ZMZN GHCziBase.Cha
-r) ->
-              tpl2})
-        (%note "foo"
-         eta);
-</programlisting>
-
-<para>
-  Here, we can see that the function <function>show</function> (which
-  has been expanded out to a case expression over the Show dictionary)
-  has a <literal>%note</literal> attached to it, as does the
-  expression <varname>eta</varname> (which used to be called
-  <varname>x</varname>).
-</para>
-
-</sect2>
-
-</sect1>
-
-<sect1 id="generic-classes">
-<title>Generic classes</title>
-
-    <para>(Note: support for generic classes is currently broken in
-    GHC 5.02).</para>
-
-<para>
-The ideas behind this extension are described in detail in "Derivable type classes",
-Ralf Hinze and Simon Peyton Jones, Haskell Workshop, Montreal Sept 2000, pp94-105.
-An example will give the idea:
-</para>
-
-<programlisting>
-  import Generics
-
-  class Bin a where
-    toBin   :: a -> [Int]
-    fromBin :: [Int] -> (a, [Int])
-  
-    toBin {| Unit |}    Unit	  = []
-    toBin {| a :+: b |} (Inl x)   = 0 : toBin x
-    toBin {| a :+: b |} (Inr y)   = 1 : toBin y
-    toBin {| a :*: b |} (x :*: y) = toBin x ++ toBin y
-  
-    fromBin {| Unit |}    bs      = (Unit, bs)
-    fromBin {| a :+: b |} (0:bs)  = (Inl x, bs')    where (x,bs') = fromBin bs
-    fromBin {| a :+: b |} (1:bs)  = (Inr y, bs')    where (y,bs') = fromBin bs
-    fromBin {| a :*: b |} bs	  = (x :*: y, bs'') where (x,bs' ) = fromBin bs
-							  (y,bs'') = fromBin bs'
-</programlisting>
-<para>
-This class declaration explains how <literal>toBin</literal> and <literal>fromBin</literal>
-work for arbitrary data types.  They do so by giving cases for unit, product, and sum,
-which are defined thus in the library module <literal>Generics</literal>:
-</para>
-<programlisting>
-  data Unit    = Unit
-  data a :+: b = Inl a | Inr b
-  data a :*: b = a :*: b
-</programlisting>
-<para>
-Now you can make a data type into an instance of Bin like this:
-<programlisting>
-  instance (Bin a, Bin b) => Bin (a,b)
-  instance Bin a => Bin [a]
-</programlisting>
-That is, just leave off the "where" clause.  Of course, you can put in the
-where clause and over-ride whichever methods you please.
-</para>
-
-    <sect2>
-      <title> Using generics </title>
-      <para>To use generics you need to</para>
-      <itemizedlist>
-	<listitem>
-	  <para>Use the flags <option>-fglasgow-exts</option> (to enable the extra syntax), 
-                <option>-fgenerics</option> (to generate extra per-data-type code),
-                and <option>-package lang</option> (to make the <literal>Generics</literal> library
-                available.  </para>
-	</listitem>
-	<listitem>
-	  <para>Import the module <literal>Generics</literal> from the
-          <literal>lang</literal> package.  This import brings into
-          scope the data types <literal>Unit</literal>,
-          <literal>:*:</literal>, and <literal>:+:</literal>.  (You
-          don't need this import if you don't mention these types
-          explicitly; for example, if you are simply giving instance
-          declarations.)</para>
-	</listitem>
-      </itemizedlist>
-    </sect2>
-
-<sect2> <title> Changes wrt the paper </title>
-<para>
-Note that the type constructors <literal>:+:</literal> and <literal>:*:</literal> 
-can be written infix (indeed, you can now use
-any operator starting in a colon as an infix type constructor).  Also note that
-the type constructors are not exactly as in the paper (Unit instead of 1, etc).
-Finally, note that the syntax of the type patterns in the class declaration
-uses "<literal>{|</literal>" and "<literal>|}</literal>" brackets; curly braces
-alone would ambiguous when they appear on right hand sides (an extension we 
-anticipate wanting).
-</para>
-</sect2>
-
-<sect2> <title>Terminology and restrictions</title>
-<para>
-Terminology.  A "generic default method" in a class declaration
-is one that is defined using type patterns as above.
-A "polymorphic default method" is a default method defined as in Haskell 98.
-A "generic class declaration" is a class declaration with at least one
-generic default method.
-</para>
-
-<para>
-Restrictions:
-<itemizedlist>
-<listitem>
-<para>
-Alas, we do not yet implement the stuff about constructor names and 
-field labels.
-</para>
-</listitem>
-
-<listitem>
-<para>
-A generic class can have only one parameter; you can't have a generic
-multi-parameter class.
-</para>
-</listitem>
-
-<listitem>
-<para>
-A default method must be defined entirely using type patterns, or entirely
-without.  So this is illegal:
-<programlisting>
-  class Foo a where
-    op :: a -> (a, Bool)
-    op {| Unit |} Unit = (Unit, True)
-    op x               = (x,    False)
-</programlisting>
-However it is perfectly OK for some methods of a generic class to have 
-generic default methods and others to have polymorphic default methods.
-</para>
-</listitem>
-
-<listitem>
-<para>
-The type variable(s) in the type pattern for a generic method declaration
-scope over the right hand side.  So this is legal (note the use of the type variable ``p'' in a type signature on the right hand side:
-<programlisting>
-  class Foo a where
-    op :: a -> Bool
-    op {| p :*: q |} (x :*: y) = op (x :: p)
-    ...
-</programlisting>
-</para>
-</listitem>
-
-<listitem>
-<para>
-The type patterns in a generic default method must take one of the forms:
-<programlisting>
-       a :+: b
-       a :*: b
-       Unit
-</programlisting>
-where "a" and "b" are type variables.  Furthermore, all the type patterns for
-a single type constructor (<literal>:*:</literal>, say) must be identical; they
-must use the same type variables.  So this is illegal:
-<programlisting>
-  class Foo a where
-    op :: a -> Bool
-    op {| a :+: b |} (Inl x) = True
-    op {| p :+: q |} (Inr y) = False
-</programlisting>
-The type patterns must be identical, even in equations for different methods of the class.
-So this too is illegal:
-<programlisting>
-  class Foo a where
-    op1 :: a -> Bool
-    op1 {| a :*: b |} (x :*: y) = True
-
-    op2 :: a -> Bool
-    op2 {| p :*: q |} (x :*: y) = False
-</programlisting>
-(The reason for this restriction is that we gather all the equations for a particular type consructor
-into a single generic instance declaration.)
-</para>
-</listitem>
-
-<listitem>
-<para>
-A generic method declaration must give a case for each of the three type constructors.
-</para>
-</listitem>
-
-<listitem>
-<para>
-The type for a generic method can be built only from:
-  <itemizedlist>
-  <listitem> <para> Function arrows </para> </listitem>
-  <listitem> <para> Type variables </para> </listitem>
-  <listitem> <para> Tuples </para> </listitem>
-  <listitem> <para> Arbitrary types not involving type variables </para> </listitem>
-  </itemizedlist>
-Here are some example type signatures for generic methods:
-<programlisting>
-    op1 :: a -> Bool
-    op2 :: Bool -> (a,Bool)
-    op3 :: [Int] -> a -> a
-    op4 :: [a] -> Bool
-</programlisting>
-Here, op1, op2, op3 are OK, but op4 is rejected, because it has a type variable
-inside a list.  
-</para>
-<para>
-This restriction is an implementation restriction: we just havn't got around to
-implementing the necessary bidirectional maps over arbitrary type constructors.
-It would be relatively easy to add specific type constructors, such as Maybe and list,
-to the ones that are allowed.</para>
-</listitem>
-
-<listitem>
-<para>
-In an instance declaration for a generic class, the idea is that the compiler
-will fill in the methods for you, based on the generic templates.  However it can only
-do so if
-  <itemizedlist>
-  <listitem>
-  <para>
-  The instance type is simple (a type constructor applied to type variables, as in Haskell 98).
-  </para>
-  </listitem>
-  <listitem>
-  <para>
-  No constructor of the instance type has unboxed fields.
-  </para>
-  </listitem>
-  </itemizedlist>
-(Of course, these things can only arise if you are already using GHC extensions.)
-However, you can still give an instance declarations for types which break these rules,
-provided you give explicit code to override any generic default methods.
-</para>
-</listitem>
-
-</itemizedlist>
-</para>
-
-<para>
-The option <option>-ddump-deriv</option> dumps incomprehensible stuff giving details of 
-what the compiler does with generic declarations.
-</para>
-
-</sect2>
-
-<sect2> <title> Another example </title>
-<para>
-Just to finish with, here's another example I rather like:
-<programlisting>
-  class Tag a where
-    nCons :: a -> Int
-    nCons {| Unit |}    _ = 1
-    nCons {| a :*: b |} _ = 1
-    nCons {| a :+: b |} _ = nCons (bot::a) + nCons (bot::b)
-  
-    tag :: a -> Int
-    tag {| Unit |}    _       = 1
-    tag {| a :*: b |} _       = 1   
-    tag {| a :+: b |} (Inl x) = tag x
-    tag {| a :+: b |} (Inr y) = nCons (bot::a) + tag y
-</programlisting>
-</para>
-</sect2>
-</sect1>
-
-
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter" "sect1") ***
-     ;;; End: ***
- -->
-
diff --git a/ghc/docs/users_guide/gone_wrong.xml b/ghc/docs/users_guide/gone_wrong.xml
deleted file mode 100644
index d31087c164..0000000000
--- a/ghc/docs/users_guide/gone_wrong.xml
+++ /dev/null
@@ -1,213 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<chapter id="wrong">
-  <title>What to do when something goes wrong</title>
-
-  <indexterm><primary>problems</primary></indexterm>
-
-  <para>If you still have a problem after consulting this section,
-  then you may have found a <emphasis>bug</emphasis>&mdash;please
-  report it!  See <xref linkend="bug-reporting"/> for details on how to
-  report a bug and a list of things we'd like to know about your bug.
-  If in doubt, send a report&mdash;we love mail from irate users
-  :-!</para>
-
-  <para>(<xref linkend="vs-Haskell-defn"/>, which describes Glasgow
-  Haskell's shortcomings vs.&nbsp;the Haskell language definition, may
-  also be of interest.)</para>
-
-  <sect1 id="wrong-compiler">
-    <title>When the compiler &ldquo;does the wrong thing&rdquo;</title>
-
-    <indexterm><primary>compiler problems</primary></indexterm>
-    <indexterm><primary>problems with the compiler</primary></indexterm>
-
-    <variablelist>
-      <varlistentry>
-	<term>&ldquo;Help! The compiler crashed (or `panic'd)!&rdquo;</term>
-	<listitem>
-	  <para>These events are <emphasis>always</emphasis> bugs in
-	  the GHC system&mdash;please report them.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>&ldquo;This is a terrible error message.&rdquo;</term>
-	<listitem>
-	  <para>If you think that GHC could have produced a better
-          error message, please report it as a bug.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>&ldquo;What about this warning from the C
-	compiler?&rdquo;</term>
-	<listitem>
-	  <para>For example: &ldquo;&hellip;warning: `Foo' declared
-          `static' but never defined.&rdquo; Unsightly, but shouldn't
-          be a problem.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Sensitivity to <filename>.hi</filename> interface files:</term>
-	<listitem>
-	  <para>GHC is very sensitive about interface files.  For
-          example, if it picks up a non-standard
-          <filename>Prelude.hi</filename> file, pretty terrible things
-          will happen.  If you turn on
-          <option>-fno-implicit-prelude</option><indexterm><primary>-fno-implicit-prelude
-          option</primary></indexterm>, the compiler will almost
-          surely die, unless you know what you are doing.</para>
-
-	  <para>Furthermore, as sketched below, you may have big
-          problems running programs compiled using unstable
-          interfaces.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>&ldquo;I think GHC is producing incorrect code&rdquo;:</term>
-	<listitem>
-	  <para>Unlikely :-) A useful be-more-paranoid option to give
-          to GHC is
-          <option>-dcore-lint</option><indexterm><primary>-dcore-lint
-          option</primary></indexterm>; this causes a
-          &ldquo;lint&rdquo; pass to check for errors (notably type
-          errors) after each Core-to-Core transformation pass.  We run
-          with <option>-dcore-lint</option> on all the time; it costs
-          about 5&percnt; in compile time.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>&ldquo;Why did I get a link error?&rdquo;</term>
-	<listitem>
-	  <para>If the linker complains about not finding
-          <literal>&lowbar;&lt;something&gt;&lowbar;fast</literal>,
-          then something is inconsistent: you probably didn't compile
-          modules in the proper dependency order.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>&ldquo;Is this line number right?&rdquo;</term>
-	<listitem>
-	  <para>On this score, GHC usually does pretty well,
-          especially if you &ldquo;allow&rdquo; it to be off by one or
-          two.  In the case of an instance or class declaration, the
-          line number may only point you to the declaration, not to a
-          specific method.</para>
-
-	  <para>Please report line-number errors that you find
-	  particularly unhelpful.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-  </sect1>
-
-  <sect1 id="wrong-compilee">
-    <title>When your program &ldquo;does the wrong thing&rdquo;</title>
-
-    <indexterm><primary>problems running your program</primary></indexterm>
-
-    <para>(For advice about overly slow or memory-hungry Haskell
-    programs, please see <xref
-    linkend="sooner-faster-quicker"/>).</para>
-
-    <variablelist>
-
-      <varlistentry>
-	<term>&ldquo;Help! My program crashed!&rdquo;</term>
-	<listitem>
-	  <para>(e.g., a `segmentation fault' or `core dumped')
-          <indexterm><primary>segmentation
-          fault</primary></indexterm></para>
-
-	  <para>If your program has no foreign calls in it, and no
-          calls to known-unsafe functions (such as
-          <literal>unsafePerformIO</literal>) then a crash is always a
-          BUG in the GHC system, except in one case: If your program
-          is made of several modules, each module must have been
-          compiled after any modules on which it depends (unless you
-          use <filename>.hi-boot</filename> files, in which case these
-          <emphasis>must</emphasis> be correct with respect to the
-          module source).</para>
-
-	  <para>For example, if an interface is lying about the type
-          of an imported value then GHC may well generate duff code
-          for the importing module.  <emphasis>This applies to pragmas
-          inside interfaces too!</emphasis> If the pragma is lying
-          (e.g., about the &ldquo;arity&rdquo; of a value), then duff
-          code may result.  Furthermore, arities may change even if
-          types do not.</para>
-
-	  <para>In short, if you compile a module and its interface
-          changes, then all the modules that import that interface
-          <emphasis>must</emphasis> be re-compiled.</para>
-
-	  <para>A useful option to alert you when interfaces change is
-          <option>-hi-diffs</option><indexterm><primary>-hi-diffs
-          option</primary></indexterm>.  It will run
-          <command>diff</command> on the changed interface file,
-          before and after, when applicable.</para>
-
-	  <para>If you are using <command>make</command>, GHC can
-          automatically generate the dependencies required in order to
-          make sure that every module <emphasis>is</emphasis>
-          up-to-date with respect to its imported interfaces.  Please
-          see <xref linkend="sec-makefile-dependencies"/>.</para>
-
-	  <para>If you are down to your
-          last-compile-before-a-bug-report, we would recommend that
-          you add a <option>-dcore-lint</option> option (for extra
-          checking) to your compilation options.</para>
-
-	  <para>So, before you report a bug because of a core dump,
-	  you should probably:</para>
-
-<screen>
-% rm *.o        # scrub your object files
-% make my_prog  # re-make your program; use -hi-diffs to highlight changes;
-                # as mentioned above, use -dcore-lint to be more paranoid
-% ./my_prog ... # retry...
-</screen>
-
-	  <para>Of course, if you have foreign calls in your program
-          then all bets are off, because you can trash the heap, the
-          stack, or whatever.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>&ldquo;My program entered an `absent' argument.&rdquo;</term>
-	<listitem>
-	  <para>This is definitely caused by a bug in GHC. Please
-          report it (see <xref linkend="bug-reporting"/>).</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>&ldquo;What's with this `arithmetic (or `floating')
-	exception' &rdquo;?</term>
-	<listitem>
-	  <para><literal>Int</literal>, <literal>Float</literal>, and
-          <literal>Double</literal> arithmetic is
-          <emphasis>unchecked</emphasis>.  Overflows, underflows and
-          loss of precision are either silent or reported as an
-          exception by the operating system (depending on the
-          platform).  Divide-by-zero <emphasis>may</emphasis> cause an
-          untrapped exception (please report it if it does).</para>
-	</listitem>
-      </varlistentry>
-
-    </variablelist>
-  </sect1>
-
-</chapter>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/installing.xml b/ghc/docs/users_guide/installing.xml
deleted file mode 100644
index 9f8e4c9eb8..0000000000
--- a/ghc/docs/users_guide/installing.xml
+++ /dev/null
@@ -1,875 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<chapter id="sec-installing-bin-distrib">
-  <title>Installing GHC</title>
-<indexterm><primary>binary installations</primary></indexterm>
-<indexterm><primary>installation, of binaries</primary></indexterm>
-
-<para>
-Installing from binary distributions is easiest, and recommended!
-(Why binaries? Because GHC is a Haskell compiler written in Haskell,
-so you've got to bootstrap it somehow.  We provide machine-generated
-C-files-from-Haskell for this purpose, but it's really quite a pain to
-use them.  If you must build GHC from its sources, using a
-binary-distributed GHC to do so is a sensible way to proceed. For the
-other <literal>fptools</literal> programs, many are written in
-Haskell, so binary distributions allow you to install them without
-having a Haskell compiler.)
-</para>
-
-<para>This guide is in several parts:</para>
-
-  <itemizedlist>
-    <listitem>
-      <para> Installing on Unix-a-likes (<xref
-      linkend="sec-unix-a-likes"/>). </para>
-    </listitem>
-    <listitem>
-      <para> Installing on Windows (<xref
-      linkend="sec-install-windows"/>).  </para>
-    </listitem>
-    <listitem>
-      <para> The layout of installed files (<xref
-      linkend="sec-install-files"/>).  You don't need to know this to
-      install GHC, but it's useful if you are changing the
-      implementation.</para>
-    </listitem>
-  </itemizedlist>
-  
-  <sect1 id="sec-unix-a-likes"><title>Installing on Unix-a-likes</title>
-
-    <sect2>
-      <title>When a platform-specific package is available</title>
-      
-      <para>For certain platforms, we provide GHC binaries packaged
-      using the native package format for the platform.  This is
-      likely to be by far the best way to install GHC for your
-      platform if one of these packages is available, since
-      dependencies will automatically be handled and the package
-      system normally provides a way to uninstall the package at a
-      later date.</para>
-
-      <para>We generally provide the following packages:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term>RedHat or SuSE Linux/x86</term>
-	  <listitem>
-	    <para>RPM source &amp; binary packages for RedHat and SuSE
-	    Linux (x86 only) are available for most major
-	    releases.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>Debian Linux/x86</term>
-	  <listitem>
-	    <para>Debian packages for Linux (x86 only), also for most
-	    major releases.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>FreeBSD/x86</term>
-	  <listitem>
-	    <para>On FreeBSD/x86, GHC can be installed using either
-	    the ports tree (<literal>cd /usr/ports/lang/ghc &amp;&amp; make
-	    install</literal>) or from a pre-compiled package
-	    available from your local FreeBSD mirror.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-      
-      <para>Other platform-specific packages may be available, check
-      the GHC download page for details.</para>
-    </sect2>
-
-<sect2>
-<title>GHC binary distributions</title>
-
-<para>
-<indexterm><primary>bundles of binary stuff</primary></indexterm>
-</para>
-
-<para>
-Binary distributions come in &ldquo;bundles,&rdquo; one bundle per file called
-<literal><replaceable>bundle</replaceable>-<replaceable>platform</replaceable>.tar.gz</literal>.  (See the building guide for the definition of a platform.)  Suppose that you untar a binary-distribution bundle, thus:
-</para>
-
-<para>
-
-<screen>
-% cd /your/scratch/space
-% gunzip &#60; ghc-x.xx-sun-sparc-solaris2.tar.gz | tar xvf -</screen>
-
-</para>
-
-<para>
-Then you should find a single directory,
-<literal>ghc-<replaceable>version</replaceable></literal>, with the
-following structure:
-</para>
-
-<para>
-<indexterm><primary>binary distribution, layout</primary></indexterm>
-<indexterm><primary>directory layout (binary distributions)</primary></indexterm>
-<variablelist>
-
-<varlistentry>
-<term><literal>Makefile.in</literal></term>
-<listitem>
-<para>
-the raw material from which the <literal>Makefile</literal>
-will be made (<xref linkend="sec-install"/>).
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>configure</literal></term>
-<listitem>
-<para>
-the configuration script (<xref linkend="sec-install"/>).
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>README</literal></term>
-<listitem>
-<para>
-Contains this file summary.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>INSTALL</literal></term>
-<listitem>
-<para>
-Contains this description of how to install
-the bundle.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>ANNOUNCE</literal></term>
-<listitem>
-<para>
-The announcement message for the bundle.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>NEWS</literal></term>
-<listitem>
-<para>
-release notes for the bundle&mdash;a longer version
-of <literal>ANNOUNCE</literal>.  For GHC, the release notes are contained in the User
-Guide and this file isn't present.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-	    <term><literal>bin/<replaceable>platform</replaceable></literal></term>
-<listitem>
-<para>
-contains platform-specific executable
-files to be invoked directly by the user.  These are the files that
-must end up in your path.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>lib/<replaceable>platform</replaceable>/</literal></term>
-<listitem>
-<para>
-contains platform-specific support
-files for the installation.  Typically there is a subdirectory for
-each <literal>fptools</literal> project, whose name is the name of the project with its
-version number.  For example, for GHC there would be a sub-directory
-<literal>ghc-x.xx</literal>/ where <literal>x.xx</literal> is the version number of GHC in the bundle.
-</para>
-
-<para>
-These sub-directories have the following general structure:
-</para>
-
-<para>
-<variablelist>
-
-<varlistentry>
-<term><literal>libHSstd.a</literal> etc:</term>
-<listitem>
-<para>
-supporting library archives.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>ghc-iface.prl</literal> etc:</term>
-<listitem>
-<para>
-support scripts.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>import/</literal></term>
-<listitem>
-<para>
-<indexterm><primary>Interface files</primary></indexterm> (<literal>.hi</literal>) for the prelude.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>include/</literal></term>
-<listitem>
-<para>
-A few C <literal>&num;include</literal> files.
-</para>
-</listitem></varlistentry>
-</variablelist>
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>share/</literal></term>
-<listitem>
-<para>
-contains platform-independent support files
-for the installation.  Again, there is a sub-directory for each
-<literal>fptools</literal> project.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>html/</literal></term>
-<listitem>
-<para>
-contains HTML documentation files (one
-sub-directory per project).
-</para>
-</listitem></varlistentry>
-</variablelist>
-</para>
-
-<sect3 id="sec-install">
-<title>Installing</title>
-
-<para>
-OK, so let's assume that you have unpacked your chosen bundles. What
-next? Well, you will at least need to run the
-<literal>configure</literal><indexterm><primary>configure</primary></indexterm>
-script by changing directory into the top-level directory for the
-bundle and typing <literal>./configure</literal>.  That should convert
-<literal>Makefile.in</literal> to <literal>Makefile</literal>.
-</para>
-
-<para>
-<indexterm><primary>installing in-place</primary></indexterm>
-<indexterm><primary>in-place installation</primary></indexterm>
-You can now either start using the tools <emphasis>in-situ</emphasis> without going
-through any installation process, just type <literal>make in-place</literal> to set the
-tools up for this. You'll also want to add the path which <literal>make</literal> will
-now echo to your <literal>PATH</literal> environment variable. This option is useful if
-you simply want to try out the package and/or you don't have the
-necessary privileges (or inclination) to properly install the tools
-locally. Note that if you do decide to install the package `properly'
-at a later date, you have to go through the installation steps that
-follow.
-</para>
-
-<para>
-To install a package, you'll have to do the following:
-</para>
-
-<para>
-
-<orderedlist>
-<listitem>
-
-<para>
- Edit the <literal>Makefile</literal> and check the settings of the following variables:
-
-<indexterm><primary>directories, installation</primary></indexterm>
-<indexterm><primary>installation directories</primary></indexterm>
-
-<variablelist>
-
-<varlistentry>
-<term><literal>platform</literal></term>
-<listitem>
-<para>
-the platform you are going to install for.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>bindir</literal></term>
-<listitem>
-<para>
-the directory in which to install user-invokable
-binaries.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>libdir</literal></term>
-<listitem>
-<para>
-the directory in which to install
-platform-dependent support files.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>datadir</literal></term>
-<listitem>
-<para>
-the directory in which to install
-platform-independent support files.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>infodir</literal></term>
-<listitem>
-<para>
-the directory in which to install Emacs info
-files.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>htmldir</literal></term>
-<listitem>
-<para>
-the directory in which to install HTML
-documentation.
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>dvidir</literal></term>
-<listitem>
-<para>
-the directory in which to install DVI
-documentation.
-</para>
-</listitem></varlistentry>
-</variablelist>
-
-The values for these variables can be set through invocation of the
-<command>configure</command><indexterm><primary>configure</primary></indexterm>
-script that comes with the distribution, but doing an optical diff to
-see if the values match your expectations is always a Good Idea.
-</para>
-
-<para>
-<emphasis>Instead of running <command>configure</command>, it is
-perfectly OK to copy <filename>Makefile.in</filename> to
-<filename>Makefile</filename> and set all these variables directly
-yourself.  But do it right!</emphasis>
-</para>
-
-</listitem>
-<listitem>
-
-<para>
-Run <literal>make install</literal>.  This <emphasis>
-should</emphasis> work with ordinary Unix
-<literal>make</literal>&mdash;no need for fancy stuff like GNU
-<literal>make</literal>.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
-<literal>rehash</literal> (t?csh or zsh users), so your shell will see the new
-stuff in your bin directory.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- Once done, test your &ldquo;installation&rdquo; as suggested in 
-<xref linkend="sec-GHC-test"/>.  Be sure to use a <literal>-v</literal>
-option, so you can see exactly what pathnames it's using.
-
-If things don't work as expected, check the list of known pitfalls in
-the building guide.
-</para>
-</listitem>
-
-</orderedlist>
-
-</para>
-
-<para>
-<indexterm><primary>link, installed as ghc</primary></indexterm>
-When installing the user-invokable binaries, this installation
-procedure will install GHC as <literal>ghc-x.xx</literal> where <literal>x.xx</literal> is the version
-number of GHC.  It will also make a link (in the binary installation
-directory) from <literal>ghc</literal> to <literal>ghc-x.xx</literal>.  If you install multiple versions
-of GHC then the last one &ldquo;wins&rdquo;, and &ldquo;<literal>ghc</literal>&rdquo; will invoke the last
-one installed.  You can change this manually if you want.  But
-regardless, <literal>ghc-x.xx</literal> should always invoke GHC version <literal>x.xx</literal>.
-</para>
-
-</sect3>
-
-
-<sect3>
-<title>What bundles there are</title>
-
-<para>
-<indexterm><primary>bundles, binary</primary></indexterm> There are
-plenty of &ldquo;non-basic&rdquo; GHC bundles.  The files for them are
-called
-<literal>ghc-x.xx-<replaceable>bundle</replaceable>-<replaceable>platform</replaceable>.tar.gz</literal>,
-where the <replaceable>platform</replaceable> is as above, and
-<replaceable>bundle</replaceable> is one of these:
-</para>
-
-<para>
-<variablelist>
-
-<varlistentry>
-<term><literal>prof</literal>:</term>
-<listitem>
-<para>
-Profiling with cost-centres.  You probably want this.
-<indexterm><primary>profiling bundles</primary></indexterm>
-<indexterm><primary>bundles, profiling</primary></indexterm>
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>par</literal>:</term>
-<listitem>
-<para>
-Parallel Haskell features (sits on top of PVM).
-You'll want this if you're into that kind of thing.
-<indexterm><primary>parallel bundles</primary></indexterm>
-<indexterm><primary>bundles, parallel</primary></indexterm>
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>gran</literal>:</term>
-<listitem>
-<para>
-The &ldquo;GranSim&rdquo; parallel-Haskell simulator
-(hmm&hellip; mainly for implementors).
-<indexterm><primary>bundles, gransim</primary></indexterm>
-<indexterm><primary>gransim bundles</primary></indexterm>
-</para>
-</listitem></varlistentry>
-<varlistentry>
-<term><literal>ticky</literal>:</term>
-<listitem>
-<para>
-&ldquo;Ticky-ticky&rdquo; profiling; very detailed
-information about &ldquo;what happened when I ran this program&rdquo;&mdash;really
-for implementors.
-<indexterm><primary>bundles, ticky-ticky</primary></indexterm>
-<indexterm><primary>ticky-ticky bundles</primary></indexterm>
-</para>
-</listitem></varlistentry>
-</variablelist>
-</para>
-
-<para>
-One likely scenario is that you will grab <emphasis>two</emphasis>
-binary bundles&mdash;basic, and profiling.  We don't usually make the
-rest, although you can build them yourself from a source distribution.
-</para>
-
-<para>The various GHC bundles are designed to be unpacked into the
-same directory; then installing as per the directions above will
-install the whole lot in one go.  Note: you <emphasis>must</emphasis>
-at least have the basic GHC binary distribution bundle, these extra
-bundles won't install on their own.</para>
-
-</sect3>
-
-<sect3 id="sec-GHC-test">
-<title>Testing that GHC seems to be working
-</title>
-
-<para>
-<indexterm><primary>testing a new GHC</primary></indexterm>
-</para>
-
-<para>
-The way to do this is, of course, to compile and run <emphasis>this</emphasis> program
-(in a file <literal>Main.hs</literal>):
-</para>
-
-<para>
-
-<programlisting>
-main = putStr "Hello, world!\n"
-</programlisting>
-
-</para>
-
-<para>
-Compile the program, using the <literal>-v</literal> (verbose) flag to verify that
-libraries, etc., are being found properly:
-
-<screen>
-% ghc -v -o hello Main.hs</screen>
-
-</para>
-
-<para>
-Now run it:
-
-<screen>
-% ./hello
-Hello, world!</screen>
-
-</para>
-
-<para>
-Some simple-but-profitable tests are to compile and run the notorious
-<literal>nfib</literal><indexterm><primary>nfib</primary></indexterm> program, using different numeric types.  Start with
-<literal>nfib :: Int -&gt; Int</literal>, and then try <literal>Integer</literal>, <literal>Float</literal>, <literal>Double</literal>,
-<literal>Rational</literal> and perhaps the overloaded version.  Code for this is
-distributed in <literal>ghc/misc/examples/nfib/</literal> in a source distribution.
-</para>
-
-<para>For more information on how to &ldquo;drive&rdquo; GHC, read
-on...</para>
-
-</sect3>
-
-</sect2>
-
-</sect1>
-
-
-<sect1 id="sec-install-windows"><title>Installing on Windows</title>
-
-<para>
-Getting the Glasgow Haskell Compiler (post 5.02) to run on Windows platforms is
-a snap: the Installshield does everything you need.  
-</para>
-
-<sect2><title>Installing GHC on Windows</title>
-
-<para>
-To install GHC, use the following steps:
-</para>
-<itemizedlist>
-<listitem><para>Download the Installshield <filename>setup.exe</filename>
-from the GHC download page
-<ulink
-url="http://www.haskell.org/ghc">haskell.org</ulink>.
-</para></listitem>
-
-<listitem><para>Run <filename>setup.exe</filename>.
-On Windows, all of GHC's files are installed in a single directory.
-If you choose ``Custom'' from the list of install options, you will be given a 
-choice about where this directory is; otherwise it will be installed 
-in <filename>c:/ghc/<replaceable>ghc-version</replaceable></filename>.
-The executable binary for GHC will be installed in the <filename>bin/</filename> sub-directory
-of the installation directory you choose.
-</para>
-<para>(If you have already installed the same version of GHC, Installshield will offer to "modify", 
-or "remove" GHC.  Choose "remove"; then run <filename>setup.exe</filename> a
-second time.  This time it should offer to install.)
-</para>
-<para>
-When installation is complete, you should find GHCi and the GHC documentation are 
-available in your Start menu under "Start/Programs/Glasgow Haskell Compiler".
-</para>
-</listitem>
-
-<listitem><para>
-The final dialogue box from the install process reminds you where the GHC binary 
-has been installed (usually <filename>c:/ghc/<replaceable>ghc-version</replaceable>/bin/</filename>.  
-If you want to invoke GHC from a command line, add this 
-to your PATH environment variable.  
-</para></listitem>
-
-<listitem><para>
-GHC needs a directory in which to create, and later delete, temporary files.
-It uses the standard Windows procedure <literal>GetTempPath()</literal> to
-find a suitable directory.  This procedure returns:
-<itemizedlist>
-<listitem><para>The path in environment variable TMP, 
-if TMP is set.</para></listitem>
-<listitem><para>Otherwise, the path in environment variable TEMP, 
-if TEMP is set.</para></listitem>
-<listitem><para>Otherwise, there is a per-user default which varies
-between versions of Windows. On NT and XP-ish versions, it might 
-be:
-<filename>c:\Documents and Settings\&lt;username&gt;\Local Settings\Temp</filename>
-</para></listitem>
-</itemizedlist>
-The main point is that if you don't do anything GHC will work fine;
-but if you want to control where the directory is, you can do so by
-setting TMP or TEMP.
-</para></listitem>
-
-<listitem>
-<para>
-To test the fruits of your labour, try now to compile a simple
-Haskell program:
-</para>
-
-<screen>
-bash$ cat main.hs
-module Main(main) where
-
-main = putStrLn "Hello, world!"
-bash$ ghc -o main main.hs
-..
-bash$ ./main
-Hello, world!
-bash$ </screen>
-</listitem>
-</itemizedlist>
-
-<para>
-You do <emphasis>not</emphasis> need the Cygwin toolchain, or anything
-else, to install and run GHC.
-</para>
-<para>
-An installation of GHC requires about 140M of disk space.
-To run GHC comfortably, your machine should have at least
-64M of memory.
-</para>
-</sect2>
-
-<sect2><title>Moving GHC around</title>
-<para>
-At the moment, GHC installs in a fixed place (<filename>c:/ghc/ghc-x.yy</filename>,
-but once it is installed, you can freely move the entire GHC tree just by copying
-the <filename>ghc-x.yy</filename> directory.   (You may need to fix up 
-the links in "Start/Programs/Glasgow Haskell Compiler" if you do this.)
-</para>
-<para>
-It is OK to put GHC tree in a directory whose path involves spaces.  However,
-don't do this if you use want to use GHC with the Cygwin tools, 
-because Cygwin can get confused when this happens.
-We havn't quite got to the bottom of this, but so far as we know it's not 
-a problem with GHC itself.  Nevertheless, just to keep life simple we usually
-put GHC in a place with a space-free path.
-</para>
-</sect2>
-
-<sect2 id="winfaq">
-<title>Installing ghc-win32 FAQ</title>
-
-      <variablelist>
-	<varlistentry>
-	  <term>I'm having trouble with symlinks.</term>
-	  <listitem>
-	    <para>Symlinks only work under Cygwin (<xref linkend="sec-install" />), so binaries not linked to the Cygwin
-	      DLL, in particular those built for Mingwin, will not work with
-	      symlinks.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>I'm getting &ldquo;permission denied&rdquo; messages from the
-	    <command>rm</command> or <command>mv</command>.</term>
-	  <listitem>
-	    <para>This can have various causes: trying to rename a directory
-	      when an Explorer window is open on it tends to fail. Closing the
-	      window generally cures the problem, but sometimes its cause is
-	      more mysterious, and logging off and back on or rebooting may be
-	      the quickest cure.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-<!-- doesn't add much value any longer; leave out [sof 7/2002].
-<para>
-Further information on using GHC under Windows can be found in <ulink
-url="http://www.dcs.gla.ac.uk/~sof/ghc-win32.html">Sigbj&oslash;rn Finne's
-pages</ulink>. Note: ignore the installation instructions, which are rather
-out of date; the <emphasis>Miscellaneous</emphasis> section at the bottom of
-the page is of most interest, covering topics beyond the scope of this
-manual.
-</para>
--->
-</sect2>
-
-</sect1>
-
-
-<sect1 id="sec-install-files"><title>The layout of installed files</title>
-
-<para>
-This section describes what files get installed where.  You don't need to know it
-if you are simply installing GHC, but it is vital information if you are changing
-the implementation.
-</para>
-<para> GHC is installed in two directory trees:</para>
-<variablelist>
-<varlistentry>
-<term>Library directory,</term>
-<listitem> <para> known as <filename>$(libdir)</filename>, holds all the 
-support files needed to run GHC.  On Unix, this 
-directory is usually something like <filename>/usr/lib/ghc/ghc-5.02</filename>. </para>
-</listitem>
-</varlistentry>
-<varlistentry>
-<term>Binary directory</term>
-<listitem> <para> known as <filename>$(bindir)</filename>, holds executables that 
-the user is expected to invoke.
-Notably, it contains
-<filename>ghc</filename> and <filename>ghci</filename>.  On Unix, this directory
-can be anywhere, but is typically something like <filename>/usr/local/bin</filename>.  On Windows,
-however, this directory <emphasis>must be</emphasis> <filename>$(libdir)/bin</filename>.
-</para>
-</listitem>
-</varlistentry>
-</variablelist>
-
-<para>
-When GHC runs, it must know where its library directory is.
-It finds this out in one of two ways:
-</para>
-<itemizedlist>
-<listitem>
-<para>
-<filename>$(libdir)</filename> is passed to GHC using the <option>-B</option> flag.
-On Unix (but not Windows), the installed <filename>ghc</filename> is just a one-line 
-shell script that invokes the real GHC, passing a suitable <option>-B</option> flag. 
-[All the user-supplied flags
-follow, and a later <option>-B</option> flag overrides an earlier one, so a user-supplied
-one wins.]
-</para>
-</listitem>
-<listitem>
-<para> On Windows (but not Unix), if no <option>-B</option> flag is given, GHC uses a system
-call to find the directory in which the running GHC executable lives, and derives 
-<filename>$(libdir)</filename> from that. [Unix lacks such a system call.]
-That is why <filename>$(bindir)</filename> must be <filename>$(libdir)/bin</filename>.
-</para>
-</listitem>
-</itemizedlist>
-
-<sect2> <title>The binary directory</title>
-
-<para>The binary directory, <filename>$(bindir)</filename> contains user-visible
-executables, notably <filename>ghc</filename> and <filename>ghci</filename>.
-You should add it to your <literal>$PATH</literal>
-</para>
-
-<para>On Unix, the user-invokable <filename>ghc</filename> invokes <filename>$(libdir)/ghc-<replaceable>version</replaceable></filename>,
-passing a suitable <option>-B</option> flag to tell <filename>ghc-<replaceable>version</replaceable></filename> where
-<filename>$(libdir)</filename> is.
-Similarly <filename>ghci</filename>, except the extra flag <literal>--interactive</literal> is passed.
-</para>
-
-<para>On Win32, the user-invokable <filename>ghc</filename> binary 
-is the Real Thing (no intervening
-shell scripts or <filename>.bat</filename> files). 
-Reason: we sometimes invoke GHC with very long command lines,
-and <filename>cmd.exe</filename> (which executes <filename>.bat</filename> files)
-truncates them.  Similarly <filename>ghci</filename> is a C wrapper program that invokes <filename>ghc --interactive</filename>
-(passing on all other arguments), not a <filename>.bat</filename> file.
-</para>
-
-
-</sect2>
-
-<sect2> <title>The library directory</title>
-
-<para>The layout of the library directory, <filename>$(libdir)</filename> is almost identical on
-Windows and Unix, as follows.  Differences between Windows and Unix
-are noted thus <literal>[Win32 only]</literal> and are commented below.</para>
-
-<programlisting>
-  $(libdir)/
-    package.conf           GHC package configuration
-    ghc-usage.txt          Message displayed by ghc &ndash;&ndash;help
-    
-    bin/                   [Win32 only]  User-visible binaries
-         ghc.exe
-         ghci.exe
-
-    unlit                  Remove literate markup
-    
-    touchy.exe             [Win32 only]
-    perl.exe               [Win32 only]
-    gcc.exe                [Win32 only]
-   
-    ghc-x.xx               GHC executable [Unix only]
-   
-    ghc-split              Asm code splitter
-    ghc-asm	           Asm code mangler
-
-    gcc-lib/               [Win32 only] Support files for gcc
-        specs              gcc configuration
- 
-        cpp0.exe           gcc support binaries
-        as.exe
-        ld.exe
-
-        crt0.o              Standard
-	   ..etc..	    binaries
-        
-        libmingw32.a        Standard
-	   ..etc..	    libraries
-
-        *.h                 Include files
-
-    imports/                GHC interface files
-        std/*.hi              'std' library
-	lang/*.hi             'lang' library
-        ..etc..
-
-    include/                 C header files
-        StgMacros.h           GHC-specific
-        ..etc...              header files
-
-        mingw/*.h            [Win32 only] Mingwin header files
-
-    libHSrts.a              GHC library archives
-    libHSstd.a
-    libHSlang.a
-      ..etc..
-
-    HSstd1.o                GHC library linkables
-    HSstd2.o                  (used by ghci, which does
-    HSlang.o                  not grok .a files yet)
-</programlisting>
-
-<para>Note that:
-<itemizedlist>
-
-	<listitem>
-	  <para><filename>$(libdir)</filename> also contains support
-          binaries.  These are <emphasis>not</emphasis> expected to be
-          on the user's <filename>PATH</filename>, but and are invoked
-          directly by GHC.  In the Makefile system, this directory is
-          also called <filename>$(libexecdir)</filename>, but
-          <emphasis>you are not free to change it</emphasis>.  It must
-          be the same as <filename>$(libdir)</filename>.</para>
-	</listitem>
-
-<listitem>
-<para>We distribute <filename>gcc</filename> with the Win32 distribution of GHC, so that users
-don't need to install <filename>gcc</filename>, nor need to care about which version it is.
-All <filename>gcc</filename>'s support files are kept in  <filename>$(libdir)/gcc-lib/</filename>.
-</para> 
-</listitem>
-
-<listitem>
-<para>Similarly, we distribute <filename>perl</filename> and a <filename>touch</filename> 
-replacement (<filename>touchy.exe</filename>)
-with the Win32 distribution of GHC. </para> 
-</listitem>
-
-	<listitem>
-	  <para>The support programs <filename>ghc-split</filename>
-          and <filename>ghc-asm</filename> are Perl scripts.  The
-          first line says <literal>#!/bin/perl</literal>; on Unix, the
-          script is indeed invoked as a shell script, which invokes
-          Perl; on Windows, GHC invokes
-          <filename>$(libdir)/perl.exe</filename> directly, which
-          treats the <literal>#!/bin/perl</literal> as a comment.
-          Reason: on Windows we want to invoke the Perl distributed
-          with GHC, rather than assume some installed one.  </para>
-	</listitem>
-</itemizedlist>
-</para>
-
-</sect2>
-
-</sect1>
-
-</chapter>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/intro.xml b/ghc/docs/users_guide/intro.xml
deleted file mode 100644
index d4b6a1241f..0000000000
--- a/ghc/docs/users_guide/intro.xml
+++ /dev/null
@@ -1,409 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<chapter id="introduction-GHC">
-  <title>Introduction to GHC</title>
-
-  <para>This is a guide to using the Glasgow Haskell Compiler (GHC):
-  an interactive and batch compilation system for the <ulink
-  url="http://www.haskell.org/">Haskell&nbsp;98</ulink>
-  language.</para>
-
-  <para>GHC has two main components: an interactive Haskell
-  interpreter (also known as GHCi), described in <xref
-  linkend="ghci"/>, and a batch compiler, described throughout <xref
-  linkend="using-ghc"/>.  In fact, GHC consists of a single program
-  which is just run with different options to provide either the
-  interactive or the batch system.</para>
-
-  <para>The batch compiler can be used alongside GHCi: compiled
-  modules can be loaded into an interactive session and used in the
-  same way as interpreted code, and in fact when using GHCi most of
-  the library code will be pre-compiled.  This means you get the best
-  of both worlds: fast pre-compiled library code, and fast compile
-  turnaround for the parts of your program being actively
-  developed.</para>
-
-  <para>GHC supports numerous language extensions, including
-  concurrency, a foreign function interface, exceptions, type system
-  extensions such as multi-parameter type classes, local universal and
-  existential quantification, functional dependencies, scoped type
-  variables and explicit unboxed types.  These are all described in
-  <xref linkend="ghc-language-features"/>.</para>
-
-  <para>GHC has a comprehensive optimiser, so when you want to Really
-  Go For It (and you've got time to spare) GHC can produce pretty fast
-  code.  Alternatively, the default option is to compile as fast as
-  possible while not making too much effort to optimise the generated
-  code (although GHC probably isn't what you'd describe as a fast
-  compiler :-).</para>
-  
-  <para>GHC's profiling system supports &ldquo;cost centre
-  stacks&rdquo;: a way of seeing the profile of a Haskell program in a
-  call-graph like structure.  See <xref linkend="profiling"/> for more
-  details.</para>
-
-  <para>GHC comes with a large collection of libraries, with
-  everything from parser combinators to networking.  The libraries are
-  described in separate documentation.</para>
-
-  <sect1 id="mailing-lists-GHC">
-    <title>Meta-information: Web sites, mailing lists, etc.</title>
-
-    <indexterm><primary>mailing lists, Glasgow Haskell</primary></indexterm>
-    <indexterm><primary>Glasgow Haskell mailing lists</primary></indexterm>
-
-    <para>On the World-Wide Web, there are several URLs of likely
-    interest:</para>
-
-    <itemizedlist>
-      <listitem>
-	<para><ulink url="http://www.haskell.org/" >Haskell home
-	page</ulink></para>
-      </listitem>
-
-      <listitem>
-	<para><ulink url="http://www.haskell.org/ghc/">GHC home
-	page</ulink></para>
-      </listitem>
-
-      <listitem>
-	<para><ulink
-	url="http://www.cs.nott.ac.uk/~gmh/faq.html">comp.lang.functional
-	FAQ</ulink></para>
-      </listitem>
-
-    </itemizedlist>
-
-    <para>We run the following mailing lists about Glasgow Haskell.
-    We encourage you to join, as you feel is appropriate.</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>glasgow-haskell-users:</term>
-	<listitem>
-	  <para>This list is for GHC users to chat among themselves.
-	  If you have a specific question about GHC, please check the
-	  <ulink
-	  url="http://hackage.haskell.org/trac/ghc/wiki/FAQ">FAQ</ulink>
-	  first.</para>
-
-	  <variablelist>
-	    <varlistentry>
-	      <term>list email address:</term>
-	      <listitem>
-		<para><email>glasgow-haskell-users@haskell.org</email></para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>subscribe at:</term> 
-	      <listitem>
-		<para><ulink
-	      url="http://www.haskell.org/mailman/listinfo/glasgow-haskell-users"><literal>http://www.haskell.org/mailman/listinfo/glasgow-haskell-users</literal></ulink>.</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>admin email address:</term>
-	      <listitem>
-		<para><email>glasgow-haskell-users-admin@haskell.org</email></para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>list archives:</term>
-	      <listitem>
-		<para><ulink
-          url="http://www.haskell.org/pipermail/glasgow-haskell-users/"><literal>http://www.haskell.org/pipermail/glasgow-haskell-users/</literal></ulink></para>
-	      </listitem>
-	    </varlistentry>
-	  </variablelist>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>glasgow-haskell-bugs:</term>
-	<listitem>
-	  <para>Send bug reports for GHC to this address!  The sad and
-          lonely people who subscribe to this list will muse upon
-          what's wrong and what you might do about it.</para>
-
-	  <variablelist>
-	    <varlistentry>
-	      <term>list email address:</term>
-	      <listitem>
-		<para><email>glasgow-haskell-bugs@haskell.org</email></para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>subscribe at:</term> 
-	      <listitem>
-		<para><ulink
-	      url="http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs"><literal>http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs</literal></ulink>.</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>admin email address:</term>
-	      <listitem>
-		<para><email>glasgow-haskell-bugs-admin@haskell.org</email></para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>list archives:</term>
-	      <listitem>
-		<para><ulink
-          url="http://www.haskell.org/pipermail/glasgow-haskell-bugs/"><literal>http://www.haskell.org/pipermail/glasgow-haskell-bugs/</literal></ulink></para>
-	      </listitem>
-	    </varlistentry>
-	  </variablelist>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>cvs-ghc:</term>
-	<listitem>
-	  <para>The hardcore GHC developers hang out here.  This list
-	  also gets commit message from the CVS repository.  There are
-	  several other similar lists for other parts of the CVS
-	  repository (eg. <literal>cvs-hslibs</literal>,
-	  <literal>cvs-happy</literal>, <literal>cvs-hdirect</literal>
-	  etc.)</para>
-	  
-	  <variablelist>
-	    <varlistentry>
-	      <term>list email address:</term>
-	      <listitem>
-		<para><email>cvs-ghc@haskell.org</email></para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>subscribe at:</term> 
-	      <listitem>
-		<para><ulink
-	      url="http://www.haskell.org/mailman/listinfo/cvs-ghc"><literal>http://www.haskell.org/mailman/listinfo/cvs-ghc</literal></ulink>.</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>admin email address:</term>
-	      <listitem>
-		<para><email>cvs-ghc-admin@haskell.org</email></para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>list archives:</term>
-	      <listitem>
-		<para><ulink
-          url="http://www.haskell.org/pipermail/cvs-ghc/"><literal>http://www.haskell.org/pipermail/cvs-ghc/</literal></ulink></para>
-	      </listitem>
-	    </varlistentry>
-	  </variablelist>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-    <para>There are several other haskell and GHC-related mailing
-    lists served by <literal>www.haskell.org</literal>.  Go to <ulink
-    url="http://www.haskell.org/mailman/listinfo/"><literal>http://www.haskell.org/mailman/listinfo/</literal></ulink>
-    for the full list.</para>
-
-    <para>Some Haskell-related discussion also takes place in the
-    Usenet newsgroup <literal>comp.lang.functional</literal>.</para>
-
-  </sect1>
-
-  <sect1 id="bug-reporting">
-    <title>Reporting bugs in GHC</title>
-    <indexterm><primary>bugs</primary><secondary>reporting</secondary>
-    </indexterm>
-    <indexterm><primary>reporting bugs</primary>
-    </indexterm>
-
-    <para>Glasgow Haskell is a changing system so there are sure to be
-    bugs in it. </para>
-
-    <para>To report a bug, either:</para>
-
-    <itemizedlist>
-      <listitem>
-	<para>Preferred: <ulink
-    url="http://hackage.haskell.org/trac/ghc/newticket?type=bug">Create
-    a new bug</ulink>, and enter your bug report.  You can also
-    search the bug database here to make sure your bug hasn't already
-    been reported (if it has, it might still help to add information
-    from your experience to the existing report).</para>
-      </listitem>
-      <listitem>
-	<para>Bug reports can also be emailed to
-    <email>glasgow-haskell-bugs@haskell.org</email>. </para>
-      </listitem>
-    </itemizedlist>
-
-    <sect2>
-      <title>How do I tell if I should report my bug?</title>
-
-      <para>Take a look at the <ulink
-      url="http://hackage.haskell.org/trac/ghc/wiki/FAQ">FAQ</ulink> and <xref
-      linkend="wrong"/>, which will give you some guidance as to
-      whether the behaviour you're seeing is really a bug or
-      not.</para>
-
-      <para>If it is a bug, then it might have been reported before:
-      try searching on the <ulink
-      url="http://hackage.haskell.org/trac/ghc">bug tracker</ulink>,
-      and failing that, try <ulink
-      url="http://www.google.com">Google</ulink>.</para>
-
-      <para>If in doubt, just report it.</para>
-    </sect2>
-
-    <sect2>
-      <title>What to put in a bug report</title>
-      <indexterm><primary>bug reports</primary><secondary>contents</secondary></indexterm>
-
-      <para>The name of the bug-reporting game is: facts, facts,
-      facts.  Don't omit them because &ldquo;Oh, they won't be
-      interested&hellip;&rdquo;</para>
-
-      <orderedlist>
-	<listitem>
-	  <para>What kind of machine are you running on, and exactly
-          what version of the operating system are you using?  (on a
-          Unix system, <command>uname -a</command> or <command>cat
-          /etc/motd</command> will show the desired information.)  In
-          the bug tracker, this information can be given in the
-          &ldquo;Architecture&rdquo; and &ldquo;Operating
-          system&rdquo; fields.</para>
-	</listitem>
-
-	<listitem>
-	  <para>What version of GCC are you using? <command>gcc&nbsp;-v</command> will tell you.</para>
-	</listitem>
-
-	<listitem>
-	  <para>Run the sequence of compiles/runs that caused the
-          offending behaviour, cut-and-paste the whole session into
-          the bug report.  We'd prefer to see the whole thing.</para>
-	</listitem>
-
-	<listitem>
-	  <para>Add the -v flag when running GHC, so we can see exactly
-          what was run, what versions of things you have, etc.</para>
-	</listitem>
-
-	<listitem>
-	  <para>What is the program behaviour that is wrong, in your
-	  opinion?</para>
-	</listitem>
-
-	<listitem>
-	  <para>If practical, please attach or send enough source
-          files for us to duplicate the problem.</para>
-	</listitem>
-
-	<listitem>
-	  <para>If you are a Hero and track down the problem in the
-          compilation-system sources, please send us patches (either
-          <literal>darcs send</literal>, plain patches, or just whole
-          files if you prefer).</para>
-	</listitem>
-      </orderedlist>
-    </sect2>
-  </sect1>
-
-  <sect1 id="version-numbering">
-    <title>GHC version numbering policy</title>
-    <indexterm><primary>version, of ghc</primary></indexterm>
-
-    <para>As of GHC version 6.0, we have adopted the following policy
-    for numbering GHC versions:</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>Stable Releases</term>
-	<listitem>
-	  <para>These are numbered <literal><replaceable>x</replaceable>.<replaceable>y</replaceable>.<replaceable>z</replaceable></literal>, where
-	  <replaceable>y</replaceable> is <emphasis>even</emphasis>, and
-	  <replaceable>z</replaceable> is the patchlevel number (the trailing
-	  <literal>.<replaceable>z</replaceable></literal> can be omitted if <replaceable>z</replaceable>
-	  is zero).  Patchlevels are bug-fix releases only, and never
-	  change the programmer interface to any system-supplied code.
-	  However, if you install a new patchlevel over an old one you
-	  will need to recompile any code that was compiled against the
-	  old libraries.</para>
-
-	  <para>The value of <literal>__GLASGOW_HASKELL__</literal>
-	  (see <xref linkend="c-pre-processor"/>) for a major release
-	  <literal><replaceable>x</replaceable>.<replaceable>y</replaceable>.<replaceable>z</replaceable></literal>
-	  is the integer <replaceable>xyy</replaceable> (if
-	  <replaceable>y</replaceable> is a single digit, then a leading zero
-	  is added, so for example in version 6.2 of GHC,
-	  <literal>__GLASGOW_HASKELL__==602</literal>).</para>
-	  <indexterm>
-	    <primary><literal>__GLASGOW_HASKELL__</literal></primary>
-	  </indexterm>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term>Snapshots/unstable releases</term>
-	<listitem>
-	  <para>We may make snapshot releases of the current
-	  development sources from time to time, and the current
-	  sources are always available via the CVS repository (see the
-	  <ulink url="http://www.haskell.org/ghc/">GHC web
-	  site</ulink> for details).</para>
-
-	  <para>Snapshot releases are named
-	  <literal><replaceable>x</replaceable>.<replaceable>y</replaceable>.YYYYMMDD</literal>
-	  where <literal>YYYYMMDD</literal> is the date of the sources
-	  from which the snapshot was built.  In theory, you can check
-	  out the exact same sources from the CVS repository using
-	  this date.</para>
-
-	  <para>If <replaceable>y</replaceable> is odd, then this is a
-	  snapshot of the CVS HEAD (the main development branch).  If
-	  <replaceable>y</replaceable> is even, then it is a snapshot
-	  of the stable branch between patchlevel releases.  For
-	  example, <literal>6.3.20040225</literal> would be a snapshot
-	  of the HEAD, but <literal>6.2.20040225</literal> would be a
-	  snapshot of the <literal>6.2</literal> branch.</para>
-
-	  <para>The value of <literal>__GLASGOW_HASKELL__</literal>
-	  for a snapshot release is the integer
-	  <replaceable>xyy</replaceable>.  You should never write any
-	  conditional code which tests for this value, however: since
-	  interfaces change on a day-to-day basis, and we don't have
-	  finer granularity in the values of
-	  <literal>__GLASGOW_HASKELL__</literal>, you should only
-	  conditionally compile using predicates which test whether
-	  <literal>__GLASGOW_HASKELL__</literal> is equal to, later
-	  than, or earlier than a given major release.</para>
-	  <indexterm>
-	    <primary><literal>__GLASGOW_HASKELL__</literal></primary>
-	  </indexterm>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-    
-    <para>The version number of your copy of GHC can be found by
-    invoking <literal>ghc</literal> with the
-    <literal>&ndash;&ndash;version</literal> flag (see <xref
-    linkend="options-help"/>).</para>
-  </sect1>
-
-
-&relnotes;
-
-</chapter>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/lang.xml b/ghc/docs/users_guide/lang.xml
deleted file mode 100644
index 7e9621ed8b..0000000000
--- a/ghc/docs/users_guide/lang.xml
+++ /dev/null
@@ -1,15 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<chapter id="ghc-language-features">
-<title>GHC Language Features</title>
-
-&glasgowexts;
-&parallel;
-
-</chapter>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/license.xml b/ghc/docs/users_guide/license.xml
deleted file mode 100644
index 55e2395a7c..0000000000
--- a/ghc/docs/users_guide/license.xml
+++ /dev/null
@@ -1,66 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<preface id="License">
-<title>The Glasgow Haskell Compiler License</title>
-
-<para>
-Copyright 2002, The University Court of the University of Glasgow. 
-All rights reserved.
-</para>
-
-<para>
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-</para>
-
-<para>
-<itemizedlist>
-
-<listitem>
-<para>
-Redistributions of source code must retain the above copyright notice,
-this list of conditions and the following disclaimer.
-</para>
-</listitem>
-
-<listitem>
-<para> 
-Redistributions in binary form must reproduce the above copyright notice,
-this list of conditions and the following disclaimer in the documentation
-and/or other materials provided with the distribution.
-</para>
-</listitem>
-
-<listitem>
-<para> 
-Neither name of the University nor the names of its contributors may be
-used to endorse or promote products derived from this software without
-specific prior written permission.
-</para>
-</listitem>
-
-</itemizedlist>
-</para>
-
-<para>
-THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
-GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
-INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
-DAMAGE.
-</para>
-
-</preface>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "preface") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/packages.xml b/ghc/docs/users_guide/packages.xml
deleted file mode 100644
index 3bd65c66ce..0000000000
--- a/ghc/docs/users_guide/packages.xml
+++ /dev/null
@@ -1,1193 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-  <sect1 id="packages">
- <title>
-Packages
- </title>
-  <indexterm><primary>packages</primary></indexterm>
-  
-  <para>A package is a library of Haskell modules known to the compiler.  GHC
-    comes with several packages: see the accompanying 
-    <ulink url="../libraries/index.html">library documentation</ulink>.</para>
-
-  <para>Using a package couldn't be simpler: if you're using
-    <option>--make</option> or GHCi, then most of the installed packages will be
-    automatically available to your program without any further options.  The
-    exceptions to this rule are covered below in <xref
-      linkend="using-packages" />.</para>
-
-  <para>Building your own packages is also quite straightforward: we provide
-    the <ulink url="http://www.haskell.org/cabal/">Cabal</ulink> infrastructure which
-    automates the process of configuring, building, installing and distributing
-    a package.  All you need to do is write a simple configuration file, put a
-    few files in the right places, and you have a package.  See the
-    <ulink url="../Cabal/index.html">Cabal documentation</ulink>
-    for details, and also the Cabal libraries (<ulink url="../libraries/Cabal/Distribution-Simple.html">Distribution.Simple</ulink>,
-    for example).</para>
-
-  <sect2 id="using-packages">
-  <title>Using Packages
-  </title>
-    <indexterm><primary>packages</primary>
-      <secondary>using</secondary></indexterm>
-    
-    <para>To see which packages are installed, use the
-      <literal>ghc-pkg</literal> command:</para>
-
-<screen>
-$ ghc-pkg list
-/usr/lib/ghc-6.4/package.conf:
-    base-1.0, haskell98-1.0, template-haskell-1.0, mtl-1.0, unix-1.0,
-    Cabal-1.0, haskell-src-1.0, parsec-1.0, network-1.0,
-    QuickCheck-1.0, HUnit-1.1, fgl-1.0, X11-1.1, HGL-3.1, OpenGL-2.0,
-    GLUT-2.0, stm-1.0, readline-1.0, (lang-1.0), (concurrent-1.0),
-    (posix-1.0), (util-1.0), (data-1.0), (text-1.0), (net-1.0),
-    (hssource-1.0), rts-1.0
-      </screen>
-
-    <para>Packages are either exposed or hidden.  Only
-      modules from exposed packages may be imported by your Haskell code; if
-      you try to import a module from a hidden package, GHC will emit an error
-      message.</para>
-
-    <para>Each package has an exposed flag, which says whether it is exposed by
-      default or not.  Packages hidden by default are listed in
-      parentheses (eg. <literal>(lang-1.0)</literal>) in the output from
-      <literal>ghc-pkg list</literal>.  To expose a package which is hidden by
-      default, use the <option>-package</option>
-      flag (see below).</para>
-    
-    <para>To see which modules are exposed by a package:</para>
-    
-<screen>
-$ ghc-pkg field network exposed-modules
-exposed-modules: Network.BSD,
-                 Network.CGI,
-                 Network.Socket,
-                 Network.URI,
-                 Network
-</screen>
-
-    <para>In general, packages containing hierarchical modules are usually
-      exposed by default.  However, it is possible for two packages to contain
-      the same module: in this case, only one of the packages should be
-      exposed.  It is an error to import a module that belongs to more than one
-      exposed package.</para>
-
-    <para>The GHC command line options that control packages are:</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>
-	  <option>-package <replaceable>P</replaceable></option>
-	  <indexterm><primary><option>-package</option></primary></indexterm>
-	</term>
-	<listitem>
-	  <para>This option causes package <replaceable>P</replaceable> to be
-	    exposed.  The package <replaceable>P</replaceable> can be specified
-	    in full with its version number
-	    (e.g. <literal>network-1.0</literal>) or the version number can be
-	    omitted if there is only one version of the package
-	    installed.</para>
-
-	  <para>If there are multiple versions of <replaceable>P</replaceable>
-	    installed, then all other versions will become hidden.</para>
-
-	  <para>The <option>-package <replaceable>P</replaceable></option>
-	    option also causes package <replaceable>P</replaceable> to be
-	    linked into the resulting executable.  In
-	    <option>&ndash;&ndash;make</option> mode and GHCi, the compiler 
-	    normally determines which packages are required by the current
-	    Haskell modules, and links only those.  In batch mode however, the
-	    dependency information isn't available, and explicit
-	    <option>-package</option> options must be given when linking.</para>
-
-	  <para>For example, to link a program consisting of objects
-	    <filename>Foo.o</filename> and <filename>Main.o</filename>, where
-	    we made use of the <literal>network</literal> package, we need to
-	    give GHC the <literal>-package</literal> flag thus:  
-
-<screen>$ ghc -o myprog Foo.o Main.o -package network</screen>
-
-	    The same flag is necessary even if we compiled the modules from
-	    source, because GHC still reckons it's in batch mode: 
-
-<screen>$ ghc -o myprog Foo.hs Main.hs -package network</screen>
-
-	    In <literal>--make</literal> and <literal>--interactive</literal>
-	    modes (<xref linkend="modes" />), however, GHC figures out the
-	    packages required for linking without further assistance.</para>
-
-	  <para>The one other time you might need to use
-	    <option>-package</option> to force linking a package is when the
-	    package does not contain any Haskell modules (it might contain a C
-	    library only, for example).  In that case, GHC
-	    will never discover a dependency on it, so it has to be mentioned
-	    explicitly.</para>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term><option>-hide-all-packages</option>
-	<indexterm><primary><option>-hide-package</option></primary>
-	  </indexterm></term>
-	<listitem>
-	  <para>Ignore the exposed flag on installed packages, and hide them
-	    all by default.  If you use
-	    this flag, then any packages you require (including
-	    <literal>base</literal>) need to be explicitly exposed using
-	    <option>-package</option> options.</para>
-
-	  <para>This is a good way to insulate your program from differences
-	    in the globally exposed packages, and being explicit about package
-	    dependencies is a Good Thing.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-hide-package</option> <replaceable>P</replaceable>
-	<indexterm><primary><option>-hide-package</option></primary>
-	  </indexterm></term>
-	<listitem>
-	  <para>This option does the opposite of <option>-package</option>: it
-	    causes the specified package to be <firstterm>hidden</firstterm>,
-	    which means that none of its modules will be available for import
-	    by Haskell <literal>import</literal> directives.</para>
-
-	  <para>Note that the package might still end up being linked into the
-	    final program, if it is a dependency (direct or indirect) of
-	    another exposed package.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-ignore-package</option> <replaceable>P</replaceable>
-	<indexterm><primary><option>-ignore-package</option></primary>
-	  </indexterm></term>
-	<listitem>
-	  <para>Causes the compiler to behave as if package
-	    <replaceable>P</replaceable>, and any packages that depend on
-	    <literal>P</literal>, are not installed at all.</para>
-
-	  <para>Saying <literal>-ignore-package P</literal> is the same as
-	    giving <literal>-hide-package</literal> flags for
-	    <literal>P</literal> and all the packages that depend on
-	    <literal>P</literal>.  Sometimes we don't know ahead of time which
-	    packages will be installed that depend on <literal>P</literal>,
-	    which is when the <literal>-ignore-package</literal> flag can be
-	    useful.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-  </sect2>
-
-  <sect2 id="package-overlaps">
-    <title>The module overlap restriction</title>
-
-    <para>The module names in a Haskell program must be distinct.
-      This doesn't sound like a severe restriction, but in a Haskell program
-      using multiple packages with interdependencies, difficulties can start to
-      arise.  You should be aware of what the module overlap
-      restriction means, and how to avoid it.</para>
-
-    <para>GHC knows which packages are <emphasis>in use</emphasis> by your
-      program: a package is in use if you imported something from it, or if it
-      is a dependency of some other package in use.  There must be no conflicts
-      between the packages in use; a conflict is when two packages contain
-      a module with the same name.  If
-      GHC detects a conflict, it will issue a message stating which packages
-      are in conflict, and which modules are overlapping.</para>
-
-    <para>For example, a conflict might arise if you use two packages, say P
-      and Q, which respectively depend on two different versions of another
-      package, say <literal>R-1.0</literal> and <literal>R-2.0</literal>.  The
-      two versions of <literal>R</literal> are likely to contain at least some
-      of the same modules, so this situation would be a conflict.</para>
-  </sect2>
-
-  <sect2 id="package-databases">
-    <title>Package Databases</title>
-      
-    <para>A package database is a file, normally called
-      <literal>package.conf</literal> which contains descriptions of installed
-      packages.  GHC usually knows about two package databases:</para>
-
-    <itemizedlist>
-      <listitem>
-	<para>The global package database, which comes with your GHC
-	  installation.</para>
-      </listitem>
-      <listitem>
-	<para>A package database private to each user.  On Unix
-	  systems this will be
-	  <filename>$HOME/.ghc/<replaceable>arch</replaceable>-<replaceable>os</replaceable>-<replaceable>version</replaceable>/package.conf</filename>, and on
-	  Windows it will be something like
-	  <filename>C:\Documents&nbsp;And&nbsp;Settings\<replaceable>user</replaceable>\ghc</filename>.
-	  The <literal>ghc-pkg</literal> tool knows where this file should be
-	  located, and will create it if it doesn't exist (see <xref linkend="package-management" />).</para>
-      </listitem>
-    </itemizedlist>
-
-    <para>When GHC starts up, it reads the contents of these two package
-      databases, and builds up a list of the packages it knows about.  You can
-      see GHC's package table by running GHC with the <option>-v</option>
-      flag.</para> 
-
-    <para>Package databases may overlap: for example, packages in the user
-      database will override those of the same name in the global
-      database.</para> 
-
-    <para>You can control the loading of package databses using the following
-      GHC options:</para> 
-
-    <variablelist>
-      <varlistentry>
-	<term>
-	  <option>-package-conf <replaceable>file</replaceable></option>
-	  <indexterm><primary><option>-package-conf</option></primary></indexterm>
-	</term>
-	<listitem>
-	  <para>Read in the package configuration file
-	    <replaceable>file</replaceable> in addition to the system
-	    default file and the user's local file.  Packages in additional
-	    files read this way will override those in the global and user
-	    databases.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-no-user-package-conf</option>
-	  <indexterm><primary><option>-no-user-package-conf</option></primary>
-	  </indexterm>
-	</term>
-	<listitem>
-	  <para>Prevent loading of the user's local package database.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-    <para>To create a new package database, just create
-      a new file and put the string
-      <quote><literal>[]</literal></quote> in it.  Packages can be
-      added to the file using the
-      <literal>ghc-pkg</literal> tool, described in <xref
-      linkend="package-management"/>.</para>
-
-    <sect3 id="ghc-package-path">
-      <title>The <literal>GHC_PACKAGE_PATH</literal> environment variable</title>
-      <indexterm><primary>Environment variable</primary><secondary><literal>GHC_PACKAGE_PATH</literal></secondary>
-      </indexterm>
-      <indexterm><primary><literal>GHC_PACKAGE_PATH</literal></primary></indexterm>
-      <para>The <literal>GHC_PACKAGE_PATH</literal> environment variable may be
-	set to a <literal>:</literal>-separated (<literal>;</literal>-separated
-	on Windows) list of files containing package databases.  This list of
-	package databases is used by GHC and ghc-pkg, with earlier databases in
-	the list overriding later ones.  This order was chosen to match the
-	behaviour of the <literal>PATH</literal> environment variable; think of
-	it as a list of package databases that are searched left-to-right for
-	packages.</para>
-
-      <para>If <literal>GHC_PACKAGE_PATH</literal> ends in a separator, then
-	the default user and system package databases are appended, in that
-	order. e.g. to augment the usual set of packages with a database of
-	your own, you could say (on Unix):
-<screen>
-$ export GHC_PACKAGE_PATH=$HOME/.my-ghc-packages.conf:</screen>
-	(use <literal>;</literal> instead of <literal>:</literal> on
-	Windows).</para>
-
-      <para>To check whether your <literal>GHC_PACKAGE_PATH</literal> setting
-	is doing the right thing, <literal>ghc-pkg list</literal> will list all
-	the databases in use, in the reverse order they are searched.</para>
-      
-    </sect3>
-  </sect2>
-
-  <sect2 id="building-packages">
-    <title>Building a package from Haskell source</title>
-    <indexterm><primary>packages</primary>
-      <secondary>building</secondary></indexterm>
-
-    <para>We don't recommend building packages the hard way.  Instead, use the
-      <ulink url="../Cabal/index.html">Cabal</ulink> infrastructure
-      if possible.  If your package is particularly complicated or requires a
-      lot of configuration, then you might have to fall back to the low-level
-      mechanisms, so a few hints for those brave souls follow.</para>
-    
-    <itemizedlist>
-      <listitem>
-	<para>You need to build an "installed package info" file for
-	  passing to <literal>ghc-pkg</literal> when installing your
-	  package.  The contents of this file are described in <xref
-	    linkend="installed-pkg-info" />.</para>
-      </listitem>
-      
-      <listitem>
-	<para>The Haskell code in a package may be built into one or
-	  more archive libraries
-	  (e.g. <filename>libHSfoo.a</filename>), or a single DLL on
-	  Windows (e.g. <filename>HSfoo.dll</filename>).  The
-	  restriction to a single DLL on Windows is because the
-	  package system is used to tell the compiler when it should
-	  make an inter-DLL call rather than an intra-DLL call
-	  (inter-DLL calls require an extra
-	  indirection). <emphasis>Building packages as DLLs doesn't
-	  work at the moment; see <xref linkend="win32-dlls-create"/>
-	  for the gory details.</emphasis>
-	  </para>
-
-	<para>Building a static library is done by using the
-	  <literal>ar</literal> tool, like so:</para>
-
-<screen>ar cqs libHSfoo.a A.o B.o C.o ...</screen>
-
-	<para>where <filename>A.o</filename>,
-	  <filename>B.o</filename> and so on are the compiled Haskell
-	  modules, and <filename>libHSfoo.a</filename> is the library
-	  you wish to create.  The syntax may differ slightly on your
-	  system, so check the documentation if you run into
-	  difficulties.</para>
-
-	<para>Versions of the Haskell libraries for use with GHCi
-	  may also be included: GHCi cannot load <literal>.a</literal>
-	  files directly, instead it will look for an object file
-	  called <filename>HSfoo.o</filename> and load that.  On some
-	  systems, the <literal>ghc-pkg</literal> tool can
-	  automatically build the GHCi version of each library, see
-	  <xref linkend="package-management"/>.  To build these
-	  libraries by hand from the <literal>.a</literal> archive, it
-	  is possible to use GNU <command>ld</command> as
-	  follows:</para>
-
-<screen>ld -r &ndash;&ndash;whole-archive -o HSfoo.o libHSfoo.a</screen>
-
-	<para>(replace
-          <literal>&ndash;&ndash;--whole-archive</literal> with
-          <literal>&ndash;all_load</literal> on MacOS X)</para>
-	
-	  <para>GHC does not maintain detailed cross-package
-          dependency information.  It does remember which modules in
-          other packages the current module depends on, but not which
-          things within those imported things.</para>
-      </listitem>
-    </itemizedlist>
-    
-    <para>It is worth noting that on Windows, when each package
-      is built as a DLL, since a reference to a DLL costs an extra
-      indirection, intra-package references are cheaper than
-      inter-package references. Of course, this applies to the
-      <filename>Main</filename> package as well.</para>
-    </sect2>
-
-  <sect2 id="package-management">
-    <title>Package management (the <literal>ghc-pkg</literal> command)</title>
-    <indexterm><primary>packages</primary>
-      <secondary>management</secondary></indexterm>
-    
-    <para>The <literal>ghc-pkg</literal> tool allows packages to be
-      added or removed from a package database.  By default,
-      the system-wide package database is modified, but alternatively
-      the user's local package database or another specified
-      file can be used.</para>
-
-    <para>To see what package databases are in use, say
-      <literal>ghc-pkg&nbsp;list</literal>.  The stack of databases that
-      <literal>ghc-pkg</literal> knows about can be modified using the
-      <literal>GHC_PACKAGE_PATH</literal> environment variable (see <xref
-	linkend="ghc-package-path" />, and using
-	<literal>--package-conf</literal> options on the
-	<literal>ghc-pkg</literal> command line.</para>
-
-    <para>When asked to modify a database, <literal>ghc-pkg</literal> modifies
-      the global database by default.  Specifying <option>--user</option>
-      causes it to act on the user database, or <option>--package-conf</option>
-      can be used to act on another database entirely.  When multiple of these
-      options are given, the rightmost one is used as the database to act
-      upon.</para>
-
-    <para>If the environment variable <literal>GHC_PACKAGE_PATH</literal> is
-      set, and its value does not end in a separator (<literal>:</literal> on
-      Unix, <literal>;</literal> on Windows), then the last database is
-      considered to be the global database, and will be modified by default by
-      <literal>ghc-pkg</literal>.  The intention here is that
-      <literal>GHC_PACKAGE_PATH</literal> can be used to create a virtual
-      package environment into which Cabal packages can be installed without
-      setting anything other than <literal>GHC_PACKAGE_PATH</literal>.</para>
-
-    <para>The <literal>ghc-pkg</literal> program may be run in the ways listed
-      below.  Where a package name is required, the package can be named in
-      full including the version number 
-      (e.g. <literal>network-1.0</literal>), or without the version number.
-      Naming a package without the version number matches all versions of the
-      package; the specified action will be applied to all the matching
-      packages.  A package specifier that matches all version of the package
-      can also be written <replaceable>pkg</replaceable><literal>-*</literal>,
-      to make it clearer that multiple packages are being matched.</para>
-
-    <variablelist>
-      <varlistentry>
-	<term><literal>ghc-pkg register <replaceable>file</replaceable></literal></term>
-	<listitem>
-	  <para>Reads a package specification from
-	    <replaceable>file</replaceable> (which may be &ldquo;<literal>-</literal>&rdquo;
-	    to indicate standard input),
-	    and adds it to the database of installed packages.  The syntax of
-	    <replaceable>file</replaceable> is given in <xref
-	      linkend="installed-pkg-info" />.</para>
-
-	  <para>The package specification must be a package that isn't already
-	    installed.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><literal>ghc-pkg update <replaceable>file</replaceable></literal></term>
-	<listitem>
-	  <para>The same as <literal>register</literal>, except that if a
-	    package of the same name is already installed, it is
-	    replaced by the new one.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><literal>ghc-pkg unregister <replaceable>P</replaceable></literal></term>
-	<listitem>
-	  <para>Remove the specified package from the database.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><literal>ghc-pkg expose <replaceable>P</replaceable></literal></term>
-	<listitem>
-	  <para>Sets the <literal>exposed</literal> flag for package
-	    <replaceable>P</replaceable> to <literal>True</literal>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><literal>ghc-pkg hide <replaceable>P</replaceable></literal></term>
-	<listitem>
-	  <para>Sets the <literal>exposed</literal> flag for package
-	    <replaceable>P</replaceable> to <literal>False</literal>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><literal>ghc-pkg list [<replaceable>P</replaceable>] [<option>--simple-output</option>]</literal></term>
-	<listitem>
-	  <para>This option displays the currently installed
-	    packages, for each of the databases known to
-	    <literal>ghc-pkg</literal>.  That includes the global database, the
-	    user's local database, and any further files specified using the
-	    <option>-f</option> option on the command line.</para>
-
-	  <para>Hidden packages (those for which the <literal>exposed</literal>
-	    flag is <literal>False</literal>) are shown in parentheses in the
-	    list of packages.</para>
-
-	  <para>If an optional package identifier <replaceable>P</replaceable>
-	    is given, then only packages matching that identifier are
-	    shown.</para>
-	  
-	  <para>If the option <option>--simple-output</option> is given, then
-	    the packages are listed on a single line separated by spaces, and
-	    the database names are not included.  This is intended to make it
-	    easier to parse the output of <literal>ghc-pkg list</literal> using
-	    a script.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><literal>ghc-pkg latest <replaceable>P</replaceable></literal></term>
-	<listitem>
-	  <para>Prints the latest available version of package
-	    <replaceable>P</replaceable>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><literal>ghc-pkg describe <replaceable>P</replaceable></literal></term>
-	<listitem>
-	  <para>Emit the full description of the specified package.  The
-	    description is in the form of an
-	    <literal>InstalledPackageInfo</literal>, the same as the input file
-	    format for <literal>ghc-pkg register</literal>.  See <xref
-	      linkend="installed-pkg-info" /> for details.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><literal>ghc-pkg field <replaceable>P</replaceable> <replaceable>field</replaceable></literal></term>
-	<listitem>
-	  <para>Show just a single field of the installed package description
-	    for <literal>P</literal>.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-    <para>Additionally, the following flags are accepted by
-      <literal>ghc-pkg</literal>:</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>
-	  <option>&ndash;&ndash;auto-ghci-libs</option><indexterm><primary><option>&ndash;&ndash;auto-ghci-libs</option></primary>
-	  </indexterm>
-	</term>
-	<listitem>
-	  <para>Automatically generate the GHCi
-	    <filename>.o</filename> version of each
-	    <filename>.a</filename> Haskell library, using GNU ld (if
-	    that is available).  Without this option,
-	    <literal>ghc-pkg</literal> will warn if GHCi versions of
-	    any Haskell libraries in the package don't exist.</para>
-	    
-	    <para>GHCi <literal>.o</literal> libraries don't
-	    necessarily have to live in the same directory as the
-	    corresponding <literal>.a</literal> library.  However,
-	    this option will cause the GHCi library to be created in
-	    the same directory as the <literal>.a</literal>
-	    library.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-	  <option>-f</option> <replaceable>file</replaceable>
-	  <indexterm><primary><option>-f</option></primary>
-	  </indexterm>
-	</term>
-	<term>
-	  <option>-package-conf</option> <replaceable>file</replaceable>
-	  <indexterm><primary><option>-package-conf</option></primary>
-	  </indexterm>
-	</term>
-	<listitem>
-	  <para>Adds <replaceable>file</replaceable> to the stack of package
-	    databases.  Additionally, <replaceable>file</replaceable> will
-	    also be the database modified by a <literal>register</literal>,
-	    <literal>unregister</literal>, <literal>expose</literal> or
-	    <literal>hide</literal> command, unless it is overriden by a later
-	    <option>--package-conf</option>, <option>--user</option> or
-	    <option>--global</option> option.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-	  <option>&ndash;&ndash;force</option>
-	  <indexterm><primary>
-	      <option>&ndash;&ndash;force</option>
-	    </primary></indexterm>
-	</term>
-	<listitem>
-	  <para>Causes <literal>ghc-pkg</literal> to ignore missing
-	    dependencies, directories and libraries when registering a package,
-	    and just go ahead and add it anyway.  This might be useful if your
-	    package installation system needs to add the package to
-	    GHC before building and installing the files.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-	  <option>&ndash;&ndash;global</option><indexterm><primary><option>&ndash;&ndash;global</option></primary>
-	  </indexterm>
-	</term>
-	<listitem>
-	  <para>Operate on the global package database (this is the default).
-	    This flag affects the <literal>register</literal>,
-	    <literal>update</literal>, <literal>unregister</literal>,
-	    <literal>expose</literal>, and <literal>hide</literal>
-	    commands.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-	  <option>&ndash;&ndash;help</option><indexterm><primary><option>&ndash;&ndash;help</option></primary>
-	  </indexterm>
-	</term>
-	<term>
-	  <option>-?</option><indexterm><primary><option>-?</option></primary>
-	  </indexterm>
-	</term>
-	<listitem>
-	  <para>Outputs the command-line syntax.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-	  <option>&ndash;&ndash;user</option><indexterm><primary><option>&ndash;&ndash;user</option></primary>
-	  </indexterm>
-	</term>
-	<listitem>
-	  <para>Operate on the current user's local package database.
-	    This flag affects the <literal>register</literal>,
-	    <literal>update</literal>, <literal>unregister</literal>,
-	    <literal>expose</literal>, and <literal>hide</literal>
-	    commands.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-	  <option>-V</option><indexterm><primary><option>-V</option></primary>
-	  </indexterm>
-	</term>
-	<term>
-	  <option>&ndash;&ndash;version</option><indexterm><primary><option>&ndash;&ndash;version</option></primary>
-	  </indexterm>
-	</term>
-	<listitem>
-	  <para>Output the <literal>ghc-pkg</literal> version number.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-    <para>When modifying the package database
-      <replaceable>file</replaceable>, a copy of the original file is
-      saved in <replaceable>file</replaceable><literal>.old</literal>,
-      so in an emergency you can always restore the old settings by
-      copying the old file back again.</para>
-
-  </sect2>
-  
-  <sect2 id="installed-pkg-info">
-    <title>
-      <literal>InstalledPackageInfo</literal>: a package specification
-    </title>
-
-    <para>A package specification is a Haskell record; in particular, it is the
-      record <ulink
-	url="../libraries/Cabal/Distribution-InstalledPackageInfo.html#%tInstalledPackageInfo">InstalledPackageInfo</ulink> in the module Distribution.InstalledPackageInfo, which is part of the Cabal package distributed with GHC.</para>
-
-    <para>An <literal>InstalledPackageInfo</literal> has a human
-      readable/writable syntax.  The functions
-      <literal>parseInstalledPackageInfo</literal> and
-      <literal>showInstalledPackageInfo</literal> read and write this syntax
-      respectively.  Here's an example of the
-      <literal>InstalledPackageInfo</literal> for the <literal>unix</literal> package:</para>
-
-<screen>
-$ ghc-pkg describe unix
-name: unix
-version: 1.0
-license: BSD3
-copyright:
-maintainer: libraries@haskell.org
-stability:
-homepage:
-package-url:
-description:
-category:
-author:
-exposed: True
-exposed-modules: System.Posix,
-                 System.Posix.DynamicLinker.Module,
-                 System.Posix.DynamicLinker.Prim,
-                 System.Posix.Directory,
-                 System.Posix.DynamicLinker,
-                 System.Posix.Env,
-                 System.Posix.Error,
-                 System.Posix.Files,
-                 System.Posix.IO,
-                 System.Posix.Process,
-                 System.Posix.Resource,
-                 System.Posix.Temp,
-                 System.Posix.Terminal,
-                 System.Posix.Time,
-                 System.Posix.Unistd,
-                 System.Posix.User,
-                 System.Posix.Signals.Exts
-import-dirs: /usr/lib/ghc-6.4/libraries/unix
-library-dirs: /usr/lib/ghc-6.4/libraries/unix
-hs-libraries: HSunix
-extra-libraries: HSunix_cbits, dl
-include-dirs: /usr/lib/ghc-6.4/libraries/unix/include
-includes: HsUnix.h
-depends: base-1.0
-</screen>
-
-    <para>The full <ulink url="../Cabal/index.html">Cabal documentation</ulink>
-      is still in preparation (at time of writing), so in the meantime
-      here is a brief description of the syntax of this file:</para>
-
-    <para>A package description consists of a number of field/value pairs.  A
-      field starts with the field name in the left-hand column followed by a
-      &ldquo;<literal>:</literal>&rdquo;, and the value continues until the next line that begins in the
-      left-hand column, or the end of file.</para>
-
-    <para>The syntax of the value depends on the field.   The various field
-      types are:</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>freeform</term>
-	<listitem>
-	  <para>Any arbitrary string, no interpretation or parsing is
-	    done.</para>
-	</listitem>
-      </varlistentry>
-      <varlistentry>
-	<term>string</term>
-	<listitem>
-	  <para>A sequence of non-space characters, or a sequence of arbitrary
-	    characters surrounded by quotes <literal>"...."</literal>.</para>
-	</listitem>
-      </varlistentry>
-      <varlistentry>
-	<term>string list</term>
-	<listitem>
-	  <para>A sequence of strings, separated by commas.  The sequence may
-	    be empty.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-    <para>In addition, there are some fields with special syntax (e.g. package
-      names, version, dependencies).</para>
-
-    <para>The allowed fields, with their types, are:</para>
-	
-    <variablelist>
-      <varlistentry>
-	<term>
-	  <literal>name</literal>
-	  <indexterm><primary><literal>name</literal></primary><secondary>package specification</secondary></indexterm>
-	</term>
-	<listitem>
-	  <para>The package's name (without the version).</para>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term>
-	  <literal>version</literal>
-	  <indexterm><primary><literal>version</literal></primary><secondary>package specification</secondary></indexterm>
-	</term>
-	<listitem>
-	  <para>The package's version, usually in the form
-	    <literal>A.B</literal> (any number of components are allowed).</para>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term>
-	  <literal>license</literal>
-	  <indexterm><primary><literal>auto</literal></primary><secondary>package specification</secondary></indexterm>
-	</term>
-	<listitem>
-	  <para>(string) The type of license under which this package is distributed.
-	    This field is a value of the <ulink
-	url="../libraries/Cabal/Distribution-License.html#t:License"><literal>License</literal></ulink> type.</para>
-	</listitem>
-      </varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>license-file</literal>
-            <indexterm><primary><literal>license-file</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(optional string) The name of a file giving detailed license
-	    information for this package.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>copyright</literal>
-            <indexterm><primary><literal>copyright</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(optional freeform) The copyright string.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>maintainer</literal>
-            <indexterm><primary><literal>maintainer</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(optinoal freeform) The email address of the package's maintainer.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>stability</literal>
-            <indexterm><primary><literal>stability</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(optional freeform) A string describing the stability of the package
-	    (eg. stable, provisional or experimental).</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>homepage</literal>
-            <indexterm><primary><literal>homepage</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(optional freeform) URL of the package's home page.</para>
-	  </listitem>
-	</varlistentry>
-
-      <varlistentry>
-	<term>
-            <literal>package-url</literal>
-            <indexterm><primary><literal>package-url</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(optional freeform) URL of a downloadable distribution for this
-	    package.  The distribution should be a Cabal package.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>description</literal>
-            <indexterm><primary><literal>description</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(optional freeform) Description of the package.</para>
-	  </listitem>
-	</varlistentry>
-
-      <varlistentry>
-	  <term>
-            <literal>category</literal>
-            <indexterm><primary><literal>category</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(optinoal freeform) Which category the package belongs to.  This field
-	    is for use in conjunction with a future centralised package
-	    distribution framework, tentatively titled Hackage.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>author</literal>
-            <indexterm><primary><literal>author</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(optional freeform) Author of the package.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>exposed</literal>
-            <indexterm><primary><literal>exposed</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(bool) Whether the package is exposed or not.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>exposed-modules</literal>
-            <indexterm><primary><literal>exposed-modules</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) modules exposed by this package.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>hidden-modules</literal>
-            <indexterm><primary><literal>hidden-modules</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) modules provided by this package,
-	    but not exposed to the programmer.  These modules cannot be
-	    imported, but they are still subject to the overlapping constraint:
-	    no other package in the same program may provide a module of the
-	    same name.</para>
-	</listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>import-dirs</literal>
-            <indexterm><primary><literal>import-dirs</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) A list of directories containing interface files
-	    (<literal>.hi</literal> files) for this package.</para>
-
-	    <para>If the package contains profiling libraries, then
-	    the interface files for those library modules should have
-	    the suffix <literal>.p_hi</literal>.  So the package can
-	    contain both normal and profiling versions of the same
-	    library without conflict (see also
-	    <literal>library_dirs</literal> below).</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>library-dirs</literal>
-            <indexterm><primary><literal>library-dirs</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) A list of directories containing libraries for this
-	    package.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>hs-libraries</literal>
-            <indexterm><primary><literal>hs-libraries</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) A list of libraries containing Haskell code for this
-	    package, with the <literal>.a</literal> or
-	    <literal>.dll</literal> suffix omitted.  When packages are
-	    built as libraries, the
-	    <literal>lib</literal> prefix is also omitted.</para>
-
-	    <para>For use with GHCi, each library should have an
-	    object file too.  The name of the object file does
-	    <emphasis>not</emphasis> have a <literal>lib</literal>
-	    prefix, and has the normal object suffix for your
-	    platform.</para>
-
-	    <para>For example, if we specify a Haskell library as
-	    <filename>HSfoo</filename> in the package spec, then the
-	    various flavours of library that GHC actually uses will be
-	    called:</para>
-	    <variablelist>
-	      <varlistentry>
-		<term><filename>libHSfoo.a</filename></term>
-		<listitem>
-		  <para>The name of the library on Unix and Windows
-		  (mingw) systems.  Note that we don't support
-		  building dynamic libraries of Haskell code on Unix
-		  systems.</para>
-		</listitem>
-	      </varlistentry>
-	      <varlistentry>
-		<term><filename>HSfoo.dll</filename></term>
-		<listitem>
-		  <para>The name of the dynamic library on Windows
-		  systems (optional).</para>
-		</listitem>
-	      </varlistentry>
-	      <varlistentry>
-		<term><filename>HSfoo.o</filename></term>
-		<term><filename>HSfoo.obj</filename></term>
-		<listitem>
-		  <para>The object version of the library used by
-		  GHCi.</para>
-		</listitem>
-	      </varlistentry>
-	    </variablelist>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>extra-libraries</literal>
-            <indexterm><primary><literal>extra-libraries</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) A list of extra libraries for this package.  The
-	    difference between <literal>hs-libraries</literal> and
-	    <literal>extra-libraries</literal> is that
-	    <literal>hs-libraries</literal> normally have several
-	    versions, to support profiling, parallel and other build
-	    options.  The various versions are given different
-	    suffixes to distinguish them, for example the profiling
-	    version of the standard prelude library is named
-	    <filename>libHSbase_p.a</filename>, with the
-	    <literal>_p</literal> indicating that this is a profiling
-	    version.  The suffix is added automatically by GHC for
-	    <literal>hs-libraries</literal> only, no suffix is added
-	    for libraries in
-	    <literal>extra-libraries</literal>.</para>
-
-	    <para>The libraries listed in
-	    <literal>extra-libraries</literal> may be any libraries
-	    supported by your system's linker, including dynamic
-	    libraries (<literal>.so</literal> on Unix,
-	    <literal>.DLL</literal> on Windows).</para>
-
-	    <para>Also, <literal>extra-libraries</literal> are placed
-	    on the linker command line after the
-	    <literal>hs-libraries</literal> for the same package.  If
-	    your package has dependencies in the other direction (i.e.
-	    <literal>extra-libraries</literal> depends on
-	    <literal>hs-libraries</literal>), and the libraries are
-	    static, you might need to make two separate
-	    packages.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>include-dirs</literal>
-            <indexterm><primary><literal>include-dirs</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) A list of directories containing C includes for this
-	    package.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-           <literal>includes</literal>
-           <indexterm><primary><literal>includes</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) A list of files to include for via-C compilations
-	    using this package.  Typically the include file(s) will
-	    contain function prototypes for any C functions used in
-	    the package, in case they end up being called as a result
-	    of Haskell functions from the package being
-	    inlined.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>depends</literal>
-            <indexterm><primary><literal>depends</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(package name list) Packages on which this package depends.  This field contains
-	    packages with explicit versions are required, except that when
-	    submitting a package to <literal>ghc-pkg register</literal>, the
-	    versions will be filled in if they are unambiguous.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>hugs-options</literal>
-            <indexterm><primary><literal>hugs-options</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) Options to pass to Hugs for this package.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>cc-options</literal>
-            <indexterm><primary><literal>cc-options</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) Extra arguments to be added to the gcc command line
-	    when this package is being used (only for via-C
-	    compilations).</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>ld-options</literal>
-            <indexterm><primary><literal>ld-options</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) Extra arguments to be added to the
-	    <command>gcc</command> command line (for linking) when
-	    this package is being used.</para>
-	  </listitem>
-	</varlistentry>
-	
-	<varlistentry>
-	  <term>
-            <literal>framework-dirs</literal>
-            <indexterm><primary><literal>framework-dirs</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) On Darwin/MacOS X, a list of directories containing
-	    frameworks for this package. This corresponds to the
-	    <option>-framework-path</option> option. It is ignored on all other
-	    platforms.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>frameworks</literal>
-            <indexterm><primary><literal>frameworks</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) On Darwin/MacOS X, a list of frameworks to link to. This
-	    corresponds to the <option>-framework</option> option. Take a look
-	    at Apple's developer documentation to find out what frameworks
-	    actually are. This entry is ignored on all other platforms.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>haddock-interfaces</literal>
-            <indexterm><primary><literal>haddock-interfaces</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(string list) A list of filenames containing <ulink
-	      url="http://www.haskell.org/haddock/">Haddock</ulink> interface
-	    files (<literal>.haddock</literal> files) for this package.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <literal>haddock-html</literal>
-            <indexterm><primary><literal>haddock-html</literal></primary><secondary>package specification</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(optional string) The directory containing the Haddock-generated HTML
-	    for this package.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-      
-<!--  This isn't true any more.  I'm not sure if we still need it -SDM
-      <para>
-      The <literal>ghc-pkg</literal> tool performs expansion of
-      environment variables occurring in input package specifications.
-      So, if the <literal>mypkg</literal> was added to the package
-      database as follows:
-      </para>
-<screen>
-  $ installdir=/usr/local/lib ghc-pkg -a &lt; mypkg.pkg
-</screen>
-
-      <para>
-      The occurrence of <literal>${installdir}</literal> is replaced
-      with <literal>/usr/local/lib</literal> in the package data that
-      is added for <literal>mypkg</literal>.
-      </para>
-      
-      <para>
-      This feature enables the distribution of package specification
-      files that can be easily configured when installing.
-      </para>
-
-      <para>For examples of more package specifications, take a look
-      at the <literal>package.conf</literal> in your GHC
-      installation.</para>
-
--->
-
-    </sect2>
-  </sect1>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter" "sect1") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/parallel.xml b/ghc/docs/users_guide/parallel.xml
deleted file mode 100644
index 11c2547898..0000000000
--- a/ghc/docs/users_guide/parallel.xml
+++ /dev/null
@@ -1,210 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<sect1 id="concurrent-and-parallel">
-<title>Concurrent and Parallel Haskell</title>
-
-<para>
-<indexterm><primary>Concurrent Haskell</primary></indexterm>
-<indexterm><primary>Parallel Haskell</primary></indexterm>
-Concurrent and Parallel Haskell are Glasgow extensions to Haskell
-which let you structure your program as a group of independent
-`threads'.
-</para>
-
-<para>
-Concurrent and Parallel Haskell have very different purposes.
-</para>
-
-<para>
-Concurrent Haskell is for applications which have an inherent
-structure of interacting, concurrent tasks (i.e. `threads').  Threads
-in such programs may be <emphasis>required</emphasis>.  For example, if a concurrent thread has been spawned to handle a mouse click, it isn't
-optional&mdash;the user wants something done!
-</para>
-
-<para>
-A Concurrent Haskell program implies multiple `threads' running within
-a single Unix process on a single processor.
-</para>
-
-<para>
-You will find at least one paper about Concurrent Haskell hanging off
-of <ulink url="http://research.microsoft.com/~simonpj/">Simon Peyton
-Jones's Web page</ulink>.
-</para>
-
-<para>
-Parallel Haskell is about <emphasis>speed</emphasis>&mdash;spawning
-threads onto multiple processors so that your program will run faster.
-The `threads' are always <emphasis>advisory</emphasis>&mdash;if the
-runtime system thinks it can get the job done more quickly by
-sequential execution, then fine.
-</para>
-
-<para>
-A Parallel Haskell program implies multiple processes running on
-multiple processors, under a PVM (Parallel Virtual Machine) framework.
-An MPI interface is under development but not fully functional, yet.
-</para>
-
-<para>
-Parallel Haskell is still relatively new; it is more about &ldquo;research
-fun&rdquo; than about &ldquo;speed.&rdquo; That will change.
-</para>
-
-<para>
-Check the <ulink url="http://www.cee.hw.ac.uk/~dsg/gph/">GPH Page</ulink>
-for more information on &ldquo;GPH&rdquo; (Haskell98 with extensions for
-parallel execution), the latest version of &ldquo;GUM&rdquo; (the runtime
-system to enable parallel executions) and papers on research issues.  A
-list of publications about GPH and about GUM is also available from Simon's
-Web Page.
-</para>
-
-<para>
-Some details about Parallel Haskell follow.  For more information
-about concurrent Haskell, see the module
-<literal>Control.Concurrent</literal> in the library documentation.
-</para>
-
-<sect2>
-<title>Features specific to Parallel Haskell
-<indexterm><primary>Parallel Haskell&mdash;features</primary></indexterm></title>
-
-<sect3>
-<title>The <literal>Parallel</literal> interface (recommended)
-<indexterm><primary>Parallel interface</primary></indexterm></title>
-
-<para>
-GHC provides two functions for controlling parallel execution, through
-the <literal>Parallel</literal> interface:
-</para>
-
-<para>
-
-<programlisting>
-interface Parallel where
-infixr 0 `par`
-infixr 1 `seq`
-
-par :: a -&#62; b -&#62; b
-seq :: a -&#62; b -&#62; b
-</programlisting>
-
-</para>
-
-<para>
-The expression <literal>(x `par` y)</literal> <emphasis>sparks</emphasis> the evaluation of <literal>x</literal>
-(to weak head normal form) and returns <literal>y</literal>.  Sparks are queued for
-execution in FIFO order, but are not executed immediately.  At the
-next heap allocation, the currently executing thread will yield
-control to the scheduler, and the scheduler will start a new thread
-(until reaching the active thread limit) for each spark which has not
-already been evaluated to WHNF.
-</para>
-
-<para>
-The expression <literal>(x `seq` y)</literal> evaluates <literal>x</literal> to weak head normal
-form and then returns <literal>y</literal>.  The <function>seq</function> primitive can be used to
-force evaluation of an expression beyond WHNF, or to impose a desired
-execution sequence for the evaluation of an expression.
-</para>
-
-<para>
-For example, consider the following parallel version of our old
-nemesis, <function>nfib</function>:
-</para>
-
-<para>
-
-<programlisting>
-import Parallel
-
-nfib :: Int -&#62; Int
-nfib n | n &#60;= 1 = 1
-       | otherwise = par n1 (seq n2 (n1 + n2 + 1))
-                     where n1 = nfib (n-1)
-                           n2 = nfib (n-2)
-</programlisting>
-
-</para>
-
-<para>
-For values of <varname>n</varname> greater than 1, we use <function>par</function> to spark a thread
-to evaluate <literal>nfib (n-1)</literal>, and then we use <function>seq</function> to force the
-parent thread to evaluate <literal>nfib (n-2)</literal> before going on to add
-together these two subexpressions.  In this divide-and-conquer
-approach, we only spark a new thread for one branch of the computation
-(leaving the parent to evaluate the other branch).  Also, we must use
-<function>seq</function> to ensure that the parent will evaluate <varname>n2</varname> <emphasis>before</emphasis>
-<varname>n1</varname> in the expression <literal>(n1 + n2 + 1)</literal>.  It is not sufficient to
-reorder the expression as <literal>(n2 + n1 + 1)</literal>, because the compiler may
-not generate code to evaluate the addends from left to right.
-</para>
-
-</sect3>
-
-<sect3>
-<title>Underlying functions and primitives
-<indexterm><primary>parallelism primitives</primary></indexterm>
-<indexterm><primary>primitives for parallelism</primary></indexterm></title>
-
-<para>
-The functions <function>par</function> and <function>seq</function> are wired into GHC, and unfold
-into uses of the <function>par&num;</function> and <function>seq&num;</function> primitives, respectively.  If
-you'd like to see this with your very own eyes, just run GHC with the
-<option>-ddump-simpl</option> option.  (Anything for a good time&hellip;)
-</para>
-
-</sect3>
-
-<sect3>
-<title>Scheduling policy for concurrent threads
-<indexterm><primary>Scheduling&mdash;concurrent</primary></indexterm>
-<indexterm><primary>Concurrent scheduling</primary></indexterm></title>
-
-<para>
-Runnable threads are scheduled in round-robin fashion.  Context
-switches are signalled by the generation of new sparks or by the
-expiry of a virtual timer (the timer interval is configurable with the
-<option>-C[&lt;num&gt;]</option><indexterm><primary>-C&lt;num&gt; RTS option (concurrent,
-parallel)</primary></indexterm> RTS option).  However, a context switch doesn't
-really happen until the current heap block is full.  You can't get any
-faster context switching than this.
-</para>
-
-<para>
-When a context switch occurs, pending sparks which have not already
-been reduced to weak head normal form are turned into new threads.
-However, there is a limit to the number of active threads (runnable or
-blocked) which are allowed at any given time.  This limit can be
-adjusted with the <option>-t&lt;num&gt;</option><indexterm><primary>-t &lt;num&gt; RTS option (concurrent, parallel)</primary></indexterm>
-RTS option (the default is 32).  Once the
-thread limit is reached, any remaining sparks are deferred until some
-of the currently active threads are completed.
-</para>
-
-</sect3>
-
-<sect3>
-<title>Scheduling policy for parallel threads
-<indexterm><primary>Scheduling&mdash;parallel</primary></indexterm>
-<indexterm><primary>Parallel scheduling</primary></indexterm></title>
-
-<para>
-In GUM we use an unfair scheduler, which means that a thread continues to
-perform graph reduction until it blocks on a closure under evaluation, on a
-remote closure or until the thread finishes. 
-</para>
- 
-</sect3>
-
-</sect2>
-
-</sect1>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter" "sect1") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/phases.xml b/ghc/docs/users_guide/phases.xml
deleted file mode 100644
index fd034a305a..0000000000
--- a/ghc/docs/users_guide/phases.xml
+++ /dev/null
@@ -1,874 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<sect1 id="options-phases">
-  <title>Options related to a particular phase</title>
-
-  <sect2 id="replacing-phases">
-    <title>Replacing the program for one or more phases</title>
-    <indexterm><primary>phases, changing</primary></indexterm>
-    
-    <para>You may specify that a different program be used for one
-    of the phases of the compilation system, in place of whatever
-    the <command>ghc</command> has wired into it.  For example, you
-    might want to try a different assembler.  The following options
-    allow you to change the external program used for a given
-    compilation phase:</para>
-
-    <variablelist>
-      <varlistentry>
-        <term>
-          <option>-pgmL</option> <replaceable>cmd</replaceable>
-        <indexterm><primary><option>-pgmL</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Use <replaceable>cmd</replaceable> as the literate
-          pre-processor.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-pgmP</option> <replaceable>cmd</replaceable>
-          <indexterm><primary><option>-pgmP</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Use <replaceable>cmd</replaceable> as the C
-          pre-processor (with <option>-cpp</option> only).</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-pgmc</option> <replaceable>cmd</replaceable>
-          <indexterm><primary><option>-pgmc</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Use <replaceable>cmd</replaceable> as the C
-          compiler.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-pgma</option> <replaceable>cmd</replaceable>
-          <indexterm><primary><option>-pgma</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Use <replaceable>cmd</replaceable> as the
-          assembler.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-pgml</option> <replaceable>cmd</replaceable>
-          <indexterm><primary><option>-pgml</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Use <replaceable>cmd</replaceable> as the
-          linker.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-pgmdll</option> <replaceable>cmd</replaceable>
-          <indexterm><primary><option>-pgmdll</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Use <replaceable>cmd</replaceable> as the DLL
-          generator.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-pgmdep</option> <replaceable>cmd</replaceable>
-          <indexterm><primary><option>-pgmdep</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Use <replaceable>cmd</replaceable> as the dependency
-          generator.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-pgmF</option> <replaceable>cmd</replaceable>
-          <indexterm><primary><option>-pgmF</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Use <replaceable>cmd</replaceable> as the
-          pre-processor (with <option>-F</option> only).</para>
-        </listitem>
-      </varlistentry>
-
-
-    </variablelist>
-  </sect2>
-
-  <sect2 id="forcing-options-through">
-    <title>Forcing options to a particular phase</title>
-    <indexterm><primary>forcing GHC-phase options</primary></indexterm>
-
-    <para>Options can be forced through to a particlar compilation
-    phase, using the following flags:</para>
-
-    <variablelist>
-      <varlistentry>
-        <term>
-          <option>-optL</option> <replaceable>option</replaceable>
-          <indexterm><primary><option>-optL</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Pass <replaceable>option</replaceable> to the
-          literate pre-processor</para>
-        </listitem>
-      </varlistentry>
-      <varlistentry>
-        <term>
-          <option>-optP</option>  <replaceable>option</replaceable>
-          <indexterm><primary><option>-optP</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Pass <replaceable>option</replaceable> to CPP (makes
-          sense only if <option>-cpp</option> is also on).</para>
-        </listitem>
-      </varlistentry>
-      <varlistentry>
-        <term>
-          <option>-optF</option> <replaceable>option</replaceable>
-          <indexterm><primary><option>-optF</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Pass <replaceable>option</replaceable> to the
-          custom pre-processor (see <xref linkend="pre-processor"/>).</para>
-        </listitem>
-      </varlistentry>
-      <varlistentry>
-        <term>
-          <option>-optc</option> <replaceable>option</replaceable>
-          <indexterm><primary><option>-optc</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Pass <replaceable>option</replaceable> to the C compiler.</para>
-        </listitem>
-      </varlistentry>
-      <varlistentry>
-        <term>
-          <option>-opta</option>  <replaceable>option</replaceable>
-          <indexterm><primary><option>-opta</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Pass <replaceable>option</replaceable> to the assembler.</para>
-        </listitem>
-      </varlistentry>
-      <varlistentry>
-        <term>
-          <option>-optl</option> <replaceable>option</replaceable>
-          <indexterm><primary><option>-optl</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Pass <replaceable>option</replaceable> to the linker.</para>
-        </listitem>
-      </varlistentry>
-      <varlistentry>
-        <term>
-          <option>-optdll</option>  <replaceable>option</replaceable>
-          <indexterm><primary><option>-optdll</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Pass <replaceable>option</replaceable> to the DLL generator.</para>
-        </listitem>
-      </varlistentry>
-      <varlistentry>
-        <term>
-          <option>-optdep</option>  <replaceable>option</replaceable>
-          <indexterm><primary><option>-optdep</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Pass <replaceable>option</replaceable> to the
-          dependency generator.</para>
-        </listitem>
-      </varlistentry>
-    </variablelist>
-
-    <para>So, for example, to force an <option>-Ewurble</option>
-    option to the assembler, you would tell the driver
-    <option>-opta-Ewurble</option> (the dash before the E is
-    required).</para>
-
-    <para>GHC is itself a Haskell program, so if you need to pass
-    options directly to GHC's runtime system you can enclose them in
-    <literal>+RTS ... -RTS</literal> (see <xref
-    linkend="runtime-control"/>).</para>
-
-  </sect2>
-
-  <sect2 id="c-pre-processor">
-    <title>Options affecting the C pre-processor</title>
-
-    <indexterm><primary>pre-processing: cpp</primary></indexterm>
-    <indexterm><primary>C pre-processor options</primary></indexterm>
-    <indexterm><primary>cpp, pre-processing with</primary></indexterm>
-
-    <variablelist>
-
-      <varlistentry>
-        <term>
-          <option>-cpp</option>
-          <indexterm><primary><option>-cpp</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>The C pre-processor <command>cpp</command> is run
-          over your Haskell code only if the <option>-cpp</option>
-          option <indexterm><primary>-cpp
-          option</primary></indexterm> is given.  Unless you are
-          building a large system with significant doses of
-          conditional compilation, you really shouldn't need
-          it.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-D</option><replaceable>symbol</replaceable><optional>=<replaceable>value</replaceable></optional>
-          <indexterm><primary><option>-D</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Define macro <replaceable>symbol</replaceable> in the
-          usual way.  NB: does <emphasis>not</emphasis> affect
-          <option>-D</option> macros passed to the C&nbsp;compiler
-          when compiling via C!  For those, use the
-          <option>-optc-Dfoo</option> hack&hellip; (see <xref
-          linkend="forcing-options-through"/>).</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-U</option><replaceable>symbol</replaceable>
-          <indexterm><primary><option>-U</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para> Undefine macro <replaceable>symbol</replaceable> in the
-          usual way.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-I</option><replaceable>dir</replaceable>
-          <indexterm><primary><option>-I</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para> Specify a directory in which to look for
-          <literal>&num;include</literal> files, in the usual C
-          way.</para>
-        </listitem>
-      </varlistentry>
-    </variablelist>
-
-    <para>The GHC driver pre-defines several macros when processing
-    Haskell source code (<filename>.hs</filename> or
-    <filename>.lhs</filename> files).</para>
-
-    <para>The symbols defined by GHC are listed below.  To check which
-    symbols are defined by your local GHC installation, the following
-    trick is useful:</para>
-
-<screen>$ ghc -E -optP-dM -cpp foo.hs
-$ cat foo.hspp</screen>
-
-    <para>(you need a file <filename>foo.hs</filename>, but it isn't
-    actually used).</para>
-
-    <variablelist>
-      <varlistentry>
-        <term>
-          <constant>&lowbar;&lowbar;HASKELL98&lowbar;&lowbar;</constant>
-          <indexterm><primary><literal>&lowbar;&lowbar;HASKELL98&lowbar;&lowbar;</literal></primary></indexterm>
-        </term>
-        <listitem>
-          <para>If defined, this means that GHC supports the
-          language defined by the Haskell 98 report.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <constant>&lowbar;&lowbar;HASKELL&lowbar;&lowbar;=98</constant>
-          <indexterm><primary><constant>&lowbar;&lowbar;HASKELL&lowbar;&lowbar;=98</constant></primary></indexterm>
-        </term>
-        <listitem>
-          <para>In GHC 4.04 and later, the
-          <constant>&lowbar;&lowbar;HASKELL&lowbar;&lowbar;</constant>
-          macro is defined as having the value
-          <constant>98</constant>.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <constant>&lowbar;&lowbar;HASKELL1&lowbar;&lowbar;</constant>
-          <indexterm><primary><constant>&lowbar;&lowbar;HASKELL1&lowbar;&lowbar;</constant></primary></indexterm>
-        </term>
-        <listitem>
-          <para>If defined to <replaceable>n</replaceable>, that
-          means GHC supports the Haskell language defined in the
-          Haskell report version <emphasis>1.n</emphasis>.
-          Currently 5.  This macro is deprecated, and will probably
-          disappear in future versions.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <constant>&lowbar;&lowbar;GLASGOW&lowbar;HASKELL&lowbar;&lowbar;</constant>
-          <indexterm><primary><constant>&lowbar;&lowbar;GLASGOW&lowbar;HASKELL&lowbar;&lowbar;</constant></primary></indexterm>
-        </term>
-        <listitem>
-          <para>For version
-          <literal><replaceable>x</replaceable>.<replaceable>y</replaceable>.<replaceable>z</replaceable></literal>
-          of GHC, the value of
-          <constant>&lowbar;&lowbar;GLASGOW&lowbar;HASKELL&lowbar;&lowbar;</constant>
-          is the integer <replaceable>xyy</replaceable> (if
-        <replaceable>y</replaceable> is a single digit, then a leading zero
-        is added, so for example in version 6.2 of GHC,
-        <literal>__GLASGOW_HASKELL__==602</literal>).  More
-          information in <xref linkend="version-numbering"/>.</para>
-
-          <para>With any luck,
-          <constant>&lowbar;&lowbar;GLASGOW&lowbar;HASKELL&lowbar;&lowbar;</constant>
-          will be undefined in all other implementations that
-          support C-style pre-processing.</para>
-
-          <para>(For reference: the comparable symbols for other
-          systems are:
-          <constant>&lowbar;&lowbar;HUGS&lowbar;&lowbar;</constant>
-          for Hugs,
-          <constant>&lowbar;&lowbar;NHC&lowbar;&lowbar;</constant>
-          for nhc98, and
-          <constant>&lowbar;&lowbar;HBC&lowbar;&lowbar;</constant>
-          for hbc.)</para>
-
-          <para>NB. This macro is set when pre-processing both
-          Haskell source and C source, including the C source
-          generated from a Haskell module
-          (i.e. <filename>.hs</filename>, <filename>.lhs</filename>,
-          <filename>.c</filename> and <filename>.hc</filename>
-          files).</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-      <term>
-          <constant>&lowbar;&lowbar;CONCURRENT&lowbar;HASKELL&lowbar;&lowbar;</constant>
-          <indexterm><primary><constant>&lowbar;&lowbar;CONCURRENT&lowbar;HASKELL&lowbar;&lowbar;</constant></primary></indexterm>
-        </term>
-      <listitem>
-        <para>This symbol is defined when pre-processing Haskell
-          (input) and pre-processing C (GHC output).  Since GHC from
-          verion 4.00 now supports concurrent haskell by default,
-          this symbol is always defined.</para>
-        </listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term>
-          <constant>&lowbar;&lowbar;PARALLEL&lowbar;HASKELL&lowbar;&lowbar;</constant>
-          <indexterm><primary><constant>&lowbar;&lowbar;PARALLEL&lowbar;HASKELL&lowbar;&lowbar;</constant></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Only defined when <option>-parallel</option> is in
-          use!  This symbol is defined when pre-processing Haskell
-          (input) and pre-processing C (GHC output).</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <constant><replaceable>os</replaceable>_HOST_OS=1</constant>
-        </term>
-	<listitem>
-	  <para>This define allows conditional compilation based on
-          the Operating System, where<replaceable>os</replaceable> is
-          the name of the current Operating System
-          (eg. <literal>linux</literal>, <literal>mingw32</literal>
-          for Windows, <literal>solaris</literal>, etc.).</para>
-	</listitem>
-      </varlistentry>
-	
-      <varlistentry>
-	<term>
-          <constant><replaceable>arch</replaceable>_HOST_ARCH=1</constant>
-        </term>
-	<listitem>
-	  <para>This define allows conditional compilation based on
-          the host architecture, where<replaceable>arch</replaceable>
-          is the name of the current architecture
-          (eg. <literal>i386</literal>, <literal>x86_64</literal>,
-          <literal>powerpc</literal>, <literal>sparc</literal>,
-          etc.).</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-    <sect3 id="cpp-string-gaps">
-      <title>CPP and string gaps</title>
-
-      <para>A small word of warning: <option>-cpp</option> is not
-      friendly to &ldquo;string gaps&rdquo;.<indexterm><primary>-cpp
-      vs string gaps</primary></indexterm><indexterm><primary>string
-      gaps vs -cpp</primary></indexterm>.  In other words, strings
-      such as the following:</para>
-
-<programlisting>strmod = "\
-\ p \
-\ "</programlisting>
-      
-      <para>don't work with <option>-cpp</option>;
-      <filename>/usr/bin/cpp</filename> elides the backslash-newline
-      pairs.</para>
-
-      <para>However, it appears that if you add a space at the end
-      of the line, then <command>cpp</command> (at least GNU
-      <command>cpp</command> and possibly other
-      <command>cpp</command>s) leaves the backslash-space pairs
-      alone and the string gap works as expected.</para>
-    </sect3>
-  </sect2>
-
-  <sect2 id="pre-processor">
-    <title>Options affecting a Haskell pre-processor</title>
-    
-    <indexterm><primary>pre-processing: custom</primary></indexterm>
-    <indexterm><primary>Pre-processor options</primary></indexterm>
-
-    <variablelist>
-      <varlistentry>
-        <term>
-          <option>-F</option>
-          <indexterm><primary><option>-F</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>A custom pre-processor is run over your Haskell
-          source file only if the <option>-F</option> option
-          <indexterm><primary>-F</primary></indexterm> is
-          given.</para>
-
-          <para>Running a custom pre-processor at compile-time is in
-          some settings appropriate and useful. The
-          <option>-F</option> option lets you run a pre-processor as
-          part of the overall GHC compilation pipeline, which has
-          the advantage over running a Haskell pre-processor
-          separately in that it works in interpreted mode and you
-          can continue to take reap the benefits of GHC's
-          recompilation checker.</para>
-
-          <para>The pre-processor is run just before the Haskell
-          compiler proper processes the Haskell input, but after the
-          literate markup has been stripped away and (possibly) the
-          C pre-processor has washed the Haskell input.</para>
-
-          <para>Use
-          <option>-pgmF&nbsp;<replaceable>cmd</replaceable></option>
-          to select the program to use as the preprocessor.  When
-          invoked, the <replaceable>cmd</replaceable> pre-processor
-          is given at least three arguments on its command-line: the
-          first argument is the name of the original source file,
-          the second is the name of the file holding the input, and
-          the third is the name of the file where
-          <replaceable>cmd</replaceable> should write its output
-          to.</para>
-
-          <para>Additional arguments to the pre-processor can be
-          passed in using the <option>-optF</option> option. These
-          are fed to <replaceable>cmd</replaceable> on the command
-          line after the three standard input and output
-          arguments.</para>
-        </listitem>
-      </varlistentry>
-    </variablelist>
-  </sect2>
-
-  <sect2 id="options-C-compiler">
-    <title>Options affecting the C compiler (if applicable)</title>
-
-    <indexterm><primary>include-file options</primary></indexterm>
-    <indexterm><primary>C compiler options</primary></indexterm>
-    <indexterm><primary>GCC options</primary></indexterm>
-
-    <para>If you are compiling with lots of foreign calls, you may
-    need to tell the C&nbsp;compiler about some
-    <literal>&num;include</literal> files.  The Right Way to do this is to
-      add an <literal>INCLUDE</literal> pragma to the top of your source file
-      (<xref linkend="include-pragma" />):</para>
-
-<programlisting>{-# INCLUDE &lt;X/Xlib.h&gt; #-}</programlisting>
-      
-    <para>Sometimes this isn't convenient.  In those cases there's an
-      equivalent command-line option:</para>
-
-<screen>% ghc -c '-#include &lt;X/Xlib.h&gt;' Xstuff.lhs</screen>
-
-    <indexterm><primary><option>-#include</option></primary>
-    </indexterm>
-
-  </sect2>
-
-  <sect2 id="options-codegen">
-    <title>Options affecting code generation</title>
-
-    <variablelist>
-      <varlistentry>
-        <term>
-          <option>-fasm</option>
-          <indexterm><primary><option>-fasm</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Use GHC's native code generator rather than
-          compiling via C.  This will compile faster (up to twice as
-          fast), but may produce code that is slightly slower than
-          compiling via C.  <option>-fasm</option> is the default
-          when optimisation is off (see <xref
-          linkend="options-optimise"/>).</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-fvia-C</option>
-          <indexterm><primary><option>-fvia-C</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Compile via C instead of using the native code
-          generator.  This is default for optimised compilations,
-          and on architectures for which GHC doesn't have a native
-          code generator.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-fno-code</option>
-          <indexterm><primary><option>-fno-code</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Omit code generation (and all later phases)
-          altogether.  Might be of some use if you just want to see
-          dumps of the intermediate compilation phases.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-fPIC</option>
-          <indexterm><primary><option>-fPIC</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Generate position-independent code (code that can be put into
-          shared libraries). This currently works on Mac OS X; it works on
-          PowerPC Linux when using the native code generator (-fasm).
-          It is not quite ready to be used yet for x86 Linux.
-          On Windows, position-independent code is never used,
-          and on PowerPC64 Linux, position-independent code is always used,
-          so the flag is a no-op on those platforms.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-dynamic</option>
-        </term>
-        <listitem>
-          <para>When generating code, assume that entities imported from a
-          different package will reside in a different shared library or
-          binary. This currently works on Mac OS X; it works on PowerPC Linux when
-          using the native code generator. As with <option>-fPIC</option>,
-          x86 Linux support is not quite ready yet. Windows is not supported,
-          and it is a no-op on PowerPC64 Linux.</para>
-          <para>Note that this option also causes GHC to use shared libraries
-          when linking.</para>
-        </listitem>
-      </varlistentry>
-    </variablelist>
-  </sect2>
-
-  <sect2 id="options-linker">
-    <title>Options affecting linking</title>
-
-    <indexterm><primary>linker options</primary></indexterm>
-    <indexterm><primary>ld options</primary></indexterm>
-
-
-    <para>GHC has to link your code with various libraries, possibly
-    including: user-supplied, GHC-supplied, and system-supplied
-    (<option>-lm</option> math library, for example).</para>
-
-    <variablelist>
-
-      <varlistentry>
-        <term>
-          <option>-l</option><replaceable>lib</replaceable>
-          <indexterm><primary><option>-l</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Link in the <replaceable>lib</replaceable> library.
-          On Unix systems, this will be in a file called
-          <filename>lib<replaceable>lib</replaceable>.a</filename>
-          or
-          <filename>lib<replaceable>lib</replaceable>.so</filename>
-          which resides somewhere on the library directories path.</para>
-
-          <para>Because of the sad state of most UNIX linkers, the
-          order of such options does matter.  If library
-          <replaceable>foo</replaceable> requires library
-          <replaceable>bar</replaceable>, then in general
-          <option>-l</option><replaceable>foo</replaceable> should
-          come <emphasis>before</emphasis>
-          <option>-l</option><replaceable>bar</replaceable> on the
-          command line.</para>
-
-          <para>There's one other gotcha to bear in mind when using
-          external libraries: if the library contains a
-          <literal>main()</literal> function, then this will be
-          linked in preference to GHC's own
-          <literal>main()</literal> function
-          (eg. <literal>libf2c</literal> and <literal>libl</literal>
-          have their own <literal>main()</literal>s).  This is
-          because GHC's <literal>main()</literal> comes from the
-          <literal>HSrts</literal> library, which is normally
-          included <emphasis>after</emphasis> all the other
-          libraries on the linker's command line.  To force GHC's
-          <literal>main()</literal> to be used in preference to any
-          other <literal>main()</literal>s from external libraries,
-          just add the option <option>-lHSrts</option> before any
-          other libraries on the command line.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-c</option>
-          <indexterm><primary><option>-c</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Omits the link step.  This option can be used with
-	    <option>&ndash;&ndash;make</option> to avoid the automatic linking
-	    that takes place if the program contains a <literal>Main</literal>
-	    module.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-package</option> <replaceable>name</replaceable>
-          <indexterm><primary><option>-package</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>If you are using a Haskell &ldquo;package&rdquo;
-          (see <xref linkend="packages"/>), don't forget to add the
-          relevant <option>-package</option> option when linking the
-          program too: it will cause the appropriate libraries to be
-          linked in with the program.  Forgetting the
-          <option>-package</option> option will likely result in
-          several pages of link errors.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-framework</option> <replaceable>name</replaceable>
-          <indexterm><primary><option>-framework</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>On Darwin/MacOS X only, link in the framework <replaceable>name</replaceable>.
-          This option corresponds to the <option>-framework</option> option for Apple's Linker.
-          Please note that frameworks and packages are two different things - frameworks don't
-          contain any haskell code. Rather, they are Apple's way of packaging shared libraries.
-          To link to Apple's &ldquo;Carbon&rdquo; API, for example, you'd use
-          <option>-framework Carbon</option>.
-          </para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-L</option><replaceable>dir</replaceable>
-          <indexterm><primary><option>-L</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Where to find user-supplied libraries&hellip;
-          Prepend the directory <replaceable>dir</replaceable> to
-          the library directories path.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-framework-path</option><replaceable>dir</replaceable>
-          <indexterm><primary><option>-framework-path</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>On Darwin/MacOS X only, prepend the directory <replaceable>dir</replaceable> to
-          the framework directories path. This option corresponds to the <option>-F</option>
-          option for Apple's Linker (<option>-F</option> already means something else for GHC).</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-split-objs</option>
-          <indexterm><primary><option>-split-objs</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Tell the linker to split the single object file that
-          would normally be generated into multiple object files,
-          one per top-level Haskell function or type in the module.
-          We use this feature for building GHC's libraries libraries
-          (warning: don't use it unless you know what you're
-          doing!).</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-static</option>
-          <indexterm><primary><option>-static</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Tell the linker to avoid shared Haskell libraries,
-          if possible.  This is the default.</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-dynamic</option>
-          <indexterm><primary><option>-dynamic</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Tell the linker to use shared Haskell libraries, if
-          available (this option is only supported on Mac OS X at the
-          moment, and also note that your distribution of GHC may
-          not have been supplied with shared libraries).</para>
-          <para>Note that this option also has an effect on
-          code generation (see above).</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-main-is <replaceable>thing</replaceable></option>
-          <indexterm><primary><option>-main-is</option></primary></indexterm>
-          <indexterm><primary>specifying your own main function</primary></indexterm>
-        </term>
-        <listitem>
-          <para> The normal rule in Haskell is that your program must supply a <literal>main</literal>
-            function in module <literal>Main</literal>.  When testing, it is often convenient
-            to change which function is the "main" one, and the <option>-main-is</option> flag
-            allows you to do so.  The  <replaceable>thing</replaceable> can be one of:
-            <itemizedlist>
-      	<listitem><para>A lower-case identifier <literal>foo</literal>.  GHC assumes that the main function is <literal>Main.foo</literal>.</para></listitem>
-      	<listitem><para>An module name <literal>A</literal>.  GHC assumes that the main function is <literal>A.main</literal>.</para></listitem>
-      	<listitem><para>An qualified name <literal>A.foo</literal>.  GHC assumes that the main function is <literal>A.foo</literal>.</para></listitem>
-      	</itemizedlist>
-            Strictly speaking, <option>-main-is</option> is not a link-phase flag at all; it has no effect on the link step.
-            The flag must be specified when compiling the module containing the specified main function (e.g. module <literal>A</literal>
-            in the latter two items above).  It has no effect for other modules,
-            and hence can safely be given to <literal>ghc --make</literal>.
-	    However, if all the modules are otherwise up to date, you may need to force
-	    recompilation both of the module where the new "main" is, and of the
-	    module where the "main" function used to be;
-	    <literal>ghc</literal> is not clever 
-	    enough to figure out that they both need recompiling.  You can
-	    force recompilation by removing the object file, or by using the
-	    <option>-no-recomp</option> flag.
-            </para> 
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-no-hs-main</option>
-          <indexterm><primary><option>-no-hs-main</option></primary></indexterm>
-          <indexterm><primary>linking Haskell libraries with foreign code</primary></indexterm>
-        </term>
-        <listitem>
-          <para>In the event you want to include ghc-compiled code
-          as part of another (non-Haskell) program, the RTS will not
-          be supplying its definition of <function>main()</function>
-          at link-time, you will have to. To signal that to the
-          compiler when linking, use
-          <option>-no-hs-main</option>. See also <xref linkend="using-own-main"/>.</para>
-
-          <para>Notice that since the command-line passed to the
-          linker is rather involved, you probably want to use
-          <command>ghc</command> to do the final link of your
-          `mixed-language' application. This is not a requirement
-          though, just try linking once with <option>-v</option> on
-          to see what options the driver passes through to the
-          linker.</para>
-
-          <para>The <option>-no-hs-main</option> flag can also be
-          used to persuade the compiler to do the link step in
-          <option>--make</option> mode when there is no Haskell
-          <literal>Main</literal> module present (normally the
-          compiler will not attempt linking when there is no
-          <literal>Main</literal>).</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-debug</option>
-          <indexterm><primary><option>-debug</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Link the program with a debugging version of the
-          runtime system.  The debugging runtime turns on numerous
-          assertions and sanity checks, and provides extra options
-          for producing debugging output at runtime (run the program
-          with <literal>+RTS&nbsp;-?</literal> to see a list).</para>
-        </listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term>
-          <option>-threaded</option>
-          <indexterm><primary><option>-threaded</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Link the program with the "threaded" runtime system.
-          This version of the runtime is designed to be used in
-          programs that use multiple operating-system threads.  It
-          supports calls to foreign-exported functions from multiple
-          OS threads.  Calls to foreign functions are made using the
-          same OS thread that created the Haskell thread (if it was
-          created by a call-in), or an arbitrary OS thread otherwise
-          (if the Haskell thread was created by
-          <literal>forkIO</literal>).</para>
-
-          <para>More details on the use of "bound threads" in the
-          threaded runtime can be found in the <ulink
-          url="../libraries/base/Control.Concurrent.html"><literal>Control.Concurrent</literal></ulink> module.</para>
-
-          <para>The threaded RTS does <emphasis>not</emphasis>
-          support using multiple CPUs to speed up execution of a
-          multi-threaded Haskell program.  The GHC runtime platform
-          is still single-threaded, but using the
-          <option>-threaded</option> option it can be used safely in
-          a multi-threaded environment.</para>
-        </listitem>
-      </varlistentry>
-    </variablelist>
-  </sect2>
-
-</sect1>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter" "sect1") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/primitives.xml b/ghc/docs/users_guide/primitives.xml
deleted file mode 100644
index e41bb59ee1..0000000000
--- a/ghc/docs/users_guide/primitives.xml
+++ /dev/null
@@ -1,1215 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<!-- UNBOXED TYPES AND PRIMITIVE OPERATIONS -->
-
-<sect1 id="primitives">
-  <title>Unboxed types and primitive operations</title>
-  <indexterm><primary>GHC.Exts module</primary></indexterm>
-
-  <para>This chapter defines all the types which are primitive in
-  Glasgow Haskell, and the operations provided for them. You bring
-  them into scope by importing module <literal>GHC.Exts</literal>.</para>
-
-  <para>Note: while you really can use this stuff to write fast code,
-  we generally find it a lot less painful, and more satisfying in the
-  long run, to use higher-level language features and libraries.  With
-  any luck, the code you write will be optimised to the efficient
-  unboxed version in any case.  And if it isn't, we'd like to know
-  about it.</para>
-  
-<sect2 id="glasgow-unboxed">
-<title>Unboxed types
-</title>
-
-<para>
-<indexterm><primary>Unboxed types (Glasgow extension)</primary></indexterm>
-</para>
-
-<para>Most types in GHC are <firstterm>boxed</firstterm>, which means
-that values of that type are represented by a pointer to a heap
-object.  The representation of a Haskell <literal>Int</literal>, for
-example, is a two-word heap object.  An <firstterm>unboxed</firstterm>
-type, however, is represented by the value itself, no pointers or heap
-allocation are involved.
-</para>
-
-<para>
-Unboxed types correspond to the &ldquo;raw machine&rdquo; types you
-would use in C: <literal>Int&num;</literal> (long int),
-<literal>Double&num;</literal> (double), <literal>Addr&num;</literal>
-(void *), etc.  The <emphasis>primitive operations</emphasis>
-(PrimOps) on these types are what you might expect; e.g.,
-<literal>(+&num;)</literal> is addition on
-<literal>Int&num;</literal>s, and is the machine-addition that we all
-know and love&mdash;usually one instruction.
-</para>
-
-<para>
-Primitive (unboxed) types cannot be defined in Haskell, and are
-therefore built into the language and compiler.  Primitive types are
-always unlifted; that is, a value of a primitive type cannot be
-bottom.  We use the convention that primitive types, values, and
-operations have a <literal>&num;</literal> suffix.
-</para>
-
-<para>
-Primitive values are often represented by a simple bit-pattern, such
-as <literal>Int&num;</literal>, <literal>Float&num;</literal>,
-<literal>Double&num;</literal>.  But this is not necessarily the case:
-a primitive value might be represented by a pointer to a
-heap-allocated object.  Examples include
-<literal>Array&num;</literal>, the type of primitive arrays.  A
-primitive array is heap-allocated because it is too big a value to fit
-in a register, and would be too expensive to copy around; in a sense,
-it is accidental that it is represented by a pointer.  If a pointer
-represents a primitive value, then it really does point to that value:
-no unevaluated thunks, no indirections&hellip;nothing can be at the
-other end of the pointer than the primitive value.
-</para>
-
-<para>
-There are some restrictions on the use of primitive types, the main
-one being that you can't pass a primitive value to a polymorphic
-function or store one in a polymorphic data type.  This rules out
-things like <literal>[Int&num;]</literal> (i.e. lists of primitive
-integers).  The reason for this restriction is that polymorphic
-arguments and constructor fields are assumed to be pointers: if an
-unboxed integer is stored in one of these, the garbage collector would
-attempt to follow it, leading to unpredictable space leaks.  Or a
-<function>seq</function> operation on the polymorphic component may
-attempt to dereference the pointer, with disastrous results.  Even
-worse, the unboxed value might be larger than a pointer
-(<literal>Double&num;</literal> for instance).
-</para>
-
-<para>
-Nevertheless, A numerically-intensive program using unboxed types can
-go a <emphasis>lot</emphasis> faster than its &ldquo;standard&rdquo;
-counterpart&mdash;we saw a threefold speedup on one example.
-</para>
-
-</sect2>
-
-<sect2 id="unboxed-tuples">
-<title>Unboxed Tuples
-</title>
-
-<para>
-Unboxed tuples aren't really exported by <literal>GHC.Exts</literal>,
-they're available by default with <option>-fglasgow-exts</option>.  An
-unboxed tuple looks like this:
-</para>
-
-<para>
-
-<programlisting>
-(# e_1, ..., e_n #)
-</programlisting>
-
-</para>
-
-<para>
-where <literal>e&lowbar;1..e&lowbar;n</literal> are expressions of any
-type (primitive or non-primitive).  The type of an unboxed tuple looks
-the same.
-</para>
-
-<para>
-Unboxed tuples are used for functions that need to return multiple
-values, but they avoid the heap allocation normally associated with
-using fully-fledged tuples.  When an unboxed tuple is returned, the
-components are put directly into registers or on the stack; the
-unboxed tuple itself does not have a composite representation.  Many
-of the primitive operations listed in this section return unboxed
-tuples.
-</para>
-
-<para>
-There are some pretty stringent restrictions on the use of unboxed tuples:
-</para>
-
-<para>
-
-<itemizedlist>
-<listitem>
-
-<para>
- Unboxed tuple types are subject to the same restrictions as
-other unboxed types; i.e. they may not be stored in polymorphic data
-structures or passed to polymorphic functions.
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- Unboxed tuples may only be constructed as the direct result of
-a function, and may only be deconstructed with a <literal>case</literal> expression.
-eg. the following are valid:
-
-
-<programlisting>
-f x y = (# x+1, y-1 #)
-g x = case f x x of { (# a, b #) -&#62; a + b }
-</programlisting>
-
-
-but the following are invalid:
-
-
-<programlisting>
-f x y = g (# x, y #)
-g (# x, y #) = x + y
-</programlisting>
-
-
-</para>
-</listitem>
-<listitem>
-
-<para>
- No variable can have an unboxed tuple type.  This is illegal:
-
-
-<programlisting>
-f :: (# Int, Int #) -&#62; (# Int, Int #)
-f x = x
-</programlisting>
-
-
-because <literal>x</literal> has an unboxed tuple type.
-
-</para>
-</listitem>
-
-</itemizedlist>
-
-</para>
-
-<para>
-Note: we may relax some of these restrictions in the future.
-</para>
-
-<para>
-The <literal>IO</literal> and <literal>ST</literal> monads use unboxed
-tuples to avoid unnecessary allocation during sequences of operations.
-</para>
-
-</sect2>
-
-<sect2>
-<title>Character and numeric types</title>
-
-<indexterm><primary>character types, primitive</primary></indexterm>
-<indexterm><primary>numeric types, primitive</primary></indexterm>
-<indexterm><primary>integer types, primitive</primary></indexterm>
-<indexterm><primary>floating point types, primitive</primary></indexterm>
-<para>
-There are the following obvious primitive types:
-</para>
-
-<programlisting>
-type Char#
-type Int#
-type Word#
-type Addr#
-type Float#
-type Double#
-type Int64#
-type Word64#
-</programlisting>
-
-<indexterm><primary><literal>Char&num;</literal></primary></indexterm>
-<indexterm><primary><literal>Int&num;</literal></primary></indexterm>
-<indexterm><primary><literal>Word&num;</literal></primary></indexterm>
-<indexterm><primary><literal>Addr&num;</literal></primary></indexterm>
-<indexterm><primary><literal>Float&num;</literal></primary></indexterm>
-<indexterm><primary><literal>Double&num;</literal></primary></indexterm>
-<indexterm><primary><literal>Int64&num;</literal></primary></indexterm>
-<indexterm><primary><literal>Word64&num;</literal></primary></indexterm>
-
-<para>
-If you really want to know their exact equivalents in C, see
-<filename>ghc/includes/StgTypes.h</filename> in the GHC source tree.
-</para>
-
-<para>
-Literals for these types may be written as follows:
-</para>
-
-<para>
-
-<programlisting>
-1#              an Int#
-1.2#            a Float#
-1.34##          a Double#
-'a'#            a Char#; for weird characters, use e.g. '\o&#60;octal&#62;'#
-"a"#            an Addr# (a `char *'); only characters '\0'..'\255' allowed
-</programlisting>
-
-<indexterm><primary>literals, primitive</primary></indexterm>
-<indexterm><primary>constants, primitive</primary></indexterm>
-<indexterm><primary>numbers, primitive</primary></indexterm>
-</para>
-
-</sect2>
-
-<sect2>
-<title>Comparison operations</title>
-
-<para>
-<indexterm><primary>comparisons, primitive</primary></indexterm>
-<indexterm><primary>operators, comparison</primary></indexterm>
-</para>
-
-<para>
-
-<programlisting>
-{&#62;,&#62;=,==,/=,&#60;,&#60;=}# :: Int# -&#62; Int# -&#62; Bool
-
-{gt,ge,eq,ne,lt,le}Char# :: Char# -&#62; Char# -&#62; Bool
-    -- ditto for Word# and Addr#
-</programlisting>
-
-<indexterm><primary><literal>&#62;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>&#62;=&num;</literal></primary></indexterm>
-<indexterm><primary><literal>==&num;</literal></primary></indexterm>
-<indexterm><primary><literal>/=&num;</literal></primary></indexterm>
-<indexterm><primary><literal>&#60;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>&#60;=&num;</literal></primary></indexterm>
-<indexterm><primary><literal>gt&lcub;Char,Word,Addr&rcub;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>ge&lcub;Char,Word,Addr&rcub;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>eq&lcub;Char,Word,Addr&rcub;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>ne&lcub;Char,Word,Addr&rcub;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>lt&lcub;Char,Word,Addr&rcub;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>le&lcub;Char,Word,Addr&rcub;&num;</literal></primary></indexterm>
-</para>
-
-</sect2>
-
-<sect2>
-<title>Primitive-character operations</title>
-
-<para>
-<indexterm><primary>characters, primitive operations</primary></indexterm>
-<indexterm><primary>operators, primitive character</primary></indexterm>
-</para>
-
-<para>
-
-<programlisting>
-ord# :: Char# -&#62; Int#
-chr# :: Int# -&#62; Char#
-</programlisting>
-
-<indexterm><primary><literal>ord&num;</literal></primary></indexterm>
-<indexterm><primary><literal>chr&num;</literal></primary></indexterm>
-</para>
-
-</sect2>
-
-<sect2>
-<title>Primitive-<literal>Int</literal> operations</title>
-
-<para>
-<indexterm><primary>integers, primitive operations</primary></indexterm>
-<indexterm><primary>operators, primitive integer</primary></indexterm>
-</para>
-
-<para>
-
-<programlisting>
-{+,-,*,quotInt,remInt,gcdInt}# :: Int# -&#62; Int# -&#62; Int#
-negateInt# :: Int# -&#62; Int#
-
-iShiftL#, iShiftRA#, iShiftRL# :: Int# -&#62; Int# -&#62; Int#
-        -- shift left, right arithmetic, right logical
-
-addIntC#, subIntC#, mulIntC# :: Int# -> Int# -> (# Int#, Int# #)
-	-- add, subtract, multiply with carry
-</programlisting>
-
-<indexterm><primary><literal>+&num;</literal></primary></indexterm>
-<indexterm><primary><literal>-&num;</literal></primary></indexterm>
-<indexterm><primary><literal>*&num;</literal></primary></indexterm>
-<indexterm><primary><literal>quotInt&num;</literal></primary></indexterm>
-<indexterm><primary><literal>remInt&num;</literal></primary></indexterm>
-<indexterm><primary><literal>gcdInt&num;</literal></primary></indexterm>
-<indexterm><primary><literal>iShiftL&num;</literal></primary></indexterm>
-<indexterm><primary><literal>iShiftRA&num;</literal></primary></indexterm>
-<indexterm><primary><literal>iShiftRL&num;</literal></primary></indexterm>
-<indexterm><primary><literal>addIntC&num;</literal></primary></indexterm>
-<indexterm><primary><literal>subIntC&num;</literal></primary></indexterm>
-<indexterm><primary><literal>mulIntC&num;</literal></primary></indexterm>
-<indexterm><primary>shift operations, integer</primary></indexterm>
-</para>
-
-<para>
-<emphasis>Note:</emphasis> No error/overflow checking!
-</para>
-
-</sect2>
-
-<sect2>
-<title>Primitive-<literal>Double</literal> and <literal>Float</literal> operations</title>
-
-<para>
-<indexterm><primary>floating point numbers, primitive</primary></indexterm>
-<indexterm><primary>operators, primitive floating point</primary></indexterm>
-</para>
-
-<para>
-
-<programlisting>
-{+,-,*,/}##         :: Double# -&#62; Double# -&#62; Double#
-{&#60;,&#60;=,==,/=,&#62;=,&#62;}## :: Double# -&#62; Double# -&#62; Bool
-negateDouble#       :: Double# -&#62; Double#
-double2Int#         :: Double# -&#62; Int#
-int2Double#         :: Int#    -&#62; Double#
-
-{plus,minus,times,divide}Float# :: Float# -&#62; Float# -&#62; Float#
-{gt,ge,eq,ne,lt,le}Float# :: Float# -&#62; Float# -&#62; Bool
-negateFloat#        :: Float# -&#62; Float#
-float2Int#          :: Float# -&#62; Int#
-int2Float#          :: Int#   -&#62; Float#
-</programlisting>
-
-</para>
-
-<para>
-<indexterm><primary><literal>+&num;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>-&num;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>*&num;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>/&num;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>&#60;&num;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>&#60;=&num;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>==&num;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>=/&num;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>&#62;=&num;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>&#62;&num;&num;</literal></primary></indexterm>
-<indexterm><primary><literal>negateDouble&num;</literal></primary></indexterm>
-<indexterm><primary><literal>double2Int&num;</literal></primary></indexterm>
-<indexterm><primary><literal>int2Double&num;</literal></primary></indexterm>
-</para>
-
-<para>
-<indexterm><primary><literal>plusFloat&num;</literal></primary></indexterm>
-<indexterm><primary><literal>minusFloat&num;</literal></primary></indexterm>
-<indexterm><primary><literal>timesFloat&num;</literal></primary></indexterm>
-<indexterm><primary><literal>divideFloat&num;</literal></primary></indexterm>
-<indexterm><primary><literal>gtFloat&num;</literal></primary></indexterm>
-<indexterm><primary><literal>geFloat&num;</literal></primary></indexterm>
-<indexterm><primary><literal>eqFloat&num;</literal></primary></indexterm>
-<indexterm><primary><literal>neFloat&num;</literal></primary></indexterm>
-<indexterm><primary><literal>ltFloat&num;</literal></primary></indexterm>
-<indexterm><primary><literal>leFloat&num;</literal></primary></indexterm>
-<indexterm><primary><literal>negateFloat&num;</literal></primary></indexterm>
-<indexterm><primary><literal>float2Int&num;</literal></primary></indexterm>
-<indexterm><primary><literal>int2Float&num;</literal></primary></indexterm>
-</para>
-
-<para>
-And a full complement of trigonometric functions:
-</para>
-
-<para>
-
-<programlisting>
-expDouble#      :: Double# -&#62; Double#
-logDouble#      :: Double# -&#62; Double#
-sqrtDouble#     :: Double# -&#62; Double#
-sinDouble#      :: Double# -&#62; Double#
-cosDouble#      :: Double# -&#62; Double#
-tanDouble#      :: Double# -&#62; Double#
-asinDouble#     :: Double# -&#62; Double#
-acosDouble#     :: Double# -&#62; Double#
-atanDouble#     :: Double# -&#62; Double#
-sinhDouble#     :: Double# -&#62; Double#
-coshDouble#     :: Double# -&#62; Double#
-tanhDouble#     :: Double# -&#62; Double#
-powerDouble#    :: Double# -&#62; Double# -&#62; Double#
-</programlisting>
-
-<indexterm><primary>trigonometric functions, primitive</primary></indexterm>
-</para>
-
-<para>
-similarly for <literal>Float&num;</literal>.
-</para>
-
-<para>
-There are two coercion functions for <literal>Float&num;</literal>/<literal>Double&num;</literal>:
-</para>
-
-<para>
-
-<programlisting>
-float2Double#   :: Float# -&#62; Double#
-double2Float#   :: Double# -&#62; Float#
-</programlisting>
-
-<indexterm><primary><literal>float2Double&num;</literal></primary></indexterm>
-<indexterm><primary><literal>double2Float&num;</literal></primary></indexterm>
-</para>
-
-<para>
-The primitive version of <function>decodeDouble</function>
-(<function>encodeDouble</function> is implemented as an external C
-function):
-</para>
-
-<para>
-
-<programlisting>
-decodeDouble#   :: Double# -&#62; PrelNum.ReturnIntAndGMP
-</programlisting>
-
-<indexterm><primary><literal>encodeDouble&num;</literal></primary></indexterm>
-<indexterm><primary><literal>decodeDouble&num;</literal></primary></indexterm>
-</para>
-
-<para>
-(And the same for <literal>Float&num;</literal>s.)
-</para>
-
-</sect2>
-
-<sect2 id="integer-operations">
-<title>Operations on/for <literal>Integers</literal> (interface to GMP)
-</title>
-
-<para>
-<indexterm><primary>arbitrary precision integers</primary></indexterm>
-<indexterm><primary>Integer, operations on</primary></indexterm>
-</para>
-
-<para>
-We implement <literal>Integers</literal> (arbitrary-precision
-integers) using the GNU multiple-precision (GMP) package (version
-2.0.2).
-</para>
-
-<para>
-The data type for <literal>Integer</literal> is either a small
-integer, represented by an <literal>Int</literal>, or a large integer
-represented using the pieces required by GMP's
-<literal>MP&lowbar;INT</literal> in <filename>gmp.h</filename> (see
-<filename>gmp.info</filename> in
-<filename>ghc/includes/runtime/gmp</filename>).  It comes out as:
-</para>
-
-<para>
-
-<programlisting>
-data Integer = S# Int#             -- small integers
-             | J# Int# ByteArray#  -- large integers
-</programlisting>
-
-<indexterm><primary>Integer type</primary></indexterm> The primitive
-ops to support large <literal>Integers</literal> use the
-&ldquo;pieces&rdquo; of the representation, and are as follows:
-</para>
-
-<para>
-
-<programlisting>
-negateInteger#  :: Int# -&#62; ByteArray# -&#62; Integer
-
-{plus,minus,times}Integer#, gcdInteger#, 
-  quotInteger#, remInteger#, divExactInteger#
-	:: Int# -> ByteArray#
-        -> Int# -> ByteArray#
-        -> (# Int#, ByteArray# #)
-
-cmpInteger# 
-	:: Int# -> ByteArray#
-        -> Int# -> ByteArray#
-        -> Int# -- -1 for &#60;; 0 for ==; +1 for >
-
-cmpIntegerInt# 
-	:: Int# -> ByteArray#
-        -> Int#
-        -> Int# -- -1 for &#60;; 0 for ==; +1 for >
-
-gcdIntegerInt# :: 
-	:: Int# -> ByteArray#
-        -> Int#
-        -> Int#
-
-divModInteger#, quotRemInteger#
-        :: Int# -> ByteArray#
-        -> Int# -> ByteArray#
-        -> (# Int#, ByteArray#,
-                  Int#, ByteArray# #)
-
-integer2Int# :: Int# -> ByteArray# -> Int#
-
-int2Integer#  :: Int#  -> Integer -- NB: no error-checking on these two!
-word2Integer# :: Word# -> Integer
-
-addr2Integer# :: Addr# -> Integer
-        -- the Addr# is taken to be a `char *' string
-        -- to be converted into an Integer.
-</programlisting>
-
-<indexterm><primary><literal>negateInteger&num;</literal></primary></indexterm>
-<indexterm><primary><literal>plusInteger&num;</literal></primary></indexterm>
-<indexterm><primary><literal>minusInteger&num;</literal></primary></indexterm>
-<indexterm><primary><literal>timesInteger&num;</literal></primary></indexterm>
-<indexterm><primary><literal>quotInteger&num;</literal></primary></indexterm>
-<indexterm><primary><literal>remInteger&num;</literal></primary></indexterm>
-<indexterm><primary><literal>gcdInteger&num;</literal></primary></indexterm>
-<indexterm><primary><literal>gcdIntegerInt&num;</literal></primary></indexterm>
-<indexterm><primary><literal>divExactInteger&num;</literal></primary></indexterm>
-<indexterm><primary><literal>cmpInteger&num;</literal></primary></indexterm>
-<indexterm><primary><literal>divModInteger&num;</literal></primary></indexterm>
-<indexterm><primary><literal>quotRemInteger&num;</literal></primary></indexterm>
-<indexterm><primary><literal>integer2Int&num;</literal></primary></indexterm>
-<indexterm><primary><literal>int2Integer&num;</literal></primary></indexterm>
-<indexterm><primary><literal>word2Integer&num;</literal></primary></indexterm>
-<indexterm><primary><literal>addr2Integer&num;</literal></primary></indexterm>
-</para>
-
-</sect2>
-
-<sect2>
-<title>Words and addresses</title>
-
-<para>
-<indexterm><primary>word, primitive type</primary></indexterm>
-<indexterm><primary>address, primitive type</primary></indexterm>
-<indexterm><primary>unsigned integer, primitive type</primary></indexterm>
-<indexterm><primary>pointer, primitive type</primary></indexterm>
-</para>
-
-<para>
-A <literal>Word&num;</literal> is used for bit-twiddling operations.
-It is the same size as an <literal>Int&num;</literal>, but has no sign
-nor any arithmetic operations.
-
-<programlisting>
-type Word#      -- Same size/etc as Int# but *unsigned*
-type Addr#      -- A pointer from outside the "Haskell world" (from C, probably);
-                -- described under "arrays"
-</programlisting>
-
-<indexterm><primary><literal>Word&num;</literal></primary></indexterm>
-<indexterm><primary><literal>Addr&num;</literal></primary></indexterm>
-</para>
-
-<para>
-<literal>Word&num;</literal>s and <literal>Addr&num;</literal>s have
-the usual comparison operations.  Other
-unboxed-<literal>Word</literal> ops (bit-twiddling and coercions):
-</para>
-
-<para>
-
-<programlisting>
-{gt,ge,eq,ne,lt,le}Word# :: Word# -> Word# -> Bool
-
-and#, or#, xor# :: Word# -> Word# -> Word#
-        -- standard bit ops.
-
-quotWord#, remWord# :: Word# -> Word# -> Word#
-        -- word (i.e. unsigned) versions are different from int
-        -- versions, so we have to provide these explicitly.
-
-not# :: Word# -> Word#
-
-shiftL#, shiftRL# :: Word# -> Int# -> Word#
-        -- shift left, right logical
-
-int2Word#       :: Int#  -> Word# -- just a cast, really
-word2Int#       :: Word# -> Int#
-</programlisting>
-
-<indexterm><primary>bit operations, Word and Addr</primary></indexterm>
-<indexterm><primary><literal>gtWord&num;</literal></primary></indexterm>
-<indexterm><primary><literal>geWord&num;</literal></primary></indexterm>
-<indexterm><primary><literal>eqWord&num;</literal></primary></indexterm>
-<indexterm><primary><literal>neWord&num;</literal></primary></indexterm>
-<indexterm><primary><literal>ltWord&num;</literal></primary></indexterm>
-<indexterm><primary><literal>leWord&num;</literal></primary></indexterm>
-<indexterm><primary><literal>and&num;</literal></primary></indexterm>
-<indexterm><primary><literal>or&num;</literal></primary></indexterm>
-<indexterm><primary><literal>xor&num;</literal></primary></indexterm>
-<indexterm><primary><literal>not&num;</literal></primary></indexterm>
-<indexterm><primary><literal>quotWord&num;</literal></primary></indexterm>
-<indexterm><primary><literal>remWord&num;</literal></primary></indexterm>
-<indexterm><primary><literal>shiftL&num;</literal></primary></indexterm>
-<indexterm><primary><literal>shiftRA&num;</literal></primary></indexterm>
-<indexterm><primary><literal>shiftRL&num;</literal></primary></indexterm>
-<indexterm><primary><literal>int2Word&num;</literal></primary></indexterm>
-<indexterm><primary><literal>word2Int&num;</literal></primary></indexterm>
-</para>
-
-<para>
-Unboxed-<literal>Addr</literal> ops (C casts, really):
-
-<programlisting>
-{gt,ge,eq,ne,lt,le}Addr# :: Addr# -> Addr# -> Bool
-
-int2Addr#       :: Int#  -> Addr#
-addr2Int#       :: Addr# -> Int#
-addr2Integer#   :: Addr# -> (# Int#, ByteArray# #)
-</programlisting>
-
-<indexterm><primary><literal>gtAddr&num;</literal></primary></indexterm>
-<indexterm><primary><literal>geAddr&num;</literal></primary></indexterm>
-<indexterm><primary><literal>eqAddr&num;</literal></primary></indexterm>
-<indexterm><primary><literal>neAddr&num;</literal></primary></indexterm>
-<indexterm><primary><literal>ltAddr&num;</literal></primary></indexterm>
-<indexterm><primary><literal>leAddr&num;</literal></primary></indexterm>
-<indexterm><primary><literal>int2Addr&num;</literal></primary></indexterm>
-<indexterm><primary><literal>addr2Int&num;</literal></primary></indexterm>
-<indexterm><primary><literal>addr2Integer&num;</literal></primary></indexterm>
-</para>
-
-<para>
-The casts between <literal>Int&num;</literal>,
-<literal>Word&num;</literal> and <literal>Addr&num;</literal>
-correspond to null operations at the machine level, but are required
-to keep the Haskell type checker happy.
-</para>
-
-<para>
-Operations for indexing off of C pointers
-(<literal>Addr&num;</literal>s) to snatch values are listed under
-&ldquo;arrays&rdquo;.
-</para>
-
-</sect2>
-
-<sect2>
-<title>Arrays</title>
-
-<para>
-<indexterm><primary>arrays, primitive</primary></indexterm>
-</para>
-
-<para>
-The type <literal>Array&num; elt</literal> is the type of primitive,
-unpointed arrays of values of type <literal>elt</literal>.
-</para>
-
-<para>
-
-<programlisting>
-type Array# elt
-</programlisting>
-
-<indexterm><primary><literal>Array&num;</literal></primary></indexterm>
-</para>
-
-<para>
-<literal>Array&num;</literal> is more primitive than a Haskell
-array&mdash;indeed, the Haskell <literal>Array</literal> interface is
-implemented using <literal>Array&num;</literal>&mdash;in that an
-<literal>Array&num;</literal> is indexed only by
-<literal>Int&num;</literal>s, starting at zero.  It is also more
-primitive by virtue of being unboxed.  That doesn't mean that it isn't
-a heap-allocated object&mdash;of course, it is.  Rather, being unboxed
-means that it is represented by a pointer to the array itself, and not
-to a thunk which will evaluate to the array (or to bottom).  The
-components of an <literal>Array&num;</literal> are themselves boxed.
-</para>
-
-<para>
-The type <literal>ByteArray&num;</literal> is similar to
-<literal>Array&num;</literal>, except that it contains just a string
-of (non-pointer) bytes.
-</para>
-
-<para>
-
-<programlisting>
-type ByteArray#
-</programlisting>
-
-<indexterm><primary><literal>ByteArray&num;</literal></primary></indexterm>
-</para>
-
-<para>
-Arrays of these types are useful when a Haskell program wishes to
-construct a value to pass to a C procedure. It is also possible to use
-them to build (say) arrays of unboxed characters for internal use in a
-Haskell program.  Given these uses, <literal>ByteArray&num;</literal>
-is deliberately a bit vague about the type of its components.
-Operations are provided to extract values of type
-<literal>Char&num;</literal>, <literal>Int&num;</literal>,
-<literal>Float&num;</literal>, <literal>Double&num;</literal>, and
-<literal>Addr&num;</literal> from arbitrary offsets within a
-<literal>ByteArray&num;</literal>.  (For type
-<literal>Foo&num;</literal>, the $i$th offset gets you the $i$th
-<literal>Foo&num;</literal>, not the <literal>Foo&num;</literal> at
-byte-position $i$.  Mumble.)  (If you want a
-<literal>Word&num;</literal>, grab an <literal>Int&num;</literal>,
-then coerce it.)
-</para>
-
-<para>
-Lastly, we have static byte-arrays, of type
-<literal>Addr&num;</literal> &lsqb;mentioned previously].  (Remember
-the duality between arrays and pointers in C.)  Arrays of this types
-are represented by a pointer to an array in the world outside Haskell,
-so this pointer is not followed by the garbage collector.  In other
-respects they are just like <literal>ByteArray&num;</literal>.  They
-are only needed in order to pass values from C to Haskell.
-</para>
-
-</sect2>
-
-<sect2>
-<title>Reading and writing</title>
-
-<para>
-Primitive arrays are linear, and indexed starting at zero.
-</para>
-
-<para>
-The size and indices of a <literal>ByteArray&num;</literal>, <literal>Addr&num;</literal>, and
-<literal>MutableByteArray&num;</literal> are all in bytes.  It's up to the program to
-calculate the correct byte offset from the start of the array.  This
-allows a <literal>ByteArray&num;</literal> to contain a mixture of values of different
-type, which is often needed when preparing data for and unpicking
-results from C.  (Umm&hellip;not true of indices&hellip;WDP 95/09)
-</para>
-
-<para>
-<emphasis>Should we provide some <literal>sizeOfDouble&num;</literal> constants?</emphasis>
-</para>
-
-<para>
-Out-of-range errors on indexing should be caught by the code which
-uses the primitive operation; the primitive operations themselves do
-<emphasis>not</emphasis> check for out-of-range indexes. The intention is that the
-primitive ops compile to one machine instruction or thereabouts.
-</para>
-
-<para>
-We use the terms &ldquo;reading&rdquo; and &ldquo;writing&rdquo; to refer to accessing
-<emphasis>mutable</emphasis> arrays (see <xref linkend="sect-mutable">), and
-&ldquo;indexing&rdquo; to refer to reading a value from an <emphasis>immutable</emphasis>
-array.
-</para>
-
-<para>
-Immutable byte arrays are straightforward to index (all indices are in
-units of the size of the object being read):
-
-<programlisting>
-indexCharArray#   :: ByteArray# -> Int# -> Char#
-indexIntArray#    :: ByteArray# -> Int# -> Int#
-indexAddrArray#   :: ByteArray# -> Int# -> Addr#
-indexFloatArray#  :: ByteArray# -> Int# -> Float#
-indexDoubleArray# :: ByteArray# -> Int# -> Double#
-
-indexCharOffAddr#   :: Addr# -> Int# -> Char#
-indexIntOffAddr#    :: Addr# -> Int# -> Int#
-indexFloatOffAddr#  :: Addr# -> Int# -> Float#
-indexDoubleOffAddr# :: Addr# -> Int# -> Double#
-indexAddrOffAddr#   :: Addr# -> Int# -> Addr#
- -- Get an Addr# from an Addr# offset
-</programlisting>
-
-<indexterm><primary><literal>indexCharArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>indexIntArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>indexAddrArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>indexFloatArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>indexDoubleArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>indexCharOffAddr&num;</literal></primary></indexterm>
-<indexterm><primary><literal>indexIntOffAddr&num;</literal></primary></indexterm>
-<indexterm><primary><literal>indexFloatOffAddr&num;</literal></primary></indexterm>
-<indexterm><primary><literal>indexDoubleOffAddr&num;</literal></primary></indexterm>
-<indexterm><primary><literal>indexAddrOffAddr&num;</literal></primary></indexterm>
-</para>
-
-<para>
-The last of these, <function>indexAddrOffAddr&num;</function>, extracts an <literal>Addr&num;</literal> using an offset
-from another <literal>Addr&num;</literal>, thereby providing the ability to follow a chain of
-C pointers.
-</para>
-
-<para>
-Something a bit more interesting goes on when indexing arrays of boxed
-objects, because the result is simply the boxed object. So presumably
-it should be entered&mdash;we never usually return an unevaluated
-object!  This is a pain: primitive ops aren't supposed to do
-complicated things like enter objects.  The current solution is to
-return a single element unboxed tuple (see <xref linkend="unboxed-tuples">).
-</para>
-
-<para>
-
-<programlisting>
-indexArray#       :: Array# elt -> Int# -> (# elt #)
-</programlisting>
-
-<indexterm><primary><literal>indexArray&num;</literal></primary></indexterm>
-</para>
-
-</sect2>
-
-<sect2>
-<title>The state type</title>
-
-<para>
-<indexterm><primary><literal>state, primitive type</literal></primary></indexterm>
-<indexterm><primary><literal>State&num;</literal></primary></indexterm>
-</para>
-
-<para>
-The primitive type <literal>State&num;</literal> represents the state of a state
-transformer.  It is parameterised on the desired type of state, which
-serves to keep states from distinct threads distinct from one another.
-But the <emphasis>only</emphasis> effect of this parameterisation is in the type
-system: all values of type <literal>State&num;</literal> are represented in the same way.
-Indeed, they are all represented by nothing at all!  The code
-generator &ldquo;knows&rdquo; to generate no code, and allocate no registers
-etc, for primitive states.
-</para>
-
-<para>
-
-<programlisting>
-type State# s
-</programlisting>
-
-</para>
-
-<para>
-The type <literal>GHC.RealWorld</literal> is truly opaque: there are no values defined
-of this type, and no operations over it.  It is &ldquo;primitive&rdquo; in that
-sense - but it is <emphasis>not unlifted!</emphasis> Its only role in life is to be
-the type which distinguishes the <literal>IO</literal> state transformer.
-</para>
-
-<para>
-
-<programlisting>
-data RealWorld
-</programlisting>
-
-</para>
-
-</sect2>
-
-<sect2>
-<title>State of the world</title>
-
-<para>
-A single, primitive, value of type <literal>State&num; RealWorld</literal> is provided.
-</para>
-
-<para>
-
-<programlisting>
-realWorld# :: State# RealWorld
-</programlisting>
-
-<indexterm><primary>realWorld&num; state object</primary></indexterm>
-</para>
-
-<para>
-(Note: in the compiler, not a <literal>PrimOp</literal>; just a mucho magic
-<literal>Id</literal>. Exported from <literal>GHC</literal>, though).
-</para>
-
-</sect2>
-
-<sect2 id="sect-mutable">
-<title>Mutable arrays</title>
-
-<para>
-<indexterm><primary>mutable arrays</primary></indexterm>
-<indexterm><primary>arrays, mutable</primary></indexterm>
-Corresponding to <literal>Array&num;</literal> and <literal>ByteArray&num;</literal>, we have the types of
-mutable versions of each.  In each case, the representation is a
-pointer to a suitable block of (mutable) heap-allocated storage.
-</para>
-
-<para>
-
-<programlisting>
-type MutableArray# s elt
-type MutableByteArray# s
-</programlisting>
-
-<indexterm><primary><literal>MutableArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>MutableByteArray&num;</literal></primary></indexterm>
-</para>
-
-<sect3>
-<title>Allocation</title>
-
-<para>
-<indexterm><primary>mutable arrays, allocation</primary></indexterm>
-<indexterm><primary>arrays, allocation</primary></indexterm>
-<indexterm><primary>allocation, of mutable arrays</primary></indexterm>
-</para>
-
-<para>
-Mutable arrays can be allocated. Only pointer-arrays are initialised;
-arrays of non-pointers are filled in by &ldquo;user code&rdquo; rather than by
-the array-allocation primitive.  Reason: only the pointer case has to
-worry about GC striking with a partly-initialised array.
-</para>
-
-<para>
-
-<programlisting>
-newArray#       :: Int# -> elt -> State# s -> (# State# s, MutableArray# s elt #)
-
-newCharArray#   :: Int# -> State# s -> (# State# s, MutableByteArray# s elt #)
-newIntArray#    :: Int# -> State# s -> (# State# s, MutableByteArray# s elt #)
-newAddrArray#   :: Int# -> State# s -> (# State# s, MutableByteArray# s elt #)
-newFloatArray#  :: Int# -> State# s -> (# State# s, MutableByteArray# s elt #)
-newDoubleArray# :: Int# -> State# s -> (# State# s, MutableByteArray# s elt #)
-</programlisting>
-
-<indexterm><primary><literal>newArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>newCharArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>newIntArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>newAddrArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>newFloatArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>newDoubleArray&num;</literal></primary></indexterm>
-</para>
-
-<para>
-The size of a <literal>ByteArray&num;</literal> is given in bytes.
-</para>
-
-</sect3>
-
-<sect3>
-<title>Reading and writing</title>
-
-<para>
-<indexterm><primary>arrays, reading and writing</primary></indexterm>
-</para>
-
-<para>
-
-<programlisting>
-readArray#       :: MutableArray# s elt -> Int# -> State# s -> (# State# s, elt #)
-readCharArray#   :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Char# #)
-readIntArray#    :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
-readAddrArray#   :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Addr# #)
-readFloatArray#  :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Float# #)
-readDoubleArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Double# #)
-
-writeArray#       :: MutableArray# s elt -> Int# -> elt     -> State# s -> State# s
-writeCharArray#   :: MutableByteArray# s -> Int# -> Char#   -> State# s -> State# s
-writeIntArray#    :: MutableByteArray# s -> Int# -> Int#    -> State# s -> State# s
-writeAddrArray#   :: MutableByteArray# s -> Int# -> Addr#   -> State# s -> State# s
-writeFloatArray#  :: MutableByteArray# s -> Int# -> Float#  -> State# s -> State# s
-writeDoubleArray# :: MutableByteArray# s -> Int# -> Double# -> State# s -> State# s
-</programlisting>
-
-<indexterm><primary><literal>readArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>readCharArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>readIntArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>readAddrArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>readFloatArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>readDoubleArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>writeArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>writeCharArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>writeIntArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>writeAddrArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>writeFloatArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>writeDoubleArray&num;</literal></primary></indexterm>
-</para>
-
-</sect3>
-
-<sect3>
-<title>Equality</title>
-
-<para>
-<indexterm><primary>arrays, testing for equality</primary></indexterm>
-</para>
-
-<para>
-One can take &ldquo;equality&rdquo; of mutable arrays.  What is compared is the
-<emphasis>name</emphasis> or reference to the mutable array, not its contents.
-</para>
-
-<para>
-
-<programlisting>
-sameMutableArray#     :: MutableArray# s elt -> MutableArray# s elt -> Bool
-sameMutableByteArray# :: MutableByteArray# s -> MutableByteArray# s -> Bool
-</programlisting>
-
-<indexterm><primary><literal>sameMutableArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>sameMutableByteArray&num;</literal></primary></indexterm>
-</para>
-
-</sect3>
-
-<sect3>
-<title>Freezing mutable arrays</title>
-
-<para>
-<indexterm><primary>arrays, freezing mutable</primary></indexterm>
-<indexterm><primary>freezing mutable arrays</primary></indexterm>
-<indexterm><primary>mutable arrays, freezing</primary></indexterm>
-</para>
-
-<para>
-Only unsafe-freeze has a primitive.  (Safe freeze is done directly in Haskell
-by copying the array and then using <function>unsafeFreeze</function>.)
-</para>
-
-<para>
-
-<programlisting>
-unsafeFreezeArray#     :: MutableArray# s elt -> State# s -> (# State# s, Array# s elt #)
-unsafeFreezeByteArray# :: MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
-</programlisting>
-
-<indexterm><primary><literal>unsafeFreezeArray&num;</literal></primary></indexterm>
-<indexterm><primary><literal>unsafeFreezeByteArray&num;</literal></primary></indexterm>
-</para>
-
-</sect3>
-
-</sect2>
-
-<sect2>
-<title>Synchronizing variables (M-vars)</title>
-
-<para>
-<indexterm><primary>synchronising variables (M-vars)</primary></indexterm>
-<indexterm><primary>M-Vars</primary></indexterm>
-</para>
-
-<para>
-Synchronising variables are the primitive type used to implement
-Concurrent Haskell's MVars (see the Concurrent Haskell paper for
-the operational behaviour of these operations).
-</para>
-
-<para>
-
-<programlisting>
-type MVar# s elt        -- primitive
-
-newMVar#    :: State# s -> (# State# s, MVar# s elt #)
-takeMVar#   :: SynchVar# s elt -> State# s -> (# State# s, elt #)
-putMVar#    :: SynchVar# s elt -> State# s -> State# s
-</programlisting>
-
-<indexterm><primary><literal>SynchVar&num;</literal></primary></indexterm>
-<indexterm><primary><literal>newSynchVar&num;</literal></primary></indexterm>
-<indexterm><primary><literal>takeMVar</literal></primary></indexterm>
-<indexterm><primary><literal>putMVar</literal></primary></indexterm>
-</para>
-
-</sect2>
-
-<sect2 id="glasgow-prim-arrays">
-<title>Primitive arrays, mutable and otherwise
-</title>
-
-<para>
-<indexterm><primary>primitive arrays (Glasgow extension)</primary></indexterm>
-<indexterm><primary>arrays, primitive (Glasgow extension)</primary></indexterm>
-</para>
-
-<para>
-GHC knows about quite a few flavours of Large Swathes of Bytes.
-</para>
-
-<para>
-First, GHC distinguishes between primitive arrays of (boxed) Haskell
-objects (type <literal>Array&num; obj</literal>) and primitive arrays of bytes (type
-<literal>ByteArray&num;</literal>).
-</para>
-
-<para>
-Second, it distinguishes between&hellip;
-<variablelist>
-
-<varlistentry>
-<term>Immutable:</term>
-<listitem>
-<para>
-Arrays that do not change (as with &ldquo;standard&rdquo; Haskell arrays); you
-can only read from them.  Obviously, they do not need the care and
-attention of the state-transformer monad.
-</para>
-</listitem>
-</varlistentry>
-<varlistentry>
-<term>Mutable:</term>
-<listitem>
-<para>
-Arrays that may be changed or &ldquo;mutated.&rdquo;  All the operations on them
-live within the state-transformer monad and the updates happen
-<emphasis>in-place</emphasis>.
-</para>
-</listitem>
-</varlistentry>
-<varlistentry>
-<term>&ldquo;Static&rdquo; (in C land):</term>
-<listitem>
-<para>
-A C routine may pass an <literal>Addr&num;</literal> pointer back into Haskell land.  There
-are then primitive operations with which you may merrily grab values
-over in C land, by indexing off the &ldquo;static&rdquo; pointer.
-</para>
-</listitem>
-</varlistentry>
-<varlistentry>
-<term>&ldquo;Stable&rdquo; pointers:</term>
-<listitem>
-<para>
-If, for some reason, you wish to hand a Haskell pointer (i.e.,
-<emphasis>not</emphasis> an unboxed value) to a C routine, you first make the
-pointer &ldquo;stable,&rdquo; so that the garbage collector won't forget that it
-exists.  That is, GHC provides a safe way to pass Haskell pointers to
-C.
-</para>
-
-<para>
-Please see the module <literal>Foreign.StablePtr</literal> in the
-library documentation for more details.
-</para>
-</listitem>
-</varlistentry>
-<varlistentry>
-<term>&ldquo;Foreign objects&rdquo;:</term>
-<listitem>
-<para>
-A &ldquo;foreign object&rdquo; is a safe way to pass an external object (a
-C-allocated pointer, say) to Haskell and have Haskell do the Right
-Thing when it no longer references the object.  So, for example, C
-could pass a large bitmap over to Haskell and say &ldquo;please free this
-memory when you're done with it.&rdquo;
-</para>
-
-<para>
-Please see module <literal>Foreign.ForeignPtr</literal> in the library
-documentatation for more details.
-</para>
-</listitem>
-</varlistentry>
-</variablelist>
-</para>
-
-<para>
-The libraries documentatation gives more details on all these
-&ldquo;primitive array&rdquo; types and the operations on them.
-</para>
-
-</sect2>
-
-</sect1>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter" "sect1") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/profiling.xml b/ghc/docs/users_guide/profiling.xml
deleted file mode 100644
index a88c8bbf4c..0000000000
--- a/ghc/docs/users_guide/profiling.xml
+++ /dev/null
@@ -1,1440 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<chapter id="profiling">
-  <title>Profiling</title>
-  <indexterm><primary>profiling</primary>
-  </indexterm>
-  <indexterm><primary>cost-centre profiling</primary></indexterm>
-
-  <para> Glasgow Haskell comes with a time and space profiling
-  system. Its purpose is to help you improve your understanding of
-  your program's execution behaviour, so you can improve it.</para>
-  
-  <para> Any comments, suggestions and/or improvements you have are
-  welcome.  Recommended &ldquo;profiling tricks&rdquo; would be
-  especially cool! </para>
-
-  <para>Profiling a program is a three-step process:</para>
-
-  <orderedlist>
-    <listitem>
-      <para> Re-compile your program for profiling with the
-      <literal>-prof</literal> option, and probably one of the
-      <literal>-auto</literal> or <literal>-auto-all</literal>
-      options.  These options are described in more detail in <xref
-      linkend="prof-compiler-options"/> </para>
-      <indexterm><primary><literal>-prof</literal></primary>
-      </indexterm>
-      <indexterm><primary><literal>-auto</literal></primary>
-      </indexterm>
-      <indexterm><primary><literal>-auto-all</literal></primary>
-      </indexterm>
-    </listitem>
-
-    <listitem>
-      <para> Run your program with one of the profiling options, eg.
-      <literal>+RTS -p -RTS</literal>.  This generates a file of
-      profiling information.</para>
-      <indexterm><primary><option>-p</option></primary><secondary>RTS
-      option</secondary></indexterm>
-    </listitem>
-      
-    <listitem>
-      <para> Examine the generated profiling information, using one of
-      GHC's profiling tools.  The tool to use will depend on the kind
-      of profiling information generated.</para>
-    </listitem>
-    
-  </orderedlist>
-  
-  <sect1 id="cost-centres">
-    <title>Cost centres and cost-centre stacks</title>
-    
-    <para>GHC's profiling system assigns <firstterm>costs</firstterm>
-    to <firstterm>cost centres</firstterm>.  A cost is simply the time
-    or space required to evaluate an expression.  Cost centres are
-    program annotations around expressions; all costs incurred by the
-    annotated expression are assigned to the enclosing cost centre.
-    Furthermore, GHC will remember the stack of enclosing cost centres
-    for any given expression at run-time and generate a call-graph of
-    cost attributions.</para>
-
-    <para>Let's take a look at an example:</para>
-
-    <programlisting>
-main = print (nfib 25)
-nfib n = if n &lt; 2 then 1 else nfib (n-1) + nfib (n-2)
-</programlisting>
-
-    <para>Compile and run this program as follows:</para>
-
-    <screen>
-$ ghc -prof -auto-all -o Main Main.hs
-$ ./Main +RTS -p
-121393
-$
-</screen>
-
-    <para>When a GHC-compiled program is run with the
-    <option>-p</option> RTS option, it generates a file called
-    <filename>&lt;prog&gt;.prof</filename>.  In this case, the file
-    will contain something like this:</para>
-
-<screen>
-          Fri May 12 14:06 2000 Time and Allocation Profiling Report  (Final)
-
-           Main +RTS -p -RTS
-
-        total time  =        0.14 secs   (7 ticks @ 20 ms)
-        total alloc =   8,741,204 bytes  (excludes profiling overheads)
-
-COST CENTRE          MODULE     %time %alloc
-
-nfib                 Main       100.0  100.0
-
-
-                                              individual     inherited
-COST CENTRE              MODULE      entries %time %alloc   %time %alloc
-
-MAIN                     MAIN             0    0.0   0.0    100.0 100.0
- main                    Main             0    0.0   0.0      0.0   0.0
- CAF                     PrelHandle       3    0.0   0.0      0.0   0.0
- CAF                     PrelAddr         1    0.0   0.0      0.0   0.0
- CAF                     Main             6    0.0   0.0    100.0 100.0
-  main                   Main             1    0.0   0.0    100.0 100.0
-   nfib                  Main        242785  100.0 100.0    100.0 100.0
-</screen>
-
-
-    <para>The first part of the file gives the program name and
-    options, and the total time and total memory allocation measured
-    during the run of the program (note that the total memory
-    allocation figure isn't the same as the amount of
-    <emphasis>live</emphasis> memory needed by the program at any one
-    time; the latter can be determined using heap profiling, which we
-    will describe shortly).</para>
-
-    <para>The second part of the file is a break-down by cost centre
-    of the most costly functions in the program.  In this case, there
-    was only one significant function in the program, namely
-    <function>nfib</function>, and it was responsible for 100&percnt;
-    of both the time and allocation costs of the program.</para>
-
-    <para>The third and final section of the file gives a profile
-    break-down by cost-centre stack.  This is roughly a call-graph
-    profile of the program.  In the example above, it is clear that
-    the costly call to <function>nfib</function> came from
-    <function>main</function>.</para>
-
-    <para>The time and allocation incurred by a given part of the
-    program is displayed in two ways: &ldquo;individual&rdquo;, which
-    are the costs incurred by the code covered by this cost centre
-    stack alone, and &ldquo;inherited&rdquo;, which includes the costs
-    incurred by all the children of this node.</para>
-
-    <para>The usefulness of cost-centre stacks is better demonstrated
-    by  modifying the example slightly:</para>
-
-    <programlisting>
-main = print (f 25 + g 25)
-f n  = nfib n
-g n  = nfib (n `div` 2)
-nfib n = if n &lt; 2 then 1 else nfib (n-1) + nfib (n-2)
-</programlisting>
-
-    <para>Compile and run this program as before, and take a look at
-    the new profiling results:</para>
-
-<screen>
-COST CENTRE              MODULE         scc  %time %alloc   %time %alloc
-
-MAIN                     MAIN             0    0.0   0.0    100.0 100.0
- main                    Main             0    0.0   0.0      0.0   0.0
- CAF                     PrelHandle       3    0.0   0.0      0.0   0.0
- CAF                     PrelAddr         1    0.0   0.0      0.0   0.0
- CAF                     Main             9    0.0   0.0    100.0 100.0
-  main                   Main             1    0.0   0.0    100.0 100.0
-   g                     Main             1    0.0   0.0      0.0   0.2
-    nfib                 Main           465    0.0   0.2      0.0   0.2
-   f                     Main             1    0.0   0.0    100.0  99.8
-    nfib                 Main        242785  100.0  99.8    100.0  99.8
-</screen>
-
-    <para>Now although we had two calls to <function>nfib</function>
-    in the program, it is immediately clear that it was the call from
-    <function>f</function> which took all the time.</para>
-
-    <para>The actual meaning of the various columns in the output is:</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>entries</term>
-	<listitem>
-	  <para>The number of times this particular point in the call
-	  graph was entered.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>individual &percnt;time</term>
-	<listitem>
-	  <para>The percentage of the total run time of the program
-	  spent at this point in the call graph.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>individual &percnt;alloc</term>
-	<listitem>
-	  <para>The percentage of the total memory allocations
-	  (excluding profiling overheads) of the program made by this
-	  call.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>inherited &percnt;time</term>
-	<listitem>
-	  <para>The percentage of the total run time of the program
-	  spent below this point in the call graph.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>inherited &percnt;alloc</term>
-	<listitem>
-	  <para>The percentage of the total memory allocations
-	  (excluding profiling overheads) of the program made by this
-	  call and all of its sub-calls.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-    <para>In addition you can use the <option>-P</option> RTS option
-    <indexterm><primary><option>-P</option></primary></indexterm> to
-    get the following additional information:</para>
-
-    <variablelist>
-      <varlistentry>
-	<term><literal>ticks</literal></term>
-	<listitem>
-	  <para>The raw number of time &ldquo;ticks&rdquo; which were
-          attributed to this cost-centre; from this, we get the
-          <literal>&percnt;time</literal> figure mentioned
-          above.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><literal>bytes</literal></term>
-	<listitem>
-	  <para>Number of bytes allocated in the heap while in this
-          cost-centre; again, this is the raw number from which we get
-          the <literal>&percnt;alloc</literal> figure mentioned
-          above.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-    <para>What about recursive functions, and mutually recursive
-    groups of functions?  Where are the costs attributed?  Well,
-    although GHC does keep information about which groups of functions
-    called each other recursively, this information isn't displayed in
-    the basic time and allocation profile, instead the call-graph is
-    flattened into a tree.  The XML profiling tool (described in <xref
-    linkend="prof-xml-tool"/>) will be able to display real loops in
-    the call-graph.</para>
-
-    <sect2><title>Inserting cost centres by hand</title>
-
-      <para>Cost centres are just program annotations.  When you say
-      <option>-auto-all</option> to the compiler, it automatically
-      inserts a cost centre annotation around every top-level function
-      in your program, but you are entirely free to add the cost
-      centre annotations yourself.</para>
-
-      <para>The syntax of a cost centre annotation is</para>
-
-      <programlisting>
-     {-# SCC "name" #-} &lt;expression&gt;
-</programlisting>
-
-      <para>where <literal>"name"</literal> is an arbitrary string,
-      that will become the name of your cost centre as it appears
-      in the profiling output, and
-      <literal>&lt;expression&gt;</literal> is any Haskell
-      expression.  An <literal>SCC</literal> annotation extends as
-      far to the right as possible when parsing.</para>
-
-    </sect2>
-
-    <sect2 id="prof-rules">
-      <title>Rules for attributing costs</title>
-
-      <para>The cost of evaluating any expression in your program is
-      attributed to a cost-centre stack using the following rules:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para>If the expression is part of the
-	  <firstterm>one-off</firstterm> costs of evaluating the
-	  enclosing top-level definition, then costs are attributed to
-	  the stack of lexically enclosing <literal>SCC</literal>
-	  annotations on top of the special <literal>CAF</literal>
-	  cost-centre. </para>
-	</listitem>
-
-	<listitem>
-	  <para>Otherwise, costs are attributed to the stack of
-	  lexically-enclosing <literal>SCC</literal> annotations,
-	  appended to the cost-centre stack in effect at the
-	  <firstterm>call site</firstterm> of the current top-level
-	  definition<footnote> <para>The call-site is just the place
-	  in the source code which mentions the particular function or
-	  variable.</para></footnote>.  Notice that this is a recursive
-	  definition.</para>
-	</listitem>
-
-	<listitem>
-	  <para>Time spent in foreign code (see <xref linkend="ffi"/>)
-	  is always attributed to the cost centre in force at the
-	  Haskell call-site of the foreign function.</para>
-	</listitem>
-      </itemizedlist>
-
-      <para>What do we mean by one-off costs?  Well, Haskell is a lazy
-      language, and certain expressions are only ever evaluated once.
-      For example, if we write:</para>
-
-      <programlisting>
-x = nfib 25
-</programlisting>
-
-      <para>then <varname>x</varname> will only be evaluated once (if
-      at all), and subsequent demands for <varname>x</varname> will
-      immediately get to see the cached result.  The definition
-      <varname>x</varname> is called a CAF (Constant Applicative
-      Form), because it has no arguments.</para>
-
-      <para>For the purposes of profiling, we say that the expression
-      <literal>nfib 25</literal> belongs to the one-off costs of
-      evaluating <varname>x</varname>.</para>
-
-      <para>Since one-off costs aren't strictly speaking part of the
-      call-graph of the program, they are attributed to a special
-      top-level cost centre, <literal>CAF</literal>.  There may be one
-      <literal>CAF</literal> cost centre for each module (the
-      default), or one for each top-level definition with any one-off
-      costs (this behaviour can be selected by giving GHC the
-      <option>-caf-all</option> flag).</para>
-
-      <indexterm><primary><literal>-caf-all</literal></primary>
-      </indexterm>
-
-      <para>If you think you have a weird profile, or the call-graph
-      doesn't look like you expect it to, feel free to send it (and
-      your program) to us at
-      <email>glasgow-haskell-bugs@haskell.org</email>.</para>
-    </sect2>
-  </sect1>
-
-  <sect1 id="prof-compiler-options">
-    <title>Compiler options for profiling</title>
-
-    <indexterm><primary>profiling</primary><secondary>options</secondary></indexterm>
-    <indexterm><primary>options</primary><secondary>for profiling</secondary></indexterm>
-
-    <variablelist>
-      <varlistentry>
-	<term>
-          <option>-prof</option>:
-          <indexterm><primary><option>-prof</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para> To make use of the profiling system
-          <emphasis>all</emphasis> modules must be compiled and linked
-          with the <option>-prof</option> option. Any
-          <literal>SCC</literal> annotations you've put in your source
-          will spring to life.</para>
-
-	  <para> Without a <option>-prof</option> option, your
-          <literal>SCC</literal>s are ignored; so you can compile
-          <literal>SCC</literal>-laden code without changing
-          it.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-      
-    <para>There are a few other profiling-related compilation options.
-    Use them <emphasis>in addition to</emphasis>
-    <option>-prof</option>.  These do not have to be used consistently
-    for all modules in a program.</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>
-          <option>-auto</option>:
-          <indexterm><primary><option>-auto</option></primary></indexterm>
-          <indexterm><primary>cost centres</primary><secondary>automatically inserting</secondary></indexterm>
-        </term>
-	<listitem>
-	  <para> GHC will automatically add
-          <function>&lowbar;scc&lowbar;</function> constructs for all
-          top-level, exported functions.</para>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term>
-          <option>-auto-all</option>:
-          <indexterm><primary><option>-auto-all</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para> <emphasis>All</emphasis> top-level functions,
-	  exported or not, will be automatically
-	  <function>&lowbar;scc&lowbar;</function>'d.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-caf-all</option>:
-          <indexterm><primary><option>-caf-all</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para> The costs of all CAFs in a module are usually
-	  attributed to one &ldquo;big&rdquo; CAF cost-centre. With
-	  this option, all CAFs get their own cost-centre.  An
-	  &ldquo;if all else fails&rdquo; option&hellip;</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-ignore-scc</option>:
-          <indexterm><primary><option>-ignore-scc</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Ignore any <function>&lowbar;scc&lowbar;</function>
-          constructs, so a module which already has
-          <function>&lowbar;scc&lowbar;</function>s can be compiled
-          for profiling with the annotations ignored.</para>
-	</listitem>
-      </varlistentry>
-
-    </variablelist>
-
-  </sect1>
-
-  <sect1 id="prof-time-options">
-    <title>Time and allocation profiling</title>
-
-    <para>To generate a time and allocation profile, give one of the
-    following RTS options to the compiled program when you run it (RTS
-    options should be enclosed between <literal>+RTS...-RTS</literal>
-    as usual):</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>
-          <option>-p</option> or <option>-P</option>:
-          <indexterm><primary><option>-p</option></primary></indexterm>
-          <indexterm><primary><option>-P</option></primary></indexterm>
-          <indexterm><primary>time profile</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>The <option>-p</option> option produces a standard
-          <emphasis>time profile</emphasis> report.  It is written
-          into the file
-          <filename><replaceable>program</replaceable>.prof</filename>.</para>
-
-	  <para>The <option>-P</option> option produces a more
-          detailed report containing the actual time and allocation
-          data as well.  (Not used much.)</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-px</option>:
-          <indexterm><primary><option>-px</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>The <option>-px</option> option generates profiling
-	  information in the XML format understood by our new
-	  profiling tool, see <xref linkend="prof-xml-tool"/>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-xc</option>
-          <indexterm><primary><option>-xc</option></primary><secondary>RTS option</secondary></indexterm>
-        </term>
-	<listitem>
-	  <para>This option makes use of the extra information
-	  maintained by the cost-centre-stack profiler to provide
-	  useful information about the location of runtime errors.
-	  See <xref linkend="rts-options-debugging"/>.</para>
-	</listitem>
-      </varlistentry>
-
-    </variablelist>
-    
-  </sect1>
-
-  <sect1 id="prof-heap">
-    <title>Profiling memory usage</title>
-
-    <para>In addition to profiling the time and allocation behaviour
-    of your program, you can also generate a graph of its memory usage
-    over time.  This is useful for detecting the causes of
-    <firstterm>space leaks</firstterm>, when your program holds on to
-    more memory at run-time that it needs to.  Space leaks lead to
-    longer run-times due to heavy garbage collector activity, and may
-    even cause the program to run out of memory altogether.</para>
-
-    <para>To generate a heap profile from your program:</para>
-
-    <orderedlist>
-      <listitem>
-	<para>Compile the program for profiling (<xref
-	linkend="prof-compiler-options"/>).</para>
-      </listitem>
-      <listitem>
-	<para>Run it with one of the heap profiling options described
-	below (eg. <option>-hc</option> for a basic producer profile).
-	This generates the file
-	<filename><replaceable>prog</replaceable>.hp</filename>.</para>
-      </listitem>
-      <listitem>
-	<para>Run <command>hp2ps</command> to produce a Postscript
-	file,
-	<filename><replaceable>prog</replaceable>.ps</filename>.  The
-	<command>hp2ps</command> utility is described in detail in
-	<xref linkend="hp2ps"/>.</para> 
-      </listitem>
-      <listitem>
-	<para>Display the heap profile using a postscript viewer such
-	as <application>Ghostview</application>, or print it out on a
-	Postscript-capable printer.</para>
-      </listitem>
-    </orderedlist>
-
-    <sect2 id="rts-options-heap-prof">
-      <title>RTS options for heap profiling</title>
-
-      <para>There are several different kinds of heap profile that can
-      be generated.  All the different profile types yield a graph of
-      live heap against time, but they differ in how the live heap is
-      broken down into bands.  The following RTS options select which
-      break-down to use:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term>
-            <option>-hc</option>
-            <indexterm><primary><option>-hc</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Breaks down the graph by the cost-centre stack which
-	    produced the data.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-hm</option>
-            <indexterm><primary><option>-hm</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Break down the live heap by the module containing
-	    the code which produced the data.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-hd</option>
-            <indexterm><primary><option>-hd</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Breaks down the graph by <firstterm>closure
-	    description</firstterm>.  For actual data, the description
-	    is just the constructor name, for other closures it is a
-	    compiler-generated string identifying the closure.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-hy</option>
-            <indexterm><primary><option>-hy</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Breaks down the graph by
-	    <firstterm>type</firstterm>.  For closures which have
-	    function type or unknown/polymorphic type, the string will
-	    represent an approximation to the actual type.</para>
-	  </listitem>
-	</varlistentry>
-	
-	<varlistentry>
-	  <term>
-            <option>-hr</option>
-            <indexterm><primary><option>-hr</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Break down the graph by <firstterm>retainer
-	    set</firstterm>.  Retainer profiling is described in more
-	    detail below (<xref linkend="retainer-prof"/>).</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-hb</option>
-            <indexterm><primary><option>-hb</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Break down the graph by
-	    <firstterm>biography</firstterm>.  Biographical profiling
-	    is described in more detail below (<xref
-	    linkend="biography-prof"/>).</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>In addition, the profile can be restricted to heap data
-      which satisfies certain criteria - for example, you might want
-      to display a profile by type but only for data produced by a
-      certain module, or a profile by retainer for a certain type of
-      data.  Restrictions are specified as follows:</para>
-      
-      <variablelist>
-	<varlistentry>
-	  <term>
-            <option>-hc</option><replaceable>name</replaceable>,...
-            <indexterm><primary><option>-hc</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Restrict the profile to closures produced by
-	    cost-centre stacks with one of the specified cost centres
-	    at the top.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-hC</option><replaceable>name</replaceable>,...
-            <indexterm><primary><option>-hC</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Restrict the profile to closures produced by
-	    cost-centre stacks with one of the specified cost centres
-	    anywhere in the stack.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-hm</option><replaceable>module</replaceable>,...
-            <indexterm><primary><option>-hm</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Restrict the profile to closures produced by the
-	    specified modules.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-hd</option><replaceable>desc</replaceable>,...
-            <indexterm><primary><option>-hd</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Restrict the profile to closures with the specified
-	    description strings.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-hy</option><replaceable>type</replaceable>,...
-            <indexterm><primary><option>-hy</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Restrict the profile to closures with the specified
-	    types.</para>
-	  </listitem>
-	</varlistentry>
-	
-	<varlistentry>
-	  <term>
-            <option>-hr</option><replaceable>cc</replaceable>,...
-            <indexterm><primary><option>-hr</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Restrict the profile to closures with retainer sets
-	    containing cost-centre stacks with one of the specified
-	    cost centres at the top.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-hb</option><replaceable>bio</replaceable>,...
-            <indexterm><primary><option>-hb</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Restrict the profile to closures with one of the
-	    specified biographies, where
-	    <replaceable>bio</replaceable> is one of
-	    <literal>lag</literal>, <literal>drag</literal>,
-	    <literal>void</literal>, or <literal>use</literal>.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>For example, the following options will generate a
-      retainer profile restricted to <literal>Branch</literal> and
-      <literal>Leaf</literal> constructors:</para>
-
-<screen>
-<replaceable>prog</replaceable> +RTS -hr -hdBranch,Leaf
-</screen>
-
-      <para>There can only be one "break-down" option
-      (eg. <option>-hr</option> in the example above), but there is no
-      limit on the number of further restrictions that may be applied.
-      All the options may be combined, with one exception: GHC doesn't
-      currently support mixing the <option>-hr</option> and
-      <option>-hb</option> options.</para>
-
-      <para>There are two more options which relate to heap
-      profiling:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term>
-            <option>-i<replaceable>secs</replaceable></option>:
-            <indexterm><primary><option>-i</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Set the profiling (sampling) interval to
-            <replaceable>secs</replaceable> seconds (the default is
-            0.1&nbsp;second).  Fractions are allowed: for example
-            <option>-i0.2</option> will get 5 samples per second.
-            This only affects heap profiling; time profiles are always
-            sampled on a 1/50 second frequency.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-xt</option>
-            <indexterm><primary><option>-xt</option></primary><secondary>RTS option</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Include the memory occupied by threads in a heap
-	    profile.  Each thread takes up a small area for its thread
-	    state in addition to the space allocated for its stack
-	    (stacks normally start small and then grow as
-	    necessary).</para>
-	    
-	    <para>This includes the main thread, so using
-	    <option>-xt</option> is a good way to see how much stack
-	    space the program is using.</para>
-
-	    <para>Memory occupied by threads and their stacks is
-	    labelled as &ldquo;TSO&rdquo; when displaying the profile
-	    by closure description or type description.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-    </sect2>
-    
-    <sect2 id="retainer-prof">
-      <title>Retainer Profiling</title>
-
-      <para>Retainer profiling is designed to help answer questions
-      like <quote>why is this data being retained?</quote>.  We start
-      by defining what we mean by a retainer:</para>
-
-      <blockquote>
-	<para>A retainer is either the system stack, or an unevaluated
-	closure (thunk).</para>
-      </blockquote>
-
-      <para>In particular, constructors are <emphasis>not</emphasis>
-      retainers.</para>
-
-      <para>An object B retains object A if (i) B is a retainer object and
-     (ii) object A can be reached by recursively following pointers
-     starting from object B, but not meeting any other retainer
-     objects on the way. Each live object is retained by one or more
-     retainer objects, collectively called its retainer set, or its
-      <firstterm>retainer set</firstterm>, or its
-      <firstterm>retainers</firstterm>.</para>
-
-      <para>When retainer profiling is requested by giving the program
-      the <option>-hr</option> option, a graph is generated which is
-      broken down by retainer set.  A retainer set is displayed as a
-      set of cost-centre stacks; because this is usually too large to
-      fit on the profile graph, each retainer set is numbered and
-      shown abbreviated on the graph along with its number, and the
-      full list of retainer sets is dumped into the file
-      <filename><replaceable>prog</replaceable>.prof</filename>.</para>
-
-      <para>Retainer profiling requires multiple passes over the live
-      heap in order to discover the full retainer set for each
-      object, which can be quite slow.  So we set a limit on the
-      maximum size of a retainer set, where all retainer sets larger
-      than the maximum retainer set size are replaced by the special
-      set <literal>MANY</literal>.  The maximum set size defaults to 8
-      and can be altered with the <option>-R</option> RTS
-      option:</para>
-      
-      <variablelist>
-	<varlistentry>
-	  <term><option>-R</option><replaceable>size</replaceable></term>
-	  <listitem>
-	    <para>Restrict the number of elements in a retainer set to
-	    <replaceable>size</replaceable> (default 8).</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <sect3>
-	<title>Hints for using retainer profiling</title>
-
-	<para>The definition of retainers is designed to reflect a
-        common cause of space leaks: a large structure is retained by
-        an unevaluated computation, and will be released once the
-        computation is forced.  A good example is looking up a value in
-        a finite map, where unless the lookup is forced in a timely
-        manner the unevaluated lookup will cause the whole mapping to
-        be retained.  These kind of space leaks can often be
-        eliminated by forcing the relevant computations to be
-        performed eagerly, using <literal>seq</literal> or strictness
-        annotations on data constructor fields.</para>
-
-	<para>Often a particular data structure is being retained by a
-        chain of unevaluated closures, only the nearest of which will
-        be reported by retainer profiling - for example A retains B, B
-        retains C, and C retains a large structure.  There might be a
-        large number of Bs but only a single A, so A is really the one
-        we're interested in eliminating.  However, retainer profiling
-        will in this case report B as the retainer of the large
-        structure.  To move further up the chain of retainers, we can
-        ask for another retainer profile but this time restrict the
-        profile to B objects, so we get a profile of the retainers of
-        B:</para>
-
-<screen>
-<replaceable>prog</replaceable> +RTS -hr -hcB
-</screen>
-	
-	<para>This trick isn't foolproof, because there might be other
-        B closures in the heap which aren't the retainers we are
-        interested in, but we've found this to be a useful technique
-        in most cases.</para>
-      </sect3>
-    </sect2>
-
-    <sect2 id="biography-prof">
-      <title>Biographical Profiling</title>
-
-      <para>A typical heap object may be in one of the following four
-      states at each point in its lifetime:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para>The <firstterm>lag</firstterm> stage, which is the
-	  time between creation and the first use of the
-	  object,</para>
-	</listitem>
-	<listitem>
-	  <para>the <firstterm>use</firstterm> stage, which lasts from
-	  the first use until the last use of the object, and</para>
-	</listitem>
-	<listitem>
-	  <para>The <firstterm>drag</firstterm> stage, which lasts
-	  from the final use until the last reference to the object
-	  is dropped.</para>
-	</listitem>
-	<listitem>
-	  <para>An object which is never used is said to be in the
-	  <firstterm>void</firstterm> state for its whole
-	  lifetime.</para>
-	</listitem>
-      </itemizedlist>
-
-      <para>A biographical heap profile displays the portion of the
-      live heap in each of the four states listed above.  Usually the
-      most interesting states are the void and drag states: live heap
-      in these states is more likely to be wasted space than heap in
-      the lag or use states.</para>
-
-      <para>It is also possible to break down the heap in one or more
-      of these states by a different criteria, by restricting a
-      profile by biography.  For example, to show the portion of the
-      heap in the drag or void state by producer: </para>
-
-<screen>
-<replaceable>prog</replaceable> +RTS -hc -hbdrag,void
-</screen>
-
-      <para>Once you know the producer or the type of the heap in the
-      drag or void states, the next step is usually to find the
-      retainer(s):</para>
-
-<screen>
-<replaceable>prog</replaceable> +RTS -hr -hc<replaceable>cc</replaceable>...
-</screen>
-
-      <para>NOTE: this two stage process is required because GHC
-      cannot currently profile using both biographical and retainer
-      information simultaneously.</para>
-    </sect2>
-
-    <sect2 id="mem-residency">
-      <title>Actual memory residency</title>
-
-      <para>How does the heap residency reported by the heap profiler relate to
-	the actual memory residency of your program when you run it?  You might
-	see a large discrepancy between the residency reported by the heap
-	profiler, and the residency reported by tools on your system
-	(eg. <literal>ps</literal> or <literal>top</literal> on Unix, or the
-	Task Manager on Windows).  There are several reasons for this:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para>There is an overhead of profiling itself, which is subtracted
-	    from the residency figures by the profiler.  This overhead goes
-	    away when compiling without profiling support, of course.  The
-	    space overhead is currently 2 extra
-	    words per heap object, which probably results in
-	    about a 30% overhead.</para>
-	</listitem>
-
-	<listitem>
-	  <para>Garbage collection requires more memory than the actual
-	    residency.  The factor depends on the kind of garbage collection
-	    algorithm in use:  a major GC in the standard
-	    generation copying collector will usually require 3L bytes of
-	    memory, where L is the amount of live data.  This is because by
-	    default (see the <option>+RTS -F</option> option) we allow the old
-	    generation to grow to twice its size (2L) before collecting it, and
-	    we require additionally L bytes to copy the live data into.  When
-	    using compacting collection (see the <option>+RTS -c</option>
-	    option), this is reduced to 2L, and can further be reduced by
-	    tweaking the <option>-F</option> option.  Also add the size of the
-	    allocation area (currently a fixed 512Kb).</para>
-	</listitem>
-
-	<listitem>
-	  <para>The stack isn't counted in the heap profile by default.  See the
-    <option>+RTS -xt</option> option.</para>
-	</listitem>
-
-	<listitem>
-	  <para>The program text itself, the C stack, any non-heap data (eg. data
-	    allocated by foreign libraries, and data allocated by the RTS), and
-	    <literal>mmap()</literal>'d memory are not counted in the heap profile.</para>
-	</listitem>
-      </itemizedlist>
-    </sect2>
-
-  </sect1>
-
-  <sect1 id="prof-xml-tool">
-    <title>Graphical time/allocation profile</title>
-
-    <para>You can view the time and allocation profiling graph of your
-    program graphically, using <command>ghcprof</command>.  This is a
-    new tool with GHC 4.08, and will eventually be the de-facto
-    standard way of viewing GHC profiles<footnote><para>Actually this
-    isn't true any more, we are working on a new tool for
-    displaying heap profiles using Gtk+HS, so
-    <command>ghcprof</command> may go away at some point in the future.</para>
-      </footnote></para>
-
-    <para>To run <command>ghcprof</command>, you need
-    <productname>uDraw(Graph)</productname> installed, which can be
-    obtained from <ulink
-    url="http://www.informatik.uni-bremen.de/uDrawGraph/en/uDrawGraph/uDrawGraph.html"><citetitle>uDraw(Graph)</citetitle></ulink>.  Install one of
-    the binary
-    distributions, and set your
-    <envar>UDG_HOME</envar> environment variable to point to the
-    installation directory.</para>
-
-    <para><command>ghcprof</command> uses an XML-based profiling log
-    format, and you therefore need to run your program with a
-    different option: <option>-px</option>.  The file generated is
-    still called <filename>&lt;prog&gt;.prof</filename>.  To see the
-    profile, run <command>ghcprof</command> like this:</para>
-
-    <indexterm><primary><option>-px</option></primary></indexterm>
-
-<screen>
-$ ghcprof &lt;prog&gt;.prof
-</screen>
-
-    <para>which should pop up a window showing the call-graph of your
-    program in glorious detail.  More information on using
-    <command>ghcprof</command> can be found at <ulink
-    url="http://www.dcs.warwick.ac.uk/people/academic/Stephen.Jarvis/profiler/index.html"><citetitle>The
-    Cost-Centre Stack Profiling Tool for
-    GHC</citetitle></ulink>.</para>
-
-  </sect1>
-
-  <sect1 id="hp2ps">
-    <title><command>hp2ps</command>&ndash;&ndash;heap profile to PostScript</title>
-
-    <indexterm><primary><command>hp2ps</command></primary></indexterm>
-    <indexterm><primary>heap profiles</primary></indexterm>
-    <indexterm><primary>postscript, from heap profiles</primary></indexterm>
-    <indexterm><primary><option>-h&lt;break-down&gt;</option></primary></indexterm>
-    
-    <para>Usage:</para>
-    
-<screen>
-hp2ps [flags] [&lt;file&gt;[.hp]]
-</screen>
-
-    <para>The program
-    <command>hp2ps</command><indexterm><primary>hp2ps
-    program</primary></indexterm> converts a heap profile as produced
-    by the <option>-h&lt;break-down&gt;</option> runtime option into a
-    PostScript graph of the heap profile. By convention, the file to
-    be processed by <command>hp2ps</command> has a
-    <filename>.hp</filename> extension. The PostScript output is
-    written to <filename>&lt;file&gt;@.ps</filename>. If
-    <filename>&lt;file&gt;</filename> is omitted entirely, then the
-    program behaves as a filter.</para>
-
-    <para><command>hp2ps</command> is distributed in
-    <filename>ghc/utils/hp2ps</filename> in a GHC source
-    distribution. It was originally developed by Dave Wakeling as part
-    of the HBC/LML heap profiler.</para>
-
-    <para>The flags are:</para>
-
-    <variablelist>
-      
-      <varlistentry>
-	<term><option>-d</option></term>
-	<listitem>
-	  <para>In order to make graphs more readable,
-          <command>hp2ps</command> sorts the shaded bands for each
-          identifier. The default sort ordering is for the bands with
-          the largest area to be stacked on top of the smaller ones.
-          The <option>-d</option> option causes rougher bands (those
-          representing series of values with the largest standard
-          deviations) to be stacked on top of smoother ones.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-b</option></term>
-	<listitem>
-	  <para>Normally, <command>hp2ps</command> puts the title of
-          the graph in a small box at the top of the page. However, if
-          the JOB string is too long to fit in a small box (more than
-          35 characters), then <command>hp2ps</command> will choose to
-          use a big box instead.  The <option>-b</option> option
-          forces <command>hp2ps</command> to use a big box.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-e&lt;float&gt;[in&verbar;mm&verbar;pt]</option></term>
-	<listitem>
-	  <para>Generate encapsulated PostScript suitable for
-          inclusion in LaTeX documents.  Usually, the PostScript graph
-          is drawn in landscape mode in an area 9 inches wide by 6
-          inches high, and <command>hp2ps</command> arranges for this
-          area to be approximately centred on a sheet of a4 paper.
-          This format is convenient of studying the graph in detail,
-          but it is unsuitable for inclusion in LaTeX documents.  The
-          <option>-e</option> option causes the graph to be drawn in
-          portrait mode, with float specifying the width in inches,
-          millimetres or points (the default).  The resulting
-          PostScript file conforms to the Encapsulated PostScript
-          (EPS) convention, and it can be included in a LaTeX document
-          using Rokicki's dvi-to-PostScript converter
-          <command>dvips</command>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-g</option></term>
-	<listitem>
-	  <para>Create output suitable for the <command>gs</command>
-          PostScript previewer (or similar). In this case the graph is
-          printed in portrait mode without scaling. The output is
-          unsuitable for a laser printer.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-l</option></term>
-	<listitem>
-	  <para>Normally a profile is limited to 20 bands with
-          additional identifiers being grouped into an
-          <literal>OTHER</literal> band. The <option>-l</option> flag
-          removes this 20 band and limit, producing as many bands as
-          necessary. No key is produced as it won't fit!. It is useful
-          for creation time profiles with many bands.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-m&lt;int&gt;</option></term>
-	<listitem>
-	  <para>Normally a profile is limited to 20 bands with
-          additional identifiers being grouped into an
-          <literal>OTHER</literal> band. The <option>-m</option> flag
-          specifies an alternative band limit (the maximum is
-          20).</para>
-
-	  <para><option>-m0</option> requests the band limit to be
-          removed. As many bands as necessary are produced. However no
-          key is produced as it won't fit! It is useful for displaying
-          creation time profiles with many bands.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-p</option></term>
-	<listitem>
-	  <para>Use previous parameters. By default, the PostScript
-          graph is automatically scaled both horizontally and
-          vertically so that it fills the page.  However, when
-          preparing a series of graphs for use in a presentation, it
-          is often useful to draw a new graph using the same scale,
-          shading and ordering as a previous one. The
-          <option>-p</option> flag causes the graph to be drawn using
-          the parameters determined by a previous run of
-          <command>hp2ps</command> on <filename>file</filename>. These
-          are extracted from <filename>file@.aux</filename>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-s</option></term>
-	<listitem>
-	  <para>Use a small box for the title.</para>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term><option>-t&lt;float&gt;</option></term>
-	<listitem>
-	  <para>Normally trace elements which sum to a total of less
-          than 1&percnt; of the profile are removed from the
-          profile. The <option>-t</option> option allows this
-          percentage to be modified (maximum 5&percnt;).</para>
-
-	  <para><option>-t0</option> requests no trace elements to be
-          removed from the profile, ensuring that all the data will be
-          displayed.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-c</option></term>
-	<listitem>
-	  <para>Generate colour output.</para>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term><option>-y</option></term>
-	<listitem>
-	  <para>Ignore marks.</para>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term><option>-?</option></term>
-	<listitem>
-	  <para>Print out usage information.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-
-    <sect2 id="manipulating-hp">
-      <title>Manipulating the hp file</title>
-
-<para>(Notes kindly offered by Jan-Willhem Maessen.)</para>
-
-<para>
-The <filename>FOO.hp</filename> file produced when you ask for the
-heap profile of a program <filename>FOO</filename> is a text file with a particularly
-simple structure. Here's a representative example, with much of the
-actual data omitted:
-<screen>
-JOB "FOO -hC"
-DATE "Thu Dec 26 18:17 2002"
-SAMPLE_UNIT "seconds"
-VALUE_UNIT "bytes"
-BEGIN_SAMPLE 0.00
-END_SAMPLE 0.00
-BEGIN_SAMPLE 15.07
-  ... sample data ...
-END_SAMPLE 15.07
-BEGIN_SAMPLE 30.23
-  ... sample data ...
-END_SAMPLE 30.23
-... etc.
-BEGIN_SAMPLE 11695.47
-END_SAMPLE 11695.47
-</screen>
-The first four lines (<literal>JOB</literal>, <literal>DATE</literal>, <literal>SAMPLE_UNIT</literal>, <literal>VALUE_UNIT</literal>) form a
-header.  Each block of lines starting with <literal>BEGIN_SAMPLE</literal> and ending
-with <literal>END_SAMPLE</literal> forms a single sample (you can think of this as a
-vertical slice of your heap profile).  The hp2ps utility should accept
-any input with a properly-formatted header followed by a series of
-*complete* samples.
-</para>
-</sect2>
-
-    <sect2>
-      <title>Zooming in on regions of your profile</title>
-
-<para>
-You can look at particular regions of your profile simply by loading a
-copy of the <filename>.hp</filename> file into a text editor and deleting the unwanted
-samples.  The resulting <filename>.hp</filename> file can be run through <command>hp2ps</command> and viewed
-or printed.
-</para>
-</sect2>
-
-    <sect2>
-      <title>Viewing the heap profile of a running program</title>
-
-<para>
-The <filename>.hp</filename> file is generated incrementally as your
-program runs.  In principle, running <command>hp2ps</command> on the incomplete file
-should produce a snapshot of your program's heap usage.  However, the
-last sample in the file may be incomplete, causing <command>hp2ps</command> to fail.  If
-you are using a machine with UNIX utilities installed, it's not too
-hard to work around this problem (though the resulting command line
-looks rather Byzantine):
-<screen>
-  head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \
-    | hp2ps > FOO.ps
-</screen>
-
-The command <command>fgrep -n END_SAMPLE FOO.hp</command> finds the
-end of every complete sample in <filename>FOO.hp</filename>, and labels each sample with
-its ending line number.  We then select the line number of the last
-complete sample using <command>tail</command> and <command>cut</command>.  This is used as a
-parameter to <command>head</command>; the result is as if we deleted the final
-incomplete sample from <filename>FOO.hp</filename>.  This results in a properly-formatted
-.hp file which we feed directly to <command>hp2ps</command>.
-</para>
-</sect2>
-    <sect2>
-      <title>Viewing a heap profile in real time</title>
-
-<para>
-The <command>gv</command> and <command>ghostview</command> programs
-have a "watch file" option can be used to view an up-to-date heap
-profile of your program as it runs.  Simply generate an incremental
-heap profile as described in the previous section.  Run <command>gv</command> on your
-profile:
-<screen>
-  gv -watch -seascape FOO.ps 
-</screen>
-If you forget the <literal>-watch</literal> flag you can still select
-"Watch file" from the "State" menu.  Now each time you generate a new
-profile <filename>FOO.ps</filename> the view will update automatically.
-</para>
-
-<para>
-This can all be encapsulated in a little script:
-<screen>
-  #!/bin/sh
-  head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \
-    | hp2ps > FOO.ps
-  gv -watch -seascape FOO.ps &amp;
-  while [ 1 ] ; do
-    sleep 10 # We generate a new profile every 10 seconds.
-    head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \
-      | hp2ps > FOO.ps
-  done
-</screen>
-Occasionally <command>gv</command> will choke as it tries to read an incomplete copy of
-<filename>FOO.ps</filename> (because <command>hp2ps</command> is still running as an update
-occurs).  A slightly more complicated script works around this
-problem, by using the fact that sending a SIGHUP to gv will cause it
-to re-read its input file:
-<screen>
-  #!/bin/sh
-  head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \
-    | hp2ps > FOO.ps
-  gv FOO.ps &amp;
-  gvpsnum=$!
-  while [ 1 ] ; do
-    sleep 10
-    head -`fgrep -n END_SAMPLE FOO.hp | tail -1 | cut -d : -f 1` FOO.hp \
-      | hp2ps > FOO.ps
-    kill -HUP $gvpsnum
-  done    
-</screen>
-</para>
-</sect2>
-
-
-  </sect1>
-
-  <sect1 id="ticky-ticky">
-    <title>Using &ldquo;ticky-ticky&rdquo; profiling (for implementors)</title>
-    <indexterm><primary>ticky-ticky profiling</primary></indexterm>
-
-    <para>(ToDo: document properly.)</para>
-
-    <para>It is possible to compile Glasgow Haskell programs so that
-    they will count lots and lots of interesting things, e.g., number
-    of updates, number of data constructors entered, etc., etc.  We
-    call this &ldquo;ticky-ticky&rdquo;
-    profiling,<indexterm><primary>ticky-ticky
-    profiling</primary></indexterm> <indexterm><primary>profiling,
-    ticky-ticky</primary></indexterm> because that's the sound a Sun4
-    makes when it is running up all those counters
-    (<emphasis>slowly</emphasis>).</para>
-
-    <para>Ticky-ticky profiling is mainly intended for implementors;
-    it is quite separate from the main &ldquo;cost-centre&rdquo;
-    profiling system, intended for all users everywhere.</para>
-
-    <para>To be able to use ticky-ticky profiling, you will need to
-    have built appropriate libraries and things when you made the
-    system.  See &ldquo;Customising what libraries to build,&rdquo; in
-    the installation guide.</para>
-
-    <para>To get your compiled program to spit out the ticky-ticky
-    numbers, use a <option>-r</option> RTS
-    option<indexterm><primary>-r RTS option</primary></indexterm>.
-    See <xref linkend="runtime-control"/>.</para>
-
-    <para>Compiling your program with the <option>-ticky</option>
-    switch yields an executable that performs these counts.  Here is a
-    sample ticky-ticky statistics file, generated by the invocation
-    <command>foo +RTS -rfoo.ticky</command>.</para>
-
-<screen>
- foo +RTS -rfoo.ticky
-
-
-ALLOCATIONS: 3964631 (11330900 words total: 3999476 admin, 6098829 goods, 1232595 slop)
-                                total words:        2     3     4     5    6+
-  69647 (  1.8%) function values                 50.0  50.0   0.0   0.0   0.0
-2382937 ( 60.1%) thunks                           0.0  83.9  16.1   0.0   0.0
-1477218 ( 37.3%) data values                     66.8  33.2   0.0   0.0   0.0
-      0 (  0.0%) big tuples
-      2 (  0.0%) black holes                      0.0 100.0   0.0   0.0   0.0
-      0 (  0.0%) prim things
-  34825 (  0.9%) partial applications             0.0   0.0   0.0 100.0   0.0
-      2 (  0.0%) thread state objects             0.0   0.0   0.0   0.0 100.0
-
-Total storage-manager allocations: 3647137 (11882004 words)
-        [551104 words lost to speculative heap-checks]
-
-STACK USAGE:
-
-ENTERS: 9400092  of which 2005772 (21.3%) direct to the entry code
-                  [the rest indirected via Node's info ptr]
-1860318 ( 19.8%) thunks
-3733184 ( 39.7%) data values
-3149544 ( 33.5%) function values
-                  [of which 1999880 (63.5%) bypassed arg-satisfaction chk]
- 348140 (  3.7%) partial applications
- 308906 (  3.3%) normal indirections
-      0 (  0.0%) permanent indirections
-
-RETURNS: 5870443
-2137257 ( 36.4%) from entering a new constructor
-                  [the rest from entering an existing constructor]
-2349219 ( 40.0%) vectored [the rest unvectored]
-
-RET_NEW:         2137257:  32.5% 46.2% 21.3%  0.0%  0.0%  0.0%  0.0%  0.0%  0.0%
-RET_OLD:         3733184:   2.8% 67.9% 29.3%  0.0%  0.0%  0.0%  0.0%  0.0%  0.0%
-RET_UNBOXED_TUP:       2:   0.0%  0.0%100.0%  0.0%  0.0%  0.0%  0.0%  0.0%  0.0%
-
-RET_VEC_RETURN : 2349219:   0.0%  0.0%100.0%  0.0%  0.0%  0.0%  0.0%  0.0%  0.0%
-
-UPDATE FRAMES: 2241725 (0 omitted from thunks)
-SEQ FRAMES:    1
-CATCH FRAMES:  1
-UPDATES: 2241725
-      0 (  0.0%) data values
-  34827 (  1.6%) partial applications
-                  [2 in place, 34825 allocated new space]
-2206898 ( 98.4%) updates to existing heap objects (46 by squeezing)
-UPD_CON_IN_NEW:         0:       0      0      0      0      0      0      0      0      0
-UPD_PAP_IN_NEW:     34825:       0      0      0  34825      0      0      0      0      0
-
-NEW GEN UPDATES: 2274700 ( 99.9%)
-
-OLD GEN UPDATES: 1852 (  0.1%)
-
-Total bytes copied during GC: 190096
-
-**************************************************
-3647137 ALLOC_HEAP_ctr
-11882004 ALLOC_HEAP_tot
-  69647 ALLOC_FUN_ctr
-  69647 ALLOC_FUN_adm
-  69644 ALLOC_FUN_gds
-  34819 ALLOC_FUN_slp
-  34831 ALLOC_FUN_hst_0
-  34816 ALLOC_FUN_hst_1
-      0 ALLOC_FUN_hst_2
-      0 ALLOC_FUN_hst_3
-      0 ALLOC_FUN_hst_4
-2382937 ALLOC_UP_THK_ctr
-      0 ALLOC_SE_THK_ctr
- 308906 ENT_IND_ctr
-      0 E!NT_PERM_IND_ctr requires +RTS -Z
-[... lots more info omitted ...]
-      0 GC_SEL_ABANDONED_ctr
-      0 GC_SEL_MINOR_ctr
-      0 GC_SEL_MAJOR_ctr
-      0 GC_FAILED_PROMOTION_ctr
-  47524 GC_WORDS_COPIED_ctr
-</screen>
-
-    <para>The formatting of the information above the row of asterisks
-    is subject to change, but hopefully provides a useful
-    human-readable summary.  Below the asterisks <emphasis>all
-    counters</emphasis> maintained by the ticky-ticky system are
-    dumped, in a format intended to be machine-readable: zero or more
-    spaces, an integer, a space, the counter name, and a newline.</para>
-
-    <para>In fact, not <emphasis>all</emphasis> counters are
-    necessarily dumped; compile- or run-time flags can render certain
-    counters invalid.  In this case, either the counter will simply
-    not appear, or it will appear with a modified counter name,
-    possibly along with an explanation for the omission (notice
-    <literal>ENT&lowbar;PERM&lowbar;IND&lowbar;ctr</literal> appears
-    with an inserted <literal>!</literal> above).  Software analysing
-    this output should always check that it has the counters it
-    expects.  Also, beware: some of the counters can have
-    <emphasis>large</emphasis> values!</para>
-
-  </sect1>
-
-</chapter>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/runtime_control.xml b/ghc/docs/users_guide/runtime_control.xml
deleted file mode 100644
index daed07cee3..0000000000
--- a/ghc/docs/users_guide/runtime_control.xml
+++ /dev/null
@@ -1,622 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<sect1 id="runtime-control">
-  <title>Running a compiled program</title>
-
-  <indexterm><primary>runtime control of Haskell programs</primary></indexterm>
-  <indexterm><primary>running, compiled program</primary></indexterm>
-  <indexterm><primary>RTS options</primary></indexterm>
-
-  <para>To make an executable program, the GHC system compiles your
-  code and then links it with a non-trivial runtime system (RTS),
-  which handles storage management, profiling, etc.</para>
-
-  <para>You have some control over the behaviour of the RTS, by giving
-  special command-line arguments to your program.</para>
-
-  <para>When your Haskell program starts up, its RTS extracts
-  command-line arguments bracketed between
-  <option>+RTS</option><indexterm><primary><option>+RTS</option></primary></indexterm>
-  and
-  <option>-RTS</option><indexterm><primary><option>-RTS</option></primary></indexterm>
-  as its own.  For example:</para>
-
-<screen>
-% ./a.out -f +RTS -p -S -RTS -h foo bar
-</screen>
-
-  <para>The RTS will snaffle <option>-p</option> <option>-S</option>
-  for itself, and the remaining arguments <literal>-f -h foo bar</literal>
-  will be handed to your program if/when it calls
-  <function>System.getArgs</function>.</para>
-
-  <para>No <option>-RTS</option> option is required if the
-  runtime-system options extend to the end of the command line, as in
-  this example:</para>
-
-<screen>
-% hls -ltr /usr/etc +RTS -A5m
-</screen>
-
-  <para>If you absolutely positively want all the rest of the options
-  in a command line to go to the program (and not the RTS), use a
-  <option>&ndash;&ndash;RTS</option><indexterm><primary><option>--RTS</option></primary></indexterm>.</para>
-
-  <para>As always, for RTS options that take
-  <replaceable>size</replaceable>s: If the last character of
-  <replaceable>size</replaceable> is a K or k, multiply by 1000; if an
-  M or m, by 1,000,000; if a G or G, by 1,000,000,000.  (And any
-  wraparound in the counters is <emphasis>your</emphasis>
-  fault!)</para>
-
-  <para>Giving a <literal>+RTS -f</literal>
-  <indexterm><primary><option>-f</option></primary><secondary>RTS option</secondary></indexterm> option
-  will print out the RTS options actually available in your program
-  (which vary, depending on how you compiled).</para>
-
-  <para>NOTE: since GHC is itself compiled by GHC, you can change RTS
-  options in the compiler using the normal
-  <literal>+RTS ... -RTS</literal>
-  combination.  eg. to increase the maximum heap
-  size for a compilation to 128M, you would add
-  <literal>+RTS -M128m -RTS</literal>
-  to the command line.</para>
-
-  <sect2 id="rts-optinos-environment">
-    <title>Setting global RTS options</title>
-
-    <indexterm><primary>RTS options</primary><secondary>from the environment</secondary></indexterm>
-    <indexterm><primary>environment variable</primary><secondary>for
-    setting RTS options</secondary></indexterm>
-
-    <para>RTS options are also taken from the environment variable
-    <envar>GHCRTS</envar><indexterm><primary><envar>GHCRTS</envar></primary>
-      </indexterm>.  For example, to set the maximum heap size
-    to 128M for all GHC-compiled programs (using an
-    <literal>sh</literal>-like shell):</para>
-
-<screen>
-   GHCRTS='-M128m'
-   export GHCRTS
-</screen>
-
-    <para>RTS options taken from the <envar>GHCRTS</envar> environment
-    variable can be overridden by options given on the command
-    line.</para>
-
-  </sect2>
-
-  <sect2 id="rts-options-gc">
-    <title>RTS options to control the garbage collector</title>
-
-    <indexterm><primary>garbage collector</primary><secondary>options</secondary></indexterm>
-    <indexterm><primary>RTS options</primary><secondary>garbage collection</secondary></indexterm>
-
-    <para>There are several options to give you precise control over
-    garbage collection.  Hopefully, you won't need any of these in
-    normal operation, but there are several things that can be tweaked
-    for maximum performance.</para>
-
-    <variablelist>
-
-      <varlistentry>
-	<term>
-          <option>-A</option><replaceable>size</replaceable>
-          <indexterm><primary><option>-A</option></primary><secondary>RTS option</secondary></indexterm>
-          <indexterm><primary>allocation area, size</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>&lsqb;Default: 256k&rsqb; Set the allocation area size
-          used by the garbage collector.  The allocation area
-          (actually generation 0 step 0) is fixed and is never resized
-          (unless you use <option>-H</option>, below).</para>
-
-	  <para>Increasing the allocation area size may or may not
-          give better performance (a bigger allocation area means
-          worse cache behaviour but fewer garbage collections and less
-          promotion).</para>
-
-	  <para>With only 1 generation (<option>-G1</option>) the
-          <option>-A</option> option specifies the minimum allocation
-          area, since the actual size of the allocation area will be
-          resized according to the amount of data in the heap (see
-          <option>-F</option>, below).</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-c</option>
-          <indexterm><primary><option>-c</option></primary><secondary>RTS option</secondary></indexterm>
-          <indexterm><primary>garbage collection</primary><secondary>compacting</secondary></indexterm>
-          <indexterm><primary>compacting garbage collection</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Use a compacting algorithm for collecting the oldest
-	  generation.  By default, the oldest generation is collected
-	  using a copying algorithm; this option causes it to be
-	  compacted in-place instead.  The compaction algorithm is
-	  slower than the copying algorithm, but the savings in memory
-	  use can be considerable.</para>
-
-	  <para>For a given heap size (using the <option>-H</option>
-	  option), compaction can in fact reduce the GC cost by
-	  allowing fewer GCs to be performed.  This is more likely
-	  when the ratio of live data to heap size is high, say
-	  &gt;30&percnt;.</para>
-
-	  <para>NOTE: compaction doesn't currently work when a single
-	  generation is requested using the <option>-G1</option>
-	  option.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-c</option><replaceable>n</replaceable></term>
-
-	<listitem>
-	  <para>&lsqb;Default: 30&rsqb; Automatically enable
-	  compacting collection when the live data exceeds
-	  <replaceable>n</replaceable>&percnt; of the maximum heap size
-	  (see the <option>-M</option> option).  Note that the maximum
-	  heap size is unlimited by default, so this option has no
-	  effect unless the maximum heap size is set with
-	  <option>-M</option><replaceable>size</replaceable>. </para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-F</option><replaceable>factor</replaceable>
-          <indexterm><primary><option>-F</option></primary><secondary>RTS option</secondary></indexterm>
-          <indexterm><primary>heap size, factor</primary></indexterm>
-        </term>
-	<listitem>
-
-	  <para>&lsqb;Default: 2&rsqb; This option controls the amount
-          of memory reserved for the older generations (and in the
-          case of a two space collector the size of the allocation
-          area) as a factor of the amount of live data.  For example,
-          if there was 2M of live data in the oldest generation when
-          we last collected it, then by default we'll wait until it
-          grows to 4M before collecting it again.</para>
-
-	  <para>The default seems to work well here.  If you have
-          plenty of memory, it is usually better to use
-          <option>-H</option><replaceable>size</replaceable> than to
-          increase
-          <option>-F</option><replaceable>factor</replaceable>.</para>
-
-	  <para>The <option>-F</option> setting will be automatically
-          reduced by the garbage collector when the maximum heap size
-          (the <option>-M</option><replaceable>size</replaceable>
-          setting) is approaching.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-G</option><replaceable>generations</replaceable>
-          <indexterm><primary><option>-G</option></primary><secondary>RTS option</secondary></indexterm>
-          <indexterm><primary>generations, number of</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>&lsqb;Default: 2&rsqb; Set the number of generations
-          used by the garbage collector.  The default of 2 seems to be
-          good, but the garbage collector can support any number of
-          generations.  Anything larger than about 4 is probably not a
-          good idea unless your program runs for a
-          <emphasis>long</emphasis> time, because the oldest
-          generation will hardly ever get collected.</para>
-
-	  <para>Specifying 1 generation with <option>+RTS -G1</option>
-          gives you a simple 2-space collector, as you would expect.
-          In a 2-space collector, the <option>-A</option> option (see
-          above) specifies the <emphasis>minimum</emphasis> allocation
-          area size, since the allocation area will grow with the
-          amount of live data in the heap.  In a multi-generational
-          collector the allocation area is a fixed size (unless you
-          use the <option>-H</option> option, see below).</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-H</option><replaceable>size</replaceable>
-          <indexterm><primary><option>-H</option></primary><secondary>RTS option</secondary></indexterm>
-          <indexterm><primary>heap size, suggested</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>&lsqb;Default: 0&rsqb; This option provides a
-          &ldquo;suggested heap size&rdquo; for the garbage collector.  The
-          garbage collector will use about this much memory until the
-          program residency grows and the heap size needs to be
-          expanded to retain reasonable performance.</para>
-
-	  <para>By default, the heap will start small, and grow and
-          shrink as necessary.  This can be bad for performance, so if
-          you have plenty of memory it's worthwhile supplying a big
-          <option>-H</option><replaceable>size</replaceable>.  For
-          improving GC performance, using
-          <option>-H</option><replaceable>size</replaceable> is
-          usually a better bet than
-          <option>-A</option><replaceable>size</replaceable>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-	  <option>-I</option><replaceable>seconds</replaceable>
-	  <indexterm><primary><option>-H</option></primary>
-	    <secondary>RTS option</secondary>
-	  </indexterm>
-	  <indexterm><primary>idle GC</primary>
-	  </indexterm>
-	  </term>
-	<listitem>
-	  <para>(default: 0.3) In the threaded and SMP versions of the RTS (see
-	    <option>-threaded</option>, <xref linkend="options-linker" />), a
-	    major GC is automatically performed if the runtime has been idle
-	    (no Haskell computation has been running) for a period of time.
-	    The amount of idle time which must pass before a GC is performed is
-	    set by the <option>-I</option><replaceable>seconds</replaceable>
-	    option.  Specifying <option>-I0</option> disables the idle GC.</para>
-
-	  <para>For an interactive application, it is probably a good idea to
-	    use the idle GC, because this will allow finalizers to run and
-	    deadlocked threads to be detected in the idle time when no Haskell
-	    computation is happening.  Also, it will mean that a GC is less
-	    likely to happen when the application is busy, and so
-	    responsiveness may be improved.   However, if the amount of live data in
-	    the heap is particularly large, then the idle GC can cause a
-	    significant delay, and too small an interval could adversely affect
-	    interactive responsiveness.</para>
-
-	  <para>This is an experimental feature, please let us know if it
-	    causes problems and/or could benefit from further tuning.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-         <option>-k</option><replaceable>size</replaceable>
-         <indexterm><primary><option>-k</option></primary><secondary>RTS option</secondary></indexterm>
-         <indexterm><primary>stack, minimum size</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>&lsqb;Default: 1k&rsqb; Set the initial stack size for
-          new threads.  Thread stacks (including the main thread's
-          stack) live on the heap, and grow as required.  The default
-          value is good for concurrent applications with lots of small
-          threads; if your program doesn't fit this model then
-          increasing this option may help performance.</para>
-
-	  <para>The main thread is normally started with a slightly
-          larger heap to cut down on unnecessary stack growth while
-          the program is starting up.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-K</option><replaceable>size</replaceable>
-          <indexterm><primary><option>-K</option></primary><secondary>RTS option</secondary></indexterm>
-          <indexterm><primary>stack, maximum size</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>&lsqb;Default: 8M&rsqb; Set the maximum stack size for
-          an individual thread to <replaceable>size</replaceable>
-          bytes.  This option is there purely to stop the program
-          eating up all the available memory in the machine if it gets
-          into an infinite loop.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-m</option><replaceable>n</replaceable>
-          <indexterm><primary><option>-m</option></primary><secondary>RTS option</secondary></indexterm>
-          <indexterm><primary>heap, minimum free</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Minimum &percnt; <replaceable>n</replaceable> of heap
-          which must be available for allocation.  The default is
-          3&percnt;.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-M</option><replaceable>size</replaceable>
-          <indexterm><primary><option>-M</option></primary><secondary>RTS option</secondary></indexterm>
-          <indexterm><primary>heap size, maximum</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>&lsqb;Default: unlimited&rsqb; Set the maximum heap size to
-          <replaceable>size</replaceable> bytes.  The heap normally
-          grows and shrinks according to the memory requirements of
-          the program.  The only reason for having this option is to
-          stop the heap growing without bound and filling up all the
-          available swap space, which at the least will result in the
-          program being summarily killed by the operating
-          system.</para>
-
-	  <para>The maximum heap size also affects other garbage
-	  collection parameters: when the amount of live data in the
-	  heap exceeds a certain fraction of the maximum heap size,
-	  compacting collection will be automatically enabled for the
-	  oldest generation, and the <option>-F</option> parameter
-	  will be reduced in order to avoid exceeding the maximum heap
-	  size.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-s</option><replaceable>file</replaceable>
-          <indexterm><primary><option>-s</option></primary><secondary>RTS option</secondary></indexterm>
-        </term>
-	<term>
-          <option>-S</option><replaceable>file</replaceable>
-          <indexterm><primary><option>-S</option></primary><secondary>RTS option</secondary></indexterm>
-        </term>
-	<listitem>
-	  <para>Write modest (<option>-s</option>) or verbose
-          (<option>-S</option>) garbage-collector statistics into file
-          <replaceable>file</replaceable>. The default
-          <replaceable>file</replaceable> is
-          <filename><replaceable>program</replaceable>.stat</filename>. The
-          <replaceable>file</replaceable> <constant>stderr</constant>
-          is treated specially, with the output really being sent to
-          <constant>stderr</constant>.</para>
-
-	  <para>This option is useful for watching how the storage
-          manager adjusts the heap size based on the current amount of
-          live data.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-t<replaceable>file</replaceable></option>
-          <indexterm><primary><option>-t</option></primary><secondary>RTS option</secondary></indexterm>
-        </term>
-	<listitem>
-	  <para>Write a one-line GC stats summary after running the
-	  program.  This output is in the same format as that produced
-	  by the <option>-Rghc-timing</option> option.</para>
-
-	  <para>As with <option>-s</option>, the default
-          <replaceable>file</replaceable> is
-          <filename><replaceable>program</replaceable>.stat</filename>. The
-          <replaceable>file</replaceable> <constant>stderr</constant>
-          is treated specially, with the output really being sent to
-          <constant>stderr</constant>.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-  </sect2>
-
-  <sect2>
-    <title>RTS options for profiling and Concurrent/Parallel Haskell</title>
-
-    <para>The RTS options related to profiling are described in <xref
-    linkend="rts-options-heap-prof"/>; and those for concurrent/parallel
-    stuff, in <xref linkend="parallel-rts-opts"/>.</para>
-  </sect2>
-
-  <sect2 id="rts-options-debugging">
-    <title>RTS options for hackers, debuggers, and over-interested
-    souls</title>
-
-    <indexterm><primary>RTS options, hacking/debugging</primary></indexterm>
-
-    <para>These RTS options might be used (a)&nbsp;to avoid a GHC bug,
-    (b)&nbsp;to see &ldquo;what's really happening&rdquo;, or
-    (c)&nbsp;because you feel like it.  Not recommended for everyday
-    use!</para>
-
-    <variablelist>
-
-      <varlistentry>
-	<term>
-          <option>-B</option>
-          <indexterm><primary><option>-B</option></primary><secondary>RTS option</secondary></indexterm>
-        </term>
-	<listitem>
-	  <para>Sound the bell at the start of each (major) garbage
-	  collection.</para>
-
-	  <para>Oddly enough, people really do use this option!  Our
-          pal in Durham (England), Paul Callaghan, writes: &ldquo;Some
-          people here use it for a variety of
-          purposes&mdash;honestly!&mdash;e.g., confirmation that the
-          code/machine is doing something, infinite loop detection,
-          gauging cost of recently added code. Certain people can even
-          tell what stage &lsqb;the program&rsqb; is in by the beep
-          pattern. But the major use is for annoying others in the
-          same office&hellip;&rdquo;</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-D</option><replaceable>num</replaceable>
-          <indexterm><primary>-D</primary><secondary>RTS option</secondary></indexterm>
-        </term>
-	<listitem>
-	  <para>An RTS debugging flag; varying quantities of output
-          depending on which bits are set in
-          <replaceable>num</replaceable>.  Only works if the RTS was
-          compiled with the <option>DEBUG</option> option.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-r</option><replaceable>file</replaceable>
-          <indexterm><primary><option>-r</option></primary><secondary>RTS option</secondary></indexterm>
-          <indexterm><primary>ticky ticky profiling</primary></indexterm>
-          <indexterm><primary>profiling</primary><secondary>ticky ticky</secondary></indexterm>
-        </term>
-	<listitem>
-	  <para>Produce &ldquo;ticky-ticky&rdquo; statistics at the
-          end of the program run.  The <replaceable>file</replaceable>
-          business works just like on the <option>-S</option> RTS
-          option (above).</para>
-
-	  <para>&ldquo;Ticky-ticky&rdquo; statistics are counts of
-          various program actions (updates, enters, etc.)  The program
-          must have been compiled using
-          <option>-ticky</option><indexterm><primary><option>-ticky</option></primary></indexterm>
-          (a.k.a. &ldquo;ticky-ticky profiling&rdquo;), and, for it to
-          be really useful, linked with suitable system libraries.
-          Not a trivial undertaking: consult the installation guide on
-          how to set things up for easy &ldquo;ticky-ticky&rdquo;
-          profiling.  For more information, see <xref
-          linkend="ticky-ticky"/>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-xc</option>
-          <indexterm><primary><option>-xc</option></primary><secondary>RTS option</secondary></indexterm>
-        </term>
-	<listitem>
-	  <para>(Only available when the program is compiled for
-	  profiling.)  When an exception is raised in the program,
-	  this option causes the current cost-centre-stack to be
-	  dumped to <literal>stderr</literal>.</para>
-
-	  <para>This can be particularly useful for debugging: if your
-	  program is complaining about a <literal>head []</literal>
-	  error and you haven't got a clue which bit of code is
-	  causing it, compiling with <literal>-prof
-	  -auto-all</literal> and running with <literal>+RTS -xc
-	  -RTS</literal> will tell you exactly the call stack at the
-	  point the error was raised.</para>
-
-	  <para>The output contains one line for each exception raised
-	  in the program (the program might raise and catch several
-	  exceptions during its execution), where each line is of the
-	  form:</para>
-
-<screen>
-&lt; cc<subscript>1</subscript>, ..., cc<subscript>n</subscript> &gt;
-</screen>
-	  <para>each <literal>cc</literal><subscript>i</subscript> is
-	  a cost centre in the program (see <xref
-	  linkend="cost-centres"/>), and the sequence represents the
-	  &ldquo;call stack&rdquo; at the point the exception was
-	  raised.  The leftmost item is the innermost function in the
-	  call stack, and the rightmost item is the outermost
-	  function.</para>
-
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-Z</option>
-          <indexterm><primary><option>-Z</option></primary><secondary>RTS option</secondary></indexterm>
-        </term>
-	<listitem>
-	  <para>Turn <emphasis>off</emphasis> &ldquo;update-frame
-          squeezing&rdquo; at garbage-collection time.  (There's no
-          particularly good reason to turn it off, except to ensure
-          the accuracy of certain data collected regarding thunk entry
-          counts.)</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-  </sect2>
-
-  <sect2 id="rts-hooks">
-    <title>&ldquo;Hooks&rdquo; to change RTS behaviour</title>
-
-    <indexterm><primary>hooks</primary><secondary>RTS</secondary></indexterm>
-    <indexterm><primary>RTS hooks</primary></indexterm>
-    <indexterm><primary>RTS behaviour, changing</primary></indexterm>
-
-    <para>GHC lets you exercise rudimentary control over the RTS
-    settings for any given program, by compiling in a
-    &ldquo;hook&rdquo; that is called by the run-time system.  The RTS
-    contains stub definitions for all these hooks, but by writing your
-    own version and linking it on the GHC command line, you can
-    override the defaults.</para>
-
-    <para>Owing to the vagaries of DLL linking, these hooks don't work
-    under Windows when the program is built dynamically.</para>
-
-    <para>The hook <literal>ghc_rts_opts</literal><indexterm><primary><literal>ghc_rts_opts</literal></primary>
-      </indexterm>lets you set RTS
-    options permanently for a given program.  A common use for this is
-    to give your program a default heap and/or stack size that is
-    greater than the default.  For example, to set <literal>-H128m
-    -K1m</literal>, place the following definition in a C source
-    file:</para>
-
-<programlisting>
-char *ghc_rts_opts = "-H128m -K1m";
-</programlisting>
-
-    <para>Compile the C file, and include the object file on the
-    command line when you link your Haskell program.</para>
-
-    <para>These flags are interpreted first, before any RTS flags from
-    the <literal>GHCRTS</literal> environment variable and any flags
-    on the command line.</para>
-
-    <para>You can also change the messages printed when the runtime
-    system &ldquo;blows up,&rdquo; e.g., on stack overflow.  The hooks
-    for these are as follows:</para>
-
-    <variablelist>
-
-      <varlistentry>
-	<term>
-          <function>void OutOfHeapHook (unsigned long, unsigned long)</function>
-          <indexterm><primary><function>OutOfHeapHook</function></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>The heap-overflow message.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <function>void StackOverflowHook (long int)</function>
-          <indexterm><primary><function>StackOverflowHook</function></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>The stack-overflow message.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <function>void MallocFailHook (long int)</function>
-          <indexterm><primary><function>MallocFailHook</function></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>The message printed if <function>malloc</function>
-	  fails.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-    <para>For examples of the use of these hooks, see GHC's own
-    versions in the file
-    <filename>ghc/compiler/parser/hschooks.c</filename> in a GHC
-    source tree.</para>
-  </sect2>
-</sect1>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter" "sect1") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/separate_compilation.xml b/ghc/docs/users_guide/separate_compilation.xml
deleted file mode 100644
index c33ff2175b..0000000000
--- a/ghc/docs/users_guide/separate_compilation.xml
+++ /dev/null
@@ -1,1213 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-  <sect1 id="separate-compilation">
-    <title>Filenames and separate compilation</title>
-
-    <indexterm><primary>separate compilation</primary></indexterm>
-    <indexterm><primary>recompilation checker</primary></indexterm>
-    <indexterm><primary>make and recompilation</primary></indexterm>
-
-    <para>This section describes what files GHC expects to find, what
-    files it creates, where these files are stored, and what options
-    affect this behaviour.</para>
-
-    <para>Note that this section is written with
-    <firstterm>hierarchical modules</firstterm> in mind (see <xref
-    linkend="hierarchical-modules"/>); hierarchical modules are an
-    extension to Haskell 98 which extends the lexical syntax of
-    module names to include a dot &lsquo;.&rsquo;.  Non-hierarchical
-    modules are thus a special case in which none of the module names
-    contain dots.</para>
-
-    <para>Pathname conventions vary from system to system.  In
-    particular, the directory separator is
-    &lsquo;<literal>/</literal>&rsquo; on Unix systems and
-    &lsquo;<literal>\</literal>&rsquo; on Windows systems.  In the
-    sections that follow, we shall consistently use
-    &lsquo;<literal>/</literal>&rsquo; as the directory separator;
-    substitute this for the appropriate character for your
-    system.</para>
-
-    <sect2 id="source-files">
-      <title>Haskell source files</title>
-
-      <indexterm><primary>filenames</primary></indexterm>
-
-      <para>Each Haskell source module should be placed in a file on
-      its own.</para>
-
-      <para>Usually, the file should be named after the module name,
-      replacing dots in the module name by directory separators.  For
-      example, on a Unix system, the module <literal>A.B.C</literal>
-      should be placed in the file <literal>A/B/C.hs</literal>,
-      relative to some base directory.  If the module is not going to
-      be imported by another module (<literal>Main</literal>, for
-      example), then you are free to use any filename for it.</para>
-
-      <indexterm><primary>unicode</primary></indexterm>
-
-      <para> GHC assumes that source files are
-      ASCII<indexterm><primary>ASCII</primary></indexterm> or
-      UTF-8<indexterm><primary>UTF-8</primary></indexterm> only, other
-      encodings<indexterm><primary>encoding</primary></indexterm> are
-      not recognised.  However, invalid UTF-8 sequences will be
-      ignored in comments, so it is possible to use other encodings
-      such as
-      Latin-1<indexterm><primary>Latin-1</primary></indexterm>, as
-      long as the non-comment source code is ASCII only.</para>
-    </sect2>
-
-    <sect2 id="output-files">
-      <title>Output files</title>
-
-      <indexterm><primary>interface files</primary></indexterm>
-      <indexterm><primary><literal>.hi</literal> files</primary></indexterm>
-      <indexterm><primary>object files</primary></indexterm>
-      <indexterm><primary><literal>.o</literal> files</primary></indexterm>
-
-      <para>When asked to compile a source file, GHC normally
-      generates two files: an <firstterm>object file</firstterm>, and
-      an <firstterm>interface file</firstterm>. </para>
-
-      <para>The object file, which normally ends in a
-      <literal>.o</literal> suffix, contains the compiled code for the
-      module.</para>
-
-      <para>The interface file,
-      which normally ends in a <literal>.hi</literal> suffix, contains
-      the information that GHC needs in order to compile further
-      modules that depend on this module.  It contains things like the
-      types of exported functions, definitions of data types, and so
-      on.  It is stored in a binary format, so don't try to read one;
-      use the <option>--show-iface</option> option instead (see <xref
-      linkend="hi-options"/>).</para>
-
-      <para>You should think of the object file and the interface file as a
-      pair, since the interface file is in a sense a compiler-readable
-      description of the contents of the object file.  If the
-      interface file and object file get out of sync for any reason,
-      then the compiler may end up making assumptions about the object
-      file that aren't true; trouble will almost certainly follow.
-      For this reason, we recommend keeping object files and interface
-      files in the same place (GHC does this by default, but it is
-      possible to override the defaults as we'll explain
-      shortly).</para>
-
-      <para>Every module has a <emphasis>module name</emphasis>
-      defined in its source code (<literal>module A.B.C where
-      ...</literal>).</para>
-
-      <para>The name of the object file generated by GHC is derived
-      according to the following rules, where
-      <replaceable>osuf</replaceable> is the object-file suffix (this
-      can be changed with the <option>-osuf</option> option).</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para>If there is no <option>-odir</option> option (the
-	  default), then the object filename is derived from the
-	  source filename (ignoring the module name) by replacing the
-	  suffix with <replaceable>osuf</replaceable>.</para>
-	</listitem>
-	<listitem>
-	  <para>If
-	  <option>-odir</option>&nbsp;<replaceable>dir</replaceable>
-	  has been specified, then the object filename is
-	  <replaceable>dir</replaceable>/<replaceable>mod</replaceable>.<replaceable>osuf</replaceable>,
-	  where <replaceable>mod</replaceable> is the module name with
-	  dots replaced by slashes.</para>
-	</listitem>
-      </itemizedlist>
-
-      <para>The name of the interface file is derived using the same
-      rules, except that the suffix is
-      <replaceable>hisuf</replaceable> (<literal>.hi</literal> by
-      default) instead of <replaceable>osuf</replaceable>, and the
-      relevant options are <option>-hidir</option> and
-      <option>-hisuf</option> instead of <option>-odir</option> and
-      <option>-osuf</option> respectively.</para>
-
-      <para>For example, if GHC compiles the module
-      <literal>A.B.C</literal> in the file
-      <filename>src/A/B/C.hs</filename>, with no
-      <literal>-odir</literal> or <literal>-hidir</literal> flags, the
-      interface file will be put in <literal>src/A/B/C.hi</literal>
-      and the object file in <literal>src/A/B/C.o</literal>.</para>
-
-      <para>For any module that is imported, GHC requires that the
-      name of the module in the import statement exactly matches the
-      name of the module in the interface file (or source file) found
-      using the strategy specified in <xref linkend="search-path"/>.
-      This means that for most modules, the source file name should
-      match the module name.</para>
-
-      <para>However, note that it is reasonable to have a module
-      <literal>Main</literal> in a file named
-      <filename>foo.hs</filename>, but this only works because GHC
-      never needs to search for the interface for module
-      <literal>Main</literal> (because it is never imported).  It is
-      therefore possible to have several <literal>Main</literal>
-      modules in separate source files in the same directory, and GHC
-      will not get confused.</para>
-
-      <para>In batch compilation mode, the name of the object file can
-      also be overridden using the <option>-o</option> option, and the
-      name of the interface file can be specified directly using the
-      <option>-ohi</option> option.</para>
-    </sect2>
-
-    <sect2 id="search-path">
-      <title>The search path</title>
-
-      <indexterm><primary>search path</primary>
-      </indexterm>
-      <indexterm><primary>interface files, finding them</primary></indexterm>
-      <indexterm><primary>finding interface files</primary></indexterm>
-
-      <para>In your program, you import a module
-      <literal>Foo</literal> by saying <literal>import Foo</literal>.
-      In <option>--make</option> mode or GHCi, GHC will look for a
-      source file for <literal>Foo</literal> and arrange to compile it
-      first.  Without <option>--make</option>, GHC will look for the
-      interface file for <literal>Foo</literal>, which should have
-      been created by an earlier compilation of
-      <literal>Foo</literal>.  GHC uses the same strategy in each of
-      these cases for finding the appropriate file.</para>
-
-      <para>This strategy is as follows: GHC keeps a list of
-      directories called the <firstterm>search path</firstterm>.  For
-      each of these directories, it tries appending
-      <replaceable>basename</replaceable><literal>.</literal><replaceable>extension</replaceable>
-      to the directory, and checks whether the file exists.  The value
-      of <replaceable>basename</replaceable> is the module name with
-      dots replaced by the directory separator ('/' or '\', depending
-      on the system), and <replaceable>extension</replaceable> is a
-      source extension (<literal>hs</literal>, <literal>lhs</literal>)
-      if we are in <option>--make</option> mode and GHCi, or
-      <replaceable>hisuf</replaceable> otherwise.</para>
-
-      <para>For example, suppose the search path contains directories
-      <literal>d1</literal>, <literal>d2</literal>, and
-      <literal>d3</literal>, and we are in <literal>--make</literal>
-      mode looking for the source file for a module
-      <literal>A.B.C</literal>.  GHC will look in
-      <literal>d1/A/B/C.hs</literal>, <literal>d1/A/B/C.lhs</literal>,
-      <literal>d2/A/B/C.hs</literal>, and so on.</para>
-
-      <para>The search path by default contains a single directory:
-      <quote>.</quote> (i.e. the current directory).  The following
-      options can be used to add to or change the contents of the
-      search path:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term><option>-i<replaceable>dirs</replaceable></option></term>
-	  <listitem>
-	    <para><indexterm><primary><option>-i<replaceable>dirs</replaceable></option>
-            </primary></indexterm>This flag appends a colon-separated
-            list of <filename>dirs</filename> to the search path.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><option>-i</option></term>
-	  <listitem>
-	    <para>resets the search path back to nothing.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>This isn't the whole story: GHC also looks for modules in
-      pre-compiled libraries, known as packages.  See the section on
-      packages (<xref linkend="packages"/>), for details.</para>
-    </sect2>
-
-    <sect2 id="options-output">
-      <title>Redirecting the compilation output(s)</title>
-
-      <indexterm><primary>output-directing options</primary></indexterm>
-      <indexterm><primary>redirecting compilation output</primary></indexterm>
-
-      <variablelist>
-	<varlistentry>
-	  <term>
-            <option>-o</option> <replaceable>file</replaceable>
-            <indexterm><primary><option>-o</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>GHC's compiled output normally goes into a
-            <filename>.hc</filename>, <filename>.o</filename>, etc.,
-            file, depending on the last-run compilation phase.  The
-            option <option>-o <replaceable>file</replaceable></option>
-            re-directs the output of that last-run phase to
-            <replaceable>file</replaceable>.</para>
-
-	    <para>Note: this &ldquo;feature&rdquo; can be
-            counterintuitive: <command>ghc -C -o foo.o
-            foo.hs</command> will put the intermediate C code in the
-            file <filename>foo.o</filename>, name
-            notwithstanding!</para>
-
-	    <para>This option is most often used when creating an
-	    executable file, to set the filename of the executable.
-	    For example:
-<screen>   ghc -o prog --make Main</screen>
-
-            will compile the program starting with module
-            <literal>Main</literal>  and put the executable in the
-            file <literal>prog</literal>.</para>
-
-	    <para>Note: on Windows, if the result is an executable
-            file, the extension "<filename>.exe</filename>" is added
-            if the specified filename does not already have an
-            extension.  Thus
-<programlisting>
-   ghc -o foo Main.hs
-</programlisting>
-          will compile and link the module
-          <filename>Main.hs</filename>, and put the resulting
-          executable in <filename>foo.exe</filename> (not
-          <filename>foo</filename>).</para>
-
-          <para>If you use <command>ghc --make</command> and you don't
-          use the <option>-o</option>, the name GHC will choose
-          for the executable will be based on the name of the file
-          containing the module <literal>Main</literal>. 
-          Note that with GHC the <literal>Main</literal> module doesn't
-          have to be put in file <filename>Main.hs</filename>.
-          Thus both
-<programlisting>
-   ghc --make Prog
-</programlisting>
-          and
-<programlisting>
-   ghc --make Prog.hs
-</programlisting>
-          will produce <filename>Prog</filename> (or
-          <filename>Prog.exe</filename> if you are on Windows).</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-odir</option> <replaceable>dir</replaceable>
-            <indexterm><primary><option>-odir</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Redirects object files to directory
-	    <replaceable>dir</replaceable>.  For example:</para>
-
-<screen>
-$ ghc -c parse/Foo.hs parse/Bar.hs gurgle/Bumble.hs -odir `arch`
-</screen>
-
-	    <para>The object files, <filename>Foo.o</filename>,
-            <filename>Bar.o</filename>, and
-            <filename>Bumble.o</filename> would be put into a
-            subdirectory named after the architecture of the executing
-            machine (<filename>x86</filename>,
-            <filename>mips</filename>, etc).</para>
-
-	    <para>Note that the <option>-odir</option> option does
-            <emphasis>not</emphasis> affect where the interface files
-            are put; use the <option>-hidir</option> option for that.
-            In the above example, they would still be put in
-            <filename>parse/Foo.hi</filename>,
-            <filename>parse/Bar.hi</filename>, and
-            <filename>gurgle/Bumble.hi</filename>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-ohi</option>  <replaceable>file</replaceable>
-            <indexterm><primary><option>-ohi</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>The interface output may be directed to another file
-            <filename>bar2/Wurble.iface</filename> with the option
-            <option>-ohi bar2/Wurble.iface</option> (not
-            recommended).</para>
-
-	    <para>WARNING: if you redirect the interface file
-	    somewhere that GHC can't find it, then the recompilation
-	    checker may get confused (at the least, you won't get any
-	    recompilation avoidance).  We recommend using a
-	    combination of <option>-hidir</option> and
-	    <option>-hisuf</option> options instead, if
-	    possible.</para>
-
-	    <para>To avoid generating an interface at all, you could
-            use this option to redirect the interface into the bit
-            bucket: <literal>-ohi /dev/null</literal>, for
-            example.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-hidir</option>  <replaceable>dir</replaceable>
-            <indexterm><primary><option>-hidir</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Redirects all generated interface files into
-	    <replaceable>dir</replaceable>, instead of the
-	    default.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-stubdir</option>  <replaceable>dir</replaceable>
-            <indexterm><primary><option>-stubdir</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Redirects all generated FFI stub files into
-	    <replaceable>dir</replaceable>.  Stub files are generated when the
-	    Haskell source contains a <literal>foreign export</literal> or
-	    <literal>foreign import "&amp;wrapper"</literal> declaration (see <xref
-	      linkend="foreign-export-ghc" />).  The <option>-stubdir</option>
-	      option behaves in exactly the same way as <option>-odir</option>
-	      and <option>-hidir</option> with respect to hierarchical
-	    modules.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-osuf</option> <replaceable>suffix</replaceable>
-            <indexterm><primary><option>-osuf</option></primary></indexterm>
-          </term>
-	  <term>
-            <option>-hisuf</option> <replaceable>suffix</replaceable>
-            <indexterm><primary><option>-hisuf</option></primary></indexterm>
-          </term>
-	  <term>
-            <option>-hcsuf</option> <replaceable>suffix</replaceable>
-            <indexterm><primary><option>-hcsuf</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>The <option>-osuf</option>
-            <replaceable>suffix</replaceable> will change the
-            <literal>.o</literal> file suffix for object files to
-            whatever you specify.  We use this when compiling
-            libraries, so that objects for the profiling versions of
-            the libraries don't clobber the normal ones.</para>
-
-	    <para>Similarly, the <option>-hisuf</option>
-            <replaceable>suffix</replaceable> will change the
-            <literal>.hi</literal> file suffix for non-system
-            interface files (see <xref linkend="hi-options"/>).</para>
-
-	    <para>Finally, the option <option>-hcsuf</option>
-            <replaceable>suffix</replaceable> will change the
-            <literal>.hc</literal> file suffix for compiler-generated
-            intermediate C files.</para>
-
-	    <para>The <option>-hisuf</option>/<option>-osuf</option>
-            game is particularly useful if you want to compile a
-            program both with and without profiling, in the same
-            directory.  You can say:
-	    <screen>
-	      ghc ...</screen>
-	    to get the ordinary version, and
-	    <screen>
-	      ghc ... -osuf prof.o -hisuf prof.hi -prof -auto-all</screen>
-	    to get the profiled version.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-    </sect2>
-  
-    <sect2 id="keeping-intermediates">
-      <title>Keeping Intermediate Files</title>
-      <indexterm><primary>intermediate files, saving</primary>
-      </indexterm>
-      <indexterm><primary><literal>.hc</literal> files, saving</primary>
-      </indexterm>
-      <indexterm><primary><literal>.s</literal> files, saving</primary>
-      </indexterm>
-
-      <para>The following options are useful for keeping certain
-      intermediate files around, when normally GHC would throw these
-      away after compilation:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term>
-            <option>-keep-hc-files</option>
-            <indexterm><primary><option>-keep-hc-files</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Keep intermediate <literal>.hc</literal> files when
-	    doing <literal>.hs</literal>-to-<literal>.o</literal>
-	    compilations via C (NOTE: <literal>.hc</literal> files
-	    aren't generated when using the native code generator, you
-	    may need to use <option>-fvia-C</option> to force them
-	    to be produced).</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-keep-s-files</option>
-            <indexterm><primary><option>-keep-s-files</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Keep intermediate <literal>.s</literal> files.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-keep-raw-s-files</option>
-            <indexterm><primary><option>-keep-raw-s-files</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Keep intermediate <literal>.raw-s</literal> files.
-	    These are the direct output from the C compiler, before
-	    GHC does &ldquo;assembly mangling&rdquo; to produce the
-	    <literal>.s</literal> file.  Again, these are not produced
-	    when using the native code generator.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-keep-tmp-files</option>
-            <indexterm><primary><option>-keep-tmp-files</option></primary></indexterm>
-            <indexterm><primary>temporary files</primary><secondary>keeping</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Instructs the GHC driver not to delete any of its
-	    temporary files, which it normally keeps in
-	    <literal>/tmp</literal> (or possibly elsewhere; see <xref
-	    linkend="temp-files"/>).  Running GHC with
-	    <option>-v</option> will show you what temporary files
-	    were generated along the way.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-    </sect2>
-
-    <sect2 id="temp-files">
-      <title>Redirecting temporary files</title>
-
-      <indexterm>
-	<primary>temporary files</primary>
-	<secondary>redirecting</secondary>
-      </indexterm>
-
-      <variablelist>
-	<varlistentry>
-	  <term>
-            <option>-tmpdir</option>
-            <indexterm><primary><option>-tmpdir</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>If you have trouble because of running out of space
-            in <filename>/tmp</filename> (or wherever your
-            installation thinks temporary files should go), you may
-            use the <option>-tmpdir
-            &lt;dir&gt;</option><indexterm><primary>-tmpdir
-            &lt;dir&gt; option</primary></indexterm> option to specify
-            an alternate directory.  For example, <option>-tmpdir
-            .</option> says to put temporary files in the current
-            working directory.</para>
-
-	    <para>Alternatively, use your <constant>TMPDIR</constant>
-            environment variable.<indexterm><primary>TMPDIR
-            environment variable</primary></indexterm> Set it to the
-            name of the directory where temporary files should be put.
-            GCC and other programs will honour the
-            <constant>TMPDIR</constant> variable as well.</para>
-
-	    <para>Even better idea: Set the
-            <constant>DEFAULT_TMPDIR</constant> make variable when
-            building GHC, and never worry about
-            <constant>TMPDIR</constant> again. (see the build
-            documentation).</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-    </sect2>
-
-    <sect2 id="hi-options">
-      <title>Other options related to interface files</title>
-      <indexterm><primary>interface files, options</primary></indexterm>
-
-      <variablelist>
-	<varlistentry>
-	  <term>
-            <option>-ddump-hi</option>
-            <indexterm><primary><option>-ddump-hi</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Dumps the new interface to standard output.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-ddump-hi-diffs</option>
-            <indexterm><primary><option>-ddump-hi-diffs</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>The compiler does not overwrite an existing
-            <filename>.hi</filename> interface file if the new one is
-            the same as the old one; this is friendly to
-            <command>make</command>.  When an interface does change,
-            it is often enlightening to be informed.  The
-            <option>-ddump-hi-diffs</option> option will make GHC run
-            <command>diff</command> on the old and new
-            <filename>.hi</filename> files.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-ddump-minimal-imports</option>
-            <indexterm><primary><option>-ddump-minimal-imports</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Dump to the file "M.imports" (where M is the module
-            being compiled) a "minimal" set of import declarations.
-            You can safely replace all the import declarations in
-            "M.hs" with those found in "M.imports".  Why would you
-            want to do that?  Because the "minimal" imports (a) import
-            everything explicitly, by name, and (b) import nothing
-            that is not required.  It can be quite painful to maintain
-            this property by hand, so this flag is intended to reduce
-            the labour.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>--show-iface</option> <replaceable>file</replaceable>
-            <indexterm><primary><option>--show-iface</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Where <replaceable>file</replaceable> is the name of
-	    an interface file, dumps the contents of that interface in
-	    a human-readable (ish) format.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-    </sect2>
-
-    <sect2 id="recomp">
-      <title>The recompilation checker</title>
-
-      <indexterm><primary>recompilation checker</primary></indexterm>
-
-      <variablelist>
-	<varlistentry>
-	  <term>
-            <option>-no-recomp</option>
-            <indexterm><primary><option>-recomp</option></primary></indexterm>
-            <indexterm><primary><option>-no-recomp</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Turn off recompilation checking (which is on by
-            default).  Recompilation checking normally stops
-            compilation early, leaving an existing
-            <filename>.o</filename> file in place, if it can be
-            determined that the module does not need to be
-            recompiled.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>In the olden days, GHC compared the newly-generated
-      <filename>.hi</filename> file with the previous version; if they
-      were identical, it left the old one alone and didn't change its
-      modification date.  In consequence, importers of a module with
-      an unchanged output <filename>.hi</filename> file were not
-      recompiled.</para>
-
-      <para>This doesn't work any more.  Suppose module
-      <literal>C</literal> imports module <literal>B</literal>, and
-      <literal>B</literal> imports module <literal>A</literal>.  So
-      changes to module <literal>A</literal> might require module
-      <literal>C</literal> to be recompiled, and hence when
-      <filename>A.hi</filename> changes we should check whether
-      <literal>C</literal> should be recompiled.  However, the
-      dependencies of <literal>C</literal> will only list
-      <literal>B.hi</literal>, not <literal>A.hi</literal>, and some
-      changes to <literal>A</literal> (changing the definition of a
-      function that appears in an inlining of a function exported by
-      <literal>B</literal>, say) may conceivably not change
-      <filename>B.hi</filename> one jot.  So now&hellip;</para>
-
-      <para>GHC keeps a version number on each interface file, and on
-      each type signature within the interface file.  It also keeps in
-      every interface file a list of the version numbers of everything
-      it used when it last compiled the file.  If the source file's
-      modification date is earlier than the <filename>.o</filename>
-      file's date (i.e. the source hasn't changed since the file was
-      last compiled), and the recompilation checking is on, GHC will be
-      clever.  It compares the version numbers on the things it needs
-      this time with the version numbers on the things it needed last
-      time (gleaned from the interface file of the module being
-      compiled); if they are all the same it stops compiling rather
-      early in the process saying &ldquo;Compilation IS NOT
-      required&rdquo;.  What a beautiful sight!</para>
-
-      <para>Patrick Sansom had a workshop paper about how all this is
-      done (though the details have changed quite a bit). <ulink
-      url="mailto:sansom@dcs.gla.ac.uk">Ask him</ulink> if you want a
-      copy.</para>
-
-    </sect2>
-
-    <sect2 id="mutual-recursion">
-      <title>How to compile mutually recursive modules</title>
-
-      <indexterm><primary>module system, recursion</primary></indexterm>
-      <indexterm><primary>recursion, between modules</primary></indexterm>
-
-      <para>GHC supports the compilation of mutually recursive modules.
-      This section explains how.</para>
-
-      <para>Every cycle in the module import graph must be broken by a <filename>hs-boot</filename> file.
-      Suppose that modules <filename>A.hs</filename> and <filename>B.hs</filename> are Haskell source files, 
-      thus:
-<programlisting>
-module A where
-    import B( TB(..) )
-    
-    newtype TA = MkTA Int
-    
-    f :: TB -&#62; TA
-    f (MkTB x) = MkTA x
-
-module B where
-    import {-# SOURCE #-} A( TA(..) )
-    
-    data TB = MkTB !Int
-    
-    g :: TA -&#62; TB
-    g (MkTA x) = MkTB x
-</programlisting>
-<indexterm><primary><literal>hs-boot</literal>
-      files</primary></indexterm> <indexterm><primary>importing,
-      <literal>hi-boot</literal> files</primary></indexterm>
-Here <filename>A</filename> imports <filename>B</filename>, but <filename>B</filename> imports
-<filename>A</filename> with a <literal>{-# SOURCE #-}</literal> pragma, which breaks the
-circular dependency.  For every module <filename>A.hs</filename> that is <literal>{-# SOURCE #-}</literal>-imported
-in this way there must exist a souce file <literal>A.hs-boot</literal>.  This file contains an abbreviated
-version of <filename>A.hs</filename>, thus:
-<programlisting>
-module A where
-    newtype TA = MkTA Int
-</programlisting>
-</para>
-<para>To compile these three files, issue the following commands:
-<programlisting>
-  ghc -c A.hs-boot    -- Poduces A.hi-boot, A.o-boot
-  ghc -c B.hs         -- Consumes A.hi-boot, produces B.hi, B.o
-  ghc -c A.hs	      -- Consumes B.hi, produces A.hi, A.o
-  ghc -o foo A.o B.o  -- Linking the program
-</programlisting>
-</para>
-<para>There are several points to note here:
-<itemizedlist>
-<listitem>
-  <para>The file <filename>A.hs-boot</filename> is a programmer-written source file.
-  It must live in the same directory as its parent source file <filename>A.hs</filename>.
-  Currently, if you use a literate source file <filename>A.lhs</filename> you must
-  also use a literate boot file, <filename>A.lhs-boot</filename>; and vice versa.
-  </para></listitem>
-
-<listitem><para>
-  A <filename>hs-boot</filename> file is compiled by GHC, just like a <filename>hs</filename> file:
-<programlisting>
-  ghc -c A.hs-boot
-</programlisting>
-When a hs-boot file <filename>A.hs-boot</filename> 
-   is compiled, it is checked for scope and type errors.
-   When its parent module <filename>A.hs</filename> is compiled, the two are compared, and
-   an error is reported if the two are inconsistent.
-   </para></listitem>
-   
-	<listitem>
-	  <para> Just as compiling <filename>A.hs</filename> produces an
-	    interface file <filename>A.hi</filename>, and an object file
-	    <filename>A.o</filename>, so compiling
-	    <filename>A.hs-boot</filename> produces an interface file
-	    <filename>A.hi-boot</filename>, and an pseudo-object file
-	    <filename>A.o-boot</filename>: </para>
-
-	  <itemizedlist>
-	    <listitem>
-	      <para>The pseudo-object file <filename>A.o-boot</filename> is
-		empty (don't link it!), but it is very useful when using a
-		Makefile, to record when the <filename>A.hi-boot</filename> was
-		last brought up to date (see <xref
-		  linkend="using-make"/>).</para>
-	    </listitem>
-
-	    <listitem>
-	      <para>The <filename>hi-boot</filename> generated by compiling a
-		<filename>hs-boot</filename> file is in the same
-		machine-generated binary format as any other GHC-generated
-		interface file (e.g. <filename>B.hi</filename>). You can
-		display its contents with <command>ghc
-		  --show-iface</command>. If you specify a directory for
-		interface files, the <option>-ohidir</option> flag, then that
-		affects <filename>hi-boot</filename> files
-		too.</para>
-	    </listitem>
-	  </itemizedlist>
-	</listitem>
-
-   <listitem><para> If hs-boot files are considered distinct from their parent source
-   files, and if a <literal>{-# SOURCE #-}</literal> import is considered to refer to the
-   hs-boot file, then the module import graph must have no cycles.  The command
-   <command>ghc -M</command> will report an error if a cycle is found.
-   </para></listitem>
-
-   <listitem><para> A module <literal>M</literal> that is 
-   <literal>{-# SOURCE #-}</literal>-imported in a program will usually also be
-   ordinarily imported elsewhere.  If not, <command>ghc --make</command>
-   automatically adds <literal>M</literal> to the set of moudles it tries to
-   compile and link, to ensure that <literal>M</literal>'s implementation is included in
-   the final program.
-   </para></listitem>
-</itemizedlist>
-</para>
-<para>
-A hs-boot file need only contain the bare
-      minimum of information needed to get the bootstrapping process
-      started.  For example, it doesn't need to contain declarations
-      for <emphasis>everything</emphasis> that module
-      <literal>A</literal> exports, only the things required by the
-      module(s) that import <literal>A</literal> recursively.</para>
-<para>A hs-boot file is written in a subset of Haskell:
-<itemizedlist>
-<listitem><para> The module header (including the export list), and import statements, are exactly as in
-Haskell, and so are the scoping rules.  
-   Hence, to mention a non-Prelude type or class, you must import it.</para></listitem>
-   
-<listitem><para> There must be no value declarations, but there can be type signatures for
-values.  For example:
-<programlisting>
-  double :: Int -&#62; Int
-</programlisting>
-</para></listitem>
-<listitem><para> Fixity declarations are exactly as in Haskell.</para></listitem>
-<listitem><para> Type synonym declarations are exactly as in Haskell.</para></listitem>
-<listitem><para> A data type declaration can either be given in full, exactly as in Haskell, or it 
-can be given abstractly, by omitting the '=' sign and everything that follows.  For example:
-<programlisting>
-  data T a b
-</programlisting>
-	    In a <emphasis>source</emphasis> program
-	  this would declare TA to have no constructors (a GHC extension: see <xref linkend="nullary-types"/>),
-	  but in an hi-boot file it means "I don't know or care what the constructors are".
-	    This is the most common form of data type declaration, because it's easy to get right.
-	  You <emphasis>can</emphasis> also write out the constructors but, if you do so, you must write
-	  it out precisely as in its real definition.</para>
-	  <para>
-	    If you do not write out the constructors, you may need to give a kind 
-	    annotation (<xref linkend="sec-kinding"/>), to tell
-	    GHC the kind of the type variable, if it is not "*".  (In source files, this is worked out
-	    from the way the type variable is used in the constructors.)  For example:
-<programlisting>
-  data R (x :: * -&#62; *) y
-</programlisting>
-</para></listitem>
-<listitem><para> Class declarations is exactly as in Haskell, except that you may not put
-default method declarations.  You can also omit all the class methods entirely.
-</para></listitem>
-<listitem><para> Do not include instance declarations. There is a complication to do with
-how the dictionary functions are named.  It may well work, but it's not a well-tested feature.
- </para></listitem>
-</itemizedlist>
-</para>
-    </sect2>
-
-
-    <sect2 id="using-make">
-      <title>Using <command>make</command></title>
-
-      <indexterm><primary><literal>make</literal></primary></indexterm>
-
-      <para>It is reasonably straightforward to set up a
-      <filename>Makefile</filename> to use with GHC, assuming you name
-      your source files the same as your modules.  Thus:</para>
-
-<programlisting>
-HC      = ghc
-HC_OPTS = -cpp $(EXTRA_HC_OPTS)
-
-SRCS = Main.lhs Foo.lhs Bar.lhs
-OBJS = Main.o   Foo.o   Bar.o
-
-.SUFFIXES : .o .hs .hi .lhs .hc .s
-
-cool_pgm : $(OBJS)
-        rm -f $@
-        $(HC) -o $@ $(HC_OPTS) $(OBJS)
-
-# Standard suffix rules
-.o.hi:
-        @:
-
-.lhs.o:
-        $(HC) -c $&#60; $(HC_OPTS)
-
-.hs.o:
-        $(HC) -c $&#60; $(HC_OPTS)
-
-.o-boot.hi-boot:
-        @:
-
-.lhs-boot.o-boot:
-        $(HC) -c $&#60; $(HC_OPTS)
-
-.hs-boot.o-boot:
-        $(HC) -c $&#60; $(HC_OPTS)
-
-# Inter-module dependencies
-Foo.o Foo.hc Foo.s    : Baz.hi          # Foo imports Baz
-Main.o Main.hc Main.s : Foo.hi Baz.hi   # Main imports Foo and Baz
-</programlisting>
-
-      <para>(Sophisticated <command>make</command> variants may
-      achieve some of the above more elegantly.  Notably,
-      <command>gmake</command>'s pattern rules let you write the more
-      comprehensible:</para>
-
-<programlisting>
-%.o : %.lhs
-        $(HC) -c $&#60; $(HC_OPTS)
-</programlisting>
-
-      <para>What we've shown should work with any
-      <command>make</command>.)</para>
-
-      <para>Note the cheesy <literal>.o.hi</literal> rule: It records
-      the dependency of the interface (<filename>.hi</filename>) file
-      on the source.  The rule says a <filename>.hi</filename> file
-      can be made from a <filename>.o</filename> file by
-      doing&hellip;nothing.  Which is true.</para>
-      <para> Note that the suffix rules are all repeated twice, once
-      for normal Haskell source files, and once for <filename>hs-boot</filename>
-      files (see <xref linkend="mutual-recursion"/>).</para>
-
-      <para>Note also the inter-module dependencies at the end of the
-      Makefile, which take the form
-
-<programlisting>
-Foo.o Foo.hc Foo.s    : Baz.hi          # Foo imports Baz
-</programlisting>
-
-      They tell <command>make</command> that if any of
-      <literal>Foo.o</literal>, <literal>Foo.hc</literal> or
-      <literal>Foo.s</literal> have an earlier modification date than
-      <literal>Baz.hi</literal>, then the out-of-date file must be
-      brought up to date.  To bring it up to date,
-      <literal>make</literal> looks for a rule to do so; one of the
-      preceding suffix rules does the job nicely.  These dependencies
-      can be generated automatically by <command>ghc</command>; see 
-      <xref linkend="sec-makefile-dependencies"/></para>
-
- </sect2>
-
-      <sect2 id="sec-makefile-dependencies">
-	<title>Dependency generation</title>
-	<indexterm><primary>dependencies in Makefiles</primary></indexterm>
-	<indexterm><primary>Makefile dependencies</primary></indexterm>
-
-	<para>Putting inter-dependencies of the form <literal>Foo.o :
-        Bar.hi</literal> into your <filename>Makefile</filename> by
-        hand is rather error-prone.  Don't worry, GHC has support for
-        automatically generating the required dependencies.  Add the
-        following to your <filename>Makefile</filename>:</para>
-
-<programlisting>
-depend :
-        ghc -M $(HC_OPTS) $(SRCS)
-</programlisting>
-
-	<para>Now, before you start compiling, and any time you change
-        the <literal>imports</literal> in your program, do
-        <command>make depend</command> before you do <command>make
-        cool&lowbar;pgm</command>.  The command <command>ghc -M</command> will
-        append the needed dependencies to your
-        <filename>Makefile</filename>.</para>
-
-	<para>In general, <command>ghc -M Foo</command> does the following.
-	For each module <literal>M</literal> in the set 
-	<literal>Foo</literal> plus all its imports (transitively),
-	it adds to the Makefile:
-	<itemizedlist>
-	<listitem><para>A line recording the dependence of the object file on the source file.
-<programlisting>
-M.o : M.hs
-</programlisting>
-(or <literal>M.lhs</literal> if that is the filename you used).
-       </para></listitem>
-       <listitem><para> For each import declaration <literal>import X</literal> in <literal>M</literal>,
-       a line recording the dependence of <literal>M</literal> on <literal>X</literal>:
-<programlisting>
-M.o : X.hi
-</programlisting></para></listitem>
-       <listitem><para> For each import declaration <literal>import {-# SOURCE #-} X</literal> in <literal>M</literal>,
-       a line recording the dependence of <literal>M</literal> on <literal>X</literal>:
-<programlisting>
-M.o : X.hi-boot
-</programlisting>
-       (See <xref linkend="mutual-recursion"/> for details of
-       <literal>hi-boot</literal> style interface files.)
-      </para></listitem>
-        </itemizedlist> 
-	If <literal>M</literal> imports multiple modules, then there will
-       be multiple lines with <filename>M.o</filename> as the
-       target.</para>
-       <para>There is no need to list all of the source files as arguments to the <command>ghc -M</command> command;
-       <command>ghc</command> traces the dependencies, just like <command>ghc --make</command>
-       (a new feature in GHC 6.4).</para>
-
-    <para>Note that <literal>ghc -M</literal> needs to find a <emphasis>source
-	file</emphasis> for each module in the dependency graph, so that it can
-      parse the import declarations and follow dependencies.  Any pre-compiled
-      modules without source files must therefore belong to a
-      package<footnote><para>This is a change in behaviour relative to 6.2 and
-	earlier.</para>
-      </footnote>.</para>
-
-        <para>By default, <command>ghc -M</command> generates all the
-        dependencies, and then concatenates them onto the end of
-        <filename>makefile</filename> (or
-        <filename>Makefile</filename> if <filename>makefile</filename>
-        doesn't exist) bracketed by the lines "<literal>&num; DO NOT
-        DELETE: Beginning of Haskell dependencies</literal>" and
-        "<literal>&num; DO NOT DELETE: End of Haskell
-        dependencies</literal>".  If these lines already exist in the
-        <filename>makefile</filename>, then the old dependencies are
-        deleted first.</para>
-
-	<para>Don't forget to use the same <option>-package</option>
-	options on the <literal>ghc -M</literal> command line as you
-	would when compiling; this enables the dependency generator to
-	locate any imported modules that come from packages.  The
-	package modules won't be included in the dependencies
-	generated, though (but see the
-	<option>&ndash;&ndash;include-pkg-deps</option> option below).</para>
-
-	<para>The dependency generation phase of GHC can take some
-        additional options, which you may find useful.  For historical
-        reasons, each option passed to the dependency generator from
-        the GHC command line must be preceded by
-        <literal>-optdep</literal>.  For example, to pass <literal>-f
-        .depend</literal> to the dependency generator, you say
-
-<screen>
-ghc -M -optdep-f -optdep.depend ...
-</screen>
-
-	The options which affect dependency generation are:</para>
-
-	<variablelist>
-	  <varlistentry>
-	    <term><option>-w</option></term>
-	    <listitem>
-	      <para>Turn off warnings about interface file shadowing.</para>
-	    </listitem>
-	  </varlistentry>
-
-	  <varlistentry>
-	    <term><option>-v2</option></term>
-	    <listitem>
-	      <para>Print a full list of the module depenencies to stdout.
-	            (This is the standard verbosity flag, so the list will
-	      also be displayed with <option>-v3</option> and
-	      <option>-v4</option>;
-	      <xref linkend ="options-help"/>.)</para>
-	    </listitem>
-	  </varlistentry>
-
-	  <varlistentry>
-	    <term><option>-f</option> <replaceable>file</replaceable></term>
-	    <listitem>
-	      <para>Use <replaceable>file</replaceable> as the makefile,
-              rather than <filename>makefile</filename> or
-              <filename>Makefile</filename>.  If
-              <replaceable>file</replaceable> doesn't exist,
-              <command>mkdependHS</command> creates it.  We often use
-              <option>-f .depend</option> to put the dependencies in
-              <filename>.depend</filename> and then
-              <command>include</command> the file
-              <filename>.depend</filename> into
-              <filename>Makefile</filename>.</para>
-	    </listitem>
-	  </varlistentry>
-
-<!-- Retired with the move away from 'mkdependHS'.
-	  <varlistentry>
-	    <term><option>-o &lt;osuf&gt;</option></term>
-	    <listitem>
-	      <para>Use <filename>.&lt;osuf&gt;</filename> as the
-              "target file" suffix ( default: <literal>o</literal>).
-              Multiple <option>-o</option> flags are permitted
-              (GHC2.05 onwards).  Thus "<option>-o hc -o o</option>"
-              will generate dependencies for <filename>.hc</filename>
-              and <filename>.o</filename> files.</para>
-	    </listitem>
-	  </varlistentry>
--->
-	  <varlistentry>
-	    <term><option>-s &lt;suf&gt;</option></term>
-	    <listitem>
-	      <para>Make extra dependencies that declare that files
-              with suffix
-              <filename>.&lt;suf&gt;&lowbar;&lt;osuf&gt;</filename>
-              depend on interface files with suffix
-              <filename>.&lt;suf&gt;&lowbar;hi</filename>, or (for
-              <literal>&lcub;-&num; SOURCE &num;-&rcub;</literal>
-              imports) on <filename>.hi-boot</filename>.  Multiple
-              <option>-s</option> flags are permitted.  For example,
-              <option>-o hc -s a -s b</option> will make dependencies
-              for <filename>.hc</filename> on
-              <filename>.hi</filename>,
-              <filename>.a&lowbar;hc</filename> on
-              <filename>.a&lowbar;hi</filename>, and
-              <filename>.b&lowbar;hc</filename> on
-              <filename>.b&lowbar;hi</filename>.  (Useful in
-              conjunction with NoFib "ways".)</para>
-	    </listitem>
-	  </varlistentry>
-
-	  <varlistentry>
-	    <term><option>&ndash;&ndash;exclude-module=&lt;file&gt;</option></term>
-	    <listitem>
-	      <para>Regard <filename>&lt;file&gt;</filename> as
-              "stable"; i.e., exclude it from having dependencies on
-              it.</para>
-	    </listitem>
-	  </varlistentry>
-
-	  <varlistentry>
-	    <term><option>-x</option></term>
-	    <listitem>
-	      <para>same as <option>&ndash;&ndash;exclude-module</option></para>
-	    </listitem>
-	  </varlistentry>
-
-	  <varlistentry>
-	    <term><option>&ndash;&ndash;exclude-directory=&lt;dirs&gt;</option></term>
-	    <listitem>
-	      <para>Regard the colon-separated list of directories
-              <filename>&lt;dirs&gt;</filename> as containing stable,
-              don't generate any dependencies on modules
-              therein.</para>
-	    </listitem>
-	  </varlistentry>
-
-	  <varlistentry>
-	    <term><option>&ndash;&ndash;include-module=&lt;file&gt;</option></term>
-	    <listitem>
-	      <para>Regard <filename>&lt;file&gt;</filename> as not
-              "stable"; i.e., generate dependencies on it (if
-              any). This option is normally used in conjunction with
-              the <option>&ndash;&ndash;exclude-directory</option> option.</para>
-	    </listitem>
-	  </varlistentry>
-
-	  <varlistentry>
-	    <term><option>&ndash;&ndash;include-pkg-deps</option></term>
-	    <listitem>
-	      <para>Regard modules imported from packages as unstable,
-              i.e., generate dependencies on any imported package modules
-              (including <literal>Prelude</literal>, and all other
-              standard Haskell libraries).  Dependencies are not traced
-	      recursively into packages; dependencies are only generated for
-	      home-package modules on external-package modules directly imported
-	      by the home package module.
-	      This option is normally
-              only used by the various system libraries.</para>
-	    </listitem>
-	  </varlistentry>
-	</variablelist>
-
-    </sect2>
-
-    <sect2 id="orphan-modules">
-      <title>Orphan modules and instance declarations</title>
-
-<para> Haskell specifies that when compiling module M, any instance
-declaration in any module "below" M is visible.  (Module A is "below"
-M if A is imported directly by M, or if A is below a module that M imports directly.)
-In principle, GHC must therefore read the interface files of every module below M,
-just in case they contain an instance declaration that matters to M.  This would
-be a disaster in practice, so GHC tries to be clever. </para>
-
-<para>In particular, if an instance declaration is in the same module as the definition
-of any type or class mentioned in the head of the instance declaration, then
-GHC has to visit that interface file anyway.  Example:</para>
-<programlisting>
-  module A where
-    instance C a =&gt; D (T a) where ...
-    data T a = ...
-</programlisting>
-<para> The instance declaration is only relevant if the type T is in use, and if
-so, GHC will have visited A's interface file to find T's definition. </para>
-
-<para> The only problem comes when a module contains an instance declaration
-and GHC has no other reason for visiting the module.  Example:
-<programlisting>
-  module Orphan where
-    instance C a =&gt; D (T a) where ...
-    class C a where ...
-</programlisting>
-Here, neither D nor T is declared in module Orphan.
-We call such modules ``orphan modules'',
-defined thus:</para>
-<itemizedlist>
-  <listitem> <para> An <emphasis>orphan module</emphasis>
-  <indexterm><primary>orphan module</primary></indexterm>
-  contains at least one <emphasis>orphan instance</emphasis> or at
-  least one <emphasis>orphan rule</emphasis>.</para> </listitem>
-
-  <listitem><para> An instance declaration in a module M is an <emphasis>orphan instance</emphasis> if
-  <indexterm><primary>orphan instance</primary></indexterm>
-  none of the type constructors
-  or classes mentioned in the instance head (the part after the ``<literal>=&gt;</literal>'') are declared
-  in M.</para>
-
-  <para> Only the instance head counts.  In the example above, it is not good enough for C's declaration
-  to be in module A; it must be the declaration of D or T.</para>
-  </listitem>
-
-  <listitem><para> A rewrite rule in a module M is an <emphasis>orphan rule</emphasis>
-  <indexterm><primary>orphan rule</primary></indexterm>
-  if none of the variables, type constructors,
-  or classes that are free in the left hand side of the rule are declared in M.
-  </para> </listitem>
- </itemizedlist>
-
-
-<para> GHC identifies orphan modules, and visits the interface file of
-every orphan module below the module being compiled.  This is usually
-wasted work, but there is no avoiding it.  You should therefore do
-your best to have as few orphan modules as possible.
-
-</para>
-
-<para> You can identify an orphan module by looking in its interface
-file, <filename>M.hi</filename>, using the
-<option>--show-iface</option>.  If there is a ``!'' on the first line,
-GHC considers it an orphan module.
-</para>
-</sect2>
-
-  </sect1>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter" "sect1") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/sooner.xml b/ghc/docs/users_guide/sooner.xml
deleted file mode 100644
index 1aba5d1af0..0000000000
--- a/ghc/docs/users_guide/sooner.xml
+++ /dev/null
@@ -1,602 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<chapter id="sooner-faster-quicker">
-<title>Advice on: sooner, faster, smaller, thriftier</title>
-
-<para>Please advise us of other &ldquo;helpful hints&rdquo; that
-should go here!</para>
-
-<sect1 id="sooner">
-<title>Sooner: producing a program more quickly
-</title>
-
-<indexterm><primary>compiling faster</primary></indexterm>
-<indexterm><primary>faster compiling</primary></indexterm>
-
-    <variablelist>
-      <varlistentry>
-	<term>Don't use <option>-O</option> or (especially) <option>-O2</option>:</term>
-	<listitem>
-	  <para>By using them, you are telling GHC that you are
-          willing to suffer longer compilation times for
-          better-quality code.</para>
-
-	  <para>GHC is surprisingly zippy for normal compilations
-	  without <option>-O</option>!</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Use more memory:</term>
-	<listitem>
-	  <para>Within reason, more memory for heap space means less
-          garbage collection for GHC, which means less compilation
-          time.  If you use the <option>-Rghc-timing</option> option,
-          you'll get a garbage-collector report.  (Again, you can use
-          the cheap-and-nasty <option>+RTS -Sstderr -RTS</option>
-          option to send the GC stats straight to standard
-          error.)</para>
-
-	  <para>If it says you're using more than 20&percnt; of total
-          time in garbage collecting, then more memory would
-          help.</para>
-
-	  <para>If the heap size is approaching the maximum (64M by
-          default), and you have lots of memory, try increasing the
-          maximum with the
-          <option>-M&lt;size&gt;</option><indexterm><primary>-M&lt;size&gt;
-          option</primary></indexterm> option, e.g.: <command>ghc -c
-          -O -M1024m Foo.hs</command>.</para>
-
-	  <para>Increasing the default allocation area size used by
-          the compiler's RTS might also help: use the
-          <option>-A&lt;size&gt;</option><indexterm><primary>-A&lt;size&gt;
-          option</primary></indexterm> option.</para>
-
-	  <para>If GHC persists in being a bad memory citizen, please
-          report it as a bug.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Don't use too much memory!</term>
-	<listitem>
-	  <para>As soon as GHC plus its &ldquo;fellow citizens&rdquo;
-          (other processes on your machine) start using more than the
-          <emphasis>real memory</emphasis> on your machine, and the
-          machine starts &ldquo;thrashing,&rdquo; <emphasis>the party
-          is over</emphasis>.  Compile times will be worse than
-          terrible!  Use something like the csh-builtin
-          <command>time</command> command to get a report on how many
-          page faults you're getting.</para>
-
-	  <para>If you don't know what virtual memory, thrashing, and
-          page faults are, or you don't know the memory configuration
-          of your machine, <emphasis>don't</emphasis> try to be clever
-          about memory use: you'll just make your life a misery (and
-          for other people, too, probably).</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Try to use local disks when linking:</term>
-	<listitem>
-	  <para>Because Haskell objects and libraries tend to be
-          large, it can take many real seconds to slurp the bits
-          to/from a remote filesystem.</para>
-
-	  <para>It would be quite sensible to
-          <emphasis>compile</emphasis> on a fast machine using
-          remotely-mounted disks; then <emphasis>link</emphasis> on a
-          slow machine that had your disks directly mounted.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Don't derive/use <function>Read</function> unnecessarily:</term>
-	<listitem>
-	  <para>It's ugly and slow.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>GHC compiles some program constructs slowly:</term>
-	<listitem>
-	  <para>Deeply-nested list comprehensions seem to be one such;
-          in the past, very large constant tables were bad,
-          too.</para>
-
-	  <para>We'd rather you reported such behaviour as a bug, so
-          that we can try to correct it.</para>
-
-	  <para>The part of the compiler that is occasionally prone to
-          wandering off for a long time is the strictness analyser.
-          You can turn this off individually with
-          <option>-fno-strictness</option>.
-          <indexterm><primary>-fno-strictness
-          anti-option</primary></indexterm></para>
-	  
-	  <para>To figure out which part of the compiler is badly
-          behaved, the
-          <option>-v2</option><indexterm><primary><option>-v</option></primary>
-          </indexterm> option is your friend.</para>
-
-	  <para>If your module has big wads of constant data, GHC may
-          produce a huge basic block that will cause the native-code
-          generator's register allocator to founder.  Bring on
-          <option>-fvia-C</option><indexterm><primary>-fvia-C
-          option</primary></indexterm> (not that GCC will be that
-          quick about it, either).</para>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term>Explicit <literal>import</literal> declarations:</term>
-	<listitem>
-	  <para>Instead of saying <literal>import Foo</literal>, say
-          <literal>import Foo (...stuff I want...)</literal> You can
-          get GHC to tell you the minimal set of required imports by
-          using the <option>-ddump-minimal-imports</option> option
-          (see <xref linkend="hi-options"/>).</para>
-
-	  <para>Truthfully, the reduction on compilation time will be
-          very small.  However, judicious use of
-          <literal>import</literal> declarations can make a program
-          easier to understand, so it may be a good idea
-          anyway.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-  </sect1>
-
-  <sect1 id="faster">
-    <title>Faster: producing a program that runs quicker</title>
-
-    <indexterm><primary>faster programs, how to produce</primary></indexterm>
-
-    <para>The key tool to use in making your Haskell program run
-    faster are GHC's profiling facilities, described separately in
-    <xref linkend="profiling"/>.  There is <emphasis>no
-    substitute</emphasis> for finding where your program's time/space
-    is <emphasis>really</emphasis> going, as opposed to where you
-    imagine it is going.</para>
-
-    <para>Another point to bear in mind: By far the best way to
-    improve a program's performance <emphasis>dramatically</emphasis>
-    is to use better algorithms.  Once profiling has thrown the
-    spotlight on the guilty time-consumer(s), it may be better to
-    re-think your program than to try all the tweaks listed below.</para>
-
-    <para>Another extremely efficient way to make your program snappy
-    is to use library code that has been Seriously Tuned By Someone
-    Else.  You <emphasis>might</emphasis> be able to write a better
-    quicksort than the one in <literal>Data.List</literal>, but it
-    will take you much longer than typing <literal>import
-    Data.List</literal>.</para>
-
-    <para>Please report any overly-slow GHC-compiled programs.  Since
-    GHC doesn't have any credible competition in the performance
-    department these days it's hard to say what overly-slow means, so
-    just use your judgement!  Of course, if a GHC compiled program
-    runs slower than the same program compiled with NHC or Hugs, then
-    it's definitely a bug.</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>Optimise, using <option>-O</option> or <option>-O2</option>:</term>
-	<listitem>
-	  <para>This is the most basic way to make your program go
-          faster.  Compilation time will be slower, especially with
-          <option>-O2</option>.</para>
-
-	  <para>At present, <option>-O2</option> is nearly
-	  indistinguishable from <option>-O</option>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Compile via C and crank up GCC:</term>
-	<listitem>
-	  <para>The native code-generator is designed to be quick, not
-          mind-bogglingly clever.  Better to let GCC have a go, as it
-          tries much harder on register allocation, etc.</para>
-
-	  <para>At the moment, if you turn on <option>-O</option> you
-          get GCC instead.  This may change in the future.</para>
-
-	  <para>So, when we want very fast code, we use: <option>-O
-	  -fvia-C</option>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Overloaded functions are not your friend:</term>
-	<listitem>
-	  <para>Haskell's overloading (using type classes) is elegant,
-          neat, etc., etc., but it is death to performance if left to
-          linger in an inner loop.  How can you squash it?</para>
-
-	  <variablelist>
-	    <varlistentry>
-	      <term>Give explicit type signatures:</term>
-	      <listitem>
-		<para>Signatures are the basic trick; putting them on
-                exported, top-level functions is good
-                software-engineering practice, anyway.  (Tip: using
-                <option>-fwarn-missing-signatures</option><indexterm><primary>-fwarn-missing-signatures
-                option</primary></indexterm> can help enforce good
-                signature-practice).</para>
-
-		<para>The automatic specialisation of overloaded
-                functions (with <option>-O</option>) should take care
-                of overloaded local and/or unexported functions.</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>Use <literal>SPECIALIZE</literal> pragmas:</term>
-	      <listitem>
-		<indexterm><primary>SPECIALIZE pragma</primary></indexterm>
-		<indexterm><primary>overloading, death to</primary></indexterm>
-
-		<para>Specialize the overloading on key functions in
-                your program.  See <xref linkend="specialize-pragma"/>
-                and <xref linkend="specialize-instance-pragma"/>.</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term>&ldquo;But how do I know where overloading is creeping in?&rdquo;:</term>
-	      <listitem>
-		<para>A low-tech way: grep (search) your interface
-                files for overloaded type signatures.  You can view
-                interface files using the
-                <option>--show-iface</option> option (see <xref
-                linkend="hi-options"/>).
-
-<programlisting>
-% ghc --show-iface Foo.hi | egrep '^[a-z].*::.*=&#62;'
-</programlisting>
-</para>
-	      </listitem>
-	    </varlistentry>
-	  </variablelist>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Strict functions are your dear friends:</term>
-	<listitem>
-	  <para>and, among other things, lazy pattern-matching is your
-	  enemy.</para>
-
-	  <para>(If you don't know what a &ldquo;strict
-          function&rdquo; is, please consult a functional-programming
-          textbook.  A sentence or two of explanation here probably
-          would not do much good.)</para>
-
-	  <para>Consider these two code fragments:
-
-<programlisting>
-f (Wibble x y) =  ... # strict
-
-f arg = let { (Wibble x y) = arg } in ... # lazy
-</programlisting>
-
-           The former will result in far better code.</para>
-
-	  <para>A less contrived example shows the use of
-          <literal>cases</literal> instead of <literal>lets</literal>
-          to get stricter code (a good thing):
-
-<programlisting>
-f (Wibble x y)  # beautiful but slow
-  = let
-        (a1, b1, c1) = unpackFoo x
-        (a2, b2, c2) = unpackFoo y
-    in ...
-
-f (Wibble x y)  # ugly, and proud of it
-  = case (unpackFoo x) of { (a1, b1, c1) -&#62;
-    case (unpackFoo y) of { (a2, b2, c2) -&#62;
-    ...
-    }}
-</programlisting>
-
-          </para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>GHC loves single-constructor data-types:</term>
-	<listitem>
-	  <para>It's all the better if a function is strict in a
-          single-constructor type (a type with only one
-          data-constructor; for example, tuples are single-constructor
-          types).</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Newtypes are better than datatypes:</term>
-	<listitem>
-	  <para>If your datatype has a single constructor with a
-          single field, use a <literal>newtype</literal> declaration
-          instead of a <literal>data</literal> declaration.  The
-          <literal>newtype</literal> will be optimised away in most
-          cases.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>&ldquo;How do I find out a function's strictness?&rdquo;</term>
-	<listitem>
-	  <para>Don't guess&mdash;look it up.</para>
-
-	  <para>Look for your function in the interface file, then for
-          the third field in the pragma; it should say
-          <literal>&lowbar;&lowbar;S &lt;string&gt;</literal>.  The
-          <literal>&lt;string&gt;</literal> gives the strictness of
-          the function's arguments.  <function>L</function> is lazy
-          (bad), <function>S</function> and <function>E</function> are
-          strict (good), <function>P</function> is
-          &ldquo;primitive&rdquo; (good), <function>U(...)</function>
-          is strict and &ldquo;unpackable&rdquo; (very good), and
-          <function>A</function> is absent (very good).</para>
-
-	  <para>For an &ldquo;unpackable&rdquo;
-          <function>U(...)</function> argument, the info inside tells
-          the strictness of its components.  So, if the argument is a
-          pair, and it says <function>U(AU(LSS))</function>, that
-          means &ldquo;the first component of the pair isn't used; the
-          second component is itself unpackable, with three components
-          (lazy in the first, strict in the second \&#38;
-          third).&rdquo;</para>
-
-	  <para>If the function isn't exported, just compile with the
-          extra flag <option>-ddump-simpl</option>; next to the
-          signature for any binder, it will print the self-same
-          pragmatic information as would be put in an interface file.
-          (Besides, Core syntax is fun to look at!)</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Force key functions to be <literal>INLINE</literal>d (esp. monads):</term>
-	<listitem>
-	  <para>Placing <literal>INLINE</literal> pragmas on certain
-          functions that are used a lot can have a dramatic effect.
-          See <xref linkend="inline-pragma"/>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Explicit <literal>export</literal> list:</term>
-	<listitem>
-	  <para>If you do not have an explicit export list in a
-          module, GHC must assume that everything in that module will
-          be exported.  This has various pessimising effects.  For
-          example, if a bit of code is actually
-          <emphasis>unused</emphasis> (perhaps because of unfolding
-          effects), GHC will not be able to throw it away, because it
-          is exported and some other module may be relying on its
-          existence.</para>
-
-	  <para>GHC can be quite a bit more aggressive with pieces of
-          code if it knows they are not exported.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Look at the Core syntax!</term>
-	<listitem>
-	  <para>(The form in which GHC manipulates your code.)  Just
-          run your compilation with <option>-ddump-simpl</option>
-          (don't forget the <option>-O</option>).</para>
-
-	  <para>If profiling has pointed the finger at particular
-          functions, look at their Core code.  <literal>lets</literal>
-          are bad, <literal>cases</literal> are good, dictionaries
-          (<literal>d.&lt;Class&gt;.&lt;Unique&gt;</literal>) &lsqb;or
-          anything overloading-ish&rsqb; are bad, nested lambdas are
-          bad, explicit data constructors are good, primitive
-          operations (e.g., <literal>eqInt&num;</literal>) are
-          good,&hellip;</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Use strictness annotations:</term>
-	<listitem>
-	  <para>Putting a strictness annotation ('!') on a constructor
-	  field helps in two ways: it adds strictness to the program,
-	  which gives the strictness analyser more to work with, and
-	  it might help to reduce space leaks.</para>
-
-	  <para>It can also help in a third way: when used with
-	  <option>-funbox-strict-fields</option> (see <xref
-	  linkend="options-f"/>), a strict field can be unpacked or
-	  unboxed in the constructor, and one or more levels of
-	  indirection may be removed.  Unpacking only happens for
-	  single-constructor datatypes (<literal>Int</literal> is a
-	  good candidate, for example).</para>
-
-	  <para>Using <option>-funbox-strict-fields</option> is only
-	  really a good idea in conjunction with <option>-O</option>,
-	  because otherwise the extra packing and unpacking won't be
-	  optimised away.  In fact, it is possible that
-	  <option>-funbox-strict-fields</option> may worsen
-	  performance even <emphasis>with</emphasis>
-	  <option>-O</option>, but this is unlikely (let us know if it
-	  happens to you).</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Use unboxed types (a GHC extension):</term>
-	<listitem>
-	  <para>When you are <emphasis>really</emphasis> desperate for
-          speed, and you want to get right down to the &ldquo;raw
-          bits.&rdquo; Please see <xref linkend="glasgow-unboxed"/> for
-          some information about using unboxed types.</para>
-
-	  <para>Before resorting to explicit unboxed types, try using
-	  strict constructor fields and
-	  <option>-funbox-strict-fields</option> first (see above).
-	  That way, your code stays portable.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Use <literal>foreign import</literal> (a GHC extension) to plug into fast libraries:</term>
-	<listitem>
-	  <para>This may take real work, but&hellip; There exist piles
-          of massively-tuned library code, and the best thing is not
-          to compete with it, but link with it.</para>
-
-	  <para><xref linkend="ffi"/> describes the foreign function
-	  interface.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Don't use <literal>Float</literal>s:</term>
-	<listitem>
-	  <para>If you're using <literal>Complex</literal>, definitely
-          use <literal>Complex Double</literal> rather than
-          <literal>Complex Float</literal> (the former is specialised
-          heavily, but the latter isn't).</para>
-
-	  <para><literal>Floats</literal> (probably 32-bits) are
-          almost always a bad idea, anyway, unless you Really Know
-          What You Are Doing.  Use <literal>Double</literal>s.
-          There's rarely a speed disadvantage&mdash;modern machines
-          will use the same floating-point unit for both.  With
-          <literal>Double</literal>s, you are much less likely to hang
-          yourself with numerical errors.</para>
-
-	  <para>One time when <literal>Float</literal> might be a good
-          idea is if you have a <emphasis>lot</emphasis> of them, say
-          a giant array of <literal>Float</literal>s.  They take up
-          half the space in the heap compared to
-          <literal>Doubles</literal>.  However, this isn't true on a
-          64-bit machine.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Use unboxed arrays (<literal>UArray</literal>)</term>
-	<listitem>
-	  <para>GHC supports arrays of unboxed elements, for several
-	  basic arithmetic element types including
-	  <literal>Int</literal> and <literal>Char</literal>: see the
-	  <literal>Data.Array.Unboxed</literal> library for details.
-	  These arrays are likely to be much faster than using
-	  standard Haskell 98 arrays from the
-	  <literal>Data.Array</literal> library.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>Use a bigger heap!</term>
-	<listitem>
-	  <para>If your program's GC stats
-          (<option>-S</option><indexterm><primary>-S RTS
-          option</primary></indexterm> RTS option) indicate that it's
-          doing lots of garbage-collection (say, more than 20&percnt;
-          of execution time), more memory might help&mdash;with the
-          <option>-M&lt;size&gt;</option><indexterm><primary>-M&lt;size&gt;
-          RTS option</primary></indexterm> or
-          <option>-A&lt;size&gt;</option><indexterm><primary>-A&lt;size&gt;
-          RTS option</primary></indexterm> RTS options (see <xref
-          linkend="rts-options-gc"/>).</para>
-
-	  <para>This is especially important if your program uses a
-	  lot of mutable arrays of pointers or mutable variables
-	  (i.e. <literal>STArray</literal>,
-	  <literal>IOArray</literal>, <literal>STRef</literal> and
-	  <literal>IORef</literal>, but not <literal>UArray</literal>,
-	  <literal>STUArray</literal> or <literal>IOUArray</literal>).
-	  GHC's garbage collector currently scans these objects on
-	  every collection, so your program won't benefit from
-	  generational GC in the normal way if you use lots of
-	  these.  Increasing the heap size to reduce the number of
-	  collections will probably help.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-</sect1>
-
-<sect1 id="smaller">
-<title>Smaller: producing a program that is smaller
-</title>
-
-<para>
-<indexterm><primary>smaller programs, how to produce</primary></indexterm>
-</para>
-
-<para>
-Decrease the &ldquo;go-for-it&rdquo; threshold for unfolding smallish
-expressions.  Give a
-<option>-funfolding-use-threshold0</option><indexterm><primary>-funfolding-use-threshold0
-option</primary></indexterm> option for the extreme case. (&ldquo;Only unfoldings with
-zero cost should proceed.&rdquo;)  Warning: except in certain specialised
-cases (like Happy parsers) this is likely to actually
-<emphasis>increase</emphasis> the size of your program, because unfolding
-generally enables extra simplifying optimisations to be performed.
-</para>
-
-<para>
-Avoid <function>Read</function>.
-</para>
-
-<para>
-Use <literal>strip</literal> on your executables.
-</para>
-
-</sect1>
-
-<sect1 id="thriftier">
-<title>Thriftier: producing a program that gobbles less heap space
-</title>
-
-<para>
-<indexterm><primary>memory, using less heap</primary></indexterm>
-<indexterm><primary>space-leaks, avoiding</primary></indexterm>
-<indexterm><primary>heap space, using less</primary></indexterm>
-</para>
-
-<para>
-&ldquo;I think I have a space leak&hellip;&rdquo; Re-run your program
-with <option>+RTS -Sstderr</option>, and remove all doubt!  (You'll
-see the heap usage get bigger and bigger&hellip;)
-&lsqb;Hmmm&hellip;this might be even easier with the
-<option>-G1</option> RTS option; so&hellip; <command>./a.out +RTS
--Sstderr -G1</command>...]
-<indexterm><primary>-G RTS option</primary></indexterm>
-<indexterm><primary>-Sstderr RTS option</primary></indexterm>
-</para>
-
-<para>
-Once again, the profiling facilities (<xref linkend="profiling"/>) are
-the basic tool for demystifying the space behaviour of your program.
-</para>
-
-<para>
-Strict functions are good for space usage, as they are for time, as
-discussed in the previous section.  Strict functions get right down to
-business, rather than filling up the heap with closures (the system's
-notes to itself about how to evaluate something, should it eventually
-be required).
-</para>
-
-</sect1>
-
-</chapter>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/ug-book.xml.in b/ghc/docs/users_guide/ug-book.xml.in
deleted file mode 100644
index c5710f1d77..0000000000
--- a/ghc/docs/users_guide/ug-book.xml.in
+++ /dev/null
@@ -1,30 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<bookinfo>
-<title>@ProjectName@ User's Guide, Version @ProjectVersion@</title>
-<author><othername>The GHC Team</othername></author>
-<address>
-<email>glasgow-haskell-&lcub;bugs,users&rcub;-request@haskell.org</email>
-</address>
-</bookinfo>
-
-&license;
-&intro;
-&installing;
-&ghci;
-&using;
-&prof;
-&sooner;
-&lang-features;
-&ffi-chap;
-&wrong;
-&utils;
-&win32-dll;
-&bugs;
-
-<index/>
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/ug-ent.xml b/ghc/docs/users_guide/ug-ent.xml
deleted file mode 100644
index cad75ab499..0000000000
--- a/ghc/docs/users_guide/ug-ent.xml
+++ /dev/null
@@ -1,23 +0,0 @@
-<!ENTITY ghci           SYSTEM "ghci.xml">
-<!ENTITY flags          SYSTEM "flags.xml">
-<!ENTITY license        SYSTEM "license.xml">
-<!ENTITY intro          SYSTEM "intro.xml" >
-<!ENTITY relnotes       SYSTEM "6.0-notes.xml" >
-<!ENTITY installing     SYSTEM "installing.xml" >
-<!ENTITY using          SYSTEM "using.xml" >
-<!ENTITY runtime        SYSTEM "runtime_control.xml" >
-<!ENTITY prof           SYSTEM "profiling.xml" >
-<!ENTITY debug          SYSTEM "debugging.xml" >
-<!ENTITY sooner         SYSTEM "sooner.xml" >
-<!ENTITY lang-features  SYSTEM "lang.xml" >
-<!ENTITY glasgowexts    SYSTEM "glasgow_exts.xml" >
-<!ENTITY packages       SYSTEM "packages.xml" >
-<!ENTITY parallel       SYSTEM "parallel.xml" >
-<!ENTITY phases         SYSTEM "phases.xml" >
-<!ENTITY primitives     SYSTEM "primitives.xml" >
-<!ENTITY separate       SYSTEM "separate_compilation.xml" >
-<!ENTITY bugs           SYSTEM "bugs.xml" >
-<!ENTITY wrong          SYSTEM "gone_wrong.xml" >
-<!ENTITY utils          SYSTEM "utils.xml" >
-<!ENTITY win32-dll      SYSTEM "win32-dlls.xml">
-<!ENTITY ffi-chap       SYSTEM "ffi-chap.xml">
diff --git a/ghc/docs/users_guide/users_guide.xml b/ghc/docs/users_guide/users_guide.xml
deleted file mode 100644
index 740e729b72..0000000000
--- a/ghc/docs/users_guide/users_guide.xml
+++ /dev/null
@@ -1,11 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
-   "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
-<!ENTITY % ug-ent SYSTEM "ug-ent.xml">
-%ug-ent;
-<!ENTITY ug-book SYSTEM "ug-book.xml">
-]>
-
-<book id="users-guide">
-&ug-book;
-</book>
diff --git a/ghc/docs/users_guide/using.xml b/ghc/docs/users_guide/using.xml
deleted file mode 100644
index 8cbcd35fca..0000000000
--- a/ghc/docs/users_guide/using.xml
+++ /dev/null
@@ -1,1976 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<chapter id="using-ghc">
-  <title>Using GHC</title>
-
-  <indexterm><primary>GHC, using</primary></indexterm>
-  <indexterm><primary>using GHC</primary></indexterm>
-
-  <sect1>
-    <title>Options overview</title>
-    
-    <para>GHC's behaviour is controlled by
-    <firstterm>options</firstterm>, which for historical reasons are
-    also sometimes referred to as command-line flags or arguments.
-    Options can be specified in three ways:</para>
-
-    <sect2>
-      <title>command-line arguments</title>
-      
-      <indexterm><primary>structure, command-line</primary></indexterm>
-      <indexterm><primary>command-line</primary><secondary>arguments</secondary></indexterm>
-      <indexterm><primary>arguments</primary><secondary>command-line</secondary></indexterm>
-      
-      <para>An invocation of GHC takes the following form:</para>
-
-<screen>
-ghc [argument...]
-</screen>
-
-      <para>command-line arguments are either options or file names.</para>
-
-      <para>command-line options begin with <literal>-</literal>.
-      They may <emphasis>not</emphasis> be grouped:
-      <option>-vO</option> is different from <option>-v -O</option>.
-      Options need not precede filenames: e.g., <literal>ghc *.o -o
-      foo</literal>.  All options are processed and then applied to
-      all files; you cannot, for example, invoke <literal>ghc -c -O1
-      Foo.hs -O2 Bar.hs</literal> to apply different optimisation
-      levels to the files <filename>Foo.hs</filename> and
-      <filename>Bar.hs</filename>.</para>
-    </sect2>
-
-    <sect2 id="source-file-options">
-      <title>command line options in source files</title>
-    
-      <indexterm><primary>source-file options</primary></indexterm>
-
-      <para>Sometimes it is useful to make the connection between a
-      source file and the command-line options it requires quite
-      tight. For instance, if a Haskell source file uses GHC
-      extensions, it will always need to be compiled with the
-      <option>-fglasgow-exts</option> option.  Rather than maintaining
-      the list of per-file options in a <filename>Makefile</filename>,
-      it is possible to do this directly in the source file using the
-      <literal>OPTIONS_GHC</literal> pragma <indexterm><primary>OPTIONS_GHC
-      pragma</primary></indexterm>:</para>
-
-<programlisting>
-{-# OPTIONS_GHC -fglasgow-exts #-}
-module X where
-...
-</programlisting>
-      
-      <para><literal>OPTIONS_GHC</literal> pragmas are only looked for at
-      the top of your source files, upto the first
-      (non-literate,non-empty) line not containing
-      <literal>OPTIONS_GHC</literal>. Multiple <literal>OPTIONS_GHC</literal>
-      pragmas are recognised.  Do not put comments before, or on the same line
-	as, the <literal>OPTIONS_GHC</literal> pragma.</para>
-
-      <para>Note that your command shell does not
-      get to the source file options, they are just included literally
-      in the array of command-line arguments the compiler
-      maintains internally, so you'll be desperately disappointed if
-      you try to glob etc. inside <literal>OPTIONS_GHC</literal>.</para>
-
-      <para>NOTE: the contents of OPTIONS_GHC are prepended to the
-      command-line options, so you <emphasis>do</emphasis> have the
-      ability to override OPTIONS_GHC settings via the command
-      line.</para>
-
-      <para>It is not recommended to move all the contents of your
-      Makefiles into your source files, but in some circumstances, the
-      <literal>OPTIONS_GHC</literal> pragma is the Right Thing. (If you
-      use <option>-keep-hc-file-too</option> and have OPTION flags in
-      your module, the OPTIONS_GHC will get put into the generated .hc
-      file).</para>
-    </sect2>
-
-    <sect2>
-      <title>Setting options in GHCi</title>
-
-      <para>Options may also be modified from within GHCi, using the
-      <literal>:set</literal> command.  See <xref linkend="ghci-set"/>
-      for more details.</para>
-    </sect2>
-  </sect1>
-    
-  <sect1 id="static-dynamic-flags">
-    <title>Static, Dynamic, and Mode options</title>
-    <indexterm><primary>static</primary><secondary>options</secondary>
-    </indexterm>
-    <indexterm><primary>dynamic</primary><secondary>options</secondary>
-    </indexterm>
-    <indexterm><primary>mode</primary><secondary>options</secondary>
-    </indexterm>
-
-    <para>Each of GHC's command line options is classified as either
-    <firstterm>static</firstterm> or <firstterm>dynamic</firstterm> or
-      <firstterm>mode</firstterm>:</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>Mode flags</term>
-	<listitem>
-	  <para>For example, <option>--make</option> or <option>-E</option>.
-	    There may be only a single mode flag on the command line.  The
-	    available modes are listed in <xref linkend="modes"/>.</para>
-	</listitem>
-      </varlistentry>
-      <varlistentry>
-	<term>Dynamic Flags</term>
-	<listitem>
-	  <para>Most non-mode flags fall into this category.  A dynamic flag
-	    may be used on the command line, in a
-	    <literal>GHC_OPTIONS</literal> pragma in a source file, or set
-	    using <literal>:set</literal> in GHCi.</para>
-	</listitem>
-      </varlistentry>
-      <varlistentry>
-	<term>Static Flags</term>
-	<listitem>
-	  <para>A few flags are "static", which means they can only be used on
-	    the command-line, and remain in force over the entire GHC/GHCi
-	    run.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-    
-    <para>The flag reference tables (<xref
-    linkend="flag-reference"/>) lists the status of each flag.</para>
-  </sect1>
-
-  <sect1 id="file-suffixes">
-    <title>Meaningful file suffixes</title>
-
-    <indexterm><primary>suffixes, file</primary></indexterm>
-    <indexterm><primary>file suffixes for GHC</primary></indexterm>
-
-    <para>File names with &ldquo;meaningful&rdquo; suffixes (e.g.,
-    <filename>.lhs</filename> or <filename>.o</filename>) cause the
-    &ldquo;right thing&rdquo; to happen to those files.</para>
-
-    <variablelist>
-
-      <varlistentry>
-	<term><filename>.hs</filename></term>
-	<listitem>
-	  <para>A Haskell module.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <filename>.lhs</filename>
-          <indexterm><primary><literal>lhs</literal> suffix</primary></indexterm>
-	</term>
-	<listitem>
-	  <para>A &ldquo;literate Haskell&rdquo; module.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><filename>.hi</filename></term>
-	<listitem>
-	  <para>A Haskell interface file, probably
-	  compiler-generated.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><filename>.hc</filename></term>
-	<listitem>
-	  <para>Intermediate C file produced by the Haskell
-	  compiler.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><filename>.c</filename></term>
-	<listitem>
-	  <para>A C&nbsp;file not produced by the Haskell
-	  compiler.</para>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term><filename>.s</filename></term>
-	<listitem>
-	  <para>An assembly-language source file, usually produced by
-          the compiler.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><filename>.o</filename></term>
-	<listitem>
-	  <para>An object file, produced by an assembler.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-    <para>Files with other suffixes (or without suffixes) are passed
-    straight to the linker.</para>
-
-  </sect1>
-
-  <sect1 id="modes">
-    <title>Modes of operation</title>
-
-    <para>GHC's behaviour is firstly controlled by a mode flag.  Only
-    one of these flags may be given, but it does not necessarily need
-    to be the first option on the command-line.  The available modes
-    are:</para>
-
-    <variablelist>
-      <varlistentry>
-	<term>
-	  <cmdsynopsis><command>ghc</command>
-	    <arg choice='plain'>&ndash;&ndash;interactive</arg>
-	  </cmdsynopsis>
-          <indexterm><primary>interactive mode</primary></indexterm>
-          <indexterm><primary>ghci</primary></indexterm>
-	</term>
-	<listitem>
-	  <para>Interactive mode, which is also available as
-	  <command>ghci</command>.  Interactive mode is described in
-	  more detail in <xref linkend="ghci"/>.</para>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term>
-	  <cmdsynopsis><command>ghc</command>
-	    <arg choice='plain'>&ndash;&ndash;make</arg>
-	  </cmdsynopsis>
-          <indexterm><primary>make mode</primary></indexterm>
-          <indexterm><primary><option>&ndash;&ndash;make</option></primary></indexterm>
-	</term>
-	<listitem>
-	  <para>In this mode, GHC will build a multi-module Haskell
-	  program automatically, figuring out dependencies for itself.
-	  If you have a straightforward Haskell program, this is
-	  likely to be much easier, and faster, than using
-	  <command>make</command>.  Make mode is described in <xref
-	  linkend="make-mode"/>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-	  <cmdsynopsis><command>ghc</command>
-	    <arg choice='plain'>&ndash;e</arg> <arg choice='plain'><replaceable>expr</replaceable></arg>
-          </cmdsynopsis>
-          <indexterm><primary>eval mode</primary></indexterm>
-	</term>
-	<listitem>
-	  <para>Expression-evaluation mode.  This is very similar to
-	  interactive mode, except that there is a single expression
-	  to evaluate (<replaceable>expr</replaceable>) which is given
-	  on the command line.  See <xref linkend="eval-mode"/> for
-	  more details.</para>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term>
-          <cmdsynopsis>
-	    <command>ghc</command>
-	    <group>
-	      <arg>-E</arg>
-	      <arg>-C</arg>
-	      <arg>-S</arg>
-	      <arg>-c</arg>
-	    </group>
-	  </cmdsynopsis>
-	  <indexterm><primary><option>-E</option></primary></indexterm>
-	  <indexterm><primary><option>-C</option></primary></indexterm>
-	  <indexterm><primary><option>-S</option></primary></indexterm>
-	  <indexterm><primary><option>-c</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>This is the traditional batch-compiler mode, in which
-	  GHC can compile source files one at a time, or link objects
-	  together into an executable.  This mode also applies if
-	  there is no other mode flag specified on the command line,
-	  in which case it means that the specified files should be
-	  compiled and then linked to form a program. See <xref
-	  linkend="options-order"/>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <cmdsynopsis>
-            <command>ghc</command>
-	    <arg choice='plain'>&ndash;M</arg>
-          </cmdsynopsis>
-          <indexterm><primary>dependency-generation mode</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Dependency-generation mode.  In this mode, GHC can be
-	  used to generate dependency information suitable for use in
-	  a <literal>Makefile</literal>.  See <xref
-	  linkend="sec-makefile-dependencies"/>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <cmdsynopsis>
-            <command>ghc</command>
-	    <arg choice='plain'>&ndash;&ndash;mk-dll</arg>
-          </cmdsynopsis>
-	  <indexterm><primary>dependency-generation mode</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>DLL-creation mode (Windows only).  See <xref
-	  linkend="win32-dlls-create"/>.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-    <sect2 id="make-mode">
-      <title>Using <command>ghc</command> <option>&ndash;&ndash;make</option></title>
-      <indexterm><primary><option>&ndash;&ndash;make</option></primary></indexterm>
-      <indexterm><primary>separate compilation</primary></indexterm>
-      
-      <para>When given the <option>&ndash;&ndash;make</option> option,
-      GHC will build a multi-module Haskell program by following
-      dependencies from a single root module (usually
-      <literal>Main</literal>).  For example, if your
-      <literal>Main</literal> module is in a file called
-      <filename>Main.hs</filename>, you could compile and link the
-      program like this:</para>
-
-<screen>
-ghc &ndash;&ndash;make Main.hs
-</screen>
-
-      <para>The command line may contain any number of source file
-      names or module names; GHC will figure out all the modules in
-      the program by following the imports from these initial modules.
-      It will then attempt to compile each module which is out of
-      date, and finally if there is a <literal>Main</literal> module,
-      the program will also be linked into an executable.</para>
-
-      <para>The main advantages to using <literal>ghc
-      &ndash;&ndash;make</literal> over traditional
-      <literal>Makefile</literal>s are:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para>GHC doesn't have to be restarted for each compilation,
-	  which means it can cache information between compilations.
-	  Compiling a multi-module program with <literal>ghc
-	  &ndash;&ndash;make</literal> can be up to twice as fast as
-	  running <literal>ghc</literal> individually on each source
-	  file.</para>
-	</listitem>
-	<listitem>
-	  <para>You don't have to write a <literal>Makefile</literal>.</para>
-          <indexterm><primary><literal>Makefile</literal>s</primary><secondary>avoiding</secondary></indexterm>
-	</listitem>
-	<listitem>
-	  <para>GHC re-calculates the dependencies each time it is
-	  invoked, so the dependencies never get out of sync with the
-	  source.</para>
-	</listitem>
-      </itemizedlist>
-      
-      <para>Any of the command-line options described in the rest of
-      this chapter can be used with
-      <option>&ndash;&ndash;make</option>, but note that any options
-      you give on the command line will apply to all the source files
-      compiled, so if you want any options to apply to a single source
-      file only, you'll need to use an <literal>OPTIONS_GHC</literal>
-      pragma (see <xref linkend="source-file-options"/>).</para>
-
-      <para>If the program needs to be linked with additional objects
-      (say, some auxiliary C code), then the object files can be
-      given on the command line and GHC will include them when linking
-      the executable.</para>
-      
-      <para>Note that GHC can only follow dependencies if it has the
-      source file available, so if your program includes a module for
-      which there is no source file, even if you have an object and an
-      interface file for the module, then GHC will complain.  The
-      exception to this rule is for package modules, which may or may
-      not have source files.</para>
-
-      <para>The source files for the program don't all need to be in
-      the same directory; the <option>-i</option> option can be used
-      to add directories to the search path (see <xref
-      linkend="search-path"/>).</para>
-    </sect2>
-  
-    <sect2 id="eval-mode">
-      <title>Expression evaluation mode</title>
-
-      <para>This mode is very similar to interactive mode, except that
-      there is a single expression to evaluate which is specified on
-      the command line as an argument to the <option>-e</option>
-      option:</para>
-
-<screen>
-ghc -e <replaceable>expr</replaceable>
-</screen>
-
-      <para>Haskell source files may be named on the command line, and
-      they will be loaded exactly as in interactive mode.  The
-      expression is evaluated in the context of the loaded
-      modules.</para>
-
-      <para>For example, to load and run a Haskell program containing
-      a module <literal>Main</literal>, we might say</para>
-
-<screen>
-ghc -e Main.main Main.hs
-</screen>
-      
-      <para>or we can just use this mode to evaluate expressions in
-      the context of the <literal>Prelude</literal>:</para>
-
-<screen>
-$ ghc -e "interact (unlines.map reverse.lines)"
-hello
-olleh
-</screen>
-    </sect2>
-
-    <sect2 id="options-order">
-      <title>Batch compiler mode</title>
-      
-      <para>In <emphasis>batch mode</emphasis>, GHC will compile one or more source files
-      given on the command line.</para>
-      
-      <para>The first phase to run is determined by each input-file
-      suffix, and the last phase is determined by a flag.  If no
-      relevant flag is present, then go all the way through linking.
-      This table summarises:</para>
-      
-      <informaltable>
-	<tgroup cols="4">
-	  <colspec align="left"/>
-	  <colspec align="left"/>
-	  <colspec align="left"/>
-	  <colspec align="left"/>
-	  
-	  <thead>
-	    <row>
-	      <entry>Phase of the compilation system</entry>
-	      <entry>Suffix saying &ldquo;start here&rdquo;</entry>
-	      <entry>Flag saying &ldquo;stop after&rdquo;</entry>
-	      <entry>(suffix of) output file</entry>
-	    </row>
-	  </thead>
-	  <tbody>
-	    <row>
-	      <entry>literate pre-processor</entry>
-	      <entry><literal>.lhs</literal></entry>
-	      <entry>-</entry>
-	      <entry><literal>.hs</literal></entry>
-	    </row>
-	    
-	    <row>
-	      <entry>C pre-processor (opt.) </entry>
-	      <entry><literal>.hs</literal> (with
-	      <option>-cpp</option>)</entry>
-	      <entry><option>-E</option></entry>
-	      <entry><literal>.hspp</literal></entry>
-	    </row>
-	    
-	    <row>
-	      <entry>Haskell compiler</entry>
-	      <entry><literal>.hs</literal></entry>
-	      <entry><option>-C</option>, <option>-S</option></entry>
-	      <entry><literal>.hc</literal>, <literal>.s</literal></entry>
-	    </row>
-	    
-	    <row>
-	      <entry>C compiler (opt.)</entry>
-	      <entry><literal>.hc</literal> or <literal>.c</literal></entry>
-	      <entry><option>-S</option></entry>
-	      <entry><literal>.s</literal></entry>
-	    </row>
-	    
-	    <row>
-	      <entry>assembler</entry>
-	      <entry><literal>.s</literal></entry>
-	      <entry><option>-c</option></entry>
-	      <entry><literal>.o</literal></entry>
-	    </row>
-	    
-	    <row>
-	      <entry>linker</entry>
-	      <entry><replaceable>other</replaceable></entry>
-	      <entry>-</entry>
-	      <entry><filename>a.out</filename></entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-      
-      <indexterm><primary><option>-C</option></primary></indexterm>
-      <indexterm><primary><option>-E</option></primary></indexterm>
-      <indexterm><primary><option>-S</option></primary></indexterm>
-      <indexterm><primary><option>-c</option></primary></indexterm>
-      
-      <para>Thus, a common invocation would be: </para>
-
-<screen>
-ghc -c Foo.hs</screen>
-      
-      <para>to compile the Haskell source file
-      <filename>Foo.hs</filename> to an object file
-      <filename>Foo.o</filename>.</para>
-
-      <para>Note: What the Haskell compiler proper produces depends on
-      whether a native-code generator<indexterm><primary>native-code
-      generator</primary></indexterm> is used (producing assembly
-      language) or not (producing C).  See <xref
-      linkend="options-codegen"/> for more details.</para>
-
-      <para>Note: C pre-processing is optional, the
-      <option>-cpp</option><indexterm><primary><option>-cpp</option></primary></indexterm>
-      flag turns it on.  See <xref linkend="c-pre-processor"/> for more
-      details.</para>
-      
-      <para>Note: The option <option>-E</option><indexterm><primary>-E
-      option</primary></indexterm> runs just the pre-processing passes
-      of the compiler, dumping the result in a file.  Note that this
-      differs from the previous behaviour of dumping the file to
-      standard output.</para>
-
-      <sect3 id="overriding-suffixes">
-	<title>Overriding the default behaviour for a file</title>
-
-	<para>As described above, the way in which a file is processed by GHC
-	  depends on its suffix.  This behaviour can be overriden using the
-	  <option>-x</option> option:</para>
-
-	<variablelist>
-	  <varlistentry>
-	    <term><option>-x</option> <replaceable>suffix</replaceable>
-	    	      <indexterm><primary><option>-x</option></primary>
-	      </indexterm></term>
-	      <listitem>
-		<para>Causes all files following this option on the command
-		  line to be processed as if they had the suffix
-		  <replaceable>suffix</replaceable>.  For example, to compile a
-		  Haskell module in the file <literal>M.my-hs</literal>,
-		  use <literal>ghc -c -x hs M.my-hs</literal>.</para>
-	      </listitem>
-	  </varlistentry>
-	</variablelist>
-      </sect3>
-
-    </sect2>
-  </sect1>
-
-  <sect1 id="options-help">
-    <title>Help and verbosity options</title>
-
-    <indexterm><primary>help options</primary></indexterm>
-    <indexterm><primary>verbosity options</primary></indexterm>
-
-    <variablelist>
-      <varlistentry>
-	<term>
-          <option>&ndash;&ndash;help</option>
-          <indexterm><primary><option>&ndash;&ndash;help</option></primary></indexterm>
-        </term>
-	<term>
-          <option>-?</option>
-          <indexterm><primary><option>-?</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Cause GHC to spew a long usage message to standard
-          output and then exit.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-v</option>
-          <indexterm><primary><option>-v</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>The <option>-v</option> option makes GHC
-          <emphasis>verbose</emphasis>: it reports its version number
-          and shows (on stderr) exactly how it invokes each phase of
-          the compilation system.  Moreover, it passes the
-          <option>-v</option> flag to most phases; each reports its
-          version number (and possibly some other information).</para>
-
-	  <para>Please, oh please, use the <option>-v</option> option
-          when reporting bugs!  Knowing that you ran the right bits in
-          the right order is always the first thing we want to
-          verify.</para>
-	</listitem>
-      </varlistentry>
-	
-      <varlistentry>
-	<term>
-          <option>-v</option><replaceable>n</replaceable>
-          <indexterm><primary><option>-v</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>To provide more control over the compiler's verbosity,
-	  the <option>-v</option> flag takes an optional numeric
-	  argument.  Specifying <option>-v</option> on its own is
-	  equivalent to <option>-v3</option>, and the other levels
-	  have the following meanings:</para>
-	  
-	  <variablelist>
-	    <varlistentry>
-	      <term><option>-v0</option></term>
-	      <listitem>
-		<para>Disable all non-essential messages (this is the
-		default).</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term><option>-v1</option></term>
-	      <listitem>
-		<para>Minimal verbosity: print one line per
-		compilation (this is the default when
-		<option>&ndash;&ndash;make</option> or
-		<option>&ndash;&ndash;interactive</option> is on).</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term><option>-v2</option></term>
-	      <listitem>
-		<para>Print the name of each compilation phase as it
-		is executed. (equivalent to
-		<option>-dshow-passes</option>).</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term><option>-v3</option></term>
-	      <listitem>
-		<para>The same as <option>-v2</option>, except that in
-                addition the full command line (if appropriate) for
-                each compilation phase is also printed.</para>
-	      </listitem>
-	    </varlistentry>
-
-	    <varlistentry>
-	      <term><option>-v4</option></term>
-	      <listitem>
-		<para>The same as <option>-v3</option> except that the
-		intermediate program representation after each
-		compilation phase is also printed (excluding
-		preprocessed and C/assembly files).</para>
-	      </listitem>
-	    </varlistentry>
-	  </variablelist>
-	</listitem>
-      </varlistentry>
-      
-      <varlistentry>
-	<term>
-          <option>-V</option>
-          <indexterm><primary><option>-V</option></primary></indexterm>
-        </term>
-	<term>
-          <option>&ndash;&ndash;version</option>
-          <indexterm><primary><option>&ndash;&ndash;version</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Print a one-line string including GHC's version number.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>&ndash;&ndash;numeric-version</option>
-          <indexterm><primary><option>&ndash;&ndash;numeric-version</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Print GHC's numeric version number only.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>&ndash;&ndash;print-libdir</option>
-          <indexterm><primary><option>&ndash;&ndash;print-libdir</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Print the path to GHC's library directory.  This is
-	  the top of the directory tree containing GHC's libraries,
-	  interfaces, and include files (usually something like
-	  <literal>/usr/local/lib/ghc-5.04</literal> on Unix).  This
-	  is the value of
-	  <literal>$libdir</literal><indexterm><primary><literal>libdir</literal></primary>
-	  </indexterm>in the package configuration file (see <xref
-	  linkend="packages"/>).</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-ferror-spans</option>
-          <indexterm><primary><option>-ferror-spans</option></primary>
-	  </indexterm>
-        </term>
-	<listitem>
-	  <para>Causes GHC to emit the full source span of the
-	  syntactic entity relating to an error message.  Normally, GHC
-	  emits the source location of the start of the syntactic
-	  entity only.</para>
-
-	  <para>For example:</para>
-
-<screen>test.hs:3:6: parse error on input `where'</screen>
-
-	  <para>becomes:</para>
-
-<screen>test296.hs:3:6-10: parse error on input `where'</screen>
-
-	  <para>And multi-line spans are possible too:</para>
-
-<screen>test.hs:(5,4)-(6,7):
-    Conflicting definitions for `a'
-    Bound at: test.hs:5:4
-              test.hs:6:7
-    In the binding group for: a, b, a</screen>
-
-	  <para>Note that line numbers start counting at one, but
-	  column numbers start at zero.  This choice was made to
-	  follow existing convention (i.e. this is how Emacs does
-	  it).</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-        <term><option>-Rghc-timing</option>
-        <indexterm><primary><option>-Rghc-timing</option></primary></indexterm>
-        </term>
-        <listitem>
-          <para>Prints a one-line summary of timing statistics for the
-          GHC run.  This option is equivalent to
-          <literal>+RTS&nbsp;-tstderr</literal>, see <xref
-          linkend="rts-options-gc" />.
-          </para>
-        </listitem>
-      </varlistentry>
-    </variablelist>
-  </sect1>
-
-  &separate;
-
-  <sect1 id="options-sanity">
-    <title>Warnings and sanity-checking</title>
-
-    <indexterm><primary>sanity-checking options</primary></indexterm>
-    <indexterm><primary>warnings</primary></indexterm>
-
-
-    <para>GHC has a number of options that select which types of
-    non-fatal error messages, otherwise known as warnings, can be
-    generated during compilation.  By default, you get a standard set
-    of warnings which are generally likely to indicate bugs in your
-    program.  These are:
-    <option>-fwarn-overlapping-patterns</option>,
-    <option>-fwarn-deprecations</option>,
-    <option>-fwarn-duplicate-exports</option>,
-    <option>-fwarn-missing-fields</option>, and
-    <option>-fwarn-missing-methods</option>.  The following flags are
-    simple ways to select standard &ldquo;packages&rdquo; of warnings:
-    </para>
-
-    <variablelist>
-
-      <varlistentry>
-	<term><option>-W</option>:</term>
-	<listitem>
-	  <indexterm><primary>-W option</primary></indexterm>
-	  <para>Provides the standard warnings plus
-	  <option>-fwarn-incomplete-patterns</option>,
-	  <option>-fwarn-unused-matches</option>,
-	  <option>-fwarn-unused-imports</option>,
-	  <option>-fwarn-misc</option>, and
-	  <option>-fwarn-unused-binds</option>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-w</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-w</option></primary></indexterm>
-	  <para>Turns off all warnings, including the standard ones.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-Wall</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-Wall</option></primary></indexterm>
-	  <para>Turns on all warning options.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-Werror</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-Werror</option></primary></indexterm>
-	  <para>Makes any warning into a fatal error. Useful so that you don't 
-	    miss warnings when doing batch compilation. </para>
-	</listitem>
-      </varlistentry>
-
-    </variablelist>
-
-    <para>The full set of warning options is described below.  To turn
-    off any warning, simply give the corresponding
-    <option>-fno-warn-...</option> option on the command line.</para>
-
-    <variablelist>
-
-      <varlistentry>
-	<term><option>-fwarn-deprecations</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-deprecations</option></primary>
-	  </indexterm>
-	  <indexterm><primary>deprecations</primary></indexterm>
-	  <para>Causes a warning to be emitted when a deprecated
-	  function or type is used.  Entities can be marked as
-	  deprecated using a pragma, see <xref
-	  linkend="deprecated-pragma"/>.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-duplicate-exports</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-duplicate-exports</option></primary></indexterm>
-	  <indexterm><primary>duplicate exports, warning</primary></indexterm>
-	  <indexterm><primary>export lists, duplicates</primary></indexterm>
-
-	  <para>Have the compiler warn about duplicate entries in
-          export lists. This is useful information if you maintain
-          large export lists, and want to avoid the continued export
-          of a definition after you've deleted (one) mention of it in
-          the export list.</para>
-
-	  <para>This option is on by default.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-hi-shadowing</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-hi-shadowing</option></primary></indexterm>
-	  <indexterm><primary>shadowing</primary>
-	    <secondary>interface files</secondary></indexterm>
-
-	  <para>Causes the compiler to emit a warning when a module or
-	  interface file in the current directory is shadowing one
-	  with the same module name in a library or other
-	  directory.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-incomplete-patterns</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-incomplete-patterns</option></primary></indexterm>
-	  <indexterm><primary>incomplete patterns, warning</primary></indexterm>
-	  <indexterm><primary>patterns, incomplete</primary></indexterm>
-
-	  <para>Similarly for incomplete patterns, the function
-          <function>g</function> below will fail when applied to
-          non-empty lists, so the compiler will emit a warning about
-          this when <option>-fwarn-incomplete-patterns</option> is
-          enabled.</para>
-
-<programlisting>
-g [] = 2
-</programlisting>
-
-	  <para>This option isn't enabled be default because it can be
-          a bit noisy, and it doesn't always indicate a bug in the
-          program.  However, it's generally considered good practice
-          to cover all the cases in your functions.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-incomplete-record-updates</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-incomplete-record-updates</option></primary></indexterm>
-	  <indexterm><primary>incomplete record updates, warning</primary></indexterm>
-	  <indexterm><primary>record updates, incomplete</primary></indexterm>
-
-	  <para>The function
-          <function>f</function> below will fail when applied to
-          <literal>Bar</literal>, so the compiler will emit a warning about
-          this when <option>-fwarn-incomplete-record-updates</option> is
-          enabled.</para>
-
-<programlisting>
-data Foo = Foo { x :: Int }
-         | Bar
-
-f :: Foo -> Foo
-f foo = foo { x = 6 }
-</programlisting>
-
-	  <para>This option isn't enabled be default because it can be
-          very noisy, and it often doesn't indicate a bug in the
-          program.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-fwarn-misc</option>:
-          <indexterm><primary><option>-fwarn-misc</option></primary></indexterm>
-        </term>
-	<listitem>
-	  <para>Turns on warnings for various harmless but untidy
-	  things.  This currently includes: importing a type with
-	  <literal>(..)</literal> when the export is abstract, and
-	  listing duplicate class assertions in a qualified type.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-fwarn-missing-fields</option>:
-	  <indexterm><primary><option>-fwarn-missing-fields</option></primary></indexterm>
-	  <indexterm><primary>missing fields, warning</primary></indexterm>
-	  <indexterm><primary>fields, missing</primary></indexterm>
-        </term>
-	<listitem>
-
-	  <para>This option is on by default, and warns you whenever
-          the construction of a labelled field constructor isn't
-          complete, missing initializers for one or more fields. While
-          not an error (the missing fields are initialised with
-          bottoms), it is often an indication of a programmer error.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-missing-methods</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-missing-methods</option></primary></indexterm>
-	  <indexterm><primary>missing methods, warning</primary></indexterm>
-	  <indexterm><primary>methods, missing</primary></indexterm>
-
-	  <para>This option is on by default, and warns you whenever
-          an instance declaration is missing one or more methods, and
-          the corresponding class declaration has no default
-          declaration for them.</para>
-	  <para>The warning is suppressed if the method name
-	  begins with an underscore.  Here's an example where this is useful:
-	    <programlisting>
-	      class C a where
-	        _simpleFn :: a -> String
-	        complexFn :: a -> a -> String
-	        complexFn x y = ... _simpleFn ...
-	      </programlisting>
-	    The idea is that: (a) users of the class will only call <literal>complexFn</literal>; 
-	    never <literal>_simpleFn</literal>; and (b)
-	    instance declarations can define either <literal>complexFn</literal> or <literal>_simpleFn</literal>.
-	    </para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-missing-signatures</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-missing-signatures</option></primary></indexterm>
-	  <indexterm><primary>type signatures, missing</primary></indexterm>
-
-	  <para>If you would like GHC to check that every top-level
-          function/value has a type signature, use the
-          <option>-fwarn-missing-signatures</option> option.  This
-          option is off by default.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-name-shadowing</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-name-shadowing</option></primary></indexterm>
-	  <indexterm><primary>shadowing, warning</primary></indexterm>
-	  
-	  <para>This option causes a warning to be emitted whenever an
-          inner-scope value has the same name as an outer-scope value,
-          i.e. the inner value shadows the outer one.  This can catch
-          typographical errors that turn into hard-to-find bugs, e.g.,
-          in the inadvertent cyclic definition <literal>let x = ... x
-          ... in</literal>.</para>
-
-	  <para>Consequently, this option does
-          <emphasis>will</emphasis> complain about cyclic recursive
-          definitions.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-orphans</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-orphans</option></primary></indexterm>
-	  <indexterm><primary>orphan instances, warning</primary></indexterm>
-	  <indexterm><primary>orphan rules, warning</primary></indexterm>
-	  
-	  <para>This option causes a warning to be emitted whenever the 
-	    module contains an "orphan" instance declaration or rewrite rule.
-	    An instance declartion is an orphan if it appears in a module in
-	    which neither the class nor the type being instanced are declared
-	    in the same module.  A rule is an orphan if it is a rule for a
-	    function declared in another module.  A module containing any
-	  orphans is called an orphan module.</para>
-	  <para>The trouble with orphans is that GHC must pro-actively read the interface
-	    files for all orphan modules, just in case their instances or rules
-	    play a role, whether or not the module's interface would otherwise 
-	    be of any use.  Other things being equal, avoid orphan modules.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term>
-          <option>-fwarn-overlapping-patterns</option>:
-          <indexterm><primary><option>-fwarn-overlapping-patterns</option></primary></indexterm>
-          <indexterm><primary>overlapping patterns, warning</primary></indexterm>
-          <indexterm><primary>patterns, overlapping</primary></indexterm>
-        </term>
-	<listitem>
-	  <para>By default, the compiler will warn you if a set of
-          patterns are overlapping, i.e.,</para>
-
-<programlisting>
-f :: String -&#62; Int
-f []     = 0
-f (_:xs) = 1
-f "2"    = 2
-</programlisting>
-
-	  <para>where the last pattern match in <function>f</function>
-          won't ever be reached, as the second pattern overlaps
-          it. More often than not, redundant patterns is a programmer
-          mistake/error, so this option is enabled by default.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-simple-patterns</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-simple-patterns</option></primary>
-	  </indexterm>
-	  <para>Causes the compiler to warn about lambda-bound
-	  patterns that can fail, eg. <literal>\(x:xs)->...</literal>.
-	  Normally, these aren't treated as incomplete patterns by
-	  <option>-fwarn-incomplete-patterns</option>.</para>
-	  <para>``Lambda-bound patterns'' includes all places where there is a single pattern,
-	    including list comprehensions and do-notation.  In these cases, a pattern-match 
-	    failure is quite legitimate, and triggers filtering (list comprehensions) or
-	    the monad <literal>fail</literal> operation (monads). For example:
-	    <programlisting>
-	      f :: [Maybe a] -> [a]
-	      f xs = [y | Just y &lt;- xs]
-	      </programlisting>
-	    Switching on <option>-fwarn-simple-patterns</option> will elicit warnings about
-	    these probably-innocent cases, which is why the flag is off by default. </para>
-	  <para> The <literal>deriving( Read )</literal> mechanism produces monadic code with
-	    pattern matches, so you will also get misleading warnings about the compiler-generated
-	    code.  (This is arguably a Bad Thing, but it's awkward to fix.)</para>
-
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-type-defaults</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-type-defaults</option></primary></indexterm>
-	  <indexterm><primary>defaulting mechanism, warning</primary></indexterm>
-	  <para>Have the compiler warn/inform you where in your source
-          the Haskell defaulting mechanism for numeric types kicks
-          in. This is useful information when converting code from a
-          context that assumed one default into one with another,
-          e.g., the `default default' for Haskell 1.4 caused the
-          otherwise unconstrained value <constant>1</constant> to be
-          given the type <literal>Int</literal>, whereas Haskell 98
-          defaults it to <literal>Integer</literal>.  This may lead to
-          differences in performance and behaviour, hence the
-          usefulness of being non-silent about this.</para>
-
-	  <para>This warning is off by default.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-unused-binds</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-unused-binds</option></primary></indexterm>
-	  <indexterm><primary>unused binds, warning</primary></indexterm>
-	  <indexterm><primary>binds, unused</primary></indexterm>
-	  <para>Report any function definitions (and local bindings)
-          which are unused.  For top-level functions, the warning is
-          only given if the binding is not exported.</para>
-	  <para>A definition is regarded as "used" if (a) it is exported, or (b) it is
-	    mentioned in the right hand side of another definition that is used, or (c) the 
-	    function it defines begins with an underscore.  The last case provides a 
-	    way to suppress unused-binding warnings selectively.  </para>
-	  <para> Notice that a variable
-	    is reported as unused even if it appears in the right-hand side of another
-	    unused binding. </para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-unused-imports</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-unused-imports</option></primary></indexterm>
-	  <indexterm><primary>unused imports, warning</primary></indexterm>
-	  <indexterm><primary>imports, unused</primary></indexterm>
-
-	  <para>Report any modules that are explicitly imported but
-	  never used.  However, the form <literal>import M()</literal> is
-	  never reported as an unused import, because it is a useful idiom
-	  for importing instance declarations, which are anonymous in Haskell.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-fwarn-unused-matches</option>:</term>
-	<listitem>
-	  <indexterm><primary><option>-fwarn-unused-matches</option></primary></indexterm>
-	  <indexterm><primary>unused matches, warning</primary></indexterm>
-	  <indexterm><primary>matches, unused</primary></indexterm>
-
-	  <para>Report all unused variables which arise from pattern
-          matches, including patterns consisting of a single variable.
-          For instance <literal>f x y = []</literal> would report
-          <varname>x</varname> and <varname>y</varname> as unused.  The
-          warning is suppressed if the variable name begins with an underscore, thus:
-	    <programlisting>
-	       f _x = True
-	    </programlisting>
-          </para>
-	</listitem>
-      </varlistentry>
-
-    </variablelist>
-
-    <para>If you're feeling really paranoid, the
-    <option>-dcore-lint</option>
-    option<indexterm><primary><option>-dcore-lint</option></primary></indexterm>
-    is a good choice.  It turns on heavyweight intra-pass
-    sanity-checking within GHC.  (It checks GHC's sanity, not
-    yours.)</para>
-
-  </sect1>
-
-  &packages;
-
-  <sect1 id="options-optimise">
-    <title>Optimisation (code improvement)</title>
-
-    <indexterm><primary>optimisation</primary></indexterm>
-    <indexterm><primary>improvement, code</primary></indexterm>
-
-    <para>The <option>-O*</option> options specify convenient
-    &ldquo;packages&rdquo; of optimisation flags; the
-    <option>-f*</option> options described later on specify
-    <emphasis>individual</emphasis> optimisations to be turned on/off;
-    the <option>-m*</option> options specify
-    <emphasis>machine-specific</emphasis> optimisations to be turned
-    on/off.</para>
-
-    <sect2 id="optimise-pkgs">
-      <title><option>-O*</option>: convenient &ldquo;packages&rdquo; of optimisation flags.</title>
-
-      <para>There are <emphasis>many</emphasis> options that affect
-      the quality of code produced by GHC.  Most people only have a
-      general goal, something like &ldquo;Compile quickly&rdquo; or
-      &ldquo;Make my program run like greased lightning.&rdquo; The
-      following &ldquo;packages&rdquo; of optimisations (or lack
-      thereof) should suffice.</para>
-
-      <para>Note that higher optimisation levels cause more
-      cross-module optimisation to be performed, which can have an
-      impact on how much of your program needs to be recompiled when
-      you change something.  This is one reaosn to stick to
-      no-optimisation when developing code.</para>
-
-      <variablelist>
-
-	<varlistentry>
-	  <term>
-            No <option>-O*</option>-type option specified:
-            <indexterm><primary>-O* not specified</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>This is taken to mean: &ldquo;Please compile
-            quickly; I'm not over-bothered about compiled-code
-            quality.&rdquo; So, for example: <command>ghc -c
-            Foo.hs</command></para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-O0</option>:
-            <indexterm><primary><option>-O0</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Means &ldquo;turn off all optimisation&rdquo;,
-	    reverting to the same settings as if no
-	    <option>-O</option> options had been specified.  Saying
-	    <option>-O0</option> can be useful if
-	    eg. <command>make</command> has inserted a
-	    <option>-O</option> on the command line already.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-O</option> or <option>-O1</option>:
-            <indexterm><primary>-O option</primary></indexterm>
-            <indexterm><primary>-O1 option</primary></indexterm>
-            <indexterm><primary>optimise</primary><secondary>normally</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Means: &ldquo;Generate good-quality code without
-            taking too long about it.&rdquo; Thus, for example:
-            <command>ghc -c -O Main.lhs</command></para>
-
-	    <para><option>-O</option> currently also implies
-	    <option>-fvia-C</option>.  This may change in the
-	    future.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-O2</option>:
-            <indexterm><primary>-O2 option</primary></indexterm>
-            <indexterm><primary>optimise</primary><secondary>aggressively</secondary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Means: &ldquo;Apply every non-dangerous
-            optimisation, even if it means significantly longer
-            compile times.&rdquo;</para>
-
-	    <para>The avoided &ldquo;dangerous&rdquo; optimisations
-            are those that can make runtime or space
-            <emphasis>worse</emphasis> if you're unlucky.  They are
-            normally turned on or off individually.</para>
-
-	    <para>At the moment, <option>-O2</option> is
-            <emphasis>unlikely</emphasis> to produce better code than
-            <option>-O</option>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-Ofile &lt;file&gt;</option>:
-            <indexterm><primary>-Ofile &lt;file&gt; option</primary></indexterm>
-            <indexterm><primary>optimising, customised</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(NOTE: not supported since GHC 4.x.  Please ask if
-	    you're interested in this.)</para>
-	    
-	    <para>For those who need <emphasis>absolute</emphasis>
-            control over <emphasis>exactly</emphasis> what options are
-            used (e.g., compiler writers, sometimes :-), a list of
-            options can be put in a file and then slurped in with
-            <option>-Ofile</option>.</para>
-
-	    <para>In that file, comments are of the
-            <literal>&num;</literal>-to-end-of-line variety; blank
-            lines and most whitespace is ignored.</para>
-
-	    <para>Please ask if you are baffled and would like an
-	    example of <option>-Ofile</option>!</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>We don't use a <option>-O*</option> flag for day-to-day
-      work.  We use <option>-O</option> to get respectable speed;
-      e.g., when we want to measure something.  When we want to go for
-      broke, we tend to use <option>-O2 -fvia-C</option> (and we go for
-      lots of coffee breaks).</para>
-
-      <para>The easiest way to see what <option>-O</option> (etc.)
-      &ldquo;really mean&rdquo; is to run with <option>-v</option>,
-      then stand back in amazement.</para>
-    </sect2>
-
-    <sect2 id="options-f">
-      <title><option>-f*</option>: platform-independent flags</title>
-
-      <indexterm><primary>-f* options (GHC)</primary></indexterm>
-      <indexterm><primary>-fno-* options (GHC)</primary></indexterm>
-
-      <para>These flags turn on and off individual optimisations.
-      They are normally set via the <option>-O</option> options
-      described above, and as such, you shouldn't need to set any of
-      them explicitly (indeed, doing so could lead to unexpected
-      results).  However, there are one or two that may be of
-      interest:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term><option>-fexcess-precision</option>:</term>
-	  <listitem>
-	    <indexterm><primary><option>-fexcess-precision</option></primary></indexterm>
-	    <para>When this option is given, intermediate floating
-	    point values can have a <emphasis>greater</emphasis>
-	    precision/range than the final type.  Generally this is a
-	    good thing, but some programs may rely on the exact
-	    precision/range of
-	    <literal>Float</literal>/<literal>Double</literal> values
-	    and should not use this option for their compilation.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><option>-fignore-asserts</option>:</term>
-	  <listitem>
-	    <indexterm><primary><option>-fignore-asserts</option></primary></indexterm>
-	    <para>Causes GHC to ignore uses of the function
-	    <literal>Exception.assert</literal> in source code (in
-	    other words, rewriting <literal>Exception.assert p
-	    e</literal> to <literal>e</literal> (see <xref
-	    linkend="sec-assertions"/>).  This flag is turned on by
-	    <option>-O</option>.
-	    </para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-fno-cse</option>
-            <indexterm><primary><option>-fno-cse</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Turns off the common-sub-expression elimination optimisation.
-	      Can be useful if you have some <literal>unsafePerformIO</literal>
-	    expressions that you don't want commoned-up.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-fno-strictness</option>
-            <indexterm><primary><option>-fno-strictness</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Turns off the strictness analyser; sometimes it eats
-	    too many cycles.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-fno-full-laziness</option>
-            <indexterm><primary><option>-fno-full-laziness</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Turns off the full laziness optimisation (also known as
-	      let-floating).  Full laziness increases sharing, which can lead
-	      to increased memory residency.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-fno-state-hack</option>
-            <indexterm><primary><option>-fno-state-hack</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Turn off the "state hack" whereby any lambda with a
-	      <literal>State#</literal> token as argument is considered to be
-	      single-entry, hence it is considered OK to inline things inside
-	      it.  This can improve performance of IO and ST monad code, but it
-	    runs the risk of reducing sharing.</para> 
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-funbox-strict-fields</option>:
-	    <indexterm><primary><option>-funbox-strict-fields</option></primary></indexterm>
-	    <indexterm><primary>strict constructor fields</primary></indexterm>
-	    <indexterm><primary>constructor fields, strict</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>This option causes all constructor fields which are
-            marked strict (i.e. &ldquo;!&rdquo;) to be unboxed or
-            unpacked if possible.  It is equivalent to adding an
-            <literal>UNPACK</literal> pragma to every strict
-            constructor field (see <xref
-            linkend="unpack-pragma"/>).</para>
-
-	    <para>This option is a bit of a sledgehammer: it might
-	    sometimes make things worse.  Selectively unboxing fields
-	    by using <literal>UNPACK</literal> pragmas might be
-	    better.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-funfolding-update-in-place&lt;n&gt;</option>
-            <indexterm><primary><option>-funfolding-update-in-place</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Switches on an experimental "optimisation".
-            Switching it on makes the compiler a little keener to
-            inline a function that returns a constructor, if the
-            context is that of a thunk.
-<programlisting>
-   x = plusInt a b
-</programlisting>
-            If we inlined plusInt we might get an opportunity to use
-            update-in-place for the thunk 'x'.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term>
-            <option>-funfolding-creation-threshold&lt;n&gt;</option>:
-	    <indexterm><primary><option>-funfolding-creation-threshold</option></primary></indexterm>
-	    <indexterm><primary>inlining, controlling</primary></indexterm>
-	    <indexterm><primary>unfolding, controlling</primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>(Default: 45) Governs the maximum size that GHC will 
-            allow a function unfolding to be.   (An unfolding has a
-            &ldquo;size&rdquo; that reflects the cost in terms of
-            &ldquo;code bloat&rdquo; of expanding that unfolding at
-            at a call site. A bigger function would be assigned a
-            bigger cost.) </para>
-
-	    <para> Consequences: (a) nothing larger than this will be
-	    inlined (unless it has an INLINE pragma); (b) nothing
-	    larger than this will be spewed into an interface
-	    file. </para>
-
-
-            <para> Increasing this figure is more likely to result in longer
-            compile times than faster code.  The next option is more
-            useful:</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><option>-funfolding-use-threshold&lt;n&gt;</option>:</term>
-	  <listitem>
-	    <indexterm><primary><option>-funfolding-use-threshold</option></primary></indexterm>
-	    <indexterm><primary>inlining, controlling</primary></indexterm>
-	    <indexterm><primary>unfolding, controlling</primary></indexterm>
-
-	    <para>(Default: 8) This is the magic cut-off figure for
-            unfolding: below this size, a function definition will be
-            unfolded at the call-site, any bigger and it won't.  The
-            size computed for a function depends on two things: the
-            actual size of the expression minus any discounts that
-            apply (see <option>-funfolding-con-discount</option>).</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-    </sect2>
-    
-  </sect1>
-  
-  &phases;  
-  
-  <sect1 id="sec-using-concurrent">
-    <title>Using Concurrent Haskell</title>
-    <indexterm><primary>Concurrent Haskell</primary><secondary>using</secondary></indexterm>
-
-    <para>GHC supports Concurrent Haskell by default, without requiring a
-      special option or libraries compiled in a certain way.  To get access to
-      the support libraries for Concurrent Haskell, just import
-      <ulink
-	url="../libraries/base/Control-Concurrent.html"><literal>Control.Concurrent</literal></ulink>.  More information on Concurrent Haskell is provided in the documentation for that module.</para>
-
-    <para>The following RTS option(s) affect the behaviour of Concurrent
-      Haskell programs:<indexterm><primary>RTS options, concurrent</primary></indexterm></para>
-
-    <variablelist>
-      <varlistentry>
-	<term><option>-C<replaceable>s</replaceable></option></term>
-	<listitem>
-	  <para><indexterm><primary><option>-C<replaceable>s</replaceable></option></primary><secondary>RTS option</secondary></indexterm>
-	    Sets the context switch interval to <replaceable>s</replaceable>
-	    seconds.  A context switch will occur at the next heap block
-	    allocation after the timer expires (a heap block allocation occurs
-	    every 4k of allocation).  With <option>-C0</option> or
-	    <option>-C</option>, context switches will occur as often as
-	    possible (at every heap block allocation).  By default, context
-	    switches occur every 20ms.  Note that GHC's internal timer ticks
-	    every 20ms, and the context switch timer is always a multiple of
-	    this timer, so 20ms is the maximum granularity available for timed
-	    context switches.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-  </sect1>
-
-<sect1 id="sec-using-parallel">
-<title>Using parallel Haskell</title>
-
-<para>
-<indexterm><primary>Parallel Haskell</primary><secondary>using</secondary></indexterm>
-&lsqb;NOTE: GHC does not support Parallel Haskell by default, you need to
-      obtain a special version of GHC from the <ulink
-	url="http://www.cee.hw.ac.uk/~dsg/gph/">GPH</ulink> site.  Also,
-you won't be able to execute parallel Haskell programs unless PVM3
-(parallel Virtual Machine, version 3) is installed at your site.&rsqb;
-</para>
-
-<para>
-To compile a Haskell program for parallel execution under PVM, use the
-<option>-parallel</option> option,<indexterm><primary>-parallel
-option</primary></indexterm> both when compiling <emphasis>and
-linking</emphasis>.  You will probably want to <literal>import
-Control.Parallel</literal> into your Haskell modules.
-</para>
-
-<para>
-To run your parallel program, once PVM is going, just invoke it
-&ldquo;as normal&rdquo;.  The main extra RTS option is
-<option>-qp&lt;n&gt;</option>, to say how many PVM
-&ldquo;processors&rdquo; your program to run on.  (For more details of
-all relevant RTS options, please see <xref
-linkend="parallel-rts-opts"/>.)
-</para>
-
-<para>
-In truth, running parallel Haskell programs and getting information
-out of them (e.g., parallelism profiles) is a battle with the vagaries of
-PVM, detailed in the following sections.
-</para>
-
-<sect2 id="pvm-dummies">
-<title>Dummy's guide to using PVM</title>
-
-<para>
-<indexterm><primary>PVM, how to use</primary></indexterm>
-<indexterm><primary>parallel Haskell&mdash;PVM use</primary></indexterm>
-Before you can run a parallel program under PVM, you must set the
-required environment variables (PVM's idea, not ours); something like,
-probably in your <filename>.cshrc</filename> or equivalent:
-
-<programlisting>
-setenv PVM_ROOT /wherever/you/put/it
-setenv PVM_ARCH `$PVM_ROOT/lib/pvmgetarch`
-setenv PVM_DPATH $PVM_ROOT/lib/pvmd
-</programlisting>
-
-</para>
-
-<para>
-Creating and/or controlling your &ldquo;parallel machine&rdquo; is a purely-PVM
-business; nothing specific to parallel Haskell. The following paragraphs
-describe how to configure your parallel machine interactively.
-</para>
-
-<para>
-If you use parallel Haskell regularly on the same machine configuration it
-is a good idea to maintain a file with all machine names and to make the
-environment variable PVM_HOST_FILE point to this file. Then you can avoid
-the interactive operations described below by just saying
-</para>
-
-<programlisting>
-pvm $PVM_HOST_FILE
-</programlisting>
-
-<para>
-You use the <command>pvm</command><indexterm><primary>pvm command</primary></indexterm> command to start PVM on your
-machine.  You can then do various things to control/monitor your
-&ldquo;parallel machine;&rdquo; the most useful being:
-</para>
-
-<para>
-<informaltable>
-<tgroup cols="2">
-<colspec align="left"/>
-<tbody>
-
-<row>
-<entry><keycombo><keycap>Control</keycap><keycap>D</keycap></keycombo></entry>
-<entry>exit <command>pvm</command>, leaving it running</entry>
-</row>
-
-<row>
-<entry><command>halt</command></entry>
-<entry>kill off this &ldquo;parallel machine&rdquo; &amp; exit</entry>
-</row>
-
-<row>
-<entry><command>add &lt;host&gt;</command></entry>
-<entry>add <command>&lt;host&gt;</command> as a processor</entry>
-</row>
-
-<row>
-<entry><command>delete &lt;host&gt;</command></entry>
-<entry>delete <command>&lt;host&gt;</command></entry>
-</row>
-
-<row>
-<entry><command>reset</command></entry>
-<entry>kill what's going, but leave PVM up</entry>
-</row>
-
-<row>
-<entry><command>conf</command></entry>
-<entry>list the current configuration</entry>
-</row>
-
-<row>
-<entry><command>ps</command></entry>
-<entry>report processes' status</entry>
-</row>
-
-<row>
-<entry><command>pstat &lt;pid&gt;</command></entry>
-<entry>status of a particular process</entry>
-</row>
-
-</tbody>
-</tgroup>
-</informaltable>
-</para>
-
-<para>
-The PVM documentation can tell you much, much more about <command>pvm</command>!
-</para>
-
-</sect2>
-
-<sect2 id="par-profiles">
-<title>parallelism profiles</title>
-
-<para>
-<indexterm><primary>parallelism profiles</primary></indexterm>
-<indexterm><primary>profiles, parallelism</primary></indexterm>
-<indexterm><primary>visualisation tools</primary></indexterm>
-</para>
-
-<para>
-With parallel Haskell programs, we usually don't care about the
-results&mdash;only with &ldquo;how parallel&rdquo; it was!  We want pretty pictures.
-</para>
-
-<para>
-parallelism profiles (&agrave; la <command>hbcpp</command>) can be generated with the
-<option>-qP</option><indexterm><primary>-qP RTS option</primary></indexterm> RTS option.  The
-per-processor profiling info is dumped into files named
-<filename>&lt;full-path&gt;&lt;program&gt;.gr</filename>.  These are then munged into a PostScript picture,
-which you can then display.  For example, to run your program
-<filename>a.out</filename> on 8 processors, then view the parallelism profile, do:
-</para>
-
-<para>
-
-<screen>
-<prompt>&dollar;</prompt> ./a.out +RTS -qP -qp8
-<prompt>&dollar;</prompt> grs2gr *.???.gr &#62; temp.gr # combine the 8 .gr files into one
-<prompt>&dollar;</prompt> gr2ps -O temp.gr              # cvt to .ps; output in temp.ps
-<prompt>&dollar;</prompt> ghostview -seascape temp.ps   # look at it!
-</screen>
-
-</para>
-
-<para>
-The scripts for processing the parallelism profiles are distributed
-in <filename>ghc/utils/parallel/</filename>.
-</para>
-
-</sect2>
-
-<sect2>
-<title>Other useful info about running parallel programs</title>
-
-<para>
-The &ldquo;garbage-collection statistics&rdquo; RTS options can be useful for
-seeing what parallel programs are doing.  If you do either
-<option>+RTS -Sstderr</option><indexterm><primary>-Sstderr RTS option</primary></indexterm> or <option>+RTS -sstderr</option>, then
-you'll get mutator, garbage-collection, etc., times on standard
-error. The standard error of all PE's other than the `main thread'
-appears in <filename>/tmp/pvml.nnn</filename>, courtesy of PVM.
-</para>
-
-<para>
-Whether doing <option>+RTS -Sstderr</option> or not, a handy way to watch
-what's happening overall is: <command>tail -f /tmp/pvml.nnn</command>.
-</para>
-
-</sect2>
-
-<sect2 id="parallel-rts-opts">
-<title>RTS options for Parallel Haskell
-</title>
-
-<para>
-<indexterm><primary>RTS options, parallel</primary></indexterm>
-<indexterm><primary>parallel Haskell&mdash;RTS options</primary></indexterm>
-</para>
-
-<para>
-Besides the usual runtime system (RTS) options
-(<xref linkend="runtime-control"/>), there are a few options particularly
-for parallel execution.
-</para>
-
-<para>
-<variablelist>
-
-<varlistentry>
-<term><option>-qp&lt;N&gt;</option>:</term>
-<listitem>
-<para>
-<indexterm><primary>-qp&lt;N&gt; RTS option</primary></indexterm>
-(paraLLEL ONLY) Use <literal>&lt;N&gt;</literal> PVM processors to run this program;
-the default is 2.
-</para>
-</listitem>
-</varlistentry>
-<varlistentry>
-<term><option>-C[&lt;s&gt;]</option>:</term>
-<listitem>
-<para>
-<indexterm><primary>-C&lt;s&gt; RTS option</primary></indexterm> Sets
-the context switch interval to <literal>&lt;s&gt;</literal> seconds.
-A context switch will occur at the next heap block allocation after
-the timer expires (a heap block allocation occurs every 4k of
-allocation).  With <option>-C0</option> or <option>-C</option>,
-context switches will occur as often as possible (at every heap block
-allocation).  By default, context switches occur every 20ms.  Note that GHC's internal timer ticks every 20ms, and
-the context switch timer is always a multiple of this timer, so 20ms
-is the maximum granularity available for timed context switches.
-</para>
-</listitem>
-</varlistentry>
-<varlistentry>
-<term><option>-q[v]</option>:</term>
-<listitem>
-<para>
-<indexterm><primary>-q RTS option</primary></indexterm>
-(paraLLEL ONLY) Produce a quasi-parallel profile of thread activity,
-in the file <filename>&lt;program&gt;.qp</filename>.  In the style of <command>hbcpp</command>, this profile
-records the movement of threads between the green (runnable) and red
-(blocked) queues.  If you specify the verbose suboption (<option>-qv</option>), the
-green queue is split into green (for the currently running thread
-only) and amber (for other runnable threads).  We do not recommend
-that you use the verbose suboption if you are planning to use the
-<command>hbcpp</command> profiling tools or if you are context switching at every heap
-check (with <option>-C</option>).
--->
-</para>
-</listitem>
-</varlistentry>
-<varlistentry>
-<term><option>-qt&lt;num&gt;</option>:</term>
-<listitem>
-<para>
-<indexterm><primary>-qt&lt;num&gt; RTS option</primary></indexterm>
-(paraLLEL ONLY) Limit the thread pool size, i.e. the number of 
-threads per processor to <literal>&lt;num&gt;</literal>.  The default is
-32.  Each thread requires slightly over 1K <emphasis>words</emphasis> in
-the heap for thread state and stack objects.  (For 32-bit machines, this
-translates to 4K bytes, and for 64-bit machines, 8K bytes.)
-</para>
-</listitem>
-</varlistentry>
-<!-- no more -HWL
-<varlistentry>
-<term><option>-d</option>:</term>
-<listitem>
-<para>
-<indexterm><primary>-d RTS option (parallel)</primary></indexterm>
-(paraLLEL ONLY) Turn on debugging.  It pops up one xterm (or GDB, or
-something&hellip;) per PVM processor.  We use the standard <command>debugger</command>
-script that comes with PVM3, but we sometimes meddle with the
-<command>debugger2</command> script.  We include ours in the GHC distribution,
-in <filename>ghc/utils/pvm/</filename>.
-</para>
-</listitem>
-</varlistentry>
--->
-<varlistentry>
-<term><option>-qe&lt;num&gt;</option>:</term>
-<listitem>
-<para>
-<indexterm><primary>-qe&lt;num&gt; RTS option
-(parallel)</primary></indexterm> (paraLLEL ONLY) Limit the spark pool size
-i.e. the number of pending sparks per processor to
-<literal>&lt;num&gt;</literal>. The default is 100. A larger number may be
-appropriate if your program generates large amounts of parallelism
-initially.
-</para>
-</listitem>
-</varlistentry>
-<varlistentry>
-<term><option>-qQ&lt;num&gt;</option>:</term>
-<listitem>
-<para>
-<indexterm><primary>-qQ&lt;num&gt; RTS option (parallel)</primary></indexterm>
-(paraLLEL ONLY) Set the size of packets transmitted between processors
-to <literal>&lt;num&gt;</literal>. The default is 1024 words. A larger number may be
-appropriate if your machine has a high communication cost relative to
-computation speed.
-</para>
-</listitem>
-</varlistentry>
-<varlistentry>
-<term><option>-qh&lt;num&gt;</option>:</term>
-<listitem>
-<para>
-<indexterm><primary>-qh&lt;num&gt; RTS option (parallel)</primary></indexterm>
-(paraLLEL ONLY) Select a packing scheme. Set the number of non-root thunks to pack in one packet to
-&lt;num&gt;-1 (0 means infinity). By default GUM uses full-subgraph
-packing, i.e. the entire subgraph with the requested closure as root is
-transmitted (provided it fits into one packet). Choosing a smaller value
-reduces the amount of pre-fetching of work done in GUM. This can be
-advantageous for improving data locality but it can also worsen the balance
-of the load in the system. 
-</para>
-</listitem>
-</varlistentry>
-<varlistentry>
-<term><option>-qg&lt;num&gt;</option>:</term>
-<listitem>
-<para>
-<indexterm><primary>-qg&lt;num&gt; RTS option
-(parallel)</primary></indexterm> (paraLLEL ONLY) Select a globalisation
-scheme. This option affects the
-generation of global addresses when transferring data. Global addresses are
-globally unique identifiers required to maintain sharing in the distributed
-graph structure. Currently this is a binary option. With &lt;num&gt;=0 full globalisation is used
-(default). This means a global address is generated for every closure that
-is transmitted. With &lt;num&gt;=1 a thunk-only globalisation scheme is
-used, which generated global address only for thunks. The latter case may
-lose sharing of data but has a reduced overhead in packing graph structures
-and maintaining internal tables of global addresses.
-</para>
-</listitem>
-</varlistentry>
-</variablelist>
-</para>
-
-</sect2>
-
-</sect1>
-
-  <sect1 id="options-platform">
-    <title>Platform-specific Flags</title>
-
-    <indexterm><primary>-m* options</primary></indexterm>
-    <indexterm><primary>platform-specific options</primary></indexterm>
-    <indexterm><primary>machine-specific options</primary></indexterm>
-
-    <para>Some flags only make sense for particular target
-    platforms.</para>
-
-    <variablelist>
-
-      <varlistentry>
-	<term><option>-mv8</option>:</term>
-	<listitem>
-	  <para>(SPARC machines)<indexterm><primary>-mv8 option (SPARC
-          only)</primary></indexterm> Means to pass the like-named
-          option to GCC; it says to use the Version 8 SPARC
-          instructions, notably integer multiply and divide.  The
-          similar <option>-m*</option> GCC options for SPARC also
-          work, actually.</para>
-	</listitem>
-      </varlistentry>
-
-      <varlistentry>
-	<term><option>-monly-[32]-regs</option>:</term>
-	<listitem>
-	  <para>(iX86 machines)<indexterm><primary>-monly-N-regs
-          option (iX86 only)</primary></indexterm> GHC tries to
-          &ldquo;steal&rdquo; four registers from GCC, for performance
-          reasons; it almost always works.  However, when GCC is
-          compiling some modules with four stolen registers, it will
-          crash, probably saying:
-
-<screen>
-Foo.hc:533: fixed or forbidden register was spilled.
-This may be due to a compiler bug or to impossible asm
-statements or clauses.
-</screen>
-
-          Just give some registers back with
-          <option>-monly-N-regs</option>.  Try `3' first, then `2'.
-          If `2' doesn't work, please report the bug to us.</para>
-	</listitem>
-      </varlistentry>
-    </variablelist>
-
-  </sect1>
-
-&runtime;
-
-<sect1 id="ext-core">
-  <title>Generating and compiling External Core Files</title>
-
-  <indexterm><primary>intermediate code generation</primary></indexterm>
-
-  <para>GHC can dump its optimized intermediate code (said to be in &ldquo;Core&rdquo; format) 
-  to a file as a side-effect of compilation. Core files, which are given the suffix
-  <filename>.hcr</filename>, can be read and processed by non-GHC back-end
-  tools.  The Core format is formally described in <ulink url="http://www.haskell.org/ghc/docs/papers/core.ps.gz">
-  <citetitle>An External Representation for the GHC Core Language</citetitle></ulink>, 
-  and sample tools (in Haskell)
-  for manipulating Core files are available in the GHC source distribution 
-  directory <literal>/fptools/ghc/utils/ext-core</literal>.  
-  Note that the format of <literal>.hcr</literal> 
-  files is <emphasis>different</emphasis> (though similar) to the Core output format generated 
-  for debugging purposes (<xref linkend="options-debugging"/>).</para>
-
-  <para>The Core format natively supports notes which you can add to
-  your source code using the <literal>CORE</literal> pragma (see <xref
-  linkend="pragmas"/>).</para>
-
-    <variablelist>
-
-  	<varlistentry>
-	  <term>
-            <option>-fext-core</option>
-            <indexterm><primary><option>-fext-core</option></primary></indexterm>
-          </term>
-	  <listitem>
-	    <para>Generate <literal>.hcr</literal> files.</para>
-	  </listitem>
-	</varlistentry>
-
-    </variablelist>
-
-<para>GHC can also read in External Core files as source; just give the <literal>.hcr</literal> file on
-the command line, instead of the <literal>.hs</literal> or <literal>.lhs</literal> Haskell source.
-A current infelicity is that you need to give the <literal>-fglasgow-exts</literal> flag too, because
-ordinary Haskell 98, when translated to External Core, uses things like rank-2 types.</para>
-</sect1>
-
-&debug;
-&flags;
-
-</chapter>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/utils.xml b/ghc/docs/users_guide/utils.xml
deleted file mode 100644
index 6c82f6b38a..0000000000
--- a/ghc/docs/users_guide/utils.xml
+++ /dev/null
@@ -1,564 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<chapter id="utils">
-  <title>Other Haskell utility programs</title>
-  <indexterm><primary>utilities, Haskell</primary></indexterm>
-
-  <para>This section describes other program(s) which we distribute,
-  that help with the Great Haskell Programming Task.</para>
-
-<!-- comment: hasktags documentation loosely based on that for hstags -->
-
-<sect1  id ="hasktags">
-	<title>Ctags and Etags for Haskell: <command>hasktags</command></title>
-	<indexterm><primary><command>hasktags</command></primary></indexterm>
-	<indexterm><primary>CTAGS for Haskell</primary></indexterm>
-
-	<para><command>hasktags</command> is a very simple Haskell program that produces ctags "tags" and etags "TAGS" files for Haskell programs.</para>
-
-	<para>When loaded into an editor such an NEdit, Vim, or Emacs, this allows one to easily navigate around a multi-file program, finding definitions of functions, types, and constructors.</para>
-
-	<para>Invocation Syntax:</para>
-
-<screen>
-hasktags files
-</screen>
-
-<para>This will read all the files listed in <option>files</option> and produce a ctags "tags" file and an etags "TAGS" file in the current directory.</para>
-
-	<para>Example usage</para>
-
-<screen>
-find -name \*.\*hs | xargs hasktags
-</screen>
-
-<para>This will find all haskell source files in the current directory and below, and create tags files indexing them in the current directory.</para>
-
-	<para><command>hasktags</command> is a simple program that uses simple
-	parsing rules to find definitions of functions, constructors, and types. It isn't guaranteed to find everything, and will sometimes create false index entries, but it usually gets the job done fairly well. In particular, at present, functions are only indexed if a type signature is given for them.</para>
-
-	<para>Before hasktags, there used to be <command>fptags</command> and <command>hstags</command>, which did essentially the same job, however neither of these seem to be maintained any more.</para>
-
-<sect2>
-<title>Using tags with your editor</title>
-
-<para>With NEdit, load the "tags" file using "File/Load Tags File". Use "Ctrl-D" to search for a tag.</para>
-
-<para>With XEmacs, load the "TAGS" file using "visit-tags-table". Use "M-." to search for a tag.</para>
-
-
-</sect2>
-
-</sect1>
-
-<!-- comment: hstags doesn't work anymore
-
-  <sect1 id="hstags">
-    <title>Emacs `TAGS' for Haskell: <command>hstags</command></title>
-    <indexterm><primary><command>hstags</command></primary></indexterm>
-    <indexterm><primary>TAGS for Haskell</primary></indexterm>
-
-    <para>`Tags' is a facility for indexing the definitions of
-    programming-language things in a multi-file program, and then
-    using that index to jump around among these definitions.</para>
-
-    <para>Rather than scratch your head, saying &ldquo;Now where did
-    we define `foo'?&rdquo;, you just do (in Emacs) <Literal>M-. foo
-    RET</Literal>, and You're There!  Some people go wild over this
-    stuff&hellip;</para>
-
-    <para>GHC comes with a program <command>hstags</command>, which
-    build Emacs-able TAGS files.  The invocation syntax is:</para>
-
-<screen>
-hstags [GHC-options] file [files...]
-</screen>
-
-    <para>The best thing is just to feed it your GHC command-line
-    flags.  A good Makefile entry might be:</para>
-
-<programlisting>
-tags:
-        $(RM) TAGS
-        hstags $(GHC_FLAGS) *.lhs
-</programlisting>
-
-    <para>The only flags of its own are: <Option>-v</Option> to be
-    verbose; <Option>-a</Option> to <Emphasis>APPEND</Emphasis> to the
-    TAGS file, rather than write to it.</para>
-
-    <para>Shortcomings: (1)&nbsp;Instance declarations don't get into
-    the TAGS file (but the definitions inside them do); as instances
-    aren't named, this is probably just as well.
-    (2)&nbsp;Data-constructor definitions don't get in.  Go for the
-    corresponding type constructor instead.</para>
-
-    <para>Actually, GHC also comes with <command>etags</command>
-    &lsqb;for C&rsqb;, and <command>perltags</command> &lsqb;for You
-    Know What&rsqb;.  And&mdash;I cannot tell a lie&mdash;there is
-    Denis Howe's <command>fptags</command> &lsqb;for Haskell,
-    etc.&rsqb; in the <Filename>ghc/CONTRIB</Filename>
-    section&hellip;)</para>
-
-  </sect1>
--->
-
-  <sect1 id="happy">
-    <title>&ldquo;Yacc for Haskell&rdquo;: <command>happy</command></title>
-
-    <indexterm><primary>Happy</primary></indexterm>
-    <indexterm><primary>Yacc for Haskell</primary></indexterm>
-    <indexterm><primary>parser generator for Haskell</primary></indexterm>
-
-    <para>Andy Gill and Simon Marlow have written a parser-generator
-    for Haskell, called
-    <command>happy</command>.<indexterm><primary>happy parser
-    generator</primary></indexterm> <command>Happy</command> is to
-    Haskell what <command>Yacc</command> is to C.</para>
-
-    <para>You can get <command>happy</command> from <ulink
-    url="http://www.haskell.org/happy/">the Happy
-    Homepage</ulink>.</para>
-
-    <para><command>Happy</command> is at its shining best when
-    compiled by GHC.</para>
-
-  </sect1>
-
-<!-- we don't distribute this anymore
-  <sect1 id="pphs">
-    <title>Pretty-printing Haskell: <command>pphs</command></title>
-    <indexterm><primary>pphs</primary></indexterm>
-    <indexterm><primary>pretty-printing Haskell code</primary></indexterm>
-
-    <para>Andrew Preece has written
-    <command>pphs</command>,<indexterm><primary>pphs</primary></indexterm><indexterm><primary>pretty-printing
-    Haskell</primary></indexterm> a utility to pretty-print Haskell
-    code in LaTeX documents.  Keywords in bolds, variables in
-    italics&mdash;that sort of thing.  It is good at lining up program
-    clauses and equals signs, things that are very tiresome to do by
-    hand.</para>
-
-    <para>The code is distributed with GHC in
-    <Filename>ghc/CONTRIB/pphs</Filename>.</para>
-  </sect1>
--->
-
-  <sect1 id="hsc2hs">
-    <title>Writing Haskell interfaces to C code:
-    <command>hsc2hs</command></title>
-    <indexterm><primary><command>hsc2hs</command></primary>
-    </indexterm>
-
-    <para>The <command>hsc2hs</command> command can be used to automate
-    some parts of the process of writing Haskell bindings to C code.
-    It reads an almost-Haskell source with embedded special
-    constructs, and outputs a real Haskell file with these constructs
-    processed, based on information taken from some C headers. The
-    extra constructs deal with accessing C data from Haskell.</para>
-
-    <para>It may also output a C file which contains additional C
-    functions to be linked into the program, together with a C header
-    that gets included into the C code to which the Haskell module
-    will be compiled (when compiled via C) and into the C file. These
-    two files are created when the <literal>#def</literal> construct
-    is used (see below).</para>
-
-    <para>Actually <command>hsc2hs</command> does not output the Haskell
-    file directly.  It creates a C program that includes the headers,
-    gets automatically compiled and run. That program outputs the
-    Haskell code.</para>
-
-    <para>In the following, &ldquo;Haskell file&rdquo; is the main
-    output (usually a <literal>.hs</literal> file), &ldquo;compiled
-    Haskell file&rdquo; is the Haskell file after
-    <command>ghc</command> has compiled it to C (i.e. a
-    <literal>.hc</literal> file), &ldquo;C program&rdquo; is the
-    program that outputs the Haskell file, &ldquo;C file&rdquo; is the
-    optionally generated C file, and &ldquo;C header&rdquo; is its
-    header file.</para>
-
-    <sect2>
-      <title>command line syntax</title>
-
-      <para><command>hsc2hs</command> takes input files as arguments,
-      and flags that modify its behavior:</para>
-
-      <variablelist>
-	<varlistentry>
-	  <term><literal>-o FILE</literal> or
-	  <literal>&ndash;&ndash;output=FILE</literal></term>
-	  <listitem>
-	    <para>Name of the Haskell file.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>-t FILE</literal> or
-	  <literal>&ndash;&ndash;template=FILE</literal></term>
-	  <listitem>
-	    <para>The template file (see below).</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>-c PROG</literal> or
-	  <literal>&ndash;&ndash;cc=PROG</literal></term>
-	  <listitem>
-	    <para>The C compiler to use (default:
-	    <command>ghc</command>)</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>-l PROG</literal> or
-	  <literal>&ndash;&ndash;ld=PROG</literal></term>
-	  <listitem>
-	    <para>The linker to use (default:
-	    <command>gcc</command>).</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>-C FLAG</literal> or
-	  <literal>&ndash;&ndash;cflag=FLAG</literal></term>
-	  <listitem>
-	    <para>An extra flag to pass to the C compiler.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>-I DIR</literal></term>
-	  <listitem>
-	    <para>Passed to the C compiler.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>-L FLAG</literal> or
-	  <literal>&ndash;&ndash;lflag=FLAG</literal></term>
-	  <listitem>
-	    <para>An extra flag to pass to the linker.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>-i FILE</literal> or
-	  <literal>&ndash;&ndash;include=FILE</literal></term>
-	  <listitem>
-	    <para>As if the appropriate <literal>#include</literal>
-            directive was placed in the source.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>-D NAME[=VALUE]</literal> or
-	  <literal>&ndash;&ndash;define=NAME[=VALUE]</literal></term>
-	  <listitem>
-	    <para>As if the appropriate <literal>#define</literal>
-            directive was placed in the source.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>&ndash;&ndash;no-compile</literal></term>
-	  <listitem>
-	    <para>Stop after writing out the intermediate C program to disk.
-	    The file name for the intermediate C program is the input file name
-	    with <literal>.hsc</literal> replaced with <literal>_hsc_make.c</literal>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>-?</literal> or <literal>&ndash;&ndash;help</literal></term>
-	  <listitem>
-	    <para>Display a summary of the available flags and exit successfully.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>-V</literal> or <literal>&ndash;&ndash;version</literal></term>
-	  <listitem>
-	    <para>Output version information and exit successfully.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-      <para>The input file should end with .hsc (it should be plain
-      Haskell source only; literate Haskell is not supported at the
-      moment). Output files by default get names with the
-      <literal>.hsc</literal> suffix replaced:</para>
-
-      <informaltable>
-	<tgroup cols="2">
-	  <tbody>
-	    <row>
-	      <entry><literal>.hs</literal></entry>
-	      <entry>Haskell file</entry>
-	    </row>
-	    <row>
-	      <entry><literal>_hsc.h</literal></entry>
-	      <entry>C header</entry>
-	    </row>
-	    <row>
-	      <entry><literal>_hsc.c</literal></entry>
-	      <entry>C file</entry>
-	    </row>
-	  </tbody>
-	</tgroup>
-      </informaltable>
-
-      <para>The C program is compiled using the Haskell compiler. This
-      provides the include path to <filename>HsFFI.h</filename> which
-      is automatically included into the C program.</para>
-
-    </sect2>
-    <sect2><title>Input syntax</title>
-
-      <para>All special processing is triggered by
-      the <literal>#</literal> operator. To output
-      a literal <literal>#</literal>, write it twice:
-      <literal>##</literal>. Inside string literals and comments
-      <literal>#</literal> characters are not processed.</para>
-
-      <para>A <literal>#</literal> is followed by optional
-      spaces and tabs, an alphanumeric keyword that describes
-      the kind of processing, and its arguments. Arguments look
-      like C expressions separated by commas (they are not
-      written inside parens).  They extend up to the nearest
-      unmatched <literal>)</literal>, <literal>]</literal> or
-      <literal>}</literal>, or to the end of line if it occurs outside
-      any <literal>() [] {} '' "" /**/</literal> and is not preceded
-      by a backslash. Backslash-newline pairs are stripped.</para>
-
-      <para>In addition <literal>#{stuff}</literal> is equivalent
-      to <literal>#stuff</literal> except that it's self-delimited
-      and thus needs not to be placed at the end of line or in some
-      brackets.</para>
-
-      <para>Meanings of specific keywords:</para>
-
-      <variablelist>
-
-	<varlistentry>
-	  <term><literal>#include &lt;file.h&gt;</literal></term>
-	  <term><literal>#include "file.h"</literal></term>
-	  <listitem>
-	    <para>The specified file gets included into the C program,
-            the compiled Haskell file, and the C header.
-            <literal>&lt;HsFFI.h&gt;</literal> is included
-            automatically.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#define name</literal></term>
-	  <term><literal>#define name value</literal></term>
-	  <term><literal>#undef name</literal></term>
-	  <listitem>
-	    <para>Similar to <literal>#include</literal>. Note that
-            <literal>#includes</literal> and
-            <literal>#defines</literal> may be put in the same file
-            twice so they should not assume otherwise.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#let name parameters = "definition"</literal></term>
-	  <listitem>
-            <para>Defines a macro to be applied to the Haskell
-            source. Parameter names are comma-separated, not
-            inside parens. Such macro is invoked as other
-            <literal>#</literal>-constructs, starting with
-            <literal>#name</literal>. The definition will be
-            put in the C program inside parens as arguments of
-            <literal>printf</literal>. To refer to a parameter,
-            close the quote, put a parameter name and open the
-            quote again, to let C string literals concatenate.
-            Or use <literal>printf</literal>'s format directives.
-            Values of arguments must be given as strings, unless the
-            macro stringifies them itself using the C preprocessor's
-            <literal>#parameter</literal> syntax.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#def C_definition</literal></term>
-	  <listitem>
-	    <para>The definition (of a function, variable, struct or
-            typedef) is written to the C file, and its prototype or
-            extern declaration to the C header. Inline functions are
-            handled correctly.  struct definitions and typedefs are
-            written to the C program too.  The
-            <literal>inline</literal>, <literal>struct</literal> or
-            <literal>typedef</literal> keyword must come just after
-            <literal>def</literal>.</para>
-
-	    <note><para>A <literal>foreign import</literal> of a
-	    C function may be inlined across a module boundary,
-	    in which case you must arrange for the importing
-	    module to <literal>#include</literal> the C header
-	    file generated by <command>hsc2hs</command> (see
-	    <xref linkend="glasgow-foreign-headers"/>).
-	    For this reason we avoid using <literal>#def</literal>
-	    in the libraries.</para></note>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#if condition</literal></term>
-	  <term><literal>#ifdef name</literal></term>
-	  <term><literal>#ifndef name</literal></term>
-	  <term><literal>#elif condition</literal></term>
-	  <term><literal>#else</literal></term>
-	  <term><literal>#endif</literal></term>
-	  <term><literal>#error message</literal></term>
-	  <term><literal>#warning message</literal></term>
-	  <listitem>
-	    <para>Conditional compilation directives are passed
-            unmodified to the C program, C file, and C header. Putting
-            them in the C program means that appropriate parts of the
-            Haskell file will be skipped.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#const C_expression</literal></term>
-	  <listitem>
-	    <para>The expression must be convertible to
-            <literal>long</literal> or <literal>unsigned
-            long</literal>.  Its value (literal or negated literal)
-            will be output.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#const_str C_expression</literal></term>
-	  <listitem>
-	    <para>The expression must be convertible to const char
-            pointer.  Its value (string literal) will be output.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#type C_type</literal></term>
-	  <listitem>
-	    <para>A Haskell equivalent of the C numeric type will be
-            output.  It will be one of
-            <literal>{Int,Word}{8,16,32,64}</literal>,
-            <literal>Float</literal>, <literal>Double</literal>,
-            <literal>LDouble</literal>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#peek struct_type, field</literal></term>
-	  <listitem>
-	    <para>A function that peeks a field of a C struct will be
-	    output.  It will have the type
-              <literal>Storable b => Ptr a -> IO b</literal>.
-
-            The intention is that <literal>#peek</literal> and
-            <literal>#poke</literal> can be used for implementing the
-            operations of class <literal>Storable</literal> for a
-            given C struct (see the
-            <literal>Foreign.Storable</literal> module in the library
-            documentation).</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#poke struct_type, field</literal></term>
-	  <listitem>
-	    <para>Similarly for poke. It will have the type
-              <literal>Storable b => Ptr a -> b -> IO ()</literal>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#ptr struct_type, field</literal></term>
-	  <listitem>
-	    <para>Makes a pointer to a field struct. It will have the type
-            <literal>Ptr a -> Ptr b</literal>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#offset struct_type, field</literal></term>
-	  <listitem>
-	    <para>Computes the offset, in bytes, of
- 	    <literal>field</literal> in
- 	    <literal>struct_type</literal>. It will have type
- 	    <literal>Int</literal>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#size struct_type</literal></term>
-	  <listitem>
-		<para>Computes the size, in bytes, of
-		<literal>struct_type</literal>. It will have type
-		<literal>Int</literal>.</para>
-	  </listitem>
-	</varlistentry>
-
-	<varlistentry>
-	  <term><literal>#enum type, constructor, value, value, ...</literal></term>
-	  <listitem>
-	    <para>A shortcut for multiple definitions which use
-	    <literal>#const</literal>. Each <literal>value</literal>
-	    is a name of a C integer constant, e.g. enumeration value.
-	    The name will be translated to Haskell by making each
-	    letter following an underscore uppercase, making all the rest
-	    lowercase, and removing underscores. You can supply a different
-	    translation by writing <literal>hs_name = c_value</literal>
-	    instead of a <literal>value</literal>, in which case
-	    <literal>c_value</literal> may be an arbitrary expression.
-	    The <literal>hs_name</literal> will be defined as having the
-	    specified <literal>type</literal>. Its definition is the specified
-	    <literal>constructor</literal> (which in fact may be an expression
-	    or be empty) applied to the appropriate integer value. You can
-	    have multiple <literal>#enum</literal> definitions with the same
-	    <literal>type</literal>; this construct does not emit the type
-	    definition itself.</para>
-	  </listitem>
-	</varlistentry>
-      </variablelist>
-
-    </sect2>
-
-    <sect2>
-      <title>Custom constructs</title>
-
-      <para><literal>#const</literal>, <literal>#type</literal>,
-      <literal>#peek</literal>, <literal>#poke</literal> and
-      <literal>#ptr</literal> are not hardwired into the
-      <command>hsc2hs</command>, but are defined in a C template that is
-      included in the C program: <filename>template-hsc.h</filename>.
-      Custom constructs and templates can be used too. Any
-      <literal>#</literal>-construct with unknown key is expected to
-      be handled by a C template.</para>
-
-      <para>A C template should define a macro or function with name
-      prefixed by <literal>hsc_</literal> that handles the construct
-      by emitting the expansion to stdout. See
-      <filename>template-hsc.h</filename> for examples.</para>
-
-      <para>Such macros can also be defined directly in the
-      source. They are useful for making a <literal>#let</literal>-like
-      macro whose expansion uses other <literal>#let</literal> macros.
-      Plain <literal>#let</literal> prepends <literal>hsc_</literal>
-      to the macro name and wraps the definition in a
-      <literal>printf</literal> call.</para>
-
-    </sect2>
-
-  </sect1>
-
-</chapter>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/users_guide/win32-dlls.xml b/ghc/docs/users_guide/win32-dlls.xml
deleted file mode 100644
index 959f7ce1b6..0000000000
--- a/ghc/docs/users_guide/win32-dlls.xml
+++ /dev/null
@@ -1,493 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<chapter id="win32">
-<title>Running GHC on Win32 systems</title>
-
-<sect1>
-<title>
-Starting GHC on Win32 platforms</title>
-
-<para>
-The installer that installs GHC on Win32 also sets up the file-suffix associations
-for ".hs" and ".lhs" files so that double-clicking them starts <command>ghci</command>.
-</para>
-<para>
-Be aware of that <command>ghc</command> and <command>ghci</command> do
-require filenames containing spaces to be escaped using quotes:
-<programlisting>
-  c:\ghc\bin\ghci "c:\\Program Files\\Haskell\\Project.hs"
-</programlisting>
-If the quotes are left off in the above command, <command>ghci</command> will
-interpret the filename as two, "c:\\Program" and "Files\\Haskell\\Project.hs".
-</para>
-
-<!-- not clear whether there are current editions of Win32 OSes that
-     doesn't do this by default.
-
-<para> Solution: don't use "Open With...", avoid spaces in file names, 
-or fiddle with the appropriate registry setting:
-<programlisting>
-  HKEY_CLASSES_ROOT\Unknown\shell\openas\command
-</programlisting>
-Notice how the "%1" argument is quoted (or not).
-</para>
-<para> This problem doesn't occur when double-clicking.
-</para>
--->
-
-</sect1>
-
-<sect1>
-<title>
-Interacting with the terminal</title>
-
-<para>By default GHC builds applications that open a console window when they start.
-If you want to build a GUI-only application, with no console window, use the flag
-<literal>-optl-mwindows</literal> in the link step.
-</para>
-
-<para>       <emphasis>Warning:</emphasis> Windows GUI-only programs have no
-        stdin, stdout or stderr so using the ordinary Haskell
-        input/output functions will cause your program to fail with an
-        IO exception, such as:
-<screen>
-      Fail: &lt;stdout&gt;: hPutChar: failed (Bad file descriptor)
-</screen>
-        However using Debug.Trace.trace is alright because it uses
-        Windows debugging output support rather than stderr.</para>
-
-<para>For some reason, Mingw ships with the <literal>readline</literal> library,
-but not with the <literal>readline</literal> headers. As a result, GHC (like Hugs) does not
-use <literal>readline</literal> for interactive input on Windows.
-You can get a close simulation by using an emacs shell buffer!
-</para>
-
-</sect1>
-
-<sect1>
-<title>
-Differences in library behaviour </title>
-
-<para>
-Some of the standard Haskell libraries behave slightly differently on Windows.
-
-<itemizedlist>
-<listitem> <para>
-On Windows, the '<literal>^Z</literal>' character is interpreted as an
-end-of-file character, so if you read a file containing this character
-the file will appear to end just before it. To avoid this,
-use <literal>IOExts.openFileEx</literal> to open a file in binary
-(untranslated) mode or change an already opened file handle into
-binary mode using <literal>IOExts.hSetBinaryMode</literal>. The
-<literal>IOExts</literal> module is part of the
-<literal>lang</literal> package.
-</para>
-</listitem>
-</itemizedlist>
-</para>
-</sect1>
-
-<sect1>
-<title>
-Using GHC (and other GHC-compiled executables) with cygwin</title>
-
-<sect2>
-<title>Background</title> <para>The cygwin tools aim to provide a
-unix-style API on top of the windows libraries, to facilitate ports of
-unix software to windows. To this end, they introduce a unix-style
-directory hierarchy under some root directory (typically
-<filename>/</filename> is <filename>C:\cygwin\</filename>). Moreover,
-everything built against the cygwin API (including the cygwin tools
-and programs compiled with cygwin's ghc) will see / as the root of
-their file system, happily pretending to work in a typical unix
-environment, and finding things like <filename>/bin</filename> and <filename>/usr/include</filename> without
-ever explicitly bothering with their actual location on the windows
-system (probably <filename>C:\cygwin\bin</filename> and <filename>C:\cygwin\usr\include</filename>).
-</para>
-</sect2>
-
-<sect2><title>The problem</title>
-<para>GHC, by default, no longer depends on cygwin, but is a native
-windows program. It is built using mingw, and it uses mingw's ghc
-while compiling your Haskell sources (even if you call it from
-cygwin's bash), but what matters here is that - just like any other
-normal windows program - neither GHC nor the executables it produces
-are aware of cygwin's pretended unix hierarchy. GHC will happily
-accept either '/' or '\' as path separators, but it won't know where
-to find <filename>/home/joe/Main.hs</filename> or <filename>/bin/bash</filename> 
-or the like. This causes all
-kinds of fun when GHC is used from within cygwin's bash, or in
-make-sessions running under cygwin.
-</para>
-</sect2>
-
-<sect2><title>Things to do</title>
-<itemizedlist>
-<listitem>
-<para> Don't use absolute paths in make, configure &amp; co if there is any chance 
-  that those might be passed to GHC (or to GHC-compiled programs). Relative
-  paths are fine because cygwin tools are happy with them and GHC accepts 
-  '/' as path-separator. And relative paths don't depend on where cygwin's
-  root directory is located, or on which partition or network drive your source
-  tree happens to reside, as long as you 'cd' there first.
-</para></listitem>
-
-<listitem>
-<para> If you have to use absolute paths (beware of the innocent-looking
-  <literal>ROOT=`pwd`</literal> in makefile hierarchies or configure scripts), cygwin provides
-  a tool called <command>cygpath</command> that can convert cygwin's unix-style paths to their
-  actual windows-style counterparts. Many cygwin tools actually accept
-  absolute windows-style paths (remember, though, that you either need 
-  to escape '\' or convert '\' to '/'), so you should be fine just using those 
-  everywhere. If you need to use tools that do some kind of path-mangling 
-  that depends on unix-style paths (one fun example is trying to interpret ':' 
-  as a separator in path lists..), you can still try to convert paths using 
-  <command>cygpath</command> just before they are passed to GHC and friends.
-</para></listitem>
-  
-<listitem>
-<para> If you don't have <command>cygpath</command>, you probably don't have cygwin and hence
-  no problems with it... unless you want to write one build process for several
-  platforms. Again, relative paths are your friend, but if you have to use
-  absolute paths, and don't want to use different tools on different platforms,
-  you can simply write a short Haskell program to print the current directory
-   (thanks to George Russell for this idea): compiled with GHC, this will give 
-  you the view of the file system that GHC depends on (which will differ 
-  depending on whether GHC is compiled with cygwin's gcc or mingw's
-  gcc or on a real unix system..) - that little program can also deal with 
-  escaping '\' in paths. Apart from the banner and the startup time, 
-  something like this would also do:
-<programlisting>
-  $ echo "Directory.getCurrentDirectory >>= putStrLn . init . tail . show " | ghci
-</programlisting>
-</para></listitem>
-</itemizedlist>
-</sect2>
-</sect1>
-
-
-<sect1 id="win32-dlls">
-<title>Building and using Win32 DLLs
-</title>
-
-<para>
-<emphasis>Making Haskell libraries into DLLs doesn't work on Windows at the
-moment; however, all the machinery is
-still there. If you're interested, contact the GHC team. Note that
-building an entire Haskell application as a single DLL is still supported: it's
-	just multi-DLL Haskell programs that don't work.  The Windows
-	distribution of GHC contains static libraries only.</emphasis></para>
-
-<!--
-<para>
-<indexterm><primary>Dynamic link libraries, Win32</primary></indexterm>
-<indexterm><primary>DLLs, Win32</primary></indexterm>
-On Win32 platforms, the compiler is capable of both producing and using
-dynamic link libraries (DLLs) containing ghc-compiled code. This
-section shows you how to make use of this facility.
-</para>
-
-<para>
-Until recently, <command>strip</command> didn't work reliably on DLLs, so you
-should test your version with care, or make sure you have the latest
-binutils. Unfortunately, we don't know exactly which version of binutils
-cured the problem (it was supposedly fixed some years ago).
-</para>
-
-
-<sect2 id="win32-dlls-link">
-<title>Linking with DLLs</title>
-
-<para>
-The default on Win32 platforms is to link applications in such a way
-that the executables will use the Prelude and system libraries DLLs,
-rather than contain (large chunks of) them. This is transparent at the
-command-line, so 
-</para>
-
-<para>
-<screen>
-sh$ cat main.hs
-module Main where
-main = putStrLn "hello, world!"
-sh$ ghc -o main main.hs
-ghc: module version changed to 1; reason: no old .hi file
-sh$ strip main.exe
-sh$ ls -l main.exe
--rwxr-xr-x   1 544      everyone     4608 May  3 17:11 main.exe*
-sh$ ./main
-hello, world!
-sh$ 
-</screen>
-</para>
-
-<para>
-will give you a binary as before, but the <filename>main.exe</filename>
-generated will use the Prelude and RTS DLLs instead of linking them in
-statically.
-</para>
-
-<para>
-4K for a <literal>"hello, world"</literal> application&mdash;not bad, huh? :-)
-</para>
-
-</sect2>
-
-<sect2 id="win32-dlls-linking-static">
-<title>Not linking with DLLs
-<indexterm><primary>-static option (Win32)</primary></indexterm></title>
-
-<para>
-If you want to build an executable that doesn't depend on any
-ghc-compiled DLLs, use the <option>-static</option> option to link in
-the code statically.
-</para>
-
-<para>
-Notice that you cannot mix code that has been compiled with
-<option>-static</option> and not, so you have to use the <option>-static</option>
-option on all the Haskell modules that make up your application.
-</para>
-
-</sect2>
--->
-
-<sect2 id="win32-dlls-create">
-<title>Creating a DLL</title>
-
-<para>
-<indexterm><primary>Creating a Win32 DLL</primary></indexterm>
-<indexterm><primary>&ndash;&ndash;mk-dll</primary></indexterm>
-Sealing up your Haskell library inside a DLL is straightforward;
-compile up the object files that make up the library, and then build
-the DLL by issuing a command of the form:
-</para>
-
-<para>
-<screen>
-ghc &ndash;&ndash;mk-dll -o foo.dll bar.o baz.o wibble.a -lfooble
-</screen>
-</para>
-
-<para>
-By feeding the ghc compiler driver the option <option>&ndash;&ndash;mk-dll</option>, it
-will build a DLL rather than produce an executable. The DLL will
-consist of all the object files and archives given on the command
-line.
-</para>
-
-<!--
-<para>
-To create a `static' DLL, i.e. one that does not depend on the GHC DLLs,
-use the <option>-static</option> when compiling up your Haskell code and
-building the DLL.
-</para>
--->
-
-<para>
-A couple of things to notice:
-</para>
-
-<para>
-
-<itemizedlist>
-<!--
-<listitem>
-<para>
-Since DLLs correspond to packages (see <xref linkend="packages"/>) you need
-to use <option>-package-name dll-name</option> when compiling modules that
-belong to a DLL if you're going to call them from Haskell. Otherwise, Haskell
-code that calls entry points in that DLL will do so incorrectly, and crash.
-For similar reasons, you can only compile a single module tree into a DLL,
-as <function>startupHaskell</function> needs to be able to call its
-initialisation function, and only takes one such argument (see <xref
-linkend="win32-dlls-foreign"/>). Hence the modules
-you compile into a DLL must have a common root.
-</para>
-</listitem>
--->
-
-<listitem>
-<para>
-By default, the entry points of all the object files will be exported from
-the DLL when using <option>&ndash;&ndash;mk-dll</option>. Should you want to constrain
-this, you can specify the <emphasis>module definition file</emphasis> to use
-on the command line as follows:
-
-<screen>
-ghc &ndash;&ndash;mk-dll -o .... -optdll&ndash;&ndash;def -optdllMyDef.def
-</screen>
-
-See Microsoft documentation for details, but a module definition file
-simply lists what entry points you want to export. Here's one that's
-suitable when building a Haskell COM server DLL:
-
-<programlisting>
-EXPORTS
- DllCanUnloadNow     = DllCanUnloadNow@0
- DllGetClassObject   = DllGetClassObject@12
- DllRegisterServer   = DllRegisterServer@0
- DllUnregisterServer = DllUnregisterServer@0
-</programlisting>
-</para>
-</listitem>
-
-<listitem>
-<para>
-In addition to creating a DLL, the <option>&ndash;&ndash;mk-dll</option> option also
-creates an import library. The import library name is derived from the
-name of the DLL, as follows:
-
-<programlisting>
-DLL: HScool.dll  ==&#62; import lib: libHScool_imp.a
-</programlisting>
-
-The naming scheme may look a bit weird, but it has the purpose of allowing
-the co-existence of import libraries with ordinary static libraries (e.g.,
-<filename>libHSfoo.a</filename> and
-<filename>libHSfoo&lowbar;imp.a</filename>.
-
-Additionally, when the compiler driver is linking in non-static mode, it
-will rewrite occurrence of <option>-lHSfoo</option> on the command line to
-<option>-lHSfoo&lowbar;imp</option>. By doing this for you, switching from
-non-static to static linking is simply a question of adding
-<option>-static</option> to your command line.
-
-</para>
-</listitem>
-</itemizedlist>
-</para>
-
-</sect2>
-
-
-<sect2 id="win32-dlls-foreign">
-<title>Making DLLs to be called from other languages</title>
-
-<para>
-
-If you want to package up Haskell code to be called from other languages,
-such as Visual Basic or C++, there are some extra things it is useful to
-know. The dirty details are in the <emphasis>Foreign Function
-Interface</emphasis> definition, but it can be tricky to work out how to
-combine this with DLL building, so here's an example:
-
-</para>
-
-<itemizedlist>
-
-<listitem>
-<para>
-Use <literal>foreign export</literal> declarations to export the Haskell
-functions you want to call from the outside. For example,
-
-<programlisting>
-module Adder where
-
-adder :: Int -> Int -> IO Int  &ndash;&ndash; gratuitous use of IO
-adder x y = return (x+y)
-
-foreign export stdcall adder :: Int -> Int -> IO Int
-</programlisting>
-</para>
-</listitem>
-
-<listitem>
-<para>
-Compile it up:
-
-<screen>
-ghc -c adder.hs -fglasgow-exts
-</screen>
-  
-This will produce two files, adder.o and adder_stub.o
-</para>
-</listitem>
-
-<listitem>
-<para>
-compile up a <function>DllMain()</function> that starts up the Haskell
-RTS-&ndash;&ndash;a possible implementation is:
-
-<programlisting>
-#include &lt;windows.h&gt;
-#include &lt;Rts.h&gt;
-
-extern void__stginit_Adder(void);
-
-static char* args[] = { "ghcDll", NULL };
-                       /* N.B. argv arrays must end with NULL */
-BOOL
-STDCALL
-DllMain
-   ( HANDLE hModule
-   , DWORD reason
-   , void* reserved
-   )
-{
-  if (reason == DLL_PROCESS_ATTACH) {
-      /* By now, the RTS DLL should have been hoisted in, but we need to start it up. */
-      startupHaskell(1, args, __stginit_Adder);
-      return TRUE;
-  }
-  return TRUE;
-}
-</programlisting>
-
-Here, <literal>Adder</literal> is the name of the root module in the module
-tree (as mentioned above, there must be a single root module, and hence a
-single module tree in the DLL).
-
-Compile this up:
-
-<screen>
-ghc -c dllMain.c
-</screen>
-</para>
-</listitem>
-
-<listitem>
-<para>
-Construct the DLL:
-
-<screen>
-ghc &ndash;&ndash;mk-dll -o adder.dll adder.o adder_stub.o dllMain.o
-</screen>
-
-</para>
-</listitem>
-
-<listitem>
-<para>
-Start using <function>adder</function> from VBA-&ndash;&ndash;here's how I would
-<constant>Declare</constant> it:
-
-<programlisting>
-Private Declare Function adder Lib "adder.dll" Alias "adder@8"
-      (ByVal x As Long, ByVal y As Long) As Long
-</programlisting>
-
-Since this Haskell DLL depends on a couple of the DLLs that come with GHC,
-make sure that they are in scope/visible.
-</para>
-
-<para>
-Building statically linked DLLs is the same as in the previous section: it
-suffices to add <option>-static</option> to the commands used to compile up
-the Haskell source and build the DLL.
-</para>
-
-</listitem>
-
-</itemizedlist>
-
-</sect2>
-
-</sect1>
-</chapter>
-
-<!-- Emacs stuff:
-     ;;; Local Variables: ***
-     ;;; mode: xml ***
-     ;;; sgml-parent-document: ("users_guide.xml" "book" "chapter") ***
-     ;;; End: ***
- -->
diff --git a/ghc/docs/vh/Makefile b/ghc/docs/vh/Makefile
deleted file mode 100644
index 4410e4953d..0000000000
--- a/ghc/docs/vh/Makefile
+++ /dev/null
@@ -1,7 +0,0 @@
-TOP = ../..
-include $(TOP)/mk/boilerplate.mk
-
-XML_DOC = vh
-INSTALL_XML_DOC = vh
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/docs/vh/vh.xml b/ghc/docs/vh/vh.xml
deleted file mode 100644
index f7d636a71f..0000000000
--- a/ghc/docs/vh/vh.xml
+++ /dev/null
@@ -1,319 +0,0 @@
-<?xml version="1.0" encoding="iso-8859-1"?>
-<!DOCTYPE article PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
-   "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
-]>
-
-  <article id="visual-haskell">
-  
-    <articleinfo>
-
-      <title>Visual Haskell User's Guide</title>
-    <author>
-      <firstname>Simon</firstname>
-      <surname>Marlow</surname>
-      <email>simonmar@microsoft.com</email>
-    </author>
-    <author>
-      <firstname>Krasimir</firstname>
-      <surname>Angelov</surname>
-      <email>kr.angelov@gmail.com</email>
-    </author>
-
-<!--
-    <abstract>
-      <para></para>
-    </abstract>
--->
-
-    </articleinfo>
-
-    <section id="sec-introduction">
-      <title>Introduction</title>
-      
-      <para>Visual Haskell is a plugin for Microsoft's Visual Studio
-	development environment to support development of Haskell software.
-	Like the other Visual languages, Visual Haskell integrates with the
-	Visual Studio editor to provide interactive features to aid Haskell
-	development, and it enables the construction of projects consisting of
-	multiple Haskell modules.</para>
-
-      <section id="sec-obtaining">
-	<title>Installing Visual Haskell</title>
-
-	<para>In order to use Visual Haskell, you need <ulink url="http://msdn.microsoft.com/vstudio/productinfo/">Visual Studio .NET
-	  2003</ulink>.  Right now, this is the only supported version of Visual
-	  Studio - unfortunately we haven't yet added support for the 2005
-	  Beta.  The Express languages (Visual C++ Express etc.) also will not
-	  work, because they don't have support for plugins.</para>
-
-	<para>You don't need to install GHC separately: Visual Haskell
-	  is bundled with a complete GHC distribution, and various other tools
-	  (Happy, Alex, Haddock).</para>
-
-	<para>The latest Visual Haskell installer can be obtained from
-	  here:</para>
-
-	<para><ulink
-	  url="http://www.haskell.org/visualhaskell/"><literal>http://www.haskell.org/visualhaskell/</literal></ulink></para>
-      </section>
-
-      <section id="release-notes">
-	<title>Release Notes</title>
-
-	<section>
-	  <title>Version 0.0, first release</title>
-	  
-	  <para>This release is a technology preview, and should be considered
-	    alpha quality.  It works for us, but you are fairly likely to
-	    encounter problems.  If you're willing to try it out and report
-	    bugs, we'd be grateful for the feedback.</para>
-
-	  <itemizedlist>
-	    <listitem>
-	      <para>This release of Visual Haskell is bundled with a
-		development snapshot of GHC, version 6.5 from around 14
-		September 2005.  This version of GHC is used to provide the
-		interactive editing features, and will be used to compile all
-		code inside Visual Haskell.  It is possible that in future
-		releases we may be able to relax this tight coupling between
-		Visual Haskell and the bundled GHC.</para>
-
-	      <para>Please note that future releases of Visual
-		Haskell will update the compiler, and hence the
-		packages, and so may break your code.  Also note that because
-		the bundled GHC is not a released version, it may have bugs and
-		quirks itself: please report them as usual to
-		<email>glasgow-haskell-bugs@haskell.org</email>.</para>
-	  </listitem>
-
-	  <listitem>
-	    <para>We're not making source code for the plugin generally
-	      available at this time, due to licensing restrictions on the
-	      Visual Studio APIs that the plugin uses (for more
-	      information see <ulink
-		url="http://msdn.microsoft.com/vstudio/extend/">Visual Studio
-		Extensibility Center</ulink>).  If you're interested in
-	      contributing to Visual Haskell, please get in touch with the
-	      authors.</para>
-	  </listitem>
-	</itemizedlist>
-      </section>
-    </section>
-
-      <section id="sec-bugs">
-	<title>Getting support, reporting bugs</title>
-	<para>Please report bugs to
-	  <email>glasgow-haskell-bugs@haskell.org</email> (subscribe <ulink url="http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs">here</ulink>), clearly indicating
-	  that your bug report relates to Visual Haskell, and giving as much
-	  information as possible so that we can reproduce the bug.  Even if
-	  you can't reproduce the bug reliably, it is still useful to report
-	  what you've seen.</para>
-
-	<para>For help and support, use the
-	  <email>glasgow-haskell-users@haskell.org</email> (subscribe <ulink
-	    url="http://www.haskell.org/mailman/listinfo/glasgow-haskell-users">here</ulink>) mailing list.</para>
-      </section>
-
-      <section id="sec-license">
-	<title>License</title>
-
-      <blockquote>
-	<para>Copyright © Microsoft Corporation. All rights reserved.</para>
-	<para>Copyright © The University of Glasgow. All rights reserved.</para>
-	<para>Copyright © Krasimir Angelov. All rights reserved.</para>
-
-	<para>Redistribution and use in source and binary forms, with or without
-	  modification,  are permitted provided that the following conditions
-	  are met:</para>
-
-	<itemizedlist>
-	  <listitem>
-	    <para>Redistributions of source code must retain the above
-	      copyright notice, this list of conditions and the following
-	      disclaimer.</para>
-	  </listitem>
- 
-	  <listitem>
-	    <para>Redistributions in binary form must reproduce the above
-	      copyright notice, this list of conditions and the following
-	      disclaimer in the documentation and/or other materials provided
-	      with the distribution.</para>
-	  </listitem>
-
-	  <listitem>
-	    <para>The names of the copyright holders may not be used to endorse
-	      or promote products derived from this software without specific
-	      prior written permission.</para>
-	  </listitem>
-	</itemizedlist>
-
-	<para>THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS
-	  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-	  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-	  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-	  COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-	  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-	  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
-	  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
-	  AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-	  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
-	  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-	  POSSIBILITY OF SUCH DAMAGE.</para>
-      </blockquote>
-    </section>
-
-    </section>
-
-    <section id="sec-using">
-      <title>Using Visual Haskell</title>
-
-      <section>
-	<title>Overview of features</title>
-
-	<para>The following features are provided in the Visual Studio editor
-	  when editing Haskell code:</para>
-
-	<itemizedlist>
-	  <listitem>
-	    <para>Automatic checking of code as you type, and visual indication
-	      of parse errors, scoping errors and type errors.</para>
-	  </listitem>
-	  
-	  <listitem>
-	  <para>Quick info: hovering the mouse over an identifier pops up
-	    an information box, including the type of the identifier.</para>
-	  </listitem>
-
-	  <listitem>
-	  <para>A drop-down bar at the top of the editing window lists the
-	    top-level declarations in the module, and allows quick navigation
-	    to a declaration.</para>
-	  </listitem>
-
-	  <listitem>
-	  <para>Name completion for identifiers in scope: press Ctrl+Space
-	    after a partial identifier to see the completions.</para>
-	  </listitem>
-
-	  <listitem>
-	  <para>Go to declaration: right clicking on an identifier and
-	    selecting "Go to declaration" will jump the cursor to the
-	    declaration of the identifier.  This works for locally-defined
-	    identifiers and those defined in another module of the project; it
-	    does not work for library functions currently.</para>
-	  </listitem>
-	</itemizedlist>
-      </section>
-
-      <para>The following features are provided by the project system for
-	constructing Haskell projects:</para>
-
-      <itemizedlist>
-	<listitem>
-	  <para>Multi-module Haskell projects are fully supported, based on the
-	    <ulink url="http://www.haskell.org/cabal">Cabal</ulink>
-	    infrastructure.  A project in Visual Haskell <emphasis>is</emphasis>
-	    a Cabal package, and vice-versa.  A Visual Studio project can be
-	    taken to a machine without Visual Haskell and built/installed as a
-	    normal Cabal package, and an existing Cabal package can be edited
-	    directly in Visual Haskell<footnote><para>This works as long as the
-		Cabal package is using Cabal's simple build system; Cabal
-		packages using their own build systems cannot be edited in Visual
-		Haskell.</para>
-	    </footnote>.</para>
-	</listitem>
-
-	<listitem>
-	  <para>Editing of most of the package meta-data is supported through
-	    the project property pages.</para>
-	</listitem>
-
-	<listitem>
-	  <para>The interactive editing features work across multiple modules in
-	    a project.  When one module is edited, changes are automatically
-	    propagated to dependent modules, even if the edited module has not yet
-	    been saved.</para>
-	</listitem>
-
-	<listitem>
-	  <para>Building is supported through the Cabal build system, and build
-	    errors are communicated back to the editor and placed in the task
-	    list.  Use any of the Visual Studio build commands (e.g. Build
-	    Project from the context menu on the project, or Ctrl-Shift-B to
-	    build the whole solution).</para>
-	</listitem>
-
-      </itemizedlist>
-    
-    <para>Additionally, Visual Haskell is bundled with a large collection of
-      documentation: the GHC manual, the hierarchical libraries reference, and
-      other material all of which can be browsed within Visual Studio
-      itself.</para>
-
-    <section>
-      <title>Getting Started</title>
-      
-      <para>After installing Visual Haskell, start up Visual Studio as you
-	would normally, and observe that on the splash screen where it lists
-	the supported languages you should now see an icon for Visual
-	Haskell (if you don't see this, something has gone wrong... please let
-	us know).</para>
-      
-      <para>Firstly, take a look at the bundled documentation.  Go to
-	Help-&gt;Contents, and you should see the &ldquo;Visual Haskell Help
-	Collection&rdquo;, which contains a large collection of GHC and
-	Haskell-related documentaiton, including this document.</para>
-
-      <para>To start using Visual Haskell right away, create a new
-	project (File-&gt;New-&gt;Project...).  Select one of the Haskell
-	project types (Console Application or Library Package), and hit Ok.
-	The project will be created for you, and an example module
-	added: <literal>Main.hs</literal> for an application, or
-	<literal>Module1.hs</literal> for a library.</para>
-      
-      <para>You can now start adding code to
-	<literal>Main.hs</literal>, or adding new modules.  To add a new
-	module, right-click on the <literal>src</literal> directory, and
-	select Add-&gt;New Item.  Visual Haskell supports hierarchical
-	modules too: you can add new folders using the same Add menu to
-	create new nodes in the hierarchy.</para>
-      
-      <para>If you have any errors in your code, they will be underlined with
-	a red squiggly line.  Select the Tasks window (usually a tab near the
-	bottom of the Visual Studio window) to see the error messages, and
-	click on an error message to jump to it in the editor.</para>
-      
-      <para>To build the program, hit Ctrl-Shift-B, or select one of the
-	options from the Build menu.</para>
-    </section>
-
-    <section>
-      <title>Editing Haskell code</title>
-
-	<para>(ToDo: more detail here)</para>
-
-	<para>Your module must be plain Haskell (<literal>.hs</literal>) for the interactive features to
-	fully work.  If your module is pre-processed with CPP or Literate
-	  Haskell, then Visual Haskell will only check the module when it is
-	  saved; between saves the source will not be checked for errors and
-	  the type information will not be updated.  If the source file is
-	  pre-processed with Happy or another pre-processor, then you may have
-	  to build the project before the type information will be updated
-	  (because the pre-processor is only run as part of the build
-	  process).  Pre-processed source files work fine in a multi-module
-	  setting; you can have modules which depend on a pre-processed module
-	  and full interactive checking will still be available in those
-	  modules.</para>
-
-	<para>Because Visual Haskell is using GHC as a backend for its
-	  interactive editing features, it supports the full GHC language,
-	  including all extensions.</para>
-      </section>
-
-      <section>
-	<title>Using Projects</title>
-	<para>(ToDo: more detail here)</para>
-      </section>
-
-    </section>
-  </article>
diff --git a/ghc/driver/Makefile b/ghc/driver/Makefile
deleted file mode 100644
index 3a87ab43c5..0000000000
--- a/ghc/driver/Makefile
+++ /dev/null
@@ -1,28 +0,0 @@
-# -----------------------------------------------------------------------------=
-# $Id: Makefile,v 1.76 2005/03/02 09:49:11 simonmar Exp $
-#
-# (c) The University of Glasgow 2002
-#
-
-TOP=..
-include $(TOP)/mk/boilerplate.mk
-
-SUBDIRS = mangler split ghc ghci
-
-boot all :: package.conf.inplace package.conf
-
-package.conf.inplace :
-	echo "[]" > $@
-
-package.conf :
-	echo "[]" > $@
-
-override datadir = $(libdir)
-INSTALL_DATAS += package.conf ghc-usage.txt ghci-usage.txt
-
-# Since cleaning effectively uninstalls all the packages, we must 
-# remove the stamp files that the build system uses to avoid unnecessarily
-# re-installing packages.
-CLEAN_FILES += package.conf* stamp-pkg-conf*
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/driver/ghc-usage.txt b/ghc/driver/ghc-usage.txt
deleted file mode 100644
index e95d5846b9..0000000000
--- a/ghc/driver/ghc-usage.txt
+++ /dev/null
@@ -1,80 +0,0 @@
-Usage:
-
-    $$ [command-line-options-and-input-files]
-
-To compile and link a complete Haskell program, run the compiler like
-so:
-
-    $$ --make Main
-
-where the module Main is in a file named Main.hs (or Main.lhs) in the
-current directory.  The other modules in the program will be located
-and compiled automatically, and the linked program will be placed in
-the file `a.out' (or `Main.exe' on Windows).
-
-Alternatively, $$ can be used to compile files individually.  Each
-input file is guided through (some of the) possible phases of a
-compilation:
-
-    - unlit:	extract code from a "literate program"
-    - hscpp:	run code through the C pre-processor (if -cpp flag given)
-    - hsc:	run the Haskell compiler proper
-    - gcc:	run the C compiler (if compiling via C)
-    - as:	run the assembler
-    - ld:	run the linker
-
-For each input file, the phase to START with is determined by the
-file's suffix:
-
-    - .lhs	literate Haskell		 unlit
-    - .hs	plain Haskell			 ghc
-    - .hc	C from the Haskell compiler	 gcc
-    - .c	C not from the Haskell compiler  gcc
-    - .s	assembly language		 as
-    - other	passed directly to the linker	 ld
-
-The phase at which to STOP processing is determined by a command-line
-option:
-
-    -E		stop after generating preprocessed, de-litted Haskell
-		     (used in conjunction with -cpp)
-    -C		stop after generating C (.hc output)
-    -S		stop after generating assembler (.s output)
-    -c		stop after generating object files (.o output)
-
-Other commonly-used options are:
-
-    -v[n]	    Control verbosity (n is 0--5, normal verbosity level is 1,
-	              -v alone is equivalent to -v3)
-
-    -fglasgow-exts  Allow Glasgow extensions (unboxed types, etc.)
-
-    -O		    An `optimising' package of compiler flags, for faster code
-
-    -prof	    Compile for cost-centre profiling
-		     (add -auto-all for automagic cost-centres on all
-		      top-level functions)
-
-    -H14m	    Increase compiler's heap size (might make compilation
-		    faster, especially on large source files).
-
-    -M              Output Makefile rules recording the
-		    dependencies of a list of Haskell files.
-
-Given the above, here are some TYPICAL invocations of $$:
-
-    # compile a Haskell module to a .o file, optimising:
-    % $$ -c -O Foo.hs
-    # link three .o files into an executable called "test":
-    % $$ -o test Foo.o Bar.o Baz.o
-    # compile a Haskell module to C (a .hc file), using a bigger heap:
-    % $$ -C -H16m Foo.hs
-    # compile Haskell-produced C (.hc) to assembly language:
-    % $$ -S Foo.hc
-
-The User's Guide has more information about GHC's *many* options.  An
-online copy can be found here:
-
-   http://www.haskell.org/ghc/documentation.html
-
-------------------------------------------------------------------------
diff --git a/ghc/driver/ghc/Makefile b/ghc/driver/ghc/Makefile
deleted file mode 100644
index 26965569a4..0000000000
--- a/ghc/driver/ghc/Makefile
+++ /dev/null
@@ -1,31 +0,0 @@
-#-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.6 2001/10/23 16:32:30 rrt Exp $
-#
-
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-# -----------------------------------------------------------------------------
-# ghc script
-
-ifeq "$(BIN_DIST)"   "1"
-GHCBIN=$$\"\"libexecdir/ghc-$(ProjectVersion)
-GHCLIB=$$\"\"libdir
-else
-GHCBIN=$(libexecdir)/ghc-$(ProjectVersion)
-GHCLIB=$(libdir)
-endif # BIN_DIST
-
-ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-SCRIPT_PROG  	  = ghc-$(ProjectVersion)
-LINK 		  = ghc
-endif
-SCRIPT_OBJS	  = ghc.sh
-INTERP		  = $(SHELL)
-TOPDIROPT	  = -B$(GHCLIB)
-SCRIPT_SUBST_VARS = GHCBIN TOPDIROPT
-INSTALL_SCRIPTS  += $(SCRIPT_PROG)
-
-# -----------------------------------------------------------------------------
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/driver/ghc/ghc.sh b/ghc/driver/ghc/ghc.sh
deleted file mode 100644
index 780b9498be..0000000000
--- a/ghc/driver/ghc/ghc.sh
+++ /dev/null
@@ -1,2 +0,0 @@
-# Mini-driver for GHC
-exec $GHCBIN $TOPDIROPT ${1+"$@"}
diff --git a/ghc/driver/ghci-usage.txt b/ghc/driver/ghci-usage.txt
deleted file mode 100644
index 4a633fc3e1..0000000000
--- a/ghc/driver/ghci-usage.txt
+++ /dev/null
@@ -1,26 +0,0 @@
-Usage:
-
-    ghci [command-line-options-and-input-files]
-
-The kinds of input files that can be given on the command-line
-include:
-
-  - Haskell source files (.hs or .lhs suffix)
-  - Object files (.o suffix, or .obj on Windows)
-  - Dynamic libraries (.so suffix, or .dll on Windows)
-
-In addition, ghci accepts most of the command-line options that plain
-GHC does.  Some of the options that are commonly used are:
-
-    -fglasgow-exts  Allow Glasgow extensions (unboxed types, etc.)
-
-    -i<dir>         Search for imported modules in the directory <dir>.
-
-    -H32m	    Increase GHC's default heap size to 32m
-
-    -cpp            Enable CPP processing of source files
-
-Full details can be found in the User's Guide, an online copy of which
-can be found here:
-
-    http://www.haskell.org/ghc/documentation.html
diff --git a/ghc/driver/ghci/Makefile b/ghc/driver/ghci/Makefile
deleted file mode 100644
index 9392249f03..0000000000
--- a/ghc/driver/ghci/Makefile
+++ /dev/null
@@ -1,69 +0,0 @@
-#-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.11 2005/05/05 00:58:38 sof Exp $
-#
-
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-# hack for ghci-inplace script, see below
-INSTALLING=1
-
-# -----------------------------------------------------------------------------
-# ghci script
-
-ifeq "$(INSTALLING)" "1"
-ifeq "$(BIN_DIST)"   "1"
-GHCBIN=$$\"\"libexecdir/ghc-$(ProjectVersion)
-GHCLIB=$$\"\"libdir
-else
-GHCBIN=$(libexecdir)/ghc-$(ProjectVersion)
-GHCLIB=$(libdir)
-endif # BIN_DIST
-else
-GHCBIN=$(FPTOOLS_TOP_ABS)/ghc/compiler/ghc-$(ProjectVersion)
-GHCLIB=$(FPTOOLS_TOP_ABS)
-endif
-
-INSTALLED_SCRIPT_PROG  = ghci-$(ProjectVersion)
-INPLACE_SCRIPT_PROG    = ghci-inplace
-
-ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-C_PROG = ghci
-C_OBJS += ghci.res
-else
-C_SRCS=
-endif
-
-SCRIPT_OBJS	  = ghci.sh
-INTERP		  = $(SHELL)
-SCRIPT_SUBST_VARS = GHCBIN TOPDIROPT
-ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-INSTALL_SCRIPTS  += $(SCRIPT_PROG)
-else
-INSTALL_SCRIPTS  += ghcii.sh
-INSTALL_PROGS    += $(C_PROG)
-endif
-TOPDIROPT 	  = -B$(GHCLIB)
-
-ifeq "$(INSTALLING)" "1"
-SCRIPT_PROG 	=  $(INSTALLED_SCRIPT_PROG)
-ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-LINK 		=  ghci
-endif
-else
-SCRIPT_PROG 	=  $(INPLACE_SCRIPT_PROG)
-endif
-
-# don't recurse on 'make install'
-#
-ifeq "$(INSTALLING)" "1"
-all clean distclean maintainer-clean ::
-	$(MAKE) INSTALLING=0 BIN_DIST=0 $(MFLAGS) $@
-endif
-
-ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-ghci.res : ghci.rc ghci.ico
-	windres -o ghci.res -i ghci.rc -O coff
-endif
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/driver/ghci/ghci.c b/ghc/driver/ghci/ghci.c
deleted file mode 100644
index f21a12a4ba..0000000000
--- a/ghc/driver/ghci/ghci.c
+++ /dev/null
@@ -1,168 +0,0 @@
-/*
- *
- * $Id: ghci.c,v 1.10 2005/05/05 00:58:38 sof Exp $
- *
- * ghci wrapper for Win32 only
- * 
- * This wrapper invokes ghc.exe with the added command-line
- *                option "--interactive".
- * (On Unix this is done by the ghci.sh shell script, but
- *  that does not work so well on Win32.)
- *
- * (c) The GHC Team 2001
- *
- * ghc.exe is searched for using the 'normal' search rules
- * for DLLs / EXEs (i.e., first in the same dir as this wrapper,
- * then system dirs, then PATH).
- *
- * To compile:
- *
- *   MSVC:    cl /o ghci.exe /c ghciwrap.c
- *   mingw:   gcc -mno-cygwin -o ghci.exe ghciwrap.c
- *
- * If you want to associate your own icon with the wrapper,
- * here's how to do it:
- *
- *   * Create a one-line .rc file, ghci.rc (say), containing
- *          0 ICON "hsicon.ico"
- *     (subst the string literal for the name of your icon file).
- *   * Compile it up (assuming the .ico file is in the same dir
- *     as the .rc file):
- *
- *         MSVC:    rc /i. /fo ghci.res ghci.rc 
- *         mingw:   windres -o ghci.res -i ghci.rc -O coff
- *
- *   * Add the resulting .res file to the link line of the wrapper:
- *
- *     MSVC:    cl /o ghci.exe /c ghciwrap.c ghci.res
- *     mingw:   gcc -mno-cygwin -o ghci.exe ghciwrap.c ghci.res
- *
- */
-
-#include <windows.h>
-#include <stdio.h>
-#include <process.h>
-#include <malloc.h>
-#include <stdlib.h>
-#include <signal.h>
-#include <io.h>
-
-#define BINARY_NAME "ghc.exe"
-#define IACTIVE_OPTION "--interactive"
-
-#define errmsg(msg) fprintf(stderr, msg "\n"); fflush(stderr)
-#define errmsg1(msg,val) fprintf(stderr, msg "\n",val); fflush(stderr)
-
-int
-main(int argc, char** argv)
-{
-  TCHAR  binPath[FILENAME_MAX+1];
-  TCHAR  binPathShort[MAX_PATH+1];
-  DWORD  dwSize = FILENAME_MAX;
-  TCHAR* szEnd;
-  int    i;
-  char*  new_cmdline;
-  char   *ptr, *src;
-  unsigned int cmdline_len = 0;
-  char **pp;
-  LPTSTR pp1;
-
-  STARTUPINFO si;
-  PROCESS_INFORMATION pi;
-  
-  ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
-  ZeroMemory(&si, sizeof(STARTUPINFO));
-  si.cb = sizeof(STARTUPINFO);
-
-  if ( getenv("_") ) {
-      printf("WARNING: GHCi invoked via 'ghci.exe' in *nix-like shells (cygwin-bash, in particular)\n");
-      printf("         doesn't handle Ctrl-C well; use the 'ghcii.sh' shell wrapper instead\n");
-      fflush(stdout);
-  }
-
-  /* Locate the binary we want to start up */
-  if ( !SearchPath(NULL,
-		   BINARY_NAME,
-		   NULL,
-		   dwSize,
-		   (char*)binPath,
-		   &szEnd) ) {
-    errmsg1("%s: Unable to locate ghc.exe", argv[0]);
-    return 1;
-  }
-  
-  dwSize = MAX_PATH;
-  /* Turn the path into short form - LFN form causes problems
-     when passed in argv[0]. */
-  if ( !(GetShortPathName(binPath, binPathShort, dwSize)) ) {
-    errmsg1("%s: Unable to locate ghc.exe", argv[0]);
-    return 1;
-  }
-  
-  /* Compute length of the flattened 'argv', including extra IACTIVE_OPTION (and spaces!) */
-  cmdline_len += 1 + strlen(IACTIVE_OPTION);
-  for(i=1;i<argc;i++) {
-      /* Note: play it safe and quote all argv strings */
-      cmdline_len += 1 + strlen(argv[i]) + 2;
-  }
-  new_cmdline = (char*)malloc(sizeof(char) * (cmdline_len + 1));
-  if (!new_cmdline) {
-      errmsg1("%s: failed to start up ghc.exe; insufficient memory", argv[0]);
-      return 1;
-  }
-  
-  strcpy(new_cmdline, " " IACTIVE_OPTION);
-  ptr = new_cmdline + strlen(" " IACTIVE_OPTION);
-  for(i=1;i<argc;i++) {
-      *ptr++ = ' ';
-      *ptr++ = '"';
-      src = argv[i];
-      while(*src) {
-	  *ptr++ = *src++;
-      }
-      *ptr++ = '"';
-  }
-  *ptr = '\0';
-  
-  /* Note: Used to use _spawnv(_P_WAIT, ...) here, but it suffered
-     from the parent intercepting console events such as Ctrl-C,
-     which it shouldn't. Installing an ignore-all console handler
-     didn't do the trick either.
-     
-     Irrespective of this issue, using CreateProcess() is preferable,
-     as it makes this wrapper work on both mingw and cygwin.
-  */
-#if 0
-  fprintf(stderr, "Invoking ghc: %s %s\n", binPathShort, new_cmdline); fflush(stderr);
-#endif
-  if (!CreateProcess(binPathShort,
-		     new_cmdline,
-		     NULL,
-		     NULL,
-		     TRUE,
-		     0, /* dwCreationFlags */
-		     NULL, /* lpEnvironment */
-		     NULL, /* lpCurrentDirectory */
-		     &si,  /* lpStartupInfo */
-		     &pi) ) {
-      errmsg1("Unable to start ghc.exe (error code: %lu)", GetLastError());
-      return 1;
-  }
-  /* Disable handling of console events in the parent by dropping its
-   * connection to the console. This has the (minor) downside of not being
-   * able to subsequently emit any error messages to the console.
-   */
-  FreeConsole();
-
-  switch (WaitForSingleObject(pi.hProcess, INFINITE) ) {
-  case WAIT_OBJECT_0:
-      return 0;
-  case WAIT_ABANDONED:
-  case WAIT_FAILED:
-      /* in the event we get any hard errors, bring the child to a halt. */
-      TerminateProcess(pi.hProcess,1);
-      return 1;
-  default:
-      return 1;
-  }
-}
diff --git a/ghc/driver/ghci/ghci.ico b/ghc/driver/ghci/ghci.ico
deleted file mode 100644
index 680be76e71..0000000000
--- a/ghc/driver/ghci/ghci.ico
+++ /dev/null
diff --git a/ghc/driver/ghci/ghci.rc b/ghc/driver/ghci/ghci.rc
deleted file mode 100644
index 01ed2f4081..0000000000
--- a/ghc/driver/ghci/ghci.rc
+++ /dev/null
@@ -1 +0,0 @@
-0 ICON "ghci.ico"
diff --git a/ghc/driver/ghci/ghci.sh b/ghc/driver/ghci/ghci.sh
deleted file mode 100644
index b0200477b8..0000000000
--- a/ghc/driver/ghci/ghci.sh
+++ /dev/null
@@ -1,2 +0,0 @@
-# Mini-driver for GHCi
-exec $GHCBIN $TOPDIROPT --interactive ${1+"$@"}
diff --git a/ghc/driver/ghci/ghcii.sh b/ghc/driver/ghci/ghcii.sh
deleted file mode 100644
index 70d98988b8..0000000000
--- a/ghc/driver/ghci/ghcii.sh
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/sh
-# Mini-driver for GHCi
-exec $0/../ghc --interactive ${1+"$@"}
diff --git a/ghc/driver/mangler/Makefile b/ghc/driver/mangler/Makefile
deleted file mode 100644
index 7b482e1d98..0000000000
--- a/ghc/driver/mangler/Makefile
+++ /dev/null
@@ -1,22 +0,0 @@
-#-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.3 2001/03/23 16:36:21 simonmar Exp $
-
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-SCRIPT_PROG 	= ghc-asm
-
-INTERP=perl
-
-SCRIPT_SUBST_VARS := TARGETPLATFORM
-
-INSTALL_LIBEXEC_SCRIPTS += $(SCRIPT_PROG)
-
-CLEAN_FILES += $(SCRIPT_OBJS)
-
-# needed for bootstrapping with HC files
-ifeq "$(BootingFromHc)" "YES"
-boot :: all
-endif
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/driver/mangler/ghc-asm.lprl b/ghc/driver/mangler/ghc-asm.lprl
deleted file mode 100644
index 902593ea7f..0000000000
--- a/ghc/driver/mangler/ghc-asm.lprl
+++ /dev/null
@@ -1,1775 +0,0 @@
-%************************************************************************
-%*									*
-\section[Driver-asm-fiddling]{Fiddling with assembler files}
-%*									*
-%************************************************************************
-
-Tasks:
-\begin{itemize}
-\item
-Utterly stomp out C functions' prologues and epilogues; i.e., the
-stuff to do with the C stack.
-\item
-Any other required tidying up.
-\end{itemize}
-
-General note [chak]: Many regexps are very fragile because they rely on white
-space being in the right place.  This caused trouble with gcc 2.95 (at least
-on Linux), where the use of white space in .s files generated by gcc suddenly 
-changed.  To guarantee compatibility across different versions of gcc, make
-sure (at least on i386-.*-linux) that regexps tolerate varying amounts of white
-space between an assembler statement and its arguments as well as after a the
-comma separating multiple arguments.  
-
-\emph{For the time being, I have corrected the regexps for i386-.*-linux.  I
-didn't touch all the regexps for other i386 platforms, as I don't have
-a box to test these changes.}
-
-HPPA specific notes:
-\begin{itemize}
-\item
-The HP linker is very picky about symbols being in the appropriate
-space (code vs. data).  When we mangle the threaded code to put the
-info tables just prior to the code, they wind up in code space
-rather than data space.  This means that references to *_info from
-un-mangled parts of the RTS (e.g. unthreaded GC code) get
-unresolved symbols.  Solution:  mini-mangler for .c files on HP.  I
-think this should really be triggered in the driver by a new -rts
-option, so that user code doesn't get mangled inappropriately.
-\item
-With reversed tables, jumps are to the _info label rather than to
-the _entry label.  The _info label is just an address in code
-space, rather than an entry point with the descriptive blob we
-talked about yesterday.  As a result, you can't use the call-style
-JMP_ macro.  However, some JMP_ macros take _info labels as targets
-and some take code entry points within the RTS.  The latter won't
-work with the goto-style JMP_ macro.  Sigh.  Solution: Use the goto
-style JMP_ macro, and mangle some more assembly, changing all
-"RP'literal" and "LP'literal" references to "R'literal" and
-"L'literal," so that you get the real address of the code, rather
-than the descriptive blob.  Also change all ".word P%literal"
-entries in info tables and vector tables to just ".word literal,"
-for the same reason.  Advantage: No more ridiculous call sequences.
-\end{itemize}
-
-%************************************************************************
-%*									*
-\subsection{Top-level code}
-%*									*
-%************************************************************************
-
-\begin{code}
-$TargetPlatform = $TARGETPLATFORM;
-
-($Pgm = $0) =~ s|.*/||;
-$ifile = $ARGV[0];
-$ofile = $ARGV[1];
-
-if ( $TargetPlatform =~ /^i386-/ ) {
-    if ($ARGV[2] eq '') {
-	$StolenX86Regs = 4;
-    } else {
-        $StolenX86Regs = $ARGV[2];
-    }
-}
-
-&mangle_asm($ifile,$ofile);
-
-exit(0);
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Constants for various architectures}
-%*									*
-%************************************************************************
-
-\begin{code}
-sub init_TARGET_STUFF {
-
-    #--------------------------------------------------------#
-    if ( $TargetPlatform =~ /^alpha-.*-.*/ ) {
-
-    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
-    $T_US	    = ''; # _ if symbols have an underscore on the front
-    $T_PRE_APP	    = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
-    $T_CONST_LBL    = '^\$L?C(\d+):$'; # regexp for what such a lbl looks like
-    $T_POST_LBL	    = ':';
-
-    $T_MOVE_DIRVS   = '^(\s*(\$.*\.\.ng:|\.align\s+\d+|\.(globl|ent)\s+\S+|\#.*|\.(file|loc)\s+\S+\s+\S+|\.text|\.r?data)\n)';
-    $T_COPY_DIRVS   = '^\s*(\$.*\.\.ng:|\#|\.(file|globl|ent|loc))';
-
-    $T_DOT_WORD	    = '\.(long|quad|byte|word)';
-    $T_DOT_GLOBAL   = '^\t\.globl';
-    $T_HDR_literal  = "\.rdata\n\t\.align 3\n";
-    $T_HDR_misc	    = "\.text\n\t\.align 3\n";
-    $T_HDR_data	    = "\.data\n\t\.align 3\n";
-    $T_HDR_rodata   = "\.rdata\n\t\.align 3\n";
-    $T_HDR_closure  = "\.data\n\t\.align 3\n";
-    $T_HDR_info	    = "\.text\n\t\.align 3\n";
-    $T_HDR_entry    = "\.text\n\t\.align 3\n";
-    $T_HDR_vector   = "\.text\n\t\.align 3\n";
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^hppa/ ) {
-
-    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
-    $T_US	    = ''; # _ if symbols have an underscore on the front
-    $T_PRE_APP	    = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
-    $T_CONST_LBL    = '^L\$C(\d+)$'; # regexp for what such a lbl looks like
-    $T_POST_LBL	    = '';
-
-    $T_MOVE_DIRVS   = '^((\s+\.(IMPORT|EXPORT|PARAM).*|\s+\.align\s+\d+|\s+\.(SPACE|SUBSPA)\s+\S+|\s*)\n)';
-    $T_COPY_DIRVS   = '^\s+\.(IMPORT|EXPORT)';
-
-    $T_DOT_WORD	    = '\.(blockz|word|half|byte)';
-    $T_DOT_GLOBAL   = '^\s+\.EXPORT';
-    $T_HDR_literal  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
-    $T_HDR_misc	    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
-    $T_HDR_data	    = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
-    $T_HDR_rodata   = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
-    $T_HDR_closure  = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
-    $T_HDR_info	    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
-    $T_HDR_entry    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
-    $T_HDR_vector   = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^i386-.*-(linuxaout|freebsd2|nextstep3|cygwin32|mingw32)$/ ) {
-				# NeXT added but not tested. CaS
-
-    $T_STABBY	    = 1; # 1 iff .stab things (usually if a.out format)
-    $T_US	    = '_'; # _ if symbols have an underscore on the front
-    $T_PRE_APP	    = '^#'; # regexp that says what comes before APP/NO_APP
-    $T_CONST_LBL    = '^LC(\d+):$';
-    $T_POST_LBL	    = ':';
-    $T_X86_PRE_LLBL_PAT = 'L';
-    $T_X86_PRE_LLBL	    = 'L';
-    $T_X86_BADJMP   = '^\tjmp [^L\*]';
-
-    $T_MOVE_DIRVS   = '^(\s*(\.(p2)?align\s.*|\.globl\s+\S+|\.text|\.data|\.stab[^n].*|\.type\s+.*|\.size\s+.*|\.lcomm.*)\n)';
-    $T_COPY_DIRVS   = '\.(globl|stab|lcomm)';
-    $T_DOT_WORD	    = '\.(long|word|value|byte|space)';
-    $T_DOT_GLOBAL   = '\.globl';
-    $T_HDR_literal  = "\.text\n\t\.align 2\n";
-    $T_HDR_misc	    = "\.text\n\t\.align 2,0x90\n";
-    $T_HDR_data	    = "\.data\n\t\.align 2\n";
-    $T_HDR_rodata   = "\.text\n\t\.align 2\n";
-    $T_HDR_closure  = "\.data\n\t\.align 2\n";
-    $T_HDR_info	    = "\.text\n\t\.align 2\n"; # NB: requires padding
-    $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
-    $T_HDR_vector   = "\.text\n\t\.align 2\n"; # NB: requires padding
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux|gnu|freebsd|netbsd|openbsd|kfreebsdgnu)$/ ) {
-
-    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
-    $T_US	    = ''; # _ if symbols have an underscore on the front
-    $T_PRE_APP	    = # regexp that says what comes before APP/NO_APP
-		      ($TargetPlatform =~ /-(linux|gnu|freebsd|netbsd|openbsd)$/) ? '#' : '/' ;
-    $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
-    $T_POST_LBL	    = ':';
-    $T_X86_PRE_LLBL_PAT = '\.L';
-    $T_X86_PRE_LLBL	    = '.L';
-    $T_X86_BADJMP   = '^\tjmp\s+[^\.\*]';
-
-    $T_MOVE_DIRVS   = '^(\s*(\.(p2)?align\s.*|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)';
-    $T_COPY_DIRVS   = '^\s*\.(globl|type|size|local)';
-
-    $T_DOT_WORD	    = '\.(long|value|word|byte|zero)';
-    $T_DOT_GLOBAL   = '\.globl';
-    $T_HDR_literal  = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
-    $T_HDR_misc	    = "\.text\n\t\.align 4\n";
-    $T_HDR_data	    = "\.data\n\t\.align 4\n";
-    $T_HDR_rodata   = "\.section\t\.rodata\n\t\.align 4\n";
-    $T_HDR_closure  = "\.data\n\t\.align 4\n";
-    $T_HDR_info	    = "\.text\n\t\.align 4\n";
-    $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
-    $T_HDR_vector   = "\.text\n\t\.align 4\n"; # NB: requires padding
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^ia64-.*-linux$/ ) {
-
-    $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
-    $T_US           = ''; # _ if symbols have an underscore on the front
-    $T_PRE_APP      = '#';
-    $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
-    $T_POST_LBL     = ':';
-
-    $T_MOVE_DIRVS   = '^(\s*\.(global|proc|pred\.safe_across_calls|text|data|section|subsection|align|size|type|ident)\s+.*\n)';
-    $T_COPY_DIRVS   = '\.(global|proc)';
-
-    $T_DOT_WORD     = '\.(long|value|byte|zero)';
-    $T_DOT_GLOBAL   = '\.global';
-    $T_HDR_literal  = "\.section\t\.rodata\n";
-    $T_HDR_misc     = "\.text\n\t\.align 8\n";
-    $T_HDR_data     = "\.data\n\t\.align 8\n";
-    $T_HDR_rodata   = "\.section\t\.rodata\n\t\.align 8\n";
-    $T_HDR_closure  = "\.data\n\t\.align 8\n";
-    $T_HDR_info     = "\.text\n\t\.align 8\n";
-    $T_HDR_entry    = "\.text\n\t\.align 16\n";
-    $T_HDR_vector   = "\.text\n\t\.align 8\n";
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^x86_64-.*-(linux|openbsd)$/ ) {
-
-    $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
-    $T_US           = ''; # _ if symbols have an underscore on the front
-    $T_PRE_APP      = '#';
-    $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
-    $T_POST_LBL     = ':';
-
-    $T_MOVE_DIRVS   = '^(\s*\.(globl|text|data|section|align|size|type|ident|local)\s+.*\n)';
-    $T_COPY_DIRVS   = '\.(globl|type|size|local)';
-
-    $T_DOT_WORD     = '\.(quad|long|value|byte|zero)';
-    $T_DOT_GLOBAL   = '\.global';
-
-    $T_HDR_literal16 = "\.section\t\.rodata.cst16\n\t.align 16\n";
-    $T_HDR_literal  = "\.section\t\.rodata\n";
-
-    $T_HDR_misc     = "\.text\n\t\.align 8\n";
-    $T_HDR_data     = "\.data\n\t\.align 8\n";
-    $T_HDR_rodata   = "\.section\t\.rodata\n\t\.align 8\n";
-
-	# the assembler on x86_64/Linux refuses to generate code for
-	#   .quad  x - y
-	# where x is in the text section and y in the rodata section.
-	# It works if y is in the text section, though.  This is probably
-	# going to cause difficulties for PIC, I imagine.
-    $T_HDR_relrodata= "\.text\n\t\.align 8\n";
-
-    $T_HDR_closure  = "\.data\n\t\.align 8\n";
-    $T_HDR_info     = "\.text\n\t\.align 8\n";
-    $T_HDR_entry    = "\.text\n\t\.align 8\n";
-    $T_HDR_vector   = "\.text\n\t\.align 8\n";
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^m68k-.*-sunos4/ ) {
-
-    $T_STABBY	    = 1; # 1 iff .stab things (usually if a.out format)
-    $T_US	    = '_'; # _ if symbols have an underscore on the front
-    $T_PRE_APP	    = '^# MAY NOT APPLY'; # regexp that says what comes before APP/NO_APP
-    $T_CONST_LBL    = '^LC(\d+):$';
-    $T_POST_LBL	    = ':';
-
-    $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)';
-    $T_COPY_DIRVS   = '\.(globl|proc|stab)';
-
-    $T_DOT_WORD	    = '\.long';
-    $T_DOT_GLOBAL   = '\.globl';
-    $T_HDR_literal  = "\.text\n\t\.even\n";
-    $T_HDR_misc	    = "\.text\n\t\.even\n";
-    $T_HDR_data	    = "\.data\n\t\.even\n";
-    $T_HDR_rodata   = "\.text\n\t\.even\n";
-    $T_HDR_closure  = "\.data\n\t\.even\n";
-    $T_HDR_info	    = "\.text\n\t\.even\n";
-    $T_HDR_entry    = "\.text\n\t\.even\n";
-    $T_HDR_vector   = "\.text\n\t\.even\n";
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^mips-.*/ ) {
-
-    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
-    $T_US	    = ''; # _ if symbols have an underscore on the front
-    $T_PRE_APP	    = '^\s*#'; # regexp that says what comes before APP/NO_APP
-    $T_CONST_LBL    = '^\$LC(\d+):$'; # regexp for what such a lbl looks like
-    $T_POST_LBL	    = ':';
-
-    $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)';
-    $T_COPY_DIRVS   = '\.(globl|ent)';
-
-    $T_DOT_WORD	    = '\.word';
-    $T_DOT_GLOBAL   = '^\t\.globl';
-    $T_HDR_literal  = "\t\.rdata\n\t\.align 2\n";
-    $T_HDR_misc	    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_data	    = "\t\.data\n\t\.align 2\n";
-    $T_HDR_rodata   = "\t\.rdata\n\t\.align 2\n";
-    $T_HDR_closure  = "\t\.data\n\t\.align 2\n";
-    $T_HDR_info	    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_entry    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_vector   = "\t\.text\n\t\.align 2\n";
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^powerpc-apple-darwin.*/ ) {
-				# Apple PowerPC Darwin/MacOS X.
-    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
-    $T_US	    = '_'; # _ if symbols have an underscore on the front
-    $T_PRE_APP	    = 'DOESNT APPLY'; # regexp that says what comes before APP/NO_APP
-    $T_CONST_LBL    = '^\LC\d+:'; # regexp for what such a lbl looks like
-    $T_POST_LBL	    = ':';
-
-    $T_MOVE_DIRVS   = '^(\s*(\.align \d+|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)';
-    $T_COPY_DIRVS   = '\.(globl|lcomm)';
-
-    $T_DOT_WORD	    = '\.(long|short|byte|fill|space)';
-    $T_DOT_GLOBAL   = '\.globl';
-    $T_HDR_toc      = "\.toc\n";
-    $T_HDR_literal  = "\t\.const\n\t\.align 2\n";
-    $T_HDR_misc	    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_data	    = "\t\.data\n\t\.align 2\n";
-    $T_HDR_rodata   = "\t\.const\n\t\.align 2\n";
-    $T_HDR_relrodata= "\t\.const_data\n\t\.align 2\n";
-    $T_HDR_closure  = "\t\.data\n\t\.align 2\n";
-    $T_HDR_info	    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_entry    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_vector   = "\t\.text\n\t\.align 2\n";
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^i386-apple-darwin.*/ ) {
-				# Apple PowerPC Darwin/MacOS X.
-    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
-    $T_US	    = '_'; # _ if symbols have an underscore on the front
-    $T_PRE_APP	    = 'DOESNT APPLY'; # regexp that says what comes before APP/NO_APP
-    $T_CONST_LBL    = '^\LC\d+:'; # regexp for what such a lbl looks like
-    $T_POST_LBL	    = ':';
-    $T_X86_PRE_LLBL_PAT = 'L';
-    $T_X86_PRE_LLBL	    = 'L';
-    $T_X86_BADJMP   = '^\tjmp [^L\*]';
-
-    $T_MOVE_DIRVS   = '^(\s*(\.align \d+|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)';
-    $T_COPY_DIRVS   = '\.(globl|lcomm)';
-
-    $T_DOT_WORD	    = '\.(long|short|byte|fill|space)';
-    $T_DOT_GLOBAL   = '\.globl';
-    $T_HDR_toc      = "\.toc\n";
-    $T_HDR_literal16= "\t\.literal8\n\t\.align 4\n";
-    $T_HDR_literal  = "\t\.const\n\t\.align 4\n";
-    $T_HDR_misc	    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_data	    = "\t\.data\n\t\.align 2\n";
-    $T_HDR_rodata   = "\t\.const\n\t\.align 2\n";
-    $T_HDR_relrodata= "\t\.const_data\n\t\.align 2\n";
-    $T_HDR_closure  = "\t\.data\n\t\.align 2\n";
-    $T_HDR_info	    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_entry    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_vector   = "\t\.text\n\t\.align 2\n";
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^powerpc-.*-linux/ ) {
-				# PowerPC Linux
-    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
-    $T_US	    = ''; # _ if symbols have an underscore on the front
-    $T_PRE_APP	    = '^#'; # regexp that says what comes before APP/NO_APP
-    $T_CONST_LBL    = '^\.LC\d+:'; # regexp for what such a lbl looks like
-    $T_POST_LBL	    = ':';
-
-    $T_MOVE_DIRVS   = '^(\s*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)';
-    $T_COPY_DIRVS   = '^\s*\.(globl|type|size|local)';
-
-    $T_DOT_WORD	    = '\.(long|short|byte|fill|space)';
-    $T_DOT_GLOBAL   = '\.globl';
-    $T_HDR_toc      = "\.toc\n";
-    $T_HDR_literal  = "\t\.section\t.rodata\n\t\.align 2\n";
-    $T_HDR_misc	    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_data	    = "\t\.data\n\t\.align 2\n";
-    $T_HDR_rodata   = "\t\.section\t.rodata\n\t\.align 2\n";
-    $T_HDR_closure  = "\t\.data\n\t\.align 2\n";
-    $T_HDR_info	    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_entry    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_vector   = "\t\.text\n\t\.align 2\n";
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^powerpc64-.*-linux/ ) {
-				# PowerPC 64 Linux
-    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
-    $T_US	    = '\.'; # _ if symbols have an underscore on the front
-    $T_PRE_APP	    = '^#'; # regexp that says what comes before APP/NO_APP
-    $T_CONST_LBL    = '^\.LC\d+:'; # regexp for what such a lbl looks like
-    $T_POST_LBL	    = ':';
-
-    $T_MOVE_DIRVS   = '^(\s*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)';
-    $T_COPY_DIRVS   = '^\s*\.(globl|type|size|local)';
-
-    $T_DOT_WORD	    = '\.(long|short|byte|fill|space)';
-    $T_DOT_GLOBAL   = '\.globl';
-    $T_HDR_toc      = "\.toc\n";
-    $T_HDR_literal  = "\t\.section\t\".toc\",\"aw\"\n";
-    $T_HDR_misc	    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_data	    = "\t\.data\n\t\.align 2\n";
-    $T_HDR_rodata   = "\t\.section\t.rodata\n\t\.align 2\n";
-    $T_HDR_closure  = "\t\.data\n\t\.align 2\n";
-    $T_HDR_info	    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_entry    = "\t\.text\n\t\.align 2\n";
-    $T_HDR_vector   = "\t\.text\n\t\.align 2\n";
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^sparc-.*-(solaris2|openbsd)/ ) {
-
-    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
-    $T_US	    = ''; # _ if symbols have an underscore on the front
-    $T_PRE_APP	    = 'DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
-    $T_CONST_LBL    = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like
-    $T_POST_LBL	    = ':';
-
-    $T_MOVE_DIRVS   =  '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\s+\.local\s+\S+|\.text|\.data|\.stab.*|\s*\.section.*|\s+\.type.*|\s+\.size.*)\n)';
-    $T_COPY_DIRVS   = '\.(global|local|proc|stab)';
-
-    $T_DOT_WORD	    = '\.(long|word|byte|half|skip|uahalf|uaword)';
-    $T_DOT_GLOBAL   = '^\t\.global';
-    $T_HDR_literal  = "\.text\n\t\.align 8\n";
-    $T_HDR_misc	    = "\.text\n\t\.align 4\n";
-    $T_HDR_data	    = "\.data\n\t\.align 8\n";
-    $T_HDR_rodata   = "\.text\n\t\.align 4\n";
-    $T_HDR_closure  = "\.data\n\t\.align 4\n";
-    $T_HDR_info     = "\.text\n\t\.align 4\n";
-    $T_HDR_entry    = "\.text\n\t\.align 4\n";
-    $T_HDR_vector   = "\.text\n\t\.align 4\n";
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^sparc-.*-sunos4/ ) {
-
-    $T_STABBY	    = 1; # 1 iff .stab things (usually if a.out format)
-    $T_US	    = '_'; # _ if symbols have an underscore on the front
-    $T_PRE_APP	    = '^# DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
-    $T_CONST_LBL    = '^LC(\d+):$';
-    $T_POST_LBL	    = ':';
-
-    $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*)\n)';
-    $T_COPY_DIRVS   = '\.(global|proc|stab)';
-
-    $T_DOT_WORD	    = '\.word';
-    $T_DOT_GLOBAL   = '^\t\.global';
-    $T_HDR_literal  = "\.text\n\t\.align 8\n";
-    $T_HDR_misc	    = "\.text\n\t\.align 4\n";
-    $T_HDR_data	    = "\.data\n\t\.align 8\n";
-    $T_HDR_rodata   = "\.text\n\t\.align 4\n";
-    $T_HDR_closure  = "\.data\n\t\.align 4\n";
-    $T_HDR_info	    = "\.text\n\t\.align 4\n";
-    $T_HDR_entry    = "\.text\n\t\.align 4\n";
-    $T_HDR_vector   = "\.text\n\t\.align 4\n";
-
-    #--------------------------------------------------------#
-    } elsif ( $TargetPlatform =~ /^sparc-.*-linux/ ) {
-    $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
-    $T_US           = ''; # _ if symbols have an underscore on the front
-    $T_PRE_APP      = '#'; # regexp that says what comes before APP/NO_APP
-                           # Probably doesn't apply anyway
-    $T_CONST_LBL    = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like
-    $T_POST_LBL     = ':';
-
-    $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.seg|\.stab.*|\s+?\.section.*|\s+\.type.*|\s+\.size.*)\n)';
-    $T_COPY_DIRVS   = '\.(global|globl|proc|stab)';
-
-    $T_DOT_WORD     = '\.(long|word|nword|xword|byte|half|short|skip|uahalf|uaword)';
-    $T_DOT_GLOBAL   = '^\t\.global';
-    $T_HDR_literal  = "\.text\n\t\.align 8\n";
-    $T_HDR_misc     = "\.text\n\t\.align 4\n";
-    $T_HDR_data     = "\.data\n\t\.align 8\n";
-    $T_HDR_rodata   = "\.text\n\t\.align 4\n";
-    $T_HDR_closure  = "\.data\n\t\.align 4\n";
-    $T_HDR_info     = "\.text\n\t\.align 4\n";
-    $T_HDR_entry    = "\.text\n\t\.align 4\n";
-    $T_HDR_vector   = "\.text\n\t\.align 4\n";
-
-    #--------------------------------------------------------#
-    } else {
-	print STDERR "$Pgm: don't know how to mangle assembly language for: $TargetPlatform\n";
-	exit 1;
-    }
-
-    if($T_HDR_relrodata eq "") {
-            # default values:
-            # relrodata defaults to rodata.
-        $T_HDR_relrodata = $T_HDR_rodata;
-    }
-
-if ( 0 ) {
-print STDERR "T_STABBY: $T_STABBY\n";
-print STDERR "T_US: $T_US\n";
-print STDERR "T_PRE_APP: $T_PRE_APP\n";
-print STDERR "T_CONST_LBL: $T_CONST_LBL\n";
-print STDERR "T_POST_LBL: $T_POST_LBL\n";
-if ( $TargetPlatform =~ /^i386-/ ) {
-    print STDERR "T_X86_PRE_LLBL_PAT: $T_X86_PRE_LLBL_PAT\n";
-    print STDERR "T_X86_PRE_LLBL: $T_X86_PRE_LLBL\n";
-    print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n";
-}
-print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n";
-print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n";
-print STDERR "T_DOT_WORD: $T_DOT_WORD\n";
-print STDERR "T_HDR_literal: $T_HDR_literal\n";
-print STDERR "T_HDR_misc: $T_HDR_misc\n";
-print STDERR "T_HDR_data: $T_HDR_data\n";
-print STDERR "T_HDR_rodata: $T_HDR_rodata\n";
-print STDERR "T_HDR_closure: $T_HDR_closure\n";
-print STDERR "T_HDR_info: $T_HDR_info\n";
-print STDERR "T_HDR_entry: $T_HDR_entry\n";
-print STDERR "T_HDR_vector: $T_HDR_vector\n";
-}
-
-}
-\end{code}
-
-%************************************************************************
-%*									*
-\subsection{Mangle away}
-%*									*
-%************************************************************************
-
-\begin{code}
-sub mangle_asm {
-    local($in_asmf, $out_asmf) = @_;
-
-    # multi-line regexp matching:
-    local($*) = 1;
-    local($i, $c);
-
-
-    &init_TARGET_STUFF();
-    &init_FUNNY_THINGS();
-
-    open(INASM, "< $in_asmf")
-	|| &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
-    open(OUTASM,"> $out_asmf")
-	|| &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
-
-    # read whole file, divide into "chunks":
-    #	record some info about what we've found...
-
-    @chk = ();		# contents of the chunk
-    $numchks = 0;	# number of them
-    @chkcat = ();	# what category of thing in each chunk
-    @chksymb = ();	# what symbol(base) is defined in this chunk
-    %entrychk = ();	# ditto, its entry code
-    %closurechk = ();	# ditto, the (static) closure
-    %srtchk = ();	# ditto, its SRT (for top-level things)
-    %infochk = (); 	# given a symbol base, say what chunk its info tbl is in
-    %vectorchk = ();    # ditto, return vector table
-    $EXTERN_DECLS = '';	# .globl <foo> .text (MIPS only)
-
-    $i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
-
-    while (<INASM>) {
-	tr/\r//d if $TargetPlatform =~ /-mingw32$/; # In case Perl doesn't convert line endings
-	next if $T_STABBY && /^\.stab.*${T_US}__stg_split_marker/o;
-	next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
-	next if /^\t\.def.*endef$/;
-	next if /${T_PRE_APP}(NO_)?APP/o; 
-    	next if /^;/ && $TargetPlatform =~ /^hppa/;
-
-	next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|ia64)-/;
-
-	if ( $TargetPlatform =~ /^mips-/ 
-	  && /^\t\.(globl\S+\.text|comm\t)/ ) {
-	    $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
-	# Treat .comm variables as data.  These show up in two (known) places:
-	#
-	#    - the module_registered variable used in the __stginit fragment.
-	#      even though these are declared static and initialised, gcc 3.3
-	#      likes to make them .comm, presumably to save space in the
-	#      object file.
-	#
-	#    - global variables used to pass arguments from C to STG in
-	#      a foreign export.  (is this still true? --SDM)
-	# 
-	} elsif ( /^\t\.comm.*$/ ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'data';
-	    $chksymb[$i] = '';
-
-	# Labels ending "_str": these are literal strings.
-	} elsif ( /^${T_US}([A-Za-z0-9_]+)_str${T_POST_LBL}$/ ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'rodata';
-	    $chksymb[$i] = '';
-        } elsif ( $TargetPlatform =~ /-darwin/
-                && (/^\s*\.subsections_via_symbols/
-                  ||/^\s*\.no_dead_strip.*/)) {
-            # Don't allow Apple's linker to do any dead-stripping of symbols
-            # in this file, because it will mess up info-tables in mangled
-            # code.
-            # The .no_dead_strip directives are actually put there by
-            # the gcc3 "used" attribute on entry points.
-        
-        } elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/ && ( 
-		   /^\s*\.picsymbol_stub/
-		|| /^\s*\.section __TEXT,__picsymbol_stub\d,.*/
-		|| /^\s*\.section __TEXT,__picsymbolstub\d,.*/
-		|| /^\s*\.symbol_stub/
-		|| /^\s*\.section __TEXT,__symbol_stub\d,.*/
-		|| /^\s*\.section __TEXT,__symbolstub\d,.*/
-		|| /^\s*\.lazy_symbol_pointer/
-		|| /^\s*\.non_lazy_symbol_pointer/
-		|| /^\s*\.section __IMPORT.*/))
-	{
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'dyld';
-	    $chksymb[$i] = '';
-	    $dyld_section = $_;
-
-	} elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/ && $chkcat[$i] eq 'dyld' && /^\s*\.data/)
-	{	# non_lazy_symbol_ptrs that point to local symbols
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'dyld';
-	    $chksymb[$i] = '';
-	    $dyld_section = $_;
-	} elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/ && $chkcat[$i] eq 'dyld' && /^\s*\.align/)
-	{	# non_lazy_symbol_ptrs that point to local symbols
-	    $dyld_section .= $_;
-	} elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/ && $chkcat[$i] eq 'dyld' && /^L_.*:$/)
-	{	# non_lazy_symbol_ptrs that point to local symbols
-	    $chk[++$i]   = $dyld_section . $_;
-	    $chkcat[$i]  = 'dyld';
-	    $chksymb[$i] = '';
-
-	} elsif ( /^\s+/ ) { # most common case first -- a simple line!
-	    # duplicated from the bottom
-
-	    $chk[$i] .= $_;
-
-	} elsif ( /\.\.ng:$/ && $TargetPlatform =~ /^alpha-/ ) {
-	    # Alphas: Local labels not to be confused with new chunks
-	    $chk[$i] .= $_;
-	# NB: all the rest start with a non-space
-
-	} elsif ( $TargetPlatform =~ /^mips-/
-	       && /^\d+:/ ) { # a funny-looking very-local label
-	    $chk[$i] .= $_;
-
-	} elsif ( /$T_CONST_LBL/o ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'literal';
-	    $chksymb[$i] = $1;
-
-	} elsif ( /^${T_US}__stg_split_marker(\d*)${T_POST_LBL}$/o ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'splitmarker';
-	    $chksymb[$i] = $1;
-
-	} elsif ( /^${T_US}([A-Za-z0-9_]+)_info${T_POST_LBL}$/o ) {
-	    $symb = $1;
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'infotbl';
-	    $chksymb[$i] = $symb;
-
-	    die "Info table already? $symb; $i\n" if defined($infochk{$symb});
-
-	    $infochk{$symb} = $i;
-
-	} elsif ( /^${T_US}([A-Za-z0-9_]+)_(entry|ret)${T_POST_LBL}$/o ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'entry';
-	    $chksymb[$i] = $1;
-
-	    $entrychk{$1} = $i;
-
-	} elsif ( /^${T_US}([A-Za-z0-9_]+)_closure${T_POST_LBL}$/o ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'closure';
-	    $chksymb[$i] = $1;
-
-	    $closurechk{$1} = $i;
-
-	} elsif ( /^${T_US}([A-Za-z0-9_]+)_srt${T_POST_LBL}$/o ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'srt';
-	    $chksymb[$i] = $1;
-
-	    $srtchk{$1} = $i;
-
-	} elsif ( /^${T_US}([A-Za-z0-9_]+)_ct${T_POST_LBL}$/o ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'data';
-	    $chksymb[$i] = '';
-
-	} elsif ( /^${T_US}(stg_ap_stack_entries|stg_stack_save_entries|stg_arg_bitmaps)${T_POST_LBL}$/o ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'data';
-	    $chksymb[$i] = '';
-
-	} elsif ( /^(${T_US}__gnu_compiled_c|gcc2_compiled\.)${T_POST_LBL}/o ) {
-	    ; # toss it
-
-	} elsif ( /^${T_US}[A-Za-z0-9_]+\.\d+${T_POST_LBL}$/o
-	       || /^${T_US}.*_CAT${T_POST_LBL}$/o 		# PROF: _entryname_CAT
-	       || /^${T_US}.*_done${T_POST_LBL}$/o		# PROF: _module_done
-	       || /^${T_US}_module_registered${T_POST_LBL}$/o	# PROF: _module_registered
-	       ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'data';
-	    $chksymb[$i] = '';
-
-	} elsif ( /^([A-Za-z0-9_]+)\s+\.comm/ && $TargetPlatform =~ /^hppa/ ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'bss';
-  	    $chksymb[$i] = '';
-
-	} elsif ( /^${T_US}([A-Za-z0-9_]+)_cc(s)?${T_POST_LBL}$/o ) {
-            # all CC_ symbols go in the data section...
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'data';
-	    $chksymb[$i] = '';
-
-	} elsif ( /^${T_US}([A-Za-z0-9_]+)_(alt|dflt)${T_POST_LBL}$/o ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'misc';
-	    $chksymb[$i] = '';
-	} elsif ( /^${T_US}([A-Za-z0-9_]+)_vtbl${T_POST_LBL}$/o ) {
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'vector';
-	    $chksymb[$i] = $1;
-
-	    $vectorchk{$1} = $i;
-
-	} elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
-	     &&   /^[A-Za-z0-9][A-Za-z0-9_]*:/ ) {
-            # Some Solaris system headers contain function definitions (as
-	    # opposed to mere prototypes), which end up in the .hc file when
-	    # a Haskell module foreign imports the corresponding system 
-	    # functions (most notably stat()).  We put them into the text 
-            # segment.  Note that this currently does not extend to function
-	    # names starting with an underscore. 
-	    # - chak 7/2001
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'misc';
-	    $chksymb[$i] = $1;
-
-        } elsif ( $TargetPlatform =~ /^i386-apple-darwin/ && /^(___i686\.get_pc_thunk\.[abcd]x):/o) {
-                # To handle PIC on Darwin/x86, we need to appropriately pass through
-                # the get_pc_thunk functions. The need to be put into a special section
-                # marked as coalesced (otherwise the .weak_definition doesn't work
-                # on Darwin).
-            $chk[++$i]   = $_;
-            $chkcat[$i]  = 'get_pc_thunk';
-            $chksymb[$i] = $1;
-
-	} elsif ( /^${T_US}[A-Za-z0-9_]/o
-		&& ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
-		   || ! /^L\$\d+$/ ) 
-		&& ( $TargetPlatform !~ /^powerpc64/ # we need to avoid local labels in this case
-		   || ! /^\.L\d+:$/ ) ) {
-	    local($thing);
-	    chop($thing = $_);
-	    $thing =~ s/:$//;
-	    $chk[++$i]   = $_;
-	    $chksymb[$i] = '';
-	    if (
-		       /^${T_US}stg_.*${T_POST_LBL}$/o          # RTS internals
-		    || /^${T_US}__stg_.*${T_POST_LBL}$/o        # more RTS internals
-		    || /^${T_US}__fexp_.*${T_POST_LBL}$/o       # foreign export
-		    || /^${T_US}.*_slow${T_POST_LBL}$/o         # slow entry
-		    || /^${T_US}__stginit.*${T_POST_LBL}$/o     # __stginit<module>
-		    || /^${T_US}.*_btm${T_POST_LBL}$/o          # large bitmaps
-		    || /^${T_US}.*_fast${T_POST_LBL}$/o         # primops
-                    || /^_uname:/o			        # x86/Solaris2
-		)
-            {
-	    	$chkcat[$i]  = 'misc';
-            } elsif (
-		       /^${T_US}.*_srtd${T_POST_LBL}$/o          # large bitmaps
-		    || /^${T_US}.*_closure_tbl${T_POST_LBL}$/o  # closure tables
-                )
-            {
-                $chkcat[$i] = 'relrodata';
-            } else
-            {
-	        print STDERR "Warning: retaining unknown function \`$thing' in output from C compiler\n";
-	    	$chkcat[$i]  = 'unknown';
-	    }
-
-	} elsif ( $TargetPlatform =~ /^powerpc-.*-linux/ && /^\.LCTOC1 = /o ) {
-		# PowerPC Linux's large-model PIC (-fPIC) generates a gobal offset
-		# table "by hand". Be sure to copy it over.
-		# Note that this label and all entries in the table should actually
-		# go into the .got2 section, but it isn't easy to distinguish them
-		# from other constant literals (.LC\d+), so we just put everything
-		# in .rodata.
-	    $chk[++$i]   = $_;
-	    $chkcat[$i]  = 'literal';
-	    $chksymb[$i] = 'LCTOC1';
-	} else { # simple line (duplicated at the top)
-
-	    $chk[$i] .= $_;
-	}
-    }
-    $numchks = $#chk + 1;
-
-    # open CHUNKS, ">/tmp/chunks1" or die "Cannot open /tmp/chunks1: $!\n";
-    # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] }
-    # close CHUNKS;
-
-    # the division into chunks is imperfect;
-    # we throw some things over the fence into the next
-    # chunk.
-    #
-    # also, there are things we would like to know
-    # about the whole module before we start spitting
-    # output.
-
-    local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0;
-    local($FIRST_TOSSABLE ) = ($TargetPlatform =~ /^(hppa|mips-)/) ? 1 : 0;
-
-#   print STDERR "first chunk to mangle: $FIRST_MANGLABLE\n";
-
-    # Alphas: NB: we start meddling at chunk 1, not chunk 0
-    # The first ".rdata" is quite magical; as of GCC 2.7.x, it
-    # spits a ".quad 0" in after the very first ".rdata"; we
-    # detect this special case (tossing the ".quad 0")!
-    local($magic_rdata_seen) = 0;
-  
-    # HPPAs, MIPSen: also start medding at chunk 1
-
-    for ($i = $FIRST_TOSSABLE; $i < $numchks; $i++) {
-	$c = $chk[$i]; # convenience copy
-
-#	print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
-
-	# toss all prologue stuff; HPPA is pretty weird
-	# (see elsewhere)
-	$c = &hppa_mash_prologue($c) if $TargetPlatform =~ /^hppa-/;
-
-	# be slightly paranoid to make sure there's
-	# nothing surprising in there
-	if ( $c =~ /--- BEGIN ---/ ) {
-	    if (($p, $r) = split(/--- BEGIN ---/, $c)) {
-
-		# remove junk whitespace around the split point
-		$p =~ s/\t+$//;
-		$r =~ s/^\s*\n//;
-
-		if ($TargetPlatform =~ /^i386-/) {
-		    if ($p =~ /^\tsubl\s+\$(\d+),\s*\%esp\n/) {
-			if ($1 >= 8192) {
-			    die "Error: reserved stack space exceeded!\n  Possible workarounds: compile with -fasm, or try another version of gcc.\n"
-			}
-		    }
-
-		# gcc 3.4.3 puts this kind of stuff in the prologue, eg.
-		# when compiling PrimOps.cmm with -optc-O2:
-		#        xorl    %ecx, %ecx
-		#        xorl    %edx, %edx
-		#        movl    %ecx, 16(%esp)
-		#        movl    %edx, 20(%esp)
-		# but then the code of the function doesn't assume
-		# anything about the contnets of these stack locations.
-		# I think it's to do with the use of inline functions for
-		# PK_Word64() and friends, where gcc is initialising the
-		# contents of the struct to zero, and failing to optimise
-		# away the initialisation.  Let's live dangerously and
-		# discard these initalisations.
-
-		    $p =~ s/^\tpushl\s+\%e(di|si|bx)\n//g;
-		    $p =~ s/^\txorl\s+\%e(ax|cx|dx),\s*\%e(ax|cx|dx)\n//g;
-		    $p =~ s/^\tmovl\s+\%e(ax|cx|dx|si|di),\s*\d*\(\%esp\)\n//g;
-		    $p =~ s/^\tmovl\s+\$\d+,\s*\d*\(\%esp\)\n//g;
-		    $p =~ s/^\tsubl\s+\$\d+,\s*\%esp\n//;
-                    $p =~ s/^\tmovl\s+\$\d+,\s*\%eax\n\tcall\s+__alloca\n// if ($TargetPlatform =~ /^.*-(cygwin32|mingw32)/);
-
-                    if ($TargetPlatform =~ /^i386-apple-darwin/) {
-                        $pcrel_label = $p;
-                        $pcrel_label =~ s/(.|\n)*^(\"?L\d+\$pb\"?):\n(.|\n)*/$2/ or $pcrel_label = "";
-                        $pcrel_reg = $p;
-                        $pcrel_reg =~ s/(.|\n)*.*___i686\.get_pc_thunk\.([abcd]x)\n(.|\n)*/$2/ or $pcrel_reg = "";
-                        $p =~ s/^\s+call\s+___i686\.get_pc_thunk\..x//;
-                        $p =~ s/^\"?L\d+\$pb\"?:\n//;
-
-                        if ($pcrel_reg eq "bx") {
-                            # Bad gcc. Goes and uses %ebx, our BaseReg, for PIC. Bad gcc.
-                            die "Darwin/x86: -fPIC -via-C doesn't work yet, use -fasm. Aborting."
-                        }
-                    }
-
-		} elsif ($TargetPlatform =~ /^x86_64-/) {
-		    $p =~ s/^\tpushq\s+\%r(bx|bp|12|13|14)\n//g;
-		    $p =~ s/^\tmovq\s+\%r(bx|bp|12|13|14),\s*\d*\(\%rsp\)\n//g;
-		    $p =~ s/^\tsubq\s+\$\d+,\s*\%rsp\n//;
-
-		} elsif ($TargetPlatform =~ /^ia64-/) {
-		    $p =~ s/^\t\.prologue .*\n//;
-		    $p =~ s/^\t\.save ar\.pfs, r\d+\n\talloc r\d+ = ar\.pfs, 0, 3[12], \d+, 0\n//;
-		    $p =~ s/^\t\.fframe \d+\n\tadds r12 = -\d+, r12\n//;
-		    $p =~ s/^\t\.save rp, r\d+\n\tmov r\d+ = b0\n//;
-		    $p =~ s/^\t\.(mii|mmi)\n//g;	# bundling is no longer sensible
-		    $p =~ s/^\t;;\n//g;		# discard stops
-		    $p =~ s/^\t\/\/.*\n//g;	# gcc inserts timings in // comments
-
-		    # GCC 3.3 saves r1 in the prologue, move this to the body
-		    if ($p =~ /^\tmov r\d+ = r1\n/) {
-			  $p = $` . $';
-			  $r = $& . $r;
-		    }
-		} elsif ($TargetPlatform =~ /^m68k-/) {
-		    $p =~ s/^\tlink a6,#-?\d.*\n//;
- 		    $p =~ s/^\tpea a6@\n\tmovel sp,a6\n//;    
- 				# The above showed up in the asm code,
- 				# so I added it here.
- 				# I hope it's correct.
- 				# CaS
-		    $p =~ s/^\tmovel d2,sp\@-\n//;
-		    $p =~ s/^\tmovel d5,sp\@-\n//; # SMmark.* only?
-		    $p =~ s/^\tmoveml \#0x[0-9a-f]+,sp\@-\n//; # SMmark.* only?
-		} elsif ($TargetPlatform =~ /^mips-/) {
-		    # the .frame/.mask/.fmask that we use is the same
-		    # as that produced by GCC for miniInterpret; this
-		    # gives GDB some chance of figuring out what happened
-		    $FRAME = "\t.frame\t\$sp,2168,\$31\n\t.mask\t0x90000000,-4\n\t.fmask\t0x00000000,0\n";
-		    $p =~ s/^\t\.(frame).*\n/__FRAME__/g;
-		    $p =~ s/^\t\.(mask|fmask).*\n//g;
-		    $p =~ s/^\t\.cprestore.*\n/\t\.cprestore 416\n/; # 16 + 100 4-byte args
-		    $p =~ s/^\tsubu\t\$sp,\$sp,\d+\n//;
-		    $p =~ s/^\tsw\t\$31,\d+\(\$sp\)\n//;
-		    $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//;
-		    $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//;
-		    $p =~ s/__FRAME__/$FRAME/;
-		} elsif ($TargetPlatform =~ /^powerpc-apple-darwin.*/) {
-		    $pcrel_label = $p;
-		    $pcrel_label =~ s/(.|\n)*^(\"?L\d+\$pb\"?):\n(.|\n)*/$2/ or $pcrel_label = "";
-
-		    $p =~ s/^\tmflr r0\n//;
- 		    $p =~ s/^\tbl saveFP # f\d+\n//;
- 		    $p =~ s/^\tbl saveFP ; save f\d+-f\d+\n//;
-		    $p =~ s/^\"?L\d+\$pb\"?:\n//;
- 		    $p =~ s/^\tstmw r\d+,-\d+\(r1\)\n//;
-   		    $p =~ s/^\tstfd f\d+,-\d+\(r1\)\n//g;
- 		    $p =~ s/^\tstw r0,\d+\(r1\)\n//g;
-  		    $p =~ s/^\tstwu r1,-\d+\(r1\)\n//; 
-  		    $p =~ s/^\tstw r\d+,-\d+\(r1\)\n//g; 
-  		    $p =~ s/^\tbcl 20,31,L\d+\$pb\n//;
-  		    $p =~ s/^L\d+\$pb:\n//;
-  		    $p =~ s/^\tmflr r31\n//;
-
-		    # This is bad: GCC 3 seems to zero-fill some local variables in the prologue
-		    # under some circumstances, only when generating position dependent code.
-		    # I have no idea why, and I don't think it is necessary, so let's toss it.
-		    $p =~ s/^\tli r\d+,0\n//g;
-		    $p =~ s/^\tstw r\d+,\d+\(r1\)\n//g;
-		} elsif ($TargetPlatform =~ /^powerpc-.*-linux/) {
-		    $p =~ s/^\tmflr 0\n//;
-		    $p =~ s/^\tstmw \d+,\d+\(1\)\n//;
-   		    $p =~ s/^\tstfd \d+,\d+\(1\)\n//g;
- 		    $p =~ s/^\tstw r0,8\(1\)\n//;
-  		    $p =~ s/^\tstwu 1,-\d+\(1\)\n//; 
-  		    $p =~ s/^\tstw \d+,\d+\(1\)\n//g; 
-                    
-                        # GCC's "large-model" PIC (-fPIC)
-		    $pcrel_label = $p;
-		    $pcrel_label =~ s/(.|\n)*^.LCF(\d+):\n(.|\n)*/$2/ or $pcrel_label = "";
-
-                    $p =~ s/^\tbcl 20,31,.LCF\d+\n//;
-                    $p =~ s/^.LCF\d+:\n//;
-                    $p =~ s/^\tmflr 30\n//;
-                    $p =~ s/^\tlwz 0,\.LCL\d+-\.LCF\d+\(30\)\n//;
-                    $p =~ s/^\tadd 30,0,30\n//;
-
-		    # This is bad: GCC 3 seems to zero-fill some local variables in the prologue
-		    # under some circumstances, only when generating position dependent code.
-		    # I have no idea why, and I don't think it is necessary, so let's toss it.
-		    $p =~ s/^\tli \d+,0\n//g;
-		    $p =~ s/^\tstw \d+,\d+\(1\)\n//g;
-		} elsif ($TargetPlatform =~ /^powerpc64-.*-linux/) {
-		    $p =~ s/^\tmr 31,1\n//;
-		    $p =~ s/^\tmflr 0\n//;
-		    $p =~ s/^\tstmw \d+,\d+\(1\)\n//;
-   		    $p =~ s/^\tstfd \d+,-?\d+\(1\)\n//g;
- 		    $p =~ s/^\tstd r0,8\(1\)\n//;
-  		    $p =~ s/^\tstdu 1,-\d+\(1\)\n//; 
-  		    $p =~ s/^\tstd \d+,-?\d+\(1\)\n//g; 
-                    
-		    # This is bad: GCC 3 seems to zero-fill some local variables in the prologue
-		    # under some circumstances, only when generating position dependent code.
-		    # I have no idea why, and I don't think it is necessary, so let's toss it.
-		    $p =~ s/^\tli \d+,0\n//g;
-		    $p =~ s/^\tstd \d+,\d+\(1\)\n//g;
-		} else {
-		    print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
-		}
-		
-		# HWL HACK: dont die, just print a warning
-		#print stderr  "HWL: this should die! Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
-		die "Prologue junk?: $p\n" if $p =~ /^\s+[^\s\.]/;
-		
-                # For PIC, we want to keep part of the prologue
-		if ($TargetPlatform =~ /^powerpc-apple-darwin.*/ && $pcrel_label ne "") {
-		    # Darwin: load the current instruction pointer into register r31
-		    $p .= "bcl 20,31,$pcrel_label\n";
-		    $p .= "$pcrel_label:\n";
-		    $p .= "\tmflr r31\n";
-		} elsif ($TargetPlatform =~ /^powerpc-.*-linux/ && $pcrel_label ne "") {
-                    # Linux: load the GOT pointer into register 30
-                    $p .= "\tbcl 20,31,.LCF$pcrel_label\n";
-                    $p .= ".LCF$pcrel_label:\n";
-                    $p .= "\tmflr 30\n";
-                    $p .= "\tlwz 0,.LCL$pcrel_label-.LCF$pcrel_label(30)\n";
-                    $p .= "\tadd 30,0,30\n";
-                } elsif ($TargetPlatform =~ /^i386-apple-darwin.*/ && $pcrel_label ne "") {
-                    $p .= "\tcall ___i686.get_pc_thunk.$pcrel_reg\n";
-                    $p .= "$pcrel_label:\n";
-                }
-		
-		# glue together what's left
-		$c = $p . $r;
-	    }
-	}
-
-	if ( $TargetPlatform =~ /^mips-/ ) {
-	    # MIPS: first, this basic sequence may occur "--- END ---" or not
-	    $c =~ s/^\tlw\t\$31,\d+\(\$sp\)\n\taddu\t\$sp,\$sp,\d+\n\tj\t\$31\n\t\.end/\t\.end/;
-	}
-
-	# toss all epilogue stuff; again, paranoidly
-	if ( $c =~ /--- END ---/ ) {
-	    if (($r, $e) = split(/--- END ---/, $c)) {
-		if ($TargetPlatform =~ /^i386-/) {
-		    $e =~ s/^\tret\n//;
-		    $e =~ s/^\tpopl\s+\%edi\n//;
-		    $e =~ s/^\tpopl\s+\%esi\n//;
-		    $e =~ s/^\tpopl\s+\%edx\n//;
-		    $e =~ s/^\tpopl\s+\%ecx\n//;
-		    $e =~ s/^\taddl\s+\$\d+,\s*\%esp\n//;
-		    $e =~ s/^\tsubl\s+\$-\d+,\s*\%esp\n//;
-		} elsif ($TargetPlatform =~ /^ia64-/) {
-		    $e =~ s/^\tmov ar\.pfs = r\d+\n//;
-		    $e =~ s/^\tmov b0 = r\d+\n//;
-		    $e =~ s/^\t\.restore sp\n\tadds r12 = \d+, r12\n//;
-		    $e =~ s/^\tbr\.ret\.sptk\.many b0\n//;
-		    $e =~ s/^\t\.(mii|mmi|mib)\n//g;	# bundling is no longer sensible
-		    $e =~ s/^\t;;\n//g;			# discard stops - stop at end of body is sufficient
-		    $e =~ s/^\t\/\/.*\n//g;		# gcc inserts timings in // comments
-		} elsif ($TargetPlatform =~ /^m68k-/) {
-		    $e =~ s/^\tunlk a6\n//;
-		    $e =~ s/^\trts\n//;
-		} elsif ($TargetPlatform =~ /^mips-/) {
-		    $e =~ s/^\tlw\t\$31,\d+\(\$sp\)\n//;
-		    $e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//;
-		    $e =~ s/^\taddu\t\$sp,\$sp,\d+\n//;
-		    $e =~ s/^\tj\t\$31\n//;
- 		} elsif ($TargetPlatform =~ /^powerpc-apple-darwin.*/) {
-  		    $e =~ s/^\taddi r1,r1,\d+\n//;
-  		    $e =~ s/^\tlwz r\d+,\d+\(r1\)\n//; 
-  		    $e =~ s/^\tlmw r\d+,-\d+\(r1\)\n//;
- 		    $e =~ s/^\tmtlr r0\n//;
-  		    $e =~ s/^\tblr\n//;
-  		    $e =~ s/^\tb restFP ;.*\n//;
- 		} elsif ($TargetPlatform =~ /^powerpc64-.*-linux/) {
-		    $e =~ s/^\tmr 3,0\n//;
-		    $e =~ s/^\taddi 1,1,\d+\n//;
-		    $e =~ s/^\tld 0,16\(1\)\n//;
-		    $e =~ s/^\tmtlr 0\n//;
-
-		    # callee-save registers
-		    $e =~ s/^\tld \d+,-?\d+\(1\)\n//g;
-		    $e =~ s/^\tlfd \d+,-?\d+\(1\)\n//g;
-
-		    # get rid of the debug junk along with the blr
-		    $e =~ s/^\tblr\n\t.long .*\n\t.byte .*\n//;
-
-		    # incase we missed it with the last one get the blr alone
-		    $e =~ s/^\tblr\n//;
-		} else {
-		    print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
-		}
-
-		print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/;
-
-		# glue together what's left
-		$c = $r . $e;
-		$c =~ s/\n\t\n/\n/; # junk blank line
-	    }
-	}
-
-	# On SPARCs, we don't do --- BEGIN/END ---, we just
-	# toss the register-windowing save/restore/ret* instructions
-	# directly unless they've been generated by function definitions in header
-	# files on Solaris:
-	if ( $TargetPlatform =~ /^sparc-/ ) {
-	    if ( ! ( $TargetPlatform =~ /solaris2$/ && $chkcat[$i] eq 'unknown' )) {
-	    	$c =~ s/^\t(save.*|restore.*|ret|retl)\n//g;
-	    }
-	    # throw away PROLOGUE comments
-	    $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
-	}
-
-	# On Alphas, the prologue mangling is done a little later (below)
-
-    	# toss all calls to __DISCARD__
-	$c =~ s/^\t(call|jbsr|jal)\s+${T_US}__DISCARD__\n//go;
-	$c =~ s/^\tjsr\s+\$26\s*,\s*${T_US}__DISCARD__\n//go if $TargetPlatform =~ /^alpha-/;
-	$c =~ s/^\tbl\s+L___DISCARD__\$stub\n//go if $TargetPlatform =~ /^powerpc-apple-darwin.*/;
-	$c =~ s/^\tbl\s+__DISCARD__(\@plt)?\n//go if $TargetPlatform =~ /^powerpc-.*-linux/;
-	$c =~ s/^\tbl\s+\.__DISCARD__\n\s+nop\n//go if $TargetPlatform =~ /^powerpc64-.*-linux/;
-	$c =~ s/^\tcall\s+L___DISCARD__\$stub\n//go if $TargetPlatform =~ /i386-apple-darwin.*/;
-
-	# IA64: mangle tailcalls into jumps here
-	if ($TargetPlatform =~ /^ia64-/) {
-	    while ($c =~ s/^\tbr\.call\.sptk\.many b0 = (.*)\n(?:^\.L([0-9]*):\n)?(?:\t;;\n)?(?:\tmov r1 = r\d+\n)?(?:\t;;\n)?\t--- TAILCALL ---\n(?:\t;;\n\tbr \.L\d+\n)?/\tbr\.few $1\n/) {
-		# Eek, the gcc optimiser is getting smarter... if we see a jump to the --- TAILCALL ---
-		# marker then we reapply the substitution at the source sites
-		$c =~ s/^\tbr \.L$2\n/\t--- TAILCALL ---\n/g if ($2);
-	    }
-	}
-
-	# MIPS: that may leave some gratuitous asm macros around
-	# (no harm done; but we get rid of them to be tidier)
-	$c =~ s/^\t\.set\tnoreorder\n\t\.set\tnomacro\n\taddu\t(\S+)\n\t\.set\tmacro\n\t\.set\treorder\n/\taddu\t$1\n/
-	    if $TargetPlatform =~ /^mips-/;
-
-    	# toss stack adjustment after DoSparks
-    	$c =~ s/^(\tjbsr _DoSparks\n)\taddqw #8,sp/$1/g
-		if $TargetPlatform =~ /^m68k-/; # this looks old...
-
-	if ( $TargetPlatform =~ /^alpha-/ &&
-	   ! $magic_rdata_seen &&
-	   $c =~ /^\s*\.rdata\n\t\.quad 0\n\t\.align \d\n/ ) {
-	    $c =~ s/^\s*\.rdata\n\t\.quad 0\n\t\.align (\d)\n/\.rdata\n\t\.align $1\n/;
-	    $magic_rdata_seen = 1;
-	}
-
-	# pick some end-things and move them to the next chunk
-
-	# pin a funny end-thing on (for easier matching):
-	$c .= 'FUNNY#END#THING';
-
-	while ( $c =~ /${T_MOVE_DIRVS}FUNNY#END#THING/o ) {
-
-	    $to_move = $1;
-
-	    # on x86 we try not to copy any directives into a literal
-	    # chunk, rather we keep looking for the next real chunk.  This
-	    # is because we get things like
-	    #
-	    #    .globl blah_closure
-	    #    .LC32
-	    #    	.string "..."
-	    #    blah_closure:
-	    #		...
-            #
-	    if ( $TargetPlatform =~ /^(i386|sparc|powerpc)/ && $to_move =~ /${T_COPY_DIRVS}/ ) {
-		$j = $i + 1;
-		while ( $j < $numchks  && $chk[$j] =~ /$T_CONST_LBL/) {
-			$j++;
-		}
-		if ( $j < $numchks ) {
-			$chk[$j] = $to_move . $chk[$j];
-	        }
-	    }
-
-	    elsif ( $i < ($numchks - 1)
-	      && ( $to_move =~ /${T_COPY_DIRVS}/
-	        || ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
-		$chk[$i + 1] = $to_move . $chk[$i + 1];
-		# otherwise they're tossed
-	    }
-
-	    $c =~ s/${T_MOVE_DIRVS}FUNNY#END#THING/FUNNY#END#THING/o;
-	}
-
-    	if ( $TargetPlatform =~ /^alpha-/ && $c =~ /^\t\.ent\s+(\S+)/ ) {
-    	    $ent = $1;
-	    # toss all prologue stuff, except for loading gp, and the ..ng address
-	    unless ($c =~ /\.ent.*\n\$.*\.\.ng:/) {
-		if (($p, $r) = split(/^\t\.prologue/, $c)) {
-		    if (($keep, $junk) = split(/\.\.ng:/, $p)) {
-			$keep =~ s/^\t\.frame.*\n/\t.frame \$30,0,\$26,0\n/;
-			$keep =~ s/^\t\.(mask|fmask).*\n//g;
-			$c = $keep . "..ng:\n";
-		    } else {
-			print STDERR "malformed code block ($ent)?\n"
-		    }
-		}
-		$c .= "\t.prologue" . $r;
-	    }
-    	}
-  
-	$c =~ s/FUNNY#END#THING//;
-
-#	print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c;
-
-	$chk[$i] = $c; # update w/ convenience copy
-    }
-
-    # open CHUNKS, ">/tmp/chunks2" or die "Cannot open /tmp/chunks2: $!\n";
-    # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] }
-    # close CHUNKS;
-
-    if ( $TargetPlatform =~ /^alpha-/ ) {
-	# print out the header stuff first
-	$chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/;
-	print OUTASM $chk[0];
-
-    } elsif ( $TargetPlatform =~ /^hppa/ ) {
-	print OUTASM $chk[0];
-
-    } elsif ( $TargetPlatform =~ /^mips-/ ) {
-	$chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];
-
-	# get rid of horrible "<dollar>Revision: .*$" strings
-	local(@lines0) = split(/\n/, $chk[0]);
-	local($z) = 0;
-	while ( $z <= $#lines0 ) {
-	    if ( $lines0[$z] =~ /^\t\.byte\t0x24,0x52,0x65,0x76,0x69,0x73,0x69,0x6f$/ ) {
-		undef($lines0[$z]);
-		$z++;
-		while ( $z <= $#lines0 ) {
-		    undef($lines0[$z]);
-		    last if $lines0[$z] =~ /[,\t]0x0$/;
-		    $z++;
-		}
-	    }
-	    $z++;
-	}
-	$chk[0] = join("\n", @lines0);
-	$chk[0] =~ s/\n\n+/\n/;
-	print OUTASM $chk[0];
-    }
-
-    # print out all the literal strings next
-    for ($i = 0; $i < $numchks; $i++) {
-	if ( $chkcat[$i] eq 'literal' ) {
-
-	    # HACK: try to detect 16-byte constants and align them
-	    # on a 16-byte boundary.  x86_64 sometimes needs 128-bit
-	    # aligned constants, and so does Darwin/x86.
-	    if ( $TargetPlatform =~ /^x86_64/
-                || $TargetPlatform =~ /^i386-apple-darwin/ ) { 
-		$z = $chk[$i];
- 		if ($z =~ /(\.long.*\n.*\.long.*\n.*\.long.*\n.*\.long|\.quad.*\n.*\.quad)/) {
-		    print OUTASM $T_HDR_literal16;
-		} else {
-		    print OUTASM $T_HDR_literal;
-		}
- 	    } else {
-		print OUTASM $T_HDR_literal;
-	    }
-
-	    print OUTASM $chk[$i];
-	    print OUTASM "; end literal\n" if $TargetPlatform =~ /^hppa/; # for the splitter
-
-	    $chkcat[$i] = 'DONE ALREADY';
-	}
-    }
-
-    # on the HPPA, print out all the bss next
-    if ( $TargetPlatform =~ /^hppa/ ) {
-	for ($i = 1; $i < $numchks; $i++) {
-	    if ( $chkcat[$i] eq 'bss' ) {
-		print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$BSS\$\n\t.align 4\n";
-		print OUTASM $chk[$i];
-
-		$chkcat[$i] = 'DONE ALREADY';
-	    }
-	}
-    }
-
-    for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
-#	print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
-
-	next if $chkcat[$i] eq 'DONE ALREADY';
-
-	if ( $chkcat[$i] eq 'misc' || $chkcat[$i] eq 'unknown' ) {
-	    if ($chk[$i] ne '') {
-		print OUTASM $T_HDR_misc;
- 		&print_doctored($chk[$i], 0);
-	    }
-
-	} elsif ( $chkcat[$i] eq 'toss' ) {
-	    print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n";
-
-	} elsif ( $chkcat[$i] eq 'data' ) {
-	    if ($chk[$i] ne '') {
-		print OUTASM $T_HDR_data;
-		print OUTASM $chk[$i];
-	    }
-
-	} elsif ( $chkcat[$i] eq 'splitmarker' ) {
-	    # we can just re-constitute this one...
-	    # NB: we emit _three_ underscores no matter what,
-	    # so ghc-split doesn't have to care.
-	    print OUTASM "___stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
-
-	} elsif ( $chkcat[$i] eq 'closure'
-	       || $chkcat[$i] eq 'srt'
-	       || $chkcat[$i] eq 'infotbl'
-	       || $chkcat[$i] eq 'entry') { # do them in that order
-	    $symb = $chksymb[$i];
-
-	    # CLOSURE
-	    if ( defined($closurechk{$symb}) ) {
-		print OUTASM $T_HDR_closure;
-		print OUTASM $chk[$closurechk{$symb}];
-		$chkcat[$closurechk{$symb}] = 'DONE ALREADY';
-	    }
-
-	    # SRT
-	    if ( defined($srtchk{$symb}) ) {
-		print OUTASM $T_HDR_relrodata;
-		print OUTASM $chk[$srtchk{$symb}];
-		$chkcat[$srtchk{$symb}] = 'DONE ALREADY';
-	    }
-
-	    # INFO TABLE
-	    if ( defined($infochk{$symb}) ) {
-
-		print OUTASM $T_HDR_info;
-                print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
-                
-		# entry code will be put here!
-
-		$chkcat[$infochk{$symb}] = 'DONE ALREADY';
-	    }
-
-	    # ENTRY POINT
-	    if ( defined($entrychk{$symb}) ) {
-
-		$c = $chk[$entrychk{$symb}];
-
-		# If this is an entry point with an info table,
-                # eliminate the entry symbol and all directives involving it.
-		if (defined($infochk{$symb}) && $TargetPlatform !~ /^ia64-/) {
-			@o = ();
-			foreach $l (split(/\n/,$c)) {
-			    next if $l =~ /^.*$symb_(entry|ret)${T_POST_LBL}/;
-
-			    # If we have .type/.size direrctives involving foo_entry,
-			    # then make them refer to foo_info instead.  The information
-			    # in these directives is used by the cachegrind annotator,
-			    # so it is worthwhile keeping.
-			    if ($l =~ /^\s*\.(type|size).*$symb_(entry|ret)/) {
-				$l =~ s/$symb(_entry|_ret)/${symb}_info/g;
-				push(@o,$l);
-				next;
-			    }
-                            next if $l =~ /^\s*\..*$symb.*\n?/;
-			    push(@o,$l);
-			}
-			$c = join("\n",@o) . "\n";
-		}
-
-		print OUTASM $T_HDR_entry;
-
-		&print_doctored($c, 1); # NB: the 1!!!
-
-		$chkcat[$entrychk{$symb}] = 'DONE ALREADY';
-	    }
-	    
-	} elsif ( $chkcat[$i] eq 'vector' ) {
-	    $symb = $chksymb[$i];
-
-	    # VECTOR TABLE
-	    if ( defined($vectorchk{$symb}) ) {
-		print OUTASM $T_HDR_vector;
-		print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
-
-		# direct return code will be put here!
-		$chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
-
-	    } elsif ( $TargetPlatform =~ /^alpha-/ ) {
-		# Alphas: the commented nop is for the splitter, to ensure
-		# that no module ends with a label as the very last
-		# thing.  (The linker will adjust the label to point
-		# to the first code word of the next module linked in,
-		# even if alignment constraints cause the label to move!)
-
-		print OUTASM "\t# nop\n";
-	    }
-	    
- 	} elsif ( $chkcat[$i] eq 'rodata' ) {
-		print OUTASM $T_HDR_rodata;
-		print OUTASM $chk[$i];
-		$chkcat[$i] = 'DONE ALREADY';
- 	} elsif ( $chkcat[$i] eq 'relrodata' ) {
-		print OUTASM $T_HDR_relrodata;
-		print OUTASM $chk[$i];
-		$chkcat[$i] = 'DONE ALREADY';
- 	} elsif ( $chkcat[$i] eq 'toc' ) {
-            # silly optimisation to print tocs, since they come in groups...
- 	    print OUTASM $T_HDR_toc;
-            local($j)	= $i;
-            while ($chkcat[$j] eq 'toc')
-              { if (   $chk[$j] !~ /\.tc UpdatePAP\[TC\]/ # not needed: always turned into a jump.
-                   ) 
-                {
-                  print OUTASM $chk[$j];
-                }
-                $chkcat[$j] = 'DONE ALREADY';
-                $j++;
- 	    }
- 	    
- 	} elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/ && $chkcat[$i] eq 'dyld' ) {
-	    # apple-darwin: dynamic linker stubs
-	    if($chk[$i] !~ /\.indirect_symbol ___DISCARD__/)
-	    {	# print them out unchanged, but remove the stubs for __DISCARD__
-		print OUTASM $chk[$i];
-	    }
-        } elsif ( $TargetPlatform =~ /^i386-apple-darwin.*/ && $chkcat[$i] eq 'get_pc_thunk' ) {
-            # i386-apple-darwin: __i686.get_pc_thunk.[abcd]x
-            print OUTASM ".section __TEXT,__textcoal_nt,coalesced,no_toc\n";
-            print OUTASM $chk[$i];
-	} else {
-	    &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
-	}
-    }
-
-    print OUTASM $EXTERN_DECLS if $TargetPlatform =~ /^mips-/;
-
-    # finished
-    close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
-    close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
-}
-\end{code}
-
-\begin{code}
-sub hppa_mash_prologue { # OK, epilogue, too
-    local($_) = @_;
-
-    # toss all prologue stuff
-    s/^\s+\.ENTRY[^\0]*--- BEGIN ---/\t.ENTRY/;
-
-    # Lie about our .CALLINFO
-    s/^\s+\.CALLINFO.*$/\t.CALLINFO NO_CALLS,NO_UNWIND/;
-
-    # Get rid of P'
-
-    s/LP'/L'/g;
-    s/RP'/R'/g;
-
-    # toss all epilogue stuff
-    s/^\s+--- END ---[^\0]*\.EXIT/\t.EXIT/;
-
-    # Sorry; we moved the _info stuff to the code segment.
-    s/_info,DATA/_info,CODE/g;
-
-    return($_);
-}
-\end{code}
-
-\begin{code}
-sub print_doctored {
-    local($_, $need_fallthru_patch) = @_;
-
-    if ( $TargetPlatform =~ /^x86_64-/ ) {
-	    # Catch things like
-	    #	
-	    #    movq -4(%ebp), %rax
-	    #    jmp  *%rax
-	    # 
-	    # and optimise:
-	    #
-	    s/^\tmovq\s+(-?\d*\(\%r(bx|bp|13)\)),\s*(\%r(ax|cx|dx|10|11))\n\tjmp\s+\*\3/\tjmp\t\*$1/g;
-	    s/^\tmovl\s+\$${T_US}(.*),\s*(\%e(ax|cx|si|di))\n\tjmp\s+\*\%r\3/\tjmp\t$T_US$1/g;
-    }
-
-    if ( $TargetPlatform !~ /^i386-/ 
-      || ! /^\t[a-z]/  # no instructions in here, apparently
-      || /^${T_US}__stginit_[A-Za-z0-9_]+${T_POST_LBL}/) {
-	print OUTASM $_;
-	return;
-    }
-
-    # OK, must do some x86 **HACKING**
-
-    local($entry_patch)	= '';
-    local($exit_patch)	= '';
-
-    # gotta watch out for weird instructions that
-    # invisibly smash various regs:
-    #   rep*	%ecx used for counting
-    #   scas*	%edi used for destination index
-    #   cmps*	%e[sd]i used for indices
-    #   loop*	%ecx used for counting
-    #
-    # SIGH.
-
-    # We cater for:
-    #  * use of STG reg [ nn(%ebx) ] where no machine reg avail
-    #
-    #  * GCC used an "STG reg" for its own purposes
-    #
-    #  * some secret uses of machine reg, requiring STG reg
-    #    to be saved/restored
-
-    # The most dangerous "GCC uses" of an "STG reg" are when
-    # the reg holds the target of a jmp -- it's tricky to
-    # insert the patch-up code before we get to the target!
-    # So here we change the jmps:
-
-    # --------------------------------------------------------
-    # it can happen that we have jumps of the form...
-    #   jmp *<something involving %esp>
-    # or
-    #   jmp <something involving another naughty register...>
-    #
-    # a reasonably-common case is:
-    #
-    #   movl $_blah,<bad-reg>
-    #   jmp  *<bad-reg>
-    #
-    s/^\tmovl\s+\$${T_US}(.*),\s*(\%e[acd]x)\n\tjmp\s+\*\2/\tjmp $T_US$1/g;
-
-    # Catch things like
-    #
-    #    movl -4(%ebx), %eax
-    #    jmp  *%eax
-    # 
-    # and optimise:
-    #
-    s/^\tmovl\s+(-?\d*\(\%e(bx|si)\)),\s*(\%e[acd]x)\n\tjmp\s+\*\3/\tjmp\t\*$1/g;
-
-    if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
-	s/^\tmovl\s+(.*),\s*\%esi\n\tjmp\s+\*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
-	s/^\tjmp\s+\*(.*\(.*\%esi.*\))\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
-	s/^\tjmp\s+\*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
-	die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
-	    if /(jmp|call)\s+.*\%esi/;
-    }
-    if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
-	s/^\tmovl\s+(.*),\s*\%edi\n\tjmp\s+\*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
-	s/^\tjmp\s+\*(.*\(.*\%edi.*\))\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
-	s/^\tjmp\s+\*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
-	die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
-	    if /(jmp|call)\s+.*\%edi/;
-    }
-
-    # OK, now we can decide what our patch-up code is going to
-    # be:
-
-    # Offsets into register table - you'd better update these magic
-    # numbers should you change its contents!
-    # local($OFFSET_R1)=0;  No offset for R1 in new RTS.
-    local($OFFSET_Hp)=88;
-
-	# Note funky ".=" stuff; we're *adding* to these _patch guys
-    if ( $StolenX86Regs <= 2
-	 && ( /[^0-9]\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
-	$entry_patch .= "\tmovl \%esi,(\%ebx)\n";
-	$exit_patch  .= "\tmovl (\%ebx),\%esi\n";
-
-	# nothing for call_{entry,exit} because %esi is callee-save
-    }
-    if ( $StolenX86Regs <= 3
-	 && ( /${OFFSET_Hp}\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # Hp (edi)
-	$entry_patch .= "\tmovl \%edi,${OFFSET_Hp}(\%ebx)\n";
-	$exit_patch  .= "\tmovl ${OFFSET_Hp}(\%ebx),\%edi\n";
-
-	# nothing for call_{entry,exit} because %edi is callee-save
-    }
-
-    # --------------------------------------------------------
-    # next, here we go with non-%esp patching!
-    #
-    s/^(\t[a-z])/$entry_patch$1/; # before first instruction
-
-# Before calling GC we must set up the exit condition before the call
-# and entry condition when we come back
-
-    # fix _all_ non-local jumps:
-
-    if ( $TargetPlatform =~ /^.*-apple-darwin.*/ ) {
-        # On Darwin, we've got local-looking jumps that are
-        # actually global (i.e. jumps to Lfoo$stub or via
-        # Lfoo$non_lazy_ptr), so we fix those first.
-        # In fact, we just fix everything that contains a dollar
-        # because false positives don't hurt here.
-
-        s/^(\tjmp\s+\*?L.*\$.*\n)/$exit_patch$1/g;
-    }
-
-    s/^\tjmp\s+\*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/go;
-    s/^\tjmp\s+${T_X86_PRE_LLBL_PAT}/\tJMP___L/go;
-
-    s/^(\tjmp\s+.*\n)/$exit_patch$1/g; # here's the fix...
-
-    s/^\tJMP___SL/\tjmp \*${T_X86_PRE_LLBL}/go;
-    s/^\tJMP___L/\tjmp ${T_X86_PRE_LLBL}/go;
-
-    if ($StolenX86Regs == 2 ) {
-	die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_" 
-	    if /^\t(jmp|call)\s+.*\%e(si|di)/;
-    } elsif ($StolenX86Regs == 3 ) {
-	die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_" 
-	    if /^\t(jmp|call)\s+.*\%edi/;
-    }
-
-    # --------------------------------------------------------
-    # that's it -- print it
-    #
-    #die "Funny jumps?\n$_" if /${T_X86_BADJMP}/o; # paranoia
-
-    print OUTASM $_;
-
-    if ( $need_fallthru_patch ) { # exit patch for end of slow entry code
-	print OUTASM $exit_patch;
-	# ToDo: make it not print if there is a "jmp" at the end
-    }
-}
-\end{code}
-
-\begin{code}
-sub init_FUNNY_THINGS {
-    %KNOWN_FUNNY_THING = (
-	# example
-	# "${T_US}stg_.*{T_POST_LBL}", 1,  
-    );
-}
-\end{code}
-
-The following table reversal is used for both info tables and return
-vectors.  In both cases, we remove the first entry from the table,
-reverse the table, put the label at the end, and paste some code
-(that which is normally referred to by the first entry in the table)
-right after the table itself.  (The code pasting is done elsewhere.)
-
-\begin{code}
-sub rev_tbl {
-    local($symb, $tbl, $discard1) = @_;
-
-    return ($tbl) if ($TargetPlatform =~ /^ia64-/);
-
-    local($before) = '';
-    local($label) = '';
-    local(@imports) = (); # hppa only
-    local(@words) = ();
-    local($after) = '';
-    local(@lines) = split(/\n/, $tbl);
-    local($i, $j);
-
-    # Deal with the header...
-    for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t?${T_DOT_WORD}\s+/o; $i++) {
-	$label .= $lines[$i] . "\n",
-	    next if $lines[$i] =~ /^[A-Za-z0-9_]+_info${T_POST_LBL}$/o
-		 || $lines[$i] =~ /${T_DOT_GLOBAL}/o
-		 || $lines[$i] =~ /^${T_US}\S+_vtbl${T_POST_LBL}$/o;
-
-	$before .= $lines[$i] . "\n"; # otherwise...
-    }
-
-    $infoname = $label;
-    $infoname =~ s/(.|\n)*^([A-Za-z0-9_]+_info)${T_POST_LBL}$(.|\n)*/\2/;
-    
-    # Grab the table data...
-    if ( $TargetPlatform !~ /^hppa/ ) {
-	for ( ; $i <= $#lines && $lines[$i] =~ /^\t?${T_DOT_WORD}\s+/o; $i++) {
-	    $line = $lines[$i];
-	    # Convert addresses of SRTs, slow entrypoints and large bitmaps
-	    # to offsets (relative to the info label),
-	    # in order to support position independent code.
-            $line =~ s/$infoname/0/
-            || $line =~ s/([A-Za-z0-9_]+_srtd)$/\1 - $infoname/
-            || $line =~ s/([A-Za-z0-9_]+_srt(\+\d+)?)$/\1 - $infoname/
-	    || $line =~ s/([A-Za-z0-9_]+_slow)$/\1 - $infoname/
-	    || $line =~ s/([A-Za-z0-9_]+_btm)$/\1 - $infoname/
-            || $line =~ s/([A-Za-z0-9_]+_alt)$/\1 - $infoname/
-            || $line =~ s/([A-Za-z0-9_]+_dflt)$/\1 - $infoname/
-            || $line =~ s/([A-Za-z0-9_]+_ret)$/\1 - $infoname/;
-	    push(@words, $line);
-	}
-    } else { # hppa weirdness
-	for ( ; $i <= $#lines && $lines[$i] =~ /^\s+(${T_DOT_WORD}|\.IMPORT)/; $i++) {
-            # FIXME: the RTS now expects offsets instead of addresses
-            # for all labels in info tables.
-	    if ($lines[$i] =~ /^\s+\.IMPORT/) {
-		push(@imports, $lines[$i]);
-	    } else {
-		# We don't use HP's ``function pointers''
-		# We just use labels in code space, like normal people
-		$lines[$i] =~ s/P%//;
-		push(@words, $lines[$i]);
-	    }
-	}
-    }
-
-    # Now throw away any initial zero word from the table.  This is a hack
-    # that lets us reduce the size of info tables when the SRT field is not
-    # needed: see comments StgFunInfoTable in InfoTables.h.
-    #
-    # The .zero business is for Linux/ELF.
-    # The .skip business is for Sparc/Solaris/ELF.
-    # The .blockz business is for HPPA.
-#    if ($discard1) {
-#	if ($words[0] =~ /^\t?(${T_DOT_WORD}\s+0|\.zero\s+4|\.skip\s+4|\.blockz\s+4)/) {
-#		shift(@words);
-#    	}
-#    }
-
-    for (; $i <= $#lines; $i++) {
-	$after .= $lines[$i] . "\n";
-    }
-
-    # Alphas: If we have anonymous text (not part of a procedure), the
-    # linker may complain about missing exception information.  Bleh.
-    # To suppress this, we place a .ent/.end pair around the code.
-    # At the same time, we have to be careful and not enclose any leading
-    # .file/.loc directives.
-    if ( $TargetPlatform =~ /^alpha-/ && $label =~ /^([A-Za-z0-9_]+):$/) {
-        local ($ident) = $1;
-        $before =~ s/^((\s*\.(file|loc)\s+[^\n]*\n)*)/$1\t.ent $ident\n/;
-    	$after .= "\t.end $ident\n";
-    }
-
-    # Alphas: The heroic Simon Marlow found a bug in the Digital UNIX
-    # assembler (!) wherein .quad constants inside .text sections are
-    # first narrowed to 32 bits then sign-extended back to 64 bits.
-    # This obviously screws up our 64-bit bitmaps, so we work around
-    # the bug by replacing .quad with .align 3 + .long + .long [ccshan]
-    if ( $TargetPlatform =~ /^alpha-/ ) {
-	foreach (@words) {
-	    if (/^\s*\.quad\s+([-+0-9].*\S)\s*$/ && length $1 >= 10) {
-		local ($number) = $1;
-		if ($number =~ /^([-+])?(0x?)?([0-9]+)$/) {
-		    local ($sign, $base, $digits) = ($1, $2, $3);
-		    $base = (10, 8, 16)[length $base];
-		    local ($hi, $lo) = (0, 0);
-		    foreach $i (split(//, $digits)) {
-			$j = $lo * $base + $i;
-			$lo = $j % 4294967296;
-			$hi = $hi * $base + ($j - $lo) / 4294967296;
-		    }
-		    ($hi, $lo) = (4294967295 - $hi, 4294967296 - $lo)
-			if $sign eq "-";
-		    $_ = "\t.align 3\n\t.long $lo\n\t.long $hi\n";
-		    # printf STDERR "TURNING %s into 0x %08x %08x\n", $number, $hi, $lo;
-		} else {
-		    print STDERR "Cannot handle \".quad $number\" in info table\n";
-		    exit 1;
-		}
-	    }
-	}
-    }
-
-    $tbl = $before
-	 . (($TargetPlatform !~ /^hppa/) ? '' : join("\n", @imports) . "\n")
-	 . join("\n", @words) . "\n"
-	 . $label . $after;
-
-#   print STDERR "before=$before\n";
-#   print STDERR "label=$label\n";
-#   print STDERR "words=",(reverse @words),"\n";
-#   print STDERR "after=$after\n";
-
-    $tbl;
-}
-\end{code}
-
-The HP is a major nuisance.  The threaded code mangler moved info
-tables from data space to code space, but unthreaded code in the RTS
-still has references to info tables in data space.  Since the HP
-linker is very precise about where symbols live, we need to patch the
-references in the unthreaded RTS as well.
-
-\begin{code}
-sub mini_mangle_asm_hppa {
-    local($in_asmf, $out_asmf) = @_;
-
-    open(INASM, "< $in_asmf")
-	|| &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
-    open(OUTASM,"> $out_asmf")
-	|| &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
-
-    while (<INASM>) {
-	s/_info,DATA/_info,CODE/;   # Move _info references to code space
-	s/P%_PR/_PR/;
-	print OUTASM;
-    }
-
-    # finished:
-    close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
-    close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
-}
-
-\end{code}
-
-\begin{code}
-sub tidy_up_and_die {
-    local($return_val, $msg) = @_;
-    print STDERR $msg;
-    exit (($return_val == 0) ? 0 : 1);
-}
-\end{code}
diff --git a/ghc/driver/ordering-passes b/ghc/driver/ordering-passes
deleted file mode 100644
index 305f3f06b4..0000000000
--- a/ghc/driver/ordering-passes
+++ /dev/null
@@ -1,257 +0,0 @@
-	Ordering the compiler's passes
-	~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-Change notes
-~~~~~~~~~~~~
-1  Nov 94	* NB: if float-out is done after strictness, remember to
-		  switch off demandedness flags on floated bindings!
-13 Oct 94	* Run Float Inwards once more after strictness-simplify [andre]
- 4 Oct 94	* Do simplification between float-in and strictness [andre]
-		* Ignore-inline-pragmas flag for final simplification [andre]
-
-Aug 94		Original: Simon, Andy, Andre
-
-
-
-
-This ordering obeys all the constraints except (5)
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-	full laziness
-	simplify with foldr/build
-	float-in
-	simplify
-	strictness
-	float-in
-
-[check FFT2 still gets benefits with this ordering]
-
-=================================
-	Constraints
-=================================
-
-1. float-in before strictness.
-Reason: floating inwards moves definitions inwards to a site at which
-the binding might well be strict.
-
-Example		let x = ... in
-		    y = x+1
-		in 
-		...
-===>
-		let y = let x = ... in x+1
-		in ...
-
-The strictness analyser will do a better job of the latter
-than the former.
-
-2. Don't simplify between float-in and strictness,
-unless you disable float-let-out-of-let, otherwise
-the simiplifier's local floating might undo some 
-useful floating-in.
-
-Example		let f = let y = .. in \x-> x+y
-		in ...
-===>
-		let y = ... 
-		    f = \x -> x+y
-		in ...
-
-This is a bad move, because now y isn't strict.
-In the pre-float case, the binding for y is strict.
-Mind you, this isn't a very common case, and
-it's easy to disable float-let-from-let.
-
-3. Want full-laziness before foldr/build.  
-Reason: Give priority to sharing rather than deforestation.
-
-Example		\z -> let xs = build g 
-		      in foldr k z xs
-===>
-		let xs = build g
-		in \x -> foldr k z xs
-
-In the post-full-laziness case, xs is shared between all
-applications of the function.   If we did foldr/build
-first, we'd have got 
-
-		\z -> g k z
-
-and now we can't share xs.
-
-
-4.  Want strictness after foldr/build.
-Reason: foldr/build makes new function definitions which
-can benefit from strictness analysis.
-
-Example:	sum [1..10]
-===> (f/b)
-		let g x a | x > 10    = a
-		          | otherwise = g (x+1) (a+x)
-
-Here we clearly want to get strictness analysis on g.
-
-
-5.  Want full laziness after strictness
-Reason: absence may allow something to be floated out
-which would not otherwise be.
-
-Example		\z -> let x = f (a,z) in ...
-===> (absence anal + inline wrapper of f)
-		\z -> let x = f.wrk a in ...
-===> (full laziness)
-		let x= f.wrk a in  \z -> ...
-
-TOO BAD.  This doesn't look a common case to me.
-
-
-6. Want float-in after foldr/build.
-Reason: Desugaring list comprehensions + foldr/build
-gives rise to new float-in opportunities.
-
-Example		...some list comp...
-==> (foldr/build)
-		let v = h xs in
-		case ... of
-		  []     -> v
-		  (y:ys) -> ...(t v)...
-==> (simplifier)
-		let v = h xs in
-		case ... of
-		  [] -> h xs
-		  (y:ys) -> ...(t v)...
-
-Now v could usefully be floated into the second branch.
-
-7. Want simplify after float-inwards.
-[Occurred in the prelude, compiling ITup2.hs, function dfun.Ord.(*,*)]
-This is due to the following (that happens with dictionaries):
-
-let a1 = case v of (a,b) -> a
-in let m1 = \ c -> case c of I# c# -> case c# of 1 -> a1 5
-                                                 2 -> 6
-in let m2 = \ c -> case c of I# c# -> 
-                     case c# +# 1# of cc# -> let cc = I# cc#
-                                             in m1 cc 
-   in (m1,m2)
-
-floating inwards will push the definition of a1 into m1 (supposing
-it is only used there):
-
-in let m1 = let a1 = case v of (a,b) -> a
-            in \ c -> case c of I# c# -> case c# of 1 -> a1 5
-                                		    2 -> 6
-in let m2 = \ c -> case c of I# c# -> 
-                     case c# +# 1# of cc# -> let cc = I# cc#
-                                             in m1 cc 
-   in (m1,m2)
-
-if we do strictness analysis now we will not get a worker-wrapper
-for m1, because of the "let a1 ..." (notice that a1 is not strict in
-its body).
-
-Not having this worker wrapper might be very bad, because it might
-mean that we will have to rebox arguments to m1 if they are
-already unboxed, generating extra allocations, as occurs with m2 (cc)
-above. 
-
-To solve this problem we have decided to run the simplifier after
-float-inwards, so that lets whose body is a HNF are floated out, 
-undoing the float-inwards transformation in these cases.
-We are then back to the original code, which would have a worker-wrapper
-for m1 after strictness analysis and would avoid the extra let in m2.
-
-What we lose in this case are the opportunities for case-floating 
-that could be presented if, for example, a1 would indeed be demanded (strict) 
-after the floating inwards.
-
-The only way of having the best of both is if we have the worker/wrapper
-pass explicitly called, and then we could do with 
-
-float-in
-strictness analysis
-simplify
-strictness analysis
-worker-wrapper generation
-
-as we would 
-a) be able to detect the strictness of m1 after the
-   first call to the strictness analyser, and exploit it with the simplifier
-   (in case it was strict).
-b) after the call to the simplifier (if m1 was not demanded) 
-   it would be floated out just like we currently do, before stricness
-   analysis II and worker/wrapperisation.
-
-The reason to not do worker/wrapperisation twice is to avoid 
-generating wrappers for wrappers which could happen.
-
-
-8.  If full laziness is ever done after strictness, remember to switch off
-demandedness flags on floated bindings!  This isn't done at the moment.
-
-
-Ignore-inline-pragmas flag for final simplification
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-[Occurred in the prelude, compiling ITup2.hs, function dfun.Ord.(*,*)]
-Sometimes (e.g. in dictionary methods) we generate
-worker/wrappers for functions but the wrappers are never
-inlined. In dictionaries we often have 
-
-dict = let f1 = ...
-           f2 = ...
-           ...
-       in (f1,f2,...)
-
-and if we create worker/wrappers for f1,...,fn the wrappers will not
-be inlined anywhere, and we will have ended up with extra
-closures (one for the worker and one for the wrapper) and extra
-function calls, as when we access the dictionary we will be acessing 
-the wrapper, which will call the worker.
-The simplifier never inlines workers into wrappers, as the wrappers
-themselves have INLINE pragmas attached to them (so that they are always
-inlined, and we do not know in advance how many times they will be inlined).
-
-To solve this problem, in the last call to the simplifier we will
-ignore these inline pragmas and handle the workers and the wrappers
-as normal definitions. This will allow a worker to be inlined into
-the wrapper if it satisfies all the criteria for inlining (e.g. it is
-the only occurrence of the worker etc.).
-
-Run Float Inwards once more after strictness-simplify
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-[Occurred in the prelude, compiling IInt.hs, function const.Int.index.wrk]
-When workers are generated after strictness analysis (worker/wrapper),
-we generate them with "reboxing" lets, that simply reboxes the unboxed
-arguments, as it may be the case that the worker will need the 
-original boxed value: 
-
-f x y = case x of 
-          (a,b) -> case y of 
-                     (c,d) -> case a == c of
-                                True -> (x,x)
-                                False -> ((1,1),(2,2))
-
-==> (worker/wrapper)
-
-f_wrapper x y = case x of
-                  (a,b) -> case y of 
-                             (c,d) -> f_worker a b c d 
-
-f_worker a b c d = let x = (a,b)
-                       y = (c,d)
-                   in case a == c of
-                        True -> (x,x)
-                        False -> ((1,1),(2,2))
-
-in this case the simplifier will remove the binding for y as it is not
-used (we expected this to happen very often, but we do not know how
-many "reboxers" are eventually removed and how many are kept), and
-will keep the binding for x.  But notice that x is only used in *one*
-of the branches in the case, but is always being allocated! The
-floating inwards pass would push its definition into the True branch.
-A similar benefit occurs if it is only used inside a let definition.
-These are basically the advantages of floating inwards, but they are
-only exposed after the S.A./worker-wrapperisation of the code!  As we
-also have reasons to float inwards before S.A. we have to run it
-twice.
-
diff --git a/ghc/driver/split/Makefile b/ghc/driver/split/Makefile
deleted file mode 100644
index 6b545de20f..0000000000
--- a/ghc/driver/split/Makefile
+++ /dev/null
@@ -1,17 +0,0 @@
-#-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.2 2000/11/03 16:54:52 simonmar Exp $
-
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-SCRIPT_PROG 	= ghc-split
-
-INTERP=perl
-
-SCRIPT_SUBST_VARS := TARGETPLATFORM
-
-INSTALL_LIBEXEC_SCRIPTS += $(SCRIPT_PROG)
-
-CLEAN_FILES += $(SCRIPT_OBJS)
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/driver/split/ghc-split.lprl b/ghc/driver/split/ghc-split.lprl
deleted file mode 100644
index 4d159ec04f..0000000000
--- a/ghc/driver/split/ghc-split.lprl
+++ /dev/null
@@ -1,618 +0,0 @@
-%************************************************************************
-%*									*
-\section[Driver-obj-splitting]{Splitting into many \tr{.o} files (for libraries)}
-%*									*
-%************************************************************************
-
-\begin{code}
-$TargetPlatform = $TARGETPLATFORM;
-
-($Pgm = $0) =~ s|.*/||;
-$ifile      = $ARGV[0];
-$Tmp_prefix = $ARGV[1];
-$Output     = $ARGV[2];
-
-&split_asm_file($ifile);
-
-open(OUTPUT, "> $Output") ||  &tidy_up_and_die(1,"$Pgm: failed to open `$Output' (to write)\n");
-print OUTPUT "$NoOfSplitFiles\n";
-close(OUTPUT);
-
-exit(0);
-\end{code}
-
-
-\begin{code}
-sub split_asm_file {
-    local($asm_file) = @_;
-
-    open(TMPI, "< $asm_file") || &tidy_up_and_die(1,"$Pgm: failed to open `$asm_file' (to read)\n");
-
-    &collectExports_hppa() if $TargetPlatform =~ /^hppa/;
-    &collectExports_mips() if $TargetPlatform =~ /^mips/;
-    &collectDyldStuff_darwin() if $TargetPlatform =~ /-apple-darwin/;
-
-    $octr = 0;	# output file counter
-    $* = 1; 	# multi-line matches are OK
-
-    %LocalConstant = (); # we have to subvert C compiler's commoning-up of constants...
-
-    $s_stuff = &ReadTMPIUpToAMarker( '', $octr );
-    # that first stuff is a prologue for all .s outputs
-    $prologue_stuff = &process_asm_block ( $s_stuff );
-    # $_ already has some of the next stuff in it...
-
-#   &tidy_up_and_die(1,"$Pgm: no split markers in .s file!\n")
-#	if $prologue_stuff eq $s_stuff;
-
-    # lie about where this stuff came from
-    # Note the \Q: this ignores regex meta-chars in $Tmp_prefix.
-    $prologue_stuff =~ s/\Q"$Tmp_prefix.c"/"$ifile_root.hc"/g;
-
-    while ( $_ ne '' ) { # not EOF
-	$octr++;
-
-	# grab and de-mangle a section of the .s file...
-	$s_stuff = &ReadTMPIUpToAMarker ( $_, $octr );
-	$this_piece = &process_asm_block ( $s_stuff );
-
-	# output to a file of its own
-	# open a new output file...
-	$ofname = "${Tmp_prefix}__${octr}.s";
-	open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n";
-
-	print OUTF $prologue_stuff;
-	print OUTF $this_piece;
-
-	close(OUTF)
-	  || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n");
-    }
-
-    # Make sure that we still have some output when the input file is empty
-    if ( $octr == 0 ) {
-        $octr = 1;
-	$ofname = "${Tmp_prefix}__${octr}.s";
-	open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n";
-
-	print OUTF $prologue_stuff;
-
-	close(OUTF)
-	  || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n");
-    }
-
-    $NoOfSplitFiles = $octr;
-
-    close(TMPI) || &tidy_up_and_die(1,"Failed reading $asm_file\n");
-}
-
-sub collectExports_hppa { # Note: HP-PA only
-
-    %LocalExport = (); # NB: global table
-
-    while(<TMPI>) {
-	if (/^\s+\.EXPORT\s+([^,]+),.*\n/) {
-	    local($label) = $1;
-	    local($body)  = "\t.IMPORT $label";
-	    if (/,DATA/) { 
-		$body .= ",DATA\n"; 
-	    } else { 
-		$body .= ",CODE\n"; 
-	    }
-	    $label =~ s/\$/\\\$/g;
-	    $LocalExport{$label} = $body;
-	}
-    }
-
-    seek(TMPI, 0, 0);
-}
-
-sub collectExports_mips { # Note: MIPS only
-    # (not really sure this is necessary [WDP 95/05])
-
-    $UNDEFINED_FUNS = ''; # NB: global table
-
-    while(<TMPI>) {
-	$UNDEFINED_FUNS .= $_ if /^\t\.globl\s+\S+ \.\S+\n/;
-	# just save 'em all
-    }
-
-    seek(TMPI, 0, 0);
-}
-
-sub collectDyldStuff_darwin {
-    local($chunk_label,$label,$cur_section,$section,$chunk,$alignment,$cur_alignment);
-    
-    %DyldChunks = (); # NB: global table
-    %DyldChunksDefined = (); # NB: global table
-        
-    $cur_section = '';
-    $section = '';
-    $label = '';
-    $chunk = '';
-    $alignment = '';
-    $cur_alignment = '';
-    
-    while ( 1 ) {
-	$_ = <TMPI>;
-	if ( $_ eq '' || /^L(_.+)\$.+:/ ) {
-	    if ( $label ne '' ) {
-		$DyldChunksDefined{$label} .= $section . $alignment . $chunk_label . $ chunk;
-		if( $section =~ s/\.data/\.non_lazy_symbol_pointer/ ) {
-		    $chunk = "\t.indirect_symbol $label\n\t.long 0\n";
-		}
-		$DyldChunks{$label} .= $section . $alignment . $chunk_label . $chunk;
-		print STDERR "### dyld chunk: $label\n$section$alignment$chunk\n###\n" if $Dump_asm_splitting_info;
-	    }
-	    last if ($_ eq '');
-		
-	    $chunk = '';
-	    $chunk_label = $_;
-	    $label = $1;
-	    $section = $cur_section;
-	    $alignment = $cur_alignment;
-	    print STDERR "label: $label\n" if $Dump_asm_splitting_info;
-	} elsif ( /^\s*\.(symbol_stub|picsymbol_stub|lazy_symbol_pointer|non_lazy_symbol_pointer|data|section __IMPORT,.*)/ ) {
-	    $cur_section = $_;
-	    printf STDERR "section: $cur_section\n" if $Dump_asm_splitting_info;
-	    $cur_alignment = ''
-	} elsif ( /^\s*\.section\s+__TEXT,__symbol_stub1,symbol_stubs,pure_instructions,\d+/ ) {
-	    $cur_section = $_;
-	    printf STDERR "section: $cur_section\n" if $Dump_asm_splitting_info;
-                # always make sure we align things
-	    $cur_alignment = '\t.align 2'
-	} elsif ( /^\s*\.align.*/ ) { 
-	    $cur_alignment = $_;
-	    printf STDERR "alignment: $cur_alignment\n" if $Dump_asm_splitting_info;
-	} else {
-	    $chunk .= $_;
-	}
-    }
-    
-    seek(TMPI, 0, 0);
-}
-
-sub ReadTMPIUpToAMarker {
-    local($str, $count) = @_; # already read bits
-
-    
-    for ( $_ = <TMPI>; $_ ne '' && ! /_?__stg_split_marker/; $_ = <TMPI> ) {
-	$str .= $_;
-    }
-    # if not EOF, then creep forward until next "real" line
-    # (throwing everything away).
-    # that first "real" line will stay in $_.
-
-    # This loop is intended to pick up the body of the split_marker function
-    # Note that the assembler mangler will already have eliminated this code
-    # if it's been invoked (which it probably has).
-
-    while ($_ ne '' && (/_?__stg_split_marker/
-		     || /^L[^C].*:$/
-		     || /^\.stab/
-		     || /\t\.proc/
-		     || /\t\.stabd/
-		     || /\t\.even/
-		     || /\tunlk a6/
-		     || /^\t!#PROLOGUE/
-		     || /\t\.prologue/
-		     || /\t\.frame/
-                     # || /\t\.end/ NOT!  Let the split_marker regexp catch it
-                     # || /\t\.ent/ NOT!  Let the split_marker regexp catch it
-		     || /^\s+(save|retl?|restore|nop)/)) {
-	$_ = <TMPI>;
-    }
-
-    print STDERR "### BLOCK:$count:\n$str" if $Dump_asm_splitting_info;
-
-    # return str
-    $str =~ tr/\r//d if $TargetPlatform =~ /-mingw32$/; # in case Perl doesn't convert line endings
-    $str;
-}
-\end{code}
-
-We must (a)~strip the marker off the block, (b)~record any literal C
-constants that are defined here, and (c)~inject copies of any C constants
-that are used-but-not-defined here.
-
-\begin{code}
-sub process_asm_block {
-    local($str) = @_;
-
-    return(&process_asm_block_darwin($str))
-                            if $TargetPlatform =~ /-apple-darwin/;
-    return(&process_asm_block_m68k($str))  if $TargetPlatform =~ /^m68k-/;
-    return(&process_asm_block_sparc($str)) if $TargetPlatform =~ /^sparc-/;
-    return(&process_asm_block_iX86($str))  if $TargetPlatform =~ /^i[34]86-/;
-    return(&process_asm_block_x86_64($str))  if $TargetPlatform =~ /^x86_64-/;
-    return(&process_asm_block_alpha($str)) if $TargetPlatform =~ /^alpha-/;
-    return(&process_asm_block_hppa($str))  if $TargetPlatform =~ /^hppa/;
-    return(&process_asm_block_mips($str))   if $TargetPlatform =~ /^mips-/;
-    return(&process_asm_block_powerpc_linux($str))
-                            if $TargetPlatform =~ /^powerpc-[^-]+-linux/;
-
-    # otherwise...
-    &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n");
-}
-
-sub process_asm_block_sparc {
-    local($str) = @_;
-
-    # strip the marker
-    if ( $OptimiseC ) {
-	$str =~ s/_?__stg_split_marker.*:\n//;
-    } else {
-	$str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
-	$str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/;
-    }
-
-    # make sure the *.hc filename gets saved; not just ghc*.c (temp name)
-    $str =~ s/^\.stabs "(ghc\d+\.c)"/.stabs "$ifile_root.hc"/g; # HACK HACK
-
-    # remove/record any literal constants defined here
-    while ( $str =~ /(\t\.align .\n\.?(L?LC\d+):\n(\t\.asci[iz].*\n)+)/ ) {
-	local($label) = $2;
-	local($body)  = $1;
-
-	&tidy_up_and_die(1,"Local constant label $label already defined!\n")
-	    if $LocalConstant{$label};
-
-	$LocalConstant{$label} = $body;
-	
-	$str =~ s/\t\.align .\n\.?LL?C\d+:\n(\t\.asci[iz].*\n)+//;
-    }
-
-    # inject definitions for any local constants now used herein
-    foreach $k (keys %LocalConstant) {
-	if ( $str =~ /\b$k\b/ ) {
-	    $str = $LocalConstant{$k} . $str;
-	}
-    }
-
-   print STDERR "### STRIPPED BLOCK (sparc):\n$str" if $Dump_asm_splitting_info;
-
-   $str;
-}
-
-sub process_asm_block_m68k {
-    local($str) = @_;
-
-    # strip the marker
-
-    $str =~ s/(\.text\n\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
-    $str =~ s/(\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/;
-
-    # it seems prudent to stick on one of these:
-    $str = "\.text\n\t.even\n" . $str;
-
-    # remove/record any literal constants defined here
-    while ( $str =~ /((LC\d+):\n\t\.ascii.*\n)/ ) {
-	local($label) = $2;
-	local($body)  = $1;
-
-	&tidy_up_and_die(1,"Local constant label $label already defined!\n")
-	    if $LocalConstant{$label};
-
-	$LocalConstant{$label} = $body;
-	
-	$str =~ s/LC\d+:\n\t\.ascii.*\n//;
-    }
-
-    # inject definitions for any local constants now used herein
-    foreach $k (keys %LocalConstant) {
-	if ( $str =~ /\b$k\b/ ) {
-	    $str = $LocalConstant{$k} . $str;
-	}
-    }
-
-   print STDERR "### STRIPPED BLOCK (m68k):\n$str" if $Dump_asm_splitting_info;
-
-   $str;
-}
-
-sub process_asm_block_alpha {
-    local($str) = @_;
-
-    # strip the marker
-    if ( $OptimiseC ) {
-	$str =~ s/_?__stg_split_marker.*:\n//;
-    } else {
-	$str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
-    }
-
-    # remove/record any literal constants defined here
-    while ( $str =~ /(\.rdata\n\t\.align \d\n)?(\$(C\d+):\n\t\..*\n)/ ) {
-	local($label) = $3;
-	local($body)  = $2;
-
-	&tidy_up_and_die(1,"Local constant label $label already defined!\n")
-	    if $LocalConstant{$label};
-
-	$LocalConstant{$label} = ".rdata\n\t.align 3\n" . $body . "\t.text\n";
-	
-	$str =~ s/(\.rdata\n\t\.align \d\n)?\$C\d+:\n\t\..*\n//;
-    }
-
-    # inject definitions for any local constants now used herein
-    foreach $k (keys %LocalConstant) {
-	if ( $str =~ /\$\b$k\b/ ) {
-	    $str = $LocalConstant{$k} . $str;
-	}
-    }
-
-    # Slide the dummy direct return code into the vtbl .ent/.end block,
-    # to keep the label fixed if it's the last thing in a module, and
-    # to avoid having any anonymous text that the linker will complain about
-    $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
-
-    print STDERR "### STRIPPED BLOCK (alpha):\n$str" if $Dump_asm_splitting_info;
-
-    $str;
-}
-
-sub process_asm_block_iX86 {
-    local($str) = @_;
-
-    # strip the marker
-
-    $str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
-    $str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/;
-
-    # it seems prudent to stick on one of these:
-    $str = "\.text\n\t.align 4\n" . $str;
-
-    # remove/record any literal constants defined here
-    # [perl made uglier to work around the perl 5.7/5.8 bug documented at
-    # http://bugs6.perl.org/rt2/Ticket/Display.html?id=1760 and illustrated
-    # by the seg fault of perl -e '("x\n" x 5000) =~ /(.*\n)+/'
-    # -- ccshan 2002-09-05]
-    while ( ($str =~ /(\.?(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ )) {
-	local($label) = $2;
-	local($body)  = $1;
-	local($prefix, $suffix, $*) = ($`, $', 0);
-
-	&tidy_up_and_die(1,"Local constant label $label already defined!\n")
-	    if $LocalConstant{$label};
-
-	while ( $suffix =~ /^((\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ ) {
-	    $body .= $1;
-	    $suffix = $';
-	}
-	$LocalConstant{$label} = $body;
-	$str = $prefix . $suffix;
-    }
-
-    # inject definitions for any local constants now used herein
-    foreach $k (keys %LocalConstant) {
-	if ( $str =~ /\b$k\b/ ) {
-	    $str = $LocalConstant{$k} . $str;
-	}
-    }
-
-   print STDERR "### STRIPPED BLOCK (iX86):\n$str" if $Dump_asm_splitting_info;
-
-   $str;
-}
-\end{code}
-
-\begin{code}
-sub process_asm_block_x86_64 {
-    local($str) = @_;
-
-    # remove/record any literal constants defined here
-    # [perl made uglier to work around the perl 5.7/5.8 bug documented at
-    # http://bugs6.perl.org/rt2/Ticket/Display.html?id=1760 and illustrated
-    # by the seg fault of perl -e '("x\n" x 5000) =~ /(.*\n)+/'
-    # -- ccshan 2002-09-05]
-    while ( ($str =~ /(\.?(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ )) {
-	local($label) = $2;
-	local($body)  = $1;
-	local($prefix, $suffix, $*) = ($`, $', 0);
-
-	&tidy_up_and_die(1,"Local constant label $label already defined!\n")
-	    if $LocalConstant{$label};
-
-	while ( $suffix =~ /^((\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ ) {
-	    $body .= $1;
-	    $suffix = $';
-	}
-	$LocalConstant{$label} = $body;
-	$str = $prefix . $suffix;
-    }
-
-    # inject definitions for any local constants now used herein
-    foreach $k (keys %LocalConstant) {
-	if ( $str =~ /\b$k\b/ ) {
-	    $str = $LocalConstant{$k} . $str;
-	}
-    }
-
-   print STDERR "### STRIPPED BLOCK (x86_64):\n$str" if $Dump_asm_splitting_info;
-
-   $str;
-}
-\end{code}
-
-\begin{code}
-sub process_asm_block_hppa {
-    local($str) = @_;
-
-    # strip the marker
-    $str =~ s/___stg_split_marker.*\n//;
-
-    # remove/record any imports defined here
-    while ( $str =~ /^(\s+\.IMPORT\s.*\n)/ ) {
-	$Imports .= $1;
-
-	$str =~ s/^\s+\.IMPORT.*\n//;
-    }
-
-    # remove/record any literal constants defined here
-    while ( $str =~ /^(\s+\.align.*\n(L\$C\d+)\n(\s.*\n)+); end literal\n/ ) {
-	local($label) = $2;
-	local($body)  = $1;
-	local($prefix) = $`;
-	local($suffix) = $';
-	$label =~ s/\$/\\\$/g;
-
-	&tidy_up_and_die(1,"Local constant label $label already defined!\n")
-	    if $LocalConstant{$label};
-
-	$LocalConstant{$label} = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n\n" . $body;
-	
-	$str = $prefix . $suffix;
-    }
-
-    # inject definitions for any local constants now used herein
-    foreach $k (keys %LocalConstant) {
-	if ( $str =~ /\b$k\b/ ) {
-	    $str = $LocalConstant{$k} . $str;
-	}
-    }
-
-    # inject required imports for local exports in other chunks
-    foreach $k (keys %LocalExport) {
-	if ( $str =~ /\b$k\b/ && ! /EXPORT\s+$k\b/ ) {
-	    $str = $LocalExport{$k} . $str;
-	}
-    }
-
-    # inject collected imports
-
-    $str = $Imports . $str;
-
-    print STDERR "### STRIPPED BLOCK (hppa):\n$str" if $Dump_asm_splitting_info;
-
-    $str;
-}
-\end{code}
-
-\begin{code}
-sub process_asm_block_mips {
-    local($str) = @_;
-
-    # strip the marker
-    if ( $OptimiseC ) {
-	$str =~ s/_?__stg_split_marker.*:\n//;
-    } else {
-	$str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/;
-    }
-
-    # remove/record any literal constants defined here
-    while ( $str =~ /(\t\.rdata\n\t\.align \d\n)?(\$(LC\d+):\n(\t\.byte\t.*\n)+)/ ) {
-	local($label) = $3;
-	local($body)  = $2;
-
-	&tidy_up_and_die(1,"Local constant label $label already defined!\n")
-	    if $LocalConstant{$label};
-
-	$LocalConstant{$label} = "\t.rdata\n\t.align 2\n" . $body . "\t.text\n";
-	
-	$str =~ s/(\t\.rdata\n\t\.align \d\n)?\$LC\d+:\n(\t\.byte\t.*\n)+//;
-    }
-
-    # inject definitions for any local constants now used herein
-    foreach $k (keys %LocalConstant) {
-	if ( $str =~ /\$\b$k\b/ ) {
-	    $str = $LocalConstant{$k} . $str;
-	}
-    }
-
-    # Slide the dummy direct return code into the vtbl .ent/.end block,
-    # to keep the label fixed if it's the last thing in a module, and
-    # to avoid having any anonymous text that the linker will complain about
-    $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g;
-
-    $str .= $UNDEFINED_FUNS; # pin on gratuitiously-large amount of info
-
-    print STDERR "### STRIPPED BLOCK (mips):\n$str" if $Dump_asm_splitting_info;
-
-    $str;
-}
-\end{code}
-
-\begin{code}
-# The logic for both Darwin/PowerPC and Darwin/x86 ends up being the same.
-
-sub process_asm_block_darwin {
-    local($str) = @_;
-    local($dyld_stuff) = '';
-
-    # strip the marker
-    $str =~ s/___stg_split_marker.*\n//;
-
-    $str =~ s/L_.*\$.*:\n(.|\n)*//;
-
-    # remove/record any literal constants defined here
-    while ( $str =~ s/^(\s+.const.*\n\s+\.align.*\n(LC\d+):\n(\s\.(byte|short|long|fill|space|ascii).*\n)+)// ) {
-	local($label) = $2;
-	local($body)  = $1;
-
-	&tidy_up_and_die(1,"Local constant label $label already defined!\n")
-	    if $LocalConstant{$label};
-
-	$LocalConstant{$label} = $body;
-    }
-
-    # inject definitions for any local constants now used herein
-    foreach $k (keys %LocalConstant) {
-	if ( $str =~ /\b$k(\b|\[)/ ) {
-	    $str = $LocalConstant{$k} . $str;
-	}
-    }
-    
-    foreach $k (keys %DyldChunks) {
-	if ( $str =~ /\bL$k\$/ ) {
-	    if ( $str =~ /^$k:$/ ) {
-		$dyld_stuff .= $DyldChunksDefined{$k};
-	    } else {
-		$dyld_stuff .= $DyldChunks{$k};
-	    }
-	}
-    }
-
-    $str .= "\n" . $dyld_stuff;
-
-    print STDERR "### STRIPPED BLOCK (darwin):\n$str" if $Dump_asm_splitting_info;
-
-    $str;
-}
-\end{code}
-
-\begin{code}
-sub process_asm_block_powerpc_linux {
-    local($str) = @_;
-
-    # strip the marker
-    $str =~ s/__stg_split_marker.*\n//;
-
-    # remove/record any literal constants defined here
-    while ( $str =~ s/^(\s+.section\s+\.rodata\n\s+\.align.*\n(\.LC\d+):\n(\s\.(byte|short|long|quad|2byte|4byte|8byte|fill|space|ascii|string).*\n)+)// ) {
-	local($label) = $2;
-	local($body)  = $1;
-
-	&tidy_up_and_die(1,"Local constant label $label already defined!\n")
-	    if $LocalConstant{$label};
-
-	$LocalConstant{$label} = $body;
-    }
-
-    # inject definitions for any local constants now used herein
-    foreach $k (keys %LocalConstant) {
-	if ( $str =~ /[\s,]$k\b/ ) {
-	    $str = $LocalConstant{$k} . $str;
-	}
-    }
-    
-    print STDERR "### STRIPPED BLOCK (powerpc linux):\n$str" if $Dump_asm_splitting_info;
-
-    $str;
-}
-\end{code}
-
-\begin{code}
-sub tidy_up_and_die {
-    local($return_val, $msg) = @_;
-    print STDERR $msg;
-    exit (($return_val == 0) ? 0 : 1);
-}
-\end{code}
diff --git a/ghc/driver/test_mangler b/ghc/driver/test_mangler
deleted file mode 100644
index 96cf31ca68..0000000000
--- a/ghc/driver/test_mangler
+++ /dev/null
@@ -1,29 +0,0 @@
-#! /usr/bin/perl
-# a simple wrapper to test a .s-file mangler
-# reads stdin, writes stdout
-
-push(@INC,"/net/dazdak/BUILDS/gransim-4.04/i386-unknown-linux/ghc/driver");
-
-$TargetPlatform = $ARGV[0]; shift; # nice error checking, Will
-
-require("ghc-asm.prl") || die "require mangler failed!\n";
-
-$SpX86Mangling = 1;
-$StolenX86Regs = 4;
-
-open(INP, "> /tmp/mangle1.$$") || die "Can't open tmp file 1\n";
-while (<>) {
-    print INP $_;
-}
-close(INP) || die "Can't close tmp file 1";
-
-&mangle_asm("/tmp/mangle1.$$", "/tmp/mangle2.$$");
-
-open(INP, "< /tmp/mangle2.$$") || die "Can't open tmp file 2\n";
-while (<INP>) {
-    print STDOUT $_;
-}
-close(INP) || die "Can't close tmp file 2";
-
-unlink("/tmp/mangle1.$$", "/tmp/mangle2.$$");
-exit(0);
diff --git a/ghc/ghc.spec.in b/ghc/ghc.spec.in
deleted file mode 100644
index 87dc6e905a..0000000000
--- a/ghc/ghc.spec.in
+++ /dev/null
@@ -1,146 +0,0 @@
-# RPM spec file for GHC					         -*-rpm-spec-*-
-#
-# Copyright [1998..2004] The GHC Team
-#
-# Thanks to Zoltan Vorosbaranyi <vbzoli@vbzo.li> for suggestions in 
-# earlier versions and Pixel <pixel@mandrakesoft.com> for coding tips.
-#
-# This file is subject to the same free software license as GHC.
-
-%define name    ghc
-%define version @ProjectVersion@
-%define release @release@
-
-Name:           %{name}
-Version:        %{version}
-Release:        %{release}
-License:        BSD-like
-Group:          Development/Languages/Haskell
-URL:            http://haskell.org/ghc/
-Source:         http://haskell.org/ghc/dist/%{version}/ghc-%{version}-src.tar.bz2
-Packager:       Sven Panne <sven.panne@aedion.de>
-BuildRoot:      %{_tmppath}/%{name}-%{version}-build
-Prefix:         %{_prefix}
-Requires:       gmp, readline
-BuildRequires:  alex >= 2.0, happy >= 1.15, ghc >= 5, haddock, docbook-dtd, docbook-xsl-stylesheets, libxslt, libxml2, fop, xmltex, dvips, gmp, readline-devel, mesaglut-devel
-Provides:       haskell
-Summary:        The Glasgow Haskell Compiler
-
-%description
-Haskell is the standard lazy purely functional programming language.
-The current language version is Haskell 98, agreed in December 1998,
-with a revised version published in January 2003.
-
-GHC is a state-of-the-art programming suite for Haskell. Included is
-an optimising compiler generating good code for a variety of
-platforms, together with an interactive system for convenient, quick
-development. The distribution includes space and time profiling
-facilities, a large collection of libraries, and support for various
-language extensions, including concurrency, exceptions, and foreign
-language interfaces (C, C++, whatever).
-
-A wide variety of Haskell related resources (tutorials, libraries,
-specifications, documentation, compilers, interpreters, references,
-contact information, links to research groups) are available from the
-Haskell home page at http://haskell.org/.
-
-Authors:
---------
-    Krasimir Angelov <ka2_mail@yahoo.com>
-    Manuel Chakravarty <chak@cse.unsw.edu.au>
-    Koen Claessen <koen@cs.chalmers.se>
-    Robert Ennals <Robert.Ennals@cl.cam.ac.uk>
-    Sigbjorn Finne <sof@galconn.com>
-    Gabrielle Keller <keller@cvs.haskell.org>
-    Marcin Kowalczyk <qrczak@knm.org.pl>
-    Jeff Lewis <jeff@galconn.com>
-    Ian Lynagh <igloo@earth.li>
-    Simon Marlow <simonmar@microsoft.com>
-    Sven Panne <sven.panne@aedion.de>
-    Ross Paterson <ross@soi.city.ac.uk>
-    Simon Peyton Jones <simonpj@microsoft.com>
-    Don Stewart <dons@cse.unsw.edu.au>
-    Volker Stolz <stolz@i2.informatik.rwth-aachen.de>
-    Wolfgang Thaller <wolfgang.thaller@gmx.net>
-    Andrew Tolmach <apt@cs.pdx.edu>
-    Keith Wansbrough <Keith.Wansbrough@cl.cam.ac.uk>
-    Michael Weber <michael.weber@post.rwth-aachen.de>
-    plus a dozen helping hands...
-
-%package prof
-Requires:       ghc = %{version}-%{release}
-Summary:        Profiling libraries for GHC
-Group:          Development/Libraries
-
-%description prof
-Profiling libraries for Glorious Glasgow Haskell Compilation System
-(GHC).  They should be installed when GHC's profiling subsystem is
-needed.
-
-%prep
-%setup
-
-%build
-test -f configure || autoreconf
-./configure --prefix=%{prefix}
-make
-make html
-make -C ghc/docs/ext-core ps
-make -C ghc/docs/storage-mgt ps
- 
-%install
-make prefix=${RPM_BUILD_ROOT}%{prefix} install
-make datadir=`pwd` install-docs
-
-# generate the file list for lib/ _excluding_ all files needed for profiling
-# only
-#
-# * generating file lists in a BUILD_ROOT spec is a bit tricky: the file list
-#   has to contain complete paths, _but_ without the BUILD_ROOT, we also do
-#   _not_ want have directory names in the list; furthermore, we have to make
-#   sure that any leading / is removed from %{prefix}/lib, as find has to 
-#   interpret the argument as a relative path; however, we have to include the
-#   leading / again in the final file list (otherwise, rpm complains)
-# * isn't there an easier way to do all this?
-#
-dir=`pwd`
-cd ${RPM_BUILD_ROOT}
-libdir=`echo %{prefix}/lib | sed 's|^/||'`
-find $libdir ! -type d !  -name '*.p_hi' !   -name '*_p.a'    -print | sed 's|^|/|' > $dir/rpm-noprof-lib-files
-find $libdir ! -type d \( -name '*.p_hi' -or -name '*_p.a' \) -print | sed 's|^|/|' > $dir/rpm-prof-lib-files
-cd $dir
-
-%clean
-rm -rf ${RPM_BUILD_ROOT}
-
-%files -f rpm-noprof-lib-files
-%defattr(-,root,root)
-%doc docs/docbook-cheat-sheet/docbook-cheat-sheet
-%doc ghc/ANNOUNCE
-%doc ghc/LICENSE
-%doc ghc/README
-%doc ghc/docs/building/building
-%doc ghc/docs/ext-core/core.ps
-%doc ghc/docs/storage-mgt/ldv.ps
-%doc ghc/docs/storage-mgt/rp.ps
-%doc ghc/docs/storage-mgt/sm.ps
-%doc ghc/docs/users_guide/users_guide
-%doc hslibs/doc/hslibs
-%doc html/*
-%doc libraries/Cabal/doc/Cabal
-%{prefix}/bin/ghc
-%{prefix}/bin/ghc-%{version}
-%{prefix}/bin/ghc-pkg
-%{prefix}/bin/ghc-pkg-%{version}
-%{prefix}/bin/ghci
-%{prefix}/bin/ghci-%{version}
-%{prefix}/bin/ghcprof
-%{prefix}/bin/hasktags
-%{prefix}/bin/hp2ps
-%{prefix}/bin/hsc2hs
-%{prefix}/bin/runghc
-%{prefix}/bin/runhaskell
-%{prefix}/bin/stat2resid
-
-%files prof -f rpm-prof-lib-files
-%defattr(-,root,root)
diff --git a/ghc/includes/Block.h b/ghc/includes/Block.h
deleted file mode 100644
index d1705ad686..0000000000
--- a/ghc/includes/Block.h
+++ /dev/null
@@ -1,202 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-1999
- *
- * Block structure for the storage manager
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef BLOCK_H
-#define BLOCK_H
-
-/* The actual block and megablock-size constants are defined in
- * includes/Constants.h, all constants here are derived from these.
- */
-
-/* Block related constants (BLOCK_SHIFT is defined in Constants.h) */
-
-#define BLOCK_SIZE   (1<<BLOCK_SHIFT)
-#define BLOCK_SIZE_W (BLOCK_SIZE/sizeof(W_))
-#define BLOCK_MASK   (BLOCK_SIZE-1)
-
-#define BLOCK_ROUND_UP(p)   ((void *) (((W_)(p)+BLOCK_SIZE-1) & ~BLOCK_MASK))
-#define BLOCK_ROUND_DOWN(p) ((void *) ((W_)(p) & ~BLOCK_MASK))
-
-/* Megablock related constants (MBLOCK_SHIFT is defined in Constants.h) */
-
-#define MBLOCK_SIZE    (1<<MBLOCK_SHIFT)
-#define MBLOCK_SIZE_W  (MBLOCK_SIZE/sizeof(W_))
-#define MBLOCK_MASK    (MBLOCK_SIZE-1)
-
-#define MBLOCK_ROUND_UP(p)   ((void *)(((W_)(p)+MBLOCK_SIZE-1) & ~MBLOCK_MASK))
-#define MBLOCK_ROUND_DOWN(p) ((void *)((W_)(p) & ~MBLOCK_MASK ))
-
-/* The largest size an object can be before we give it a block of its
- * own and treat it as an immovable object during GC, expressed as a
- * fraction of BLOCK_SIZE.
- */
-#define LARGE_OBJECT_THRESHOLD ((nat)(BLOCK_SIZE * 8 / 10))
-
-/* -----------------------------------------------------------------------------
- * Block descriptor.  This structure *must* be the right length, so we
- * can do pointer arithmetic on pointers to it.
- */
-
-/* The block descriptor is 64 bytes on a 64-bit machine, and 32-bytes
- * on a 32-bit machine.
- */
-
-#ifndef CMINUSMINUS
-typedef struct bdescr_ {
-  StgPtr start;			/* start addr of memory */
-  StgPtr free;			/* first free byte of memory */
-  struct bdescr_ *link;		/* used for chaining blocks together */
-  union { 
-      struct bdescr_ *back;	/* used (occasionally) for doubly-linked lists*/
-      StgWord *bitmap;
-  } u;
-  unsigned int gen_no;		/* generation */
-  struct step_ *step;		/* step */
-  StgWord32 blocks;		/* no. of blocks (if grp head, 0 otherwise) */
-  StgWord32 flags;              /* block is in to-space */
-#if SIZEOF_VOID_P == 8
-  StgWord32 _padding[2];
-#else
-  StgWord32 _padding[0];
-#endif
-} bdescr;
-#endif
-
-#if SIZEOF_VOID_P == 8
-#define BDESCR_SIZE  0x40
-#define BDESCR_MASK  0x3f
-#define BDESCR_SHIFT 6
-#else
-#define BDESCR_SIZE  0x20
-#define BDESCR_MASK  0x1f
-#define BDESCR_SHIFT 5
-#endif
-
-/* Block contains objects evacuated during this GC */
-#define BF_EVACUATED 1
-/* Block is a large object */
-#define BF_LARGE     2
-/* Block is pinned */
-#define BF_PINNED    4
-/* Block is part of a compacted generation */
-#define BF_COMPACTED 8
-/* Block is free, and on the free list */
-#define BF_FREE      16
-
-/* Finding the block descriptor for a given block -------------------------- */
-
-#ifdef CMINUSMINUS
-
-#define Bdescr(p) \
-    ((((p) &  MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) \
-     | ((p) & ~MBLOCK_MASK))
-
-#else
-
-INLINE_HEADER bdescr *Bdescr(StgPtr p)
-{
-  return (bdescr *)
-    ((((W_)p &  MBLOCK_MASK & ~BLOCK_MASK) >> (BLOCK_SHIFT-BDESCR_SHIFT)) 
-     | ((W_)p & ~MBLOCK_MASK)
-     );
-}
-
-#endif
-
-/* Useful Macros ------------------------------------------------------------ */
-
-/* Offset of first real data block in a megablock */
-
-#define FIRST_BLOCK_OFF \
-   ((W_)BLOCK_ROUND_UP(BDESCR_SIZE * (MBLOCK_SIZE / BLOCK_SIZE)))
-
-/* First data block in a given megablock */
-
-#define FIRST_BLOCK(m) ((void *)(FIRST_BLOCK_OFF + (W_)(m)))
-   
-/* Last data block in a given megablock */
-
-#define LAST_BLOCK(m)  ((void *)(MBLOCK_SIZE-BLOCK_SIZE + (W_)(m)))
-
-/* First real block descriptor in a megablock */
-
-#define FIRST_BDESCR(m) \
-   ((bdescr *)((FIRST_BLOCK_OFF>>(BLOCK_SHIFT-BDESCR_SHIFT)) + (W_)(m)))
-
-/* Number of usable blocks in a megablock */
-
-#define BLOCKS_PER_MBLOCK ((MBLOCK_SIZE - FIRST_BLOCK_OFF) / BLOCK_SIZE)
-
-/* How many blocks in this megablock group */
-
-#define MBLOCK_GROUP_BLOCKS(n) \
-   (BLOCKS_PER_MBLOCK + (n-1) * (MBLOCK_SIZE / BLOCK_SIZE))
-
-/* Compute the required size of a megablock group */
-
-#define BLOCKS_TO_MBLOCKS(n) \
-   (1 + (W_)MBLOCK_ROUND_UP((n-BLOCKS_PER_MBLOCK) * BLOCK_SIZE) / MBLOCK_SIZE)
-
-
-#ifndef CMINUSMINUS 
-/* to the end... */
-
-/* Double-linked block lists: --------------------------------------------- */
-
-INLINE_HEADER void
-dbl_link_onto(bdescr *bd, bdescr **list)
-{
-  bd->link = *list;
-  bd->u.back = NULL;
-  if (*list) {
-    (*list)->u.back = bd; /* double-link the list */
-  }
-  *list = bd;
-}
-
-/* Initialisation ---------------------------------------------------------- */
-
-extern void initBlockAllocator(void);
-
-/* Allocation -------------------------------------------------------------- */
-
-bdescr *allocGroup(nat n);
-bdescr *allocBlock(void);
-
-// versions that take the storage manager lock for you:
-bdescr *allocGroup_lock(nat n);
-bdescr *allocBlock_lock(void);
-
-/* De-Allocation ----------------------------------------------------------- */
-
-void freeGroup(bdescr *p);
-void freeChain(bdescr *p);
-
-// versions that take the storage manager lock for you:
-void freeGroup_lock(bdescr *p);
-void freeChain_lock(bdescr *p);
-
-/* Round a value to megablocks --------------------------------------------- */
-
-#define WORDS_PER_MBLOCK  (BLOCKS_PER_MBLOCK * BLOCK_SIZE_W)
-
-INLINE_HEADER nat
-round_to_mblocks(nat words)
-{
-  if (words > WORDS_PER_MBLOCK) {
-    if ((words % WORDS_PER_MBLOCK) < (WORDS_PER_MBLOCK / 2)) {
-      words = (words / WORDS_PER_MBLOCK) * WORDS_PER_MBLOCK;
-    } else {
-      words = ((words / WORDS_PER_MBLOCK) + 1) * WORDS_PER_MBLOCK;
-    }
-  }
-  return words;
-}
-
-#endif /* !CMINUSMINUS */
-#endif /* BLOCK_H */
diff --git a/ghc/includes/Bytecodes.h b/ghc/includes/Bytecodes.h
deleted file mode 100644
index 73003a3002..0000000000
--- a/ghc/includes/Bytecodes.h
+++ /dev/null
@@ -1,86 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2002
- *
- * Bytecode definitions.
- *
- * ---------------------------------------------------------------------------*/
-
-/* --------------------------------------------------------------------------
- * Instructions
- *
- * Notes:
- * o CASEFAIL is generated by the compiler whenever it tests an "irrefutable"
- *   pattern which fails.  If we don't see too many of these, we could
- *   optimise out the redundant test.
- * ------------------------------------------------------------------------*/
-
-/* NOTE:
-
-   THIS FILE IS INCLUDED IN HASKELL SOURCES (ghc/compiler/ghci/ByteCodeGen.lhs).
-   DO NOT PUT C-SPECIFIC STUFF IN HERE!
-
-   I hope that's clear :-)
-*/
-
-#define bci_STKCHECK  			1
-#define bci_PUSH_L    			2
-#define bci_PUSH_LL   			3
-#define bci_PUSH_LLL  			4
-#define bci_PUSH_G    			5
-#define bci_PUSH_ALTS  			6
-#define bci_PUSH_ALTS_P			7
-#define bci_PUSH_ALTS_N			8 
-#define bci_PUSH_ALTS_F			9 
-#define bci_PUSH_ALTS_D			10
-#define bci_PUSH_ALTS_L			11
-#define bci_PUSH_ALTS_V			12
-#define bci_PUSH_UBX  			13
-#define bci_PUSH_APPLY_N		14
-#define bci_PUSH_APPLY_F		15
-#define bci_PUSH_APPLY_D		16
-#define bci_PUSH_APPLY_L		17
-#define bci_PUSH_APPLY_V		18
-#define bci_PUSH_APPLY_P		19
-#define bci_PUSH_APPLY_PP		20
-#define bci_PUSH_APPLY_PPP		21
-#define bci_PUSH_APPLY_PPPP		22
-#define bci_PUSH_APPLY_PPPPP		23
-#define bci_PUSH_APPLY_PPPPPP		24
-/* #define bci_PUSH_APPLY_PPPPPPP		25 */
-#define bci_SLIDE     			26
-#define bci_ALLOC_AP   			27
-#define bci_ALLOC_PAP  			28
-#define bci_MKAP      			29
-#define bci_MKPAP      			30
-#define bci_UNPACK    			31
-#define bci_PACK      			32
-#define bci_TESTLT_I   			33
-#define bci_TESTEQ_I  			34
-#define bci_TESTLT_F  			35
-#define bci_TESTEQ_F  			36
-#define bci_TESTLT_D  			37
-#define bci_TESTEQ_D  			38
-#define bci_TESTLT_P  			39
-#define bci_TESTEQ_P  			40
-#define bci_CASEFAIL  			41
-#define bci_JMP       			42
-#define bci_CCALL     			43
-#define bci_SWIZZLE   			44
-#define bci_ENTER     			45
-#define bci_RETURN    			46
-#define bci_RETURN_P 			47
-#define bci_RETURN_N 			48
-#define bci_RETURN_F 			49
-#define bci_RETURN_D 			50
-#define bci_RETURN_L 			51
-#define bci_RETURN_V 			52
-
-/* If a BCO definitely requires less than this many words of stack,
-   don't include an explicit STKCHECK insn in it.  The interpreter
-   will check for this many words of stack before running each BCO,
-   rendering an explicit check unnecessary in the majority of
-   cases. */
-#define INTERP_STACK_CHECK_THRESH  50
-
-/*-------------------------------------------------------------------------*/
diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h
deleted file mode 100644
index f40f6aace6..0000000000
--- a/ghc/includes/ClosureMacros.h
+++ /dev/null
@@ -1,198 +0,0 @@
-/* ----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Macros for building and manipulating closures
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef CLOSUREMACROS_H
-#define CLOSUREMACROS_H
-
-/* Say whether the code comes before the heap; on mingwin this may not be the
-   case, not because of another random MS pathology, but because the static
-   program may reside in a DLL
-*/
-
-/* -----------------------------------------------------------------------------
-   Info tables are slammed up against the entry code, and the label
-   for the info table is at the *end* of the table itself.  This
-   inline function adjusts an info pointer to point to the beginning
-   of the table, so we can use standard C structure indexing on it.
-
-   Note: this works for SRT info tables as long as you don't want to
-   access the SRT, since they are laid out the same with the SRT
-   pointer as the first word in the table.
-
-   NOTES ABOUT MANGLED C VS. MINI-INTERPRETER:
-
-   A couple of definitions:
-
-       "info pointer"    The first word of the closure.  Might point
-                         to either the end or the beginning of the
-			 info table, depending on whether we're using
-			 the mini interpretter or not.  GET_INFO(c)
-			 retrieves the info pointer of a closure.
-
-       "info table"      The info table structure associated with a
-                         closure.  This is always a pointer to the
-			 beginning of the structure, so we can
-			 use standard C structure indexing to pull out
-			 the fields.  get_itbl(c) returns a pointer to
-			 the info table for closure c.
-
-   An address of the form xxxx_info points to the end of the info
-   table or the beginning of the info table depending on whether we're
-   mangling or not respectively.  So, 
-
-         c->header.info = xxx_info 
-
-   makes absolute sense, whether mangling or not.
- 
-   -------------------------------------------------------------------------- */
-
-#define SET_INFO(c,i) ((c)->header.info = (i))
-#define GET_INFO(c)   ((c)->header.info)
-#define GET_ENTRY(c)  (ENTRY_CODE(GET_INFO(c)))
-
-#define get_itbl(c)   (INFO_PTR_TO_STRUCT((c)->header.info))
-#define get_ret_itbl(c) (RET_INFO_PTR_TO_STRUCT((c)->header.info))
-#define get_fun_itbl(c) (FUN_INFO_PTR_TO_STRUCT((c)->header.info))
-#define get_thunk_itbl(c) (THUNK_INFO_PTR_TO_STRUCT((c)->header.info))
-
-#define GET_TAG(con) (get_itbl(con)->srt_bitmap)
-
-#ifdef TABLES_NEXT_TO_CODE
-#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)(info) - 1)
-#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)(info) - 1)
-#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)(info) - 1)
-#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)(info) - 1)
-#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
-#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
-#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(((StgInfoTable *)(i) + 1)) - 1)
-#else
-#define INFO_PTR_TO_STRUCT(info) ((StgInfoTable *)info)
-#define RET_INFO_PTR_TO_STRUCT(info) ((StgRetInfoTable *)info)
-#define FUN_INFO_PTR_TO_STRUCT(info) ((StgFunInfoTable *)info)
-#define THUNK_INFO_PTR_TO_STRUCT(info) ((StgThunkInfoTable *)info)
-#define itbl_to_fun_itbl(i) ((StgFunInfoTable *)(i))
-#define itbl_to_ret_itbl(i) ((StgRetInfoTable *)(i))
-#define itbl_to_thunk_itbl(i) ((StgThunkInfoTable *)(i))
-#endif
-
-/* -----------------------------------------------------------------------------
-   Macros for building closures
-   -------------------------------------------------------------------------- */
-
-#ifdef PROFILING
-#ifdef DEBUG_RETAINER
-/* 
-  For the sake of debugging, we take the safest way for the moment. Actually, this 
-  is useful to check the sanity of heap before beginning retainer profiling.
-  flip is defined in RetainerProfile.c, and declared as extern in RetainerProfile.h.
-  Note: change those functions building Haskell objects from C datatypes, i.e.,
-  all rts_mk???() functions in RtsAPI.c, as well.
- */
-#define SET_PROF_HDR(c,ccs_)            \
-        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = (retainerSet *)((StgWord)NULL | flip))
-#else
-/*
-  For retainer profiling only: we do not have to set (c)->header.prof.hp.rs to
-  NULL | flip (flip is defined in RetainerProfile.c) because even when flip
-  is 1, rs is invalid and will be initialized to NULL | flip later when 
-  the closure *c is visited.
- */
-/*
-#define SET_PROF_HDR(c,ccs_)            \
-        ((c)->header.prof.ccs = ccs_, (c)->header.prof.hp.rs = NULL)
- */
-/*
-  The following macro works for both retainer profiling and LDV profiling:
-  for retainer profiling, ldvTime remains 0, so rs fields are initialized to 0.
-  See the invariants on ldvTime.
- */
-#define SET_PROF_HDR(c,ccs_)            \
-        ((c)->header.prof.ccs = ccs_,   \
-        LDV_RECORD_CREATE((c)))
-#endif /* DEBUG_RETAINER */
-#define SET_STATIC_PROF_HDR(ccs_)       \
-        prof : { ccs : (CostCentreStack *)ccs_, hp : { rs : NULL } },
-#else
-#define SET_PROF_HDR(c,ccs)
-#define SET_STATIC_PROF_HDR(ccs)
-#endif
-
-#ifdef GRAN
-#define SET_GRAN_HDR(c,pe)		(c)->header.gran.procs = pe
-#define SET_STATIC_GRAN_HDR		gran : { procs : Everywhere },
-#else
-#define SET_GRAN_HDR(c,pe)
-#define SET_STATIC_GRAN_HDR
-#endif
-
-#ifdef PAR
-#define SET_PAR_HDR(c,stuff)
-#define SET_STATIC_PAR_HDR(stuff)
-#else
-#define SET_PAR_HDR(c,stuff)
-#define SET_STATIC_PAR_HDR(stuff)
-#endif
-
-#ifdef TICKY_TICKY
-#define SET_TICKY_HDR(c,stuff)	     /* old: (c)->header.ticky.updated = stuff */
-#define SET_STATIC_TICKY_HDR(stuff)  /* old: ticky : { updated : stuff } */
-#else
-#define SET_TICKY_HDR(c,stuff)
-#define SET_STATIC_TICKY_HDR(stuff)
-#endif
-
-#define SET_HDR(c,_info,ccs)				\
-   {							\
-	(c)->header.info = _info;			\
-	SET_GRAN_HDR((StgClosure *)(c),ThisPE);		\
-	SET_PAR_HDR((StgClosure *)(c),LOCAL_GA);	\
-	SET_PROF_HDR((StgClosure *)(c),ccs);		\
-	SET_TICKY_HDR((StgClosure *)(c),0);		\
-   }
-
-#define SET_ARR_HDR(c,info,costCentreStack,n_words)	\
-   SET_HDR(c,info,costCentreStack);			\
-   (c)->words = n_words;
-
-/* -----------------------------------------------------------------------------
-   How to get hold of the static link field for a static closure.
-   -------------------------------------------------------------------------- */
-
-/* These are hard-coded. */
-#define FUN_STATIC_LINK(p)   (&(p)->payload[0])
-#define THUNK_STATIC_LINK(p) (&(p)->payload[1])
-#define IND_STATIC_LINK(p)   (&(p)->payload[1])
-
-INLINE_HEADER StgClosure **
-STATIC_LINK(const StgInfoTable *info, StgClosure *p)
-{ 
-    switch (info->type) {
-    case THUNK_STATIC:
-	return THUNK_STATIC_LINK(p);
-    case FUN_STATIC:
-	return FUN_STATIC_LINK(p);
-    case IND_STATIC:
-	return IND_STATIC_LINK(p);
-    default:
-	return &(p)->payload[info->layout.payload.ptrs +
-			     info->layout.payload.nptrs];
-    }
-}
-
-#define STATIC_LINK2(info,p)							\
-   (*(StgClosure**)(&((p)->payload[info->layout.payload.ptrs +			\
-					info->layout.payload.nptrs + 1])))
-
-/* -----------------------------------------------------------------------------
-   INTLIKE and CHARLIKE closures.
-   -------------------------------------------------------------------------- */
-
-#define CHARLIKE_CLOSURE(n) ((P_)&stg_CHARLIKE_closure[(n)-MIN_CHARLIKE])
-#define INTLIKE_CLOSURE(n)  ((P_)&stg_INTLIKE_closure[(n)-MIN_INTLIKE])
-
-#endif /* CLOSUREMACROS_H */
diff --git a/ghc/includes/ClosureTypes.h b/ghc/includes/ClosureTypes.h
deleted file mode 100644
index f8840264f3..0000000000
--- a/ghc/includes/ClosureTypes.h
+++ /dev/null
@@ -1,99 +0,0 @@
-/* ----------------------------------------------------------------------------
- * 
- * (c) The GHC Team, 1998-2005
- *
- * Closure Type Constants: out here because the native code generator
- * needs to get at them.
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef CLOSURETYPES_H
-#define CLOSURETYPES_H
-
-/* 
- * WARNING WARNING WARNING
- *
- * Keep the closure tags contiguous: rts/ClosureFlags.c relies on
- * this.
- *
- * If you add or delete any closure types, don't forget to update
- * the closure flags table in rts/ClosureFlags.c.
- */
-
-/* Object tag 0 raises an internal error */
-#define INVALID_OBJECT          0
-#define CONSTR                  1
-#define	CONSTR_1_0		2
-#define	CONSTR_0_1		3
-#define	CONSTR_2_0		4
-#define	CONSTR_1_1		5
-#define	CONSTR_0_2		6
-#define CONSTR_INTLIKE	        7 
-#define CONSTR_CHARLIKE	        8 
-#define CONSTR_STATIC	        9 
-#define CONSTR_NOCAF_STATIC     10
-#define FUN		        11
-#define	FUN_1_0		  	12
-#define	FUN_0_1		  	13
-#define	FUN_2_0		  	14
-#define	FUN_1_1		  	15
-#define	FUN_0_2			16
-#define FUN_STATIC	        17
-#define THUNK		        18
-#define	THUNK_1_0	  	19
-#define	THUNK_0_1	  	20
-#define	THUNK_2_0	  	21
-#define	THUNK_1_1	  	22
-#define	THUNK_0_2		23
-#define THUNK_STATIC	        24
-#define THUNK_SELECTOR	        25
-#define BCO		        26
-#define AP		        27
-#define PAP			28
-#define AP_STACK                29
-#define IND		        30
-#define IND_OLDGEN	        31
-#define IND_PERM	        32
-#define IND_OLDGEN_PERM	        33
-#define IND_STATIC	        34
-#define RET_BCO                 35
-#define RET_SMALL	        36
-#define RET_VEC_SMALL	        37
-#define RET_BIG		        38
-#define RET_VEC_BIG	        39
-#define RET_DYN		        40
-#define RET_FUN                 41
-#define UPDATE_FRAME	        42
-#define CATCH_FRAME	        43
-#define STOP_FRAME	        44
-#define CAF_BLACKHOLE		45
-#define BLACKHOLE	        46
-#define SE_BLACKHOLE		47
-#define SE_CAF_BLACKHOLE	48
-#define MVAR		        49
-#define ARR_WORDS	        50
-#define MUT_ARR_PTRS_CLEAN      51
-#define MUT_ARR_PTRS_DIRTY      52
-#define MUT_ARR_PTRS_FROZEN0    53
-#define MUT_ARR_PTRS_FROZEN     54
-#define MUT_VAR_CLEAN	        55
-#define MUT_VAR_DIRTY	        56
-#define WEAK		        57
-#define STABLE_NAME	        58
-#define TSO		        59
-#define BLOCKED_FETCH	        60
-#define FETCH_ME                61
-#define FETCH_ME_BQ             62
-#define RBH                     63
-#define EVACUATED               64
-#define REMOTE_REF              65
-#define TVAR_WAIT_QUEUE         66
-#define TVAR                    67
-#define TREC_CHUNK              68
-#define TREC_HEADER             69
-#define ATOMICALLY_FRAME        70
-#define CATCH_RETRY_FRAME       71
-#define CATCH_STM_FRAME         72
-#define N_CLOSURE_TYPES         73
-
-#endif /* CLOSURETYPES_H */
diff --git a/ghc/includes/Closures.h b/ghc/includes/Closures.h
deleted file mode 100644
index 3df208cd09..0000000000
--- a/ghc/includes/Closures.h
+++ /dev/null
@@ -1,480 +0,0 @@
-/* ----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Closures
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef CLOSURES_H
-#define CLOSURES_H
-
-/*
- * The Layout of a closure header depends on which kind of system we're
- * compiling for: profiling, parallel, ticky, etc.
- */
-
-/* -----------------------------------------------------------------------------
-   The profiling header
-   -------------------------------------------------------------------------- */
-
-typedef struct {
-  CostCentreStack *ccs;
-  union {
-    struct _RetainerSet *rs;  /* Retainer Set */
-    StgWord ldvw;             /* Lag/Drag/Void Word */
-  } hp;
-} StgProfHeader;
-
-/* -----------------------------------------------------------------------------
-   The GranSim header
-   -------------------------------------------------------------------------- */
-
-typedef struct {
-  StgWord procs; /* bitmask indicating on which PEs this closure resides */
-} StgGranHeader;
-
-/* -----------------------------------------------------------------------------
-   The SMP header
-   
-   A thunk has a padding word to take the updated value.  This is so
-   that the update doesn't overwrite the payload, so we can avoid
-   needing to lock the thunk during entry and update.
-   
-   Note: this doesn't apply to THUNK_STATICs, which have no payload.
-
-   Note: we leave this padding word in all ways, rather than just SMP,
-   so that we don't have to recompile all our libraries for SMP.
-   -------------------------------------------------------------------------- */
-
-typedef struct {
-    StgWord pad;
-} StgSMPThunkHeader;
-
-/* -----------------------------------------------------------------------------
-   The full fixed-size closure header
-
-   The size of the fixed header is the sum of the optional parts plus a single
-   word for the entry code pointer.
-   -------------------------------------------------------------------------- */
-
-typedef struct {
-    const struct _StgInfoTable* info;
-#ifdef PROFILING
-    StgProfHeader         prof;
-#endif
-#ifdef GRAN
-    StgGranHeader         gran;
-#endif
-} StgHeader;
-
-typedef struct {
-    const struct _StgInfoTable* info;
-#ifdef PROFILING
-    StgProfHeader         prof;
-#endif
-#ifdef GRAN
-    StgGranHeader         gran;
-#endif
-    StgSMPThunkHeader     smp;
-} StgThunkHeader;
-
-#define THUNK_EXTRA_HEADER_W (sizeofW(StgThunkHeader)-sizeofW(StgHeader))
-
-/* -----------------------------------------------------------------------------
-   Closure Types
-
-   For any given closure type (defined in InfoTables.h), there is a
-   corresponding structure defined below.  The name of the structure
-   is obtained by concatenating the closure type with '_closure'
-   -------------------------------------------------------------------------- */
-
-/* All closures follow the generic format */
-
-struct StgClosure_ {
-    StgHeader   header;
-    struct StgClosure_ *payload[FLEXIBLE_ARRAY];
-};
-
-typedef struct {
-    StgThunkHeader  header;
-    struct StgClosure_ *payload[FLEXIBLE_ARRAY];
-} StgThunk;
-
-typedef struct {
-    StgThunkHeader   header;
-    StgClosure *selectee;
-} StgSelector;
-
-typedef struct {
-    StgHeader   header;
-    StgHalfWord arity;		/* zero if it is an AP */
-    StgHalfWord n_args;
-    StgClosure *fun;		/* really points to a fun */
-    StgClosure *payload[FLEXIBLE_ARRAY];
-} StgPAP;
-
-typedef struct {
-    StgThunkHeader   header;
-    StgHalfWord arity;		/* zero if it is an AP */
-    StgHalfWord n_args;
-    StgClosure *fun;		/* really points to a fun */
-    StgClosure *payload[FLEXIBLE_ARRAY];
-} StgAP;
-
-typedef struct {
-    StgThunkHeader   header;
-    StgWord     size;                    /* number of words in payload */
-    StgClosure *fun;
-    StgClosure *payload[FLEXIBLE_ARRAY]; /* contains a chunk of *stack* */
-} StgAP_STACK;
-
-typedef struct {
-    StgHeader   header;
-    StgClosure *indirectee;
-} StgInd;
-
-typedef struct {
-    StgHeader     header;
-    StgClosure   *indirectee;
-    StgClosure   *static_link;
-    struct _StgInfoTable *saved_info;
-} StgIndStatic;
-
-typedef struct {
-    StgHeader  header;
-    StgWord    words;
-    StgWord    payload[FLEXIBLE_ARRAY];
-} StgArrWords;
-
-typedef struct {
-    StgHeader   header;
-    StgWord     ptrs;
-    StgClosure *payload[FLEXIBLE_ARRAY];
-} StgMutArrPtrs;
-
-typedef struct {
-    StgHeader   header;
-    StgClosure *var;
-} StgMutVar;
-
-typedef struct _StgUpdateFrame {
-    StgHeader  header;
-    StgClosure *updatee;
-} StgUpdateFrame;
-
-typedef struct {
-    StgHeader  header;
-    StgInt      exceptions_blocked;
-    StgClosure *handler;
-} StgCatchFrame;
-
-typedef struct {
-    StgHeader  header;
-} StgStopFrame;  
-
-typedef struct {
-    StgHeader   header;
-    StgClosure *evacuee;
-} StgEvacuated;
-
-typedef struct {
-  StgHeader header;
-  StgWord data;
-} StgIntCharlikeClosure;
-
-/* statically allocated */
-typedef struct {
-  StgHeader  header;
-} StgRetry;
-
-typedef struct _StgStableName {
-  StgHeader      header;
-  StgWord        sn;
-} StgStableName;
-
-typedef struct _StgWeak {	/* Weak v */
-  StgHeader header;
-  StgClosure *key;
-  StgClosure *value;		/* v */
-  StgClosure *finalizer;
-  struct _StgWeak *link;
-} StgWeak;
-
-typedef struct _StgDeadWeak {	/* Weak v */
-  StgHeader header;
-  struct _StgWeak *link;
-} StgDeadWeak;
-
-/* Byte code objects.  These are fixed size objects with pointers to
- * four arrays, designed so that a BCO can be easily "re-linked" to
- * other BCOs, to facilitate GHC's intelligent recompilation.  The
- * array of instructions is static and not re-generated when the BCO
- * is re-linked, but the other 3 arrays will be regenerated.
- *
- * A BCO represents either a function or a stack frame.  In each case,
- * it needs a bitmap to describe to the garbage collector the
- * pointerhood of its arguments/free variables respectively, and in
- * the case of a function it also needs an arity.  These are stored
- * directly in the BCO, rather than in the instrs array, for two
- * reasons:
- * (a) speed: we need to get at the bitmap info quickly when
- *     the GC is examining APs and PAPs that point to this BCO
- * (b) a subtle interaction with the compacting GC.  In compacting
- *     GC, the info that describes the size/layout of a closure
- *     cannot be in an object more than one level of indirection
- *     away from the current object, because of the order in
- *     which pointers are updated to point to their new locations.
- */
-
-typedef struct {
-    StgHeader      header;
-    StgArrWords   *instrs;	/* a pointer to an ArrWords */
-    StgArrWords   *literals;	/* a pointer to an ArrWords */
-    StgMutArrPtrs *ptrs;	/* a pointer to a  MutArrPtrs */
-    StgArrWords   *itbls;	/* a pointer to an ArrWords */
-    StgHalfWord   arity;        /* arity of this BCO */
-    StgHalfWord   size;         /* size of this BCO (in words) */
-    StgWord       bitmap[FLEXIBLE_ARRAY];  /* an StgLargeBitmap */
-} StgBCO;
-
-#define BCO_BITMAP(bco)      ((StgLargeBitmap *)((StgBCO *)(bco))->bitmap)
-#define BCO_BITMAP_SIZE(bco) (BCO_BITMAP(bco)->size)
-#define BCO_BITMAP_BITS(bco) (BCO_BITMAP(bco)->bitmap)
-#define BCO_BITMAP_SIZEW(bco) ((BCO_BITMAP_SIZE(bco) + BITS_IN(StgWord) - 1) \
-			        / BITS_IN(StgWord))
-
-/* -----------------------------------------------------------------------------
-   Dynamic stack frames for generic heap checks.
-
-   These generic heap checks are slow, but have the advantage of being
-   usable in a variety of situations.
-
-   The one restriction is that any relevant SRTs must already be pointed
-   to from the stack.  The return address doesn't need to have an info
-   table attached: hence it can be any old code pointer.
-
-   The liveness mask contains a 1 at bit n, if register Rn contains a
-   non-pointer.  The contents of all 8 vanilla registers are always saved
-   on the stack; the liveness mask tells the GC which ones contain
-   pointers.
-
-   Good places to use a generic heap check: 
-
-        - case alternatives (the return address with an SRT is already
-	  on the stack).
-
-	- primitives (no SRT required).
-
-   The stack frame layout for a RET_DYN is like this:
-
-          some pointers         |-- RET_DYN_PTRS(liveness) words
-          some nonpointers      |-- RET_DYN_NONPTRS(liveness) words
-			       
-	  L1                    \
-          D1-2                  |-- RET_DYN_NONPTR_REGS_SIZE words
-	  F1-4                  /
-			       
-	  R1-8                  |-- RET_DYN_BITMAP_SIZE words
-			       
-	  return address        \
-	  liveness mask         |-- StgRetDyn structure
-	  stg_gen_chk_info      /
-
-   we assume that the size of a double is always 2 pointers (wasting a
-   word when it is only one pointer, but avoiding lots of #ifdefs).
-
-   See Liveness.h for the macros (RET_DYN_PTRS() etc.).
-
-   NOTE: if you change the layout of RET_DYN stack frames, then you
-   might also need to adjust the value of RESERVED_STACK_WORDS in
-   Constants.h.
-   -------------------------------------------------------------------------- */
-
-typedef struct {
-    const struct _StgInfoTable* info;
-    StgWord        liveness;
-    StgWord        ret_addr;
-    StgClosure *   payload[FLEXIBLE_ARRAY];
-} StgRetDyn;
-
-/* A function return stack frame: used when saving the state for a
- * garbage collection at a function entry point.  The function
- * arguments are on the stack, and we also save the function (its
- * info table describes the pointerhood of the arguments).
- *
- * The stack frame size is also cached in the frame for convenience.
- */
-typedef struct {
-    const struct _StgInfoTable* info;
-    StgWord        size;
-    StgClosure *   fun;
-    StgClosure *   payload[FLEXIBLE_ARRAY];
-} StgRetFun;
-
-/* Concurrent communication objects */
-
-typedef struct {
-  StgHeader       header;
-  struct StgTSO_ *head;
-  struct StgTSO_ *tail;
-  StgClosure*     value;
-} StgMVar;
-
-
-/* STM data structures
- *
- *  StgTVar defines the only type that can be updated through the STM
- *  interface.
- * 
- *  Note that various optimisations may be possible in order to use less
- *  space for these data structures at the cost of more complexity in the
- *  implementation:
- *
- *   - In StgTVar, current_value and first_wait_queue_entry could be held in
- *     the same field: if any thread is waiting then its expected_value for
- *     the tvar is the current value.  
- *
- *   - In StgTRecHeader, it might be worthwhile having separate chunks
- *     of read-only and read-write locations.  This would save a
- *     new_value field in the read-only locations.
- *
- *   - In StgAtomicallyFrame, we could combine the waiting bit into
- *     the header (maybe a different info tbl for a waiting transaction).
- *     This means we can specialise the code for the atomically frame
- *     (it immediately switches on frame->waiting anyway).
- */
-
-typedef struct StgTVarWaitQueue_ {
-  StgHeader                  header;
-  struct StgTSO_            *waiting_tso;
-  struct StgTVarWaitQueue_  *next_queue_entry;
-  struct StgTVarWaitQueue_  *prev_queue_entry;
-} StgTVarWaitQueue;
-
-typedef struct {
-  StgHeader                  header;
-  StgClosure                *volatile current_value;
-  StgTVarWaitQueue          *volatile first_wait_queue_entry;
-#if defined(THREADED_RTS)
-  StgInt                     volatile num_updates;
-#endif
-} StgTVar;
-
-/* new_value == expected_value for read-only accesses */
-/* new_value is a StgTVarWaitQueue entry when trec in state TREC_WAITING */
-typedef struct {
-  StgTVar                   *tvar;
-  StgClosure                *expected_value;
-  StgClosure                *new_value; 
-#if defined(THREADED_RTS)
-  StgInt                     num_updates;
-#endif
-} TRecEntry;
-
-#define TREC_CHUNK_NUM_ENTRIES 16
-
-typedef struct StgTRecChunk_ {
-  StgHeader                  header;
-  struct StgTRecChunk_      *prev_chunk;
-  StgWord                    next_entry_idx;
-  TRecEntry                  entries[TREC_CHUNK_NUM_ENTRIES];
-} StgTRecChunk;
-
-typedef enum { 
-  TREC_ACTIVE,        /* Transaction in progress, outcome undecided */
-  TREC_CONDEMNED,     /* Transaction in progress, inconsistent / out of date reads */
-  TREC_COMMITTED,     /* Transaction has committed, now updating tvars */
-  TREC_ABORTED,       /* Transaction has aborted, now reverting tvars */
-  TREC_WAITING,       /* Transaction currently waiting */
-} TRecState;
-
-typedef struct StgTRecHeader_ {
-  StgHeader                  header;
-  TRecState                  state;
-  struct StgTRecHeader_     *enclosing_trec;
-  StgTRecChunk              *current_chunk;
-} StgTRecHeader;
-
-typedef struct {
-    StgHeader   header;
-    StgClosure *code;
-} StgAtomicallyFrame;
-
-typedef struct {
-    StgHeader   header;
-    StgClosure *handler;
-} StgCatchSTMFrame;
-
-typedef struct {
-    StgHeader      header;
-    StgBool        running_alt_code;
-    StgClosure    *first_code;
-    StgClosure    *alt_code;
-    StgTRecHeader *first_code_trec;
-} StgCatchRetryFrame;
-
-#if defined(PAR) || defined(GRAN)
-/*
-  StgBlockingQueueElement is a ``collective type'' representing the types
-  of closures that can be found on a blocking queue: StgTSO, StgRBHSave,
-  StgBlockedFetch.  (StgRBHSave can only appear at the end of a blocking
-  queue).  Logically, this is a union type, but defining another struct
-  with a common layout is easier to handle in the code.  
-  Note that in the standard setup only StgTSOs can be on a blocking queue.
-  This is one of the main reasons for slightly different code in files
-  such as Schedule.c.
-*/
-typedef struct StgBlockingQueueElement_ {
-  StgHeader                         header;
-  struct StgBlockingQueueElement_  *link;      /* next elem in BQ */
-  struct StgClosure_               *payload[FLEXIBLE_ARRAY];/* contents of the closure */
-} StgBlockingQueueElement;
-
-/* only difference to std code is type of the elem in the BQ */
-typedef struct StgBlockingQueue_ {
-  StgHeader                 header;
-  struct StgBlockingQueueElement_ *blocking_queue; /* start of the BQ */
-} StgBlockingQueue;
-
-/* this closure is hanging at the end of a blocking queue in (see RBH.c) */
-typedef struct StgRBHSave_ {
-  StgHeader    header;
-  StgClosure  *payload[FLEXIBLE_ARRAY];     /* 2 words ripped out of the guts of the */
-} StgRBHSave;                  /*  closure holding the blocking queue */
- 
-typedef struct StgRBH_ {
-  StgHeader                         header;
-  struct StgBlockingQueueElement_  *blocking_queue; /* start of the BQ */
-} StgRBH;
-
-#endif
-
-#if defined(PAR)
-/* global indirections aka FETCH_ME closures */
-typedef struct StgFetchMe_ {
-  StgHeader              header;
-  globalAddr            *ga;        /* ptr to unique id for a closure */
-} StgFetchMe;
-
-/* same contents as an ordinary StgBlockingQueue */
-typedef struct StgFetchMeBlockingQueue_ {
-  StgHeader                          header;
-  struct StgBlockingQueueElement_   *blocking_queue; /* start of the BQ */
-} StgFetchMeBlockingQueue;
-
-/* This is an entry in a blocking queue. It indicates a fetch request from a 
-   TSO on another PE demanding the value of this closur. Note that a
-   StgBlockedFetch can only occur in a BQ. Once the node is evaluated and
-   updated with the result, the result will be sent back (the PE is encoded
-   in the globalAddr) and the StgBlockedFetch closure will be nuked.
-*/
-typedef struct StgBlockedFetch_ {
-  StgHeader                         header;
-  struct StgBlockingQueueElement_  *link;     /* next elem in the BQ */
-  StgClosure                       *node;     /* node to fetch */
-  globalAddr                        ga;       /* where to send the result to */
-} StgBlockedFetch;                            /* NB: not just a ptr to a GA */
-#endif
-
-#endif /* CLOSURES_H */
diff --git a/ghc/includes/Cmm.h b/ghc/includes/Cmm.h
deleted file mode 100644
index 783b0e41bb..0000000000
--- a/ghc/includes/Cmm.h
+++ /dev/null
@@ -1,517 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The University of Glasgow 2004
- *
- * This file is included at the top of all .cmm source files (and
- * *only* .cmm files).  It defines a collection of useful macros for
- * making .cmm code a bit less error-prone to write, and a bit easier
- * on the eye for the reader.
- *
- * For the syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
- *
- * If you're used to the old HC file syntax, here's a quick cheat sheet
- * for converting HC code:
- *
- *       - Remove FB_/FE_
- *       - Remove all type casts
- *       - Remove '&'
- *       - STGFUN(foo) { ... }  ==>  foo { ... }
- *       - FN_(foo) { ... }  ==>  foo { ... }
- *       - JMP_(e)  ==> jump e;
- *       - Remove EXTFUN(foo)
- *       - Sp[n]  ==>  Sp(n)
- *       - Hp[n]  ==>  Hp(n)
- *       - Sp += n  ==> Sp_adj(n)
- *       - Hp += n  ==> Hp_adj(n)
- *       - R1.i   ==>  R1   (similarly for R1.w, R1.cl etc.)
- *       - You need to explicitly dereference variables; eg. 
- *             context_switch   ==>  CInt[context_switch]
- *       - convert all word offsets into byte offsets:
- *         	- e ==> WDS(e)
- *       - sizeofW(StgFoo)  ==>  SIZEOF_StgFoo
- *       - ENTRY_CODE(e)  ==>  %ENTRY_CODE(e)
- *       - get_itbl(c)  ==>  %GET_STD_INFO(c)
- *       - Change liveness masks in STK_CHK_GEN, HP_CHK_GEN:
- *        	R1_PTR | R2_PTR  ==>  R1_PTR & R2_PTR
- *         	(NOTE: | becomes &)
- *       - Declarations like 'StgPtr p;' become just 'W_ p;'
- *       - e->payload[n] ==> PAYLOAD(e,n)
- *       - Be very careful with comparisons: the infix versions (>, >=, etc.)
- *         are unsigned, so use %lt(a,b) to get signed less-than for example.
- *
- * Accessing fields of structures defined in the RTS header files is
- * done via automatically-generated macros in DerivedConstants.h.  For
- * example, where previously we used
- *
- *          CurrentTSO->what_next = x
- *
- * in C-- we now use
- *
- *          StgTSO_what_next(CurrentTSO) = x
- *
- * where the StgTSO_what_next() macro is automatically generated by
- * mkDerivedConstnants.c.  If you need to access a field that doesn't
- * already have a macro, edit that file (it's pretty self-explanatory).
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef CMM_H
-#define CMM_H
-
-/*
- * In files that are included into both C and C-- (and perhaps
- * Haskell) sources, we sometimes need to conditionally compile bits
- * depending on the language.  CMINUSMINUS==1 in .cmm sources:
- */
-#define CMINUSMINUS 1
-
-#include "ghcconfig.h"
-#include "RtsConfig.h"
-
-/* -----------------------------------------------------------------------------
-   Types 
-
-   The following synonyms for C-- types are declared here:
-
-     I8, I16, I32, I64    MachRep-style names for convenience
-
-     W_                   is shorthand for the word type (== StgWord)
-     F_		 	  shorthand for float  (F_ == StgFloat == C's float)
-     D_	 		  shorthand for double (D_ == StgDouble == C's double)
-
-     CInt		  has the same size as an int in C on this platform
-     CLong		  has the same size as a long in C on this platform
-   
-  --------------------------------------------------------------------------- */
-
-#define I8  bits8
-#define I16 bits16
-#define I32 bits32
-#define I64 bits64
-
-#if SIZEOF_VOID_P == 4
-#define W_ bits32
-#elif SIZEOF_VOID_P == 8
-#define W_ bits64
-#else
-#error Unknown word size
-#endif
-
-#if SIZEOF_INT == 4
-#define CInt bits32
-#elif SIZEOF_INT == 8
-#define CInt bits64
-#else
-#error Unknown int size
-#endif
-
-#if SIZEOF_LONG == 4
-#define CLong bits32
-#elif SIZEOF_LONG == 8
-#define CLong bits64
-#else
-#error Unknown long size
-#endif
-
-#define F_ float32
-#define D_ float64
-#define L_ bits64
-
-#define SIZEOF_StgDouble 8
-#define SIZEOF_StgWord64 8
-
-/* -----------------------------------------------------------------------------
-   Misc useful stuff
-   -------------------------------------------------------------------------- */
-
-#define NULL (0::W_)
-
-#define STRING(name,str)			\
-  section "rodata" {				\
-	name : bits8[] str;			\
-  }						\
-
-/* -----------------------------------------------------------------------------
-   Byte/word macros
-
-   Everything in C-- is in byte offsets (well, most things).  We use
-   some macros to allow us to express offsets in words and to try to
-   avoid byte/word confusion.
-   -------------------------------------------------------------------------- */
-
-#define SIZEOF_W  SIZEOF_VOID_P
-#define W_MASK    (SIZEOF_W-1)
-
-#if SIZEOF_W == 4
-#define W_SHIFT 2
-#elif SIZEOF_W == 8
-#define W_SHIFT 4
-#endif
-
-/* Converting quantities of words to bytes */
-#define WDS(n) ((n)*SIZEOF_W)
-
-/*
- * Converting quantities of bytes to words
- * NB. these work on *unsigned* values only
- */
-#define BYTES_TO_WDS(n) ((n) / SIZEOF_W)
-#define ROUNDUP_BYTES_TO_WDS(n) (((n) + SIZEOF_W - 1) / SIZEOF_W)
-
-/* TO_W_(n) converts n to W_ type from a smaller type */
-#if SIZEOF_W == 4
-#define TO_W_(x) %sx32(x)
-#define HALF_W_(x) %lobits16(x)
-#elif SIZEOF_W == 8
-#define TO_W_(x) %sx64(x)
-#define HALF_W_(x) %lobits32(x)
-#endif
-
-#if SIZEOF_INT == 4 && SIZEOF_W == 8
-#define W_TO_INT(x) %lobits32(x)
-#elif SIZEOF_INT == SIZEOF_W
-#define W_TO_INT(x) (x)
-#endif
-
-/* -----------------------------------------------------------------------------
-   Heap/stack access, and adjusting the heap/stack pointers.
-   -------------------------------------------------------------------------- */
-
-#define Sp(n)  W_[Sp + WDS(n)]
-#define Hp(n)  W_[Hp + WDS(n)]
-
-#define Sp_adj(n) Sp = Sp + WDS(n)
-#define Hp_adj(n) Hp = Hp + WDS(n)
-
-/* -----------------------------------------------------------------------------
-   Assertions and Debuggery
-   -------------------------------------------------------------------------- */
-
-#ifdef DEBUG
-#define ASSERT(predicate)			\
-	if (predicate) {			\
-	    /*null*/;				\
-	} else {				\
-	    foreign "C" _assertFail(NULL, __LINE__); \
-        }
-#else
-#define ASSERT(p) /* nothing */
-#endif
-
-#ifdef DEBUG
-#define DEBUG_ONLY(s) s
-#else
-#define DEBUG_ONLY(s) /* nothing */
-#endif
-
-/*
- * The IF_DEBUG macro is useful for debug messages that depend on one
- * of the RTS debug options.  For example:
- * 
- *   IF_DEBUG(RtsFlags_DebugFlags_apply,
- *      foreign "C" fprintf(stderr, stg_ap_0_ret_str));
- *
- * Note the syntax is slightly different to the C version of this macro.
- */
-#ifdef DEBUG
-#define IF_DEBUG(c,s)  if (RtsFlags_DebugFlags_##c(RtsFlags)) { s; }
-#else
-#define IF_DEBUG(c,s)  /* nothing */
-#endif
-
-/* -----------------------------------------------------------------------------
-   Entering 
-
-   It isn't safe to "enter" every closure.  Functions in particular
-   have no entry code as such; their entry point contains the code to
-   apply the function.
-
-   ToDo: range should end in N_CLOSURE_TYPES-1, not N_CLOSURE_TYPES,
-   but switch doesn't allow us to use exprs there yet.
-   -------------------------------------------------------------------------- */
-
-#define ENTER()						\
- again:							\
-  W_ info;						\
-  info = %INFO_PTR(R1);					\
-  switch [INVALID_OBJECT .. N_CLOSURE_TYPES]		\
-         (TO_W_( %INFO_TYPE(%STD_INFO(info)) )) {	\
-  case							\
-    IND,						\
-    IND_OLDGEN,						\
-    IND_PERM,						\
-    IND_OLDGEN_PERM,					\
-    IND_STATIC:						\
-   {							\
-      R1 = StgInd_indirectee(R1);			\
-      goto again;					\
-   }							\
-  case							\
-    BCO,						\
-    FUN,						\
-    FUN_1_0,						\
-    FUN_0_1,						\
-    FUN_2_0,						\
-    FUN_1_1,						\
-    FUN_0_2,						\
-    FUN_STATIC,						\
-    PAP:						\
-   {							\
-      jump %ENTRY_CODE(Sp(0));				\
-   }							\
-  default:						\
-   {							\
-      jump %ENTRY_CODE(info);				\
-   }							\
-  }
-
-/* -----------------------------------------------------------------------------
-   Constants.
-   -------------------------------------------------------------------------- */
-
-#include "Constants.h"
-#include "DerivedConstants.h"
-#include "ClosureTypes.h"
-#include "StgFun.h"
-
-/*
- * Need MachRegs, because some of the RTS code is conditionally
- * compiled based on REG_R1, REG_R2, etc.
- */
-#define STOLEN_X86_REGS 4
-#include "MachRegs.h"
-
-#include "Liveness.h"
-#include "StgLdvProf.h"
-
-#undef BLOCK_SIZE
-#undef MBLOCK_SIZE
-#include "Block.h"  /* For Bdescr() */
-
-
-/* Can't think of a better place to put this. */
-#if SIZEOF_mp_limb_t != SIZEOF_VOID_P
-#error mp_limb_t != StgWord: assumptions in PrimOps.cmm are now false
-#endif
-
-#define MyCapability()  (BaseReg - OFFSET_Capability_r)
-
-/* -------------------------------------------------------------------------
-   Allocation and garbage collection
-   ------------------------------------------------------------------------- */
-
-/*
- * ALLOC_PRIM is for allocating memory on the heap for a primitive
- * object.  It is used all over PrimOps.cmm.
- *
- * We make the simplifying assumption that the "admin" part of a
- * primitive closure is just the header when calculating sizes for
- * ticky-ticky.  It's not clear whether eg. the size field of an array
- * should be counted as "admin", or the various fields of a BCO.
- */
-#define ALLOC_PRIM(bytes,liveness,reentry)			\
-   HP_CHK_GEN_TICKY(bytes,liveness,reentry);			\
-   TICK_ALLOC_PRIM(SIZEOF_StgHeader,bytes-SIZEOF_StgHeader,0);	\
-   CCCS_ALLOC(bytes);
-
-/* CCS_ALLOC wants the size in words, because ccs->mem_alloc is in words */
-#define CCCS_ALLOC(__alloc) CCS_ALLOC(BYTES_TO_WDS(__alloc), W_[CCCS])
-
-#define HP_CHK_GEN_TICKY(alloc,liveness,reentry)	\
-   HP_CHK_GEN(alloc,liveness,reentry);			\
-   TICK_ALLOC_HEAP_NOCTR(alloc);
-
-// allocateLocal() allocates from the nursery, so we check to see
-// whether the nursery is nearly empty in any function that uses
-// allocateLocal() - this includes many of the primops.
-#define MAYBE_GC(liveness,reentry)			\
-  if (bdescr_link(CurrentNursery) == NULL || CInt[alloc_blocks] >= CInt[alloc_blocks_lim]) {		\
-	R9  = liveness;					\
-        R10 = reentry;					\
-        jump stg_gc_gen_hp;				\
-   }
-
-/* -----------------------------------------------------------------------------
-   Closure headers
-   -------------------------------------------------------------------------- */
-
-/*
- * This is really ugly, since we don't do the rest of StgHeader this
- * way.  The problem is that values from DerivedConstants.h cannot be 
- * dependent on the way (SMP, PROF etc.).  For SIZEOF_StgHeader we get
- * the value from GHC, but it seems like too much trouble to do that
- * for StgThunkHeader.
- */
-#define SIZEOF_StgThunkHeader SIZEOF_StgHeader+SIZEOF_StgSMPThunkHeader
-
-#define StgThunk_payload(__ptr__,__ix__) \
-    W_[__ptr__+SIZEOF_StgThunkHeader+ WDS(__ix__)]
-
-/* -----------------------------------------------------------------------------
-   Closures
-   -------------------------------------------------------------------------- */
-
-/* The offset of the payload of an array */
-#define BYTE_ARR_CTS(arr)  ((arr) + SIZEOF_StgArrWords)
-
-/* Getting/setting the info pointer of a closure */
-#define SET_INFO(p,info) StgHeader_info(p) = info
-#define GET_INFO(p) StgHeader_info(p)
-
-/* Determine the size of an ordinary closure from its info table */
-#define sizeW_fromITBL(itbl) \
-  SIZEOF_StgHeader + WDS(%INFO_PTRS(itbl)) + WDS(%INFO_NPTRS(itbl))
-
-/* NB. duplicated from InfoTables.h! */
-#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)
-#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)
-
-/* Debugging macros */
-#define LOOKS_LIKE_INFO_PTR(p)				\
-   ((p) != NULL && 					\
-     (TO_W_(%INFO_TYPE(%STD_INFO(p))) != INVALID_OBJECT) &&	\
-     (TO_W_(%INFO_TYPE(%STD_INFO(p))) <  N_CLOSURE_TYPES))
-
-#define LOOKS_LIKE_CLOSURE_PTR(p) (LOOKS_LIKE_INFO_PTR(GET_INFO(p)))
-
-/*
- * The layout of the StgFunInfoExtra part of an info table changes
- * depending on TABLES_NEXT_TO_CODE.  So we define field access
- * macros which use the appropriate version here:
- */
-#ifdef TABLES_NEXT_TO_CODE
-/*
- * when TABLES_NEXT_TO_CODE, slow_apply is stored as an offset
- * instead of the normal pointer.
- */
-        
-#define StgFunInfoExtra_slow_apply(fun_info)    \
-        (TO_W_(StgFunInfoExtraRev_slow_apply_offset(fun_info))    \
-               + (fun_info) + SIZEOF_StgFunInfoExtraRev + SIZEOF_StgInfoTable)
-
-#define StgFunInfoExtra_fun_type(i)   StgFunInfoExtraRev_fun_type(i)
-#define StgFunInfoExtra_arity(i)      StgFunInfoExtraRev_arity(i)
-#define StgFunInfoExtra_bitmap(i)     StgFunInfoExtraRev_bitmap(i)
-#else
-#define StgFunInfoExtra_slow_apply(i) StgFunInfoExtraFwd_slow_apply(i)
-#define StgFunInfoExtra_fun_type(i)   StgFunInfoExtraFwd_fun_type(i)
-#define StgFunInfoExtra_arity(i)      StgFunInfoExtraFwd_arity(i)
-#define StgFunInfoExtra_bitmap(i)     StgFunInfoExtraFwd_bitmap(i)
-#endif
-
-/* -----------------------------------------------------------------------------
-   Voluntary Yields/Blocks
-
-   We only have a generic version of this at the moment - if it turns
-   out to be slowing us down we can make specialised ones.
-   -------------------------------------------------------------------------- */
-
-#define YIELD(liveness,reentry)			\
-   R9  = liveness;				\
-   R10 = reentry;				\
-   jump stg_gen_yield;
-
-#define BLOCK(liveness,reentry)			\
-   R9  = liveness;				\
-   R10 = reentry;				\
-   jump stg_gen_block;
-
-/* -----------------------------------------------------------------------------
-   Ticky macros 
-   -------------------------------------------------------------------------- */
-
-#ifdef TICKY_TICKY
-#define TICK_BUMP_BY(ctr,n) CLong[ctr] = CLong[ctr] + n
-#else
-#define TICK_BUMP_BY(ctr,n) /* nothing */
-#endif
-
-#define TICK_BUMP(ctr)      TICK_BUMP_BY(ctr,1)
-
-#define TICK_ENT_DYN_IND()  		TICK_BUMP(ENT_DYN_IND_ctr)
-#define TICK_ENT_DYN_THK()  		TICK_BUMP(ENT_DYN_THK_ctr)
-#define TICK_ENT_VIA_NODE()  		TICK_BUMP(ENT_VIA_NODE_ctr)
-#define TICK_ENT_STATIC_IND()  		TICK_BUMP(ENT_STATIC_IND_ctr)
-#define TICK_ENT_PERM_IND()  		TICK_BUMP(ENT_PERM_IND_ctr)
-#define TICK_ENT_PAP()  		TICK_BUMP(ENT_PAP_ctr)
-#define TICK_ENT_AP()  			TICK_BUMP(ENT_AP_ctr)
-#define TICK_ENT_AP_STACK()  		TICK_BUMP(ENT_AP_STACK_ctr)
-#define TICK_ENT_BH()  			TICK_BUMP(ENT_BH_ctr)
-#define TICK_UNKNOWN_CALL()  		TICK_BUMP(UNKNOWN_CALL_ctr)
-#define TICK_UPDF_PUSHED()  		TICK_BUMP(UPDF_PUSHED_ctr)
-#define TICK_CATCHF_PUSHED()  		TICK_BUMP(CATCHF_PUSHED_ctr)
-#define TICK_UPDF_OMITTED()  		TICK_BUMP(UPDF_OMITTED_ctr)
-#define TICK_UPD_NEW_IND()  		TICK_BUMP(UPD_NEW_IND_ctr)
-#define TICK_UPD_NEW_PERM_IND()  	TICK_BUMP(UPD_NEW_PERM_IND_ctr)
-#define TICK_UPD_OLD_IND()  		TICK_BUMP(UPD_OLD_IND_ctr)
-#define TICK_UPD_OLD_PERM_IND()  	TICK_BUMP(UPD_OLD_PERM_IND_ctr)
-  
-#define TICK_SLOW_CALL_FUN_TOO_FEW()	TICK_BUMP(SLOW_CALL_FUN_TOO_FEW_ctr)
-#define TICK_SLOW_CALL_FUN_CORRECT()	TICK_BUMP(SLOW_CALL_FUN_CORRECT_ctr)
-#define TICK_SLOW_CALL_FUN_TOO_MANY()	TICK_BUMP(SLOW_CALL_FUN_TOO_MANY_ctr)
-#define TICK_SLOW_CALL_PAP_TOO_FEW()	TICK_BUMP(SLOW_CALL_PAP_TOO_FEW_ctr)
-#define TICK_SLOW_CALL_PAP_CORRECT()	TICK_BUMP(SLOW_CALL_PAP_CORRECT_ctr)
-#define TICK_SLOW_CALL_PAP_TOO_MANY()	TICK_BUMP(SLOW_CALL_PAP_TOO_MANY_ctr)
-
-#define TICK_SLOW_CALL_v()  		TICK_BUMP(SLOW_CALL_v_ctr)
-#define TICK_SLOW_CALL_p()  		TICK_BUMP(SLOW_CALL_p_ctr)
-#define TICK_SLOW_CALL_pv()  		TICK_BUMP(SLOW_CALL_pv_ctr)
-#define TICK_SLOW_CALL_pp()  		TICK_BUMP(SLOW_CALL_pp_ctr)
-#define TICK_SLOW_CALL_ppp()  		TICK_BUMP(SLOW_CALL_ppp_ctr)
-#define TICK_SLOW_CALL_pppp()  		TICK_BUMP(SLOW_CALL_pppp_ctr)
-#define TICK_SLOW_CALL_ppppp()  	TICK_BUMP(SLOW_CALL_ppppp_ctr)
-#define TICK_SLOW_CALL_pppppp()  	TICK_BUMP(SLOW_CALL_pppppp_ctr)
-
-#ifdef TICKY_TICKY
-#define TICK_HISTO_BY(histo,n,i)			\
-	 W_ __idx;					\
-	 __idx = (n);					\
-	 if (__idx > 8) {				\
-	    __idx = 8;					\
-         }						\
-	 CLong[histo##_hst + _idx*SIZEOF_LONG]		\
-	   = histo##_hst + __idx*SIZEOF_LONG] + i;
-#else
-#define TICK_HISTO_BY(histo,n,i) /* nothing */
-#endif
-
-#define TICK_HISTO(histo,n) TICK_HISTO_BY(histo,n,1)
-
-/* An unboxed tuple with n components. */
-#define TICK_RET_UNBOXED_TUP(n)			\
-  TICK_BUMP(RET_UNBOXED_TUP_ctr++);		\
-  TICK_HISTO(RET_UNBOXED_TUP,n)
-
-/*
- * A slow call with n arguments.  In the unevald case, this call has
- * already been counted once, so don't count it again.
- */
-#define TICK_SLOW_CALL(n)			\
-  TICK_BUMP(SLOW_CALL_ctr);			\
-  TICK_HISTO(SLOW_CALL,n)
-
-/*
- * This slow call was found to be to an unevaluated function; undo the
- * ticks we did in TICK_SLOW_CALL.
- */
-#define TICK_SLOW_CALL_UNEVALD(n)		\
-  TICK_BUMP(SLOW_CALL_UNEVALD_ctr);		\
-  TICK_BUMP_BY(SLOW_CALL_ctr,-1);		\
-  TICK_HISTO_BY(SLOW_CALL,n,-1);
-
-/* Updating a closure with a new CON */
-#define TICK_UPD_CON_IN_NEW(n)			\
-  TICK_BUMP(UPD_CON_IN_NEW_ctr);		\
-  TICK_HISTO(UPD_CON_IN_NEW,n)
-
-#define TICK_ALLOC_HEAP_NOCTR(n)		\
-    TICK_BUMP(ALLOC_HEAP_ctr);			\
-    TICK_BUMP_BY(ALLOC_HEAP_tot,n)
-
-/* -----------------------------------------------------------------------------
-   Misc junk
-   -------------------------------------------------------------------------- */
-
-#define TICK_MILLISECS   (1000/TICK_FREQUENCY)   /* ms per tick */
-
-#endif /* CMM_H */
diff --git a/ghc/includes/Constants.h b/ghc/includes/Constants.h
deleted file mode 100644
index 4f3c35b744..0000000000
--- a/ghc/includes/Constants.h
+++ /dev/null
@@ -1,258 +0,0 @@
-/* ----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2002
- *
- * Constants
- *
- * NOTE: this information is used by both the compiler and the RTS.
- * Some of it is tweakable, and some of it must be kept up to date
- * with various other parts of the system.
- *
- * Constants which are derived automatically from other definitions in
- * the system (eg. structure sizes) are generated into the file
- * DerivedConstants.h by a C program (mkDerivedConstantsHdr).
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef CONSTANTS_H
-#define CONSTANTS_H
-
-/* -----------------------------------------------------------------------------
-   Minimum closure sizes
-
-   This is the minimum number of words in the payload of a
-   heap-allocated closure, so that the closure has enough room to be
-   overwritten with a forwarding pointer during garbage collection.
-   -------------------------------------------------------------------------- */
-
-#define MIN_PAYLOAD_SIZE 1
-
-/* -----------------------------------------------------------------------------
-   Constants to do with specialised closure types.
-   -------------------------------------------------------------------------- */
-
-/* We have some pre-compiled selector thunks defined in rts/StgStdThunks.hc.
- * This constant defines the highest selectee index that we can replace with a 
- * reference to the pre-compiled code.
- */
-
-#define MAX_SPEC_SELECTEE_SIZE 15
-
-/* Vector-apply thunks.  These thunks just push their free variables
- * on the stack and enter the first one.  They're a bit like PAPs, but
- * don't have a dynamic size.  We've pre-compiled a few to save
- * space. 
- */
-
-#define MAX_SPEC_AP_SIZE       7
-
-/* Specialised FUN/THUNK/CONSTR closure types */
-
-#define MAX_SPEC_THUNK_SIZE    2
-#define MAX_SPEC_FUN_SIZE      2
-#define MAX_SPEC_CONSTR_SIZE   2
-
-/* Range of built-in table of static small int-like and char-like closures. 
- * 
- *   NB. This corresponds with the number of actual INTLIKE/CHARLIKE
- *   closures defined in rts/StgMiscClosures.cmm.
- */
-#define MAX_INTLIKE 		16
-#define MIN_INTLIKE 		(-16)
-
-#define MAX_CHARLIKE		255
-#define MIN_CHARLIKE		0
-
-/* -----------------------------------------------------------------------------
-   STG Registers.
-
-   Note that in MachRegs.h we define how many of these registers are
-   *real* machine registers, and not just offsets in the Register Table.
-   -------------------------------------------------------------------------- */
-
-#define MAX_VANILLA_REG 8
-#define MAX_FLOAT_REG   4
-#define MAX_DOUBLE_REG  2
-#define MAX_LONG_REG    1
-
-/* -----------------------------------------------------------------------------
- *  Maximum number of constructors in a data type for direct-returns. 
- *
- *   NB. There are various places that assume the value of this
- *   constant, such as the polymorphic return frames for updates
- *   (stg_upd_frame_info) and catch frames (stg_catch_frame_info).
- * -------------------------------------------------------------------------- */
-
-#define MAX_VECTORED_RTN 8
-
-/* -----------------------------------------------------------------------------
-   Semi-Tagging constants
-
-   Old Comments about this stuff:
-
-   Tags for indirection nodes and ``other'' (probably unevaluated) nodes;
-   normal-form values of algebraic data types will have tags 0, 1, ...
-   
-   @INFO_IND_TAG@ is different from @INFO_OTHER_TAG@ just so we can count
-   how often we bang into indirection nodes; that's all.  (WDP 95/11)
-
-   ToDo: find out if we need any of this.
-   -------------------------------------------------------------------------- */
-
-#define INFO_OTHER_TAG		(-1)
-#define INFO_IND_TAG		(-2)
-#define INFO_FIRST_TAG		0
-
-/* -----------------------------------------------------------------------------
-   How much C stack to reserve for local temporaries when in the STG
-   world.  Used in StgCRun.c.
-   -------------------------------------------------------------------------- */
-
-#define RESERVED_C_STACK_BYTES (2048 * SIZEOF_LONG)
-
-/* -----------------------------------------------------------------------------
-   How much Haskell stack space to reserve for the saving of registers
-   etc. in the case of a stack/heap overflow.
-   
-   This must be large enough to accomodate the largest stack frame
-   pushed in one of the heap check fragments in HeapStackCheck.hc
-   (ie. currently the generic heap checks - 3 words for StgRetDyn,
-   18 words for the saved registers, see StgMacros.h).  
-
-   In the event of an unboxed tuple or let-no-escape stack/heap check
-   failure, there will be other words on the stack which are covered
-   by the RET_DYN frame.  These will have been accounted for by stack
-   checks however, so we don't need to allow for them here.
-   -------------------------------------------------------------------------- */
-
-#define RESERVED_STACK_WORDS 21
-
-/* -----------------------------------------------------------------------------
-   Storage manager constants
-   -------------------------------------------------------------------------- */
-
-/* The size of a block (2^BLOCK_SHIFT bytes) */
-#define BLOCK_SHIFT  12
-
-/* The size of a megablock (2^MBLOCK_SHIFT bytes) */
-#define MBLOCK_SHIFT   20
-
-/* -----------------------------------------------------------------------------
-   Bitmap/size fields (used in info tables)
-   -------------------------------------------------------------------------- */
-
-/* In a 32-bit bitmap field, we use 5 bits for the size, and 27 bits
- * for the bitmap.  If the bitmap requires more than 27 bits, then we
- * store it in a separate array, and leave a pointer in the bitmap
- * field.  On a 64-bit machine, the sizes are extended accordingly.
- */
-#if SIZEOF_VOID_P == 4
-#define BITMAP_SIZE_MASK     0x1f
-#define BITMAP_BITS_SHIFT    5
-#elif SIZEOF_VOID_P == 8
-#define BITMAP_SIZE_MASK     0x3f
-#define BITMAP_BITS_SHIFT    6
-#else
-#error unknown SIZEOF_VOID_P
-#endif
-
-/* -----------------------------------------------------------------------------
-   Lag/Drag/Void constants
-   -------------------------------------------------------------------------- */
-
-/*
-  An LDV word is divided into 3 parts: state bits (LDV_STATE_MASK), creation 
-  time bits (LDV_CREATE_MASK), and last use time bits (LDV_LAST_MASK). 
- */
-#if SIZEOF_VOID_P == 8
-#define LDV_SHIFT               30
-#define LDV_STATE_MASK          0x1000000000000000
-#define LDV_CREATE_MASK         0x0FFFFFFFC0000000
-#define LDV_LAST_MASK           0x000000003FFFFFFF
-#define LDV_STATE_CREATE        0x0000000000000000
-#define LDV_STATE_USE           0x1000000000000000
-#else
-#define LDV_SHIFT               15
-#define LDV_STATE_MASK          0x40000000 
-#define LDV_CREATE_MASK         0x3FFF8000
-#define LDV_LAST_MASK           0x00007FFF
-#define LDV_STATE_CREATE        0x00000000
-#define LDV_STATE_USE           0x40000000
-#endif /* SIZEOF_VOID_P */
-
-/* -----------------------------------------------------------------------------
-   TSO related constants
-   -------------------------------------------------------------------------- */
-
-/*
- * Constants for the what_next field of a TSO, which indicates how it
- * is to be run.
- */
-#define ThreadRunGHC    1	/* return to address on top of stack */
-#define ThreadInterpret 2	/* interpret this thread */
-#define ThreadKilled	3	/* thread has died, don't run it */
-#define ThreadRelocated	4	/* thread has moved, link points to new locn */
-#define ThreadComplete	5	/* thread has finished */
-
-/*
- * Constants for the why_blocked field of a TSO
- */
-#define NotBlocked          0
-#define BlockedOnMVar       1
-#define BlockedOnBlackHole  2
-#define BlockedOnException  3
-#define BlockedOnRead       4
-#define BlockedOnWrite      5
-#define BlockedOnDelay      6
-#define BlockedOnSTM        7
-
-/* Win32 only: */
-#define BlockedOnDoProc     8
-
-/* Only relevant for PAR: */
-  /* blocked on a remote closure represented by a Global Address: */
-#define BlockedOnGA         9
-  /* same as above but without sending a Fetch message */
-#define BlockedOnGA_NoSend  10
-/* Only relevant for THREADED_RTS: */
-#define BlockedOnCCall      11
-#define BlockedOnCCall_NoUnblockExc 12
-   /* same as above but don't unblock async exceptions in resumeThread() */
-
-/*
- * These constants are returned to the scheduler by a thread that has
- * stopped for one reason or another.  See typedef StgThreadReturnCode
- * in TSO.h.
- */
-#define HeapOverflow   1		/* might also be StackOverflow */
-#define StackOverflow  2
-#define ThreadYielding 3
-#define ThreadBlocked  4
-#define ThreadFinished 5
-
-/* -----------------------------------------------------------------------------
-   RET_DYN stack frames
-   -------------------------------------------------------------------------- */
-
-/* VERY MAGIC CONSTANTS! 
- * must agree with code in HeapStackCheck.c, stg_gen_chk, and
- * RESERVED_STACK_WORDS in Constants.h.
- */
-#define RET_DYN_BITMAP_SIZE 8
-#define RET_DYN_NONPTR_REGS_SIZE 10
-
-/* Sanity check that RESERVED_STACK_WORDS is reasonable.  We can't
- * just derive RESERVED_STACK_WORDS because it's used in Haskell code
- * too.
- */
-#if RESERVED_STACK_WORDS != (3 + RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE)
-#error RESERVED_STACK_WORDS may be wrong!
-#endif
-
-/* -----------------------------------------------------------------------------
-   How often our context-switch timer ticks
-   -------------------------------------------------------------------------- */
-
-#define TICK_FREQUENCY   50                      /* ticks per second */
-
-#endif /* CONSTANTS_H */
diff --git a/ghc/includes/DNInvoke.h b/ghc/includes/DNInvoke.h
deleted file mode 100644
index 410bd640e1..0000000000
--- a/ghc/includes/DNInvoke.h
+++ /dev/null
@@ -1,55 +0,0 @@
-/*
- * C callable bridge to the .NET object model
- *
- * (c) 2003, sof.
- *
- */
-#ifndef __DNINVOKE_H__
-#define __DNINVOKE_H__
-#include "Dotnet.h"
-
-extern char* DN_invokeStatic ( char       *assemName,
-			       char       *methName,
-			       DotnetArg  *args,
-			       int        n_args,
-			       DotnetType resultTy,
-			       void       *res);
-extern char* DN_getStatic ( char       *assemName,
-			    char       *fieldClsName,
-			    DotnetArg  *args,
-			    int        n_args,
-			    DotnetType resultTy,
-			    void       *res);
-extern char* DN_setStatic ( char       *assemName,
-			    char       *fieldClsName,
-			    DotnetArg  *args,
-			    int        n_args,
-			    DotnetType resultTy,
-			    void       *res);
-extern char* DN_createObject ( char       *assemName,
-			       char       *methName,
-			       DotnetArg  *args,
-			       int        n_args,
-			       DotnetType resultTy,
-			       void       *res);
-
-extern char* DN_invokeMethod ( char       *methName,
-			       DotnetArg  *args,
-			       int        n_args,
-			       DotnetType resultTy,
-			       void       *res);
-
-extern char* DN_getField ( char       *methName,
-			   DotnetArg  *args,
-			   int        n_args,
-			   DotnetType resultTy,
-			   void       *res);
-extern char* DN_setField ( char       *clsAndMethName,
-			   DotnetArg  *args,
-			   int        n_args,
-			   DotnetType resultTy,
-			   void       *res);
-
-extern void stopDotnetBridge(void);
-
-#endif /* __DNINVOKE_H__ */
diff --git a/ghc/includes/Dotnet.h b/ghc/includes/Dotnet.h
deleted file mode 100644
index 89dace2ced..0000000000
--- a/ghc/includes/Dotnet.h
+++ /dev/null
@@ -1,64 +0,0 @@
-/*
- * Types and definitions to support GHC .NET interop.
- *
- * (c) 2003, sof.
- *
- */
-#ifndef __DOTNET_H__
-#define __DOTNET_H__
-
-typedef enum { 
-  Dotnet_Byte = 0,
-  Dotnet_Boolean,
-  Dotnet_Char,
-  Dotnet_Double,
-  Dotnet_Float,
-  Dotnet_Int,
-  Dotnet_Int8,
-  Dotnet_Int16,
-  Dotnet_Int32,
-  Dotnet_Int64,
-  Dotnet_Word8,
-  Dotnet_Word16,
-  Dotnet_Word32,
-  Dotnet_Word64,
-  Dotnet_Ptr,
-  Dotnet_Unit,
-  Dotnet_Object,
-  Dotnet_String
-} DotnetType;
-
-typedef union {
-  unsigned char      arg_byte;
-  unsigned int       arg_bool;
-  unsigned char      arg_char;
-  int                arg_int;
-  signed   char      arg_int8;
-  signed   short     arg_int16;
-  signed   int       arg_int32;
-#if defined(_MSC_VER)
-  signed  __int64    arg_int64;
-#else
-  signed  long long  arg_int64;
-#endif
-  float              arg_float;
-  double             arg_double;
-  unsigned char      arg_word8;
-  unsigned short     arg_word16;
-  unsigned int       arg_word32;
-#if defined(_MSC_VER)
-  unsigned __int64   arg_word64;
-#else
-  unsigned long long arg_word64;
-#endif
-  void*              arg_ptr;
-  void*              arg_obj;
-  void*              arg_str;
-} DotnetArgVal;
-
-typedef struct {
-  DotnetArgVal arg;
-  DotnetType   arg_type;
-} DotnetArg;
-
-#endif /* __DOTNET_H__ */
diff --git a/ghc/includes/GranSim.h b/ghc/includes/GranSim.h
deleted file mode 100644
index be5aa83a52..0000000000
--- a/ghc/includes/GranSim.h
+++ /dev/null
@@ -1,331 +0,0 @@
-/*
-  Headers for GranSim specific objects.
-  
-  Note that in GranSim we have one run-queue and blocking-queue for each
-  processor. Therefore, this header file redefines variables like
-  run_queue_hd to be relative to CurrentProc. The main arrays of runnable
-  and blocking queues are defined in Schedule.c.  The important STG-called
-  GranSim macros (e.g. for fetching nodes) are at the end of this
-  file. Usually they are just wrappers to proper C functions in GranSim.c.  
-*/
-
-#ifndef GRANSIM_H
-#define GRANSIM_H
-
-#if !defined(GRAN)
-
-/* Dummy definitions for basic GranSim macros called from STG land */
-#define DO_GRAN_ALLOCATE(n)     			  /* nothing */
-#define DO_GRAN_UNALLOCATE(n)   			  /* nothing */
-#define DO_GRAN_FETCH(node)     			  /* nothing */
-#define DO_GRAN_EXEC(arith,branch,load,store,floats)      /* nothing */
-#define GRAN_FETCH_AND_RESCHEDULE(liveness_mask,reenter)  /* nothing */
-#define GRAN_RESCHEDULE(liveness_mask,reenter)	          /* nothing */
-
-#endif
-
-#if defined(GRAN)  /* whole file */
-
-extern StgTSO *CurrentTSO;
-
-/*
- * @node Headers for GranSim specific objects, , ,
- * @section Headers for GranSim specific objects
- *
- * @menu
- * * Externs and prototypes::	
- * * Run and blocking queues::	
- * * Spark queues::		
- * * Processor related stuff::	
- * * GranSim costs::		
- * * STG called GranSim functions::  
- * * STG-called routines::	
- * @end menu
- *
- * @node Externs and prototypes, Run and blocking queues, Includes, Headers for GranSim specific objects
- * @subsection Externs and prototypes
- */
-
-/* Global constants */
-extern char *gran_event_names[];
-extern char *proc_status_names[];
-extern char *event_names[];
-
-/* Vars checked from within STG land */
-extern rtsBool  NeedToReSchedule, IgnoreEvents, IgnoreYields; 
-; 
-extern rtsTime  TimeOfNextEvent, TimeOfLastEvent, EndOfTimeSlice;
-
-/* costs for basic operations (copied from RTS flags) */
-extern nat gran_arith_cost, gran_branch_cost, gran_load_cost, gran_store_cost, gran_float_cost;
-
-extern nat SparksAvail;     /* How many sparks are available */
-extern nat SurplusThreads;  /* How many excess threads are there */
-extern nat sparksIgnored, sparksCreated;
-
-/*
- * @node Run and blocking queues, Spark queues, Externs and prototypes, Headers for GranSim specific objects
- * @subsection Run and blocking queues
- */
-
-/* declared in Schedule.c */
-extern StgTSO *run_queue_hds[], *run_queue_tls[];
-extern StgTSO *blocked_queue_hds[], *blocked_queue_tls[];
-extern StgTSO *ccalling_threadss[];
-
-#define run_queue_hd         run_queue_hds[CurrentProc]
-#define run_queue_tl         run_queue_tls[CurrentProc]
-#define blocked_queue_hd     blocked_queue_hds[CurrentProc]
-#define blocked_queue_tl     blocked_queue_tls[CurrentProc]
-#define pending_sparks_hd    pending_sparks_hds[CurrentProc]
-#define pending_sparks_tl    pending_sparks_tls[CurrentProc]
-#define ccalling_threads     ccalling_threadss[CurrentProc]
-
-/*
- * @node Spark queues, Processor related stuff, Run and blocking queues, Headers for GranSim specific objects
- * @subsection Spark queues
- */
-
-/*
-  In GranSim we use a double linked list to represent spark queues.
-  
-  This is more flexible, but slower, than the array of pointers
-  representation used in GUM. We use the flexibility to define new fields in
-  the rtsSpark structure, representing e.g. granularity info (see HWL's PhD
-  thesis), or info about the parent of a spark.
-*/
-
-/* Sparks and spark queues */
-typedef struct rtsSpark_
-{
-  StgClosure    *node;
-  nat            name, global;
-  nat            gran_info;      /* for granularity improvement mechanisms */
-  PEs            creator;        /* PE that created this spark (unused) */
-  struct rtsSpark_  *prev, *next;
-} rtsSpark;
-typedef rtsSpark *rtsSparkQ;
-
-/* The spark queues, proper */
-/* In GranSim this is a globally visible array of spark queues */
-extern rtsSparkQ pending_sparks_hds[];
-extern rtsSparkQ pending_sparks_tls[];
-
-/* Prototypes of those spark routines visible to compiler generated .hc */
-/* Routines only used inside the RTS are defined in rts/parallel GranSimRts.h */
-rtsSpark    *newSpark(StgClosure *node, 
-		      nat name, nat gran_info, nat size_info, 
-		      nat par_info, nat local);
-/* void         add_to_spark_queue(rtsSpark *spark); */
-
-/*
- * @node Processor related stuff, GranSim costs, Spark queues, Headers for GranSim specific objects
- * @subsection Processor related stuff
- */
-
-extern PEs CurrentProc;
-extern rtsTime CurrentTime[];  
-
-/* Maximum number of PEs that can be simulated */
-#define MAX_PROC             32 /* (BITS_IN(StgWord))  */ /* ToDo: fix this!! */
-/*
-#if MAX_PROC==16 
-#else 
-#error MAX_PROC should be 32 on this architecture 
-#endif
-*/
-
-/* #define CurrentTSO           CurrentTSOs[CurrentProc] */
-
-/* Processor numbers to bitmasks and vice-versa */
-#define MainProc	     0           /* Id of main processor */
-#define NO_PRI               0           /* dummy priority */
-#define MAX_PRI              10000       /* max possible priority */
-#define MAIN_PRI             MAX_PRI     /* priority of main thread */ 
-
-/* GrAnSim uses IdleProcs as bitmask to indicate which procs are idle */
-#define PE_NUMBER(n)          (1l << (long)n)
-#define ThisPE		      PE_NUMBER(CurrentProc)
-#define MainPE		      PE_NUMBER(MainProc)
-#define Everywhere	      (~0l)
-#define Nowhere	              (0l)
-#define Now                   CurrentTime[CurrentProc]
-
-#define IS_LOCAL_TO(ga,proc)  ((1l << (PEs) proc) & ga)
-
-#define GRAN_TIME_SLICE       1000        /* max time between 2 ReSchedules */
-
-/*
- * @node GranSim costs, STG called GranSim functions, Processor related stuff, Headers for GranSim specific objects
- * @subsection GranSim costs
- */
-
-/* Default constants for communication (see RtsFlags on how to change them) */
-
-#define LATENCY		           1000	/* Latency for single packet */
-#define ADDITIONAL_LATENCY	    100	/* Latency for additional packets */
-#define BASICBLOCKTIME	    	     10
-#define FETCHTIME	  	(LATENCY*2+MSGUNPACKTIME)
-#define LOCALUNBLOCKTIME  	     10
-#define GLOBALUNBLOCKTIME 	(LATENCY+MSGUNPACKTIME)
-
-#define	MSGPACKTIME		     0  /* Cost of creating a packet */
-#define	MSGUNPACKTIME		     0  /* Cost of receiving a packet */
-#define MSGTIDYTIME                  0  /* Cost of cleaning up after send */
-
-/* How much to increase GrAnSims internal packet size if an overflow 
-   occurs.
-   NB: This is a GrAnSim internal variable and is independent of the
-   simulated packet buffer size.
-*/
-
-#define GRANSIM_DEFAULT_PACK_BUFFER_SIZE     400
-#define REALLOC_SZ                           200
-
-/* extern W_ gran_mpacktime, gran_mtidytime, gran_munpacktime; */
-
-/* Thread cost model */
-#define THREADCREATETIME	   (25+THREADSCHEDULETIME)
-#define THREADQUEUETIME		    12  /* Cost of adding a thread to the running/runnable queue */
-#define THREADDESCHEDULETIME	    75  /* Cost of descheduling a thread */
-#define THREADSCHEDULETIME	    75  /* Cost of scheduling a thread */
-#define THREADCONTEXTSWITCHTIME	    (THREADDESCHEDULETIME+THREADSCHEDULETIME)
-
-/* Instruction Cost model (SPARC, including cache misses) */
-#define ARITH_COST	     	   1
-#define BRANCH_COST	     	   2
-#define LOAD_COST	  	   4
-#define STORE_COST	  	   4
-#define FLOAT_COST		   1 /* ? */
-
-#define HEAPALLOC_COST             11
-
-#define PRI_SPARK_OVERHEAD    5
-#define PRI_SCHED_OVERHEAD    5
-
-/*
- * @node STG called GranSim functions, STG-called routines, GranSim costs, Headers for GranSim specific objects
- * @subsection STG called GranSim functions
- */
-
-/* STG called GranSim functions */
-void GranSimAllocate(StgInt n);
-void GranSimUnallocate(StgInt n);
-void GranSimExec(StgWord ariths, StgWord branches, StgWord loads, StgWord stores, StgWord floats);
-StgInt GranSimFetch(StgClosure *node);
-void GranSimSpark(StgInt local, StgClosure *node);
-void GranSimSparkAt(rtsSpark *spark, StgClosure *where,StgInt identifier);
-void GranSimSparkAtAbs(rtsSpark *spark, PEs proc, StgInt identifier);
-void GranSimBlock(StgTSO *tso, PEs proc, StgClosure *node);
-
-
-/*
- * @node STG-called routines,  , STG called GranSim functions, Headers for GranSim specific objects
- * @subsection STG-called routines
- */
-
-/* Wrapped version of calls to GranSim-specific STG routines */
-
-/*
-#define DO_PERFORM_RESCHEDULE(liveness, always_reenter_node) PerformReschedule_wrapper(liveness, always_reenter_node)
-*/
-#define DO_GRAN_ALLOCATE(n)     STGCALL1(GranSimAllocate, n)
-#define DO_GRAN_UNALLOCATE(n)   STGCALL1(GranSimUnallocate, n)
-#define DO_GRAN_FETCH(node)     STGCALL1(GranSimFetch, node)
-#define DO_GRAN_EXEC(arith,branch,load,store,floats) GranSimExec(arith,branch,load,store,floats)
-
-/* 
-   ToDo: Clean up this mess of GRAN macros!!! -- HWL
-*/
-/* DO_GRAN_FETCH((StgClosure*)R1.p); */
-#define GRAN_FETCH()		/* nothing */
-
-#define GRAN_FETCH_AND_RESCHEDULE(liveness,reenter)	\
-          DO_GRAN_FETCH((StgClosure*)R1.p); 			        \
-          DO_GRAN_YIELD(liveness,ENTRY_CODE((D_)(*R1.p))); 
-/* RESTORE_EVERYTHING is done implicitly before entering threaded world again */
-
-/*
-  This is the only macro currently enabled;
-  It should check whether it is time for the current thread to yield
-  (e.g. if there is a more recent event in the queue) and it should check
-  whether node is local, via a call to GranSimFetch.
-  ToDo: split this in 2 routines:
-         - GRAN_YIELD (as it is below)
-	 - GRAN_FETCH (the rest of this macro)
-        emit only these 2 macros based on node's liveness
-	  node alive: emit both macros
-	  node not alive: do only a GRAN_YIELD
-	  
-        replace gran_yield_? with gran_block_? (they really block the current
-	thread)
-*/
-#define GRAN_RESCHEDULE(liveness,ptrs)  \
-          if (RET_STGCALL1(StgInt, GranSimFetch, (StgClosure*)R1.p)) {\
-            EXTFUN_RTS(gran_block_##ptrs); \
-            JMP_(gran_block_##ptrs);       \
-          } else {                         \
-	    if (TimeOfLastEvent < CurrentTime[CurrentProc] && \
-                HEAP_ALLOCED((StgClosure *)R1.p) && \
-                LOOKS_LIKE_GHC_INFO(get_itbl((StgClosure *)R1.p))) { \
-                                  EXTFUN_RTS(gran_yield_##ptrs); \
-                                  JMP_(gran_yield_##ptrs); \
-                } \
-            /* GRAN_YIELD(ptrs)  */             \
-	  }
-
-
-/*                                                   YIELD(liveness,reenter) */
-
-/* GRAN_YIELD(liveness_mask); */
-
-/* GRAN_FETCH_AND_RESCHEDULE(liveness_mask,reenter) */
-
-#define THREAD_CONTEXT_SWITCH(liveness_mask,reenter)	\
-        do { \
-	if (context_switch /* OR_INTERVAL_EXPIRED */) {	\
-          GRAN_RESCHEDULE(liveness_mask,reenter); \
-        } }while(0)
-
-#define GRAN_EXEC(arith,branch,load,store,floats)       \
-        { \
-          W_ cost = gran_arith_cost*arith +   \
-                    gran_branch_cost*branch + \
-                    gran_load_cost*load +   \
-                    gran_store_cost*store +   \
-                    gran_float_cost*floats;   \
-          CurrentTSO->gran.exectime += cost;                      \
-          CurrentTime[CurrentProc] += cost;                      \
-        }
-
-/* In GranSim we first check whether there is an event to handle; only if
-   this is the case (or the time slice is over in case of fair scheduling)
-   we do a yield, which is very similar to that in the concurrent world 
-   ToDo: check whether gran_yield_? can be merged with other yielding codes
-*/
-
-#define DO_GRAN_YIELD(ptrs)	if (!IgnoreYields && \
-                                    TimeOfLastEvent < CurrentTime[CurrentProc] && \
-				    HEAP_ALLOCED((StgClosure *)R1.p) && \
-                                    LOOKS_LIKE_GHC_INFO(get_itbl((StgClosure *)R1.p))) { \
-                                  EXTFUN_RTS(gran_yield_##ptrs); \
-                                  JMP_(gran_yield_##ptrs); \
-                                }
-
-#define GRAN_YIELD(ptrs)                                   \
-        {                                                   \
-          extern int context_switch;                          \
-          if ( (CurrentTime[CurrentProc]>=EndOfTimeSlice) ||   \
-               ((CurrentTime[CurrentProc]>=TimeOfNextEvent) && \
-	        (TimeOfNextEvent!=0) && !IgnoreEvents )) {     \
-	    /* context_switch = 1; */                          \
-            DO_GRAN_YIELD(ptrs);   \
-	  }                                                    \
-	}
-
-#define ADD_TO_SPARK_QUEUE(spark)	      \
-   STGCALL1(add_to_spark_queue,spark) \
-
-#endif /* GRAN */
-
-#endif /* GRANSIM_H */
diff --git a/ghc/includes/Hooks.h b/ghc/includes/Hooks.h
deleted file mode 100644
index 38014cc8f7..0000000000
--- a/ghc/includes/Hooks.h
+++ /dev/null
@@ -1,20 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-1999
- *
- * User-overridable RTS hooks.
- *
- * ---------------------------------------------------------------------------*/
-
-extern char *ghc_rts_opts;
-
-extern void OnExitHook (void);
-extern int  NoRunnableThreadsHook (void);
-extern void StackOverflowHook (unsigned long stack_size);
-extern void OutOfHeapHook (unsigned long request_size, unsigned long heap_size);
-extern void MallocFailHook (unsigned long request_size /* in bytes */, char *msg);
-extern void defaultsHook (void);
-#if defined(PAR)
-extern void InitEachPEHook (void);
-extern void ShutdownEachPEHook (void);
-#endif
diff --git a/ghc/includes/HsFFI.h b/ghc/includes/HsFFI.h
deleted file mode 100644
index 70891a2dc2..0000000000
--- a/ghc/includes/HsFFI.h
+++ /dev/null
@@ -1,167 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2000
- *
- * A mapping for Haskell types to C types, including the corresponding bounds.
- * Intended to be used in conjuction with the FFI.
- *
- * WARNING: Keep this file and StgTypes.h in synch!
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef HSFFI_H
-#define HSFFI_H
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* get types from GHC's runtime system */
-#include "ghcconfig.h"
-#include "RtsConfig.h"
-#include "StgTypes.h"
-
-/* get limits for integral types */
-#ifdef HAVE_STDINT_H
-/* ISO C 99 says:
- * "C++ implementations should define these macros only when
- * __STDC_LIMIT_MACROS is defined before <stdint.h> is included."
- */
-#define __STDC_LIMIT_MACROS
-#include <stdint.h>
-#elif defined(HAVE_INTTYPES_H)
-#include <inttypes.h>
-#else
-/* second best guess (e.g. on Solaris) */
-#include <limits.h>
-#endif
-
-#ifdef INT8_MIN
-#define __INT8_MIN  		INT8_MIN
-#define __INT16_MIN 		INT16_MIN
-#define __INT32_MIN 		INT32_MIN
-#define __INT64_MIN 		INT64_MIN
-#define __INT8_MAX  		INT8_MAX
-#define __INT16_MAX 		INT16_MAX
-#define __INT32_MAX 		INT32_MAX
-#define __INT64_MAX 		INT64_MAX
-#define __UINT8_MAX 		UINT8_MAX
-#define __UINT16_MAX		UINT16_MAX
-#define __UINT32_MAX		UINT32_MAX
-#define __UINT64_MAX		UINT64_MAX
-#else
-/* if we had no luck, let's do it for ourselves (assuming 64bit long longs) */
-#define __INT8_MIN		(-128)
-#define __INT16_MIN		(-32767-1)
-#define __INT32_MIN		(-2147483647-1)
-#define __INT64_MIN		(-9223372036854775807LL-1)
-#define __INT8_MAX		(127)
-#define __INT16_MAX		(32767)
-#define __INT32_MAX		(2147483647)
-#define __INT64_MAX		(9223372036854775807LL)
-#define __UINT8_MAX		(255U)
-#define __UINT16_MAX		(65535U)
-#define __UINT32_MAX		(4294967295U)
-#define __UINT64_MAX		(18446744073709551615ULL)
-#endif
-
-/* get limits for floating point types */
-#include <float.h>
-
-typedef StgChar			HsChar;
-typedef StgInt			HsInt;
-typedef StgInt8			HsInt8;
-typedef StgInt16		HsInt16;
-typedef StgInt32		HsInt32;
-typedef StgInt64		HsInt64;
-typedef StgWord                 HsWord;
-typedef StgWord8		HsWord8;
-typedef StgWord16		HsWord16;
-typedef StgWord32		HsWord32;
-typedef StgWord64		HsWord64;
-typedef StgFloat		HsFloat;
-typedef StgDouble		HsDouble;
-typedef StgBool			HsBool;
-typedef void*			HsPtr;          /* this should better match StgAddr */
-typedef void			(*HsFunPtr)(void); /* this should better match StgAddr */
-typedef void*			HsForeignPtr;   /* ... and this StgForeignPtr       */
-typedef void*			HsStablePtr;
-typedef void*			HsAddr;         /* DEPRECATED */
-typedef void*			HsForeignObj;   /* DEPRECATED */
-
-/* this should correspond to the type of StgChar in StgTypes.h */
-#define HS_CHAR_MIN		0
-#define HS_CHAR_MAX		0x10FFFF
-
-/* is it true or not?  */
-#define HS_BOOL_FALSE           0
-#define HS_BOOL_TRUE            1
-
-#define HS_BOOL_MIN             HS_BOOL_FALSE
-#define HS_BOOL_MAX             HS_BOOL_TRUE
-
-/* this mirrors the distinction of cases in StgTypes.h */
-#if   SIZEOF_VOID_P == 8
-#define HS_INT_MIN		__INT64_MIN
-#define HS_INT_MAX		__INT64_MAX
-#elif SIZEOF_VOID_P == 4
-#define HS_INT_MIN		__INT32_MIN
-#define HS_INT_MAX		__INT32_MAX
-#else
-#error GHC untested on this architecture: sizeof(void *) != 4 or 8
-#endif
-
-#define HS_INT8_MIN		__INT8_MIN
-#define HS_INT8_MAX		__INT8_MAX
-#define HS_INT16_MIN		__INT16_MIN
-#define HS_INT16_MAX		__INT16_MAX
-#define HS_INT32_MIN		__INT32_MIN
-#define HS_INT32_MAX		__INT32_MAX
-#define HS_INT64_MIN		__INT64_MIN
-#define HS_INT64_MAX		__INT64_MAX
-#define HS_WORD8_MAX		__UINT8_MAX
-#define HS_WORD16_MAX		__UINT16_MAX
-#define HS_WORD32_MAX		__UINT32_MAX
-#define HS_WORD64_MAX		__UINT64_MAX
-
-#define HS_FLOAT_RADIX		FLT_RADIX
-#define HS_FLOAT_ROUNDS		FLT_ROUNDS
-#define HS_FLOAT_EPSILON	FLT_EPSILON
-#define HS_FLOAT_DIG		FLT_DIG
-#define HS_FLOAT_MANT_DIG	FLT_MANT_DIG
-#define HS_FLOAT_MIN		FLT_MIN
-#define HS_FLOAT_MIN_EXP	FLT_MIN_EXP
-#define HS_FLOAT_MIN_10_EXP	FLT_MIN_10_EXP
-#define HS_FLOAT_MAX		FLT_MAX
-#define HS_FLOAT_MAX_EXP	FLT_MAX_EXP
-#define HS_FLOAT_MAX_10_EXP	FLT_MAX_10_EXP
-
-#define HS_DOUBLE_RADIX		DBL_RADIX
-#define HS_DOUBLE_ROUNDS	DBL_ROUNDS
-#define HS_DOUBLE_EPSILON	DBL_EPSILON
-#define HS_DOUBLE_DIG		DBL_DIG
-#define HS_DOUBLE_MANT_DIG	DBL_MANT_DIG
-#define HS_DOUBLE_MIN		DBL_MIN
-#define HS_DOUBLE_MIN_EXP	DBL_MIN_EXP
-#define HS_DOUBLE_MIN_10_EXP	DBL_MIN_10_EXP
-#define HS_DOUBLE_MAX		DBL_MAX
-#define HS_DOUBLE_MAX_EXP	DBL_MAX_EXP
-#define HS_DOUBLE_MAX_10_EXP	DBL_MAX_10_EXP
-
-extern void hs_init     (int *argc, char **argv[]);
-extern void hs_exit     (void);
-extern void hs_set_argv (int argc, char *argv[]);
-extern void hs_add_root (void (*init_root)(void));
-
-extern void hs_perform_gc (void);
-
-extern void hs_free_stable_ptr (HsStablePtr sp);
-extern void hs_free_fun_ptr    (HsFunPtr fp);
-
-/* -------------------------------------------------------------------------- */
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* HSFFI_H */
diff --git a/ghc/includes/InfoTables.h b/ghc/includes/InfoTables.h
deleted file mode 100644
index 8fa699a097..0000000000
--- a/ghc/includes/InfoTables.h
+++ /dev/null
@@ -1,423 +0,0 @@
-/* ----------------------------------------------------------------------------
- * 
- * (c) The GHC Team, 1998-2002
- *
- * Info Tables
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef INFOTABLES_H
-#define INFOTABLES_H
-
-/* -----------------------------------------------------------------------------
-   Profiling info
-   -------------------------------------------------------------------------- */
-
-typedef struct {
-    char *closure_type;
-    char *closure_desc;
-} StgProfInfo;
-
-/* -----------------------------------------------------------------------------
-   Parallelism info
-   -------------------------------------------------------------------------- */
-
-#if 0 && (defined(PAR) || defined(GRAN))
-
-/* CURRENTLY UNUSED
-   ToDo: use this in StgInfoTable (mutually recursive) -- HWL */
-
-typedef struct {
-  StgInfoTable *rbh_infoptr;     /* infoptr to the RBH  */
-} StgParInfo;
-
-#endif /* 0 */
-
-/*
-   Copied from ghc-0.29; ToDo: check this code -- HWL
-
-   In the parallel system, all updatable closures have corresponding
-   revertible black holes.  When we are assembly-mangling, we guarantee
-   that the revertible black hole code precedes the normal entry code, so
-   that the RBH info table resides at a fixed offset from the normal info
-   table.  Otherwise, we add the RBH info table pointer to the end of the
-   normal info table and vice versa.
-
-   Currently has to use a !RBH_MAGIC_OFFSET setting.
-   Still todo: init of par.infoptr field in all infotables!!
-*/
-
-#if defined(PAR) || defined(GRAN)
-
-# ifdef RBH_MAGIC_OFFSET
-
-#  error magic offset not yet implemented
-
-#  define RBH_INFO_WORDS    0
-#  define INCLUDE_RBH_INFO(infoptr)
-
-#  define RBH_INFOPTR(infoptr)	    (((P_)infoptr) - RBH_MAGIC_OFFSET)
-#  define REVERT_INFOPTR(infoptr)   (((P_)infoptr) + RBH_MAGIC_OFFSET)
-
-# else
-
-#  define RBH_INFO_WORDS    1
-#  define INCLUDE_RBH_INFO(info)    rbh_infoptr : &(info)
-
-#  define RBH_INFOPTR(infoptr)	    (((StgInfoTable *)(infoptr))->rbh_infoptr)
-#  define REVERT_INFOPTR(infoptr)   (((StgInfoTable *)(infoptr))->rbh_infoptr)
-
-# endif
-
-/* see ParallelRts.h */
-/*
-EXTFUN(RBH_entry);
-StgClosure *convertToRBH(StgClosure *closure);
-#if defined(GRAN)
-void convertFromRBH(StgClosure *closure);
-#elif defined(PAR)
-void convertToFetchMe(StgPtr closure, globalAddr *ga);
-#endif
-*/
-
-#endif
-
-/* -----------------------------------------------------------------------------
-   Ticky info
-
-   There is no ticky-specific stuff in an info table at this time.
-   -------------------------------------------------------------------------- */
-
-/* -----------------------------------------------------------------------------
-   Debugging info
-   -------------------------------------------------------------------------- */
-
-#ifdef DEBUG_CLOSURE
-
-typedef struct {
-	... whatever ...
-} StgDebugInfo;
-
-#else /* !DEBUG_CLOSURE */
-
-/* There is no DEBUG-specific stuff in an info table at this time. */
-
-#endif /* DEBUG_CLOSURE */
-
-/* -----------------------------------------------------------------------------
-   Closure flags
-   -------------------------------------------------------------------------- */
-
-/* The type flags provide quick access to certain properties of a closure. */
-
-#define _HNF (1<<0)  /* head normal form?    */
-#define _BTM (1<<1)  /* bitmap-style layout? */
-#define _NS  (1<<2)  /* non-sparkable        */
-#define _STA (1<<3)  /* static?              */
-#define _THU (1<<4)  /* thunk?               */
-#define _MUT (1<<5)  /* mutable?             */
-#define _UPT (1<<6)  /* unpointed?           */
-#define _SRT (1<<7)  /* has an SRT?          */
-#define _IND (1<<8)  /* is an indirection?   */
-
-#define isSTATIC(flags)    ((flags) &_STA)
-#define isMUTABLE(flags)   ((flags) &_MUT)
-#define isBITMAP(flags)    ((flags) &_BTM)
-#define isTHUNK(flags)     ((flags) &_THU)
-#define isUNPOINTED(flags) ((flags) &_UPT)
-#define hasSRT(flags)      ((flags) &_SRT)
-
-extern StgWord16 closure_flags[];
-
-#define closureFlags(c)         (closure_flags[get_itbl(c)->type])
-
-#define closure_HNF(c)          (  closureFlags(c) & _HNF)
-#define closure_BITMAP(c)       (  closureFlags(c) & _BTM)
-#define closure_NON_SPARK(c)    ( (closureFlags(c) & _NS))
-#define closure_SHOULD_SPARK(c) (!(closureFlags(c) & _NS))
-#define closure_STATIC(c)       (  closureFlags(c) & _STA)
-#define closure_THUNK(c)        (  closureFlags(c) & _THU)
-#define closure_MUTABLE(c)      (  closureFlags(c) & _MUT)
-#define closure_UNPOINTED(c)    (  closureFlags(c) & _UPT)
-#define closure_SRT(c)          (  closureFlags(c) & _SRT)
-#define closure_IND(c)          (  closureFlags(c) & _IND)
-
-/* same as above but for info-ptr rather than closure */
-#define ipFlags(ip)             (closure_flags[ip->type])
-
-#define ip_HNF(ip)               (  ipFlags(ip) & _HNF)
-#define ip_BITMAP(ip)       	 (  ipFlags(ip) & _BTM)
-#define ip_SHOULD_SPARK(ip) 	 (!(ipFlags(ip) & _NS))
-#define ip_STATIC(ip)       	 (  ipFlags(ip) & _STA)
-#define ip_THUNK(ip)        	 (  ipFlags(ip) & _THU)
-#define ip_MUTABLE(ip)      	 (  ipFlags(ip) & _MUT)
-#define ip_UNPOINTED(ip)    	 (  ipFlags(ip) & _UPT)
-#define ip_SRT(ip)          	 (  ipFlags(ip) & _SRT)
-#define ip_IND(ip)          	 (  ipFlags(ip) & _IND)
-
-/* -----------------------------------------------------------------------------
-   Bitmaps
-
-   These are used to describe the pointerhood of a sequence of words
-   (usually on the stack) to the garbage collector.  The two primary
-   uses are for stack frames, and functions (where we need to describe
-   the layout of a PAP to the GC).
-
-   In these bitmaps: 0 == ptr, 1 == non-ptr.
-   -------------------------------------------------------------------------- */
-
-/*
- * Small bitmaps:  for a small bitmap, we store the size and bitmap in 
- * the same word, using the following macros.  If the bitmap doesn't
- * fit in a single word, we use a pointer to an StgLargeBitmap below.
- */
-#define MK_SMALL_BITMAP(size,bits) (((bits)<<BITMAP_BITS_SHIFT) | (size))
-
-#define BITMAP_SIZE(bitmap) ((bitmap) & BITMAP_SIZE_MASK)
-#define BITMAP_BITS(bitmap) ((bitmap) >> BITMAP_BITS_SHIFT)
-
-/*
- * A large bitmap.
- */
-typedef struct {
-  StgWord size;
-  StgWord bitmap[FLEXIBLE_ARRAY];
-} StgLargeBitmap;
-
-/* -----------------------------------------------------------------------------
-   SRTs  (Static Reference Tables)
-
-   These tables are used to keep track of the static objects referred
-   to by the code for a closure or stack frame, so that we can follow
-   static data references from code and thus accurately
-   garbage-collect CAFs.
-   -------------------------------------------------------------------------- */
-
-/* An SRT is just an array of closure pointers: */
-typedef StgClosure* StgSRT[];
-
-/*
- * Each info table refers to some subset of the closure pointers in an
- * SRT.  It does this using a pair of an StgSRT pointer and a
- * half-word bitmap.  If the half-word bitmap isn't large enough, then
- * we fall back to a large SRT, including an unbounded bitmap.  If the
- * half-word bitmap is set to all ones (0xffff), then the StgSRT
- * pointer instead points to an StgLargeSRT:
- */
-typedef struct StgLargeSRT_ {
-    StgSRT *srt;
-    StgLargeBitmap l;
-} StgLargeSRT;
-
-/* ----------------------------------------------------------------------------
-   Relative pointers
-
-   Several pointer fields in info tables are expressed as offsets
-   relative to the info pointer, so that we can generate
-   position-independent code.
-
-   There is a complication on the x86_64 platform, where pointeres are
-   64 bits, but the tools don't support 64-bit relative relocations.
-   However, the default memory model (small) ensures that all symbols
-   have values in the lower 2Gb of the address space, so offsets all
-   fit in 32 bits.  Hence we can use 32-bit offset fields.
-   ------------------------------------------------------------------------- */
-
-#if x86_64_TARGET_ARCH
-#define OFFSET_FIELD(n) StgHalfInt n; StgHalfWord __pad_##n;
-#else   
-#define OFFSET_FIELD(n) StgInt n;
-#endif
-
-/* ----------------------------------------------------------------------------
-   Info Tables
-   ------------------------------------------------------------------------- */
-
-/*
- * Stuff describing the closure layout.  Well, actually, it might
- * contain the selector index for a THUNK_SELECTOR.  This union is one
- * word long.
- */
-typedef union {
-    struct {			/* Heap closure payload layout: */
-	StgHalfWord ptrs;	/* number of pointers */
-	StgHalfWord nptrs;	/* number of non-pointers */
-    } payload;
-    
-    StgWord bitmap;		  /* word-sized bit pattern describing */
-				  /*  a stack frame: see below */
-
-#ifndef TABLES_NEXT_TO_CODE
-    StgLargeBitmap* large_bitmap; /* pointer to large bitmap structure */
-#else
-    OFFSET_FIELD( large_bitmap_offset );  /* offset from info table to large bitmap structure */
-#endif
-    
-    StgWord selector_offset;	  /* used in THUNK_SELECTORs */
-
-} StgClosureInfo;
-
-
-/*
- * The "standard" part of an info table.  Every info table has this bit.
- */
-typedef struct _StgInfoTable {
-
-#ifndef TABLES_NEXT_TO_CODE
-    StgFunPtr       entry;	/* pointer to the entry code */
-#endif
-
-#if defined(PAR) || defined(GRAN)
-    struct _StgInfoTable    *rbh_infoptr;
-#endif
-#ifdef PROFILING
-    StgProfInfo     prof;
-#endif
-#ifdef TICKY
-  /* Ticky-specific stuff would go here. */
-#endif
-#ifdef DEBUG_CLOSURE
-  /* Debug-specific stuff would go here. */
-#endif
-
-    StgClosureInfo  layout;	/* closure layout info (one word) */
-
-    StgHalfWord     type;	/* closure type */
-    StgHalfWord     srt_bitmap;    /* number of entries in SRT (or constructor tag) */
-
-#ifdef TABLES_NEXT_TO_CODE
-    StgCode         code[FLEXIBLE_ARRAY];
-#endif
-} StgInfoTable;
-
-
-/* -----------------------------------------------------------------------------
-   Function info tables
-
-   This is the general form of function info tables.  The compiler
-   will omit some of the fields in common cases:
-
-   -  If fun_type is not ARG_GEN or ARG_GEN_BIG, then the slow_apply
-      and bitmap fields may be left out (they are at the end, so omitting
-      them doesn't affect the layout).
-      
-   -  If srt_bitmap (in the std info table part) is zero, then the srt
-      field may be omitted.  This only applies if the slow_apply and
-      bitmap fields have also been omitted.
-   -------------------------------------------------------------------------- */
-
-typedef struct _StgFunInfoExtraRev {
-    OFFSET_FIELD ( slow_apply_offset ); /* apply to args on the stack */
-    union { 
-	StgWord bitmap;
-	OFFSET_FIELD ( bitmap_offset );	/* arg ptr/nonptr bitmap */
-    } b;
-    OFFSET_FIELD ( srt_offset ); /* pointer to the SRT table */
-    StgHalfWord    fun_type;    /* function type */
-    StgHalfWord    arity;       /* function arity */
-} StgFunInfoExtraRev;
-
-typedef struct _StgFunInfoExtraFwd {
-    StgHalfWord    fun_type;    /* function type */
-    StgHalfWord    arity;       /* function arity */
-    StgSRT         *srt;	/* pointer to the SRT table */
-    union { /* union for compat. with TABLES_NEXT_TO_CODE version */
-	StgWord        bitmap;	/* arg ptr/nonptr bitmap */
-    } b;
-    StgFun         *slow_apply; /* apply to args on the stack */
-} StgFunInfoExtraFwd;
-
-typedef struct {
-#if defined(TABLES_NEXT_TO_CODE)
-    StgFunInfoExtraRev f;
-    StgInfoTable i;
-#else
-    StgInfoTable i;
-    StgFunInfoExtraFwd f;
-#endif
-} StgFunInfoTable;
-
-/* -----------------------------------------------------------------------------
-   Return info tables
-   -------------------------------------------------------------------------- */
-
-/*
- * When info tables are laid out backwards, we can omit the SRT
- * pointer iff srt_bitmap is zero.
- */
-
-typedef struct {
-#if defined(TABLES_NEXT_TO_CODE)
-    OFFSET_FIELD( srt_offset );	/* offset to the SRT table */
-    StgInfoTable i;
-#else
-    StgInfoTable i;
-    StgSRT      *srt;	/* pointer to the SRT table */
-    StgFunPtr vector[FLEXIBLE_ARRAY];
-#endif
-} StgRetInfoTable;
-
-/* -----------------------------------------------------------------------------
-   Thunk info tables
-   -------------------------------------------------------------------------- */
-
-/*
- * When info tables are laid out backwards, we can omit the SRT
- * pointer iff srt_bitmap is zero.
- */
-
-typedef struct _StgThunkInfoTable {
-#if !defined(TABLES_NEXT_TO_CODE)
-    StgInfoTable i;
-#endif
-#if defined(TABLES_NEXT_TO_CODE)
-    OFFSET_FIELD( srt_offset );	/* offset to the SRT table */
-#else
-    StgSRT         *srt;	/* pointer to the SRT table */
-#endif
-#if defined(TABLES_NEXT_TO_CODE)
-    StgInfoTable i;
-#endif
-} StgThunkInfoTable;
-
-
-/* -----------------------------------------------------------------------------
-   Accessor macros for fields that might be offsets (C version)
-   -------------------------------------------------------------------------- */
-
-/*
- * GET_SRT(info)
- * info must be a Stg[Ret|Thunk]InfoTable* (an info table that has a SRT)
- */
-#ifdef TABLES_NEXT_TO_CODE
-#define GET_SRT(info) ((StgSRT*) (((StgWord) ((info)+1)) + (info)->srt_offset))
-#else
-#define GET_SRT(info) ((info)->srt)
-#endif
-
-/*
- * GET_FUN_SRT(info)
- * info must be a StgFunInfoTable*
- */
-#ifdef TABLES_NEXT_TO_CODE
-#define GET_FUN_SRT(info) ((StgSRT*) (((StgWord) ((info)+1)) + (info)->f.srt_offset))
-#else
-#define GET_FUN_SRT(info) ((info)->f.srt)
-#endif
-
-#ifdef TABLES_NEXT_TO_CODE
-#define GET_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \
-                                        + (info)->layout.large_bitmap_offset))
-#else
-#define GET_LARGE_BITMAP(info) ((info)->layout.large_bitmap)
-#endif
-
-#ifdef TABLES_NEXT_TO_CODE
-#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) (((StgWord) ((info)+1)) \
-                                        + (info)->f.b.bitmap_offset))
-#else
-#define GET_FUN_LARGE_BITMAP(info) ((StgLargeBitmap*) ((info)->f.b.bitmap))
-#endif
-
-
-#endif /* INFOTABLES_H */
diff --git a/ghc/includes/Linker.h b/ghc/includes/Linker.h
deleted file mode 100644
index bb1a4c251f..0000000000
--- a/ghc/includes/Linker.h
+++ /dev/null
@@ -1,30 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2000
- *
- * RTS Object Linker
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef LINKER_H
-#define LINKER_H
-
-/* initialize the object linker */
-void initLinker( void );
-
-/* lookup a symbol in the hash table */
-void *lookupSymbol( char *lbl );
-
-/* delete an object from the pool */
-HsInt unloadObj( char *path );
-
-/* add an obj (populate the global symbol table, but don't resolve yet) */
-HsInt loadObj( char *path );
-
-/* resolve all the currently unlinked objects in memory */
-HsInt resolveObjs( void );
-
-/* load a dynamic library */
-char *addDLL( char* dll_name );
-
-#endif /* LINKER_H */
diff --git a/ghc/includes/Liveness.h b/ghc/includes/Liveness.h
deleted file mode 100644
index cc93cae34f..0000000000
--- a/ghc/includes/Liveness.h
+++ /dev/null
@@ -1,34 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The University of Glasgow 2004
- *
- * Building liveness masks for RET_DYN stack frames.
- * A few macros that are used in both .cmm and .c sources.
- *
- * A liveness mask is constructed like so:
- *
- *    R1_PTR & R2_PTR & R3_PTR
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef LIVENESS_H
-#define LIVENESS_H
-
-#define NO_PTRS   0xff
-#define R1_PTR	  (NO_PTRS ^ (1<<0))
-#define R2_PTR	  (NO_PTRS ^ (1<<1))
-#define R3_PTR	  (NO_PTRS ^ (1<<2))
-#define R4_PTR	  (NO_PTRS ^ (1<<3))
-#define R5_PTR	  (NO_PTRS ^ (1<<4))
-#define R6_PTR	  (NO_PTRS ^ (1<<5))
-#define R7_PTR	  (NO_PTRS ^ (1<<6))
-#define R8_PTR	  (NO_PTRS ^ (1<<7))
-
-#define N_NONPTRS(n)  ((n)<<16)
-#define N_PTRS(n)     ((n)<<24)
-
-#define RET_DYN_NONPTRS(l) ((l)>>16 & 0xff)
-#define RET_DYN_PTRS(l)    ((l)>>24 & 0xff)
-#define RET_DYN_LIVENESS(l) ((l) & 0xffff)
-
-#endif /* LIVENESS_H */
diff --git a/ghc/includes/MachDeps.h b/ghc/includes/MachDeps.h
deleted file mode 100644
index abe4405d5e..0000000000
--- a/ghc/includes/MachDeps.h
+++ /dev/null
@@ -1,108 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The University of Glasgow 2002
- * 
- * Definitions that characterise machine specific properties of basic
- * types (C & Haskell).
- *
- * NB: Keep in sync with HsFFI.h and StgTypes.h.
- * NB: THIS FILE IS INCLUDED IN HASKELL SOURCE!
- * ---------------------------------------------------------------------------*/
-
-#ifndef MACHDEPS_H
-#define MACHDEPS_H
-
-/* Sizes of C types come from here... */
-#include "ghcautoconf.h"
-
-/* Sizes of Haskell types follow.  These sizes correspond to:
- *   - the number of bytes in the primitive type (eg. Int#)
- *   - the number of bytes in the external representation (eg. HsInt)
- *   - the scale offset used by writeFooOffAddr#
- *
- * In the heap, the type may take up more space: eg. SIZEOF_INT8 == 1,
- * but it takes up SIZEOF_HSWORD (4 or 8) bytes in the heap.
- */
-
-/* First, check some assumptions.. */
-#if SIZEOF_CHAR != 1
-#error GHC untested on this architecture: sizeof(char) != 1
-#endif
-
-#if SIZEOF_SHORT != 2
-#error GHC untested on this architecture: sizeof(short) != 2
-#endif
-
-#if SIZEOF_UNSIGNED_INT != 4
-#error GHC untested on this architecture: sizeof(unsigned int) != 4
-#endif
-
-#define SIZEOF_HSCHAR           SIZEOF_WORD32
-#define ALIGNMENT_HSCHAR        ALIGNMENT_WORD32
-
-#define SIZEOF_HSINT            SIZEOF_VOID_P
-#define ALIGNMENT_HSINT         ALIGNMENT_VOID_P
-
-#define SIZEOF_HSWORD		SIZEOF_VOID_P
-#define ALIGNMENT_HSWORD	ALIGNMENT_VOID_P
-
-#define SIZEOF_HSDOUBLE		SIZEOF_DOUBLE
-#define ALIGNMENT_HSDOUBLE	ALIGNMENT_DOUBLE
-
-#define SIZEOF_HSFLOAT		SIZEOF_FLOAT
-#define ALIGNMENT_HSFLOAT	ALIGNMENT_FLOAT
-
-#define SIZEOF_HSPTR            SIZEOF_VOID_P
-#define ALIGNMENT_HSPTR         ALIGNMENT_VOID_P
-
-#define SIZEOF_HSFUNPTR         SIZEOF_VOID_P
-#define ALIGNMENT_HSFUNPTR      ALIGNMENT_VOID_P
-
-#define SIZEOF_HSFOREIGNPTR     SIZEOF_VOID_P
-#define ALIGNMENT_HSFOREIGNPTR  ALIGNMENT_VOID_P
-
-#define SIZEOF_HSSTABLEPTR      SIZEOF_VOID_P
-#define ALIGNMENT_HSSTABLEPTR   ALIGNMENT_VOID_P
-
-#define SIZEOF_INT8             SIZEOF_CHAR
-#define ALIGNMENT_INT8          ALIGNMENT_CHAR
-
-#define SIZEOF_WORD8            SIZEOF_UNSIGNED_CHAR
-#define ALIGNMENT_WORD8         ALIGNMENT_UNSIGNED_CHAR
-
-#define SIZEOF_INT16            SIZEOF_SHORT
-#define ALIGNMENT_INT16         ALIGNMENT_SHORT
-
-#define SIZEOF_WORD16           SIZEOF_UNSIGNED_SHORT
-#define ALIGNMENT_WORD16        ALIGNMENT_UNSIGNED_SHORT
-
-#define SIZEOF_INT32            SIZEOF_INT
-#define ALIGNMENT_INT32         ALIGNMENT_INT
-
-#define SIZEOF_WORD32           SIZEOF_UNSIGNED_INT
-#define ALIGNMENT_WORD32        ALIGNMENT_UNSIGNED_INT
-
-#if HAVE_LONG_LONG && SIZEOF_VOID_P < 8
-/* assume long long is 64 bits */
-#define SIZEOF_INT64            SIZEOF_LONG_LONG
-#define ALIGNMENT_INT64         ALIGNMENT_LONG_LONG
-#define SIZEOF_WORD64           SIZEOF_UNSIGNED_LONG_LONG
-#define ALIGNMENT_WORD64        ALIGNMENT_UNSIGNED_LONG_LONG
-#elif SIZEOF_LONG == 8
-#define SIZEOF_INT64            SIZEOF_LONG
-#define ALIGNMENT_INT64         ALIGNMENT_LONG
-#define SIZEOF_WORD64           SIZEOF_UNSIGNED_LONG
-#define ALIGNMENT_WORD64        ALIGNMENT_UNSIGNED_LONG
-#else
-#error GHC untested on this architecture: sizeof(void *) < 8 and no long longs.
-#endif
-
-#ifndef WORD_SIZE_IN_BITS
-#if SIZEOF_HSWORD == 4
-#define WORD_SIZE_IN_BITS       32
-#else 
-#define WORD_SIZE_IN_BITS       64
-#endif
-#endif
-
-#endif /* MACHDEPS_H */
diff --git a/ghc/includes/MachRegs.h b/ghc/includes/MachRegs.h
deleted file mode 100644
index 92944e1467..0000000000
--- a/ghc/includes/MachRegs.h
+++ /dev/null
@@ -1,732 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-1999
- *
- * Registers used in STG code.  Might or might not correspond to
- * actual machine registers.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef MACHREGS_H
-#define MACHREGS_H
-
-/* This file is #included into Haskell code in the compiler: #defines
- * only in here please.
- */
-
-/* 
- * Defining NO_REGS causes no global registers to be used.  NO_REGS is
- * typically defined by GHC, via a command-line option passed to gcc,
- * when the -funregisterised flag is given.
- *
- * NB. When NO_REGS is on, calling & return conventions may be
- * different.  For example, all function arguments will be passed on
- * the stack, and components of an unboxed tuple will be returned on
- * the stack rather than in registers.
- */
-#ifndef NO_REGS
-
-/* NOTE: when testing the platform in this file we must test either
- * *_HOST_ARCH and *_TARGET_ARCH, depending on whether COMPILING_GHC
- * is set.  This is because when we're compiling the RTS and HC code,
- * the platform we're running on is the HOST, but when compiling GHC
- * we want to know about the register mapping on the TARGET platform.
- */
-#ifdef COMPILING_GHC
-#define alpha_REGS    alpha_TARGET_ARCH
-#define hppa1_1_REGS  hppa1_1_TARGET_ARCH
-#define i386_REGS     i386_TARGET_ARCH
-#define x86_64_REGS   x86_64_TARGET_ARCH
-#define m68k_REGS     m68k_TARGET_ARCH
-#define mips_REGS     (mipsel_TARGET_ARCH || mipseb_TARGET_ARCH)
-#define powerpc_REGS  (powerpc_TARGET_ARCH || powerpc64_TARGET_ARCH || rs6000_TARGET_ARCH)
-#define ia64_REGS     ia64_TARGET_ARCH
-#define sparc_REGS    sparc_TARGET_ARCH
-#define darwin_REGS   darwin_TARGET_OS
-#else
-#define alpha_REGS    alpha_HOST_ARCH
-#define hppa1_1_REGS  hppa1_1_HOST_ARCH
-#define i386_REGS     i386_HOST_ARCH
-#define x86_64_REGS   x86_64_HOST_ARCH
-#define m68k_REGS     m68k_HOST_ARCH
-#define mips_REGS     (mipsel_HOST_ARCH || mipseb_HOST_ARCH)
-#define powerpc_REGS  (powerpc_HOST_ARCH || powerpc64_HOST_ARCH || rs6000_HOST_ARCH)
-#define ia64_REGS     ia64_HOST_ARCH
-#define sparc_REGS    sparc_HOST_ARCH
-#define darwin_REGS   darwin_HOST_OS
-#endif
-
-/* ----------------------------------------------------------------------------
-   Caller saves and callee-saves regs.
-   
-   Caller-saves regs have to be saved around C-calls made from STG
-   land, so this file defines CALLER_SAVES_<reg> for each <reg> that
-   is designated caller-saves in that machine's C calling convention.
-   -------------------------------------------------------------------------- */
-
-/* -----------------------------------------------------------------------------
-   The DEC Alpha register mapping
-
-   Alpha registers
-   \tr{$9}--\tr{$14} are our ``prize'' callee-save registers.  
-   \tr{$15} is the frame pointer, and \tr{$16}--\tr{$21} are argument
-   registers.  (These are off-limits.)  We can steal some of the \tr{$22}-and-up 
-   caller-save registers provided we do the appropriate save/restore stuff.
-   
-   \tr{$f2}--\tr{$f9} are some callee-save floating-point registers.
-   
-   We cannot use \tr{$23} (aka t9), \tr{$24} (aka t10), \tr{$25} (aka
-   t11), \tr{$27} (aka pv), or \tr{$28} (aka at), because they are
-   occasionally required by the assembler to handle non-primitive
-   instructions (e.g. ldb, remq).  Sigh!
-   
-   Cheat sheet for GDB:
-   
-   GDB	here	Main map
-   ===	====	========
-   s5	$14	R1
-   t1	$2	R2
-   t2	$3	R3
-   t3	$4	R4
-   t4	$5	R5
-   t5	$6	R6
-   t6	$7	R7
-   t7	$8	R8
-   s0	$9	Sp
-   s2	$11	SpLim
-   s3	$12	Hp   
-   s4	$13	HpLim
-   t8	$22	NCG_reserved
-   t12	$27	NCG_reserved
-   -------------------------------------------------------------------------- */
-
-#if alpha_REGS
-# define REG(x) __asm__("$" #x)
-
-#  define CALLER_SAVES_R2
-#  define CALLER_SAVES_R3
-#  define CALLER_SAVES_R4
-#  define CALLER_SAVES_R5
-#  define CALLER_SAVES_R6
-#  define CALLER_SAVES_R7
-#  define CALLER_SAVES_R8
-  
-#  define CALLER_SAVES_USER
-  
-#  define REG_R1	14
-#  define REG_R2    	2
-#  define REG_R3    	3
-#  define REG_R4    	4
-#  define REG_R5    	5
-#  define REG_R6    	6
-#  define REG_R7    	7
-#  define REG_R8    	8
-  
-#  define REG_F1	f2
-#  define REG_F2	f3
-#  define REG_F3	f4
-#  define REG_F4	f5
-  
-#  define REG_D1	f6
-#  define REG_D2	f7
-  
-#  define REG_Sp    	9
-#  define REG_SpLim     11
-
-#  define REG_Hp	12
-#  define REG_HpLim	13
-  
-#  define NCG_Reserved_I1 22
-#  define NCG_Reserved_I2 27
-#  define NCG_Reserved_F1 f29
-#  define NCG_Reserved_F2 f30
-
-#endif /* alpha_REGS */
-
-/* -----------------------------------------------------------------------------
-   The HP-PA register mapping
-
-   We cater for HP-PA 1.1.
-   
-   \tr{%r0}--\tr{%r1} are special.
-   \tr{%r2} is the return pointer.
-   \tr{%r3} is the frame pointer.
-   \tr{%r4}--\tr{%r18} are callee-save registers.
-   \tr{%r19} is a linkage table register for HPUX 8.0 shared libraries.
-   \tr{%r20}--\tr{%r22} are caller-save registers.
-   \tr{%r23}--\tr{%r26} are parameter registers.
-   \tr{%r27} is a global data pointer.
-   \tr{%r28}--\tr{%r29} are temporaries.
-   \tr{%r30} is the stack pointer.
-   \tr{%r31} is a temporary.
-   
-   \tr{%fr12}--\tr{%fr15} are some callee-save floating-point registers.
-   \tr{%fr8}--\tr{%fr11} are some available caller-save fl-pt registers.
-   -------------------------------------------------------------------------- */
-
-#if hppa1_1_REGS
-
-#define REG(x) __asm__("%" #x)
-
-#define REG_R1		r11
-#define REG_R2    	r12
-#define REG_R3    	r13
-#define REG_R4    	r14
-#define REG_R5    	r15
-#define REG_R6    	r16
-#define REG_R7    	r17
-#define REG_R8    	r18
-
-#define REG_F1		fr12
-#define REG_F2		fr12R
-#define REG_F3		fr13
-#define REG_F4		fr13R
-
-#define REG_D1		fr20	/* L & R */
-#define REG_D2		fr21	/* L & R */
-
-#define REG_Sp    	r4
-#define REG_SpLim    	r6
-
-#define REG_Hp	    	r7
-#define REG_HpLim	r8
-
-#define NCG_Reserved_I1 r28
-#define NCG_Reserved_I2	r29
-#define NCG_Reserved_F1	fr8
-#define NCG_Reserved_F2	fr8R
-#define NCG_Reserved_D1	fr10
-#define NCG_Reserved_D2	fr11
-
-#endif /* hppa */
-
-/* -----------------------------------------------------------------------------
-   The x86 register mapping
-
-   Ok, we've only got 6 general purpose registers, a frame pointer and a
-   stack pointer.  \tr{%eax} and \tr{%edx} are return values from C functions,
-   hence they get trashed across ccalls and are caller saves. \tr{%ebx},
-   \tr{%esi}, \tr{%edi}, \tr{%ebp} are all callee-saves.
-
-   Reg     STG-Reg
-   ---------------
-   ebx     Base
-   ebp     Sp
-   esi     R1
-   edi     Hp
-
-   Leaving SpLim, and HpLim out of the picture.
-   -------------------------------------------------------------------------- */
-
-
-#if i386_REGS
-
-#define REG(x) __asm__("%" #x)
-
-#ifndef not_doing_dynamic_linking
-#define REG_Base    ebx
-#endif
-#define REG_Sp	    ebp
-
-#ifndef STOLEN_X86_REGS
-#define STOLEN_X86_REGS 4
-#endif
-
-#if STOLEN_X86_REGS >= 3
-# define REG_R1	    esi
-#endif
-
-#if STOLEN_X86_REGS >= 4
-# define REG_Hp     edi
-#endif
-
-#define MAX_REAL_VANILLA_REG 1	/* always, since it defines the entry conv */
-#define MAX_REAL_FLOAT_REG   0
-#define MAX_REAL_DOUBLE_REG  0
-#define MAX_REAL_LONG_REG    0
-
-#endif /* iX86 */
-
-/* -----------------------------------------------------------------------------
-  The x86-64 register mapping
-
-  %rax		caller-saves, don't steal this one
-  %rbx		YES
-  %rcx          arg reg, caller-saves
-  %rdx		arg reg, caller-saves
-  %rsi		arg reg, caller-saves
-  %rdi		arg reg, caller-saves
-  %rbp		YES (our *prime* register)
-  %rsp		(unavailable - stack pointer)
-  %r8           arg reg, caller-saves
-  %r9		arg reg, caller-saves
-  %r10          caller-saves
-  %r11		caller-saves
-  %r12		YES
-  %r13		YES
-  %r14		YES
-  %r15		YES
-
-  %xmm0-7       arg regs, caller-saves
-  %xmm8-15      caller-saves
-
-  Use the caller-saves regs for Rn, because we don't always have to
-  save those (as opposed to Sp/Hp/SpLim etc. which always have to be
-  saved).
-
-  --------------------------------------------------------------------------- */
-
-#if x86_64_REGS
-
-#define REG(x) __asm__("%" #x)
-
-#define REG_Base  r13
-#define REG_Sp    rbp
-#define REG_Hp    r12
-#define REG_R1    rbx
-#define REG_R2    rsi
-#define REG_R3    rdi
-#define REG_R4    r8
-#define REG_R5    r9
-#define REG_SpLim r14
-#define REG_HpLim r15
-
-#define REG_F1    xmm1
-#define REG_F2    xmm2
-#define REG_F3    xmm3
-#define REG_F4    xmm4
-
-#define REG_D1    xmm5
-#define REG_D2    xmm6
-
-#define CALLER_SAVES_R2
-#define CALLER_SAVES_R3
-#define CALLER_SAVES_R4
-#define CALLER_SAVES_R5
-
-#define CALLER_SAVES_F1
-#define CALLER_SAVES_F2
-#define CALLER_SAVES_F3
-#define CALLER_SAVES_F4
-
-#define CALLER_SAVES_D1
-#define CALLER_SAVES_D2
-
-#define MAX_REAL_VANILLA_REG 5
-#define MAX_REAL_FLOAT_REG   4
-#define MAX_REAL_DOUBLE_REG  2
-#define MAX_REAL_LONG_REG    0
-
-#endif /* x86_64 */
-
-/* -----------------------------------------------------------------------------
-   The Motorola 680x0 register mapping
-
-   A Sun3 (mc680x0) has eight address registers, \tr{a0} to \tr{a7}, and
-   eight data registers, \tr{d0} to \tr{d7}.  Address operations have to
-   be done through address registers; data registers are used for
-   comparison values and data.
-   
-   Here's the register-usage picture for m68k boxes with GCC.
-
-   \begin{tabular}{ll}
-   a0 & used directly by GCC \\
-   a1 & used directly by GCC \\
-   \\
-   a2..a5 & callee-saved: available for STG registers \\
-   & (a5 may be special, ``global'' register for PIC?) \\
-   \\
-   a6 & C-stack frame pointer \\
-   a7 & C-stack pointer \\
-   \\
-   d0 & used directly by GCC \\
-   d1 & used directly by GCC \\
-   d2 & really needed for local optimisation by GCC \\
-   \\
-   d3..d7 & callee-saved: available for STG registers
-   \\
-   fp0 & call-clobbered \\
-   fp1 & call-clobbered \\
-   fp2..fp7 & callee-saved: available for STG registers
-   \end{tabular}
-   -------------------------------------------------------------------------- */
-
-#if m68k_REGS
-
-#define REG(x) __asm__(#x)
-
-#define REG_Base	a2
-
-#define REG_Sp		a3
-#define REG_SpLim	d3
-
-#define REG_Hp	    	d4
-#define REG_HpLim       d5
-
-#define REG_R1    	a5
-#define REG_R2    	d6
-#define MAX_REAL_VANILLA_REG 2
-
-#define REG_Ret		d7
-
-#define REG_F1		fp2
-#define REG_F2		fp3
-#define REG_F3		fp4
-#define REG_F4		fp5
-
-#define REG_D1		fp6
-#define REG_D2		fp7
-
-#endif /* m68k */
-
-/* -----------------------------------------------------------------------------
-   The DECstation (MIPS) register mapping
-
-   Here's at least some simple stuff about registers on a MIPS.
-   
-   \tr{s0}--\tr{s7} are callee-save integer registers; they are our
-   ``prize'' stolen registers.  There is also a wad of callee-save
-   floating-point registers, \tr{$f20}--\tr{$f31}; we'll use some of
-   those.
-   
-   \tr{t0}--\tr{t9} are caller-save (``temporary?'') integer registers.
-   We can steal some, but we might have to save/restore around ccalls.
-   -------------------------------------------------------------------------- */
-
-#if mips_REGS
-
-#define REG(x) __asm__("$" #x)
-
-#define CALLER_SAVES_R1
-#define CALLER_SAVES_R2
-#define CALLER_SAVES_R3
-#define CALLER_SAVES_R4
-#define CALLER_SAVES_R5
-#define CALLER_SAVES_R6
-#define CALLER_SAVES_R7
-#define CALLER_SAVES_R8
-
-#define CALLER_SAVES_USER
-
-#define REG_R1		9
-#define REG_R2    	10
-#define REG_R3    	11
-#define REG_R4    	12
-#define REG_R5    	13
-#define REG_R6    	14
-#define REG_R7    	15
-#define REG_R8    	24
-
-#define REG_F1		f20
-#define REG_F2		f22
-#define REG_F3		f24
-#define REG_F4		f26
-
-#define REG_D1		f28
-#define REG_D2		f30
-
-#define REG_Sp    	16
-#define REG_SpLim    	18
-
-#define REG_Hp	    	19
-#define REG_HpLim	20
-
-#endif /* mipse[lb] */
-
-/* -----------------------------------------------------------------------------
-   The PowerPC register mapping
-
-   0		system glue?	(caller-save, volatile)
-   1		SP		(callee-save, non-volatile)
-   2            AIX, powerpc64-linux:
-                    RTOC        (a strange special case)
-                darwin:         
-                                (caller-save, volatile)
-                powerpc32-linux:
-                                reserved for use by system
-                    
-   3-10		args/return	(caller-save, volatile)
-   11,12	system glue?	(caller-save, volatile)
-   13           on 64-bit:      reserved for thread state pointer
-                on 32-bit:      (callee-save, non-volatile)
-   14-31			(callee-save, non-volatile)
-   
-   f0				(caller-save, volatile)
-   f1-f13	args/return	(caller-save, volatile)
-   f14-f31			(callee-save, non-volatile)
-   
-   \tr{14}--\tr{31} are wonderful callee-save registers on all ppc OSes.
-   \tr{0}--\tr{12} are caller-save registers.
-   
-   \tr{%f14}--\tr{%f31} are callee-save floating-point registers.
-   
-   We can do the Whole Business with callee-save registers only!
-   -------------------------------------------------------------------------- */
-
-#if powerpc_REGS
-
-#define REG(x) __asm__(#x)
-
-#define REG_R1		r14
-#define REG_R2    	r15
-#define REG_R3    	r16
-#define REG_R4    	r17
-#define REG_R5    	r18
-#define REG_R6    	r19
-#define REG_R7    	r20
-#define REG_R8    	r21
-
-#if darwin_REGS
-
-#define REG_F1		f14
-#define REG_F2		f15
-#define REG_F3		f16
-#define REG_F4		f17
-
-#define REG_D1		f18
-#define REG_D2		f19
-
-#else
-
-#define REG_F1		fr14
-#define REG_F2		fr15
-#define REG_F3		fr16
-#define REG_F4		fr17
-
-#define REG_D1		fr18
-#define REG_D2		fr19
-
-#endif
-
-#define REG_Sp    	r22
-#define REG_SpLim    	r24
-
-#define REG_Hp	    	r25
-#define REG_HpLim	r26
-
-#define REG_Base        r27
-
-#endif /* powerpc */
-
-/* -----------------------------------------------------------------------------
-   The IA64 register mapping
-
-   We place the general registers in the locals area of the register stack,
-   so that the call mechanism takes care of saving them for us.  We reserve
-   the first 16 for gcc's use - since gcc uses the highest used register to
-   determine the register stack frame size, this gives us a constant size
-   register stack frame.
-   
-   \tr{f16-f32} are the callee-saved floating point registers.
-   -------------------------------------------------------------------------- */
-
-#if ia64_REGS
-
-#define REG(x) __asm__(#x)
-
-#define REG_R1		loc16
-#define REG_R2		loc17
-#define REG_R3		loc18
-#define REG_R4		loc19
-#define REG_R5		loc20
-#define REG_R6		loc21
-#define REG_R7		loc22
-#define REG_R8		loc23
-
-#define REG_F1		f16
-#define REG_F2		f17
-#define REG_F3		f18
-#define REG_F4		f19
-
-#define REG_D1		f20
-#define REG_D2		f21
-
-#define REG_Sp		loc24
-#define REG_SpLim	loc26
-
-#define REG_Hp		loc27
-#define REG_HpLim	loc28
-
-#endif /* ia64 */
-
-/* -----------------------------------------------------------------------------
-   The Sun SPARC register mapping
-
-   The SPARC register (window) story: Remember, within the Haskell
-   Threaded World, we essentially ``shut down'' the register-window
-   mechanism---the window doesn't move at all while in this World.  It
-   *does* move, of course, if we call out to arbitrary~C...
-   
-   The %i, %l, and %o registers (8 each) are the input, local, and
-   output registers visible in one register window.  The 8 %g (global)
-   registers are visible all the time.
-   
-   %o0..%o7 	       	not available; can be zapped by callee
-   			  (%o6 is C-stack ptr; %o7 hold ret addrs)
-   %i0..%i7            	available (except %i6 is used as frame ptr)
-   			  (and %i7 tends to have ret-addr-ish things)
-   %l0..%l7	       	available
-   %g0..%g4 		not available; prone to stomping by division, etc.
-   %g5..%g7 		not available; reserved for the OS
-
-   Note: %g3 is *definitely* clobbered in the builtin divide code (and
-   our save/restore machinery is NOT GOOD ENOUGH for that); discretion
-   being the better part of valor, we also don't take %g4.
-
-   The paired nature of the floating point registers causes complications for
-   the native code generator.  For convenience, we pretend that the first 22
-   fp regs %f0 .. %f21 are actually 11 double regs, and the remaining 10 are
-   float (single) regs.  The NCG acts accordingly.  That means that the 
-   following FP assignment is rather fragile, and should only be changed
-   with extreme care.  The current scheme is:
-
-      %f0 /%f1    FP return from C
-      %f2 /%f3    D1
-      %f4 /%f5    D2
-      %f6 /%f7    ncg double spill tmp #1
-      %f8 /%f9    ncg double spill tmp #2
-      %f10/%f11   allocatable
-      %f12/%f13   allocatable
-      %f14/%f15   allocatable
-      %f16/%f17   allocatable
-      %f18/%f19   allocatable
-      %f20/%f21   allocatable
-
-      %f22        F1
-      %f23        F2
-      %f24        F3
-      %f25        F4
-      %f26        ncg single spill tmp #1
-      %f27        ncg single spill tmp #2
-      %f28        allocatable
-      %f29        allocatable
-      %f30        allocatable
-      %f31        allocatable
-
-   -------------------------------------------------------------------------- */
-
-#if sparc_REGS
-
-#define REG(x) __asm__("%" #x)
-
-#define CALLER_SAVES_USER
-
-#define CALLER_SAVES_F1
-#define CALLER_SAVES_F2
-#define CALLER_SAVES_F3
-#define CALLER_SAVES_F4
-#define CALLER_SAVES_D1
-#define CALLER_SAVES_D2
-
-#define REG_R1	    	l1
-#define REG_R2    	l2
-#define REG_R3    	l3
-#define REG_R4    	l4
-#define REG_R5    	l5
-#define REG_R6    	i5
-
-#define REG_F1	    	f22
-#define REG_F2	    	f23
-#define REG_F3	    	f24
-#define REG_F4	    	f25
-#define REG_D1	    	f2
-#define REG_D2	    	f4
-
-#define REG_Sp    	i0
-#define REG_SpLim    	i2
-
-#define REG_Hp	    	i3
-#define REG_HpLim	i4
-
-#define NCG_SpillTmp_I1	g1
-#define NCG_SpillTmp_I2	g2
-#define NCG_SpillTmp_F1	f26
-#define NCG_SpillTmp_F2 f27
-#define NCG_SpillTmp_D1	f6
-#define NCG_SpillTmp_D2	f8
-
-#define NCG_FirstFloatReg f22
-
-#endif /* sparc */
-
-#endif /* NO_REGS */
-
-/* -----------------------------------------------------------------------------
- * These constants define how many stg registers will be used for
- * passing arguments (and results, in the case of an unboxed-tuple
- * return).
- *
- * We usually set MAX_REAL_VANILLA_REG and co. to be the number of the
- * highest STG register to occupy a real machine register, otherwise
- * the calling conventions will needlessly shuffle data between the
- * stack and memory-resident STG registers.  We might occasionally
- * set these macros to other values for testing, though.
- *
- * Registers above these values might still be used, for instance to
- * communicate with PrimOps and RTS functions.
- */
-
-#ifndef MAX_REAL_VANILLA_REG
-#  if   defined(REG_R8)
-#  define MAX_REAL_VANILLA_REG 8
-#  elif defined(REG_R7)
-#  define MAX_REAL_VANILLA_REG 7
-#  elif defined(REG_R6)
-#  define MAX_REAL_VANILLA_REG 6
-#  elif defined(REG_R5)
-#  define MAX_REAL_VANILLA_REG 5
-#  elif defined(REG_R4)
-#  define MAX_REAL_VANILLA_REG 4
-#  elif defined(REG_R3)
-#  define MAX_REAL_VANILLA_REG 3
-#  elif defined(REG_R2)
-#  define MAX_REAL_VANILLA_REG 2
-#  elif defined(REG_R1)
-#  define MAX_REAL_VANILLA_REG 1
-#  else
-#  define MAX_REAL_VANILLA_REG 0
-#  endif
-#endif
-
-#ifndef MAX_REAL_FLOAT_REG
-#  if   defined(REG_F4)
-#  define MAX_REAL_FLOAT_REG 4
-#  elif defined(REG_F3)
-#  define MAX_REAL_FLOAT_REG 3
-#  elif defined(REG_F2)
-#  define MAX_REAL_FLOAT_REG 2
-#  elif defined(REG_F1)
-#  define MAX_REAL_FLOAT_REG 1
-#  else
-#  define MAX_REAL_FLOAT_REG 0
-#  endif
-#endif
-
-#ifndef MAX_REAL_DOUBLE_REG
-#  if   defined(REG_D2)
-#  define MAX_REAL_DOUBLE_REG 2
-#  elif defined(REG_D1)
-#  define MAX_REAL_DOUBLE_REG 1
-#  else
-#  define MAX_REAL_DOUBLE_REG 0
-#  endif
-#endif
-
-#ifndef MAX_REAL_LONG_REG
-#  if   defined(REG_L1)
-#  define MAX_REAL_LONG_REG 1
-#  else
-#  define MAX_REAL_LONG_REG 0
-#  endif
-#endif
-
-/* define NO_ARG_REGS if we have no argument registers at all (we can
- * optimise certain code paths using this predicate).
- */
-#if MAX_REAL_VANILLA_REG < 2
-#define NO_ARG_REGS 
-#else
-#undef NO_ARG_REGS
-#endif
-
-#endif /* MACHREGS_H */
diff --git a/ghc/includes/Makefile b/ghc/includes/Makefile
deleted file mode 100644
index cb33ade014..0000000000
--- a/ghc/includes/Makefile
+++ /dev/null
@@ -1,181 +0,0 @@
-# -----------------------------------------------------------------------------
-
-TOP = ..
-include $(TOP)/mk/boilerplate.mk
-
-#
-# All header files
-#
-H_FILES = $(filter-out gmp.h,$(wildcard *.h)) gmp.h
-
-#
-# Options -- if we're building unregisterised, add a couple of -D's
-#
-ifeq "$(GhcUnregisterised)" "YES"
-SRC_CC_OPTS += -DNO_REGS -DUSE_MINIINTERPRETER
-endif
-
-SRC_CC_OPTS += -I. -I../rts
-
-#
-# Header file built from the configure script's findings
-#
-H_CONFIG   = ghcautoconf.h
-H_PLATFORM = ghcplatform.h
-
-boot :: gmp.h
-
-all :: $(H_CONFIG) $(H_PLATFORM)
-
-# gmp.h is copied from the GMP directory
-gmp.h : $(FPTOOLS_TOP)/ghc/rts/gmp/gmp.h
-	$(CP) $< $@
-
-# The fptools configure script creates the configuration header file and puts it
-# in fptools/mk/config.h. We copy it down to here (without any PACKAGE_FOO
-# definitions to avoid clashes), prepending some make variables specifying cpp
-# platform variables.
-
-ifneq "$(TARGETPLATFORM)"  "$(HOSTPLATFORM)"
-
-$(H_CONFIG) :
-	@echo "*** Cross-compiling: please copy $(H_CONFIG) from the target system"
-	@exit 1
-
-else
-
-$(H_CONFIG) : $(FPTOOLS_TOP)/mk/config.h $(FPTOOLS_TOP)/mk/config.mk
-
-$(H_CONFIG) : Makefile
-	@echo "#ifndef __GHCAUTOCONF_H__"  >$@
-	@echo "#define __GHCAUTOCONF_H__" >>$@
-#	Turn '#define PACKAGE_FOO "blah"' into '/* #undef PACKAGE_FOO */'.
-	@sed 's,^\([	 ]*\)#[	 ]*define[	 ][	 ]*\(PACKAGE_[A-Z]*\)[	 ][ 	]*".*".*$$,\1/* #undef \2 */,' $(FPTOOLS_TOP)/mk/config.h >> $@
-	@echo "#endif /* __GHCAUTOCONF_H__ */"          >> $@
-	@echo "Done."
-
-endif
-
-$(H_PLATFORM) : Makefile
-	@echo "Creating $@..."
-	@$(RM) $@
-	@echo "#ifndef __GHCPLATFORM_H__"  >$@
-	@echo "#define __GHCPLATFORM_H__" >>$@
-	@echo >> $@
-	@echo "#define BuildPlatform_TYPE  $(HostPlatform_CPP)" >> $@
-	@echo "#define HostPlatform_TYPE   $(TargetPlatform_CPP)" >> $@
-	@echo >> $@
-	@echo "#define $(HostPlatform_CPP)_BUILD  1" >> $@
-	@echo "#define $(TargetPlatform_CPP)_HOST  1" >> $@
-	@echo >> $@
-	@echo "#define $(HostArch_CPP)_BUILD_ARCH  1" >> $@
-	@echo "#define $(TargetArch_CPP)_HOST_ARCH  1" >> $@
-	@echo "#define BUILD_ARCH  \"$(HostArch_CPP)\"" >> $@
-	@echo "#define HOST_ARCH  \"$(TargetArch_CPP)\"" >> $@
-	@echo >> $@
-	@echo "#define $(HostOS_CPP)_BUILD_OS  1" >> $@
-	@echo "#define $(TargetOS_CPP)_HOST_OS  1" >> $@
-	@echo "#define BUILD_OS  \"$(HostOS_CPP)\"" >> $@
-	@echo "#define HOST_OS  \"$(TargetOS_CPP)\"" >> $@
-ifeq "$(HostOS_CPP)" "irix"
-	@echo "#ifndef $(IRIX_MAJOR)_HOST_OS" >> $@  
-	@echo "#define $(IRIX_MAJOR)_HOST_OS  1" >> $@  
-	@echo "#endif" >> $@  
-endif
-	@echo >> $@
-	@echo "#define $(HostVendor_CPP)_BUILD_VENDOR  1" >> $@
-	@echo "#define $(TargetVendor_CPP)_HOST_VENDOR  1" >> $@
-	@echo "#define BUILD_VENDOR  \"$(HostVendor_CPP)\"" >> $@
-	@echo "#define HOST_VENDOR  \"$(TargetVendor_CPP)\"" >> $@
-	@echo >> $@
-	@echo "/* These TARGET macros are for backwards compatibily... DO NOT USE! */" >> $@
-	@echo "#define TargetPlatform_TYPE $(TargetPlatform_CPP)" >> $@
-	@echo "#define $(TargetPlatform_CPP)_TARGET  1" >> $@
-	@echo "#define $(TargetArch_CPP)_TARGET_ARCH  1" >> $@
-	@echo "#define TARGET_ARCH  \"$(TargetArch_CPP)\"" >> $@
-	@echo "#define $(TargetOS_CPP)_TARGET_OS  1" >> $@  
-	@echo "#define TARGET_OS  \"$(TargetOS_CPP)\"" >> $@
-	@echo "#define $(TargetVendor_CPP)_TARGET_VENDOR  1" >> $@
-	@echo >> $@
-	@echo "#endif /* __GHCPLATFORM_H__ */"          >> $@
-	@echo "Done."
-
-# ---------------------------------------------------------------------------
-# Make DerivedConstants.h for the compiler
-
-all :: DerivedConstants.h
-
-ifneq "$(TARGETPLATFORM)" "$(HOSTPLATFORM)"
-
-DerivedConstants.h :
-	@echo "*** Cross-compiling: please copy DerivedConstants.h from the target system"
-	@exit 1
-
-else
-
-mkDerivedConstants.c : $(H_CONFIG) $(H_PLATFORM)
-
-mkDerivedConstantsHdr : mkDerivedConstants.o
-	$(CC) -o $@ $(CC_OPTS) $(LD_OPTS) mkDerivedConstants.o
-
-DerivedConstants.h : mkDerivedConstantsHdr
-	./mkDerivedConstantsHdr >$@
-
-endif
-
-CLEAN_FILES += mkDerivedConstantsHdr$(exeext) DerivedConstants.h
-
-# -----------------------------------------------------------------------------
-#
-
-all :: GHCConstants.h
-
-ifneq "$(TARGETPLATFORM)" "$(HOSTPLATFORM)"
-
-GHCConstants.h :
-	@echo "*** Cross-compiling: please copy DerivedConstants.h from the target system"
-	@exit 1
-
-else
-
-mkGHCConstants : mkGHCConstants.o
-	$(CC) -o $@ $(CC_OPTS) $(LD_OPTS) mkGHCConstants.o
-
-mkGHCConstants.o : mkDerivedConstants.c
-	$(CC) -o $@ $(CC_OPTS) -c $<  -DGEN_HASKELL
-
-GHCConstants.h : mkGHCConstants
-	./mkGHCConstants >$@
-
-endif
-
-CLEAN_FILES += mkGHCConstants$(exeext) GHCConstants.h
-
-# ---------------------------------------------------------------------------
-# boot setup:
-#
-# Need config.h to make dependencies in the runtime system source.
-#
-boot :: all
-
-#
-# Install all header files
-#
-# Hackily set the install destination here:
-#
-# Note: we keep per-platform copies of all the include files
-# (ditto for interface files). This is not *really* needed, but
-# it gives (perhaps) a cleaner binary dist structure..might change.
-#
-override datadir:=$(libdir)/include
-INSTALL_DATAS += $(H_FILES) $(H_CONFIG) $(H_PLATFORM)
-
-#
-# `make clean' settings:
-#
-CLEAN_FILES += $(H_CONFIG) $(H_PLATFORM)
-
-#
-# Finally, slurp in the standard targets.
-#
-include $(TOP)/mk/target.mk
diff --git a/ghc/includes/OSThreads.h b/ghc/includes/OSThreads.h
deleted file mode 100644
index 90431445b7..0000000000
--- a/ghc/includes/OSThreads.h
+++ /dev/null
@@ -1,180 +0,0 @@
-/* ---------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2001-2005
- *
- * Accessing OS threads functionality in a (mostly) OS-independent
- * manner. 
- * 
- * --------------------------------------------------------------------------*/
-
-#ifndef __OSTHREADS_H__
-#define __OSTHREADS_H__
-
-#if defined(THREADED_RTS) /* to the end */
-
-# if defined(HAVE_PTHREAD_H) && !defined(WANT_NATIVE_WIN32_THREADS)
-
-#include <pthread.h>
-
-typedef pthread_cond_t  Condition;
-typedef pthread_mutex_t Mutex;
-typedef pthread_t       OSThreadId;
-typedef pthread_key_t   ThreadLocalKey;
-
-#define OSThreadProcAttr /* nothing */
-
-#define INIT_COND_VAR       PTHREAD_COND_INITIALIZER
-
-#ifdef LOCK_DEBUG
-
-#define ACQUIRE_LOCK(mutex) \
-  debugBelch("ACQUIRE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \
-  pthread_mutex_lock(mutex)
-#define RELEASE_LOCK(mutex) \
-  debugBelch("RELEASE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \
-  pthread_mutex_unlock(mutex)
-#define ASSERT_LOCK_HELD(mutex) /* nothing */
-
-#elif defined(DEBUG) && defined(linux_HOST_OS)
-#include <errno.h>
-/* 
- * On Linux, we can use extensions to determine whether we already
- * hold a lock or not, which is useful for debugging.
- */
-#define ACQUIRE_LOCK(mutex) \
-  if (pthread_mutex_lock(mutex) == EDEADLK) { \
-    barf("multiple ACQUIRE_LOCK: %s %d", __FILE__,__LINE__); \
-  }
-#define RELEASE_LOCK(mutex) \
-  if (pthread_mutex_unlock(mutex) != 0) { \
-    barf("RELEASE_LOCK: I do not own this lock: %s %d", __FILE__,__LINE__); \
-  }
-
-#define ASSERT_LOCK_HELD(mutex) ASSERT(pthread_mutex_lock(mutex) == EDEADLK)
-
-#define ASSERT_LOCK_NOTHELD(mutex)		\
-  if (pthread_mutex_lock(mutex) != EDEADLK) {	\
-     pthread_mutex_unlock(mutex);		\
-  } else {					\
-    ASSERT(0);					\
-  }
-
-
-#else
-
-#define ACQUIRE_LOCK(mutex) pthread_mutex_lock(mutex)
-#define RELEASE_LOCK(mutex) pthread_mutex_unlock(mutex)
-#define ASSERT_LOCK_HELD(mutex) /* nothing */
-
-#endif
-
-# elif defined(HAVE_WINDOWS_H)
-#include <windows.h>
-
-typedef HANDLE Condition;
-typedef DWORD OSThreadId;
-typedef DWORD ThreadLocalKey;
-
-#define OSThreadProcAttr __stdcall
-
-#define INIT_COND_VAR  0
-
-// We have a choice for implementing Mutexes on Windows.  Standard
-// Mutexes are kernel objects that require kernel calls to
-// acquire/release, whereas CriticalSections are spin-locks that block
-// in the kernel after spinning for a configurable number of times.
-// CriticalSections are *much* faster, so we use those.  The Mutex
-// implementation is left here for posterity.
-#define USE_CRITICAL_SECTIONS 1
-
-#if USE_CRITICAL_SECTIONS
-
-typedef CRITICAL_SECTION Mutex;
-
-#ifdef LOCK_DEBUG
-
-#define ACQUIRE_LOCK(mutex) \
-  debugBelch("ACQUIRE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \
-  EnterCriticalSection(mutex)
-#define RELEASE_LOCK(mutex) \
-  debugBelch("RELEASE_LOCK(0x%p) %s %d\n", mutex,__FILE__,__LINE__); \
-  LeaveCriticalSection(mutex)
-#define ASSERT_LOCK_HELD(mutex) /* nothing */
-
-#else
-
-#define ACQUIRE_LOCK(mutex)  EnterCriticalSection(mutex)
-#define RELEASE_LOCK(mutex)  LeaveCriticalSection(mutex)
-
-// I don't know how to do this.  TryEnterCriticalSection() doesn't do
-// the right thing.
-#define ASSERT_LOCK_HELD(mutex) /* nothing */
-
-#endif
-
-#else
-
-typedef HANDLE Mutex;
-
-// casting to (Mutex *) here required due to use in .cmm files where
-// the argument has (void *) type.
-#define ACQUIRE_LOCK(mutex)					\
-    if (WaitForSingleObject(*((Mutex *)mutex),INFINITE) == WAIT_FAILED) { \
-	barf("WaitForSingleObject: %d", GetLastError());	\
-    }
-
-#define RELEASE_LOCK(mutex)				\
-    if (ReleaseMutex(*((Mutex *)mutex)) == 0) {		\
-	barf("ReleaseMutex: %d", GetLastError());	\
-    }
-
-#define ASSERT_LOCK_HELD(mutex) /* nothing */
-#endif
-
-# else
-#  error "Threads not supported"
-# endif
-
-//
-// General thread operations
-//
-extern OSThreadId osThreadId      ( void );
-extern void shutdownThread        ( void );
-extern void yieldThread           ( void );
-
-typedef void OSThreadProcAttr OSThreadProc(void *);
-
-extern int  createOSThread        ( OSThreadId* tid, 
-				    OSThreadProc *startProc, void *param);
-
-//
-// Condition Variables
-//
-extern void initCondition         ( Condition* pCond );
-extern void closeCondition        ( Condition* pCond );
-extern rtsBool broadcastCondition ( Condition* pCond );
-extern rtsBool signalCondition    ( Condition* pCond );
-extern rtsBool waitCondition      ( Condition* pCond, 
-				    Mutex* pMut );
-
-//
-// Mutexes
-//
-extern void initMutex             ( Mutex* pMut );
-
-//
-// Thread-local storage
-//
-void  newThreadLocalKey (ThreadLocalKey *key);
-void *getThreadLocalVar (ThreadLocalKey *key);
-void  setThreadLocalVar (ThreadLocalKey *key, void *value);
-
-#else
-
-#define ACQUIRE_LOCK(l)
-#define RELEASE_LOCK(l)
-#define ASSERT_LOCK_HELD(l)
-
-#endif /* defined(THREADED_RTS) */
-
-#endif /* __OSTHREADS_H__ */
diff --git a/ghc/includes/Parallel.h b/ghc/includes/Parallel.h
deleted file mode 100644
index e18fbe9b2c..0000000000
--- a/ghc/includes/Parallel.h
+++ /dev/null
@@ -1,360 +0,0 @@
-/*
-  Definitions for GUM i.e. running on a parallel machine.
-
-  This section contains definitions applicable only to programs compiled
-  to run on a parallel machine, i.e. on GUM. Some of these definitions
-  are also used when simulating parallel execution, i.e. on GranSim.
-*/
-
-#ifndef PARALLEL_H
-#define PARALLEL_H
-
-#if defined(PAR) || defined(GRAN)        /* whole file */
-
-/*
- * @node Parallel definitions, End of File
- * @section Parallel definitions
- *
- * @menu
- * * Basic definitions::		
- * * GUM::			
- * * GranSim::			
- * @end menu
- *
- * @node Basic definitions, GUM, Parallel definitions, Parallel definitions
- * @subsection Basic definitions
- */
-
-/* This clashes with TICKY, but currently TICKY and PAR hate each other anyway */
-#define _HS  sizeofW(StgHeader)
-
-/* SET_PAR_HDR and SET_STATIC_PAR_HDR now live in ClosureMacros.h */
-
-/* Needed for dumping routines */
-#if defined(PAR)
-# define NODE_STR_LEN              20
-# define TIME_STR_LEN              120
-# define TIME                      rtsTime
-# define CURRENT_TIME              (msTime() - startTime)
-# define TIME_ON_PROC(p)           (msTime() - startTime)
-# define CURRENT_PROC              thisPE
-# define BINARY_STATS              RtsFlags.ParFlags.ParStats.Binary
-#elif defined(GRAN)
-# define NODE_STR_LEN              20
-# define TIME_STR_LEN              120
-# define TIME                      rtsTime
-# define CURRENT_TIME              CurrentTime[CurrentProc]
-# define TIME_ON_PROC(p)           CurrentTime[p]
-# define CURRENT_PROC              CurrentProc
-# define BINARY_STATS              RtsFlags.GranFlags.GranSimStats.Binary
-#endif
-
-#if defined(PAR)
-#  define MAX_PES	256		/* Maximum number of processors */
-	/* MAX_PES is enforced by SysMan, which does not
-	   allow more than this many "processors".
-	   This is important because PackGA [GlobAddr.lc]
-	   **assumes** that a PE# can fit in 8+ bits.
-	*/
-
-# define SPARK_POOLS 	2   /* no. of spark pools */
-# define REQUIRED_POOL 	0   /* idx of pool of mandatory sparks (concurrency) */
-# define ADVISORY_POOL 	1   /* idx of pool of advisory sparks (parallelism) */
-#endif
-
-/*
- * @menu
- * * GUM::			
- * * GranSim::			
- * @end menu
- *
- * @node GUM, GranSim, Basic definitions, Parallel definitions
- * @subsection GUM
- */
-
-#if defined(PAR) 
-/*
-  Symbolic constants for the packing code.
-  
-  This constant defines how many words of data we can pack into a single
-  packet in the parallel (GUM) system.
-*/
-
-/*
- * @menu
- * * Types::			
- * * Externs::			
- * * Prototypes::		
- * * Macros::			
- * @end menu
- *
- * @node Types, Externs, GUM, GUM
- * @subsubsection Types
- */
-
-/* Sparks and spark queues */
-typedef StgClosure  *rtsSpark;
-typedef rtsSpark    *rtsSparkQ;
-
-typedef struct rtsPackBuffer_ {
-  StgInt /* nat */           id; 
-  StgInt /* nat */           size;
-  StgInt /* nat */           unpacked_size;
-  StgTSO       *tso;
-  StgWord     *buffer[0];  
-} rtsPackBuffer;
-
-#define PACK_BUFFER_HDR_SIZE 4
-
-/*
- * @node Externs, Prototypes, Types, GUM
- * @subsubsection Externs
- */
-
-/* extern rtsBool do_sp_profile; */
-
-extern globalAddr theGlobalFromGA, theGlobalToGA;
-extern StgBlockedFetch *PendingFetches;
-extern GlobalTaskId    *allPEs;
-
-extern rtsBool      IAmMainThread, GlobalStopPending;
-/*extern rtsBool      fishing; */
-extern rtsTime      last_fish_arrived_at;
-extern nat          outstandingFishes;
-extern GlobalTaskId SysManTask;
-extern int          seed;     /* pseudo-random-number generator seed: */
-                              /* Initialised in ParInit */
-extern StgInt       threadId; /* Number of Threads that have existed on a PE */
-extern GlobalTaskId mytid;
-
-extern GlobalTaskId *allPEs;
-extern nat nPEs;
-extern nat sparksIgnored, sparksCreated, threadsIgnored, threadsCreated;
-extern nat advisory_thread_count;
-
-extern rtsBool InGlobalGC;  /* Are we in the midst of performing global GC */
-
-extern ullong startTime;    /* start of comp; in RtsStartup.c */
-
-/* the spark pools proper */
-extern rtsSpark *pending_sparks_hd[];  /* ptr to start of a spark pool */ 
-extern rtsSpark *pending_sparks_tl[];  /* ptr to end of a spark pool */ 
-extern rtsSpark *pending_sparks_lim[]; 
-extern rtsSpark *pending_sparks_base[]; 
-extern nat spark_limit[];
-
-extern rtsPackBuffer *PackBuffer;      /* size: can be set via option */
-extern rtsPackBuffer *buffer;
-extern rtsPackBuffer *freeBuffer;
-extern rtsPackBuffer *packBuffer;
-extern rtsPackBuffer *gumPackBuffer;
-
-extern nat thisPE;
-
-/* From Global.c 
-extern GALA *freeGALAList;
-extern GALA *freeIndirections;
-extern GALA *liveIndirections;
-extern GALA *liveRemoteGAs;
-*/
-
-/*
- * @node Prototypes, Macros, Externs, GUM
- * @subsubsection Prototypes
- */
-
-/* From ParInit.c */
-void          initParallelSystem(void);
-void          SynchroniseSystem(void);
-void          par_exit(StgInt n);
-
-PEs           taskIDtoPE (GlobalTaskId gtid);
-void          registerTask (GlobalTaskId gtid);
-globalAddr   *LAGAlookup (StgClosure *addr);
-StgClosure   *GALAlookup (globalAddr *ga);
-/*static GALA  *allocIndirection (StgPtr addr); */
-globalAddr   *makeGlobal (StgClosure *addr, rtsBool preferred);
-globalAddr   *setRemoteGA (StgClosure *addr, globalAddr *ga, rtsBool preferred);
-void          splitWeight (globalAddr *to, globalAddr *from);
-globalAddr   *addWeight (globalAddr *ga);
-void          initGAtables (void);
-void          RebuildLAGAtable (void);
-StgWord       PackGA (StgWord pe, int slot);
-
-# if defined(DEBUG)
-/* from Global.c */
-/* highest_slot breaks the abstraction of the slot counter for GAs; it is
-   only used for sanity checking and should used nowhere else */
-StgInt highest_slot (void); 
-# endif
-
-/*
- * @node Macros,  , Prototypes, GUM
- * @subsubsection Macros
- */
-
-/* delay (in us) between dying fish returning and sending out a new fish */
-#define FISH_DELAY                   1000
-/* max no. of outstanding spark steals */
-#define MAX_FISHES                   1  
-
-/* ToDo: check which of these is actually needed! */
-
-#    define PACK_HEAP_REQUIRED  ((RtsFlags.ParFlags.packBufferSize - PACK_HDR_SIZE) / (PACK_GA_SIZE + _HS) * (MIN_UPD_SIZE + 2))
-
-#  define MAX_GAS 	(RtsFlags.ParFlags.packBufferSize / PACK_GA_SIZE)
-
-
-#  define PACK_GA_SIZE	3	/* Size of a packed GA in words */
-			        /* Size of a packed fetch-me in words */
-#  define PACK_FETCHME_SIZE (PACK_GA_SIZE + _HS)
-
-#  define PACK_HDR_SIZE	1	/* Words of header in a packet */
-
-#  define PACK_PLC_SIZE	2	/* Size of a packed PLC in words */
-
-/*
-  Definitions relating to the entire parallel-only fixed-header field.
-
-  On GUM, the global addresses for each local closure are stored in a
-  separate hash table, rather then with the closure in the heap.  We call
-  @getGA@ to look up the global address associated with a local closure (0
-  is returned for local closures that have no global address), and @setGA@
-  to store a new global address for a local closure which did not
-  previously have one.  */
-
-#  define GA_HDR_SIZE			0
-  
-#  define GA(closure)		        getGA(closure)
-  
-#  define SET_GA(closure, ga)             setGA(closure,ga)
-#  define SET_STATIC_GA(closure)
-#  define SET_GRAN_HDR(closure,pe)
-#  define SET_STATIC_PROCS(closure)
-  
-#  define MAX_GA_WEIGHT			0	/* Treat as 2^n */
-  
-/* At the moment, there is no activity profiling for GUM.  This may change. */
-#  define SET_TASK_ACTIVITY(act)        /* nothing */
-
-/* 
-   The following macros are only needed for sanity checking (see Sanity.c).
-*/
-
-/* NB: this is PVM specific and should be updated for MPI etc
-       in PVM a task id (tid) is split into 2 parts: the id for the 
-       physical processor it is running on and an index of tasks running
-       on a processor; PVM_PE_MASK indicates which part of a tid holds the 
-       id of the physical processor (the other part of the word holds the 
-       index on that processor)
-       MAX_PVM_PES and MAX_PVM_TIDS are maximal values for these 2 components
-       in GUM we have an upper bound for the total number of PVM PEs allowed:
-       it's MAX_PE defined in Parallel.h
-       to check the slot field of a GA we call a fct highest_slot which just
-       returns the internal counter 
-*/
-#define PVM_PE_MASK    0xfffc0000
-#define MAX_PVM_PES    MAX_PES
-#define MAX_PVM_TIDS   MAX_PES
-
-#if 0
-#define LOOKS_LIKE_TID(tid)  (((tid & PVM_PE_MASK) != 0) && \
-                              (((tid & PVM_PE_MASK) + (tid & ~PVM_PE_MASK)) < MAX_PVM_TIDS))
-#define LOOKS_LIKE_SLOT(slot) (slot<=highest_slot())
-
-#define LOOKS_LIKE_GA(ga)    (LOOKS_LIKE_TID((ga)->payload.gc.gtid) && \
-                             LOOKS_LIKE_SLOT((ga)->payload.gc.slot))
-#else
-rtsBool looks_like_tid(StgInt tid);
-rtsBool looks_like_slot(StgInt slot);
-rtsBool looks_like_ga(globalAddr *ga);
-#define LOOKS_LIKE_TID(tid)  looks_like_tid(tid)
-#define LOOKS_LIKE_GA(ga)    looks_like_ga(ga)
-#endif /* 0 */
-
-#endif /* PAR */
-
-/*
- * @node GranSim,  , GUM, Parallel definitions
- * @subsection GranSim
- */
-
-#if defined(GRAN)
-/* ToDo: Check which of the PAR routines are needed in GranSim -- HWL */
-
-/*
- * @menu
- * * Types::			
- * * Prototypes::		
- * * Macros::			
- * @end menu
- *
- * @node Types, Prototypes, GranSim, GranSim
- * @subsubsection Types
- */
-
-typedef StgWord *StgBuffer;
-typedef struct rtsPackBuffer_ {
-  StgInt /* nat */           id;
-  StgInt /* nat */           size;
-  StgInt /* nat */           unpacked_size;
-  StgTSO       *tso;
-  StgWord      *buffer;  
-} rtsPackBuffer;
-
-/*
- * @node Macros,  , Prototypes, GranSim
- * @subsubsection Macros
- */
-
-/* max no. of outstanding spark steals */
-#define MAX_FISHES                   1  
-
-/* These are needed in the packing code to get the size of the packet
-   right. The closures itself are never built in GrAnSim. */
-#  define FETCHME_VHS				IND_VHS
-#  define FETCHME_HS				IND_HS
-  
-#  define FETCHME_GA_LOCN                       FETCHME_HS
-  
-#  define FETCHME_CLOSURE_SIZE(closure)		IND_CLOSURE_SIZE(closure)
-#  define FETCHME_CLOSURE_NoPTRS(closure)		0L
-#  define FETCHME_CLOSURE_NoNONPTRS(closure)	(IND_CLOSURE_SIZE(closure)-IND_VHS)
-  
-#  define MAX_GAS 	(RtsFlags.GranFlags.packBufferSize / PACK_GA_SIZE)
-#  define PACK_GA_SIZE	3	/* Size of a packed GA in words */
-			        /* Size of a packed fetch-me in words */
-#  define PACK_FETCHME_SIZE (PACK_GA_SIZE + _HS)
-#  define PACK_HDR_SIZE	4	/* Words of header in a packet */
-
-#    define PACK_HEAP_REQUIRED  \
-      (RtsFlags.GranFlags.packBufferSize * sizeofW(StgClosure*) + \
-      2 * sizeofW(StgInt) + sizeofW(StgTSO*))
-
-#    define PACK_FLAG_LOCN           0  
-#    define PACK_TSO_LOCN            1
-#    define PACK_UNPACKED_SIZE_LOCN  2
-#    define PACK_SIZE_LOCN           3
-#    define MAGIC_PACK_FLAG          0xfabc
-
-#  define GA_HDR_SIZE			1
-
-#  define PROCS_HDR_POSN		PAR_HDR_POSN
-#  define PROCS_HDR_SIZE		1
-
-/* Accessing components of the field */
-#  define PROCS(closure)	        ((closure)->header.gran.procs)
-/* SET_PROCS is now SET_GRAN_HEADER in ClosureMacros.h. */
-
-#endif   /* GRAN */
-
-/*
- * @node End of File,  , Parallel definitions
- * @section End of File
- */
-
-#endif /* defined(PAR) || defined(GRAN)         whole file */
-
-#endif /* Parallel_H */
-
-
diff --git a/ghc/includes/README b/ghc/includes/README
deleted file mode 100644
index aae99bf20b..0000000000
--- a/ghc/includes/README
+++ /dev/null
@@ -1,114 +0,0 @@
------------------------------------------------------------------------------
-The External API to the GHC Runtime System.
------------------------------------------------------------------------------
-
-The header files in this directory form the external API for the
-runtime.  The header files are used in the following scenarios:
-
-  1. Included into the RTS source code itself.
-	In this case we include "Rts.h", which includes everything
-	else in the appropriate order.
-
-	Pretty much everything falls into this category.
-
-  2. Included into a .hc file generated by the compiler.
-	In this case we include Stg.h, which includes a
-	subset of the headers, in the appropriate order and
-	with the appropriate settings (e.g. global register variables
-	turned on).
-
-	Includes everything below Stg.h in the hierarchy (see below).
-
-  3. Included into external C source code.
-	The following headers are designed to be included into
-        external C  code (i.e. C code compiled using a GHC installation,
-        not part of GHC itself or the RTS):
-
-		HsFFI.h
-		RtsAPI.h
-		SchedAPI.h
-		RtsFlags.h
-		Linker.h
-
-	These interfaces are intended to be relatively stable.
-
-	Also Rts.h can be included to get hold of everything else, including
-	definitions of heap objects, info tables, the storage manager interface
-	and so on.  But be warned: none of this is guaranteed to remain stable
-	from one GHC release to the next.
-
-  4. Included into non-C source code, including Haskell (GHC itself)
-     and C-- code in the RTS.
-
-	The following headers are #included into non-C source, so
-	cannot contain any C code or declarations:
-		config.h
-		RtsConfig.h
-		Constants.h
-		DerivedConstants.h
-		ClosureTypes.h
-		StgFun.h
-		MachRegs.h
-		Liveness.h
-		StgLdvProf.h
-
-Here is a rough hierarchy of the header files by dependency.
-
-Rts.h
-  Stg.h
-    ghcconfig.h		/* configuration info derived by the configure script. */
-    RtsConfig.h		/* settings for Rts things (eg. eager vs. lazy BH) */
-    MachDeps.h		/* sizes of various basic types */
-    StgTypes.h		/* basic types specific to the virtual machine */
-    TailCalls.h		/* tail calls in .hc code */
-    StgDLL.h		/* stuff related to Windows DLLs */
-    MachRegs.h		/* global register assignments for this arch */
-    Regs.h		/* "registers" in the virtual machine */
-    StgProf.h		/* profiling gubbins */
-    StgMiscClosures.h	/* decls for closures & info tables in the RTS */
-    RtsExternal.h	/* decls for RTS things required by .hc code */
-      (RtsAPI.h)
-      (HsFFI.h)
-
-  RtsTypes.h		/* types used in the RTS */
-
-  Constants.h		/* build-time constants */
-  StgLdvProf.h
-  StgFun.h
-  Closures.h
-  Liveness.h		/* macros for constructing RET_DYN liveness masks */
-  ClosureMacros.h
-  ClosureTypes.h
-  InfoTables.h
-  TSO.h
-  Updates.h		/* macros for performing updates */
-  GranSim.h
-  Parallel.h
-  SMP.h
-  Block.h
-  StgTicky.h
-  Stable.h
-  Hooks.h
-  Signals.h
-  DNInvoke.h
-    Dotnet.h
-
-Cmm.h			/* included into .cmm source only */
-  DerivedConstants.h	/* generated by mkDerivedConstants.c from other */
-			/* .h files. */
-  (Constants.h)
-  (ClosureTypes.h)
-  (StgFun.h)
-  (MachRegs.h)
-  (Liveness.h)  
-  (Block.h)
-
-Bytecodes.h	/* Bytecode definitions for the interpreter */
-Linker.h	/* External API to the linker */
-RtsFlags.h	/* External API to the RTS runtime flags */
-SchedAPI.h	/* External API to the RTS scheduler */
-ieee-flpt.h	/* ToDo: needed? */
-
-RtsAPI.h	/* The top-level interface to the RTS (rts_evalIO(), etc.) */
-HsFFI.h		/* The external FFI api */
-  
diff --git a/ghc/includes/Regs.h b/ghc/includes/Regs.h
deleted file mode 100644
index b6e29217eb..0000000000
--- a/ghc/includes/Regs.h
+++ /dev/null
@@ -1,787 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Registers in the STG machine.
- *
- * The STG machine has a collection of "registers", each one of which
- * may or may not correspond to an actual machine register when
- * running code.  
- *
- * The register set is backed by a table in memory (struct
- * StgRegTable).  If a particular STG register is not mapped to a
- * machine register, then the apprpriate slot in this table is used
- * instead.  
- *
- * This table is itself pointed to by another register, BaseReg.  If
- * BaseReg is not in a machine register, then the register table is
- * used from an absolute location (MainCapability).
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef REGS_H
-#define REGS_H
-
-#include "gmp.h" // Needs MP_INT definition 
-
-/*
- * Spark pools: used to store pending sparks 
- *  (THREADED_RTS & PARALLEL_HASKELL only)
- * This is a circular buffer.  Invariants:
- *    - base <= hd < lim
- *    - base <= tl < lim
- *    - if hd==tl, then the pool is empty.
- *    - if hd == tl+1, then the pool is full.
- * Adding to the pool is done by assigning to *tl++ (wrapping round as
- * necessary).  When adding to a full pool, we have the option of
- * throwing away either the oldest (hd++) or the most recent (tl--) entry.
- */
-typedef struct StgSparkPool_ {
-  StgClosure **base;
-  StgClosure **lim;
-  StgClosure **hd;
-  StgClosure **tl;
-} StgSparkPool;
-
-#define ASSERT_SPARK_POOL_INVARIANTS(p)		\
-  ASSERT((p)->base <= (p)->hd);			\
-  ASSERT((p)->hd < (p)->lim);			\
-  ASSERT((p)->base <= (p)->tl);			\
-  ASSERT((p)->tl < (p)->lim);
-
-typedef struct {
-  StgFunPtr      stgGCEnter1;
-  StgFunPtr      stgGCFun;
-} StgFunTable;
-
-/*
- * Vanilla registers are given this union type, which is purely so
- * that we can cast the vanilla reg to a variety of types with the
- * minimum of syntax.  eg.  R1.w instead of (StgWord)R1.
- */
-typedef union {
-    StgWord        w;
-    StgAddr        a;
-    StgChar        c;
-    StgInt8        i8;
-    StgFloat       f;
-    StgInt         i;
-    StgPtr         p;
-    StgClosurePtr  cl;
-    StgStackOffset offset;	/* unused? */
-    StgByteArray   b;
-    StgTSOPtr      t;
-} StgUnion;
-
-/* 
- * This is the table that holds shadow-locations for all the STG
- * registers.  The shadow locations are used when:
- *
- *     1) the particular register isn't mapped to a real machine
- *        register, probably because there's a shortage of real registers.
- *     2) caller-saves registers are saved across a CCall
- */
-typedef struct StgRegTable_ {
-  StgUnion 	  rR1;
-  StgUnion   	  rR2;
-  StgUnion   	  rR3;
-  StgUnion   	  rR4;
-  StgUnion   	  rR5;
-  StgUnion   	  rR6;
-  StgUnion   	  rR7;
-  StgUnion   	  rR8;
-  StgUnion   	  rR9;		/* used occasionally by heap/stack checks */
-  StgUnion   	  rR10;		/* used occasionally by heap/stack checks */
-  StgFloat 	  rF1;
-  StgFloat 	  rF2;
-  StgFloat 	  rF3;
-  StgFloat 	  rF4;
-  StgDouble 	  rD1;
-  StgDouble 	  rD2;
-  StgWord64       rL1;
-  StgPtr 	  rSp;
-  StgPtr 	  rSpLim;
-  StgPtr 	  rHp;
-  StgPtr 	  rHpLim;
-  struct StgTSO_ *rCurrentTSO;
-  struct step_   *rNursery;
-  struct bdescr_ *rCurrentNursery; /* Hp/HpLim point into this block */
-  struct bdescr_ *rCurrentAlloc;   /* for allocation using allocate() */
-  StgWord         rHpAlloc;	/* number of *bytes* being allocated in heap */
-  // rmp_tmp1..rmp_result2 are only used in THREADED_RTS builds to
-  // avoid per-thread temps in bss, but currently always incldue here
-  // so we just run mkDerivedConstants once
-  StgInt          rmp_tmp_w;
-  MP_INT          rmp_tmp1;      
-  MP_INT          rmp_tmp2;      
-  MP_INT          rmp_result1;
-  MP_INT          rmp_result2;
-  StgWord         rRet;  // holds the return code of the thread
-#if defined(THREADED_RTS) || defined(PAR)
-  StgSparkPool    rSparks;	/* per-task spark pool */
-#endif
-} StgRegTable;
-
-#if IN_STG_CODE
-
-/*
- * Registers Hp and HpLim are global across the entire system, and are
- * copied into the RegTable before executing a thread.
- *
- * Registers Sp and SpLim are saved in the TSO for the
- * thread, but are copied into the RegTable before executing a thread.
- *
- * All other registers are "general purpose", and are used for passing
- * arguments to functions, and returning values.  The code generator
- * knows how many of these are in real registers, and avoids
- * generating code that uses non-real registers.  General purpose
- * registers are never saved when returning to the scheduler, instead
- * we save whatever is live at the time on the stack, and restore it
- * later.  This should reduce the context switch time, amongst other
- * things.
- *
- * For argument passing, the stack will be used in preference to
- * pseudo-registers if the architecture has too few general purpose
- * registers.
- *
- * Some special RTS functions like newArray and the Integer primitives
- * expect their arguments to be in registers R1-Rn, so we use these
- * (pseudo-)registers in those cases.
- */
-
-/* 
- * Locations for saving per-thread registers.
- */
-
-#define SAVE_Sp    	    (CurrentTSO->sp)
-#define SAVE_SpLim    	    (CurrentTSO->splim)
-
-#define SAVE_Hp	    	    (BaseReg->rHp)
-#define SAVE_HpLim	    (BaseReg->rHpLim)
-
-#define SAVE_CurrentTSO     (BaseReg->rCurrentTSO)
-#define SAVE_CurrentNursery (BaseReg->rCurrentNursery)
-#define SAVE_HpAlloc        (BaseReg->rHpAlloc)
-#define SAVE_SparkHd 	    (BaseReg->rSparks.hd)
-#define SAVE_SparkTl        (BaseReg->rSparks.tl)
-#define SAVE_SparkBase      (BaseReg->rSparks.base)
-#define SAVE_SparkLim 	    (BaseReg->rSparks.lim)
-
-/* We sometimes need to save registers across a C-call, eg. if they
- * are clobbered in the standard calling convention.  We define the
- * save locations for all registers in the register table.
- */
-
-#define SAVE_R1             (BaseReg->rR1)
-#define SAVE_R2             (BaseReg->rR2)
-#define SAVE_R3             (BaseReg->rR3)
-#define SAVE_R4             (BaseReg->rR4)
-#define SAVE_R5             (BaseReg->rR5)
-#define SAVE_R6             (BaseReg->rR6)
-#define SAVE_R7             (BaseReg->rR7)
-#define SAVE_R8             (BaseReg->rR8)
- 
-#define SAVE_F1             (BaseReg->rF1)
-#define SAVE_F2             (BaseReg->rF2)
-#define SAVE_F3             (BaseReg->rF3)
-#define SAVE_F4             (BaseReg->rF4)
-
-#define SAVE_D1             (BaseReg->rD1)
-#define SAVE_D2             (BaseReg->rD2)
-
-#define SAVE_L1             (BaseReg->rL1)
-
-/* -----------------------------------------------------------------------------
- * Emit the GCC-specific register declarations for each machine
- * register being used.  If any STG register isn't mapped to a machine
- * register, then map it to an offset from BaseReg.
- *
- * First, the general purpose registers.  The idea is, if a particular
- * general-purpose STG register can't be mapped to a real machine
- * register, it won't be used at all.  Instead, we'll use the stack.
- *
- * This is an improvement on the way things used to be done, when all
- * registers were mapped to locations in the register table, and stuff
- * was being shifted from the stack to the register table and back
- * again for no good reason (on register-poor architectures).
- */
-
-/* define NO_REGS to omit register declarations - used in RTS C code
- * that needs all the STG definitions but not the global register 
- * settings.
- */
-#define GLOBAL_REG_DECL(type,name,reg) register type name REG(reg);
-
-#if defined(REG_R1) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgUnion,R1,REG_R1)
-#else
-# define R1 (BaseReg->rR1)
-#endif
-
-#if defined(REG_R2) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgUnion,R2,REG_R2)
-#else
-# define R2 (BaseReg->rR2)
-#endif
-
-#if defined(REG_R3) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgUnion,R3,REG_R3)
-#else
-# define R3 (BaseReg->rR3)
-#endif
-
-#if defined(REG_R4) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgUnion,R4,REG_R4)
-#else
-# define R4 (BaseReg->rR4)
-#endif
-
-#if defined(REG_R5) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgUnion,R5,REG_R5)
-#else
-# define R5 (BaseReg->rR5)
-#endif
-
-#if defined(REG_R6) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgUnion,R6,REG_R6)
-#else
-# define R6 (BaseReg->rR6)
-#endif
-
-#if defined(REG_R7) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgUnion,R7,REG_R7)
-#else
-# define R7 (BaseReg->rR7)
-#endif
-
-#if defined(REG_R8) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgUnion,R8,REG_R8)
-#else
-# define R8 (BaseReg->rR8)
-#endif
-
-#if defined(REG_R9) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgUnion,R9,REG_R9)
-#else
-# define R9 (BaseReg->rR9)
-#endif
-
-#if defined(REG_R10) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgUnion,R10,REG_R10)
-#else
-# define R10 (BaseReg->rR10)
-#endif
-
-#if defined(REG_F1) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgFloat,F1,REG_F1)
-#else
-#define F1 (BaseReg->rF1)
-#endif
-
-#if defined(REG_F2) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgFloat,F2,REG_F2)
-#else
-#define F2 (BaseReg->rF2)
-#endif
-
-#if defined(REG_F3) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgFloat,F3,REG_F3)
-#else
-#define F3 (BaseReg->rF3)
-#endif
-
-#if defined(REG_F4) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgFloat,F4,REG_F4)
-#else
-#define F4 (BaseReg->rF4)
-#endif
-
-#if defined(REG_D1) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgDouble,D1,REG_D1)
-#else
-#define D1 (BaseReg->rD1)
-#endif
-
-#if defined(REG_D2) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgDouble,D2,REG_D2)
-#else
-#define D2 (BaseReg->rD2)
-#endif
-
-#if defined(REG_L1) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgWord64,L1,REG_L1)
-#else
-#define L1 (BaseReg->rL1)
-#endif
-
-/*
- * If BaseReg isn't mapped to a machine register, just use the global
- * address of the current register table (CurrentRegTable in
- * concurrent Haskell, MainRegTable otherwise).
- */
-
-/* A capability is a combination of a FunTable and a RegTable.  In STG
- * code, BaseReg normally points to the RegTable portion of this
- * structure, so that we can index both forwards and backwards to take
- * advantage of shorter instruction forms on some archs (eg. x86).
- * This is a cut-down version of the Capability structure; the full
- * version is defined in Capability.h.
- */
-struct PartCapability_ {
-    StgFunTable f;
-    StgRegTable r;
-};
-
-/* No such thing as a MainCapability under THREADED_RTS - each thread must have
- * its own Capability.
- */
-#if IN_STG_CODE && !defined(THREADED_RTS)
-extern W_ MainCapability[];
-#endif
-
-/*
- * Assigning to BaseReg (the ASSIGN_BaseReg macro): this happens on
- * return from a "safe" foreign call, when the thread might be running
- * on a new Capability.  Obviously if BaseReg is not a register, then
- * we are restricted to a single Capability (this invariant is enforced
- * in Capability.c:initCapabilities), and assigning to BaseReg can be omitted.
- */
-
-#if defined(REG_Base) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(StgRegTable *,BaseReg,REG_Base)
-#define ASSIGN_BaseReg(e) (BaseReg = (e))
-#else
-#ifdef THREADED_RTS
-#error BaseReg must be in a register for THREADED_RTS
-#endif
-#define BaseReg (&((struct PartCapability_ *)MainCapability)->r)
-#define ASSIGN_BaseReg(e) (e)
-#endif
-
-#if defined(REG_Sp) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(P_,Sp,REG_Sp)
-#else
-#define Sp (BaseReg->rSp)
-#endif
-
-#if defined(REG_SpLim) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(P_,SpLim,REG_SpLim)
-#else
-#define SpLim (BaseReg->rSpLim)
-#endif
-
-#if defined(REG_Hp) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(P_,Hp,REG_Hp)
-#else
-#define Hp (BaseReg->rHp)
-#endif
-
-#if defined(REG_HpLim) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(P_,HpLim,REG_HpLim)
-#else
-#define HpLim (BaseReg->rHpLim)
-#endif
-
-#if defined(REG_CurrentTSO) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(struct _StgTSO *,CurrentTSO,REG_CurrentTSO)
-#else
-#define CurrentTSO (BaseReg->rCurrentTSO)
-#endif
-
-#if defined(REG_CurrentNursery) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(bdescr *,CurrentNursery,REG_CurrentNursery)
-#else
-#define CurrentNursery (BaseReg->rCurrentNursery)
-#endif
-
-#if defined(REG_HpAlloc) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(bdescr *,HpAlloc,REG_HpAlloc)
-#else
-#define HpAlloc (BaseReg->rHpAlloc)
-#endif
-
-#if defined(REG_SparkHd) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(bdescr *,SparkHd,REG_SparkHd)
-#else
-#define SparkHd (BaseReg->rSparks.hd)
-#endif
-
-#if defined(REG_SparkTl) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(bdescr *,SparkTl,REG_SparkTl)
-#else
-#define SparkTl (BaseReg->rSparks.tl)
-#endif
-
-#if defined(REG_SparkBase) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(bdescr *,SparkBase,REG_SparkBase)
-#else
-#define SparkBase (BaseReg->rSparks.base)
-#endif
-
-#if defined(REG_SparkLim) && !defined(NO_GLOBAL_REG_DECLS)
-GLOBAL_REG_DECL(bdescr *,SparkLim,REG_SparkLim)
-#else
-#define SparkLim (BaseReg->rSparks.lim)
-#endif
-
-/* -----------------------------------------------------------------------------
-   Get absolute function pointers from the register table, to save
-   code space.  On x86, 
-
-       jmp  *-12(%ebx)
-
-   is shorter than
-   
-       jmp absolute_address
-
-   as long as the offset is within the range of a signed byte
-   (-128..+127).  So we pick some common absolute_addresses and put
-   them in the register table.  As a bonus, linking time should also
-   be reduced.
-
-   Other possible candidates in order of importance:
-      
-     stg_upd_frame_info
-     stg_CAF_BLACKHOLE_info
-     stg_IND_STATIC_info
-
-   anything else probably isn't worth the effort.
-
-   -------------------------------------------------------------------------- */
-
-
-#define FunReg ((StgFunTable *)((void *)BaseReg - sizeof(StgFunTable)))
-
-#define stg_gc_enter_1     (FunReg->stgGCEnter1)
-#define stg_gc_fun         (FunReg->stgGCFun)
-
-/* -----------------------------------------------------------------------------
-   For any registers which are denoted "caller-saves" by the C calling
-   convention, we have to emit code to save and restore them across C
-   calls.
-   -------------------------------------------------------------------------- */
-
-#ifdef CALLER_SAVES_R1
-#define CALLER_SAVE_R1    	SAVE_R1 = R1;
-#define CALLER_RESTORE_R1 	R1 = SAVE_R1;
-#else
-#define CALLER_SAVE_R1      	/* nothing */
-#define CALLER_RESTORE_R1    	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_R2
-#define CALLER_SAVE_R2    	SAVE_R2 = R2;
-#define CALLER_RESTORE_R2 	R2 = SAVE_R2;
-#else
-#define CALLER_SAVE_R2      	/* nothing */
-#define CALLER_RESTORE_R2    	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_R3
-#define CALLER_SAVE_R3    	SAVE_R3 = R3;
-#define CALLER_RESTORE_R3 	R3 = SAVE_R3;
-#else
-#define CALLER_SAVE_R3      	/* nothing */
-#define CALLER_RESTORE_R3    	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_R4
-#define CALLER_SAVE_R4    	SAVE_R4 = R4;
-#define CALLER_RESTORE_R4 	R4 = SAVE_R4;
-#else
-#define CALLER_SAVE_R4      	/* nothing */
-#define CALLER_RESTORE_R4    	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_R5
-#define CALLER_SAVE_R5    	SAVE_R5 = R5;
-#define CALLER_RESTORE_R5 	R5 = SAVE_R5;
-#else
-#define CALLER_SAVE_R5      	/* nothing */
-#define CALLER_RESTORE_R5    	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_R6
-#define CALLER_SAVE_R6    	SAVE_R6 = R6;
-#define CALLER_RESTORE_R6 	R6 = SAVE_R6;
-#else
-#define CALLER_SAVE_R6      	/* nothing */
-#define CALLER_RESTORE_R6    	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_R7
-#define CALLER_SAVE_R7    	SAVE_R7 = R7;
-#define CALLER_RESTORE_R7 	R7 = SAVE_R7;
-#else
-#define CALLER_SAVE_R7      	/* nothing */
-#define CALLER_RESTORE_R7    	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_R8
-#define CALLER_SAVE_R8    	SAVE_R8 = R8;
-#define CALLER_RESTORE_R8 	R8 = SAVE_R8;
-#else
-#define CALLER_SAVE_R8      	/* nothing */
-#define CALLER_RESTORE_R8    	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_R9
-#define CALLER_SAVE_R9    	SAVE_R9 = R9;
-#define CALLER_RESTORE_R9 	R9 = SAVE_R9;
-#else
-#define CALLER_SAVE_R9      	/* nothing */
-#define CALLER_RESTORE_R9    	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_R10
-#define CALLER_SAVE_R10    	SAVE_R10 = R10;
-#define CALLER_RESTORE_R10 	R10 = SAVE_R10;
-#else
-#define CALLER_SAVE_R10      	/* nothing */
-#define CALLER_RESTORE_R10    	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_F1
-#define CALLER_SAVE_F1    	SAVE_F1 = F1;
-#define CALLER_RESTORE_F1 	F1 = SAVE_F1;
-#else
-#define CALLER_SAVE_F1    	/* nothing */
-#define CALLER_RESTORE_F1 	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_F2
-#define CALLER_SAVE_F2    	SAVE_F2 = F2;
-#define CALLER_RESTORE_F2 	F2 = SAVE_F2;
-#else
-#define CALLER_SAVE_F2    	/* nothing */
-#define CALLER_RESTORE_F2 	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_F3
-#define CALLER_SAVE_F3    	SAVE_F3 = F3;
-#define CALLER_RESTORE_F3 	F3 = SAVE_F3;
-#else
-#define CALLER_SAVE_F3    	/* nothing */
-#define CALLER_RESTORE_F3 	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_F4
-#define CALLER_SAVE_F4    	SAVE_F4 = F4;
-#define CALLER_RESTORE_F4 	F4 = SAVE_F4;
-#else
-#define CALLER_SAVE_F4    	/* nothing */
-#define CALLER_RESTORE_F4 	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_D1
-#define CALLER_SAVE_D1    	SAVE_D1 = D1;
-#define CALLER_RESTORE_D1 	D1 = SAVE_D1;
-#else
-#define CALLER_SAVE_D1    	/* nothing */
-#define CALLER_RESTORE_D1 	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_D2
-#define CALLER_SAVE_D2    	SAVE_D2 = D2;
-#define CALLER_RESTORE_D2 	D2 = SAVE_D2;
-#else
-#define CALLER_SAVE_D2    	/* nothing */
-#define CALLER_RESTORE_D2 	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_L1
-#define CALLER_SAVE_L1    	SAVE_L1 = L1;
-#define CALLER_RESTORE_L1 	L1 = SAVE_L1;
-#else
-#define CALLER_SAVE_L1    	/* nothing */
-#define CALLER_RESTORE_L1 	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_Sp
-#define CALLER_SAVE_Sp	    	SAVE_Sp = Sp;
-#define CALLER_RESTORE_Sp  	Sp = SAVE_Sp;
-#else
-#define CALLER_SAVE_Sp	    	/* nothing */
-#define CALLER_RESTORE_Sp	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_SpLim
-#define CALLER_SAVE_SpLim    	SAVE_SpLim = SpLim;
-#define CALLER_RESTORE_SpLim  	SpLim = SAVE_SpLim;
-#else
-#define CALLER_SAVE_SpLim    	/* nothing */
-#define CALLER_RESTORE_SpLim	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_Hp
-#define CALLER_SAVE_Hp	    	SAVE_Hp = Hp;
-#define CALLER_RESTORE_Hp   	Hp = SAVE_Hp;
-#else
-#define CALLER_SAVE_Hp	    	/* nothing */
-#define CALLER_RESTORE_Hp	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_HpLim
-#define CALLER_SAVE_HpLim   	SAVE_HpLim = HpLim;
-#define CALLER_RESTORE_HpLim	HpLim = SAVE_HpLim;
-#else
-#define CALLER_SAVE_HpLim   	/* nothing */
-#define CALLER_RESTORE_HpLim   	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_Base
-#ifdef THREADED_RTS
-#error "Can't have caller-saved BaseReg with THREADED_RTS"
-#endif
-#define CALLER_SAVE_Base	/* nothing */
-#define CALLER_RESTORE_Base	BaseReg = &MainRegTable;
-#else
-#define CALLER_SAVE_Base	/* nothing */
-#define CALLER_RESTORE_Base	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_CurrentTSO
-#define CALLER_SAVE_CurrentTSO   	SAVE_CurrentTSO = CurrentTSO;
-#define CALLER_RESTORE_CurrentTSO	CurrentTSO = SAVE_CurrentTSO;
-#else
-#define CALLER_SAVE_CurrentTSO   	/* nothing */
-#define CALLER_RESTORE_CurrentTSO   	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_CurrentNursery
-#define CALLER_SAVE_CurrentNursery   	SAVE_CurrentNursery = CurrentNursery;
-#define CALLER_RESTORE_CurrentNursery	CurrentNursery = SAVE_CurrentNursery;
-#else
-#define CALLER_SAVE_CurrentNursery   	/* nothing */
-#define CALLER_RESTORE_CurrentNursery   /* nothing */
-#endif
-
-#ifdef CALLER_SAVES_HpAlloc
-#define CALLER_SAVE_HpAlloc   		SAVE_HpAlloc = HpAlloc;
-#define CALLER_RESTORE_HpAlloc		HpAlloc = SAVE_HpAlloc;
-#else
-#define CALLER_SAVE_HpAlloc   		/* nothing */
-#define CALLER_RESTORE_HpAlloc   	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_SparkHd
-#define CALLER_SAVE_SparkHd   		SAVE_SparkHd = SparkHd;
-#define CALLER_RESTORE_SparkHd		SparkHd = SAVE_SparkHd;
-#else
-#define CALLER_SAVE_SparkHd   		/* nothing */
-#define CALLER_RESTORE_SparkHd   	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_SparkTl
-#define CALLER_SAVE_SparkTl   		SAVE_SparkTl = SparkTl;
-#define CALLER_RESTORE_SparkTl		SparkTl = SAVE_SparkTl;
-#else
-#define CALLER_SAVE_SparkTl   		/* nothing */
-#define CALLER_RESTORE_SparkTl   	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_SparkBase
-#define CALLER_SAVE_SparkBase   	SAVE_SparkBase = SparkBase;
-#define CALLER_RESTORE_SparkBase	SparkBase = SAVE_SparkBase;
-#else
-#define CALLER_SAVE_SparkBase   	/* nothing */
-#define CALLER_RESTORE_SparkBase   	/* nothing */
-#endif
-
-#ifdef CALLER_SAVES_SparkLim
-#define CALLER_SAVE_SparkLim   		SAVE_SparkLim = SparkLim;
-#define CALLER_RESTORE_SparkLim		SparkLim = SAVE_SparkLim;
-#else
-#define CALLER_SAVE_SparkLim   		/* nothing */
-#define CALLER_RESTORE_SparkLim   	/* nothing */
-#endif
-
-#endif /* IN_STG_CODE */
-
-/* ----------------------------------------------------------------------------
-   Handy bunches of saves/restores 
-   ------------------------------------------------------------------------  */
-
-#if IN_STG_CODE
-
-#define CALLER_SAVE_USER			\
-  CALLER_SAVE_R1				\
-  CALLER_SAVE_R2				\
-  CALLER_SAVE_R3				\
-  CALLER_SAVE_R4				\
-  CALLER_SAVE_R5				\
-  CALLER_SAVE_R6				\
-  CALLER_SAVE_R7				\
-  CALLER_SAVE_R8				\
-  CALLER_SAVE_F1				\
-  CALLER_SAVE_F2				\
-  CALLER_SAVE_F3				\
-  CALLER_SAVE_F4				\
-  CALLER_SAVE_D1				\
-  CALLER_SAVE_D2				\
-  CALLER_SAVE_L1
-
-     /* Save Base last, since the others may
-	be addressed relative to it */
-#define CALLER_SAVE_SYSTEM			\
-  CALLER_SAVE_Sp				\
-  CALLER_SAVE_SpLim				\
-  CALLER_SAVE_Hp				\
-  CALLER_SAVE_HpLim				\
-  CALLER_SAVE_CurrentTSO			\
-  CALLER_SAVE_CurrentNursery			\
-  CALLER_SAVE_SparkHd				\
-  CALLER_SAVE_SparkTl				\
-  CALLER_SAVE_SparkBase				\
-  CALLER_SAVE_SparkLim                          \
-  CALLER_SAVE_Base
-
-#define CALLER_RESTORE_USER			\
-  CALLER_RESTORE_R1				\
-  CALLER_RESTORE_R2				\
-  CALLER_RESTORE_R3				\
-  CALLER_RESTORE_R4				\
-  CALLER_RESTORE_R5				\
-  CALLER_RESTORE_R6				\
-  CALLER_RESTORE_R7				\
-  CALLER_RESTORE_R8				\
-  CALLER_RESTORE_F1				\
-  CALLER_RESTORE_F2				\
-  CALLER_RESTORE_F3				\
-  CALLER_RESTORE_F4				\
-  CALLER_RESTORE_D1				\
-  CALLER_RESTORE_D2				\
-  CALLER_RESTORE_L1
-
-     /* Restore Base first, since the others may
-	be addressed relative to it */
-#define CALLER_RESTORE_SYSTEM			\
-  CALLER_RESTORE_Base				\
-  CALLER_RESTORE_Sp				\
-  CALLER_RESTORE_SpLim				\
-  CALLER_RESTORE_Hp				\
-  CALLER_RESTORE_HpLim				\
-  CALLER_RESTORE_CurrentTSO			\
-  CALLER_RESTORE_CurrentNursery			\
-  CALLER_RESTORE_SparkHd			\
-  CALLER_RESTORE_SparkTl			\
-  CALLER_RESTORE_SparkBase			\
-  CALLER_RESTORE_SparkLim
-
-#else /* not IN_STG_CODE */
-
-#define CALLER_SAVE_USER       /* nothing */
-#define CALLER_SAVE_SYSTEM     /* nothing */
-#define CALLER_RESTORE_USER    /* nothing */
-#define CALLER_RESTORE_SYSTEM  /* nothing */
-
-#endif /* IN_STG_CODE */
-#define CALLER_SAVE_ALL				\
-  CALLER_SAVE_SYSTEM				\
-  CALLER_SAVE_USER
-
-#define CALLER_RESTORE_ALL			\
-  CALLER_RESTORE_SYSTEM				\
-  CALLER_RESTORE_USER
-
-#endif /* REGS_H */
diff --git a/ghc/includes/Rts.h b/ghc/includes/Rts.h
deleted file mode 100644
index 3ca0d9a913..0000000000
--- a/ghc/includes/Rts.h
+++ /dev/null
@@ -1,238 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Top-level include file for the RTS itself
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef RTS_H
-#define RTS_H
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-#ifndef IN_STG_CODE
-#define IN_STG_CODE 0
-#endif
-#include "Stg.h"
-
-#include "RtsTypes.h"
-
-#if __GNUC__ >= 3
-/* Assume that a flexible array member at the end of a struct
- * can be defined thus: T arr[]; */
-#define FLEXIBLE_ARRAY
-#else
-/* Assume that it must be defined thus: T arr[0]; */
-#define FLEXIBLE_ARRAY 0
-#endif
-
-/* Fix for mingw stat problem (done here so it's early enough) */
-#ifdef mingw32_HOST_OS
-#define __MSVCRT__ 1
-#endif
-
-/*
- * We often want to know the size of something in units of an
- * StgWord... (rounded up, of course!)
- */
-#define sizeofW(t) ((sizeof(t)+sizeof(W_)-1)/sizeof(W_))
-
-/* 
- * It's nice to be able to grep for casts
- */
-#define stgCast(ty,e) ((ty)(e))
-
-/* -----------------------------------------------------------------------------
-   Assertions and Debuggery
-   -------------------------------------------------------------------------- */
-
-#ifndef DEBUG
-#define ASSERT(predicate) /* nothing */
-#else
-
-extern void _assertFail (char *, unsigned int);
-
-#define ASSERT(predicate)			\
-	if (predicate)				\
-	    /*null*/;				\
-	else					\
-	    _assertFail(__FILE__, __LINE__)
-#endif /* DEBUG */
-
-/* 
- * Use this on the RHS of macros which expand to nothing
- * to make sure that the macro can be used in a context which
- * demands a non-empty statement.
- */
-
-#define doNothing() do { } while (0)
-
-#ifdef DEBUG
-#define USED_IF_DEBUG
-#define USED_IF_NOT_DEBUG STG_UNUSED
-#else
-#define USED_IF_DEBUG STG_UNUSED
-#define USED_IF_NOT_DEBUG
-#endif
-
-#ifdef THREADED_RTS
-#define USED_IF_THREADS
-#define USED_IF_NOT_THREADS STG_UNUSED
-#else
-#define USED_IF_THREADS STG_UNUSED
-#define USED_IF_NOT_THREADS
-#endif
-
-/* -----------------------------------------------------------------------------
-   Include everything STG-ish
-   -------------------------------------------------------------------------- */
-
-/* System headers: stdlib.h is eeded so that we can use NULL.  It must
- * come after MachRegs.h, because stdlib.h might define some inline
- * functions which may only be defined after register variables have
- * been declared.
- */
-#include <stdlib.h>
-
-/* Global constaints */
-#include "Constants.h"
-
-/* Profiling information */
-#include "StgProf.h"
-#include "StgLdvProf.h"
-
-/* Storage format definitions */
-#include "StgFun.h"
-#include "Closures.h"
-#include "Liveness.h"
-#include "ClosureTypes.h"
-#include "InfoTables.h"
-#include "TSO.h"
-
-/* Info tables, closures & code fragments defined in the RTS */
-#include "StgMiscClosures.h"
-
-/* Simulated-parallel information */
-#include "GranSim.h"
-
-/* Parallel information */
-#include "Parallel.h"
-#include "OSThreads.h"
-#include "SMP.h"
-
-/* STG/Optimised-C related stuff */
-#include "Block.h"
-
-/* GNU mp library */
-#include "gmp.h"
-
-/* Macros for STG/C code */
-#include "ClosureMacros.h"
-#include "StgTicky.h"
-#include "Stable.h"
-
-/* Runtime-system hooks */
-#include "Hooks.h"
-#include "RtsMessages.h"
-
-#include "ieee-flpt.h"
-
-#include "Signals.h"
-
-/* Misc stuff without a home */
-DLL_IMPORT_RTS extern char **prog_argv;	/* so we can get at these from Haskell */
-DLL_IMPORT_RTS extern int    prog_argc;
-DLL_IMPORT_RTS extern char  *prog_name;
-
-extern void stackOverflow(void);
-
-extern void      __decodeDouble (MP_INT *man, I_ *_exp, StgDouble dbl);
-extern void      __decodeFloat  (MP_INT *man, I_ *_exp, StgFloat flt);
-
-#if defined(WANT_DOTNET_SUPPORT)
-#include "DNInvoke.h"
-#endif
-
-/* Initialising the whole adjustor thunk machinery. */
-extern void initAdjustor(void);
-
-extern void stg_exit(int n) GNU_ATTRIBUTE(__noreturn__);
-
-/* -----------------------------------------------------------------------------
-   RTS Exit codes
-   -------------------------------------------------------------------------- */
-
-/* 255 is allegedly used by dynamic linkers to report linking failure */
-#define EXIT_INTERNAL_ERROR 254
-#define EXIT_DEADLOCK       253
-#define EXIT_INTERRUPTED    252
-#define EXIT_HEAPOVERFLOW   251
-#define EXIT_KILLED         250
-
-/* -----------------------------------------------------------------------------
-   Miscellaneous garbage
-   -------------------------------------------------------------------------- */
-
-/* declarations for runtime flags/values */
-#define MAX_RTS_ARGS 32
-
-/* -----------------------------------------------------------------------------
-   Assertions and Debuggery
-   -------------------------------------------------------------------------- */
-
-#define IF_RTSFLAGS(c,s)  if (RtsFlags.c) { s; }
-
-/* -----------------------------------------------------------------------------
-   Assertions and Debuggery
-   -------------------------------------------------------------------------- */
-
-#ifdef DEBUG
-#define IF_DEBUG(c,s)  if (RtsFlags.DebugFlags.c) { s; }
-#else
-#define IF_DEBUG(c,s)  doNothing()
-#endif
-
-#ifdef DEBUG
-#define DEBUG_ONLY(s) s
-#else
-#define DEBUG_ONLY(s) doNothing()
-#endif
-
-#if defined(GRAN) && defined(DEBUG)
-#define IF_GRAN_DEBUG(c,s)  if (RtsFlags.GranFlags.Debug.c) { s; }
-#else
-#define IF_GRAN_DEBUG(c,s)  doNothing()
-#endif
-
-#if defined(PAR) && defined(DEBUG)
-#define IF_PAR_DEBUG(c,s)  if (RtsFlags.ParFlags.Debug.c) { s; }
-#else
-#define IF_PAR_DEBUG(c,s)  doNothing()
-#endif
-
-/* -----------------------------------------------------------------------------
-   Useful macros and inline functions
-   -------------------------------------------------------------------------- */
-
-#if defined(__GNUC__)
-#define SUPPORTS_TYPEOF
-#endif
-
-#if defined(SUPPORTS_TYPEOF)
-#define stg_min(a,b) ({typeof(a) _a = (a), _b = (b); _a <= _b ? _a : _b; })
-#define stg_max(a,b) ({typeof(a) _a = (a), _b = (b); _a <= _b ? _b : _a; })
-#else
-#define stg_min(a,b) ((a) <= (b) ? (a) : (b))
-#define stg_max(a,b) ((a) <= (b) ? (b) : (a))
-#endif
-
-/* -------------------------------------------------------------------------- */
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* RTS_H */
diff --git a/ghc/includes/RtsAPI.h b/ghc/includes/RtsAPI.h
deleted file mode 100644
index 1b66789059..0000000000
--- a/ghc/includes/RtsAPI.h
+++ /dev/null
@@ -1,155 +0,0 @@
-/* ----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * API for invoking Haskell functions via the RTS
- *
- * --------------------------------------------------------------------------*/
-
-#ifndef RTSAPI_H
-#define RTSAPI_H
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-#include "HsFFI.h"
-
-/*
- * Running the scheduler
- */
-typedef enum {
-    NoStatus,    /* not finished yet */
-    Success,	 /* completed successfully */
-    Killed,	 /* uncaught exception */
-    Interrupted  /* stopped in response to a call to interruptStgRts */
-} SchedulerStatus;
-
-typedef StgClosure *HaskellObj;
-
-/*
- * An abstract type representing the token returned by rts_lock() and
- * used when allocating objects and threads in the RTS.
- */
-typedef struct Capability_ Capability;
-
-/* ----------------------------------------------------------------------------
-   Starting up and shutting down the Haskell RTS.
-   ------------------------------------------------------------------------- */
-extern void startupHaskell         ( int argc, char *argv[], 
-				     void (*init_root)(void) );
-extern void shutdownHaskell        ( void );
-extern void shutdownHaskellAndExit ( int exitCode );
-extern void getProgArgv            ( int *argc, char **argv[] );
-extern void setProgArgv            ( int argc, char *argv[] );
-
-
-/* ----------------------------------------------------------------------------
-   Locking.
-   
-   You have to surround all access to the RtsAPI with these calls.
-   ------------------------------------------------------------------------- */
-   
-// acquires a token which may be used to create new objects and
-// evaluate them.
-Capability *rts_lock (void);
-
-// releases the token acquired with rts_lock().
-void rts_unlock (Capability *token);
-
-/* ----------------------------------------------------------------------------
-   Building Haskell objects from C datatypes.
-   ------------------------------------------------------------------------- */
-HaskellObj   rts_mkChar       ( Capability *, HsChar   c );
-HaskellObj   rts_mkInt        ( Capability *, HsInt    i );
-HaskellObj   rts_mkInt8       ( Capability *, HsInt8   i );
-HaskellObj   rts_mkInt16      ( Capability *, HsInt16  i );
-HaskellObj   rts_mkInt32      ( Capability *, HsInt32  i );
-HaskellObj   rts_mkInt64      ( Capability *, HsInt64  i );
-HaskellObj   rts_mkWord       ( Capability *, HsWord   w );
-HaskellObj   rts_mkWord8      ( Capability *, HsWord8  w );
-HaskellObj   rts_mkWord16     ( Capability *, HsWord16 w );
-HaskellObj   rts_mkWord32     ( Capability *, HsWord32 w );
-HaskellObj   rts_mkWord64     ( Capability *, HsWord64 w );
-HaskellObj   rts_mkPtr        ( Capability *, HsPtr    a );
-HaskellObj   rts_mkFunPtr     ( Capability *, HsFunPtr a );
-HaskellObj   rts_mkFloat      ( Capability *, HsFloat  f );
-HaskellObj   rts_mkDouble     ( Capability *, HsDouble f );
-HaskellObj   rts_mkStablePtr  ( Capability *, HsStablePtr s );
-HaskellObj   rts_mkBool       ( Capability *, HsBool   b );
-HaskellObj   rts_mkString     ( Capability *, char    *s );
-
-HaskellObj   rts_apply        ( Capability *, HaskellObj, HaskellObj );
-
-/* ----------------------------------------------------------------------------
-   Deconstructing Haskell objects
-   ------------------------------------------------------------------------- */
-HsChar       rts_getChar      ( HaskellObj );
-HsInt        rts_getInt       ( HaskellObj );
-HsInt8       rts_getInt8      ( HaskellObj );
-HsInt16      rts_getInt16     ( HaskellObj );
-HsInt32      rts_getInt32     ( HaskellObj );
-HsInt64      rts_getInt64     ( HaskellObj );
-HsWord       rts_getWord      ( HaskellObj );
-HsWord8      rts_getWord8     ( HaskellObj );
-HsWord16     rts_getWord16    ( HaskellObj );
-HsWord32     rts_getWord32    ( HaskellObj );
-HsWord64     rts_getWord64    ( HaskellObj );
-HsPtr        rts_getPtr       ( HaskellObj );
-HsFunPtr     rts_getFunPtr    ( HaskellObj );
-HsFloat      rts_getFloat     ( HaskellObj );
-HsDouble     rts_getDouble    ( HaskellObj );
-HsStablePtr  rts_getStablePtr ( HaskellObj );
-HsBool       rts_getBool      ( HaskellObj );
-
-/* ----------------------------------------------------------------------------
-   Evaluating Haskell expressions
-
-   The versions ending in '_' allow you to specify an initial stack size.
-   Note that these calls may cause Garbage Collection, so all HaskellObj
-   references are rendered invalid by these calls.
-   ------------------------------------------------------------------------- */
-Capability * 
-rts_eval (Capability *, HaskellObj p, /*out*/HaskellObj *ret);
-
-Capability * 
-rts_eval_ (Capability *, HaskellObj p, unsigned int stack_size, 
-	   /*out*/HaskellObj *ret);
-
-Capability * 
-rts_evalIO (Capability *, HaskellObj p, /*out*/HaskellObj *ret);
-
-Capability *
-rts_evalStableIO (Capability *, HsStablePtr s, /*out*/HsStablePtr *ret);
-
-Capability * 
-rts_evalLazyIO (Capability *, HaskellObj p, /*out*/HaskellObj *ret);
-
-Capability * 
-rts_evalLazyIO_ (Capability *, HaskellObj p, unsigned int stack_size, 
-		 /*out*/HaskellObj *ret);
-
-void
-rts_checkSchedStatus (char* site, Capability *);
-
-SchedulerStatus
-rts_getSchedStatus (Capability *cap);
-
-/* --------------------------------------------------------------------------
-   Wrapper closures
-
-   These are used by foreign export and foreign import "wrapper" stubs.
-   ----------------------------------------------------------------------- */
-
-extern StgWord GHCziTopHandler_runIO_closure[];
-extern StgWord GHCziTopHandler_runNonIO_closure[];
-#define runIO_closure		  GHCziTopHandler_runIO_closure
-#define runNonIO_closure	  GHCziTopHandler_runNonIO_closure
-
-/* ------------------------------------------------------------------------ */
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* RTSAPI_H */
diff --git a/ghc/includes/RtsConfig.h b/ghc/includes/RtsConfig.h
deleted file mode 100644
index 8590ccd7cc..0000000000
--- a/ghc/includes/RtsConfig.h
+++ /dev/null
@@ -1,89 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Rts settings.
- *
- * NOTE: assumes #include "ghcconfig.h"
- * 
- * NB: THIS FILE IS INCLUDED IN NON-C CODE AND DATA!  #defines only please.
- * ---------------------------------------------------------------------------*/
-
-#ifndef RTSCONFIG_H
-#define RTSCONFIG_H
-
-/*
- * SUPPORT_LONG_LONGS controls whether we need to support long longs on a
- * particular platform.   On 64-bit platforms, we don't need to support
- * long longs since regular machine words will do just fine.
- */
-#if HAVE_LONG_LONG && SIZEOF_VOID_P < 8
-#define SUPPORT_LONG_LONGS 1
-#endif
-
-/*
- * Whether the runtime system will use libbfd for debugging purposes.
- */
-#if defined(DEBUG) && defined(HAVE_BFD_H) && !defined(_WIN32) && !defined(PAR) && !defined(GRAN)
-#define USING_LIBBFD 1
-#endif
-
-/* Turn lazy blackholing and eager blackholing on/off.
- *
- * Using eager blackholing makes things easier to debug because
- * the blackholes are more predictable - but it's slower and less sexy.
- *
- * For now, do lazy and not eager.
- */
-
-/* TICKY_TICKY needs EAGER_BLACKHOLING to verify no double-entries of
- * single-entry thunks.
- */
-/* #if defined(TICKY_TICKY) || defined(THREADED_RTS) */
-#if defined(TICKY_TICKY)
-#  define EAGER_BLACKHOLING
-#else
-#  define LAZY_BLACKHOLING
-#endif
-
-/* TABLES_NEXT_TO_CODE says whether to assume that info tables are
- * assumed to reside just before the code for a function.
- *
- * UNDEFINING THIS WON'T WORK ON ITS OWN.  You have been warned.
- */
-#if !defined(USE_MINIINTERPRETER) && !defined(ia64_HOST_ARCH) && !defined (powerpc64_HOST_ARCH)
-#define TABLES_NEXT_TO_CODE
-#endif
-
-/* -----------------------------------------------------------------------------
-   Labels - entry labels & info labels point to the same place in
-   TABLES_NEXT_TO_CODE, so we only generate the _info label.  Jumps
-   must therefore be directed to foo_info rather than foo_entry when
-   TABLES_NEXT_TO_CODE is on.
-
-   This isn't a good place for these macros, but they need to be
-   available to .cmm sources as well as C and we don't have a better
-   place.
-   -------------------------------------------------------------------------- */
-
-#ifdef TABLES_NEXT_TO_CODE
-#define ENTRY_LBL(f) f##_info
-#else
-#define ENTRY_LBL(f) f##_entry
-#endif
-
-#ifdef TABLES_NEXT_TO_CODE
-#define RET_LBL(f) f##_info
-#else
-#define RET_LBL(f) f##_ret
-#endif
-
-/* -----------------------------------------------------------------------------
-   Signals - supported on non-PAR versions of the runtime.  See RtsSignals.h.
-   -------------------------------------------------------------------------- */
-
-#if !defined(PAR)
-#define RTS_USER_SIGNALS 1
-#endif
-
-#endif /* RTSCONFIG_H */
diff --git a/ghc/includes/RtsExternal.h b/ghc/includes/RtsExternal.h
deleted file mode 100644
index 61a920b0ab..0000000000
--- a/ghc/includes/RtsExternal.h
+++ /dev/null
@@ -1,96 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Things visible externally to the RTS
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef RTSEXTERNAL_H
-#define RTSEXTERNAL_H
-
-/* The RTS public interface. */
-#include "RtsAPI.h"
-
-/* The standard FFI interface */
-#include "HsFFI.h"
-
-/* -----------------------------------------------------------------------------
-   Functions exported by the RTS for use in Stg code
-   -------------------------------------------------------------------------- */
-
-#if IN_STG_CODE
-extern void newCAF(void*);
-#else
-extern void newCAF(StgClosure*);
-#endif
-
-/* ToDo: remove? */
-extern I_ genSymZh(void);
-extern I_ resetGenSymZh(void);
-
-/* Alternate to raise(3) for threaded rts, for OpenBSD */
-extern int genericRaise(int sig);
-
-/* Concurrency/Exception PrimOps. */
-extern int cmp_thread(StgPtr tso1, StgPtr tso2);
-extern int rts_getThreadId(StgPtr tso);
-extern int forkOS_createThread ( HsStablePtr entry );
-extern StgInt forkProcess(HsStablePtr *entry);
-extern StgBool rtsSupportsBoundThreads(void);
-
-/* grimy low-level support functions defined in StgPrimFloat.c */
-extern StgDouble __encodeDouble (I_ size, StgByteArray arr, I_ e);
-extern StgDouble __int_encodeDouble (I_ j, I_ e);
-extern StgFloat  __encodeFloat (I_ size, StgByteArray arr, I_ e);
-extern StgFloat  __int_encodeFloat (I_ j, I_ e);
-extern StgInt    isDoubleNaN(StgDouble d);
-extern StgInt    isDoubleInfinite(StgDouble d);
-extern StgInt    isDoubleDenormalized(StgDouble d);
-extern StgInt    isDoubleNegativeZero(StgDouble d);
-extern StgInt    isFloatNaN(StgFloat f);
-extern StgInt    isFloatInfinite(StgFloat f);
-extern StgInt    isFloatDenormalized(StgFloat f);
-extern StgInt    isFloatNegativeZero(StgFloat f);
-
-/* Suspending/resuming threads around foreign calls */
-extern void *        suspendThread ( StgRegTable * );
-extern StgRegTable * resumeThread  ( void * );
-
-/* scheduler stuff */
-extern void stg_scheduleThread (StgRegTable *reg, struct StgTSO_ *tso);
-
-/* Creating and destroying an adjustor thunk */
-extern void*  createAdjustor(int cconv, StgStablePtr hptr, StgFunPtr wptr,
-                             char *typeString);
-extern void   freeHaskellFunctionPtr(void* ptr);
-
-#if defined(mingw32_HOST_OS)
-extern int  rts_InstallConsoleEvent ( int action, StgStablePtr *handler );
-extern void rts_ConsoleHandlerDone  ( int ev );
-#else
-extern int stg_sig_install (int, int, StgStablePtr *, void *);
-#endif
-
-#if !defined(mingw32_HOST_OS)
-extern StgInt *signal_handlers;
-#endif
-extern void setIOManagerPipe (int fd);
-
-extern void* stgMallocBytesRWX(int len);
-
-/* -----------------------------------------------------------------------------
-   Storage manager stuff exported
-   -------------------------------------------------------------------------- */
-
-/* Prototype for an evacuate-like function */
-typedef void (*evac_fn)(StgClosure **);
-
-extern void performGC(void);
-extern void performMajorGC(void);
-extern void performGCWithRoots(void (*get_roots)(evac_fn));
-extern HsInt64 getAllocations( void );
-extern void revertCAFs( void );
-extern void dirty_MUT_VAR(StgRegTable *reg, StgClosure *p);
-
-#endif /*  RTSEXTERNAL_H */
diff --git a/ghc/includes/RtsFlags.h b/ghc/includes/RtsFlags.h
deleted file mode 100644
index 17d23638e7..0000000000
--- a/ghc/includes/RtsFlags.h
+++ /dev/null
@@ -1,357 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-1999
- *
- * Datatypes that holds the command-line flag settings.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef RTSFLAGS_H
-#define RTSFLAGS_H
-
-#include <stdio.h>
-
-/* For defaults, see the @initRtsFlagsDefaults@ routine. */
-
-struct GC_FLAGS {
-    FILE   *statsFile;
-    nat	    giveStats;
-#define NO_GC_STATS	 0
-#define COLLECT_GC_STATS 1
-#define ONELINE_GC_STATS 2
-#define SUMMARY_GC_STATS 3
-#define VERBOSE_GC_STATS 4
-
-    nat     maxStkSize;         /* in *words* */
-    nat     initialStkSize;     /* in *words* */
-
-    nat	    maxHeapSize;        /* in *blocks* */
-    nat     minAllocAreaSize;   /* in *blocks* */
-    nat     minOldGenSize;      /* in *blocks* */
-    nat     heapSizeSuggestion; /* in *blocks* */
-    double  oldGenFactor;
-    double  pcFreeHeap;
-
-    nat     generations;
-    nat     steps;
-    rtsBool squeezeUpdFrames;
-
-    rtsBool compact;		/* True <=> "compact all the time" */
-    double  compactThreshold;
-
-    rtsBool ringBell;
-    rtsBool frontpanel;
-
-    int idleGCDelayTicks;	/* in milliseconds */
-};
-
-struct DEBUG_FLAGS {  
-    /* flags to control debugging output & extra checking in various subsystems */
-    rtsBool scheduler;      /* 's' */
-    rtsBool interpreter;    /* 'i' */
-    rtsBool codegen;        /* 'c' */
-    rtsBool weak;           /* 'w' */
-    rtsBool gccafs;         /* 'G' */
-    rtsBool gc;             /* 'g' */
-    rtsBool block_alloc;    /* 'b' */
-    rtsBool sanity;         /* 'S'   warning: might be expensive! */
-    rtsBool stable;         /* 't' */
-    rtsBool prof;           /* 'p' */
-    rtsBool gran;           /* 'r' */
-    rtsBool par;            /* 'P' */
-    rtsBool linker;         /* 'l'   the object linker */
-    rtsBool apply;          /* 'a' */
-    rtsBool stm;            /* 'm' */
-    rtsBool squeeze;        /* 'z'  stack squeezing & lazy blackholing */
-};
-
-struct COST_CENTRE_FLAGS {
-    unsigned int	    doCostCentres;
-# define COST_CENTRES_SUMMARY	1
-# define COST_CENTRES_VERBOSE	2 /* incl. serial time profile */
-# define COST_CENTRES_ALL	3
-# define COST_CENTRES_XML       4
-
-    int	    profilerTicks;   /* derived */
-    int	    msecsPerTick;    /* derived */
-};
-
-struct PROFILING_FLAGS {
-    unsigned int	doHeapProfile;
-# define NO_HEAP_PROFILING	0	/* N.B. Used as indexes into arrays */
-# define HEAP_BY_CCS		1
-# define HEAP_BY_MOD		2
-# define HEAP_BY_DESCR		4
-# define HEAP_BY_TYPE		5
-# define HEAP_BY_RETAINER       6
-# define HEAP_BY_LDV            7
-
-# define HEAP_BY_INFOPTR        1      /* DEBUG only */
-# define HEAP_BY_CLOSURE_TYPE   2      /* DEBUG only */
-
-    nat                 profileInterval;      /* delta between samples (in ms) */
-    nat                 profileIntervalTicks; /* delta between samples (in 'ticks') */
-    rtsBool             includeTSOs;
-
-
-    rtsBool		showCCSOnException;
-
-    nat                 maxRetainerSetSize;
-
-    char*               modSelector;
-    char*               descrSelector;
-    char*               typeSelector;
-    char*               ccSelector;
-    char*               ccsSelector;
-    char*               retainerSelector;
-    char*               bioSelector;
-
-};
-
-struct CONCURRENT_FLAGS {
-    int ctxtSwitchTime;		/* in milliseconds */
-    int ctxtSwitchTicks;	/* derived */
-};
-
-#ifdef PAR
-/* currently the same as GRAN_STATS_FLAGS */
-struct PAR_STATS_FLAGS {
-  rtsBool Full;       /* Full .gr profile (rtsTrue) or only END events? */
-  rtsBool Suppressed; /* No .gr profile at all */
-  rtsBool Binary;     /* Binary profile? (not yet implemented) */
-  rtsBool Sparks;     /* Info on sparks in profile? */
-  rtsBool Heap;       /* Info on heap allocs in profile? */ 
-  rtsBool NewLogfile; /* Use new log-file format? (not yet implemented) */
-  rtsBool Global;     /* Global statistics? (printed on shutdown; no log file) */
-};
-
-struct PAR_DEBUG_FLAGS {  
-  /* flags to control debugging output in various subsystems */
-  rtsBool verbose    : 1; /*    1 */
-  rtsBool bq         : 1; /*    2 */
-  rtsBool schedule   : 1; /*    4 */
-  rtsBool free       : 1; /*    8 */
-  rtsBool resume     : 1; /*   16 */
-  rtsBool weight     : 1; /*   32 */
-  rtsBool fetch      : 1; /*   64 */
-  rtsBool fish       : 1; /*  128 */
-  rtsBool tables     : 1; /*  256 */
-  rtsBool packet     : 1; /*  512 */
-  rtsBool pack       : 1; /* 1024 */
-  rtsBool paranoia   : 1; /* 2048 */
-};
-
-#define MAX_PAR_DEBUG_OPTION     11
-#define PAR_DEBUG_MASK(n)        ((nat)(ldexp(1,n)))
-#define MAX_PAR_DEBUG_MASK       ((nat)(ldexp(1,(MAX_PAR_DEBUG_OPTION+1))-1))
-
-struct PAR_FLAGS {
-  struct PAR_STATS_FLAGS ParStats;  /* profile and stats output */
-  struct PAR_DEBUG_FLAGS Debug;         /* debugging options */
-  rtsBool  outputDisabled;	  /* Disable output for performance purposes */
-  rtsBool  doFairScheduling;	  /* Fair-ish scheduling (round robin; no time-slices) */
-  nat      packBufferSize;
-  nat      thunksToPack;          /* number of thunks in packet + 1 */ 
-  nat      globalising;           /* globalisation scheme */
-  nat	   maxLocalSparks;        /* spark pool size */
-  nat      maxThreads;            /* thread pool size */
-  nat      maxFishes;             /* max number of active fishes */
-  rtsTime  fishDelay;             /* delay before sending a new fish */
-  long   wait;
-};
-#endif /* PAR */
-
-#ifdef THREADED_RTS
-struct PAR_FLAGS {
-  nat            nNodes;         /* number of threads to run simultaneously */
-  rtsBool        migrate;        /* migrate threads between capabilities */
-  rtsBool        wakeupMigrate;  /* migrate a thread on wakeup */
-  unsigned int	 maxLocalSparks;
-};
-#endif /* THREADED_RTS */
-
-#ifdef GRAN
-struct GRAN_STATS_FLAGS {
-  rtsBool Full;       /* Full .gr profile (rtsTrue) or only END events? */
-  rtsBool Suppressed; /* No .gr profile at all */
-  rtsBool Binary;     /* Binary profile? (not yet implemented) */
-  rtsBool Sparks;     /* Info on sparks in profile? */
-  rtsBool Heap;       /* Info on heap allocs in profile? */ 
-  rtsBool NewLogfile; /* Use new log-file format? (not yet implemented) */
-  rtsBool Global;     /* Global statistics? (printed on shutdown; no log file) */
-};
-
-struct GRAN_COST_FLAGS {
-  /* Communication Cost Variables -- set in main program */
-  nat latency;              /* Latency for single packet */
-  nat additional_latency;   /* Latency for additional packets */
-  nat fetchtime;            
-  nat lunblocktime;         /* Time for local unblock */
-  nat gunblocktime;         /* Time for global unblock */
-  nat mpacktime;            /* Cost of creating a packet */     
-  nat munpacktime;	    /* Cost of receiving a packet */    
-  nat mtidytime;	    /* Cost of cleaning up after send */
-  
-  nat threadcreatetime;     /* Thread creation costs */
-  nat threadqueuetime;      /* Cost of adding a thread to the running/runnable queue */
-  nat threaddescheduletime; /* Cost of descheduling a thread */
-  nat threadscheduletime;   /* Cost of scheduling a thread */
-  nat threadcontextswitchtime;  /* Cost of context switch  */
-  
-  /* Instruction Costs */
-  nat arith_cost;        /* arithmetic instructions (+,i,< etc) */
-  nat branch_cost;       /* branch instructions */ 
-  nat load_cost;         /* load into register */
-  nat store_cost;        /* store into memory */
-  nat float_cost;        /* floating point operations */
-  
-  nat heapalloc_cost;    /* heap allocation costs */
-  
-  /* Overhead for granularity control mechanisms */
-  /* overhead per elem of spark queue */
-  nat pri_spark_overhead;
-  /* overhead per elem of thread queue */
-  nat pri_sched_overhead;
-};
-
-struct GRAN_DEBUG_FLAGS {  
-  /* flags to control debugging output in various subsystems */
-  rtsBool event_trace    : 1; /*    1 */
-  rtsBool event_stats    : 1; /*    2 */
-  rtsBool bq             : 1; /*    4 */
-  rtsBool pack           : 1; /*    8 */
-  rtsBool checkSparkQ    : 1; /*   16 */
-  rtsBool thunkStealing  : 1; /*   32 */
-  rtsBool randomSteal  	 : 1; /*   64 */
-  rtsBool findWork     	 : 1; /*  128 */
-  rtsBool unused     	 : 1; /*  256 */
-  rtsBool pri     	 : 1; /*  512 */
-  rtsBool checkLight   	 : 1; /* 1024 */
-  rtsBool sortedQ      	 : 1; /* 2048 */
-  rtsBool blockOnFetch   : 1; /* 4096 */
-  rtsBool packBuffer     : 1; /* 8192 */
-  rtsBool blockOnFetch_sanity : 1; /*  16384 */
-};
-
-#define MAX_GRAN_DEBUG_OPTION     14
-#define GRAN_DEBUG_MASK(n)        ((nat)(ldexp(1,n)))
-#define MAX_GRAN_DEBUG_MASK       ((nat)(ldexp(1,(MAX_GRAN_DEBUG_OPTION+1))-1))
-
-struct GRAN_FLAGS {
-  struct GRAN_STATS_FLAGS GranSimStats;  /* profile and stats output */
-  struct GRAN_COST_FLAGS Costs;          /* cost metric for simulation */
-  struct GRAN_DEBUG_FLAGS Debug;         /* debugging options */
-
-  nat  maxThreads;              /* ToDo: share with THREADED_RTS and GUM */
-  /* rtsBool labelling; */
-  nat  packBufferSize;
-  nat  packBufferSize_internal;
-
-  PEs proc;                     /* number of processors */
-  rtsBool Fishing;              /* Simulate GUM style fishing mechanism? */
-  nat maxFishes;                /* max number of spark or thread steals */
-  rtsTime time_slice;           /* max time slice of one reduction thread */
-
-    /* GrAnSim-Light: This version puts no bound on the number of
-         processors but in exchange doesn't model communication costs
-         (all communication is 0 cost). Mainly intended to show maximal
-         degree of parallelism in the program (*not* to simulate the
-         execution on a real machine). */
-   
-    rtsBool Light;
-
-    rtsBool DoFairSchedule ;        /* fair scheduling alg? default: unfair */
-    rtsBool DoAsyncFetch;           /* async. communication? */
-    rtsBool DoStealThreadsFirst;    /* prefer threads over sparks when stealing */
-  rtsBool DoAlwaysCreateThreads;  /* eager thread creation */
-  rtsBool DoBulkFetching;         /* bulk fetching */
-  rtsBool DoThreadMigration;      /* allow to move threads */
-  nat     FetchStrategy;         /* what to do when waiting for data */
-  rtsBool PreferSparksOfLocalNodes; /* prefer local over global sparks */
-  rtsBool DoPrioritySparking;     /* sparks sorted by priorities */
-  rtsBool DoPriorityScheduling;   /* threads sorted by priorities */
-  nat     SparkPriority;         /* threshold for cut-off mechanism */
-  nat     SparkPriority2;
-  rtsBool RandomPriorities;
-  rtsBool InversePriorities;
-  rtsBool IgnorePriorities;
-  nat     ThunksToPack;      /* number of thunks in packet + 1 */ 
-  rtsBool RandomSteal;        /* steal spark/thread from random proc */
-  rtsBool NoForward;        /* no forwarding of fetch messages */
-
-  /* unsigned int	    debug; */
-  /*  rtsBool event_trace; */
-  /*  rtsBool event_trace_all; */
-};
-#endif /* GRAN */
-
-struct TICKY_FLAGS {
-    rtsBool showTickyStats;
-    FILE   *tickyFile;
-};
-
-
-/* Put them together: */
-
-typedef struct _RTS_FLAGS {
-    /* The first portion of RTS_FLAGS is invariant. */
-    struct GC_FLAGS	     GcFlags;
-    struct CONCURRENT_FLAGS  ConcFlags;
-    struct DEBUG_FLAGS	     DebugFlags;
-    struct COST_CENTRE_FLAGS CcFlags;
-    struct PROFILING_FLAGS   ProfFlags;
-    struct TICKY_FLAGS	     TickyFlags;
-
-#if defined(THREADED_RTS) || defined(PAR)
-    struct PAR_FLAGS	ParFlags;
-#endif
-#ifdef GRAN
-    struct GRAN_FLAGS	GranFlags;
-#endif
-} RTS_FLAGS;
-
-#ifdef COMPILING_RTS_MAIN
-extern DLLIMPORT RTS_FLAGS RtsFlags;
-#elif IN_STG_CODE
-/* Hack because the C code generator can't generate '&label'. */
-extern RTS_FLAGS RtsFlags[];
-#else
-extern RTS_FLAGS RtsFlags;
-#endif
-
-/* Routines that operate-on/to-do-with RTS flags: */
-
-extern void initRtsFlagsDefaults(void);
-extern void setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[]);
-extern void setProgName(char *argv[]);
-
-
-/*
- * The printf formats are here, so we are less likely to make
- * overly-long filenames (with disastrous results).  No more than 128
- * chars, please!  
- */
-
-#define STATS_FILENAME_MAXLEN	128
-
-#define GR_FILENAME_FMT		"%0.124s.gr"
-#define GR_FILENAME_FMT_GUM	"%0.120s.%03d.%s"
-#define HP_FILENAME_FMT		"%0.124s.hp"
-#define LIFE_FILENAME_FMT	"%0.122s.life"
-#define PROF_FILENAME_FMT	"%0.122s.prof"
-#define PROF_FILENAME_FMT_GUM	"%0.118s.%03d.prof"
-#define QP_FILENAME_FMT		"%0.124s.qp"
-#define STAT_FILENAME_FMT	"%0.122s.stat"
-#define TICKY_FILENAME_FMT	"%0.121s.ticky"
-#define TIME_FILENAME_FMT	"%0.122s.time"
-#define TIME_FILENAME_FMT_GUM	"%0.118s.%03d.time"
-
-/* an "int" so as to match normal "argc" */
-/* Now defined in Stg.h (lib/std/cbits need these too.)
-extern int     prog_argc;
-extern char  **prog_argv;
-*/
-extern int     rts_argc;  /* ditto */
-extern char   *rts_argv[];
-
-#endif	/* RTSFLAGS_H */
diff --git a/ghc/includes/RtsMessages.h b/ghc/includes/RtsMessages.h
deleted file mode 100644
index 3f0da3d7ed..0000000000
--- a/ghc/includes/RtsMessages.h
+++ /dev/null
@@ -1,76 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Message API for use inside the RTS.  All messages generated by the
- * RTS should go through one of the functions declared here, and we
- * also provide hooks so that messages from the RTS can be redirected
- * as appropriate.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef RTSMESSAGES_H
-#define RTSMESSAGES_H
-
-#include <stdarg.h>
-
-/* -----------------------------------------------------------------------------
- * Message generation
- * -------------------------------------------------------------------------- */
-
-/*
- * A fatal internal error: this is for errors that probably indicate
- * bugs in the RTS or compiler.  We normally output bug reporting
- * instructions along with the error message.
- *
- * barf() invokes (*fatalInternalErrorFn)().  This function is not
- * expected to return.
- */
-extern void barf(char *s, ...)
-   GNUC3_ATTRIBUTE(__noreturn__);
-
-extern void vbarf(char *s, va_list ap)
-   GNUC3_ATTRIBUTE(__noreturn__);
-
-extern void _assertFail(char *filename, unsigned int linenum)
-   GNUC3_ATTRIBUTE(__noreturn__);
-
-/*
- * An error condition which is caused by and/or can be corrected by
- * the user.
- *
- * errorBelch() invokes (*errorMsgFn)().
- */
-extern void errorBelch(char *s, ...)
-   GNUC3_ATTRIBUTE(format (printf, 1, 2));
-
-extern void verrorBelch(char *s, va_list ap);
-
-/*
- * A debugging message.  Debugging messages are generated either as a
- * virtue of having DEBUG turned on, or by being explicitly selected
- * via RTS options (eg. +RTS -Ds).
- *
- * debugBelch() invokes (*debugMsgFn)().
- */
-extern void debugBelch(char *s, ...)
-   GNUC3_ATTRIBUTE(format (printf, 1, 2));
-
-extern void vdebugBelch(char *s, va_list ap);
-
-
-/* Hooks for redirecting message generation: */
-
-typedef void RtsMsgFunction(char *, va_list);
-
-extern RtsMsgFunction *fatalInternalErrorFn;
-extern RtsMsgFunction *debugMsgFn;
-extern RtsMsgFunction *errorMsgFn;
-
-/* Default stdio implementation of the message hooks: */
-
-extern RtsMsgFunction rtsFatalInternalErrorFn;
-extern RtsMsgFunction rtsDebugMsgFn;
-extern RtsMsgFunction rtsErrorMsgFn;
-
-#endif /* RTSMESSAGES_H */
diff --git a/ghc/includes/RtsTypes.h b/ghc/includes/RtsTypes.h
deleted file mode 100644
index 9e8c7b847b..0000000000
--- a/ghc/includes/RtsTypes.h
+++ /dev/null
@@ -1,88 +0,0 @@
-/*
-  Time-stamp: <2005-03-30 12:02:33 simonmar>
-
-  RTS specific types.
-*/
-
-/* -------------------------------------------------------------------------
-   Generally useful typedefs
-   ------------------------------------------------------------------------- */
-
-#ifndef RTS_TYPES_H
-#define RTS_TYPES_H
-
-typedef unsigned int  nat;           /* at least 32 bits (like int) */
-typedef unsigned long lnat;          /* at least 32 bits            */
-#ifndef _MSC_VER
-typedef unsigned long long ullong;   /* at least 32 bits            */
-typedef long long llong;
-#else
-typedef unsigned __int64   ullong;   /* at least 32 bits            */
-typedef __int64 llong;
-#endif
-
-/* ullong (64|128-bit) type: only include if needed (not ANSI) */
-#if defined(__GNUC__) 
-#define LL(x) (x##LL)
-#else
-#define LL(x) (x##L)
-#endif
-  
-typedef enum { 
-    rtsFalse = 0, 
-    rtsTrue 
-} rtsBool;
-
-/* 
-   Types specific to the parallel runtime system.
-*/
-
-typedef ullong        rtsTime;
-
-#if defined(PAR)
-/* types only needed in the parallel system */
-typedef struct hashtable ParHashTable;
-typedef struct hashlist ParHashList;
-
-/* typedef double REAL_TIME; */
-/* typedef W_ TIME; */
-/* typedef GlobalTaskId Proc; */
-typedef int           GlobalTaskId;
-typedef GlobalTaskId  PEs;
-typedef unsigned int  rtsWeight;
-typedef int           rtsPacket;
-typedef int           OpCode;
-
-/* Global addresses i.e. unique ids in a parallel setup; needed in Closures.h*/
-typedef struct {
-  union {
-    StgPtr plc;
-    struct {
-      GlobalTaskId gtid;
-      int slot;
-    } gc;
-  } payload;
-  rtsWeight weight;
-} globalAddr;
-
-/* (GA, LA) pairs */
-typedef struct gala {
-    globalAddr ga;
-    StgPtr la;
-    struct gala *next;
-    rtsBool preferred;
-} GALA;
-
-#elif defined(GRAN)
-
-/*
- * GlobalTaskId is dummy in GranSim;
- * we define it to have cleaner code in the RTS
- */
-typedef int       GlobalTaskId;
-typedef lnat      rtsTime;
-typedef StgWord   PEs;
-
-#endif
-
-#endif /* RTS_TYPES_H */
diff --git a/ghc/includes/SMP.h b/ghc/includes/SMP.h
deleted file mode 100644
index 5974c962ad..0000000000
--- a/ghc/includes/SMP.h
+++ /dev/null
@@ -1,160 +0,0 @@
-/* ----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2005
- *
- * Macros for THREADED_RTS support
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef SMP_H
-#define SMP_H
-
-/* THREADED_RTS is currently not compatible with the following options:
- *
- *      PROFILING (but only 1 CPU supported)
- *      TICKY_TICKY
- *      Unregisterised builds are ok, but only 1 CPU supported.
- */
-
-#if defined(THREADED_RTS)
-
-#if  defined(TICKY_TICKY)
-#error Build options incompatible with THREADED_RTS.
-#endif
-
-/* 
- * XCHG - the atomic exchange instruction.  Used for locking closures
- * during updates (see lockClosure() below) and the MVar primops.
- *
- * NB: the xchg instruction is implicitly locked, so we do not need
- * a lock prefix here. 
- */
-INLINE_HEADER StgWord
-xchg(StgPtr p, StgWord w)
-{
-    StgWord result;
-#if i386_HOST_ARCH || x86_64_HOST_ARCH
-    result = w;
-    __asm__ __volatile__ (
- 	  "xchg %1,%0"
-          :"+r" (result), "+m" (*p)
-          : /* no input-only operands */
-	);
-#elif powerpc_HOST_ARCH
-    __asm__ __volatile__ (
-        "1:     lwarx     %0, 0, %2\n"
-        "       stwcx.    %1, 0, %2\n"
-        "       bne-      1b"
-        :"=r" (result)
-        :"r" (w), "r" (p)
-    );
-#else
-#error xchg() unimplemented on this architecture
-#endif
-    return result;
-}
-
-/* 
- * CMPXCHG - the single-word atomic compare-and-exchange instruction.  Used 
- * in the STM implementation.
- */
-INLINE_HEADER StgWord
-cas(StgVolatilePtr p, StgWord o, StgWord n)
-{
-#if i386_HOST_ARCH || x86_64_HOST_ARCH
-    __asm__ __volatile__ (
- 	  "lock/cmpxchg %3,%1"
-          :"=a"(o), "=m" (*(volatile unsigned int *)p) 
-          :"0" (o), "r" (n));
-    return o;
-#elif powerpc_HOST_ARCH
-    StgWord result;
-    __asm__ __volatile__ (
-        "1:     lwarx     %0, 0, %3\n"
-        "       cmpw      %0, %1\n"
-        "       bne       2f\n"
-        "       stwcx.    %2, 0, %3\n"
-        "       bne-      1b\n"
-        "2:"
-        :"=r" (result)
-        :"r" (o), "r" (n), "r" (p)
-    );
-    return result;
-#else
-#error cas() unimplemented on this architecture
-#endif
-}
-
-/*
- * Write barrier - ensure that all preceding writes have happened
- * before all following writes.  
- *
- * We need to tell both the compiler AND the CPU about the barrier.
- * This is a brute force solution; better results might be obtained by
- * using volatile type declarations to get fine-grained ordering
- * control in C, and optionally a memory barrier instruction on CPUs
- * that require it (not x86 or x86_64).
- */
-INLINE_HEADER void
-wb(void) {
-#if i386_HOST_ARCH || x86_64_HOST_ARCH
-    __asm__ __volatile__ ("" : : : "memory");
-#elif powerpc_HOST_ARCH
-    __asm__ __volatile__ ("lwsync" : : : "memory");
-#else
-#error memory barriers unimplemented on this architecture
-#endif
-}
-
-/*
- * Locking/unlocking closures
- *
- * This is used primarily in the implementation of MVars.
- */
-#define SPIN_COUNT 4000
-
-INLINE_HEADER StgInfoTable *
-lockClosure(StgClosure *p)
-{
-#if i386_HOST_ARCH || x86_64_HOST_ARCH || powerpc_HOST_ARCH
-    StgWord info;
-    do {
-	nat i = 0;
-	do {
-	    info = xchg((P_)(void *)&p->header.info, (W_)&stg_WHITEHOLE_info);
-	    if (info != (W_)&stg_WHITEHOLE_info) return (StgInfoTable *)info;
-	} while (++i < SPIN_COUNT);
-	yieldThread();
-    } while (1);
-#else
-   ACQUIRE_SM_LOCK
-#endif
-}
-
-INLINE_HEADER void
-unlockClosure(StgClosure *p, StgInfoTable *info)
-{
-#if i386_HOST_ARCH || x86_64_HOST_ARCH || powerpc_HOST_ARCH
-    // This is a strictly ordered write, so we need a wb():
-    wb();
-    p->header.info = info;
-#else
-    RELEASE_SM_LOCK;
-#endif
-}
-
-#else /* !THREADED_RTS */
-
-#define wb() /* nothing */
-
-INLINE_HEADER StgWord
-xchg(StgPtr p, StgWord w)
-{
-    StgWord old = *p;
-    *p = w;
-    return old;
-}
-
-#endif /* !THREADED_RTS */
-
-#endif /* SMP_H */
diff --git a/ghc/includes/STM.h b/ghc/includes/STM.h
deleted file mode 100644
index 4c2b109f73..0000000000
--- a/ghc/includes/STM.h
+++ /dev/null
@@ -1,237 +0,0 @@
-/*----------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * STM interface definition
- *
- *----------------------------------------------------------------------
-
-  STM.h defines the C-level interface to the STM.  
-
-  The design follows that of the PPoPP 2005 paper "Composable memory
-  transactions" extended to include fine-grained locking of TVars.
-
-  Three different implementations can be built.  In overview:
-  
-  STM_UNIPROC  -- no locking at all: not safe for concurrent invocations
- 
-  STM_CG_LOCK  -- coarse-grained locking : a single mutex protects all
-                  TVars
- 
-  STM_FG_LOCKS -- per-TVar exclusion : each TVar can be owned by at
-                  most one TRec at any time.  This allows dynamically
-                  non-conflicting transactions to commit in parallel.
-                  The implementation treats reads optimisitcally --
-                  extra versioning information is retained in the 
-                  saw_update_by field of the TVars so that they do not 
-                  need to be locked for reading.
-
-  STM.C contains more details about the locking schemes used.
-
-*/
-
-#ifndef STM_H
-#define STM_H
-
-#ifdef THREADED_RTS
-//#define STM_CG_LOCK
-#define STM_FG_LOCKS
-#else
-#define STM_UNIPROC
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/*----------------------------------------------------------------------
-
-   GC interaction
-   --------------
-*/
-
-extern void stmPreGCHook(void);
-
-/*----------------------------------------------------------------------
-
-   Transaction context management
-   ------------------------------
-
-*/
-
-/* Create and enter a new transaction context */
-
-extern StgTRecHeader *stmStartTransaction(Capability *cap, StgTRecHeader *outer);
-extern StgTRecHeader *stmStartNestedTransaction(Capability *cap, StgTRecHeader *outer
-);
-
-/*
- * Exit the current transaction context, abandoning any read/write
- * operations performed within it and removing the thread from any
- * tvar wait queues if it was waitin.  Note that if nested transactions
- * are not fully supported then this may leave the enclosing
- * transaction contexts doomed to abort.
- */
-
-extern void stmAbortTransaction(Capability *cap, StgTRecHeader *trec);
-
-/*
- * Ensure that a subsequent commit / validation will fail.  We use this 
- * in our current handling of transactions that may have become invalid
- * and started looping.  We strip their stack back to the ATOMICALLY_FRAME,
- * and, when the thread is next scheduled, discover it to be invalid and
- * re-execute it.  However, we need to force the transaction to stay invalid
- * in case other threads' updates make it valid in the mean time.
- */
-
-extern void stmCondemnTransaction(Capability *cap, StgTRecHeader *trec);
-
-/*
- * Return the trec within which the specified trec was created (not
- * valid if trec==NO_TREC).
- */
-
-extern StgTRecHeader *stmGetEnclosingTRec(StgTRecHeader *trec);
-
-/*----------------------------------------------------------------------
-
-   Validation
-   ----------
-
-  Test whether the specified transaction record, and all those within which
-  it is nested, are still valid.
-
-  Note: the caller can assume that once stmValidateTransaction has
-  returned FALSE for a given trec then that transaction will never
-  again be valid -- we rely on this in Schedule.c when kicking invalid
-  threads at GC (in case they are stuck looping)
-*/
-
-extern StgBool stmValidateNestOfTransactions(StgTRecHeader *trec);
-
-/*----------------------------------------------------------------------
-
-   Commit/wait/rewait operations
-   -----------------------------
-
-   These four operations return boolean results which should be interpreted
-   as follows:
-
-   true  => The transaction record was definitely valid 
-
-   false => The transaction record may not have been valid
-
-   Note that, for nested operations, validity here is solely in terms
-   of the specified trec: it does not say whether those that it may be
-   nested are themselves valid.  Callers can check this with 
-   stmValidateNestOfTransactions.
-
-   The user of the STM should ensure that it is always safe to assume that a
-   transaction context is not valid when in fact it is (i.e. to return false in
-   place of true, with side-effects as defined below).  This may cause
-   needless retries of transactions (in the case of validate and commit), or it
-   may cause needless spinning instead of blocking (in the case of wait and
-   rewait).
-
-   In defining the behaviour of wait and rewait we distinguish between two
-   different aspects of a thread's runnability:
-
-    - We say that a thread is "blocked" when it is not running or
-      runnable as far as the scheduler is concerned.
-
-    - We say that a thread is "waiting" when its StgTRecHeader is linked on an
-      tvar's wait queue.
-
-   Considering only STM operations, (blocked) => (waiting).  The user of the STM
-   should ensure that they are prepared for threads to be unblocked spuriously
-   and for wait/reWait to return false even when the previous transaction context
-   is actually still valid.
-*/
-
-/*
- * Test whether the current transaction context is valid and, if so,
- * commit its memory accesses to the heap.  stmCommitTransaction must
- * unblock any threads which are waiting on tvars that updates have
- * been committed to.
- */
-
-extern StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec);
-extern StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec);
-
-/*
- * Test whether the current transaction context is valid and, if so,
- * start the thread waiting for updates to any of the tvars it has
- * ready from and mark it as blocked.  It is an error to call stmWait
- * if the thread is already waiting.  
- */
-
-extern StgBool stmWait(Capability *cap,
-                       StgTSO *tso, 
-                       StgTRecHeader *trec);
-
-extern void stmWaitUnlock(Capability *cap, StgTRecHeader *trec);
-
-/*
- * Test whether the current transaction context is valid and, if so,
- * leave the thread waiting and mark it as blocked again.  If the
- * transaction context is no longer valid then stop the thread waiting
- * and leave it as unblocked.  It is an error to call stmReWait if the
- * thread is not waiting.
- */
-
-extern StgBool stmReWait(Capability *cap, StgTSO *tso);
-
-/*----------------------------------------------------------------------
-
-   TVar management operations
-   --------------------------
-*/
-
-extern StgTVar *stmNewTVar(Capability *cap,
-                           StgClosure *new_value);
-
-/*----------------------------------------------------------------------
-
-   Data access operations
-   ----------------------
-*/
-
-/*
- * Return the logical contents of 'tvar' within the context of the
- * thread's current transaction.
- */
-
-extern StgClosure *stmReadTVar(Capability *cap,
-                               StgTRecHeader *trec, 
-			       StgTVar *tvar);
-
-/* Update the logical contents of 'tvar' within the context of the
- * thread's current transaction.
- */
-
-extern void stmWriteTVar(Capability *cap,
-                         StgTRecHeader *trec,
-			 StgTVar *tvar, 
-			 StgClosure *new_value);
-
-/*----------------------------------------------------------------------*/
-
-/* NULLs */
-
-#define END_STM_WAIT_QUEUE ((StgTVarWaitQueue *)(void *)&stg_END_STM_WAIT_QUEUE_closure)
-#define END_STM_CHUNK_LIST ((StgTRecChunk *)(void *)&stg_END_STM_CHUNK_LIST_closure)
-
-#if IN_STG_CODE
-#define NO_TREC (stg_NO_TREC_closure)
-#else
-#define NO_TREC ((StgTRecHeader *)(void *)&stg_NO_TREC_closure)
-#endif
-
-/*----------------------------------------------------------------------*/
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* STM_H */
-
diff --git a/ghc/includes/SchedAPI.h b/ghc/includes/SchedAPI.h
deleted file mode 100644
index 8dff6ea63d..0000000000
--- a/ghc/includes/SchedAPI.h
+++ /dev/null
@@ -1,36 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1998-2002
- *
- * External API for the scheduler.  For most uses, the functions in
- * RtsAPI.h should be enough.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef SCHEDAPI_H
-#define SCHEDAPI_H
-
-#if defined(GRAN)
-/* Dummy def for NO_PRI if not in GranSim */
-#define NO_PRI  0
-#endif
-
-/* 
- * Creating threads
- */
-#if defined(GRAN)
-StgTSO *createThread (Capability *cap, nat stack_size, StgInt pri);
-#else
-StgTSO *createThread (Capability *cap, nat stack_size);
-#endif
-
-Capability *scheduleWaitThread (StgTSO *tso, /*out*/HaskellObj* ret,
-				Capability *cap);
-
-StgTSO *createGenThread       (Capability *cap, nat stack_size,  
-			       StgClosure *closure);
-StgTSO *createIOThread        (Capability *cap, nat stack_size,  
-			       StgClosure *closure);
-StgTSO *createStrictIOThread  (Capability *cap, nat stack_size,  
-			       StgClosure *closure);
-#endif
diff --git a/ghc/includes/Signals.h b/ghc/includes/Signals.h
deleted file mode 100644
index a5907bbee9..0000000000
--- a/ghc/includes/Signals.h
+++ /dev/null
@@ -1,18 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * RTS signal handling 
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef SIGNALS_H
-#define SIGNALS_H
-
-#define STG_SIG_DFL   (-1)
-#define STG_SIG_IGN   (-2)
-#define STG_SIG_ERR   (-3)
-#define STG_SIG_HAN   (-4)
-#define STG_SIG_RST   (-5)
-
-#endif /* SIGNALS_H */
diff --git a/ghc/includes/Stable.h b/ghc/includes/Stable.h
deleted file mode 100644
index ca2e72118a..0000000000
--- a/ghc/includes/Stable.h
+++ /dev/null
@@ -1,66 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Stable Pointers: A stable pointer is represented as an index into
- * the stable pointer table in the low BITS_PER_WORD-8 bits with a
- * weight in the upper 8 bits.
- *
- * SUP: StgStablePtr used to be a synonym for StgWord, but stable pointers
- * are guaranteed to be void* on the C-side, so we have to do some occasional
- * casting. Size is not a matter, because StgWord is always the same size as
- * a void*.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef STABLE_H
-#define STABLE_H
-
-/* -----------------------------------------------------------------------------
-   External C Interface
-   -------------------------------------------------------------------------- */
-
-extern StgPtr         deRefStablePtr(StgStablePtr stable_ptr);
-extern void           freeStablePtr(StgStablePtr sp);
-extern StgStablePtr   splitStablePtr(StgStablePtr sp);
-extern StgStablePtr   getStablePtr(StgPtr p);
-
-/* -----------------------------------------------------------------------------
-   PRIVATE from here.
-   -------------------------------------------------------------------------- */
-
-typedef struct { 
-  StgPtr  addr;			/* Haskell object, free list, or NULL */
-  StgPtr  old;			/* old Haskell object, used during GC */
-  StgWord ref;			/* used for reference counting */
-  StgClosure *sn_obj;		/* the StableName object (or NULL) */
-} snEntry;
-
-extern DLL_IMPORT_RTS snEntry *stable_ptr_table;
-
-extern void freeStablePtr(StgStablePtr sp);
-
-#if defined(__GNUC__)
-# ifndef RTS_STABLE_C
-extern inline
-# endif
-StgPtr deRefStablePtr(StgStablePtr sp)
-{
-    ASSERT(stable_ptr_table[(StgWord)sp].ref > 0);
-    return stable_ptr_table[(StgWord)sp].addr;
-}
-#else
-/* No support for 'extern inline' */
-extern StgPtr deRefStablePtr(StgStablePtr sp);
-#endif
-
-extern void    initStablePtrTable    ( void );
-extern void    enlargeStablePtrTable ( void );
-extern StgWord lookupStableName      ( StgPtr p );
-
-extern void    markStablePtrTable    ( evac_fn evac );
-extern void    threadStablePtrTable  ( evac_fn evac );
-extern void    gcStablePtrTable      ( void );
-extern void    updateStablePtrTable  ( rtsBool full );
-
-#endif
diff --git a/ghc/includes/Stg.h b/ghc/includes/Stg.h
deleted file mode 100644
index a63b7ec2d6..0000000000
--- a/ghc/includes/Stg.h
+++ /dev/null
@@ -1,461 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Top-level include file for everything STG-ish.  
- *
- * This file is included *automatically* by all .hc files.
- *
- * NOTE: always include Stg.h *before* any other headers, because we
- * define some register variables which must be done before any inline
- * functions are defined (some system headers have been known to
- * define the odd inline function).
- *
- * We generally try to keep as little visible as possible when
- * compiling .hc files.  So for example the definitions of the
- * InfoTable structs, closure structs and other RTS types are not
- * visible here.  The compiler knows enough about the representations
- * of these types to generate code which manipulates them directly
- * with pointer arithmetic.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef STG_H
-#define STG_H
-
-
-/* If we include "Stg.h" directly, we're in STG code, and we therefore
- * get all the global register variables, macros etc. that go along
- * with that.  If "Stg.h" is included via "Rts.h", we're assumed to
- * be in vanilla C.
- */
-#ifndef IN_STG_CODE
-# define IN_STG_CODE 1
-#endif
-
-#if IN_STG_CODE == 0
-# define NO_GLOBAL_REG_DECLS	/* don't define fixed registers */
-#endif
-
-/* Configuration */
-#include "ghcconfig.h"
-#include "RtsConfig.h"
-
-/* -----------------------------------------------------------------------------
-   Useful definitions
-   -------------------------------------------------------------------------- */
-
-/*
- * The C backend like to refer to labels by just mentioning their
- * names.  Howevver, when a symbol is declared as a variable in C, the
- * C compiler will implicitly dereference it when it occurs in source.
- * So we must subvert this behaviour for .hc files by declaring
- * variables as arrays, which eliminates the implicit dereference.
- */
-#if IN_STG_CODE
-#define RTS_VAR(x) (x)[]
-#define RTS_DEREF(x) (*(x))
-#else
-#define RTS_VAR(x) x
-#define RTS_DEREF(x) x
-#endif
-
-/* bit macros
- */
-#define BITS_PER_BYTE 8
-#define BITS_IN(x) (BITS_PER_BYTE * sizeof(x))
-
-/*
- * 'Portable' inlining
- */
-#if defined(__GNUC__) || defined( __INTEL_COMPILER)
-# define INLINE_HEADER static inline
-# define INLINE_ME inline
-# define STATIC_INLINE INLINE_HEADER
-#elif defined(_MSC_VER)
-# define INLINE_HEADER __inline static
-# define INLINE_ME __inline
-# define STATIC_INLINE INLINE_HEADER
-#else
-# error "Don't know how to inline functions with your C compiler."
-#endif
-
-/*
- * GCC attributes
- */
-#if defined(__GNUC__)
-#define GNU_ATTRIBUTE(at) __attribute__((at))
-#else
-#define GNU_ATTRIBUTE(at)
-#endif
-
-#if __GNUC__ >= 3 
-#define GNUC3_ATTRIBUTE(at) __attribute__((at))
-#else
-#define GNUC3_ATTRIBUTE(at)
-#endif
-
-#define STG_UNUSED    GNUC3_ATTRIBUTE(__unused__)
-
-/* -----------------------------------------------------------------------------
-   Global type definitions
-   -------------------------------------------------------------------------- */
-
-#include "MachDeps.h"
-#include "StgTypes.h"
-
-/* -----------------------------------------------------------------------------
-   Shorthand forms
-   -------------------------------------------------------------------------- */
-
-typedef StgChar		C_;
-typedef StgWord		W_;
-typedef StgWord*	P_;
-typedef P_*		PP_;
-typedef StgInt		I_;
-typedef StgAddr	        A_;
-typedef const StgWord*  D_;
-typedef StgFunPtr       F_;
-typedef StgByteArray    B_;
-typedef StgClosurePtr   L_;
-
-typedef StgInt64        LI_;
-typedef StgWord64       LW_;
-
-#define IF_(f)		static F_ GNUC3_ATTRIBUTE(used) f(void) 
-#define FN_(f)		F_ f(void)
-#define EF_(f)		extern F_ f(void)
-
-typedef StgWord StgWordArray[];
-#define EI_             extern StgWordArray
-#define II_             static StgWordArray
-
-/* -----------------------------------------------------------------------------
-   Tail calls
-
-   This needs to be up near the top as the register line on alpha needs
-   to be before all procedures (inline & out-of-line).
-   -------------------------------------------------------------------------- */
-
-#include "TailCalls.h"
-
-/* -----------------------------------------------------------------------------
-   Other Stg stuff...
-   -------------------------------------------------------------------------- */
-
-#include "StgDLL.h"
-#include "MachRegs.h"
-#include "Regs.h"
-#include "StgProf.h"  /* ToDo: separate out RTS-only stuff from here */
-
-#if IN_STG_CODE
-/*
- * This is included later for RTS sources, after definitions of
- * StgInfoTable, StgClosure and so on. 
- */
-#include "StgMiscClosures.h"
-#endif
-
-/* RTS external interface */
-#include "RtsExternal.h"
-
-/* -----------------------------------------------------------------------------
-   Moving Floats and Doubles
-
-   ASSIGN_FLT is for assigning a float to memory (usually the
-              stack/heap).  The memory address is guaranteed to be
-	      StgWord aligned (currently == sizeof(void *)).
-
-   PK_FLT     is for pulling a float out of memory.  The memory is
-              guaranteed to be StgWord aligned.
-   -------------------------------------------------------------------------- */
-
-INLINE_HEADER void	  ASSIGN_FLT (W_ [], StgFloat);
-INLINE_HEADER StgFloat    PK_FLT     (W_ []);
-
-#if ALIGNMENT_FLOAT <= ALIGNMENT_LONG
-
-INLINE_HEADER void     ASSIGN_FLT(W_ p_dest[], StgFloat src) { *(StgFloat *)p_dest = src; }
-INLINE_HEADER StgFloat PK_FLT    (W_ p_src[])                { return *(StgFloat *)p_src; }
-
-#else  /* ALIGNMENT_FLOAT > ALIGNMENT_UNSIGNED_INT */
-
-INLINE_HEADER void ASSIGN_FLT(W_ p_dest[], StgFloat src)
-{
-    float_thing y;
-    y.f = src;
-    *p_dest = y.fu;
-}
-
-INLINE_HEADER StgFloat PK_FLT(W_ p_src[])
-{
-    float_thing y;
-    y.fu = *p_src;
-    return(y.f);
-}
-
-#endif /* ALIGNMENT_FLOAT > ALIGNMENT_LONG */
-
-#if ALIGNMENT_DOUBLE <= ALIGNMENT_LONG
-
-INLINE_HEADER void	  ASSIGN_DBL (W_ [], StgDouble);
-INLINE_HEADER StgDouble   PK_DBL     (W_ []);
-
-INLINE_HEADER void      ASSIGN_DBL(W_ p_dest[], StgDouble src) { *(StgDouble *)p_dest = src; }
-INLINE_HEADER StgDouble PK_DBL    (W_ p_src[])                 { return *(StgDouble *)p_src; }
-
-#else	/* ALIGNMENT_DOUBLE > ALIGNMENT_LONG */
-
-/* Sparc uses two floating point registers to hold a double.  We can
- * write ASSIGN_DBL and PK_DBL by directly accessing the registers
- * independently - unfortunately this code isn't writable in C, we
- * have to use inline assembler.
- */
-#if sparc_HOST_ARCH
-
-#define ASSIGN_DBL(dst0,src) \
-    { StgPtr dst = (StgPtr)(dst0); \
-      __asm__("st %2,%0\n\tst %R2,%1" : "=m" (((P_)(dst))[0]), \
-	"=m" (((P_)(dst))[1]) : "f" (src)); \
-    }
-
-#define PK_DBL(src0) \
-    ( { StgPtr src = (StgPtr)(src0); \
-        register double d; \
-      __asm__("ld %1,%0\n\tld %2,%R0" : "=f" (d) : \
-	"m" (((P_)(src))[0]), "m" (((P_)(src))[1])); d; \
-    } )
-
-#else /* ! sparc_HOST_ARCH */
-
-INLINE_HEADER void	  ASSIGN_DBL (W_ [], StgDouble);
-INLINE_HEADER StgDouble   PK_DBL     (W_ []);
-
-typedef struct
-  { StgWord dhi;
-    StgWord dlo;
-  } unpacked_double;
-
-typedef union
-  { StgDouble d;
-    unpacked_double du;
-  } double_thing;
-
-INLINE_HEADER void ASSIGN_DBL(W_ p_dest[], StgDouble src)
-{
-    double_thing y;
-    y.d = src;
-    p_dest[0] = y.du.dhi;
-    p_dest[1] = y.du.dlo;
-}
-
-/* GCC also works with this version, but it generates
-   the same code as the previous one, and is not ANSI
-
-#define ASSIGN_DBL( p_dest, src ) \
-	*p_dest = ((double_thing) src).du.dhi; \
-	*(p_dest+1) = ((double_thing) src).du.dlo \
-*/
-
-INLINE_HEADER StgDouble PK_DBL(W_ p_src[])
-{
-    double_thing y;
-    y.du.dhi = p_src[0];
-    y.du.dlo = p_src[1];
-    return(y.d);
-}
-
-#endif /* ! sparc_HOST_ARCH */
-
-#endif /* ALIGNMENT_DOUBLE > ALIGNMENT_UNSIGNED_INT */
-
-
-/* -----------------------------------------------------------------------------
-   Moving 64-bit quantities around
-
-   ASSIGN_Word64      assign an StgWord64/StgInt64 to a memory location
-   PK_Word64          load an StgWord64/StgInt64 from a amemory location
-
-   In both cases the memory location might not be 64-bit aligned.
-   -------------------------------------------------------------------------- */
-
-#ifdef SUPPORT_LONG_LONGS
-
-typedef struct
-  { StgWord dhi;
-    StgWord dlo;
-  } unpacked_double_word;
-
-typedef union
-  { StgInt64 i;
-    unpacked_double_word iu;
-  } int64_thing;
-
-typedef union
-  { StgWord64 w;
-    unpacked_double_word wu;
-  } word64_thing;
-
-INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
-{
-    word64_thing y;
-    y.w = src;
-    p_dest[0] = y.wu.dhi;
-    p_dest[1] = y.wu.dlo;
-}
-
-INLINE_HEADER StgWord64 PK_Word64(W_ p_src[])
-{
-    word64_thing y;
-    y.wu.dhi = p_src[0];
-    y.wu.dlo = p_src[1];
-    return(y.w);
-}
-
-INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
-{
-    int64_thing y;
-    y.i = src;
-    p_dest[0] = y.iu.dhi;
-    p_dest[1] = y.iu.dlo;
-}
-
-INLINE_HEADER StgInt64 PK_Int64(W_ p_src[])
-{
-    int64_thing y;
-    y.iu.dhi = p_src[0];
-    y.iu.dlo = p_src[1];
-    return(y.i);
-}
-
-#elif SIZEOF_VOID_P == 8
-
-INLINE_HEADER void ASSIGN_Word64(W_ p_dest[], StgWord64 src)
-{
-	p_dest[0] = src;
-}
-
-INLINE_HEADER StgWord64 PK_Word64(W_ p_src[])
-{
-    return p_src[0];
-}
-
-INLINE_HEADER void ASSIGN_Int64(W_ p_dest[], StgInt64 src)
-{
-    p_dest[0] = src;
-}
-
-INLINE_HEADER StgInt64 PK_Int64(W_ p_src[])
-{
-    return p_src[0];
-}
-
-#endif
-
-/* -----------------------------------------------------------------------------
-   Split markers
-   -------------------------------------------------------------------------- */
-
-#if defined(USE_SPLIT_MARKERS)
-#if defined(LEADING_UNDERSCORE)
-#define __STG_SPLIT_MARKER __asm__("\n___stg_split_marker:");
-#else
-#define __STG_SPLIT_MARKER __asm__("\n__stg_split_marker:");
-#endif
-#else
-#define __STG_SPLIT_MARKER /* nothing */
-#endif
-
-/* -----------------------------------------------------------------------------
-   Write-combining store
-   -------------------------------------------------------------------------- */
-
-INLINE_HEADER void
-wcStore (StgPtr p, StgWord w)
-{
-#ifdef x86_64_HOST_ARCH    
-    __asm__(
-	"movnti\t%1, %0"
-	: "=m" (*p)
-	: "r" (w)
-	);
-#else
-      *p = w;
-#endif
-}
-
-/* -----------------------------------------------------------------------------
-   Integer multiply with overflow
-   -------------------------------------------------------------------------- */
-
-/* Multiply with overflow checking.
- *
- * This is tricky - the usual sign rules for add/subtract don't apply.  
- *
- * On 32-bit machines we use gcc's 'long long' types, finding
- * overflow with some careful bit-twiddling.
- *
- * On 64-bit machines where gcc's 'long long' type is also 64-bits,
- * we use a crude approximation, testing whether either operand is
- * larger than 32-bits; if neither is, then we go ahead with the
- * multiplication.
- *
- * Return non-zero if there is any possibility that the signed multiply
- * of a and b might overflow.  Return zero only if you are absolutely sure
- * that it won't overflow.  If in doubt, return non-zero.
- */
-
-#if SIZEOF_VOID_P == 4
-
-#ifdef WORDS_BIGENDIAN
-#define RTS_CARRY_IDX__ 0
-#define RTS_REM_IDX__  1
-#else
-#define RTS_CARRY_IDX__ 1
-#define RTS_REM_IDX__ 0
-#endif
-
-typedef union {
-    StgInt64 l;
-    StgInt32 i[2];
-} long_long_u ;
-
-#define mulIntMayOflo(a,b)			\
-({                                              \
-  StgInt32 r, c;				\
-  long_long_u z;				\
-  z.l = (StgInt64)a * (StgInt64)b;		\
-  r = z.i[RTS_REM_IDX__];			\
-  c = z.i[RTS_CARRY_IDX__];			\
-  if (c == 0 || c == -1) {			\
-    c = ((StgWord)((a^b) ^ r))			\
-      >> (BITS_IN (I_) - 1);			\
-  }						\
-  c;                                            \
-})
-
-/* Careful: the carry calculation above is extremely delicate.  Make sure
- * you test it thoroughly after changing it.
- */
-
-#else
-
-/* Approximate version when we don't have long arithmetic (on 64-bit archs) */
-
-#define HALF_POS_INT  (((I_)1) << (BITS_IN (I_) / 2))
-#define HALF_NEG_INT  (-HALF_POS_INT)
-
-#define mulIntMayOflo(a,b)			\
-({                                              \
-  I_ c; 					\
-  if ((I_)a <= HALF_NEG_INT || a >= HALF_POS_INT    \
-      || (I_)b <= HALF_NEG_INT || b >= HALF_POS_INT) {\
-    c = 1;					\
-  } else {					\
-    c = 0;					\
-  }						\
-  c;                                            \
-})
-#endif
-
-#endif /* STG_H */
diff --git a/ghc/includes/StgDLL.h b/ghc/includes/StgDLL.h
deleted file mode 100644
index ededcc96b5..0000000000
--- a/ghc/includes/StgDLL.h
+++ /dev/null
@@ -1,48 +0,0 @@
-#ifndef __STGDLL_H__
-#define __STGDLL_H__ 1
-
-#if defined(HAVE_WIN32_DLL_SUPPORT) && !defined(DONT_WANT_WIN32_DLL_SUPPORT)
-#define ENABLE_WIN32_DLL_SUPPORT
-#endif
-
-#ifdef ENABLE_WIN32_DLL_SUPPORT
-# if __GNUC__ && !defined(__declspec)
-#  define DLLIMPORT
-# else
-#  define DLLIMPORT __declspec(dllimport)
-#  define DLLIMPORT_DATA(x) _imp__##x
-# endif
-#else
-# define DLLIMPORT
-#endif
-
-/* The view of the ghc/includes/ header files differ ever so
-   slightly depending on whether the RTS is being compiled
-   or not - so we're forced to distinguish between two.
-   [oh, you want details :) : Data symbols defined by the RTS
-    have to be accessed through an extra level of indirection
-    when compiling generated .hc code compared to when the RTS
-    sources are being processed. This is only the case when 
-    using Win32 DLLs. ]
-*/
-#ifdef COMPILING_RTS
-#define DLL_IMPORT DLLIMPORT
-#define DLL_IMPORT_RTS
-#define DLL_IMPORT_DATA_VAR(x) x
-#else
-#define DLL_IMPORT
-#define DLL_IMPORT_RTS DLLIMPORT
-# ifdef ENABLE_WIN32_DLL_SUPPORT
-#  define DLL_IMPORT_DATA_VAR(x) _imp__##x
-# else
-#  define DLL_IMPORT_DATA_VAR(x) x
-# endif
-#endif
-
-#ifdef COMPILING_STDLIB
-#define DLL_IMPORT_STDLIB
-#else
-#define DLL_IMPORT_STDLIB DLLIMPORT
-#endif
-
-#endif /* __STGDLL_H__ */
diff --git a/ghc/includes/StgFun.h b/ghc/includes/StgFun.h
deleted file mode 100644
index e6f9b1fe0e..0000000000
--- a/ghc/includes/StgFun.h
+++ /dev/null
@@ -1,52 +0,0 @@
-/* -----------------------------------------------------------------------------
- * (c) The GHC Team, 2002
- *
- * Things for functions.
- * ---------------------------------------------------------------------------*/
-
-#ifndef STGFUN_H
-#define STGFUN_H
-
-/* generic - function comes with a small bitmap */
-#define ARG_GEN      0   
-
-/* generic - function comes with a large bitmap */
-#define ARG_GEN_BIG  1
-
-/* BCO - function is really a BCO */
-#define ARG_BCO      2
-
-/*
- * Specialised function types: bitmaps and calling sequences
- * for these functions are pre-generated: see ghc/utils/genapply and
- * generated code in ghc/rts/AutoApply.cmm.
- *
- *  NOTE: other places to change if you change this table:
- *       - utils/genapply/GenApply.hs: stackApplyTypes
- *       - compiler/codeGen/CgCallConv.lhs: stdPattern
- */
-#define ARG_NONE     3 
-#define ARG_N        4  
-#define ARG_P        5 
-#define ARG_F        6 
-#define ARG_D        7 
-#define ARG_L        8 
-#define ARG_NN       9 
-#define ARG_NP       10
-#define ARG_PN       11
-#define ARG_PP       12
-#define ARG_NNN      13
-#define ARG_NNP      14
-#define ARG_NPN      15
-#define ARG_NPP      16
-#define ARG_PNN      17
-#define ARG_PNP      18
-#define ARG_PPN      19
-#define ARG_PPP      20
-#define ARG_PPPP     21
-#define ARG_PPPPP    22
-#define ARG_PPPPPP   23
-#define ARG_PPPPPPP  24
-#define ARG_PPPPPPPP 25
-
-#endif /* STGFUN_H */
diff --git a/ghc/includes/StgLdvProf.h b/ghc/includes/StgLdvProf.h
deleted file mode 100644
index 3c3df1c5fa..0000000000
--- a/ghc/includes/StgLdvProf.h
+++ /dev/null
@@ -1,45 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The University of Glasgow, 2004
- *
- * Lag/Drag/Void profiling.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef STGLDVPROF_H
-#define STGLDVPROF_H
-
-#ifdef PROFILING
-
-/* retrieves the LDV word from closure c */
-#define LDVW(c)                 (((StgClosure *)(c))->header.prof.hp.ldvw)
-
-/*
- * Stores the creation time for closure c. 
- * This macro is called at the very moment of closure creation.
- *
- * NOTE: this initializes LDVW(c) to zero, which ensures that there
- * is no conflict between retainer profiling and LDV profiling,
- * because retainer profiling also expects LDVW(c) to be initialised
- * to zero.
- */
-#ifndef CMINUSMINUS
-#define LDV_RECORD_CREATE(c)   \
-  LDVW((c)) = ((StgWord)RTS_DEREF(era) << LDV_SHIFT) | LDV_STATE_CREATE
-#endif
-
-#ifdef CMINUSMINUS
-#define LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(c) \
-  foreign "C" LDV_recordDead_FILL_SLOP_DYNAMIC(c "ptr")
-#else
-#define LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(c) \
-  LDV_recordDead_FILL_SLOP_DYNAMIC(c)
-#endif
-
-#else  /* !PROFILING */
-
-#define LDV_RECORD_CREATE(c)   /* nothing */
-#define LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(c)  /* nothing */
-
-#endif /* PROFILING */
-#endif /* STGLDVPROF_H */
diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h
deleted file mode 100644
index 4a6a7c47c2..0000000000
--- a/ghc/includes/StgMiscClosures.h
+++ /dev/null
@@ -1,606 +0,0 @@
-/* ----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Declarations for various symbols exported by the RTS.
- *
- * ToDo: many of the symbols in here don't need to be exported, but
- * our Cmm code generator doesn't know how to generate local symbols
- * for the RTS bits (it assumes all RTS symbols are external).
- *
- * --------------------------------------------------------------------------*/
-
-#ifndef STGMISCCLOSURES_H
-#define STGMISCCLOSURES_H
-
-#if IN_STG_CODE
-#  define RTS_RET_INFO(i)   extern W_(i)[]
-#  define RTS_FUN_INFO(i)   extern W_(i)[]
-#  define RTS_THUNK_INFO(i) extern W_(i)[]
-#  define RTS_INFO(i)       extern W_(i)[]
-#  define RTS_CLOSURE(i)    extern W_(i)[]
-#  define RTS_FUN(f)	    extern DLL_IMPORT_RTS StgFunPtr f(void)
-#else
-#  define RTS_RET_INFO(i)   extern DLL_IMPORT_RTS const StgRetInfoTable i
-#  define RTS_FUN_INFO(i)   extern DLL_IMPORT_RTS const StgFunInfoTable i
-#  define RTS_THUNK_INFO(i) extern DLL_IMPORT_RTS const StgThunkInfoTable i
-#  define RTS_INFO(i)       extern DLL_IMPORT_RTS const StgInfoTable i
-#  define RTS_CLOSURE(i)    extern DLL_IMPORT_RTS StgClosure i
-#  define RTS_FUN(f)	    extern DLL_IMPORT_RTS StgFunPtr f(void)
-#endif
-
-#ifdef TABLES_NEXT_TO_CODE
-#  define RTS_ENTRY(f)    /* nothing */
-#else
-#  define RTS_ENTRY(f)    RTS_FUN(f)
-#endif
-
-/* Stack frames */
-RTS_RET_INFO(stg_upd_frame_info);
-RTS_RET_INFO(stg_marked_upd_frame_info);
-RTS_RET_INFO(stg_noupd_frame_info);
-RTS_RET_INFO(stg_seq_frame_info);
-RTS_RET_INFO(stg_catch_frame_info);
-RTS_RET_INFO(stg_catch_retry_frame_info);
-RTS_RET_INFO(stg_atomically_frame_info);
-RTS_RET_INFO(stg_atomically_waiting_frame_info);
-RTS_RET_INFO(stg_catch_stm_frame_info);
-
-RTS_ENTRY(stg_upd_frame_ret);
-RTS_ENTRY(stg_marked_upd_frame_ret);
-RTS_ENTRY(stg_seq_frame_ret);
-
-/* Entry code for constructors created by the bytecode interpreter */
-RTS_FUN(stg_interp_constr_entry);
-RTS_FUN(stg_interp_constr1_entry);
-RTS_FUN(stg_interp_constr2_entry);
-RTS_FUN(stg_interp_constr3_entry);
-RTS_FUN(stg_interp_constr4_entry);
-RTS_FUN(stg_interp_constr5_entry);
-RTS_FUN(stg_interp_constr6_entry);
-RTS_FUN(stg_interp_constr7_entry);
-RTS_FUN(stg_interp_constr8_entry);
-
-/* Magic glue code for when compiled code returns a value in R1/F1/D1
-   or a VoidRep to the interpreter. */
-RTS_RET_INFO(stg_ctoi_R1p_info);
-RTS_RET_INFO(stg_ctoi_R1unpt_info);
-RTS_RET_INFO(stg_ctoi_R1n_info);
-RTS_RET_INFO(stg_ctoi_F1_info);
-RTS_RET_INFO(stg_ctoi_D1_info);
-RTS_RET_INFO(stg_ctoi_L1_info);
-RTS_RET_INFO(stg_ctoi_V_info);
-
-RTS_ENTRY(stg_ctoi_R1p_ret);
-RTS_ENTRY(stg_ctoi_R1unpt_ret);
-RTS_ENTRY(stg_ctoi_R1n_ret);
-RTS_ENTRY(stg_ctoi_F1_ret);
-RTS_ENTRY(stg_ctoi_D1_ret);
-RTS_ENTRY(stg_ctoi_L1_ret);
-RTS_ENTRY(stg_ctoi_V_ret);
-
-RTS_RET_INFO(stg_apply_interp_info);
-RTS_ENTRY(stg_apply_interp_ret);
-
-RTS_INFO(stg_IND_info);
-RTS_INFO(stg_IND_direct_info);
-RTS_INFO(stg_IND_0_info);
-RTS_INFO(stg_IND_1_info);
-RTS_INFO(stg_IND_2_info);
-RTS_INFO(stg_IND_3_info);
-RTS_INFO(stg_IND_4_info);
-RTS_INFO(stg_IND_5_info);
-RTS_INFO(stg_IND_6_info);
-RTS_INFO(stg_IND_7_info);
-RTS_INFO(stg_IND_STATIC_info);
-RTS_INFO(stg_IND_PERM_info);
-RTS_INFO(stg_IND_OLDGEN_info);
-RTS_INFO(stg_IND_OLDGEN_PERM_info);
-RTS_INFO(stg_CAF_UNENTERED_info);
-RTS_INFO(stg_CAF_ENTERED_info);
-RTS_INFO(stg_WHITEHOLE_info);
-RTS_INFO(stg_BLACKHOLE_info);
-RTS_INFO(stg_CAF_BLACKHOLE_info);
-#ifdef TICKY_TICKY
-RTS_INFO(stg_SE_BLACKHOLE_info);
-RTS_INFO(stg_SE_CAF_BLACKHOLE_info);
-#endif
-
-#if defined(PAR) || defined(GRAN)
-RTS_INFO(stg_RBH_info);
-#endif
-#if defined(PAR)
-RTS_INFO(stg_FETCH_ME_BQ_info);
-#endif
-RTS_FUN_INFO(stg_BCO_info);
-RTS_INFO(stg_EVACUATED_info);
-RTS_INFO(stg_WEAK_info);
-RTS_INFO(stg_DEAD_WEAK_info);
-RTS_INFO(stg_STABLE_NAME_info);
-RTS_INFO(stg_FULL_MVAR_info);
-RTS_INFO(stg_EMPTY_MVAR_info);
-RTS_INFO(stg_TSO_info);
-RTS_INFO(stg_ARR_WORDS_info);
-RTS_INFO(stg_MUT_ARR_WORDS_info);
-RTS_INFO(stg_MUT_ARR_PTRS_CLEAN_info);
-RTS_INFO(stg_MUT_ARR_PTRS_DIRTY_info);
-RTS_INFO(stg_MUT_ARR_PTRS_FROZEN_info);
-RTS_INFO(stg_MUT_ARR_PTRS_FROZEN0_info);
-RTS_INFO(stg_MUT_VAR_CLEAN_info);
-RTS_INFO(stg_MUT_VAR_DIRTY_info);
-RTS_INFO(stg_END_TSO_QUEUE_info);
-RTS_INFO(stg_MUT_CONS_info);
-RTS_INFO(stg_catch_info);
-RTS_INFO(stg_PAP_info);
-RTS_INFO(stg_AP_info);
-RTS_INFO(stg_AP_STACK_info);
-RTS_INFO(stg_dummy_ret_info);
-RTS_INFO(stg_raise_info);
-RTS_INFO(stg_TVAR_WAIT_QUEUE_info);
-RTS_INFO(stg_TVAR_info);
-RTS_INFO(stg_TREC_CHUNK_info);
-RTS_INFO(stg_TREC_HEADER_info);
-RTS_INFO(stg_END_STM_WAIT_QUEUE_info);
-RTS_INFO(stg_END_STM_CHUNK_LIST_info);
-RTS_INFO(stg_NO_TREC_info);
-
-RTS_ENTRY(stg_IND_entry);
-RTS_ENTRY(stg_IND_direct_entry);
-RTS_ENTRY(stg_IND_0_entry);
-RTS_ENTRY(stg_IND_1_entry);
-RTS_ENTRY(stg_IND_2_entry);
-RTS_ENTRY(stg_IND_3_entry);
-RTS_ENTRY(stg_IND_4_entry);
-RTS_ENTRY(stg_IND_5_entry);
-RTS_ENTRY(stg_IND_6_entry);
-RTS_ENTRY(stg_IND_7_entry);
-RTS_ENTRY(stg_IND_STATIC_entry);
-RTS_ENTRY(stg_IND_PERM_entry);
-RTS_ENTRY(stg_IND_OLDGEN_entry);
-RTS_ENTRY(stg_IND_OLDGEN_PERM_entry);
-RTS_ENTRY(stg_CAF_UNENTERED_entry);
-RTS_ENTRY(stg_CAF_ENTERED_entry);
-RTS_ENTRY(stg_WHITEHOLE_entry);
-RTS_ENTRY(stg_BLACKHOLE_entry);
-RTS_ENTRY(stg_CAF_BLACKHOLE_entry);
-#ifdef TICKY_TICKY
-RTS_ENTRY(stg_SE_BLACKHOLE_entry);
-RTS_ENTRY(stg_SE_CAF_BLACKHOLE_entry);
-#endif
-#if defined(PAR) || defined(GRAN)
-RTS_ENTRY(stg_RBH_entry);
-#endif
-#if defined(PAR)
-RTS_ENTRY(stg_FETCH_ME_BQ_entry);
-#endif
-RTS_ENTRY(stg_BCO_entry);
-RTS_ENTRY(stg_EVACUATED_entry);
-RTS_ENTRY(stg_WEAK_entry);
-RTS_ENTRY(stg_DEAD_WEAK_entry);
-RTS_ENTRY(stg_STABLE_NAME_entry);
-RTS_ENTRY(stg_FULL_MVAR_entry);
-RTS_ENTRY(stg_EMPTY_MVAR_entry);
-RTS_ENTRY(stg_TSO_entry);
-RTS_ENTRY(stg_ARR_WORDS_entry);
-RTS_ENTRY(stg_MUT_ARR_WORDS_entry);
-RTS_ENTRY(stg_MUT_ARR_PTRS_CLEAN_entry);
-RTS_ENTRY(stg_MUT_ARR_PTRS_DIRTY_entry);
-RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN_entry);
-RTS_ENTRY(stg_MUT_ARR_PTRS_FROZEN0_entry);
-RTS_ENTRY(stg_MUT_VAR_CLEAN_entry);
-RTS_ENTRY(stg_MUT_VAR_DIRTY_entry);
-RTS_ENTRY(stg_END_TSO_QUEUE_entry);
-RTS_ENTRY(stg_MUT_CONS_entry);
-RTS_ENTRY(stg_catch_entry);
-RTS_ENTRY(stg_PAP_entry);
-RTS_ENTRY(stg_AP_entry);
-RTS_ENTRY(stg_AP_STACK_entry);
-RTS_ENTRY(stg_dummy_ret_entry);
-RTS_ENTRY(stg_raise_entry);
-RTS_ENTRY(stg_END_STM_WAIT_QUEUE_entry);
-RTS_ENTRY(stg_END_STM_CHUNK_LIST_entry);
-RTS_ENTRY(stg_NO_TREC_entry);
-RTS_ENTRY(stg_TVAR_entry);
-RTS_ENTRY(stg_TVAR_WAIT_QUEUE_entry);
-RTS_ENTRY(stg_TREC_CHUNK_entry);
-RTS_ENTRY(stg_TREC_HEADER_entry);
-
-
-RTS_ENTRY(stg_unblockAsyncExceptionszh_ret_ret);
-RTS_ENTRY(stg_blockAsyncExceptionszh_ret_ret);
-RTS_ENTRY(stg_catch_frame_ret);
-RTS_ENTRY(stg_catch_retry_frame_ret);
-RTS_ENTRY(stg_atomically_frame_ret);
-RTS_ENTRY(stg_atomically_waiting_frame_ret);
-RTS_ENTRY(stg_catch_stm_frame_ret);
-RTS_ENTRY(stg_catch_frame_ret);
-RTS_ENTRY(stg_catch_entry);
-RTS_ENTRY(stg_raise_entry);
-
-/* closures */
-
-RTS_CLOSURE(stg_END_TSO_QUEUE_closure);
-RTS_CLOSURE(stg_NO_FINALIZER_closure);
-RTS_CLOSURE(stg_dummy_ret_closure);
-RTS_CLOSURE(stg_forceIO_closure);
-
-RTS_CLOSURE(stg_END_STM_WAIT_QUEUE_closure);
-RTS_CLOSURE(stg_END_STM_CHUNK_LIST_closure);
-RTS_CLOSURE(stg_NO_TREC_closure);
-
-RTS_ENTRY(stg_NO_FINALIZER_entry);
-RTS_ENTRY(stg_END_EXCEPTION_LIST_entry);
-RTS_ENTRY(stg_EXCEPTION_CONS_entry);
-
-#if IN_STG_CODE
-extern DLL_IMPORT_RTS StgWordArray stg_CHARLIKE_closure;
-extern DLL_IMPORT_RTS StgWordArray stg_INTLIKE_closure;
-#else
-extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_CHARLIKE_closure[];
-extern DLL_IMPORT_RTS StgIntCharlikeClosure stg_INTLIKE_closure[];
-#endif
-
-/* StgStartup */
-
-RTS_RET_INFO(stg_forceIO_info);
-RTS_ENTRY(stg_forceIO_ret);
-
-RTS_RET_INFO(stg_noforceIO_info);
-RTS_ENTRY(stg_noforceIO_ret);
-
-/* standard entry points */
-
-/* standard selector thunks */
-
-RTS_ENTRY(stg_sel_ret_0_upd_ret);
-RTS_ENTRY(stg_sel_ret_1_upd_ret);
-RTS_ENTRY(stg_sel_ret_2_upd_ret);
-RTS_ENTRY(stg_sel_ret_3_upd_ret);
-RTS_ENTRY(stg_sel_ret_4_upd_ret);
-RTS_ENTRY(stg_sel_ret_5_upd_ret);
-RTS_ENTRY(stg_sel_ret_6_upd_ret);
-RTS_ENTRY(stg_sel_ret_7_upd_ret);
-RTS_ENTRY(stg_sel_ret_8_upd_ret);
-RTS_ENTRY(stg_sel_ret_8_upd_ret);
-RTS_ENTRY(stg_sel_ret_9_upd_ret);
-RTS_ENTRY(stg_sel_ret_10_upd_ret);
-RTS_ENTRY(stg_sel_ret_11_upd_ret);
-RTS_ENTRY(stg_sel_ret_12_upd_ret);
-RTS_ENTRY(stg_sel_ret_13_upd_ret);
-RTS_ENTRY(stg_sel_ret_14_upd_ret);
-RTS_ENTRY(stg_sel_ret_15_upd_ret);
-
-RTS_INFO(stg_sel_0_upd_info);
-RTS_INFO(stg_sel_1_upd_info);
-RTS_INFO(stg_sel_2_upd_info);
-RTS_INFO(stg_sel_3_upd_info);
-RTS_INFO(stg_sel_4_upd_info);
-RTS_INFO(stg_sel_5_upd_info);
-RTS_INFO(stg_sel_6_upd_info);
-RTS_INFO(stg_sel_7_upd_info);
-RTS_INFO(stg_sel_8_upd_info);
-RTS_INFO(stg_sel_8_upd_info);
-RTS_INFO(stg_sel_9_upd_info);
-RTS_INFO(stg_sel_10_upd_info);
-RTS_INFO(stg_sel_11_upd_info);
-RTS_INFO(stg_sel_12_upd_info);
-RTS_INFO(stg_sel_13_upd_info);
-RTS_INFO(stg_sel_14_upd_info);
-RTS_INFO(stg_sel_15_upd_info);
-
-RTS_ENTRY(stg_sel_0_upd_entry);
-RTS_ENTRY(stg_sel_1_upd_entry);
-RTS_ENTRY(stg_sel_2_upd_entry);
-RTS_ENTRY(stg_sel_3_upd_entry);
-RTS_ENTRY(stg_sel_4_upd_entry);
-RTS_ENTRY(stg_sel_5_upd_entry);
-RTS_ENTRY(stg_sel_6_upd_entry);
-RTS_ENTRY(stg_sel_7_upd_entry);
-RTS_ENTRY(stg_sel_8_upd_entry);
-RTS_ENTRY(stg_sel_8_upd_entry);
-RTS_ENTRY(stg_sel_9_upd_entry);
-RTS_ENTRY(stg_sel_10_upd_entry);
-RTS_ENTRY(stg_sel_11_upd_entry);
-RTS_ENTRY(stg_sel_12_upd_entry);
-RTS_ENTRY(stg_sel_13_upd_entry);
-RTS_ENTRY(stg_sel_14_upd_entry);
-RTS_ENTRY(stg_sel_15_upd_entry);
-
-RTS_ENTRY(stg_sel_ret_0_noupd_ret);
-RTS_ENTRY(stg_sel_ret_1_noupd_ret);
-RTS_ENTRY(stg_sel_ret_2_noupd_ret);
-RTS_ENTRY(stg_sel_ret_3_noupd_ret);
-RTS_ENTRY(stg_sel_ret_4_noupd_ret);
-RTS_ENTRY(stg_sel_ret_5_noupd_ret);
-RTS_ENTRY(stg_sel_ret_6_noupd_ret);
-RTS_ENTRY(stg_sel_ret_7_noupd_ret);
-RTS_ENTRY(stg_sel_ret_8_noupd_ret);
-RTS_ENTRY(stg_sel_ret_8_noupd_ret);
-RTS_ENTRY(stg_sel_ret_9_noupd_ret);
-RTS_ENTRY(stg_sel_ret_10_noupd_ret);
-RTS_ENTRY(stg_sel_ret_11_noupd_ret);
-RTS_ENTRY(stg_sel_ret_12_noupd_ret);
-RTS_ENTRY(stg_sel_ret_13_noupd_ret);
-RTS_ENTRY(stg_sel_ret_14_noupd_ret);
-RTS_ENTRY(stg_sel_ret_15_noupd_ret);
-
-RTS_INFO(stg_sel_0_noupd_info);
-RTS_INFO(stg_sel_1_noupd_info);
-RTS_INFO(stg_sel_2_noupd_info);
-RTS_INFO(stg_sel_3_noupd_info);
-RTS_INFO(stg_sel_4_noupd_info);
-RTS_INFO(stg_sel_5_noupd_info);
-RTS_INFO(stg_sel_6_noupd_info);
-RTS_INFO(stg_sel_7_noupd_info);
-RTS_INFO(stg_sel_8_noupd_info);
-RTS_INFO(stg_sel_9_noupd_info);
-RTS_INFO(stg_sel_10_noupd_info);
-RTS_INFO(stg_sel_11_noupd_info);
-RTS_INFO(stg_sel_12_noupd_info);
-RTS_INFO(stg_sel_13_noupd_info);
-RTS_INFO(stg_sel_14_noupd_info);
-RTS_INFO(stg_sel_15_noupd_info);
-
-RTS_ENTRY(stg_sel_0_noupd_entry);
-RTS_ENTRY(stg_sel_1_noupd_entry);
-RTS_ENTRY(stg_sel_2_noupd_entry);
-RTS_ENTRY(stg_sel_3_noupd_entry);
-RTS_ENTRY(stg_sel_4_noupd_entry);
-RTS_ENTRY(stg_sel_5_noupd_entry);
-RTS_ENTRY(stg_sel_6_noupd_entry);
-RTS_ENTRY(stg_sel_7_noupd_entry);
-RTS_ENTRY(stg_sel_8_noupd_entry);
-RTS_ENTRY(stg_sel_9_noupd_entry);
-RTS_ENTRY(stg_sel_10_noupd_entry);
-RTS_ENTRY(stg_sel_11_noupd_entry);
-RTS_ENTRY(stg_sel_12_noupd_entry);
-RTS_ENTRY(stg_sel_13_noupd_entry);
-RTS_ENTRY(stg_sel_14_noupd_entry);
-RTS_ENTRY(stg_sel_15_noupd_entry);
-
-/* standard ap thunks */
-
-RTS_THUNK_INFO(stg_ap_1_upd_info);
-RTS_THUNK_INFO(stg_ap_2_upd_info);
-RTS_THUNK_INFO(stg_ap_3_upd_info);
-RTS_THUNK_INFO(stg_ap_4_upd_info);
-RTS_THUNK_INFO(stg_ap_5_upd_info);
-RTS_THUNK_INFO(stg_ap_6_upd_info);
-RTS_THUNK_INFO(stg_ap_7_upd_info);
-
-RTS_ENTRY(stg_ap_1_upd_entry);
-RTS_ENTRY(stg_ap_2_upd_entry);
-RTS_ENTRY(stg_ap_3_upd_entry);
-RTS_ENTRY(stg_ap_4_upd_entry);
-RTS_ENTRY(stg_ap_5_upd_entry);
-RTS_ENTRY(stg_ap_6_upd_entry);
-RTS_ENTRY(stg_ap_7_upd_entry);
-
-/* standard application routines (see also rts/gen_apply.py, 
- * and compiler/codeGen/CgStackery.lhs).
- */
-RTS_RET_INFO(stg_ap_v_info);
-RTS_RET_INFO(stg_ap_f_info);
-RTS_RET_INFO(stg_ap_d_info);
-RTS_RET_INFO(stg_ap_l_info);
-RTS_RET_INFO(stg_ap_n_info);
-RTS_RET_INFO(stg_ap_p_info);
-RTS_RET_INFO(stg_ap_pv_info);
-RTS_RET_INFO(stg_ap_pp_info);
-RTS_RET_INFO(stg_ap_ppv_info);
-RTS_RET_INFO(stg_ap_ppp_info);
-RTS_RET_INFO(stg_ap_pppv_info);
-RTS_RET_INFO(stg_ap_pppp_info);
-RTS_RET_INFO(stg_ap_ppppp_info);
-RTS_RET_INFO(stg_ap_pppppp_info);
-
-RTS_ENTRY(stg_ap_v_ret);
-RTS_ENTRY(stg_ap_f_ret);
-RTS_ENTRY(stg_ap_d_ret);
-RTS_ENTRY(stg_ap_l_ret);
-RTS_ENTRY(stg_ap_n_ret);
-RTS_ENTRY(stg_ap_p_ret);
-RTS_ENTRY(stg_ap_pv_ret);
-RTS_ENTRY(stg_ap_pp_ret);
-RTS_ENTRY(stg_ap_ppv_ret);
-RTS_ENTRY(stg_ap_ppp_ret);
-RTS_ENTRY(stg_ap_pppv_ret);
-RTS_ENTRY(stg_ap_pppp_ret);
-RTS_ENTRY(stg_ap_ppppp_ret);
-RTS_ENTRY(stg_ap_pppppp_ret);
-
-RTS_FUN(stg_ap_0_fast);
-RTS_FUN(stg_ap_v_fast);
-RTS_FUN(stg_ap_f_fast);
-RTS_FUN(stg_ap_d_fast);
-RTS_FUN(stg_ap_l_fast);
-RTS_FUN(stg_ap_n_fast);
-RTS_FUN(stg_ap_p_fast);
-RTS_FUN(stg_ap_pv_fast);
-RTS_FUN(stg_ap_pp_fast);
-RTS_FUN(stg_ap_ppv_fast);
-RTS_FUN(stg_ap_ppp_fast);
-RTS_FUN(stg_ap_pppv_fast);
-RTS_FUN(stg_ap_pppp_fast);
-RTS_FUN(stg_ap_ppppp_fast);
-RTS_FUN(stg_ap_pppppp_fast);
-RTS_FUN(stg_PAP_apply);
-
-/* standard GC & stack check entry points, all defined in HeapStackCheck.hc */
-
-RTS_RET_INFO(stg_enter_info);
-RTS_ENTRY(stg_enter_ret);
-
-RTS_RET_INFO(stg_gc_void_info);
-RTS_ENTRY(stg_gc_void_ret);
-
-RTS_FUN(__stg_gc_enter_1);
-
-RTS_FUN(stg_gc_noregs);
-
-RTS_RET_INFO(stg_gc_unpt_r1_info);
-RTS_ENTRY(stg_gc_unpt_r1_ret);
-RTS_FUN(stg_gc_unpt_r1);
-
-RTS_RET_INFO(stg_gc_unbx_r1_info);
-RTS_ENTRY(stg_gc_unbx_r1_ret);
-RTS_FUN(stg_gc_unbx_r1);
-
-RTS_RET_INFO(stg_gc_f1_info);
-RTS_ENTRY(stg_gc_f1_ret);
-RTS_FUN(stg_gc_f1);
-
-RTS_RET_INFO(stg_gc_d1_info);
-RTS_ENTRY(stg_gc_d1_ret);
-RTS_FUN(stg_gc_d1);
-
-RTS_RET_INFO(stg_gc_l1_info);
-RTS_ENTRY(stg_gc_l1_ret);
-RTS_FUN(stg_gc_l1);
-
-RTS_FUN(__stg_gc_fun);
-RTS_RET_INFO(stg_gc_fun_info);
-RTS_ENTRY(stg_gc_fun_ret);
-
-RTS_RET_INFO(stg_gc_gen_info);
-RTS_ENTRY(stg_gc_gen_ret);
-RTS_FUN(stg_gc_gen);
-
-RTS_ENTRY(stg_ut_1_0_unreg_ret);
-RTS_RET_INFO(stg_ut_1_0_unreg_info);
-
-RTS_FUN(stg_gc_gen_hp);
-RTS_FUN(stg_gc_ut);
-RTS_FUN(stg_gen_yield);
-RTS_FUN(stg_yield_noregs);
-RTS_FUN(stg_yield_to_interpreter);
-RTS_FUN(stg_gen_block);
-RTS_FUN(stg_block_noregs);
-RTS_FUN(stg_block_1);
-RTS_FUN(stg_block_blackhole);
-RTS_FUN(stg_block_blackhole_finally);
-RTS_FUN(stg_block_takemvar);
-RTS_ENTRY(stg_block_takemvar_ret);
-RTS_FUN(stg_block_putmvar);
-RTS_ENTRY(stg_block_putmvar_ret);
-#ifdef mingw32_HOST_OS
-RTS_FUN(stg_block_async);
-RTS_ENTRY(stg_block_async_ret);
-RTS_FUN(stg_block_async_void);
-RTS_ENTRY(stg_block_async_void_ret);
-#endif
-RTS_FUN(stg_block_stmwait);
-
-/* Entry/exit points from StgStartup.cmm */
-
-RTS_RET_INFO(stg_stop_thread_info);
-RTS_ENTRY(stg_stop_thread_ret);
-
-RTS_FUN(stg_returnToStackTop);
-RTS_FUN(stg_returnToSched);
-RTS_FUN(stg_returnToSchedNotPaused);
-RTS_FUN(stg_returnToSchedButFirst);
-
-RTS_FUN(stg_init_finish);
-RTS_FUN(stg_init);
-
-/* -----------------------------------------------------------------------------
-   PrimOps
-   -------------------------------------------------------------------------- */
-
-RTS_FUN(plusIntegerzh_fast);
-RTS_FUN(minusIntegerzh_fast);
-RTS_FUN(timesIntegerzh_fast);
-RTS_FUN(gcdIntegerzh_fast);
-RTS_FUN(quotRemIntegerzh_fast);
-RTS_FUN(quotIntegerzh_fast);
-RTS_FUN(remIntegerzh_fast);
-RTS_FUN(divExactIntegerzh_fast);
-RTS_FUN(divModIntegerzh_fast);
-
-RTS_FUN(cmpIntegerIntzh_fast);
-RTS_FUN(cmpIntegerzh_fast);
-RTS_FUN(integer2Intzh_fast);
-RTS_FUN(integer2Wordzh_fast);
-RTS_FUN(gcdIntegerIntzh_fast);
-RTS_FUN(gcdIntzh_fast);
-
-RTS_FUN(int2Integerzh_fast);
-RTS_FUN(word2Integerzh_fast);
-
-RTS_FUN(decodeFloatzh_fast);
-RTS_FUN(decodeDoublezh_fast);
-
-RTS_FUN(andIntegerzh_fast);
-RTS_FUN(orIntegerzh_fast);
-RTS_FUN(xorIntegerzh_fast);
-RTS_FUN(complementIntegerzh_fast);
-
-#ifdef SUPPORT_LONG_LONGS
-
-RTS_FUN(int64ToIntegerzh_fast);
-RTS_FUN(word64ToIntegerzh_fast);
-
-#endif
-
-RTS_FUN(unsafeThawArrayzh_fast);
-RTS_FUN(newByteArrayzh_fast);
-RTS_FUN(newPinnedByteArrayzh_fast);
-RTS_FUN(newArrayzh_fast);
-
-RTS_FUN(decodeFloatzh_fast);
-RTS_FUN(decodeDoublezh_fast);
-
-RTS_FUN(newMutVarzh_fast);
-RTS_FUN(atomicModifyMutVarzh_fast);
-
-RTS_FUN(isEmptyMVarzh_fast);
-RTS_FUN(newMVarzh_fast);
-RTS_FUN(takeMVarzh_fast);
-RTS_FUN(putMVarzh_fast);
-RTS_FUN(tryTakeMVarzh_fast);
-RTS_FUN(tryPutMVarzh_fast);
-
-RTS_FUN(waitReadzh_fast);
-RTS_FUN(waitWritezh_fast);
-RTS_FUN(delayzh_fast);
-#ifdef mingw32_HOST_OS
-RTS_FUN(asyncReadzh_fast);
-RTS_FUN(asyncWritezh_fast);
-RTS_FUN(asyncDoProczh_fast);
-#endif
-
-RTS_FUN(catchzh_fast);
-RTS_FUN(raisezh_fast);
-RTS_FUN(raiseIOzh_fast);
-
-RTS_FUN(makeStableNamezh_fast);
-RTS_FUN(makeStablePtrzh_fast);
-RTS_FUN(deRefStablePtrzh_fast);
-
-RTS_FUN(forkzh_fast);
-RTS_FUN(forkOnzh_fast);
-RTS_FUN(yieldzh_fast);
-RTS_FUN(killThreadzh_fast);
-RTS_FUN(blockAsyncExceptionszh_fast);
-RTS_FUN(unblockAsyncExceptionszh_fast);
-RTS_FUN(myThreadIdzh_fast);
-RTS_FUN(labelThreadzh_fast);
-RTS_FUN(isCurrentThreadBoundzh_fast);
-
-RTS_FUN(mkWeakzh_fast);
-RTS_FUN(finalizzeWeakzh_fast);
-RTS_FUN(deRefWeakzh_fast);
-
-RTS_FUN(newBCOzh_fast);
-RTS_FUN(mkApUpd0zh_fast);
-
-RTS_FUN(retryzh_fast);
-RTS_FUN(catchRetryzh_fast);
-RTS_FUN(catchSTMzh_fast);
-RTS_FUN(atomicallyzh_fast);
-RTS_FUN(newTVarzh_fast);
-RTS_FUN(readTVarzh_fast);
-RTS_FUN(writeTVarzh_fast);
-
-#endif /* STGMISCCLOSURES_H */
diff --git a/ghc/includes/StgProf.h b/ghc/includes/StgProf.h
deleted file mode 100644
index 9b3ce69a9f..0000000000
--- a/ghc/includes/StgProf.h
+++ /dev/null
@@ -1,238 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2004
- *
- * Macros for profiling operations in STG code
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef STGPROF_H
-#define STGPROF_H
-
-/* -----------------------------------------------------------------------------
- * Data Structures 
- * ---------------------------------------------------------------------------*/  
-/*
- * NB. be careful to avoid unwanted padding between fields, by
- * putting the 8-byte fields on an 8-byte boundary.  Padding can
- * vary between C compilers, and we don't take into account any
- * possible padding when generating CCS and CC decls in the code
- * generator (compiler/codeGen/CgProf.hs).
- */
-
-typedef struct _CostCentre {
-  StgInt ccID;
-
-  char * label;
-  char * module;
- 
-  /* used for accumulating costs at the end of the run... */
-  StgWord   time_ticks;
-  StgWord64 mem_alloc;      /* align 8 (see above) */
-
-  StgInt    is_caf;
-
-  struct _CostCentre *link;
-} CostCentre;
-
-typedef struct _CostCentreStack {
-  StgInt ccsID;
-
-  CostCentre *cc;
-  struct _CostCentreStack *prevStack;
-  struct _IndexTable *indexTable;
-
-  StgWord64  scc_count;       /* align 8 (see above) */
-  StgWord    selected;
-  StgWord    time_ticks;
-  StgWord64  mem_alloc;       /* align 8 (see above) */
-  StgWord64  inherited_alloc; /* align 8 (see above) */
-  StgWord    inherited_ticks;
-
-  CostCentre *root;
-} CostCentreStack;
-
-
-/* -----------------------------------------------------------------------------
- * The rest is PROFILING only...
- * ---------------------------------------------------------------------------*/
-
-#if defined(PROFILING)
-  
-/* -----------------------------------------------------------------------------
- * Constants
- * ---------------------------------------------------------------------------*/
-
-#define EMPTY_STACK NULL
-#define EMPTY_TABLE NULL
-
-/* Constants used to set sumbsumed flag on CostCentres */
-
-#define CC_IS_CAF      'c'            /* 'c'  => *is* a CAF cc           */
-#define CC_IS_BORING   'B'            /* 'B'  => *not* a CAF/sub cc      */
-
-
-/* -----------------------------------------------------------------------------
- * Data Structures
- * ---------------------------------------------------------------------------*/
-
-typedef struct _IndexTable {
-  CostCentre *cc;
-  CostCentreStack *ccs;
-  struct _IndexTable *next;
-  unsigned int back_edge;
-} IndexTable;
-
-     
-/* -----------------------------------------------------------------------------
-   Pre-defined cost centres and cost centre stacks
-   -------------------------------------------------------------------------- */
-
-extern CostCentreStack * RTS_VAR(CCCS);	        /* current CCS */
- 
-#if IN_STG_CODE
-
-extern StgWord CC_MAIN[];	
-extern StgWord CCS_MAIN[];      /* Top CCS */
-
-extern StgWord CC_SYSTEM[];	
-extern StgWord CCS_SYSTEM[];    /* RTS costs */
-
-extern StgWord CC_GC[];
-extern StgWord CCS_GC[];	 /* Garbage collector costs */
-
-extern StgWord CC_SUBSUMED[];	
-extern StgWord CCS_SUBSUMED[];   /* Costs are subsumed by caller */
-
-extern StgWord CC_OVERHEAD[];
-extern StgWord CCS_OVERHEAD[];   /* Profiling overhead */
-
-extern StgWord CC_DONT_CARE[];
-extern StgWord CCS_DONT_CARE[];  /* shouldn't ever get set */
-
-#else
-
-extern CostCentre      CC_MAIN[];	
-extern CostCentreStack CCS_MAIN[];      /* Top CCS */
-
-extern CostCentre      CC_SYSTEM[];	
-extern CostCentreStack CCS_SYSTEM[];    /* RTS costs */
-
-extern CostCentre      CC_GC[];
-extern CostCentreStack CCS_GC[];	 /* Garbage collector costs */
-
-extern CostCentre      CC_SUBSUMED[];	
-extern CostCentreStack CCS_SUBSUMED[];   /* Costs are subsumed by caller */
-
-extern CostCentre      CC_OVERHEAD[];
-extern CostCentreStack CCS_OVERHEAD[];   /* Profiling overhead */
-
-extern CostCentre      CC_DONT_CARE[];
-extern CostCentreStack CCS_DONT_CARE[];  /* shouldn't ever get set */
-
-#endif /* IN_STG_CODE */
-
-extern unsigned int RTS_VAR(CC_ID);	/* global ids */
-extern unsigned int RTS_VAR(CCS_ID);
-extern unsigned int RTS_VAR(HP_ID);
-
-extern unsigned int RTS_VAR(era);
-
-/* -----------------------------------------------------------------------------
- * Functions 
- * ---------------------------------------------------------------------------*/
-
-void EnterFunCCS ( CostCentreStack *ccsfn );
-CostCentreStack *PushCostCentre ( CostCentreStack *, CostCentre * );
-CostCentreStack *AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 );
-
-extern unsigned int RTS_VAR(entering_PAP);
-
-/* -----------------------------------------------------------------------------
- * Registering CCs
- 
- Cost centres are registered at startup by calling a registering
- routine in each module. Each module registers its cost centres and
- calls the registering routine for all imported modules. The RTS calls
- the registering routine for the module Main. This registering must be
- done before initialisation since the evaluation required for
- initialisation may use the cost centres.
- 
- As the code for each module uses tail calls we use an auxiliary stack
- (in the heap) to record imported modules still to be registered. At
- the bottom of the stack is NULL which indicates that
- @miniInterpretEnd@ should be resumed.
- 
- @START_REGISTER@ and @END_REGISTER@ are special macros used to
- delimit the function. @END_REGISTER@ pops the next registering
- routine off the stack and jumps to it. @REGISTER_CC@ registers a cost
- centre. @REGISTER_IMPORT@ pushes a modules registering routine onto
- the register stack.
-
- -------------------------------------------------------------------------- */
-
-extern CostCentre * RTS_VAR(CC_LIST);               /* registered CC list */
-extern CostCentreStack * RTS_VAR(CCS_LIST);         /* registered CCS list */
-
-#define REGISTER_CC(cc)					\
-	do {						\
-	extern CostCentre cc[];				\
-	if ((cc)->link == (CostCentre *)0) {		\
-	    (cc)->link = CC_LIST;			\
-	    CC_LIST = (cc);				\
-	    (cc)->ccID = CC_ID++; 			\
-	}} while(0)
-
-#define REGISTER_CCS(ccs)				\
-	do {						\
-	extern CostCentreStack ccs[];			\
-        if ((ccs)->prevStack == (CostCentreStack *)0) {	\
-	  (ccs)->prevStack = CCS_LIST;			\
-	  CCS_LIST = (ccs);				\
-	  (ccs)->ccsID = CCS_ID++;			\
-	}} while(0)
-
-/* -----------------------------------------------------------------------------
- * Declaring Cost Centres & Cost Centre Stacks.
- * -------------------------------------------------------------------------- */
-
-# define CC_DECLARE(cc_ident,name,module,caf,is_local)		\
-     is_local CostCentre cc_ident[1]				\
-	= {{ 0,							\
-	     name,						\
-	     module,						\
-             0,							\
-	     0,							\
-	     caf,						\
-	     0 }};
-
-# define CCS_DECLARE(ccs_ident,cc_ident,is_local)		\
-     is_local CostCentreStack ccs_ident[1]			\
-       = {{ ccsID 		: 0,				\
-	    cc 			: cc_ident,			\
-	    prevStack 		: NULL,				\
-	    indexTable 		: NULL,				\
-            selected            : 0,				\
-	    scc_count 		: 0,				\
-	    time_ticks 		: 0,				\
-	    mem_alloc 		: 0,				\
-	    inherited_ticks 	: 0,				\
-	    inherited_alloc	: 0,				\
-	    root 		: 0,				\
-       }};
-
-/* -----------------------------------------------------------------------------
- * Time / Allocation Macros
- * ---------------------------------------------------------------------------*/
-
-/* eliminate profiling overhead from allocation costs */
-#define CCS_ALLOC(ccs, size) (ccs)->mem_alloc += ((size)-sizeofW(StgProfHeader))
-
-#else /* !PROFILING */
-
-#define CCS_ALLOC(ccs, amount) doNothing()
- 
-#endif /* PROFILING */
-
-#endif /* STGPROF_H */
-
diff --git a/ghc/includes/StgTicky.h b/ghc/includes/StgTicky.h
deleted file mode 100644
index 27dd24edd9..0000000000
--- a/ghc/includes/StgTicky.h
+++ /dev/null
@@ -1,771 +0,0 @@
-/* ----------------------------------------------------------------------------
- *
- * (c) The AQUA project, Glasgow University, 1994-1997
- * (c) The GHC Team, 1998-1999
- *
- * Ticky-ticky profiling macros.
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef TICKY_H
-#define TICKY_H
-
-/* -----------------------------------------------------------------------------
-   The StgEntCounter type - needed regardless of TICKY_TICKY
-   -------------------------------------------------------------------------- */
-
-typedef struct _StgEntCounter {
-    StgWord16	registeredp;	/* 0 == no, 1 == yes */
-    StgWord16	arity;		/* arity (static info) */
-    StgWord16	stk_args;	/* # of args off stack */
-				/* (rest of args are in registers) */
-    char   	*str;		/* name of the thing */
-    char   	*arg_kinds;	/* info about the args types */
-    StgInt	entry_count;	/* Trips to fast entry code */
-    StgInt      allocs;         /* number of allocations by this fun */
-    struct _StgEntCounter *link;/* link to chain them all together */
-} StgEntCounter;
-
-
-#ifdef TICKY_TICKY
-
-/* -----------------------------------------------------------------------------
-   Allocations
-   -------------------------------------------------------------------------- */
-
-/* How many times we do a heap check and move Hp; comparing this with
- * the allocations gives an indication of how many things we get per trip
- * to the well:
- */
-#define TICK_ALLOC_HEAP(n, f_ct)		\
-  {						\
-    f_ct.allocs += (n);				\
-    ALLOC_HEAP_ctr++;				\
-    ALLOC_HEAP_tot += (n);			\
-  }
-
-#define TICK_ALLOC_HEAP_NOCTR(n)		\
-  {						\
-    ALLOC_HEAP_ctr++;				\
-    ALLOC_HEAP_tot += (n);			\
-  }
-
-/* We count things every time we allocate something in the dynamic heap.
- * For each, we count the number of words of (1) ``admin'' (header),
- * (2) good stuff (useful pointers and data), and (3) ``slop'' (extra
- * space, to leave room for an old generation indirection for example).
- * 
- * The first five macros are inserted when the compiler generates code
- * to allocate something; the categories correspond to the @ClosureClass@
- * datatype (manifest functions, thunks, constructors, big tuples, and
- * partial applications).
- */
-
-#define _HS  sizeofW(StgHeader)
-
-#define TICK_ALLOC_FUN(g,s) 				\
-	ALLOC_FUN_ctr++;	ALLOC_FUN_adm += _HS;	\
-	ALLOC_FUN_gds += (g);	ALLOC_FUN_slp += (s);	\
-	TICK_ALLOC_HISTO(FUN,_HS,g,s)
-
-#define TICK_ALLOC_UP_THK(g,s)                          \
-     	ALLOC_UP_THK_ctr++;	ALLOC_THK_adm += _HS;	\
-	ALLOC_THK_gds += (g);	ALLOC_THK_slp += (s);	\
-	TICK_ALLOC_HISTO(THK,_HS,g,s)
-
-#define TICK_ALLOC_SE_THK(g,s)                          \
-     	ALLOC_SE_THK_ctr++;	ALLOC_THK_adm += _HS;	\
-	ALLOC_THK_gds += (g);	ALLOC_THK_slp += (s);	\
-	TICK_ALLOC_HISTO(THK,_HS,g,s)
-
-#define TICK_ALLOC_CON(g,s)				\
-	ALLOC_CON_ctr++;	ALLOC_CON_adm += _HS;	\
-	ALLOC_CON_gds += (g);	ALLOC_CON_slp += (s);	\
-	TICK_ALLOC_HISTO(CON,_HS,g,s)
-
-#define TICK_ALLOC_TUP(g,s)				\
-	ALLOC_TUP_ctr++;	ALLOC_TUP_adm += _HS;	\
-	ALLOC_TUP_gds += (g);	ALLOC_TUP_slp += (s);	\
-	TICK_ALLOC_HISTO(TUP,_HS,g,s)
-
-#define TICK_ALLOC_BH(g,s)				\
-	ALLOC_BH_ctr++;		ALLOC_BH_adm += _HS;	\
-	ALLOC_BH_gds += (g);	ALLOC_BH_slp += (s);	\
-	TICK_ALLOC_HISTO(BH,_HS,g,s)
-
-/*
- * admin size doesn't take into account the FUN, that is accounted for
- * in the "goods".
- */
-#define TICK_ALLOC_PAP(g,s)					\
-	ALLOC_PAP_ctr++;      ALLOC_PAP_adm += sizeofW(StgPAP)-1; \
-	ALLOC_PAP_gds += (g); ALLOC_PAP_slp += (s);	\
-	TICK_ALLOC_HISTO(PAP,sizeofW(StgPAP)-1,g,s)
-
-#define TICK_ALLOC_TSO(g,s)						\
-	ALLOC_TSO_ctr++;	ALLOC_TSO_adm += sizeofW(StgTSO);	\
-	ALLOC_TSO_gds += (g);	ALLOC_TSO_slp += (s);			\
-	TICK_ALLOC_HISTO(TSO,sizeofW(StgTSO),g,s)
-     
-#ifdef PAR
-#define TICK_ALLOC_FMBQ(a,g,s) 				\
-	ALLOC_FMBQ_ctr++;	ALLOC_FMBQ_adm += (a);	\
-	ALLOC_FMBQ_gds += (g);	ALLOC_FMBQ_slp += (s);	\
-	TICK_ALLOC_HISTO(FMBQ,a,g,s)
-
-#define TICK_ALLOC_FME(a,g,s) 				\
-	ALLOC_FME_ctr++;	ALLOC_FME_adm += (a);	\
-	ALLOC_FME_gds += (g);	ALLOC_FME_slp += (s);	\
-	TICK_ALLOC_HISTO(FME,a,g,s)
-
-#define TICK_ALLOC_BF(a,g,s)  				\
-	ALLOC_BF_ctr++;	ALLOC_BF_adm += (a);		\
-	ALLOC_BF_gds += (g);	ALLOC_BF_slp += (s);	\
-	TICK_ALLOC_HISTO(BF,a,g,s)
-#endif
-     
-/* The histogrammy bit is fairly straightforward; the -2 is: one for
- * 0-origin C arrays; the other one because we do no one-word
- * allocations, so we would never inc that histogram slot; so we shift
- * everything over by one.
- */
-#define TICK_ALLOC_HISTO(categ,a,g,s)				\
-	{ I_ __idx;						\
-	  __idx = (a) + (g) + (s) - 2;				\
-	 ALLOC_##categ##_hst[((__idx > 4) ? 4 : __idx)] += 1;} 
-
-/* Some hard-to-account-for words are allocated by/for primitives,
- * includes Integer support.  ALLOC_PRIM2 tells us about these.  We
- * count everything as ``goods'', which is not strictly correct.
- * (ALLOC_PRIM is the same sort of stuff, but we know the
- * admin/goods/slop breakdown.)
- */
-#define TICK_ALLOC_PRIM(a,g,s)				\
-	ALLOC_PRIM_ctr++;	ALLOC_PRIM_adm += (a);	\
-	ALLOC_PRIM_gds += (g); 	ALLOC_PRIM_slp += (s);	\
-	TICK_ALLOC_HISTO(PRIM,a,g,s)
-
-#define TICK_ALLOC_PRIM2(w) ALLOC_PRIM_ctr++; ALLOC_PRIM_gds +=(w); \
-		       TICK_ALLOC_HISTO(PRIM,0,w,0)
-
-
-/* -----------------------------------------------------------------------------
-   Enters
-   -------------------------------------------------------------------------- */
-
-#define TICK_ENT_VIA_NODE()	ENT_VIA_NODE_ctr++
-
-#define TICK_ENT_STATIC_THK()	ENT_STATIC_THK_ctr++ 
-#define TICK_ENT_DYN_THK()	ENT_DYN_THK_ctr++
-
-#define TICK_CTR(f_ct, str, arity, args, arg_kinds)	\
-   static StgEntCounter f_ct			\
-	= { 0, arity, args,			\
-	    str, arg_kinds, 			\
-	    0, 0, NULL };
-
-#define TICK_ENT_FUN_DIRECT_BODY(f_ct)                          \
-	{							\
-	  if ( ! f_ct.registeredp ) {				\
-	    /* hook this one onto the front of the list */	\
-	    f_ct.link = ticky_entry_ctrs;			\
-	    ticky_entry_ctrs = & (f_ct);			\
-	    /* mark it as "registered" */			\
-	    f_ct.registeredp = 1;				\
-	  }							\
-	  f_ct.entry_count += 1;				\
-	}
-
-#define TICK_ENT_STATIC_FUN_DIRECT(f_ct)			\
-        TICK_ENT_FUN_DIRECT_BODY(f_ct)                          \
-	ENT_STATIC_FUN_DIRECT_ctr++ /* The static total one */
-
-#define TICK_ENT_DYN_FUN_DIRECT(f_ct)				\
-        TICK_ENT_FUN_DIRECT_BODY(f_ct)                          \
-	ENT_DYN_FUN_DIRECT_ctr++ /* The dynamic total one */
-
-extern StgEntCounter top_ct;
-extern StgEntCounter *ticky_entry_ctrs;
-
-#define TICK_ENT_STATIC_CON(n)	ENT_STATIC_CON_ctr++  /* enter static constructor */
-#define TICK_ENT_DYN_CON(n)	ENT_DYN_CON_ctr++     /* enter dynamic constructor */
-#define TICK_ENT_STATIC_IND(n)	ENT_STATIC_IND_ctr++  /* enter static indirection */
-#define TICK_ENT_DYN_IND(n)	ENT_DYN_IND_ctr++     /* enter dynamic indirection */
-#define TICK_ENT_PERM_IND(n)    ENT_PERM_IND_ctr++    /* enter permanent indirection */
-#define TICK_ENT_PAP(n)		ENT_PAP_ctr++	      /* enter PAP */
-#define TICK_ENT_AP(n) 	        ENT_AP_ctr++          /* enter AP_UPD */
-#define TICK_ENT_AP_STACK(n)    ENT_AP_STACK_ctr++    /* enter AP_STACK_UPD */
-#define TICK_ENT_BH()		ENT_BH_ctr++          /* enter BLACKHOLE */
-
-
-#define TICK_SLOW_HISTO(n)				\
- { unsigned __idx;					\
-   __idx = (n);						\
-   SLOW_CALL_hst[((__idx > 8) ? 8 : __idx)] += 1;	\
- }
-
-#define UNDO_TICK_SLOW_HISTO(n)				\
- { unsigned __idx;					\
-   __idx = (n);						\
-   SLOW_CALL_hst[((__idx > 8) ? 8 : __idx)] -= 1;	\
- }
-
-/*
- * A slow call with n arguments.  In the unevald case, this call has
- * already been counted once, so don't count it again.
- */
-#define TICK_SLOW_CALL(n) \
-  SLOW_CALL_ctr++; \
-  TICK_SLOW_HISTO(n)
-
-/*
- * This slow call was found to be to an unevaluated function; undo the
- * ticks we did in TICK_SLOW_CALL.
- */
-#define TICK_SLOW_CALL_UNEVALD(n) \
-  SLOW_CALL_UNEVALD_ctr++; \
-  SLOW_CALL_ctr--; \
-  UNDO_TICK_SLOW_HISTO(n)
-
-#define TICK_MULTI_CHUNK_SLOW_CALL(pattern, chunks) \
-  fprintf(stderr, "Multi-chunk slow call: %s\n", pattern); \
-  MULTI_CHUNK_SLOW_CALL_ctr++; \
-  MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr += chunks;
-
-/* A completely unknown tail-call */
-#define TICK_UNKNOWN_CALL()               UNKNOWN_CALL_ctr++
-
-/*
- * slow call patterns (includes "extra" args to known calls,
- * so the total of these will be greater than UNKNOWN_CALL_ctr).
- */
-#define TICK_SLOW_CALL_v()             SLOW_CALL_v_ctr++
-#define TICK_SLOW_CALL_f()             SLOW_CALL_f_ctr++
-#define TICK_SLOW_CALL_d()             SLOW_CALL_d_ctr++
-#define TICK_SLOW_CALL_l()             SLOW_CALL_l_ctr++
-#define TICK_SLOW_CALL_n()             SLOW_CALL_n_ctr++
-#define TICK_SLOW_CALL_p()             SLOW_CALL_p_ctr++
-#define TICK_SLOW_CALL_pv()            SLOW_CALL_pv_ctr++
-#define TICK_SLOW_CALL_pp()            SLOW_CALL_pp_ctr++
-#define TICK_SLOW_CALL_ppv()           SLOW_CALL_ppv_ctr++
-#define TICK_SLOW_CALL_ppp()           SLOW_CALL_ppp_ctr++
-#define TICK_SLOW_CALL_pppv()          SLOW_CALL_pppv_ctr++
-#define TICK_SLOW_CALL_pppp()          SLOW_CALL_pppp_ctr++
-#define TICK_SLOW_CALL_ppppp()         SLOW_CALL_ppppp_ctr++
-#define TICK_SLOW_CALL_pppppp()        SLOW_CALL_pppppp_ctr++
-#define TICK_SLOW_CALL_OTHER(pattern) \
-     fprintf(stderr,"slow call: %s\n", pattern); \
-     SLOW_CALL_OTHER_ctr++
-
-#define TICK_KNOWN_CALL()               KNOWN_CALL_ctr++
-#define TICK_KNOWN_CALL_TOO_FEW_ARGS()  KNOWN_CALL_TOO_FEW_ARGS_ctr++
-#define TICK_KNOWN_CALL_EXTRA_ARGS()    KNOWN_CALL_EXTRA_ARGS_ctr++
-
-/* A slow call to a FUN found insufficient arguments, and built a PAP */
-#define TICK_SLOW_CALL_FUN_TOO_FEW()	    SLOW_CALL_FUN_TOO_FEW_ctr++
-#define TICK_SLOW_CALL_FUN_CORRECT()	    SLOW_CALL_FUN_CORRECT_ctr++
-#define TICK_SLOW_CALL_FUN_TOO_MANY()	    SLOW_CALL_FUN_TOO_MANY_ctr++
-#define TICK_SLOW_CALL_PAP_TOO_FEW()	    SLOW_CALL_PAP_TOO_FEW_ctr++
-#define TICK_SLOW_CALL_PAP_CORRECT()	    SLOW_CALL_PAP_CORRECT_ctr++
-#define TICK_SLOW_CALL_PAP_TOO_MANY()	    SLOW_CALL_PAP_TOO_MANY_ctr++
-  
-/* -----------------------------------------------------------------------------
-   Returns
-   -------------------------------------------------------------------------- */
-
-#define TICK_RET_HISTO(categ,n)					\
-	{ I_ __idx;						\
-	  __idx = (n);						\
-	 RET_##categ##_hst[((__idx > 8) ? 8 : __idx)] += 1;} 
-
-#define TICK_RET_NEW(n)	RET_NEW_ctr++; \
-			TICK_RET_HISTO(NEW,n)
-
-#define TICK_RET_OLD(n)	RET_OLD_ctr++; \
-			TICK_RET_HISTO(OLD,n)
-
-#define TICK_RET_UNBOXED_TUP(n)  RET_UNBOXED_TUP_ctr++; \
-                         TICK_RET_HISTO(UNBOXED_TUP,n)
-
-#define TICK_VEC_RETURN(n)	VEC_RETURN_ctr++;	    \
-				TICK_RET_HISTO(VEC_RETURN,n)
-
-/* -----------------------------------------------------------------------------
-   Stack Frames
-
-   Macro			   Counts
-   ------------------              -------------------------------------------
-   TICK_UPDF_PUSHED	 	   Update frame pushed
-   TICK_CATCHF_PUSHED	 	   Catch frame pushed
-   TICK_UPDF_OMITTED		   A thunk decided not to push an update frame
-   TICK_UPDF_RCC_PUSHED		   Cost Centre restore frame pushed
-   TICK_UPDF_RCC_OMITTED	   Cost Centres not required -- not pushed
-
-   -------------------------------------------------------------------------- */
-
-#define TICK_UPDF_OMITTED()	UPDF_OMITTED_ctr++
-#define TICK_UPDF_PUSHED(tgt,inf)	UPDF_PUSHED_ctr++ \
-/*                              ; fprintf(stderr,"UPDF_PUSHED:%p:%p\n",tgt,inf) */
-#define TICK_CATCHF_PUSHED()    CATCHF_PUSHED_ctr++
-#define TICK_UPDF_RCC_PUSHED()	UPDF_RCC_PUSHED_ctr++
-#define TICK_UPDF_RCC_OMITTED()	UPDF_RCC_OMITTED_ctr++
-
-/* -----------------------------------------------------------------------------
-   Updates
-
-   These macros record information when we do an update.  We always
-   update either with a data constructor (CON) or a partial application
-   (PAP).
-   
-   
-   Macro				Where
-   -----------------------  	--------------------------------------------
-   TICK_UPD_SQUEEZED		Same as UPD_EXISTING but because
-   				of stack-squeezing
-
-   TICK_UPD_CON_IN_NEW		Allocating a new CON
-   TICK_UPD_CON_IN_PLACE	Updating with a PAP in place
-   TICK_UPD_PAP_IN_NEW		Allocating a new PAP
-   TICK_UPD_PAP_IN_PLACE	Updating with a PAP in place
-
-   ToDo: the IN_PLACE versions are not relevant any more.
-   -------------------------------------------------------------------------- */
-
-#define TICK_UPD_HISTO(categ,n) \
-	{ I_ __idx;						 \
-	  __idx = (n);						 \
-	 UPD_##categ##_hst[((__idx > 8) ? 8 : __idx)] += 1;} 
-
-#define TICK_UPD_SQUEEZED()		UPD_SQUEEZED_ctr++
-
-#define TICK_UPD_CON_IN_NEW(n)		UPD_CON_IN_NEW_ctr++ ; \
-					TICK_UPD_HISTO(CON_IN_NEW,n)
-
-#define TICK_UPD_CON_IN_PLACE(n)	UPD_CON_IN_PLACE_ctr++; \
-					TICK_UPD_HISTO(CON_IN_PLACE,n)
-
-#define TICK_UPD_PAP_IN_NEW(n)		UPD_PAP_IN_NEW_ctr++ ; \
-					TICK_UPD_HISTO(PAP_IN_NEW,n)
-
-#define TICK_UPD_PAP_IN_PLACE()		UPD_PAP_IN_PLACE_ctr++
-
-/* For the generational collector: 
- */
-#define TICK_UPD_NEW_IND()		UPD_NEW_IND_ctr++
-#define TICK_UPD_NEW_PERM_IND(tgt)	UPD_NEW_PERM_IND_ctr++ \
-/*                                      ; fprintf(stderr,"UPD_NEW_PERM:%p\n",tgt) */
-#define TICK_UPD_OLD_IND()		UPD_OLD_IND_ctr++			
-#define TICK_UPD_OLD_PERM_IND()		UPD_OLD_PERM_IND_ctr++			
-
-/* Count blackholes:
- */
-#define TICK_UPD_BH_UPDATABLE()         UPD_BH_UPDATABLE_ctr++
-#define TICK_UPD_BH_SINGLE_ENTRY()      UPD_BH_SINGLE_ENTRY_ctr++
-#define TICK_UPD_CAF_BH_UPDATABLE(s)                          \
-     UPD_CAF_BH_UPDATABLE_ctr++                               \
-/*   ; fprintf(stderr,"TICK_UPD_CAF_BH_UPDATABLE(%s)\n",s) */
-#define TICK_UPD_CAF_BH_SINGLE_ENTRY(s)                       \
-     UPD_CAF_BH_SINGLE_ENTRY_ctr++                            \
-/*   ; fprintf(stderr,"TICK_UPD_CAF_BH_SINGLE_ENTRY(%s)\n",s) */
-
-
-/* -----------------------------------------------------------------------------
-   Garbage collection counters
-   -------------------------------------------------------------------------- */
-
-/* Selectors:
- *
- * GC_SEL_ABANDONED: we could've done the selection, but we gave up
- * (e.g., to avoid overflowing the C stack); GC_SEL_MINOR: did a
- * selection in a minor GC; GC_SEL_MAJOR: ditto, but major GC.
- */
-#define TICK_GC_SEL_ABANDONED()		GC_SEL_ABANDONED_ctr++
-#define TICK_GC_SEL_MINOR()		GC_SEL_MINOR_ctr++
-#define TICK_GC_SEL_MAJOR()		GC_SEL_MAJOR_ctr++
-
-/* Failed promotion: we wanted to promote an object early, but
- * it had already been evacuated to (or resided in) a younger
- * generation.
- */
-#define TICK_GC_FAILED_PROMOTION()	GC_FAILED_PROMOTION_ctr++
-
-/* Bytes copied: this is a fairly good measure of GC cost and depends
- * on all sorts of things like number of generations, aging, eager
- * promotion, generation sizing policy etc.
- */
-#define TICK_GC_WORDS_COPIED(n)         GC_WORDS_COPIED_ctr+=(n)
-
-/* -----------------------------------------------------------------------------
-   The accumulators (extern decls)
-   -------------------------------------------------------------------------- */
-
-#ifdef TICKY_C
-#define INIT(ializer) = ializer
-#define EXTERN
-#else
-#define INIT(ializer)
-#define EXTERN extern
-#endif
-
-EXTERN unsigned long ALLOC_HEAP_ctr INIT(0);
-EXTERN unsigned long ALLOC_HEAP_tot INIT(0);
-
-EXTERN unsigned long ALLOC_FUN_ctr INIT(0);
-EXTERN unsigned long ALLOC_FUN_adm INIT(0);
-EXTERN unsigned long ALLOC_FUN_gds INIT(0);
-EXTERN unsigned long ALLOC_FUN_slp INIT(0);
-EXTERN unsigned long ALLOC_FUN_hst[5] 
-#ifdef TICKY_C
-   = {0,0,0,0,0}  /* urk, can't use INIT macro 'cause of the commas */
-#endif
-;
-
-EXTERN unsigned long ALLOC_UP_THK_ctr INIT(0);
-EXTERN unsigned long ALLOC_SE_THK_ctr INIT(0);
-EXTERN unsigned long ALLOC_THK_adm INIT(0);
-EXTERN unsigned long ALLOC_THK_gds INIT(0);
-EXTERN unsigned long ALLOC_THK_slp INIT(0);
-EXTERN unsigned long ALLOC_THK_hst[5]
-#ifdef TICKY_C
-   = {0,0,0,0,0}
-#endif
-;
-
-EXTERN unsigned long ALLOC_CON_ctr INIT(0);
-EXTERN unsigned long ALLOC_CON_adm INIT(0);
-EXTERN unsigned long ALLOC_CON_gds INIT(0);
-EXTERN unsigned long ALLOC_CON_slp INIT(0);
-EXTERN unsigned long ALLOC_CON_hst[5]
-#ifdef TICKY_C
-   = {0,0,0,0,0}
-#endif
-;
-
-EXTERN unsigned long ALLOC_TUP_ctr INIT(0);
-EXTERN unsigned long ALLOC_TUP_adm INIT(0);
-EXTERN unsigned long ALLOC_TUP_gds INIT(0);
-EXTERN unsigned long ALLOC_TUP_slp INIT(0);
-EXTERN unsigned long ALLOC_TUP_hst[5]
-#ifdef TICKY_C
-   = {0,0,0,0,0}
-#endif
-;
-
-EXTERN unsigned long ALLOC_BH_ctr INIT(0);
-EXTERN unsigned long ALLOC_BH_adm INIT(0);
-EXTERN unsigned long ALLOC_BH_gds INIT(0);
-EXTERN unsigned long ALLOC_BH_slp INIT(0);
-EXTERN unsigned long ALLOC_BH_hst[5]
-#ifdef TICKY_C
-   = {0,0,0,0,0}
-#endif
-;
-
-EXTERN unsigned long ALLOC_PRIM_ctr INIT(0);
-EXTERN unsigned long ALLOC_PRIM_adm INIT(0);
-EXTERN unsigned long ALLOC_PRIM_gds INIT(0);
-EXTERN unsigned long ALLOC_PRIM_slp INIT(0);
-EXTERN unsigned long ALLOC_PRIM_hst[5]
-#ifdef TICKY_C
-   = {0,0,0,0,0}
-#endif
-;
-
-EXTERN unsigned long ALLOC_PAP_ctr INIT(0);
-EXTERN unsigned long ALLOC_PAP_adm INIT(0);
-EXTERN unsigned long ALLOC_PAP_gds INIT(0);
-EXTERN unsigned long ALLOC_PAP_slp INIT(0);
-EXTERN unsigned long ALLOC_PAP_hst[5]
-#ifdef TICKY_C
-   = {0,0,0,0,0}
-#endif
-;
-
-EXTERN unsigned long ALLOC_TSO_ctr INIT(0);
-EXTERN unsigned long ALLOC_TSO_adm INIT(0);
-EXTERN unsigned long ALLOC_TSO_gds INIT(0);
-EXTERN unsigned long ALLOC_TSO_slp INIT(0);
-EXTERN unsigned long ALLOC_TSO_hst[5]
-#ifdef TICKY_C
-   = {0,0,0,0,0}
-#endif
-;
-
-# ifdef PAR
-EXTERN unsigned long ALLOC_FMBQ_ctr INIT(0);
-EXTERN unsigned long ALLOC_FMBQ_adm INIT(0);
-EXTERN unsigned long ALLOC_FMBQ_gds INIT(0);
-EXTERN unsigned long ALLOC_FMBQ_slp INIT(0);
-EXTERN unsigned long ALLOC_FMBQ_hst[5]
-#ifdef TICKY_C
-   = {0,0,0,0,0}
-#endif
-;
-
-EXTERN unsigned long ALLOC_FME_ctr INIT(0);
-EXTERN unsigned long ALLOC_FME_adm INIT(0);
-EXTERN unsigned long ALLOC_FME_gds INIT(0);
-EXTERN unsigned long ALLOC_FME_slp INIT(0);
-EXTERN unsigned long ALLOC_FME_hst[5]
-#ifdef TICKY_C
-   = {0,0,0,0,0}
-#endif
-;
-
-EXTERN unsigned long ALLOC_BF_ctr INIT(0);
-EXTERN unsigned long ALLOC_BF_adm INIT(0);
-EXTERN unsigned long ALLOC_BF_gds INIT(0);
-EXTERN unsigned long ALLOC_BF_slp INIT(0);
-EXTERN unsigned long ALLOC_BF_hst[5]
-#ifdef TICKY_C
-   = {0,0,0,0,0}
-#endif
-;
-#endif /* PAR */
-
-EXTERN unsigned long ENT_VIA_NODE_ctr INIT(0);
-EXTERN unsigned long ENT_STATIC_THK_ctr INIT(0);
-EXTERN unsigned long ENT_DYN_THK_ctr INIT(0);
-EXTERN unsigned long ENT_STATIC_FUN_DIRECT_ctr INIT(0);
-EXTERN unsigned long ENT_DYN_FUN_DIRECT_ctr INIT(0);
-EXTERN unsigned long ENT_STATIC_CON_ctr INIT(0);
-EXTERN unsigned long ENT_DYN_CON_ctr INIT(0);
-EXTERN unsigned long ENT_STATIC_IND_ctr INIT(0);
-EXTERN unsigned long ENT_DYN_IND_ctr INIT(0);
-EXTERN unsigned long ENT_PERM_IND_ctr INIT(0);
-EXTERN unsigned long ENT_PAP_ctr INIT(0);
-EXTERN unsigned long ENT_AP_ctr INIT(0);
-EXTERN unsigned long ENT_AP_STACK_ctr INIT(0);
-EXTERN unsigned long ENT_BH_ctr INIT(0);
-
-EXTERN unsigned long UNKNOWN_CALL_ctr INIT(0);
-
-EXTERN unsigned long SLOW_CALL_v_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_f_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_d_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_l_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_n_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_p_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_pv_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_pp_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_ppv_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_ppp_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_pppv_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_pppp_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_ppppp_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_pppppp_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_OTHER_ctr INIT(0);
-
-EXTERN unsigned long ticky_slow_call_unevald INIT(0);
-EXTERN unsigned long SLOW_CALL_ctr INIT(0);
-EXTERN unsigned long MULTI_CHUNK_SLOW_CALL_ctr INIT(0);
-EXTERN unsigned long MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr INIT(0);
-EXTERN unsigned long KNOWN_CALL_ctr INIT(0);
-EXTERN unsigned long KNOWN_CALL_TOO_FEW_ARGS_ctr INIT(0);
-EXTERN unsigned long KNOWN_CALL_EXTRA_ARGS_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_FUN_TOO_FEW_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_FUN_CORRECT_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_FUN_TOO_MANY_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_PAP_TOO_FEW_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_PAP_CORRECT_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_PAP_TOO_MANY_ctr INIT(0);
-EXTERN unsigned long SLOW_CALL_UNEVALD_ctr INIT(0);
-
-EXTERN unsigned long SLOW_CALL_hst[8]
-#ifdef TICKY_C
-   = {0,0,0,0,0,0,0,0}
-#endif
-;
-
-EXTERN unsigned long RET_NEW_ctr INIT(0);
-EXTERN unsigned long RET_OLD_ctr INIT(0);
-EXTERN unsigned long RET_UNBOXED_TUP_ctr INIT(0);
-
-EXTERN unsigned long VEC_RETURN_ctr INIT(0);
-
-EXTERN unsigned long RET_NEW_hst[9]
-#ifdef TICKY_C
-   = {0,0,0,0,0,0,0,0,0}
-#endif
-;
-EXTERN unsigned long RET_OLD_hst[9]
-#ifdef TICKY_C
-   = {0,0,0,0,0,0,0,0,0}
-#endif
-;
-EXTERN unsigned long RET_UNBOXED_TUP_hst[9]
-#ifdef TICKY_C
-   = {0,0,0,0,0,0,0,0,0}
-#endif
-;
-EXTERN unsigned long RET_SEMI_IN_HEAP_hst[9]
-#ifdef TICKY_C
-   = {0,0,0,0,0,0,0,0,0}
-#endif
-;
-EXTERN unsigned long RET_VEC_RETURN_hst[9]
-#ifdef TICKY_C
-   = {0,0,0,0,0,0,0,0,0}
-#endif
-;
-
-EXTERN unsigned long RET_SEMI_loads_avoided INIT(0);
-
-EXTERN unsigned long UPDF_OMITTED_ctr INIT(0);
-EXTERN unsigned long UPDF_PUSHED_ctr INIT(0);
-EXTERN unsigned long CATCHF_PUSHED_ctr INIT(0);
-EXTERN unsigned long UPDF_RCC_PUSHED_ctr INIT(0);
-EXTERN unsigned long UPDF_RCC_OMITTED_ctr INIT(0);
-
-EXTERN unsigned long UPD_SQUEEZED_ctr INIT(0);
-EXTERN unsigned long UPD_CON_IN_NEW_ctr INIT(0);
-EXTERN unsigned long UPD_CON_IN_PLACE_ctr INIT(0);
-EXTERN unsigned long UPD_PAP_IN_NEW_ctr INIT(0);
-EXTERN unsigned long UPD_PAP_IN_PLACE_ctr INIT(0);
-
-EXTERN unsigned long UPD_CON_IN_NEW_hst[9]
-#ifdef TICKY_C
-   = {0,0,0,0,0,0,0,0,0}
-#endif
-;
-EXTERN unsigned long UPD_CON_IN_PLACE_hst[9]
-#ifdef TICKY_C
-   = {0,0,0,0,0,0,0,0,0}
-#endif
-;
-EXTERN unsigned long UPD_PAP_IN_NEW_hst[9]
-#ifdef TICKY_C
-   = {0,0,0,0,0,0,0,0,0}
-#endif
-;
-
-EXTERN unsigned long UPD_NEW_IND_ctr INIT(0);
-EXTERN unsigned long UPD_NEW_PERM_IND_ctr INIT(0);
-EXTERN unsigned long UPD_OLD_IND_ctr INIT(0);
-EXTERN unsigned long UPD_OLD_PERM_IND_ctr INIT(0);
-
-EXTERN unsigned long UPD_BH_UPDATABLE_ctr INIT(0);
-EXTERN unsigned long UPD_BH_SINGLE_ENTRY_ctr INIT(0);
-EXTERN unsigned long UPD_CAF_BH_UPDATABLE_ctr INIT(0);
-EXTERN unsigned long UPD_CAF_BH_SINGLE_ENTRY_ctr INIT(0);
-
-EXTERN unsigned long GC_SEL_ABANDONED_ctr INIT(0);
-EXTERN unsigned long GC_SEL_MINOR_ctr INIT(0);
-EXTERN unsigned long GC_SEL_MAJOR_ctr INIT(0);
-
-EXTERN unsigned long GC_FAILED_PROMOTION_ctr INIT(0);
-
-EXTERN unsigned long GC_WORDS_COPIED_ctr INIT(0);
-
-#undef INIT
-#undef EXTERN
-
-/* -----------------------------------------------------------------------------
-   Just stubs if no ticky-ticky profiling
-   -------------------------------------------------------------------------- */
-
-#else /* !TICKY_TICKY */
-
-#define TICK_ALLOC_HEAP(words, f_ct)
-#define TICK_ALLOC_HEAP_NOCTR(words)
-
-#define TICK_ALLOC_FUN(g,s)
-#define TICK_ALLOC_UP_THK(g,s)
-#define TICK_ALLOC_SE_THK(g,s)
-#define TICK_ALLOC_CON(g,s)
-#define TICK_ALLOC_TUP(g,s)
-#define TICK_ALLOC_BH(g,s)
-#define TICK_ALLOC_PAP(g,s)
-#define TICK_ALLOC_TSO(g,s)
-#define TICK_ALLOC_FMBQ(a,g,s)
-#define TICK_ALLOC_FME(a,g,s)
-#define TICK_ALLOC_BF(a,g,s)
-#define TICK_ALLOC_PRIM(a,g,s)
-#define TICK_ALLOC_PRIM2(w)
-
-#define TICK_ENT_VIA_NODE()	
-				
-#define TICK_ENT_STATIC_THK()
-#define TICK_ENT_DYN_THK()
-#define TICK_ENT_STATIC_FUN_DIRECT(n)
-#define TICK_ENT_DYN_FUN_DIRECT(n)
-#define TICK_ENT_STATIC_CON(n)
-#define TICK_ENT_DYN_CON(n)
-#define TICK_ENT_STATIC_IND(n)
-#define TICK_ENT_DYN_IND(n)
-#define TICK_ENT_PERM_IND(n)
-#define TICK_ENT_PAP(n)
-#define TICK_ENT_AP(n)
-#define TICK_ENT_AP_STACK(n)
-#define TICK_ENT_BH()
-
-#define TICK_SLOW_CALL(n)
-#define TICK_SLOW_CALL_UNEVALD(n)
-#define TICK_SLOW_CALL_FUN_TOO_FEW()
-#define TICK_SLOW_CALL_FUN_CORRECT()
-#define TICK_SLOW_CALL_FUN_TOO_MANY()
-#define TICK_SLOW_CALL_PAP_TOO_FEW()
-#define TICK_SLOW_CALL_PAP_CORRECT()
-#define TICK_SLOW_CALL_PAP_TOO_MANY()
-
-#define TICK_SLOW_CALL_v()
-#define TICK_SLOW_CALL_f()
-#define TICK_SLOW_CALL_d()
-#define TICK_SLOW_CALL_l()
-#define TICK_SLOW_CALL_n()
-#define TICK_SLOW_CALL_p()
-#define TICK_SLOW_CALL_pv()
-#define TICK_SLOW_CALL_pp()
-#define TICK_SLOW_CALL_ppv()
-#define TICK_SLOW_CALL_ppp()
-#define TICK_SLOW_CALL_pppv()
-#define TICK_SLOW_CALL_pppp()
-#define TICK_SLOW_CALL_ppppp()
-#define TICK_SLOW_CALL_pppppp()
-#define TICK_SLOW_CALL_OTHER(pattern)
-
-#define TICK_KNOWN_CALL()
-#define TICK_KNOWN_CALL_TOO_FEW_ARGS()
-#define TICK_KNOWN_CALL_EXTRA_ARGS()
-#define TICK_UNKNOWN_CALL()
-
-#define TICK_RET_NEW(n)
-#define TICK_RET_OLD(n)
-#define TICK_RET_UNBOXED_TUP(n)
-#define TICK_RET_SEMI(n)
-#define TICK_RET_SEMI_BY_DEFAULT()
-#define TICK_RET_SEMI_FAILED(tag)
-#define TICK_VEC_RETURN(n)
-
-#define TICK_UPDF_OMITTED()
-#define TICK_UPDF_PUSHED(tgt,inf)
-#define TICK_CATCHF_PUSHED()
-#define TICK_UPDF_RCC_PUSHED()
-#define TICK_UPDF_RCC_OMITTED()
-
-#define TICK_UPD_SQUEEZED()
-#define TICK_UPD_CON_IN_NEW(n)
-#define TICK_UPD_CON_IN_PLACE(n)
-#define TICK_UPD_PAP_IN_NEW(n)
-#define TICK_UPD_PAP_IN_PLACE()
-
-#define TICK_UPD_NEW_IND()
-#define TICK_UPD_NEW_PERM_IND(tgt)
-#define TICK_UPD_OLD_IND()
-#define TICK_UPD_OLD_PERM_IND()
-
-#define TICK_UPD_BH_UPDATABLE()
-#define TICK_UPD_BH_SINGLE_ENTRY()
-#define TICK_UPD_CAF_BH_UPDATABLE()
-#define TICK_UPD_CAF_BH_SINGLE_ENTRY()
-
-#define TICK_GC_SEL_ABANDONED()
-#define TICK_GC_SEL_MINOR()
-#define TICK_GC_SEL_MAJOR()
-
-#define TICK_GC_FAILED_PROMOTION()
-#define TICK_GC_WORDS_COPIED(n)
-
-#endif /* !TICKY_TICKY */
-
-#endif /* TICKY_H */
diff --git a/ghc/includes/StgTypes.h b/ghc/includes/StgTypes.h
deleted file mode 100644
index ac2f78e27c..0000000000
--- a/ghc/includes/StgTypes.h
+++ /dev/null
@@ -1,152 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Various C datatypes used in the run-time system.  This is the
- * lowest-level include file, after ghcconfig.h and RtsConfig.h.
- *
- * This module should define types *only*, all beginning with "Stg".
- *
- * Specifically:
-
-	StgInt8,  16, 32, 64
-	StgWord8, 16, 32, 64
-	StgChar, StgFloat, StgDouble
-
-	***** All the same size (i.e. sizeof(void *)): *****
-	StgPtr			Basic pointer type
-	StgWord			Unit of heap allocation
-	StgInt			Signed version of StgWord
-	StgAddr			Generic address type
-	
-	StgBool, StgVoid, StgClosurePtr, StgPtr, StgOffset, 
-	StgTSOPtr, StgForeignPtr, StgStackOffset, StgStackPtr,
-	StgCode, StgArray, StgByteArray, StgStablePtr, StgFunPtr,
-	StgUnion.
-
- * WARNING: Keep this file, MachDeps.h, and HsFFI.h in synch!
- *
- * NOTE: assumes #include "ghcconfig.h"
- * 
- * Works with or without _POSIX_SOURCE.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef STGTYPES_H
-#define STGTYPES_H
-
-/*
- * First, platform-dependent definitions of size-specific integers.
- * Assume for now that the int type is 32 bits.
- * NOTE: Synch the following definitions with MachDeps.h!
- * ToDo: move these into a platform-dependent file.
- */
-
-typedef signed   char            StgInt8;
-typedef unsigned char            StgWord8;
-
-typedef signed   short           StgInt16;
-typedef unsigned short           StgWord16;
-
-#if SIZEOF_UNSIGNED_INT == 4
-typedef signed   int             StgInt32;
-typedef unsigned int             StgWord32;
-#else
-#error GHC untested on this architecture: sizeof(unsigned int) != 4
-#endif
-
-#ifdef SUPPORT_LONG_LONGS
-/* assume long long is 64 bits */
-# ifndef _MSC_VER
-typedef signed long long int   StgInt64;
-typedef unsigned long long int StgWord64;
-# else
-typedef __int64 StgInt64;
-typedef unsigned __int64 StgWord64;
-# endif
-#elif SIZEOF_LONG == 8
-typedef signed   long          StgInt64;
-typedef unsigned long          StgWord64;
-#elif defined(__MSVC__)
-typedef __int64                StgInt64;
-typedef unsigned __int64       StgWord64;
-#else
-#error GHC untested on this architecture: sizeof(void *) < 8 and no long longs.
-#endif
-
-/*
- * Define the standard word size we'll use on this machine: make it
- * big enough to hold a pointer.
- */
-
-#if SIZEOF_VOID_P == 8
-typedef StgInt64           StgInt;
-typedef StgWord64          StgWord;
-typedef StgInt32           StgHalfInt;
-typedef StgWord32          StgHalfWord;
-#else
-#if SIZEOF_VOID_P == 4
-typedef StgInt32           StgInt; 
-typedef StgWord32          StgWord;
-typedef StgInt16           StgHalfInt;
-typedef StgWord16          StgHalfWord;
-#else
-#error GHC untested on this architecture: sizeof(void *) != 4 or 8
-#endif
-#endif
-
-#define W_MASK  (sizeof(W_)-1)
-
-typedef void*              StgAddr;
-
-/*
- * Other commonly-used STG datatypes.
- */
-
-typedef StgWord32          StgChar;
-typedef int                StgBool;
-
-typedef float		   StgFloat;
-typedef double		   StgDouble;
-                           
-typedef void               StgVoid;
-                           
-typedef struct StgClosure_ StgClosure;
-typedef StgClosure*        StgClosurePtr;
-typedef StgWord*           StgPtr;           /* pointer into closure       */
-typedef StgWord volatile*  StgVolatilePtr;   /* pointer to volatile word   */
-typedef StgWord            StgOffset;        /* byte offset within closure */
-                           
-typedef struct StgTSO_*    StgTSOPtr;
-
-typedef void*              StgForeignPtr;
-
-typedef StgInt             StgStackOffset;   /* offset in words! */
-
-typedef StgWord*           StgStackPtr;
-
-typedef StgWord8 	   StgCode;  	    /* close enough */
-
-typedef StgPtr*            StgArray;        /* the goods of an Array# */
-typedef char*		   StgByteArray;    /* the goods of a ByteArray# */
-
-typedef void*		   StgStablePtr;
-
-/*
-  Types for the generated C functions
-  take no arguments
-  return a pointer to the next function to be called
-  use: Ptr to Fun that returns a Ptr to Fun which returns Ptr to void
-
-  Note: Neither StgFunPtr not StgFun is quite right (that is, 
-  StgFunPtr != StgFun*).  So, the functions we define all have type
-  StgFun but we always have to cast them to StgFunPtr when we assign
-  them to something.
-  The only way round this would be to write a recursive type but
-  C only allows that if you're defining a struct or union.
-*/
-
-typedef void  *(*(*StgFunPtr)(void))(void);
-typedef StgFunPtr StgFun(void);
-
-#endif /* STGTYPES_H */
diff --git a/ghc/includes/Storage.h b/ghc/includes/Storage.h
deleted file mode 100644
index 3a6bb2fde1..0000000000
--- a/ghc/includes/Storage.h
+++ /dev/null
@@ -1,518 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * External Storage Manger Interface
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef STORAGE_H
-#define STORAGE_H
-
-#include <stddef.h>
-#include "OSThreads.h"
-
-/* -----------------------------------------------------------------------------
- * Generational GC
- *
- * We support an arbitrary number of generations, with an arbitrary number
- * of steps per generation.  Notes (in no particular order):
- *
- *       - all generations except the oldest should have two steps.  This gives
- *         objects a decent chance to age before being promoted, and in
- *         particular will ensure that we don't end up with too many
- *         thunks being updated in older generations.
- *
- *       - the oldest generation has one step.  There's no point in aging
- *         objects in the oldest generation.
- *
- *       - generation 0, step 0 (G0S0) is the allocation area.  It is given
- *         a fixed set of blocks during initialisation, and these blocks
- *         are never freed.
- *
- *       - during garbage collection, each step which is an evacuation
- *         destination (i.e. all steps except G0S0) is allocated a to-space.
- *         evacuated objects are allocated into the step's to-space until
- *         GC is finished, when the original step's contents may be freed
- *         and replaced by the to-space.
- *
- *       - the mutable-list is per-generation (not per-step).  G0 doesn't 
- *         have one (since every garbage collection collects at least G0).
- * 
- *       - block descriptors contain pointers to both the step and the
- *         generation that the block belongs to, for convenience.
- *
- *       - static objects are stored in per-generation lists.  See GC.c for
- *         details of how we collect CAFs in the generational scheme.
- *
- *       - large objects are per-step, and are promoted in the same way
- *         as small objects, except that we may allocate large objects into
- *         generation 1 initially.
- *
- * ------------------------------------------------------------------------- */
-
-typedef struct step_ {
-  unsigned int         no;		/* step number */
-  bdescr *             blocks;		/* blocks in this step */
-  unsigned int         n_blocks;	/* number of blocks */
-  struct step_ *       to;		/* destination step for live objects */
-  struct generation_ * gen;		/* generation this step belongs to */
-  unsigned int         gen_no;          /* generation number (cached) */
-  bdescr *             large_objects;	/* large objects (doubly linked) */
-  unsigned int         n_large_blocks;  /* no. of blocks used by large objs */
-  int                  is_compacted;	/* compact this step? (old gen only) */
-
-  /* During GC, if we are collecting this step, blocks and n_blocks
-   * are copied into the following two fields.  After GC, these blocks
-   * are freed. */
-  bdescr *     old_blocks;	        /* bdescr of first from-space block */
-  unsigned int n_old_blocks;		/* number of blocks in from-space */
-
-  /* temporary use during GC: */
-  StgPtr       hp;			/* next free locn in to-space */
-  StgPtr       hpLim;			/* end of current to-space block */
-  bdescr *     hp_bd;			/* bdescr of current to-space block */
-  StgPtr       scavd_hp;		/* ... same as above, but already */
-  StgPtr       scavd_hpLim;		/*     scavenged.  */
-  bdescr *     scan_bd;			/* block currently being scanned */
-  StgPtr       scan;			/* scan pointer in current block */
-  bdescr *     new_large_objects;    	/* large objects collected so far */
-  bdescr *     scavenged_large_objects; /* live large objs after GC (d-link) */
-  unsigned int n_scavenged_large_blocks;/* size of above */
-  bdescr *     bitmap;  		/* bitmap for compacting collection */
-} step;
-
-typedef struct generation_ {
-  unsigned int   no;			/* generation number */
-  step *         steps;			/* steps */
-  unsigned int   n_steps;		/* number of steps */
-  unsigned int   max_blocks;		/* max blocks in step 0 */
-  bdescr        *mut_list;      	/* mut objects in this gen (not G0)*/
-
-  /* temporary use during GC: */
-  bdescr        *saved_mut_list;
-
-  /* stats information */
-  unsigned int collections;
-  unsigned int failed_promotions;
-} generation;
-
-extern generation * RTS_VAR(generations);
-
-extern generation * RTS_VAR(g0);
-extern step * RTS_VAR(g0s0);
-extern generation * RTS_VAR(oldest_gen);
-
-/* -----------------------------------------------------------------------------
-   Initialisation / De-initialisation
-   -------------------------------------------------------------------------- */
-
-extern void initStorage(void);
-extern void exitStorage(void);
-extern void freeStorage(void);
-
-/* -----------------------------------------------------------------------------
-   Generic allocation
-
-   StgPtr allocate(nat n)       Allocates a chunk of contiguous store
-   				n words long, returning a pointer to
-				the first word.  Always succeeds.
-				
-   StgPtr allocatePinned(nat n) Allocates a chunk of contiguous store
-   				n words long, which is at a fixed
-				address (won't be moved by GC).  
-				Returns a pointer to the first word.
-				Always succeeds.
-				
-				NOTE: the GC can't in general handle
-				pinned objects, so allocatePinned()
-				can only be used for ByteArrays at the
-				moment.
-
-				Don't forget to TICK_ALLOC_XXX(...)
-				after calling allocate or
-				allocatePinned, for the
-				benefit of the ticky-ticky profiler.
-
-   rtsBool doYouWantToGC(void)  Returns True if the storage manager is
-   				ready to perform a GC, False otherwise.
-
-   lnat  allocated_bytes(void)  Returns the number of bytes allocated
-                                via allocate() since the last GC.
-				Used in the reporting of statistics.
-
-   THREADED_RTS: allocate and doYouWantToGC can be used from STG code, they are
-   surrounded by a mutex.
-   -------------------------------------------------------------------------- */
-
-extern StgPtr  allocate        ( nat n );
-extern StgPtr  allocateLocal   ( Capability *cap, nat n );
-extern StgPtr  allocatePinned  ( nat n );
-extern lnat    allocated_bytes ( void );
-
-extern bdescr * RTS_VAR(small_alloc_list);
-extern bdescr * RTS_VAR(large_alloc_list);
-extern bdescr * RTS_VAR(pinned_object_block);
-
-extern StgPtr RTS_VAR(alloc_Hp);
-extern StgPtr RTS_VAR(alloc_HpLim);
-
-extern nat RTS_VAR(alloc_blocks);
-extern nat RTS_VAR(alloc_blocks_lim);
-
-INLINE_HEADER rtsBool
-doYouWantToGC( void )
-{
-  return (alloc_blocks >= alloc_blocks_lim);
-}
-
-/* -----------------------------------------------------------------------------
-   Performing Garbage Collection
-
-   GarbageCollect(get_roots)    Performs a garbage collection.  
-				'get_roots' is called to find all the 
-				roots that the system knows about.
-
-   StgClosure 			Called by get_roots on each root.	
-   MarkRoot(StgClosure *p)	Returns the new location of the root.
-   -------------------------------------------------------------------------- */
-
-extern void GarbageCollect(void (*get_roots)(evac_fn),rtsBool force_major_gc);
-
-/* -----------------------------------------------------------------------------
-   Generational garbage collection support
-
-   recordMutable(StgPtr p)       Informs the garbage collector that a
-				 previously immutable object has
-				 become (permanently) mutable.  Used
-				 by thawArray and similar.
-
-   updateWithIndirection(p1,p2)  Updates the object at p1 with an
-				 indirection pointing to p2.  This is
-				 normally called for objects in an old
-				 generation (>0) when they are updated.
-
-   updateWithPermIndirection(p1,p2)  As above but uses a permanent indir.
-
-   -------------------------------------------------------------------------- */
-
-/*
- * Storage manager mutex
- */
-#if defined(THREADED_RTS)
-extern Mutex sm_mutex;
-extern Mutex atomic_modify_mutvar_mutex;
-#endif
-
-#if defined(THREADED_RTS)
-#define ACQUIRE_SM_LOCK   ACQUIRE_LOCK(&sm_mutex);
-#define RELEASE_SM_LOCK   RELEASE_LOCK(&sm_mutex);
-#define ASSERT_SM_LOCK()  ASSERT_LOCK_HELD(&sm_mutex);
-#else
-#define ACQUIRE_SM_LOCK
-#define RELEASE_SM_LOCK
-#define ASSERT_SM_LOCK()
-#endif
-
-INLINE_HEADER void
-recordMutableGen(StgClosure *p, generation *gen)
-{
-    bdescr *bd;
-
-    bd = gen->mut_list;
-    if (bd->free >= bd->start + BLOCK_SIZE_W) {
-	bdescr *new_bd;
-	new_bd = allocBlock();
-	new_bd->link = bd;
-	bd = new_bd;
-	gen->mut_list = bd;
-    }
-    *bd->free++ = (StgWord)p;
-
-}
-
-INLINE_HEADER void
-recordMutableGenLock(StgClosure *p, generation *gen)
-{
-    ACQUIRE_SM_LOCK;
-    recordMutableGen(p,gen);
-    RELEASE_SM_LOCK;
-}
-
-INLINE_HEADER void
-recordMutable(StgClosure *p)
-{
-    bdescr *bd;
-    ASSERT(closure_MUTABLE(p));
-    bd = Bdescr((P_)p);
-    if (bd->gen_no > 0) recordMutableGen(p, &RTS_DEREF(generations)[bd->gen_no]);
-}
-
-INLINE_HEADER void
-recordMutableLock(StgClosure *p)
-{
-    ACQUIRE_SM_LOCK;
-    recordMutable(p);
-    RELEASE_SM_LOCK;
-}
-
-/* -----------------------------------------------------------------------------
-   The CAF table - used to let us revert CAFs in GHCi
-   -------------------------------------------------------------------------- */
-
-/* set to disable CAF garbage collection in GHCi. */
-/* (needed when dynamic libraries are used). */
-extern rtsBool keepCAFs;
-
-/* -----------------------------------------------------------------------------
-   This is the write barrier for MUT_VARs, a.k.a. IORefs.  A
-   MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY
-   is.  When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY
-   and is put on the mutable list.
-   -------------------------------------------------------------------------- */
-
-void dirty_MUT_VAR(StgRegTable *reg, StgClosure *p);
-
-/* -----------------------------------------------------------------------------
-   DEBUGGING predicates for pointers
-
-   LOOKS_LIKE_INFO_PTR(p)    returns False if p is definitely not an info ptr
-   LOOKS_LIKE_CLOSURE_PTR(p) returns False if p is definitely not a closure ptr
-
-   These macros are complete but not sound.  That is, they might
-   return false positives.  Do not rely on them to distinguish info
-   pointers from closure pointers, for example.
-
-   We don't use address-space predicates these days, for portability
-   reasons, and the fact that code/data can be scattered about the
-   address space in a dynamically-linked environment.  Our best option
-   is to look at the alleged info table and see whether it seems to
-   make sense...
-   -------------------------------------------------------------------------- */
-
-#define LOOKS_LIKE_INFO_PTR(p) \
-   (p && ((StgInfoTable *)(INFO_PTR_TO_STRUCT(p)))->type != INVALID_OBJECT && \
-    ((StgInfoTable *)(INFO_PTR_TO_STRUCT(p)))->type < N_CLOSURE_TYPES)
-
-#define LOOKS_LIKE_CLOSURE_PTR(p) \
-   (LOOKS_LIKE_INFO_PTR(((StgClosure *)(p))->header.info))
-
-/* -----------------------------------------------------------------------------
-   Macros for calculating how big a closure will be (used during allocation)
-   -------------------------------------------------------------------------- */
-
-INLINE_HEADER StgOffset PAP_sizeW   ( nat n_args )
-{ return sizeofW(StgPAP) + n_args; }
-
-INLINE_HEADER StgOffset AP_sizeW   ( nat n_args )
-{ return sizeofW(StgAP) + n_args; }
-
-INLINE_HEADER StgOffset AP_STACK_sizeW ( nat size )
-{ return sizeofW(StgAP_STACK) + size; }
-
-INLINE_HEADER StgOffset CONSTR_sizeW( nat p, nat np )
-{ return sizeofW(StgHeader) + p + np; }
-
-INLINE_HEADER StgOffset THUNK_SELECTOR_sizeW ( void )
-{ return sizeofW(StgSelector); }
-
-INLINE_HEADER StgOffset BLACKHOLE_sizeW ( void )
-{ return sizeofW(StgHeader)+MIN_PAYLOAD_SIZE; }
-
-/* --------------------------------------------------------------------------
-   Sizes of closures
-   ------------------------------------------------------------------------*/
-
-INLINE_HEADER StgOffset sizeW_fromITBL( const StgInfoTable* itbl ) 
-{ return sizeofW(StgClosure) 
-       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs 
-       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
-
-INLINE_HEADER StgOffset thunk_sizeW_fromITBL( const StgInfoTable* itbl ) 
-{ return sizeofW(StgThunk) 
-       + sizeofW(StgPtr)  * itbl->layout.payload.ptrs 
-       + sizeofW(StgWord) * itbl->layout.payload.nptrs; }
-
-INLINE_HEADER StgOffset ap_stack_sizeW( StgAP_STACK* x )
-{ return AP_STACK_sizeW(x->size); }
-
-INLINE_HEADER StgOffset ap_sizeW( StgAP* x )
-{ return AP_sizeW(x->n_args); }
-
-INLINE_HEADER StgOffset pap_sizeW( StgPAP* x )
-{ return PAP_sizeW(x->n_args); }
-
-INLINE_HEADER StgOffset arr_words_sizeW( StgArrWords* x )
-{ return sizeofW(StgArrWords) + x->words; }
-
-INLINE_HEADER StgOffset mut_arr_ptrs_sizeW( StgMutArrPtrs* x )
-{ return sizeofW(StgMutArrPtrs) + x->ptrs; }
-
-INLINE_HEADER StgWord tso_sizeW ( StgTSO *tso )
-{ return TSO_STRUCT_SIZEW + tso->stack_size; }
-
-INLINE_HEADER StgWord bco_sizeW ( StgBCO *bco )
-{ return bco->size; }
-
-STATIC_INLINE nat
-closure_sizeW_ (StgClosure *p, StgInfoTable *info)
-{
-    switch (info->type) {
-    case THUNK_0_1:
-    case THUNK_1_0:
-	return sizeofW(StgThunk) + 1;
-    case FUN_0_1:
-    case CONSTR_0_1:
-    case FUN_1_0:
-    case CONSTR_1_0:
-	return sizeofW(StgHeader) + 1;
-    case THUNK_0_2:
-    case THUNK_1_1:
-    case THUNK_2_0:
-	return sizeofW(StgThunk) + 2;
-    case FUN_0_2:
-    case CONSTR_0_2:
-    case FUN_1_1:
-    case CONSTR_1_1:
-    case FUN_2_0:
-    case CONSTR_2_0:
-	return sizeofW(StgHeader) + 2;
-    case THUNK:
-	return thunk_sizeW_fromITBL(info);
-    case THUNK_SELECTOR:
-	return THUNK_SELECTOR_sizeW();
-    case AP_STACK:
-	return ap_stack_sizeW((StgAP_STACK *)p);
-    case AP:
-    case PAP:
-	return pap_sizeW((StgPAP *)p);
-    case IND:
-    case IND_PERM:
-    case IND_OLDGEN:
-    case IND_OLDGEN_PERM:
-	return sizeofW(StgInd);
-    case ARR_WORDS:
-	return arr_words_sizeW((StgArrWords *)p);
-    case MUT_ARR_PTRS_CLEAN:
-    case MUT_ARR_PTRS_DIRTY:
-    case MUT_ARR_PTRS_FROZEN:
-    case MUT_ARR_PTRS_FROZEN0:
-	return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-    case TSO:
-	return tso_sizeW((StgTSO *)p);
-    case BCO:
-	return bco_sizeW((StgBCO *)p);
-    case TVAR_WAIT_QUEUE:
-        return sizeofW(StgTVarWaitQueue);
-    case TVAR:
-        return sizeofW(StgTVar);
-    case TREC_CHUNK:
-        return sizeofW(StgTRecChunk);
-    case TREC_HEADER:
-        return sizeofW(StgTRecHeader);
-    default:
-	return sizeW_fromITBL(info);
-    }
-}
-
-// The definitive way to find the size, in words, of a heap-allocated closure
-STATIC_INLINE nat
-closure_sizeW (StgClosure *p)
-{
-    return closure_sizeW_(p, get_itbl(p));
-}
-
-/* -----------------------------------------------------------------------------
-   Sizes of stack frames
-   -------------------------------------------------------------------------- */
-
-INLINE_HEADER StgWord stack_frame_sizeW( StgClosure *frame )
-{
-    StgRetInfoTable *info;
-
-    info = get_ret_itbl(frame);
-    switch (info->i.type) {
-
-    case RET_DYN:
-    {
-	StgRetDyn *dyn = (StgRetDyn *)frame;
-	return  sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE + 
-	    RET_DYN_NONPTR_REGS_SIZE +
-	    RET_DYN_PTRS(dyn->liveness) + RET_DYN_NONPTRS(dyn->liveness);
-    }
-	    
-    case RET_FUN:
-	return sizeofW(StgRetFun) + ((StgRetFun *)frame)->size;
-
-    case RET_BIG:
-    case RET_VEC_BIG:
-	return 1 + GET_LARGE_BITMAP(&info->i)->size;
-
-    case RET_BCO:
-	return 2 + BCO_BITMAP_SIZE((StgBCO *)((P_)frame)[1]);
-
-    default:
-	return 1 + BITMAP_SIZE(info->i.layout.bitmap);
-    }
-}
-
-/* -----------------------------------------------------------------------------
-   Nursery manipulation
-   -------------------------------------------------------------------------- */
-
-extern void     allocNurseries       ( void );
-extern void     resetNurseries       ( void );
-extern void     resizeNurseries      ( nat blocks );
-extern void     resizeNurseriesFixed ( nat blocks );
-extern void     tidyAllocateLists    ( void );
-extern lnat     countNurseryBlocks   ( void );
-
-/* -----------------------------------------------------------------------------
-   Functions from GC.c 
-   -------------------------------------------------------------------------- */
-
-extern void         threadPaused ( Capability *cap, StgTSO * );
-extern StgClosure * isAlive      ( StgClosure *p );
-extern void         markCAFs     ( evac_fn evac );
-
-/* -----------------------------------------------------------------------------
-   Stats 'n' DEBUG stuff
-   -------------------------------------------------------------------------- */
-
-extern ullong RTS_VAR(total_allocated);
-
-extern lnat calcAllocated  ( void );
-extern lnat calcLive       ( void );
-extern lnat calcNeeded     ( void );
-
-#if defined(DEBUG)
-extern void memInventory(void);
-extern void checkSanity(void);
-extern nat  countBlocks(bdescr *);
-extern void checkNurserySanity( step *stp );
-#endif
-
-#if defined(DEBUG)
-void printMutOnceList(generation *gen);
-void printMutableList(generation *gen);
-#endif
-
-/* ----------------------------------------------------------------------------
-   Storage manager internal APIs and globals
-   ------------------------------------------------------------------------- */
-
-#define END_OF_STATIC_LIST stgCast(StgClosure*,1)
-
-extern void newDynCAF(StgClosure *);
-
-extern void move_TSO(StgTSO *src, StgTSO *dest);
-extern StgTSO *relocate_stack(StgTSO *dest, ptrdiff_t diff);
-
-extern StgClosure * RTS_VAR(scavenged_static_objects);
-extern StgWeak    * RTS_VAR(old_weak_ptr_list);
-extern StgWeak    * RTS_VAR(weak_ptr_list);
-extern StgClosure * RTS_VAR(caf_list);
-extern StgClosure * RTS_VAR(revertible_caf_list);
-extern StgTSO     * RTS_VAR(resurrected_threads);
-
-#endif /* STORAGE_H */
diff --git a/ghc/includes/TSO.h b/ghc/includes/TSO.h
deleted file mode 100644
index d096d401cf..0000000000
--- a/ghc/includes/TSO.h
+++ /dev/null
@@ -1,279 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-1999
- *
- * The definitions for Thread State Objects.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef TSO_H
-#define TSO_H
-
-#if DEBUG
-#define TSO_MAGIC 4321
-#endif
-
-typedef struct {
-  StgInt   pri;
-  StgInt   magic;
-  StgInt   sparkname;
-  rtsTime  startedat;
-  rtsBool  exported;
-  StgInt   basicblocks;
-  StgInt   allocs;
-  rtsTime  exectime;
-  rtsTime  fetchtime;
-  rtsTime  fetchcount;
-  rtsTime  blocktime;
-  StgInt   blockcount;
-  rtsTime  blockedat;
-  StgInt   globalsparks;
-  StgInt   localsparks;
-  rtsTime  clock;
-} StgTSOStatBuf;
-
-/*
- * GRAN: We distinguish between the various classes of threads in 
- * the system.
- */
-typedef enum {
-  AdvisoryPriority,
-  MandatoryPriority,
-  RevalPriority
-} StgThreadPriority;
-
-/*
- * PROFILING info in a TSO
- */
-typedef struct {
-  CostCentreStack *CCCS;	/* thread's current CCS */
-} StgTSOProfInfo;
-
-/*
- * PAR info in a TSO
- */
-typedef StgTSOStatBuf StgTSOParInfo;
-
-/*
- * DIST info in a TSO
- */
-typedef struct {
-  StgThreadPriority  priority;   
-  StgInt             revalTid;   /* ToDo: merge both into 1 word */
-  StgInt             revalSlot;
-} StgTSODistInfo;
-
-/*
- * GRAN info in a TSO
- */
-typedef StgTSOStatBuf StgTSOGranInfo;
-
-/*
- * There is no TICKY info in a TSO at this time.
- */
-
-/*
- * Thread IDs are 32 bits.
- */
-typedef StgWord32 StgThreadID;
-
-/* 
- * Flags for the tso->flags field.
- *
- * The TSO_DIRTY flag indicates that this TSO's stack should be
- * scanned during garbage collection.  The link field of a TSO is
- * always scanned, so we don't have to dirty a TSO just for linking
- * it on a different list.
- *
- * TSO_DIRTY is set by 
- *    - schedule(), just before running a thread,
- *    - raiseAsync(), because it modifies a thread's stack
- *    - resumeThread(), just before running the thread again
- * and unset by the garbage collector (only).
- */
-#define TSO_DIRTY   1
-
-/*
- * TSO_LOCKED is set when a TSO is locked to a particular Capability.
- */
-#define TSO_LOCKED  2
-
-#define tsoDirty(tso)  ((tso)->flags & TSO_DIRTY)
-#define tsoLocked(tso) ((tso)->flags & TSO_LOCKED)
-
-/*
- * Type returned after running a thread.  Values of this type
- * include HeapOverflow, StackOverflow etc.  See Constants.h for the
- * full list.
- */
-typedef unsigned int StgThreadReturnCode;
-
-#if defined(mingw32_HOST_OS)
-/* results from an async I/O request + its request ID. */
-typedef struct {
-  unsigned int reqID;
-  int          len;
-  int          errCode;
-} StgAsyncIOResult;
-#endif
-
-typedef union {
-  StgClosure *closure;
-  struct StgTSO_ *tso;
-  StgInt fd;	/* StgInt instead of int, so that it's the same size as the ptrs */
-#if defined(mingw32_HOST_OS)
-  StgAsyncIOResult *async_result;
-#endif
-  StgWord target;
-} StgTSOBlockInfo;
-
-/*
- * TSOs live on the heap, and therefore look just like heap objects.
- * Large TSOs will live in their own "block group" allocated by the
- * storage manager, and won't be copied during garbage collection.
- */
-
-/* 
- * Threads may be blocked for several reasons.  A blocked thread will
- * have the reason in the why_blocked field of the TSO, and some
- * further info (such as the closure the thread is blocked on, or the
- * file descriptor if the thread is waiting on I/O) in the block_info
- * field.
- */
-
-typedef struct StgTSO_ {
-    StgHeader               header;
-
-    struct StgTSO_*         link;       /* Links threads onto blocking queues */
-    struct StgTSO_*         global_link;    /* Links all threads together */
-    
-    StgWord16               what_next;      /* Values defined in Constants.h */
-    StgWord16               why_blocked;    /* Values defined in Constants.h */
-    StgWord32               flags;
-    StgTSOBlockInfo         block_info;
-    struct StgTSO_*         blocked_exceptions;
-    StgThreadID             id;
-    int                     saved_errno;
-    struct Task_*           bound;
-    struct Capability_*     cap;
-    struct StgTRecHeader_ * trec;       /* STM transaction record */
-
-#ifdef TICKY_TICKY
-    /* TICKY-specific stuff would go here. */
-#endif
-#ifdef PROFILING
-    StgTSOProfInfo prof;
-#endif
-#ifdef PAR
-    StgTSOParInfo par;
-#endif
-#ifdef GRAN
-    StgTSOGranInfo gran;
-#endif
-#ifdef DIST
-    StgTSODistInfo dist;
-#endif
-
-    /* The thread stack... */
-    StgWord32	       stack_size;     /* stack size in *words* */
-    StgWord32          max_stack_size; /* maximum stack size in *words* */
-    StgPtr             sp;
-    
-    StgWord            stack[FLEXIBLE_ARRAY];
-} StgTSO;
-
-/* -----------------------------------------------------------------------------
-   Invariants:
-
-   An active thread has the following properties:
-
-      tso->stack < tso->sp < tso->stack+tso->stack_size
-      tso->stack_size <= tso->max_stack_size
-      
-      RESERVED_STACK_WORDS is large enough for any heap-check or
-      stack-check failure.
-
-      The size of the TSO struct plus the stack is either
-        (a) smaller than a block, or
-	(b) a multiple of BLOCK_SIZE
-
-	tso->why_blocked       tso->block_info      location
-        ----------------------------------------------------------------------
-	NotBlocked             NULL                 runnable_queue, or running
-	
-        BlockedOnBlackHole     the BLACKHOLE_BQ     the BLACKHOLE_BQ's queue
-	
-        BlockedOnMVar          the MVAR             the MVAR's queue
-
-	BlockedOnSTM           END_TSO_QUEUE        STM wait queue(s)
-	
-        BlockedOnException     the TSO              TSO->blocked_exception
-
-        BlockedOnRead          NULL                 blocked_queue
-        BlockedOnWrite         NULL		    blocked_queue
-        BlockedOnDelay         NULL                 blocked_queue
-	BlockedOnGA            closure TSO blocks on   BQ of that closure
-	BlockedOnGA_NoSend     closure TSO blocks on   BQ of that closure
-
-      tso->link == END_TSO_QUEUE, if the thread is currently running.
-
-   A zombie thread has the following properties:
-      
-      tso->what_next == ThreadComplete or ThreadKilled
-      tso->link     ==  (could be on some queue somewhere)
-      tso->su       ==  tso->stack + tso->stack_size
-      tso->sp       ==  tso->stack + tso->stack_size - 1 (i.e. top stack word)
-      tso->sp[0]    ==  return value of thread, if what_next == ThreadComplete,
-                        exception             , if what_next == ThreadKilled
-
-      (tso->sp is left pointing at the top word on the stack so that
-      the return value or exception will be retained by a GC).
-
-   tso->blocked_exceptions is either:
-
-      NULL             if async exceptions are unblocked.
-
-      END_TSO_QUEUE    if async exceptions are blocked, but no threads
-                       are currently waiting to deliver.
-
-      (StgTSO *)tso    if threads are currently awaiting delivery of
-                       exceptions to this thread.
-
-   The 2 cases BlockedOnGA and BlockedOnGA_NoSend are needed in a GUM
-   setup only. They mark a TSO that has entered a FETCH_ME or
-   FETCH_ME_BQ closure, respectively; only the first TSO hitting the 
-   closure will send a Fetch message.
-   Currently we have no separate code for blocking on an RBH; we use the
-   BlockedOnBlackHole case for that.   -- HWL
-
- ---------------------------------------------------------------------------- */
-
-/* Workaround for a bug/quirk in gcc on certain architectures.
- * symptom is that (&tso->stack - &tso->header) /=  sizeof(StgTSO)
- * in other words, gcc pads the structure at the end.
- */
-
-extern StgTSO dummy_tso;
-
-#define TSO_STRUCT_SIZE \
-   ((char *)&dummy_tso.stack - (char *)&dummy_tso.header)
-
-#define TSO_STRUCT_SIZEW (TSO_STRUCT_SIZE / sizeof(W_))
-
-
-/* this is the NIL ptr for a TSO queue (e.g. runnable queue) */
-#if IN_STG_CODE
-#define END_TSO_QUEUE  (stg_END_TSO_QUEUE_closure)
-#else
-#define END_TSO_QUEUE  ((StgTSO *)(void*)&stg_END_TSO_QUEUE_closure)
-#endif
-
-#if defined(PAR) || defined(GRAN)
-/* this is the NIL ptr for a blocking queue */
-# define END_BQ_QUEUE  ((StgBlockingQueueElement *)(void*)&stg_END_TSO_QUEUE_closure)
-/* this is the NIL ptr for a blocked fetch queue (as in PendingFetches in GUM) */
-# define END_BF_QUEUE  ((StgBlockedFetch *)(void*)&stg_END_TSO_QUEUE_closure)
-#endif
-/* ToDo?: different name for end of sleeping queue ? -- HWL */
-
-#endif /* TSO_H */
diff --git a/ghc/includes/TailCalls.h b/ghc/includes/TailCalls.h
deleted file mode 100644
index 670da9546f..0000000000
--- a/ghc/includes/TailCalls.h
+++ /dev/null
@@ -1,272 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-1999
- *
- * Stuff for implementing proper tail jumps.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef TAILCALLS_H
-#define TAILCALLS_H
-
-/* -----------------------------------------------------------------------------
-   Unmangled tail-jumping: use the mini interpretter.
-   -------------------------------------------------------------------------- */
-
-#ifdef USE_MINIINTERPRETER
-
-#define JMP_(cont) return((StgFunPtr)(cont))
-#define FB_
-#define FE_
-
-#else
-
-extern void __DISCARD__(void);
-
-/* -----------------------------------------------------------------------------
-   Tail calling on x86
-   -------------------------------------------------------------------------- */
-
-#if i386_HOST_ARCH
-
-/* Note about discard: possibly there to fool GCC into clearing up
-   before we do the jump eg. if there are some arguments left on the C
-   stack that GCC hasn't popped yet.  Also possibly to fool any
-   optimisations (a function call often acts as a barrier).  Not sure
-   if any of this is necessary now -- SDM
-
-   Comment to above note: I don't think the __DISCARD__() in JMP_ is 
-   necessary.  Arguments should be popped from the C stack immediately
-   after returning from a function, as long as we pass -fno-defer-pop
-   to gcc.  Moreover, a goto to a first-class label acts as a barrier 
-   for optimisations in the same way a function call does. 
-   -= chak
-   */
-
-/* The goto here seems to cause gcc -O2 to delete all the code after
-   it - including the FE_ marker and the epilogue code - exactly what
-   we want! -- SDM
-   */
-
-#define JMP_(cont)			\
-    { 					\
-      void *__target;			\
-      __DISCARD__();			\
-      __target = (void *)(cont);    	\
-      goto *__target; 	    	    	\
-    }
-
-#endif /* i386_HOST_ARCH */
-
-/* -----------------------------------------------------------------------------
-   Tail calling on x86_64
-   -------------------------------------------------------------------------- */
-
-#if x86_64_HOST_ARCH
-
-/*
-  NOTE about __DISCARD__():
-
-  On x86_64 this is necessary to work around bugs in the register
-  variable support in gcc.  Without the __DISCARD__() call, gcc will
-  silently throw away assignements to global register variables that
-  happen before the jump.
-
-  Here's the example:
-
-  extern void g(void);
-  static void f(void) {
-    R1 = g;
-    __DISCARD__()
-    goto *R1;
-  }
-
-  without the dummy function call, gcc throws away the assignment to R1
-  (gcc 3.4.3) gcc bug #20359.
-*/
-
-#define JMP_(cont)			\
-    { 					\
-      __DISCARD__();			\
-      goto *(void *)(cont); 	    	    	\
-    }
-
-#endif /* x86_64_HOST_ARCH */
-
-/* -----------------------------------------------------------------------------
-   Tail calling on Sparc
-   -------------------------------------------------------------------------- */
-
-#ifdef sparc_HOST_ARCH
-
-#define JMP_(cont)	((F_) (cont))()
-	/* Oh so happily, the above turns into a "call" instruction,
-	   which, on a SPARC, is nothing but a "jmpl" with the
-	   return address in %o7 [which we don't care about].
-	*/
-
-/* Don't need these for sparc mangling */
-#define FB_
-#define FE_
-
-#endif /* sparc_HOST_ARCH */
-
-/* -----------------------------------------------------------------------------
-   Tail calling on Alpha
-   -------------------------------------------------------------------------- */
-
-#ifdef alpha_HOST_ARCH
-
-#if IN_STG_CODE
-register void *_procedure __asm__("$27");
-#endif
-
-#define JMP_(cont)				\
-    do { _procedure = (void *)(cont);		\
-         __DISCARD__();				\
-         goto *_procedure;			\
-       } while(0)
-
-/* Don't need these for alpha mangling */
-#define FB_
-#define FE_
-
-#endif /* alpha_HOST_ARCH */
-
-/* -----------------------------------------------------------------------------
-   Tail calling on HP
-
-Description of HP's weird procedure linkage, many thanks to Andy Bennet
-<andy_bennett@hp.com>:
-
-I've been digging a little further into the problem of how HP-UX does
-dynamic procedure calls. My solution in the last e-mail inserting an extra
-'if' statement into the JMP_ I think is probably the best general solution I
-can come up with. There are still a few problems with it however: It wont
-work, if JMP_ ever has to call anything in a shared library, if this is
-likely to be required it'll need something more elaborate. It also wont work
-with PA-RISC 2.0 wide mode (64-bit) which uses a different format PLT.
-
-I had some feedback from someone in HP's compiler lab and the problem
-relates to the linker on HP-UX, not gcc as I first suspected. The reason the
-'hsc' executable works is most likely due to a change in 'ld's behaviour for
-performance reasons between your revision and mine.
-
-The major issue relating to this is shared libraries and how they are
-implented under HP-UX. The whole point of the Procedure Label Table (PLT) is
-to allow a function pointer to hold the address of the function and a
-pointer to the library's global data lookup table (DLT) used by position
-independent code (PIC). This makes the PLT absolutely essential for shared
-library calls. HP has two linker introduced assembly functions for dealing
-with dynamic calls, $$dyncall and $$dyncall_external. The former does a
-check to see if the address is a PLT pointer and dereferences if necessary
-or just calls the address otherwise; the latter skips the check and just
-does the indirect jump no matter what.
-
-Since $$dyncall_external runs faster due to its not having the test, the
-linker nowadays prefers to generate calls to that, rather than $$dyncall. It
-makes this decision based on the presence of any shared library. If it even
-smells an sl's existence at link time, it rigs the runtime system to
-generate PLT references for everything on the assumption that the result
-will be slightly more efficient. This is what is crashing GHC since the
-calls it is generating have no understanding of the procedure label proper.
-The only way to get real addresses is to link everything archive, including
-system libraries, at which point it assumes you probably are going to be
-using calls similar to GHC's (its rigged for HP's +ESfic compiler option)
-but uses $$dyncall if necessary to cope, just in case you aren't.
-
-   -------------------------------------------------------------------------- */
-
-#ifdef hppa1_1_hp_hpux_TARGET
-
-#define JMP_(cont)                              \
-    do { void *_procedure = (void *)(cont);     \
-         if (((int) _procedure) & 2)            \
-            _procedure = (void *)(*((int *) (_procedure - 2))); \
-         goto *_procedure;                      \
-       } while(0)
-
-#endif /* hppa1_1_hp_hpux_TARGET */
-
-/* -----------------------------------------------------------------------------
-   Tail calling on PowerPC
-   -------------------------------------------------------------------------- */
-
-#ifdef powerpc_HOST_ARCH
-
-#define JMP_(cont)			\
-    { 					\
-      void *target;			\
-      target = (void *)(cont);    	\
-      __DISCARD__();			\
-      goto *target; 	    	    	\
-    }
-
-/*
-	The __DISCARD__ is there because Apple's April 2002 Beta of GCC 3.1
-	sometimes generates incorrect code otherwise.
-	It tends to "forget" to update global register variables in the presence
-	of decrement/increment operators:
-	JMP_(*(--Sp)) is wrongly compiled as JMP_(Sp[-1]).
-	Calling __DISCARD__ in between works around this problem.
-*/
-
-/*
-	I would _love_ to use the following instead,
-	but some versions of Apple's GCC fail to generate code for it
-	if it is called for a casted data pointer - which is exactly what
-	we are going to do...
-
-	#define JMP_(cont)	((F_) (cont))()
-*/
-
-#endif /* powerpc_HOST_ARCH */
-
-#ifdef powerpc64_HOST_ARCH
-#define JMP_(cont) ((F_) (cont))()
-#endif
-
-/* -----------------------------------------------------------------------------
-   Tail calling on IA64
-   -------------------------------------------------------------------------- */
-
-#ifdef ia64_HOST_ARCH
-
-/* The compiler can more intelligently decide how to do this.  We therefore
- * implement it as a call and optimise to a jump at mangle time. */
-#define JMP_(cont)	((F_) (cont))(); __asm__ volatile ("--- TAILCALL ---");
-
-/* Don't emit calls to __DISCARD__ as this causes hassles */
-#define __DISCARD__()
-
-#endif
-
-/* -----------------------------------------------------------------------------
-  FUNBEGIN and FUNEND.
-
-  These are markers indicating the start and end of Real Code in a
-  function.  All instructions between the actual start and end of the
-  function and these markers is shredded by the mangler.
-  -------------------------------------------------------------------------- */
-
-/*  The following __DISCARD__() has become necessary with gcc 2.96 on x86.
- *  It prevents gcc from moving stack manipulation code from the function
- *  body (aka the Real Code) into the function prologue, ie, from moving it
- *  over the --- BEGIN --- marker.  It should be noted that (like some
- *  other black magic in GHC's code), there is no essential reason why gcc
- *  could not move some stack manipulation code across the __DISCARD__() -
- *  it just doesn't choose to do it at the moment.
- *  -= chak
- */
- 
-#ifndef FB_
-#define FB_    __asm__ volatile ("--- BEGIN ---"); __DISCARD__ ();
-#endif
-
-#ifndef FE_
-#define FE_    __asm__ volatile ("--- END ---");
-#endif
-
-#endif /* !USE_MINIINTERPRETER */
-
-#endif /* TAILCALLS_H */
diff --git a/ghc/includes/config.h b/ghc/includes/config.h
deleted file mode 100644
index 66e2ade637..0000000000
--- a/ghc/includes/config.h
+++ /dev/null
@@ -1,7 +0,0 @@
-#ifndef __CONFIG_H__
-#define __CONFIG_H__
-
-#warning config.h is deprecated; please use ghcconfig.h instead
-#include "ghcconfig.h"
-
-#endif
diff --git a/ghc/includes/ghcconfig.h b/ghc/includes/ghcconfig.h
deleted file mode 100644
index 5f10e923fd..0000000000
--- a/ghc/includes/ghcconfig.h
+++ /dev/null
@@ -1,7 +0,0 @@
-#ifndef __GHCCONFIG_H__
-#define __GHCCONFIG_H__
-
-#include "ghcautoconf.h"
-#include "ghcplatform.h"
-
-#endif
diff --git a/ghc/includes/ieee-flpt.h b/ghc/includes/ieee-flpt.h
deleted file mode 100644
index a1fce3a8da..0000000000
--- a/ghc/includes/ieee-flpt.h
+++ /dev/null
@@ -1,35 +0,0 @@
-/* this file is #included into both C (.c and .hc) and Haskell files */
-
-    /* IEEE format floating-point */
-#define IEEE_FLOATING_POINT 1
-
-   /* Radix of exponent representation */
-#ifndef FLT_RADIX
-# define FLT_RADIX 2
-#endif
-
-   /* Number of base-FLT_RADIX digits in the significand of a float */
-#ifndef FLT_MANT_DIG
-# define FLT_MANT_DIG 24
-#endif
-   /* Minimum int x such that FLT_RADIX**(x-1) is a normalised float */
-#ifndef FLT_MIN_EXP
-#  define FLT_MIN_EXP (-125)
-#endif
-   /* Maximum int x such that FLT_RADIX**(x-1) is a representable float */
-#ifndef FLT_MAX_EXP
-# define FLT_MAX_EXP 128
-#endif
-
-   /* Number of base-FLT_RADIX digits in the significand of a double */
-#ifndef DBL_MANT_DIG
-# define DBL_MANT_DIG 53
-#endif
-   /* Minimum int x such that FLT_RADIX**(x-1) is a normalised double */
-#ifndef DBL_MIN_EXP
-#  define DBL_MIN_EXP (-1021)
-#endif
-   /* Maximum int x such that FLT_RADIX**(x-1) is a representable double */
-#ifndef DBL_MAX_EXP
-# define DBL_MAX_EXP 1024
-#endif
diff --git a/ghc/includes/mkDerivedConstants.c b/ghc/includes/mkDerivedConstants.c
deleted file mode 100644
index 27d4fa9e7b..0000000000
--- a/ghc/includes/mkDerivedConstants.c
+++ /dev/null
@@ -1,404 +0,0 @@
-/* --------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1992-2004
- *
- * mkDerivedConstants.c
- *
- * Basically this is a C program that extracts information from the C
- * declarations in the header files (primarily struct field offsets)
- * and generates a header file that can be #included into non-C source
- * containing this information.
- *
- * ------------------------------------------------------------------------*/
-
-#define IN_STG_CODE 0
-
-/*
- * We need offsets of profiled things... better be careful that this
- * doesn't affect the offsets of anything else.
- */
-#define PROFILING
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "Storage.h"
-#include "OSThreads.h"
-#include "Capability.h"
-
-#include <stdio.h>
-
-#define str(a,b) #a "_" #b
-
-#define OFFSET(s_type, field) ((unsigned int)&(((s_type*)0)->field))
-
-#if defined(GEN_HASKELL)
-#define def_offset(str, offset) \
-    printf("oFFSET_" str " = %d::Int\n", offset);
-#else
-#define def_offset(str, offset) \
-    printf("#define OFFSET_" str " %d\n", offset);
-#endif
-
-#if defined(GEN_HASKELL)
-#define ctype(type) /* nothing */
-#else
-#define ctype(type) \
-    printf("#define SIZEOF_" #type " %d\n", sizeof(type)); 
-#endif
-
-#if defined(GEN_HASKELL)
-#define field_type_(str, s_type, field) /* nothing */
-#else
-#define field_type_(str, s_type, field) \
-    printf("#define REP_" str " I"); \
-    printf("%d\n", sizeof (__typeof__(((((s_type*)0)->field)))) * 8);
-#endif
-
-#define field_type(s_type, field) \
-    field_type_(str(s_type,field),s_type,field);
-
-#define field_offset_(str, s_type, field) \
-    def_offset(str, OFFSET(s_type,field));
-
-#define field_offset(s_type, field) \
-    field_offset_(str(s_type,field),s_type,field);
-
-/* An access macro for use in C-- sources. */
-#define struct_field_macro(str) \
-    printf("#define " str "(__ptr__)  REP_" str "[__ptr__+OFFSET_" str "]\n");
-
-/* Outputs the byte offset and MachRep for a field */
-#define struct_field(s_type, field)		\
-    field_offset(s_type, field);		\
-    field_type(s_type, field);			\
-    struct_field_macro(str(s_type,field))
-
-#define struct_field_(str, s_type, field)	\
-    field_offset_(str, s_type, field);		\
-    field_type_(str, s_type, field);		\
-    struct_field_macro(str)
-
-#if defined(GEN_HASKELL)
-#define def_size(str, size) \
-    printf("sIZEOF_" str " = %d::Int\n", size);
-#else
-#define def_size(str, size) \
-    printf("#define SIZEOF_" str " %d\n", size);
-#endif
-
-#if defined(GEN_HASKELL)
-#define def_closure_size(str, size) /* nothing */
-#else
-#define def_closure_size(str, size) \
-    printf("#define SIZEOF_" str " (SIZEOF_StgHeader+%d)\n", size);
-#endif
-
-#define struct_size(s_type) \
-    def_size(#s_type, sizeof(s_type));
-
-/*
- * Size of a closure type, minus the header, named SIZEOF_<type>_NoHdr
- * Also, we #define SIZEOF_<type> to be the size of the whole closure for .cmm.
- */
-#define closure_size(s_type) \
-    def_size(#s_type "_NoHdr", sizeof(s_type) - sizeof(StgHeader)); \
-    def_closure_size(#s_type, sizeof(s_type) - sizeof(StgHeader));
-
-#define thunk_size(s_type) \
-    def_size(#s_type "_NoThunkHdr", sizeof(s_type) - sizeof(StgThunkHeader)); \
-    closure_size(s_type)
-
-/* An access macro for use in C-- sources. */
-#define closure_field_macro(str) \
-    printf("#define " str "(__ptr__)  REP_" str "[__ptr__+SIZEOF_StgHeader+OFFSET_" str "]\n");
-
-#define closure_field_offset_(str, s_type,field) \
-    def_offset(str, OFFSET(s_type,field) - sizeof(StgHeader));
-
-#define closure_field_offset(s_type,field) \
-    closure_field_offset_(str(s_type,field),s_type,field)
-
-#define closure_payload_macro(str) \
-    printf("#define " str "(__ptr__,__ix__)  W_[__ptr__+SIZEOF_StgHeader+OFFSET_" str " + WDS(__ix__)]\n");
-
-#define closure_payload(s_type,field) \
-    closure_field_offset_(str(s_type,field),s_type,field); \
-    closure_payload_macro(str(s_type,field));
-
-/* Byte offset and MachRep for a closure field, minus the header */
-#define closure_field(s_type, field) \
-    closure_field_offset(s_type,field) \
-    field_type(s_type, field); \
-    closure_field_macro(str(s_type,field))
-
-/* Byte offset and MachRep for a closure field, minus the header */
-#define closure_field_(str, s_type, field) \
-    closure_field_offset_(str,s_type,field) \
-    field_type_(str, s_type, field); \
-    closure_field_macro(str)
-
-/* Byte offset for a TSO field, minus the header and variable prof bit. */
-#define tso_payload_offset(s_type, field) \
-    def_offset(str(s_type,field), OFFSET(s_type,field) - sizeof(StgHeader) - sizeof(StgTSOProfInfo));
-
-/* Full byte offset for a TSO field, for use from Cmm */
-#define tso_field_offset_macro(str) \
-    printf("#define TSO_OFFSET_" str " (SIZEOF_StgHeader+SIZEOF_OPT_StgTSOProfInfo+SIZEOF_OPT_StgTSOParInfo+SIZEOF_OPT_StgTSOGranInfo+SIZEOF_OPT_StgTSODistInfo+OFFSET_" str ")\n");
-
-#define tso_field_offset(s_type, field) \
-    tso_payload_offset(s_type, field);  	\
-    tso_field_offset_macro(str(s_type,field));
-
-#define tso_field_macro(str) \
-    printf("#define " str "(__ptr__)  REP_" str "[__ptr__+TSO_OFFSET_" str "]\n")
-#define tso_field(s_type, field)		\
-    field_type(s_type, field);			\
-    tso_field_offset(s_type,field);		\
-    tso_field_macro(str(s_type,field))
-  
-#define opt_struct_size(s_type, option)					\
-    printf("#ifdef " #option "\n");					\
-    printf("#define SIZEOF_OPT_" #s_type " SIZEOF_" #s_type "\n");	\
-    printf("#else\n");							\
-    printf("#define SIZEOF_OPT_" #s_type " 0\n");			\
-    printf("#endif\n\n");
-
-#define FUN_OFFSET(sym) (OFFSET(Capability,f.sym) - OFFSET(Capability,r))
-
-
-int
-main(int argc, char *argv[])
-{
-#ifndef GEN_HASKELL
-    printf("/* This file is created automatically.  Do not edit by hand.*/\n\n");
-
-    printf("#define STD_HDR_SIZE   %d\n", sizeofW(StgHeader) - sizeofW(StgProfHeader));
-    /* grrr.. PROFILING is on so we need to subtract sizeofW(StgProfHeader) */
-    printf("#define PROF_HDR_SIZE  %d\n", sizeofW(StgProfHeader));
-    printf("#define GRAN_HDR_SIZE  %d\n", sizeofW(StgGranHeader));
-
-    printf("#define STD_ITBL_SIZE   %d\n", sizeofW(StgInfoTable));
-    printf("#define RET_ITBL_SIZE   %d\n", sizeofW(StgRetInfoTable) - sizeofW(StgInfoTable));
-    printf("#define PROF_ITBL_SIZE  %d\n", sizeofW(StgProfInfo));
-
-    printf("#define GRAN_ITBL_SIZE  %d\n", 0);
-    printf("#define TICKY_ITBL_SIZE %d\n", 0);
-
-    printf("#define BLOCK_SIZE   %d\n", BLOCK_SIZE);
-    printf("#define MBLOCK_SIZE   %d\n", MBLOCK_SIZE);  
-
-    printf("\n\n");
-#endif
-
-    field_offset(StgRegTable, rR1);
-    field_offset(StgRegTable, rR2);
-    field_offset(StgRegTable, rR3);
-    field_offset(StgRegTable, rR4);
-    field_offset(StgRegTable, rR5);
-    field_offset(StgRegTable, rR6);
-    field_offset(StgRegTable, rR7);
-    field_offset(StgRegTable, rR8);
-    field_offset(StgRegTable, rR9);
-    field_offset(StgRegTable, rR10);
-    field_offset(StgRegTable, rF1);
-    field_offset(StgRegTable, rF2);
-    field_offset(StgRegTable, rF3);
-    field_offset(StgRegTable, rF4);
-    field_offset(StgRegTable, rD1);
-    field_offset(StgRegTable, rD2);
-    field_offset(StgRegTable, rL1);
-    field_offset(StgRegTable, rSp);
-    field_offset(StgRegTable, rSpLim);
-    field_offset(StgRegTable, rHp);
-    field_offset(StgRegTable, rHpLim);
-    field_offset(StgRegTable, rCurrentTSO);
-    field_offset(StgRegTable, rCurrentNursery);
-    field_offset(StgRegTable, rHpAlloc);
-    struct_field(StgRegTable, rRet);
-
-    // Needed for SMP builds
-    field_offset(StgRegTable, rmp_tmp_w);
-    field_offset(StgRegTable, rmp_tmp1);
-    field_offset(StgRegTable, rmp_tmp2);
-    field_offset(StgRegTable, rmp_result1);
-    field_offset(StgRegTable, rmp_result2);
-
-    def_offset("stgGCEnter1", FUN_OFFSET(stgGCEnter1));
-    def_offset("stgGCFun", FUN_OFFSET(stgGCFun));
-
-    field_offset(Capability, r);
-
-    struct_field(bdescr, start);
-    struct_field(bdescr, free);
-    struct_field(bdescr, blocks);
-    struct_field(bdescr, gen_no);
-    struct_field(bdescr, link);
-
-    struct_size(generation);
-    struct_field(generation, mut_list);
-
-    struct_size(CostCentreStack);
-    struct_field(CostCentreStack, ccsID);
-    struct_field(CostCentreStack, mem_alloc);
-    struct_field(CostCentreStack, scc_count);
-    struct_field(CostCentreStack, prevStack);
-
-    struct_field(CostCentre, ccID);
-    struct_field(CostCentre, link);
-
-    struct_field(StgHeader, info);
-    struct_field_("StgHeader_ccs",  StgHeader, prof.ccs);
-    struct_field_("StgHeader_ldvw", StgHeader, prof.hp.ldvw);
-
-    struct_size(StgSMPThunkHeader);
-
-    closure_payload(StgClosure,payload);
-
-    struct_field(StgEntCounter, allocs);
-    struct_field(StgEntCounter, registeredp);
-    struct_field(StgEntCounter, link);
-    
-    closure_size(StgUpdateFrame);
-    closure_size(StgCatchFrame);
-    closure_size(StgStopFrame);
-
-    closure_size(StgMutArrPtrs);
-    closure_field(StgMutArrPtrs, ptrs);
-
-    closure_size(StgArrWords);
-    closure_field(StgArrWords, words);
-    closure_payload(StgArrWords, payload);
-
-    closure_field(StgTSO, link);
-    closure_field(StgTSO, global_link);
-    closure_field(StgTSO, what_next);
-    closure_field(StgTSO, why_blocked);
-    closure_field(StgTSO, block_info);
-    closure_field(StgTSO, blocked_exceptions);
-    closure_field(StgTSO, id);
-    closure_field(StgTSO, saved_errno);
-    closure_field(StgTSO, trec);
-    closure_field_("StgTSO_CCCS", StgTSO, prof.CCCS);
-    tso_field(StgTSO, sp);
-    tso_field_offset(StgTSO, stack);
-    tso_field(StgTSO, stack_size);
-
-    struct_size(StgTSOProfInfo);
-    struct_size(StgTSOParInfo);
-    struct_size(StgTSOGranInfo);
-    struct_size(StgTSODistInfo);
-
-    opt_struct_size(StgTSOProfInfo,PROFILING);
-    opt_struct_size(StgTSOParInfo,PAR);
-    opt_struct_size(StgTSOGranInfo,GRAN);
-    opt_struct_size(StgTSODistInfo,DIST);
-
-    closure_field(StgUpdateFrame, updatee);
-
-    closure_field(StgCatchFrame, handler);
-    closure_field(StgCatchFrame, exceptions_blocked);
-
-    closure_size(StgPAP);
-    closure_field(StgPAP, n_args);
-    closure_field(StgPAP, fun);
-    closure_field(StgPAP, arity);
-    closure_payload(StgPAP, payload);
-
-    thunk_size(StgAP);
-    closure_field(StgAP, n_args);
-    closure_field(StgAP, fun);
-    closure_payload(StgAP, payload);
-
-    thunk_size(StgAP_STACK);
-    closure_field(StgAP_STACK, size);
-    closure_field(StgAP_STACK, fun);
-    closure_payload(StgAP_STACK, payload);
-
-    closure_field(StgInd, indirectee);
-
-    closure_size(StgMutVar);
-    closure_field(StgMutVar, var);
-
-    closure_size(StgAtomicallyFrame);
-    closure_field(StgAtomicallyFrame, code);
-
-    closure_size(StgCatchSTMFrame);
-    closure_field(StgCatchSTMFrame, handler);
-
-    closure_size(StgCatchRetryFrame);
-    closure_field(StgCatchRetryFrame, running_alt_code);
-    closure_field(StgCatchRetryFrame, first_code);
-    closure_field(StgCatchRetryFrame, alt_code);
-    closure_field(StgCatchRetryFrame, first_code_trec);
-
-    closure_size(StgWeak);
-    closure_field(StgWeak,link);
-    closure_field(StgWeak,key);
-    closure_field(StgWeak,value);
-    closure_field(StgWeak,finalizer);
-
-    closure_size(StgDeadWeak);
-    closure_field(StgDeadWeak,link);
-
-    closure_size(StgMVar);
-    closure_field(StgMVar,head);
-    closure_field(StgMVar,tail);
-    closure_field(StgMVar,value);
-
-    closure_size(StgBCO);
-    closure_field(StgBCO, instrs);
-    closure_field(StgBCO, literals);
-    closure_field(StgBCO, ptrs);
-    closure_field(StgBCO, itbls);
-    closure_field(StgBCO, arity);
-    closure_field(StgBCO, size);
-    closure_payload(StgBCO, bitmap);
-
-    closure_size(StgStableName);
-    closure_field(StgStableName,sn);
-
-    struct_field_("RtsFlags_ProfFlags_showCCSOnException",
-		  RTS_FLAGS, ProfFlags.showCCSOnException);
-    struct_field_("RtsFlags_DebugFlags_apply",
-		  RTS_FLAGS, DebugFlags.apply);
-    struct_field_("RtsFlags_DebugFlags_sanity",
-		  RTS_FLAGS, DebugFlags.sanity);
-    struct_field_("RtsFlags_DebugFlags_weak",
-		  RTS_FLAGS, DebugFlags.weak);
-    struct_field_("RtsFlags_GcFlags_initialStkSize",
-		  RTS_FLAGS, GcFlags.initialStkSize);
-
-    struct_size(StgFunInfoExtraFwd);
-    struct_field(StgFunInfoExtraFwd, slow_apply);
-    struct_field(StgFunInfoExtraFwd, fun_type);
-    struct_field(StgFunInfoExtraFwd, arity);
-    struct_field_("StgFunInfoExtraFwd_bitmap", StgFunInfoExtraFwd, b.bitmap);
-
-    struct_size(StgFunInfoExtraRev);
-    struct_field(StgFunInfoExtraRev, slow_apply_offset);
-    struct_field(StgFunInfoExtraRev, fun_type);
-    struct_field(StgFunInfoExtraRev, arity);
-    struct_field_("StgFunInfoExtraRev_bitmap", StgFunInfoExtraRev, b.bitmap);
-
-    struct_field(StgLargeBitmap, size);
-    field_offset(StgLargeBitmap, bitmap);
-
-    struct_size(snEntry);
-    struct_field(snEntry,sn_obj);
-    struct_field(snEntry,addr);
-
-#ifdef mingw32_HOST_OS
-    struct_size(StgAsyncIOResult);
-    struct_field(StgAsyncIOResult, reqID);
-    struct_field(StgAsyncIOResult, len);
-    struct_field(StgAsyncIOResult, errCode);
-#endif
-
-    struct_size(MP_INT);
-    struct_field(MP_INT,_mp_alloc);
-    struct_field(MP_INT,_mp_size);
-    struct_field(MP_INT,_mp_d);
-
-    ctype(mp_limb_t);
-    return 0;
-}
diff --git a/ghc/lib/Makefile b/ghc/lib/Makefile
deleted file mode 100644
index ca08ea20bc..0000000000
--- a/ghc/lib/Makefile
+++ /dev/null
@@ -1,6 +0,0 @@
-TOP=..
-include $(TOP)/mk/boilerplate.mk
-
-SUBDIRS = compat
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/lib/compat/Compat/Directory.hs b/ghc/lib/compat/Compat/Directory.hs
deleted file mode 100644
index e6e4cd4a2c..0000000000
--- a/ghc/lib/compat/Compat/Directory.hs
+++ /dev/null
@@ -1,131 +0,0 @@
-{-# OPTIONS -cpp #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Compat.Directory
--- Copyright   :  (c) The University of Glasgow 2001-2004
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  portable
---
--- Functions from System.Directory that aren't present in older versions
--- of that library.
---
------------------------------------------------------------------------------
-
-module Compat.Directory (
-  	getAppUserDataDirectory,
-  	copyFile,
-  	findExecutable,
-  	createDirectoryIfMissing
-  ) where
-
-#include "../../includes/ghcconfig.h"
-
-import System.Environment (getEnv)
-import System.Directory.Internals
-#if __GLASGOW_HASKELL__ > 600
-import Control.Exception	( bracket )
-import Control.Monad		( when )
-import Foreign.Marshal.Alloc	( allocaBytes )
-import System.IO (IOMode(..), openBinaryFile, hGetBuf, hPutBuf, hClose)
-import System.IO.Error		( try )
-import GHC.IOBase ( IOException(..), IOErrorType(..) )
-#else
-import System.IO		( try )
-#endif
-#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
-import Foreign.Ptr
-import Foreign.C
-#endif
-import System.Directory(doesFileExist, doesDirectoryExist, getPermissions, setPermissions, createDirectory)
-
-getAppUserDataDirectory :: String -> IO FilePath
-getAppUserDataDirectory appName = do
-#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
-  allocaBytes long_path_size $ \pPath -> do
-     r <- c_SHGetFolderPath nullPtr csidl_APPDATA nullPtr 0 pPath
-     when (r<0) (raiseUnsupported "Compat.Directory.getAppUserDataDirectory")
-     s <- peekCString pPath
-     return (s++'\\':appName)
-#else
-  path <- getEnv "HOME"
-  return (path++'/':'.':appName)
-#endif
-
-#if __GLASGOW_HASKELL__ && defined(mingw32_HOST_OS)
-foreign import ccall unsafe "directory.h __hscore_getFolderPath"
-            c_SHGetFolderPath :: Ptr () 
-                              -> CInt 
-                              -> Ptr () 
-                              -> CInt 
-                              -> CString 
-                              -> IO CInt
-
--- __compat_long_path_size defined in cbits/directory.c
-foreign import ccall unsafe "directory.h __compat_long_path_size"
-  long_path_size :: Int
-
-foreign import ccall unsafe "directory.h __hscore_CSIDL_APPDATA"  csidl_APPDATA  :: CInt
-
-raiseUnsupported loc = 
-   ioError (IOError Nothing UnsupportedOperation loc "unsupported operation" Nothing)
-#endif
-
-
-copyFile :: FilePath -> FilePath -> IO ()
-copyFile fromFPath toFPath =
-#if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
-	do readFile fromFPath >>= writeFile toFPath
-	   try (getPermissions fromFPath >>= setPermissions toFPath)
-	   return ()
-#else
-	(bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
-	 bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
-	 allocaBytes bufferSize $ \buffer -> do
-		copyContents hFrom hTo buffer
-		try (getPermissions fromFPath >>= setPermissions toFPath)
-		return ()) `catch` (ioError . changeFunName)
-	where
-		bufferSize = 1024
-		
-		changeFunName (IOError h iot fun str mb_fp) = IOError h iot "copyFile" str mb_fp
-		
-		copyContents hFrom hTo buffer = do
-			count <- hGetBuf hFrom buffer bufferSize
-			when (count > 0) $ do
-				hPutBuf hTo buffer count
-				copyContents hFrom hTo buffer
-#endif
-
-
-findExecutable :: String -> IO (Maybe FilePath)
-findExecutable binary = do
-  path <- getEnv "PATH"
-  search (parseSearchPath path)
-  where
-#ifdef mingw32_HOST_OS
-    fileName = binary `joinFileExt` "exe"
-#else
-    fileName = binary
-#endif
-
-    search :: [FilePath] -> IO (Maybe FilePath)
-    search [] = return Nothing
-    search (d:ds) = do
-	let path = d `joinFileName` fileName
-	b <- doesFileExist path
-	if b then return (Just path)
-             else search ds
-
-createDirectoryIfMissing :: Bool     -- ^ Create its parents too?
-		         -> FilePath -- ^ The path to the directory you want to make
-		         -> IO ()
-createDirectoryIfMissing parents file = do
-  b <- doesDirectoryExist file
-  case (b,parents, file) of 
-    (_,     _, "") -> return ()
-    (True,  _,  _) -> return ()
-    (_,  True,  _) -> mapM_ (createDirectoryIfMissing False) (tail (pathParents file))
-    (_, False,  _) -> createDirectory file
diff --git a/ghc/lib/compat/Compat/RawSystem.hs b/ghc/lib/compat/Compat/RawSystem.hs
deleted file mode 100644
index f0f8aa3ac7..0000000000
--- a/ghc/lib/compat/Compat/RawSystem.hs
+++ /dev/null
@@ -1,156 +0,0 @@
-{-# OPTIONS -cpp #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Compat.RawSystem
--- Copyright   :  (c) The University of Glasgow 2001-2004
--- License     :  BSD-style (see the file libraries/base/LICENSE)
--- 
--- Maintainer  :  libraries@haskell.org
--- Stability   :  provisional
--- Portability :  portable
---
--- This is an implementation of rawSystem for use on older versions of GHC
--- which had missing or buggy implementations of this function.
---
------------------------------------------------------------------------------
-
-module Compat.RawSystem (rawSystem) where
-
-#include "../../includes/ghcconfig.h"
-
-#if __GLASGOW_HASKELL__ >= 603
-
-import System.Cmd (rawSystem)
-
-#else /* to end of file */
-
-import System.Exit
-import Foreign
-import Foreign.C
-
-{- | 
-The computation @'rawSystem' cmd args@ runs the operating system command
-whose file name is @cmd@, passing it the arguments @args@.  It
-bypasses the shell, so that @cmd@ should see precisely the argument
-strings @args@, with no funny escaping or shell meta-syntax expansion.
-(Unix users will recognise this behaviour 
-as @execvp@, and indeed that's how it's implemented.)
-It will therefore behave more portably between operating systems than 'system'.
-
-The return codes are the same as for 'system'.
--}
-
-rawSystem :: FilePath -> [String] -> IO ExitCode
-
-{- -------------------------------------------------------------------------
- 	IMPORTANT IMPLEMENTATION NOTES
-   (see also libraries/base/cbits/rawSystem.c)
-
-On Unix, rawSystem is easy to implement: use execvp.
-
-On Windows it's more tricky.  We use CreateProcess, passing a single
-command-line string (lpCommandLine) as its argument.  (CreateProcess
-is well documented on http://msdn.microsoft/com.)
-
-  - It parses the beginning of the string to find the command. If the
-	file name has embedded spaces, it must be quoted, using double
-	quotes thus 
-		"foo\this that\cmd" arg1 arg2
-
-  - The invoked command can in turn access the entire lpCommandLine string,
-	and the C runtime does indeed do so, parsing it to generate the 
-	traditional argument vector argv[0], argv[1], etc.  It does this
-	using a complex and arcane set of rules which are described here:
-	
-	   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
-
-	(if this URL stops working, you might be able to find it by
-	searching for "Parsing C Command-Line Arguments" on MSDN.  Also,
-	the code in the Microsoft C runtime that does this translation
-	is shipped with VC++).
-
-
-Our goal in rawSystem is to take a command filename and list of
-arguments, and construct a string which inverts the translatsions
-described above, such that the program at the other end sees exactly
-the same arguments in its argv[] that we passed to rawSystem.
-
-This inverse translation is implemented by 'translate' below.
-
-Here are some pages that give informations on Windows-related 
-limitations and deviations from Unix conventions:
-
-    http://support.microsoft.com/default.aspx?scid=kb;en-us;830473
-    Command lines and environment variables effectively limited to 8191 
-    characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):
-
-    http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp
-    Command-line substitution under Windows XP. IIRC these facilities (or at 
-    least a large subset of them) are available on Win NT and 2000. Some 
-    might be available on Win 9x.
-
-    http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp
-    How CMD.EXE processes command lines.
-
-
-Note: CreateProcess does have a separate argument (lpApplicationName)
-with which you can specify the command, but we have to slap the
-command into lpCommandLine anyway, so that argv[0] is what a C program
-expects (namely the application name).  So it seems simpler to just
-use lpCommandLine alone, which CreateProcess supports.
-
------------------------------------------------------------------------------ -}
-
-#ifndef mingw32_HOST_OS
-
-rawSystem cmd args =
-  withCString cmd $ \pcmd ->
-    withMany withCString (cmd:args) $ \cstrs ->
-      withArray0 nullPtr cstrs $ \arr -> do
-	status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmd arr)
-        case status of
-            0  -> return ExitSuccess
-            n  -> return (ExitFailure n)
-
-foreign import ccall unsafe "rawSystem"
-  c_rawSystem :: CString -> Ptr CString -> IO Int
-
-#else
-
--- On Windows, the command line is passed to the operating system as
--- a single string.  Command-line parsing is done by the executable
--- itself.
-rawSystem cmd args = do
-	-- NOTE: 'cmd' is assumed to contain the application to run _only_,
-	-- as it'll be quoted surrounded in quotes here.
-  let cmdline = translate cmd ++ concat (map ((' ':) . translate) args)
-  withCString cmdline $ \pcmdline -> do
-    status <- throwErrnoIfMinus1 "rawSystem" (c_rawSystem pcmdline)
-    case status of
-       0  -> return ExitSuccess
-       n  -> return (ExitFailure n)
-
-translate :: String -> String
-translate str@('"':_) = str -- already escaped.
-	-- ToDo: this case is wrong.  It is only here because we
-	-- abuse the system in GHC's SysTools by putting arguments into
-	-- the command name; at some point we should fix it up and remove
-	-- the case above.
-translate str = '"' : snd (foldr escape (True,"\"") str)
-  where escape '"'  (b,     str) = (True,  '\\' : '"'  : str)
-        escape '\\' (True,  str) = (True,  '\\' : '\\' : str)
-        escape '\\' (False, str) = (False, '\\' : str)
-	escape c    (b,     str) = (False, c : str)
-	-- See long comment above for what this function is trying to do.
-	--
-	-- The Bool passed back along the string is True iff the
-	-- rest of the string is a sequence of backslashes followed by
-	-- a double quote.
-
-foreign import ccall unsafe "rawSystem"
-  c_rawSystem :: CString -> IO Int
-
-#endif
-
-#endif
-
diff --git a/ghc/lib/compat/Compat/Unicode.hs b/ghc/lib/compat/Compat/Unicode.hs
deleted file mode 100644
index 2637fac818..0000000000
--- a/ghc/lib/compat/Compat/Unicode.hs
+++ /dev/null
@@ -1,66 +0,0 @@
-{-# OPTIONS -cpp #-}
-module Compat.Unicode (
-    GeneralCategory(..), generalCategory, isPrint, isUpper
-  ) where
-
-#if __GLASGOW_HASKELL__ > 604
-
-import Data.Char (GeneralCategory(..), generalCategory,isPrint,isUpper)
-
-#else
-
-import Foreign.C	( CInt )
-import Data.Char	( ord )
-
--- | Unicode General Categories (column 2 of the UnicodeData table)
--- in the order they are listed in the Unicode standard.
-
-data GeneralCategory
-        = UppercaseLetter       -- Lu  Letter, Uppercase
-        | LowercaseLetter       -- Ll  Letter, Lowercase
-        | TitlecaseLetter       -- Lt  Letter, Titlecase
-        | ModifierLetter        -- Lm  Letter, Modifier
-        | OtherLetter           -- Lo  Letter, Other
-        | NonSpacingMark        -- Mn  Mark, Non-Spacing
-        | SpacingCombiningMark  -- Mc  Mark, Spacing Combining
-        | EnclosingMark         -- Me  Mark, Enclosing
-        | DecimalNumber         -- Nd  Number, Decimal
-        | LetterNumber          -- Nl  Number, Letter
-        | OtherNumber           -- No  Number, Other
-        | ConnectorPunctuation  -- Pc  Punctuation, Connector
-        | DashPunctuation       -- Pd  Punctuation, Dash
-        | OpenPunctuation       -- Ps  Punctuation, Open
-        | ClosePunctuation      -- Pe  Punctuation, Close
-        | InitialQuote          -- Pi  Punctuation, Initial quote
-        | FinalQuote            -- Pf  Punctuation, Final quote
-        | OtherPunctuation      -- Po  Punctuation, Other
-        | MathSymbol            -- Sm  Symbol, Math
-        | CurrencySymbol        -- Sc  Symbol, Currency
-        | ModifierSymbol        -- Sk  Symbol, Modifier
-        | OtherSymbol           -- So  Symbol, Other
-        | Space                 -- Zs  Separator, Space
-        | LineSeparator         -- Zl  Separator, Line
-        | ParagraphSeparator    -- Zp  Separator, Paragraph
-        | Control               -- Cc  Other, Control
-        | Format                -- Cf  Other, Format
-        | Surrogate             -- Cs  Other, Surrogate
-        | PrivateUse            -- Co  Other, Private Use
-        | NotAssigned           -- Cn  Other, Not Assigned
-        deriving (Eq, Ord, Enum, Read, Show, Bounded)
-
--- | Retrieves the general Unicode category of the character.
-generalCategory :: Char -> GeneralCategory
-generalCategory c = toEnum (wgencat (fromIntegral (ord c)))
-
-foreign import ccall unsafe "u_gencat"
-  wgencat :: CInt -> Int
-
-isPrint c = iswprint (fromIntegral (ord c)) /= 0
-isUpper c = iswupper (fromIntegral (ord c)) /= 0
-
-foreign import ccall unsafe "u_iswprint"
-  iswprint :: CInt -> CInt
-
-foreign import ccall unsafe "u_iswupper"
-  iswupper :: CInt -> CInt
-#endif
diff --git a/ghc/lib/compat/Distribution/Compat/FilePath.hs b/ghc/lib/compat/Distribution/Compat/FilePath.hs
deleted file mode 100644
index 2dbd337b67..0000000000
--- a/ghc/lib/compat/Distribution/Compat/FilePath.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-{-# OPTIONS -cpp #-}
-#include "Cabal/Distribution/Compat/FilePath.hs"
--- dummy comment
diff --git a/ghc/lib/compat/Distribution/Compat/ReadP.hs b/ghc/lib/compat/Distribution/Compat/ReadP.hs
deleted file mode 100644
index 5fc69da3da..0000000000
--- a/ghc/lib/compat/Distribution/Compat/ReadP.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-{-# OPTIONS -cpp #-}
-#include "Cabal/Distribution/Compat/ReadP.hs"
--- dummy comment
diff --git a/ghc/lib/compat/Distribution/Compiler.hs b/ghc/lib/compat/Distribution/Compiler.hs
deleted file mode 100644
index b5a2f68f1e..0000000000
--- a/ghc/lib/compat/Distribution/Compiler.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-{-# OPTIONS -cpp #-}
-#include "Cabal/Distribution/Compiler.hs"
--- dummy comment
diff --git a/ghc/lib/compat/Distribution/GetOpt.hs b/ghc/lib/compat/Distribution/GetOpt.hs
deleted file mode 100644
index 7da2e30431..0000000000
--- a/ghc/lib/compat/Distribution/GetOpt.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-{-# OPTIONS -cpp #-}
-#include "Cabal/Distribution/GetOpt.hs"
--- dummy comment
diff --git a/ghc/lib/compat/Distribution/InstalledPackageInfo.hs b/ghc/lib/compat/Distribution/InstalledPackageInfo.hs
deleted file mode 100644
index 03f509216a..0000000000
--- a/ghc/lib/compat/Distribution/InstalledPackageInfo.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-{-# OPTIONS -cpp #-}
-#include "Cabal/Distribution/InstalledPackageInfo.hs"
--- dummy comment
diff --git a/ghc/lib/compat/Distribution/License.hs b/ghc/lib/compat/Distribution/License.hs
deleted file mode 100644
index 31b1b271a6..0000000000
--- a/ghc/lib/compat/Distribution/License.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-{-# OPTIONS -cpp #-}
-#include "Cabal/Distribution/License.hs"
-
--- dummy comment
diff --git a/ghc/lib/compat/Distribution/Package.hs b/ghc/lib/compat/Distribution/Package.hs
deleted file mode 100644
index d40171eec5..0000000000
--- a/ghc/lib/compat/Distribution/Package.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-{-# OPTIONS -cpp #-}
-#include "Cabal/Distribution/Package.hs"
--- dummy comment
diff --git a/ghc/lib/compat/Distribution/ParseUtils.hs b/ghc/lib/compat/Distribution/ParseUtils.hs
deleted file mode 100644
index f5bf266a95..0000000000
--- a/ghc/lib/compat/Distribution/ParseUtils.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-{-# OPTIONS -cpp #-}
-#include "Cabal/Distribution/ParseUtils.hs"
--- dummy comment
diff --git a/ghc/lib/compat/Distribution/Version.hs b/ghc/lib/compat/Distribution/Version.hs
deleted file mode 100644
index 1140c03cbd..0000000000
--- a/ghc/lib/compat/Distribution/Version.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-{-# OPTIONS -cpp #-}
-#include "Cabal/Distribution/Version.hs"
--- dummy comment
diff --git a/ghc/lib/compat/Language/Haskell/Extension.hs b/ghc/lib/compat/Language/Haskell/Extension.hs
deleted file mode 100644
index 410a07b4d6..0000000000
--- a/ghc/lib/compat/Language/Haskell/Extension.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-{-# OPTIONS -cpp #-}
-#include "Cabal/Language/Haskell/Extension.hs"
--- dummy comment
diff --git a/ghc/lib/compat/Makefile b/ghc/lib/compat/Makefile
deleted file mode 100644
index 7637c94115..0000000000
--- a/ghc/lib/compat/Makefile
+++ /dev/null
@@ -1,101 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-ALL_DIRS = \
-	Data \
-	Compat \
-	Distribution \
-	Distribution/Compat \
-	Language/Haskell \
-	System \
-	System/Directory \
-	cbits
-
-SplitObjs=NO
-LIBRARY = libghccompat.a
-
-# We don't want this installed
-NO_INSTALL_LIBRARY = YES
-
-# Avoid building the GHCi lib, since we don't need it
-GhcWithInterpreter = NO
-
-# Needed so that the libraries can #include relative to this directory.
-INCLUDE_DIRS=-I. -Iinclude
-
-SRC_HC_OPTS    += $(INCLUDE_DIRS)
-SRC_CC_OPTS    += $(INCLUDE_DIRS)
-MKDEPENDC_OPTS += $(INCLUDE_DIRS)
-
-# Just to silence warnings
-MKDEPENDC_OPTS += -I$(GHC_INCLUDE_DIR)
-
-UseGhcForCc = YES
-
-# This library is linked to the compiler, at least in stage1, so we
-# better make sure it is built the same "way".
-#
-# BUT, if GhcHcOpts includes -DDEBUG we *don't* want to compile
-# lib/compat with -DDEBUG, because the preprocessor symbols used
-# by the compiler may be understood differently by library code.
-# In this particular case, it turned out that -DDEBUG made Cabal 
-# import HUnit, which might not be installed for the compiler we are
-# compiling with (e.g. 6.2.1). Hence the filter-out.
-SRC_HC_OPTS += $(filter-out -D%, $(GhcHcOpts)) 
-
-# GHC 6.4 didn't have WCsubst.c, but 6.4.1 did, and we need to know
-# this in cbits/unicode.c The patchlevel isn't normally exposed as a
-# CPP symbol, so we have to do it by hand:
-SRC_CC_OPTS += -D__GHC_PATCHLEVEL__=$(GhcPatchLevel)
-
-ifeq "$(ghc_ge_603)" "YES"
-# These modules are provided in GHC 6.3+
-EXCLUDED_SRCS += \
-	System/Directory/Internals.hs
-
-SRC_MKDEPENDHS_OPTS += \
-	-optdep--exclude-module=System.Directory.Internals
-
-# GHC 6.3+ has Cabal, but we're replacing it:
-SRC_HC_OPTS += -ignore-package Cabal
-endif
-
-# Some explicit dependencies, needed because ghc -M can't discover the
-# true dependencies of these stub files.
-System/Directory/Internals.$(way_)o : $(FPTOOLS_TOP)/libraries/base/System/Directory/Internals.hs
-Distribution/Compat/FilePath.$(way_) : $(FPTOOLS_TOP)/libraries/Cabal/Distribution/Compat/FilePath.hs
-Distribution/Compat/ReadP.$(way_) : $(FPTOOLS_TOP)/libraries/Cabal/Distribution/Compat/ReadP.hs
-Distribution/GetOpt.$(way_)o    : $(FPTOOLS_TOP)/libraries/Cabal/Distribution/GetOpt.hs
-Distribution/InstalledPackageInfo.$(way_)o :  $(FPTOOLS_TOP)/libraries/Cabal/Distribution/InstalledPackageInfo.hs
-Distribution/License.$(way_)o :  $(FPTOOLS_TOP)/libraries/Cabal/Distribution/License.hs
-Distribution/Package.$(way_)o :  $(FPTOOLS_TOP)/libraries/Cabal/Distribution/Package.hs
-Distribution/ParseUtils.$(way_)o :  $(FPTOOLS_TOP)/libraries/Cabal/Distribution/ParseUtils.hs
-Distribution/Compiler.$(way_)o :  $(FPTOOLS_TOP)/libraries/Cabal/Distribution/Compiler.hs
-Distribution/Version.$(way_)o :  $(FPTOOLS_TOP)/libraries/Cabal/Distribution/Version.hs
-Language/Haskell/Extension.$(way_)o :  $(FPTOOLS_TOP)/libraries/Cabal/Language/Haskell/Extension.hs
-cbits/unicode.o : $(FPTOOLS_TOP)/libraries/base/cbits/WCsubst.c $(FPTOOLS_TOP)/libraries/base/include/WCsubst.h
-
-SRC_CC_OPTS += -I$(FPTOOLS_TOP)/libraries/base/cbits -I$(FPTOOLS_TOP)/libraries/base/include
-
-# Make the #includes in the stubs independent of the current location
-SRC_HC_OPTS += -I$(FPTOOLS_TOP)/libraries
-
-SRC_HC_OPTS +=  -fglasgow-exts -no-recomp
-
-ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-Compat/Directory_HC_OPTS += -\#include shlobj.h
-endif
-
-# libghccompat is needed to build ghc-pkg, which is built during 'make boot',
-# so we must build this library during 'make boot' too.
-# Do a recursive 'make all' after generating dependencies, because this
-# will work with 'make -j'.
-ifneq "$(BootingFromHc)" "YES"
-boot :: depend
-	$(MAKE) all
-endif
-
-# We don't ever want to build libghccompat as a shared library.
-GhcBuildDylibs=NO
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/lib/compat/README b/ghc/lib/compat/README
deleted file mode 100644
index 8d0697beb4..0000000000
--- a/ghc/lib/compat/README
+++ /dev/null
@@ -1,32 +0,0 @@
-GHC compatibiliy library: libghccompat.a
-----------------------------------------
-
-This library contains interfaces that are available in recent versions
-of GHC, but may or may not be available in older versions.  The idea
-is to provide an abstraction layer and reduce the amount of #ifdefery
-and code duplication in GHC and its tools.  Furthermore, we can add
-modules to the main library and start using them right away in GHC, by
-adding a stub to this compat library.
-
-There are two types of modules in here:
-
-(a) a module with the same name as a module in the main library
-    (eg. Distribution.Package).  If the module is available in
-    the main library, then we don't include it in  libghccompat.
-    Otherwise, we have a stub module here that just #includes
-    the source from the real location under libraries/.  Go look
-    at Distribution/Package.hs for example.
-
-(b) a module that doesn't exist in another library.  For example,
-    Compat.RawSystem.  These modules are used to provide functions
-    that are available in newer versions of the main libraries.
-
-BIG NOTE: when building stage 2 of GHC, libghccompat is not used,
-because we would have to build another version of it.  Instead, we
-just use the appropriate libraries directly.  For (a)-type modules,
-just import the module directly.  For (b)-type modules, a single
-#ifdef will be required to choose between the Compat version and
-the real version.
-
-In stage 1 of GHC, and tools (eg. ghc-pkg, runghc), libghccompat.a
-is linked in, so all its libraries will be accessible.
diff --git a/ghc/lib/compat/System/Directory/Internals.hs b/ghc/lib/compat/System/Directory/Internals.hs
deleted file mode 100644
index 5ac8e3ba24..0000000000
--- a/ghc/lib/compat/System/Directory/Internals.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-{-# OPTIONS -cpp #-}
-#include "../../includes/ghcplatform.h"
-#include "base/System/Directory/Internals.hs"
--- dummy comment
diff --git a/ghc/lib/compat/cbits/directory.c b/ghc/lib/compat/cbits/directory.c
deleted file mode 100644
index 79d6cd4d44..0000000000
--- a/ghc/lib/compat/cbits/directory.c
+++ /dev/null
@@ -1,96 +0,0 @@
-#include "HsFFI.h"
-
-#include "../../../includes/ghcconfig.h"
-
-#if HAVE_LIMITS_H
-#include <limits.h>
-#endif
-#if HAVE_WINDOWS_H
-#include <windows.h>
-#endif
-#include "directory.h"
-
-#define INLINE /* nothing */
-
-/*
- * Following code copied from libraries/base/includes/HsBase.h
- */
-
-#ifdef PATH_MAX
-/* A size that will contain many path names, but not necessarily all
- * (PATH_MAX is not defined on systems with unlimited path length,
- * e.g. the Hurd).
- */
-INLINE HsInt __compat_long_path_size() { return PATH_MAX; } 
-#else
-INLINE HsInt __compat_long_path_size() { return 4096; }
-#endif
-
-#if defined(mingw32_HOST_OS)
-
-/* Make sure we've got the reqd CSIDL_ constants in scope;
- * w32api header files are lagging a bit in defining the full set.
- */
-#if !defined(CSIDL_APPDATA)
-#define CSIDL_APPDATA 0x001a
-#endif
-#if !defined(CSIDL_PERSONAL)
-#define CSIDL_PERSONAL 0x0005
-#endif
-#if !defined(CSIDL_PROFILE)
-#define CSIDL_PROFILE 0x0028
-#endif
-#if !defined(CSIDL_WINDOWS)
-#define CSIDL_WINDOWS 0x0024
-#endif
-
-INLINE int __hscore_CSIDL_PROFILE()  { return CSIDL_PROFILE;  }
-INLINE int __hscore_CSIDL_APPDATA()  { return CSIDL_APPDATA;  }
-INLINE int __hscore_CSIDL_WINDOWS()  { return CSIDL_WINDOWS;  }
-INLINE int __hscore_CSIDL_PERSONAL() { return CSIDL_PERSONAL; }
-
-#if __GLASGOW_HASKELL__ < 604
-/*
- * Function: __hscore_getFolderPath()
- *
- * Late-bound version of SHGetFolderPath(), coping with OS versions
- * that have shell32's lacking that particular API.
- *
- */
-typedef HRESULT (*HSCORE_GETAPPFOLDERFUNTY)(HWND,int,HANDLE,DWORD,char*);
-int
-__hscore_getFolderPath(HWND hwndOwner,
-		       int nFolder,
-		       HANDLE hToken,
-		       DWORD dwFlags,
-		       char*  pszPath)
-{
-    static int loaded_dll = 0;
-    static HMODULE hMod = (HMODULE)NULL;
-    static HSCORE_GETAPPFOLDERFUNTY funcPtr = NULL;
-    /* The DLLs to try loading entry point from */
-    char* dlls[] = { "shell32.dll", "shfolder.dll" };
-    
-    if (loaded_dll < 0) {
-	return (-1);
-    } else if (loaded_dll == 0) {
-	int i;
-	for(i=0;i < sizeof(dlls); i++) {
-	    hMod = LoadLibrary(dlls[i]);
-	    if ( hMod != NULL &&
-		 (funcPtr = (HSCORE_GETAPPFOLDERFUNTY)GetProcAddress(hMod, "SHGetFolderPathA")) ) {
-		loaded_dll = 1;
-		break;
-	    }
-	}
-	if (loaded_dll == 0) {
-	    loaded_dll = (-1);
-	    return (-1);
-	}
-    }
-    /* OK, if we got this far the function has been bound */
-    return (int)funcPtr(hwndOwner,nFolder,hToken,dwFlags,pszPath);
-    /* ToDo: unload the DLL on shutdown? */
-}
-#endif /* __GLASGOW_HASKELL__ < 604 */
-#endif
diff --git a/ghc/lib/compat/cbits/rawSystem.c b/ghc/lib/compat/cbits/rawSystem.c
deleted file mode 100644
index 00b8c49cc1..0000000000
--- a/ghc/lib/compat/cbits/rawSystem.c
+++ /dev/null
@@ -1,140 +0,0 @@
-/* 
- * (c) The University of Glasgow 1994-2004
- *
- * WARNING: this file is here for backwards compatibility only.  It is
- * not included as part of the base package, but is #included into the
- * compiler and the runghc utility when building either of these with 
- * an old version of GHC.
- *
- * shell-less system Runtime Support (see System.Cmd.rawSystem).
- */
-
-/* The itimer stuff in this module is non-posix */
-/* #include "PosixSource.h" */
-
-#include "../../../includes/ghcconfig.h"
-
-#include <stdio.h>
-#include <stdlib.h>
-
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-#ifdef HAVE_ERRNO_H
-#include <errno.h>
-#endif
-#ifdef HAVE_SYS_WAIT_H
-#include <sys/wait.h>
-#endif
-
-# ifdef TIME_WITH_SYS_TIME
-#  include <sys/time.h>
-#  include <time.h>
-# else
-#  ifdef HAVE_SYS_TIME_H
-#   include <sys/time.h>
-#  else
-#   include <time.h>
-#  endif
-# endif
-
-#include "HsFFI.h"
-
-#if defined(mingw32_HOST_OS)
-#include <windows.h>
-#endif
-
-#ifdef HAVE_VFORK_H
-#include <vfork.h>
-#endif
-
-#ifdef HAVE_VFORK
-#define fork vfork
-#endif
-
-#if defined(mingw32_HOST_OS)
-/* -------------------- WINDOWS VERSION --------------------- */
-
-HsInt
-rawSystem(HsAddr cmd)
-{
-  STARTUPINFO sInfo;
-  PROCESS_INFORMATION pInfo;
-  DWORD retCode;
-
-  ZeroMemory(&sInfo, sizeof(sInfo));
-  sInfo.cb = sizeof(sInfo);
-
-  if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, 0, NULL, NULL, &sInfo, &pInfo)) {
-    /* The 'TRUE' says that the created process should share
-       handles with the current process.  This is vital to ensure
-       that error messages sent to stderr actually appear on the screen.
-       Since we are going to wait for the process to terminate anyway,
-       there is no problem with such sharing. */
-
-      errno = EINVAL; // ToDo: wrong, caller should use GetLastError()
-      return -1;
-  }
-  WaitForSingleObject(pInfo.hProcess, INFINITE);
-  if (GetExitCodeProcess(pInfo.hProcess, &retCode) == 0) {
-      errno = EINVAL; // ToDo: wrong, caller should use GetLastError()
-      return -1;
-  }
-
-  CloseHandle(pInfo.hProcess);
-  CloseHandle(pInfo.hThread);
-  return retCode;
-}
-
-#else
-/* -------------------- UNIX VERSION --------------------- */
-
-HsInt
-rawSystem(HsAddr cmd, HsAddr args)
-{
-    int pid;
-    int wstat;
-
-    switch(pid = fork()) {
-    case -1:
-	{
-	    return -1;
-	}
-    case 0:
-      {
-#ifdef HAVE_SETITIMER
-	/* Reset the itimers in the child, so it doesn't get plagued
-	 * by SIGVTALRM interrupts.
-	 */
-	struct timeval tv_null = { 0, 0 };
-	struct itimerval itv;
-	itv.it_interval = tv_null;
-	itv.it_value = tv_null;
-	setitimer(ITIMER_REAL, &itv, NULL);
-	setitimer(ITIMER_VIRTUAL, &itv, NULL);
-	setitimer(ITIMER_PROF, &itv, NULL);
-#endif
-
-	/* the child */
-	execvp(cmd, args);
-	_exit(127);
-      }
-    }
-
-    while (waitpid(pid, &wstat, 0) < 0) {
-	if (errno != EINTR) {
-	    return -1;
-	}
-    }
-
-    if (WIFEXITED(wstat))
-	return WEXITSTATUS(wstat);
-    else if (WIFSIGNALED(wstat)) {
-	errno = EINTR;
-    }
-    else {
-	/* This should never happen */
-    }
-    return -1;
-}
-#endif
diff --git a/ghc/lib/compat/cbits/unicode.c b/ghc/lib/compat/cbits/unicode.c
deleted file mode 100644
index c744cc9436..0000000000
--- a/ghc/lib/compat/cbits/unicode.c
+++ /dev/null
@@ -1,3 +0,0 @@
-#if __GLASGOW_HASKELL__ < 604 || (__GLASGOW_HASKELL__==604 && __GHC_PATCHLEVEL__==0)
-#include "WCsubst.c"
-#endif
diff --git a/ghc/lib/compat/compat.mk b/ghc/lib/compat/compat.mk
deleted file mode 100644
index 156f03378e..0000000000
--- a/ghc/lib/compat/compat.mk
+++ /dev/null
@@ -1,43 +0,0 @@
-# Settings for using the libghccompat.a library elsewhere in the build
-# tree: this file is just included into Makefiles, see 
-# ghc/utils/ghc-pkg/Makefile for example.
-#
-# This is a poor-mans package, but simpler because we don't
-# have to deal with variations in the package support of different
-# versions of GHC.
-
-# Use libghccompat.a:
-SRC_HC_OPTS += -i$(GHC_LIB_COMPAT_DIR)
-SRC_LD_OPTS += -L$(GHC_LIB_COMPAT_DIR) -lghccompat
-
-# Do *not* use the installed Cabal:
-ifeq "$(ghc_ge_603)" "YES"
-SRC_HC_OPTS += -ignore-package Cabal
-endif
-
-# And similarly for when booting from .hc files:
-HC_BOOT_LD_OPTS += -L$(GHC_LIB_COMPAT_DIR)
-HC_BOOT_LIBS += -lghccompat
-
-ifeq "$(Windows)" "YES"
-# not very nice, but required for -lghccompat on Windows
-SRC_LD_OPTS += -lshell32
-HC_BOOT_LIBS += -lshell32
-endif
-
-# This is horrible.  We ought to be able to omit the entire directory
-# from mkDependHS.
-SRC_MKDEPENDHS_OPTS += \
-	-optdep--exclude-module=Compat.RawSystem \
-	-optdep--exclude-module=Compat.Directory \
-	-optdep--exclude-module=Distribution.Compat.FilePath \
-	-optdep--exclude-module=Distribution.Compat.ReadP \
-	-optdep--exclude-module=Distribution.Extension \
-	-optdep--exclude-module=Distribution.GetOpt \
-	-optdep--exclude-module=Distribution.InstalledPackageInfo \
-	-optdep--exclude-module=Distribution.License \
-	-optdep--exclude-module=Distribution.Package \
-	-optdep--exclude-module=Distribution.ParseUtils \
-	-optdep--exclude-module=Distribution.Compiler \
-	-optdep--exclude-module=Distribution.Version \
-	-optdep--exclude-module=System.Directory.Internals
diff --git a/ghc/lib/compat/include/directory.h b/ghc/lib/compat/include/directory.h
deleted file mode 100644
index 2e26c3d5a1..0000000000
--- a/ghc/lib/compat/include/directory.h
+++ /dev/null
@@ -1,13 +0,0 @@
-#ifndef __DIRECTORY_H__
-#define __DIRECTORY_H__ 
-
-#if defined(mingw32_HOST_OS)
-extern int __compat_long_path_size();
-extern int __hscore_CSIDL_APPDATA();
-extern int __hscore_getFolderPath(HWND hwndOwner,
-				  int nFolder,
-				  HANDLE hToken,
-				  DWORD dwFlags,
-				  char*  pszPath);
-#endif
-#endif
diff --git a/ghc/mk/boilerplate.mk b/ghc/mk/boilerplate.mk
deleted file mode 100644
index 0ab3f331a0..0000000000
--- a/ghc/mk/boilerplate.mk
+++ /dev/null
@@ -1,28 +0,0 @@
-# GHC boilerplate.mk
-
-GHC_TOP := $(TOP)
-
-# Include this first, because the top-level .mk files might depend on
-# the values of $(ProjectXXX) variables.  (in fact they might/should not, 
-# but we're not brave enough to move this include later --SDM).
--include $(GHC_TOP)/mk/version.mk
-
-# We need to set TOP to be the TOP that the next level up expects!
-# The TOP variable is reset after the inclusion of the fptools
-# boilerplate, so we stash TOP away first:
-TOP:=$(GHC_TOP)/..
-
-include $(TOP)/mk/boilerplate.mk
-
-# Reset TOP
-TOP:=$(GHC_TOP)
-
-# -----------------------------------------------------------------
-# Everything after this point
-# augments or overrides previously set variables.
-# -----------------------------------------------------------------
-
--include $(GHC_TOP)/mk/config.mk
--include $(GHC_TOP)/mk/paths.mk
--include $(GHC_TOP)/mk/opts.mk
--include $(GHC_TOP)/mk/suffix.mk
diff --git a/ghc/mk/config.mk.in b/ghc/mk/config.mk.in
deleted file mode 100644
index e3060ec20c..0000000000
--- a/ghc/mk/config.mk.in
+++ /dev/null
@@ -1,67 +0,0 @@
-# -*-makefile-*-
-# @configure_input@
-
-# -----------------------------------------------------------------------------
-# GHC binary distribution configuration
-
-# These settings are used by the top-level Makefile when building
-# binary distributions.
-
-# what to include in a binary distribution
-GhcMainDir = ghc
-GhcBinDistDirs = ghc libraries hslibs
-
-ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-GhcBinDistShScripts = ghc-$(ProjectVersion) ghci-$(ProjectVersion) ghc-pkg-$(ProjectVersion) hsc2hs
-else
-GhcBinDistShScripts =
-endif
-
-GhcBinDistPrlScripts = ghcprof
-GhcBinDistLibPrlScripts = ghc-asm ghc-split
-GhcBinDistBins = hp2ps runghc
-GhcBinDistOptBins = runhaskell
-GhcBinDistLinks = ghc ghci ghc-pkg
-GhcBinDistLibSplicedFiles = package.conf
-
-# -----------------------------------------------------------------------------
-# GHC-specific configuration settings
-
-# Set to YES if $(GHC) has the readline package installed
-GhcHasReadline	= @GhcHasReadline@
-
-# GTK+
-GTK_CONFIG = @GTK_CONFIG@
-
-# -----------------------------------------------------------------------------
-
-# We can build using the stage1 compiler by setting UseStage1=YES.
-# This is useful when building up a set of .hc files for
-# bootstrapping, because we need the ghc/lib/compat library and the
-# contents of ghc/utils compiled with the stage1 compiler.
-
-ifeq "$(UseStage1)" "YES"
-HC=$(GHC_STAGE1)
-MKDEPENDHS=$(GHC_STAGE1)
-endif
-
-# Some useful GHC version predicates:
-
-ifeq "$(UseStage1)" "YES"
-ghc_ge_504 = YES
-ghc_ge_601 = YES
-ghc_ge_602 = YES
-ghc_ge_603 = YES
-else
-ifeq "$(BootingFromHc)" "YES"
-ghc_ge_504 = YES
-ghc_ge_601 = YES
-ghc_ge_602 = YES
-ghc_ge_603 = YES
-else
-ghc_ge_504 = $(shell if (test $(GhcCanonVersion) -ge 504); then echo YES; else echo NO; fi)
-ghc_ge_601 = $(shell if (test $(GhcCanonVersion) -ge 601); then echo YES; else echo NO; fi)
-ghc_ge_602 = $(shell if (test $(GhcCanonVersion) -ge 602); then echo YES; else echo NO; fi)
-ghc_ge_603 = $(shell if (test $(GhcCanonVersion) -ge 603); then echo YES; else echo NO; fi)
-endif
-endif
diff --git a/ghc/mk/paths.mk b/ghc/mk/paths.mk
deleted file mode 100644
index 2e86122f2c..0000000000
--- a/ghc/mk/paths.mk
+++ /dev/null
@@ -1,80 +0,0 @@
-# -----------------------------------------------------------------------------
-# $Id: paths.mk,v 1.44 2004/11/11 09:36:40 simonmar Exp $
-#
-# ghc project specific make variables
-#
-
-PROJECT_DIR		:= ghc
-
-#-----------------------------------------------------------------------------
-# Useful directories
-#
-#      xxx_DIR_REL      a directory relative to $(GHC_TOP)
-#      xxx_DIR          a directory (including $(GHC_TOP))
-
-GHC_INCLUDE_DIR_REL   	= includes
-GHC_COMPILER_DIR_REL  	= compiler
-GHC_RUNTIME_DIR_REL   	= rts
-GHC_UTILS_DIR_REL 	= utils
-GHC_DRIVER_DIR_REL	= driver
-GHC_LIB_DIR_REL		= lib
-
-GHC_UNLIT_DIR_REL	= $(GHC_UTILS_DIR_REL)/unlit
-GHC_HSTAGS_DIR_REL	= $(GHC_UTILS_DIR_REL)/hasktags
-GHC_TOUCHY_DIR_REL	= $(GHC_UTILS_DIR_REL)/touchy
-GHC_PKG_DIR_REL		= $(GHC_UTILS_DIR_REL)/ghc-pkg
-GHC_GENPRIMOP_DIR_REL	= $(GHC_UTILS_DIR_REL)/genprimopcode
-GHC_GENAPPLY_DIR_REL	= $(GHC_UTILS_DIR_REL)/genapply
-GHC_MANGLER_DIR_REL 	= $(GHC_DRIVER_DIR_REL)/mangler
-GHC_SPLIT_DIR_REL 	= $(GHC_DRIVER_DIR_REL)/split
-GHC_SYSMAN_DIR_REL	= $(GHC_RUNTIME_DIR_REL)/parallel
-GHC_LIB_COMPAT_DIR_REL	= $(GHC_LIB_DIR_REL)/compat
-
-GHC_INCLUDE_DIR   	= $(GHC_TOP)/$(GHC_INCLUDE_DIR_REL)
-GHC_COMPILER_DIR  	= $(GHC_TOP)/$(GHC_COMPILER_DIR_REL)
-GHC_RUNTIME_DIR   	= $(GHC_TOP)/$(GHC_RUNTIME_DIR_REL)
-GHC_UTILS_DIR	 	= $(GHC_TOP)/$(GHC_UTILS_DIR_REL)
-GHC_DRIVER_DIR		= $(GHC_TOP)/$(GHC_DRIVER_DIR_REL)
-GHC_PKG_DIR		= $(GHC_TOP)/$(GHC_PKG_DIR_REL)
-GHC_GENPRIMOP_DIR	= $(GHC_TOP)/$(GHC_GENPRIMOP_DIR_REL)
-GHC_GENAPPLY_DIR	= $(GHC_TOP)/$(GHC_GENAPPLY_DIR_REL)
-GHC_MANGLER_DIR         = $(GHC_TOP)/$(GHC_MANGLER_DIR_REL)
-GHC_SPLIT_DIR           = $(GHC_TOP)/$(GHC_SPLIT_DIR_REL)
-GHC_LIB_COMPAT_DIR      = $(GHC_TOP)/$(GHC_LIB_COMPAT_DIR_REL)
-
-# -----------------------------------------------------------------------------
-# Names of programs in the GHC tree
-#
-#      xxx_PGM	        the name of an executable, without the path
-
-GHC_UNLIT_PGM		= unlit$(exeext)
-GHC_HSTAGS_PGM		= hasktags
-GHC_TOUCHY_PGM		= touchy$(exeext)
-GHC_MANGLER_PGM		= ghc-asm
-GHC_SPLIT_PGM		= ghc-split
-GHC_SYSMAN_PGM 		= SysMan
-GHC_PKG_INPLACE_PGM	= ghc-pkg-inplace
-GHC_GENPRIMOP_PGM	= genprimopcode
-GHC_GENAPPLY_PGM	= genapply
-
-# -----------------------------------------------------------------------------
-# Auxilliary programs used by GHC
-#
-#      xxx              the pathname to an executable (some using $(TOP))
-
-ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-GHC_CP			= "xcopy /y"
-GHC_PERL		= perl
-else
-GHC_CP			= $(CP)
-GHC_PERL		= $(PERL)
-endif
-
-GHC_UNLIT		= $(GHC_UNLIT_DIR)/$(GHC_UNLIT_PGM)
-GHC_HSTAGS		= $(GHC_HSTAGS_DIR)/$(GHC_HSTAGS_PGM)
-GHC_MANGLER		= $(GHC_MANGLER_DIR)/$(GHC_MANGLER_PGM)
-GHC_SPLIT		= $(GHC_SPLIT_DIR)/$(GHC_SPLIT_PGM)
-GHC_SYSMAN 		= $(GHC_SYSMAN_DIR)/$(GHC_SYSMAN_PGM)
-GHC_PKG_INPLACE		= $(GHC_PKG_DIR)/$(GHC_PKG_INPLACE_PGM)
-GHC_GENPRIMOP		= $(GHC_GENPRIMOP_DIR)/$(GHC_GENPRIMOP_PGM)
-GHC_GENAPPLY		= $(GHC_GENAPPLY_DIR)/$(GHC_GENAPPLY_PGM)
diff --git a/ghc/mk/target.mk b/ghc/mk/target.mk
deleted file mode 100644
index 0d49585a90..0000000000
--- a/ghc/mk/target.mk
+++ /dev/null
@@ -1,14 +0,0 @@
-#
-# target.mk project stub
-#
-
-# We need to set TOP to be the TOP that the next level up expects!
-# The TOP variable is reset after the inclusion of the fptools
-# boilerplate, so we stash TOP away first:
-GHC_TOP := $(TOP)
-TOP:=$(TOP)/..
-
-include $(TOP)/mk/target.mk
-
-# Reset TOP
-TOP:=$(GHC_TOP)
diff --git a/ghc/mk/version.mk.in b/ghc/mk/version.mk.in
deleted file mode 100644
index e8e1656b7c..0000000000
--- a/ghc/mk/version.mk.in
+++ /dev/null
@@ -1,60 +0,0 @@
-#
-# Project-specific version information.
-#
-# Note:
-#   this config file is intended to centralise all
-#   project version information. To bump up the version
-#   info on your package, edit this file and recompile
-#   all the dependents. This file lives in the source tree.
-#
-# In the case of the ghc/ project, if you make changes
-# to this file, you'll *have to* to rebuild the driver
-# in your build tree(s). The ghc/driver/Makefile has got
-# a dependency that will force such rebuilding to happen,
-# but it does require you to do a 'make' in ghc/driver.
-
-#
-# Ghc project settings:
-# 
-# ProjectVersion    is treated as a *string*
-# ProjectVersionInt is treated as an *integer* (for cpp defines)
-
-# Versioning scheme: A.B.C
-#         A: major version, decimal, any number of digits
-#         B: minor version, decimal, any number of digits
-#	  C: patchlevel, one digit, omitted if zero.
-#
-# ProjectVersionInt does *not* contain the patchlevel (rationale: this
-# figure is used for conditional compilations, and library interfaces
-# etc. are not supposed to change between patchlevels).
-#
-# The ProjectVersionInt is included in interface files, and GHC
-# checks that it's reading interface generated by the same ProjectVersion
-# as itself. It does this even though interface file syntax may not 
-# change between versions.  Rationale: calling conventions or other 
-# random .o-file stuff might change even if the .hi syntax doesn't
-
-ProjectName       = @ProjectName@
-ProjectNameShort  = @ProjectNameShort@
-ProjectVersion    = @ProjectVersion@
-ProjectVersionInt = @ProjectVersionInt@
-ProjectPatchLevel = @ProjectPatchLevel@
-
-# Interface file version (hi-boot files only)
-#
-# A GHC built with HscIfaceFileVersion=n will look for 
-#	M.hi-boot-n, and only then for 
-#	M.hi-boot.
-# (It'll be happy with the latter if the former doesn't exist.)
-#
-#
-# This variable is used ONLY for hi-boot files.  Its only purpose is
-# to allow you to have a single directory with multiple .hi-boot files
-# for the same module, each corresponding to a different version of
-# GHC.
-#
-# HscIfaceFileVersion is propagated to hsc via
-# ghc/compiler/main/Config.hs, which is automatically generated by
-# ghc/compiler/Makefile.
-
-HscIfaceFileVersion=6
diff --git a/ghc/rts/Adjustor.c b/ghc/rts/Adjustor.c
deleted file mode 100644
index f3e5bfe6aa..0000000000
--- a/ghc/rts/Adjustor.c
+++ /dev/null
@@ -1,1110 +0,0 @@
-/* -----------------------------------------------------------------------------
- * Foreign export adjustor thunks
- *
- * Copyright (c) 1998.
- *
- * ---------------------------------------------------------------------------*/
-
-/* A little bit of background...
-
-An adjustor thunk is a dynamically allocated code snippet that allows
-Haskell closures to be viewed as C function pointers. 
-
-Stable pointers provide a way for the outside world to get access to,
-and evaluate, Haskell heap objects, with the RTS providing a small
-range of ops for doing so. So, assuming we've got a stable pointer in
-our hand in C, we can jump into the Haskell world and evaluate a callback
-procedure, say. This works OK in some cases where callbacks are used, but
-does require the external code to know about stable pointers and how to deal
-with them. We'd like to hide the Haskell-nature of a callback and have it
-be invoked just like any other C function pointer. 
-
-Enter adjustor thunks. An adjustor thunk is a little piece of code
-that's generated on-the-fly (one per Haskell closure being exported)
-that, when entered using some 'universal' calling convention (e.g., the
-C calling convention on platform X), pushes an implicit stable pointer
-(to the Haskell callback) before calling another (static) C function stub
-which takes care of entering the Haskell code via its stable pointer.
-
-An adjustor thunk is allocated on the C heap, and is called from within
-Haskell just before handing out the function pointer to the Haskell (IO)
-action. User code should never have to invoke it explicitly.
-
-An adjustor thunk differs from a C function pointer in one respect: when
-the code is through with it, it has to be freed in order to release Haskell
-and C resources. Failure to do so result in memory leaks on both the C and
-Haskell side.
-*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsExternal.h"
-#include "RtsUtils.h"
-#include <stdlib.h>
-
-#if defined(_WIN32)
-#include <windows.h>
-#endif
-
-#if defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)
-#include <string.h>
-#endif
-
-#ifdef LEADING_UNDERSCORE
-#define UNDERSCORE "_"
-#else 
-#define UNDERSCORE ""
-#endif
-#if defined(i386_HOST_ARCH) && !defined(darwin_HOST_OS)
-/* 
-  Now here's something obscure for you:
-
-  When generating an adjustor thunk that uses the C calling
-  convention, we have to make sure that the thunk kicks off
-  the process of jumping into Haskell with a tail jump. Why?
-  Because as a result of jumping in into Haskell we may end
-  up freeing the very adjustor thunk we came from using
-  freeHaskellFunctionPtr(). Hence, we better not return to
-  the adjustor code on our way  out, since it could by then
-  point to junk.
-  
-  The fix is readily at hand, just include the opcodes
-  for the C stack fixup code that we need to perform when
-  returning in some static piece of memory and arrange
-  to return to it before tail jumping from the adjustor thunk.
-*/
-static void  GNUC3_ATTRIBUTE(used) obscure_ccall_wrapper(void)
-{
-  __asm__ (
-     ".globl " UNDERSCORE "obscure_ccall_ret_code\n"
-     UNDERSCORE "obscure_ccall_ret_code:\n\t"
-     "addl $0x4, %esp\n\t"
-     "ret"
-   );
-}
-extern void obscure_ccall_ret_code(void);
-
-#if defined(openbsd_HOST_OS)
-static unsigned char *obscure_ccall_ret_code_dyn;
-#endif
-
-#endif
-
-#if defined(x86_64_HOST_ARCH)
-static void GNUC3_ATTRIBUTE(used) obscure_ccall_wrapper(void)
-{
-  __asm__ (
-   ".globl " UNDERSCORE "obscure_ccall_ret_code\n"
-   UNDERSCORE "obscure_ccall_ret_code:\n\t"
-   "addq $0x8, %rsp\n\t"
-   "ret"
-  );
-}
-extern void obscure_ccall_ret_code(void);
-#endif
-
-#if defined(alpha_HOST_ARCH)
-/* To get the definition of PAL_imb: */
-# if defined(linux_HOST_OS)
-#  include <asm/pal.h>
-# else
-#  include <machine/pal.h>
-# endif
-#endif
-
-#if defined(ia64_HOST_ARCH)
-#include "Storage.h"
-
-/* Layout of a function descriptor */
-typedef struct _IA64FunDesc {
-    StgWord64 ip;
-    StgWord64 gp;
-} IA64FunDesc;
-
-static void *
-stgAllocStable(size_t size_in_bytes, StgStablePtr *stable)
-{
-  StgArrWords* arr;
-  nat data_size_in_words, total_size_in_words;
-  
-  /* round up to a whole number of words */
-  data_size_in_words  = (size_in_bytes + sizeof(W_) + 1) / sizeof(W_);
-  total_size_in_words = sizeofW(StgArrWords) + data_size_in_words;
-  
-  /* allocate and fill it in */
-  arr = (StgArrWords *)allocate(total_size_in_words);
-  SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words);
- 
-  /* obtain a stable ptr */
-  *stable = getStablePtr((StgPtr)arr);
-
-  /* and return a ptr to the goods inside the array */
-  return(&(arr->payload));
-}
-#endif
-
-#if defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)
-__asm__("obscure_ccall_ret_code:\n\t"
-        "lwz 1,0(1)\n\t"
-        "lwz 0,4(1)\n\t"
-        "mtlr 0\n\t"
-        "blr");
-extern void obscure_ccall_ret_code(void);
-#endif
-
-#if defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH)
-#if !(defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS))
-
-/* !!! !!! WARNING: !!! !!!
- * This structure is accessed from AdjustorAsm.s
- * Any changes here have to be mirrored in the offsets there.
- */
-
-typedef struct AdjustorStub {
-#if defined(powerpc_HOST_ARCH) && defined(darwin_HOST_OS)
-    unsigned        lis;
-    unsigned        ori;
-    unsigned        lwz;
-    unsigned        mtctr;
-    unsigned        bctr;
-    StgFunPtr       code;
-#elif defined(powerpc64_HOST_ARCH) && defined(darwin_HOST_OS)
-        /* powerpc64-darwin: just guessing that it won't use fundescs. */
-    unsigned        lis;
-    unsigned        ori;
-    unsigned        rldimi;
-    unsigned        oris;
-    unsigned        ori2;
-    unsigned        lwz;
-    unsigned        mtctr;
-    unsigned        bctr;
-    StgFunPtr       code;
-#else
-        /* fundesc-based ABIs */
-#define         FUNDESCS
-    StgFunPtr       code;
-    struct AdjustorStub
-                    *toc;
-    void            *env;
-#endif
-    StgStablePtr    hptr;
-    StgFunPtr       wptr;
-    StgInt          negative_framesize;
-    StgInt          extrawords_plus_one;
-} AdjustorStub;
-
-#endif
-#endif
-
-#if defined(i386_HOST_ARCH) && defined(darwin_HOST_OS)
-
-/* !!! !!! WARNING: !!! !!!
- * This structure is accessed from AdjustorAsm.s
- * Any changes here have to be mirrored in the offsets there.
- */
-
-typedef struct AdjustorStub {
-    unsigned char   call[8];
-    StgStablePtr    hptr;
-    StgFunPtr       wptr;
-    StgInt          frame_size;
-    StgInt          argument_size;
-} AdjustorStub;
-#endif
-
-#if defined(darwin_HOST_OS) || defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH)
-static int totalArgumentSize(char *typeString)
-{
-    int sz = 0;
-    while(*typeString)
-    {
-        char t = *typeString++;
-
-        switch(t)
-        {
-                // on 32-bit platforms, Double and Int64 occupy two words.
-            case 'd':
-            case 'l':
-                if(sizeof(void*) == 4)
-                {
-                    sz += 2;
-                    break;
-                }
-                // everything else is one word.
-            default:
-                sz += 1;
-        }
-    }
-    return sz;
-}
-#endif
-
-void*
-createAdjustor(int cconv, StgStablePtr hptr,
-	       StgFunPtr wptr,
-	       char *typeString
-#if !defined(powerpc_HOST_ARCH) && !defined(powerpc64_HOST_ARCH) && !defined(x86_64_HOST_ARCH)
-	          STG_UNUSED
-#endif
-              )
-{
-  void *adjustor = NULL;
-
-  switch (cconv)
-  {
-  case 0: /* _stdcall */
-#if defined(i386_HOST_ARCH) && !defined(darwin_HOST_OS)
-    /* Magic constant computed by inspecting the code length of
-       the following assembly language snippet
-       (offset and machine code prefixed):
-
-     <0>:	58	          popl   %eax              # temp. remove ret addr..
-     <1>:	68 fd fc fe fa    pushl  0xfafefcfd  	   # constant is large enough to
-        			   	           	   # hold a StgStablePtr
-     <6>:	50	          pushl  %eax		   # put back ret. addr
-     <7>:	b8 fa ef ff 00	  movl   $0x00ffeffa, %eax # load up wptr
-     <c>: 	ff e0             jmp    %eax        	   # and jump to it.
-		# the callee cleans up the stack
-    */
-    adjustor = stgMallocBytesRWX(14);
-    {
-	unsigned char *const adj_code = (unsigned char *)adjustor;
-	adj_code[0x00] = (unsigned char)0x58;  /* popl %eax  */
-
-	adj_code[0x01] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
-	*((StgStablePtr*)(adj_code + 0x02)) = (StgStablePtr)hptr;
-
-	adj_code[0x06] = (unsigned char)0x50; /* pushl %eax */
-
-	adj_code[0x07] = (unsigned char)0xb8; /* movl  $wptr, %eax */
-	*((StgFunPtr*)(adj_code + 0x08)) = (StgFunPtr)wptr;
-
-	adj_code[0x0c] = (unsigned char)0xff; /* jmp %eax */
-	adj_code[0x0d] = (unsigned char)0xe0;
-    }
-#endif
-    break;
-
-  case 1: /* _ccall */
-#if defined(i386_HOST_ARCH) && !defined(darwin_HOST_OS)
-  /* Magic constant computed by inspecting the code length of
-     the following assembly language snippet
-     (offset and machine code prefixed):
-
-  <00>: 68 ef be ad de     pushl  $0xdeadbeef  	   # constant is large enough to
-        			   	           # hold a StgStablePtr
-  <05>:	b8 fa ef ff 00	   movl   $0x00ffeffa, %eax # load up wptr
-  <0a>: 68 ef be ad de     pushl  $obscure_ccall_ret_code # push the return address
-  <0f>: ff e0              jmp    *%eax            # jump to wptr
-
-    The ccall'ing version is a tad different, passing in the return
-    address of the caller to the auto-generated C stub (which enters
-    via the stable pointer.) (The auto-generated C stub is in on this
-    game, don't worry :-)
-
-    See the comment next to obscure_ccall_ret_code why we need to
-    perform a tail jump instead of a call, followed by some C stack
-    fixup.
-
-    Note: The adjustor makes the assumption that any return value
-    coming back from the C stub is not stored on the stack.
-    That's (thankfully) the case here with the restricted set of 
-    return types that we support.
-  */
-    adjustor = stgMallocBytesRWX(17);
-    {
-	unsigned char *const adj_code = (unsigned char *)adjustor;
-
-	adj_code[0x00] = (unsigned char)0x68;  /* pushl hptr (which is a dword immediate ) */
-	*((StgStablePtr*)(adj_code+0x01)) = (StgStablePtr)hptr;
-
-	adj_code[0x05] = (unsigned char)0xb8;  /* movl  $wptr, %eax */
-	*((StgFunPtr*)(adj_code + 0x06)) = (StgFunPtr)wptr;
-
-	adj_code[0x0a] = (unsigned char)0x68;  /* pushl obscure_ccall_ret_code */
-	*((StgFunPtr*)(adj_code + 0x0b)) = 
-#if !defined(openbsd_HOST_OS)
-			(StgFunPtr)obscure_ccall_ret_code;
-#else
-			(StgFunPtr)obscure_ccall_ret_code_dyn;
-#endif
-
-	adj_code[0x0f] = (unsigned char)0xff; /* jmp *%eax */
-	adj_code[0x10] = (unsigned char)0xe0; 
-    }
-#elif defined(i386_HOST_ARCH) && defined(darwin_HOST_OS)
-    {
-        /*
-          What's special about Darwin/Mac OS X on i386?
-          It wants the stack to stay 16-byte aligned.
-          
-          We offload most of the work to AdjustorAsm.S.
-        */
-        AdjustorStub *adjustorStub = stgMallocBytesRWX(sizeof(AdjustorStub));
-        adjustor = adjustorStub;
-
-        extern void adjustorCode(void);
-        int sz = totalArgumentSize(typeString);
-        
-        adjustorStub->call[0] = 0xe8;
-        *(long*)&adjustorStub->call[1] = ((char*)&adjustorCode) - ((char*)adjustorStub + 5);
-        adjustorStub->hptr = hptr;
-        adjustorStub->wptr = wptr;
-        
-            // The adjustor puts the following things on the stack:
-            // 1.) %ebp link
-            // 2.) padding and (a copy of) the arguments
-            // 3.) a dummy argument
-            // 4.) hptr
-            // 5.) return address (for returning to the adjustor)
-            // All these have to add up to a multiple of 16. 
-
-            // first, include everything in frame_size
-        adjustorStub->frame_size = sz * 4 + 16;
-            // align to 16 bytes
-        adjustorStub->frame_size = (adjustorStub->frame_size + 15) & ~15;
-            // only count 2.) and 3.) as part of frame_size
-        adjustorStub->frame_size -= 12; 
-        adjustorStub->argument_size = sz;
-    }
-    
-#elif defined(x86_64_HOST_ARCH)
-    /*
-      stack at call:
-               argn
-	       ...
-	       arg7
-               return address
-	       %rdi,%rsi,%rdx,%rcx,%r8,%r9 = arg0..arg6
-
-      if there are <6 integer args, then we can just push the
-      StablePtr into %edi and shuffle the other args up.
-
-      If there are >=6 integer args, then we have to flush one arg
-      to the stack, and arrange to adjust the stack ptr on return.
-      The stack will be rearranged to this:
-
-             argn
-	     ...
-	     arg7
-	     return address  *** <-- dummy arg in stub fn.
-	     arg6
-	     obscure_ccall_ret_code
-
-      This unfortunately means that the type of the stub function
-      must have a dummy argument for the original return address
-      pointer inserted just after the 6th integer argument.
-
-      Code for the simple case:
-
-   0:   4d 89 c1                mov    %r8,%r9
-   3:   49 89 c8                mov    %rcx,%r8
-   6:   48 89 d1                mov    %rdx,%rcx
-   9:   48 89 f2                mov    %rsi,%rdx
-   c:   48 89 fe                mov    %rdi,%rsi
-   f:   48 8b 3d 0a 00 00 00    mov    10(%rip),%rdi
-  16:   ff 25 0c 00 00 00       jmpq   *12(%rip)
-  ... 
-  20: .quad 0  # aligned on 8-byte boundary
-  28: .quad 0  # aligned on 8-byte boundary
-
-
-  And the version for >=6 integer arguments:
-
-   0:   41 51                   push   %r9
-   2:   ff 35 20 00 00 00       pushq  32(%rip)        # 28 <ccall_adjustor+0x28>
-   8:   4d 89 c1                mov    %r8,%r9
-   b:   49 89 c8                mov    %rcx,%r8
-   e:   48 89 d1                mov    %rdx,%rcx
-  11:   48 89 f2                mov    %rsi,%rdx
-  14:   48 89 fe                mov    %rdi,%rsi
-  17:   48 8b 3d 12 00 00 00    mov    18(%rip),%rdi        # 30 <ccall_adjustor+0x30>
-  1e:   ff 25 14 00 00 00       jmpq   *20(%rip)        # 38 <ccall_adjustor+0x38>
-  ...
-  28: .quad 0  # aligned on 8-byte boundary
-  30: .quad 0  # aligned on 8-byte boundary
-  38: .quad 0  # aligned on 8-byte boundary
-    */
-
-    /* we assume the small code model (gcc -mcmmodel=small) where
-     * all symbols are <2^32, so hence wptr should fit into 32 bits.
-     */
-    ASSERT(((long)wptr >> 32) == 0);
-
-    {  
-	int i = 0;
-	char *c;
-
-	// determine whether we have 6 or more integer arguments,
-	// and therefore need to flush one to the stack.
-	for (c = typeString; *c != '\0'; c++) {
-	    if (*c == 'i' || *c == 'l') i++;
-	    if (i == 6) break;
-	}
-
-	if (i < 6) {
-	    adjustor = stgMallocBytesRWX(0x30);
-
-	    *(StgInt32 *)adjustor        = 0x49c1894d;
-	    *(StgInt32 *)(adjustor+0x4)  = 0x8948c889;
-	    *(StgInt32 *)(adjustor+0x8)  = 0xf28948d1;
-	    *(StgInt32 *)(adjustor+0xc)  = 0x48fe8948;
-	    *(StgInt32 *)(adjustor+0x10) = 0x000a3d8b;
-	    *(StgInt32 *)(adjustor+0x14) = 0x25ff0000;
-	    *(StgInt32 *)(adjustor+0x18) = 0x0000000c;
-	    *(StgInt64 *)(adjustor+0x20) = (StgInt64)hptr;
-	    *(StgInt64 *)(adjustor+0x28) = (StgInt64)wptr;
-	}
-	else
-	{
-	    adjustor = stgMallocBytesRWX(0x40);
-
-	    *(StgInt32 *)adjustor        = 0x35ff5141;
-	    *(StgInt32 *)(adjustor+0x4)  = 0x00000020;
-	    *(StgInt32 *)(adjustor+0x8)  = 0x49c1894d;
-	    *(StgInt32 *)(adjustor+0xc)  = 0x8948c889;
-	    *(StgInt32 *)(adjustor+0x10) = 0xf28948d1;
-	    *(StgInt32 *)(adjustor+0x14) = 0x48fe8948;
-	    *(StgInt32 *)(adjustor+0x18) = 0x00123d8b;
-	    *(StgInt32 *)(adjustor+0x1c) = 0x25ff0000;
-	    *(StgInt32 *)(adjustor+0x20) = 0x00000014;
-	    
-	    *(StgInt64 *)(adjustor+0x28) = (StgInt64)obscure_ccall_ret_code;
-	    *(StgInt64 *)(adjustor+0x30) = (StgInt64)hptr;
-	    *(StgInt64 *)(adjustor+0x38) = (StgInt64)wptr;
-	}
-    }
-#elif defined(sparc_HOST_ARCH)
-  /* Magic constant computed by inspecting the code length of the following
-     assembly language snippet (offset and machine code prefixed):
-
-     <00>: 9C23A008   sub   %sp, 8, %sp         ! make room for %o4/%o5 in caller's frame
-     <04>: DA23A060   st    %o5, [%sp + 96]     ! shift registers by 2 positions
-     <08>: D823A05C   st    %o4, [%sp + 92]
-     <0C>: 9A10000B   mov   %o3, %o5
-     <10>: 9810000A   mov   %o2, %o4
-     <14>: 96100009   mov   %o1, %o3
-     <18>: 94100008   mov   %o0, %o2
-     <1C>: 13000000   sethi %hi(wptr), %o1      ! load up wptr (1 of 2)
-     <20>: 11000000   sethi %hi(hptr), %o0      ! load up hptr (1 of 2)
-     <24>: 81C26000   jmp   %o1 + %lo(wptr)     ! jump to wptr (load 2 of 2)
-     <28>: 90122000   or    %o0, %lo(hptr), %o0 ! load up hptr (2 of 2, delay slot)
-     <2C>  00000000                             ! place for getting hptr back easily
-
-     ccall'ing on SPARC is easy, because we are quite lucky to push a
-     multiple of 8 bytes (1 word hptr + 1 word dummy arg) in front of the
-     existing arguments (note that %sp must stay double-word aligned at
-     all times, see ABI spec at http://www.sparc.org/standards/psABI3rd.pdf).
-     To do this, we extend the *caller's* stack frame by 2 words and shift
-     the output registers used for argument passing (%o0 - %o5, we are a *leaf*
-     procedure because of the tail-jump) by 2 positions. This makes room in
-     %o0 and %o1 for the additinal arguments, namely  hptr and a dummy (used
-     for destination addr of jump on SPARC, return address on x86, ...). This
-     shouldn't cause any problems for a C-like caller: alloca is implemented
-     similarly, and local variables should be accessed via %fp, not %sp. In a
-     nutshell: This should work! (Famous last words! :-)
-  */
-    adjustor = stgMallocBytesRWX(4*(11+1));
-    {
-        unsigned long *const adj_code = (unsigned long *)adjustor;
-
-        adj_code[ 0]  = 0x9C23A008UL;   /* sub   %sp, 8, %sp         */
-        adj_code[ 1]  = 0xDA23A060UL;   /* st    %o5, [%sp + 96]     */
-        adj_code[ 2]  = 0xD823A05CUL;   /* st    %o4, [%sp + 92]     */
-        adj_code[ 3]  = 0x9A10000BUL;   /* mov   %o3, %o5            */
-        adj_code[ 4]  = 0x9810000AUL;   /* mov   %o2, %o4            */
-        adj_code[ 5]  = 0x96100009UL;   /* mov   %o1, %o3            */
-        adj_code[ 6]  = 0x94100008UL;   /* mov   %o0, %o2            */
-        adj_code[ 7]  = 0x13000000UL;   /* sethi %hi(wptr), %o1      */
-        adj_code[ 7] |= ((unsigned long)wptr) >> 10;
-        adj_code[ 8]  = 0x11000000UL;   /* sethi %hi(hptr), %o0      */
-        adj_code[ 8] |= ((unsigned long)hptr) >> 10;
-        adj_code[ 9]  = 0x81C26000UL;   /* jmp   %o1 + %lo(wptr)     */
-        adj_code[ 9] |= ((unsigned long)wptr) & 0x000003FFUL;
-        adj_code[10]  = 0x90122000UL;   /* or    %o0, %lo(hptr), %o0 */
-        adj_code[10] |= ((unsigned long)hptr) & 0x000003FFUL;
-
-        adj_code[11]  = (unsigned long)hptr;
-
-        /* flush cache */
-        asm("flush %0" : : "r" (adj_code     ));
-        asm("flush %0" : : "r" (adj_code +  2));
-        asm("flush %0" : : "r" (adj_code +  4));
-        asm("flush %0" : : "r" (adj_code +  6));
-        asm("flush %0" : : "r" (adj_code + 10));
-
-        /* max. 5 instructions latency, and we need at >= 1 for returning */
-        asm("nop");
-        asm("nop");
-        asm("nop");
-        asm("nop");
-    }
-#elif defined(alpha_HOST_ARCH)
-  /* Magic constant computed by inspecting the code length of
-     the following assembly language snippet
-     (offset and machine code prefixed; note that the machine code
-     shown is longwords stored in little-endian order):
-
-  <00>: 46520414	mov	a2, a4
-  <04>: 46100412	mov	a0, a2
-  <08>: a61b0020	ldq     a0, 0x20(pv)	# load up hptr
-  <0c>: 46730415	mov	a3, a5
-  <10>: a77b0028	ldq     pv, 0x28(pv)	# load up wptr
-  <14>: 46310413	mov	a1, a3
-  <18>: 6bfb----	jmp     (pv), <hint>	# jump to wptr (with hint)
-  <1c>: 00000000				# padding for alignment
-  <20>: [8 bytes for hptr quadword]
-  <28>: [8 bytes for wptr quadword]
-
-     The "computed" jump at <08> above is really a jump to a fixed
-     location.  Accordingly, we place an always-correct hint in the
-     jump instruction, namely the address offset from <0c> to wptr,
-     divided by 4, taking the lowest 14 bits.
-
-     We only support passing 4 or fewer argument words, for the same
-     reason described under sparc_HOST_ARCH above by JRS, 21 Aug 01.
-     On the Alpha the first 6 integer arguments are in a0 through a5,
-     and the rest on the stack.  Hence we want to shuffle the original
-     caller's arguments by two.
-
-     On the Alpha the calling convention is so complex and dependent
-     on the callee's signature -- for example, the stack pointer has
-     to be a multiple of 16 -- that it seems impossible to me [ccshan]
-     to handle the general case correctly without changing how the
-     adjustor is called from C.  For now, our solution of shuffling
-     registers only and ignoring the stack only works if the original
-     caller passed 4 or fewer argument words.
-
-TODO: Depending on how much allocation overhead stgMallocBytes uses for
-      header information (more precisely, if the overhead is no more than
-      4 bytes), we should move the first three instructions above down by
-      4 bytes (getting rid of the nop), hence saving memory. [ccshan]
-  */
-    ASSERT(((StgWord64)wptr & 3) == 0);
-    adjustor = stgMallocBytesRWX(48);
-    {
-	StgWord64 *const code = (StgWord64 *)adjustor;
-
-	code[0] = 0x4610041246520414L;
-	code[1] = 0x46730415a61b0020L;
-	code[2] = 0x46310413a77b0028L;
-	code[3] = 0x000000006bfb0000L
-		| (((StgWord32*)(wptr) - (StgWord32*)(code) - 3) & 0x3fff);
-
-	code[4] = (StgWord64)hptr;
-	code[5] = (StgWord64)wptr;
-
-	/* Ensure that instruction cache is consistent with our new code */
-	__asm__ volatile("call_pal %0" : : "i" (PAL_imb));
-    }
-#elif defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)
-
-#define OP_LO(op,lo)  ((((unsigned)(op)) << 16) | (((unsigned)(lo)) & 0xFFFF))
-#define OP_HI(op,hi)  ((((unsigned)(op)) << 16) | (((unsigned)(hi)) >> 16))
-    {
-        /* The PowerPC Linux (32-bit) calling convention is annoyingly complex.
-           We need to calculate all the details of the stack frame layout,
-           taking into account the types of all the arguments, and then
-           generate code on the fly. */
-    
-        int src_gpr = 3, dst_gpr = 5;
-        int fpr = 3;
-        int src_offset = 0, dst_offset = 0;
-        int n = strlen(typeString),i;
-        int src_locs[n], dst_locs[n];
-        int frameSize;
-        unsigned *code;
-      
-            /* Step 1:
-               Calculate where the arguments should go.
-               src_locs[] will contain the locations of the arguments in the
-               original stack frame passed to the adjustor.
-               dst_locs[] will contain the locations of the arguments after the
-               adjustor runs, on entry to the wrapper proc pointed to by wptr.
-
-               This algorithm is based on the one described on page 3-19 of the
-               System V ABI PowerPC Processor Supplement.
-            */
-        for(i=0;typeString[i];i++)
-        {
-            char t = typeString[i];
-            if((t == 'f' || t == 'd') && fpr <= 8)
-                src_locs[i] = dst_locs[i] = -32-(fpr++);
-            else
-            {
-                if(t == 'l' && src_gpr <= 9)
-                {
-                    if((src_gpr & 1) == 0)
-                        src_gpr++;
-                    src_locs[i] = -src_gpr;
-                    src_gpr += 2;
-                }
-                else if(t == 'i' && src_gpr <= 10)
-                {
-                    src_locs[i] = -(src_gpr++);
-                }
-                else
-                {
-                    if(t == 'l' || t == 'd')
-                    {
-                        if(src_offset % 8)
-                            src_offset += 4;
-                    }
-                    src_locs[i] = src_offset;
-                    src_offset += (t == 'l' || t == 'd') ? 8 : 4;
-                }
-
-                if(t == 'l' && dst_gpr <= 9)
-                {
-                    if((dst_gpr & 1) == 0)
-                        dst_gpr++;
-                    dst_locs[i] = -dst_gpr;
-                    dst_gpr += 2;
-                }
-                else if(t == 'i' && dst_gpr <= 10)
-                {
-                    dst_locs[i] = -(dst_gpr++);
-                }
-                else
-                {
-                    if(t == 'l' || t == 'd')
-                    {
-                        if(dst_offset % 8)
-                            dst_offset += 4;
-                    }
-                    dst_locs[i] = dst_offset;
-                    dst_offset += (t == 'l' || t == 'd') ? 8 : 4;
-                }
-            }
-        }
-
-        frameSize = dst_offset + 8;
-        frameSize = (frameSize+15) & ~0xF;
-
-            /* Step 2:
-               Build the adjustor.
-            */
-                    // allocate space for at most 4 insns per parameter
-                    // plus 14 more instructions.
-        adjustor = stgMallocBytesRWX(4 * (4*n + 14));
-        code = (unsigned*)adjustor;
-        
-        *code++ = 0x48000008; // b *+8
-            // * Put the hptr in a place where freeHaskellFunctionPtr
-            //   can get at it.
-        *code++ = (unsigned) hptr;
-
-            // * save the link register
-        *code++ = 0x7c0802a6; // mflr r0;
-        *code++ = 0x90010004; // stw r0, 4(r1);
-            // * and build a new stack frame
-        *code++ = OP_LO(0x9421, -frameSize); // stwu r1, -frameSize(r1)
-
-            // * now generate instructions to copy arguments
-            //   from the old stack frame into the new stack frame.
-        for(i=n-1;i>=0;i--)
-        {
-            if(src_locs[i] < -32)
-                ASSERT(dst_locs[i] == src_locs[i]);
-            else if(src_locs[i] < 0)
-            {
-                // source in GPR.
-                ASSERT(typeString[i] != 'f' && typeString[i] != 'd');
-                if(dst_locs[i] < 0)
-                {
-                    ASSERT(dst_locs[i] > -32);
-                        // dst is in GPR, too.
-
-                    if(typeString[i] == 'l')
-                    {
-                            // mr dst+1, src+1
-                        *code++ = 0x7c000378
-                                | ((-dst_locs[i]+1) << 16)
-                                | ((-src_locs[i]+1) << 11)
-                                | ((-src_locs[i]+1) << 21);
-                    }
-                    // mr dst, src
-                    *code++ = 0x7c000378
-                            | ((-dst_locs[i]) << 16)
-                            | ((-src_locs[i]) << 11)
-                            | ((-src_locs[i]) << 21);
-                }
-                else
-                {
-                    if(typeString[i] == 'l')
-                    {
-                            // stw src+1, dst_offset+4(r1)
-                        *code++ = 0x90010000
-                                | ((-src_locs[i]+1) << 21)
-                                | (dst_locs[i] + 4);
-                    }
-                    
-                        // stw src, dst_offset(r1)
-                    *code++ = 0x90010000
-                            | ((-src_locs[i]) << 21)
-                            | (dst_locs[i] + 8);
-                }
-            }
-            else
-            {
-                ASSERT(dst_locs[i] >= 0);
-                ASSERT(typeString[i] != 'f' && typeString[i] != 'd');
-
-                if(typeString[i] == 'l')
-                {
-                    // lwz r0, src_offset(r1)
-                        *code++ = 0x80010000
-                                | (src_locs[i] + frameSize + 8 + 4);
-                    // stw r0, dst_offset(r1)
-                        *code++ = 0x90010000
-                                | (dst_locs[i] + 8 + 4);
-                    }
-                // lwz r0, src_offset(r1)
-                    *code++ = 0x80010000
-                            | (src_locs[i] + frameSize + 8);
-                // stw r0, dst_offset(r1)
-                    *code++ = 0x90010000
-                            | (dst_locs[i] + 8);
-           }
-        }
-
-            // * hptr will be the new first argument.
-            // lis r3, hi(hptr)
-        *code++ = OP_HI(0x3c60, hptr);
-            // ori r3,r3,lo(hptr)
-        *code++ = OP_LO(0x6063, hptr);
-
-            // * we need to return to a piece of code
-            //   which will tear down the stack frame.
-            // lis r11,hi(obscure_ccall_ret_code)
-        *code++ = OP_HI(0x3d60, obscure_ccall_ret_code);
-            // ori r11,r11,lo(obscure_ccall_ret_code)
-        *code++ = OP_LO(0x616b, obscure_ccall_ret_code);
-            // mtlr r11
-        *code++ = 0x7d6803a6;
-
-            // * jump to wptr
-            // lis r11,hi(wptr)
-        *code++ = OP_HI(0x3d60, wptr);
-            // ori r11,r11,lo(wptr)
-        *code++ = OP_LO(0x616b, wptr);
-            // mtctr r11
-        *code++ = 0x7d6903a6;
-            // bctr
-        *code++ = 0x4e800420;
-
-        // Flush the Instruction cache:
-        {
-            unsigned *p = adjustor;
-            while(p < code)
-            {
-                __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
-                                 : : "r" (p));
-                p++;
-            }
-            __asm__ volatile ("sync\n\tisync");
-        }
-    }
-
-#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH)
-        
-#define OP_LO(op,lo)  ((((unsigned)(op)) << 16) | (((unsigned)(lo)) & 0xFFFF))
-#define OP_HI(op,hi)  ((((unsigned)(op)) << 16) | (((unsigned)(hi)) >> 16))
-    {
-        /* The following code applies to all PowerPC and PowerPC64 platforms
-           whose stack layout is based on the AIX ABI.
-
-           Besides (obviously) AIX, this includes
-            Mac OS 9 and BeOS/PPC (may they rest in peace),
-                which use the 32-bit AIX ABI
-            powerpc64-linux,
-                which uses the 64-bit AIX ABI
-            and Darwin (Mac OS X),
-                which uses the same stack layout as AIX,
-                but no function descriptors.
-
-           The actual stack-frame shuffling is implemented out-of-line
-           in the function adjustorCode, in AdjustorAsm.S.
-           Here, we set up an AdjustorStub structure, which
-           is a function descriptor (on platforms that have function
-           descriptors) or a short piece of stub code (on Darwin) to call
-           adjustorCode with a pointer to the AdjustorStub struct loaded
-           into register r2.
-
-           One nice thing about this is that there is _no_ code generated at
-           runtime on the platforms that have function descriptors.
-        */
-        AdjustorStub *adjustorStub;
-        int sz = 0, extra_sz, total_sz;
-
-            // from AdjustorAsm.s
-            // not declared as a function so that AIX-style
-            // fundescs can never get in the way.
-        extern void *adjustorCode;
-        
-#ifdef FUNDESCS
-        adjustorStub = stgMallocBytes(sizeof(AdjustorStub), "createAdjustor");
-#else
-        adjustorStub = stgMallocBytesRWX(sizeof(AdjustorStub));
-#endif
-        adjustor = adjustorStub;
-            
-        adjustorStub->code = (void*) &adjustorCode;
-
-#ifdef FUNDESCS
-            // function descriptors are a cool idea.
-            // We don't need to generate any code at runtime.
-        adjustorStub->toc = adjustorStub;
-#else
-
-            // no function descriptors :-(
-            // We need to do things "by hand".
-#if defined(powerpc_HOST_ARCH)
-            // lis  r2, hi(adjustorStub)
-        adjustorStub->lis = OP_HI(0x3c40, adjustorStub);
-            // ori  r2, r2, lo(adjustorStub)
-        adjustorStub->ori = OP_LO(0x6042, adjustorStub);
-            // lwz r0, code(r2)
-        adjustorStub->lwz = OP_LO(0x8002, (char*)(&adjustorStub->code)
-                                        - (char*)adjustorStub);
-            // mtctr r0
-        adjustorStub->mtctr = 0x7c0903a6;
-            // bctr
-        adjustorStub->bctr = 0x4e800420;
-#else
-        barf("adjustor creation not supported on this platform");
-#endif
-
-        // Flush the Instruction cache:
-        {
-            int n = sizeof(AdjustorStub)/sizeof(unsigned);
-            unsigned *p = (unsigned*)adjustor;
-            while(n--)
-            {
-                __asm__ volatile ("dcbf 0,%0\n\tsync\n\ticbi 0,%0"
-                                    : : "r" (p));
-                p++;
-            }
-            __asm__ volatile ("sync\n\tisync");
-        }
-#endif
-
-            // Calculate the size of the stack frame, in words.
-        sz = totalArgumentSize(typeString);
-        
-            // The first eight words of the parameter area
-            // are just "backing store" for the parameters passed in
-            // the GPRs. extra_sz is the number of words beyond those first
-            // 8 words.
-        extra_sz = sz - 8;
-        if(extra_sz < 0)
-            extra_sz = 0;
-
-            // Calculate the total size of the stack frame.
-        total_sz = (6 /* linkage area */
-                  + 8 /* minimum parameter area */
-                  + 2 /* two extra arguments */
-                  + extra_sz)*sizeof(StgWord);
-       
-            // align to 16 bytes.
-            // AIX only requires 8 bytes, but who cares?
-        total_sz = (total_sz+15) & ~0xF;
-       
-            // Fill in the information that adjustorCode in AdjustorAsm.S
-            // will use to create a new stack frame with the additional args.
-        adjustorStub->hptr = hptr;
-        adjustorStub->wptr = wptr;
-        adjustorStub->negative_framesize = -total_sz;
-        adjustorStub->extrawords_plus_one = extra_sz + 1;
-    }
-
-#elif defined(ia64_HOST_ARCH)
-/*
-    Up to 8 inputs are passed in registers.  We flush the last two inputs to
-    the stack, initially into the 16-byte scratch region left by the caller.
-    We then shuffle the others along by 4 (taking 2 registers for ourselves
-    to save return address and previous function state - we need to come back
-    here on the way out to restore the stack, so this is a real function
-    rather than just a trampoline).
-    
-    The function descriptor we create contains the gp of the target function
-    so gp is already loaded correctly.
-
-	[MLX]       alloc r16=ar.pfs,10,2,0
-		    movl r17=wptr
-	[MII]       st8.spill [r12]=r38,8		// spill in6 (out4)
-		    mov r41=r37				// out7 = in5 (out3)
-		    mov r40=r36;;			// out6 = in4 (out2)
-	[MII]       st8.spill [r12]=r39			// spill in7 (out5)
-		    mov.sptk b6=r17,50
-		    mov r38=r34;;			// out4 = in2 (out0)
-	[MII]       mov r39=r35				// out5 = in3 (out1)
-		    mov r37=r33				// out3 = in1 (loc1)
-		    mov r36=r32				// out2 = in0 (loc0)
-	[MLX]       adds r12=-24,r12			// update sp
-		    movl r34=hptr;;			// out0 = hptr
-	[MIB]       mov r33=r16				// loc1 = ar.pfs
-		    mov r32=b0				// loc0 = retaddr
-		    br.call.sptk.many b0=b6;;
-
-	[MII]       adds r12=-16,r12
-		    mov b0=r32
-		    mov.i ar.pfs=r33
-	[MFB]       nop.m 0x0
-		    nop.f 0x0
-		    br.ret.sptk.many b0;;
-*/
-
-/* These macros distribute a long constant into the two words of an MLX bundle */
-#define BITS(val,start,count)	(((val) >> (start)) & ((1 << (count))-1))
-#define MOVL_LOWORD(val)	(BITS(val,22,18) << 46)
-#define MOVL_HIWORD(val)	(BITS(val,40,23) | (BITS(val,0,7) << 36) | (BITS(val,7,9) << 50) \
-				| (BITS(val,16,5) << 55) | (BITS(val,21,1) << 44) | BITS(val,63,1) << 59)
-
-    {
-	StgStablePtr stable;
-	IA64FunDesc *wdesc = (IA64FunDesc *)wptr;
-	StgWord64 wcode = wdesc->ip;
-	IA64FunDesc *fdesc;
-	StgWord64 *code;
-
-	/* we allocate on the Haskell heap since malloc'd memory isn't executable - argh */
-	adjustor = stgAllocStable(sizeof(IA64FunDesc)+18*8, &stable);
-
-	fdesc = (IA64FunDesc *)adjustor;
-	code = (StgWord64 *)(fdesc + 1);
-	fdesc->ip = (StgWord64)code;
-	fdesc->gp = wdesc->gp;
-
-	code[0]  = 0x0000058004288004 | MOVL_LOWORD(wcode);
-	code[1]  = 0x6000000220000000 | MOVL_HIWORD(wcode);
-	code[2]  = 0x029015d818984001;
-	code[3]  = 0x8401200500420094;
-	code[4]  = 0x886011d8189c0001;
-	code[5]  = 0x84011004c00380c0;
-	code[6]  = 0x0250210046013800;
-	code[7]  = 0x8401000480420084;
-	code[8]  = 0x0000233f19a06005 | MOVL_LOWORD((StgWord64)hptr);
-	code[9]  = 0x6000000440000000 | MOVL_HIWORD((StgWord64)hptr);
-	code[10] = 0x0200210020010811;
-	code[11] = 0x1080006800006200;
-	code[12] = 0x0000210018406000;
-	code[13] = 0x00aa021000038005;
-	code[14] = 0x000000010000001d;
-	code[15] = 0x0084000880000200;
-
-	/* save stable pointers in convenient form */
-	code[16] = (StgWord64)hptr;
-	code[17] = (StgWord64)stable;
-    }
-#else
-    barf("adjustor creation not supported on this platform");
-#endif
-    break;
-  
-  default:
-    ASSERT(0);
-    break;
-  }
-
-  /* Have fun! */
-  return adjustor;
-}
-
-
-void
-freeHaskellFunctionPtr(void* ptr)
-{
-#if defined(i386_HOST_ARCH) && !defined(darwin_HOST_OS)
- if ( *(unsigned char*)ptr != 0x68 &&
-      *(unsigned char*)ptr != 0x58 ) {
-   errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
-   return;
- }
-
- /* Free the stable pointer first..*/
- if (*(unsigned char*)ptr == 0x68) { /* Aha, a ccall adjustor! */
-    freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x01)));
- } else {
-    freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02)));
- }
-#elif defined(x86_TARGET_ARCH) && defined(darwin_HOST_OS)
-if ( *(unsigned char*)ptr != 0xe8 ) {
-   errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
-   return;
- }
- freeStablePtr(((AdjustorStub*)ptr)->hptr);
-#elif defined(x86_64_HOST_ARCH)
- if ( *(StgWord16 *)ptr == 0x894d ) {
-     freeStablePtr(*(StgStablePtr*)(ptr+0x20));
- } else if ( *(StgWord16 *)ptr == 0x5141 ) {
-     freeStablePtr(*(StgStablePtr*)(ptr+0x30));
- } else {
-   errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
-   return;
- }
-#elif defined(sparc_HOST_ARCH)
- if ( *(unsigned long*)ptr != 0x9C23A008UL ) {
-   errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
-   return;
- }
-
- /* Free the stable pointer first..*/
- freeStablePtr(*((StgStablePtr*)((unsigned long*)ptr + 11)));
-#elif defined(alpha_HOST_ARCH)
- if ( *(StgWord64*)ptr != 0xa77b0018a61b0010L ) {
-   errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
-   return;
- }
-
- /* Free the stable pointer first..*/
- freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x10)));
-#elif defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)
- if ( *(StgWord*)ptr != 0x48000008 ) {
-   errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
-   return;
- }
- freeStablePtr(((StgStablePtr*)ptr)[1]);
-#elif defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH)
- extern void* adjustorCode;
- if ( ((AdjustorStub*)ptr)->code != (StgFunPtr) &adjustorCode ) {
-   errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
-   return;
- }
- freeStablePtr(((AdjustorStub*)ptr)->hptr);
-#elif defined(ia64_HOST_ARCH)
- IA64FunDesc *fdesc = (IA64FunDesc *)ptr;
- StgWord64 *code = (StgWord64 *)(fdesc+1);
-
- if (fdesc->ip != (StgWord64)code) {
-   errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
-   return;
- }
- freeStablePtr((StgStablePtr)code[16]);
- freeStablePtr((StgStablePtr)code[17]);
- return;
-#else
- ASSERT(0);
-#endif
- *((unsigned char*)ptr) = '\0';
-
- stgFree(ptr);
-}
-
-
-/*
- * Function: initAdjustor()
- *
- * Perform initialisation of adjustor thunk layer (if needed.)
- */
-void
-initAdjustor(void)
-{
-#if defined(i386_HOST_ARCH) && defined(openbsd_HOST_OS)
-    obscure_ccall_ret_code_dyn = stgMallocBytesRWX(4);
-    obscure_ccall_ret_code_dyn[0] = ((unsigned char *)obscure_ccall_ret_code)[0];
-    obscure_ccall_ret_code_dyn[1] = ((unsigned char *)obscure_ccall_ret_code)[1];
-    obscure_ccall_ret_code_dyn[2] = ((unsigned char *)obscure_ccall_ret_code)[2];
-    obscure_ccall_ret_code_dyn[3] = ((unsigned char *)obscure_ccall_ret_code)[3];
-#endif
-}
diff --git a/ghc/rts/AdjustorAsm.S b/ghc/rts/AdjustorAsm.S
deleted file mode 100644
index cfdef68349..0000000000
--- a/ghc/rts/AdjustorAsm.S
+++ /dev/null
@@ -1,189 +0,0 @@
-#include "../includes/ghcconfig.h"
-
-/* ******************************** PowerPC ******************************** */
-
-#if defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH)
-#if !(defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS))
-    /* The following code applies, with some differences,
-       to all powerpc platforms except for powerpc32-linux,
-       whose calling convention is annoyingly complex.
-    */
-
-
-    /* The code is "almost" the same for
-       32-bit and for 64-bit
-    */
-#if defined(powerpc64_HOST_ARCH)
-#define WS          8
-#define LOAD        ld
-#define STORE       std
-#else
-#define WS          4
-#define LOAD        lwz
-#define STORE       stw
-#endif
-
-    /* Some info about stack frame layout */
-#define LINK_SLOT           (2*WS)
-#define LINKAGE_AREA_SIZE   (6*WS)
-
-    /* The following defines mirror struct AdjustorStub
-       from Adjustor.c. Make sure to keep these in sync.
-    */
-#if defined(powerpc_HOST_ARCH) && defined(darwin_HOST_OS)
-#define HEADER_WORDS   6
-#elif defined(powerpc64_HOST_ARCH) && defined(darwin_HOST_OS)
-#else
-#define HEADER_WORDS   3
-#endif
-
-#define HPTR_OFF        ((HEADER_WORDS    )*WS)
-#define WPTR_OFF        ((HEADER_WORDS + 1)*WS)
-#define FRAMESIZE_OFF   ((HEADER_WORDS + 2)*WS)
-#define EXTRA_WORDS_OFF ((HEADER_WORDS + 3)*WS)
-
-    /* Darwin insists on register names, everyone else prefers
-       to use numbers. */
-#if !defined(darwin_HOST_OS)
-#define r0 0
-#define r1 1
-#define r2 2
-#define r3 3
-#define r4 4
-#define r5 5
-#define r6 6
-#define r7 7
-#define r8 8
-#define r9 9
-#define r10 10
-#define r11 11
-#define r12 12
-
-#define r30 30
-#define r31 31
-#endif
-
-
-.text
-#if LEADING_UNDERSCORE
-    .globl _adjustorCode
-_adjustorCode:
-#else
-    .globl adjustorCode
-        /* Note that we don't build a function descriptor
-           for AIX-derived ABIs here. This will happen at runtime
-           in createAdjustor().
-        */
-adjustorCode:
-#endif
-    /* On entry, r2 will point to the AdjustorStub data structure. */
-
-        /* save the link */
-    mflr    r0
-    STORE   r0, LINK_SLOT(r1)
-    
-        /* set up stack frame */
-    LOAD    r12, FRAMESIZE_OFF(r2)
-#ifdef powerpc64_HOST_ARCH
-    stdux   r1, r1, r12
-#else   
-    stwux   r1, r1, r12
-#endif
-
-        /* Save some regs so that we can use them.
-           Note that we use the "Red Zone" below the stack pointer.
-        */
-    STORE   r31, -WS(r1)
-    STORE   r30, -2*WS(r1)
-
-    mr      r31, r1
-    subf    r30, r12, r31
-
-    LOAD    r12, EXTRA_WORDS_OFF(r2)
-    mtctr   r12
-    b       2f
-1:
-    LOAD    r0, LINKAGE_AREA_SIZE +  8*WS(r30)
-    STORE   r0, LINKAGE_AREA_SIZE + 10*WS(r31)
-    addi    r30, r30, WS
-    addi    r31, r31, WS
-2:
-    bdnz    1b
-
-        /* Restore r30 and r31 now.
-        */
-    LOAD    r31, -WS(r1)
-    LOAD    r30, -2*WS(r1)
-
-    STORE   r10, LINKAGE_AREA_SIZE + 9*WS(r1)
-    STORE   r9,  LINKAGE_AREA_SIZE + 8*WS(r1)
-    mr      r10, r8
-    mr      r9, r7
-    mr      r8, r6
-    mr      r7, r5
-    mr      r6, r4
-    mr      r5, r3
-
-    LOAD    r3, HPTR_OFF(r2)
-
-    LOAD    r12, WPTR_OFF(r2)
-#if defined(darwin_HOST_OS)
-    mtctr   r12
-#else
-    LOAD    r0, 0(r12)
-        /* The function we're calling will never be a nested function,
-           so we don't load r11. 
-        */
-    mtctr   r0
-    LOAD    r2, WS(r12)
-#endif
-    bctrl
-
-    LOAD    r1, 0(r1)
-    LOAD    r0, LINK_SLOT(r1)
-    mtlr    r0
-    blr
-#endif
-
-/* ********************************* i386 ********************************** */
-
-#elif defined(i386_HOST_ARCH) && defined(darwin_HOST_OS)
-
-#define WS              4
-#define RETVAL_OFF      5
-#define HEADER_BYTES    8
-
-#define HPTR_OFF        HEADER_BYTES
-#define WPTR_OFF        (HEADER_BYTES + 1*WS)
-#define FRAMESIZE_OFF   (HEADER_BYTES + 2*WS)
-#define ARGWORDS_OFF    (HEADER_BYTES + 3*WS)
-
-    .globl _adjustorCode
-_adjustorCode:
-    popl    %eax
-    subl    $RETVAL_OFF, %eax
-    
-    pushl   %ebp
-    movl    %esp, %ebp
-    
-    subl    FRAMESIZE_OFF(%eax), %esp
-
-    pushl   %esi
-    pushl   %edi
-        
-    leal    8(%ebp), %esi
-    leal    12(%esp), %edi
-    movl    ARGWORDS_OFF(%eax), %ecx
-    rep
-    movsl
-    
-    popl    %edi
-    popl    %esi
-    
-    pushl   HPTR_OFF(%eax)
-    call    *WPTR_OFF(%eax)
-    
-    leave
-    ret
-#endif
-
diff --git a/ghc/rts/Apply.cmm b/ghc/rts/Apply.cmm
deleted file mode 100644
index e0ca03944c..0000000000
--- a/ghc/rts/Apply.cmm
+++ /dev/null
@@ -1,268 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The University of Glasgow 2004
- *
- * Application-related bits.
- *
- * This file is written in a subset of C--, extended with various
- * features specific to GHC.  It is compiled by GHC directly.  For the
- * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
- *
- * -------------------------------------------------------------------------- */
-
-#include "Cmm.h"
-
-/* ----------------------------------------------------------------------------
- * Evaluate a closure and return it.
- *
- * There isn't an info table / return address version of stg_ap_0, because
- * everything being returned is guaranteed evaluated, so it would be a no-op.
- */
-
-STRING(stg_ap_0_ret_str,"stg_ap_0_ret... ")
-
-stg_ap_0_fast
-{ 
-    // fn is in R1, no args on the stack
-
-    IF_DEBUG(apply,
-	foreign "C" debugBelch(stg_ap_0_ret_str) [R1];
-	foreign "C" printClosure(R1 "ptr") [R1]);
-
-    IF_DEBUG(sanity,
-	foreign "C" checkStackChunk(Sp "ptr",
-				    CurrentTSO + TSO_OFFSET_StgTSO_stack +
-				    WDS(TO_W_(StgTSO_stack_size(CurrentTSO))) "ptr") [R1]);
-
-    ENTER();
-}
-
-/* -----------------------------------------------------------------------------
-   Entry Code for a PAP.
-
-   This entry code is *only* called by one of the stg_ap functions.
-   On entry: Sp points to the remaining arguments on the stack.  If
-   the stack check fails, we can just push the PAP on the stack and
-   return to the scheduler.
-
-   On entry: R1 points to the PAP.  The rest of the function's
-   arguments (apart from those that are already in the PAP) are on the
-   stack, starting at Sp(0).  R2 contains an info table which
-   describes these arguments, which is used in the event that the
-   stack check in the entry code below fails.  The info table is
-   currently one of the stg_ap_*_ret family, as this code is always
-   entered from those functions.
-
-   The idea is to copy the chunk of stack from the PAP object onto the
-   stack / into registers, and enter the function.
-   -------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP")
-{  foreign "C" barf("PAP object entered!"); }
-    
-stg_PAP_apply
-{
-  W_ Words;
-  W_ pap;
-    
-  pap = R1;
-
-  Words = TO_W_(StgPAP_n_args(pap));
-
-  //
-  // Check for stack overflow and bump the stack pointer.
-  // We have a hand-rolled stack check fragment here, because none of
-  // the canned ones suit this situation.
-  //
-  if ((Sp - WDS(Words)) < SpLim) {
-      // there is a return address in R2 in the event of a
-      // stack check failure.  The various stg_apply functions arrange
-      // this before calling stg_PAP_entry.
-      Sp_adj(-1); 
-      Sp(0) = R2;
-      jump stg_gc_unpt_r1;
-  }
-  Sp_adj(-Words);
-
-  // profiling
-  TICK_ENT_PAP();
-  LDV_ENTER(pap);
-  // Enter PAP cost centre 
-  ENTER_CCS_PAP_CL(pap);
-
-  R1 = StgPAP_fun(pap);
-
-  // Reload the stack 
-  W_ i;
-  W_ p;
-  p = pap + SIZEOF_StgHeader + OFFSET_StgPAP_payload;
-  i = 0;
-for:
-  if (i < Words) {
-    Sp(i) = W_[p];
-    p = p + WDS(1);
-    i = i + 1;
-    goto for;
-  }
-
-  // Off we go! 
-  TICK_ENT_VIA_NODE();
-
-#ifdef NO_ARG_REGS
-  jump %GET_ENTRY(R1);
-#else
-      W_ info;
-      info = %GET_FUN_INFO(R1);
-      W_ type;
-      type = TO_W_(StgFunInfoExtra_fun_type(info));
-      if (type == ARG_GEN) {
-	  jump StgFunInfoExtra_slow_apply(info);
-      }
-      if (type == ARG_GEN_BIG) {
-	  jump StgFunInfoExtra_slow_apply(info);
-      }
-      if (type == ARG_BCO) {
-	  Sp_adj(-2);
-	  Sp(1) = R1;
-	  Sp(0) = stg_apply_interp_info;
-	  jump stg_yield_to_interpreter;
-      }
-      jump W_[stg_ap_stack_entries + 
-		WDS(TO_W_(StgFunInfoExtra_fun_type(info)))];
-#endif
-}
-
-/* -----------------------------------------------------------------------------
-   Entry Code for an AP (a PAP with arity zero).
-
-   The entry code is very similar to a PAP, except there are no
-   further arguments on the stack to worry about, so the stack check
-   is simpler.  We must also push an update frame on the stack before
-   applying the function.
-   -------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_AP,/*special layout*/0,0,AP,"AP","AP")
-{
-  W_ Words;
-  W_ ap;
-    
-  ap = R1;
-  
-  Words = TO_W_(StgAP_n_args(ap));
-
-  /* 
-   * Check for stack overflow.  IMPORTANT: use a _NP check here,
-   * because if the check fails, we might end up blackholing this very
-   * closure, in which case we must enter the blackhole on return rather
-   * than continuing to evaluate the now-defunct closure.
-   */
-  STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame);
-
-  PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
-  Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
-
-  TICK_ENT_AP();
-  LDV_ENTER(ap);
-
-  // Enter PAP cost centre
-  ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL 
-
-  R1 = StgAP_fun(ap);
-
-  // Reload the stack 
-  W_ i;
-  W_ p;
-  p = ap + SIZEOF_StgHeader + OFFSET_StgAP_payload;
-  i = 0;
-for:
-  if (i < Words) {
-    Sp(i) = W_[p];
-    p = p + WDS(1);
-    i = i + 1;
-    goto for;
-  }
-
-  // Off we go! 
-  TICK_ENT_VIA_NODE();
-
-#ifdef NO_ARG_REGS
-  jump %GET_ENTRY(R1);
-#else
-      W_ info;
-      info = %GET_FUN_INFO(R1);
-      W_ type;
-      type = TO_W_(StgFunInfoExtra_fun_type(info));
-      if (type == ARG_GEN) {
-	  jump StgFunInfoExtra_slow_apply(info);
-      }
-      if (type == ARG_GEN_BIG) {
-	  jump StgFunInfoExtra_slow_apply(info);
-      }
-      if (type == ARG_BCO) {
-	  Sp_adj(-2);
-	  Sp(1) = R1;
-	  Sp(0) = stg_apply_interp_info;
-	  jump stg_yield_to_interpreter;
-      }
-      jump W_[stg_ap_stack_entries + 
-		WDS(TO_W_(StgFunInfoExtra_fun_type(info)))];
-#endif
-}
-
-/* -----------------------------------------------------------------------------
-   Entry Code for an AP_STACK.
-
-   Very similar to a PAP and AP.  The layout is the same as PAP
-   and AP, except that the payload is a chunk of stack instead of
-   being described by the function's info table.  Like an AP,
-   there are no further arguments on the stack to worry about.
-   However, the function closure (ap->fun) does not necessarily point
-   directly to a function, so we have to enter it using stg_ap_0.
-   -------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_AP_STACK,/*special layout*/0,0,AP_STACK,"AP_STACK","AP_STACK")
-{
-  W_ Words;
-  W_ ap;
-
-  ap = R1;
-  
-  Words = StgAP_STACK_size(ap);
-
-  /* 
-   * Check for stack overflow.  IMPORTANT: use a _NP check here,
-   * because if the check fails, we might end up blackholing this very
-   * closure, in which case we must enter the blackhole on return rather
-   * than continuing to evaluate the now-defunct closure.
-   */
-  STK_CHK_NP(WDS(Words) + SIZEOF_StgUpdateFrame);
-
-  PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);
-  Sp = Sp - SIZEOF_StgUpdateFrame - WDS(Words);
-
-  TICK_ENT_AP();
-  LDV_ENTER(ap);
-
-  // Enter PAP cost centre
-  ENTER_CCS_PAP_CL(ap);   // ToDo: ENTER_CC_AP_CL 
-
-  R1 = StgAP_STACK_fun(ap);
-
-  // Reload the stack
-  W_ i;
-  W_ p;
-  p = ap + SIZEOF_StgHeader + OFFSET_StgAP_STACK_payload;
-  i = 0;
-for:
-  if (i < Words) {
-    Sp(i) = W_[p];
-    p = p + WDS(1);
-    i = i + 1;
-    goto for;
-  }
-
-  // Off we go!
-  TICK_ENT_VIA_NODE();
-
-  ENTER();
-}
diff --git a/ghc/rts/Apply.h b/ghc/rts/Apply.h
deleted file mode 100644
index 76e36cb9fb..0000000000
--- a/ghc/rts/Apply.h
+++ /dev/null
@@ -1,29 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The University of Glasgow 2002-2004
- *
- * Declarations for things defined in AutoApply.cmm
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef APPLY_H
-#define APPLY_H
-
-// canned slow entry points, indexed by arg type (ARG_P, ARG_PP, etc.)
-#ifdef IN_STG_CODE
-extern StgWord stg_ap_stack_entries[];
-#else
-extern StgFun *stg_ap_stack_entries[];
-#endif
-
-// canned register save code for heap check failure in a function
-#ifdef IN_STG_CODE
-extern StgWord stg_stack_save_entries[];
-#else
-extern StgFun *stg_stack_save_entries[];
-#endif
-
-// canned bitmap for each arg type
-extern StgWord stg_arg_bitmaps[];
-
-#endif /* APPLY_H */
diff --git a/ghc/rts/Arena.c b/ghc/rts/Arena.c
deleted file mode 100644
index 76ac23cf88..0000000000
--- a/ghc/rts/Arena.c
+++ /dev/null
@@ -1,120 +0,0 @@
-/* -----------------------------------------------------------------------------
-   (c) The University of Glasgow 2001
-
-   Arena allocation.  Arenas provide fast memory allocation at the
-   expense of fine-grained recycling of storage: memory may be
-   only be returned to the system by freeing the entire arena, it
-   isn't possible to return individual objects within an arena.
-
-   Do not assume that sequentially allocated objects will be adjacent
-   in memory.
-   
-   Quirks: this allocator makes use of the RTS block allocator.  If
-   the current block doesn't have enough room for the requested
-   object, then a new block is allocated.  This means that allocating
-   large objects will tend to result in wasted space at the end of
-   each block.  In the worst case, half of the allocated space is
-   wasted.  This allocator is therefore best suited to situations in
-   which most allocations are small.
-   -------------------------------------------------------------------------- */
-
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "BlockAlloc.h"
-#include "Arena.h"
-
-#include <stdlib.h>
-
-// Each arena struct is allocated using malloc().
-struct _Arena {
-    bdescr *current;
-    StgWord *free;		// ptr to next free byte in current block
-    StgWord *lim;		// limit (== last free byte + 1)
-};
-
-// We like to keep track of how many blocks we've allocated for 
-// Storage.c:memInventory().
-static long arena_blocks = 0;
-
-// Begin a new arena
-Arena *
-newArena( void )
-{
-    Arena *arena;
-
-    arena = stgMallocBytes(sizeof(Arena), "newArena");
-    arena->current = allocBlock();
-    arena->current->link = NULL;
-    arena->free = arena->current->start;
-    arena->lim  = arena->current->start + BLOCK_SIZE_W;
-    arena_blocks++;
-
-    return arena;
-}
-
-// The minimum alignment of an allocated block.
-#define MIN_ALIGN 8
-
-/* 'n' is assumed to be a power of 2 */
-#define ROUNDUP(x,n)  (((x)+((n)-1))&(~((n)-1)))
-#define B_TO_W(x)     ((x) / sizeof(W_))
-
-// Allocate some memory in an arena
-void  *
-arenaAlloc( Arena *arena, size_t size )
-{
-    void *p;
-    nat size_w;
-    nat req_blocks;
-    bdescr *bd;
-
-    // round up to nearest alignment chunk.
-    size = ROUNDUP(size,MIN_ALIGN);
-
-    // size of allocated block in words.
-    size_w = B_TO_W(size);
-
-    if ( arena->free + size_w < arena->lim ) {
-	// enough room in the current block...
-	p = arena->free;
-	arena->free += size_w;
-	return p;
-    } else {
-	// allocate a fresh block...
-	req_blocks =  (lnat)BLOCK_ROUND_UP(size) / BLOCK_SIZE;
-	bd = allocGroup(req_blocks);
-	arena_blocks += req_blocks;
-
-	bd->gen_no  = 0;
-	bd->step    = NULL;
-	bd->flags   = 0;
-	bd->free    = bd->start;
-	bd->link    = arena->current;
-	arena->current = bd;
-	arena->free = bd->free + size_w;
-	arena->lim = bd->free + bd->blocks * BLOCK_SIZE_W;
-	return bd->start;
-    }
-}
-
-// Free an entire arena
-void
-arenaFree( Arena *arena )
-{
-    bdescr *bd, *next;
-
-    for (bd = arena->current; bd != NULL; bd = next) {
-	next = bd->link;
-	arena_blocks -= bd->blocks;
-	ASSERT(arena_blocks >= 0);
-	freeGroup(bd);
-    }
-    stgFree(arena);
-}
-
-unsigned long
-arenaBlocks( void )
-{
-    return arena_blocks;
-}
-
diff --git a/ghc/rts/Arena.h b/ghc/rts/Arena.h
deleted file mode 100644
index 7a2989e543..0000000000
--- a/ghc/rts/Arena.h
+++ /dev/null
@@ -1,25 +0,0 @@
-/* -----------------------------------------------------------------------------
-   (c) The University of Glasgow 2001
-
-   Arena allocation interface.
-   -------------------------------------------------------------------------- */
-
-#ifndef ARENA_H
-#define ARENA_H
-
-// Abstract type of arenas
-typedef struct _Arena Arena;
-
-// Start a new arena
-extern Arena * newArena   ( void );
-
-// Allocate memory in an arena
-extern void  * arenaAlloc ( Arena *, size_t );
-
-// Free an entire arena
-extern void    arenaFree  ( Arena * );
-
-// For internal use only:
-extern unsigned long arenaBlocks( void );
-
-#endif /* ARENA_H */
diff --git a/ghc/rts/AutoApply.h b/ghc/rts/AutoApply.h
deleted file mode 100644
index bbec1224ff..0000000000
--- a/ghc/rts/AutoApply.h
+++ /dev/null
@@ -1,80 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The University of Glasgow 2002-2004
- *
- * Helper bits for the generic apply code (AutoApply.hc)
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef AUTOAPPLY_H
-#define AUTOAPPLY_H
-
-// Build a new PAP: function is in R1
-// ret addr and m arguments taking up n words are on the stack.
-// NB. x is a dummy argument attached to the 'for' label so that
-// BUILD_PAP can be used multiple times in the same function.
-#define BUILD_PAP(m,n,f,x)				\
-    W_ pap;						\
-    W_ size;						\
-    W_ i;						\
-    size = SIZEOF_StgPAP + WDS(n);			\
-    HP_CHK_NP_ASSIGN_SP0(size,f);			\
-    TICK_ALLOC_HEAP_NOCTR(BYTES_TO_WDS(size));		\
-    TICK_ALLOC_PAP(n+1 /* +1 for the FUN */, 0);	\
-    pap = Hp + WDS(1) - size;				\
-    SET_HDR(pap, stg_PAP_info, W_[CCCS]);		\
-    StgPAP_arity(pap) = HALF_W_(arity - m);		\
-    StgPAP_fun(pap)   = R1;				\
-    StgPAP_n_args(pap) = HALF_W_(n);			\
-    i = 0;						\
-  for##x:						\
-    if (i < n) {					\
-	StgPAP_payload(pap,i) = Sp(1+i);		\
-	i = i + 1;					\
-	goto for##x;					\
-    }							\
-    R1 = pap;						\
-    Sp_adj(1 + n);					\
-    jump %ENTRY_CODE(Sp(0));
-
-// Copy the old PAP, build a new one with the extra arg(s)
-// ret addr and m arguments taking up n words are on the stack.
-// NB. x is a dummy argument attached to the 'for' label so that
-// BUILD_PAP can be used multiple times in the same function.
-#define NEW_PAP(m,n,f,x)					\
-     W_ pap;							\
-     W_ new_pap;						\
-     W_ size;							\
-     W_ i;							\
-     pap = R1;							\
-     size = SIZEOF_StgPAP + WDS(TO_W_(StgPAP_n_args(pap))) + WDS(n);	\
-     HP_CHK_NP_ASSIGN_SP0(size,f);				\
-     TICK_ALLOC_HEAP_NOCTR(BYTES_TO_WDS(size));			\
-     TICK_ALLOC_PAP(n+1 /* +1 for the FUN */, 0);		\
-     new_pap = Hp + WDS(1) - size;				\
-     SET_HDR(new_pap, stg_PAP_info, W_[CCCS]);			\
-     StgPAP_arity(new_pap) = HALF_W_(arity - m);		\
-     W_ n_args;							\
-     n_args = TO_W_(StgPAP_n_args(pap));			\
-     StgPAP_n_args(new_pap) = HALF_W_(n_args + n);		\
-     StgPAP_fun(new_pap) = StgPAP_fun(pap);			\
-     i = 0;							\
-   for1##x:							\
-     if (i < n_args) {						\
-         StgPAP_payload(new_pap,i) = StgPAP_payload(pap,i);	\
-	 i = i + 1;						\
-	 goto for1##x;						\
-     }								\
-     i = 0;							\
-   for2##x:							\
-     if (i < n) {						\
-	 StgPAP_payload(new_pap,n_args+i) = Sp(1+i);		\
-         i = i + 1;						\
-         goto for2##x;						\
-     }								\
-     R1 = new_pap;						\
-     Sp_adj(n+1);						\
-     jump %ENTRY_CODE(Sp(0));
-
-#endif /* APPLY_H */
-
diff --git a/ghc/rts/AwaitEvent.h b/ghc/rts/AwaitEvent.h
deleted file mode 100644
index e03cb4444e..0000000000
--- a/ghc/rts/AwaitEvent.h
+++ /dev/null
@@ -1,24 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1998-2005
- *
- * The awaitEvent() interface, for the non-threaded RTS
- *
- * -------------------------------------------------------------------------*/
-
-#ifndef AWAITEVENT_H
-#define AWAITEVENT_H
-
-#if !defined(THREADED_RTS)
-/* awaitEvent(rtsBool wait)
- *
- * Checks for blocked threads that need to be woken.
- *
- * Called from STG :  NO
- * Locks assumed   :  sched_mutex
- */
-void awaitEvent(rtsBool wait);  /* In posix/Select.c or
-				 * win32/AwaitEvent.c */
-#endif
-
-#endif /* SELECT_H */
diff --git a/ghc/rts/BlockAlloc.c b/ghc/rts/BlockAlloc.c
deleted file mode 100644
index 5e0e321947..0000000000
--- a/ghc/rts/BlockAlloc.c
+++ /dev/null
@@ -1,391 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1998-2006
- * 
- * The block allocator and free list manager.
- *
- * This is the architecture independent part of the block allocator.
- * It requires only the following support from the operating system: 
- *
- *    void *getMBlock();
- *
- * returns the address of an MBLOCK_SIZE region of memory, aligned on
- * an MBLOCK_SIZE boundary.  There is no requirement for successive
- * calls to getMBlock to return strictly increasing addresses.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "BlockAlloc.h"
-#include "MBlock.h"
-#include "Storage.h"
-
-#include <string.h>
-
-static void    initMBlock(void *mblock);
-static bdescr *allocMegaGroup(nat mblocks);
-static void    freeMegaGroup(bdescr *bd);
-
-// In THREADED_RTS mode, the free list is protected by sm_mutex.
-static bdescr *free_list = NULL;
-
-/* -----------------------------------------------------------------------------
-   Initialisation
-   -------------------------------------------------------------------------- */
-
-void initBlockAllocator(void)
-{
-    // The free list starts off NULL
-}
-
-/* -----------------------------------------------------------------------------
-   Allocation
-   -------------------------------------------------------------------------- */
-
-STATIC_INLINE void
-initGroup(nat n, bdescr *head)
-{
-  bdescr *bd;
-  nat i;
-
-  if (n != 0) {
-    head->blocks = n;
-    head->free   = head->start;
-    head->link   = NULL;
-    for (i=1, bd = head+1; i < n; i++, bd++) {
-      bd->free = 0;
-      bd->blocks = 0;
-      bd->link = head;
-    }
-  }
-}
-
-bdescr *
-allocGroup(nat n)
-{
-  void *mblock;
-  bdescr *bd, **last;
-
-  ASSERT_SM_LOCK();
-  ASSERT(n != 0);
-
-  if (n > BLOCKS_PER_MBLOCK) {
-    return allocMegaGroup(BLOCKS_TO_MBLOCKS(n));
-  }
-
-  last = &free_list;
-  for (bd = free_list; bd != NULL; bd = bd->link) {
-    if (bd->blocks == n) {	/* exactly the right size! */
-      *last = bd->link;
-      /* no initialisation necessary - this is already a
-       * self-contained block group. */
-      bd->free = bd->start;	/* block isn't free now */
-      bd->link = NULL;
-      return bd;
-    }
-    if (bd->blocks >  n) {	/* block too big... */
-      bd->blocks -= n;		/* take a chunk off the *end* */
-      bd += bd->blocks;
-      initGroup(n, bd);		/* initialise it */
-      return bd;
-    }
-    last = &bd->link;
-  }
-  
-  mblock = getMBlock();		/* get a new megablock */
-  initMBlock(mblock);		/* initialise the start fields */
-  bd = FIRST_BDESCR(mblock);
-  initGroup(n,bd);		/* we know the group will fit */
-  if (n < BLOCKS_PER_MBLOCK) {
-    initGroup(BLOCKS_PER_MBLOCK-n, bd+n);
-    freeGroup(bd+n);      	/* add the rest on to the free list */
-  }
-  return bd;
-}
-
-bdescr *
-allocGroup_lock(nat n)
-{
-    bdescr *bd;
-    ACQUIRE_SM_LOCK;
-    bd = allocGroup(n);
-    RELEASE_SM_LOCK;
-    return bd;
-}
-
-bdescr *
-allocBlock(void)
-{
-  return allocGroup(1);
-}
-
-bdescr *
-allocBlock_lock(void)
-{
-    bdescr *bd;
-    ACQUIRE_SM_LOCK;
-    bd = allocBlock();
-    RELEASE_SM_LOCK;
-    return bd;
-}
-
-/* -----------------------------------------------------------------------------
-   Any request larger than BLOCKS_PER_MBLOCK needs a megablock group.
-   First, search the free list for enough contiguous megablocks to
-   fulfill the request - if we don't have enough, we need to
-   allocate some new ones.
-
-   A megablock group looks just like a normal block group, except that
-   the blocks field in the head will be larger than BLOCKS_PER_MBLOCK.
-
-   Note that any objects placed in this group must start in the first
-   megablock, since the other blocks don't have block descriptors.
-   -------------------------------------------------------------------------- */
-   
-static bdescr *
-allocMegaGroup(nat n)
-{
-  nat mbs_found;
-  bdescr *bd, *last, *grp_start, *grp_prev;
-
-  mbs_found = 0;
-  grp_start = NULL;
-  grp_prev  = NULL;
-  last      = NULL;
-  for (bd = free_list; bd != NULL; bd = bd->link) {
-
-    if (bd->blocks == BLOCKS_PER_MBLOCK) {	/* whole megablock found */
-
-      /* is it the first one we've found or a non-contiguous megablock? */
-      if (grp_start == NULL ||
-          bd->start != last->start + MBLOCK_SIZE/sizeof(W_)) {
-	grp_start = bd;
-	grp_prev  = last;
-	mbs_found = 1;
-      } else {
-	mbs_found++;
-      }
-
-      if (mbs_found == n) {	/* found enough contig megablocks? */
-	break;
-      }
-    } 
-
-    else {			/* only a partial megablock, start again */
-      grp_start = NULL;
-    }
-
-    last = bd;
-  }
-
-  /* found all the megablocks we need on the free list
-   */
-  if (mbs_found == n) {
-    /* remove the megablocks from the free list */
-    if (grp_prev == NULL) {	/* bd now points to the last mblock */
-      free_list = bd->link;
-    } else {
-      grp_prev->link = bd->link;
-    }
-  }
-
-  /* the free list wasn't sufficient, allocate all new mblocks.
-   */
-  else {
-    void *mblock = getMBlocks(n);
-    initMBlock(mblock);		/* only need to init the 1st one */
-    grp_start = FIRST_BDESCR(mblock);
-  }
-
-  /* set up the megablock group */
-  initGroup(BLOCKS_PER_MBLOCK, grp_start);
-  grp_start->blocks = MBLOCK_GROUP_BLOCKS(n);
-  return grp_start;
-}
-
-/* -----------------------------------------------------------------------------
-   De-Allocation
-   -------------------------------------------------------------------------- */
-
-/* coalesce the group p with p->link if possible.
- *
- * Returns p->link if no coalescing was done, otherwise returns a
- * pointer to the newly enlarged group p.
- */
-
-STATIC_INLINE bdescr *
-coalesce(bdescr *p)
-{
-  bdescr *bd, *q;
-  nat i, blocks;
-
-  q = p->link;
-  if (q != NULL && p->start + p->blocks * BLOCK_SIZE_W == q->start) {
-    /* can coalesce */
-    p->blocks += q->blocks;
-    p->link    = q->link;
-    blocks = q->blocks;
-    for (i = 0, bd = q; i < blocks; bd++, i++) {
-	bd->free = 0;
-	bd->blocks = 0;
-	bd->link = p;
-    }
-    return p;
-  }
-  return q;
-}
-
-void
-freeGroup(bdescr *p)
-{
-  bdescr *bd, *last;
-  
-  ASSERT_SM_LOCK();
-
-  /* are we dealing with a megablock group? */
-  if (p->blocks > BLOCKS_PER_MBLOCK) {
-    freeMegaGroup(p);
-    return;
-  }
-
-
-  p->free = (void *)-1;  /* indicates that this block is free */
-  p->step = NULL;
-  p->gen_no = 0;
-  /* fill the block group with garbage if sanity checking is on */
-  IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
-
-  /* find correct place in free list to place new group */
-  last = NULL;
-  for (bd = free_list; bd != NULL && bd->start < p->start; 
-       bd = bd->link) {
-    last = bd;
-  }
-
-  /* now, last = previous group (or NULL) */
-  if (last == NULL) {
-    p->link = free_list;
-    free_list = p;
-  } else {
-    /* coalesce with previous group if possible */
-    p->link = last->link;
-    last->link = p;
-    p = coalesce(last);
-  }
-
-  /* coalesce with next group if possible */
-  coalesce(p);
-  IF_DEBUG(sanity, checkFreeListSanity());
-}
-
-void
-freeGroup_lock(bdescr *p)
-{
-    ACQUIRE_SM_LOCK;
-    freeGroup(p);
-    RELEASE_SM_LOCK;
-}
-
-static void
-freeMegaGroup(bdescr *p)
-{
-  nat n;
-  void *q = p;
-
-  n = ((bdescr *)q)->blocks * BLOCK_SIZE / MBLOCK_SIZE + 1;
-  for (; n > 0; q += MBLOCK_SIZE, n--) {
-    initMBlock(MBLOCK_ROUND_DOWN(q));
-    initGroup(BLOCKS_PER_MBLOCK, (bdescr *)q);
-    freeGroup((bdescr *)q);
-  }
-}
-
-void
-freeChain(bdescr *bd)
-{
-  bdescr *next_bd;
-  while (bd != NULL) {
-    next_bd = bd->link;
-    freeGroup(bd);
-    bd = next_bd;
-  }
-}
-
-void
-freeChain_lock(bdescr *bd)
-{
-    ACQUIRE_SM_LOCK;
-    freeChain(bd);
-    RELEASE_SM_LOCK;
-}
-
-static void
-initMBlock(void *mblock)
-{
-  bdescr *bd;
-  void *block;
-
-  /* the first few Bdescr's in a block are unused, so we don't want to
-   * put them all on the free list.
-   */
-  block = FIRST_BLOCK(mblock);
-  bd    = FIRST_BDESCR(mblock);
-
-  /* Initialise the start field of each block descriptor
-   */
-  for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
-    bd->start = block;
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   Debugging
-   -------------------------------------------------------------------------- */
-
-#ifdef DEBUG
-static void
-checkWellFormedGroup( bdescr *bd )
-{
-    nat i;
-
-    for (i = 1; i < bd->blocks; i++) {
-	ASSERT(bd[i].blocks == 0);
-	ASSERT(bd[i].free   == 0);
-	ASSERT(bd[i].link   == bd);
-    }
-}
-
-void
-checkFreeListSanity(void)
-{
-  bdescr *bd;
-
-  for (bd = free_list; bd != NULL; bd = bd->link) {
-    IF_DEBUG(block_alloc,
-	     debugBelch("group at 0x%p, length %d blocks\n", 
-			bd->start, bd->blocks));
-    ASSERT(bd->blocks > 0);
-    checkWellFormedGroup(bd);
-    if (bd->link != NULL) {
-      /* make sure we're fully coalesced */
-      ASSERT(bd->start + bd->blocks * BLOCK_SIZE_W != bd->link->start);
-      ASSERT(bd->start < bd->link->start);
-    }
-  }
-}
-
-nat /* BLOCKS */
-countFreeList(void)
-{
-  bdescr *bd;
-  lnat total_blocks = 0;
-
-  for (bd = free_list; bd != NULL; bd = bd->link) {
-    total_blocks += bd->blocks;
-  }
-  return total_blocks;
-}
-#endif
diff --git a/ghc/rts/BlockAlloc.h b/ghc/rts/BlockAlloc.h
deleted file mode 100644
index 1472ac6f76..0000000000
--- a/ghc/rts/BlockAlloc.h
+++ /dev/null
@@ -1,19 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-1999
- *
- * Block Allocator Interface
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef BLOCK_ALLOC_H
-#define BLOCK_ALLOC_H
-
-/* Debugging  -------------------------------------------------------------- */
-
-#ifdef DEBUG
-extern void checkFreeListSanity(void);
-nat         countFreeList(void);
-#endif
-
-#endif /* BLOCK_ALLOC_H */
diff --git a/ghc/rts/Capability.c b/ghc/rts/Capability.c
deleted file mode 100644
index 51a42ef468..0000000000
--- a/ghc/rts/Capability.c
+++ /dev/null
@@ -1,668 +0,0 @@
-/* ---------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2003-2006
- *
- * Capabilities
- *
- * A Capability represent the token required to execute STG code,
- * and all the state an OS thread/task needs to run Haskell code:
- * its STG registers, a pointer to its TSO, a nursery etc. During
- * STG execution, a pointer to the capabilitity is kept in a
- * register (BaseReg; actually it is a pointer to cap->r).
- *
- * Only in an THREADED_RTS build will there be multiple capabilities,
- * for non-threaded builds there is only one global capability, namely
- * MainCapability.
- *
- * --------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "STM.h"
-#include "OSThreads.h"
-#include "Capability.h"
-#include "Schedule.h"
-#include "Sparks.h"
-
-// one global capability, this is the Capability for non-threaded
-// builds, and for +RTS -N1
-Capability MainCapability;
-
-nat n_capabilities;
-Capability *capabilities = NULL;
-
-// Holds the Capability which last became free.  This is used so that
-// an in-call has a chance of quickly finding a free Capability.
-// Maintaining a global free list of Capabilities would require global
-// locking, so we don't do that.
-Capability *last_free_capability;
-
-#if defined(THREADED_RTS)
-STATIC_INLINE rtsBool
-globalWorkToDo (void)
-{
-    return blackholes_need_checking
-	|| sched_state >= SCHED_INTERRUPTING
-	;
-}
-#endif
-
-#if defined(THREADED_RTS)
-STATIC_INLINE rtsBool
-anyWorkForMe( Capability *cap, Task *task )
-{
-    if (task->tso != NULL) {
-	// A bound task only runs if its thread is on the run queue of
-	// the capability on which it was woken up.  Otherwise, we
-	// can't be sure that we have the right capability: the thread
-	// might be woken up on some other capability, and task->cap
-	// could change under our feet.
-	return !emptyRunQueue(cap) && cap->run_queue_hd->bound == task;
-    } else {
-	// A vanilla worker task runs if either there is a lightweight
-	// thread at the head of the run queue, or the run queue is
-	// empty and (there are sparks to execute, or there is some
-	// other global condition to check, such as threads blocked on
-	// blackholes).
-	if (emptyRunQueue(cap)) {
-	    return !emptySparkPoolCap(cap)
-		|| !emptyWakeupQueue(cap)
-		|| globalWorkToDo();
-	} else
-	    return cap->run_queue_hd->bound == NULL;
-    }
-}
-#endif
-
-/* -----------------------------------------------------------------------------
- * Manage the returning_tasks lists.
- *
- * These functions require cap->lock
- * -------------------------------------------------------------------------- */
-
-#if defined(THREADED_RTS)
-STATIC_INLINE void
-newReturningTask (Capability *cap, Task *task)
-{
-    ASSERT_LOCK_HELD(&cap->lock);
-    ASSERT(task->return_link == NULL);
-    if (cap->returning_tasks_hd) {
-	ASSERT(cap->returning_tasks_tl->return_link == NULL);
-	cap->returning_tasks_tl->return_link = task;
-    } else {
-	cap->returning_tasks_hd = task;
-    }
-    cap->returning_tasks_tl = task;
-}
-
-STATIC_INLINE Task *
-popReturningTask (Capability *cap)
-{
-    ASSERT_LOCK_HELD(&cap->lock);
-    Task *task;
-    task = cap->returning_tasks_hd;
-    ASSERT(task);
-    cap->returning_tasks_hd = task->return_link;
-    if (!cap->returning_tasks_hd) {
-	cap->returning_tasks_tl = NULL;
-    }
-    task->return_link = NULL;
-    return task;
-}
-#endif
-
-/* ----------------------------------------------------------------------------
- * Initialisation
- *
- * The Capability is initially marked not free.
- * ------------------------------------------------------------------------- */
-
-static void
-initCapability( Capability *cap, nat i )
-{
-    nat g;
-
-    cap->no = i;
-    cap->in_haskell        = rtsFalse;
-
-    cap->run_queue_hd      = END_TSO_QUEUE;
-    cap->run_queue_tl      = END_TSO_QUEUE;
-
-#if defined(THREADED_RTS)
-    initMutex(&cap->lock);
-    cap->running_task      = NULL; // indicates cap is free
-    cap->spare_workers     = NULL;
-    cap->suspended_ccalling_tasks = NULL;
-    cap->returning_tasks_hd = NULL;
-    cap->returning_tasks_tl = NULL;
-    cap->wakeup_queue_hd    = END_TSO_QUEUE;
-    cap->wakeup_queue_tl    = END_TSO_QUEUE;
-#endif
-
-    cap->f.stgGCEnter1     = (F_)__stg_gc_enter_1;
-    cap->f.stgGCFun        = (F_)__stg_gc_fun;
-
-    cap->mut_lists  = stgMallocBytes(sizeof(bdescr *) *
-				     RtsFlags.GcFlags.generations,
-				     "initCapability");
-
-    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	cap->mut_lists[g] = NULL;
-    }
-
-    cap->free_tvar_wait_queues = END_STM_WAIT_QUEUE;
-    cap->free_trec_chunks = END_STM_CHUNK_LIST;
-    cap->free_trec_headers = NO_TREC;
-    cap->transaction_tokens = 0;
-}
-
-/* ---------------------------------------------------------------------------
- * Function:  initCapabilities()
- *
- * Purpose:   set up the Capability handling. For the THREADED_RTS build,
- *            we keep a table of them, the size of which is
- *            controlled by the user via the RTS flag -N.
- *
- * ------------------------------------------------------------------------- */
-void
-initCapabilities( void )
-{
-#if defined(THREADED_RTS)
-    nat i;
-
-#ifndef REG_Base
-    // We can't support multiple CPUs if BaseReg is not a register
-    if (RtsFlags.ParFlags.nNodes > 1) {
-	errorBelch("warning: multiple CPUs not supported in this build, reverting to 1");
-	RtsFlags.ParFlags.nNodes = 1;
-    }
-#endif
-
-    n_capabilities = RtsFlags.ParFlags.nNodes;
-
-    if (n_capabilities == 1) {
-	capabilities = &MainCapability;
-	// THREADED_RTS must work on builds that don't have a mutable
-	// BaseReg (eg. unregisterised), so in this case
-	// capabilities[0] must coincide with &MainCapability.
-    } else {
-	capabilities = stgMallocBytes(n_capabilities * sizeof(Capability),
-				      "initCapabilities");
-    }
-
-    for (i = 0; i < n_capabilities; i++) {
-	initCapability(&capabilities[i], i);
-    }
-
-    IF_DEBUG(scheduler, sched_belch("allocated %d capabilities", 
-				    n_capabilities));
-
-#else /* !THREADED_RTS */
-
-    n_capabilities = 1;
-    capabilities = &MainCapability;
-    initCapability(&MainCapability, 0);
-
-#endif
-
-    // There are no free capabilities to begin with.  We will start
-    // a worker Task to each Capability, which will quickly put the
-    // Capability on the free list when it finds nothing to do.
-    last_free_capability = &capabilities[0];
-}
-
-/* ----------------------------------------------------------------------------
- * Give a Capability to a Task.  The task must currently be sleeping
- * on its condition variable.
- *
- * Requires cap->lock (modifies cap->running_task).
- *
- * When migrating a Task, the migrater must take task->lock before
- * modifying task->cap, to synchronise with the waking up Task.
- * Additionally, the migrater should own the Capability (when
- * migrating the run queue), or cap->lock (when migrating
- * returning_workers).
- *
- * ------------------------------------------------------------------------- */
-
-#if defined(THREADED_RTS)
-STATIC_INLINE void
-giveCapabilityToTask (Capability *cap USED_IF_DEBUG, Task *task)
-{
-    ASSERT_LOCK_HELD(&cap->lock);
-    ASSERT(task->cap == cap);
-    IF_DEBUG(scheduler,
-	     sched_belch("passing capability %d to %s %p",
-			 cap->no, task->tso ? "bound task" : "worker",
-			 (void *)task->id));
-    ACQUIRE_LOCK(&task->lock);
-    task->wakeup = rtsTrue;
-    // the wakeup flag is needed because signalCondition() doesn't
-    // flag the condition if the thread is already runniing, but we want
-    // it to be sticky.
-    signalCondition(&task->cond);
-    RELEASE_LOCK(&task->lock);
-}
-#endif
-
-/* ----------------------------------------------------------------------------
- * Function:  releaseCapability(Capability*)
- *
- * Purpose:   Letting go of a capability. Causes a
- *            'returning worker' thread or a 'waiting worker'
- *            to wake up, in that order.
- * ------------------------------------------------------------------------- */
-
-#if defined(THREADED_RTS)
-void
-releaseCapability_ (Capability* cap)
-{
-    Task *task;
-
-    task = cap->running_task;
-
-    ASSERT_PARTIAL_CAPABILITY_INVARIANTS(cap,task);
-
-    cap->running_task = NULL;
-
-    // Check to see whether a worker thread can be given
-    // the go-ahead to return the result of an external call..
-    if (cap->returning_tasks_hd != NULL) {
-	giveCapabilityToTask(cap,cap->returning_tasks_hd);
-	// The Task pops itself from the queue (see waitForReturnCapability())
-	return;
-    }
-
-    // If the next thread on the run queue is a bound thread,
-    // give this Capability to the appropriate Task.
-    if (!emptyRunQueue(cap) && cap->run_queue_hd->bound) {
-	// Make sure we're not about to try to wake ourselves up
-	ASSERT(task != cap->run_queue_hd->bound);
-	task = cap->run_queue_hd->bound;
-	giveCapabilityToTask(cap,task);
-	return;
-    }
-
-    if (!cap->spare_workers) {
-	// Create a worker thread if we don't have one.  If the system
-	// is interrupted, we only create a worker task if there
-	// are threads that need to be completed.  If the system is
-	// shutting down, we never create a new worker.
-	if (sched_state < SCHED_SHUTTING_DOWN || !emptyRunQueue(cap)) {
-	    IF_DEBUG(scheduler,
-		     sched_belch("starting new worker on capability %d", cap->no));
-	    startWorkerTask(cap, workerStart);
-	    return;
-	}
-    }
-
-    // If we have an unbound thread on the run queue, or if there's
-    // anything else to do, give the Capability to a worker thread.
-    if (!emptyRunQueue(cap) || !emptyWakeupQueue(cap)
-	      || !emptySparkPoolCap(cap) || globalWorkToDo()) {
-	if (cap->spare_workers) {
-	    giveCapabilityToTask(cap,cap->spare_workers);
-	    // The worker Task pops itself from the queue;
-	    return;
-	}
-    }
-
-    last_free_capability = cap;
-    IF_DEBUG(scheduler, sched_belch("freeing capability %d", cap->no));
-}
-
-void
-releaseCapability (Capability* cap USED_IF_THREADS)
-{
-    ACQUIRE_LOCK(&cap->lock);
-    releaseCapability_(cap);
-    RELEASE_LOCK(&cap->lock);
-}
-
-static void
-releaseCapabilityAndQueueWorker (Capability* cap USED_IF_THREADS)
-{
-    Task *task;
-
-    ACQUIRE_LOCK(&cap->lock);
-
-    task = cap->running_task;
-
-    // If the current task is a worker, save it on the spare_workers
-    // list of this Capability.  A worker can mark itself as stopped,
-    // in which case it is not replaced on the spare_worker queue.
-    // This happens when the system is shutting down (see
-    // Schedule.c:workerStart()).
-    // Also, be careful to check that this task hasn't just exited
-    // Haskell to do a foreign call (task->suspended_tso).
-    if (!isBoundTask(task) && !task->stopped && !task->suspended_tso) {
-	task->next = cap->spare_workers;
-	cap->spare_workers = task;
-    }
-    // Bound tasks just float around attached to their TSOs.
-
-    releaseCapability_(cap);
-
-    RELEASE_LOCK(&cap->lock);
-}
-#endif
-
-/* ----------------------------------------------------------------------------
- * waitForReturnCapability( Task *task )
- *
- * Purpose:  when an OS thread returns from an external call,
- * it calls waitForReturnCapability() (via Schedule.resumeThread())
- * to wait for permission to enter the RTS & communicate the
- * result of the external call back to the Haskell thread that
- * made it.
- *
- * ------------------------------------------------------------------------- */
-void
-waitForReturnCapability (Capability **pCap, Task *task)
-{
-#if !defined(THREADED_RTS)
-
-    MainCapability.running_task = task;
-    task->cap = &MainCapability;
-    *pCap = &MainCapability;
-
-#else
-    Capability *cap = *pCap;
-
-    if (cap == NULL) {
-	// Try last_free_capability first
-	cap = last_free_capability;
-	if (!cap->running_task) {
-	    nat i;
-	    // otherwise, search for a free capability
-	    for (i = 0; i < n_capabilities; i++) {
-		cap = &capabilities[i];
-		if (!cap->running_task) {
-		    break;
-		}
-	    }
-	    // Can't find a free one, use last_free_capability.
-	    cap = last_free_capability;
-	}
-
-	// record the Capability as the one this Task is now assocated with.
-	task->cap = cap;
-
-    } else {
-	ASSERT(task->cap == cap);
-    }
-
-    ACQUIRE_LOCK(&cap->lock);
-
-    IF_DEBUG(scheduler,
-	     sched_belch("returning; I want capability %d", cap->no));
-
-    if (!cap->running_task) {
-	// It's free; just grab it
-	cap->running_task = task;
-	RELEASE_LOCK(&cap->lock);
-    } else {
-	newReturningTask(cap,task);
-	RELEASE_LOCK(&cap->lock);
-
-	for (;;) {
-	    ACQUIRE_LOCK(&task->lock);
-	    // task->lock held, cap->lock not held
-	    if (!task->wakeup) waitCondition(&task->cond, &task->lock);
-	    cap = task->cap;
-	    task->wakeup = rtsFalse;
-	    RELEASE_LOCK(&task->lock);
-
-	    // now check whether we should wake up...
-	    ACQUIRE_LOCK(&cap->lock);
-	    if (cap->running_task == NULL) {
-		if (cap->returning_tasks_hd != task) {
-		    giveCapabilityToTask(cap,cap->returning_tasks_hd);
-		    RELEASE_LOCK(&cap->lock);
-		    continue;
-		}
-		cap->running_task = task;
-		popReturningTask(cap);
-		RELEASE_LOCK(&cap->lock);
-		break;
-	    }
-	    RELEASE_LOCK(&cap->lock);
-	}
-
-    }
-
-    ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
-
-    IF_DEBUG(scheduler,
-	     sched_belch("returning; got capability %d", cap->no));
-
-    *pCap = cap;
-#endif
-}
-
-#if defined(THREADED_RTS)
-/* ----------------------------------------------------------------------------
- * yieldCapability
- * ------------------------------------------------------------------------- */
-
-void
-yieldCapability (Capability** pCap, Task *task)
-{
-    Capability *cap = *pCap;
-
-    // The fast path has no locking, if we don't enter this while loop
-
-    while ( cap->returning_tasks_hd != NULL || !anyWorkForMe(cap,task) ) {
-	IF_DEBUG(scheduler, sched_belch("giving up capability %d", cap->no));
-
-	// We must now release the capability and wait to be woken up
-	// again.
-	task->wakeup = rtsFalse;
-	releaseCapabilityAndQueueWorker(cap);
-
-	for (;;) {
-	    ACQUIRE_LOCK(&task->lock);
-	    // task->lock held, cap->lock not held
-	    if (!task->wakeup) waitCondition(&task->cond, &task->lock);
-	    cap = task->cap;
-	    task->wakeup = rtsFalse;
-	    RELEASE_LOCK(&task->lock);
-
-	    IF_DEBUG(scheduler, sched_belch("woken up on capability %d", cap->no));
-	    ACQUIRE_LOCK(&cap->lock);
-	    if (cap->running_task != NULL) {
-		IF_DEBUG(scheduler, sched_belch("capability %d is owned by another task", cap->no));
-		RELEASE_LOCK(&cap->lock);
-		continue;
-	    }
-
-	    if (task->tso == NULL) {
-		ASSERT(cap->spare_workers != NULL);
-		// if we're not at the front of the queue, release it
-		// again.  This is unlikely to happen.
-		if (cap->spare_workers != task) {
-		    giveCapabilityToTask(cap,cap->spare_workers);
-		    RELEASE_LOCK(&cap->lock);
-		    continue;
-		}
-		cap->spare_workers = task->next;
-		task->next = NULL;
-	    }
-	    cap->running_task = task;
-	    RELEASE_LOCK(&cap->lock);
-	    break;
-	}
-
-	IF_DEBUG(scheduler, sched_belch("got capability %d", cap->no));
-	ASSERT(cap->running_task == task);
-    }
-
-    *pCap = cap;
-
-    ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
-
-    return;
-}
-
-/* ----------------------------------------------------------------------------
- * Wake up a thread on a Capability.
- *
- * This is used when the current Task is running on a Capability and
- * wishes to wake up a thread on a different Capability.
- * ------------------------------------------------------------------------- */
-
-void
-wakeupThreadOnCapability (Capability *cap, StgTSO *tso)
-{
-    ASSERT(tso->cap == cap);
-    ASSERT(tso->bound ? tso->bound->cap == cap : 1);
-
-    ACQUIRE_LOCK(&cap->lock);
-    if (cap->running_task == NULL) {
-	// nobody is running this Capability, we can add our thread
-	// directly onto the run queue and start up a Task to run it.
-	appendToRunQueue(cap,tso);
-
-	// start it up
-	cap->running_task = myTask(); // precond for releaseCapability_()
-	releaseCapability_(cap);
-    } else {
-	appendToWakeupQueue(cap,tso);
-	// someone is running on this Capability, so it cannot be
-	// freed without first checking the wakeup queue (see
-	// releaseCapability_).
-    }
-    RELEASE_LOCK(&cap->lock);
-}
-
-/* ----------------------------------------------------------------------------
- * prodCapabilities
- *
- * Used to indicate that the interrupted flag is now set, or some
- * other global condition that might require waking up a Task on each
- * Capability.
- * ------------------------------------------------------------------------- */
-
-static void
-prodCapabilities(rtsBool all)
-{
-    nat i;
-    Capability *cap;
-    Task *task;
-
-    for (i=0; i < n_capabilities; i++) {
-	cap = &capabilities[i];
-	ACQUIRE_LOCK(&cap->lock);
-	if (!cap->running_task) {
-	    if (cap->spare_workers) {
-		task = cap->spare_workers;
-		ASSERT(!task->stopped);
-		giveCapabilityToTask(cap,task);
-		if (!all) {
-		    RELEASE_LOCK(&cap->lock);
-		    return;
-		}
-	    }
-	}
-	RELEASE_LOCK(&cap->lock);
-    }
-    return;
-}
-
-void
-prodAllCapabilities (void)
-{
-    prodCapabilities(rtsTrue);
-}
-
-/* ----------------------------------------------------------------------------
- * prodOneCapability
- *
- * Like prodAllCapabilities, but we only require a single Task to wake
- * up in order to service some global event, such as checking for
- * deadlock after some idle time has passed.
- * ------------------------------------------------------------------------- */
-
-void
-prodOneCapability (void)
-{
-    prodCapabilities(rtsFalse);
-}
-
-/* ----------------------------------------------------------------------------
- * shutdownCapability
- *
- * At shutdown time, we want to let everything exit as cleanly as
- * possible.  For each capability, we let its run queue drain, and
- * allow the workers to stop.
- *
- * This function should be called when interrupted and
- * shutting_down_scheduler = rtsTrue, thus any worker that wakes up
- * will exit the scheduler and call taskStop(), and any bound thread
- * that wakes up will return to its caller.  Runnable threads are
- * killed.
- *
- * ------------------------------------------------------------------------- */
-
-void
-shutdownCapability (Capability *cap, Task *task)
-{
-    nat i;
-
-    ASSERT(sched_state == SCHED_SHUTTING_DOWN);
-
-    task->cap = cap;
-
-    for (i = 0; i < 50; i++) {
-	IF_DEBUG(scheduler, sched_belch("shutting down capability %d, attempt %d", cap->no, i));
-	ACQUIRE_LOCK(&cap->lock);
-	if (cap->running_task) {
-	    RELEASE_LOCK(&cap->lock);
-	    IF_DEBUG(scheduler, sched_belch("not owner, yielding"));
-	    yieldThread();
-	    continue;
-	}
-	cap->running_task = task;
-	if (!emptyRunQueue(cap) || cap->spare_workers) {
-	    IF_DEBUG(scheduler, sched_belch("runnable threads or workers still alive, yielding"));
-	    releaseCapability_(cap); // this will wake up a worker
-	    RELEASE_LOCK(&cap->lock);
-	    yieldThread();
-	    continue;
-	}
-	IF_DEBUG(scheduler, sched_belch("capability %d is stopped.", cap->no));
-	RELEASE_LOCK(&cap->lock);
-	break;
-    }
-    // we now have the Capability, its run queue and spare workers
-    // list are both empty.
-}
-
-/* ----------------------------------------------------------------------------
- * tryGrabCapability
- *
- * Attempt to gain control of a Capability if it is free.
- *
- * ------------------------------------------------------------------------- */
-
-rtsBool
-tryGrabCapability (Capability *cap, Task *task)
-{
-    if (cap->running_task != NULL) return rtsFalse;
-    ACQUIRE_LOCK(&cap->lock);
-    if (cap->running_task != NULL) {
-	RELEASE_LOCK(&cap->lock);
-	return rtsFalse;
-    }
-    task->cap = cap;
-    cap->running_task = task;
-    RELEASE_LOCK(&cap->lock);
-    return rtsTrue;
-}
-
-
-#endif /* THREADED_RTS */
-
-
diff --git a/ghc/rts/Capability.h b/ghc/rts/Capability.h
deleted file mode 100644
index a2551d0cc5..0000000000
--- a/ghc/rts/Capability.h
+++ /dev/null
@@ -1,250 +0,0 @@
-/* ---------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2001-2006
- *
- * Capabilities
- *
- * The notion of a capability is used when operating in multi-threaded
- * environments (which the THREADED_RTS build of the RTS does), to
- * hold all the state an OS thread/task needs to run Haskell code:
- * its STG registers, a pointer to its  TSO, a nursery etc. During
- * STG execution, a pointer to the capabilitity is kept in a 
- * register (BaseReg).
- *
- * Only in an THREADED_RTS build will there be multiple capabilities,
- * in the non-threaded builds there is one global capability, namely
- * MainCapability.
- *
- * This header file contains the functions for working with capabilities.
- * (the main, and only, consumer of this interface is the scheduler).
- * 
- * --------------------------------------------------------------------------*/
-
-#ifndef CAPABILITY_H
-#define CAPABILITY_H
-
-#include "RtsFlags.h"
-#include "Task.h"
-
-struct Capability_ {
-    // State required by the STG virtual machine when running Haskell
-    // code.  During STG execution, the BaseReg register always points
-    // to the StgRegTable of the current Capability (&cap->r).
-    StgFunTable f;
-    StgRegTable r;
-
-    nat no;  // capability number.
-
-    // The Task currently holding this Capability.  This task has
-    // exclusive access to the contents of this Capability (apart from
-    // returning_tasks_hd/returning_tasks_tl).
-    // Locks required: cap->lock.
-    Task *running_task;
-
-    // true if this Capability is running Haskell code, used for
-    // catching unsafe call-ins.
-    rtsBool in_haskell;
-
-    // The run queue.  The Task owning this Capability has exclusive
-    // access to its run queue, so can wake up threads without
-    // taking a lock, and the common path through the scheduler is
-    // also lock-free.
-    StgTSO *run_queue_hd;
-    StgTSO *run_queue_tl;
-
-    // Tasks currently making safe foreign calls.  Doubly-linked.
-    // When returning, a task first acquires the Capability before
-    // removing itself from this list, so that the GC can find all
-    // the suspended TSOs easily.  Hence, when migrating a Task from
-    // the returning_tasks list, we must also migrate its entry from
-    // this list.
-    Task *suspended_ccalling_tasks;
-
-    // One mutable list per generation, so we don't need to take any
-    // locks when updating an old-generation thunk.  These
-    // mini-mut-lists are moved onto the respective gen->mut_list at
-    // each GC.
-    bdescr **mut_lists;
-
-#if defined(THREADED_RTS)
-    // Worker Tasks waiting in the wings.  Singly-linked.
-    Task *spare_workers;
-
-    // This lock protects running_task, returning_tasks_{hd,tl}, wakeup_queue.
-    Mutex lock;
-
-    // Tasks waiting to return from a foreign call, or waiting to make
-    // a new call-in using this Capability (NULL if empty).
-    // NB. this field needs to be modified by tasks other than the
-    // running_task, so it requires cap->lock to modify.  A task can
-    // check whether it is NULL without taking the lock, however.
-    Task *returning_tasks_hd; // Singly-linked, with head/tail
-    Task *returning_tasks_tl;
-
-    // A list of threads to append to this Capability's run queue at
-    // the earliest opportunity.  These are threads that have been
-    // woken up by another Capability.
-    StgTSO *wakeup_queue_hd;
-    StgTSO *wakeup_queue_tl;
-#endif
-
-    // Per-capability STM-related data
-    StgTVarWaitQueue *free_tvar_wait_queues;
-    StgTRecChunk *free_trec_chunks;
-    StgTRecHeader *free_trec_headers;
-    nat transaction_tokens;
-}; // typedef Capability, defined in RtsAPI.h
-
-
-#if defined(THREADED_RTS)
-#define ASSERT_TASK_ID(task) ASSERT(task->id == osThreadId())
-#else
-#define ASSERT_TASK_ID(task) /*empty*/
-#endif
-
-// These properties should be true when a Task is holding a Capability
-#define ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task)			\
-  ASSERT(cap->running_task != NULL && cap->running_task == task);	\
-  ASSERT(task->cap == cap);						\
-  ASSERT_PARTIAL_CAPABILITY_INVARIANTS(cap,task)
-
-// Sometimes a Task holds a Capability, but the Task is not associated
-// with that Capability (ie. task->cap != cap).  This happens when
-// (a) a Task holds multiple Capabilities, and (b) when the current
-// Task is bound, its thread has just blocked, and it may have been
-// moved to another Capability.
-#define ASSERT_PARTIAL_CAPABILITY_INVARIANTS(cap,task)	\
-  ASSERT(cap->run_queue_hd == END_TSO_QUEUE ?		\
-	    cap->run_queue_tl == END_TSO_QUEUE : 1);	\
-  ASSERT(myTask() == task);				\
-  ASSERT_TASK_ID(task);
-
-// Converts a *StgRegTable into a *Capability.
-//
-INLINE_HEADER Capability *
-regTableToCapability (StgRegTable *reg)
-{
-    return (Capability *)((void *)((unsigned char*)reg - sizeof(StgFunTable)));
-}
-
-// Initialise the available capabilities.
-//
-void initCapabilities (void);
-
-// Release a capability.  This is called by a Task that is exiting
-// Haskell to make a foreign call, or in various other cases when we
-// want to relinquish a Capability that we currently hold.
-//
-// ASSUMES: cap->running_task is the current Task.
-//
-#if defined(THREADED_RTS)
-void releaseCapability  (Capability* cap);
-void releaseCapability_ (Capability* cap); // assumes cap->lock is held
-#else
-// releaseCapability() is empty in non-threaded RTS
-INLINE_HEADER void releaseCapability  (Capability* cap STG_UNUSED) {};
-INLINE_HEADER void releaseCapability_ (Capability* cap STG_UNUSED) {};
-#endif
-
-#if !IN_STG_CODE
-// one global capability
-extern Capability MainCapability; 
-#endif
-
-// Array of all the capabilities
-//
-extern nat n_capabilities;
-extern Capability *capabilities;
-
-// The Capability that was last free.  Used as a good guess for where
-// to assign new threads.
-//
-extern Capability *last_free_capability;
-
-// Acquires a capability at a return point.  If *cap is non-NULL, then
-// this is taken as a preference for the Capability we wish to
-// acquire.
-//
-// OS threads waiting in this function get priority over those waiting
-// in waitForCapability().
-//
-// On return, *cap is non-NULL, and points to the Capability acquired.
-//
-void waitForReturnCapability (Capability **cap/*in/out*/, Task *task);
-
-INLINE_HEADER void recordMutableCap (StgClosure *p, Capability *cap, nat gen);
-
-#if defined(THREADED_RTS)
-
-// Gives up the current capability IFF there is a higher-priority
-// thread waiting for it.  This happens in one of two ways:
-//
-//   (a) we are passing the capability to another OS thread, so
-//       that it can run a bound Haskell thread, or
-//
-//   (b) there is an OS thread waiting to return from a foreign call
-//
-// On return: *pCap is NULL if the capability was released.  The
-// current task should then re-acquire it using waitForCapability().
-//
-void yieldCapability (Capability** pCap, Task *task);
-
-// Acquires a capability for doing some work.
-//
-// On return: pCap points to the capability.
-//
-void waitForCapability (Task *task, Mutex *mutex, Capability **pCap);
-
-// Wakes up a thread on a Capability (probably a different Capability
-// from the one held by the current Task).
-//
-void wakeupThreadOnCapability (Capability *cap, StgTSO *tso);
-
-// Wakes up a worker thread on just one Capability, used when we
-// need to service some global event.
-//
-void prodOneCapability (void);
-
-// Similar to prodOneCapability(), but prods all of them.
-//
-void prodAllCapabilities (void);
-
-// Waits for a capability to drain of runnable threads and workers,
-// and then acquires it.  Used at shutdown time.
-//
-void shutdownCapability (Capability *cap, Task *task);
-
-// Attempt to gain control of a Capability if it is free.
-//
-rtsBool tryGrabCapability (Capability *cap, Task *task);
-
-#else // !THREADED_RTS
-
-// Grab a capability.  (Only in the non-threaded RTS; in the threaded
-// RTS one of the waitFor*Capability() functions must be used).
-//
-extern void grabCapability (Capability **pCap);
-
-#endif /* !THREADED_RTS */
-
-/* -----------------------------------------------------------------------------
- * INLINE functions... private below here
- * -------------------------------------------------------------------------- */
-
-INLINE_HEADER void
-recordMutableCap (StgClosure *p, Capability *cap, nat gen)
-{
-    bdescr *bd;
-
-    bd = cap->mut_lists[gen];
-    if (bd->free >= bd->start + BLOCK_SIZE_W) {
-	bdescr *new_bd;
-	new_bd = allocBlock_lock();
-	new_bd->link = bd;
-	bd = new_bd;
-	cap->mut_lists[gen] = bd;
-    }
-    *bd->free++ = (StgWord)p;
-}
-
-#endif /* CAPABILITY_H */
diff --git a/ghc/rts/ClosureFlags.c b/ghc/rts/ClosureFlags.c
deleted file mode 100644
index 5545693362..0000000000
--- a/ghc/rts/ClosureFlags.c
+++ /dev/null
@@ -1,107 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1998-1999
- *
- * Closure type flags
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-
-StgWord16 closure_flags[] = {
-
-/* 
- * These *must* be in the same order as the closure types in
- * ClosureTypes.h.
- */
-
-/* ToDo: some of these flags seem to be duplicated.
- *       - NS is the same as HNF, and the negation of THU
- * (however, we set NS for indirections, which is probably the
- *  right thing to do, since we never get indirections pointing
- *  to thunks.)
- */
-
-/*                              0    1    2    3    4   5   6   7 */
-/*			      HNF  BTM   NS  STA  THU MUT UPT SRT */
-
-/* INVALID_OBJECT       = */ ( 0                                      	 ),
-/* CONSTR  		= */ (_HNF|     _NS                           	 ),
-/* CONSTR_1_0	   	= */ (_HNF|     _NS                           	 ),
-/* CONSTR_0_1	   	= */ (_HNF|     _NS                           	 ),
-/* CONSTR_2_0	   	= */ (_HNF|     _NS                           	 ),
-/* CONSTR_1_1	   	= */ (_HNF|     _NS                           	 ),
-/* CONSTR_0_2	   	= */ (_HNF|     _NS                           	 ),
-/* CONSTR_INTLIKE 	= */ (_HNF|     _NS|_STA                      	 ),
-/* CONSTR_CHARLIKE  	= */ (_HNF|     _NS|_STA                      	 ),
-/* CONSTR_STATIC	= */ (_HNF|     _NS|_STA                      	 ),
-/* CONSTR_NOCAF_STATIC  = */ (_HNF|     _NS|_STA                      	 ),
-/* FUN		   	= */ (_HNF|     _NS|                  _SRT    	 ),
-/* FUN_1_0		= */ (_HNF|     _NS|		      _SRT       ),
-/* FUN_0_1		= */ (_HNF|     _NS|		      _SRT       ),
-/* FUN_2_0		= */ (_HNF|     _NS|		      _SRT       ),
-/* FUN_1_1		= */ (_HNF|     _NS|		      _SRT       ),
-/* FUN_0_2		= */ (_HNF|     _NS|		      _SRT       ),
-/* FUN_STATIC	   	= */ (_HNF|     _NS|_STA|             _SRT    	 ),
-/* THUNK		= */ (     _BTM|         _THU|        _SRT    	 ),
-/* THUNK_1_0		= */ (     _BTM|         _THU|        _SRT    	 ),
-/* THUNK_0_1		= */ (     _BTM|         _THU|        _SRT    	 ),
-/* THUNK_2_0		= */ (     _BTM|         _THU|        _SRT    	 ),
-/* THUNK_1_1		= */ (     _BTM|         _THU|        _SRT    	 ),
-/* THUNK_0_2		= */ (     _BTM|         _THU|        _SRT    	 ),
-/* THUNK_STATIC	   	= */ (     _BTM|    _STA|_THU|        _SRT    	 ),
-/* THUNK_SELECTOR	= */ (     _BTM|         _THU|        _SRT    	 ),
-/* BCO		   	= */ (_HNF|     _NS                           	 ),
-/* AP			= */ (                   _THU                 	 ),
-/* PAP		   	= */ (_HNF|     _NS				 ),
-/* AP_STACK	   	= */ (          	 _THU			 ),
-/* IND		   	= */ (          _NS|			    _IND ),
-/* IND_OLDGEN	   	= */ (          _NS|			    _IND ),
-/* IND_PERM		= */ (          _NS|			    _IND ),
-/* IND_OLDGEN_PERM	= */ (          _NS|			    _IND ),
-/* IND_STATIC	   	= */ (          _NS|_STA|                   _IND ),
-/* RET_BCO		= */ (     _BTM                                  ),
-/* RET_SMALL		= */ (     _BTM|                       _SRT      ),
-/* RET_VEC_SMALL	= */ (     _BTM|                       _SRT      ),
-/* RET_BIG		= */ (                                 _SRT      ),
-/* RET_VEC_BIG	   	= */ (                                 _SRT      ),
-/* RET_DYN		= */ (                                 _SRT      ),
-/* RET_FUN		= */ ( 0                                         ),
-/* UPDATE_FRAME        	= */ (     _BTM                                  ),
-/* CATCH_FRAME	   	= */ (     _BTM                                  ),
-/* STOP_FRAME	   	= */ (     _BTM                                  ),
-/* CAF_BLACKHOLE   	= */ ( 	   _BTM|_NS|              _UPT           ),
-/* BLACKHOLE		= */ ( 	        _NS|              _UPT           ),
-/* SE_BLACKHOLE		= */ ( 	        _NS|              _UPT           ),
-/* SE_CAF_BLACKHOLE	= */ ( 	        _NS|              _UPT           ),
-/* MVAR		   	= */ (_HNF|     _NS|         _MUT|_UPT           ),
-/* ARR_WORDS		= */ (_HNF|     _NS|              _UPT           ),
-/* MUT_ARR_PTRS_CLEAN  	= */ (_HNF|     _NS|         _MUT|_UPT           ),
-/* MUT_ARR_PTRS_DIRTY  	= */ (_HNF|     _NS|         _MUT|_UPT           ),
-/* MUT_ARR_PTRS_FROZEN0	= */ (_HNF|     _NS|         _MUT|_UPT           ),
-/* MUT_ARR_PTRS_FROZEN 	= */ (_HNF|     _NS|              _UPT           ),
-/* MUT_VAR_CLEAN	= */ (_HNF|     _NS|         _MUT|_UPT           ),
-/* MUT_VAR_DIRTY	= */ (_HNF|     _NS|         _MUT|_UPT           ),
-/* WEAK		   	= */ (_HNF|     _NS|              _UPT           ),
-/* STABLE_NAME	   	= */ (_HNF|     _NS|              _UPT           ),
-/* TSO                 	= */ (_HNF|     _NS|         _MUT|_UPT           ),
-/* BLOCKED_FETCH	= */ (_HNF|     _NS|         _MUT|_UPT           ),
-/* FETCH_ME		= */ (_HNF|     _NS|         _MUT|_UPT           ),
-/* FETCH_ME_BQ          = */ ( 	        _NS|         _MUT|_UPT           ),
-/* RBH                  = */ ( 	        _NS|         _MUT|_UPT           ),
-/* EVACUATED		= */ ( 0                                         ),
-/* REMOTE_REF		= */ (_HNF|     _NS|              _UPT           ),
-/* TVAR_WAIT_QUEUE      = */ (          _NS|         _MUT|_UPT           ),
-/* TVAR                 = */ (_HNF|     _NS|         _MUT|_UPT           ), 
-/* TREC_CHUNK           = */ (          _NS|         _MUT|_UPT           ),
-/* TREC_HEADER          = */ (          _NS|         _MUT|_UPT           ),
-/* ATOMICALLY_FRAME     = */ (     _BTM                                  ),
-/* CATCH_RETRY_FRAME    = */ (     _BTM                                  ),
-/* CATCH_STM_FRAME      = */ (     _BTM                                  )
-};
-
-#if N_CLOSURE_TYPES != 73
-#error Closure types changed: update ClosureFlags.c!
-#endif
-
diff --git a/ghc/rts/Disassembler.c b/ghc/rts/Disassembler.c
deleted file mode 100644
index b084a29b89..0000000000
--- a/ghc/rts/Disassembler.c
+++ /dev/null
@@ -1,281 +0,0 @@
-/* -----------------------------------------------------------------------------
- * Bytecode disassembler
- *
- * Copyright (c) 1994-2002.
- *
- * $RCSfile: Disassembler.c,v $
- * $Revision: 1.29 $
- * $Date: 2004/09/03 15:28:19 $
- * ---------------------------------------------------------------------------*/
-
-#ifdef DEBUG
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsAPI.h"
-#include "RtsUtils.h"
-#include "Closures.h"
-#include "TSO.h"
-#include "Schedule.h"
-
-#include "Bytecodes.h"
-#include "Printer.h"
-#include "Disassembler.h"
-#include "Interpreter.h"
-
-/* --------------------------------------------------------------------------
- * Disassembler
- * ------------------------------------------------------------------------*/
-
-int
-disInstr ( StgBCO *bco, int pc )
-{
-   int i;
-
-   StgWord16*     instrs      = (StgWord16*)(bco->instrs->payload);
-
-   StgArrWords*   literal_arr = bco->literals;
-   StgWord*       literals    = (StgWord*)(&literal_arr->payload[0]);
-
-   StgMutArrPtrs* ptrs_arr    = bco->ptrs;
-   StgPtr*        ptrs        = (StgPtr*)(&ptrs_arr->payload[0]);
-
-   StgArrWords*   itbls_arr   = bco->itbls;
-   StgInfoTable** itbls       = (StgInfoTable**)(&itbls_arr->payload[0]);
-
-   switch (instrs[pc++]) {
-      case bci_SWIZZLE:
-         debugBelch("SWIZZLE stkoff %d by %d\n",
-                         instrs[pc], (signed int)instrs[pc+1]);
-         pc += 2; break;
-      case bci_CCALL:
-         debugBelch("CCALL    marshaller at 0x%x\n", 
-                         literals[instrs[pc]] );
-         pc += 1; break;
-      case bci_STKCHECK: 
-         debugBelch("STKCHECK %d\n", instrs[pc] );
-         pc += 1; break;
-      case bci_PUSH_L: 
-         debugBelch("PUSH_L   %d\n", instrs[pc] );
-         pc += 1; break;
-      case bci_PUSH_LL:
-         debugBelch("PUSH_LL  %d %d\n", instrs[pc], instrs[pc+1] ); 
-         pc += 2; break;
-      case bci_PUSH_LLL:
-         debugBelch("PUSH_LLL %d %d %d\n", instrs[pc], instrs[pc+1], 
-                                                            instrs[pc+2] ); 
-         pc += 3; break;
-      case bci_PUSH_G:
-         debugBelch("PUSH_G   " ); printPtr( ptrs[instrs[pc]] );
-         debugBelch("\n" );
-         pc += 1; break;
-
-      case bci_PUSH_ALTS:
-         debugBelch("PUSH_ALTS  " ); printPtr( ptrs[instrs[pc]] );
-         debugBelch("\n");
-         pc += 1; break;
-      case bci_PUSH_ALTS_P:
-         debugBelch("PUSH_ALTS_P  " ); printPtr( ptrs[instrs[pc]] );
-         debugBelch("\n");
-         pc += 1; break;
-      case bci_PUSH_ALTS_N:
-         debugBelch("PUSH_ALTS_N  " ); printPtr( ptrs[instrs[pc]] );
-         debugBelch("\n");
-         pc += 1; break;
-      case bci_PUSH_ALTS_F:
-         debugBelch("PUSH_ALTS_F  " ); printPtr( ptrs[instrs[pc]] );
-         debugBelch("\n");
-         pc += 1; break;
-      case bci_PUSH_ALTS_D:
-         debugBelch("PUSH_ALTS_D  " ); printPtr( ptrs[instrs[pc]] );
-         debugBelch("\n");
-         pc += 1; break;
-      case bci_PUSH_ALTS_L:
-         debugBelch("PUSH_ALTS_L  " ); printPtr( ptrs[instrs[pc]] );
-         debugBelch("\n");
-         pc += 1; break;
-      case bci_PUSH_ALTS_V:
-         debugBelch("PUSH_ALTS_V  " ); printPtr( ptrs[instrs[pc]] );
-         debugBelch("\n");
-         pc += 1; break;
-
-      case bci_PUSH_UBX:
-         debugBelch("PUSH_UBX ");
-         for (i = 0; i < instrs[pc+1]; i++) 
-            debugBelch("0x%x ", literals[i + instrs[pc]] );
-         debugBelch("\n");
-         pc += 2; break;
-      case bci_PUSH_APPLY_N:
-	  debugBelch("PUSH_APPLY_N\n");
-	  break;
-      case bci_PUSH_APPLY_V:
-	  debugBelch("PUSH_APPLY_V\n");
-	  break;
-      case bci_PUSH_APPLY_F:
-	  debugBelch("PUSH_APPLY_F\n");
-	  break;
-      case bci_PUSH_APPLY_D:
-	  debugBelch("PUSH_APPLY_D\n");
-	  break;
-      case bci_PUSH_APPLY_L:
-	  debugBelch("PUSH_APPLY_L\n");
-	  break;
-      case bci_PUSH_APPLY_P:
-	  debugBelch("PUSH_APPLY_P\n");
-	  break;
-      case bci_PUSH_APPLY_PP:
-	  debugBelch("PUSH_APPLY_PP\n");
-	  break;
-      case bci_PUSH_APPLY_PPP:
-	  debugBelch("PUSH_APPLY_PPP\n");
-	  break;
-      case bci_PUSH_APPLY_PPPP:
-	  debugBelch("PUSH_APPLY_PPPP\n");
-	  break;
-      case bci_PUSH_APPLY_PPPPP:
-	  debugBelch("PUSH_APPLY_PPPPP\n");
-	  break;
-      case bci_PUSH_APPLY_PPPPPP:
-	  debugBelch("PUSH_APPLY_PPPPPP\n");
-	  break;
-      case bci_SLIDE: 
-         debugBelch("SLIDE     %d down by %d\n", instrs[pc], instrs[pc+1] );
-         pc += 2; break;
-      case bci_ALLOC_AP:
-         debugBelch("ALLOC_AP  %d words\n", instrs[pc] );
-         pc += 1; break;
-      case bci_ALLOC_PAP:
-         debugBelch("ALLOC_PAP %d words, %d arity\n",
-		 instrs[pc], instrs[pc+1] );
-         pc += 2; break;
-      case bci_MKAP:
-         debugBelch("MKAP      %d words, %d stkoff\n", instrs[pc+1], 
-                                                           instrs[pc] );
-         pc += 2; break;
-      case bci_UNPACK:
-         debugBelch("UNPACK    %d\n", instrs[pc] );
-         pc += 1; break;
-      case bci_PACK:
-         debugBelch("PACK      %d words with itbl ", instrs[pc+1] );
-         printPtr( (StgPtr)itbls[instrs[pc]] );
-         debugBelch("\n");
-         pc += 2; break;
-
-      case bci_TESTLT_I:
-         debugBelch("TESTLT_I  %d, fail to %d\n", literals[instrs[pc]],
-                                                      instrs[pc+1]);
-         pc += 2; break;
-      case bci_TESTEQ_I:
-         debugBelch("TESTEQ_I  %d, fail to %d\n", literals[instrs[pc]],
-                                                      instrs[pc+1]);
-         pc += 2; break;
-
-      case bci_TESTLT_F:
-         debugBelch("TESTLT_F  %d, fail to %d\n", literals[instrs[pc]],
-                                                      instrs[pc+1]);
-         pc += 2; break;
-      case bci_TESTEQ_F:
-         debugBelch("TESTEQ_F  %d, fail to %d\n", literals[instrs[pc]],
-                                                      instrs[pc+1]);
-         pc += 2; break;
-
-      case bci_TESTLT_D:
-         debugBelch("TESTLT_D  %d, fail to %d\n", literals[instrs[pc]],
-                                                      instrs[pc+1]);
-         pc += 2; break;
-      case bci_TESTEQ_D:
-         debugBelch("TESTEQ_D  %d, fail to %d\n", literals[instrs[pc]],
-                                                      instrs[pc+1]);
-         pc += 2; break;
-
-      case bci_TESTLT_P:
-         debugBelch("TESTLT_P  %d, fail to %d\n", instrs[pc],
-                                                      instrs[pc+1]);
-         pc += 2; break;
-      case bci_TESTEQ_P:
-         debugBelch("TESTEQ_P  %d, fail to %d\n", instrs[pc],
-                                                      instrs[pc+1]);
-         pc += 2; break;
-      case bci_CASEFAIL: 
-         debugBelch("CASEFAIL\n" );
-         break;
-      case bci_JMP:
-         debugBelch("JMP to    %d\n", instrs[pc]);
-         pc += 1; break;
-
-      case bci_ENTER:
-         debugBelch("ENTER\n");
-         break;
-
-      case bci_RETURN:
-         debugBelch("RETURN\n" );
-	 break;
-      case bci_RETURN_P:
-         debugBelch("RETURN_P\n" );
-	 break;
-      case bci_RETURN_N:
-         debugBelch("RETURN_N\n" );
-	 break;
-      case bci_RETURN_F:
-         debugBelch("RETURN_F\n" );
-	 break;
-      case bci_RETURN_D:
-         debugBelch("RETURN_D\n" );
-	 break;
-      case bci_RETURN_L:
-         debugBelch("RETURN_L\n" );
-	 break;
-      case bci_RETURN_V:
-         debugBelch("RETURN_V\n" );
-	 break;
-
-      default:
-         barf("disInstr: unknown opcode");
-   }
-   return pc;
-}
-
-
-/* Something of a kludge .. how do we know where the end of the insn
-   array is, since it isn't recorded anywhere?  Answer: the first
-   short is the number of bytecodes which follow it.  
-   See ByteCodeGen.linkBCO.insns_arr for construction ...  
-*/
-void disassemble( StgBCO *bco )
-{
-   nat i, j;
-   StgWord16*     instrs    = (StgWord16*)(bco->instrs->payload);
-   StgMutArrPtrs* ptrs      = bco->ptrs;
-   nat            nbcs      = (int)instrs[0];
-   nat            pc        = 1;
-
-   debugBelch("BCO\n" );
-   pc = 1;
-   while (pc <= nbcs) {
-      debugBelch("\t%2d:  ", pc );
-      pc = disInstr ( bco, pc );
-   }
-
-   debugBelch("INSTRS:\n   " );
-   j = 16;
-   for (i = 0; i < nbcs; i++) {
-      debugBelch("%3d ", (int)instrs[i] );
-      j--; 
-      if (j == 0) { j = 16; debugBelch("\n   "); };
-   }
-   debugBelch("\n");
-
-   debugBelch("PTRS:\n   " );
-   j = 8;
-   for (i = 0; i < ptrs->ptrs; i++) {
-      debugBelch("%8p ", ptrs->payload[i] );
-      j--; 
-      if (j == 0) { j = 8; debugBelch("\n   "); };
-   }
-   debugBelch("\n");
-
-   debugBelch("\n");
-   ASSERT(pc == nbcs+1);
-}
-
-#endif /* DEBUG */
diff --git a/ghc/rts/Disassembler.h b/ghc/rts/Disassembler.h
deleted file mode 100644
index 2851097117..0000000000
--- a/ghc/rts/Disassembler.h
+++ /dev/null
@@ -1,19 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Prototypes for functions in Disassembler.c
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef DISASSEMBLER_H
-#define DISASSEMBLER_H
-
-#ifdef DEBUG
-
-extern int  disInstr   ( StgBCO *bco, int pc );
-extern void disassemble( StgBCO *bco );
-
-#endif
-
-#endif /* DISASSEMBLER_H */
diff --git a/ghc/rts/Exception.cmm b/ghc/rts/Exception.cmm
deleted file mode 100644
index b5c29626b2..0000000000
--- a/ghc/rts/Exception.cmm
+++ /dev/null
@@ -1,446 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Exception support
- *
- * This file is written in a subset of C--, extended with various
- * features specific to GHC.  It is compiled by GHC directly.  For the
- * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Cmm.h"
-
-/* -----------------------------------------------------------------------------
-   Exception Primitives
-
-   A thread can request that asynchronous exceptions not be delivered
-   ("blocked") for the duration of an I/O computation.  The primitive
-   
-	blockAsyncExceptions# :: IO a -> IO a
-
-   is used for this purpose.  During a blocked section, asynchronous
-   exceptions may be unblocked again temporarily:
-
-	unblockAsyncExceptions# :: IO a -> IO a
-
-   Furthermore, asynchronous exceptions are blocked automatically during
-   the execution of an exception handler.  Both of these primitives
-   leave a continuation on the stack which reverts to the previous
-   state (blocked or unblocked) on exit.
-
-   A thread which wants to raise an exception in another thread (using
-   killThread#) must block until the target thread is ready to receive
-   it.  The action of unblocking exceptions in a thread will release all
-   the threads waiting to deliver exceptions to that thread.
-
-   NB. there's a bug in here.  If a thread is inside an
-   unsafePerformIO, and inside blockAsyncExceptions# (there is an
-   unblockAsyncExceptions_ret on the stack), and it is blocked in an
-   interruptible operation, and it receives an exception, then the
-   unsafePerformIO thunk will be updated with a stack object
-   containing the unblockAsyncExceptions_ret frame.  Later, when
-   someone else evaluates this thunk, the blocked exception state is
-   not restored, and the result is that unblockAsyncExceptions_ret
-   will attempt to unblock exceptions in the current thread, but it'll
-   find that the CurrentTSO->blocked_exceptions is NULL.  Hence, we
-   work around this by checking for NULL in awakenBlockedQueue().
-
-   -------------------------------------------------------------------------- */
-
-INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret,
- 		0/*framesize*/, 0/*bitmap*/, RET_SMALL )
-{
-    // Not true: see comments above
-    // ASSERT(StgTSO_blocked_exceptions(CurrentTSO) != NULL);
-#if defined(GRAN) || defined(PAR)
-    foreign "C" awakenBlockedQueue(MyCapability() "ptr", StgTSO_blocked_exceptions(CurrentTSO) "ptr", 
-				   NULL "ptr"); 
-#else
-    foreign "C" awakenBlockedQueue(MyCapability() "ptr", StgTSO_blocked_exceptions(CurrentTSO) "ptr");
-#endif
-    StgTSO_blocked_exceptions(CurrentTSO) = NULL;
-#ifdef REG_R1
-    Sp_adj(1);
-    jump %ENTRY_CODE(Sp(0));
-#else
-    Sp(1) = Sp(0);
-    Sp_adj(1);
-    jump %ENTRY_CODE(Sp(1));
-#endif
-}
-
-INFO_TABLE_RET( stg_blockAsyncExceptionszh_ret,
-  		0/*framesize*/, 0/*bitmap*/, RET_SMALL )
-{
-    // Not true: see comments above
-    // ASSERT(StgTSO_blocked_exceptions(CurrentTSO) == NULL);
-    StgTSO_blocked_exceptions(CurrentTSO) = END_TSO_QUEUE;
-#ifdef REG_R1
-    Sp_adj(1);
-    jump %ENTRY_CODE(Sp(0));
-#else
-    Sp(1) = Sp(0);
-    Sp_adj(1);
-    jump %ENTRY_CODE(Sp(1));
-#endif
-}
-
-blockAsyncExceptionszh_fast
-{
-    /* Args: R1 :: IO a */
-    STK_CHK_GEN( WDS(2)/* worst case */, R1_PTR, blockAsyncExceptionszh_fast);
-
-    if (StgTSO_blocked_exceptions(CurrentTSO) == NULL) {
-      StgTSO_blocked_exceptions(CurrentTSO) = END_TSO_QUEUE;
-      /* avoid growing the stack unnecessarily */
-      if (Sp(0) == stg_blockAsyncExceptionszh_ret_info) {
-	Sp_adj(1);
-      } else {
-	Sp_adj(-1);
-	Sp(0) = stg_unblockAsyncExceptionszh_ret_info;
-      }
-    }
-    TICK_UNKNOWN_CALL();
-    TICK_SLOW_CALL_v();
-    jump stg_ap_v_fast;
-}
-
-unblockAsyncExceptionszh_fast
-{
-    /* Args: R1 :: IO a */
-    STK_CHK_GEN( WDS(2), R1_PTR, unblockAsyncExceptionszh_fast);
-
-    if (StgTSO_blocked_exceptions(CurrentTSO) != NULL) {
-#if defined(GRAN) || defined(PAR)
-      foreign "C" awakenBlockedQueue(MyCapability() "ptr", StgTSO_blocked_exceptions(CurrentTSO) "ptr", 
-	          		     StgTSO_block_info(CurrentTSO) "ptr");
-#else
-      foreign "C" awakenBlockedQueue(MyCapability() "ptr", StgTSO_blocked_exceptions(CurrentTSO) "ptr");
-#endif
-      StgTSO_blocked_exceptions(CurrentTSO) = NULL;
-
-      /* avoid growing the stack unnecessarily */
-      if (Sp(0) == stg_unblockAsyncExceptionszh_ret_info) {
-	Sp_adj(1);
-      } else {
-	Sp_adj(-1);
-	Sp(0) = stg_blockAsyncExceptionszh_ret_info;
-      }
-    }
-    TICK_UNKNOWN_CALL();
-    TICK_SLOW_CALL_v();
-    jump stg_ap_v_fast;
-}
-
-
-#define interruptible(what_next) 		\
-        (   what_next == BlockedOnMVar		\
-         || what_next == BlockedOnException	\
-         || what_next == BlockedOnRead		\
-         || what_next == BlockedOnWrite		\
-         || what_next == BlockedOnDelay		\
-         || what_next == BlockedOnDoProc)
-
-killThreadzh_fast
-{
-  /* args: R1 = TSO to kill, R2 = Exception */
-
-  W_ why_blocked;
-
-  /* This thread may have been relocated.
-   * (see Schedule.c:threadStackOverflow)
-   */
- while:
-  if (StgTSO_what_next(R1) == ThreadRelocated::I16) {
-    R1 = StgTSO_link(R1);
-    goto while;
-  }
-
-  /* Determine whether this thread is interruptible or not */
-
-  /* If the target thread is currently blocking async exceptions,
-   * we'll have to block until it's ready to accept them.  The
-   * exception is interruptible threads - ie. those that are blocked
-   * on some resource.
-   */
-  why_blocked = TO_W_(StgTSO_why_blocked(R1));
-  if (StgTSO_blocked_exceptions(R1) != NULL && !interruptible(why_blocked))
-  {
-      StgTSO_link(CurrentTSO) = StgTSO_blocked_exceptions(R1);
-      StgTSO_blocked_exceptions(R1) = CurrentTSO;
-      
-      StgTSO_why_blocked(CurrentTSO) = BlockedOnException::I16;
-      StgTSO_block_info(CurrentTSO) = R1;
-      
-      BLOCK( R1_PTR & R2_PTR, killThreadzh_fast );
-  }
-
-  /* Killed threads turn into zombies, which might be garbage
-   * collected at a later date.  That's why we don't have to
-   * explicitly remove them from any queues they might be on.
-   */
-
-  /* We might have killed ourselves.  In which case, better be *very*
-   * careful.  If the exception killed us, then return to the scheduler.
-   * If the exception went to a catch frame, we'll just continue from
-   * the handler.
-   */
-  if (R1 == CurrentTSO) {
-	SAVE_THREAD_STATE();
-	foreign "C" raiseAsync(MyCapability() "ptr", R1 "ptr", R2 "ptr");
-	if (StgTSO_what_next(CurrentTSO) == ThreadKilled::I16) {
-		R1 = ThreadFinished;
-		jump StgReturn;
-	} else {
-		LOAD_THREAD_STATE();
-		ASSERT(StgTSO_what_next(CurrentTSO) == ThreadRunGHC::I16);
-		jump %ENTRY_CODE(Sp(0));
-	}
-  } else {
-	foreign "C" raiseAsync(MyCapability() "ptr", R1 "ptr", R2 "ptr");
-  }
-
-  jump %ENTRY_CODE(Sp(0));
-}
-
-/* -----------------------------------------------------------------------------
-   Catch frames
-   -------------------------------------------------------------------------- */
-
-#ifdef REG_R1
-#define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) 	\
-   label					\
-   {						\
-      Sp = Sp + SIZEOF_StgCatchFrame; 		\
-      jump ret;					\
-   }
-#else
-#define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) 	\
-   label					\
-   {						\
-      W_ rval;					\
-      rval = Sp(0);				\
-      Sp = Sp + SIZEOF_StgCatchFrame;		\
-      Sp(0) = rval;				\
-      jump ret;					\
-   }
-#endif
-
-#ifdef REG_R1
-#define SP_OFF 0
-#else
-#define SP_OFF 1
-#endif
-
-CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_0_ret,%RET_VEC(Sp(SP_OFF),0))
-CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_1_ret,%RET_VEC(Sp(SP_OFF),1))
-CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_2_ret,%RET_VEC(Sp(SP_OFF),2))
-CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_3_ret,%RET_VEC(Sp(SP_OFF),3))
-CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_4_ret,%RET_VEC(Sp(SP_OFF),4))
-CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_5_ret,%RET_VEC(Sp(SP_OFF),5))
-CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_6_ret,%RET_VEC(Sp(SP_OFF),6))
-CATCH_FRAME_ENTRY_TEMPLATE(stg_catch_frame_7_ret,%RET_VEC(Sp(SP_OFF),7))
-
-#if MAX_VECTORED_RTN > 8
-#error MAX_VECTORED_RTN has changed: please modify stg_catch_frame too.
-#endif
-
-#if defined(PROFILING)
-#define CATCH_FRAME_BITMAP 7
-#define CATCH_FRAME_WORDS  4
-#else
-#define CATCH_FRAME_BITMAP 1
-#define CATCH_FRAME_WORDS  2
-#endif
-
-/* Catch frames are very similar to update frames, but when entering
- * one we just pop the frame off the stack and perform the correct
- * kind of return to the activation record underneath us on the stack.
- */
-
-INFO_TABLE_RET(stg_catch_frame,
-	       CATCH_FRAME_WORDS, CATCH_FRAME_BITMAP,
-	       CATCH_FRAME,
-	       stg_catch_frame_0_ret,
-	       stg_catch_frame_1_ret,
-	       stg_catch_frame_2_ret,
-	       stg_catch_frame_3_ret,
-	       stg_catch_frame_4_ret,
-	       stg_catch_frame_5_ret,
-	       stg_catch_frame_6_ret,
-	       stg_catch_frame_7_ret)
-CATCH_FRAME_ENTRY_TEMPLATE(,%ENTRY_CODE(Sp(SP_OFF)))
-
-/* -----------------------------------------------------------------------------
- * The catch infotable
- *
- * This should be exactly the same as would be generated by this STG code
- *
- * catch = {x,h} \n {} -> catch#{x,h}
- *
- * It is used in deleteThread when reverting blackholes.
- * -------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_catch,2,0,FUN,"catch","catch")
-{
-  R2 = StgClosure_payload(R1,1); /* h */
-  R1 = StgClosure_payload(R1,0); /* x */
-  jump catchzh_fast;
-}
-
-catchzh_fast
-{
-    /* args: R1 = m :: IO a, R2 = handler :: Exception -> IO a */
-    STK_CHK_GEN(SIZEOF_StgCatchFrame + WDS(1), R1_PTR & R2_PTR, catchzh_fast);
-  
-    /* Set up the catch frame */
-    Sp = Sp - SIZEOF_StgCatchFrame;
-    SET_HDR(Sp,stg_catch_frame_info,W_[CCCS]);
-    
-    StgCatchFrame_handler(Sp) = R2;
-    StgCatchFrame_exceptions_blocked(Sp) = 
-	(StgTSO_blocked_exceptions(CurrentTSO) != NULL);
-    TICK_CATCHF_PUSHED();
-
-    /* Apply R1 to the realworld token */
-    TICK_UNKNOWN_CALL();
-    TICK_SLOW_CALL_v();
-    jump stg_ap_v_fast;
-}      
-
-/* -----------------------------------------------------------------------------
- * The raise infotable
- * 
- * This should be exactly the same as would be generated by this STG code
- *
- *   raise = {err} \n {} -> raise#{err}
- *
- * It is used in raisezh_fast to update thunks on the update list
- * -------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_raise,1,0,THUNK_1_0,"raise","raise")
-{
-  R1 = StgThunk_payload(R1,0);
-  jump raisezh_fast;
-}
-
-raisezh_fast
-{
-    W_ handler;
-    W_ raise_closure;
-    W_ frame_type;
-    /* args : R1 :: Exception */
-
-
-#if defined(PROFILING)
-    /* Debugging tool: on raising an  exception, show where we are. */
-
-    /* ToDo: currently this is a hack.  Would be much better if
-     * the info was only displayed for an *uncaught* exception.
-     */
-    if (RtsFlags_ProfFlags_showCCSOnException(RtsFlags)) {
-      foreign "C" fprintCCS_stderr(W_[CCCS] "ptr");
-    }
-#endif
-
-retry_pop_stack:
-    StgTSO_sp(CurrentTSO) = Sp;
-    frame_type = foreign "C" raiseExceptionHelper(BaseReg "ptr", CurrentTSO "ptr", R1 "ptr");
-    Sp = StgTSO_sp(CurrentTSO);
-    if (frame_type == ATOMICALLY_FRAME) {
-      /* The exception has reached the edge of a memory transaction.  Check that 
-       * the transaction is valid.  If not then perhaps the exception should
-       * not have been thrown: re-run the transaction */
-      W_ trec;
-      W_ r;
-      trec = StgTSO_trec(CurrentTSO);
-      r = foreign "C" stmValidateNestOfTransactions(trec "ptr");
-      foreign "C" stmAbortTransaction(MyCapability() "ptr", trec "ptr");
-      StgTSO_trec(CurrentTSO) = NO_TREC;
-      if (r) {
-        // Transaction was valid: continue searching for a catch frame
-        Sp = Sp + SIZEOF_StgAtomicallyFrame;
-        goto retry_pop_stack;
-      } else {
-        // Transaction was not valid: we retry the exception (otherwise continue
-        // with a further call to raiseExceptionHelper)
-        "ptr" trec = foreign "C" stmStartTransaction(MyCapability() "ptr", NO_TREC "ptr");
-        StgTSO_trec(CurrentTSO) = trec;
-        R1 = StgAtomicallyFrame_code(Sp);
-        jump stg_ap_v_fast;
-      }          
-    }
-
-    if (frame_type == STOP_FRAME) {
-	/*
-	 * We've stripped the entire stack, the thread is now dead.
-	 * We will leave the stack in a GC'able state, see the stg_stop_thread
-	 * entry code in StgStartup.cmm.
-	 */
-	Sp = CurrentTSO + TSO_OFFSET_StgTSO_stack 
-		+ WDS(TO_W_(StgTSO_stack_size(CurrentTSO))) - WDS(2);
-	Sp(1) = R1;		/* save the exception */
-	Sp(0) = stg_enter_info; /* so that GC can traverse this stack */
-	StgTSO_what_next(CurrentTSO) = ThreadKilled::I16;
-	SAVE_THREAD_STATE();	/* inline! */
-
-	/* The return code goes in BaseReg->rRet, and BaseReg is returned in R1 */
-	StgRegTable_rRet(BaseReg) = ThreadFinished;
-	R1 = BaseReg;
-
-	jump StgReturn;
-    }
-
-    /* Ok, Sp points to the enclosing CATCH_FRAME or CATCH_STM_FRAME.  Pop everything
-     * down to and including this frame, update Su, push R1, and enter the handler.
-     */
-    if (frame_type == CATCH_FRAME) {
-      handler = StgCatchFrame_handler(Sp);
-    } else {
-      handler = StgCatchSTMFrame_handler(Sp);
-    }
-
-    /* Restore the blocked/unblocked state for asynchronous exceptions
-     * at the CATCH_FRAME.  
-     *
-     * If exceptions were unblocked, arrange that they are unblocked
-     * again after executing the handler by pushing an
-     * unblockAsyncExceptions_ret stack frame.
-     */
-    W_ frame;
-    frame = Sp;
-    if (frame_type == CATCH_FRAME) {
-      Sp = Sp + SIZEOF_StgCatchFrame;
-      if (StgCatchFrame_exceptions_blocked(frame) == 0) {
-        Sp_adj(-1);
-        Sp(0) = stg_unblockAsyncExceptionszh_ret_info;
-      }
-    } else {
-      Sp = Sp + SIZEOF_StgCatchSTMFrame;
-    }
-
-    /* Ensure that async excpetions are blocked when running the handler.
-    */
-    if (StgTSO_blocked_exceptions(CurrentTSO) == NULL) {
-      StgTSO_blocked_exceptions(CurrentTSO) = END_TSO_QUEUE;
-    }
-
-    /* Call the handler, passing the exception value and a realworld
-     * token as arguments.
-     */
-    Sp_adj(-1);
-    Sp(0) = R1;
-    R1 = handler;
-    Sp_adj(-1);
-    TICK_UNKNOWN_CALL();
-    TICK_SLOW_CALL_pv();
-    jump RET_LBL(stg_ap_pv);
-}
-
-raiseIOzh_fast
-{
-  /* Args :: R1 :: Exception */
-  jump raisezh_fast;
-}
diff --git a/ghc/rts/Exception.h b/ghc/rts/Exception.h
deleted file mode 100644
index f7832f4045..0000000000
--- a/ghc/rts/Exception.h
+++ /dev/null
@@ -1,40 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Exception support
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef EXCEPTION_H
-#define EXCEPTION_H
-
-extern const StgRetInfoTable stg_blockAsyncExceptionszh_ret_info;
-extern const StgRetInfoTable stg_unblockAsyncExceptionszh_ret_info;
-
-/* Determine whether a thread is interruptible (ie. blocked
- * indefinitely).  Interruptible threads can be sent an exception with
- * killThread# even if they have async exceptions blocked.
- */
-STATIC_INLINE int
-interruptible(StgTSO *t)
-{
-  switch (t->why_blocked) {
-  case BlockedOnMVar:
-  case BlockedOnException:
-  case BlockedOnRead:
-  case BlockedOnWrite:
-#if defined(mingw32_HOST_OS)
-  case BlockedOnDoProc:
-#endif
-  case BlockedOnDelay:
-    return 1;
-  // NB. Threaded blocked on foreign calls (BlockedOnCCall) are
-  // *not* interruptible.  We can't send these threads an exception.
-  default:
-    return 0;
-  }
-}
-
-#endif /* EXCEPTION_H */
-
diff --git a/ghc/rts/FrontPanel.c b/ghc/rts/FrontPanel.c
deleted file mode 100644
index 579b75bab3..0000000000
--- a/ghc/rts/FrontPanel.c
+++ /dev/null
@@ -1,802 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 2000
- *
- * RTS GTK Front Panel
- *
- * ---------------------------------------------------------------------------*/
-
-#ifdef RTS_GTK_FRONTPANEL
-
-/* Alas, not Posix. */
-/* #include "PosixSource.h" */
-
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "MBlock.h"
-#include "FrontPanel.h"
-#include "Storage.h"
-#include "Stats.h"
-#include "RtsFlags.h"
-#include "Schedule.h"
-
-#include <gtk/gtk.h>
-#include <unistd.h>
-#include <string.h>
-
-#include "VisSupport.h"
-#include "VisWindow.h"
-
-static GtkWidget *window, *map_drawing_area, *gen_drawing_area;
-static GtkWidget *res_drawing_area;
-static GtkWidget *continue_but, *stop_but, *quit_but;
-static GtkWidget *statusbar;
-static GtkWidget *live_label, *allocated_label;
-static GtkWidget *footprint_label, *alloc_rate_label;
-static GtkWidget *map_ruler, *gen_ruler;
-static GtkWidget *res_vruler, *res_hruler;
-static GtkWidget *running_label, *b_read_label, *b_write_label, *total_label;
-static GtkWidget *b_mvar_label, *b_bh_label, *b_throwto_label, *sleeping_label;
-
-static guint status_context_id;
-
-gboolean continue_now = FALSE, stop_now = FALSE, quit = FALSE;
-UpdateMode update_mode = Continuous;
-
-static GdkPixmap *map_pixmap = NULL;
-static GdkPixmap *gen_pixmap = NULL;
-static GdkPixmap *res_pixmap = NULL;
-
-#define N_GENS 10
-
-static GdkColor 
-    bdescr_color = { 0, 0xffff, 0, 0 },	/* red */
-    free_color   = { 0, 0, 0, 0xffff },	/* blue */
-    gen_colors[N_GENS] = {
-	{ 0, 0, 0xffff, 0 },
-	{ 0, 0, 0xf000, 0 },
-	{ 0, 0, 0xe000, 0 },
-	{ 0, 0, 0xd000, 0 },
-	{ 0, 0, 0xc000, 0 },
-	{ 0, 0, 0xb000, 0 },
-	{ 0, 0, 0xa000, 0 },
-	{ 0, 0, 0x9000, 0 },
-	{ 0, 0, 0x8000, 0 },
-	{ 0, 0, 0x7000, 0 }
-    };
-
-GdkGC *my_gc = NULL;
-
-static void *mem_start = (void *) 0x50000000;
-
-static void colorBlock( void *addr, GdkColor *color, 
-			nat block_width, nat block_height, 
-			nat blocks_per_line );
-
-static void residencyCensus( void );
-static void updateResidencyGraph( void );
-static void updateThreadsPanel( void );
-
-/* Some code pinched from examples/scribble-simple in the GTK+
- * distribution.
- */
-
-/* Create a new backing pixmap of the appropriate size */
-static gint 
-configure_event( GtkWidget *widget, GdkEventConfigure *event STG_UNUSED,
-		 GdkPixmap **pixmap )
-{
-  if (*pixmap)
-    gdk_pixmap_unref(*pixmap);
-
-  *pixmap = gdk_pixmap_new(widget->window,
-			   widget->allocation.width,
-			   widget->allocation.height,
-			   -1);
-
-  gdk_draw_rectangle (*pixmap,
-		      widget->style->white_gc,
-		      TRUE,
-		      0, 0,
-		      widget->allocation.width,
-		      widget->allocation.height);
-
-  debugBelch("configure!\n");
-  updateFrontPanel();
-  return TRUE;
-}
-
-/* Redraw the screen from the backing pixmap */
-static gint 
-expose_event( GtkWidget *widget, GdkEventExpose *event, GdkPixmap **pixmap )
-{
-  gdk_draw_pixmap(widget->window,
-		  widget->style->fg_gc[GTK_WIDGET_STATE (widget)],
-		  *pixmap,
-		  event->area.x, event->area.y,
-		  event->area.x, event->area.y,
-		  event->area.width, event->area.height);
-
-  return FALSE;
-}
-
-void
-initFrontPanel( void )
-{
-    GdkColormap *colormap;
-    GtkWidget *gen_hbox;
-
-    gtk_init( &prog_argc, &prog_argv );
-
-    window = create_GHC_Front_Panel();
-    map_drawing_area  = lookup_widget(window, "memmap");
-    gen_drawing_area  = lookup_widget(window, "generations");
-    res_drawing_area  = lookup_widget(window, "res_drawingarea");
-    stop_but          = lookup_widget(window, "stop_but");
-    continue_but      = lookup_widget(window, "continue_but");
-    quit_but          = lookup_widget(window, "quit_but");
-    statusbar         = lookup_widget(window, "statusbar");
-    live_label        = lookup_widget(window, "live_label");
-    footprint_label   = lookup_widget(window, "footprint_label");
-    allocated_label   = lookup_widget(window, "allocated_label");
-    alloc_rate_label  = lookup_widget(window, "alloc_rate_label");
-    gen_hbox          = lookup_widget(window, "gen_hbox");
-    gen_ruler         = lookup_widget(window, "gen_ruler");
-    map_ruler         = lookup_widget(window, "map_ruler");
-    res_vruler        = lookup_widget(window, "res_vruler");
-    res_hruler        = lookup_widget(window, "res_hruler");
-    running_label     = lookup_widget(window, "running_label");
-    b_read_label      = lookup_widget(window, "blockread_label");
-    b_write_label     = lookup_widget(window, "blockwrite_label");
-    b_mvar_label      = lookup_widget(window, "blockmvar_label");
-    b_bh_label        = lookup_widget(window, "blockbh_label");
-    b_throwto_label   = lookup_widget(window, "blockthrowto_label");
-    sleeping_label    = lookup_widget(window, "sleeping_label");
-    total_label       = lookup_widget(window, "total_label");
-    
-    status_context_id = 
-	gtk_statusbar_get_context_id( GTK_STATUSBAR(statusbar), "context" );
-
-    /* hook up some signals for the mem map drawing area */
-    gtk_signal_connect (GTK_OBJECT(map_drawing_area), "expose_event",
-			(GtkSignalFunc)expose_event, &map_pixmap);
-    gtk_signal_connect (GTK_OBJECT(map_drawing_area), "configure_event",
-			(GtkSignalFunc)configure_event, &map_pixmap);
-
-    gtk_widget_set_events(map_drawing_area, GDK_EXPOSURE_MASK);
-
-    /* hook up some signals for the gen drawing area */
-    gtk_signal_connect (GTK_OBJECT(gen_drawing_area), "expose_event",
-			(GtkSignalFunc)expose_event, &gen_pixmap);
-    gtk_signal_connect (GTK_OBJECT(gen_drawing_area), "configure_event",
-			(GtkSignalFunc)configure_event, &gen_pixmap);
-
-    gtk_widget_set_events(gen_drawing_area, GDK_EXPOSURE_MASK);
-    
-    /* hook up some signals for the res drawing area */
-    gtk_signal_connect (GTK_OBJECT(res_drawing_area), "expose_event",
-			(GtkSignalFunc)expose_event, &res_pixmap);
-    gtk_signal_connect (GTK_OBJECT(res_drawing_area), "configure_event",
-			(GtkSignalFunc)configure_event, &res_pixmap);
-
-    gtk_widget_set_events(res_drawing_area, GDK_EXPOSURE_MASK);
-    
-    /* allocate our colors */
-    colormap = gdk_colormap_get_system();
-    gdk_colormap_alloc_color(colormap, &bdescr_color, TRUE, TRUE);
-    gdk_colormap_alloc_color(colormap, &free_color, TRUE, TRUE);
-
-    {
-	gboolean success[N_GENS];
-	gdk_colormap_alloc_colors(colormap, gen_colors, N_GENS, TRUE,
-				  TRUE, success);
-	if (!success) { barf("can't allocate colors"); }
-    }
-
-    /* set the labels on the generation histogram */
-    {
-	char buf[64];
-	nat g, s;
-	GtkWidget *label;
-
-	for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	    for(s = 0; s < generations[g].n_steps; s++) {
-		g_snprintf( buf, 64, "%d.%d", g, s );
-		label = gtk_label_new( buf );
-		gtk_box_pack_start( GTK_BOX(gen_hbox), label,
-				    TRUE, TRUE, 5 );
-		gtk_widget_show(label);
-	    }
-	}
-    }
-
-    gtk_widget_show(window);
-
-    /* wait for the user to press "Continue" before getting going... */
-    gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, 
-			"Program start");
-    gtk_widget_set_sensitive( stop_but, FALSE );
-    continue_now = FALSE;
-    while (continue_now == FALSE) {
-	gtk_main_iteration();
-    }
-    gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
-    gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, 
-			"Running");
-
-    gtk_widget_set_sensitive( continue_but, FALSE );
-    gtk_widget_set_sensitive( stop_but, TRUE );
-    gtk_widget_set_sensitive( quit_but, FALSE );
-
-    while (gtk_events_pending()) {
-	gtk_main_iteration();
-    }
-}
-
-void
-stopFrontPanel( void )
-{
-    gtk_widget_set_sensitive( quit_but, TRUE );
-    gtk_widget_set_sensitive( continue_but, FALSE );
-    gtk_widget_set_sensitive( stop_but, FALSE );
-
-    updateFrontPanel();
-
-    gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, 
-			"Program finished");
-
-    quit = FALSE;
-    while (quit == FALSE) {
-	gtk_main_iteration();
-    }
-}
-
-static void
-waitForContinue( void )
-{
-    gtk_widget_set_sensitive( continue_but, TRUE );
-    gtk_widget_set_sensitive( stop_but, FALSE );
-    stop_now = FALSE;
-    continue_now = FALSE;
-    while (continue_now == FALSE) {
-	gtk_main_iteration();
-    }
-    gtk_widget_set_sensitive( continue_but, FALSE );
-    gtk_widget_set_sensitive( stop_but, TRUE );
-}
-
-void
-updateFrontPanelBeforeGC( nat N )
-{
-    char buf[1000];
-
-    updateFrontPanel();
-
-    if (update_mode == BeforeGC 
-	|| update_mode == BeforeAfterGC
-	|| stop_now == TRUE) {
-	g_snprintf( buf, 1000, "Stopped (before GC, generation %d)", N );
-	gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, buf );
-	waitForContinue();
-	gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
-    }
-
-    g_snprintf( buf, 1000, "Garbage collecting (generation %d)", N );
-    gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, buf);
-
-    while (gtk_events_pending()) {
-	gtk_main_iteration();
-    }
-}
-
-static void
-numLabel( GtkWidget *lbl, nat n )
-{
-    char buf[64];
-    g_snprintf(buf, 64, "%d", n);
-    gtk_label_set_text( GTK_LABEL(lbl), buf );
-}
-
-void
-updateFrontPanelAfterGC( nat N, lnat live )
-{
-    char buf[1000];
-
-    gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
-
-    /* is a major GC? */
-    if (N == RtsFlags.GcFlags.generations-1) {
-	residencyCensus();
-    }
-
-    updateFrontPanel();
-
-    if (update_mode == AfterGC 
-	|| update_mode == BeforeAfterGC
-	|| stop_now == TRUE) {
-	snprintf( buf, 1000, "Stopped (after GC, generation %d)", N );
-	gtk_statusbar_push( GTK_STATUSBAR(statusbar), status_context_id, buf );
-	waitForContinue();
-	gtk_statusbar_pop( GTK_STATUSBAR(statusbar), status_context_id );
-    }
-
-    {
-	double words_to_megs = (1024 * 1024) / sizeof(W_);
-	double time = mut_user_time();
-
-	snprintf( buf, 1000, "%.2f", (double)live / words_to_megs );
-	gtk_label_set_text( GTK_LABEL(live_label), buf );
-
-	snprintf( buf, 1000, "%.2f", (double)total_allocated / words_to_megs );
-	gtk_label_set_text( GTK_LABEL(allocated_label), buf );
-
-	snprintf( buf, 1000, "%.2f",
-		  (double)(mblocks_allocated * MBLOCK_SIZE_W) / words_to_megs );
-	gtk_label_set_text( GTK_LABEL(footprint_label), buf );
-
-	if ( time == 0.0 )
-	    snprintf( buf, 1000, "%.2f", time );
-	else
-	    snprintf( buf, 1000, "%.2f",
-		      (double)(total_allocated / words_to_megs) / time );
-	gtk_label_set_text( GTK_LABEL(alloc_rate_label), buf );
-    }
-
-    while (gtk_events_pending()) {
-	gtk_main_iteration();
-    }
-}
-
-void
-updateFrontPanel( void )
-{
-    void *m, *a;
-    bdescr *bd;
-
-    updateThreadsPanel();
-
-    if (my_gc == NULL) {
-	my_gc = gdk_gc_new( window->window );
-    }
-
-    if (map_pixmap != NULL) {
-	nat height, width, blocks_per_line, 
-	    block_height, block_width, mblock_height;
-
-	height = map_drawing_area->allocation.height;
-	width  = map_drawing_area->allocation.width;
-
-	mblock_height =  height / mblocks_allocated;
-	blocks_per_line = 16;
-	block_height  = mblock_height / 
-	    ((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
-	while (block_height == 0) {
-	    blocks_per_line *= 2;
-	    block_height  = mblock_height / 
-		((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
-	}
-	block_width = width / blocks_per_line;
-
-	gdk_draw_rectangle (map_pixmap,
-			    map_drawing_area->style->bg_gc[GTK_STATE_NORMAL],
-			    TRUE,
-			    0, 0,
-			    map_drawing_area->allocation.width,
-			    map_drawing_area->allocation.height);
-	
-	for ( m = mem_start; 
-	      (char *)m < (char *)mem_start + 
-		  (mblocks_allocated * MBLOCK_SIZE); 
-	      (char *)m += MBLOCK_SIZE ) {
-	    
-	    /* color the bdescr area first */
-	    for (a = m; a < FIRST_BLOCK(m); (char *)a += BLOCK_SIZE) {
-		colorBlock( a, &bdescr_color, 
-			    block_width, block_height, blocks_per_line );
-	    }
-	    
-#if 0 /* Segfaults because bd appears to be bogus but != NULL. stolz, 2003-06-24 */
-	    /* color each block */
-	    for (; a <= LAST_BLOCK(m); (char *)a += BLOCK_SIZE) {
-		bd = Bdescr((P_)a);
-		ASSERT(bd->start == a);
-                if (bd->flags & BF_FREE) {
-		    colorBlock( a, &free_color, 
-				block_width, block_height, blocks_per_line );
-		} else {
-		    colorBlock( a, &gen_colors[bd->gen_no],
-				block_width, block_height, blocks_per_line );
-		}
-	    }
-#endif
-	}
-
-	
-	{ 
-	    nat height = map_drawing_area->allocation.height,
-		block_height, mblock_height;
-
-	    block_height = (height / mblocks_allocated) / 
-		((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
-	    if (block_height < 1) block_height = 1;
-	    mblock_height = block_height * 
-		((MBLOCK_SIZE/BLOCK_SIZE) / blocks_per_line);
-
-	    gtk_ruler_set_range( GTK_RULER(map_ruler), 0, 
-				 (double)(height * mblocks_allocated) / 
-				 (double)((mblock_height * mblocks_allocated)),
-				 0,
-				 (double)(height * mblocks_allocated) / 
-				 (double)((mblock_height * mblocks_allocated))
-		);
-	}
-				  
-	gtk_widget_draw( map_drawing_area, NULL );
-    }
-
-    if (gen_pixmap != NULL) {
-
-	GdkRectangle rect;
-	nat g, s, columns, column, max_blocks, height_blocks,
-	    width, height;
-	
-	gdk_draw_rectangle (gen_pixmap,
-			    gen_drawing_area->style->white_gc,
-			    TRUE,
-			    0, 0,
-			    gen_drawing_area->allocation.width,
-			    gen_drawing_area->allocation.height);
-
-	height = gen_drawing_area->allocation.height;
-	width  = gen_drawing_area->allocation.width;
-
-	columns = 0; max_blocks = 0;
-	for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	    columns += generations[g].n_steps;
-	    for(s = 0; s < generations[g].n_steps; s++) {
-		if (generations[g].steps[s].n_blocks > max_blocks) {
-		    max_blocks = generations[g].steps[s].n_blocks;
-		}
-	    }
-	}
-
-	/* find a reasonable height value larger than max_blocks */
-	{ 
-	    nat n = 0;
-	    while (max_blocks != 0) {
-		max_blocks >>= 1; n++;
-	    }
-	    height_blocks = 1 << n;
-	}
-
-	column = 0;
-	for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	    for(s = 0; s < generations[g].n_steps; s++, column++) {
-		gdk_gc_set_foreground(my_gc, &gen_colors[g]);
-
-		rect.x = column * (width / columns);
-
-		if (generations[g].steps[s].n_blocks == 0)
-		    rect.y = height;
-		else
-		    rect.y = height - 
-			(height * generations[g].steps[s].n_blocks
-			 / height_blocks);
-
-		rect.width = (width / columns);
-		rect.height = height - rect.y;
-
-		gdk_draw_rectangle( gen_pixmap, my_gc, TRUE/*filled*/, 
-				    rect.x, rect.y, rect.width,
-				    rect.height );
-	    }
-	}
-
-	gtk_ruler_set_range( GTK_RULER(gen_ruler), 
-			     height_blocks * BLOCK_SIZE / (1024 * 1024),
-			     0, 0,
-			     height_blocks * BLOCK_SIZE / (1024 * 1024)
-	    );
-
-	gtk_widget_draw( gen_drawing_area, NULL );
-    }
-
-    if (res_pixmap != NULL) {
-	updateResidencyGraph();
-    }
-
-    while (gtk_events_pending()) {
-	gtk_main_iteration_do(FALSE/*don't block*/);
-    }
-}
-
-static void
-colorBlock( void *addr, GdkColor *color, 
-	    nat block_width, nat block_height, nat blocks_per_line )
-{
-    GdkRectangle rect;
-    nat block_no;
-
-    gdk_gc_set_foreground(my_gc, color);
-
-    block_no = ((char *)addr - (char *)mem_start) / BLOCK_SIZE;
-
-    rect.x = (block_no % blocks_per_line) * block_width;
-    rect.y = block_no / blocks_per_line * block_height;
-    rect.width = block_width;
-    rect.height = block_height;
-    gdk_draw_rectangle( map_pixmap, my_gc, TRUE/*filled*/, 
-			rect.x, rect.y, rect.width, rect.height );
-}
-
-static void
-updateThreadsPanel( void )
-{
-    nat running = 0,
-	b_read = 0,
-	b_write = 0,
-	b_mvar = 0,
-	b_throwto = 0,
-	b_bh = 0,
-	sleeping = 0,
-	total = 0;
-
-    StgTSO *t;
-
-    for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) {
-	switch (t->what_next) {
-	case ThreadKilled:	    break;
-	case ThreadComplete:	    break;
-	default:
-	    switch (t->why_blocked) {
-	    case BlockedOnRead:       b_read++;    break;
-	    case BlockedOnWrite:      b_write++;   break;
-	    case BlockedOnDelay:      sleeping++;  break;
-	    case BlockedOnMVar:       b_mvar++;    break;
-	    case BlockedOnException:  b_throwto++; break;
-	    case BlockedOnBlackHole:  b_bh++;      break;
-	    case NotBlocked:          running++;   break;
-	    }
-	}
-    }
-    total = running + b_read + b_write + b_mvar + b_throwto + b_bh + sleeping;
-    numLabel(running_label,   running);
-    numLabel(b_read_label,    b_read);
-    numLabel(b_write_label,   b_write);
-    numLabel(b_mvar_label,    b_mvar);
-    numLabel(b_bh_label,      b_bh);
-    numLabel(b_throwto_label, b_throwto);
-    numLabel(sleeping_label,  sleeping);
-    numLabel(total_label,     total);
-}
-
-typedef enum { Thunk, Fun, Constr, BlackHole,
-	       Array, Thread, Other, N_Cats } ClosureCategory;
-
-#define N_SLICES 100
-
-static nat *res_prof[N_SLICES];
-static double res_time[N_SLICES];
-static nat next_slice = 0;
-
-static void
-residencyCensus( void )
-{
-    nat slice = next_slice++, *prof;
-    bdescr *bd;
-    nat g, s, size, type;
-    StgPtr p;
-    StgInfoTable *info;
-
-    if (slice >= N_SLICES) {
-	barf("too many slices");
-    }
-    res_prof[slice] = stgMallocBytes(N_Cats * sizeof(nat), "residencyCensus");
-    prof = res_prof[slice];
-    memset(prof, 0, N_Cats * sizeof(nat));
-
-    res_time[slice] = mut_user_time();
-    
-    for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	for(s = 0; s < generations[g].n_steps; s++) {
-
-	    /* skip over g0s0 if multi-generational */
-	    if (RtsFlags.GcFlags.generations > 1 &&
-		g == 0 && s == 0) continue;
-
-	    if (RtsFlags.GcFlags.generations == 1) {
-/*		bd = generations[g].steps[s].to_blocks; FIXME to_blocks does not exist */
-	    } else {
-		bd = generations[g].steps[s].blocks;
-	    }
-
-	    for (; bd != NULL; bd = bd->link) {
-
-		p = bd->start;
-
-		while (p < bd->free) {
-		    info = get_itbl((StgClosure *)p);
-		    type = Other;
-		    
-		    switch (info->type) {
-
-		    case CONSTR:
-		    case BCO:
-			if (((StgClosure *)p)->header.info == &stg_DEAD_WEAK_info) {
-			    size = sizeofW(StgWeak);
-			    type = Other;
-			    break;
-			}
-			/* else, fall through... */
-		    case CONSTR_1_0:
-		    case CONSTR_0_1:
-		    case CONSTR_1_1:
-		    case CONSTR_0_2:
-		    case CONSTR_2_0:
-			size = sizeW_fromITBL(info);
-			type = Constr;
-			break;
-			
-		    case FUN_1_0:
-		    case FUN_0_1:
-			size = sizeofW(StgHeader) + 1;
-			goto fun;
-		    case FUN_1_1:
-		    case FUN_0_2:
-		    case FUN_2_0:
-		    case FUN:
-			size = sizeW_fromITBL(info);
-		    fun:
-			type = Fun;
-			break;
-
-		    case THUNK_1_0:
-		    case THUNK_0_1:
-		    case THUNK_SELECTOR:
-			size = sizeofW(StgHeader) + 2;
-			goto thunk;
-		    case THUNK_1_1:
-		    case THUNK_0_2:
-		    case THUNK_2_0:
-		    case THUNK:
-			size = sizeW_fromITBL(info);
-		    thunk:
-			type = Thunk;
-			break;
-
-		    case CAF_BLACKHOLE:
-		    case SE_CAF_BLACKHOLE:
-		    case SE_BLACKHOLE:
-		    case BLACKHOLE:
-/*		    case BLACKHOLE_BQ: FIXME: case does not exist */
-			size = sizeW_fromITBL(info);
-			type = BlackHole;
-			break;
-
-		    case AP:
-			size = pap_sizeW((StgPAP *)p);
-			type = Thunk;
-			break;
-
-		    case PAP:
-			size = pap_sizeW((StgPAP *)p);
-			type = Fun;
-			break;
-			
-		    case ARR_WORDS:
-			size = arr_words_sizeW(stgCast(StgArrWords*,p));
-			type = Array;
-			break;
-			
-		    case MUT_ARR_PTRS:
-		    case MUT_ARR_PTRS_FROZEN:
-			size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
-			type = Array;
-			break;
-			
-		    case TSO:
-			size = tso_sizeW((StgTSO *)p);
-			type = Thread;
-			break;
-			
-		    case WEAK:
-		    case STABLE_NAME:
-		    case MVAR:
-		    case MUT_VAR:
-/*		    case MUT_CONS: FIXME: case does not exist */
-		    case IND_PERM:
-		    case IND_OLDGEN_PERM:
-			size = sizeW_fromITBL(info);
-			type = Other;
-			break;
-
-		    default:
-			barf("updateResidencyGraph: strange closure "
-                             "%d", info->type );
-		    }
-
-		    prof[type] += size;
-		    p += size;
-		}
-	    }
-	}
-    }
-
-}
-	    
-static void
-updateResidencyGraph( void )
-{
-    nat total, prev_total, i, max_res;
-    double time;
-    double time_scale = 1;
-    nat last_slice = next_slice-1;
-    double res_scale  = 1; /* in megabytes, doubles */
-    nat *prof;
-    nat width, height;
-    GdkPoint points[4];
-
-    gdk_draw_rectangle (res_pixmap,
-			res_drawing_area->style->bg_gc[GTK_STATE_NORMAL],
-			TRUE,
-			0, 0,
-			res_drawing_area->allocation.width,
-			res_drawing_area->allocation.height);
-    
-    if (next_slice == 0) return;
-
-    time = res_time[last_slice];
-    while (time > time_scale) {
-	time_scale *= 2;
-    }
-
-    max_res = 0; 
-    for (i = 0; i < next_slice; i++) {
-	prof = res_prof[i];
-	total = prof[Thunk] + prof[Fun] + prof[Constr] +
-	    prof[BlackHole] + prof[Array] + prof[Other];
-	if (total > max_res) {
-	    max_res = total;
-	}
-    }
-    while (max_res > res_scale) {
-	res_scale *= 2;
-    }
-
-    height = res_drawing_area->allocation.height;
-    width  = res_drawing_area->allocation.width;
-
-    points[0].x = 0;
-    points[0].y = height;
-    points[1].y = height;
-    points[3].x = 0;
-    points[3].y = height;
-
-    gdk_gc_set_foreground(my_gc, &free_color);
-
-    prev_total = 0;
-    for (i = 0; i < next_slice; i++) {
-	prof = res_prof[i];
-	total = prof[Thunk] + prof[Fun] + prof[Constr] +
-	    prof[BlackHole] + prof[Array] + prof[Other];
-	points[1].x = width * res_time[i] / time_scale;
-	points[2].x = points[1].x;
-	points[2].y = height - ((height * total) / res_scale);
-	gdk_draw_polygon(res_pixmap, my_gc, TRUE/*filled*/, points, 4);
-	points[3] = points[2];
-	points[0] = points[1];
-    }
-
-    gtk_ruler_set_range( GTK_RULER(res_vruler), 
-			 res_scale / ((1024*1024)/sizeof(W_)),
-			 0, 0,
-			 res_scale / ((1024*1024)/sizeof(W_)) );
-
-    gtk_ruler_set_range( GTK_RULER(res_hruler), 
-			 0, time_scale, 0, time_scale );
-
-
-    gtk_widget_draw( res_drawing_area, NULL );
-}
-
-#endif /* RTS_GTK_FRONTPANEL */
diff --git a/ghc/rts/FrontPanel.h b/ghc/rts/FrontPanel.h
deleted file mode 100644
index de3b741657..0000000000
--- a/ghc/rts/FrontPanel.h
+++ /dev/null
@@ -1,35 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 2000-2005
- *
- * RTS GTK Front Panel
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef FRONTPANEL_H
-#define FRONTPANEL_H
-
-#ifdef RTS_GTK_FRONTPANEL
-
-#include "Rts.h"  /* needed because this file gets included by
-		   * auto-generated code */
-
-void initFrontPanel( void );
-void stopFrontPanel( void );
-void updateFrontPanelBeforeGC( nat N );
-void updateFrontPanelAfterGC( nat N, lnat live );
-void updateFrontPanel( void );
-
-
-/* --------- PRIVATE ----------------------------------------- */
-
-#include <gdk/gdktypes.h>
-
-typedef enum { BeforeGC, AfterGC, BeforeAfterGC, Continuous } UpdateMode;
-extern UpdateMode update_mode;
-extern gboolean continue_now, stop_now, quit;
-
-#endif /* RTS_GTK_FRONTPANEL */
-
-#endif /* FRONTPANEL_H */
-
diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
deleted file mode 100644
index a13cd33afa..0000000000
--- a/ghc/rts/GC.c
+++ /dev/null
@@ -1,4719 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1998-2003
- *
- * Generational garbage collector
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "Apply.h"
-#include "OSThreads.h"
-#include "Storage.h"
-#include "LdvProfile.h"
-#include "Updates.h"
-#include "Stats.h"
-#include "Schedule.h"
-#include "Sanity.h"
-#include "BlockAlloc.h"
-#include "MBlock.h"
-#include "ProfHeap.h"
-#include "SchedAPI.h"
-#include "Weak.h"
-#include "Prelude.h"
-#include "ParTicky.h"		// ToDo: move into Rts.h
-#include "GCCompact.h"
-#include "RtsSignals.h"
-#include "STM.h"
-#if defined(GRAN) || defined(PAR)
-# include "GranSimRts.h"
-# include "ParallelRts.h"
-# include "FetchMe.h"
-# if defined(DEBUG)
-#  include "Printer.h"
-#  include "ParallelDebug.h"
-# endif
-#endif
-#include "HsFFI.h"
-#include "Linker.h"
-#if defined(RTS_GTK_FRONTPANEL)
-#include "FrontPanel.h"
-#endif
-
-#include "RetainerProfile.h"
-
-#include <string.h>
-
-// Turn off inlining when debugging - it obfuscates things
-#ifdef DEBUG
-# undef  STATIC_INLINE
-# define STATIC_INLINE static
-#endif
-
-/* STATIC OBJECT LIST.
- *
- * During GC:
- * We maintain a linked list of static objects that are still live.
- * The requirements for this list are:
- *
- *  - we need to scan the list while adding to it, in order to
- *    scavenge all the static objects (in the same way that
- *    breadth-first scavenging works for dynamic objects).
- *
- *  - we need to be able to tell whether an object is already on
- *    the list, to break loops.
- *
- * Each static object has a "static link field", which we use for
- * linking objects on to the list.  We use a stack-type list, consing
- * objects on the front as they are added (this means that the
- * scavenge phase is depth-first, not breadth-first, but that
- * shouldn't matter).  
- *
- * A separate list is kept for objects that have been scavenged
- * already - this is so that we can zero all the marks afterwards.
- *
- * An object is on the list if its static link field is non-zero; this
- * means that we have to mark the end of the list with '1', not NULL.  
- *
- * Extra notes for generational GC:
- *
- * Each generation has a static object list associated with it.  When
- * collecting generations up to N, we treat the static object lists
- * from generations > N as roots.
- *
- * We build up a static object list while collecting generations 0..N,
- * which is then appended to the static object list of generation N+1.
- */
-static StgClosure* static_objects;      // live static objects
-StgClosure* scavenged_static_objects;   // static objects scavenged so far
-
-/* N is the oldest generation being collected, where the generations
- * are numbered starting at 0.  A major GC (indicated by the major_gc
- * flag) is when we're collecting all generations.  We only attempt to
- * deal with static objects and GC CAFs when doing a major GC.
- */
-static nat N;
-static rtsBool major_gc;
-
-/* Youngest generation that objects should be evacuated to in
- * evacuate().  (Logically an argument to evacuate, but it's static
- * a lot of the time so we optimise it into a global variable).
- */
-static nat evac_gen;
-
-/* Whether to do eager promotion or not.
- */
-static rtsBool eager_promotion;
-
-/* Weak pointers
- */
-StgWeak *old_weak_ptr_list; // also pending finaliser list
-
-/* Which stage of processing various kinds of weak pointer are we at?
- * (see traverse_weak_ptr_list() below for discussion).
- */
-typedef enum { WeakPtrs, WeakThreads, WeakDone } WeakStage;
-static WeakStage weak_stage;
-
-/* List of all threads during GC
- */
-static StgTSO *old_all_threads;
-StgTSO *resurrected_threads;
-
-/* Flag indicating failure to evacuate an object to the desired
- * generation.
- */
-static rtsBool failed_to_evac;
-
-/* Saved nursery (used for 2-space collector only)
- */
-static bdescr *saved_nursery;
-static nat saved_n_blocks;
-  
-/* Data used for allocation area sizing.
- */
-static lnat new_blocks;		 // blocks allocated during this GC 
-static lnat new_scavd_blocks;	 // ditto, but depth-first blocks
-static lnat g0s0_pcnt_kept = 30; // percentage of g0s0 live at last minor GC 
-
-/* Used to avoid long recursion due to selector thunks
- */
-static lnat thunk_selector_depth = 0;
-#define MAX_THUNK_SELECTOR_DEPTH 8
-
-/* Mut-list stats */
-#ifdef DEBUG
-static nat 
-    mutlist_MUTVARS,
-    mutlist_MUTARRS,
-    mutlist_OTHERS;
-#endif
-
-/* -----------------------------------------------------------------------------
-   Static function declarations
-   -------------------------------------------------------------------------- */
-
-static bdescr *     gc_alloc_block          ( step *stp );
-static void         mark_root               ( StgClosure **root );
-
-// Use a register argument for evacuate, if available.
-#if __GNUC__ >= 2
-#define REGPARM1 __attribute__((regparm(1)))
-#else
-#define REGPARM1
-#endif
-
-REGPARM1 static StgClosure * evacuate (StgClosure *q);
-
-static void         zero_static_object_list ( StgClosure* first_static );
-
-static rtsBool      traverse_weak_ptr_list  ( void );
-static void         mark_weak_ptr_list      ( StgWeak **list );
-
-static StgClosure * eval_thunk_selector     ( nat field, StgSelector * p );
-
-
-static void    scavenge                ( step * );
-static void    scavenge_mark_stack     ( void );
-static void    scavenge_stack          ( StgPtr p, StgPtr stack_end );
-static rtsBool scavenge_one            ( StgPtr p );
-static void    scavenge_large          ( step * );
-static void    scavenge_static         ( void );
-static void    scavenge_mutable_list   ( generation *g );
-
-static void    scavenge_large_bitmap   ( StgPtr p, 
-					 StgLargeBitmap *large_bitmap, 
-					 nat size );
-
-#if 0 && defined(DEBUG)
-static void         gcCAFs                  ( void );
-#endif
-
-/* -----------------------------------------------------------------------------
-   inline functions etc. for dealing with the mark bitmap & stack.
-   -------------------------------------------------------------------------- */
-
-#define MARK_STACK_BLOCKS 4
-
-static bdescr *mark_stack_bdescr;
-static StgPtr *mark_stack;
-static StgPtr *mark_sp;
-static StgPtr *mark_splim;
-
-// Flag and pointers used for falling back to a linear scan when the
-// mark stack overflows.
-static rtsBool mark_stack_overflowed;
-static bdescr *oldgen_scan_bd;
-static StgPtr  oldgen_scan;
-
-STATIC_INLINE rtsBool
-mark_stack_empty(void)
-{
-    return mark_sp == mark_stack;
-}
-
-STATIC_INLINE rtsBool
-mark_stack_full(void)
-{
-    return mark_sp >= mark_splim;
-}
-
-STATIC_INLINE void
-reset_mark_stack(void)
-{
-    mark_sp = mark_stack;
-}
-
-STATIC_INLINE void
-push_mark_stack(StgPtr p)
-{
-    *mark_sp++ = p;
-}
-
-STATIC_INLINE StgPtr
-pop_mark_stack(void)
-{
-    return *--mark_sp;
-}
-
-/* -----------------------------------------------------------------------------
-   Allocate a new to-space block in the given step.
-   -------------------------------------------------------------------------- */
-
-static bdescr *
-gc_alloc_block(step *stp)
-{
-    bdescr *bd = allocBlock();
-    bd->gen_no = stp->gen_no;
-    bd->step = stp;
-    bd->link = NULL;
-
-    // blocks in to-space in generations up to and including N
-    // get the BF_EVACUATED flag.
-    if (stp->gen_no <= N) {
-	bd->flags = BF_EVACUATED;
-    } else {
-	bd->flags = 0;
-    }
-
-    // Start a new to-space block, chain it on after the previous one.
-    if (stp->hp_bd != NULL) {
-	stp->hp_bd->free = stp->hp;
-	stp->hp_bd->link = bd;
-    }
-
-    stp->hp_bd = bd;
-    stp->hp    = bd->start;
-    stp->hpLim = stp->hp + BLOCK_SIZE_W;
-
-    stp->n_blocks++;
-    new_blocks++;
-
-    return bd;
-}
-
-static bdescr *
-gc_alloc_scavd_block(step *stp)
-{
-    bdescr *bd = allocBlock();
-    bd->gen_no = stp->gen_no;
-    bd->step = stp;
-
-    // blocks in to-space in generations up to and including N
-    // get the BF_EVACUATED flag.
-    if (stp->gen_no <= N) {
-	bd->flags = BF_EVACUATED;
-    } else {
-	bd->flags = 0;
-    }
-
-    bd->link = stp->blocks;
-    stp->blocks = bd;
-
-    if (stp->scavd_hp != NULL) {
-	Bdescr(stp->scavd_hp)->free = stp->scavd_hp;
-    }
-    stp->scavd_hp    = bd->start;
-    stp->scavd_hpLim = stp->scavd_hp + BLOCK_SIZE_W;
-
-    stp->n_blocks++;
-    new_scavd_blocks++;
-
-    return bd;
-}
-
-/* -----------------------------------------------------------------------------
-   GarbageCollect
-
-   Rough outline of the algorithm: for garbage collecting generation N
-   (and all younger generations):
-
-     - follow all pointers in the root set.  the root set includes all 
-       mutable objects in all generations (mutable_list).
-
-     - for each pointer, evacuate the object it points to into either
-
-       + to-space of the step given by step->to, which is the next
-         highest step in this generation or the first step in the next
-         generation if this is the last step.
-
-       + to-space of generations[evac_gen]->steps[0], if evac_gen != 0.
-         When we evacuate an object we attempt to evacuate
-         everything it points to into the same generation - this is
-         achieved by setting evac_gen to the desired generation.  If
-         we can't do this, then an entry in the mut list has to
-         be made for the cross-generation pointer.
-
-       + if the object is already in a generation > N, then leave
-         it alone.
-
-     - repeatedly scavenge to-space from each step in each generation
-       being collected until no more objects can be evacuated.
-      
-     - free from-space in each step, and set from-space = to-space.
-
-   Locks held: all capabilities are held throughout GarbageCollect().
-
-   -------------------------------------------------------------------------- */
-
-void
-GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
-{
-  bdescr *bd;
-  step *stp;
-  lnat live, allocated, copied = 0, scavd_copied = 0;
-  lnat oldgen_saved_blocks = 0;
-  nat g, s, i;
-
-  ACQUIRE_SM_LOCK;
-
-#ifdef PROFILING
-  CostCentreStack *prev_CCS;
-#endif
-
-#if defined(DEBUG) && defined(GRAN)
-  IF_DEBUG(gc, debugBelch("@@ Starting garbage collection at %ld (%lx)\n", 
-		     Now, Now));
-#endif
-
-#if defined(RTS_USER_SIGNALS)
-  // block signals
-  blockUserSignals();
-#endif
-
-  // tell the STM to discard any cached closures its hoping to re-use
-  stmPreGCHook();
-
-  // tell the stats department that we've started a GC 
-  stat_startGC();
-
-#ifdef DEBUG
-  // check for memory leaks if DEBUG is on 
-  memInventory();
-#endif
-
-#ifdef DEBUG
-  mutlist_MUTVARS = 0;
-  mutlist_MUTARRS = 0;
-  mutlist_OTHERS = 0;
-#endif
-
-  // Init stats and print par specific (timing) info 
-  PAR_TICKY_PAR_START();
-
-  // attribute any costs to CCS_GC 
-#ifdef PROFILING
-  prev_CCS = CCCS;
-  CCCS = CCS_GC;
-#endif
-
-  /* Approximate how much we allocated.  
-   * Todo: only when generating stats? 
-   */
-  allocated = calcAllocated();
-
-  /* Figure out which generation to collect
-   */
-  if (force_major_gc) {
-    N = RtsFlags.GcFlags.generations - 1;
-    major_gc = rtsTrue;
-  } else {
-    N = 0;
-    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-      if (generations[g].steps[0].n_blocks +
-	  generations[g].steps[0].n_large_blocks
-	  >= generations[g].max_blocks) {
-        N = g;
-      }
-    }
-    major_gc = (N == RtsFlags.GcFlags.generations-1);
-  }
-
-#ifdef RTS_GTK_FRONTPANEL
-  if (RtsFlags.GcFlags.frontpanel) {
-      updateFrontPanelBeforeGC(N);
-  }
-#endif
-
-  // check stack sanity *before* GC (ToDo: check all threads) 
-#if defined(GRAN)
-  // ToDo!: check sanity  IF_DEBUG(sanity, checkTSOsSanity());
-#endif
-  IF_DEBUG(sanity, checkFreeListSanity());
-
-  /* Initialise the static object lists
-   */
-  static_objects = END_OF_STATIC_LIST;
-  scavenged_static_objects = END_OF_STATIC_LIST;
-
-  /* Save the nursery if we're doing a two-space collection.
-   * g0s0->blocks will be used for to-space, so we need to get the
-   * nursery out of the way.
-   */
-  if (RtsFlags.GcFlags.generations == 1) {
-      saved_nursery = g0s0->blocks;
-      saved_n_blocks = g0s0->n_blocks;
-      g0s0->blocks = NULL;
-      g0s0->n_blocks = 0;
-  }
-
-  /* Keep a count of how many new blocks we allocated during this GC
-   * (used for resizing the allocation area, later).
-   */
-  new_blocks = 0;
-  new_scavd_blocks = 0;
-
-  // Initialise to-space in all the generations/steps that we're
-  // collecting.
-  //
-  for (g = 0; g <= N; g++) {
-
-    // throw away the mutable list.  Invariant: the mutable list
-    // always has at least one block; this means we can avoid a check for
-    // NULL in recordMutable().
-    if (g != 0) {
-	freeChain(generations[g].mut_list);
-	generations[g].mut_list = allocBlock();
-	for (i = 0; i < n_capabilities; i++) {
-	    freeChain(capabilities[i].mut_lists[g]);
-	    capabilities[i].mut_lists[g] = allocBlock();
-	}
-    }
-
-    for (s = 0; s < generations[g].n_steps; s++) {
-
-      // generation 0, step 0 doesn't need to-space 
-      if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) { 
-	continue; 
-      }
-
-      stp = &generations[g].steps[s];
-      ASSERT(stp->gen_no == g);
-
-      // start a new to-space for this step.
-      stp->old_blocks   = stp->blocks;
-      stp->n_old_blocks = stp->n_blocks;
-
-      // allocate the first to-space block; extra blocks will be
-      // chained on as necessary.
-      stp->hp_bd     = NULL;
-      bd = gc_alloc_block(stp);
-      stp->blocks      = bd;
-      stp->n_blocks    = 1;
-      stp->scan        = bd->start;
-      stp->scan_bd     = bd;
-
-      // allocate a block for "already scavenged" objects.  This goes
-      // on the front of the stp->blocks list, so it won't be
-      // traversed by the scavenging sweep.
-      gc_alloc_scavd_block(stp);
-
-      // initialise the large object queues.
-      stp->new_large_objects = NULL;
-      stp->scavenged_large_objects = NULL;
-      stp->n_scavenged_large_blocks = 0;
-
-      // mark the large objects as not evacuated yet 
-      for (bd = stp->large_objects; bd; bd = bd->link) {
-	bd->flags &= ~BF_EVACUATED;
-      }
-
-      // for a compacted step, we need to allocate the bitmap
-      if (stp->is_compacted) {
-	  nat bitmap_size; // in bytes
-	  bdescr *bitmap_bdescr;
-	  StgWord *bitmap;
-
-	  bitmap_size = stp->n_old_blocks * BLOCK_SIZE / (sizeof(W_)*BITS_PER_BYTE);
-
-	  if (bitmap_size > 0) {
-	      bitmap_bdescr = allocGroup((lnat)BLOCK_ROUND_UP(bitmap_size) 
-					 / BLOCK_SIZE);
-	      stp->bitmap = bitmap_bdescr;
-	      bitmap = bitmap_bdescr->start;
-	      
-	      IF_DEBUG(gc, debugBelch("bitmap_size: %d, bitmap: %p",
-				   bitmap_size, bitmap););
-	      
-	      // don't forget to fill it with zeros!
-	      memset(bitmap, 0, bitmap_size);
-	      
-	      // For each block in this step, point to its bitmap from the
-	      // block descriptor.
-	      for (bd=stp->old_blocks; bd != NULL; bd = bd->link) {
-		  bd->u.bitmap = bitmap;
-		  bitmap += BLOCK_SIZE_W / (sizeof(W_)*BITS_PER_BYTE);
-
-		  // Also at this point we set the BF_COMPACTED flag
-		  // for this block.  The invariant is that
-		  // BF_COMPACTED is always unset, except during GC
-		  // when it is set on those blocks which will be
-		  // compacted.
-		  bd->flags |= BF_COMPACTED;
-	      }
-	  }
-      }
-    }
-  }
-
-  /* make sure the older generations have at least one block to
-   * allocate into (this makes things easier for copy(), see below).
-   */
-  for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
-    for (s = 0; s < generations[g].n_steps; s++) {
-      stp = &generations[g].steps[s];
-      if (stp->hp_bd == NULL) {
-	  ASSERT(stp->blocks == NULL);
-	  bd = gc_alloc_block(stp);
-	  stp->blocks = bd;
-	  stp->n_blocks = 1;
-      }
-      if (stp->scavd_hp == NULL) {
-	  gc_alloc_scavd_block(stp);
-	  stp->n_blocks++;
-      }
-      /* Set the scan pointer for older generations: remember we
-       * still have to scavenge objects that have been promoted. */
-      stp->scan = stp->hp;
-      stp->scan_bd = stp->hp_bd;
-      stp->new_large_objects = NULL;
-      stp->scavenged_large_objects = NULL;
-      stp->n_scavenged_large_blocks = 0;
-    }
-
-    /* Move the private mutable lists from each capability onto the
-     * main mutable list for the generation.
-     */
-    for (i = 0; i < n_capabilities; i++) {
-	for (bd = capabilities[i].mut_lists[g]; 
-	     bd->link != NULL; bd = bd->link) {
-	    /* nothing */
-	}
-	bd->link = generations[g].mut_list;
-	generations[g].mut_list = capabilities[i].mut_lists[g];
-	capabilities[i].mut_lists[g] = allocBlock();
-    }
-  }
-
-  /* Allocate a mark stack if we're doing a major collection.
-   */
-  if (major_gc) {
-      mark_stack_bdescr = allocGroup(MARK_STACK_BLOCKS);
-      mark_stack = (StgPtr *)mark_stack_bdescr->start;
-      mark_sp    = mark_stack;
-      mark_splim = mark_stack + (MARK_STACK_BLOCKS * BLOCK_SIZE_W);
-  } else {
-      mark_stack_bdescr = NULL;
-  }
-
-  eager_promotion = rtsTrue; // for now
-
-  /* -----------------------------------------------------------------------
-   * follow all the roots that we know about:
-   *   - mutable lists from each generation > N
-   * we want to *scavenge* these roots, not evacuate them: they're not
-   * going to move in this GC.
-   * Also: do them in reverse generation order.  This is because we
-   * often want to promote objects that are pointed to by older
-   * generations early, so we don't have to repeatedly copy them.
-   * Doing the generations in reverse order ensures that we don't end
-   * up in the situation where we want to evac an object to gen 3 and
-   * it has already been evaced to gen 2.
-   */
-  { 
-    int st;
-    for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
-      generations[g].saved_mut_list = generations[g].mut_list;
-      generations[g].mut_list = allocBlock(); 
-        // mut_list always has at least one block.
-    }
-
-    for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
-      IF_PAR_DEBUG(verbose, printMutableList(&generations[g]));
-      scavenge_mutable_list(&generations[g]);
-      evac_gen = g;
-      for (st = generations[g].n_steps-1; st >= 0; st--) {
-	scavenge(&generations[g].steps[st]);
-      }
-    }
-  }
-
-  /* follow roots from the CAF list (used by GHCi)
-   */
-  evac_gen = 0;
-  markCAFs(mark_root);
-
-  /* follow all the roots that the application knows about.
-   */
-  evac_gen = 0;
-  get_roots(mark_root);
-
-#if defined(PAR)
-  /* And don't forget to mark the TSO if we got here direct from
-   * Haskell! */
-  /* Not needed in a seq version?
-  if (CurrentTSO) {
-    CurrentTSO = (StgTSO *)MarkRoot((StgClosure *)CurrentTSO);
-  }
-  */
-
-  // Mark the entries in the GALA table of the parallel system 
-  markLocalGAs(major_gc);
-  // Mark all entries on the list of pending fetches 
-  markPendingFetches(major_gc);
-#endif
-
-  /* Mark the weak pointer list, and prepare to detect dead weak
-   * pointers.
-   */
-  mark_weak_ptr_list(&weak_ptr_list);
-  old_weak_ptr_list = weak_ptr_list;
-  weak_ptr_list = NULL;
-  weak_stage = WeakPtrs;
-
-  /* The all_threads list is like the weak_ptr_list.  
-   * See traverse_weak_ptr_list() for the details.
-   */
-  old_all_threads = all_threads;
-  all_threads = END_TSO_QUEUE;
-  resurrected_threads = END_TSO_QUEUE;
-
-  /* Mark the stable pointer table.
-   */
-  markStablePtrTable(mark_root);
-
-  /* -------------------------------------------------------------------------
-   * Repeatedly scavenge all the areas we know about until there's no
-   * more scavenging to be done.
-   */
-  { 
-    rtsBool flag;
-  loop:
-    flag = rtsFalse;
-
-    // scavenge static objects 
-    if (major_gc && static_objects != END_OF_STATIC_LIST) {
-	IF_DEBUG(sanity, checkStaticObjects(static_objects));
-	scavenge_static();
-    }
-
-    /* When scavenging the older generations:  Objects may have been
-     * evacuated from generations <= N into older generations, and we
-     * need to scavenge these objects.  We're going to try to ensure that
-     * any evacuations that occur move the objects into at least the
-     * same generation as the object being scavenged, otherwise we
-     * have to create new entries on the mutable list for the older
-     * generation.
-     */
-
-    // scavenge each step in generations 0..maxgen 
-    { 
-      long gen;
-      int st; 
-
-    loop2:
-      // scavenge objects in compacted generation
-      if (mark_stack_overflowed || oldgen_scan_bd != NULL ||
-	  (mark_stack_bdescr != NULL && !mark_stack_empty())) {
-	  scavenge_mark_stack();
-	  flag = rtsTrue;
-      }
-
-      for (gen = RtsFlags.GcFlags.generations; --gen >= 0; ) {
-	for (st = generations[gen].n_steps; --st >= 0; ) {
-	  if (gen == 0 && st == 0 && RtsFlags.GcFlags.generations > 1) { 
-	    continue; 
-	  }
-	  stp = &generations[gen].steps[st];
-	  evac_gen = gen;
-	  if (stp->hp_bd != stp->scan_bd || stp->scan < stp->hp) {
-	    scavenge(stp);
-	    flag = rtsTrue;
-	    goto loop2;
-	  }
-	  if (stp->new_large_objects != NULL) {
-	    scavenge_large(stp);
-	    flag = rtsTrue;
-	    goto loop2;
-	  }
-	}
-      }
-    }
-
-    if (flag) { goto loop; }
-
-    // must be last...  invariant is that everything is fully
-    // scavenged at this point.
-    if (traverse_weak_ptr_list()) { // returns rtsTrue if evaced something 
-      goto loop;
-    }
-  }
-
-  /* Update the pointers from the task list - these are
-   * treated as weak pointers because we want to allow a main thread
-   * to get a BlockedOnDeadMVar exception in the same way as any other
-   * thread.  Note that the threads should all have been retained by
-   * GC by virtue of being on the all_threads list, we're just
-   * updating pointers here.
-   */
-  {
-      Task *task;
-      StgTSO *tso;
-      for (task = all_tasks; task != NULL; task = task->all_link) {
-	  if (!task->stopped && task->tso) {
-	      ASSERT(task->tso->bound == task);
-	      tso = (StgTSO *) isAlive((StgClosure *)task->tso);
-	      if (tso == NULL) {
-		  barf("task %p: main thread %d has been GC'd", 
-#ifdef THREADED_RTS
-		       (void *)task->id, 
-#else
-		       (void *)task,
-#endif
-		       task->tso->id);
-	      }
-	      task->tso = tso;
-	  }
-      }
-  }
-
-#if defined(PAR)
-  // Reconstruct the Global Address tables used in GUM 
-  rebuildGAtables(major_gc);
-  IF_DEBUG(sanity, checkLAGAtable(rtsTrue/*check closures, too*/));
-#endif
-
-  // Now see which stable names are still alive.
-  gcStablePtrTable();
-
-  // Tidy the end of the to-space chains 
-  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-      for (s = 0; s < generations[g].n_steps; s++) {
-	  stp = &generations[g].steps[s];
-	  if (!(g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1)) {
-	      ASSERT(Bdescr(stp->hp) == stp->hp_bd);
-	      stp->hp_bd->free = stp->hp;
-	      Bdescr(stp->scavd_hp)->free = stp->scavd_hp;
-	  }
-      }
-  }
-
-#ifdef PROFILING
-  // We call processHeapClosureForDead() on every closure destroyed during
-  // the current garbage collection, so we invoke LdvCensusForDead().
-  if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV
-      || RtsFlags.ProfFlags.bioSelector != NULL)
-    LdvCensusForDead(N);
-#endif
-
-  // NO MORE EVACUATION AFTER THIS POINT!
-  // Finally: compaction of the oldest generation.
-  if (major_gc && oldest_gen->steps[0].is_compacted) {
-      // save number of blocks for stats
-      oldgen_saved_blocks = oldest_gen->steps[0].n_old_blocks;
-      compact(get_roots);
-  }
-
-  IF_DEBUG(sanity, checkGlobalTSOList(rtsFalse));
-
-  /* run through all the generations/steps and tidy up 
-   */
-  copied = new_blocks * BLOCK_SIZE_W;
-  scavd_copied =  new_scavd_blocks * BLOCK_SIZE_W;
-  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-
-    if (g <= N) {
-      generations[g].collections++; // for stats 
-    }
-
-    // Count the mutable list as bytes "copied" for the purposes of
-    // stats.  Every mutable list is copied during every GC.
-    if (g > 0) {
-	nat mut_list_size = 0;
-	for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
-	    mut_list_size += bd->free - bd->start;
-	}
-	copied +=  mut_list_size;
-
-	IF_DEBUG(gc, debugBelch("mut_list_size: %ld (%d vars, %d arrays, %d others)\n", mut_list_size * sizeof(W_), mutlist_MUTVARS, mutlist_MUTARRS, mutlist_OTHERS));
-    }
-
-    for (s = 0; s < generations[g].n_steps; s++) {
-      bdescr *next;
-      stp = &generations[g].steps[s];
-
-      if (!(g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1)) {
-	// stats information: how much we copied 
-	if (g <= N) {
-	  copied -= stp->hp_bd->start + BLOCK_SIZE_W -
-	    stp->hp_bd->free;
-	  scavd_copied -= (P_)(BLOCK_ROUND_UP(stp->scavd_hp)) - stp->scavd_hp;
-	}
-      }
-
-      // for generations we collected... 
-      if (g <= N) {
-
-	/* free old memory and shift to-space into from-space for all
-	 * the collected steps (except the allocation area).  These
-	 * freed blocks will probaby be quickly recycled.
-	 */
-	if (!(g == 0 && s == 0)) {
-	    if (stp->is_compacted) {
-		// for a compacted step, just shift the new to-space
-		// onto the front of the now-compacted existing blocks.
-		for (bd = stp->blocks; bd != NULL; bd = bd->link) {
-		    bd->flags &= ~BF_EVACUATED;  // now from-space 
-		}
-		// tack the new blocks on the end of the existing blocks
-		if (stp->old_blocks != NULL) {
-		    for (bd = stp->old_blocks; bd != NULL; bd = next) {
-			// NB. this step might not be compacted next
-			// time, so reset the BF_COMPACTED flags.
-			// They are set before GC if we're going to
-			// compact.  (search for BF_COMPACTED above).
-			bd->flags &= ~BF_COMPACTED;
-			next = bd->link;
-			if (next == NULL) {
-			    bd->link = stp->blocks;
-			}
-		    }
-		    stp->blocks = stp->old_blocks;
-		}
-		// add the new blocks to the block tally
-		stp->n_blocks += stp->n_old_blocks;
-		ASSERT(countBlocks(stp->blocks) == stp->n_blocks);
-	    } else {
-		freeChain(stp->old_blocks);
-		for (bd = stp->blocks; bd != NULL; bd = bd->link) {
-		    bd->flags &= ~BF_EVACUATED;	 // now from-space 
-		}
-	    }
-	    stp->old_blocks = NULL;
-	    stp->n_old_blocks = 0;
-	}
-
-	/* LARGE OBJECTS.  The current live large objects are chained on
-	 * scavenged_large, having been moved during garbage
-	 * collection from large_objects.  Any objects left on
-	 * large_objects list are therefore dead, so we free them here.
-	 */
-	for (bd = stp->large_objects; bd != NULL; bd = next) {
-	  next = bd->link;
-	  freeGroup(bd);
-	  bd = next;
-	}
-
-	// update the count of blocks used by large objects
-	for (bd = stp->scavenged_large_objects; bd != NULL; bd = bd->link) {
-	  bd->flags &= ~BF_EVACUATED;
-	}
-	stp->large_objects  = stp->scavenged_large_objects;
-	stp->n_large_blocks = stp->n_scavenged_large_blocks;
-
-      } else {
-	// for older generations... 
-	
-	/* For older generations, we need to append the
-	 * scavenged_large_object list (i.e. large objects that have been
-	 * promoted during this GC) to the large_object list for that step.
-	 */
-	for (bd = stp->scavenged_large_objects; bd; bd = next) {
-	  next = bd->link;
-	  bd->flags &= ~BF_EVACUATED;
-	  dbl_link_onto(bd, &stp->large_objects);
-	}
-
-	// add the new blocks we promoted during this GC 
-	stp->n_large_blocks += stp->n_scavenged_large_blocks;
-      }
-    }
-  }
-
-  /* Reset the sizes of the older generations when we do a major
-   * collection.
-   *
-   * CURRENT STRATEGY: make all generations except zero the same size.
-   * We have to stay within the maximum heap size, and leave a certain
-   * percentage of the maximum heap size available to allocate into.
-   */
-  if (major_gc && RtsFlags.GcFlags.generations > 1) {
-      nat live, size, min_alloc;
-      nat max  = RtsFlags.GcFlags.maxHeapSize;
-      nat gens = RtsFlags.GcFlags.generations;
-
-      // live in the oldest generations
-      live = oldest_gen->steps[0].n_blocks +
-	     oldest_gen->steps[0].n_large_blocks;
-
-      // default max size for all generations except zero
-      size = stg_max(live * RtsFlags.GcFlags.oldGenFactor,
-		     RtsFlags.GcFlags.minOldGenSize);
-
-      // minimum size for generation zero
-      min_alloc = stg_max((RtsFlags.GcFlags.pcFreeHeap * max) / 200,
-			  RtsFlags.GcFlags.minAllocAreaSize);
-
-      // Auto-enable compaction when the residency reaches a
-      // certain percentage of the maximum heap size (default: 30%).
-      if (RtsFlags.GcFlags.generations > 1 &&
-	  (RtsFlags.GcFlags.compact ||
-	   (max > 0 &&
-	    oldest_gen->steps[0].n_blocks > 
-	    (RtsFlags.GcFlags.compactThreshold * max) / 100))) {
-	  oldest_gen->steps[0].is_compacted = 1;
-//	  debugBelch("compaction: on\n", live);
-      } else {
-	  oldest_gen->steps[0].is_compacted = 0;
-//	  debugBelch("compaction: off\n", live);
-      }
-
-      // if we're going to go over the maximum heap size, reduce the
-      // size of the generations accordingly.  The calculation is
-      // different if compaction is turned on, because we don't need
-      // to double the space required to collect the old generation.
-      if (max != 0) {
-
-	  // this test is necessary to ensure that the calculations
-	  // below don't have any negative results - we're working
-	  // with unsigned values here.
-	  if (max < min_alloc) {
-	      heapOverflow();
-	  }
-
-	  if (oldest_gen->steps[0].is_compacted) {
-	      if ( (size + (size - 1) * (gens - 2) * 2) + min_alloc > max ) {
-		  size = (max - min_alloc) / ((gens - 1) * 2 - 1);
-	      }
-	  } else {
-	      if ( (size * (gens - 1) * 2) + min_alloc > max ) {
-		  size = (max - min_alloc) / ((gens - 1) * 2);
-	      }
-	  }
-
-	  if (size < live) {
-	      heapOverflow();
-	  }
-      }
-
-#if 0
-      debugBelch("live: %d, min_alloc: %d, size : %d, max = %d\n", live,
-	      min_alloc, size, max);
-#endif
-
-      for (g = 0; g < gens; g++) {
-	  generations[g].max_blocks = size;
-      }
-  }
-
-  // Guess the amount of live data for stats.
-  live = calcLive();
-
-  /* Free the small objects allocated via allocate(), since this will
-   * all have been copied into G0S1 now.  
-   */
-  if (small_alloc_list != NULL) {
-    freeChain(small_alloc_list);
-  }
-  small_alloc_list = NULL;
-  alloc_blocks = 0;
-  alloc_Hp = NULL;
-  alloc_HpLim = NULL;
-  alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
-
-  // Start a new pinned_object_block
-  pinned_object_block = NULL;
-
-  /* Free the mark stack.
-   */
-  if (mark_stack_bdescr != NULL) {
-      freeGroup(mark_stack_bdescr);
-  }
-
-  /* Free any bitmaps.
-   */
-  for (g = 0; g <= N; g++) {
-      for (s = 0; s < generations[g].n_steps; s++) {
-	  stp = &generations[g].steps[s];
-	  if (stp->bitmap != NULL) {
-	      freeGroup(stp->bitmap);
-	      stp->bitmap = NULL;
-	  }
-      }
-  }
-
-  /* Two-space collector:
-   * Free the old to-space, and estimate the amount of live data.
-   */
-  if (RtsFlags.GcFlags.generations == 1) {
-    nat blocks;
-    
-    if (g0s0->old_blocks != NULL) {
-      freeChain(g0s0->old_blocks);
-    }
-    for (bd = g0s0->blocks; bd != NULL; bd = bd->link) {
-      bd->flags = 0;	// now from-space 
-    }
-    g0s0->old_blocks = g0s0->blocks;
-    g0s0->n_old_blocks = g0s0->n_blocks;
-    g0s0->blocks = saved_nursery;
-    g0s0->n_blocks = saved_n_blocks;
-
-    /* For a two-space collector, we need to resize the nursery. */
-    
-    /* set up a new nursery.  Allocate a nursery size based on a
-     * function of the amount of live data (by default a factor of 2)
-     * Use the blocks from the old nursery if possible, freeing up any
-     * left over blocks.
-     *
-     * If we get near the maximum heap size, then adjust our nursery
-     * size accordingly.  If the nursery is the same size as the live
-     * data (L), then we need 3L bytes.  We can reduce the size of the
-     * nursery to bring the required memory down near 2L bytes.
-     * 
-     * A normal 2-space collector would need 4L bytes to give the same
-     * performance we get from 3L bytes, reducing to the same
-     * performance at 2L bytes.
-     */
-    blocks = g0s0->n_old_blocks;
-
-    if ( RtsFlags.GcFlags.maxHeapSize != 0 &&
-	 blocks * RtsFlags.GcFlags.oldGenFactor * 2 > 
-	   RtsFlags.GcFlags.maxHeapSize ) {
-      long adjusted_blocks;  // signed on purpose 
-      int pc_free; 
-      
-      adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
-      IF_DEBUG(gc, debugBelch("@@ Near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks));
-      pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
-      if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even be < 0 */ {
-	heapOverflow();
-      }
-      blocks = adjusted_blocks;
-      
-    } else {
-      blocks *= RtsFlags.GcFlags.oldGenFactor;
-      if (blocks < RtsFlags.GcFlags.minAllocAreaSize) {
-	blocks = RtsFlags.GcFlags.minAllocAreaSize;
-      }
-    }
-    resizeNurseries(blocks);
-    
-  } else {
-    /* Generational collector:
-     * If the user has given us a suggested heap size, adjust our
-     * allocation area to make best use of the memory available.
-     */
-
-    if (RtsFlags.GcFlags.heapSizeSuggestion) {
-      long blocks;
-      nat needed = calcNeeded(); 	// approx blocks needed at next GC 
-
-      /* Guess how much will be live in generation 0 step 0 next time.
-       * A good approximation is obtained by finding the
-       * percentage of g0s0 that was live at the last minor GC.
-       */
-      if (N == 0) {
-	g0s0_pcnt_kept = (new_blocks * 100) / countNurseryBlocks();
-      }
-
-      /* Estimate a size for the allocation area based on the
-       * information available.  We might end up going slightly under
-       * or over the suggested heap size, but we should be pretty
-       * close on average.
-       *
-       * Formula:            suggested - needed
-       *                ----------------------------
-       *                    1 + g0s0_pcnt_kept/100
-       *
-       * where 'needed' is the amount of memory needed at the next
-       * collection for collecting all steps except g0s0.
-       */
-      blocks = 
-	(((long)RtsFlags.GcFlags.heapSizeSuggestion - (long)needed) * 100) /
-	(100 + (long)g0s0_pcnt_kept);
-      
-      if (blocks < (long)RtsFlags.GcFlags.minAllocAreaSize) {
-	blocks = RtsFlags.GcFlags.minAllocAreaSize;
-      }
-      
-      resizeNurseries((nat)blocks);
-
-    } else {
-      // we might have added extra large blocks to the nursery, so
-      // resize back to minAllocAreaSize again.
-      resizeNurseriesFixed(RtsFlags.GcFlags.minAllocAreaSize);
-    }
-  }
-
- // mark the garbage collected CAFs as dead 
-#if 0 && defined(DEBUG) // doesn't work at the moment 
-  if (major_gc) { gcCAFs(); }
-#endif
-  
-#ifdef PROFILING
-  // resetStaticObjectForRetainerProfiling() must be called before
-  // zeroing below.
-  resetStaticObjectForRetainerProfiling();
-#endif
-
-  // zero the scavenged static object list 
-  if (major_gc) {
-    zero_static_object_list(scavenged_static_objects);
-  }
-
-  // Reset the nursery
-  resetNurseries();
-
-  // start any pending finalizers 
-  RELEASE_SM_LOCK;
-  scheduleFinalizers(last_free_capability, old_weak_ptr_list);
-  ACQUIRE_SM_LOCK;
-  
-  // send exceptions to any threads which were about to die 
-  RELEASE_SM_LOCK;
-  resurrectThreads(resurrected_threads);
-  ACQUIRE_SM_LOCK;
-
-  // Update the stable pointer hash table.
-  updateStablePtrTable(major_gc);
-
-  // check sanity after GC 
-  IF_DEBUG(sanity, checkSanity());
-
-  // extra GC trace info 
-  IF_DEBUG(gc, statDescribeGens());
-
-#ifdef DEBUG
-  // symbol-table based profiling 
-  /*  heapCensus(to_blocks); */ /* ToDo */
-#endif
-
-  // restore enclosing cost centre 
-#ifdef PROFILING
-  CCCS = prev_CCS;
-#endif
-
-#ifdef DEBUG
-  // check for memory leaks if DEBUG is on 
-  memInventory();
-#endif
-
-#ifdef RTS_GTK_FRONTPANEL
-  if (RtsFlags.GcFlags.frontpanel) {
-      updateFrontPanelAfterGC( N, live );
-  }
-#endif
-
-  // ok, GC over: tell the stats department what happened. 
-  stat_endGC(allocated, live, copied, scavd_copied, N);
-
-#if defined(RTS_USER_SIGNALS)
-  // unblock signals again
-  unblockUserSignals();
-#endif
-
-  RELEASE_SM_LOCK;
-
-  //PAR_TICKY_TP();
-}
-
-
-/* -----------------------------------------------------------------------------
-   Weak Pointers
-
-   traverse_weak_ptr_list is called possibly many times during garbage
-   collection.  It returns a flag indicating whether it did any work
-   (i.e. called evacuate on any live pointers).
-
-   Invariant: traverse_weak_ptr_list is called when the heap is in an
-   idempotent state.  That means that there are no pending
-   evacuate/scavenge operations.  This invariant helps the weak
-   pointer code decide which weak pointers are dead - if there are no
-   new live weak pointers, then all the currently unreachable ones are
-   dead.
-
-   For generational GC: we just don't try to finalize weak pointers in
-   older generations than the one we're collecting.  This could
-   probably be optimised by keeping per-generation lists of weak
-   pointers, but for a few weak pointers this scheme will work.
-
-   There are three distinct stages to processing weak pointers:
-
-   - weak_stage == WeakPtrs
-
-     We process all the weak pointers whos keys are alive (evacuate
-     their values and finalizers), and repeat until we can find no new
-     live keys.  If no live keys are found in this pass, then we
-     evacuate the finalizers of all the dead weak pointers in order to
-     run them.
-
-   - weak_stage == WeakThreads
-
-     Now, we discover which *threads* are still alive.  Pointers to
-     threads from the all_threads and main thread lists are the
-     weakest of all: a pointers from the finalizer of a dead weak
-     pointer can keep a thread alive.  Any threads found to be unreachable
-     are evacuated and placed on the resurrected_threads list so we 
-     can send them a signal later.
-
-   - weak_stage == WeakDone
-
-     No more evacuation is done.
-
-   -------------------------------------------------------------------------- */
-
-static rtsBool 
-traverse_weak_ptr_list(void)
-{
-  StgWeak *w, **last_w, *next_w;
-  StgClosure *new;
-  rtsBool flag = rtsFalse;
-
-  switch (weak_stage) {
-
-  case WeakDone:
-      return rtsFalse;
-
-  case WeakPtrs:
-      /* doesn't matter where we evacuate values/finalizers to, since
-       * these pointers are treated as roots (iff the keys are alive).
-       */
-      evac_gen = 0;
-      
-      last_w = &old_weak_ptr_list;
-      for (w = old_weak_ptr_list; w != NULL; w = next_w) {
-	  
-	  /* There might be a DEAD_WEAK on the list if finalizeWeak# was
-	   * called on a live weak pointer object.  Just remove it.
-	   */
-	  if (w->header.info == &stg_DEAD_WEAK_info) {
-	      next_w = ((StgDeadWeak *)w)->link;
-	      *last_w = next_w;
-	      continue;
-	  }
-	  
-	  switch (get_itbl(w)->type) {
-
-	  case EVACUATED:
-	      next_w = (StgWeak *)((StgEvacuated *)w)->evacuee;
-	      *last_w = next_w;
-	      continue;
-
-	  case WEAK:
-	      /* Now, check whether the key is reachable.
-	       */
-	      new = isAlive(w->key);
-	      if (new != NULL) {
-		  w->key = new;
-		  // evacuate the value and finalizer 
-		  w->value = evacuate(w->value);
-		  w->finalizer = evacuate(w->finalizer);
-		  // remove this weak ptr from the old_weak_ptr list 
-		  *last_w = w->link;
-		  // and put it on the new weak ptr list 
-		  next_w  = w->link;
-		  w->link = weak_ptr_list;
-		  weak_ptr_list = w;
-		  flag = rtsTrue;
-		  IF_DEBUG(weak, debugBelch("Weak pointer still alive at %p -> %p", 
-				       w, w->key));
-		  continue;
-	      }
-	      else {
-		  last_w = &(w->link);
-		  next_w = w->link;
-		  continue;
-	      }
-
-	  default:
-	      barf("traverse_weak_ptr_list: not WEAK");
-	  }
-      }
-      
-      /* If we didn't make any changes, then we can go round and kill all
-       * the dead weak pointers.  The old_weak_ptr list is used as a list
-       * of pending finalizers later on.
-       */
-      if (flag == rtsFalse) {
-	  for (w = old_weak_ptr_list; w; w = w->link) {
-	      w->finalizer = evacuate(w->finalizer);
-	  }
-
-	  // Next, move to the WeakThreads stage after fully
-	  // scavenging the finalizers we've just evacuated.
-	  weak_stage = WeakThreads;
-      }
-
-      return rtsTrue;
-
-  case WeakThreads:
-      /* Now deal with the all_threads list, which behaves somewhat like
-       * the weak ptr list.  If we discover any threads that are about to
-       * become garbage, we wake them up and administer an exception.
-       */
-      {
-	  StgTSO *t, *tmp, *next, **prev;
-	  
-	  prev = &old_all_threads;
-	  for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
-	      
-	      tmp = (StgTSO *)isAlive((StgClosure *)t);
-	      
-	      if (tmp != NULL) {
-		  t = tmp;
-	      }
-	      
-	      ASSERT(get_itbl(t)->type == TSO);
-	      switch (t->what_next) {
-	      case ThreadRelocated:
-		  next = t->link;
-		  *prev = next;
-		  continue;
-	      case ThreadKilled:
-	      case ThreadComplete:
-		  // finshed or died.  The thread might still be alive, but we
-		  // don't keep it on the all_threads list.  Don't forget to
-		  // stub out its global_link field.
-		  next = t->global_link;
-		  t->global_link = END_TSO_QUEUE;
-		  *prev = next;
-		  continue;
-	      default:
-		  ;
-	      }
-	      
-	      // Threads blocked on black holes: if the black hole
-	      // is alive, then the thread is alive too.
-	      if (tmp == NULL && t->why_blocked == BlockedOnBlackHole) {
-		  if (isAlive(t->block_info.closure)) {
-		      t = (StgTSO *)evacuate((StgClosure *)t);
-		      tmp = t;
-		      flag = rtsTrue;
-		  }
-	      }
-
-	      if (tmp == NULL) {
-		  // not alive (yet): leave this thread on the
-		  // old_all_threads list.
-		  prev = &(t->global_link);
-		  next = t->global_link;
-	      } 
-	      else {
-		  // alive: move this thread onto the all_threads list.
-		  next = t->global_link;
-		  t->global_link = all_threads;
-		  all_threads  = t;
-		  *prev = next;
-	      }
-	  }
-      }
-      
-      /* If we evacuated any threads, we need to go back to the scavenger.
-       */
-      if (flag) return rtsTrue;
-
-      /* And resurrect any threads which were about to become garbage.
-       */
-      {
-	  StgTSO *t, *tmp, *next;
-	  for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
-	      next = t->global_link;
-	      tmp = (StgTSO *)evacuate((StgClosure *)t);
-	      tmp->global_link = resurrected_threads;
-	      resurrected_threads = tmp;
-	  }
-      }
-      
-      /* Finally, we can update the blackhole_queue.  This queue
-       * simply strings together TSOs blocked on black holes, it is
-       * not intended to keep anything alive.  Hence, we do not follow
-       * pointers on the blackhole_queue until now, when we have
-       * determined which TSOs are otherwise reachable.  We know at
-       * this point that all TSOs have been evacuated, however.
-       */
-      { 
-	  StgTSO **pt;
-	  for (pt = &blackhole_queue; *pt != END_TSO_QUEUE; pt = &((*pt)->link)) {
-	      *pt = (StgTSO *)isAlive((StgClosure *)*pt);
-	      ASSERT(*pt != NULL);
-	  }
-      }
-
-      weak_stage = WeakDone;  // *now* we're done,
-      return rtsTrue;         // but one more round of scavenging, please
-
-  default:
-      barf("traverse_weak_ptr_list");
-      return rtsTrue;
-  }
-
-}
-
-/* -----------------------------------------------------------------------------
-   After GC, the live weak pointer list may have forwarding pointers
-   on it, because a weak pointer object was evacuated after being
-   moved to the live weak pointer list.  We remove those forwarding
-   pointers here.
-
-   Also, we don't consider weak pointer objects to be reachable, but
-   we must nevertheless consider them to be "live" and retain them.
-   Therefore any weak pointer objects which haven't as yet been
-   evacuated need to be evacuated now.
-   -------------------------------------------------------------------------- */
-
-
-static void
-mark_weak_ptr_list ( StgWeak **list )
-{
-  StgWeak *w, **last_w;
-
-  last_w = list;
-  for (w = *list; w; w = w->link) {
-      // w might be WEAK, EVACUATED, or DEAD_WEAK (actually CON_STATIC) here
-      ASSERT(w->header.info == &stg_DEAD_WEAK_info 
-	     || get_itbl(w)->type == WEAK || get_itbl(w)->type == EVACUATED);
-      w = (StgWeak *)evacuate((StgClosure *)w);
-      *last_w = w;
-      last_w = &(w->link);
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   isAlive determines whether the given closure is still alive (after
-   a garbage collection) or not.  It returns the new address of the
-   closure if it is alive, or NULL otherwise.
-
-   NOTE: Use it before compaction only!
-   -------------------------------------------------------------------------- */
-
-
-StgClosure *
-isAlive(StgClosure *p)
-{
-  const StgInfoTable *info;
-  bdescr *bd;
-
-  while (1) {
-
-    ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
-    info = get_itbl(p);
-
-    // ignore static closures 
-    //
-    // ToDo: for static closures, check the static link field.
-    // Problem here is that we sometimes don't set the link field, eg.
-    // for static closures with an empty SRT or CONSTR_STATIC_NOCAFs.
-    //
-    if (!HEAP_ALLOCED(p)) {
-	return p;
-    }
-
-    // ignore closures in generations that we're not collecting. 
-    bd = Bdescr((P_)p);
-    if (bd->gen_no > N) {
-	return p;
-    }
-
-    // if it's a pointer into to-space, then we're done
-    if (bd->flags & BF_EVACUATED) {
-	return p;
-    }
-
-    // large objects use the evacuated flag
-    if (bd->flags & BF_LARGE) {
-	return NULL;
-    }
-
-    // check the mark bit for compacted steps
-    if ((bd->flags & BF_COMPACTED) && is_marked((P_)p,bd)) {
-	return p;
-    }
-
-    switch (info->type) {
-
-    case IND:
-    case IND_STATIC:
-    case IND_PERM:
-    case IND_OLDGEN:		// rely on compatible layout with StgInd 
-    case IND_OLDGEN_PERM:
-      // follow indirections 
-      p = ((StgInd *)p)->indirectee;
-      continue;
-
-    case EVACUATED:
-      // alive! 
-      return ((StgEvacuated *)p)->evacuee;
-
-    case TSO:
-      if (((StgTSO *)p)->what_next == ThreadRelocated) {
-	p = (StgClosure *)((StgTSO *)p)->link;
-	continue;
-      } 
-      return NULL;
-
-    default:
-      // dead. 
-      return NULL;
-    }
-  }
-}
-
-static void
-mark_root(StgClosure **root)
-{
-  *root = evacuate(*root);
-}
-
-STATIC_INLINE void 
-upd_evacuee(StgClosure *p, StgClosure *dest)
-{
-    // not true: (ToDo: perhaps it should be)
-    // ASSERT(Bdescr((P_)dest)->flags & BF_EVACUATED);
-    SET_INFO(p, &stg_EVACUATED_info);
-    ((StgEvacuated *)p)->evacuee = dest;
-}
-
-
-STATIC_INLINE StgClosure *
-copy(StgClosure *src, nat size, step *stp)
-{
-  StgPtr to, from;
-  nat i;
-#ifdef PROFILING
-  // @LDV profiling
-  nat size_org = size;
-#endif
-
-  TICK_GC_WORDS_COPIED(size);
-  /* Find out where we're going, using the handy "to" pointer in 
-   * the step of the source object.  If it turns out we need to
-   * evacuate to an older generation, adjust it here (see comment
-   * by evacuate()).
-   */
-  if (stp->gen_no < evac_gen) {
-      if (eager_promotion) {
-	  stp = &generations[evac_gen].steps[0];
-      } else {
-	  failed_to_evac = rtsTrue;
-      }
-  }
-
-  /* chain a new block onto the to-space for the destination step if
-   * necessary.
-   */
-  if (stp->hp + size >= stp->hpLim) {
-    gc_alloc_block(stp);
-  }
-
-  to = stp->hp;
-  from = (StgPtr)src;
-  stp->hp = to + size;
-  for (i = 0; i < size; i++) { // unroll for small i
-      to[i] = from[i];
-  }
-  upd_evacuee((StgClosure *)from,(StgClosure *)to);
-
-#ifdef PROFILING
-  // We store the size of the just evacuated object in the LDV word so that
-  // the profiler can guess the position of the next object later.
-  SET_EVACUAEE_FOR_LDV(from, size_org);
-#endif
-  return (StgClosure *)to;
-}
-
-// Same as copy() above, except the object will be allocated in memory
-// that will not be scavenged.  Used for object that have no pointer
-// fields.
-STATIC_INLINE StgClosure *
-copy_noscav(StgClosure *src, nat size, step *stp)
-{
-  StgPtr to, from;
-  nat i;
-#ifdef PROFILING
-  // @LDV profiling
-  nat size_org = size;
-#endif
-
-  TICK_GC_WORDS_COPIED(size);
-  /* Find out where we're going, using the handy "to" pointer in 
-   * the step of the source object.  If it turns out we need to
-   * evacuate to an older generation, adjust it here (see comment
-   * by evacuate()).
-   */
-  if (stp->gen_no < evac_gen) {
-      if (eager_promotion) {
-	  stp = &generations[evac_gen].steps[0];
-      } else {
-	  failed_to_evac = rtsTrue;
-      }
-  }
-
-  /* chain a new block onto the to-space for the destination step if
-   * necessary.
-   */
-  if (stp->scavd_hp + size >= stp->scavd_hpLim) {
-    gc_alloc_scavd_block(stp);
-  }
-
-  to = stp->scavd_hp;
-  from = (StgPtr)src;
-  stp->scavd_hp = to + size;
-  for (i = 0; i < size; i++) { // unroll for small i
-      to[i] = from[i];
-  }
-  upd_evacuee((StgClosure *)from,(StgClosure *)to);
-
-#ifdef PROFILING
-  // We store the size of the just evacuated object in the LDV word so that
-  // the profiler can guess the position of the next object later.
-  SET_EVACUAEE_FOR_LDV(from, size_org);
-#endif
-  return (StgClosure *)to;
-}
-
-/* Special version of copy() for when we only want to copy the info
- * pointer of an object, but reserve some padding after it.  This is
- * used to optimise evacuation of BLACKHOLEs.
- */
-
-
-static StgClosure *
-copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
-{
-  P_ dest, to, from;
-#ifdef PROFILING
-  // @LDV profiling
-  nat size_to_copy_org = size_to_copy;
-#endif
-
-  TICK_GC_WORDS_COPIED(size_to_copy);
-  if (stp->gen_no < evac_gen) {
-      if (eager_promotion) {
-	  stp = &generations[evac_gen].steps[0];
-      } else {
-	  failed_to_evac = rtsTrue;
-      }
-  }
-
-  if (stp->hp + size_to_reserve >= stp->hpLim) {
-    gc_alloc_block(stp);
-  }
-
-  for(to = stp->hp, from = (P_)src; size_to_copy>0; --size_to_copy) {
-    *to++ = *from++;
-  }
-  
-  dest = stp->hp;
-  stp->hp += size_to_reserve;
-  upd_evacuee(src,(StgClosure *)dest);
-#ifdef PROFILING
-  // We store the size of the just evacuated object in the LDV word so that
-  // the profiler can guess the position of the next object later.
-  // size_to_copy_org is wrong because the closure already occupies size_to_reserve
-  // words.
-  SET_EVACUAEE_FOR_LDV(src, size_to_reserve);
-  // fill the slop
-  if (size_to_reserve - size_to_copy_org > 0)
-    LDV_FILL_SLOP(stp->hp - 1, (int)(size_to_reserve - size_to_copy_org)); 
-#endif
-  return (StgClosure *)dest;
-}
-
-
-/* -----------------------------------------------------------------------------
-   Evacuate a large object
-
-   This just consists of removing the object from the (doubly-linked)
-   step->large_objects list, and linking it on to the (singly-linked)
-   step->new_large_objects list, from where it will be scavenged later.
-
-   Convention: bd->flags has BF_EVACUATED set for a large object
-   that has been evacuated, or unset otherwise.
-   -------------------------------------------------------------------------- */
-
-
-STATIC_INLINE void
-evacuate_large(StgPtr p)
-{
-  bdescr *bd = Bdescr(p);
-  step *stp;
-
-  // object must be at the beginning of the block (or be a ByteArray)
-  ASSERT(get_itbl((StgClosure *)p)->type == ARR_WORDS ||
-	 (((W_)p & BLOCK_MASK) == 0));
-
-  // already evacuated? 
-  if (bd->flags & BF_EVACUATED) { 
-    /* Don't forget to set the failed_to_evac flag if we didn't get
-     * the desired destination (see comments in evacuate()).
-     */
-    if (bd->gen_no < evac_gen) {
-      failed_to_evac = rtsTrue;
-      TICK_GC_FAILED_PROMOTION();
-    }
-    return;
-  }
-
-  stp = bd->step;
-  // remove from large_object list 
-  if (bd->u.back) {
-    bd->u.back->link = bd->link;
-  } else { // first object in the list 
-    stp->large_objects = bd->link;
-  }
-  if (bd->link) {
-    bd->link->u.back = bd->u.back;
-  }
-  
-  /* link it on to the evacuated large object list of the destination step
-   */
-  stp = bd->step->to;
-  if (stp->gen_no < evac_gen) {
-      if (eager_promotion) {
-	  stp = &generations[evac_gen].steps[0];
-      } else {
-	  failed_to_evac = rtsTrue;
-      }
-  }
-
-  bd->step = stp;
-  bd->gen_no = stp->gen_no;
-  bd->link = stp->new_large_objects;
-  stp->new_large_objects = bd;
-  bd->flags |= BF_EVACUATED;
-}
-
-/* -----------------------------------------------------------------------------
-   Evacuate
-
-   This is called (eventually) for every live object in the system.
-
-   The caller to evacuate specifies a desired generation in the
-   evac_gen global variable.  The following conditions apply to
-   evacuating an object which resides in generation M when we're
-   collecting up to generation N
-
-   if  M >= evac_gen 
-           if  M > N     do nothing
-	   else          evac to step->to
-
-   if  M < evac_gen      evac to evac_gen, step 0
-
-   if the object is already evacuated, then we check which generation
-   it now resides in.
-
-   if  M >= evac_gen     do nothing
-   if  M <  evac_gen     set failed_to_evac flag to indicate that we
-                         didn't manage to evacuate this object into evac_gen.
-
-
-   OPTIMISATION NOTES:
-
-   evacuate() is the single most important function performance-wise
-   in the GC.  Various things have been tried to speed it up, but as
-   far as I can tell the code generated by gcc 3.2 with -O2 is about
-   as good as it's going to get.  We pass the argument to evacuate()
-   in a register using the 'regparm' attribute (see the prototype for
-   evacuate() near the top of this file).
-
-   Changing evacuate() to take an (StgClosure **) rather than
-   returning the new pointer seems attractive, because we can avoid
-   writing back the pointer when it hasn't changed (eg. for a static
-   object, or an object in a generation > N).  However, I tried it and
-   it doesn't help.  One reason is that the (StgClosure **) pointer
-   gets spilled to the stack inside evacuate(), resulting in far more
-   extra reads/writes than we save.
-   -------------------------------------------------------------------------- */
-
-REGPARM1 static StgClosure *
-evacuate(StgClosure *q)
-{
-#if defined(PAR)
-  StgClosure *to;
-#endif
-  bdescr *bd = NULL;
-  step *stp;
-  const StgInfoTable *info;
-
-loop:
-  ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
-
-  if (!HEAP_ALLOCED(q)) {
-
-      if (!major_gc) return q;
-
-      info = get_itbl(q);
-      switch (info->type) {
-
-      case THUNK_STATIC:
-	  if (info->srt_bitmap != 0 && 
-	      *THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
-	      *THUNK_STATIC_LINK((StgClosure *)q) = static_objects;
-	      static_objects = (StgClosure *)q;
-	  }
-	  return q;
-	  
-      case FUN_STATIC:
-	  if (info->srt_bitmap != 0 && 
-	      *FUN_STATIC_LINK((StgClosure *)q) == NULL) {
-	      *FUN_STATIC_LINK((StgClosure *)q) = static_objects;
-	      static_objects = (StgClosure *)q;
-	  }
-	  return q;
-	  
-      case IND_STATIC:
-	  /* If q->saved_info != NULL, then it's a revertible CAF - it'll be
-	   * on the CAF list, so don't do anything with it here (we'll
-	   * scavenge it later).
-	   */
-	  if (((StgIndStatic *)q)->saved_info == NULL
-	      && *IND_STATIC_LINK((StgClosure *)q) == NULL) {
-	      *IND_STATIC_LINK((StgClosure *)q) = static_objects;
-	      static_objects = (StgClosure *)q;
-	  }
-	  return q;
-	  
-      case CONSTR_STATIC:
-	  if (*STATIC_LINK(info,(StgClosure *)q) == NULL) {
-	      *STATIC_LINK(info,(StgClosure *)q) = static_objects;
-	      static_objects = (StgClosure *)q;
-	  }
-	  return q;
-	  
-      case CONSTR_INTLIKE:
-      case CONSTR_CHARLIKE:
-      case CONSTR_NOCAF_STATIC:
-	  /* no need to put these on the static linked list, they don't need
-	   * to be scavenged.
-	   */
-	  return q;
-	  
-      default:
-	  barf("evacuate(static): strange closure type %d", (int)(info->type));
-      }
-  }
-
-  bd = Bdescr((P_)q);
-
-  if (bd->gen_no > N) {
-      /* Can't evacuate this object, because it's in a generation
-       * older than the ones we're collecting.  Let's hope that it's
-       * in evac_gen or older, or we will have to arrange to track
-       * this pointer using the mutable list.
-       */
-      if (bd->gen_no < evac_gen) {
-	  // nope 
-	  failed_to_evac = rtsTrue;
-	  TICK_GC_FAILED_PROMOTION();
-      }
-      return q;
-  }
-
-  if ((bd->flags & (BF_LARGE | BF_COMPACTED | BF_EVACUATED)) != 0) {
-
-      /* pointer into to-space: just return it.  This normally
-       * shouldn't happen, but alllowing it makes certain things
-       * slightly easier (eg. the mutable list can contain the same
-       * object twice, for example).
-       */
-      if (bd->flags & BF_EVACUATED) {
-	  if (bd->gen_no < evac_gen) {
-	      failed_to_evac = rtsTrue;
-	      TICK_GC_FAILED_PROMOTION();
-	  }
-	  return q;
-      }
-
-      /* evacuate large objects by re-linking them onto a different list.
-       */
-      if (bd->flags & BF_LARGE) {
-	  info = get_itbl(q);
-	  if (info->type == TSO && 
-	      ((StgTSO *)q)->what_next == ThreadRelocated) {
-	      q = (StgClosure *)((StgTSO *)q)->link;
-	      goto loop;
-	  }
-	  evacuate_large((P_)q);
-	  return q;
-      }
-      
-      /* If the object is in a step that we're compacting, then we
-       * need to use an alternative evacuate procedure.
-       */
-      if (bd->flags & BF_COMPACTED) {
-	  if (!is_marked((P_)q,bd)) {
-	      mark((P_)q,bd);
-	      if (mark_stack_full()) {
-		  mark_stack_overflowed = rtsTrue;
-		  reset_mark_stack();
-	      }
-	      push_mark_stack((P_)q);
-	  }
-	  return q;
-      }
-  }
-      
-  stp = bd->step->to;
-
-  info = get_itbl(q);
-  
-  switch (info->type) {
-
-  case MUT_VAR_CLEAN:
-  case MUT_VAR_DIRTY:
-  case MVAR:
-      return copy(q,sizeW_fromITBL(info),stp);
-
-  case CONSTR_0_1:
-  { 
-      StgWord w = (StgWord)q->payload[0];
-      if (q->header.info == Czh_con_info &&
-	  // unsigned, so always true:  (StgChar)w >= MIN_CHARLIKE &&  
-	  (StgChar)w <= MAX_CHARLIKE) {
-	  return (StgClosure *)CHARLIKE_CLOSURE((StgChar)w);
-      }
-      if (q->header.info == Izh_con_info &&
-	  (StgInt)w >= MIN_INTLIKE && (StgInt)w <= MAX_INTLIKE) {
-	  return (StgClosure *)INTLIKE_CLOSURE((StgInt)w);
-      }
-      // else
-      return copy_noscav(q,sizeofW(StgHeader)+1,stp);
-  }
-
-  case FUN_0_1:
-  case FUN_1_0:
-  case CONSTR_1_0:
-    return copy(q,sizeofW(StgHeader)+1,stp);
-
-  case THUNK_1_0:
-  case THUNK_0_1:
-    return copy(q,sizeofW(StgThunk)+1,stp);
-
-  case THUNK_1_1:
-  case THUNK_2_0:
-  case THUNK_0_2:
-#ifdef NO_PROMOTE_THUNKS
-    if (bd->gen_no == 0 && 
-	bd->step->no != 0 &&
-	bd->step->no == generations[bd->gen_no].n_steps-1) {
-      stp = bd->step;
-    }
-#endif
-    return copy(q,sizeofW(StgThunk)+2,stp);
-
-  case FUN_1_1:
-  case FUN_2_0:
-  case CONSTR_1_1:
-  case CONSTR_2_0:
-  case FUN_0_2:
-    return copy(q,sizeofW(StgHeader)+2,stp);
-
-  case CONSTR_0_2:
-    return copy_noscav(q,sizeofW(StgHeader)+2,stp);
-
-  case THUNK:
-    return copy(q,thunk_sizeW_fromITBL(info),stp);
-
-  case FUN:
-  case CONSTR:
-  case IND_PERM:
-  case IND_OLDGEN_PERM:
-  case WEAK:
-  case STABLE_NAME:
-    return copy(q,sizeW_fromITBL(info),stp);
-
-  case BCO:
-      return copy(q,bco_sizeW((StgBCO *)q),stp);
-
-  case CAF_BLACKHOLE:
-  case SE_CAF_BLACKHOLE:
-  case SE_BLACKHOLE:
-  case BLACKHOLE:
-    return copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),stp);
-
-  case THUNK_SELECTOR:
-    {
-	StgClosure *p;
-	const StgInfoTable *info_ptr;
-
-	if (thunk_selector_depth > MAX_THUNK_SELECTOR_DEPTH) {
-	    return copy(q,THUNK_SELECTOR_sizeW(),stp);
-	}
-
-	// stashed away for LDV profiling, see below
-	info_ptr = q->header.info;
-
-	p = eval_thunk_selector(info->layout.selector_offset,
-				(StgSelector *)q);
-
-	if (p == NULL) {
-	    return copy(q,THUNK_SELECTOR_sizeW(),stp);
-	} else {
-	    StgClosure *val;
-	    // q is still BLACKHOLE'd.
-	    thunk_selector_depth++;
-	    val = evacuate(p);
-	    thunk_selector_depth--;
-
-#ifdef PROFILING
-	    // For the purposes of LDV profiling, we have destroyed
-	    // the original selector thunk.
-	    SET_INFO(q, info_ptr);
-	    LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(q);
-#endif
-
-	    // Update the THUNK_SELECTOR with an indirection to the
-	    // EVACUATED closure now at p.  Why do this rather than
-	    // upd_evacuee(q,p)?  Because we have an invariant that an
-	    // EVACUATED closure always points to an object in the
-	    // same or an older generation (required by the short-cut
-	    // test in the EVACUATED case, below).
-	    SET_INFO(q, &stg_IND_info);
-	    ((StgInd *)q)->indirectee = p;
-
-	    // For the purposes of LDV profiling, we have created an
-	    // indirection.
-	    LDV_RECORD_CREATE(q);
-
-	    return val;
-	}
-    }
-
-  case IND:
-  case IND_OLDGEN:
-    // follow chains of indirections, don't evacuate them 
-    q = ((StgInd*)q)->indirectee;
-    goto loop;
-
-  case RET_BCO:
-  case RET_SMALL:
-  case RET_VEC_SMALL:
-  case RET_BIG:
-  case RET_VEC_BIG:
-  case RET_DYN:
-  case UPDATE_FRAME:
-  case STOP_FRAME:
-  case CATCH_FRAME:
-  case CATCH_STM_FRAME:
-  case CATCH_RETRY_FRAME:
-  case ATOMICALLY_FRAME:
-    // shouldn't see these 
-    barf("evacuate: stack frame at %p\n", q);
-
-  case PAP:
-      return copy(q,pap_sizeW((StgPAP*)q),stp);
-
-  case AP:
-      return copy(q,ap_sizeW((StgAP*)q),stp);
-
-  case AP_STACK:
-      return copy(q,ap_stack_sizeW((StgAP_STACK*)q),stp);
-
-  case EVACUATED:
-    /* Already evacuated, just return the forwarding address.
-     * HOWEVER: if the requested destination generation (evac_gen) is
-     * older than the actual generation (because the object was
-     * already evacuated to a younger generation) then we have to
-     * set the failed_to_evac flag to indicate that we couldn't 
-     * manage to promote the object to the desired generation.
-     */
-    /* 
-     * Optimisation: the check is fairly expensive, but we can often
-     * shortcut it if either the required generation is 0, or the
-     * current object (the EVACUATED) is in a high enough generation.
-     * We know that an EVACUATED always points to an object in the
-     * same or an older generation.  stp is the lowest step that the
-     * current object would be evacuated to, so we only do the full
-     * check if stp is too low.
-     */
-    if (evac_gen > 0 && stp->gen_no < evac_gen) {  // optimisation 
-      StgClosure *p = ((StgEvacuated*)q)->evacuee;
-      if (HEAP_ALLOCED(p) && Bdescr((P_)p)->gen_no < evac_gen) {
-	failed_to_evac = rtsTrue;
-	TICK_GC_FAILED_PROMOTION();
-      }
-    }
-    return ((StgEvacuated*)q)->evacuee;
-
-  case ARR_WORDS:
-      // just copy the block 
-      return copy_noscav(q,arr_words_sizeW((StgArrWords *)q),stp);
-
-  case MUT_ARR_PTRS_CLEAN:
-  case MUT_ARR_PTRS_DIRTY:
-  case MUT_ARR_PTRS_FROZEN:
-  case MUT_ARR_PTRS_FROZEN0:
-      // just copy the block 
-      return copy(q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),stp);
-
-  case TSO:
-    {
-      StgTSO *tso = (StgTSO *)q;
-
-      /* Deal with redirected TSOs (a TSO that's had its stack enlarged).
-       */
-      if (tso->what_next == ThreadRelocated) {
-	q = (StgClosure *)tso->link;
-	goto loop;
-      }
-
-      /* To evacuate a small TSO, we need to relocate the update frame
-       * list it contains.  
-       */
-      {
-	  StgTSO *new_tso;
-	  StgPtr p, q;
-
-	  new_tso = (StgTSO *)copyPart((StgClosure *)tso,
-				       tso_sizeW(tso),
-				       sizeofW(StgTSO), stp);
-	  move_TSO(tso, new_tso);
-	  for (p = tso->sp, q = new_tso->sp;
-	       p < tso->stack+tso->stack_size;) {
-	      *q++ = *p++;
-	  }
-	  
-	  return (StgClosure *)new_tso;
-      }
-    }
-
-#if defined(PAR)
-  case RBH:
-    {
-      //StgInfoTable *rip = get_closure_info(q, &size, &ptrs, &nonptrs, &vhs, str);
-      to = copy(q,BLACKHOLE_sizeW(),stp); 
-      //ToDo: derive size etc from reverted IP
-      //to = copy(q,size,stp);
-      IF_DEBUG(gc,
-	       debugBelch("@@ evacuate: RBH %p (%s) to %p (%s)",
-		     q, info_type(q), to, info_type(to)));
-      return to;
-    }
-
-  case BLOCKED_FETCH:
-    ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOD_SIZE);
-    to = copy(q,sizeofW(StgBlockedFetch),stp);
-    IF_DEBUG(gc,
-	     debugBelch("@@ evacuate: %p (%s) to %p (%s)",
-		   q, info_type(q), to, info_type(to)));
-    return to;
-
-# ifdef DIST    
-  case REMOTE_REF:
-# endif
-  case FETCH_ME:
-    ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOAD_SIZE);
-    to = copy(q,sizeofW(StgFetchMe),stp);
-    IF_DEBUG(gc,
-	     debugBelch("@@ evacuate: %p (%s) to %p (%s)",
-		   q, info_type(q), to, info_type(to)));
-    return to;
-
-  case FETCH_ME_BQ:
-    ASSERT(sizeofW(StgBlockedFetch) >= MIN_PAYLOAD_SIZE);
-    to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp);
-    IF_DEBUG(gc,
-	     debugBelch("@@ evacuate: %p (%s) to %p (%s)",
-		   q, info_type(q), to, info_type(to)));
-    return to;
-#endif
-
-  case TREC_HEADER: 
-    return copy(q,sizeofW(StgTRecHeader),stp);
-
-  case TVAR_WAIT_QUEUE:
-    return copy(q,sizeofW(StgTVarWaitQueue),stp);
-
-  case TVAR:
-    return copy(q,sizeofW(StgTVar),stp);
-    
-  case TREC_CHUNK:
-    return copy(q,sizeofW(StgTRecChunk),stp);
-
-  default:
-    barf("evacuate: strange closure type %d", (int)(info->type));
-  }
-
-  barf("evacuate");
-}
-
-/* -----------------------------------------------------------------------------
-   Evaluate a THUNK_SELECTOR if possible.
-
-   returns: NULL if we couldn't evaluate this THUNK_SELECTOR, or
-   a closure pointer if we evaluated it and this is the result.  Note
-   that "evaluating" the THUNK_SELECTOR doesn't necessarily mean
-   reducing it to HNF, just that we have eliminated the selection.
-   The result might be another thunk, or even another THUNK_SELECTOR.
-
-   If the return value is non-NULL, the original selector thunk has
-   been BLACKHOLE'd, and should be updated with an indirection or a
-   forwarding pointer.  If the return value is NULL, then the selector
-   thunk is unchanged.
-
-   ***
-   ToDo: the treatment of THUNK_SELECTORS could be improved in the
-   following way (from a suggestion by Ian Lynagh):
-
-   We can have a chain like this:
-
-      sel_0 --> (a,b)
-                 |
-                 |-----> sel_0 --> (a,b)
-                                    |
-                                    |-----> sel_0 --> ...
-
-   and the depth limit means we don't go all the way to the end of the
-   chain, which results in a space leak.  This affects the recursive
-   call to evacuate() in the THUNK_SELECTOR case in evacuate(): *not*
-   the recursive call to eval_thunk_selector() in
-   eval_thunk_selector().
-
-   We could eliminate the depth bound in this case, in the following
-   way:
-
-      - traverse the chain once to discover the *value* of the 
-        THUNK_SELECTOR.  Mark all THUNK_SELECTORS that we
-        visit on the way as having been visited already (somehow).
-
-      - in a second pass, traverse the chain again updating all
-        THUNK_SEELCTORS that we find on the way with indirections to
-        the value.
-
-      - if we encounter a "marked" THUNK_SELECTOR in a normal 
-        evacuate(), we konw it can't be updated so just evac it.
-
-   Program that illustrates the problem:
-
-	foo [] = ([], [])
-	foo (x:xs) = let (ys, zs) = foo xs
-	             in if x >= 0 then (x:ys, zs) else (ys, x:zs)
-
-	main = bar [1..(100000000::Int)]
-	bar xs = (\(ys, zs) -> print ys >> print zs) (foo xs)
-
-   -------------------------------------------------------------------------- */
-
-static inline rtsBool
-is_to_space ( StgClosure *p )
-{
-    bdescr *bd;
-
-    bd = Bdescr((StgPtr)p);
-    if (HEAP_ALLOCED(p) &&
-	((bd->flags & BF_EVACUATED) 
-	 || ((bd->flags & BF_COMPACTED) &&
-	     is_marked((P_)p,bd)))) {
-	return rtsTrue;
-    } else {
-	return rtsFalse;
-    }
-}    
-
-static StgClosure *
-eval_thunk_selector( nat field, StgSelector * p )
-{
-    StgInfoTable *info;
-    const StgInfoTable *info_ptr;
-    StgClosure *selectee;
-    
-    selectee = p->selectee;
-
-    // Save the real info pointer (NOTE: not the same as get_itbl()).
-    info_ptr = p->header.info;
-
-    // If the THUNK_SELECTOR is in a generation that we are not
-    // collecting, then bail out early.  We won't be able to save any
-    // space in any case, and updating with an indirection is trickier
-    // in an old gen.
-    if (Bdescr((StgPtr)p)->gen_no > N) {
-	return NULL;
-    }
-
-    // BLACKHOLE the selector thunk, since it is now under evaluation.
-    // This is important to stop us going into an infinite loop if
-    // this selector thunk eventually refers to itself.
-    SET_INFO(p,&stg_BLACKHOLE_info);
-
-selector_loop:
-
-    // We don't want to end up in to-space, because this causes
-    // problems when the GC later tries to evacuate the result of
-    // eval_thunk_selector().  There are various ways this could
-    // happen:
-    //
-    // 1. following an IND_STATIC
-    //
-    // 2. when the old generation is compacted, the mark phase updates
-    //    from-space pointers to be to-space pointers, and we can't
-    //    reliably tell which we're following (eg. from an IND_STATIC).
-    // 
-    // 3. compacting GC again: if we're looking at a constructor in
-    //    the compacted generation, it might point directly to objects
-    //    in to-space.  We must bale out here, otherwise doing the selection
-    //    will result in a to-space pointer being returned.
-    //
-    //  (1) is dealt with using a BF_EVACUATED test on the
-    //  selectee. (2) and (3): we can tell if we're looking at an
-    //  object in the compacted generation that might point to
-    //  to-space objects by testing that (a) it is BF_COMPACTED, (b)
-    //  the compacted generation is being collected, and (c) the
-    //  object is marked.  Only a marked object may have pointers that
-    //  point to to-space objects, because that happens when
-    //  scavenging.
-    //
-    //  The to-space test is now embodied in the in_to_space() inline
-    //  function, as it is re-used below.
-    //
-    if (is_to_space(selectee)) {
-	goto bale_out;
-    }
-
-    info = get_itbl(selectee);
-    switch (info->type) {
-      case CONSTR:
-      case CONSTR_1_0:
-      case CONSTR_0_1:
-      case CONSTR_2_0:
-      case CONSTR_1_1:
-      case CONSTR_0_2:
-      case CONSTR_STATIC:
-      case CONSTR_NOCAF_STATIC:
-	  // check that the size is in range 
-	  ASSERT(field <  (StgWord32)(info->layout.payload.ptrs + 
-				      info->layout.payload.nptrs));
-	  
-	  // Select the right field from the constructor, and check
-	  // that the result isn't in to-space.  It might be in
-	  // to-space if, for example, this constructor contains
-	  // pointers to younger-gen objects (and is on the mut-once
-	  // list).
-	  //
-	  { 
-	      StgClosure *q;
-	      q = selectee->payload[field];
-	      if (is_to_space(q)) {
-		  goto bale_out;
-	      } else {
-		  return q;
-	      }
-	  }
-
-      case IND:
-      case IND_PERM:
-      case IND_OLDGEN:
-      case IND_OLDGEN_PERM:
-      case IND_STATIC:
-	  selectee = ((StgInd *)selectee)->indirectee;
-	  goto selector_loop;
-
-      case EVACUATED:
-	  // We don't follow pointers into to-space; the constructor
-	  // has already been evacuated, so we won't save any space
-	  // leaks by evaluating this selector thunk anyhow.
-	  break;
-
-      case THUNK_SELECTOR:
-      {
-	  StgClosure *val;
-
-	  // check that we don't recurse too much, re-using the
-	  // depth bound also used in evacuate().
-	  if (thunk_selector_depth >= MAX_THUNK_SELECTOR_DEPTH) {
-	      break;
-	  }
-	  thunk_selector_depth++;
-
-	  val = eval_thunk_selector(info->layout.selector_offset, 
-				    (StgSelector *)selectee);
-
-	  thunk_selector_depth--;
-
-	  if (val == NULL) { 
-	      break;
-	  } else {
-	      // We evaluated this selector thunk, so update it with
-	      // an indirection.  NOTE: we don't use UPD_IND here,
-	      // because we are guaranteed that p is in a generation
-	      // that we are collecting, and we never want to put the
-	      // indirection on a mutable list.
-#ifdef PROFILING
-	      // For the purposes of LDV profiling, we have destroyed
-	      // the original selector thunk.
-	      SET_INFO(p, info_ptr);
-	      LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(selectee);
-#endif
-	      ((StgInd *)selectee)->indirectee = val;
-	      SET_INFO(selectee,&stg_IND_info);
-
-	      // For the purposes of LDV profiling, we have created an
-	      // indirection.
-	      LDV_RECORD_CREATE(selectee);
-
-	      selectee = val;
-	      goto selector_loop;
-	  }
-      }
-
-      case AP:
-      case AP_STACK:
-      case THUNK:
-      case THUNK_1_0:
-      case THUNK_0_1:
-      case THUNK_2_0:
-      case THUNK_1_1:
-      case THUNK_0_2:
-      case THUNK_STATIC:
-      case CAF_BLACKHOLE:
-      case SE_CAF_BLACKHOLE:
-      case SE_BLACKHOLE:
-      case BLACKHOLE:
-#if defined(PAR)
-      case RBH:
-      case BLOCKED_FETCH:
-# ifdef DIST    
-      case REMOTE_REF:
-# endif
-      case FETCH_ME:
-      case FETCH_ME_BQ:
-#endif
-	  // not evaluated yet 
-	  break;
-    
-      default:
-	barf("eval_thunk_selector: strange selectee %d",
-	     (int)(info->type));
-    }
-
-bale_out:
-    // We didn't manage to evaluate this thunk; restore the old info pointer
-    SET_INFO(p, info_ptr);
-    return NULL;
-}
-
-/* -----------------------------------------------------------------------------
-   move_TSO is called to update the TSO structure after it has been
-   moved from one place to another.
-   -------------------------------------------------------------------------- */
-
-void
-move_TSO (StgTSO *src, StgTSO *dest)
-{
-    ptrdiff_t diff;
-
-    // relocate the stack pointer... 
-    diff = (StgPtr)dest - (StgPtr)src; // In *words* 
-    dest->sp = (StgPtr)dest->sp + diff;
-}
-
-/* Similar to scavenge_large_bitmap(), but we don't write back the
- * pointers we get back from evacuate().
- */
-static void
-scavenge_large_srt_bitmap( StgLargeSRT *large_srt )
-{
-    nat i, b, size;
-    StgWord bitmap;
-    StgClosure **p;
-    
-    b = 0;
-    bitmap = large_srt->l.bitmap[b];
-    size   = (nat)large_srt->l.size;
-    p      = (StgClosure **)large_srt->srt;
-    for (i = 0; i < size; ) {
-	if ((bitmap & 1) != 0) {
-	    evacuate(*p);
-	}
-	i++;
-	p++;
-	if (i % BITS_IN(W_) == 0) {
-	    b++;
-	    bitmap = large_srt->l.bitmap[b];
-	} else {
-	    bitmap = bitmap >> 1;
-	}
-    }
-}
-
-/* evacuate the SRT.  If srt_bitmap is zero, then there isn't an
- * srt field in the info table.  That's ok, because we'll
- * never dereference it.
- */
-STATIC_INLINE void
-scavenge_srt (StgClosure **srt, nat srt_bitmap)
-{
-  nat bitmap;
-  StgClosure **p;
-
-  bitmap = srt_bitmap;
-  p = srt;
-
-  if (bitmap == (StgHalfWord)(-1)) {  
-      scavenge_large_srt_bitmap( (StgLargeSRT *)srt );
-      return;
-  }
-
-  while (bitmap != 0) {
-      if ((bitmap & 1) != 0) {
-#ifdef ENABLE_WIN32_DLL_SUPPORT
-	  // Special-case to handle references to closures hiding out in DLLs, since
-	  // double indirections required to get at those. The code generator knows
-	  // which is which when generating the SRT, so it stores the (indirect)
-	  // reference to the DLL closure in the table by first adding one to it.
-	  // We check for this here, and undo the addition before evacuating it.
-	  // 
-	  // If the SRT entry hasn't got bit 0 set, the SRT entry points to a
-	  // closure that's fixed at link-time, and no extra magic is required.
-	  if ( (unsigned long)(*srt) & 0x1 ) {
-	      evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
-	  } else {
-	      evacuate(*p);
-	  }
-#else
-	  evacuate(*p);
-#endif
-      }
-      p++;
-      bitmap = bitmap >> 1;
-  }
-}
-
-
-STATIC_INLINE void
-scavenge_thunk_srt(const StgInfoTable *info)
-{
-    StgThunkInfoTable *thunk_info;
-
-    if (!major_gc) return;
-
-    thunk_info = itbl_to_thunk_itbl(info);
-    scavenge_srt((StgClosure **)GET_SRT(thunk_info), thunk_info->i.srt_bitmap);
-}
-
-STATIC_INLINE void
-scavenge_fun_srt(const StgInfoTable *info)
-{
-    StgFunInfoTable *fun_info;
-
-    if (!major_gc) return;
-  
-    fun_info = itbl_to_fun_itbl(info);
-    scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), fun_info->i.srt_bitmap);
-}
-
-/* -----------------------------------------------------------------------------
-   Scavenge a TSO.
-   -------------------------------------------------------------------------- */
-
-static void
-scavengeTSO (StgTSO *tso)
-{
-    if (   tso->why_blocked == BlockedOnMVar
-	|| tso->why_blocked == BlockedOnBlackHole
-	|| tso->why_blocked == BlockedOnException
-#if defined(PAR)
-	|| tso->why_blocked == BlockedOnGA
-	|| tso->why_blocked == BlockedOnGA_NoSend
-#endif
-	) {
-	tso->block_info.closure = evacuate(tso->block_info.closure);
-    }
-    if ( tso->blocked_exceptions != NULL ) {
-	tso->blocked_exceptions = 
-	    (StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions);
-    }
-    
-    // We don't always chase the link field: TSOs on the blackhole
-    // queue are not automatically alive, so the link field is a
-    // "weak" pointer in that case.
-    if (tso->why_blocked != BlockedOnBlackHole) {
-	tso->link = (StgTSO *)evacuate((StgClosure *)tso->link);
-    }
-
-    // scavange current transaction record
-    tso->trec = (StgTRecHeader *)evacuate((StgClosure *)tso->trec);
-    
-    // scavenge this thread's stack 
-    scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
-}
-
-/* -----------------------------------------------------------------------------
-   Blocks of function args occur on the stack (at the top) and
-   in PAPs.
-   -------------------------------------------------------------------------- */
-
-STATIC_INLINE StgPtr
-scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
-{
-    StgPtr p;
-    StgWord bitmap;
-    nat size;
-
-    p = (StgPtr)args;
-    switch (fun_info->f.fun_type) {
-    case ARG_GEN:
-	bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
-	size = BITMAP_SIZE(fun_info->f.b.bitmap);
-	goto small_bitmap;
-    case ARG_GEN_BIG:
-	size = GET_FUN_LARGE_BITMAP(fun_info)->size;
-	scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
-	p += size;
-	break;
-    default:
-	bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
-	size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
-    small_bitmap:
-	while (size > 0) {
-	    if ((bitmap & 1) == 0) {
-		*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	    }
-	    p++;
-	    bitmap = bitmap >> 1;
-	    size--;
-	}
-	break;
-    }
-    return p;
-}
-
-STATIC_INLINE StgPtr
-scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
-{
-    StgPtr p;
-    StgWord bitmap;
-    StgFunInfoTable *fun_info;
-    
-    fun_info = get_fun_itbl(fun);
-    ASSERT(fun_info->i.type != PAP);
-    p = (StgPtr)payload;
-
-    switch (fun_info->f.fun_type) {
-    case ARG_GEN:
-	bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
-	goto small_bitmap;
-    case ARG_GEN_BIG:
-	scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
-	p += size;
-	break;
-    case ARG_BCO:
-	scavenge_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
-	p += size;
-	break;
-    default:
-	bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
-    small_bitmap:
-	while (size > 0) {
-	    if ((bitmap & 1) == 0) {
-		*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	    }
-	    p++;
-	    bitmap = bitmap >> 1;
-	    size--;
-	}
-	break;
-    }
-    return p;
-}
-
-STATIC_INLINE StgPtr
-scavenge_PAP (StgPAP *pap)
-{
-    pap->fun = evacuate(pap->fun);
-    return scavenge_PAP_payload (pap->fun, pap->payload, pap->n_args);
-}
-
-STATIC_INLINE StgPtr
-scavenge_AP (StgAP *ap)
-{
-    ap->fun = evacuate(ap->fun);
-    return scavenge_PAP_payload (ap->fun, ap->payload, ap->n_args);
-}
-
-/* -----------------------------------------------------------------------------
-   Scavenge a given step until there are no more objects in this step
-   to scavenge.
-
-   evac_gen is set by the caller to be either zero (for a step in a
-   generation < N) or G where G is the generation of the step being
-   scavenged.  
-
-   We sometimes temporarily change evac_gen back to zero if we're
-   scavenging a mutable object where early promotion isn't such a good
-   idea.  
-   -------------------------------------------------------------------------- */
-
-static void
-scavenge(step *stp)
-{
-  StgPtr p, q;
-  StgInfoTable *info;
-  bdescr *bd;
-  nat saved_evac_gen = evac_gen;
-
-  p = stp->scan;
-  bd = stp->scan_bd;
-
-  failed_to_evac = rtsFalse;
-
-  /* scavenge phase - standard breadth-first scavenging of the
-   * evacuated objects 
-   */
-
-  while (bd != stp->hp_bd || p < stp->hp) {
-
-    // If we're at the end of this block, move on to the next block 
-    if (bd != stp->hp_bd && p == bd->free) {
-      bd = bd->link;
-      p = bd->start;
-      continue;
-    }
-
-    ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
-    info = get_itbl((StgClosure *)p);
-    
-    ASSERT(thunk_selector_depth == 0);
-
-    q = p;
-    switch (info->type) {
-
-    case MVAR:
-    { 
-	StgMVar *mvar = ((StgMVar *)p);
-	evac_gen = 0;
-	mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
-	mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
-	mvar->value = evacuate((StgClosure *)mvar->value);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable.
-	p += sizeofW(StgMVar);
-	break;
-    }
-
-    case FUN_2_0:
-	scavenge_fun_srt(info);
-	((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
-	((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
-	p += sizeofW(StgHeader) + 2;
-	break;
-
-    case THUNK_2_0:
-	scavenge_thunk_srt(info);
-	((StgThunk *)p)->payload[1] = evacuate(((StgThunk *)p)->payload[1]);
-	((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
-	p += sizeofW(StgThunk) + 2;
-	break;
-
-    case CONSTR_2_0:
-	((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
-	((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
-	p += sizeofW(StgHeader) + 2;
-	break;
-	
-    case THUNK_1_0:
-	scavenge_thunk_srt(info);
-	((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
-	p += sizeofW(StgThunk) + 1;
-	break;
-	
-    case FUN_1_0:
-	scavenge_fun_srt(info);
-    case CONSTR_1_0:
-	((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
-	p += sizeofW(StgHeader) + 1;
-	break;
-	
-    case THUNK_0_1:
-	scavenge_thunk_srt(info);
-	p += sizeofW(StgThunk) + 1;
-	break;
-	
-    case FUN_0_1:
-	scavenge_fun_srt(info);
-    case CONSTR_0_1:
-	p += sizeofW(StgHeader) + 1;
-	break;
-	
-    case THUNK_0_2:
-	scavenge_thunk_srt(info);
-	p += sizeofW(StgThunk) + 2;
-	break;
-	
-    case FUN_0_2:
-	scavenge_fun_srt(info);
-    case CONSTR_0_2:
-	p += sizeofW(StgHeader) + 2;
-	break;
-	
-    case THUNK_1_1:
-	scavenge_thunk_srt(info);
-	((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
-	p += sizeofW(StgThunk) + 2;
-	break;
-
-    case FUN_1_1:
-	scavenge_fun_srt(info);
-    case CONSTR_1_1:
-	((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
-	p += sizeofW(StgHeader) + 2;
-	break;
-	
-    case FUN:
-	scavenge_fun_srt(info);
-	goto gen_obj;
-
-    case THUNK:
-    {
-	StgPtr end;
-
-	scavenge_thunk_srt(info);
-	end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
-	for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	}
-	p += info->layout.payload.nptrs;
-	break;
-    }
-	
-    gen_obj:
-    case CONSTR:
-    case WEAK:
-    case STABLE_NAME:
-    {
-	StgPtr end;
-
-	end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
-	for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	}
-	p += info->layout.payload.nptrs;
-	break;
-    }
-
-    case BCO: {
-	StgBCO *bco = (StgBCO *)p;
-	bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
-	bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
-	bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
-	bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
-	p += bco_sizeW(bco);
-	break;
-    }
-
-    case IND_PERM:
-      if (stp->gen->no != 0) {
-#ifdef PROFILING
-        // @LDV profiling
-        // No need to call LDV_recordDead_FILL_SLOP_DYNAMIC() because an 
-        // IND_OLDGEN_PERM closure is larger than an IND_PERM closure.
-        LDV_recordDead((StgClosure *)p, sizeofW(StgInd));
-#endif        
-        // 
-        // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?
-        //
-	SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
-
-        // We pretend that p has just been created.
-        LDV_RECORD_CREATE((StgClosure *)p);
-      }
-	// fall through 
-    case IND_OLDGEN_PERM:
-	((StgInd *)p)->indirectee = evacuate(((StgInd *)p)->indirectee);
-	p += sizeofW(StgInd);
-	break;
-
-    case MUT_VAR_CLEAN:
-    case MUT_VAR_DIRTY: {
-	rtsBool saved_eager_promotion = eager_promotion;
-
-	eager_promotion = rtsFalse;
-	((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
-	eager_promotion = saved_eager_promotion;
-
-	if (failed_to_evac) {
-	    ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
-	} else {
-	    ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
-	}
-	p += sizeofW(StgMutVar);
-	break;
-    }
-
-    case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case SE_BLACKHOLE:
-    case BLACKHOLE:
-	p += BLACKHOLE_sizeW();
-	break;
-
-    case THUNK_SELECTOR:
-    { 
-	StgSelector *s = (StgSelector *)p;
-	s->selectee = evacuate(s->selectee);
-	p += THUNK_SELECTOR_sizeW();
-	break;
-    }
-
-    // A chunk of stack saved in a heap object
-    case AP_STACK:
-    {
-	StgAP_STACK *ap = (StgAP_STACK *)p;
-
-	ap->fun = evacuate(ap->fun);
-	scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
-	p = (StgPtr)ap->payload + ap->size;
-	break;
-    }
-
-    case PAP:
-	p = scavenge_PAP((StgPAP *)p);
-	break;
-
-    case AP:
-	p = scavenge_AP((StgAP *)p);
-	break;
-
-    case ARR_WORDS:
-	// nothing to follow 
-	p += arr_words_sizeW((StgArrWords *)p);
-	break;
-
-    case MUT_ARR_PTRS_CLEAN:
-    case MUT_ARR_PTRS_DIRTY:
-	// follow everything 
-    {
-	StgPtr next;
-	rtsBool saved_eager;
-
-	// We don't eagerly promote objects pointed to by a mutable
-	// array, but if we find the array only points to objects in
-	// the same or an older generation, we mark it "clean" and
-	// avoid traversing it during minor GCs.
-	saved_eager = eager_promotion;
-	eager_promotion = rtsFalse;
-	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	}
-	eager_promotion = saved_eager;
-
-	if (failed_to_evac) {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
-	} else {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
-	}
-
-	failed_to_evac = rtsTrue; // always put it on the mutable list.
-	break;
-    }
-
-    case MUT_ARR_PTRS_FROZEN:
-    case MUT_ARR_PTRS_FROZEN0:
-	// follow everything 
-    {
-	StgPtr next;
-
-	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	}
-
-	// If we're going to put this object on the mutable list, then
-	// set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
-	if (failed_to_evac) {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
-	} else {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
-	}
-	break;
-    }
-
-    case TSO:
-    { 
-	StgTSO *tso = (StgTSO *)p;
-	rtsBool saved_eager = eager_promotion;
-
-	eager_promotion = rtsFalse;
-	scavengeTSO(tso);
-	eager_promotion = saved_eager;
-
-	if (failed_to_evac) {
-	    tso->flags |= TSO_DIRTY;
-	} else {
-	    tso->flags &= ~TSO_DIRTY;
-	}
-
-	failed_to_evac = rtsTrue; // always on the mutable list
-	p += tso_sizeW(tso);
-	break;
-    }
-
-#if defined(PAR)
-    case RBH:
-    { 
-#if 0
-	nat size, ptrs, nonptrs, vhs;
-	char str[80];
-	StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
-#endif
-	StgRBH *rbh = (StgRBH *)p;
-	(StgClosure *)rbh->blocking_queue = 
-	    evacuate((StgClosure *)rbh->blocking_queue);
-	failed_to_evac = rtsTrue;  // mutable anyhow.
-	IF_DEBUG(gc,
-		 debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
-		       p, info_type(p), (StgClosure *)rbh->blocking_queue));
-	// ToDo: use size of reverted closure here!
-	p += BLACKHOLE_sizeW(); 
-	break;
-    }
-
-    case BLOCKED_FETCH:
-    { 
-	StgBlockedFetch *bf = (StgBlockedFetch *)p;
-	// follow the pointer to the node which is being demanded 
-	(StgClosure *)bf->node = 
-	    evacuate((StgClosure *)bf->node);
-	// follow the link to the rest of the blocking queue 
-	(StgClosure *)bf->link = 
-	    evacuate((StgClosure *)bf->link);
-	IF_DEBUG(gc,
-		 debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
-		       bf, info_type((StgClosure *)bf), 
-		       bf->node, info_type(bf->node)));
-	p += sizeofW(StgBlockedFetch);
-	break;
-    }
-
-#ifdef DIST
-    case REMOTE_REF:
-#endif
-    case FETCH_ME:
-	p += sizeofW(StgFetchMe);
-	break; // nothing to do in this case
-
-    case FETCH_ME_BQ:
-    { 
-	StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
-	(StgClosure *)fmbq->blocking_queue = 
-	    evacuate((StgClosure *)fmbq->blocking_queue);
-	IF_DEBUG(gc,
-		 debugBelch("@@ scavenge: %p (%s) exciting, isn't it",
-		       p, info_type((StgClosure *)p)));
-	p += sizeofW(StgFetchMeBlockingQueue);
-	break;
-    }
-#endif
-
-    case TVAR_WAIT_QUEUE:
-      {
-	StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p);
-	evac_gen = 0;
-	wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso);
-	wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry);
-	wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgTVarWaitQueue);
-	break;
-      }
-
-    case TVAR:
-      {
-	StgTVar *tvar = ((StgTVar *) p);
-	evac_gen = 0;
-	tvar->current_value = evacuate((StgClosure*)tvar->current_value);
-	tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgTVar);
-	break;
-      }
-
-    case TREC_HEADER:
-      {
-        StgTRecHeader *trec = ((StgTRecHeader *) p);
-        evac_gen = 0;
-	trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
-	trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgTRecHeader);
-        break;
-      }
-
-    case TREC_CHUNK:
-      {
-	StgWord i;
-	StgTRecChunk *tc = ((StgTRecChunk *) p);
-	TRecEntry *e = &(tc -> entries[0]);
-	evac_gen = 0;
-	tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
-	for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
-	  e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
-	  e->expected_value = evacuate((StgClosure*)e->expected_value);
-	  e->new_value = evacuate((StgClosure*)e->new_value);
-	}
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	p += sizeofW(StgTRecChunk);
-	break;
-      }
-
-    default:
-	barf("scavenge: unimplemented/strange closure type %d @ %p", 
-	     info->type, p);
-    }
-
-    /*
-     * We need to record the current object on the mutable list if
-     *  (a) It is actually mutable, or 
-     *  (b) It contains pointers to a younger generation.
-     * Case (b) arises if we didn't manage to promote everything that
-     * the current object points to into the current generation.
-     */
-    if (failed_to_evac) {
-	failed_to_evac = rtsFalse;
-	if (stp->gen_no > 0) {
-	    recordMutableGen((StgClosure *)q, stp->gen);
-	}
-    }
-  }
-
-  stp->scan_bd = bd;
-  stp->scan = p;
-}    
-
-/* -----------------------------------------------------------------------------
-   Scavenge everything on the mark stack.
-
-   This is slightly different from scavenge():
-      - we don't walk linearly through the objects, so the scavenger
-        doesn't need to advance the pointer on to the next object.
-   -------------------------------------------------------------------------- */
-
-static void
-scavenge_mark_stack(void)
-{
-    StgPtr p, q;
-    StgInfoTable *info;
-    nat saved_evac_gen;
-
-    evac_gen = oldest_gen->no;
-    saved_evac_gen = evac_gen;
-
-linear_scan:
-    while (!mark_stack_empty()) {
-	p = pop_mark_stack();
-
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
-	info = get_itbl((StgClosure *)p);
-	
-	q = p;
-	switch (info->type) {
-	    
-	case MVAR:
-	{
-	    StgMVar *mvar = ((StgMVar *)p);
-	    evac_gen = 0;
-	    mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
-	    mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
-	    mvar->value = evacuate((StgClosure *)mvar->value);
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable.
-	    break;
-	}
-
-	case FUN_2_0:
-	    scavenge_fun_srt(info);
-	    ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
-	    ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
-	    break;
-
-	case THUNK_2_0:
-	    scavenge_thunk_srt(info);
-	    ((StgThunk *)p)->payload[1] = evacuate(((StgThunk *)p)->payload[1]);
-	    ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
-	    break;
-
-	case CONSTR_2_0:
-	    ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
-	    ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
-	    break;
-	
-	case FUN_1_0:
-	case FUN_1_1:
-	    scavenge_fun_srt(info);
-	    ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
-	    break;
-
-	case THUNK_1_0:
-	case THUNK_1_1:
-	    scavenge_thunk_srt(info);
-	    ((StgThunk *)p)->payload[0] = evacuate(((StgThunk *)p)->payload[0]);
-	    break;
-
-	case CONSTR_1_0:
-	case CONSTR_1_1:
-	    ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
-	    break;
-	
-	case FUN_0_1:
-	case FUN_0_2:
-	    scavenge_fun_srt(info);
-	    break;
-
-	case THUNK_0_1:
-	case THUNK_0_2:
-	    scavenge_thunk_srt(info);
-	    break;
-
-	case CONSTR_0_1:
-	case CONSTR_0_2:
-	    break;
-	
-	case FUN:
-	    scavenge_fun_srt(info);
-	    goto gen_obj;
-
-	case THUNK:
-	{
-	    StgPtr end;
-	    
-	    scavenge_thunk_srt(info);
-	    end = (P_)((StgThunk *)p)->payload + info->layout.payload.ptrs;
-	    for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
-		*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	    }
-	    break;
-	}
-	
-	gen_obj:
-	case CONSTR:
-	case WEAK:
-	case STABLE_NAME:
-	{
-	    StgPtr end;
-	    
-	    end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
-	    for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
-		*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	    }
-	    break;
-	}
-
-	case BCO: {
-	    StgBCO *bco = (StgBCO *)p;
-	    bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
-	    bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
-	    bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
-	    bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
-	    break;
-	}
-
-	case IND_PERM:
-	    // don't need to do anything here: the only possible case
-	    // is that we're in a 1-space compacting collector, with
-	    // no "old" generation.
-	    break;
-
-	case IND_OLDGEN:
-	case IND_OLDGEN_PERM:
-	    ((StgInd *)p)->indirectee = 
-		evacuate(((StgInd *)p)->indirectee);
-	    break;
-
-	case MUT_VAR_CLEAN:
-	case MUT_VAR_DIRTY: {
-	    rtsBool saved_eager_promotion = eager_promotion;
-	    
-	    eager_promotion = rtsFalse;
-	    ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
-	    eager_promotion = saved_eager_promotion;
-	    
-	    if (failed_to_evac) {
-		((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
-	    } else {
-		((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
-	    }
-	    break;
-	}
-
-	case CAF_BLACKHOLE:
-	case SE_CAF_BLACKHOLE:
-	case SE_BLACKHOLE:
-	case BLACKHOLE:
-	case ARR_WORDS:
-	    break;
-
-	case THUNK_SELECTOR:
-	{ 
-	    StgSelector *s = (StgSelector *)p;
-	    s->selectee = evacuate(s->selectee);
-	    break;
-	}
-
-	// A chunk of stack saved in a heap object
-	case AP_STACK:
-	{
-	    StgAP_STACK *ap = (StgAP_STACK *)p;
-	    
-	    ap->fun = evacuate(ap->fun);
-	    scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
-	    break;
-	}
-
-	case PAP:
-	    scavenge_PAP((StgPAP *)p);
-	    break;
-
-	case AP:
-	    scavenge_AP((StgAP *)p);
-	    break;
-      
-	case MUT_ARR_PTRS_CLEAN:
-	case MUT_ARR_PTRS_DIRTY:
-	    // follow everything 
-	{
-	    StgPtr next;
-	    rtsBool saved_eager;
-
-	    // We don't eagerly promote objects pointed to by a mutable
-	    // array, but if we find the array only points to objects in
-	    // the same or an older generation, we mark it "clean" and
-	    // avoid traversing it during minor GCs.
-	    saved_eager = eager_promotion;
-	    eager_promotion = rtsFalse;
-	    next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	    for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-		*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	    }
-	    eager_promotion = saved_eager;
-
-	    if (failed_to_evac) {
-		((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
-	    } else {
-		((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
-	    }
-
-	    failed_to_evac = rtsTrue; // mutable anyhow.
-	    break;
-	}
-
-	case MUT_ARR_PTRS_FROZEN:
-	case MUT_ARR_PTRS_FROZEN0:
-	    // follow everything 
-	{
-	    StgPtr next, q = p;
-	    
-	    next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	    for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-		*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	    }
-
-	    // If we're going to put this object on the mutable list, then
-	    // set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
-	    if (failed_to_evac) {
-		((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
-	    } else {
-		((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
-	    }
-	    break;
-	}
-
-	case TSO:
-	{ 
-	    StgTSO *tso = (StgTSO *)p;
-	    rtsBool saved_eager = eager_promotion;
-
-	    eager_promotion = rtsFalse;
-	    scavengeTSO(tso);
-	    eager_promotion = saved_eager;
-	    
-	    if (failed_to_evac) {
-		tso->flags |= TSO_DIRTY;
-	    } else {
-		tso->flags &= ~TSO_DIRTY;
-	    }
-	    
-	    failed_to_evac = rtsTrue; // always on the mutable list
-	    break;
-	}
-
-#if defined(PAR)
-	case RBH:
-	{ 
-#if 0
-	    nat size, ptrs, nonptrs, vhs;
-	    char str[80];
-	    StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
-#endif
-	    StgRBH *rbh = (StgRBH *)p;
-	    bh->blocking_queue = 
-		(StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
-	    failed_to_evac = rtsTrue;  // mutable anyhow.
-	    IF_DEBUG(gc,
-		     debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
-			   p, info_type(p), (StgClosure *)rbh->blocking_queue));
-	    break;
-	}
-	
-	case BLOCKED_FETCH:
-	{ 
-	    StgBlockedFetch *bf = (StgBlockedFetch *)p;
-	    // follow the pointer to the node which is being demanded 
-	    (StgClosure *)bf->node = 
-		evacuate((StgClosure *)bf->node);
-	    // follow the link to the rest of the blocking queue 
-	    (StgClosure *)bf->link = 
-		evacuate((StgClosure *)bf->link);
-	    IF_DEBUG(gc,
-		     debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
-			   bf, info_type((StgClosure *)bf), 
-			   bf->node, info_type(bf->node)));
-	    break;
-	}
-
-#ifdef DIST
-	case REMOTE_REF:
-#endif
-	case FETCH_ME:
-	    break; // nothing to do in this case
-
-	case FETCH_ME_BQ:
-	{ 
-	    StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
-	    (StgClosure *)fmbq->blocking_queue = 
-		evacuate((StgClosure *)fmbq->blocking_queue);
-	    IF_DEBUG(gc,
-		     debugBelch("@@ scavenge: %p (%s) exciting, isn't it",
-			   p, info_type((StgClosure *)p)));
-	    break;
-	}
-#endif /* PAR */
-
-	case TVAR_WAIT_QUEUE:
-	  {
-	    StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p);
-	    evac_gen = 0;
-	    wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso);
-	    wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry);
-	    wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable
-	    break;
-	  }
-	  
-	case TVAR:
-	  {
-	    StgTVar *tvar = ((StgTVar *) p);
-	    evac_gen = 0;
-	    tvar->current_value = evacuate((StgClosure*)tvar->current_value);
-	    tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable
-	    break;
-	  }
-	  
-	case TREC_CHUNK:
-	  {
-	    StgWord i;
-	    StgTRecChunk *tc = ((StgTRecChunk *) p);
-	    TRecEntry *e = &(tc -> entries[0]);
-	    evac_gen = 0;
-	    tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
-	    for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
-	      e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
-	      e->expected_value = evacuate((StgClosure*)e->expected_value);
-	      e->new_value = evacuate((StgClosure*)e->new_value);
-	    }
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable
-	    break;
-	  }
-
-	case TREC_HEADER:
-	  {
-	    StgTRecHeader *trec = ((StgTRecHeader *) p);
-	    evac_gen = 0;
-	    trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
-	    trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
-	    evac_gen = saved_evac_gen;
-	    failed_to_evac = rtsTrue; // mutable
-	    break;
-	  }
-
-	default:
-	    barf("scavenge_mark_stack: unimplemented/strange closure type %d @ %p", 
-		 info->type, p);
-	}
-
-	if (failed_to_evac) {
-	    failed_to_evac = rtsFalse;
-	    if (evac_gen > 0) {
-		recordMutableGen((StgClosure *)q, &generations[evac_gen]);
-	    }
-	}
-	
-	// mark the next bit to indicate "scavenged"
-	mark(q+1, Bdescr(q));
-
-    } // while (!mark_stack_empty())
-
-    // start a new linear scan if the mark stack overflowed at some point
-    if (mark_stack_overflowed && oldgen_scan_bd == NULL) {
-	IF_DEBUG(gc, debugBelch("scavenge_mark_stack: starting linear scan"));
-	mark_stack_overflowed = rtsFalse;
-	oldgen_scan_bd = oldest_gen->steps[0].old_blocks;
-	oldgen_scan = oldgen_scan_bd->start;
-    }
-
-    if (oldgen_scan_bd) {
-	// push a new thing on the mark stack
-    loop:
-	// find a closure that is marked but not scavenged, and start
-	// from there.
-	while (oldgen_scan < oldgen_scan_bd->free 
-	       && !is_marked(oldgen_scan,oldgen_scan_bd)) {
-	    oldgen_scan++;
-	}
-
-	if (oldgen_scan < oldgen_scan_bd->free) {
-
-	    // already scavenged?
-	    if (is_marked(oldgen_scan+1,oldgen_scan_bd)) {
-		oldgen_scan += sizeofW(StgHeader) + MIN_PAYLOAD_SIZE;
-		goto loop;
-	    }
-	    push_mark_stack(oldgen_scan);
-	    // ToDo: bump the linear scan by the actual size of the object
-	    oldgen_scan += sizeofW(StgHeader) + MIN_PAYLOAD_SIZE;
-	    goto linear_scan;
-	}
-
-	oldgen_scan_bd = oldgen_scan_bd->link;
-	if (oldgen_scan_bd != NULL) {
-	    oldgen_scan = oldgen_scan_bd->start;
-	    goto loop;
-	}
-    }
-}
-
-/* -----------------------------------------------------------------------------
-   Scavenge one object.
-
-   This is used for objects that are temporarily marked as mutable
-   because they contain old-to-new generation pointers.  Only certain
-   objects can have this property.
-   -------------------------------------------------------------------------- */
-
-static rtsBool
-scavenge_one(StgPtr p)
-{
-    const StgInfoTable *info;
-    nat saved_evac_gen = evac_gen;
-    rtsBool no_luck;
-    
-    ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
-    info = get_itbl((StgClosure *)p);
-    
-    switch (info->type) {
-	
-    case MVAR:
-    { 
-	StgMVar *mvar = ((StgMVar *)p);
-	evac_gen = 0;
-	mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
-	mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
-	mvar->value = evacuate((StgClosure *)mvar->value);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable.
-	break;
-    }
-
-    case THUNK:
-    case THUNK_1_0:
-    case THUNK_0_1:
-    case THUNK_1_1:
-    case THUNK_0_2:
-    case THUNK_2_0:
-    {
-	StgPtr q, end;
-	
-	end = (StgPtr)((StgThunk *)p)->payload + info->layout.payload.ptrs;
-	for (q = (StgPtr)((StgThunk *)p)->payload; q < end; q++) {
-	    *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
-	}
-	break;
-    }
-
-    case FUN:
-    case FUN_1_0:			// hardly worth specialising these guys
-    case FUN_0_1:
-    case FUN_1_1:
-    case FUN_0_2:
-    case FUN_2_0:
-    case CONSTR:
-    case CONSTR_1_0:
-    case CONSTR_0_1:
-    case CONSTR_1_1:
-    case CONSTR_0_2:
-    case CONSTR_2_0:
-    case WEAK:
-    case IND_PERM:
-    {
-	StgPtr q, end;
-	
-	end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
-	for (q = (StgPtr)((StgClosure *)p)->payload; q < end; q++) {
-	    *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
-	}
-	break;
-    }
-    
-    case MUT_VAR_CLEAN:
-    case MUT_VAR_DIRTY: {
-	StgPtr q = p;
-	rtsBool saved_eager_promotion = eager_promotion;
-
-	eager_promotion = rtsFalse;
-	((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
-	eager_promotion = saved_eager_promotion;
-
-	if (failed_to_evac) {
-	    ((StgClosure *)q)->header.info = &stg_MUT_VAR_DIRTY_info;
-	} else {
-	    ((StgClosure *)q)->header.info = &stg_MUT_VAR_CLEAN_info;
-	}
-	break;
-    }
-
-    case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case SE_BLACKHOLE:
-    case BLACKHOLE:
-	break;
-	
-    case THUNK_SELECTOR:
-    { 
-	StgSelector *s = (StgSelector *)p;
-	s->selectee = evacuate(s->selectee);
-	break;
-    }
-    
-    case AP_STACK:
-    {
-	StgAP_STACK *ap = (StgAP_STACK *)p;
-
-	ap->fun = evacuate(ap->fun);
-	scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
-	p = (StgPtr)ap->payload + ap->size;
-	break;
-    }
-
-    case PAP:
-	p = scavenge_PAP((StgPAP *)p);
-	break;
-
-    case AP:
-	p = scavenge_AP((StgAP *)p);
-	break;
-
-    case ARR_WORDS:
-	// nothing to follow 
-	break;
-
-    case MUT_ARR_PTRS_CLEAN:
-    case MUT_ARR_PTRS_DIRTY:
-    {
-	StgPtr next, q;
-	rtsBool saved_eager;
-
-	// We don't eagerly promote objects pointed to by a mutable
-	// array, but if we find the array only points to objects in
-	// the same or an older generation, we mark it "clean" and
-	// avoid traversing it during minor GCs.
-	saved_eager = eager_promotion;
-	eager_promotion = rtsFalse;
-	q = p;
-	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	}
-	eager_promotion = saved_eager;
-
-	if (failed_to_evac) {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_DIRTY_info;
-	} else {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_CLEAN_info;
-	}
-
-	failed_to_evac = rtsTrue;
-	break;
-    }
-
-    case MUT_ARR_PTRS_FROZEN:
-    case MUT_ARR_PTRS_FROZEN0:
-    {
-	// follow everything 
-	StgPtr next, q=p;
-      
-	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	}
-
-	// If we're going to put this object on the mutable list, then
-	// set its info ptr to MUT_ARR_PTRS_FROZEN0 to indicate that.
-	if (failed_to_evac) {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN0_info;
-	} else {
-	    ((StgClosure *)q)->header.info = &stg_MUT_ARR_PTRS_FROZEN_info;
-	}
-	break;
-    }
-
-    case TSO:
-    {
-	StgTSO *tso = (StgTSO *)p;
-	rtsBool saved_eager = eager_promotion;
-
-	eager_promotion = rtsFalse;
-	scavengeTSO(tso);
-	eager_promotion = saved_eager;
-
-	if (failed_to_evac) {
-	    tso->flags |= TSO_DIRTY;
-	} else {
-	    tso->flags &= ~TSO_DIRTY;
-	}
-
-	failed_to_evac = rtsTrue; // always on the mutable list
-	break;
-    }
-  
-#if defined(PAR)
-    case RBH:
-    { 
-#if 0
-	nat size, ptrs, nonptrs, vhs;
-	char str[80];
-	StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
-#endif
-	StgRBH *rbh = (StgRBH *)p;
-	(StgClosure *)rbh->blocking_queue = 
-	    evacuate((StgClosure *)rbh->blocking_queue);
-	failed_to_evac = rtsTrue;  // mutable anyhow.
-	IF_DEBUG(gc,
-		 debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
-		       p, info_type(p), (StgClosure *)rbh->blocking_queue));
-	// ToDo: use size of reverted closure here!
-	break;
-    }
-
-    case BLOCKED_FETCH:
-    { 
-	StgBlockedFetch *bf = (StgBlockedFetch *)p;
-	// follow the pointer to the node which is being demanded 
-	(StgClosure *)bf->node = 
-	    evacuate((StgClosure *)bf->node);
-	// follow the link to the rest of the blocking queue 
-	(StgClosure *)bf->link = 
-	    evacuate((StgClosure *)bf->link);
-	IF_DEBUG(gc,
-		 debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
-		       bf, info_type((StgClosure *)bf), 
-		       bf->node, info_type(bf->node)));
-	break;
-    }
-
-#ifdef DIST
-    case REMOTE_REF:
-#endif
-    case FETCH_ME:
-	break; // nothing to do in this case
-
-    case FETCH_ME_BQ:
-    { 
-	StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
-	(StgClosure *)fmbq->blocking_queue = 
-	    evacuate((StgClosure *)fmbq->blocking_queue);
-	IF_DEBUG(gc,
-		 debugBelch("@@ scavenge: %p (%s) exciting, isn't it",
-		       p, info_type((StgClosure *)p)));
-	break;
-    }
-#endif
-
-    case TVAR_WAIT_QUEUE:
-      {
-	StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p);
-	evac_gen = 0;
-	wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso);
-	wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry);
-	wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	break;
-      }
-
-    case TVAR:
-      {
-	StgTVar *tvar = ((StgTVar *) p);
-	evac_gen = 0;
-	tvar->current_value = evacuate((StgClosure*)tvar->current_value);
-	tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	break;
-      }
-
-    case TREC_HEADER:
-      {
-        StgTRecHeader *trec = ((StgTRecHeader *) p);
-        evac_gen = 0;
-	trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
-	trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-        break;
-      }
-
-    case TREC_CHUNK:
-      {
-	StgWord i;
-	StgTRecChunk *tc = ((StgTRecChunk *) p);
-	TRecEntry *e = &(tc -> entries[0]);
-	evac_gen = 0;
-	tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
-	for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
-	  e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
-	  e->expected_value = evacuate((StgClosure*)e->expected_value);
-	  e->new_value = evacuate((StgClosure*)e->new_value);
-	}
-	evac_gen = saved_evac_gen;
-	failed_to_evac = rtsTrue; // mutable
-	break;
-      }
-
-    case IND_OLDGEN:
-    case IND_OLDGEN_PERM:
-    case IND_STATIC:
-    {
-	/* Careful here: a THUNK can be on the mutable list because
-	 * it contains pointers to young gen objects.  If such a thunk
-	 * is updated, the IND_OLDGEN will be added to the mutable
-	 * list again, and we'll scavenge it twice.  evacuate()
-	 * doesn't check whether the object has already been
-	 * evacuated, so we perform that check here.
-	 */
-	StgClosure *q = ((StgInd *)p)->indirectee;
-	if (HEAP_ALLOCED(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) {
-	    break;
-	}
-	((StgInd *)p)->indirectee = evacuate(q);
-    }
-
-#if 0 && defined(DEBUG)
-      if (RtsFlags.DebugFlags.gc) 
-      /* Debugging code to print out the size of the thing we just
-       * promoted 
-       */
-      { 
-	StgPtr start = gen->steps[0].scan;
-	bdescr *start_bd = gen->steps[0].scan_bd;
-	nat size = 0;
-	scavenge(&gen->steps[0]);
-	if (start_bd != gen->steps[0].scan_bd) {
-	  size += (P_)BLOCK_ROUND_UP(start) - start;
-	  start_bd = start_bd->link;
-	  while (start_bd != gen->steps[0].scan_bd) {
-	    size += BLOCK_SIZE_W;
-	    start_bd = start_bd->link;
-	  }
-	  size += gen->steps[0].scan -
-	    (P_)BLOCK_ROUND_DOWN(gen->steps[0].scan);
-	} else {
-	  size = gen->steps[0].scan - start;
-	}
-	debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_));
-      }
-#endif
-      break;
-
-    default:
-	barf("scavenge_one: strange object %d", (int)(info->type));
-    }    
-
-    no_luck = failed_to_evac;
-    failed_to_evac = rtsFalse;
-    return (no_luck);
-}
-
-/* -----------------------------------------------------------------------------
-   Scavenging mutable lists.
-
-   We treat the mutable list of each generation > N (i.e. all the
-   generations older than the one being collected) as roots.  We also
-   remove non-mutable objects from the mutable list at this point.
-   -------------------------------------------------------------------------- */
-
-static void
-scavenge_mutable_list(generation *gen)
-{
-    bdescr *bd;
-    StgPtr p, q;
-
-    bd = gen->saved_mut_list;
-
-    evac_gen = gen->no;
-    for (; bd != NULL; bd = bd->link) {
-	for (q = bd->start; q < bd->free; q++) {
-	    p = (StgPtr)*q;
-	    ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
-
-#ifdef DEBUG	    
-	    switch (get_itbl((StgClosure *)p)->type) {
-	    case MUT_VAR_CLEAN:
-		barf("MUT_VAR_CLEAN on mutable list");
-	    case MUT_VAR_DIRTY:
-		mutlist_MUTVARS++; break;
-	    case MUT_ARR_PTRS_CLEAN:
-	    case MUT_ARR_PTRS_DIRTY:
-	    case MUT_ARR_PTRS_FROZEN:
-	    case MUT_ARR_PTRS_FROZEN0:
-		mutlist_MUTARRS++; break;
-	    default:
-		mutlist_OTHERS++; break;
-	    }
-#endif
-
-	    // Check whether this object is "clean", that is it
-	    // definitely doesn't point into a young generation.
-	    // Clean objects don't need to be scavenged.  Some clean
-	    // objects (MUT_VAR_CLEAN) are not kept on the mutable
-	    // list at all; others, such as MUT_ARR_PTRS_CLEAN and
-	    // TSO, are always on the mutable list.
-	    //
-	    switch (get_itbl((StgClosure *)p)->type) {
-	    case MUT_ARR_PTRS_CLEAN:
-		recordMutableGen((StgClosure *)p,gen);
-		continue;
-	    case TSO: {
-		StgTSO *tso = (StgTSO *)p;
-		if ((tso->flags & TSO_DIRTY) == 0) {
-		    // A clean TSO: we don't have to traverse its
-		    // stack.  However, we *do* follow the link field:
-		    // we don't want to have to mark a TSO dirty just
-		    // because we put it on a different queue.
-		    if (tso->why_blocked != BlockedOnBlackHole) {
-			tso->link = (StgTSO *)evacuate((StgClosure *)tso->link);
-		    }
-		    recordMutableGen((StgClosure *)p,gen);
-		    continue;
-		}
-	    }
-	    default:
-		;
-	    }
-
-	    if (scavenge_one(p)) {
-		// didn't manage to promote everything, so put the
-		// object back on the list.
-		recordMutableGen((StgClosure *)p,gen);
-	    }
-	}
-    }
-
-    // free the old mut_list
-    freeChain(gen->saved_mut_list);
-    gen->saved_mut_list = NULL;
-}
-
-
-static void
-scavenge_static(void)
-{
-  StgClosure* p = static_objects;
-  const StgInfoTable *info;
-
-  /* Always evacuate straight to the oldest generation for static
-   * objects */
-  evac_gen = oldest_gen->no;
-
-  /* keep going until we've scavenged all the objects on the linked
-     list... */
-  while (p != END_OF_STATIC_LIST) {
-
-    ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
-    info = get_itbl(p);
-    /*
-    if (info->type==RBH)
-      info = REVERT_INFOPTR(info); // if it's an RBH, look at the orig closure
-    */
-    // make sure the info pointer is into text space 
-    
-    /* Take this object *off* the static_objects list,
-     * and put it on the scavenged_static_objects list.
-     */
-    static_objects = *STATIC_LINK(info,p);
-    *STATIC_LINK(info,p) = scavenged_static_objects;
-    scavenged_static_objects = p;
-    
-    switch (info -> type) {
-      
-    case IND_STATIC:
-      {
-	StgInd *ind = (StgInd *)p;
-	ind->indirectee = evacuate(ind->indirectee);
-
-	/* might fail to evacuate it, in which case we have to pop it
-	 * back on the mutable list of the oldest generation.  We
-	 * leave it *on* the scavenged_static_objects list, though,
-	 * in case we visit this object again.
-	 */
-	if (failed_to_evac) {
-	  failed_to_evac = rtsFalse;
-	  recordMutableGen((StgClosure *)p,oldest_gen);
-	}
-	break;
-      }
-      
-    case THUNK_STATIC:
-      scavenge_thunk_srt(info);
-      break;
-
-    case FUN_STATIC:
-      scavenge_fun_srt(info);
-      break;
-      
-    case CONSTR_STATIC:
-      {	
-	StgPtr q, next;
-	
-	next = (P_)p->payload + info->layout.payload.ptrs;
-	// evacuate the pointers 
-	for (q = (P_)p->payload; q < next; q++) {
-	    *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
-	}
-	break;
-      }
-      
-    default:
-      barf("scavenge_static: strange closure %d", (int)(info->type));
-    }
-
-    ASSERT(failed_to_evac == rtsFalse);
-
-    /* get the next static object from the list.  Remember, there might
-     * be more stuff on this list now that we've done some evacuating!
-     * (static_objects is a global)
-     */
-    p = static_objects;
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   scavenge a chunk of memory described by a bitmap
-   -------------------------------------------------------------------------- */
-
-static void
-scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
-{
-    nat i, b;
-    StgWord bitmap;
-    
-    b = 0;
-    bitmap = large_bitmap->bitmap[b];
-    for (i = 0; i < size; ) {
-	if ((bitmap & 1) == 0) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	}
-	i++;
-	p++;
-	if (i % BITS_IN(W_) == 0) {
-	    b++;
-	    bitmap = large_bitmap->bitmap[b];
-	} else {
-	    bitmap = bitmap >> 1;
-	}
-    }
-}
-
-STATIC_INLINE StgPtr
-scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap)
-{
-    while (size > 0) {
-	if ((bitmap & 1) == 0) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	}
-	p++;
-	bitmap = bitmap >> 1;
-	size--;
-    }
-    return p;
-}
-
-/* -----------------------------------------------------------------------------
-   scavenge_stack walks over a section of stack and evacuates all the
-   objects pointed to by it.  We can use the same code for walking
-   AP_STACK_UPDs, since these are just sections of copied stack.
-   -------------------------------------------------------------------------- */
-
-
-static void
-scavenge_stack(StgPtr p, StgPtr stack_end)
-{
-  const StgRetInfoTable* info;
-  StgWord bitmap;
-  nat size;
-
-  //IF_DEBUG(sanity, debugBelch("  scavenging stack between %p and %p", p, stack_end));
-
-  /* 
-   * Each time around this loop, we are looking at a chunk of stack
-   * that starts with an activation record. 
-   */
-
-  while (p < stack_end) {
-    info  = get_ret_itbl((StgClosure *)p);
-      
-    switch (info->i.type) {
-	
-    case UPDATE_FRAME:
-	// In SMP, we can get update frames that point to indirections
-	// when two threads evaluate the same thunk.  We do attempt to
-	// discover this situation in threadPaused(), but it's
-	// possible that the following sequence occurs:
-	//
-	//        A             B
-	//                  enter T
-	//     enter T
-	//     blackhole T
-	//                  update T
-	//     GC
-	//
-	// Now T is an indirection, and the update frame is already
-	// marked on A's stack, so we won't traverse it again in
-	// threadPaused().  We could traverse the whole stack again
-	// before GC, but that seems like overkill.
-	//
-	// Scavenging this update frame as normal would be disastrous;
-	// the updatee would end up pointing to the value.  So we turn
-	// the indirection into an IND_PERM, so that evacuate will
-	// copy the indirection into the old generation instead of
-	// discarding it.
-	if (get_itbl(((StgUpdateFrame *)p)->updatee)->type == IND) {
-	    ((StgUpdateFrame *)p)->updatee->header.info = 
-		(StgInfoTable *)&stg_IND_PERM_info;
-	}
-	((StgUpdateFrame *)p)->updatee 
-	    = evacuate(((StgUpdateFrame *)p)->updatee);
-	p += sizeofW(StgUpdateFrame);
-	continue;
-
-      // small bitmap (< 32 entries, or 64 on a 64-bit machine) 
-    case CATCH_STM_FRAME:
-    case CATCH_RETRY_FRAME:
-    case ATOMICALLY_FRAME:
-    case STOP_FRAME:
-    case CATCH_FRAME:
-    case RET_SMALL:
-    case RET_VEC_SMALL:
-	bitmap = BITMAP_BITS(info->i.layout.bitmap);
-	size   = BITMAP_SIZE(info->i.layout.bitmap);
-	// NOTE: the payload starts immediately after the info-ptr, we
-	// don't have an StgHeader in the same sense as a heap closure.
-	p++;
-	p = scavenge_small_bitmap(p, size, bitmap);
-
-    follow_srt:
-	if (major_gc) 
-	    scavenge_srt((StgClosure **)GET_SRT(info), info->i.srt_bitmap);
-	continue;
-
-    case RET_BCO: {
-	StgBCO *bco;
-	nat size;
-
-	p++;
-	*p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	bco = (StgBCO *)*p;
-	p++;
-	size = BCO_BITMAP_SIZE(bco);
-	scavenge_large_bitmap(p, BCO_BITMAP(bco), size);
-	p += size;
-	continue;
-    }
-
-      // large bitmap (> 32 entries, or > 64 on a 64-bit machine) 
-    case RET_BIG:
-    case RET_VEC_BIG:
-    {
-	nat size;
-
-	size = GET_LARGE_BITMAP(&info->i)->size;
-	p++;
-	scavenge_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
-	p += size;
-	// and don't forget to follow the SRT 
-	goto follow_srt;
-    }
-
-      // Dynamic bitmap: the mask is stored on the stack, and
-      // there are a number of non-pointers followed by a number
-      // of pointers above the bitmapped area.  (see StgMacros.h,
-      // HEAP_CHK_GEN).
-    case RET_DYN:
-    {
-	StgWord dyn;
-	dyn = ((StgRetDyn *)p)->liveness;
-
-	// traverse the bitmap first
-	bitmap = RET_DYN_LIVENESS(dyn);
-	p      = (P_)&((StgRetDyn *)p)->payload[0];
-	size   = RET_DYN_BITMAP_SIZE;
-	p = scavenge_small_bitmap(p, size, bitmap);
-
-	// skip over the non-ptr words
-	p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
-	
-	// follow the ptr words
-	for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
-	    *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
-	    p++;
-	}
-	continue;
-    }
-
-    case RET_FUN:
-    {
-	StgRetFun *ret_fun = (StgRetFun *)p;
-	StgFunInfoTable *fun_info;
-
-	ret_fun->fun = evacuate(ret_fun->fun);
- 	fun_info = get_fun_itbl(ret_fun->fun);
-	p = scavenge_arg_block(fun_info, ret_fun->payload);
-	goto follow_srt;
-    }
-
-    default:
-	barf("scavenge_stack: weird activation record found on stack: %d", (int)(info->i.type));
-    }
-  }		     
-}
-
-/*-----------------------------------------------------------------------------
-  scavenge the large object list.
-
-  evac_gen set by caller; similar games played with evac_gen as with
-  scavenge() - see comment at the top of scavenge().  Most large
-  objects are (repeatedly) mutable, so most of the time evac_gen will
-  be zero.
-  --------------------------------------------------------------------------- */
-
-static void
-scavenge_large(step *stp)
-{
-  bdescr *bd;
-  StgPtr p;
-
-  bd = stp->new_large_objects;
-
-  for (; bd != NULL; bd = stp->new_large_objects) {
-
-    /* take this object *off* the large objects list and put it on
-     * the scavenged large objects list.  This is so that we can
-     * treat new_large_objects as a stack and push new objects on
-     * the front when evacuating.
-     */
-    stp->new_large_objects = bd->link;
-    dbl_link_onto(bd, &stp->scavenged_large_objects);
-
-    // update the block count in this step.
-    stp->n_scavenged_large_blocks += bd->blocks;
-
-    p = bd->start;
-    if (scavenge_one(p)) {
-	if (stp->gen_no > 0) {
-	    recordMutableGen((StgClosure *)p, stp->gen);
-	}
-    }
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   Initialising the static object & mutable lists
-   -------------------------------------------------------------------------- */
-
-static void
-zero_static_object_list(StgClosure* first_static)
-{
-  StgClosure* p;
-  StgClosure* link;
-  const StgInfoTable *info;
-
-  for (p = first_static; p != END_OF_STATIC_LIST; p = link) {
-    info = get_itbl(p);
-    link = *STATIC_LINK(info, p);
-    *STATIC_LINK(info,p) = NULL;
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   Reverting CAFs
-   -------------------------------------------------------------------------- */
-
-void
-revertCAFs( void )
-{
-    StgIndStatic *c;
-
-    for (c = (StgIndStatic *)revertible_caf_list; c != NULL; 
-	 c = (StgIndStatic *)c->static_link) 
-    {
-	SET_INFO(c, c->saved_info);
-	c->saved_info = NULL;
-	// could, but not necessary: c->static_link = NULL; 
-    }
-    revertible_caf_list = NULL;
-}
-
-void
-markCAFs( evac_fn evac )
-{
-    StgIndStatic *c;
-
-    for (c = (StgIndStatic *)caf_list; c != NULL; 
-	 c = (StgIndStatic *)c->static_link) 
-    {
-	evac(&c->indirectee);
-    }
-    for (c = (StgIndStatic *)revertible_caf_list; c != NULL; 
-	 c = (StgIndStatic *)c->static_link) 
-    {
-	evac(&c->indirectee);
-    }
-}
-
-/* -----------------------------------------------------------------------------
-   Sanity code for CAF garbage collection.
-
-   With DEBUG turned on, we manage a CAF list in addition to the SRT
-   mechanism.  After GC, we run down the CAF list and blackhole any
-   CAFs which have been garbage collected.  This means we get an error
-   whenever the program tries to enter a garbage collected CAF.
-
-   Any garbage collected CAFs are taken off the CAF list at the same
-   time. 
-   -------------------------------------------------------------------------- */
-
-#if 0 && defined(DEBUG)
-
-static void
-gcCAFs(void)
-{
-  StgClosure*  p;
-  StgClosure** pp;
-  const StgInfoTable *info;
-  nat i;
-
-  i = 0;
-  p = caf_list;
-  pp = &caf_list;
-
-  while (p != NULL) {
-    
-    info = get_itbl(p);
-
-    ASSERT(info->type == IND_STATIC);
-
-    if (STATIC_LINK(info,p) == NULL) {
-      IF_DEBUG(gccafs, debugBelch("CAF gc'd at 0x%04lx", (long)p));
-      // black hole it 
-      SET_INFO(p,&stg_BLACKHOLE_info);
-      p = STATIC_LINK2(info,p);
-      *pp = p;
-    }
-    else {
-      pp = &STATIC_LINK2(info,p);
-      p = *pp;
-      i++;
-    }
-
-  }
-
-  //  debugBelch("%d CAFs live", i); 
-}
-#endif
-
-
-/* -----------------------------------------------------------------------------
- * Stack squeezing
- *
- * Code largely pinched from old RTS, then hacked to bits.  We also do
- * lazy black holing here.
- *
- * -------------------------------------------------------------------------- */
-
-struct stack_gap { StgWord gap_size; struct stack_gap *next_gap; };
-
-static void
-stackSqueeze(StgTSO *tso, StgPtr bottom)
-{
-    StgPtr frame;
-    rtsBool prev_was_update_frame;
-    StgClosure *updatee = NULL;
-    StgRetInfoTable *info;
-    StgWord current_gap_size;
-    struct stack_gap *gap;
-
-    // Stage 1: 
-    //    Traverse the stack upwards, replacing adjacent update frames
-    //    with a single update frame and a "stack gap".  A stack gap
-    //    contains two values: the size of the gap, and the distance
-    //    to the next gap (or the stack top).
-
-    frame = tso->sp;
-
-    ASSERT(frame < bottom);
-    
-    prev_was_update_frame = rtsFalse;
-    current_gap_size = 0;
-    gap = (struct stack_gap *) (tso->sp - sizeofW(StgUpdateFrame));
-
-    while (frame < bottom) {
-	
-	info = get_ret_itbl((StgClosure *)frame);
-	switch (info->i.type) {
-
-	case UPDATE_FRAME:
-	{ 
-	    StgUpdateFrame *upd = (StgUpdateFrame *)frame;
-
-	    if (prev_was_update_frame) {
-
-		TICK_UPD_SQUEEZED();
-		/* wasn't there something about update squeezing and ticky to be
-		 * sorted out?  oh yes: we aren't counting each enter properly
-		 * in this case.  See the log somewhere.  KSW 1999-04-21
-		 *
-		 * Check two things: that the two update frames don't point to
-		 * the same object, and that the updatee_bypass isn't already an
-		 * indirection.  Both of these cases only happen when we're in a
-		 * block hole-style loop (and there are multiple update frames
-		 * on the stack pointing to the same closure), but they can both
-		 * screw us up if we don't check.
-		 */
-		if (upd->updatee != updatee && !closure_IND(upd->updatee)) {
-		    UPD_IND_NOLOCK(upd->updatee, updatee);
-		}
-
-		// now mark this update frame as a stack gap.  The gap
-		// marker resides in the bottom-most update frame of
-		// the series of adjacent frames, and covers all the
-		// frames in this series.
-		current_gap_size += sizeofW(StgUpdateFrame);
-		((struct stack_gap *)frame)->gap_size = current_gap_size;
-		((struct stack_gap *)frame)->next_gap = gap;
-
-		frame += sizeofW(StgUpdateFrame);
-		continue;
-	    } 
-
-	    // single update frame, or the topmost update frame in a series
-	    else {
-		prev_was_update_frame = rtsTrue;
-		updatee = upd->updatee;
-		frame += sizeofW(StgUpdateFrame);
-		continue;
-	    }
-	}
-	    
-	default:
-	    prev_was_update_frame = rtsFalse;
-
-	    // we're not in a gap... check whether this is the end of a gap
-	    // (an update frame can't be the end of a gap).
-	    if (current_gap_size != 0) {
-		gap = (struct stack_gap *) (frame - sizeofW(StgUpdateFrame));
-	    }
-	    current_gap_size = 0;
-
-	    frame += stack_frame_sizeW((StgClosure *)frame);
-	    continue;
-	}
-    }
-
-    if (current_gap_size != 0) {
-	gap = (struct stack_gap *) (frame - sizeofW(StgUpdateFrame));
-    }
-
-    // Now we have a stack with gaps in it, and we have to walk down
-    // shoving the stack up to fill in the gaps.  A diagram might
-    // help:
-    //
-    //    +| ********* |
-    //     | ********* | <- sp
-    //     |           |
-    //     |           | <- gap_start
-    //     | ......... |                |
-    //     | stack_gap | <- gap         | chunk_size
-    //     | ......... |                | 
-    //     | ......... | <- gap_end     v
-    //     | ********* | 
-    //     | ********* | 
-    //     | ********* | 
-    //    -| ********* | 
-    //
-    // 'sp'  points the the current top-of-stack
-    // 'gap' points to the stack_gap structure inside the gap
-    // *****   indicates real stack data
-    // .....   indicates gap
-    // <empty> indicates unused
-    //
-    {
-	void *sp;
-	void *gap_start, *next_gap_start, *gap_end;
-	nat chunk_size;
-
-	next_gap_start = (void *)((unsigned char*)gap + sizeof(StgUpdateFrame));
-	sp = next_gap_start;
-
-	while ((StgPtr)gap > tso->sp) {
-
-	    // we're working in *bytes* now...
-	    gap_start = next_gap_start;
-	    gap_end = (void*) ((unsigned char*)gap_start - gap->gap_size * sizeof(W_));
-
-	    gap = gap->next_gap;
-	    next_gap_start = (void *)((unsigned char*)gap + sizeof(StgUpdateFrame));
-
-	    chunk_size = (unsigned char*)gap_end - (unsigned char*)next_gap_start;
-	    sp -= chunk_size;
-	    memmove(sp, next_gap_start, chunk_size);
-	}
-
-	tso->sp = (StgPtr)sp;
-    }
-}    
-
-/* -----------------------------------------------------------------------------
- * Pausing a thread
- * 
- * We have to prepare for GC - this means doing lazy black holing
- * here.  We also take the opportunity to do stack squeezing if it's
- * turned on.
- * -------------------------------------------------------------------------- */
-void
-threadPaused(Capability *cap, StgTSO *tso)
-{
-    StgClosure *frame;
-    StgRetInfoTable *info;
-    StgClosure *bh;
-    StgPtr stack_end;
-    nat words_to_squeeze = 0;
-    nat weight           = 0;
-    nat weight_pending   = 0;
-    rtsBool prev_was_update_frame;
-    
-    stack_end = &tso->stack[tso->stack_size];
-    
-    frame = (StgClosure *)tso->sp;
-
-    while (1) {
-	// If we've already marked this frame, then stop here.
-	if (frame->header.info == (StgInfoTable *)&stg_marked_upd_frame_info) {
-	    goto end;
-	}
-
-	info = get_ret_itbl(frame);
-	
-	switch (info->i.type) {
-	    
-	case UPDATE_FRAME:
-
-	    SET_INFO(frame, (StgInfoTable *)&stg_marked_upd_frame_info);
-
-	    bh = ((StgUpdateFrame *)frame)->updatee;
-
-	    if (closure_IND(bh) || bh->header.info == &stg_BLACKHOLE_info) {
-		IF_DEBUG(squeeze, debugBelch("suspending duplicate work: %ld words of stack\n", (StgPtr)frame - tso->sp));
-
-		// If this closure is already an indirection, then
-		// suspend the computation up to this point:
-		suspendComputation(cap,tso,(StgPtr)frame);
-
-		// Now drop the update frame, and arrange to return
-		// the value to the frame underneath:
-		tso->sp = (StgPtr)frame + sizeofW(StgUpdateFrame) - 2;
-		tso->sp[1] = (StgWord)bh;
-		tso->sp[0] = (W_)&stg_enter_info;
-
-		// And continue with threadPaused; there might be
-		// yet more computation to suspend.
-		threadPaused(cap,tso);
-		return;
-	    }
-
-	    if (bh->header.info != &stg_CAF_BLACKHOLE_info) {
-#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
-		debugBelch("Unexpected lazy BHing required at 0x%04lx\n",(long)bh);
-#endif
-		// zero out the slop so that the sanity checker can tell
-		// where the next closure is.
-		DEBUG_FILL_SLOP(bh);
-#ifdef PROFILING
-		// @LDV profiling
-		// We pretend that bh is now dead.
-		LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
-#endif
-		SET_INFO(bh,&stg_BLACKHOLE_info);
-
-		// We pretend that bh has just been created.
-		LDV_RECORD_CREATE(bh);
-	    }
-	    
-	    frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
-	    if (prev_was_update_frame) {
-		words_to_squeeze += sizeofW(StgUpdateFrame);
-		weight += weight_pending;
-		weight_pending = 0;
-	    }
-	    prev_was_update_frame = rtsTrue;
-	    break;
-	    
-	case STOP_FRAME:
-	    goto end;
-	    
-	    // normal stack frames; do nothing except advance the pointer
-	default:
-	{
-	    nat frame_size = stack_frame_sizeW(frame);
-	    weight_pending += frame_size;
-	    frame = (StgClosure *)((StgPtr)frame + frame_size);
-	    prev_was_update_frame = rtsFalse;
-	}
-	}
-    }
-
-end:
-    IF_DEBUG(squeeze, 
-	     debugBelch("words_to_squeeze: %d, weight: %d, squeeze: %s\n", 
-			words_to_squeeze, weight, 
-			weight < words_to_squeeze ? "YES" : "NO"));
-
-    // Should we squeeze or not?  Arbitrary heuristic: we squeeze if
-    // the number of words we have to shift down is less than the
-    // number of stack words we squeeze away by doing so.
-    if (RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue &&
-	weight < words_to_squeeze) {
-	stackSqueeze(tso, (StgPtr)frame);
-    }
-}
-
-/* -----------------------------------------------------------------------------
- * Debugging
- * -------------------------------------------------------------------------- */
-
-#if DEBUG
-void
-printMutableList(generation *gen)
-{
-    bdescr *bd;
-    StgPtr p;
-
-    debugBelch("@@ Mutable list %p: ", gen->mut_list);
-
-    for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
-	for (p = bd->start; p < bd->free; p++) {
-	    debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
-	}
-    }
-    debugBelch("\n");
-}
-#endif /* DEBUG */
diff --git a/ghc/rts/GCCompact.c b/ghc/rts/GCCompact.c
deleted file mode 100644
index 4dfe84bbe0..0000000000
--- a/ghc/rts/GCCompact.c
+++ /dev/null
@@ -1,949 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 2001
- *
- * Compacting garbage collector
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "OSThreads.h"
-#include "Storage.h"
-#include "BlockAlloc.h"
-#include "MBlock.h"
-#include "GCCompact.h"
-#include "Schedule.h"
-#include "Apply.h"
-
-// Turn off inlining when debugging - it obfuscates things
-#ifdef DEBUG
-# undef  STATIC_INLINE
-# define STATIC_INLINE static
-#endif
-
-/* -----------------------------------------------------------------------------
-   Threading / unthreading pointers.
-
-   The basic idea here is to chain together all the fields pointing at
-   a particular object, with the root of the chain in the object's
-   info table field.  The original contents of the info pointer goes
-   at the end of the chain.
-
-   Adding a new field to the chain is a matter of swapping the
-   contents of the field with the contents of the object's info table
-   field.
-
-   To unthread the chain, we walk down it updating all the fields on
-   the chain with the new location of the object.  We stop when we
-   reach the info pointer at the end.
-
-   We use a trick to identify the info pointer: when swapping pointers
-   for threading, we set the low bit of the original pointer, with the
-   result that all the pointers in the chain have their low bits set
-   except for the info pointer.
-   -------------------------------------------------------------------------- */
-
-STATIC_INLINE void
-thread( StgPtr p )
-{
-    StgPtr q = (StgPtr)*p;
-    bdescr *bd;
-
-    // It doesn't look like a closure at the moment, because the info
-    // ptr is possibly threaded:
-    // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
-
-    if (HEAP_ALLOCED(q)) {
-	bd = Bdescr(q); 
-	// a handy way to discover whether the ptr is into the
-	// compacted area of the old gen, is that the EVACUATED flag
-	// is zero (it's non-zero for all the other areas of live
-	// memory).
-	if ((bd->flags & BF_EVACUATED) == 0) {
-	    *p = (StgWord)*q;
-	    *q = (StgWord)p + 1;	// set the low bit
-	}
-    }
-}
-
-STATIC_INLINE void
-unthread( StgPtr p, StgPtr free )
-{
-    StgWord q = *p, r;
-    
-    while ((q & 1) != 0) {
-	q -= 1;	// unset the low bit again
-	r = *((StgPtr)q);
-	*((StgPtr)q) = (StgWord)free;
-	q = r;
-    }
-    *p = q;
-}
-
-STATIC_INLINE StgInfoTable *
-get_threaded_info( StgPtr p )
-{
-    StgPtr q = (P_)GET_INFO((StgClosure *)p);
-
-    while (((StgWord)q & 1) != 0) {
-	q = (P_)*((StgPtr)((StgWord)q-1));
-    }
-
-    ASSERT(LOOKS_LIKE_INFO_PTR(q));
-    return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
-}
-
-// A word-aligned memmove will be faster for small objects than libc's or gcc's.
-// Remember, the two regions *might* overlap, but: to <= from.
-STATIC_INLINE void
-move(StgPtr to, StgPtr from, nat size)
-{
-    for(; size > 0; --size) {
-	*to++ = *from++;
-    }
-}
-
-static void
-thread_static( StgClosure* p )
-{
-  const StgInfoTable *info;
-
-  // keep going until we've threaded all the objects on the linked
-  // list... 
-  while (p != END_OF_STATIC_LIST) {
-
-    info = get_itbl(p);
-    switch (info->type) {
-      
-    case IND_STATIC:
-	thread((StgPtr)&((StgInd *)p)->indirectee);
-	p = *IND_STATIC_LINK(p);
-	continue;
-      
-    case THUNK_STATIC:
-	p = *THUNK_STATIC_LINK(p);
-	continue;
-    case FUN_STATIC:
-	p = *FUN_STATIC_LINK(p);
-	continue;
-    case CONSTR_STATIC:
-	p = *STATIC_LINK(info,p);
-	continue;
-      
-    default:
-	barf("thread_static: strange closure %d", (int)(info->type));
-    }
-
-  }
-}
-
-STATIC_INLINE void
-thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
-{
-    nat i, b;
-    StgWord bitmap;
-
-    b = 0;
-    bitmap = large_bitmap->bitmap[b];
-    for (i = 0; i < size; ) {
-	if ((bitmap & 1) == 0) {
-	    thread(p);
-	}
-	i++;
-	p++;
-	if (i % BITS_IN(W_) == 0) {
-	    b++;
-	    bitmap = large_bitmap->bitmap[b];
-	} else {
-	    bitmap = bitmap >> 1;
-	}
-    }
-}
-
-STATIC_INLINE StgPtr
-thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
-{
-    StgPtr p;
-    StgWord bitmap;
-    nat size;
-
-    p = (StgPtr)args;
-    switch (fun_info->f.fun_type) {
-    case ARG_GEN:
-	bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
-	size = BITMAP_SIZE(fun_info->f.b.bitmap);
-	goto small_bitmap;
-    case ARG_GEN_BIG:
-	size = GET_FUN_LARGE_BITMAP(fun_info)->size;
-	thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
-	p += size;
-	break;
-    default:
-	bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
-	size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
-    small_bitmap:
-	while (size > 0) {
-	    if ((bitmap & 1) == 0) {
-		thread(p);
-	    }
-	    p++;
-	    bitmap = bitmap >> 1;
-	    size--;
-	}
-	break;
-    }
-    return p;
-}
-
-static void
-thread_stack(StgPtr p, StgPtr stack_end)
-{
-    const StgRetInfoTable* info;
-    StgWord bitmap;
-    nat size;
-    
-    // highly similar to scavenge_stack, but we do pointer threading here.
-    
-    while (p < stack_end) {
-
-	// *p must be the info pointer of an activation
-	// record.  All activation records have 'bitmap' style layout
-	// info.
-	//
-	info  = get_ret_itbl((StgClosure *)p);
-	
-	switch (info->i.type) {
-	    
-	    // Dynamic bitmap: the mask is stored on the stack 
-	case RET_DYN:
-	{
-	    StgWord dyn;
-	    dyn = ((StgRetDyn *)p)->liveness;
-
-	    // traverse the bitmap first
-	    bitmap = RET_DYN_LIVENESS(dyn);
-	    p      = (P_)&((StgRetDyn *)p)->payload[0];
-	    size   = RET_DYN_BITMAP_SIZE;
-	    while (size > 0) {
-		if ((bitmap & 1) == 0) {
-		    thread(p);
-		}
-		p++;
-		bitmap = bitmap >> 1;
-		size--;
-	    }
-	    
-	    // skip over the non-ptr words
-	    p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
-	    
-	    // follow the ptr words
-	    for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
-		thread(p);
-		p++;
-	    }
-	    continue;
-	}
-	    
-	    // small bitmap (<= 32 entries, or 64 on a 64-bit machine) 
-        case CATCH_RETRY_FRAME:
-        case CATCH_STM_FRAME:
-        case ATOMICALLY_FRAME:
-	case UPDATE_FRAME:
-	case STOP_FRAME:
-	case CATCH_FRAME:
-	case RET_SMALL:
-	case RET_VEC_SMALL:
-	    bitmap = BITMAP_BITS(info->i.layout.bitmap);
-	    size   = BITMAP_SIZE(info->i.layout.bitmap);
-	    p++;
-	    // NOTE: the payload starts immediately after the info-ptr, we
-	    // don't have an StgHeader in the same sense as a heap closure.
-	    while (size > 0) {
-		if ((bitmap & 1) == 0) {
-		    thread(p);
-		}
-		p++;
-		bitmap = bitmap >> 1;
-		size--;
-	    }
-	    continue;
-
-	case RET_BCO: {
-	    StgBCO *bco;
-	    nat size;
-	    
-	    p++;
-	    bco = (StgBCO *)*p;
-	    thread(p);
-	    p++;
-	    size = BCO_BITMAP_SIZE(bco);
-	    thread_large_bitmap(p, BCO_BITMAP(bco), size);
-	    p += size;
-	    continue;
-	}
-
-	    // large bitmap (> 32 entries, or 64 on a 64-bit machine) 
-	case RET_BIG:
-	case RET_VEC_BIG:
-	    p++;
-	    size = GET_LARGE_BITMAP(&info->i)->size;
-	    thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
-	    p += size;
-	    continue;
-
-	case RET_FUN:
-	{
-	    StgRetFun *ret_fun = (StgRetFun *)p;
-	    StgFunInfoTable *fun_info;
-	    
-	    fun_info = itbl_to_fun_itbl(
-		get_threaded_info((StgPtr)ret_fun->fun));
-	         // *before* threading it!
-	    thread((StgPtr)&ret_fun->fun);
-	    p = thread_arg_block(fun_info, ret_fun->payload);
-	    continue;
-	}
-
-	default:
-	    barf("thread_stack: weird activation record found on stack: %d", 
-		 (int)(info->i.type));
-	}
-    }
-}
-
-STATIC_INLINE StgPtr
-thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
-{
-    StgPtr p;
-    StgWord bitmap;
-    StgFunInfoTable *fun_info;
-
-    fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun));
-    ASSERT(fun_info->i.type != PAP);
-
-    p = (StgPtr)payload;
-
-    switch (fun_info->f.fun_type) {
-    case ARG_GEN:
-	bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
-	goto small_bitmap;
-    case ARG_GEN_BIG:
-	thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
-	p += size;
-	break;
-    case ARG_BCO:
-	thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
-	p += size;
-	break;
-    default:
-	bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
-    small_bitmap:
-	while (size > 0) {
-	    if ((bitmap & 1) == 0) {
-		thread(p);
-	    }
-	    p++;
-	    bitmap = bitmap >> 1;
-	    size--;
-	}
-	break;
-    }
-
-    return p;
-}
-
-STATIC_INLINE StgPtr
-thread_PAP (StgPAP *pap)
-{
-    StgPtr p;
-    p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
-    thread((StgPtr)&pap->fun);
-    return p;
-}
-    
-STATIC_INLINE StgPtr
-thread_AP (StgAP *ap)
-{
-    StgPtr p;
-    p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
-    thread((StgPtr)&ap->fun);
-    return p;
-}    
-
-STATIC_INLINE StgPtr
-thread_AP_STACK (StgAP_STACK *ap)
-{
-    thread((StgPtr)&ap->fun);
-    thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
-    return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
-}
-
-static StgPtr
-thread_TSO (StgTSO *tso)
-{
-    thread((StgPtr)&tso->link);
-    thread((StgPtr)&tso->global_link);
-
-    if (   tso->why_blocked == BlockedOnMVar
-	|| tso->why_blocked == BlockedOnBlackHole
-	|| tso->why_blocked == BlockedOnException
-#if defined(PAR)
-	|| tso->why_blocked == BlockedOnGA
-	|| tso->why_blocked == BlockedOnGA_NoSend
-#endif
-	) {
-	thread((StgPtr)&tso->block_info.closure);
-    }
-    if ( tso->blocked_exceptions != NULL ) {
-	thread((StgPtr)&tso->blocked_exceptions);
-    }
-    
-    thread((StgPtr)&tso->trec);
-
-    thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
-    return (StgPtr)tso + tso_sizeW(tso);
-}
-
-
-static void
-update_fwd_large( bdescr *bd )
-{
-  StgPtr p;
-  const StgInfoTable* info;
-
-  for (; bd != NULL; bd = bd->link) {
-
-    p = bd->start;
-    info  = get_itbl((StgClosure *)p);
-
-    switch (info->type) {
-
-    case ARR_WORDS:
-      // nothing to follow 
-      continue;
-
-    case MUT_ARR_PTRS_CLEAN:
-    case MUT_ARR_PTRS_DIRTY:
-    case MUT_ARR_PTRS_FROZEN:
-    case MUT_ARR_PTRS_FROZEN0:
-      // follow everything 
-      {
-	StgPtr next;
-
-	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	    thread(p);
-	}
-	continue;
-      }
-
-    case TSO:
-	thread_TSO((StgTSO *)p);
-	continue;
-
-    case AP_STACK:
-	thread_AP_STACK((StgAP_STACK *)p);
-	continue;
-
-    case PAP:
-	thread_PAP((StgPAP *)p);
-	continue;
-
-    case TREC_CHUNK:
-    {
-        StgWord i;
-        StgTRecChunk *tc = (StgTRecChunk *)p;
-	TRecEntry *e = &(tc -> entries[0]);
-	thread((StgPtr)&tc->prev_chunk);
-	for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
-	  thread((StgPtr)&e->tvar);
-	  thread((StgPtr)&e->expected_value);
-	  thread((StgPtr)&e->new_value);
-	}
-	continue;
-    }
-
-    default:
-      barf("update_fwd_large: unknown/strange object  %d", (int)(info->type));
-    }
-  }
-}
-
-STATIC_INLINE StgPtr
-thread_obj (StgInfoTable *info, StgPtr p)
-{
-    switch (info->type) {
-    case THUNK_0_1:
-	return p + sizeofW(StgThunk) + 1;
-
-    case FUN_0_1:
-    case CONSTR_0_1:
-	return p + sizeofW(StgHeader) + 1;
-	
-    case FUN_1_0:
-    case CONSTR_1_0:
-	thread((StgPtr)&((StgClosure *)p)->payload[0]);
-	return p + sizeofW(StgHeader) + 1;
-	
-    case THUNK_1_0:
-	thread((StgPtr)&((StgThunk *)p)->payload[0]);
-	return p + sizeofW(StgThunk) + 1;
-	
-    case THUNK_0_2:
-	return p + sizeofW(StgThunk) + 2;
-
-    case FUN_0_2:
-    case CONSTR_0_2:
-	return p + sizeofW(StgHeader) + 2;
-	
-    case THUNK_1_1:
-	thread((StgPtr)&((StgThunk *)p)->payload[0]);
-	return p + sizeofW(StgThunk) + 2;
-
-    case FUN_1_1:
-    case CONSTR_1_1:
-	thread((StgPtr)&((StgClosure *)p)->payload[0]);
-	return p + sizeofW(StgHeader) + 2;
-	
-    case THUNK_2_0:
-	thread((StgPtr)&((StgThunk *)p)->payload[0]);
-	thread((StgPtr)&((StgThunk *)p)->payload[1]);
-	return p + sizeofW(StgThunk) + 2;
-
-    case FUN_2_0:
-    case CONSTR_2_0:
-	thread((StgPtr)&((StgClosure *)p)->payload[0]);
-	thread((StgPtr)&((StgClosure *)p)->payload[1]);
-	return p + sizeofW(StgHeader) + 2;
-	
-    case BCO: {
-	StgBCO *bco = (StgBCO *)p;
-	thread((StgPtr)&bco->instrs);
-	thread((StgPtr)&bco->literals);
-	thread((StgPtr)&bco->ptrs);
-	thread((StgPtr)&bco->itbls);
-	return p + bco_sizeW(bco);
-    }
-
-    case THUNK:
-    {
-	StgPtr end;
-	
-	end = (P_)((StgThunk *)p)->payload + 
-	    info->layout.payload.ptrs;
-	for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
-	    thread(p);
-	}
-	return p + info->layout.payload.nptrs;
-    }
-
-    case FUN:
-    case CONSTR:
-    case STABLE_NAME:
-    case IND_PERM:
-    case MUT_VAR_CLEAN:
-    case MUT_VAR_DIRTY:
-    case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case SE_BLACKHOLE:
-    case BLACKHOLE:
-    {
-	StgPtr end;
-	
-	end = (P_)((StgClosure *)p)->payload + 
-	    info->layout.payload.ptrs;
-	for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
-	    thread(p);
-	}
-	return p + info->layout.payload.nptrs;
-    }
-    
-    case WEAK:
-    {
-	StgWeak *w = (StgWeak *)p;
-	thread((StgPtr)&w->key);
-	thread((StgPtr)&w->value);
-	thread((StgPtr)&w->finalizer);
-	if (w->link != NULL) {
-	    thread((StgPtr)&w->link);
-	}
-	return p + sizeofW(StgWeak);
-    }
-    
-    case MVAR:
-    { 
-	StgMVar *mvar = (StgMVar *)p;
-	thread((StgPtr)&mvar->head);
-	thread((StgPtr)&mvar->tail);
-	thread((StgPtr)&mvar->value);
-	return p + sizeofW(StgMVar);
-    }
-    
-    case IND_OLDGEN:
-    case IND_OLDGEN_PERM:
-	thread((StgPtr)&((StgInd *)p)->indirectee);
-	return p + sizeofW(StgInd);
-
-    case THUNK_SELECTOR:
-    { 
-	StgSelector *s = (StgSelector *)p;
-	thread((StgPtr)&s->selectee);
-	return p + THUNK_SELECTOR_sizeW();
-    }
-    
-    case AP_STACK:
-	return thread_AP_STACK((StgAP_STACK *)p);
-	
-    case PAP:
-	return thread_PAP((StgPAP *)p);
-
-    case AP:
-	return thread_AP((StgAP *)p);
-	
-    case ARR_WORDS:
-	return p + arr_words_sizeW((StgArrWords *)p);
-	
-    case MUT_ARR_PTRS_CLEAN:
-    case MUT_ARR_PTRS_DIRTY:
-    case MUT_ARR_PTRS_FROZEN:
-    case MUT_ARR_PTRS_FROZEN0:
-	// follow everything 
-    {
-	StgPtr next;
-	
-	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	    thread(p);
-	}
-	return p;
-    }
-    
-    case TSO:
-	return thread_TSO((StgTSO *)p);
-    
-    case TVAR_WAIT_QUEUE:
-    {
-        StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p;
-	thread((StgPtr)&wq->waiting_tso);
-	thread((StgPtr)&wq->next_queue_entry);
-	thread((StgPtr)&wq->prev_queue_entry);
-	return p + sizeofW(StgTVarWaitQueue);
-    }
-    
-    case TVAR:
-    {
-        StgTVar *tvar = (StgTVar *)p;
-	thread((StgPtr)&tvar->current_value);
-	thread((StgPtr)&tvar->first_wait_queue_entry);
-	return p + sizeofW(StgTVar);
-    }
-    
-    case TREC_HEADER:
-    {
-        StgTRecHeader *trec = (StgTRecHeader *)p;
-	thread((StgPtr)&trec->enclosing_trec);
-	thread((StgPtr)&trec->current_chunk);
-	return p + sizeofW(StgTRecHeader);
-    }
-
-    case TREC_CHUNK:
-    {
-        StgWord i;
-        StgTRecChunk *tc = (StgTRecChunk *)p;
-	TRecEntry *e = &(tc -> entries[0]);
-	thread((StgPtr)&tc->prev_chunk);
-	for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
-	  thread((StgPtr)&e->tvar);
-	  thread((StgPtr)&e->expected_value);
-	  thread((StgPtr)&e->new_value);
-	}
-	return p + sizeofW(StgTRecChunk);
-    }
-
-    default:
-	barf("update_fwd: unknown/strange object  %d", (int)(info->type));
-	return NULL;
-    }
-}
-
-static void
-update_fwd( bdescr *blocks )
-{
-    StgPtr p;
-    bdescr *bd;
-    StgInfoTable *info;
-
-    bd = blocks;
-
-#if defined(PAR)
-    barf("update_fwd: ToDo");
-#endif
-
-    // cycle through all the blocks in the step
-    for (; bd != NULL; bd = bd->link) {
-	p = bd->start;
-
-	// linearly scan the objects in this block
-	while (p < bd->free) {
-	    ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
-	    info = get_itbl((StgClosure *)p);
-	    p = thread_obj(info, p);
-	}
-    }
-} 
-
-static void
-update_fwd_compact( bdescr *blocks )
-{
-    StgPtr p, q, free;
-#if 0
-    StgWord m;
-#endif
-    bdescr *bd, *free_bd;
-    StgInfoTable *info;
-    nat size;
-
-    bd = blocks;
-    free_bd = blocks;
-    free = free_bd->start;
-
-#if defined(PAR)
-    barf("update_fwd: ToDo");
-#endif
-
-    // cycle through all the blocks in the step
-    for (; bd != NULL; bd = bd->link) {
-	p = bd->start;
-
-	while (p < bd->free ) {
-
-	    while ( p < bd->free && !is_marked(p,bd) ) {
-		p++;
-	    }
-	    if (p >= bd->free) {
-		break;
-	    }
-
-#if 0
-    next:
-	m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
-	m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
-
-	while ( p < bd->free ) {
-
-	    if ((m & 1) == 0) {
-		m >>= 1;
-		p++;
-		if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
-		    goto next;
-		} else {
-		    continue;
-		}
-	    }
-#endif
-
-	    // Problem: we need to know the destination for this cell
-	    // in order to unthread its info pointer.  But we can't
-	    // know the destination without the size, because we may
-	    // spill into the next block.  So we have to run down the 
-	    // threaded list and get the info ptr first.
-	    info = get_threaded_info(p);
-
-	    q = p;
-
-	    p = thread_obj(info, p);
-
-	    size = p - q;
-	    if (free + size > free_bd->start + BLOCK_SIZE_W) {
-		// unset the next bit in the bitmap to indicate that
-		// this object needs to be pushed into the next
-		// block.  This saves us having to run down the
-		// threaded info pointer list twice during the next pass.
-		unmark(q+1,bd);
-		free_bd = free_bd->link;
-		free = free_bd->start;
-	    } else {
-		ASSERT(is_marked(q+1,bd));
-	    }
-
-	    unthread(q,free);
-	    free += size;
-#if 0
-	    goto next;
-#endif
-	}
-    }
-}
-
-static nat
-update_bkwd_compact( step *stp )
-{
-    StgPtr p, free;
-#if 0
-    StgWord m;
-#endif
-    bdescr *bd, *free_bd;
-    StgInfoTable *info;
-    nat size, free_blocks;
-
-    bd = free_bd = stp->old_blocks;
-    free = free_bd->start;
-    free_blocks = 1;
-
-#if defined(PAR)
-    barf("update_bkwd: ToDo");
-#endif
-
-    // cycle through all the blocks in the step
-    for (; bd != NULL; bd = bd->link) {
-	p = bd->start;
-
-	while (p < bd->free ) {
-
-	    while ( p < bd->free && !is_marked(p,bd) ) {
-		p++;
-	    }
-	    if (p >= bd->free) {
-		break;
-	    }
-
-#if 0
-    next:
-	m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
-	m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
-
-	while ( p < bd->free ) {
-
-	    if ((m & 1) == 0) {
-		m >>= 1;
-		p++;
-		if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
-		    goto next;
-		} else {
-		    continue;
-		}
-	    }
-#endif
-
-	    if (!is_marked(p+1,bd)) {
-		// don't forget to update the free ptr in the block desc.
-		free_bd->free = free;
-		free_bd = free_bd->link;
-		free = free_bd->start;
-		free_blocks++;
-	    }
-
-	    unthread(p,free);
-	    ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
-	    info = get_itbl((StgClosure *)p);
-	    size = closure_sizeW_((StgClosure *)p,info);
-
-	    if (free != p) {
-		move(free,p,size);
-	    }
-
-	    // relocate TSOs
-	    if (info->type == TSO) {
-		move_TSO((StgTSO *)p, (StgTSO *)free);
-	    }
-
-	    free += size;
-	    p += size;
-#if 0
-	    goto next;
-#endif
-	}
-    }
-
-    // free the remaining blocks and count what's left.
-    free_bd->free = free;
-    if (free_bd->link != NULL) {
-	freeChain(free_bd->link);
-	free_bd->link = NULL;
-    }
-
-    return free_blocks;
-}
-
-void
-compact( void (*get_roots)(evac_fn) )
-{
-    nat g, s, blocks;
-    step *stp;
-
-    // 1. thread the roots
-    get_roots((evac_fn)thread);
-
-    // the weak pointer lists...
-    if (weak_ptr_list != NULL) {
-	thread((StgPtr)(void *)&weak_ptr_list);
-    }
-    if (old_weak_ptr_list != NULL) {
-	thread((StgPtr)(void *)&old_weak_ptr_list); // tmp
-    }
-
-    // mutable lists
-    for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
-	bdescr *bd;
-	StgPtr p;
-	for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
-	    for (p = bd->start; p < bd->free; p++) {
-		thread(p);
-	    }
-	}
-    }
-
-    // the global thread list
-    thread((StgPtr)(void *)&all_threads);
-
-    // any threads resurrected during this GC
-    thread((StgPtr)(void *)&resurrected_threads);
-
-    // the task list
-    {
-	Task *task;
-	for (task = all_tasks; task != NULL; task = task->all_link) {
-	    if (task->tso) {
-		thread((StgPtr)&task->tso);
-	    }
-	}
-    }
-
-    // the static objects
-    thread_static(scavenged_static_objects);
-
-    // the stable pointer table
-    threadStablePtrTable((evac_fn)thread);
-
-    // the CAF list (used by GHCi)
-    markCAFs((evac_fn)thread);
-
-    // 2. update forward ptrs
-    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	for (s = 0; s < generations[g].n_steps; s++) {
-	    if (g==0 && s ==0) continue;
-	    stp = &generations[g].steps[s];
-	    IF_DEBUG(gc, debugBelch("update_fwd:  %d.%d\n", stp->gen->no, stp->no););
-
-	    update_fwd(stp->blocks);
-	    update_fwd_large(stp->scavenged_large_objects);
-	    if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
-		IF_DEBUG(gc, debugBelch("update_fwd:  %d.%d (compact)\n", stp->gen->no, stp->no););
-		update_fwd_compact(stp->old_blocks);
-	    }
-	}
-    }
-
-    // 3. update backward ptrs
-    stp = &oldest_gen->steps[0];
-    if (stp->old_blocks != NULL) {
-	blocks = update_bkwd_compact(stp);
-	IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n", 
-			     stp->gen->no, stp->no,
-			     stp->n_old_blocks, blocks););
-	stp->n_old_blocks = blocks;
-    }
-}
diff --git a/ghc/rts/GCCompact.h b/ghc/rts/GCCompact.h
deleted file mode 100644
index 0fb39b3b12..0000000000
--- a/ghc/rts/GCCompact.h
+++ /dev/null
@@ -1,44 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1998-2005
- *
- * Compacting garbage collector
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef GCCOMPACT_H
-#define GCCOMPACT_H
-
-STATIC_INLINE void 
-mark(StgPtr p, bdescr *bd)
-{
-    nat offset_within_block = p - bd->start; // in words
-    StgPtr bitmap_word = (StgPtr)bd->u.bitmap + 
-	(offset_within_block / (sizeof(W_)*BITS_PER_BYTE));
-    StgWord bit_mask = (StgWord)1 << (offset_within_block & (sizeof(W_)*BITS_PER_BYTE - 1));
-    *bitmap_word |= bit_mask;
-}
-
-STATIC_INLINE void 
-unmark(StgPtr p, bdescr *bd)
-{
-    nat offset_within_block = p - bd->start; // in words
-    StgPtr bitmap_word = (StgPtr)bd->u.bitmap + 
-	(offset_within_block / (sizeof(W_)*BITS_PER_BYTE));
-    StgWord bit_mask = (StgWord)1 << (offset_within_block & (sizeof(W_)*BITS_PER_BYTE - 1));
-    *bitmap_word &= ~bit_mask;
-}
-
-STATIC_INLINE StgWord
-is_marked(StgPtr p, bdescr *bd)
-{
-    nat offset_within_block = p - bd->start; // in words
-    StgPtr bitmap_word = (StgPtr)bd->u.bitmap + 
-	(offset_within_block / (sizeof(W_)*BITS_PER_BYTE));
-    StgWord bit_mask = (StgWord)1 << (offset_within_block & (sizeof(W_)*BITS_PER_BYTE - 1));
-    return (*bitmap_word & bit_mask);
-}
-
-void compact( void (*get_roots)(evac_fn) );
-
-#endif /* GCCOMPACT_H */
diff --git a/ghc/rts/GetTime.h b/ghc/rts/GetTime.h
deleted file mode 100644
index 5f02df0625..0000000000
--- a/ghc/rts/GetTime.h
+++ /dev/null
@@ -1,26 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 2005
- *
- * Machine-independent interface to time measurement
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef GETTIME_H
-#define GETTIME_H
-
-// We'll use a fixed resolution of usec for now.  The machine
-// dependent implementation may have a different resolution, but we'll
-// normalise to this for the machine independent interface.
-#define TICKS_PER_SECOND 1000000
-typedef StgInt64 Ticks;
-
-Ticks getProcessCPUTime     (void);
-Ticks getThreadCPUTime      (void);
-Ticks getProcessElapsedTime (void);
-void  getProcessTimes       (Ticks *user, Ticks *elapsed);
-
-// Not strictly timing, but related
-nat   getPageFaults         (void);
-
-#endif /* GETTIME_H */
diff --git a/ghc/rts/HSprel.def b/ghc/rts/HSprel.def
deleted file mode 100644
index 0ffe00b48c..0000000000
--- a/ghc/rts/HSprel.def
+++ /dev/null
@@ -1,28 +0,0 @@
-; list of entry points that the RTS imports from
-; the Prelude.
-EXPORTS
-PrelBase_False_closure
-PrelBase_True_closure
-PrelBase_Czh_con_info DATA
-PrelBase_Czh_static_info DATA
-PrelBase_Izh_con_info DATA
-PrelBase_Izh_static_info DATA
-PrelAddr_I64zh_con_info DATA
-PrelAddr_W64zh_con_info DATA
-PrelAddr_Azh_con_info DATA
-PrelAddr_Azh_static_info DATA
-PrelFloat_Fzh_con_info DATA
-PrelFloat_Fzh_static_info DATA
-PrelFloat_Dzh_con_info DATA
-PrelFloat_Dzh_static_info DATA
-PrelAddr_Wzh_con_info DATA
-PrelAddr_Wzh_static_info DATA
-PrelStable_StablePtr_con_info DATA
-PrelStable_StablePtr_static_info DATA
-PrelPack_unpackCString_closure
-PrelIOBase_stackOverflow_closure
-PrelIOBase_BlockedOnDeadMVar_closure
-PrelIOBase_BlockedIndefinitely_closure
-PrelIOBase_NonTermination_closure
-PrelWeak_runFinalizzerBatch_closure
-__stginit_Prelude
diff --git a/ghc/rts/Hash.c b/ghc/rts/Hash.c
deleted file mode 100644
index ada11a6a85..0000000000
--- a/ghc/rts/Hash.c
+++ /dev/null
@@ -1,376 +0,0 @@
-/*-----------------------------------------------------------------------------
- *
- * (c) The AQUA Project, Glasgow University, 1995-1998
- * (c) The GHC Team, 1999
- *
- * Dynamically expanding linear hash tables, as described in
- * Per-\AAke Larson, ``Dynamic Hash Tables,'' CACM 31(4), April 1988,
- * pp. 446 -- 457.
- * -------------------------------------------------------------------------- */
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "Hash.h"
-#include "RtsUtils.h"
-
-#include <stdlib.h>
-#include <string.h>
-
-#define HSEGSIZE    1024    /* Size of a single hash table segment */
-			    /* Also the minimum size of a hash table */
-#define HDIRSIZE    1024    /* Size of the segment directory */
-			    /* Maximum hash table size is HSEGSIZE * HDIRSIZE */
-#define HLOAD	    5	    /* Maximum average load of a single hash bucket */
-
-#define HCHUNK	    (1024 * sizeof(W_) / sizeof(HashList))
-			    /* Number of HashList cells to allocate in one go */
-
-
-/* Linked list of (key, data) pairs for separate chaining */
-struct hashlist {
-    StgWord key;
-    void *data;
-    struct hashlist *next;  /* Next cell in bucket chain (same hash value) */
-};
-
-typedef struct hashlist HashList;
-
-typedef int HashFunction(HashTable *table, StgWord key);
-typedef int CompareFunction(StgWord key1, StgWord key2);
-
-struct hashtable {
-    int split;		    /* Next bucket to split when expanding */
-    int max;		    /* Max bucket of smaller table */
-    int mask1;		    /* Mask for doing the mod of h_1 (smaller table) */
-    int mask2;		    /* Mask for doing the mod of h_2 (larger table) */
-    int kcount;		    /* Number of keys */
-    int bcount;		    /* Number of buckets */
-    HashList **dir[HDIRSIZE];	/* Directory of segments */
-    HashFunction *hash;		/* hash function */
-    CompareFunction *compare;   /* key comparison function */
-};
-
-/* -----------------------------------------------------------------------------
- * Hash first using the smaller table.  If the bucket is less than the
- * next bucket to be split, re-hash using the larger table.
- * -------------------------------------------------------------------------- */
-
-static int
-hashWord(HashTable *table, StgWord key)
-{
-    int bucket;
-
-    /* Strip the boring zero bits */
-    key /= sizeof(StgWord);
-
-    /* Mod the size of the hash table (a power of 2) */
-    bucket = key & table->mask1;
-
-    if (bucket < table->split) {
-	/* Mod the size of the expanded hash table (also a power of 2) */
-	bucket = key & table->mask2;
-    }
-    return bucket;
-}
-
-static int
-hashStr(HashTable *table, char *key)
-{
-    int h, bucket;
-    char *s;
-
-    s = key;
-    for (h=0; *s; s++) {
-	h *= 128;
-	h += *s;
-	h = h % 1048583;	/* some random large prime */
-    }
-
-    /* Mod the size of the hash table (a power of 2) */
-    bucket = h & table->mask1;
-
-    if (bucket < table->split) {
-	/* Mod the size of the expanded hash table (also a power of 2) */
-	bucket = h & table->mask2;
-    }
-
-    return bucket;
-}
-
-static int
-compareWord(StgWord key1, StgWord key2)
-{
-    return (key1 == key2);
-}
-
-static int
-compareStr(StgWord key1, StgWord key2)
-{
-    return (strcmp((char *)key1, (char *)key2) == 0);
-}
-
-
-/* -----------------------------------------------------------------------------
- * Allocate a new segment of the dynamically growing hash table.
- * -------------------------------------------------------------------------- */
-
-static void
-allocSegment(HashTable *table, int segment)
-{
-    table->dir[segment] = stgMallocBytes(HSEGSIZE * sizeof(HashList *), 
-					 "allocSegment");
-}
-
-
-/* -----------------------------------------------------------------------------
- * Expand the larger hash table by one bucket, and split one bucket
- * from the smaller table into two parts.  Only the bucket referenced
- * by @table->split@ is affected by the expansion.
- * -------------------------------------------------------------------------- */
-
-static void
-expand(HashTable *table)
-{
-    int oldsegment;
-    int oldindex;
-    int newbucket;
-    int newsegment;
-    int newindex;
-    HashList *hl;
-    HashList *next;
-    HashList *old, *new;
-
-    if (table->split + table->max >= HDIRSIZE * HSEGSIZE)
-	/* Wow!  That's big.  Too big, so don't expand. */
-	return;
-
-    /* Calculate indices of bucket to split */
-    oldsegment = table->split / HSEGSIZE;
-    oldindex = table->split % HSEGSIZE;
-
-    newbucket = table->max + table->split;
-
-    /* And the indices of the new bucket */
-    newsegment = newbucket / HSEGSIZE;
-    newindex = newbucket % HSEGSIZE;
-
-    if (newindex == 0)
-	allocSegment(table, newsegment);
-
-    if (++table->split == table->max) {
-	table->split = 0;
-	table->max *= 2;
-	table->mask1 = table->mask2;
-	table->mask2 = table->mask2 << 1 | 1;
-    }
-    table->bcount++;
-
-    /* Split the bucket, paying no attention to the original order */
-
-    old = new = NULL;
-    for (hl = table->dir[oldsegment][oldindex]; hl != NULL; hl = next) {
-	next = hl->next;
-	if (table->hash(table, hl->key) == newbucket) {
-	    hl->next = new;
-	    new = hl;
-	} else {
-	    hl->next = old;
-	    old = hl;
-	}
-    }
-    table->dir[oldsegment][oldindex] = old;
-    table->dir[newsegment][newindex] = new;
-
-    return;
-}
-
-void *
-lookupHashTable(HashTable *table, StgWord key)
-{
-    int bucket;
-    int segment;
-    int index;
-    HashList *hl;
-
-    bucket = table->hash(table, key);
-    segment = bucket / HSEGSIZE;
-    index = bucket % HSEGSIZE;
-
-    for (hl = table->dir[segment][index]; hl != NULL; hl = hl->next)
-	if (table->compare(hl->key, key))
-	    return hl->data;
-
-    /* It's not there */
-    return NULL;
-}
-
-/* -----------------------------------------------------------------------------
- * We allocate the hashlist cells in large chunks to cut down on malloc
- * overhead.  Although we keep a free list of hashlist cells, we make
- * no effort to actually return the space to the malloc arena.
- * -------------------------------------------------------------------------- */
-
-static HashList *freeList = NULL;
-
-static HashList *
-allocHashList(void)
-{
-    HashList *hl, *p;
-
-    if ((hl = freeList) != NULL) {
-	freeList = hl->next;
-    } else {
-        hl = stgMallocBytes(HCHUNK * sizeof(HashList), "allocHashList");
-
-	freeList = hl + 1;
-	for (p = freeList; p < hl + HCHUNK - 1; p++)
-	    p->next = p + 1;
-	p->next = NULL;
-    }
-    return hl;
-}
-
-static void
-freeHashList(HashList *hl)
-{
-    hl->next = freeList;
-    freeList = hl;
-}
-
-void
-insertHashTable(HashTable *table, StgWord key, void *data)
-{
-    int bucket;
-    int segment;
-    int index;
-    HashList *hl;
-
-    // Disable this assert; sometimes it's useful to be able to
-    // overwrite entries in the hash table.
-    // ASSERT(lookupHashTable(table, key) == NULL);
-
-    /* When the average load gets too high, we expand the table */
-    if (++table->kcount >= HLOAD * table->bcount)
-	expand(table);
-
-    bucket = table->hash(table, key);
-    segment = bucket / HSEGSIZE;
-    index = bucket % HSEGSIZE;
-
-    hl = allocHashList();
-
-    hl->key = key;
-    hl->data = data;
-    hl->next = table->dir[segment][index];
-    table->dir[segment][index] = hl;
-
-}
-
-void *
-removeHashTable(HashTable *table, StgWord key, void *data)
-{
-    int bucket;
-    int segment;
-    int index;
-    HashList *hl;
-    HashList *prev = NULL;
-
-    bucket = table->hash(table, key);
-    segment = bucket / HSEGSIZE;
-    index = bucket % HSEGSIZE;
-
-    for (hl = table->dir[segment][index]; hl != NULL; hl = hl->next) {
-	if (table->compare(hl->key,key) && (data == NULL || hl->data == data)) {
-	    if (prev == NULL)
-		table->dir[segment][index] = hl->next;
-	    else
-		prev->next = hl->next;
-	    freeHashList(hl);
-	    table->kcount--;
-	    return hl->data;
-	}
-	prev = hl;
-    }
-
-    /* It's not there */
-    ASSERT(data == NULL);
-    return NULL;
-}
-
-/* -----------------------------------------------------------------------------
- * When we free a hash table, we are also good enough to free the
- * data part of each (key, data) pair, as long as our caller can tell
- * us how to do it.
- * -------------------------------------------------------------------------- */
-
-void
-freeHashTable(HashTable *table, void (*freeDataFun)(void *) )
-{
-    long segment;
-    long index;
-    HashList *hl;
-    HashList *next;
-
-    /* The last bucket with something in it is table->max + table->split - 1 */
-    segment = (table->max + table->split - 1) / HSEGSIZE;
-    index = (table->max + table->split - 1) % HSEGSIZE;
-
-    while (segment >= 0) {
-	while (index >= 0) {
-	    for (hl = table->dir[segment][index]; hl != NULL; hl = next) {
-		next = hl->next;
-		if (freeDataFun != NULL)
-		    (*freeDataFun)(hl->data);
-		freeHashList(hl);
-	    }
-	    index--;
-	}
-	stgFree(table->dir[segment]);
-	segment--;
-	index = HSEGSIZE - 1;
-    }
-    stgFree(table);
-}
-
-/* -----------------------------------------------------------------------------
- * When we initialize a hash table, we set up the first segment as well,
- * initializing all of the first segment's hash buckets to NULL.
- * -------------------------------------------------------------------------- */
-
-static HashTable *
-allocHashTable_(HashFunction *hash, CompareFunction *compare)
-{
-    HashTable *table;
-    HashList **hb;
-
-    table = stgMallocBytes(sizeof(HashTable),"allocHashTable");
-
-    allocSegment(table, 0);
-
-    for (hb = table->dir[0]; hb < table->dir[0] + HSEGSIZE; hb++)
-	*hb = NULL;
-
-    table->split = 0;
-    table->max = HSEGSIZE;
-    table->mask1 = HSEGSIZE - 1;
-    table->mask2 = 2 * HSEGSIZE - 1;
-    table->kcount = 0;
-    table->bcount = HSEGSIZE;
-    table->hash = hash;
-    table->compare = compare;
-
-    return table;
-}
-
-HashTable *
-allocHashTable(void)
-{
-    return allocHashTable_(hashWord, compareWord);
-}
-
-HashTable *
-allocStrHashTable(void)
-{
-    return allocHashTable_((HashFunction *)hashStr, 
-			   (CompareFunction *)compareStr);
-}
diff --git a/ghc/rts/Hash.h b/ghc/rts/Hash.h
deleted file mode 100644
index ad55953da4..0000000000
--- a/ghc/rts/Hash.h
+++ /dev/null
@@ -1,40 +0,0 @@
-/*-----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1999
- *
- * Prototypes for Hash.c
- *
- * -------------------------------------------------------------------------- */
-
-#ifndef HASH_H
-#define HASH_H
-
-typedef struct hashtable HashTable; /* abstract */
-
-/* Hash table access where the keys are StgWords */
-HashTable * allocHashTable    ( void );
-void *      lookupHashTable ( HashTable *table, StgWord key );
-void        insertHashTable ( HashTable *table, StgWord key, void *data );
-void *      removeHashTable ( HashTable *table, StgWord key, void *data );
-
-/* Hash table access where the keys are C strings (the strings are
- * assumed to be allocated by the caller, and mustn't be deallocated
- * until the corresponding hash table entry has been removed).
- */
-HashTable * allocStrHashTable ( void );
-
-#define lookupStrHashTable(table, key)  \
-   (lookupHashTable(table, (StgWord)key))
-
-#define insertStrHashTable(table, key, data)  \
-   (insertHashTable(table, (StgWord)key, data))
-
-#define removeStrHashTable(table, key, data) \
-   (removeHashTable(table, (StgWord)key, data))
-
-/* Freeing hash tables 
- */
-void freeHashTable ( HashTable *table, void (*freeDataFun)(void *) );
-
-#endif /* HASH_H */
-
diff --git a/ghc/rts/HeapStackCheck.cmm b/ghc/rts/HeapStackCheck.cmm
deleted file mode 100644
index 4e5dd24596..0000000000
--- a/ghc/rts/HeapStackCheck.cmm
+++ /dev/null
@@ -1,964 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Canned Heap-Check and Stack-Check sequences.
- *
- * This file is written in a subset of C--, extended with various
- * features specific to GHC.  It is compiled by GHC directly.  For the
- * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Cmm.h"
-
-/* Stack/Heap Check Failure
- * ------------------------
- *
- * On discovering that a stack or heap check has failed, we do the following:
- *
- *    - If the context_switch flag is set, indicating that there are more
- *      threads waiting to run, we yield to the scheduler 
- *	(return ThreadYielding).
- *
- *    - If Hp > HpLim, we've had a heap check failure.  This means we've
- *	come to the end of the current heap block, so we try to chain
- *	another block on with ExtendNursery().  
- *
- *	     - If this succeeds, we carry on without returning to the 
- *	       scheduler.  
- *
- *	     - If it fails, we return to the scheduler claiming HeapOverflow
- *	       so that a garbage collection can be performed.
- *
- *    - If Hp <= HpLim, it must have been a stack check that failed.  In
- *	which case, we return to the scheduler claiming StackOverflow, the
- *	scheduler will either increase the size of our stack, or raise
- *	an exception if the stack is already too big.
- *
- * The effect of checking for context switch only in the heap/stack check
- * failure code is that we'll switch threads after the current thread has
- * reached the end of its heap block.  If a thread isn't allocating
- * at all, it won't yield.  Hopefully this won't be a problem in practice.
- */
- 
-#define PRE_RETURN(why,what_next)			\
-  StgTSO_what_next(CurrentTSO) = what_next::I16;	\
-  StgRegTable_rRet(BaseReg) = why;           	        \
-  R1 = BaseReg;
-
-/* Remember that the return address is *removed* when returning to a
- * ThreadRunGHC thread.
- */
-
-#define GC_GENERIC						\
-    DEBUG_ONLY(foreign "C" heapCheckFail());			\
-    if (Hp > HpLim) {						\
-        Hp = Hp - HpAlloc/*in bytes*/;				\
-        if (HpAlloc <= BLOCK_SIZE				\
-            && bdescr_link(CurrentNursery) != NULL) {		\
-            CLOSE_NURSERY();					\
-            CurrentNursery = bdescr_link(CurrentNursery);	\
-            OPEN_NURSERY();					\
-            if (CInt[context_switch] != 0 :: CInt) {		\
-                R1 = ThreadYielding;				\
-                goto sched;					\
-            } else {						\
-                jump %ENTRY_CODE(Sp(0));			\
-            }							\
-	} else {						\
-            R1 = HeapOverflow;					\
-            goto sched;						\
-        }							\
-    } else {							\
-        R1 = StackOverflow;					\
-    }								\
-  sched:							\
-    PRE_RETURN(R1,ThreadRunGHC);				\
-    jump stg_returnToSched;
-
-#define HP_GENERIC				\
-   PRE_RETURN(HeapOverflow, ThreadRunGHC)	\
-  jump stg_returnToSched;
-
-#define BLOCK_GENERIC				\
-   PRE_RETURN(ThreadBlocked,  ThreadRunGHC)	\
-  jump stg_returnToSched;
-
-#define YIELD_GENERIC				\
-  PRE_RETURN(ThreadYielding, ThreadRunGHC)	\
-  jump stg_returnToSched;
-
-#define BLOCK_BUT_FIRST(c)			\
-  PRE_RETURN(ThreadBlocked, ThreadRunGHC)	\
-  R2 = c;					\
-  jump stg_returnToSchedButFirst;
-
-#define YIELD_TO_INTERPRETER			\
-  PRE_RETURN(ThreadYielding, ThreadInterpret)	\
-  jump stg_returnToSchedNotPaused;
-
-/* -----------------------------------------------------------------------------
-   Heap checks in thunks/functions.
-
-   In these cases, node always points to the function closure.  This gives
-   us an easy way to return to the function: just leave R1 on the top of
-   the stack, and have the scheduler enter it to return.
-
-   There are canned sequences for 'n' pointer values in registers.
-   -------------------------------------------------------------------------- */
-
-INFO_TABLE_RET( stg_enter, 1/*framesize*/, 0/*bitmap*/, RET_SMALL)
-{
-    R1 = Sp(1);
-    Sp_adj(2);
-    ENTER();
-}
-
-__stg_gc_enter_1
-{
-    Sp_adj(-2);
-    Sp(1) = R1;
-    Sp(0) = stg_enter_info;
-    GC_GENERIC
-}
-
-#if defined(GRAN)
-/*
-  ToDo: merge the block and yield macros, calling something like BLOCK(N)
-        at the end;
-*/
-
-/* 
-   Should we actually ever do a yield in such a case?? -- HWL
-*/
-gran_yield_0
-{
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadYielding;
-    jump StgReturn;
-}
-
-gran_yield_1
-{
-    Sp_adj(-1);
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadYielding;
-    jump StgReturn;
-}
-
-/*- 2 Regs--------------------------------------------------------------------*/
-
-gran_yield_2
-{
-    Sp_adj(-2);
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadYielding;
-    jump StgReturn;
-}
-
-/*- 3 Regs -------------------------------------------------------------------*/
-
-gran_yield_3
-{
-    Sp_adj(-3);
-    Sp(2) = R3;
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadYielding;
-    jump StgReturn;
-}
-
-/*- 4 Regs -------------------------------------------------------------------*/
-
-gran_yield_4
-{
-    Sp_adj(-4);
-    Sp(3) = R4;
-    Sp(2) = R3;
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadYielding;
-    jump StgReturn;
-}
-
-/*- 5 Regs -------------------------------------------------------------------*/
-
-gran_yield_5
-{
-    Sp_adj(-5);
-    Sp(4) = R5;
-    Sp(3) = R4;
-    Sp(2) = R3;
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadYielding;
-    jump StgReturn;
-}
-
-/*- 6 Regs -------------------------------------------------------------------*/
-
-gran_yield_6
-{
-    Sp_adj(-6);
-    Sp(5) = R6;
-    Sp(4) = R5;
-    Sp(3) = R4;
-    Sp(2) = R3;
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadYielding;
-    jump StgReturn;
-}
-
-/*- 7 Regs -------------------------------------------------------------------*/
-
-gran_yield_7
-{
-    Sp_adj(-7);
-    Sp(6) = R7;
-    Sp(5) = R6;
-    Sp(4) = R5;
-    Sp(3) = R4;
-    Sp(2) = R3;
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadYielding;
-    jump StgReturn;
-}
-
-/*- 8 Regs -------------------------------------------------------------------*/
-
-gran_yield_8
-{
-    Sp_adj(-8);
-    Sp(7) = R8;
-    Sp(6) = R7;
-    Sp(5) = R6;
-    Sp(4) = R5;
-    Sp(3) = R4;
-    Sp(2) = R3;
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadYielding;
-    jump StgReturn;
-}
-
-// the same routines but with a block rather than a yield
-
-gran_block_1
-{
-    Sp_adj(-1);
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadBlocked;
-    jump StgReturn;
-}
-
-/*- 2 Regs--------------------------------------------------------------------*/
-
-gran_block_2
-{
-    Sp_adj(-2);
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadBlocked;
-    jump StgReturn;
-}
-
-/*- 3 Regs -------------------------------------------------------------------*/
-
-gran_block_3
-{
-    Sp_adj(-3);
-    Sp(2) = R3;
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadBlocked;
-    jump StgReturn;
-}
-
-/*- 4 Regs -------------------------------------------------------------------*/
-
-gran_block_4
-{
-    Sp_adj(-4);
-    Sp(3) = R4;
-    Sp(2) = R3;
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadBlocked;
-    jump StgReturn;
-}
-
-/*- 5 Regs -------------------------------------------------------------------*/
-
-gran_block_5
-{
-    Sp_adj(-5);
-    Sp(4) = R5;
-    Sp(3) = R4;
-    Sp(2) = R3;
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadBlocked;
-    jump StgReturn;
-}
-
-/*- 6 Regs -------------------------------------------------------------------*/
-
-gran_block_6
-{
-    Sp_adj(-6);
-    Sp(5) = R6;
-    Sp(4) = R5;
-    Sp(3) = R4;
-    Sp(2) = R3;
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadBlocked;
-    jump StgReturn;
-}
-
-/*- 7 Regs -------------------------------------------------------------------*/
-
-gran_block_7
-{
-    Sp_adj(-7);
-    Sp(6) = R7;
-    Sp(5) = R6;
-    Sp(4) = R5;
-    Sp(3) = R4;
-    Sp(2) = R3;
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadBlocked;
-    jump StgReturn;
-}
-
-/*- 8 Regs -------------------------------------------------------------------*/
-
-gran_block_8
-{
-    Sp_adj(-8);
-    Sp(7) = R8;
-    Sp(6) = R7;
-    Sp(5) = R6;
-    Sp(4) = R5;
-    Sp(3) = R4;
-    Sp(2) = R3;
-    Sp(1) = R2;
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadBlocked;
-    jump StgReturn;
-}
-
-#endif
-
-#if 0 && defined(PAR)
-
-/*
-  Similar to stg_block_1 (called via StgMacro BLOCK_NP) but separates the
-  saving of the thread state from the actual jump via an StgReturn.
-  We need this separation because we call RTS routines in blocking entry codes
-  before jumping back into the RTS (see parallel/FetchMe.hc).
-*/
-
-par_block_1_no_jump
-{
-    Sp_adj(-1);
-    Sp(0) = R1;
-    SAVE_THREAD_STATE();					
-}
-
-par_jump
-{
-    TSO_what_next(CurrentTSO) = ThreadRunGHC;		
-    R1 = ThreadBlocked;
-    jump StgReturn;
-}
-
-#endif
-
-/* -----------------------------------------------------------------------------
-   Heap checks in Primitive case alternatives
-
-   A primitive case alternative is entered with a value either in 
-   R1, FloatReg1 or D1 depending on the return convention.  All the
-   cases are covered below.
-   -------------------------------------------------------------------------- */
-
-/*-- No Registers live ------------------------------------------------------ */
-
-stg_gc_noregs
-{
-    GC_GENERIC
-}
-
-/*-- void return ------------------------------------------------------------ */
-
-INFO_TABLE_RET( stg_gc_void, 0/*framesize*/, 0/*bitmap*/, RET_SMALL)
-{
-    Sp_adj(1);
-    jump %ENTRY_CODE(Sp(0));
-}
-
-/*-- R1 is boxed/unpointed -------------------------------------------------- */
-
-INFO_TABLE_RET( stg_gc_unpt_r1, 1/*framesize*/, 0/*bitmap*/, RET_SMALL)
-{
-    R1 = Sp(1);
-    Sp_adj(2);
-    jump %ENTRY_CODE(Sp(0));
-}
-
-stg_gc_unpt_r1
-{
-    Sp_adj(-2);
-    Sp(1) = R1;
-    Sp(0) = stg_gc_unpt_r1_info;
-    GC_GENERIC
-}
-
-/*-- R1 is unboxed -------------------------------------------------- */
-
-/* the 1 is a bitmap - i.e. 1 non-pointer word on the stack. */
-INFO_TABLE_RET(	stg_gc_unbx_r1, 1/*framesize*/, 1/*bitmap*/, RET_SMALL )
-{
-    R1 = Sp(1);
-    Sp_adj(2);
-    jump %ENTRY_CODE(Sp(0));
-}
-
-stg_gc_unbx_r1
-{
-    Sp_adj(-2);
-    Sp(1) = R1;
-    Sp(0) = stg_gc_unbx_r1_info;
-    GC_GENERIC
-}
-
-/*-- F1 contains a float ------------------------------------------------- */
-
-INFO_TABLE_RET(	stg_gc_f1, 1/*framesize*/, 1/*bitmap*/, RET_SMALL )
-{
-    F1 = F_[Sp+WDS(1)];
-    Sp_adj(2);
-    jump %ENTRY_CODE(Sp(0));
-}
-
-stg_gc_f1
-{
-    Sp_adj(-2);
-    F_[Sp + WDS(1)] = F1;
-    Sp(0) = stg_gc_f1_info;
-    GC_GENERIC
-}
-
-/*-- D1 contains a double ------------------------------------------------- */
-
-/* we support doubles of either 1 or 2 words in size */
-
-#if SIZEOF_DOUBLE == SIZEOF_VOID_P
-#  define DBL_BITMAP 1
-#  define DBL_WORDS  1
-#else
-#  define DBL_BITMAP 3
-#  define DBL_WORDS  2
-#endif 
-
-INFO_TABLE_RET(	stg_gc_d1, DBL_WORDS/*framesize*/, DBL_BITMAP/*bitmap*/, RET_SMALL )
-{
-    D1 = D_[Sp + WDS(1)];
-    Sp = Sp + WDS(1) + SIZEOF_StgDouble;
-    jump %ENTRY_CODE(Sp(0));
-}
-
-stg_gc_d1
-{
-    Sp = Sp - WDS(1) - SIZEOF_StgDouble;
-    D_[Sp + WDS(1)] = D1;
-    Sp(0) = stg_gc_d1_info;
-    GC_GENERIC
-}
-
-
-/*-- L1 contains an int64 ------------------------------------------------- */
-
-/* we support int64s of either 1 or 2 words in size */
-
-#if SIZEOF_VOID_P == 8
-#  define LLI_BITMAP 1
-#  define LLI_WORDS  1
-#else
-#  define LLI_BITMAP 3
-#  define LLI_WORDS  2
-#endif 
-
-INFO_TABLE_RET( stg_gc_l1, LLI_WORDS/*framesize*/, LLI_BITMAP/*bitmap*/, RET_SMALL )
-{
-    L1 = L_[Sp + WDS(1)];
-    Sp_adj(1) + SIZEOF_StgWord64;
-    jump %ENTRY_CODE(Sp(0));
-}
-
-stg_gc_l1
-{
-    Sp_adj(-1) - SIZEOF_StgWord64;
-    L_[Sp + WDS(1)] = L1;
-    Sp(0) = stg_gc_l1_info;
-    GC_GENERIC
-}
-
-/*-- Unboxed tuple return, one pointer (unregisterised build only) ---------- */
-
-INFO_TABLE_RET( stg_ut_1_0_unreg, 1/*size*/, 0/*BITMAP*/, RET_SMALL )
-{
-    Sp_adj(1);
-    // one ptr is on the stack (Sp(0))
-    jump %ENTRY_CODE(Sp(1));
-}
-
-/* -----------------------------------------------------------------------------
-   Generic function entry heap check code.
-
-   At a function entry point, the arguments are as per the calling convention,
-   i.e. some in regs and some on the stack.  There may or may not be 
-   a pointer to the function closure in R1 - if there isn't, then the heap
-   check failure code in the function will arrange to load it.
-
-   The function's argument types are described in its info table, so we
-   can just jump to this bit of generic code to save away all the
-   registers and return to the scheduler.
-
-   This code arranges the stack like this:
-	 
-         |        ....         |
-         |        args         |
-	 +---------------------+
-         |      f_closure      |
-	 +---------------------+
-         |        size         |
-	 +---------------------+
-         |   stg_gc_fun_info   |
-	 +---------------------+
-
-   The size is the number of words of arguments on the stack, and is cached
-   in the frame in order to simplify stack walking: otherwise the size of
-   this stack frame would have to be calculated by looking at f's info table.
-
-   -------------------------------------------------------------------------- */
-
-__stg_gc_fun
-{
-    W_ size;
-    W_ info;
-    W_ type;
-
-    info = %GET_FUN_INFO(R1);
-
-    // cache the size
-    type = TO_W_(StgFunInfoExtra_fun_type(info));
-    if (type == ARG_GEN) {
-	size = BITMAP_SIZE(StgFunInfoExtra_bitmap(info));
-    } else { 
-	if (type == ARG_GEN_BIG) {
-#ifdef TABLES_NEXT_TO_CODE
-            // bitmap field holds an offset
-            size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info)
-                                        + %GET_ENTRY(R1) /* ### */ );
-#else
-	    size = StgLargeBitmap_size( StgFunInfoExtra_bitmap(info) );
-#endif
-	} else {
-	    size = BITMAP_SIZE(W_[stg_arg_bitmaps + WDS(type)]);
-	}
-    }
-    
-#ifdef NO_ARG_REGS
-    // we don't have to save any registers away
-    Sp_adj(-3);
-    Sp(2) = R1;
-    Sp(1) = size;
-    Sp(0) = stg_gc_fun_info;
-    GC_GENERIC
-#else
-    W_ type;
-    type = TO_W_(StgFunInfoExtra_fun_type(info));
-    // cache the size
-    if (type == ARG_GEN || type == ARG_GEN_BIG) {
-        // regs already saved by the heap check code
-        Sp_adj(-3);
-        Sp(2) = R1;
-        Sp(1) = size;
-        Sp(0) = stg_gc_fun_info;
-        // DEBUG_ONLY(foreign "C" debugBelch("stg_fun_gc_gen(ARG_GEN)"););
-        GC_GENERIC
-    } else { 
-	jump W_[stg_stack_save_entries + WDS(type)];
-	    // jumps to stg_gc_noregs after saving stuff
-    }
-#endif /* !NO_ARG_REGS */
-}
-
-/* -----------------------------------------------------------------------------
-   Generic Apply (return point)
-
-   The dual to stg_fun_gc_gen (above): this fragment returns to the
-   function, passing arguments in the stack and in registers
-   appropriately.  The stack layout is given above.
-   -------------------------------------------------------------------------- */
-
-INFO_TABLE_RET( stg_gc_fun, 0/*framesize*/, 0/*bitmap*/, RET_FUN )
-{
-    R1 = Sp(2);
-    Sp_adj(3);
-#ifdef NO_ARG_REGS
-    // Minor optimisation: there are no argument registers to load up,
-    // so we can just jump straight to the function's entry point.
-    jump %GET_ENTRY(R1);
-#else
-    W_ info;
-    W_ type;
-    
-    info = %GET_FUN_INFO(R1);
-    type = TO_W_(StgFunInfoExtra_fun_type(info));
-    if (type == ARG_GEN || type == ARG_GEN_BIG) {
-	jump StgFunInfoExtra_slow_apply(info);
-    } else { 
-	if (type == ARG_BCO) {
-	    // cover this case just to be on the safe side
-	    Sp_adj(-2);
-	    Sp(1) = R1;
-	    Sp(0) = stg_apply_interp_info;
-	    jump stg_yield_to_interpreter;
-	} else {
-	    jump W_[stg_ap_stack_entries + WDS(type)];
-	}
-    }
-#endif
-}
-
-/* -----------------------------------------------------------------------------
-   Generic Heap Check Code.
-
-   Called with Liveness mask in R9,  Return address in R10.
-   Stack must be consistent (containing all necessary info pointers
-   to relevant SRTs).
-
-   See StgMacros.h for a description of the RET_DYN stack frame.
-
-   We also define an stg_gen_yield here, because it's very similar.
-   -------------------------------------------------------------------------- */
-
-// For simplicity, we assume that SIZEOF_DOUBLE == 2*SIZEOF_VOID_P
-// on a 64-bit machine, we'll end up wasting a couple of words, but
-// it's not a big deal.
-
-#define RESTORE_EVERYTHING			\
-    L1   = L_[Sp + WDS(19)];			\
-    D2   = D_[Sp + WDS(17)];			\
-    D1   = D_[Sp + WDS(15)];			\
-    F4   = F_[Sp + WDS(14)];			\
-    F3   = F_[Sp + WDS(13)];			\
-    F2   = F_[Sp + WDS(12)];			\
-    F1   = F_[Sp + WDS(11)];			\
-    R8 = Sp(10);				\
-    R7 = Sp(9);					\
-    R6 = Sp(8);					\
-    R5 = Sp(7);					\
-    R4 = Sp(6);					\
-    R3 = Sp(5);					\
-    R2 = Sp(4);					\
-    R1 = Sp(3);					\
-    Sp_adj(21);
-
-#define RET_OFFSET (-19)
-
-#define SAVE_EVERYTHING				\
-    Sp_adj(-21);				\
-    L_[Sp + WDS(19)] = L1;			\
-    D_[Sp + WDS(17)] = D2;			\
-    D_[Sp + WDS(15)] = D1;			\
-    F_[Sp + WDS(14)] = F4;			\
-    F_[Sp + WDS(13)] = F3;			\
-    F_[Sp + WDS(12)] = F2;			\
-    F_[Sp + WDS(11)] = F1;			\
-    Sp(10) = R8;				\
-    Sp(9) = R7;					\
-    Sp(8) = R6;					\
-    Sp(7) = R5;					\
-    Sp(6) = R4;					\
-    Sp(5) = R3;					\
-    Sp(4) = R2;					\
-    Sp(3) = R1;					\
-    Sp(2) = R10;    /* return address */	\
-    Sp(1) = R9;     /* liveness mask  */	\
-    Sp(0) = stg_gc_gen_info;
-
-INFO_TABLE_RET( stg_gc_gen, 0/*framesize*/, 0/*bitmap*/, RET_DYN )
-/* bitmap in the above info table is unused, the real one is on the stack. */
-{
-    RESTORE_EVERYTHING;
-    jump Sp(RET_OFFSET); /* No %ENTRY_CODE( - this is an actual code ptr */
-}
-
-stg_gc_gen
-{
-    SAVE_EVERYTHING;
-    GC_GENERIC
-}	  
-
-// A heap check at an unboxed tuple return point.  The return address
-// is on the stack, and we can find it by using the offsets given
-// to us in the liveness mask.
-stg_gc_ut
-{
-    R10 = %ENTRY_CODE(Sp(RET_DYN_NONPTRS(R9) + RET_DYN_PTRS(R9)));
-    SAVE_EVERYTHING;
-    GC_GENERIC
-}
-
-/*
- * stg_gen_hp is used by MAYBE_GC, where we can't use GC_GENERIC
- * because we've just failed doYouWantToGC(), not a standard heap
- * check.  GC_GENERIC would end up returning StackOverflow.
- */
-stg_gc_gen_hp
-{
-    SAVE_EVERYTHING;
-    HP_GENERIC
-}	  
-
-/* -----------------------------------------------------------------------------
-   Yields
-   -------------------------------------------------------------------------- */
-
-stg_gen_yield
-{
-    SAVE_EVERYTHING;
-    YIELD_GENERIC
-}
-
-stg_yield_noregs
-{
-    YIELD_GENERIC;
-}
-
-/* -----------------------------------------------------------------------------
-   Yielding to the interpreter... top of stack says what to do next.
-   -------------------------------------------------------------------------- */
-
-stg_yield_to_interpreter
-{
-    YIELD_TO_INTERPRETER;
-}
-
-/* -----------------------------------------------------------------------------
-   Blocks
-   -------------------------------------------------------------------------- */
-
-stg_gen_block
-{
-    SAVE_EVERYTHING;
-    BLOCK_GENERIC;
-}
-
-stg_block_noregs
-{
-    BLOCK_GENERIC;
-}
-
-stg_block_1
-{
-    Sp_adj(-2);
-    Sp(1) = R1;
-    Sp(0) = stg_enter_info;
-    BLOCK_GENERIC;
-}
-
-/* -----------------------------------------------------------------------------
- * takeMVar/putMVar-specific blocks
- *
- * Stack layout for a thread blocked in takeMVar:
- *      
- *       ret. addr
- *       ptr to MVar   (R1)
- *       stg_block_takemvar_info
- *
- * Stack layout for a thread blocked in putMVar:
- *      
- *       ret. addr
- *       ptr to Value  (R2)
- *       ptr to MVar   (R1)
- *       stg_block_putmvar_info
- *
- * See PrimOps.hc for a description of the workings of take/putMVar.
- * 
- * -------------------------------------------------------------------------- */
-
-INFO_TABLE_RET( stg_block_takemvar, 1/*framesize*/, 0/*bitmap*/, RET_SMALL )
-{
-    R1 = Sp(1);
-    Sp_adj(2);
-    jump takeMVarzh_fast;
-}
-
-// code fragment executed just before we return to the scheduler
-stg_block_takemvar_finally
-{
-#ifdef THREADED_RTS
-    foreign "C" unlockClosure(R3 "ptr", stg_EMPTY_MVAR_info);
-#endif
-    jump StgReturn;
-}
-
-stg_block_takemvar
-{
-    Sp_adj(-2);
-    Sp(1) = R1;
-    Sp(0) = stg_block_takemvar_info;
-    R3 = R1;
-    BLOCK_BUT_FIRST(stg_block_takemvar_finally);
-}
-
-INFO_TABLE_RET( stg_block_putmvar, 2/*framesize*/, 0/*bitmap*/, RET_SMALL )
-{
-    R2 = Sp(2);
-    R1 = Sp(1);
-    Sp_adj(3);
-    jump putMVarzh_fast;
-}
-
-// code fragment executed just before we return to the scheduler
-stg_block_putmvar_finally
-{
-#ifdef THREADED_RTS
-    foreign "C" unlockClosure(R3 "ptr", stg_FULL_MVAR_info);
-#endif
-    jump StgReturn;
-}
-
-stg_block_putmvar
-{
-    Sp_adj(-3);
-    Sp(2) = R2;
-    Sp(1) = R1;
-    Sp(0) = stg_block_putmvar_info;
-    R3 = R1;
-    BLOCK_BUT_FIRST(stg_block_putmvar_finally);
-}
-
-// code fragment executed just before we return to the scheduler
-stg_block_blackhole_finally
-{
-#if defined(THREADED_RTS)
-    // The last thing we do is release sched_lock, which is
-    // preventing other threads from accessing blackhole_queue and
-    // picking up this thread before we are finished with it.
-    foreign "C" RELEASE_LOCK(sched_mutex "ptr");
-#endif
-    jump StgReturn;
-}
-
-stg_block_blackhole
-{
-    Sp_adj(-2);
-    Sp(1) = R1;
-    Sp(0) = stg_enter_info;
-    BLOCK_BUT_FIRST(stg_block_blackhole_finally);
-}
-
-#ifdef mingw32_HOST_OS
-INFO_TABLE_RET( stg_block_async, 0/*framesize*/, 0/*bitmap*/, RET_SMALL )
-{
-    W_ ares;
-    W_ len, errC;
-
-    ares = StgTSO_block_info(CurrentTSO);
-    len = StgAsyncIOResult_len(ares);
-    errC = StgAsyncIOResult_errCode(ares);
-    StgTSO_block_info(CurrentTSO) = NULL;
-    foreign "C" free(ares "ptr");
-    R1 = len;
-    Sp(0) = errC;
-    jump %ENTRY_CODE(Sp(1));
-}
-
-stg_block_async
-{
-    Sp_adj(-1);
-    Sp(0) = stg_block_async_info;
-    BLOCK_GENERIC;
-}
-
-/* Used by threadDelay implementation; it would be desirable to get rid of
- * this free()'ing void return continuation.
- */
-INFO_TABLE_RET( stg_block_async_void, 0/*framesize*/, 0/*bitmap*/, RET_SMALL )
-{
-    W_ ares;
-
-    ares = StgTSO_block_info(CurrentTSO);
-    StgTSO_block_info(CurrentTSO) = NULL;
-    foreign "C" free(ares "ptr");
-    Sp_adj(1);
-    jump %ENTRY_CODE(Sp(0));
-}
-
-stg_block_async_void
-{
-    Sp_adj(-1);
-    Sp(0) = stg_block_async_void_info;
-    BLOCK_GENERIC;
-}
-
-#endif
-
-/* -----------------------------------------------------------------------------
-   STM-specific waiting
-   -------------------------------------------------------------------------- */
-
-stg_block_stmwait_finally
-{
-    foreign "C" stmWaitUnlock(MyCapability() "ptr", R3 "ptr");
-    jump StgReturn;
-}
-
-stg_block_stmwait
-{
-    BLOCK_BUT_FIRST(stg_block_stmwait_finally);
-}
diff --git a/ghc/rts/HsFFI.c b/ghc/rts/HsFFI.c
deleted file mode 100644
index 350bcfbdec..0000000000
--- a/ghc/rts/HsFFI.c
+++ /dev/null
@@ -1,40 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2005
- *
- * RTS entry points as mandated by the FFI addendum to the Haskell 98 report
- *
- * ---------------------------------------------------------------------------*/
-
-#include "HsFFI.h"
-#include "Rts.h"
-
-// hs_init and hs_exit are defined in RtsStartup.c
-
-void
-hs_set_argv(int argc, char *argv[])
-{
-    setProgArgv(argc,argv);
-}
-
-void
-hs_perform_gc(void)
-{
-    /* Hmmm, the FFI spec is a bit vague, but it seems to imply a major GC... */
-    performMajorGC();
-}
-
-void
-hs_free_stable_ptr(HsStablePtr sp)
-{
-    /* The cast is for clarity only, both HsStablePtr and StgStablePtr are
-       typedefs for void*. */
-    freeStablePtr((StgStablePtr)sp);
-}
-
-void
-hs_free_fun_ptr(HsFunPtr fp)
-{
-    /* I simply *love* all these similar names... */
-    freeHaskellFunctionPtr(fp);
-}
diff --git a/ghc/rts/Interpreter.c b/ghc/rts/Interpreter.c
deleted file mode 100644
index 56e9bb67ce..0000000000
--- a/ghc/rts/Interpreter.c
+++ /dev/null
@@ -1,1261 +0,0 @@
-/* -----------------------------------------------------------------------------
- * Bytecode interpreter
- *
- * Copyright (c) The GHC Team, 1994-2002.
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsAPI.h"
-#include "RtsUtils.h"
-#include "Closures.h"
-#include "TSO.h"
-#include "Schedule.h"
-#include "RtsFlags.h"
-#include "Storage.h"
-#include "LdvProfile.h"
-#include "Updates.h"
-#include "Sanity.h"
-#include "Liveness.h"
-
-#include "Bytecodes.h"
-#include "Printer.h"
-#include "Disassembler.h"
-#include "Interpreter.h"
-
-#include <string.h>     /* for memcpy */
-#ifdef HAVE_ERRNO_H
-#include <errno.h>
-#endif
-
-
-/* --------------------------------------------------------------------------
- * The bytecode interpreter
- * ------------------------------------------------------------------------*/
-
-/* Gather stats about entry, opcode, opcode-pair frequencies.  For
-   tuning the interpreter. */
-
-/* #define INTERP_STATS */
-
-
-/* Sp points to the lowest live word on the stack. */
-
-#define BCO_NEXT      instrs[bciPtr++]
-#define BCO_PTR(n)    (W_)ptrs[n]
-#define BCO_LIT(n)    literals[n]
-#define BCO_ITBL(n)   itbls[n]
-
-#define LOAD_STACK_POINTERS					\
-    Sp = cap->r.rCurrentTSO->sp;				\
-    /* We don't change this ... */				\
-    SpLim = cap->r.rCurrentTSO->stack + RESERVED_STACK_WORDS;
-
-#define SAVE_STACK_POINTERS			\
-    cap->r.rCurrentTSO->sp = Sp
-
-#define RETURN_TO_SCHEDULER(todo,retcode)	\
-   SAVE_STACK_POINTERS;				\
-   cap->r.rCurrentTSO->what_next = (todo);	\
-   threadPaused(cap,cap->r.rCurrentTSO);		\
-   cap->r.rRet = (retcode);			\
-   return cap;
-
-#define RETURN_TO_SCHEDULER_NO_PAUSE(todo,retcode)	\
-   SAVE_STACK_POINTERS;					\
-   cap->r.rCurrentTSO->what_next = (todo);		\
-   cap->r.rRet = (retcode);				\
-   return cap;
-
-
-STATIC_INLINE StgPtr
-allocate_NONUPD (int n_words)
-{
-    return allocate(stg_max(sizeofW(StgHeader)+MIN_PAYLOAD_SIZE, n_words));
-}
-
-
-#ifdef INTERP_STATS
-
-/* Hacky stats, for tuning the interpreter ... */
-int it_unknown_entries[N_CLOSURE_TYPES];
-int it_total_unknown_entries;
-int it_total_entries;
-
-int it_retto_BCO;
-int it_retto_UPDATE;
-int it_retto_other;
-
-int it_slides;
-int it_insns;
-int it_BCO_entries;
-
-int it_ofreq[27];
-int it_oofreq[27][27];
-int it_lastopc;
-
-#define INTERP_TICK(n) (n)++
-
-void interp_startup ( void )
-{
-   int i, j;
-   it_retto_BCO = it_retto_UPDATE = it_retto_other = 0;
-   it_total_entries = it_total_unknown_entries = 0;
-   for (i = 0; i < N_CLOSURE_TYPES; i++)
-      it_unknown_entries[i] = 0;
-   it_slides = it_insns = it_BCO_entries = 0;
-   for (i = 0; i < 27; i++) it_ofreq[i] = 0;
-   for (i = 0; i < 27; i++) 
-     for (j = 0; j < 27; j++)
-        it_oofreq[i][j] = 0;
-   it_lastopc = 0;
-}
-
-void interp_shutdown ( void )
-{
-   int i, j, k, o_max, i_max, j_max;
-   debugBelch("%d constrs entered -> (%d BCO, %d UPD, %d ??? )\n",
-                   it_retto_BCO + it_retto_UPDATE + it_retto_other,
-                   it_retto_BCO, it_retto_UPDATE, it_retto_other );
-   debugBelch("%d total entries, %d unknown entries \n", 
-                   it_total_entries, it_total_unknown_entries);
-   for (i = 0; i < N_CLOSURE_TYPES; i++) {
-     if (it_unknown_entries[i] == 0) continue;
-     debugBelch("   type %2d: unknown entries (%4.1f%%) == %d\n",
-	     i, 100.0 * ((double)it_unknown_entries[i]) / 
-                        ((double)it_total_unknown_entries),
-             it_unknown_entries[i]);
-   }
-   debugBelch("%d insns, %d slides, %d BCO_entries\n", 
-                   it_insns, it_slides, it_BCO_entries);
-   for (i = 0; i < 27; i++) 
-      debugBelch("opcode %2d got %d\n", i, it_ofreq[i] );
-
-   for (k = 1; k < 20; k++) {
-      o_max = 0;
-      i_max = j_max = 0;
-      for (i = 0; i < 27; i++) {
-         for (j = 0; j < 27; j++) {
-	    if (it_oofreq[i][j] > o_max) {
-               o_max = it_oofreq[i][j];
-	       i_max = i; j_max = j;
-	    }
-	 }
-      }
-      
-      debugBelch("%d:  count (%4.1f%%) %6d   is %d then %d\n",
-                k, ((double)o_max) * 100.0 / ((double)it_insns), o_max,
-                   i_max, j_max );
-      it_oofreq[i_max][j_max] = 0;
-
-   }
-}
-
-#else // !INTERP_STATS
-
-#define INTERP_TICK(n) /* nothing */
-
-#endif
-
-static StgWord app_ptrs_itbl[] = {
-    (W_)&stg_ap_p_info,
-    (W_)&stg_ap_pp_info,
-    (W_)&stg_ap_ppp_info,
-    (W_)&stg_ap_pppp_info,
-    (W_)&stg_ap_ppppp_info,
-    (W_)&stg_ap_pppppp_info,
-};
-
-Capability *
-interpretBCO (Capability* cap)
-{
-    // Use of register here is primarily to make it clear to compilers
-    // that these entities are non-aliasable.
-    register StgPtr       Sp;    // local state -- stack pointer
-    register StgPtr       SpLim; // local state -- stack lim pointer
-    register StgClosure*  obj;
-    nat n, m;
-
-    LOAD_STACK_POINTERS;
-
-    // ------------------------------------------------------------------------
-    // Case 1:
-    // 
-    //       We have a closure to evaluate.  Stack looks like:
-    //       
-    //      	|   XXXX_info   |
-    //      	+---------------+
-    //       Sp |      -------------------> closure
-    //      	+---------------+
-    //       
-    if (Sp[0] == (W_)&stg_enter_info) {
-	Sp++;
-	goto eval;
-    }
-
-    // ------------------------------------------------------------------------
-    // Case 2:
-    // 
-    //       We have a BCO application to perform.  Stack looks like:
-    //
-    //      	|     ....      |
-    //      	+---------------+
-    //      	|     arg1      |
-    //      	+---------------+
-    //      	|     BCO       |
-    //      	+---------------+
-    //       Sp |   RET_BCO     |
-    //      	+---------------+
-    //       
-    else if (Sp[0] == (W_)&stg_apply_interp_info) {
-	obj = (StgClosure *)Sp[1];
-	Sp += 2;
-	goto run_BCO_fun;
-    }
-
-    // ------------------------------------------------------------------------
-    // Case 3:
-    //
-    //       We have an unboxed value to return.  See comment before
-    //       do_return_unboxed, below.
-    //
-    else {
-	goto do_return_unboxed;
-    }
-
-    // Evaluate the object on top of the stack.
-eval:
-    obj = (StgClosure*)Sp[0]; Sp++;
-
-eval_obj:
-    INTERP_TICK(it_total_evals);
-
-    IF_DEBUG(interpreter,
-             debugBelch(
-             "\n---------------------------------------------------------------\n");
-             debugBelch("Evaluating: "); printObj(obj);
-             debugBelch("Sp = %p\n", Sp);
-             debugBelch("\n" );
-
-             printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
-             debugBelch("\n\n");
-            );
-
-    IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
-
-    switch ( get_itbl(obj)->type ) {
-
-    case IND:
-    case IND_OLDGEN:
-    case IND_PERM:
-    case IND_OLDGEN_PERM:
-    case IND_STATIC:
-    { 
-	obj = ((StgInd*)obj)->indirectee;
-	goto eval_obj;
-    }
-    
-    case CONSTR:
-    case CONSTR_1_0:
-    case CONSTR_0_1:
-    case CONSTR_2_0:
-    case CONSTR_1_1:
-    case CONSTR_0_2:
-    case CONSTR_INTLIKE:
-    case CONSTR_CHARLIKE:
-    case CONSTR_STATIC:
-    case CONSTR_NOCAF_STATIC:
-    case FUN:
-    case FUN_1_0:
-    case FUN_0_1:
-    case FUN_2_0:
-    case FUN_1_1:
-    case FUN_0_2:
-    case FUN_STATIC:
-    case PAP:
-	// already in WHNF
-	break;
-	
-    case BCO:
-	ASSERT(((StgBCO *)obj)->arity > 0);
-	break;
-
-    case AP:	/* Copied from stg_AP_entry. */
-    {
-	nat i, words;
-	StgAP *ap;
-	
-	ap = (StgAP*)obj;
-	words = ap->n_args;
-	
-	// Stack check
-	if (Sp - (words+sizeofW(StgUpdateFrame)) < SpLim) {
-	    Sp -= 2;
-	    Sp[1] = (W_)obj;
-	    Sp[0] = (W_)&stg_enter_info;
-	    RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
-	}
-	
-	/* Ok; we're safe.  Party on.  Push an update frame. */
-	Sp -= sizeofW(StgUpdateFrame);
-	{
-	    StgUpdateFrame *__frame;
-	    __frame = (StgUpdateFrame *)Sp;
-	    SET_INFO(__frame, (StgInfoTable *)&stg_upd_frame_info);
-	    __frame->updatee = (StgClosure *)(ap);
-	}
-	
-	/* Reload the stack */
-	Sp -= words;
-	for (i=0; i < words; i++) {
-	    Sp[i] = (W_)ap->payload[i];
-	}
-
-	obj = (StgClosure*)ap->fun;
-	ASSERT(get_itbl(obj)->type == BCO);
-	goto run_BCO_fun;
-    }
-
-    default:
-#ifdef INTERP_STATS
-    { 
-	int j;
-	
-	j = get_itbl(obj)->type;
-	ASSERT(j >= 0 && j < N_CLOSURE_TYPES);
-	it_unknown_entries[j]++;
-	it_total_unknown_entries++;
-    }
-#endif
-    {
-	// Can't handle this object; yield to scheduler
-	IF_DEBUG(interpreter,
-		 debugBelch("evaluating unknown closure -- yielding to sched\n"); 
-		 printObj(obj);
-	    );
-	Sp -= 2;
-	Sp[1] = (W_)obj;
-	Sp[0] = (W_)&stg_enter_info;
-	RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
-    }
-    }
-
-    // ------------------------------------------------------------------------
-    // We now have an evaluated object (obj).  The next thing to
-    // do is return it to the stack frame on top of the stack.
-do_return:
-    ASSERT(closure_HNF(obj));
-
-    IF_DEBUG(interpreter,
-             debugBelch(
-             "\n---------------------------------------------------------------\n");
-             debugBelch("Returning: "); printObj(obj);
-             debugBelch("Sp = %p\n", Sp);
-             debugBelch("\n" );
-             printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
-             debugBelch("\n\n");
-            );
-
-    IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size));
-
-    switch (get_itbl((StgClosure *)Sp)->type) {
-
-    case RET_SMALL: {
-	const StgInfoTable *info;
-
-	// NOTE: not using get_itbl().
-	info = ((StgClosure *)Sp)->header.info;
-	if (info == (StgInfoTable *)&stg_ap_v_info) {
-	    n = 1; m = 0; goto do_apply;
-	}
-	if (info == (StgInfoTable *)&stg_ap_f_info) {
-	    n = 1; m = 1; goto do_apply;
-	}
-	if (info == (StgInfoTable *)&stg_ap_d_info) {
-	    n = 1; m = sizeofW(StgDouble); goto do_apply;
-	}
-	if (info == (StgInfoTable *)&stg_ap_l_info) {
-	    n = 1; m = sizeofW(StgInt64); goto do_apply;
-	}
-	if (info == (StgInfoTable *)&stg_ap_n_info) {
-	    n = 1; m = 1; goto do_apply;
-	}
-	if (info == (StgInfoTable *)&stg_ap_p_info) {
-	    n = 1; m = 1; goto do_apply;
-	}
-	if (info == (StgInfoTable *)&stg_ap_pp_info) {
-	    n = 2; m = 2; goto do_apply;
-	}
-	if (info == (StgInfoTable *)&stg_ap_ppp_info) {
-	    n = 3; m = 3; goto do_apply;
-	}
-	if (info == (StgInfoTable *)&stg_ap_pppp_info) {
-	    n = 4; m = 4; goto do_apply;
-	}
-	if (info == (StgInfoTable *)&stg_ap_ppppp_info) {
-	    n = 5; m = 5; goto do_apply;
-	}
-	if (info == (StgInfoTable *)&stg_ap_pppppp_info) {
-	    n = 6; m = 6; goto do_apply;
-	}
-	goto do_return_unrecognised;
-    }
-
-    case UPDATE_FRAME:
-	// Returning to an update frame: do the update, pop the update
-	// frame, and continue with the next stack frame.
-	INTERP_TICK(it_retto_UPDATE);
-	UPD_IND(((StgUpdateFrame *)Sp)->updatee, obj); 
-	Sp += sizeofW(StgUpdateFrame);
-	goto do_return;
-
-    case RET_BCO:
-	// Returning to an interpreted continuation: put the object on
-	// the stack, and start executing the BCO.
-	INTERP_TICK(it_retto_BCO);
-	Sp--;
-	Sp[0] = (W_)obj;
-	obj = (StgClosure*)Sp[2];
-	ASSERT(get_itbl(obj)->type == BCO);
-	goto run_BCO_return;
-
-    default:
-    do_return_unrecognised:
-    {
-	// Can't handle this return address; yield to scheduler
-	INTERP_TICK(it_retto_other);
-	IF_DEBUG(interpreter,
-		 debugBelch("returning to unknown frame -- yielding to sched\n"); 
-		 printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
-	    );
-	Sp -= 2;
-	Sp[1] = (W_)obj;
-	Sp[0] = (W_)&stg_enter_info;
-	RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
-    }
-    }
-
-    // -------------------------------------------------------------------------
-    // Returning an unboxed value.  The stack looks like this:
-    //
-    // 	  |     ....      |
-    // 	  +---------------+
-    // 	  |     fv2       |
-    // 	  +---------------+
-    // 	  |     fv1       |
-    // 	  +---------------+
-    // 	  |     BCO       |
-    // 	  +---------------+
-    // 	  | stg_ctoi_ret_ |
-    // 	  +---------------+
-    // 	  |    retval     |
-    // 	  +---------------+
-    // 	  |   XXXX_info   |
-    // 	  +---------------+
-    //
-    // where XXXX_info is one of the stg_gc_unbx_r1_info family.
-    //
-    // We're only interested in the case when the real return address
-    // is a BCO; otherwise we'll return to the scheduler.
-
-do_return_unboxed:
-    { 
-	int offset;
-	
-	ASSERT( Sp[0] == (W_)&stg_gc_unbx_r1_info
-		|| Sp[0] == (W_)&stg_gc_unpt_r1_info
-		|| Sp[0] == (W_)&stg_gc_f1_info
-		|| Sp[0] == (W_)&stg_gc_d1_info
-		|| Sp[0] == (W_)&stg_gc_l1_info
-		|| Sp[0] == (W_)&stg_gc_void_info // VoidRep
-	    );
-
-	// get the offset of the stg_ctoi_ret_XXX itbl
-	offset = stack_frame_sizeW((StgClosure *)Sp);
-
-	switch (get_itbl((StgClosure *)Sp+offset)->type) {
-
-	case RET_BCO:
-	    // Returning to an interpreted continuation: put the object on
-	    // the stack, and start executing the BCO.
-	    INTERP_TICK(it_retto_BCO);
-	    obj = (StgClosure*)Sp[offset+1];
-	    ASSERT(get_itbl(obj)->type == BCO);
-	    goto run_BCO_return_unboxed;
-
-	default:
-	{
-	    // Can't handle this return address; yield to scheduler
-	    INTERP_TICK(it_retto_other);
-	    IF_DEBUG(interpreter,
-		     debugBelch("returning to unknown frame -- yielding to sched\n"); 
-		     printStackChunk(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size);
-		);
-	    RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
-	}
-	}
-    }
-    // not reached.
-
-
-    // -------------------------------------------------------------------------
-    // Application...
-
-do_apply:
-    // we have a function to apply (obj), and n arguments taking up m
-    // words on the stack.  The info table (stg_ap_pp_info or whatever)
-    // is on top of the arguments on the stack.
-    {
-	switch (get_itbl(obj)->type) {
-
-	case PAP: {
-	    StgPAP *pap;
-	    nat i, arity;
-
-	    pap = (StgPAP *)obj;
-
-	    // we only cope with PAPs whose function is a BCO
-	    if (get_itbl(pap->fun)->type != BCO) {
-		goto defer_apply_to_sched;
-	    }
-
-	    Sp++;
-	    arity = pap->arity;
-	    ASSERT(arity > 0);
-	    if (arity < n) {
-		// n must be greater than 1, and the only kinds of
-		// application we support with more than one argument
-		// are all pointers...
-		//
-		// Shuffle the args for this function down, and put
-		// the appropriate info table in the gap.
-		for (i = 0; i < arity; i++) {
-		    Sp[(int)i-1] = Sp[i];
-		    // ^^^^^ careful, i-1 might be negative, but i in unsigned
-		}
-		Sp[arity-1] = app_ptrs_itbl[n-arity-1];
-		Sp--;
-		// unpack the PAP's arguments onto the stack
-		Sp -= pap->n_args;
-		for (i = 0; i < pap->n_args; i++) {
-		    Sp[i] = (W_)pap->payload[i];
-		}
-		obj = pap->fun;
-		goto run_BCO_fun;
-	    } 
-	    else if (arity == n) {
-		Sp -= pap->n_args;
-		for (i = 0; i < pap->n_args; i++) {
-		    Sp[i] = (W_)pap->payload[i];
-		}
-		obj = pap->fun;
-		goto run_BCO_fun;
-	    } 
-	    else /* arity > n */ {
-		// build a new PAP and return it.
-		StgPAP *new_pap;
-		new_pap = (StgPAP *)allocate(PAP_sizeW(pap->n_args + m));
-		SET_HDR(new_pap,&stg_PAP_info,CCCS);
-		new_pap->arity = pap->arity - n;
-		new_pap->n_args = pap->n_args + m;
-		new_pap->fun = pap->fun;
-		for (i = 0; i < pap->n_args; i++) {
-		    new_pap->payload[i] = pap->payload[i];
-		}
-		for (i = 0; i < m; i++) {
-		    new_pap->payload[pap->n_args + i] = (StgClosure *)Sp[i];
-		}
-		obj = (StgClosure *)new_pap;
-		Sp += m;
-		goto do_return;
-	    }
-	}	    
-
-	case BCO: {
-	    nat arity, i;
-
-	    Sp++;
-	    arity = ((StgBCO *)obj)->arity;
-	    ASSERT(arity > 0);
-	    if (arity < n) {
-		// n must be greater than 1, and the only kinds of
-		// application we support with more than one argument
-		// are all pointers...
-		//
-		// Shuffle the args for this function down, and put
-		// the appropriate info table in the gap.
-		for (i = 0; i < arity; i++) {
-		    Sp[(int)i-1] = Sp[i];
-		    // ^^^^^ careful, i-1 might be negative, but i in unsigned
-		}
-		Sp[arity-1] = app_ptrs_itbl[n-arity-1];
-		Sp--;
-		goto run_BCO_fun;
-	    } 
-	    else if (arity == n) {
-		goto run_BCO_fun;
-	    }
-	    else /* arity > n */ {
-		// build a PAP and return it.
-		StgPAP *pap;
-		nat i;
-		pap = (StgPAP *)allocate(PAP_sizeW(m));
-		SET_HDR(pap, &stg_PAP_info,CCCS);
-		pap->arity = arity - n;
-		pap->fun = obj;
-		pap->n_args = m;
-		for (i = 0; i < m; i++) {
-		    pap->payload[i] = (StgClosure *)Sp[i];
-		}
-		obj = (StgClosure *)pap;
-		Sp += m;
-		goto do_return;
-	    }
-	}
-
-	// No point in us applying machine-code functions
-	default:
-	defer_apply_to_sched:
-	    Sp -= 2;
-	    Sp[1] = (W_)obj;
-	    Sp[0] = (W_)&stg_enter_info;
-	    RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding);
-    }
-
-    // ------------------------------------------------------------------------
-    // Ok, we now have a bco (obj), and its arguments are all on the
-    // stack.  We can start executing the byte codes.
-    //
-    // The stack is in one of two states.  First, if this BCO is a
-    // function:
-    //
-    // 	  |     ....      |
-    // 	  +---------------+
-    // 	  |     arg2      |
-    // 	  +---------------+
-    // 	  |     arg1      |
-    // 	  +---------------+
-    //
-    // Second, if this BCO is a continuation:
-    //
-    // 	  |     ....      |
-    // 	  +---------------+
-    // 	  |     fv2       |
-    // 	  +---------------+
-    // 	  |     fv1       |
-    // 	  +---------------+
-    // 	  |     BCO       |
-    // 	  +---------------+
-    // 	  | stg_ctoi_ret_ |
-    // 	  +---------------+
-    // 	  |    retval     |
-    // 	  +---------------+
-    // 
-    // where retval is the value being returned to this continuation.
-    // In the event of a stack check, heap check, or context switch,
-    // we need to leave the stack in a sane state so the garbage
-    // collector can find all the pointers.
-    //
-    //  (1) BCO is a function:  the BCO's bitmap describes the
-    //      pointerhood of the arguments.
-    //
-    //  (2) BCO is a continuation: BCO's bitmap describes the
-    //      pointerhood of the free variables.
-    //
-    // Sadly we have three different kinds of stack/heap/cswitch check
-    // to do:
-
-run_BCO_return:
-    // Heap check
-    if (doYouWantToGC()) {
-	Sp--; Sp[0] = (W_)&stg_enter_info;
-	RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
-    }
-    // Stack checks aren't necessary at return points, the stack use
-    // is aggregated into the enclosing function entry point.
-    goto run_BCO;
-    
-run_BCO_return_unboxed:
-    // Heap check
-    if (doYouWantToGC()) {
-	RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
-    }
-    // Stack checks aren't necessary at return points, the stack use
-    // is aggregated into the enclosing function entry point.
-    goto run_BCO;
-    
-run_BCO_fun:
-    IF_DEBUG(sanity,
-	     Sp -= 2; 
-	     Sp[1] = (W_)obj; 
-	     Sp[0] = (W_)&stg_apply_interp_info;
-	     checkStackChunk(Sp,SpLim);
-	     Sp += 2;
-	);
-
-    // Heap check
-    if (doYouWantToGC()) {
-	Sp -= 2; 
-	Sp[1] = (W_)obj; 
-	Sp[0] = (W_)&stg_apply_interp_info; // placeholder, really
-	RETURN_TO_SCHEDULER(ThreadInterpret, HeapOverflow);
-    }
-    
-    // Stack check
-    if (Sp - INTERP_STACK_CHECK_THRESH < SpLim) {
-	Sp -= 2; 
-	Sp[1] = (W_)obj; 
-	Sp[0] = (W_)&stg_apply_interp_info; // placeholder, really
-	RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
-    }
-    goto run_BCO;
-    
-    // Now, actually interpret the BCO... (no returning to the
-    // scheduler again until the stack is in an orderly state).
-run_BCO:
-    INTERP_TICK(it_BCO_entries);
-    {
-	register int       bciPtr     = 1; /* instruction pointer */
-	register StgBCO*   bco        = (StgBCO*)obj;
-	register StgWord16* instrs    = (StgWord16*)(bco->instrs->payload);
-	register StgWord*  literals   = (StgWord*)(&bco->literals->payload[0]);
-	register StgPtr*   ptrs       = (StgPtr*)(&bco->ptrs->payload[0]);
-	register StgInfoTable** itbls = (StgInfoTable**)
-	    (&bco->itbls->payload[0]);
-
-#ifdef INTERP_STATS
-	it_lastopc = 0; /* no opcode */
-#endif
-
-    nextInsn:
-	ASSERT(bciPtr <= instrs[0]);
-	IF_DEBUG(interpreter,
-		 //if (do_print_stack) {
-		 //debugBelch("\n-- BEGIN stack\n");
-		 //printStack(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
-		 //debugBelch("-- END stack\n\n");
-		 //}
-		 debugBelch("Sp = %p   pc = %d      ", Sp, bciPtr);
-		 disInstr(bco,bciPtr);
-		 if (0) { int i;
-		 debugBelch("\n");
-		 for (i = 8; i >= 0; i--) {
-		     debugBelch("%d  %p\n", i, (StgPtr)(*(Sp+i)));
-		 }
-		 debugBelch("\n");
-		 }
-		 //if (do_print_stack) checkStack(Sp,cap->r.rCurrentTSO->stack+cap->r.rCurrentTSO->stack_size,iSu);
-	    );
-
-	INTERP_TICK(it_insns);
-
-#ifdef INTERP_STATS
-	ASSERT( (int)instrs[bciPtr] >= 0 && (int)instrs[bciPtr] < 27 );
-	it_ofreq[ (int)instrs[bciPtr] ] ++;
-	it_oofreq[ it_lastopc ][ (int)instrs[bciPtr] ] ++;
-	it_lastopc = (int)instrs[bciPtr];
-#endif
-
-	switch (BCO_NEXT) {
-
-	case bci_STKCHECK: {
-	    // Explicit stack check at the beginning of a function
-	    // *only* (stack checks in case alternatives are
-	    // propagated to the enclosing function).
-	    int stk_words_reqd = BCO_NEXT + 1;
-	    if (Sp - stk_words_reqd < SpLim) {
-		Sp -= 2; 
-		Sp[1] = (W_)obj; 
-		Sp[0] = (W_)&stg_apply_interp_info;
-		RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow);
-	    } else {
-		goto nextInsn;
-	    }
-	}
-
-	case bci_PUSH_L: {
-	    int o1 = BCO_NEXT;
-	    Sp[-1] = Sp[o1];
-	    Sp--;
-	    goto nextInsn;
-	}
-
-	case bci_PUSH_LL: {
-	    int o1 = BCO_NEXT;
-	    int o2 = BCO_NEXT;
-	    Sp[-1] = Sp[o1];
-	    Sp[-2] = Sp[o2];
-	    Sp -= 2;
-	    goto nextInsn;
-	}
-
-	case bci_PUSH_LLL: {
-	    int o1 = BCO_NEXT;
-	    int o2 = BCO_NEXT;
-	    int o3 = BCO_NEXT;
-	    Sp[-1] = Sp[o1];
-	    Sp[-2] = Sp[o2];
-	    Sp[-3] = Sp[o3];
-	    Sp -= 3;
-	    goto nextInsn;
-	}
-
-	case bci_PUSH_G: {
-	    int o1 = BCO_NEXT;
-	    Sp[-1] = BCO_PTR(o1);
-	    Sp -= 1;
-	    goto nextInsn;
-	}
-
-	case bci_PUSH_ALTS: {
-	    int o_bco  = BCO_NEXT;
-	    Sp[-2] = (W_)&stg_ctoi_R1p_info;
-	    Sp[-1] = BCO_PTR(o_bco);
-	    Sp -= 2;
-	    goto nextInsn;
-	}
-
-	case bci_PUSH_ALTS_P: {
-	    int o_bco  = BCO_NEXT;
-	    Sp[-2] = (W_)&stg_ctoi_R1unpt_info;
-	    Sp[-1] = BCO_PTR(o_bco);
-	    Sp -= 2;
-	    goto nextInsn;
-	}
-
-	case bci_PUSH_ALTS_N: {
-	    int o_bco  = BCO_NEXT;
-	    Sp[-2] = (W_)&stg_ctoi_R1n_info;
-	    Sp[-1] = BCO_PTR(o_bco);
-	    Sp -= 2;
-	    goto nextInsn;
-	}
-
-	case bci_PUSH_ALTS_F: {
-	    int o_bco  = BCO_NEXT;
-	    Sp[-2] = (W_)&stg_ctoi_F1_info;
-	    Sp[-1] = BCO_PTR(o_bco);
-	    Sp -= 2;
-	    goto nextInsn;
-	}
-
-	case bci_PUSH_ALTS_D: {
-	    int o_bco  = BCO_NEXT;
-	    Sp[-2] = (W_)&stg_ctoi_D1_info;
-	    Sp[-1] = BCO_PTR(o_bco);
-	    Sp -= 2;
-	    goto nextInsn;
-	}
-
-	case bci_PUSH_ALTS_L: {
-	    int o_bco  = BCO_NEXT;
-	    Sp[-2] = (W_)&stg_ctoi_L1_info;
-	    Sp[-1] = BCO_PTR(o_bco);
-	    Sp -= 2;
-	    goto nextInsn;
-	}
-
-	case bci_PUSH_ALTS_V: {
-	    int o_bco  = BCO_NEXT;
-	    Sp[-2] = (W_)&stg_ctoi_V_info;
-	    Sp[-1] = BCO_PTR(o_bco);
-	    Sp -= 2;
-	    goto nextInsn;
-	}
-
-	case bci_PUSH_APPLY_N:
-	    Sp--; Sp[0] = (W_)&stg_ap_n_info;
-	    goto nextInsn;
-	case bci_PUSH_APPLY_V:
-	    Sp--; Sp[0] = (W_)&stg_ap_v_info;
-	    goto nextInsn;
-	case bci_PUSH_APPLY_F:
-	    Sp--; Sp[0] = (W_)&stg_ap_f_info;
-	    goto nextInsn;
-	case bci_PUSH_APPLY_D:
-	    Sp--; Sp[0] = (W_)&stg_ap_d_info;
-	    goto nextInsn;
-	case bci_PUSH_APPLY_L:
-	    Sp--; Sp[0] = (W_)&stg_ap_l_info;
-	    goto nextInsn;
-	case bci_PUSH_APPLY_P:
-	    Sp--; Sp[0] = (W_)&stg_ap_p_info;
-	    goto nextInsn;
-	case bci_PUSH_APPLY_PP:
-	    Sp--; Sp[0] = (W_)&stg_ap_pp_info;
-	    goto nextInsn;
-	case bci_PUSH_APPLY_PPP:
-	    Sp--; Sp[0] = (W_)&stg_ap_ppp_info;
-	    goto nextInsn;
-	case bci_PUSH_APPLY_PPPP:
-	    Sp--; Sp[0] = (W_)&stg_ap_pppp_info;
-	    goto nextInsn;
-	case bci_PUSH_APPLY_PPPPP:
-	    Sp--; Sp[0] = (W_)&stg_ap_ppppp_info;
-	    goto nextInsn;
-	case bci_PUSH_APPLY_PPPPPP:
-	    Sp--; Sp[0] = (W_)&stg_ap_pppppp_info;
-	    goto nextInsn;
-	    
-	case bci_PUSH_UBX: {
-	    int i;
-	    int o_lits = BCO_NEXT;
-	    int n_words = BCO_NEXT;
-	    Sp -= n_words;
-	    for (i = 0; i < n_words; i++) {
-		Sp[i] = (W_)BCO_LIT(o_lits+i);
-	    }
-	    goto nextInsn;
-	}
-
-	case bci_SLIDE: {
-	    int n  = BCO_NEXT;
-	    int by = BCO_NEXT;
-	    /* a_1, .. a_n, b_1, .. b_by, s => a_1, .. a_n, s */
-	    while(--n >= 0) {
-		Sp[n+by] = Sp[n];
-	    }
-	    Sp += by;
-	    INTERP_TICK(it_slides);
-	    goto nextInsn;
-	}
-
-	case bci_ALLOC_AP: {
-	    StgAP* ap; 
-	    int n_payload = BCO_NEXT;
-	    ap = (StgAP*)allocate(AP_sizeW(n_payload));
-	    Sp[-1] = (W_)ap;
-	    ap->n_args = n_payload;
-	    SET_HDR(ap, &stg_AP_info, CCS_SYSTEM/*ToDo*/)
-	    Sp --;
-	    goto nextInsn;
-	}
-
-	case bci_ALLOC_PAP: {
-	    StgPAP* pap; 
-	    int arity = BCO_NEXT;
-	    int n_payload = BCO_NEXT;
-	    pap = (StgPAP*)allocate(PAP_sizeW(n_payload));
-	    Sp[-1] = (W_)pap;
-	    pap->n_args = n_payload;
-	    pap->arity = arity;
-	    SET_HDR(pap, &stg_PAP_info, CCS_SYSTEM/*ToDo*/)
-	    Sp --;
-	    goto nextInsn;
-	}
-
-	case bci_MKAP: {
-	    int i;
-	    int stkoff = BCO_NEXT;
-	    int n_payload = BCO_NEXT;
-	    StgAP* ap = (StgAP*)Sp[stkoff];
-	    ASSERT((int)ap->n_args == n_payload);
-	    ap->fun = (StgClosure*)Sp[0];
-	    
-	    // The function should be a BCO, and its bitmap should
-	    // cover the payload of the AP correctly.
-	    ASSERT(get_itbl(ap->fun)->type == BCO
-		   && BCO_BITMAP_SIZE(ap->fun) == ap->n_args);
-	    
-	    for (i = 0; i < n_payload; i++)
-		ap->payload[i] = (StgClosure*)Sp[i+1];
-	    Sp += n_payload+1;
-	    IF_DEBUG(interpreter,
-		     debugBelch("\tBuilt "); 
-		     printObj((StgClosure*)ap);
-		);
-	    goto nextInsn;
-	}
-
-	case bci_MKPAP: {
-	    int i;
-	    int stkoff = BCO_NEXT;
-	    int n_payload = BCO_NEXT;
-	    StgPAP* pap = (StgPAP*)Sp[stkoff];
-	    ASSERT((int)pap->n_args == n_payload);
-	    pap->fun = (StgClosure*)Sp[0];
-	    
-	    // The function should be a BCO
-	    ASSERT(get_itbl(pap->fun)->type == BCO);
-	    
-	    for (i = 0; i < n_payload; i++)
-		pap->payload[i] = (StgClosure*)Sp[i+1];
-	    Sp += n_payload+1;
-	    IF_DEBUG(interpreter,
-		     debugBelch("\tBuilt "); 
-		     printObj((StgClosure*)pap);
-		);
-	    goto nextInsn;
-	}
-
-	case bci_UNPACK: {
-	    /* Unpack N ptr words from t.o.s constructor */
-	    int i;
-	    int n_words = BCO_NEXT;
-	    StgClosure* con = (StgClosure*)Sp[0];
-	    Sp -= n_words;
-	    for (i = 0; i < n_words; i++) {
-		Sp[i] = (W_)con->payload[i];
-	    }
-	    goto nextInsn;
-	}
-
-	case bci_PACK: {
-	    int i;
-	    int o_itbl         = BCO_NEXT;
-	    int n_words        = BCO_NEXT;
-	    StgInfoTable* itbl = INFO_PTR_TO_STRUCT(BCO_ITBL(o_itbl));
-	    int request        = CONSTR_sizeW( itbl->layout.payload.ptrs, 
-					       itbl->layout.payload.nptrs );
-	    StgClosure* con = (StgClosure*)allocate_NONUPD(request);
-	    ASSERT( itbl->layout.payload.ptrs + itbl->layout.payload.nptrs > 0);
-	    SET_HDR(con, BCO_ITBL(o_itbl), CCS_SYSTEM/*ToDo*/);
-	    for (i = 0; i < n_words; i++) {
-		con->payload[i] = (StgClosure*)Sp[i];
-	    }
-	    Sp += n_words;
-	    Sp --;
-	    Sp[0] = (W_)con;
-	    IF_DEBUG(interpreter,
-		     debugBelch("\tBuilt "); 
-		     printObj((StgClosure*)con);
-		);
-	    goto nextInsn;
-	}
-
-	case bci_TESTLT_P: {
-	    unsigned int discr  = BCO_NEXT;
-	    int failto = BCO_NEXT;
-	    StgClosure* con = (StgClosure*)Sp[0];
-	    if (GET_TAG(con) >= discr) {
-		bciPtr = failto;
-	    }
-	    goto nextInsn;
-	}
-
-	case bci_TESTEQ_P: {
-	    unsigned int discr  = BCO_NEXT;
-	    int failto = BCO_NEXT;
-	    StgClosure* con = (StgClosure*)Sp[0];
-	    if (GET_TAG(con) != discr) {
-		bciPtr = failto;
-	    }
-	    goto nextInsn;
-	}
-
-	case bci_TESTLT_I: {
-	    // There should be an Int at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
-	    int failto  = BCO_NEXT;
-	    I_ stackInt = (I_)Sp[1];
-	    if (stackInt >= (I_)BCO_LIT(discr))
-		bciPtr = failto;
-	    goto nextInsn;
-	}
-
-	case bci_TESTEQ_I: {
-	    // There should be an Int at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
-	    int failto  = BCO_NEXT;
-	    I_ stackInt = (I_)Sp[1];
-	    if (stackInt != (I_)BCO_LIT(discr)) {
-		bciPtr = failto;
-	    }
-	    goto nextInsn;
-	}
-
-	case bci_TESTLT_D: {
-	    // There should be a Double at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
-	    int failto  = BCO_NEXT;
-	    StgDouble stackDbl, discrDbl;
-	    stackDbl = PK_DBL( & Sp[1] );
-	    discrDbl = PK_DBL( & BCO_LIT(discr) );
-	    if (stackDbl >= discrDbl) {
-		bciPtr = failto;
-	    }
-	    goto nextInsn;
-	}
-
-	case bci_TESTEQ_D: {
-	    // There should be a Double at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
-	    int failto  = BCO_NEXT;
-	    StgDouble stackDbl, discrDbl;
-	    stackDbl = PK_DBL( & Sp[1] );
-	    discrDbl = PK_DBL( & BCO_LIT(discr) );
-	    if (stackDbl != discrDbl) {
-		bciPtr = failto;
-	    }
-	    goto nextInsn;
-	}
-
-	case bci_TESTLT_F: {
-	    // There should be a Float at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
-	    int failto  = BCO_NEXT;
-	    StgFloat stackFlt, discrFlt;
-	    stackFlt = PK_FLT( & Sp[1] );
-	    discrFlt = PK_FLT( & BCO_LIT(discr) );
-	    if (stackFlt >= discrFlt) {
-		bciPtr = failto;
-	    }
-	    goto nextInsn;
-	}
-
-	case bci_TESTEQ_F: {
-	    // There should be a Float at Sp[1], and an info table at Sp[0].
-	    int discr   = BCO_NEXT;
-	    int failto  = BCO_NEXT;
-	    StgFloat stackFlt, discrFlt;
-	    stackFlt = PK_FLT( & Sp[1] );
-	    discrFlt = PK_FLT( & BCO_LIT(discr) );
-	    if (stackFlt != discrFlt) {
-		bciPtr = failto;
-	    }
-	    goto nextInsn;
-	}
-
-	// Control-flow ish things
-	case bci_ENTER:
-	    // Context-switch check.  We put it here to ensure that
-	    // the interpreter has done at least *some* work before
-	    // context switching: sometimes the scheduler can invoke
-	    // the interpreter with context_switch == 1, particularly
-	    // if the -C0 flag has been given on the cmd line.
-	    if (context_switch) {
-		Sp--; Sp[0] = (W_)&stg_enter_info;
-		RETURN_TO_SCHEDULER(ThreadInterpret, ThreadYielding);
-	    }
-	    goto eval;
-
-	case bci_RETURN:
-	    obj = (StgClosure *)Sp[0];
-	    Sp++;
-	    goto do_return;
-
-	case bci_RETURN_P:
-	    Sp--;
-	    Sp[0] = (W_)&stg_gc_unpt_r1_info;
-	    goto do_return_unboxed;
-	case bci_RETURN_N:
-	    Sp--;
-	    Sp[0] = (W_)&stg_gc_unbx_r1_info;
-	    goto do_return_unboxed;
-	case bci_RETURN_F:
-	    Sp--;
-	    Sp[0] = (W_)&stg_gc_f1_info;
-	    goto do_return_unboxed;
-	case bci_RETURN_D:
-	    Sp--;
-	    Sp[0] = (W_)&stg_gc_d1_info;
-	    goto do_return_unboxed;
-	case bci_RETURN_L:
-	    Sp--;
-	    Sp[0] = (W_)&stg_gc_l1_info;
-	    goto do_return_unboxed;
-	case bci_RETURN_V:
-	    Sp--;
-	    Sp[0] = (W_)&stg_gc_void_info;
-	    goto do_return_unboxed;
-
-	case bci_SWIZZLE: {
-	    int stkoff = BCO_NEXT;
-	    signed short n = (signed short)(BCO_NEXT);
-	    Sp[stkoff] += (W_)n;
-	    goto nextInsn;
-	}
-
-	case bci_CCALL: {
-	    void *tok;
-	    int stk_offset            = BCO_NEXT;
-	    int o_itbl                = BCO_NEXT;
-	    void(*marshall_fn)(void*) = (void (*)(void*))BCO_LIT(o_itbl);
-	    int ret_dyn_size = 
-		RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE
-		+ sizeofW(StgRetDyn);
-
-#ifdef THREADED_RTS
-	    // Threaded RTS:
-	    // Arguments on the TSO stack are not good, because garbage
-	    // collection might move the TSO as soon as we call
-	    // suspendThread below.
-
-	    W_ arguments[stk_offset];
-	    
-	    memcpy(arguments, Sp, sizeof(W_) * stk_offset);
-#endif
-
-	    // Restore the Haskell thread's current value of errno
-	    errno = cap->r.rCurrentTSO->saved_errno;
-
-	    // There are a bunch of non-ptr words on the stack (the
-	    // ccall args, the ccall fun address and space for the
-	    // result), which we need to cover with an info table
-	    // since we might GC during this call.
-	    //
-	    // We know how many (non-ptr) words there are before the
-	    // next valid stack frame: it is the stk_offset arg to the
-	    // CCALL instruction.   So we build a RET_DYN stack frame
-	    // on the stack frame to describe this chunk of stack.
-	    //
-	    Sp -= ret_dyn_size;
-	    ((StgRetDyn *)Sp)->liveness = NO_PTRS | N_NONPTRS(stk_offset);
-	    ((StgRetDyn *)Sp)->info = (StgInfoTable *)&stg_gc_gen_info;
-
-	    SAVE_STACK_POINTERS;
-	    tok = suspendThread(&cap->r);
-
-#ifndef THREADED_RTS
-	    // Careful:
-	    // suspendThread might have shifted the stack
-	    // around (stack squeezing), so we have to grab the real
-	    // Sp out of the TSO to find the ccall args again.
-
-	    marshall_fn ( (void*)(cap->r.rCurrentTSO->sp + ret_dyn_size) );
-#else
-	    // Threaded RTS:
-	    // We already made a copy of the arguments above.
-
-	    marshall_fn ( arguments );
-#endif
-
-	    // And restart the thread again, popping the RET_DYN frame.
-	    cap = (Capability *)((void *)((unsigned char*)resumeThread(tok) - sizeof(StgFunTable)));
-	    LOAD_STACK_POINTERS;
-	    Sp += ret_dyn_size;
-	    
-	    // Save the Haskell thread's current value of errno
-	    cap->r.rCurrentTSO->saved_errno = errno;
-		
-#ifdef THREADED_RTS
-	    // Threaded RTS:
-	    // Copy the "arguments", which might include a return value,
-	    // back to the TSO stack. It would of course be enough to
-	    // just copy the return value, but we don't know the offset.
-	    memcpy(Sp, arguments, sizeof(W_) * stk_offset);
-#endif
-
-	    goto nextInsn;
-	}
-
-	case bci_JMP: {
-	    /* BCO_NEXT modifies bciPtr, so be conservative. */
-	    int nextpc = BCO_NEXT;
-	    bciPtr     = nextpc;
-	    goto nextInsn;
-	}
-
-	case bci_CASEFAIL:
-	    barf("interpretBCO: hit a CASEFAIL");
-	    
-	    // Errors
-	default: 
-	    barf("interpretBCO: unknown or unimplemented opcode");
-
-	} /* switch on opcode */
-    }
-    }
-
-    barf("interpretBCO: fell off end of the interpreter");
-}
diff --git a/ghc/rts/Interpreter.h b/ghc/rts/Interpreter.h
deleted file mode 100644
index d66e636084..0000000000
--- a/ghc/rts/Interpreter.h
+++ /dev/null
@@ -1,14 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2002.
- *
- * Prototypes for functions in Interpreter.c
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef INTERPRETER_H
-#define INTERPRETER_H
-
-extern Capability *interpretBCO (Capability* cap);
-
-#endif /* INTERPRETER_H */
diff --git a/ghc/rts/LdvProfile.c b/ghc/rts/LdvProfile.c
deleted file mode 100644
index 19ebe426d3..0000000000
--- a/ghc/rts/LdvProfile.c
+++ /dev/null
@@ -1,342 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2001
- * Author: Sungwoo Park
- *
- * Lag/Drag/Void profiling.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifdef PROFILING
-
-#include "Rts.h"
-#include "LdvProfile.h"
-#include "RtsFlags.h"
-#include "Profiling.h"
-#include "Stats.h"
-#include "Storage.h"
-#include "RtsUtils.h"
-#include "Schedule.h"
-
-/* --------------------------------------------------------------------------
- * Fills in the slop when a *dynamic* closure changes its type.
- * First calls LDV_recordDead() to declare the closure is dead, and then
- * fills in the slop.
- * 
- *  Invoked when:
- *    1) blackholing, UPD_BH_UPDATABLE() and UPD_BH_SINGLE_ENTRY (in
- * 	 includes/StgMacros.h), threadLazyBlackHole() and 
- * 	 threadSqueezeStack() (in GC.c).
- *    2) updating with indirection closures, updateWithIndirection() 
- * 	 and updateWithPermIndirection() (in Storage.h).
- * 
- *  LDV_recordDead_FILL_SLOP_DYNAMIC() is not called on 'inherently used' 
- *  closures such as TSO. It is not called on PAP because PAP is not updatable.
- *  ----------------------------------------------------------------------- */
-void 
-LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p )
-{
-    nat size, i;
-
-#if defined(__GNUC__) && __GNUC__ < 3 && defined(DEBUG)
-#error Please use gcc 3.0+ to compile this file with DEBUG; gcc < 3.0 miscompiles it
-#endif
-
-    if (era > 0) {
-	// very like FILL_SLOP(), except that we call LDV_recordDead().
-	size = closure_sizeW(p);
-
-	LDV_recordDead((StgClosure *)(p), size);
-
-	if (size > sizeofW(StgThunkHeader)) {
-	    for (i = 0; i < size - sizeofW(StgThunkHeader); i++) {
-		((StgThunk *)(p))->payload[i] = 0;
-	    }
-	}
-    }
-}
-
-/* --------------------------------------------------------------------------
- * This function is called eventually on every object destroyed during
- * a garbage collection, whether it is a major garbage collection or
- * not.  If c is an 'inherently used' closure, nothing happens.  If c
- * is an ordinary closure, LDV_recordDead() is called on c with its
- * proper size which excludes the profiling header portion in the
- * closure.  Returns the size of the closure, including the profiling
- * header portion, so that the caller can find the next closure.
- * ----------------------------------------------------------------------- */
-STATIC_INLINE nat
-processHeapClosureForDead( StgClosure *c )
-{
-    nat size;
-    StgInfoTable *info;
-
-    info = get_itbl(c);
-
-    if (info->type != EVACUATED) {
-	ASSERT(((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) <= era &&
-	       ((LDVW(c) & LDV_CREATE_MASK) >> LDV_SHIFT) > 0);
-	ASSERT(((LDVW(c) & LDV_STATE_MASK) == LDV_STATE_CREATE) ||
-	       (
-		   (LDVW(c) & LDV_LAST_MASK) <= era &&
-		   (LDVW(c) & LDV_LAST_MASK) > 0
-		   ));
-    }
-
-    if (info->type == EVACUATED) {
-	// The size of the evacuated closure is currently stored in
-	// the LDV field.  See SET_EVACUAEE_FOR_LDV() in
-	// includes/StgLdvProf.h.
-	return LDVW(c);
-    }
-
-    size = closure_sizeW(c);
-
-    switch (info->type) {
-	/*
-	  'inherently used' cases: do nothing.
-	*/
-    case TSO:
-    case MVAR:
-    case MUT_ARR_PTRS_CLEAN:
-    case MUT_ARR_PTRS_DIRTY:
-    case MUT_ARR_PTRS_FROZEN:
-    case MUT_ARR_PTRS_FROZEN0:
-    case ARR_WORDS:
-    case WEAK:
-    case MUT_VAR_CLEAN:
-    case MUT_VAR_DIRTY:
-    case BCO:
-    case STABLE_NAME:
-    case TVAR_WAIT_QUEUE:
-    case TVAR:
-    case TREC_HEADER:
-    case TREC_CHUNK:
-	return size;
-
-	/*
-	  ordinary cases: call LDV_recordDead().
-	*/
-    case THUNK:
-    case THUNK_1_0:
-    case THUNK_0_1:
-    case THUNK_SELECTOR:
-    case THUNK_2_0:
-    case THUNK_1_1:
-    case THUNK_0_2:
-    case AP:
-    case PAP:
-    case AP_STACK:
-    case CONSTR:
-    case CONSTR_1_0:
-    case CONSTR_0_1:
-    case CONSTR_2_0:
-    case CONSTR_1_1:
-    case CONSTR_0_2:
-    case FUN:
-    case FUN_1_0:
-    case FUN_0_1:
-    case FUN_2_0:
-    case FUN_1_1:
-    case FUN_0_2:
-    case BLACKHOLE:
-    case SE_BLACKHOLE:
-    case CAF_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case IND_PERM:
-    case IND_OLDGEN_PERM:
-	/*
-	  'Ingore' cases
-	*/
-	// Why can we ignore IND/IND_OLDGEN closures? We assume that
-	// any census is preceded by a major garbage collection, which
-	// IND/IND_OLDGEN closures cannot survive. Therefore, it is no
-	// use considering IND/IND_OLDGEN closures in the meanwhile
-	// because they will perish before the next census at any
-	// rate.
-    case IND:
-    case IND_OLDGEN:
-	// Found a dead closure: record its size
-	LDV_recordDead(c, size);
-	return size;
-
-	/*
-	  Error case
-	*/
-	// static objects
-    case IND_STATIC:
-    case CONSTR_STATIC:
-    case FUN_STATIC:
-    case THUNK_STATIC:
-    case CONSTR_INTLIKE:
-    case CONSTR_CHARLIKE:
-    case CONSTR_NOCAF_STATIC:
-	// stack objects
-    case UPDATE_FRAME:
-    case CATCH_FRAME:
-    case STOP_FRAME:
-    case RET_DYN:
-    case RET_BCO:
-    case RET_SMALL:
-    case RET_VEC_SMALL:
-    case RET_BIG:
-    case RET_VEC_BIG:
-	// others
-    case BLOCKED_FETCH:
-    case FETCH_ME:
-    case FETCH_ME_BQ:
-    case RBH:
-    case REMOTE_REF:
-    case INVALID_OBJECT:
-    default:
-	barf("Invalid object in processHeapClosureForDead(): %d", info->type);
-	return 0;
-    }
-}
-
-/* --------------------------------------------------------------------------
- * Calls processHeapClosureForDead() on every *dead* closures in the
- * heap blocks starting at bd.
- * ----------------------------------------------------------------------- */
-static void
-processHeapForDead( bdescr *bd )
-{
-    StgPtr p;
-
-    while (bd != NULL) {
-	p = bd->start;
-	while (p < bd->free) {
-	    p += processHeapClosureForDead((StgClosure *)p);
-	    while (p < bd->free && !*p)   // skip slop
-		p++;
-	}
-	ASSERT(p == bd->free);
-	bd = bd->link;
-    }
-}
-
-/* --------------------------------------------------------------------------
- * Calls processHeapClosureForDead() on every *dead* closures in the nursery.
- * ----------------------------------------------------------------------- */
-static void
-processNurseryForDead( void )
-{
-    StgPtr p, bdLimit;
-    bdescr *bd;
-
-    bd = MainCapability.r.rNursery->blocks;
-    while (bd->start < bd->free) {
-	p = bd->start;
-	bdLimit = bd->start + BLOCK_SIZE_W;
-	while (p < bd->free && p < bdLimit) {
-	    p += processHeapClosureForDead((StgClosure *)p);
-	    while (p < bd->free && p < bdLimit && !*p)  // skip slop
-		p++;
-	}
-	bd = bd->link;
-	if (bd == NULL)
-	    break;
-    }
-}
-
-/* --------------------------------------------------------------------------
- * Calls processHeapClosureForDead() on every *dead* closures in the
- * small object pool.
- * ----------------------------------------------------------------------- */
-static void
-processSmallObjectPoolForDead( void )
-{
-    bdescr *bd;
-    StgPtr p;
-
-    bd = small_alloc_list;
-
-    // first block
-    if (bd == NULL)
-	return;
-
-    p = bd->start;
-    while (p < alloc_Hp) {
-	p += processHeapClosureForDead((StgClosure *)p);
-	while (p < alloc_Hp && !*p)     // skip slop
-	    p++;
-    }
-    ASSERT(p == alloc_Hp);
-
-    bd = bd->link;
-    while (bd != NULL) {
-	p = bd->start;
-	while (p < bd->free) {
-	    p += processHeapClosureForDead((StgClosure *)p);
-	    while (p < bd->free && !*p)    // skip slop
-		p++;
-	}
-	ASSERT(p == bd->free);
-	bd = bd->link;
-    }
-}
-
-/* --------------------------------------------------------------------------
- * Calls processHeapClosureForDead() on every *dead* closures in the closure
- * chain.
- * ----------------------------------------------------------------------- */
-static void
-processChainForDead( bdescr *bd )
-{
-    // Any object still in the chain is dead!
-    while (bd != NULL) {
-	processHeapClosureForDead((StgClosure *)bd->start);
-	bd = bd->link;
-    }
-}
-
-/* --------------------------------------------------------------------------
- * Start a census for *dead* closures, and calls
- * processHeapClosureForDead() on every closure which died in the
- * current garbage collection.  This function is called from a garbage
- * collector right before tidying up, when all dead closures are still
- * stored in the heap and easy to identify.  Generations 0 through N
- * have just beed garbage collected.
- * ----------------------------------------------------------------------- */
-void
-LdvCensusForDead( nat N )
-{
-    nat g, s;
-
-    // ldvTime == 0 means that LDV profiling is currently turned off.
-    if (era == 0)
-	return;
-
-    if (RtsFlags.GcFlags.generations == 1) {
-	//
-	// Todo: support LDV for two-space garbage collection.
-	//
-	barf("Lag/Drag/Void profiling not supported with -G1");
-    } else {
-	for (g = 0; g <= N; g++)
-	    for (s = 0; s < generations[g].n_steps; s++) {
-		if (g == 0 && s == 0) {
-		    processSmallObjectPoolForDead();
-		    processNurseryForDead();
-		    processChainForDead(generations[g].steps[s].large_objects);
-		} else{
-		    processHeapForDead(generations[g].steps[s].old_blocks);
-		    processChainForDead(generations[g].steps[s].large_objects);
-		}
-	    }
-    }
-}
-
-/* --------------------------------------------------------------------------
- * Regard any closure in the current heap as dead or moribund and update
- * LDV statistics accordingly.
- * Called from shutdownHaskell() in RtsStartup.c.
- * Also, stops LDV profiling by resetting ldvTime to 0.
- * ----------------------------------------------------------------------- */
-void
-LdvCensusKillAll( void )
-{
-    LdvCensusForDead(RtsFlags.GcFlags.generations - 1);
-}
-
-#endif /* PROFILING */
diff --git a/ghc/rts/LdvProfile.h b/ghc/rts/LdvProfile.h
deleted file mode 100644
index d85b95cd6a..0000000000
--- a/ghc/rts/LdvProfile.h
+++ /dev/null
@@ -1,42 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2001
- * Author: Sungwoo Park
- *
- * Lag/Drag/Void profiling.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef LDVPROFILE_H
-#define LDVPROFILE_H
-
-#ifdef PROFILING
-
-#include "ProfHeap.h"
-
-extern void LDV_recordDead_FILL_SLOP_DYNAMIC( StgClosure *p );
-extern void LdvCensusForDead ( nat );
-extern void LdvCensusKillAll ( void );
-
-// Creates a 0-filled slop of size 'howManyBackwards' backwards from the
-// address 'from'. 
-//
-// Invoked when: 
-//   1) Hp is incremented and exceeds HpLim (in Updates.hc).
-//   2) copypart() is called (in GC.c).
-#define LDV_FILL_SLOP(from, howManyBackwards)	\
-  if (era > 0) {				\
-    int i;					\
-    for (i = 0;i < (howManyBackwards); i++)	\
-      ((StgWord *)(from))[-i] = 0;		\
-  }
-
-// Informs the LDV profiler that closure c has just been evacuated.
-// Evacuated objects are no longer needed, so we just store its original size in
-// the LDV field.
-#define SET_EVACUAEE_FOR_LDV(c, size)   \
-    LDVW((c)) = (size)
-
-#endif /* PROFILING */
-
-#endif /* LDVPROFILE_H */
diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c
deleted file mode 100644
index 92d0106def..0000000000
--- a/ghc/rts/Linker.c
+++ /dev/null
@@ -1,4315 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2000-2004
- *
- * RTS Object Linker
- *
- * ---------------------------------------------------------------------------*/
-
-#if 0
-#include "PosixSource.h"
-#endif
-
-/* Linux needs _GNU_SOURCE to get RTLD_DEFAULT from <dlfcn.h> and 
-   MREMAP_MAYMOVE from <sys/mman.h>.
- */
-#ifdef __linux__
-#define _GNU_SOURCE
-#endif
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "HsFFI.h"
-#include "Hash.h"
-#include "Linker.h"
-#include "LinkerInternals.h"
-#include "RtsUtils.h"
-#include "Schedule.h"
-#include "Storage.h"
-#include "Sparks.h"
-
-#ifdef HAVE_SYS_TYPES_H
-#include <sys/types.h>
-#endif
-
-#include <stdlib.h>
-#include <string.h>
-
-#ifdef HAVE_SYS_STAT_H
-#include <sys/stat.h>
-#endif
-
-#if defined(HAVE_DLFCN_H)
-#include <dlfcn.h>
-#endif
-
-#if defined(cygwin32_HOST_OS)
-#ifdef HAVE_DIRENT_H
-#include <dirent.h>
-#endif
-
-#ifdef HAVE_SYS_TIME_H
-#include <sys/time.h>
-#endif
-#include <regex.h>
-#include <sys/fcntl.h>
-#include <sys/termios.h>
-#include <sys/utime.h>
-#include <sys/utsname.h>
-#include <sys/wait.h>
-#endif
-
-#if defined(ia64_HOST_ARCH) || defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
-#define USE_MMAP
-#include <fcntl.h>
-#include <sys/mman.h>
-
-#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS)
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-#endif
-
-#endif
-
-#if defined(linux_HOST_OS) || defined(solaris2_HOST_OS) || defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS) || defined(openbsd_HOST_OS)
-#  define OBJFORMAT_ELF
-#elif defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
-#  define OBJFORMAT_PEi386
-#  include <windows.h>
-#  include <math.h>
-#elif defined(darwin_HOST_OS)
-#  define OBJFORMAT_MACHO
-#  include <mach-o/loader.h>
-#  include <mach-o/nlist.h>
-#  include <mach-o/reloc.h>
-#  include <mach-o/dyld.h>
-#if defined(powerpc_HOST_ARCH)
-#  include <mach-o/ppc/reloc.h>
-#endif
-#endif
-
-/* Hash table mapping symbol names to Symbol */
-static /*Str*/HashTable *symhash;
-
-/* List of currently loaded objects */
-ObjectCode *objects = NULL;	/* initially empty */
-
-#if defined(OBJFORMAT_ELF)
-static int ocVerifyImage_ELF    ( ObjectCode* oc );
-static int ocGetNames_ELF       ( ObjectCode* oc );
-static int ocResolve_ELF        ( ObjectCode* oc );
-#if defined(powerpc_HOST_ARCH)
-static int ocAllocateJumpIslands_ELF ( ObjectCode* oc );
-#endif
-#elif defined(OBJFORMAT_PEi386)
-static int ocVerifyImage_PEi386 ( ObjectCode* oc );
-static int ocGetNames_PEi386    ( ObjectCode* oc );
-static int ocResolve_PEi386     ( ObjectCode* oc );
-#elif defined(OBJFORMAT_MACHO)
-static int ocVerifyImage_MachO    ( ObjectCode* oc );
-static int ocGetNames_MachO       ( ObjectCode* oc );
-static int ocResolve_MachO        ( ObjectCode* oc );
-
-static int machoGetMisalignment( FILE * );
-#ifdef powerpc_HOST_ARCH
-static int ocAllocateJumpIslands_MachO ( ObjectCode* oc );
-static void machoInitSymbolsWithoutUnderscore( void );
-#endif
-#endif
-
-#if defined(x86_64_HOST_ARCH)
-static void*x86_64_high_symbol( char *lbl, void *addr );
-#endif
-
-/* -----------------------------------------------------------------------------
- * Built-in symbols from the RTS
- */
-
-typedef struct _RtsSymbolVal {
-    char   *lbl;
-    void   *addr;
-} RtsSymbolVal;
-
-
-#if !defined(PAR)
-#define Maybe_Stable_Names      SymX(mkWeakzh_fast)			\
-      				SymX(makeStableNamezh_fast)		\
-      				SymX(finalizzeWeakzh_fast)
-#else
-/* These are not available in GUM!!! -- HWL */
-#define Maybe_Stable_Names
-#endif
-
-#if !defined (mingw32_HOST_OS)
-#define RTS_POSIX_ONLY_SYMBOLS                  \
-      SymX(signal_handlers)			\
-      SymX(stg_sig_install)			\
-      Sym(nocldstop)
-#endif
-
-#if defined (cygwin32_HOST_OS)
-#define RTS_MINGW_ONLY_SYMBOLS /**/
-/* Don't have the ability to read import libs / archives, so
- * we have to stupidly list a lot of what libcygwin.a
- * exports; sigh.
- */
-#define RTS_CYGWIN_ONLY_SYMBOLS                 \
-      SymX(regfree)                             \
-      SymX(regexec)                             \
-      SymX(regerror)                            \
-      SymX(regcomp)                             \
-      SymX(__errno)                             \
-      SymX(access)                              \
-      SymX(chmod)                               \
-      SymX(chdir)                               \
-      SymX(close)                               \
-      SymX(creat)                               \
-      SymX(dup)                                 \
-      SymX(dup2)                                \
-      SymX(fstat)                               \
-      SymX(fcntl)                               \
-      SymX(getcwd)                              \
-      SymX(getenv)                              \
-      SymX(lseek)                               \
-      SymX(open)                                \
-      SymX(fpathconf)                           \
-      SymX(pathconf)                            \
-      SymX(stat)                                \
-      SymX(pow)                                 \
-      SymX(tanh)                                \
-      SymX(cosh)                                \
-      SymX(sinh)                                \
-      SymX(atan)                                \
-      SymX(acos)                                \
-      SymX(asin)                                \
-      SymX(tan)                                 \
-      SymX(cos)                                 \
-      SymX(sin)                                 \
-      SymX(exp)                                 \
-      SymX(log)                                 \
-      SymX(sqrt)                                \
-      SymX(localtime_r)                         \
-      SymX(gmtime_r)                            \
-      SymX(mktime)                              \
-      Sym(_imp___tzname)                        \
-      SymX(gettimeofday)                        \
-      SymX(timezone)                            \
-      SymX(tcgetattr)                           \
-      SymX(tcsetattr)                           \
-      SymX(memcpy)                              \
-      SymX(memmove)                             \
-      SymX(realloc)                             \
-      SymX(malloc)                              \
-      SymX(free)                                \
-      SymX(fork)                                \
-      SymX(lstat)                               \
-      SymX(isatty)                              \
-      SymX(mkdir)                               \
-      SymX(opendir)                             \
-      SymX(readdir)                             \
-      SymX(rewinddir)                           \
-      SymX(closedir)                            \
-      SymX(link)                                \
-      SymX(mkfifo)                              \
-      SymX(pipe)                                \
-      SymX(read)                                \
-      SymX(rename)                              \
-      SymX(rmdir)                               \
-      SymX(select)                              \
-      SymX(system)                              \
-      SymX(write)                               \
-      SymX(strcmp)                              \
-      SymX(strcpy)                              \
-      SymX(strncpy)                             \
-      SymX(strerror)                            \
-      SymX(sigaddset)                           \
-      SymX(sigemptyset)                         \
-      SymX(sigprocmask)                         \
-      SymX(umask)                               \
-      SymX(uname)                               \
-      SymX(unlink)                              \
-      SymX(utime)                               \
-      SymX(waitpid)
-
-#elif !defined(mingw32_HOST_OS)
-#define RTS_MINGW_ONLY_SYMBOLS /**/
-#define RTS_CYGWIN_ONLY_SYMBOLS /**/
-#else /* defined(mingw32_HOST_OS) */
-#define RTS_POSIX_ONLY_SYMBOLS  /**/
-#define RTS_CYGWIN_ONLY_SYMBOLS /**/
-
-/* Extra syms gen'ed by mingw-2's gcc-3.2: */
-#if __GNUC__>=3
-#define RTS_MINGW_EXTRA_SYMS                    \
-      Sym(_imp____mb_cur_max)                   \
-      Sym(_imp___pctype)
-#else
-#define RTS_MINGW_EXTRA_SYMS
-#endif
-
-/* These are statically linked from the mingw libraries into the ghc
-   executable, so we have to employ this hack. */
-#define RTS_MINGW_ONLY_SYMBOLS                  \
-      SymX(asyncReadzh_fast)			\
-      SymX(asyncWritezh_fast)			\
-      SymX(asyncDoProczh_fast)			\
-      SymX(memset)                              \
-      SymX(inet_ntoa)                           \
-      SymX(inet_addr)                           \
-      SymX(htonl)                               \
-      SymX(recvfrom)                            \
-      SymX(listen)                              \
-      SymX(bind)                                \
-      SymX(shutdown)                            \
-      SymX(connect)                             \
-      SymX(htons)                               \
-      SymX(ntohs)                               \
-      SymX(getservbyname)                       \
-      SymX(getservbyport)                       \
-      SymX(getprotobynumber)                    \
-      SymX(getprotobyname)                      \
-      SymX(gethostbyname)                       \
-      SymX(gethostbyaddr)                       \
-      SymX(gethostname)                         \
-      SymX(strcpy)                              \
-      SymX(strncpy)                             \
-      SymX(abort)                               \
-      Sym(_alloca)                              \
-      Sym(isxdigit)                             \
-      Sym(isupper)                              \
-      Sym(ispunct)                              \
-      Sym(islower)                              \
-      Sym(isspace)                              \
-      Sym(isprint)                              \
-      Sym(isdigit)                              \
-      Sym(iscntrl)                              \
-      Sym(isalpha)                              \
-      Sym(isalnum)                              \
-      SymX(strcmp)                              \
-      SymX(memmove)                             \
-      SymX(realloc)                             \
-      SymX(malloc)                              \
-      SymX(pow)                                 \
-      SymX(tanh)                                \
-      SymX(cosh)                                \
-      SymX(sinh)                                \
-      SymX(atan)                                \
-      SymX(acos)                                \
-      SymX(asin)                                \
-      SymX(tan)                                 \
-      SymX(cos)                                 \
-      SymX(sin)                                 \
-      SymX(exp)                                 \
-      SymX(log)                                 \
-      SymX(sqrt)                                \
-      SymX(powf)                                 \
-      SymX(tanhf)                                \
-      SymX(coshf)                                \
-      SymX(sinhf)                                \
-      SymX(atanf)                                \
-      SymX(acosf)                                \
-      SymX(asinf)                                \
-      SymX(tanf)                                 \
-      SymX(cosf)                                 \
-      SymX(sinf)                                 \
-      SymX(expf)                                 \
-      SymX(logf)                                 \
-      SymX(sqrtf)                                \
-      SymX(memcpy)                              \
-      SymX(rts_InstallConsoleEvent)             \
-      SymX(rts_ConsoleHandlerDone)              \
-      Sym(mktime)                               \
-      Sym(_imp___timezone)                      \
-      Sym(_imp___tzname)                        \
-      Sym(_imp___iob)                           \
-      Sym(_imp___osver)                         \
-      Sym(localtime)                            \
-      Sym(gmtime)                               \
-      Sym(opendir)                              \
-      Sym(readdir)                              \
-      Sym(rewinddir)                            \
-      RTS_MINGW_EXTRA_SYMS                      \
-      Sym(closedir)
-#endif
-
-#if defined(darwin_TARGET_OS) && HAVE_PRINTF_LDBLSTUB
-#define RTS_DARWIN_ONLY_SYMBOLS			\
-     Sym(asprintf$LDBLStub)                     \
-     Sym(err$LDBLStub)                          \
-     Sym(errc$LDBLStub)                         \
-     Sym(errx$LDBLStub)                         \
-     Sym(fprintf$LDBLStub)                      \
-     Sym(fscanf$LDBLStub)                       \
-     Sym(fwprintf$LDBLStub)                     \
-     Sym(fwscanf$LDBLStub)                      \
-     Sym(printf$LDBLStub)                       \
-     Sym(scanf$LDBLStub)                        \
-     Sym(snprintf$LDBLStub)                     \
-     Sym(sprintf$LDBLStub)                      \
-     Sym(sscanf$LDBLStub)                       \
-     Sym(strtold$LDBLStub)                      \
-     Sym(swprintf$LDBLStub)                     \
-     Sym(swscanf$LDBLStub)                      \
-     Sym(syslog$LDBLStub)                       \
-     Sym(vasprintf$LDBLStub)                    \
-     Sym(verr$LDBLStub)                         \
-     Sym(verrc$LDBLStub)                        \
-     Sym(verrx$LDBLStub)                        \
-     Sym(vfprintf$LDBLStub)                     \
-     Sym(vfscanf$LDBLStub)                      \
-     Sym(vfwprintf$LDBLStub)                    \
-     Sym(vfwscanf$LDBLStub)                     \
-     Sym(vprintf$LDBLStub)                      \
-     Sym(vscanf$LDBLStub)                       \
-     Sym(vsnprintf$LDBLStub)                    \
-     Sym(vsprintf$LDBLStub)                     \
-     Sym(vsscanf$LDBLStub)                      \
-     Sym(vswprintf$LDBLStub)                    \
-     Sym(vswscanf$LDBLStub)                     \
-     Sym(vsyslog$LDBLStub)                      \
-     Sym(vwarn$LDBLStub)                        \
-     Sym(vwarnc$LDBLStub)                       \
-     Sym(vwarnx$LDBLStub)                       \
-     Sym(vwprintf$LDBLStub)                     \
-     Sym(vwscanf$LDBLStub)                      \
-     Sym(warn$LDBLStub)                         \
-     Sym(warnc$LDBLStub)                        \
-     Sym(warnx$LDBLStub)                        \
-     Sym(wcstold$LDBLStub)                      \
-     Sym(wprintf$LDBLStub)                      \
-     Sym(wscanf$LDBLStub)
-#else
-#define RTS_DARWIN_ONLY_SYMBOLS
-#endif
-
-#ifndef SMP
-# define MAIN_CAP_SYM SymX(MainCapability)
-#else
-# define MAIN_CAP_SYM
-#endif
-
-#if !defined(mingw32_HOST_OS)
-#define RTS_USER_SIGNALS_SYMBOLS \
-   SymX(setIOManagerPipe)
-#else
-#define RTS_USER_SIGNALS_SYMBOLS /* nothing */
-#endif
-
-#ifdef TABLES_NEXT_TO_CODE
-#define RTS_RET_SYMBOLS /* nothing */
-#else
-#define RTS_RET_SYMBOLS 			\
-      SymX(stg_enter_ret)			\
-      SymX(stg_gc_fun_ret)			\
-      SymX(stg_ap_v_ret)			\
-      SymX(stg_ap_f_ret)			\
-      SymX(stg_ap_d_ret)			\
-      SymX(stg_ap_l_ret)			\
-      SymX(stg_ap_n_ret)			\
-      SymX(stg_ap_p_ret)			\
-      SymX(stg_ap_pv_ret)			\
-      SymX(stg_ap_pp_ret)			\
-      SymX(stg_ap_ppv_ret)			\
-      SymX(stg_ap_ppp_ret)			\
-      SymX(stg_ap_pppv_ret)			\
-      SymX(stg_ap_pppp_ret)			\
-      SymX(stg_ap_ppppp_ret)			\
-      SymX(stg_ap_pppppp_ret)
-#endif
-
-#define RTS_SYMBOLS				\
-      Maybe_Stable_Names			\
-      Sym(StgReturn)				\
-      SymX(stg_enter_info)			\
-      SymX(stg_gc_void_info)			\
-      SymX(__stg_gc_enter_1)			\
-      SymX(stg_gc_noregs)			\
-      SymX(stg_gc_unpt_r1_info)			\
-      SymX(stg_gc_unpt_r1)			\
-      SymX(stg_gc_unbx_r1_info)			\
-      SymX(stg_gc_unbx_r1)			\
-      SymX(stg_gc_f1_info)			\
-      SymX(stg_gc_f1)				\
-      SymX(stg_gc_d1_info)			\
-      SymX(stg_gc_d1)				\
-      SymX(stg_gc_l1_info)			\
-      SymX(stg_gc_l1)				\
-      SymX(__stg_gc_fun)			\
-      SymX(stg_gc_fun_info)			\
-      SymX(stg_gc_gen)				\
-      SymX(stg_gc_gen_info)			\
-      SymX(stg_gc_gen_hp)			\
-      SymX(stg_gc_ut)				\
-      SymX(stg_gen_yield)			\
-      SymX(stg_yield_noregs)			\
-      SymX(stg_yield_to_interpreter)		\
-      SymX(stg_gen_block)			\
-      SymX(stg_block_noregs)			\
-      SymX(stg_block_1)				\
-      SymX(stg_block_takemvar)			\
-      SymX(stg_block_putmvar)			\
-      SymX(stg_seq_frame_info)			\
-      MAIN_CAP_SYM                              \
-      SymX(MallocFailHook)			\
-      SymX(OnExitHook)				\
-      SymX(OutOfHeapHook)			\
-      SymX(StackOverflowHook)			\
-      SymX(__encodeDouble)			\
-      SymX(__encodeFloat)			\
-      SymX(addDLL)               		\
-      SymX(__gmpn_gcd_1)			\
-      SymX(__gmpz_cmp)				\
-      SymX(__gmpz_cmp_si)			\
-      SymX(__gmpz_cmp_ui)			\
-      SymX(__gmpz_get_si)			\
-      SymX(__gmpz_get_ui)			\
-      SymX(__int_encodeDouble)			\
-      SymX(__int_encodeFloat)			\
-      SymX(andIntegerzh_fast)			\
-      SymX(atomicallyzh_fast)			\
-      SymX(barf)				\
-      SymX(debugBelch)				\
-      SymX(errorBelch)				\
-      SymX(blockAsyncExceptionszh_fast)		\
-      SymX(catchzh_fast)			\
-      SymX(catchRetryzh_fast)			\
-      SymX(catchSTMzh_fast)			\
-      SymX(closure_flags)                       \
-      SymX(cmp_thread)				\
-      SymX(cmpIntegerzh_fast)	        	\
-      SymX(cmpIntegerIntzh_fast)	      	\
-      SymX(complementIntegerzh_fast)		\
-      SymX(createAdjustor)			\
-      SymX(decodeDoublezh_fast)			\
-      SymX(decodeFloatzh_fast)			\
-      SymX(defaultsHook)			\
-      SymX(delayzh_fast)			\
-      SymX(deRefWeakzh_fast)			\
-      SymX(deRefStablePtrzh_fast)		\
-      SymX(dirty_MUT_VAR)			\
-      SymX(divExactIntegerzh_fast)		\
-      SymX(divModIntegerzh_fast)		\
-      SymX(forkzh_fast)				\
-      SymX(forkOnzh_fast)			\
-      SymX(forkProcess)				\
-      SymX(forkOS_createThread)			\
-      SymX(freeHaskellFunctionPtr)		\
-      SymX(freeStablePtr)		        \
-      SymX(gcdIntegerzh_fast)			\
-      SymX(gcdIntegerIntzh_fast)		\
-      SymX(gcdIntzh_fast)			\
-      SymX(genSymZh)				\
-      SymX(genericRaise)			\
-      SymX(getProgArgv)				\
-      SymX(getStablePtr)			\
-      SymX(hs_init)				\
-      SymX(hs_exit)				\
-      SymX(hs_set_argv)				\
-      SymX(hs_add_root)				\
-      SymX(hs_perform_gc)			\
-      SymX(hs_free_stable_ptr)			\
-      SymX(hs_free_fun_ptr)			\
-      SymX(initLinker)				\
-      SymX(int2Integerzh_fast)			\
-      SymX(integer2Intzh_fast)			\
-      SymX(integer2Wordzh_fast)			\
-      SymX(isCurrentThreadBoundzh_fast)		\
-      SymX(isDoubleDenormalized)		\
-      SymX(isDoubleInfinite)			\
-      SymX(isDoubleNaN)				\
-      SymX(isDoubleNegativeZero)		\
-      SymX(isEmptyMVarzh_fast)			\
-      SymX(isFloatDenormalized)			\
-      SymX(isFloatInfinite)			\
-      SymX(isFloatNaN)				\
-      SymX(isFloatNegativeZero)			\
-      SymX(killThreadzh_fast)			\
-      SymX(loadObj)          			\
-      SymX(lookupSymbol)     			\
-      SymX(makeStablePtrzh_fast)		\
-      SymX(minusIntegerzh_fast)			\
-      SymX(mkApUpd0zh_fast)			\
-      SymX(myThreadIdzh_fast)			\
-      SymX(labelThreadzh_fast)                  \
-      SymX(newArrayzh_fast)			\
-      SymX(newBCOzh_fast)			\
-      SymX(newByteArrayzh_fast)			\
-      SymX_redirect(newCAF, newDynCAF)		\
-      SymX(newMVarzh_fast)			\
-      SymX(newMutVarzh_fast)			\
-      SymX(newTVarzh_fast)			\
-      SymX(atomicModifyMutVarzh_fast)		\
-      SymX(newPinnedByteArrayzh_fast)		\
-      SymX(newSpark)				\
-      SymX(orIntegerzh_fast)			\
-      SymX(performGC)				\
-      SymX(performMajorGC)			\
-      SymX(plusIntegerzh_fast)			\
-      SymX(prog_argc)				\
-      SymX(prog_argv)				\
-      SymX(putMVarzh_fast)			\
-      SymX(quotIntegerzh_fast)			\
-      SymX(quotRemIntegerzh_fast)		\
-      SymX(raisezh_fast)			\
-      SymX(raiseIOzh_fast)			\
-      SymX(readTVarzh_fast)			\
-      SymX(remIntegerzh_fast)			\
-      SymX(resetNonBlockingFd)			\
-      SymX(resumeThread)			\
-      SymX(resolveObjs)                         \
-      SymX(retryzh_fast)                        \
-      SymX(rts_apply)				\
-      SymX(rts_checkSchedStatus)		\
-      SymX(rts_eval)				\
-      SymX(rts_evalIO)				\
-      SymX(rts_evalLazyIO)			\
-      SymX(rts_evalStableIO)			\
-      SymX(rts_eval_)				\
-      SymX(rts_getBool)				\
-      SymX(rts_getChar)				\
-      SymX(rts_getDouble)			\
-      SymX(rts_getFloat)			\
-      SymX(rts_getInt)				\
-      SymX(rts_getInt32)			\
-      SymX(rts_getPtr)				\
-      SymX(rts_getFunPtr)			\
-      SymX(rts_getStablePtr)			\
-      SymX(rts_getThreadId)			\
-      SymX(rts_getWord)				\
-      SymX(rts_getWord32)			\
-      SymX(rts_lock)				\
-      SymX(rts_mkBool)				\
-      SymX(rts_mkChar)				\
-      SymX(rts_mkDouble)			\
-      SymX(rts_mkFloat)				\
-      SymX(rts_mkInt)				\
-      SymX(rts_mkInt16)				\
-      SymX(rts_mkInt32)				\
-      SymX(rts_mkInt64)				\
-      SymX(rts_mkInt8)				\
-      SymX(rts_mkPtr)				\
-      SymX(rts_mkFunPtr)			\
-      SymX(rts_mkStablePtr)			\
-      SymX(rts_mkString)			\
-      SymX(rts_mkWord)				\
-      SymX(rts_mkWord16)			\
-      SymX(rts_mkWord32)			\
-      SymX(rts_mkWord64)			\
-      SymX(rts_mkWord8)				\
-      SymX(rts_unlock)				\
-      SymX(rtsSupportsBoundThreads)		\
-      SymX(__hscore_get_saved_termios)		\
-      SymX(__hscore_set_saved_termios)		\
-      SymX(setProgArgv)				\
-      SymX(startupHaskell)			\
-      SymX(shutdownHaskell)			\
-      SymX(shutdownHaskellAndExit)		\
-      SymX(stable_ptr_table)			\
-      SymX(stackOverflow)			\
-      SymX(stg_CAF_BLACKHOLE_info)		\
-      SymX(awakenBlockedQueue)			\
-      SymX(stg_CHARLIKE_closure)		\
-      SymX(stg_EMPTY_MVAR_info)			\
-      SymX(stg_IND_STATIC_info)			\
-      SymX(stg_INTLIKE_closure)			\
-      SymX(stg_MUT_ARR_PTRS_DIRTY_info)		\
-      SymX(stg_MUT_ARR_PTRS_FROZEN_info)	\
-      SymX(stg_MUT_ARR_PTRS_FROZEN0_info)	\
-      SymX(stg_WEAK_info)                       \
-      SymX(stg_ap_v_info)			\
-      SymX(stg_ap_f_info)			\
-      SymX(stg_ap_d_info)			\
-      SymX(stg_ap_l_info)			\
-      SymX(stg_ap_n_info)			\
-      SymX(stg_ap_p_info)			\
-      SymX(stg_ap_pv_info)			\
-      SymX(stg_ap_pp_info)			\
-      SymX(stg_ap_ppv_info)			\
-      SymX(stg_ap_ppp_info)			\
-      SymX(stg_ap_pppv_info)			\
-      SymX(stg_ap_pppp_info)			\
-      SymX(stg_ap_ppppp_info)			\
-      SymX(stg_ap_pppppp_info)			\
-      SymX(stg_ap_0_fast)			\
-      SymX(stg_ap_v_fast)			\
-      SymX(stg_ap_f_fast)			\
-      SymX(stg_ap_d_fast)			\
-      SymX(stg_ap_l_fast)			\
-      SymX(stg_ap_n_fast)			\
-      SymX(stg_ap_p_fast)			\
-      SymX(stg_ap_pv_fast)			\
-      SymX(stg_ap_pp_fast)			\
-      SymX(stg_ap_ppv_fast)			\
-      SymX(stg_ap_ppp_fast)			\
-      SymX(stg_ap_pppv_fast)			\
-      SymX(stg_ap_pppp_fast)			\
-      SymX(stg_ap_ppppp_fast)			\
-      SymX(stg_ap_pppppp_fast)			\
-      SymX(stg_ap_1_upd_info)			\
-      SymX(stg_ap_2_upd_info)			\
-      SymX(stg_ap_3_upd_info)			\
-      SymX(stg_ap_4_upd_info)			\
-      SymX(stg_ap_5_upd_info)			\
-      SymX(stg_ap_6_upd_info)			\
-      SymX(stg_ap_7_upd_info)			\
-      SymX(stg_exit)				\
-      SymX(stg_sel_0_upd_info)			\
-      SymX(stg_sel_10_upd_info)			\
-      SymX(stg_sel_11_upd_info)			\
-      SymX(stg_sel_12_upd_info)			\
-      SymX(stg_sel_13_upd_info)			\
-      SymX(stg_sel_14_upd_info)			\
-      SymX(stg_sel_15_upd_info)			\
-      SymX(stg_sel_1_upd_info)			\
-      SymX(stg_sel_2_upd_info)			\
-      SymX(stg_sel_3_upd_info)			\
-      SymX(stg_sel_4_upd_info)			\
-      SymX(stg_sel_5_upd_info)			\
-      SymX(stg_sel_6_upd_info)			\
-      SymX(stg_sel_7_upd_info)			\
-      SymX(stg_sel_8_upd_info)			\
-      SymX(stg_sel_9_upd_info)			\
-      SymX(stg_upd_frame_info)			\
-      SymX(suspendThread)			\
-      SymX(takeMVarzh_fast)			\
-      SymX(timesIntegerzh_fast)			\
-      SymX(tryPutMVarzh_fast)			\
-      SymX(tryTakeMVarzh_fast)			\
-      SymX(unblockAsyncExceptionszh_fast)	\
-      SymX(unloadObj)                           \
-      SymX(unsafeThawArrayzh_fast)		\
-      SymX(waitReadzh_fast)			\
-      SymX(waitWritezh_fast)			\
-      SymX(word2Integerzh_fast)			\
-      SymX(writeTVarzh_fast)			\
-      SymX(xorIntegerzh_fast)			\
-      SymX(yieldzh_fast)                        \
-      SymX(stg_interp_constr_entry)             \
-      SymX(stg_interp_constr1_entry)            \
-      SymX(stg_interp_constr2_entry)            \
-      SymX(stg_interp_constr3_entry)            \
-      SymX(stg_interp_constr4_entry)            \
-      SymX(stg_interp_constr5_entry)            \
-      SymX(stg_interp_constr6_entry)            \
-      SymX(stg_interp_constr7_entry)            \
-      SymX(stg_interp_constr8_entry)            \
-      SymX(stgMallocBytesRWX)                   \
-      SymX(getAllocations)                      \
-      SymX(revertCAFs)                          \
-      SymX(RtsFlags)                            \
-      RTS_USER_SIGNALS_SYMBOLS
-
-#ifdef SUPPORT_LONG_LONGS
-#define RTS_LONG_LONG_SYMS			\
-      SymX(int64ToIntegerzh_fast)		\
-      SymX(word64ToIntegerzh_fast)
-#else
-#define RTS_LONG_LONG_SYMS /* nothing */
-#endif
-
-// 64-bit support functions in libgcc.a
-#if defined(__GNUC__) && SIZEOF_VOID_P <= 4
-#define RTS_LIBGCC_SYMBOLS			\
-      Sym(__divdi3)                             \
-      Sym(__udivdi3)                            \
-      Sym(__moddi3)                             \
-      Sym(__umoddi3)				\
-      Sym(__muldi3)				\
-      Sym(__ashldi3)				\
-      Sym(__ashrdi3)				\
-      Sym(__lshrdi3)				\
-      Sym(__eprintf)
-#elif defined(ia64_HOST_ARCH)
-#define RTS_LIBGCC_SYMBOLS			\
-      Sym(__divdi3)				\
-      Sym(__udivdi3)                            \
-      Sym(__moddi3)				\
-      Sym(__umoddi3)				\
-      Sym(__divsf3)				\
-      Sym(__divdf3)
-#else
-#define RTS_LIBGCC_SYMBOLS
-#endif
-
-#if defined(darwin_HOST_OS) && defined(powerpc_HOST_ARCH)
-      // Symbols that don't have a leading underscore
-      // on Mac OS X. They have to receive special treatment,
-      // see machoInitSymbolsWithoutUnderscore()
-#define RTS_MACHO_NOUNDERLINE_SYMBOLS		\
-      Sym(saveFP)				\
-      Sym(restFP)
-#endif
-
-/* entirely bogus claims about types of these symbols */
-#define Sym(vvv)  extern void vvv(void);
-#define SymX(vvv) /**/
-#define SymX_redirect(vvv,xxx) /**/
-RTS_SYMBOLS
-RTS_RET_SYMBOLS
-RTS_LONG_LONG_SYMS
-RTS_POSIX_ONLY_SYMBOLS
-RTS_MINGW_ONLY_SYMBOLS
-RTS_CYGWIN_ONLY_SYMBOLS
-RTS_DARWIN_ONLY_SYMBOLS
-RTS_LIBGCC_SYMBOLS
-#undef Sym
-#undef SymX
-#undef SymX_redirect
-
-#ifdef LEADING_UNDERSCORE
-#define MAYBE_LEADING_UNDERSCORE_STR(s) ("_" s)
-#else
-#define MAYBE_LEADING_UNDERSCORE_STR(s) (s)
-#endif
-
-#define Sym(vvv) { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
-                    (void*)(&(vvv)) },
-#define SymX(vvv) Sym(vvv)
-
-// SymX_redirect allows us to redirect references to one symbol to
-// another symbol.  See newCAF/newDynCAF for an example.
-#define SymX_redirect(vvv,xxx) \
-    { MAYBE_LEADING_UNDERSCORE_STR(#vvv), \
-      (void*)(&(xxx)) },
-
-static RtsSymbolVal rtsSyms[] = {
-      RTS_SYMBOLS
-      RTS_RET_SYMBOLS
-      RTS_LONG_LONG_SYMS
-      RTS_POSIX_ONLY_SYMBOLS
-      RTS_MINGW_ONLY_SYMBOLS
-      RTS_CYGWIN_ONLY_SYMBOLS
-      RTS_LIBGCC_SYMBOLS
-#if defined(darwin_HOST_OS) && defined(i386_HOST_ARCH)
-      // dyld stub code contains references to this,
-      // but it should never be called because we treat
-      // lazy pointers as nonlazy.
-      { "dyld_stub_binding_helper", (void*)0xDEADBEEF },
-#endif
-      { 0, 0 } /* sentinel */
-};
-
-/* -----------------------------------------------------------------------------
- * Insert symbols into hash tables, checking for duplicates.
- */
-static void ghciInsertStrHashTable ( char* obj_name,
-                                     HashTable *table,
-                                     char* key,
-                                     void *data
-				   )
-{
-   if (lookupHashTable(table, (StgWord)key) == NULL)
-   {
-      insertStrHashTable(table, (StgWord)key, data);
-      return;
-   }
-   debugBelch(
-      "\n\n"
-      "GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
-      "   %s\n"
-      "whilst processing object file\n"
-      "   %s\n"
-      "This could be caused by:\n"
-      "   * Loading two different object files which export the same symbol\n"
-      "   * Specifying the same object file twice on the GHCi command line\n"
-      "   * An incorrect `package.conf' entry, causing some object to be\n"
-      "     loaded twice.\n"
-      "GHCi cannot safely continue in this situation.  Exiting now.  Sorry.\n"
-      "\n",
-      (char*)key,
-      obj_name
-   );
-   exit(1);
-}
-
-
-/* -----------------------------------------------------------------------------
- * initialize the object linker
- */
-
-
-static int linker_init_done = 0 ;
-
-#if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
-static void *dl_prog_handle;
-#endif
-
-/* dlopen(NULL,..) doesn't work so we grab libc explicitly */
-#if defined(openbsd_HOST_OS)
-static void *dl_libc_handle;
-#endif
-
-void
-initLinker( void )
-{
-    RtsSymbolVal *sym;
-
-    /* Make initLinker idempotent, so we can call it
-       before evey relevant operation; that means we
-       don't need to initialise the linker separately */
-    if (linker_init_done == 1) { return; } else {
-      linker_init_done = 1;
-    }
-
-    symhash = allocStrHashTable();
-
-    /* populate the symbol table with stuff from the RTS */
-    for (sym = rtsSyms; sym->lbl != NULL; sym++) {
-	ghciInsertStrHashTable("(GHCi built-in symbols)",
-                               symhash, sym->lbl, sym->addr);
-    }
-#   if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
-    machoInitSymbolsWithoutUnderscore();
-#   endif
-
-#   if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
-#   if defined(RTLD_DEFAULT)
-    dl_prog_handle = RTLD_DEFAULT;
-#   else
-    dl_prog_handle = dlopen(NULL, RTLD_LAZY);
-#   if defined(openbsd_HOST_OS)
-    dl_libc_handle = dlopen("libc.so", RTLD_LAZY);
-#   endif
-#   endif /* RTLD_DEFAULT */
-#   endif
-}
-
-/* -----------------------------------------------------------------------------
- *                  Loading DLL or .so dynamic libraries
- * -----------------------------------------------------------------------------
- *
- * Add a DLL from which symbols may be found.  In the ELF case, just
- * do RTLD_GLOBAL-style add, so no further messing around needs to
- * happen in order that symbols in the loaded .so are findable --
- * lookupSymbol() will subsequently see them by dlsym on the program's
- * dl-handle.  Returns NULL if success, otherwise ptr to an err msg.
- *
- * In the PEi386 case, open the DLLs and put handles to them in a
- * linked list.  When looking for a symbol, try all handles in the
- * list.  This means that we need to load even DLLs that are guaranteed
- * to be in the ghc.exe image already, just so we can get a handle
- * to give to loadSymbol, so that we can find the symbols.  For such
- * libraries, the LoadLibrary call should be a no-op except for returning
- * the handle.
- *
- */
-
-#if defined(OBJFORMAT_PEi386)
-/* A record for storing handles into DLLs. */
-
-typedef
-   struct _OpenedDLL {
-      char*              name;
-      struct _OpenedDLL* next;
-      HINSTANCE instance;
-   }
-   OpenedDLL;
-
-/* A list thereof. */
-static OpenedDLL* opened_dlls = NULL;
-#endif
-
-char *
-addDLL( char *dll_name )
-{
-#  if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
-   /* ------------------- ELF DLL loader ------------------- */
-   void *hdl;
-   char *errmsg;
-
-   initLinker();
-
-   hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL);
-
-   if (hdl == NULL) {
-      /* dlopen failed; return a ptr to the error msg. */
-      errmsg = dlerror();
-      if (errmsg == NULL) errmsg = "addDLL: unknown error";
-      return errmsg;
-   } else {
-      return NULL;
-   }
-   /*NOTREACHED*/
-
-#  elif defined(OBJFORMAT_PEi386)
-   /* ------------------- Win32 DLL loader ------------------- */
-
-   char*      buf;
-   OpenedDLL* o_dll;
-   HINSTANCE  instance;
-
-   initLinker();
-
-   /* debugBelch("\naddDLL; dll_name = `%s'\n", dll_name); */
-
-   /* See if we've already got it, and ignore if so. */
-   for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
-      if (0 == strcmp(o_dll->name, dll_name))
-         return NULL;
-   }
-
-   /* The file name has no suffix (yet) so that we can try
-      both foo.dll and foo.drv
-
-      The documentation for LoadLibrary says:
-      	If no file name extension is specified in the lpFileName
-      	parameter, the default library extension .dll is
-      	appended. However, the file name string can include a trailing
-      	point character (.) to indicate that the module name has no
-      	extension. */
-
-   buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
-   sprintf(buf, "%s.DLL", dll_name);
-   instance = LoadLibrary(buf);
-   if (instance == NULL) {
-	 sprintf(buf, "%s.DRV", dll_name);	// KAA: allow loading of drivers (like winspool.drv)
-	 instance = LoadLibrary(buf);
-	 if (instance == NULL) {
-		stgFree(buf);
-
-	    /* LoadLibrary failed; return a ptr to the error msg. */
-	    return "addDLL: unknown error";
-   	 }
-   }
-   stgFree(buf);
-
-   /* Add this DLL to the list of DLLs in which to search for symbols. */
-   o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
-   o_dll->name     = stgMallocBytes(1+strlen(dll_name), "addDLL");
-   strcpy(o_dll->name, dll_name);
-   o_dll->instance = instance;
-   o_dll->next     = opened_dlls;
-   opened_dlls     = o_dll;
-
-   return NULL;
-#  else
-   barf("addDLL: not implemented on this platform");
-#  endif
-}
-
-/* -----------------------------------------------------------------------------
- * lookup a symbol in the hash table
- */
-void *
-lookupSymbol( char *lbl )
-{
-    void *val;
-    initLinker() ;
-    ASSERT(symhash != NULL);
-    val = lookupStrHashTable(symhash, lbl);
-
-    if (val == NULL) {
-#       if defined(OBJFORMAT_ELF)
-#	if defined(openbsd_HOST_OS)
-	val = dlsym(dl_prog_handle, lbl);
-	return (val != NULL) ? val : dlsym(dl_libc_handle,lbl);
-#	elif defined(x86_64_HOST_ARCH)
-	val = dlsym(dl_prog_handle, lbl);
-	if (val >= (void *)0x80000000) {
-	    void *new_val;
-	    new_val = x86_64_high_symbol(lbl, val);
-	    IF_DEBUG(linker,debugBelch("lookupSymbol: relocating out of range symbol: %s = %p, now %p\n", lbl, val, new_val));
-	    return new_val;
-	} else {
-	    return val;
-	}
-#	else /* not openbsd */
-	return dlsym(dl_prog_handle, lbl);
-#	endif
-#       elif defined(OBJFORMAT_MACHO)
-	if(NSIsSymbolNameDefined(lbl)) {
-	    NSSymbol symbol = NSLookupAndBindSymbol(lbl);
-	    return NSAddressOfSymbol(symbol);
-	} else {
-	    return NULL;
-	}
-#       elif defined(OBJFORMAT_PEi386)
-        OpenedDLL* o_dll;
-        void* sym;
-        for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
-	  /* debugBelch("look in %s for %s\n", o_dll->name, lbl); */
-           if (lbl[0] == '_') {
-              /* HACK: if the name has an initial underscore, try stripping
-                 it off & look that up first. I've yet to verify whether there's
-                 a Rule that governs whether an initial '_' *should always* be
-                 stripped off when mapping from import lib name to the DLL name.
-              */
-              sym = GetProcAddress(o_dll->instance, (lbl+1));
-              if (sym != NULL) {
-		/*debugBelch("found %s in %s\n", lbl+1,o_dll->name);*/
-		return sym;
-	      }
-           }
-           sym = GetProcAddress(o_dll->instance, lbl);
-           if (sym != NULL) {
-	     /*debugBelch("found %s in %s\n", lbl,o_dll->name);*/
-	     return sym;
-	   }
-        }
-        return NULL;
-#       else
-        ASSERT(2+2 == 5);
-        return NULL;
-#       endif
-    } else {
-	return val;
-    }
-}
-
-static
-__attribute((unused))
-void *
-lookupLocalSymbol( ObjectCode* oc, char *lbl )
-{
-    void *val;
-    initLinker() ;
-    val = lookupStrHashTable(oc->lochash, lbl);
-
-    if (val == NULL) {
-        return NULL;
-    } else {
-	return val;
-    }
-}
-
-
-/* -----------------------------------------------------------------------------
- * Debugging aid: look in GHCi's object symbol tables for symbols
- * within DELTA bytes of the specified address, and show their names.
- */
-#ifdef DEBUG
-void ghci_enquire ( char* addr );
-
-void ghci_enquire ( char* addr )
-{
-   int   i;
-   char* sym;
-   char* a;
-   const int DELTA = 64;
-   ObjectCode* oc;
-
-   initLinker();
-
-   for (oc = objects; oc; oc = oc->next) {
-      for (i = 0; i < oc->n_symbols; i++) {
-         sym = oc->symbols[i];
-         if (sym == NULL) continue;
-         // debugBelch("enquire %p %p\n", sym, oc->lochash);
-         a = NULL;
-         if (oc->lochash != NULL) {
-            a = lookupStrHashTable(oc->lochash, sym);
-	 }
-         if (a == NULL) {
-            a = lookupStrHashTable(symhash, sym);
-	 }
-         if (a == NULL) {
-	     // debugBelch("ghci_enquire: can't find %s\n", sym);
-         }
-         else if (addr-DELTA <= a && a <= addr+DELTA) {
-            debugBelch("%p + %3d  ==  `%s'\n", addr, (int)(a - addr), sym);
-         }
-      }
-   }
-}
-#endif
-
-#ifdef ia64_HOST_ARCH
-static unsigned int PLTSize(void);
-#endif
-
-/* -----------------------------------------------------------------------------
- * Load an obj (populate the global symbol table, but don't resolve yet)
- *
- * Returns: 1 if ok, 0 on error.
- */
-HsInt
-loadObj( char *path )
-{
-   ObjectCode* oc;
-   struct stat st;
-   int r, n;
-#ifdef USE_MMAP
-   int fd, pagesize;
-   void *map_addr = NULL;
-#else
-   FILE *f;
-   int misalignment;
-#endif
-   initLinker();
-
-   /* debugBelch("loadObj %s\n", path ); */
-
-   /* Check that we haven't already loaded this object. 
-      Ignore requests to load multiple times */
-   {
-       ObjectCode *o;
-       int is_dup = 0;
-       for (o = objects; o; o = o->next) {
-          if (0 == strcmp(o->fileName, path)) {
-             is_dup = 1;
-             break; /* don't need to search further */
-          }
-       }
-       if (is_dup) {
-          IF_DEBUG(linker, debugBelch(
-            "GHCi runtime linker: warning: looks like you're trying to load the\n"
-            "same object file twice:\n"
-            "   %s\n"
-            "GHCi will ignore this, but be warned.\n"
-            , path));
-          return 1; /* success */
-       }
-   }
-
-   oc = stgMallocBytes(sizeof(ObjectCode), "loadObj(oc)");
-
-#  if defined(OBJFORMAT_ELF)
-   oc->formatName = "ELF";
-#  elif defined(OBJFORMAT_PEi386)
-   oc->formatName = "PEi386";
-#  elif defined(OBJFORMAT_MACHO)
-   oc->formatName = "Mach-O";
-#  else
-   stgFree(oc);
-   barf("loadObj: not implemented on this platform");
-#  endif
-
-   r = stat(path, &st);
-   if (r == -1) { return 0; }
-
-   /* sigh, strdup() isn't a POSIX function, so do it the long way */
-   oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
-   strcpy(oc->fileName, path);
-
-   oc->fileSize          = st.st_size;
-   oc->symbols           = NULL;
-   oc->sections          = NULL;
-   oc->lochash           = allocStrHashTable();
-   oc->proddables        = NULL;
-
-   /* chain it onto the list of objects */
-   oc->next              = objects;
-   objects               = oc;
-
-#ifdef USE_MMAP
-#define ROUND_UP(x,size) ((x + size - 1) & ~(size - 1))
-
-   /* On many architectures malloc'd memory isn't executable, so we need to use mmap. */
-
-#if defined(openbsd_HOST_OS)
-   fd = open(path, O_RDONLY, S_IRUSR);
-#else
-   fd = open(path, O_RDONLY);
-#endif
-   if (fd == -1)
-      barf("loadObj: can't open `%s'", path);
-
-   pagesize = getpagesize();
-
-#ifdef ia64_HOST_ARCH
-   /* The PLT needs to be right before the object */
-   n = ROUND_UP(PLTSize(), pagesize);
-   oc->plt = mmap(NULL, n, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, -1, 0);
-   if (oc->plt == MAP_FAILED)
-      barf("loadObj: can't allocate PLT");
-
-   oc->pltIndex = 0;
-   map_addr = oc->plt + n;
-#endif
-
-   n = ROUND_UP(oc->fileSize, pagesize);
-
-   /* Link objects into the lower 2Gb on x86_64.  GHC assumes the
-    * small memory model on this architecture (see gcc docs,
-    * -mcmodel=small).
-    */
-#ifdef x86_64_HOST_ARCH
-#define EXTRA_MAP_FLAGS MAP_32BIT
-#else
-#define EXTRA_MAP_FLAGS 0
-#endif
-
-   oc->image = mmap(map_addr, n, PROT_EXEC|PROT_READ|PROT_WRITE, 
-		    MAP_PRIVATE|EXTRA_MAP_FLAGS, fd, 0);
-   if (oc->image == MAP_FAILED)
-      barf("loadObj: can't map `%s'", path);
-
-   close(fd);
-
-#else /* !USE_MMAP */
-
-   /* load the image into memory */
-   f = fopen(path, "rb");
-   if (!f)
-       barf("loadObj: can't read `%s'", path);
-
-#ifdef darwin_HOST_OS
-    // In a Mach-O .o file, all sections can and will be misaligned
-    // if the total size of the headers is not a multiple of the
-    // desired alignment. This is fine for .o files that only serve
-    // as input for the static linker, but it's not fine for us,
-    // as SSE (used by gcc for floating point) and Altivec require
-    // 16-byte alignment.
-    // We calculate the correct alignment from the header before
-    // reading the file, and then we misalign oc->image on purpose so
-    // that the actual sections end up aligned again.
-   misalignment = machoGetMisalignment(f);
-   oc->misalignment = misalignment;
-#else
-   misalignment = 0;
-#endif
-
-   oc->image = stgMallocBytes(oc->fileSize + misalignment, "loadObj(image)");
-   oc->image += misalignment;
-   
-   n = fread ( oc->image, 1, oc->fileSize, f );
-   if (n != oc->fileSize)
-      barf("loadObj: error whilst reading `%s'", path);
-
-   fclose(f);
-
-#endif /* USE_MMAP */
-
-#  if defined(OBJFORMAT_MACHO) && defined(powerpc_HOST_ARCH)
-   r = ocAllocateJumpIslands_MachO ( oc );
-   if (!r) { return r; }
-#  elif defined(OBJFORMAT_ELF) && defined(powerpc_HOST_ARCH)
-   r = ocAllocateJumpIslands_ELF ( oc );
-   if (!r) { return r; }
-#endif
-
-   /* verify the in-memory image */
-#  if defined(OBJFORMAT_ELF)
-   r = ocVerifyImage_ELF ( oc );
-#  elif defined(OBJFORMAT_PEi386)
-   r = ocVerifyImage_PEi386 ( oc );
-#  elif defined(OBJFORMAT_MACHO)
-   r = ocVerifyImage_MachO ( oc );
-#  else
-   barf("loadObj: no verify method");
-#  endif
-   if (!r) { return r; }
-
-   /* build the symbol list for this image */
-#  if defined(OBJFORMAT_ELF)
-   r = ocGetNames_ELF ( oc );
-#  elif defined(OBJFORMAT_PEi386)
-   r = ocGetNames_PEi386 ( oc );
-#  elif defined(OBJFORMAT_MACHO)
-   r = ocGetNames_MachO ( oc );
-#  else
-   barf("loadObj: no getNames method");
-#  endif
-   if (!r) { return r; }
-
-   /* loaded, but not resolved yet */
-   oc->status = OBJECT_LOADED;
-
-   return 1;
-}
-
-/* -----------------------------------------------------------------------------
- * resolve all the currently unlinked objects in memory
- *
- * Returns: 1 if ok, 0 on error.
- */
-HsInt
-resolveObjs( void )
-{
-    ObjectCode *oc;
-    int r;
-
-    initLinker();
-
-    for (oc = objects; oc; oc = oc->next) {
-	if (oc->status != OBJECT_RESOLVED) {
-#           if defined(OBJFORMAT_ELF)
-	    r = ocResolve_ELF ( oc );
-#           elif defined(OBJFORMAT_PEi386)
-	    r = ocResolve_PEi386 ( oc );
-#           elif defined(OBJFORMAT_MACHO)
-	    r = ocResolve_MachO ( oc );
-#           else
-	    barf("resolveObjs: not implemented on this platform");
-#           endif
-	    if (!r) { return r; }
-	    oc->status = OBJECT_RESOLVED;
-	}
-    }
-    return 1;
-}
-
-/* -----------------------------------------------------------------------------
- * delete an object from the pool
- */
-HsInt
-unloadObj( char *path )
-{
-    ObjectCode *oc, *prev;
-
-    ASSERT(symhash != NULL);
-    ASSERT(objects != NULL);
-
-    initLinker();
-
-    prev = NULL;
-    for (oc = objects; oc; prev = oc, oc = oc->next) {
-	if (!strcmp(oc->fileName,path)) {
-
-	    /* Remove all the mappings for the symbols within this
-	     * object..
-	     */
-	    {
-                int i;
-                for (i = 0; i < oc->n_symbols; i++) {
-                   if (oc->symbols[i] != NULL) {
-                       removeStrHashTable(symhash, oc->symbols[i], NULL);
-                   }
-                }
-            }
-
-	    if (prev == NULL) {
-		objects = oc->next;
-	    } else {
-		prev->next = oc->next;
-	    }
-
-	    /* We're going to leave this in place, in case there are
-	       any pointers from the heap into it: */
-	    /* stgFree(oc->image); */
-	    stgFree(oc->fileName);
-	    stgFree(oc->symbols);
-	    stgFree(oc->sections);
-	    /* The local hash table should have been freed at the end
-               of the ocResolve_ call on it. */
-            ASSERT(oc->lochash == NULL);
-	    stgFree(oc);
-	    return 1;
-	}
-    }
-
-    errorBelch("unloadObj: can't find `%s' to unload", path);
-    return 0;
-}
-
-/* -----------------------------------------------------------------------------
- * Sanity checking.  For each ObjectCode, maintain a list of address ranges
- * which may be prodded during relocation, and abort if we try and write
- * outside any of these.
- */
-static void addProddableBlock ( ObjectCode* oc, void* start, int size )
-{
-   ProddableBlock* pb
-      = stgMallocBytes(sizeof(ProddableBlock), "addProddableBlock");
-   /* debugBelch("aPB %p %p %d\n", oc, start, size); */
-   ASSERT(size > 0);
-   pb->start      = start;
-   pb->size       = size;
-   pb->next       = oc->proddables;
-   oc->proddables = pb;
-}
-
-static void checkProddableBlock ( ObjectCode* oc, void* addr )
-{
-   ProddableBlock* pb;
-   for (pb = oc->proddables; pb != NULL; pb = pb->next) {
-      char* s = (char*)(pb->start);
-      char* e = s + pb->size - 1;
-      char* a = (char*)addr;
-      /* Assumes that the biggest fixup involves a 4-byte write.  This
-         probably needs to be changed to 8 (ie, +7) on 64-bit
-         plats. */
-      if (a >= s && (a+3) <= e) return;
-   }
-   barf("checkProddableBlock: invalid fixup in runtime linker");
-}
-
-/* -----------------------------------------------------------------------------
- * Section management.
- */
-static void addSection ( ObjectCode* oc, SectionKind kind,
-                         void* start, void* end )
-{
-   Section* s   = stgMallocBytes(sizeof(Section), "addSection");
-   s->start     = start;
-   s->end       = end;
-   s->kind      = kind;
-   s->next      = oc->sections;
-   oc->sections = s;
-   /*
-   debugBelch("addSection: %p-%p (size %d), kind %d\n",
-                   start, ((char*)end)-1, end - start + 1, kind );
-   */
-}
-
-
-/* --------------------------------------------------------------------------
- * PowerPC specifics (jump islands)
- * ------------------------------------------------------------------------*/
-
-#if defined(powerpc_HOST_ARCH)
-
-/*
-  ocAllocateJumpIslands
-  
-  Allocate additional space at the end of the object file image to make room
-  for jump islands.
-  
-  PowerPC relative branch instructions have a 24 bit displacement field.
-  As PPC code is always 4-byte-aligned, this yields a +-32MB range.
-  If a particular imported symbol is outside this range, we have to redirect
-  the jump to a short piece of new code that just loads the 32bit absolute
-  address and jumps there.
-  This function just allocates space for one 16 byte ppcJumpIsland for every
-  undefined symbol in the object file. The code for the islands is filled in by
-  makeJumpIsland below.
-*/
-
-static int ocAllocateJumpIslands( ObjectCode* oc, int count, int first )
-{
-#ifdef USE_MMAP
-  int pagesize, n, m;
-#endif
-  int aligned;
-  int misalignment = 0;
-#if darwin_HOST_OS
-  misalignment = oc->misalignment;
-#endif
-
-  if( count > 0 )
-  {
-    // round up to the nearest 4
-    aligned = (oc->fileSize + 3) & ~3;
-
-#ifdef USE_MMAP
-    #ifndef linux_HOST_OS /* mremap is a linux extension */
-        #error ocAllocateJumpIslands doesnt want USE_MMAP to be defined
-    #endif
-
-    pagesize = getpagesize();
-    n = ROUND_UP( oc->fileSize, pagesize );
-    m = ROUND_UP( aligned + sizeof (ppcJumpIsland) * count, pagesize );
-
-    /* If we have a half-page-size file and map one page of it then
-     * the part of the page after the size of the file remains accessible.
-     * If, however, we map in 2 pages, the 2nd page is not accessible
-     * and will give a "Bus Error" on access.  To get around this, we check
-     * if we need any extra pages for the jump islands and map them in
-     * anonymously.  We must check that we actually require extra pages
-     * otherwise the attempt to mmap 0 pages of anonymous memory will
-     * fail -EINVAL.
-     */
-
-    if( m > n )
-    {
-      /* The effect of this mremap() call is only the ensure that we have
-       * a sufficient number of virtually contiguous pages.  As returned from
-       * mremap, the pages past the end of the file are not backed.  We give
-       * them a backing by using MAP_FIXED to map in anonymous pages.
-       */
-      oc->image = mremap( oc->image, n, m, MREMAP_MAYMOVE );
-
-      if( oc->image == MAP_FAILED )
-      {
-        errorBelch( "Unable to mremap for Jump Islands\n" );
-        return 0;
-      }
-
-      if( mmap( oc->image + n, m - n, PROT_READ | PROT_WRITE | PROT_EXEC,
-                MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, 0, 0 ) == MAP_FAILED )
-      {
-        errorBelch( "Unable to mmap( MAP_FIXED ) for Jump Islands\n" );
-        return 0;
-      }
-    }
-
-#else
-    oc->image -= misalignment;
-    oc->image = stgReallocBytes( oc->image,
-                                 misalignment + 
-                                 aligned + sizeof (ppcJumpIsland) * count,
-                                 "ocAllocateJumpIslands" );
-    oc->image += misalignment;
-#endif /* USE_MMAP */
-
-    oc->jump_islands = (ppcJumpIsland *) (oc->image + aligned);
-    memset( oc->jump_islands, 0, sizeof (ppcJumpIsland) * count );
-  }
-  else
-    oc->jump_islands = NULL;
-
-  oc->island_start_symbol = first;
-  oc->n_islands = count;
-
-  return 1;
-}
-
-static unsigned long makeJumpIsland( ObjectCode* oc,
-                                     unsigned long symbolNumber,
-                                     unsigned long target )
-{
-  ppcJumpIsland *island;
-
-  if( symbolNumber < oc->island_start_symbol ||
-      symbolNumber - oc->island_start_symbol > oc->n_islands)
-    return 0;
-
-  island = &oc->jump_islands[symbolNumber - oc->island_start_symbol];
-
-  // lis r12, hi16(target)
-  island->lis_r12     = 0x3d80;
-  island->hi_addr     = target >> 16;
-
-  // ori r12, r12, lo16(target)
-  island->ori_r12_r12 = 0x618c;
-  island->lo_addr     = target & 0xffff;
-
-  // mtctr r12
-  island->mtctr_r12   = 0x7d8903a6;
-
-  // bctr
-  island->bctr        = 0x4e800420;
-    
-  return (unsigned long) island;
-}
-
-/*
-   ocFlushInstructionCache
-
-   Flush the data & instruction caches.
-   Because the PPC has split data/instruction caches, we have to
-   do that whenever we modify code at runtime.
- */
-
-static void ocFlushInstructionCache( ObjectCode *oc )
-{
-    int n = (oc->fileSize + sizeof( ppcJumpIsland ) * oc->n_islands + 3) / 4;
-    unsigned long *p = (unsigned long *) oc->image;
-
-    while( n-- )
-    {
-        __asm__ volatile ( "dcbf 0,%0\n\t"
-                           "sync\n\t"
-                           "icbi 0,%0"
-                           :
-                           : "r" (p)
-                         );
-        p++;
-    }
-    __asm__ volatile ( "sync\n\t"
-                       "isync"
-                     );
-}
-#endif
-
-/* --------------------------------------------------------------------------
- * PEi386 specifics (Win32 targets)
- * ------------------------------------------------------------------------*/
-
-/* The information for this linker comes from
-      Microsoft Portable Executable
-      and Common Object File Format Specification
-      revision 5.1 January 1998
-   which SimonM says comes from the MS Developer Network CDs.
-
-   It can be found there (on older CDs), but can also be found
-   online at:
-
-      http://www.microsoft.com/hwdev/hardware/PECOFF.asp
-
-   (this is Rev 6.0 from February 1999).
-
-   Things move, so if that fails, try searching for it via
-
-      http://www.google.com/search?q=PE+COFF+specification
-
-   The ultimate reference for the PE format is the Winnt.h
-   header file that comes with the Platform SDKs; as always,
-   implementations will drift wrt their documentation.
-
-   A good background article on the PE format is Matt Pietrek's
-   March 1994 article in Microsoft System Journal (MSJ)
-   (Vol.9, No. 3): "Peering Inside the PE: A Tour of the
-   Win32 Portable Executable File Format." The info in there
-   has recently been updated in a two part article in
-   MSDN magazine, issues Feb and March 2002,
-   "Inside Windows: An In-Depth Look into the Win32 Portable
-   Executable File Format"
-
-   John Levine's book "Linkers and Loaders" contains useful
-   info on PE too.
-*/
-
-
-#if defined(OBJFORMAT_PEi386)
-
-
-
-typedef unsigned char  UChar;
-typedef unsigned short UInt16;
-typedef unsigned int   UInt32;
-typedef          int   Int32;
-
-
-typedef
-   struct {
-      UInt16 Machine;
-      UInt16 NumberOfSections;
-      UInt32 TimeDateStamp;
-      UInt32 PointerToSymbolTable;
-      UInt32 NumberOfSymbols;
-      UInt16 SizeOfOptionalHeader;
-      UInt16 Characteristics;
-   }
-   COFF_header;
-
-#define sizeof_COFF_header 20
-
-
-typedef
-   struct {
-      UChar  Name[8];
-      UInt32 VirtualSize;
-      UInt32 VirtualAddress;
-      UInt32 SizeOfRawData;
-      UInt32 PointerToRawData;
-      UInt32 PointerToRelocations;
-      UInt32 PointerToLinenumbers;
-      UInt16 NumberOfRelocations;
-      UInt16 NumberOfLineNumbers;
-      UInt32 Characteristics;
-   }
-   COFF_section;
-
-#define sizeof_COFF_section 40
-
-
-typedef
-   struct {
-      UChar  Name[8];
-      UInt32 Value;
-      UInt16 SectionNumber;
-      UInt16 Type;
-      UChar  StorageClass;
-      UChar  NumberOfAuxSymbols;
-   }
-   COFF_symbol;
-
-#define sizeof_COFF_symbol 18
-
-
-typedef
-   struct {
-      UInt32 VirtualAddress;
-      UInt32 SymbolTableIndex;
-      UInt16 Type;
-   }
-   COFF_reloc;
-
-#define sizeof_COFF_reloc 10
-
-
-/* From PE spec doc, section 3.3.2 */
-/* Note use of MYIMAGE_* since IMAGE_* are already defined in
-   windows.h -- for the same purpose, but I want to know what I'm
-   getting, here. */
-#define MYIMAGE_FILE_RELOCS_STRIPPED     0x0001
-#define MYIMAGE_FILE_EXECUTABLE_IMAGE    0x0002
-#define MYIMAGE_FILE_DLL                 0x2000
-#define MYIMAGE_FILE_SYSTEM              0x1000
-#define MYIMAGE_FILE_BYTES_REVERSED_HI   0x8000
-#define MYIMAGE_FILE_BYTES_REVERSED_LO   0x0080
-#define MYIMAGE_FILE_32BIT_MACHINE       0x0100
-
-/* From PE spec doc, section 5.4.2 and 5.4.4 */
-#define MYIMAGE_SYM_CLASS_EXTERNAL       2
-#define MYIMAGE_SYM_CLASS_STATIC         3
-#define MYIMAGE_SYM_UNDEFINED            0
-
-/* From PE spec doc, section 4.1 */
-#define MYIMAGE_SCN_CNT_CODE             0x00000020
-#define MYIMAGE_SCN_CNT_INITIALIZED_DATA 0x00000040
-#define MYIMAGE_SCN_LNK_NRELOC_OVFL      0x01000000
-
-/* From PE spec doc, section 5.2.1 */
-#define MYIMAGE_REL_I386_DIR32           0x0006
-#define MYIMAGE_REL_I386_REL32           0x0014
-
-
-/* We use myindex to calculate array addresses, rather than
-   simply doing the normal subscript thing.  That's because
-   some of the above structs have sizes which are not
-   a whole number of words.  GCC rounds their sizes up to a
-   whole number of words, which means that the address calcs
-   arising from using normal C indexing or pointer arithmetic
-   are just plain wrong.  Sigh.
-*/
-static UChar *
-myindex ( int scale, void* base, int index )
-{
-   return
-      ((UChar*)base) + scale * index;
-}
-
-
-static void
-printName ( UChar* name, UChar* strtab )
-{
-   if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
-      UInt32 strtab_offset = * (UInt32*)(name+4);
-      debugBelch("%s", strtab + strtab_offset );
-   } else {
-      int i;
-      for (i = 0; i < 8; i++) {
-         if (name[i] == 0) break;
-         debugBelch("%c", name[i] );
-      }
-   }
-}
-
-
-static void
-copyName ( UChar* name, UChar* strtab, UChar* dst, int dstSize )
-{
-   if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
-      UInt32 strtab_offset = * (UInt32*)(name+4);
-      strncpy ( dst, strtab+strtab_offset, dstSize );
-      dst[dstSize-1] = 0;
-   } else {
-      int i = 0;
-      while (1) {
-         if (i >= 8) break;
-         if (name[i] == 0) break;
-         dst[i] = name[i];
-         i++;
-      }
-      dst[i] = 0;
-   }
-}
-
-
-static UChar *
-cstring_from_COFF_symbol_name ( UChar* name, UChar* strtab )
-{
-   UChar* newstr;
-   /* If the string is longer than 8 bytes, look in the
-      string table for it -- this will be correctly zero terminated.
-   */
-   if (name[0]==0 && name[1]==0 && name[2]==0 && name[3]==0) {
-      UInt32 strtab_offset = * (UInt32*)(name+4);
-      return ((UChar*)strtab) + strtab_offset;
-   }
-   /* Otherwise, if shorter than 8 bytes, return the original,
-      which by defn is correctly terminated.
-   */
-   if (name[7]==0) return name;
-   /* The annoying case: 8 bytes.  Copy into a temporary
-      (which is never freed ...)
-   */
-   newstr = stgMallocBytes(9, "cstring_from_COFF_symbol_name");
-   ASSERT(newstr);
-   strncpy(newstr,name,8);
-   newstr[8] = 0;
-   return newstr;
-}
-
-
-/* Just compares the short names (first 8 chars) */
-static COFF_section *
-findPEi386SectionCalled ( ObjectCode* oc,  char* name )
-{
-   int i;
-   COFF_header* hdr
-      = (COFF_header*)(oc->image);
-   COFF_section* sectab
-      = (COFF_section*) (
-           ((UChar*)(oc->image))
-           + sizeof_COFF_header + hdr->SizeOfOptionalHeader
-        );
-   for (i = 0; i < hdr->NumberOfSections; i++) {
-      UChar* n1;
-      UChar* n2;
-      COFF_section* section_i
-         = (COFF_section*)
-           myindex ( sizeof_COFF_section, sectab, i );
-      n1 = (UChar*) &(section_i->Name);
-      n2 = name;
-      if (n1[0]==n2[0] && n1[1]==n2[1] && n1[2]==n2[2] &&
-          n1[3]==n2[3] && n1[4]==n2[4] && n1[5]==n2[5] &&
-          n1[6]==n2[6] && n1[7]==n2[7])
-         return section_i;
-   }
-
-   return NULL;
-}
-
-
-static void
-zapTrailingAtSign ( UChar* sym )
-{
-#  define my_isdigit(c) ((c) >= '0' && (c) <= '9')
-   int i, j;
-   if (sym[0] == 0) return;
-   i = 0;
-   while (sym[i] != 0) i++;
-   i--;
-   j = i;
-   while (j > 0 && my_isdigit(sym[j])) j--;
-   if (j > 0 && sym[j] == '@' && j != i) sym[j] = 0;
-#  undef my_isdigit
-}
-
-
-static int
-ocVerifyImage_PEi386 ( ObjectCode* oc )
-{
-   int i;
-   UInt32 j, noRelocs;
-   COFF_header*  hdr;
-   COFF_section* sectab;
-   COFF_symbol*  symtab;
-   UChar*        strtab;
-   /* debugBelch("\nLOADING %s\n", oc->fileName); */
-   hdr = (COFF_header*)(oc->image);
-   sectab = (COFF_section*) (
-               ((UChar*)(oc->image))
-               + sizeof_COFF_header + hdr->SizeOfOptionalHeader
-            );
-   symtab = (COFF_symbol*) (
-               ((UChar*)(oc->image))
-               + hdr->PointerToSymbolTable
-            );
-   strtab = ((UChar*)symtab)
-            + hdr->NumberOfSymbols * sizeof_COFF_symbol;
-
-   if (hdr->Machine != 0x14c) {
-      errorBelch("%s: Not x86 PEi386", oc->fileName);
-      return 0;
-   }
-   if (hdr->SizeOfOptionalHeader != 0) {
-      errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
-      return 0;
-   }
-   if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
-        (hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
-        (hdr->Characteristics & MYIMAGE_FILE_DLL) ||
-        (hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
-      errorBelch("%s: Not a PEi386 object file", oc->fileName);
-      return 0;
-   }
-   if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
-        /* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
-      errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
-		 oc->fileName,
-		 (int)(hdr->Characteristics));
-      return 0;
-   }
-   /* If the string table size is way crazy, this might indicate that
-      there are more than 64k relocations, despite claims to the
-      contrary.  Hence this test. */
-   /* debugBelch("strtab size %d\n", * (UInt32*)strtab); */
-#if 0
-   if ( (*(UInt32*)strtab) > 600000 ) {
-      /* Note that 600k has no special significance other than being
-         big enough to handle the almost-2MB-sized lumps that
-         constitute HSwin32*.o. */
-      debugBelch("PEi386 object has suspiciously large string table; > 64k relocs?");
-      return 0;
-   }
-#endif
-
-   /* No further verification after this point; only debug printing. */
-   i = 0;
-   IF_DEBUG(linker, i=1);
-   if (i == 0) return 1;
-
-   debugBelch( "sectab offset = %d\n", ((UChar*)sectab) - ((UChar*)hdr) );
-   debugBelch( "symtab offset = %d\n", ((UChar*)symtab) - ((UChar*)hdr) );
-   debugBelch( "strtab offset = %d\n", ((UChar*)strtab) - ((UChar*)hdr) );
-
-   debugBelch("\n" );
-   debugBelch( "Machine:           0x%x\n", (UInt32)(hdr->Machine) );
-   debugBelch( "# sections:        %d\n",   (UInt32)(hdr->NumberOfSections) );
-   debugBelch( "time/date:         0x%x\n", (UInt32)(hdr->TimeDateStamp) );
-   debugBelch( "symtab offset:     %d\n",   (UInt32)(hdr->PointerToSymbolTable) );
-   debugBelch( "# symbols:         %d\n",   (UInt32)(hdr->NumberOfSymbols) );
-   debugBelch( "sz of opt hdr:     %d\n",   (UInt32)(hdr->SizeOfOptionalHeader) );
-   debugBelch( "characteristics:   0x%x\n", (UInt32)(hdr->Characteristics) );
-
-   /* Print the section table. */
-   debugBelch("\n" );
-   for (i = 0; i < hdr->NumberOfSections; i++) {
-      COFF_reloc* reltab;
-      COFF_section* sectab_i
-         = (COFF_section*)
-           myindex ( sizeof_COFF_section, sectab, i );
-      debugBelch(
-                "\n"
-                "section %d\n"
-                "     name `",
-                i
-              );
-      printName ( sectab_i->Name, strtab );
-      debugBelch(
-                "'\n"
-                "    vsize %d\n"
-                "    vaddr %d\n"
-                "  data sz %d\n"
-                " data off %d\n"
-                "  num rel %d\n"
-                "  off rel %d\n"
-                "  ptr raw 0x%x\n",
-                sectab_i->VirtualSize,
-                sectab_i->VirtualAddress,
-                sectab_i->SizeOfRawData,
-                sectab_i->PointerToRawData,
-                sectab_i->NumberOfRelocations,
-                sectab_i->PointerToRelocations,
-                sectab_i->PointerToRawData
-              );
-      reltab = (COFF_reloc*) (
-                  ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
-               );
-
-      if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
-	/* If the relocation field (a short) has overflowed, the
-	 * real count can be found in the first reloc entry.
-	 *
-	 * See Section 4.1 (last para) of the PE spec (rev6.0).
-	 */
-        COFF_reloc* rel = (COFF_reloc*)
-                           myindex ( sizeof_COFF_reloc, reltab, 0 );
-	noRelocs = rel->VirtualAddress;
-	j = 1;
-      } else {
-	noRelocs = sectab_i->NumberOfRelocations;
-        j = 0;
-      }
-
-      for (; j < noRelocs; j++) {
-         COFF_symbol* sym;
-         COFF_reloc* rel = (COFF_reloc*)
-                           myindex ( sizeof_COFF_reloc, reltab, j );
-         debugBelch(
-                   "        type 0x%-4x   vaddr 0x%-8x   name `",
-                   (UInt32)rel->Type,
-                   rel->VirtualAddress );
-         sym = (COFF_symbol*)
-               myindex ( sizeof_COFF_symbol, symtab, rel->SymbolTableIndex );
-	 /* Hmm..mysterious looking offset - what's it for? SOF */
-         printName ( sym->Name, strtab -10 );
-         debugBelch("'\n" );
-      }
-
-      debugBelch("\n" );
-   }
-   debugBelch("\n" );
-   debugBelch("string table has size 0x%x\n", * (UInt32*)strtab );
-   debugBelch("---START of string table---\n");
-   for (i = 4; i < *(Int32*)strtab; i++) {
-      if (strtab[i] == 0)
-         debugBelch("\n"); else
-         debugBelch("%c", strtab[i] );
-   }
-   debugBelch("--- END  of string table---\n");
-
-   debugBelch("\n" );
-   i = 0;
-   while (1) {
-      COFF_symbol* symtab_i;
-      if (i >= (Int32)(hdr->NumberOfSymbols)) break;
-      symtab_i = (COFF_symbol*)
-                 myindex ( sizeof_COFF_symbol, symtab, i );
-      debugBelch(
-                "symbol %d\n"
-                "     name `",
-                i
-              );
-      printName ( symtab_i->Name, strtab );
-      debugBelch(
-                "'\n"
-                "    value 0x%x\n"
-                "   1+sec# %d\n"
-                "     type 0x%x\n"
-                "   sclass 0x%x\n"
-                "     nAux %d\n",
-                symtab_i->Value,
-                (Int32)(symtab_i->SectionNumber),
-                (UInt32)symtab_i->Type,
-                (UInt32)symtab_i->StorageClass,
-                (UInt32)symtab_i->NumberOfAuxSymbols
-              );
-      i += symtab_i->NumberOfAuxSymbols;
-      i++;
-   }
-
-   debugBelch("\n" );
-   return 1;
-}
-
-
-static int
-ocGetNames_PEi386 ( ObjectCode* oc )
-{
-   COFF_header*  hdr;
-   COFF_section* sectab;
-   COFF_symbol*  symtab;
-   UChar*        strtab;
-
-   UChar* sname;
-   void*  addr;
-   int    i;
-
-   hdr = (COFF_header*)(oc->image);
-   sectab = (COFF_section*) (
-               ((UChar*)(oc->image))
-               + sizeof_COFF_header + hdr->SizeOfOptionalHeader
-            );
-   symtab = (COFF_symbol*) (
-               ((UChar*)(oc->image))
-               + hdr->PointerToSymbolTable
-            );
-   strtab = ((UChar*)(oc->image))
-            + hdr->PointerToSymbolTable
-            + hdr->NumberOfSymbols * sizeof_COFF_symbol;
-
-   /* Allocate space for any (local, anonymous) .bss sections. */
-
-   for (i = 0; i < hdr->NumberOfSections; i++) {
-      UInt32 bss_sz;
-      UChar* zspace;
-      COFF_section* sectab_i
-         = (COFF_section*)
-           myindex ( sizeof_COFF_section, sectab, i );
-      if (0 != strcmp(sectab_i->Name, ".bss")) continue;
-      /* sof 10/05: the PE spec text isn't too clear regarding what
-       * the SizeOfRawData field is supposed to hold for object
-       * file sections containing just uninitialized data -- for executables,
-       * it is supposed to be zero; unclear what it's supposed to be
-       * for object files. However, VirtualSize is guaranteed to be
-       * zero for object files, which definitely suggests that SizeOfRawData
-       * will be non-zero (where else would the size of this .bss section be
-       * stored?) Looking at the COFF_section info for incoming object files,
-       * this certainly appears to be the case.
-       *
-       * => I suspect we've been incorrectly handling .bss sections in (relocatable)
-       * object files up until now. This turned out to bite us with ghc-6.4.1's use
-       * of gcc-3.4.x, which has started to emit initially-zeroed-out local 'static'
-       * variable decls into to the .bss section. (The specific function in Q which
-       * triggered this is libraries/base/cbits/dirUtils.c:__hscore_getFolderPath())
-       */
-      if (sectab_i->VirtualSize == 0 && sectab_i->SizeOfRawData == 0) continue;
-      /* This is a non-empty .bss section.  Allocate zeroed space for
-         it, and set its PointerToRawData field such that oc->image +
-         PointerToRawData == addr_of_zeroed_space.  */
-      bss_sz = sectab_i->VirtualSize;
-      if ( bss_sz < sectab_i->SizeOfRawData) { bss_sz = sectab_i->SizeOfRawData; }
-      zspace = stgCallocBytes(1, bss_sz, "ocGetNames_PEi386(anonymous bss)");
-      sectab_i->PointerToRawData = ((UChar*)zspace) - ((UChar*)(oc->image));
-      addProddableBlock(oc, zspace, bss_sz);
-      /* debugBelch("BSS anon section at 0x%x\n", zspace); */
-   }
-
-   /* Copy section information into the ObjectCode. */
-
-   for (i = 0; i < hdr->NumberOfSections; i++) {
-      UChar* start;
-      UChar* end;
-      UInt32 sz;
-
-      SectionKind kind
-         = SECTIONKIND_OTHER;
-      COFF_section* sectab_i
-         = (COFF_section*)
-           myindex ( sizeof_COFF_section, sectab, i );
-      IF_DEBUG(linker, debugBelch("section name = %s\n", sectab_i->Name ));
-
-#     if 0
-      /* I'm sure this is the Right Way to do it.  However, the
-         alternative of testing the sectab_i->Name field seems to
-         work ok with Cygwin.
-      */
-      if (sectab_i->Characteristics & MYIMAGE_SCN_CNT_CODE ||
-          sectab_i->Characteristics & MYIMAGE_SCN_CNT_INITIALIZED_DATA)
-         kind = SECTIONKIND_CODE_OR_RODATA;
-#     endif
-
-      if (0==strcmp(".text",sectab_i->Name) ||
-          0==strcmp(".rdata",sectab_i->Name)||
-          0==strcmp(".rodata",sectab_i->Name))
-         kind = SECTIONKIND_CODE_OR_RODATA;
-      if (0==strcmp(".data",sectab_i->Name) ||
-          0==strcmp(".bss",sectab_i->Name))
-         kind = SECTIONKIND_RWDATA;
-
-      ASSERT(sectab_i->SizeOfRawData == 0 || sectab_i->VirtualSize == 0);
-      sz = sectab_i->SizeOfRawData;
-      if (sz < sectab_i->VirtualSize) sz = sectab_i->VirtualSize;
-
-      start = ((UChar*)(oc->image)) + sectab_i->PointerToRawData;
-      end   = start + sz - 1;
-
-      if (kind == SECTIONKIND_OTHER
-          /* Ignore sections called which contain stabs debugging
-             information. */
-          && 0 != strcmp(".stab", sectab_i->Name)
-          && 0 != strcmp(".stabstr", sectab_i->Name)
-          /* ignore constructor section for now */
-          && 0 != strcmp(".ctors", sectab_i->Name)
-         ) {
-         errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", sectab_i->Name, oc->fileName);
-         return 0;
-      }
-
-      if (kind != SECTIONKIND_OTHER && end >= start) {
-         addSection(oc, kind, start, end);
-         addProddableBlock(oc, start, end - start + 1);
-      }
-   }
-
-   /* Copy exported symbols into the ObjectCode. */
-
-   oc->n_symbols = hdr->NumberOfSymbols;
-   oc->symbols   = stgMallocBytes(oc->n_symbols * sizeof(char*),
-                                  "ocGetNames_PEi386(oc->symbols)");
-   /* Call me paranoid; I don't care. */
-   for (i = 0; i < oc->n_symbols; i++)
-      oc->symbols[i] = NULL;
-
-   i = 0;
-   while (1) {
-      COFF_symbol* symtab_i;
-      if (i >= (Int32)(hdr->NumberOfSymbols)) break;
-      symtab_i = (COFF_symbol*)
-                 myindex ( sizeof_COFF_symbol, symtab, i );
-
-      addr  = NULL;
-
-      if (symtab_i->StorageClass == MYIMAGE_SYM_CLASS_EXTERNAL
-          && symtab_i->SectionNumber != MYIMAGE_SYM_UNDEFINED) {
-         /* This symbol is global and defined, viz, exported */
-         /* for MYIMAGE_SYMCLASS_EXTERNAL
-                && !MYIMAGE_SYM_UNDEFINED,
-            the address of the symbol is:
-                address of relevant section + offset in section
-         */
-         COFF_section* sectabent
-            = (COFF_section*) myindex ( sizeof_COFF_section,
-                                        sectab,
-                                        symtab_i->SectionNumber-1 );
-         addr = ((UChar*)(oc->image))
-                + (sectabent->PointerToRawData
-                   + symtab_i->Value);
-      }
-      else
-      if (symtab_i->SectionNumber == MYIMAGE_SYM_UNDEFINED
-	  && symtab_i->Value > 0) {
-         /* This symbol isn't in any section at all, ie, global bss.
-            Allocate zeroed space for it. */
-         addr = stgCallocBytes(1, symtab_i->Value,
-                               "ocGetNames_PEi386(non-anonymous bss)");
-         addSection(oc, SECTIONKIND_RWDATA, addr,
-                        ((UChar*)addr) + symtab_i->Value - 1);
-         addProddableBlock(oc, addr, symtab_i->Value);
-         /* debugBelch("BSS      section at 0x%x\n", addr); */
-      }
-
-      if (addr != NULL ) {
-         sname = cstring_from_COFF_symbol_name ( symtab_i->Name, strtab );
-         /* debugBelch("addSymbol %p `%s \n", addr,sname);  */
-         IF_DEBUG(linker, debugBelch("addSymbol %p `%s'\n", addr,sname);)
-         ASSERT(i >= 0 && i < oc->n_symbols);
-         /* cstring_from_COFF_symbol_name always succeeds. */
-         oc->symbols[i] = sname;
-         ghciInsertStrHashTable(oc->fileName, symhash, sname, addr);
-      } else {
-#        if 0
-         debugBelch(
-                   "IGNORING symbol %d\n"
-                   "     name `",
-                   i
-                 );
-         printName ( symtab_i->Name, strtab );
-         debugBelch(
-                   "'\n"
-                   "    value 0x%x\n"
-                   "   1+sec# %d\n"
-                   "     type 0x%x\n"
-                   "   sclass 0x%x\n"
-                   "     nAux %d\n",
-                   symtab_i->Value,
-                   (Int32)(symtab_i->SectionNumber),
-                   (UInt32)symtab_i->Type,
-                   (UInt32)symtab_i->StorageClass,
-                   (UInt32)symtab_i->NumberOfAuxSymbols
-                 );
-#        endif
-      }
-
-      i += symtab_i->NumberOfAuxSymbols;
-      i++;
-   }
-
-   return 1;
-}
-
-
-static int
-ocResolve_PEi386 ( ObjectCode* oc )
-{
-   COFF_header*  hdr;
-   COFF_section* sectab;
-   COFF_symbol*  symtab;
-   UChar*        strtab;
-
-   UInt32        A;
-   UInt32        S;
-   UInt32*       pP;
-
-   int i;
-   UInt32 j, noRelocs;
-
-   /* ToDo: should be variable-sized?  But is at least safe in the
-      sense of buffer-overrun-proof. */
-   char symbol[1000];
-   /* debugBelch("resolving for %s\n", oc->fileName); */
-
-   hdr = (COFF_header*)(oc->image);
-   sectab = (COFF_section*) (
-               ((UChar*)(oc->image))
-               + sizeof_COFF_header + hdr->SizeOfOptionalHeader
-            );
-   symtab = (COFF_symbol*) (
-               ((UChar*)(oc->image))
-               + hdr->PointerToSymbolTable
-            );
-   strtab = ((UChar*)(oc->image))
-            + hdr->PointerToSymbolTable
-            + hdr->NumberOfSymbols * sizeof_COFF_symbol;
-
-   for (i = 0; i < hdr->NumberOfSections; i++) {
-      COFF_section* sectab_i
-         = (COFF_section*)
-           myindex ( sizeof_COFF_section, sectab, i );
-      COFF_reloc* reltab
-         = (COFF_reloc*) (
-              ((UChar*)(oc->image)) + sectab_i->PointerToRelocations
-           );
-
-      /* Ignore sections called which contain stabs debugging
-         information. */
-      if (0 == strcmp(".stab", sectab_i->Name)
-          || 0 == strcmp(".stabstr", sectab_i->Name)
-          || 0 == strcmp(".ctors", sectab_i->Name))
-         continue;
-
-      if ( sectab_i->Characteristics & MYIMAGE_SCN_LNK_NRELOC_OVFL ) {
-	/* If the relocation field (a short) has overflowed, the
-	 * real count can be found in the first reloc entry.
-         *
-	 * See Section 4.1 (last para) of the PE spec (rev6.0).
-	 *
-	 * Nov2003 update: the GNU linker still doesn't correctly
-	 * handle the generation of relocatable object files with
-	 * overflown relocations. Hence the output to warn of potential
-	 * troubles.
-	 */
-        COFF_reloc* rel = (COFF_reloc*)
-                           myindex ( sizeof_COFF_reloc, reltab, 0 );
-	noRelocs = rel->VirtualAddress;
-
-	/* 10/05: we now assume (and check for) a GNU ld that is capable
-	 * of handling object files with (>2^16) of relocs.
-	 */
-#if 0
-	debugBelch("WARNING: Overflown relocation field (# relocs found: %u)\n",
-		   noRelocs);
-#endif
-	j = 1;
-      } else {
-	noRelocs = sectab_i->NumberOfRelocations;
-        j = 0;
-      }
-
-
-      for (; j < noRelocs; j++) {
-         COFF_symbol* sym;
-         COFF_reloc* reltab_j
-            = (COFF_reloc*)
-              myindex ( sizeof_COFF_reloc, reltab, j );
-
-         /* the location to patch */
-         pP = (UInt32*)(
-                 ((UChar*)(oc->image))
-                 + (sectab_i->PointerToRawData
-                    + reltab_j->VirtualAddress
-                    - sectab_i->VirtualAddress )
-              );
-         /* the existing contents of pP */
-         A = *pP;
-         /* the symbol to connect to */
-         sym = (COFF_symbol*)
-               myindex ( sizeof_COFF_symbol,
-                         symtab, reltab_j->SymbolTableIndex );
-         IF_DEBUG(linker,
-                  debugBelch(
-                            "reloc sec %2d num %3d:  type 0x%-4x   "
-                            "vaddr 0x%-8x   name `",
-                            i, j,
-                            (UInt32)reltab_j->Type,
-                            reltab_j->VirtualAddress );
-                            printName ( sym->Name, strtab );
-                            debugBelch("'\n" ));
-
-         if (sym->StorageClass == MYIMAGE_SYM_CLASS_STATIC) {
-            COFF_section* section_sym
-               = findPEi386SectionCalled ( oc, sym->Name );
-            if (!section_sym) {
-               errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
-               return 0;
-            }
-            S = ((UInt32)(oc->image))
-                + (section_sym->PointerToRawData
-                   + sym->Value);
-         } else {
-            copyName ( sym->Name, strtab, symbol, 1000-1 );
-            (void*)S = lookupLocalSymbol( oc, symbol );
-            if ((void*)S != NULL) goto foundit;
-            (void*)S = lookupSymbol( symbol );
-            if ((void*)S != NULL) goto foundit;
-            zapTrailingAtSign ( symbol );
-            (void*)S = lookupLocalSymbol( oc, symbol );
-            if ((void*)S != NULL) goto foundit;
-            (void*)S = lookupSymbol( symbol );
-            if ((void*)S != NULL) goto foundit;
-	    /* Newline first because the interactive linker has printed "linking..." */
-            errorBelch("\n%s: unknown symbol `%s'", oc->fileName, symbol);
-            return 0;
-           foundit:;
-         }
-         checkProddableBlock(oc, pP);
-         switch (reltab_j->Type) {
-            case MYIMAGE_REL_I386_DIR32:
-               *pP = A + S;
-               break;
-            case MYIMAGE_REL_I386_REL32:
-               /* Tricky.  We have to insert a displacement at
-                  pP which, when added to the PC for the _next_
-                  insn, gives the address of the target (S).
-                  Problem is to know the address of the next insn
-                  when we only know pP.  We assume that this
-                  literal field is always the last in the insn,
-                  so that the address of the next insn is pP+4
-                  -- hence the constant 4.
-                  Also I don't know if A should be added, but so
-                  far it has always been zero.
-
-		  SOF 05/2005: 'A' (old contents of *pP) have been observed
-		  to contain values other than zero (the 'wx' object file
-		  that came with wxhaskell-0.9.4; dunno how it was compiled..).
-		  So, add displacement to old value instead of asserting
-		  A to be zero. Fixes wxhaskell-related crashes, and no other
-		  ill effects have been observed.
-		  
-		  Update: the reason why we're seeing these more elaborate
-		  relocations is due to a switch in how the NCG compiles SRTs 
-		  and offsets to them from info tables. SRTs live in .(ro)data, 
-		  while info tables live in .text, causing GAS to emit REL32/DISP32 
-		  relocations with non-zero values. Adding the displacement is
-		  the right thing to do.
-	       */
-               *pP = S - ((UInt32)pP) - 4 + A;
-               break;
-            default:
-               debugBelch("%s: unhandled PEi386 relocation type %d",
-		     oc->fileName, reltab_j->Type);
-               return 0;
-         }
-
-      }
-   }
-
-   IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
-   return 1;
-}
-
-#endif /* defined(OBJFORMAT_PEi386) */
-
-
-/* --------------------------------------------------------------------------
- * ELF specifics
- * ------------------------------------------------------------------------*/
-
-#if defined(OBJFORMAT_ELF)
-
-#define FALSE 0
-#define TRUE  1
-
-#if defined(sparc_HOST_ARCH)
-#  define ELF_TARGET_SPARC  /* Used inside <elf.h> */
-#elif defined(i386_HOST_ARCH)
-#  define ELF_TARGET_386    /* Used inside <elf.h> */
-#elif defined(x86_64_HOST_ARCH)
-#  define ELF_TARGET_X64_64
-#  define ELF_64BIT
-#elif defined (ia64_HOST_ARCH)
-#  define ELF_TARGET_IA64   /* Used inside <elf.h> */
-#  define ELF_64BIT
-#  define ELF_FUNCTION_DESC /* calling convention uses function descriptors */
-#  define ELF_NEED_GOT      /* needs Global Offset Table */
-#  define ELF_NEED_PLT      /* needs Procedure Linkage Tables */
-#endif
-
-#if !defined(openbsd_HOST_OS)
-#include <elf.h>
-#else
-/* openbsd elf has things in different places, with diff names */
-#include <elf_abi.h>
-#include <machine/reloc.h>
-#define R_386_32    RELOC_32
-#define R_386_PC32  RELOC_PC32
-#endif
-
-/*
- * Define a set of types which can be used for both ELF32 and ELF64
- */
-
-#ifdef ELF_64BIT
-#define ELFCLASS    ELFCLASS64
-#define Elf_Addr    Elf64_Addr
-#define Elf_Word    Elf64_Word
-#define Elf_Sword   Elf64_Sword
-#define Elf_Ehdr    Elf64_Ehdr
-#define Elf_Phdr    Elf64_Phdr
-#define Elf_Shdr    Elf64_Shdr
-#define Elf_Sym     Elf64_Sym
-#define Elf_Rel     Elf64_Rel
-#define Elf_Rela    Elf64_Rela
-#define ELF_ST_TYPE ELF64_ST_TYPE
-#define ELF_ST_BIND ELF64_ST_BIND
-#define ELF_R_TYPE  ELF64_R_TYPE
-#define ELF_R_SYM   ELF64_R_SYM
-#else
-#define ELFCLASS    ELFCLASS32
-#define Elf_Addr    Elf32_Addr
-#define Elf_Word    Elf32_Word
-#define Elf_Sword   Elf32_Sword
-#define Elf_Ehdr    Elf32_Ehdr
-#define Elf_Phdr    Elf32_Phdr
-#define Elf_Shdr    Elf32_Shdr
-#define Elf_Sym     Elf32_Sym
-#define Elf_Rel     Elf32_Rel
-#define Elf_Rela    Elf32_Rela
-#ifndef ELF_ST_TYPE
-#define ELF_ST_TYPE ELF32_ST_TYPE
-#endif
-#ifndef ELF_ST_BIND
-#define ELF_ST_BIND ELF32_ST_BIND
-#endif
-#ifndef ELF_R_TYPE
-#define ELF_R_TYPE  ELF32_R_TYPE
-#endif
-#ifndef ELF_R_SYM
-#define ELF_R_SYM   ELF32_R_SYM
-#endif
-#endif
-
-
-/*
- * Functions to allocate entries in dynamic sections.  Currently we simply
- * preallocate a large number, and we don't check if a entry for the given
- * target already exists (a linear search is too slow).  Ideally these
- * entries would be associated with symbols.
- */
-
-/* These sizes sufficient to load HSbase + HShaskell98 + a few modules */
-#define GOT_SIZE            0x20000
-#define FUNCTION_TABLE_SIZE 0x10000
-#define PLT_SIZE            0x08000
-
-#ifdef ELF_NEED_GOT
-static Elf_Addr got[GOT_SIZE];
-static unsigned int gotIndex;
-static Elf_Addr gp_val = (Elf_Addr)got;
-
-static Elf_Addr
-allocateGOTEntry(Elf_Addr target)
-{
-   Elf_Addr *entry;
-
-   if (gotIndex >= GOT_SIZE)
-      barf("Global offset table overflow");
-
-   entry = &got[gotIndex++];
-   *entry = target;
-   return (Elf_Addr)entry;
-}
-#endif
-
-#ifdef ELF_FUNCTION_DESC
-typedef struct {
-   Elf_Addr ip;
-   Elf_Addr gp;
-} FunctionDesc;
-
-static FunctionDesc functionTable[FUNCTION_TABLE_SIZE];
-static unsigned int functionTableIndex;
-
-static Elf_Addr
-allocateFunctionDesc(Elf_Addr target)
-{
-   FunctionDesc *entry;
-
-   if (functionTableIndex >= FUNCTION_TABLE_SIZE)
-      barf("Function table overflow");
-
-   entry = &functionTable[functionTableIndex++];
-   entry->ip = target;
-   entry->gp = (Elf_Addr)gp_val;
-   return (Elf_Addr)entry;
-}
-
-static Elf_Addr
-copyFunctionDesc(Elf_Addr target)
-{
-   FunctionDesc *olddesc = (FunctionDesc *)target;
-   FunctionDesc *newdesc;
-
-   newdesc = (FunctionDesc *)allocateFunctionDesc(olddesc->ip);
-   newdesc->gp = olddesc->gp;
-   return (Elf_Addr)newdesc;
-}
-#endif
-
-#ifdef ELF_NEED_PLT
-#ifdef ia64_HOST_ARCH
-static void ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value);
-static void ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc);
-
-static unsigned char plt_code[] =
-{
-   /* taken from binutils bfd/elfxx-ia64.c */
-   0x0b, 0x78, 0x00, 0x02, 0x00, 0x24,  /*   [MMI]       addl r15=0,r1;;    */
-   0x00, 0x41, 0x3c, 0x30, 0x28, 0xc0,  /*               ld8 r16=[r15],8    */
-   0x01, 0x08, 0x00, 0x84,              /*               mov r14=r1;;       */
-   0x11, 0x08, 0x00, 0x1e, 0x18, 0x10,  /*   [MIB]       ld8 r1=[r15]       */
-   0x60, 0x80, 0x04, 0x80, 0x03, 0x00,  /*               mov b6=r16         */
-   0x60, 0x00, 0x80, 0x00               /*               br.few b6;;        */
-};
-
-/* If we can't get to the function descriptor via gp, take a local copy of it */
-#define PLT_RELOC(code, target) { \
-   Elf64_Sxword rel_value = target - gp_val; \
-   if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff)) \
-      ia64_reloc_gprel22((Elf_Addr)code, copyFunctionDesc(target)); \
-   else \
-      ia64_reloc_gprel22((Elf_Addr)code, target); \
-   }
-#endif
-
-typedef struct {
-   unsigned char code[sizeof(plt_code)];
-} PLTEntry;
-
-static Elf_Addr
-allocatePLTEntry(Elf_Addr target, ObjectCode *oc)
-{
-   PLTEntry *plt = (PLTEntry *)oc->plt;
-   PLTEntry *entry;
-
-   if (oc->pltIndex >= PLT_SIZE)
-      barf("Procedure table overflow");
-
-   entry = &plt[oc->pltIndex++];
-   memcpy(entry->code, plt_code, sizeof(entry->code));
-   PLT_RELOC(entry->code, target);
-   return (Elf_Addr)entry;
-}
-
-static unsigned int
-PLTSize(void)
-{
-   return (PLT_SIZE * sizeof(PLTEntry));
-}
-#endif
-
-
-#if x86_64_HOST_ARCH
-// On x86_64, 32-bit relocations are often used, which requires that
-// we can resolve a symbol to a 32-bit offset.  However, shared
-// libraries are placed outside the 2Gb area, which leaves us with a
-// problem when we need to give a 32-bit offset to a symbol in a
-// shared library.
-// 
-// For a function symbol, we can allocate a bounce sequence inside the
-// 2Gb area and resolve the symbol to this.  The bounce sequence is
-// simply a long jump instruction to the real location of the symbol.
-//
-// For data references, we're screwed.
-//
-typedef struct {
-    unsigned char jmp[8];  /* 6 byte instruction: jmpq *0x00000002(%rip) */
-    void *addr;
-} x86_64_bounce;
-
-#define X86_64_BB_SIZE 1024
-
-static x86_64_bounce *x86_64_bounce_buffer = NULL;
-static nat x86_64_bb_next_off;
-
-static void*
-x86_64_high_symbol( char *lbl, void *addr )
-{
-    x86_64_bounce *bounce;
-
-    if ( x86_64_bounce_buffer == NULL || 
-	 x86_64_bb_next_off >= X86_64_BB_SIZE ) {
-	x86_64_bounce_buffer = 
-	    mmap(NULL, X86_64_BB_SIZE * sizeof(x86_64_bounce), 
-		 PROT_EXEC|PROT_READ|PROT_WRITE, 
-		 MAP_PRIVATE|MAP_32BIT|MAP_ANONYMOUS, -1, 0);
-	if (x86_64_bounce_buffer == MAP_FAILED) {
-	    barf("x86_64_high_symbol: mmap failed");
-	}
-	x86_64_bb_next_off = 0;
-    }
-    bounce = &x86_64_bounce_buffer[x86_64_bb_next_off];
-    bounce->jmp[0] = 0xff;
-    bounce->jmp[1] = 0x25;
-    bounce->jmp[2] = 0x02;
-    bounce->jmp[3] = 0x00;
-    bounce->jmp[4] = 0x00;
-    bounce->jmp[5] = 0x00;
-    bounce->addr = addr;
-    x86_64_bb_next_off++;
-
-    IF_DEBUG(linker, debugBelch("x86_64: allocated bounce entry for %s->%p at %p\n",
-				lbl, addr, bounce));
-
-    insertStrHashTable(symhash, lbl, bounce);
-    return bounce;
-}
-#endif
-
-
-/*
- * Generic ELF functions
- */
-
-static char *
-findElfSection ( void* objImage, Elf_Word sh_type )
-{
-   char* ehdrC = (char*)objImage;
-   Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
-   Elf_Shdr* shdr = (Elf_Shdr*)(ehdrC + ehdr->e_shoff);
-   char* sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
-   char* ptr = NULL;
-   int i;
-
-   for (i = 0; i < ehdr->e_shnum; i++) {
-      if (shdr[i].sh_type == sh_type
-          /* Ignore the section header's string table. */
-          && i != ehdr->e_shstrndx
-	  /* Ignore string tables named .stabstr, as they contain
-             debugging info. */
-          && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
-         ) {
-         ptr = ehdrC + shdr[i].sh_offset;
-         break;
-      }
-   }
-   return ptr;
-}
-
-#if defined(ia64_HOST_ARCH)
-static Elf_Addr
-findElfSegment ( void* objImage, Elf_Addr vaddr )
-{
-   char* ehdrC = (char*)objImage;
-   Elf_Ehdr* ehdr = (Elf_Ehdr*)ehdrC;
-   Elf_Phdr* phdr = (Elf_Phdr*)(ehdrC + ehdr->e_phoff);
-   Elf_Addr segaddr = 0;
-   int i;
-
-   for (i = 0; i < ehdr->e_phnum; i++) {
-      segaddr = phdr[i].p_vaddr;
-      if ((vaddr >= segaddr) && (vaddr < segaddr + phdr[i].p_memsz))
-	      break;
-   }
-   return segaddr;
-}
-#endif
-
-static int
-ocVerifyImage_ELF ( ObjectCode* oc )
-{
-   Elf_Shdr* shdr;
-   Elf_Sym*  stab;
-   int i, j, nent, nstrtab, nsymtabs;
-   char* sh_strtab;
-   char* strtab;
-
-   char*     ehdrC = (char*)(oc->image);
-   Elf_Ehdr* ehdr  = (Elf_Ehdr*)ehdrC;
-
-   if (ehdr->e_ident[EI_MAG0] != ELFMAG0 ||
-       ehdr->e_ident[EI_MAG1] != ELFMAG1 ||
-       ehdr->e_ident[EI_MAG2] != ELFMAG2 ||
-       ehdr->e_ident[EI_MAG3] != ELFMAG3) {
-      errorBelch("%s: not an ELF object", oc->fileName);
-      return 0;
-   }
-
-   if (ehdr->e_ident[EI_CLASS] != ELFCLASS) {
-      errorBelch("%s: unsupported ELF format", oc->fileName);
-      return 0;
-   }
-
-   if (ehdr->e_ident[EI_DATA] == ELFDATA2LSB) {
-       IF_DEBUG(linker,debugBelch( "Is little-endian\n" ));
-   } else
-   if (ehdr->e_ident[EI_DATA] == ELFDATA2MSB) {
-       IF_DEBUG(linker,debugBelch( "Is big-endian\n" ));
-   } else {
-       errorBelch("%s: unknown endiannness", oc->fileName);
-       return 0;
-   }
-
-   if (ehdr->e_type != ET_REL) {
-      errorBelch("%s: not a relocatable object (.o) file", oc->fileName);
-      return 0;
-   }
-   IF_DEBUG(linker, debugBelch( "Is a relocatable object (.o) file\n" ));
-
-   IF_DEBUG(linker,debugBelch( "Architecture is " ));
-   switch (ehdr->e_machine) {
-      case EM_386:   IF_DEBUG(linker,debugBelch( "x86" )); break;
-      case EM_SPARC: IF_DEBUG(linker,debugBelch( "sparc" )); break;
-#ifdef EM_IA_64
-      case EM_IA_64: IF_DEBUG(linker,debugBelch( "ia64" )); break;
-#endif
-      case EM_PPC:   IF_DEBUG(linker,debugBelch( "powerpc32" )); break;
-#ifdef EM_X86_64
-      case EM_X86_64: IF_DEBUG(linker,debugBelch( "x86_64" )); break;
-#endif
-      default:       IF_DEBUG(linker,debugBelch( "unknown" ));
-                     errorBelch("%s: unknown architecture", oc->fileName);
-                     return 0;
-   }
-
-   IF_DEBUG(linker,debugBelch(
-             "\nSection header table: start %ld, n_entries %d, ent_size %d\n",
-             (long)ehdr->e_shoff, ehdr->e_shnum, ehdr->e_shentsize  ));
-
-   ASSERT (ehdr->e_shentsize == sizeof(Elf_Shdr));
-
-   shdr = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
-
-   if (ehdr->e_shstrndx == SHN_UNDEF) {
-      errorBelch("%s: no section header string table", oc->fileName);
-      return 0;
-   } else {
-      IF_DEBUG(linker,debugBelch( "Section header string table is section %d\n",
-                          ehdr->e_shstrndx));
-      sh_strtab = ehdrC + shdr[ehdr->e_shstrndx].sh_offset;
-   }
-
-   for (i = 0; i < ehdr->e_shnum; i++) {
-      IF_DEBUG(linker,debugBelch("%2d:  ", i ));
-      IF_DEBUG(linker,debugBelch("type=%2d  ", (int)shdr[i].sh_type ));
-      IF_DEBUG(linker,debugBelch("size=%4d  ", (int)shdr[i].sh_size ));
-      IF_DEBUG(linker,debugBelch("offs=%4d  ", (int)shdr[i].sh_offset ));
-      IF_DEBUG(linker,debugBelch("  (%p .. %p)  ",
-               ehdrC + shdr[i].sh_offset,
-		      ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1));
-
-      if (shdr[i].sh_type == SHT_REL) {
-	  IF_DEBUG(linker,debugBelch("Rel  " ));
-      } else if (shdr[i].sh_type == SHT_RELA) {
-	  IF_DEBUG(linker,debugBelch("RelA " ));
-      } else {
-	  IF_DEBUG(linker,debugBelch("     "));
-      }
-      if (sh_strtab) {
-	  IF_DEBUG(linker,debugBelch("sname=%s\n", sh_strtab + shdr[i].sh_name ));
-      }
-   }
-
-   IF_DEBUG(linker,debugBelch( "\nString tables" ));
-   strtab = NULL;
-   nstrtab = 0;
-   for (i = 0; i < ehdr->e_shnum; i++) {
-      if (shdr[i].sh_type == SHT_STRTAB
-          /* Ignore the section header's string table. */
-          && i != ehdr->e_shstrndx
-	  /* Ignore string tables named .stabstr, as they contain
-             debugging info. */
-          && 0 != memcmp(".stabstr", sh_strtab + shdr[i].sh_name, 8)
-         ) {
-         IF_DEBUG(linker,debugBelch("   section %d is a normal string table", i ));
-         strtab = ehdrC + shdr[i].sh_offset;
-         nstrtab++;
-      }
-   }
-   if (nstrtab != 1) {
-      errorBelch("%s: no string tables, or too many", oc->fileName);
-      return 0;
-   }
-
-   nsymtabs = 0;
-   IF_DEBUG(linker,debugBelch( "\nSymbol tables" ));
-   for (i = 0; i < ehdr->e_shnum; i++) {
-      if (shdr[i].sh_type != SHT_SYMTAB) continue;
-      IF_DEBUG(linker,debugBelch( "section %d is a symbol table\n", i ));
-      nsymtabs++;
-      stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
-      nent = shdr[i].sh_size / sizeof(Elf_Sym);
-      IF_DEBUG(linker,debugBelch( "   number of entries is apparently %d (%ld rem)\n",
-               nent,
-               (long)shdr[i].sh_size % sizeof(Elf_Sym)
-             ));
-      if (0 != shdr[i].sh_size % sizeof(Elf_Sym)) {
-         errorBelch("%s: non-integral number of symbol table entries", oc->fileName);
-         return 0;
-      }
-      for (j = 0; j < nent; j++) {
-         IF_DEBUG(linker,debugBelch("   %2d  ", j ));
-         IF_DEBUG(linker,debugBelch("  sec=%-5d  size=%-3d  val=%5p  ",
-                             (int)stab[j].st_shndx,
-                             (int)stab[j].st_size,
-                             (char*)stab[j].st_value ));
-
-         IF_DEBUG(linker,debugBelch("type=" ));
-         switch (ELF_ST_TYPE(stab[j].st_info)) {
-            case STT_NOTYPE:  IF_DEBUG(linker,debugBelch("notype " )); break;
-            case STT_OBJECT:  IF_DEBUG(linker,debugBelch("object " )); break;
-            case STT_FUNC  :  IF_DEBUG(linker,debugBelch("func   " )); break;
-            case STT_SECTION: IF_DEBUG(linker,debugBelch("section" )); break;
-            case STT_FILE:    IF_DEBUG(linker,debugBelch("file   " )); break;
-            default:          IF_DEBUG(linker,debugBelch("?      " )); break;
-         }
-         IF_DEBUG(linker,debugBelch("  " ));
-
-         IF_DEBUG(linker,debugBelch("bind=" ));
-         switch (ELF_ST_BIND(stab[j].st_info)) {
-            case STB_LOCAL :  IF_DEBUG(linker,debugBelch("local " )); break;
-            case STB_GLOBAL:  IF_DEBUG(linker,debugBelch("global" )); break;
-            case STB_WEAK  :  IF_DEBUG(linker,debugBelch("weak  " )); break;
-            default:          IF_DEBUG(linker,debugBelch("?     " )); break;
-         }
-         IF_DEBUG(linker,debugBelch("  " ));
-
-         IF_DEBUG(linker,debugBelch("name=%s\n", strtab + stab[j].st_name ));
-      }
-   }
-
-   if (nsymtabs == 0) {
-      errorBelch("%s: didn't find any symbol tables", oc->fileName);
-      return 0;
-   }
-
-   return 1;
-}
-
-static int getSectionKind_ELF( Elf_Shdr *hdr, int *is_bss )
-{
-    *is_bss = FALSE;
-
-    if (hdr->sh_type == SHT_PROGBITS
-	&& (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_EXECINSTR)) {
-	/* .text-style section */
-	return SECTIONKIND_CODE_OR_RODATA;
-    }
-
-    if (hdr->sh_type == SHT_PROGBITS
-	    && (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
-	    /* .data-style section */
-	    return SECTIONKIND_RWDATA;
-    }
-
-    if (hdr->sh_type == SHT_PROGBITS
-	&& (hdr->sh_flags & SHF_ALLOC) && !(hdr->sh_flags & SHF_WRITE)) {
-	/* .rodata-style section */
-	return SECTIONKIND_CODE_OR_RODATA;
-    }
-
-    if (hdr->sh_type == SHT_NOBITS
-	&& (hdr->sh_flags & SHF_ALLOC) && (hdr->sh_flags & SHF_WRITE)) {
-	/* .bss-style section */
-	*is_bss = TRUE;
-	return SECTIONKIND_RWDATA;
-    }
-
-    return SECTIONKIND_OTHER;
-}
-
-
-static int
-ocGetNames_ELF ( ObjectCode* oc )
-{
-   int i, j, k, nent;
-   Elf_Sym* stab;
-
-   char*     ehdrC    = (char*)(oc->image);
-   Elf_Ehdr* ehdr     = (Elf_Ehdr*)ehdrC;
-   char*     strtab   = findElfSection ( ehdrC, SHT_STRTAB );
-   Elf_Shdr* shdr     = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
-
-   ASSERT(symhash != NULL);
-
-   if (!strtab) {
-      errorBelch("%s: no strtab", oc->fileName);
-      return 0;
-   }
-
-   k = 0;
-   for (i = 0; i < ehdr->e_shnum; i++) {
-      /* Figure out what kind of section it is.  Logic derived from
-         Figure 1.14 ("Special Sections") of the ELF document
-         ("Portable Formats Specification, Version 1.1"). */
-      int         is_bss = FALSE;
-      SectionKind kind   = getSectionKind_ELF(&shdr[i], &is_bss);
-
-      if (is_bss && shdr[i].sh_size > 0) {
-         /* This is a non-empty .bss section.  Allocate zeroed space for
-            it, and set its .sh_offset field such that
-            ehdrC + .sh_offset == addr_of_zeroed_space.  */
-         char* zspace = stgCallocBytes(1, shdr[i].sh_size,
-                                       "ocGetNames_ELF(BSS)");
-         shdr[i].sh_offset = ((char*)zspace) - ((char*)ehdrC);
-	 /*
-         debugBelch("BSS section at 0x%x, size %d\n",
-                         zspace, shdr[i].sh_size);
-	 */
-      }
-
-      /* fill in the section info */
-      if (kind != SECTIONKIND_OTHER && shdr[i].sh_size > 0) {
-         addProddableBlock(oc, ehdrC + shdr[i].sh_offset, shdr[i].sh_size);
-         addSection(oc, kind, ehdrC + shdr[i].sh_offset,
-                        ehdrC + shdr[i].sh_offset + shdr[i].sh_size - 1);
-      }
-
-      if (shdr[i].sh_type != SHT_SYMTAB) continue;
-
-      /* copy stuff into this module's object symbol table */
-      stab = (Elf_Sym*) (ehdrC + shdr[i].sh_offset);
-      nent = shdr[i].sh_size / sizeof(Elf_Sym);
-
-      oc->n_symbols = nent;
-      oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
-                                   "ocGetNames_ELF(oc->symbols)");
-
-      for (j = 0; j < nent; j++) {
-
-         char  isLocal = FALSE; /* avoids uninit-var warning */
-         char* ad      = NULL;
-         char* nm      = strtab + stab[j].st_name;
-         int   secno   = stab[j].st_shndx;
-
-	 /* Figure out if we want to add it; if so, set ad to its
-            address.  Otherwise leave ad == NULL. */
-
-         if (secno == SHN_COMMON) {
-            isLocal = FALSE;
-            ad = stgCallocBytes(1, stab[j].st_size, "ocGetNames_ELF(COMMON)");
-	    /*
-            debugBelch("COMMON symbol, size %d name %s\n",
-                            stab[j].st_size, nm);
-	    */
-	    /* Pointless to do addProddableBlock() for this area,
-               since the linker should never poke around in it. */
-	 }
-         else
-         if ( ( ELF_ST_BIND(stab[j].st_info)==STB_GLOBAL
-                || ELF_ST_BIND(stab[j].st_info)==STB_LOCAL
-              )
-              /* and not an undefined symbol */
-              && stab[j].st_shndx != SHN_UNDEF
-	      /* and not in a "special section" */
-              && stab[j].st_shndx < SHN_LORESERVE
-              &&
-	      /* and it's a not a section or string table or anything silly */
-              ( ELF_ST_TYPE(stab[j].st_info)==STT_FUNC ||
-                ELF_ST_TYPE(stab[j].st_info)==STT_OBJECT ||
-                ELF_ST_TYPE(stab[j].st_info)==STT_NOTYPE
-              )
-            ) {
-	    /* Section 0 is the undefined section, hence > and not >=. */
-            ASSERT(secno > 0 && secno < ehdr->e_shnum);
-	    /*
-            if (shdr[secno].sh_type == SHT_NOBITS) {
-               debugBelch("   BSS symbol, size %d off %d name %s\n",
-                               stab[j].st_size, stab[j].st_value, nm);
-            }
-            */
-            ad = ehdrC + shdr[ secno ].sh_offset + stab[j].st_value;
-            if (ELF_ST_BIND(stab[j].st_info)==STB_LOCAL) {
-               isLocal = TRUE;
-            } else {
-#ifdef ELF_FUNCTION_DESC
-               /* dlsym() and the initialisation table both give us function
-		* descriptors, so to be consistent we store function descriptors
-		* in the symbol table */
-               if (ELF_ST_TYPE(stab[j].st_info) == STT_FUNC)
-                   ad = (char *)allocateFunctionDesc((Elf_Addr)ad);
-#endif
-               IF_DEBUG(linker,debugBelch( "addOTabName(GLOB): %10p  %s %s",
-                                      ad, oc->fileName, nm ));
-               isLocal = FALSE;
-            }
-         }
-
-         /* And the decision is ... */
-
-         if (ad != NULL) {
-            ASSERT(nm != NULL);
-	    oc->symbols[j] = nm;
-            /* Acquire! */
-            if (isLocal) {
-               /* Ignore entirely. */
-            } else {
-               ghciInsertStrHashTable(oc->fileName, symhash, nm, ad);
-            }
-         } else {
-            /* Skip. */
-            IF_DEBUG(linker,debugBelch( "skipping `%s'\n",
-                                   strtab + stab[j].st_name ));
-            /*
-            debugBelch(
-                    "skipping   bind = %d,  type = %d,  shndx = %d   `%s'\n",
-                    (int)ELF_ST_BIND(stab[j].st_info),
-                    (int)ELF_ST_TYPE(stab[j].st_info),
-                    (int)stab[j].st_shndx,
-                    strtab + stab[j].st_name
-                   );
-            */
-            oc->symbols[j] = NULL;
-         }
-
-      }
-   }
-
-   return 1;
-}
-
-/* Do ELF relocations which lack an explicit addend.  All x86-linux
-   relocations appear to be of this form. */
-static int
-do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC,
-                         Elf_Shdr* shdr, int shnum,
-                         Elf_Sym*  stab, char* strtab )
-{
-   int j;
-   char *symbol;
-   Elf_Word* targ;
-   Elf_Rel*  rtab = (Elf_Rel*) (ehdrC + shdr[shnum].sh_offset);
-   int         nent = shdr[shnum].sh_size / sizeof(Elf_Rel);
-   int target_shndx = shdr[shnum].sh_info;
-   int symtab_shndx = shdr[shnum].sh_link;
-
-   stab  = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
-   targ  = (Elf_Word*)(ehdrC + shdr[ target_shndx ].sh_offset);
-   IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
-                          target_shndx, symtab_shndx ));
-
-   /* Skip sections that we're not interested in. */
-   {
-       int is_bss;
-       SectionKind kind = getSectionKind_ELF(&shdr[target_shndx], &is_bss);
-       if (kind == SECTIONKIND_OTHER) {
-	   IF_DEBUG(linker,debugBelch( "skipping (target section not loaded)"));
-	   return 1;
-       }
-   }
-
-   for (j = 0; j < nent; j++) {
-      Elf_Addr offset = rtab[j].r_offset;
-      Elf_Addr info   = rtab[j].r_info;
-
-      Elf_Addr  P  = ((Elf_Addr)targ) + offset;
-      Elf_Word* pP = (Elf_Word*)P;
-      Elf_Addr  A  = *pP;
-      Elf_Addr  S;
-      void*     S_tmp;
-      Elf_Addr  value;
-
-      IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p)",
-                             j, (void*)offset, (void*)info ));
-      if (!info) {
-         IF_DEBUG(linker,debugBelch( " ZERO" ));
-         S = 0;
-      } else {
-         Elf_Sym sym = stab[ELF_R_SYM(info)];
-	 /* First see if it is a local symbol. */
-         if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
-            /* Yes, so we can get the address directly from the ELF symbol
-               table. */
-            symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
-            S = (Elf_Addr)
-                (ehdrC + shdr[ sym.st_shndx ].sh_offset
-                       + stab[ELF_R_SYM(info)].st_value);
-
-	 } else {
-            /* No, so look up the name in our global table. */
-            symbol = strtab + sym.st_name;
-            S_tmp = lookupSymbol( symbol );
-            S = (Elf_Addr)S_tmp;
-	 }
-         if (!S) {
-            errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
-	    return 0;
-         }
-         IF_DEBUG(linker,debugBelch( "`%s' resolves to %p\n", symbol, (void*)S ));
-      }
-
-      IF_DEBUG(linker,debugBelch( "Reloc: P = %p   S = %p   A = %p\n",
-			     (void*)P, (void*)S, (void*)A ));
-      checkProddableBlock ( oc, pP );
-
-      value = S + A;
-
-      switch (ELF_R_TYPE(info)) {
-#        ifdef i386_HOST_ARCH
-         case R_386_32:   *pP = value;     break;
-         case R_386_PC32: *pP = value - P; break;
-#        endif
-         default:
-            errorBelch("%s: unhandled ELF relocation(Rel) type %lu\n",
-		  oc->fileName, (lnat)ELF_R_TYPE(info));
-            return 0;
-      }
-
-   }
-   return 1;
-}
-
-/* Do ELF relocations for which explicit addends are supplied.
-   sparc-solaris relocations appear to be of this form. */
-static int
-do_Elf_Rela_relocations ( ObjectCode* oc, char* ehdrC,
-                          Elf_Shdr* shdr, int shnum,
-                          Elf_Sym*  stab, char* strtab )
-{
-   int j;
-   char *symbol = NULL;
-   Elf_Addr targ;
-   Elf_Rela* rtab = (Elf_Rela*) (ehdrC + shdr[shnum].sh_offset);
-   int         nent = shdr[shnum].sh_size / sizeof(Elf_Rela);
-   int target_shndx = shdr[shnum].sh_info;
-   int symtab_shndx = shdr[shnum].sh_link;
-
-   stab  = (Elf_Sym*) (ehdrC + shdr[ symtab_shndx ].sh_offset);
-   targ  = (Elf_Addr) (ehdrC + shdr[ target_shndx ].sh_offset);
-   IF_DEBUG(linker,debugBelch( "relocations for section %d using symtab %d\n",
-                          target_shndx, symtab_shndx ));
-
-   for (j = 0; j < nent; j++) {
-#if defined(DEBUG) || defined(sparc_HOST_ARCH) || defined(ia64_HOST_ARCH) || defined(powerpc_HOST_ARCH) || defined(x86_64_HOST_ARCH)
-      /* This #ifdef only serves to avoid unused-var warnings. */
-      Elf_Addr  offset = rtab[j].r_offset;
-      Elf_Addr  P      = targ + offset;
-#endif
-      Elf_Addr  info   = rtab[j].r_info;
-      Elf_Addr  A      = rtab[j].r_addend;
-      Elf_Addr  S;
-      void*     S_tmp;
-      Elf_Addr  value;
-#     if defined(sparc_HOST_ARCH)
-      Elf_Word* pP = (Elf_Word*)P;
-      Elf_Word  w1, w2;
-#     elif defined(ia64_HOST_ARCH)
-      Elf64_Xword *pP = (Elf64_Xword *)P;
-      Elf_Addr addr;
-#     elif defined(powerpc_HOST_ARCH)
-      Elf_Sword delta;
-#     endif
-
-      IF_DEBUG(linker,debugBelch( "Rel entry %3d is raw(%6p %6p %6p)   ",
-                             j, (void*)offset, (void*)info,
-                                (void*)A ));
-      if (!info) {
-         IF_DEBUG(linker,debugBelch( " ZERO" ));
-         S = 0;
-      } else {
-         Elf_Sym sym = stab[ELF_R_SYM(info)];
-	 /* First see if it is a local symbol. */
-         if (ELF_ST_BIND(sym.st_info) == STB_LOCAL) {
-            /* Yes, so we can get the address directly from the ELF symbol
-               table. */
-            symbol = sym.st_name==0 ? "(noname)" : strtab+sym.st_name;
-            S = (Elf_Addr)
-                (ehdrC + shdr[ sym.st_shndx ].sh_offset
-                       + stab[ELF_R_SYM(info)].st_value);
-#ifdef ELF_FUNCTION_DESC
-	    /* Make a function descriptor for this function */
-            if (S && ELF_ST_TYPE(sym.st_info) == STT_FUNC) {
-               S = allocateFunctionDesc(S + A);
-       	       A = 0;
-            }
-#endif
-	 } else {
-            /* No, so look up the name in our global table. */
-            symbol = strtab + sym.st_name;
-            S_tmp = lookupSymbol( symbol );
-            S = (Elf_Addr)S_tmp;
-
-#ifdef ELF_FUNCTION_DESC
-	    /* If a function, already a function descriptor - we would
-	       have to copy it to add an offset. */
-            if (S && (ELF_ST_TYPE(sym.st_info) == STT_FUNC) && (A != 0))
-               errorBelch("%s: function %s with addend %p", oc->fileName, symbol, (void *)A);
-#endif
-	 }
-         if (!S) {
-	   errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
-	   return 0;
-         }
-         IF_DEBUG(linker,debugBelch( "`%s' resolves to %p", symbol, (void*)S ));
-      }
-
-      IF_DEBUG(linker,debugBelch("Reloc: P = %p   S = %p   A = %p\n",
-                                        (void*)P, (void*)S, (void*)A ));
-      /* checkProddableBlock ( oc, (void*)P ); */
-
-      value = S + A;
-
-      switch (ELF_R_TYPE(info)) {
-#        if defined(sparc_HOST_ARCH)
-         case R_SPARC_WDISP30:
-            w1 = *pP & 0xC0000000;
-            w2 = (Elf_Word)((value - P) >> 2);
-            ASSERT((w2 & 0xC0000000) == 0);
-            w1 |= w2;
-            *pP = w1;
-            break;
-         case R_SPARC_HI22:
-            w1 = *pP & 0xFFC00000;
-            w2 = (Elf_Word)(value >> 10);
-            ASSERT((w2 & 0xFFC00000) == 0);
-            w1 |= w2;
-            *pP = w1;
-            break;
-         case R_SPARC_LO10:
-            w1 = *pP & ~0x3FF;
-            w2 = (Elf_Word)(value & 0x3FF);
-            ASSERT((w2 & ~0x3FF) == 0);
-            w1 |= w2;
-            *pP = w1;
-            break;
-         /* According to the Sun documentation:
-            R_SPARC_UA32
-            This relocation type resembles R_SPARC_32, except it refers to an
-            unaligned word. That is, the word to be relocated must be treated
-            as four separate bytes with arbitrary alignment, not as a word
-            aligned according to the architecture requirements.
-
-            (JRS: which means that freeloading on the R_SPARC_32 case
-            is probably wrong, but hey ...)
-         */
-         case R_SPARC_UA32:
-         case R_SPARC_32:
-            w2 = (Elf_Word)value;
-            *pP = w2;
-            break;
-#        elif defined(ia64_HOST_ARCH)
-	 case R_IA64_DIR64LSB:
-	 case R_IA64_FPTR64LSB:
-	    *pP = value;
-	    break;
-	 case R_IA64_PCREL64LSB:
-	    *pP = value - P;
-	    break;
-	 case R_IA64_SEGREL64LSB:
-	    addr = findElfSegment(ehdrC, value);
-	    *pP = value - addr;
-	    break;
-	 case R_IA64_GPREL22:
-	    ia64_reloc_gprel22(P, value);
-	    break;
-	 case R_IA64_LTOFF22:
-	 case R_IA64_LTOFF22X:
-	 case R_IA64_LTOFF_FPTR22:
-	    addr = allocateGOTEntry(value);
-	    ia64_reloc_gprel22(P, addr);
-	    break;
-	 case R_IA64_PCREL21B:
-	    ia64_reloc_pcrel21(P, S, oc);
-	    break;
-	 case R_IA64_LDXMOV:
-	    /* This goes with R_IA64_LTOFF22X and points to the load to
-	     * convert into a move.  We don't implement relaxation. */
-	    break;
-#        elif defined(powerpc_HOST_ARCH)
-         case R_PPC_ADDR16_LO:
-            *(Elf32_Half*) P = value;
-            break;
-
-         case R_PPC_ADDR16_HI:
-            *(Elf32_Half*) P = value >> 16;
-            break;
- 
-         case R_PPC_ADDR16_HA:
-            *(Elf32_Half*) P = (value + 0x8000) >> 16;
-            break;
-
-         case R_PPC_ADDR32:
-            *(Elf32_Word *) P = value;
-            break;
-
-         case R_PPC_REL32:
-            *(Elf32_Word *) P = value - P;
-            break;
-
-         case R_PPC_REL24:
-            delta = value - P;
-
-            if( delta << 6 >> 6 != delta )
-            {
-               value = makeJumpIsland( oc, ELF_R_SYM(info), value );
-               delta = value - P;
-
-               if( value == 0 || delta << 6 >> 6 != delta )
-               {
-                  barf( "Unable to make ppcJumpIsland for #%d",
-                        ELF_R_SYM(info) );
-                  return 0;
-               }
-            }
-
-            *(Elf_Word *) P = (*(Elf_Word *) P & 0xfc000003)
-                                          | (delta & 0x3fffffc);
-            break;
-#        endif
-
-#if x86_64_HOST_ARCH
-      case R_X86_64_64:
-	  *(Elf64_Xword *)P = value;
-	  break;
-
-      case R_X86_64_PC32:
-      {
-	  StgInt64 off = value - P;
-	  if (off >= 0x7fffffffL || off < -0x80000000L) {
-	      barf("R_X86_64_PC32 relocation out of range: %s = %p",
-		   symbol, off);
-	  }
-	  *(Elf64_Word *)P = (Elf64_Word)off;
-	  break;
-      }
-
-      case R_X86_64_32:
-	  if (value >= 0x7fffffffL) {
-	      barf("R_X86_64_32 relocation out of range: %s = %p\n",
-		   symbol, value);
-	  }
-	  *(Elf64_Word *)P = (Elf64_Word)value;
-	  break;
-
-      case R_X86_64_32S:
-	  if ((StgInt64)value > 0x7fffffffL || (StgInt64)value < -0x80000000L) {
-	      barf("R_X86_64_32S relocation out of range: %s = %p\n",
-		   symbol, value);
-	  }
-	  *(Elf64_Sword *)P = (Elf64_Sword)value;
-	  break;
-#endif
-
-         default:
-            errorBelch("%s: unhandled ELF relocation(RelA) type %lu\n",
-		  oc->fileName, (lnat)ELF_R_TYPE(info));
-            return 0;
-      }
-
-   }
-   return 1;
-}
-
-static int
-ocResolve_ELF ( ObjectCode* oc )
-{
-   char *strtab;
-   int   shnum, ok;
-   Elf_Sym*  stab  = NULL;
-   char*     ehdrC = (char*)(oc->image);
-   Elf_Ehdr* ehdr  = (Elf_Ehdr*) ehdrC;
-   Elf_Shdr* shdr  = (Elf_Shdr*) (ehdrC + ehdr->e_shoff);
-
-   /* first find "the" symbol table */
-   stab = (Elf_Sym*) findElfSection ( ehdrC, SHT_SYMTAB );
-
-   /* also go find the string table */
-   strtab = findElfSection ( ehdrC, SHT_STRTAB );
-
-   if (stab == NULL || strtab == NULL) {
-      errorBelch("%s: can't find string or symbol table", oc->fileName);
-      return 0;
-   }
-
-   /* Process the relocation sections. */
-   for (shnum = 0; shnum < ehdr->e_shnum; shnum++) {
-      if (shdr[shnum].sh_type == SHT_REL) {
-         ok = do_Elf_Rel_relocations ( oc, ehdrC, shdr,
-                                       shnum, stab, strtab );
-         if (!ok) return ok;
-      }
-      else
-      if (shdr[shnum].sh_type == SHT_RELA) {
-         ok = do_Elf_Rela_relocations ( oc, ehdrC, shdr,
-                                        shnum, stab, strtab );
-         if (!ok) return ok;
-      }
-   }
-
-   /* Free the local symbol table; we won't need it again. */
-   freeHashTable(oc->lochash, NULL);
-   oc->lochash = NULL;
-
-#if defined(powerpc_HOST_ARCH)
-   ocFlushInstructionCache( oc );
-#endif
-
-   return 1;
-}
-
-/*
- * IA64 specifics
- * Instructions are 41 bits long, packed into 128 bit bundles with a 5-bit template
- * at the front.  The following utility functions pack and unpack instructions, and
- * take care of the most common relocations.
- */
-
-#ifdef ia64_HOST_ARCH
-
-static Elf64_Xword
-ia64_extract_instruction(Elf64_Xword *target)
-{
-   Elf64_Xword w1, w2;
-   int slot = (Elf_Addr)target & 3;
-   target = (Elf_Addr)target & ~3;
-
-   w1 = *target;
-   w2 = *(target+1);
-
-   switch (slot)
-   {
-      case 0:
-         return ((w1 >> 5) & 0x1ffffffffff);
-      case 1:
-         return (w1 >> 46) | ((w2 & 0x7fffff) << 18);
-      case 2:
-         return (w2 >> 23);
-      default:
-         barf("ia64_extract_instruction: invalid slot %p", target);
-   }
-}
-
-static void
-ia64_deposit_instruction(Elf64_Xword *target, Elf64_Xword value)
-{
-   int slot = (Elf_Addr)target & 3;
-   target = (Elf_Addr)target & ~3;
-
-   switch (slot)
-   {
-      case 0:
-         *target |= value << 5;
-         break;
-      case 1:
-         *target |= value << 46;
-         *(target+1) |= value >> 18;
-         break;
-      case 2:
-         *(target+1) |= value << 23;
-         break;
-   }
-}
-
-static void
-ia64_reloc_gprel22(Elf_Addr target, Elf_Addr value)
-{
-   Elf64_Xword instruction;
-   Elf64_Sxword rel_value;
-
-   rel_value = value - gp_val;
-   if ((rel_value > 0x1fffff) || (rel_value < -0x1fffff))
-      barf("GP-relative data out of range (address = 0x%lx, gp = 0x%lx)", value, gp_val);
-
-   instruction = ia64_extract_instruction((Elf64_Xword *)target);
-   instruction |= (((rel_value >> 0) & 0x07f) << 13)		/* imm7b */
-		    | (((rel_value >> 7) & 0x1ff) << 27)	/* imm9d */
-		    | (((rel_value >> 16) & 0x01f) << 22)	/* imm5c */
-		    | ((Elf64_Xword)(rel_value < 0) << 36);	/* s */
-   ia64_deposit_instruction((Elf64_Xword *)target, instruction);
-}
-
-static void
-ia64_reloc_pcrel21(Elf_Addr target, Elf_Addr value, ObjectCode *oc)
-{
-   Elf64_Xword instruction;
-   Elf64_Sxword rel_value;
-   Elf_Addr entry;
-
-   entry = allocatePLTEntry(value, oc);
-
-   rel_value = (entry >> 4) - (target >> 4);
-   if ((rel_value > 0xfffff) || (rel_value < -0xfffff))
-      barf("PLT entry too far away (entry = 0x%lx, target = 0x%lx)", entry, target);
-
-   instruction = ia64_extract_instruction((Elf64_Xword *)target);
-   instruction |= ((rel_value & 0xfffff) << 13) 		/* imm20b */
-	    	    | ((Elf64_Xword)(rel_value < 0) << 36);	/* s */
-   ia64_deposit_instruction((Elf64_Xword *)target, instruction);
-}
-
-#endif /* ia64 */
-
-/*
- * PowerPC ELF specifics
- */
-
-#ifdef powerpc_HOST_ARCH
-
-static int ocAllocateJumpIslands_ELF( ObjectCode *oc )
-{
-  Elf_Ehdr *ehdr;
-  Elf_Shdr* shdr;
-  int i;
-
-  ehdr = (Elf_Ehdr *) oc->image;
-  shdr = (Elf_Shdr *) ( ((char *)oc->image) + ehdr->e_shoff );
-
-  for( i = 0; i < ehdr->e_shnum; i++ )
-    if( shdr[i].sh_type == SHT_SYMTAB )
-      break;
-
-  if( i == ehdr->e_shnum )
-  {
-    errorBelch( "This ELF file contains no symtab" );
-    return 0;
-  }
-
-  if( shdr[i].sh_entsize != sizeof( Elf_Sym ) )
-  {
-    errorBelch( "The entry size (%d) of the symtab isn't %d\n",
-      shdr[i].sh_entsize, sizeof( Elf_Sym ) );
-    
-    return 0;
-  }
-
-  return ocAllocateJumpIslands( oc, shdr[i].sh_size / sizeof( Elf_Sym ), 0 );
-}
-
-#endif /* powerpc */
-
-#endif /* ELF */
-
-/* --------------------------------------------------------------------------
- * Mach-O specifics
- * ------------------------------------------------------------------------*/
-
-#if defined(OBJFORMAT_MACHO)
-
-/*
-  Support for MachO linking on Darwin/MacOS X
-  by Wolfgang Thaller (wolfgang.thaller@gmx.net)
-
-  I hereby formally apologize for the hackish nature of this code.
-  Things that need to be done:
-  *) implement ocVerifyImage_MachO
-  *) add still more sanity checks.
-*/
-
-#ifdef powerpc_HOST_ARCH
-static int ocAllocateJumpIslands_MachO(ObjectCode* oc)
-{
-    struct mach_header *header = (struct mach_header *) oc->image;
-    struct load_command *lc = (struct load_command *) (header + 1);
-    unsigned i;
-
-    for( i = 0; i < header->ncmds; i++ )
-    {   
-        if( lc->cmd == LC_SYMTAB )
-        {
-                // Find out the first and last undefined external
-                // symbol, so we don't have to allocate too many
-                // jump islands.
-            struct symtab_command *symLC = (struct symtab_command *) lc;
-            unsigned min = symLC->nsyms, max = 0;
-            struct nlist *nlist =
-                symLC ? (struct nlist*) ((char*) oc->image + symLC->symoff)
-                      : NULL;
-            for(i=0;i<symLC->nsyms;i++)
-            {
-                if(nlist[i].n_type & N_STAB)
-                    ;
-                else if(nlist[i].n_type & N_EXT)
-                {
-                    if((nlist[i].n_type & N_TYPE) == N_UNDF
-                        && (nlist[i].n_value == 0))
-                    {
-                        if(i < min)
-                            min = i;
-                        if(i > max)
-                            max = i;
-                    }
-                }
-            }
-            if(max >= min)
-                return ocAllocateJumpIslands(oc, max - min + 1, min);
-
-            break;
-        }
-        
-        lc = (struct load_command *) ( ((char *)lc) + lc->cmdsize );
-    }
-    return ocAllocateJumpIslands(oc,0,0);
-}
-#endif
-
-static int ocVerifyImage_MachO(ObjectCode* oc STG_UNUSED)
-{
-    // FIXME: do some verifying here
-    return 1;
-}
-
-static int resolveImports(
-    ObjectCode* oc,
-    char *image,
-    struct symtab_command *symLC,
-    struct section *sect,    // ptr to lazy or non-lazy symbol pointer section
-    unsigned long *indirectSyms,
-    struct nlist *nlist)
-{
-    unsigned i;
-    size_t itemSize = 4;
-
-#if i386_HOST_ARCH
-    int isJumpTable = 0;
-    if(!strcmp(sect->sectname,"__jump_table"))
-    {
-        isJumpTable = 1;
-        itemSize = 5;
-        ASSERT(sect->reserved2 == itemSize);
-    }
-#endif
-
-    for(i=0; i*itemSize < sect->size;i++)
-    {
-	// according to otool, reserved1 contains the first index into the indirect symbol table
-	struct nlist *symbol = &nlist[indirectSyms[sect->reserved1+i]];
-	char *nm = image + symLC->stroff + symbol->n_un.n_strx;
-	void *addr = NULL;
-
-	if((symbol->n_type & N_TYPE) == N_UNDF
-	    && (symbol->n_type & N_EXT) && (symbol->n_value != 0))
-	    addr = (void*) (symbol->n_value);
-	else if((addr = lookupLocalSymbol(oc,nm)) != NULL)
-	    ;
-	else
-	    addr = lookupSymbol(nm);
-	if(!addr)
-	{
-	    errorBelch("\n%s: unknown symbol `%s'", oc->fileName, nm);
-	    return 0;
-	}
-	ASSERT(addr);
-
-#if i386_HOST_ARCH
-        if(isJumpTable)
-        {
-            checkProddableBlock(oc,image + sect->offset + i*itemSize);
-            *(image + sect->offset + i*itemSize) = 0xe9; // jmp
-            *(unsigned*)(image + sect->offset + i*itemSize + 1)
-                = (char*)addr - (image + sect->offset + i*itemSize + 5);
-        }
-        else
-#endif
-	{
-	    checkProddableBlock(oc,((void**)(image + sect->offset)) + i);
-	    ((void**)(image + sect->offset))[i] = addr;
-        }
-    }
-
-    return 1;
-}
-
-static unsigned long relocateAddress(
-    ObjectCode* oc,
-    int nSections,
-    struct section* sections,
-    unsigned long address)
-{
-    int i;
-    for(i = 0; i < nSections; i++)
-    {
-        if(sections[i].addr <= address
-            && address < sections[i].addr + sections[i].size)
-        {
-            return (unsigned long)oc->image
-                    + sections[i].offset + address - sections[i].addr;
-        }
-    }
-    barf("Invalid Mach-O file:"
-         "Address out of bounds while relocating object file");
-    return 0;
-}
-
-static int relocateSection(
-    ObjectCode* oc,
-    char *image,
-    struct symtab_command *symLC, struct nlist *nlist,
-    int nSections, struct section* sections, struct section *sect)
-{
-    struct relocation_info *relocs;
-    int i,n;
-
-    if(!strcmp(sect->sectname,"__la_symbol_ptr"))
-	return 1;
-    else if(!strcmp(sect->sectname,"__nl_symbol_ptr"))
-	return 1;
-    else if(!strcmp(sect->sectname,"__la_sym_ptr2"))
-	return 1;
-    else if(!strcmp(sect->sectname,"__la_sym_ptr3"))
-	return 1;
-
-    n = sect->nreloc;
-    relocs = (struct relocation_info*) (image + sect->reloff);
-
-    for(i=0;i<n;i++)
-    {
-	if(relocs[i].r_address & R_SCATTERED)
-	{
-	    struct scattered_relocation_info *scat =
-		(struct scattered_relocation_info*) &relocs[i];
-
-	    if(!scat->r_pcrel)
-	    {
-		if(scat->r_length == 2)
-		{
-		    unsigned long word = 0;
-		    unsigned long* wordPtr = (unsigned long*) (image + sect->offset + scat->r_address);
-		    checkProddableBlock(oc,wordPtr);
-
-                    // Note on relocation types:
-                    // i386 uses the GENERIC_RELOC_* types,
-                    // while ppc uses special PPC_RELOC_* types.
-                    // *_RELOC_VANILLA and *_RELOC_PAIR have the same value
-                    // in both cases, all others are different.
-                    // Therefore, we use GENERIC_RELOC_VANILLA
-                    // and GENERIC_RELOC_PAIR instead of the PPC variants,
-                    // and use #ifdefs for the other types.
-                    
-		    // Step 1: Figure out what the relocated value should be
-		    if(scat->r_type == GENERIC_RELOC_VANILLA)
-		    {
-                        word = *wordPtr + (unsigned long) relocateAddress(
-                                                                oc,
-                                                                nSections,
-                                                                sections,
-                                                                scat->r_value)
-                                        - scat->r_value;
-		    }
-#ifdef powerpc_HOST_ARCH
-		    else if(scat->r_type == PPC_RELOC_SECTDIFF
-		        || scat->r_type == PPC_RELOC_LO16_SECTDIFF
-		        || scat->r_type == PPC_RELOC_HI16_SECTDIFF
-		        || scat->r_type == PPC_RELOC_HA16_SECTDIFF)
-#else
-                    else if(scat->r_type == GENERIC_RELOC_SECTDIFF)
-#endif
-		    {
-		        struct scattered_relocation_info *pair =
-		                (struct scattered_relocation_info*) &relocs[i+1];
-
-		        if(!pair->r_scattered || pair->r_type != GENERIC_RELOC_PAIR)
-		            barf("Invalid Mach-O file: "
-		                 "RELOC_*_SECTDIFF not followed by RELOC_PAIR");
-
-		        word = (unsigned long)
-		               (relocateAddress(oc, nSections, sections, scat->r_value)
-		              - relocateAddress(oc, nSections, sections, pair->r_value));
-		        i++;
-		    }
-#ifdef powerpc_HOST_ARCH
-		    else if(scat->r_type == PPC_RELOC_HI16
-                         || scat->r_type == PPC_RELOC_LO16
-                         || scat->r_type == PPC_RELOC_HA16
-                         || scat->r_type == PPC_RELOC_LO14)
-                    {   // these are generated by label+offset things
-		        struct relocation_info *pair = &relocs[i+1];
-                        if((pair->r_address & R_SCATTERED) || pair->r_type != PPC_RELOC_PAIR)
-		            barf("Invalid Mach-O file: "
-		                 "PPC_RELOC_* not followed by PPC_RELOC_PAIR");
-                        
-                        if(scat->r_type == PPC_RELOC_LO16)
-                        {
-                            word = ((unsigned short*) wordPtr)[1];
-                            word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
-                        }
-                        else if(scat->r_type == PPC_RELOC_LO14)
-                        {
-                            barf("Unsupported Relocation: PPC_RELOC_LO14");
-                            word = ((unsigned short*) wordPtr)[1] & 0xFFFC;
-                            word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
-                        }
-                        else if(scat->r_type == PPC_RELOC_HI16)
-                        {
-                            word = ((unsigned short*) wordPtr)[1] << 16;
-                            word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
-                        }
-                        else if(scat->r_type == PPC_RELOC_HA16)
-                        {
-                            word = ((unsigned short*) wordPtr)[1] << 16;
-                            word += ((short)relocs[i+1].r_address & (short)0xFFFF);
-                        }
-                       
-                        
-                        word += (unsigned long) relocateAddress(oc, nSections, sections, scat->r_value)
-                                                - scat->r_value;
-                        
-                        i++;
-                    }
- #endif
-                    else
-		        continue;  // ignore the others
-
-#ifdef powerpc_HOST_ARCH
-                    if(scat->r_type == GENERIC_RELOC_VANILLA
-                        || scat->r_type == PPC_RELOC_SECTDIFF)
-#else
-                    if(scat->r_type == GENERIC_RELOC_VANILLA
-                        || scat->r_type == GENERIC_RELOC_SECTDIFF)
-#endif
-                    {
-                        *wordPtr = word;
-                    }
-#ifdef powerpc_HOST_ARCH
-                    else if(scat->r_type == PPC_RELOC_LO16_SECTDIFF || scat->r_type == PPC_RELOC_LO16)
-                    {
-                        ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
-                    }
-                    else if(scat->r_type == PPC_RELOC_HI16_SECTDIFF || scat->r_type == PPC_RELOC_HI16)
-                    {
-                        ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
-                    }
-                    else if(scat->r_type == PPC_RELOC_HA16_SECTDIFF || scat->r_type == PPC_RELOC_HA16)
-                    {
-                        ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
-                            + ((word & (1<<15)) ? 1 : 0);
-                    }
-#endif
-		}
-	    }
-
-	    continue; // FIXME: I hope it's OK to ignore all the others.
-	}
-	else
-	{
-	    struct relocation_info *reloc = &relocs[i];
-	    if(reloc->r_pcrel && !reloc->r_extern)
-		continue;
-
-	    if(reloc->r_length == 2)
-	    {
-		unsigned long word = 0;
-#ifdef powerpc_HOST_ARCH
-                unsigned long jumpIsland = 0;
-                long offsetToJumpIsland = 0xBADBAD42; // initialise to bad value
-                                                      // to avoid warning and to catch
-                                                      // bugs.
-#endif
-
-		unsigned long* wordPtr = (unsigned long*) (image + sect->offset + reloc->r_address);
-		checkProddableBlock(oc,wordPtr);
-
-		if(reloc->r_type == GENERIC_RELOC_VANILLA)
-		{
-		    word = *wordPtr;
-		}
-#ifdef powerpc_HOST_ARCH
-		else if(reloc->r_type == PPC_RELOC_LO16)
-		{
-		    word = ((unsigned short*) wordPtr)[1];
-		    word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF) << 16;
-		}
-		else if(reloc->r_type == PPC_RELOC_HI16)
-		{
-		    word = ((unsigned short*) wordPtr)[1] << 16;
-		    word |= ((unsigned long) relocs[i+1].r_address & 0xFFFF);
-		}
-		else if(reloc->r_type == PPC_RELOC_HA16)
-		{
-		    word = ((unsigned short*) wordPtr)[1] << 16;
-		    word += ((short)relocs[i+1].r_address & (short)0xFFFF);
-		}
-		else if(reloc->r_type == PPC_RELOC_BR24)
-		{
-		    word = *wordPtr;
-		    word = (word & 0x03FFFFFC) | ((word & 0x02000000) ? 0xFC000000 : 0);
-		}
-#endif
-
-		if(!reloc->r_extern)
-		{
-		    long delta =
-			sections[reloc->r_symbolnum-1].offset
-			- sections[reloc->r_symbolnum-1].addr
-			+ ((long) image);
-
-		    word += delta;
-		}
-		else
-		{
-		    struct nlist *symbol = &nlist[reloc->r_symbolnum];
-		    char *nm = image + symLC->stroff + symbol->n_un.n_strx;
-		    void *symbolAddress = lookupSymbol(nm);
-		    if(!symbolAddress)
-		    {
-			errorBelch("\nunknown symbol `%s'", nm);
-			return 0;
-		    }
-
-		    if(reloc->r_pcrel)
-                    {  
-#ifdef powerpc_HOST_ARCH
-                            // In the .o file, this should be a relative jump to NULL
-                            // and we'll change it to a relative jump to the symbol
-                        ASSERT(-word == reloc->r_address);
-                        jumpIsland = makeJumpIsland(oc,reloc->r_symbolnum,(unsigned long) symbolAddress);
-                        if(jumpIsland != 0)
-                        {
-                            offsetToJumpIsland = word + jumpIsland
-                                - (((long)image) + sect->offset - sect->addr);
-                        }
-#endif
-			word += (unsigned long) symbolAddress
-                                - (((long)image) + sect->offset - sect->addr);
-                    }
-                    else
-                    {
-                        word += (unsigned long) symbolAddress;
-                    }
-		}
-
-		if(reloc->r_type == GENERIC_RELOC_VANILLA)
-		{
-		    *wordPtr = word;
-		    continue;
-		}
-#ifdef powerpc_HOST_ARCH
-		else if(reloc->r_type == PPC_RELOC_LO16)
-		{
-		    ((unsigned short*) wordPtr)[1] = word & 0xFFFF;
-		    i++; continue;
-		}
-		else if(reloc->r_type == PPC_RELOC_HI16)
-		{
-		    ((unsigned short*) wordPtr)[1] = (word >> 16) & 0xFFFF;
-		    i++; continue;
-		}
-		else if(reloc->r_type == PPC_RELOC_HA16)
-		{
-		    ((unsigned short*) wordPtr)[1] = ((word >> 16) & 0xFFFF)
-			+ ((word & (1<<15)) ? 1 : 0);
-		    i++; continue;
-		}
-		else if(reloc->r_type == PPC_RELOC_BR24)
-		{
-                    if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
-                    {
-                        // The branch offset is too large.
-                        // Therefore, we try to use a jump island.
-                        if(jumpIsland == 0)
-                        {
-                            barf("unconditional relative branch out of range: "
-                                 "no jump island available");
-                        }
-                        
-                        word = offsetToJumpIsland;
-                        if((long)word > (long)0x01FFFFFF || (long)word < (long)0xFFE00000)
-                            barf("unconditional relative branch out of range: "
-                                 "jump island out of range");
-                    }
-		    *wordPtr = (*wordPtr & 0xFC000003) | (word & 0x03FFFFFC);
-		    continue;
-		}
-#endif
-            }
-	    barf("\nunknown relocation %d",reloc->r_type);
-	    return 0;
-	}
-    }
-    return 1;
-}
-
-static int ocGetNames_MachO(ObjectCode* oc)
-{
-    char *image = (char*) oc->image;
-    struct mach_header *header = (struct mach_header*) image;
-    struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
-    unsigned i,curSymbol = 0;
-    struct segment_command *segLC = NULL;
-    struct section *sections;
-    struct symtab_command *symLC = NULL;
-    struct nlist *nlist;
-    unsigned long commonSize = 0;
-    char    *commonStorage = NULL;
-    unsigned long commonCounter;
-
-    for(i=0;i<header->ncmds;i++)
-    {
-	if(lc->cmd == LC_SEGMENT)
-	    segLC = (struct segment_command*) lc;
-	else if(lc->cmd == LC_SYMTAB)
-	    symLC = (struct symtab_command*) lc;
-	lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
-    }
-
-    sections = (struct section*) (segLC+1);
-    nlist = symLC ? (struct nlist*) (image + symLC->symoff)
-                  : NULL;
-
-    for(i=0;i<segLC->nsects;i++)
-    {
-        if(sections[i].size == 0)
-            continue;
-
-        if((sections[i].flags & SECTION_TYPE) == S_ZEROFILL)
-        {
-            char * zeroFillArea = stgCallocBytes(1,sections[i].size,
-                                      "ocGetNames_MachO(common symbols)");
-            sections[i].offset = zeroFillArea - image;
-        }
-
-	if(!strcmp(sections[i].sectname,"__text"))
-	    addSection(oc, SECTIONKIND_CODE_OR_RODATA,
-		(void*) (image + sections[i].offset),
-		(void*) (image + sections[i].offset + sections[i].size));
-	else if(!strcmp(sections[i].sectname,"__const"))
-	    addSection(oc, SECTIONKIND_RWDATA,
-		(void*) (image + sections[i].offset),
-		(void*) (image + sections[i].offset + sections[i].size));
-	else if(!strcmp(sections[i].sectname,"__data"))
-	    addSection(oc, SECTIONKIND_RWDATA,
-		(void*) (image + sections[i].offset),
-		(void*) (image + sections[i].offset + sections[i].size));
-	else if(!strcmp(sections[i].sectname,"__bss")
-	        || !strcmp(sections[i].sectname,"__common"))
-	    addSection(oc, SECTIONKIND_RWDATA,
-		(void*) (image + sections[i].offset),
-		(void*) (image + sections[i].offset + sections[i].size));
-
-        addProddableBlock(oc, (void*) (image + sections[i].offset),
-                                        sections[i].size);
-    }
-
-	// count external symbols defined here
-    oc->n_symbols = 0;
-    if(symLC)
-    {
-        for(i=0;i<symLC->nsyms;i++)
-        {
-            if(nlist[i].n_type & N_STAB)
-                ;
-            else if(nlist[i].n_type & N_EXT)
-            {
-                if((nlist[i].n_type & N_TYPE) == N_UNDF
-                    && (nlist[i].n_value != 0))
-                {
-                    commonSize += nlist[i].n_value;
-                    oc->n_symbols++;
-                }
-                else if((nlist[i].n_type & N_TYPE) == N_SECT)
-                    oc->n_symbols++;
-            }
-        }
-    }
-    oc->symbols = stgMallocBytes(oc->n_symbols * sizeof(char*),
-				   "ocGetNames_MachO(oc->symbols)");
-
-    if(symLC)
-    {
-        for(i=0;i<symLC->nsyms;i++)
-        {
-            if(nlist[i].n_type & N_STAB)
-                ;
-            else if((nlist[i].n_type & N_TYPE) == N_SECT)
-            {
-                if(nlist[i].n_type & N_EXT)
-                {
-                    char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
-                    ghciInsertStrHashTable(oc->fileName, symhash, nm,
-                                            image
-                                            + sections[nlist[i].n_sect-1].offset
-                                            - sections[nlist[i].n_sect-1].addr
-                                            + nlist[i].n_value);
-                    oc->symbols[curSymbol++] = nm;
-                }
-                else
-                {
-                    char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
-                    ghciInsertStrHashTable(oc->fileName, oc->lochash, nm,
-                                            image
-                                            + sections[nlist[i].n_sect-1].offset
-                                            - sections[nlist[i].n_sect-1].addr
-                                            + nlist[i].n_value);
-                }
-            }
-        }
-    }
-
-    commonStorage = stgCallocBytes(1,commonSize,"ocGetNames_MachO(common symbols)");
-    commonCounter = (unsigned long)commonStorage;
-    if(symLC)
-    {
-        for(i=0;i<symLC->nsyms;i++)
-        {
-	    if((nlist[i].n_type & N_TYPE) == N_UNDF
-	            && (nlist[i].n_type & N_EXT) && (nlist[i].n_value != 0))
-	    {
-	        char *nm = image + symLC->stroff + nlist[i].n_un.n_strx;
-	        unsigned long sz = nlist[i].n_value;
-
-	        nlist[i].n_value = commonCounter;
-
-	        ghciInsertStrHashTable(oc->fileName, symhash, nm,
-	                               (void*)commonCounter);
-	        oc->symbols[curSymbol++] = nm;
-
-	        commonCounter += sz;
-	    }
-        }
-    }
-    return 1;
-}
-
-static int ocResolve_MachO(ObjectCode* oc)
-{
-    char *image = (char*) oc->image;
-    struct mach_header *header = (struct mach_header*) image;
-    struct load_command *lc = (struct load_command*) (image + sizeof(struct mach_header));
-    unsigned i;
-    struct segment_command *segLC = NULL;
-    struct section *sections;
-    struct symtab_command *symLC = NULL;
-    struct dysymtab_command *dsymLC = NULL;
-    struct nlist *nlist;
-
-    for(i=0;i<header->ncmds;i++)
-    {
-	if(lc->cmd == LC_SEGMENT)
-	    segLC = (struct segment_command*) lc;
-	else if(lc->cmd == LC_SYMTAB)
-	    symLC = (struct symtab_command*) lc;
-	else if(lc->cmd == LC_DYSYMTAB)
-	    dsymLC = (struct dysymtab_command*) lc;
-	lc = (struct load_command *) ( ((char*)lc) + lc->cmdsize );
-    }
-
-    sections = (struct section*) (segLC+1);
-    nlist = symLC ? (struct nlist*) (image + symLC->symoff)
-                  : NULL;
-
-    if(dsymLC)
-    {
-        unsigned long *indirectSyms
-            = (unsigned long*) (image + dsymLC->indirectsymoff);
-
-        for(i=0;i<segLC->nsects;i++)
-        {
-            if(    !strcmp(sections[i].sectname,"__la_symbol_ptr")
-                || !strcmp(sections[i].sectname,"__la_sym_ptr2")
-                || !strcmp(sections[i].sectname,"__la_sym_ptr3"))
-            {
-                if(!resolveImports(oc,image,symLC,&sections[i],indirectSyms,nlist))
-                    return 0;
-            }
-            else if(!strcmp(sections[i].sectname,"__nl_symbol_ptr")
-                ||  !strcmp(sections[i].sectname,"__pointers"))
-            {
-                if(!resolveImports(oc,image,symLC,&sections[i],indirectSyms,nlist))
-                    return 0;
-            }
-            else if(!strcmp(sections[i].sectname,"__jump_table"))
-            {
-                if(!resolveImports(oc,image,symLC,&sections[i],indirectSyms,nlist))
-                    return 0;
-            }
-        }
-    }
-    
-    for(i=0;i<segLC->nsects;i++)
-    {
-	if(!relocateSection(oc,image,symLC,nlist,segLC->nsects,sections,&sections[i]))
-	    return 0;
-    }
-
-    /* Free the local symbol table; we won't need it again. */
-    freeHashTable(oc->lochash, NULL);
-    oc->lochash = NULL;
-
-#if defined (powerpc_HOST_ARCH)
-    ocFlushInstructionCache( oc );
-#endif
-
-    return 1;
-}
-
-#ifdef powerpc_HOST_ARCH
-/*
- * The Mach-O object format uses leading underscores. But not everywhere.
- * There is a small number of runtime support functions defined in
- * libcc_dynamic.a whose name does not have a leading underscore.
- * As a consequence, we can't get their address from C code.
- * We have to use inline assembler just to take the address of a function.
- * Yuck.
- */
-
-static void machoInitSymbolsWithoutUnderscore()
-{
-    extern void* symbolsWithoutUnderscore[];
-    void **p = symbolsWithoutUnderscore;
-    __asm__ volatile(".globl _symbolsWithoutUnderscore\n.data\n_symbolsWithoutUnderscore:");
-
-#undef Sym
-#define Sym(x)  \
-    __asm__ volatile(".long " # x);
-
-    RTS_MACHO_NOUNDERLINE_SYMBOLS
-
-    __asm__ volatile(".text");
-    
-#undef Sym
-#define Sym(x)  \
-    ghciInsertStrHashTable("(GHCi built-in symbols)", symhash, #x, *p++);
-    
-    RTS_MACHO_NOUNDERLINE_SYMBOLS
-    
-#undef Sym
-}
-#endif
-
-/*
- * Figure out by how much to shift the entire Mach-O file in memory
- * when loading so that its single segment ends up 16-byte-aligned
- */
-static int machoGetMisalignment( FILE * f )
-{
-    struct mach_header header;
-    int misalignment;
-    
-    fread(&header, sizeof(header), 1, f);
-    rewind(f);
-
-    if(header.magic != MH_MAGIC)
-        return 0;
-    
-    misalignment = (header.sizeofcmds + sizeof(header))
-                    & 0xF;
-
-    return misalignment ? (16 - misalignment) : 0;
-}
-
-#endif
diff --git a/ghc/rts/LinkerInternals.h b/ghc/rts/LinkerInternals.h
deleted file mode 100644
index 07d6334c7f..0000000000
--- a/ghc/rts/LinkerInternals.h
+++ /dev/null
@@ -1,110 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2000
- *
- * RTS Object Linker
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef LINKERINTERNALS_H
-#define LINKERINTERNALS_H
-
-typedef enum { OBJECT_LOADED, OBJECT_RESOLVED } OStatus;
-
-/* Indication of section kinds for loaded objects.  Needed by
-   the GC for deciding whether or not a pointer on the stack
-   is a code pointer.
-*/
-typedef 
-   enum { SECTIONKIND_CODE_OR_RODATA,
-          SECTIONKIND_RWDATA,
-          SECTIONKIND_OTHER,
-          SECTIONKIND_NOINFOAVAIL } 
-   SectionKind;
-
-typedef 
-   struct _Section { 
-      void* start; 
-      void* end; 
-      SectionKind kind;
-      struct _Section* next;
-   } 
-   Section;
-
-typedef 
-   struct _ProddableBlock {
-      void* start;
-      int   size;
-      struct _ProddableBlock* next;
-   }
-   ProddableBlock;
-
-/* Jump Islands are sniplets of machine code required for relative
- * address relocations on the PowerPC.
- */
-#ifdef powerpc_HOST_ARCH
-typedef struct {
-    short lis_r12, hi_addr;
-    short ori_r12_r12, lo_addr;
-    long mtctr_r12;
-    long bctr;
-} ppcJumpIsland;
-#endif
-
-/* Top-level structure for an object module.  One of these is allocated
- * for each object file in use.
- */
-typedef struct _ObjectCode {
-    OStatus    status;
-    char*      fileName;
-    int        fileSize;
-    char*      formatName;            /* eg "ELF32", "DLL", "COFF", etc. */
-
-    /* An array containing ptrs to all the symbol names copied from
-       this object into the global symbol hash table.  This is so that
-       we know which parts of the latter mapping to nuke when this
-       object is removed from the system. */
-    char**     symbols;
-    int        n_symbols;
-
-    /* ptr to malloc'd lump of memory holding the obj file */
-    char*      image;
-
-#ifdef darwin_HOST_OS
-    /* record by how much image has been deliberately misaligned
-       after allocation, so that we can use realloc */
-    int        misalignment;
-#endif
-
-    /* The section-kind entries for this object module.  Linked
-       list. */
-    Section* sections;
-
-    /* A private hash table for local symbols. */
-    HashTable* lochash;
-    
-    /* Allow a chain of these things */
-    struct _ObjectCode * next;
-
-    /* SANITY CHECK ONLY: a list of the only memory regions which may
-       safely be prodded during relocation.  Any attempt to prod
-       outside one of these is an error in the linker. */
-    ProddableBlock* proddables;
-
-#ifdef ia64_HOST_ARCH
-    /* Procedure Linkage Table for this object */
-    void *plt;
-    unsigned int pltIndex;
-#endif
-
-#ifdef powerpc_HOST_ARCH
-    ppcJumpIsland   *jump_islands;
-    unsigned long   island_start_symbol;
-    unsigned long   n_islands;
-#endif
-
-} ObjectCode;
-
-extern ObjectCode *objects;
-
-#endif /* LINKERINTERNALS_H */
diff --git a/ghc/rts/MBlock.c b/ghc/rts/MBlock.c
deleted file mode 100644
index fa8fd49d88..0000000000
--- a/ghc/rts/MBlock.c
+++ /dev/null
@@ -1,453 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1998-1999
- *
- * MegaBlock Allocator Interface.  This file contains all the dirty
- * architecture-dependent hackery required to get a chunk of aligned
- * memory from the operating system.
- *
- * ---------------------------------------------------------------------------*/
-
-/* This is non-posix compliant. */
-/* #include "PosixSource.h" */
-
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "MBlock.h"
-#include "BlockAlloc.h"
-
-#ifdef HAVE_STDLIB_H
-#include <stdlib.h>
-#endif
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-#ifdef HAVE_SYS_TYPES_H
-#include <sys/types.h>
-#endif
-#ifndef mingw32_HOST_OS
-# ifdef HAVE_SYS_MMAN_H
-# include <sys/mman.h>
-# endif
-#endif
-#ifdef HAVE_FCNTL_H
-#include <fcntl.h>
-#endif
-#if HAVE_WINDOWS_H
-#include <windows.h>
-#endif
-#if darwin_HOST_OS
-#include <mach/vm_map.h>
-#endif
-
-#include <errno.h>
-
-lnat mblocks_allocated = 0;
-
-/* -----------------------------------------------------------------------------
-   The MBlock Map: provides our implementation of HEAP_ALLOCED()
-   -------------------------------------------------------------------------- */
-
-#if SIZEOF_VOID_P == 4
-StgWord8 mblock_map[MBLOCK_MAP_SIZE]; // initially all zeros
-#elif SIZEOF_VOID_P == 8
-static MBlockMap dummy_mblock_map;
-MBlockMap *mblock_cache = &dummy_mblock_map;
-int mblock_map_count = 0;
-MBlockMap **mblock_maps = NULL;
-
-static MBlockMap *
-findMBlockMap(void *p)
-{
-    int i;
-    StgWord32 hi = (StgWord32) (((StgWord)p) >> 32);
-    for( i = 0; i < mblock_map_count; i++ )
-    {
-        if(mblock_maps[i]->addrHigh32 == hi)
-        {
-	    return mblock_maps[i];
-	}
-    }
-    return NULL;
-}
-
-StgBool
-slowIsHeapAlloced(void *p)
-{
-    MBlockMap *map = findMBlockMap(p);
-    if(map)
-    {
-    	mblock_cache = map;
-	return map->mblocks[MBLOCK_MAP_ENTRY(p)];
-    }
-    else
-    	return 0;
-}
-#endif
-
-static void
-markHeapAlloced(void *p)
-{
-#if SIZEOF_VOID_P == 4
-    mblock_map[MBLOCK_MAP_ENTRY(p)] = 1;
-#elif SIZEOF_VOID_P == 8
-    MBlockMap *map = findMBlockMap(p);
-    if(map == NULL)
-    {
-    	mblock_map_count++;
-    	mblock_maps = realloc(mblock_maps,
-			      sizeof(MBlockMap*) * mblock_map_count);
-	map = mblock_maps[mblock_map_count-1] = calloc(1,sizeof(MBlockMap));
-	map->addrHigh32 = (StgWord32) (((StgWord)p) >> 32);
-    }
-    map->mblocks[MBLOCK_MAP_ENTRY(p)] = 1;
-    mblock_cache = map;
-#endif
-}
-
-/* -----------------------------------------------------------------------------
-   Allocate new mblock(s)
-   -------------------------------------------------------------------------- */
-
-void *
-getMBlock(void)
-{
-  return getMBlocks(1);
-}
-
-/* -----------------------------------------------------------------------------
-   The mmap() method
-
-   On Unix-like systems, we use mmap() to allocate our memory.  We
-   want memory in chunks of MBLOCK_SIZE, and aligned on an MBLOCK_SIZE
-   boundary.  The mmap() interface doesn't give us this level of
-   control, so we have to use some heuristics.
-
-   In the general case, if we want a block of n megablocks, then we
-   allocate n+1 and trim off the slop from either side (using
-   munmap()) to get an aligned chunk of size n.  However, the next
-   time we'll try to allocate directly after the previously allocated
-   chunk, on the grounds that this is aligned and likely to be free.
-   If it turns out that we were wrong, we have to munmap() and try
-   again using the general method.
-
-   Note on posix_memalign(): this interface is available on recent
-   systems and appears to provide exactly what we want.  However, it
-   turns out not to be as good as our mmap() implementation, because
-   it wastes extra space (using double the address space, in a test on
-   x86_64/Linux).  The problem seems to be that posix_memalign()
-   returns memory that can be free()'d, so the library must store
-   extra information along with the allocated block, thus messing up
-   the alignment.  Hence, we don't use posix_memalign() for now.
-
-   -------------------------------------------------------------------------- */
-
-#if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS)
-
-// A wrapper around mmap(), to abstract away from OS differences in
-// the mmap() interface.
-
-static void *
-my_mmap (void *addr, lnat size)
-{
-    void *ret;
-
-#if defined(solaris2_HOST_OS) || defined(irix_HOST_OS)
-    { 
-	int fd = open("/dev/zero",O_RDONLY);
-	ret = mmap(addr, size, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0);
-	close(fd);
-    }
-#elif hpux_HOST_OS
-    ret = mmap(addr, size, PROT_READ | PROT_WRITE, 
-	       MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
-#elif darwin_HOST_OS
-    // Without MAP_FIXED, Apple's mmap ignores addr.
-    // With MAP_FIXED, it overwrites already mapped regions, whic
-    // mmap(0, ... MAP_FIXED ...) is worst of all: It unmaps the program text
-    // and replaces it with zeroes, causing instant death.
-    // This behaviour seems to be conformant with IEEE Std 1003.1-2001.
-    // Let's just use the underlying Mach Microkernel calls directly,
-    // they're much nicer.
-    
-    kern_return_t err;
-    ret = addr;
-    if(addr)	// try to allocate at adress
-	err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, FALSE);
-    if(!addr || err)	// try to allocate anywhere
-	err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, TRUE);
-	
-    if(err) {
-	// don't know what the error codes mean exactly, assume it's
-	// not our problem though.
-	errorBelch("memory allocation failed (requested %lu bytes)", size);
-	stg_exit(EXIT_FAILURE);
-    } else {
-	vm_protect(mach_task_self(),ret,size,FALSE,VM_PROT_READ|VM_PROT_WRITE);
-    }
-#else
-    ret = mmap(addr, size, PROT_READ | PROT_WRITE | PROT_EXEC, 
-	       MAP_ANON | MAP_PRIVATE, -1, 0);
-#endif
-
-    if (ret == (void *)-1) {
-	if (errno == ENOMEM || 
-	    (errno == EINVAL && sizeof(void*)==4 && size >= 0xc0000000)) {
-	    // If we request more than 3Gig, then we get EINVAL
-	    // instead of ENOMEM (at least on Linux).
-	    errorBelch("out of memory (requested %lu bytes)", size);
-	    stg_exit(EXIT_FAILURE);
-	} else {
-	    barf("getMBlock: mmap: %s", strerror(errno));
-	}
-    }
-
-    return ret;
-}
-
-// Implements the general case: allocate a chunk of memory of 'size'
-// mblocks.
-
-static void *
-gen_map_mblocks (lnat size)
-{
-    int slop;
-    void *ret;
-
-    // Try to map a larger block, and take the aligned portion from
-    // it (unmap the rest).
-    size += MBLOCK_SIZE;
-    ret = my_mmap(0, size);
-    
-    // unmap the slop bits around the chunk we allocated
-    slop = (W_)ret & MBLOCK_MASK;
-    
-    if (munmap(ret, MBLOCK_SIZE - slop) == -1) {
-      barf("gen_map_mblocks: munmap failed");
-    }
-    if (slop > 0 && munmap(ret+size-slop, slop) == -1) {
-      barf("gen_map_mblocks: munmap failed");
-    }
-
-    // ToDo: if we happened to get an aligned block, then don't
-    // unmap the excess, just use it. For this to work, you
-    // need to keep in mind the following:
-    //     * Calling my_mmap() with an 'addr' arg pointing to
-    //       already my_mmap()ed space is OK and won't fail.
-    //     * If my_mmap() can't satisfy the request at the
-    //       given 'next_request' address in getMBlocks(), that
-    //       you unmap the extra mblock mmap()ed here (or simply
-    //       satisfy yourself that the slop introduced isn't worth
-    //       salvaging.)
-    // 
-
-    // next time, try after the block we just got.
-    ret += MBLOCK_SIZE - slop;
-    return ret;
-}
-
-
-// The external interface: allocate 'n' mblocks, and return the
-// address.
-
-void *
-getMBlocks(nat n)
-{
-  static caddr_t next_request = (caddr_t)HEAP_BASE;
-  caddr_t ret;
-  lnat size = MBLOCK_SIZE * n;
-  nat i;
- 
-  if (next_request == 0) {
-      // use gen_map_mblocks the first time.
-      ret = gen_map_mblocks(size);
-  } else {
-      ret = my_mmap(next_request, size);
-
-      if (((W_)ret & MBLOCK_MASK) != 0) {
-	  // misaligned block!
-#if 0 // defined(DEBUG)
-	  errorBelch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
-#endif
-
-	  // unmap this block...
-	  if (munmap(ret, size) == -1) {
-	      barf("getMBlock: munmap failed");
-	  }
-	  // and do it the hard way
-	  ret = gen_map_mblocks(size);
-      }
-  }
-
-  // Next time, we'll try to allocate right after the block we just got.
-  // ToDo: check that we haven't already grabbed the memory at next_request
-  next_request = ret + size;
-
-  IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at %p\n",n,ret));
-
-  // fill in the table
-  for (i = 0; i < n; i++) {
-      markHeapAlloced( ret + i * MBLOCK_SIZE );
-  }
-
-  mblocks_allocated += n;
-
-  return ret;
-}
-
-void
-freeAllMBlocks(void)
-{
-  /* XXX Do something here */
-}
-
-#else /* defined(mingw32_HOST_OS) || defined(cygwin32_HOST_OS) */
-
-/*
- On Win32 platforms we make use of the two-phased virtual memory API
- to allocate mega blocks. We proceed as follows:
-
- Reserve a large chunk of VM (256M at the time, or what the user asked
- for via the -M option), but don't supply a base address that's aligned on
- a MB boundary. Instead we round up to the nearest mblock from the chunk of
- VM we're handed back from the OS (at the moment we just leave the 'slop' at
- the beginning of the reserved chunk unused - ToDo: reuse it .)
-
- Reserving memory doesn't allocate physical storage (not even in the
- page file), this is done later on by committing pages (or mega-blocks in
- our case).
-*/
-
-static char* base_non_committed = (char*)0;
-static char* end_non_committed = (char*)0;
-
-static void *membase;
-
-/* Default is to reserve 256M of VM to minimise the slop cost. */
-#define SIZE_RESERVED_POOL  ( 256 * 1024 * 1024 )
-
-/* Number of bytes reserved */
-static unsigned long size_reserved_pool = SIZE_RESERVED_POOL;
-
-void *
-getMBlocks(nat n)
-{
-  static char* base_mblocks       = (char*)0;
-  static char* next_request       = (char*)0;
-  void* ret                       = (void*)0;
-  nat i;
-
-  lnat size = MBLOCK_SIZE * n;
-  
-  if ( (base_non_committed == 0) || (next_request + size > end_non_committed) ) {
-    if (base_non_committed) {
-	/* Tacky, but if no user-provided -M option is in effect,
-	 * set it to the default (==256M) in time for the heap overflow PSA.
-	 */
-	if (RtsFlags.GcFlags.maxHeapSize == 0) {
-	    RtsFlags.GcFlags.maxHeapSize = size_reserved_pool / BLOCK_SIZE;
-	}
-	heapOverflow();
-    }
-    if (RtsFlags.GcFlags.maxHeapSize != 0) {
-      size_reserved_pool = BLOCK_SIZE * RtsFlags.GcFlags.maxHeapSize;
-      if (size_reserved_pool < MBLOCK_SIZE) {
-	size_reserved_pool = 2*MBLOCK_SIZE;
-      }
-    }
-    base_non_committed = VirtualAlloc ( NULL
-                                      , size_reserved_pool
-				      , MEM_RESERVE
-				      , PAGE_READWRITE
-				      );
-    membase = base_non_committed;
-    if ( base_non_committed == 0 ) {
-         errorBelch("getMBlocks: VirtualAlloc MEM_RESERVE %lu failed with: %ld\n", size_reserved_pool, GetLastError());
-       ret=(void*)-1;
-    } else {
-      end_non_committed = (char*)base_non_committed + (unsigned long)size_reserved_pool;
-      /* The returned pointer is not aligned on a mega-block boundary. Make it. */
-      base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)~MBLOCK_MASK) + MBLOCK_SIZE;
-#      if 0
-       debugBelch("getMBlocks: Dropping %d bytes off of 256M chunk\n", 
-		  (unsigned)base_mblocks - (unsigned)base_non_committed);
-#      endif
-
-       if ( ((char*)base_mblocks + size) > end_non_committed ) {
-          debugBelch("getMBlocks: oops, committed too small a region to start with.");
-	  ret=(void*)-1;
-       } else {
-          next_request = base_mblocks;
-       }
-    }
-  }
-  /* Commit the mega block(s) to phys mem */
-  if ( ret != (void*)-1 ) {
-     ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
-     if (ret == NULL) {
-        debugBelch("getMBlocks: VirtualAlloc MEM_COMMIT %lu failed with: %ld\n", size, GetLastError());
-        ret=(void*)-1;
-     }
-  }
-
-  if (((W_)ret & MBLOCK_MASK) != 0) {
-    barf("getMBlocks: misaligned block returned");
-  }
-
-  if (ret == (void*)-1) {
-     barf("getMBlocks: unknown memory allocation failure on Win32.");
-  }
-
-  IF_DEBUG(gc,debugBelch("Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
-  next_request = (char*)next_request + size;
-
-  mblocks_allocated += n;
-  
-  // fill in the table
-  for (i = 0; i < n; i++) {
-      markHeapAlloced( ret + i * MBLOCK_SIZE );
-  }
-
-  return ret;
-}
-
-void
-freeAllMBlocks(void)
-{
-  BOOL rc;
-
-  rc = VirtualFree(membase, 0, MEM_RELEASE);
-  
-  if (rc == FALSE) {
-     debugBelch("freeAllMBlocks: VirtualFree failed with: %ld\n", GetLastError());
-  }
-}
-
-/* Hand back the physical memory that is allocated to a mega-block. 
-   ToDo: chain the released mega block onto some list so that
-         getMBlocks() can get at it.
-
-   Currently unused.
-*/
-#if 0
-void
-freeMBlock(void* p, nat n)
-{
-  BOOL rc;
-
-  rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
-  
-  if (rc == FALSE) {
-#    ifdef DEBUG
-     debugBelch("freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
-#    endif
-  }
-
-}
-#endif
-
-#endif
diff --git a/ghc/rts/MBlock.h b/ghc/rts/MBlock.h
deleted file mode 100644
index 1cc0dc5a1f..0000000000
--- a/ghc/rts/MBlock.h
+++ /dev/null
@@ -1,90 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * MegaBlock Allocator interface.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef MBLOCK_H
-#define MBLOCK_H
-
-extern lnat RTS_VAR(mblocks_allocated);
-
-extern void * getMBlock(void);
-extern void * getMBlocks(nat n);
-extern void freeAllMBlocks(void);
-
-#if osf3_HOST_OS
-/* ToDo: Perhaps by adjusting this value we can make linking without
- * -static work (i.e., not generate a core-dumping executable)? */
-#if SIZEOF_VOID_P == 8
-#define HEAP_BASE 0x180000000L
-#else
-#error I have no idea where to begin the heap on a non-64-bit osf3 machine.
-#endif
-
-#else
-
-// we're using the generic method
-#define HEAP_BASE 0
-
-#endif
-
-/* -----------------------------------------------------------------------------
-   The HEAP_ALLOCED() test.
-
-   HEAP_ALLOCED is called FOR EVERY SINGLE CLOSURE during GC.
-   It needs to be FAST.
-
-   Implementation of HEAP_ALLOCED
-   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-
-   Since heap is allocated in chunks of megablocks (MBLOCK_SIZE), we
-   can just use a table to record which megablocks in the address
-   space belong to the heap.  On a 32-bit machine, with 1Mb
-   megablocks, using 8 bits for each entry in the table, the table
-   requires 4k.  Lookups during GC will be fast, because the table
-   will be quickly cached (indeed, performance measurements showed no
-   measurable difference between doing the table lookup and using a
-   constant comparison).
-
-   On 64-bit machines, we cache one 12-bit block map that describes
-   4096 megablocks or 4GB of memory. If HEAP_ALLOCED is called for
-   an address that is not in the cache, it calls slowIsHeapAlloced
-   (see MBlock.c) which will find the block map for the 4GB block in
-   question.
-   -------------------------------------------------------------------------- */
-
-#if SIZEOF_VOID_P == 4
-extern StgWord8 mblock_map[];
-
-/* On a 32-bit machine a 4KB table is always sufficient */
-# define MBLOCK_MAP_SIZE	4096
-# define MBLOCK_MAP_ENTRY(p)	((StgWord)(p) >> MBLOCK_SHIFT)
-# define HEAP_ALLOCED(p)	mblock_map[MBLOCK_MAP_ENTRY(p)]
-
-#elif SIZEOF_VOID_P == 8
-
-# define MBLOCK_MAP_SIZE	4096
-# define MBLOCK_MAP_ENTRY(p)	(((StgWord)(p) & 0xffffffff) >> MBLOCK_SHIFT)
-
-typedef struct {
-    StgWord32	addrHigh32;
-    StgWord8	mblocks[MBLOCK_MAP_SIZE];
-} MBlockMap;
-
-extern MBlockMap *mblock_cache;
-
-StgBool slowIsHeapAlloced(void *p);
-
-# define HEAP_ALLOCED(p)  					\
-	( ((((StgWord)(p)) >> 32) == mblock_cache->addrHigh32)	\
-	? mblock_cache->mblocks[MBLOCK_MAP_ENTRY(p)]		\
-	: slowIsHeapAlloced(p) )
-
-#else
-# error HEAP_ALLOCED not defined
-#endif
-
-#endif /* MBLOCK_H */
diff --git a/ghc/rts/Main.c b/ghc/rts/Main.c
deleted file mode 100644
index 6aef280e25..0000000000
--- a/ghc/rts/Main.c
+++ /dev/null
@@ -1,138 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1998-2000
- *
- * Main function for a standalone Haskell program.
- *
- * ---------------------------------------------------------------------------*/
-
-#define COMPILING_RTS_MAIN
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsAPI.h"
-#include "SchedAPI.h"
-#include "Schedule.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "Prelude.h"
-#include "Task.h"
-#include <stdlib.h>
-
-#ifdef DEBUG
-# include "Printer.h"   /* for printing        */
-#endif
-
-#ifdef PAR
-# include "Parallel.h"
-# include "ParallelRts.h"
-# include "LLC.h"
-#endif
-
-#if defined(GRAN) || defined(PAR)
-# include "GranSimRts.h"
-#endif
-
-#ifdef HAVE_WINDOWS_H
-# include <windows.h>
-#endif
-
-extern void __stginit_ZCMain(void);
-
-/* Hack: we assume that we're building a batch-mode system unless 
- * INTERPRETER is set
- */
-#ifndef INTERPRETER /* Hack */
-int main(int argc, char *argv[])
-{
-    int exit_status;
-    SchedulerStatus status;
-    /* all GranSim/GUM init is done in startupHaskell; sets IAmMainThread! */
-
-    startupHaskell(argc,argv,__stginit_ZCMain);
-
-    /* kick off the computation by creating the main thread with a pointer
-       to mainIO_closure representing the computation of the overall program;
-       then enter the scheduler with this thread and off we go;
-      
-       the same for GranSim (we have only one instance of this code)
-
-       in a parallel setup, where we have many instances of this code
-       running on different PEs, we should do this only for the main PE
-       (IAmMainThread is set in startupHaskell) 
-    */
-
-#  if defined(PAR)
-
-#   if defined(DEBUG)
-    { /* a wait loop to allow attachment of gdb to UNIX threads */
-      nat i, j, s;
-
-      for (i=0, s=0; i<(nat)RtsFlags.ParFlags.wait; i++)
-	for (j=0; j<1000000; j++) 
-	  s += j % 65536;
-    }
-    IF_PAR_DEBUG(verbose,
-		 belch("Passed wait loop"));
-#   endif
-
-    if (IAmMainThread == rtsTrue) {
-      IF_PAR_DEBUG(verbose,
-		   debugBelch("==== [%x] Main Thread Started ...\n", mytid));
-
-      /* ToDo: Dump event for the main thread */
-      status = rts_mainLazyIO((HaskellObj)mainIO_closure, NULL);
-    } else {
-      /* Just to show we're alive */
-      IF_PAR_DEBUG(verbose,
-		   debugBelch("== [%x] Non-Main PE enters scheduler via taskStart() without work ...\n",
-			   mytid));
-     
-      /* all non-main threads enter the scheduler without work */
-      taskStart();       
-      status = Success;  // declare victory (see shutdownParallelSystem)
-    }
-
-#  elif defined(GRAN)
-
-    /* ToDo: Dump event for the main thread */
-    status = rts_mainLazyIO(mainIO_closure, NULL);
-
-#  else /* !PAR && !GRAN */
-
-    /* ToDo: want to start with a larger stack size */
-    { 
-	void *cap = rts_lock();
-	cap = rts_evalLazyIO(cap,(HaskellObj)(void *)mainIO_closure, NULL);
-	status = rts_getSchedStatus(cap);
-	rts_unlock(cap);
-    }
-
-#  endif /* !PAR && !GRAN */
-
-    /* check the status of the entire Haskell computation */
-    switch (status) {
-    case Killed:
-      errorBelch("main thread exited (uncaught exception)");
-      exit_status = EXIT_KILLED;
-      break;
-    case Interrupted:
-      errorBelch("interrupted");
-      exit_status = EXIT_INTERRUPTED;
-      break;
-    case Success:
-      exit_status = EXIT_SUCCESS;
-      break;
-#if defined(PAR)
-    case NoStatus:
-      errorBelch("main thread PE killed; probably due to failure of another PE; check /tmp/pvml...");
-      exit_status = EXIT_KILLED;
-      break;
-#endif 
-    default:
-      barf("main thread completed with invalid status");
-    }
-    shutdownHaskellAndExit(exit_status);
-    return 0; /* never reached, keep gcc -Wall happy */
-}
-# endif /* BATCH_MODE */
diff --git a/ghc/rts/Makefile b/ghc/rts/Makefile
deleted file mode 100644
index ef3e244032..0000000000
--- a/ghc/rts/Makefile
+++ /dev/null
@@ -1,370 +0,0 @@
-#-----------------------------------------------------------------------------
-#
-#  This is the Makefile for the runtime-system stuff.
-#  This stuff is written in C (and cannot be written in Haskell).
-#
-#  .c  files are vanilla C,
-#  .hc files are "Haskellized-C", compiled using the C compiler and
-#      (possibly) the assembly-mangler.  The GHC driver script
-#      knows how to compile this stuff.
-#
-#  Other sorta independent, compile-once subdirs are:
-#	gmp		-- GNU multi-precision library (for Integer)
-
-#-----------------------------------------------------------------------------
-# Preamble
-
-TOP=..
-
-# Set UseGhcForCc: this causes the fptools build system to use a different
-# set of suffix rules for compiling C code, using $(HC) rather than $(CC)
-# and prepending "-optc" to $(CC_OPTS).  NB. must be done before including
-# boilerplate.mk below.
-UseGhcForCc = YES
-
-include $(TOP)/mk/boilerplate.mk
-
-PACKAGE = rts
-
-HC=$(GHC_INPLACE)
-
-# -----------------------------------------------------------------------------
-# RTS ways
-
-WAYS=$(GhcLibWays) $(GhcRTSWays)
-
-ifneq "$(findstring debug, $(way))" ""
-GhcRtsHcOpts=
-GhcRtsCcOpts=-g
-endif
-
-# -----------------------------------------------------------------------------
-
-# Tells the build system not to add various Haskellish options to $(SRC_HC_OPTS)
-NON_HS_PACKAGE = YES
-
-# grab sources from these subdirectories
-ALL_DIRS = hooks parallel
-
-ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-ALL_DIRS += win32
-else
-ALL_DIRS += posix
-endif
-
-ifneq "$(DLLized)" "YES"
-EXCLUDED_SRCS += RtsDllMain.c
-else
-EXCLUDED_SRCS += Main.c
-endif
-
-# This file ends up being empty unless we're building for a powerpc
-# or darwin system, and it is reported that Solaris ld chokes on it when
-# building HSrts.o.
-ifeq "$(findstring $(TargetArch_CPP), powerpc powerpc64)" ""
-ifeq "$(findstring $(TargetOS_CPP), darwin)" ""
-EXCLUDED_SRCS += AdjustorAsm.S
-endif
-endif
-
-EXCLUDED_SRCS += parallel/SysMan.c
-
-# The build system doesn't give us these
-CMM_SRCS = $(filter-out AutoApply%.cmm, $(wildcard *.cmm)) $(EXTRA_CMM_SRCS)
-CMM_OBJS = $(patsubst %.cmm,%.$(way_)o, $(CMM_SRCS))
-
-CLEAN_FILES += $(CMM_OBJS)
-
-# Override the default $(LIBOBJS) (defaults to $(HS_OBJS))
-LIBOBJS = $(C_OBJS) $(CMM_OBJS)
-
-SplitObjs=NO
-
-H_FILES = $(wildcard ../includes/*.h) $(wildcard *.h)
-
-#-----------------------------------------------------------------------------
-# Flags for compiling RTS .c and .hc files
-
-# gcc provides lots of useful warnings if you ask it.
-# This is a pretty good list to start with - use a # to comment out
-# any you don't like.
-WARNING_OPTS += -Wall 
-WARNING_OPTS += -W
-WARNING_OPTS += -Wstrict-prototypes 
-WARNING_OPTS += -Wmissing-prototypes 
-WARNING_OPTS += -Wmissing-declarations
-WARNING_OPTS += -Winline
-WARNING_OPTS += -Waggregate-return
-#WARNING_OPTS += -Wpointer-arith
-WARNING_OPTS += -Wbad-function-cast
-#WARNING_OPTS += -Wcast-align
-#WARNING_OPTS += -Wnested-externs
-#WARNING_OPTS += -Wshadow
-#WARNING_OPTS += -Wcast-qual
-#WARNING_OPTS += -Wno-unused 
-#WARNING_OPTS += -Wredundant-decls 
-#WARNING_OPTS += -Wconversion
-
-STANDARD_OPTS += -I../includes -I. -Iparallel
-# COMPILING_RTS is only used when building Win32 DLL support.
-STANDARD_OPTS += -DCOMPILING_RTS
-
-# HC_OPTS is included in both .c and .cmm compilations, whereas CC_OPTS is
-# only included in .c compilations.  HC_OPTS included the WAY_* opts, which
-# must be included in both types of compilations.
-
-SRC_CC_OPTS += $(WARNING_OPTS)
-SRC_CC_OPTS += $(STANDARD_OPTS)
-
-SRC_CC_OPTS += $(GhcRtsCcOpts)
-SRC_HC_OPTS += $(GhcRtsHcOpts)
-
-ifneq "$(DLLized)" "YES"
-SRC_HC_OPTS += -static
-endif
-# SRC_HC_OPTS += -fPIC
-
-RtsMessages_CC_OPTS += -DProjectVersion=\"$(ProjectVersion)\"
-
-ifeq "$(way)" "mp"
-SRC_HC_OPTS += -I$$PVM_ROOT/include
-endif
-
-# If -DDEBUG is in effect, adjust package conf accordingly..
-ifneq "$(strip $(filter -optc-DDEBUG,$(GhcRtsHcOpts)))" ""
-PACKAGE_CPP_OPTS += -DDEBUG
-endif
-
-ifeq "$(HaveLibMingwEx)" "YES"
-PACKAGE_CPP_OPTS += -DHAVE_LIBMINGWEX
-endif
-
-ifeq "$(DotnetSupport)" "YES"
-
-# 
-# Would like to just use SUBDIRS here, but need to
-# descend into dotnet/ earlier than that.
-#
-all ::
-	$(MAKE) -C dotnet all
-
-# But use SUBDIRS for other recursive targets.
-SUBDIRS += dotnet
-
-LIBOBJS += dotnet/Invoke.o
-endif
-
-# Suppress uninitialized variable warnings for GC.c
-GC_CC_OPTS 	+= -Wno-uninitialized
-
-#-----------------------------------------------------------------------------
-# Include the Front panel code?
-
-# we need GTK+ for the front panel
-ifneq "$(GTK_CONFIG)" ""
-ifeq "$(GhcRtsWithFrontPanel)" "YES"
-SRC_HC_OPTS 		+= `$(GTK_CONFIG) --cflags` -optc-DRTS_GTK_FRONTPANEL
-VisCallbacks_CC_OPTS 	+= -Wno-unused
-SRC_MKDEPENDC_OPTS	+= `$(GTK_CONFIG) --cflags`
-else # GhcRtsWithFrontPanel
-EXCLUDED_SRCS		+= $(wildcard Vis*.c)
-endif
-else # GTK_CONFIG
-EXCLUDED_SRCS		+= $(wildcard Vis*.c)
-endif
-
-#-----------------------------------------------------------------------------
-# make depend setup
-
-SRC_MKDEPENDC_OPTS += -I. -I../includes
-
-# Hack: we define every way-related option here, so that we get (hopefully)
-# a superset of the dependencies.  To do this properly, we should generate
-# a different set of dependencies for each way.  Further hack: PROFILING and
-# TICKY_TICKY can't be used together, so we omit TICKY_TICKY for now.
-SRC_MKDEPENDC_OPTS += -DPROFILING -DTHREADED_RTS -DDEBUG
-
-# -----------------------------------------------------------------------------
-# The auto-generated apply code
-
-# We want a slightly different version for the unregisterised way, so we make
-# AutoApply on a per-way basis (eg. AutoApply_p.cmm).
-
-AUTO_APPLY_CMM = AutoApply$(_way).cmm
-
-ifneq "$(BootingFromHc)" "YES"
-$(AUTO_APPLY_CMM): $(GHC_GENAPPLY)
-	@$(RM) $@
-	$(GHC_GENAPPLY) $(if $(filter $(way), u debug_u), -u) >$@
-endif
-
-EXTRA_CMM_SRCS += $(AUTO_APPLY_CMM)
-
-CLEAN_FILES += $(AUTO_APPLY_CMM)
-
-# -----------------------------------------------------------------------------
-#
-#  Building DLLs is only supported on mingw32 at the moment.
-#
-ifeq "$(DLLized)" "YES"
-SRC_BLD_DLL_OPTS += -lHS_imp_stub -lgmp_imp
-
-# It's not included in the DLL, but we need to compile it up separately.
-all :: Main.dll_o
-
-# Need an import library containing the symbols the RTS uses from the Prelude.
-# So, to avoid bootstrapping trouble, we build one containing just the syms
-# we need. Weirdly named to avoid clashing later on when compiling the contents
-# of ghc/lib/..
-#
-# Note: if you do change the name of the Prelude DLL, the "--dllname <nm>.dll"
-# below will need to be updated as well.
-
-$(DLL_PEN)/HSrts$(_way).dll :: libHS_imp_stub.a
-
-libHS_imp_stub.a :
-	dlltool --output-lib libHS_imp_stub.a --def HSprel.def --dllname HSstd.dll
-
-endif
-
-# -----------------------------------------------------------------------------
-# Compile GMP only if we don't have it already
-#
-# We use GMP's own configuration stuff, because it's all rather hairy
-# and not worth re-implementing in our Makefile framework.
-
-ifneq "$(HaveLibGmp)" "YES"
-ifneq "$(HaveFrameworkGMP)" "YES"
-boot ::
-	if [ -f gmp/config.status ]; then \
-	   cd gmp && CC=$(WhatGccIsCalled) ./config.status; \
-        else \
-	   cd gmp && CC=$(WhatGccIsCalled) ./configure --enable-shared=no \
-		        --host=`echo $(HOSTPLATFORM) | sed 's/i[567]86/i486/g'`; \
-	fi
-
-# Slight cheatage here to pass host as target, but x-compilation isn't supported by ghc.
-
-ifeq "$(way)" ""
-all :: gmp/libgmp.a
-
-ifeq "$(DLLized)" "YES"
-all :: $(DLL_PEN)/gmp.dll
-
-$(DLL_PEN)/gmp.dll:
-	$(MAKE) -C gmp gmp.dll
-	$(MV) gmp/gmp.dll $(DLL_PEN)
-endif
-endif
-
-install :: gmp/libgmp.a
-
-ifeq "$(way)" ""
-clean distclean maintainer-clean ::
-	-$(MAKE) -C gmp MAKEFLAGS= $@
-
-INSTALL_LIBS += gmp/libgmp.a
-endif
-endif
-
-gmp/libgmp.a ::
-	$(MAKE) -C gmp MAKEFLAGS=
-	@$(CP) gmp/.libs/libgmp.a gmp
-	@$(RANLIB) gmp/libgmp.a
-endif
-
-CLEAN_FILES += gmp/libgmp.a
-
-#-----------------------------------------------------------------------------
-#
-# Building the GUM SysMan
-#
-
-ifeq "$(way)" "mp"
-all :: parallel/SysMan
-
-ifdef solaris2_TARGET_OS
-__socket_libs = -lsocket -lnsl
-else
-__socket_libs =
-endif
-
-parallel/SysMan : parallel/SysMan.mp_o parallel/LLComms.mp_o RtsUtils.mp_o RtsFlags.mp_o
-	$(RM) $@
-	gcc -o $@ parallel/SysMan.mp_o parallel/LLComms.mp_o -L$$PVM_ROOT/lib/$$PVM_ARCH -lgpvm3 -lpvm3 $(__socket_libs)
-
-CLEAN_FILES  += parallel/SysMan.mp_o parallel/SysMan
-INSTALL_LIBEXECS += parallel/SysMan
-endif
-
-#-----------------------------------------------------------------------------
-# Compiling the cmm files
-
-# ToDo: should we really include Rts.h here?  Required for GNU_ATTRIBUTE().
-SRC_HC_OPTS += \
-  -I. \
-  -\#include Prelude.h \
-  -\#include Rts.h \
-  -\#include RtsFlags.h \
-  -\#include RtsUtils.h \
-  -\#include StgRun.h \
-  -\#include Schedule.h \
-  -\#include Printer.h \
-  -\#include Sanity.h \
-  -\#include STM.h \
-  -\#include Storage.h \
-  -\#include SchedAPI.h \
-  -\#include Timer.h \
-  -\#include ProfHeap.h \
-  -\#include LdvProfile.h \
-  -\#include Profiling.h \
-  -\#include OSThreads.h \
-  -\#include Apply.h \
-  -\#include SMP.h
-
-ifeq "$(Windows)" "YES"
-PrimOps_HC_OPTS += -\#include '<windows.h>' -\#include win32/AsyncIO.h
-else
-PrimOps_HC_OPTS += -\#include posix/Itimer.h
-endif
-
-# -O3 helps unroll some loops (especially in copy() with a constant argument).
-# -fno-strict-aliasing is a hack because we often mix StgPtr and StgClosure pointers
-# to the same object, and gcc will assume these don't alias.  eg. it happens in
-# copy() with gcc 3.4.3, the upd_evacee() assigments get moved before the object copy.
-GC_HC_OPTS += -optc-O3 -optc-fno-strict-aliasing
-
-# Cmm must be compiled via-C for now, because the NCG can't handle loops
-SRC_HC_OPTS += -fvia-C
-
-# We *want* type-checking of hand-written cmm.
-SRC_HC_OPTS += -dcmm-lint 
-
-ifneq "$(BootingFromHc)" "YES"
-# .cmm files depend on all the .h files, to a first approximation.
-%.$(way_)o : %.cmm $(H_FILES)
-	$(HC_PRE_OPTS)
-	$(HC) $(HC_OPTS) -c $< -o $@
-	$(HC_POST_OPTS)
-
-%.$(way_)hc : %.cmm $(H_FILES)
-	$(HC) $(HC_OPTS) -C $< -o $@
-
-%.$(way_)s : %.cmm $(H_FILES)
-	$(HC) $(HC_OPTS) -S $< -o $@
-endif
-
-#-----------------------------------------------------------------------------
-#
-# Files to install
-#
-# Just libHSrts is installed uniformly across ways
-#
-INSTALL_LIBS += $(LIBRARY)
-ifeq "$(DLLized)" "YES"
-INSTALL_PROGS += $(DLL_NAME) gmp/gmp.dll
-INSTALL_LIBS += $(patsubst %.a,%_imp.a,$(LIBARY))
-INSTALL_LIBS += gmp/libgmp_imp.a Main.dll_o
-endif
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/rts/PosixSource.h b/ghc/rts/PosixSource.h
deleted file mode 100644
index a938f9bc0f..0000000000
--- a/ghc/rts/PosixSource.h
+++ /dev/null
@@ -1,18 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Include this file into sources which should not need any non-Posix services.
- * That includes most RTS C sources.
- * ---------------------------------------------------------------------------*/
-
-#ifndef POSIXSOURCE_H
-#define POSIXSOURCE_H
-
-#define _POSIX_SOURCE   1
-#define _POSIX_C_SOURCE 199506L
-#define _ISOC9X_SOURCE
-
-/* Let's be ISO C9X too... */
-
-#endif /* POSIXSOURCE_H */
diff --git a/ghc/rts/Prelude.h b/ghc/rts/Prelude.h
deleted file mode 100644
index c209b2b800..0000000000
--- a/ghc/rts/Prelude.h
+++ /dev/null
@@ -1,129 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Prelude identifiers that we sometimes need to refer to in the RTS.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef PRELUDE_H
-#define PRELUDE_H
-
-/* These definitions are required by the RTS .cmm files too, so we
- * need declarations that we can #include into the generated .hc files.
- */
-#if IN_STG_CODE
-#define PRELUDE_INFO(i)       extern W_(i)[]
-#define PRELUDE_CLOSURE(i)    extern W_(i)[]
-#else
-#define PRELUDE_INFO(i)       extern DLL_IMPORT const StgInfoTable i
-#define PRELUDE_CLOSURE(i)    extern DLL_IMPORT StgClosure i
-#endif
-
-/* Define canonical names so we can abstract away from the actual
- * modules these names are defined in.
- */
-
-PRELUDE_CLOSURE(GHCziBase_True_closure);
-PRELUDE_CLOSURE(GHCziBase_False_closure);
-PRELUDE_CLOSURE(GHCziPack_unpackCString_closure);
-PRELUDE_CLOSURE(GHCziWeak_runFinalizzerBatch_closure);
-
-#ifdef IN_STG_CODE
-extern W_ ZCMain_main_closure[];
-#else
-extern StgClosure ZCMain_main_closure;
-#endif
-
-PRELUDE_CLOSURE(GHCziIOBase_stackOverflow_closure);
-PRELUDE_CLOSURE(GHCziIOBase_heapOverflow_closure);
-PRELUDE_CLOSURE(GHCziIOBase_BlockedOnDeadMVar_closure);
-PRELUDE_CLOSURE(GHCziIOBase_BlockedIndefinitely_closure);
-PRELUDE_CLOSURE(GHCziIOBase_NonTermination_closure);
-PRELUDE_CLOSURE(GHCziIOBase_NestedAtomically_closure);
-
-PRELUDE_INFO(GHCziBase_Czh_static_info);
-PRELUDE_INFO(GHCziBase_Izh_static_info);
-PRELUDE_INFO(GHCziFloat_Fzh_static_info);
-PRELUDE_INFO(GHCziFloat_Dzh_static_info);
-PRELUDE_INFO(Addr_Azh_static_info);
-PRELUDE_INFO(GHCziPtr_Ptr_static_info);
-PRELUDE_INFO(GHCziPtr_FunPtr_static_info);
-PRELUDE_INFO(GHCziInt_I8zh_static_info);
-PRELUDE_INFO(GHCziInt_I16zh_static_info);
-PRELUDE_INFO(GHCziInt_I32zh_static_info);
-PRELUDE_INFO(GHCziInt_I64zh_static_info);
-PRELUDE_INFO(GHCziWord_Wzh_static_info);
-PRELUDE_INFO(GHCziWord_W8zh_static_info);
-PRELUDE_INFO(GHCziWord_W16zh_static_info);
-PRELUDE_INFO(GHCziWord_W32zh_static_info);
-PRELUDE_INFO(GHCziWord_W64zh_static_info);
-PRELUDE_INFO(GHCziBase_Czh_con_info);
-PRELUDE_INFO(GHCziBase_Izh_con_info);
-PRELUDE_INFO(GHCziFloat_Fzh_con_info);
-PRELUDE_INFO(GHCziFloat_Dzh_con_info);
-PRELUDE_INFO(GHCziPtr_Ptr_con_info);
-PRELUDE_INFO(GHCziPtr_FunPtr_con_info);
-PRELUDE_INFO(Addr_Azh_con_info);
-PRELUDE_INFO(GHCziWord_Wzh_con_info);
-PRELUDE_INFO(GHCziInt_I8zh_con_info);
-PRELUDE_INFO(GHCziInt_I16zh_con_info);
-PRELUDE_INFO(GHCziInt_I32zh_con_info);
-PRELUDE_INFO(GHCziInt_I64zh_con_info);
-PRELUDE_INFO(GHCziWord_W8zh_con_info);
-PRELUDE_INFO(GHCziWord_W16zh_con_info);
-PRELUDE_INFO(GHCziWord_W32zh_con_info);
-PRELUDE_INFO(GHCziWord_W64zh_con_info);
-PRELUDE_INFO(GHCziStable_StablePtr_static_info);
-PRELUDE_INFO(GHCziStable_StablePtr_con_info);
-
-#define True_closure              (&GHCziBase_True_closure)
-#define False_closure             (&GHCziBase_False_closure)
-#define unpackCString_closure     (&GHCziPack_unpackCString_closure)
-#define runFinalizerBatch_closure (&GHCziWeak_runFinalizzerBatch_closure)
-#define mainIO_closure            (&ZCMain_main_closure)
-
-#define stackOverflow_closure     (&GHCziIOBase_stackOverflow_closure)
-#define heapOverflow_closure      (&GHCziIOBase_heapOverflow_closure)
-#define BlockedOnDeadMVar_closure (&GHCziIOBase_BlockedOnDeadMVar_closure)
-#define BlockedIndefinitely_closure (&GHCziIOBase_BlockedIndefinitely_closure)
-#define NonTermination_closure    (&GHCziIOBase_NonTermination_closure)
-#define NestedAtomically_closure  (&GHCziIOBase_NestedAtomically_closure)
-
-#define Czh_static_info           (&GHCziBase_Czh_static_info)
-#define Fzh_static_info           (&GHCziFloat_Fzh_static_info)
-#define Dzh_static_info           (&GHCziFloat_Dzh_static_info)
-#define Azh_static_info           (&Addr_Azh_static_info)
-#define Izh_static_info           (&GHCziBase_Izh_static_info)
-#define I8zh_static_info          (&GHCziInt_I8zh_static_info)
-#define I16zh_static_info         (&GHCziInt_I16zh_static_info)
-#define I32zh_static_info         (&GHCziInt_I32zh_static_info)
-#define I64zh_static_info         (&GHCziInt_I64zh_static_info)
-#define Wzh_static_info           (&GHCziWord_Wzh_static_info)
-#define W8zh_static_info          (&GHCziWord_W8zh_static_info)
-#define W16zh_static_info         (&GHCziWord_W16zh_static_info)
-#define W32zh_static_info         (&GHCziWord_W32zh_static_info)
-#define W64zh_static_info         (&GHCziWord_W64zh_static_info)
-#define Ptr_static_info           (&GHCziPtr_Ptr_static_info)
-#define FunPtr_static_info        (&GHCziPtr_FunPtr_static_info)
-#define Czh_con_info              (&GHCziBase_Czh_con_info)
-#define Izh_con_info              (&GHCziBase_Izh_con_info)
-#define Fzh_con_info              (&GHCziFloat_Fzh_con_info)
-#define Dzh_con_info              (&GHCziFloat_Dzh_con_info)
-#define Azh_con_info              (&Addr_Azh_con_info)
-#define Wzh_con_info              (&GHCziWord_Wzh_con_info)
-#define W8zh_con_info             (&GHCziWord_W8zh_con_info)
-#define W16zh_con_info            (&GHCziWord_W16zh_con_info)
-#define W32zh_con_info            (&GHCziWord_W32zh_con_info)
-#define W64zh_con_info            (&GHCziWord_W64zh_con_info)
-#define I8zh_con_info             (&GHCziInt_I8zh_con_info)
-#define I16zh_con_info            (&GHCziInt_I16zh_con_info)
-#define I32zh_con_info            (&GHCziInt_I32zh_con_info)
-#define I64zh_con_info            (&GHCziInt_I64zh_con_info)
-#define I64zh_con_info            (&GHCziInt_I64zh_con_info)
-#define Ptr_con_info              (&GHCziPtr_Ptr_con_info)
-#define FunPtr_con_info           (&GHCziPtr_FunPtr_con_info)
-#define StablePtr_static_info     (&GHCziStable_StablePtr_static_info)
-#define StablePtr_con_info        (&GHCziStable_StablePtr_con_info)
-
-#endif /* PRELUDE_H */
diff --git a/ghc/rts/PrimOps.cmm b/ghc/rts/PrimOps.cmm
deleted file mode 100644
index f1c214e304..0000000000
--- a/ghc/rts/PrimOps.cmm
+++ /dev/null
@@ -1,2106 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Out-of-line primitive operations
- *
- * This file contains the implementations of all the primitive
- * operations ("primops") which are not expanded inline.  See
- * ghc/compiler/prelude/primops.txt.pp for a list of all the primops;
- * this file contains code for most of those with the attribute
- * out_of_line=True.
- *
- * Entry convention: the entry convention for a primop is that all the
- * args are in Stg registers (R1, R2, etc.).  This is to make writing
- * the primops easier.  (see compiler/codeGen/CgCallConv.hs).
- *
- * Return convention: results from a primop are generally returned
- * using the ordinary unboxed tuple return convention.  The C-- parser
- * implements the RET_xxxx() macros to perform unboxed-tuple returns
- * based on the prevailing return convention.
- *
- * This file is written in a subset of C--, extended with various
- * features specific to GHC.  It is compiled by GHC directly.  For the
- * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Cmm.h"
-
-/*-----------------------------------------------------------------------------
-  Array Primitives
-
-  Basically just new*Array - the others are all inline macros.
-
-  The size arg is always passed in R1, and the result returned in R1.
-
-  The slow entry point is for returning from a heap check, the saved
-  size argument must be re-loaded from the stack.
-  -------------------------------------------------------------------------- */
-
-/* for objects that are *less* than the size of a word, make sure we
- * round up to the nearest word for the size of the array.
- */
-
-newByteArrayzh_fast
-{
-    W_ words, payload_words, n, p;
-    MAYBE_GC(NO_PTRS,newByteArrayzh_fast);
-    n = R1;
-    payload_words = ROUNDUP_BYTES_TO_WDS(n);
-    words = BYTES_TO_WDS(SIZEOF_StgArrWords) + payload_words;
-    "ptr" p = foreign "C" allocateLocal(MyCapability() "ptr",words) [];
-    TICK_ALLOC_PRIM(SIZEOF_StgArrWords,WDS(payload_words),0);
-    SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
-    StgArrWords_words(p) = payload_words;
-    RET_P(p);
-}
-
-newPinnedByteArrayzh_fast
-{
-    W_ words, payload_words, n, p;
-
-    MAYBE_GC(NO_PTRS,newPinnedByteArrayzh_fast);
-    n = R1;
-    payload_words = ROUNDUP_BYTES_TO_WDS(n);
-
-    // We want an 8-byte aligned array.  allocatePinned() gives us
-    // 8-byte aligned memory by default, but we want to align the
-    // *goods* inside the ArrWords object, so we have to check the
-    // size of the ArrWords header and adjust our size accordingly.
-    words = BYTES_TO_WDS(SIZEOF_StgArrWords) + payload_words;
-    if ((SIZEOF_StgArrWords & 7) != 0) {
-	words = words + 1;
-    }
-
-    "ptr" p = foreign "C" allocatePinned(words) [];
-    TICK_ALLOC_PRIM(SIZEOF_StgArrWords,WDS(payload_words),0);
-
-    // Again, if the ArrWords header isn't a multiple of 8 bytes, we
-    // have to push the object forward one word so that the goods
-    // fall on an 8-byte boundary.
-    if ((SIZEOF_StgArrWords & 7) != 0) {
-	p = p + WDS(1);
-    }
-
-    SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
-    StgArrWords_words(p) = payload_words;
-    RET_P(p);
-}
-
-newArrayzh_fast
-{
-    W_ words, n, init, arr, p;
-    /* Args: R1 = words, R2 = initialisation value */
-
-    n = R1;
-    MAYBE_GC(R2_PTR,newArrayzh_fast);
-
-    words = BYTES_TO_WDS(SIZEOF_StgMutArrPtrs) + n;
-    "ptr" arr = foreign "C" allocateLocal(MyCapability() "ptr",words) [R2];
-    TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(n), 0);
-
-    SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]);
-    StgMutArrPtrs_ptrs(arr) = n;
-
-    // Initialise all elements of the the array with the value in R2
-    init = R2;
-    p = arr + SIZEOF_StgMutArrPtrs;
-  for:
-    if (p < arr + WDS(words)) {
-	W_[p] = init;
-	p = p + WDS(1);
-	goto for;
-    }
-
-    RET_P(arr);
-}
-
-unsafeThawArrayzh_fast
-{
-  // SUBTLETY TO DO WITH THE OLD GEN MUTABLE LIST
-  //
-  // A MUT_ARR_PTRS lives on the mutable list, but a MUT_ARR_PTRS_FROZEN 
-  // normally doesn't.  However, when we freeze a MUT_ARR_PTRS, we leave
-  // it on the mutable list for the GC to remove (removing something from
-  // the mutable list is not easy, because the mut_list is only singly-linked).
-  // 
-  // So that we can tell whether a MUT_ARR_PTRS_FROZEN is on the mutable list,
-  // when we freeze it we set the info ptr to be MUT_ARR_PTRS_FROZEN0
-  // to indicate that it is still on the mutable list.
-  //
-  // So, when we thaw a MUT_ARR_PTRS_FROZEN, we must cope with two cases:
-  // either it is on a mut_list, or it isn't.  We adopt the convention that
-  // the closure type is MUT_ARR_PTRS_FROZEN0 if it is on the mutable list,
-  // and MUT_ARR_PTRS_FROZEN otherwise.  In fact it wouldn't matter if
-  // we put it on the mutable list more than once, but it would get scavenged
-  // multiple times during GC, which would be unnecessarily slow.
-  //
-  if (StgHeader_info(R1) != stg_MUT_ARR_PTRS_FROZEN0_info) {
-	SET_INFO(R1,stg_MUT_ARR_PTRS_DIRTY_info);
-	foreign "C" recordMutableLock(R1 "ptr") [R1];
-	// must be done after SET_INFO, because it ASSERTs closure_MUTABLE()
-	RET_P(R1);
-  } else {
-	SET_INFO(R1,stg_MUT_ARR_PTRS_DIRTY_info);
-	RET_P(R1);
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   MutVar primitives
-   -------------------------------------------------------------------------- */
-
-newMutVarzh_fast
-{
-    W_ mv;
-    /* Args: R1 = initialisation value */
-
-    ALLOC_PRIM( SIZEOF_StgMutVar, R1_PTR, newMutVarzh_fast);
-
-    mv = Hp - SIZEOF_StgMutVar + WDS(1);
-    SET_HDR(mv,stg_MUT_VAR_DIRTY_info,W_[CCCS]);
-    StgMutVar_var(mv) = R1;
-    
-    RET_P(mv);
-}
-
-atomicModifyMutVarzh_fast
-{
-    W_ mv, z, x, y, r;
-    /* Args: R1 :: MutVar#,  R2 :: a -> (a,b) */
-
-    /* If x is the current contents of the MutVar#, then 
-       We want to make the new contents point to
-
-         (sel_0 (f x))
- 
-       and the return value is
-	 
-	 (sel_1 (f x))
-
-        obviously we can share (f x).
-
-         z = [stg_ap_2 f x]  (max (HS + 2) MIN_UPD_SIZE)
-	 y = [stg_sel_0 z]   (max (HS + 1) MIN_UPD_SIZE)
-         r = [stg_sel_1 z]   (max (HS + 1) MIN_UPD_SIZE)
-    */
-
-#if MIN_UPD_SIZE > 1
-#define THUNK_1_SIZE (SIZEOF_StgThunkHeader + WDS(MIN_UPD_SIZE))
-#define TICK_ALLOC_THUNK_1() TICK_ALLOC_UP_THK(WDS(1),WDS(MIN_UPD_SIZE-1))
-#else
-#define THUNK_1_SIZE (SIZEOF_StgThunkHeader + WDS(1))
-#define TICK_ALLOC_THUNK_1() TICK_ALLOC_UP_THK(WDS(1),0)
-#endif
-
-#if MIN_UPD_SIZE > 2
-#define THUNK_2_SIZE (SIZEOF_StgThunkHeader + WDS(MIN_UPD_SIZE))
-#define TICK_ALLOC_THUNK_2() TICK_ALLOC_UP_THK(WDS(2),WDS(MIN_UPD_SIZE-2))
-#else
-#define THUNK_2_SIZE (SIZEOF_StgThunkHeader + WDS(2))
-#define TICK_ALLOC_THUNK_2() TICK_ALLOC_UP_THK(WDS(2),0)
-#endif
-
-#define SIZE (THUNK_2_SIZE + THUNK_1_SIZE + THUNK_1_SIZE)
-
-   HP_CHK_GEN_TICKY(SIZE, R1_PTR & R2_PTR, atomicModifyMutVarzh_fast);
-
-#if defined(THREADED_RTS)
-    foreign "C" ACQUIRE_LOCK(atomic_modify_mutvar_mutex "ptr") [R1,R2];
-#endif
-
-   x = StgMutVar_var(R1);
-
-   TICK_ALLOC_THUNK_2();
-   CCCS_ALLOC(THUNK_2_SIZE);
-   z = Hp - THUNK_2_SIZE + WDS(1);
-   SET_HDR(z, stg_ap_2_upd_info, W_[CCCS]);
-   LDV_RECORD_CREATE(z);
-   StgThunk_payload(z,0) = R2;
-   StgThunk_payload(z,1) = x;
-
-   TICK_ALLOC_THUNK_1();
-   CCCS_ALLOC(THUNK_1_SIZE);
-   y = z - THUNK_1_SIZE;
-   SET_HDR(y, stg_sel_0_upd_info, W_[CCCS]);
-   LDV_RECORD_CREATE(y);
-   StgThunk_payload(y,0) = z;
-
-   StgMutVar_var(R1) = y;
-   foreign "C" dirty_MUT_VAR(BaseReg "ptr", R1 "ptr") [R1];
-
-   TICK_ALLOC_THUNK_1();
-   CCCS_ALLOC(THUNK_1_SIZE);
-   r = y - THUNK_1_SIZE;
-   SET_HDR(r, stg_sel_1_upd_info, W_[CCCS]);
-   LDV_RECORD_CREATE(r);
-   StgThunk_payload(r,0) = z;
-
-#if defined(THREADED_RTS)
-    foreign "C" RELEASE_LOCK(atomic_modify_mutvar_mutex "ptr") [];
-#endif
-
-   RET_P(r);
-}
-
-/* -----------------------------------------------------------------------------
-   Weak Pointer Primitives
-   -------------------------------------------------------------------------- */
-
-STRING(stg_weak_msg,"New weak pointer at %p\n")
-
-mkWeakzh_fast
-{
-  /* R1 = key
-     R2 = value
-     R3 = finalizer (or NULL)
-  */
-  W_ w;
-
-  if (R3 == NULL) {
-    R3 = stg_NO_FINALIZER_closure;
-  }
-
-  ALLOC_PRIM( SIZEOF_StgWeak, R1_PTR & R2_PTR & R3_PTR, mkWeakzh_fast );
-
-  w = Hp - SIZEOF_StgWeak + WDS(1);
-  SET_HDR(w, stg_WEAK_info, W_[CCCS]);
-
-  StgWeak_key(w)       = R1;
-  StgWeak_value(w)     = R2;
-  StgWeak_finalizer(w) = R3;
-
-  StgWeak_link(w)	= W_[weak_ptr_list];
-  W_[weak_ptr_list] 	= w;
-
-  IF_DEBUG(weak, foreign "C" debugBelch(stg_weak_msg,w) []);
-
-  RET_P(w);
-}
-
-
-finalizzeWeakzh_fast
-{
-  /* R1 = weak ptr
-   */
-  W_ w, f;
-
-  w = R1;
-
-  // already dead?
-  if (GET_INFO(w) == stg_DEAD_WEAK_info) {
-      RET_NP(0,stg_NO_FINALIZER_closure);
-  }
-
-  // kill it
-#ifdef PROFILING
-  // @LDV profiling
-  // A weak pointer is inherently used, so we do not need to call
-  // LDV_recordDead_FILL_SLOP_DYNAMIC():
-  //    LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)w);
-  // or, LDV_recordDead():
-  //    LDV_recordDead((StgClosure *)w, sizeofW(StgWeak) - sizeofW(StgProfHeader));
-  // Furthermore, when PROFILING is turned on, dead weak pointers are exactly as 
-  // large as weak pointers, so there is no need to fill the slop, either.
-  // See stg_DEAD_WEAK_info in StgMiscClosures.hc.
-#endif
-
-  //
-  // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
-  //
-  SET_INFO(w,stg_DEAD_WEAK_info);
-  LDV_RECORD_CREATE(w);
-
-  f = StgWeak_finalizer(w);
-  StgDeadWeak_link(w) = StgWeak_link(w);
-
-  /* return the finalizer */
-  if (f == stg_NO_FINALIZER_closure) {
-      RET_NP(0,stg_NO_FINALIZER_closure);
-  } else {
-      RET_NP(1,f);
-  }
-}
-
-deRefWeakzh_fast
-{
-  /* R1 = weak ptr */
-  W_ w, code, val;
-
-  w = R1;
-  if (GET_INFO(w) == stg_WEAK_info) {
-    code = 1;
-    val = StgWeak_value(w);
-  } else {
-    code = 0;
-    val = w;
-  }
-  RET_NP(code,val);
-}
-
-/* -----------------------------------------------------------------------------
-   Arbitrary-precision Integer operations.
-
-   There are some assumptions in this code that mp_limb_t == W_.  This is
-   the case for all the platforms that GHC supports, currently.
-   -------------------------------------------------------------------------- */
-
-int2Integerzh_fast
-{
-   /* arguments: R1 = Int# */
-
-   W_ val, s, p;	/* to avoid aliasing */
-
-   val = R1;
-   ALLOC_PRIM( SIZEOF_StgArrWords + WDS(1), NO_PTRS, int2Integerzh_fast );
-
-   p = Hp - SIZEOF_StgArrWords;
-   SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
-   StgArrWords_words(p) = 1;
-
-   /* mpz_set_si is inlined here, makes things simpler */
-   if (%lt(val,0)) { 
-	s  = -1;
-	Hp(0) = -val;
-   } else { 
-     if (%gt(val,0)) {
-	s = 1;
-	Hp(0) = val;
-     } else {
-	s = 0;
-     }
-  }
-
-   /* returns (# size  :: Int#, 
-		 data  :: ByteArray# 
-	       #)
-   */
-   RET_NP(s,p);
-}
-
-word2Integerzh_fast
-{
-   /* arguments: R1 = Word# */
-
-   W_ val, s, p;	/* to avoid aliasing */
-
-   val = R1;
-
-   ALLOC_PRIM( SIZEOF_StgArrWords + WDS(1), NO_PTRS, word2Integerzh_fast);
-
-   p = Hp - SIZEOF_StgArrWords;
-   SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
-   StgArrWords_words(p) = 1;
-
-   if (val != 0) {
-	s = 1;
-	W_[Hp] = val;
-   } else {
-	s = 0;
-   }
-
-   /* returns (# size  :: Int#, 
-		 data  :: ByteArray# #)
-   */
-   RET_NP(s,p);
-}
-
-
-/*
- * 'long long' primops for converting to/from Integers.
- */
-
-#ifdef SUPPORT_LONG_LONGS
-
-int64ToIntegerzh_fast
-{
-   /* arguments: L1 = Int64# */
-
-   L_ val;
-   W_ hi, s, neg, words_needed, p;
-
-   val = L1;
-   neg = 0;
-
-   if ( %ge(val,0x100000000::L_) || %le(val,-0x100000000::L_) )  { 
-       words_needed = 2;
-   } else { 
-       // minimum is one word
-       words_needed = 1;
-   }
-
-   ALLOC_PRIM( SIZEOF_StgArrWords + WDS(words_needed),
-	       NO_PTRS, int64ToIntegerzh_fast );
-
-   p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
-   SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
-   StgArrWords_words(p) = words_needed;
-
-   if ( %lt(val,0::L_) ) {
-     neg = 1;
-     val = -val;
-   }
-
-   hi = TO_W_(val >> 32);
-
-   if ( words_needed == 2 )  { 
-      s = 2;
-      Hp(-1) = TO_W_(val);
-      Hp(0) = hi;
-   } else { 
-       if ( val != 0::L_ ) {
-	   s = 1;
-	   Hp(0) = TO_W_(val);
-       } else /* val==0 */  {
-	   s = 0;
-       }
-   }
-   if ( neg != 0 ) {
-	s = -s;
-   }
-
-   /* returns (# size  :: Int#, 
-		 data  :: ByteArray# #)
-   */
-   RET_NP(s,p);
-}
-
-word64ToIntegerzh_fast
-{
-   /* arguments: L1 = Word64# */
-
-   L_ val;
-   W_ hi, s, words_needed, p;
-
-   val = L1;
-   if ( val >= 0x100000000::L_ ) {
-      words_needed = 2;
-   } else {
-      words_needed = 1;
-   }
-
-   ALLOC_PRIM( SIZEOF_StgArrWords + WDS(words_needed),
-	       NO_PTRS, word64ToIntegerzh_fast );
-
-   p = Hp - SIZEOF_StgArrWords - WDS(words_needed) + WDS(1);
-   SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
-   StgArrWords_words(p) = words_needed;
-
-   hi = TO_W_(val >> 32);
-   if ( val >= 0x100000000::L_ ) { 
-     s = 2;
-     Hp(-1) = TO_W_(val);
-     Hp(0)  = hi;
-   } else {
-      if ( val != 0::L_ ) {
-        s = 1;
-        Hp(0) = TO_W_(val);
-     } else /* val==0 */  {
-      s = 0;
-     }
-  }
-
-   /* returns (# size  :: Int#, 
-		 data  :: ByteArray# #)
-   */
-   RET_NP(s,p);
-}
-
-
-#endif /* SUPPORT_LONG_LONGS */
-
-/* ToDo: this is shockingly inefficient */
-
-#ifndef THREADED_RTS
-section "bss" {
-  mp_tmp1:
-    bits8 [SIZEOF_MP_INT];
-}
-
-section "bss" {
-  mp_tmp2:
-    bits8 [SIZEOF_MP_INT];
-}
-
-section "bss" {
-  mp_result1:
-    bits8 [SIZEOF_MP_INT];
-}
-
-section "bss" {
-  mp_result2:
-    bits8 [SIZEOF_MP_INT];
-}
-#endif
-
-#ifdef THREADED_RTS
-#define FETCH_MP_TEMP(X) \
-W_ X; \
-X = BaseReg + (OFFSET_StgRegTable_r ## X);
-#else
-#define FETCH_MP_TEMP(X) /* Nothing */
-#endif
-
-#define GMP_TAKE2_RET1(name,mp_fun)                                     \
-name                                                                    \
-{                                                                       \
-  CInt s1, s2;                                                          \
-  W_ d1, d2;                                                            \
-  FETCH_MP_TEMP(mp_tmp1);                                               \
-  FETCH_MP_TEMP(mp_tmp2);                                               \
-  FETCH_MP_TEMP(mp_result1)                                             \
-  FETCH_MP_TEMP(mp_result2);                                            \
-                                                                        \
-  /* call doYouWantToGC() */                                            \
-  MAYBE_GC(R2_PTR & R4_PTR, name);                                      \
-                                                                        \
-  s1 = W_TO_INT(R1);                                                    \
-  d1 = R2;                                                              \
-  s2 = W_TO_INT(R3);                                                    \
-  d2 = R4;                                                              \
-                                                                        \
-  MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1));          \
-  MP_INT__mp_size(mp_tmp1)  = (s1);                                     \
-  MP_INT__mp_d(mp_tmp1)	    = BYTE_ARR_CTS(d1);                         \
-  MP_INT__mp_alloc(mp_tmp2) = W_TO_INT(StgArrWords_words(d2));          \
-  MP_INT__mp_size(mp_tmp2)  = (s2);                                     \
-  MP_INT__mp_d(mp_tmp2)	    = BYTE_ARR_CTS(d2);                         \
-                                                                        \
-  foreign "C" mpz_init(mp_result1 "ptr") [];                            \
-                                                                        \
-  /* Perform the operation */                                           \
-  foreign "C" mp_fun(mp_result1 "ptr",mp_tmp1  "ptr",mp_tmp2  "ptr") []; \
-                                                                        \
-  RET_NP(TO_W_(MP_INT__mp_size(mp_result1)),                            \
-         MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords);                \
-}
-
-#define GMP_TAKE1_RET1(name,mp_fun)                                     \
-name                                                                    \
-{                                                                       \
-  CInt s1;                                                              \
-  W_ d1;                                                                \
-  FETCH_MP_TEMP(mp_tmp1);                                               \
-  FETCH_MP_TEMP(mp_result1)                                             \
-                                                                        \
-  /* call doYouWantToGC() */                                            \
-  MAYBE_GC(R2_PTR, name);                                               \
-                                                                        \
-  d1 = R2;                                                              \
-  s1 = W_TO_INT(R1);                                                    \
-                                                                        \
-  MP_INT__mp_alloc(mp_tmp1)	= W_TO_INT(StgArrWords_words(d1));      \
-  MP_INT__mp_size(mp_tmp1)	= (s1);                                 \
-  MP_INT__mp_d(mp_tmp1)		= BYTE_ARR_CTS(d1);                     \
-                                                                        \
-  foreign "C" mpz_init(mp_result1 "ptr") [];                            \
-                                                                        \
-  /* Perform the operation */                                           \
-  foreign "C" mp_fun(mp_result1 "ptr",mp_tmp1 "ptr") [];                \
-                                                                        \
-  RET_NP(TO_W_(MP_INT__mp_size(mp_result1)),                            \
-         MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords);                \
-}
-
-#define GMP_TAKE2_RET2(name,mp_fun)                                                     \
-name                                                                                    \
-{                                                                                       \
-  CInt s1, s2;                                                                          \
-  W_ d1, d2;                                                                            \
-  FETCH_MP_TEMP(mp_tmp1);                                                               \
-  FETCH_MP_TEMP(mp_tmp2);                                                               \
-  FETCH_MP_TEMP(mp_result1)                                                             \
-  FETCH_MP_TEMP(mp_result2)                                                             \
-                                                                                        \
-  /* call doYouWantToGC() */                                                            \
-  MAYBE_GC(R2_PTR & R4_PTR, name);                                                      \
-                                                                                        \
-  s1 = W_TO_INT(R1);                                                                    \
-  d1 = R2;                                                                              \
-  s2 = W_TO_INT(R3);                                                                    \
-  d2 = R4;                                                                              \
-                                                                                        \
-  MP_INT__mp_alloc(mp_tmp1)	= W_TO_INT(StgArrWords_words(d1));                      \
-  MP_INT__mp_size(mp_tmp1)	= (s1);                                                 \
-  MP_INT__mp_d(mp_tmp1)		= BYTE_ARR_CTS(d1);                                     \
-  MP_INT__mp_alloc(mp_tmp2)	= W_TO_INT(StgArrWords_words(d2));                      \
-  MP_INT__mp_size(mp_tmp2)	= (s2);                                                 \
-  MP_INT__mp_d(mp_tmp2)		= BYTE_ARR_CTS(d2);                                     \
-                                                                                        \
-  foreign "C" mpz_init(mp_result1 "ptr") [];                                               \
-  foreign "C" mpz_init(mp_result2 "ptr") [];                                               \
-                                                                                        \
-  /* Perform the operation */                                                           \
-  foreign "C" mp_fun(mp_result1 "ptr",mp_result2 "ptr",mp_tmp1 "ptr",mp_tmp2 "ptr") [];    \
-                                                                                        \
-  RET_NPNP(TO_W_(MP_INT__mp_size(mp_result1)),                                          \
-           MP_INT__mp_d(mp_result1) - SIZEOF_StgArrWords,                               \
-	   TO_W_(MP_INT__mp_size(mp_result2)),                                          \
-           MP_INT__mp_d(mp_result2) - SIZEOF_StgArrWords);                              \
-}
-
-GMP_TAKE2_RET1(plusIntegerzh_fast,     mpz_add)
-GMP_TAKE2_RET1(minusIntegerzh_fast,    mpz_sub)
-GMP_TAKE2_RET1(timesIntegerzh_fast,    mpz_mul)
-GMP_TAKE2_RET1(gcdIntegerzh_fast,      mpz_gcd)
-GMP_TAKE2_RET1(quotIntegerzh_fast,     mpz_tdiv_q)
-GMP_TAKE2_RET1(remIntegerzh_fast,      mpz_tdiv_r)
-GMP_TAKE2_RET1(divExactIntegerzh_fast, mpz_divexact)
-GMP_TAKE2_RET1(andIntegerzh_fast,      mpz_and)
-GMP_TAKE2_RET1(orIntegerzh_fast,       mpz_ior)
-GMP_TAKE2_RET1(xorIntegerzh_fast,      mpz_xor)
-GMP_TAKE1_RET1(complementIntegerzh_fast, mpz_com)
-
-GMP_TAKE2_RET2(quotRemIntegerzh_fast, mpz_tdiv_qr)
-GMP_TAKE2_RET2(divModIntegerzh_fast,  mpz_fdiv_qr)
-
-#ifndef THREADED_RTS
-section "bss" {
-  mp_tmp_w:  W_; // NB. mp_tmp_w is really an here mp_limb_t
-}
-#endif
-
-gcdIntzh_fast
-{
-    /* R1 = the first Int#; R2 = the second Int# */
-    W_ r; 
-    FETCH_MP_TEMP(mp_tmp_w);
-
-    W_[mp_tmp_w] = R1;
-    r = foreign "C" mpn_gcd_1(mp_tmp_w "ptr", 1, R2) [];
-
-    R1 = r;
-    /* Result parked in R1, return via info-pointer at TOS */
-    jump %ENTRY_CODE(Sp(0));
-}
-
-
-gcdIntegerIntzh_fast
-{
-    /* R1 = s1; R2 = d1; R3 = the int */
-    R1 = foreign "C" mpn_gcd_1( BYTE_ARR_CTS(R2) "ptr", R1, R3) [];
-    
-    /* Result parked in R1, return via info-pointer at TOS */
-    jump %ENTRY_CODE(Sp(0));
-}
-
-
-cmpIntegerIntzh_fast
-{
-    /* R1 = s1; R2 = d1; R3 = the int */
-    W_ usize, vsize, v_digit, u_digit;
-
-    usize = R1;
-    vsize = 0;
-    v_digit = R3;
-
-    // paraphrased from mpz_cmp_si() in the GMP sources
-    if (%gt(v_digit,0)) {
-	vsize = 1;
-    } else { 
-	if (%lt(v_digit,0)) {
-	    vsize = -1;
-	    v_digit = -v_digit;
-	}
-    }
-
-    if (usize != vsize) {
-	R1 = usize - vsize; 
-	jump %ENTRY_CODE(Sp(0));
-    }
-
-    if (usize == 0) {
-	R1 = 0; 
-	jump %ENTRY_CODE(Sp(0));
-    }
-
-    u_digit = W_[BYTE_ARR_CTS(R2)];
-
-    if (u_digit == v_digit) {
-	R1 = 0; 
-	jump %ENTRY_CODE(Sp(0));
-    }
-
-    if (%gtu(u_digit,v_digit)) { // NB. unsigned: these are mp_limb_t's
-	R1 = usize; 
-    } else {
-	R1 = -usize; 
-    }
-
-    jump %ENTRY_CODE(Sp(0));
-}
-
-cmpIntegerzh_fast
-{
-    /* R1 = s1; R2 = d1; R3 = s2; R4 = d2 */
-    W_ usize, vsize, size, up, vp;
-    CInt cmp;
-
-    // paraphrased from mpz_cmp() in the GMP sources
-    usize = R1;
-    vsize = R3;
-
-    if (usize != vsize) {
-	R1 = usize - vsize; 
-	jump %ENTRY_CODE(Sp(0));
-    }
-
-    if (usize == 0) {
-	R1 = 0; 
-	jump %ENTRY_CODE(Sp(0));
-    }
-
-    if (%lt(usize,0)) { // NB. not <, which is unsigned
-	size = -usize;
-    } else {
-	size = usize;
-    }
-
-    up = BYTE_ARR_CTS(R2);
-    vp = BYTE_ARR_CTS(R4);
-
-    cmp = foreign "C" mpn_cmp(up "ptr", vp "ptr", size) [];
-
-    if (cmp == 0 :: CInt) {
-	R1 = 0; 
-	jump %ENTRY_CODE(Sp(0));
-    }
-
-    if (%lt(cmp,0 :: CInt) == %lt(usize,0)) {
-	R1 = 1;
-    } else {
-	R1 = (-1); 
-    }
-    /* Result parked in R1, return via info-pointer at TOS */
-    jump %ENTRY_CODE(Sp(0));
-}
-
-integer2Intzh_fast
-{
-    /* R1 = s; R2 = d */
-    W_ r, s;
-
-    s = R1;
-    if (s == 0) {
-	r = 0;
-    } else {
-	r = W_[R2 + SIZEOF_StgArrWords];
-	if (%lt(s,0)) {
-	    r = -r;
-	}
-    }
-    /* Result parked in R1, return via info-pointer at TOS */
-    R1 = r;
-    jump %ENTRY_CODE(Sp(0));
-}
-
-integer2Wordzh_fast
-{
-  /* R1 = s; R2 = d */
-  W_ r, s;
-
-  s = R1;
-  if (s == 0) {
-    r = 0;
-  } else {
-    r = W_[R2 + SIZEOF_StgArrWords];
-    if (%lt(s,0)) {
-	r = -r;
-    }
-  }
-  /* Result parked in R1, return via info-pointer at TOS */
-  R1 = r;
-  jump %ENTRY_CODE(Sp(0));
-}
-
-decodeFloatzh_fast
-{ 
-    W_ p;
-    F_ arg;
-    FETCH_MP_TEMP(mp_tmp1);
-    FETCH_MP_TEMP(mp_tmp_w);
-    
-    /* arguments: F1 = Float# */
-    arg = F1;
-    
-    ALLOC_PRIM( SIZEOF_StgArrWords + WDS(1), NO_PTRS, decodeFloatzh_fast );
-    
-    /* Be prepared to tell Lennart-coded __decodeFloat
-       where mantissa._mp_d can be put (it does not care about the rest) */
-    p = Hp - SIZEOF_StgArrWords;
-    SET_HDR(p,stg_ARR_WORDS_info,W_[CCCS]);
-    StgArrWords_words(p) = 1;
-    MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(p);
-    
-    /* Perform the operation */
-    foreign "C" __decodeFloat(mp_tmp1 "ptr",mp_tmp_w "ptr" ,arg) [];
-    
-    /* returns: (Int# (expn), Int#, ByteArray#) */
-    RET_NNP(W_[mp_tmp_w], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
-}
-
-#define DOUBLE_MANTISSA_SIZE SIZEOF_DOUBLE
-#define ARR_SIZE (SIZEOF_StgArrWords + DOUBLE_MANTISSA_SIZE)
-
-decodeDoublezh_fast
-{ 
-    D_ arg;
-    W_ p;
-    FETCH_MP_TEMP(mp_tmp1);
-    FETCH_MP_TEMP(mp_tmp_w);
-
-    /* arguments: D1 = Double# */
-    arg = D1;
-
-    ALLOC_PRIM( ARR_SIZE, NO_PTRS, decodeDoublezh_fast );
-    
-    /* Be prepared to tell Lennart-coded __decodeDouble
-       where mantissa.d can be put (it does not care about the rest) */
-    p = Hp - ARR_SIZE + WDS(1);
-    SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
-    StgArrWords_words(p) = BYTES_TO_WDS(DOUBLE_MANTISSA_SIZE);
-    MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(p);
-
-    /* Perform the operation */
-    foreign "C" __decodeDouble(mp_tmp1 "ptr", mp_tmp_w "ptr",arg) [];
-    
-    /* returns: (Int# (expn), Int#, ByteArray#) */
-    RET_NNP(W_[mp_tmp_w], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
-}
-
-/* -----------------------------------------------------------------------------
- * Concurrency primitives
- * -------------------------------------------------------------------------- */
-
-forkzh_fast
-{
-  /* args: R1 = closure to spark */
-
-  MAYBE_GC(R1_PTR, forkzh_fast);
-
-  W_ closure;
-  W_ threadid;
-  closure = R1;
-
-  "ptr" threadid = foreign "C" createIOThread( MyCapability() "ptr", 
-				RtsFlags_GcFlags_initialStkSize(RtsFlags), 
-				closure "ptr") [];
-  foreign "C" scheduleThread(MyCapability() "ptr", threadid "ptr") [];
-
-  // switch at the earliest opportunity
-  CInt[context_switch] = 1 :: CInt;
-  
-  RET_P(threadid);
-}
-
-forkOnzh_fast
-{
-  /* args: R1 = cpu, R2 = closure to spark */
-
-  MAYBE_GC(R2_PTR, forkOnzh_fast);
-
-  W_ cpu;
-  W_ closure;
-  W_ threadid;
-  cpu = R1;
-  closure = R2;
-
-  "ptr" threadid = foreign "C" createIOThread( MyCapability() "ptr", 
-				RtsFlags_GcFlags_initialStkSize(RtsFlags), 
-				closure "ptr") [];
-  foreign "C" scheduleThreadOn(MyCapability() "ptr", cpu, threadid "ptr") [];
-
-  // switch at the earliest opportunity
-  CInt[context_switch] = 1 :: CInt;
-  
-  RET_P(threadid);
-}
-
-yieldzh_fast
-{
-  jump stg_yield_noregs;
-}
-
-myThreadIdzh_fast
-{
-  /* no args. */
-  RET_P(CurrentTSO);
-}
-
-labelThreadzh_fast
-{
-  /* args: 
-	R1 = ThreadId#
-	R2 = Addr# */
-#ifdef DEBUG
-  foreign "C" labelThread(R1 "ptr", R2 "ptr") [];
-#endif
-  jump %ENTRY_CODE(Sp(0));
-}
-
-isCurrentThreadBoundzh_fast
-{
-  /* no args */
-  W_ r;
-  r = foreign "C" isThreadBound(CurrentTSO) [];
-  RET_N(r);
-}
-
-
-/* -----------------------------------------------------------------------------
- * TVar primitives
- * -------------------------------------------------------------------------- */
-
-#ifdef REG_R1
-#define SP_OFF 0
-#define IF_NOT_REG_R1(x) 
-#else
-#define SP_OFF 1
-#define IF_NOT_REG_R1(x) x
-#endif
-
-// Catch retry frame ------------------------------------------------------------
-
-#define CATCH_RETRY_FRAME_ERROR(label) \
-  label { foreign "C" barf("catch_retry_frame incorrectly entered!"); }
-
-CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_0_ret)
-CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_1_ret)
-CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_2_ret)
-CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_3_ret)
-CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_4_ret)
-CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_5_ret)
-CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_6_ret)
-CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_7_ret)
-
-#if MAX_VECTORED_RTN > 8
-#error MAX_VECTORED_RTN has changed: please modify stg_catch_retry_frame too.
-#endif
-
-#if defined(PROFILING)
-#define CATCH_RETRY_FRAME_BITMAP 7
-#define CATCH_RETRY_FRAME_WORDS  6
-#else
-#define CATCH_RETRY_FRAME_BITMAP 1
-#define CATCH_RETRY_FRAME_WORDS  4
-#endif
-
-INFO_TABLE_RET(stg_catch_retry_frame,
-	       CATCH_RETRY_FRAME_WORDS, CATCH_RETRY_FRAME_BITMAP,
-	       CATCH_RETRY_FRAME,
-	       stg_catch_retry_frame_0_ret,
-	       stg_catch_retry_frame_1_ret,
-	       stg_catch_retry_frame_2_ret,
-	       stg_catch_retry_frame_3_ret,
-	       stg_catch_retry_frame_4_ret,
-	       stg_catch_retry_frame_5_ret,
-	       stg_catch_retry_frame_6_ret,
-	       stg_catch_retry_frame_7_ret)
-{
-   W_ r, frame, trec, outer;
-   IF_NOT_REG_R1(W_ rval;  rval = Sp(0);  Sp_adj(1); )
-
-   frame = Sp;
-   trec = StgTSO_trec(CurrentTSO);
-   "ptr" outer = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
-   r = foreign "C" stmCommitNestedTransaction(MyCapability() "ptr", trec "ptr") [];
-   if (r) {
-     /* Succeeded (either first branch or second branch) */
-     StgTSO_trec(CurrentTSO) = outer;
-     Sp = Sp + SIZEOF_StgCatchRetryFrame;
-     IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)
-     jump %ENTRY_CODE(Sp(SP_OFF));
-   } else {
-     /* Did not commit: retry */
-     W_ new_trec;
-     "ptr" new_trec = foreign "C" stmStartTransaction(MyCapability() "ptr", outer "ptr") [];
-     StgTSO_trec(CurrentTSO) = new_trec;
-     if (StgCatchRetryFrame_running_alt_code(frame)) {
-       R1 = StgCatchRetryFrame_alt_code(frame);
-     } else {
-       R1 = StgCatchRetryFrame_first_code(frame);
-       StgCatchRetryFrame_first_code_trec(frame) = new_trec;
-     }
-     jump stg_ap_v_fast;
-   }
-}
-
-
-// Atomically frame -------------------------------------------------------------
-
-
-#define ATOMICALLY_FRAME_ERROR(label) \
-  label { foreign "C" barf("atomically_frame incorrectly entered!"); }
-
-ATOMICALLY_FRAME_ERROR(stg_atomically_frame_0_ret)
-ATOMICALLY_FRAME_ERROR(stg_atomically_frame_1_ret)
-ATOMICALLY_FRAME_ERROR(stg_atomically_frame_2_ret)
-ATOMICALLY_FRAME_ERROR(stg_atomically_frame_3_ret)
-ATOMICALLY_FRAME_ERROR(stg_atomically_frame_4_ret)
-ATOMICALLY_FRAME_ERROR(stg_atomically_frame_5_ret)
-ATOMICALLY_FRAME_ERROR(stg_atomically_frame_6_ret)
-ATOMICALLY_FRAME_ERROR(stg_atomically_frame_7_ret)
-
-#if MAX_VECTORED_RTN > 8
-#error MAX_VECTORED_RTN has changed: please modify stg_atomically_frame too.
-#endif
-
-#if defined(PROFILING)
-#define ATOMICALLY_FRAME_BITMAP 3
-#define ATOMICALLY_FRAME_WORDS  3
-#else
-#define ATOMICALLY_FRAME_BITMAP 0
-#define ATOMICALLY_FRAME_WORDS  1
-#endif
-
-
-INFO_TABLE_RET(stg_atomically_frame,
-	       ATOMICALLY_FRAME_WORDS, ATOMICALLY_FRAME_BITMAP,
-	       ATOMICALLY_FRAME,
-	       stg_atomically_frame_0_ret,
-	       stg_atomically_frame_1_ret,
-	       stg_atomically_frame_2_ret,
-	       stg_atomically_frame_3_ret,
-	       stg_atomically_frame_4_ret,
-	       stg_atomically_frame_5_ret,
-	       stg_atomically_frame_6_ret,
-	       stg_atomically_frame_7_ret)
-{
-  W_ frame, trec, valid;
-  IF_NOT_REG_R1(W_ rval;  rval = Sp(0);  Sp_adj(1); )
-
-  frame = Sp;
-  trec = StgTSO_trec(CurrentTSO);
-
-  /* The TSO is not currently waiting: try to commit the transaction */
-  valid = foreign "C" stmCommitTransaction(MyCapability() "ptr", trec "ptr") [];
-  if (valid) {
-    /* Transaction was valid: commit succeeded */
-    StgTSO_trec(CurrentTSO) = NO_TREC;
-    Sp = Sp + SIZEOF_StgAtomicallyFrame;
-    IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)
-    jump %ENTRY_CODE(Sp(SP_OFF));
-  } else {
-    /* Transaction was not valid: try again */
-    "ptr" trec = foreign "C" stmStartTransaction(MyCapability() "ptr", NO_TREC "ptr") [];
-    StgTSO_trec(CurrentTSO) = trec;
-    R1 = StgAtomicallyFrame_code(frame);
-    jump stg_ap_v_fast;
-  }
-}
-
-INFO_TABLE_RET(stg_atomically_waiting_frame,
-	       ATOMICALLY_FRAME_WORDS, ATOMICALLY_FRAME_BITMAP,
-	       ATOMICALLY_FRAME,
-	       stg_atomically_frame_0_ret,
-	       stg_atomically_frame_1_ret,
-	       stg_atomically_frame_2_ret,
-	       stg_atomically_frame_3_ret,
-	       stg_atomically_frame_4_ret,
-	       stg_atomically_frame_5_ret,
-	       stg_atomically_frame_6_ret,
-	       stg_atomically_frame_7_ret)
-{
-  W_ frame, trec, valid;
-  IF_NOT_REG_R1(W_ rval;  rval = Sp(0);  Sp_adj(1); )
-
-  frame = Sp;
-
-  /* The TSO is currently waiting: should we stop waiting? */
-  valid = foreign "C" stmReWait(MyCapability() "ptr", CurrentTSO "ptr") [];
-  if (valid) {
-    /* Previous attempt is still valid: no point trying again yet */
-	  IF_NOT_REG_R1(Sp_adj(-2);
-			Sp(1) = stg_NO_FINALIZER_closure;
-		  	Sp(0) = stg_ut_1_0_unreg_info;)
-    jump stg_block_noregs;
-  } else {
-    /* Previous attempt is no longer valid: try again */
-    "ptr" trec = foreign "C" stmStartTransaction(MyCapability() "ptr", NO_TREC "ptr") [];
-    StgTSO_trec(CurrentTSO) = trec;
-    StgHeader_info(frame) = stg_atomically_frame_info;
-    R1 = StgAtomicallyFrame_code(frame);
-    jump stg_ap_v_fast;
-  }
-}
-
-// STM catch frame --------------------------------------------------------------
-
-#define CATCH_STM_FRAME_ENTRY_TEMPLATE(label,ret)          \
-   label                                                   \
-   {                                                       \
-      IF_NOT_REG_R1(W_ rval;  rval = Sp(0);  Sp_adj(1); )  \
-      Sp = Sp + SIZEOF_StgCatchSTMFrame;                   \
-      IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)             \
-      jump ret;                                            \
-   }
-
-#ifdef REG_R1
-#define SP_OFF 0
-#else
-#define SP_OFF 1
-#endif
-
-CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_0_ret,%RET_VEC(Sp(SP_OFF),0))
-CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_1_ret,%RET_VEC(Sp(SP_OFF),1))
-CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_2_ret,%RET_VEC(Sp(SP_OFF),2))
-CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_3_ret,%RET_VEC(Sp(SP_OFF),3))
-CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_4_ret,%RET_VEC(Sp(SP_OFF),4))
-CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_5_ret,%RET_VEC(Sp(SP_OFF),5))
-CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_6_ret,%RET_VEC(Sp(SP_OFF),6))
-CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_7_ret,%RET_VEC(Sp(SP_OFF),7))
-
-#if MAX_VECTORED_RTN > 8
-#error MAX_VECTORED_RTN has changed: please modify stg_catch_stm_frame too.
-#endif
-
-#if defined(PROFILING)
-#define CATCH_STM_FRAME_BITMAP 3
-#define CATCH_STM_FRAME_WORDS  3
-#else
-#define CATCH_STM_FRAME_BITMAP 0
-#define CATCH_STM_FRAME_WORDS  1
-#endif
-
-/* Catch frames are very similar to update frames, but when entering
- * one we just pop the frame off the stack and perform the correct
- * kind of return to the activation record underneath us on the stack.
- */
-
-INFO_TABLE_RET(stg_catch_stm_frame,
-	       CATCH_STM_FRAME_WORDS, CATCH_STM_FRAME_BITMAP,
-	       CATCH_STM_FRAME,
-	       stg_catch_stm_frame_0_ret,
-	       stg_catch_stm_frame_1_ret,
-	       stg_catch_stm_frame_2_ret,
-	       stg_catch_stm_frame_3_ret,
-	       stg_catch_stm_frame_4_ret,
-	       stg_catch_stm_frame_5_ret,
-	       stg_catch_stm_frame_6_ret,
-	       stg_catch_stm_frame_7_ret)
-CATCH_STM_FRAME_ENTRY_TEMPLATE(,%ENTRY_CODE(Sp(SP_OFF)))
-
-
-// Primop definition ------------------------------------------------------------
-
-atomicallyzh_fast
-{
-  W_ frame;
-  W_ old_trec;
-  W_ new_trec;
-  
-  // stmStartTransaction may allocate
-  MAYBE_GC (R1_PTR, atomicallyzh_fast); 
-
-  /* Args: R1 = m :: STM a */
-  STK_CHK_GEN(SIZEOF_StgAtomicallyFrame + WDS(1), R1_PTR, atomicallyzh_fast);
-
-  old_trec = StgTSO_trec(CurrentTSO);
-
-  /* Nested transactions are not allowed; raise an exception */
-  if (old_trec != NO_TREC) {
-     R1 = GHCziIOBase_NestedAtomically_closure;
-     jump raisezh_fast;
-  }
-
-  /* Set up the atomically frame */
-  Sp = Sp - SIZEOF_StgAtomicallyFrame;
-  frame = Sp;
-
-  SET_HDR(frame,stg_atomically_frame_info, W_[CCCS]);
-  StgAtomicallyFrame_code(frame) = R1;
-
-  /* Start the memory transcation */
-  "ptr" new_trec = foreign "C" stmStartTransaction(MyCapability() "ptr", old_trec "ptr") [R1];
-  StgTSO_trec(CurrentTSO) = new_trec;
-
-  /* Apply R1 to the realworld token */
-  jump stg_ap_v_fast;
-}
-
-
-catchSTMzh_fast
-{
-  W_ frame;
-  
-  /* Args: R1 :: STM a */
-  /* Args: R2 :: Exception -> STM a */
-  STK_CHK_GEN(SIZEOF_StgCatchSTMFrame + WDS(1), R1_PTR & R2_PTR, catchSTMzh_fast);
-
-  /* Set up the catch frame */
-  Sp = Sp - SIZEOF_StgCatchSTMFrame;
-  frame = Sp;
-
-  SET_HDR(frame, stg_catch_stm_frame_info, W_[CCCS]);
-  StgCatchSTMFrame_handler(frame) = R2;
-
-  /* Apply R1 to the realworld token */
-  jump stg_ap_v_fast;
-}
-
-
-catchRetryzh_fast
-{
-  W_ frame;
-  W_ new_trec;
-  W_ trec;
-
-  // stmStartTransaction may allocate
-  MAYBE_GC (R1_PTR & R2_PTR, catchRetryzh_fast); 
-
-  /* Args: R1 :: STM a */
-  /* Args: R2 :: STM a */
-  STK_CHK_GEN(SIZEOF_StgCatchRetryFrame + WDS(1), R1_PTR & R2_PTR, catchRetryzh_fast);
-
-  /* Start a nested transaction within which to run the first code */
-  trec = StgTSO_trec(CurrentTSO);
-  "ptr" new_trec = foreign "C" stmStartTransaction(MyCapability() "ptr", trec "ptr") [R1,R2];
-  StgTSO_trec(CurrentTSO) = new_trec;
-
-  /* Set up the catch-retry frame */
-  Sp = Sp - SIZEOF_StgCatchRetryFrame;
-  frame = Sp;
-  
-  SET_HDR(frame, stg_catch_retry_frame_info, W_[CCCS]);
-  StgCatchRetryFrame_running_alt_code(frame) = 0 :: CInt; // false;
-  StgCatchRetryFrame_first_code(frame) = R1;
-  StgCatchRetryFrame_alt_code(frame) = R2;
-  StgCatchRetryFrame_first_code_trec(frame) = new_trec;
-
-  /* Apply R1 to the realworld token */
-  jump stg_ap_v_fast;
-}
-
-
-retryzh_fast
-{
-  W_ frame_type;
-  W_ frame;
-  W_ trec;
-  W_ outer;
-  W_ r;
-
-  MAYBE_GC (NO_PTRS, retryzh_fast); // STM operations may allocate
-
-  // Find the enclosing ATOMICALLY_FRAME or CATCH_RETRY_FRAME
-retry_pop_stack:
-  trec = StgTSO_trec(CurrentTSO);
-  "ptr" outer = foreign "C" stmGetEnclosingTRec(trec "ptr") [];
-  StgTSO_sp(CurrentTSO) = Sp;
-  frame_type = foreign "C" findRetryFrameHelper(CurrentTSO "ptr") [];
-  Sp = StgTSO_sp(CurrentTSO);
-  frame = Sp;
-
-  if (frame_type == CATCH_RETRY_FRAME) {
-    // The retry reaches a CATCH_RETRY_FRAME before the atomic frame
-    ASSERT(outer != NO_TREC);
-    if (!StgCatchRetryFrame_running_alt_code(frame)) {
-      // Retry in the first code: try the alternative
-      "ptr" trec = foreign "C" stmStartTransaction(MyCapability() "ptr", outer "ptr") [];
-      StgTSO_trec(CurrentTSO) = trec;
-      StgCatchRetryFrame_running_alt_code(frame) = 1 :: CInt; // true;
-      R1 = StgCatchRetryFrame_alt_code(frame);
-      jump stg_ap_v_fast;
-    } else {
-      // Retry in the alternative code: propagate
-      W_ other_trec;
-      other_trec = StgCatchRetryFrame_first_code_trec(frame);
-      r = foreign "C" stmCommitNestedTransaction(MyCapability() "ptr", other_trec "ptr") [];
-      if (r) {
-        r = foreign "C" stmCommitNestedTransaction(MyCapability() "ptr", trec "ptr") [];
-      } else {
-        foreign "C" stmAbortTransaction(MyCapability() "ptr", trec "ptr") [];
-      }
-      if (r) {
-        // Merge between siblings succeeded: commit it back to enclosing transaction
-        // and then propagate the retry
-        StgTSO_trec(CurrentTSO) = outer;
-        Sp = Sp + SIZEOF_StgCatchRetryFrame;
-        goto retry_pop_stack;
-      } else {
-        // Merge failed: we musn't propagate the retry.  Try both paths again.
-        "ptr" trec = foreign "C" stmStartTransaction(MyCapability() "ptr", outer "ptr") [];
-        StgCatchRetryFrame_first_code_trec(frame) = trec;
-        StgCatchRetryFrame_running_alt_code(frame) = 0 :: CInt; // false;
-        StgTSO_trec(CurrentTSO) = trec;
-        R1 = StgCatchRetryFrame_first_code(frame);
-        jump stg_ap_v_fast;
-      }
-    }
-  }
-
-  // We've reached the ATOMICALLY_FRAME: attempt to wait 
-  ASSERT(frame_type == ATOMICALLY_FRAME);
-  ASSERT(outer == NO_TREC);
-  r = foreign "C" stmWait(MyCapability() "ptr", CurrentTSO "ptr", trec "ptr") [];
-  if (r) {
-    // Transaction was valid: stmWait put us on the TVars' queues, we now block
-    StgHeader_info(frame) = stg_atomically_waiting_frame_info;
-    Sp = frame;
-    // Fix up the stack in the unregisterised case: the return convention is different.
-    IF_NOT_REG_R1(Sp_adj(-2); 
-		  Sp(1) = stg_NO_FINALIZER_closure;
-		  Sp(0) = stg_ut_1_0_unreg_info;)
-    R3 = trec; // passing to stmWaitUnblock()
-    jump stg_block_stmwait;
-  } else {
-    // Transaction was not valid: retry immediately
-    "ptr" trec = foreign "C" stmStartTransaction(MyCapability() "ptr", outer "ptr") [];
-    StgTSO_trec(CurrentTSO) = trec;
-    R1 = StgAtomicallyFrame_code(frame);
-    Sp = frame;
-    jump stg_ap_v_fast;
-  }
-}
-
-
-newTVarzh_fast
-{
-  W_ tv;
-  W_ new_value;
-
-  /* Args: R1 = initialisation value */
-
-  MAYBE_GC (R1_PTR, newTVarzh_fast); 
-  new_value = R1;
-  "ptr" tv = foreign "C" stmNewTVar(MyCapability() "ptr", new_value "ptr") [];
-  RET_P(tv);
-}
-
-
-readTVarzh_fast
-{
-  W_ trec;
-  W_ tvar;
-  W_ result;
-
-  /* Args: R1 = TVar closure */
-
-  MAYBE_GC (R1_PTR, readTVarzh_fast); // Call to stmReadTVar may allocate
-  trec = StgTSO_trec(CurrentTSO);
-  tvar = R1;
-  "ptr" result = foreign "C" stmReadTVar(MyCapability() "ptr", trec "ptr", tvar "ptr") [];
-
-  RET_P(result);
-}
-
-
-writeTVarzh_fast
-{
-  W_ trec;
-  W_ tvar;
-  W_ new_value;
-  
-  /* Args: R1 = TVar closure */
-  /*       R2 = New value    */
-
-  MAYBE_GC (R1_PTR & R2_PTR, writeTVarzh_fast); // Call to stmWriteTVar may allocate
-  trec = StgTSO_trec(CurrentTSO);
-  tvar = R1;
-  new_value = R2;
-  foreign "C" stmWriteTVar(MyCapability() "ptr", trec "ptr", tvar "ptr", new_value "ptr") [];
-
-  jump %ENTRY_CODE(Sp(0));
-}
-
-
-/* -----------------------------------------------------------------------------
- * MVar primitives
- *
- * take & putMVar work as follows.  Firstly, an important invariant:
- *
- *    If the MVar is full, then the blocking queue contains only
- *    threads blocked on putMVar, and if the MVar is empty then the
- *    blocking queue contains only threads blocked on takeMVar.
- *
- * takeMvar:
- *    MVar empty : then add ourselves to the blocking queue
- *    MVar full  : remove the value from the MVar, and
- *                 blocking queue empty     : return
- *                 blocking queue non-empty : perform the first blocked putMVar
- *                                            from the queue, and wake up the
- *                                            thread (MVar is now full again)
- *
- * putMVar is just the dual of the above algorithm.
- *
- * How do we "perform a putMVar"?  Well, we have to fiddle around with
- * the stack of the thread waiting to do the putMVar.  See
- * stg_block_putmvar and stg_block_takemvar in HeapStackCheck.c for
- * the stack layout, and the PerformPut and PerformTake macros below.
- *
- * It is important that a blocked take or put is woken up with the
- * take/put already performed, because otherwise there would be a
- * small window of vulnerability where the thread could receive an
- * exception and never perform its take or put, and we'd end up with a
- * deadlock.
- *
- * -------------------------------------------------------------------------- */
-
-isEmptyMVarzh_fast
-{
-    /* args: R1 = MVar closure */
-
-    if (GET_INFO(R1) == stg_EMPTY_MVAR_info) {
-	RET_N(1);
-    } else {
-	RET_N(0);
-    }
-}
-
-newMVarzh_fast
-{
-    /* args: none */
-    W_ mvar;
-
-    ALLOC_PRIM ( SIZEOF_StgMVar, NO_PTRS, newMVarzh_fast );
-  
-    mvar = Hp - SIZEOF_StgMVar + WDS(1);
-    SET_HDR(mvar,stg_EMPTY_MVAR_info,W_[CCCS]);
-    StgMVar_head(mvar)  = stg_END_TSO_QUEUE_closure;
-    StgMVar_tail(mvar)  = stg_END_TSO_QUEUE_closure;
-    StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
-    RET_P(mvar);
-}
-
-
-/* If R1 isn't available, pass it on the stack */
-#ifdef REG_R1
-#define PerformTake(tso, value)				\
-    W_[StgTSO_sp(tso) + WDS(1)] = value;		\
-    W_[StgTSO_sp(tso) + WDS(0)] = stg_gc_unpt_r1_info;
-#else
-#define PerformTake(tso, value)					\
-    W_[StgTSO_sp(tso) + WDS(1)] = value;			\
-    W_[StgTSO_sp(tso) + WDS(0)] = stg_ut_1_0_unreg_info;
-#endif
-
-#define PerformPut(tso,lval)			\
-    StgTSO_sp(tso) = StgTSO_sp(tso) + WDS(3);	\
-    lval = W_[StgTSO_sp(tso) - WDS(1)];
-
-takeMVarzh_fast
-{
-    W_ mvar, val, info, tso;
-
-    /* args: R1 = MVar closure */
-    mvar = R1;
-
-#if defined(THREADED_RTS)
-    "ptr" info = foreign "C" lockClosure(mvar "ptr") [];
-#else
-    info = GET_INFO(mvar);
-#endif
-
-    /* If the MVar is empty, put ourselves on its blocking queue,
-     * and wait until we're woken up.
-     */
-    if (info == stg_EMPTY_MVAR_info) {
-	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	    StgMVar_head(mvar) = CurrentTSO;
-	} else {
-	    StgTSO_link(StgMVar_tail(mvar)) = CurrentTSO;
-	}
-	StgTSO_link(CurrentTSO)        = stg_END_TSO_QUEUE_closure;
-	StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
-	StgTSO_block_info(CurrentTSO)  = mvar;
-	StgMVar_tail(mvar) = CurrentTSO;
-	
-	jump stg_block_takemvar;
-  }
-
-  /* we got the value... */
-  val = StgMVar_value(mvar);
-
-  if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure)
-  {
-      /* There are putMVar(s) waiting... 
-       * wake up the first thread on the queue
-       */
-      ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
-
-      /* actually perform the putMVar for the thread that we just woke up */
-      tso = StgMVar_head(mvar);
-      PerformPut(tso,StgMVar_value(mvar));
-      foreign "C" dirtyTSO(tso "ptr") [];
-
-#if defined(GRAN) || defined(PAR)
-      /* ToDo: check 2nd arg (mvar) is right */
-      "ptr" tso = foreign "C" unblockOne(StgMVar_head(mvar),mvar) [];
-      StgMVar_head(mvar) = tso;
-#else
-      "ptr" tso = foreign "C" unblockOne(MyCapability() "ptr", 
-				         StgMVar_head(mvar) "ptr") [];
-      StgMVar_head(mvar) = tso;
-#endif
-
-      if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	  StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
-      }
-
-#if defined(THREADED_RTS)
-      foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info) [];
-#endif
-      RET_P(val);
-  } 
-  else
-  {
-      /* No further putMVars, MVar is now empty */
-      StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
- 
-#if defined(THREADED_RTS)
-      foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info) [];
-#else
-      SET_INFO(mvar,stg_EMPTY_MVAR_info);
-#endif
-
-      RET_P(val);
-  }
-}
-
-
-tryTakeMVarzh_fast
-{
-    W_ mvar, val, info, tso;
-
-    /* args: R1 = MVar closure */
-
-    mvar = R1;
-
-#if defined(THREADED_RTS)
-    "ptr" info = foreign "C" lockClosure(mvar "ptr") [];
-#else
-    info = GET_INFO(mvar);
-#endif
-
-    if (info == stg_EMPTY_MVAR_info) {
-#if defined(THREADED_RTS)
-        foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info) [];
-#endif
-	/* HACK: we need a pointer to pass back, 
-	 * so we abuse NO_FINALIZER_closure
-	 */
-	RET_NP(0, stg_NO_FINALIZER_closure);
-    }
-
-    /* we got the value... */
-    val = StgMVar_value(mvar);
-
-    if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
-
-	/* There are putMVar(s) waiting... 
-	 * wake up the first thread on the queue
-	 */
-	ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
-
-	/* actually perform the putMVar for the thread that we just woke up */
-	tso = StgMVar_head(mvar);
-	PerformPut(tso,StgMVar_value(mvar));
-        foreign "C" dirtyTSO(tso "ptr") [];
-
-#if defined(GRAN) || defined(PAR)
-	/* ToDo: check 2nd arg (mvar) is right */
-	"ptr" tso = foreign "C" unblockOne(StgMVar_head(mvar) "ptr", mvar "ptr") [];
-	StgMVar_head(mvar) = tso;
-#else
-	"ptr" tso = foreign "C" unblockOne(MyCapability() "ptr",
-					   StgMVar_head(mvar) "ptr") [];
-	StgMVar_head(mvar) = tso;
-#endif
-
-	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	    StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
-	}
-#if defined(THREADED_RTS)
-        foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info) [];
-#endif
-    }
-    else 
-    {
-	/* No further putMVars, MVar is now empty */
-	StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
-#if defined(THREADED_RTS)
-    	foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info) [];
-#else
-	SET_INFO(mvar,stg_EMPTY_MVAR_info);
-#endif
-    }
-    
-    RET_NP(1, val);
-}
-
-
-putMVarzh_fast
-{
-    W_ mvar, info, tso;
-
-    /* args: R1 = MVar, R2 = value */
-    mvar = R1;
-
-#if defined(THREADED_RTS)
-    "ptr" info = foreign "C" lockClosure(mvar "ptr") [R2];
-#else
-    info = GET_INFO(mvar);
-#endif
-
-    if (info == stg_FULL_MVAR_info) {
-	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	    StgMVar_head(mvar) = CurrentTSO;
-	} else {
-	    StgTSO_link(StgMVar_tail(mvar)) = CurrentTSO;
-	}
-	StgTSO_link(CurrentTSO)        = stg_END_TSO_QUEUE_closure;
-	StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
-	StgTSO_block_info(CurrentTSO)  = mvar;
-	StgMVar_tail(mvar) = CurrentTSO;
-	
-	jump stg_block_putmvar;
-    }
-  
-    if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
-
-	/* There are takeMVar(s) waiting: wake up the first one
-	 */
-	ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
-
-	/* actually perform the takeMVar */
-	tso = StgMVar_head(mvar);
-	PerformTake(tso, R2);
-        foreign "C" dirtyTSO(tso "ptr") [];
-      
-#if defined(GRAN) || defined(PAR)
-	/* ToDo: check 2nd arg (mvar) is right */
-	"ptr" tso = foreign "C" unblockOne(MyCapability() "ptr", StgMVar_head(mvar) "ptr",mvar "ptr") [];
-	StgMVar_head(mvar) = tso;
-#else
-	"ptr" tso = foreign "C" unblockOne(MyCapability() "ptr", StgMVar_head(mvar) "ptr") [];
-	StgMVar_head(mvar) = tso;
-#endif
-
-	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	    StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
-	}
-
-#if defined(THREADED_RTS)
-    	foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info) [];
-#endif
-	jump %ENTRY_CODE(Sp(0));
-    }
-    else
-    {
-	/* No further takes, the MVar is now full. */
-	StgMVar_value(mvar) = R2;
-
-#if defined(THREADED_RTS)
-    	foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info) [];
-#else
-	SET_INFO(mvar,stg_FULL_MVAR_info);
-#endif
-	jump %ENTRY_CODE(Sp(0));
-    }
-    
-    /* ToDo: yield afterward for better communication performance? */
-}
-
-
-tryPutMVarzh_fast
-{
-    W_ mvar, info, tso;
-
-    /* args: R1 = MVar, R2 = value */
-    mvar = R1;
-
-#if defined(THREADED_RTS)
-    "ptr" info = foreign "C" lockClosure(mvar "ptr") [R2];
-#else
-    info = GET_INFO(mvar);
-#endif
-
-    if (info == stg_FULL_MVAR_info) {
-#if defined(THREADED_RTS)
-    	foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info) [];
-#endif
-	RET_N(0);
-    }
-  
-    if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
-
-	/* There are takeMVar(s) waiting: wake up the first one
-	 */
-	ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
-	
-	/* actually perform the takeMVar */
-	tso = StgMVar_head(mvar);
-	PerformTake(tso, R2);
-        foreign "C" dirtyTSO(tso "ptr") [];
-      
-#if defined(GRAN) || defined(PAR)
-	/* ToDo: check 2nd arg (mvar) is right */
-	"ptr" tso = foreign "C" unblockOne(MyCapability() "ptr", StgMVar_head(mvar) "ptr",mvar "ptr") [];
-	StgMVar_head(mvar) = tso;
-#else
-	"ptr" tso = foreign "C" unblockOne(MyCapability() "ptr", StgMVar_head(mvar) "ptr") [];
-	StgMVar_head(mvar) = tso;
-#endif
-
-	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	    StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
-	}
-
-#if defined(THREADED_RTS)
-    	foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info) [];
-#endif
-    }
-    else
-    {
-	/* No further takes, the MVar is now full. */
-	StgMVar_value(mvar) = R2;
-
-#if defined(THREADED_RTS)
-    	foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info) [];
-#else
-	SET_INFO(mvar,stg_FULL_MVAR_info);
-#endif
-    }
-    
-    RET_N(1);
-    /* ToDo: yield afterward for better communication performance? */
-}
-
-
-/* -----------------------------------------------------------------------------
-   Stable pointer primitives
-   -------------------------------------------------------------------------  */
-
-makeStableNamezh_fast
-{
-    W_ index, sn_obj;
-
-    ALLOC_PRIM( SIZEOF_StgStableName, R1_PTR, makeStableNamezh_fast );
-  
-    index = foreign "C" lookupStableName(R1 "ptr") [];
-
-    /* Is there already a StableName for this heap object?
-     *  stable_ptr_table is a pointer to an array of snEntry structs.
-     */
-    if ( snEntry_sn_obj(W_[stable_ptr_table] + index*SIZEOF_snEntry) == NULL ) {
-	sn_obj = Hp - SIZEOF_StgStableName + WDS(1);
-	SET_HDR(sn_obj, stg_STABLE_NAME_info, W_[CCCS]);
-	StgStableName_sn(sn_obj) = index;
-	snEntry_sn_obj(W_[stable_ptr_table] + index*SIZEOF_snEntry) = sn_obj;
-    } else {
-	sn_obj = snEntry_sn_obj(W_[stable_ptr_table] + index*SIZEOF_snEntry);
-    }
-    
-    RET_P(sn_obj);
-}
-
-
-makeStablePtrzh_fast
-{
-    /* Args: R1 = a */
-    W_ sp;
-    MAYBE_GC(R1_PTR, makeStablePtrzh_fast);
-    "ptr" sp = foreign "C" getStablePtr(R1 "ptr") [];
-    RET_N(sp);
-}
-
-deRefStablePtrzh_fast
-{
-    /* Args: R1 = the stable ptr */
-    W_ r, sp;
-    sp = R1;
-    r = snEntry_addr(W_[stable_ptr_table] + sp*SIZEOF_snEntry);
-    RET_P(r);
-}
-
-/* -----------------------------------------------------------------------------
-   Bytecode object primitives
-   -------------------------------------------------------------------------  */
-
-newBCOzh_fast
-{
-    /* R1 = instrs
-       R2 = literals
-       R3 = ptrs
-       R4 = itbls
-       R5 = arity
-       R6 = bitmap array
-    */
-    W_ bco, bitmap_arr, bytes, words;
-    
-    bitmap_arr = R6;
-    words = BYTES_TO_WDS(SIZEOF_StgBCO) + StgArrWords_words(bitmap_arr);
-    bytes = WDS(words);
-
-    ALLOC_PRIM( bytes, R1_PTR&R2_PTR&R3_PTR&R4_PTR&R6_PTR, newBCOzh_fast );
-
-    bco = Hp - bytes + WDS(1);
-    SET_HDR(bco, stg_BCO_info, W_[CCCS]);
-    
-    StgBCO_instrs(bco)     = R1;
-    StgBCO_literals(bco)   = R2;
-    StgBCO_ptrs(bco)       = R3;
-    StgBCO_itbls(bco)      = R4;
-    StgBCO_arity(bco)      = HALF_W_(R5);
-    StgBCO_size(bco)       = HALF_W_(words);
-    
-    // Copy the arity/bitmap info into the BCO
-    W_ i;
-    i = 0;
-for:
-    if (i < StgArrWords_words(bitmap_arr)) {
-	StgBCO_bitmap(bco,i) = StgArrWords_payload(bitmap_arr,i);
-	i = i + 1;
-	goto for;
-    }
-    
-    RET_P(bco);
-}
-
-
-mkApUpd0zh_fast
-{
-    // R1 = the BCO# for the AP
-    //	
-    W_ ap;
-
-    // This function is *only* used to wrap zero-arity BCOs in an
-    // updatable wrapper (see ByteCodeLink.lhs).  An AP thunk is always
-    // saturated and always points directly to a FUN or BCO.
-    ASSERT(%INFO_TYPE(%GET_STD_INFO(R1)) == HALF_W_(BCO) &&
-	   StgBCO_arity(R1) == HALF_W_(0));
-
-    HP_CHK_GEN_TICKY(SIZEOF_StgAP, R1_PTR, mkApUpd0zh_fast);
-    TICK_ALLOC_UP_THK(0, 0);
-    CCCS_ALLOC(SIZEOF_StgAP);
-
-    ap = Hp - SIZEOF_StgAP + WDS(1);
-    SET_HDR(ap, stg_AP_info, W_[CCCS]);
-    
-    StgAP_n_args(ap) = HALF_W_(0);
-    StgAP_fun(ap) = R1;
-    
-    RET_P(ap);
-}
-
-/* -----------------------------------------------------------------------------
-   Thread I/O blocking primitives
-   -------------------------------------------------------------------------- */
-
-/* Add a thread to the end of the blocked queue. (C-- version of the C
- * macro in Schedule.h).
- */
-#define APPEND_TO_BLOCKED_QUEUE(tso)			\
-    ASSERT(StgTSO_link(tso) == END_TSO_QUEUE);		\
-    if (W_[blocked_queue_hd] == END_TSO_QUEUE) {	\
-      W_[blocked_queue_hd] = tso;			\
-    } else {						\
-      StgTSO_link(W_[blocked_queue_tl]) = tso;		\
-    }							\
-    W_[blocked_queue_tl] = tso;
-
-waitReadzh_fast
-{
-    /* args: R1 */
-#ifdef THREADED_RTS
-    foreign "C" barf("waitRead# on threaded RTS");
-#else
-
-    ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
-    StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I16;
-    StgTSO_block_info(CurrentTSO) = R1;
-    // No locking - we're not going to use this interface in the
-    // threaded RTS anyway.
-    APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
-    jump stg_block_noregs;
-#endif
-}
-
-waitWritezh_fast
-{
-    /* args: R1 */
-#ifdef THREADED_RTS
-    foreign "C" barf("waitWrite# on threaded RTS");
-#else
-
-    ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
-    StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I16;
-    StgTSO_block_info(CurrentTSO) = R1;
-    // No locking - we're not going to use this interface in the
-    // threaded RTS anyway.
-    APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
-    jump stg_block_noregs;
-#endif
-}
-
-
-STRING(stg_delayzh_malloc_str, "delayzh_fast")
-delayzh_fast
-{
-#ifdef mingw32_HOST_OS
-    W_ ares;
-    CInt reqID;
-#else
-    W_ t, prev, target;
-#endif
-
-#ifdef THREADED_RTS
-    foreign "C" barf("delay# on threaded RTS");
-#else
-
-    /* args: R1 (microsecond delay amount) */
-    ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
-    StgTSO_why_blocked(CurrentTSO) = BlockedOnDelay::I16;
-
-#ifdef mingw32_HOST_OS
-
-    /* could probably allocate this on the heap instead */
-    "ptr" ares = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
-					    stg_delayzh_malloc_str);
-    reqID = foreign "C" addDelayRequest(R1);
-    StgAsyncIOResult_reqID(ares)   = reqID;
-    StgAsyncIOResult_len(ares)     = 0;
-    StgAsyncIOResult_errCode(ares) = 0;
-    StgTSO_block_info(CurrentTSO)  = ares;
-
-    /* Having all async-blocked threads reside on the blocked_queue
-     * simplifies matters, so change the status to OnDoProc put the
-     * delayed thread on the blocked_queue.
-     */
-    StgTSO_why_blocked(CurrentTSO) = BlockedOnDoProc::I16;
-    APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
-    jump stg_block_async_void;
-
-#else
-
-    W_ time;
-    time = foreign "C" getourtimeofday();
-    target = (R1 / (TICK_MILLISECS*1000)) + time;
-    StgTSO_block_info(CurrentTSO) = target;
-
-    /* Insert the new thread in the sleeping queue. */
-    prev = NULL;
-    t = W_[sleeping_queue];
-while:
-    if (t != END_TSO_QUEUE && StgTSO_block_info(t) < target) {
-	prev = t;
-	t = StgTSO_link(t);
-	goto while;
-    }
-
-    StgTSO_link(CurrentTSO) = t;
-    if (prev == NULL) {
-	W_[sleeping_queue] = CurrentTSO;
-    } else {
-	StgTSO_link(prev) = CurrentTSO;
-    }
-    jump stg_block_noregs;
-#endif
-#endif /* !THREADED_RTS */
-}
-
-
-#ifdef mingw32_HOST_OS
-STRING(stg_asyncReadzh_malloc_str, "asyncReadzh_fast")
-asyncReadzh_fast
-{
-    W_ ares;
-    CInt reqID;
-
-#ifdef THREADED_RTS
-    foreign "C" barf("asyncRead# on threaded RTS");
-#else
-
-    /* args: R1 = fd, R2 = isSock, R3 = len, R4 = buf */
-    ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
-    StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I16;
-
-    /* could probably allocate this on the heap instead */
-    "ptr" ares = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
-					    stg_asyncReadzh_malloc_str)
-			[R1,R2,R3,R4];
-    reqID = foreign "C" addIORequest(R1, 0/*FALSE*/,R2,R3,R4 "ptr") [];
-    StgAsyncIOResult_reqID(ares)   = reqID;
-    StgAsyncIOResult_len(ares)     = 0;
-    StgAsyncIOResult_errCode(ares) = 0;
-    StgTSO_block_info(CurrentTSO)  = ares;
-    APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
-    jump stg_block_async;
-#endif
-}
-
-STRING(stg_asyncWritezh_malloc_str, "asyncWritezh_fast")
-asyncWritezh_fast
-{
-    W_ ares;
-    CInt reqID;
-
-#ifdef THREADED_RTS
-    foreign "C" barf("asyncWrite# on threaded RTS");
-#else
-
-    /* args: R1 = fd, R2 = isSock, R3 = len, R4 = buf */
-    ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
-    StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I16;
-
-    "ptr" ares = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
-					    stg_asyncWritezh_malloc_str)
-			[R1,R2,R3,R4];
-    reqID = foreign "C" addIORequest(R1, 1/*TRUE*/,R2,R3,R4 "ptr") [];
-
-    StgAsyncIOResult_reqID(ares)   = reqID;
-    StgAsyncIOResult_len(ares)     = 0;
-    StgAsyncIOResult_errCode(ares) = 0;
-    StgTSO_block_info(CurrentTSO)  = ares;
-    APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
-    jump stg_block_async;
-#endif
-}
-
-STRING(stg_asyncDoProczh_malloc_str, "asyncDoProczh_fast")
-asyncDoProczh_fast
-{
-    W_ ares;
-    CInt reqID;
-
-#ifdef THREADED_RTS
-    foreign "C" barf("asyncDoProc# on threaded RTS");
-#else
-
-    /* args: R1 = proc, R2 = param */
-    ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
-    StgTSO_why_blocked(CurrentTSO) = BlockedOnDoProc::I16;
-
-    /* could probably allocate this on the heap instead */
-    "ptr" ares = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
-					    stg_asyncDoProczh_malloc_str) 
-				[R1,R2];
-    reqID = foreign "C" addDoProcRequest(R1 "ptr",R2 "ptr") [];
-    StgAsyncIOResult_reqID(ares)   = reqID;
-    StgAsyncIOResult_len(ares)     = 0;
-    StgAsyncIOResult_errCode(ares) = 0;
-    StgTSO_block_info(CurrentTSO) = ares;
-    APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
-    jump stg_block_async;
-#endif
-}
-#endif
-
-/* -----------------------------------------------------------------------------
-  ** temporary **
-
-   classes CCallable and CReturnable don't really exist, but the
-   compiler insists on generating dictionaries containing references
-   to GHC_ZcCCallable_static_info etc., so we provide dummy symbols
-   for these.  Some C compilers can't cope with zero-length static arrays,
-   so we have to make these one element long.
-  --------------------------------------------------------------------------- */
-
-section "rodata" {
-  GHC_ZCCCallable_static_info:   W_ 0;
-}
-
-section "rodata" {
-  GHC_ZCCReturnable_static_info: W_ 0;
-}
diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c
deleted file mode 100644
index 8290d220a0..0000000000
--- a/ghc/rts/Printer.c
+++ /dev/null
@@ -1,1127 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1994-2000.
- *
- * Heap printer
- * 
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "Printer.h"
-#include "RtsUtils.h"
-
-#ifdef DEBUG
-
-#include "RtsFlags.h"
-#include "MBlock.h"
-#include "Storage.h"
-#include "Bytecodes.h"  /* for InstrPtr */
-#include "Disassembler.h"
-#include "Apply.h"
-
-#include <stdlib.h>
-#include <string.h>
-
-#if defined(GRAN) || defined(PAR)
-// HWL: explicit fixed header size to make debugging easier
-int fixed_hs = sizeof(StgHeader), itbl_sz = sizeofW(StgInfoTable), 
-    uf_sz=sizeofW(StgUpdateFrame); 
-#endif
-
-/* --------------------------------------------------------------------------
- * local function decls
- * ------------------------------------------------------------------------*/
-
-static void    printStdObjPayload( StgClosure *obj );
-#ifdef USING_LIBBFD
-static void    reset_table   ( int size );
-static void    prepare_table ( void );
-static void    insert        ( unsigned value, const char *name );
-#endif
-#if 0 /* unused but might be useful sometime */
-static rtsBool lookup_name   ( char *name, unsigned *result );
-static void    enZcode       ( char *in, char *out );
-#endif
-static char    unZcode       ( char ch );
-const char *   lookupGHCName ( void *addr );
-static void    printZcoded   ( const char *raw );
-
-/* --------------------------------------------------------------------------
- * Printer
- * ------------------------------------------------------------------------*/
-
-void printPtr( StgPtr p )
-{
-    const char *raw;
-    raw = lookupGHCName(p);
-    if (raw != NULL) {
-        printZcoded(raw);
-    } else {
-        debugBelch("%p", p);
-    }
-}
-  
-void printObj( StgClosure *obj )
-{
-    debugBelch("Object "); printPtr((StgPtr)obj); debugBelch(" = ");
-    printClosure(obj);
-}
-
-STATIC_INLINE void
-printStdObjHdr( StgClosure *obj, char* tag )
-{
-    debugBelch("%s(",tag);
-    printPtr((StgPtr)obj->header.info);
-#ifdef PROFILING
-    debugBelch(", %s", obj->header.prof.ccs->cc->label);
-#endif
-}
-
-static void
-printStdObjPayload( StgClosure *obj )
-{
-    StgWord i, j;
-    const StgInfoTable* info;
-
-    info = get_itbl(obj);
-    for (i = 0; i < info->layout.payload.ptrs; ++i) {
-        debugBelch(", ");
-        printPtr((StgPtr)obj->payload[i]);
-    }
-    for (j = 0; j < info->layout.payload.nptrs; ++j) {
-        debugBelch(", %pd#",obj->payload[i+j]);
-    }
-    debugBelch(")\n");
-}
-
-static void
-printThunkPayload( StgThunk *obj )
-{
-    StgWord i, j;
-    const StgInfoTable* info;
-
-    info = get_itbl(obj);
-    for (i = 0; i < info->layout.payload.ptrs; ++i) {
-        debugBelch(", ");
-        printPtr((StgPtr)obj->payload[i]);
-    }
-    for (j = 0; j < info->layout.payload.nptrs; ++j) {
-        debugBelch(", %pd#",obj->payload[i+j]);
-    }
-    debugBelch(")\n");
-}
-
-static void
-printThunkObject( StgThunk *obj, char* tag )
-{
-    printStdObjHdr( (StgClosure *)obj, tag );
-    printThunkPayload( obj );
-}
-
-void
-printClosure( StgClosure *obj )
-{
-    StgInfoTable *info;
-    
-    info = get_itbl(obj);
-
-    switch ( info->type ) {
-    case INVALID_OBJECT:
-            barf("Invalid object");
-
-    case CONSTR:
-    case CONSTR_1_0: case CONSTR_0_1:
-    case CONSTR_1_1: case CONSTR_0_2: case CONSTR_2_0:
-    case CONSTR_INTLIKE:
-    case CONSTR_CHARLIKE:
-    case CONSTR_STATIC:
-    case CONSTR_NOCAF_STATIC:
-        {
-            StgWord i, j;
-#ifdef PROFILING
-	    debugBelch("%s(", info->prof.closure_desc);
-	    debugBelch("%s", obj->header.prof.ccs->cc->label);
-#else
-            debugBelch("CONSTR(");
-            printPtr((StgPtr)obj->header.info);
-            debugBelch("(tag=%d)",info->srt_bitmap);
-#endif
-            for (i = 0; i < info->layout.payload.ptrs; ++i) {
-		debugBelch(", ");
-                printPtr((StgPtr)obj->payload[i]);
-            }
-            for (j = 0; j < info->layout.payload.nptrs; ++j) {
-                debugBelch(", %p#", obj->payload[i+j]);
-            }
-            debugBelch(")\n");
-            break;
-        }
-
-    case FUN:
-    case FUN_1_0: case FUN_0_1: 
-    case FUN_1_1: case FUN_0_2: case FUN_2_0:
-    case FUN_STATIC:
-	debugBelch("FUN/%d(",itbl_to_fun_itbl(info)->f.arity);
-	printPtr((StgPtr)obj->header.info);
-#ifdef PROFILING
-	debugBelch(", %s", obj->header.prof.ccs->cc->label);
-#endif
-	printStdObjPayload(obj);
-	break;
-
-    case THUNK:
-    case THUNK_1_0: case THUNK_0_1:
-    case THUNK_1_1: case THUNK_0_2: case THUNK_2_0:
-    case THUNK_STATIC:
-            /* ToDo: will this work for THUNK_STATIC too? */
-#ifdef PROFILING
-	    printThunkObject((StgThunk *)obj,info->prof.closure_desc);
-#else
-            printThunkObject((StgThunk *)obj,"THUNK");
-#endif
-            break;
-
-    case THUNK_SELECTOR:
-	printStdObjHdr(obj, "THUNK_SELECTOR");
-	debugBelch(", %p)\n", ((StgSelector *)obj)->selectee);
-	break;
-
-    case BCO:
-            disassemble( (StgBCO*)obj );
-            break;
-
-    case AP:
-        {
-	    StgAP* ap = stgCast(StgAP*,obj);
-            StgWord i;
-            debugBelch("AP("); printPtr((StgPtr)ap->fun);
-            for (i = 0; i < ap->n_args; ++i) {
-                debugBelch(", ");
-                printPtr((P_)ap->payload[i]);
-            }
-            debugBelch(")\n");
-            break;
-        }
-
-    case PAP:
-        {
-	    StgPAP* pap = stgCast(StgPAP*,obj);
-            StgWord i;
-            debugBelch("PAP/%d(",pap->arity); 
-	    printPtr((StgPtr)pap->fun);
-            for (i = 0; i < pap->n_args; ++i) {
-                debugBelch(", ");
-                printPtr((StgPtr)pap->payload[i]);
-            }
-            debugBelch(")\n");
-            break;
-        }
-
-    case AP_STACK:
-        {
-	    StgAP_STACK* ap = stgCast(StgAP_STACK*,obj);
-            StgWord i;
-            debugBelch("AP_STACK("); printPtr((StgPtr)ap->fun);
-            for (i = 0; i < ap->size; ++i) {
-                debugBelch(", ");
-                printPtr((P_)ap->payload[i]);
-            }
-            debugBelch(")\n");
-            break;
-        }
-
-    case IND:
-            debugBelch("IND("); 
-            printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
-            debugBelch(")\n"); 
-            break;
-
-    case IND_OLDGEN:
-            debugBelch("IND_OLDGEN("); 
-            printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
-            debugBelch(")\n"); 
-            break;
-
-    case IND_PERM:
-            debugBelch("IND("); 
-            printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
-            debugBelch(")\n"); 
-            break;
-
-    case IND_OLDGEN_PERM:
-            debugBelch("IND_OLDGEN_PERM("); 
-            printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
-            debugBelch(")\n"); 
-            break;
-
-    case IND_STATIC:
-            debugBelch("IND_STATIC("); 
-            printPtr((StgPtr)stgCast(StgInd*,obj)->indirectee);
-            debugBelch(")\n"); 
-            break;
-
-    /* Cannot happen -- use default case.
-    case RET_BCO:
-    case RET_SMALL:
-    case RET_VEC_SMALL:
-    case RET_BIG:
-    case RET_VEC_BIG:
-    case RET_DYN:
-    case RET_FUN:
-    */
-
-    case UPDATE_FRAME:
-        {
-            StgUpdateFrame* u = stgCast(StgUpdateFrame*,obj);
-            debugBelch("UPDATE_FRAME(");
-            printPtr((StgPtr)GET_INFO(u));
-            debugBelch(",");
-            printPtr((StgPtr)u->updatee);
-            debugBelch(")\n"); 
-            break;
-        }
-
-    case CATCH_FRAME:
-        {
-            StgCatchFrame* u = stgCast(StgCatchFrame*,obj);
-            debugBelch("CATCH_FRAME(");
-            printPtr((StgPtr)GET_INFO(u));
-            debugBelch(",");
-            printPtr((StgPtr)u->handler);
-            debugBelch(")\n"); 
-            break;
-        }
-
-    case STOP_FRAME:
-        {
-            StgStopFrame* u = stgCast(StgStopFrame*,obj);
-            debugBelch("STOP_FRAME(");
-            printPtr((StgPtr)GET_INFO(u));
-            debugBelch(")\n"); 
-            break;
-        }
-
-    case CAF_BLACKHOLE:
-            debugBelch("CAF_BH"); 
-            break;
-
-    case BLACKHOLE:
-            debugBelch("BH\n"); 
-            break;
-
-    case SE_BLACKHOLE:
-            debugBelch("SE_BH\n"); 
-            break;
-
-    case SE_CAF_BLACKHOLE:
-            debugBelch("SE_CAF_BH\n"); 
-            break;
-
-    case ARR_WORDS:
-        {
-            StgWord i;
-            debugBelch("ARR_WORDS(\"");
-            /* ToDo: we can't safely assume that this is a string! 
-            for (i = 0; arrWordsGetChar(obj,i); ++i) {
-                putchar(arrWordsGetChar(obj,i));
-		} */
-	    for (i=0; i<((StgArrWords *)obj)->words; i++)
-	      debugBelch("%lu", (lnat)((StgArrWords *)obj)->payload[i]);
-            debugBelch("\")\n");
-            break;
-        }
-
-    case MUT_ARR_PTRS_CLEAN:
-	debugBelch("MUT_ARR_PTRS_CLEAN(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
-	break;
-
-    case MUT_ARR_PTRS_DIRTY:
-	debugBelch("MUT_ARR_PTRS_DIRTY(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
-	break;
-
-    case MUT_ARR_PTRS_FROZEN:
-	debugBelch("MUT_ARR_PTRS_FROZEN(size=%lu)\n", (lnat)((StgMutArrPtrs *)obj)->ptrs);
-	break;
-
-    case MVAR:
-        {
-	  StgMVar* mv = (StgMVar*)obj;
-	  debugBelch("MVAR(head=%p, tail=%p, value=%p)\n", mv->head, mv->tail, mv->value);
-          break;
-        }
-
-    case MUT_VAR_CLEAN:
-        {
-	  StgMutVar* mv = (StgMutVar*)obj;
-	  debugBelch("MUT_VAR_CLEAN(var=%p)\n", mv->var);
-          break;
-        }
-
-    case MUT_VAR_DIRTY:
-        {
-	  StgMutVar* mv = (StgMutVar*)obj;
-	  debugBelch("MUT_VAR_DIRTY(var=%p)\n", mv->var);
-          break;
-        }
-
-    case WEAK:
-            debugBelch("WEAK("); 
-	    debugBelch(" key=%p value=%p finalizer=%p", 
-		    (StgPtr)(((StgWeak*)obj)->key),
-		    (StgPtr)(((StgWeak*)obj)->value),
-		    (StgPtr)(((StgWeak*)obj)->finalizer));
-            debugBelch(")\n"); 
-	    /* ToDo: chase 'link' ? */
-            break;
-
-    case STABLE_NAME:
-            debugBelch("STABLE_NAME(%lu)\n", (lnat)((StgStableName*)obj)->sn); 
-            break;
-
-    case TSO:
-      debugBelch("TSO("); 
-      debugBelch("%d (%p)",((StgTSO*)obj)->id, (StgTSO*)obj);
-      debugBelch(")\n"); 
-      break;
-
-#if defined(PAR)
-    case BLOCKED_FETCH:
-      debugBelch("BLOCKED_FETCH("); 
-      printGA(&(stgCast(StgBlockedFetch*,obj)->ga));
-      printPtr((StgPtr)(stgCast(StgBlockedFetch*,obj)->node));
-      debugBelch(")\n"); 
-      break;
-
-    case FETCH_ME:
-      debugBelch("FETCH_ME("); 
-      printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
-      debugBelch(")\n"); 
-      break;
-
-    case FETCH_ME_BQ:
-      debugBelch("FETCH_ME_BQ("); 
-      // printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
-      printPtr((StgPtr)stgCast(StgFetchMeBlockingQueue*,obj)->blocking_queue);
-      debugBelch(")\n"); 
-      break;
-#endif
-
-#if defined(GRAN) || defined(PAR)
-    case RBH:
-      debugBelch("RBH("); 
-      printPtr((StgPtr)stgCast(StgRBH*,obj)->blocking_queue);
-      debugBelch(")\n"); 
-      break;
-
-#endif
-
-#if 0
-      /* Symptomatic of a problem elsewhere, have it fall-through & fail */
-    case EVACUATED:
-      debugBelch("EVACUATED("); 
-      printClosure((StgEvacuated*)obj->evacuee);
-      debugBelch(")\n"); 
-      break;
-#endif
-
-#if defined(PAR) && defined(DIST)
-    case REMOTE_REF:
-      debugBelch("REMOTE_REF("); 
-      printGA((globalAddr *)stgCast(StgFetchMe*,obj)->ga);
-      debugBelch(")\n"); 
-      break;
-#endif
-
-    default:
-            //barf("printClosure %d",get_itbl(obj)->type);
-            debugBelch("*** printClosure: unknown type %d ****\n",
-                    get_itbl(obj)->type );
-            barf("printClosure %d",get_itbl(obj)->type);
-            return;
-    }
-}
-
-/*
-void printGraph( StgClosure *obj )
-{
- printClosure(obj);
-}
-*/
-
-StgPtr
-printStackObj( StgPtr sp )
-{
-    /*debugBelch("Stack[%d] = ", &stgStack[STACK_SIZE] - sp); */
-
-        StgClosure* c = (StgClosure*)(*sp);
-        printPtr((StgPtr)*sp);
-        if (c == (StgClosure*)&stg_ctoi_R1p_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_R1p_info\n" );
-	} else
-        if (c == (StgClosure*)&stg_ctoi_R1n_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_R1n_info\n" );
-	} else
-        if (c == (StgClosure*)&stg_ctoi_F1_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_F1_info\n" );
-	} else
-        if (c == (StgClosure*)&stg_ctoi_D1_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_D1_info\n" );
-	} else
-        if (c == (StgClosure*)&stg_ctoi_V_info) {
-           debugBelch("\t\t\tstg_ctoi_ret_V_info\n" );
-	} else
-        if (get_itbl(c)->type == BCO) {
-           debugBelch("\t\t\t");
-           debugBelch("BCO(...)\n"); 
-        }
-        else {
-           debugBelch("\t\t\t");
-           printClosure ( (StgClosure*)(*sp));
-        }
-        sp += 1;
-
-    return sp;
-    
-}
-
-static void
-printSmallBitmap( StgPtr spBottom, StgPtr payload, StgWord bitmap, nat size )
-{
-    StgPtr p;
-    nat i;
-
-    p = payload;
-    for(i = 0; i < size; i++, bitmap >>= 1 ) {
-	debugBelch("   stk[%ld] (%p) = ", (long)(spBottom-(payload+i)), payload+i);
-	if ((bitmap & 1) == 0) {
-	    printPtr((P_)payload[i]);
-	    debugBelch("\n");
-	} else {
-	    debugBelch("Word# %lu\n", (lnat)payload[i]);
-	}
-    }
-}
-
-static void
-printLargeBitmap( StgPtr spBottom, StgPtr payload, StgLargeBitmap* large_bitmap, nat size )
-{
-    StgWord bmp;
-    nat i, j;
-
-    i = 0;
-    for (bmp=0; i < size; bmp++) {
-	StgWord bitmap = large_bitmap->bitmap[bmp];
-	j = 0;
-	for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
-	    debugBelch("   stk[%lu] (%p) = ", (lnat)(spBottom-(payload+i)), payload+i);
-	    if ((bitmap & 1) == 0) {
-		printPtr((P_)payload[i]);
-		debugBelch("\n");
-	    } else {
-		debugBelch("Word# %lu\n", (lnat)payload[i]);
-	    }
-	}
-    }
-}
-
-void
-printStackChunk( StgPtr sp, StgPtr spBottom )
-{
-    StgWord bitmap;
-    const StgInfoTable *info;
-
-    ASSERT(sp <= spBottom);
-    for (; sp < spBottom; sp += stack_frame_sizeW((StgClosure *)sp)) {
-
-	info = get_itbl((StgClosure *)sp);
-
-	switch (info->type) {
-	    
-	case UPDATE_FRAME:
-	case CATCH_FRAME:
-	    printObj((StgClosure*)sp);
-	    continue;
-
-	case STOP_FRAME:
-	    printObj((StgClosure*)sp);
-	    return;
-
-	case RET_DYN:
-	{ 
-	    StgRetDyn* r;
-	    StgPtr p;
-	    StgWord dyn;
-	    nat size;
-
-	    r = (StgRetDyn *)sp;
-	    dyn = r->liveness;
-	    debugBelch("RET_DYN (%p)\n", r);
-
-	    p = (P_)(r->payload);
-	    printSmallBitmap(spBottom, sp,
-			     RET_DYN_LIVENESS(r->liveness), 
-			     RET_DYN_BITMAP_SIZE);
-	    p += RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE;
-
-	    for (size = RET_DYN_NONPTRS(dyn); size > 0; size--) {
-		debugBelch("   stk[%ld] (%p) = ", (long)(spBottom-p), p);
-		debugBelch("Word# %ld\n", (long)*p);
-		p++;
-	    }
-	
-	    for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
-		debugBelch("   stk[%ld] (%p) = ", (long)(spBottom-p), p);
-		printPtr(p);
-		p++;
-	    }
-	    continue;
-	}
-
-	case RET_SMALL:
-	case RET_VEC_SMALL:
-	    debugBelch("RET_SMALL (%p)\n", info);
-	    bitmap = info->layout.bitmap;
-	    printSmallBitmap(spBottom, sp+1, 
-			     BITMAP_BITS(bitmap), BITMAP_SIZE(bitmap));
-	    continue;
-
-	case RET_BCO: {
-	    StgBCO *bco;
-	    
-	    bco = ((StgBCO *)sp[1]);
-
-	    debugBelch("RET_BCO (%p)\n", sp);
-	    printLargeBitmap(spBottom, sp+2,
-			     BCO_BITMAP(bco), BCO_BITMAP_SIZE(bco));
-	    continue;
-	}
-
-	case RET_BIG:
-	case RET_VEC_BIG:
-	    barf("todo");
-
-	case RET_FUN:
-	{
-	    StgFunInfoTable *fun_info;
-	    StgRetFun *ret_fun;
-	    nat size;
-
-	    ret_fun = (StgRetFun *)sp;
-	    fun_info = get_fun_itbl(ret_fun->fun);
-	    size = ret_fun->size;
-	    debugBelch("RET_FUN (%p) (type=%d)\n", ret_fun->fun, fun_info->f.fun_type);
-	    switch (fun_info->f.fun_type) {
-	    case ARG_GEN:
-		printSmallBitmap(spBottom, sp+2,
-				 BITMAP_BITS(fun_info->f.b.bitmap),
-				 BITMAP_SIZE(fun_info->f.b.bitmap));
-		break;
-	    case ARG_GEN_BIG:
-		printLargeBitmap(spBottom, sp+2,
-				 GET_FUN_LARGE_BITMAP(fun_info),
-				 GET_FUN_LARGE_BITMAP(fun_info)->size);
-		break;
-	    default:
-		printSmallBitmap(spBottom, sp+2,
-				 BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
-				 BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]));
-		break;
-	    }
-	    continue;
-	}
-	   
-	default:
-	    debugBelch("unknown object %d\n", info->type);
-	    barf("printStackChunk");
-	}
-    }
-}
-
-void printTSO( StgTSO *tso )
-{
-    printStackChunk( tso->sp, tso->stack+tso->stack_size);
-}
-
-/* -----------------------------------------------------------------------------
-   Closure types
-   
-   NOTE: must be kept in sync with the closure types in includes/ClosureTypes.h
-   -------------------------------------------------------------------------- */
-
-static char *closure_type_names[] = {
-    "INVALID_OBJECT",
-    "CONSTR",
-    "CONSTR_1",
-    "CONSTR_0",
-    "CONSTR_2",
-    "CONSTR_1",
-    "CONSTR_0",
-    "CONSTR_INTLIKE",
-    "CONSTR_CHARLIKE",
-    "CONSTR_STATIC",
-    "CONSTR_NOCAF_STATIC",
-    "FUN",
-    "FUN_1_0",
-    "FUN_0_1",
-    "FUN_2_0",
-    "FUN_1_1",
-    "FUN_0",
-    "FUN_STATIC",
-    "THUNK",
-    "THUNK_1_0",
-    "THUNK_0_1",
-    "THUNK_2_0",
-    "THUNK_1_1",
-    "THUNK_0",
-    "THUNK_STATIC",
-    "THUNK_SELECTOR",
-    "BCO",
-    "AP_UPD",
-    "PAP",
-    "AP_STACK",
-    "IND",
-    "IND_OLDGEN",
-    "IND_PERM",
-    "IND_OLDGEN_PERM",
-    "IND_STATIC",
-    "RET_BCO",
-    "RET_SMALL",
-    "RET_VEC_SMALL",
-    "RET_BIG",
-    "RET_VEC_BIG",
-    "RET_DYN",
-    "RET_FUN",
-    "UPDATE_FRAME",
-    "CATCH_FRAME",
-    "STOP_FRAME",
-    "CAF_BLACKHOLE",
-    "BLACKHOLE",
-    "BLACKHOLE_BQ",
-    "SE_BLACKHOLE",
-    "SE_CAF_BLACKHOLE",
-    "MVAR",
-    "ARR_WORDS",
-    "MUT_ARR_PTRS_CLEAN",
-    "MUT_ARR_PTRS_DIRTY",
-    "MUT_ARR_PTRS_FROZEN",
-    "MUT_VAR_CLEAN",
-    "MUT_VAR_DIRTY",
-    "MUT_CONS",
-    "WEAK",
-    "FOREIGN",
-    "STABLE_NAME",
-    "TSO",
-    "BLOCKED_FETCH",
-    "FETCH_ME",
-    "FETCH_ME_BQ",
-    "RBH",
-    "EVACUATED",
-    "REMOTE_REF",
-    "TVAR_WAIT_QUEUE",
-    "TVAR",
-    "TREC_CHUNK",
-    "TREC_HEADER",
-    "ATOMICALLY_FRAME",
-    "CATCH_RETRY_FRAME"
-};
-
-
-char *
-info_type(StgClosure *closure){ 
-  return closure_type_names[get_itbl(closure)->type];
-}
-
-char *
-info_type_by_ip(StgInfoTable *ip){ 
-  return closure_type_names[ip->type];
-}
-
-void
-info_hdr_type(StgClosure *closure, char *res){ 
-  strcpy(res,closure_type_names[get_itbl(closure)->type]);
-}
-
-/* --------------------------------------------------------------------------
- * Address printing code
- *
- * Uses symbol table in (unstripped executable)
- * ------------------------------------------------------------------------*/
-
-/* --------------------------------------------------------------------------
- * Simple lookup table
- *
- * Current implementation is pretty dumb!
- * ------------------------------------------------------------------------*/
-
-struct entry {
-    nat value;
-    const char *name;
-};
-
-static nat table_size;
-static struct entry* table;
-
-#ifdef USING_LIBBFD
-static nat max_table_size;
-
-static void reset_table( int size )
-{
-    max_table_size = size;
-    table_size = 0;
-    table = (struct entry *)stgMallocBytes(size * sizeof(struct entry), "Printer.c:reset_table()");
-}
-
-static void prepare_table( void )
-{
-    /* Could sort it...  */
-}
-
-static void insert( unsigned value, const char *name )
-{
-    if ( table_size >= max_table_size ) {
-        barf( "Symbol table overflow\n" );
-    }
-    table[table_size].value = value;
-    table[table_size].name = name;
-    table_size = table_size + 1;
-}
-#endif
-
-#if 0
-static rtsBool lookup_name( char *name, unsigned *result )
-{
-    int i;
-    for( i = 0; i < table_size && strcmp(name,table[i].name) != 0; ++i ) {
-    }
-    if (i < table_size) {
-        *result = table[i].value;
-        return rtsTrue;
-    } else {
-        return rtsFalse;
-    }
-}
-#endif
-
-/* Code from somewhere inside GHC (circa 1994)
- * * Z-escapes:
- *     "std"++xs -> "Zstd"++xs
- *     char_to_c 'Z'  = "ZZ"
- *     char_to_c '&'  = "Za"
- *     char_to_c '|'  = "Zb"
- *     char_to_c ':'  = "Zc"
- *     char_to_c '/'  = "Zd"
- *     char_to_c '='  = "Ze"
- *     char_to_c '>'  = "Zg"
- *     char_to_c '#'  = "Zh"
- *     char_to_c '<'  = "Zl"
- *     char_to_c '-'  = "Zm"
- *     char_to_c '!'  = "Zn"
- *     char_to_c '.'  = "Zo"
- *     char_to_c '+'  = "Zp"
- *     char_to_c '\'' = "Zq"
- *     char_to_c '*'  = "Zt"
- *     char_to_c '_'  = "Zu"
- *     char_to_c c    = "Z" ++ show (ord c)
- */
-static char unZcode( char ch )
-{
-    switch (ch) {
-    case 'a'  : return ('&');
-    case 'b'  : return ('|');
-    case 'c'  : return (':');
-    case 'd'  : return ('/');
-    case 'e'  : return ('=');
-    case 'g'  : return ('>');
-    case 'h'  : return ('#');
-    case 'l'  : return ('<');
-    case 'm'  : return ('-');
-    case 'n'  : return ('!');
-    case 'o'  : return ('.');
-    case 'p'  : return ('+');
-    case 'q'  : return ('\'');
-    case 't'  : return ('*');
-    case 'u'  : return ('_');
-    case 'Z'  :
-    case '\0' : return ('Z');
-    default   : return (ch);
-    }
-}
-
-#if 0
-/* Precondition: out big enough to handle output (about twice length of in) */
-static void enZcode( char *in, char *out )
-{
-    int i, j;
-
-    j = 0;
-    out[ j++ ] = '_';
-    for( i = 0; in[i] != '\0'; ++i ) {
-        switch (in[i]) {
-        case 'Z'  : 
-                out[j++] = 'Z';
-                out[j++] = 'Z';
-                break;
-        case '&'  : 
-                out[j++] = 'Z';
-                out[j++] = 'a';
-                break;
-        case '|'  : 
-                out[j++] = 'Z';
-                out[j++] = 'b';
-                break;
-        case ':'  : 
-                out[j++] = 'Z';
-                out[j++] = 'c';
-                break;
-        case '/'  : 
-                out[j++] = 'Z';
-                out[j++] = 'd';
-                break;
-        case '='  : 
-                out[j++] = 'Z';
-                out[j++] = 'e';
-                break;
-        case '>'  : 
-                out[j++] = 'Z';
-                out[j++] = 'g';
-                break;
-        case '#'  : 
-                out[j++] = 'Z';
-                out[j++] = 'h';
-                break;
-        case '<'  : 
-                out[j++] = 'Z';
-                out[j++] = 'l';
-                break;
-        case '-'  : 
-                out[j++] = 'Z';
-                out[j++] = 'm';
-                break;
-        case '!'  : 
-                out[j++] = 'Z';
-                out[j++] = 'n';
-                break;
-        case '.'  : 
-                out[j++] = 'Z';
-                out[j++] = 'o';
-                break;
-        case '+'  : 
-                out[j++] = 'Z';
-                out[j++] = 'p';
-                break;
-        case '\'' : 
-                out[j++] = 'Z';
-                out[j++] = 'q';
-                break;
-        case '*'  : 
-                out[j++] = 'Z';
-                out[j++] = 't';
-                break;
-        case '_'  : 
-                out[j++] = 'Z';
-                out[j++] = 'u';
-                break;
-        default :
-                out[j++] = in[i];
-                break;
-        }
-    }
-    out[j] = '\0';
-}
-#endif
-
-const char *lookupGHCName( void *addr )
-{
-    nat i;
-    for( i = 0; i < table_size && table[i].value != (unsigned) addr; ++i ) {
-    }
-    if (i < table_size) {
-        return table[i].name;
-    } else {
-        return NULL;
-    }
-}
-
-static void printZcoded( const char *raw )
-{
-    nat j = 0;
-    
-    while ( raw[j] != '\0' ) {
-        if (raw[j] == 'Z') {
-            debugBelch("%c", unZcode(raw[j+1]));
-            j = j + 2;
-        } else {
-            debugBelch("%c", unZcode(raw[j+1]));
-            j = j + 1;
-        }
-    }
-}
-
-/* --------------------------------------------------------------------------
- * Symbol table loading
- * ------------------------------------------------------------------------*/
-
-/* Causing linking trouble on Win32 plats, so I'm
-   disabling this for now. 
-*/
-#ifdef USING_LIBBFD
-
-#include <bfd.h>
-
-/* Fairly ad-hoc piece of code that seems to filter out a lot of
- * rubbish like the obj-splitting symbols
- */
-
-static rtsBool isReal( flagword flags STG_UNUSED, const char *name )
-{
-#if 0
-    /* ToDo: make this work on BFD */
-    int tp = type & N_TYPE;    
-    if (tp == N_TEXT || tp == N_DATA) {
-        return (name[0] == '_' && name[1] != '_');
-    } else {
-        return rtsFalse;
-    }
-#else
-    if (*name == '\0'  || 
-	(name[0] == 'g' && name[1] == 'c' && name[2] == 'c') ||
-	(name[0] == 'c' && name[1] == 'c' && name[2] == '.')) {
-	return rtsFalse;
-    }
-    return rtsTrue;
-#endif
-}
-
-extern void DEBUG_LoadSymbols( char *name )
-{
-    bfd* abfd;
-    char **matching;
-
-    bfd_init();
-    abfd = bfd_openr(name, "default");
-    if (abfd == NULL) {
-	barf("can't open executable %s to get symbol table", name);
-    }
-    if (!bfd_check_format_matches (abfd, bfd_object, &matching)) {
-	barf("mismatch");
-    }
-
-    {
-	long storage_needed;
-	asymbol **symbol_table;
-	long number_of_symbols;
-        long num_real_syms = 0;
-	long i;
-     
-	storage_needed = bfd_get_symtab_upper_bound (abfd);
-     
-	if (storage_needed < 0) {
-	    barf("can't read symbol table");
-	}     
-#if 0
-	if (storage_needed == 0) {
-	    debugBelch("no storage needed");
-	}
-#endif
-	symbol_table = (asymbol **) stgMallocBytes(storage_needed,"DEBUG_LoadSymbols");
-
-	number_of_symbols = bfd_canonicalize_symtab (abfd, symbol_table);
-     
-	if (number_of_symbols < 0) {
-	    barf("can't canonicalise symbol table");
-	}
-
-        for( i = 0; i != number_of_symbols; ++i ) {
-            symbol_info info;
-            bfd_get_symbol_info(abfd,symbol_table[i],&info);
-            /*debugBelch("\t%c\t0x%x      \t%s\n",info.type,(nat)info.value,info.name); */
-            if (isReal(info.type, info.name)) {
-                num_real_syms += 1;
-            }
-        }
-    
-        IF_DEBUG(interpreter,
-                 debugBelch("Loaded %ld symbols. Of which %ld are real symbols\n", 
-                         number_of_symbols, num_real_syms)
-                 );
-
-        reset_table( num_real_syms );
-    
-        for( i = 0; i != number_of_symbols; ++i ) {
-            symbol_info info;
-            bfd_get_symbol_info(abfd,symbol_table[i],&info);
-            if (isReal(info.type, info.name)) {
-                insert( info.value, info.name );
-            }
-        }
-
-        stgFree(symbol_table);
-    }
-    prepare_table();
-}
-
-#else /* HAVE_BFD_H */
-
-extern void DEBUG_LoadSymbols( char *name STG_UNUSED )
-{
-  /* nothing, yet */
-}
-
-#endif /* HAVE_BFD_H */
-
-void findPtr(P_ p, int);		/* keep gcc -Wall happy */
-
-void
-findPtr(P_ p, int follow)
-{
-  nat s, g;
-  P_ q, r;
-  bdescr *bd;
-#if defined(__GNUC__)
-  const int arr_size = 1024;
-#else
-#define arr_size 1024
-#endif
-  StgPtr arr[arr_size];
-  int i = 0;
-
-  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-      for (s = 0; s < generations[g].n_steps; s++) {
-	  bd = generations[g].steps[s].blocks;
-	  for (; bd; bd = bd->link) {
-	      for (q = bd->start; q < bd->free; q++) {
-		  if (*q == (W_)p) {
-		      if (i < arr_size) {
-			  r = q;
-			  while (!LOOKS_LIKE_INFO_PTR(*r) || (P_)*r == NULL) {
-			      r--;
-			  }
-			  debugBelch("%p = ", r);
-			  printClosure((StgClosure *)r);
-			  arr[i++] = r;
-		      } else {
-			  return;
-		      }
-		  }
-	      }
-	  }
-      }
-  }
-  if (follow && i == 1) {
-      debugBelch("-->\n");
-      findPtr(arr[0], 1);
-  }
-}
-
-#else /* DEBUG */
-void printPtr( StgPtr p )
-{
-    debugBelch("ptr 0x%p (enable -DDEBUG for more info) " , p );
-}
-  
-void printObj( StgClosure *obj )
-{
-    debugBelch("obj 0x%p (enable -DDEBUG for more info) " , obj );
-}
-#endif /* DEBUG */
diff --git a/ghc/rts/Printer.h b/ghc/rts/Printer.h
deleted file mode 100644
index 54bf611250..0000000000
--- a/ghc/rts/Printer.h
+++ /dev/null
@@ -1,31 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Prototypes for functions in Printer.c
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef PRINTER_H
-#define PRINTER_H
-
-extern void   	   printPtr        ( StgPtr p );
-extern void   	   printObj        ( StgClosure *obj );
-
-#ifdef DEBUG
-extern void   	   printClosure    ( StgClosure *obj );
-extern StgStackPtr printStackObj   ( StgStackPtr sp );
-extern void        printStackChunk ( StgStackPtr sp, StgStackPtr spLim );
-extern void        printTSO        ( StgTSO *tso );
-
-void   	           info_hdr_type   ( StgClosure *closure, char *res );
-char  *	           info_type       ( StgClosure *closure );
-char  *	           info_type_by_ip ( StgInfoTable *ip );
-
-extern void DEBUG_LoadSymbols( char *name );
-
-extern const char *lookupGHCName( void *addr );
-#endif
-
-#endif /* PRINTER_H */
-
diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c
deleted file mode 100644
index 312bee735c..0000000000
--- a/ghc/rts/ProfHeap.c
+++ /dev/null
@@ -1,1156 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2003
- *
- * Support for heap profiling
- *
- * ---------------------------------------------------------------------------*/
-
-#if defined(DEBUG) && !defined(PROFILING)
-#define DEBUG_HEAP_PROF
-#else
-#undef DEBUG_HEAP_PROF
-#endif
-
-#if defined(PROFILING) || defined(DEBUG_HEAP_PROF)
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "Profiling.h"
-#include "Storage.h"
-#include "ProfHeap.h"
-#include "Stats.h"
-#include "Hash.h"
-#include "RetainerProfile.h"
-#include "LdvProfile.h"
-#include "Arena.h"
-#include "Printer.h"
-
-#include <string.h>
-#include <stdlib.h>
-#include <math.h>
-
-/* -----------------------------------------------------------------------------
- * era stores the current time period.  It is the same as the
- * number of censuses that have been performed.
- *
- * RESTRICTION:
- *   era must be no longer than LDV_SHIFT (15 or 30) bits.
- * Invariants:
- *   era is initialized to 1 in initHeapProfiling().
- *
- * max_era is initialized to 2^LDV_SHIFT in initHeapProfiling().
- * When era reaches max_era, the profiling stops because a closure can
- * store only up to (max_era - 1) as its creation or last use time.
- * -------------------------------------------------------------------------- */
-unsigned int era;
-static nat max_era;
-
-/* -----------------------------------------------------------------------------
- * Counters
- *
- * For most heap profiles each closure identity gets a simple count
- * of live words in the heap at each census.  However, if we're
- * selecting by biography, then we have to keep the various
- * lag/drag/void counters for each identity.
- * -------------------------------------------------------------------------- */
-typedef struct _counter {
-    void *identity;
-    union {
-	nat resid;
-	struct {
-	    int prim;     // total size of 'inherently used' closures
-	    int not_used; // total size of 'never used' closures
-	    int used;     // total size of 'used at least once' closures
-	    int void_total;  // current total size of 'destroyed without being used' closures
-	    int drag_total;  // current total size of 'used at least once and waiting to die'
-	} ldv;
-    } c;
-    struct _counter *next;
-} counter;
-
-STATIC_INLINE void
-initLDVCtr( counter *ctr )
-{
-    ctr->c.ldv.prim = 0;
-    ctr->c.ldv.not_used = 0;
-    ctr->c.ldv.used = 0;
-    ctr->c.ldv.void_total = 0;
-    ctr->c.ldv.drag_total = 0;
-}
-
-typedef struct {
-    double      time;    // the time in MUT time when the census is made
-    HashTable * hash;
-    counter   * ctrs;
-    Arena     * arena;
-
-    // for LDV profiling, when just displaying by LDV
-    int       prim;
-    int       not_used;
-    int       used;
-    int       void_total;
-    int       drag_total;
-} Census;
-
-static Census *censuses = NULL;
-static nat n_censuses = 0;
-
-#ifdef PROFILING
-static void aggregateCensusInfo( void );
-#endif
-
-static void dumpCensus( Census *census );
-
-/* -----------------------------------------------------------------------------
-   Closure Type Profiling;
-
-   PROBABLY TOTALLY OUT OF DATE -- ToDo (SDM)
-   -------------------------------------------------------------------------- */
-
-#ifdef DEBUG_HEAP_PROF
-static char *type_names[] = {
-      "INVALID_OBJECT"
-    , "CONSTR"
-    , "CONSTR_INTLIKE"
-    , "CONSTR_CHARLIKE"
-    , "CONSTR_STATIC"
-    , "CONSTR_NOCAF_STATIC"
-
-    , "FUN"
-    , "FUN_STATIC"
-
-    , "THUNK"
-    , "THUNK_STATIC"
-    , "THUNK_SELECTOR"
-
-    , "BCO"
-    , "AP_STACK"
-    , "AP"
-
-    , "PAP"
-
-    , "IND"
-    , "IND_OLDGEN"
-    , "IND_PERM"
-    , "IND_OLDGEN_PERM"
-    , "IND_STATIC"
-
-    , "RET_BCO"
-    , "RET_SMALL"
-    , "RET_VEC_SMALL"
-    , "RET_BIG"
-    , "RET_VEC_BIG"
-    , "RET_DYN"
-    , "UPDATE_FRAME"
-    , "CATCH_FRAME"
-    , "STOP_FRAME"
-
-    , "BLACKHOLE"
-    , "MVAR"
-
-    , "ARR_WORDS"
-
-    , "MUT_ARR_PTRS_CLEAN"
-    , "MUT_ARR_PTRS_DIRTY"
-    , "MUT_ARR_PTRS_FROZEN"
-    , "MUT_VAR_CLEAN"
-    , "MUT_VAR_DIRTY"
-
-    , "WEAK"
-  
-    , "TSO"
-
-    , "BLOCKED_FETCH"
-    , "FETCH_ME"
-
-    , "EVACUATED"
-};
-
-#endif /* DEBUG_HEAP_PROF */
-
-/* -----------------------------------------------------------------------------
- * Find the "closure identity", which is a unique pointer reresenting
- * the band to which this closure's heap space is attributed in the
- * heap profile.
- * ------------------------------------------------------------------------- */
-STATIC_INLINE void *
-closureIdentity( StgClosure *p )
-{
-    switch (RtsFlags.ProfFlags.doHeapProfile) {
-
-#ifdef PROFILING
-    case HEAP_BY_CCS:
-	return p->header.prof.ccs;
-    case HEAP_BY_MOD:
-	return p->header.prof.ccs->cc->module;
-    case HEAP_BY_DESCR:
-	return get_itbl(p)->prof.closure_desc;
-    case HEAP_BY_TYPE:
-	return get_itbl(p)->prof.closure_type;
-    case HEAP_BY_RETAINER:
-	// AFAIK, the only closures in the heap which might not have a
-	// valid retainer set are DEAD_WEAK closures.
-	if (isRetainerSetFieldValid(p))
-	    return retainerSetOf(p);
-	else
-	    return NULL;
-
-#else // DEBUG
-    case HEAP_BY_INFOPTR:
-	return (void *)((StgClosure *)p)->header.info; 
-    case HEAP_BY_CLOSURE_TYPE:
-	return type_names[get_itbl(p)->type];
-
-#endif
-    default:
-	barf("closureIdentity");
-    }
-}
-
-/* --------------------------------------------------------------------------
- * Profiling type predicates
- * ----------------------------------------------------------------------- */
-#ifdef PROFILING
-STATIC_INLINE rtsBool
-doingLDVProfiling( void )
-{
-    return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV 
-	    || RtsFlags.ProfFlags.bioSelector != NULL);
-}
-
-STATIC_INLINE rtsBool
-doingRetainerProfiling( void )
-{
-    return (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER
-	    || RtsFlags.ProfFlags.retainerSelector != NULL);
-}
-#endif /* PROFILING */
-
-// Precesses a closure 'c' being destroyed whose size is 'size'.
-// Make sure that LDV_recordDead() is not invoked on 'inherently used' closures
-// such as TSO; they should not be involved in computing dragNew or voidNew.
-// 
-// Even though era is checked in both LdvCensusForDead() and 
-// LdvCensusKillAll(), we still need to make sure that era is > 0 because 
-// LDV_recordDead() may be called from elsewhere in the runtime system. E.g., 
-// when a thunk is replaced by an indirection object.
-
-#ifdef PROFILING
-void
-LDV_recordDead( StgClosure *c, nat size )
-{
-    void *id;
-    nat t;
-    counter *ctr;
-
-    if (era > 0 && closureSatisfiesConstraints(c)) {
-	size -= sizeofW(StgProfHeader);
-	ASSERT(LDVW(c) != 0);
-	if ((LDVW((c)) & LDV_STATE_MASK) == LDV_STATE_CREATE) {
-	    t = (LDVW((c)) & LDV_CREATE_MASK) >> LDV_SHIFT;
-	    if (t < era) {
-		if (RtsFlags.ProfFlags.bioSelector == NULL) {
-		    censuses[t].void_total   += (int)size;
-		    censuses[era].void_total -= (int)size;
-		    ASSERT(censuses[t].void_total < censuses[t].not_used);
-		} else {
-		    id = closureIdentity(c);
-		    ctr = lookupHashTable(censuses[t].hash, (StgWord)id);
-		    ASSERT( ctr != NULL );
-		    ctr->c.ldv.void_total += (int)size;
-		    ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
-		    if (ctr == NULL) {
-			ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
-			initLDVCtr(ctr);
-			insertHashTable(censuses[era].hash, (StgWord)id, ctr);
-			ctr->identity = id;
-			ctr->next = censuses[era].ctrs;
-			censuses[era].ctrs = ctr;
-		    }
-		    ctr->c.ldv.void_total -= (int)size;
-		}
-	    }
-	} else {
-	    t = LDVW((c)) & LDV_LAST_MASK;
-	    if (t + 1 < era) {
-		if (RtsFlags.ProfFlags.bioSelector == NULL) {
-		    censuses[t+1].drag_total += size;
-		    censuses[era].drag_total -= size;
-		} else {
-		    void *id;
-		    id = closureIdentity(c);
-		    ctr = lookupHashTable(censuses[t+1].hash, (StgWord)id);
-		    ASSERT( ctr != NULL );
-		    ctr->c.ldv.drag_total += (int)size;
-		    ctr = lookupHashTable(censuses[era].hash, (StgWord)id);
-		    if (ctr == NULL) {
-			ctr = arenaAlloc(censuses[era].arena, sizeof(counter));
-			initLDVCtr(ctr);
-			insertHashTable(censuses[era].hash, (StgWord)id, ctr);
-			ctr->identity = id;
-			ctr->next = censuses[era].ctrs;
-			censuses[era].ctrs = ctr;
-		    }
-		    ctr->c.ldv.drag_total -= (int)size;
-		}
-	    }
-	}
-    }
-}
-#endif
-
-/* --------------------------------------------------------------------------
- * Initialize censuses[era];
- * ----------------------------------------------------------------------- */
-STATIC_INLINE void
-initEra(Census *census)
-{
-    census->hash  = allocHashTable();
-    census->ctrs  = NULL;
-    census->arena = newArena();
-
-    census->not_used   = 0;
-    census->used       = 0;
-    census->prim       = 0;
-    census->void_total = 0;
-    census->drag_total = 0;
-}
-
-/* --------------------------------------------------------------------------
- * Increases era by 1 and initialize census[era].
- * Reallocates gi[] and increases its size if needed.
- * ----------------------------------------------------------------------- */
-static void
-nextEra( void )
-{
-#ifdef PROFILING
-    if (doingLDVProfiling()) { 
-	era++;
-
-	if (era == max_era) {
-	    errorBelch("maximum number of censuses reached; use +RTS -i to reduce");
-	    stg_exit(EXIT_FAILURE);
-	}
-	
-	if (era == n_censuses) {
-	    n_censuses *= 2;
-	    censuses = stgReallocBytes(censuses, sizeof(Census) * n_censuses,
-				       "nextEra");
-	}
-    }
-#endif /* PROFILING */
-
-    initEra( &censuses[era] );
-}
-
-/* -----------------------------------------------------------------------------
- * DEBUG heap profiling, by info table
- * -------------------------------------------------------------------------- */
-
-#ifdef DEBUG_HEAP_PROF
-FILE *hp_file;
-static char *hp_filename;
-
-void initProfiling1( void )
-{
-}
-
-void initProfiling2( void )
-{
-  if (RtsFlags.ProfFlags.doHeapProfile) {
-    /* Initialise the log file name */
-    hp_filename = stgMallocBytes(strlen(prog_name) + 6, "hpFileName");
-    sprintf(hp_filename, "%s.hp", prog_name);
-    
-    /* open the log file */
-    if ((hp_file = fopen(hp_filename, "w")) == NULL) {
-      debugBelch("Can't open profiling report file %s\n", 
-	      hp_filename);
-      RtsFlags.ProfFlags.doHeapProfile = 0;
-      return;
-    }
-  }
-  
-  initHeapProfiling();
-}
-
-void endProfiling( void )
-{
-  endHeapProfiling();
-}
-#endif /* DEBUG_HEAP_PROF */
-
-static void
-printSample(rtsBool beginSample, StgDouble sampleValue)
-{
-    StgDouble fractionalPart, integralPart;
-    fractionalPart = modf(sampleValue, &integralPart);
-    fprintf(hp_file, "%s %d.%02d\n",
-            (beginSample ? "BEGIN_SAMPLE" : "END_SAMPLE"),
-            (int)integralPart, (int)(fractionalPart * 100));
-}
-
-/* --------------------------------------------------------------------------
- * Initialize the heap profilier
- * ----------------------------------------------------------------------- */
-nat
-initHeapProfiling(void)
-{
-    if (! RtsFlags.ProfFlags.doHeapProfile) {
-        return 0;
-    }
-
-#ifdef PROFILING
-    if (doingLDVProfiling() && doingRetainerProfiling()) {
-	errorBelch("cannot mix -hb and -hr");
-	stg_exit(EXIT_FAILURE);
-    }
-#endif
-
-    // we only count eras if we're doing LDV profiling.  Otherwise era
-    // is fixed at zero.
-#ifdef PROFILING
-    if (doingLDVProfiling()) {
-	era = 1;
-    } else
-#endif
-    {
-	era = 0;
-    }
-
-    {   // max_era = 2^LDV_SHIFT
-	nat p;
-	max_era = 1;
-	for (p = 0; p < LDV_SHIFT; p++)
-	    max_era *= 2;
-    }
-
-    n_censuses = 32;
-    censuses = stgMallocBytes(sizeof(Census) * n_censuses, "initHeapProfiling");
-
-    initEra( &censuses[era] );
-
-    /* initProfilingLogFile(); */
-    fprintf(hp_file, "JOB \"%s", prog_name);
-
-#ifdef PROFILING
-    {
-	int count;
-	for(count = 1; count < prog_argc; count++)
-	    fprintf(hp_file, " %s", prog_argv[count]);
-	fprintf(hp_file, " +RTS");
-	for(count = 0; count < rts_argc; count++)
-	    fprintf(hp_file, " %s", rts_argv[count]);
-    }
-#endif /* PROFILING */
-
-    fprintf(hp_file, "\"\n" );
-
-    fprintf(hp_file, "DATE \"%s\"\n", time_str());
-
-    fprintf(hp_file, "SAMPLE_UNIT \"seconds\"\n");
-    fprintf(hp_file, "VALUE_UNIT \"bytes\"\n");
-
-    printSample(rtsTrue, 0);
-    printSample(rtsFalse, 0);
-
-#ifdef DEBUG_HEAP_PROF
-    DEBUG_LoadSymbols(prog_name);
-#endif
-
-#ifdef PROFILING
-    if (doingRetainerProfiling()) {
-	initRetainerProfiling();
-    }
-#endif
-
-    return 0;
-}
-
-void
-endHeapProfiling(void)
-{
-    StgDouble seconds;
-
-    if (! RtsFlags.ProfFlags.doHeapProfile) {
-        return;
-    }
-
-#ifdef PROFILING
-    if (doingRetainerProfiling()) {
-	endRetainerProfiling();
-    }
-#endif
-
-#ifdef PROFILING
-    if (doingLDVProfiling()) {
-	nat t;
-	LdvCensusKillAll();
-	aggregateCensusInfo();
-	for (t = 1; t < era; t++) {
-	    dumpCensus( &censuses[t] );
-	}
-    }
-#endif
-
-    seconds = mut_user_time();
-    printSample(rtsTrue, seconds);
-    printSample(rtsFalse, seconds);
-    fclose(hp_file);
-}
-
-
-
-#ifdef PROFILING
-static size_t
-buf_append(char *p, const char *q, char *end)
-{
-    int m;
-
-    for (m = 0; p < end; p++, q++, m++) {
-	*p = *q;
-	if (*q == '\0') { break; }
-    }
-    return m;
-}
-
-static void
-fprint_ccs(FILE *fp, CostCentreStack *ccs, nat max_length)
-{
-    char buf[max_length+1], *p, *buf_end;
-
-    // MAIN on its own gets printed as "MAIN", otherwise we ignore MAIN.
-    if (ccs == CCS_MAIN) {
-	fprintf(fp, "MAIN");
-	return;
-    }
-
-    fprintf(fp, "(%ld)", ccs->ccsID);
-
-    p = buf;
-    buf_end = buf + max_length + 1;
-
-    // keep printing components of the stack until we run out of space
-    // in the buffer.  If we run out of space, end with "...".
-    for (; ccs != NULL && ccs != CCS_MAIN; ccs = ccs->prevStack) {
-
-	// CAF cost centres print as M.CAF, but we leave the module
-	// name out of all the others to save space.
-	if (!strcmp(ccs->cc->label,"CAF")) {
-	    p += buf_append(p, ccs->cc->module, buf_end);
-	    p += buf_append(p, ".CAF", buf_end);
-	} else {
-	    if (ccs->prevStack != NULL && ccs->prevStack != CCS_MAIN) {
-		p += buf_append(p, "/", buf_end);
-	    }
-	    p += buf_append(p, ccs->cc->label, buf_end);
-	}
-	
-	if (p >= buf_end) {
-	    sprintf(buf+max_length-4, "...");
-	    break;
-	}
-    }
-    fprintf(fp, "%s", buf);
-}
-#endif /* PROFILING */
-
-rtsBool
-strMatchesSelector( char* str, char* sel )
-{
-   char* p;
-   // debugBelch("str_matches_selector %s %s\n", str, sel);
-   while (1) {
-       // Compare str against wherever we've got to in sel.
-       p = str;
-       while (*p != '\0' && *sel != ',' && *sel != '\0' && *p == *sel) {
-	   p++; sel++;
-       }
-       // Match if all of str used and have reached the end of a sel fragment.
-       if (*p == '\0' && (*sel == ',' || *sel == '\0'))
-	   return rtsTrue;
-       
-       // No match.  Advance sel to the start of the next elem.
-       while (*sel != ',' && *sel != '\0') sel++;
-       if (*sel == ',') sel++;
-       
-       /* Run out of sel ?? */
-       if (*sel == '\0') return rtsFalse;
-   }
-}
-
-/* -----------------------------------------------------------------------------
- * Figure out whether a closure should be counted in this census, by
- * testing against all the specified constraints.
- * -------------------------------------------------------------------------- */
-rtsBool
-closureSatisfiesConstraints( StgClosure* p )
-{
-#ifdef DEBUG_HEAP_PROF
-    (void)p;   /* keep gcc -Wall happy */
-    return rtsTrue;
-#else
-   rtsBool b;
-
-   // The CCS has a selected field to indicate whether this closure is
-   // deselected by not being mentioned in the module, CC, or CCS
-   // selectors.
-   if (!p->header.prof.ccs->selected) {
-       return rtsFalse;
-   }
-
-   if (RtsFlags.ProfFlags.descrSelector) {
-       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_desc,
-				 RtsFlags.ProfFlags.descrSelector );
-       if (!b) return rtsFalse;
-   }
-   if (RtsFlags.ProfFlags.typeSelector) {
-       b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_type,
-                                RtsFlags.ProfFlags.typeSelector );
-       if (!b) return rtsFalse;
-   }
-   if (RtsFlags.ProfFlags.retainerSelector) {
-       RetainerSet *rs;
-       nat i;
-       // We must check that the retainer set is valid here.  One
-       // reason it might not be valid is if this closure is a
-       // a newly deceased weak pointer (i.e. a DEAD_WEAK), since
-       // these aren't reached by the retainer profiler's traversal.
-       if (isRetainerSetFieldValid((StgClosure *)p)) {
-	   rs = retainerSetOf((StgClosure *)p);
-	   if (rs != NULL) {
-	       for (i = 0; i < rs->num; i++) {
-		   b = strMatchesSelector( rs->element[i]->cc->label,
-					   RtsFlags.ProfFlags.retainerSelector );
-		   if (b) return rtsTrue;
-	       }
-	   }
-       }
-       return rtsFalse;
-   }
-   return rtsTrue;
-#endif /* PROFILING */
-}
-
-/* -----------------------------------------------------------------------------
- * Aggregate the heap census info for biographical profiling
- * -------------------------------------------------------------------------- */
-#ifdef PROFILING
-static void
-aggregateCensusInfo( void )
-{
-    HashTable *acc;
-    nat t;
-    counter *c, *d, *ctrs;
-    Arena *arena;
-
-    if (!doingLDVProfiling()) return;
-
-    // Aggregate the LDV counters when displaying by biography.
-    if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
-	int void_total, drag_total;
-
-	// Now we compute void_total and drag_total for each census
-	// After the program has finished, the void_total field of
-	// each census contains the count of words that were *created*
-	// in this era and were eventually void.  Conversely, if a
-	// void closure was destroyed in this era, it will be
-	// represented by a negative count of words in void_total.
-	//
-	// To get the count of live words that are void at each
-	// census, just propagate the void_total count forwards:
-
-	void_total = 0;
-	drag_total = 0;
-	for (t = 1; t < era; t++) { // note: start at 1, not 0
-	    void_total += censuses[t].void_total;
-	    drag_total += censuses[t].drag_total;
-	    censuses[t].void_total = void_total;
-	    censuses[t].drag_total = drag_total;
-
-	    ASSERT( censuses[t].void_total <= censuses[t].not_used );
-	    // should be true because: void_total is the count of
-	    // live words that are void at this census, which *must*
-	    // be less than the number of live words that have not
-	    // been used yet.
-
-	    ASSERT( censuses[t].drag_total <= censuses[t].used );
-	    // similar reasoning as above.
-	}
-	
-	return;
-    }
-
-    // otherwise... we're doing a heap profile that is restricted to
-    // some combination of lag, drag, void or use.  We've kept all the
-    // census info for all censuses so far, but we still need to
-    // aggregate the counters forwards.
-
-    arena = newArena();
-    acc = allocHashTable();
-    ctrs = NULL;
-
-    for (t = 1; t < era; t++) {
-
-	// first look through all the counters we're aggregating
-	for (c = ctrs; c != NULL; c = c->next) {
-	    // if one of the totals is non-zero, then this closure
-	    // type must be present in the heap at this census time...
-	    d = lookupHashTable(censuses[t].hash, (StgWord)c->identity);
-
-	    if (d == NULL) {
-		// if this closure identity isn't present in the
-		// census for this time period, then our running
-		// totals *must* be zero.
-		ASSERT(c->c.ldv.void_total == 0 && c->c.ldv.drag_total == 0);
-
-		// debugCCS(c->identity);
-		// debugBelch(" census=%d void_total=%d drag_total=%d\n",
-		//         t, c->c.ldv.void_total, c->c.ldv.drag_total);
-	    } else {
-		d->c.ldv.void_total += c->c.ldv.void_total;
-		d->c.ldv.drag_total += c->c.ldv.drag_total;
-		c->c.ldv.void_total =  d->c.ldv.void_total;
-		c->c.ldv.drag_total =  d->c.ldv.drag_total;
-
-		ASSERT( c->c.ldv.void_total >= 0 );
-		ASSERT( c->c.ldv.drag_total >= 0 );
-	    }
-	}
-
-	// now look through the counters in this census to find new ones
-	for (c = censuses[t].ctrs; c != NULL; c = c->next) {
-	    d = lookupHashTable(acc, (StgWord)c->identity);
-	    if (d == NULL) {
-		d = arenaAlloc( arena, sizeof(counter) );
-		initLDVCtr(d);
-		insertHashTable( acc, (StgWord)c->identity, d );
-		d->identity = c->identity;
-		d->next = ctrs;
-		ctrs = d;
-		d->c.ldv.void_total = c->c.ldv.void_total;
-		d->c.ldv.drag_total = c->c.ldv.drag_total;
-	    }
-	    ASSERT( c->c.ldv.void_total >= 0 );
-	    ASSERT( c->c.ldv.drag_total >= 0 );
-	}
-    }
-
-    freeHashTable(acc, NULL);
-    arenaFree(arena);
-}
-#endif
-
-/* -----------------------------------------------------------------------------
- * Print out the results of a heap census.
- * -------------------------------------------------------------------------- */
-static void
-dumpCensus( Census *census )
-{
-    counter *ctr;
-    int count;
-
-    printSample(rtsTrue, census->time);
-
-#ifdef PROFILING
-    if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
-      fprintf(hp_file, "VOID\t%lu\n", (unsigned long)(census->void_total) * sizeof(W_));
-	fprintf(hp_file, "LAG\t%lu\n", 
-		(unsigned long)(census->not_used - census->void_total) * sizeof(W_));
-	fprintf(hp_file, "USE\t%lu\n", 
-		(unsigned long)(census->used - census->drag_total) * sizeof(W_));
-	fprintf(hp_file, "INHERENT_USE\t%lu\n", 
-		(unsigned long)(census->prim) * sizeof(W_));
-	fprintf(hp_file, "DRAG\t%lu\n",
-		(unsigned long)(census->drag_total) * sizeof(W_));
-	printSample(rtsFalse, census->time);
-	return;
-    }
-#endif
-
-    for (ctr = census->ctrs; ctr != NULL; ctr = ctr->next) {
-
-#ifdef PROFILING
-	if (RtsFlags.ProfFlags.bioSelector != NULL) {
-	    count = 0;
-	    if (strMatchesSelector("lag", RtsFlags.ProfFlags.bioSelector))
-		count += ctr->c.ldv.not_used - ctr->c.ldv.void_total;
-	    if (strMatchesSelector("drag", RtsFlags.ProfFlags.bioSelector))
-		count += ctr->c.ldv.drag_total;
-	    if (strMatchesSelector("void", RtsFlags.ProfFlags.bioSelector))
-		count += ctr->c.ldv.void_total;
-	    if (strMatchesSelector("use", RtsFlags.ProfFlags.bioSelector))
-		count += ctr->c.ldv.used - ctr->c.ldv.drag_total;
-	} else
-#endif
-	{
-	    count = ctr->c.resid;
-	}
-
-	ASSERT( count >= 0 );
-
-	if (count == 0) continue;
-
-#ifdef DEBUG_HEAP_PROF
-	switch (RtsFlags.ProfFlags.doHeapProfile) {
-	case HEAP_BY_INFOPTR:
-	    fprintf(hp_file, "%s", lookupGHCName(ctr->identity));
-	    break;
-	case HEAP_BY_CLOSURE_TYPE:
-	    fprintf(hp_file, "%s", (char *)ctr->identity);
-	    break;
-	}
-#endif
-	
-#ifdef PROFILING
-	switch (RtsFlags.ProfFlags.doHeapProfile) {
-	case HEAP_BY_CCS:
-	    fprint_ccs(hp_file, (CostCentreStack *)ctr->identity, 25);
-	    break;
-	case HEAP_BY_MOD:
-	case HEAP_BY_DESCR:
-	case HEAP_BY_TYPE:
-	    fprintf(hp_file, "%s", (char *)ctr->identity);
-	    break;
-	case HEAP_BY_RETAINER:
-	{
-	    RetainerSet *rs = (RetainerSet *)ctr->identity;
-
-	    // it might be the distinguished retainer set rs_MANY:
-	    if (rs == &rs_MANY) {
-		fprintf(hp_file, "MANY");
-		break;
-	    }
-
-	    // Mark this retainer set by negating its id, because it
-	    // has appeared in at least one census.  We print the
-	    // values of all such retainer sets into the log file at
-	    // the end.  A retainer set may exist but not feature in
-	    // any censuses if it arose as the intermediate retainer
-	    // set for some closure during retainer set calculation.
-	    if (rs->id > 0)
-		rs->id = -(rs->id);
-
-	    // report in the unit of bytes: * sizeof(StgWord)
-	    printRetainerSetShort(hp_file, rs);
-	    break;
-	}
-	default:
-	    barf("dumpCensus; doHeapProfile");
-	}
-#endif
-
-	fprintf(hp_file, "\t%lu\n", (unsigned long)count * sizeof(W_));
-    }
-
-    printSample(rtsFalse, census->time);
-}
-
-/* -----------------------------------------------------------------------------
- * Code to perform a heap census.
- * -------------------------------------------------------------------------- */
-static void
-heapCensusChain( Census *census, bdescr *bd )
-{
-    StgPtr p;
-    StgInfoTable *info;
-    void *identity;
-    nat size;
-    counter *ctr;
-    nat real_size;
-    rtsBool prim;
-
-    for (; bd != NULL; bd = bd->link) {
-
-	// HACK: ignore pinned blocks, because they contain gaps.
-	// It's not clear exactly what we'd like to do here, since we
-	// can't tell which objects in the block are actually alive.
-	// Perhaps the whole block should be counted as SYSTEM memory.
-	if (bd->flags & BF_PINNED) {
-	    continue;
-	}
-
-	p = bd->start;
-	while (p < bd->free) {
-	    info = get_itbl((StgClosure *)p);
-	    prim = rtsFalse;
-	    
-	    switch (info->type) {
-
-	    case THUNK:
-		size = thunk_sizeW_fromITBL(info);
-		break;
-
-	    case THUNK_1_1:
-	    case THUNK_0_2:
-	    case THUNK_2_0:
-		size = sizeofW(StgThunkHeader) + 2;
-		break;
-
-	    case THUNK_1_0:
-	    case THUNK_0_1:
-	    case THUNK_SELECTOR:
-		size = sizeofW(StgThunkHeader) + 1;
-		break;
-
-	    case CONSTR:
-	    case FUN:
-	    case IND_PERM:
-	    case IND_OLDGEN:
-	    case IND_OLDGEN_PERM:
-	    case CAF_BLACKHOLE:
-	    case SE_CAF_BLACKHOLE:
-	    case SE_BLACKHOLE:
-	    case BLACKHOLE:
-	    case CONSTR_INTLIKE:
-	    case CONSTR_CHARLIKE:
-	    case FUN_1_0:
-	    case FUN_0_1:
-	    case FUN_1_1:
-	    case FUN_0_2:
-	    case FUN_2_0:
-	    case CONSTR_1_0:
-	    case CONSTR_0_1:
-	    case CONSTR_1_1:
-	    case CONSTR_0_2:
-	    case CONSTR_2_0:
-		size = sizeW_fromITBL(info);
-		break;
-
-	    case IND:
-		// Special case/Delicate Hack: INDs don't normally
-		// appear, since we're doing this heap census right
-		// after GC.  However, GarbageCollect() also does
-		// resurrectThreads(), which can update some
-		// blackholes when it calls raiseAsync() on the
-		// resurrected threads.  So we know that any IND will
-		// be the size of a BLACKHOLE.
-		size = BLACKHOLE_sizeW();
-		break;
-
-	    case BCO:
-		prim = rtsTrue;
-		size = bco_sizeW((StgBCO *)p);
-		break;
-
-	    case MVAR:
-	    case WEAK:
-	    case STABLE_NAME:
-	    case MUT_VAR_CLEAN:
-	    case MUT_VAR_DIRTY:
-		prim = rtsTrue;
-		size = sizeW_fromITBL(info);
-		break;
-
-	    case AP:
-		size = ap_sizeW((StgAP *)p);
-		break;
-
-	    case PAP:
-		size = pap_sizeW((StgPAP *)p);
-		break;
-
-	    case AP_STACK:
-		size = ap_stack_sizeW((StgAP_STACK *)p);
-		break;
-		
-	    case ARR_WORDS:
-		prim = rtsTrue;
-		size = arr_words_sizeW(stgCast(StgArrWords*,p));
-		break;
-		
-	    case MUT_ARR_PTRS_CLEAN:
-	    case MUT_ARR_PTRS_DIRTY:
-	    case MUT_ARR_PTRS_FROZEN:
-	    case MUT_ARR_PTRS_FROZEN0:
-		prim = rtsTrue;
-		size = mut_arr_ptrs_sizeW((StgMutArrPtrs *)p);
-		break;
-		
-	    case TSO:
-		prim = rtsTrue;
-#ifdef DEBUG_HEAP_PROF
-		size = tso_sizeW((StgTSO *)p);
-		break;
-#else
-		if (RtsFlags.ProfFlags.includeTSOs) {
-		    size = tso_sizeW((StgTSO *)p);
-		    break;
-		} else {
-		    // Skip this TSO and move on to the next object
-		    p += tso_sizeW((StgTSO *)p);
-		    continue;
-		}
-#endif
-
-	    case TREC_HEADER: 
-		prim = rtsTrue;
-		size = sizeofW(StgTRecHeader);
-		break;
-
-	    case TVAR_WAIT_QUEUE:
-		prim = rtsTrue;
-		size = sizeofW(StgTVarWaitQueue);
-		break;
-		
-	    case TVAR:
-		prim = rtsTrue;
-		size = sizeofW(StgTVar);
-		break;
-		
-	    case TREC_CHUNK:
-		prim = rtsTrue;
-		size = sizeofW(StgTRecChunk);
-		break;
-
-	    default:
-		barf("heapCensus, unknown object: %d", info->type);
-	    }
-	    
-	    identity = NULL;
-
-#ifdef DEBUG_HEAP_PROF
-	    real_size = size;
-#else
-	    // subtract the profiling overhead
-	    real_size = size - sizeofW(StgProfHeader);
-#endif
-
-	    if (closureSatisfiesConstraints((StgClosure*)p)) {
-#ifdef PROFILING
-		if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_LDV) {
-		    if (prim)
-			census->prim += real_size;
-		    else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
-			census->not_used += real_size;
-		    else
-			census->used += real_size;
-		} else
-#endif
-		{
-		    identity = closureIdentity((StgClosure *)p);
-
-		    if (identity != NULL) {
-			ctr = lookupHashTable( census->hash, (StgWord)identity );
-			if (ctr != NULL) {
-#ifdef PROFILING
-			    if (RtsFlags.ProfFlags.bioSelector != NULL) {
-				if (prim)
-				    ctr->c.ldv.prim += real_size;
-				else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
-				    ctr->c.ldv.not_used += real_size;
-				else
-				    ctr->c.ldv.used += real_size;
-			    } else
-#endif
-			    {
-				ctr->c.resid += real_size;
-			    }
-			} else {
-			    ctr = arenaAlloc( census->arena, sizeof(counter) );
-			    initLDVCtr(ctr);
-			    insertHashTable( census->hash, (StgWord)identity, ctr );
-			    ctr->identity = identity;
-			    ctr->next = census->ctrs;
-			    census->ctrs = ctr;
-
-#ifdef PROFILING
-			    if (RtsFlags.ProfFlags.bioSelector != NULL) {
-				if (prim)
-				    ctr->c.ldv.prim = real_size;
-				else if ((LDVW(p) & LDV_STATE_MASK) == LDV_STATE_CREATE)
-				    ctr->c.ldv.not_used = real_size;
-				else
-				    ctr->c.ldv.used = real_size;
-			    } else
-#endif
-			    {
-				ctr->c.resid = real_size;
-			    }
-			}
-		    }
-		}
-	    }
-
-	    p += size;
-	}
-    }
-}
-
-void
-heapCensus( void )
-{
-  nat g, s;
-  Census *census;
-
-  census = &censuses[era];
-  census->time  = mut_user_time();
-    
-  // calculate retainer sets if necessary
-#ifdef PROFILING
-  if (doingRetainerProfiling()) {
-      retainerProfile();
-  }
-#endif
-
-#ifdef PROFILING
-  stat_startHeapCensus();
-#endif
-
-  // Traverse the heap, collecting the census info
-
-  // First the small_alloc_list: we have to fix the free pointer at
-  // the end by calling tidyAllocatedLists() first.
-  tidyAllocateLists();
-  heapCensusChain( census, small_alloc_list );
-
-  // Now traverse the heap in each generation/step.
-  if (RtsFlags.GcFlags.generations == 1) {
-      heapCensusChain( census, g0s0->blocks );
-  } else {
-      for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	  for (s = 0; s < generations[g].n_steps; s++) {
-	      heapCensusChain( census, generations[g].steps[s].blocks );
-	      // Are we interested in large objects?  might be
-	      // confusing to include the stack in a heap profile.
-	      heapCensusChain( census, generations[g].steps[s].large_objects );
-	  }
-      }
-  }
-
-  // dump out the census info
-#ifdef PROFILING
-    // We can't generate any info for LDV profiling until
-    // the end of the run...
-    if (!doingLDVProfiling())
-	dumpCensus( census );
-#else
-    dumpCensus( census );
-#endif
-
-
-  // free our storage, unless we're keeping all the census info for
-  // future restriction by biography.
-#ifdef PROFILING
-  if (RtsFlags.ProfFlags.bioSelector == NULL)
-#endif
-  {
-      freeHashTable( census->hash, NULL/* don't free the elements */ );
-      arenaFree( census->arena );
-      census->hash = NULL;
-      census->arena = NULL;
-  }
-
-  // we're into the next time period now
-  nextEra();
-
-#ifdef PROFILING
-  stat_endHeapCensus();
-#endif
-}    
-
-#endif /* PROFILING || DEBUG_HEAP_PROF */
-
diff --git a/ghc/rts/ProfHeap.h b/ghc/rts/ProfHeap.h
deleted file mode 100644
index 0251416762..0000000000
--- a/ghc/rts/ProfHeap.h
+++ /dev/null
@@ -1,19 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Support for heap profiling
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef PROFHEAP_H
-#define PROFHEAP_H
-
-extern void    heapCensus( void );
-extern nat     initHeapProfiling( void );
-extern void    endHeapProfiling( void );
-extern rtsBool closureSatisfiesConstraints( StgClosure* p );
-extern void    LDV_recordDead( StgClosure *c, nat size );
-extern rtsBool strMatchesSelector( char* str, char* sel );
-
-#endif /* PROFHEAP_H */
diff --git a/ghc/rts/Profiling.c b/ghc/rts/Profiling.c
deleted file mode 100644
index 028dc5a509..0000000000
--- a/ghc/rts/Profiling.c
+++ /dev/null
@@ -1,941 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2000
- *
- * Support for profiling
- *
- * ---------------------------------------------------------------------------*/
-
-#ifdef PROFILING
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "Profiling.h"
-#include "Storage.h"
-#include "Proftimer.h"
-#include "Timer.h"
-#include "ProfHeap.h"
-#include "Arena.h"
-#include "RetainerProfile.h"
-#include "LdvProfile.h"
-
-#include <string.h>
-
-/*
- * Profiling allocation arena.
- */
-Arena *prof_arena;
-
-/*
- * Global variables used to assign unique IDs to cc's, ccs's, and 
- * closure_cats
- */
-
-unsigned int CC_ID;
-unsigned int CCS_ID;
-unsigned int HP_ID;
-
-/* figures for the profiling report.
- */
-static ullong total_alloc;
-static lnat   total_prof_ticks;
-
-/* Globals for opening the profiling log file(s)
- */
-static char *prof_filename; /* prof report file name = <program>.prof */
-FILE *prof_file;
-
-static char *hp_filename;	/* heap profile (hp2ps style) log file */
-FILE *hp_file;
-
-/* The Current Cost Centre Stack (for attributing costs)
- */
-CostCentreStack *CCCS;
-
-/* Linked lists to keep track of cc's and ccs's that haven't
- * been declared in the log file yet
- */
-CostCentre *CC_LIST;
-CostCentreStack *CCS_LIST;
-
-/*
- * Built-in cost centres and cost-centre stacks:
- *
- *    MAIN   is the root of the cost-centre stack tree.  If there are
- *           no _scc_s in the program, all costs will be attributed
- *           to MAIN.
- *
- *    SYSTEM is the RTS in general (scheduler, etc.).  All costs for
- *           RTS operations apart from garbage collection are attributed
- *           to SYSTEM.
- *
- *    GC     is the storage manager / garbage collector.
- *
- *    OVERHEAD gets all costs generated by the profiling system
- *           itself.  These are costs that would not be incurred
- *           during non-profiled execution of the program.
- *
- *    SUBSUMED is the one-and-only CCS placed on top-level functions. 
- *           It indicates that all costs are to be attributed to the
- *           enclosing cost centre stack.  SUBSUMED never accumulates
- *           any costs.  The is_caf flag is set on the subsumed cost
- *           centre.
- *
- *    DONT_CARE is a placeholder cost-centre we assign to static
- *           constructors.  It should *never* accumulate any costs.
- */
-
-CC_DECLARE(CC_MAIN,      "MAIN", 	"MAIN",      CC_IS_BORING, );
-CC_DECLARE(CC_SYSTEM,    "SYSTEM",   	"MAIN",      CC_IS_BORING, );
-CC_DECLARE(CC_GC,        "GC",   	"GC",        CC_IS_BORING, );
-CC_DECLARE(CC_OVERHEAD,  "OVERHEAD_of", "PROFILING", CC_IS_CAF,    );
-CC_DECLARE(CC_SUBSUMED,  "SUBSUMED",    "MAIN",      CC_IS_CAF,    );
-CC_DECLARE(CC_DONT_CARE, "DONT_CARE",   "MAIN",      CC_IS_BORING, );
-
-CCS_DECLARE(CCS_MAIN, 	    CC_MAIN,       );
-CCS_DECLARE(CCS_SYSTEM,	    CC_SYSTEM,     );
-CCS_DECLARE(CCS_GC,         CC_GC,         );
-CCS_DECLARE(CCS_OVERHEAD,   CC_OVERHEAD,   );
-CCS_DECLARE(CCS_SUBSUMED,   CC_SUBSUMED,   );
-CCS_DECLARE(CCS_DONT_CARE,  CC_DONT_CARE, );
-
-/* 
- * Uniques for the XML log-file format
- */
-#define CC_UQ         1
-#define CCS_UQ        2
-#define TC_UQ         3
-#define HEAP_OBJ_UQ   4
-#define TIME_UPD_UQ   5
-#define HEAP_UPD_UQ   6
-
-/* 
- * Static Functions
- */
-
-static  CostCentreStack * ActualPush_     ( CostCentreStack *ccs, CostCentre *cc, 
-					    CostCentreStack *new_ccs );
-static  rtsBool           ccs_to_ignore   ( CostCentreStack *ccs );
-static  void              count_ticks     ( CostCentreStack *ccs );
-static  void              inherit_costs   ( CostCentreStack *ccs );
-static  void              reportCCS       ( CostCentreStack *ccs, nat indent );
-static  void              DecCCS          ( CostCentreStack *ccs );
-static  void              DecBackEdge     ( CostCentreStack *ccs, 
-					    CostCentreStack *oldccs );
-static  CostCentreStack * CheckLoop       ( CostCentreStack *ccs, CostCentre *cc );
-static  CostCentreStack * pruneCCSTree    ( CostCentreStack *ccs );
-static  CostCentreStack * ActualPush      ( CostCentreStack *, CostCentre * );
-static  CostCentreStack * IsInIndexTable  ( IndexTable *, CostCentre * );
-static  IndexTable *      AddToIndexTable ( IndexTable *, CostCentreStack *, 
-					    CostCentre *, unsigned int );
-static  void              ccsSetSelected  ( CostCentreStack *ccs );
-
-static  void              initTimeProfiling   ( void );
-static  void              initProfilingLogFile( void );
-
-static  void              reportCCS_XML       ( CostCentreStack *ccs );
-
-/* -----------------------------------------------------------------------------
-   Initialise the profiling environment
-   -------------------------------------------------------------------------- */
-
-void
-initProfiling1 (void)
-{
-  // initialise our arena
-  prof_arena = newArena();
-
-  /* for the benefit of allocate()... */
-  CCCS = CCS_SYSTEM;
-  
-  /* Initialize counters for IDs */
-  CC_ID  = 1;
-  CCS_ID = 1;
-  HP_ID  = 1;
-  
-  /* Initialize Declaration lists to NULL */
-  CC_LIST  = NULL;
-  CCS_LIST = NULL;
-
-  /* Register all the cost centres / stacks in the program 
-   * CC_MAIN gets link = 0, all others have non-zero link.
-   */
-  REGISTER_CC(CC_MAIN);
-  REGISTER_CC(CC_SYSTEM);
-  REGISTER_CC(CC_GC);
-  REGISTER_CC(CC_OVERHEAD);
-  REGISTER_CC(CC_SUBSUMED);
-  REGISTER_CC(CC_DONT_CARE);
-  REGISTER_CCS(CCS_MAIN);
-  REGISTER_CCS(CCS_SYSTEM);
-  REGISTER_CCS(CCS_GC);
-  REGISTER_CCS(CCS_OVERHEAD);
-  REGISTER_CCS(CCS_SUBSUMED);
-  REGISTER_CCS(CCS_DONT_CARE);
-
-  CCCS = CCS_OVERHEAD;
-
-  /* cost centres are registered by the per-module 
-   * initialisation code now... 
-   */
-}
-
-void
-initProfiling2 (void)
-{
-  CostCentreStack *ccs, *next;
-
-  CCCS = CCS_SYSTEM;
-
-  /* Set up the log file, and dump the header and cost centre
-   * information into it.  */
-  initProfilingLogFile();
-
-  /* find all the "special" cost centre stacks, and make them children
-   * of CCS_MAIN.
-   */
-  ASSERT(CCS_MAIN->prevStack == 0);
-  CCS_MAIN->root = CC_MAIN;
-  ccsSetSelected(CCS_MAIN);
-  DecCCS(CCS_MAIN);
-
-  for (ccs = CCS_LIST; ccs != CCS_MAIN; ) {
-    next = ccs->prevStack;
-    ccs->prevStack = 0;
-    ActualPush_(CCS_MAIN,ccs->cc,ccs);
-    ccs->root = ccs->cc;
-    ccs = next;
-  }
-  
-  if (RtsFlags.CcFlags.doCostCentres) {
-    initTimeProfiling();
-  }
-
-  if (RtsFlags.ProfFlags.doHeapProfile) {
-    initHeapProfiling();
-  }
-}
-
-// Decide whether closures with this CCS should contribute to the heap
-// profile.
-static void 
-ccsSetSelected( CostCentreStack *ccs )
-{
-    if (RtsFlags.ProfFlags.modSelector) {
-	if (! strMatchesSelector( ccs->cc->module,
-				  RtsFlags.ProfFlags.modSelector ) ) {
-	    ccs->selected = 0;
-	    return;
-	}
-    }
-    if (RtsFlags.ProfFlags.ccSelector) {
-	if (! strMatchesSelector( ccs->cc->label,
-				  RtsFlags.ProfFlags.ccSelector ) ) {
-	    ccs->selected = 0;
-	    return;
-	}
-    }
-    if (RtsFlags.ProfFlags.ccsSelector) {
-	CostCentreStack *c;
-	for (c = ccs; c != NULL; c = c->prevStack) {
-	    if ( strMatchesSelector( c->cc->label,
-				     RtsFlags.ProfFlags.ccsSelector )) {
-		break; 
-	    }
-	}
-	if (c == NULL) {
-	    ccs->selected = 0;
-	    return;
-	}
-    }
-
-    ccs->selected = 1;
-    return;
-}
-
-
-static void
-initProfilingLogFile(void)
-{
-    /* Initialise the log file name */
-    prof_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
-    sprintf(prof_filename, "%s.prof", prog_name);
-
-    /* open the log file */
-    if ((prof_file = fopen(prof_filename, "w")) == NULL) {
-	debugBelch("Can't open profiling report file %s\n", prof_filename);
-	RtsFlags.CcFlags.doCostCentres = 0;
-        // The following line was added by Sung; retainer/LDV profiling may need
-        // two output files, i.e., <program>.prof/hp.
-        if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER)
-            RtsFlags.ProfFlags.doHeapProfile = 0;
-	return;
-    }
-
-    if (RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
-	/* dump the time, and the profiling interval */
-	fprintf(prof_file, "\"%s\"\n", time_str());
-	fprintf(prof_file, "\"%d ms\"\n", TICK_MILLISECS);
-	
-	/* declare all the cost centres */
-	{
-	    CostCentre *cc;
-	    for (cc = CC_LIST; cc != NULL; cc = cc->link) {
-		fprintf(prof_file, "%d %d \"%s\" \"%s\"\n",
-			CC_UQ, cc->ccID, cc->label, cc->module);
-	    }
-	}
-    }
-    
-    if (RtsFlags.ProfFlags.doHeapProfile) {
-	/* Initialise the log file name */
-	hp_filename = arenaAlloc(prof_arena, strlen(prog_name) + 6);
-	sprintf(hp_filename, "%s.hp", prog_name);
-	
-	/* open the log file */
-	if ((hp_file = fopen(hp_filename, "w")) == NULL) {
-	    debugBelch("Can't open profiling report file %s\n", 
-		    hp_filename);
-	    RtsFlags.ProfFlags.doHeapProfile = 0;
-	    return;
-	}
-    }
-}
-
-void
-initTimeProfiling(void)
-{
-  /* Start ticking */
-  startProfTimer();
-};
-
-void 
-endProfiling ( void )
-{
-  if (RtsFlags.CcFlags.doCostCentres) {
-    stopProfTimer();
-  }
-  if (RtsFlags.ProfFlags.doHeapProfile) {
-    endHeapProfiling();
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   Set cost centre stack when entering a function.
-   -------------------------------------------------------------------------- */
-rtsBool entering_PAP;
-
-void
-EnterFunCCS ( CostCentreStack *ccsfn )
-{
-  /* PAP_entry has already set CCCS for us */
-  if (entering_PAP) {
-    entering_PAP = rtsFalse;
-    return;
-  }
-
-  if (ccsfn->root->is_caf == CC_IS_CAF) {
-    CCCS = AppendCCS(CCCS,ccsfn);
-  } else {
-    CCCS = ccsfn;
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   Cost-centre stack manipulation
-   -------------------------------------------------------------------------- */
-
-#ifdef DEBUG
-CostCentreStack * _PushCostCentre ( CostCentreStack *ccs, CostCentre *cc );
-CostCentreStack *
-PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
-#define PushCostCentre _PushCostCentre
-{
-  IF_DEBUG(prof, 
-	   debugBelch("Pushing %s on ", cc->label);
-	   debugCCS(ccs);
-	   debugBelch("\n"));
-  return PushCostCentre(ccs,cc);
-}
-#endif
-
-CostCentreStack *
-PushCostCentre ( CostCentreStack *ccs, CostCentre *cc )
-{
-  CostCentreStack *temp_ccs;
-  
-  if (ccs == EMPTY_STACK)
-    return ActualPush(ccs,cc);
-  else {
-    if (ccs->cc == cc)
-      return ccs;
-    else {
-      /* check if we've already memoized this stack */
-      temp_ccs = IsInIndexTable(ccs->indexTable,cc);
-      
-      if (temp_ccs != EMPTY_STACK)
-	return temp_ccs;
-      else {
-	temp_ccs = CheckLoop(ccs,cc);
-	if (temp_ccs != NULL) {
-	  /* we have recursed to an older CCS.  Mark this in
-	   * the index table, and emit a "back edge" into the
-	   * log file.
-	   */
-	  ccs->indexTable = AddToIndexTable(ccs->indexTable,temp_ccs,cc,1);
-	  DecBackEdge(temp_ccs,ccs);
-	  return temp_ccs;
-	} else {
-	  return ActualPush(ccs,cc);
-	}
-      }
-    }
-  }
-}
-
-static CostCentreStack *
-CheckLoop ( CostCentreStack *ccs, CostCentre *cc )
-{
-  while (ccs != EMPTY_STACK) {
-    if (ccs->cc == cc)
-      return ccs;
-    ccs = ccs->prevStack;
-  }
-  return NULL;
-}
-
-/* Append ccs1 to ccs2 (ignoring any CAF cost centre at the root of ccs1 */
-
-#ifdef DEBUG
-CostCentreStack *_AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 );
-CostCentreStack *
-AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
-#define AppendCCS _AppendCCS
-{
-  IF_DEBUG(prof, 
-	   if (ccs1 != ccs2) {
-	     debugBelch("Appending ");
-	     debugCCS(ccs1);
-	     debugBelch(" to ");
-	     debugCCS(ccs2);
-	     debugBelch("\n");});
-  return AppendCCS(ccs1,ccs2);
-}
-#endif
-
-CostCentreStack *
-AppendCCS ( CostCentreStack *ccs1, CostCentreStack *ccs2 )
-{
-  CostCentreStack *ccs = NULL;
-
-  if (ccs1 == ccs2) {
-    return ccs1;
-  }
-
-  if (ccs2->cc->is_caf == CC_IS_CAF) {
-    return ccs1;
-  }
-  
-  if (ccs2->prevStack != NULL) {
-    ccs = AppendCCS(ccs1, ccs2->prevStack);
-  }
-
-  return PushCostCentre(ccs,ccs2->cc);
-}
-
-static CostCentreStack *
-ActualPush ( CostCentreStack *ccs, CostCentre *cc )
-{
-  CostCentreStack *new_ccs;
-  
-  /* allocate space for a new CostCentreStack */
-  new_ccs = (CostCentreStack *) arenaAlloc(prof_arena, sizeof(CostCentreStack));
-  
-  return ActualPush_(ccs, cc, new_ccs);
-}
-
-static CostCentreStack *
-ActualPush_ ( CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs )
-{
-  /* assign values to each member of the structure */
-  new_ccs->ccsID = CCS_ID++;
-  new_ccs->cc = cc;
-  new_ccs->prevStack = ccs;
-  
-  new_ccs->indexTable = EMPTY_TABLE;
-  
-  /* Initialise the various _scc_ counters to zero
-   */
-  new_ccs->scc_count        = 0;
-  
-  /* Initialize all other stats here.  There should be a quick way
-   * that's easily used elsewhere too 
-   */
-  new_ccs->time_ticks = 0;
-  new_ccs->mem_alloc = 0;
-  new_ccs->inherited_ticks = 0;
-  new_ccs->inherited_alloc = 0;
-  
-  new_ccs->root = ccs->root;
-
-  // Set the selected field.
-  ccsSetSelected(new_ccs);
-
-  /* update the memoization table for the parent stack */
-  if (ccs != EMPTY_STACK)
-    ccs->indexTable = AddToIndexTable(ccs->indexTable, new_ccs, cc, 
-				      0/*not a back edge*/);
-  
-  /* make sure this CC is declared at the next heap/time sample */
-  DecCCS(new_ccs);
-  
-  /* return a pointer to the new stack */
-  return new_ccs;
-}
-
-
-static CostCentreStack *
-IsInIndexTable(IndexTable *it, CostCentre *cc)
-{
-  while (it!=EMPTY_TABLE)
-    {
-      if (it->cc==cc)
-	return it->ccs;
-      else
-	it = it->next;
-    }
-  
-  /* otherwise we never found it so return EMPTY_TABLE */
-  return EMPTY_TABLE;
-}
-
-
-static IndexTable *
-AddToIndexTable(IndexTable *it, CostCentreStack *new_ccs, 
-		CostCentre *cc, unsigned int back_edge)
-{
-  IndexTable *new_it;
-  
-  new_it = arenaAlloc(prof_arena, sizeof(IndexTable));
-  
-  new_it->cc = cc;
-  new_it->ccs = new_ccs;
-  new_it->next = it;
-  new_it->back_edge = back_edge;
-  return new_it;
-}
-
-
-static void
-DecCCS(CostCentreStack *ccs)
-{
-  if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
-    if (ccs->prevStack == EMPTY_STACK)
-      fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ, 
-	      ccs->ccsID, ccs->cc->ccID);
-    else
-      fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ, 
-	      ccs->ccsID, ccs->cc->ccID, ccs->prevStack->ccsID);
-  }
-}
-
-static void
-DecBackEdge( CostCentreStack *ccs, CostCentreStack *oldccs )
-{
-  if (prof_file && RtsFlags.CcFlags.doCostCentres == COST_CENTRES_XML) {
-    if (ccs->prevStack == EMPTY_STACK)
-      fprintf(prof_file, "%d %d 1 %d\n", CCS_UQ, 
-	      ccs->ccsID, ccs->cc->ccID);
-    else
-      fprintf(prof_file, "%d %d 2 %d %d\n", CCS_UQ, 
-	      ccs->ccsID, ccs->cc->ccID, oldccs->ccsID);
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   Generating a time & allocation profiling report.
-   -------------------------------------------------------------------------- */
-
-/* We omit certain system-related CCs and CCSs from the default
- * reports, so as not to cause confusion.
- */
-static rtsBool
-cc_to_ignore (CostCentre *cc)
-{
-    if (    cc == CC_OVERHEAD 
-	 || cc == CC_DONT_CARE
-	 || cc == CC_GC 
-	 || cc == CC_SYSTEM) {
-	return rtsTrue;
-    } else {
-	return rtsFalse;
-    }
-}
-
-static rtsBool
-ccs_to_ignore (CostCentreStack *ccs)
-{
-    if (    ccs == CCS_OVERHEAD 
-	 || ccs == CCS_DONT_CARE
-	 || ccs == CCS_GC 
-	 || ccs == CCS_SYSTEM) {
-	return rtsTrue;
-    } else {
-	return rtsFalse;
-    }
-}
-
-/* -----------------------------------------------------------------------------
-   Generating the aggregated per-cost-centre time/alloc report.
-   -------------------------------------------------------------------------- */
-
-static CostCentre *sorted_cc_list;
-
-static void
-aggregate_cc_costs( CostCentreStack *ccs )
-{
-  IndexTable *i;
-
-  ccs->cc->mem_alloc += ccs->mem_alloc;
-  ccs->cc->time_ticks += ccs->time_ticks;
-
-  for (i = ccs->indexTable; i != 0; i = i->next) {
-    if (!i->back_edge) {
-      aggregate_cc_costs(i->ccs);
-    }
-  }
-}
-
-static void
-insert_cc_in_sorted_list( CostCentre *new_cc )
-{
-  CostCentre **prev, *cc;
-
-  prev = &sorted_cc_list;
-  for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
-    if (new_cc->time_ticks > cc->time_ticks) {
-      new_cc->link = cc;
-      *prev = new_cc;
-      return;
-    } else {
-      prev = &(cc->link);
-    }
-  }
-  new_cc->link = NULL;
-  *prev = new_cc;
-}
-
-static void
-report_per_cc_costs( void )
-{
-  CostCentre *cc, *next;
-
-  aggregate_cc_costs(CCS_MAIN);
-  sorted_cc_list = NULL;
-
-  for (cc = CC_LIST; cc != NULL; cc = next) {
-    next = cc->link;
-    if (cc->time_ticks > total_prof_ticks/100
-	|| cc->mem_alloc > total_alloc/100
-	|| RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL) {
-      insert_cc_in_sorted_list(cc);
-    }
-  }
-  
-  fprintf(prof_file, "%-30s %-20s", "COST CENTRE", "MODULE");  
-  fprintf(prof_file, "%6s %6s", "%time", "%alloc");
-  if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
-    fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
-  }
-  fprintf(prof_file, "\n\n");
-
-  for (cc = sorted_cc_list; cc != NULL; cc = cc->link) {
-      if (cc_to_ignore(cc)) {
-	  continue;
-      }
-      fprintf(prof_file, "%-30s %-20s", cc->label, cc->module);
-      fprintf(prof_file, "%6.1f %6.1f",
-	      total_prof_ticks == 0 ? 0.0 : (cc->time_ticks / (StgFloat) total_prof_ticks * 100),
-	      total_alloc == 0 ? 0.0 : (cc->mem_alloc / (StgFloat)
-					total_alloc * 100)
-	  );
-      
-      if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
-	fprintf(prof_file, "  %5llu %9llu", (StgWord64)(cc->time_ticks), cc->mem_alloc);
-      }
-      fprintf(prof_file, "\n");
-  }
-
-  fprintf(prof_file,"\n\n");
-}
-
-/* -----------------------------------------------------------------------------
-   Generate the cost-centre-stack time/alloc report
-   -------------------------------------------------------------------------- */
-
-static void 
-fprint_header( void )
-{
-  fprintf(prof_file, "%-24s %-10s                                                            individual    inherited\n", "", "");
-
-  fprintf(prof_file, "%-24s %-50s", "COST CENTRE", "MODULE");  
-  fprintf(prof_file, "%6s %10s  %5s %5s   %5s %5s", "no.", "entries", "%time", "%alloc", "%time", "%alloc");
-
-  if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
-    fprintf(prof_file, "  %5s %9s", "ticks", "bytes");
-#if defined(PROFILING_DETAIL_COUNTS)
-    fprintf(prof_file, "  %8s %8s %8s %8s %8s %8s %8s",
-	    "closures", "thunks", "funcs", "PAPs", "subfuns", "subcafs", "cafssub");
-#endif
-  }
-
-  fprintf(prof_file, "\n\n");
-}
-
-void
-reportCCSProfiling( void )
-{
-    nat count;
-    char temp[128]; /* sigh: magic constant */
-
-    stopProfTimer();
-
-    total_prof_ticks = 0;
-    total_alloc = 0;
-    count_ticks(CCS_MAIN);
-    
-    switch (RtsFlags.CcFlags.doCostCentres) {
-    case 0:
-      return;
-    case COST_CENTRES_XML:
-      gen_XML_logfile();
-      return;
-    default:
-      break;
-    }
-
-    fprintf(prof_file, "\t%s Time and Allocation Profiling Report  (%s)\n", 
-	    time_str(), "Final");
-
-    fprintf(prof_file, "\n\t  ");
-    fprintf(prof_file, " %s", prog_name);
-    fprintf(prof_file, " +RTS");
-    for (count = 0; rts_argv[count]; count++)
-	fprintf(prof_file, " %s", rts_argv[count]);
-    fprintf(prof_file, " -RTS");
-    for (count = 1; prog_argv[count]; count++)
-	fprintf(prof_file, " %s", prog_argv[count]);
-    fprintf(prof_file, "\n\n");
-
-    fprintf(prof_file, "\ttotal time  = %11.2f secs   (%lu ticks @ %d ms)\n",
-	    total_prof_ticks / (StgFloat) TICK_FREQUENCY, 
-	    total_prof_ticks, TICK_MILLISECS);
-
-    fprintf(prof_file, "\ttotal alloc = %11s bytes",
-	    ullong_format_string(total_alloc * sizeof(W_),
-				 temp, rtsTrue/*commas*/));
-
-#if defined(PROFILING_DETAIL_COUNTS)
-    fprintf(prof_file, "  (%lu closures)", total_allocs);
-#endif
-    fprintf(prof_file, "  (excludes profiling overheads)\n\n");
-
-    report_per_cc_costs();
-
-    inherit_costs(CCS_MAIN);
-
-    fprint_header();
-    reportCCS(pruneCCSTree(CCS_MAIN), 0);
-}
-
-static void 
-reportCCS(CostCentreStack *ccs, nat indent)
-{
-  CostCentre *cc;
-  IndexTable *i;
-
-  cc = ccs->cc;
-  
-  /* Only print cost centres with non 0 data ! */
-  
-  if ( RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL ||
-       ! ccs_to_ignore(ccs))
-	/* force printing of *all* cost centres if -P -P */ 
-    {
-
-    fprintf(prof_file, "%-*s%-*s %-50s", 
-	    indent, "", 24-indent, cc->label, cc->module);
-
-    fprintf(prof_file, "%6d %11.0f %5.1f  %5.1f   %5.1f  %5.1f",
-	    ccs->ccsID, (double) ccs->scc_count, 
-	    total_prof_ticks == 0 ? 0.0 : ((double)ccs->time_ticks / (double)total_prof_ticks * 100.0),
-	    total_alloc == 0 ? 0.0 : ((double)ccs->mem_alloc / (double)total_alloc * 100.0),
-	    total_prof_ticks == 0 ? 0.0 : ((double)ccs->inherited_ticks / (double)total_prof_ticks * 100.0),
-	    total_alloc == 0 ? 0.0 : ((double)ccs->inherited_alloc / (double)total_alloc * 100.0)
-	    );
-
-    if (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_VERBOSE) {
-      fprintf(prof_file, "  %5llu %9llu", (StgWord64)(ccs->time_ticks), ccs->mem_alloc*sizeof(W_));
-#if defined(PROFILING_DETAIL_COUNTS)
-      fprintf(prof_file, "  %8ld %8ld %8ld %8ld %8ld %8ld %8ld",
-	      ccs->mem_allocs, ccs->thunk_count,
-	      ccs->function_count, ccs->pap_count,
-	      ccs->subsumed_fun_count,	ccs->subsumed_caf_count,
-	      ccs->caffun_subsumed);
-#endif
-    }
-    fprintf(prof_file, "\n");
-  }
-
-  for (i = ccs->indexTable; i != 0; i = i->next) {
-    if (!i->back_edge) {
-      reportCCS(i->ccs, indent+1);
-    }
-  }
-}
-
-
-/* Traverse the cost centre stack tree and accumulate
- * ticks/allocations.
- */
-static void
-count_ticks(CostCentreStack *ccs)
-{
-  IndexTable *i;
-  
-  if (!ccs_to_ignore(ccs)) {
-    total_alloc += ccs->mem_alloc;
-    total_prof_ticks += ccs->time_ticks;
-  }
-  for (i = ccs->indexTable; i != NULL; i = i->next)
-    if (!i->back_edge) {
-      count_ticks(i->ccs);
-    }
-}
-
-/* Traverse the cost centre stack tree and inherit ticks & allocs.
- */
-static void
-inherit_costs(CostCentreStack *ccs)
-{
-  IndexTable *i;
-
-  if (ccs_to_ignore(ccs)) { return; }
-
-  ccs->inherited_ticks += ccs->time_ticks;
-  ccs->inherited_alloc += ccs->mem_alloc;
-
-  for (i = ccs->indexTable; i != NULL; i = i->next)
-      if (!i->back_edge) {
-	  inherit_costs(i->ccs);
-	  ccs->inherited_ticks += i->ccs->inherited_ticks;
-	  ccs->inherited_alloc += i->ccs->inherited_alloc;
-      }
-  
-  return;
-}
-
-static CostCentreStack *
-pruneCCSTree( CostCentreStack *ccs )
-{
-  CostCentreStack *ccs1;
-  IndexTable *i, **prev;
-  
-  prev = &ccs->indexTable;
-  for (i = ccs->indexTable; i != 0; i = i->next) {
-    if (i->back_edge) { continue; }
-
-    ccs1 = pruneCCSTree(i->ccs);
-    if (ccs1 == NULL) {
-      *prev = i->next;
-    } else {
-      prev = &(i->next);
-    }
-  }
-
-  if ( (RtsFlags.CcFlags.doCostCentres >= COST_CENTRES_ALL
-	/* force printing of *all* cost centres if -P -P */ )
-       
-       || ( ccs->indexTable != 0 )
-       || ( ccs->scc_count || ccs->time_ticks || ccs->mem_alloc )
-      ) {
-      return ccs;
-  } else {
-      return NULL;
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   Generate the XML time/allocation profile
-   -------------------------------------------------------------------------- */
-
-void
-gen_XML_logfile( void )
-{
-  fprintf(prof_file, "%d %lu", TIME_UPD_UQ, total_prof_ticks);
-
-  reportCCS_XML(pruneCCSTree(CCS_MAIN));
-
-  fprintf(prof_file, " 0\n");
-
-  fclose(prof_file);
-}
-
-static void 
-reportCCS_XML(CostCentreStack *ccs)
-{
-  CostCentre *cc;
-  IndexTable *i;
-
-  if (ccs_to_ignore(ccs)) { return; }
-
-  cc = ccs->cc;
-  
-  fprintf(prof_file, " 1 %d %llu %llu %llu", 
-	  ccs->ccsID, ccs->scc_count, (StgWord64)(ccs->time_ticks), ccs->mem_alloc);
-
-  for (i = ccs->indexTable; i != 0; i = i->next) {
-    if (!i->back_edge) {
-      reportCCS_XML(i->ccs);
-    }
-  }
-}
-
-void
-fprintCCS( FILE *f, CostCentreStack *ccs )
-{
-  fprintf(f,"<");
-  for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
-      fprintf(f,"%s.%s", ccs->cc->module, ccs->cc->label);
-      if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
-	  fprintf(f,",");
-      }
-  }
-  fprintf(f,">");
-}
-
-/* For calling from .cmm code, where we can't reliably refer to stderr */
-void
-fprintCCS_stderr( CostCentreStack *ccs )
-{
-    fprintCCS(stderr, ccs);
-}
-
-#ifdef DEBUG
-void
-debugCCS( CostCentreStack *ccs )
-{
-  debugBelch("<");
-  for (; ccs && ccs != CCS_MAIN; ccs = ccs->prevStack ) {
-      debugBelch("%s.%s", ccs->cc->module, ccs->cc->label);
-      if (ccs->prevStack && ccs->prevStack != CCS_MAIN) {
-	  debugBelch(",");
-      }
-  }
-  debugBelch(">");
-}
-#endif /* DEBUG */
-
-#endif /* PROFILING */
diff --git a/ghc/rts/Profiling.h b/ghc/rts/Profiling.h
deleted file mode 100644
index d968349a52..0000000000
--- a/ghc/rts/Profiling.h
+++ /dev/null
@@ -1,39 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Support for profiling
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef PROFILING_H
-#define PROFILING_H
-
-#include <stdio.h>
-
-#if defined(PROFILING) || defined(DEBUG)
-void initProfiling1 ( void );
-void initProfiling2 ( void );
-void endProfiling   ( void );
-
-extern FILE *prof_file;
-extern FILE *hp_file;
-#endif
-
-#ifdef PROFILING
-
-void gen_XML_logfile     ( void );
-void reportCCSProfiling ( void );
-
-void PrintNewStackDecls ( void );
-
-extern void fprintCCS( FILE *f, CostCentreStack *ccs );
-extern void fprintCCS_stderr( CostCentreStack *ccs );
-
-#ifdef DEBUG
-extern void debugCCS( CostCentreStack *ccs );
-#endif
-
-#endif
-
-#endif /* PROFILING_H */
diff --git a/ghc/rts/Proftimer.c b/ghc/rts/Proftimer.c
deleted file mode 100644
index 3b499152d6..0000000000
--- a/ghc/rts/Proftimer.c
+++ /dev/null
@@ -1,85 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-1999
- *
- * Profiling interval timer
- *
- * ---------------------------------------------------------------------------*/
-
-#if defined (PROFILING)
-
-#include "PosixSource.h"
-
-#include "Rts.h"
-#include "Profiling.h"
-#include "Timer.h"
-#include "Proftimer.h"
-#include "RtsFlags.h"
-
-static rtsBool do_prof_ticks = rtsFalse;       // enable profiling ticks
-static rtsBool do_heap_prof_ticks = rtsFalse;  // enable heap profiling ticks
-
-// Number of ticks until next heap census
-static int ticks_to_heap_profile;
-
-// Time for a heap profile on the next context switch
-rtsBool performHeapProfile;
-
-void
-stopProfTimer( void )
-{
-    do_prof_ticks = rtsFalse;
-}
-
-void
-startProfTimer( void )
-{
-    do_prof_ticks = rtsTrue;
-}
-
-void
-stopHeapProfTimer( void )
-{
-    do_heap_prof_ticks = rtsFalse;
-}
-
-void
-startHeapProfTimer( void )
-{
-    if (RtsFlags.ProfFlags.doHeapProfile && 
-	RtsFlags.ProfFlags.profileIntervalTicks > 0) {
-	do_heap_prof_ticks = rtsTrue;
-    }
-}
-
-void
-initProfTimer( void )
-{
-    performHeapProfile = rtsFalse;
-
-    RtsFlags.ProfFlags.profileIntervalTicks = 
-	RtsFlags.ProfFlags.profileInterval / TICK_MILLISECS;
-
-    ticks_to_heap_profile = RtsFlags.ProfFlags.profileIntervalTicks;
-
-    startHeapProfTimer();
-}
-
-
-void
-handleProfTick(void)
-{
-    if (do_prof_ticks) {
-	CCCS->time_ticks++;
-    }
-
-    if (do_heap_prof_ticks) {
-	ticks_to_heap_profile--;
-	if (ticks_to_heap_profile <= 0) {
-	    ticks_to_heap_profile = RtsFlags.ProfFlags.profileIntervalTicks;
-	    performHeapProfile = rtsTrue;
-	}
-    }
-}
-
-#endif /* PROFILING */
diff --git a/ghc/rts/Proftimer.h b/ghc/rts/Proftimer.h
deleted file mode 100644
index c837b855f9..0000000000
--- a/ghc/rts/Proftimer.h
+++ /dev/null
@@ -1,22 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Profiling interval timer
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef PROFTIMER_H
-#define PROFTIMER_H
-
-extern void initProfTimer      ( void );
-extern void handleProfTick     ( void );
-
-extern void stopProfTimer      ( void );
-extern void startProfTimer     ( void );
-extern void stopHeapProfTimer  ( void );
-extern void startHeapProfTimer ( void );
-
-extern rtsBool performHeapProfile;
-
-#endif /* PROFTIMER_H */
diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c
deleted file mode 100644
index c5c3de5314..0000000000
--- a/ghc/rts/RetainerProfile.c
+++ /dev/null
@@ -1,2338 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2001
- * Author: Sungwoo Park
- *
- * Retainer profiling.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifdef PROFILING
-
-// Turn off inlining when debugging - it obfuscates things
-#ifdef DEBUG
-#define INLINE
-#else
-#define INLINE inline
-#endif
-
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "RetainerProfile.h"
-#include "RetainerSet.h"
-#include "Schedule.h"
-#include "Printer.h"
-#include "Storage.h"
-#include "RtsFlags.h"
-#include "Weak.h"
-#include "Sanity.h"
-#include "Profiling.h"
-#include "Stats.h"
-#include "BlockAlloc.h"
-#include "ProfHeap.h"
-#include "Apply.h"
-
-/*
-  Note: what to change in order to plug-in a new retainer profiling scheme?
-    (1) type retainer in ../includes/StgRetainerProf.h
-    (2) retainer function R(), i.e., getRetainerFrom()
-    (3) the two hashing functions, hashKeySingleton() and hashKeyAddElement(),
-        in RetainerSet.h, if needed.
-    (4) printRetainer() and printRetainerSetShort() in RetainerSet.c.
- */
-
-/* -----------------------------------------------------------------------------
- * Declarations...
- * -------------------------------------------------------------------------- */
-
-static nat retainerGeneration;	// generation
-
-static nat numObjectVisited;	// total number of objects visited
-static nat timesAnyObjectVisited; // number of times any objects are visited
-
-/*
-  The rs field in the profile header of any object points to its retainer
-  set in an indirect way: if flip is 0, it points to the retainer set;
-  if flip is 1, it points to the next byte after the retainer set (even
-  for NULL pointers). Therefore, with flip 1, (rs ^ 1) is the actual
-  pointer. See retainerSetOf().
- */
-
-StgWord flip = 0;     // flip bit
-                      // must be 0 if DEBUG_RETAINER is on (for static closures)
-
-#define setRetainerSetToNull(c)   \
-  (c)->header.prof.hp.rs = (RetainerSet *)((StgWord)NULL | flip)
-
-static void retainStack(StgClosure *, retainer, StgPtr, StgPtr);
-static void retainClosure(StgClosure *, StgClosure *, retainer);
-#ifdef DEBUG_RETAINER
-static void belongToHeap(StgPtr p);
-#endif
-
-#ifdef DEBUG_RETAINER
-/*
-  cStackSize records how many times retainStack() has been invoked recursively,
-  that is, the number of activation records for retainStack() on the C stack.
-  maxCStackSize records its max value.
-  Invariants:
-    cStackSize <= maxCStackSize
- */
-static nat cStackSize, maxCStackSize;
-
-static nat sumOfNewCost;	// sum of the cost of each object, computed
-				// when the object is first visited
-static nat sumOfNewCostExtra;   // for those objects not visited during
-                                // retainer profiling, e.g., MUT_VAR
-static nat costArray[N_CLOSURE_TYPES];
-
-nat sumOfCostLinear;		// sum of the costs of all object, computed
-				// when linearly traversing the heap after
-				// retainer profiling
-nat costArrayLinear[N_CLOSURE_TYPES];
-#endif
-
-/* -----------------------------------------------------------------------------
- * Retainer stack - header
- *   Note:
- *     Although the retainer stack implementation could be separated *
- *     from the retainer profiling engine, there does not seem to be
- *     any advantage in doing that; retainer stack is an integral part
- *     of retainer profiling engine and cannot be use elsewhere at
- *     all.
- * -------------------------------------------------------------------------- */
-
-typedef enum {
-    posTypeStep,
-    posTypePtrs,
-    posTypeSRT,
-    posTypeLargeSRT,
-} nextPosType;
-
-typedef union {
-    // fixed layout or layout specified by a field in the closure
-    StgWord step;
-
-    // layout.payload
-    struct {
-    // See StgClosureInfo in InfoTables.h
-#if SIZEOF_VOID_P == 8
-	StgWord32 pos;
-	StgWord32 ptrs;
-#else
-	StgWord16 pos;
-	StgWord16 ptrs;
-#endif
-	StgPtr payload;
-    } ptrs;
-
-    // SRT
-    struct {
-	StgClosure **srt;
-	StgWord    srt_bitmap;
-    } srt;
-
-    // Large SRT
-    struct {
-	StgLargeSRT *srt;
-	StgWord offset;
-    } large_srt;
-	
-} nextPos;
-
-typedef struct {
-    nextPosType type;
-    nextPos next;
-} stackPos;
-
-typedef struct {
-    StgClosure *c;
-    retainer c_child_r;
-    stackPos info;
-} stackElement;
-
-/*
-  Invariants:
-    firstStack points to the first block group.
-    currentStack points to the block group currently being used.
-    currentStack->free == stackLimit.
-    stackTop points to the topmost byte in the stack of currentStack.
-    Unless the whole stack is empty, stackTop must point to the topmost
-    object (or byte) in the whole stack. Thus, it is only when the whole stack
-    is empty that stackTop == stackLimit (not during the execution of push()
-    and pop()).
-    stackBottom == currentStack->start.
-    stackLimit == currentStack->start + BLOCK_SIZE_W * currentStack->blocks.
-  Note:
-    When a current stack becomes empty, stackTop is set to point to
-    the topmost element on the previous block group so as to satisfy
-    the invariants described above.
- */
-static bdescr *firstStack = NULL;
-static bdescr *currentStack;
-static stackElement *stackBottom, *stackTop, *stackLimit;
-
-/*
-  currentStackBoundary is used to mark the current stack chunk.
-  If stackTop == currentStackBoundary, it means that the current stack chunk
-  is empty. It is the responsibility of the user to keep currentStackBoundary
-  valid all the time if it is to be employed.
- */
-static stackElement *currentStackBoundary;
-
-/*
-  stackSize records the current size of the stack.
-  maxStackSize records its high water mark.
-  Invariants:
-    stackSize <= maxStackSize
-  Note:
-    stackSize is just an estimate measure of the depth of the graph. The reason
-    is that some heap objects have only a single child and may not result
-    in a new element being pushed onto the stack. Therefore, at the end of
-    retainer profiling, maxStackSize + maxCStackSize is some value no greater
-    than the actual depth of the graph.
- */
-#ifdef DEBUG_RETAINER
-static int stackSize, maxStackSize;
-#endif
-
-// number of blocks allocated for one stack
-#define BLOCKS_IN_STACK 1
-
-/* -----------------------------------------------------------------------------
- * Add a new block group to the stack.
- * Invariants:
- *  currentStack->link == s.
- * -------------------------------------------------------------------------- */
-static INLINE void
-newStackBlock( bdescr *bd )
-{
-    currentStack = bd;
-    stackTop     = (stackElement *)(bd->start + BLOCK_SIZE_W * bd->blocks);
-    stackBottom  = (stackElement *)bd->start;
-    stackLimit   = (stackElement *)stackTop;
-    bd->free     = (StgPtr)stackLimit;
-}
-
-/* -----------------------------------------------------------------------------
- * Return to the previous block group.
- * Invariants:
- *   s->link == currentStack.
- * -------------------------------------------------------------------------- */
-static INLINE void
-returnToOldStack( bdescr *bd )
-{
-    currentStack = bd;
-    stackTop = (stackElement *)bd->free;
-    stackBottom = (stackElement *)bd->start;
-    stackLimit = (stackElement *)(bd->start + BLOCK_SIZE_W * bd->blocks);
-    bd->free = (StgPtr)stackLimit;
-}
-
-/* -----------------------------------------------------------------------------
- *  Initializes the traverse stack.
- * -------------------------------------------------------------------------- */
-static void
-initializeTraverseStack( void )
-{
-    if (firstStack != NULL) {
-	freeChain(firstStack);
-    }
-
-    firstStack = allocGroup(BLOCKS_IN_STACK);
-    firstStack->link = NULL;
-    firstStack->u.back = NULL;
-
-    newStackBlock(firstStack);
-}
-
-/* -----------------------------------------------------------------------------
- * Frees all the block groups in the traverse stack.
- * Invariants:
- *   firstStack != NULL
- * -------------------------------------------------------------------------- */
-static void
-closeTraverseStack( void )
-{
-    freeChain(firstStack);
-    firstStack = NULL;
-}
-
-/* -----------------------------------------------------------------------------
- * Returns rtsTrue if the whole stack is empty.
- * -------------------------------------------------------------------------- */
-static INLINE rtsBool
-isEmptyRetainerStack( void )
-{
-    return (firstStack == currentStack) && stackTop == stackLimit;
-}
-
-/* -----------------------------------------------------------------------------
- * Returns size of stack
- * -------------------------------------------------------------------------- */
-#ifdef DEBUG
-lnat
-retainerStackBlocks( void )
-{
-    bdescr* bd;
-    lnat res = 0;
-
-    for (bd = firstStack; bd != NULL; bd = bd->link) 
-      res += bd->blocks;
-
-    return res;
-}
-#endif
-
-/* -----------------------------------------------------------------------------
- * Returns rtsTrue if stackTop is at the stack boundary of the current stack,
- * i.e., if the current stack chunk is empty.
- * -------------------------------------------------------------------------- */
-static INLINE rtsBool
-isOnBoundary( void )
-{
-    return stackTop == currentStackBoundary;
-}
-
-/* -----------------------------------------------------------------------------
- * Initializes *info from ptrs and payload.
- * Invariants:
- *   payload[] begins with ptrs pointers followed by non-pointers.
- * -------------------------------------------------------------------------- */
-static INLINE void
-init_ptrs( stackPos *info, nat ptrs, StgPtr payload )
-{
-    info->type              = posTypePtrs;
-    info->next.ptrs.pos     = 0;
-    info->next.ptrs.ptrs    = ptrs;
-    info->next.ptrs.payload = payload;
-}
-
-/* -----------------------------------------------------------------------------
- * Find the next object from *info.
- * -------------------------------------------------------------------------- */
-static INLINE StgClosure *
-find_ptrs( stackPos *info )
-{
-    if (info->next.ptrs.pos < info->next.ptrs.ptrs) {
-	return (StgClosure *)info->next.ptrs.payload[info->next.ptrs.pos++];
-    } else {
-	return NULL;
-    }
-}
-
-/* -----------------------------------------------------------------------------
- *  Initializes *info from SRT information stored in *infoTable.
- * -------------------------------------------------------------------------- */
-static INLINE void
-init_srt_fun( stackPos *info, StgFunInfoTable *infoTable )
-{
-    if (infoTable->i.srt_bitmap == (StgHalfWord)(-1)) {
-	info->type = posTypeLargeSRT;
-	info->next.large_srt.srt = (StgLargeSRT *)GET_FUN_SRT(infoTable);
-	info->next.large_srt.offset = 0;
-    } else {
-	info->type = posTypeSRT;
-	info->next.srt.srt = (StgClosure **)GET_FUN_SRT(infoTable);
-	info->next.srt.srt_bitmap = infoTable->i.srt_bitmap;
-    }
-}
-
-static INLINE void
-init_srt_thunk( stackPos *info, StgThunkInfoTable *infoTable )
-{
-    if (infoTable->i.srt_bitmap == (StgHalfWord)(-1)) {
-	info->type = posTypeLargeSRT;
-	info->next.large_srt.srt = (StgLargeSRT *)GET_SRT(infoTable);
-	info->next.large_srt.offset = 0;
-    } else {
-	info->type = posTypeSRT;
-	info->next.srt.srt = (StgClosure **)GET_SRT(infoTable);
-	info->next.srt.srt_bitmap = infoTable->i.srt_bitmap;
-    }
-}
-
-/* -----------------------------------------------------------------------------
- * Find the next object from *info.
- * -------------------------------------------------------------------------- */
-static INLINE StgClosure *
-find_srt( stackPos *info )
-{
-    StgClosure *c;
-    StgWord bitmap;
-
-    if (info->type == posTypeSRT) {
-	// Small SRT bitmap
-	bitmap = info->next.srt.srt_bitmap;
-	while (bitmap != 0) {
-	    if ((bitmap & 1) != 0) {
-#ifdef ENABLE_WIN32_DLL_SUPPORT
-		
-		if ((unsigned long)(*(info->next.srt.srt)) & 0x1)
-		    c = (* (StgClosure **)((unsigned long)*(info->next.srt.srt)) & ~0x1);
-		else
-		    c = *(info->next.srt.srt);
-#else
-		c = *(info->next.srt.srt);
-#endif
-		bitmap = bitmap >> 1;
-		info->next.srt.srt++;
-		info->next.srt.srt_bitmap = bitmap;
-		return c;
-	    }
-	    bitmap = bitmap >> 1;
-	    info->next.srt.srt++;
-	}
-	// bitmap is now zero...
-	return NULL;
-    }
-    else {
-	// Large SRT bitmap
-	nat i = info->next.large_srt.offset;
-	StgWord bitmap;
-
-	// Follow the pattern from GC.c:scavenge_large_srt_bitmap().
-	bitmap = info->next.large_srt.srt->l.bitmap[i / BITS_IN(W_)];
-	bitmap = bitmap >> (i % BITS_IN(StgWord));
-	while (i < info->next.large_srt.srt->l.size) {
-	    if ((bitmap & 1) != 0) {
-		c = ((StgClosure **)info->next.large_srt.srt->srt)[i];
-		i++;
-		info->next.large_srt.offset = i;
-		return c;
-	    }
-	    i++;
-	    if (i % BITS_IN(W_) == 0) {
-		bitmap = info->next.large_srt.srt->l.bitmap[i / BITS_IN(W_)];
-	    } else {
-		bitmap = bitmap >> 1;
-	    }
-	}
-	// reached the end of this bitmap.
-	info->next.large_srt.offset = i;
-	return NULL;
-    }
-}
-
-/* -----------------------------------------------------------------------------
- *  push() pushes a stackElement representing the next child of *c
- *  onto the traverse stack. If *c has no child, *first_child is set
- *  to NULL and nothing is pushed onto the stack. If *c has only one
- *  child, *c_chlid is set to that child and nothing is pushed onto
- *  the stack.  If *c has more than two children, *first_child is set
- *  to the first child and a stackElement representing the second
- *  child is pushed onto the stack.
-
- *  Invariants:
- *     *c_child_r is the most recent retainer of *c's children.
- *     *c is not any of TSO, AP, PAP, AP_STACK, which means that
- *        there cannot be any stack objects.
- *  Note: SRTs are considered to  be children as well.
- * -------------------------------------------------------------------------- */
-static INLINE void
-push( StgClosure *c, retainer c_child_r, StgClosure **first_child )
-{
-    stackElement se;
-    bdescr *nbd;      // Next Block Descriptor
-
-#ifdef DEBUG_RETAINER
-    // debugBelch("push(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
-#endif
-
-    ASSERT(get_itbl(c)->type != TSO);
-    ASSERT(get_itbl(c)->type != AP_STACK);
-
-    //
-    // fill in se
-    //
-
-    se.c = c;
-    se.c_child_r = c_child_r;
-
-    // fill in se.info
-    switch (get_itbl(c)->type) {
-	// no child, no SRT
-    case CONSTR_0_1:
-    case CONSTR_0_2:
-    case CAF_BLACKHOLE:
-    case BLACKHOLE:
-    case SE_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-    case ARR_WORDS:
-	*first_child = NULL;
-	return;
-
-	// one child (fixed), no SRT
-    case MUT_VAR_CLEAN:
-    case MUT_VAR_DIRTY:
-	*first_child = ((StgMutVar *)c)->var;
-	return;
-    case THUNK_SELECTOR:
-	*first_child = ((StgSelector *)c)->selectee;
-	return;
-    case IND_PERM:
-    case IND_OLDGEN_PERM:
-    case IND_OLDGEN:
-	*first_child = ((StgInd *)c)->indirectee;
-	return;
-    case CONSTR_1_0:
-    case CONSTR_1_1:
-	*first_child = c->payload[0];
-	return;
-
-	// For CONSTR_2_0 and MVAR, we use se.info.step to record the position
-	// of the next child. We do not write a separate initialization code.
-	// Also we do not have to initialize info.type;
-
-	// two children (fixed), no SRT
-	// need to push a stackElement, but nothing to store in se.info
-    case CONSTR_2_0:
-	*first_child = c->payload[0];         // return the first pointer
-	// se.info.type = posTypeStep;
-	// se.info.next.step = 2;            // 2 = second
-	break;
-
-	// three children (fixed), no SRT
-	// need to push a stackElement
-    case MVAR:
-	// head must be TSO and the head of a linked list of TSOs.
-	// Shoule it be a child? Seems to be yes.
-	*first_child = (StgClosure *)((StgMVar *)c)->head;
-	// se.info.type = posTypeStep;
-	se.info.next.step = 2;            // 2 = second
-	break;
-
-	// three children (fixed), no SRT
-    case WEAK:
-	*first_child = ((StgWeak *)c)->key;
-	// se.info.type = posTypeStep;
-	se.info.next.step = 2;
-	break;
-
-	// layout.payload.ptrs, no SRT
-    case CONSTR:
-    case STABLE_NAME:
-    case BCO:
-    case CONSTR_STATIC:
-	init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs,
-		  (StgPtr)c->payload);
-	*first_child = find_ptrs(&se.info);
-	if (*first_child == NULL)
-	    return;   // no child
-	break;
-
-	// StgMutArrPtr.ptrs, no SRT
-    case MUT_ARR_PTRS_CLEAN:
-    case MUT_ARR_PTRS_DIRTY:
-    case MUT_ARR_PTRS_FROZEN:
-    case MUT_ARR_PTRS_FROZEN0:
-	init_ptrs(&se.info, ((StgMutArrPtrs *)c)->ptrs,
-		  (StgPtr)(((StgMutArrPtrs *)c)->payload));
-	*first_child = find_ptrs(&se.info);
-	if (*first_child == NULL)
-	    return;
-	break;
-
-    // layout.payload.ptrs, SRT
-    case FUN:           // *c is a heap object.
-    case FUN_2_0:
-	init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs, (StgPtr)c->payload);
-	*first_child = find_ptrs(&se.info);
-	if (*first_child == NULL)
-	    // no child from ptrs, so check SRT
-	    goto fun_srt_only;
-	break;
-
-    case THUNK:
-    case THUNK_2_0:
-	init_ptrs(&se.info, get_itbl(c)->layout.payload.ptrs, 
-		  (StgPtr)((StgThunk *)c)->payload);
-	*first_child = find_ptrs(&se.info);
-	if (*first_child == NULL)
-	    // no child from ptrs, so check SRT
-	    goto thunk_srt_only;
-	break;
-
-	// 1 fixed child, SRT
-    case FUN_1_0:
-    case FUN_1_1:
-	*first_child = c->payload[0];
-	ASSERT(*first_child != NULL);
-	init_srt_fun(&se.info, get_fun_itbl(c));
-	break;
-
-    case THUNK_1_0:
-    case THUNK_1_1:
-	*first_child = ((StgThunk *)c)->payload[0];
-	ASSERT(*first_child != NULL);
-	init_srt_thunk(&se.info, get_thunk_itbl(c));
-	break;
-
-    case FUN_STATIC:      // *c is a heap object.
-	ASSERT(get_itbl(c)->srt_bitmap != 0);
-    case FUN_0_1:
-    case FUN_0_2:
-    fun_srt_only:
-        init_srt_fun(&se.info, get_fun_itbl(c));
-	*first_child = find_srt(&se.info);
-	if (*first_child == NULL)
-	    return;     // no child
-	break;
-
-    // SRT only
-    case THUNK_STATIC:
-	ASSERT(get_itbl(c)->srt_bitmap != 0);
-    case THUNK_0_1:
-    case THUNK_0_2:
-    thunk_srt_only:
-        init_srt_thunk(&se.info, get_thunk_itbl(c));
-	*first_child = find_srt(&se.info);
-	if (*first_child == NULL)
-	    return;     // no child
-	break;
-	
-    case TVAR_WAIT_QUEUE:
-	*first_child = (StgClosure *)((StgTVarWaitQueue *)c)->waiting_tso;
-	se.info.next.step = 2;            // 2 = second
-	break;
-    case TVAR:
-	*first_child = (StgClosure *)((StgTVar *)c)->current_value;
-	break;
-    case TREC_HEADER:
-	*first_child = (StgClosure *)((StgTRecHeader *)c)->enclosing_trec;
-	break;
-    case TREC_CHUNK:
-	*first_child = (StgClosure *)((StgTRecChunk *)c)->prev_chunk;
-	se.info.next.step = 0;  // entry no.
-	break;
-
-	// cannot appear
-    case PAP:
-    case AP:
-    case AP_STACK:
-    case TSO:
-    case IND_STATIC:
-    case CONSTR_INTLIKE:
-    case CONSTR_CHARLIKE:
-    case CONSTR_NOCAF_STATIC:
-	// stack objects
-    case UPDATE_FRAME:
-    case CATCH_FRAME:
-    case STOP_FRAME:
-    case RET_DYN:
-    case RET_BCO:
-    case RET_SMALL:
-    case RET_VEC_SMALL:
-    case RET_BIG:
-    case RET_VEC_BIG:
-	// invalid objects
-    case IND:
-    case BLOCKED_FETCH:
-    case FETCH_ME:
-    case FETCH_ME_BQ:
-    case RBH:
-    case REMOTE_REF:
-    case EVACUATED:
-    case INVALID_OBJECT:
-    default:
-	barf("Invalid object *c in push()");
-	return;
-    }
-
-    if (stackTop - 1 < stackBottom) {
-#ifdef DEBUG_RETAINER
-	// debugBelch("push() to the next stack.\n");
-#endif
-	// currentStack->free is updated when the active stack is switched
-	// to the next stack.
-	currentStack->free = (StgPtr)stackTop;
-
-	if (currentStack->link == NULL) {
-	    nbd = allocGroup(BLOCKS_IN_STACK);
-	    nbd->link = NULL;
-	    nbd->u.back = currentStack;
-	    currentStack->link = nbd;
-	} else
-	    nbd = currentStack->link;
-
-	newStackBlock(nbd);
-    }
-
-    // adjust stackTop (acutal push)
-    stackTop--;
-    // If the size of stackElement was huge, we would better replace the
-    // following statement by either a memcpy() call or a switch statement
-    // on the type of the element. Currently, the size of stackElement is
-    // small enough (5 words) that this direct assignment seems to be enough.
-    *stackTop = se;
-
-#ifdef DEBUG_RETAINER
-    stackSize++;
-    if (stackSize > maxStackSize) maxStackSize = stackSize;
-    // ASSERT(stackSize >= 0);
-    // debugBelch("stackSize = %d\n", stackSize);
-#endif
-}
-
-/* -----------------------------------------------------------------------------
- *  popOff() and popOffReal(): Pop a stackElement off the traverse stack.
- *  Invariants:
- *    stackTop cannot be equal to stackLimit unless the whole stack is
- *    empty, in which case popOff() is not allowed.
- *  Note:
- *    You can think of popOffReal() as a part of popOff() which is
- *    executed at the end of popOff() in necessary. Since popOff() is
- *    likely to be executed quite often while popOffReal() is not, we
- *    separate popOffReal() from popOff(), which is declared as an
- *    INLINE function (for the sake of execution speed).  popOffReal()
- *    is called only within popOff() and nowhere else.
- * -------------------------------------------------------------------------- */
-static void
-popOffReal(void)
-{
-    bdescr *pbd;    // Previous Block Descriptor
-
-#ifdef DEBUG_RETAINER
-    // debugBelch("pop() to the previous stack.\n");
-#endif
-
-    ASSERT(stackTop + 1 == stackLimit);
-    ASSERT(stackBottom == (stackElement *)currentStack->start);
-
-    if (firstStack == currentStack) {
-	// The stack is completely empty.
-	stackTop++;
-	ASSERT(stackTop == stackLimit);
-#ifdef DEBUG_RETAINER
-	stackSize--;
-	if (stackSize > maxStackSize) maxStackSize = stackSize;
-	/*
-	  ASSERT(stackSize >= 0);
-	  debugBelch("stackSize = %d\n", stackSize);
-	*/
-#endif
-	return;
-    }
-
-    // currentStack->free is updated when the active stack is switched back
-    // to the previous stack.
-    currentStack->free = (StgPtr)stackLimit;
-
-    // find the previous block descriptor
-    pbd = currentStack->u.back;
-    ASSERT(pbd != NULL);
-
-    returnToOldStack(pbd);
-
-#ifdef DEBUG_RETAINER
-    stackSize--;
-    if (stackSize > maxStackSize) maxStackSize = stackSize;
-    /*
-      ASSERT(stackSize >= 0);
-      debugBelch("stackSize = %d\n", stackSize);
-    */
-#endif
-}
-
-static INLINE void
-popOff(void) {
-#ifdef DEBUG_RETAINER
-    // debugBelch("\tpopOff(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
-#endif
-
-    ASSERT(stackTop != stackLimit);
-    ASSERT(!isEmptyRetainerStack());
-
-    // <= (instead of <) is wrong!
-    if (stackTop + 1 < stackLimit) {
-	stackTop++;
-#ifdef DEBUG_RETAINER
-	stackSize--;
-	if (stackSize > maxStackSize) maxStackSize = stackSize;
-	/*
-	  ASSERT(stackSize >= 0);
-	  debugBelch("stackSize = %d\n", stackSize);
-	*/
-#endif
-	return;
-    }
-
-    popOffReal();
-}
-
-/* -----------------------------------------------------------------------------
- *  Finds the next object to be considered for retainer profiling and store
- *  its pointer to *c.
- *  Test if the topmost stack element indicates that more objects are left,
- *  and if so, retrieve the first object and store its pointer to *c. Also,
- *  set *cp and *r appropriately, both of which are stored in the stack element.
- *  The topmost stack element then is overwritten so as for it to now denote
- *  the next object.
- *  If the topmost stack element indicates no more objects are left, pop
- *  off the stack element until either an object can be retrieved or
- *  the current stack chunk becomes empty, indicated by rtsTrue returned by
- *  isOnBoundary(), in which case *c is set to NULL.
- *  Note:
- *    It is okay to call this function even when the current stack chunk
- *    is empty.
- * -------------------------------------------------------------------------- */
-static INLINE void
-pop( StgClosure **c, StgClosure **cp, retainer *r )
-{
-    stackElement *se;
-
-#ifdef DEBUG_RETAINER
-    // debugBelch("pop(): stackTop = 0x%x, currentStackBoundary = 0x%x\n", stackTop, currentStackBoundary);
-#endif
-
-    do {
-	if (isOnBoundary()) {     // if the current stack chunk is depleted
-	    *c = NULL;
-	    return;
-	}
-
-	se = stackTop;
-
-	switch (get_itbl(se->c)->type) {
-	    // two children (fixed), no SRT
-	    // nothing in se.info
-	case CONSTR_2_0:
-	    *c = se->c->payload[1];
-	    *cp = se->c;
-	    *r = se->c_child_r;
-	    popOff();
-	    return;
-
-	    // three children (fixed), no SRT
-	    // need to push a stackElement
-	case MVAR:
-	    if (se->info.next.step == 2) {
-		*c = (StgClosure *)((StgMVar *)se->c)->tail;
-		se->info.next.step++;             // move to the next step
-		// no popOff
-	    } else {
-		*c = ((StgMVar *)se->c)->value;
-		popOff();
-	    }
-	    *cp = se->c;
-	    *r = se->c_child_r;
-	    return;
-
-	    // three children (fixed), no SRT
-	case WEAK:
-	    if (se->info.next.step == 2) {
-		*c = ((StgWeak *)se->c)->value;
-		se->info.next.step++;
-		// no popOff
-	    } else {
-		*c = ((StgWeak *)se->c)->finalizer;
-		popOff();
-	    }
-	    *cp = se->c;
-	    *r = se->c_child_r;
-	    return;
-
-	case TVAR_WAIT_QUEUE:
-	    if (se->info.next.step == 2) {
-		*c = (StgClosure *)((StgTVarWaitQueue *)se->c)->next_queue_entry;
-		se->info.next.step++;             // move to the next step
-		// no popOff
-	    } else {
-		*c = (StgClosure *)((StgTVarWaitQueue *)se->c)->prev_queue_entry;
-		popOff();
-	    }
-	    *cp = se->c;
-	    *r = se->c_child_r;
-	    return;
-
-	case TVAR:
-	    *c = (StgClosure *)((StgTVar *)se->c)->first_wait_queue_entry;
-	    *cp = se->c;
-	    *r = se->c_child_r;
-	    popOff();
-	    return;
-
-	case TREC_HEADER:
-	    *c = (StgClosure *)((StgTRecHeader *)se->c)->current_chunk;
-	    *cp = se->c;
-	    *r = se->c_child_r;
-	    popOff();
-	    return;
-
-	case TREC_CHUNK: {
-	    // These are pretty complicated: we have N entries, each
-	    // of which contains 3 fields that we want to follow.  So
-	    // we divide the step counter: the 2 low bits indicate
-	    // which field, and the rest of the bits indicate the
-	    // entry number (starting from zero).
-	    nat entry_no = se->info.next.step >> 2;
-	    nat field_no = se->info.next.step & 3;
-	    if (entry_no == ((StgTRecChunk *)se->c)->next_entry_idx) {
-		*c = NULL;
-		popOff();
-		return;
-	    }
-	    TRecEntry *entry = &((StgTRecChunk *)se->c)->entries[entry_no];
-	    if (field_no == 0) {
-		*c = (StgClosure *)entry->tvar;
-	    } else if (field_no == 1) {
-		*c = entry->expected_value;
-	    } else {
-		*c = entry->new_value;
-	    }
-	    *cp = se->c;
-	    *r = se->c_child_r;
-	    se->info.next.step++;
-	    return;
-	}
-
-	case CONSTR:
-	case STABLE_NAME:
-	case BCO:
-	case CONSTR_STATIC:
-	    // StgMutArrPtr.ptrs, no SRT
-	case MUT_ARR_PTRS_CLEAN:
-	case MUT_ARR_PTRS_DIRTY:
-	case MUT_ARR_PTRS_FROZEN:
-	case MUT_ARR_PTRS_FROZEN0:
-	    *c = find_ptrs(&se->info);
-	    if (*c == NULL) {
-		popOff();
-		break;
-	    }
-	    *cp = se->c;
-	    *r = se->c_child_r;
-	    return;
-
-	    // layout.payload.ptrs, SRT
-	case FUN:         // always a heap object
-	case FUN_2_0:
-	    if (se->info.type == posTypePtrs) {
-		*c = find_ptrs(&se->info);
-		if (*c != NULL) {
-		    *cp = se->c;
-		    *r = se->c_child_r;
-		    return;
-		}
-		init_srt_fun(&se->info, get_fun_itbl(se->c));
-	    }
-	    goto do_srt;
-
-	case THUNK:
-	case THUNK_2_0:
-	    if (se->info.type == posTypePtrs) {
-		*c = find_ptrs(&se->info);
-		if (*c != NULL) {
-		    *cp = se->c;
-		    *r = se->c_child_r;
-		    return;
-		}
-		init_srt_thunk(&se->info, get_thunk_itbl(se->c));
-	    }
-	    goto do_srt;
-
-	    // SRT
-	do_srt:
-	case THUNK_STATIC:
-	case FUN_STATIC:
-	case FUN_0_1:
-	case FUN_0_2:
-	case THUNK_0_1:
-	case THUNK_0_2:
-	case FUN_1_0:
-	case FUN_1_1:
-	case THUNK_1_0:
-	case THUNK_1_1:
-	    *c = find_srt(&se->info);
-	    if (*c != NULL) {
-		*cp = se->c;
-		*r = se->c_child_r;
-		return;
-	    }
-	    popOff();
-	    break;
-
-	    // no child (fixed), no SRT
-	case CONSTR_0_1:
-	case CONSTR_0_2:
-	case CAF_BLACKHOLE:
-	case BLACKHOLE:
-	case SE_BLACKHOLE:
-	case SE_CAF_BLACKHOLE:
-	case ARR_WORDS:
-	    // one child (fixed), no SRT
-	case MUT_VAR_CLEAN:
-	case MUT_VAR_DIRTY:
-	case THUNK_SELECTOR:
-	case IND_PERM:
-	case IND_OLDGEN_PERM:
-	case IND_OLDGEN:
-	case CONSTR_1_1:
-	    // cannot appear
-	case PAP:
-	case AP:
-	case AP_STACK:
-	case TSO:
-	case IND_STATIC:
-	case CONSTR_INTLIKE:
-	case CONSTR_CHARLIKE:
-	case CONSTR_NOCAF_STATIC:
-	    // stack objects
-	case RET_DYN:
-	case UPDATE_FRAME:
-	case CATCH_FRAME:
-	case STOP_FRAME:
-	case RET_BCO:
-	case RET_SMALL:
-	case RET_VEC_SMALL:
-	case RET_BIG:
-	case RET_VEC_BIG:
-	    // invalid objects
-	case IND:
-	case BLOCKED_FETCH:
-	case FETCH_ME:
-	case FETCH_ME_BQ:
-	case RBH:
-	case REMOTE_REF:
-	case EVACUATED:
-	case INVALID_OBJECT:
-	default:
-	    barf("Invalid object *c in pop()");
-	    return;
-	}
-    } while (rtsTrue);
-}
-
-/* -----------------------------------------------------------------------------
- * RETAINER PROFILING ENGINE
- * -------------------------------------------------------------------------- */
-
-void
-initRetainerProfiling( void )
-{
-    initializeAllRetainerSet();
-    retainerGeneration = 0;
-}
-
-/* -----------------------------------------------------------------------------
- *  This function must be called before f-closing prof_file.
- * -------------------------------------------------------------------------- */
-void
-endRetainerProfiling( void )
-{
-#ifdef SECOND_APPROACH
-    outputAllRetainerSet(prof_file);
-#endif
-}
-
-/* -----------------------------------------------------------------------------
- *  Returns the actual pointer to the retainer set of the closure *c.
- *  It may adjust RSET(c) subject to flip.
- *  Side effects:
- *    RSET(c) is initialized to NULL if its current value does not
- *    conform to flip.
- *  Note:
- *    Even though this function has side effects, they CAN be ignored because
- *    subsequent calls to retainerSetOf() always result in the same return value
- *    and retainerSetOf() is the only way to retrieve retainerSet of a given
- *    closure.
- *    We have to perform an XOR (^) operation each time a closure is examined.
- *    The reason is that we do not know when a closure is visited last.
- * -------------------------------------------------------------------------- */
-static INLINE void
-maybeInitRetainerSet( StgClosure *c )
-{
-    if (!isRetainerSetFieldValid(c)) {
-	setRetainerSetToNull(c);
-    }
-}
-
-/* -----------------------------------------------------------------------------
- * Returns rtsTrue if *c is a retainer.
- * -------------------------------------------------------------------------- */
-static INLINE rtsBool
-isRetainer( StgClosure *c )
-{
-    switch (get_itbl(c)->type) {
-	//
-	//  True case
-	//
-	// TSOs MUST be retainers: they constitute the set of roots.
-    case TSO:
-
-	// mutable objects
-    case MVAR:
-    case MUT_VAR_CLEAN:
-    case MUT_VAR_DIRTY:
-    case MUT_ARR_PTRS_CLEAN:
-    case MUT_ARR_PTRS_DIRTY:
-    case MUT_ARR_PTRS_FROZEN:
-    case MUT_ARR_PTRS_FROZEN0:
-
-	// thunks are retainers.
-    case THUNK:
-    case THUNK_1_0:
-    case THUNK_0_1:
-    case THUNK_2_0:
-    case THUNK_1_1:
-    case THUNK_0_2:
-    case THUNK_SELECTOR:
-    case AP:
-    case AP_STACK:
-
-	// Static thunks, or CAFS, are obviously retainers.
-    case THUNK_STATIC:
-
-	// WEAK objects are roots; there is separate code in which traversing
-	// begins from WEAK objects.
-    case WEAK:
-
-	// Since the other mutvar-type things are retainers, seems
-	// like the right thing to do:
-    case TVAR:
-	return rtsTrue;
-
-	//
-	// False case
-	//
-
-	// constructors
-    case CONSTR:
-    case CONSTR_1_0:
-    case CONSTR_0_1:
-    case CONSTR_2_0:
-    case CONSTR_1_1:
-    case CONSTR_0_2:
-	// functions
-    case FUN:
-    case FUN_1_0:
-    case FUN_0_1:
-    case FUN_2_0:
-    case FUN_1_1:
-    case FUN_0_2:
-	// partial applications
-    case PAP:
-	// blackholes
-    case CAF_BLACKHOLE:
-    case BLACKHOLE:
-    case SE_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-	// indirection
-    case IND_PERM:
-    case IND_OLDGEN_PERM:
-    case IND_OLDGEN:
-	// static objects
-    case CONSTR_STATIC:
-    case FUN_STATIC:
-	// misc
-    case STABLE_NAME:
-    case BCO:
-    case ARR_WORDS:
-	// STM
-    case TVAR_WAIT_QUEUE:
-    case TREC_HEADER:
-    case TREC_CHUNK:
-	return rtsFalse;
-
-	//
-	// Error case
-	//
-	// IND_STATIC cannot be *c, *cp, *r in the retainer profiling loop.
-    case IND_STATIC:
-	// CONSTR_INTLIKE, CONSTR_CHARLIKE, and CONSTR_NOCAF_STATIC
-	// cannot be *c, *cp, *r in the retainer profiling loop.
-    case CONSTR_INTLIKE:
-    case CONSTR_CHARLIKE:
-    case CONSTR_NOCAF_STATIC:
-	// Stack objects are invalid because they are never treated as
-	// legal objects during retainer profiling.
-    case UPDATE_FRAME:
-    case CATCH_FRAME:
-    case STOP_FRAME:
-    case RET_DYN:
-    case RET_BCO:
-    case RET_SMALL:
-    case RET_VEC_SMALL:
-    case RET_BIG:
-    case RET_VEC_BIG:
-	// other cases
-    case IND:
-    case BLOCKED_FETCH:
-    case FETCH_ME:
-    case FETCH_ME_BQ:
-    case RBH:
-    case REMOTE_REF:
-    case EVACUATED:
-    case INVALID_OBJECT:
-    default:
-	barf("Invalid object in isRetainer(): %d", get_itbl(c)->type);
-	return rtsFalse;
-    }
-}
-
-/* -----------------------------------------------------------------------------
- *  Returns the retainer function value for the closure *c, i.e., R(*c).
- *  This function does NOT return the retainer(s) of *c.
- *  Invariants:
- *    *c must be a retainer.
- *  Note:
- *    Depending on the definition of this function, the maintenance of retainer
- *    sets can be made easier. If most retainer sets are likely to be created
- *    again across garbage collections, refreshAllRetainerSet() in
- *    RetainerSet.c can simply do nothing.
- *    If this is not the case, we can free all the retainer sets and
- *    re-initialize the hash table.
- *    See refreshAllRetainerSet() in RetainerSet.c.
- * -------------------------------------------------------------------------- */
-static INLINE retainer
-getRetainerFrom( StgClosure *c )
-{
-    ASSERT(isRetainer(c));
-
-#if defined(RETAINER_SCHEME_INFO)
-    // Retainer scheme 1: retainer = info table
-    return get_itbl(c);
-#elif defined(RETAINER_SCHEME_CCS)
-    // Retainer scheme 2: retainer = cost centre stack
-    return c->header.prof.ccs;
-#elif defined(RETAINER_SCHEME_CC)
-    // Retainer scheme 3: retainer = cost centre
-    return c->header.prof.ccs->cc;
-#endif
-}
-
-/* -----------------------------------------------------------------------------
- *  Associates the retainer set *s with the closure *c, that is, *s becomes
- *  the retainer set of *c.
- *  Invariants:
- *    c != NULL
- *    s != NULL
- * -------------------------------------------------------------------------- */
-static INLINE void
-associate( StgClosure *c, RetainerSet *s )
-{
-    // StgWord has the same size as pointers, so the following type
-    // casting is okay.
-    RSET(c) = (RetainerSet *)((StgWord)s | flip);
-}
-
-/* -----------------------------------------------------------------------------
-   Call retainClosure for each of the closures covered by a large bitmap.
-   -------------------------------------------------------------------------- */
-
-static void
-retain_large_bitmap (StgPtr p, StgLargeBitmap *large_bitmap, nat size,
-		     StgClosure *c, retainer c_child_r)
-{
-    nat i, b;
-    StgWord bitmap;
-    
-    b = 0;
-    bitmap = large_bitmap->bitmap[b];
-    for (i = 0; i < size; ) {
-	if ((bitmap & 1) == 0) {
-	    retainClosure((StgClosure *)*p, c, c_child_r);
-	}
-	i++;
-	p++;
-	if (i % BITS_IN(W_) == 0) {
-	    b++;
-	    bitmap = large_bitmap->bitmap[b];
-	} else {
-	    bitmap = bitmap >> 1;
-	}
-    }
-}
-
-static INLINE StgPtr
-retain_small_bitmap (StgPtr p, nat size, StgWord bitmap,
-		     StgClosure *c, retainer c_child_r)
-{
-    while (size > 0) {
-	if ((bitmap & 1) == 0) {
-	    retainClosure((StgClosure *)*p, c, c_child_r);
-	}
-	p++;
-	bitmap = bitmap >> 1;
-	size--;
-    }
-    return p;
-}
-
-/* -----------------------------------------------------------------------------
- * Call retainClosure for each of the closures in an SRT.
- * ------------------------------------------------------------------------- */
-
-static void
-retain_large_srt_bitmap (StgLargeSRT *srt, StgClosure *c, retainer c_child_r)
-{
-    nat i, b, size;
-    StgWord bitmap;
-    StgClosure **p;
-    
-    b = 0;
-    p = (StgClosure **)srt->srt;
-    size   = srt->l.size;
-    bitmap = srt->l.bitmap[b];
-    for (i = 0; i < size; ) {
-	if ((bitmap & 1) != 0) {
-	    retainClosure((StgClosure *)*p, c, c_child_r);
-	}
-	i++;
-	p++;
-	if (i % BITS_IN(W_) == 0) {
-	    b++;
-	    bitmap = srt->l.bitmap[b];
-	} else {
-	    bitmap = bitmap >> 1;
-	}
-    }
-}
-
-static INLINE void
-retainSRT (StgClosure **srt, nat srt_bitmap, StgClosure *c, retainer c_child_r)
-{
-  nat bitmap;
-  StgClosure **p;
-
-  bitmap = srt_bitmap;
-  p = srt;
-
-  if (bitmap == (StgHalfWord)(-1)) {  
-      retain_large_srt_bitmap( (StgLargeSRT *)srt, c, c_child_r );
-      return;
-  }
-
-  while (bitmap != 0) {
-      if ((bitmap & 1) != 0) {
-#ifdef ENABLE_WIN32_DLL_SUPPORT
-	  if ( (unsigned long)(*srt) & 0x1 ) {
-	      retainClosure(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)), 
-			    c, c_child_r);
-	  } else {
-	      retainClosure(*srt,c,c_child_r);
-	  }
-#else
-	  retainClosure(*srt,c,c_child_r);
-#endif
-      }
-      p++;
-      bitmap = bitmap >> 1;
-  }
-}
-
-/* -----------------------------------------------------------------------------
- *  Process all the objects in the stack chunk from stackStart to stackEnd
- *  with *c and *c_child_r being their parent and their most recent retainer,
- *  respectively. Treat stackOptionalFun as another child of *c if it is
- *  not NULL.
- *  Invariants:
- *    *c is one of the following: TSO, AP_STACK.
- *    If *c is TSO, c == c_child_r.
- *    stackStart < stackEnd.
- *    RSET(c) and RSET(c_child_r) are valid, i.e., their
- *    interpretation conforms to the current value of flip (even when they
- *    are interpreted to be NULL).
- *    If *c is TSO, its state is not any of ThreadRelocated, ThreadComplete,
- *    or ThreadKilled, which means that its stack is ready to process.
- *  Note:
- *    This code was almost plagiarzied from GC.c! For each pointer,
- *    retainClosure() is invoked instead of evacuate().
- * -------------------------------------------------------------------------- */
-static void
-retainStack( StgClosure *c, retainer c_child_r,
-	     StgPtr stackStart, StgPtr stackEnd )
-{
-    stackElement *oldStackBoundary;
-    StgPtr p;
-    StgRetInfoTable *info;
-    StgWord32 bitmap;
-    nat size;
-
-#ifdef DEBUG_RETAINER
-    cStackSize++;
-    if (cStackSize > maxCStackSize) maxCStackSize = cStackSize;
-#endif
-
-    /*
-      Each invocation of retainStack() creates a new virtual
-      stack. Since all such stacks share a single common stack, we
-      record the current currentStackBoundary, which will be restored
-      at the exit.
-    */
-    oldStackBoundary = currentStackBoundary;
-    currentStackBoundary = stackTop;
-
-#ifdef DEBUG_RETAINER
-    // debugBelch("retainStack() called: oldStackBoundary = 0x%x, currentStackBoundary = 0x%x\n", oldStackBoundary, currentStackBoundary);
-#endif
-
-    ASSERT(get_itbl(c)->type != TSO || 
-	   (((StgTSO *)c)->what_next != ThreadRelocated &&
-	    ((StgTSO *)c)->what_next != ThreadComplete &&
-	    ((StgTSO *)c)->what_next != ThreadKilled));
-    
-    p = stackStart;
-    while (p < stackEnd) {
-	info = get_ret_itbl((StgClosure *)p);
-
-	switch(info->i.type) {
-
-	case UPDATE_FRAME:
-	    retainClosure(((StgUpdateFrame *)p)->updatee, c, c_child_r);
-	    p += sizeofW(StgUpdateFrame);
-	    continue;
-
-	case STOP_FRAME:
-	case CATCH_FRAME:
-	case CATCH_STM_FRAME:
-	case CATCH_RETRY_FRAME:
-	case ATOMICALLY_FRAME:
-	case RET_SMALL:
-	case RET_VEC_SMALL:
-	    bitmap = BITMAP_BITS(info->i.layout.bitmap);
-	    size   = BITMAP_SIZE(info->i.layout.bitmap);
-	    p++;
-	    p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
-
-	follow_srt:
-	    retainSRT((StgClosure **)GET_SRT(info), info->i.srt_bitmap, c, c_child_r);
-	    continue;
-
-	case RET_BCO: {
-	    StgBCO *bco;
-	    
-	    p++;
-	    retainClosure((StgClosure *)*p, c, c_child_r);
-	    bco = (StgBCO *)*p;
-	    p++;
-	    size = BCO_BITMAP_SIZE(bco);
-	    retain_large_bitmap(p, BCO_BITMAP(bco), size, c, c_child_r);
-	    p += size;
-	    continue;
-	}
-
-	    // large bitmap (> 32 entries, or > 64 on a 64-bit machine) 
-	case RET_BIG:
-	case RET_VEC_BIG:
-	    size = GET_LARGE_BITMAP(&info->i)->size;
-	    p++;
-	    retain_large_bitmap(p, GET_LARGE_BITMAP(&info->i),
-				size, c, c_child_r);
-	    p += size;
-	    // and don't forget to follow the SRT 
-	    goto follow_srt;
-
-	    // Dynamic bitmap: the mask is stored on the stack 
-	case RET_DYN: {
-	    StgWord dyn;
-	    dyn = ((StgRetDyn *)p)->liveness;
-
-	    // traverse the bitmap first
-	    bitmap = RET_DYN_LIVENESS(dyn);
-	    p      = (P_)&((StgRetDyn *)p)->payload[0];
-	    size   = RET_DYN_BITMAP_SIZE;
-	    p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
-	    
-	    // skip over the non-ptr words
-	    p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
-	    
-	    // follow the ptr words
-	    for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
-		retainClosure((StgClosure *)*p, c, c_child_r);
-		p++;
-	    }
-	    continue;
-	}
-
-	case RET_FUN: {
-	    StgRetFun *ret_fun = (StgRetFun *)p;
-	    StgFunInfoTable *fun_info;
-	    
-	    retainClosure(ret_fun->fun, c, c_child_r);
-	    fun_info = get_fun_itbl(ret_fun->fun);
-	    
-	    p = (P_)&ret_fun->payload;
-	    switch (fun_info->f.fun_type) {
-	    case ARG_GEN:
-		bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
-		size = BITMAP_SIZE(fun_info->f.b.bitmap);
-		p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
-		break;
-	    case ARG_GEN_BIG:
-		size = GET_FUN_LARGE_BITMAP(fun_info)->size;
-		retain_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), 
-				    size, c, c_child_r);
-		p += size;
-		break;
-	    default:
-		bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
-		size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
-		p = retain_small_bitmap(p, size, bitmap, c, c_child_r);
-		break;
-	    }
-	    goto follow_srt;
-	}
-
-	default:
-	    barf("Invalid object found in retainStack(): %d",
-		 (int)(info->i.type));
-	}
-    }
-
-    // restore currentStackBoundary
-    currentStackBoundary = oldStackBoundary;
-#ifdef DEBUG_RETAINER
-    // debugBelch("retainStack() finished: currentStackBoundary = 0x%x\n", currentStackBoundary);
-#endif
-
-#ifdef DEBUG_RETAINER
-    cStackSize--;
-#endif
-}
-
-/* ----------------------------------------------------------------------------
- * Call retainClosure for each of the children of a PAP/AP
- * ------------------------------------------------------------------------- */
-
-static INLINE StgPtr
-retain_PAP_payload (StgClosure *pap,  retainer c_child_r, StgClosure *fun, 
-		    StgClosure** payload, StgWord n_args)
-{
-    StgPtr p;
-    StgWord bitmap;
-    StgFunInfoTable *fun_info;
-
-    retainClosure(fun, pap, c_child_r);
-    fun_info = get_fun_itbl(fun);
-    ASSERT(fun_info->i.type != PAP);
-
-    p = (StgPtr)payload;
-
-    switch (fun_info->f.fun_type) {
-    case ARG_GEN:
-	bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
-	p = retain_small_bitmap(p, n_args, bitmap, 
-				pap, c_child_r);
-	break;
-    case ARG_GEN_BIG:
-	retain_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info),
-			    n_args, pap, c_child_r);
-	p += n_args;
-	break;
-    case ARG_BCO:
-	retain_large_bitmap((StgPtr)payload, BCO_BITMAP(fun),
-			    n_args, pap, c_child_r);
-	p += n_args;
-	break;
-    default:
-	bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
-	p = retain_small_bitmap(p, n_args, bitmap, pap, c_child_r);
-	break;
-    }
-    return p;
-}
-
-/* -----------------------------------------------------------------------------
- *  Compute the retainer set of *c0 and all its desecents by traversing.
- *  *cp0 is the parent of *c0, and *r0 is the most recent retainer of *c0.
- *  Invariants:
- *    c0 = cp0 = r0 holds only for root objects.
- *    RSET(cp0) and RSET(r0) are valid, i.e., their
- *    interpretation conforms to the current value of flip (even when they
- *    are interpreted to be NULL).
- *    However, RSET(c0) may be corrupt, i.e., it may not conform to
- *    the current value of flip. If it does not, during the execution
- *    of this function, RSET(c0) must be initialized as well as all
- *    its descendants.
- *  Note:
- *    stackTop must be the same at the beginning and the exit of this function.
- *    *c0 can be TSO (as well as AP_STACK).
- * -------------------------------------------------------------------------- */
-static void
-retainClosure( StgClosure *c0, StgClosure *cp0, retainer r0 )
-{
-    // c = Current closure
-    // cp = Current closure's Parent
-    // r = current closures' most recent Retainer
-    // c_child_r = current closure's children's most recent retainer
-    // first_child = first child of c
-    StgClosure *c, *cp, *first_child;
-    RetainerSet *s, *retainerSetOfc;
-    retainer r, c_child_r;
-    StgWord typeOfc;
-
-#ifdef DEBUG_RETAINER
-    // StgPtr oldStackTop;
-#endif
-
-#ifdef DEBUG_RETAINER
-    // oldStackTop = stackTop;
-    // debugBelch("retainClosure() called: c0 = 0x%x, cp0 = 0x%x, r0 = 0x%x\n", c0, cp0, r0);
-#endif
-
-    // (c, cp, r) = (c0, cp0, r0)
-    c = c0;
-    cp = cp0;
-    r = r0;
-    goto inner_loop;
-
-loop:
-    //debugBelch("loop");
-    // pop to (c, cp, r);
-    pop(&c, &cp, &r);
-
-    if (c == NULL) {
-#ifdef DEBUG_RETAINER
-	// debugBelch("retainClosure() ends: oldStackTop = 0x%x, stackTop = 0x%x\n", oldStackTop, stackTop);
-#endif
-	return;
-    }
-
-    //debugBelch("inner_loop");
-
-inner_loop:
-    // c  = current closure under consideration,
-    // cp = current closure's parent,
-    // r  = current closure's most recent retainer
-    //
-    // Loop invariants (on the meaning of c, cp, r, and their retainer sets):
-    //   RSET(cp) and RSET(r) are valid.
-    //   RSET(c) is valid only if c has been visited before.
-    //
-    // Loop invariants (on the relation between c, cp, and r)
-    //   if cp is not a retainer, r belongs to RSET(cp).
-    //   if cp is a retainer, r == cp.
-
-    typeOfc = get_itbl(c)->type;
-
-#ifdef DEBUG_RETAINER
-    switch (typeOfc) {
-    case IND_STATIC:
-    case CONSTR_INTLIKE:
-    case CONSTR_CHARLIKE:
-    case CONSTR_NOCAF_STATIC:
-    case CONSTR_STATIC:
-    case THUNK_STATIC:
-    case FUN_STATIC:
-	break;
-    default:
-	if (retainerSetOf(c) == NULL) {   // first visit?
-	    costArray[typeOfc] += cost(c);
-	    sumOfNewCost += cost(c);
-	}
-	break;
-    }
-#endif
-
-    // special cases
-    switch (typeOfc) {
-    case TSO:
-	if (((StgTSO *)c)->what_next == ThreadComplete ||
-	    ((StgTSO *)c)->what_next == ThreadKilled) {
-#ifdef DEBUG_RETAINER
-	    debugBelch("ThreadComplete or ThreadKilled encountered in retainClosure()\n");
-#endif
-	    goto loop;
-	}
-	if (((StgTSO *)c)->what_next == ThreadRelocated) {
-#ifdef DEBUG_RETAINER
-	    debugBelch("ThreadRelocated encountered in retainClosure()\n");
-#endif
-	    c = (StgClosure *)((StgTSO *)c)->link;
-	    goto inner_loop;
-	}
-	break;
-
-    case IND_STATIC:
-	// We just skip IND_STATIC, so its retainer set is never computed.
-	c = ((StgIndStatic *)c)->indirectee;
-	goto inner_loop;
-    case CONSTR_INTLIKE:
-    case CONSTR_CHARLIKE:
-	// static objects with no pointers out, so goto loop.
-    case CONSTR_NOCAF_STATIC:
-	// It is not just enough not to compute the retainer set for *c; it is
-	// mandatory because CONSTR_NOCAF_STATIC are not reachable from
-	// scavenged_static_objects, the list from which is assumed to traverse
-	// all static objects after major garbage collections.
-	goto loop;
-    case THUNK_STATIC:
-    case FUN_STATIC:
-	if (get_itbl(c)->srt_bitmap == 0) {
-	    // No need to compute the retainer set; no dynamic objects
-	    // are reachable from *c.
-	    //
-	    // Static objects: if we traverse all the live closures,
-	    // including static closures, during each heap census then
-	    // we will observe that some static closures appear and
-	    // disappear.  eg. a closure may contain a pointer to a
-	    // static function 'f' which is not otherwise reachable
-	    // (it doesn't indirectly point to any CAFs, so it doesn't
-	    // appear in any SRTs), so we would find 'f' during
-	    // traversal.  However on the next sweep there may be no
-	    // closures pointing to 'f'.
-	    //
-	    // We must therefore ignore static closures whose SRT is
-	    // empty, because these are exactly the closures that may
-	    // "appear".  A closure with a non-empty SRT, and which is
-	    // still required, will always be reachable.
-	    //
-	    // But what about CONSTR_STATIC?  Surely these may be able
-	    // to appear, and they don't have SRTs, so we can't
-	    // check.  So for now, we're calling
-	    // resetStaticObjectForRetainerProfiling() from the
-	    // garbage collector to reset the retainer sets in all the
-	    // reachable static objects.
-	    goto loop;
-	}
-    default:
-	break;
-    }
-
-    // The above objects are ignored in computing the average number of times
-    // an object is visited.
-    timesAnyObjectVisited++;
-
-    // If this is the first visit to c, initialize its retainer set.
-    maybeInitRetainerSet(c);
-    retainerSetOfc = retainerSetOf(c);
-
-    // Now compute s:
-    //    isRetainer(cp) == rtsTrue => s == NULL
-    //    isRetainer(cp) == rtsFalse => s == cp.retainer
-    if (isRetainer(cp))
-	s = NULL;
-    else
-	s = retainerSetOf(cp);
-
-    // (c, cp, r, s) is available.
-
-    // (c, cp, r, s, R_r) is available, so compute the retainer set for *c.
-    if (retainerSetOfc == NULL) {
-	// This is the first visit to *c.
-	numObjectVisited++;
-
-	if (s == NULL)
-	    associate(c, singleton(r));
-	else
-	    // s is actually the retainer set of *c!
-	    associate(c, s);
-
-	// compute c_child_r
-	c_child_r = isRetainer(c) ? getRetainerFrom(c) : r;
-    } else {
-	// This is not the first visit to *c.
-	if (isMember(r, retainerSetOfc))
-	    goto loop;          // no need to process child
-
-	if (s == NULL)
-	    associate(c, addElement(r, retainerSetOfc));
-	else {
-	    // s is not NULL and cp is not a retainer. This means that
-	    // each time *cp is visited, so is *c. Thus, if s has
-	    // exactly one more element in its retainer set than c, s
-	    // is also the new retainer set for *c.
-	    if (s->num == retainerSetOfc->num + 1) {
-		associate(c, s);
-	    }
-	    // Otherwise, just add R_r to the current retainer set of *c.
-	    else {
-		associate(c, addElement(r, retainerSetOfc));
-	    }
-	}
-
-	if (isRetainer(c))
-	    goto loop;          // no need to process child
-
-	// compute c_child_r
-	c_child_r = r;
-    }
-
-    // now, RSET() of all of *c, *cp, and *r is valid.
-    // (c, c_child_r) are available.
-
-    // process child
-
-    // Special case closures: we process these all in one go rather
-    // than attempting to save the current position, because doing so
-    // would be hard.
-    switch (typeOfc) {
-    case TSO:
-	retainStack(c, c_child_r,
-		    ((StgTSO *)c)->sp,
-		    ((StgTSO *)c)->stack + ((StgTSO *)c)->stack_size);
-	goto loop;
-
-    case PAP:
-    {
-	StgPAP *pap = (StgPAP *)c;
-	retain_PAP_payload(c, c_child_r, pap->fun, pap->payload, pap->n_args);
-	goto loop;
-    }
-
-    case AP:
-    {
-	StgAP *ap = (StgAP *)c;
-	retain_PAP_payload(c, c_child_r, ap->fun, ap->payload, ap->n_args);
-	goto loop;
-    }
-
-    case AP_STACK:
-	retainClosure(((StgAP_STACK *)c)->fun, c, c_child_r);
-	retainStack(c, c_child_r,
-		    (StgPtr)((StgAP_STACK *)c)->payload,
-		    (StgPtr)((StgAP_STACK *)c)->payload +
-		             ((StgAP_STACK *)c)->size);
-	goto loop;
-    }
-
-    push(c, c_child_r, &first_child);
-
-    // If first_child is null, c has no child.
-    // If first_child is not null, the top stack element points to the next
-    // object. push() may or may not push a stackElement on the stack.
-    if (first_child == NULL)
-	goto loop;
-
-    // (c, cp, r) = (first_child, c, c_child_r)
-    r = c_child_r;
-    cp = c;
-    c = first_child;
-    goto inner_loop;
-}
-
-/* -----------------------------------------------------------------------------
- *  Compute the retainer set for every object reachable from *tl.
- * -------------------------------------------------------------------------- */
-static void
-retainRoot( StgClosure **tl )
-{
-    // We no longer assume that only TSOs and WEAKs are roots; any closure can
-    // be a root.
-
-    ASSERT(isEmptyRetainerStack());
-    currentStackBoundary = stackTop;
-
-    if (*tl != &stg_END_TSO_QUEUE_closure && isRetainer(*tl)) {
-	retainClosure(*tl, *tl, getRetainerFrom(*tl));
-    } else {
-	retainClosure(*tl, *tl, CCS_SYSTEM);
-    }
-
-    // NOT TRUE: ASSERT(isMember(getRetainerFrom(*tl), retainerSetOf(*tl)));
-    // *tl might be a TSO which is ThreadComplete, in which
-    // case we ignore it for the purposes of retainer profiling.
-}
-
-/* -----------------------------------------------------------------------------
- *  Compute the retainer set for each of the objects in the heap.
- * -------------------------------------------------------------------------- */
-static void
-computeRetainerSet( void )
-{
-    StgWeak *weak;
-    RetainerSet *rtl;
-    nat g;
-    StgPtr ml;
-    bdescr *bd;
-#ifdef DEBUG_RETAINER
-    RetainerSet tmpRetainerSet;
-#endif
-
-    GetRoots(retainRoot);	// for scheduler roots
-
-    // This function is called after a major GC, when key, value, and finalizer
-    // all are guaranteed to be valid, or reachable.
-    //
-    // The following code assumes that WEAK objects are considered to be roots
-    // for retainer profilng.
-    for (weak = weak_ptr_list; weak != NULL; weak = weak->link)
-	// retainRoot((StgClosure *)weak);
-	retainRoot((StgClosure **)&weak);
-
-    // Consider roots from the stable ptr table.
-    markStablePtrTable(retainRoot);
-
-    // The following code resets the rs field of each unvisited mutable
-    // object (computing sumOfNewCostExtra and updating costArray[] when
-    // debugging retainer profiler).
-    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	// NOT TRUE: even G0 has a block on its mutable list
-        // ASSERT(g != 0 || (generations[g].mut_list == NULL));
-
-	// Traversing through mut_list is necessary
-	// because we can find MUT_VAR objects which have not been
-	// visited during retainer profiling.
-	for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
-	    for (ml = bd->start; ml < bd->free; ml++) {
-
-		maybeInitRetainerSet((StgClosure *)*ml);
-		rtl = retainerSetOf((StgClosure *)*ml);
-
-#ifdef DEBUG_RETAINER
-		if (rtl == NULL) {
-		    // first visit to *ml
-		    // This is a violation of the interface rule!
-		    RSET(ml) = (RetainerSet *)((StgWord)(&tmpRetainerSet) | flip);
-		    
-		    switch (get_itbl((StgClosure *)ml)->type) {
-		    case IND_STATIC:
-			// no cost involved
-			break;
-		    case CONSTR_INTLIKE:
-		    case CONSTR_CHARLIKE:
-		    case CONSTR_NOCAF_STATIC:
-		    case CONSTR_STATIC:
-		    case THUNK_STATIC:
-		    case FUN_STATIC:
-			barf("Invalid object in computeRetainerSet(): %d", get_itbl((StgClosure*)ml)->type);
-			break;
-		    default:
-			// dynamic objects
-			costArray[get_itbl((StgClosure *)ml)->type] += cost((StgClosure *)ml);
-			sumOfNewCostExtra += cost((StgClosure *)ml);
-			break;
-		    }
-		}
-#endif
-	    }
-	}
-    }
-}
-
-/* -----------------------------------------------------------------------------
- *  Traverse all static objects for which we compute retainer sets,
- *  and reset their rs fields to NULL, which is accomplished by
- *  invoking maybeInitRetainerSet(). This function must be called
- *  before zeroing all objects reachable from scavenged_static_objects
- *  in the case of major gabage collections. See GarbageCollect() in
- *  GC.c.
- *  Note:
- *    The mut_once_list of the oldest generation must also be traversed?
- *    Why? Because if the evacuation of an object pointed to by a static
- *    indirection object fails, it is put back to the mut_once_list of
- *    the oldest generation.
- *    However, this is not necessary because any static indirection objects
- *    are just traversed through to reach dynamic objects. In other words,
- *    they are not taken into consideration in computing retainer sets.
- * -------------------------------------------------------------------------- */
-void
-resetStaticObjectForRetainerProfiling( void )
-{
-#ifdef DEBUG_RETAINER
-    nat count;
-#endif
-    StgClosure *p;
-
-#ifdef DEBUG_RETAINER
-    count = 0;
-#endif
-    p = scavenged_static_objects;
-    while (p != END_OF_STATIC_LIST) {
-#ifdef DEBUG_RETAINER
-	count++;
-#endif
-	switch (get_itbl(p)->type) {
-	case IND_STATIC:
-	    // Since we do not compute the retainer set of any
-	    // IND_STATIC object, we don't have to reset its retainer
-	    // field.
-	    p = (StgClosure*)*IND_STATIC_LINK(p);
-	    break;
-	case THUNK_STATIC:
-	    maybeInitRetainerSet(p);
-	    p = (StgClosure*)*THUNK_STATIC_LINK(p);
-	    break;
-	case FUN_STATIC:
-	    maybeInitRetainerSet(p);
-	    p = (StgClosure*)*FUN_STATIC_LINK(p);
-	    break;
-	case CONSTR_STATIC:
-	    maybeInitRetainerSet(p);
-	    p = (StgClosure*)*STATIC_LINK(get_itbl(p), p);
-	    break;
-	default:
-	    barf("resetStaticObjectForRetainerProfiling: %p (%s)",
-		 p, get_itbl(p)->type);
-	    break;
-	}
-    }
-#ifdef DEBUG_RETAINER
-    // debugBelch("count in scavenged_static_objects = %d\n", count);
-#endif
-}
-
-/* -----------------------------------------------------------------------------
- * Perform retainer profiling.
- * N is the oldest generation being profilied, where the generations are
- * numbered starting at 0.
- * Invariants:
- * Note:
- *   This function should be called only immediately after major garbage
- *   collection.
- * ------------------------------------------------------------------------- */
-void
-retainerProfile(void)
-{
-#ifdef DEBUG_RETAINER
-  nat i;
-  nat totalHeapSize;        // total raw heap size (computed by linear scanning)
-#endif
-
-#ifdef DEBUG_RETAINER
-  debugBelch(" < retainerProfile() invoked : %d>\n", retainerGeneration);
-#endif
-
-  stat_startRP();
-
-  // We haven't flipped the bit yet.
-#ifdef DEBUG_RETAINER
-  debugBelch("Before traversing:\n");
-  sumOfCostLinear = 0;
-  for (i = 0;i < N_CLOSURE_TYPES; i++)
-    costArrayLinear[i] = 0;
-  totalHeapSize = checkHeapSanityForRetainerProfiling();
-
-  debugBelch("\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize);
-  /*
-  debugBelch("costArrayLinear[] = ");
-  for (i = 0;i < N_CLOSURE_TYPES; i++)
-    debugBelch("[%u:%u] ", i, costArrayLinear[i]);
-  debugBelch("\n");
-  */
-
-  ASSERT(sumOfCostLinear == totalHeapSize);
-
-/*
-#define pcostArrayLinear(index) \
-  if (costArrayLinear[index] > 0) \
-    debugBelch("costArrayLinear[" #index "] = %u\n", costArrayLinear[index])
-  pcostArrayLinear(THUNK_STATIC);
-  pcostArrayLinear(FUN_STATIC);
-  pcostArrayLinear(CONSTR_STATIC);
-  pcostArrayLinear(CONSTR_NOCAF_STATIC);
-  pcostArrayLinear(CONSTR_INTLIKE);
-  pcostArrayLinear(CONSTR_CHARLIKE);
-*/
-#endif
-
-  // Now we flips flip.
-  flip = flip ^ 1;
-
-#ifdef DEBUG_RETAINER
-  stackSize = 0;
-  maxStackSize = 0;
-  cStackSize = 0;
-  maxCStackSize = 0;
-#endif
-  numObjectVisited = 0;
-  timesAnyObjectVisited = 0;
-
-#ifdef DEBUG_RETAINER
-  debugBelch("During traversing:\n");
-  sumOfNewCost = 0;
-  sumOfNewCostExtra = 0;
-  for (i = 0;i < N_CLOSURE_TYPES; i++)
-    costArray[i] = 0;
-#endif
-
-  /*
-    We initialize the traverse stack each time the retainer profiling is
-    performed (because the traverse stack size varies on each retainer profiling
-    and this operation is not costly anyhow). However, we just refresh the
-    retainer sets.
-   */
-  initializeTraverseStack();
-#ifdef DEBUG_RETAINER
-  initializeAllRetainerSet();
-#else
-  refreshAllRetainerSet();
-#endif
-  computeRetainerSet();
-
-#ifdef DEBUG_RETAINER
-  debugBelch("After traversing:\n");
-  sumOfCostLinear = 0;
-  for (i = 0;i < N_CLOSURE_TYPES; i++)
-    costArrayLinear[i] = 0;
-  totalHeapSize = checkHeapSanityForRetainerProfiling();
-
-  debugBelch("\tsumOfCostLinear = %d, totalHeapSize = %d\n", sumOfCostLinear, totalHeapSize);
-  ASSERT(sumOfCostLinear == totalHeapSize);
-
-  // now, compare the two results
-  /*
-    Note:
-      costArray[] must be exactly the same as costArrayLinear[].
-      Known exceptions:
-        1) Dead weak pointers, whose type is CONSTR. These objects are not
-           reachable from any roots.
-  */
-  debugBelch("Comparison:\n");
-  debugBelch("\tcostArrayLinear[] (must be empty) = ");
-  for (i = 0;i < N_CLOSURE_TYPES; i++)
-    if (costArray[i] != costArrayLinear[i])
-      // nothing should be printed except MUT_VAR after major GCs
-      debugBelch("[%u:%u] ", i, costArrayLinear[i]);
-  debugBelch("\n");
-
-  debugBelch("\tsumOfNewCost = %u\n", sumOfNewCost);
-  debugBelch("\tsumOfNewCostExtra = %u\n", sumOfNewCostExtra);
-  debugBelch("\tcostArray[] (must be empty) = ");
-  for (i = 0;i < N_CLOSURE_TYPES; i++)
-    if (costArray[i] != costArrayLinear[i])
-      // nothing should be printed except MUT_VAR after major GCs
-      debugBelch("[%u:%u] ", i, costArray[i]);
-  debugBelch("\n");
-
-  // only for major garbage collection
-  ASSERT(sumOfNewCost + sumOfNewCostExtra == sumOfCostLinear);
-#endif
-
-  // post-processing
-  closeTraverseStack();
-#ifdef DEBUG_RETAINER
-  closeAllRetainerSet();
-#else
-  // Note that there is no post-processing for the retainer sets.
-#endif
-  retainerGeneration++;
-
-  stat_endRP(
-    retainerGeneration - 1,   // retainerGeneration has just been incremented!
-#ifdef DEBUG_RETAINER
-    maxCStackSize, maxStackSize,
-#endif
-    (double)timesAnyObjectVisited / numObjectVisited);
-}
-
-/* -----------------------------------------------------------------------------
- * DEBUGGING CODE
- * -------------------------------------------------------------------------- */
-
-#ifdef DEBUG_RETAINER
-
-#define LOOKS_LIKE_PTR(r) ((LOOKS_LIKE_STATIC_CLOSURE(r) || \
-        ((HEAP_ALLOCED(r) && ((Bdescr((P_)r)->flags & BF_FREE) == 0)))) && \
-        ((StgWord)(*(StgPtr)r)!=0xaaaaaaaa))
-
-static nat
-sanityCheckHeapClosure( StgClosure *c )
-{
-    StgInfoTable *info;
-
-    ASSERT(LOOKS_LIKE_GHC_INFO(c->header.info));
-    ASSERT(!closure_STATIC(c));
-    ASSERT(LOOKS_LIKE_PTR(c));
-
-    if ((((StgWord)RSET(c) & 1) ^ flip) != 0) {
-	if (get_itbl(c)->type == CONSTR &&
-	    !strcmp(get_itbl(c)->prof.closure_type, "DEAD_WEAK") &&
-	    !strcmp(get_itbl(c)->prof.closure_desc, "DEAD_WEAK")) {
-	    debugBelch("\tUnvisited dead weak pointer object found: c = %p\n", c);
-	    costArray[get_itbl(c)->type] += cost(c);
-	    sumOfNewCost += cost(c);
-	} else
-	    debugBelch(
-		    "Unvisited object: flip = %d, c = %p(%d, %s, %s), rs = %p\n",
-		    flip, c, get_itbl(c)->type,
-		    get_itbl(c)->prof.closure_type, get_itbl(c)->prof.closure_desc,
-		    RSET(c));
-    } else {
-	// debugBelch("sanityCheckHeapClosure) S: flip = %d, c = %p(%d), rs = %p\n", flip, c, get_itbl(c)->type, RSET(c));
-    }
-
-    return closure_sizeW(c);
-}
-
-static nat
-heapCheck( bdescr *bd )
-{
-    StgPtr p;
-    static nat costSum, size;
-
-    costSum = 0;
-    while (bd != NULL) {
-	p = bd->start;
-	while (p < bd->free) {
-	    size = sanityCheckHeapClosure((StgClosure *)p);
-	    sumOfCostLinear += size;
-	    costArrayLinear[get_itbl((StgClosure *)p)->type] += size;
-	    p += size;
-	    // no need for slop check; I think slops are not used currently.
-	}
-	ASSERT(p == bd->free);
-	costSum += bd->free - bd->start;
-	bd = bd->link;
-    }
-
-    return costSum;
-}
-
-static nat
-smallObjectPoolCheck(void)
-{
-    bdescr *bd;
-    StgPtr p;
-    static nat costSum, size;
-
-    bd = small_alloc_list;
-    costSum = 0;
-
-    // first block
-    if (bd == NULL)
-	return costSum;
-
-    p = bd->start;
-    while (p < alloc_Hp) {
-	size = sanityCheckHeapClosure((StgClosure *)p);
-	sumOfCostLinear += size;
-	costArrayLinear[get_itbl((StgClosure *)p)->type] += size;
-	p += size;
-    }
-    ASSERT(p == alloc_Hp);
-    costSum += alloc_Hp - bd->start;
-
-    bd = bd->link;
-    while (bd != NULL) {
-	p = bd->start;
-	while (p < bd->free) {
-	    size = sanityCheckHeapClosure((StgClosure *)p);
-	    sumOfCostLinear += size;
-	    costArrayLinear[get_itbl((StgClosure *)p)->type] += size;
-	    p += size;
-	}
-	ASSERT(p == bd->free);
-	costSum += bd->free - bd->start;
-	bd = bd->link;
-    }
-
-    return costSum;
-}
-
-static nat
-chainCheck(bdescr *bd)
-{
-    nat costSum, size;
-
-    costSum = 0;
-    while (bd != NULL) {
-	// bd->free - bd->start is not an accurate measurement of the
-	// object size.  Actually it is always zero, so we compute its
-	// size explicitly.
-	size = sanityCheckHeapClosure((StgClosure *)bd->start);
-	sumOfCostLinear += size;
-	costArrayLinear[get_itbl((StgClosure *)bd->start)->type] += size;
-	costSum += size;
-	bd = bd->link;
-    }
-
-    return costSum;
-}
-
-static nat
-checkHeapSanityForRetainerProfiling( void )
-{
-    nat costSum, g, s;
-
-    costSum = 0;
-    debugBelch("START: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
-    if (RtsFlags.GcFlags.generations == 1) {
-	costSum += heapCheck(g0s0->to_blocks);
-	debugBelch("heapCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
-	costSum += chainCheck(g0s0->large_objects);
-	debugBelch("chainCheck: sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
-    } else {
-	for (g = 0; g < RtsFlags.GcFlags.generations; g++)
-	for (s = 0; s < generations[g].n_steps; s++) {
-	    /*
-	      After all live objects have been scavenged, the garbage
-	      collector may create some objects in
-	      scheduleFinalizers(). These objects are created throught
-	      allocate(), so the small object pool or the large object
-	      pool of the g0s0 may not be empty.
-	    */
-	    if (g == 0 && s == 0) {
-		costSum += smallObjectPoolCheck();
-		debugBelch("smallObjectPoolCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
-		costSum += chainCheck(generations[g].steps[s].large_objects);
-		debugBelch("chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
-	    } else {
-		costSum += heapCheck(generations[g].steps[s].blocks);
-		debugBelch("heapCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
-		costSum += chainCheck(generations[g].steps[s].large_objects);
-		debugBelch("chainCheck(): sumOfCostLinear = %d, costSum = %d\n", sumOfCostLinear, costSum);
-	    }
-	}
-    }
-
-    return costSum;
-}
-
-void
-findPointer(StgPtr p)
-{
-    StgPtr q, r, e;
-    bdescr *bd;
-    nat g, s;
-
-    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	for (s = 0; s < generations[g].n_steps; s++) {
-	    // if (g == 0 && s == 0) continue;
-	    bd = generations[g].steps[s].blocks;
-	    for (; bd; bd = bd->link) {
-		for (q = bd->start; q < bd->free; q++) {
-		    if (*q == (StgWord)p) {
-			r = q;
-			while (!LOOKS_LIKE_GHC_INFO(*r)) r--;
-			debugBelch("Found in gen[%d], step[%d]: q = %p, r = %p\n", g, s, q, r);
-			// return;
-		    }
-		}
-	    }
-	    bd = generations[g].steps[s].large_objects;
-	    for (; bd; bd = bd->link) {
-		e = bd->start + cost((StgClosure *)bd->start);
-		for (q = bd->start; q < e; q++) {
-		    if (*q == (StgWord)p) {
-			r = q;
-			while (*r == 0 || !LOOKS_LIKE_GHC_INFO(*r)) r--;
-			debugBelch("Found in gen[%d], large_objects: %p\n", g, r);
-			// return;
-		    }
-		}
-	    }
-	}
-    }
-}
-
-static void
-belongToHeap(StgPtr p)
-{
-    bdescr *bd;
-    nat g, s;
-
-    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	for (s = 0; s < generations[g].n_steps; s++) {
-	    // if (g == 0 && s == 0) continue;
-	    bd = generations[g].steps[s].blocks;
-	    for (; bd; bd = bd->link) {
-		if (bd->start <= p && p < bd->free) {
-		    debugBelch("Belongs to gen[%d], step[%d]", g, s);
-		    return;
-		}
-	    }
-	    bd = generations[g].steps[s].large_objects;
-	    for (; bd; bd = bd->link) {
-		if (bd->start <= p && p < bd->start + getHeapClosureSize((StgClosure *)bd->start)) {
-		    debugBelch("Found in gen[%d], large_objects: %p\n", g, bd->start);
-		    return;
-		}
-	    }
-	}
-    }
-}
-#endif /* DEBUG_RETAINER */
-
-#endif /* PROFILING */
diff --git a/ghc/rts/RetainerProfile.h b/ghc/rts/RetainerProfile.h
deleted file mode 100644
index 827daa8ef4..0000000000
--- a/ghc/rts/RetainerProfile.h
+++ /dev/null
@@ -1,47 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2001
- * Author: Sungwoo Park
- *
- * Retainer profiling interface.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef RETAINERPROFILE_H
-#define RETAINERPROFILE_H
-
-#ifdef PROFILING
-
-#include "RetainerSet.h"
-
-extern void  initRetainerProfiling ( void );
-extern void  endRetainerProfiling  ( void );
-extern void  printRetainer         ( FILE *, retainer );
-extern void  retainerProfile       ( void );
-extern void  resetStaticObjectForRetainerProfiling ( void );
-
-extern StgWord RTS_VAR(flip);
-
-// extract the retainer set field from c
-#define RSET(c)   ((c)->header.prof.hp.rs)
-
-#define isRetainerSetFieldValid(c) \
-  ((((StgWord)(c)->header.prof.hp.rs & 1) ^ flip) == 0)
-
-static inline RetainerSet *
-retainerSetOf( StgClosure *c )
-{
-    ASSERT( isRetainerSetFieldValid(c) );
-    // StgWord has the same size as pointers, so the following type
-    // casting is okay.
-    return (RetainerSet *)((StgWord)RSET(c) ^ flip);
-}
-
-// Used by Storage.c:memInventory()
-#ifdef DEBUG
-extern lnat retainerStackBlocks ( void );
-#endif
-
-#endif /* PROFILING */
-
-#endif /* RETAINERPROFILE_H */
diff --git a/ghc/rts/RetainerSet.c b/ghc/rts/RetainerSet.c
deleted file mode 100644
index bfa0bc8acf..0000000000
--- a/ghc/rts/RetainerSet.c
+++ /dev/null
@@ -1,498 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2001
- * Author: Sungwoo Park
- *
- * Retainer set implementation for retainer profiling (see RetainerProfile.c)
- *
- * ---------------------------------------------------------------------------*/
-
-#ifdef PROFILING
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "Stats.h"
-#include "RtsUtils.h"
-#include "RetainerSet.h"
-#include "Arena.h"
-#include "Profiling.h"
-
-#include <stdlib.h>
-#include <string.h>
-
-#define HASH_TABLE_SIZE 255
-#define hash(hk)  (hk % HASH_TABLE_SIZE)
-static RetainerSet *hashTable[HASH_TABLE_SIZE];
-
-static Arena *arena;		// arena in which we store retainer sets
-
-static int nextId;              // id of next retainer set       
-
-/* -----------------------------------------------------------------------------
- * rs_MANY is a distinguished retainer set, such that
- *
- *        isMember(e, rs_MANY)   = True
- *
- *	  addElement(e, rs)      = rs_MANY,   if rs->num >= maxRetainerSetSize
- *	  addElement(e, rs_MANY) = rs_MANY
- *
- * The point of rs_MANY is to keep the total number of retainer sets
- * from growing too large.
- * -------------------------------------------------------------------------- */
-RetainerSet rs_MANY = {
-    num : 0,
-    hashKey : 0,
-    link : NULL,
-    id : 1,
-    element : {}
-};
-
-/* -----------------------------------------------------------------------------
- * calculate the size of a RetainerSet structure
- * -------------------------------------------------------------------------- */
-STATIC_INLINE size_t
-sizeofRetainerSet( int elems )
-{
-    return (sizeof(RetainerSet) + elems * sizeof(retainer));
-}
-
-/* -----------------------------------------------------------------------------
- * Creates the first pool and initializes hashTable[].
- * Frees all pools if any.
- * -------------------------------------------------------------------------- */
-void
-initializeAllRetainerSet(void)
-{
-    int i;
-
-    arena = newArena();
-
-    for (i = 0; i < HASH_TABLE_SIZE; i++)
-	hashTable[i] = NULL;
-    nextId = 2;   // Initial value must be positive, 2 is MANY.
-}
-
-/* -----------------------------------------------------------------------------
- * Refreshes all pools for reuse and initializes hashTable[].
- * -------------------------------------------------------------------------- */
-void
-refreshAllRetainerSet(void)
-{
-#ifdef FIRST_APPROACH
-    int i;
-
-    // first approach: completely refresh
-    arenaFree(arena);
-    arena = newArena();
-
-    for (i = 0; i < HASH_TABLE_SIZE; i++)
-	hashTable[i] = NULL;
-    nextId = 2;
-#endif /* FIRST_APPROACH */
-}
-
-/* -----------------------------------------------------------------------------
- * Frees all pools.
- * -------------------------------------------------------------------------- */
-void
-closeAllRetainerSet(void)
-{
-    arenaFree(arena);
-}
-
-/* -----------------------------------------------------------------------------
- *  Finds or creates if needed a singleton retainer set.
- * -------------------------------------------------------------------------- */
-RetainerSet *
-singleton(retainer r)
-{
-    RetainerSet *rs;
-    StgWord hk;
-
-    hk = hashKeySingleton(r);
-    for (rs = hashTable[hash(hk)]; rs != NULL; rs = rs->link)
-	if (rs->num == 1 &&  rs->element[0] == r) return rs;    // found it
-
-    // create it
-    rs = arenaAlloc( arena, sizeofRetainerSet(1) );
-    rs->num = 1;
-    rs->hashKey = hk;
-    rs->link = hashTable[hash(hk)];
-    rs->id = nextId++;
-    rs->element[0] = r;
-
-    // The new retainer set is placed at the head of the linked list.
-    hashTable[hash(hk)] = rs;
-
-    return rs;
-}
-
-/* -----------------------------------------------------------------------------
- *   Finds or creates a retainer set *rs augmented with r.
- *   Invariants:
- *     r is not a member of rs, i.e., isMember(r, rs) returns rtsFalse.
- *     rs is not NULL.
- *   Note:
- *     We could check if rs is NULL, in which case this function call
- *     reverts to singleton(). We do not choose this strategy because
- *     in most cases addElement() is invoked with non-NULL rs.
- * -------------------------------------------------------------------------- */
-RetainerSet *
-addElement(retainer r, RetainerSet *rs)
-{
-    nat i;
-    nat nl;             // Number of retainers in *rs Less than r
-    RetainerSet *nrs;   // New Retainer Set
-    StgWord hk;         // Hash Key
-
-#ifdef DEBUG_RETAINER
-    // debugBelch("addElement(%p, %p) = ", r, rs);
-#endif
-
-    ASSERT(rs != NULL);
-    ASSERT(rs->num <= RtsFlags.ProfFlags.maxRetainerSetSize);
-
-    if (rs == &rs_MANY || rs->num == RtsFlags.ProfFlags.maxRetainerSetSize) {
-	return &rs_MANY;
-    }
-
-    ASSERT(!isMember(r, rs));
-
-    for (nl = 0; nl < rs->num; nl++)
-	if (r < rs->element[nl]) break;
-    // Now nl is the index for r into the new set.
-    // Also it denotes the number of retainers less than r in *rs.
-    // Thus, compare the first nl retainers, then r itself, and finally the
-    // remaining (rs->num - nl) retainers.
-
-    hk = hashKeyAddElement(r, rs);
-    for (nrs = hashTable[hash(hk)]; nrs != NULL; nrs = nrs->link) {
-	// test *rs and *nrs for equality
-
-	// check their size
-	if (rs->num + 1 != nrs->num) continue;
-
-	// compare the first nl retainers and find the first non-matching one.
-	for (i = 0; i < nl; i++)
-	    if (rs->element[i] != nrs->element[i]) break;
-	if (i < nl) continue;
-
-	// compare r itself
-	if (r != nrs->element[i]) continue;       // i == nl
-
-	// compare the remaining retainers
-	for (; i < rs->num; i++)
-	    if (rs->element[i] != nrs->element[i + 1]) break;
-	if (i < rs->num) continue;
-
-#ifdef DEBUG_RETAINER
-	// debugBelch("%p\n", nrs);
-#endif
-	// The set we are seeking already exists!
-	return nrs;
-    }
-
-    // create a new retainer set
-    nrs = arenaAlloc( arena, sizeofRetainerSet(rs->num + 1) );
-    nrs->num = rs->num + 1;
-    nrs->hashKey = hk;
-    nrs->link = hashTable[hash(hk)];
-    nrs->id = nextId++;
-    for (i = 0; i < nl; i++) {              // copy the first nl retainers
-	nrs->element[i] = rs->element[i];
-    }
-    nrs->element[i] = r;                    // copy r
-    for (; i < rs->num; i++) {              // copy the remaining retainers
-	nrs->element[i + 1] = rs->element[i];
-    }
-
-    hashTable[hash(hk)] = nrs;
-
-#ifdef DEBUG_RETAINER
-    // debugBelch("%p\n", nrs);
-#endif
-    return nrs;
-}
-
-/* -----------------------------------------------------------------------------
- *  Call f() for each retainer set.
- * -------------------------------------------------------------------------- */
-void
-traverseAllRetainerSet(void (*f)(RetainerSet *))
-{
-    int i;
-    RetainerSet *rs;
-
-    (*f)(&rs_MANY);
-    for (i = 0; i < HASH_TABLE_SIZE; i++)
-	for (rs = hashTable[i]; rs != NULL; rs = rs->link)
-	    (*f)(rs);
-}
-
-
-/* -----------------------------------------------------------------------------
- *  printRetainer() prints the full information on a given retainer,
- *  not a retainer set.
- * -------------------------------------------------------------------------- */
-#if defined(RETAINER_SCHEME_INFO)
-// Retainer scheme 1: retainer = info table
-void
-printRetainer(FILE *f, retainer itbl)
-{
-    fprintf(f, "%s[%s]", itbl->prof.closure_desc, itbl->prof.closure_type);
-}
-#elif defined(RETAINER_SCHEME_CCS)
-// Retainer scheme 2: retainer = cost centre stack
-void
-printRetainer(FILE *f, retainer ccs)
-{
-    fprintCCS(f, ccs);
-}
-#elif defined(RETAINER_SCHEME_CC)
-// Retainer scheme 3: retainer = cost centre
-void
-printRetainer(FILE *f, retainer cc)
-{
-    fprintf(f,"%s.%s", cc->module, cc->label);
-}
-#endif
-
-/* -----------------------------------------------------------------------------
- *  printRetainerSetShort() should always display the same output for
- *  a given retainer set regardless of the time of invocation.
- * -------------------------------------------------------------------------- */
-#ifdef SECOND_APPROACH
-#if defined(RETAINER_SCHEME_INFO)
-// Retainer scheme 1: retainer = info table
-void
-printRetainerSetShort(FILE *f, RetainerSet *rs)
-{
-#define MAX_RETAINER_SET_SPACE  24
-    char tmp[MAX_RETAINER_SET_SPACE + 1];
-    int size;
-    nat j;
-
-    ASSERT(rs->id < 0);
-
-    tmp[MAX_RETAINER_SET_SPACE] = '\0';
-
-    // No blank characters are allowed.
-    sprintf(tmp + 0, "(%d)", -(rs->id));
-    size = strlen(tmp);
-    ASSERT(size < MAX_RETAINER_SET_SPACE);
-
-    for (j = 0; j < rs->num; j++) {
-	if (j < rs->num - 1) {
-	    strncpy(tmp + size, rs->element[j]->prof.closure_desc, MAX_RETAINER_SET_SPACE - size);
-	    size = strlen(tmp);
-	    if (size == MAX_RETAINER_SET_SPACE)
-		break;
-	    strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
-	    size = strlen(tmp);
-	    if (size == MAX_RETAINER_SET_SPACE)
-		break;
-	}
-	else {
-	    strncpy(tmp + size, rs->element[j]->prof.closure_desc, MAX_RETAINER_SET_SPACE - size);
-	    // size = strlen(tmp);
-	}
-    }
-    fprintf(f, tmp);
-}
-#elif defined(RETAINER_SCHEME_CC)
-// Retainer scheme 3: retainer = cost centre
-void
-printRetainerSetShort(FILE *f, RetainerSet *rs)
-{
-#define MAX_RETAINER_SET_SPACE  24
-    char tmp[MAX_RETAINER_SET_SPACE + 1];
-    int size;
-    nat j;
-
-}
-#elif defined(RETAINER_SCHEME_CCS)
-// Retainer scheme 2: retainer = cost centre stack
-void
-printRetainerSetShort(FILE *f, RetainerSet *rs)
-{
-#define MAX_RETAINER_SET_SPACE  24
-    char tmp[MAX_RETAINER_SET_SPACE + 1];
-    int size;
-    nat j;
-
-    ASSERT(rs->id < 0);
-
-    tmp[MAX_RETAINER_SET_SPACE] = '\0';
-
-    // No blank characters are allowed.
-    sprintf(tmp + 0, "(%d)", -(rs->id));
-    size = strlen(tmp);
-    ASSERT(size < MAX_RETAINER_SET_SPACE);
-
-    for (j = 0; j < rs->num; j++) {
-	if (j < rs->num - 1) {
-	    strncpy(tmp + size, rs->element[j]->cc->label, MAX_RETAINER_SET_SPACE - size);
-	    size = strlen(tmp);
-	    if (size == MAX_RETAINER_SET_SPACE)
-		break;
-	    strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
-	    size = strlen(tmp);
-	    if (size == MAX_RETAINER_SET_SPACE)
-		break;
-	}
-	else {
-	    strncpy(tmp + size, rs->element[j]->cc->label, MAX_RETAINER_SET_SPACE - size);
-	    // size = strlen(tmp);
-	}
-    }
-    fprintf(f, tmp);
-}
-#elif defined(RETAINER_SCHEME_CC)
-// Retainer scheme 3: retainer = cost centre
-static void
-printRetainerSetShort(FILE *f, retainerSet *rs)
-{
-#define MAX_RETAINER_SET_SPACE  24
-    char tmp[MAX_RETAINER_SET_SPACE + 1];
-    int size;
-    nat j;
-
-    ASSERT(rs->id < 0);
-
-    tmp[MAX_RETAINER_SET_SPACE] = '\0';
-
-    // No blank characters are allowed.
-    sprintf(tmp + 0, "(%d)", -(rs->id));
-    size = strlen(tmp);
-    ASSERT(size < MAX_RETAINER_SET_SPACE);
-
-    for (j = 0; j < rs->num; j++) {
-	if (j < rs->num - 1) {
-	    strncpy(tmp + size, rs->element[j]->label,
-		    MAX_RETAINER_SET_SPACE - size);
-	    size = strlen(tmp);
-	    if (size == MAX_RETAINER_SET_SPACE)
-		break;
-	    strncpy(tmp + size, ",", MAX_RETAINER_SET_SPACE - size);
-	    size = strlen(tmp);
-	    if (size == MAX_RETAINER_SET_SPACE)
-		break;
-	}
-	else {
-	    strncpy(tmp + size, rs->element[j]->label,
-		    MAX_RETAINER_SET_SPACE - size);
-	    // size = strlen(tmp);
-	}
-    }
-    fprintf(f, tmp);
-/*
-  #define MAX_RETAINER_SET_SPACE  24
-  #define DOT_NUMBER              3
-  // 1. 32 > MAX_RETAINER_SET_SPACE + 1 (1 for '\0')
-  // 2. (MAX_RETAINER_SET_SPACE - DOT_NUMBER ) characters should be enough for
-  //    printing one natural number (plus '(' and ')').
-  char tmp[32];
-  int size, ts;
-  nat j;
-
-  ASSERT(rs->id < 0);
-
-  // No blank characters are allowed.
-  sprintf(tmp + 0, "(%d)", -(rs->id));
-  size = strlen(tmp);
-  ASSERT(size < MAX_RETAINER_SET_SPACE - DOT_NUMBER);
-
-  for (j = 0; j < rs->num; j++) {
-    ts = strlen(rs->element[j]->label);
-    if (j < rs->num - 1) {
-      if (size + ts + 1 > MAX_RETAINER_SET_SPACE - DOT_NUMBER) {
-        sprintf(tmp + size, "...");
-        break;
-      }
-      sprintf(tmp + size, "%s,", rs->element[j]->label);
-      size += ts + 1;
-    }
-    else {
-      if (size + ts > MAX_RETAINER_SET_SPACE - DOT_NUMBER) {
-        sprintf(tmp + size, "...");
-        break;
-      }
-      sprintf(tmp + size, "%s", rs->element[j]->label);
-      size += ts;
-    }
-  }
-  fprintf(f, tmp);
-*/
-}
-#endif /* RETAINER_SCHEME_CC */
-#endif /* SECOND_APPROACH */
-
-/* -----------------------------------------------------------------------------
- * Dump the contents of each retainer set into the log file at the end
- * of the run, so the user can find out for a given retainer set ID
- * the full contents of that set.
- * --------------------------------------------------------------------------- */
-#ifdef SECOND_APPROACH
-void
-outputAllRetainerSet(FILE *prof_file)
-{
-    nat i, j;
-    nat numSet;
-    RetainerSet *rs, **rsArray, *tmp;
-
-    // find out the number of retainer sets which have had a non-zero cost at
-    // least once during retainer profiling
-    numSet = 0;
-    for (i = 0; i < HASH_TABLE_SIZE; i++)
-	for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
-	    if (rs->id < 0)
-		numSet++;
-	}
-
-    if (numSet == 0)      // retainer profiling was not done at all.
-	return;
-
-    // allocate memory
-    rsArray = stgMallocBytes(numSet * sizeof(RetainerSet *),
-			     "outputAllRetainerSet()");
-
-    // prepare for sorting
-    j = 0;
-    for (i = 0; i < HASH_TABLE_SIZE; i++)
-	for (rs = hashTable[i]; rs != NULL; rs = rs->link) {
-	    if (rs->id < 0) {
-		rsArray[j] = rs;
-		j++;
-	    }
-	}
-
-    ASSERT(j == numSet);
-
-    // sort rsArray[] according to the id of each retainer set
-    for (i = numSet - 1; i > 0; i--) {
-	for (j = 0; j <= i - 1; j++) {
-	    // if (-(rsArray[j]->id) < -(rsArray[j + 1]->id))
-	    if (rsArray[j]->id < rsArray[j + 1]->id) {
-		tmp = rsArray[j];
-		rsArray[j] = rsArray[j + 1];
-		rsArray[j + 1] = tmp;
-	    }
-	}
-    }
-
-    fprintf(prof_file, "\nRetainer sets created during profiling:\n");
-    for (i = 0;i < numSet; i++) {
-	fprintf(prof_file, "SET %u = {", -(rsArray[i]->id));
-	for (j = 0; j < rsArray[i]->num - 1; j++) {
-	    printRetainer(prof_file, rsArray[i]->element[j]);
-	    fprintf(prof_file, ", ");
-	}
-	printRetainer(prof_file, rsArray[i]->element[j]);
-	fprintf(prof_file, "}\n");
-    }
-
-    stgFree(rsArray);
-}
-#endif /* SECOND_APPROACH */
-
-#endif /* PROFILING */
diff --git a/ghc/rts/RetainerSet.h b/ghc/rts/RetainerSet.h
deleted file mode 100644
index 6a00e1395e..0000000000
--- a/ghc/rts/RetainerSet.h
+++ /dev/null
@@ -1,201 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2001
- * Author: Sungwoo Park
- *
- * Retainer set interface for retainer profiling.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef RETAINERSET_H
-#define RETAINERSET_H
-
-#include <stdio.h>
-
-#ifdef PROFILING
-
-/*
-  Type 'retainer' defines the retainer identity.
-
-  Invariant:
-    1. The retainer identity of a given retainer cannot change during 
-    program execution, no matter where it is actually stored.
-    For instance, the memory address of a retainer cannot be used as
-    its retainer identity because its location may change during garbage
-    collections.
-    2. Type 'retainer' must come with comparison operations as well as
-    an equality operation. That it, <, >, and == must be supported -
-    this is necessary to store retainers in a sorted order in retainer sets.
-    Therefore, you cannot use a huge structure type as 'retainer', for instance.
-
-  We illustrate three possibilities of defining 'retainer identity'.
-  Choose one of the following three compiler directives:
-
-   Retainer scheme 1 (RETAINER_SCHEME_INFO) : retainer = info table
-   Retainer scheme 2 (RETAINER_SCHEME_CCS)  : retainer = cost centre stack
-   Retainer scheme 3 (RETAINER_SCHEME_CC)   : retainer = cost centre
-*/
-
-// #define RETAINER_SCHEME_INFO
-#define RETAINER_SCHEME_CCS
-// #define RETAINER_SCHEME_CC
-
-#ifdef RETAINER_SCHEME_INFO
-struct _StgInfoTable;
-typedef struct _StgInfoTable *retainer;
-#endif
-
-#ifdef RETAINER_SCHEME_CCS
-typedef CostCentreStack *retainer;
-#endif
-
-#ifdef RETAINER_SCHEME_CC
-typedef CostCentre *retainer;
-#endif
-
-/*
-  Type 'retainerSet' defines an abstract datatype for sets of retainers.  
-
-  Invariants:
-    A retainer set stores its elements in increasing order (in element[] array).
- */
-
-typedef struct _RetainerSet {
-  nat num;                      // number of elements
-  StgWord hashKey;              // hash key for this retainer set
-  struct _RetainerSet *link;    // link to the next retainer set in the bucket
-  int id;   // unique id of this retainer set (used when printing)
-            // Its absolute value is interpreted as its true id; if id is
-            // negative, it indicates that this retainer set has had a postive
-            // cost after some retainer profiling.
-  retainer element[0];          // elements of this retainer set
-  // do not put anything below here!
-} RetainerSet;
-
-/*
-  Note: 
-    There are two ways of maintaining all retainer sets. The first is simply by
-    freeing all the retainer sets and re-initialize the hash table at each
-    retainer profiling. The second is by setting the cost field of each 
-    retainer set. The second is preferred to the first if most retainer sets 
-    are likely to be observed again during the next retainer profiling. Note 
-    that in the first approach, we do not free the memory allocated for 
-    retainer sets; we just invalidate all retainer sets.
- */
-#ifdef DEBUG_RETAINER
-// In thise case, FIRST_APPROACH must be turned on because the memory pool
-// for retainer sets is freed each time.
-#define FIRST_APPROACH
-#else
-// #define FIRST_APPROACH
-#define SECOND_APPROACH
-#endif
-
-// Creates the first pool and initializes a hash table. Frees all pools if any.
-void initializeAllRetainerSet(void);
-
-// Refreshes all pools for reuse and initializes a hash table.
-void refreshAllRetainerSet(void);
-
-// Frees all pools.
-void closeAllRetainerSet(void);
-
-// Finds or creates if needed a singleton retainer set.
-RetainerSet *singleton(retainer r);
-
-extern RetainerSet rs_MANY;
-
-// Checks if a given retainer is a memeber of the retainer set.
-// 
-// Note & (maybe) Todo:
-//   This function needs to be declared as an inline function, so it is declared
-//   as an inline static function here.
-//   This make the interface really bad, but isMember() returns a value, so
-//   it is not easy either to write it as a macro (due to my lack of C 
-//   programming experience). Sungwoo
-//
-// rtsBool isMember(retainer, retainerSet *);
-/*
-  Returns rtsTrue if r is a member of *rs.
-  Invariants:
-    rs is not NULL.
-  Note:
-    The efficiency of this function is subject to the typical size of
-    retainer sets. If it is small, linear scan is better. If it
-    is large in most cases, binary scan is better. 
-    The current implementation mixes the two search strategies.
- */
-
-#define BINARY_SEARCH_THRESHOLD   8
-INLINE_HEADER rtsBool
-isMember(retainer r, RetainerSet *rs)
-{
-  int i, left, right;       // must be int, not nat (because -1 can appear)
-  retainer ri;
-
-  if (rs == &rs_MANY) { return rtsTrue; }
-
-  if (rs->num < BINARY_SEARCH_THRESHOLD) {
-    for (i = 0; i < (int)rs->num; i++) {
-      ri = rs->element[i];
-      if (r == ri) return rtsTrue;
-      else if (r < ri) return rtsFalse;
-    }
-  } else {
-    left = 0;
-    right = rs->num - 1;
-    while (left <= right) {
-      i = (left + right) / 2;
-      ri = rs->element[i];
-      if (r == ri) return rtsTrue;
-      else if (r < ri) right = i - 1;
-      else left = i + 1;
-    }
-  }
-  return rtsFalse;
-}
-
-// Finds or creates a retainer set augmented with a new retainer.
-RetainerSet *addElement(retainer, RetainerSet *);
-
-// Call f() for each retainer set.
-void traverseAllRetainerSet(void (*f)(RetainerSet *));
-
-#ifdef SECOND_APPROACH
-// Prints a single retainer set.
-void printRetainerSetShort(FILE *, RetainerSet *);
-#endif
-
-// Print the statistics on all the retainer sets.
-// store the sum of all costs and the number of all retainer sets. 
-void outputRetainerSet(FILE *, nat *, nat *);
-
-#ifdef SECOND_APPROACH
-// Print all retainer sets at the exit of the program.
-void outputAllRetainerSet(FILE *);
-#endif
-
-// Hashing functions
-/*
-  Invariants:
-    Once either initializeAllRetainerSet() or refreshAllRetainerSet()
-    is called, there exists only one copy of any retainer set created
-    through singleton() and addElement().  The pool (the storage for
-    retainer sets) is consumed linearly.  All the retainer sets of the
-    same hash function value are linked together from an element in
-    hashTable[].  See the invariants of allocateInPool() for the
-    maximum size of retainer sets.  The hashing function is defined by
-    hashKeySingleton() and hashKeyAddElement(). The hash key for a set
-    must be unique regardless of the order its elements are inserted,
-    i.e., the hashing function must be additive(?).
-*/
-#define hashKeySingleton(r)       ((StgWord)(r))
-#define hashKeyAddElement(r, s)   (hashKeySingleton((r)) + (s)->hashKey)
-
-// Prints the full information on a given retainer.
-// Note: This function is not part of retainerSet interface, but this is
-//       the best place to define it.
-void printRetainer(FILE *, retainer);
-
-#endif /* PROFILING */
-#endif /* RETAINERSET_H */
diff --git a/ghc/rts/RtsAPI.c b/ghc/rts/RtsAPI.c
deleted file mode 100644
index b1b1d9c52d..0000000000
--- a/ghc/rts/RtsAPI.c
+++ /dev/null
@@ -1,597 +0,0 @@
-/* ----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2001
- *
- * API for invoking Haskell functions via the RTS
- *
- * --------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "OSThreads.h"
-#include "Storage.h"
-#include "RtsAPI.h"
-#include "SchedAPI.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "Prelude.h"
-#include "Schedule.h"
-#include "Capability.h"
-
-#include <stdlib.h>
-
-/* ----------------------------------------------------------------------------
-   Building Haskell objects from C datatypes.
-   ------------------------------------------------------------------------- */
-HaskellObj
-rts_mkChar (Capability *cap, HsChar c)
-{
-  StgClosure *p = (StgClosure *)allocateLocal(cap, CONSTR_sizeW(0,1));
-  SET_HDR(p, Czh_con_info, CCS_SYSTEM);
-  p->payload[0]  = (StgClosure *)(StgWord)(StgChar)c;
-  return p;
-}
-
-HaskellObj
-rts_mkInt (Capability *cap, HsInt i)
-{
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
-  SET_HDR(p, Izh_con_info, CCS_SYSTEM);
-  p->payload[0]  = (StgClosure *)(StgInt)i;
-  return p;
-}
-
-HaskellObj
-rts_mkInt8 (Capability *cap, HsInt8 i)
-{
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
-  SET_HDR(p, I8zh_con_info, CCS_SYSTEM);
-  /* Make sure we mask out the bits above the lowest 8 */
-  p->payload[0]  = (StgClosure *)(StgInt)((unsigned)i & 0xff);
-  return p;
-}
-
-HaskellObj
-rts_mkInt16 (Capability *cap, HsInt16 i)
-{
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
-  SET_HDR(p, I16zh_con_info, CCS_SYSTEM);
-  /* Make sure we mask out the relevant bits */
-  p->payload[0]  = (StgClosure *)(StgInt)((unsigned)i & 0xffff);
-  return p;
-}
-
-HaskellObj
-rts_mkInt32 (Capability *cap, HsInt32 i)
-{
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
-  SET_HDR(p, I32zh_con_info, CCS_SYSTEM);
-  p->payload[0]  = (StgClosure *)(StgInt)((unsigned)i & 0xffffffff);
-  return p;
-}
-
-HaskellObj
-rts_mkInt64 (Capability *cap, HsInt64 i)
-{
-  llong *tmp;
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,2));
-  SET_HDR(p, I64zh_con_info, CCS_SYSTEM);
-  tmp  = (llong*)&(p->payload[0]);
-  *tmp = (StgInt64)i;
-  return p;
-}
-
-HaskellObj
-rts_mkWord (Capability *cap, HsWord i)
-{
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
-  SET_HDR(p, Wzh_con_info, CCS_SYSTEM);
-  p->payload[0]  = (StgClosure *)(StgWord)i;
-  return p;
-}
-
-HaskellObj
-rts_mkWord8 (Capability *cap, HsWord8 w)
-{
-  /* see rts_mkInt* comments */
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
-  SET_HDR(p, W8zh_con_info, CCS_SYSTEM);
-  p->payload[0]  = (StgClosure *)(StgWord)(w & 0xff);
-  return p;
-}
-
-HaskellObj
-rts_mkWord16 (Capability *cap, HsWord16 w)
-{
-  /* see rts_mkInt* comments */
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
-  SET_HDR(p, W16zh_con_info, CCS_SYSTEM);
-  p->payload[0]  = (StgClosure *)(StgWord)(w & 0xffff);
-  return p;
-}
-
-HaskellObj
-rts_mkWord32 (Capability *cap, HsWord32 w)
-{
-  /* see rts_mkInt* comments */
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
-  SET_HDR(p, W32zh_con_info, CCS_SYSTEM);
-  p->payload[0]  = (StgClosure *)(StgWord)(w & 0xffffffff);
-  return p;
-}
-
-HaskellObj
-rts_mkWord64 (Capability *cap, HsWord64 w)
-{
-  ullong *tmp;
-
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,2));
-  /* see mk_Int8 comment */
-  SET_HDR(p, W64zh_con_info, CCS_SYSTEM);
-  tmp  = (ullong*)&(p->payload[0]);
-  *tmp = (StgWord64)w;
-  return p;
-}
-
-HaskellObj
-rts_mkFloat (Capability *cap, HsFloat f)
-{
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,1));
-  SET_HDR(p, Fzh_con_info, CCS_SYSTEM);
-  ASSIGN_FLT((P_)p->payload, (StgFloat)f);
-  return p;
-}
-
-HaskellObj
-rts_mkDouble (Capability *cap, HsDouble d)
-{
-  StgClosure *p = (StgClosure *)allocateLocal(cap,CONSTR_sizeW(0,sizeofW(StgDouble)));
-  SET_HDR(p, Dzh_con_info, CCS_SYSTEM);
-  ASSIGN_DBL((P_)p->payload, (StgDouble)d);
-  return p;
-}
-
-HaskellObj
-rts_mkStablePtr (Capability *cap, HsStablePtr s)
-{
-  StgClosure *p = (StgClosure *)allocateLocal(cap,sizeofW(StgHeader)+1);
-  SET_HDR(p, StablePtr_con_info, CCS_SYSTEM);
-  p->payload[0]  = (StgClosure *)s;
-  return p;
-}
-
-HaskellObj
-rts_mkPtr (Capability *cap, HsPtr a)
-{
-  StgClosure *p = (StgClosure *)allocateLocal(cap,sizeofW(StgHeader)+1);
-  SET_HDR(p, Ptr_con_info, CCS_SYSTEM);
-  p->payload[0]  = (StgClosure *)a;
-  return p;
-}
-
-HaskellObj
-rts_mkFunPtr (Capability *cap, HsFunPtr a)
-{
-  StgClosure *p = (StgClosure *)allocateLocal(cap,sizeofW(StgHeader)+1);
-  SET_HDR(p, FunPtr_con_info, CCS_SYSTEM);
-  p->payload[0]  = (StgClosure *)a;
-  return p;
-}
-
-HaskellObj
-rts_mkBool (Capability *cap STG_UNUSED, HsBool b)
-{
-  if (b) {
-    return (StgClosure *)True_closure;
-  } else {
-    return (StgClosure *)False_closure;
-  }
-}
-
-HaskellObj
-rts_mkString (Capability *cap, char *s)
-{
-  return rts_apply(cap, (StgClosure *)unpackCString_closure, rts_mkPtr(cap,s));
-}
-
-HaskellObj
-rts_apply (Capability *cap, HaskellObj f, HaskellObj arg)
-{
-    StgThunk *ap;
-
-    ap = (StgThunk *)allocateLocal(cap,sizeofW(StgThunk) + 2);
-    SET_HDR(ap, (StgInfoTable *)&stg_ap_2_upd_info, CCS_SYSTEM);
-    ap->payload[0] = f;
-    ap->payload[1] = arg;
-    return (StgClosure *)ap;
-}
-
-/* ----------------------------------------------------------------------------
-   Deconstructing Haskell objects
-
-   We would like to assert that we have the right kind of object in
-   each case, but this is problematic because in GHCi the info table
-   for the D# constructor (say) might be dynamically loaded.  Hence we
-   omit these assertions for now.
-   ------------------------------------------------------------------------- */
-
-HsChar
-rts_getChar (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == Czh_con_info ||
-    //        p->header.info == Czh_static_info);
-    return (StgChar)(StgWord)(p->payload[0]);
-}
-
-HsInt
-rts_getInt (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == Izh_con_info ||
-    //        p->header.info == Izh_static_info);
-    return (HsInt)(p->payload[0]);
-}
-
-HsInt8
-rts_getInt8 (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == I8zh_con_info ||
-    //        p->header.info == I8zh_static_info);
-    return (HsInt8)(HsInt)(p->payload[0]);
-}
-
-HsInt16
-rts_getInt16 (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == I16zh_con_info ||
-    //        p->header.info == I16zh_static_info);
-    return (HsInt16)(HsInt)(p->payload[0]);
-}
-
-HsInt32
-rts_getInt32 (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == I32zh_con_info ||
-    //        p->header.info == I32zh_static_info);
-    return (HsInt32)(HsInt)(p->payload[0]);
-}
-
-HsInt64
-rts_getInt64 (HaskellObj p)
-{
-    HsInt64* tmp;
-    // See comment above:
-    // ASSERT(p->header.info == I64zh_con_info ||
-    //        p->header.info == I64zh_static_info);
-    tmp = (HsInt64*)&(p->payload[0]);
-    return *tmp;
-}
-HsWord
-rts_getWord (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == Wzh_con_info ||
-    //        p->header.info == Wzh_static_info);
-    return (HsWord)(p->payload[0]);
-}
-
-HsWord8
-rts_getWord8 (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == W8zh_con_info ||
-    //        p->header.info == W8zh_static_info);
-    return (HsWord8)(HsWord)(p->payload[0]);
-}
-
-HsWord16
-rts_getWord16 (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == W16zh_con_info ||
-    //        p->header.info == W16zh_static_info);
-    return (HsWord16)(HsWord)(p->payload[0]);
-}
-
-HsWord32
-rts_getWord32 (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == W32zh_con_info ||
-    //        p->header.info == W32zh_static_info);
-    return (HsWord32)(HsWord)(p->payload[0]);
-}
-
-
-HsWord64
-rts_getWord64 (HaskellObj p)
-{
-    HsWord64* tmp;
-    // See comment above:
-    // ASSERT(p->header.info == W64zh_con_info ||
-    //        p->header.info == W64zh_static_info);
-    tmp = (HsWord64*)&(p->payload[0]);
-    return *tmp;
-}
-
-HsFloat
-rts_getFloat (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == Fzh_con_info ||
-    //        p->header.info == Fzh_static_info);
-    return (float)(PK_FLT((P_)p->payload));
-}
-
-HsDouble
-rts_getDouble (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == Dzh_con_info ||
-    //        p->header.info == Dzh_static_info);
-    return (double)(PK_DBL((P_)p->payload));
-}
-
-HsStablePtr
-rts_getStablePtr (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == StablePtr_con_info ||
-    //        p->header.info == StablePtr_static_info);
-    return (StgStablePtr)(p->payload[0]);
-}
-
-HsPtr
-rts_getPtr (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == Ptr_con_info ||
-    //        p->header.info == Ptr_static_info);
-    return (Capability *)(p->payload[0]);
-}
-
-HsFunPtr
-rts_getFunPtr (HaskellObj p)
-{
-    // See comment above:
-    // ASSERT(p->header.info == FunPtr_con_info ||
-    //        p->header.info == FunPtr_static_info);
-    return (void *)(p->payload[0]);
-}
-
-HsBool
-rts_getBool (HaskellObj p)
-{
-    StgInfoTable *info;
-
-    info = get_itbl((StgClosure *)p);
-    if (info->srt_bitmap == 0) { // srt_bitmap is the constructor tag
-	return 0;
-    } else {
-	return 1;
-    }
-}
-
-/* -----------------------------------------------------------------------------
-   Creating threads
-   -------------------------------------------------------------------------- */
-
-INLINE_HEADER void pushClosure   (StgTSO *tso, StgWord c) {
-  tso->sp--;
-  tso->sp[0] = (W_) c;
-}
-
-StgTSO *
-createGenThread (Capability *cap, nat stack_size,  StgClosure *closure)
-{
-  StgTSO *t;
-#if defined(GRAN)
-  t = createThread (cap, stack_size, NO_PRI);
-#else
-  t = createThread (cap, stack_size);
-#endif
-  pushClosure(t, (W_)closure);
-  pushClosure(t, (W_)&stg_enter_info);
-  return t;
-}
-
-StgTSO *
-createIOThread (Capability *cap, nat stack_size,  StgClosure *closure)
-{
-  StgTSO *t;
-#if defined(GRAN)
-  t = createThread (cap, stack_size, NO_PRI);
-#else
-  t = createThread (cap, stack_size);
-#endif
-  pushClosure(t, (W_)&stg_noforceIO_info);
-  pushClosure(t, (W_)&stg_ap_v_info);
-  pushClosure(t, (W_)closure);
-  pushClosure(t, (W_)&stg_enter_info);
-  return t;
-}
-
-/*
- * Same as above, but also evaluate the result of the IO action
- * to whnf while we're at it.
- */
-
-StgTSO *
-createStrictIOThread(Capability *cap, nat stack_size,  StgClosure *closure)
-{
-  StgTSO *t;
-#if defined(GRAN)
-  t = createThread(cap, stack_size, NO_PRI);
-#else
-  t = createThread(cap, stack_size);
-#endif
-  pushClosure(t, (W_)&stg_forceIO_info);
-  pushClosure(t, (W_)&stg_ap_v_info);
-  pushClosure(t, (W_)closure);
-  pushClosure(t, (W_)&stg_enter_info);
-  return t;
-}
-
-/* ----------------------------------------------------------------------------
-   Evaluating Haskell expressions
-   ------------------------------------------------------------------------- */
-
-Capability *
-rts_eval (Capability *cap, HaskellObj p, /*out*/HaskellObj *ret)
-{
-    StgTSO *tso;
-    
-    tso = createGenThread(cap, RtsFlags.GcFlags.initialStkSize, p);
-    return scheduleWaitThread(tso,ret,cap);
-}
-
-Capability *
-rts_eval_ (Capability *cap, HaskellObj p, unsigned int stack_size, 
-	   /*out*/HaskellObj *ret)
-{
-    StgTSO *tso;
-
-    tso = createGenThread(cap, stack_size, p);
-    return scheduleWaitThread(tso,ret,cap);
-}
-
-/*
- * rts_evalIO() evaluates a value of the form (IO a), forcing the action's
- * result to WHNF before returning.
- */
-Capability *
-rts_evalIO (Capability *cap, HaskellObj p, /*out*/HaskellObj *ret)
-{
-    StgTSO* tso; 
-    
-    tso = createStrictIOThread(cap, RtsFlags.GcFlags.initialStkSize, p);
-    return scheduleWaitThread(tso,ret,cap);
-}
-
-/*
- * rts_evalStableIO() is suitable for calling from Haskell.  It
- * evaluates a value of the form (StablePtr (IO a)), forcing the
- * action's result to WHNF before returning.  The result is returned
- * in a StablePtr.
- */
-Capability *
-rts_evalStableIO (Capability *cap, HsStablePtr s, /*out*/HsStablePtr *ret)
-{
-    StgTSO* tso;
-    StgClosure *p, *r;
-    SchedulerStatus stat;
-    
-    p = (StgClosure *)deRefStablePtr(s);
-    tso = createStrictIOThread(cap, RtsFlags.GcFlags.initialStkSize, p);
-    cap = scheduleWaitThread(tso,&r,cap);
-    stat = rts_getSchedStatus(cap);
-
-    if (stat == Success && ret != NULL) {
-	ASSERT(r != NULL);
-	*ret = getStablePtr((StgPtr)r);
-    }
-
-    return cap;
-}
-
-/*
- * Like rts_evalIO(), but doesn't force the action's result.
- */
-Capability *
-rts_evalLazyIO (Capability *cap, HaskellObj p, /*out*/HaskellObj *ret)
-{
-    StgTSO *tso;
-
-    tso = createIOThread(cap, RtsFlags.GcFlags.initialStkSize, p);
-    return scheduleWaitThread(tso,ret,cap);
-}
-
-Capability *
-rts_evalLazyIO_ (Capability *cap, HaskellObj p, unsigned int stack_size, 
-		 /*out*/HaskellObj *ret)
-{
-    StgTSO *tso;
-
-    tso = createIOThread(cap, stack_size, p);
-    return scheduleWaitThread(tso,ret,cap);
-}
-
-/* Convenience function for decoding the returned status. */
-
-void
-rts_checkSchedStatus (char* site, Capability *cap)
-{
-    SchedulerStatus rc = cap->running_task->stat;
-    switch (rc) {
-    case Success:
-	return;
-    case Killed:
-	errorBelch("%s: uncaught exception",site);
-	stg_exit(EXIT_FAILURE);
-    case Interrupted:
-	errorBelch("%s: interrupted", site);
-	stg_exit(EXIT_FAILURE);
-    default:
-	errorBelch("%s: Return code (%d) not ok",(site),(rc));	
-	stg_exit(EXIT_FAILURE);
-    }
-}
-
-SchedulerStatus
-rts_getSchedStatus (Capability *cap)
-{
-    return cap->running_task->stat;
-}
-
-Capability *
-rts_lock (void)
-{
-    Capability *cap;
-    Task *task;
-
-    // ToDo: get rid of this lock in the common case.  We could store
-    // a free Task in thread-local storage, for example.  That would
-    // leave just one lock on the path into the RTS: cap->lock when
-    // acquiring the Capability.
-    ACQUIRE_LOCK(&sched_mutex);
-    task = newBoundTask();
-    RELEASE_LOCK(&sched_mutex);
-
-    cap = NULL;
-    waitForReturnCapability(&cap, task);
-    return (Capability *)cap;
-}
-
-// Exiting the RTS: we hold a Capability that is not necessarily the
-// same one that was originally returned by rts_lock(), because
-// rts_evalIO() etc. may return a new one.  Now that we have
-// investigated the return value, we can release the Capability,
-// and free the Task (in that order).
-
-void
-rts_unlock (Capability *cap)
-{
-    Task *task;
-
-    task = cap->running_task;
-    ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
-
-    // slightly delicate ordering of operations below, pay attention!
-
-    // We are no longer a bound task/thread.  This is important,
-    // because the GC can run when we release the Capability below,
-    // and we don't want it to treat this as a live TSO pointer.
-    task->tso = NULL;
-
-    // Now release the Capability.  With the capability released, GC
-    // may happen.  NB. does not try to put the current Task on the
-    // worker queue.
-    releaseCapability(cap);
-
-    // Finally, we can release the Task to the free list.
-    boundTaskExiting(task);
-}
diff --git a/ghc/rts/RtsDllMain.c b/ghc/rts/RtsDllMain.c
deleted file mode 100644
index af3c5090de..0000000000
--- a/ghc/rts/RtsDllMain.c
+++ /dev/null
@@ -1,39 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1999-2000
- *
- * Entry point for RTS-in-a-DLL
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsAPI.h"
-
-#ifdef HAVE_WINDOWS_H
-#include <windows.h>
-#endif
-
-/* I'd be mildly surprised if this wasn't defined, but still. */
-#ifdef ENABLE_WIN32_DLL_SUPPORT
-
-BOOL
-WINAPI
-DllMain ( HINSTANCE hInstance
-        , DWORD reason
-	, LPVOID reserved
-	)
-{
-  /*
-   * Note: the DllMain() doesn't call startupHaskell() for you,
-   *       that is the task of users of the RTS. The reason is
-   *       that *you* want to be able to control the arguments
-   *       you pass to the RTS.
-   */
-  switch (reason) {
-  case DLL_PROCESS_DETACH: shutdownHaskell();
-  }
-  return TRUE;
-}
-
-#endif /* ENABLE_WIN32_DLL_SUPPORT */
diff --git a/ghc/rts/RtsFlags.c b/ghc/rts/RtsFlags.c
deleted file mode 100644
index 0f83b3356c..0000000000
--- a/ghc/rts/RtsFlags.c
+++ /dev/null
@@ -1,2281 +0,0 @@
-
-/* -----------------------------------------------------------------------------
- *
- * (c) The AQUA Project, Glasgow University, 1994-1997
- * (c) The GHC Team, 1998-1999
- *
- * Functions for parsing the argument list.
- *
- * ---------------------------------------------------------------------------*/
-
-//@menu
-//* Includes::			
-//* Constants::			
-//* Static function decls::	
-//* Command-line option parsing routines::  
-//* GranSim specific options::	
-//* Aux fcts::			
-//@end menu
-//*/
-
-//@node Includes, Constants
-//@subsection Includes
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "BlockAlloc.h"
-#include "Timer.h"		/* CS_MIN_MILLISECS */
-#include "Profiling.h"
-
-#ifdef HAVE_CTYPE_H
-#include <ctype.h>
-#endif
-
-#include <stdlib.h>
-#include <string.h>
-
-// Flag Structure
-RTS_FLAGS RtsFlags;
-
-/*
- * Split argument lists
- */
-int     prog_argc = 0;    /* an "int" so as to match normal "argc" */
-char  **prog_argv = NULL;
-char   *prog_name = NULL; /* 'basename' of prog_argv[0] */
-int     rts_argc = 0;  /* ditto */
-char   *rts_argv[MAX_RTS_ARGS];
-
-//@node Constants, Static function decls, Includes
-//@subsection Constants
-
-/*
- * constants, used later 
- */
-#define RTS 1
-#define PGM 0
-
-#if defined(GRAN)
-
-static char *gran_debug_opts_strs[] = {
-  "DEBUG (-bDe, -bD1): event_trace; printing event trace.\n",
-  "DEBUG (-bDE, -bD2): event_stats; printing event statistics.\n",
-  "DEBUG (-bDb, -bD4): bq; check blocking queues\n",
-  "DEBUG (-bDG, -bD8): pack; routines for (un-)packing graph structures.\n",
-  "DEBUG (-bDq, -bD16): checkSparkQ; check consistency of the spark queues.\n",
-  "DEBUG (-bDf, -bD32): thunkStealing; print forwarding of fetches.\n",
-  "DEBUG (-bDr, -bD64): randomSteal; stealing sparks/threads from random PEs.\n",
-  "DEBUG (-bDF, -bD128): findWork; searching spark-pools (local & remote), thread queues for work.\n",
-  "DEBUG (-bDu, -bD256): unused; currently unused flag.\n",
-  "DEBUG (-bDS, -bD512): pri; priority sparking or scheduling.\n",
-  "DEBUG (-bD:, -bD1024): checkLight; check GranSim-Light setup.\n",
-  "DEBUG (-bDo, -bD2048): sortedQ; check whether spark/thread queues are sorted.\n",
-  "DEBUG (-bDz, -bD4096): blockOnFetch; check for blocked on fetch.\n",
-  "DEBUG (-bDP, -bD8192): packBuffer; routines handling pack buffer (GranSim internal!).\n",
-  "DEBUG (-bDt, -bD16384): blockOnFetch_sanity; check for TSO asleep on fetch.\n",
-};
-
-/* one character codes for the available debug options */
-static char gran_debug_opts_flags[] = {
-  'e', 'E', 'b', 'G', 'q', 'f', 'r', 'F', 'u', 'S', ':', 'o', 'z', 'P', 't'
-};
-
-#elif defined(PAR)
-
-static char *par_debug_opts_strs[] = {
-  "DEBUG (-qDv, -qD1): verbose; be generally verbose with parallel related stuff.\n",
-  "DEBUG (-qDq, -qD2): bq; print blocking queues.\n",
-  "DEBUG (-qDs, -qD4): schedule; scheduling of parallel threads.\n",
-  "DEBUG (-qDe, -qD8): free; free messages.\n",
-  "DEBUG (-qDr, -qD16): resume; resume messages.\n",
-  "DEBUG (-qDw, -qD32): weight; print weights and distrib GC stuff.\n",
-  "DEBUG (-qDF, -qD64): fetch; fetch messages.\n",
-  // "DEBUG (-qDa, -qD128): ack; ack messages.\n",
-  "DEBUG (-qDf, -qD128): fish; fish messages.\n",
-  //"DEBUG (-qDo, -qD512): forward; forwarding messages to other PEs.\n",
-  "DEBUG (-qDl, -qD256): tables; print internal LAGA etc tables.\n",
-  "DEBUG (-qDo, -qD512): packet; packets and graph structures when packing.\n",
-  "DEBUG (-qDp, -qD1024): pack; packing and unpacking graphs.\n",
-  "DEBUG (-qDz, -qD2048): paranoia; ridiculously detailed output (excellent for filling a partition).\n"
-};
-
-/* one character codes for the available debug options */
-static char par_debug_opts_flags[] = {
-  'v', 'q', 's', 'e', 'r', 'w', 'F', 'f', 'l', 'o', 'p', 'z'
-};
-
-#endif /* PAR */
-
-//@node Static function decls, Command-line option parsing routines, Constants
-//@subsection Static function decls
-
-/* -----------------------------------------------------------------------------
-   Static function decls
-   -------------------------------------------------------------------------- */
-
-static int		/* return NULL on error */
-open_stats_file (
-    I_ arg,
-    int argc, char *argv[],
-    int rts_argc, char *rts_argv[],
-    const char *FILENAME_FMT,
-    FILE **file_ret);
-
-static I_ decode(const char *s);
-static void bad_option(const char *s);
-
-#if defined(GRAN)
-static void enable_GranSimLight(void);
-static void process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error);
-static void set_GranSim_debug_options(nat n);
-static void help_GranSim_debug_options(nat n);
-#elif defined(PAR)
-static void process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error);
-static void set_par_debug_options(nat n);
-static void help_par_debug_options(nat n);
-#endif
-
-//@node Command-line option parsing routines, GranSim specific options, Static function decls
-//@subsection Command-line option parsing routines
-
-/* -----------------------------------------------------------------------------
- * Command-line option parsing routines.
- * ---------------------------------------------------------------------------*/
-
-void initRtsFlagsDefaults(void)
-{
-    RtsFlags.GcFlags.statsFile		= NULL;
-    RtsFlags.GcFlags.giveStats		= NO_GC_STATS;
-
-    RtsFlags.GcFlags.maxStkSize		= (8 * 1024 * 1024) / sizeof(W_);
-    RtsFlags.GcFlags.initialStkSize	= 1024 / sizeof(W_);
-
-    RtsFlags.GcFlags.minAllocAreaSize   = (512 * 1024)        / BLOCK_SIZE;
-    RtsFlags.GcFlags.minOldGenSize      = (1024 * 1024)       / BLOCK_SIZE;
-    RtsFlags.GcFlags.maxHeapSize	= 0;    /* off by default */
-    RtsFlags.GcFlags.heapSizeSuggestion	= 0;    /* none */
-    RtsFlags.GcFlags.pcFreeHeap		= 3;	/* 3% */
-    RtsFlags.GcFlags.oldGenFactor       = 2;
-#if defined(PAR)
-    /* A hack currently needed for GUM -- HWL */
-    RtsFlags.GcFlags.generations        = 1;
-    RtsFlags.GcFlags.steps              = 2;
-    RtsFlags.GcFlags.squeezeUpdFrames	= rtsFalse;
-#else
-    RtsFlags.GcFlags.generations        = 2;
-    RtsFlags.GcFlags.steps              = 2;
-    RtsFlags.GcFlags.squeezeUpdFrames	= rtsTrue;
-#endif
-    RtsFlags.GcFlags.compact            = rtsFalse;
-    RtsFlags.GcFlags.compactThreshold   = 30.0;
-#ifdef RTS_GTK_FRONTPANEL
-    RtsFlags.GcFlags.frontpanel         = rtsFalse;
-#endif
-    RtsFlags.GcFlags.idleGCDelayTicks   = 300 / TICK_MILLISECS; /* ticks */
-
-#ifdef DEBUG
-    RtsFlags.DebugFlags.scheduler	= rtsFalse;
-    RtsFlags.DebugFlags.interpreter	= rtsFalse;
-    RtsFlags.DebugFlags.codegen		= rtsFalse;
-    RtsFlags.DebugFlags.weak		= rtsFalse;
-    RtsFlags.DebugFlags.gccafs		= rtsFalse;
-    RtsFlags.DebugFlags.gc		= rtsFalse;
-    RtsFlags.DebugFlags.block_alloc	= rtsFalse;
-    RtsFlags.DebugFlags.sanity		= rtsFalse;
-    RtsFlags.DebugFlags.stable		= rtsFalse;
-    RtsFlags.DebugFlags.stm             = rtsFalse;
-    RtsFlags.DebugFlags.prof		= rtsFalse;
-    RtsFlags.DebugFlags.gran		= rtsFalse;
-    RtsFlags.DebugFlags.par		= rtsFalse;
-    RtsFlags.DebugFlags.linker		= rtsFalse;
-    RtsFlags.DebugFlags.squeeze		= rtsFalse;
-#endif
-
-#if defined(PROFILING) || defined(PAR)
-    RtsFlags.CcFlags.doCostCentres	= 0;
-#endif /* PROFILING or PAR */
-
-#ifdef PROFILING
-    RtsFlags.ProfFlags.doHeapProfile      = rtsFalse;
-    RtsFlags.ProfFlags.profileInterval    = 100;
-    RtsFlags.ProfFlags.includeTSOs        = rtsFalse;
-    RtsFlags.ProfFlags.showCCSOnException = rtsFalse;
-    RtsFlags.ProfFlags.maxRetainerSetSize = 8;
-    RtsFlags.ProfFlags.modSelector        = NULL;
-    RtsFlags.ProfFlags.descrSelector      = NULL;
-    RtsFlags.ProfFlags.typeSelector       = NULL;
-    RtsFlags.ProfFlags.ccSelector         = NULL;
-    RtsFlags.ProfFlags.ccsSelector        = NULL;
-    RtsFlags.ProfFlags.retainerSelector   = NULL;
-    RtsFlags.ProfFlags.bioSelector        = NULL;
-
-#elif defined(DEBUG)
-    RtsFlags.ProfFlags.doHeapProfile      = rtsFalse;
-#endif
-
-    RtsFlags.ConcFlags.ctxtSwitchTime	= CS_MIN_MILLISECS;  /* In milliseconds */
-
-#ifdef THREADED_RTS
-    RtsFlags.ParFlags.nNodes	        = 1;
-    RtsFlags.ParFlags.migrate           = rtsTrue;
-    RtsFlags.ParFlags.wakeupMigrate     = rtsFalse;
-#endif
-
-#ifdef PAR
-    RtsFlags.ParFlags.ParStats.Full   	  = rtsFalse;
-    RtsFlags.ParFlags.ParStats.Suppressed = rtsFalse;
-    RtsFlags.ParFlags.ParStats.Binary 	  = rtsFalse;
-    RtsFlags.ParFlags.ParStats.Sparks 	  = rtsFalse;
-    RtsFlags.ParFlags.ParStats.Heap   	  = rtsFalse;
-    RtsFlags.ParFlags.ParStats.NewLogfile = rtsFalse;
-    RtsFlags.ParFlags.ParStats.Global     = rtsFalse;
-
-    RtsFlags.ParFlags.outputDisabled	= rtsFalse;
-#ifdef DIST
-    RtsFlags.ParFlags.doFairScheduling  = rtsTrue;  /* fair sched by def */
-#else
-    RtsFlags.ParFlags.doFairScheduling  = rtsFalse;  /* unfair sched by def */
-#endif
-    RtsFlags.ParFlags.packBufferSize	= 1024;
-    RtsFlags.ParFlags.thunksToPack      = 1; /* 0 ... infinity; */
-    RtsFlags.ParFlags.globalising       = 1; /* 0 ... everything */
-    RtsFlags.ParFlags.maxThreads        = 1024;
-    RtsFlags.ParFlags.maxFishes        = MAX_FISHES;
-    RtsFlags.ParFlags.fishDelay         = FISH_DELAY;
-#endif
-
-#if defined(PAR) || defined(THREADED_RTS)
-    RtsFlags.ParFlags.maxLocalSparks	= 4096;
-#endif /* PAR || THREADED_RTS */
-
-#if defined(GRAN)
-    /* ToDo: check defaults for GranSim and GUM */
-    RtsFlags.GcFlags.maxStkSize		= (8 * 1024 * 1024) / sizeof(W_);
-    RtsFlags.GcFlags.initialStkSize	= 1024 / sizeof(W_);
-
-    RtsFlags.GranFlags.maxThreads	= 65536; // refers to mandatory threads
-    RtsFlags.GranFlags.GranSimStats.Full	= rtsFalse;
-    RtsFlags.GranFlags.GranSimStats.Suppressed	= rtsFalse;
-    RtsFlags.GranFlags.GranSimStats.Binary      = rtsFalse;
-    RtsFlags.GranFlags.GranSimStats.Sparks      = rtsFalse;
-    RtsFlags.GranFlags.GranSimStats.Heap        = rtsFalse;
-    RtsFlags.GranFlags.GranSimStats.NewLogfile  = rtsFalse;
-    RtsFlags.GranFlags.GranSimStats.Global      = rtsFalse;
-
-    RtsFlags.GranFlags.packBufferSize	= 1024;
-    RtsFlags.GranFlags.packBufferSize_internal = GRANSIM_DEFAULT_PACK_BUFFER_SIZE;
-
-    RtsFlags.GranFlags.proc         = MAX_PROC;
-    RtsFlags.GranFlags.Fishing      = rtsFalse;
-    RtsFlags.GranFlags.maxFishes   = MAX_FISHES;
-    RtsFlags.GranFlags.time_slice   = GRAN_TIME_SLICE;
-    RtsFlags.GranFlags.Light        = rtsFalse;
-
-    RtsFlags.GranFlags.Costs.latency =             LATENCY;          
-    RtsFlags.GranFlags.Costs.additional_latency =  ADDITIONAL_LATENCY; 
-    RtsFlags.GranFlags.Costs.fetchtime =           FETCHTIME; 
-    RtsFlags.GranFlags.Costs.lunblocktime =        LOCALUNBLOCKTIME; 
-    RtsFlags.GranFlags.Costs.gunblocktime =        GLOBALUNBLOCKTIME;
-    RtsFlags.GranFlags.Costs.mpacktime =           MSGPACKTIME;      
-    RtsFlags.GranFlags.Costs.munpacktime =         MSGUNPACKTIME;
-    RtsFlags.GranFlags.Costs.mtidytime =           MSGTIDYTIME;
-
-    RtsFlags.GranFlags.Costs.threadcreatetime =         THREADCREATETIME;
-    RtsFlags.GranFlags.Costs.threadqueuetime =          THREADQUEUETIME;
-    RtsFlags.GranFlags.Costs.threaddescheduletime =     THREADDESCHEDULETIME;
-    RtsFlags.GranFlags.Costs.threadscheduletime =       THREADSCHEDULETIME;
-    RtsFlags.GranFlags.Costs.threadcontextswitchtime =  THREADCONTEXTSWITCHTIME;
-
-    RtsFlags.GranFlags.Costs.arith_cost =         ARITH_COST;       
-    RtsFlags.GranFlags.Costs.branch_cost =        BRANCH_COST; 
-    RtsFlags.GranFlags.Costs.load_cost =          LOAD_COST;        
-    RtsFlags.GranFlags.Costs.store_cost =         STORE_COST; 
-    RtsFlags.GranFlags.Costs.float_cost =         FLOAT_COST;       
-
-    RtsFlags.GranFlags.Costs.heapalloc_cost =     HEAPALLOC_COST;
-
-    RtsFlags.GranFlags.Costs.pri_spark_overhead = PRI_SPARK_OVERHEAD;        
-    RtsFlags.GranFlags.Costs.pri_sched_overhead = PRI_SCHED_OVERHEAD;        
-
-    RtsFlags.GranFlags.DoFairSchedule           = rtsFalse;             
-    RtsFlags.GranFlags.DoAsyncFetch             = rtsFalse;        
-    RtsFlags.GranFlags.DoStealThreadsFirst      = rtsFalse;        
-    RtsFlags.GranFlags.DoAlwaysCreateThreads    = rtsFalse;      
-    RtsFlags.GranFlags.DoBulkFetching           = rtsFalse;             
-    RtsFlags.GranFlags.DoThreadMigration        = rtsFalse;          
-    RtsFlags.GranFlags.FetchStrategy            = 2;                     
-    RtsFlags.GranFlags.PreferSparksOfLocalNodes = rtsFalse;   
-    RtsFlags.GranFlags.DoPrioritySparking       = rtsFalse;         
-    RtsFlags.GranFlags.DoPriorityScheduling     = rtsFalse;       
-    RtsFlags.GranFlags.SparkPriority            = 0;
-    RtsFlags.GranFlags.SparkPriority2           = 0; 
-    RtsFlags.GranFlags.RandomPriorities         = rtsFalse;           
-    RtsFlags.GranFlags.InversePriorities        = rtsFalse;          
-    RtsFlags.GranFlags.IgnorePriorities         = rtsFalse;           
-    RtsFlags.GranFlags.ThunksToPack             = 0;                      
-    RtsFlags.GranFlags.RandomSteal              = rtsTrue;
-#endif
-
-#ifdef TICKY_TICKY
-    RtsFlags.TickyFlags.showTickyStats	 = rtsFalse;
-    RtsFlags.TickyFlags.tickyFile	 = NULL;
-#endif
-}
-
-static const char *
-usage_text[] = {
-"",
-"Usage: <prog> <args> [+RTS <rtsopts> | -RTS <args>] ... --RTS <args>",
-"",
-"   +RTS    Indicates run time system options follow",
-"   -RTS    Indicates program arguments follow",
-"  --RTS    Indicates that ALL subsequent arguments will be given to the",
-"           program (including any of these RTS flags)",
-"",
-"The following run time system options are available:",
-"",
-"  -?       Prints this message and exits; the program is not executed",
-"",
-"  -K<size> Sets the maximum stack size (default 8M)  Egs: -K32k   -K512k",
-"  -k<size> Sets the initial thread stack size (default 1k)  Egs: -k4k   -k2m",
-"",
-"  -A<size> Sets the minimum allocation area size (default 256k) Egs: -A1m -A10k",
-"  -M<size> Sets the maximum heap size (default unlimited)  Egs: -M256k -M1G",
-"  -H<size> Sets the minimum heap size (default 0M)   Egs: -H24m  -H1G",
-"  -m<n>    Minimum % of heap which must be available (default 3%)",
-"  -G<n>    Number of generations (default: 2)",
-"  -T<n>    Number of steps in younger generations (default: 2)",
-"  -c<n>    Auto-enable compaction of the oldest generation when live data is",
-"           at least <n>% of the maximum heap size set with -M (default: 30%)",
-"  -c       Enable compaction for all major collections",
-#if defined(THREADED_RTS)
-"  -I<sec>  Perform full GC after <sec> idle time (default: 0.3, 0 == off)",
-#endif
-"",
-"  -t<file> One-line GC statistics  (default file: <program>.stat)",
-"  -s<file> Summary  GC statistics  (with -Sstderr going to stderr)",
-"  -S<file> Detailed GC statistics",
-#ifdef RTS_GTK_FRONTPANEL
-"  -f       Display front panel (requires X11 & GTK+)",
-#endif
-"",
-"",
-"  -Z       Don't squeeze out update frames on stack overflow",
-"  -B       Sound the bell at the start of each garbage collection",
-#if defined(PROFILING) || defined(PAR)
-"",
-"  -px      Time/allocation profile (XML)  (output file <program>.prof)",
-"  -p       Time/allocation profile        (output file <program>.prof)",
-"  -P       More detailed Time/Allocation profile",
-"  -Pa      Give information about *all* cost centres",
-
-# if defined(PROFILING)
-"",
-"  -hx            Heap residency profile (XML)   (output file <program>.prof)",
-"  -h<break-down> Heap residency profile (hp2ps) (output file <program>.hp)",
-"     break-down: c = cost centre stack (default)",
-"                 m = module",
-"                 d = closure description",
-"                 y = type description",
-"                 r = retainer",
-"                 b = biography (LAG,DRAG,VOID,USE)",
-"  A subset of closures may be selected thusly:",
-"    -hc<cc>,...  specific cost centre(s) (top of stack only)",
-"    -hC<cc>,...  specific cost centre(s) (anywhere in stack)",
-"    -hm<mod>...  all cost centres from the specified modules(s)",
-"    -hd<des>,... closures with specified closure descriptions",
-"    -hy<typ>...  closures with specified type descriptions",
-"    -hr<cc>...   closures with specified retainers",
-"    -hb<bio>...  closures with specified biographies (lag,drag,void,use)",
-"",
-"  -R<size>       Set the maximum retainer set size (default: 8)",
-"",
-"  -i<sec>        Time between heap samples (seconds, default: 0.1)",
-"",
-"  -xt            Include threads (TSOs) in a heap profile",
-"",
-"  -xc      Show current cost centre stack on raising an exception",
-# endif
-#endif /* PROFILING or PAR */
-#if !defined(PROFILING) && defined(DEBUG)
-"",
-"  -h<break-down> Debugging Heap residency profile",
-"                 (output file <program>.hp)",
-"     break-down: L = closure label (default)",
-"                 T = closure type (constructor, thunk etc.)",
-#endif
-"",
-#if defined(TICKY_TICKY)
-"  -r<file>  Produce reduction profiling statistics (with -rstderr for stderr)",
-"",
-#endif
-#if defined(PAR)
-"  -N<n>     Use <n> PVMish processors in parallel (default: 2)",
-/* NB: the -N<n> is implemented by the driver!! */
-#endif
-"  -C<secs>  Context-switch interval in seconds",
-"                (0 or no argument means switch as often as possible)",
-"                the default is .02 sec; resolution is .02 sec",
-"",
-#if defined(DEBUG)
-"  -Ds  DEBUG: scheduler",
-"  -Di  DEBUG: interpreter",
-"  -Dc  DEBUG: codegen",
-"  -Dw  DEBUG: weak",
-"  -DG  DEBUG: gccafs",
-"  -Dg  DEBUG: gc",
-"  -Db  DEBUG: block",
-"  -DS  DEBUG: sanity",
-"  -Dt  DEBUG: stable",
-"  -Dp  DEBUG: prof",
-"  -Dr  DEBUG: gran",
-"  -DP  DEBUG: par",
-"  -Dl  DEBUG: linker",
-"  -Dm  DEBUG: stm",
-"  -Dz  DEBUG: stack squezing",
-"",
-#endif /* DEBUG */
-#if defined(THREADED_RTS)
-"  -N<n>     Use <n> OS threads (default: 1)",
-"  -qm       Don't automatically migrate threads between CPUs",
-"  -qw       Migrate a thread to the current CPU when it is woken up",
-#endif
-#if defined(THREADED_RTS) || defined(PAR)
-"  -e<size>  Size of spark pools (default 100)",
-#endif
-#if defined(PAR)
-"  -t<num>   Set maximum number of advisory threads per PE (default 32)",
-"  -qP       Enable activity profile (output files in ~/<program>*.gr)",
-"  -qQ<size> Set pack-buffer size (default: 1024)",
-"  -qd       Turn on PVM-ish debugging",
-"  -qO       Disable output for performance measurement",
-#endif
-#if defined(THREADED_RTS) || defined(PAR)
-"  -e<n>     Maximum number of outstanding local sparks (default: 4096)",
-#endif
-#if defined(PAR)
-"  -d        Turn on PVM-ish debugging",
-"  -O        Disable output for performance measurement",
-#endif /* PAR */
-#if defined(GRAN)  /* ToDo: fill in decent Docu here */
-"  -b...     All GranSim options start with -b; see GranSim User's Guide for details",
-#endif
-"",
-"RTS options may also be specified using the GHCRTS environment variable.",
-"",
-"Other RTS options may be available for programs compiled a different way.",
-"The GHC User's Guide has full details.",
-"",
-0
-};
-
-STATIC_INLINE rtsBool
-strequal(const char *a, const char * b)
-{
-    return(strcmp(a, b) == 0);
-}
-
-static void
-splitRtsFlags(char *s, int *rts_argc, char *rts_argv[])
-{
-    char *c1, *c2;
-
-    c1 = s;
-    do {
-	while (isspace(*c1)) { c1++; };
-	c2 = c1;
-	while (!isspace(*c2) && *c2 != '\0') { c2++; };
-	
-	if (c1 == c2) { break; }
-	
-	if (*rts_argc < MAX_RTS_ARGS-1) {
-	    s = stgMallocBytes(c2-c1+1, "RtsFlags.c:splitRtsFlags()");
-	    strncpy(s, c1, c2-c1);
-	    s[c2-c1] = '\0';
-	    rts_argv[(*rts_argc)++] = s;
-	} else {
-	    barf("too many RTS arguments (max %d)", MAX_RTS_ARGS-1);
-	}
-	
-	c1 = c2;
-    } while (*c1 != '\0');
-}
-    
-void
-setupRtsFlags(int *argc, char *argv[], int *rts_argc, char *rts_argv[])
-{
-    rtsBool error = rtsFalse;
-    I_ mode;
-    I_ arg, total_arg;
-
-    setProgName (argv);
-    total_arg = *argc;
-    arg = 1;
-
-    *argc = 1;
-    *rts_argc = 0;
-
-    // process arguments from the ghc_rts_opts global variable first.
-    // (arguments from the GHCRTS environment variable and the command
-    // line override these).
-    {
-	if (ghc_rts_opts != NULL) {
-	    splitRtsFlags(ghc_rts_opts, rts_argc, rts_argv);
-	}
-    }
-
-    // process arguments from the GHCRTS environment variable next
-    // (arguments from the command line override these).
-    {
-	char *ghc_rts = getenv("GHCRTS");
-
-	if (ghc_rts != NULL) {
-	    splitRtsFlags(ghc_rts, rts_argc, rts_argv);
-	}
-    }
-
-    // Split arguments (argv) into PGM (argv) and RTS (rts_argv) parts
-    //   argv[0] must be PGM argument -- leave in argv
-
-    for (mode = PGM; arg < total_arg; arg++) {
-	// The '--RTS' argument disables all future +RTS ... -RTS processing.
-	if (strequal("--RTS", argv[arg])) {
-	    arg++;
-	    break;
-	}
-	// The '--' argument is passed through to the program, but
-	// disables all further +RTS ... -RTS processing.
-	else if (strequal("--", argv[arg])) {
-	    break;
-	}
-	else if (strequal("+RTS", argv[arg])) {
-	    mode = RTS;
-	}
-	else if (strequal("-RTS", argv[arg])) {
-	    mode = PGM;
-	}
-	else if (mode == RTS && *rts_argc < MAX_RTS_ARGS-1) {
-	    rts_argv[(*rts_argc)++] = argv[arg];
-	}
-	else if (mode == PGM) {
-	    argv[(*argc)++] = argv[arg];
-	}
-	else {
-	  barf("too many RTS arguments (max %d)", MAX_RTS_ARGS-1);
-	}
-    }
-    // process remaining program arguments
-    for (; arg < total_arg; arg++) {
-	argv[(*argc)++] = argv[arg];
-    }
-    argv[*argc] = (char *) 0;
-    rts_argv[*rts_argc] = (char *) 0;
-
-    // Process RTS (rts_argv) part: mainly to determine statsfile
-    for (arg = 0; arg < *rts_argc; arg++) {
-	if (rts_argv[arg][0] != '-') {
-	    fflush(stdout);
-	    errorBelch("unexpected RTS argument: %s", rts_argv[arg]);
-	    error = rtsTrue;
-
-        } else {
-	    switch(rts_argv[arg][1]) {
-
-	      /* process: general args, then PROFILING-only ones,
-		 then CONCURRENT-only, PARallel-only, GRAN-only,
-		 TICKY-only (same order as defined in RtsFlags.lh);
-		 within those groups, mostly in case-insensitive
-		 alphabetical order.
-                 Final group is x*, which allows for more options.
-	      */
-
-#ifdef TICKY_TICKY
-# define TICKY_BUILD_ONLY(x) x
-#else
-# define TICKY_BUILD_ONLY(x) \
-errorBelch("not built for: ticky-ticky stats"); \
-error = rtsTrue;
-#endif
-
-#if defined(PROFILING) 
-# define COST_CENTRE_USING_BUILD_ONLY(x) x
-#else
-# define COST_CENTRE_USING_BUILD_ONLY(x) \
-errorBelch("not built for: -prof or -parallel"); \
-error = rtsTrue;
-#endif
-
-#ifdef PROFILING
-# define PROFILING_BUILD_ONLY(x)   x
-#else
-# define PROFILING_BUILD_ONLY(x) \
-errorBelch("not built for: -prof"); \
-error = rtsTrue;
-#endif
-
-#ifdef PAR
-# define PAR_BUILD_ONLY(x)      x
-#else
-# define PAR_BUILD_ONLY(x) \
-errorBelch("not built for: -parallel"); \
-error = rtsTrue;
-#endif
-
-#ifdef THREADED_RTS
-# define THREADED_BUILD_ONLY(x)      x
-#else
-# define THREADED_BUILD_ONLY(x) \
-errorBelch("not built for: -smp"); \
-error = rtsTrue;
-#endif
-
-#if defined(THREADED_RTS) || defined(PAR)
-# define PAR_OR_THREADED_BUILD_ONLY(x)      x
-#else
-# define PAR_OR_THREADED_BUILD_ONLY(x) \
-errorBelch("not built for: -parallel or -smp"); \
-error = rtsTrue;
-#endif
-
-#ifdef GRAN
-# define GRAN_BUILD_ONLY(x)     x
-#else
-# define GRAN_BUILD_ONLY(x) \
-errorBelch("not built for: -gransim"); \
-error = rtsTrue;
-#endif
-
-	      /* =========== GENERAL ========================== */
-	      case '?':
-		error = rtsTrue;
-		break;
-
-	      case 'A':
-		RtsFlags.GcFlags.minAllocAreaSize
-		  = decode(rts_argv[arg]+2) / BLOCK_SIZE;
-		if (RtsFlags.GcFlags.minAllocAreaSize <= 0) {
-		  bad_option(rts_argv[arg]);
-		}
-		break;
-
-	      case 'B':
-		RtsFlags.GcFlags.ringBell = rtsTrue;
-		break;
-
-	      case 'c':
-		  if (rts_argv[arg][2] != '\0') {
-		      RtsFlags.GcFlags.compactThreshold =
-			  atof(rts_argv[arg]+2);
-		  } else {
-		      RtsFlags.GcFlags.compact = rtsTrue;
-		  }
-		  break;
-
-	      case 'F':
-	        RtsFlags.GcFlags.oldGenFactor = atof(rts_argv[arg]+2);
-	      
-		if (RtsFlags.GcFlags.oldGenFactor < 0)
-		  bad_option( rts_argv[arg] );
-		break;
-	      
-#ifdef DEBUG
-	      case 'D':
-	      { 
-		  char *c;
-
-		  for (c  = rts_argv[arg] + 2; *c != '\0'; c++) {
-		      switch (*c) {
-		      case 's':
-			  RtsFlags.DebugFlags.scheduler = rtsTrue;
-			  break;
-		      case 'i':
-			  RtsFlags.DebugFlags.interpreter = rtsTrue;
-			  break;
-		      case 'c':
-			  RtsFlags.DebugFlags.codegen = rtsTrue;
-			  break;
-		      case 'w':
-			  RtsFlags.DebugFlags.weak = rtsTrue;
-			  break;
-		      case 'G':
-			  RtsFlags.DebugFlags.gccafs = rtsTrue;
-			  break;
-		      case 'g':
-			  RtsFlags.DebugFlags.gc = rtsTrue;
-			  break;
-		      case 'b':
-			  RtsFlags.DebugFlags.block_alloc = rtsTrue;
-			  break;
-		      case 'S':
-			  RtsFlags.DebugFlags.sanity = rtsTrue;
-			  break;
-		      case 't':
-			  RtsFlags.DebugFlags.stable = rtsTrue;
-			  break;
-		      case 'p':
-			  RtsFlags.DebugFlags.prof = rtsTrue;
-			  break;
-		      case 'r':
-			  RtsFlags.DebugFlags.gran = rtsTrue;
-			  break;
-		      case 'P':
-			  RtsFlags.DebugFlags.par = rtsTrue;
-			  break;
-		      case 'l':
-			  RtsFlags.DebugFlags.linker = rtsTrue;
-			  break;
-		      case 'a':
-			  RtsFlags.DebugFlags.apply = rtsTrue;
-			  break;
-		      case 'm':
-			  RtsFlags.DebugFlags.stm = rtsTrue;
-			  break;
-		      case 'z':
-			  RtsFlags.DebugFlags.squeeze = rtsTrue;
-			  break;
-		      default:
-			  bad_option( rts_argv[arg] );
-		      }
-		  }
-		  break;
-	      }
-#endif
-
-	      case 'K':
-		RtsFlags.GcFlags.maxStkSize = 
-		  decode(rts_argv[arg]+2) / sizeof(W_);
-
-		if (RtsFlags.GcFlags.maxStkSize == 0) 
-		  bad_option( rts_argv[arg] );
-		break;
-
-	      case 'k':
-		RtsFlags.GcFlags.initialStkSize = 
-		  decode(rts_argv[arg]+2) / sizeof(W_);
-
-		if (RtsFlags.GcFlags.initialStkSize == 0) 
-		  bad_option( rts_argv[arg] );
-		break;
-
-	      case 'M':
-		RtsFlags.GcFlags.maxHeapSize = 
-		  decode(rts_argv[arg]+2) / BLOCK_SIZE;
-		/* user give size in *bytes* but "maxHeapSize" is in *blocks* */
-
-		if (RtsFlags.GcFlags.maxHeapSize <= 0) {
-		  bad_option(rts_argv[arg]);
-		}
-		break;
-
-	      case 'm':
-		RtsFlags.GcFlags.pcFreeHeap = atof(rts_argv[arg]+2);
-
-		if (RtsFlags.GcFlags.pcFreeHeap < 0 || 
-		    RtsFlags.GcFlags.pcFreeHeap > 100)
-		  bad_option( rts_argv[arg] );
-		break;
-
-	      case 'G':
-		RtsFlags.GcFlags.generations = decode(rts_argv[arg]+2);
-		if (RtsFlags.GcFlags.generations < 1) {
-		  bad_option(rts_argv[arg]);
-		}
-		break;
-
-	      case 'T':
-		RtsFlags.GcFlags.steps = decode(rts_argv[arg]+2);
-		if (RtsFlags.GcFlags.steps < 1) {
-		  bad_option(rts_argv[arg]);
-		}
-		break;
-
-	      case 'H':
-		RtsFlags.GcFlags.heapSizeSuggestion = 
-		  decode(rts_argv[arg]+2) / BLOCK_SIZE;
-
-		if (RtsFlags.GcFlags.heapSizeSuggestion <= 0) {
-		  bad_option(rts_argv[arg]);
-		}
-		break;
-
-#ifdef RTS_GTK_FRONTPANEL
-	      case 'f':
-		  RtsFlags.GcFlags.frontpanel = rtsTrue;
-		  break;
-#endif
-
-    	      case 'I':	/* idle GC delay */
-		if (rts_argv[arg][2] == '\0') {
-		  /* use default */
-		} else {
-		    I_ cst; /* tmp */
-
-		    /* Convert to ticks */
-		    cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
-		    if (cst > 0 && cst < TICK_MILLISECS) {
-			cst = TICK_MILLISECS;
-		    } else {
-			cst = cst / TICK_MILLISECS;
-		    }
-		    RtsFlags.GcFlags.idleGCDelayTicks = cst;
-		}
-		break;
-
-	      case 'S':
-		  RtsFlags.GcFlags.giveStats = VERBOSE_GC_STATS;
-		  goto stats;
-
-	      case 's':
-		  RtsFlags.GcFlags.giveStats = SUMMARY_GC_STATS;
-		  goto stats;
-
-	      case 't':
-		  RtsFlags.GcFlags.giveStats = ONELINE_GC_STATS;
-		  goto stats;
-
-	    stats:
-#ifdef PAR
-		/* Opening all those files would almost certainly fail... */
-		// RtsFlags.ParFlags.ParStats.Full = rtsTrue;
-		RtsFlags.GcFlags.statsFile = NULL; /* temporary; ToDo: rm */
-#else
-		{ 
-		    int r;
-		    r = open_stats_file(arg, *argc, argv,
-					*rts_argc, rts_argv, STAT_FILENAME_FMT,
-					&RtsFlags.GcFlags.statsFile);
-		    if (r == -1) { error = rtsTrue; }
-		}
-#endif
-		  break;
-
-	      case 'Z':
-		RtsFlags.GcFlags.squeezeUpdFrames = rtsFalse;
-		break;
-
-	      /* =========== PROFILING ========================== */
-
-	      case 'P': /* detailed cost centre profiling (time/alloc) */
-	      case 'p': /* cost centre profiling (time/alloc) */
-		COST_CENTRE_USING_BUILD_ONLY(
-		switch (rts_argv[arg][2]) {
-		  case 'x':
-		    RtsFlags.CcFlags.doCostCentres = COST_CENTRES_XML;
-		    break;
-		  case 'a':
-		    RtsFlags.CcFlags.doCostCentres = COST_CENTRES_ALL;
-		    break;
-		  default:
-		      if (rts_argv[arg][1] == 'P') {
-			  RtsFlags.CcFlags.doCostCentres =
-			      COST_CENTRES_VERBOSE;
-		      } else {
-			  RtsFlags.CcFlags.doCostCentres =
-			      COST_CENTRES_SUMMARY;
-		      }
-		      break;
-		}
-		) break;
-
-	      case 'R':
-		  PROFILING_BUILD_ONLY(
-		      RtsFlags.ProfFlags.maxRetainerSetSize = atof(rts_argv[arg]+2);
-  	          ) break;
-
-	      case 'h': /* serial heap profile */
-#if !defined(PROFILING) && defined(DEBUG)
-		switch (rts_argv[arg][2]) {
-		  case '\0':
-		  case 'L':
-		    RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_INFOPTR;
-		    break;
-		  case 'T':
-		    RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CLOSURE_TYPE;
-		    break;
-		  default:
-		    errorBelch("invalid heap profile option: %s",rts_argv[arg]);
-		    error = rtsTrue;
-		}
-#else
-		PROFILING_BUILD_ONLY(
-		switch (rts_argv[arg][2]) {
-		case '\0':
-		case 'C':
-		case 'c':
-		case 'M':
-		case 'm':
-		case 'D':
-		case 'd':
-		case 'Y':
-		case 'y':
-		case 'R':
-		case 'r':
-		case 'B':
-		case 'b':
-		    if (rts_argv[arg][2] != '\0' && rts_argv[arg][3] != '\0') {
-			{
-			    char *left  = strchr(rts_argv[arg], '{');
-			    char *right = strrchr(rts_argv[arg], '}');
-
-			    // curly braces are optional, for
-			    // backwards compat.
-			    if (left)
-				left = left+1;
-			    else
-				left = rts_argv[arg] + 3;
-
-			    if (!right)
-				right = rts_argv[arg] + strlen(rts_argv[arg]);
-
-			    *right = '\0';
-
-			    switch (rts_argv[arg][2]) {
-			    case 'c': // cost centre label select
-				RtsFlags.ProfFlags.ccSelector = left;
-				break;
-			    case 'C':
-				RtsFlags.ProfFlags.ccsSelector = left;
-				break;
-			    case 'M':
-			    case 'm': // cost centre module select
-				RtsFlags.ProfFlags.modSelector = left;
-				break;
-			    case 'D':
-			    case 'd': // closure descr select 
-				RtsFlags.ProfFlags.descrSelector = left;
-				break;
-			    case 'Y':
-			    case 'y': // closure type select
-				RtsFlags.ProfFlags.typeSelector = left;
-				break;
-			    case 'R':
-			    case 'r': // retainer select
-				RtsFlags.ProfFlags.retainerSelector = left;
-				break;
-			    case 'B':
-			    case 'b': // biography select
-				RtsFlags.ProfFlags.bioSelector = left;
-				break;
-			    }
-			}
-			break;
-		    }
-
-		    if (RtsFlags.ProfFlags.doHeapProfile != 0) {
-			errorBelch("multiple heap profile options");
-			error = rtsTrue;
-			break;
-		    }
-
-		    switch (rts_argv[arg][2]) {
-		    case '\0':
-		    case 'C':
-		    case 'c':
-			RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_CCS;
-			break;
-		    case 'M':
-		    case 'm':
-			  RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_MOD;
-			  break;
-		    case 'D':
-		    case 'd':
-			  RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_DESCR;
-			  break;
-		    case 'Y':
-		    case 'y':
-			  RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_TYPE;
-			  break;
-		    case 'R':
-		    case 'r':
-			  RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_RETAINER;
-			  break;
-		    case 'B':
-		    case 'b':
-			  RtsFlags.ProfFlags.doHeapProfile = HEAP_BY_LDV;
-			  break;
-		    }
-		    break;
-		      
-		default:
-		    errorBelch("invalid heap profile option: %s",rts_argv[arg]);
-		    error = rtsTrue;
-		}
-		) 
-#endif /* PROFILING */
-    	    	break;
-
-#if defined(PROFILING) 
-    	      case 'i':	/* heap sample interval */
-		if (rts_argv[arg][2] == '\0') {
-		  /* use default */
-		} else {
-		    I_ cst; /* tmp */
-
-		    /* Convert to milliseconds */
-		    cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
-		    cst = (cst / CS_MIN_MILLISECS) * CS_MIN_MILLISECS;
-		    if (cst != 0 && cst < CS_MIN_MILLISECS)
-			cst = CS_MIN_MILLISECS;
-
-		    RtsFlags.ProfFlags.profileInterval = cst;
-		}
-		break;
-#endif
-
-	      /* =========== CONCURRENT ========================= */
-    	      case 'C':	/* context switch interval */
-		if (rts_argv[arg][2] == '\0')
-    	    	    RtsFlags.ConcFlags.ctxtSwitchTime = 0;
-		else {
-		    I_ cst; /* tmp */
-
-		    /* Convert to milliseconds */
-		    cst = (I_) ((atof(rts_argv[arg]+2) * 1000));
-		    cst = (cst / CS_MIN_MILLISECS) * CS_MIN_MILLISECS;
-		    if (cst != 0 && cst < CS_MIN_MILLISECS)
-			cst = CS_MIN_MILLISECS;
-
-		    RtsFlags.ConcFlags.ctxtSwitchTime = cst;
-		}
-    	    	break;
-
-#ifdef THREADED_RTS
-	      case 'N':
-		THREADED_BUILD_ONLY(
-		if (rts_argv[arg][2] != '\0') {
-		    RtsFlags.ParFlags.nNodes
-		      = strtol(rts_argv[arg]+2, (char **) NULL, 10);
-		    if (RtsFlags.ParFlags.nNodes <= 0) {
-		      errorBelch("bad value for -N");
-		      error = rtsTrue;
-		    }
-		}
-		) break;
-
-	    case 'q':
-		    switch (rts_argv[arg][2]) {
-		    case '\0':
-			errorBelch("incomplete RTS option: %s",rts_argv[arg]);
-			error = rtsTrue;
-			break;
-		    case 'm':
-			RtsFlags.ParFlags.migrate = rtsFalse;
-			break;
-		    case 'w':
-			RtsFlags.ParFlags.wakeupMigrate = rtsTrue;
-			break;
-		    default:
-			errorBelch("unknown RTS option: %s",rts_argv[arg]);
-			error = rtsTrue;
-			break;
-		    }
-		    break;
-#endif
-	      /* =========== PARALLEL =========================== */
-	      case 'e':
-		PAR_OR_THREADED_BUILD_ONLY(
-		if (rts_argv[arg][2] != '\0') {
-		    RtsFlags.ParFlags.maxLocalSparks
-		      = strtol(rts_argv[arg]+2, (char **) NULL, 10);
-		    if (RtsFlags.ParFlags.maxLocalSparks <= 0) {
-		      errorBelch("bad value for -e");
-		      error = rtsTrue;
-		    }
-		}
-		) break;
-
-#ifdef PAR
-    	      case 'q':
-		PAR_BUILD_ONLY(
-		  process_par_option(arg, rts_argc, rts_argv, &error);
-		) break;
-#endif
-
-	      /* =========== GRAN =============================== */
-
-    	      case 'b':
-		GRAN_BUILD_ONLY(
-		  process_gran_option(arg, rts_argc, rts_argv, &error);
-		) break;
-
-	      /* =========== TICKY ============================== */
-
-	      case 'r': /* Basic profiling stats */
-		TICKY_BUILD_ONLY(
-
-		RtsFlags.TickyFlags.showTickyStats = rtsTrue;
-
-		{ 
-		    int r;
-		    r = open_stats_file(arg, *argc, argv,
-					*rts_argc, rts_argv, TICKY_FILENAME_FMT,
-					&RtsFlags.TickyFlags.tickyFile);
-		    if (r == -1) { error = rtsTrue; }
-		}
-	        ) break;
-
-	      /* =========== EXTENDED OPTIONS =================== */
-
-              case 'x': /* Extend the argument space */
-                switch(rts_argv[arg][2]) {
-                  case '\0':
-		    errorBelch("incomplete RTS option: %s",rts_argv[arg]);
-		    error = rtsTrue;
-		    break;
-
-                  case 'c': /* Debugging tool: show current cost centre on an exception */
-                    PROFILING_BUILD_ONLY(
-			RtsFlags.ProfFlags.showCCSOnException = rtsTrue;
-			);
-		    break;
-
-		case 't':  /* Include memory used by TSOs in a heap profile */
-		    PROFILING_BUILD_ONLY(
-			RtsFlags.ProfFlags.includeTSOs = rtsTrue;
-			);
-		    break;
-
-                  /* The option prefix '-xx' is reserved for future extension.  KSW 1999-11. */
-
-	          default:
-		    errorBelch("unknown RTS option: %s",rts_argv[arg]);
-		    error = rtsTrue;
-		    break;
-                }
-                break;  /* defensive programming */
-
-	      /* =========== OH DEAR ============================ */
-	      default:
-		errorBelch("unknown RTS option: %s",rts_argv[arg]);
-		error = rtsTrue;
-		break;
-	    }
-	}
-    }
-    if (error) {
-	const char **p;
-
-        fflush(stdout);
-	for (p = usage_text; *p; p++)
-	    errorBelch("%s", *p);
-	stg_exit(EXIT_FAILURE);
-    }
-}
-
-#if defined(GRAN)
-
-//@node GranSim specific options, Aux fcts, Command-line option parsing routines
-//@subsection GranSim specific options
-
-static void
-enable_GranSimLight(void) {
-
-    debugBelch("GrAnSim Light enabled (infinite number of processors;  0 communication costs)\n");
-    RtsFlags.GranFlags.Light=rtsTrue;
-    RtsFlags.GranFlags.Costs.latency = 
-	RtsFlags.GranFlags.Costs.fetchtime = 
-	RtsFlags.GranFlags.Costs.additional_latency =
-	RtsFlags.GranFlags.Costs.gunblocktime = 
-	RtsFlags.GranFlags.Costs.lunblocktime =
-	RtsFlags.GranFlags.Costs.threadcreatetime = 
-	RtsFlags.GranFlags.Costs.threadqueuetime =
-	RtsFlags.GranFlags.Costs.threadscheduletime = 
-	RtsFlags.GranFlags.Costs.threaddescheduletime =
-	RtsFlags.GranFlags.Costs.threadcontextswitchtime = 0;
-  
-    RtsFlags.GranFlags.Costs.mpacktime = 
-	RtsFlags.GranFlags.Costs.munpacktime = 0;
-
-    RtsFlags.GranFlags.DoFairSchedule = rtsTrue;
-    RtsFlags.GranFlags.DoAsyncFetch = rtsFalse;
-    RtsFlags.GranFlags.DoAlwaysCreateThreads = rtsTrue;
-    /* FetchStrategy is irrelevant in GrAnSim-Light */
-
-    /* GrAnSim Light often creates an abundance of parallel threads,
-       each with its own stack etc. Therefore, it's in general a good
-       idea to use small stack chunks (use the -o<size> option to 
-       increase it again). 
-    */
-    // RtsFlags.ConcFlags.stkChunkSize = 100;
-
-    RtsFlags.GranFlags.proc = 1; 
-}
-
-static void
-process_gran_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error)
-{
-    if (rts_argv[arg][1] != 'b') /* All GranSim options start with -b */
-      return;
-
-    /* or a ridiculously idealised simulator */
-    if(strcmp((rts_argv[arg]+2),"oring")==0) {
-      RtsFlags.GranFlags.Costs.latency = 
-	RtsFlags.GranFlags.Costs.fetchtime = 
-	RtsFlags.GranFlags.Costs.additional_latency =
-	RtsFlags.GranFlags.Costs.gunblocktime = 
-	RtsFlags.GranFlags.Costs.lunblocktime =
-	RtsFlags.GranFlags.Costs.threadcreatetime = 
-	RtsFlags.GranFlags.Costs.threadqueuetime =
-	RtsFlags.GranFlags.Costs.threadscheduletime = 
-	RtsFlags.GranFlags.Costs.threaddescheduletime =
-	RtsFlags.GranFlags.Costs.threadcontextswitchtime = 0;
-
-      RtsFlags.GranFlags.Costs.mpacktime = 
-	RtsFlags.GranFlags.Costs.munpacktime = 0;
-
-      RtsFlags.GranFlags.Costs.arith_cost = 
-	RtsFlags.GranFlags.Costs.float_cost = 
-	RtsFlags.GranFlags.Costs.load_cost =
-	RtsFlags.GranFlags.Costs.store_cost = 
-	RtsFlags.GranFlags.Costs.branch_cost = 0;
-
-      RtsFlags.GranFlags.Costs.heapalloc_cost = 1;
-
-      /* ++RtsFlags.GranFlags.DoFairSchedule; */
-      RtsFlags.GranFlags.DoStealThreadsFirst = rtsTrue;        /* -bZ */
-      RtsFlags.GranFlags.DoThreadMigration   = rtsTrue;        /* -bM */
-      RtsFlags.GranFlags.GranSimStats.Full   = rtsTrue;        /* -bP */
-      return;
-    }
-
-      /* or a somewhat idealised simulator */
-      if(strcmp((rts_argv[arg]+2),"onzo")==0) {
-	RtsFlags.GranFlags.Costs.latency = 
-	RtsFlags.GranFlags.Costs.fetchtime = 
-	RtsFlags.GranFlags.Costs.additional_latency =
-	RtsFlags.GranFlags.Costs.gunblocktime = 
-	RtsFlags.GranFlags.Costs.lunblocktime =
-	RtsFlags.GranFlags.Costs.threadcreatetime = 
-	RtsFlags.GranFlags.Costs.threadqueuetime =
-	RtsFlags.GranFlags.Costs.threadscheduletime = 
-	RtsFlags.GranFlags.Costs.threaddescheduletime =
-	RtsFlags.GranFlags.Costs.threadcontextswitchtime = 0;
-
-	RtsFlags.GranFlags.Costs.mpacktime = 
-	RtsFlags.GranFlags.Costs.munpacktime = 0;
-	
-	RtsFlags.GranFlags.Costs.heapalloc_cost = 1;
-
-	/* RtsFlags.GranFlags.DoFairSchedule  = rtsTrue; */       /* -b-R */
-	/* RtsFlags.GranFlags.DoStealThreadsFirst = rtsTrue; */   /* -b-T */
-	RtsFlags.GranFlags.DoAsyncFetch = rtsTrue;         /* -bZ */
-	RtsFlags.GranFlags.DoThreadMigration  = rtsTrue;          /* -bM */
-	RtsFlags.GranFlags.GranSimStats.Full  = rtsTrue;          /* -bP */
-#  if defined(GRAN_CHECK) && defined(GRAN)
-	RtsFlags.GranFlags.Debug.event_stats = rtsTrue; /* print event statistics   */
-#  endif
-	return;
-      }
-
-      /* Communication and task creation cost parameters */
-      switch(rts_argv[arg][2]) {
-        case '.':
-	  IgnoreYields = rtsTrue; // HWL HACK
-	  break;
-
-        case ':':
-	  enable_GranSimLight();       /* set flags for GrAnSim-Light mode */
-	  break;
-
-        case 'l':
-	  if (rts_argv[arg][3] != '\0')
-	    {
-	      RtsFlags.GranFlags.Costs.gunblocktime = 
-	      RtsFlags.GranFlags.Costs.latency = decode(rts_argv[arg]+3);
-	      RtsFlags.GranFlags.Costs.fetchtime = 2*RtsFlags.GranFlags.Costs.latency;
-	    }
-	  else
-	    RtsFlags.GranFlags.Costs.latency = LATENCY;
-	  break;
-
-        case 'a':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.additional_latency = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.additional_latency = ADDITIONAL_LATENCY;
-	  break;
-
-        case 'm':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.mpacktime = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.mpacktime = MSGPACKTIME;
-	  break;
-
-        case 'x':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.mtidytime = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.mtidytime = 0;
-	  break;
-
-        case 'r':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.munpacktime = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.munpacktime = MSGUNPACKTIME;
-	  break;
-	  
-        case 'g':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.fetchtime = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.fetchtime = FETCHTIME;
-	  break;
-	  
-        case 'n':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.gunblocktime = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.gunblocktime = GLOBALUNBLOCKTIME;
-	  break;
-
-        case 'u':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.lunblocktime = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.lunblocktime = LOCALUNBLOCKTIME;
-	  break;
-
-	/* Thread-related metrics */
-        case 't':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.threadcreatetime = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.threadcreatetime = THREADCREATETIME;
-	  break;
-	  
-        case 'q':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.threadqueuetime = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.threadqueuetime = THREADQUEUETIME;
-	  break;
-	  
-        case 'c':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.threadscheduletime = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.threadscheduletime = THREADSCHEDULETIME;
-	  
-	  RtsFlags.GranFlags.Costs.threadcontextswitchtime = RtsFlags.GranFlags.Costs.threadscheduletime
-	    + RtsFlags.GranFlags.Costs.threaddescheduletime;
-	  break;
-
-        case 'd':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.threaddescheduletime = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.threaddescheduletime = THREADDESCHEDULETIME;
-	  
-	  RtsFlags.GranFlags.Costs.threadcontextswitchtime = RtsFlags.GranFlags.Costs.threadscheduletime
-	    + RtsFlags.GranFlags.Costs.threaddescheduletime;
-	  break;
-
-	/* Instruction Cost Metrics */
-        case 'A':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.arith_cost = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.arith_cost = ARITH_COST;
-	  break;
-
-        case 'F':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.float_cost = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.float_cost = FLOAT_COST;
-	  break;
-		      
-        case 'B':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.branch_cost = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.branch_cost = BRANCH_COST;
-	  break;
-
-        case 'L':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.load_cost = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.load_cost = LOAD_COST;
-	  break;
-	  
-        case 'S':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.store_cost = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.store_cost = STORE_COST;
-	  break;
-
-        case 'H':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.heapalloc_cost = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.heapalloc_cost = 0;
-	  break;
-
-        case 'y':
-	  RtsFlags.GranFlags.DoAsyncFetch = rtsTrue;
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.FetchStrategy = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.FetchStrategy = 2;
-	  if (RtsFlags.GranFlags.FetchStrategy == 0)
-	    RtsFlags.GranFlags.DoAsyncFetch = rtsFalse;
-	  break;
-	  
-        case 'K':   /* sort overhead (per elem in spark list) */
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.pri_spark_overhead = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.pri_spark_overhead = PRI_SPARK_OVERHEAD;
-	  debugBelch("Overhead for pri spark: %d (per elem).\n",
-		         RtsFlags.GranFlags.Costs.pri_spark_overhead);
-	  break;
-
-        case 'O':  /* sort overhead (per elem in spark list) */
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.Costs.pri_sched_overhead = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.Costs.pri_sched_overhead = PRI_SCHED_OVERHEAD;
-	  debugBelch("Overhead for pri sched: %d (per elem).\n",
-		       RtsFlags.GranFlags.Costs.pri_sched_overhead);
-	  break;
-
-        /* General Parameters */
-        case 'p':
-	  if (rts_argv[arg][3] != '\0')
-	    {
-	      RtsFlags.GranFlags.proc = decode(rts_argv[arg]+3);
-	      if (RtsFlags.GranFlags.proc==0) {
-		  enable_GranSimLight(); /* set flags for GrAnSim-Light mode */
-	      } else if (RtsFlags.GranFlags.proc > MAX_PROC || 
-			 RtsFlags.GranFlags.proc < 1)
-		{
-		  debugBelch("setupRtsFlags: no more than %u processors allowed\n",
-			  MAX_PROC);
-		  *error = rtsTrue;
-		}
-	    }
-	  else
-	    RtsFlags.GranFlags.proc = MAX_PROC;
-	  break;
-
-        case 'f':
-	  RtsFlags.GranFlags.Fishing = rtsTrue;
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.maxFishes = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.maxFishes = MAX_FISHES;
-	  break;
-	  
-        case 'w':
-	  if (rts_argv[arg][3] != '\0')
-	    RtsFlags.GranFlags.time_slice = decode(rts_argv[arg]+3);
-	  else
-	    RtsFlags.GranFlags.time_slice = GRAN_TIME_SLICE;
-	  break;
-	  
-        case 'C':
-	  RtsFlags.GranFlags.DoAlwaysCreateThreads=rtsTrue;
-	  RtsFlags.GranFlags.DoThreadMigration=rtsTrue;
-	  break;
-
-        case 'G':
-	  debugBelch("Bulk fetching enabled.\n");
-	  RtsFlags.GranFlags.DoBulkFetching=rtsTrue;
-	  break;
-	  
-        case 'M':
-	  debugBelch("Thread migration enabled.\n");
-	  RtsFlags.GranFlags.DoThreadMigration=rtsTrue;
-	  break;
-
-        case 'R':
-	  debugBelch("Fair Scheduling enabled.\n");
-	  RtsFlags.GranFlags.DoFairSchedule=rtsTrue;
-	  break;
-	  
-        case 'I':
-	  debugBelch("Priority Scheduling enabled.\n");
-	  RtsFlags.GranFlags.DoPriorityScheduling=rtsTrue;
-	  break;
-
-        case 'T':
-	  RtsFlags.GranFlags.DoStealThreadsFirst=rtsTrue;
-	  RtsFlags.GranFlags.DoThreadMigration=rtsTrue;
-	  break;
-	  
-        case 'Z':
-	  RtsFlags.GranFlags.DoAsyncFetch=rtsTrue;
-	  break;
-	  
-/*          case 'z': */
-/*  	  RtsFlags.GranFlags.SimplifiedFetch=rtsTrue; */
-/*  	  break; */
-	  
-        case 'N':
-	  RtsFlags.GranFlags.PreferSparksOfLocalNodes=rtsTrue;
-	  break;
-	  
-        case 'b':
-	  RtsFlags.GranFlags.GranSimStats.Binary=rtsTrue;
-	  break;
-	  
-        case 'P':
-	  /* format is -bP<c> where <c> is one char describing kind of profile */
-	  RtsFlags.GranFlags.GranSimStats.Full = rtsTrue;
-	  switch(rts_argv[arg][3]) {
-	  case '\0': break; // nothing special, just an ordinary profile
-	  case '0': RtsFlags.GranFlags.GranSimStats.Suppressed = rtsTrue;
-	    break;
-	  case 'b': RtsFlags.GranFlags.GranSimStats.Binary = rtsTrue;
-	    break;
-	  case 's': RtsFlags.GranFlags.GranSimStats.Sparks = rtsTrue;
-	    break;
-	  case 'h': RtsFlags.GranFlags.GranSimStats.Heap = rtsTrue;
-	    break;
-	  case 'n': RtsFlags.GranFlags.GranSimStats.NewLogfile = rtsTrue;
-	    break;
-	  case 'g': RtsFlags.GranFlags.GranSimStats.Global = rtsTrue;
-	    break;
-	  default: barf("Unknown option -bP%c", rts_argv[arg][3]);
-	  }
-	  break;
-
-        case 's':
-	  RtsFlags.GranFlags.GranSimStats.Sparks=rtsTrue;
-	  break;
-
-        case 'h':
-	  RtsFlags.GranFlags.GranSimStats.Heap=rtsTrue;
-	  break;
-
-        case 'Y':   /* syntax: -bY<n>[,<n>]  n ... pos int */ 
-	  if (rts_argv[arg][3] != '\0') {
-	    char *arg0, *tmp;
-	    
-	    arg0 = rts_argv[arg]+3;
-	    if ((tmp = strstr(arg0,","))==NULL) {
-	      RtsFlags.GranFlags.SparkPriority = decode(arg0);
-	      debugBelch("SparkPriority: %u.\n",RtsFlags.GranFlags.SparkPriority);
-	    } else {
-	      *(tmp++) = '\0'; 
-	      RtsFlags.GranFlags.SparkPriority = decode(arg0);
-	      RtsFlags.GranFlags.SparkPriority2 = decode(tmp);
-	      debugBelch("SparkPriority: %u.\n",
-		      RtsFlags.GranFlags.SparkPriority);
-	      debugBelch("SparkPriority2:%u.\n",
-		      RtsFlags.GranFlags.SparkPriority2);
-	      if (RtsFlags.GranFlags.SparkPriority2 < 
-		  RtsFlags.GranFlags.SparkPriority) {
-		debugBelch("WARNING: 2nd pri < main pri (%u<%u); 2nd pri has no effect\n",
-			RtsFlags.GranFlags.SparkPriority2,
-			RtsFlags.GranFlags.SparkPriority);
-	      }
-	    }
-	  } else {
-	    /* plain pri spark is now invoked with -bX  
-	       RtsFlags.GranFlags.DoPrioritySparking = 1;
-	       debugBelch("PrioritySparking.\n");
-	    */
-	  }
-	  break;
-
-        case 'Q':
-	  if (rts_argv[arg][3] != '\0') {
-	    RtsFlags.GranFlags.ThunksToPack = decode(rts_argv[arg]+3);
-	  } else {
-	    RtsFlags.GranFlags.ThunksToPack = 1;
-	  }
-	  debugBelch("Thunks To Pack in one packet: %u.\n",
-		  RtsFlags.GranFlags.ThunksToPack);
-	  break;
-		      
-        case 'e':
-	  RtsFlags.GranFlags.RandomSteal = rtsFalse;
-	  debugBelch("Deterministic mode (no random stealing)\n");
-		      break;
-
-	  /* The following class of options contains eXperimental */
-	  /* features in connection with exploiting granularity */
-	  /* information. I.e. if -bY is chosen these options */
-	  /* tell the RTS what to do with the supplied info --HWL */
-
-        case 'W':
-	  if (rts_argv[arg][3] != '\0') {
-	    RtsFlags.GranFlags.packBufferSize_internal = decode(rts_argv[arg]+3);
-	  } else {
-	    RtsFlags.GranFlags.packBufferSize_internal = GRANSIM_DEFAULT_PACK_BUFFER_SIZE;
-	  }
-	  debugBelch("Size of GranSim internal pack buffer: %u.\n",
-		  RtsFlags.GranFlags.packBufferSize_internal);
-	  break;
-  		      
-        case 'X':
-	  switch(rts_argv[arg][3]) {
-	    
-	    case '\0':
-	      RtsFlags.GranFlags.DoPrioritySparking = 1;
-	      debugBelch("Priority Sparking with Normal Priorities.\n");
-	      RtsFlags.GranFlags.InversePriorities = rtsFalse; 
-	      RtsFlags.GranFlags.RandomPriorities = rtsFalse;
-	      RtsFlags.GranFlags.IgnorePriorities = rtsFalse;
-	      break;
-			
-	    case 'I':
-	      RtsFlags.GranFlags.DoPrioritySparking = 1;
-	      debugBelch("Priority Sparking with Inverse Priorities.\n");
-	      RtsFlags.GranFlags.InversePriorities++; 
-	      break;
-	      
-	    case 'R': 
-	      RtsFlags.GranFlags.DoPrioritySparking = 1;
-	      debugBelch("Priority Sparking with Random Priorities.\n");
-	      RtsFlags.GranFlags.RandomPriorities++;
-	      break;
-	      
-	    case 'N':
-	      RtsFlags.GranFlags.DoPrioritySparking = 1;
-	      debugBelch("Priority Sparking with No Priorities.\n");
-	      RtsFlags.GranFlags.IgnorePriorities++;
-	      break;
-	      
-	    default:
-	      bad_option( rts_argv[arg] );
-	      break;
-	  }
-	  break;
-
-        case '-':
-	  switch(rts_argv[arg][3]) {
-	    
-	    case 'C':
-	      RtsFlags.GranFlags.DoAlwaysCreateThreads=rtsFalse;
-	      RtsFlags.GranFlags.DoThreadMigration=rtsFalse;
-	      break;
-
-	    case 'G':
-	      RtsFlags.GranFlags.DoBulkFetching=rtsFalse;
-	      break;
-	      
-	    case 'M':
-	      RtsFlags.GranFlags.DoThreadMigration=rtsFalse;
-	      break;
-
-	    case 'R':
-	      RtsFlags.GranFlags.DoFairSchedule=rtsFalse;
-	      break;
-
-	    case 'T':
-	      RtsFlags.GranFlags.DoStealThreadsFirst=rtsFalse;
-	      RtsFlags.GranFlags.DoThreadMigration=rtsFalse;
-	      break;
-
-	    case 'Z':
-	      RtsFlags.GranFlags.DoAsyncFetch=rtsFalse;
-	      break;
-	      
-	    case 'N':
-	      RtsFlags.GranFlags.PreferSparksOfLocalNodes=rtsFalse;
-			 break;
-			 
-	    case 'P':
-	      RtsFlags.GranFlags.GranSimStats.Suppressed=rtsTrue;
-	      break;
-
-	    case 's':
-	      RtsFlags.GranFlags.GranSimStats.Sparks=rtsFalse;
-	      break;
-	    
-	    case 'h':
-	      RtsFlags.GranFlags.GranSimStats.Heap=rtsFalse;
-	      break;
-	    
-	    case 'b':
-	      RtsFlags.GranFlags.GranSimStats.Binary=rtsFalse;
-	      break;
-			 
-	    case 'X':
-	      RtsFlags.GranFlags.DoPrioritySparking = rtsFalse;
-	      break;
-
-	    case 'Y':
-	      RtsFlags.GranFlags.DoPrioritySparking = rtsFalse;
-	      RtsFlags.GranFlags.SparkPriority = rtsFalse;
-	      break;
-
-	    case 'I':
-	      RtsFlags.GranFlags.DoPriorityScheduling = rtsFalse;
-	      break;
-
-	    case 'e':
-	      RtsFlags.GranFlags.RandomSteal = rtsFalse;
-	      break;
-
-	    default:
-	      bad_option( rts_argv[arg] );
-	      break;
-	  }
-	  break;
-
-#  if defined(GRAN_CHECK) && defined(GRAN)
-        case 'D':
-	  switch(rts_argv[arg][3]) {
-	    case 'Q':    /* Set pack buffer size (same as 'Q' in GUM) */
-	      if (rts_argv[arg][4] != '\0') {
-		RtsFlags.GranFlags.packBufferSize = decode(rts_argv[arg]+4);
-		debugBelch("Pack buffer size: %d\n",
-			RtsFlags.GranFlags.packBufferSize);
-	      } else {
-    	    	debugBelch("setupRtsFlags: missing size of PackBuffer (for -Q)\n");
-    	    	*error = rtsTrue;
-    	      }
-	      break;
-
-	  default:
-	      if (isdigit(rts_argv[arg][3])) {/* Set all debugging options in one */
-	    	/* hack warning: interpret the flags as a binary number */
-	    	nat n = decode(rts_argv[arg]+3);
-		set_GranSim_debug_options(n);
-	      } else {
-		nat i;
-		for (i=0; i<=MAX_GRAN_DEBUG_OPTION; i++) 
-		  if (rts_argv[arg][3] == gran_debug_opts_flags[i])
-		    break;
-		
-		if (i==MAX_GRAN_DEBUG_OPTION+1) {
-		  debugBelch("Valid GranSim debug options are:\n");
-		  help_GranSim_debug_options(MAX_GRAN_DEBUG_MASK);
-		  bad_option( rts_argv[arg] );
-		} else { // flag found; now set it
-		  set_GranSim_debug_options(GRAN_DEBUG_MASK(i));  // 2^i
-		}
-	      }
-	      break;
-	      
-#if 0
-	    case 'e':       /* event trace; also -bD1 */
-	      debugBelch("DEBUG: event_trace; printing event trace.\n");
-	      RtsFlags.GranFlags.Debug.event_trace = rtsTrue;
-	      /* RtsFlags.GranFlags.event_trace=rtsTrue; */
-	      break;
-	      
-	    case 'E':       /* event statistics; also -bD2 */
-	      debugBelch("DEBUG: event_stats; printing event statistics.\n");
-	      RtsFlags.GranFlags.Debug.event_stats = rtsTrue;
-	      /* RtsFlags.GranFlags.Debug |= 0x20; print event statistics   */
-	      break;
-	      
-	    case 'f':       /* thunkStealing; also -bD4 */
-	      debugBelch("DEBUG: thunkStealing; printing forwarding of FETCHNODES.\n");
-	      RtsFlags.GranFlags.Debug.thunkStealing = rtsTrue;
-	      /* RtsFlags.GranFlags.Debug |= 0x2;  print fwd messages */
-	      break;
-
-	    case 'z':       /* blockOnFetch; also -bD8 */
-	      debugBelch("DEBUG: blockOnFetch; check for blocked on fetch.\n");
-	      RtsFlags.GranFlags.Debug.blockOnFetch = rtsTrue;
-	      /* RtsFlags.GranFlags.Debug |= 0x4; debug non-reschedule-on-fetch */
-	      break;
-	      
-	    case 't':       /* blockOnFetch_sanity; also -bD16 */  
-	      debugBelch("DEBUG: blockOnFetch_sanity; check for TSO asleep on fetch.\n");
-	      RtsFlags.GranFlags.Debug.blockOnFetch_sanity = rtsTrue;
-	      /* RtsFlags.GranFlags.Debug |= 0x10; debug TSO asleep for fetch  */
-	      break;
-
-	    case 'S':       /* priSpark; also -bD32 */
-	      debugBelch("DEBUG: priSpark; priority sparking.\n");
-	      RtsFlags.GranFlags.Debug.priSpark = rtsTrue;
-	      break;
-
-	    case 's':       /* priSched; also -bD64 */
-	      debugBelch("DEBUG: priSched; priority scheduling.\n");
-	      RtsFlags.GranFlags.Debug.priSched = rtsTrue;
-	      break;
-
-	    case 'F':       /* findWork; also -bD128 */
-	      debugBelch("DEBUG: findWork; searching spark-pools (local & remote), thread queues for work.\n");
-	      RtsFlags.GranFlags.Debug.findWork = rtsTrue;
-	      break;
-	      
-	    case 'g':       /* globalBlock; also -bD256 */
-	      debugBelch("DEBUG: globalBlock; blocking on remote closures (FETCHMEs etc in GUM).\n");
-	      RtsFlags.GranFlags.Debug.globalBlock = rtsTrue;
-	      break;
-	      
-	    case 'G':       /* pack; also -bD512 */
-	      debugBelch("DEBUG: pack; routines for (un-)packing graph structures.\n");
-	      RtsFlags.GranFlags.Debug.pack = rtsTrue;
-	      break;
-	      
-	    case 'P':       /* packBuffer; also -bD1024 */
-	      debugBelch("DEBUG: packBuffer; routines handling pack buffer (GranSim internal!).\n");
-	      RtsFlags.GranFlags.Debug.packBuffer = rtsTrue;
-	      break;
-	      
-	    case 'o':       /* sortedQ; also -bD2048 */
-	      debugBelch("DEBUG: sortedQ; check whether spark/thread queues are sorted.\n");
-	      RtsFlags.GranFlags.Debug.sortedQ = rtsTrue;
-	      break;
-	      
-	    case 'r':       /* randomSteal; also -bD4096 */
-	      debugBelch("DEBUG: randomSteal; stealing sparks/threads from random PEs.\n");
-	      RtsFlags.GranFlags.Debug.randomSteal = rtsTrue;
-	      break;
-	      
-	    case 'q':       /* checkSparkQ; also -bD8192 */
-	      debugBelch("DEBUG: checkSparkQ; check consistency of the spark queues.\n");
-	      RtsFlags.GranFlags.Debug.checkSparkQ = rtsTrue;
-	      break;
-	      
-	    case ':':       /* checkLight; also -bD16384 */
-	      debugBelch("DEBUG: checkLight; check GranSim-Light setup.\n");
-	      RtsFlags.GranFlags.Debug.checkLight = rtsTrue;
-	      break;
-	      
-	    case 'b':       /* bq; also -bD32768 */
-	      debugBelch("DEBUG: bq; check blocking queues\n");
-	      RtsFlags.GranFlags.Debug.bq = rtsTrue;
-	      break;
-	      
-	    case 'd':       /* all options turned on */
-	      debugBelch("DEBUG: all options turned on.\n");
-	      set_GranSim_debug_options(MAX_GRAN_DEBUG_MASK);
-	      /* RtsFlags.GranFlags.Debug |= 0x40; */
-	      break;
-
-/*  	    case '\0': */
-/*  	      RtsFlags.GranFlags.Debug = 1; */
-/*  	      break; */
-#endif
-
-	  }
-	  break;
-#  endif  /* GRAN_CHECK */
-      default:
-	bad_option( rts_argv[arg] );
-	break;
-      }
-}
-
-/*
-  Interpret n as a binary number masking GranSim debug options and set the 
-  correxponding option. See gran_debug_opts_strs for explanations of the flags.
-*/
-static void
-set_GranSim_debug_options(nat n) {
-  nat i;
-
-  for (i=0; i<=MAX_GRAN_DEBUG_OPTION; i++) 
-    if ((n>>i)&1) {
-      errorBelch(gran_debug_opts_strs[i]);
-      switch (i) {
-        case 0: RtsFlags.GranFlags.Debug.event_trace   = rtsTrue;  break;
-        case 1: RtsFlags.GranFlags.Debug.event_stats   = rtsTrue;  break;
-        case 2: RtsFlags.GranFlags.Debug.bq            = rtsTrue;  break;
-        case 3: RtsFlags.GranFlags.Debug.pack          = rtsTrue;  break;
-        case 4: RtsFlags.GranFlags.Debug.checkSparkQ   = rtsTrue;  break;
-        case 5: RtsFlags.GranFlags.Debug.thunkStealing = rtsTrue;  break;
-        case 6: RtsFlags.GranFlags.Debug.randomSteal   = rtsTrue;  break;
-        case 7: RtsFlags.GranFlags.Debug.findWork      = rtsTrue;  break;
-        case 8: RtsFlags.GranFlags.Debug.unused        = rtsTrue;  break;
-        case 9: RtsFlags.GranFlags.Debug.pri           = rtsTrue;  break;
-        case 10: RtsFlags.GranFlags.Debug.checkLight   = rtsTrue;  break;
-        case 11: RtsFlags.GranFlags.Debug.sortedQ      = rtsTrue;  break;
-        case 12: RtsFlags.GranFlags.Debug.blockOnFetch = rtsTrue;  break;
-        case 13: RtsFlags.GranFlags.Debug.packBuffer   = rtsTrue;  break;
-        case 14: RtsFlags.GranFlags.Debug.blockOnFetch_sanity = rtsTrue;  break;
-        default: barf("set_GranSim_debug_options: only %d debug options expected");
-      } /* switch */
-    } /* if */
-}
-
-/*
-  Print one line explanation for each of the GranSim debug options specified
-  in the bitmask n.
-*/
-static void
-help_GranSim_debug_options(nat n) {
-  nat i;
-
-  for (i=0; i<=MAX_GRAN_DEBUG_OPTION; i++) 
-    if ((n>>i)&1) 
-      debugBelch(gran_debug_opts_strs[i]);
-}
-
-# elif defined(PAR)
-
-static void
-process_par_option(int arg, int *rts_argc, char *rts_argv[], rtsBool *error)
-{
-
-  if (rts_argv[arg][1] != 'q') { /* All GUM options start with -q */
-    errorBelch("Warning: GUM option does not start with -q: %s", rts_argv[arg]);
-    return;
-  }
-
-  /* Communication and task creation cost parameters */
-  switch(rts_argv[arg][2]) {
-  case 'e':  /* -qe<n>  ... allow <n> local sparks */
-    if (rts_argv[arg][3] != '\0') { /* otherwise, stick w/ the default */
-      RtsFlags.ParFlags.maxLocalSparks
-	= strtol(rts_argv[arg]+3, (char **) NULL, 10);
-      
-      if (RtsFlags.ParFlags.maxLocalSparks <= 0) {
-	errorBelch("setupRtsFlags: bad value for -e\n");
-	*error = rtsTrue;
-      }
-    }
-    IF_PAR_DEBUG(verbose,
-		 errorBelch("-qe<n>: max %d local sparks", 
-		       RtsFlags.ParFlags.maxLocalSparks));
-    break;
-  
-  case 't':
-    if (rts_argv[arg][3] != '\0') {
-      RtsFlags.ParFlags.maxThreads
-	= strtol(rts_argv[arg]+3, (char **) NULL, 10);
-    } else {
-      errorBelch("missing size for -qt\n");
-      *error = rtsTrue;
-    }
-    IF_PAR_DEBUG(verbose,
-		 errorBelch("-qt<n>: max %d threads", 
-		       RtsFlags.ParFlags.maxThreads));
-    break;
-
-  case 'f':
-    if (rts_argv[arg][3] != '\0')
-      RtsFlags.ParFlags.maxFishes = decode(rts_argv[arg]+3);
-    else
-      RtsFlags.ParFlags.maxFishes = MAX_FISHES;
-    break;
-    IF_PAR_DEBUG(verbose,
-		 errorBelch("-qf<n>: max %d fishes sent out at one time", 
-		       RtsFlags.ParFlags.maxFishes));
-    break;
-  
-  case 'F':
-    if (rts_argv[arg][3] != '\0') {
-      RtsFlags.ParFlags.fishDelay
-	= strtol(rts_argv[arg]+3, (char **) NULL, 10);
-    } else {
-      errorBelch("missing fish delay time for -qF\n");
-      *error = rtsTrue;
-    }
-    IF_PAR_DEBUG(verbose,
-		 errorBelch("-qF<n>: fish delay time %d us", 
-		       RtsFlags.ParFlags.fishDelay));
-    break;
-
-  case 'O':
-    RtsFlags.ParFlags.outputDisabled = rtsTrue;
-    IF_PAR_DEBUG(verbose,
-		 errorBelch("-qO: output disabled"));
-    break;
-  
-  case 'g': /* -qg<n> ... globalisation scheme */
-    if (rts_argv[arg][3] != '\0') {
-      RtsFlags.ParFlags.globalising = decode(rts_argv[arg]+3);
-    } else {
-      errorBelch("missing identifier for globalisation scheme (for -qg)\n");
-      *error = rtsTrue;
-    }
-    IF_PAR_DEBUG(verbose,
-		 debugBelch("-qg<n>: globalisation scheme set to  %d", 
-		       RtsFlags.ParFlags.globalising));
-    break;
-
-  case 'h': /* -qh<n> ... max number of thunks (except root) in packet */
-    if (rts_argv[arg][3] != '\0') {
-      RtsFlags.ParFlags.thunksToPack = decode(rts_argv[arg]+3);
-    } else {
-      errorBelch("missing number of thunks per packet (for -qh)\n");
-      *error = rtsTrue;
-    }
-    IF_PAR_DEBUG(verbose,
-		 debugBelch("-qh<n>: thunks per packet set to %d", 
-		       RtsFlags.ParFlags.thunksToPack));
-    break;
-
-  case 'P': /* -qP for writing a log file */
-    //RtsFlags.ParFlags.ParStats.Full = rtsFalse;
-    /* same encoding as in GranSim after -bP */	
-    switch(rts_argv[arg][3]) {
-    case '\0': RtsFlags.ParFlags.ParStats.Full = rtsTrue;
-      break; // nothing special, just an ordinary profile
-    case '0': RtsFlags.ParFlags.ParStats.Suppressed = rtsTrue;
-	RtsFlags.ParFlags.ParStats.Full = rtsFalse;
-      break;
-    case 'b': RtsFlags.ParFlags.ParStats.Binary = rtsTrue;
-      break;
-    case 's': RtsFlags.ParFlags.ParStats.Sparks = rtsTrue;
-      break;
-      //case 'h': RtsFlags.parFlags.ParStats.Heap = rtsTrue;
-      //  break;
-    case 'n': RtsFlags.ParFlags.ParStats.NewLogfile = rtsTrue;
-      break;
-    case 'g': 
-# if defined(PAR_TICKY)
-      RtsFlags.ParFlags.ParStats.Global = rtsTrue;
-# else 
-      errorBelch("-qPg is only possible for a PAR_TICKY RTS, which this is not");
-      stg_exit(EXIT_FAILURE);
-# endif
-      break;
-    default: barf("Unknown option -qP%c", rts_argv[arg][2]);
-    }
-    IF_PAR_DEBUG(verbose,
-		 debugBelch("(-qP) writing to log-file (RtsFlags.ParFlags.ParStats.Full=%s)",
-		       (RtsFlags.ParFlags.ParStats.Full ? "rtsTrue" : "rtsFalse")));
-    break;
-  
-  case 'Q': /* -qQ<n> ... set pack buffer size to <n> */
-    if (rts_argv[arg][3] != '\0') {
-      RtsFlags.ParFlags.packBufferSize = decode(rts_argv[arg]+3);
-    } else {
-      errorBelch("missing size of PackBuffer (for -qQ)\n");
-      *error = rtsTrue;
-    }
-    IF_PAR_DEBUG(verbose,
-		 debugBelch("-qQ<n>: pack buffer size set to %d", 
-		       RtsFlags.ParFlags.packBufferSize));
-    break;
-
-  case 'R':
-    RtsFlags.ParFlags.doFairScheduling = rtsTrue;
-    IF_PAR_DEBUG(verbose,
-		 debugBelch("-qR: fair-ish scheduling"));
-    break;
-  
-# if defined(DEBUG)  
-  case 'w':
-    if (rts_argv[arg][3] != '\0') {
-      RtsFlags.ParFlags.wait
-	= strtol(rts_argv[arg]+3, (char **) NULL, 10);
-    } else {
-      RtsFlags.ParFlags.wait = 1000;
-    }
-    IF_PAR_DEBUG(verbose,
-		 debugBelch("-qw<n>: length of wait loop after synchr before reduction: %d", 
-		       RtsFlags.ParFlags.wait));
-    break;
-
-  case 'D':  /* -qD ... all the debugging options */
-    if (isdigit(rts_argv[arg][3])) {/* Set all debugging options in one */
-      /* hack warning: interpret the flags as a binary number */
-      nat n = decode(rts_argv[arg]+3);
-      set_par_debug_options(n);
-    } else {
-      nat i;
-      for (i=0; i<=MAX_PAR_DEBUG_OPTION; i++) 
-	if (rts_argv[arg][3] == par_debug_opts_flags[i])
-	  break;
-	
-      if (i==MAX_PAR_DEBUG_OPTION+1) {
-	errorBelch("Valid GUM debug options are:\n");
-	help_par_debug_options(MAX_PAR_DEBUG_MASK);
-	bad_option( rts_argv[arg] );
-      } else { // flag found; now set it
-	set_par_debug_options(PAR_DEBUG_MASK(i));  // 2^i
-      }
-    }
-    break;
-# endif
-  default:
-    errorBelch("Unknown option -q%c (%d opts in total)", 
-	  rts_argv[arg][2], *rts_argc);
-    break;
-  } /* switch */
-}
-
-/*
-  Interpret n as a binary number masking Par debug options and set the 
-  correxponding option. See par_debug_opts_strs for explanations of the flags.
-*/
-static void
-set_par_debug_options(nat n) {
-  nat i;
-
-  for (i=0; i<=MAX_PAR_DEBUG_OPTION; i++) 
-    if ((n>>i)&1) {
-      debugBelch(par_debug_opts_strs[i]);
-      switch (i) {
-        case 0: RtsFlags.ParFlags.Debug.verbose       = rtsTrue;  break;
-        case 1: RtsFlags.ParFlags.Debug.bq            = rtsTrue;  break;
-        case 2: RtsFlags.ParFlags.Debug.schedule      = rtsTrue;  break;
-        case 3: RtsFlags.ParFlags.Debug.free          = rtsTrue;  break;
-        case 4: RtsFlags.ParFlags.Debug.resume        = rtsTrue;  break;
-        case 5: RtsFlags.ParFlags.Debug.weight        = rtsTrue;  break;
-        case 6: RtsFlags.ParFlags.Debug.fetch         = rtsTrue;  break;
-	  //case 7: RtsFlags.ParFlags.Debug.ack           = rtsTrue;  break;
-        case 7: RtsFlags.ParFlags.Debug.fish          = rtsTrue;  break;
-        case 8: RtsFlags.ParFlags.Debug.tables        = rtsTrue;  break;
-        case 9: RtsFlags.ParFlags.Debug.packet        = rtsTrue;  break;
-        case 10: RtsFlags.ParFlags.Debug.pack         = rtsTrue;  break;
-        case 11: RtsFlags.ParFlags.Debug.paranoia     = rtsTrue;  break;
-        default: barf("set_par_debug_options: only %d debug options expected",
-		      MAX_PAR_DEBUG_OPTION);
-      } /* switch */
-    } /* if */
-}
-
-/*
-  Print one line explanation for each of the GranSim debug options specified
-  in the bitmask n.
-*/
-static void
-help_par_debug_options(nat n) {
-  nat i;
-
-  for (i=0; i<=MAX_PAR_DEBUG_OPTION; i++) 
-    if ((n>>i)&1) 
-      debugBelch(par_debug_opts_strs[i]);
-}
-
-#endif /* PAR */
-
-//@node Aux fcts,  , GranSim specific options
-//@subsection Aux fcts
-
-static void
-stats_fprintf(FILE *f, char *s, ...)
-{
-    va_list ap;
-    va_start(ap,s);
-    if (f == NULL) {
-	vdebugBelch(s, ap);
-    } else {
-	vfprintf(f, s, ap);
-    }
-    va_end(ap);
-}
-
-static int		/* return -1 on error */
-open_stats_file (
-    I_ arg,
-    int argc, char *argv[],
-    int rts_argc, char *rts_argv[],
-    const char *FILENAME_FMT,
-    FILE **file_ret)
-{
-    FILE *f = NULL;
-
-    if (strequal(rts_argv[arg]+2, "stderr")) { /* use debugBelch */
-        f = NULL; /* NULL means use debugBelch */
-    } else {
-	if (rts_argv[arg][2] != '\0') {  /* stats file specified */
-	    f = fopen(rts_argv[arg]+2,"w");
-	} else {
-	    char stats_filename[STATS_FILENAME_MAXLEN]; /* default <program>.<ext> */
-	    sprintf(stats_filename, FILENAME_FMT, argv[0]);
-	    f = fopen(stats_filename,"w");
-	}
-	if (f == NULL) {
-	    errorBelch("Can't open stats file %s\n", rts_argv[arg]+2);
-	    return -1;
-	}
-    }
-    *file_ret = f;
-
-    {
-	/* Write argv and rtsv into start of stats file */
-	int count;
-	for(count = 0; count < argc; count++) {
-	    stats_fprintf(f, "%s ", argv[count]);
-	}
-	stats_fprintf(f, "+RTS ");
-	for(count = 0; count < rts_argc; count++)
-	    stats_fprintf(f, "%s ", rts_argv[count]);
-	stats_fprintf(f, "\n");
-    }
-    return 0;
-}
-
-
-
-static I_
-decode(const char *s)
-{
-    I_ c;
-    StgDouble m;
-
-    if (!*s)
-	return 0;
-
-    m = atof(s);
-    c = s[strlen(s)-1];
-
-    if (c == 'g' || c == 'G')
-	m *= 1000*1000*1000;	/* UNchecked! */
-    else if (c == 'm' || c == 'M')
-	m *= 1000*1000;			/* We do not use powers of 2 (1024) */
-    else if (c == 'k' || c == 'K')	/* to avoid possible bad effects on */
-	m *= 1000;			/* a direct-mapped cache.   	    */ 
-    else if (c == 'w' || c == 'W')
-	m *= sizeof(W_);
-
-    return (I_)m;
-}
-
-static void
-bad_option(const char *s)
-{
-  errorBelch("bad RTS option: %s", s);
-  stg_exit(EXIT_FAILURE);
-}
-
-/* -----------------------------------------------------------------------------
-   Getting/Setting the program's arguments.
-
-   These are used by System.Environment, and parts of the RTS.
-   -------------------------------------------------------------------------- */
-
-void
-setProgName(char *argv[])
-{
-    /* Remove directory from argv[0] -- default files in current directory */
-#if !defined(mingw32_HOST_OS)
-    char *last_slash;
-    if ( (last_slash = (char *) strrchr(argv[0], '/')) != NULL ) {
-	prog_name = last_slash+1;
-   } else {
-	prog_name = argv[0];
-   }
-#else
-    char* last_slash = argv[0] + (strlen(argv[0]) - 1);
-    while ( last_slash > argv[0] ) {
-	if ( *last_slash == '/' || *last_slash == '\\' ) {
-	    prog_name = last_slash+1;
-	    return;
-	}
-	last_slash--;
-    }
-    prog_name = argv[0];
-#endif
-}
-
-void
-getProgArgv(int *argc, char **argv[])
-{
-    if (argc) { *argc = prog_argc; }
-    if (argv) { *argv = prog_argv; }
-}
-
-void
-setProgArgv(int argc, char *argv[])
-{
-   /* Usually this is done by startupHaskell, so we don't need to call this. 
-      However, sometimes Hugs wants to change the arguments which Haskell
-      getArgs >>= ... will be fed.  So you can do that by calling here
-      _after_ calling startupHaskell.
-   */
-   prog_argc = argc;
-   prog_argv = argv;
-   setProgName(prog_argv);
-}
diff --git a/ghc/rts/RtsMessages.c b/ghc/rts/RtsMessages.c
deleted file mode 100644
index 1242d886eb..0000000000
--- a/ghc/rts/RtsMessages.c
+++ /dev/null
@@ -1,201 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * General utility functions used in the RTS.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-
-#include <stdio.h>
-
-#ifdef HAVE_WINDOWS_H
-#include <windows.h>
-#endif
-
-/* -----------------------------------------------------------------------------
-   General message generation functions
-
-   All messages should go through here.  We can't guarantee that
-   stdout/stderr will be available - e.g. in a Windows program there
-   is no console for generating messages, so they have to either go to
-   to the debug console, or pop up message boxes.
-   -------------------------------------------------------------------------- */
-
-// Default to the stdio implementation of these hooks.
-RtsMsgFunction *fatalInternalErrorFn = rtsFatalInternalErrorFn;
-RtsMsgFunction *debugMsgFn           = rtsDebugMsgFn;
-RtsMsgFunction *errorMsgFn           = rtsErrorMsgFn;
-
-void
-barf(char *s, ...)
-{
-  va_list ap;
-  va_start(ap,s);
-  (*fatalInternalErrorFn)(s,ap);
-  stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
-  va_end(ap);
-}
-
-void
-vbarf(char *s, va_list ap)
-{
-  (*fatalInternalErrorFn)(s,ap);
-  stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
-}
-
-void 
-_assertFail(char *filename, unsigned int linenum)
-{
-    barf("ASSERTION FAILED: file %s, line %u\n", filename, linenum);
-}
-
-void
-errorBelch(char *s, ...)
-{
-  va_list ap;
-  va_start(ap,s);
-  (*errorMsgFn)(s,ap);
-  va_end(ap);
-}
-
-void
-verrorBelch(char *s, va_list ap)
-{
-  (*errorMsgFn)(s,ap);
-}
-
-void
-debugBelch(char *s, ...)
-{
-  va_list ap;
-  va_start(ap,s);
-  (*debugMsgFn)(s,ap);
-  va_end(ap);
-}
-
-void
-vdebugBelch(char *s, va_list ap)
-{
-  (*debugMsgFn)(s,ap);
-}
-
-/* -----------------------------------------------------------------------------
-   stdio versions of the message functions
-   -------------------------------------------------------------------------- */
-
-#define BUFSIZE 512
-
-#if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
-static int
-isGUIApp()
-{
-  PIMAGE_DOS_HEADER pDOSHeader;
-  PIMAGE_NT_HEADERS pPEHeader;
-
-  pDOSHeader = (PIMAGE_DOS_HEADER) GetModuleHandleA(NULL);
-  if (pDOSHeader->e_magic != IMAGE_DOS_SIGNATURE)
-    return 0;
-
-  pPEHeader = (PIMAGE_NT_HEADERS) ((char *)pDOSHeader + pDOSHeader->e_lfanew);
-  if (pPEHeader->Signature != IMAGE_NT_SIGNATURE)
-    return 0;
-
-  return (pPEHeader->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
-}
-#endif
-
-#define xstr(s) str(s)
-#define str(s) #s
-
-void
-rtsFatalInternalErrorFn(char *s, va_list ap)
-{
-#if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
-  if (isGUIApp())
-  {
-     char title[BUFSIZE], message[BUFSIZE];
-
-     snprintf(title,   BUFSIZE, "%s: internal error", prog_name);
-     vsnprintf(message, BUFSIZE, s, ap);
-
-     MessageBox(NULL /* hWnd */,
-	        message,
-	        title,
-	        MB_OK | MB_ICONERROR | MB_TASKMODAL
-	       );
-  }
-  else
-#endif
-  {
-     /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-     if (prog_argv != NULL && prog_name != NULL) {
-       fprintf(stderr, "%s: internal error: ", prog_name);
-     } else {
-       fprintf(stderr, "internal error: ");
-     }
-     vfprintf(stderr, s, ap);
-     fprintf(stderr, "\n");
-     fprintf(stderr, "    (GHC version %s for %s)\n", ProjectVersion, xstr(HostPlatform_TYPE));
-     fprintf(stderr, "    Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n");
-     fflush(stderr);
-  }
-
-  abort();
-  // stg_exit(EXIT_INTERNAL_ERROR);
-}
-
-void
-rtsErrorMsgFn(char *s, va_list ap)
-{
-#if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
-  if (isGUIApp())
-  {
-     char buf[BUFSIZE];
-     int r;
-
-	 r = vsnprintf(buf, BUFSIZE, s, ap);
-	 if (r > 0 && r < BUFSIZE) {
-		MessageBox(NULL /* hWnd */,
-              buf,
-              prog_name,
-              MB_OK | MB_ICONERROR | MB_TASKMODAL
-              );
-     }
-  }
-  else
-#endif
-  {
-     /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-     if (prog_argv != NULL && prog_name != NULL) {
-       fprintf(stderr, "%s: ", prog_name);
-     }
-     vfprintf(stderr, s, ap);
-     fprintf(stderr, "\n");
-  }
-}
-
-void
-rtsDebugMsgFn(char *s, va_list ap)
-{
-#if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
-  if (isGUIApp())
-  {
-     char buf[BUFSIZE];
-	 int r;
-
-	 r = vsnprintf(buf, BUFSIZE, s, ap);
-	 if (r > 0 && r < BUFSIZE) {
-       OutputDebugString(buf);
-     }
-  }
-  else
-#endif
-  {
-     /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-     vfprintf(stderr, s, ap);
-     fflush(stderr);
-  }
-}
diff --git a/ghc/rts/RtsSignals.h b/ghc/rts/RtsSignals.h
deleted file mode 100644
index eafeeaaf55..0000000000
--- a/ghc/rts/RtsSignals.h
+++ /dev/null
@@ -1,78 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Signal processing / handling.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef RTS_SIGNALS_H
-#define RTS_SIGNALS_H
-
-#if !defined(PAR) && !defined(mingw32_HOST_OS)
-
-#include "posix/Signals.h"
-
-#elif defined(mingw32_HOST_OS)
-
-#include "win32/ConsoleHandler.h"
-
-#else /* PAR */
-
-#define signals_pending() (rtsFalse)
-
-#endif /* PAR */
-
-
-#if RTS_USER_SIGNALS
-
-/*
- * Function: initUserSignals()
- *
- * Initialize the console handling substrate.
- */
-extern void initUserSignals(void);
-
-/*
- * Function: initDefaultHandlers()
- *
- * Install any default signal/console handlers. Currently we install a
- * Ctrl+C handler that shuts down the RTS in an orderly manner.
- */
-extern void initDefaultHandlers(void);
-
-/*
- * Function: blockUserSignals()
- *
- * Temporarily block the delivery of further console events. Needed to
- * avoid race conditions when GCing the queue of outstanding handlers or
- * when emptying the queue by running the handlers.
- * 
- */
-extern void blockUserSignals(void);
-
-/*
- * Function: unblockUserSignals()
- *
- * The inverse of blockUserSignals(); re-enable the deliver of console events.
- */
-extern void unblockUserSignals(void);
-
-/*
- * Function: awaitUserSignals()
- *
- * Wait for the next console event. Currently a NOP (returns immediately.)
- */
-extern void awaitUserSignals(void);
-
-/*
- * Function: markSignalHandlers()
- *
- * Evacuate the handler queue. _Assumes_ that console event delivery
- * has already been blocked.
- */
-extern void markSignalHandlers (evac_fn evac);
-
-#endif /* RTS_USER_SIGNALS */
-
-#endif /* RTS_SIGNALS_H */
diff --git a/ghc/rts/RtsStartup.c b/ghc/rts/RtsStartup.c
deleted file mode 100644
index 147de7b857..0000000000
--- a/ghc/rts/RtsStartup.c
+++ /dev/null
@@ -1,457 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2002
- *
- * Main function for a standalone Haskell program.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsAPI.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"  
-#include "OSThreads.h"
-#include "Storage.h"    /* initStorage, exitStorage */
-#include "Schedule.h"   /* initScheduler */
-#include "Stats.h"      /* initStats */
-#include "STM.h"        /* initSTM */
-#include "Signals.h"
-#include "RtsSignals.h"
-#include "Timer.h"      /* startTimer, stopTimer */
-#include "Weak.h"
-#include "Ticky.h"
-#include "StgRun.h"
-#include "Prelude.h"		/* fixupRTStoPreludeRefs */
-#include "HsFFI.h"
-#include "Linker.h"
-#include "ThreadLabels.h"
-#include "BlockAlloc.h"
-
-#if defined(RTS_GTK_FRONTPANEL)
-#include "FrontPanel.h"
-#endif
-
-#if defined(PROFILING) || defined(DEBUG)
-# include "Profiling.h"
-# include "ProfHeap.h"
-# include "RetainerProfile.h"
-#endif
-
-#if defined(GRAN)
-# include "GranSimRts.h"
-#endif
-
-#if defined(GRAN) || defined(PAR)
-# include "ParallelRts.h"
-#endif
-
-#if defined(PAR)
-# include "Parallel.h"
-# include "LLC.h"
-#endif
-
-#if defined(mingw32_HOST_OS)
-#include "win32/AsyncIO.h"
-#endif
-
-#include <stdlib.h>
-
-#ifdef HAVE_TERMIOS_H
-#include <termios.h>
-#endif
-#ifdef HAVE_SIGNAL_H
-#include <signal.h>
-#endif
-
-// Count of how many outstanding hs_init()s there have been.
-static int hs_init_count = 0;
-
-// Here we save the terminal settings on the standard file
-// descriptors, if we need to change them (eg. to support NoBuffering
-// input).
-static void *saved_termios[3] = {NULL,NULL,NULL};
-
-void*
-__hscore_get_saved_termios(int fd)
-{
-  return (0 <= fd && fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) ?
-    saved_termios[fd] : NULL;
-}
-
-void
-__hscore_set_saved_termios(int fd, void* ts)
-{
-  if (0 <= fd && fd < (int)(sizeof(saved_termios) / sizeof(*saved_termios))) {
-    saved_termios[fd] = ts;
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   Initialise floating point unit on x86 (currently disabled. why?)
-   (see comment in ghc/compiler/nativeGen/MachInstrs.lhs).
-   -------------------------------------------------------------------------- */
-
-#define X86_INIT_FPU 0
-
-#if X86_INIT_FPU
-static void
-x86_init_fpu ( void )
-{
-  __volatile unsigned short int fpu_cw;
-
-  // Grab the control word
-  __asm __volatile ("fnstcw %0" : "=m" (fpu_cw));
-
-#if 0
-  printf("fpu_cw: %x\n", fpu_cw);
-#endif
-
-  // Set bits 8-9 to 10 (64-bit precision).
-  fpu_cw = (fpu_cw & 0xfcff) | 0x0200;
-
-  // Store the new control word back
-  __asm __volatile ("fldcw %0" : : "m" (fpu_cw));
-}
-#endif
-
-/* -----------------------------------------------------------------------------
-   Starting up the RTS
-   -------------------------------------------------------------------------- */
-
-void
-hs_init(int *argc, char **argv[])
-{
-    hs_init_count++;
-    if (hs_init_count > 1) {
-	// second and subsequent inits are ignored
-	return;
-    }
-
-    /* The very first thing we do is grab the start time...just in case we're
-     * collecting timing statistics.
-     */
-    stat_startInit();
-
-#ifdef PAR
-    /*
-     * The parallel system needs to be initialised and synchronised before
-     * the program is run.  
-     */ 
-    startupParallelSystem(argv);
-     
-    if (*argv[0] == '-') { /* Strip off mainPE flag argument */
-      argv++; 
-      argc--;			
-    }
-
-    argv[1] = argv[0];   /* ignore the nPEs argument */
-    argv++; argc--;
-#endif
-
-    /* Set the RTS flags to default values. */
-    initRtsFlagsDefaults();
-
-    /* Call the user hook to reset defaults, if present */
-    defaultsHook();
-
-    /* Parse the flags, separating the RTS flags from the programs args */
-    if (argc != NULL && argv != NULL) {
-	setupRtsFlags(argc, *argv, &rts_argc, rts_argv);
-	setProgArgv(*argc,*argv);
-    }
-
-#if defined(PAR)
-    /* NB: this really must be done after processing the RTS flags */
-    IF_PAR_DEBUG(verbose,
-                 debugBelch("==== Synchronising system (%d PEs)\n", nPEs));
-    synchroniseSystem();             // calls initParallelSystem etc
-#endif	/* PAR */
-
-    /* Perform initialisation of adjustor thunk layer. */
-    initAdjustor();
-
-    /* initialise scheduler data structures (needs to be done before
-     * initStorage()).
-     */
-    initScheduler();
-
-#if defined(GRAN)
-    /* And start GranSim profiling if required: */
-    if (RtsFlags.GranFlags.GranSimStats.Full)
-      init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
-#elif defined(PAR)
-    /* And start GUM profiling if required: */
-    if (RtsFlags.ParFlags.ParStats.Full)
-      init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv);
-#endif	/* PAR || GRAN */
-
-    /* initialize the storage manager */
-    initStorage();
-
-    /* initialise the stable pointer table */
-    initStablePtrTable();
-
-#if defined(DEBUG)
-    /* initialise thread label table (tso->char*) */
-    initThreadLabelTable();
-#endif
-
-#if defined(PROFILING) || defined(DEBUG)
-    initProfiling1();
-#endif
-
-    /* start the virtual timer 'subsystem'. */
-    startTimer(TICK_MILLISECS);
-
-    /* Initialise the stats department */
-    initStats();
-
-#if defined(RTS_USER_SIGNALS)
-    /* Initialise the user signal handler set */
-    initUserSignals();
-    /* Set up handler to run on SIGINT, etc. */
-    initDefaultHandlers();
-#endif
- 
-#if defined(mingw32_HOST_OS)
-    startupAsyncIO();
-#endif
-
-#ifdef RTS_GTK_FRONTPANEL
-    if (RtsFlags.GcFlags.frontpanel) {
-	initFrontPanel();
-    }
-#endif
-
-#if X86_INIT_FPU
-    x86_init_fpu();
-#endif
-
-    /* Record initialization times */
-    stat_endInit();
-}
-
-// Compatibility interface
-void
-startupHaskell(int argc, char *argv[], void (*init_root)(void))
-{
-    hs_init(&argc, &argv);
-    if(init_root)
-        hs_add_root(init_root);
-}
-
-
-/* -----------------------------------------------------------------------------
-   Per-module initialisation
-
-   This process traverses all the compiled modules in the program
-   starting with "Main", and performing per-module initialisation for
-   each one.
-
-   So far, two things happen at initialisation time:
-
-      - we register stable names for each foreign-exported function
-        in that module.  This prevents foreign-exported entities, and
-	things they depend on, from being garbage collected.
-
-      - we supply a unique integer to each statically declared cost
-        centre and cost centre stack in the program.
-
-   The code generator inserts a small function "__stginit_<module>" in each
-   module and calls the registration functions in each of the modules it
-   imports.
-
-   The init* functions are compiled in the same way as STG code,
-   i.e. without normal C call/return conventions.  Hence we must use
-   StgRun to call this stuff.
-   -------------------------------------------------------------------------- */
-
-/* The init functions use an explicit stack... 
- */
-#define INIT_STACK_BLOCKS  4
-static F_ *init_stack = NULL;
-
-void
-hs_add_root(void (*init_root)(void))
-{
-    bdescr *bd;
-    nat init_sp;
-    Capability *cap = &MainCapability;
-
-    if (hs_init_count <= 0) {
-	barf("hs_add_root() must be called after hs_init()");
-    }
-
-    /* The initialisation stack grows downward, with sp pointing 
-       to the last occupied word */
-    init_sp = INIT_STACK_BLOCKS*BLOCK_SIZE_W;
-    bd = allocGroup_lock(INIT_STACK_BLOCKS);
-    init_stack = (F_ *)bd->start;
-    init_stack[--init_sp] = (F_)stg_init_finish;
-    if (init_root != NULL) {
-	init_stack[--init_sp] = (F_)init_root;
-    }
-    
-    cap->r.rSp = (P_)(init_stack + init_sp);
-    StgRun((StgFunPtr)stg_init, &cap->r);
-
-    freeGroup_lock(bd);
-
-#if defined(PROFILING) || defined(DEBUG)
-    // This must be done after module initialisation.
-    // ToDo: make this work in the presence of multiple hs_add_root()s.
-    initProfiling2();
-#endif
-}
-
-/* -----------------------------------------------------------------------------
-   Shutting down the RTS
-   -------------------------------------------------------------------------- */
-
-void
-hs_exit(void)
-{
-    if (hs_init_count <= 0) {
-	errorBelch("warning: too many hs_exit()s");
-	return;
-    }
-    hs_init_count--;
-    if (hs_init_count > 0) {
-	// ignore until it's the last one
-	return;
-    }
-
-    /* start timing the shutdown */
-    stat_startExit();
-    
-    /* stop all running tasks */
-    exitScheduler();
-    
-#if defined(GRAN)
-    /* end_gr_simulation prints global stats if requested -- HWL */
-    if (!RtsFlags.GranFlags.GranSimStats.Suppressed)
-	end_gr_simulation();
-#endif
-    
-    /* stop the ticker */
-    stopTimer();
-    
-    /* reset the standard file descriptors to blocking mode */
-    resetNonBlockingFd(0);
-    resetNonBlockingFd(1);
-    resetNonBlockingFd(2);
-
-#if HAVE_TERMIOS_H
-    // Reset the terminal settings on the standard file descriptors,
-    // if we changed them.  See System.Posix.Internals.tcSetAttr for
-    // more details, including the reason we termporarily disable
-    // SIGTTOU here.
-    { 
-	int fd;
-	sigset_t sigset, old_sigset;
-	sigemptyset(&sigset);
-	sigaddset(&sigset, SIGTTOU);
-	sigprocmask(SIG_BLOCK, &sigset, &old_sigset);
-	for (fd = 0; fd <= 2; fd++) {
-	    struct termios* ts = (struct termios*)__hscore_get_saved_termios(fd);
-	    if (ts != NULL) {
-		tcsetattr(fd,TCSANOW,ts);
-	    }
-	}
-	sigprocmask(SIG_SETMASK, &old_sigset, NULL);
-    }
-#endif
-
-#if defined(PAR)
-    /* controlled exit; good thread! */
-    shutdownParallelSystem(0);
-    
-    /* global statistics in parallel system */
-    PAR_TICKY_PAR_END();
-#endif
-
-    /* stop timing the shutdown, we're about to print stats */
-    stat_endExit();
-    
-    // clean up things from the storage manager's point of view.
-    // also outputs the stats (+RTS -s) info.
-    exitStorage();
-    
-#ifdef RTS_GTK_FRONTPANEL
-    if (RtsFlags.GcFlags.frontpanel) {
-	stopFrontPanel();
-    }
-#endif
-
-#if defined(PROFILING) 
-    reportCCSProfiling();
-#endif
-
-#if defined(PROFILING) || defined(DEBUG)
-    endProfiling();
-#endif
-
-#ifdef PROFILING
-    // Originally, this was in report_ccs_profiling().  Now, retainer
-    // profiling might tack some extra stuff on to the end of this file
-    // during endProfiling().
-    fclose(prof_file);
-#endif
-
-#if defined(TICKY_TICKY)
-    if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
-#endif
-
-#if defined(mingw32_HOST_OS)
-    shutdownAsyncIO();
-#endif
-
-    // Finally, free all our storage.
-    freeStorage();
-}
-
-// Compatibility interfaces
-void
-shutdownHaskell(void)
-{
-    hs_exit();
-}
-
-void
-shutdownHaskellAndExit(int n)
-{
-    if (hs_init_count == 1) {
-	OnExitHook();
-	hs_exit();
-#if defined(PAR)
-	/* really exit (stg_exit() would call shutdownParallelSystem() again) */
-	exit(n);
-#else
-	stg_exit(n);
-#endif
-    }
-}
-
-/* 
- * called from STG-land to exit the program
- */
-
-#ifdef PAR
-static int exit_started=rtsFalse;
-#endif
-
-void  
-stg_exit(int n)
-{ 
-#ifdef PAR
-  /* HACK: avoid a loop when exiting due to a stupid error */
-  if (exit_started) 
-    return;
-  exit_started=rtsTrue;
-
-  IF_PAR_DEBUG(verbose, debugBelch("==-- stg_exit %d on [%x]...", n, mytid));
-  shutdownParallelSystem(n);
-#endif
-  exit(n);
-}
diff --git a/ghc/rts/RtsUtils.c b/ghc/rts/RtsUtils.c
deleted file mode 100644
index 3e7e225dda..0000000000
--- a/ghc/rts/RtsUtils.c
+++ /dev/null
@@ -1,367 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * General utility functions used in the RTS.
- *
- * ---------------------------------------------------------------------------*/
-
-/* gettimeofday isn't POSIX */
-/* #include "PosixSource.h" */
-
-#include "Rts.h"
-#include "RtsAPI.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "Ticky.h"
-
-#ifdef HAVE_TIME_H
-#include <time.h>
-#endif
-
-#ifdef HAVE_FCNTL_H
-#include <fcntl.h>
-#endif
-
-#ifdef HAVE_GETTIMEOFDAY
-#include <sys/time.h>
-#endif
-
-#include <stdlib.h>
-#include <string.h>
-#include <stdarg.h>
-#include <stdio.h>
-
-#ifdef HAVE_SIGNAL_H
-#include <signal.h>
-#endif
-
-#if defined(THREADED_RTS) && defined(openbsd_HOST_OS) && defined(HAVE_PTHREAD_H)
-#include <pthread.h>
-#endif
-
-#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(darwin_HOST_OS)
-#include <unistd.h>
-#include <sys/types.h>
-#include <sys/mman.h>
-
-/* no C99 header stdint.h on OpenBSD? */
-#if defined(openbsd_HOST_OS)
-typedef unsigned long my_uintptr_t;
-#else
-#include <stdint.h>
-typedef uintptr_t my_uintptr_t;
-#endif
-#endif
-
-#if defined(_WIN32)
-#include <windows.h>
-#endif
-
-/* -----------------------------------------------------------------------------
-   Result-checking malloc wrappers.
-   -------------------------------------------------------------------------- */
-
-void *
-stgMallocBytes (int n, char *msg)
-{
-    char *space;
-
-    if ((space = (char *) malloc((size_t) n)) == NULL) {
-      /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-      MallocFailHook((W_) n, msg); /*msg*/
-      stg_exit(EXIT_INTERNAL_ERROR);
-    }
-    return space;
-}
-
-void *
-stgReallocBytes (void *p, int n, char *msg)
-{
-    char *space;
-
-    if ((space = (char *) realloc(p, (size_t) n)) == NULL) {
-      /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-      MallocFailHook((W_) n, msg); /*msg*/
-      stg_exit(EXIT_INTERNAL_ERROR);
-    }
-    return space;
-}
-
-void *
-stgCallocBytes (int n, int m, char *msg)
-{
-    char *space;
-
-    if ((space = (char *) calloc((size_t) n, (size_t) m)) == NULL) {
-      /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-      MallocFailHook((W_) n*m, msg); /*msg*/
-      stg_exit(EXIT_INTERNAL_ERROR);
-    }
-    return space;
-}
-
-/* To simplify changing the underlying allocator used
- * by stgMallocBytes(), provide stgFree() as well.
- */
-void
-stgFree(void* p)
-{
-  free(p);
-}
-
-/* -----------------------------------------------------------------------------
-   Stack overflow
-   
-   Not sure if this belongs here.
-   -------------------------------------------------------------------------- */
-
-void
-stackOverflow(void)
-{
-  StackOverflowHook(RtsFlags.GcFlags.maxStkSize * sizeof(W_));
-
-#if defined(TICKY_TICKY)
-  if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
-#endif
-}
-
-void
-heapOverflow(void)
-{
-  /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-  OutOfHeapHook(0/*unknown request size*/, 
-		RtsFlags.GcFlags.maxHeapSize * BLOCK_SIZE);
-  
-#if defined(TICKY_TICKY)
-  if (RtsFlags.TickyFlags.showTickyStats) PrintTickyInfo();
-#endif
-
-  stg_exit(EXIT_HEAPOVERFLOW);
-}
-
-/* -----------------------------------------------------------------------------
-   Out-of-line strlen.
-
-   Used in addr2Integer because the C compiler on x86 chokes on
-   strlen, trying to inline it with not enough registers available.
-   -------------------------------------------------------------------------- */
-
-nat stg_strlen(char *s)
-{
-   char *p = s;
-
-   while (*p) p++;
-   return p-s;
-}
-
-
-/* -----------------------------------------------------------------------------
-   genSym stuff, used by GHC itself for its splitting unique supply.
-
-   ToDo: put this somewhere sensible.
-   -------------------------------------------------------------------------  */
-
-static I_ __GenSymCounter = 0;
-
-I_
-genSymZh(void)
-{
-    return(__GenSymCounter++);
-}
-I_
-resetGenSymZh(void) /* it's your funeral */
-{
-    __GenSymCounter=0;
-    return(__GenSymCounter);
-}
-
-/* -----------------------------------------------------------------------------
-   Get the current time as a string.  Used in profiling reports.
-   -------------------------------------------------------------------------- */
-
-#if defined(PROFILING) || defined(DEBUG) || defined(PAR) || defined(GRAN)
-char *
-time_str(void)
-{
-    static time_t now = 0;
-    static char nowstr[26];
-
-    if (now == 0) {
-	time(&now);
-#if HAVE_CTIME_R
-	ctime_r(&now, nowstr);
-#else
-	strcpy(nowstr, ctime(&now));
-#endif
-	memmove(nowstr+16,nowstr+19,7);
-	nowstr[21] = '\0';  // removes the \n
-    }
-    return nowstr;
-}
-#endif
-
-/* -----------------------------------------------------------------------------
- * Reset a file handle to blocking mode.  We do this for the standard
- * file descriptors before exiting, because the shell doesn't always
- * clean up for us.
- * -------------------------------------------------------------------------- */
-
-#if !defined(mingw32_HOST_OS)
-void
-resetNonBlockingFd(int fd)
-{
-  long fd_flags;
-
-  /* clear the non-blocking flag on this file descriptor */
-  fd_flags = fcntl(fd, F_GETFL);
-  if (fd_flags & O_NONBLOCK) {
-    fcntl(fd, F_SETFL, fd_flags & ~O_NONBLOCK);
-  }
-}
-
-void
-setNonBlockingFd(int fd)
-{
-  long fd_flags;
-
-  /* clear the non-blocking flag on this file descriptor */
-  fd_flags = fcntl(fd, F_GETFL);
-  if (!(fd_flags & O_NONBLOCK)) {
-    fcntl(fd, F_SETFL, fd_flags | O_NONBLOCK);
-  }
-}
-#else
-/* Stub defns -- async / non-blocking IO is not done 
- * via O_NONBLOCK and select() under Win32. 
- */
-void resetNonBlockingFd(int fd STG_UNUSED) {}
-void setNonBlockingFd(int fd STG_UNUSED) {}
-#endif
-
-#ifdef PAR
-static ullong startTime = 0;
-
-/* used in a parallel setup */
-ullong
-msTime(void)
-{
-# if defined(HAVE_GETCLOCK) && !defined(alpha_HOST_ARCH) && !defined(hppa1_1_HOST_ARCH)
-    struct timespec tv;
-
-    if (getclock(TIMEOFDAY, &tv) != 0) {
-	fflush(stdout);
-	fprintf(stderr, "Clock failed\n");
-	stg_exit(EXIT_FAILURE);
-    }
-    return tv.tv_sec * LL(1000) + tv.tv_nsec / LL(1000000) - startTime;
-# elif HAVE_GETTIMEOFDAY && !defined(alpha_HOST_ARCH)
-    struct timeval tv;
- 
-    if (gettimeofday(&tv, NULL) != 0) {
-	fflush(stdout);
-	fprintf(stderr, "Clock failed\n");
-	stg_exit(EXIT_FAILURE);
-    }
-    return tv.tv_sec * LL(1000) + tv.tv_usec / LL(1000) - startTime;
-# else
-    time_t t;
-    if ((t = time(NULL)) == (time_t) -1) {
-	fflush(stdout);
-	fprintf(stderr, "Clock failed\n");
-	stg_exit(EXIT_FAILURE);
-    }
-    return t * LL(1000) - startTime;
-# endif
-}
-#endif /* PAR */
-
-/* -----------------------------------------------------------------------------
-   Print large numbers, with punctuation.
-   -------------------------------------------------------------------------- */
-
-char *
-ullong_format_string(ullong x, char *s, rtsBool with_commas)
-{
-    if (x < (ullong)1000) 
-	sprintf(s, "%lu", (lnat)x);
-    else if (x < (ullong)1000000)
-	sprintf(s, (with_commas) ? "%lu,%3.3lu" : "%lu%3.3lu",
-		(lnat)((x)/(ullong)1000),
-		(lnat)((x)%(ullong)1000));
-    else if (x < (ullong)1000000000)
-	sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu" :  "%lu%3.3lu%3.3lu",
-		(lnat)((x)/(ullong)1000000),
-		(lnat)((x)/(ullong)1000%(ullong)1000),
-		(lnat)((x)%(ullong)1000));
-    else
-	sprintf(s, (with_commas) ? "%lu,%3.3lu,%3.3lu,%3.3lu" : "%lu%3.3lu%3.3lu%3.3lu",
-		(lnat)((x)/(ullong)1000000000),
-		(lnat)((x)/(ullong)1000000%(ullong)1000),
-		(lnat)((x)/(ullong)1000%(ullong)1000), 
-		(lnat)((x)%(ullong)1000));
-    return s;
-}
-
-
-// Can be used as a breakpoint to set on every heap check failure.
-#ifdef DEBUG
-void
-heapCheckFail( void )
-{
-}
-#endif
-
-/* 
- * It seems that pthreads and signals interact oddly in OpenBSD & FreeBSD
- * pthreads (and possibly others). When linking with -lpthreads, we
- * have to use pthread_kill to send blockable signals. So use that
- * when we have a threaded rts. So System.Posix.Signals will call
- * genericRaise(), rather than raise(3).
- */
-int genericRaise(int sig) {
-#if defined(THREADED_RTS) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
-        return pthread_kill(pthread_self(), sig);
-#else
-        return raise(sig);
-#endif
-}
-
-/* -----------------------------------------------------------------------------
-   Allocating executable memory
-   -------------------------------------------------------------------------- */
-
-/* Heavily arch-specific, I'm afraid.. */
-
-/*
- * Allocate len bytes which are readable, writable, and executable.
- *
- * ToDo: If this turns out to be a performance bottleneck, one could
- * e.g. cache the last VirtualProtect/mprotect-ed region and do
- * nothing in case of a cache hit.
- */
-void*
-stgMallocBytesRWX(int len)
-{
-  void *addr = stgMallocBytes(len, "mallocBytesRWX");
-#if defined(i386_HOST_ARCH) && defined(_WIN32)
-  /* This could be necessary for processors which distinguish between READ and
-     EXECUTE memory accesses, e.g. Itaniums. */
-  DWORD dwOldProtect = 0;
-  if (VirtualProtect (addr, len, PAGE_EXECUTE_READWRITE, &dwOldProtect) == 0) {
-    barf("mallocBytesRWX: failed to protect 0x%p; error=%lu; old protection: %lu\n",
-         addr, (unsigned long)GetLastError(), (unsigned long)dwOldProtect);
-  }
-#elif defined(openbsd_HOST_OS) || defined(linux_HOST_OS) || defined(darwin_HOST_OS)
-  /* malloced memory isn't executable by default on OpenBSD */
-  my_uintptr_t pageSize         = sysconf(_SC_PAGESIZE);
-  my_uintptr_t mask             = ~(pageSize - 1);
-  my_uintptr_t startOfFirstPage = ((my_uintptr_t)addr          ) & mask;
-  my_uintptr_t startOfLastPage  = ((my_uintptr_t)addr + len - 1) & mask;
-  my_uintptr_t size             = startOfLastPage - startOfFirstPage + pageSize;
-  if (mprotect((void*)startOfFirstPage, (size_t)size, PROT_EXEC | PROT_READ | PROT_WRITE) != 0) {
-    barf("mallocBytesRWX: failed to protect 0x%p\n", addr);
-  }
-#endif
-  return addr;
-}
diff --git a/ghc/rts/RtsUtils.h b/ghc/rts/RtsUtils.h
deleted file mode 100644
index 96a5f0d82f..0000000000
--- a/ghc/rts/RtsUtils.h
+++ /dev/null
@@ -1,54 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * General utility functions used in the RTS.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef RTSUTILS_H
-#define RTSUTILS_H
-
-/* -----------------------------------------------------------------------------
- * (Checked) dynamic allocation
- * -------------------------------------------------------------------------- */
-
-extern void *stgMallocBytes(int n, char *msg)
-    GNUC3_ATTRIBUTE(__malloc__);
-
-extern void* stgMallocBytesRWX(int len)
-    GNUC3_ATTRIBUTE(__malloc__);
-
-extern void *stgReallocBytes(void *p, int n, char *msg);
-
-extern void *stgCallocBytes(int n, int m, char *msg)
-     GNUC3_ATTRIBUTE(__malloc__);
-
-extern void stgFree(void* p);
-
-/* -----------------------------------------------------------------------------
- * Misc other utilities
- * -------------------------------------------------------------------------- */
-
-extern void heapOverflow(void);
-
-extern void setNonBlockingFd(int fd);
-extern void resetNonBlockingFd(int fd);
-
-extern nat stg_strlen(char *str);
-
-extern char *time_str(void);
-extern char *ullong_format_string(ullong, char *, rtsBool);
-
-#ifdef PAR
-extern ullong msTime(void);
-#endif
-
-#ifdef DEBUG
-extern void heapCheckFail( void );
-#endif
-
-extern void* __hscore_get_saved_termios(int fd);
-extern void __hscore_set_saved_termios(int fd, void* ts);
-
-#endif /* RTSUTILS_H */
diff --git a/ghc/rts/STM.c b/ghc/rts/STM.c
deleted file mode 100644
index d3283a92f0..0000000000
--- a/ghc/rts/STM.c
+++ /dev/null
@@ -1,1261 +0,0 @@
-/* -----------------------------------------------------------------------------
- * (c) The GHC Team 1998-2005
- * 
- * STM implementation.
- *
- * Overview
- * --------
- *
- * See the PPoPP 2005 paper "Composable memory transactions".  In summary, 
- * each transcation has a TRec (transaction record) holding entries for each of the
- * TVars (transactional variables) that it has accessed.  Each entry records
- * (a) the TVar, (b) the expected value seen in the TVar, (c) the new value that
- * the transaction wants to write to the TVar, (d) during commit, the identity of
- * the TRec that wrote the expected value.  
- *
- * Separate TRecs are used for each level in a nest of transactions.  This allows
- * a nested transaction to be aborted without condemning its enclosing transactions.
- * This is needed in the implementation of catchRetry.  Note that the "expected value"
- * in a nested transaction's TRec is the value expected to be *held in memory* if
- * the transaction commits -- not the "new value" stored in one of the enclosing
- * transactions.  This means that validation can be done without searching through
- * a nest of TRecs.
- *
- * Concurrency control
- * -------------------
- *
- * Three different concurrency control schemes can be built according to the settings
- * in STM.h:
- * 
- * STM_UNIPROC assumes that the caller serialises invocations on the STM interface.
- * In the Haskell RTS this means it is suitable only for non-THREADED_RTS builds.
- *
- * STM_CG_LOCK uses coarse-grained locking -- a single 'stm lock' is acquired during
- * an invocation on the STM interface.  Note that this does not mean that 
- * transactions are simply serialized -- the lock is only held *within* the 
- * implementation of stmCommitTransaction, stmWait etc.
- *
- * STM_FG_LOCKS uses fine-grained locking -- locking is done on a per-TVar basis
- * and, when committing a transaction, no locks are acquired for TVars that have
- * been read but not updated.
- *
- * Concurrency control is implemented in the functions:
- *
- *    lock_stm
- *    unlock_stm
- *    lock_tvar / cond_lock_tvar
- *    unlock_tvar
- *
- * The choice between STM_UNIPROC / STM_CG_LOCK / STM_FG_LOCKS affects the 
- * implementation of these functions.  
- *
- * lock_stm & unlock_stm are straightforward : they acquire a simple spin-lock
- * using STM_CG_LOCK, and otherwise they are no-ops.
- *
- * lock_tvar / cond_lock_tvar and unlock_tvar are more complex because they 
- * have other effects (present in STM_UNIPROC and STM_CG_LOCK builds) as well
- * as the actual business of maniupultaing a lock (present only in STM_FG_LOCKS
- * builds).  This is because locking a TVar is implemented by writing the lock
- * holder's TRec into the TVar's current_value field:
- *
- *   lock_tvar - lock a specified TVar (STM_FG_LOCKS only), returning the value 
- *               it contained.
- *
- *   cond_lock_tvar - lock a specified TVar (STM_FG_LOCKS only) if it 
- *               contains a specified value.  Return TRUE if this succeeds,
- *               FALSE otherwise.
- *
- *   unlock_tvar - release the lock on a specified TVar (STM_FG_LOCKS only),
- *               storing a specified value in place of the lock entry.
- *
- * Using these operations, the typcial pattern of a commit/validate/wait operation
- * is to (a) lock the STM, (b) lock all the TVars being updated, (c) check that 
- * the TVars that were only read from still contain their expected values, 
- * (d) release the locks on the TVars, writing updates to them in the case of a 
- * commit, (e) unlock the STM.
- *
- * Queues of waiting threads hang off the first_wait_queue_entry field of each
- * TVar.  This may only be manipulated when holding that TVar's lock.  In
- * particular, when a thread is putting itself to sleep, it mustn't release
- * the TVar's lock until it has added itself to the wait queue and marked its
- * TSO as BlockedOnSTM -- this makes sure that other threads will know to wake it.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "Schedule.h"
-#include "SMP.h"
-#include "STM.h"
-#include "Storage.h"
-
-#include <stdlib.h>
-#include <stdio.h>
-
-#define TRUE 1
-#define FALSE 0
-
-// ACQ_ASSERT is used for assertions which are only required for
-// THREADED_RTS builds with fine-grained locking.
-
-#if defined(STM_FG_LOCKS)
-#define ACQ_ASSERT(_X) ASSERT(_X)
-#define NACQ_ASSERT(_X) /*Nothing*/
-#else
-#define ACQ_ASSERT(_X) /*Nothing*/
-#define NACQ_ASSERT(_X) ASSERT(_X)
-#endif
-
-/*......................................................................*/
-
-// If SHAKE is defined then validation will sometime spuriously fail.  They helps test
-// unusualy code paths if genuine contention is rare
-
-#if defined(DEBUG)
-#define SHAKE
-#if defined(THREADED_RTS)
-#define TRACE(_x...) IF_DEBUG(stm, debugBelch("STM  (task %p): ", (void *)(unsigned long)(unsigned int)osThreadId()); debugBelch ( _x ))
-#else
-#define TRACE(_x...) IF_DEBUG(stm, debugBelch ( _x ))
-#endif
-#else
-#define TRACE(_x...) /*Nothing*/
-#endif
-
-#ifdef SHAKE
-static const int do_shake = TRUE;
-#else
-static const int do_shake = FALSE;
-#endif
-static int shake_ctr = 0;
-static int shake_lim = 1;
-
-static int shake(void) {
-  if (do_shake) {
-    if (((shake_ctr++) % shake_lim) == 0) {
-      shake_ctr = 1;
-      shake_lim ++;
-      return TRUE;
-    } 
-    return FALSE;
-  } else {
-    return FALSE;
-  }
-}
-
-/*......................................................................*/
-
-// Helper macros for iterating over entries within a transaction
-// record
-
-#define FOR_EACH_ENTRY(_t,_x,CODE) do {                                         \
-  StgTRecHeader *__t = (_t);                                                    \
-  StgTRecChunk *__c = __t -> current_chunk;                                     \
-  StgWord __limit = __c -> next_entry_idx;                                      \
-  TRACE("%p : FOR_EACH_ENTRY, current_chunk=%p limit=%ld\n", __t, __c, __limit); \
-  while (__c != END_STM_CHUNK_LIST) {                                           \
-    StgWord __i;                                                                \
-    for (__i = 0; __i < __limit; __i ++) {                                      \
-      TRecEntry *_x = &(__c -> entries[__i]);                                   \
-      do { CODE } while (0);                                                    \
-    }                                                                           \
-    __c = __c -> prev_chunk;                                                    \
-    __limit = TREC_CHUNK_NUM_ENTRIES;                                           \
-  }                                                                             \
- exit_for_each:                                                                 \
-  if (FALSE) goto exit_for_each;                                                \
-} while (0)
-
-#define BREAK_FOR_EACH goto exit_for_each
-     
-/*......................................................................*/
-
-// if REUSE_MEMORY is defined then attempt to re-use descriptors, log chunks,
-// and wait queue entries without GC
-
-#define REUSE_MEMORY
-
-/*......................................................................*/
-
-#define IF_STM_UNIPROC(__X)  do { } while (0)
-#define IF_STM_CG_LOCK(__X)  do { } while (0)
-#define IF_STM_FG_LOCKS(__X) do { } while (0)
-
-#if defined(STM_UNIPROC)
-#undef IF_STM_UNIPROC
-#define IF_STM_UNIPROC(__X)  do { __X } while (0)
-static const StgBool use_read_phase = FALSE;
-
-static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
-  TRACE("%p : lock_stm()\n", trec);
-}
-
-static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
-  TRACE("%p : unlock_stm()\n", trec);
-}
-
-static StgClosure *lock_tvar(StgTRecHeader *trec STG_UNUSED, 
-                             StgTVar *s STG_UNUSED) {
-  StgClosure *result;
-  TRACE("%p : lock_tvar(%p)\n", trec, s);
-  result = s -> current_value;
-  return result;
-}
-
-static void unlock_tvar(StgTRecHeader *trec STG_UNUSED,
-                        StgTVar *s STG_UNUSED,
-                        StgClosure *c,
-                        StgBool force_update) {
-  TRACE("%p : unlock_tvar(%p)\n", trec, s);
-  if (force_update) {
-    s -> current_value = c;
-  }
-}
-
-static StgBool cond_lock_tvar(StgTRecHeader *trec STG_UNUSED, 
-                              StgTVar *s STG_UNUSED,
-                              StgClosure *expected) {
-  StgClosure *result;
-  TRACE("%p : cond_lock_tvar(%p, %p)\n", trec, s, expected);
-  result = s -> current_value;
-  TRACE("%p : %s\n", trec, (result == expected) ? "success" : "failure");
-  return (result == expected);
-}
-#endif
-
-#if defined(STM_CG_LOCK) /*........................................*/
-
-#undef IF_STM_CG_LOCK
-#define IF_STM_CG_LOCK(__X)  do { __X } while (0)
-static const StgBool use_read_phase = FALSE;
-static volatile StgTRecHeader *smp_locked = NULL;
-
-static void lock_stm(StgTRecHeader *trec) {
-  while (cas(&smp_locked, NULL, trec) != NULL) { }
-  TRACE("%p : lock_stm()\n", trec);
-}
-
-static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
-  TRACE("%p : unlock_stm()\n", trec);
-  ASSERT (smp_locked == trec);
-  smp_locked = 0;
-}
-
-static StgClosure *lock_tvar(StgTRecHeader *trec STG_UNUSED, 
-                             StgTVar *s STG_UNUSED) {
-  StgClosure *result;
-  TRACE("%p : lock_tvar(%p)\n", trec, s);
-  ASSERT (smp_locked == trec);
-  result = s -> current_value;
-  return result;
-}
-
-static void *unlock_tvar(StgTRecHeader *trec STG_UNUSED,
-                         StgTVar *s STG_UNUSED,
-                         StgClosure *c,
-                         StgBool force_update) {
-  TRACE("%p : unlock_tvar(%p, %p)\n", trec, s, c);
-  ASSERT (smp_locked == trec);
-  if (force_update) {
-    s -> current_value = c;
-  }
-}
-
-static StgBool cond_lock_tvar(StgTRecHeader *trec STG_UNUSED, 
-                               StgTVar *s STG_UNUSED,
-                               StgClosure *expected) {
-  StgClosure *result;
-  TRACE("%p : cond_lock_tvar(%p, %p)\n", trec, s, expected);
-  ASSERT (smp_locked == trec);
-  result = s -> current_value;
-  TRACE("%p : %d\n", result ? "success" : "failure");
-  return (result == expected);
-}
-#endif
-
-#if defined(STM_FG_LOCKS) /*...................................*/
-
-#undef IF_STM_FG_LOCKS
-#define IF_STM_FG_LOCKS(__X) do { __X } while (0)
-static const StgBool use_read_phase = TRUE;
-
-static void lock_stm(StgTRecHeader *trec STG_UNUSED) {
-  TRACE("%p : lock_stm()\n", trec);
-}
-
-static void unlock_stm(StgTRecHeader *trec STG_UNUSED) {
-  TRACE("%p : unlock_stm()\n", trec);
-}
-
-static StgClosure *lock_tvar(StgTRecHeader *trec, 
-                             StgTVar *s STG_UNUSED) {
-  StgClosure *result;
-  TRACE("%p : lock_tvar(%p)\n", trec, s);
-  do {
-    do {
-      result = s -> current_value;
-    } while (GET_INFO(result) == &stg_TREC_HEADER_info);
-  } while (cas(&(s -> current_value), result, trec) != result);
-  return result;
-}
-
-static void unlock_tvar(StgTRecHeader *trec STG_UNUSED,
-                        StgTVar *s,
-                        StgClosure *c,
-                        StgBool force_update STG_UNUSED) {
-  TRACE("%p : unlock_tvar(%p, %p)\n", trec, s, c);
-  ASSERT(s -> current_value == trec);
-  s -> current_value = c;
-}
-
-static StgBool cond_lock_tvar(StgTRecHeader *trec, 
-                              StgTVar *s,
-                              StgClosure *expected) {
-  StgClosure *result;
-  TRACE("%p : cond_lock_tvar(%p, %p)\n", trec, s, expected);
-  result = cas(&(s -> current_value), expected, trec);
-  TRACE("%p : %s\n", trec, result ? "success" : "failure");
-  return (result == expected);
-}
-#endif
-
-/*......................................................................*/
-
-// Helper functions for thread blocking and unblocking
-
-static void park_tso(StgTSO *tso) {
-  ASSERT(tso -> why_blocked == NotBlocked);
-  tso -> why_blocked = BlockedOnSTM;
-  tso -> block_info.closure = (StgClosure *) END_TSO_QUEUE;
-  TRACE("park_tso on tso=%p\n", tso);
-}
-
-static void unpark_tso(Capability *cap, StgTSO *tso) {
-  // We will continue unparking threads while they remain on one of the wait
-  // queues: it's up to the thread itself to remove it from the wait queues
-  // if it decides to do so when it is scheduled.
-  if (tso -> why_blocked == BlockedOnSTM) {
-    TRACE("unpark_tso on tso=%p\n", tso);
-    unblockOne(cap,tso);
-  } else {
-    TRACE("spurious unpark_tso on tso=%p\n", tso);
-  }
-}
-
-static void unpark_waiters_on(Capability *cap, StgTVar *s) {
-  StgTVarWaitQueue *q;
-  TRACE("unpark_waiters_on tvar=%p\n", s);
-  for (q = s -> first_wait_queue_entry; 
-       q != END_STM_WAIT_QUEUE; 
-       q = q -> next_queue_entry) {
-    unpark_tso(cap, q -> waiting_tso);
-  }
-}
-
-/*......................................................................*/
-
-// Helper functions for downstream allocation and initialization
-
-static StgTVarWaitQueue *new_stg_tvar_wait_queue(Capability *cap,
-                                                 StgTSO *waiting_tso) {
-  StgTVarWaitQueue *result;
-  result = (StgTVarWaitQueue *)allocateLocal(cap, sizeofW(StgTVarWaitQueue));
-  SET_HDR (result, &stg_TVAR_WAIT_QUEUE_info, CCS_SYSTEM);
-  result -> waiting_tso = waiting_tso;
-  return result;
-}
-
-static StgTRecChunk *new_stg_trec_chunk(Capability *cap) {
-  StgTRecChunk *result;
-  result = (StgTRecChunk *)allocateLocal(cap, sizeofW(StgTRecChunk));
-  SET_HDR (result, &stg_TREC_CHUNK_info, CCS_SYSTEM);
-  result -> prev_chunk = END_STM_CHUNK_LIST;
-  result -> next_entry_idx = 0;
-  return result;
-}
-
-static StgTRecHeader *new_stg_trec_header(Capability *cap,
-                                          StgTRecHeader *enclosing_trec) {
-  StgTRecHeader *result;
-  result = (StgTRecHeader *) allocateLocal(cap, sizeofW(StgTRecHeader));
-  SET_HDR (result, &stg_TREC_HEADER_info, CCS_SYSTEM);
-
-  result -> enclosing_trec = enclosing_trec;
-  result -> current_chunk = new_stg_trec_chunk(cap);
-
-  if (enclosing_trec == NO_TREC) {
-    result -> state = TREC_ACTIVE;
-  } else {
-    ASSERT(enclosing_trec -> state == TREC_ACTIVE ||
-           enclosing_trec -> state == TREC_CONDEMNED);
-    result -> state = enclosing_trec -> state;
-  }
-
-  return result;  
-}
-
-/*......................................................................*/
-
-// Allocation / deallocation functions that retain per-capability lists
-// of closures that can be re-used
-
-static StgTVarWaitQueue *alloc_stg_tvar_wait_queue(Capability *cap,
-                                                   StgTSO *waiting_tso) {
-  StgTVarWaitQueue *result = NULL;
-  if (cap -> free_tvar_wait_queues == END_STM_WAIT_QUEUE) {
-    result = new_stg_tvar_wait_queue(cap, waiting_tso);
-  } else {
-    result = cap -> free_tvar_wait_queues;
-    result -> waiting_tso = waiting_tso;
-    cap -> free_tvar_wait_queues = result -> next_queue_entry;
-  }
-  return result;
-}
-
-static void free_stg_tvar_wait_queue(Capability *cap,
-                                     StgTVarWaitQueue *wq) {
-#if defined(REUSE_MEMORY)
-  wq -> next_queue_entry = cap -> free_tvar_wait_queues;
-  cap -> free_tvar_wait_queues = wq;
-#endif
-}
-
-static StgTRecChunk *alloc_stg_trec_chunk(Capability *cap) {
-  StgTRecChunk *result = NULL;
-  if (cap -> free_trec_chunks == END_STM_CHUNK_LIST) {
-    result = new_stg_trec_chunk(cap);
-  } else {
-    result = cap -> free_trec_chunks;
-    cap -> free_trec_chunks = result -> prev_chunk;
-    result -> prev_chunk = END_STM_CHUNK_LIST;
-    result -> next_entry_idx = 0;
-  }
-  return result;
-}
-
-static void free_stg_trec_chunk(Capability *cap, 
-                                StgTRecChunk *c) {
-#if defined(REUSE_MEMORY)
-  c -> prev_chunk = cap -> free_trec_chunks;
-  cap -> free_trec_chunks = c;
-#endif
-}
-
-static StgTRecHeader *alloc_stg_trec_header(Capability *cap,
-                                            StgTRecHeader *enclosing_trec) {
-  StgTRecHeader *result = NULL;
-  if (cap -> free_trec_headers == NO_TREC) {
-    result = new_stg_trec_header(cap, enclosing_trec);
-  } else {
-    result = cap -> free_trec_headers;
-    cap -> free_trec_headers = result -> enclosing_trec;
-    result -> enclosing_trec = enclosing_trec;
-    result -> current_chunk -> next_entry_idx = 0;
-    if (enclosing_trec == NO_TREC) {
-      result -> state = TREC_ACTIVE;
-    } else {
-      ASSERT(enclosing_trec -> state == TREC_ACTIVE ||
-             enclosing_trec -> state == TREC_CONDEMNED);
-      result -> state = enclosing_trec -> state;
-    }
-  }
-  return result;
-}
-
-static void free_stg_trec_header(Capability *cap,
-                                 StgTRecHeader *trec) {
-#if defined(REUSE_MEMORY)
-  StgTRecChunk *chunk = trec -> current_chunk -> prev_chunk;
-  while (chunk != END_STM_CHUNK_LIST) {
-    StgTRecChunk *prev_chunk = chunk -> prev_chunk;
-    free_stg_trec_chunk(cap, chunk);
-    chunk = prev_chunk;
-  } 
-  trec -> current_chunk -> prev_chunk = END_STM_CHUNK_LIST;
-  trec -> enclosing_trec = cap -> free_trec_headers;
-  cap -> free_trec_headers = trec;
-#endif
-}
-
-/*......................................................................*/
-
-// Helper functions for managing waiting lists
-
-static void build_wait_queue_entries_for_trec(Capability *cap,
-                                      StgTSO *tso, 
-                                      StgTRecHeader *trec) {
-  ASSERT(trec != NO_TREC);
-  ASSERT(trec -> enclosing_trec == NO_TREC);
-  ASSERT(trec -> state == TREC_ACTIVE);
-
-  TRACE("%p : build_wait_queue_entries_for_trec()\n", trec);
-
-  FOR_EACH_ENTRY(trec, e, {
-    StgTVar *s;
-    StgTVarWaitQueue *q;
-    StgTVarWaitQueue *fq;
-    s = e -> tvar;
-    TRACE("%p : adding tso=%p to wait queue for tvar=%p\n", trec, tso, s);
-    ACQ_ASSERT(s -> current_value == trec);
-    NACQ_ASSERT(s -> current_value == e -> expected_value);
-    fq = s -> first_wait_queue_entry;
-    q = alloc_stg_tvar_wait_queue(cap, tso);
-    q -> next_queue_entry = fq;
-    q -> prev_queue_entry = END_STM_WAIT_QUEUE;
-    if (fq != END_STM_WAIT_QUEUE) {
-      fq -> prev_queue_entry = q;
-    }
-    s -> first_wait_queue_entry = q;
-    e -> new_value = (StgClosure *) q;
-  });
-}
-
-static void remove_wait_queue_entries_for_trec(Capability *cap,
-                                               StgTRecHeader *trec) {
-  ASSERT(trec != NO_TREC);
-  ASSERT(trec -> enclosing_trec == NO_TREC);
-  ASSERT(trec -> state == TREC_WAITING ||
-         trec -> state == TREC_CONDEMNED);
-
-  TRACE("%p : remove_wait_queue_entries_for_trec()\n", trec);
-
-  FOR_EACH_ENTRY(trec, e, {
-    StgTVar *s;
-    StgTVarWaitQueue *pq;
-    StgTVarWaitQueue *nq;
-    StgTVarWaitQueue *q;
-    s = e -> tvar;
-    StgClosure *saw = lock_tvar(trec, s);
-    q = (StgTVarWaitQueue *) (e -> new_value);
-    TRACE("%p : removing tso=%p from wait queue for tvar=%p\n", trec, q -> waiting_tso, s);
-    ACQ_ASSERT(s -> current_value == trec);
-    nq = q -> next_queue_entry;
-    pq = q -> prev_queue_entry;
-    if (nq != END_STM_WAIT_QUEUE) {
-      nq -> prev_queue_entry = pq;
-    }
-    if (pq != END_STM_WAIT_QUEUE) {
-      pq -> next_queue_entry = nq;
-    } else {
-      ASSERT (s -> first_wait_queue_entry == q);
-      s -> first_wait_queue_entry = nq;
-    }
-    free_stg_tvar_wait_queue(cap, q);
-    unlock_tvar(trec, s, saw, FALSE);
-  });
-}
- 
-/*......................................................................*/
- 
-static TRecEntry *get_new_entry(Capability *cap,
-                                StgTRecHeader *t) {
-  TRecEntry *result;
-  StgTRecChunk *c;
-  int i;
-
-  c = t -> current_chunk;
-  i = c -> next_entry_idx;
-  ASSERT(c != END_STM_CHUNK_LIST);
-
-  if (i < TREC_CHUNK_NUM_ENTRIES) {
-    // Continue to use current chunk
-    result = &(c -> entries[i]);
-    c -> next_entry_idx ++;
-  } else {
-    // Current chunk is full: allocate a fresh one
-    StgTRecChunk *nc;
-    nc = alloc_stg_trec_chunk(cap);
-    nc -> prev_chunk = c;
-    nc -> next_entry_idx = 1;
-    t -> current_chunk = nc;
-    result = &(nc -> entries[0]);
-  }
-
-  return result;
-}
-
-/*......................................................................*/
-
-static void merge_update_into(Capability *cap,
-                              StgTRecHeader *t,
-                              StgTVar *tvar,
-                              StgClosure *expected_value,
-                              StgClosure *new_value) {
-  int found;
-  
-  // Look for an entry in this trec
-  found = FALSE;
-  FOR_EACH_ENTRY(t, e, {
-    StgTVar *s;
-    s = e -> tvar;
-    if (s == tvar) {
-      found = TRUE;
-      if (e -> expected_value != expected_value) {
-        // Must abort if the two entries start from different values
-        TRACE("%p : entries inconsistent at %p (%p vs %p)\n", 
-              t, tvar, e -> expected_value, expected_value);
-        t -> state = TREC_CONDEMNED;
-      } 
-      e -> new_value = new_value;
-      BREAK_FOR_EACH;
-    }
-  });
-
-  if (!found) {
-    // No entry so far in this trec
-    TRecEntry *ne;
-    ne = get_new_entry(cap, t);
-    ne -> tvar = tvar;
-    ne -> expected_value = expected_value;
-    ne -> new_value = new_value;
-  }
-}
-
-/*......................................................................*/
-
-static StgBool entry_is_update(TRecEntry *e) {
-  StgBool result;
-  result = (e -> expected_value != e -> new_value);
-  return result;
-} 
-
-#if defined(STM_FG_LOCKS)
-static StgBool entry_is_read_only(TRecEntry *e) {
-  StgBool result;
-  result = (e -> expected_value == e -> new_value);
-  return result;
-} 
-
-static StgBool tvar_is_locked(StgTVar *s, StgTRecHeader *h) {
-  StgClosure *c;
-  StgBool result;
-  c = s -> current_value;
-  result = (c == (StgClosure *) h);
-  return result;  
-}
-#endif
-
-// revert_ownership : release a lock on a TVar, storing back
-// the value that it held when the lock was acquired.  "revert_all"
-// is set in stmWait and stmReWait when we acquired locks on all of 
-// the TVars involved.  "revert_all" is not set in commit operations
-// where we don't lock TVars that have been read from but not updated.
-
-static void revert_ownership(StgTRecHeader *trec STG_UNUSED,
-                             StgBool revert_all STG_UNUSED) {
-#if defined(STM_FG_LOCKS) 
-  FOR_EACH_ENTRY(trec, e, {
-    if (revert_all || entry_is_update(e)) {
-      StgTVar *s;
-      s = e -> tvar;
-      if (tvar_is_locked(s, trec)) {
-        unlock_tvar(trec, s, e -> expected_value, TRUE);
-      }
-    }
-  });
-#endif
-}
-
-/*......................................................................*/
-
-// validate_and_acquire_ownership : this performs the twin functions
-// of checking that the TVars referred to by entries in trec hold the
-// expected values and:
-// 
-//   - locking the TVar (on updated TVars during commit, or all TVars
-//     during wait)
-//
-//   - recording the identity of the TRec who wrote the value seen in the
-//     TVar (on non-updated TVars during commit).  These values are 
-//     stashed in the TRec entries and are then checked in check_read_only
-//     to ensure that an atomic snapshot of all of these locations has been
-//     seen.
-
-static StgBool validate_and_acquire_ownership (StgTRecHeader *trec, 
-                                               int acquire_all,
-                                               int retain_ownership) {
-  StgBool result;
-
-  if (shake()) {
-    TRACE("%p : shake, pretending trec is invalid when it may not be\n", trec);
-    return FALSE;
-  }
-
-  ASSERT ((trec -> state == TREC_ACTIVE) || 
-	  (trec -> state == TREC_WAITING) ||
-	  (trec -> state == TREC_CONDEMNED));
-  result = !((trec -> state) == TREC_CONDEMNED);
-  if (result) {
-    FOR_EACH_ENTRY(trec, e, {
-      StgTVar *s;
-      s = e -> tvar;
-      if (acquire_all || entry_is_update(e)) {
-        TRACE("%p : trying to acquire %p\n", trec, s);
-        if (!cond_lock_tvar(trec, s, e -> expected_value)) {
-          TRACE("%p : failed to acquire %p\n", trec, s);
-          result = FALSE;
-          BREAK_FOR_EACH;
-        }
-      } else {
-        ASSERT(use_read_phase);
-        IF_STM_FG_LOCKS({
-          TRACE("%p : will need to check %p\n", trec, s);
-          if (s -> current_value != e -> expected_value) {
-            TRACE("%p : doesn't match\n", trec);
-            result = FALSE;
-            BREAK_FOR_EACH;
-          }
-          e -> num_updates = s -> num_updates;
-          if (s -> current_value != e -> expected_value) {
-            TRACE("%p : doesn't match (race)\n", trec);
-            result = FALSE;
-            BREAK_FOR_EACH;
-          } else {
-            TRACE("%p : need to check version %d\n", trec, e -> num_updates);
-          }
-        });
-      }
-    });
-  }
-
-  if ((!result) || (!retain_ownership)) {
-    revert_ownership(trec, acquire_all);
-  }
-  
-  return result;
-}
-
-// check_read_only : check that we've seen an atomic snapshot of the
-// non-updated TVars accessed by a trec.  This checks that the last TRec to
-// commit an update to the TVar is unchanged since the value was stashed in
-// validate_and_acquire_ownership.  If no udpate is seen to any TVar than
-// all of them contained their expected values at the start of the call to
-// check_read_only.
-//
-// The paper "Concurrent programming without locks" (under submission), or
-// Keir Fraser's PhD dissertation "Practical lock-free programming" discuss
-// this kind of algorithm.
-
-static StgBool check_read_only(StgTRecHeader *trec STG_UNUSED) {
-  StgBool result = TRUE;
-
-  ASSERT (use_read_phase);
-  IF_STM_FG_LOCKS({
-    FOR_EACH_ENTRY(trec, e, {
-      StgTVar *s;
-      s = e -> tvar;
-      if (entry_is_read_only(e)) {
-        TRACE("%p : check_read_only for TVar %p, saw %d\n", trec, s, e -> num_updates);
-        if (s -> num_updates != e -> num_updates) {
-          // ||s -> current_value != e -> expected_value) {
-          TRACE("%p : mismatch\n", trec);
-          result = FALSE;
-          BREAK_FOR_EACH;
-        }
-      }
-    });
-  });
-
-  return result;
-}
-
-
-/************************************************************************/
-
-void stmPreGCHook() {
-  nat i;
-
-  lock_stm(NO_TREC);
-  TRACE("stmPreGCHook\n");
-  for (i = 0; i < n_capabilities; i ++) {
-    Capability *cap = &capabilities[i];
-    cap -> free_tvar_wait_queues = END_STM_WAIT_QUEUE;
-    cap -> free_trec_chunks = END_STM_CHUNK_LIST;
-    cap -> free_trec_headers = NO_TREC;
-  }
-  unlock_stm(NO_TREC);
-}
-
-/************************************************************************/
-
-// check_read_only relies on version numbers held in TVars' "num_updates" 
-// fields not wrapping around while a transaction is committed.  The version
-// number is incremented each time an update is committed to the TVar
-// This is unlikely to wrap around when 32-bit integers are used for the counts, 
-// but to ensure correctness we maintain a shared count on the maximum
-// number of commit operations that may occur and check that this has 
-// not increased by more than 2^32 during a commit.
-
-#define TOKEN_BATCH_SIZE 1024
-
-static volatile StgInt64 max_commits = 0;
-
-static volatile StgBool token_locked = FALSE;
-
-#if defined(THREADED_RTS)
-static void getTokenBatch(Capability *cap) {
-  while (cas(&token_locked, FALSE, TRUE) == TRUE) { /* nothing */ }
-  max_commits += TOKEN_BATCH_SIZE;
-  cap -> transaction_tokens = TOKEN_BATCH_SIZE;
-  token_locked = FALSE;
-}
-
-static void getToken(Capability *cap) {
-  if (cap -> transaction_tokens == 0) {
-    getTokenBatch(cap);
-  }
-  cap -> transaction_tokens --;
-}
-#else
-static void getToken(Capability *cap STG_UNUSED) {
-  // Nothing
-}
-#endif
-
-/*......................................................................*/
-
-StgTRecHeader *stmStartTransaction(Capability *cap,
-                                   StgTRecHeader *outer) {
-  StgTRecHeader *t;
-  TRACE("%p : stmStartTransaction with %d tokens\n", 
-        outer, 
-        cap -> transaction_tokens);
-
-  getToken(cap);
-
-  t = alloc_stg_trec_header(cap, outer);
-  TRACE("%p : stmStartTransaction()=%p\n", outer, t);
-  return t;
-}
-
-/*......................................................................*/
-
-void stmAbortTransaction(Capability *cap,
-                         StgTRecHeader *trec) {
-  TRACE("%p : stmAbortTransaction\n", trec);
-  ASSERT (trec != NO_TREC);
-  ASSERT ((trec -> state == TREC_ACTIVE) || 
-          (trec -> state == TREC_WAITING) ||
-          (trec -> state == TREC_CONDEMNED));
-
-  lock_stm(trec);
-  if (trec -> state == TREC_WAITING) {
-    ASSERT (trec -> enclosing_trec == NO_TREC);
-    TRACE("%p : stmAbortTransaction aborting waiting transaction\n", trec);
-    remove_wait_queue_entries_for_trec(cap, trec);
-  } 
-  trec -> state = TREC_ABORTED;
-  unlock_stm(trec);
-
-  free_stg_trec_header(cap, trec);
-
-  TRACE("%p : stmAbortTransaction done\n", trec);
-}
-
-/*......................................................................*/
-
-void stmCondemnTransaction(Capability *cap,
-                           StgTRecHeader *trec) {
-  TRACE("%p : stmCondemnTransaction\n", trec);
-  ASSERT (trec != NO_TREC);
-  ASSERT ((trec -> state == TREC_ACTIVE) || 
-          (trec -> state == TREC_WAITING) ||
-          (trec -> state == TREC_CONDEMNED));
-
-  lock_stm(trec);
-  if (trec -> state == TREC_WAITING) {
-    ASSERT (trec -> enclosing_trec == NO_TREC);
-    TRACE("%p : stmCondemnTransaction condemning waiting transaction\n", trec);
-    remove_wait_queue_entries_for_trec(cap, trec);
-  } 
-  trec -> state = TREC_CONDEMNED;
-  unlock_stm(trec);
-
-  TRACE("%p : stmCondemnTransaction done\n", trec);
-}
-
-/*......................................................................*/
-
-StgTRecHeader *stmGetEnclosingTRec(StgTRecHeader *trec) {
-  StgTRecHeader *outer;
-  TRACE("%p : stmGetEnclosingTRec\n", trec);
-  outer = trec -> enclosing_trec;
-  TRACE("%p : stmGetEnclosingTRec()=%p\n", trec, outer);
-  return outer;
-}
-
-/*......................................................................*/
-
-StgBool stmValidateNestOfTransactions(StgTRecHeader *trec) {
-  StgTRecHeader *t;
-  StgBool result;
-
-  TRACE("%p : stmValidateNestOfTransactions\n", trec);
-  ASSERT(trec != NO_TREC);
-  ASSERT((trec -> state == TREC_ACTIVE) || 
-         (trec -> state == TREC_WAITING) ||
-         (trec -> state == TREC_CONDEMNED));
-
-  lock_stm(trec);
-
-  t = trec;
-  result = TRUE;
-  while (t != NO_TREC) {
-    result &= validate_and_acquire_ownership(t, TRUE, FALSE);
-    t = t -> enclosing_trec;
-  }
-
-  if (!result && trec -> state != TREC_WAITING) {
-    trec -> state = TREC_CONDEMNED; 
-  }
-
-  unlock_stm(trec);
-
-  TRACE("%p : stmValidateNestOfTransactions()=%d\n", trec, result);
-  return result;
-}
-
-/*......................................................................*/
-
-StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec) {
-  int result;
-  StgInt64 max_commits_at_start = max_commits;
-
-  TRACE("%p : stmCommitTransaction()\n", trec);
-  ASSERT (trec != NO_TREC);
-
-  lock_stm(trec);
-
-  ASSERT (trec -> enclosing_trec == NO_TREC);
-  ASSERT ((trec -> state == TREC_ACTIVE) || 
-          (trec -> state == TREC_CONDEMNED));
-
-  result = validate_and_acquire_ownership(trec, (!use_read_phase), TRUE);
-  if (result) {
-    // We now know that all the updated locations hold their expected values.
-    ASSERT (trec -> state == TREC_ACTIVE);
-
-    if (use_read_phase) {
-      TRACE("%p : doing read check\n", trec);
-      result = check_read_only(trec);
-      TRACE("%p : read-check %s\n", trec, result ? "succeeded" : "failed");
-
-      StgInt64 max_commits_at_end = max_commits;
-      StgInt64 max_concurrent_commits;
-      max_concurrent_commits = ((max_commits_at_end - max_commits_at_start) +
-                                (n_capabilities * TOKEN_BATCH_SIZE));
-      if (((max_concurrent_commits >> 32) > 0) || shake()) {
-        result = FALSE;
-      }
-    }
-    
-    if (result) {
-      // We now know that all of the read-only locations held their exepcted values
-      // at the end of the call to validate_and_acquire_ownership.  This forms the
-      // linearization point of the commit.
-      
-      FOR_EACH_ENTRY(trec, e, {
-        StgTVar *s;
-        s = e -> tvar;
-        if (e -> new_value != e -> expected_value) {
-          // Entry is an update: write the value back to the TVar, unlocking it if
-          // necessary.
-
-          ACQ_ASSERT(tvar_is_locked(s, trec));
-          TRACE("%p : writing %p to %p, waking waiters\n", trec, e -> new_value, s);
-          unpark_waiters_on(cap,s);
-          IF_STM_FG_LOCKS({
-            s -> num_updates ++;
-          });
-          unlock_tvar(trec, s, e -> new_value, TRUE);
-        } 
-        ACQ_ASSERT(!tvar_is_locked(s, trec));
-      });
-    } else {
-      revert_ownership(trec, FALSE);
-    }
-  } 
-
-  unlock_stm(trec);
-
-  free_stg_trec_header(cap, trec);
-
-  TRACE("%p : stmCommitTransaction()=%d\n", trec, result);
-
-  return result;
-}
-
-/*......................................................................*/
-
-StgBool stmCommitNestedTransaction(Capability *cap, StgTRecHeader *trec) {
-  StgTRecHeader *et;
-  int result;
-  ASSERT (trec != NO_TREC && trec -> enclosing_trec != NO_TREC);
-  TRACE("%p : stmCommitNestedTransaction() into %p\n", trec, trec -> enclosing_trec);
-  ASSERT ((trec -> state == TREC_ACTIVE) || (trec -> state == TREC_CONDEMNED));
-
-  lock_stm(trec);
-
-  et = trec -> enclosing_trec;
-  result = validate_and_acquire_ownership(trec, (!use_read_phase), TRUE);
-  if (result) {
-    // We now know that all the updated locations hold their expected values.
-
-    if (use_read_phase) {
-      TRACE("%p : doing read check\n", trec);
-      result = check_read_only(trec);
-    }
-    if (result) {
-      // We now know that all of the read-only locations held their exepcted values
-      // at the end of the call to validate_and_acquire_ownership.  This forms the
-      // linearization point of the commit.
-
-      if (result) {
-        TRACE("%p : read-check succeeded\n", trec);
-        FOR_EACH_ENTRY(trec, e, {
-          // Merge each entry into the enclosing transaction record, release all
-          // locks.
-
-          StgTVar *s;
-          s = e -> tvar;
-          if (entry_is_update(e)) {
-            unlock_tvar(trec, s, e -> expected_value, FALSE);
-          }
-          merge_update_into(cap, et, s, e -> expected_value, e -> new_value);
-          ACQ_ASSERT(s -> current_value != trec);
-        });
-      } else {
-        revert_ownership(trec, FALSE);
-      }
-    }
-  } 
-
-  unlock_stm(trec);
-
-  free_stg_trec_header(cap, trec);
-
-  TRACE("%p : stmCommitNestedTransaction()=%d\n", trec, result);
-
-  return result;
-}
-
-/*......................................................................*/
-
-StgBool stmWait(Capability *cap, StgTSO *tso, StgTRecHeader *trec) {
-  int result;
-  TRACE("%p : stmWait(%p)\n", trec, tso);
-  ASSERT (trec != NO_TREC);
-  ASSERT (trec -> enclosing_trec == NO_TREC);
-  ASSERT ((trec -> state == TREC_ACTIVE) || 
-          (trec -> state == TREC_CONDEMNED));
-
-  lock_stm(trec);
-  result = validate_and_acquire_ownership(trec, TRUE, TRUE);
-  if (result) {
-    // The transaction is valid so far so we can actually start waiting.
-    // (Otherwise the transaction was not valid and the thread will have to
-    // retry it).
-
-    // Put ourselves to sleep.  We retain locks on all the TVars involved
-    // until we are sound asleep : (a) on the wait queues, (b) BlockedOnSTM
-    // in the TSO, (c) TREC_WAITING in the Trec.  
-    build_wait_queue_entries_for_trec(cap, tso, trec);
-    park_tso(tso);
-    trec -> state = TREC_WAITING;
-
-    // We haven't released ownership of the transaction yet.  The TSO
-    // has been put on the wait queue for the TVars it is waiting for,
-    // but we haven't yet tidied up the TSO's stack and made it safe
-    // to wake up the TSO.  Therefore, we must wait until the TSO is
-    // safe to wake up before we release ownership - when all is well,
-    // the runtime will call stmWaitUnlock() below, with the same
-    // TRec.
-
-  } else {
-    unlock_stm(trec);
-    free_stg_trec_header(cap, trec);
-  }
-
-  TRACE("%p : stmWait(%p)=%d\n", trec, tso, result);
-  return result;
-}
-
-
-void
-stmWaitUnlock(Capability *cap STG_UNUSED, StgTRecHeader *trec) {
-    revert_ownership(trec, TRUE);
-    unlock_stm(trec);
-}
-
-/*......................................................................*/
-
-StgBool stmReWait(Capability *cap, StgTSO *tso) {
-  int result;
-  StgTRecHeader *trec = tso->trec;
-
-  TRACE("%p : stmReWait\n", trec);
-  ASSERT (trec != NO_TREC);
-  ASSERT (trec -> enclosing_trec == NO_TREC);
-  ASSERT ((trec -> state == TREC_WAITING) || 
-          (trec -> state == TREC_CONDEMNED));
-
-  lock_stm(trec);
-  result = validate_and_acquire_ownership(trec, TRUE, TRUE);
-  TRACE("%p : validation %s\n", trec, result ? "succeeded" : "failed");
-  if (result) {
-    // The transaction remains valid -- do nothing because it is already on
-    // the wait queues
-    ASSERT (trec -> state == TREC_WAITING);
-    park_tso(tso);
-    revert_ownership(trec, TRUE);
-  } else {
-    // The transcation has become invalid.  We can now remove it from the wait
-    // queues.
-    if (trec -> state != TREC_CONDEMNED) {
-      remove_wait_queue_entries_for_trec (cap, trec);
-    }
-    free_stg_trec_header(cap, trec);
-  }
-  unlock_stm(trec);
-
-  TRACE("%p : stmReWait()=%d\n", trec, result);
-  return result;
-}
-
-/*......................................................................*/
-
-static TRecEntry *get_entry_for(StgTRecHeader *trec, StgTVar *tvar, StgTRecHeader **in) {
-  TRecEntry *result = NULL;
-
-  TRACE("%p : get_entry_for TVar %p\n", trec, tvar);
-  ASSERT(trec != NO_TREC);
-
-  do {
-    FOR_EACH_ENTRY(trec, e, {
-      if (e -> tvar == tvar) {
-        result = e;
-        if (in != NULL) {
-          *in = trec;
-        }
-        BREAK_FOR_EACH;
-      }
-    });
-    trec = trec -> enclosing_trec;
-  } while (result == NULL && trec != NO_TREC);
-
-  return result;    
-}
-
-static StgClosure *read_current_value(StgTRecHeader *trec STG_UNUSED, StgTVar *tvar) {
-  StgClosure *result;
-  result = tvar -> current_value;
-
-#if defined(STM_FG_LOCKS)
-  while (GET_INFO(result) == &stg_TREC_HEADER_info) {
-    TRACE("%p : read_current_value(%p) saw %p\n", trec, tvar, result);
-    result = tvar -> current_value;
-  }
-#endif
-
-  TRACE("%p : read_current_value(%p)=%p\n", trec, tvar, result);
-  return result;
-}
-
-/*......................................................................*/
-
-StgClosure *stmReadTVar(Capability *cap,
-                        StgTRecHeader *trec, 
-			StgTVar *tvar) {
-  StgTRecHeader *entry_in;
-  StgClosure *result = NULL;
-  TRecEntry *entry = NULL;
-  TRACE("%p : stmReadTVar(%p)\n", trec, tvar);
-  ASSERT (trec != NO_TREC);
-  ASSERT (trec -> state == TREC_ACTIVE || 
-          trec -> state == TREC_CONDEMNED);
-
-  entry = get_entry_for(trec, tvar, &entry_in);
-
-  if (entry != NULL) {
-    if (entry_in == trec) {
-      // Entry found in our trec
-      result = entry -> new_value;
-    } else {
-      // Entry found in another trec
-      TRecEntry *new_entry = get_new_entry(cap, trec);
-      new_entry -> tvar = tvar;
-      new_entry -> expected_value = entry -> expected_value;
-      new_entry -> new_value = entry -> new_value;
-      result = new_entry -> new_value;
-    } 
-  } else {
-    // No entry found
-    StgClosure *current_value = read_current_value(trec, tvar);
-    TRecEntry *new_entry = get_new_entry(cap, trec);
-    new_entry -> tvar = tvar;
-    new_entry -> expected_value = current_value;
-    new_entry -> new_value = current_value;
-    result = current_value;
-  }
-
-  TRACE("%p : stmReadTVar(%p)=%p\n", trec, tvar, result);
-  return result;
-}
-
-/*......................................................................*/
-
-void stmWriteTVar(Capability *cap,
-                  StgTRecHeader *trec,
-		  StgTVar *tvar, 
-		  StgClosure *new_value) {
-
-  StgTRecHeader *entry_in;
-  TRecEntry *entry = NULL;
-  TRACE("%p : stmWriteTVar(%p, %p)\n", trec, tvar, new_value);
-  ASSERT (trec != NO_TREC);
-  ASSERT (trec -> state == TREC_ACTIVE || 
-          trec -> state == TREC_CONDEMNED);
-
-  entry = get_entry_for(trec, tvar, &entry_in);
-
-  if (entry != NULL) {
-    if (entry_in == trec) {
-      // Entry found in our trec
-      entry -> new_value = new_value;
-    } else {
-      // Entry found in another trec
-      TRecEntry *new_entry = get_new_entry(cap, trec);
-      new_entry -> tvar = tvar;
-      new_entry -> expected_value = entry -> expected_value;
-      new_entry -> new_value = new_value;
-    } 
-  } else {
-    // No entry found
-    StgClosure *current_value = read_current_value(trec, tvar);
-    TRecEntry *new_entry = get_new_entry(cap, trec);
-    new_entry -> tvar = tvar;
-    new_entry -> expected_value = current_value;
-    new_entry -> new_value = new_value;
-  }
-
-  TRACE("%p : stmWriteTVar done\n", trec);
-}
-
-/*......................................................................*/
-
-StgTVar *stmNewTVar(Capability *cap,
-                    StgClosure *new_value) {
-  StgTVar *result;
-  result = (StgTVar *)allocateLocal(cap, sizeofW(StgTVar));
-  SET_HDR (result, &stg_TVAR_info, CCS_SYSTEM);
-  result -> current_value = new_value;
-  result -> first_wait_queue_entry = END_STM_WAIT_QUEUE;
-#if defined(THREADED_RTS)
-  result -> num_updates = 0;
-#endif
-  return result;
-}
-
-/*......................................................................*/
diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c
deleted file mode 100644
index 0e68a86ba7..0000000000
--- a/ghc/rts/Sanity.c
+++ /dev/null
@@ -1,948 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2006
- *
- * Sanity checking code for the heap and stack.
- *
- * Used when debugging: check that everything reasonable.
- *
- *    - All things that are supposed to be pointers look like pointers.
- *
- *    - Objects in text space are marked as static closures, those
- *	in the heap are dynamic.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-
-#ifdef DEBUG                                                   /* whole file */
-
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "BlockAlloc.h"
-#include "Sanity.h"
-#include "MBlock.h"
-#include "Storage.h"
-#include "Schedule.h"
-#include "Apply.h"
-
-/* -----------------------------------------------------------------------------
-   Forward decls.
-   -------------------------------------------------------------------------- */
-
-static void      checkSmallBitmap    ( StgPtr payload, StgWord bitmap, nat );
-static void      checkLargeBitmap    ( StgPtr payload, StgLargeBitmap*, nat );
-static void      checkClosureShallow ( StgClosure * );
-
-/* -----------------------------------------------------------------------------
-   Check stack sanity
-   -------------------------------------------------------------------------- */
-
-static void
-checkSmallBitmap( StgPtr payload, StgWord bitmap, nat size )
-{
-    StgPtr p;
-    nat i;
-
-    p = payload;
-    for(i = 0; i < size; i++, bitmap >>= 1 ) {
-	if ((bitmap & 1) == 0) {
-	    checkClosureShallow((StgClosure *)payload[i]);
-	}
-    }
-}
-
-static void
-checkLargeBitmap( StgPtr payload, StgLargeBitmap* large_bitmap, nat size )
-{
-    StgWord bmp;
-    nat i, j;
-
-    i = 0;
-    for (bmp=0; i < size; bmp++) {
-	StgWord bitmap = large_bitmap->bitmap[bmp];
-	j = 0;
-	for(; i < size && j < BITS_IN(W_); j++, i++, bitmap >>= 1 ) {
-	    if ((bitmap & 1) == 0) {
-		checkClosureShallow((StgClosure *)payload[i]);
-	    }
-	}
-    }
-}
-
-/*
- * check that it looks like a valid closure - without checking its payload
- * used to avoid recursion between checking PAPs and checking stack
- * chunks.
- */
- 
-static void 
-checkClosureShallow( StgClosure* p )
-{
-    ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
-
-    /* Is it a static closure? */
-    if (!HEAP_ALLOCED(p)) {
-	ASSERT(closure_STATIC(p));
-    } else {
-	ASSERT(!closure_STATIC(p));
-    }
-}
-
-// check an individual stack object
-StgOffset 
-checkStackFrame( StgPtr c )
-{
-    nat size;
-    const StgRetInfoTable* info;
-
-    info = get_ret_itbl((StgClosure *)c);
-
-    /* All activation records have 'bitmap' style layout info. */
-    switch (info->i.type) {
-    case RET_DYN: /* Dynamic bitmap: the mask is stored on the stack */
-    {
-	StgWord dyn;
-	StgPtr p;
-	StgRetDyn* r;
-	
-	r = (StgRetDyn *)c;
-	dyn = r->liveness;
-	
-	p = (P_)(r->payload);
-	checkSmallBitmap(p,RET_DYN_LIVENESS(r->liveness),RET_DYN_BITMAP_SIZE);
-	p += RET_DYN_BITMAP_SIZE + RET_DYN_NONPTR_REGS_SIZE;
-
-	// skip over the non-pointers
-	p += RET_DYN_NONPTRS(dyn);
-	
-	// follow the ptr words
-	for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
-	    checkClosureShallow((StgClosure *)*p);
-	    p++;
-	}
-	
-	return sizeofW(StgRetDyn) + RET_DYN_BITMAP_SIZE +
-	    RET_DYN_NONPTR_REGS_SIZE +
-	    RET_DYN_NONPTRS(dyn) + RET_DYN_PTRS(dyn);
-    }
-
-    case UPDATE_FRAME:
-      ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgUpdateFrame*)c)->updatee));
-    case ATOMICALLY_FRAME:
-    case CATCH_RETRY_FRAME:
-    case CATCH_STM_FRAME:
-    case CATCH_FRAME:
-      // small bitmap cases (<= 32 entries)
-    case STOP_FRAME:
-    case RET_SMALL:
-    case RET_VEC_SMALL:
-	size = BITMAP_SIZE(info->i.layout.bitmap);
-	checkSmallBitmap((StgPtr)c + 1, 
-			 BITMAP_BITS(info->i.layout.bitmap), size);
-	return 1 + size;
-
-    case RET_BCO: {
-	StgBCO *bco;
-	nat size;
-	bco = (StgBCO *)*(c+1);
-	size = BCO_BITMAP_SIZE(bco);
-	checkLargeBitmap((StgPtr)c + 2, BCO_BITMAP(bco), size);
-	return 2 + size;
-    }
-
-    case RET_BIG: // large bitmap (> 32 entries)
-    case RET_VEC_BIG:
-	size = GET_LARGE_BITMAP(&info->i)->size;
-	checkLargeBitmap((StgPtr)c + 1, GET_LARGE_BITMAP(&info->i), size);
-	return 1 + size;
-
-    case RET_FUN:
-    {
-	StgFunInfoTable *fun_info;
-	StgRetFun *ret_fun;
-
-	ret_fun = (StgRetFun *)c;
-	fun_info = get_fun_itbl(ret_fun->fun);
-	size = ret_fun->size;
-	switch (fun_info->f.fun_type) {
-	case ARG_GEN:
-	    checkSmallBitmap((StgPtr)ret_fun->payload, 
-			     BITMAP_BITS(fun_info->f.b.bitmap), size);
-	    break;
-	case ARG_GEN_BIG:
-	    checkLargeBitmap((StgPtr)ret_fun->payload,
-			     GET_FUN_LARGE_BITMAP(fun_info), size);
-	    break;
-	default:
-	    checkSmallBitmap((StgPtr)ret_fun->payload,
-			     BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
-			     size);
-	    break;
-	}
-	return sizeofW(StgRetFun) + size;
-    }
-
-    default:
-	barf("checkStackFrame: weird activation record found on stack (%p %d).",c,info->i.type);
-    }
-}
-
-// check sections of stack between update frames
-void 
-checkStackChunk( StgPtr sp, StgPtr stack_end )
-{
-    StgPtr p;
-
-    p = sp;
-    while (p < stack_end) {
-	p += checkStackFrame( p );
-    }
-    // ASSERT( p == stack_end ); -- HWL
-}
-
-static void
-checkPAP (StgClosure *fun, StgClosure** payload, StgWord n_args)
-{ 
-    StgClosure *p;
-    StgFunInfoTable *fun_info;
-    
-    ASSERT(LOOKS_LIKE_CLOSURE_PTR(fun));
-    fun_info = get_fun_itbl(fun);
-    
-    p = (StgClosure *)payload;
-    switch (fun_info->f.fun_type) {
-    case ARG_GEN:
-	checkSmallBitmap( (StgPtr)payload, 
-			  BITMAP_BITS(fun_info->f.b.bitmap), n_args );
-	break;
-    case ARG_GEN_BIG:
-	checkLargeBitmap( (StgPtr)payload, 
-			  GET_FUN_LARGE_BITMAP(fun_info), 
-			  n_args );
-	break;
-    case ARG_BCO:
-	checkLargeBitmap( (StgPtr)payload, 
-			  BCO_BITMAP(fun), 
-			  n_args );
-	break;
-    default:
-	checkSmallBitmap( (StgPtr)payload, 
-			  BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]),
-			  n_args );
-	break;
-    }
-}
-
-
-StgOffset 
-checkClosure( StgClosure* p )
-{
-    const StgInfoTable *info;
-
-    ASSERT(LOOKS_LIKE_INFO_PTR(p->header.info));
-
-    /* Is it a static closure (i.e. in the data segment)? */
-    if (!HEAP_ALLOCED(p)) {
-	ASSERT(closure_STATIC(p));
-    } else {
-	ASSERT(!closure_STATIC(p));
-    }
-
-    info = get_itbl(p);
-    switch (info->type) {
-
-    case MVAR:
-      { 
-	StgMVar *mvar = (StgMVar *)p;
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->head));
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->tail));
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(mvar->value));
-#if 0
-#if defined(PAR)
-	checkBQ((StgBlockingQueueElement *)mvar->head, p);
-#else
-	checkBQ(mvar->head, p);
-#endif
-#endif
-	return sizeofW(StgMVar);
-      }
-
-    case THUNK:
-    case THUNK_1_0:
-    case THUNK_0_1:
-    case THUNK_1_1:
-    case THUNK_0_2:
-    case THUNK_2_0:
-      {
-	nat i;
-	for (i = 0; i < info->layout.payload.ptrs; i++) {
-	  ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgThunk *)p)->payload[i]));
-	}
-	return thunk_sizeW_fromITBL(info);
-      }
-
-    case FUN:
-    case FUN_1_0:
-    case FUN_0_1:
-    case FUN_1_1:
-    case FUN_0_2:
-    case FUN_2_0:
-    case CONSTR:
-    case CONSTR_1_0:
-    case CONSTR_0_1:
-    case CONSTR_1_1:
-    case CONSTR_0_2:
-    case CONSTR_2_0:
-    case IND_PERM:
-    case IND_OLDGEN:
-    case IND_OLDGEN_PERM:
-#ifdef TICKY_TICKY
-    case SE_BLACKHOLE:
-    case SE_CAF_BLACKHOLE:
-#endif
-    case BLACKHOLE:
-    case CAF_BLACKHOLE:
-    case STABLE_NAME:
-    case MUT_VAR_CLEAN:
-    case MUT_VAR_DIRTY:
-    case CONSTR_INTLIKE:
-    case CONSTR_CHARLIKE:
-    case CONSTR_STATIC:
-    case CONSTR_NOCAF_STATIC:
-    case THUNK_STATIC:
-    case FUN_STATIC:
-	{
-	    nat i;
-	    for (i = 0; i < info->layout.payload.ptrs; i++) {
-		ASSERT(LOOKS_LIKE_CLOSURE_PTR(p->payload[i]));
-	    }
-	    return sizeW_fromITBL(info);
-	}
-
-    case BCO: {
-	StgBCO *bco = (StgBCO *)p;
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->instrs));
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->literals));
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->ptrs));
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(bco->itbls));
-	return bco_sizeW(bco);
-    }
-
-    case IND_STATIC: /* (1, 0) closure */
-      ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgIndStatic*)p)->indirectee));
-      return sizeW_fromITBL(info);
-
-    case WEAK:
-      /* deal with these specially - the info table isn't
-       * representative of the actual layout.
-       */
-      { StgWeak *w = (StgWeak *)p;
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->key));
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->value));
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->finalizer));
-	if (w->link) {
-	  ASSERT(LOOKS_LIKE_CLOSURE_PTR(w->link));
-	}
-	return sizeW_fromITBL(info);
-      }
-
-    case THUNK_SELECTOR:
-	    ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgSelector *)p)->selectee));
-	    return THUNK_SELECTOR_sizeW();
-
-    case IND:
-	{ 
-  	    /* we don't expect to see any of these after GC
-	     * but they might appear during execution
-	     */
-	    StgInd *ind = (StgInd *)p;
-	    ASSERT(LOOKS_LIKE_CLOSURE_PTR(ind->indirectee));
-	    return sizeofW(StgInd);
-	}
-
-    case RET_BCO:
-    case RET_SMALL:
-    case RET_VEC_SMALL:
-    case RET_BIG:
-    case RET_VEC_BIG:
-    case RET_DYN:
-    case UPDATE_FRAME:
-    case STOP_FRAME:
-    case CATCH_FRAME:
-    case ATOMICALLY_FRAME:
-    case CATCH_RETRY_FRAME:
-    case CATCH_STM_FRAME:
-	    barf("checkClosure: stack frame");
-
-    case AP:
-    {
-	StgAP* ap = (StgAP *)p;
-	checkPAP (ap->fun, ap->payload, ap->n_args);
-	return ap_sizeW(ap);
-    }
-
-    case PAP:
-    {
-	StgPAP* pap = (StgPAP *)p;
-	checkPAP (pap->fun, pap->payload, pap->n_args);
-	return pap_sizeW(pap);
-    }
-
-    case AP_STACK:
-    { 
-	StgAP_STACK *ap = (StgAP_STACK *)p;
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(ap->fun));
-	checkStackChunk((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
-	return ap_stack_sizeW(ap);
-    }
-
-    case ARR_WORDS:
-	    return arr_words_sizeW((StgArrWords *)p);
-
-    case MUT_ARR_PTRS_CLEAN:
-    case MUT_ARR_PTRS_DIRTY:
-    case MUT_ARR_PTRS_FROZEN:
-    case MUT_ARR_PTRS_FROZEN0:
-	{
-	    StgMutArrPtrs* a = (StgMutArrPtrs *)p;
-	    nat i;
-	    for (i = 0; i < a->ptrs; i++) {
-		ASSERT(LOOKS_LIKE_CLOSURE_PTR(a->payload[i]));
-	    }
-	    return mut_arr_ptrs_sizeW(a);
-	}
-
-    case TSO:
-        checkTSO((StgTSO *)p);
-        return tso_sizeW((StgTSO *)p);
-
-#if defined(PAR)
-
-    case BLOCKED_FETCH:
-      ASSERT(LOOKS_LIKE_GA(&(((StgBlockedFetch *)p)->ga)));
-      ASSERT(LOOKS_LIKE_CLOSURE_PTR((((StgBlockedFetch *)p)->node)));
-      return sizeofW(StgBlockedFetch);  // see size used in evacuate()
-
-#ifdef DIST
-    case REMOTE_REF:
-      return sizeofW(StgFetchMe); 
-#endif /*DIST */
-      
-    case FETCH_ME:
-      ASSERT(LOOKS_LIKE_GA(((StgFetchMe *)p)->ga));
-      return sizeofW(StgFetchMe);  // see size used in evacuate()
-
-    case FETCH_ME_BQ:
-      checkBQ(((StgFetchMeBlockingQueue *)p)->blocking_queue, (StgClosure *)p);
-      return sizeofW(StgFetchMeBlockingQueue); // see size used in evacuate()
-
-    case RBH:
-      /* In an RBH the BQ may be empty (ie END_BQ_QUEUE) but not NULL */
-      ASSERT(((StgRBH *)p)->blocking_queue!=NULL);
-      if (((StgRBH *)p)->blocking_queue!=END_BQ_QUEUE)
-	checkBQ(((StgRBH *)p)->blocking_queue, p);
-      ASSERT(LOOKS_LIKE_INFO_PTR(REVERT_INFOPTR(get_itbl((StgClosure *)p))));
-      return BLACKHOLE_sizeW();   // see size used in evacuate()
-      // sizeW_fromITBL(REVERT_INFOPTR(get_itbl((StgClosure *)p)));
-
-#endif
-
-    case TVAR_WAIT_QUEUE:
-      {
-        StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p;
-        ASSERT(LOOKS_LIKE_CLOSURE_PTR(wq->next_queue_entry));
-        ASSERT(LOOKS_LIKE_CLOSURE_PTR(wq->prev_queue_entry));
-        return sizeofW(StgTVarWaitQueue);
-      }
-
-    case TVAR:
-      {
-        StgTVar *tv = (StgTVar *)p;
-        ASSERT(LOOKS_LIKE_CLOSURE_PTR(tv->current_value));
-        ASSERT(LOOKS_LIKE_CLOSURE_PTR(tv->first_wait_queue_entry));
-        return sizeofW(StgTVar);
-      }
-
-    case TREC_CHUNK:
-      {
-        nat i;
-        StgTRecChunk *tc = (StgTRecChunk *)p;
-        ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->prev_chunk));
-        for (i = 0; i < tc -> next_entry_idx; i ++) {
-          ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->entries[i].tvar));
-          ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->entries[i].expected_value));
-          ASSERT(LOOKS_LIKE_CLOSURE_PTR(tc->entries[i].new_value));
-        }
-        return sizeofW(StgTRecChunk);
-      }
-
-    case TREC_HEADER:
-      {
-        StgTRecHeader *trec = (StgTRecHeader *)p;
-        ASSERT(LOOKS_LIKE_CLOSURE_PTR(trec -> enclosing_trec));
-        ASSERT(LOOKS_LIKE_CLOSURE_PTR(trec -> current_chunk));
-        return sizeofW(StgTRecHeader);
-      }
-      
-      
-    case EVACUATED:
-	    barf("checkClosure: found EVACUATED closure %d",
-		 info->type);
-    default:
-	    barf("checkClosure (closure type %d)", info->type);
-    }
-}
-
-#if defined(PAR)
-
-#define PVM_PE_MASK    0xfffc0000
-#define MAX_PVM_PES    MAX_PES
-#define MAX_PVM_TIDS   MAX_PES
-#define MAX_SLOTS      100000
-
-rtsBool
-looks_like_tid(StgInt tid)
-{
-  StgInt hi = (tid & PVM_PE_MASK) >> 18;
-  StgInt lo = (tid & ~PVM_PE_MASK);
-  rtsBool ok = (hi != 0) && (lo < MAX_PVM_TIDS) && (hi < MAX_PVM_TIDS);
-  return ok;
-}
-
-rtsBool
-looks_like_slot(StgInt slot)
-{
-  /* if tid is known better use looks_like_ga!! */
-  rtsBool ok = slot<MAX_SLOTS;
-  // This refers only to the no. of slots on the current PE
-  // rtsBool ok = slot<=highest_slot();
-  return ok; 
-}
-
-rtsBool
-looks_like_ga(globalAddr *ga)
-{
-  rtsBool is_tid = looks_like_tid((ga)->payload.gc.gtid);
-  rtsBool is_slot = ((ga)->payload.gc.gtid==mytid) ? 
-                     (ga)->payload.gc.slot<=highest_slot() : 
-                     (ga)->payload.gc.slot<MAX_SLOTS;
-  rtsBool ok = is_tid && is_slot;
-  return ok;
-}
-
-#endif
-
-
-/* -----------------------------------------------------------------------------
-   Check Heap Sanity
-
-   After garbage collection, the live heap is in a state where we can
-   run through and check that all the pointers point to the right
-   place.  This function starts at a given position and sanity-checks
-   all the objects in the remainder of the chain.
-   -------------------------------------------------------------------------- */
-
-void 
-checkHeap(bdescr *bd)
-{
-    StgPtr p;
-
-#if defined(THREADED_RTS)
-    // heap sanity checking doesn't work with SMP, because we can't
-    // zero the slop (see Updates.h).
-    return;
-#endif
-
-    for (; bd != NULL; bd = bd->link) {
-	p = bd->start;
-	while (p < bd->free) {
-	    nat size = checkClosure((StgClosure *)p);
-	    /* This is the smallest size of closure that can live in the heap */
-	    ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) );
-	    p += size;
-	    
-	    /* skip over slop */
-	    while (p < bd->free &&
-		   (*p < 0x1000 || !LOOKS_LIKE_INFO_PTR((void*)*p))) { p++; } 
-	}
-    }
-}
-
-#if defined(PAR)
-/* 
-   Check heap between start and end. Used after unpacking graphs.
-*/
-void 
-checkHeapChunk(StgPtr start, StgPtr end)
-{
-  extern globalAddr *LAGAlookup(StgClosure *addr);
-  StgPtr p;
-  nat size;
-
-  for (p=start; p<end; p+=size) {
-    ASSERT(LOOKS_LIKE_INFO_PTR((void*)*p));
-    if (get_itbl((StgClosure*)p)->type == FETCH_ME &&
-	*(p+1) == 0x0000eeee /* ie. unpack garbage (see SetGAandCommonUp) */) {
-      /* if it's a FM created during unpack and commoned up, it's not global */
-      ASSERT(LAGAlookup((StgClosure*)p)==NULL);
-      size = sizeofW(StgFetchMe);
-    } else if (get_itbl((StgClosure*)p)->type == IND) {
-      *(p+2) = 0x0000ee11; /* mark slop in IND as garbage */
-      size = sizeofW(StgInd);
-    } else {
-      size = checkClosure((StgClosure *)p);
-      /* This is the smallest size of closure that can live in the heap. */
-      ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) );
-    }
-  }
-}
-#else /* !PAR */
-void 
-checkHeapChunk(StgPtr start, StgPtr end)
-{
-  StgPtr p;
-  nat size;
-
-  for (p=start; p<end; p+=size) {
-    ASSERT(LOOKS_LIKE_INFO_PTR((void*)*p));
-    size = checkClosure((StgClosure *)p);
-    /* This is the smallest size of closure that can live in the heap. */
-    ASSERT( size >= MIN_PAYLOAD_SIZE + sizeofW(StgHeader) );
-  }
-}
-#endif
-
-void
-checkChain(bdescr *bd)
-{
-  while (bd != NULL) {
-    checkClosure((StgClosure *)bd->start);
-    bd = bd->link;
-  }
-}
-
-void
-checkTSO(StgTSO *tso)
-{
-    StgPtr sp = tso->sp;
-    StgPtr stack = tso->stack;
-    StgOffset stack_size = tso->stack_size;
-    StgPtr stack_end = stack + stack_size;
-
-    if (tso->what_next == ThreadRelocated) {
-      checkTSO(tso->link);
-      return;
-    }
-
-    if (tso->what_next == ThreadKilled) {
-      /* The garbage collector doesn't bother following any pointers
-       * from dead threads, so don't check sanity here.  
-       */
-      return;
-    }
-
-    ASSERT(stack <= sp && sp < stack_end);
-
-#if defined(PAR)
-    ASSERT(tso->par.magic==TSO_MAGIC);
-
-    switch (tso->why_blocked) {
-    case BlockedOnGA: 
-      checkClosureShallow(tso->block_info.closure);
-      ASSERT(/* Can't be a FETCH_ME because *this* closure is on its BQ */
-	     get_itbl(tso->block_info.closure)->type==FETCH_ME_BQ);
-      break;
-    case BlockedOnGA_NoSend: 
-      checkClosureShallow(tso->block_info.closure);
-      ASSERT(get_itbl(tso->block_info.closure)->type==FETCH_ME_BQ);
-      break;
-    case BlockedOnBlackHole: 
-      checkClosureShallow(tso->block_info.closure);
-      ASSERT(get_itbl(tso->block_info.closure)->type==BLACKHOLE ||
-             get_itbl(tso->block_info.closure)->type==RBH);
-      break;
-    case BlockedOnRead:
-    case BlockedOnWrite:
-    case BlockedOnDelay:
-#if defined(mingw32_HOST_OS)
-    case BlockedOnDoProc:
-#endif
-      /* isOnBQ(blocked_queue) */
-      break;
-    case BlockedOnException:
-      /* isOnSomeBQ(tso) */
-      ASSERT(get_itbl(tso->block_info.tso)->type==TSO);
-      break;
-    case BlockedOnMVar:
-      ASSERT(get_itbl(tso->block_info.closure)->type==MVAR);
-      break;
-    case BlockedOnSTM:
-      ASSERT(tso->block_info.closure == END_TSO_QUEUE);
-      break;
-    default:
-      /* 
-	 Could check other values of why_blocked but I am more 
-	 lazy than paranoid (bad combination) -- HWL 
-      */
-    }
-
-    /* if the link field is non-nil it most point to one of these
-       three closure types */
-    ASSERT(tso->link == END_TSO_QUEUE ||
-	   get_itbl(tso->link)->type == TSO ||
-	   get_itbl(tso->link)->type == BLOCKED_FETCH ||
-	   get_itbl(tso->link)->type == CONSTR);
-#endif
-
-    checkStackChunk(sp, stack_end);
-}
-
-#if defined(GRAN)
-void  
-checkTSOsSanity(void) {
-  nat i, tsos;
-  StgTSO *tso;
-  
-  debugBelch("Checking sanity of all runnable TSOs:");
-  
-  for (i=0, tsos=0; i<RtsFlags.GranFlags.proc; i++) {
-    for (tso=run_queue_hds[i]; tso!=END_TSO_QUEUE; tso=tso->link) {
-      debugBelch("TSO %p on PE %d ...", tso, i);
-      checkTSO(tso); 
-      debugBelch("OK, ");
-      tsos++;
-    }
-  }
-  
-  debugBelch(" checked %d TSOs on %d PEs; ok\n", tsos, RtsFlags.GranFlags.proc);
-}
-
-
-// still GRAN only
-
-rtsBool
-checkThreadQSanity (PEs proc, rtsBool check_TSO_too) 
-{
-  StgTSO *tso, *prev;
-
-  /* the NIL value for TSOs is END_TSO_QUEUE; thus, finding NULL is an error */
-  ASSERT(run_queue_hds[proc]!=NULL);
-  ASSERT(run_queue_tls[proc]!=NULL);
-  /* if either head or tail is NIL then the other one must be NIL, too */
-  ASSERT(run_queue_hds[proc]!=END_TSO_QUEUE || run_queue_tls[proc]==END_TSO_QUEUE);
-  ASSERT(run_queue_tls[proc]!=END_TSO_QUEUE || run_queue_hds[proc]==END_TSO_QUEUE);
-  for (tso=run_queue_hds[proc], prev=END_TSO_QUEUE; 
-       tso!=END_TSO_QUEUE;
-       prev=tso, tso=tso->link) {
-    ASSERT((prev!=END_TSO_QUEUE || tso==run_queue_hds[proc]) &&
-	   (prev==END_TSO_QUEUE || prev->link==tso));
-    if (check_TSO_too)
-      checkTSO(tso);
-  }
-  ASSERT(prev==run_queue_tls[proc]);
-}
-
-rtsBool
-checkThreadQsSanity (rtsBool check_TSO_too)
-{
-  PEs p;
-  
-  for (p=0; p<RtsFlags.GranFlags.proc; p++)
-    checkThreadQSanity(p, check_TSO_too);
-}
-#endif /* GRAN */
-
-/* 
-   Check that all TSOs have been evacuated.
-   Optionally also check the sanity of the TSOs.
-*/
-void
-checkGlobalTSOList (rtsBool checkTSOs)
-{
-  extern  StgTSO *all_threads;
-  StgTSO *tso;
-  for (tso=all_threads; tso != END_TSO_QUEUE; tso = tso->global_link) {
-      ASSERT(LOOKS_LIKE_CLOSURE_PTR(tso));
-      ASSERT(get_itbl(tso)->type == TSO);
-      if (checkTSOs)
-	  checkTSO(tso);
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   Check mutable list sanity.
-   -------------------------------------------------------------------------- */
-
-void
-checkMutableList( bdescr *mut_bd, nat gen )
-{
-    bdescr *bd;
-    StgPtr q;
-    StgClosure *p;
-
-    for (bd = mut_bd; bd != NULL; bd = bd->link) {
-	for (q = bd->start; q < bd->free; q++) {
-	    p = (StgClosure *)*q;
-	    ASSERT(!HEAP_ALLOCED(p) || Bdescr((P_)p)->gen_no == gen);
-	}
-    }
-}
-
-/*
-  Check the static objects list.
-*/
-void
-checkStaticObjects ( StgClosure* static_objects )
-{
-  StgClosure *p = static_objects;
-  StgInfoTable *info;
-
-  while (p != END_OF_STATIC_LIST) {
-    checkClosure(p);
-    info = get_itbl(p);
-    switch (info->type) {
-    case IND_STATIC:
-      { 
-	StgClosure *indirectee = ((StgIndStatic *)p)->indirectee;
-
-	ASSERT(LOOKS_LIKE_CLOSURE_PTR(indirectee));
-	ASSERT(LOOKS_LIKE_INFO_PTR(indirectee->header.info));
-	p = *IND_STATIC_LINK((StgClosure *)p);
-	break;
-      }
-
-    case THUNK_STATIC:
-      p = *THUNK_STATIC_LINK((StgClosure *)p);
-      break;
-
-    case FUN_STATIC:
-      p = *FUN_STATIC_LINK((StgClosure *)p);
-      break;
-
-    case CONSTR_STATIC:
-      p = *STATIC_LINK(info,(StgClosure *)p);
-      break;
-
-    default:
-      barf("checkStaticObjetcs: strange closure %p (%s)", 
-	   p, info_type(p));
-    }
-  }
-}
-
-/* 
-   Check the sanity of a blocking queue starting at bqe with closure being
-   the closure holding the blocking queue.
-   Note that in GUM we can have several different closure types in a 
-   blocking queue 
-*/
-#if defined(PAR)
-void
-checkBQ (StgBlockingQueueElement *bqe, StgClosure *closure) 
-{
-  rtsBool end = rtsFalse;
-  StgInfoTable *info = get_itbl(closure);
-
-  ASSERT(info->type == MVAR || info->type == FETCH_ME_BQ || info->type == RBH);
-
-  do {
-    switch (get_itbl(bqe)->type) {
-    case BLOCKED_FETCH:
-    case TSO:
-      checkClosure((StgClosure *)bqe);
-      bqe = bqe->link;
-      end = (bqe==END_BQ_QUEUE);
-      break;
-    
-    case CONSTR:
-      checkClosure((StgClosure *)bqe);
-      end = rtsTrue;
-      break;
-
-    default:
-      barf("checkBQ: strange closure %d in blocking queue for closure %p (%s)\n", 
-	   get_itbl(bqe)->type, closure, info_type(closure));
-    }
-  } while (!end);
-}
-#elif defined(GRAN)
-void
-checkBQ (StgTSO *bqe, StgClosure *closure) 
-{  
-  rtsBool end = rtsFalse;
-  StgInfoTable *info = get_itbl(closure);
-
-  ASSERT(info->type == MVAR);
-
-  do {
-    switch (get_itbl(bqe)->type) {
-    case BLOCKED_FETCH:
-    case TSO:
-      checkClosure((StgClosure *)bqe);
-      bqe = bqe->link;
-      end = (bqe==END_BQ_QUEUE);
-      break;
-    
-    default:
-      barf("checkBQ: strange closure %d in blocking queue for closure %p (%s)\n", 
-	   get_itbl(bqe)->type, closure, info_type(closure));
-    }
-  } while (!end);
-}
-#endif
-    
-
-
-/*
-  This routine checks the sanity of the LAGA and GALA tables. They are 
-  implemented as lists through one hash table, LAtoGALAtable, because entries 
-  in both tables have the same structure:
-   - the LAGA table maps local addresses to global addresses; it starts
-     with liveIndirections
-   - the GALA table maps global addresses to local addresses; it starts 
-     with liveRemoteGAs
-*/
-
-#if defined(PAR)
-#include "Hash.h"
-
-/* hidden in parallel/Global.c; only accessed for testing here */
-extern GALA *liveIndirections;
-extern GALA *liveRemoteGAs;
-extern HashTable *LAtoGALAtable;
-
-void
-checkLAGAtable(rtsBool check_closures)
-{
-  GALA *gala, *gala0;
-  nat n=0, m=0; // debugging
-
-  for (gala = liveIndirections; gala != NULL; gala = gala->next) {
-    n++;
-    gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la);
-    ASSERT(!gala->preferred || gala == gala0);
-    ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)gala->la)->header.info));
-    ASSERT(gala->next!=gala); // detect direct loops
-    if ( check_closures ) {
-      checkClosure((StgClosure *)gala->la);
-    }
-  }
-
-  for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
-    m++;
-    gala0 = lookupHashTable(LAtoGALAtable, (StgWord) gala->la);
-    ASSERT(!gala->preferred || gala == gala0);
-    ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)gala->la)->header.info));
-    ASSERT(gala->next!=gala); // detect direct loops
-    /*
-    if ( check_closures ) {
-      checkClosure((StgClosure *)gala->la);
-    }
-    */
-  }
-}
-#endif
-
-#endif /* DEBUG */
diff --git a/ghc/rts/Sanity.h b/ghc/rts/Sanity.h
deleted file mode 100644
index 8cf3f9e52e..0000000000
--- a/ghc/rts/Sanity.h
+++ /dev/null
@@ -1,56 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-1999
- *
- * Prototypes for functions in Sanity.c
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef SANITY_H
-
-#ifdef DEBUG
-
-# if defined(PAR)
-# define PVM_PE_MASK    0xfffc0000
-# define MAX_PVM_PES    MAX_PES
-# define MAX_PVM_TIDS   MAX_PES
-# define MAX_SLOTS      100000
-# endif
-
-/* debugging routines */
-extern void checkHeap      ( bdescr *bd );
-extern void checkHeapChunk ( StgPtr start, StgPtr end );
-extern void checkChain     ( bdescr *bd );
-extern void checkTSO       ( StgTSO* tso );
-extern void checkGlobalTSOList ( rtsBool checkTSOs );
-extern void checkStaticObjects ( StgClosure* static_objects );
-extern void checkStackChunk    ( StgPtr sp, StgPtr stack_end );
-extern StgOffset checkStackFrame ( StgPtr sp );
-extern StgOffset checkClosure  ( StgClosure* p );
-
-extern void checkMutableList   ( bdescr *bd, nat gen );
-
-#if defined(GRAN)
-extern void checkTSOsSanity(void);
-extern rtsBool checkThreadQSanity (PEs proc, rtsBool check_TSO_too);
-extern rtsBool checkThreadQsSanity (rtsBool check_TSO_too);
-#endif
-
-#if defined(PAR)
-extern void checkBQ (StgBlockingQueueElement *bqe, StgClosure *closure);
-#else
-extern void checkBQ (StgTSO *bqe, StgClosure *closure);
-#endif
-
-#if defined(PAR)
-extern void checkLAGAtable(rtsBool check_closures);
-extern void checkHeapChunk(StgPtr start, StgPtr end);
-#endif
-
-/* test whether an object is already on update list */
-extern rtsBool isBlackhole( StgTSO* tso, StgClosure* p );
-
-#endif /* DEBUG */
- 
-#endif /* SANITY_H */
-
diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
deleted file mode 100644
index 52fd4d5df6..0000000000
--- a/ghc/rts/Schedule.c
+++ /dev/null
@@ -1,4589 +0,0 @@
-/* ---------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * The scheduler and thread-related functionality
- *
- * --------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "SchedAPI.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "BlockAlloc.h"
-#include "OSThreads.h"
-#include "Storage.h"
-#include "StgRun.h"
-#include "Hooks.h"
-#include "Schedule.h"
-#include "StgMiscClosures.h"
-#include "Interpreter.h"
-#include "Exception.h"
-#include "Printer.h"
-#include "RtsSignals.h"
-#include "Sanity.h"
-#include "Stats.h"
-#include "STM.h"
-#include "Timer.h"
-#include "Prelude.h"
-#include "ThreadLabels.h"
-#include "LdvProfile.h"
-#include "Updates.h"
-#ifdef PROFILING
-#include "Proftimer.h"
-#include "ProfHeap.h"
-#endif
-#if defined(GRAN) || defined(PARALLEL_HASKELL)
-# include "GranSimRts.h"
-# include "GranSim.h"
-# include "ParallelRts.h"
-# include "Parallel.h"
-# include "ParallelDebug.h"
-# include "FetchMe.h"
-# include "HLC.h"
-#endif
-#include "Sparks.h"
-#include "Capability.h"
-#include "Task.h"
-#include "AwaitEvent.h"
-#if defined(mingw32_HOST_OS)
-#include "win32/IOManager.h"
-#endif
-
-#ifdef HAVE_SYS_TYPES_H
-#include <sys/types.h>
-#endif
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-#include <string.h>
-#include <stdlib.h>
-#include <stdarg.h>
-
-#ifdef HAVE_ERRNO_H
-#include <errno.h>
-#endif
-
-// Turn off inlining when debugging - it obfuscates things
-#ifdef DEBUG
-# undef  STATIC_INLINE
-# define STATIC_INLINE static
-#endif
-
-/* -----------------------------------------------------------------------------
- * Global variables
- * -------------------------------------------------------------------------- */
-
-#if defined(GRAN)
-
-StgTSO* ActiveTSO = NULL; /* for assigning system costs; GranSim-Light only */
-/* rtsTime TimeOfNextEvent, EndOfTimeSlice;            now in GranSim.c */
-
-/* 
-   In GranSim we have a runnable and a blocked queue for each processor.
-   In order to minimise code changes new arrays run_queue_hds/tls
-   are created. run_queue_hd is then a short cut (macro) for
-   run_queue_hds[CurrentProc] (see GranSim.h).
-   -- HWL
-*/
-StgTSO *run_queue_hds[MAX_PROC], *run_queue_tls[MAX_PROC];
-StgTSO *blocked_queue_hds[MAX_PROC], *blocked_queue_tls[MAX_PROC];
-StgTSO *ccalling_threadss[MAX_PROC];
-/* We use the same global list of threads (all_threads) in GranSim as in
-   the std RTS (i.e. we are cheating). However, we don't use this list in
-   the GranSim specific code at the moment (so we are only potentially
-   cheating).  */
-
-#else /* !GRAN */
-
-#if !defined(THREADED_RTS)
-// Blocked/sleeping thrads
-StgTSO *blocked_queue_hd = NULL;
-StgTSO *blocked_queue_tl = NULL;
-StgTSO *sleeping_queue = NULL;    // perhaps replace with a hash table?
-#endif
-
-/* Threads blocked on blackholes.
- * LOCK: sched_mutex+capability, or all capabilities
- */
-StgTSO *blackhole_queue = NULL;
-#endif
-
-/* The blackhole_queue should be checked for threads to wake up.  See
- * Schedule.h for more thorough comment.
- * LOCK: none (doesn't matter if we miss an update)
- */
-rtsBool blackholes_need_checking = rtsFalse;
-
-/* Linked list of all threads.
- * Used for detecting garbage collected threads.
- * LOCK: sched_mutex+capability, or all capabilities
- */
-StgTSO *all_threads = NULL;
-
-/* flag set by signal handler to precipitate a context switch
- * LOCK: none (just an advisory flag)
- */
-int context_switch = 0;
-
-/* flag that tracks whether we have done any execution in this time slice.
- * LOCK: currently none, perhaps we should lock (but needs to be
- * updated in the fast path of the scheduler).
- */
-nat recent_activity = ACTIVITY_YES;
-
-/* if this flag is set as well, give up execution
- * LOCK: none (changes once, from false->true)
- */
-rtsBool sched_state = SCHED_RUNNING;
-
-/* Next thread ID to allocate.
- * LOCK: sched_mutex
- */
-static StgThreadID next_thread_id = 1;
-
-/* The smallest stack size that makes any sense is:
- *    RESERVED_STACK_WORDS    (so we can get back from the stack overflow)
- *  + sizeofW(StgStopFrame)   (the stg_stop_thread_info frame)
- *  + 1                       (the closure to enter)
- *  + 1			      (stg_ap_v_ret)
- *  + 1			      (spare slot req'd by stg_ap_v_ret)
- *
- * A thread with this stack will bomb immediately with a stack
- * overflow, which will increase its stack size.  
- */
-#define MIN_STACK_WORDS (RESERVED_STACK_WORDS + sizeofW(StgStopFrame) + 3)
-
-#if defined(GRAN)
-StgTSO *CurrentTSO;
-#endif
-
-/*  This is used in `TSO.h' and gcc 2.96 insists that this variable actually 
- *  exists - earlier gccs apparently didn't.
- *  -= chak
- */
-StgTSO dummy_tso;
-
-/*
- * Set to TRUE when entering a shutdown state (via shutdownHaskellAndExit()) --
- * in an MT setting, needed to signal that a worker thread shouldn't hang around
- * in the scheduler when it is out of work.
- */
-rtsBool shutting_down_scheduler = rtsFalse;
-
-/*
- * This mutex protects most of the global scheduler data in
- * the THREADED_RTS runtime.
- */
-#if defined(THREADED_RTS)
-Mutex sched_mutex;
-#endif
-
-#if defined(PARALLEL_HASKELL)
-StgTSO *LastTSO;
-rtsTime TimeOfLastYield;
-rtsBool emitSchedule = rtsTrue;
-#endif
-
-/* -----------------------------------------------------------------------------
- * static function prototypes
- * -------------------------------------------------------------------------- */
-
-static Capability *schedule (Capability *initialCapability, Task *task);
-
-//
-// These function all encapsulate parts of the scheduler loop, and are
-// abstracted only to make the structure and control flow of the
-// scheduler clearer.
-//
-static void schedulePreLoop (void);
-#if defined(THREADED_RTS)
-static void schedulePushWork(Capability *cap, Task *task);
-#endif
-static void scheduleStartSignalHandlers (Capability *cap);
-static void scheduleCheckBlockedThreads (Capability *cap);
-static void scheduleCheckWakeupThreads(Capability *cap USED_IF_NOT_THREADS);
-static void scheduleCheckBlackHoles (Capability *cap);
-static void scheduleDetectDeadlock (Capability *cap, Task *task);
-#if defined(GRAN)
-static StgTSO *scheduleProcessEvent(rtsEvent *event);
-#endif
-#if defined(PARALLEL_HASKELL)
-static StgTSO *scheduleSendPendingMessages(void);
-static void scheduleActivateSpark(void);
-static rtsBool scheduleGetRemoteWork(rtsBool *receivedFinish);
-#endif
-#if defined(PAR) || defined(GRAN)
-static void scheduleGranParReport(void);
-#endif
-static void schedulePostRunThread(void);
-static rtsBool scheduleHandleHeapOverflow( Capability *cap, StgTSO *t );
-static void scheduleHandleStackOverflow( Capability *cap, Task *task, 
-					 StgTSO *t);
-static rtsBool scheduleHandleYield( Capability *cap, StgTSO *t, 
-				    nat prev_what_next );
-static void scheduleHandleThreadBlocked( StgTSO *t );
-static rtsBool scheduleHandleThreadFinished( Capability *cap, Task *task,
-					     StgTSO *t );
-static rtsBool scheduleDoHeapProfile(rtsBool ready_to_gc);
-static Capability *scheduleDoGC(Capability *cap, Task *task,
-				rtsBool force_major, 
-				void (*get_roots)(evac_fn));
-
-static void unblockThread(Capability *cap, StgTSO *tso);
-static rtsBool checkBlackHoles(Capability *cap);
-static void AllRoots(evac_fn evac);
-
-static StgTSO *threadStackOverflow(Capability *cap, StgTSO *tso);
-
-static void raiseAsync_(Capability *cap, StgTSO *tso, StgClosure *exception, 
-			rtsBool stop_at_atomically, StgPtr stop_here);
-
-static void deleteThread (Capability *cap, StgTSO *tso);
-static void deleteAllThreads (Capability *cap);
-
-#ifdef DEBUG
-static void printThreadBlockage(StgTSO *tso);
-static void printThreadStatus(StgTSO *tso);
-void printThreadQueue(StgTSO *tso);
-#endif
-
-#if defined(PARALLEL_HASKELL)
-StgTSO * createSparkThread(rtsSpark spark);
-StgTSO * activateSpark (rtsSpark spark);  
-#endif
-
-#ifdef DEBUG
-static char *whatNext_strs[] = {
-  "(unknown)",
-  "ThreadRunGHC",
-  "ThreadInterpret",
-  "ThreadKilled",
-  "ThreadRelocated",
-  "ThreadComplete"
-};
-#endif
-
-/* -----------------------------------------------------------------------------
- * Putting a thread on the run queue: different scheduling policies
- * -------------------------------------------------------------------------- */
-
-STATIC_INLINE void
-addToRunQueue( Capability *cap, StgTSO *t )
-{
-#if defined(PARALLEL_HASKELL)
-    if (RtsFlags.ParFlags.doFairScheduling) { 
-	// this does round-robin scheduling; good for concurrency
-	appendToRunQueue(cap,t);
-    } else {
-	// this does unfair scheduling; good for parallelism
-	pushOnRunQueue(cap,t);
-    }
-#else
-    // this does round-robin scheduling; good for concurrency
-    appendToRunQueue(cap,t);
-#endif
-}
-
-/* ---------------------------------------------------------------------------
-   Main scheduling loop.
-
-   We use round-robin scheduling, each thread returning to the
-   scheduler loop when one of these conditions is detected:
-
-      * out of heap space
-      * timer expires (thread yields)
-      * thread blocks
-      * thread ends
-      * stack overflow
-
-   GRAN version:
-     In a GranSim setup this loop iterates over the global event queue.
-     This revolves around the global event queue, which determines what 
-     to do next. Therefore, it's more complicated than either the 
-     concurrent or the parallel (GUM) setup.
-
-   GUM version:
-     GUM iterates over incoming messages.
-     It starts with nothing to do (thus CurrentTSO == END_TSO_QUEUE),
-     and sends out a fish whenever it has nothing to do; in-between
-     doing the actual reductions (shared code below) it processes the
-     incoming messages and deals with delayed operations 
-     (see PendingFetches).
-     This is not the ugliest code you could imagine, but it's bloody close.
-
-   ------------------------------------------------------------------------ */
-
-static Capability *
-schedule (Capability *initialCapability, Task *task)
-{
-  StgTSO *t;
-  Capability *cap;
-  StgThreadReturnCode ret;
-#if defined(GRAN)
-  rtsEvent *event;
-#elif defined(PARALLEL_HASKELL)
-  StgTSO *tso;
-  GlobalTaskId pe;
-  rtsBool receivedFinish = rtsFalse;
-# if defined(DEBUG)
-  nat tp_size, sp_size; // stats only
-# endif
-#endif
-  nat prev_what_next;
-  rtsBool ready_to_gc;
-#if defined(THREADED_RTS)
-  rtsBool first = rtsTrue;
-#endif
-  
-  cap = initialCapability;
-
-  // Pre-condition: this task owns initialCapability.
-  // The sched_mutex is *NOT* held
-  // NB. on return, we still hold a capability.
-
-  IF_DEBUG(scheduler,
-	   sched_belch("### NEW SCHEDULER LOOP (task: %p, cap: %p)",
-		       task, initialCapability);
-      );
-
-  schedulePreLoop();
-
-  // -----------------------------------------------------------
-  // Scheduler loop starts here:
-
-#if defined(PARALLEL_HASKELL)
-#define TERMINATION_CONDITION        (!receivedFinish)
-#elif defined(GRAN)
-#define TERMINATION_CONDITION        ((event = get_next_event()) != (rtsEvent*)NULL) 
-#else
-#define TERMINATION_CONDITION        rtsTrue
-#endif
-
-  while (TERMINATION_CONDITION) {
-
-#if defined(GRAN)
-      /* Choose the processor with the next event */
-      CurrentProc = event->proc;
-      CurrentTSO = event->tso;
-#endif
-
-#if defined(THREADED_RTS)
-      if (first) {
-	  // don't yield the first time, we want a chance to run this
-	  // thread for a bit, even if there are others banging at the
-	  // door.
-	  first = rtsFalse;
-	  ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
-      } else {
-	  // Yield the capability to higher-priority tasks if necessary.
-	  yieldCapability(&cap, task);
-      }
-#endif
-      
-#if defined(THREADED_RTS)
-      schedulePushWork(cap,task);
-#endif
-
-    // Check whether we have re-entered the RTS from Haskell without
-    // going via suspendThread()/resumeThread (i.e. a 'safe' foreign
-    // call).
-    if (cap->in_haskell) {
-    	  errorBelch("schedule: re-entered unsafely.\n"
-    		     "   Perhaps a 'foreign import unsafe' should be 'safe'?");
-    	  stg_exit(EXIT_FAILURE);
-    }
-
-    // The interruption / shutdown sequence.
-    // 
-    // In order to cleanly shut down the runtime, we want to:
-    //   * make sure that all main threads return to their callers
-    //     with the state 'Interrupted'.
-    //   * clean up all OS threads assocated with the runtime
-    //   * free all memory etc.
-    //
-    // So the sequence for ^C goes like this:
-    //
-    //   * ^C handler sets sched_state := SCHED_INTERRUPTING and
-    //     arranges for some Capability to wake up
-    //
-    //   * all threads in the system are halted, and the zombies are
-    //     placed on the run queue for cleaning up.  We acquire all
-    //     the capabilities in order to delete the threads, this is
-    //     done by scheduleDoGC() for convenience (because GC already
-    //     needs to acquire all the capabilities).  We can't kill
-    //     threads involved in foreign calls.
-    // 
-    //   * sched_state := SCHED_INTERRUPTED
-    //
-    //   * somebody calls shutdownHaskell(), which calls exitScheduler()
-    //
-    //   * sched_state := SCHED_SHUTTING_DOWN
-    //
-    //   * all workers exit when the run queue on their capability
-    //     drains.  All main threads will also exit when their TSO
-    //     reaches the head of the run queue and they can return.
-    //
-    //   * eventually all Capabilities will shut down, and the RTS can
-    //     exit.
-    //
-    //   * We might be left with threads blocked in foreign calls, 
-    //     we should really attempt to kill these somehow (TODO);
-    
-    switch (sched_state) {
-    case SCHED_RUNNING:
-	break;
-    case SCHED_INTERRUPTING:
-	IF_DEBUG(scheduler, sched_belch("SCHED_INTERRUPTING"));
-#if defined(THREADED_RTS)
-	discardSparksCap(cap);
-#endif
-	/* scheduleDoGC() deletes all the threads */
-	cap = scheduleDoGC(cap,task,rtsFalse,GetRoots);
-	break;
-    case SCHED_INTERRUPTED:
-	IF_DEBUG(scheduler, sched_belch("SCHED_INTERRUPTED"));
-	break;
-    case SCHED_SHUTTING_DOWN:
-	IF_DEBUG(scheduler, sched_belch("SCHED_SHUTTING_DOWN"));
-	// If we are a worker, just exit.  If we're a bound thread
-	// then we will exit below when we've removed our TSO from
-	// the run queue.
-	if (task->tso == NULL && emptyRunQueue(cap)) {
-	    return cap;
-	}
-	break;
-    default:
-	barf("sched_state: %d", sched_state);
-    }
-
-#if defined(THREADED_RTS)
-    // If the run queue is empty, take a spark and turn it into a thread.
-    {
-	if (emptyRunQueue(cap)) {
-	    StgClosure *spark;
-	    spark = findSpark(cap);
-	    if (spark != NULL) {
-		IF_DEBUG(scheduler,
-			 sched_belch("turning spark of closure %p into a thread",
-				     (StgClosure *)spark));
-		createSparkThread(cap,spark);	  
-	    }
-	}
-    }
-#endif // THREADED_RTS
-
-    scheduleStartSignalHandlers(cap);
-
-    // Only check the black holes here if we've nothing else to do.
-    // During normal execution, the black hole list only gets checked
-    // at GC time, to avoid repeatedly traversing this possibly long
-    // list each time around the scheduler.
-    if (emptyRunQueue(cap)) { scheduleCheckBlackHoles(cap); }
-
-    scheduleCheckWakeupThreads(cap);
-
-    scheduleCheckBlockedThreads(cap);
-
-    scheduleDetectDeadlock(cap,task);
-#if defined(THREADED_RTS)
-    cap = task->cap;    // reload cap, it might have changed
-#endif
-
-    // Normally, the only way we can get here with no threads to
-    // run is if a keyboard interrupt received during 
-    // scheduleCheckBlockedThreads() or scheduleDetectDeadlock().
-    // Additionally, it is not fatal for the
-    // threaded RTS to reach here with no threads to run.
-    //
-    // win32: might be here due to awaitEvent() being abandoned
-    // as a result of a console event having been delivered.
-    if ( emptyRunQueue(cap) ) {
-#if !defined(THREADED_RTS) && !defined(mingw32_HOST_OS)
-	ASSERT(sched_state >= SCHED_INTERRUPTING);
-#endif
-	continue; // nothing to do
-    }
-
-#if defined(PARALLEL_HASKELL)
-    scheduleSendPendingMessages();
-    if (emptyRunQueue(cap) && scheduleActivateSpark()) 
-	continue;
-
-#if defined(SPARKS)
-    ASSERT(next_fish_to_send_at==0);  // i.e. no delayed fishes left!
-#endif
-
-    /* If we still have no work we need to send a FISH to get a spark
-       from another PE */
-    if (emptyRunQueue(cap)) {
-	if (!scheduleGetRemoteWork(&receivedFinish)) continue;
-	ASSERT(rtsFalse); // should not happen at the moment
-    }
-    // from here: non-empty run queue.
-    //  TODO: merge above case with this, only one call processMessages() !
-    if (PacketsWaiting()) {  /* process incoming messages, if
-				any pending...  only in else
-				because getRemoteWork waits for
-				messages as well */
-	receivedFinish = processMessages();
-    }
-#endif
-
-#if defined(GRAN)
-    scheduleProcessEvent(event);
-#endif
-
-    // 
-    // Get a thread to run
-    //
-    t = popRunQueue(cap);
-
-#if defined(GRAN) || defined(PAR)
-    scheduleGranParReport(); // some kind of debuging output
-#else
-    // Sanity check the thread we're about to run.  This can be
-    // expensive if there is lots of thread switching going on...
-    IF_DEBUG(sanity,checkTSO(t));
-#endif
-
-#if defined(THREADED_RTS)
-    // Check whether we can run this thread in the current task.
-    // If not, we have to pass our capability to the right task.
-    {
-	Task *bound = t->bound;
-      
-	if (bound) {
-	    if (bound == task) {
-		IF_DEBUG(scheduler,
-			 sched_belch("### Running thread %d in bound thread",
-				     t->id));
-		// yes, the Haskell thread is bound to the current native thread
-	    } else {
-		IF_DEBUG(scheduler,
-			 sched_belch("### thread %d bound to another OS thread",
-				     t->id));
-		// no, bound to a different Haskell thread: pass to that thread
-		pushOnRunQueue(cap,t);
-		continue;
-	    }
-	} else {
-	    // The thread we want to run is unbound.
-	    if (task->tso) { 
-		IF_DEBUG(scheduler,
-			 sched_belch("### this OS thread cannot run thread %d", t->id));
-		// no, the current native thread is bound to a different
-		// Haskell thread, so pass it to any worker thread
-		pushOnRunQueue(cap,t);
-		continue; 
-	    }
-	}
-    }
-#endif
-
-    cap->r.rCurrentTSO = t;
-    
-    /* context switches are initiated by the timer signal, unless
-     * the user specified "context switch as often as possible", with
-     * +RTS -C0
-     */
-    if (RtsFlags.ConcFlags.ctxtSwitchTicks == 0
-	&& !emptyThreadQueues(cap)) {
-	context_switch = 1;
-    }
-	 
-run_thread:
-
-    IF_DEBUG(scheduler, sched_belch("-->> running thread %ld %s ...", 
-			      (long)t->id, whatNext_strs[t->what_next]));
-
-#if defined(PROFILING)
-    startHeapProfTimer();
-#endif
-
-    // ----------------------------------------------------------------------
-    // Run the current thread 
-
-    ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
-    ASSERT(t->cap == cap);
-
-    prev_what_next = t->what_next;
-
-    errno = t->saved_errno;
-    cap->in_haskell = rtsTrue;
-
-    dirtyTSO(t);
-
-    recent_activity = ACTIVITY_YES;
-
-    switch (prev_what_next) {
-	
-    case ThreadKilled:
-    case ThreadComplete:
-	/* Thread already finished, return to scheduler. */
-	ret = ThreadFinished;
-	break;
-	
-    case ThreadRunGHC:
-    {
-	StgRegTable *r;
-	r = StgRun((StgFunPtr) stg_returnToStackTop, &cap->r);
-	cap = regTableToCapability(r);
-	ret = r->rRet;
-	break;
-    }
-    
-    case ThreadInterpret:
-	cap = interpretBCO(cap);
-	ret = cap->r.rRet;
-	break;
-	
-    default:
-	barf("schedule: invalid what_next field");
-    }
-
-    cap->in_haskell = rtsFalse;
-
-    // The TSO might have moved, eg. if it re-entered the RTS and a GC
-    // happened.  So find the new location:
-    t = cap->r.rCurrentTSO;
-
-    // We have run some Haskell code: there might be blackhole-blocked
-    // threads to wake up now.
-    // Lock-free test here should be ok, we're just setting a flag.
-    if ( blackhole_queue != END_TSO_QUEUE ) {
-	blackholes_need_checking = rtsTrue;
-    }
-    
-    // And save the current errno in this thread.
-    // XXX: possibly bogus for SMP because this thread might already
-    // be running again, see code below.
-    t->saved_errno = errno;
-
-#if defined(THREADED_RTS)
-    // If ret is ThreadBlocked, and this Task is bound to the TSO that
-    // blocked, we are in limbo - the TSO is now owned by whatever it
-    // is blocked on, and may in fact already have been woken up,
-    // perhaps even on a different Capability.  It may be the case
-    // that task->cap != cap.  We better yield this Capability
-    // immediately and return to normaility.
-    if (ret == ThreadBlocked) {
-	IF_DEBUG(scheduler,
-		 sched_belch("--<< thread %d (%s) stopped: blocked\n",
-			     t->id, whatNext_strs[t->what_next]));
-	continue;
-    }
-#endif
-
-    ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
-    ASSERT(t->cap == cap);
-
-    // ----------------------------------------------------------------------
-    
-    // Costs for the scheduler are assigned to CCS_SYSTEM
-#if defined(PROFILING)
-    stopHeapProfTimer();
-    CCCS = CCS_SYSTEM;
-#endif
-    
-#if defined(THREADED_RTS)
-    IF_DEBUG(scheduler,debugBelch("sched (task %p): ", (void *)(unsigned long)(unsigned int)osThreadId()););
-#elif !defined(GRAN) && !defined(PARALLEL_HASKELL)
-    IF_DEBUG(scheduler,debugBelch("sched: "););
-#endif
-    
-    schedulePostRunThread();
-
-    ready_to_gc = rtsFalse;
-
-    switch (ret) {
-    case HeapOverflow:
-	ready_to_gc = scheduleHandleHeapOverflow(cap,t);
-	break;
-
-    case StackOverflow:
-	scheduleHandleStackOverflow(cap,task,t);
-	break;
-
-    case ThreadYielding:
-	if (scheduleHandleYield(cap, t, prev_what_next)) {
-            // shortcut for switching between compiler/interpreter:
-	    goto run_thread; 
-	}
-	break;
-
-    case ThreadBlocked:
-	scheduleHandleThreadBlocked(t);
-	break;
-
-    case ThreadFinished:
-	if (scheduleHandleThreadFinished(cap, task, t)) return cap;
-	ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
-	break;
-
-    default:
-      barf("schedule: invalid thread return code %d", (int)ret);
-    }
-
-    if (scheduleDoHeapProfile(ready_to_gc)) { ready_to_gc = rtsFalse; }
-    if (ready_to_gc) {
-      cap = scheduleDoGC(cap,task,rtsFalse,GetRoots);
-    }
-  } /* end of while() */
-
-  IF_PAR_DEBUG(verbose,
-	       debugBelch("== Leaving schedule() after having received Finish\n"));
-}
-
-/* ----------------------------------------------------------------------------
- * Setting up the scheduler loop
- * ------------------------------------------------------------------------- */
-
-static void
-schedulePreLoop(void)
-{
-#if defined(GRAN) 
-    /* set up first event to get things going */
-    /* ToDo: assign costs for system setup and init MainTSO ! */
-    new_event(CurrentProc, CurrentProc, CurrentTime[CurrentProc],
-	      ContinueThread, 
-	      CurrentTSO, (StgClosure*)NULL, (rtsSpark*)NULL);
-    
-    IF_DEBUG(gran,
-	     debugBelch("GRAN: Init CurrentTSO (in schedule) = %p\n", 
-			CurrentTSO);
-	     G_TSO(CurrentTSO, 5));
-    
-    if (RtsFlags.GranFlags.Light) {
-	/* Save current time; GranSim Light only */
-	CurrentTSO->gran.clock = CurrentTime[CurrentProc];
-    }      
-#endif
-}
-
-/* -----------------------------------------------------------------------------
- * schedulePushWork()
- *
- * Push work to other Capabilities if we have some.
- * -------------------------------------------------------------------------- */
-
-#if defined(THREADED_RTS)
-static void
-schedulePushWork(Capability *cap USED_IF_THREADS, 
-		 Task *task      USED_IF_THREADS)
-{
-    Capability *free_caps[n_capabilities], *cap0;
-    nat i, n_free_caps;
-
-    // migration can be turned off with +RTS -qg
-    if (!RtsFlags.ParFlags.migrate) return;
-
-    // Check whether we have more threads on our run queue, or sparks
-    // in our pool, that we could hand to another Capability.
-    if ((emptyRunQueue(cap) || cap->run_queue_hd->link == END_TSO_QUEUE)
-	&& sparkPoolSizeCap(cap) < 2) {
-	return;
-    }
-
-    // First grab as many free Capabilities as we can.
-    for (i=0, n_free_caps=0; i < n_capabilities; i++) {
-	cap0 = &capabilities[i];
-	if (cap != cap0 && tryGrabCapability(cap0,task)) {
-	    if (!emptyRunQueue(cap0) || cap->returning_tasks_hd != NULL) {
-		// it already has some work, we just grabbed it at 
-		// the wrong moment.  Or maybe it's deadlocked!
-		releaseCapability(cap0);
-	    } else {
-		free_caps[n_free_caps++] = cap0;
-	    }
-	}
-    }
-
-    // we now have n_free_caps free capabilities stashed in
-    // free_caps[].  Share our run queue equally with them.  This is
-    // probably the simplest thing we could do; improvements we might
-    // want to do include:
-    //
-    //   - giving high priority to moving relatively new threads, on 
-    //     the gournds that they haven't had time to build up a
-    //     working set in the cache on this CPU/Capability.
-    //
-    //   - giving low priority to moving long-lived threads
-
-    if (n_free_caps > 0) {
-	StgTSO *prev, *t, *next;
-	rtsBool pushed_to_all;
-
-	IF_DEBUG(scheduler, sched_belch("excess threads on run queue and %d free capabilities, sharing...", n_free_caps));
-
-	i = 0;
-	pushed_to_all = rtsFalse;
-
-	if (cap->run_queue_hd != END_TSO_QUEUE) {
-	    prev = cap->run_queue_hd;
-	    t = prev->link;
-	    prev->link = END_TSO_QUEUE;
-	    for (; t != END_TSO_QUEUE; t = next) {
-		next = t->link;
-		t->link = END_TSO_QUEUE;
-		if (t->what_next == ThreadRelocated
-		    || t->bound == task // don't move my bound thread
-		    || tsoLocked(t)) {  // don't move a locked thread
-		    prev->link = t;
-		    prev = t;
-		} else if (i == n_free_caps) {
-		    pushed_to_all = rtsTrue;
-		    i = 0;
-		    // keep one for us
-		    prev->link = t;
-		    prev = t;
-		} else {
-		    IF_DEBUG(scheduler, sched_belch("pushing thread %d to capability %d", t->id, free_caps[i]->no));
-		    appendToRunQueue(free_caps[i],t);
-		    if (t->bound) { t->bound->cap = free_caps[i]; }
-		    t->cap = free_caps[i];
-		    i++;
-		}
-	    }
-	    cap->run_queue_tl = prev;
-	}
-
-	// If there are some free capabilities that we didn't push any
-	// threads to, then try to push a spark to each one.
-	if (!pushed_to_all) {
-	    StgClosure *spark;
-	    // i is the next free capability to push to
-	    for (; i < n_free_caps; i++) {
-		if (emptySparkPoolCap(free_caps[i])) {
-		    spark = findSpark(cap);
-		    if (spark != NULL) {
-			IF_DEBUG(scheduler, sched_belch("pushing spark %p to capability %d", spark, free_caps[i]->no));
-			newSpark(&(free_caps[i]->r), spark);
-		    }
-		}
-	    }
-	}
-
-	// release the capabilities
-	for (i = 0; i < n_free_caps; i++) {
-	    task->cap = free_caps[i];
-	    releaseCapability(free_caps[i]);
-	}
-    }
-    task->cap = cap; // reset to point to our Capability.
-}
-#endif
-
-/* ----------------------------------------------------------------------------
- * Start any pending signal handlers
- * ------------------------------------------------------------------------- */
-
-#if defined(RTS_USER_SIGNALS) && (!defined(THREADED_RTS) || defined(mingw32_HOST_OS))
-static void
-scheduleStartSignalHandlers(Capability *cap)
-{
-    if (signals_pending()) { // safe outside the lock
-	startSignalHandlers(cap);
-    }
-}
-#else
-static void
-scheduleStartSignalHandlers(Capability *cap STG_UNUSED)
-{
-}
-#endif
-
-/* ----------------------------------------------------------------------------
- * Check for blocked threads that can be woken up.
- * ------------------------------------------------------------------------- */
-
-static void
-scheduleCheckBlockedThreads(Capability *cap USED_IF_NOT_THREADS)
-{
-#if !defined(THREADED_RTS)
-    //
-    // Check whether any waiting threads need to be woken up.  If the
-    // run queue is empty, and there are no other tasks running, we
-    // can wait indefinitely for something to happen.
-    //
-    if ( !emptyQueue(blocked_queue_hd) || !emptyQueue(sleeping_queue) )
-    {
-	awaitEvent( emptyRunQueue(cap) && !blackholes_need_checking );
-    }
-#endif
-}
-
-
-/* ----------------------------------------------------------------------------
- * Check for threads woken up by other Capabilities
- * ------------------------------------------------------------------------- */
-
-static void
-scheduleCheckWakeupThreads(Capability *cap USED_IF_THREADS)
-{
-#if defined(THREADED_RTS)
-    // Any threads that were woken up by other Capabilities get
-    // appended to our run queue.
-    if (!emptyWakeupQueue(cap)) {
-	ACQUIRE_LOCK(&cap->lock);
-	if (emptyRunQueue(cap)) {
-	    cap->run_queue_hd = cap->wakeup_queue_hd;
-	    cap->run_queue_tl = cap->wakeup_queue_tl;
-	} else {
-	    cap->run_queue_tl->link = cap->wakeup_queue_hd;
-	    cap->run_queue_tl = cap->wakeup_queue_tl;
-	}
-	cap->wakeup_queue_hd = cap->wakeup_queue_tl = END_TSO_QUEUE;
-	RELEASE_LOCK(&cap->lock);
-    }
-#endif
-}
-
-/* ----------------------------------------------------------------------------
- * Check for threads blocked on BLACKHOLEs that can be woken up
- * ------------------------------------------------------------------------- */
-static void
-scheduleCheckBlackHoles (Capability *cap)
-{
-    if ( blackholes_need_checking ) // check without the lock first
-    {
-	ACQUIRE_LOCK(&sched_mutex);
-	if ( blackholes_need_checking ) {
-	    checkBlackHoles(cap);
-	    blackholes_need_checking = rtsFalse;
-	}
-	RELEASE_LOCK(&sched_mutex);
-    }
-}
-
-/* ----------------------------------------------------------------------------
- * Detect deadlock conditions and attempt to resolve them.
- * ------------------------------------------------------------------------- */
-
-static void
-scheduleDetectDeadlock (Capability *cap, Task *task)
-{
-
-#if defined(PARALLEL_HASKELL)
-    // ToDo: add deadlock detection in GUM (similar to THREADED_RTS) -- HWL
-    return;
-#endif
-
-    /* 
-     * Detect deadlock: when we have no threads to run, there are no
-     * threads blocked, waiting for I/O, or sleeping, and all the
-     * other tasks are waiting for work, we must have a deadlock of
-     * some description.
-     */
-    if ( emptyThreadQueues(cap) )
-    {
-#if defined(THREADED_RTS)
-	/* 
-	 * In the threaded RTS, we only check for deadlock if there
-	 * has been no activity in a complete timeslice.  This means
-	 * we won't eagerly start a full GC just because we don't have
-	 * any threads to run currently.
-	 */
-	if (recent_activity != ACTIVITY_INACTIVE) return;
-#endif
-
-	IF_DEBUG(scheduler, sched_belch("deadlocked, forcing major GC..."));
-
-	// Garbage collection can release some new threads due to
-	// either (a) finalizers or (b) threads resurrected because
-	// they are unreachable and will therefore be sent an
-	// exception.  Any threads thus released will be immediately
-	// runnable.
-	cap = scheduleDoGC (cap, task, rtsTrue/*force  major GC*/, GetRoots);
-
-	recent_activity = ACTIVITY_DONE_GC;
-	
-	if ( !emptyRunQueue(cap) ) return;
-
-#if defined(RTS_USER_SIGNALS) && (!defined(THREADED_RTS) || defined(mingw32_HOST_OS))
-	/* If we have user-installed signal handlers, then wait
-	 * for signals to arrive rather then bombing out with a
-	 * deadlock.
-	 */
-	if ( anyUserHandlers() ) {
-	    IF_DEBUG(scheduler, 
-		     sched_belch("still deadlocked, waiting for signals..."));
-
-	    awaitUserSignals();
-
-	    if (signals_pending()) {
-		startSignalHandlers(cap);
-	    }
-
-	    // either we have threads to run, or we were interrupted:
-	    ASSERT(!emptyRunQueue(cap) || sched_state >= SCHED_INTERRUPTING);
-	}
-#endif
-
-#if !defined(THREADED_RTS)
-	/* Probably a real deadlock.  Send the current main thread the
-	 * Deadlock exception.
-	 */
-	if (task->tso) {
-	    switch (task->tso->why_blocked) {
-	    case BlockedOnSTM:
-	    case BlockedOnBlackHole:
-	    case BlockedOnException:
-	    case BlockedOnMVar:
-		raiseAsync(cap, task->tso, (StgClosure *)NonTermination_closure);
-		return;
-	    default:
-		barf("deadlock: main thread blocked in a strange way");
-	    }
-	}
-	return;
-#endif
-    }
-}
-
-/* ----------------------------------------------------------------------------
- * Process an event (GRAN only)
- * ------------------------------------------------------------------------- */
-
-#if defined(GRAN)
-static StgTSO *
-scheduleProcessEvent(rtsEvent *event)
-{
-    StgTSO *t;
-
-    if (RtsFlags.GranFlags.Light)
-      GranSimLight_enter_system(event, &ActiveTSO); // adjust ActiveTSO etc
-
-    /* adjust time based on time-stamp */
-    if (event->time > CurrentTime[CurrentProc] &&
-        event->evttype != ContinueThread)
-      CurrentTime[CurrentProc] = event->time;
-    
-    /* Deal with the idle PEs (may issue FindWork or MoveSpark events) */
-    if (!RtsFlags.GranFlags.Light)
-      handleIdlePEs();
-
-    IF_DEBUG(gran, debugBelch("GRAN: switch by event-type\n"));
-
-    /* main event dispatcher in GranSim */
-    switch (event->evttype) {
-      /* Should just be continuing execution */
-    case ContinueThread:
-      IF_DEBUG(gran, debugBelch("GRAN: doing ContinueThread\n"));
-      /* ToDo: check assertion
-      ASSERT(run_queue_hd != (StgTSO*)NULL &&
-	     run_queue_hd != END_TSO_QUEUE);
-      */
-      /* Ignore ContinueThreads for fetching threads (if synchr comm) */
-      if (!RtsFlags.GranFlags.DoAsyncFetch &&
-	  procStatus[CurrentProc]==Fetching) {
-	debugBelch("ghuH: Spurious ContinueThread while Fetching ignored; TSO %d (%p) [PE %d]\n",
-	      CurrentTSO->id, CurrentTSO, CurrentProc);
-	goto next_thread;
-      }	
-      /* Ignore ContinueThreads for completed threads */
-      if (CurrentTSO->what_next == ThreadComplete) {
-	debugBelch("ghuH: found a ContinueThread event for completed thread %d (%p) [PE %d] (ignoring ContinueThread)\n", 
-	      CurrentTSO->id, CurrentTSO, CurrentProc);
-	goto next_thread;
-      }	
-      /* Ignore ContinueThreads for threads that are being migrated */
-      if (PROCS(CurrentTSO)==Nowhere) { 
-	debugBelch("ghuH: trying to run the migrating TSO %d (%p) [PE %d] (ignoring ContinueThread)\n",
-	      CurrentTSO->id, CurrentTSO, CurrentProc);
-	goto next_thread;
-      }
-      /* The thread should be at the beginning of the run queue */
-      if (CurrentTSO!=run_queue_hds[CurrentProc]) { 
-	debugBelch("ghuH: TSO %d (%p) [PE %d] is not at the start of the run_queue when doing a ContinueThread\n",
-	      CurrentTSO->id, CurrentTSO, CurrentProc);
-	break; // run the thread anyway
-      }
-      /*
-      new_event(proc, proc, CurrentTime[proc],
-		FindWork,
-		(StgTSO*)NULL, (StgClosure*)NULL, (rtsSpark*)NULL);
-      goto next_thread; 
-      */ /* Catches superfluous CONTINUEs -- should be unnecessary */
-      break; // now actually run the thread; DaH Qu'vam yImuHbej 
-
-    case FetchNode:
-      do_the_fetchnode(event);
-      goto next_thread;             /* handle next event in event queue  */
-      
-    case GlobalBlock:
-      do_the_globalblock(event);
-      goto next_thread;             /* handle next event in event queue  */
-      
-    case FetchReply:
-      do_the_fetchreply(event);
-      goto next_thread;             /* handle next event in event queue  */
-      
-    case UnblockThread:   /* Move from the blocked queue to the tail of */
-      do_the_unblock(event);
-      goto next_thread;             /* handle next event in event queue  */
-      
-    case ResumeThread:  /* Move from the blocked queue to the tail of */
-      /* the runnable queue ( i.e. Qu' SImqa'lu') */ 
-      event->tso->gran.blocktime += 
-	CurrentTime[CurrentProc] - event->tso->gran.blockedat;
-      do_the_startthread(event);
-      goto next_thread;             /* handle next event in event queue  */
-      
-    case StartThread:
-      do_the_startthread(event);
-      goto next_thread;             /* handle next event in event queue  */
-      
-    case MoveThread:
-      do_the_movethread(event);
-      goto next_thread;             /* handle next event in event queue  */
-      
-    case MoveSpark:
-      do_the_movespark(event);
-      goto next_thread;             /* handle next event in event queue  */
-      
-    case FindWork:
-      do_the_findwork(event);
-      goto next_thread;             /* handle next event in event queue  */
-      
-    default:
-      barf("Illegal event type %u\n", event->evttype);
-    }  /* switch */
-    
-    /* This point was scheduler_loop in the old RTS */
-
-    IF_DEBUG(gran, debugBelch("GRAN: after main switch\n"));
-
-    TimeOfLastEvent = CurrentTime[CurrentProc];
-    TimeOfNextEvent = get_time_of_next_event();
-    IgnoreEvents=(TimeOfNextEvent==0); // HWL HACK
-    // CurrentTSO = ThreadQueueHd;
-
-    IF_DEBUG(gran, debugBelch("GRAN: time of next event is: %ld\n", 
-			 TimeOfNextEvent));
-
-    if (RtsFlags.GranFlags.Light) 
-      GranSimLight_leave_system(event, &ActiveTSO); 
-
-    EndOfTimeSlice = CurrentTime[CurrentProc]+RtsFlags.GranFlags.time_slice;
-
-    IF_DEBUG(gran, 
-	     debugBelch("GRAN: end of time-slice is %#lx\n", EndOfTimeSlice));
-
-    /* in a GranSim setup the TSO stays on the run queue */
-    t = CurrentTSO;
-    /* Take a thread from the run queue. */
-    POP_RUN_QUEUE(t); // take_off_run_queue(t);
-
-    IF_DEBUG(gran, 
-	     debugBelch("GRAN: About to run current thread, which is\n");
-	     G_TSO(t,5));
-
-    context_switch = 0; // turned on via GranYield, checking events and time slice
-
-    IF_DEBUG(gran, 
-	     DumpGranEvent(GR_SCHEDULE, t));
-
-    procStatus[CurrentProc] = Busy;
-}
-#endif // GRAN
-
-/* ----------------------------------------------------------------------------
- * Send pending messages (PARALLEL_HASKELL only)
- * ------------------------------------------------------------------------- */
-
-#if defined(PARALLEL_HASKELL)
-static StgTSO *
-scheduleSendPendingMessages(void)
-{
-    StgSparkPool *pool;
-    rtsSpark spark;
-    StgTSO *t;
-
-# if defined(PAR) // global Mem.Mgmt., omit for now
-    if (PendingFetches != END_BF_QUEUE) {
-        processFetches();
-    }
-# endif
-    
-    if (RtsFlags.ParFlags.BufferTime) {
-	// if we use message buffering, we must send away all message
-	// packets which have become too old...
-	sendOldBuffers(); 
-    }
-}
-#endif
-
-/* ----------------------------------------------------------------------------
- * Activate spark threads (PARALLEL_HASKELL only)
- * ------------------------------------------------------------------------- */
-
-#if defined(PARALLEL_HASKELL)
-static void
-scheduleActivateSpark(void)
-{
-#if defined(SPARKS)
-  ASSERT(emptyRunQueue());
-/* We get here if the run queue is empty and want some work.
-   We try to turn a spark into a thread, and add it to the run queue,
-   from where it will be picked up in the next iteration of the scheduler
-   loop.
-*/
-
-      /* :-[  no local threads => look out for local sparks */
-      /* the spark pool for the current PE */
-      pool = &(cap.r.rSparks); // JB: cap = (old) MainCap
-      if (advisory_thread_count < RtsFlags.ParFlags.maxThreads &&
-	  pool->hd < pool->tl) {
-	/* 
-	 * ToDo: add GC code check that we really have enough heap afterwards!!
-	 * Old comment:
-	 * If we're here (no runnable threads) and we have pending
-	 * sparks, we must have a space problem.  Get enough space
-	 * to turn one of those pending sparks into a
-	 * thread... 
-	 */
-
-  	spark = findSpark(rtsFalse);            /* get a spark */
-  	if (spark != (rtsSpark) NULL) {
-  	  tso = createThreadFromSpark(spark);       /* turn the spark into a thread */
-  	  IF_PAR_DEBUG(fish, // schedule,
-  		       debugBelch("==== schedule: Created TSO %d (%p); %d threads active\n",
-  			     tso->id, tso, advisory_thread_count));
-
-  	  if (tso==END_TSO_QUEUE) { /* failed to activate spark->back to loop */
-  	    IF_PAR_DEBUG(fish, // schedule,
-  			 debugBelch("==^^ failed to create thread from spark @ %lx\n",
-                            spark));
-  	    return rtsFalse; /* failed to generate a thread */
-  	  }                  /* otherwise fall through & pick-up new tso */
-  	} else {
-  	  IF_PAR_DEBUG(fish, // schedule,
-  		       debugBelch("==^^ no local sparks (spark pool contains only NFs: %d)\n", 
-  			     spark_queue_len(pool)));
-  	  return rtsFalse;  /* failed to generate a thread */
-  	}
-  	return rtsTrue;  /* success in generating a thread */
-  } else { /* no more threads permitted or pool empty */
-    return rtsFalse;  /* failed to generateThread */
-  }
-#else
-  tso = NULL; // avoid compiler warning only
-  return rtsFalse;  /* dummy in non-PAR setup */
-#endif // SPARKS
-}
-#endif // PARALLEL_HASKELL
-
-/* ----------------------------------------------------------------------------
- * Get work from a remote node (PARALLEL_HASKELL only)
- * ------------------------------------------------------------------------- */
-    
-#if defined(PARALLEL_HASKELL)
-static rtsBool
-scheduleGetRemoteWork(rtsBool *receivedFinish)
-{
-  ASSERT(emptyRunQueue());
-
-  if (RtsFlags.ParFlags.BufferTime) {
-	IF_PAR_DEBUG(verbose, 
-	        debugBelch("...send all pending data,"));
-        {
-	  nat i;
-	  for (i=1; i<=nPEs; i++)
-	    sendImmediately(i); // send all messages away immediately
-	}
-  }
-# ifndef SPARKS
-	//++EDEN++ idle() , i.e. send all buffers, wait for work
-	// suppress fishing in EDEN... just look for incoming messages
-	// (blocking receive)
-  IF_PAR_DEBUG(verbose, 
-	       debugBelch("...wait for incoming messages...\n"));
-  *receivedFinish = processMessages(); // blocking receive...
-
-	// and reenter scheduling loop after having received something
-	// (return rtsFalse below)
-
-# else /* activate SPARKS machinery */
-/* We get here, if we have no work, tried to activate a local spark, but still
-   have no work. We try to get a remote spark, by sending a FISH message.
-   Thread migration should be added here, and triggered when a sequence of 
-   fishes returns without work. */
-	delay = (RtsFlags.ParFlags.fishDelay!=0ll ? RtsFlags.ParFlags.fishDelay : 0ll);
-
-      /* =8-[  no local sparks => look for work on other PEs */
-	/*
-	 * We really have absolutely no work.  Send out a fish
-	 * (there may be some out there already), and wait for
-	 * something to arrive.  We clearly can't run any threads
-	 * until a SCHEDULE or RESUME arrives, and so that's what
-	 * we're hoping to see.  (Of course, we still have to
-	 * respond to other types of messages.)
-	 */
-	rtsTime now = msTime() /*CURRENT_TIME*/;
-	IF_PAR_DEBUG(verbose, 
-		     debugBelch("--  now=%ld\n", now));
-	IF_PAR_DEBUG(fish, // verbose,
-  	     if (outstandingFishes < RtsFlags.ParFlags.maxFishes &&
-  		 (last_fish_arrived_at!=0 &&
-  		  last_fish_arrived_at+delay > now)) {
-  	       debugBelch("--$$ <%llu> delaying FISH until %llu (last fish %llu, delay %llu)\n",
-  		     now, last_fish_arrived_at+delay, 
-		     last_fish_arrived_at,
-  		     delay);
-  	     });
-  
-	if (outstandingFishes < RtsFlags.ParFlags.maxFishes &&
-	    advisory_thread_count < RtsFlags.ParFlags.maxThreads) { // send a FISH, but when?
-	  if (last_fish_arrived_at==0 ||
-	      (last_fish_arrived_at+delay <= now)) {           // send FISH now!
-	    /* outstandingFishes is set in sendFish, processFish;
-	       avoid flooding system with fishes via delay */
-    next_fish_to_send_at = 0;  
-  } else {
-    /* ToDo: this should be done in the main scheduling loop to avoid the
-             busy wait here; not so bad if fish delay is very small  */
-    int iq = 0; // DEBUGGING -- HWL
-    next_fish_to_send_at = last_fish_arrived_at+delay; // remember when to send  
-    /* send a fish when ready, but process messages that arrive in the meantime */
-    do {
-      if (PacketsWaiting()) {
-        iq++; // DEBUGGING
-        *receivedFinish = processMessages();
-      }
-      now = msTime();
-    } while (!*receivedFinish || now<next_fish_to_send_at);
-    // JB: This means the fish could become obsolete, if we receive
-    // work. Better check for work again? 
-    // last line: while (!receivedFinish || !haveWork || now<...)
-    // next line: if (receivedFinish || haveWork )
-
-    if (*receivedFinish) // no need to send a FISH if we are finishing anyway
-      return rtsFalse;  // NB: this will leave scheduler loop
-			// immediately after return!
-  			  
-    IF_PAR_DEBUG(fish, // verbose,
-  	       debugBelch("--$$ <%llu> sent delayed fish (%d processMessages); active/total threads=%d/%d\n",now,iq,run_queue_len(),advisory_thread_count));
-
-  }
-
-    // JB: IMHO, this should all be hidden inside sendFish(...)
-    /* pe = choosePE(); 
-       sendFish(pe, thisPE, NEW_FISH_AGE, NEW_FISH_HISTORY, 
-                NEW_FISH_HUNGER);
-
-    // Global statistics: count no. of fishes
-    if (RtsFlags.ParFlags.ParStats.Global &&
-         RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	   globalParStats.tot_fish_mess++;
-	   }
-    */ 
-
-  /* delayed fishes must have been sent by now! */
-  next_fish_to_send_at = 0;  
-  }
-      
-  *receivedFinish = processMessages();
-# endif /* SPARKS */
-
- return rtsFalse;
- /* NB: this function always returns rtsFalse, meaning the scheduler
-    loop continues with the next iteration; 
-    rationale: 
-      return code means success in finding work; we enter this function
-      if there is no local work, thus have to send a fish which takes
-      time until it arrives with work; in the meantime we should process
-      messages in the main loop;
- */
-}
-#endif // PARALLEL_HASKELL
-
-/* ----------------------------------------------------------------------------
- * PAR/GRAN: Report stats & debugging info(?)
- * ------------------------------------------------------------------------- */
-
-#if defined(PAR) || defined(GRAN)
-static void
-scheduleGranParReport(void)
-{
-  ASSERT(run_queue_hd != END_TSO_QUEUE);
-
-  /* Take a thread from the run queue, if we have work */
-  POP_RUN_QUEUE(t);  // take_off_run_queue(END_TSO_QUEUE);
-
-    /* If this TSO has got its outport closed in the meantime, 
-     *   it mustn't be run. Instead, we have to clean it up as if it was finished.
-     * It has to be marked as TH_DEAD for this purpose.
-     * If it is TH_TERM instead, it is supposed to have finished in the normal way.
-
-JB: TODO: investigate wether state change field could be nuked
-     entirely and replaced by the normal tso state (whatnext
-     field). All we want to do is to kill tsos from outside.
-     */
-
-    /* ToDo: write something to the log-file
-    if (RTSflags.ParFlags.granSimStats && !sameThread)
-        DumpGranEvent(GR_SCHEDULE, RunnableThreadsHd);
-
-    CurrentTSO = t;
-    */
-    /* the spark pool for the current PE */
-    pool = &(cap.r.rSparks); //  cap = (old) MainCap
-
-    IF_DEBUG(scheduler, 
-	     debugBelch("--=^ %d threads, %d sparks on [%#x]\n", 
-		   run_queue_len(), spark_queue_len(pool), CURRENT_PROC));
-
-    IF_PAR_DEBUG(fish,
-	     debugBelch("--=^ %d threads, %d sparks on [%#x]\n", 
-		   run_queue_len(), spark_queue_len(pool), CURRENT_PROC));
-
-    if (RtsFlags.ParFlags.ParStats.Full && 
-	(t->par.sparkname != (StgInt)0) && // only log spark generated threads
-	(emitSchedule || // forced emit
-         (t && LastTSO && t->id != LastTSO->id))) {
-      /* 
-	 we are running a different TSO, so write a schedule event to log file
-	 NB: If we use fair scheduling we also have to write  a deschedule 
-	     event for LastTSO; with unfair scheduling we know that the
-	     previous tso has blocked whenever we switch to another tso, so
-	     we don't need it in GUM for now
-      */
-      IF_PAR_DEBUG(fish, // schedule,
-		   debugBelch("____ scheduling spark generated thread %d (%lx) (%lx) via a forced emit\n",t->id,t,t->par.sparkname));
-
-      DumpRawGranEvent(CURRENT_PROC, CURRENT_PROC,
-		       GR_SCHEDULE, t, (StgClosure *)NULL, 0, 0);
-      emitSchedule = rtsFalse;
-    }
-}     
-#endif
-
-/* ----------------------------------------------------------------------------
- * After running a thread...
- * ------------------------------------------------------------------------- */
-
-static void
-schedulePostRunThread(void)
-{
-#if defined(PAR)
-    /* HACK 675: if the last thread didn't yield, make sure to print a 
-       SCHEDULE event to the log file when StgRunning the next thread, even
-       if it is the same one as before */
-    LastTSO = t; 
-    TimeOfLastYield = CURRENT_TIME;
-#endif
-
-  /* some statistics gathering in the parallel case */
-
-#if defined(GRAN) || defined(PAR) || defined(EDEN)
-  switch (ret) {
-    case HeapOverflow:
-# if defined(GRAN)
-      IF_DEBUG(gran, DumpGranEvent(GR_DESCHEDULE, t));
-      globalGranStats.tot_heapover++;
-# elif defined(PAR)
-      globalParStats.tot_heapover++;
-# endif
-      break;
-
-     case StackOverflow:
-# if defined(GRAN)
-      IF_DEBUG(gran, 
-	       DumpGranEvent(GR_DESCHEDULE, t));
-      globalGranStats.tot_stackover++;
-# elif defined(PAR)
-      // IF_DEBUG(par, 
-      // DumpGranEvent(GR_DESCHEDULE, t);
-      globalParStats.tot_stackover++;
-# endif
-      break;
-
-    case ThreadYielding:
-# if defined(GRAN)
-      IF_DEBUG(gran, 
-	       DumpGranEvent(GR_DESCHEDULE, t));
-      globalGranStats.tot_yields++;
-# elif defined(PAR)
-      // IF_DEBUG(par, 
-      // DumpGranEvent(GR_DESCHEDULE, t);
-      globalParStats.tot_yields++;
-# endif
-      break; 
-
-    case ThreadBlocked:
-# if defined(GRAN)
-      IF_DEBUG(scheduler,
-	       debugBelch("--<< thread %ld (%p; %s) stopped, blocking on node %p [PE %d] with BQ: ", 
-			  t->id, t, whatNext_strs[t->what_next], t->block_info.closure, 
-			  (t->block_info.closure==(StgClosure*)NULL ? 99 : where_is(t->block_info.closure)));
-	       if (t->block_info.closure!=(StgClosure*)NULL)
-	         print_bq(t->block_info.closure);
-	       debugBelch("\n"));
-
-      // ??? needed; should emit block before
-      IF_DEBUG(gran, 
-	       DumpGranEvent(GR_DESCHEDULE, t)); 
-      prune_eventq(t, (StgClosure *)NULL); // prune ContinueThreads for t
-      /*
-	ngoq Dogh!
-      ASSERT(procStatus[CurrentProc]==Busy || 
-	      ((procStatus[CurrentProc]==Fetching) && 
-	      (t->block_info.closure!=(StgClosure*)NULL)));
-      if (run_queue_hds[CurrentProc] == END_TSO_QUEUE &&
-	  !(!RtsFlags.GranFlags.DoAsyncFetch &&
-	    procStatus[CurrentProc]==Fetching)) 
-	procStatus[CurrentProc] = Idle;
-      */
-# elif defined(PAR)
-//++PAR++  blockThread() writes the event (change?)
-# endif
-    break;
-
-  case ThreadFinished:
-    break;
-
-  default:
-    barf("parGlobalStats: unknown return code");
-    break;
-    }
-#endif
-}
-
-/* -----------------------------------------------------------------------------
- * Handle a thread that returned to the scheduler with ThreadHeepOverflow
- * -------------------------------------------------------------------------- */
-
-static rtsBool
-scheduleHandleHeapOverflow( Capability *cap, StgTSO *t )
-{
-    // did the task ask for a large block?
-    if (cap->r.rHpAlloc > BLOCK_SIZE) {
-	// if so, get one and push it on the front of the nursery.
-	bdescr *bd;
-	lnat blocks;
-	
-	blocks = (lnat)BLOCK_ROUND_UP(cap->r.rHpAlloc) / BLOCK_SIZE;
-	
-	IF_DEBUG(scheduler,
-		 debugBelch("--<< thread %ld (%s) stopped: requesting a large block (size %ld)\n", 
-			    (long)t->id, whatNext_strs[t->what_next], blocks));
-	
-	// don't do this if the nursery is (nearly) full, we'll GC first.
-	if (cap->r.rCurrentNursery->link != NULL ||
-	    cap->r.rNursery->n_blocks == 1) {  // paranoia to prevent infinite loop
-	                                       // if the nursery has only one block.
-	    
-	    ACQUIRE_SM_LOCK
-	    bd = allocGroup( blocks );
-	    RELEASE_SM_LOCK
-	    cap->r.rNursery->n_blocks += blocks;
-	    
-	    // link the new group into the list
-	    bd->link = cap->r.rCurrentNursery;
-	    bd->u.back = cap->r.rCurrentNursery->u.back;
-	    if (cap->r.rCurrentNursery->u.back != NULL) {
-		cap->r.rCurrentNursery->u.back->link = bd;
-	    } else {
-#if !defined(THREADED_RTS)
-		ASSERT(g0s0->blocks == cap->r.rCurrentNursery &&
-		       g0s0 == cap->r.rNursery);
-#endif
-		cap->r.rNursery->blocks = bd;
-	    }		  
-	    cap->r.rCurrentNursery->u.back = bd;
-	    
-	    // initialise it as a nursery block.  We initialise the
-	    // step, gen_no, and flags field of *every* sub-block in
-	    // this large block, because this is easier than making
-	    // sure that we always find the block head of a large
-	    // block whenever we call Bdescr() (eg. evacuate() and
-	    // isAlive() in the GC would both have to do this, at
-	    // least).
-	    { 
-		bdescr *x;
-		for (x = bd; x < bd + blocks; x++) {
-		    x->step = cap->r.rNursery;
-		    x->gen_no = 0;
-		    x->flags = 0;
-		}
-	    }
-	    
-	    // This assert can be a killer if the app is doing lots
-	    // of large block allocations.
-	    IF_DEBUG(sanity, checkNurserySanity(cap->r.rNursery));
-	    
-	    // now update the nursery to point to the new block
-	    cap->r.rCurrentNursery = bd;
-	    
-	    // we might be unlucky and have another thread get on the
-	    // run queue before us and steal the large block, but in that
-	    // case the thread will just end up requesting another large
-	    // block.
-	    pushOnRunQueue(cap,t);
-	    return rtsFalse;  /* not actually GC'ing */
-	}
-    }
-    
-    IF_DEBUG(scheduler,
-	     debugBelch("--<< thread %ld (%s) stopped: HeapOverflow\n", 
-			(long)t->id, whatNext_strs[t->what_next]));
-#if defined(GRAN)
-    ASSERT(!is_on_queue(t,CurrentProc));
-#elif defined(PARALLEL_HASKELL)
-    /* Currently we emit a DESCHEDULE event before GC in GUM.
-       ToDo: either add separate event to distinguish SYSTEM time from rest
-       or just nuke this DESCHEDULE (and the following SCHEDULE) */
-    if (0 && RtsFlags.ParFlags.ParStats.Full) {
-	DumpRawGranEvent(CURRENT_PROC, CURRENT_PROC,
-			 GR_DESCHEDULE, t, (StgClosure *)NULL, 0, 0);
-	emitSchedule = rtsTrue;
-    }
-#endif
-      
-    pushOnRunQueue(cap,t);
-    return rtsTrue;
-    /* actual GC is done at the end of the while loop in schedule() */
-}
-
-/* -----------------------------------------------------------------------------
- * Handle a thread that returned to the scheduler with ThreadStackOverflow
- * -------------------------------------------------------------------------- */
-
-static void
-scheduleHandleStackOverflow (Capability *cap, Task *task, StgTSO *t)
-{
-    IF_DEBUG(scheduler,debugBelch("--<< thread %ld (%s) stopped, StackOverflow\n", 
-				  (long)t->id, whatNext_strs[t->what_next]));
-    /* just adjust the stack for this thread, then pop it back
-     * on the run queue.
-     */
-    { 
-	/* enlarge the stack */
-	StgTSO *new_t = threadStackOverflow(cap, t);
-	
-	/* The TSO attached to this Task may have moved, so update the
-	 * pointer to it.
-	 */
-	if (task->tso == t) {
-	    task->tso = new_t;
-	}
-	pushOnRunQueue(cap,new_t);
-    }
-}
-
-/* -----------------------------------------------------------------------------
- * Handle a thread that returned to the scheduler with ThreadYielding
- * -------------------------------------------------------------------------- */
-
-static rtsBool
-scheduleHandleYield( Capability *cap, StgTSO *t, nat prev_what_next )
-{
-    // Reset the context switch flag.  We don't do this just before
-    // running the thread, because that would mean we would lose ticks
-    // during GC, which can lead to unfair scheduling (a thread hogs
-    // the CPU because the tick always arrives during GC).  This way
-    // penalises threads that do a lot of allocation, but that seems
-    // better than the alternative.
-    context_switch = 0;
-    
-    /* put the thread back on the run queue.  Then, if we're ready to
-     * GC, check whether this is the last task to stop.  If so, wake
-     * up the GC thread.  getThread will block during a GC until the
-     * GC is finished.
-     */
-    IF_DEBUG(scheduler,
-	     if (t->what_next != prev_what_next) {
-		 debugBelch("--<< thread %ld (%s) stopped to switch evaluators\n", 
-			    (long)t->id, whatNext_strs[t->what_next]);
-	     } else {
-		 debugBelch("--<< thread %ld (%s) stopped, yielding\n",
-			    (long)t->id, whatNext_strs[t->what_next]);
-	     }
-	);
-    
-    IF_DEBUG(sanity,
-	     //debugBelch("&& Doing sanity check on yielding TSO %ld.", t->id);
-	     checkTSO(t));
-    ASSERT(t->link == END_TSO_QUEUE);
-    
-    // Shortcut if we're just switching evaluators: don't bother
-    // doing stack squeezing (which can be expensive), just run the
-    // thread.
-    if (t->what_next != prev_what_next) {
-	return rtsTrue;
-    }
-    
-#if defined(GRAN)
-    ASSERT(!is_on_queue(t,CurrentProc));
-      
-    IF_DEBUG(sanity,
-	     //debugBelch("&& Doing sanity check on all ThreadQueues (and their TSOs).");
-	     checkThreadQsSanity(rtsTrue));
-
-#endif
-
-    addToRunQueue(cap,t);
-
-#if defined(GRAN)
-    /* add a ContinueThread event to actually process the thread */
-    new_event(CurrentProc, CurrentProc, CurrentTime[CurrentProc],
-	      ContinueThread,
-	      t, (StgClosure*)NULL, (rtsSpark*)NULL);
-    IF_GRAN_DEBUG(bq, 
-		  debugBelch("GRAN: eventq and runnableq after adding yielded thread to queue again:\n");
-		  G_EVENTQ(0);
-		  G_CURR_THREADQ(0));
-#endif
-    return rtsFalse;
-}
-
-/* -----------------------------------------------------------------------------
- * Handle a thread that returned to the scheduler with ThreadBlocked
- * -------------------------------------------------------------------------- */
-
-static void
-scheduleHandleThreadBlocked( StgTSO *t
-#if !defined(GRAN) && !defined(DEBUG)
-    STG_UNUSED
-#endif
-    )
-{
-#if defined(GRAN)
-    IF_DEBUG(scheduler,
-	     debugBelch("--<< thread %ld (%p; %s) stopped, blocking on node %p [PE %d] with BQ: \n", 
-			t->id, t, whatNext_strs[t->what_next], t->block_info.closure, (t->block_info.closure==(StgClosure*)NULL ? 99 : where_is(t->block_info.closure)));
-	     if (t->block_info.closure!=(StgClosure*)NULL) print_bq(t->block_info.closure));
-    
-    // ??? needed; should emit block before
-    IF_DEBUG(gran, 
-	     DumpGranEvent(GR_DESCHEDULE, t)); 
-    prune_eventq(t, (StgClosure *)NULL); // prune ContinueThreads for t
-    /*
-      ngoq Dogh!
-      ASSERT(procStatus[CurrentProc]==Busy || 
-      ((procStatus[CurrentProc]==Fetching) && 
-      (t->block_info.closure!=(StgClosure*)NULL)));
-      if (run_queue_hds[CurrentProc] == END_TSO_QUEUE &&
-      !(!RtsFlags.GranFlags.DoAsyncFetch &&
-      procStatus[CurrentProc]==Fetching)) 
-      procStatus[CurrentProc] = Idle;
-    */
-#elif defined(PAR)
-    IF_DEBUG(scheduler,
-	     debugBelch("--<< thread %ld (%p; %s) stopped, blocking on node %p with BQ: \n", 
-			t->id, t, whatNext_strs[t->what_next], t->block_info.closure));
-    IF_PAR_DEBUG(bq,
-		 
-		 if (t->block_info.closure!=(StgClosure*)NULL) 
-		 print_bq(t->block_info.closure));
-    
-    /* Send a fetch (if BlockedOnGA) and dump event to log file */
-    blockThread(t);
-    
-    /* whatever we schedule next, we must log that schedule */
-    emitSchedule = rtsTrue;
-    
-#else /* !GRAN */
-
-      // We don't need to do anything.  The thread is blocked, and it
-      // has tidied up its stack and placed itself on whatever queue
-      // it needs to be on.
-
-#if !defined(THREADED_RTS)
-    ASSERT(t->why_blocked != NotBlocked);
-	     // This might not be true under THREADED_RTS: we don't have
-	     // exclusive access to this TSO, so someone might have
-	     // woken it up by now.  This actually happens: try
-	     // conc023 +RTS -N2.
-#endif
-
-    IF_DEBUG(scheduler,
-	     debugBelch("--<< thread %d (%s) stopped: ", 
-			t->id, whatNext_strs[t->what_next]);
-	     printThreadBlockage(t);
-	     debugBelch("\n"));
-    
-    /* Only for dumping event to log file 
-       ToDo: do I need this in GranSim, too?
-       blockThread(t);
-    */
-#endif
-}
-
-/* -----------------------------------------------------------------------------
- * Handle a thread that returned to the scheduler with ThreadFinished
- * -------------------------------------------------------------------------- */
-
-static rtsBool
-scheduleHandleThreadFinished (Capability *cap STG_UNUSED, Task *task, StgTSO *t)
-{
-    /* Need to check whether this was a main thread, and if so,
-     * return with the return value.
-     *
-     * We also end up here if the thread kills itself with an
-     * uncaught exception, see Exception.cmm.
-     */
-    IF_DEBUG(scheduler,debugBelch("--++ thread %d (%s) finished\n", 
-				  t->id, whatNext_strs[t->what_next]));
-
-#if defined(GRAN)
-      endThread(t, CurrentProc); // clean-up the thread
-#elif defined(PARALLEL_HASKELL)
-      /* For now all are advisory -- HWL */
-      //if(t->priority==AdvisoryPriority) ??
-      advisory_thread_count--; // JB: Caution with this counter, buggy!
-      
-# if defined(DIST)
-      if(t->dist.priority==RevalPriority)
-	FinishReval(t);
-# endif
-    
-# if defined(EDENOLD)
-      // the thread could still have an outport... (BUG)
-      if (t->eden.outport != -1) {
-      // delete the outport for the tso which has finished...
-	IF_PAR_DEBUG(eden_ports,
-		   debugBelch("WARNING: Scheduler removes outport %d for TSO %d.\n",
-			      t->eden.outport, t->id));
-	deleteOPT(t);
-      }
-      // thread still in the process (HEAVY BUG! since outport has just been closed...)
-      if (t->eden.epid != -1) {
-	IF_PAR_DEBUG(eden_ports,
-		   debugBelch("WARNING: Scheduler removes TSO %d from process %d .\n",
-			   t->id, t->eden.epid));
-	removeTSOfromProcess(t);
-      }
-# endif 
-
-# if defined(PAR)
-      if (RtsFlags.ParFlags.ParStats.Full &&
-	  !RtsFlags.ParFlags.ParStats.Suppressed) 
-	DumpEndEvent(CURRENT_PROC, t, rtsFalse /* not mandatory */);
-
-      //  t->par only contains statistics: left out for now...
-      IF_PAR_DEBUG(fish,
-		   debugBelch("**** end thread: ended sparked thread %d (%lx); sparkname: %lx\n",
-			      t->id,t,t->par.sparkname));
-# endif
-#endif // PARALLEL_HASKELL
-
-      //
-      // Check whether the thread that just completed was a bound
-      // thread, and if so return with the result.  
-      //
-      // There is an assumption here that all thread completion goes
-      // through this point; we need to make sure that if a thread
-      // ends up in the ThreadKilled state, that it stays on the run
-      // queue so it can be dealt with here.
-      //
-
-      if (t->bound) {
-
-	  if (t->bound != task) {
-#if !defined(THREADED_RTS)
-	      // Must be a bound thread that is not the topmost one.  Leave
-	      // it on the run queue until the stack has unwound to the
-	      // point where we can deal with this.  Leaving it on the run
-	      // queue also ensures that the garbage collector knows about
-	      // this thread and its return value (it gets dropped from the
-	      // all_threads list so there's no other way to find it).
-	      appendToRunQueue(cap,t);
-	      return rtsFalse;
-#else
-	      // this cannot happen in the threaded RTS, because a
-	      // bound thread can only be run by the appropriate Task.
-	      barf("finished bound thread that isn't mine");
-#endif
-	  }
-
-	  ASSERT(task->tso == t);
-
-	  if (t->what_next == ThreadComplete) {
-	      if (task->ret) {
-		  // NOTE: return val is tso->sp[1] (see StgStartup.hc)
-		  *(task->ret) = (StgClosure *)task->tso->sp[1]; 
-	      }
-	      task->stat = Success;
-	  } else {
-	      if (task->ret) {
-		  *(task->ret) = NULL;
-	      }
-	      if (sched_state >= SCHED_INTERRUPTING) {
-		  task->stat = Interrupted;
-	      } else {
-		  task->stat = Killed;
-	      }
-	  }
-#ifdef DEBUG
-	  removeThreadLabel((StgWord)task->tso->id);
-#endif
-	  return rtsTrue; // tells schedule() to return
-      }
-
-      return rtsFalse;
-}
-
-/* -----------------------------------------------------------------------------
- * Perform a heap census, if PROFILING
- * -------------------------------------------------------------------------- */
-
-static rtsBool
-scheduleDoHeapProfile( rtsBool ready_to_gc STG_UNUSED )
-{
-#if defined(PROFILING)
-    // When we have +RTS -i0 and we're heap profiling, do a census at
-    // every GC.  This lets us get repeatable runs for debugging.
-    if (performHeapProfile ||
-	(RtsFlags.ProfFlags.profileInterval==0 &&
-	 RtsFlags.ProfFlags.doHeapProfile && ready_to_gc)) {
-
-	// checking black holes is necessary before GC, otherwise
-	// there may be threads that are unreachable except by the
-	// blackhole queue, which the GC will consider to be
-	// deadlocked.
-	scheduleCheckBlackHoles(&MainCapability);
-
-	IF_DEBUG(scheduler, sched_belch("garbage collecting before heap census"));
-	GarbageCollect(GetRoots, rtsTrue);
-
-	IF_DEBUG(scheduler, sched_belch("performing heap census"));
-	heapCensus();
-
-	performHeapProfile = rtsFalse;
-	return rtsTrue;  // true <=> we already GC'd
-    }
-#endif
-    return rtsFalse;
-}
-
-/* -----------------------------------------------------------------------------
- * Perform a garbage collection if necessary
- * -------------------------------------------------------------------------- */
-
-static Capability *
-scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS,
-	      rtsBool force_major, void (*get_roots)(evac_fn))
-{
-    StgTSO *t;
-#ifdef THREADED_RTS
-    static volatile StgWord waiting_for_gc;
-    rtsBool was_waiting;
-    nat i;
-#endif
-
-#ifdef THREADED_RTS
-    // In order to GC, there must be no threads running Haskell code.
-    // Therefore, the GC thread needs to hold *all* the capabilities,
-    // and release them after the GC has completed.  
-    //
-    // This seems to be the simplest way: previous attempts involved
-    // making all the threads with capabilities give up their
-    // capabilities and sleep except for the *last* one, which
-    // actually did the GC.  But it's quite hard to arrange for all
-    // the other tasks to sleep and stay asleep.
-    //
-	
-    was_waiting = cas(&waiting_for_gc, 0, 1);
-    if (was_waiting) {
-	do {
-	    IF_DEBUG(scheduler, sched_belch("someone else is trying to GC..."));
-	    if (cap) yieldCapability(&cap,task);
-	} while (waiting_for_gc);
-	return cap;  // NOTE: task->cap might have changed here
-    }
-
-    for (i=0; i < n_capabilities; i++) {
-	IF_DEBUG(scheduler, sched_belch("ready_to_gc, grabbing all the capabilies (%d/%d)", i, n_capabilities));
-	if (cap != &capabilities[i]) {
-	    Capability *pcap = &capabilities[i];
-	    // we better hope this task doesn't get migrated to
-	    // another Capability while we're waiting for this one.
-	    // It won't, because load balancing happens while we have
-	    // all the Capabilities, but even so it's a slightly
-	    // unsavoury invariant.
-	    task->cap = pcap;
-	    context_switch = 1;
-	    waitForReturnCapability(&pcap, task);
-	    if (pcap != &capabilities[i]) {
-		barf("scheduleDoGC: got the wrong capability");
-	    }
-	}
-    }
-
-    waiting_for_gc = rtsFalse;
-#endif
-
-    /* Kick any transactions which are invalid back to their
-     * atomically frames.  When next scheduled they will try to
-     * commit, this commit will fail and they will retry.
-     */
-    { 
-	StgTSO *next;
-
-	for (t = all_threads; t != END_TSO_QUEUE; t = next) {
-	    if (t->what_next == ThreadRelocated) {
-		next = t->link;
-	    } else {
-		next = t->global_link;
-		if (t -> trec != NO_TREC && t -> why_blocked == NotBlocked) {
-		    if (!stmValidateNestOfTransactions (t -> trec)) {
-			IF_DEBUG(stm, sched_belch("trec %p found wasting its time", t));
-			
-			// strip the stack back to the
-			// ATOMICALLY_FRAME, aborting the (nested)
-			// transaction, and saving the stack of any
-			// partially-evaluated thunks on the heap.
-			raiseAsync_(&capabilities[0], t, NULL, rtsTrue, NULL);
-			
-#ifdef REG_R1
-			ASSERT(get_itbl((StgClosure *)t->sp)->type == ATOMICALLY_FRAME);
-#endif
-		    }
-		}
-	    }
-	}
-    }
-    
-    // so this happens periodically:
-    if (cap) scheduleCheckBlackHoles(cap);
-    
-    IF_DEBUG(scheduler, printAllThreads());
-
-    /*
-     * We now have all the capabilities; if we're in an interrupting
-     * state, then we should take the opportunity to delete all the
-     * threads in the system.
-     */
-    if (sched_state >= SCHED_INTERRUPTING) {
-	deleteAllThreads(&capabilities[0]);
-	sched_state = SCHED_INTERRUPTED;
-    }
-
-    /* everybody back, start the GC.
-     * Could do it in this thread, or signal a condition var
-     * to do it in another thread.  Either way, we need to
-     * broadcast on gc_pending_cond afterward.
-     */
-#if defined(THREADED_RTS)
-    IF_DEBUG(scheduler,sched_belch("doing GC"));
-#endif
-    GarbageCollect(get_roots, force_major);
-    
-#if defined(THREADED_RTS)
-    // release our stash of capabilities.
-    for (i = 0; i < n_capabilities; i++) {
-	if (cap != &capabilities[i]) {
-	    task->cap = &capabilities[i];
-	    releaseCapability(&capabilities[i]);
-	}
-    }
-    if (cap) {
-	task->cap = cap;
-    } else {
-	task->cap = NULL;
-    }
-#endif
-
-#if defined(GRAN)
-    /* add a ContinueThread event to continue execution of current thread */
-    new_event(CurrentProc, CurrentProc, CurrentTime[CurrentProc],
-	      ContinueThread,
-	      t, (StgClosure*)NULL, (rtsSpark*)NULL);
-    IF_GRAN_DEBUG(bq, 
-		  debugBelch("GRAN: eventq and runnableq after Garbage collection:\n\n");
-		  G_EVENTQ(0);
-		  G_CURR_THREADQ(0));
-#endif /* GRAN */
-
-    return cap;
-}
-
-/* ---------------------------------------------------------------------------
- * rtsSupportsBoundThreads(): is the RTS built to support bound threads?
- * used by Control.Concurrent for error checking.
- * ------------------------------------------------------------------------- */
- 
-StgBool
-rtsSupportsBoundThreads(void)
-{
-#if defined(THREADED_RTS)
-  return rtsTrue;
-#else
-  return rtsFalse;
-#endif
-}
-
-/* ---------------------------------------------------------------------------
- * isThreadBound(tso): check whether tso is bound to an OS thread.
- * ------------------------------------------------------------------------- */
- 
-StgBool
-isThreadBound(StgTSO* tso USED_IF_THREADS)
-{
-#if defined(THREADED_RTS)
-  return (tso->bound != NULL);
-#endif
-  return rtsFalse;
-}
-
-/* ---------------------------------------------------------------------------
- * Singleton fork(). Do not copy any running threads.
- * ------------------------------------------------------------------------- */
-
-#if !defined(mingw32_HOST_OS)
-#define FORKPROCESS_PRIMOP_SUPPORTED
-#endif
-
-#ifdef FORKPROCESS_PRIMOP_SUPPORTED
-static void 
-deleteThread_(Capability *cap, StgTSO *tso);
-#endif
-StgInt
-forkProcess(HsStablePtr *entry
-#ifndef FORKPROCESS_PRIMOP_SUPPORTED
-	    STG_UNUSED
-#endif
-           )
-{
-#ifdef FORKPROCESS_PRIMOP_SUPPORTED
-    Task *task;
-    pid_t pid;
-    StgTSO* t,*next;
-    Capability *cap;
-    
-#if defined(THREADED_RTS)
-    if (RtsFlags.ParFlags.nNodes > 1) {
-	errorBelch("forking not supported with +RTS -N<n> greater than 1");
-	stg_exit(EXIT_FAILURE);
-    }
-#endif
-
-    IF_DEBUG(scheduler,sched_belch("forking!"));
-    
-    // ToDo: for SMP, we should probably acquire *all* the capabilities
-    cap = rts_lock();
-    
-    pid = fork();
-    
-    if (pid) { // parent
-	
-	// just return the pid
-	rts_unlock(cap);
-	return pid;
-	
-    } else { // child
-	
-	// Now, all OS threads except the thread that forked are
-	// stopped.  We need to stop all Haskell threads, including
-	// those involved in foreign calls.  Also we need to delete
-	// all Tasks, because they correspond to OS threads that are
-	// now gone.
-
-	for (t = all_threads; t != END_TSO_QUEUE; t = next) {
-	    if (t->what_next == ThreadRelocated) {
-		next = t->link;
-	    } else {
-		next = t->global_link;
-		// don't allow threads to catch the ThreadKilled
-		// exception, but we do want to raiseAsync() because these
-		// threads may be evaluating thunks that we need later.
-		deleteThread_(cap,t);
-	    }
-	}
-	
-	// Empty the run queue.  It seems tempting to let all the
-	// killed threads stay on the run queue as zombies to be
-	// cleaned up later, but some of them correspond to bound
-	// threads for which the corresponding Task does not exist.
-	cap->run_queue_hd = END_TSO_QUEUE;
-	cap->run_queue_tl = END_TSO_QUEUE;
-
-	// Any suspended C-calling Tasks are no more, their OS threads
-	// don't exist now:
-	cap->suspended_ccalling_tasks = NULL;
-
-	// Empty the all_threads list.  Otherwise, the garbage
-	// collector may attempt to resurrect some of these threads.
-	all_threads = END_TSO_QUEUE;
-
-	// Wipe the task list, except the current Task.
-	ACQUIRE_LOCK(&sched_mutex);
-	for (task = all_tasks; task != NULL; task=task->all_link) {
-	    if (task != cap->running_task) {
-		discardTask(task);
-	    }
-	}
-	RELEASE_LOCK(&sched_mutex);
-
-#if defined(THREADED_RTS)
-	// Wipe our spare workers list, they no longer exist.  New
-	// workers will be created if necessary.
-	cap->spare_workers = NULL;
-	cap->returning_tasks_hd = NULL;
-	cap->returning_tasks_tl = NULL;
-#endif
-
-	cap = rts_evalStableIO(cap, entry, NULL);  // run the action
-	rts_checkSchedStatus("forkProcess",cap);
-	
-	rts_unlock(cap);
-	hs_exit();                      // clean up and exit
-	stg_exit(EXIT_SUCCESS);
-    }
-#else /* !FORKPROCESS_PRIMOP_SUPPORTED */
-    barf("forkProcess#: primop not supported on this platform, sorry!\n");
-    return -1;
-#endif
-}
-
-/* ---------------------------------------------------------------------------
- * Delete all the threads in the system
- * ------------------------------------------------------------------------- */
-   
-static void
-deleteAllThreads ( Capability *cap )
-{
-  StgTSO* t, *next;
-  IF_DEBUG(scheduler,sched_belch("deleting all threads"));
-  for (t = all_threads; t != END_TSO_QUEUE; t = next) {
-      if (t->what_next == ThreadRelocated) {
-	  next = t->link;
-      } else {
-	  next = t->global_link;
-	  deleteThread(cap,t);
-      }
-  }      
-
-  // The run queue now contains a bunch of ThreadKilled threads.  We
-  // must not throw these away: the main thread(s) will be in there
-  // somewhere, and the main scheduler loop has to deal with it.
-  // Also, the run queue is the only thing keeping these threads from
-  // being GC'd, and we don't want the "main thread has been GC'd" panic.
-
-#if !defined(THREADED_RTS)
-  ASSERT(blocked_queue_hd == END_TSO_QUEUE);
-  ASSERT(sleeping_queue == END_TSO_QUEUE);
-#endif
-}
-
-/* -----------------------------------------------------------------------------
-   Managing the suspended_ccalling_tasks list.
-   Locks required: sched_mutex
-   -------------------------------------------------------------------------- */
-
-STATIC_INLINE void
-suspendTask (Capability *cap, Task *task)
-{
-    ASSERT(task->next == NULL && task->prev == NULL);
-    task->next = cap->suspended_ccalling_tasks;
-    task->prev = NULL;
-    if (cap->suspended_ccalling_tasks) {
-	cap->suspended_ccalling_tasks->prev = task;
-    }
-    cap->suspended_ccalling_tasks = task;
-}
-
-STATIC_INLINE void
-recoverSuspendedTask (Capability *cap, Task *task)
-{
-    if (task->prev) {
-	task->prev->next = task->next;
-    } else {
-	ASSERT(cap->suspended_ccalling_tasks == task);
-	cap->suspended_ccalling_tasks = task->next;
-    }
-    if (task->next) {
-	task->next->prev = task->prev;
-    }
-    task->next = task->prev = NULL;
-}
-
-/* ---------------------------------------------------------------------------
- * Suspending & resuming Haskell threads.
- * 
- * When making a "safe" call to C (aka _ccall_GC), the task gives back
- * its capability before calling the C function.  This allows another
- * task to pick up the capability and carry on running Haskell
- * threads.  It also means that if the C call blocks, it won't lock
- * the whole system.
- *
- * The Haskell thread making the C call is put to sleep for the
- * duration of the call, on the susepended_ccalling_threads queue.  We
- * give out a token to the task, which it can use to resume the thread
- * on return from the C function.
- * ------------------------------------------------------------------------- */
-   
-void *
-suspendThread (StgRegTable *reg)
-{
-  Capability *cap;
-  int saved_errno = errno;
-  StgTSO *tso;
-  Task *task;
-
-  /* assume that *reg is a pointer to the StgRegTable part of a Capability.
-   */
-  cap = regTableToCapability(reg);
-
-  task = cap->running_task;
-  tso = cap->r.rCurrentTSO;
-
-  IF_DEBUG(scheduler,
-	   sched_belch("thread %d did a safe foreign call", cap->r.rCurrentTSO->id));
-
-  // XXX this might not be necessary --SDM
-  tso->what_next = ThreadRunGHC;
-
-  threadPaused(cap,tso);
-
-  if(tso->blocked_exceptions == NULL)  {
-      tso->why_blocked = BlockedOnCCall;
-      tso->blocked_exceptions = END_TSO_QUEUE;
-  } else {
-      tso->why_blocked = BlockedOnCCall_NoUnblockExc;
-  }
-
-  // Hand back capability
-  task->suspended_tso = tso;
-
-  ACQUIRE_LOCK(&cap->lock);
-
-  suspendTask(cap,task);
-  cap->in_haskell = rtsFalse;
-  releaseCapability_(cap);
-  
-  RELEASE_LOCK(&cap->lock);
-
-#if defined(THREADED_RTS)
-  /* Preparing to leave the RTS, so ensure there's a native thread/task
-     waiting to take over.
-  */
-  IF_DEBUG(scheduler, sched_belch("thread %d: leaving RTS", tso->id));
-#endif
-
-  errno = saved_errno;
-  return task;
-}
-
-StgRegTable *
-resumeThread (void *task_)
-{
-    StgTSO *tso;
-    Capability *cap;
-    int saved_errno = errno;
-    Task *task = task_;
-
-    cap = task->cap;
-    // Wait for permission to re-enter the RTS with the result.
-    waitForReturnCapability(&cap,task);
-    // we might be on a different capability now... but if so, our
-    // entry on the suspended_ccalling_tasks list will also have been
-    // migrated.
-
-    // Remove the thread from the suspended list
-    recoverSuspendedTask(cap,task);
-
-    tso = task->suspended_tso;
-    task->suspended_tso = NULL;
-    tso->link = END_TSO_QUEUE;
-    IF_DEBUG(scheduler, sched_belch("thread %d: re-entering RTS", tso->id));
-    
-    if (tso->why_blocked == BlockedOnCCall) {
-	awakenBlockedQueue(cap,tso->blocked_exceptions);
-	tso->blocked_exceptions = NULL;
-    }
-    
-    /* Reset blocking status */
-    tso->why_blocked  = NotBlocked;
-    
-    cap->r.rCurrentTSO = tso;
-    cap->in_haskell = rtsTrue;
-    errno = saved_errno;
-
-    /* We might have GC'd, mark the TSO dirty again */
-    dirtyTSO(tso);
-
-    IF_DEBUG(sanity, checkTSO(tso));
-
-    return &cap->r;
-}
-
-/* ---------------------------------------------------------------------------
- * Comparing Thread ids.
- *
- * This is used from STG land in the implementation of the
- * instances of Eq/Ord for ThreadIds.
- * ------------------------------------------------------------------------ */
-
-int
-cmp_thread(StgPtr tso1, StgPtr tso2) 
-{ 
-  StgThreadID id1 = ((StgTSO *)tso1)->id; 
-  StgThreadID id2 = ((StgTSO *)tso2)->id;
- 
-  if (id1 < id2) return (-1);
-  if (id1 > id2) return 1;
-  return 0;
-}
-
-/* ---------------------------------------------------------------------------
- * Fetching the ThreadID from an StgTSO.
- *
- * This is used in the implementation of Show for ThreadIds.
- * ------------------------------------------------------------------------ */
-int
-rts_getThreadId(StgPtr tso) 
-{
-  return ((StgTSO *)tso)->id;
-}
-
-#ifdef DEBUG
-void
-labelThread(StgPtr tso, char *label)
-{
-  int len;
-  void *buf;
-
-  /* Caveat: Once set, you can only set the thread name to "" */
-  len = strlen(label)+1;
-  buf = stgMallocBytes(len * sizeof(char), "Schedule.c:labelThread()");
-  strncpy(buf,label,len);
-  /* Update will free the old memory for us */
-  updateThreadLabel(((StgTSO *)tso)->id,buf);
-}
-#endif /* DEBUG */
-
-/* ---------------------------------------------------------------------------
-   Create a new thread.
-
-   The new thread starts with the given stack size.  Before the
-   scheduler can run, however, this thread needs to have a closure
-   (and possibly some arguments) pushed on its stack.  See
-   pushClosure() in Schedule.h.
-
-   createGenThread() and createIOThread() (in SchedAPI.h) are
-   convenient packaged versions of this function.
-
-   currently pri (priority) is only used in a GRAN setup -- HWL
-   ------------------------------------------------------------------------ */
-#if defined(GRAN)
-/*   currently pri (priority) is only used in a GRAN setup -- HWL */
-StgTSO *
-createThread(nat size, StgInt pri)
-#else
-StgTSO *
-createThread(Capability *cap, nat size)
-#endif
-{
-    StgTSO *tso;
-    nat stack_size;
-
-    /* sched_mutex is *not* required */
-
-    /* First check whether we should create a thread at all */
-#if defined(PARALLEL_HASKELL)
-    /* check that no more than RtsFlags.ParFlags.maxThreads threads are created */
-    if (advisory_thread_count >= RtsFlags.ParFlags.maxThreads) {
-	threadsIgnored++;
-	debugBelch("{createThread}Daq ghuH: refusing to create another thread; no more than %d threads allowed (currently %d)\n",
-		   RtsFlags.ParFlags.maxThreads, advisory_thread_count);
-	return END_TSO_QUEUE;
-    }
-    threadsCreated++;
-#endif
-
-#if defined(GRAN)
-    ASSERT(!RtsFlags.GranFlags.Light || CurrentProc==0);
-#endif
-
-    // ToDo: check whether size = stack_size - TSO_STRUCT_SIZEW
-
-    /* catch ridiculously small stack sizes */
-    if (size < MIN_STACK_WORDS + TSO_STRUCT_SIZEW) {
-	size = MIN_STACK_WORDS + TSO_STRUCT_SIZEW;
-    }
-
-    stack_size = size - TSO_STRUCT_SIZEW;
-    
-    tso = (StgTSO *)allocateLocal(cap, size);
-    TICK_ALLOC_TSO(stack_size, 0);
-
-    SET_HDR(tso, &stg_TSO_info, CCS_SYSTEM);
-#if defined(GRAN)
-    SET_GRAN_HDR(tso, ThisPE);
-#endif
-
-    // Always start with the compiled code evaluator
-    tso->what_next = ThreadRunGHC;
-
-    tso->why_blocked  = NotBlocked;
-    tso->blocked_exceptions = NULL;
-    tso->flags = TSO_DIRTY;
-    
-    tso->saved_errno = 0;
-    tso->bound = NULL;
-    tso->cap = cap;
-    
-    tso->stack_size     = stack_size;
-    tso->max_stack_size = round_to_mblocks(RtsFlags.GcFlags.maxStkSize) 
-	                  - TSO_STRUCT_SIZEW;
-    tso->sp             = (P_)&(tso->stack) + stack_size;
-
-    tso->trec = NO_TREC;
-    
-#ifdef PROFILING
-    tso->prof.CCCS = CCS_MAIN;
-#endif
-    
-  /* put a stop frame on the stack */
-    tso->sp -= sizeofW(StgStopFrame);
-    SET_HDR((StgClosure*)tso->sp,(StgInfoTable *)&stg_stop_thread_info,CCS_SYSTEM);
-    tso->link = END_TSO_QUEUE;
-    
-  // ToDo: check this
-#if defined(GRAN)
-    /* uses more flexible routine in GranSim */
-    insertThread(tso, CurrentProc);
-#else
-    /* In a non-GranSim setup the pushing of a TSO onto the runq is separated
-     * from its creation
-     */
-#endif
-    
-#if defined(GRAN) 
-    if (RtsFlags.GranFlags.GranSimStats.Full) 
-	DumpGranEvent(GR_START,tso);
-#elif defined(PARALLEL_HASKELL)
-    if (RtsFlags.ParFlags.ParStats.Full) 
-	DumpGranEvent(GR_STARTQ,tso);
-    /* HACk to avoid SCHEDULE 
-       LastTSO = tso; */
-#endif
-    
-    /* Link the new thread on the global thread list.
-     */
-    ACQUIRE_LOCK(&sched_mutex);
-    tso->id = next_thread_id++;  // while we have the mutex
-    tso->global_link = all_threads;
-    all_threads = tso;
-    RELEASE_LOCK(&sched_mutex);
-    
-#if defined(DIST)
-    tso->dist.priority = MandatoryPriority; //by default that is...
-#endif
-    
-#if defined(GRAN)
-    tso->gran.pri = pri;
-# if defined(DEBUG)
-    tso->gran.magic = TSO_MAGIC; // debugging only
-# endif
-    tso->gran.sparkname   = 0;
-    tso->gran.startedat   = CURRENT_TIME; 
-    tso->gran.exported    = 0;
-    tso->gran.basicblocks = 0;
-    tso->gran.allocs      = 0;
-    tso->gran.exectime    = 0;
-    tso->gran.fetchtime   = 0;
-    tso->gran.fetchcount  = 0;
-    tso->gran.blocktime   = 0;
-    tso->gran.blockcount  = 0;
-    tso->gran.blockedat   = 0;
-    tso->gran.globalsparks = 0;
-    tso->gran.localsparks  = 0;
-    if (RtsFlags.GranFlags.Light)
-	tso->gran.clock  = Now; /* local clock */
-    else
-	tso->gran.clock  = 0;
-    
-    IF_DEBUG(gran,printTSO(tso));
-#elif defined(PARALLEL_HASKELL)
-# if defined(DEBUG)
-    tso->par.magic = TSO_MAGIC; // debugging only
-# endif
-    tso->par.sparkname   = 0;
-    tso->par.startedat   = CURRENT_TIME; 
-    tso->par.exported    = 0;
-    tso->par.basicblocks = 0;
-    tso->par.allocs      = 0;
-    tso->par.exectime    = 0;
-    tso->par.fetchtime   = 0;
-    tso->par.fetchcount  = 0;
-    tso->par.blocktime   = 0;
-    tso->par.blockcount  = 0;
-    tso->par.blockedat   = 0;
-    tso->par.globalsparks = 0;
-    tso->par.localsparks  = 0;
-#endif
-    
-#if defined(GRAN)
-    globalGranStats.tot_threads_created++;
-    globalGranStats.threads_created_on_PE[CurrentProc]++;
-    globalGranStats.tot_sq_len += spark_queue_len(CurrentProc);
-    globalGranStats.tot_sq_probes++;
-#elif defined(PARALLEL_HASKELL)
-    // collect parallel global statistics (currently done together with GC stats)
-    if (RtsFlags.ParFlags.ParStats.Global &&
-	RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	//debugBelch("Creating thread %d @ %11.2f\n", tso->id, usertime()); 
-	globalParStats.tot_threads_created++;
-    }
-#endif 
-    
-#if defined(GRAN)
-    IF_GRAN_DEBUG(pri,
-		  sched_belch("==__ schedule: Created TSO %d (%p);",
-			      CurrentProc, tso, tso->id));
-#elif defined(PARALLEL_HASKELL)
-    IF_PAR_DEBUG(verbose,
-		 sched_belch("==__ schedule: Created TSO %d (%p); %d threads active",
-			     (long)tso->id, tso, advisory_thread_count));
-#else
-    IF_DEBUG(scheduler,sched_belch("created thread %ld, stack size = %lx words", 
-				   (long)tso->id, (long)tso->stack_size));
-#endif    
-    return tso;
-}
-
-#if defined(PAR)
-/* RFP:
-   all parallel thread creation calls should fall through the following routine.
-*/
-StgTSO *
-createThreadFromSpark(rtsSpark spark) 
-{ StgTSO *tso;
-  ASSERT(spark != (rtsSpark)NULL);
-// JB: TAKE CARE OF THIS COUNTER! BUGGY
-  if (advisory_thread_count >= RtsFlags.ParFlags.maxThreads) 
-  { threadsIgnored++;
-    barf("{createSparkThread}Daq ghuH: refusing to create another thread; no more than %d threads allowed (currently %d)",
-	  RtsFlags.ParFlags.maxThreads, advisory_thread_count);    
-    return END_TSO_QUEUE;
-  }
-  else
-  { threadsCreated++;
-    tso = createThread(RtsFlags.GcFlags.initialStkSize);
-    if (tso==END_TSO_QUEUE)	
-      barf("createSparkThread: Cannot create TSO");
-#if defined(DIST)
-    tso->priority = AdvisoryPriority;
-#endif
-    pushClosure(tso,spark);
-    addToRunQueue(tso);
-    advisory_thread_count++;  // JB: TAKE CARE OF THIS COUNTER! BUGGY
-  }
-  return tso;
-}
-#endif
-
-/*
-  Turn a spark into a thread.
-  ToDo: fix for SMP (needs to acquire SCHED_MUTEX!)
-*/
-#if 0
-StgTSO *
-activateSpark (rtsSpark spark) 
-{
-  StgTSO *tso;
-
-  tso = createSparkThread(spark);
-  if (RtsFlags.ParFlags.ParStats.Full) {   
-    //ASSERT(run_queue_hd == END_TSO_QUEUE); // I think ...
-      IF_PAR_DEBUG(verbose,
-		   debugBelch("==^^ activateSpark: turning spark of closure %p (%s) into a thread\n",
-			      (StgClosure *)spark, info_type((StgClosure *)spark)));
-  }
-  // ToDo: fwd info on local/global spark to thread -- HWL
-  // tso->gran.exported =  spark->exported;
-  // tso->gran.locked =   !spark->global;
-  // tso->gran.sparkname = spark->name;
-
-  return tso;
-}
-#endif
-
-/* ---------------------------------------------------------------------------
- * scheduleThread()
- *
- * scheduleThread puts a thread on the end  of the runnable queue.
- * This will usually be done immediately after a thread is created.
- * The caller of scheduleThread must create the thread using e.g.
- * createThread and push an appropriate closure
- * on this thread's stack before the scheduler is invoked.
- * ------------------------------------------------------------------------ */
-
-void
-scheduleThread(Capability *cap, StgTSO *tso)
-{
-    // The thread goes at the *end* of the run-queue, to avoid possible
-    // starvation of any threads already on the queue.
-    appendToRunQueue(cap,tso);
-}
-
-void
-scheduleThreadOn(Capability *cap, StgWord cpu USED_IF_THREADS, StgTSO *tso)
-{
-#if defined(THREADED_RTS)
-    tso->flags |= TSO_LOCKED; // we requested explicit affinity; don't
-			      // move this thread from now on.
-    cpu %= RtsFlags.ParFlags.nNodes;
-    if (cpu == cap->no) {
-	appendToRunQueue(cap,tso);
-    } else {
-	Capability *target_cap = &capabilities[cpu];
-	if (tso->bound) {
-	    tso->bound->cap = target_cap;
-	}
-	tso->cap = target_cap;
-	wakeupThreadOnCapability(target_cap,tso);
-    }
-#else
-    appendToRunQueue(cap,tso);
-#endif
-}
-
-Capability *
-scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability *cap)
-{
-    Task *task;
-
-    // We already created/initialised the Task
-    task = cap->running_task;
-
-    // This TSO is now a bound thread; make the Task and TSO
-    // point to each other.
-    tso->bound = task;
-    tso->cap = cap;
-
-    task->tso = tso;
-    task->ret = ret;
-    task->stat = NoStatus;
-
-    appendToRunQueue(cap,tso);
-
-    IF_DEBUG(scheduler, sched_belch("new bound thread (%d)", tso->id));
-
-#if defined(GRAN)
-    /* GranSim specific init */
-    CurrentTSO = m->tso;                // the TSO to run
-    procStatus[MainProc] = Busy;        // status of main PE
-    CurrentProc = MainProc;             // PE to run it on
-#endif
-
-    cap = schedule(cap,task);
-
-    ASSERT(task->stat != NoStatus);
-    ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
-
-    IF_DEBUG(scheduler, sched_belch("bound thread (%d) finished", task->tso->id));
-    return cap;
-}
-
-/* ----------------------------------------------------------------------------
- * Starting Tasks
- * ------------------------------------------------------------------------- */
-
-#if defined(THREADED_RTS)
-void
-workerStart(Task *task)
-{
-    Capability *cap;
-
-    // See startWorkerTask().
-    ACQUIRE_LOCK(&task->lock);
-    cap = task->cap;
-    RELEASE_LOCK(&task->lock);
-
-    // set the thread-local pointer to the Task:
-    taskEnter(task);
-
-    // schedule() runs without a lock.
-    cap = schedule(cap,task);
-
-    // On exit from schedule(), we have a Capability.
-    releaseCapability(cap);
-    taskStop(task);
-}
-#endif
-
-/* ---------------------------------------------------------------------------
- * initScheduler()
- *
- * Initialise the scheduler.  This resets all the queues - if the
- * queues contained any threads, they'll be garbage collected at the
- * next pass.
- *
- * ------------------------------------------------------------------------ */
-
-void 
-initScheduler(void)
-{
-#if defined(GRAN)
-  nat i;
-  for (i=0; i<=MAX_PROC; i++) {
-    run_queue_hds[i]      = END_TSO_QUEUE;
-    run_queue_tls[i]      = END_TSO_QUEUE;
-    blocked_queue_hds[i]  = END_TSO_QUEUE;
-    blocked_queue_tls[i]  = END_TSO_QUEUE;
-    ccalling_threadss[i]  = END_TSO_QUEUE;
-    blackhole_queue[i]    = END_TSO_QUEUE;
-    sleeping_queue        = END_TSO_QUEUE;
-  }
-#elif !defined(THREADED_RTS)
-  blocked_queue_hd  = END_TSO_QUEUE;
-  blocked_queue_tl  = END_TSO_QUEUE;
-  sleeping_queue    = END_TSO_QUEUE;
-#endif
-
-  blackhole_queue   = END_TSO_QUEUE;
-  all_threads       = END_TSO_QUEUE;
-
-  context_switch = 0;
-  sched_state    = SCHED_RUNNING;
-
-  RtsFlags.ConcFlags.ctxtSwitchTicks =
-      RtsFlags.ConcFlags.ctxtSwitchTime / TICK_MILLISECS;
-      
-#if defined(THREADED_RTS)
-  /* Initialise the mutex and condition variables used by
-   * the scheduler. */
-  initMutex(&sched_mutex);
-#endif
-  
-  ACQUIRE_LOCK(&sched_mutex);
-
-  /* A capability holds the state a native thread needs in
-   * order to execute STG code. At least one capability is
-   * floating around (only THREADED_RTS builds have more than one).
-   */
-  initCapabilities();
-
-  initTaskManager();
-
-#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL)
-  initSparkPools();
-#endif
-
-#if defined(THREADED_RTS)
-  /*
-   * Eagerly start one worker to run each Capability, except for
-   * Capability 0.  The idea is that we're probably going to start a
-   * bound thread on Capability 0 pretty soon, so we don't want a
-   * worker task hogging it.
-   */
-  { 
-      nat i;
-      Capability *cap;
-      for (i = 1; i < n_capabilities; i++) {
-	  cap = &capabilities[i];
-	  ACQUIRE_LOCK(&cap->lock);
-	  startWorkerTask(cap, workerStart);
-	  RELEASE_LOCK(&cap->lock);
-      }
-  }
-#endif
-
-  RELEASE_LOCK(&sched_mutex);
-}
-
-void
-exitScheduler( void )
-{
-    Task *task = NULL;
-
-#if defined(THREADED_RTS)
-    ACQUIRE_LOCK(&sched_mutex);
-    task = newBoundTask();
-    RELEASE_LOCK(&sched_mutex);
-#endif
-
-    // If we haven't killed all the threads yet, do it now.
-    if (sched_state < SCHED_INTERRUPTED) {
-	sched_state = SCHED_INTERRUPTING;
-	scheduleDoGC(NULL,task,rtsFalse,GetRoots);    
-    }
-    sched_state = SCHED_SHUTTING_DOWN;
-
-#if defined(THREADED_RTS)
-    { 
-	nat i;
-	
-	for (i = 0; i < n_capabilities; i++) {
-	    shutdownCapability(&capabilities[i], task);
-	}
-	boundTaskExiting(task);
-	stopTaskManager();
-    }
-#endif
-}
-
-/* ---------------------------------------------------------------------------
-   Where are the roots that we know about?
-
-        - all the threads on the runnable queue
-        - all the threads on the blocked queue
-        - all the threads on the sleeping queue
-	- all the thread currently executing a _ccall_GC
-        - all the "main threads"
-     
-   ------------------------------------------------------------------------ */
-
-/* This has to be protected either by the scheduler monitor, or by the
-	garbage collection monitor (probably the latter).
-	KH @ 25/10/99
-*/
-
-void
-GetRoots( evac_fn evac )
-{
-    nat i;
-    Capability *cap;
-    Task *task;
-
-#if defined(GRAN)
-    for (i=0; i<=RtsFlags.GranFlags.proc; i++) {
-	if ((run_queue_hds[i] != END_TSO_QUEUE) && ((run_queue_hds[i] != NULL)))
-	    evac((StgClosure **)&run_queue_hds[i]);
-	if ((run_queue_tls[i] != END_TSO_QUEUE) && ((run_queue_tls[i] != NULL)))
-	    evac((StgClosure **)&run_queue_tls[i]);
-	
-	if ((blocked_queue_hds[i] != END_TSO_QUEUE) && ((blocked_queue_hds[i] != NULL)))
-	    evac((StgClosure **)&blocked_queue_hds[i]);
-	if ((blocked_queue_tls[i] != END_TSO_QUEUE) && ((blocked_queue_tls[i] != NULL)))
-	    evac((StgClosure **)&blocked_queue_tls[i]);
-	if ((ccalling_threadss[i] != END_TSO_QUEUE) && ((ccalling_threadss[i] != NULL)))
-	    evac((StgClosure **)&ccalling_threads[i]);
-    }
-
-    markEventQueue();
-
-#else /* !GRAN */
-
-    for (i = 0; i < n_capabilities; i++) {
-	cap = &capabilities[i];
-	evac((StgClosure **)(void *)&cap->run_queue_hd);
-	evac((StgClosure **)(void *)&cap->run_queue_tl);
-#if defined(THREADED_RTS)
-	evac((StgClosure **)(void *)&cap->wakeup_queue_hd);
-	evac((StgClosure **)(void *)&cap->wakeup_queue_tl);
-#endif
-	for (task = cap->suspended_ccalling_tasks; task != NULL; 
-	     task=task->next) {
-	    IF_DEBUG(scheduler,sched_belch("evac'ing suspended TSO %d", task->suspended_tso->id));
-	    evac((StgClosure **)(void *)&task->suspended_tso);
-	}
-
-    }
-    
-
-#if !defined(THREADED_RTS)
-    evac((StgClosure **)(void *)&blocked_queue_hd);
-    evac((StgClosure **)(void *)&blocked_queue_tl);
-    evac((StgClosure **)(void *)&sleeping_queue);
-#endif 
-#endif
-
-    // evac((StgClosure **)&blackhole_queue);
-
-#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL) || defined(GRAN)
-    markSparkQueue(evac);
-#endif
-    
-#if defined(RTS_USER_SIGNALS)
-    // mark the signal handlers (signals should be already blocked)
-    markSignalHandlers(evac);
-#endif
-}
-
-/* -----------------------------------------------------------------------------
-   performGC
-
-   This is the interface to the garbage collector from Haskell land.
-   We provide this so that external C code can allocate and garbage
-   collect when called from Haskell via _ccall_GC.
-
-   It might be useful to provide an interface whereby the programmer
-   can specify more roots (ToDo).
-   
-   This needs to be protected by the GC condition variable above.  KH.
-   -------------------------------------------------------------------------- */
-
-static void (*extra_roots)(evac_fn);
-
-static void
-performGC_(rtsBool force_major, void (*get_roots)(evac_fn))
-{
-    Task *task = myTask();
-
-    if (task == NULL) {
-	ACQUIRE_LOCK(&sched_mutex);
-	task = newBoundTask();
-	RELEASE_LOCK(&sched_mutex);
-	scheduleDoGC(NULL,task,force_major, get_roots);
-	boundTaskExiting(task);
-    } else {
-	scheduleDoGC(NULL,task,force_major, get_roots);
-    }
-}
-
-void
-performGC(void)
-{
-    performGC_(rtsFalse, GetRoots);
-}
-
-void
-performMajorGC(void)
-{
-    performGC_(rtsTrue, GetRoots);
-}
-
-static void
-AllRoots(evac_fn evac)
-{
-    GetRoots(evac);		// the scheduler's roots
-    extra_roots(evac);		// the user's roots
-}
-
-void
-performGCWithRoots(void (*get_roots)(evac_fn))
-{
-    extra_roots = get_roots;
-    performGC_(rtsFalse, AllRoots);
-}
-
-/* -----------------------------------------------------------------------------
-   Stack overflow
-
-   If the thread has reached its maximum stack size, then raise the
-   StackOverflow exception in the offending thread.  Otherwise
-   relocate the TSO into a larger chunk of memory and adjust its stack
-   size appropriately.
-   -------------------------------------------------------------------------- */
-
-static StgTSO *
-threadStackOverflow(Capability *cap, StgTSO *tso)
-{
-  nat new_stack_size, stack_words;
-  lnat new_tso_size;
-  StgPtr new_sp;
-  StgTSO *dest;
-
-  IF_DEBUG(sanity,checkTSO(tso));
-  if (tso->stack_size >= tso->max_stack_size) {
-
-    IF_DEBUG(gc,
-	     debugBelch("@@ threadStackOverflow of TSO %ld (%p): stack too large (now %ld; max is %ld)\n",
-		   (long)tso->id, tso, (long)tso->stack_size, (long)tso->max_stack_size);
-	     /* If we're debugging, just print out the top of the stack */
-	     printStackChunk(tso->sp, stg_min(tso->stack+tso->stack_size, 
-					      tso->sp+64)));
-
-    /* Send this thread the StackOverflow exception */
-    raiseAsync(cap, tso, (StgClosure *)stackOverflow_closure);
-    return tso;
-  }
-
-  /* Try to double the current stack size.  If that takes us over the
-   * maximum stack size for this thread, then use the maximum instead.
-   * Finally round up so the TSO ends up as a whole number of blocks.
-   */
-  new_stack_size = stg_min(tso->stack_size * 2, tso->max_stack_size);
-  new_tso_size   = (lnat)BLOCK_ROUND_UP(new_stack_size * sizeof(W_) + 
-				       TSO_STRUCT_SIZE)/sizeof(W_);
-  new_tso_size = round_to_mblocks(new_tso_size);  /* Be MBLOCK-friendly */
-  new_stack_size = new_tso_size - TSO_STRUCT_SIZEW;
-
-  IF_DEBUG(scheduler, sched_belch("increasing stack size from %ld words to %d.\n", (long)tso->stack_size, new_stack_size));
-
-  dest = (StgTSO *)allocate(new_tso_size);
-  TICK_ALLOC_TSO(new_stack_size,0);
-
-  /* copy the TSO block and the old stack into the new area */
-  memcpy(dest,tso,TSO_STRUCT_SIZE);
-  stack_words = tso->stack + tso->stack_size - tso->sp;
-  new_sp = (P_)dest + new_tso_size - stack_words;
-  memcpy(new_sp, tso->sp, stack_words * sizeof(W_));
-
-  /* relocate the stack pointers... */
-  dest->sp         = new_sp;
-  dest->stack_size = new_stack_size;
-	
-  /* Mark the old TSO as relocated.  We have to check for relocated
-   * TSOs in the garbage collector and any primops that deal with TSOs.
-   *
-   * It's important to set the sp value to just beyond the end
-   * of the stack, so we don't attempt to scavenge any part of the
-   * dead TSO's stack.
-   */
-  tso->what_next = ThreadRelocated;
-  tso->link = dest;
-  tso->sp = (P_)&(tso->stack[tso->stack_size]);
-  tso->why_blocked = NotBlocked;
-
-  IF_PAR_DEBUG(verbose,
-	       debugBelch("@@ threadStackOverflow of TSO %d (now at %p): stack size increased to %ld\n",
-		     tso->id, tso, tso->stack_size);
-	       /* If we're debugging, just print out the top of the stack */
-	       printStackChunk(tso->sp, stg_min(tso->stack+tso->stack_size, 
-						tso->sp+64)));
-  
-  IF_DEBUG(sanity,checkTSO(tso));
-#if 0
-  IF_DEBUG(scheduler,printTSO(dest));
-#endif
-
-  return dest;
-}
-
-/* ---------------------------------------------------------------------------
-   Wake up a queue that was blocked on some resource.
-   ------------------------------------------------------------------------ */
-
-#if defined(GRAN)
-STATIC_INLINE void
-unblockCount ( StgBlockingQueueElement *bqe, StgClosure *node )
-{
-}
-#elif defined(PARALLEL_HASKELL)
-STATIC_INLINE void
-unblockCount ( StgBlockingQueueElement *bqe, StgClosure *node )
-{
-  /* write RESUME events to log file and
-     update blocked and fetch time (depending on type of the orig closure) */
-  if (RtsFlags.ParFlags.ParStats.Full) {
-    DumpRawGranEvent(CURRENT_PROC, CURRENT_PROC, 
-		     GR_RESUMEQ, ((StgTSO *)bqe), ((StgTSO *)bqe)->block_info.closure,
-		     0, 0 /* spark_queue_len(ADVISORY_POOL) */);
-    if (emptyRunQueue())
-      emitSchedule = rtsTrue;
-
-    switch (get_itbl(node)->type) {
-	case FETCH_ME_BQ:
-	  ((StgTSO *)bqe)->par.fetchtime += CURRENT_TIME-((StgTSO *)bqe)->par.blockedat;
-	  break;
-	case RBH:
-	case FETCH_ME:
-	case BLACKHOLE_BQ:
-	  ((StgTSO *)bqe)->par.blocktime += CURRENT_TIME-((StgTSO *)bqe)->par.blockedat;
-	  break;
-#ifdef DIST
-        case MVAR:
-          break;
-#endif	  
-	default:
-	  barf("{unblockOne}Daq Qagh: unexpected closure in blocking queue");
-	}
-      }
-}
-#endif
-
-#if defined(GRAN)
-StgBlockingQueueElement *
-unblockOne(StgBlockingQueueElement *bqe, StgClosure *node)
-{
-    StgTSO *tso;
-    PEs node_loc, tso_loc;
-
-    node_loc = where_is(node); // should be lifted out of loop
-    tso = (StgTSO *)bqe;  // wastes an assignment to get the type right
-    tso_loc = where_is((StgClosure *)tso);
-    if (IS_LOCAL_TO(PROCS(node),tso_loc)) { // TSO is local
-      /* !fake_fetch => TSO is on CurrentProc is same as IS_LOCAL_TO */
-      ASSERT(CurrentProc!=node_loc || tso_loc==CurrentProc);
-      CurrentTime[CurrentProc] += RtsFlags.GranFlags.Costs.lunblocktime;
-      // insertThread(tso, node_loc);
-      new_event(tso_loc, tso_loc, CurrentTime[CurrentProc],
-		ResumeThread,
-		tso, node, (rtsSpark*)NULL);
-      tso->link = END_TSO_QUEUE; // overwrite link just to be sure 
-      // len_local++;
-      // len++;
-    } else { // TSO is remote (actually should be FMBQ)
-      CurrentTime[CurrentProc] += RtsFlags.GranFlags.Costs.mpacktime +
-                                  RtsFlags.GranFlags.Costs.gunblocktime +
-	                          RtsFlags.GranFlags.Costs.latency;
-      new_event(tso_loc, CurrentProc, CurrentTime[CurrentProc],
-		UnblockThread,
-		tso, node, (rtsSpark*)NULL);
-      tso->link = END_TSO_QUEUE; // overwrite link just to be sure 
-      // len++;
-    }
-    /* the thread-queue-overhead is accounted for in either Resume or UnblockThread */
-    IF_GRAN_DEBUG(bq,
-		  debugBelch(" %s TSO %d (%p) [PE %d] (block_info.closure=%p) (next=%p) ,",
-			  (node_loc==tso_loc ? "Local" : "Global"), 
-			  tso->id, tso, CurrentProc, tso->block_info.closure, tso->link));
-    tso->block_info.closure = NULL;
-    IF_DEBUG(scheduler,debugBelch("-- Waking up thread %ld (%p)\n", 
-			     tso->id, tso));
-}
-#elif defined(PARALLEL_HASKELL)
-StgBlockingQueueElement *
-unblockOne(StgBlockingQueueElement *bqe, StgClosure *node)
-{
-    StgBlockingQueueElement *next;
-
-    switch (get_itbl(bqe)->type) {
-    case TSO:
-      ASSERT(((StgTSO *)bqe)->why_blocked != NotBlocked);
-      /* if it's a TSO just push it onto the run_queue */
-      next = bqe->link;
-      ((StgTSO *)bqe)->link = END_TSO_QUEUE; // debugging?
-      APPEND_TO_RUN_QUEUE((StgTSO *)bqe); 
-      threadRunnable();
-      unblockCount(bqe, node);
-      /* reset blocking status after dumping event */
-      ((StgTSO *)bqe)->why_blocked = NotBlocked;
-      break;
-
-    case BLOCKED_FETCH:
-      /* if it's a BLOCKED_FETCH put it on the PendingFetches list */
-      next = bqe->link;
-      bqe->link = (StgBlockingQueueElement *)PendingFetches;
-      PendingFetches = (StgBlockedFetch *)bqe;
-      break;
-
-# if defined(DEBUG)
-      /* can ignore this case in a non-debugging setup; 
-	 see comments on RBHSave closures above */
-    case CONSTR:
-      /* check that the closure is an RBHSave closure */
-      ASSERT(get_itbl((StgClosure *)bqe) == &stg_RBH_Save_0_info ||
-	     get_itbl((StgClosure *)bqe) == &stg_RBH_Save_1_info ||
-	     get_itbl((StgClosure *)bqe) == &stg_RBH_Save_2_info);
-      break;
-
-    default:
-      barf("{unblockOne}Daq Qagh: Unexpected IP (%#lx; %s) in blocking queue at %#lx\n",
-	   get_itbl((StgClosure *)bqe), info_type((StgClosure *)bqe), 
-	   (StgClosure *)bqe);
-# endif
-    }
-  IF_PAR_DEBUG(bq, debugBelch(", %p (%s)\n", bqe, info_type((StgClosure*)bqe)));
-  return next;
-}
-#endif
-
-StgTSO *
-unblockOne(Capability *cap, StgTSO *tso)
-{
-  StgTSO *next;
-
-  ASSERT(get_itbl(tso)->type == TSO);
-  ASSERT(tso->why_blocked != NotBlocked);
-
-  tso->why_blocked = NotBlocked;
-  next = tso->link;
-  tso->link = END_TSO_QUEUE;
-
-#if defined(THREADED_RTS)
-  if (tso->cap == cap || (!tsoLocked(tso) && RtsFlags.ParFlags.wakeupMigrate)) {
-      // We are waking up this thread on the current Capability, which
-      // might involve migrating it from the Capability it was last on.
-      if (tso->bound) {
-	  ASSERT(tso->bound->cap == tso->cap);
-	  tso->bound->cap = cap;
-      }
-      tso->cap = cap;
-      appendToRunQueue(cap,tso);
-      // we're holding a newly woken thread, make sure we context switch
-      // quickly so we can migrate it if necessary.
-      context_switch = 1;
-  } else {
-      // we'll try to wake it up on the Capability it was last on.
-      wakeupThreadOnCapability(tso->cap, tso);
-  }
-#else
-  appendToRunQueue(cap,tso);
-  context_switch = 1;
-#endif
-
-  IF_DEBUG(scheduler,sched_belch("waking up thread %ld on cap %d", (long)tso->id, tso->cap->no));
-  return next;
-}
-
-
-#if defined(GRAN)
-void 
-awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node)
-{
-  StgBlockingQueueElement *bqe;
-  PEs node_loc;
-  nat len = 0; 
-
-  IF_GRAN_DEBUG(bq, 
-		debugBelch("##-_ AwBQ for node %p on PE %d @ %ld by TSO %d (%p): \n", \
-		      node, CurrentProc, CurrentTime[CurrentProc], 
-		      CurrentTSO->id, CurrentTSO));
-
-  node_loc = where_is(node);
-
-  ASSERT(q == END_BQ_QUEUE ||
-	 get_itbl(q)->type == TSO ||   // q is either a TSO or an RBHSave
-	 get_itbl(q)->type == CONSTR); // closure (type constructor)
-  ASSERT(is_unique(node));
-
-  /* FAKE FETCH: magically copy the node to the tso's proc;
-     no Fetch necessary because in reality the node should not have been 
-     moved to the other PE in the first place
-  */
-  if (CurrentProc!=node_loc) {
-    IF_GRAN_DEBUG(bq, 
-		  debugBelch("## node %p is on PE %d but CurrentProc is %d (TSO %d); assuming fake fetch and adjusting bitmask (old: %#x)\n",
-			node, node_loc, CurrentProc, CurrentTSO->id, 
-			// CurrentTSO, where_is(CurrentTSO),
-			node->header.gran.procs));
-    node->header.gran.procs = (node->header.gran.procs) | PE_NUMBER(CurrentProc);
-    IF_GRAN_DEBUG(bq, 
-		  debugBelch("## new bitmask of node %p is %#x\n",
-			node, node->header.gran.procs));
-    if (RtsFlags.GranFlags.GranSimStats.Global) {
-      globalGranStats.tot_fake_fetches++;
-    }
-  }
-
-  bqe = q;
-  // ToDo: check: ASSERT(CurrentProc==node_loc);
-  while (get_itbl(bqe)->type==TSO) { // q != END_TSO_QUEUE) {
-    //next = bqe->link;
-    /* 
-       bqe points to the current element in the queue
-       next points to the next element in the queue
-    */
-    //tso = (StgTSO *)bqe;  // wastes an assignment to get the type right
-    //tso_loc = where_is(tso);
-    len++;
-    bqe = unblockOne(bqe, node);
-  }
-
-  /* if this is the BQ of an RBH, we have to put back the info ripped out of
-     the closure to make room for the anchor of the BQ */
-  if (bqe!=END_BQ_QUEUE) {
-    ASSERT(get_itbl(node)->type == RBH && get_itbl(bqe)->type == CONSTR);
-    /*
-    ASSERT((info_ptr==&RBH_Save_0_info) ||
-	   (info_ptr==&RBH_Save_1_info) ||
-	   (info_ptr==&RBH_Save_2_info));
-    */
-    /* cf. convertToRBH in RBH.c for writing the RBHSave closure */
-    ((StgRBH *)node)->blocking_queue = (StgBlockingQueueElement *)((StgRBHSave *)bqe)->payload[0];
-    ((StgRBH *)node)->mut_link       = (StgMutClosure *)((StgRBHSave *)bqe)->payload[1];
-
-    IF_GRAN_DEBUG(bq,
-		  debugBelch("## Filled in RBH_Save for %p (%s) at end of AwBQ\n",
-			node, info_type(node)));
-  }
-
-  /* statistics gathering */
-  if (RtsFlags.GranFlags.GranSimStats.Global) {
-    // globalGranStats.tot_bq_processing_time += bq_processing_time;
-    globalGranStats.tot_bq_len += len;      // total length of all bqs awakened
-    // globalGranStats.tot_bq_len_local += len_local;  // same for local TSOs only
-    globalGranStats.tot_awbq++;             // total no. of bqs awakened
-  }
-  IF_GRAN_DEBUG(bq,
-		debugBelch("## BQ Stats of %p: [%d entries] %s\n",
-			node, len, (bqe!=END_BQ_QUEUE) ? "RBH" : ""));
-}
-#elif defined(PARALLEL_HASKELL)
-void 
-awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node)
-{
-  StgBlockingQueueElement *bqe;
-
-  IF_PAR_DEBUG(verbose, 
-	       debugBelch("##-_ AwBQ for node %p on [%x]: \n",
-		     node, mytid));
-#ifdef DIST  
-  //RFP
-  if(get_itbl(q)->type == CONSTR || q==END_BQ_QUEUE) {
-    IF_PAR_DEBUG(verbose, debugBelch("## ... nothing to unblock so lets just return. RFP (BUG?)\n"));
-    return;
-  }
-#endif
-  
-  ASSERT(q == END_BQ_QUEUE ||
-	 get_itbl(q)->type == TSO ||           
-  	 get_itbl(q)->type == BLOCKED_FETCH || 
-  	 get_itbl(q)->type == CONSTR); 
-
-  bqe = q;
-  while (get_itbl(bqe)->type==TSO || 
-	 get_itbl(bqe)->type==BLOCKED_FETCH) {
-    bqe = unblockOne(bqe, node);
-  }
-}
-
-#else   /* !GRAN && !PARALLEL_HASKELL */
-
-void
-awakenBlockedQueue(Capability *cap, StgTSO *tso)
-{
-    if (tso == NULL) return; // hack; see bug #1235728, and comments in
-	 		     // Exception.cmm
-    while (tso != END_TSO_QUEUE) {
-	tso = unblockOne(cap,tso);
-    }
-}
-#endif
-
-/* ---------------------------------------------------------------------------
-   Interrupt execution
-   - usually called inside a signal handler so it mustn't do anything fancy.   
-   ------------------------------------------------------------------------ */
-
-void
-interruptStgRts(void)
-{
-    sched_state = SCHED_INTERRUPTING;
-    context_switch = 1;
-#if defined(THREADED_RTS)
-    prodAllCapabilities();
-#endif
-}
-
-/* -----------------------------------------------------------------------------
-   Unblock a thread
-
-   This is for use when we raise an exception in another thread, which
-   may be blocked.
-   This has nothing to do with the UnblockThread event in GranSim. -- HWL
-   -------------------------------------------------------------------------- */
-
-#if defined(GRAN) || defined(PARALLEL_HASKELL)
-/*
-  NB: only the type of the blocking queue is different in GranSim and GUM
-      the operations on the queue-elements are the same
-      long live polymorphism!
-
-  Locks: sched_mutex is held upon entry and exit.
-
-*/
-static void
-unblockThread(Capability *cap, StgTSO *tso)
-{
-  StgBlockingQueueElement *t, **last;
-
-  switch (tso->why_blocked) {
-
-  case NotBlocked:
-    return;  /* not blocked */
-
-  case BlockedOnSTM:
-    // Be careful: nothing to do here!  We tell the scheduler that the thread
-    // is runnable and we leave it to the stack-walking code to abort the 
-    // transaction while unwinding the stack.  We should perhaps have a debugging
-    // test to make sure that this really happens and that the 'zombie' transaction
-    // does not get committed.
-    goto done;
-
-  case BlockedOnMVar:
-    ASSERT(get_itbl(tso->block_info.closure)->type == MVAR);
-    {
-      StgBlockingQueueElement *last_tso = END_BQ_QUEUE;
-      StgMVar *mvar = (StgMVar *)(tso->block_info.closure);
-
-      last = (StgBlockingQueueElement **)&mvar->head;
-      for (t = (StgBlockingQueueElement *)mvar->head; 
-	   t != END_BQ_QUEUE; 
-	   last = &t->link, last_tso = t, t = t->link) {
-	if (t == (StgBlockingQueueElement *)tso) {
-	  *last = (StgBlockingQueueElement *)tso->link;
-	  if (mvar->tail == tso) {
-	    mvar->tail = (StgTSO *)last_tso;
-	  }
-	  goto done;
-	}
-      }
-      barf("unblockThread (MVAR): TSO not found");
-    }
-
-  case BlockedOnBlackHole:
-    ASSERT(get_itbl(tso->block_info.closure)->type == BLACKHOLE_BQ);
-    {
-      StgBlockingQueue *bq = (StgBlockingQueue *)(tso->block_info.closure);
-
-      last = &bq->blocking_queue;
-      for (t = bq->blocking_queue; 
-	   t != END_BQ_QUEUE; 
-	   last = &t->link, t = t->link) {
-	if (t == (StgBlockingQueueElement *)tso) {
-	  *last = (StgBlockingQueueElement *)tso->link;
-	  goto done;
-	}
-      }
-      barf("unblockThread (BLACKHOLE): TSO not found");
-    }
-
-  case BlockedOnException:
-    {
-      StgTSO *target  = tso->block_info.tso;
-
-      ASSERT(get_itbl(target)->type == TSO);
-
-      if (target->what_next == ThreadRelocated) {
-	  target = target->link;
-	  ASSERT(get_itbl(target)->type == TSO);
-      }
-
-      ASSERT(target->blocked_exceptions != NULL);
-
-      last = (StgBlockingQueueElement **)&target->blocked_exceptions;
-      for (t = (StgBlockingQueueElement *)target->blocked_exceptions; 
-	   t != END_BQ_QUEUE; 
-	   last = &t->link, t = t->link) {
-	ASSERT(get_itbl(t)->type == TSO);
-	if (t == (StgBlockingQueueElement *)tso) {
-	  *last = (StgBlockingQueueElement *)tso->link;
-	  goto done;
-	}
-      }
-      barf("unblockThread (Exception): TSO not found");
-    }
-
-  case BlockedOnRead:
-  case BlockedOnWrite:
-#if defined(mingw32_HOST_OS)
-  case BlockedOnDoProc:
-#endif
-    {
-      /* take TSO off blocked_queue */
-      StgBlockingQueueElement *prev = NULL;
-      for (t = (StgBlockingQueueElement *)blocked_queue_hd; t != END_BQ_QUEUE; 
-	   prev = t, t = t->link) {
-	if (t == (StgBlockingQueueElement *)tso) {
-	  if (prev == NULL) {
-	    blocked_queue_hd = (StgTSO *)t->link;
-	    if ((StgBlockingQueueElement *)blocked_queue_tl == t) {
-	      blocked_queue_tl = END_TSO_QUEUE;
-	    }
-	  } else {
-	    prev->link = t->link;
-	    if ((StgBlockingQueueElement *)blocked_queue_tl == t) {
-	      blocked_queue_tl = (StgTSO *)prev;
-	    }
-	  }
-#if defined(mingw32_HOST_OS)
-	  /* (Cooperatively) signal that the worker thread should abort
-	   * the request.
-	   */
-	  abandonWorkRequest(tso->block_info.async_result->reqID);
-#endif
-	  goto done;
-	}
-      }
-      barf("unblockThread (I/O): TSO not found");
-    }
-
-  case BlockedOnDelay:
-    {
-      /* take TSO off sleeping_queue */
-      StgBlockingQueueElement *prev = NULL;
-      for (t = (StgBlockingQueueElement *)sleeping_queue; t != END_BQ_QUEUE; 
-	   prev = t, t = t->link) {
-	if (t == (StgBlockingQueueElement *)tso) {
-	  if (prev == NULL) {
-	    sleeping_queue = (StgTSO *)t->link;
-	  } else {
-	    prev->link = t->link;
-	  }
-	  goto done;
-	}
-      }
-      barf("unblockThread (delay): TSO not found");
-    }
-
-  default:
-    barf("unblockThread");
-  }
-
- done:
-  tso->link = END_TSO_QUEUE;
-  tso->why_blocked = NotBlocked;
-  tso->block_info.closure = NULL;
-  pushOnRunQueue(cap,tso);
-}
-#else
-static void
-unblockThread(Capability *cap, StgTSO *tso)
-{
-  StgTSO *t, **last;
-  
-  /* To avoid locking unnecessarily. */
-  if (tso->why_blocked == NotBlocked) {
-    return;
-  }
-
-  switch (tso->why_blocked) {
-
-  case BlockedOnSTM:
-    // Be careful: nothing to do here!  We tell the scheduler that the thread
-    // is runnable and we leave it to the stack-walking code to abort the 
-    // transaction while unwinding the stack.  We should perhaps have a debugging
-    // test to make sure that this really happens and that the 'zombie' transaction
-    // does not get committed.
-    goto done;
-
-  case BlockedOnMVar:
-    ASSERT(get_itbl(tso->block_info.closure)->type == MVAR);
-    {
-      StgTSO *last_tso = END_TSO_QUEUE;
-      StgMVar *mvar = (StgMVar *)(tso->block_info.closure);
-
-      last = &mvar->head;
-      for (t = mvar->head; t != END_TSO_QUEUE; 
-	   last = &t->link, last_tso = t, t = t->link) {
-	if (t == tso) {
-	  *last = tso->link;
-	  if (mvar->tail == tso) {
-	    mvar->tail = last_tso;
-	  }
-	  goto done;
-	}
-      }
-      barf("unblockThread (MVAR): TSO not found");
-    }
-
-  case BlockedOnBlackHole:
-    {
-      last = &blackhole_queue;
-      for (t = blackhole_queue; t != END_TSO_QUEUE; 
-	   last = &t->link, t = t->link) {
-	if (t == tso) {
-	  *last = tso->link;
-	  goto done;
-	}
-      }
-      barf("unblockThread (BLACKHOLE): TSO not found");
-    }
-
-  case BlockedOnException:
-    {
-      StgTSO *target  = tso->block_info.tso;
-
-      ASSERT(get_itbl(target)->type == TSO);
-
-      while (target->what_next == ThreadRelocated) {
-	  target = target->link;
-	  ASSERT(get_itbl(target)->type == TSO);
-      }
-      
-      ASSERT(target->blocked_exceptions != NULL);
-
-      last = &target->blocked_exceptions;
-      for (t = target->blocked_exceptions; t != END_TSO_QUEUE; 
-	   last = &t->link, t = t->link) {
-	ASSERT(get_itbl(t)->type == TSO);
-	if (t == tso) {
-	  *last = tso->link;
-	  goto done;
-	}
-      }
-      barf("unblockThread (Exception): TSO not found");
-    }
-
-#if !defined(THREADED_RTS)
-  case BlockedOnRead:
-  case BlockedOnWrite:
-#if defined(mingw32_HOST_OS)
-  case BlockedOnDoProc:
-#endif
-    {
-      StgTSO *prev = NULL;
-      for (t = blocked_queue_hd; t != END_TSO_QUEUE; 
-	   prev = t, t = t->link) {
-	if (t == tso) {
-	  if (prev == NULL) {
-	    blocked_queue_hd = t->link;
-	    if (blocked_queue_tl == t) {
-	      blocked_queue_tl = END_TSO_QUEUE;
-	    }
-	  } else {
-	    prev->link = t->link;
-	    if (blocked_queue_tl == t) {
-	      blocked_queue_tl = prev;
-	    }
-	  }
-#if defined(mingw32_HOST_OS)
-	  /* (Cooperatively) signal that the worker thread should abort
-	   * the request.
-	   */
-	  abandonWorkRequest(tso->block_info.async_result->reqID);
-#endif
-	  goto done;
-	}
-      }
-      barf("unblockThread (I/O): TSO not found");
-    }
-
-  case BlockedOnDelay:
-    {
-      StgTSO *prev = NULL;
-      for (t = sleeping_queue; t != END_TSO_QUEUE; 
-	   prev = t, t = t->link) {
-	if (t == tso) {
-	  if (prev == NULL) {
-	    sleeping_queue = t->link;
-	  } else {
-	    prev->link = t->link;
-	  }
-	  goto done;
-	}
-      }
-      barf("unblockThread (delay): TSO not found");
-    }
-#endif
-
-  default:
-    barf("unblockThread");
-  }
-
- done:
-  tso->link = END_TSO_QUEUE;
-  tso->why_blocked = NotBlocked;
-  tso->block_info.closure = NULL;
-  appendToRunQueue(cap,tso);
-
-  // We might have just migrated this TSO to our Capability:
-  if (tso->bound) {
-      tso->bound->cap = cap;
-  }
-  tso->cap = cap;
-}
-#endif
-
-/* -----------------------------------------------------------------------------
- * checkBlackHoles()
- *
- * Check the blackhole_queue for threads that can be woken up.  We do
- * this periodically: before every GC, and whenever the run queue is
- * empty.
- *
- * An elegant solution might be to just wake up all the blocked
- * threads with awakenBlockedQueue occasionally: they'll go back to
- * sleep again if the object is still a BLACKHOLE.  Unfortunately this
- * doesn't give us a way to tell whether we've actually managed to
- * wake up any threads, so we would be busy-waiting.
- *
- * -------------------------------------------------------------------------- */
-
-static rtsBool
-checkBlackHoles (Capability *cap)
-{
-    StgTSO **prev, *t;
-    rtsBool any_woke_up = rtsFalse;
-    StgHalfWord type;
-
-    // blackhole_queue is global:
-    ASSERT_LOCK_HELD(&sched_mutex);
-
-    IF_DEBUG(scheduler, sched_belch("checking threads blocked on black holes"));
-
-    // ASSUMES: sched_mutex
-    prev = &blackhole_queue;
-    t = blackhole_queue;
-    while (t != END_TSO_QUEUE) {
-	ASSERT(t->why_blocked == BlockedOnBlackHole);
-	type = get_itbl(t->block_info.closure)->type;
-	if (type != BLACKHOLE && type != CAF_BLACKHOLE) {
-	    IF_DEBUG(sanity,checkTSO(t));
-	    t = unblockOne(cap, t);
-	    // urk, the threads migrate to the current capability
-	    // here, but we'd like to keep them on the original one.
-	    *prev = t;
-	    any_woke_up = rtsTrue;
-	} else {
-	    prev = &t->link;
-	    t = t->link;
-	}
-    }
-
-    return any_woke_up;
-}
-
-/* -----------------------------------------------------------------------------
- * raiseAsync()
- *
- * The following function implements the magic for raising an
- * asynchronous exception in an existing thread.
- *
- * We first remove the thread from any queue on which it might be
- * blocked.  The possible blockages are MVARs and BLACKHOLE_BQs.
- *
- * We strip the stack down to the innermost CATCH_FRAME, building
- * thunks in the heap for all the active computations, so they can 
- * be restarted if necessary.  When we reach a CATCH_FRAME, we build
- * an application of the handler to the exception, and push it on
- * the top of the stack.
- * 
- * How exactly do we save all the active computations?  We create an
- * AP_STACK for every UpdateFrame on the stack.  Entering one of these
- * AP_STACKs pushes everything from the corresponding update frame
- * upwards onto the stack.  (Actually, it pushes everything up to the
- * next update frame plus a pointer to the next AP_STACK object.
- * Entering the next AP_STACK object pushes more onto the stack until we
- * reach the last AP_STACK object - at which point the stack should look
- * exactly as it did when we killed the TSO and we can continue
- * execution by entering the closure on top of the stack.
- *
- * We can also kill a thread entirely - this happens if either (a) the 
- * exception passed to raiseAsync is NULL, or (b) there's no
- * CATCH_FRAME on the stack.  In either case, we strip the entire
- * stack and replace the thread with a zombie.
- *
- * ToDo: in THREADED_RTS mode, this function is only safe if either
- * (a) we hold all the Capabilities (eg. in GC, or if there is only
- * one Capability), or (b) we own the Capability that the TSO is
- * currently blocked on or on the run queue of.
- *
- * -------------------------------------------------------------------------- */
- 
-void
-raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception)
-{
-    raiseAsync_(cap, tso, exception, rtsFalse, NULL);
-}
-
-void
-suspendComputation(Capability *cap, StgTSO *tso, StgPtr stop_here)
-{
-    raiseAsync_(cap, tso, NULL, rtsFalse, stop_here);
-}
-
-static void
-raiseAsync_(Capability *cap, StgTSO *tso, StgClosure *exception, 
-	    rtsBool stop_at_atomically, StgPtr stop_here)
-{
-    StgRetInfoTable *info;
-    StgPtr sp, frame;
-    nat i;
-  
-    // Thread already dead?
-    if (tso->what_next == ThreadComplete || tso->what_next == ThreadKilled) {
-	return;
-    }
-
-    IF_DEBUG(scheduler, 
-	     sched_belch("raising exception in thread %ld.", (long)tso->id));
-    
-    // Remove it from any blocking queues
-    unblockThread(cap,tso);
-
-    // mark it dirty; we're about to change its stack.
-    dirtyTSO(tso);
-
-    sp = tso->sp;
-    
-    // The stack freezing code assumes there's a closure pointer on
-    // the top of the stack, so we have to arrange that this is the case...
-    //
-    if (sp[0] == (W_)&stg_enter_info) {
-	sp++;
-    } else {
-	sp--;
-	sp[0] = (W_)&stg_dummy_ret_closure;
-    }
-
-    frame = sp + 1;
-    while (stop_here == NULL || frame < stop_here) {
-
-	// 1. Let the top of the stack be the "current closure"
-	//
-	// 2. Walk up the stack until we find either an UPDATE_FRAME or a
-	// CATCH_FRAME.
-	//
-	// 3. If it's an UPDATE_FRAME, then make an AP_STACK containing the
-	// current closure applied to the chunk of stack up to (but not
-	// including) the update frame.  This closure becomes the "current
-	// closure".  Go back to step 2.
-	//
-	// 4. If it's a CATCH_FRAME, then leave the exception handler on
-	// top of the stack applied to the exception.
-	// 
-	// 5. If it's a STOP_FRAME, then kill the thread.
-        // 
-        // NB: if we pass an ATOMICALLY_FRAME then abort the associated 
-        // transaction
-       
-	info = get_ret_itbl((StgClosure *)frame);
-
-	switch (info->i.type) {
-
-	case UPDATE_FRAME:
-	{
-	    StgAP_STACK * ap;
-	    nat words;
-	    
-	    // First build an AP_STACK consisting of the stack chunk above the
-	    // current update frame, with the top word on the stack as the
-	    // fun field.
-	    //
-	    words = frame - sp - 1;
-	    ap = (StgAP_STACK *)allocateLocal(cap,AP_STACK_sizeW(words));
-	    
-	    ap->size = words;
-	    ap->fun  = (StgClosure *)sp[0];
-	    sp++;
-	    for(i=0; i < (nat)words; ++i) {
-		ap->payload[i] = (StgClosure *)*sp++;
-	    }
-	    
-	    SET_HDR(ap,&stg_AP_STACK_info,
-		    ((StgClosure *)frame)->header.prof.ccs /* ToDo */); 
-	    TICK_ALLOC_UP_THK(words+1,0);
-	    
-	    IF_DEBUG(scheduler,
-		     debugBelch("sched: Updating ");
-		     printPtr((P_)((StgUpdateFrame *)frame)->updatee); 
-		     debugBelch(" with ");
-		     printObj((StgClosure *)ap);
-		);
-
-	    // Replace the updatee with an indirection
-	    //
-	    // Warning: if we're in a loop, more than one update frame on
-	    // the stack may point to the same object.  Be careful not to
-	    // overwrite an IND_OLDGEN in this case, because we'll screw
-	    // up the mutable lists.  To be on the safe side, don't
-	    // overwrite any kind of indirection at all.  See also
-	    // threadSqueezeStack in GC.c, where we have to make a similar
-	    // check.
-	    //
-	    if (!closure_IND(((StgUpdateFrame *)frame)->updatee)) {
-		// revert the black hole
-		UPD_IND_NOLOCK(((StgUpdateFrame *)frame)->updatee,
-			       (StgClosure *)ap);
-	    }
-	    sp += sizeofW(StgUpdateFrame) - 1;
-	    sp[0] = (W_)ap; // push onto stack
-	    frame = sp + 1;
-	    continue; //no need to bump frame
-	}
-
-	case STOP_FRAME:
-	    // We've stripped the entire stack, the thread is now dead.
-	    tso->what_next = ThreadKilled;
-	    tso->sp = frame + sizeofW(StgStopFrame);
-	    return;
-
-	case CATCH_FRAME:
-	    // If we find a CATCH_FRAME, and we've got an exception to raise,
-	    // then build the THUNK raise(exception), and leave it on
-	    // top of the CATCH_FRAME ready to enter.
-	    //
-	{
-#ifdef PROFILING
-	    StgCatchFrame *cf = (StgCatchFrame *)frame;
-#endif
-	    StgThunk *raise;
-	    
-	    if (exception == NULL) break;
-
-	    // we've got an exception to raise, so let's pass it to the
-	    // handler in this frame.
-	    //
-	    raise = (StgThunk *)allocateLocal(cap,sizeofW(StgThunk)+1);
-	    TICK_ALLOC_SE_THK(1,0);
-	    SET_HDR(raise,&stg_raise_info,cf->header.prof.ccs);
-	    raise->payload[0] = exception;
-	    
-	    // throw away the stack from Sp up to the CATCH_FRAME.
-	    //
-	    sp = frame - 1;
-	    
-	    /* Ensure that async excpetions are blocked now, so we don't get
-	     * a surprise exception before we get around to executing the
-	     * handler.
-	     */
-	    if (tso->blocked_exceptions == NULL) {
-		tso->blocked_exceptions = END_TSO_QUEUE;
-	    }
-
-	    /* Put the newly-built THUNK on top of the stack, ready to execute
-	     * when the thread restarts.
-	     */
-	    sp[0] = (W_)raise;
-	    sp[-1] = (W_)&stg_enter_info;
-	    tso->sp = sp-1;
-	    tso->what_next = ThreadRunGHC;
-	    IF_DEBUG(sanity, checkTSO(tso));
-	    return;
-	}
-	    
-	case ATOMICALLY_FRAME:
-	    if (stop_at_atomically) {
-		ASSERT(stmGetEnclosingTRec(tso->trec) == NO_TREC);
-		stmCondemnTransaction(cap, tso -> trec);
-#ifdef REG_R1
-		tso->sp = frame;
-#else
-		// R1 is not a register: the return convention for IO in
-		// this case puts the return value on the stack, so we
-		// need to set up the stack to return to the atomically
-		// frame properly...
-		tso->sp = frame - 2;
-		tso->sp[1] = (StgWord) &stg_NO_FINALIZER_closure; // why not?
-		tso->sp[0] = (StgWord) &stg_ut_1_0_unreg_info;
-#endif
-		tso->what_next = ThreadRunGHC;
-		return;
-	    }
-	    // Not stop_at_atomically... fall through and abort the
-	    // transaction.
-	    
-	case CATCH_RETRY_FRAME:
-	    // IF we find an ATOMICALLY_FRAME then we abort the
-	    // current transaction and propagate the exception.  In
-	    // this case (unlike ordinary exceptions) we do not care
-	    // whether the transaction is valid or not because its
-	    // possible validity cannot have caused the exception
-	    // and will not be visible after the abort.
-	    IF_DEBUG(stm,
-		     debugBelch("Found atomically block delivering async exception\n"));
-            StgTRecHeader *trec = tso -> trec;
-            StgTRecHeader *outer = stmGetEnclosingTRec(trec);
-            stmAbortTransaction(cap, trec);
-            tso -> trec = outer;
-	    break;
-	    
-	default:
-	    break;
-	}
-
-	// move on to the next stack frame
-	frame += stack_frame_sizeW((StgClosure *)frame);
-    }
-
-    // if we got here, then we stopped at stop_here
-    ASSERT(stop_here != NULL);
-}
-
-/* -----------------------------------------------------------------------------
-   Deleting threads
-
-   This is used for interruption (^C) and forking, and corresponds to
-   raising an exception but without letting the thread catch the
-   exception.
-   -------------------------------------------------------------------------- */
-
-static void 
-deleteThread (Capability *cap, StgTSO *tso)
-{
-  if (tso->why_blocked != BlockedOnCCall &&
-      tso->why_blocked != BlockedOnCCall_NoUnblockExc) {
-      raiseAsync(cap,tso,NULL);
-  }
-}
-
-#ifdef FORKPROCESS_PRIMOP_SUPPORTED
-static void 
-deleteThread_(Capability *cap, StgTSO *tso)
-{ // for forkProcess only:
-  // like deleteThread(), but we delete threads in foreign calls, too.
-
-    if (tso->why_blocked == BlockedOnCCall ||
-	tso->why_blocked == BlockedOnCCall_NoUnblockExc) {
-	unblockOne(cap,tso);
-	tso->what_next = ThreadKilled;
-    } else {
-	deleteThread(cap,tso);
-    }
-}
-#endif
-
-/* -----------------------------------------------------------------------------
-   raiseExceptionHelper
-   
-   This function is called by the raise# primitve, just so that we can
-   move some of the tricky bits of raising an exception from C-- into
-   C.  Who knows, it might be a useful re-useable thing here too.
-   -------------------------------------------------------------------------- */
-
-StgWord
-raiseExceptionHelper (StgRegTable *reg, StgTSO *tso, StgClosure *exception)
-{
-    Capability *cap = regTableToCapability(reg);
-    StgThunk *raise_closure = NULL;
-    StgPtr p, next;
-    StgRetInfoTable *info;
-    //
-    // This closure represents the expression 'raise# E' where E
-    // is the exception raise.  It is used to overwrite all the
-    // thunks which are currently under evaluataion.
-    //
-
-    // OLD COMMENT (we don't have MIN_UPD_SIZE now):
-    // LDV profiling: stg_raise_info has THUNK as its closure
-    // type. Since a THUNK takes at least MIN_UPD_SIZE words in its
-    // payload, MIN_UPD_SIZE is more approprate than 1.  It seems that
-    // 1 does not cause any problem unless profiling is performed.
-    // However, when LDV profiling goes on, we need to linearly scan
-    // small object pool, where raise_closure is stored, so we should
-    // use MIN_UPD_SIZE.
-    //
-    // raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
-    // 				       sizeofW(StgClosure)+1);
-    //
-
-    //
-    // Walk up the stack, looking for the catch frame.  On the way,
-    // we update any closures pointed to from update frames with the
-    // raise closure that we just built.
-    //
-    p = tso->sp;
-    while(1) {
-	info = get_ret_itbl((StgClosure *)p);
-	next = p + stack_frame_sizeW((StgClosure *)p);
-	switch (info->i.type) {
-	    
-	case UPDATE_FRAME:
-	    // Only create raise_closure if we need to.
-	    if (raise_closure == NULL) {
-		raise_closure = 
-		    (StgThunk *)allocateLocal(cap,sizeofW(StgThunk)+1);
-		SET_HDR(raise_closure, &stg_raise_info, CCCS);
-		raise_closure->payload[0] = exception;
-	    }
-	    UPD_IND(((StgUpdateFrame *)p)->updatee,(StgClosure *)raise_closure);
-	    p = next;
-	    continue;
-
-        case ATOMICALLY_FRAME:
-            IF_DEBUG(stm, debugBelch("Found ATOMICALLY_FRAME at %p\n", p));
-            tso->sp = p;
-            return ATOMICALLY_FRAME;
-	    
-	case CATCH_FRAME:
-	    tso->sp = p;
-	    return CATCH_FRAME;
-
-        case CATCH_STM_FRAME:
-            IF_DEBUG(stm, debugBelch("Found CATCH_STM_FRAME at %p\n", p));
-            tso->sp = p;
-            return CATCH_STM_FRAME;
-	    
-	case STOP_FRAME:
-	    tso->sp = p;
-	    return STOP_FRAME;
-
-        case CATCH_RETRY_FRAME:
-	default:
-	    p = next; 
-	    continue;
-	}
-    }
-}
-
-
-/* -----------------------------------------------------------------------------
-   findRetryFrameHelper
-
-   This function is called by the retry# primitive.  It traverses the stack
-   leaving tso->sp referring to the frame which should handle the retry.  
-
-   This should either be a CATCH_RETRY_FRAME (if the retry# is within an orElse#) 
-   or should be a ATOMICALLY_FRAME (if the retry# reaches the top level).  
-
-   We skip CATCH_STM_FRAMEs because retries are not considered to be exceptions,
-   despite the similar implementation.
-
-   We should not expect to see CATCH_FRAME or STOP_FRAME because those should
-   not be created within memory transactions.
-   -------------------------------------------------------------------------- */
-
-StgWord
-findRetryFrameHelper (StgTSO *tso)
-{
-  StgPtr           p, next;
-  StgRetInfoTable *info;
-
-  p = tso -> sp;
-  while (1) {
-    info = get_ret_itbl((StgClosure *)p);
-    next = p + stack_frame_sizeW((StgClosure *)p);
-    switch (info->i.type) {
-      
-    case ATOMICALLY_FRAME:
-      IF_DEBUG(stm, debugBelch("Found ATOMICALLY_FRAME at %p during retrry\n", p));
-      tso->sp = p;
-      return ATOMICALLY_FRAME;
-      
-    case CATCH_RETRY_FRAME:
-      IF_DEBUG(stm, debugBelch("Found CATCH_RETRY_FRAME at %p during retrry\n", p));
-      tso->sp = p;
-      return CATCH_RETRY_FRAME;
-      
-    case CATCH_STM_FRAME:
-    default:
-      ASSERT(info->i.type != CATCH_FRAME);
-      ASSERT(info->i.type != STOP_FRAME);
-      p = next; 
-      continue;
-    }
-  }
-}
-
-/* -----------------------------------------------------------------------------
-   resurrectThreads is called after garbage collection on the list of
-   threads found to be garbage.  Each of these threads will be woken
-   up and sent a signal: BlockedOnDeadMVar if the thread was blocked
-   on an MVar, or NonTermination if the thread was blocked on a Black
-   Hole.
-
-   Locks: assumes we hold *all* the capabilities.
-   -------------------------------------------------------------------------- */
-
-void
-resurrectThreads (StgTSO *threads)
-{
-    StgTSO *tso, *next;
-    Capability *cap;
-
-    for (tso = threads; tso != END_TSO_QUEUE; tso = next) {
-	next = tso->global_link;
-	tso->global_link = all_threads;
-	all_threads = tso;
-	IF_DEBUG(scheduler, sched_belch("resurrecting thread %d", tso->id));
-	
-	// Wake up the thread on the Capability it was last on
-	cap = tso->cap;
-	
-	switch (tso->why_blocked) {
-	case BlockedOnMVar:
-	case BlockedOnException:
-	    /* Called by GC - sched_mutex lock is currently held. */
-	    raiseAsync(cap, tso,(StgClosure *)BlockedOnDeadMVar_closure);
-	    break;
-	case BlockedOnBlackHole:
-	    raiseAsync(cap, tso,(StgClosure *)NonTermination_closure);
-	    break;
-	case BlockedOnSTM:
-	    raiseAsync(cap, tso,(StgClosure *)BlockedIndefinitely_closure);
-	    break;
-	case NotBlocked:
-	    /* This might happen if the thread was blocked on a black hole
-	     * belonging to a thread that we've just woken up (raiseAsync
-	     * can wake up threads, remember...).
-	     */
-	    continue;
-	default:
-	    barf("resurrectThreads: thread blocked in a strange way");
-	}
-    }
-}
-
-/* ----------------------------------------------------------------------------
- * Debugging: why is a thread blocked
- * [Also provides useful information when debugging threaded programs
- *  at the Haskell source code level, so enable outside of DEBUG. --sof 7/02]
-   ------------------------------------------------------------------------- */
-
-#if DEBUG
-static void
-printThreadBlockage(StgTSO *tso)
-{
-  switch (tso->why_blocked) {
-  case BlockedOnRead:
-    debugBelch("is blocked on read from fd %d", (int)(tso->block_info.fd));
-    break;
-  case BlockedOnWrite:
-    debugBelch("is blocked on write to fd %d", (int)(tso->block_info.fd));
-    break;
-#if defined(mingw32_HOST_OS)
-    case BlockedOnDoProc:
-    debugBelch("is blocked on proc (request: %ld)", tso->block_info.async_result->reqID);
-    break;
-#endif
-  case BlockedOnDelay:
-    debugBelch("is blocked until %ld", (long)(tso->block_info.target));
-    break;
-  case BlockedOnMVar:
-    debugBelch("is blocked on an MVar @ %p", tso->block_info.closure);
-    break;
-  case BlockedOnException:
-    debugBelch("is blocked on delivering an exception to thread %d",
-	    tso->block_info.tso->id);
-    break;
-  case BlockedOnBlackHole:
-    debugBelch("is blocked on a black hole");
-    break;
-  case NotBlocked:
-    debugBelch("is not blocked");
-    break;
-#if defined(PARALLEL_HASKELL)
-  case BlockedOnGA:
-    debugBelch("is blocked on global address; local FM_BQ is %p (%s)",
-	    tso->block_info.closure, info_type(tso->block_info.closure));
-    break;
-  case BlockedOnGA_NoSend:
-    debugBelch("is blocked on global address (no send); local FM_BQ is %p (%s)",
-	    tso->block_info.closure, info_type(tso->block_info.closure));
-    break;
-#endif
-  case BlockedOnCCall:
-    debugBelch("is blocked on an external call");
-    break;
-  case BlockedOnCCall_NoUnblockExc:
-    debugBelch("is blocked on an external call (exceptions were already blocked)");
-    break;
-  case BlockedOnSTM:
-    debugBelch("is blocked on an STM operation");
-    break;
-  default:
-    barf("printThreadBlockage: strange tso->why_blocked: %d for TSO %d (%d)",
-	 tso->why_blocked, tso->id, tso);
-  }
-}
-
-void
-printThreadStatus(StgTSO *t)
-{
-    debugBelch("\tthread %4d @ %p ", t->id, (void *)t);
-    {
-      void *label = lookupThreadLabel(t->id);
-      if (label) debugBelch("[\"%s\"] ",(char *)label);
-    }
-    if (t->what_next == ThreadRelocated) {
-	debugBelch("has been relocated...\n");
-    } else {
-	switch (t->what_next) {
-	case ThreadKilled:
-	    debugBelch("has been killed");
-	    break;
-	case ThreadComplete:
-	    debugBelch("has completed");
-	    break;
-	default:
-	    printThreadBlockage(t);
-	}
-	debugBelch("\n");
-    }
-}
-
-void
-printAllThreads(void)
-{
-  StgTSO *t, *next;
-  nat i;
-  Capability *cap;
-
-# if defined(GRAN)
-  char time_string[TIME_STR_LEN], node_str[NODE_STR_LEN];
-  ullong_format_string(TIME_ON_PROC(CurrentProc), 
-		       time_string, rtsFalse/*no commas!*/);
-
-  debugBelch("all threads at [%s]:\n", time_string);
-# elif defined(PARALLEL_HASKELL)
-  char time_string[TIME_STR_LEN], node_str[NODE_STR_LEN];
-  ullong_format_string(CURRENT_TIME,
-		       time_string, rtsFalse/*no commas!*/);
-
-  debugBelch("all threads at [%s]:\n", time_string);
-# else
-  debugBelch("all threads:\n");
-# endif
-
-  for (i = 0; i < n_capabilities; i++) {
-      cap = &capabilities[i];
-      debugBelch("threads on capability %d:\n", cap->no);
-      for (t = cap->run_queue_hd; t != END_TSO_QUEUE; t = t->link) {
-	  printThreadStatus(t);
-      }
-  }
-
-  debugBelch("other threads:\n");
-  for (t = all_threads; t != END_TSO_QUEUE; t = next) {
-      if (t->why_blocked != NotBlocked) {
-	  printThreadStatus(t);
-      }
-      if (t->what_next == ThreadRelocated) {
-	  next = t->link;
-      } else {
-	  next = t->global_link;
-      }
-  }
-}
-
-// useful from gdb
-void 
-printThreadQueue(StgTSO *t)
-{
-    nat i = 0;
-    for (; t != END_TSO_QUEUE; t = t->link) {
-	printThreadStatus(t);
-	i++;
-    }
-    debugBelch("%d threads on queue\n", i);
-}
-
-/* 
-   Print a whole blocking queue attached to node (debugging only).
-*/
-# if defined(PARALLEL_HASKELL)
-void 
-print_bq (StgClosure *node)
-{
-  StgBlockingQueueElement *bqe;
-  StgTSO *tso;
-  rtsBool end;
-
-  debugBelch("## BQ of closure %p (%s): ",
-	  node, info_type(node));
-
-  /* should cover all closures that may have a blocking queue */
-  ASSERT(get_itbl(node)->type == BLACKHOLE_BQ ||
-	 get_itbl(node)->type == FETCH_ME_BQ ||
-	 get_itbl(node)->type == RBH ||
-	 get_itbl(node)->type == MVAR);
-    
-  ASSERT(node!=(StgClosure*)NULL);         // sanity check
-
-  print_bqe(((StgBlockingQueue*)node)->blocking_queue);
-}
-
-/* 
-   Print a whole blocking queue starting with the element bqe.
-*/
-void 
-print_bqe (StgBlockingQueueElement *bqe)
-{
-  rtsBool end;
-
-  /* 
-     NB: In a parallel setup a BQ of an RBH must end with an RBH_Save closure;
-  */
-  for (end = (bqe==END_BQ_QUEUE);
-       !end; // iterate until bqe points to a CONSTR
-       end = (get_itbl(bqe)->type == CONSTR) || (bqe->link==END_BQ_QUEUE), 
-       bqe = end ? END_BQ_QUEUE : bqe->link) {
-    ASSERT(bqe != END_BQ_QUEUE);                               // sanity check
-    ASSERT(bqe != (StgBlockingQueueElement *)NULL);            // sanity check
-    /* types of closures that may appear in a blocking queue */
-    ASSERT(get_itbl(bqe)->type == TSO ||           
-	   get_itbl(bqe)->type == BLOCKED_FETCH || 
-	   get_itbl(bqe)->type == CONSTR); 
-    /* only BQs of an RBH end with an RBH_Save closure */
-    //ASSERT(get_itbl(bqe)->type != CONSTR || get_itbl(node)->type == RBH);
-
-    switch (get_itbl(bqe)->type) {
-    case TSO:
-      debugBelch(" TSO %u (%x),",
-	      ((StgTSO *)bqe)->id, ((StgTSO *)bqe));
-      break;
-    case BLOCKED_FETCH:
-      debugBelch(" BF (node=%p, ga=((%x, %d, %x)),",
-	      ((StgBlockedFetch *)bqe)->node, 
-	      ((StgBlockedFetch *)bqe)->ga.payload.gc.gtid,
-	      ((StgBlockedFetch *)bqe)->ga.payload.gc.slot,
-	      ((StgBlockedFetch *)bqe)->ga.weight);
-      break;
-    case CONSTR:
-      debugBelch(" %s (IP %p),",
-	      (get_itbl(bqe) == &stg_RBH_Save_0_info ? "RBH_Save_0" :
-	       get_itbl(bqe) == &stg_RBH_Save_1_info ? "RBH_Save_1" :
-	       get_itbl(bqe) == &stg_RBH_Save_2_info ? "RBH_Save_2" :
-	       "RBH_Save_?"), get_itbl(bqe));
-      break;
-    default:
-      barf("Unexpected closure type %s in blocking queue", // of %p (%s)",
-	   info_type((StgClosure *)bqe)); // , node, info_type(node));
-      break;
-    }
-  } /* for */
-  debugBelch("\n");
-}
-# elif defined(GRAN)
-void 
-print_bq (StgClosure *node)
-{
-  StgBlockingQueueElement *bqe;
-  PEs node_loc, tso_loc;
-  rtsBool end;
-
-  /* should cover all closures that may have a blocking queue */
-  ASSERT(get_itbl(node)->type == BLACKHOLE_BQ ||
-	 get_itbl(node)->type == FETCH_ME_BQ ||
-	 get_itbl(node)->type == RBH);
-    
-  ASSERT(node!=(StgClosure*)NULL);         // sanity check
-  node_loc = where_is(node);
-
-  debugBelch("## BQ of closure %p (%s) on [PE %d]: ",
-	  node, info_type(node), node_loc);
-
-  /* 
-     NB: In a parallel setup a BQ of an RBH must end with an RBH_Save closure;
-  */
-  for (bqe = ((StgBlockingQueue*)node)->blocking_queue, end = (bqe==END_BQ_QUEUE);
-       !end; // iterate until bqe points to a CONSTR
-       end = (get_itbl(bqe)->type == CONSTR) || (bqe->link==END_BQ_QUEUE), bqe = end ? END_BQ_QUEUE : bqe->link) {
-    ASSERT(bqe != END_BQ_QUEUE);             // sanity check
-    ASSERT(bqe != (StgBlockingQueueElement *)NULL);  // sanity check
-    /* types of closures that may appear in a blocking queue */
-    ASSERT(get_itbl(bqe)->type == TSO ||           
-	   get_itbl(bqe)->type == CONSTR); 
-    /* only BQs of an RBH end with an RBH_Save closure */
-    ASSERT(get_itbl(bqe)->type != CONSTR || get_itbl(node)->type == RBH);
-
-    tso_loc = where_is((StgClosure *)bqe);
-    switch (get_itbl(bqe)->type) {
-    case TSO:
-      debugBelch(" TSO %d (%p) on [PE %d],",
-	      ((StgTSO *)bqe)->id, (StgTSO *)bqe, tso_loc);
-      break;
-    case CONSTR:
-      debugBelch(" %s (IP %p),",
-	      (get_itbl(bqe) == &stg_RBH_Save_0_info ? "RBH_Save_0" :
-	       get_itbl(bqe) == &stg_RBH_Save_1_info ? "RBH_Save_1" :
-	       get_itbl(bqe) == &stg_RBH_Save_2_info ? "RBH_Save_2" :
-	       "RBH_Save_?"), get_itbl(bqe));
-      break;
-    default:
-      barf("Unexpected closure type %s in blocking queue of %p (%s)",
-	   info_type((StgClosure *)bqe), node, info_type(node));
-      break;
-    }
-  } /* for */
-  debugBelch("\n");
-}
-# endif
-
-#if defined(PARALLEL_HASKELL)
-static nat
-run_queue_len(void)
-{
-    nat i;
-    StgTSO *tso;
-    
-    for (i=0, tso=run_queue_hd; 
-	 tso != END_TSO_QUEUE;
-	 i++, tso=tso->link) {
-	/* nothing */
-    }
-	
-    return i;
-}
-#endif
-
-void
-sched_belch(char *s, ...)
-{
-    va_list ap;
-    va_start(ap,s);
-#ifdef THREADED_RTS
-    debugBelch("sched (task %p): ", (void *)(unsigned long)(unsigned int)osThreadId());
-#elif defined(PARALLEL_HASKELL)
-    debugBelch("== ");
-#else
-    debugBelch("sched: ");
-#endif
-    vdebugBelch(s, ap);
-    debugBelch("\n");
-    va_end(ap);
-}
-
-#endif /* DEBUG */
diff --git a/ghc/rts/Schedule.h b/ghc/rts/Schedule.h
deleted file mode 100644
index 37b07941f4..0000000000
--- a/ghc/rts/Schedule.h
+++ /dev/null
@@ -1,332 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1998-2005
- *
- * Prototypes for functions in Schedule.c 
- * (RTS internal scheduler interface)
- *
- * -------------------------------------------------------------------------*/
-
-#ifndef SCHEDULE_H
-#define SCHEDULE_H
-
-#include "OSThreads.h"
-#include "Capability.h"
-
-/* initScheduler(), exitScheduler()
- * Called from STG :  no
- * Locks assumed   :  none
- */
-void initScheduler (void);
-void exitScheduler (void);
-
-// Place a new thread on the run queue of the current Capability
-void scheduleThread (Capability *cap, StgTSO *tso);
-
-// Place a new thread on the run queue of a specified Capability
-// (cap is the currently owned Capability, cpu is the number of
-// the desired Capability).
-void scheduleThreadOn(Capability *cap, StgWord cpu, StgTSO *tso);
-
-/* awakenBlockedQueue()
- *
- * Takes a pointer to the beginning of a blocked TSO queue, and
- * wakes up the entire queue.
- * Called from STG :  yes
- * Locks assumed   :  none
- */
-#if defined(GRAN)
-void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node);
-#elif defined(PAR)
-void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node);
-#else
-void awakenBlockedQueue (Capability *cap, StgTSO *tso);
-#endif
-
-/* unblockOne()
- *
- * Put the specified thread on the run queue of the given Capability.
- * Called from STG :  yes
- * Locks assumed   :  we own the Capability.
- */
-StgTSO * unblockOne(Capability *cap, StgTSO *tso);
-
-/* raiseAsync()
- *
- * Raises an exception asynchronously in the specified thread.
- *
- * Called from STG :  yes
- * Locks assumed   :  none
- */
-void raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception);
-
-/* suspendComputation()
- *
- * A variant of raiseAsync(), this strips the stack of the specified
- * thread down to the stop_here point, leaving a current closure on
- * top of the stack at [stop_here - 1].
- */
-void suspendComputation(Capability *cap, StgTSO *tso, StgPtr stop_here);
-
-/* raiseExceptionHelper */
-StgWord raiseExceptionHelper (StgRegTable *reg, StgTSO *tso, StgClosure *exception);
-
-/* findRetryFrameHelper */
-StgWord findRetryFrameHelper (StgTSO *tso);
-
-/* GetRoots(evac_fn f)
- *
- * Call f() for each root known to the scheduler.
- *
- * Called from STG :  NO
- * Locks assumed   :  ????
- */
-void GetRoots(evac_fn);
-
-/* workerStart()
- * 
- * Entry point for a new worker task.
- * Called from STG :  NO
- * Locks assumed   :  none
- */
-void workerStart(Task *task);
-
-#if defined(GRAN)
-void    awaken_blocked_queue(StgBlockingQueueElement *q, StgClosure *node);
-void    unlink_from_bq(StgTSO* tso, StgClosure* node);
-void    initThread(StgTSO *tso, nat stack_size, StgInt pri);
-#elif defined(PAR)
-nat     run_queue_len(void);
-void    awaken_blocked_queue(StgBlockingQueueElement *q, StgClosure *node);
-void    initThread(StgTSO *tso, nat stack_size);
-#else
-char   *info_type(StgClosure *closure);    // dummy
-char   *info_type_by_ip(StgInfoTable *ip); // dummy
-void    awaken_blocked_queue(StgTSO *q);
-void    initThread(StgTSO *tso, nat stack_size);
-#endif
-
-/* Context switch flag.
- * Locks required  : none (conflicts are harmless)
- */
-extern int RTS_VAR(context_switch);
-
-/* The state of the scheduler.  This is used to control the sequence
- * of events during shutdown, and when the runtime is interrupted
- * using ^C.
- */
-#define SCHED_RUNNING       0  /* running as normal */
-#define SCHED_INTERRUPTING  1  /* ^C detected, before threads are deleted */
-#define SCHED_INTERRUPTED   2  /* ^C detected, after threads deleted */
-#define SCHED_SHUTTING_DOWN 3  /* final shutdown */
-
-extern rtsBool RTS_VAR(sched_state);
-
-/* 
- * flag that tracks whether we have done any execution in this time slice.
- */
-#define ACTIVITY_YES      0 /* there has been activity in the current slice */
-#define ACTIVITY_MAYBE_NO 1 /* no activity in the current slice */
-#define ACTIVITY_INACTIVE 2 /* a complete slice has passed with no activity */
-#define ACTIVITY_DONE_GC  3 /* like 2, but we've done a GC too */
-
-/* Recent activity flag.
- * Locks required  : Transition from MAYBE_NO to INACTIVE
- * happens in the timer signal, so it is atomic.  Trnasition from
- * INACTIVE to DONE_GC happens under sched_mutex.  No lock required
- * to set it to ACTIVITY_YES.
- */
-extern nat recent_activity;
-
-/* Thread queues.
- * Locks required  : sched_mutex
- *
- * In GranSim we have one run/blocked_queue per PE.
- */
-#if defined(GRAN)
-// run_queue_hds defined in GranSim.h
-#else
-extern  StgTSO *RTS_VAR(blackhole_queue);
-#if !defined(THREADED_RTS)
-extern  StgTSO *RTS_VAR(blocked_queue_hd), *RTS_VAR(blocked_queue_tl);
-extern  StgTSO *RTS_VAR(sleeping_queue);
-#endif
-#endif
-
-/* Linked list of all threads.
- * Locks required  : sched_mutex
- */
-extern  StgTSO *RTS_VAR(all_threads);
-
-/* Set to rtsTrue if there are threads on the blackhole_queue, and
- * it is possible that one or more of them may be available to run.
- * This flag is set to rtsFalse after we've checked the queue, and
- * set to rtsTrue just before we run some Haskell code.  It is used
- * to decide whether we should yield the Capability or not.
- * Locks required  : none (see scheduleCheckBlackHoles()).
- */
-extern rtsBool blackholes_need_checking;
-
-#if defined(THREADED_RTS)
-extern Mutex RTS_VAR(sched_mutex);
-#endif
-
-StgBool isThreadBound(StgTSO *tso);
-
-SchedulerStatus rts_mainLazyIO(HaskellObj p, /*out*/HaskellObj *ret);
-
-/* Called by shutdown_handler(). */
-void interruptStgRts (void);
-
-nat  run_queue_len (void);
-
-void resurrectThreads (StgTSO *);
-
-void printAllThreads(void);
-
-/* debugging only 
- */
-#ifdef DEBUG
-void print_bq (StgClosure *node);
-#endif
-#if defined(PAR)
-void print_bqe (StgBlockingQueueElement *bqe);
-#endif
-
-void labelThread(StgPtr tso, char *label);
-
-/* -----------------------------------------------------------------------------
- * Some convenient macros/inline functions...
- */
-
-#if !IN_STG_CODE
-
-/* END_TSO_QUEUE and friends now defined in includes/StgMiscClosures.h */
-
-/* Add a thread to the end of the run queue.
- * NOTE: tso->link should be END_TSO_QUEUE before calling this macro.
- * ASSUMES: cap->running_task is the current task.
- */
-STATIC_INLINE void
-appendToRunQueue (Capability *cap, StgTSO *tso)
-{
-    ASSERT(tso->link == END_TSO_QUEUE);
-    if (cap->run_queue_hd == END_TSO_QUEUE) {
-	cap->run_queue_hd = tso;
-    } else {
-	cap->run_queue_tl->link = tso;
-    }
-    cap->run_queue_tl = tso;
-}
-
-/* Push a thread on the beginning of the run queue.  Used for
- * newly awakened threads, so they get run as soon as possible.
- * ASSUMES: cap->running_task is the current task.
- */
-STATIC_INLINE void
-pushOnRunQueue (Capability *cap, StgTSO *tso)
-{
-    tso->link = cap->run_queue_hd;
-    cap->run_queue_hd = tso;
-    if (cap->run_queue_tl == END_TSO_QUEUE) {
-	cap->run_queue_tl = tso;
-    }
-}
-
-/* Pop the first thread off the runnable queue.
- */
-STATIC_INLINE StgTSO *
-popRunQueue (Capability *cap)
-{ 
-    StgTSO *t = cap->run_queue_hd;
-    ASSERT(t != END_TSO_QUEUE);
-    cap->run_queue_hd = t->link;
-    t->link = END_TSO_QUEUE;
-    if (cap->run_queue_hd == END_TSO_QUEUE) {
-	cap->run_queue_tl = END_TSO_QUEUE;
-    }
-    return t;
-}
-
-/* Add a thread to the end of the blocked queue.
- */
-#if !defined(THREADED_RTS)
-STATIC_INLINE void
-appendToBlockedQueue(StgTSO *tso)
-{
-    ASSERT(tso->link == END_TSO_QUEUE);
-    if (blocked_queue_hd == END_TSO_QUEUE) {
-	blocked_queue_hd = tso;
-    } else {
-	blocked_queue_tl->link = tso;
-    }
-    blocked_queue_tl = tso;
-}
-#endif
-
-#if defined(THREADED_RTS)
-STATIC_INLINE void
-appendToWakeupQueue (Capability *cap, StgTSO *tso)
-{
-    ASSERT(tso->link == END_TSO_QUEUE);
-    if (cap->wakeup_queue_hd == END_TSO_QUEUE) {
-	cap->wakeup_queue_hd = tso;
-    } else {
-	cap->wakeup_queue_tl->link = tso;
-    }
-    cap->wakeup_queue_tl = tso;
-}
-#endif
-
-/* Check whether various thread queues are empty
- */
-STATIC_INLINE rtsBool
-emptyQueue (StgTSO *q)
-{
-    return (q == END_TSO_QUEUE);
-}
-
-STATIC_INLINE rtsBool
-emptyRunQueue(Capability *cap)
-{
-    return emptyQueue(cap->run_queue_hd);
-}
-
-#if defined(THREADED_RTS)
-STATIC_INLINE rtsBool
-emptyWakeupQueue(Capability *cap)
-{
-    return emptyQueue(cap->wakeup_queue_hd);
-}
-#endif
-
-#if !defined(THREADED_RTS)
-#define EMPTY_BLOCKED_QUEUE()  (emptyQueue(blocked_queue_hd))
-#define EMPTY_SLEEPING_QUEUE() (emptyQueue(sleeping_queue))
-#endif
-
-STATIC_INLINE rtsBool
-emptyThreadQueues(Capability *cap)
-{
-    return emptyRunQueue(cap)
-#if !defined(THREADED_RTS)
-	&& EMPTY_BLOCKED_QUEUE() && EMPTY_SLEEPING_QUEUE()
-#endif
-    ;
-}
-
-#ifdef DEBUG
-void sched_belch(char *s, ...)
-   GNU_ATTRIBUTE(format (printf, 1, 2));
-#endif
-
-#endif /* !IN_STG_CODE */
-
-STATIC_INLINE void
-dirtyTSO (StgTSO *tso)
-{
-    tso->flags |= TSO_DIRTY;
-}
-
-#endif /* SCHEDULE_H */
-
diff --git a/ghc/rts/Sparks.c b/ghc/rts/Sparks.c
deleted file mode 100644
index 615d832e33..0000000000
--- a/ghc/rts/Sparks.c
+++ /dev/null
@@ -1,881 +0,0 @@
-/* ---------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2000-2006
- *
- * Sparking support for PARALLEL_HASKELL and THREADED_RTS versions of the RTS.
- *
- * -------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "Schedule.h"
-#include "SchedAPI.h"
-#include "Storage.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "ParTicky.h"
-# if defined(PARALLEL_HASKELL)
-# include "ParallelRts.h"
-# include "GranSimRts.h"   // for GR_...
-# elif defined(GRAN)
-# include "GranSimRts.h"
-# endif
-#include "Sparks.h"
-
-#if defined(THREADED_RTS) || defined(PARALLEL_HASKELL)
-
-static INLINE_ME void bump_hd (StgSparkPool *p)
-{ p->hd++; if (p->hd == p->lim) p->hd = p->base; }
-
-static INLINE_ME void bump_tl (StgSparkPool *p)
-{ p->tl++; if (p->tl == p->lim) p->tl = p->base; }
-
-/* -----------------------------------------------------------------------------
- * 
- * Initialising spark pools.
- *
- * -------------------------------------------------------------------------- */
-
-static void 
-initSparkPool(StgSparkPool *pool)
-{
-    pool->base = stgMallocBytes(RtsFlags.ParFlags.maxLocalSparks
-				* sizeof(StgClosure *),
-				"initSparkPools");
-    pool->lim = pool->base + RtsFlags.ParFlags.maxLocalSparks;
-    pool->hd  = pool->base;
-    pool->tl  = pool->base;
-}
-
-void
-initSparkPools( void )
-{
-#ifdef THREADED_RTS
-    /* walk over the capabilities, allocating a spark pool for each one */
-    nat i;
-    for (i = 0; i < n_capabilities; i++) {
-	initSparkPool(&capabilities[i].r.rSparks);
-    }
-#else
-    /* allocate a single spark pool */
-    initSparkPool(&MainCapability.r.rSparks);
-#endif
-}
-
-/* -----------------------------------------------------------------------------
- * 
- * findSpark: find a spark on the current Capability that we can fork
- * into a thread.
- *
- * -------------------------------------------------------------------------- */
-
-StgClosure *
-findSpark (Capability *cap)
-{
-    StgSparkPool *pool;
-    StgClosure *spark;
-    
-    pool = &(cap->r.rSparks);
-    ASSERT_SPARK_POOL_INVARIANTS(pool);
-
-    while (pool->hd != pool->tl) {
-	spark = *pool->hd;
-	bump_hd(pool);
-	if (closure_SHOULD_SPARK(spark)) {
-#ifdef GRAN
-	    if (RtsFlags.ParFlags.ParStats.Sparks) 
-		DumpRawGranEvent(CURRENT_PROC, CURRENT_PROC, 
-				 GR_STEALING, ((StgTSO *)NULL), spark, 
-				 0, 0 /* spark_queue_len(ADVISORY_POOL) */);
-#endif
-	    return spark;
-	}
-    }
-    // spark pool is now empty
-    return NULL;
-}
-
-/* -----------------------------------------------------------------------------
- * Mark all nodes pointed to by sparks in the spark queues (for GC) Does an
- * implicit slide i.e. after marking all sparks are at the beginning of the
- * spark pool and the spark pool only contains sparkable closures 
- * -------------------------------------------------------------------------- */
-
-void
-markSparkQueue (evac_fn evac)
-{ 
-    StgClosure **sparkp, **to_sparkp;
-    nat i, n, pruned_sparks; // stats only
-    StgSparkPool *pool;
-    Capability *cap;
-    
-    PAR_TICKY_MARK_SPARK_QUEUE_START();
-    
-    n = 0;
-    pruned_sparks = 0;
-    for (i = 0; i < n_capabilities; i++) {
-	cap = &capabilities[i];
-	pool = &(cap->r.rSparks);
-	
-	ASSERT_SPARK_POOL_INVARIANTS(pool);
-
-#if defined(PARALLEL_HASKELL)
-	// stats only
-	n = 0;
-	pruned_sparks = 0;
-#endif
-	
-	sparkp = pool->hd;
-	to_sparkp = pool->hd;
-	while (sparkp != pool->tl) {
-	    ASSERT(to_sparkp<=sparkp);
-	    ASSERT(*sparkp!=NULL);
-	    ASSERT(LOOKS_LIKE_CLOSURE_PTR(((StgClosure *)*sparkp)));
-	    // ToDo?: statistics gathering here (also for GUM!)
-	    if (closure_SHOULD_SPARK(*sparkp)) {
-		evac(sparkp);
-		*to_sparkp++ = *sparkp;
-		n++;
-	    } else {
-		pruned_sparks++;
-	    }
-	    sparkp++;
-	    if (sparkp == pool->lim) {
-		sparkp = pool->base;
-	    }
-	}
-	pool->tl = to_sparkp;
-	
-	PAR_TICKY_MARK_SPARK_QUEUE_END(n);
-	
-#if defined(PARALLEL_HASKELL)
-	IF_DEBUG(scheduler,
-		 debugBelch("markSparkQueue: marked %d sparks and pruned %d sparks on [%x]",
-			    n, pruned_sparks, mytid));
-#else
-	IF_DEBUG(scheduler,
-	       debugBelch("markSparkQueue: marked %d sparks and pruned %d sparks\n",
-			  n, pruned_sparks));
-#endif
-	
-	IF_DEBUG(scheduler,
-		 debugBelch("markSparkQueue:   new spark queue len=%d; (hd=%p; tl=%p)\n",
-			    sparkPoolSize(pool), pool->hd, pool->tl));
-	
-    }
-}
-
-/* -----------------------------------------------------------------------------
- * 
- * Turn a spark into a real thread
- *
- * -------------------------------------------------------------------------- */
-
-void
-createSparkThread (Capability *cap, StgClosure *p)
-{
-    StgTSO *tso;
-
-    tso = createGenThread (cap, RtsFlags.GcFlags.initialStkSize, p);
-    appendToRunQueue(cap,tso);
-}
-
-/* -----------------------------------------------------------------------------
- * 
- * Create a new spark
- *
- * -------------------------------------------------------------------------- */
-
-#define DISCARD_NEW
-
-StgInt
-newSpark (StgRegTable *reg, StgClosure *p)
-{
-    StgSparkPool *pool = &(reg->rSparks);
-
-    ASSERT_SPARK_POOL_INVARIANTS(pool);
-
-    if (closure_SHOULD_SPARK(p)) {
-#ifdef DISCARD_NEW
-	StgClosure **new_tl;
-	new_tl = pool->tl + 1;
-	if (new_tl == pool->lim) { new_tl = pool->base; }
-	if (new_tl != pool->hd) {
-	    *pool->tl = p;
-	    pool->tl = new_tl;
-	} else if (!closure_SHOULD_SPARK(*pool->hd)) {
-	    // if the old closure is not sparkable, discard it and
-	    // keep the new one.  Otherwise, keep the old one.
-	    *pool->tl = p;
-	    bump_hd(pool);
-	}
-#else  /* DISCARD OLD */
-	*pool->tl = p;
-	bump_tl(pool);
-	if (pool->tl == pool->hd) { bump_hd(pool); }
-#endif
-    }	
-
-    ASSERT_SPARK_POOL_INVARIANTS(pool);
-    return 1;
-}
-
-#else
-
-StgInt
-newSpark (StgRegTable *reg STG_UNUSED, StgClosure *p STG_UNUSED)
-{
-    /* nothing */
-    return 1;
-}
-
-#endif /* PARALLEL_HASKELL || THREADED_RTS */
-
-
-/* -----------------------------------------------------------------------------
- * 
- * GRAN & PARALLEL_HASKELL stuff beyond here.
- *
- * -------------------------------------------------------------------------- */
-
-#if defined(PARALLEL_HASKELL) || defined(GRAN)
-
-static void slide_spark_pool( StgSparkPool *pool );
-
-rtsBool
-add_to_spark_queue( StgClosure *closure, StgSparkPool *pool )
-{
-  if (pool->tl == pool->lim)
-    slide_spark_pool(pool);
-
-  if (closure_SHOULD_SPARK(closure) && 
-      pool->tl < pool->lim) {
-    *(pool->tl++) = closure;
-
-#if defined(PARALLEL_HASKELL)
-    // collect parallel global statistics (currently done together with GC stats)
-    if (RtsFlags.ParFlags.ParStats.Global &&
-	RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-      // debugBelch("Creating spark for %x @ %11.2f\n", closure, usertime()); 
-      globalParStats.tot_sparks_created++;
-    }
-#endif
-    return rtsTrue;
-  } else {
-#if defined(PARALLEL_HASKELL)
-    // collect parallel global statistics (currently done together with GC stats)
-    if (RtsFlags.ParFlags.ParStats.Global &&
-	RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-      //debugBelch("Ignoring spark for %x @ %11.2f\n", closure, usertime()); 
-      globalParStats.tot_sparks_ignored++;
-    }
-#endif
-    return rtsFalse;
-  }
-}
-
-static void
-slide_spark_pool( StgSparkPool *pool )
-{
-  StgClosure **sparkp, **to_sparkp;
-
-  sparkp = pool->hd;
-  to_sparkp = pool->base;
-  while (sparkp < pool->tl) {
-    ASSERT(to_sparkp<=sparkp);
-    ASSERT(*sparkp!=NULL);
-    ASSERT(LOOKS_LIKE_GHC_INFO((*sparkp)->header.info));
-
-    if (closure_SHOULD_SPARK(*sparkp)) {
-      *to_sparkp++ = *sparkp++;
-    } else {
-      sparkp++;
-    }
-  }
-  pool->hd = pool->base;
-  pool->tl = to_sparkp;
-}
-
-void
-disposeSpark(spark)
-StgClosure *spark;
-{
-#if !defined(THREADED_RTS)
-  Capability *cap;
-  StgSparkPool *pool;
-
-  cap = &MainRegTable;
-  pool = &(cap->rSparks);
-  ASSERT(pool->hd <= pool->tl && pool->tl <= pool->lim);
-#endif
-  ASSERT(spark != (StgClosure *)NULL);
-  /* Do nothing */
-}
-
-
-#elif defined(GRAN)
-
-/* 
-   Search the spark queue of the proc in event for a spark that's worth
-   turning into a thread 
-   (was gimme_spark in the old RTS)
-*/
-void
-findLocalSpark (rtsEvent *event, rtsBool *found_res, rtsSparkQ *spark_res)
-{
-   PEs proc = event->proc,       /* proc to search for work */
-       creator = event->creator; /* proc that requested work */
-   StgClosure* node;
-   rtsBool found;
-   rtsSparkQ spark_of_non_local_node = NULL, 
-             spark_of_non_local_node_prev = NULL, 
-             low_priority_spark = NULL, 
-             low_priority_spark_prev = NULL,
-             spark = NULL, prev = NULL;
-  
-   /* Choose a spark from the local spark queue */
-   prev = (rtsSpark*)NULL;
-   spark = pending_sparks_hds[proc];
-   found = rtsFalse;
-
-   // ToDo: check this code & implement local sparking !! -- HWL  
-   while (!found && spark != (rtsSpark*)NULL)
-     {
-       ASSERT((prev!=(rtsSpark*)NULL || spark==pending_sparks_hds[proc]) &&
-	      (prev==(rtsSpark*)NULL || prev->next==spark) &&
-	      (spark->prev==prev));
-       node = spark->node;
-       if (!closure_SHOULD_SPARK(node)) 
-         {
-	   IF_GRAN_DEBUG(checkSparkQ,
-			 debugBelch("^^ pruning spark %p (node %p) in gimme_spark",
-			       spark, node));
-
-           if (RtsFlags.GranFlags.GranSimStats.Sparks)
-             DumpRawGranEvent(proc, (PEs)0, SP_PRUNED,(StgTSO*)NULL,
-			      spark->node, spark->name, spark_queue_len(proc));
-  
-	   ASSERT(spark != (rtsSpark*)NULL);
-	   ASSERT(SparksAvail>0);
-	   --SparksAvail;
-
-	   ASSERT(prev==(rtsSpark*)NULL || prev->next==spark);
-	   spark = delete_from_sparkq (spark, proc, rtsTrue);
-	   if (spark != (rtsSpark*)NULL)
-	     prev = spark->prev;
-	   continue;
-         }
-       /* -- node should eventually be sparked */
-       else if (RtsFlags.GranFlags.PreferSparksOfLocalNodes && 
-               !IS_LOCAL_TO(PROCS(node),CurrentProc)) 
-         {
-	   barf("Local sparking not yet implemented");
-
-           /* Remember first low priority spark */
-           if (spark_of_non_local_node==(rtsSpark*)NULL) {
-	     spark_of_non_local_node_prev = prev;
-             spark_of_non_local_node = spark;
-  	      }
-  
-           if (spark->next == (rtsSpark*)NULL) { 
-  	     /* ASSERT(spark==SparkQueueTl);  just for testing */
-  	     prev = spark_of_non_local_node_prev;
-  	     spark = spark_of_non_local_node;
-             found = rtsTrue;
-             break;
-           }
-  
-# if defined(GRAN) && defined(GRAN_CHECK)
-           /* Should never happen; just for testing 
-           if (spark==pending_sparks_tl) {
-             debugBelch("ReSchedule: Last spark != SparkQueueTl\n");
-	   	stg_exit(EXIT_FAILURE);
-		} */
-# endif
-  	   prev = spark; 
-  	   spark = spark->next;
-	   ASSERT(SparksAvail>0);
-           --SparksAvail;
-	   continue;
-         }
-       else if ( RtsFlags.GranFlags.DoPrioritySparking || 
-  		 (spark->gran_info >= RtsFlags.GranFlags.SparkPriority2) )
-         {
-	   if (RtsFlags.GranFlags.DoPrioritySparking)
-	     barf("Priority sparking not yet implemented");
-
-           found = rtsTrue;
-         }
-#if 0	   
-       else /* only used if SparkPriority2 is defined */
-         {
-	   /* ToDo: fix the code below and re-integrate it */
-           /* Remember first low priority spark */
-           if (low_priority_spark==(rtsSpark*)NULL) { 
-	     low_priority_spark_prev = prev;
-             low_priority_spark = spark;
-	   }
-  
-           if (spark->next == (rtsSpark*)NULL) { 
-	        /* ASSERT(spark==spark_queue_tl);  just for testing */
-	     prev = low_priority_spark_prev;
-	     spark = low_priority_spark;
-             found = rtsTrue;       /* take low pri spark => rc is 2  */
-             break;
-           }
-  
-           /* Should never happen; just for testing 
-           if (spark==pending_sparks_tl) {
-             debugBelch("ReSchedule: Last spark != SparkQueueTl\n");
-  		stg_exit(EXIT_FAILURE);
-             break;
-	   } */                
-	   prev = spark; 
-	   spark = spark->next;
-
-	   IF_GRAN_DEBUG(pri,
-			 debugBelch("++ Ignoring spark of priority %u (SparkPriority=%u); node=%p; name=%u\n", 
-			       spark->gran_info, RtsFlags.GranFlags.SparkPriority, 
-			       spark->node, spark->name);)
-           }
-#endif
-   }  /* while (spark!=NULL && !found) */
-
-   *spark_res = spark;
-   *found_res = found;
-}
-
-/*
-  Turn the spark into a thread.
-  In GranSim this basically means scheduling a StartThread event for the
-  node pointed to by the spark at some point in the future.
-  (was munch_spark in the old RTS)
-*/
-rtsBool
-activateSpark (rtsEvent *event, rtsSparkQ spark) 
-{
-  PEs proc = event->proc,       /* proc to search for work */
-      creator = event->creator; /* proc that requested work */
-  StgTSO* tso;
-  StgClosure* node;
-  rtsTime spark_arrival_time;
-
-  /* 
-     We've found a node on PE proc requested by PE creator.
-     If proc==creator we can turn the spark into a thread immediately;
-     otherwise we schedule a MoveSpark event on the requesting PE
-  */
-     
-  /* DaH Qu' yIchen */
-  if (proc!=creator) { 
-
-    /* only possible if we simulate GUM style fishing */
-    ASSERT(RtsFlags.GranFlags.Fishing);
-
-    /* Message packing costs for sending a Fish; qeq jabbI'ID */
-    CurrentTime[proc] += RtsFlags.GranFlags.Costs.mpacktime;
-  
-    if (RtsFlags.GranFlags.GranSimStats.Sparks)
-      DumpRawGranEvent(proc, (PEs)0, SP_EXPORTED,
-		       (StgTSO*)NULL, spark->node,
-		       spark->name, spark_queue_len(proc));
-
-    /* time of the spark arrival on the remote PE */
-    spark_arrival_time = CurrentTime[proc] + RtsFlags.GranFlags.Costs.latency;
-
-    new_event(creator, proc, spark_arrival_time,
-	      MoveSpark,
-	      (StgTSO*)NULL, spark->node, spark);
-
-    CurrentTime[proc] += RtsFlags.GranFlags.Costs.mtidytime;
-	    
-  } else { /* proc==creator i.e. turn the spark into a thread */
-
-    if ( RtsFlags.GranFlags.GranSimStats.Global && 
-	 spark->gran_info < RtsFlags.GranFlags.SparkPriority2 ) {
-
-      globalGranStats.tot_low_pri_sparks++;
-      IF_GRAN_DEBUG(pri,
-		    debugBelch("++ No high priority spark available; low priority (%u) spark chosen: node=%p; name=%u\n",
-			  spark->gran_info, 
-			  spark->node, spark->name));
-    } 
-    
-    CurrentTime[proc] += RtsFlags.GranFlags.Costs.threadcreatetime;
-    
-    node = spark->node;
-    
-# if 0
-    /* ToDo: fix the GC interface and move to StartThread handling-- HWL */
-    if (GARBAGE COLLECTION IS NECESSARY) {
-      /* Some kind of backoff needed here in case there's too little heap */
-#  if defined(GRAN_CHECK) && defined(GRAN)
-      if (RtsFlags.GcFlags.giveStats)
-	fprintf(RtsFlags.GcFlags.statsFile,"***** vIS Qu' chen veQ boSwI'; spark=%p, node=%p;  name=%u\n", 
-		/* (found==2 ? "no hi pri spark" : "hi pri spark"), */
-		spark, node, spark->name);
-#  endif
-      new_event(CurrentProc, CurrentProc, CurrentTime[CurrentProc]+1,
-    		  FindWork,
-    		  (StgTSO*)NULL, (StgClosure*)NULL, (rtsSpark*)NULL);
-      barf("//// activateSpark: out of heap ; ToDo: call GarbageCollect()");
-      GarbageCollect(GetRoots, rtsFalse);
-      // HWL old: ReallyPerformThreadGC(TSO_HS+TSO_CTS_SIZE,rtsFalse);
-      // HWL old: SAVE_Hp -= TSO_HS+TSO_CTS_SIZE;
-      spark = NULL;
-      return; /* was: continue; */ /* to the next event, eventually */
-    }
-# endif
-    
-    if (RtsFlags.GranFlags.GranSimStats.Sparks)
-      DumpRawGranEvent(CurrentProc,(PEs)0,SP_USED,(StgTSO*)NULL,
-		       spark->node, spark->name,
-		       spark_queue_len(CurrentProc));
-    
-    new_event(proc, proc, CurrentTime[proc],
-	      StartThread, 
-	      END_TSO_QUEUE, node, spark); // (rtsSpark*)NULL);
-    
-    procStatus[proc] = Starting;
-  }
-}
-
-/* -------------------------------------------------------------------------
-   This is the main point where handling granularity information comes into
-   play. 
-   ------------------------------------------------------------------------- */
-
-#define MAX_RAND_PRI    100
-
-/* 
-   Granularity info transformers. 
-   Applied to the GRAN_INFO field of a spark.
-*/
-STATIC_INLINE nat  ID(nat x) { return(x); };
-STATIC_INLINE nat  INV(nat x) { return(-x); };
-STATIC_INLINE nat  IGNORE(nat x) { return (0); };
-STATIC_INLINE nat  RAND(nat x) { return ((random() % MAX_RAND_PRI) + 1); }
-
-/* NB: size_info and par_info are currently unused (what a shame!) -- HWL */
-rtsSpark *
-newSpark(node,name,gran_info,size_info,par_info,local)
-StgClosure *node;
-nat name, gran_info, size_info, par_info, local;
-{
-  nat pri;
-  rtsSpark *newspark;
-
-  pri = RtsFlags.GranFlags.RandomPriorities ? RAND(gran_info) :
-        RtsFlags.GranFlags.InversePriorities ? INV(gran_info) :
-	RtsFlags.GranFlags.IgnorePriorities ? IGNORE(gran_info) :
-                           ID(gran_info);
-
-  if ( RtsFlags.GranFlags.SparkPriority!=0 && 
-       pri<RtsFlags.GranFlags.SparkPriority ) {
-    IF_GRAN_DEBUG(pri,
-      debugBelch(",, NewSpark: Ignoring spark of priority %u (SparkPriority=%u); node=%#x; name=%u\n", 
-	      pri, RtsFlags.GranFlags.SparkPriority, node, name));
-    return ((rtsSpark*)NULL);
-  }
-
-  newspark = (rtsSpark*) stgMallocBytes(sizeof(rtsSpark), "NewSpark");
-  newspark->prev = newspark->next = (rtsSpark*)NULL;
-  newspark->node = node;
-  newspark->name = (name==1) ? CurrentTSO->gran.sparkname : name;
-  newspark->gran_info = pri;
-  newspark->global = !local;      /* Check that with parAt, parAtAbs !!*/
-
-  if (RtsFlags.GranFlags.GranSimStats.Global) {
-    globalGranStats.tot_sparks_created++;
-    globalGranStats.sparks_created_on_PE[CurrentProc]++;
-  }
-
-  return(newspark);
-}
-
-void
-disposeSpark(spark)
-rtsSpark *spark;
-{
-  ASSERT(spark!=NULL);
-  stgFree(spark);
-}
-
-void 
-disposeSparkQ(spark)
-rtsSparkQ spark;
-{
-  if (spark==NULL) 
-    return;
-
-  disposeSparkQ(spark->next);
-
-# ifdef GRAN_CHECK
-  if (SparksAvail < 0) {
-    debugBelch("disposeSparkQ: SparksAvail<0 after disposing sparkq @ %p\n", &spark);
-    print_spark(spark);
-  }
-# endif
-
-  stgFree(spark);
-}
-
-/*
-   With PrioritySparking add_to_spark_queue performs an insert sort to keep
-   the spark queue sorted. Otherwise the spark is just added to the end of
-   the queue. 
-*/
-
-void
-add_to_spark_queue(spark)
-rtsSpark *spark;
-{
-  rtsSpark *prev = NULL, *next = NULL;
-  nat count = 0;
-  rtsBool found = rtsFalse;
-
-  if ( spark == (rtsSpark *)NULL ) {
-    return;
-  }
-
-  if (RtsFlags.GranFlags.DoPrioritySparking && (spark->gran_info != 0) ) {
-    /* Priority sparking is enabled i.e. spark queues must be sorted */
-
-    for (prev = NULL, next = pending_sparks_hd, count=0;
-	 (next != NULL) && 
-	 !(found = (spark->gran_info >= next->gran_info));
-	 prev = next, next = next->next, count++) 
-     {}
-
-  } else {   /* 'utQo' */
-    /* Priority sparking is disabled */
-    
-    found = rtsFalse;   /* to add it at the end */
-
-  }
-
-  if (found) {
-    /* next points to the first spark with a gran_info smaller than that
-       of spark; therefore, add spark before next into the spark queue */
-    spark->next = next;
-    if ( next == NULL ) {
-      pending_sparks_tl = spark;
-    } else {
-      next->prev = spark;
-    }
-    spark->prev = prev;
-    if ( prev == NULL ) {
-      pending_sparks_hd = spark;
-    } else {
-      prev->next = spark;
-    }
-  } else {  /* (RtsFlags.GranFlags.DoPrioritySparking && !found) || !DoPrioritySparking */
-    /* add the spark at the end of the spark queue */
-    spark->next = NULL;			       
-    spark->prev = pending_sparks_tl;
-    if (pending_sparks_hd == NULL)
-      pending_sparks_hd = spark;
-    else
-      pending_sparks_tl->next = spark;
-    pending_sparks_tl = spark;	  
-  } 
-  ++SparksAvail;
-
-  /* add costs for search in priority sparking */
-  if (RtsFlags.GranFlags.DoPrioritySparking) {
-    CurrentTime[CurrentProc] += count * RtsFlags.GranFlags.Costs.pri_spark_overhead;
-  }
-
-  IF_GRAN_DEBUG(checkSparkQ,
-		debugBelch("++ Spark stats after adding spark %p (node %p) to queue on PE %d",
-		      spark, spark->node, CurrentProc);
-		print_sparkq_stats());
-
-#  if defined(GRAN_CHECK)
-  if (RtsFlags.GranFlags.Debug.checkSparkQ) {
-    for (prev = NULL, next =  pending_sparks_hd;
-	 (next != NULL);
-	 prev = next, next = next->next) 
-      {}
-    if ( (prev!=NULL) && (prev!=pending_sparks_tl) )
-      debugBelch("SparkQ inconsistency after adding spark %p: (PE %u) pending_sparks_tl (%p) not end of queue (%p)\n",
-	      spark,CurrentProc, 
-	      pending_sparks_tl, prev);
-  }
-#  endif
-
-#  if defined(GRAN_CHECK)
-  /* Check if the sparkq is still sorted. Just for testing, really!  */
-  if ( RtsFlags.GranFlags.Debug.checkSparkQ &&
-       RtsFlags.GranFlags.Debug.pri ) {
-    rtsBool sorted = rtsTrue;
-    rtsSpark *prev, *next;
-
-    if (pending_sparks_hd == NULL ||
-	pending_sparks_hd->next == NULL ) {
-      /* just 1 elem => ok */
-    } else {
-      for (prev = pending_sparks_hd,
-	   next = pending_sparks_hd->next;
-	   (next != NULL) ;
-	   prev = next, next = next->next) {
-	sorted = sorted && 
-	         (prev->gran_info >= next->gran_info);
-      }
-    }
-    if (!sorted) {
-      debugBelch("ghuH: SPARKQ on PE %d is not sorted:\n",
-	      CurrentProc);
-      print_sparkq(CurrentProc);
-    }
-  }
-#  endif
-}
-
-nat
-spark_queue_len(proc) 
-PEs proc;
-{
- rtsSpark *prev, *spark;                     /* prev only for testing !! */
- nat len;
-
- for (len = 0, prev = NULL, spark = pending_sparks_hds[proc]; 
-      spark != NULL; 
-      len++, prev = spark, spark = spark->next)
-   {}
-
-#  if defined(GRAN_CHECK)
-  if ( RtsFlags.GranFlags.Debug.checkSparkQ ) 
-    if ( (prev!=NULL) && (prev!=pending_sparks_tls[proc]) )
-      debugBelch("ERROR in spark_queue_len: (PE %u) pending_sparks_tl (%p) not end of queue (%p)\n",
-	      proc, pending_sparks_tls[proc], prev);
-#  endif
-
- return (len);
-}
-
-/* 
-   Take spark out of the spark queue on PE p and nuke the spark. Adjusts
-   hd and tl pointers of the spark queue. Returns a pointer to the next
-   spark in the queue.
-*/
-rtsSpark *
-delete_from_sparkq (spark, p, dispose_too)     /* unlink and dispose spark */
-rtsSpark *spark;
-PEs p;
-rtsBool dispose_too;
-{
-  rtsSpark *new_spark;
-
-  if (spark==NULL) 
-    barf("delete_from_sparkq: trying to delete NULL spark\n");
-
-#  if defined(GRAN_CHECK)
-  if ( RtsFlags.GranFlags.Debug.checkSparkQ ) {
-    debugBelch("## |%p:%p| (%p)<-spark=%p->(%p) <-(%p)\n",
-	    pending_sparks_hd, pending_sparks_tl,
-	    spark->prev, spark, spark->next, 
-	    (spark->next==NULL ? 0 : spark->next->prev));
-  }
-#  endif
-
-  if (spark->prev==NULL) {
-    /* spark is first spark of queue => adjust hd pointer */
-    ASSERT(pending_sparks_hds[p]==spark);
-    pending_sparks_hds[p] = spark->next;
-  } else {
-    spark->prev->next = spark->next;
-  }
-  if (spark->next==NULL) {
-    ASSERT(pending_sparks_tls[p]==spark);
-    /* spark is first spark of queue => adjust tl pointer */
-    pending_sparks_tls[p] = spark->prev;
-  } else {
-    spark->next->prev = spark->prev;
-  }
-  new_spark = spark->next;
-  
-#  if defined(GRAN_CHECK)
-  if ( RtsFlags.GranFlags.Debug.checkSparkQ ) {
-    debugBelch("## |%p:%p| (%p)<-spark=%p->(%p) <-(%p); spark=%p will be deleted NOW \n",
-	    pending_sparks_hd, pending_sparks_tl,
-	    spark->prev, spark, spark->next, 
-	    (spark->next==NULL ? 0 : spark->next->prev), spark);
-  }
-#  endif
-
-  if (dispose_too)
-    disposeSpark(spark);
-                  
-  return new_spark;
-}
-
-/* Mark all nodes pointed to by sparks in the spark queues (for GC) */
-void
-markSparkQueue(void)
-{ 
-  StgClosure *MarkRoot(StgClosure *root); // prototype
-  PEs p;
-  rtsSpark *sp;
-
-  for (p=0; p<RtsFlags.GranFlags.proc; p++)
-    for (sp=pending_sparks_hds[p]; sp!=NULL; sp=sp->next) {
-      ASSERT(sp->node!=NULL);
-      ASSERT(LOOKS_LIKE_GHC_INFO(sp->node->header.info));
-      // ToDo?: statistics gathering here (also for GUM!)
-      sp->node = (StgClosure *)MarkRoot(sp->node);
-    }
-  IF_DEBUG(gc,
-	   debugBelch("@@ markSparkQueue: spark statistics at start of GC:");
-	   print_sparkq_stats());
-}
-
-void
-print_spark(spark)
-rtsSpark *spark;
-{ 
-  char str[16];
-
-  if (spark==NULL) {
-    debugBelch("Spark: NIL\n");
-    return;
-  } else {
-    sprintf(str,
-	    ((spark->node==NULL) ? "______" : "%#6lx"), 
-	    stgCast(StgPtr,spark->node));
-
-    debugBelch("Spark: Node %8s, Name %#6x, Global %5s, Creator %5x, Prev %6p, Next %6p\n",
-	    str, spark->name, 
-            ((spark->global)==rtsTrue?"True":"False"), spark->creator, 
-            spark->prev, spark->next);
-  }
-}
-
-void
-print_sparkq(proc)
-PEs proc;
-// rtsSpark *hd;
-{
-  rtsSpark *x = pending_sparks_hds[proc];
-
-  debugBelch("Spark Queue of PE %d with root at %p:\n", proc, x);
-  for (; x!=(rtsSpark*)NULL; x=x->next) {
-    print_spark(x);
-  }
-}
-
-/* 
-   Print a statistics of all spark queues.
-*/
-void
-print_sparkq_stats(void)
-{
-  PEs p;
-
-  debugBelch("SparkQs: [");
-  for (p=0; p<RtsFlags.GranFlags.proc; p++)
-    debugBelch(", PE %d: %d", p, spark_queue_len(p));
-  debugBelch("\n");
-}
-
-#endif
diff --git a/ghc/rts/Sparks.h b/ghc/rts/Sparks.h
deleted file mode 100644
index 77d280bea8..0000000000
--- a/ghc/rts/Sparks.h
+++ /dev/null
@@ -1,104 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2000-2006
- *
- * Sparking support for GRAN, PAR and THREADED_RTS versions of the RTS.
- * 
- * ---------------------------------------------------------------------------*/
-
-#ifndef SPARKS_H
-#define SPARKS_H
-
-#if !defined(GRAN)
-StgInt newSpark (StgRegTable *reg, StgClosure *p);
-#endif
-
-#if defined(PARALLEL_HASKELL) || defined(THREADED_RTS)
-StgClosure * findSpark         (Capability *cap);
-void         initSparkPools    (void);
-void         markSparkQueue    (evac_fn evac);
-void         createSparkThread (Capability *cap, StgClosure *p);
-
-INLINE_HEADER void     discardSparks  (StgSparkPool *pool);
-INLINE_HEADER nat      sparkPoolSize  (StgSparkPool *pool);
-INLINE_HEADER rtsBool  emptySparkPool (StgSparkPool *pool);
-
-INLINE_HEADER void     discardSparksCap  (Capability *cap);
-INLINE_HEADER nat      sparkPoolSizeCap  (Capability *cap);
-INLINE_HEADER rtsBool  emptySparkPoolCap (Capability *cap);
-#endif
-
-#if defined(PARALLEL_HASKELL)
-StgTSO      *activateSpark (rtsSpark spark) ;
-rtsBool      add_to_spark_queue( StgClosure *closure, StgSparkPool *pool );
-void         markSparkQueue( void );
-nat          spark_queue_len( StgSparkPool *pool );
-void         disposeSpark( StgClosure *spark );
-#endif
-
-#if defined(GRAN)
-void      findLocalSpark (rtsEvent *event, rtsBool *found_res, rtsSparkQ *spark_res);
-rtsBool   activateSpark (rtsEvent *event, rtsSparkQ spark);
-rtsSpark *newSpark(StgClosure *node, nat name, nat gran_info, 
-		   nat size_info, nat par_info, nat local);
-void      add_to_spark_queue(rtsSpark *spark);
-rtsSpark *delete_from_sparkq (rtsSpark *spark, PEs p, rtsBool dispose_too);
-void 	  disposeSpark(rtsSpark *spark);
-void 	  disposeSparkQ(rtsSparkQ spark);
-void 	  print_spark(rtsSpark *spark);
-void      print_sparkq(PEs proc);
-void 	  print_sparkq_stats(void);
-nat  	  spark_queue_len(PEs proc);
-void      markSparkQueue(void);
-#endif
-
-/* -----------------------------------------------------------------------------
- * PRIVATE below here
- * -------------------------------------------------------------------------- */
-
-#if defined(PARALLEL_HASKELL) || defined(THREADED_RTS)
-
-INLINE_HEADER rtsBool
-emptySparkPool (StgSparkPool *pool)
-{
-    return (pool->hd == pool->tl);
-}
-
-INLINE_HEADER rtsBool
-emptySparkPoolCap (Capability *cap) 
-{ return emptySparkPool(&cap->r.rSparks); }
-
-INLINE_HEADER nat
-sparkPoolSize (StgSparkPool *pool) 
-{
-    if (pool->hd <= pool->tl) {
-	return (pool->hd - pool->tl);
-    } else {
-	return (pool->lim - pool->hd + pool->tl - pool->base);
-    }
-}
-
-INLINE_HEADER nat
-sparkPoolSizeCap (Capability *cap) 
-{ return sparkPoolSize(&cap->r.rSparks); }
-
-INLINE_HEADER void
-discardSparks (StgSparkPool *pool)
-{
-    pool->hd = pool->tl;
-}
-
-INLINE_HEADER void
-discardSparksCap (Capability *cap) 
-{ return discardSparks(&cap->r.rSparks); }
-
-
-#elif defined(THREADED_RTS) 
-
-INLINE_HEADER rtsBool
-emptySparkPoolCap (Capability *cap STG_UNUSED)
-{ return rtsTrue; }
-
-#endif
-
-#endif /* SPARKS_H */
diff --git a/ghc/rts/Stable.c b/ghc/rts/Stable.c
deleted file mode 100644
index a4db5cd749..0000000000
--- a/ghc/rts/Stable.c
+++ /dev/null
@@ -1,460 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2002
- *
- * Stable names and stable pointers.
- *
- * ---------------------------------------------------------------------------*/
-
-// Make static versions of inline functions in Stable.h:
-#define RTS_STABLE_C
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "Hash.h"
-#include "RtsUtils.h"
-#include "OSThreads.h"
-#include "Storage.h"
-#include "RtsAPI.h"
-#include "RtsFlags.h"
-#include "OSThreads.h"
-
-/* Comment from ADR's implementation in old RTS:
-
-  This files (together with @ghc/runtime/storage/PerformIO.lhc@ and a
-  small change in @HpOverflow.lc@) consists of the changes in the
-  runtime system required to implement "Stable Pointers". But we're
-  getting a bit ahead of ourselves --- what is a stable pointer and what
-  is it used for?
-
-  When Haskell calls C, it normally just passes over primitive integers,
-  floats, bools, strings, etc.  This doesn't cause any problems at all
-  for garbage collection because the act of passing them makes a copy
-  from the heap, stack or wherever they are onto the C-world stack.
-  However, if we were to pass a heap object such as a (Haskell) @String@
-  and a garbage collection occured before we finished using it, we'd run
-  into problems since the heap object might have been moved or even
-  deleted.
-
-  So, if a C call is able to cause a garbage collection or we want to
-  store a pointer to a heap object between C calls, we must be careful
-  when passing heap objects. Our solution is to keep a table of all
-  objects we've given to the C-world and to make sure that the garbage
-  collector collects these objects --- updating the table as required to
-  make sure we can still find the object.
-
-
-  Of course, all this rather begs the question: why would we want to
-  pass a boxed value?
-
-  One very good reason is to preserve laziness across the language
-  interface. Rather than evaluating an integer or a string because it
-  {\em might\/} be required by the C function, we can wait until the C
-  function actually wants the value and then force an evaluation.
-
-  Another very good reason (the motivating reason!) is that the C code
-  might want to execute an object of sort $IO ()$ for the side-effects
-  it will produce. For example, this is used when interfacing to an X
-  widgets library to allow a direct implementation of callbacks.
-
-
-  The @makeStablePointer :: a -> IO (StablePtr a)@ function
-  converts a value into a stable pointer.  It is part of the @PrimIO@
-  monad, because we want to be sure we don't allocate one twice by
-  accident, and then only free one of the copies.
-
-  \begin{verbatim}
-  makeStablePtr#  :: a -> State# RealWorld -> (# RealWorld, a #)
-  freeStablePtr#  :: StablePtr# a -> State# RealWorld -> State# RealWorld
-  deRefStablePtr# :: StablePtr# a -> State# RealWorld -> 
-        (# State# RealWorld, a #)
-  \end{verbatim}
-
-  There may be additional functions on the C side to allow evaluation,
-  application, etc of a stable pointer.
-
-*/
-
-snEntry *stable_ptr_table = NULL;
-static snEntry *stable_ptr_free = NULL;
-
-static unsigned int SPT_size = 0;
-
-#ifdef THREADED_RTS
-static Mutex stable_mutex;
-#endif
-
-/* This hash table maps Haskell objects to stable names, so that every
- * call to lookupStableName on a given object will return the same
- * stable name.
- *
- * OLD COMMENTS about reference counting follow.  The reference count
- * in a stable name entry is now just a counter.
- *
- * Reference counting
- * ------------------
- * A plain stable name entry has a zero reference count, which means
- * the entry will dissappear when the object it points to is
- * unreachable.  For stable pointers, we need an entry that sticks
- * around and keeps the object it points to alive, so each stable name
- * entry has an associated reference count.
- *
- * A stable pointer has a weighted reference count N attached to it
- * (actually in its upper 5 bits), which represents the weight
- * 2^(N-1).  The stable name entry keeps a 32-bit reference count, which
- * represents any weight between 1 and 2^32 (represented as zero).
- * When the weight is 2^32, the stable name table owns "all" of the
- * stable pointers to this object, and the entry can be garbage
- * collected if the object isn't reachable.
- *
- * A new stable pointer is given the weight log2(W/2), where W is the
- * weight stored in the table entry.  The new weight in the table is W
- * - 2^log2(W/2).
- *
- * A stable pointer can be "split" into two stable pointers, by
- * dividing the weight by 2 and giving each pointer half.
- * When freeing a stable pointer, the weight of the pointer is added
- * to the weight stored in the table entry.
- * */
-
-static HashTable *addrToStableHash = NULL;
-
-#define INIT_SPT_SIZE 64
-
-STATIC_INLINE void
-initFreeList(snEntry *table, nat n, snEntry *free)
-{
-  snEntry *p;
-
-  for (p = table + n - 1; p >= table; p--) {
-    p->addr   = (P_)free;
-    p->old    = NULL;
-    p->ref    = 0;
-    p->sn_obj = NULL;
-    free = p;
-  }
-  stable_ptr_free = table;
-}
-
-void
-initStablePtrTable(void)
-{
-	if (SPT_size > 0)
-		return;
-
-    SPT_size = INIT_SPT_SIZE;
-    stable_ptr_table = stgMallocBytes(SPT_size * sizeof(snEntry),
-				      "initStablePtrTable");
-
-    /* we don't use index 0 in the stable name table, because that
-     * would conflict with the hash table lookup operations which
-     * return NULL if an entry isn't found in the hash table.
-     */
-    initFreeList(stable_ptr_table+1,INIT_SPT_SIZE-1,NULL);
-    addrToStableHash = allocHashTable();
-
-#ifdef THREADED_RTS
-    initMutex(&stable_mutex);
-#endif
-}
-
-/*
- * get at the real stuff...remove indirections.
- *
- * ToDo: move to a better home.
- */
-static
-StgClosure*
-removeIndirections(StgClosure* p)
-{
-  StgClosure* q = p;
-
-  while (get_itbl(q)->type == IND ||
-         get_itbl(q)->type == IND_STATIC ||
-         get_itbl(q)->type == IND_OLDGEN ||
-         get_itbl(q)->type == IND_PERM ||
-         get_itbl(q)->type == IND_OLDGEN_PERM ) {
-      q = ((StgInd *)q)->indirectee;
-  }
-  return q;
-}
-
-static StgWord
-lookupStableName_(StgPtr p)
-{
-  StgWord sn;
-  void* sn_tmp;
-
-  if (stable_ptr_free == NULL) {
-    enlargeStablePtrTable();
-  }
-
-  /* removing indirections increases the likelihood
-   * of finding a match in the stable name hash table.
-   */
-  p = (StgPtr)removeIndirections((StgClosure*)p);
-
-  sn_tmp = lookupHashTable(addrToStableHash,(W_)p);
-  sn = (StgWord)sn_tmp;
-  
-  if (sn != 0) {
-    ASSERT(stable_ptr_table[sn].addr == p);
-    IF_DEBUG(stable,debugBelch("cached stable name %ld at %p\n",sn,p));
-    return sn;
-  } else {
-    sn = stable_ptr_free - stable_ptr_table;
-    stable_ptr_free  = (snEntry*)(stable_ptr_free->addr);
-    stable_ptr_table[sn].ref = 0;
-    stable_ptr_table[sn].addr = p;
-    stable_ptr_table[sn].sn_obj = NULL;
-    /* IF_DEBUG(stable,debugBelch("new stable name %d at %p\n",sn,p)); */
-    
-    /* add the new stable name to the hash table */
-    insertHashTable(addrToStableHash, (W_)p, (void *)sn);
-
-    return sn;
-  }
-}
-
-StgWord
-lookupStableName(StgPtr p)
-{
-    StgWord res;
-
-    initStablePtrTable();
-    ACQUIRE_LOCK(&stable_mutex);
-    res = lookupStableName_(p);
-    RELEASE_LOCK(&stable_mutex);
-    return res;
-}
-
-STATIC_INLINE void
-freeStableName(snEntry *sn)
-{
-  ASSERT(sn->sn_obj == NULL);
-  if (sn->addr != NULL) {
-      removeHashTable(addrToStableHash, (W_)sn->addr, NULL);
-  }
-  sn->addr = (P_)stable_ptr_free;
-  stable_ptr_free = sn;
-}
-
-StgStablePtr
-getStablePtr(StgPtr p)
-{
-  StgWord sn;
-
-  initStablePtrTable();
-  ACQUIRE_LOCK(&stable_mutex);
-  sn = lookupStableName_(p);
-  stable_ptr_table[sn].ref++;
-  RELEASE_LOCK(&stable_mutex);
-  return (StgStablePtr)(sn);
-}
-
-void
-freeStablePtr(StgStablePtr sp)
-{
-    snEntry *sn;
-
-	initStablePtrTable();
-    ACQUIRE_LOCK(&stable_mutex);
-
-    sn = &stable_ptr_table[(StgWord)sp];
-    
-    ASSERT((StgWord)sp < SPT_size  &&  sn->addr != NULL  &&  sn->ref > 0);
-
-    sn->ref--;
-
-    // If this entry has no StableName attached, then just free it
-    // immediately.  This is important; it might be a while before the
-    // next major GC which actually collects the entry.
-    if (sn->sn_obj == NULL && sn->ref == 0) {
-	freeStableName(sn);
-    }
-
-    RELEASE_LOCK(&stable_mutex);
-}
-
-void
-enlargeStablePtrTable(void)
-{
-  nat old_SPT_size = SPT_size;
-
-    // 2nd and subsequent times
-  SPT_size *= 2;
-  stable_ptr_table =
-    stgReallocBytes(stable_ptr_table,
-		      SPT_size * sizeof(snEntry),
-		      "enlargeStablePtrTable");
-
-  initFreeList(stable_ptr_table + old_SPT_size, old_SPT_size, NULL);
-}
-
-/* -----------------------------------------------------------------------------
- * Treat stable pointers as roots for the garbage collector.
- *
- * A stable pointer is any stable name entry with a ref > 0.  We'll
- * take the opportunity to zero the "keep" flags at the same time.
- * -------------------------------------------------------------------------- */
-
-void
-markStablePtrTable(evac_fn evac)
-{
-    snEntry *p, *end_stable_ptr_table;
-    StgPtr q;
-    
-    end_stable_ptr_table = &stable_ptr_table[SPT_size];
-    
-    // Mark all the stable *pointers* (not stable names).
-    // _starting_ at index 1; index 0 is unused.
-    for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) {
-	q = p->addr;
-
-	// Internal pointers are free slots.  If q == NULL, it's a
-	// stable name where the object has been GC'd, but the
-	// StableName object (sn_obj) is still alive.
-	if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {
-
-	    // save the current addr away: we need to be able to tell
-	    // whether the objects moved in order to be able to update
-	    // the hash table later.
-	    p->old = p->addr;
-
-	    // if the ref is non-zero, treat addr as a root
-	    if (p->ref != 0) {
-		evac((StgClosure **)&p->addr);
-	    }
-	}
-    }
-}
-
-/* -----------------------------------------------------------------------------
- * Thread the stable pointer table for compacting GC.
- * 
- * Here we must call the supplied evac function for each pointer into
- * the heap from the stable pointer table, because the compacting
- * collector may move the object it points to.
- * -------------------------------------------------------------------------- */
-
-void
-threadStablePtrTable( evac_fn evac )
-{
-    snEntry *p, *end_stable_ptr_table;
-    StgPtr q;
-    
-    end_stable_ptr_table = &stable_ptr_table[SPT_size];
-    
-    for (p = stable_ptr_table+1; p < end_stable_ptr_table; p++) {
-	
-	if (p->sn_obj != NULL) {
-	    evac((StgClosure **)&p->sn_obj);
-	}
-
-	q = p->addr;
-	if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {
-	    evac((StgClosure **)&p->addr);
-	}
-    }
-}
-
-/* -----------------------------------------------------------------------------
- * Garbage collect any dead entries in the stable pointer table.
- *
- * A dead entry has:
- *
- *          - a zero reference count
- *          - a dead sn_obj
- *
- * Both of these conditions must be true in order to re-use the stable
- * name table entry.  We can re-use stable name table entries for live
- * heap objects, as long as the program has no StableName objects that
- * refer to the entry.
- * -------------------------------------------------------------------------- */
-
-void
-gcStablePtrTable( void )
-{
-    snEntry *p, *end_stable_ptr_table;
-    StgPtr q;
-    
-    end_stable_ptr_table = &stable_ptr_table[SPT_size];
-    
-    // NOTE: _starting_ at index 1; index 0 is unused.
-    for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) {
-	
-	// Update the pointer to the StableName object, if there is one
-	if (p->sn_obj != NULL) {
-	    p->sn_obj = isAlive(p->sn_obj);
-	}
-	
-	// Internal pointers are free slots.  If q == NULL, it's a
-	// stable name where the object has been GC'd, but the
-	// StableName object (sn_obj) is still alive.
-	q = p->addr;
-	if (q && (q < (P_)stable_ptr_table || q >= (P_)end_stable_ptr_table)) {
-
-	    // StableNames only:
-	    if (p->ref == 0) {
-		if (p->sn_obj == NULL) {
-		    // StableName object is dead
-		    freeStableName(p);
-		    IF_DEBUG(stable, debugBelch("GC'd Stable name %ld\n", 
-						p - stable_ptr_table));
-		    continue;
-		    
-		} else {
-		  p->addr = (StgPtr)isAlive((StgClosure *)p->addr);
-		    IF_DEBUG(stable, debugBelch("Stable name %ld still alive at %p, ref %ld\n", p - stable_ptr_table, p->addr, p->ref));
-		}
-	    }
-	}
-    }
-}
-
-/* -----------------------------------------------------------------------------
- * Update the StablePtr/StableName hash table
- *
- * The boolean argument 'full' indicates that a major collection is
- * being done, so we might as well throw away the hash table and build
- * a new one.  For a minor collection, we just re-hash the elements
- * that changed.
- * -------------------------------------------------------------------------- */
-
-void
-updateStablePtrTable(rtsBool full)
-{
-    snEntry *p, *end_stable_ptr_table;
-    
-    if (full && addrToStableHash != NULL) {
-	freeHashTable(addrToStableHash,NULL);
-	addrToStableHash = allocHashTable();
-    }
-    
-    end_stable_ptr_table = &stable_ptr_table[SPT_size];
-    
-    // NOTE: _starting_ at index 1; index 0 is unused.
-    for (p = stable_ptr_table + 1; p < end_stable_ptr_table; p++) {
-	
-	if (p->addr == NULL) {
-	    if (p->old != NULL) {
-		// The target has been garbage collected.  Remove its
-		// entry from the hash table.
-		removeHashTable(addrToStableHash, (W_)p->old, NULL);
-		p->old = NULL;
-	    }
-	}
-	else if (p->addr < (P_)stable_ptr_table 
-		 || p->addr >= (P_)end_stable_ptr_table) {
-	    // Target still alive, Re-hash this stable name 
-	    if (full) {
-		insertHashTable(addrToStableHash, (W_)p->addr, 
-				(void *)(p - stable_ptr_table));
-	    } else if (p->addr != p->old) {
-		removeHashTable(addrToStableHash, (W_)p->old, NULL);
-		insertHashTable(addrToStableHash, (W_)p->addr, 
-				(void *)(p - stable_ptr_table));
-	    }
-	}
-    }
-}
diff --git a/ghc/rts/Stats.c b/ghc/rts/Stats.c
deleted file mode 100644
index 28d09bdbed..0000000000
--- a/ghc/rts/Stats.c
+++ /dev/null
@@ -1,632 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Statistics and timing-related functions.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "MBlock.h"
-#include "Schedule.h"
-#include "Stats.h"
-#include "ParTicky.h"                       /* ToDo: move into Rts.h */
-#include "Profiling.h"
-#include "Storage.h"
-#include "GetTime.h"
-
-/* huh? */
-#define BIG_STRING_LEN              512
-
-#define TICK_TO_DBL(t) ((double)(t) / TICKS_PER_SECOND)
-
-static Ticks ElapsedTimeStart = 0;
-
-static Ticks InitUserTime     = 0;
-static Ticks InitElapsedTime  = 0;
-static Ticks InitElapsedStamp = 0;
-
-static Ticks MutUserTime      = 0;
-static Ticks MutElapsedTime   = 0;
-static Ticks MutElapsedStamp  = 0;
-
-static Ticks ExitUserTime     = 0;
-static Ticks ExitElapsedTime  = 0;
-
-static ullong GC_tot_alloc        = 0;
-static ullong GC_tot_copied       = 0;
-static ullong GC_tot_scavd_copied = 0;
-
-static Ticks GC_start_time = 0,  GC_tot_time  = 0;  /* User GC Time */
-static Ticks GCe_start_time = 0, GCe_tot_time = 0;  /* Elapsed GC time */
-
-#ifdef PROFILING
-static Ticks RP_start_time  = 0, RP_tot_time  = 0;  /* retainer prof user time */
-static Ticks RPe_start_time = 0, RPe_tot_time = 0;  /* retainer prof elap time */
-
-static Ticks HC_start_time, HC_tot_time = 0;     // heap census prof user time
-static Ticks HCe_start_time, HCe_tot_time = 0;   // heap census prof elap time
-#endif
-
-#ifdef PROFILING
-#define PROF_VAL(x)   (x)
-#else
-#define PROF_VAL(x)   0
-#endif
-
-static lnat MaxResidency = 0;     // in words; for stats only
-static lnat AvgResidency = 0;
-static lnat ResidencySamples = 0; // for stats only
-
-static lnat GC_start_faults = 0, GC_end_faults = 0;
-
-static Ticks *GC_coll_times;
-
-static void statsPrintf( char *s, ... ) 
-    GNUC3_ATTRIBUTE(format (printf, 1, 2));
-
-static void statsFlush( void );
-static void statsClose( void );
-
-Ticks stat_getElapsedGCTime(void)
-{
-    return GCe_tot_time;
-}
-
-/* mut_user_time_during_GC() and mut_user_time()
- *
- * The former function can be used to get the current mutator time
- * *during* a GC, i.e. between stat_startGC and stat_endGC.  This is
- * used in the heap profiler for accurately time stamping the heap
- * sample.  
- *
- * ATTENTION: mut_user_time_during_GC() relies on GC_start_time being 
- *	      defined in stat_startGC() - to minimise system calls, 
- *	      GC_start_time is, however, only defined when really needed (check
- *	      stat_startGC() for details)
- */
-double
-mut_user_time_during_GC( void )
-{
-  return TICK_TO_DBL(GC_start_time - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time));
-}
-
-double
-mut_user_time( void )
-{
-    Ticks user;
-    user = getProcessCPUTime();
-    return TICK_TO_DBL(user - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time));
-}
-
-#ifdef PROFILING
-/*
-  mut_user_time_during_RP() is similar to mut_user_time_during_GC();
-  it returns the MUT time during retainer profiling.
-  The same is for mut_user_time_during_HC();
- */
-double
-mut_user_time_during_RP( void )
-{
-  return TICK_TO_DBL(RP_start_time - GC_tot_time - RP_tot_time - HC_tot_time);
-}
-
-double
-mut_user_time_during_heap_census( void )
-{
-  return TICK_TO_DBL(HC_start_time - GC_tot_time - RP_tot_time - HC_tot_time);
-}
-#endif /* PROFILING */
-
-void
-initStats(void)
-{
-    nat i;
-  
-    if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
-	statsPrintf("    Alloc    Copied     Live    GC    GC     TOT     TOT  Page Flts\n");
-	statsPrintf("    bytes     bytes     bytes  user  elap    user    elap\n");
-    }
-    GC_coll_times = 
-	(Ticks *)stgMallocBytes(
-	    sizeof(Ticks)*RtsFlags.GcFlags.generations,
-	    "initStats");
-    for (i = 0; i < RtsFlags.GcFlags.generations; i++) {
-	GC_coll_times[i] = 0;
-    }
-}    
-
-/* -----------------------------------------------------------------------------
-   Initialisation time...
-   -------------------------------------------------------------------------- */
-
-void
-stat_startInit(void)
-{
-    Ticks elapsed;
-
-    elapsed = getProcessElapsedTime();
-    ElapsedTimeStart = elapsed;
-}
-
-void 
-stat_endInit(void)
-{
-    Ticks user, elapsed;
-
-    getProcessTimes(&user, &elapsed);
-
-    InitUserTime = user;
-    InitElapsedStamp = elapsed; 
-    if (ElapsedTimeStart > elapsed) {
-	InitElapsedTime = 0;
-    } else {
-	InitElapsedTime = elapsed - ElapsedTimeStart;
-    }
-}
-
-/* -----------------------------------------------------------------------------
-   stat_startExit and stat_endExit
-   
-   These two measure the time taken in shutdownHaskell().
-   -------------------------------------------------------------------------- */
-
-void
-stat_startExit(void)
-{
-    Ticks user, elapsed;
-
-    getProcessTimes(&user, &elapsed);
-
-    MutElapsedStamp = elapsed;
-    MutElapsedTime = elapsed - GCe_tot_time -
-	PROF_VAL(RPe_tot_time + HCe_tot_time) - InitElapsedStamp;
-    if (MutElapsedTime < 0) { MutElapsedTime = 0; }	/* sometimes -0.00 */
-
-    MutUserTime = user - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime;
-    if (MutUserTime < 0) { MutUserTime = 0; }
-}
-
-void
-stat_endExit(void)
-{
-    Ticks user, elapsed;
-
-    getProcessTimes(&user, &elapsed);
-
-    ExitUserTime = user - MutUserTime - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime;
-    ExitElapsedTime = elapsed - MutElapsedStamp;
-    if (ExitUserTime < 0) {
-	ExitUserTime = 0;
-    }
-    if (ExitElapsedTime < 0) {
-	ExitElapsedTime = 0;
-    }
-}
-
-/* -----------------------------------------------------------------------------
-   Called at the beginning of each GC
-   -------------------------------------------------------------------------- */
-
-static nat rub_bell = 0;
-
-/*  initialise global variables needed during GC
- *
- *  * GC_start_time is read in mut_user_time_during_GC(), which in turn is 
- *    needed if either PROFILING or DEBUGing is enabled
- */
-void
-stat_startGC(void)
-{
-    nat bell = RtsFlags.GcFlags.ringBell;
-
-    if (bell) {
-	if (bell > 1) {
-	    debugBelch(" GC ");
-	    rub_bell = 1;
-	} else {
-	    debugBelch("\007");
-	}
-    }
-
-#if defined(PROFILING) || defined(DEBUG)
-    GC_start_time = getProcessCPUTime();  // needed in mut_user_time_during_GC()
-#endif
-
-    if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
-#if !defined(PROFILING) && !defined(DEBUG)
-        GC_start_time = getProcessCPUTime();
-#endif
-	GCe_start_time = getProcessElapsedTime();
-	if (RtsFlags.GcFlags.giveStats) {
-	    GC_start_faults = getPageFaults();
-	}
-    }
-}
-
-/* -----------------------------------------------------------------------------
-   Called at the end of each GC
-   -------------------------------------------------------------------------- */
-
-void
-stat_endGC (lnat alloc, lnat live, lnat copied, 
-	    lnat scavd_copied, lnat gen)
-{
-    if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
-	Ticks time, etime, gc_time, gc_etime;
-	
-	getProcessTimes(&time, &etime);
-	gc_time  = time - GC_start_time;
-	gc_etime = etime - GCe_start_time;
-	
-	if (RtsFlags.GcFlags.giveStats == VERBOSE_GC_STATS) {
-	    nat faults = getPageFaults();
-	    
-	    statsPrintf("%9ld %9ld %9ld",
-		    alloc*sizeof(W_), (copied+scavd_copied)*sizeof(W_), 
-			live*sizeof(W_));
-	    statsPrintf(" %5.2f %5.2f %7.2f %7.2f %4ld %4ld  (Gen: %2ld)\n", 
-		    TICK_TO_DBL(gc_time),
-		    TICK_TO_DBL(gc_etime),
-		    TICK_TO_DBL(time),
-		    TICK_TO_DBL(etime - ElapsedTimeStart),
-		    faults - GC_start_faults,
-		    GC_start_faults - GC_end_faults,
-		    gen);
-
-	    GC_end_faults = faults;
-	    statsFlush();
-	}
-
-	GC_coll_times[gen] += gc_time;
-
-	GC_tot_copied += (ullong) copied;
-	GC_tot_scavd_copied += (ullong) scavd_copied;
-	GC_tot_alloc  += (ullong) alloc;
-	GC_tot_time   += gc_time;
-	GCe_tot_time  += gc_etime;
-	
-#if defined(THREADED_RTS)
-	{
-	    Task *task;
-	    if ((task = myTask()) != NULL) {
-		task->gc_time += gc_time;
-		task->gc_etime += gc_etime;
-	    }
-	}
-#endif
-
-	if (gen == RtsFlags.GcFlags.generations-1) { /* major GC? */
-	    if (live > MaxResidency) {
-		MaxResidency = live;
-	    }
-	    ResidencySamples++;
-	    AvgResidency += live;
-	}
-    }
-
-    if (rub_bell) {
-	debugBelch("\b\b\b  \b\b\b");
-	rub_bell = 0;
-    }
-}
-
-/* -----------------------------------------------------------------------------
-   Called at the beginning of each Retainer Profiliing
-   -------------------------------------------------------------------------- */
-#ifdef PROFILING
-void
-stat_startRP(void)
-{
-    Ticks user, elapsed;
-    getProcessTimes( &user, &elapsed );
-
-    RP_start_time = user;
-    RPe_start_time = elapsed;
-}
-#endif /* PROFILING */
-
-/* -----------------------------------------------------------------------------
-   Called at the end of each Retainer Profiliing
-   -------------------------------------------------------------------------- */
-
-#ifdef PROFILING
-void
-stat_endRP(
-  nat retainerGeneration,
-#ifdef DEBUG_RETAINER
-  nat maxCStackSize,
-  int maxStackSize,
-#endif
-  double averageNumVisit)
-{
-    Ticks user, elapsed;
-    getProcessTimes( &user, &elapsed );
-
-    RP_tot_time += user - RP_start_time;
-    RPe_tot_time += elapsed - RPe_start_time;
-
-  fprintf(prof_file, "Retainer Profiling: %d, at %f seconds\n", 
-    retainerGeneration, mut_user_time_during_RP());
-#ifdef DEBUG_RETAINER
-  fprintf(prof_file, "\tMax C stack size = %u\n", maxCStackSize);
-  fprintf(prof_file, "\tMax auxiliary stack size = %u\n", maxStackSize);
-#endif
-  fprintf(prof_file, "\tAverage number of visits per object = %f\n", averageNumVisit);
-}
-#endif /* PROFILING */
-
-/* -----------------------------------------------------------------------------
-   Called at the beginning of each heap census
-   -------------------------------------------------------------------------- */
-#ifdef PROFILING
-void
-stat_startHeapCensus(void)
-{
-    Ticks user, elapsed;
-    getProcessTimes( &user, &elapsed );
-
-    HC_start_time = user;
-    HCe_start_time = elapsed;
-}
-#endif /* PROFILING */
-
-/* -----------------------------------------------------------------------------
-   Called at the end of each heap census
-   -------------------------------------------------------------------------- */
-#ifdef PROFILING
-void
-stat_endHeapCensus(void) 
-{
-    Ticks user, elapsed;
-    getProcessTimes( &user, &elapsed );
-
-    HC_tot_time += user - HC_start_time;
-    HCe_tot_time += elapsed - HCe_start_time;
-}
-#endif /* PROFILING */
-
-/* -----------------------------------------------------------------------------
-   Called at the end of execution
-
-   NOTE: number of allocations is not entirely accurate: it doesn't
-   take into account the few bytes at the end of the heap that
-   were left unused when the heap-check failed.
-   -------------------------------------------------------------------------- */
-
-void
-stat_exit(int alloc)
-{
-    if (RtsFlags.GcFlags.giveStats != NO_GC_STATS) {
-
-	char temp[BIG_STRING_LEN];
-	Ticks time;
-	Ticks etime;
-	nat g, total_collections = 0;
-
-	getProcessTimes( &time, &etime );
-	etime -= ElapsedTimeStart;
-
-	GC_tot_alloc += alloc;
-
-	/* Count total garbage collections */
-	for (g = 0; g < RtsFlags.GcFlags.generations; g++)
-	    total_collections += generations[g].collections;
-
-	/* avoid divide by zero if time is measured as 0.00 seconds -- SDM */
-	if (time  == 0.0)  time = 1;
-	if (etime == 0.0) etime = 1;
-	
-	if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
-	    statsPrintf("%9ld %9.9s %9.9s", (lnat)alloc*sizeof(W_), "", "");
-	    statsPrintf(" %5.2f %5.2f\n\n", 0.0, 0.0);
-	}
-
-	if (RtsFlags.GcFlags.giveStats >= SUMMARY_GC_STATS) {
-	    ullong_format_string(GC_tot_alloc*sizeof(W_), 
-				 temp, rtsTrue/*commas*/);
-	    statsPrintf("%11s bytes allocated in the heap\n", temp);
-
-	    ullong_format_string(GC_tot_copied*sizeof(W_), 
-				 temp, rtsTrue/*commas*/);
-	    statsPrintf("%11s bytes copied during GC (scavenged)\n", temp);
-
-	    ullong_format_string(GC_tot_scavd_copied*sizeof(W_), 
-				 temp, rtsTrue/*commas*/);
-	    statsPrintf("%11s bytes copied during GC (not scavenged)\n", temp);
-  
-	    if ( ResidencySamples > 0 ) {
-		ullong_format_string(MaxResidency*sizeof(W_), 
-				     temp, rtsTrue/*commas*/);
-		statsPrintf("%11s bytes maximum residency (%ld sample(s))\n",
-			temp, ResidencySamples);
-	    }
-	    statsPrintf("\n");
-
-	    /* Print garbage collections in each gen */
-	    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-		statsPrintf("%11d collections in generation %d (%6.2fs)\n", 
-			generations[g].collections, g, 
-			TICK_TO_DBL(GC_coll_times[g]));
-	    }
-
-	    statsPrintf("\n%11ld Mb total memory in use\n\n", 
-		    mblocks_allocated * MBLOCK_SIZE / (1024 * 1024));
-
-#if defined(THREADED_RTS)
-	    {
-		nat i;
-		Task *task;
-		for (i = 0, task = all_tasks; 
-		     task != NULL; 
-		     i++, task = task->all_link) {
-		    statsPrintf("  Task %2d %-8s :  MUT time: %6.2fs  (%6.2fs elapsed)\n"
-			    "                      GC  time: %6.2fs  (%6.2fs elapsed)\n\n", 
-				i,
-				(task->tso == NULL) ? "(worker)" : "(bound)",
-				TICK_TO_DBL(task->mut_time),
-				TICK_TO_DBL(task->mut_etime),
-				TICK_TO_DBL(task->gc_time),
-				TICK_TO_DBL(task->gc_etime));
-		}
-	    }
-#endif
-
-	    statsPrintf("  INIT  time  %6.2fs  (%6.2fs elapsed)\n",
-		    TICK_TO_DBL(InitUserTime), TICK_TO_DBL(InitElapsedTime));
-	    statsPrintf("  MUT   time  %6.2fs  (%6.2fs elapsed)\n",
-		    TICK_TO_DBL(MutUserTime), TICK_TO_DBL(MutElapsedTime));
-	    statsPrintf("  GC    time  %6.2fs  (%6.2fs elapsed)\n",
-		    TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
-#ifdef PROFILING
-	    statsPrintf("  RP    time  %6.2fs  (%6.2fs elapsed)\n",
-		    TICK_TO_DBL(RP_tot_time), TICK_TO_DBL(RPe_tot_time));
-	    statsPrintf("  PROF  time  %6.2fs  (%6.2fs elapsed)\n",
-		    TICK_TO_DBL(HC_tot_time), TICK_TO_DBL(HCe_tot_time));
-#endif 
-	    statsPrintf("  EXIT  time  %6.2fs  (%6.2fs elapsed)\n",
-		    TICK_TO_DBL(ExitUserTime), TICK_TO_DBL(ExitElapsedTime));
-	    statsPrintf("  Total time  %6.2fs  (%6.2fs elapsed)\n\n",
-		    TICK_TO_DBL(time), TICK_TO_DBL(etime));
-	    statsPrintf("  %%GC time     %5.1f%%  (%.1f%% elapsed)\n\n",
-		    TICK_TO_DBL(GC_tot_time)*100/TICK_TO_DBL(time),
-		    TICK_TO_DBL(GCe_tot_time)*100/TICK_TO_DBL(etime));
-
-	    if (time - GC_tot_time - PROF_VAL(RP_tot_time + HC_tot_time) == 0)
-		ullong_format_string(0, temp, rtsTrue/*commas*/);
-	    else
-		ullong_format_string(
-		    (ullong)((GC_tot_alloc*sizeof(W_))/
-			     TICK_TO_DBL(time - GC_tot_time - 
-					 PROF_VAL(RP_tot_time + HC_tot_time))),
-		    temp, rtsTrue/*commas*/);
-	    
-	    statsPrintf("  Alloc rate    %s bytes per MUT second\n\n", temp);
-	
-	    statsPrintf("  Productivity %5.1f%% of total user, %.1f%% of total elapsed\n\n",
-		    TICK_TO_DBL(time - GC_tot_time - 
-				PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime) * 100 
-		    / TICK_TO_DBL(time), 
-		    TICK_TO_DBL(time - GC_tot_time - 
-				PROF_VAL(RP_tot_time + HC_tot_time) - InitUserTime) * 100 
-		    / TICK_TO_DBL(etime));
-	}
-
-	if (RtsFlags.GcFlags.giveStats == ONELINE_GC_STATS) {
-	  /* print the long long separately to avoid bugginess on mingwin (2001-07-02, mingw-0.5) */
-	  statsPrintf("<<ghc: %llu bytes, ", GC_tot_alloc*(ullong)sizeof(W_));
-	  statsPrintf("%d GCs, %ld/%ld avg/max bytes residency (%ld samples), %luM in use, %.2f INIT (%.2f elapsed), %.2f MUT (%.2f elapsed), %.2f GC (%.2f elapsed) :ghc>>\n",
-		    total_collections,
-		    ResidencySamples == 0 ? 0 : 
-		        AvgResidency*sizeof(W_)/ResidencySamples, 
-		    MaxResidency*sizeof(W_), 
-		    ResidencySamples,
-		    (unsigned long)(mblocks_allocated * MBLOCK_SIZE / (1024L * 1024L)),
-		    TICK_TO_DBL(InitUserTime), TICK_TO_DBL(InitElapsedTime),
-		    TICK_TO_DBL(MutUserTime), TICK_TO_DBL(MutElapsedTime),
-		    TICK_TO_DBL(GC_tot_time), TICK_TO_DBL(GCe_tot_time));
-	}
-
-	statsFlush();
-	statsClose();
-    }
-}
-
-/* -----------------------------------------------------------------------------
-   stat_describe_gens
-
-   Produce some detailed info on the state of the generational GC.
-   -------------------------------------------------------------------------- */
-#ifdef DEBUG
-void
-statDescribeGens(void)
-{
-  nat g, s, mut, lge;
-  lnat live;
-  bdescr *bd;
-  step *step;
-
-  debugBelch(
-"     Gen    Steps      Max   Mutable  Step   Blocks     Live    Large\n"
-"                     Blocks Closures                          Objects\n");
-
-  mut = 0;
-  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-      for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
-	  mut += bd->free - bd->start;
-      }
-
-    debugBelch("%8d %8d %8d %9d", g, generations[g].n_steps,
-	    generations[g].max_blocks, mut);
-
-    for (s = 0; s < generations[g].n_steps; s++) {
-      step = &generations[g].steps[s];
-      live = 0;
-      for (bd = step->large_objects, lge = 0; bd; bd = bd->link) {
-	lge++;
-      }
-      live = step->n_large_blocks * BLOCK_SIZE;
-      bd = step->blocks;
-      // This live figure will be slightly less that the "live" figure
-      // given by +RTS -Sstderr, because we take don't count the
-      // slop at the end of each block.
-      for (; bd; bd = bd->link) {
-	live += (bd->free - bd->start) * sizeof(W_);
-      }
-      if (s != 0) {
-	debugBelch("%36s","");
-      }
-      debugBelch("%6d %8d %8d %8d\n", s, step->n_blocks,
-	      live, lge);
-    }
-  }
-  debugBelch("\n");
-}
-#endif
-
-/* -----------------------------------------------------------------------------
-   Stats available via a programmatic interface, so eg. GHCi can time
-   each compilation and expression evaluation.
-   -------------------------------------------------------------------------- */
-
-extern HsInt64 getAllocations( void ) 
-{ return (HsInt64)total_allocated * sizeof(W_); }
-
-/* -----------------------------------------------------------------------------
-   Dumping stuff in the stats file, or via the debug message interface
-   -------------------------------------------------------------------------- */
-
-static void
-statsPrintf( char *s, ... )
-{
-    FILE *sf = RtsFlags.GcFlags.statsFile;
-    va_list ap;
-    
-    va_start(ap,s);
-    if (sf == NULL) {
-	vdebugBelch(s,ap);
-    } else {
-	vfprintf(sf, s, ap);
-    }
-    va_end(ap);
-}
-
-static void
-statsFlush( void )
-{
-    FILE *sf = RtsFlags.GcFlags.statsFile;
-    if (sf != NULL) {
-	fflush(sf);
-    }
-}
-
-static void
-statsClose( void )
-{
-    FILE *sf = RtsFlags.GcFlags.statsFile;
-    if (sf != NULL) {
-	fclose(sf);
-    }
-}
diff --git a/ghc/rts/Stats.h b/ghc/rts/Stats.h
deleted file mode 100644
index 20bc0155ad..0000000000
--- a/ghc/rts/Stats.h
+++ /dev/null
@@ -1,56 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Statistics and timing-related functions.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef STATS_H
-#define STATS_H
-
-#include "GetTime.h"
-
-void      stat_startInit(void);
-void      stat_endInit(void);
-
-void      stat_startGC(void);
-void      stat_endGC (lnat alloc, lnat live, 
-		      lnat copied, lnat scavd_copied, lnat gen);
-
-#ifdef PROFILING
-void      stat_startRP(void);
-void      stat_endRP(nat, 
-#ifdef DEBUG_RETAINER
-                            nat, int, 
-#endif
-                            double);
-#endif /* PROFILING */
-
-#if defined(PROFILING) || defined(DEBUG)
-void      stat_startHeapCensus(void);
-void      stat_endHeapCensus(void);
-#endif
-
-void      stat_startExit(void);
-void      stat_endExit(void);
-
-void      stat_exit(int alloc);
-void      stat_workerStop(void);
-
-void      initStats(void);
-
-double    mut_user_time_during_GC(void);
-double    mut_user_time(void);
-
-#ifdef PROFILING
-double    mut_user_time_during_RP(void);
-double    mut_user_time_during_heap_census(void);
-#endif /* PROFILING */
-
-void      statDescribeGens( void );
-HsInt64   getAllocations( void );
-
-Ticks stat_getElapsedGCTime(void);
-
-#endif /* STATS_H */
diff --git a/ghc/rts/StgCRun.c b/ghc/rts/StgCRun.c
deleted file mode 100644
index c1afc16559..0000000000
--- a/ghc/rts/StgCRun.c
+++ /dev/null
@@ -1,897 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2003
- *
- * STG-to-C glue.
- *
- * To run an STG function from C land, call
- *
- *		rv = StgRun(f,BaseReg);
- *
- * where "f" is the STG function to call, and BaseReg is the address of the
- * RegTable for this run (we might have separate RegTables if we're running
- * multiple threads on an SMP machine).
- *
- * In the end, "f" must JMP to StgReturn (defined below),
- * passing the return-value "rv" in R1,
- * to return to the caller of StgRun returning "rv" in
- * the whatever way C returns a value.
- *
- * NOTE: StgRun/StgReturn do *NOT* load or store Hp or any
- * other registers (other than saving the C callee-saves
- * registers).  Instead, the called function "f" must do that
- * in STG land.
- *
- * GCC will have assumed that pushing/popping of C-stack frames is
- * going on when it generated its code, and used stack space
- * accordingly.  However, we actually {\em post-process away} all
- * such stack-framery (see \tr{ghc/driver/ghc-asm.lprl}). Things will
- * be OK however, if we initially make sure there are
- * @RESERVED_C_STACK_BYTES@ on the C-stack to begin with, for local
- * variables.
- *
- * -------------------------------------------------------------------------- */
-
-#include "PosixSource.h"
-
-
-/*
- * We define the following (unused) global register variables, because for
- * some reason gcc generates sub-optimal code for StgRun() on the Alpha
- * (unnecessarily saving extra registers on the stack) if we don't.
- *
- * Why do it at the top of this file, rather than near StgRun() below?  Because
- * gcc doesn't let us define global register variables after any function
- * definition has been read.  Any point after #include "Stg.h" would be too
- * late.
- *
- * We define alpha_EXTRA_CAREFUL here to save $s6, $f8 and $f9 -- registers
- * that we don't use but which are callee-save registers.  The __divq() routine
- * in libc.a clobbers $s6.
- */
-#include "ghcconfig.h"
-#ifdef alpha_HOST_ARCH
-#define alpha_EXTRA_CAREFUL
-register long   fake_ra __asm__("$26");
-register long   fake_gp __asm__("$29");
-#ifdef alpha_EXTRA_CAREFUL
-register long   fake_s6 __asm__("$15");
-register double fake_f8 __asm__("$f8");
-register double fake_f9 __asm__("$f9");
-#endif
-#endif
-
-/* include Stg.h first because we want real machine regs in here: we
- * have to get the value of R1 back from Stg land to C land intact.
- */
-#include "Stg.h"
-#include "Rts.h"
-#include "StgRun.h"
-#include "RtsFlags.h"
-#include "OSThreads.h"
-#include "Capability.h"
-
-#ifdef DEBUG
-#include "RtsUtils.h"
-#include "Printer.h"
-#endif
-
-#ifdef USE_MINIINTERPRETER
-
-/* -----------------------------------------------------------------------------
-   any architecture (using miniinterpreter)
-   -------------------------------------------------------------------------- */
-
-StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg STG_UNUSED)
-{
-    while (f) {
-	IF_DEBUG(interpreter,
-	    debugBelch("Jumping to ");
-	    printPtr((P_)f); fflush(stdout);
-	    debugBelch("\n");
-	    );
-	f = (StgFunPtr) (f)();
-    }
-    return (StgRegTable *)R1.p;
-}
-
-StgFunPtr StgReturn(void)
-{
-    return 0;
-}
-
-#else /* !USE_MINIINTERPRETER */
-
-#ifdef LEADING_UNDERSCORE
-#define STG_RETURN "_StgReturn"
-#else
-#define STG_RETURN "StgReturn"
-#endif
-
-/* -----------------------------------------------------------------------------
-   x86 architecture
-   -------------------------------------------------------------------------- */
-
-#ifdef i386_HOST_ARCH
-
-#ifdef darwin_TARGET_OS
-#define STG_GLOBAL ".globl "
-#else
-#define STG_GLOBAL ".global "
-#endif
-
-StgRegTable *
-StgRun(StgFunPtr f, StgRegTable *basereg) {
-
-    unsigned char space[ RESERVED_C_STACK_BYTES + 4*sizeof(void *) ];
-    StgRegTable * r;
-
-    __asm__ volatile (
-	/*
-	 * save callee-saves registers on behalf of the STG code.
-	 */
-	"movl %%esp, %%eax\n\t"
-	"addl %4, %%eax\n\t"
-        "movl %%ebx,0(%%eax)\n\t"
-        "movl %%esi,4(%%eax)\n\t"
-        "movl %%edi,8(%%eax)\n\t"
-        "movl %%ebp,12(%%eax)\n\t"
-	/*
-	 * Set BaseReg
-	 */
-	"movl %3,%%ebx\n\t"
-	/*
-	 * grab the function argument from the stack
-	 */
-        "movl %2,%%eax\n\t"
-        
-	/*
-	 * Darwin note:
-	 * The stack pointer has to be aligned to a multiple of 16 bytes at
-	 * this point. This works out correctly with gcc 4.0.1, but it might
-	 * break at any time in the future. TODO: Make this future-proof.
-	 */
-
-	/*
-	 * jump to it
-	 */
-        "jmp *%%eax\n\t"
-
-	STG_GLOBAL STG_RETURN "\n"
-       	STG_RETURN ":\n\t"
-
-	"movl %%esi, %%eax\n\t"   /* Return value in R1  */
-
-	/*
-	 * restore callee-saves registers.  (Don't stomp on %%eax!)
-	 */
-	"movl %%esp, %%edx\n\t"
-	"addl %4, %%edx\n\t"
-        "movl 0(%%edx),%%ebx\n\t"	/* restore the registers saved above */
-        "movl 4(%%edx),%%esi\n\t"
-        "movl 8(%%edx),%%edi\n\t"
-        "movl 12(%%edx),%%ebp\n\t"
-
-      : "=&a" (r), "=m" (space)
-      : "m" (f), "m" (basereg), "i" (RESERVED_C_STACK_BYTES)
-      : "edx" /* stomps on %edx */
-    );
-
-    return r;
-}
-
-#endif
-
-/* ----------------------------------------------------------------------------
-   x86-64 is almost the same as plain x86.
-
-   I've done it using entirely inline assembler, because I couldn't
-   get gcc to generate the correct subtraction from %rsp by using
-   the local array variable trick.  It didn't seem to reserve
-   enough space.  Oh well, it's not much harder this way.
-
-   ------------------------------------------------------------------------- */
-
-#ifdef x86_64_HOST_ARCH
-
-extern StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg);
-
-static void GNUC3_ATTRIBUTE(used)
-StgRunIsImplementedInAssembler(void)
-{
-    __asm__ volatile (
-	/*
-	 * save callee-saves registers on behalf of the STG code.
-	 */
-	".globl StgRun\n"
-	"StgRun:\n\t"
-	"subq %0, %%rsp\n\t"
-	"movq %%rsp, %%rax\n\t"
-	"addq %0-48, %%rax\n\t"
-        "movq %%rbx,0(%%rax)\n\t"
-        "movq %%rbp,8(%%rax)\n\t"
-        "movq %%r12,16(%%rax)\n\t"
-        "movq %%r13,24(%%rax)\n\t"
-        "movq %%r14,32(%%rax)\n\t"
-        "movq %%r15,40(%%rax)\n\t"
-	/*
-	 * Set BaseReg
-	 */
-	"movq %%rsi,%%r13\n\t"
-	/*
-	 * grab the function argument from the stack, and jump to it.
-	 */
-        "movq %%rdi,%%rax\n\t"
-        "jmp *%%rax\n\t"
-
-	".global " STG_RETURN "\n"
-       	STG_RETURN ":\n\t"
-
-	"movq %%rbx, %%rax\n\t"   /* Return value in R1  */
-
-	/*
-	 * restore callee-saves registers.  (Don't stomp on %%rax!)
-	 */
-	"movq %%rsp, %%rdx\n\t"
-	"addq %0-48, %%rdx\n\t"
-        "movq 0(%%rdx),%%rbx\n\t"	/* restore the registers saved above */
-        "movq 8(%%rdx),%%rbp\n\t"
-        "movq 16(%%rdx),%%r12\n\t"
-        "movq 24(%%rdx),%%r13\n\t"
-        "movq 32(%%rdx),%%r14\n\t"
-        "movq 40(%%rdx),%%r15\n\t"
-	"addq %0, %%rsp\n\t"
-	"retq"
-
-	: : "i"(RESERVED_C_STACK_BYTES+48+8 /*stack frame size*/));
-    /* 
-       HACK alert!
-
-       The x86_64 ABI specifies that on a procedure call, %rsp is
-       aligned on a 16-byte boundary + 8.  That is, the first
-       argument on the stack after the return address will be
-       16-byte aligned.  
-       
-       Which should be fine: RESERVED_C_STACK_BYTES+48 is a multiple
-       of 16 bytes.  
-       
-       BUT... when we do a C-call from STG land, gcc likes to put the
-       stack alignment adjustment in the prolog.  eg. if we're calling
-       a function with arguments in regs, gcc will insert 'subq $8,%rsp'
-       in the prolog, to keep %rsp aligned (the return address is 8
-       bytes, remember).  The mangler throws away the prolog, so we
-       lose the stack alignment.
-
-       The hack is to add this extra 8 bytes to our %rsp adjustment
-       here, so that throughout STG code, %rsp is 16-byte aligned,
-       ready for a C-call.  
-
-       A quick way to see if this is wrong is to compile this code:
-
-          main = System.Exit.exitWith ExitSuccess
-
-       And run it with +RTS -sstderr.  The stats code in the RTS, in
-       particular statsPrintf(), relies on the stack alignment because
-       it saves the %xmm regs on the stack, so it'll fall over if the
-       stack isn't aligned, and calling exitWith from Haskell invokes
-       shutdownHaskellAndExit using a C call.
-
-       Future gcc releases will almost certainly break this hack...
-    */
-}
-
-#endif /* x86-64 */
-
-/* -----------------------------------------------------------------------------
-   Sparc architecture
-
-   --
-   OLD COMMENT from GHC-3.02:
-
-   We want tailjumps to be calls, because `call xxx' is the only Sparc
-   branch that allows an arbitrary label as a target.  (Gcc's ``goto
-   *target'' construct ends up loading the label into a register and
-   then jumping, at the cost of two extra instructions for the 32-bit
-   load.)
-
-   When entering the threaded world, we stash our return address in a
-   known location so that \tr{%i7} is available as an extra
-   callee-saves register.  Of course, we have to restore this when
-   coming out of the threaded world.
-
-   I hate this god-forsaken architecture.  Since the top of the
-   reserved stack space is used for globals and the bottom is reserved
-   for outgoing arguments, we have to stick our return address
-   somewhere in the middle.  Currently, I'm allowing 100 extra
-   outgoing arguments beyond the first 6.  --JSM
-
-   Updated info (GHC 4.06): we don't appear to use %i7 any more, so
-   I'm not sure whether we still need to save it.  Incedentally, what
-   does the last paragraph above mean when it says "the top of the
-   stack is used for globals"?  What globals?  --SDM
-
-   Updated info (GHC 4.08.2): not saving %i7 any more (see below).
-   -------------------------------------------------------------------------- */
-
-#ifdef sparc_HOST_ARCH
-
-StgRegTable *
-StgRun(StgFunPtr f, StgRegTable *basereg) {
-
-    unsigned char space[RESERVED_C_STACK_BYTES];
-#if 0
-    register void *i7 __asm__("%i7");
-    ((void **)(space))[100] = i7;
-#endif
-    f();
-    __asm__ volatile (
-	    ".align 4\n"
-            ".global " STG_RETURN "\n"
-       	    STG_RETURN ":"
-	    : : : "l0","l1","l2","l3","l4","l5","l6","l7");
-    /* we tell the C compiler that l0-l7 are clobbered on return to
-     * StgReturn, otherwise it tries to use these to save eg. the
-     * address of space[100] across the call.  The correct thing
-     * to do would be to save all the callee-saves regs, but we
-     * can't be bothered to do that.
-     *
-     * The code that gcc generates for this little fragment is now
-     * terrible.  We could do much better by coding it directly in
-     * assembler.
-     */
-#if 0
-    /* updated 4.08.2: we don't save %i7 in the middle of the reserved
-     * space any more, since gcc tries to save its address across the
-     * call to f(), this gets clobbered in STG land and we end up
-     * dereferencing a bogus pointer in StgReturn.
-     */
-    __asm__ volatile ("ld %1,%0"
-		      : "=r" (i7) : "m" (((void **)(space))[100]));
-#endif
-    return (StgRegTable *)R1.i;
-}
-
-#endif
-
-/* -----------------------------------------------------------------------------
-   alpha architecture
-
-   "The stack pointer (SP) must at all times denote an address that has octaword
-    alignment. (This restriction has the side effect that the in-memory portion
-    of the argument list, if any, will start on an octaword boundary.) Note that
-    the stack grows toward lower addresses. During a procedure invocation, SP
-    can never be set to a value that is higher than the value of SP at entry to
-    that procedure invocation.
-
-   "The contents of the stack, located above the portion of the argument list
-    (if any) that is passed in memory, belong to the calling procedure. Because
-    they are part of the calling procedure, they should not be read or written
-    by the called procedure, except as specified by indirect arguments or
-    language-controlled up-level references.
-
-   "The SP value might be used by the hardware when raising exceptions and
-    asynchronous interrupts. It must be assumed that the contents of the stack
-    below the current SP value and within the stack for the current thread are
-    continually and unpredictably modified, as specified in the _Alpha
-    Architecture Reference Manual_, and as a result of asynchronous software
-    actions."
-
-   -- Compaq Computer Corporation, Houston. Tru64 UNIX Calling Standard for
-      Alpha Systems, 5.1 edition, August 2000, section 3.2.1.  http://www.
-      tru64unix.compaq.com/docs/base_doc/DOCUMENTATION/V51_PDF/ARH9MBTE.PDF
-   -------------------------------------------------------------------------- */
-
-#ifdef alpha_HOST_ARCH
-
-StgRegTable *
-StgRun(StgFunPtr f, StgRegTable *basereg)
-{
-    register long   real_ra __asm__("$26"); volatile long   save_ra;
-    register long   real_gp __asm__("$29"); volatile long   save_gp;
-
-    register long   real_s0 __asm__("$9" ); volatile long   save_s0;
-    register long   real_s1 __asm__("$10"); volatile long   save_s1;
-    register long   real_s2 __asm__("$11"); volatile long   save_s2;
-    register long   real_s3 __asm__("$12"); volatile long   save_s3;
-    register long   real_s4 __asm__("$13"); volatile long   save_s4;
-    register long   real_s5 __asm__("$14"); volatile long   save_s5;
-#ifdef alpha_EXTRA_CAREFUL
-    register long   real_s6 __asm__("$15"); volatile long   save_s6;
-#endif
-
-    register double real_f2 __asm__("$f2"); volatile double save_f2;
-    register double real_f3 __asm__("$f3"); volatile double save_f3;
-    register double real_f4 __asm__("$f4"); volatile double save_f4;
-    register double real_f5 __asm__("$f5"); volatile double save_f5;
-    register double real_f6 __asm__("$f6"); volatile double save_f6;
-    register double real_f7 __asm__("$f7"); volatile double save_f7;
-#ifdef alpha_EXTRA_CAREFUL
-    register double real_f8 __asm__("$f8"); volatile double save_f8;
-    register double real_f9 __asm__("$f9"); volatile double save_f9;
-#endif
-
-    register StgFunPtr real_pv __asm__("$27");
-
-    StgRegTable * ret;
-
-    save_ra = real_ra;
-    save_gp = real_gp;
-
-    save_s0 = real_s0;
-    save_s1 = real_s1;
-    save_s2 = real_s2;
-    save_s3 = real_s3;
-    save_s4 = real_s4;
-    save_s5 = real_s5;
-#ifdef alpha_EXTRA_CAREFUL
-    save_s6 = real_s6;
-#endif
-
-    save_f2 = real_f2;
-    save_f3 = real_f3;
-    save_f4 = real_f4;
-    save_f5 = real_f5;
-    save_f6 = real_f6;
-    save_f7 = real_f7;
-#ifdef alpha_EXTRA_CAREFUL
-    save_f8 = real_f8;
-    save_f9 = real_f9;
-#endif
-
-    real_pv = f;
-
-    __asm__ volatile(	"lda $30,-%0($30)"	"\n"
-		"\t"	"jmp ($27)"		"\n"
-		"\t"	".align 3"		"\n"
-		".globl " STG_RETURN		"\n"
-		STG_RETURN ":"			"\n"
-		"\t"	"lda $30,%0($30)"	"\n"
-		: : "K" (RESERVED_C_STACK_BYTES));
-
-    ret = real_s5;
-
-    real_s0 = save_s0;
-    real_s1 = save_s1;
-    real_s2 = save_s2;
-    real_s3 = save_s3;
-    real_s4 = save_s4;
-    real_s5 = save_s5;
-#ifdef alpha_EXTRA_CAREFUL
-    real_s6 = save_s6;
-#endif
-
-    real_f2 = save_f2;
-    real_f3 = save_f3;
-    real_f4 = save_f4;
-    real_f5 = save_f5;
-    real_f6 = save_f6;
-    real_f7 = save_f7;
-#ifdef alpha_EXTRA_CAREFUL
-    real_f8 = save_f8;
-    real_f9 = save_f9;
-#endif
-
-    real_ra = save_ra;
-    real_gp = save_gp;
-
-    return ret;
-}
-
-#endif /* alpha_HOST_ARCH */
-
-/* -----------------------------------------------------------------------------
-   HP-PA architecture
-   -------------------------------------------------------------------------- */
-
-#ifdef hppa1_1_HOST_ARCH
-
-StgRegTable *
-StgRun(StgFunPtr f, StgRegTable *basereg)
-{
-    StgChar space[RESERVED_C_STACK_BYTES+16*sizeof(long)+10*sizeof(double)];
-    StgRegTable * ret;
-
-    __asm__ volatile ("ldo %0(%%r30),%%r19\n"
-		      "\tstw %%r3, 0(0,%%r19)\n"
-                      "\tstw %%r4, 4(0,%%r19)\n"
-                      "\tstw %%r5, 8(0,%%r19)\n"
-                      "\tstw %%r6,12(0,%%r19)\n"
-                      "\tstw %%r7,16(0,%%r19)\n"
-                      "\tstw %%r8,20(0,%%r19)\n"
-                      "\tstw %%r9,24(0,%%r19)\n"
-		      "\tstw %%r10,28(0,%%r19)\n"
-                      "\tstw %%r11,32(0,%%r19)\n"
-                      "\tstw %%r12,36(0,%%r19)\n"
-                      "\tstw %%r13,40(0,%%r19)\n"
-                      "\tstw %%r14,44(0,%%r19)\n"
-                      "\tstw %%r15,48(0,%%r19)\n"
-                      "\tstw %%r16,52(0,%%r19)\n"
-                      "\tstw %%r17,56(0,%%r19)\n"
-                      "\tstw %%r18,60(0,%%r19)\n"
-		      "\tldo 80(%%r19),%%r19\n"
-		      "\tfstds %%fr12,-16(0,%%r19)\n"
-		      "\tfstds %%fr13, -8(0,%%r19)\n"
-		      "\tfstds %%fr14,  0(0,%%r19)\n"
-		      "\tfstds %%fr15,  8(0,%%r19)\n"
-		      "\tldo 32(%%r19),%%r19\n"
-		      "\tfstds %%fr16,-16(0,%%r19)\n"
-		      "\tfstds %%fr17, -8(0,%%r19)\n"
-		      "\tfstds %%fr18,  0(0,%%r19)\n"
-		      "\tfstds %%fr19,  8(0,%%r19)\n"
-		      "\tldo 32(%%r19),%%r19\n"
-		      "\tfstds %%fr20,-16(0,%%r19)\n"
-		      "\tfstds %%fr21, -8(0,%%r19)\n" : :
-                      "n" (-(116 * sizeof(long) + 10 * sizeof(double))) : "%r19"
-		      );
-
-    f();
-
-    __asm__ volatile (".align 4\n"
-               	      "\t.EXPORT " STG_RETURN ",CODE\n"
-		      "\t.EXPORT " STG_RETURN ",ENTRY,PRIV_LEV=3\n"
-                      STG_RETURN "\n"
-                      /* "\tldo %0(%%r3),%%r19\n" */
-                      "\tldo %1(%%r30),%%r19\n"
-                      "\tcopy %%r11, %0\n"  /* save R1 */
-		      "\tldw  0(0,%%r19),%%r3\n"
-                      "\tldw  4(0,%%r19),%%r4\n"
-                      "\tldw  8(0,%%r19),%%r5\n"
-                      "\tldw 12(0,%%r19),%%r6\n"
-                      "\tldw 16(0,%%r19),%%r7\n"
-                      "\tldw 20(0,%%r19),%%r8\n"
-                      "\tldw 24(0,%%r19),%%r9\n"
-		      "\tldw 28(0,%%r19),%%r10\n"
-                      "\tldw 32(0,%%r19),%%r11\n"
-                      "\tldw 36(0,%%r19),%%r12\n"
-                      "\tldw 40(0,%%r19),%%r13\n"
-                      "\tldw 44(0,%%r19),%%r14\n"
-                      "\tldw 48(0,%%r19),%%r15\n"
-                      "\tldw 52(0,%%r19),%%r16\n"
-                      "\tldw 56(0,%%r19),%%r17\n"
-                      "\tldw 60(0,%%r19),%%r18\n"
-		      "\tldo 80(%%r19),%%r19\n"
-		      "\tfldds -16(0,%%r19),%%fr12\n"
-		      "\tfldds  -8(0,%%r19),%%fr13\n"
-		      "\tfldds   0(0,%%r19),%%fr14\n"
-		      "\tfldds   8(0,%%r19),%%fr15\n"
-		      "\tldo 32(%%r19),%%r19\n"
-		      "\tfldds -16(0,%%r19),%%fr16\n"
-		      "\tfldds  -8(0,%%r19),%%fr17\n"
-		      "\tfldds   0(0,%%r19),%%fr18\n"
-		      "\tfldds   8(0,%%r19),%%fr19\n"
-		      "\tldo 32(%%r19),%%r19\n"
-		      "\tfldds -16(0,%%r19),%%fr20\n"
-		      "\tfldds  -8(0,%%r19),%%fr21\n"
-		         : "=r" (ret)
-		         : "n" (-(116 * sizeof(long) + 10 * sizeof(double)))
-		         : "%r19"
-		      );
-
-    return ret;
-}
-
-#endif /* hppa1_1_HOST_ARCH */
-
-/* -----------------------------------------------------------------------------
-   PowerPC architecture
-
-   Everything is in assembler, so we don't have to deal with GCC...
-   
-   -------------------------------------------------------------------------- */
-
-#ifdef powerpc_HOST_ARCH
-
-extern StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg);
-
-#ifdef darwin_HOST_OS
-void StgRunIsImplementedInAssembler(void)
-{
-#if HAVE_SUBSECTIONS_VIA_SYMBOLS
-            // if the toolchain supports deadstripping, we have to
-            // prevent it here (it tends to get confused here).
-        __asm__ volatile (".no_dead_strip _StgRunIsImplementedInAssembler");
-#endif
-	__asm__ volatile (
-		"\n.globl _StgRun\n"
-		"_StgRun:\n"
-		"\tmflr r0\n"
-		"\tbl saveFP # f14\n"
-		"\tstmw r13,-220(r1)\n"
-		"\tstwu r1,-%0(r1)\n"
-                "\tmr r27,r4\n" // BaseReg == r27
-		"\tmtctr r3\n"
-		"\tmr r12,r3\n"
-		"\tbctr\n"
-		".globl _StgReturn\n"
-		"_StgReturn:\n"
-		"\tmr r3,r14\n"
-		"\tla r1,%0(r1)\n"
-		"\tlmw r13,-220(r1)\n"
-		"\tb restFP # f14\n"
-	: : "i"(RESERVED_C_STACK_BYTES+224 /*stack frame size*/));
-}
-#else
-
-// This version is for PowerPC Linux.
-
-// Differences from the Darwin/Mac OS X version:
-// *) Different Assembler Syntax
-// *) Doesn't use Register Saving Helper Functions (although they exist somewhere)
-// *) We may not access positive stack offsets
-//    (no "Red Zone" as in the Darwin ABI)
-// *) The Link Register is saved to a different offset in the caller's stack frame
-//    (Linux: 4(r1), Darwin 8(r1))
-
-static void GNUC3_ATTRIBUTE(used)
-StgRunIsImplementedInAssembler(void)
-{
-	__asm__ volatile (
-		"\t.globl StgRun\n"
-		"\t.type StgRun,@function\n"
-		"StgRun:\n"
-		"\tmflr 0\n"
-		"\tstw 0,4(1)\n"
-		"\tmr 5,1\n"
-		"\tstwu 1,-%0(1)\n"
-		"\tstmw 13,-220(5)\n"
-		"\tstfd 14,-144(5)\n"
-		"\tstfd 15,-136(5)\n"
-		"\tstfd 16,-128(5)\n"
-		"\tstfd 17,-120(5)\n"
-		"\tstfd 18,-112(5)\n"
-		"\tstfd 19,-104(5)\n"
-		"\tstfd 20,-96(5)\n"
-		"\tstfd 21,-88(5)\n"
-		"\tstfd 22,-80(5)\n"
-		"\tstfd 23,-72(5)\n"
-		"\tstfd 24,-64(5)\n"
-		"\tstfd 25,-56(5)\n"
-		"\tstfd 26,-48(5)\n"
-		"\tstfd 27,-40(5)\n"
-		"\tstfd 28,-32(5)\n"
-		"\tstfd 29,-24(5)\n"
-		"\tstfd 30,-16(5)\n"
-		"\tstfd 31,-8(5)\n"
-		"\tmr 27,4\n"  // BaseReg == r27
-		"\tmtctr 3\n"
-		"\tmr 12,3\n"
-		"\tbctr\n"
-		".globl StgReturn\n"
-		"\t.type StgReturn,@function\n"
-		"StgReturn:\n"
-		"\tmr 3,14\n"
-		"\tla 5,%0(1)\n"
-		"\tlmw 13,-220(5)\n"
-		"\tlfd 14,-144(5)\n"
-		"\tlfd 15,-136(5)\n"
-		"\tlfd 16,-128(5)\n"
-		"\tlfd 17,-120(5)\n"
-		"\tlfd 18,-112(5)\n"
-		"\tlfd 19,-104(5)\n"
-		"\tlfd 20,-96(5)\n"
-		"\tlfd 21,-88(5)\n"
-		"\tlfd 22,-80(5)\n"
-		"\tlfd 23,-72(5)\n"
-		"\tlfd 24,-64(5)\n"
-		"\tlfd 25,-56(5)\n"
-		"\tlfd 26,-48(5)\n"
-		"\tlfd 27,-40(5)\n"
-		"\tlfd 28,-32(5)\n"
-		"\tlfd 29,-24(5)\n"
-		"\tlfd 30,-16(5)\n"
-		"\tlfd 31,-8(5)\n"
-		"\tmr 1,5\n"
-		"\tlwz 0,4(1)\n"
-		"\tmtlr 0\n"
-		"\tblr\n"
-	: : "i"(RESERVED_C_STACK_BYTES+224 /*stack frame size*/));
-}
-#endif
-
-#endif
-
-/* -----------------------------------------------------------------------------
-   PowerPC 64 architecture
-
-   Everything is in assembler, so we don't have to deal with GCC...
-   
-   -------------------------------------------------------------------------- */
-
-#ifdef powerpc64_HOST_ARCH
-
-#ifdef linux_HOST_OS
-extern StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg);
-
-static void GNUC3_ATTRIBUTE(used)
-StgRunIsImplementedInAssembler(void)
-{
-        // r0 volatile
-	// r1 stack pointer
-	// r2 toc - needs to be saved
-	// r3-r10 argument passing, volatile
-	// r11, r12 very volatile (not saved across cross-module calls)
-	// r13 thread local state (never modified, don't need to save)
-	// r14-r31 callee-save
-	__asm__ volatile (
-		".section \".opd\",\"aw\"\n"
-		".align 3\n"
-		".globl StgRun\n"
-		"StgRun:\n"
-			"\t.quad\t.StgRun,.TOC.@tocbase,0\n"
-			"\t.size StgRun,24\n"
-		".globl StgReturn\n"
-		"StgReturn:\n"
-			"\t.quad\t.StgReturn,.TOC.@tocbase,0\n"
-			"\t.size StgReturn,24\n"
-		".previous\n"
-		".globl .StgRun\n"
-		".type .StgRun,@function\n"
-		".StgRun:\n"
-			"\tmflr 0\n"
-			"\tmr 5, 1\n"
-			"\tstd 0, 16(1)\n"
-			"\tstdu 1, -%0(1)\n"
-			"\tstd 2, -296(5)\n"
-			"\tstd 14, -288(5)\n"
-			"\tstd 15, -280(5)\n"
-			"\tstd 16, -272(5)\n"
-			"\tstd 17, -264(5)\n"
-			"\tstd 18, -256(5)\n"
-			"\tstd 19, -248(5)\n"
-			"\tstd 20, -240(5)\n"
-			"\tstd 21, -232(5)\n"
-			"\tstd 22, -224(5)\n"
-			"\tstd 23, -216(5)\n"
-			"\tstd 24, -208(5)\n"
-			"\tstd 25, -200(5)\n"
-			"\tstd 26, -192(5)\n"
-			"\tstd 27, -184(5)\n"
-			"\tstd 28, -176(5)\n"
-			"\tstd 29, -168(5)\n"
-			"\tstd 30, -160(5)\n"
-			"\tstd 31, -152(5)\n"
-			"\tstfd 14, -144(5)\n"
-			"\tstfd 15, -136(5)\n"
-			"\tstfd 16, -128(5)\n"
-			"\tstfd 17, -120(5)\n"
-			"\tstfd 18, -112(5)\n"
-			"\tstfd 19, -104(5)\n"
-			"\tstfd 20, -96(5)\n"
-			"\tstfd 21, -88(5)\n"
-			"\tstfd 22, -80(5)\n"
-			"\tstfd 23, -72(5)\n"
-			"\tstfd 24, -64(5)\n"
-			"\tstfd 25, -56(5)\n"
-			"\tstfd 26, -48(5)\n"
-			"\tstfd 27, -40(5)\n"
-			"\tstfd 28, -32(5)\n"
-			"\tstfd 29, -24(5)\n"
-			"\tstfd 30, -16(5)\n"
-			"\tstfd 31, -8(5)\n"
-			"\tmr 27, 4\n"  // BaseReg == r27
-			"\tld 2, 8(3)\n"
-			"\tld 3, 0(3)\n"
-			"\tmtctr 3\n"
-			"\tbctr\n"
-		".globl .StgReturn\n"
-		".type .StgReturn,@function\n"
-		".StgReturn:\n"
-			"\tmr 3,14\n"
-			"\tla 5, %0(1)\n" // load address == addi r5, r1, %0
-			"\tld 2, -296(5)\n"
-			"\tld 14, -288(5)\n"
-			"\tld 15, -280(5)\n"
-			"\tld 16, -272(5)\n"
-			"\tld 17, -264(5)\n"
-			"\tld 18, -256(5)\n"
-			"\tld 19, -248(5)\n"
-			"\tld 20, -240(5)\n"
-			"\tld 21, -232(5)\n"
-			"\tld 22, -224(5)\n"
-			"\tld 23, -216(5)\n"
-			"\tld 24, -208(5)\n"
-			"\tld 25, -200(5)\n"
-			"\tld 26, -192(5)\n"
-			"\tld 27, -184(5)\n"
-			"\tld 28, -176(5)\n"
-			"\tld 29, -168(5)\n"
-			"\tld 30, -160(5)\n"
-			"\tld 31, -152(5)\n"
-			"\tlfd 14, -144(5)\n"
-			"\tlfd 15, -136(5)\n"
-			"\tlfd 16, -128(5)\n"
-			"\tlfd 17, -120(5)\n"
-			"\tlfd 18, -112(5)\n"
-			"\tlfd 19, -104(5)\n"
-			"\tlfd 20, -96(5)\n"
-			"\tlfd 21, -88(5)\n"
-			"\tlfd 22, -80(5)\n"
-			"\tlfd 23, -72(5)\n"
-			"\tlfd 24, -64(5)\n"
-			"\tlfd 25, -56(5)\n"
-			"\tlfd 26, -48(5)\n"
-			"\tlfd 27, -40(5)\n"
-			"\tlfd 28, -32(5)\n"
-			"\tlfd 29, -24(5)\n"
-			"\tlfd 30, -16(5)\n"
-			"\tlfd 31, -8(5)\n"
-			"\tmr 1, 5\n"
-			"\tld 0, 16(1)\n"
-			"\tmtlr 0\n"
-			"\tblr\n"
-	: : "i"(RESERVED_C_STACK_BYTES+304 /*stack frame size*/));
-}
-#else // linux_HOST_OS
-#error Only linux support for power64 right now.
-#endif
-
-#endif
-
-/* -----------------------------------------------------------------------------
-   IA64 architecture
-
-   Again, in assembler - so we can fiddle with the register stack, and because
-   gcc doesn't handle asm-clobbered callee-saves correctly.
-
-   loc0  - loc15: preserved locals
-   loc16 - loc28: STG registers
-           loc29: saved ar.pfs
-           loc30: saved b0
-           loc31: saved gp (gcc 3.3 uses this slot)
-   -------------------------------------------------------------------------- */
-
-#ifdef ia64_HOST_ARCH
-
-/* the memory stack is rarely used, so 16K is excessive */
-#undef RESERVED_C_STACK_BYTES
-#define RESERVED_C_STACK_BYTES 1024
-
-#if ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)
-/* gcc 3.3+: leave an extra slot for gp saves */
-#define LOCALS 32
-#else
-#define LOCALS 31
-#endif
-
-static void GNUC3_ATTRIBUTE(used)
-StgRunIsImplementedInAssembler(void)
-{
-    __asm__ volatile(
-		".global StgRun\n"
-		"StgRun:\n"
-		"\talloc loc29 = ar.pfs, 0, %1, 8, 0\n"	/* setup register frame */
-		"\tld8 r18 = [r32],8\n"			/* get procedure address */
-		"\tadds sp = -%0, sp ;;\n"		/* setup stack */
-		"\tld8 gp = [r32]\n"			/* get procedure GP */
-		"\tadds r16 = %0-(6*16), sp\n"
-		"\tadds r17 = %0-(5*16), sp ;;\n"
-		"\tstf.spill [r16] = f16,32\n"		/* spill callee-saved fp regs */
-		"\tstf.spill [r17] = f17,32\n"
-		"\tmov b6 = r18 ;;\n"			/* set target address */
-		"\tstf.spill [r16] = f18,32\n"
-		"\tstf.spill [r17] = f19,32\n"
-		"\tmov loc30 = b0 ;;\n"			/* save return address */
-		"\tstf.spill [r16] = f20,32\n"
-		"\tstf.spill [r17] = f21,32\n"
-		"\tbr.few b6 ;;\n"			/* branch to function */
-		".global StgReturn\n"
-		"StgReturn:\n"
-		"\tmov r8 = loc16\n"		/* return value in r8 */
-		"\tadds r16 = %0-(6*16), sp\n"
-	    	"\tadds r17 = %0-(5*16), sp ;;\n"
-		"\tldf.fill f16 = [r16],32\n"	/* start restoring fp regs */
-		"\tldf.fill f17 = [r17],32\n"
-		"\tmov ar.pfs = loc29 ;;\n"	/* restore register frame */
-		"\tldf.fill f18 = [r16],32\n"
-		"\tldf.fill f19 = [r17],32\n"
-		"\tmov b0 = loc30 ;;\n"		/* restore return address */
-		"\tldf.fill f20 = [r16],32\n"
-		"\tldf.fill f21 = [r17],32\n"
-		"\tadds sp = %0, sp\n"		/* restore stack */
-		"\tbr.ret.sptk.many b0 ;;\n"	/* return */
-	: : "i"(RESERVED_C_STACK_BYTES + 6*16), "i"(LOCALS));
-}
-
-#endif
-
-#endif /* !USE_MINIINTERPRETER */
diff --git a/ghc/rts/StgMiscClosures.cmm b/ghc/rts/StgMiscClosures.cmm
deleted file mode 100644
index 70d08aeb0e..0000000000
--- a/ghc/rts/StgMiscClosures.cmm
+++ /dev/null
@@ -1,953 +0,0 @@
-/* ----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Entry code for various built-in closure types.
- *
- * This file is written in a subset of C--, extended with various
- * features specific to GHC.  It is compiled by GHC directly.  For the
- * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
- *
- * --------------------------------------------------------------------------*/
-
-#include "Cmm.h"
-
-/* ----------------------------------------------------------------------------
-   Support for the bytecode interpreter.
-   ------------------------------------------------------------------------- */
-
-/* 9 bits of return code for constructors created by the interpreter. */
-stg_interp_constr_entry
-{ 
-    /* R1 points at the constructor */
-    jump %ENTRY_CODE(Sp(0));
-}
-
-stg_interp_constr1_entry { jump %RET_VEC(Sp(0),0); }
-stg_interp_constr2_entry { jump %RET_VEC(Sp(0),1); }
-stg_interp_constr3_entry { jump %RET_VEC(Sp(0),2); }
-stg_interp_constr4_entry { jump %RET_VEC(Sp(0),3); }
-stg_interp_constr5_entry { jump %RET_VEC(Sp(0),4); }
-stg_interp_constr6_entry { jump %RET_VEC(Sp(0),5); }
-stg_interp_constr7_entry { jump %RET_VEC(Sp(0),6); }
-stg_interp_constr8_entry { jump %RET_VEC(Sp(0),7); }
-
-/* Some info tables to be used when compiled code returns a value to
-   the interpreter, i.e. the interpreter pushes one of these onto the
-   stack before entering a value.  What the code does is to
-   impedance-match the compiled return convention (in R1p/R1n/F1/D1 etc) to
-   the interpreter's convention (returned value is on top of stack),
-   and then cause the scheduler to enter the interpreter.
-
-   On entry, the stack (growing down) looks like this:
-
-      ptr to BCO holding return continuation
-      ptr to one of these info tables.
- 
-   The info table code, both direct and vectored, must:
-      * push R1/F1/D1 on the stack, and its tag if necessary
-      * push the BCO (so it's now on the stack twice)
-      * Yield, ie, go to the scheduler.
-
-   Scheduler examines the t.o.s, discovers it is a BCO, and proceeds
-   directly to the bytecode interpreter.  That pops the top element
-   (the BCO, containing the return continuation), and interprets it.
-   Net result: return continuation gets interpreted, with the
-   following stack:
-
-      ptr to this BCO
-      ptr to the info table just jumped thru
-      return value
-
-   which is just what we want -- the "standard" return layout for the
-   interpreter.  Hurrah!
-
-   Don't ask me how unboxed tuple returns are supposed to work.  We
-   haven't got a good story about that yet.
-*/
-
-INFO_TABLE_RET( stg_ctoi_R1p, 
-		0/*size*/, 0/*bitmap*/,    /* special layout! */
-		RET_BCO,
-		RET_LBL(stg_ctoi_R1p),
-		RET_LBL(stg_ctoi_R1p),
-		RET_LBL(stg_ctoi_R1p),
-		RET_LBL(stg_ctoi_R1p),
-		RET_LBL(stg_ctoi_R1p),
-		RET_LBL(stg_ctoi_R1p),
-		RET_LBL(stg_ctoi_R1p),
-		RET_LBL(stg_ctoi_R1p))
-{
-    Sp_adj(-2);
-    Sp(1) = R1;
-    Sp(0) = stg_enter_info;
-    jump stg_yield_to_interpreter;
-}
-
-#if MAX_VECTORED_RTN != 8
-#error MAX_VECTORED_RTN has changed: please modify stg_ctoi_R1p too.
-#endif
-
-/*
- * When the returned value is a pointer, but unlifted, in R1 ... 
- */
-INFO_TABLE_RET( stg_ctoi_R1unpt,
-		0/*size*/, 0/*bitmap*/,    /* special layout! */
-		RET_BCO )
-{
-    Sp_adj(-2);
-    Sp(1) = R1;
-    Sp(0) = stg_gc_unpt_r1_info;
-    jump stg_yield_to_interpreter;
-}
-
-/*
- * When the returned value is a non-pointer in R1 ...
- */
-INFO_TABLE_RET( stg_ctoi_R1n,
-		0/*size*/, 0/*bitmap*/,    /* special layout! */
-		RET_BCO )
-{
-    Sp_adj(-2);
-    Sp(1) = R1;
-    Sp(0) = stg_gc_unbx_r1_info;
-    jump stg_yield_to_interpreter;
-}
-
-/*
- * When the returned value is in F1
- */
-INFO_TABLE_RET( stg_ctoi_F1,
-		0/*size*/, 0/*bitmap*/,    /* special layout! */
-		RET_BCO )
-{
-    Sp_adj(-2);
-    F_[Sp + WDS(1)] = F1;
-    Sp(0) = stg_gc_f1_info;
-    jump stg_yield_to_interpreter;
-}
-
-/*
- * When the returned value is in D1
- */
-INFO_TABLE_RET( stg_ctoi_D1,
-		0/*size*/, 0/*bitmap*/,    /* special layout! */
-		RET_BCO )
-{
-    Sp_adj(-1) - SIZEOF_DOUBLE;
-    D_[Sp + WDS(1)] = D1;
-    Sp(0) = stg_gc_d1_info;
-    jump stg_yield_to_interpreter;
-}
-
-/*
- * When the returned value is in L1
- */
-INFO_TABLE_RET( stg_ctoi_L1,
-		0/*size*/, 0/*bitmap*/,    /* special layout! */
-		RET_BCO )
-{
-    Sp_adj(-1) - 8;
-    L_[Sp + WDS(1)] = L1;
-    Sp(0) = stg_gc_l1_info;
-    jump stg_yield_to_interpreter;
-}
-
-/*
- * When the returned value is a void
- */
-INFO_TABLE_RET( stg_ctoi_V,
-		0/*size*/, 0/*bitmap*/,    /* special layout! */
-		RET_BCO )
-{
-    Sp_adj(-1);
-    Sp(0) = stg_gc_void_info;
-    jump stg_yield_to_interpreter;
-}
-
-/*
- * Dummy info table pushed on the top of the stack when the interpreter
- * should apply the BCO on the stack to its arguments, also on the
- * stack.
- */
-INFO_TABLE_RET( stg_apply_interp,
-		0/*size*/, 0/*bitmap*/,    /* special layout! */
-		RET_BCO )
-{
-    /* Just in case we end up in here... (we shouldn't) */
-    jump stg_yield_to_interpreter;
-}
-
-/* ----------------------------------------------------------------------------
-   Entry code for a BCO
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE_FUN( stg_BCO, 4, 0, BCO, "BCO", "BCO", ARG_BCO )
-{
-  /* entering a BCO means "apply it", same as a function */
-  Sp_adj(-2);
-  Sp(1) = R1;
-  Sp(0) = stg_apply_interp_info;
-  jump stg_yield_to_interpreter;
-}
-
-/* ----------------------------------------------------------------------------
-   Info tables for indirections.
-
-   SPECIALISED INDIRECTIONS: we have a specialised indirection for each
-   kind of return (direct, vectored 0-7), so that we can avoid entering
-   the object when we know what kind of return it will do.  The update
-   code (Updates.hc) updates objects with the appropriate kind of
-   indirection.  We only do this for young-gen indirections.
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_IND,1,0,IND,"IND","IND")
-{
-    TICK_ENT_DYN_IND();	/* tick */
-    R1 = StgInd_indirectee(R1);
-    TICK_ENT_VIA_NODE();
-    jump %GET_ENTRY(R1);
-}
-
-#define IND_SPEC(label,ret) \
-INFO_TABLE(label,1,0,IND,"IND","IND") \
-{						\
-    TICK_ENT_DYN_IND();	/* tick */		\
-    R1 = StgInd_indirectee(R1);			\
-    TICK_ENT_VIA_NODE();			\
-    jump ret;					\
-}
-
-IND_SPEC(stg_IND_direct, %ENTRY_CODE(Sp(0)))
-IND_SPEC(stg_IND_0, %RET_VEC(Sp(0),0))
-IND_SPEC(stg_IND_1, %RET_VEC(Sp(0),1))
-IND_SPEC(stg_IND_2, %RET_VEC(Sp(0),2))
-IND_SPEC(stg_IND_3, %RET_VEC(Sp(0),3))
-IND_SPEC(stg_IND_4, %RET_VEC(Sp(0),4))
-IND_SPEC(stg_IND_5, %RET_VEC(Sp(0),5))
-IND_SPEC(stg_IND_6, %RET_VEC(Sp(0),6))
-IND_SPEC(stg_IND_7, %RET_VEC(Sp(0),7))
-
-INFO_TABLE(stg_IND_STATIC,1,0,IND_STATIC,"IND_STATIC","IND_STATIC")
-{
-    TICK_ENT_STATIC_IND();	/* tick */
-    R1 = StgInd_indirectee(R1);
-    TICK_ENT_VIA_NODE();
-    jump %GET_ENTRY(R1);
-}
-
-INFO_TABLE(stg_IND_PERM,1,0,IND_PERM,"IND_PERM","IND_PERM")
-{
-    /* Don't add INDs to granularity cost */
-
-    /* Don't: TICK_ENT_STATIC_IND(Node); for ticky-ticky; this ind is
-       here only to help profiling */
-
-#if defined(TICKY_TICKY) && !defined(PROFILING)
-    /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, rather than
-       being extra  */
-    TICK_ENT_PERM_IND();
-#endif
-
-    LDV_ENTER(R1);
-
-    /* Enter PAP cost centre */
-    ENTER_CCS_PAP_CL(R1);
-
-    /* For ticky-ticky, change the perm_ind to a normal ind on first
-     * entry, so the number of ent_perm_inds is the number of *thunks*
-     * entered again, not the number of subsequent entries.
-     *
-     * Since this screws up cost centres, we die if profiling and
-     * ticky_ticky are on at the same time.  KSW 1999-01.
-     */
-#ifdef TICKY_TICKY
-#  ifdef PROFILING
-#    error Profiling and ticky-ticky do not mix at present!
-#  endif  /* PROFILING */
-    StgHeader_info(R1) = stg_IND_info;
-#endif /* TICKY_TICKY */
-
-    R1 = StgInd_indirectee(R1);
-
-#if defined(TICKY_TICKY) && !defined(PROFILING)
-    TICK_ENT_VIA_NODE();
-#endif
-
-    jump %GET_ENTRY(R1);
-}  
-
-
-INFO_TABLE(stg_IND_OLDGEN,1,0,IND_OLDGEN,"IND_OLDGEN","IND_OLDGEN")
-{
-    TICK_ENT_STATIC_IND();	/* tick */
-    R1 = StgInd_indirectee(R1);
-    TICK_ENT_VIA_NODE();
-    jump %GET_ENTRY(R1);
-}
-
-INFO_TABLE(stg_IND_OLDGEN_PERM,1,0,IND_OLDGEN_PERM,"IND_OLDGEN_PERM","IND_OLDGEN_PERM")
-{
-    /* Don't: TICK_ENT_STATIC_IND(Node); for ticky-ticky; 
-       this ind is here only to help profiling */
-
-#if defined(TICKY_TICKY) && !defined(PROFILING)
-    /* TICKY_TICKY && !PROFILING means PERM_IND *replaces* an IND, 
-       rather than being extra  */
-    TICK_ENT_PERM_IND(R1); /* tick */
-#endif
-
-    LDV_ENTER(R1);
-
-    /* Enter PAP cost centre -- lexical scoping only */
-    ENTER_CCS_PAP_CL(R1);
-
-    /* see comment in IND_PERM */
-#ifdef TICKY_TICKY
-#  ifdef PROFILING
-#    error Profiling and ticky-ticky do not mix at present!
-#  endif  /* PROFILING */
-    StgHeader_info(R1) = stg_IND_OLDGEN_info;
-#endif /* TICKY_TICKY */
-
-    R1 = StgInd_indirectee(R1);
-
-    TICK_ENT_VIA_NODE();
-    jump %GET_ENTRY(R1);
-}
-
-/* ----------------------------------------------------------------------------
-   Black holes.
-
-   Entering a black hole normally causes a cyclic data dependency, but
-   in the concurrent world, black holes are synchronization points,
-   and they are turned into blocking queues when there are threads
-   waiting for the evaluation of the closure to finish.
-   ------------------------------------------------------------------------- */
-
-/* Note: a BLACKHOLE must be big enough to be
- * overwritten with an indirection/evacuee/catch.  Thus we claim it
- * has 1 non-pointer word of payload. 
- */
-INFO_TABLE(stg_BLACKHOLE,0,1,BLACKHOLE,"BLACKHOLE","BLACKHOLE")
-{
-#if defined(GRAN)
-    /* Before overwriting TSO_LINK */
-    STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1 /*Node*/);
-#endif
-
-    TICK_ENT_BH();
-
-#ifdef THREADED_RTS
-    // foreign "C" debugBelch("BLACKHOLE entry\n");
-#endif
-
-    /* Actually this is not necessary because R1 is about to be destroyed. */
-    LDV_ENTER(R1);
-
-#if defined(THREADED_RTS)
-    foreign "C" ACQUIRE_LOCK(sched_mutex "ptr");
-    // released in stg_block_blackhole_finally
-#endif
-
-    /* Put ourselves on the blackhole queue */
-    StgTSO_link(CurrentTSO) = W_[blackhole_queue];
-    W_[blackhole_queue] = CurrentTSO;
-
-    /* jot down why and on what closure we are blocked */
-    StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
-    StgTSO_block_info(CurrentTSO) = R1;
-
-    jump stg_block_blackhole;
-}
-
-#if defined(PAR) || defined(GRAN)
-
-INFO_TABLE(stg_RBH,1,1,RBH,"RBH","RBH")
-{
-# if defined(GRAN)
-    /* mainly statistics gathering for GranSim simulation */
-    STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1 /*Node*/);
-# endif
-
-    /* exactly the same as a BLACKHOLE_BQ_entry -- HWL */
-    /* Put ourselves on the blocking queue for this black hole */
-    TSO_link(CurrentTSO) = StgBlockingQueue_blocking_queue(R1);
-    StgBlockingQueue_blocking_queue(R1) = CurrentTSO;
-    /* jot down why and on what closure we are blocked */
-    TSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
-    TSO_block_info(CurrentTSO) = R1;
-
-    /* PAR: dumping of event now done in blockThread -- HWL */
-
-    /* stg_gen_block is too heavyweight, use a specialised one */
-    jump stg_block_1;
-}
-
-INFO_TABLE(stg_RBH_Save_0,0,2,CONSTR,"RBH_Save_0","RBH_Save_0")
-{ foreign "C" barf("RBH_Save_0 object entered!"); }
-
-INFO_TABLE(stg_RBH_Save_1,1,1,CONSTR,"RBH_Save_1","RBH_Save_1");
-{ foreign "C" barf("RBH_Save_1 object entered!"); }
-
-INFO_TABLE(stg_RBH_Save_2,2,0,CONSTR,"RBH_Save_2","RBH_Save_2");
-{ foreign "C" barf("RBH_Save_2 object entered!"); }
-
-#endif /* defined(PAR) || defined(GRAN) */
-
-/* identical to BLACKHOLEs except for the infotag */
-INFO_TABLE(stg_CAF_BLACKHOLE,0,1,CAF_BLACKHOLE,"CAF_BLACKHOLE","CAF_BLACKHOLE")
-{
-#if defined(GRAN)
-    /* mainly statistics gathering for GranSim simulation */
-    STGCALL3(GranSimBlock,CurrentTSO,CurrentProc,(StgClosure *)R1 /*Node*/);
-#endif
-
-    TICK_ENT_BH();
-    LDV_ENTER(R1);
-
-#if defined(THREADED_RTS)
-    // foreign "C" debugBelch("BLACKHOLE entry\n");
-#endif
-
-#if defined(THREADED_RTS)
-    foreign "C" ACQUIRE_LOCK(sched_mutex "ptr");
-    // released in stg_block_blackhole_finally
-#endif
-
-    /* Put ourselves on the blackhole queue */
-    StgTSO_link(CurrentTSO) = W_[blackhole_queue];
-    W_[blackhole_queue] = CurrentTSO;
-
-    /* jot down why and on what closure we are blocked */
-    StgTSO_why_blocked(CurrentTSO) = BlockedOnBlackHole::I16;
-    StgTSO_block_info(CurrentTSO) = R1;
-
-    jump stg_block_blackhole;
-}
-
-#ifdef EAGER_BLACKHOLING
-INFO_TABLE(stg_SE_BLACKHOLE,0,1,SE_BLACKHOLE,"SE_BLACKHOLE","SE_BLACKHOLE")
-{ foreign "C" barf("SE_BLACKHOLE object entered!"); }
-
-INFO_TABLE(stg_SE_CAF_BLACKHOLE,0,1,SE_CAF_BLACKHOLE,"SE_CAF_BLACKHOLE","SE_CAF_BLACKHOLE")
-{ foreign "C" barf("SE_CAF_BLACKHOLE object entered!"); }
-#endif
-
-/* ----------------------------------------------------------------------------
-   Whiteholes are used for the "locked" state of a closure (see lockClosure())
-
-   The closure type is BLAKCHOLE, just because we need a valid closure type
-   for sanity checking.
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_WHITEHOLE, 0,0, BLACKHOLE, "WHITEHOLE", "WHITEHOLE")
-{ foreign "C" barf("WHITEHOLE object entered!"); }
-
-/* ----------------------------------------------------------------------------
-   Some static info tables for things that don't get entered, and
-   therefore don't need entry code (i.e. boxed but unpointed objects)
-   NON_ENTERABLE_ENTRY_CODE now defined at the beginning of the file
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_TSO, 0,0,TSO, "TSO", "TSO")
-{ foreign "C" barf("TSO object entered!"); }
-
-/* ----------------------------------------------------------------------------
-   Evacuees are left behind by the garbage collector.  Any attempt to enter
-   one is a real bug.
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_EVACUATED,1,0,EVACUATED,"EVACUATED","EVACUATED")
-{ foreign "C" barf("EVACUATED object entered!"); }
-
-/* ----------------------------------------------------------------------------
-   Weak pointers
-
-   Live weak pointers have a special closure type.  Dead ones are just
-   nullary constructors (although they live on the heap - we overwrite
-   live weak pointers with dead ones).
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_WEAK,0,4,WEAK,"WEAK","WEAK")
-{ foreign "C" barf("WEAK object entered!"); }
-
-/*
- * It's important when turning an existing WEAK into a DEAD_WEAK
- * (which is what finalizeWeak# does) that we don't lose the link
- * field and break the linked list of weak pointers.  Hence, we give
- * DEAD_WEAK 4 non-pointer fields, the same as WEAK.
- */
-INFO_TABLE_CONSTR(stg_DEAD_WEAK,0,4,0,CONSTR,"DEAD_WEAK","DEAD_WEAK")
-{ foreign "C" barf("DEAD_WEAK object entered!"); }
-
-/* ----------------------------------------------------------------------------
-   NO_FINALIZER
-
-   This is a static nullary constructor (like []) that we use to mark an empty
-   finalizer in a weak pointer object.
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE_CONSTR(stg_NO_FINALIZER,0,0,0,CONSTR_NOCAF_STATIC,"NO_FINALIZER","NO_FINALIZER")
-{ foreign "C" barf("NO_FINALIZER object entered!"); }
-
-CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER);
-
-/* ----------------------------------------------------------------------------
-   Stable Names are unlifted too.
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_STABLE_NAME,0,1,STABLE_NAME,"STABLE_NAME","STABLE_NAME")
-{ foreign "C" barf("STABLE_NAME object entered!"); }
-
-/* ----------------------------------------------------------------------------
-   MVars
-
-   There are two kinds of these: full and empty.  We need an info table
-   and entry code for each type.
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_FULL_MVAR,3,0,MVAR,"MVAR","MVAR")
-{ foreign "C" barf("FULL_MVAR object entered!"); }
-
-INFO_TABLE(stg_EMPTY_MVAR,3,0,MVAR,"MVAR","MVAR")
-{ foreign "C" barf("EMPTY_MVAR object entered!"); }
-
-/* -----------------------------------------------------------------------------
-   STM
-   -------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_TVAR, 0, 0, TVAR, "TVAR", "TVAR")
-{ foreign "C" barf("TVAR object entered!"); }
-
-INFO_TABLE(stg_TVAR_WAIT_QUEUE, 0, 0, TVAR_WAIT_QUEUE, "TVAR_WAIT_QUEUE", "TVAR_WAIT_QUEUE")
-{ foreign "C" barf("TVAR_WAIT_QUEUE object entered!"); }
-
-INFO_TABLE(stg_TREC_CHUNK, 0, 0, TREC_CHUNK, "TREC_CHUNK", "TREC_CHUNK")
-{ foreign "C" barf("TREC_CHUNK object entered!"); }
-
-INFO_TABLE(stg_TREC_HEADER, 0, 0, TREC_HEADER, "TREC_HEADER", "TREC_HEADER")
-{ foreign "C" barf("TREC_HEADER object entered!"); }
-
-INFO_TABLE_CONSTR(stg_END_STM_WAIT_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_WAIT_QUEUE","END_STM_WAIT_QUEUE")
-{ foreign "C" barf("END_STM_WAIT_QUEUE object entered!"); }
-
-INFO_TABLE_CONSTR(stg_END_STM_CHUNK_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_CHUNK_LIST","END_STM_CHUNK_LIST")
-{ foreign "C" barf("END_STM_CHUNK_LIST object entered!"); }
-
-INFO_TABLE_CONSTR(stg_NO_TREC,0,0,0,CONSTR_NOCAF_STATIC,"NO_TREC","NO_TREC")
-{ foreign "C" barf("NO_TREC object entered!"); }
-
-CLOSURE(stg_END_STM_WAIT_QUEUE_closure,stg_END_STM_WAIT_QUEUE);
-
-CLOSURE(stg_END_STM_CHUNK_LIST_closure,stg_END_STM_CHUNK_LIST);
-
-CLOSURE(stg_NO_TREC_closure,stg_NO_TREC);
-
-/* ----------------------------------------------------------------------------
-   END_TSO_QUEUE
-
-   This is a static nullary constructor (like []) that we use to mark the
-   end of a linked TSO queue.
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE_CONSTR(stg_END_TSO_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_TSO_QUEUE","END_TSO_QUEUE")
-{ foreign "C" barf("END_TSO_QUEUE object entered!"); }
-
-CLOSURE(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE);
-
-/* ----------------------------------------------------------------------------
-   Exception lists
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_EXCEPTION_LIST","END_EXCEPTION_LIST")
-{ foreign "C" barf("END_EXCEPTION_LIST object entered!"); }
-
-CLOSURE(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST);
-
-INFO_TABLE(stg_EXCEPTION_CONS,1,1,CONSTR,"EXCEPTION_CONS","EXCEPTION_CONS")
-{ foreign "C" barf("EXCEPTION_CONS object entered!"); }
-
-/* ----------------------------------------------------------------------------
-   Arrays
-
-   These come in two basic flavours: arrays of data (StgArrWords) and arrays of
-   pointers (StgArrPtrs).  They all have a similar layout:
-
-	___________________________
-	| Info | No. of | data....
-        |  Ptr | Words  |
-	---------------------------
-
-   These are *unpointed* objects: i.e. they cannot be entered.
-
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_ARR_WORDS, 0, 0, ARR_WORDS, "ARR_WORDS", "ARR_WORDS")
-{ foreign "C" barf("ARR_WORDS object entered!"); }
-
-INFO_TABLE(stg_MUT_ARR_PTRS_CLEAN, 0, 0, MUT_ARR_PTRS_CLEAN, "MUT_ARR_PTRS_CLEAN", "MUT_ARR_PTRS_CLEAN")
-{ foreign "C" barf("MUT_ARR_PTRS_CLEAN object entered!"); }
-
-INFO_TABLE(stg_MUT_ARR_PTRS_DIRTY, 0, 0, MUT_ARR_PTRS_DIRTY, "MUT_ARR_PTRS_DIRTY", "MUT_ARR_PTRS_DIRTY")
-{ foreign "C" barf("MUT_ARR_PTRS_DIRTY object entered!"); }
-
-INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN, 0, 0, MUT_ARR_PTRS_FROZEN, "MUT_ARR_PTRS_FROZEN", "MUT_ARR_PTRS_FROZEN")
-{ foreign "C" barf("MUT_ARR_PTRS_FROZEN object entered!"); }
-
-INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN0, 0, 0, MUT_ARR_PTRS_FROZEN0, "MUT_ARR_PTRS_FROZEN0", "MUT_ARR_PTRS_FROZEN0")
-{ foreign "C" barf("MUT_ARR_PTRS_FROZEN0 object entered!"); }
-
-/* ----------------------------------------------------------------------------
-   Mutable Variables
-   ------------------------------------------------------------------------- */
-
-INFO_TABLE(stg_MUT_VAR_CLEAN, 1, 0, MUT_VAR_CLEAN, "MUT_VAR_CLEAN", "MUT_VAR_CLEAN")
-{ foreign "C" barf("MUT_VAR_CLEAN object entered!"); }
-INFO_TABLE(stg_MUT_VAR_DIRTY, 1, 0, MUT_VAR_DIRTY, "MUT_VAR_DIRTY", "MUT_VAR_DIRTY")
-{ foreign "C" barf("MUT_VAR_DIRTY object entered!"); }
-
-/* ----------------------------------------------------------------------------
-   Dummy return closure
- 
-   Entering this closure will just return to the address on the top of the
-   stack.  Useful for getting a thread in a canonical form where we can
-   just enter the top stack word to start the thread.  (see deleteThread)
- * ------------------------------------------------------------------------- */
-
-INFO_TABLE( stg_dummy_ret, 0, 0, CONSTR_NOCAF_STATIC, "DUMMY_RET", "DUMMY_RET")
-{
-  jump %ENTRY_CODE(Sp(0));
-}
-CLOSURE(stg_dummy_ret_closure,stg_dummy_ret);
-
-/* ----------------------------------------------------------------------------
-   CHARLIKE and INTLIKE closures.  
-
-   These are static representations of Chars and small Ints, so that
-   we can remove dynamic Chars and Ints during garbage collection and
-   replace them with references to the static objects.
-   ------------------------------------------------------------------------- */
-
-#if defined(ENABLE_WIN32_DLL_SUPPORT)
-/*
- * When sticking the RTS in a DLL, we delay populating the
- * Charlike and Intlike tables until load-time, which is only
- * when we've got the real addresses to the C# and I# closures.
- *
- */
-static INFO_TBL_CONST StgInfoTable czh_static_info;
-static INFO_TBL_CONST StgInfoTable izh_static_info;
-#define Char_hash_static_info czh_static_info
-#define Int_hash_static_info izh_static_info
-#else
-#define Char_hash_static_info GHCziBase_Czh_static
-#define Int_hash_static_info GHCziBase_Izh_static
-#endif
-
-
-#define CHARLIKE_HDR(n)  CLOSURE(Char_hash_static_info, n)
-#define INTLIKE_HDR(n)   CLOSURE(Int_hash_static_info, n)
-
-/* put these in the *data* section, since the garbage collector relies
- * on the fact that static closures live in the data section.
- */
-
-/* end the name with _closure, to convince the mangler this is a closure */
-
-section "data" {
- stg_CHARLIKE_closure:
-    CHARLIKE_HDR(0)
-    CHARLIKE_HDR(1)
-    CHARLIKE_HDR(2)
-    CHARLIKE_HDR(3)
-    CHARLIKE_HDR(4)
-    CHARLIKE_HDR(5)
-    CHARLIKE_HDR(6)
-    CHARLIKE_HDR(7)
-    CHARLIKE_HDR(8)
-    CHARLIKE_HDR(9)
-    CHARLIKE_HDR(10)
-    CHARLIKE_HDR(11)
-    CHARLIKE_HDR(12)
-    CHARLIKE_HDR(13)
-    CHARLIKE_HDR(14)
-    CHARLIKE_HDR(15)
-    CHARLIKE_HDR(16)
-    CHARLIKE_HDR(17)
-    CHARLIKE_HDR(18)
-    CHARLIKE_HDR(19)
-    CHARLIKE_HDR(20)
-    CHARLIKE_HDR(21)
-    CHARLIKE_HDR(22)
-    CHARLIKE_HDR(23)
-    CHARLIKE_HDR(24)
-    CHARLIKE_HDR(25)
-    CHARLIKE_HDR(26)
-    CHARLIKE_HDR(27)
-    CHARLIKE_HDR(28)
-    CHARLIKE_HDR(29)
-    CHARLIKE_HDR(30)
-    CHARLIKE_HDR(31)
-    CHARLIKE_HDR(32)
-    CHARLIKE_HDR(33)
-    CHARLIKE_HDR(34)
-    CHARLIKE_HDR(35)
-    CHARLIKE_HDR(36)
-    CHARLIKE_HDR(37)
-    CHARLIKE_HDR(38)
-    CHARLIKE_HDR(39)
-    CHARLIKE_HDR(40)
-    CHARLIKE_HDR(41)
-    CHARLIKE_HDR(42)
-    CHARLIKE_HDR(43)
-    CHARLIKE_HDR(44)
-    CHARLIKE_HDR(45)
-    CHARLIKE_HDR(46)
-    CHARLIKE_HDR(47)
-    CHARLIKE_HDR(48)
-    CHARLIKE_HDR(49)
-    CHARLIKE_HDR(50)
-    CHARLIKE_HDR(51)
-    CHARLIKE_HDR(52)
-    CHARLIKE_HDR(53)
-    CHARLIKE_HDR(54)
-    CHARLIKE_HDR(55)
-    CHARLIKE_HDR(56)
-    CHARLIKE_HDR(57)
-    CHARLIKE_HDR(58)
-    CHARLIKE_HDR(59)
-    CHARLIKE_HDR(60)
-    CHARLIKE_HDR(61)
-    CHARLIKE_HDR(62)
-    CHARLIKE_HDR(63)
-    CHARLIKE_HDR(64)
-    CHARLIKE_HDR(65)
-    CHARLIKE_HDR(66)
-    CHARLIKE_HDR(67)
-    CHARLIKE_HDR(68)
-    CHARLIKE_HDR(69)
-    CHARLIKE_HDR(70)
-    CHARLIKE_HDR(71)
-    CHARLIKE_HDR(72)
-    CHARLIKE_HDR(73)
-    CHARLIKE_HDR(74)
-    CHARLIKE_HDR(75)
-    CHARLIKE_HDR(76)
-    CHARLIKE_HDR(77)
-    CHARLIKE_HDR(78)
-    CHARLIKE_HDR(79)
-    CHARLIKE_HDR(80)
-    CHARLIKE_HDR(81)
-    CHARLIKE_HDR(82)
-    CHARLIKE_HDR(83)
-    CHARLIKE_HDR(84)
-    CHARLIKE_HDR(85)
-    CHARLIKE_HDR(86)
-    CHARLIKE_HDR(87)
-    CHARLIKE_HDR(88)
-    CHARLIKE_HDR(89)
-    CHARLIKE_HDR(90)
-    CHARLIKE_HDR(91)
-    CHARLIKE_HDR(92)
-    CHARLIKE_HDR(93)
-    CHARLIKE_HDR(94)
-    CHARLIKE_HDR(95)
-    CHARLIKE_HDR(96)
-    CHARLIKE_HDR(97)
-    CHARLIKE_HDR(98)
-    CHARLIKE_HDR(99)
-    CHARLIKE_HDR(100)
-    CHARLIKE_HDR(101)
-    CHARLIKE_HDR(102)
-    CHARLIKE_HDR(103)
-    CHARLIKE_HDR(104)
-    CHARLIKE_HDR(105)
-    CHARLIKE_HDR(106)
-    CHARLIKE_HDR(107)
-    CHARLIKE_HDR(108)
-    CHARLIKE_HDR(109)
-    CHARLIKE_HDR(110)
-    CHARLIKE_HDR(111)
-    CHARLIKE_HDR(112)
-    CHARLIKE_HDR(113)
-    CHARLIKE_HDR(114)
-    CHARLIKE_HDR(115)
-    CHARLIKE_HDR(116)
-    CHARLIKE_HDR(117)
-    CHARLIKE_HDR(118)
-    CHARLIKE_HDR(119)
-    CHARLIKE_HDR(120)
-    CHARLIKE_HDR(121)
-    CHARLIKE_HDR(122)
-    CHARLIKE_HDR(123)
-    CHARLIKE_HDR(124)
-    CHARLIKE_HDR(125)
-    CHARLIKE_HDR(126)
-    CHARLIKE_HDR(127)
-    CHARLIKE_HDR(128)
-    CHARLIKE_HDR(129)
-    CHARLIKE_HDR(130)
-    CHARLIKE_HDR(131)
-    CHARLIKE_HDR(132)
-    CHARLIKE_HDR(133)
-    CHARLIKE_HDR(134)
-    CHARLIKE_HDR(135)
-    CHARLIKE_HDR(136)
-    CHARLIKE_HDR(137)
-    CHARLIKE_HDR(138)
-    CHARLIKE_HDR(139)
-    CHARLIKE_HDR(140)
-    CHARLIKE_HDR(141)
-    CHARLIKE_HDR(142)
-    CHARLIKE_HDR(143)
-    CHARLIKE_HDR(144)
-    CHARLIKE_HDR(145)
-    CHARLIKE_HDR(146)
-    CHARLIKE_HDR(147)
-    CHARLIKE_HDR(148)
-    CHARLIKE_HDR(149)
-    CHARLIKE_HDR(150)
-    CHARLIKE_HDR(151)
-    CHARLIKE_HDR(152)
-    CHARLIKE_HDR(153)
-    CHARLIKE_HDR(154)
-    CHARLIKE_HDR(155)
-    CHARLIKE_HDR(156)
-    CHARLIKE_HDR(157)
-    CHARLIKE_HDR(158)
-    CHARLIKE_HDR(159)
-    CHARLIKE_HDR(160)
-    CHARLIKE_HDR(161)
-    CHARLIKE_HDR(162)
-    CHARLIKE_HDR(163)
-    CHARLIKE_HDR(164)
-    CHARLIKE_HDR(165)
-    CHARLIKE_HDR(166)
-    CHARLIKE_HDR(167)
-    CHARLIKE_HDR(168)
-    CHARLIKE_HDR(169)
-    CHARLIKE_HDR(170)
-    CHARLIKE_HDR(171)
-    CHARLIKE_HDR(172)
-    CHARLIKE_HDR(173)
-    CHARLIKE_HDR(174)
-    CHARLIKE_HDR(175)
-    CHARLIKE_HDR(176)
-    CHARLIKE_HDR(177)
-    CHARLIKE_HDR(178)
-    CHARLIKE_HDR(179)
-    CHARLIKE_HDR(180)
-    CHARLIKE_HDR(181)
-    CHARLIKE_HDR(182)
-    CHARLIKE_HDR(183)
-    CHARLIKE_HDR(184)
-    CHARLIKE_HDR(185)
-    CHARLIKE_HDR(186)
-    CHARLIKE_HDR(187)
-    CHARLIKE_HDR(188)
-    CHARLIKE_HDR(189)
-    CHARLIKE_HDR(190)
-    CHARLIKE_HDR(191)
-    CHARLIKE_HDR(192)
-    CHARLIKE_HDR(193)
-    CHARLIKE_HDR(194)
-    CHARLIKE_HDR(195)
-    CHARLIKE_HDR(196)
-    CHARLIKE_HDR(197)
-    CHARLIKE_HDR(198)
-    CHARLIKE_HDR(199)
-    CHARLIKE_HDR(200)
-    CHARLIKE_HDR(201)
-    CHARLIKE_HDR(202)
-    CHARLIKE_HDR(203)
-    CHARLIKE_HDR(204)
-    CHARLIKE_HDR(205)
-    CHARLIKE_HDR(206)
-    CHARLIKE_HDR(207)
-    CHARLIKE_HDR(208)
-    CHARLIKE_HDR(209)
-    CHARLIKE_HDR(210)
-    CHARLIKE_HDR(211)
-    CHARLIKE_HDR(212)
-    CHARLIKE_HDR(213)
-    CHARLIKE_HDR(214)
-    CHARLIKE_HDR(215)
-    CHARLIKE_HDR(216)
-    CHARLIKE_HDR(217)
-    CHARLIKE_HDR(218)
-    CHARLIKE_HDR(219)
-    CHARLIKE_HDR(220)
-    CHARLIKE_HDR(221)
-    CHARLIKE_HDR(222)
-    CHARLIKE_HDR(223)
-    CHARLIKE_HDR(224)
-    CHARLIKE_HDR(225)
-    CHARLIKE_HDR(226)
-    CHARLIKE_HDR(227)
-    CHARLIKE_HDR(228)
-    CHARLIKE_HDR(229)
-    CHARLIKE_HDR(230)
-    CHARLIKE_HDR(231)
-    CHARLIKE_HDR(232)
-    CHARLIKE_HDR(233)
-    CHARLIKE_HDR(234)
-    CHARLIKE_HDR(235)
-    CHARLIKE_HDR(236)
-    CHARLIKE_HDR(237)
-    CHARLIKE_HDR(238)
-    CHARLIKE_HDR(239)
-    CHARLIKE_HDR(240)
-    CHARLIKE_HDR(241)
-    CHARLIKE_HDR(242)
-    CHARLIKE_HDR(243)
-    CHARLIKE_HDR(244)
-    CHARLIKE_HDR(245)
-    CHARLIKE_HDR(246)
-    CHARLIKE_HDR(247)
-    CHARLIKE_HDR(248)
-    CHARLIKE_HDR(249)
-    CHARLIKE_HDR(250)
-    CHARLIKE_HDR(251)
-    CHARLIKE_HDR(252)
-    CHARLIKE_HDR(253)
-    CHARLIKE_HDR(254)
-    CHARLIKE_HDR(255)
-}
-
-section "data" {
- stg_INTLIKE_closure:
-    INTLIKE_HDR(-16)	/* MIN_INTLIKE == -16 */
-    INTLIKE_HDR(-15)
-    INTLIKE_HDR(-14)
-    INTLIKE_HDR(-13)
-    INTLIKE_HDR(-12)
-    INTLIKE_HDR(-11)
-    INTLIKE_HDR(-10)
-    INTLIKE_HDR(-9)
-    INTLIKE_HDR(-8)
-    INTLIKE_HDR(-7)
-    INTLIKE_HDR(-6)
-    INTLIKE_HDR(-5)
-    INTLIKE_HDR(-4)
-    INTLIKE_HDR(-3)
-    INTLIKE_HDR(-2)
-    INTLIKE_HDR(-1)
-    INTLIKE_HDR(0)
-    INTLIKE_HDR(1)
-    INTLIKE_HDR(2)
-    INTLIKE_HDR(3)
-    INTLIKE_HDR(4)
-    INTLIKE_HDR(5)
-    INTLIKE_HDR(6)
-    INTLIKE_HDR(7)
-    INTLIKE_HDR(8)
-    INTLIKE_HDR(9)
-    INTLIKE_HDR(10)
-    INTLIKE_HDR(11)
-    INTLIKE_HDR(12)
-    INTLIKE_HDR(13)
-    INTLIKE_HDR(14)
-    INTLIKE_HDR(15)
-    INTLIKE_HDR(16)	/* MAX_INTLIKE == 16 */
-}
diff --git a/ghc/rts/StgPrimFloat.c b/ghc/rts/StgPrimFloat.c
deleted file mode 100644
index 5bd6aebb1c..0000000000
--- a/ghc/rts/StgPrimFloat.c
+++ /dev/null
@@ -1,491 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2000
- *
- * Miscellaneous support for floating-point primitives
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-
-#include <math.h>
-
-/*
- * Encoding and decoding Doubles.  Code based on the HBC code
- * (lib/fltcode.c).
- */
-
-#ifdef _SHORT_LIMB
-#define SIZEOF_LIMB_T SIZEOF_UNSIGNED_INT
-#else
-#ifdef _LONG_LONG_LIMB
-#define SIZEOF_LIMB_T SIZEOF_UNSIGNED_LONG_LONG
-#else
-#define SIZEOF_LIMB_T SIZEOF_UNSIGNED_LONG
-#endif
-#endif
-
-#if SIZEOF_LIMB_T == 4
-#define GMP_BASE 4294967296.0
-#elif SIZEOF_LIMB_T == 8
-#define GMP_BASE 18446744073709551616.0
-#else
-#error Cannot cope with SIZEOF_LIMB_T -- please add definition of GMP_BASE
-#endif
-
-#define DNBIGIT	 ((SIZEOF_DOUBLE+SIZEOF_LIMB_T-1)/SIZEOF_LIMB_T)
-#define FNBIGIT	 ((SIZEOF_FLOAT +SIZEOF_LIMB_T-1)/SIZEOF_LIMB_T)
-
-#if IEEE_FLOATING_POINT
-#define MY_DMINEXP  ((DBL_MIN_EXP) - (DBL_MANT_DIG) - 1)
-/* DMINEXP is defined in values.h on Linux (for example) */
-#define DHIGHBIT 0x00100000
-#define DMSBIT   0x80000000
-
-#define MY_FMINEXP  ((FLT_MIN_EXP) - (FLT_MANT_DIG) - 1)
-#define FHIGHBIT 0x00800000
-#define FMSBIT   0x80000000
-#endif
-
-#ifdef WORDS_BIGENDIAN
-#define L 1
-#define H 0
-#else
-#define L 0
-#define H 1
-#endif
-
-#define __abs(a)		(( (a) >= 0 ) ? (a) : (-(a)))
-
-StgDouble
-__encodeDouble (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
-{
-    StgDouble r;
-    const mp_limb_t *const arr = (const mp_limb_t *)ba;
-    I_ i;
-
-    /* Convert MP_INT to a double; knows a lot about internal rep! */
-    for(r = 0.0, i = __abs(size)-1; i >= 0; i--)
-	r = (r * GMP_BASE) + arr[i];
-
-    /* Now raise to the exponent */
-    if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
-	r = ldexp(r, e);
-
-    /* sign is encoded in the size */
-    if (size < 0)
-	r = -r;
-
-    return r;
-}
-
-/* Special version for small Integers */
-StgDouble
-__int_encodeDouble (I_ j, I_ e)
-{
-  StgDouble r;
-  
-  r = (StgDouble)__abs(j);
-  
-  /* Now raise to the exponent */
-  if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
-    r = ldexp(r, e);
-  
-  /* sign is encoded in the size */
-  if (j < 0)
-    r = -r;
-  
-  return r;
-}
-
-StgFloat
-__encodeFloat (I_ size, StgByteArray ba, I_ e) /* result = s * 2^e */
-{
-    StgFloat r;
-    const mp_limb_t *arr = (const mp_limb_t *)ba;
-    I_ i;
-
-    /* Convert MP_INT to a float; knows a lot about internal rep! */
-    for(r = 0.0, i = __abs(size)-1; i >= 0; i--)
-	r = (r * GMP_BASE) + arr[i];
-
-    /* Now raise to the exponent */
-    if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
-	r = ldexp(r, e);
-
-    /* sign is encoded in the size */
-    if (size < 0)
-	r = -r;
-
-    return r;
-}
-
-/* Special version for small Integers */
-StgFloat
-__int_encodeFloat (I_ j, I_ e)
-{
-  StgFloat r;
-  
-  r = (StgFloat)__abs(j);
-  
-  /* Now raise to the exponent */
-  if ( r != 0.0 ) /* Lennart suggests this avoids a bug in MIPS's ldexp */
-    r = ldexp(r, e);
-  
-  /* sign is encoded in the size */
-  if (j < 0)
-    r = -r;
-  
-  return r;
-}
-
-/* This only supports IEEE floating point */
-
-void
-__decodeDouble (MP_INT *man, I_ *exp, StgDouble dbl)
-{
-    /* Do some bit fiddling on IEEE */
-    unsigned int low, high; 	     	/* assuming 32 bit ints */
-    int sign, iexp;
-    union { double d; unsigned int i[2]; } u;	/* assuming 32 bit ints, 64 bit double */
-
-    ASSERT(sizeof(unsigned int ) == 4            );
-    ASSERT(sizeof(dbl          ) == SIZEOF_DOUBLE);
-    ASSERT(sizeof(man->_mp_d[0]) == SIZEOF_LIMB_T);
-    ASSERT(DNBIGIT*SIZEOF_LIMB_T >= SIZEOF_DOUBLE);
-
-    u.d = dbl;	    /* grab chunks of the double */
-    low = u.i[L];
-    high = u.i[H];
-
-    /* we know the MP_INT* passed in has size zero, so we realloc
-    	no matter what.
-    */
-    man->_mp_alloc = DNBIGIT;
-
-    if (low == 0 && (high & ~DMSBIT) == 0) {
-	man->_mp_size = 0;
-	*exp = 0L;
-    } else {
-	man->_mp_size = DNBIGIT;
-	iexp = ((high >> 20) & 0x7ff) + MY_DMINEXP;
-	sign = high;
-
-	high &= DHIGHBIT-1;
-	if (iexp != MY_DMINEXP)	/* don't add hidden bit to denorms */
-	    high |= DHIGHBIT;
-	else {
-	    iexp++;
-	    /* A denorm, normalize the mantissa */
-	    while (! (high & DHIGHBIT)) {
-		high <<= 1;
-		if (low & DMSBIT)
-		    high++;
-		low <<= 1;
-		iexp--;
-	    }
-	}
-        *exp = (I_) iexp;
-#if DNBIGIT == 2
-	man->_mp_d[0] = (mp_limb_t)low;
-	man->_mp_d[1] = (mp_limb_t)high;
-#else
-#if DNBIGIT == 1
-	man->_mp_d[0] = ((mp_limb_t)high) << 32 | (mp_limb_t)low;
-#else
-#error Cannot cope with DNBIGIT
-#endif
-#endif
-	if (sign < 0)
-	    man->_mp_size = -man->_mp_size;
-    }
-}
-
-void
-__decodeFloat (MP_INT *man, I_ *exp, StgFloat flt)
-{
-    /* Do some bit fiddling on IEEE */
-    int high, sign; 	    	    /* assuming 32 bit ints */
-    union { float f; int i; } u;    /* assuming 32 bit float and int */
-
-    ASSERT(sizeof(int          ) == 4            );
-    ASSERT(sizeof(flt          ) == SIZEOF_FLOAT );
-    ASSERT(sizeof(man->_mp_d[0]) == SIZEOF_LIMB_T);
-    ASSERT(FNBIGIT*SIZEOF_LIMB_T >= SIZEOF_FLOAT );
-
-    u.f = flt;	    /* grab the float */
-    high = u.i;
-
-    /* we know the MP_INT* passed in has size zero, so we realloc
-    	no matter what.
-    */
-    man->_mp_alloc = FNBIGIT;
-
-    if ((high & ~FMSBIT) == 0) {
-	man->_mp_size = 0;
-	*exp = 0;
-    } else {
-	man->_mp_size = FNBIGIT;
-	*exp = ((high >> 23) & 0xff) + MY_FMINEXP;
-	sign = high;
-
-	high &= FHIGHBIT-1;
-	if (*exp != MY_FMINEXP)	/* don't add hidden bit to denorms */
-	    high |= FHIGHBIT;
-	else {
-	    (*exp)++;
-	    /* A denorm, normalize the mantissa */
-	    while (! (high & FHIGHBIT)) {
-		high <<= 1;
-		(*exp)--;
-	    }
-	}
-#if FNBIGIT == 1
-	man->_mp_d[0] = (mp_limb_t)high;
-#else
-#error Cannot cope with FNBIGIT
-#endif
-	if (sign < 0)
-	    man->_mp_size = -man->_mp_size;
-    }
-}
-
-/* Convenient union types for checking the layout of IEEE 754 types -
-   based on defs in GNU libc <ieee754.h>
-*/
-
-union stg_ieee754_flt
-{
-   float f;
-   struct {
-
-#if WORDS_BIGENDIAN
-	unsigned int negative:1;
-	unsigned int exponent:8;
-	unsigned int mantissa:23;
-#else
-	unsigned int mantissa:23;
-	unsigned int exponent:8;
-	unsigned int negative:1;
-#endif
-   } ieee;
-   struct {
-
-#if WORDS_BIGENDIAN
-	unsigned int negative:1;
-	unsigned int exponent:8;
-	unsigned int quiet_nan:1;
-	unsigned int mantissa:22;
-#else
-	unsigned int mantissa:22;
-	unsigned int quiet_nan:1;
-	unsigned int exponent:8;
-	unsigned int negative:1;
-#endif
-   } ieee_nan;
-};
-
-/*
- 
- To recap, here's the representation of a double precision
- IEEE floating point number:
-
- sign         63           sign bit (0==positive, 1==negative)
- exponent     62-52        exponent (biased by 1023)
- fraction     51-0         fraction (bits to right of binary point)
-*/
-
-union stg_ieee754_dbl
-{
-   double d;
-   struct {
-
-#if WORDS_BIGENDIAN
-	unsigned int negative:1;
-	unsigned int exponent:11;
-	unsigned int mantissa0:20;
-	unsigned int mantissa1:32;
-#else
-	unsigned int mantissa1:32;
-	unsigned int mantissa0:20;
-	unsigned int exponent:11;
-	unsigned int negative:1;
-#endif
-   } ieee;
-    /* This format makes it easier to see if a NaN is a signalling NaN.  */
-   struct {
-
-#if WORDS_BIGENDIAN
-	unsigned int negative:1;
-	unsigned int exponent:11;
-	unsigned int quiet_nan:1;
-	unsigned int mantissa0:19;
-	unsigned int mantissa1:32;
-#else
-	unsigned int mantissa1:32;
-	unsigned int mantissa0:19;
-	unsigned int quiet_nan:1;
-	unsigned int exponent:11;
-	unsigned int negative:1;
-#endif
-   } ieee_nan;
-};
-
-/*
- * Predicates for testing for extreme IEEE fp values. Used
- * by the bytecode evaluator and the Prelude.
- *
- */ 
-
-/* In case you don't suppport IEEE, you'll just get dummy defs.. */
-#ifdef IEEE_FLOATING_POINT
-
-StgInt
-isDoubleNaN(StgDouble d)
-{
-  union stg_ieee754_dbl u;
-  
-  u.d = d;
-
-  return (
-    u.ieee.exponent  == 2047 /* 2^11 - 1 */ &&  /* Is the exponent all ones? */
-    (u.ieee.mantissa0 != 0 || u.ieee.mantissa1 != 0)
-    	/* and the mantissa non-zero? */
-    );
-}
-
-StgInt
-isDoubleInfinite(StgDouble d)
-{
-    union stg_ieee754_dbl u;
-
-    u.d = d;
-
-    /* Inf iff exponent is all ones, mantissa all zeros */
-    return (
-        u.ieee.exponent  == 2047 /* 2^11 - 1 */ &&
-	u.ieee.mantissa0 == 0 		        &&
-	u.ieee.mantissa1 == 0
-      );
-}
-
-StgInt
-isDoubleDenormalized(StgDouble d) 
-{
-    union stg_ieee754_dbl u;
-
-    u.d = d;
-
-    /* A (single/double/quad) precision floating point number
-       is denormalised iff:
-        - exponent is zero
-	- mantissa is non-zero.
-        - (don't care about setting of sign bit.)
-
-    */
-    return (  
-	u.ieee.exponent  == 0 &&
-	(u.ieee.mantissa0 != 0 ||
-	 u.ieee.mantissa1 != 0)
-      );
-	 
-}
-
-StgInt
-isDoubleNegativeZero(StgDouble d) 
-{
-    union stg_ieee754_dbl u;
-
-    u.d = d;
-    /* sign (bit 63) set (only) => negative zero */
-
-    return (
-    	u.ieee.negative  == 1 &&
-	u.ieee.exponent  == 0 &&
-	u.ieee.mantissa0 == 0 &&
-	u.ieee.mantissa1 == 0);
-}
-
-/* Same tests, this time for StgFloats. */
-
-/*
- To recap, here's the representation of a single precision
- IEEE floating point number:
-
- sign         31           sign bit (0 == positive, 1 == negative)
- exponent     30-23        exponent (biased by 127)
- fraction     22-0         fraction (bits to right of binary point)
-*/
-
-
-StgInt
-isFloatNaN(StgFloat f)
-{
-    union stg_ieee754_flt u;
-    u.f = f;
-
-   /* Floating point NaN iff exponent is all ones, mantissa is
-      non-zero (but see below.) */
-   return (
-   	u.ieee.exponent == 255 /* 2^8 - 1 */ &&
-	u.ieee.mantissa != 0);
-}
-
-StgInt
-isFloatInfinite(StgFloat f)
-{
-    union stg_ieee754_flt u;
-    u.f = f;
-  
-    /* A float is Inf iff exponent is max (all ones),
-       and mantissa is min(all zeros.) */
-    return (
-    	u.ieee.exponent == 255 /* 2^8 - 1 */ &&
-	u.ieee.mantissa == 0);
-}
-
-StgInt
-isFloatDenormalized(StgFloat f)
-{
-    union stg_ieee754_flt u;
-    u.f = f;
-
-    /* A (single/double/quad) precision floating point number
-       is denormalised iff:
-        - exponent is zero
-	- mantissa is non-zero.
-        - (don't care about setting of sign bit.)
-
-    */
-    return (
-    	u.ieee.exponent == 0 &&
-	u.ieee.mantissa != 0);
-}
-
-StgInt
-isFloatNegativeZero(StgFloat f) 
-{
-    union stg_ieee754_flt u;
-    u.f = f;
-
-    /* sign (bit 31) set (only) => negative zero */
-    return (
-	u.ieee.negative      &&
-	u.ieee.exponent == 0 &&
-	u.ieee.mantissa == 0);
-}
-
-#else /* ! IEEE_FLOATING_POINT */
-
-/* Dummy definitions of predicates - they all return false */
-StgInt isDoubleNaN(d) StgDouble d; { return 0; }
-StgInt isDoubleInfinite(d) StgDouble d; { return 0; }
-StgInt isDoubleDenormalized(d) StgDouble d; { return 0; }
-StgInt isDoubleNegativeZero(d) StgDouble d; { return 0; }
-StgInt isFloatNaN(f) StgFloat f; { return 0; }
-StgInt isFloatInfinite(f) StgFloat f; { return 0; }
-StgInt isFloatDenormalized(f) StgFloat f; { return 0; }
-StgInt isFloatNegativeZero(f) StgFloat f; { return 0; }
-
-#endif /* ! IEEE_FLOATING_POINT */
diff --git a/ghc/rts/StgRun.h b/ghc/rts/StgRun.h
deleted file mode 100644
index da376b4971..0000000000
--- a/ghc/rts/StgRun.h
+++ /dev/null
@@ -1,16 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Tiny assembler 'layer' between the C and STG worlds.
- * 
- ---------------------------------------------------------------------------- */
-
-#ifndef STGRUN_H
-#define STGRUN_H
-
-extern StgRegTable * StgRun(StgFunPtr f, StgRegTable *basereg);
-
-RTS_FUN(StgReturn);
-
-#endif /* STGRUN_H */
diff --git a/ghc/rts/StgStartup.cmm b/ghc/rts/StgStartup.cmm
deleted file mode 100644
index 2f2a759c81..0000000000
--- a/ghc/rts/StgStartup.cmm
+++ /dev/null
@@ -1,218 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Code for starting, stopping and restarting threads.
- *
- * This file is written in a subset of C--, extended with various
- * features specific to GHC.  It is compiled by GHC directly.  For the
- * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Cmm.h"
-
-/*
- * This module contains the two entry points and the final exit point
- * to/from the Haskell world.  We can enter either by:
- *
- *   a) returning to the address on the top of the stack, or
- *   b) entering the closure on the top of the stack
- *
- * the function stg_stop_thread_entry is the final exit for a
- * thread: it is the last return address on the stack.  It returns
- * to the scheduler marking the thread as finished.
- */
-
-#define CHECK_SENSIBLE_REGS() \
-    ASSERT(Hp != 0);			\
-    ASSERT(Sp != 0);			\
-    ASSERT(SpLim != 0);			\
-    ASSERT(HpLim != 0);			\
-    ASSERT(SpLim - WDS(RESERVED_STACK_WORDS) <= Sp); \
-    ASSERT(HpLim >= Hp);
-
-/* -----------------------------------------------------------------------------
-   Returning from the STG world.
-
-   This is a polymorphic return address, meaning that any old constructor
-   can be returned, we don't care (actually, it's probably going to be
-   an IOok constructor, which will indirect through the vector table
-   slot 0).
-   -------------------------------------------------------------------------- */
-
-#if defined(PROFILING)
-#define STOP_THREAD_BITMAP 3
-#define STOP_THREAD_WORDS  2
-#else
-#define STOP_THREAD_BITMAP 0
-#define STOP_THREAD_WORDS  0
-#endif
-
-/* A polymorhpic return address, where all the vector slots point to the
-   direct entry point. */
-INFO_TABLE_RET( stg_stop_thread, STOP_THREAD_WORDS, STOP_THREAD_BITMAP,
-		STOP_FRAME, 
-		RET_LBL(stg_stop_thread),
-		RET_LBL(stg_stop_thread),
-		RET_LBL(stg_stop_thread),
-		RET_LBL(stg_stop_thread),
-		RET_LBL(stg_stop_thread),
-		RET_LBL(stg_stop_thread),
-		RET_LBL(stg_stop_thread),
-		RET_LBL(stg_stop_thread) )
-{
-    /* 
-       The final exit.
-      
-       The top-top-level closures (e.g., "main") are of type "IO a".
-       When entered, they perform an IO action and return an 'a' in R1.
-      
-       We save R1 on top of the stack where the scheduler can find it,
-       tidy up the registers and return to the scheduler.
-      
-       We Leave the stack looking like this:
-      
-            	+----------------+
-                |      -------------------> return value
-            	+----------------+
-            	| stg_enter_info |
-            	+----------------+
-      
-       The stg_enter_info is just a dummy info table so that the
-       garbage collector can understand the stack (there must always
-       be an info table on top of the stack).
-    */
-
-    Sp = Sp + SIZEOF_StgStopFrame - WDS(2);
-    Sp(1) = R1;
-    Sp(0) = stg_enter_info;
-
-    StgTSO_what_next(CurrentTSO) = ThreadComplete::I16;
-
-    SAVE_THREAD_STATE();
-
-    /* The return code goes in BaseReg->rRet, and BaseReg is returned in R1 */
-    StgRegTable_rRet(BaseReg) = ThreadFinished;
-    R1 = BaseReg;
-
-    jump StgReturn;
-}
-
-/* -----------------------------------------------------------------------------
-   Start a thread from the scheduler by returning to the address on
-   the top of the stack.  This is used for all entries to STG code
-   from C land.
-
-   On the way back, we (usually) pass through stg_returnToSched which saves
-   the thread's state away nicely.
-   -------------------------------------------------------------------------- */
-
-stg_returnToStackTop
-{
-  LOAD_THREAD_STATE();
-  CHECK_SENSIBLE_REGS();
-  jump %ENTRY_CODE(Sp(0));
-}
-
-stg_returnToSched
-{
-  SAVE_THREAD_STATE();
-  foreign "C" threadPaused(MyCapability() "ptr", CurrentTSO);
-  jump StgReturn;
-}
-
-// A variant of stg_returntToSched that doesn't call threadPaused() on the
-// current thread.  This is used for switching from compiled execution to the
-// interpreter, where calling threadPaused() on every switch would be too
-// expensive.
-stg_returnToSchedNotPaused
-{
-  SAVE_THREAD_STATE();
-  jump StgReturn;
-}
-
-// A variant of stg_returnToSched, but instead of returning directly to the
-// scheduler, we jump to the code fragment pointed to by R2.  This lets us
-// perform some final actions after making the thread safe, such as unlocking
-// the MVar on which we are about to block in SMP mode.
-stg_returnToSchedButFirst
-{
-  SAVE_THREAD_STATE();
-  foreign "C" threadPaused(MyCapability() "ptr", CurrentTSO);
-  jump R2;
-}
-
-/* -----------------------------------------------------------------------------
-    Strict IO application - performing an IO action and entering its result.
-    
-    rts_evalIO() lets you perform Haskell IO actions from outside of
-    Haskell-land, returning back to you their result. Want this result
-    to be evaluated to WHNF by that time, so that we can easily get at
-    the int/char/whatever using the various get{Ty} functions provided
-    by the RTS API.
-
-    forceIO takes care of this, performing the IO action and entering the
-    results that comes back.
-    ------------------------------------------------------------------------- */
-
-INFO_TABLE_RET( stg_forceIO, 0/*size*/, 0/*bitmap*/, RET_SMALL)
-
-#ifdef REG_R1
-{
-  Sp_adj(1);
-  ENTER();
-}
-#else
-{
-  R1 = Sp(0);
-  Sp_adj(2);
-  ENTER();
-}
-#endif
-
-/* -----------------------------------------------------------------------------
-    Non-strict IO application.
-
-    This stack frame works like stg_forceIO_info except that it
-    doesn't evaluate the return value.  We need the layer because the
-    return convention for an IO action differs depending on whether R1
-    is a register or not.
-    ------------------------------------------------------------------------- */
-
-INFO_TABLE_RET( stg_noforceIO, 0/*size*/, 0/*bitmap*/, RET_SMALL )
-
-#ifdef REG_R1
-{
-  Sp_adj(1);
-  jump %ENTRY_CODE(Sp(0));
-}
-#else
-{
-  R1 = Sp(0);
-  Sp_adj(2);
-  jump %ENTRY_CODE(Sp(0));
-}
-#endif
-
-/* -----------------------------------------------------------------------------
-   Special STG entry points for module registration.
-   -------------------------------------------------------------------------- */
-
-stg_init_finish
-{
-  jump StgReturn;
-}
-
-/* On entry to stg_init:
- *    init_stack[0] = &stg_init_ret;
- *    init_stack[1] = __stginit_Something;
- */
-stg_init
-{
-  W_ next;
-  Sp = W_[BaseReg + OFFSET_StgRegTable_rSp];
-  next = W_[Sp];
-  Sp_adj(1);
-  jump next;
-}
diff --git a/ghc/rts/StgStdThunks.cmm b/ghc/rts/StgStdThunks.cmm
deleted file mode 100644
index 342a6eb164..0000000000
--- a/ghc/rts/StgStdThunks.cmm
+++ /dev/null
@@ -1,274 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The University of Glasgow, 1998-2004
- *
- * Canned "Standard Form" Thunks
- *
- * This file is written in a subset of C--, extended with various
- * features specific to GHC.  It is compiled by GHC directly.  For the
- * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Cmm.h"
-
-/* -----------------------------------------------------------------------------
-   The code for a thunk that simply extracts a field from a
-   single-constructor datatype depends only on the offset of the field
-   to be selected.
-
-   Here we define some canned "selector" thunks that do just that; any
-   selector thunk appearing in a program will refer to one of these
-   instead of being compiled independently.
-
-   The garbage collector spots selector thunks and reduces them if
-   possible, in order to avoid space leaks resulting from lazy pattern
-   matching.
-   -------------------------------------------------------------------------- */
-
-#define WITHUPD_FRAME_SIZE  (SIZEOF_StgUpdateFrame + SIZEOF_StgHeader)
-#define NOUPD_FRAME_SIZE    (SIZEOF_StgHeader)
-
-#ifdef PROFILING
-#define SAVE_CCCS(fs)  	StgHeader_ccs(Sp-fs) = W_[CCCS]
-#define GET_SAVED_CCCS  W_[CCCS] = StgHeader_ccs(Sp)
-#define RET_BITMAP    3
-#define RET_FRAMESIZE 2
-#else
-#define SAVE_CCCS(fs)   /* empty */
-#define GET_SAVED_CCCS  /* empty */
-#define RET_BITMAP    0
-#define RET_FRAMESIZE 0
-#endif
-
-#define SELECTOR_CODE_UPD(offset) \
-  INFO_TABLE_RET(stg_sel_ret_##offset##_upd, RET_FRAMESIZE, RET_BITMAP, RET_SMALL)	\
-  {									\
-      R1 = StgClosure_payload(R1,offset);				\
-      GET_SAVED_CCCS;							\
-      Sp = Sp + SIZEOF_StgHeader;					\
-      ENTER();								\
-  }									\
-									\
-  INFO_TABLE_SELECTOR(stg_sel_##offset##_upd, offset, THUNK_SELECTOR, "stg_sel_upd", "stg_sel_upd") \
-  {									\
-      TICK_ENT_DYN_THK();						\
-      STK_CHK_NP(WITHUPD_FRAME_SIZE);					\
-      UPD_BH_UPDATABLE();						\
-      LDV_ENTER(R1);							\
-      PUSH_UPD_FRAME(Sp - SIZEOF_StgUpdateFrame, R1);			\
-      ENTER_CCS_THUNK(R1);						\
-      SAVE_CCCS(WITHUPD_FRAME_SIZE);					\
-      W_[Sp-WITHUPD_FRAME_SIZE] = stg_sel_ret_##offset##_upd_info;	\
-      R1 = StgThunk_payload(R1,0);					\
-      Sp = Sp - WITHUPD_FRAME_SIZE;					\
-      jump %GET_ENTRY(R1);						\
-  }
-  /* NOTE: no need to ENTER() here, we know the closure cannot evaluate to a function,
-     because we're going to do a field selection on the result. */
-
-SELECTOR_CODE_UPD(0)
-SELECTOR_CODE_UPD(1)
-SELECTOR_CODE_UPD(2)
-SELECTOR_CODE_UPD(3)
-SELECTOR_CODE_UPD(4)
-SELECTOR_CODE_UPD(5)
-SELECTOR_CODE_UPD(6)
-SELECTOR_CODE_UPD(7)
-SELECTOR_CODE_UPD(8)
-SELECTOR_CODE_UPD(9)
-SELECTOR_CODE_UPD(10)
-SELECTOR_CODE_UPD(11)
-SELECTOR_CODE_UPD(12)
-SELECTOR_CODE_UPD(13)
-SELECTOR_CODE_UPD(14)
-SELECTOR_CODE_UPD(15)
-
-#define SELECTOR_CODE_NOUPD(offset) \
-  INFO_TABLE_RET(stg_sel_ret_##offset##_noupd, RET_FRAMESIZE, RET_BITMAP, RET_SMALL)	\
-  {									\
-      R1 = StgClosure_payload(R1,offset);				\
-      GET_SAVED_CCCS;							\
-      Sp = Sp + SIZEOF_StgHeader;					\
-      jump %GET_ENTRY(R1);						\
-  }									\
-									\
-  INFO_TABLE_SELECTOR(stg_sel_##offset##_noupd, offset, THUNK_SELECTOR, "stg_sel_noupd", "stg_sel_noupd")\
-  {									\
-      TICK_ENT_DYN_THK();						\
-      STK_CHK_NP(NOUPD_FRAME_SIZE);					\
-      UPD_BH_SINGLE_ENTRY();						\
-      LDV_ENTER(R1);							\
-      TICK_UPDF_OMITTED();						\
-      ENTER_CCS_THUNK(R1);						\
-      SAVE_CCCS(NOUPD_FRAME_SIZE);					\
-      W_[Sp-NOUPD_FRAME_SIZE] = stg_sel_ret_##offset##_noupd_info;	\
-      R1 = StgThunk_payload(R1,0);					\
-      Sp = Sp - NOUPD_FRAME_SIZE;					\
-      jump %GET_ENTRY(R1);						\
-  }
-
-SELECTOR_CODE_NOUPD(0)
-SELECTOR_CODE_NOUPD(1)
-SELECTOR_CODE_NOUPD(2)
-SELECTOR_CODE_NOUPD(3)
-SELECTOR_CODE_NOUPD(4)
-SELECTOR_CODE_NOUPD(5)
-SELECTOR_CODE_NOUPD(6)
-SELECTOR_CODE_NOUPD(7)
-SELECTOR_CODE_NOUPD(8)
-SELECTOR_CODE_NOUPD(9)
-SELECTOR_CODE_NOUPD(10)
-SELECTOR_CODE_NOUPD(11)
-SELECTOR_CODE_NOUPD(12)
-SELECTOR_CODE_NOUPD(13)
-SELECTOR_CODE_NOUPD(14)
-SELECTOR_CODE_NOUPD(15)
-
-/* -----------------------------------------------------------------------------
-   Apply thunks
-
-   An apply thunk is a thunk of the form
-	
-		let z = [x1...xn] \u x1...xn
-		in ...
-
-   We pre-compile some of these because the code is always the same.
-
-   These have to be independent of the update frame size, so the code
-   works when profiling etc.
-   -------------------------------------------------------------------------- */
-
-/* stg_ap_1_upd_info is a bit redundant, but there appears to be a bug
- * in the compiler that means stg_ap_1 is generated occasionally (ToDo)
- */
-
-INFO_TABLE(stg_ap_1_upd,1,1,THUNK_1_0,"stg_ap_1_upd_info","stg_ap_1_upd_info")
-{
-  TICK_ENT_DYN_THK();
-  STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(1));
-  UPD_BH_UPDATABLE();
-  LDV_ENTER(R1);
-  ENTER_CCS_THUNK(R1);
-  PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
-  R1 = StgThunk_payload(R1,0);
-  Sp = Sp - SIZEOF_StgUpdateFrame;
-  jump stg_ap_0_fast;
-}
-
-INFO_TABLE(stg_ap_2_upd,2,0,THUNK_2_0,"stg_ap_2_upd_info","stg_ap_2_upd_info")
-{
-  TICK_ENT_DYN_THK();
-  STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(2));
-  UPD_BH_UPDATABLE();
-  LDV_ENTER(R1);
-  ENTER_CCS_THUNK(R1);
-  PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,1);
-  R1 = StgThunk_payload(R1,0);
-  Sp = Sp - SIZEOF_StgUpdateFrame - WDS(1);
-  Sp_adj(-1); // for stg_ap_*_ret
-  TICK_UNKNOWN_CALL();
-  TICK_SLOW_CALL_p();
-  jump RET_LBL(stg_ap_p);
-}
-
-INFO_TABLE(stg_ap_3_upd,3,0,THUNK,"stg_ap_3_upd_info","stg_ap_3_upd_info")
-{
-  TICK_ENT_DYN_THK();
-  STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(3));
-  UPD_BH_UPDATABLE();
-  LDV_ENTER(R1);
-  ENTER_CCS_THUNK(R1);
-  PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,2);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,1);
-  R1 = StgThunk_payload(R1,0);
-  Sp = Sp - SIZEOF_StgUpdateFrame - WDS(2);
-  Sp_adj(-1); // for stg_ap_*_ret
-  TICK_UNKNOWN_CALL();
-  TICK_SLOW_CALL_pp();
-  jump RET_LBL(stg_ap_pp);
-}
-
-INFO_TABLE(stg_ap_4_upd,4,0,THUNK,"stg_ap_4_upd_info","stg_ap_4_upd_info")
-{
-  TICK_ENT_DYN_THK();
-  STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(4));
-  UPD_BH_UPDATABLE();
-  LDV_ENTER(R1);
-  ENTER_CCS_THUNK(R1);
-  PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,3);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,2);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,1);
-  R1 = StgThunk_payload(R1,0);
-  Sp = Sp - SIZEOF_StgUpdateFrame - WDS(3);
-  Sp_adj(-1); // for stg_ap_*_ret
-  TICK_UNKNOWN_CALL();
-  TICK_SLOW_CALL_ppp();
-  jump RET_LBL(stg_ap_ppp);
-}
-
-INFO_TABLE(stg_ap_5_upd,5,0,THUNK,"stg_ap_5_upd_info","stg_ap_5_upd_info")
-{
-  TICK_ENT_DYN_THK();
-  STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(5));
-  UPD_BH_UPDATABLE();
-  LDV_ENTER(R1);
-  ENTER_CCS_THUNK(R1);
-  PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,4);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,3);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,2);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,1);
-  R1 = StgThunk_payload(R1,0);
-  Sp = Sp - SIZEOF_StgUpdateFrame - WDS(4);
-  Sp_adj(-1); // for stg_ap_*_ret
-  TICK_UNKNOWN_CALL();
-  TICK_SLOW_CALL_pppp();
-  jump RET_LBL(stg_ap_pppp);
-}
-
-INFO_TABLE(stg_ap_6_upd,6,0,THUNK,"stg_ap_6_upd_info","stg_ap_6_upd_info")
-{
-  TICK_ENT_DYN_THK();
-  STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(6));
-  UPD_BH_UPDATABLE();
-  LDV_ENTER(R1);
-  ENTER_CCS_THUNK(R1);
-  PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,5);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,4);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,3);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,2);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgThunk_payload(R1,1);
-  R1 = StgThunk_payload(R1,0);
-  Sp = Sp - SIZEOF_StgUpdateFrame - WDS(5);
-  Sp_adj(-1); // for stg_ap_*_ret
-  TICK_UNKNOWN_CALL();
-  TICK_SLOW_CALL_ppppp();
-  jump RET_LBL(stg_ap_ppppp);
-}
-
-INFO_TABLE(stg_ap_7_upd,7,0,THUNK,"stg_ap_7_upd_info","stg_ap_7_upd_info")
-{
-  TICK_ENT_DYN_THK();
-  STK_CHK_NP(SIZEOF_StgUpdateFrame+WDS(7));
-  UPD_BH_UPDATABLE();
-  LDV_ENTER(R1);
-  ENTER_CCS_THUNK(R1);
-  PUSH_UPD_FRAME(Sp-SIZEOF_StgUpdateFrame,R1);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(1)] = StgThunk_payload(R1,6);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(2)] = StgThunk_payload(R1,5);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(3)] = StgThunk_payload(R1,4);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(4)] = StgThunk_payload(R1,3);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(5)] = StgThunk_payload(R1,2);
-  W_[Sp-SIZEOF_StgUpdateFrame-WDS(6)] = StgThunk_payload(R1,1);
-  R1 = StgThunk_payload(R1,0);
-  Sp = Sp - SIZEOF_StgUpdateFrame - WDS(6);
-  Sp_adj(-1); // for stg_ap_*_ret
-  TICK_UNKNOWN_CALL();
-  TICK_SLOW_CALL_pppppp();
-  jump RET_LBL(stg_ap_pppppp);
-}
diff --git a/ghc/rts/Storage.c b/ghc/rts/Storage.c
deleted file mode 100644
index 974be45f10..0000000000
--- a/ghc/rts/Storage.c
+++ /dev/null
@@ -1,1137 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Storage manager front end
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "Stats.h"
-#include "Hooks.h"
-#include "BlockAlloc.h"
-#include "MBlock.h"
-#include "Weak.h"
-#include "Sanity.h"
-#include "Arena.h"
-#include "OSThreads.h"
-#include "Capability.h"
-#include "Storage.h"
-#include "Schedule.h"
-#include "RetainerProfile.h"	// for counting memory blocks (memInventory)
-
-#include <stdlib.h>
-#include <string.h>
-
-/* 
- * All these globals require sm_mutex to access in THREADED_RTS mode.
- */
-StgClosure    *caf_list         = NULL;
-StgClosure    *revertible_caf_list = NULL;
-rtsBool       keepCAFs;
-
-bdescr *small_alloc_list;	/* allocate()d small objects */
-bdescr *pinned_object_block;    /* allocate pinned objects into this block */
-nat alloc_blocks;		/* number of allocate()d blocks since GC */
-nat alloc_blocks_lim;		/* approximate limit on alloc_blocks */
-
-StgPtr alloc_Hp    = NULL;	/* next free byte in small_alloc_list */
-StgPtr alloc_HpLim = NULL;	/* end of block at small_alloc_list   */
-
-generation *generations = NULL;	/* all the generations */
-generation *g0		= NULL; /* generation 0, for convenience */
-generation *oldest_gen  = NULL; /* oldest generation, for convenience */
-step *g0s0 		= NULL; /* generation 0, step 0, for convenience */
-
-ullong total_allocated = 0;	/* total memory allocated during run */
-
-nat n_nurseries         = 0;    /* == RtsFlags.ParFlags.nNodes, convenience */
-step *nurseries         = NULL; /* array of nurseries, >1 only if THREADED_RTS */
-
-#ifdef THREADED_RTS
-/*
- * Storage manager mutex:  protects all the above state from
- * simultaneous access by two STG threads.
- */
-Mutex sm_mutex;
-/*
- * This mutex is used by atomicModifyMutVar# only
- */
-Mutex atomic_modify_mutvar_mutex;
-#endif
-
-
-/*
- * Forward references
- */
-static void *stgAllocForGMP   (size_t size_in_bytes);
-static void *stgReallocForGMP (void *ptr, size_t old_size, size_t new_size);
-static void  stgDeallocForGMP (void *ptr, size_t size);
-
-static void
-initStep (step *stp, int g, int s)
-{
-    stp->no = s;
-    stp->blocks = NULL;
-    stp->n_blocks = 0;
-    stp->old_blocks = NULL;
-    stp->n_old_blocks = 0;
-    stp->gen = &generations[g];
-    stp->gen_no = g;
-    stp->hp = NULL;
-    stp->hpLim = NULL;
-    stp->hp_bd = NULL;
-    stp->scavd_hp = NULL;
-    stp->scavd_hpLim = NULL;
-    stp->scan = NULL;
-    stp->scan_bd = NULL;
-    stp->large_objects = NULL;
-    stp->n_large_blocks = 0;
-    stp->new_large_objects = NULL;
-    stp->scavenged_large_objects = NULL;
-    stp->n_scavenged_large_blocks = 0;
-    stp->is_compacted = 0;
-    stp->bitmap = NULL;
-}
-
-void
-initStorage( void )
-{
-  nat g, s;
-  generation *gen;
-
-  if (generations != NULL) {
-      // multi-init protection
-      return;
-  }
-
-  /* Sanity check to make sure the LOOKS_LIKE_ macros appear to be
-   * doing something reasonable.
-   */
-  ASSERT(LOOKS_LIKE_INFO_PTR(&stg_BLACKHOLE_info));
-  ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure));
-  ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure));
-  
-  if (RtsFlags.GcFlags.maxHeapSize != 0 &&
-      RtsFlags.GcFlags.heapSizeSuggestion > 
-      RtsFlags.GcFlags.maxHeapSize) {
-    RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
-  }
-
-  if (RtsFlags.GcFlags.maxHeapSize != 0 &&
-      RtsFlags.GcFlags.minAllocAreaSize > 
-      RtsFlags.GcFlags.maxHeapSize) {
-      errorBelch("maximum heap size (-M) is smaller than minimum alloc area size (-A)");
-      exit(1);
-  }
-
-  initBlockAllocator();
-  
-#if defined(THREADED_RTS)
-  initMutex(&sm_mutex);
-  initMutex(&atomic_modify_mutvar_mutex);
-#endif
-
-  ACQUIRE_SM_LOCK;
-
-  /* allocate generation info array */
-  generations = (generation *)stgMallocBytes(RtsFlags.GcFlags.generations 
-					     * sizeof(struct generation_),
-					     "initStorage: gens");
-
-  /* Initialise all generations */
-  for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
-    gen = &generations[g];
-    gen->no = g;
-    gen->mut_list = allocBlock();
-    gen->collections = 0;
-    gen->failed_promotions = 0;
-    gen->max_blocks = 0;
-  }
-
-  /* A couple of convenience pointers */
-  g0 = &generations[0];
-  oldest_gen = &generations[RtsFlags.GcFlags.generations-1];
-
-  /* Allocate step structures in each generation */
-  if (RtsFlags.GcFlags.generations > 1) {
-    /* Only for multiple-generations */
-
-    /* Oldest generation: one step */
-    oldest_gen->n_steps = 1;
-    oldest_gen->steps = 
-      stgMallocBytes(1 * sizeof(struct step_), "initStorage: last step");
-
-    /* set up all except the oldest generation with 2 steps */
-    for(g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
-      generations[g].n_steps = RtsFlags.GcFlags.steps;
-      generations[g].steps  = 
-	stgMallocBytes (RtsFlags.GcFlags.steps * sizeof(struct step_),
-			"initStorage: steps");
-    }
-    
-  } else {
-    /* single generation, i.e. a two-space collector */
-    g0->n_steps = 1;
-    g0->steps = stgMallocBytes (sizeof(struct step_), "initStorage: steps");
-  }
-
-#ifdef THREADED_RTS
-  n_nurseries = n_capabilities;
-  nurseries = stgMallocBytes (n_nurseries * sizeof(struct step_),
-			      "initStorage: nurseries");
-#else
-  n_nurseries = 1;
-  nurseries = g0->steps; // just share nurseries[0] with g0s0
-#endif  
-
-  /* Initialise all steps */
-  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-    for (s = 0; s < generations[g].n_steps; s++) {
-	initStep(&generations[g].steps[s], g, s);
-    }
-  }
-  
-#ifdef THREADED_RTS
-  for (s = 0; s < n_nurseries; s++) {
-      initStep(&nurseries[s], 0, s);
-  }
-#endif
-  
-  /* Set up the destination pointers in each younger gen. step */
-  for (g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
-    for (s = 0; s < generations[g].n_steps-1; s++) {
-      generations[g].steps[s].to = &generations[g].steps[s+1];
-    }
-    generations[g].steps[s].to = &generations[g+1].steps[0];
-  }
-  oldest_gen->steps[0].to = &oldest_gen->steps[0];
-  
-#ifdef THREADED_RTS
-  for (s = 0; s < n_nurseries; s++) {
-      nurseries[s].to = generations[0].steps[0].to;
-  }
-#endif
-  
-  /* The oldest generation has one step. */
-  if (RtsFlags.GcFlags.compact) {
-      if (RtsFlags.GcFlags.generations == 1) {
-	  errorBelch("WARNING: compaction is incompatible with -G1; disabled");
-      } else {
-	  oldest_gen->steps[0].is_compacted = 1;
-      }
-  }
-
-#ifdef THREADED_RTS
-  if (RtsFlags.GcFlags.generations == 1) {
-      errorBelch("-G1 is incompatible with -threaded");
-      stg_exit(EXIT_FAILURE);
-  }
-#endif
-
-  /* generation 0 is special: that's the nursery */
-  generations[0].max_blocks = 0;
-
-  /* G0S0: the allocation area.  Policy: keep the allocation area
-   * small to begin with, even if we have a large suggested heap
-   * size.  Reason: we're going to do a major collection first, and we
-   * don't want it to be a big one.  This vague idea is borne out by 
-   * rigorous experimental evidence.
-   */
-  g0s0 = &generations[0].steps[0];
-
-  allocNurseries();
-
-  weak_ptr_list = NULL;
-  caf_list = NULL;
-  revertible_caf_list = NULL;
-   
-  /* initialise the allocate() interface */
-  small_alloc_list = NULL;
-  alloc_blocks = 0;
-  alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
-
-  /* Tell GNU multi-precision pkg about our custom alloc functions */
-  mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
-
-  IF_DEBUG(gc, statDescribeGens());
-
-  RELEASE_SM_LOCK;
-}
-
-void
-exitStorage (void)
-{
-    stat_exit(calcAllocated());
-}
-
-void
-freeStorage (void)
-{
-    freeAllMBlocks();
-}
-
-/* -----------------------------------------------------------------------------
-   CAF management.
-
-   The entry code for every CAF does the following:
-     
-      - builds a CAF_BLACKHOLE in the heap
-      - pushes an update frame pointing to the CAF_BLACKHOLE
-      - invokes UPD_CAF(), which:
-          - calls newCaf, below
-	  - updates the CAF with a static indirection to the CAF_BLACKHOLE
-      
-   Why do we build a BLACKHOLE in the heap rather than just updating
-   the thunk directly?  It's so that we only need one kind of update
-   frame - otherwise we'd need a static version of the update frame too.
-
-   newCaf() does the following:
-       
-      - it puts the CAF on the oldest generation's mut-once list.
-        This is so that we can treat the CAF as a root when collecting
-	younger generations.
-
-   For GHCI, we have additional requirements when dealing with CAFs:
-
-      - we must *retain* all dynamically-loaded CAFs ever entered,
-        just in case we need them again.
-      - we must be able to *revert* CAFs that have been evaluated, to
-        their pre-evaluated form.
-
-      To do this, we use an additional CAF list.  When newCaf() is
-      called on a dynamically-loaded CAF, we add it to the CAF list
-      instead of the old-generation mutable list, and save away its
-      old info pointer (in caf->saved_info) for later reversion.
-
-      To revert all the CAFs, we traverse the CAF list and reset the
-      info pointer to caf->saved_info, then throw away the CAF list.
-      (see GC.c:revertCAFs()).
-
-      -- SDM 29/1/01
-
-   -------------------------------------------------------------------------- */
-
-void
-newCAF(StgClosure* caf)
-{
-  ACQUIRE_SM_LOCK;
-
-  if(keepCAFs)
-  {
-    // HACK:
-    // If we are in GHCi _and_ we are using dynamic libraries,
-    // then we can't redirect newCAF calls to newDynCAF (see below),
-    // so we make newCAF behave almost like newDynCAF.
-    // The dynamic libraries might be used by both the interpreted
-    // program and GHCi itself, so they must not be reverted.
-    // This also means that in GHCi with dynamic libraries, CAFs are not
-    // garbage collected. If this turns out to be a problem, we could
-    // do another hack here and do an address range test on caf to figure
-    // out whether it is from a dynamic library.
-    ((StgIndStatic *)caf)->saved_info  = (StgInfoTable *)caf->header.info;
-    ((StgIndStatic *)caf)->static_link = caf_list;
-    caf_list = caf;
-  }
-  else
-  {
-    /* Put this CAF on the mutable list for the old generation.
-    * This is a HACK - the IND_STATIC closure doesn't really have
-    * a mut_link field, but we pretend it has - in fact we re-use
-    * the STATIC_LINK field for the time being, because when we
-    * come to do a major GC we won't need the mut_link field
-    * any more and can use it as a STATIC_LINK.
-    */
-    ((StgIndStatic *)caf)->saved_info = NULL;
-    recordMutableGen(caf, oldest_gen);
-  }
-  
-  RELEASE_SM_LOCK;
-
-#ifdef PAR
-  /* If we are PAR or DIST then  we never forget a CAF */
-  { globalAddr *newGA;
-    //debugBelch("<##> Globalising CAF %08x %s",caf,info_type(caf));
-    newGA=makeGlobal(caf,rtsTrue); /*given full weight*/
-    ASSERT(newGA);
-  } 
-#endif /* PAR */
-}
-
-// An alternate version of newCaf which is used for dynamically loaded
-// object code in GHCi.  In this case we want to retain *all* CAFs in
-// the object code, because they might be demanded at any time from an
-// expression evaluated on the command line.
-// Also, GHCi might want to revert CAFs, so we add these to the
-// revertible_caf_list.
-//
-// The linker hackily arranges that references to newCaf from dynamic
-// code end up pointing to newDynCAF.
-void
-newDynCAF(StgClosure *caf)
-{
-    ACQUIRE_SM_LOCK;
-
-    ((StgIndStatic *)caf)->saved_info  = (StgInfoTable *)caf->header.info;
-    ((StgIndStatic *)caf)->static_link = revertible_caf_list;
-    revertible_caf_list = caf;
-
-    RELEASE_SM_LOCK;
-}
-
-/* -----------------------------------------------------------------------------
-   Nursery management.
-   -------------------------------------------------------------------------- */
-
-static bdescr *
-allocNursery (step *stp, bdescr *tail, nat blocks)
-{
-    bdescr *bd;
-    nat i;
-
-    // Allocate a nursery: we allocate fresh blocks one at a time and
-    // cons them on to the front of the list, not forgetting to update
-    // the back pointer on the tail of the list to point to the new block.
-    for (i=0; i < blocks; i++) {
-	// @LDV profiling
-	/*
-	  processNursery() in LdvProfile.c assumes that every block group in
-	  the nursery contains only a single block. So, if a block group is
-	  given multiple blocks, change processNursery() accordingly.
-	*/
-	bd = allocBlock();
-	bd->link = tail;
-	// double-link the nursery: we might need to insert blocks
-	if (tail != NULL) {
-	    tail->u.back = bd;
-	}
-	bd->step = stp;
-	bd->gen_no = 0;
-	bd->flags = 0;
-	bd->free = bd->start;
-	tail = bd;
-    }
-    tail->u.back = NULL;
-    return tail;
-}
-
-static void
-assignNurseriesToCapabilities (void)
-{
-#ifdef THREADED_RTS
-    nat i;
-
-    for (i = 0; i < n_nurseries; i++) {
-	capabilities[i].r.rNursery        = &nurseries[i];
-	capabilities[i].r.rCurrentNursery = nurseries[i].blocks;
-	capabilities[i].r.rCurrentAlloc   = NULL;
-    }
-#else /* THREADED_RTS */
-    MainCapability.r.rNursery        = &nurseries[0];
-    MainCapability.r.rCurrentNursery = nurseries[0].blocks;
-    MainCapability.r.rCurrentAlloc   = NULL;
-#endif
-}
-
-void
-allocNurseries( void )
-{ 
-    nat i;
-
-    for (i = 0; i < n_nurseries; i++) {
-	nurseries[i].blocks = 
-	    allocNursery(&nurseries[i], NULL, 
-			 RtsFlags.GcFlags.minAllocAreaSize);
-	nurseries[i].n_blocks    = RtsFlags.GcFlags.minAllocAreaSize;
-	nurseries[i].old_blocks   = NULL;
-	nurseries[i].n_old_blocks = 0;
-	/* hp, hpLim, hp_bd, to_space etc. aren't used in the nursery */
-    }
-    assignNurseriesToCapabilities();
-}
-      
-void
-resetNurseries( void )
-{
-    nat i;
-    bdescr *bd;
-    step *stp;
-
-    for (i = 0; i < n_nurseries; i++) {
-	stp = &nurseries[i];
-	for (bd = stp->blocks; bd; bd = bd->link) {
-	    bd->free = bd->start;
-	    ASSERT(bd->gen_no == 0);
-	    ASSERT(bd->step == stp);
-	    IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
-	}
-    }
-    assignNurseriesToCapabilities();
-}
-
-lnat
-countNurseryBlocks (void)
-{
-    nat i;
-    lnat blocks = 0;
-
-    for (i = 0; i < n_nurseries; i++) {
-	blocks += nurseries[i].n_blocks;
-    }
-    return blocks;
-}
-
-static void
-resizeNursery ( step *stp, nat blocks )
-{
-  bdescr *bd;
-  nat nursery_blocks;
-
-  nursery_blocks = stp->n_blocks;
-  if (nursery_blocks == blocks) return;
-
-  if (nursery_blocks < blocks) {
-    IF_DEBUG(gc, debugBelch("Increasing size of nursery to %d blocks\n", 
-			 blocks));
-    stp->blocks = allocNursery(stp, stp->blocks, blocks-nursery_blocks);
-  } 
-  else {
-    bdescr *next_bd;
-    
-    IF_DEBUG(gc, debugBelch("Decreasing size of nursery to %d blocks\n", 
-			 blocks));
-
-    bd = stp->blocks;
-    while (nursery_blocks > blocks) {
-	next_bd = bd->link;
-	next_bd->u.back = NULL;
-	nursery_blocks -= bd->blocks; // might be a large block
-	freeGroup(bd);
-	bd = next_bd;
-    }
-    stp->blocks = bd;
-    // might have gone just under, by freeing a large block, so make
-    // up the difference.
-    if (nursery_blocks < blocks) {
-	stp->blocks = allocNursery(stp, stp->blocks, blocks-nursery_blocks);
-    }
-  }
-  
-  stp->n_blocks = blocks;
-  ASSERT(countBlocks(stp->blocks) == stp->n_blocks);
-}
-
-// 
-// Resize each of the nurseries to the specified size.
-//
-void
-resizeNurseriesFixed (nat blocks)
-{
-    nat i;
-    for (i = 0; i < n_nurseries; i++) {
-	resizeNursery(&nurseries[i], blocks);
-    }
-}
-
-// 
-// Resize the nurseries to the total specified size.
-//
-void
-resizeNurseries (nat blocks)
-{
-    // If there are multiple nurseries, then we just divide the number
-    // of available blocks between them.
-    resizeNurseriesFixed(blocks / n_nurseries);
-}
-
-/* -----------------------------------------------------------------------------
-   The allocate() interface
-
-   allocate(n) always succeeds, and returns a chunk of memory n words
-   long.  n can be larger than the size of a block if necessary, in
-   which case a contiguous block group will be allocated.
-   -------------------------------------------------------------------------- */
-
-StgPtr
-allocate( nat n )
-{
-    bdescr *bd;
-    StgPtr p;
-
-    ACQUIRE_SM_LOCK;
-
-    TICK_ALLOC_HEAP_NOCTR(n);
-    CCS_ALLOC(CCCS,n);
-
-    /* big allocation (>LARGE_OBJECT_THRESHOLD) */
-    /* ToDo: allocate directly into generation 1 */
-    if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
-	nat req_blocks =  (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
-	bd = allocGroup(req_blocks);
-	dbl_link_onto(bd, &g0s0->large_objects);
-	g0s0->n_large_blocks += req_blocks;
-	bd->gen_no  = 0;
-	bd->step = g0s0;
-	bd->flags = BF_LARGE;
-	bd->free = bd->start + n;
-	alloc_blocks += req_blocks;
-	RELEASE_SM_LOCK;
-	return bd->start;
-	
-	/* small allocation (<LARGE_OBJECT_THRESHOLD) */
-    } else if (small_alloc_list == NULL || alloc_Hp + n > alloc_HpLim) {
-	if (small_alloc_list) {
-	    small_alloc_list->free = alloc_Hp;
-	}
-	bd = allocBlock();
-	bd->link = small_alloc_list;
-	small_alloc_list = bd;
-	bd->gen_no = 0;
-	bd->step = g0s0;
-	bd->flags = 0;
-	alloc_Hp = bd->start;
-	alloc_HpLim = bd->start + BLOCK_SIZE_W;
-	alloc_blocks++;
-    }
-    
-    p = alloc_Hp;
-    alloc_Hp += n;
-    RELEASE_SM_LOCK;
-    return p;
-}
-
-lnat
-allocated_bytes( void )
-{
-    lnat allocated;
-
-    allocated = alloc_blocks * BLOCK_SIZE_W - (alloc_HpLim - alloc_Hp);
-    if (pinned_object_block != NULL) {
-	allocated -= (pinned_object_block->start + BLOCK_SIZE_W) - 
-	    pinned_object_block->free;
-    }
-	
-    return allocated;
-}
-
-void
-tidyAllocateLists (void)
-{
-    if (small_alloc_list != NULL) {
-	ASSERT(alloc_Hp >= small_alloc_list->start && 
-	       alloc_Hp <= small_alloc_list->start + BLOCK_SIZE);
-	small_alloc_list->free = alloc_Hp;
-    }
-}
-
-/* -----------------------------------------------------------------------------
-   allocateLocal()
-
-   This allocates memory in the current thread - it is intended for
-   use primarily from STG-land where we have a Capability.  It is
-   better than allocate() because it doesn't require taking the
-   sm_mutex lock in the common case.
-
-   Memory is allocated directly from the nursery if possible (but not
-   from the current nursery block, so as not to interfere with
-   Hp/HpLim).
-   -------------------------------------------------------------------------- */
-
-StgPtr
-allocateLocal (Capability *cap, nat n)
-{
-    bdescr *bd;
-    StgPtr p;
-
-    TICK_ALLOC_HEAP_NOCTR(n);
-    CCS_ALLOC(CCCS,n);
-    
-    /* big allocation (>LARGE_OBJECT_THRESHOLD) */
-    /* ToDo: allocate directly into generation 1 */
-    if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
-	nat req_blocks =  (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
-	ACQUIRE_SM_LOCK;
-	bd = allocGroup(req_blocks);
-	dbl_link_onto(bd, &g0s0->large_objects);
-	g0s0->n_large_blocks += req_blocks;
-	bd->gen_no  = 0;
-	bd->step = g0s0;
-	bd->flags = BF_LARGE;
-	bd->free = bd->start + n;
-	alloc_blocks += req_blocks;
-	RELEASE_SM_LOCK;
-	return bd->start;
-	
-	/* small allocation (<LARGE_OBJECT_THRESHOLD) */
-    } else {
-
-	bd = cap->r.rCurrentAlloc;
-	if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
-
-	    // The CurrentAlloc block is full, we need to find another
-	    // one.  First, we try taking the next block from the
-	    // nursery:
-	    bd = cap->r.rCurrentNursery->link;
-
-	    if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
-		// The nursery is empty, or the next block is already
-		// full: allocate a fresh block (we can't fail here).
-		ACQUIRE_SM_LOCK;
-		bd = allocBlock();
-		cap->r.rNursery->n_blocks++;
-		RELEASE_SM_LOCK;
-		bd->gen_no = 0;
-		bd->step = cap->r.rNursery;
-		bd->flags = 0;
-	    } else {
-		// we have a block in the nursery: take it and put
-		// it at the *front* of the nursery list, and use it
-		// to allocate() from.
-		cap->r.rCurrentNursery->link = bd->link;
-		if (bd->link != NULL) {
-		    bd->link->u.back = cap->r.rCurrentNursery;
-		}
-	    }
-	    dbl_link_onto(bd, &cap->r.rNursery->blocks);
-	    cap->r.rCurrentAlloc = bd;
-	    IF_DEBUG(sanity, checkNurserySanity(cap->r.rNursery));
-	}
-    }
-    p = bd->free;
-    bd->free += n;
-    return p;
-}
-
-/* ---------------------------------------------------------------------------
-   Allocate a fixed/pinned object.
-
-   We allocate small pinned objects into a single block, allocating a
-   new block when the current one overflows.  The block is chained
-   onto the large_object_list of generation 0 step 0.
-
-   NOTE: The GC can't in general handle pinned objects.  This
-   interface is only safe to use for ByteArrays, which have no
-   pointers and don't require scavenging.  It works because the
-   block's descriptor has the BF_LARGE flag set, so the block is
-   treated as a large object and chained onto various lists, rather
-   than the individual objects being copied.  However, when it comes
-   to scavenge the block, the GC will only scavenge the first object.
-   The reason is that the GC can't linearly scan a block of pinned
-   objects at the moment (doing so would require using the
-   mostly-copying techniques).  But since we're restricting ourselves
-   to pinned ByteArrays, not scavenging is ok.
-
-   This function is called by newPinnedByteArray# which immediately
-   fills the allocated memory with a MutableByteArray#.
-   ------------------------------------------------------------------------- */
-
-StgPtr
-allocatePinned( nat n )
-{
-    StgPtr p;
-    bdescr *bd = pinned_object_block;
-
-    // If the request is for a large object, then allocate()
-    // will give us a pinned object anyway.
-    if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
-	return allocate(n);
-    }
-
-    ACQUIRE_SM_LOCK;
-    
-    TICK_ALLOC_HEAP_NOCTR(n);
-    CCS_ALLOC(CCCS,n);
-
-    // we always return 8-byte aligned memory.  bd->free must be
-    // 8-byte aligned to begin with, so we just round up n to
-    // the nearest multiple of 8 bytes.
-    if (sizeof(StgWord) == 4) {
-	n = (n+1) & ~1;
-    }
-
-    // If we don't have a block of pinned objects yet, or the current
-    // one isn't large enough to hold the new object, allocate a new one.
-    if (bd == NULL || (bd->free + n) > (bd->start + BLOCK_SIZE_W)) {
-	pinned_object_block = bd = allocBlock();
-	dbl_link_onto(bd, &g0s0->large_objects);
-	bd->gen_no = 0;
-	bd->step   = g0s0;
-	bd->flags  = BF_PINNED | BF_LARGE;
-	bd->free   = bd->start;
-	alloc_blocks++;
-    }
-
-    p = bd->free;
-    bd->free += n;
-    RELEASE_SM_LOCK;
-    return p;
-}
-
-/* -----------------------------------------------------------------------------
-   This is the write barrier for MUT_VARs, a.k.a. IORefs.  A
-   MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY
-   is.  When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY
-   and is put on the mutable list.
-   -------------------------------------------------------------------------- */
-
-void
-dirty_MUT_VAR(StgRegTable *reg, StgClosure *p)
-{
-    Capability *cap = regTableToCapability(reg);
-    bdescr *bd;
-    if (p->header.info == &stg_MUT_VAR_CLEAN_info) {
-	p->header.info = &stg_MUT_VAR_DIRTY_info;
-	bd = Bdescr((StgPtr)p);
-	if (bd->gen_no > 0) recordMutableCap(p,cap,bd->gen_no);
-    }
-}
-
-/* -----------------------------------------------------------------------------
-   Allocation functions for GMP.
-
-   These all use the allocate() interface - we can't have any garbage
-   collection going on during a gmp operation, so we use allocate()
-   which always succeeds.  The gmp operations which might need to
-   allocate will ask the storage manager (via doYouWantToGC()) whether
-   a garbage collection is required, in case we get into a loop doing
-   only allocate() style allocation.
-   -------------------------------------------------------------------------- */
-
-static void *
-stgAllocForGMP (size_t size_in_bytes)
-{
-  StgArrWords* arr;
-  nat data_size_in_words, total_size_in_words;
-  
-  /* round up to a whole number of words */
-  data_size_in_words  = (size_in_bytes + sizeof(W_) + 1) / sizeof(W_);
-  total_size_in_words = sizeofW(StgArrWords) + data_size_in_words;
-  
-  /* allocate and fill it in. */
-#if defined(THREADED_RTS)
-  arr = (StgArrWords *)allocateLocal(myTask()->cap, total_size_in_words);
-#else
-  arr = (StgArrWords *)allocateLocal(&MainCapability, total_size_in_words);
-#endif
-  SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words);
-  
-  /* and return a ptr to the goods inside the array */
-  return arr->payload;
-}
-
-static void *
-stgReallocForGMP (void *ptr, size_t old_size, size_t new_size)
-{
-    void *new_stuff_ptr = stgAllocForGMP(new_size);
-    nat i = 0;
-    char *p = (char *) ptr;
-    char *q = (char *) new_stuff_ptr;
-
-    for (; i < old_size; i++, p++, q++) {
-	*q = *p;
-    }
-
-    return(new_stuff_ptr);
-}
-
-static void
-stgDeallocForGMP (void *ptr STG_UNUSED, 
-		  size_t size STG_UNUSED)
-{
-    /* easy for us: the garbage collector does the dealloc'n */
-}
-
-/* -----------------------------------------------------------------------------
- * Stats and stuff
- * -------------------------------------------------------------------------- */
-
-/* -----------------------------------------------------------------------------
- * calcAllocated()
- *
- * Approximate how much we've allocated: number of blocks in the
- * nursery + blocks allocated via allocate() - unused nusery blocks.
- * This leaves a little slop at the end of each block, and doesn't
- * take into account large objects (ToDo).
- * -------------------------------------------------------------------------- */
-
-lnat
-calcAllocated( void )
-{
-  nat allocated;
-  bdescr *bd;
-
-  allocated = allocated_bytes();
-  allocated += countNurseryBlocks() * BLOCK_SIZE_W;
-  
-  {
-#ifdef THREADED_RTS
-  nat i;
-  for (i = 0; i < n_nurseries; i++) {
-      Capability *cap;
-      for ( bd = capabilities[i].r.rCurrentNursery->link; 
-	    bd != NULL; bd = bd->link ) {
-	  allocated -= BLOCK_SIZE_W;
-      }
-      cap = &capabilities[i];
-      if (cap->r.rCurrentNursery->free < 
-	  cap->r.rCurrentNursery->start + BLOCK_SIZE_W) {
-	  allocated -= (cap->r.rCurrentNursery->start + BLOCK_SIZE_W)
-	      - cap->r.rCurrentNursery->free;
-      }
-  }
-#else
-  bdescr *current_nursery = MainCapability.r.rCurrentNursery;
-
-  for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
-      allocated -= BLOCK_SIZE_W;
-  }
-  if (current_nursery->free < current_nursery->start + BLOCK_SIZE_W) {
-      allocated -= (current_nursery->start + BLOCK_SIZE_W)
-	  - current_nursery->free;
-  }
-#endif
-  }
-
-  total_allocated += allocated;
-  return allocated;
-}  
-
-/* Approximate the amount of live data in the heap.  To be called just
- * after garbage collection (see GarbageCollect()).
- */
-extern lnat 
-calcLive(void)
-{
-  nat g, s;
-  lnat live = 0;
-  step *stp;
-
-  if (RtsFlags.GcFlags.generations == 1) {
-    live = (g0s0->n_blocks - 1) * BLOCK_SIZE_W + 
-      ((lnat)g0s0->hp_bd->free - (lnat)g0s0->hp_bd->start) / sizeof(W_);
-    return live;
-  }
-
-  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-    for (s = 0; s < generations[g].n_steps; s++) {
-      /* approximate amount of live data (doesn't take into account slop
-       * at end of each block).
-       */
-      if (g == 0 && s == 0) { 
-	  continue; 
-      }
-      stp = &generations[g].steps[s];
-      live += (stp->n_large_blocks + stp->n_blocks - 1) * BLOCK_SIZE_W;
-      if (stp->hp_bd != NULL) {
-	  live += ((lnat)stp->hp_bd->free - (lnat)stp->hp_bd->start) 
-	      / sizeof(W_);
-      }
-      if (stp->scavd_hp != NULL) {
-	  live -= (P_)(BLOCK_ROUND_UP(stp->scavd_hp)) - stp->scavd_hp;
-      }
-    }
-  }
-  return live;
-}
-
-/* Approximate the number of blocks that will be needed at the next
- * garbage collection.
- *
- * Assume: all data currently live will remain live.  Steps that will
- * be collected next time will therefore need twice as many blocks
- * since all the data will be copied.
- */
-extern lnat 
-calcNeeded(void)
-{
-    lnat needed = 0;
-    nat g, s;
-    step *stp;
-    
-    for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	for (s = 0; s < generations[g].n_steps; s++) {
-	    if (g == 0 && s == 0) { continue; }
-	    stp = &generations[g].steps[s];
-	    if (generations[g].steps[0].n_blocks +
-		generations[g].steps[0].n_large_blocks 
-		> generations[g].max_blocks
-		&& stp->is_compacted == 0) {
-		needed += 2 * stp->n_blocks;
-	    } else {
-		needed += stp->n_blocks;
-	    }
-	}
-    }
-    return needed;
-}
-
-/* -----------------------------------------------------------------------------
-   Debugging
-
-   memInventory() checks for memory leaks by counting up all the
-   blocks we know about and comparing that to the number of blocks
-   allegedly floating around in the system.
-   -------------------------------------------------------------------------- */
-
-#ifdef DEBUG
-
-static lnat
-stepBlocks (step *stp)
-{
-    lnat total_blocks;
-    bdescr *bd;
-
-    total_blocks = stp->n_blocks;    
-    total_blocks += stp->n_old_blocks;
-    for (bd = stp->large_objects; bd; bd = bd->link) {
-	total_blocks += bd->blocks;
-	/* hack for megablock groups: they have an extra block or two in
-	   the second and subsequent megablocks where the block
-	   descriptors would normally go.
-	*/
-	if (bd->blocks > BLOCKS_PER_MBLOCK) {
-	    total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK)
-		* (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE));
-	}
-    }
-    return total_blocks;
-}
-
-void
-memInventory(void)
-{
-  nat g, s, i;
-  step *stp;
-  bdescr *bd;
-  lnat total_blocks = 0, free_blocks = 0;
-
-  /* count the blocks we current have */
-
-  for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-      for (i = 0; i < n_capabilities; i++) {
-	  for (bd = capabilities[i].mut_lists[g]; bd != NULL; bd = bd->link) {
-	      total_blocks += bd->blocks;
-	  }
-      }	  
-      for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
-	  total_blocks += bd->blocks;
-      }
-      for (s = 0; s < generations[g].n_steps; s++) {
-	  if (g==0 && s==0) continue;
-	  stp = &generations[g].steps[s];
-	  total_blocks += stepBlocks(stp);
-      }
-  }
-
-  for (i = 0; i < n_nurseries; i++) {
-      total_blocks += stepBlocks(&nurseries[i]);
-  }
-#ifdef THREADED_RTS
-  // We put pinned object blocks in g0s0, so better count blocks there too.
-  total_blocks += stepBlocks(g0s0);
-#endif
-
-  /* any blocks held by allocate() */
-  for (bd = small_alloc_list; bd; bd = bd->link) {
-    total_blocks += bd->blocks;
-  }
-
-#ifdef PROFILING
-  if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER) {
-      total_blocks += retainerStackBlocks();
-  }
-#endif
-
-  // count the blocks allocated by the arena allocator
-  total_blocks += arenaBlocks();
-
-  /* count the blocks on the free list */
-  free_blocks = countFreeList();
-
-  if (total_blocks + free_blocks != mblocks_allocated *
-      BLOCKS_PER_MBLOCK) {
-    debugBelch("Blocks: %ld live + %ld free  = %ld total (%ld around)\n",
-	    total_blocks, free_blocks, total_blocks + free_blocks,
-	    mblocks_allocated * BLOCKS_PER_MBLOCK);
-  }
-
-  ASSERT(total_blocks + free_blocks == mblocks_allocated * BLOCKS_PER_MBLOCK);
-}
-
-
-nat
-countBlocks(bdescr *bd)
-{
-    nat n;
-    for (n=0; bd != NULL; bd=bd->link) {
-	n += bd->blocks;
-    }
-    return n;
-}
-
-/* Full heap sanity check. */
-void
-checkSanity( void )
-{
-    nat g, s;
-
-    if (RtsFlags.GcFlags.generations == 1) {
-	checkHeap(g0s0->blocks);
-	checkChain(g0s0->large_objects);
-    } else {
-	
-	for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
-	    for (s = 0; s < generations[g].n_steps; s++) {
-		if (g == 0 && s == 0) { continue; }
-		ASSERT(countBlocks(generations[g].steps[s].blocks)
-		       == generations[g].steps[s].n_blocks);
-		ASSERT(countBlocks(generations[g].steps[s].large_objects)
-		       == generations[g].steps[s].n_large_blocks);
-		checkHeap(generations[g].steps[s].blocks);
-		checkChain(generations[g].steps[s].large_objects);
-		if (g > 0) {
-		    checkMutableList(generations[g].mut_list, g);
-		}
-	    }
-	}
-
-	for (s = 0; s < n_nurseries; s++) {
-	    ASSERT(countBlocks(nurseries[s].blocks)
-		   == nurseries[s].n_blocks);
-	    ASSERT(countBlocks(nurseries[s].large_objects)
-		   == nurseries[s].n_large_blocks);
-	}
-	    
-	checkFreeListSanity();
-    }
-}
-
-/* Nursery sanity check */
-void
-checkNurserySanity( step *stp )
-{
-    bdescr *bd, *prev;
-    nat blocks = 0;
-
-    prev = NULL;
-    for (bd = stp->blocks; bd != NULL; bd = bd->link) {
-	ASSERT(bd->u.back == prev);
-	prev = bd;
-	blocks += bd->blocks;
-    }
-    ASSERT(blocks == stp->n_blocks);
-}
-
-// handy function for use in gdb, because Bdescr() is inlined.
-extern bdescr *_bdescr( StgPtr p );
-
-bdescr *
-_bdescr( StgPtr p )
-{
-    return Bdescr(p);
-}
-
-#endif
diff --git a/ghc/rts/Task.c b/ghc/rts/Task.c
deleted file mode 100644
index 7366480094..0000000000
--- a/ghc/rts/Task.c
+++ /dev/null
@@ -1,315 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 2001-2005
- *
- * The task manager subsystem.  Tasks execute STG code, with this
- * module providing the API which the Scheduler uses to control their
- * creation and destruction.
- * 
- * -------------------------------------------------------------------------*/
-
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "OSThreads.h"
-#include "Task.h"
-#include "Capability.h"
-#include "Stats.h"
-#include "RtsFlags.h"
-#include "Schedule.h"
-#include "Hash.h"
-
-#if HAVE_SIGNAL_H
-#include <signal.h>
-#endif
-
-// Task lists and global counters.
-// Locks required: sched_mutex.
-Task *all_tasks = NULL;
-static Task *task_free_list = NULL; // singly-linked
-static nat taskCount;
-#define DEFAULT_MAX_WORKERS 64
-static nat maxWorkers; // we won't create more workers than this
-static nat tasksRunning;
-static nat workerCount;
-
-/* -----------------------------------------------------------------------------
- * Remembering the current thread's Task
- * -------------------------------------------------------------------------- */
-
-// A thread-local-storage key that we can use to get access to the
-// current thread's Task structure.
-#if defined(THREADED_RTS)
-ThreadLocalKey currentTaskKey;
-#else
-Task *my_task;
-#endif
-
-/* -----------------------------------------------------------------------------
- * Rest of the Task API
- * -------------------------------------------------------------------------- */
-
-void
-initTaskManager (void)
-{
-    static int initialized = 0;
-
-    if (!initialized) {
-	taskCount = 0;
-	workerCount = 0;
-	tasksRunning = 0;
-	maxWorkers = DEFAULT_MAX_WORKERS;
-	initialized = 1;
-#if defined(THREADED_RTS)
-	newThreadLocalKey(&currentTaskKey);
-#endif
-    }
-}
-
-
-void
-stopTaskManager (void)
-{
-    IF_DEBUG(scheduler, sched_belch("stopping task manager, %d tasks still running", tasksRunning));
-}
-
-
-static Task*
-newTask (void)
-{
-#if defined(THREADED_RTS)
-    Ticks currentElapsedTime, currentUserTime;
-#endif
-    Task *task;
-
-    task = stgMallocBytes(sizeof(Task), "newTask");
-    
-    task->cap  = NULL;
-    task->stopped = rtsFalse;
-    task->suspended_tso = NULL;
-    task->tso  = NULL;
-    task->stat = NoStatus;
-    task->ret  = NULL;
-    
-#if defined(THREADED_RTS)
-    initCondition(&task->cond);
-    initMutex(&task->lock);
-    task->wakeup = rtsFalse;
-#endif
-
-#if defined(THREADED_RTS)
-    currentUserTime = getThreadCPUTime();
-    currentElapsedTime = getProcessElapsedTime();
-    task->mut_time = 0.0;
-    task->mut_etime = 0.0;
-    task->gc_time = 0.0;
-    task->gc_etime = 0.0;
-    task->muttimestart = currentUserTime;
-    task->elapsedtimestart = currentElapsedTime;
-#endif
-
-    task->prev = NULL;
-    task->next = NULL;
-    task->return_link = NULL;
-
-    task->all_link = all_tasks;
-    all_tasks = task;
-
-    taskCount++;
-    workerCount++;
-
-    return task;
-}
-
-Task *
-newBoundTask (void)
-{
-    Task *task;
-
-    ASSERT_LOCK_HELD(&sched_mutex);
-    if (task_free_list == NULL) {
-	task = newTask();
-    } else {
-	task = task_free_list;
-	task_free_list = task->next;
-	task->next = NULL;
-	task->prev = NULL;
-	task->stopped = rtsFalse;
-    }
-#if defined(THREADED_RTS)
-    task->id = osThreadId();
-#endif
-    ASSERT(task->cap == NULL);
-
-    tasksRunning++;
-
-    taskEnter(task);
-
-    IF_DEBUG(scheduler,sched_belch("new task (taskCount: %d)", taskCount););
-    return task;
-}
-
-void
-boundTaskExiting (Task *task)
-{
-    task->stopped = rtsTrue;
-    task->cap = NULL;
-
-#if defined(THREADED_RTS)
-    ASSERT(osThreadId() == task->id);
-#endif
-    ASSERT(myTask() == task);
-    setMyTask(task->prev_stack);
-
-    tasksRunning--;
-
-    // sadly, we need a lock around the free task list. Todo: eliminate.
-    ACQUIRE_LOCK(&sched_mutex);
-    task->next = task_free_list;
-    task_free_list = task;
-    RELEASE_LOCK(&sched_mutex);
-
-    IF_DEBUG(scheduler,sched_belch("task exiting"));
-}
-
-#ifdef THREADED_RTS
-#define TASK_ID(t) (t)->id
-#else
-#define TASK_ID(t) (t)
-#endif
-
-void
-discardTask (Task *task)
-{
-    ASSERT_LOCK_HELD(&sched_mutex);
-    if (!task->stopped) {
-	IF_DEBUG(scheduler,sched_belch("discarding task %p", TASK_ID(task)));
-	task->cap = NULL;
-	task->tso = NULL;
-	task->stopped = rtsTrue;
-	tasksRunning--;
-	task->next = task_free_list;
-	task_free_list = task;
-    }
-}
-
-void
-taskStop (Task *task)
-{
-#if defined(THREADED_RTS)
-    OSThreadId id;
-    Ticks currentElapsedTime, currentUserTime, elapsedGCTime;
-
-    id = osThreadId();
-    ASSERT(task->id == id);
-    ASSERT(myTask() == task);
-
-    currentUserTime = getThreadCPUTime();
-    currentElapsedTime = getProcessElapsedTime();
-
-    // XXX this is wrong; we want elapsed GC time since the
-    // Task started.
-    elapsedGCTime = stat_getElapsedGCTime();
-    
-    task->mut_time = 
-	currentUserTime - task->muttimestart - task->gc_time;
-    task->mut_etime = 
-	currentElapsedTime - task->elapsedtimestart - elapsedGCTime;
-
-    if (task->mut_time < 0.0)  { task->mut_time = 0.0;  }
-    if (task->mut_etime < 0.0) { task->mut_etime = 0.0; }
-#endif
-
-    task->stopped = rtsTrue;
-    tasksRunning--;
-}
-
-void
-resetTaskManagerAfterFork (void)
-{
-#warning TODO!
-    taskCount = 0;
-}
-
-#if defined(THREADED_RTS)
-
-void
-startWorkerTask (Capability *cap, 
-		 void OSThreadProcAttr (*taskStart)(Task *task))
-{
-  int r;
-  OSThreadId tid;
-  Task *task;
-
-  if (workerCount >= maxWorkers) {
-      barf("too many workers; runaway worker creation?");
-  }
-  workerCount++;
-
-  // A worker always gets a fresh Task structure.
-  task = newTask();
-
-  tasksRunning++;
-
-  // The lock here is to synchronise with taskStart(), to make sure
-  // that we have finished setting up the Task structure before the
-  // worker thread reads it.
-  ACQUIRE_LOCK(&task->lock);
-
-  task->cap = cap;
-
-  // Give the capability directly to the worker; we can't let anyone
-  // else get in, because the new worker Task has nowhere to go to
-  // sleep so that it could be woken up again.
-  ASSERT_LOCK_HELD(&cap->lock);
-  cap->running_task = task;
-
-  r = createOSThread(&tid, (OSThreadProc *)taskStart, task);
-  if (r != 0) {
-    barf("startTask: Can't create new task");
-  }
-
-  IF_DEBUG(scheduler,sched_belch("new worker task (taskCount: %d)", taskCount););
-
-  task->id = tid;
-
-  // ok, finished with the Task struct.
-  RELEASE_LOCK(&task->lock);
-}
-
-#endif /* THREADED_RTS */
-
-#ifdef DEBUG
-
-static void *taskId(Task *task)
-{
-#ifdef THREADED_RTS
-    return (void *)task->id;
-#else
-    return (void *)task;
-#endif
-}
-
-void printAllTasks(void);
-
-void
-printAllTasks(void)
-{
-    Task *task;
-    for (task = all_tasks; task != NULL; task = task->all_link) {
-	debugBelch("task %p is %s, ", taskId(task), task->stopped ? "stopped" : "alive");
-	if (!task->stopped) {
-	    if (task->cap) {
-		debugBelch("on capability %d, ", task->cap->no);
-	    }
-	    if (task->tso) {
-		debugBelch("bound to thread %d", task->tso->id);
-	    } else {
-		debugBelch("worker");
-	    }
-	}
-	debugBelch("\n");
-    }
-}		       
-
-#endif
-
diff --git a/ghc/rts/Task.h b/ghc/rts/Task.h
deleted file mode 100644
index ca71d2809a..0000000000
--- a/ghc/rts/Task.h
+++ /dev/null
@@ -1,271 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 2001-2005
- *
- * Tasks
- *
- * -------------------------------------------------------------------------*/
-
-#ifndef TASK_H
-#define TASK_H
-
-#include "GetTime.h"
-
-/* 
-   Definition of a Task
-   --------------------
- 
-   A task is an OSThread that runs Haskell code.  Every OSThread
-   created by the RTS for the purposes of running Haskell code is a
-   Task, and OS threads that enter the Haskell RTS for the purposes of
-   making a call-in are also Tasks.
-   
-   The relationship between the number of tasks and capabilities, and
-   the runtime build (-threaded, -smp etc.) is summarised by the
-   following table:
-
-     build        Tasks   Capabilities
-     ---------------------------------
-     normal         1          1
-     -threaded      N          N
-
-   The non-threaded build has a single Task and a single global
-   Capability.
-   
-   The THREADED_RTS build allows multiple tasks and mulitple Capabilities.
-   Multiple Tasks may all be running Haskell code simultaneously. A task
-   relinquishes its Capability when it is asked to evaluate an external
-   (C) call.
-
-   In general, there may be multiple Tasks for an OS thread.  This
-   happens if one Task makes a foreign call from Haskell, and
-   subsequently calls back in to create a new bound thread.
-
-   A particular Task structure can belong to more than one OS thread
-   over its lifetime.  This is to avoid creating an unbounded number
-   of Task structures.  The stats just accumulate.
-
-   Ownership of Task
-   -----------------
-
-   The OS thread named in the Task structure has exclusive access to
-   the structure, as long as it is the running_task of its Capability.
-   That is, if (task->cap->running_task == task), then task->id owns
-   the Task.  Otherwise the Task is owned by the owner of the parent
-   data structure on which it is sleeping; for example, if the task is
-   sleeping on spare_workers field of a Capability, then the owner of the
-   Capability has access to the Task.
-
-   When a task is migrated from sleeping on one Capability to another,
-   its task->cap field must be modified.  When the task wakes up, it
-   will read the new value of task->cap to find out which Capability
-   it belongs to.  Hence some synchronisation is required on
-   task->cap, and this is why we have task->lock.
-
-   If the Task is not currently owned by task->id, then the thread is
-   either
-
-      (a) waiting on the condition task->cond.  The Task is either
-         (1) a bound Task, the TSO will be on a queue somewhere
-	 (2) a worker task, on the spare_workers queue of task->cap.
-
-     (b) making a foreign call.  The Task will be on the
-         suspended_ccalling_tasks list.
-
-   We re-establish ownership in each case by respectively
-
-      (a) the task is currently blocked in yieldCapability().
-          This call will return when we have ownership of the Task and
-          a Capability.  The Capability we get might not be the same
-	  as the one we had when we called yieldCapability().
-          
-      (b) we must call resumeThread(task), which will safely establish
-          ownership of the Task and a Capability.
-*/
-
-typedef struct Task_ {
-#if defined(THREADED_RTS)
-    OSThreadId id;		// The OS Thread ID of this task
-#endif
-
-    // This points to the Capability that the Task "belongs" to.  If
-    // the Task owns a Capability, then task->cap points to it.  If
-    // the task does not own a Capability, then either (a) if the task
-    // is a worker, then task->cap points to the Capability it belongs
-    // to, or (b) it is returning from a foreign call, then task->cap
-    // points to the Capability with the returning_worker queue that this
-    // this Task is on.
-    //
-    // When a task goes to sleep, it may be migrated to a different
-    // Capability.  Hence, we always check task->cap on wakeup.  To
-    // syncrhonise between the migrater and the migratee, task->lock
-    // must be held when modifying task->cap.
-    struct Capability_ *cap;
-
-    rtsBool    stopped;         // this task has stopped or exited Haskell
-    StgTSO *   suspended_tso;   // the TSO is stashed here when we
-				// make a foreign call (NULL otherwise);
-
-    // The following 3 fields are used by bound threads:
-    StgTSO *   tso;             // the bound TSO (or NULL)
-    SchedulerStatus  stat;      // return status
-    StgClosure **    ret;       // return value
-
-#if defined(THREADED_RTS)
-    Condition cond;             // used for sleeping & waking up this task
-    Mutex lock;			// lock for the condition variable
-
-    // this flag tells the task whether it should wait on task->cond
-    // or just continue immediately.  It's a workaround for the fact
-    // that signalling a condition variable doesn't do anything if the
-    // thread is already running, but we want it to be sticky.
-    rtsBool wakeup;
-#endif
-
-    // Stats that we collect about this task
-    // ToDo: we probably want to put this in a separate TaskStats
-    // structure, so we can share it between multiple Tasks.  We don't
-    // really want separate stats for each call in a nested chain of
-    // foreign->haskell->foreign->haskell calls, but we'll get a
-    // separate Task for each of the haskell calls.
-    Ticks       elapsedtimestart;
-    Ticks       muttimestart;
-    Ticks       mut_time;
-    Ticks       mut_etime;
-    Ticks       gc_time;
-    Ticks       gc_etime;
-
-    // Links tasks onto various lists. (ToDo: do we need double
-    // linking now?)
-    struct Task_ *prev;
-    struct Task_ *next;
-
-    // Links tasks on the returning_tasks queue of a Capability.
-    struct Task_ *return_link;
-
-    // Links tasks on the all_tasks list
-    struct Task_ *all_link;
-
-    // When a Haskell thread makes a foreign call that re-enters
-    // Haskell, we end up with another Task associated with the
-    // current thread.  We have to remember the whole stack of Tasks
-    // associated with the current thread so that we can correctly
-    // save & restore the thread-local current task pointer.
-    struct Task_ *prev_stack;
-} Task;
-
-INLINE_HEADER rtsBool
-isBoundTask (Task *task) 
-{
-    return (task->tso != NULL);
-}
-
-
-// Linked list of all tasks.
-//
-extern Task *all_tasks;
-
-// Start and stop the task manager.
-// Requires: sched_mutex.
-//
-void initTaskManager (void);
-void stopTaskManager (void);
-
-// Create a new Task for a bound thread
-// Requires: sched_mutex.
-//
-Task *newBoundTask (void);
-
-// The current task is a bound task that is exiting.
-// Requires: sched_mutex.
-//
-void boundTaskExiting (Task *task);
-
-// This must be called when a new Task is associated with the current
-// thread.  It sets up the thread-local current task pointer so that
-// myTask() can work.
-INLINE_HEADER void taskEnter (Task *task);
-
-// Notify the task manager that a task has stopped.  This is used
-// mainly for stats-gathering purposes.
-// Requires: sched_mutex.
-//
-void taskStop (Task *task);
-
-// Put the task back on the free list, mark it stopped.  Used by
-// forkProcess().
-//
-void discardTask (Task *task);
-
-// Get the Task associated with the current OS thread (or NULL if none).
-//
-INLINE_HEADER Task *myTask (void);
-
-// After a fork, the tasks are not carried into the child process, so
-// we must tell the task manager.
-// Requires: sched_mutex.
-//
-void resetTaskManagerAfterFork (void);
-
-#if defined(THREADED_RTS)
-
-// Workers are attached to the supplied Capability.  This Capability
-// should not currently have a running_task, because the new task
-// will become the running_task for that Capability.
-// Requires: sched_mutex.
-//
-void startWorkerTask  (struct Capability_ *cap, 
-		       void OSThreadProcAttr (*taskStart)(Task *task));
-
-#endif /* THREADED_RTS */
-
-// -----------------------------------------------------------------------------
-// INLINE functions... private from here on down:
-
-// A thread-local-storage key that we can use to get access to the
-// current thread's Task structure.
-#if defined(THREADED_RTS)
-extern ThreadLocalKey currentTaskKey;
-#else
-extern Task *my_task;
-#endif
-
-//
-// myTask() uses thread-local storage to find the Task associated with
-// the current OS thread.  If the current OS thread has multiple
-// Tasks, because it has re-entered the RTS, then the task->prev_stack
-// field is used to store the previous Task.
-//
-INLINE_HEADER Task *
-myTask (void)
-{
-#if defined(THREADED_RTS)
-    return getThreadLocalVar(&currentTaskKey);
-#else
-    return my_task;
-#endif
-}
-
-INLINE_HEADER void
-setMyTask (Task *task)
-{
-#if defined(THREADED_RTS)
-    setThreadLocalVar(&currentTaskKey,task);
-#else
-    my_task = task;
-#endif
-}
-
-// This must be called when a new Task is associated with the current
-// thread.  It sets up the thread-local current task pointer so that
-// myTask() can work.
-INLINE_HEADER void
-taskEnter (Task *task)
-{
-    // save the current value, just in case this Task has been created
-    // as a result of re-entering the RTS (defaults to NULL):
-    task->prev_stack = myTask();
-    setMyTask(task);
-}
-
-#endif /* TASK_H */
diff --git a/ghc/rts/ThreadLabels.c b/ghc/rts/ThreadLabels.c
deleted file mode 100644
index 9b9f1723ff..0000000000
--- a/ghc/rts/ThreadLabels.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/* -----------------------------------------------------------------------------
- * ThreadLabels.c
- *
- * (c) The GHC Team 2002-2003
- *
- * Table of thread labels.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "ThreadLabels.h"
-#include "RtsUtils.h"
-
-#include <stdlib.h>
-
-#if defined(DEBUG)
-/* to the end */
-static HashTable * threadLabels = NULL;
-
-void
-initThreadLabelTable(void)
-{
-  if (threadLabels == NULL) {
-    threadLabels = allocHashTable();
-  }
-}
-
-void
-updateThreadLabel(StgWord key, void *data)
-{
-  removeThreadLabel(key);
-  insertHashTable(threadLabels,key,data);
-}
-
-void *
-lookupThreadLabel(StgWord key)
-{
-  return lookupHashTable(threadLabels,key);
-}
-
-void
-removeThreadLabel(StgWord key)
-{
-  void * old = NULL;
-  if ((old = lookupHashTable(threadLabels,key))) {
-    removeHashTable(threadLabels,key,old);
-    stgFree(old);
-  }  
-}
-#endif /* DEBUG */
diff --git a/ghc/rts/ThreadLabels.h b/ghc/rts/ThreadLabels.h
deleted file mode 100644
index 97d3d0d241..0000000000
--- a/ghc/rts/ThreadLabels.h
+++ /dev/null
@@ -1,27 +0,0 @@
-/* -----------------------------------------------------------------------------
- * ThreadLabels.h
- *
- * (c) The GHC Team 2002-2003
- *
- * Table of thread labels.
- *
- * ---------------------------------------------------------------------------*/
-#ifndef __THREADLABELS_H__
-#define __THREADLABELS_H__
-
-#include "Rts.h"
-#include "Hash.h"
-
-void
-initThreadLabelTable(void);
-
-void
-updateThreadLabel(StgWord key, void *data);
-
-void *
-lookupThreadLabel(StgWord key);
-
-void
-removeThreadLabel(StgWord key);
-
-#endif /* __THREADLABELS_H__ */
diff --git a/ghc/rts/Ticker.h b/ghc/rts/Ticker.h
deleted file mode 100644
index f9555768b5..0000000000
--- a/ghc/rts/Ticker.h
+++ /dev/null
@@ -1,15 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 2005
- *
- * Ticker interface (implementation is OS-specific)
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef TICKER_H
-#define TICKER_H
-
-extern int  startTicker( nat ms, TickProc handle_tick );
-extern int  stopTicker ( void );
-
-#endif /* TICKER_H */
diff --git a/ghc/rts/Ticky.c b/ghc/rts/Ticky.c
deleted file mode 100644
index 294e12bdda..0000000000
--- a/ghc/rts/Ticky.c
+++ /dev/null
@@ -1,628 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The AQUA project, Glasgow University, 1992-1997
- * (c) The GHC Team, 1998-1999
- *
- * Ticky-ticky profiling
- *-------------------------------------------------------------------------- */
-
-#if defined(TICKY_TICKY)
-
-#define TICKY_C			/* define those variables */
-#include "PosixSource.h"
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "Ticky.h"
-
-/* -----------------------------------------------------------------------------
-   Print out all the counters
-   -------------------------------------------------------------------------- */
-
-static void printRegisteredCounterInfo (FILE *); /* fwd decl */
-
-#define INTAVG(a,b) ((b == 0) ? 0.0 : ((double) (a) / (double) (b)))
-#define PC(a)	    (100.0 * a)
-
-#define AVG(thing) \
-	StgDouble avg##thing  = INTAVG(tot##thing,ctr##thing)
-
-void
-PrintTickyInfo(void)
-{
-  unsigned long i;
-  unsigned long tot_allocs = /* total number of things allocated */
-	ALLOC_FUN_ctr + ALLOC_SE_THK_ctr + ALLOC_UP_THK_ctr + ALLOC_CON_ctr + ALLOC_TUP_ctr +
-    	+ ALLOC_TSO_ctr + ALLOC_BH_ctr  + ALLOC_PAP_ctr + ALLOC_PRIM_ctr
-#ifdef PAR
-	+ ALLOC_FMBQ_ctr + ALLOC_FME_ctr + ALLOC_BF_ctr
-#endif
-      ;	
-
-  unsigned long tot_adm_wds = /* total number of admin words allocated */
-	ALLOC_FUN_adm + ALLOC_THK_adm + ALLOC_CON_adm + ALLOC_TUP_adm
-    	+ ALLOC_TSO_adm + ALLOC_BH_adm  + ALLOC_PAP_adm + ALLOC_PRIM_adm
-#ifdef PAR
-	+ ALLOC_FMBQ_adm + ALLOC_FME_adm + ALLOC_BF_adm
-#endif
-      ;
-
-  unsigned long tot_gds_wds = /* total number of words of ``good stuff'' allocated */
-	ALLOC_FUN_gds + ALLOC_THK_gds + ALLOC_CON_gds + ALLOC_TUP_gds
-    	+ ALLOC_TSO_gds + ALLOC_BH_gds  + ALLOC_PAP_gds + ALLOC_PRIM_gds
-#ifdef PAR
-	+ ALLOC_FMBQ_gds + ALLOC_FME_gds + ALLOC_BF_gds
-#endif
-      ;
-
-  unsigned long tot_slp_wds = /* total number of ``slop'' words allocated */
-	ALLOC_FUN_slp + ALLOC_THK_slp + ALLOC_CON_slp + ALLOC_TUP_slp
-    	+ ALLOC_TSO_slp + ALLOC_BH_slp  + ALLOC_PAP_slp + ALLOC_PRIM_slp
-#ifdef PAR
-	+ ALLOC_FMBQ_slp + ALLOC_FME_slp + ALLOC_BF_slp
-#endif
-      ;
-
-  unsigned long tot_wds = /* total words */
-	tot_adm_wds + tot_gds_wds + tot_slp_wds;
-
-  unsigned long tot_thk_enters = ENT_STATIC_THK_ctr + ENT_DYN_THK_ctr;
-  unsigned long tot_con_enters = ENT_STATIC_CON_ctr + ENT_DYN_CON_ctr;
-  unsigned long tot_fun_direct_enters = ENT_STATIC_FUN_DIRECT_ctr + ENT_DYN_FUN_DIRECT_ctr;
-  unsigned long tot_ind_enters = ENT_STATIC_IND_ctr + ENT_DYN_IND_ctr;
-  
-  // This is the number of times we entered a function via some kind
-  // of slow call.  It amounts to all the slow applications, not
-  // counting those that were to too few arguments.
-  unsigned long tot_fun_slow_enters = 
-      SLOW_CALL_ctr - 
-      SLOW_CALL_FUN_TOO_FEW_ctr -
-      SLOW_CALL_PAP_TOO_FEW_ctr;
-
-  unsigned long tot_known_calls =
-      KNOWN_CALL_ctr + KNOWN_CALL_TOO_FEW_ARGS_ctr + 
-      + KNOWN_CALL_EXTRA_ARGS_ctr;
-  unsigned long tot_tail_calls =
-      UNKNOWN_CALL_ctr + tot_known_calls;
-
-  unsigned long tot_enters =
-	tot_con_enters + tot_fun_direct_enters +
-	tot_ind_enters + ENT_PERM_IND_ctr + ENT_PAP_ctr + tot_thk_enters;
-  unsigned long jump_direct_enters =
-	tot_enters - ENT_VIA_NODE_ctr;
-
-  unsigned long tot_returns =
-      RET_NEW_ctr + RET_OLD_ctr + RET_UNBOXED_TUP_ctr;
-
-  unsigned long tot_returns_of_new = RET_NEW_ctr;
-
-  unsigned long con_updates = UPD_CON_IN_NEW_ctr + UPD_CON_IN_PLACE_ctr;
-  unsigned long pap_updates = UPD_PAP_IN_NEW_ctr + UPD_PAP_IN_PLACE_ctr;
-
-  unsigned long tot_updates = UPD_SQUEEZED_ctr + pap_updates + con_updates;
-
-  unsigned long tot_new_updates   = UPD_NEW_IND_ctr + UPD_NEW_PERM_IND_ctr;
-  unsigned long tot_old_updates   = UPD_OLD_IND_ctr + UPD_OLD_PERM_IND_ctr;
-  unsigned long tot_gengc_updates = tot_new_updates + tot_old_updates;
-
-  FILE *tf = RtsFlags.TickyFlags.tickyFile;
-
-  fprintf(tf,"\n\nALLOCATIONS: %ld (%ld words total: %ld admin, %ld goods, %ld slop)\n",
-	  tot_allocs, tot_wds, tot_adm_wds, tot_gds_wds, tot_slp_wds);
-  fprintf(tf,"\t\t\t\ttotal words:\t    2     3     4     5    6+\n");
-
-#define ALLOC_HISTO_MAGIC(categ) \
-	(PC(INTAVG(ALLOC_##categ##_hst[0], ALLOC_##categ##_ctr))), \
-	(PC(INTAVG(ALLOC_##categ##_hst[1], ALLOC_##categ##_ctr))), \
-	(PC(INTAVG(ALLOC_##categ##_hst[2], ALLOC_##categ##_ctr))), \
-	(PC(INTAVG(ALLOC_##categ##_hst[3], ALLOC_##categ##_ctr))), \
-	(PC(INTAVG(ALLOC_##categ##_hst[4], ALLOC_##categ##_ctr)))
-
-  fprintf(tf,"%7ld (%5.1f%%) function values",
-	ALLOC_FUN_ctr,
-	PC(INTAVG(ALLOC_FUN_ctr, tot_allocs)));
-  if (ALLOC_FUN_ctr != 0)
-      fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FUN));
-
-  fprintf(tf,"\n%7ld (%5.1f%%) thunks",
-	ALLOC_SE_THK_ctr + ALLOC_UP_THK_ctr,
-	PC(INTAVG(ALLOC_SE_THK_ctr + ALLOC_UP_THK_ctr, tot_allocs)));
-
-#define ALLOC_THK_ctr (ALLOC_UP_THK_ctr + ALLOC_SE_THK_ctr)
-  /* hack to make ALLOC_HISTO_MAGIC still work for THK */
-  if ((ALLOC_SE_THK_ctr + ALLOC_UP_THK_ctr) != 0)
-      fprintf(tf,"\t\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(THK));
-#undef ALLOC_THK_ctr
-
-  fprintf(tf,"\n%7ld (%5.1f%%) data values",
-	ALLOC_CON_ctr,
-	PC(INTAVG(ALLOC_CON_ctr, tot_allocs)));
-  if (ALLOC_CON_ctr != 0)
-      fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(CON));
-
-  fprintf(tf,"\n%7ld (%5.1f%%) big tuples",
-	ALLOC_TUP_ctr,
-	PC(INTAVG(ALLOC_TUP_ctr, tot_allocs)));
-  if (ALLOC_TUP_ctr != 0)
-      fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(TUP));
-
-  fprintf(tf,"\n%7ld (%5.1f%%) black holes",
-	ALLOC_BH_ctr,
-	PC(INTAVG(ALLOC_BH_ctr, tot_allocs)));
-  if (ALLOC_BH_ctr != 0)
-      fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BH));
-
-  fprintf(tf,"\n%7ld (%5.1f%%) prim things",
-	ALLOC_PRIM_ctr,
-	PC(INTAVG(ALLOC_PRIM_ctr, tot_allocs)));
-  if (ALLOC_PRIM_ctr != 0)
-      fprintf(tf,"\t\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(PRIM));
-
-  fprintf(tf,"\n%7ld (%5.1f%%) partial applications",
-	ALLOC_PAP_ctr,
-	PC(INTAVG(ALLOC_PAP_ctr, tot_allocs)));
-  if (ALLOC_PAP_ctr != 0)
-      fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(PAP));
-
-  fprintf(tf,"\n%7ld (%5.1f%%) thread state objects",
-	ALLOC_TSO_ctr,
-	PC(INTAVG(ALLOC_TSO_ctr, tot_allocs)));
-  if (ALLOC_TSO_ctr != 0)
-      fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(TSO));
-#ifdef PAR
-  fprintf(tf,"\n%7ld (%5.1f%%) thread state objects",
-	ALLOC_FMBQ_ctr,
-	PC(INTAVG(ALLOC_FMBQ_ctr, tot_allocs)));
-  if (ALLOC_FMBQ_ctr != 0)
-      fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FMBQ));
-  fprintf(tf,"\n%7ld (%5.1f%%) thread state objects",
-	ALLOC_FME_ctr,
-	PC(INTAVG(ALLOC_FME_ctr, tot_allocs)));
-  if (ALLOC_FME_ctr != 0)
-      fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(FME));
-  fprintf(tf,"\n%7ld (%5.1f%%) thread state objects",
-	ALLOC_BF_ctr,
-	PC(INTAVG(ALLOC_BF_ctr, tot_allocs)));
-  if (ALLOC_BF_ctr != 0)
-      fprintf(tf,"\t\t%5.1f %5.1f %5.1f %5.1f %5.1f", ALLOC_HISTO_MAGIC(BF));
-#endif
-  fprintf(tf,"\n");
-
-  fprintf(tf,"\nTotal storage-manager allocations: %ld (%ld words)\n\t[%ld words lost to speculative heap-checks]\n", ALLOC_HEAP_ctr, ALLOC_HEAP_tot, ALLOC_HEAP_tot - tot_wds);
-
-  fprintf(tf,"\nSTACK USAGE:\n"); /* NB: some bits are direction sensitive */
-
-  fprintf(tf,"\nENTERS: %ld  of which %ld (%.1f%%) direct to the entry code\n\t\t  [the rest indirected via Node's info ptr]\n",
-	tot_enters,
-	jump_direct_enters,
-	PC(INTAVG(jump_direct_enters,tot_enters)));
-  fprintf(tf,"%7ld (%5.1f%%) thunks\n",
-	tot_thk_enters,
-	PC(INTAVG(tot_thk_enters,tot_enters)));
-  fprintf(tf,"%7ld (%5.1f%%) data values\n",
-	tot_con_enters,
-	PC(INTAVG(tot_con_enters,tot_enters)));
-  fprintf(tf,"%7ld (%5.1f%%) normal indirections\n",
-	tot_ind_enters,
-	PC(INTAVG(tot_ind_enters,tot_enters)));
-  fprintf(tf,"%7ld (%5.1f%%) permanent indirections\n",
-	ENT_PERM_IND_ctr,
-	PC(INTAVG(ENT_PERM_IND_ctr,tot_enters)));
-
-  fprintf(tf,"\nFUNCTION ENTRIES: %ld\n", tot_fun_direct_enters);
-
-  fprintf(tf, "\nTAIL CALLS: %ld, of which %ld (%.lf%%) were to known functions\n", 
-	  tot_tail_calls, tot_known_calls,
-	  PC(INTAVG(tot_known_calls,tot_tail_calls)));
-
-  fprintf(tf, "\nSLOW APPLICATIONS: %ld evaluated, %ld unevaluated\n",
-	  SLOW_CALL_ctr, SLOW_CALL_UNEVALD_ctr);
-  fprintf(tf, "\n");
-  fprintf(tf, "         Too few args   Correct args   Too many args\n");
-  fprintf(tf, "   FUN     %8ld       %8ld        %8ld\n", 
-	  SLOW_CALL_FUN_TOO_FEW_ctr, SLOW_CALL_FUN_CORRECT_ctr, SLOW_CALL_FUN_TOO_MANY_ctr);
-  fprintf(tf, "   PAP     %8ld       %8ld        %8ld\n", 
-	  SLOW_CALL_PAP_TOO_FEW_ctr, SLOW_CALL_PAP_CORRECT_ctr, SLOW_CALL_PAP_TOO_MANY_ctr);
-  fprintf(tf, "\n");
-
-  fprintf(tf,"\nRETURNS: %ld\n", tot_returns);
-  fprintf(tf,"%7ld (%5.1f%%) from entering a new constructor\n\t\t  [the rest from entering an existing constructor]\n",
-	tot_returns_of_new,
-	PC(INTAVG(tot_returns_of_new,tot_returns)));
-  fprintf(tf,"%7ld (%5.1f%%) vectored [the rest unvectored]\n",
-	VEC_RETURN_ctr,
-	PC(INTAVG(VEC_RETURN_ctr,tot_returns)));
-
-  fprintf(tf, "\nRET_NEW:         %7ld: ", RET_NEW_ctr);
-  for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
-				PC(INTAVG(RET_NEW_hst[i],RET_NEW_ctr))); }
-  fprintf(tf, "\n");
-  fprintf(tf, "RET_OLD:         %7ld: ", RET_OLD_ctr);
-  for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
-				PC(INTAVG(RET_OLD_hst[i],RET_OLD_ctr))); }
-  fprintf(tf, "\n");
-  fprintf(tf, "RET_UNBOXED_TUP: %7ld: ", RET_UNBOXED_TUP_ctr);
-  for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
-				    PC(INTAVG(RET_UNBOXED_TUP_hst[i],
-					      RET_UNBOXED_TUP_ctr))); }
-  fprintf(tf, "\n");
-  fprintf(tf, "\nRET_VEC_RETURN : %7ld: ", VEC_RETURN_ctr);
-  for (i = 0; i < 9; i++) { fprintf(tf, "%5.1f%%",
-				PC(INTAVG(RET_VEC_RETURN_hst[i],VEC_RETURN_ctr))); }
-  fprintf(tf, "\n");
-
-  fprintf(tf,"\nUPDATE FRAMES: %ld (%ld omitted from thunks)",
-	UPDF_PUSHED_ctr,
-	UPDF_OMITTED_ctr);
-
-  fprintf(tf,"\nCATCH FRAMES:  %ld", CATCHF_PUSHED_ctr);
-
-  if (UPDF_RCC_PUSHED_ctr != 0)
-     fprintf(tf,"%7ld restore cost centre frames (%ld omitted)\n",
-	UPDF_RCC_PUSHED_ctr,
-	UPDF_RCC_OMITTED_ctr);
-
-  fprintf(tf,"\nUPDATES: %ld\n", tot_updates);
-  fprintf(tf,"%7ld (%5.1f%%) data values\n\t\t  [%ld in place, %ld allocated new space]\n",
-	con_updates,
-	PC(INTAVG(con_updates,tot_updates)),
-	UPD_CON_IN_PLACE_ctr, UPD_CON_IN_NEW_ctr);
-  fprintf(tf,"%7ld (%5.1f%%) partial applications\n\t\t  [%ld in place, %ld allocated new space]\n",
-	pap_updates,
-	PC(INTAVG(pap_updates,tot_updates)),
-	UPD_PAP_IN_PLACE_ctr, UPD_PAP_IN_NEW_ctr);
-  fprintf(tf,"%7ld (%5.1f%%) updates by squeezing\n",
-	UPD_SQUEEZED_ctr,
-	PC(INTAVG(UPD_SQUEEZED_ctr, tot_updates)));
-
-  fprintf(tf, "\nUPD_CON_IN_NEW:   %7ld: ", UPD_CON_IN_NEW_ctr);
-  for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_CON_IN_NEW_hst[i]); }
-  fprintf(tf, "\n");
-  fprintf(tf, "UPD_CON_IN_PLACE: %7ld: ", UPD_CON_IN_PLACE_ctr);
-  for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_CON_IN_PLACE_hst[i]); }
-  fprintf(tf, "\n");
-  fprintf(tf, "UPD_PAP_IN_NEW:   %7ld: ", UPD_PAP_IN_NEW_ctr);
-  for (i = 0; i < 9; i++) { fprintf(tf, "%7ld", UPD_PAP_IN_NEW_hst[i]); }
-  fprintf(tf, "\n");
-
-  if (tot_gengc_updates != 0) {
-      fprintf(tf,"\nNEW GEN UPDATES: %9ld (%5.1f%%)\n",
-	      tot_new_updates,
-	      PC(INTAVG(tot_new_updates,tot_gengc_updates)));
-      fprintf(tf,"OLD GEN UPDATES: %9ld (%5.1f%%)\n",
-	      tot_old_updates,
-	      PC(INTAVG(tot_old_updates,tot_gengc_updates)));
-  }
-
-  fprintf(tf,"\nTotal bytes copied during GC: %ld\n",
-	  GC_WORDS_COPIED_ctr * sizeof(W_));
-
-  printRegisteredCounterInfo(tf);
-
-  fprintf(tf,"\n**************************************************\n");
-
-  /* here, we print out all the raw numbers; these are really
-    more useful when we want to snag them for subsequent
-    rdb-etc processing. WDP 95/11
-  */
-
-#define PR_CTR(ctr) \
-  do { fprintf(tf,"%7ld " #ctr "\n", ctr); } while(0)
-/* COND_PR_CTR takes a boolean; if false then msg is the printname rather than ctr */
-#define COND_PR_CTR(ctr,b,msg) \
-    if (b) { fprintf(tf,"%7ld " #ctr "\n", ctr); } else { fprintf(tf,"%7ld " msg "\n", ctr); }
-#define PR_HST(hst,i) \
-  do { fprintf(tf,"%7ld " #hst "_" #i "\n", hst[i]); } while(0)
-
-  PR_CTR(ALLOC_HEAP_ctr);
-  PR_CTR(ALLOC_HEAP_tot);
-
-  PR_CTR(ALLOC_FUN_ctr);
-  PR_CTR(ALLOC_FUN_adm);
-  PR_CTR(ALLOC_FUN_gds);
-  PR_CTR(ALLOC_FUN_slp);
-  PR_HST(ALLOC_FUN_hst,0);
-  PR_HST(ALLOC_FUN_hst,1);
-  PR_HST(ALLOC_FUN_hst,2);
-  PR_HST(ALLOC_FUN_hst,3);
-  PR_HST(ALLOC_FUN_hst,4);
-  PR_CTR(ALLOC_UP_THK_ctr);
-  PR_CTR(ALLOC_SE_THK_ctr);
-  PR_CTR(ALLOC_THK_adm);
-  PR_CTR(ALLOC_THK_gds);
-  PR_CTR(ALLOC_THK_slp);
-  PR_HST(ALLOC_THK_hst,0);
-  PR_HST(ALLOC_THK_hst,1);
-  PR_HST(ALLOC_THK_hst,2);
-  PR_HST(ALLOC_THK_hst,3);
-  PR_HST(ALLOC_THK_hst,4);
-  PR_CTR(ALLOC_CON_ctr);
-  PR_CTR(ALLOC_CON_adm);
-  PR_CTR(ALLOC_CON_gds);
-  PR_CTR(ALLOC_CON_slp);
-  PR_HST(ALLOC_CON_hst,0);
-  PR_HST(ALLOC_CON_hst,1);
-  PR_HST(ALLOC_CON_hst,2);
-  PR_HST(ALLOC_CON_hst,3);
-  PR_HST(ALLOC_CON_hst,4);
-  PR_CTR(ALLOC_TUP_ctr);
-  PR_CTR(ALLOC_TUP_adm);
-  PR_CTR(ALLOC_TUP_gds);
-  PR_CTR(ALLOC_TUP_slp);
-  PR_HST(ALLOC_TUP_hst,0);
-  PR_HST(ALLOC_TUP_hst,1);
-  PR_HST(ALLOC_TUP_hst,2);
-  PR_HST(ALLOC_TUP_hst,3);
-  PR_HST(ALLOC_TUP_hst,4);
-  PR_CTR(ALLOC_BH_ctr);
-  PR_CTR(ALLOC_BH_adm);
-  PR_CTR(ALLOC_BH_gds);
-  PR_CTR(ALLOC_BH_slp);
-  PR_HST(ALLOC_BH_hst,0);
-  PR_HST(ALLOC_BH_hst,1);
-  PR_HST(ALLOC_BH_hst,2);
-  PR_HST(ALLOC_BH_hst,3);
-  PR_HST(ALLOC_BH_hst,4);
-  PR_CTR(ALLOC_PRIM_ctr);
-  PR_CTR(ALLOC_PRIM_adm);
-  PR_CTR(ALLOC_PRIM_gds);
-  PR_CTR(ALLOC_PRIM_slp);
-  PR_HST(ALLOC_PRIM_hst,0);
-  PR_HST(ALLOC_PRIM_hst,1);
-  PR_HST(ALLOC_PRIM_hst,2);
-  PR_HST(ALLOC_PRIM_hst,3);
-  PR_HST(ALLOC_PRIM_hst,4);
-  PR_CTR(ALLOC_PAP_ctr);
-  PR_CTR(ALLOC_PAP_adm);
-  PR_CTR(ALLOC_PAP_gds);
-  PR_CTR(ALLOC_PAP_slp);
-  PR_HST(ALLOC_PAP_hst,0);
-  PR_HST(ALLOC_PAP_hst,1);
-  PR_HST(ALLOC_PAP_hst,2);
-  PR_HST(ALLOC_PAP_hst,3);
-  PR_HST(ALLOC_PAP_hst,4);
-
-  PR_CTR(ALLOC_TSO_ctr);
-  PR_CTR(ALLOC_TSO_adm);
-  PR_CTR(ALLOC_TSO_gds);
-  PR_CTR(ALLOC_TSO_slp);
-  PR_HST(ALLOC_TSO_hst,0);
-  PR_HST(ALLOC_TSO_hst,1);
-  PR_HST(ALLOC_TSO_hst,2);
-  PR_HST(ALLOC_TSO_hst,3);
-  PR_HST(ALLOC_TSO_hst,4);
-
-#ifdef PAR
-  PR_CTR(ALLOC_FMBQ_ctr);
-  PR_CTR(ALLOC_FMBQ_adm);
-  PR_CTR(ALLOC_FMBQ_gds);
-  PR_CTR(ALLOC_FMBQ_slp);
-  PR_HST(ALLOC_FMBQ_hst,0);
-  PR_HST(ALLOC_FMBQ_hst,1);
-  PR_HST(ALLOC_FMBQ_hst,2);
-  PR_HST(ALLOC_FMBQ_hst,3);
-  PR_HST(ALLOC_FMBQ_hst,4);
-  PR_CTR(ALLOC_FME_ctr);
-  PR_CTR(ALLOC_FME_adm);
-  PR_CTR(ALLOC_FME_gds);
-  PR_CTR(ALLOC_FME_slp);
-  PR_HST(ALLOC_FME_hst,0);
-  PR_HST(ALLOC_FME_hst,1);
-  PR_HST(ALLOC_FME_hst,2);
-  PR_HST(ALLOC_FME_hst,3);
-  PR_HST(ALLOC_FME_hst,4);
-  PR_CTR(ALLOC_BF_ctr);
-  PR_CTR(ALLOC_BF_adm);
-  PR_CTR(ALLOC_BF_gds);
-  PR_CTR(ALLOC_BF_slp);
-  PR_HST(ALLOC_BF_hst,0);
-  PR_HST(ALLOC_BF_hst,1);
-  PR_HST(ALLOC_BF_hst,2);
-  PR_HST(ALLOC_BF_hst,3);
-  PR_HST(ALLOC_BF_hst,4);
-#endif
-
-  PR_CTR(ENT_VIA_NODE_ctr);
-  PR_CTR(ENT_STATIC_CON_ctr);
-  PR_CTR(ENT_DYN_CON_ctr);
-  PR_CTR(ENT_STATIC_FUN_DIRECT_ctr);
-  PR_CTR(ENT_DYN_FUN_DIRECT_ctr);
-  PR_CTR(ENT_STATIC_IND_ctr);
-  PR_CTR(ENT_DYN_IND_ctr);
-
-/* The counters ENT_PERM_IND and UPD_{NEW,OLD}_PERM_IND are not dumped
- * at the end of execution unless update squeezing is turned off (+RTS
- * -Z =RtsFlags.GcFlags.squeezeUpdFrames), as they will be wrong
- * otherwise.  Why?  Because for each update frame squeezed out, we
- * count an UPD_NEW_PERM_IND *at GC time* (i.e., too early).  And
- * further, when we enter the closure that has been updated, we count
- * the ENT_PERM_IND, but we then enter the PERM_IND that was built for
- * the next update frame below, and so on down the chain until we
- * finally reach the value.  Thus we count many new ENT_PERM_INDs too
- * early.  
- * 
- * This of course refers to the -ticky version that uses PERM_INDs to
- * determine the number of closures entered 0/1/>1.  KSW 1999-04.  */
-  COND_PR_CTR(ENT_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == rtsFalse,"E!NT_PERM_IND_ctr requires +RTS -Z");
-
-  PR_CTR(ENT_AP_ctr);
-  PR_CTR(ENT_PAP_ctr);
-  PR_CTR(ENT_AP_STACK_ctr);
-  PR_CTR(ENT_BH_ctr);
-  PR_CTR(ENT_STATIC_THK_ctr);
-  PR_CTR(ENT_DYN_THK_ctr);
-
-  PR_CTR(SLOW_CALL_v_ctr);
-  PR_CTR(SLOW_CALL_f_ctr);
-  PR_CTR(SLOW_CALL_d_ctr);
-  PR_CTR(SLOW_CALL_l_ctr);
-  PR_CTR(SLOW_CALL_n_ctr);
-  PR_CTR(SLOW_CALL_p_ctr);
-  PR_CTR(SLOW_CALL_pv_ctr);
-  PR_CTR(SLOW_CALL_pp_ctr);
-  PR_CTR(SLOW_CALL_ppv_ctr);
-  PR_CTR(SLOW_CALL_ppp_ctr);
-  PR_CTR(SLOW_CALL_pppv_ctr);
-  PR_CTR(SLOW_CALL_pppp_ctr);
-  PR_CTR(SLOW_CALL_ppppp_ctr);
-  PR_CTR(SLOW_CALL_pppppp_ctr);
-  PR_CTR(SLOW_CALL_OTHER_ctr);
-
-  PR_CTR(UNKNOWN_CALL_ctr);
-  PR_CTR(KNOWN_CALL_ctr);
-  PR_CTR(KNOWN_CALL_TOO_FEW_ARGS_ctr);
-  PR_CTR(KNOWN_CALL_EXTRA_ARGS_ctr);
-  PR_CTR(MULTI_CHUNK_SLOW_CALL_ctr);
-  PR_CTR(MULTI_CHUNK_SLOW_CALL_CHUNKS_ctr);
-  PR_CTR(SLOW_CALL_ctr);
-  PR_CTR(SLOW_CALL_FUN_TOO_FEW_ctr);
-  PR_CTR(SLOW_CALL_FUN_CORRECT_ctr);
-  PR_CTR(SLOW_CALL_FUN_TOO_MANY_ctr);
-  PR_CTR(SLOW_CALL_PAP_TOO_FEW_ctr);
-  PR_CTR(SLOW_CALL_PAP_CORRECT_ctr);
-  PR_CTR(SLOW_CALL_PAP_TOO_MANY_ctr);
-  PR_CTR(SLOW_CALL_UNEVALD_ctr);
-  PR_HST(SLOW_CALL_hst,0);
-  PR_HST(SLOW_CALL_hst,1);
-  PR_HST(SLOW_CALL_hst,2);
-  PR_HST(SLOW_CALL_hst,3);
-  PR_HST(SLOW_CALL_hst,4);
-  PR_HST(SLOW_CALL_hst,5);
-  PR_HST(SLOW_CALL_hst,6);
-  PR_HST(SLOW_CALL_hst,7);
-
-  PR_CTR(RET_NEW_ctr);
-  PR_CTR(RET_OLD_ctr);
-  PR_CTR(RET_UNBOXED_TUP_ctr);
-  PR_CTR(VEC_RETURN_ctr);
-
-  PR_HST(RET_NEW_hst,0);
-  PR_HST(RET_NEW_hst,1);
-  PR_HST(RET_NEW_hst,2);
-  PR_HST(RET_NEW_hst,3);
-  PR_HST(RET_NEW_hst,4);
-  PR_HST(RET_NEW_hst,5);
-  PR_HST(RET_NEW_hst,6);
-  PR_HST(RET_NEW_hst,7);
-  PR_HST(RET_NEW_hst,8);
-  PR_HST(RET_OLD_hst,0);
-  PR_HST(RET_OLD_hst,1);
-  PR_HST(RET_OLD_hst,2);
-  PR_HST(RET_OLD_hst,3);
-  PR_HST(RET_OLD_hst,4);
-  PR_HST(RET_OLD_hst,5);
-  PR_HST(RET_OLD_hst,6);
-  PR_HST(RET_OLD_hst,7);
-  PR_HST(RET_OLD_hst,8);
-  PR_HST(RET_UNBOXED_TUP_hst,0);
-  PR_HST(RET_UNBOXED_TUP_hst,1);
-  PR_HST(RET_UNBOXED_TUP_hst,2);
-  PR_HST(RET_UNBOXED_TUP_hst,3);
-  PR_HST(RET_UNBOXED_TUP_hst,4);
-  PR_HST(RET_UNBOXED_TUP_hst,5);
-  PR_HST(RET_UNBOXED_TUP_hst,6);
-  PR_HST(RET_UNBOXED_TUP_hst,7);
-  PR_HST(RET_UNBOXED_TUP_hst,8);
-  PR_HST(RET_VEC_RETURN_hst,0);
-  PR_HST(RET_VEC_RETURN_hst,1);
-  PR_HST(RET_VEC_RETURN_hst,2);
-  PR_HST(RET_VEC_RETURN_hst,3);
-  PR_HST(RET_VEC_RETURN_hst,4);
-  PR_HST(RET_VEC_RETURN_hst,5);
-  PR_HST(RET_VEC_RETURN_hst,6);
-  PR_HST(RET_VEC_RETURN_hst,7);
-  PR_HST(RET_VEC_RETURN_hst,8);
-
-  PR_CTR(UPDF_OMITTED_ctr);
-  PR_CTR(UPDF_PUSHED_ctr);
-  PR_CTR(CATCHF_PUSHED_ctr);
-
-  PR_CTR(UPDF_RCC_PUSHED_ctr);
-  PR_CTR(UPDF_RCC_OMITTED_ctr);
-
-  PR_CTR(UPD_SQUEEZED_ctr);
-  PR_CTR(UPD_CON_IN_NEW_ctr);
-  PR_CTR(UPD_CON_IN_PLACE_ctr);
-  PR_CTR(UPD_PAP_IN_NEW_ctr);
-  PR_CTR(UPD_PAP_IN_PLACE_ctr);
-
-  PR_CTR(UPD_BH_UPDATABLE_ctr);
-  PR_CTR(UPD_BH_SINGLE_ENTRY_ctr);
-  PR_CTR(UPD_CAF_BH_UPDATABLE_ctr);
-  PR_CTR(UPD_CAF_BH_SINGLE_ENTRY_ctr);
-
-  PR_HST(UPD_CON_IN_NEW_hst,0);
-  PR_HST(UPD_CON_IN_NEW_hst,1);
-  PR_HST(UPD_CON_IN_NEW_hst,2);
-  PR_HST(UPD_CON_IN_NEW_hst,3);
-  PR_HST(UPD_CON_IN_NEW_hst,4);
-  PR_HST(UPD_CON_IN_NEW_hst,5);
-  PR_HST(UPD_CON_IN_NEW_hst,6);
-  PR_HST(UPD_CON_IN_NEW_hst,7);
-  PR_HST(UPD_CON_IN_NEW_hst,8);
-  PR_HST(UPD_PAP_IN_NEW_hst,0);
-  PR_HST(UPD_PAP_IN_NEW_hst,1);
-  PR_HST(UPD_PAP_IN_NEW_hst,2);
-  PR_HST(UPD_PAP_IN_NEW_hst,3);
-  PR_HST(UPD_PAP_IN_NEW_hst,4);
-  PR_HST(UPD_PAP_IN_NEW_hst,5);
-  PR_HST(UPD_PAP_IN_NEW_hst,6);
-  PR_HST(UPD_PAP_IN_NEW_hst,7);
-  PR_HST(UPD_PAP_IN_NEW_hst,8);
-
-  PR_CTR(UPD_NEW_IND_ctr);
-  /* see comment on ENT_PERM_IND_ctr */
-  COND_PR_CTR(UPD_NEW_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == rtsFalse,"U!PD_NEW_PERM_IND_ctr requires +RTS -Z");
-  PR_CTR(UPD_OLD_IND_ctr);
-  /* see comment on ENT_PERM_IND_ctr */
-  COND_PR_CTR(UPD_OLD_PERM_IND_ctr,RtsFlags.GcFlags.squeezeUpdFrames == rtsFalse,"U!PD_OLD_PERM_IND_ctr requires +RTS -Z");
-
-  PR_CTR(GC_SEL_ABANDONED_ctr);
-  PR_CTR(GC_SEL_MINOR_ctr);
-  PR_CTR(GC_SEL_MAJOR_ctr);
-  PR_CTR(GC_FAILED_PROMOTION_ctr);
-  PR_CTR(GC_WORDS_COPIED_ctr);
-}
-
-/* Data structure used in ``registering'' one of these counters. */
-
-StgEntCounter *ticky_entry_ctrs = NULL; /* root of list of them */
-
-/* To print out all the registered-counter info: */
-
-static void
-printRegisteredCounterInfo (FILE *tf)
-{
-    StgEntCounter *p;
-
-    if ( ticky_entry_ctrs != NULL ) {
-      fprintf(tf,"\n**************************************************\n\n");
-    }
-    fprintf(tf, "%11s%11s %6s%6s    %-11s%-30s\n",
-	    "Entries", "Allocs", "Arity", "Stack", "Kinds", "Function");
-    fprintf(tf, "--------------------------------------------------------------------------------\n");
-    /* Function name at the end so it doesn't mess up the tabulation */
-
-    for (p = ticky_entry_ctrs; p != NULL; p = p->link) {
-	fprintf(tf, "%11ld%11ld %6u%6u    %-11s%-30s",
-		p->entry_count,
-		p->allocs,
-		p->arity,
-		p->stk_args,
-		p->arg_kinds,
-		p->str);
-
-	fprintf(tf, "\n");
-
-    }
-}
-
-/* Catch-all top-level counter struct.  Allocations from CAFs will go
- * here.
- */
-StgEntCounter top_ct
-        = { 0, 0, 0,
-	    "TOP", "",
-	    0, 0, NULL };
-
-#endif /* TICKY_TICKY */
-
diff --git a/ghc/rts/Ticky.h b/ghc/rts/Ticky.h
deleted file mode 100644
index 21765e4bbb..0000000000
--- a/ghc/rts/Ticky.h
+++ /dev/null
@@ -1,9 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1999
- *
- * Header for Ticky.c
- *
- * ---------------------------------------------------------------------------*/
-
-extern void PrintTickyInfo(void);
diff --git a/ghc/rts/Timer.c b/ghc/rts/Timer.c
deleted file mode 100644
index 0bfea2d6fd..0000000000
--- a/ghc/rts/Timer.c
+++ /dev/null
@@ -1,102 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1995-2005
- *
- * Interval timer service for profiling and pre-emptive scheduling.
- *
- * ---------------------------------------------------------------------------*/
-
-/*
- * The interval timer is used for profiling and for context switching in the
- * threaded build. 
- *
- * This file defines the platform-independent view of interval timing, relying
- * on platform-specific services to install and run the timers.
- *
- */
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "Proftimer.h"
-#include "Schedule.h"
-#include "Timer.h"
-#include "Ticker.h"
-#include "Capability.h"
-
-/* ticks left before next pre-emptive context switch */
-static int ticks_to_ctxt_switch = 0;
-
-#if defined(THREADED_RTS)
-/* idle ticks left before we perform a GC */
-static int ticks_to_gc = 0;
-#endif
-
-/*
- * Function: handle_tick()
- *
- * At each occurrence of a tick, the OS timer will invoke
- * handle_tick().
- */
-static
-void
-handle_tick(int unused STG_UNUSED)
-{
-#ifdef PROFILING
-  handleProfTick();
-#endif
-  if (RtsFlags.ConcFlags.ctxtSwitchTicks > 0) {
-      ticks_to_ctxt_switch--;
-      if (ticks_to_ctxt_switch <= 0) {
-	  ticks_to_ctxt_switch = RtsFlags.ConcFlags.ctxtSwitchTicks;
-	  context_switch = 1;	/* schedule a context switch */
-      }
-  }
-
-#if defined(THREADED_RTS)
-  /* 
-   * If we've been inactive for idleGCDelayTicks (set by +RTS
-   * -I), tell the scheduler to wake up and do a GC, to check
-   * for threads that are deadlocked.
-   */
-  switch (recent_activity) {
-  case ACTIVITY_YES:
-      recent_activity = ACTIVITY_MAYBE_NO;
-      ticks_to_gc = RtsFlags.GcFlags.idleGCDelayTicks;
-      break;
-  case ACTIVITY_MAYBE_NO:
-      if (ticks_to_gc == 0) break; /* 0 ==> no idle GC */
-      ticks_to_gc--;
-      if (ticks_to_gc == 0) {
-	  ticks_to_gc = RtsFlags.GcFlags.idleGCDelayTicks;
-	  recent_activity = ACTIVITY_INACTIVE;
-	  blackholes_need_checking = rtsTrue;
-	  /* hack: re-use the blackholes_need_checking flag */
-	  
-	  /* ToDo: this doesn't work.  Can't invoke
-	   * pthread_cond_signal from a signal handler.
-	   * Furthermore, we can't prod a capability that we
-	   * might be holding.  What can we do?
-	   */
-	  prodOneCapability();
-      }
-      break;
-  default:
-      break;
-  }
-#endif
-}
-
-int
-startTimer(nat ms)
-{
-#ifdef PROFILING
-  initProfTimer();
-#endif
-
-  return startTicker(ms, handle_tick);
-}
-
-int
-stopTimer()
-{
-  return stopTicker();
-}
diff --git a/ghc/rts/Timer.h b/ghc/rts/Timer.h
deleted file mode 100644
index ae26653462..0000000000
--- a/ghc/rts/Timer.h
+++ /dev/null
@@ -1,24 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1995-2005
- *
- * Interval timer service for profiling and pre-emptive scheduling.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef TIMER_H
-#define TIMER_H
-
-# define TICK_MILLISECS   (1000/TICK_FREQUENCY)   /* ms per tick */
-
-/* Context switch timing constants. Context switches happen after a
- * whole number of ticks, the default being every tick.
- */
-#define CS_MIN_MILLISECS TICK_MILLISECS       /* milliseconds per slice */
-
-typedef void (*TickProc)(int);
-
-extern int startTimer(nat ms);
-extern int stopTimer(void);
-
-#endif /* TIMER_H */
diff --git a/ghc/rts/Updates.cmm b/ghc/rts/Updates.cmm
deleted file mode 100644
index 1d2fc5fe0f..0000000000
--- a/ghc/rts/Updates.cmm
+++ /dev/null
@@ -1,153 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Code to perform updates.
- *
- * This file is written in a subset of C--, extended with various
- * features specific to GHC.  It is compiled by GHC directly.  For the
- * syntax of .cmm files, see the parser in ghc/compiler/cmm/CmmParse.y.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Cmm.h"
-#include "Updates.h"
-#include "StgLdvProf.h"
-
-/*
-  The update frame return address must be *polymorphic*, that means
-  we have to cope with both vectored and non-vectored returns.  This
-  is done by putting the return vector right before the info table, and
-  having a standard direct return address after the info table (pointed
-  to by the return address itself, as usual).
-
-  Each entry in the vector table points to a specialised entry code fragment
-  that knows how to return after doing the update.  It would be possible to
-  use a single generic piece of code that simply entered the return value
-  to return, but it's quicker this way.  The direct return code of course
-  just does another direct return when it's finished.
-*/
-
-/* on entry to the update code
-   (1) R1 points to the closure being returned
-   (2) Sp points to the update frame
-*/
-
-/* The update fragment has been tuned so as to generate good
-   code with gcc, which accounts for some of the strangeness in the
-   way it is written.  
-
-   In particular, the JMP_(ret) bit is passed down and pinned on the
-   end of each branch (there end up being two major branches in the
-   code), since we don't mind duplicating this jump.
-*/
-
-#define UPD_FRAME_ENTRY_TEMPLATE(label,ind_info,ret)			\
-        label								\
-	{								\
-          W_ updatee;							\
-									\
-          updatee = StgUpdateFrame_updatee(Sp);				\
-									\
-	  /* remove the update frame from the stack */			\
-	  Sp = Sp + SIZEOF_StgUpdateFrame;				\
-									\
-	  /* ToDo: it might be a PAP, so we should check... */		\
-	  TICK_UPD_CON_IN_NEW(sizeW_fromITBL(%GET_STD_INFO(updatee)));	\
-									\
-	  UPD_SPEC_IND(updatee, ind_info, R1, jump (ret));		\
-	}
-
-UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_0_ret,stg_IND_0_info,%RET_VEC(Sp(0),0))
-UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_1_ret,stg_IND_1_info,%RET_VEC(Sp(0),1))
-UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_2_ret,stg_IND_2_info,%RET_VEC(Sp(0),2))
-UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_3_ret,stg_IND_3_info,%RET_VEC(Sp(0),3))
-UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_4_ret,stg_IND_4_info,%RET_VEC(Sp(0),4))
-UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_5_ret,stg_IND_5_info,%RET_VEC(Sp(0),5))
-UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_6_ret,stg_IND_6_info,%RET_VEC(Sp(0),6))
-UPD_FRAME_ENTRY_TEMPLATE(stg_upd_frame_7_ret,stg_IND_7_info,%RET_VEC(Sp(0),7))
-
-#if MAX_VECTORED_RTN > 8
-#error MAX_VECTORED_RTN has changed: please modify stg_upd_frame too.
-#endif
-
-/*
-  Make sure this table is big enough to handle the maximum vectored
-  return size!
-  */
-
-#if defined(PROFILING)
-#define UPD_FRAME_BITMAP 3
-#define UPD_FRAME_WORDS  3
-#else
-#define UPD_FRAME_BITMAP 0
-#define UPD_FRAME_WORDS  1
-#endif
-
-/* this bitmap indicates that the first word of an update frame is a
- * non-pointer - this is the update frame link.  (for profiling,
- * there's a cost-centre-stack in there too).
- */
-
-INFO_TABLE_RET( stg_upd_frame, 
-	    UPD_FRAME_WORDS, UPD_FRAME_BITMAP, UPDATE_FRAME,
-	    stg_upd_frame_0_ret,
-	    stg_upd_frame_1_ret,
-	    stg_upd_frame_2_ret,
-	    stg_upd_frame_3_ret,
-	    stg_upd_frame_4_ret,
-	    stg_upd_frame_5_ret,
-	    stg_upd_frame_6_ret,
-	    stg_upd_frame_7_ret
-	    )
-UPD_FRAME_ENTRY_TEMPLATE(,stg_IND_direct_info,%ENTRY_CODE(Sp(0)))
-
-
-INFO_TABLE_RET( stg_marked_upd_frame, 
-	    UPD_FRAME_WORDS, UPD_FRAME_BITMAP, UPDATE_FRAME,
-	    stg_upd_frame_0_ret,
-	    stg_upd_frame_1_ret,
-	    stg_upd_frame_2_ret,
-	    stg_upd_frame_3_ret,
-	    stg_upd_frame_4_ret,
-	    stg_upd_frame_5_ret,
-	    stg_upd_frame_6_ret,
-	    stg_upd_frame_7_ret
-	    )
-UPD_FRAME_ENTRY_TEMPLATE(,stg_IND_direct_info,%ENTRY_CODE(Sp(0)))
-
-/*-----------------------------------------------------------------------------
-  Seq frames 
-
-  We don't have a primitive seq# operator: it is just a 'case'
-  expression whose scrutinee has either a polymorphic or function type
-  (constructor types can be handled by normal 'case' expressions).
-
-  To handle a polymorphic/function typed seq, we push a SEQ frame on
-  the stack.  This is a polymorphic activation record that just pops
-  itself and returns (in a non-vectored way) when entered.  The
-  purpose of the SEQ frame is to avoid having to make a polymorphic return
-  point for each polymorphic case expression.  
-
-  Another way of looking at it: the SEQ frame turns a vectored return
-  into a direct one.
-  -------------------------------------------------------------------------- */
-
-#if MAX_VECTORED_RTN > 8
-#error MAX_VECTORED_RTN has changed: please modify stg_seq_frame too.
-#endif
-
-INFO_TABLE_RET( stg_seq_frame, 0/* words */, 0/* bitmap */, RET_SMALL,
-	RET_LBL(stg_seq_frame), /* 0 */
-	RET_LBL(stg_seq_frame), /* 1 */
-	RET_LBL(stg_seq_frame), /* 2 */
-	RET_LBL(stg_seq_frame), /* 3 */
-	RET_LBL(stg_seq_frame), /* 4 */
-	RET_LBL(stg_seq_frame), /* 5 */
-	RET_LBL(stg_seq_frame), /* 6 */
-	RET_LBL(stg_seq_frame)  /* 7 */
-	)
-{
-   Sp_adj(1);
-   jump %ENTRY_CODE(Sp(0));
-}
diff --git a/ghc/rts/Updates.h b/ghc/rts/Updates.h
deleted file mode 100644
index 5872157c81..0000000000
--- a/ghc/rts/Updates.h
+++ /dev/null
@@ -1,361 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * Performing updates.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef UPDATES_H
-#define UPDATES_H
-
-/* -----------------------------------------------------------------------------
-   Updates
-
-   We have two layers of update macros.  The top layer, UPD_IND() and
-   friends perform all the work of an update.  In detail:
-
-      - if the closure being updated is a blocking queue, then all the
-        threads waiting on the blocking queue are updated.
-
-      - then the lower level updateWithIndirection() macro is invoked 
-        to actually replace the closure with an indirection (see below).
-
-   -------------------------------------------------------------------------- */
-
-#ifdef TICKY_TICKY
-# define UPD_IND(updclosure, heapptr) \
-   UPD_PERM_IND(updclosure,heapptr)
-# define UPD_SPEC_IND(updclosure, ind_info, heapptr, and_then) \
-   UPD_PERM_IND(updclosure,heapptr); and_then
-#else
-#  define SEMI ;
-# define UPD_IND(updclosure, heapptr) \
-   UPD_REAL_IND(updclosure,INFO_PTR(stg_IND_info),heapptr,SEMI)
-# define UPD_SPEC_IND(updclosure, ind_info, heapptr, and_then) \
-   UPD_REAL_IND(updclosure,ind_info,heapptr,and_then)
-#endif
-
-/* These macros have to work in both C and C--, so here's the
- * impedence matching:
- */
-#ifdef CMINUSMINUS
-#define BLOCK_BEGIN
-#define BLOCK_END
-#define DECLARE_IPTR(info)  W_ info
-#define FCALL               foreign "C"
-#define INFO_PTR(info)      info
-#define ARG_PTR             "ptr"
-#else
-#define BLOCK_BEGIN         {
-#define BLOCK_END           }
-#define DECLARE_IPTR(info)  const StgInfoTable *(info)
-#define FCALL               /* nothing */
-#define INFO_PTR(info)      &info
-#define StgBlockingQueue_blocking_queue(closure) \
-    (((StgBlockingQueue *)closure)->blocking_queue)
-#define ARG_PTR             /* nothing */
-#endif
-
-/* UPD_IND actually does a PERM_IND if TICKY_TICKY is on;
-   if you *really* need an IND use UPD_REAL_IND
- */
-#define UPD_REAL_IND(updclosure, ind_info, heapptr, and_then)	\
-        BLOCK_BEGIN						\
-	DECLARE_IPTR(info);					\
-	info = GET_INFO(updclosure);				\
-	updateWithIndirection(ind_info,				\
-			      updclosure,			\
-			      heapptr,				\
-			      and_then);			\
-	BLOCK_END
-
-#if defined(PROFILING) || defined(TICKY_TICKY)
-#define UPD_PERM_IND(updclosure, heapptr)	\
-        BLOCK_BEGIN				\
-	updateWithPermIndirection(updclosure,	\
-				  heapptr);	\
-	BLOCK_END
-#endif
-
-#if defined(RTS_SUPPORTS_THREADS)
-
-# ifdef TICKY_TICKY
-#  define UPD_IND_NOLOCK(updclosure, heapptr)	\
-        BLOCK_BEGIN				\
-	updateWithPermIndirection(updclosure,	\
-				  heapptr);	\
-	BLOCK_END
-# else
-#  define UPD_IND_NOLOCK(updclosure, heapptr)			\
-        BLOCK_BEGIN						\
-	updateWithIndirection(INFO_PTR(stg_IND_info),		\
-			      updclosure,			\
-			      heapptr,); 			\
-	BLOCK_END
-# endif
-
-#else
-#define UPD_IND_NOLOCK(updclosure,heapptr) UPD_IND(updclosure,heapptr)
-#endif
-
-/* -----------------------------------------------------------------------------
-   Awaken any threads waiting on a blocking queue (BLACKHOLE_BQ).
-   -------------------------------------------------------------------------- */
-
-#if defined(PAR) 
-
-/* 
-   In a parallel setup several types of closures might have a blocking queue:
-     BLACKHOLE_BQ ... same as in the default concurrent setup; it will be
-                      reawakened via calling UPD_IND on that closure after
-		      having finished the computation of the graph
-     FETCH_ME_BQ  ... a global indirection (FETCH_ME) may be entered by a 
-                      local TSO, turning it into a FETCH_ME_BQ; it will be
-		      reawakened via calling processResume
-     RBH          ... a revertible black hole may be entered by another 
-                      local TSO, putting it onto its blocking queue; since
-		      RBHs only exist while the corresponding closure is in 
-		      transit, they will be reawakened via calling 
-		      convertToFetchMe (upon processing an ACK message)
-
-   In a parallel setup a blocking queue may contain 3 types of closures:
-     TSO           ... as in the default concurrent setup
-     BLOCKED_FETCH ... indicating that a TSO on another PE is waiting for
-                       the result of the current computation
-     CONSTR        ... an RBHSave closure (which contains data ripped out of
-                       the closure to make room for a blocking queue; since
-		       it only contains data we use the exisiting type of
-		       a CONSTR closure); this closure is the end of a 
-		       blocking queue for an RBH closure; it only exists in
-		       this kind of blocking queue and must be at the end
-		       of the queue
-*/		      
-extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node);
-#define DO_AWAKEN_BQ(bqe, node)  STGCALL2(awakenBlockedQueue, bqe, node);
-
-#define AWAKEN_BQ(info,closure)						\
-     	if (info == &stg_BLACKHOLE_BQ_info ||               \
-	    info == &stg_FETCH_ME_BQ_info ||                \
-	    get_itbl(closure)->type == RBH) {		                \
-		DO_AWAKEN_BQ(((StgBlockingQueue *)closure)->blocking_queue, closure);     	                \
-	}
-
-#elif defined(GRAN)
-
-extern void awakenBlockedQueue(StgBlockingQueueElement *q, StgClosure *node);
-#define DO_AWAKEN_BQ(bq, node)  STGCALL2(awakenBlockedQueue, bq, node);
-
-/* In GranSim we don't have FETCH_ME or FETCH_ME_BQ closures, so they are
-   not checked. The rest of the code is the same as for GUM.
-*/
-#define AWAKEN_BQ(info,closure)						\
-     	if (info == &stg_BLACKHOLE_BQ_info ||               \
-	    get_itbl(closure)->type == RBH) {		                \
-		DO_AWAKEN_BQ(((StgBlockingQueue *)closure)->blocking_queue, closure);     	                \
-	}
-
-#endif /* GRAN || PAR */
-
-
-/* -----------------------------------------------------------------------------
-   Updates: lower-level macros which update a closure with an
-   indirection to another closure.
-
-   There are several variants of this code.
-
-       PROFILING:
-   -------------------------------------------------------------------------- */
-
-/* LDV profiling:
- * We call LDV_recordDead_FILL_SLOP_DYNAMIC(p1) regardless of the generation in 
- * which p1 resides.
- *
- * Note: 
- *   After all, we do *NOT* need to call LDV_RECORD_CREATE() for both IND and 
- *   IND_OLDGEN closures because they are inherently used. But, it corrupts
- *   the invariants that every closure keeps its creation time in the profiling
- *  field. So, we call LDV_RECORD_CREATE().
- */
-
-/* In the DEBUG case, we also zero out the slop of the old closure,
- * so that the sanity checker can tell where the next closure is.
- *
- * Two important invariants: we should never try to update a closure
- * to point to itself, and the closure being updated should not
- * already have been updated (the mutable list will get messed up
- * otherwise).
- *
- * NB. We do *not* do this in THREADED_RTS mode, because when we have the
- * possibility of multiple threads entering the same closure, zeroing
- * the slop in one of the threads would have a disastrous effect on
- * the other (seen in the wild!).
- */
-#ifdef CMINUSMINUS
-
-#define FILL_SLOP(p)							\
-  W_ inf;								\
-  W_ sz;								\
-  W_ i;									\
-  inf = %GET_STD_INFO(p);						\
-  if (%INFO_TYPE(inf) != HALF_W_(THUNK_SELECTOR)			\
-	&& %INFO_TYPE(inf) != HALF_W_(BLACKHOLE)			\
-	&& %INFO_TYPE(inf) != HALF_W_(CAF_BLACKHOLE)) {			\
-      if (%INFO_TYPE(inf) == HALF_W_(AP_STACK)) {			\
-          sz = StgAP_STACK_size(p) + BYTES_TO_WDS(SIZEOF_StgAP_STACK_NoThunkHdr); \
-      } else {								\
-          if (%INFO_TYPE(inf) == HALF_W_(AP)) {				\
-	      sz = TO_W_(StgAP_n_args(p)) +  BYTES_TO_WDS(SIZEOF_StgAP_NoThunkHdr);	\
-          } else {							\
-              sz = TO_W_(%INFO_PTRS(inf)) + TO_W_(%INFO_NPTRS(inf));	\
-	  }								\
-      }									\
-      i = 0;								\
-      for:								\
-        if (i < sz) {							\
-          StgThunk_payload(p,i) = 0;					\
-          i = i + 1;							\
-          goto for;							\
-        }								\
-  }
-
-#else /* !CMINUSMINUS */
-
-INLINE_HEADER void
-FILL_SLOP(StgClosure *p)
-{						
-    StgInfoTable *inf = get_itbl(p);		
-    nat i, sz;
-
-    switch (inf->type) {
-    case BLACKHOLE:
-    case CAF_BLACKHOLE:
-    case THUNK_SELECTOR:
-	return;
-    case AP:
-	sz = ((StgAP *)p)->n_args + sizeofW(StgAP) - sizeofW(StgThunkHeader);
-	break;
-    case AP_STACK:
-	sz = ((StgAP_STACK *)p)->size + sizeofW(StgAP_STACK) - sizeofW(StgThunkHeader);
-	break;
-    default:
-	sz = inf->layout.payload.ptrs + inf->layout.payload.nptrs;
-        break;
-    }
-    for (i = 0; i < sz; i++) {
-	((StgThunk *)p)->payload[i] = 0;
-    }
-}
-
-#endif /* CMINUSMINUS */
-
-#if !defined(DEBUG) || defined(THREADED_RTS)
-#define DEBUG_FILL_SLOP(p) /* do nothing */
-#else
-#define DEBUG_FILL_SLOP(p) FILL_SLOP(p)
-#endif
-
-/* We have two versions of this macro (sadly), one for use in C-- code,
- * and the other for C.
- *
- * The and_then argument is a performance hack so that we can paste in
- * the continuation code directly.  It helps shave a couple of
- * instructions off the common case in the update code, which is
- * worthwhile (the update code is often part of the inner loop).
- * (except that gcc now appears to common up this code again and
- * invert the optimisation.  Grrrr --SDM).
- */
-#ifdef CMINUSMINUS
-#define generation(n) (W_[generations] + n*SIZEOF_generation)
-#define updateWithIndirection(ind_info, p1, p2, and_then)	\
-    W_ bd;							\
-								\
-    DEBUG_FILL_SLOP(p1);					\
-    LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1);			\
-    StgInd_indirectee(p1) = p2;					\
-    foreign "C" wb() [];					\
-    bd = Bdescr(p1);						\
-    if (bdescr_gen_no(bd) != 0 :: CInt) {			\
-      foreign "C" recordMutableCap(p1 "ptr",			\
-				   MyCapability() "ptr",	\
-		                   bdescr_gen_no(bd)) [R1];	\
-      SET_INFO(p1, stg_IND_OLDGEN_info);			\
-      LDV_RECORD_CREATE(p1);					\
-      TICK_UPD_OLD_IND();					\
-      and_then;							\
-    } else {							\
-      SET_INFO(p1, ind_info);					\
-      LDV_RECORD_CREATE(p1);					\
-      TICK_UPD_NEW_IND();					\
-      and_then;							\
-  }
-#else
-#define updateWithIndirection(ind_info, p1, p2, and_then)		\
-  {									\
-    bdescr *bd;								\
-									\
-    /* cas(p1, 0, &stg_WHITEHOLE_info); */				\
-    ASSERT( (P_)p1 != (P_)p2 && !closure_IND(p1) );			\
-    DEBUG_FILL_SLOP(p1);						\
-    LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1);				\
-    ((StgInd *)p1)->indirectee = p2;					\
-    wb();								\
-    bd = Bdescr((P_)p1);						\
-    if (bd->gen_no != 0) {						\
-      recordMutableGenLock(p1, &generations[bd->gen_no]);		\
-      SET_INFO(p1, &stg_IND_OLDGEN_info);				\
-      TICK_UPD_OLD_IND();						\
-      and_then;								\
-    } else {								\
-      SET_INFO(p1, ind_info);						\
-      LDV_RECORD_CREATE(p1);						\
-      TICK_UPD_NEW_IND();						\
-      and_then;								\
-    }									\
-  }
-#endif
-
-/* The permanent indirection version isn't performance critical.  We
- * therefore use an inline C function instead of the C-- macro.
- */
-#ifndef CMINUSMINUS
-INLINE_HEADER void
-updateWithPermIndirection(StgClosure *p1,
-	                  StgClosure *p2) 
-{
-  bdescr *bd;
-
-  ASSERT( p1 != p2 && !closure_IND(p1) );
-
-  /*
-   * @LDV profiling
-   * Destroy the old closure.
-   * Nb: LDV_* stuff cannot mix with ticky-ticky
-   */
-  LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(p1);
-
-  bd = Bdescr((P_)p1);
-  if (bd->gen_no != 0) {
-    recordMutableGenLock(p1, &generations[bd->gen_no]);
-    ((StgInd *)p1)->indirectee = p2;
-    SET_INFO(p1, &stg_IND_OLDGEN_PERM_info);
-    /*
-     * @LDV profiling
-     * We have just created a new closure.
-     */
-    LDV_RECORD_CREATE(p1);
-    TICK_UPD_OLD_PERM_IND();
-  } else {
-    ((StgInd *)p1)->indirectee = p2;
-    SET_INFO(p1, &stg_IND_PERM_info);
-    /*
-     * @LDV profiling
-     * We have just created a new closure.
-     */
-    LDV_RECORD_CREATE(p1);
-    TICK_UPD_NEW_PERM_IND(p1);
-  }
-}
-#endif
-
-#endif /* UPDATES_H */
diff --git a/ghc/rts/VisCallbacks.c b/ghc/rts/VisCallbacks.c
deleted file mode 100644
index 8e3c6ceb6c..0000000000
--- a/ghc/rts/VisCallbacks.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 2000
- *
- * RTS GTK Front Panel (callbacks)
- *
- * ---------------------------------------------------------------------------*/
-
-#ifdef RTS_GTK_FRONTPANEL
-
-#include "Rts.h"
-
-#include <gtk/gtk.h>
-
-#include "VisCallbacks.h"
-#include "VisWindow.h"
-#include "VisSupport.h"
-#include "FrontPanel.h"
-
-void
-on_cont_radio_clicked                  (GtkButton       *button,
-                                        gpointer         user_data)
-{
-    update_mode = Continuous;
-}
-
-
-void
-on_stop_before_radio_clicked           (GtkButton       *button,
-                                        gpointer         user_data)
-{
-    update_mode = BeforeGC;
-}
-
-
-void
-on_stop_after_radio_clicked            (GtkButton       *button,
-                                        gpointer         user_data)
-{
-    update_mode = AfterGC;
-}
-
-
-void
-on_stop_both_radio_clicked             (GtkButton       *button,
-                                        gpointer         user_data)
-{
-    update_mode = BeforeAfterGC;
-}
-
-
-void
-on_stop_but_clicked                    (GtkButton       *button,
-                                        gpointer         user_data)
-{
-    stop_now = TRUE;
-}
-
-
-void
-on_continue_but_clicked                (GtkButton       *button,
-                                        gpointer         user_data)
-{
-    continue_now = TRUE;
-}
-
-
-void
-on_quit_but_clicked                    (GtkButton       *button,
-                                        gpointer         user_data)
-{
-    quit = TRUE;
-}
-
-#endif /* RTS_GTK_FRONTPANEL */
diff --git a/ghc/rts/VisCallbacks.h b/ghc/rts/VisCallbacks.h
deleted file mode 100644
index d242010fad..0000000000
--- a/ghc/rts/VisCallbacks.h
+++ /dev/null
@@ -1,30 +0,0 @@
-#include <gtk/gtk.h>
-
-
-void
-on_cont_radio_clicked                  (GtkButton       *button,
-                                        gpointer         user_data);
-
-void
-on_stop_before_radio_clicked           (GtkButton       *button,
-                                        gpointer         user_data);
-
-void
-on_stop_after_radio_clicked            (GtkButton       *button,
-                                        gpointer         user_data);
-
-void
-on_stop_both_radio_clicked             (GtkButton       *button,
-                                        gpointer         user_data);
-
-void
-on_stop_but_clicked                    (GtkButton       *button,
-                                        gpointer         user_data);
-
-void
-on_continue_but_clicked                (GtkButton       *button,
-                                        gpointer         user_data);
-
-void
-on_quit_but_clicked                    (GtkButton       *button,
-                                        gpointer         user_data);
diff --git a/ghc/rts/VisSupport.c b/ghc/rts/VisSupport.c
deleted file mode 100644
index a85c5f43a4..0000000000
--- a/ghc/rts/VisSupport.c
+++ /dev/null
@@ -1,144 +0,0 @@
-/*
- * DO NOT EDIT THIS FILE - it is generated by Glade.
- */
-
-#ifdef HAVE_CONFIG_H
-#  include <config.h>
-#endif
-
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <unistd.h>
-#include <string.h>
-#include <stdio.h>
-
-#include <gtk/gtk.h>
-
-#include "VisSupport.h"
-
-GtkWidget*
-lookup_widget                          (GtkWidget       *widget,
-                                        const gchar     *widget_name)
-{
-  GtkWidget *parent, *found_widget;
-
-  for (;;)
-    {
-      if (GTK_IS_MENU (widget))
-        parent = gtk_menu_get_attach_widget (GTK_MENU (widget));
-      else
-        parent = widget->parent;
-      if (!parent)
-        parent = (GtkWidget*) g_object_get_data (G_OBJECT (widget), "GladeParentKey");
-      if (parent == NULL)
-        break;
-      widget = parent;
-    }
-
-  found_widget = (GtkWidget*) g_object_get_data (G_OBJECT (widget),
-                                                 widget_name);
-  if (!found_widget)
-    g_warning ("Widget not found: %s", widget_name);
-  return found_widget;
-}
-
-static GList *pixmaps_directories = NULL;
-
-/* Use this function to set the directory containing installed pixmaps. */
-void
-add_pixmap_directory                   (const gchar     *directory)
-{
-  pixmaps_directories = g_list_prepend (pixmaps_directories,
-                                        g_strdup (directory));
-}
-
-/* This is an internally used function to find pixmap files. */
-static gchar*
-find_pixmap_file                       (const gchar     *filename)
-{
-  GList *elem;
-
-  /* We step through each of the pixmaps directory to find it. */
-  elem = pixmaps_directories;
-  while (elem)
-    {
-      gchar *pathname = g_strdup_printf ("%s%s%s", (gchar*)elem->data,
-                                         G_DIR_SEPARATOR_S, filename);
-      if (g_file_test (pathname, G_FILE_TEST_EXISTS))
-        return pathname;
-      g_free (pathname);
-      elem = elem->next;
-    }
-  return NULL;
-}
-
-/* This is an internally used function to create pixmaps. */
-GtkWidget*
-create_pixmap                          (GtkWidget       *widget,
-                                        const gchar     *filename)
-{
-  gchar *pathname = NULL;
-  GtkWidget *pixmap;
-
-  if (!filename || !filename[0])
-      return gtk_image_new ();
-
-  pathname = find_pixmap_file (filename);
-
-  if (!pathname)
-    {
-      g_warning ("Couldn't find pixmap file: %s", filename);
-      return gtk_image_new ();
-    }
-
-  pixmap = gtk_image_new_from_file (pathname);
-  g_free (pathname);
-  return pixmap;
-}
-
-/* This is an internally used function to create pixmaps. */
-GdkPixbuf*
-create_pixbuf                          (const gchar     *filename)
-{
-  gchar *pathname = NULL;
-  GdkPixbuf *pixbuf;
-  GError *error = NULL;
-
-  if (!filename || !filename[0])
-      return NULL;
-
-  pathname = find_pixmap_file (filename);
-
-  if (!pathname)
-    {
-      g_warning ("Couldn't find pixmap file: %s", filename);
-      return NULL;
-    }
-
-  pixbuf = gdk_pixbuf_new_from_file (pathname, &error);
-  if (!pixbuf)
-    {
-      fprintf (stderr, "Failed to load pixbuf file: %s: %s\n",
-               pathname, error->message);
-      g_error_free (error);
-    }
-  g_free (pathname);
-  return pixbuf;
-}
-
-/* This is used to set ATK action descriptions. */
-void
-glade_set_atk_action_description       (AtkAction       *action,
-                                        const gchar     *action_name,
-                                        const gchar     *description)
-{
-  gint n_actions, i;
-
-  n_actions = atk_action_get_n_actions (action);
-  for (i = 0; i < n_actions; i++)
-    {
-      if (!strcmp (atk_action_get_name (action, i), action_name))
-        atk_action_set_description (action, i, description);
-    }
-}
-
diff --git a/ghc/rts/VisSupport.h b/ghc/rts/VisSupport.h
deleted file mode 100644
index 2dea079c2a..0000000000
--- a/ghc/rts/VisSupport.h
+++ /dev/null
@@ -1,44 +0,0 @@
-/*
- * DO NOT EDIT THIS FILE - it is generated by Glade.
- */
-
-#ifdef HAVE_CONFIG_H
-#  include <config.h>
-#endif
-
-#include <gtk/gtk.h>
-
-/*
- * Public Functions.
- */
-
-/*
- * This function returns a widget in a component created by Glade.
- * Call it with the toplevel widget in the component (i.e. a window/dialog),
- * or alternatively any widget in the component, and the name of the widget
- * you want returned.
- */
-GtkWidget*  lookup_widget              (GtkWidget       *widget,
-                                        const gchar     *widget_name);
-
-
-/* Use this function to set the directory containing installed pixmaps. */
-void        add_pixmap_directory       (const gchar     *directory);
-
-
-/*
- * Private Functions.
- */
-
-/* This is used to create the pixmaps used in the interface. */
-GtkWidget*  create_pixmap              (GtkWidget       *widget,
-                                        const gchar     *filename);
-
-/* This is used to create the pixbufs used in the interface. */
-GdkPixbuf*  create_pixbuf              (const gchar     *filename);
-
-/* This is used to set ATK action descriptions. */
-void        glade_set_atk_action_description (AtkAction       *action,
-                                              const gchar     *action_name,
-                                              const gchar     *description);
-
diff --git a/ghc/rts/VisWindow.c b/ghc/rts/VisWindow.c
deleted file mode 100644
index 188b88976e..0000000000
--- a/ghc/rts/VisWindow.c
+++ /dev/null
@@ -1,747 +0,0 @@
-/*
- * DO NOT EDIT THIS FILE - it is generated by Glade.
- */
-
-#ifdef HAVE_CONFIG_H
-#  include <config.h>
-#endif
-
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <unistd.h>
-#include <string.h>
-#include <stdio.h>
-
-#include <gdk/gdkkeysyms.h>
-#include <gtk/gtk.h>
-
-#include "VisCallbacks.h"
-#include "VisWindow.h"
-#include "VisSupport.h"
-
-#define GLADE_HOOKUP_OBJECT(component,widget,name) \
-  g_object_set_data_full (G_OBJECT (component), name, \
-    gtk_widget_ref (widget), (GDestroyNotify) gtk_widget_unref)
-
-#define GLADE_HOOKUP_OBJECT_NO_REF(component,widget,name) \
-  g_object_set_data (G_OBJECT (component), name, widget)
-
-GtkWidget*
-create_GHC_Front_Panel (void)
-{
-  GtkWidget *GHC_Front_Panel;
-  GtkWidget *vbox1;
-  GtkWidget *hbox1;
-  GtkWidget *vbox4;
-  GtkWidget *frame3;
-  GtkWidget *hbox3;
-  GtkWidget *label40;
-  GtkWidget *map_ruler;
-  GtkWidget *memmap;
-  GtkWidget *label1;
-  GtkWidget *frame8;
-  GtkWidget *vbox14;
-  GtkWidget *table4;
-  GtkWidget *gen_ruler;
-  GtkWidget *gen_hbox;
-  GtkWidget *generations;
-  GtkWidget *label39;
-  GtkWidget *label41;
-  GtkWidget *frame7;
-  GtkWidget *table3;
-  GtkWidget *res_hruler;
-  GtkWidget *res_vruler;
-  GtkWidget *res_drawingarea;
-  GtkWidget *label37;
-  GtkWidget *label38;
-  GtkWidget *label42;
-  GtkWidget *vbox5;
-  GtkWidget *frame5;
-  GtkWidget *vbox6;
-  GtkWidget *table1;
-  GtkWidget *label12;
-  GtkWidget *label13;
-  GtkWidget *label14;
-  GtkWidget *label15;
-  GtkWidget *label16;
-  GtkWidget *label17;
-  GtkWidget *label18;
-  GtkWidget *label19;
-  GtkWidget *live_label;
-  GtkWidget *allocated_label;
-  GtkWidget *footprint_label;
-  GtkWidget *alloc_rate_label;
-  GtkWidget *label43;
-  GtkWidget *frame9;
-  GtkWidget *table5;
-  GtkWidget *label20;
-  GtkWidget *label21;
-  GtkWidget *label22;
-  GtkWidget *label24;
-  GtkWidget *label26;
-  GtkWidget *label25;
-  GtkWidget *label27;
-  GtkWidget *running_label;
-  GtkWidget *blockread_label;
-  GtkWidget *blockwrite_label;
-  GtkWidget *blockmvar_label;
-  GtkWidget *blockthrowto_label;
-  GtkWidget *blockbh_label;
-  GtkWidget *sleeping_label;
-  GtkWidget *hseparator1;
-  GtkWidget *hseparator2;
-  GtkWidget *label35;
-  GtkWidget *total_label;
-  GtkWidget *label44;
-  GtkWidget *frame6;
-  GtkWidget *vbox7;
-  GtkWidget *vbox9;
-  GtkWidget *cont_radio;
-  GSList *cont_radio_group = NULL;
-  GtkWidget *stop_before_radio;
-  GtkWidget *stop_after_radio;
-  GtkWidget *stop_both_radio;
-  GtkWidget *vbox8;
-  GtkWidget *stop_but;
-  GtkWidget *continue_but;
-  GtkWidget *label45;
-  GtkWidget *quit_but;
-  GtkWidget *statusbar;
-
-  GHC_Front_Panel = gtk_window_new (GTK_WINDOW_TOPLEVEL);
-  gtk_widget_set_name (GHC_Front_Panel, "GHC_Front_Panel");
-  gtk_window_set_title (GTK_WINDOW (GHC_Front_Panel), "GHC Front Panel");
-  gtk_window_set_default_size (GTK_WINDOW (GHC_Front_Panel), 450, 600);
-
-  vbox1 = gtk_vbox_new (FALSE, 0);
-  gtk_widget_set_name (vbox1, "vbox1");
-  gtk_widget_show (vbox1);
-  gtk_container_add (GTK_CONTAINER (GHC_Front_Panel), vbox1);
-
-  hbox1 = gtk_hbox_new (FALSE, 10);
-  gtk_widget_set_name (hbox1, "hbox1");
-  gtk_widget_show (hbox1);
-  gtk_box_pack_start (GTK_BOX (vbox1), hbox1, TRUE, TRUE, 0);
-  gtk_container_set_border_width (GTK_CONTAINER (hbox1), 10);
-
-  vbox4 = gtk_vbox_new (FALSE, 10);
-  gtk_widget_set_name (vbox4, "vbox4");
-  gtk_widget_show (vbox4);
-  gtk_box_pack_start (GTK_BOX (hbox1), vbox4, TRUE, TRUE, 0);
-
-  frame3 = gtk_frame_new (NULL);
-  gtk_widget_set_name (frame3, "frame3");
-  gtk_widget_show (frame3);
-  gtk_box_pack_start (GTK_BOX (vbox4), frame3, TRUE, TRUE, 0);
-
-  hbox3 = gtk_hbox_new (FALSE, 0);
-  gtk_widget_set_name (hbox3, "hbox3");
-  gtk_widget_show (hbox3);
-  gtk_container_add (GTK_CONTAINER (frame3), hbox3);
-
-  label40 = gtk_label_new ("Mb");
-  gtk_widget_set_name (label40, "label40");
-  gtk_widget_show (label40);
-  gtk_box_pack_start (GTK_BOX (hbox3), label40, FALSE, FALSE, 0);
-  gtk_label_set_justify (GTK_LABEL (label40), GTK_JUSTIFY_CENTER);
-
-  map_ruler = gtk_vruler_new ();
-  gtk_widget_set_name (map_ruler, "map_ruler");
-  gtk_widget_show (map_ruler);
-  gtk_box_pack_start (GTK_BOX (hbox3), map_ruler, FALSE, FALSE, 0);
-  gtk_ruler_set_range (GTK_RULER (map_ruler), 0, 10, 1.40845, 10);
-
-  memmap = gtk_drawing_area_new ();
-  gtk_widget_set_name (memmap, "memmap");
-  gtk_widget_show (memmap);
-  gtk_box_pack_start (GTK_BOX (hbox3), memmap, TRUE, TRUE, 0);
-
-  label1 = gtk_label_new ("Memory Map");
-  gtk_widget_set_name (label1, "label1");
-  gtk_widget_show (label1);
-  gtk_frame_set_label_widget (GTK_FRAME (frame3), label1);
-
-  frame8 = gtk_frame_new (NULL);
-  gtk_widget_set_name (frame8, "frame8");
-  gtk_widget_show (frame8);
-  gtk_box_pack_start (GTK_BOX (vbox4), frame8, TRUE, TRUE, 0);
-
-  vbox14 = gtk_vbox_new (FALSE, 0);
-  gtk_widget_set_name (vbox14, "vbox14");
-  gtk_widget_show (vbox14);
-  gtk_container_add (GTK_CONTAINER (frame8), vbox14);
-
-  table4 = gtk_table_new (2, 3, FALSE);
-  gtk_widget_set_name (table4, "table4");
-  gtk_widget_show (table4);
-  gtk_box_pack_start (GTK_BOX (vbox14), table4, TRUE, TRUE, 0);
-
-  gen_ruler = gtk_vruler_new ();
-  gtk_widget_set_name (gen_ruler, "gen_ruler");
-  gtk_widget_show (gen_ruler);
-  gtk_table_attach (GTK_TABLE (table4), gen_ruler, 1, 2, 0, 1,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (GTK_EXPAND | GTK_FILL), 0, 0);
-  gtk_ruler_set_range (GTK_RULER (gen_ruler), 0, 10, 1.69935, 10);
-
-  gen_hbox = gtk_hbox_new (FALSE, 0);
-  gtk_widget_set_name (gen_hbox, "gen_hbox");
-  gtk_widget_show (gen_hbox);
-  gtk_table_attach (GTK_TABLE (table4), gen_hbox, 2, 3, 1, 2,
-                    (GtkAttachOptions) (GTK_EXPAND | GTK_FILL),
-                    (GtkAttachOptions) (GTK_FILL), 0, 0);
-
-  generations = gtk_drawing_area_new ();
-  gtk_widget_set_name (generations, "generations");
-  gtk_widget_show (generations);
-  gtk_table_attach (GTK_TABLE (table4), generations, 2, 3, 0, 1,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (GTK_FILL), 0, 0);
-
-  label39 = gtk_label_new ("Mb");
-  gtk_widget_set_name (label39, "label39");
-  gtk_widget_show (label39);
-  gtk_table_attach (GTK_TABLE (table4), label39, 0, 1, 0, 1,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label39), GTK_JUSTIFY_CENTER);
-
-  label41 = gtk_label_new ("Generations");
-  gtk_widget_set_name (label41, "label41");
-  gtk_widget_show (label41);
-  gtk_frame_set_label_widget (GTK_FRAME (frame8), label41);
-
-  frame7 = gtk_frame_new (NULL);
-  gtk_widget_set_name (frame7, "frame7");
-  gtk_widget_show (frame7);
-  gtk_box_pack_start (GTK_BOX (vbox4), frame7, TRUE, TRUE, 0);
-
-  table3 = gtk_table_new (3, 3, FALSE);
-  gtk_widget_set_name (table3, "table3");
-  gtk_widget_show (table3);
-  gtk_container_add (GTK_CONTAINER (frame7), table3);
-  gtk_container_set_border_width (GTK_CONTAINER (table3), 2);
-
-  res_hruler = gtk_hruler_new ();
-  gtk_widget_set_name (res_hruler, "res_hruler");
-  gtk_widget_show (res_hruler);
-  gtk_table_attach (GTK_TABLE (table3), res_hruler, 2, 3, 1, 2,
-                    (GtkAttachOptions) (GTK_EXPAND | GTK_FILL),
-                    (GtkAttachOptions) (GTK_FILL), 0, 0);
-  gtk_ruler_set_range (GTK_RULER (res_hruler), 0, 10, 8.35443, 10);
-
-  res_vruler = gtk_vruler_new ();
-  gtk_widget_set_name (res_vruler, "res_vruler");
-  gtk_widget_show (res_vruler);
-  gtk_table_attach (GTK_TABLE (table3), res_vruler, 1, 2, 2, 3,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (GTK_EXPAND | GTK_FILL), 0, 0);
-  gtk_ruler_set_range (GTK_RULER (res_vruler), 0, 10, 9.69925, 10);
-
-  res_drawingarea = gtk_drawing_area_new ();
-  gtk_widget_set_name (res_drawingarea, "res_drawingarea");
-  gtk_widget_show (res_drawingarea);
-  gtk_table_attach (GTK_TABLE (table3), res_drawingarea, 2, 3, 2, 3,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (GTK_FILL), 0, 0);
-
-  label37 = gtk_label_new ("Secs");
-  gtk_widget_set_name (label37, "label37");
-  gtk_widget_show (label37);
-  gtk_table_attach (GTK_TABLE (table3), label37, 2, 3, 0, 1,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label37), GTK_JUSTIFY_CENTER);
-
-  label38 = gtk_label_new ("Mb");
-  gtk_widget_set_name (label38, "label38");
-  gtk_widget_show (label38);
-  gtk_table_attach (GTK_TABLE (table3), label38, 0, 1, 2, 3,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label38), GTK_JUSTIFY_CENTER);
-
-  label42 = gtk_label_new ("Residency");
-  gtk_widget_set_name (label42, "label42");
-  gtk_widget_show (label42);
-  gtk_frame_set_label_widget (GTK_FRAME (frame7), label42);
-
-  vbox5 = gtk_vbox_new (FALSE, 10);
-  gtk_widget_set_name (vbox5, "vbox5");
-  gtk_widget_show (vbox5);
-  gtk_box_pack_end (GTK_BOX (hbox1), vbox5, FALSE, FALSE, 0);
-
-  frame5 = gtk_frame_new (NULL);
-  gtk_widget_set_name (frame5, "frame5");
-  gtk_widget_show (frame5);
-  gtk_box_pack_start (GTK_BOX (vbox5), frame5, FALSE, TRUE, 0);
-
-  vbox6 = gtk_vbox_new (FALSE, 0);
-  gtk_widget_set_name (vbox6, "vbox6");
-  gtk_widget_show (vbox6);
-  gtk_container_add (GTK_CONTAINER (frame5), vbox6);
-  gtk_container_set_border_width (GTK_CONTAINER (vbox6), 5);
-
-  table1 = gtk_table_new (4, 3, FALSE);
-  gtk_widget_set_name (table1, "table1");
-  gtk_widget_show (table1);
-  gtk_box_pack_start (GTK_BOX (vbox6), table1, TRUE, TRUE, 0);
-  gtk_table_set_col_spacings (GTK_TABLE (table1), 7);
-
-  label12 = gtk_label_new ("Allocated");
-  gtk_widget_set_name (label12, "label12");
-  gtk_widget_show (label12);
-  gtk_table_attach (GTK_TABLE (table1), label12, 0, 1, 1, 2,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label12), GTK_JUSTIFY_RIGHT);
-  gtk_misc_set_alignment (GTK_MISC (label12), 1, 0.5);
-
-  label13 = gtk_label_new ("Live");
-  gtk_widget_set_name (label13, "label13");
-  gtk_widget_show (label13);
-  gtk_table_attach (GTK_TABLE (table1), label13, 0, 1, 0, 1,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label13), GTK_JUSTIFY_RIGHT);
-  gtk_misc_set_alignment (GTK_MISC (label13), 1, 0.5);
-
-  label14 = gtk_label_new ("Allocation Rate");
-  gtk_widget_set_name (label14, "label14");
-  gtk_widget_show (label14);
-  gtk_table_attach (GTK_TABLE (table1), label14, 0, 1, 3, 4,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label14), GTK_JUSTIFY_RIGHT);
-  gtk_misc_set_alignment (GTK_MISC (label14), 1, 0.5);
-
-  label15 = gtk_label_new ("\t\tFootprint");
-  gtk_widget_set_name (label15, "label15");
-  gtk_widget_show (label15);
-  gtk_table_attach (GTK_TABLE (table1), label15, 0, 1, 2, 3,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label15), GTK_JUSTIFY_RIGHT);
-  gtk_misc_set_alignment (GTK_MISC (label15), 1, 0.5);
-
-  label16 = gtk_label_new ("M/sec");
-  gtk_widget_set_name (label16, "label16");
-  gtk_widget_show (label16);
-  gtk_table_attach (GTK_TABLE (table1), label16, 2, 3, 3, 4,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label16), GTK_JUSTIFY_CENTER);
-
-  label17 = gtk_label_new ("M");
-  gtk_widget_set_name (label17, "label17");
-  gtk_widget_show (label17);
-  gtk_table_attach (GTK_TABLE (table1), label17, 2, 3, 2, 3,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_misc_set_alignment (GTK_MISC (label17), 7.45058e-09, 0.5);
-
-  label18 = gtk_label_new ("M");
-  gtk_widget_set_name (label18, "label18");
-  gtk_widget_show (label18);
-  gtk_table_attach (GTK_TABLE (table1), label18, 2, 3, 1, 2,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label18), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (label18), 7.45058e-09, 0.5);
-
-  label19 = gtk_label_new ("M");
-  gtk_widget_set_name (label19, "label19");
-  gtk_widget_show (label19);
-  gtk_table_attach (GTK_TABLE (table1), label19, 2, 3, 0, 1,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label19), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (label19), 7.45058e-09, 0.5);
-
-  live_label = gtk_label_new ("");
-  gtk_widget_set_name (live_label, "live_label");
-  gtk_widget_show (live_label);
-  gtk_table_attach (GTK_TABLE (table1), live_label, 1, 2, 0, 1,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (live_label), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (live_label), 1, 0.5);
-
-  allocated_label = gtk_label_new ("");
-  gtk_widget_set_name (allocated_label, "allocated_label");
-  gtk_widget_show (allocated_label);
-  gtk_table_attach (GTK_TABLE (table1), allocated_label, 1, 2, 1, 2,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (allocated_label), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (allocated_label), 1, 0.5);
-
-  footprint_label = gtk_label_new ("");
-  gtk_widget_set_name (footprint_label, "footprint_label");
-  gtk_widget_show (footprint_label);
-  gtk_table_attach (GTK_TABLE (table1), footprint_label, 1, 2, 2, 3,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (footprint_label), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (footprint_label), 1, 0.5);
-
-  alloc_rate_label = gtk_label_new ("");
-  gtk_widget_set_name (alloc_rate_label, "alloc_rate_label");
-  gtk_widget_show (alloc_rate_label);
-  gtk_table_attach (GTK_TABLE (table1), alloc_rate_label, 1, 2, 3, 4,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (alloc_rate_label), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (alloc_rate_label), 1, 0.5);
-
-  label43 = gtk_label_new ("Stats");
-  gtk_widget_set_name (label43, "label43");
-  gtk_widget_show (label43);
-  gtk_frame_set_label_widget (GTK_FRAME (frame5), label43);
-
-  frame9 = gtk_frame_new (NULL);
-  gtk_widget_set_name (frame9, "frame9");
-  gtk_widget_show (frame9);
-  gtk_box_pack_start (GTK_BOX (vbox5), frame9, FALSE, TRUE, 0);
-
-  table5 = gtk_table_new (9, 2, FALSE);
-  gtk_widget_set_name (table5, "table5");
-  gtk_widget_show (table5);
-  gtk_container_add (GTK_CONTAINER (frame9), table5);
-  gtk_container_set_border_width (GTK_CONTAINER (table5), 6);
-  gtk_table_set_col_spacings (GTK_TABLE (table5), 10);
-
-  label20 = gtk_label_new ("Running");
-  gtk_widget_set_name (label20, "label20");
-  gtk_widget_show (label20);
-  gtk_table_attach (GTK_TABLE (table5), label20, 0, 1, 0, 1,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label20), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (label20), 1, 0.5);
-
-  label21 = gtk_label_new ("Blocked on I/O (Read)");
-  gtk_widget_set_name (label21, "label21");
-  gtk_widget_show (label21);
-  gtk_table_attach (GTK_TABLE (table5), label21, 0, 1, 1, 2,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label21), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (label21), 1, 0.5);
-
-  label22 = gtk_label_new ("Blocked on MVar");
-  gtk_widget_set_name (label22, "label22");
-  gtk_widget_show (label22);
-  gtk_table_attach (GTK_TABLE (table5), label22, 0, 1, 3, 4,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label22), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (label22), 1, 0.5);
-
-  label24 = gtk_label_new ("Blocked on throwTo");
-  gtk_widget_set_name (label24, "label24");
-  gtk_widget_show (label24);
-  gtk_table_attach (GTK_TABLE (table5), label24, 0, 1, 4, 5,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label24), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (label24), 1, 0.5);
-
-  label26 = gtk_label_new ("Blocked on Black Hole");
-  gtk_widget_set_name (label26, "label26");
-  gtk_widget_show (label26);
-  gtk_table_attach (GTK_TABLE (table5), label26, 0, 1, 5, 6,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label26), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (label26), 1, 0.5);
-
-  label25 = gtk_label_new ("Sleeping");
-  gtk_widget_set_name (label25, "label25");
-  gtk_widget_show (label25);
-  gtk_table_attach (GTK_TABLE (table5), label25, 0, 1, 6, 7,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label25), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (label25), 1, 0.5);
-
-  label27 = gtk_label_new ("Blocked on I/O (Write)");
-  gtk_widget_set_name (label27, "label27");
-  gtk_widget_show (label27);
-  gtk_table_attach (GTK_TABLE (table5), label27, 0, 1, 2, 3,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label27), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (label27), 1, 0.5);
-
-  running_label = gtk_label_new ("label28");
-  gtk_widget_set_name (running_label, "running_label");
-  gtk_widget_show (running_label);
-  gtk_table_attach (GTK_TABLE (table5), running_label, 1, 2, 0, 1,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (running_label), GTK_JUSTIFY_CENTER);
-
-  blockread_label = gtk_label_new ("label29");
-  gtk_widget_set_name (blockread_label, "blockread_label");
-  gtk_widget_show (blockread_label);
-  gtk_table_attach (GTK_TABLE (table5), blockread_label, 1, 2, 1, 2,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (blockread_label), GTK_JUSTIFY_CENTER);
-
-  blockwrite_label = gtk_label_new ("label30");
-  gtk_widget_set_name (blockwrite_label, "blockwrite_label");
-  gtk_widget_show (blockwrite_label);
-  gtk_table_attach (GTK_TABLE (table5), blockwrite_label, 1, 2, 2, 3,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (blockwrite_label), GTK_JUSTIFY_CENTER);
-
-  blockmvar_label = gtk_label_new ("label31");
-  gtk_widget_set_name (blockmvar_label, "blockmvar_label");
-  gtk_widget_show (blockmvar_label);
-  gtk_table_attach (GTK_TABLE (table5), blockmvar_label, 1, 2, 3, 4,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (blockmvar_label), GTK_JUSTIFY_CENTER);
-
-  blockthrowto_label = gtk_label_new ("label32");
-  gtk_widget_set_name (blockthrowto_label, "blockthrowto_label");
-  gtk_widget_show (blockthrowto_label);
-  gtk_table_attach (GTK_TABLE (table5), blockthrowto_label, 1, 2, 4, 5,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (blockthrowto_label), GTK_JUSTIFY_CENTER);
-
-  blockbh_label = gtk_label_new ("label33");
-  gtk_widget_set_name (blockbh_label, "blockbh_label");
-  gtk_widget_show (blockbh_label);
-  gtk_table_attach (GTK_TABLE (table5), blockbh_label, 1, 2, 5, 6,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (blockbh_label), GTK_JUSTIFY_CENTER);
-
-  sleeping_label = gtk_label_new ("label34");
-  gtk_widget_set_name (sleeping_label, "sleeping_label");
-  gtk_widget_show (sleeping_label);
-  gtk_table_attach (GTK_TABLE (table5), sleeping_label, 1, 2, 6, 7,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (sleeping_label), GTK_JUSTIFY_CENTER);
-
-  hseparator1 = gtk_hseparator_new ();
-  gtk_widget_set_name (hseparator1, "hseparator1");
-  gtk_widget_show (hseparator1);
-  gtk_table_attach (GTK_TABLE (table5), hseparator1, 0, 1, 7, 8,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (GTK_EXPAND | GTK_FILL), 0, 0);
-
-  hseparator2 = gtk_hseparator_new ();
-  gtk_widget_set_name (hseparator2, "hseparator2");
-  gtk_widget_show (hseparator2);
-  gtk_table_attach (GTK_TABLE (table5), hseparator2, 1, 2, 7, 8,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (GTK_FILL), 0, 0);
-
-  label35 = gtk_label_new ("Total");
-  gtk_widget_set_name (label35, "label35");
-  gtk_widget_show (label35);
-  gtk_table_attach (GTK_TABLE (table5), label35, 0, 1, 8, 9,
-                    (GtkAttachOptions) (GTK_FILL),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (label35), GTK_JUSTIFY_CENTER);
-  gtk_misc_set_alignment (GTK_MISC (label35), 1, 0.5);
-
-  total_label = gtk_label_new ("label36");
-  gtk_widget_set_name (total_label, "total_label");
-  gtk_widget_show (total_label);
-  gtk_table_attach (GTK_TABLE (table5), total_label, 1, 2, 8, 9,
-                    (GtkAttachOptions) (0),
-                    (GtkAttachOptions) (0), 0, 0);
-  gtk_label_set_justify (GTK_LABEL (total_label), GTK_JUSTIFY_CENTER);
-
-  label44 = gtk_label_new ("Threads");
-  gtk_widget_set_name (label44, "label44");
-  gtk_widget_show (label44);
-  gtk_frame_set_label_widget (GTK_FRAME (frame9), label44);
-
-  frame6 = gtk_frame_new (NULL);
-  gtk_widget_set_name (frame6, "frame6");
-  gtk_widget_show (frame6);
-  gtk_box_pack_start (GTK_BOX (vbox5), frame6, FALSE, FALSE, 0);
-
-  vbox7 = gtk_vbox_new (FALSE, 10);
-  gtk_widget_set_name (vbox7, "vbox7");
-  gtk_widget_show (vbox7);
-  gtk_container_add (GTK_CONTAINER (frame6), vbox7);
-  gtk_container_set_border_width (GTK_CONTAINER (vbox7), 5);
-
-  vbox9 = gtk_vbox_new (FALSE, 0);
-  gtk_widget_set_name (vbox9, "vbox9");
-  gtk_widget_show (vbox9);
-  gtk_box_pack_start (GTK_BOX (vbox7), vbox9, TRUE, TRUE, 0);
-
-  cont_radio = gtk_radio_button_new_with_mnemonic (NULL, "Continuous");
-  gtk_widget_set_name (cont_radio, "cont_radio");
-  gtk_widget_show (cont_radio);
-  gtk_box_pack_start (GTK_BOX (vbox9), cont_radio, FALSE, FALSE, 0);
-  gtk_radio_button_set_group (GTK_RADIO_BUTTON (cont_radio), cont_radio_group);
-  cont_radio_group = gtk_radio_button_get_group (GTK_RADIO_BUTTON (cont_radio));
-  gtk_toggle_button_set_active (GTK_TOGGLE_BUTTON (cont_radio), TRUE);
-
-  stop_before_radio = gtk_radio_button_new_with_mnemonic (NULL, "Stop before GC");
-  gtk_widget_set_name (stop_before_radio, "stop_before_radio");
-  gtk_widget_show (stop_before_radio);
-  gtk_box_pack_start (GTK_BOX (vbox9), stop_before_radio, FALSE, FALSE, 0);
-  gtk_radio_button_set_group (GTK_RADIO_BUTTON (stop_before_radio), cont_radio_group);
-  cont_radio_group = gtk_radio_button_get_group (GTK_RADIO_BUTTON (stop_before_radio));
-
-  stop_after_radio = gtk_radio_button_new_with_mnemonic (NULL, "Stop after GC");
-  gtk_widget_set_name (stop_after_radio, "stop_after_radio");
-  gtk_widget_show (stop_after_radio);
-  gtk_box_pack_start (GTK_BOX (vbox9), stop_after_radio, FALSE, FALSE, 0);
-  gtk_radio_button_set_group (GTK_RADIO_BUTTON (stop_after_radio), cont_radio_group);
-  cont_radio_group = gtk_radio_button_get_group (GTK_RADIO_BUTTON (stop_after_radio));
-
-  stop_both_radio = gtk_radio_button_new_with_mnemonic (NULL, "Stop before & after GC");
-  gtk_widget_set_name (stop_both_radio, "stop_both_radio");
-  gtk_widget_show (stop_both_radio);
-  gtk_box_pack_start (GTK_BOX (vbox9), stop_both_radio, FALSE, FALSE, 0);
-  gtk_radio_button_set_group (GTK_RADIO_BUTTON (stop_both_radio), cont_radio_group);
-  cont_radio_group = gtk_radio_button_get_group (GTK_RADIO_BUTTON (stop_both_radio));
-
-  vbox8 = gtk_vbox_new (FALSE, 0);
-  gtk_widget_set_name (vbox8, "vbox8");
-  gtk_widget_show (vbox8);
-  gtk_box_pack_start (GTK_BOX (vbox7), vbox8, FALSE, FALSE, 0);
-
-  stop_but = gtk_button_new_with_mnemonic ("Stop");
-  gtk_widget_set_name (stop_but, "stop_but");
-  gtk_widget_show (stop_but);
-  gtk_box_pack_start (GTK_BOX (vbox8), stop_but, FALSE, FALSE, 0);
-
-  continue_but = gtk_button_new_with_mnemonic ("Continue");
-  gtk_widget_set_name (continue_but, "continue_but");
-  gtk_widget_show (continue_but);
-  gtk_box_pack_start (GTK_BOX (vbox8), continue_but, FALSE, FALSE, 0);
-
-  label45 = gtk_label_new ("Updates");
-  gtk_widget_set_name (label45, "label45");
-  gtk_widget_show (label45);
-  gtk_frame_set_label_widget (GTK_FRAME (frame6), label45);
-
-  quit_but = gtk_button_new_with_mnemonic ("Quit");
-  gtk_widget_set_name (quit_but, "quit_but");
-  gtk_widget_show (quit_but);
-  gtk_box_pack_end (GTK_BOX (vbox5), quit_but, FALSE, FALSE, 0);
-
-  statusbar = gtk_statusbar_new ();
-  gtk_widget_set_name (statusbar, "statusbar");
-  gtk_widget_show (statusbar);
-  gtk_box_pack_start (GTK_BOX (vbox1), statusbar, FALSE, FALSE, 0);
-
-  g_signal_connect ((gpointer) cont_radio, "clicked",
-                    G_CALLBACK (on_cont_radio_clicked),
-                    NULL);
-  g_signal_connect ((gpointer) stop_before_radio, "clicked",
-                    G_CALLBACK (on_stop_before_radio_clicked),
-                    NULL);
-  g_signal_connect ((gpointer) stop_after_radio, "clicked",
-                    G_CALLBACK (on_stop_after_radio_clicked),
-                    NULL);
-  g_signal_connect ((gpointer) stop_both_radio, "clicked",
-                    G_CALLBACK (on_stop_both_radio_clicked),
-                    NULL);
-  g_signal_connect ((gpointer) stop_but, "clicked",
-                    G_CALLBACK (on_stop_but_clicked),
-                    NULL);
-  g_signal_connect ((gpointer) continue_but, "clicked",
-                    G_CALLBACK (on_continue_but_clicked),
-                    NULL);
-  g_signal_connect ((gpointer) quit_but, "clicked",
-                    G_CALLBACK (on_quit_but_clicked),
-                    NULL);
-
-  /* Store pointers to all widgets, for use by lookup_widget(). */
-  GLADE_HOOKUP_OBJECT_NO_REF (GHC_Front_Panel, GHC_Front_Panel, "GHC_Front_Panel");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, vbox1, "vbox1");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, hbox1, "hbox1");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, vbox4, "vbox4");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, frame3, "frame3");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, hbox3, "hbox3");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label40, "label40");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, map_ruler, "map_ruler");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, memmap, "memmap");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label1, "label1");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, frame8, "frame8");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, vbox14, "vbox14");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, table4, "table4");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, gen_ruler, "gen_ruler");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, gen_hbox, "gen_hbox");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, generations, "generations");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label39, "label39");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label41, "label41");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, frame7, "frame7");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, table3, "table3");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, res_hruler, "res_hruler");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, res_vruler, "res_vruler");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, res_drawingarea, "res_drawingarea");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label37, "label37");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label38, "label38");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label42, "label42");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, vbox5, "vbox5");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, frame5, "frame5");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, vbox6, "vbox6");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, table1, "table1");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label12, "label12");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label13, "label13");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label14, "label14");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label15, "label15");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label16, "label16");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label17, "label17");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label18, "label18");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label19, "label19");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, live_label, "live_label");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, allocated_label, "allocated_label");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, footprint_label, "footprint_label");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, alloc_rate_label, "alloc_rate_label");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label43, "label43");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, frame9, "frame9");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, table5, "table5");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label20, "label20");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label21, "label21");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label22, "label22");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label24, "label24");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label26, "label26");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label25, "label25");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label27, "label27");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, running_label, "running_label");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, blockread_label, "blockread_label");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, blockwrite_label, "blockwrite_label");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, blockmvar_label, "blockmvar_label");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, blockthrowto_label, "blockthrowto_label");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, blockbh_label, "blockbh_label");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, sleeping_label, "sleeping_label");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, hseparator1, "hseparator1");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, hseparator2, "hseparator2");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label35, "label35");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, total_label, "total_label");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label44, "label44");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, frame6, "frame6");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, vbox7, "vbox7");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, vbox9, "vbox9");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, cont_radio, "cont_radio");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, stop_before_radio, "stop_before_radio");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, stop_after_radio, "stop_after_radio");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, stop_both_radio, "stop_both_radio");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, vbox8, "vbox8");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, stop_but, "stop_but");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, continue_but, "continue_but");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, label45, "label45");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, quit_but, "quit_but");
-  GLADE_HOOKUP_OBJECT (GHC_Front_Panel, statusbar, "statusbar");
-
-  return GHC_Front_Panel;
-}
-
diff --git a/ghc/rts/VisWindow.h b/ghc/rts/VisWindow.h
deleted file mode 100644
index c646c40c02..0000000000
--- a/ghc/rts/VisWindow.h
+++ /dev/null
@@ -1,5 +0,0 @@
-/*
- * DO NOT EDIT THIS FILE - it is generated by Glade.
- */
-
-GtkWidget* create_GHC_Front_Panel (void);
diff --git a/ghc/rts/Weak.c b/ghc/rts/Weak.c
deleted file mode 100644
index f010395221..0000000000
--- a/ghc/rts/Weak.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-1999
- *
- * Weak pointers / finalizers
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#define COMPILING_RTS_MAIN
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "SchedAPI.h"
-#include "RtsFlags.h"
-#include "Weak.h"
-#include "Storage.h"
-#include "Schedule.h"
-#include "Prelude.h"
-#include "RtsAPI.h"
-
-StgWeak *weak_ptr_list;
-
-/*
- * scheduleFinalizers() is called on the list of weak pointers found
- * to be dead after a garbage collection.  It overwrites each object
- * with DEAD_WEAK, and creates a new thread to run the pending finalizers.
- *
- * This function is called just after GC.  The weak pointers on the
- * argument list are those whose keys were found to be not reachable,
- * however the value and finalizer fields have by now been marked live.
- * The weak pointer object itself may not be alive - i.e. we may be
- * looking at either an object in from-space or one in to-space.  It
- * doesn't really matter either way.
- *
- * Pre-condition: sched_mutex _not_ held.
- */
-
-void
-scheduleFinalizers(Capability *cap, StgWeak *list)
-{
-    StgWeak *w;
-    StgTSO *t;
-    StgMutArrPtrs *arr;
-    nat n;
-
-    // count number of finalizers, and kill all the weak pointers first...
-    n = 0;
-    for (w = list; w; w = w->link) { 
-
-	// Better not be a DEAD_WEAK at this stage; the garbage
-	// collector removes DEAD_WEAKs from the weak pointer list.
-	ASSERT(w->header.info != &stg_DEAD_WEAK_info);
-
-	if (w->finalizer != &stg_NO_FINALIZER_closure) {
-	    n++;
-	}
-
-#ifdef PROFILING
-        // A weak pointer is inherently used, so we do not need to call
-        // LDV_recordDead().
-	//
-        // Furthermore, when PROFILING is turned on, dead weak
-        // pointers are exactly as large as weak pointers, so there is
-        // no need to fill the slop, either.  See stg_DEAD_WEAK_info
-        // in StgMiscClosures.hc.
-#endif
-	SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs);
-    }
-	
-    // No finalizers to run?
-    if (n == 0) return;
-
-    IF_DEBUG(weak,debugBelch("weak: batching %d finalizers\n", n));
-
-    arr = (StgMutArrPtrs *)allocateLocal(cap, sizeofW(StgMutArrPtrs) + n);
-    TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), n, 0);
-    SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_info, CCS_SYSTEM);
-    arr->ptrs = n;
-
-    n = 0;
-    for (w = list; w; w = w->link) {
-	if (w->finalizer != &stg_NO_FINALIZER_closure) {
-	    arr->payload[n] = w->finalizer;
-	    n++;
-	}
-    }
-
-    t = createIOThread(cap, 
-		       RtsFlags.GcFlags.initialStkSize, 
-		       rts_apply(cap,
-			   rts_apply(cap,
-			       (StgClosure *)runFinalizerBatch_closure,
-			       rts_mkInt(cap,n)), 
-			   (StgClosure *)arr)
-	);
-    scheduleThread(cap,t);
-}
diff --git a/ghc/rts/Weak.h b/ghc/rts/Weak.h
deleted file mode 100644
index ba8c1ca913..0000000000
--- a/ghc/rts/Weak.h
+++ /dev/null
@@ -1,17 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Weak pointers / finalizers
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef WEAK_H
-#define WEAK_H
-
-#include "Capability.h"
-
-void scheduleFinalizers(Capability *cap, StgWeak *w);
-void markWeakList(void);
-
-#endif
diff --git a/ghc/rts/dotnet/Invoke.c b/ghc/rts/dotnet/Invoke.c
deleted file mode 100644
index 585dcacaad..0000000000
--- a/ghc/rts/dotnet/Invoke.c
+++ /dev/null
@@ -1,1081 +0,0 @@
-/*
- * C callable bridge to the .NET object model
- *
- * Managed C++ is used to access the .NET object model via
- * System.Reflection. Here we provide C callable functions
- * to that functionality, which we then export via a COM
- * component.
- *
- * Note: the _only_ reason why we're going via COM and not simply
- * exposing the required via some DLL entry points, is that COM
- * gives us location independence (i.e., the RTS doesn't need
- * be told where this interop layer resides in order to hoik
- * it in, the CLSID suffices (provided the component has been
- * registered, of course.)) It is a bit tiresome to have play
- * by the .NET COM Interop's rules as regards argument arrays,
- * so we may want to revisit this issue at some point.
- * 
- * [ But why not simply use MC++ and provide C-callable entry
- *   points to the relevant functionality, and avoid COM interop
- *   alltogether? Because we have to be able to (statically)
- *   link with gcc-compiled code, and linking MC++ and gcc-compiled
- *   object files doesn't work.]
- *
- * Note: you need something never than gcc-2.95 to compile this
- *       code (I'm using gcc-3.2, which comes with mingw-2).
- */
-#define _WIN32_DCOM
-#define COBJMACROS
-#include <stdio.h>
-#include <stdlib.h>
-#include <wtypes.h>
-#ifndef _MSC_VER
-#include <oaidl.h>
-#include <objbase.h>
-#include <oleauto.h>
-# if defined(COBJMACROS) && !defined(_MSC_VER)
-#define IErrorInfo_QueryInterface(T,r,O) (T)->lpVtbl->QueryInterface(T,r,O)
-#define IErrorInfo_AddRef(T) (T)->lpVtbl->AddRef(T)
-#define IErrorInfo_Release(T) (T)->lpVtbl->Release(T)
-#define IErrorInfo_GetSource(T,pbstr) (T)->lpVtbl->GetSource(T,pbstr)
-#define IErrorInfo_GetDescription(T,pbstr) (T)->lpVtbl->GetDescription(T,pbstr)
-
-#define ISupportErrorInfo_QueryInterface(T,r,O) (T)->lpVtbl->QueryInterface(T,r,O)
-#define ISupportErrorInfo_AddRef(T) (T)->lpVtbl->AddRef(T)
-#define ISupportErrorInfo_Release(T) (T)->lpVtbl->Release(T)
-#define ISupportErrorInfo_InterfaceSupportsErrorInfo(T,iid) (T)->lpVtbl->InterfaceSupportsErrorInfo(T,iid)
-# endif
-#endif
-#include "DNInvoke.h"
-#define WANT_UUID_DECLS
-#include "InvokerClient.h"
-#include "Dotnet.h"
-
-/* Local prototypes */
-static void genError( IUnknown* pUnk,
-		      HRESULT hr,
-		      char* loc,
-		      char** pErrMsg);
-static int  startBridge(char**);
-static int  fromVariant
-                    ( DotnetType resTy, 
-		      VARIANT* pVar, 
-		      void* res,
-		      char** pErrMsg);
-static VARIANT* toVariant ( DotnetArg* p );
-
-/* Pointer to .NET COM component instance; instantiated on demand. */
-static InvokeBridge* pBridge = NULL;
-
-/* convert a char* to a BSTR, copied from the HDirect comlib/ sources */
-static
-HRESULT
-stringToBSTR( /*[in,ptr]*/const char* pstrz
-	    , /*[out]*/ BSTR* pbstr
-	    )
-{
-  int i;
-
-  if (!pbstr) {
-    return E_FAIL;
-  } else {
-    *pbstr = NULL;
-  }
-  if (!pstrz) {
-    return S_OK;
-  }
-
-  i = MultiByteToWideChar(CP_ACP, 0, pstrz, -1, NULL, 0);
-  if ( i < 0 ) {
-    return E_FAIL;
-  }
-  *pbstr = SysAllocStringLen(NULL,i-1);
-  if (*pbstr != NULL) {
-    MultiByteToWideChar(CP_ACP, 0, pstrz, -1, *pbstr, i-1); 
-    //    (*pbstr)[i]=0;
-    return S_OK;
-  } else {
-    return E_FAIL;
-  }
-}
-
-static
-char*
-bstrToString( BSTR bstr )
-{
-    int  i,len;
-    char *res;
-    int  blen;
-
-    if (!bstr) {
-	return NULL;
-    }
-    
-    blen =  SysStringLen(bstr);
-    
-    /* pass in NULL for the multi-byte arg in order to compute length first */
-    len = WideCharToMultiByte(CP_ACP, 0, bstr, blen,
-			      NULL, 0, NULL, NULL);
-    if (len == 0) return NULL;
-    
-    /* Allocate string of required length. */
-    res = (char*)malloc(sizeof(char) * (len + 1));
-    if (!res) return NULL;
-    
-    i = WideCharToMultiByte(CP_ACP, 0, bstr, blen,
-			    res, (len+1), NULL, NULL);
-			    
-    /* Poor error handling to map this to NULL. */
-    if ( i == 0 ) return NULL;
-
-    /* Terminate and return */
-    res[i] = '\0';
-    return res;
-}
-
-static
-void
-freeArgs ( SAFEARRAY* psa )
-{
-  /* The argument SAFEARRAYs contain dynamically allocated
-   * VARIANTs. Release the VARIANT contents and its memory here.
-   */
-  long lb,ub;
-  int i;
-  HRESULT hr;
-  VARIANT *pv = NULL;
-  
-  hr = SafeArrayGetLBound(psa, 1, &lb);
-  if (FAILED(hr)) {
-    fprintf(stderr, "freeArgs: failed fetching lower bound\n");
-    SafeArrayDestroy(psa);
-    return;
-  }
-  hr = SafeArrayGetUBound(psa, 1, &ub);
-  if (FAILED(hr)) {
-    fprintf(stderr, "freeArgs: failed fetching upper bound\n");
-    SafeArrayDestroy(psa);
-    return;
-  }
-  for ( i = 0; i < (ub - lb); i++ ) {
-    hr = SafeArrayGetElement(psa,(long*)&i,(void*)pv);
-    if (FAILED(hr)) {
-      fprintf(stderr, "freeArgs: unable to fetch element %d\n", i);
-      SafeArrayDestroy(psa);
-      return;
-    }
-    VariantClear(pv);
-    free(pv);
-  }
-  SafeArrayDestroy(psa);
-}
-
-static
-SAFEARRAY*
-marshalArgs ( DotnetArg*   args,
-	      unsigned int n_args )
-{
-  SAFEARRAY *psa;
-  SAFEARRAYBOUND rgsabound[1];
-  int i;
-  long idxArr[1];
-  HRESULT hr;
-  VARIANT* var;
-
-  rgsabound[0].lLbound   = 0;
-  rgsabound[0].cElements = n_args;
-  psa = SafeArrayCreate(VT_VARIANT, 1, rgsabound);
-  
-  for(i=0;i < n_args; i++) {
-    idxArr[0] = i;
-    var = toVariant(&args[i]);
-    hr = SafeArrayPutElement(psa, idxArr, (void*)var);
-  }
-  return psa;
-}
-
-/* 
- * ***** Accessing the .NET object model *****
- *
- * General remarks:
- *
- *   - the functions report error conditions via their return value; a char*.
- *     If NULL, the call was successful. If not, the returned string 
- *     contains the (dynamically allocated) error message. 
- * 
- *     This unorthodox calling convetion is used to simplify the task
- *     of interfacing to these funs from GHC-generated code.
- */
-
-/*
- * Function: DN_invokeStatic()
- *
- * Given assembly and fully-qualified name of a static .NET method,
- * invoke it using the supplied arguments.
- *
- * Returns NULL on success, pointer to error message if an error.
- *
- */
-char*
-DN_invokeStatic ( char       *assemName,
-		  char       *methName,
-		  DotnetArg  *args,
-		  int        n_args,
-		  DotnetType resultTy,
-		  void       *res)
-{
-    SAFEARRAY* psa;
-    VARIANT    result;
-    HRESULT    hr;
-    BSTR       b_assemName;
-    BSTR       b_methName;
-    char*      errMsg = NULL;
-    
-    if (!pBridge && !startBridge(&errMsg)) {
-      return errMsg;
-    }
-    
-    /* Package up arguments */
-    psa = marshalArgs(args, n_args);
-    VariantInit(&result);
-    
-    hr = stringToBSTR(assemName, &b_assemName);
-    hr = stringToBSTR(methName, &b_methName);
-
-    hr = InvokeBridge_InvokeStaticMethod(pBridge,
-					 b_assemName,
-					 b_methName,
-					 psa,
-					 &result);
-    SysFreeString(b_assemName);
-    SysFreeString(b_methName);
-    if (FAILED(hr)) {
-	genError((IUnknown*)pBridge, hr, "DInvoke.invokeStatic", &errMsg);
-	return errMsg;
-    }
-   
-    fromVariant(resultTy, &result, res, &errMsg);
-    freeArgs(psa);
-  
-    return errMsg;
-}
-
-/*
- * Function: DN_invokeMethod()
- *
- * Given method name and arguments, invoke .NET method on an object.
- * The object ref / this-pointer is passed in as the last argument.
- *
- * Returns NULL on success, pointer to error message if an error.
- *
- */
-char*
-DN_invokeMethod ( char       *clsAndMethName,
-		  DotnetArg  *args,
-		  int        n_args,
-		  DotnetType resultTy,
-		  void       *res)
-{
-    SAFEARRAY* psa;
-    VARIANT    result;
-    HRESULT    hr;
-    char*      methName;
-    BSTR       b_methName;
-    char*      errMsg = NULL;
-    VARIANT    *thisPtr;
-    
-    if (!pBridge && !startBridge(&errMsg)) {
-      return errMsg;
-    }
-    
-    if (n_args <= 0) {
-      genError(NULL, 0x0, "Invoke.invokeMethod - missing this pointer", &errMsg);
-      return errMsg;
-    }
-    
-    /* The this-pointer is last */
-    thisPtr = toVariant(&args[n_args-1]);
-
-    /* Package up arguments */
-    psa = marshalArgs(args, n_args-1);
-    VariantInit(&result);
-    
-    /* If the user has qualified method with class, ignore the class bit. */
-    if ( (methName = strrchr(clsAndMethName, '.')) == NULL) {
-      methName = clsAndMethName;
-    } else {
-      /* Skip past '.' */
-      methName++;
-    }
-    
-    hr = stringToBSTR(methName, &b_methName);
-    hr = InvokeBridge_InvokeMethod(pBridge,
-				   *thisPtr,
-				   b_methName,
-				   psa,
-				   &result);
-    SysFreeString(b_methName);
-    if (FAILED(hr)) {
-	genError((IUnknown*)pBridge, hr, "Invoke.invokeMethod", &errMsg);
-	return errMsg;
-    }
-    
-    fromVariant(resultTy, &result, res, &errMsg);
-    freeArgs(psa);
-  
-    return errMsg;
-}
-
-/*
- * Function: DN_getField()
- *
- * Given a field name and an object pointer, read a field value.
- * The object ref / this-pointer is passed in as the last argument.
- *
- * Returns NULL on success, pointer to error message if an error.
- *
- */
-char*
-DN_getField ( char       *clsAndMethName,
-	      DotnetArg  *args,
-	      int        n_args,
-	      DotnetType resultTy,
-	      void       *res)
-{
-    VARIANT    result;
-    HRESULT    hr;
-    char*      methName;
-    BSTR       b_methName;
-    char*      errMsg = NULL;
-    VARIANT    *thisPtr;
-    
-    if (!pBridge && !startBridge(&errMsg)) {
-      return errMsg;
-    }
-    
-    if (n_args <= 0) {
-      genError(NULL, 0x0, "Invoke.getField - missing this pointer", &errMsg);
-      return errMsg;
-    }
-    
-    /* The this-pointer is last */
-    thisPtr = toVariant(&args[n_args-1]);
-    VariantInit(&result);
-    
-    /* If the user has qualified method with class, ignore the class bit. */
-    if ( (methName = strrchr(clsAndMethName, '.')) == NULL) {
-      methName = clsAndMethName;
-    } else {
-      /* Skip past '.' */
-      methName++;
-    }
-    
-    hr = stringToBSTR(methName, &b_methName);
-    hr = InvokeBridge_GetField(pBridge,
-			       *thisPtr,
-			       b_methName,
-			       &result);
-    SysFreeString(b_methName);
-    if (FAILED(hr)) {
-	genError((IUnknown*)pBridge, hr, "Invoke.getField", &errMsg);
-	return errMsg;
-    }
-    
-    fromVariant(resultTy, &result, res, &errMsg);
-    return errMsg;
-}
-
-/*
- * Function: DN_setField()
- *
- * Given field name, a value and an object reference, set the field value of
- * an object.
- * The object ref / this-pointer is passed in as the last argument.
- *
- * Returns NULL on success, pointer to error message if an error.
- *
- */
-char*
-DN_setField ( char       *clsAndMethName,
-	      DotnetArg  *args,
-	      int        n_args,
-	      /* next two args are ignored */
-	      DotnetType resultTy,
-	      void       *res)
-{
-    HRESULT    hr;
-    char*      methName;
-    BSTR       b_methName;
-    char*      errMsg = NULL;
-    VARIANT    *thisPtr;
-    VARIANT    *pVal;
-
-    if (!pBridge && !startBridge(&errMsg)) {
-      return errMsg;
-    }
-    
-    if (n_args != 2) {
-      genError(NULL, 0x0, "Invoke.setField - missing this pointer", &errMsg);
-      return errMsg;
-    }
-    
-    /* The this-pointer is last */
-    thisPtr = toVariant(&args[1]);
-
-    /* Package up arguments */
-    pVal = toVariant(&args[0]);
-    
-    /* If the user has qualified method with class, ignore the class bit. */
-    if ( (methName = strrchr(clsAndMethName, '.')) == NULL) {
-      methName = clsAndMethName;
-    } else {
-      /* Skip past '.' */
-      methName++;
-    }
-    
-    hr = stringToBSTR(methName, &b_methName);
-    hr = InvokeBridge_SetField(pBridge,
-			       *thisPtr,
-			       b_methName,
-			       *pVal);
-    SysFreeString(b_methName);
-    VariantClear(pVal);
-    free(pVal);
-    free(thisPtr);
-
-    if (FAILED(hr)) {
-	genError((IUnknown*)pBridge, hr, "Invoke.setField", &errMsg);
-	return errMsg;
-    }
-    return errMsg;
-}
-
-
-/*
- * Function: DN_createObject()
- *
- * Given assembly and fully-qualified name of a type,
- * invoke its (possibly parameterised) constructor.
- *
- * Returns NULL on success, pointer to error message if an error.
- *
- */
-char*
-DN_createObject ( char       *assemName,
-		  char       *methName,
-		  DotnetArg  *args,
-		  int        n_args,
-		  DotnetType resultTy,
-		  void       *res)
-{
-    SAFEARRAY* psa;
-    VARIANT    result;
-    HRESULT    hr;
-    BSTR       b_assemName;
-    BSTR       b_methName;
-    char*      errMsg = NULL;
-    
-    if (!pBridge && !startBridge(&errMsg)) {
-      return errMsg;
-    }
-    
-    /* Package up arguments */
-    psa = marshalArgs(args, n_args);
-    VariantInit(&result);
-    
-    hr = stringToBSTR(assemName, &b_assemName);
-    hr = stringToBSTR(methName, &b_methName);
-
-    hr = InvokeBridge_CreateObject(pBridge,
-				   b_assemName,
-				   b_methName,
-				   psa,
-				   &result);
-    SysFreeString(b_assemName);
-    SysFreeString(b_methName);
-    if (FAILED(hr)) {
-	genError((IUnknown*)pBridge, hr, "DN_createObject", &errMsg);
-	return errMsg;
-    }
-    
-    fromVariant(resultTy, &result, res, &errMsg);
-    freeArgs(psa);
-  
-    return errMsg;
-}
-
-/*
- * Function: DN_getStatic()
- *
- * Given assembly and fully-qualified field name, fetch value of static
- * field.
- *
- * Returns NULL on success, pointer to error message if an error.
- *
- */
-char*
-DN_getStatic ( char       *assemName,
-	       char       *fieldClsName,
-	       /* the next two args are ignored */
-	       DotnetArg  *args,
-	       int        n_args,
-	       DotnetType resultTy,
-	       void       *res)
-{
-    VARIANT    result;
-    HRESULT    hr;
-    BSTR       b_assemName;
-    BSTR       b_clsName;
-    BSTR       b_fieldName;
-    char*      errMsg = NULL;
-    char*      fieldName;
-    char*      clsName = fieldName;
-    
-    if (!pBridge && !startBridge(&errMsg)) {
-      return errMsg;
-    }
-    
-    fieldName = (char*)malloc(sizeof(char) * (strlen(fieldClsName) + 1));
-    strcpy(fieldName, fieldClsName);
-    clsName = fieldName;
-    
-    if (( fieldName = strrchr(fieldName, '.')) == NULL ) {
-      genError((IUnknown*)pBridge, 0x0, "Invoke.getStatic - malformed field spec", &errMsg);
-      return errMsg;
-    }
-    *fieldName = '\0';
-    fieldName++;
-    
-    VariantInit(&result);
-    
-    hr = stringToBSTR(assemName, &b_assemName);
-    hr = stringToBSTR(fieldName, &b_fieldName);
-    hr = stringToBSTR(clsName, &b_clsName);
-    /* ToDo: honour assembly spec */
-    hr = InvokeBridge_GetStaticField(pBridge,
-				     b_clsName,
-				     b_fieldName,
-				     &result);
-    SysFreeString(b_assemName);
-    SysFreeString(b_clsName);
-    SysFreeString(b_fieldName);
-    if (FAILED(hr)) {
-	genError((IUnknown*)pBridge, hr, "Invoke.getStatic", &errMsg);
-	return errMsg;
-    }
-    fromVariant(resultTy, &result, res, &errMsg);
-  
-    return errMsg;
-}
-
-/*
- * Function: DN_setStatic()
- *
- * Given assembly and fully-qualified field name, set value of static
- * field.
- *
- * Returns NULL on success, pointer to error message if an error.
- *
- */
-char*
-DN_setStatic ( char       *assemName,
-	       char       *fieldClsName,
-	       DotnetArg  *args,
-	       int        n_args,
-	       /* the next two args are ignored */
-	       DotnetType resultTy,
-	       void       *res)
-{
-    VARIANT    result;
-    VARIANT    *pVal;
-    HRESULT    hr;
-    BSTR       b_assemName;
-    BSTR       b_clsName;
-    BSTR       b_fieldName;
-    char*      errMsg = NULL;
-    char*      fieldName;
-    char*      clsName = fieldName;
-    
-    if (!pBridge && !startBridge(&errMsg)) {
-      return errMsg;
-    }
-    
-    fieldName = (char*)malloc(sizeof(char) * (strlen(fieldClsName) + 1));
-    strcpy(fieldName, fieldClsName);
-    clsName = fieldName;
-    
-    if (( fieldName = strrchr(fieldName, '.')) == NULL ) {
-      genError((IUnknown*)pBridge, 0x0, "Invoke.setStatic - malformed field spec", &errMsg);
-      return errMsg;
-    }
-    *fieldName = '\0';
-    fieldName++;
-    
-    pVal = toVariant(&args[0]);
-    VariantInit(&result);
-    
-    hr = stringToBSTR(assemName, &b_assemName);
-    hr = stringToBSTR(fieldName, &b_fieldName);
-    hr = stringToBSTR(clsName, &b_clsName);
-    /* ToDo: honour assembly spec */
-    hr = InvokeBridge_SetStaticField(pBridge,
-				     b_clsName,
-				     b_fieldName,
-				     *pVal);
-    SysFreeString(b_assemName);
-    SysFreeString(b_clsName);
-    SysFreeString(b_fieldName);
-    VariantClear(pVal);
-    free(pVal);
-    if (FAILED(hr)) {
-	genError((IUnknown*)pBridge, hr, "Invoke.setStatic", &errMsg);
-	return errMsg;
-    }
-    fromVariant(resultTy, &result, res, &errMsg);
-  
-    return errMsg;
-}
-
-
-
-
-/*
- * Function: startBridge(pErrMsg)
- *
- * Instantiates an InvokeBridge component, which is then
- * used to interact with the .NET world.
- *
- * If the component isn't available locally, zero is returned.
- * Otherwise, 1.
- */
-static
-int
-startBridge(char** pErrMsg)
-{
-    HRESULT   hr;
-    IUnknown *pUnk;
-
-    hr = CoInitializeEx(NULL, COINIT_APARTMENTTHREADED);
-    if (FAILED(hr)) {
-	genError(NULL, hr, "DInvoke.createBridge.CoInitializeEx", pErrMsg);
-	return FALSE;
-    }
-
-    hr = CoCreateInstance( &CLSID_InvokeBridge,
-			   NULL,
-			   CLSCTX_INPROC_SERVER,
-			   &IID_IUnknown,
-			   (void**)&pUnk);
-    if (FAILED(hr)) {
-	genError(NULL, hr, "DInvoke.createBridge.CoCreateInstance", pErrMsg);
-	return 0;
-    }
-    
-    hr = IUnknown_QueryInterface(pUnk, &IID_InvokeBridge, (void**)&pBridge);
-    IUnknown_Release(pUnk);
-    if (FAILED(hr)) {
-	genError(pUnk, hr, "DInvoke.createBridge.QueryInterface.InvokeBridge", pErrMsg);
-	return 0;
-    }
-    
-    return 1;
-}
-
-/*
- * Function: stopBridge()
- *
- * Releases the InvokeBridge object and closes the COM library.
- * 
- */
-void
-stopDotnetBridge()
-{
-    if (pBridge) {
-	InvokeBridge_Release(pBridge);
-	pBridge = NULL;
-	CoUninitialize();
-    }
-    /* Match up the call to CoInitializeEx() in startBridge(). */
-}
-
-/*
- * Function: genError()
- *
- * Construct a string describing an error condition given
- * an HRESULT and a location. 
- * 
- * If an interface pointer is passed in via the first arg, 
- * attempts are made to get at richer error information through
- * the IErrorInfo interface. (Note: we don't currently look for
- * the _Exception interface for even more detailed info.)
- *
- */
-#define LOCATION_HDR "Location: "
-#define HRESULT_HDR  "HRESULT: "
-#define SOURCE_HDR   "Source: "
-#define DESCR_HDR    "Description: "
-#define NEWLINE_EXTRA 3
-
-static
-void
-genError(IUnknown* pUnk,
-	 HRESULT err,
-	 char* loc,
-	 char** pErrMsg)
-{
-  HRESULT hr;
-  HRESULT invoke_hr = err;
-  char*   invoke_src   = NULL;
-  char*   invoke_descr = NULL;
-  char*   buf;
-  int     bufLen;
-  
-  /* If an interface pointer has been supplied, look for
-   * IErrorInfo in order to get more detailed information
-   * on the failure.
-   *
-   * The CLR's .NET COM Interop implementation does provide
-   * IErrorInfo, so we're not really clutching at straws here..
-   *
-   * Note: CLR also reflects .NET exceptions via the _Exception*
-   * interface..
-   *
-   */
-  if (pUnk) {
-    ISupportErrorInfo *pSupp;
-    IErrorInfo        *pErrInfo;
-    BSTR src   = NULL;
-    BSTR descr = NULL;
-
-    hr = IUnknown_QueryInterface(pUnk, 
-				 &IID_ISupportErrorInfo,
-				 (void**)&pSupp);
-    if ( SUCCEEDED(hr) ) {
-      hr = ISupportErrorInfo_InterfaceSupportsErrorInfo(pSupp,
-							&IID_InvokeBridge);
-      if ( SUCCEEDED(hr) ) {
-	hr = GetErrorInfo(0,&pErrInfo);
-	if ( SUCCEEDED(hr) ) {
-	  IErrorInfo_GetSource(pErrInfo,&src);
-	  IErrorInfo_GetDescription(pErrInfo,&descr);
-	  invoke_src   = bstrToString(src);
-	  invoke_descr = bstrToString(descr);
-
-	  IErrorInfo_Release(pErrInfo);
-	  if (src)   { SysFreeString(src);   src = NULL;   }
-	  if (descr) { SysFreeString(descr); descr = NULL; }
-	}
-	ISupportErrorInfo_Release(pSupp);
-      }
-    }
-  }
-  /* Putting it all together.. */
-  bufLen  = sizeof(LOCATION_HDR) + strlen(loc) + NEWLINE_EXTRA +
-            sizeof(HRESULT_HDR)  + 16 + NEWLINE_EXTRA + 
-            sizeof(SOURCE_HDR)   + (invoke_src ? strlen(invoke_src) : 16) + NEWLINE_EXTRA +
-            sizeof(DESCR_HDR)    + (invoke_descr ? strlen(invoke_descr) : 16) + NEWLINE_EXTRA;
-  buf = (char*) malloc(sizeof(char) * (bufLen + 1));
-  if (!buf) {
-    fprintf(stderr, "Unable to allocate %d for error message", (bufLen + 1));
-    *pErrMsg = NULL;
-    return;
-  }
-    
-  _snprintf(buf, bufLen, "%s%s\n%s0x%08x\n%s%s\n%s%s",
-	   LOCATION_HDR, loc,
-	   HRESULT_HDR,  invoke_hr,
-	   SOURCE_HDR,   invoke_src,
-	   DESCR_HDR,    invoke_descr);
-
-  /* Done with these chaps */
-  if (invoke_src)   free(invoke_src);
-  if (invoke_descr) free(invoke_descr);
-  
-  if (pErrMsg) *pErrMsg = buf;
-  fprintf(stderr, "**InvokeBridge Error:\n%s", buf); fflush(stderr);
-}
-
-/* Converting to/from VARIANTs */
-
-/*
- * Function: fromVariant()
- *
- * Unmarshal the contents of a VARIANT, converting its embedded value
- * into the desired DotnetType (if possible.)
- *
- * Returns 1 if successful, 0 otherwise. If the conversion fails, 
- * *pErrMsg holds the error message string.
- */
-static
-int
-fromVariant (DotnetType resTy, 
-	     VARIANT* pVar, 
-	     void* res,
-	     char** pErrMsg)
-{
-    VARIANT vNew;
-    HRESULT hr;
-
-    VariantInit(&vNew);
-    switch(resTy) {
-    case Dotnet_Byte:
-    case Dotnet_Char:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_UI1);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_UI1}", pErrMsg);
-	    return FALSE;
-	}
-	*((unsigned char*)res) = vNew.bVal;
-	return 1;
-    case Dotnet_Boolean:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_BOOL);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_BOOL}", pErrMsg);
-	    return 0;
-	}
-	*((unsigned char*)res) = vNew.bVal;
-	return 1;
-    case Dotnet_Int:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_INT);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_INT}", pErrMsg);
-	    return 0;
-	}
-	*((int*)res) = vNew.intVal;
-	return 1;
-    case Dotnet_Int8:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_I1);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_I1}", pErrMsg);
-	    return 0;
-	}
-	*((signed char*)res) = vNew.bVal;
-	return 1;
-    case Dotnet_Int16:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_I2);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_I2}", pErrMsg);
-	    return 0;
-	}
-	*((signed short*)res) = vNew.iVal;
-	return 1;
-    case Dotnet_Int32:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_I4);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_I4}", pErrMsg);
-	    return 0;
-	}
-	*((signed int*)res) = vNew.lVal;
-	return 1;
-    case Dotnet_Int64:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_I8);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_I8}", pErrMsg);
-	    return 0;
-	}
-#ifdef _MSC_VER
-	*((__int64*)res) = vNew.llVal;
-#else
-	*((long long*)res) = vNew.lVal;
-#endif
-	return 1;
-    case Dotnet_Float:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_R4);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_R4}", pErrMsg);
-	    return 0;
-	}
-	*((float*)res) = vNew.fltVal;
-	return 1;
-    case Dotnet_Double:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_R8);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_R4}", pErrMsg);
-	    return 0;
-	}
-	*((double*)res) = vNew.dblVal;
-	return 1;
-    case Dotnet_Word8:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_UI1);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_UI1}", pErrMsg);
-	    return 0;
-	}
-	*((unsigned char*)res) = vNew.bVal;
-	return 1;
-    case Dotnet_Word16:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_UI2);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_UI2}", pErrMsg);
-	    return 0;
-	}
-	*((unsigned short*)res) = vNew.uiVal;
-	return 1;
-    case Dotnet_Word32:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_UI4);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_UI4}", pErrMsg);
-	    return 0;
-	}
-	*((unsigned int*)res) = vNew.ulVal;
-	return 1;
-    case Dotnet_Word64:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_UI8);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_UI8}", pErrMsg);
-	    return 0;
-	}
-#ifdef _MSC_VER
-	*((unsigned __int64*)res) = vNew.ullVal;
-#else
-	*((unsigned long long*)res) = vNew.lVal;
-#endif
-	return 1;
-    case Dotnet_Ptr:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_BYREF);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_BYREF}", pErrMsg);
-	    return 0;
-	}
-	*((void**)res) = vNew.byref;
-	return 1;
-    case Dotnet_Unit:
-	return 0;
-    case Dotnet_Object:
-      if ( pVar->vt == VT_BSTR ) {
-	/* Special handling for strings. If the user has asked for
-	 * the string in object form, give him/her that. 
-	 */
-	VARIANT res;
-
-	VariantInit(&res);
-	hr = InvokeBridge_NewString(pBridge,
-				    pVar->bstrVal,
-				    &res);
-	if (SUCCEEDED(hr)) {
-	  pVar = &res;
-	}
-      }
-	hr = VariantChangeType (&vNew, pVar, 0, VT_UNKNOWN);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_UNKNOWN}", pErrMsg);
-	    return 0;
-	}
-	*((IUnknown**)res) = vNew.punkVal;
-	return 1;
-    case Dotnet_String:
-	hr = VariantChangeType (&vNew, pVar, 0, VT_BSTR);
-	if (FAILED(hr)) {
-	    genError(NULL, hr, "DInvoke.fromVariant{VT_BSTR}", pErrMsg);
-	    return 0;
-	}
-	/* Storage is allocated by malloc(), caller is resp for freeing. */
-	*((char**)res) = bstrToString(vNew.bstrVal);
-	return 1;
-    }
-    return 0;
-}
-
-/*
- * Function: toVariant()
- *
- * Convert a DotnetArg into a VARIANT. The VARIANT
- * is dynamically allocated.
- *
- * The result is the pointer to the filled-in VARIANT structure;
- * NULL if allocation failed.
- *
- */
-static
-VARIANT*
-toVariant ( DotnetArg* p )
-{
-  VARIANT* v = (VARIANT*)malloc(sizeof(VARIANT));
-  if (!v) return NULL;
-  VariantInit(v);
-  switch (p->arg_type) {
-  case Dotnet_Byte:
-    v->vt = VT_UI1;
-    v->bVal = p->arg.arg_byte;
-    break;
-  case Dotnet_Char:
-    v->vt = VT_UI1;
-    v->bVal = p->arg.arg_char;
-    break;
-  case Dotnet_Boolean:
-    v->vt = VT_BOOL;
-    v->boolVal = p->arg.arg_bool;
-    break;
-  case Dotnet_Int:
-    v->vt = VT_INT;
-    v->intVal = p->arg.arg_int;
-    break;
-  case Dotnet_Int8:
-    v->vt = VT_I1;
-    v->bVal = p->arg.arg_int8;
-    break;
-  case Dotnet_Int16:
-    v->vt = VT_I2;
-    v->iVal = p->arg.arg_int16;
-    break;
-  case Dotnet_Int32:
-    v->vt = VT_I4;
-    v->lVal = p->arg.arg_int32;
-    break;
-  case Dotnet_Int64:
-    v->vt = VT_I8;
-#ifdef _MSC_VER
-    v->llVal = p->arg.arg_int64;
-#else
-    (long long*)(v->lVal) = p->arg.arg_int64;
-#endif
-    break;
-  case Dotnet_Float:
-    v->vt = VT_R4;
-    v->fltVal = p->arg.arg_float;
-    break;
-  case Dotnet_Double:
-    v->vt = VT_R8;
-    v->dblVal = p->arg.arg_double;
-    break;
-  case Dotnet_Word8:
-    v->vt = VT_UI1;
-    v->bVal = p->arg.arg_word8;
-    break;
-  case Dotnet_Word16:
-    v->vt = VT_UI2;
-    v->uiVal = p->arg.arg_word16;
-    break;
-  case Dotnet_Word32:
-    v->vt = VT_UI4;
-    v->ulVal = p->arg.arg_word32;
-    break;
-  case Dotnet_Word64:
-    v->vt = VT_UI8;
-#ifdef _MSC_VER
-    v->ullVal = p->arg.arg_word64;
-#else
-    (unsigned long long*)(v->lVal) = p->arg.arg_word64;
-#endif
-    break;
-  case Dotnet_Ptr:
-    v->vt = VT_BYREF;
-    v->byref = p->arg.arg_ptr;
-    break;
-  case Dotnet_Unit:
-    v->vt = VT_EMPTY;
-    break;
-  case Dotnet_Object:
-    v->vt = VT_UNKNOWN;
-    v->punkVal = (IUnknown*)p->arg.arg_obj;
-    break;
-  case Dotnet_String: {
-    BSTR b;
-    HRESULT hr;
-    v->vt = VT_BSTR;
-    hr = stringToBSTR((const char*)p->arg.arg_str,&b);
-    v->bstrVal = b;
-    break; }
-  }
-  return v;
-}
diff --git a/ghc/rts/dotnet/Invoker.cpp b/ghc/rts/dotnet/Invoker.cpp
deleted file mode 100644
index d8ad87212d..0000000000
--- a/ghc/rts/dotnet/Invoker.cpp
+++ /dev/null
@@ -1,338 +0,0 @@
-//
-// (c) 2002-2003, sof.
-//
-// Dynamic invocation helper classes. The details of how
-// to access the .NET object model via the Reflection API
-// is taken care of by Invoker.{h,cpp}
-//
-#include "Invoker.h"
-
-namespace DynInvoke {
-
-static TypeName* ParseType(String* str) {
-    int curPos = 0;
-    int endPos;
-
-    //    Console::WriteLine("x{0}y", str);
-    TypeName* typeName = new TypeName();
-
-    if ( str->get_Chars(0) == '[' ) {
-      endPos = str->IndexOf(']');
-      curPos = endPos + 1;
-      typeName->m_assembly = str->Substring(1,endPos-1);
-      typeName->m_length = endPos+1;
-    }
-    String* delimStr = " ,()";
-    Char delims __gc [] = delimStr->ToCharArray();
-
-    endPos  = str->IndexOfAny(delims,curPos);
-    //    Console::WriteLine("{0} {1} x{2}x", __box(endPos), __box(curPos), str);
-    if ( endPos == -1 ) {
-      typeName->m_class = str->Substring(curPos);
-    } else {
-      typeName->m_class = str->Substring(curPos,endPos-curPos);
-    }
-
-    //    typeName->m_class = str->Substring(curPos,endPos-curPos);
-    typeName->m_length += endPos-curPos;
-
-    return typeName;
-}
-
-// Method: GetType(String* typeName);
-// 
-// Purpose: Assembly-savvy version of Type::GetType()
-//
-Type* InvokeBridge::GetType(String* typeName) {
-
-  try {
-    Type* t = Type::GetType(typeName);
-    if (t) return t;
-  } catch (Exception*) {
-    ;
-  }
-
-  for (int i=0;i < InvokeBridge::m_assemblies->Count; i++) {
-     try {
-       String* stuff = String::Format("{0},{1}",typeName,InvokeBridge::m_assemblies->get_Item(i)->ToString());
-       //       Console::WriteLine(stuff);
-       Type* t = Type::GetType(stuff);
-       if (t) {
-	 return t;
-       }
-     } catch (Exception*) {
-       continue;
-     }
-  }
-  return 0;
-}
-
-//
-// Method:  CreateInstance(String* typeName, Object* [])
-//
-// Purpose: Assembly-savvy invocation of Activator::CreateInstance
-Object* InvokeBridge::CreateInstance(TypeName* typeName,
-				     Object* args[]) {
-
-  Object* instance = 0;
-  Type*   t = InvokeBridge::GetType(typeName->toStdString());
-
-  //  Console::WriteLine("x{0} y{1}", typeName->toStdString(), t);
-  if (!t) {
-    try {
-      Assembly* localA = Assembly::LoadFrom(typeName->m_assembly);
-      t = localA->GetType(typeName->m_class);
-    } catch (Exception* e) {
-      ;
-    }
-  }
-  
-  if (!t) {
-    try {
-      AppDomain* currentDomain = AppDomain::CurrentDomain;
-      
-      //      Assembly* stuff[] = currentDomain->GetAssemblies();
-      //      for (int i=0;i < stuff.Length; i++) {
-      //	Console::WriteLine("x{0} y{1}", stuff[i]->ToString(), stuff[i]->FullName);
-      //      }
-      //      Console::WriteLine("x{0} y{1}", typeName->toStdString(), t);
-      Assembly* localA = Assembly::LoadWithPartialName("HugsAssembly");
-      t = localA->GetType(typeName->m_class);
-      //      Console::WriteLine("x{0} y{1}", typeName->toStdString(), t);
-    } catch (Exception*) {
-      ;
-    }
-  }
-
-  if (t) {
-    try {
-      Object* o =Activator::CreateInstance(t,(Object* [])args);
-      return o;
-    } catch (Exception* e) {
-      Console::WriteLine("Failure: {0}", e);
-      return 0;
-    }
-  }
-}
-
-//
-// Method: CreateObject(String* objSpec, Object* args[])
-//
-// Purpose: Given a fully qualified name of a class/type, try
-//          to create an instance of it.
-//
-Object* InvokeBridge::CreateObject(String* assemName,
-				   String* objSpec,
-				   Object* args[]) {
- 
-  Object* instance = 0;
-
-  // Unravel the name of the class/type.
-  TypeName* typeName = ParseType(objSpec);
-  
-  if (assemName != 0 && assemName->Length > 0) {
-    typeName->m_assembly = assemName;
-  }
-
-  // Try creating the instance..
-  try {
-    instance = InvokeBridge::CreateInstance(typeName,(Object* [])args);
-  } catch (Exception* e) {
-    Console::WriteLine("Unable to create instance \"{0}\" {1}", objSpec, e);
-    throw(e);
-  }
-  if (!instance) {
-    Console::WriteLine("Unable to create instance \"{0}\"", objSpec);
-  }
-  return instance;
-}
-
-//
-// Method:  InvokeMethod
-// 
-// Purpose: Given a pointer to an already created object, look up
-//          one of its method. If found, invoke the method passing it
-//          'args' as arguments.
-//
-Object*
-InvokeBridge::InvokeMethod(Object* obj, 
-			   String* methName,
-			   Object* args[]) {
-  // Get the methods from the type
-  MethodInfo* methods __gc[] = obj->GetType()->GetMethods();
-  MethodInfo* mInfo;
-
-  if (!methods) {
-    Console::WriteLine("InvokeMethod: No matching types found");
-    return 0;
-  }
-			
-  System::Reflection::BindingFlags flgs 
-    = (System::Reflection::BindingFlags) // why do I need to cast?
-      (System::Reflection::BindingFlags::Public       |
-       System::Reflection::BindingFlags::NonPublic    |
-       System::Reflection::BindingFlags::Instance     |
-       System::Reflection::BindingFlags::Static       |
-       System::Reflection::BindingFlags::InvokeMethod);
-    
-  /* Caller is assumed to catch any exceptions raised. */
-  return obj->GetType()->InvokeMember(methName,
-				      flgs,
-				      0,
-				      obj,
-				      (Object __gc* [])args);
-}
-
-//
-// Method:  InvokeStaticMethod
-// 
-// Purpose: Invoke a static method, given the fully qualified name
-//          of the method (and its arguments). If found, invoke the
-//          method passing it 'args' as arguments.
-//
-Object* InvokeBridge::InvokeStaticMethod(String* assemName,
-					 String* typeAndMethName,
-					 Object* args[]) {
-
-  // Get the methods from the type
-  MethodInfo* methods __gc[];
-  MethodInfo* mInfo;
-
-  int lastDot = typeAndMethName->LastIndexOf('.');
-  String* className = typeAndMethName->Substring(0,lastDot);
-  String* methName  = typeAndMethName->Substring(lastDot+1);
-
-  // Unravel the name of the class/type.
-  TypeName* typeName = ParseType(className);
-  Type* t;
-  
-  if (assemName != 0 && assemName->Length > 0) {
-    typeName->m_assembly = assemName;
-  }
-  
-  try {
-    t = InvokeBridge::GetType(typeName->toStdString());
-    
-    if (!t) {
-      try {
-	Assembly* localA = Assembly::LoadFrom(typeName->m_assembly);
-	t = localA->GetType(typeName->m_class);
-	//	Console::WriteLine("InvokeStaticMethod: Type {0} found", t);
-      } catch (Exception* e) {
-	;
-      }
-    }
-
-    if (t) {
-      methods = t->GetMethods();
-    } else {
-      Console::WriteLine("InvokeStaticMethod: Type {0} not found", className);
-      return 0;
-    }
-  } catch (Exception *e) {
-      Console::WriteLine("InvokeStaticMethod: Type {0} not found", className);
-      throw(e);
-  }
-
-  System::Reflection::BindingFlags flgs 
-    = (System::Reflection::BindingFlags) // why do I need to cast?
-      (System::Reflection::BindingFlags::DeclaredOnly |
-       System::Reflection::BindingFlags::Public       |
-       System::Reflection::BindingFlags::NonPublic    |
-       System::Reflection::BindingFlags::Static       |
-       System::Reflection::BindingFlags::InvokeMethod);
-    
-  return t->InvokeMember(methName,
-			 flgs,
-			 0,
-			 0,
-			 (Object __gc* [])args);
-}
-
-//
-// Method:  GetField
-//
-// Purpose: Fetch the (boxed) value of named field of a given object.
-//
-Object* InvokeBridge::GetField(Object* obj, System::String* fieldName) {
-
-  FieldInfo* fInfo = obj->GetType()->GetField(fieldName);
-  return fInfo->GetValue(obj);
-}
-
-//
-// Method:  GetStaticField
-//
-// Purpose: Fetch the (boxed) value of named static field.
-//
-Object* InvokeBridge::GetStaticField(System::String* clsName,
-				     System::String* fieldName) {
-
-  Type* ty = InvokeBridge::GetType(clsName);
-  System::Reflection::BindingFlags static_field_flgs 
-    = (System::Reflection::BindingFlags)
-    (System::Reflection::BindingFlags::Public       |
-     System::Reflection::BindingFlags::NonPublic    |
-     System::Reflection::BindingFlags::FlattenHierarchy |
-     System::Reflection::BindingFlags::Static);
-
-  FieldInfo* fInfo = ty->GetField(fieldName, static_field_flgs);
-  return fInfo->GetValue(0); // according to doc, ok to pass any val here.
-}
-
-//
-// Method:  SetField
-//
-// Purpose: Replace the (boxed) value of named field of a given object.
-//
-void InvokeBridge::SetField(Object* obj, System::String* fieldName, Object* val) {
-
-  FieldInfo* fInfo = obj->GetType()->GetField(fieldName);
-  fInfo->SetValue(obj,val);
-  return;
-}
-
-//
-// Method:  SetStaticField
-//
-// Purpose: Replace the (boxed) value of named static field.
-//
-void InvokeBridge::SetStaticField(System::String* clsName,
-				  System::String* fieldName,
-				  Object* val) {
-
-  Type* ty = InvokeBridge::GetType(clsName);
-  System::Reflection::BindingFlags static_field_flgs 
-    = (System::Reflection::BindingFlags)
-    (System::Reflection::BindingFlags::Public       |
-     System::Reflection::BindingFlags::NonPublic    |
-     System::Reflection::BindingFlags::FlattenHierarchy |
-     System::Reflection::BindingFlags::Static);
-  
-  FieldInfo* fInfo = ty->GetField(fieldName,static_field_flgs);
-  fInfo->SetValue(0,val);
-  return;
-}
-
-Object* InvokeBridge::NewString(System::String* s)
-{
-  System::String* c = System::String::Copy(s);
-  return dynamic_cast<Object*>(c);
-}
-
-Array* InvokeBridge::NewArgArray(int sz)
-{
- return Array::CreateInstance(__typeof(Object), sz); 
-}
-
-void InvokeBridge::SetArg(Object* arr[], Object* val, int idx)
-{
- arr->SetValue(val,idx);
-}
-
-Object* InvokeBridge::GetArg(Object* arr[], int idx)
-{
- return arr->GetValue(idx);
-}
-
-} /* namespace */
diff --git a/ghc/rts/dotnet/Invoker.h b/ghc/rts/dotnet/Invoker.h
deleted file mode 100644
index d649a4c716..0000000000
--- a/ghc/rts/dotnet/Invoker.h
+++ /dev/null
@@ -1,197 +0,0 @@
-//
-// (c) 2003, sof.
-//
-// Dynamic invocation helper classes. The details of how
-// to access the .NET object model via the Reflection API
-// is taken care of by Invoker.{h,cpp}
-//
-#pragma once
-#using <mscorlib.dll>
-
-using namespace System;
-using namespace System::Reflection;
-using namespace System::Text;
-using namespace System::Runtime::InteropServices;
-
-[assembly:AssemblyKeyFileAttribute(S"invoker.snk")];
-
-namespace DynInvoke {
-
-//
-// Class: TypeName
-//
-// Purpose: pairing up an assembly name and the type/class name.
-//
-[ComVisible(false)]
-public __gc class TypeName {
-
-public:
-  System::String* m_assembly;
-  System::String* m_class;
-  int     m_length;
-
-  TypeName() { 
-    m_assembly = String::Empty;
-    m_class = String::Empty;
-    m_length = 0;
-  }
-
-  void Print() {
-    if (m_assembly && m_assembly != String::Empty ) {
-      Console::Write("[");
-      Console::Write(m_assembly);
-      Console::Write("]");
-    }
-    Console::WriteLine(m_class);
-  }
-  
-  int Length() { return m_length; }
-
-  System::String* toStdString() {
-    System::String* res = new System::String(m_class->ToCharArray());
-    
-    if (m_assembly && m_assembly != String::Empty ){
-      res = String::Concat(res, S",");
-      res = String::Concat(res, m_assembly);
-    }
-    return res;
-  }
-};
-
-// 
-// Class:   InvokeBridge
-// 
-// Purpose: Collection of (static) methods for dynamically creating
-//          objects and accessing methods/fields on them. 
-//
-[ClassInterface(ClassInterfaceType::AutoDual),
-GuidAttribute("39D497D9-60E0-3525-B7F2-7BC096D3A2A3"),
-ComVisible(true)
-]
-public __gc class InvokeBridge {
-public:
-  InvokeBridge() {
-    Assembly* corAss      = Assembly::Load("mscorlib.dll"); 
-    System::String*  dir  = System::IO::Path::GetDirectoryName(corAss->Location);
-   
-    m_assemblies = new System::Collections::ArrayList();
-   
-    System::String* fs[] = System::IO::Directory::GetFiles(dir, "*.dll");
-    for (int i=0;i < fs->Length; i++) {
-      try {
-	Assembly* tAss = Assembly::LoadFrom(fs[i]);
-	m_assemblies->Add(tAss->FullName);
-      } catch (Exception* e) {
-	continue;
-      }
-    }
-  }
-
-  //
-  // Method: CreateObject(String* assemName, String* objSpec, Object* args[])
-  //
-  // Purpose: Given a fully qualified name of a class/type, try
-  //          to create an instance of it.
-  //
-  Object* CreateObject(System::String* assemName,
-		       System::String* objSpec,
-		       Object* args[]);
-	  
-  //
-  // Method:  InvokeMethod
-  // 
-  // Purpose: Given a pointer to an already created object, look up
-  //          one of its method. If found, invoke the method passing it
-  //          'args' as arguments.
-  //
-  // Comments: the format of the method-spec is "methodName(type1,..,typeN)" [N>=0]
-  //
-  Object* InvokeMethod(Object* obj, 
-		       System::String* methSpec,
-		       Object* args[]);
-			      
-  //
-  // Method:  InvokeStaticMethod
-  // 
-  // Purpose: Invoke a static method, given the fully qualified name
-  //          of the method (and its arguments). If found, invoke the
-  //          method passing it 'args' as arguments.
-  //
-  // Comments: the format of the method-spec is 
-  //              "T1.T2.<..>.Tn.methodName(type1,..,typeN)" [N>=0]
-  //
-  Object* InvokeStaticMethod(System::String* assemName,
-			     System::String* methSpec,
-			     Object* args[]);
-			      
-  //
-  // Method:  GetField
-  //
-  // Purpose: Fetch the (boxed) value of named field of a given object.
-  //
-  Object* GetField(Object* obj, System::String* fieldSpec);
-
-  //
-  // Method:  GetField
-  //
-  // Purpose: Fetch the (boxed) value of named static field.
-  //
-  Object* GetStaticField(System::String* clsName, 
-			 System::String* fieldSpec);
-
-  //
-  // Method:  SetField
-  //
-  // Purpose: Replace the (boxed) value of named field of a given object.
-  //
-  void SetField(Object* obj, System::String* fieldSpec, Object* val);
-	    
-  //
-  // Method:  SetStaticField
-  //
-  // Purpose: Replace the (boxed) value of named field of a given object.
-  //
-  void SetStaticField(System::String* clsName,
-		      System::String* fieldSpec,
-		      Object* val);
-	    
-
-  // 
-  // Method:  NewString
-  // 
-  // Purpose: construct a System.String object copy in a manner that avoids
-  //          COM Interop from deconstructing it to a BSTR.
-  //
-  System::Object* NewString( System::String* s);
-
-  //
-  // Method:  NewArgArray
-  //
-  // Purpose: create a new array for holding (boxed) arguments to constructors/
-  //          methods.
-  //
-  Array* NewArgArray(int sz);
-  
-  //
-  // Method: SetArg
-  //
-  // Purpose: set an entry in the argument vector.
-  //
-  void SetArg(Object* arr[], Object* val, int idx);
-
-  //
-  // Method: GetArg
-  //
-  // Purpose: get an entry in the argument vector.
-  //
-  Object* GetArg(Object* arr[], int idx);
-
-  System::Type* InvokeBridge::GetType(System::String* typeName);
-
-protected:
-  System::Collections::ArrayList __gc* m_assemblies;
-  Object* InvokeBridge::CreateInstance(TypeName* typeName,
-				       Object* args[]);
-};
-
-} /* namespace */
diff --git a/ghc/rts/dotnet/InvokerClient.h b/ghc/rts/dotnet/InvokerClient.h
deleted file mode 100644
index 122f455c01..0000000000
--- a/ghc/rts/dotnet/InvokerClient.h
+++ /dev/null
@@ -1,180 +0,0 @@
-/*
- * InvokerClient interface defns for use with gcc.
- *
- * Note: These declarations mirror those of the InvokeBridge
- *       class declaration. 
- *
- */
-
-#include <windows.h>
-#include <wtypes.h>
-#include <oaidl.h>
-
-#ifdef __cplusplus
-extern "C"{
-#endif
-
-#ifndef STDCALL
-#define STDCALL __stdcall
-#endif
-
-extern const CLSID CLSID_InvokeBridge;
-extern const IID   IID_IUnknown;
-extern const IID   IID_NULL;
-extern const IID   IID_InvokeBridge;
-
-#ifdef WANT_UUID_DECLS
-const CLSID CLSID_InvokeBridge = { 0x39D497D9,0x60E0,0x3525,{0xB7,0xF2,0x7B,0xC0,0x96,0xD3,0xA2,0xA3}};
-//const IID IID_NULL = {0x00000000L, 0x0000, 0x0000, {0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}};
-//const IID IID_IUnknown = {0x00000000L, 0x0000, 0x0000, {0xC0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x46}};
-const IID IID_InvokeBridge = { 0xAFF5FFCA, 0xC5C2, 0x3D5B, {0xAF, 0xD5, 0xED, 0x8E, 0x4B, 0x38, 0xDB, 0x7B}};
-  //0x3A85D703, 0xFAE4,0x3C5E, {0x9F,0x7E,0x20,0x98,0x31,0xCD,0x61,0x7A}};
-#endif
-
-#ifndef __InvokeBridge_INTERFACE_DEFINED__
-#define __InvokeBridge_INTERFACE_DEFINED__
-#undef INTERFACE
-#define INTERFACE InvokeBridge
-DECLARE_INTERFACE(InvokeBridge)
-{
-    STDMETHOD(QueryInterface)(THIS_ REFIID,PVOID*) PURE;
-    STDMETHOD_(ULONG,AddRef)(THIS) PURE;
-    STDMETHOD_(ULONG,Release)(THIS) PURE;
-    STDMETHOD(GetTypeInfoCount)(THIS_ UINT*) PURE;
-    STDMETHOD(GetTypeInfo)(THIS_ UINT,LCID,LPTYPEINFO*) PURE;
-    STDMETHOD(GetIDsOfNames)(THIS_ REFIID,LPOLESTR*,UINT,LCID,DISPID*) PURE;
-    STDMETHOD(Invoke)(THIS_ DISPID,REFIID,LCID,WORD,DISPPARAMS*,VARIANT*,EXCEPINFO*,UINT*) PURE;
-
-    STDMETHOD(ToString)(THIS_ BSTR*) PURE;
-    STDMETHOD(Equals)(THIS_ BSTR*) PURE;
-    STDMETHOD(GetHashCode)(THIS_ long*) PURE;
-    STDMETHOD(GetType)(THIS_ IUnknown**);
-    STDMETHOD(CreateObject)(THIS_ BSTR,BSTR,SAFEARRAY*, VARIANT*) PURE;
-    STDMETHOD(InvokeMethod)(THIS_ VARIANT,BSTR,SAFEARRAY*,VARIANT*) PURE;
-    STDMETHOD(InvokeStaticMethod)(THIS_ BSTR,BSTR,SAFEARRAY*,VARIANT*) PURE;
-
-    HRESULT ( STDCALL *GetField )( 
-            InvokeBridge * This,
-            /* [in] */ VARIANT obj,
-            /* [in] */ BSTR fieldSpec,
-            /* [retval][out] */ VARIANT *pRetVal);
-        
-        HRESULT ( STDCALL *GetStaticField )( 
-            InvokeBridge * This,
-            /* [in] */ BSTR clsName,
-            /* [in] */ BSTR fieldSpec,
-            /* [retval][out] */ VARIANT *pRetVal);
-        
-        HRESULT ( STDCALL *SetField )( 
-            InvokeBridge * This,
-            /* [in] */ VARIANT obj,
-            /* [in] */ BSTR fieldSpec,
-            /* [in] */ VARIANT val);
-        
-        HRESULT ( STDCALL *SetStaticField )( 
-            InvokeBridge * This,
-            /* [in] */ BSTR clsName,
-            /* [in] */ BSTR fieldSpec,
-            /* [in] */ VARIANT val);
-        
-        HRESULT ( STDCALL *NewString )( 
-            InvokeBridge * This,
-            /* [in] */ BSTR s,
-            /* [retval][out] */VARIANT* pRetVal);
-        
-        HRESULT ( STDCALL *NewArgArray )( 
-            InvokeBridge * This,
-            /* [in] */ long sz,
-            /* [retval][out] */IUnknown **pRetVal);
-        
-        HRESULT ( STDCALL *SetArg )( 
-            InvokeBridge * This,
-            /* [in] */ SAFEARRAY * arr,
-            /* [in] */ VARIANT val,
-            /* [in] */ long idx);
-        
-        HRESULT ( STDCALL *GetArg )( 
-            InvokeBridge * This,
-            /* [in] */ SAFEARRAY * arr,
-            /* [in] */ long idx,
-            /* [retval][out] */ VARIANT *pRetVal);
-        
-        HRESULT ( STDCALL *GetType_2 )( 
-            InvokeBridge * This,
-            /* [in] */ BSTR typeName,
-            /* [retval][out] */ IUnknown **pRetVal);
-};
-#endif
-
-#define InvokeBridge_QueryInterface(This,riid,ppvObject)	\
-    (This)->lpVtbl->QueryInterface(This,riid,ppvObject)
-
-#define InvokeBridge_AddRef(This)	\
-    (This)->lpVtbl->AddRef(This)
-
-#define InvokeBridge_Release(This)	\
-    (This)->lpVtbl->Release(This)
-
-#define InvokeBridge_GetTypeInfoCount(This,pctinfo)	\
-    (This)->lpVtbl->GetTypeInfoCount(This,pctinfo)
-
-#define InvokeBridge_GetTypeInfo(This,iTInfo,lcid,ppTInfo)	\
-    (This)->lpVtbl->GetTypeInfo(This,iTInfo,lcid,ppTInfo)
-
-#define InvokeBridge_GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)	\
-    (This)->lpVtbl->GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)
-
-#define InvokeBridge_Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)	\
-    (This)->lpVtbl->Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)
-
-#define InvokeBridge_get_ToString(This,pRetVal)	\
-    (This)->lpVtbl->get_ToString(This,pRetVal)
-
-#define InvokeBridge_Equals(This,obj,pRetVal)	\
-    (This)->lpVtbl->Equals(This,obj,pRetVal)
-
-#define InvokeBridge_GetHashCode(This,pRetVal)	\
-    (This)->lpVtbl->GetHashCode(This,pRetVal)
-
-#define InvokeBridge_GetType(This,pRetVal)	\
-    (This)->lpVtbl->GetType(This,pRetVal)
-
-#define InvokeBridge_CreateObject(This,assemName,objSpec,args,pRetVal)	\
-    (This)->lpVtbl->CreateObject(This,assemName,objSpec,args,pRetVal)
-
-#define InvokeBridge_InvokeMethod(This,obj,methSpec,args,pRetVal)	\
-    (This)->lpVtbl->InvokeMethod(This,obj,methSpec,args,pRetVal)
-
-#define InvokeBridge_InvokeStaticMethod(This,assemName,methSpec,args,pRetVal)	\
-    (This)->lpVtbl->InvokeStaticMethod(This,assemName,methSpec,args,pRetVal)
-
-#define InvokeBridge_GetField(This,obj,fieldSpec,pRetVal)	\
-    (This)->lpVtbl->GetField(This,obj,fieldSpec,pRetVal)
-
-#define InvokeBridge_GetStaticField(This,clsName,fieldSpec,pRetVal)	\
-    (This)->lpVtbl->GetStaticField(This,clsName,fieldSpec,pRetVal)
-
-#define InvokeBridge_SetField(This,obj,fieldSpec,val)	\
-    (This)->lpVtbl->SetField(This,obj,fieldSpec,val)
-
-#define InvokeBridge_SetStaticField(This,clsName,fieldSpec,val)	\
-    (This)->lpVtbl->SetStaticField(This,clsName,fieldSpec,val)
-
-#define InvokeBridge_NewString(This,s,pRetVal)	\
-    (This)->lpVtbl->NewString(This,s,pRetVal)
-
-#define InvokeBridge_NewArgArray(This,sz,pRetVal)	\
-    (This)->lpVtbl->NewArgArray(This,sz,pRetVal)
-
-#define InvokeBridge_SetArg(This,arr,val,idx)	\
-    (This)->lpVtbl->SetArg(This,arr,val,idx)
-
-#define InvokeBridge_GetArg(This,arr,idx,pRetVal)	\
-    (This)->lpVtbl->GetArg(This,arr,idx,pRetVal)
-
-#define InvokeBridge_GetType_2(This,typeName,pRetVal)	\
-    (This)->lpVtbl->GetType_2(This,typeName,pRetVal)
-
-#ifdef __cplusplus
-}
-#endif
diff --git a/ghc/rts/dotnet/Makefile b/ghc/rts/dotnet/Makefile
deleted file mode 100644
index 95b6c38890..0000000000
--- a/ghc/rts/dotnet/Makefile
+++ /dev/null
@@ -1,53 +0,0 @@
-#
-# .NET interop for GHC.
-#
-#  (c) 2003, sof.
-# 
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-all :: Invoker.dll Invoke.o
-
-#
-# To compile the dotnet interop bits, you need to have the
-# .NET Framework SDK or VS.NET installed. The following
-# apps are used:
-# 
-MCPP=cl
-TLBEXP=tlbexp
-REGASM=regasm
-GACUTIL=gacutil
-
-Invoker.dll : Invoker.obj 
-	$(MCPP) /LD /clr /o Invoker.dll Invoker.obj
-	$(TLBEXP) Invoker.dll
-	$(REGASM) Invoker.dll
-	$(GACUTIL) /i Invoker.dll
-
-Invoker.obj : Invoker.cpp Invoker.h
-	$(MCPP) /LD /clr /c Invoker.cpp
-
-CLEAN_FILES += $(wildcard *.obj *.dll *.tlb)
-
-# ToDo: 
-#   - switch to /ir (i.e., copy it into the GAC.)
-#   - sort out installation story.
-
-# drop the assembly
-remove : 
-	$(GACUTIL) /u Invoker
-
-#
-# NOTE: For DotnetCc a version of gcc later than gcc-2.95 is
-#       required (I'm using the gcc-3.2 snapshot that comes with mingw-2)
-#
-ifeq "$(DotnetCc)" ""
-DotnetCc=$(CC)
-endif
-DotnetCcOpts=$(CC_OPTS) $(DOTNET_EXTRA_CC_OPTS)
-SRC_CC_OPTS += -I$(TOP)/includes
-
-Invoke.o : Invoke.c 
-	$(DotnetCc) $(DotnetCcOpts) -c $< -o $@ 
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/rts/dotnet/invoker.snk b/ghc/rts/dotnet/invoker.snk
deleted file mode 100644
index 05a222178a..0000000000
--- a/ghc/rts/dotnet/invoker.snk
+++ /dev/null
diff --git a/ghc/rts/ghc-frontpanel.glade b/ghc/rts/ghc-frontpanel.glade
deleted file mode 100644
index 9b73afce47..0000000000
--- a/ghc/rts/ghc-frontpanel.glade
+++ /dev/null
@@ -1,1622 +0,0 @@
-<?xml version="1.0" standalone="no"?> <!--*- mode: xml -*-->
-<!DOCTYPE glade-interface SYSTEM "http://glade.gnome.org/glade-2.0.dtd">
-
-<glade-interface>
-
-<widget class="GtkWindow" id="GHC Front Panel">
-  <property name="visible">True</property>
-  <property name="title" translatable="yes">GHC Front Panel</property>
-  <property name="type">GTK_WINDOW_TOPLEVEL</property>
-  <property name="window_position">GTK_WIN_POS_NONE</property>
-  <property name="modal">False</property>
-  <property name="default_width">450</property>
-  <property name="default_height">600</property>
-  <property name="resizable">True</property>
-  <property name="destroy_with_parent">False</property>
-  <property name="decorated">True</property>
-  <property name="skip_taskbar_hint">False</property>
-  <property name="skip_pager_hint">False</property>
-  <property name="type_hint">GDK_WINDOW_TYPE_HINT_NORMAL</property>
-  <property name="gravity">GDK_GRAVITY_NORTH_WEST</property>
-  <property name="focus_on_map">True</property>
-
-  <child>
-    <widget class="GtkVBox" id="vbox1">
-      <property name="visible">True</property>
-      <property name="homogeneous">False</property>
-      <property name="spacing">0</property>
-
-      <child>
-	<widget class="GtkHBox" id="hbox1">
-	  <property name="border_width">10</property>
-	  <property name="visible">True</property>
-	  <property name="homogeneous">False</property>
-	  <property name="spacing">10</property>
-
-	  <child>
-	    <widget class="GtkVBox" id="vbox4">
-	      <property name="visible">True</property>
-	      <property name="homogeneous">False</property>
-	      <property name="spacing">10</property>
-
-	      <child>
-		<widget class="GtkFrame" id="frame3">
-		  <property name="visible">True</property>
-		  <property name="label_xalign">0</property>
-		  <property name="label_yalign">0.5</property>
-		  <property name="shadow_type">GTK_SHADOW_ETCHED_IN</property>
-
-		  <child>
-		    <widget class="GtkHBox" id="hbox3">
-		      <property name="visible">True</property>
-		      <property name="homogeneous">False</property>
-		      <property name="spacing">0</property>
-
-		      <child>
-			<widget class="GtkLabel" id="label40">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">Mb</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">0.5</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="padding">0</property>
-			  <property name="expand">False</property>
-			  <property name="fill">False</property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkVRuler" id="map_ruler">
-			  <property name="visible">True</property>
-			  <property name="metric">GTK_PIXELS</property>
-			  <property name="lower">0</property>
-			  <property name="upper">10</property>
-			  <property name="position">1.40845072269</property>
-			  <property name="max_size">10</property>
-			</widget>
-			<packing>
-			  <property name="padding">0</property>
-			  <property name="expand">False</property>
-			  <property name="fill">False</property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkDrawingArea" id="memmap">
-			  <property name="visible">True</property>
-			</widget>
-			<packing>
-			  <property name="padding">0</property>
-			  <property name="expand">True</property>
-			  <property name="fill">True</property>
-			</packing>
-		      </child>
-		    </widget>
-		  </child>
-
-		  <child>
-		    <widget class="GtkLabel" id="label1">
-		      <property name="visible">True</property>
-		      <property name="label" translatable="yes">Memory Map</property>
-		      <property name="use_underline">False</property>
-		      <property name="use_markup">False</property>
-		      <property name="justify">GTK_JUSTIFY_LEFT</property>
-		      <property name="wrap">False</property>
-		      <property name="selectable">False</property>
-		      <property name="xalign">0.5</property>
-		      <property name="yalign">0.5</property>
-		      <property name="xpad">0</property>
-		      <property name="ypad">0</property>
-		      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-		      <property name="width_chars">-1</property>
-		      <property name="single_line_mode">False</property>
-		      <property name="angle">0</property>
-		    </widget>
-		    <packing>
-		      <property name="type">label_item</property>
-		    </packing>
-		  </child>
-		</widget>
-		<packing>
-		  <property name="padding">0</property>
-		  <property name="expand">True</property>
-		  <property name="fill">True</property>
-		</packing>
-	      </child>
-
-	      <child>
-		<widget class="GtkFrame" id="frame8">
-		  <property name="visible">True</property>
-		  <property name="label_xalign">0</property>
-		  <property name="label_yalign">0.5</property>
-		  <property name="shadow_type">GTK_SHADOW_ETCHED_IN</property>
-
-		  <child>
-		    <widget class="GtkVBox" id="vbox14">
-		      <property name="visible">True</property>
-		      <property name="homogeneous">False</property>
-		      <property name="spacing">0</property>
-
-		      <child>
-			<widget class="GtkTable" id="table4">
-			  <property name="visible">True</property>
-			  <property name="n_rows">2</property>
-			  <property name="n_columns">3</property>
-			  <property name="homogeneous">False</property>
-			  <property name="row_spacing">0</property>
-			  <property name="column_spacing">0</property>
-
-			  <child>
-			    <widget class="GtkVRuler" id="gen_ruler">
-			      <property name="visible">True</property>
-			      <property name="metric">GTK_PIXELS</property>
-			      <property name="lower">0</property>
-			      <property name="upper">10</property>
-			      <property name="position">1.69934999943</property>
-			      <property name="max_size">10</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">1</property>
-			      <property name="right_attach">2</property>
-			      <property name="top_attach">0</property>
-			      <property name="bottom_attach">1</property>
-			      <property name="x_options">fill</property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkHBox" id="gen_hbox">
-			      <property name="visible">True</property>
-			      <property name="homogeneous">False</property>
-			      <property name="spacing">0</property>
-
-			      <child>
-				<placeholder/>
-			      </child>
-
-			      <child>
-				<placeholder/>
-			      </child>
-
-			      <child>
-				<placeholder/>
-			      </child>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">2</property>
-			      <property name="right_attach">3</property>
-			      <property name="top_attach">1</property>
-			      <property name="bottom_attach">2</property>
-			      <property name="y_options">fill</property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkDrawingArea" id="generations">
-			      <property name="visible">True</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">2</property>
-			      <property name="right_attach">3</property>
-			      <property name="top_attach">0</property>
-			      <property name="bottom_attach">1</property>
-			      <property name="x_options">fill</property>
-			      <property name="y_options">fill</property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkLabel" id="label39">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes">Mb</property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_CENTER</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">0.5</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">0</property>
-			      <property name="right_attach">1</property>
-			      <property name="top_attach">0</property>
-			      <property name="bottom_attach">1</property>
-			      <property name="x_options"></property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-			</widget>
-			<packing>
-			  <property name="padding">0</property>
-			  <property name="expand">True</property>
-			  <property name="fill">True</property>
-			</packing>
-		      </child>
-		    </widget>
-		  </child>
-
-		  <child>
-		    <widget class="GtkLabel" id="label41">
-		      <property name="visible">True</property>
-		      <property name="label" translatable="yes">Generations</property>
-		      <property name="use_underline">False</property>
-		      <property name="use_markup">False</property>
-		      <property name="justify">GTK_JUSTIFY_LEFT</property>
-		      <property name="wrap">False</property>
-		      <property name="selectable">False</property>
-		      <property name="xalign">0.5</property>
-		      <property name="yalign">0.5</property>
-		      <property name="xpad">0</property>
-		      <property name="ypad">0</property>
-		      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-		      <property name="width_chars">-1</property>
-		      <property name="single_line_mode">False</property>
-		      <property name="angle">0</property>
-		    </widget>
-		    <packing>
-		      <property name="type">label_item</property>
-		    </packing>
-		  </child>
-		</widget>
-		<packing>
-		  <property name="padding">0</property>
-		  <property name="expand">True</property>
-		  <property name="fill">True</property>
-		</packing>
-	      </child>
-
-	      <child>
-		<widget class="GtkFrame" id="frame7">
-		  <property name="visible">True</property>
-		  <property name="label_xalign">0</property>
-		  <property name="label_yalign">0.5</property>
-		  <property name="shadow_type">GTK_SHADOW_ETCHED_IN</property>
-
-		  <child>
-		    <widget class="GtkTable" id="table3">
-		      <property name="border_width">2</property>
-		      <property name="visible">True</property>
-		      <property name="n_rows">3</property>
-		      <property name="n_columns">3</property>
-		      <property name="homogeneous">False</property>
-		      <property name="row_spacing">0</property>
-		      <property name="column_spacing">0</property>
-
-		      <child>
-			<widget class="GtkHRuler" id="res_hruler">
-			  <property name="visible">True</property>
-			  <property name="metric">GTK_PIXELS</property>
-			  <property name="lower">0</property>
-			  <property name="upper">10</property>
-			  <property name="position">8.35443019867</property>
-			  <property name="max_size">10</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">2</property>
-			  <property name="right_attach">3</property>
-			  <property name="top_attach">1</property>
-			  <property name="bottom_attach">2</property>
-			  <property name="y_options">fill</property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkVRuler" id="res_vruler">
-			  <property name="visible">True</property>
-			  <property name="metric">GTK_PIXELS</property>
-			  <property name="lower">0</property>
-			  <property name="upper">10</property>
-			  <property name="position">9.69925022125</property>
-			  <property name="max_size">10</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">1</property>
-			  <property name="right_attach">2</property>
-			  <property name="top_attach">2</property>
-			  <property name="bottom_attach">3</property>
-			  <property name="x_options">fill</property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkDrawingArea" id="res_drawingarea">
-			  <property name="visible">True</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">2</property>
-			  <property name="right_attach">3</property>
-			  <property name="top_attach">2</property>
-			  <property name="bottom_attach">3</property>
-			  <property name="x_options">fill</property>
-			  <property name="y_options">fill</property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="label37">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">Secs</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">0.5</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">2</property>
-			  <property name="right_attach">3</property>
-			  <property name="top_attach">0</property>
-			  <property name="bottom_attach">1</property>
-			  <property name="x_options"></property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="label38">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">Mb</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">0.5</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">0</property>
-			  <property name="right_attach">1</property>
-			  <property name="top_attach">2</property>
-			  <property name="bottom_attach">3</property>
-			  <property name="x_options"></property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-		    </widget>
-		  </child>
-
-		  <child>
-		    <widget class="GtkLabel" id="label42">
-		      <property name="visible">True</property>
-		      <property name="label" translatable="yes">Residency</property>
-		      <property name="use_underline">False</property>
-		      <property name="use_markup">False</property>
-		      <property name="justify">GTK_JUSTIFY_LEFT</property>
-		      <property name="wrap">False</property>
-		      <property name="selectable">False</property>
-		      <property name="xalign">0.5</property>
-		      <property name="yalign">0.5</property>
-		      <property name="xpad">0</property>
-		      <property name="ypad">0</property>
-		      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-		      <property name="width_chars">-1</property>
-		      <property name="single_line_mode">False</property>
-		      <property name="angle">0</property>
-		    </widget>
-		    <packing>
-		      <property name="type">label_item</property>
-		    </packing>
-		  </child>
-		</widget>
-		<packing>
-		  <property name="padding">0</property>
-		  <property name="expand">True</property>
-		  <property name="fill">True</property>
-		</packing>
-	      </child>
-	    </widget>
-	    <packing>
-	      <property name="padding">0</property>
-	      <property name="expand">True</property>
-	      <property name="fill">True</property>
-	    </packing>
-	  </child>
-
-	  <child>
-	    <widget class="GtkVBox" id="vbox5">
-	      <property name="visible">True</property>
-	      <property name="homogeneous">False</property>
-	      <property name="spacing">10</property>
-
-	      <child>
-		<widget class="GtkFrame" id="frame5">
-		  <property name="visible">True</property>
-		  <property name="label_xalign">0</property>
-		  <property name="label_yalign">0.5</property>
-		  <property name="shadow_type">GTK_SHADOW_ETCHED_IN</property>
-
-		  <child>
-		    <widget class="GtkVBox" id="vbox6">
-		      <property name="border_width">5</property>
-		      <property name="visible">True</property>
-		      <property name="homogeneous">False</property>
-		      <property name="spacing">0</property>
-
-		      <child>
-			<placeholder/>
-		      </child>
-
-		      <child>
-			<placeholder/>
-		      </child>
-
-		      <child>
-			<widget class="GtkTable" id="table1">
-			  <property name="visible">True</property>
-			  <property name="n_rows">4</property>
-			  <property name="n_columns">3</property>
-			  <property name="homogeneous">False</property>
-			  <property name="row_spacing">0</property>
-			  <property name="column_spacing">7</property>
-
-			  <child>
-			    <widget class="GtkLabel" id="label12">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes">Allocated</property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_RIGHT</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">1</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">0</property>
-			      <property name="right_attach">1</property>
-			      <property name="top_attach">1</property>
-			      <property name="bottom_attach">2</property>
-			      <property name="x_options">fill</property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkLabel" id="label13">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes">Live</property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_RIGHT</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">1</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">0</property>
-			      <property name="right_attach">1</property>
-			      <property name="top_attach">0</property>
-			      <property name="bottom_attach">1</property>
-			      <property name="x_options">fill</property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkLabel" id="label14">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes">Allocation Rate</property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_RIGHT</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">1</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">0</property>
-			      <property name="right_attach">1</property>
-			      <property name="top_attach">3</property>
-			      <property name="bottom_attach">4</property>
-			      <property name="x_options"></property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkLabel" id="label15">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes">		Footprint</property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_RIGHT</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">1</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">0</property>
-			      <property name="right_attach">1</property>
-			      <property name="top_attach">2</property>
-			      <property name="bottom_attach">3</property>
-			      <property name="x_options">fill</property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkLabel" id="label16">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes">M/sec</property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_CENTER</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">0.5</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">2</property>
-			      <property name="right_attach">3</property>
-			      <property name="top_attach">3</property>
-			      <property name="bottom_attach">4</property>
-			      <property name="x_options"></property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkLabel" id="label17">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes">M</property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_LEFT</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">7.45058015283e-09</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">2</property>
-			      <property name="right_attach">3</property>
-			      <property name="top_attach">2</property>
-			      <property name="bottom_attach">3</property>
-			      <property name="x_options">fill</property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkLabel" id="label18">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes">M</property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_CENTER</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">7.45058015283e-09</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">2</property>
-			      <property name="right_attach">3</property>
-			      <property name="top_attach">1</property>
-			      <property name="bottom_attach">2</property>
-			      <property name="x_options">fill</property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkLabel" id="label19">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes">M</property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_CENTER</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">7.45058015283e-09</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">2</property>
-			      <property name="right_attach">3</property>
-			      <property name="top_attach">0</property>
-			      <property name="bottom_attach">1</property>
-			      <property name="x_options">fill</property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkLabel" id="live_label">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes"></property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_CENTER</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">1</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">1</property>
-			      <property name="right_attach">2</property>
-			      <property name="top_attach">0</property>
-			      <property name="bottom_attach">1</property>
-			      <property name="x_options">fill</property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkLabel" id="allocated_label">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes"></property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_CENTER</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">1</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">1</property>
-			      <property name="right_attach">2</property>
-			      <property name="top_attach">1</property>
-			      <property name="bottom_attach">2</property>
-			      <property name="x_options">fill</property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkLabel" id="footprint_label">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes"></property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_CENTER</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">1</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">1</property>
-			      <property name="right_attach">2</property>
-			      <property name="top_attach">2</property>
-			      <property name="bottom_attach">3</property>
-			      <property name="x_options">fill</property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkLabel" id="alloc_rate_label">
-			      <property name="visible">True</property>
-			      <property name="label" translatable="yes"></property>
-			      <property name="use_underline">False</property>
-			      <property name="use_markup">False</property>
-			      <property name="justify">GTK_JUSTIFY_CENTER</property>
-			      <property name="wrap">False</property>
-			      <property name="selectable">False</property>
-			      <property name="xalign">1</property>
-			      <property name="yalign">0.5</property>
-			      <property name="xpad">0</property>
-			      <property name="ypad">0</property>
-			      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			      <property name="width_chars">-1</property>
-			      <property name="single_line_mode">False</property>
-			      <property name="angle">0</property>
-			    </widget>
-			    <packing>
-			      <property name="left_attach">1</property>
-			      <property name="right_attach">2</property>
-			      <property name="top_attach">3</property>
-			      <property name="bottom_attach">4</property>
-			      <property name="x_options">fill</property>
-			      <property name="y_options"></property>
-			    </packing>
-			  </child>
-			</widget>
-			<packing>
-			  <property name="padding">0</property>
-			  <property name="expand">True</property>
-			  <property name="fill">True</property>
-			</packing>
-		      </child>
-		    </widget>
-		  </child>
-
-		  <child>
-		    <widget class="GtkLabel" id="label43">
-		      <property name="visible">True</property>
-		      <property name="label" translatable="yes">Stats</property>
-		      <property name="use_underline">False</property>
-		      <property name="use_markup">False</property>
-		      <property name="justify">GTK_JUSTIFY_LEFT</property>
-		      <property name="wrap">False</property>
-		      <property name="selectable">False</property>
-		      <property name="xalign">0.5</property>
-		      <property name="yalign">0.5</property>
-		      <property name="xpad">0</property>
-		      <property name="ypad">0</property>
-		      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-		      <property name="width_chars">-1</property>
-		      <property name="single_line_mode">False</property>
-		      <property name="angle">0</property>
-		    </widget>
-		    <packing>
-		      <property name="type">label_item</property>
-		    </packing>
-		  </child>
-		</widget>
-		<packing>
-		  <property name="padding">0</property>
-		  <property name="expand">False</property>
-		  <property name="fill">True</property>
-		</packing>
-	      </child>
-
-	      <child>
-		<widget class="GtkFrame" id="frame9">
-		  <property name="visible">True</property>
-		  <property name="label_xalign">0</property>
-		  <property name="label_yalign">0.5</property>
-		  <property name="shadow_type">GTK_SHADOW_ETCHED_IN</property>
-
-		  <child>
-		    <widget class="GtkTable" id="table5">
-		      <property name="border_width">6</property>
-		      <property name="visible">True</property>
-		      <property name="n_rows">9</property>
-		      <property name="n_columns">2</property>
-		      <property name="homogeneous">False</property>
-		      <property name="row_spacing">0</property>
-		      <property name="column_spacing">10</property>
-
-		      <child>
-			<widget class="GtkLabel" id="label20">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">Running</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">1</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">0</property>
-			  <property name="right_attach">1</property>
-			  <property name="top_attach">0</property>
-			  <property name="bottom_attach">1</property>
-			  <property name="x_options">fill</property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="label21">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">Blocked on I/O (Read)</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">1</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">0</property>
-			  <property name="right_attach">1</property>
-			  <property name="top_attach">1</property>
-			  <property name="bottom_attach">2</property>
-			  <property name="x_options">fill</property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="label22">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">Blocked on MVar</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">1</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">0</property>
-			  <property name="right_attach">1</property>
-			  <property name="top_attach">3</property>
-			  <property name="bottom_attach">4</property>
-			  <property name="x_options">fill</property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="label24">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">Blocked on throwTo</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">1</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">0</property>
-			  <property name="right_attach">1</property>
-			  <property name="top_attach">4</property>
-			  <property name="bottom_attach">5</property>
-			  <property name="x_options">fill</property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="label26">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">Blocked on Black Hole</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">1</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">0</property>
-			  <property name="right_attach">1</property>
-			  <property name="top_attach">5</property>
-			  <property name="bottom_attach">6</property>
-			  <property name="x_options">fill</property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="label25">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">Sleeping</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">1</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">0</property>
-			  <property name="right_attach">1</property>
-			  <property name="top_attach">6</property>
-			  <property name="bottom_attach">7</property>
-			  <property name="x_options">fill</property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="label27">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">Blocked on I/O (Write)</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">1</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">0</property>
-			  <property name="right_attach">1</property>
-			  <property name="top_attach">2</property>
-			  <property name="bottom_attach">3</property>
-			  <property name="x_options"></property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="running_label">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">label28</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">0.5</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">1</property>
-			  <property name="right_attach">2</property>
-			  <property name="top_attach">0</property>
-			  <property name="bottom_attach">1</property>
-			  <property name="x_options"></property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="blockread_label">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">label29</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">0.5</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">1</property>
-			  <property name="right_attach">2</property>
-			  <property name="top_attach">1</property>
-			  <property name="bottom_attach">2</property>
-			  <property name="x_options"></property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="blockwrite_label">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">label30</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">0.5</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">1</property>
-			  <property name="right_attach">2</property>
-			  <property name="top_attach">2</property>
-			  <property name="bottom_attach">3</property>
-			  <property name="x_options"></property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="blockmvar_label">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">label31</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">0.5</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">1</property>
-			  <property name="right_attach">2</property>
-			  <property name="top_attach">3</property>
-			  <property name="bottom_attach">4</property>
-			  <property name="x_options"></property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="blockthrowto_label">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">label32</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">0.5</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">1</property>
-			  <property name="right_attach">2</property>
-			  <property name="top_attach">4</property>
-			  <property name="bottom_attach">5</property>
-			  <property name="x_options"></property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="blockbh_label">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">label33</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">0.5</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">1</property>
-			  <property name="right_attach">2</property>
-			  <property name="top_attach">5</property>
-			  <property name="bottom_attach">6</property>
-			  <property name="x_options"></property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="sleeping_label">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">label34</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">0.5</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">1</property>
-			  <property name="right_attach">2</property>
-			  <property name="top_attach">6</property>
-			  <property name="bottom_attach">7</property>
-			  <property name="x_options"></property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkHSeparator" id="hseparator1">
-			  <property name="visible">True</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">0</property>
-			  <property name="right_attach">1</property>
-			  <property name="top_attach">7</property>
-			  <property name="bottom_attach">8</property>
-			  <property name="x_options">fill</property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkHSeparator" id="hseparator2">
-			  <property name="visible">True</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">1</property>
-			  <property name="right_attach">2</property>
-			  <property name="top_attach">7</property>
-			  <property name="bottom_attach">8</property>
-			  <property name="x_options">fill</property>
-			  <property name="y_options">fill</property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="label35">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">Total</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">1</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">0</property>
-			  <property name="right_attach">1</property>
-			  <property name="top_attach">8</property>
-			  <property name="bottom_attach">9</property>
-			  <property name="x_options">fill</property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkLabel" id="total_label">
-			  <property name="visible">True</property>
-			  <property name="label" translatable="yes">label36</property>
-			  <property name="use_underline">False</property>
-			  <property name="use_markup">False</property>
-			  <property name="justify">GTK_JUSTIFY_CENTER</property>
-			  <property name="wrap">False</property>
-			  <property name="selectable">False</property>
-			  <property name="xalign">0.5</property>
-			  <property name="yalign">0.5</property>
-			  <property name="xpad">0</property>
-			  <property name="ypad">0</property>
-			  <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-			  <property name="width_chars">-1</property>
-			  <property name="single_line_mode">False</property>
-			  <property name="angle">0</property>
-			</widget>
-			<packing>
-			  <property name="left_attach">1</property>
-			  <property name="right_attach">2</property>
-			  <property name="top_attach">8</property>
-			  <property name="bottom_attach">9</property>
-			  <property name="x_options"></property>
-			  <property name="y_options"></property>
-			</packing>
-		      </child>
-		    </widget>
-		  </child>
-
-		  <child>
-		    <widget class="GtkLabel" id="label44">
-		      <property name="visible">True</property>
-		      <property name="label" translatable="yes">Threads</property>
-		      <property name="use_underline">False</property>
-		      <property name="use_markup">False</property>
-		      <property name="justify">GTK_JUSTIFY_LEFT</property>
-		      <property name="wrap">False</property>
-		      <property name="selectable">False</property>
-		      <property name="xalign">0.5</property>
-		      <property name="yalign">0.5</property>
-		      <property name="xpad">0</property>
-		      <property name="ypad">0</property>
-		      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-		      <property name="width_chars">-1</property>
-		      <property name="single_line_mode">False</property>
-		      <property name="angle">0</property>
-		    </widget>
-		    <packing>
-		      <property name="type">label_item</property>
-		    </packing>
-		  </child>
-		</widget>
-		<packing>
-		  <property name="padding">0</property>
-		  <property name="expand">False</property>
-		  <property name="fill">True</property>
-		</packing>
-	      </child>
-
-	      <child>
-		<widget class="GtkFrame" id="frame6">
-		  <property name="visible">True</property>
-		  <property name="label_xalign">0</property>
-		  <property name="label_yalign">0.5</property>
-		  <property name="shadow_type">GTK_SHADOW_ETCHED_IN</property>
-
-		  <child>
-		    <widget class="GtkVBox" id="vbox7">
-		      <property name="border_width">5</property>
-		      <property name="visible">True</property>
-		      <property name="homogeneous">False</property>
-		      <property name="spacing">10</property>
-
-		      <child>
-			<widget class="GtkVBox" id="vbox9">
-			  <property name="visible">True</property>
-			  <property name="homogeneous">False</property>
-			  <property name="spacing">0</property>
-
-			  <child>
-			    <widget class="GtkRadioButton" id="cont_radio">
-			      <property name="visible">True</property>
-			      <property name="can_focus">True</property>
-			      <property name="label" translatable="yes">Continuous</property>
-			      <property name="use_underline">True</property>
-			      <property name="relief">GTK_RELIEF_NORMAL</property>
-			      <property name="focus_on_click">True</property>
-			      <property name="active">True</property>
-			      <property name="inconsistent">False</property>
-			      <property name="draw_indicator">True</property>
-			      <signal name="clicked" handler="on_cont_radio_clicked"/>
-			    </widget>
-			    <packing>
-			      <property name="padding">0</property>
-			      <property name="expand">False</property>
-			      <property name="fill">False</property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkRadioButton" id="stop_before_radio">
-			      <property name="visible">True</property>
-			      <property name="can_focus">True</property>
-			      <property name="label" translatable="yes">Stop before GC</property>
-			      <property name="use_underline">True</property>
-			      <property name="relief">GTK_RELIEF_NORMAL</property>
-			      <property name="focus_on_click">True</property>
-			      <property name="active">False</property>
-			      <property name="inconsistent">False</property>
-			      <property name="draw_indicator">True</property>
-			      <property name="group">cont_radio</property>
-			      <signal name="clicked" handler="on_stop_before_radio_clicked"/>
-			    </widget>
-			    <packing>
-			      <property name="padding">0</property>
-			      <property name="expand">False</property>
-			      <property name="fill">False</property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkRadioButton" id="stop_after_radio">
-			      <property name="visible">True</property>
-			      <property name="can_focus">True</property>
-			      <property name="label" translatable="yes">Stop after GC</property>
-			      <property name="use_underline">True</property>
-			      <property name="relief">GTK_RELIEF_NORMAL</property>
-			      <property name="focus_on_click">True</property>
-			      <property name="active">False</property>
-			      <property name="inconsistent">False</property>
-			      <property name="draw_indicator">True</property>
-			      <property name="group">cont_radio</property>
-			      <signal name="clicked" handler="on_stop_after_radio_clicked"/>
-			    </widget>
-			    <packing>
-			      <property name="padding">0</property>
-			      <property name="expand">False</property>
-			      <property name="fill">False</property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkRadioButton" id="stop_both_radio">
-			      <property name="visible">True</property>
-			      <property name="can_focus">True</property>
-			      <property name="label" translatable="yes">Stop before &amp; after GC</property>
-			      <property name="use_underline">True</property>
-			      <property name="relief">GTK_RELIEF_NORMAL</property>
-			      <property name="focus_on_click">True</property>
-			      <property name="active">False</property>
-			      <property name="inconsistent">False</property>
-			      <property name="draw_indicator">True</property>
-			      <property name="group">cont_radio</property>
-			      <signal name="clicked" handler="on_stop_both_radio_clicked"/>
-			    </widget>
-			    <packing>
-			      <property name="padding">0</property>
-			      <property name="expand">False</property>
-			      <property name="fill">False</property>
-			    </packing>
-			  </child>
-			</widget>
-			<packing>
-			  <property name="padding">0</property>
-			  <property name="expand">True</property>
-			  <property name="fill">True</property>
-			</packing>
-		      </child>
-
-		      <child>
-			<widget class="GtkVBox" id="vbox8">
-			  <property name="visible">True</property>
-			  <property name="homogeneous">False</property>
-			  <property name="spacing">0</property>
-
-			  <child>
-			    <widget class="GtkButton" id="stop_but">
-			      <property name="visible">True</property>
-			      <property name="can_focus">True</property>
-			      <property name="label" translatable="yes">Stop</property>
-			      <property name="use_underline">True</property>
-			      <property name="relief">GTK_RELIEF_NORMAL</property>
-			      <property name="focus_on_click">True</property>
-			      <signal name="clicked" handler="on_stop_but_clicked"/>
-			    </widget>
-			    <packing>
-			      <property name="padding">0</property>
-			      <property name="expand">False</property>
-			      <property name="fill">False</property>
-			    </packing>
-			  </child>
-
-			  <child>
-			    <widget class="GtkButton" id="continue_but">
-			      <property name="visible">True</property>
-			      <property name="can_focus">True</property>
-			      <property name="label" translatable="yes">Continue</property>
-			      <property name="use_underline">True</property>
-			      <property name="relief">GTK_RELIEF_NORMAL</property>
-			      <property name="focus_on_click">True</property>
-			      <signal name="clicked" handler="on_continue_but_clicked"/>
-			    </widget>
-			    <packing>
-			      <property name="padding">0</property>
-			      <property name="expand">False</property>
-			      <property name="fill">False</property>
-			    </packing>
-			  </child>
-			</widget>
-			<packing>
-			  <property name="padding">0</property>
-			  <property name="expand">False</property>
-			  <property name="fill">False</property>
-			</packing>
-		      </child>
-		    </widget>
-		  </child>
-
-		  <child>
-		    <widget class="GtkLabel" id="label45">
-		      <property name="visible">True</property>
-		      <property name="label" translatable="yes">Updates</property>
-		      <property name="use_underline">False</property>
-		      <property name="use_markup">False</property>
-		      <property name="justify">GTK_JUSTIFY_LEFT</property>
-		      <property name="wrap">False</property>
-		      <property name="selectable">False</property>
-		      <property name="xalign">0.5</property>
-		      <property name="yalign">0.5</property>
-		      <property name="xpad">0</property>
-		      <property name="ypad">0</property>
-		      <property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
-		      <property name="width_chars">-1</property>
-		      <property name="single_line_mode">False</property>
-		      <property name="angle">0</property>
-		    </widget>
-		    <packing>
-		      <property name="type">label_item</property>
-		    </packing>
-		  </child>
-		</widget>
-		<packing>
-		  <property name="padding">0</property>
-		  <property name="expand">False</property>
-		  <property name="fill">False</property>
-		</packing>
-	      </child>
-
-	      <child>
-		<widget class="GtkButton" id="quit_but">
-		  <property name="visible">True</property>
-		  <property name="can_focus">True</property>
-		  <property name="label" translatable="yes">Quit</property>
-		  <property name="use_underline">True</property>
-		  <property name="relief">GTK_RELIEF_NORMAL</property>
-		  <property name="focus_on_click">True</property>
-		  <signal name="clicked" handler="on_quit_but_clicked"/>
-		</widget>
-		<packing>
-		  <property name="padding">0</property>
-		  <property name="expand">False</property>
-		  <property name="fill">False</property>
-		  <property name="pack_type">GTK_PACK_END</property>
-		</packing>
-	      </child>
-	    </widget>
-	    <packing>
-	      <property name="padding">0</property>
-	      <property name="expand">False</property>
-	      <property name="fill">False</property>
-	      <property name="pack_type">GTK_PACK_END</property>
-	    </packing>
-	  </child>
-	</widget>
-	<packing>
-	  <property name="padding">0</property>
-	  <property name="expand">True</property>
-	  <property name="fill">True</property>
-	</packing>
-      </child>
-
-      <child>
-	<widget class="GtkStatusbar" id="statusbar">
-	  <property name="visible">True</property>
-	  <property name="has_resize_grip">True</property>
-	</widget>
-	<packing>
-	  <property name="padding">0</property>
-	  <property name="expand">False</property>
-	  <property name="fill">False</property>
-	</packing>
-      </child>
-    </widget>
-  </child>
-</widget>
-
-</glade-interface>
diff --git a/ghc/rts/gmp/.gdbinit b/ghc/rts/gmp/.gdbinit
deleted file mode 100644
index 843c109e89..0000000000
--- a/ghc/rts/gmp/.gdbinit
+++ /dev/null
@@ -1,34 +0,0 @@
-# Copyright (C) 1999 Free Software Foundation, Inc.
-#
-# This file is part of the GNU MP Library.
-#
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-#
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-define pz
-set __gmpz_dump ($)
-end
-
-define pq
-set __gmpz_dump ($->_mp_num)
-echo /
-set __gmpz_dump ($->_mp_den)
-end
-
-define pf
-set __gmpf_dump ($)
-end
-
diff --git a/ghc/rts/gmp/AUTHORS b/ghc/rts/gmp/AUTHORS
deleted file mode 100644
index 1fa057af6c..0000000000
--- a/ghc/rts/gmp/AUTHORS
+++ /dev/null
@@ -1,12 +0,0 @@
-Authors if GNU MP (in chronological order)
-Torbjörn Granlund
-John Amanatides
-Paul Zimmermann
-Ken Weber
-Bennet Yee
-Andreas Schwab
-Robert Harley
-Linus Nordberg
-Kent Boortz
-Kevin Ryde
-Guillaume Hanrot
diff --git a/ghc/rts/gmp/COPYING b/ghc/rts/gmp/COPYING
deleted file mode 100644
index a6d7d0188a..0000000000
--- a/ghc/rts/gmp/COPYING
+++ /dev/null
@@ -1,336 +0,0 @@
-		    GNU GENERAL PUBLIC LICENSE
-		       Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
-     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-			    Preamble
-
-  The licenses for most software are designed to take away your
-freedom to share and change it.  By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users.  This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it.  (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.)  You can apply it to
-your programs, too.
-
-  When we speak of free software, we are referring to freedom, not
-price.  Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
-  To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
-  For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have.  You must make sure that they, too, receive or can get the
-source code.  And you must show them these terms so they know their
-rights.
-
-  We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
-  Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software.  If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
-  Finally, any free program is threatened constantly by software
-patents.  We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary.  To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
-  The precise terms and conditions for copying, distribution and
-modification follow.
-
-		    GNU GENERAL PUBLIC LICENSE
-   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
-  0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License.  The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language.  (Hereinafter, translation is included without limitation in
-the term "modification".)  Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope.  The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
-  1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
-  2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
-    a) You must cause the modified files to carry prominent notices
-    stating that you changed the files and the date of any change.
-
-    b) You must cause any work that you distribute or publish, that in
-    whole or in part contains or is derived from the Program or any
-    part thereof, to be licensed as a whole at no charge to all third
-    parties under the terms of this License.
-
-    c) If the modified program normally reads commands interactively
-    when run, you must cause it, when started running for such
-    interactive use in the most ordinary way, to print or display an
-    announcement including an appropriate copyright notice and a
-    notice that there is no warranty (or else, saying that you provide
-    a warranty) and that users may redistribute the program under
-    these conditions, and telling the user how to view a copy of this
-    License.  (Exception: if the Program itself is interactive but
-    does not normally print such an announcement, your work based on
-    the Program is not required to print an announcement.)
-
-These requirements apply to the modified work as a whole.  If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works.  But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
-  3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
-    a) Accompany it with the complete corresponding machine-readable
-    source code, which must be distributed under the terms of Sections
-    1 and 2 above on a medium customarily used for software interchange; or,
-
-    b) Accompany it with a written offer, valid for at least three
-    years, to give any third party, for a charge no more than your
-    cost of physically performing source distribution, a complete
-    machine-readable copy of the corresponding source code, to be
-    distributed under the terms of Sections 1 and 2 above on a medium
-    customarily used for software interchange; or,
-
-    c) Accompany it with the information you received as to the offer
-    to distribute corresponding source code.  (This alternative is
-    allowed only for noncommercial distribution and only if you
-    received the program in object code or executable form with such
-    an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it.  For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable.  However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
-  4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License.  Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
-  5. You are not required to accept this License, since you have not
-signed it.  However, nothing else grants you permission to modify or
-distribute the Program or its derivative works.  These actions are
-prohibited by law if you do not accept this License.  Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
-  6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions.  You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
-  7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License.  If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all.  For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices.  Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
-  8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded.  In such case, this License incorporates
-the limitation as if written in the body of this License.
-
-  9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time.  Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number.  If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation.  If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
-  10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission.  For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this.  Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
-			    NO WARRANTY
-
-  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
-  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
-		     END OF TERMS AND CONDITIONS
-
-	    How to Apply These Terms to Your New Programs
-
-  If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
-  To do so, attach the following notices to the program.  It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
-    <one line to give the program's name and a brief idea of what it does.>
-    Copyright (C) <year>  <name of author>
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
-    Gnomovision version 69, Copyright (C) year  name of author
-    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
-    This is free software, and you are welcome to redistribute it
-    under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License.  Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary.  Hereny it with the complete corresponding machine-readable
-    source code, which must be distributed under the terms of Sections
-    1 and 2 above on a medium customarily used for software interchange; or,
-
-    b) Accompany it with a written offer, valid for at least three
-    years, to give any third party, for a charge no more than your
-    cost of physically performing source distribution, a complete
-    machine-readable copy of the corresponding source code, to be
-    distributed under the terms of Section
diff --git a/ghc/rts/gmp/COPYING.LIB b/ghc/rts/gmp/COPYING.LIB
deleted file mode 100644
index c4792dd27a..0000000000
--- a/ghc/rts/gmp/COPYING.LIB
+++ /dev/null
@@ -1,515 +0,0 @@
-
-                  GNU LESSER GENERAL PUBLIC LICENSE
-                       Version 2.1, February 1999
-
- Copyright (C) 1991, 1999 Free Software Foundation, Inc.
-     59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-[This is the first released version of the Lesser GPL.  It also counts
- as the successor of the GNU Library Public License, version 2, hence
- the version number 2.1.]
-
-                            Preamble
-
-  The licenses for most software are designed to take away your
-freedom to share and change it.  By contrast, the GNU General Public
-Licenses are intended to guarantee your freedom to share and change
-free software--to make sure the software is free for all its users.
-
-  This license, the Lesser General Public License, applies to some
-specially designated software packages--typically libraries--of the
-Free Software Foundation and other authors who decide to use it.  You
-can use it too, but we suggest you first think carefully about whether
-this license or the ordinary General Public License is the better
-strategy to use in any particular case, based on the explanations
-below.
-
-  When we speak of free software, we are referring to freedom of use,
-not price.  Our General Public Licenses are designed to make sure that
-you have the freedom to distribute copies of free software (and charge
-for this service if you wish); that you receive source code or can get
-it if you want it; that you can change the software and use pieces of
-it in new free programs; and that you are informed that you can do
-these things.
-
-  To protect your rights, we need to make restrictions that forbid
-distributors to deny you these rights or to ask you to surrender these
-rights.  These restrictions translate to certain responsibilities for
-you if you distribute copies of the library or if you modify it.
-
-  For example, if you distribute copies of the library, whether gratis
-or for a fee, you must give the recipients all the rights that we gave
-you.  You must make sure that they, too, receive or can get the source
-code.  If you link other code with the library, you must provide
-complete object files to the recipients, so that they can relink them
-with the library after making changes to the library and recompiling
-it.  And you must show them these terms so they know their rights.
-
-  We protect your rights with a two-step method: (1) we copyright the
-library, and (2) we offer you this license, which gives you legal
-permission to copy, distribute and/or modify the library.
-
-  To protect each distributor, we want to make it very clear that
-there is no warranty for the free library.  Also, if the library is
-modified by someone else and passed on, the recipients should know
-that what they have is not the original version, so that the original
-author's reputation will not be affected by problems that might be
-introduced by others.
-^L
-  Finally, software patents pose a constant threat to the existence of
-any free program.  We wish to make sure that a company cannot
-effectively restrict the users of a free program by obtaining a
-restrictive license from a patent holder.  Therefore, we insist that
-any patent license obtained for a version of the library must be
-consistent with the full freedom of use specified in this license.
-
-  Most GNU software, including some libraries, is covered by the
-ordinary GNU General Public License.  This license, the GNU Lesser
-General Public License, applies to certain designated libraries, and
-is quite different from the ordinary General Public License.  We use
-this license for certain libraries in order to permit linking those
-libraries into non-free programs.
-
-  When a program is linked with a library, whether statically or using
-a shared library, the combination of the two is legally speaking a
-combined work, a derivative of the original library.  The ordinary
-General Public License therefore permits such linking only if the
-entire combination fits its criteria of freedom.  The Lesser General
-Public License permits more lax criteria for linking other code with
-the library.
-
-  We call this license the "Lesser" General Public License because it
-does Less to protect the user's freedom than the ordinary General
-Public License.  It also provides other free software developers Less
-of an advantage over competing non-free programs.  These disadvantages
-are the reason we use the ordinary General Public License for many
-libraries.  However, the Lesser license provides advantages in certain
-special circumstances.
-
-  For example, on rare occasions, there may be a special need to
-encourage the widest possible use of a certain library, so that it
-becomes
-a de-facto standard.  To achieve this, non-free programs must be
-allowed to use the library.  A more frequent case is that a free
-library does the same job as widely used non-free libraries.  In this
-case, there is little to gain by limiting the free library to free
-software only, so we use the Lesser General Public License.
-
-  In other cases, permission to use a particular library in non-free
-programs enables a greater number of people to use a large body of
-free software.  For example, permission to use the GNU C Library in
-non-free programs enables many more people to use the whole GNU
-operating system, as well as its variant, the GNU/Linux operating
-system.
-
-  Although the Lesser General Public License is Less protective of the
-users' freedom, it does ensure that the user of a program that is
-linked with the Library has the freedom and the wherewithal to run
-that program using a modified version of the Library.
-
-  The precise terms and conditions for copying, distribution and
-modification follow.  Pay close attention to the difference between a
-"work based on the library" and a "work that uses the library".  The
-former contains code derived from the library, whereas the latter must
-be combined with the library in order to run.
-^L
-                  GNU LESSER GENERAL PUBLIC LICENSE
-   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
-  0. This License Agreement applies to any software library or other
-program which contains a notice placed by the copyright holder or
-other authorized party saying it may be distributed under the terms of
-this Lesser General Public License (also called "this License").
-Each licensee is addressed as "you".
-
-  A "library" means a collection of software functions and/or data
-prepared so as to be conveniently linked with application programs
-(which use some of those functions and data) to form executables.
-
-  The "Library", below, refers to any such software library or work
-which has been distributed under these terms.  A "work based on the
-Library" means either the Library or any derivative work under
-copyright law: that is to say, a work containing the Library or a
-portion of it, either verbatim or with modifications and/or translated
-straightforwardly into another language.  (Hereinafter, translation is
-included without limitation in the term "modification".)
-
-  "Source code" for a work means the preferred form of the work for
-making modifications to it.  For a library, complete source code means
-all the source code for all modules it contains, plus any associated
-interface definition files, plus the scripts used to control
-compilation
-and installation of the library.
-
-  Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope.  The act of
-running a program using the Library is not restricted, and output from
-such a program is covered only if its contents constitute a work based
-on the Library (independent of the use of the Library in a tool for
-writing it).  Whether that is true depends on what the Library does
-and what the program that uses the Library does.
-
-  1. You may copy and distribute verbatim copies of the Library's
-complete source code as you receive it, in any medium, provided that
-you conspicuously and appropriately publish on each copy an
-appropriate copyright notice and disclaimer of warranty; keep intact
-all the notices that refer to this License and to the absence of any
-warranty; and distribute a copy of this License along with the
-Library.
-
-  You may charge a fee for the physical act of transferring a copy,
-and you may at your option offer warranty protection in exchange for a
-fee.
-
-  2. You may modify your copy or copies of the Library or any portion
-of it, thus forming a work based on the Library, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
-    a) The modified work must itself be a software library.
-
-    b) You must cause the files modified to carry prominent notices
-    stating that you changed the files and the date of any change.
-
-    c) You must cause the whole of the work to be licensed at no
-    charge to all third parties under the terms of this License.
-
-    d) If a facility in the modified Library refers to a function or a
-    table of data to be supplied by an application program that uses
-    the facility, other than as an argument passed when the facility
-    is invoked, then you must make a good faith effort to ensure that,
-    in the event an application does not supply such function or
-    table, the facility still operates, and performs whatever part of
-    its purpose remains meaningful.
-
-    (For example, a function in a library to compute square roots has
-    a purpose that is entirely well-defined independent of the
-    application.  Therefore, Subsection 2d requires that any
-    application-supplied function or table used by this function must
-    be optional: if the application does not supply it, the square
-    root function must still compute square roots.)
-
-These requirements apply to the modified work as a whole.  If
-identifiable sections of that work are not derived from the Library,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works.  But when you
-distribute the same sections as part of a whole which is a work based
-on the Library, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote
-it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Library.
-
-In addition, mere aggregation of another work not based on the Library
-with the Library (or with a work based on the Library) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
-  3. You may opt to apply the terms of the ordinary GNU General Public
-License instead of this License to a given copy of the Library.  To do
-this, you must alter all the notices that refer to this License, so
-that they refer to the ordinary GNU General Public License, version 2,
-instead of to this License.  (If a newer version than version 2 of the
-ordinary GNU General Public License has appeared, then you can specify
-that version instead if you wish.)  Do not make any other change in
-these notices.
-^L
-  Once this change is made in a given copy, it is irreversible for
-that copy, so the ordinary GNU General Public License applies to all
-subsequent copies and derivative works made from that copy.
-
-  This option is useful when you wish to copy part of the code of
-the Library into a program that is not a library.
-
-  4. You may copy and distribute the Library (or a portion or
-derivative of it, under Section 2) in object code or executable form
-under the terms of Sections 1 and 2 above provided that you accompany
-it with the complete corresponding machine-readable source code, which
-must be distributed under the terms of Sections 1 and 2 above on a
-medium customarily used for software interchange.
-
-  If distribution of object code is made by offering access to copy
-from a designated place, then offering equivalent access to copy the
-source code from the same place satisfies the requirement to
-distribute the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
-  5. A program that contains no derivative of any portion of the
-Library, but is designed to work with the Library by being compiled or
-linked with it, is called a "work that uses the Library".  Such a
-work, in isolation, is not a derivative work of the Library, and
-therefore falls outside the scope of this License.
-
-  However, linking a "work that uses the Library" with the Library
-creates an executable that is a derivative of the Library (because it
-contains portions of the Library), rather than a "work that uses the
-library".  The executable is therefore covered by this License.
-Section 6 states terms for distribution of such executables.
-
-  When a "work that uses the Library" uses material from a header file
-that is part of the Library, the object code for the work may be a
-derivative work of the Library even though the source code is not.
-Whether this is true is especially significant if the work can be
-linked without the Library, or if the work is itself a library.  The
-threshold for this to be true is not precisely defined by law.
-
-  If such an object file uses only numerical parameters, data
-structure layouts and accessors, and small macros and small inline
-functions (ten lines or less in length), then the use of the object
-file is unrestricted, regardless of whether it is legally a derivative
-work.  (Executables containing this object code plus portions of the
-Library will still fall under Section 6.)
-
-  Otherwise, if the work is a derivative of the Library, you may
-distribute the object code for the work under the terms of Section 6.
-Any executables containing that work also fall under Section 6,
-whether or not they are linked directly with the Library itself.
-^L
-  6. As an exception to the Sections above, you may also combine or
-link a "work that uses the Library" with the Library to produce a
-work containing portions of the Library, and distribute that work
-under terms of your choice, provided that the terms permit
-modification of the work for the customer's own use and reverse
-engineering for debugging such modifications.
-
-  You must give prominent notice with each copy of the work that the
-Library is used in it and that the Library and its use are covered by
-this License.  You must supply a copy of this License.  If the work
-during execution displays copyright notices, you must include the
-copyright notice for the Library among them, as well as a reference
-directing the user to the copy of this License.  Also, you must do one
-of these things:
-
-    a) Accompany the work with the complete corresponding
-    machine-readable source code for the Library including whatever
-    changes were used in the work (which must be distributed under
-    Sections 1 and 2 above); and, if the work is an executable linked
-    with the Library, with the complete machine-readable "work that
-    uses the Library", as object code and/or source code, so that the
-    user can modify the Library and then relink to produce a modified
-    executable containing the modified Library.  (It is understood
-    that the user who changes the contents of definitions files in the
-    Library will not necessarily be able to recompile the application
-    to use the modified definitions.)
-
-    b) Use a suitable shared library mechanism for linking with the
-    Library.  A suitable mechanism is one that (1) uses at run time a
-    copy of the library already present on the user's computer system,
-    rather than copying library functions into the executable, and (2)
-    will operate properly with a modified version of the library, if
-    the user installs one, as long as the modified version is
-    interface-compatible with the version that the work was made with.
-
-    c) Accompany the work with a written offer, valid for at
-    least three years, to give the same user the materials
-    specified in Subsection 6a, above, for a charge no more
-    than the cost of performing this distribution.
-
-    d) If distribution of the work is made by offering access to copy
-    from a designated place, offer equivalent access to copy the above
-    specified materials from the same place.
-
-    e) Verify that the user has already received a copy of these
-    materials or that you have already sent this user a copy.
-
-  For an executable, the required form of the "work that uses the
-Library" must include any data and utility programs needed for
-reproducing the executable from it.  However, as a special exception,
-the materials to be distributed need not include anything that is
-normally distributed (in either source or binary form) with the major
-components (compiler, kernel, and so on) of the operating system on
-which the executable runs, unless that component itself accompanies
-the executable.
-
-  It may happen that this requirement contradicts the license
-restrictions of other proprietary libraries that do not normally
-accompany the operating system.  Such a contradiction means you cannot
-use both them and the Library together in an executable that you
-distribute.
-^L
-  7. You may place library facilities that are a work based on the
-Library side-by-side in a single library together with other library
-facilities not covered by this License, and distribute such a combined
-library, provided that the separate distribution of the work based on
-the Library and of the other library facilities is otherwise
-permitted, and provided that you do these two things:
-
-    a) Accompany the combined library with a copy of the same work
-    based on the Library, uncombined with any other library
-    facilities.  This must be distributed under the terms of the
-    Sections above.
-
-    b) Give prominent notice with the combined library of the fact
-    that part of it is a work based on the Library, and explaining
-    where to find the accompanying uncombined form of the same work.
-
-  8. You may not copy, modify, sublicense, link with, or distribute
-the Library except as expressly provided under this License.  Any
-attempt otherwise to copy, modify, sublicense, link with, or
-distribute the Library is void, and will automatically terminate your
-rights under this License.  However, parties who have received copies,
-or rights, from you under this License will not have their licenses
-terminated so long as such parties remain in full compliance.
-
-  9. You are not required to accept this License, since you have not
-signed it.  However, nothing else grants you permission to modify or
-distribute the Library or its derivative works.  These actions are
-prohibited by law if you do not accept this License.  Therefore, by
-modifying or distributing the Library (or any work based on the
-Library), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Library or works based on it.
-
-  10. Each time you redistribute the Library (or any work based on the
-Library), the recipient automatically receives a license from the
-original licensor to copy, distribute, link with or modify the Library
-subject to these terms and conditions.  You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties with
-this License.
-^L
-  11. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License.  If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Library at all.  For example, if a patent
-license would not permit royalty-free redistribution of the Library by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Library.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply, and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system which is
-implemented by public license practices.  Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
-  12. If the distribution and/or use of the Library is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Library under this License
-may add an explicit geographical distribution limitation excluding those
-countries, so that distribution is permitted only in or among
-countries not thus excluded.  In such case, this License incorporates
-the limitation as if written in the body of this License.
-
-  13. The Free Software Foundation may publish revised and/or new
-versions of the Lesser General Public License from time to time.
-Such new versions will be similar in spirit to the present version,
-but may differ in detail to address new problems or concerns.
-
-Each version is given a distinguishing version number.  If the Library
-specifies a version number of this License which applies to it and
-"any later version", you have the option of following the terms and
-conditions either of that version or of any later version published by
-the Free Software Foundation.  If the Library does not specify a
-license version number, you may choose any version ever published by
-the Free Software Foundation.
-^L
-  14. If you wish to incorporate parts of the Library into other free
-programs whose distribution conditions are incompatible with these,
-write to the author to ask for permission.  For software which is
-copyrighted by the Free Software Foundation, write to the Free
-Software Foundation; we sometimes make exceptions for this.  Our
-decision will be guided by the two goals of preserving the free status
-of all derivatives of our free software and of promoting the sharing
-and reuse of software generally.
-
-                            NO WARRANTY
-
-  15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
-WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
-EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
-OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
-KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
-LIBRARY IS WITH YOU.  SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
-THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
-  16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
-WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
-AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
-FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
-CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
-LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
-RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
-FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-DAMAGES.
-
-                     END OF TERMS AND CONDITIONS
-^L
-           How to Apply These Terms to Your New Libraries
-
-  If you develop a new library, and you want it to be of the greatest
-possible use to the public, we recommend making it free software that
-everyone can redistribute and change.  You can do so by permitting
-redistribution under these terms (or, alternatively, under the terms
-of the ordinary General Public License).
-
-  To apply these terms, attach the following notices to the library.
-It is safest to attach them to the start of each source file to most
-effectively convey the exclusion of warranty; and each file should
-have at least the "copyright" line and a pointer to where the full
-notice is found.
-
-
-    <one line to give the library's name and a brief idea of what it
-does.>
-    Copyright (C) <year>  <name of author>
-
-    This library is free software; you can redistribute it and/or
-    modify it under the terms of the GNU Lesser General Public
-    License as published by the Free Software Foundation; either
-    version 2 of the License, or (at your option) any later version.
-
-    This library is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-    Lesser General Public License for more details.
-
-    You should have received a copy of the GNU Lesser General Public
-    License along with this library; if not, write to the Free Software
-    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
-
-Also add information on how to contact you by electronic and paper
-mail.
-
-You should also get your employer (if you work as a programmer) or
-your
-school, if any, to sign a "copyright disclaimer" for the library, if
-necessary.  Here is a sample; alter the names:
-
-  Yoyodyne, Inc., hereby disclaims all copyright interest in the
-  library `Frob' (a library for tweaking knobs) written by James
-Random Hacker.
-
-  <signature of Ty Coon>, 1 April 1990
-  Ty Coon, President of Vice
-
-That's all there is to it!
-
-
diff --git a/ghc/rts/gmp/INSTALL b/ghc/rts/gmp/INSTALL
deleted file mode 100644
index 62faa1a2e3..0000000000
--- a/ghc/rts/gmp/INSTALL
+++ /dev/null
@@ -1,146 +0,0 @@
-
-                          INSTALLING GNU MP
-                          =================
-
-
-These instructions are only for the impatient.  Others should read the install
-instructions in the manual, gmp.info.  Use
-
-	info -f ./gmp.info
-
-or in emacs
-
-	C-u C-h i gmp.info
-
-
-Here are some brief instructions on how to install GMP, and some examples to
-help you get started using GMP.
-
-First, you need to compile, and optionally install, GMP.  Since you're
-impatient, try this:
-
-	./configure; make
-
-If that fails, or you care about the performance of GMP, you need to read the
-full instructions in the chapter "Installing GMP", in the manual.
-
-Next, try some small test programs, for example the ones below.
-
-In GMP programs, all variables need to be initialized before they are
-assigned, and cleared out before program flow leaves the scope in which they
-were declared.  Here is an example program that reads two numbers from the
-command line, multiplies them, and prints the result to stdout.
-
-
-    #include <stdio.h>
-    #include <gmp.h>         /* All GMP programs need to include gmp.h */
-
-    main (int argc, char **argv)
-    {
-      mpz_t a, b, p;
-
-      if (argc != 3)
-        { printf ("Usage: %s <number> <number>\n", argv[0]); exit (1); }
-
-      /* Initialize variables */
-      mpz_init (a);
-      mpz_init (b);
-      mpz_init (p);
-
-      /* Assign a and b from base 10 strings in argv */
-      mpz_set_str (a, argv[1], 10);
-      mpz_set_str (b, argv[2], 10);
-
-      /* Multiply a and b and put the result in p */
-      mpz_mul (p, a, b);
-
-      /* Print p in base 10 */
-      mpz_out_str (stdout, 10, p);
-      fputc ('\n', stdout);
-
-      /* Clear out variables */
-      mpz_clear (a);
-      mpz_clear (b);
-      mpz_clear (p);
-      exit (0);
-    }
-
-
-This might look tedious, with all the initializing and clearing.  Fortunately
-some of these operations can be combined, and other operations can often be
-avoided.  An experienced GMP user might write:
-
-
-    #include <stdio.h>
-    #include <gmp.h>
-
-    main (int argc, char **argv)
-    {
-      mpz_t a, b, p;
-
-      if (argc != 3)
-        { printf ("Usage: %s <number> <number>\n", argv[0]); exit (1); }
-
-      /* Initialize and assign a and b from base 10 strings in argv */
-      mpz_init_set_str (a, argv[1], 10);
-      mpz_init_set_str (b, argv[2], 10);
-      /* Initialize p */
-      mpz_init (p);
-
-      /* Multiply a and b and put the result in p */
-      mpz_mul (p, a, b);
-
-      /* Print p in base 10 */
-      mpz_out_str (stdout, 10, p);
-      fputc ('\n', stdout);
-
-      /* Since we're about to exit, no need to clear out variables */
-      exit (0);
-    }
-
-
-Now you have to compile your test program, and link it with the GMP library.
-Assuming your working directory is still the gmp source directory, and your
-source file is called example.c, enter:
-
-	gcc -g -I. example.c .libs/libgmp.a
-
-After installing, the command becomes: "gcc -g example.c -lgmp".  Also, GMP is
-libtool based so you can use that to link if you want.
-
-Now try to run the example:
-
-	./a.out 98365871231256752134 319378318340103345227
-	31415926535897932384618573336104570964418
-
-The functions used here all operate on signed integers, and have names
-starting with "mpz_".  There are many more such functions than used in these
-examples.  See the chapter "Integer Functions" in the manual, for a complete
-list.
-
-There are two other main classes of functions in GMP.  They operate on
-rational numbers and floating-point numbers, respectively.  The chapters
-"Rational Number Functions", and "Floating-point Functions" document these
-classes.
-
-To run a set of tests, do "make check".  This will take a while.
-
-To create the printable documentation from the texinfo source, type "make
-gmp.dvi" or "make gmp.ps".  This requires various "tex" commands.
-
-To install the library, do "make install" (then you can use -lgmp instead of
-.libs/libgmp.a).
-
-If you decide to use GMP, it is a good idea you at least read the chapter "GMP
-Basics" in the manual.
-
-Some known build problems are noted in the "Installing GMP" chapter of
-the manual.  Please report other problems to bug-gmp@gnu.org.
-
-
-
-----------------
-Local variables:
-mode: text
-fill-column: 78
-End:
diff --git a/ghc/rts/gmp/Makefile.am b/ghc/rts/gmp/Makefile.am
deleted file mode 100644
index b73b805c6e..0000000000
--- a/ghc/rts/gmp/Makefile.am
+++ /dev/null
@@ -1,197 +0,0 @@
-## Process this file with automake to generate Makefile.in
-
-
-# Copyright (C) 1991, 1993, 1994, 1996, 1997, 1999, 2000 Free Software
-# Foundation, Inc.
-#
-# This file is part of the GNU MP Library.
-#
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-#
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# make check
-#
-#     It'd be good if "make check" first did a "make all" or whatever to
-#     build libgmp.la, but it's not clear how best to do this.  Putting a
-#     "check:" target is overridden by automake, and a "check-local:" runs
-#     too late (due to depth-first subdirectory processing).  For now it's
-#     necessary to do "make && make check".
-#
-# MPF_OBJECTS etc
-#
-#     Libtool needs all the .lo files passed to it if it's going to build
-#     both a static and shared library.  If a convenience library like
-#     mpf/libmpf.la is passed then the resulting libgmp.a gets the PIC .lo
-#     objects rather than the non-PIC .o's.
-#
-#     Unfortunately this leads to the big lists of objects below.  Something
-#     like mpz/*.lo would probably work, but might risk missing something
-#     out or getting something extra.  The source files for each .lo are
-#     listed in the Makefile.am's in the subdirectories.
-
-
-# Libtool -version-info for libgmp.la and libmp.la.  See (libtool)Versioning
-#
-# 1. No interfaces changed, only implementations (good): Increment REVISION.
-#
-# 2. Interfaces added, none removed (good): Increment CURRENT, increment
-#    AGE, set REVISION to 0.
-#
-# 3. Interfaces removed (BAD, breaks upward compatibility): Increment
-#    CURRENT, set AGE and REVISION to 0.
-#
-# Do this separately for libgmp and libmp, only do it just before a release.
-#
-#	  GMP	   -version-info
-#	release   libgmp  libmp
-#	 2.0.x      -       -
-#	 3.0      3:0:0   3:0:0
-#        3.0.1    3:1:0   3:0:0
-#        3.1      4:0:1   4:0:1
-#        3.1.1    4:1:1   4:1:1
-#
-#
-# Starting at 3:0:0 is a slight abuse of the versioning system, but it
-# ensures we're past soname libgmp.so.2, which is what has been used on
-# Debian GNU/Linux packages of gmp 2.  Pretend gmp 2 was 2:0:0, so the
-# interface changes for gmp 3 mean 3:0:0 is right.
-
-LIBGMP_LT_CURRENT =  4
-LIBGMP_LT_REVISION = 1
-LIBGMP_LT_AGE =      1
-
-LIBMP_LT_CURRENT =  4
-LIBMP_LT_REVISION = 1
-LIBMP_LT_AGE =      1
-
-
-AUTOMAKE_OPTIONS = gnu check-news no-dependencies ansi2knr
-
-SUBDIRS = mpn mpz mpq mpf mpbsd mpfr tests demos tune
-
-include_HEADERS = gmp.h $(MPBSD_HEADERS_OPTION) $(MPFR_HEADERS_OPTION)
-EXTRA_HEADERS = mp.h
-
-lib_LTLIBRARIES = libgmp.la $(MPBSD_LTLIBRARIES_OPTION)
-
-EXTRA_DIST = .gdbinit gmp-impl.h longlong.h stack-alloc.h urandom.h doc macos
-
-DISTCLEANFILES = asm-syntax.h config.m4 @gmp_srclinks@
-
-
-MPF_OBJECTS = mpf/init.lo mpf/init2.lo mpf/set.lo mpf/set_ui.lo mpf/set_si.lo \
-  mpf/set_str.lo mpf/set_d.lo mpf/set_z.lo mpf/iset.lo mpf/iset_ui.lo \
-  mpf/iset_si.lo mpf/iset_str.lo mpf/iset_d.lo mpf/clear.lo mpf/get_str.lo \
-  mpf/dump.lo mpf/size.lo mpf/eq.lo mpf/reldiff.lo mpf/sqrt.lo mpf/random2.lo \
-  mpf/inp_str.lo mpf/out_str.lo mpf/add.lo mpf/add_ui.lo mpf/sub.lo \
-  mpf/sub_ui.lo mpf/ui_sub.lo mpf/mul.lo mpf/mul_ui.lo mpf/div.lo \
-  mpf/div_ui.lo mpf/cmp.lo mpf/cmp_ui.lo mpf/cmp_si.lo mpf/mul_2exp.lo \
-  mpf/div_2exp.lo mpf/abs.lo mpf/neg.lo mpf/set_q.lo mpf/get_d.lo \
-  mpf/set_dfl_prec.lo mpf/set_prc.lo mpf/set_prc_raw.lo mpf/get_prc.lo \
-  mpf/ui_div.lo mpf/sqrt_ui.lo mpf/floor.lo mpf/ceil.lo mpf/trunc.lo \
-  mpf/pow_ui.lo mpf/urandomb.lo mpf/swap.lo
-MPZ_OBJECTS = mpz/abs.lo mpz/add.lo mpz/add_ui.lo mpz/addmul_ui.lo mpz/and.lo \
-  mpz/array_init.lo mpz/bin_ui.lo mpz/bin_uiui.lo mpz/cdiv_q.lo \
-  mpz/cdiv_q_ui.lo mpz/cdiv_qr.lo mpz/cdiv_qr_ui.lo mpz/cdiv_r.lo \
-  mpz/cdiv_r_ui.lo mpz/cdiv_ui.lo mpz/clear.lo mpz/clrbit.lo mpz/cmp.lo \
-  mpz/cmp_si.lo mpz/cmp_ui.lo mpz/cmpabs.lo mpz/cmpabs_ui.lo mpz/com.lo \
-  mpz/divexact.lo mpz/dump.lo mpz/fac_ui.lo mpz/fdiv_q.lo mpz/fdiv_q_2exp.lo \
-  mpz/fdiv_q_ui.lo mpz/fdiv_qr.lo mpz/fdiv_qr_ui.lo mpz/fdiv_r.lo \
-  mpz/fdiv_r_2exp.lo mpz/fdiv_r_ui.lo mpz/fdiv_ui.lo mpz/fib_ui.lo \
-  mpz/fits_sint_p.lo mpz/fits_slong_p.lo mpz/fits_sshort_p.lo \
-  mpz/fits_uint_p.lo mpz/fits_ulong_p.lo mpz/fits_ushort_p.lo mpz/gcd.lo \
-  mpz/gcd_ui.lo mpz/gcdext.lo mpz/get_d.lo mpz/get_si.lo mpz/get_str.lo \
-  mpz/get_ui.lo mpz/getlimbn.lo mpz/hamdist.lo mpz/init.lo mpz/inp_raw.lo \
-  mpz/inp_str.lo mpz/invert.lo mpz/ior.lo mpz/iset.lo mpz/iset_d.lo \
-  mpz/iset_si.lo mpz/iset_str.lo mpz/iset_ui.lo mpz/jacobi.lo \
-  mpz/kronsz.lo mpz/kronuz.lo mpz/kronzs.lo mpz/kronzu.lo \
-  mpz/lcm.lo mpz/legendre.lo \
-  mpz/mod.lo mpz/mul.lo mpz/mul_2exp.lo mpz/mul_si.lo mpz/mul_ui.lo \
-  mpz/neg.lo mpz/nextprime.lo mpz/out_raw.lo mpz/out_str.lo mpz/perfpow.lo mpz/perfsqr.lo \
-  mpz/popcount.lo mpz/pow_ui.lo mpz/powm.lo mpz/powm_ui.lo mpz/pprime_p.lo \
-  mpz/random.lo mpz/random2.lo mpz/realloc.lo mpz/remove.lo mpz/root.lo \
-  mpz/rrandomb.lo \
-  mpz/scan0.lo mpz/scan1.lo mpz/set.lo mpz/set_d.lo mpz/set_f.lo mpz/set_q.lo \
-  mpz/set_si.lo mpz/set_str.lo mpz/set_ui.lo mpz/setbit.lo mpz/size.lo \
-  mpz/sizeinbase.lo mpz/sqrt.lo mpz/sqrtrem.lo mpz/sub.lo mpz/sub_ui.lo \
-  mpz/swap.lo mpz/tdiv_ui.lo mpz/tdiv_q.lo mpz/tdiv_q_2exp.lo mpz/tdiv_q_ui.lo \
-  mpz/tdiv_qr.lo mpz/tdiv_qr_ui.lo mpz/tdiv_r.lo mpz/tdiv_r_2exp.lo \
-  mpz/tdiv_r_ui.lo mpz/tstbit.lo mpz/ui_pow_ui.lo mpz/urandomb.lo \
-  mpz/urandomm.lo mpz/xor.lo
-MPQ_OBJECTS = mpq/add.lo mpq/canonicalize.lo mpq/clear.lo mpq/cmp.lo \
-  mpq/cmp_ui.lo mpq/div.lo mpq/get_d.lo mpq/get_den.lo mpq/get_num.lo \
-  mpq/init.lo mpq/inv.lo mpq/mul.lo mpq/neg.lo mpq/out_str.lo \
-  mpq/set.lo mpq/set_den.lo \
-  mpq/set_num.lo mpq/set_si.lo mpq/set_ui.lo mpq/sub.lo mpq/equal.lo \
-  mpq/set_z.lo mpq/set_d.lo mpq/swap.lo
-MPN_OBJECTS = @mpn_objs_in_libgmp@
-
-MPBSD_OBJECTS = mpbsd/add.lo mpbsd/tdiv_qr.lo mpbsd/move.lo mpbsd/powm.lo \
-  mpbsd/sub.lo mpbsd/cmp.lo mpbsd/mfree.lo mpbsd/mtox.lo mpbsd/realloc.lo \
-  mpbsd/gcd.lo mpbsd/itom.lo mpbsd/min.lo mpbsd/mul.lo mpbsd/mout.lo	  \
-  mpbsd/pow_ui.lo mpbsd/sdiv.lo mpbsd/sqrtrem.lo mpbsd/xtom.lo 
-
-# FIXME: Add mpfr/rnd_mode.lo when it's clean.
-MPFR_OBJECTS = mpfr/add.lo mpfr/div_2exp.lo mpfr/neg.lo mpfr/set_dfl_prec.lo \
-  mpfr/set_str_raw.lo mpfr/agm.lo mpfr/get_str.lo mpfr/print_raw.lo \
-  mpfr/set_dfl_rnd.lo mpfr/sqrt.lo mpfr/clear.lo mpfr/init.lo \
-  mpfr/set_f.lo mpfr/sub.lo mpfr/cmp.lo mpfr/mul.lo mpfr/round.lo \
-  mpfr/set_prec.lo mpfr/cmp_ui.lo mpfr/mul_2exp.lo mpfr/set.lo mpfr/set_si.lo \
-  mpfr/div.lo mpfr/mul_ui.lo mpfr/set_d.lo mpfr/pow.lo mpfr/out_str.lo \
-  mpfr/pi.lo mpfr/set_z.lo mpfr/add_ulp.lo mpfr/log2.lo mpfr/random.lo \
-  mpfr/log.lo mpfr/exp.lo mpfr/div_ui.lo mpfr/zeta.lo mpfr/karadiv.lo \
-  mpfr/karasqrt.lo mpfr/print_rnd_mode.lo
-
-
-if WANT_MPFR
-MPFR_HEADERS_OPTION = mpfr/mpfr.h
-MPFR_OBJECTS_OPTION = $(MPFR_OBJECTS)
-MPFR_LIBADD_OPTION = -lm
-endif
-libgmp_la_SOURCES = assert.c compat.c errno.c memory.c mp_set_fns.c	 \
-  mp_clz_tab.c mp_minv_tab.c						 \
-  rand.c randclr.c randlc.c randlc2x.c randraw.c randsd.c		 \
-  randsdui.c version.c stack-alloc.c mp_bpl.c extract-dbl.c insert-dbl.c
-libgmp_la_DEPENDENCIES = \
-  $(MPF_OBJECTS) $(MPZ_OBJECTS) $(MPN_OBJECTS) $(MPQ_OBJECTS) \
-  $(MPFR_OBJECTS_OPTION)
-libgmp_la_LIBADD = $(libgmp_la_DEPENDENCIES) $(MPFR_LIBADD_OPTION)
-libgmp_la_LDFLAGS = \
-  -version-info $(LIBGMP_LT_CURRENT):$(LIBGMP_LT_REVISION):$(LIBGMP_LT_AGE)
-
-
-if WANT_MPBSD
-MPBSD_HEADERS_OPTION = mp.h
-MPBSD_LTLIBRARIES_OPTION = libmp.la
-endif
-libmp_la_SOURCES = assert.c errno.c memory.c mp_bpl.c mp_clz_tab.c	\
-  mp_minv_tab.c mp_set_fns.c stack-alloc.c
-libmp_la_DEPENDENCIES = $(MPBSD_OBJECTS) $(MPN_OBJECTS)			\
-  mpz/add.lo mpz/clear.lo mpz/cmp.lo mpz/init.lo mpz/mod.lo mpz/mul.lo	\
-  mpz/mul_2exp.lo mpz/realloc.lo mpz/set.lo mpz/set_ui.lo mpz/tdiv_r.lo	\
-  mpz/sub.lo
-libmp_la_LIBADD = $(libmp_la_DEPENDENCIES)
-libmp_la_LDFLAGS = \
-  -version-info $(LIBMP_LT_CURRENT):$(LIBMP_LT_REVISION):$(LIBMP_LT_AGE)
-
-
-info_TEXINFOS = gmp.texi
-
-
-# Don't ship CVS directories or emacs backups.
-dist-hook:
-	-find $(distdir) \( -name CVS -type d \) -o -name "*.~*" \
-		| xargs rm -rf
diff --git a/ghc/rts/gmp/Makefile.in b/ghc/rts/gmp/Makefile.in
deleted file mode 100644
index e63383e7a7..0000000000
--- a/ghc/rts/gmp/Makefile.in
+++ /dev/null
@@ -1,932 +0,0 @@
-# Makefile.in generated automatically by automake 1.4a from Makefile.am
-
-# Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
-# This Makefile.in is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
-# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-# PARTICULAR PURPOSE.
-
-SHELL = @SHELL@
-
-srcdir = @srcdir@
-top_srcdir = @top_srcdir@
-VPATH = @srcdir@
-prefix = @prefix@
-exec_prefix = @exec_prefix@
-
-bindir = @bindir@
-sbindir = @sbindir@
-libexecdir = @libexecdir@
-datadir = @datadir@
-sysconfdir = @sysconfdir@
-sharedstatedir = @sharedstatedir@
-localstatedir = @localstatedir@
-libdir = @libdir@
-infodir = @infodir@
-mandir = @mandir@
-includedir = @includedir@
-oldincludedir = /usr/include
-
-DESTDIR =
-
-pkgdatadir = $(datadir)/@PACKAGE@
-pkglibdir = $(libdir)/@PACKAGE@
-pkgincludedir = $(includedir)/@PACKAGE@
-
-top_builddir = .
-
-ACLOCAL = @ACLOCAL@
-AUTOCONF = @AUTOCONF@
-AUTOMAKE = @AUTOMAKE@
-AUTOHEADER = @AUTOHEADER@
-
-INSTALL = @INSTALL@
-INSTALL_PROGRAM = @INSTALL_PROGRAM@
-INSTALL_DATA = @INSTALL_DATA@
-INSTALL_SCRIPT = @INSTALL_SCRIPT@
-INSTALL_STRIP_FLAG =
-transform = @program_transform_name@
-
-NORMAL_INSTALL = :
-PRE_INSTALL = :
-POST_INSTALL = :
-NORMAL_UNINSTALL = :
-PRE_UNINSTALL = :
-POST_UNINSTALL = :
-
-@SET_MAKE@
-build_alias = @build_alias@
-build_triplet = @build@
-host_alias = @host_alias@
-host_triplet = @host@
-target_alias = @target_alias@
-target_triplet = @target@
-AMDEP = @AMDEP@
-AMTAR = @AMTAR@
-AR = @AR@
-AS = @AS@
-AWK = @AWK@
-CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
-CC = @CC@
-CCAS = @CCAS@
-CPP = @CPP@
-CXX = @CXX@
-CXXCPP = @CXXCPP@
-DEPDIR = @DEPDIR@
-DLLTOOL = @DLLTOOL@
-EXEEXT = @EXEEXT@
-LIBTOOL = @LIBTOOL@
-LN_S = @LN_S@
-M4 = @M4@
-MAINT = @MAINT@
-MAKEINFO = @MAKEINFO@
-OBJDUMP = @OBJDUMP@
-OBJEXT = @OBJEXT@
-PACKAGE = @PACKAGE@
-RANLIB = @RANLIB@
-SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
-STRIP = @STRIP@
-U = @U@
-VERSION = @VERSION@
-gmp_srclinks = @gmp_srclinks@
-install_sh = @install_sh@
-mpn_objects = @mpn_objects@
-mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
-
-# Copyright (C) 1991, 1993, 1994, 1996, 1997, 1999, 2000 Free Software
-# Foundation, Inc.
-#
-# This file is part of the GNU MP Library.
-#
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-#
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-# make check
-#
-#     It'd be good if "make check" first did a "make all" or whatever to
-#     build libgmp.la, but it's not clear how best to do this.  Putting a
-#     "check:" target is overridden by automake, and a "check-local:" runs
-#     too late (due to depth-first subdirectory processing).  For now it's
-#     necessary to do "make && make check".
-#
-# MPF_OBJECTS etc
-#
-#     Libtool needs all the .lo files passed to it if it's going to build
-#     both a static and shared library.  If a convenience library like
-#     mpf/libmpf.la is passed then the resulting libgmp.a gets the PIC .lo
-#     objects rather than the non-PIC .o's.
-#
-#     Unfortunately this leads to the big lists of objects below.  Something
-#     like mpz/*.lo would probably work, but might risk missing something
-#     out or getting something extra.  The source files for each .lo are
-#     listed in the Makefile.am's in the subdirectories.
-
-# Libtool -version-info for libgmp.la and libmp.la.  See (libtool)Versioning
-#
-# 1. No interfaces changed, only implementations (good): Increment REVISION.
-#
-# 2. Interfaces added, none removed (good): Increment CURRENT, increment
-#    AGE, set REVISION to 0.
-#
-# 3. Interfaces removed (BAD, breaks upward compatibility): Increment
-#    CURRENT, set AGE and REVISION to 0.
-#
-# Do this separately for libgmp and libmp, only do it just before a release.
-#
-#	  GMP	   -version-info
-#	release   libgmp  libmp
-#	 2.0.x      -       -
-#	 3.0      3:0:0   3:0:0
-#        3.0.1    3:1:0   3:0:0
-#        3.1      4:0:1   4:0:1
-#        3.1.1    4:1:1   4:1:1
-#
-#
-# Starting at 3:0:0 is a slight abuse of the versioning system, but it
-# ensures we're past soname libgmp.so.2, which is what has been used on
-# Debian GNU/Linux packages of gmp 2.  Pretend gmp 2 was 2:0:0, so the
-# interface changes for gmp 3 mean 3:0:0 is right.
-
-
-LIBGMP_LT_CURRENT = 4
-LIBGMP_LT_REVISION = 1
-LIBGMP_LT_AGE = 1
-
-LIBMP_LT_CURRENT = 4
-LIBMP_LT_REVISION = 1
-LIBMP_LT_AGE = 1
-
-AUTOMAKE_OPTIONS = gnu check-news no-dependencies ansi2knr
-
-SUBDIRS = mpn mpz
-
-include_HEADERS = gmp.h $(MPBSD_HEADERS_OPTION) $(MPFR_HEADERS_OPTION)
-EXTRA_HEADERS = mp.h
-
-lib_LTLIBRARIES = libgmp.la $(MPBSD_LTLIBRARIES_OPTION)
-
-EXTRA_DIST = .gdbinit gmp-impl.h longlong.h stack-alloc.h urandom.h doc macos
-
-DISTCLEANFILES = asm-syntax.h config.m4 @gmp_srclinks@
-
-MPZ_OBJECTS = mpz/abs.lo mpz/add.lo mpz/add_ui.lo mpz/addmul_ui.lo mpz/and.lo \
-  mpz/array_init.lo mpz/bin_ui.lo mpz/bin_uiui.lo mpz/cdiv_q.lo \
-  mpz/cdiv_q_ui.lo mpz/cdiv_qr.lo mpz/cdiv_qr_ui.lo mpz/cdiv_r.lo \
-  mpz/cdiv_r_ui.lo mpz/cdiv_ui.lo mpz/clear.lo mpz/clrbit.lo mpz/cmp.lo \
-  mpz/cmp_si.lo mpz/cmp_ui.lo mpz/cmpabs.lo mpz/cmpabs_ui.lo mpz/com.lo \
-  mpz/divexact.lo mpz/dump.lo mpz/fac_ui.lo mpz/fdiv_q.lo mpz/fdiv_q_2exp.lo \
-  mpz/fdiv_q_ui.lo mpz/fdiv_qr.lo mpz/fdiv_qr_ui.lo mpz/fdiv_r.lo \
-  mpz/fdiv_r_2exp.lo mpz/fdiv_r_ui.lo mpz/fdiv_ui.lo mpz/fib_ui.lo \
-  mpz/fits_sint_p.lo mpz/fits_slong_p.lo mpz/fits_sshort_p.lo \
-  mpz/fits_uint_p.lo mpz/fits_ulong_p.lo mpz/fits_ushort_p.lo mpz/gcd.lo \
-  mpz/gcd_ui.lo mpz/gcdext.lo mpz/get_d.lo mpz/get_si.lo mpz/get_str.lo \
-  mpz/get_ui.lo mpz/getlimbn.lo mpz/hamdist.lo mpz/init.lo mpz/inp_raw.lo \
-  mpz/inp_str.lo mpz/invert.lo mpz/ior.lo mpz/iset.lo mpz/iset_d.lo \
-  mpz/iset_si.lo mpz/iset_str.lo mpz/iset_ui.lo mpz/jacobi.lo \
-  mpz/kronsz.lo mpz/kronuz.lo mpz/kronzs.lo mpz/kronzu.lo \
-  mpz/lcm.lo mpz/legendre.lo \
-  mpz/mod.lo mpz/mul.lo mpz/mul_2exp.lo mpz/mul_si.lo mpz/mul_ui.lo \
-  mpz/neg.lo mpz/nextprime.lo mpz/out_raw.lo mpz/out_str.lo mpz/perfpow.lo mpz/perfsqr.lo \
-  mpz/popcount.lo mpz/pow_ui.lo mpz/powm.lo mpz/powm_ui.lo mpz/pprime_p.lo \
-  mpz/random.lo mpz/random2.lo mpz/realloc.lo mpz/remove.lo mpz/root.lo \
-  mpz/rrandomb.lo \
-  mpz/scan0.lo mpz/scan1.lo mpz/set.lo mpz/set_d.lo mpz/set_f.lo mpz/set_q.lo \
-  mpz/set_si.lo mpz/set_str.lo mpz/set_ui.lo mpz/setbit.lo mpz/size.lo \
-  mpz/sizeinbase.lo mpz/sqrt.lo mpz/sqrtrem.lo mpz/sub.lo mpz/sub_ui.lo \
-  mpz/swap.lo mpz/tdiv_ui.lo mpz/tdiv_q.lo mpz/tdiv_q_2exp.lo mpz/tdiv_q_ui.lo \
-  mpz/tdiv_qr.lo mpz/tdiv_qr_ui.lo mpz/tdiv_r.lo mpz/tdiv_r_2exp.lo \
-  mpz/tdiv_r_ui.lo mpz/tstbit.lo mpz/ui_pow_ui.lo mpz/urandomb.lo \
-  mpz/urandomm.lo mpz/xor.lo
-
-MPN_OBJECTS = @mpn_objs_in_libgmp@
-
-MPBSD_OBJECTS = mpbsd/add.lo mpbsd/tdiv_qr.lo mpbsd/move.lo mpbsd/powm.lo \
-  mpbsd/sub.lo mpbsd/cmp.lo mpbsd/mfree.lo mpbsd/mtox.lo mpbsd/realloc.lo \
-  mpbsd/gcd.lo mpbsd/itom.lo mpbsd/min.lo mpbsd/mul.lo mpbsd/mout.lo	  \
-  mpbsd/pow_ui.lo mpbsd/sdiv.lo mpbsd/sqrtrem.lo mpbsd/xtom.lo 
-
-
-
-@WANT_MPFR_TRUE@MPFR_HEADERS_OPTION = @WANT_MPFR_TRUE@mpfr/mpfr.h
-@WANT_MPFR_TRUE@MPFR_OBJECTS_OPTION = @WANT_MPFR_TRUE@$(MPFR_OBJECTS)
-@WANT_MPFR_TRUE@MPFR_LIBADD_OPTION = @WANT_MPFR_TRUE@-lm
-libgmp_la_SOURCES = assert.c compat.c errno.c memory.c mp_set_fns.c	 \
-  mp_clz_tab.c mp_minv_tab.c						 \
-  version.c stack-alloc.c mp_bpl.c extract-dbl.c insert-dbl.c
-
-libgmp_la_DEPENDENCIES = \
-  $(MPF_OBJECTS) $(MPZ_OBJECTS) $(MPN_OBJECTS) $(MPQ_OBJECTS) \
-  $(MPFR_OBJECTS_OPTION)
-
-libgmp_la_LIBADD = $(libgmp_la_DEPENDENCIES) $(MPFR_LIBADD_OPTION)
-libgmp_la_LDFLAGS = \
-  -version-info $(LIBGMP_LT_CURRENT):$(LIBGMP_LT_REVISION):$(LIBGMP_LT_AGE)
-
-
-@WANT_MPBSD_TRUE@MPBSD_HEADERS_OPTION = @WANT_MPBSD_TRUE@mp.h
-@WANT_MPBSD_TRUE@MPBSD_LTLIBRARIES_OPTION = @WANT_MPBSD_TRUE@libmp.la
-libmp_la_SOURCES = assert.c errno.c memory.c mp_bpl.c mp_clz_tab.c	\
-  mp_minv_tab.c mp_set_fns.c stack-alloc.c
-
-libmp_la_DEPENDENCIES = $(MPBSD_OBJECTS) $(MPN_OBJECTS)			\
-  mpz/add.lo mpz/clear.lo mpz/cmp.lo mpz/init.lo mpz/mod.lo mpz/mul.lo	\
-  mpz/mul_2exp.lo mpz/realloc.lo mpz/set.lo mpz/set_ui.lo mpz/tdiv_r.lo	\
-  mpz/sub.lo
-
-libmp_la_LIBADD = $(libmp_la_DEPENDENCIES)
-libmp_la_LDFLAGS = \
-  -version-info $(LIBMP_LT_CURRENT):$(LIBMP_LT_REVISION):$(LIBMP_LT_AGE)
-
-
-info_TEXINFOS = gmp.texi
-subdir = .
-ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
-mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
-CONFIG_HEADER = config.h
-CONFIG_CLEAN_FILES = 
-LTLIBRARIES =  $(lib_LTLIBRARIES)
-
-
-DEFS = @DEFS@ -I. -I$(srcdir) -I.
-CPPFLAGS = @CPPFLAGS@
-LDFLAGS = @LDFLAGS@
-LIBS = @LIBS@
-ANSI2KNR = @ANSI2KNR@
-am_libgmp_la_OBJECTS =  assert$U.lo compat$U.lo errno$U.lo memory$U.lo \
-mp_set_fns$U.lo mp_clz_tab$U.lo mp_minv_tab$U.lo rand$U.lo randclr$U.lo \
-randlc$U.lo randlc2x$U.lo randraw$U.lo randsd$U.lo randsdui$U.lo \
-version$U.lo stack-alloc$U.lo mp_bpl$U.lo extract-dbl$U.lo \
-insert-dbl$U.lo
-libgmp_la_OBJECTS =  $(am_libgmp_la_OBJECTS)
-am_libmp_la_OBJECTS =  assert$U.lo errno$U.lo memory$U.lo mp_bpl$U.lo \
-mp_clz_tab$U.lo mp_minv_tab$U.lo mp_set_fns$U.lo stack-alloc$U.lo
-libmp_la_OBJECTS =  $(am_libmp_la_OBJECTS)
-COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
-LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
-CFLAGS = @CFLAGS@
-CCLD = $(CC)
-LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
-DIST_SOURCES =  $(libgmp_la_SOURCES) $(libmp_la_SOURCES)
-TEXI2DVI = texi2dvi
-# INFO_DEPS = gmp.info
-DVIS = gmp.dvi
-TEXINFOS = gmp.texi
-HEADERS =  $(include_HEADERS)
-
-DIST_COMMON =  README $(EXTRA_HEADERS) $(include_HEADERS) ./stamp-h.in \
-AUTHORS COPYING COPYING.LIB ChangeLog INSTALL Makefile.am Makefile.in \
-NEWS acconfig.h acinclude.m4 aclocal.m4 ansi2knr.1 ansi2knr.c \
-config.guess config.in config.sub configure configure.in depcomp \
-install-sh ltconfig ltmain.sh mdate-sh missing mkinstalldirs stamp-vti \
-texinfo.tex version.texi
-
-
-DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
-
-GZIP_ENV = --best
-depcomp = 
-SOURCES = $(libgmp_la_SOURCES) $(libmp_la_SOURCES)
-OBJECTS = $(am_libgmp_la_OBJECTS) $(am_libmp_la_OBJECTS)
-
-all: all-redirect
-.SUFFIXES:
-.SUFFIXES: .c .dvi .info .lo .o .obj .ps .texi .texinfo .txi
-$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
-	cd $(top_srcdir) && $(AUTOMAKE) --gnu Makefile
-
-Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
-	cd $(top_builddir) \
-	  && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status
-
-$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ configure.in  acinclude.m4
-	cd $(srcdir) && $(ACLOCAL)
-
-config.status: $(srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
-	$(SHELL) ./config.status --recheck
-$(srcdir)/configure: @MAINTAINER_MODE_TRUE@$(srcdir)/configure.in $(ACLOCAL_M4) $(CONFIGURE_DEPENDENCIES)
-	cd $(srcdir) && $(AUTOCONF)
-
-config.h: stamp-h
-	@if test ! -f $@; then \
-		rm -f stamp-h; \
-		$(MAKE) stamp-h; \
-	else :; fi
-stamp-h: $(srcdir)/config.in $(top_builddir)/config.status
-	@rm -f stamp-h stamp-hT
-	@echo timestamp > stamp-hT 2> /dev/null
-	cd $(top_builddir) \
-	  && CONFIG_FILES= CONFIG_HEADERS=config.h:config.in \
-	     $(SHELL) ./config.status
-	@mv stamp-hT stamp-h
-$(srcdir)/config.in: @MAINTAINER_MODE_TRUE@$(srcdir)/./stamp-h.in
-	@if test ! -f $@; then \
-		rm -f $(srcdir)/./stamp-h.in; \
-		$(MAKE) $(srcdir)/./stamp-h.in; \
-	else :; fi
-$(srcdir)/./stamp-h.in: $(top_srcdir)/configure.in $(ACLOCAL_M4) acconfig.h
-	@rm -f $(srcdir)/./stamp-h.in $(srcdir)/./stamp-h.inT
-	@echo timestamp > $(srcdir)/./stamp-h.inT 2> /dev/null
-	cd $(top_srcdir) && $(AUTOHEADER)
-	@mv $(srcdir)/./stamp-h.inT $(srcdir)/./stamp-h.in
-
-mostlyclean-hdr:
-
-clean-hdr:
-
-distclean-hdr:
-	-rm -f config.h
-
-maintainer-clean-hdr:
-
-mostlyclean-libLTLIBRARIES:
-
-clean-libLTLIBRARIES:
-	-test -z "$(lib_LTLIBRARIES)" || rm -f $(lib_LTLIBRARIES)
-
-distclean-libLTLIBRARIES:
-
-maintainer-clean-libLTLIBRARIES:
-
-install-libLTLIBRARIES: $(lib_LTLIBRARIES)
-	@$(NORMAL_INSTALL)
-	$(mkinstalldirs) $(DESTDIR)$(libdir)
-	@list='$(lib_LTLIBRARIES)'; for p in $$list; do \
-	  if test -f $$p; then \
-	    echo " $(LIBTOOL)  --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$p $(DESTDIR)$(libdir)/$$p"; \
-	    $(LIBTOOL)  --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$p $(DESTDIR)$(libdir)/$$p; \
-	  else :; fi; \
-	done
-
-uninstall-libLTLIBRARIES:
-	@$(NORMAL_UNINSTALL)
-	@list='$(lib_LTLIBRARIES)'; for p in $$list; do \
-	  echo " $(LIBTOOL)  --mode=uninstall rm -f $(DESTDIR)$(libdir)/$$p"; \
-	  $(LIBTOOL)  --mode=uninstall rm -f $(DESTDIR)$(libdir)/$$p; \
-	done
-
-mostlyclean-compile:
-	-rm -f *.o core *.core
-	-rm -f *.$(OBJEXT)
-
-clean-compile:
-
-distclean-compile:
-	-rm -f *.tab.c
-
-maintainer-clean-compile:
-
-mostlyclean-libtool:
-	-rm -f *.lo
-
-clean-libtool:
-	-rm -rf .libs _libs
-
-distclean-libtool:
-
-maintainer-clean-libtool:
-
-mostlyclean-krextra:
-
-clean-krextra:
-	-rm -f ansi2knr
-
-distclean-krextra:
-
-maintainer-clean-krextra:
-ansi2knr: ansi2knr.$(OBJEXT)
-	$(LINK) ansi2knr.$(OBJEXT) $(LIBS)
-ansi2knr.$(OBJEXT): $(CONFIG_HEADER)
-
-
-mostlyclean-kr:
-	-rm -f *_.c
-
-clean-kr:
-
-distclean-kr:
-
-maintainer-clean-kr:
-
-gmp.dll: libgmp.a
-	dllwrap -mno-cygwin --target=i386-unknown-mingw32 \
-		--export-all --dllname gmp.dll --output-lib=libgmp_imp.a \
-		-o gmp.dll libgmp.a
-
-libgmp.la: $(libgmp_la_OBJECTS) $(libgmp_la_DEPENDENCIES)
-	$(LINK) -rpath $(libdir) $(libgmp_la_LDFLAGS) $(libgmp_la_OBJECTS) $(libgmp_la_LIBADD) $(LIBS)
-
-libmp.la: $(libmp_la_OBJECTS) $(libmp_la_DEPENDENCIES)
-	$(LINK) -rpath $(libdir) $(libmp_la_LDFLAGS) $(libmp_la_OBJECTS) $(libmp_la_LIBADD) $(LIBS)
-.c.o:
-	$(COMPILE) -c $<
-.c.obj:
-	$(COMPILE) -c `cygpath -w $<`
-.c.lo:
-	$(LTCOMPILE) -c -o $@ $<
-assert_.c: assert.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/assert.c; then echo $(srcdir)/assert.c; else echo assert.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > assert_.c
-compat_.c: compat.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/compat.c; then echo $(srcdir)/compat.c; else echo compat.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > compat_.c
-errno_.c: errno.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/errno.c; then echo $(srcdir)/errno.c; else echo errno.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > errno_.c
-extract-dbl_.c: extract-dbl.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/extract-dbl.c; then echo $(srcdir)/extract-dbl.c; else echo extract-dbl.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > extract-dbl_.c
-insert-dbl_.c: insert-dbl.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/insert-dbl.c; then echo $(srcdir)/insert-dbl.c; else echo insert-dbl.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > insert-dbl_.c
-memory_.c: memory.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/memory.c; then echo $(srcdir)/memory.c; else echo memory.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > memory_.c
-mp_bpl_.c: mp_bpl.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/mp_bpl.c; then echo $(srcdir)/mp_bpl.c; else echo mp_bpl.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > mp_bpl_.c
-mp_clz_tab_.c: mp_clz_tab.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/mp_clz_tab.c; then echo $(srcdir)/mp_clz_tab.c; else echo mp_clz_tab.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > mp_clz_tab_.c
-mp_minv_tab_.c: mp_minv_tab.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/mp_minv_tab.c; then echo $(srcdir)/mp_minv_tab.c; else echo mp_minv_tab.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > mp_minv_tab_.c
-mp_set_fns_.c: mp_set_fns.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/mp_set_fns.c; then echo $(srcdir)/mp_set_fns.c; else echo mp_set_fns.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > mp_set_fns_.c
-rand_.c: rand.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/rand.c; then echo $(srcdir)/rand.c; else echo rand.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > rand_.c
-randclr_.c: randclr.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/randclr.c; then echo $(srcdir)/randclr.c; else echo randclr.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > randclr_.c
-randlc_.c: randlc.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/randlc.c; then echo $(srcdir)/randlc.c; else echo randlc.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > randlc_.c
-randlc2x_.c: randlc2x.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/randlc2x.c; then echo $(srcdir)/randlc2x.c; else echo randlc2x.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > randlc2x_.c
-randraw_.c: randraw.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/randraw.c; then echo $(srcdir)/randraw.c; else echo randraw.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > randraw_.c
-randsd_.c: randsd.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/randsd.c; then echo $(srcdir)/randsd.c; else echo randsd.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > randsd_.c
-randsdui_.c: randsdui.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/randsdui.c; then echo $(srcdir)/randsdui.c; else echo randsdui.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > randsdui_.c
-stack-alloc_.c: stack-alloc.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/stack-alloc.c; then echo $(srcdir)/stack-alloc.c; else echo stack-alloc.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > stack-alloc_.c
-version_.c: version.c $(ANSI2KNR)
-	$(CPP) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) `if test -f $(srcdir)/version.c; then echo $(srcdir)/version.c; else echo version.c; fi` | sed 's/^# \([0-9]\)/#line \1/' | $(ANSI2KNR) > version_.c
-assert_.$(OBJEXT) assert_.lo compat_.$(OBJEXT) compat_.lo \
-errno_.$(OBJEXT) errno_.lo extract-dbl_.$(OBJEXT) extract-dbl_.lo \
-insert-dbl_.$(OBJEXT) insert-dbl_.lo memory_.$(OBJEXT) memory_.lo \
-mp_bpl_.$(OBJEXT) mp_bpl_.lo mp_clz_tab_.$(OBJEXT) mp_clz_tab_.lo \
-mp_minv_tab_.$(OBJEXT) mp_minv_tab_.lo mp_set_fns_.$(OBJEXT) \
-mp_set_fns_.lo rand_.$(OBJEXT) rand_.lo randclr_.$(OBJEXT) randclr_.lo \
-randlc_.$(OBJEXT) randlc_.lo randlc2x_.$(OBJEXT) randlc2x_.lo \
-randraw_.$(OBJEXT) randraw_.lo randsd_.$(OBJEXT) randsd_.lo \
-randsdui_.$(OBJEXT) randsdui_.lo stack-alloc_.$(OBJEXT) stack-alloc_.lo \
-version_.$(OBJEXT) version_.lo : $(ANSI2KNR)
-
-$(srcdir)/version.texi: @MAINTAINER_MODE_TRUE@stamp-vti
-	@:
-
-$(srcdir)/stamp-vti: gmp.texi $(top_srcdir)/configure.in
-	@echo "@set UPDATED `$(SHELL) $(srcdir)/mdate-sh $(srcdir)/gmp.texi`" > vti.tmp
-	@echo "@set EDITION $(VERSION)" >> vti.tmp
-	@echo "@set VERSION $(VERSION)" >> vti.tmp
-	@cmp -s vti.tmp $(srcdir)/version.texi \
-	  || (echo "Updating $(srcdir)/version.texi"; \
-	      cp vti.tmp $(srcdir)/version.texi)
-	-@rm -f vti.tmp
-	@cp $(srcdir)/version.texi $@
-
-mostlyclean-vti:
-	-rm -f vti.tmp
-
-clean-vti:
-
-distclean-vti:
-
-maintainer-clean-vti:
-	-@MAINTAINER_MODE_TRUE@rm -f $(srcdir)/stamp-vti $(srcdir)/version.texi
-
-# gmp.info: gmp.texi version.texi
-# gmp.dvi: gmp.texi version.texi
-
-
-DVIPS = dvips
-
-.texi.info:
-	@cd $(srcdir) && rm -f $@ $@-[0-9] $@-[0-9][0-9]
-	cd $(srcdir) \
-	  && $(MAKEINFO) `echo $< | sed 's,.*/,,'`
-
-.texi.dvi:
-	TEXINPUTS=$(srcdir):$$TEXINPUTS \
-	  MAKEINFO='$(MAKEINFO) -I $(srcdir)' $(TEXI2DVI) $<
-
-.texi:
-	@cd $(srcdir) && rm -f $@ $@-[0-9] $@-[0-9][0-9]
-	cd $(srcdir) \
-	  && $(MAKEINFO) `echo $< | sed 's,.*/,,'`
-
-.texinfo.info:
-	@cd $(srcdir) && rm -f $@ $@-[0-9] $@-[0-9][0-9]
-	cd $(srcdir) \
-	  && $(MAKEINFO) `echo $< | sed 's,.*/,,'`
-
-.texinfo:
-	@cd $(srcdir) && rm -f $@ $@-[0-9] $@-[0-9][0-9]
-	cd $(srcdir) \
-	  && $(MAKEINFO) `echo $< | sed 's,.*/,,'`
-
-.texinfo.dvi:
-	TEXINPUTS=$(srcdir):$$TEXINPUTS \
-	  MAKEINFO='$(MAKEINFO) -I $(srcdir)' $(TEXI2DVI) $<
-
-.txi.info:
-	@cd $(srcdir) && rm -f $@ $@-[0-9] $@-[0-9][0-9]
-	cd $(srcdir) \
-	  && $(MAKEINFO) `echo $< | sed 's,.*/,,'`
-
-.txi.dvi:
-	TEXINPUTS=$(srcdir):$$TEXINPUTS \
-	  MAKEINFO='$(MAKEINFO) -I $(srcdir)' $(TEXI2DVI) $<
-
-.txi:
-	@cd $(srcdir) && rm -f $@ $@-[0-9] $@-[0-9][0-9]
-	cd $(srcdir) \
-	  && $(MAKEINFO) `echo $< | sed 's,.*/,,'`
-.dvi.ps:
-	$(DVIPS) $< -o $@
-
-install-info-am: $(INFO_DEPS)
-	@$(NORMAL_INSTALL)
-	$(mkinstalldirs) $(DESTDIR)$(infodir)
-	@list='$(INFO_DEPS)'; \
-	for file in $$list; do \
-	  d=$(srcdir); \
-	  for ifile in `CDPATH=: && cd $$d && echo $$file $$file-[0-9] $$file-[0-9][0-9]`; do \
-	    if test -f $$d/$$ifile; then \
-	      echo " $(INSTALL_DATA) $$d/$$ifile $(DESTDIR)$(infodir)/$$ifile"; \
-	      $(INSTALL_DATA) $$d/$$ifile $(DESTDIR)$(infodir)/$$ifile; \
-	    else : ; fi; \
-	  done; \
-	done
-	@$(POST_INSTALL)
-	@if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \
-	  list='$(INFO_DEPS)'; \
-	  for file in $$list; do \
-	    echo " install-info --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/$$file";\
-	    install-info --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/$$file || :;\
-	  done; \
-	else : ; fi
-
-uninstall-info:
-	$(PRE_UNINSTALL)
-	@if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \
-	  list='$(INFO_DEPS)'; \
-	  for file in $$list; do \
-	    echo " install-info --info-dir=$(DESTDIR)$(infodir) --remove $(DESTDIR)$(infodir)/$$file"; \
-	    install-info --info-dir=$(DESTDIR)$(infodir) --remove $(DESTDIR)$(infodir)/$$file; \
-	  done; \
-	else :; fi
-	@$(NORMAL_UNINSTALL)
-	@list='$(INFO_DEPS)'; \
-	for file in $$list; do \
-	  (if cd $(DESTDIR)$(infodir); then \
-	     echo " rm -f $$file $$file-[0-9] $$file-[0-9][0-9])"; \
-	     rm -f $$file $$file-[0-9] $$file-[0-9][0-9]; \
-	   else :; fi); \
-	done
-
-dist-info: $(INFO_DEPS)
-	list='$(INFO_DEPS)'; \
-	for base in $$list; do \
-	  d=$(srcdir); \
-	  for file in `CDPATH=: && cd $$d && eval echo $$base*`; do \
-	    test -f $(distdir)/$$file \
-	    || cp -p $$d/$$file $(distdir)/$$file; \
-	  done; \
-	done
-
-mostlyclean-aminfo:
-	-rm -f gmp.aux gmp.cp gmp.cps gmp.dvi gmp.fn gmp.fns gmp.pgs gmp.ky \
-	  gmp.kys gmp.ps gmp.log gmp.pg gmp.toc gmp.tp gmp.tps gmp.vr \
-	  gmp.vrs gmp.op gmp.tr gmp.cv gmp.cn gmp.cm gmp.ov
-
-clean-aminfo:
-
-distclean-aminfo:
-
-maintainer-clean-aminfo:
-	cd $(srcdir) && for i in $(INFO_DEPS); do \
-	  rm -f $$i; \
-	  if test "`echo $$i-[0-9]*`" != "$$i-[0-9]*"; then \
-	    rm -f $$i-[0-9]*; \
-	  fi; \
-	done
-
-install-includeHEADERS: $(include_HEADERS)
-	@$(NORMAL_INSTALL)
-	$(mkinstalldirs) $(DESTDIR)$(includedir)
-	@list='$(include_HEADERS)'; for p in $$list; do \
-	  if test -f "$$p"; then d= ; else d="$(srcdir)/"; fi; \
-	  f="`echo $$p | sed -e 's|^.*/||'`"; \
-	  echo " $(INSTALL_DATA) $$d$$p $(DESTDIR)$(includedir)/$$f"; \
-	  $(INSTALL_DATA) $$d$$p $(DESTDIR)$(includedir)/$$f; \
-	done
-
-uninstall-includeHEADERS:
-	@$(NORMAL_UNINSTALL)
-	@list='$(include_HEADERS)'; for p in $$list; do \
-	  f="`echo $$p | sed -e 's|^.*/||'`"; \
-	  echo " rm -f $(DESTDIR)$(includedir)/$$f"; \
-	  rm -f $(DESTDIR)$(includedir)/$$f; \
-	done
-
-# This directory's subdirectories are mostly independent; you can cd
-# into them and run `make' without going through this Makefile.
-# To change the values of `make' variables: instead of editing Makefiles,
-# (1) if the variable is set in `config.status', edit `config.status'
-#     (which will cause the Makefiles to be regenerated when you run `make');
-# (2) otherwise, pass the desired values on the `make' command line.
-
-all-recursive install-data-recursive install-exec-recursive \
-installdirs-recursive install-recursive uninstall-recursive  \
-check-recursive installcheck-recursive info-recursive dvi-recursive:
-	@set fnord $(MAKEFLAGS); amf=$$2; \
-	dot_seen=no; \
-	target=`echo $@ | sed s/-recursive//`; \
-	list='$(SUBDIRS)'; for subdir in $$list; do \
-	  echo "Making $$target in $$subdir"; \
-	  if test "$$subdir" = "."; then \
-	    dot_seen=yes; \
-	    local_target="$$target-am"; \
-	  else \
-	    local_target="$$target"; \
-	  fi; \
-	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
-	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
-	done; \
-	if test "$$dot_seen" = "no"; then \
-	  $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
-	fi; test -z "$$fail"
-
-mostlyclean-recursive clean-recursive distclean-recursive \
-maintainer-clean-recursive:
-	@set fnord $(MAKEFLAGS); amf=$$2; \
-	dot_seen=no; \
-	rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
-	  rev="$$subdir $$rev"; \
-	  if test "$$subdir" = "."; then dot_seen=yes; else :; fi; \
-	done; \
-	test "$$dot_seen" = "no" && rev=". $$rev"; \
-	target=`echo $@ | sed s/-recursive//`; \
-	for subdir in $$rev; do \
-	  echo "Making $$target in $$subdir"; \
-	  if test "$$subdir" = "."; then \
-	    local_target="$$target-am"; \
-	  else \
-	    local_target="$$target"; \
-	  fi; \
-	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
-	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
-	done && test -z "$$fail"
-tags-recursive:
-	list='$(SUBDIRS)'; for subdir in $$list; do \
-	  test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
-	done
-
-tags: TAGS
-
-ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
-	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
-	unique=`for i in $$list; do \
-	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
-	  done | \
-	  $(AWK) '    { files[$$0] = 1; } \
-	       END { for (i in files) print i; }'`; \
-	mkid -f$$here/ID $$unique $(LISP)
-
-TAGS: tags-recursive $(HEADERS) $(SOURCES) config.in $(TAGS_DEPENDENCIES) \
-		$(TAGS_FILES) $(LISP)
-	tags=; \
-	here=`pwd`; \
-	list='$(SUBDIRS)'; for subdir in $$list; do \
-   if test "$$subdir" = .; then :; else \
-	    test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
-   fi; \
-	done; \
-	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
-	unique=`for i in $$list; do \
-	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
-	  done | \
-	  $(AWK) '    { files[$$0] = 1; } \
-	       END { for (i in files) print i; }'`; \
-	test -z "$(ETAGS_ARGS)config.in$$unique$(LISP)$$tags" \
-	  || etags $(ETAGS_ARGS) $$tags config.in $$unique $(LISP)
-
-mostlyclean-tags:
-
-clean-tags:
-
-distclean-tags:
-	-rm -f TAGS ID
-
-maintainer-clean-tags:
-
-distdir = $(PACKAGE)-$(VERSION)
-top_distdir = $(distdir)
-
-
-# This target untars the dist file and tries a VPATH configuration.  Then
-# it guarantees that the distribution is self-contained by making another
-# tarfile.
-distcheck: dist
-	-chmod -R a+w $(distdir) > /dev/null 2>&1; rm -rf $(distdir)
-	GZIP=$(GZIP_ENV) gunzip -c $(distdir).tar.gz | $(AMTAR) xf -
-	chmod -R a-w $(distdir); chmod a+w $(distdir)
-	mkdir $(distdir)/=build
-	mkdir $(distdir)/=inst
-	chmod a-w $(distdir)
-	dc_install_base=`CDPATH=: && cd $(distdir)/=inst && pwd` \
-	  && cd $(distdir)/=build \
-	  && ../configure --srcdir=.. --prefix=$$dc_install_base \
-	  && $(MAKE) $(AM_MAKEFLAGS) \
-	  && $(MAKE) $(AM_MAKEFLAGS) dvi \
-	  && $(MAKE) $(AM_MAKEFLAGS) check \
-	  && $(MAKE) $(AM_MAKEFLAGS) install \
-	  && $(MAKE) $(AM_MAKEFLAGS) installcheck \
-	  && $(MAKE) $(AM_MAKEFLAGS) uninstall \
-	  && test `find $$dc_install_base -type f -print | wc -l` -le 1 \
-	  && $(MAKE) $(AM_MAKEFLAGS) dist \
-	  && $(MAKE) $(AM_MAKEFLAGS) distclean \
-	  && rm -f $(distdir).tar.gz \
-	  && test `find . -type f -print | wc -l` -eq 0
-	-chmod -R a+w $(distdir) > /dev/null 2>&1; rm -rf $(distdir)
-	@banner="$(distdir).tar.gz is ready for distribution"; \
-	dashes=`echo "$$banner" | sed s/./=/g`; \
-	echo "$$dashes"; \
-	echo "$$banner"; \
-	echo "$$dashes"
-dist: distdir
-	-find $(distdir) -type d ! -perm -777 -exec chmod a+rwx {} \; -o \
-	  ! -type d ! -perm -444 -links 1 -exec chmod a+r {} \; -o \
-	  ! -type d ! -perm -400 -exec chmod a+r {} \; -o \
-	  ! -type d ! -perm -444 -exec $(SHELL) $(install_sh) -c -m a+r {} {} \; \
-	|| chmod -R a+r $(distdir)
-	$(AMTAR) chof - $(distdir) | GZIP=$(GZIP_ENV) gzip -c > $(distdir).tar.gz
-	-chmod -R a+w $(distdir) > /dev/null 2>&1; rm -rf $(distdir)
-dist-all: distdir
-	-find $(distdir) -type d ! -perm -777 -exec chmod a+rwx {} \; -o \
-	  ! -type d ! -perm -444 -links 1 -exec chmod a+r {} \; -o \
-	  ! -type d ! -perm -400 -exec chmod a+r {} \; -o \
-	  ! -type d ! -perm -444 -exec $(SHELL) $(install_sh) -c -m a+r {} {} \; \
-	|| chmod -R a+r $(distdir)
-	$(AMTAR) chof - $(distdir) | GZIP=$(GZIP_ENV) gzip -c > $(distdir).tar.gz
-	-chmod -R a+w $(distdir) > /dev/null 2>&1; rm -rf $(distdir)
-distdir: $(DISTFILES)
-	@if sed 15q $(srcdir)/NEWS | fgrep -e "$(VERSION)" > /dev/null; then :; else \
-	  echo "NEWS not updated; not releasing" 1>&2; \
-	  exit 1; \
-	fi
-	-chmod -R a+w $(distdir) > /dev/null 2>&1; rm -rf $(distdir)
-	mkdir $(distdir)
-	$(mkinstalldirs) $(distdir)/mpfr
-	@for file in $(DISTFILES); do \
-	  d=$(srcdir); \
-	  if test -d $$d/$$file; then \
-	    cp -pR $$d/$$file $(distdir); \
-	  else \
-	    test -f $(distdir)/$$file \
-	    || cp -p $$d/$$file $(distdir)/$$file || :; \
-	  fi; \
-	done
-	for subdir in $(SUBDIRS); do \
-	  if test "$$subdir" = .; then :; else \
-	    test -d $(distdir)/$$subdir \
-	    || mkdir $(distdir)/$$subdir \
-	    || exit 1; \
-	    (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(distdir) distdir=../$(distdir)/$$subdir distdir) \
-	      || exit 1; \
-	  fi; \
-	done
-	$(MAKE) $(AM_MAKEFLAGS) top_distdir="$(top_distdir)" distdir="$(distdir)" dist-info
-	$(MAKE) $(AM_MAKEFLAGS) top_distdir="$(top_distdir)" distdir="$(distdir)" dist-hook
-info-am: $(INFO_DEPS)
-info: info-recursive
-dvi-am: $(DVIS)
-dvi: dvi-recursive
-check-am: all-am
-check: check-recursive
-installcheck-am:
-installcheck: installcheck-recursive
-all-recursive-am: config.h
-	$(MAKE) $(AM_MAKEFLAGS) all-recursive
-
-install-exec-am: install-libLTLIBRARIES
-install-exec: install-exec-recursive
-
-install-data-am: install-info-am install-includeHEADERS
-install-data: install-data-recursive
-
-install-am: all-am
-	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
-install: install-recursive
-uninstall-am: uninstall-libLTLIBRARIES uninstall-info \
-		uninstall-includeHEADERS
-uninstall: uninstall-recursive
-all-am: Makefile $(INFO_DEPS) $(ANSI2KNR) $(LTLIBRARIES) $(HEADERS) \
-		config.h
-all-redirect: all-recursive-am
-install-strip:
-	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
-installdirs: installdirs-recursive
-installdirs-am:
-	$(mkinstalldirs)  $(DESTDIR)$(libdir) $(DESTDIR)$(infodir) \
-		$(DESTDIR)$(includedir)
-
-
-mostlyclean-generic:
-
-clean-generic:
-
-distclean-generic:
-	-rm -f Makefile $(CONFIG_CLEAN_FILES)
-	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
-	-test -z "$(DISTCLEANFILES)" || rm -f $(DISTCLEANFILES)
-
-maintainer-clean-generic:
-	-rm -f Makefile.in
-mostlyclean-am:  mostlyclean-hdr mostlyclean-libLTLIBRARIES \
-		mostlyclean-compile mostlyclean-libtool \
-		mostlyclean-krextra mostlyclean-kr mostlyclean-vti \
-		mostlyclean-aminfo mostlyclean-tags mostlyclean-generic
-
-mostlyclean: mostlyclean-recursive
-
-clean-am:  clean-hdr clean-libLTLIBRARIES clean-compile clean-libtool \
-		clean-krextra clean-kr clean-vti clean-aminfo \
-		clean-tags clean-generic mostlyclean-am
-
-clean: clean-recursive
-
-distclean-am:  distclean-hdr distclean-libLTLIBRARIES distclean-compile \
-		distclean-libtool distclean-krextra distclean-kr \
-		distclean-vti distclean-aminfo distclean-tags \
-		distclean-generic clean-am
-	-rm -f libtool
-
-distclean: distclean-recursive
-	-rm -f config.status
-
-maintainer-clean-am:  maintainer-clean-hdr \
-		maintainer-clean-libLTLIBRARIES \
-		maintainer-clean-compile maintainer-clean-libtool \
-		maintainer-clean-krextra maintainer-clean-kr \
-		maintainer-clean-vti maintainer-clean-aminfo \
-		maintainer-clean-tags maintainer-clean-generic \
-		distclean-am
-	@echo "This command is intended for maintainers to use;"
-	@echo "it deletes files that may require special tools to rebuild."
-
-maintainer-clean: maintainer-clean-recursive
-	-rm -f config.status
-
-.PHONY: mostlyclean-hdr distclean-hdr clean-hdr maintainer-clean-hdr \
-mostlyclean-libLTLIBRARIES distclean-libLTLIBRARIES \
-clean-libLTLIBRARIES maintainer-clean-libLTLIBRARIES \
-uninstall-libLTLIBRARIES install-libLTLIBRARIES mostlyclean-compile \
-distclean-compile clean-compile maintainer-clean-compile \
-mostlyclean-libtool distclean-libtool clean-libtool \
-maintainer-clean-libtool mostlyclean-krextra distclean-krextra \
-clean-krextra maintainer-clean-krextra mostlyclean-kr distclean-kr \
-clean-kr maintainer-clean-kr mostlyclean-vti distclean-vti clean-vti \
-maintainer-clean-vti install-info-am uninstall-info mostlyclean-aminfo \
-distclean-aminfo clean-aminfo maintainer-clean-aminfo \
-uninstall-includeHEADERS install-includeHEADERS install-recursive \
-uninstall-recursive install-data-recursive uninstall-data-recursive \
-install-exec-recursive uninstall-exec-recursive installdirs-recursive \
-uninstalldirs-recursive all-recursive check-recursive \
-installcheck-recursive info-recursive dvi-recursive \
-mostlyclean-recursive distclean-recursive clean-recursive \
-maintainer-clean-recursive tags tags-recursive mostlyclean-tags \
-distclean-tags clean-tags maintainer-clean-tags distdir info-am info \
-dvi-am dvi check check-am installcheck-am installcheck all-recursive-am \
-install-exec-am install-exec install-data-am install-data install-am \
-install uninstall-am uninstall all-redirect all-am all install-strip \
-installdirs-am installdirs mostlyclean-generic distclean-generic \
-clean-generic maintainer-clean-generic clean mostlyclean distclean \
-maintainer-clean
-
-
-# Don't ship CVS directories or emacs backups.
-dist-hook:
-	-find $(distdir) \( -name CVS -type d \) -o -name "*.~*" \
-		| xargs rm -rf
-
-# Tell versions [3.59,3.63) of GNU make to not export all variables.
-# Otherwise a system limit (for SysV at least) may be exceeded.
-.NOEXPORT:
diff --git a/ghc/rts/gmp/NEWS b/ghc/rts/gmp/NEWS
deleted file mode 100644
index 3b549d59f3..0000000000
--- a/ghc/rts/gmp/NEWS
+++ /dev/null
@@ -1,136 +0,0 @@
-Changes between MP version 3.1 and 3.1.1
-
-* Bug fixes for division (rare), mpf_get_str, FFT, and miscellaneous minor
-  things.
-
-Changes between MP version 3.0 and 3.1
-
-* Bug fixes.
-* Improved `make check' running more tests.
-* Tuned algorithm cutoff points for many machines.  This will improve speed for
-  a lot of operations, in some cases by a large amount.
-* Major speed improvments: Alpha 21264.
-* Some speed improvments: Cray vector computers, AMD K6 and Athlon, Intel P5
-  and Pentium Pro/II/III.
-* The mpf_get_prec function now works as it did in GMP 2.
-* New utilities for auto-tuning and speed measuring.
-* Multiplication now optionally uses FFT for very large operands.  (To enable
-  it, pass --enable-fft to configure.)
-* Support for new systems: Solaris running on x86, FreeBSD 5, HP-UX 11, Cray
-  vector computers, Rhapsody, Nextstep/Openstep, MacOS.
-* Support for shared libraries on 32-bit HPPA.
-* New integer functions: mpz_mul_si, mpz_odd_p, mpz_even_p.
-* New Kronecker symbol functions: mpz_kronecker_si, mpz_kronecker_ui,
-  mpz_si_kronecker, mpz_ui_kronecker.
-* New rational functions: mpq_out_str, mpq_swap.
-* New float functions: mpf_swap.
-* New mpn functions: mpn_divexact_by3c, mpn_tdiv_qr.
-* New EXPERIMENTAL function layer for accurate floating-point arithmetic, mpfr.
-  To try it, pass --enable-mpfr to configure.  See the mpfr subdirectory for
-  more information; it is not documented in the main GMP manual.
-
-Changes between MP version 3.0 and 3.0.1
-
-* Memory leaks in gmp_randinit and mpz_probab_prime_p fixed.
-* Documentation for gmp_randinit fixed.  Misc documentation errors fixed.
-
-Changes between MP version 2.0 and 3.0
-
-* Source level compatibility with past releases (except mpn_gcd).
-* Bug fixes.
-* Much improved speed thanks to both host independent and host dependent
-  optimizations.
-* Switch to autoconf/automake/libtool.
-* Support for building libgmp as a shared library.
-* Multiplication and squaring using 3-way Toom-Cook.
-* Division using the Burnikel-Ziegler method.
-* New functions computing binomial coefficients: mpz_bin_ui, mpz_bin_uiui.
-* New function computing Fibonacci numbers: mpz_fib_ui.
-* New random number generators: mpf_urandomb, mpz_rrandomb, mpz_urandomb,
-  mpz_urandomm, gmp_randclear, gmp_randinit, gmp_randinit_lc_2exp, gmp_randseed, 
-  gmp_randseed_ui.
-* New function for quickly extracting limbs: mpz_getlimbn.
-* New functions performing integer size tests: mpz_fits_sint_p,
-  mpz_fits_slong_p, mpz_fits_sshort_p, mpz_fits_uint_p, mpz_fits_ulong_p,
-  mpz_fits_ushort_p.
-* New mpf functions: mpf_ceil, mpf_floor, mpf_pow_ui, mpf_trunc.
-* New mpq function: mpq_set_d.
-* New mpz functions: mpz_addmul_ui, mpz_cmpabs, mpz_cmpabs_ui, mpz_lcm,
-  mpz_nextprime, mpz_perfect_power_p, mpz_remove, mpz_root, mpz_swap,
-  mpz_tdiv_ui, mpz_tstbit, mpz_xor.
-* New mpn function: mpn_divexact_by3.
-* New CPU support: DEC Alpha 21264, AMD K6 and Athlon, HPPA 2.0 and 64,
-  Intel Pentium Pro and Pentium-II/III, Sparc 64, PowerPC 64.
-* Almost 10 times faster mpz_invert and mpn_gcdext.
-* The interface of mpn_gcd has changed.
-* Better support for MIPS R4x000 and R5000 under Irix 6.
-* Improved support for SPARCv8 and SPARCv9 processors.
-
-Changes between MP version 2.0 and 2.0.2
-
-* Many bug fixes.
-
-Changes between MP version 1.3.2 and 2.0
-
-* Division routines in the mpz class have changed.  There are three classes of
-  functions, that rounds the quotient to -infinity, 0, and +infinity,
-  respectively.  The first class of functions have names that begin with
-  mpz_fdiv (f is short for floor), the second class' names begin with mpz_tdiv
-  (t is short for trunc), and the third class' names begin with mpz_cdiv (c is
-  short for ceil).
-
-  The old division routines beginning with mpz_m are similar to the new
-  mpz_fdiv, with the exception that some of the new functions return useful
-  values.
-
-  The old function names can still be used.  All the old functions names will
-  now do floor division, not trunc division as some of them used to.  This was
-  changed to make the functions more compatible with common mathematical
-  practice.
-
-  The mpz_mod and mpz_mod_ui functions now compute the mathematical mod
-  function.  I.e., the sign of the 2nd argument is ignored.
-
-* The mpq assignment functions do not canonicalize their results.  A new
-  function, mpq_canonicalize must be called by the user if the result is not
-  known to be canonical.
-* The mpn functions are now documented.  These functions are intended for
-  very time critical applications, or applications that need full control over
-  memory allocation.  Note that the mpn interface is irregular and hard to
-  use.
-* New functions for arbitrary precision floating point arithmetic.  Names
-  begin with `mpf_'.  Associated type mpf_t.
-* New and improved mpz functions, including much faster GCD, fast exact
-  division (mpz_divexact), bit scan (mpz_scan0 and mpz_scan1), and number
-  theoretical functions like Jacobi (mpz_jacobi) and multiplicative inverse
-  (mpz_invert).
-* New variable types (mpz_t and mpq_t) are available that makes syntax of
-  mpz and mpq calls nicer (no need for & before variables).  The MP_INT and
-  MP_RAT types are still available for compatibility.
-* Uses GNU configure.  This makes it possible to choose target architecture
-  and CPU variant, and to compile into a separate object directory.
-* Carefully optimized assembly for important inner loops.  Support for DEC
-  Alpha, Amd 29000, HPPA 1.0 and 1.1, Intel Pentium and generic x86, Intel
-  i960, Motorola MC68000, MC68020, MC88100, and MC88110, Motorola/IBM
-  PowerPC, National NS32000, IBM POWER, MIPS R3000, R4000, SPARCv7,
-  SuperSPARC, generic SPARCv8, and DEC VAX.  Some support also for ARM,
-  Clipper, IBM ROMP (RT), and Pyramid AP/XP.
-* Faster.  Thanks to the assembler code, new algorithms, and general tuning.
-  In particular, the speed on machines without GCC is improved.
-* Support for machines without alloca.
-* Now under the LGPL.
-
-INCOMPATIBILITIES BETWEEN GMP 1 AND GMP 2
-
-* mpq assignment functions do not canonicalize their results.
-* mpz division functions round differently.
-* mpz mod functions now really compute mod.
-* mpz_powm and mpz_powm_ui now really use mod for reduction.
-
-
-
-----------------
-Local variables:
-mode: text
-fill-column: 76
-End:
diff --git a/ghc/rts/gmp/README b/ghc/rts/gmp/README
deleted file mode 100644
index 177c97eb12..0000000000
--- a/ghc/rts/gmp/README
+++ /dev/null
@@ -1,84 +0,0 @@
-
-			THE GNU MP LIBRARY
-
-
-GNU MP is a library for arbitrary precision arithmetic, operating on signed
-integers, rational numbers, and floating point numbers.  It has a rich set of
-functions, and the functions have a regular interface.
-
-GNU MP is designed to be as fast as possible, both for small operands and huge
-operands.  The speed is achieved by using fullwords as the basic arithmetic
-type, by using fast algorithms, with carefully optimized assembly code for the
-most common inner loops for lots of CPUs, and by a general emphasis on speed
-(instead of simplicity or elegance).
-
-GNU MP is believed to be faster than any other similar library.  Its advantage
-increases with operand sizes for certain operations, since GNU MP in many
-cases has asymptotically faster algorithms.
-
-GNU MP is free software and may be freely copied on the terms contained in the
-files COPYING.LIB and COPYING (most of GNU MP is under the former, some under
-the latter).
-
-
-
-			OVERVIEW OF GNU MP
-
-There are five classes of functions in GNU MP.
-
- 1. Signed integer arithmetic functions (mpz).  These functions are intended
-    to be easy to use, with their regular interface.  The associated type is
-    `mpz_t'.
-
- 2. Rational arithmetic functions (mpq).  For now, just a small set of
-    functions necessary for basic rational arithmetics.  The associated type
-    is `mpq_t'.
-
- 3. Floating-point arithmetic functions (mpf).  If the C type `double'
-    doesn't give enough precision for your application, declare your
-    variables as `mpf_t' instead, set the precision to any number desired,
-    and call the functions in the mpf class for the arithmetic operations.
-
- 4. Positive-integer, hard-to-use, very low overhead functions are in the
-    mpn class.  No memory management is performed.  The caller must ensure
-    enough space is available for the results.  The set of functions is not
-    regular, nor is the calling interface.  These functions accept input
-    arguments in the form of pairs consisting of a pointer to the least
-    significant word, and an integral size telling how many limbs (= words)
-    the pointer points to.
-
-    Almost all calculations, in the entire package, are made by calling these
-    low-level functions.
-
- 5. Berkeley MP compatible functions.
-
-    To use these functions, include the file "mp.h".  You can test if you are
-    using the GNU version by testing if the symbol __GNU_MP__ is defined.
-
-For more information on how to use GNU MP, please refer to the documentation.
-It is composed from the file gmp.texi, and can be displayed on the screen or
-printed.  How to do that, as well how to build the library, is described in
-the INSTALL file in this directory.
-
-
-
-			REPORTING BUGS
-
-If you find a bug in the library, please make sure to tell us about it!
-
-You should first check the GNU MP web pages at http://www.swox.com/gmp/,
-under "Status of the current release".  There will be patches for all known
-serious bugs there.
-
-Report bugs to bug-gmp@gnu.org.  What information is needed in a good bug
-report is described in the manual.  The same address can be used for
-suggesting modifications and enhancements.
-
-
-
-
-----------------
-Local variables:
-mode: text
-fill-column: 78
-End:
diff --git a/ghc/rts/gmp/acconfig.h b/ghc/rts/gmp/acconfig.h
deleted file mode 100644
index dfb1b0b039..0000000000
--- a/ghc/rts/gmp/acconfig.h
+++ /dev/null
@@ -1,92 +0,0 @@
-/*
-Copyright (C) 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-@TOP@
-
-/* Define if a limb is long long. */
-#undef _LONG_LONG_LIMB
-
-/* Define if we have native implementation of function. */
-#undef HAVE_NATIVE_
-#undef HAVE_NATIVE_mpn_add                 
-#undef HAVE_NATIVE_mpn_add_1               
-#undef HAVE_NATIVE_mpn_add_n               
-#undef HAVE_NATIVE_mpn_add_nc              
-#undef HAVE_NATIVE_mpn_addmul_1            
-#undef HAVE_NATIVE_mpn_addmul_1c
-#undef HAVE_NATIVE_mpn_addsub_n            
-#undef HAVE_NATIVE_mpn_addsub_nc
-#undef HAVE_NATIVE_mpn_and_n               
-#undef HAVE_NATIVE_mpn_andn_n              
-#undef HAVE_NATIVE_mpn_bdivmod             
-#undef HAVE_NATIVE_mpn_cmp                 
-#undef HAVE_NATIVE_mpn_com_n               
-#undef HAVE_NATIVE_mpn_copyd               
-#undef HAVE_NATIVE_mpn_copyi               
-#undef HAVE_NATIVE_mpn_divexact_by3c
-#undef HAVE_NATIVE_mpn_divrem              
-#undef HAVE_NATIVE_mpn_divrem_1            
-#undef HAVE_NATIVE_mpn_divrem_1c
-#undef HAVE_NATIVE_mpn_divrem_2            
-#undef HAVE_NATIVE_mpn_divrem_newton       
-#undef HAVE_NATIVE_mpn_divrem_classic      
-#undef HAVE_NATIVE_mpn_dump                
-#undef HAVE_NATIVE_mpn_gcd                 
-#undef HAVE_NATIVE_mpn_gcd_1               
-#undef HAVE_NATIVE_mpn_gcdext              
-#undef HAVE_NATIVE_mpn_get_str             
-#undef HAVE_NATIVE_mpn_hamdist             
-#undef HAVE_NATIVE_mpn_invert_limb
-#undef HAVE_NATIVE_mpn_ior_n               
-#undef HAVE_NATIVE_mpn_iorn_n              
-#undef HAVE_NATIVE_mpn_lshift              
-#undef HAVE_NATIVE_mpn_mod_1               
-#undef HAVE_NATIVE_mpn_mod_1c
-#undef HAVE_NATIVE_mpn_mul                 
-#undef HAVE_NATIVE_mpn_mul_1               
-#undef HAVE_NATIVE_mpn_mul_1c
-#undef HAVE_NATIVE_mpn_mul_basecase        
-#undef HAVE_NATIVE_mpn_mul_n               
-#undef HAVE_NATIVE_mpn_nand_n              
-#undef HAVE_NATIVE_mpn_nior_n              
-#undef HAVE_NATIVE_mpn_perfect_square_p    
-#undef HAVE_NATIVE_mpn_popcount            
-#undef HAVE_NATIVE_mpn_preinv_mod_1        
-#undef HAVE_NATIVE_mpn_random2             
-#undef HAVE_NATIVE_mpn_random              
-#undef HAVE_NATIVE_mpn_rawrandom           
-#undef HAVE_NATIVE_mpn_rshift              
-#undef HAVE_NATIVE_mpn_scan0               
-#undef HAVE_NATIVE_mpn_scan1               
-#undef HAVE_NATIVE_mpn_set_str             
-#undef HAVE_NATIVE_mpn_sqrtrem             
-#undef HAVE_NATIVE_mpn_sqr_basecase        
-#undef HAVE_NATIVE_mpn_sub                 
-#undef HAVE_NATIVE_mpn_sub_1               
-#undef HAVE_NATIVE_mpn_sub_n               
-#undef HAVE_NATIVE_mpn_sub_nc              
-#undef HAVE_NATIVE_mpn_submul_1            
-#undef HAVE_NATIVE_mpn_submul_1c
-#undef HAVE_NATIVE_mpn_udiv_w_sdiv         
-#undef HAVE_NATIVE_mpn_umul_ppmm
-#undef HAVE_NATIVE_mpn_udiv_qrnnd
-#undef HAVE_NATIVE_mpn_xor_n               
-#undef HAVE_NATIVE_mpn_xnor_n              
diff --git a/ghc/rts/gmp/acinclude.m4 b/ghc/rts/gmp/acinclude.m4
deleted file mode 100644
index a02394a963..0000000000
--- a/ghc/rts/gmp/acinclude.m4
+++ /dev/null
@@ -1,835 +0,0 @@
-dnl  GMP specific autoconf macros
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl
-dnl  This file is part of the GNU MP Library.
-dnl
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-dnl
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-dnl
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-dnl  GMP_HEADER_GETVAL(NAME,FILE)
-dnl  ----------------------------
-dnl  Expand to the value of a "#define NAME" from the given FILE.
-dnl  The regexps here aren't very rugged, but are enough for gmp.
-dnl  /dev/null as a parameter prevents a hang if $2 is accidentally omitted.
-
-define(GMP_HEADER_GETVAL,
-[patsubst(patsubst(
-esyscmd([grep "^#define $1 " $2 /dev/null 2>/dev/null]),
-[^.*$1[ 	]+],[]),
-[[
- 	]*$],[])])
-
-
-dnl  GMP_VERSION
-dnl  -----------
-dnl  The gmp version number, extracted from the #defines in gmp.h.
-dnl  Two digits like 3.0 if patchlevel <= 0, or three digits like 3.0.1 if
-dnl  patchlevel > 0.
-
-define(GMP_VERSION,
-[GMP_HEADER_GETVAL(__GNU_MP_VERSION,gmp.h)[]dnl
-.GMP_HEADER_GETVAL(__GNU_MP_VERSION_MINOR,gmp.h)[]dnl
-ifelse(m4_eval(GMP_HEADER_GETVAL(__GNU_MP_VERSION_PATCHLEVEL,gmp.h) > 0),1,
-[.GMP_HEADER_GETVAL(__GNU_MP_VERSION_PATCHLEVEL,gmp.h)])])
-
-
-dnl  GMP_PROG_M4()
-dnl  -------------
-dnl
-dnl  Find a working m4, either in $PATH or likely locations, and setup $M4
-dnl  and an AC_SUBST accordingly.  If $M4 is already set then it's a user
-dnl  choice and is accepted with no checks.  GMP_PROG_M4 is like
-dnl  AC_PATH_PROG or AC_CHECK_PROG, but it tests each m4 found to see if
-dnl  it's good enough.
-dnl 
-dnl  See mpn/asm-defs.m4 for details on the known bad m4s.
-
-AC_DEFUN(GMP_PROG_M4,
-[AC_CACHE_CHECK([for suitable m4],
-                gmp_cv_prog_m4,
-[if test -n "$M4"; then
-  gmp_cv_prog_m4="$M4"
-else
-  cat >conftest.m4 <<\EOF
-dnl  must protect this against being expanded during autoconf m4!
-[define(dollarhash,``$][#'')dnl
-ifelse(dollarhash(x),1,`define(t1,Y)',
-``bad: $][# not supported (SunOS /usr/bin/m4)
-'')dnl
-ifelse(eval(89),89,`define(t2,Y)',
-`bad: eval() doesnt support 8 or 9 in a constant (OpenBSD 2.6 m4)
-')dnl
-ifelse(t1`'t2,YY,`good
-')dnl]
-EOF
-  echo "trying m4" 1>&AC_FD_CC
-  gmp_tmp_val="`(m4 conftest.m4) 2>&AC_FD_CC`"
-  echo "$gmp_tmp_val" 1>&AC_FD_CC
-  if test "$gmp_tmp_val" = good; then
-    gmp_cv_prog_m4="m4"
-  else
-    IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
-dnl $ac_dummy forces splitting on constant user-supplied paths.
-dnl POSIX.2 word splitting is done only on the output of word expansions,
-dnl not every word.  This closes a longstanding sh security hole.
-    ac_dummy="$PATH:/usr/5bin"
-    for ac_dir in $ac_dummy; do
-      test -z "$ac_dir" && ac_dir=.
-      echo "trying $ac_dir/m4" 1>&AC_FD_CC
-      gmp_tmp_val="`($ac_dir/m4 conftest.m4) 2>&AC_FD_CC`"
-      echo "$gmp_tmp_val" 1>&AC_FD_CC
-      if test "$gmp_tmp_val" = good; then
-        gmp_cv_prog_m4="$ac_dir/m4"
-        break
-      fi
-    done
-    IFS="$ac_save_ifs"
-    if test -z "$gmp_cv_prog_m4"; then
-      AC_MSG_ERROR([No usable m4 in \$PATH or /usr/5bin (see config.log for reasons).])
-    fi
-  fi
-  rm -f conftest.m4
-fi])
-M4="$gmp_cv_prog_m4"
-AC_SUBST(M4)
-])
-
-
-dnl  GMP_PROG_CC_FIND([CC_LIST], [REQ_64BIT_CC])
-dnl  Find first working compiler in CC_LIST.
-dnl  If REQ_64BIT_CC is "yes", the compiler is required to be able to 
-dnl  produce 64-bit code.
-dnl  NOTE: If a compiler needs any special flags for producing 64-bit code,
-dnl  these have to be found in shell variable `gmp_cflags64_{cc}', where `{cc}'
-dnl  is the name of the compiler.
-dnl  Set CC to the name of the first working compiler.
-dnl  If a 64-bit compiler is found, set CC64 to the name of the compiler and
-dnl  CFLAGS64 to flags to use.
-dnl  This macro does not test if any of the compilers found is a GNU compiler.
-dnl  To do this, when you have finally made up your mind on which one to use, 
-dnl  and set CC accordingly, invoke [GMP_PROG_CC_SELECT].  That macro will 
-dnl  also make sure that your selection of CFLAGS is valid.
-dnl
-AC_DEFUN(GMP_PROG_CC_FIND,
-[AC_BEFORE([$0], [CC_PROG_CPP])
-ifelse([$1], , gmp_cc_list="gcc cc", gmp_cc_list="[$1]")
-ifelse([$2], , gmp_req_64bit_cc="no", gmp_req_64bit_cc="[$2]")
-
-CC32=
-CC64=
-for c in $gmp_cc_list; do
-  # Avoid cache hits.
-  unset CC
-  unset ac_cv_prog_CC
-  AC_CHECK_TOOL(CC, $c, $c)
-  if test -n "$CC"; then
-    eval c_flags=\$gmp_cflags_$c
-    GMP_PROG_CC_WORKS($CC, $c_flags,
-		      gmp_prog_cc_works=yes, 
-		      gmp_prog_cc_works=no)
-
-    if test "$gmp_prog_cc_works" != "yes"; then
-      continue
-    fi
-
-    # Save first working compiler, whether 32- or 64-bit capable.
-    if test -z "$CC32"; then
-      CC32="$CC"
-    fi
-    if test "$gmp_req_64bit_cc" = "yes"; then
-      eval c_flags=\$gmp_cflags64_$c
-
-      # Verify that the compiler works in 64-bit mode as well.
-      # /usr/ucb/cc on Solaris 7 can *compile* in 64-bit mode, but not link.
-      GMP_PROG_CC_WORKS($c, $c_flags,
-		      	gmp_prog_cc_works=yes, 
-		      	gmp_prog_cc_works=no)
-
-      if test "$gmp_prog_cc_works" = "yes"; then
-        GMP_CHECK_CC_64BIT($c, $c_flags)
-        if test "$gmp_cv_cc_64bit" = "yes"; then
-          test -z "$CC64" && CC64="$c"
-          test -z "$CFLAGS64" && CFLAGS64="$c_flags"
-	  # We have CC64 so we're done.
-          break
-        fi
-      fi
-    else
-      # We have CC32, and we don't need a 64-bit compiler so we're done.
-      break
-    fi
-  fi
-done
-CC="$CC32"
-])dnl
-
-dnl  GMP_PROG_CC_SELECT
-dnl  Check that `CC' works with `CFLAGS'.  Check if `CC' is a GNU compiler.
-dnl  Cache the result as `ac_cv_prog_CC'.
-AC_DEFUN(GMP_PROG_CC_SELECT,
-[AC_BEFORE([$0], [CC_PROG_CPP])
-AC_PROG_CC_WORKS
-AC_PROG_CC_GNU
-
-if test "$ac_cv_prog_gcc" = "yes"; then
-  GCC=yes
-else
-  GCC=
-fi
-
-# Set CFLAGS if not already set.
-if test -z "$CFLAGS"; then
-  CFLAGS="-g"
-  if test "$GCC" = "yes"; then
-    CFLAGS="$CFLAGS -O2"
-  fi
-fi
-
-AC_SUBST(CC)
-AC_CACHE_VAL(ac_cv_prog_CC, ac_cv_prog_CC="$CC")
-AC_PROVIDE([AC_PROG_CC])
-])dnl
-
-dnl  GMP_CHECK_CC_64BIT(cc, cflags64)
-dnl  Find out if `CC' can produce 64-bit code.
-dnl  Requires NM to be set to nm for target.
-dnl  FIXME: Cache result.
-AC_DEFUN(GMP_CHECK_CC_64BIT,
-[
-  gmp_tmp_CC_save="$CC"
-  CC="[$1]"
-  AC_MSG_CHECKING([whether the C compiler ($CC) is 64-bit capable])
-  if test -z "$NM"; then
-    echo; echo ["configure: $0: fatal: need nm"]
-    exit 1
-  fi
-  gmp_tmp_CFLAGS_save="$CFLAGS"
-  CFLAGS="[$2]"
-
-  case "$target" in 
-    hppa2.0*-*-*)
-      # FIXME: If gcc is installed under another name than "gcc", we will 
-      # test the wrong thing.
-      if test "$CC" != "gcc"; then
-        dnl Let compiler version A.10.32.30 or higher be ok.
-        dnl Bad compiler output:
-        dnl   ccom: HP92453-01 G.10.32.05 HP C Compiler
-        dnl Good compiler output:
-        dnl   ccom: HP92453-01 A.10.32.30 HP C Compiler
-        echo >conftest.c
-        gmp_tmp_vs=`$CC $CFLAGS -V -c -o conftest.o conftest.c 2>&1 | grep "^ccom:"`
-        rm conftest*
-        gmp_tmp_v1=`echo $gmp_tmp_vs | sed 's/.* .\.\(.*\)\..*\..* HP C.*/\1/'`
-        gmp_tmp_v2=`echo $gmp_tmp_vs | sed 's/.* .\..*\.\(.*\)\..* HP C.*/\1/'`
-        gmp_tmp_v3=`echo $gmp_tmp_vs | sed 's/.* .\..*\..*\.\(.*\) HP C.*/\1/'`
-	gmp_cv_cc_64bit=no
-	test -n "$gmp_tmp_v1" && test "$gmp_tmp_v1" -ge "10" \
-  	  && test -n "$gmp_tmp_v2" && test "$gmp_tmp_v2" -ge "32" \
-    	  && test -n "$gmp_tmp_v3" && test "$gmp_tmp_v3" -ge "30" \
-	  && gmp_cv_cc_64bit=yes
-      else	# gcc
-	# FIXME: Compile a minimal file and determine if the resulting object 
-	# file is an ELF file.  If so, gcc can produce 64-bit code.
-	# Do we have file(1) for target?
-	gmp_cv_cc_64bit=no
-      fi
-      ;;
-    mips-sgi-irix6.*)
-      # We use `-n32' to cc and `-mabi=n32' to gcc, resulting in 64-bit 
-      # arithmetic but not 64-bit pointers, so the general test for sizeof
-      # (void *) is not valid.
-      # Simply try to compile an empty main.  If that succeeds return
-      # true.
-      AC_TRY_COMPILE( , ,
-                     gmp_cv_cc_64bit=yes, gmp_cv_cc_64bit=no,
-                     gmp_cv_cc_64bit=no)
-      ;;
-    *-*-*)
-      # Allocate an array of size sizeof (void *) and use nm to determine its 
-      # size.  We depend on the first declared variable being put at address 0.
-      cat >conftest.c <<EOF
-[char arr[sizeof (void *)]={0};
-char post=0;]
-EOF
-      gmp_compile="$CC $CFLAGS -c conftest.c 1>&AC_FD_CC"
-      if AC_TRY_EVAL(gmp_compile); then
-        changequote(<,>)dnl
-	gmp_tmp_val=`$NM conftest.o | grep post | sed -e 's;[[][0-9][]]\(.*\);\1;' \
-          -e 's;[^1-9]*\([0-9]*\).*;\1;'`
-        changequote([, ])dnl
-        if test "$gmp_tmp_val" = "8"; then
-	  gmp_cv_cc_64bit=yes
-	else
-	  gmp_cv_cc_64bit=no
-        fi
-      else
-        echo "configure: failed program was:" >&AC_FD_CC
-        cat conftest.$ac_ext >&AC_FD_CC
-        gmp_cv_cc_64bit=no
-      fi
-      rm -f conftest*
-      ;;
-  esac
-
-  CC="$gmp_tmp_CC_save"
-  CFLAGS="$gmp_tmp_CFLAGS_save"
-  AC_MSG_RESULT($gmp_cv_cc_64bit)
-])dnl
-
-dnl  GMP_INIT([M4-DEF-FILE])
-dnl  
-AC_DEFUN(GMP_INIT,
-[ifelse([$1], , gmp_configm4=config.m4, gmp_configm4="[$1]")
-gmp_tmpconfigm4=cnfm4.tmp
-gmp_tmpconfigm4i=cnfm4i.tmp
-gmp_tmpconfigm4p=cnfm4p.tmp
-test -f $gmp_tmpconfigm4 && rm $gmp_tmpconfigm4
-test -f $gmp_tmpconfigm4i && rm $gmp_tmpconfigm4i
-test -f $gmp_tmpconfigm4p && rm $gmp_tmpconfigm4p
-])dnl
-
-dnl  GMP_FINISH
-dnl  ----------
-dnl  Create config.m4 from its accumulated parts.
-dnl
-dnl  __CONFIG_M4_INCLUDED__ is used so that a second or subsequent include
-dnl  of config.m4 is harmless.
-dnl
-dnl  A separate ifdef on the angle bracket quoted part ensures the quoting
-dnl  style there is respected.  The basic defines from gmp_tmpconfigm4 are
-dnl  fully quoted but are still put under an ifdef in case any have been
-dnl  redefined by one of the m4 include files.
-dnl
-dnl  Doing a big ifdef within asm-defs.m4 and/or other macro files wouldn't
-dnl  work, since it'd interpret parentheses and quotes in dnl comments, and
-dnl  having a whole file as a macro argument would overflow the string space
-dnl  on BSD m4.
-
-AC_DEFUN(GMP_FINISH,
-[AC_REQUIRE([GMP_INIT])
-echo "creating $gmp_configm4"
-echo ["dnl $gmp_configm4.  Generated automatically by configure."] > $gmp_configm4
-if test -f $gmp_tmpconfigm4; then
-  echo ["changequote(<,>)dnl"] >> $gmp_configm4
-  echo ["ifdef(<__CONFIG_M4_INCLUDED__>,,<"] >> $gmp_configm4
-  cat $gmp_tmpconfigm4 >> $gmp_configm4
-  echo [">)"] >> $gmp_configm4
-  echo ["changequote(\`,')dnl"] >> $gmp_configm4
-  rm $gmp_tmpconfigm4
-fi
-echo ["ifdef(\`__CONFIG_M4_INCLUDED__',,\`"] >> $gmp_configm4
-if test -f $gmp_tmpconfigm4i; then
-  cat $gmp_tmpconfigm4i >> $gmp_configm4
-  rm $gmp_tmpconfigm4i
-fi
-if test -f $gmp_tmpconfigm4p; then
-  cat $gmp_tmpconfigm4p >> $gmp_configm4
-  rm $gmp_tmpconfigm4p
-fi
-echo ["')"] >> $gmp_configm4
-echo ["define(\`__CONFIG_M4_INCLUDED__')"] >> $gmp_configm4
-])dnl
-
-dnl  GMP_INCLUDE(FILE)
-AC_DEFUN(GMP_INCLUDE,
-[AC_REQUIRE([GMP_INIT])
-echo ["include(\`$1')"] >> $gmp_tmpconfigm4i
-])dnl
-
-dnl  GMP_SINCLUDE(FILE)
-AC_DEFUN(GMP_SINCLUDE,
-[AC_REQUIRE([GMP_INIT])
-echo ["sinclude(\`$1')"] >> $gmp_tmpconfigm4i
-])dnl
-
-dnl GMP_DEFINE(MACRO, DEFINITION [, LOCATION])
-dnl [ Define M4 macro MACRO as DEFINITION in temporary file.		]
-dnl [ If LOCATION is `POST', the definition will appear after any	]
-dnl [ include() directives inserted by GMP_INCLUDE/GMP_SINCLUDE.	]
-dnl [ Mind the quoting!  No shell variables will get expanded.		]
-dnl [ Don't forget to invoke GMP_FINISH to create file config.m4.	]
-dnl [ config.m4 uses `<' and '>' as quote characters for all defines.	]
-AC_DEFUN(GMP_DEFINE, 
-[AC_REQUIRE([GMP_INIT])
-echo ['define(<$1>, <$2>)'] >> ifelse([$3], [POST], $gmp_tmpconfigm4p, $gmp_tmpconfigm4)
-])dnl
-
-dnl GMP_DEFINE_RAW(STRING, [, LOCATION])
-dnl [ Put STRING in temporary file.					]
-dnl [ If LOCATION is `POST', the definition will appear after any	]
-dnl [ include() directives inserted by GMP_INCLUDE/GMP_SINCLUDE.	]
-dnl [ Don't forget to invoke GMP_FINISH to create file config.m4.	]
-AC_DEFUN(GMP_DEFINE_RAW,
-[AC_REQUIRE([GMP_INIT])
-echo [$1] >> ifelse([$2], [POST], $gmp_tmpconfigm4p, $gmp_tmpconfigm4)
-])dnl
-
-dnl  GMP_CHECK_ASM_LABEL_SUFFIX
-dnl  Should a label have a colon or not?
-AC_DEFUN(GMP_CHECK_ASM_LABEL_SUFFIX,
-[AC_CACHE_CHECK([what assembly label suffix to use],
-               gmp_cv_check_asm_label_suffix,
-[case "$target" in 
-  *-*-hpux*) gmp_cv_check_asm_label_suffix=[""] ;;
-  *) gmp_cv_check_asm_label_suffix=[":"] ;;
-esac
-])
-echo ["define(<LABEL_SUFFIX>, <\$][1$gmp_cv_check_asm_label_suffix>)"] >> $gmp_tmpconfigm4
-])dnl
-
-dnl  GMP_CHECK_ASM_UNDERSCORE([ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
-dnl  Shamelessly borrowed from glibc.
-AC_DEFUN(GMP_CHECK_ASM_UNDERSCORE,
-[AC_CACHE_CHECK([if symbols are prefixed by underscore], 
-	        gmp_cv_check_asm_underscore,
-[cat > conftest.$ac_ext <<EOF
-dnl This sometimes fails to find confdefs.h, for some reason.
-dnl [#]line __oline__ "[$]0"
-[#]line __oline__ "configure"
-#include "confdefs.h"
-int underscore_test() {
-return; }
-EOF
-if AC_TRY_EVAL(ac_compile); then
-  if grep _underscore_test conftest* >/dev/null; then
-    gmp_cv_check_asm_underscore=yes
-  else
-    gmp_cv_check_asm_underscore=no
-  fi
-else
-  echo "configure: failed program was:" >&AC_FD_CC
-  cat conftest.$ac_ext >&AC_FD_CC
-fi
-rm -f conftest*
-])
-if test "$gmp_cv_check_asm_underscore" = "yes"; then
-  GMP_DEFINE(GSYM_PREFIX, [_])
-  ifelse([$1], , :, [$1])
-else
-  GMP_DEFINE(GSYM_PREFIX, [])
-  ifelse([$2], , :, [$2])
-fi    
-])dnl
-
-dnl  GMP_CHECK_ASM_ALIGN_LOG([ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
-dnl  Is parameter to `.align' logarithmic?
-dnl  Requires NM to be set to nm for target.
-AC_DEFUN(GMP_CHECK_ASM_ALIGN_LOG,
-[AC_REQUIRE([GMP_CHECK_ASM_GLOBL])
-AC_REQUIRE([GMP_CHECK_ASM_DATA])
-AC_REQUIRE([GMP_CHECK_ASM_LABEL_SUFFIX])
-AC_CACHE_CHECK([if .align assembly directive is logarithmic],
-		gmp_cv_check_asm_align_log,
-[if test -z "$NM"; then
-  echo; echo ["configure: $0: fatal: need nm"]
-  exit 1
-fi
-cat > conftest.s <<EOF
-      	$gmp_cv_check_asm_data
-      	.align  4
-	$gmp_cv_check_asm_globl	foo
-	.byte	1
-	.align	4
-foo$gmp_cv_check_asm_label_suffix
-	.byte	2
-EOF
-ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-if AC_TRY_EVAL(ac_assemble); then
-  changequote(<,>)
-  gmp_tmp_val=`$NM conftest.o | grep foo | sed -e 's;[[][0-9][]]\(.*\);\1;' \
-       -e 's;[^1-9]*\([0-9]*\).*;\1;'`
-  changequote([, ])dnl
-  if test "$gmp_tmp_val" = "10" || test "$gmp_tmp_val" = "16"; then
-    gmp_cv_check_asm_align_log=yes
-  else
-    gmp_cv_check_asm_align_log=no
-  fi
-else 
-  echo "configure: failed program was:" >&AC_FD_CC
-  cat conftest.s >&AC_FD_CC
-fi
-rm -f conftest*
-])
-GMP_DEFINE_RAW(["define(<ALIGN_LOGARITHMIC>,<$gmp_cv_check_asm_align_log>)"])
-if test "$gmp_cv_check_asm_align_log" = "yes"; then
-  ifelse([$1], , :, [$1])
-else
-  ifelse([$2], , :, [$2])
-fi  
-])dnl
-
-
-dnl  GMP_CHECK_ASM_ALIGN_FILL_0x90
-dnl  -----------------------------
-dnl  Determine whether a ",0x90" suffix works on a .align directive.
-dnl  This is only meant for use on x86, where 0x90 is a "nop".
-dnl
-dnl  Old gas, eg. 1.92.3 - needs ",0x90" or else the fill is an invalid 0x00.
-dnl  New gas, eg. 2.91 - generates the good multibyte nop fills even when
-dnl                      ",0x90" is given.
-dnl  Solaris 2.6 as - doesn't allow ",0x90", gives a fatal error.
-dnl  Solaris 2.8 as - gives a warning for ",0x90", no ill effect.
-dnl
-dnl  Note that both solaris "as"s only care about ",0x90" if they actually
-dnl  have to use it to fill something, hence the .byte in the sample.  It's
-dnl  only the second .align that provokes an error or warning.
-dnl
-dnl  We prefer to suppress the warning from solaris 2.8 to stop anyone
-dnl  worrying something might be wrong.
-
-AC_DEFUN(GMP_CHECK_ASM_ALIGN_FILL_0x90,
-[AC_CACHE_CHECK([if the .align directive accepts an 0x90 fill in .text],
-                gmp_cv_check_asm_align_fill_0x90,
-[AC_REQUIRE([GMP_CHECK_ASM_TEXT])
-cat > conftest.s <<EOF
-      	$gmp_cv_check_asm_text
-      	.align  4, 0x90
-	.byte   0
-      	.align  4, 0x90
-EOF
-gmp_tmp_val="`$CCAS $CFLAGS conftest.s 2>&1`"
-if test $? = 0; then
-  echo "$gmp_tmp_val" 1>&AC_FD_CC
-  if echo "$gmp_tmp_val" | grep "Warning: Fill parameter ignored for executable section"; then
-    echo "Supressing this warning by omitting 0x90" 1>&AC_FD_CC
-    gmp_cv_check_asm_align_fill_0x90=no
-  else
-    gmp_cv_check_asm_align_fill_0x90=yes
-  fi
-else
-  echo "Non-zero exit code" 1>&AC_FD_CC
-  echo "$gmp_tmp_val" 1>&AC_FD_CC
-  gmp_cv_check_asm_align_fill_0x90=no
-fi
-rm -f conftest*
-])
-GMP_DEFINE_RAW(
-["define(<ALIGN_FILL_0x90>,<$gmp_cv_check_asm_align_fill_0x90>)"])
-])
-
-
-dnl  GMP_CHECK_ASM_TEXT
-AC_DEFUN(GMP_CHECK_ASM_TEXT,
-[AC_CACHE_CHECK([how to switch to text section], gmp_cv_check_asm_text,
-[case "$target" in
-  *-*-aix*)
-    changequote({, })
-    gmp_cv_check_asm_text={".csect .text[PR]"}
-    changequote([, ])
-    ;;
-  *-*-hpux*) gmp_cv_check_asm_text=[".code"] ;;
-  *) gmp_cv_check_asm_text=[".text"] ;;
-esac
-])
-echo ["define(<TEXT>, <$gmp_cv_check_asm_text>)"] >> $gmp_tmpconfigm4
-])dnl
-
-dnl  GMP_CHECK_ASM_DATA
-dnl  Can we say `.data'?
-AC_DEFUN(GMP_CHECK_ASM_DATA,
-[AC_CACHE_CHECK([how to switch to data section], gmp_cv_check_asm_data,
-[case "$target" in
-  *-*-aix*)
-    changequote({, })
-    gmp_cv_check_asm_data={".csect .data[RW]"}
-    changequote([, ])
-    ;;
-  *) gmp_cv_check_asm_data=[".data"] ;;
-esac
-])
-echo ["define(<DATA>, <$gmp_cv_check_asm_data>)"] >> $gmp_tmpconfigm4
-])dnl
-
-dnl  GMP_CHECK_ASM_GLOBL
-dnl  Can we say `.global'?
-AC_DEFUN(GMP_CHECK_ASM_GLOBL,
-[AC_CACHE_CHECK([how to export a symbol], gmp_cv_check_asm_globl,
-[case "$target" in
-  *-*-hpux*) gmp_cv_check_asm_globl=[".export"] ;;
-  *) gmp_cv_check_asm_globl=[".globl"] ;;
-esac
-])
-echo ["define(<GLOBL>, <$gmp_cv_check_asm_globl>)"] >> $gmp_tmpconfigm4
-])dnl
-
-dnl  GMP_CHECK_ASM_TYPE
-dnl  Can we say `.type'?
-AC_DEFUN(GMP_CHECK_ASM_TYPE,
-[AC_CACHE_CHECK([how the .type assembly directive should be used],
-gmp_cv_check_asm_type,
-[ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-for gmp_tmp_prefix in @ \# %; do
-  echo "	.type	sym,${gmp_tmp_prefix}function" > conftest.s
-  if AC_TRY_EVAL(ac_assemble); then
-    gmp_cv_check_asm_type="[.type	\$][1,${gmp_tmp_prefix}\$][2]"
-    break
-  fi
-done
-if test -z "$gmp_cv_check_asm_type"; then
-  gmp_cv_check_asm_type="[dnl]"
-fi
-])
-echo ["define(<TYPE>, <$gmp_cv_check_asm_type>)"] >> $gmp_tmpconfigm4
-])dnl
-
-dnl  GMP_CHECK_ASM_SIZE
-dnl  Can we say `.size'?
-AC_DEFUN(GMP_CHECK_ASM_SIZE,
-[AC_CACHE_CHECK([if the .size assembly directive works], gmp_cv_check_asm_size,
-[ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-echo '	.size	sym,1' > conftest.s
-if AC_TRY_EVAL(ac_assemble); then
-  gmp_cv_check_asm_size="[.size	\$][1,\$][2]"
-else
-  gmp_cv_check_asm_size="[dnl]"
-fi
-])
-echo ["define(<SIZE>, <$gmp_cv_check_asm_size>)"] >> $gmp_tmpconfigm4
-])dnl
-
-dnl  GMP_CHECK_ASM_LSYM_PREFIX
-dnl  What is the prefix for a local label?
-dnl  Requires NM to be set to nm for target.
-AC_DEFUN(GMP_CHECK_ASM_LSYM_PREFIX,
-[AC_REQUIRE([GMP_CHECK_ASM_LABEL_SUFFIX])
-AC_CACHE_CHECK([what prefix to use for a local label], 
-gmp_cv_check_asm_lsym_prefix,
-[if test -z "$NM"; then
-  echo; echo ["$0: fatal: need nm"]
-  exit 1
-fi
-ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-gmp_cv_check_asm_lsym_prefix="L"
-for gmp_tmp_pre in L .L $ L$; do
-  cat > conftest.s <<EOF
-dummy${gmp_cv_check_asm_label_suffix}
-${gmp_tmp_pre}gurkmacka${gmp_cv_check_asm_label_suffix}
-	.byte 0
-EOF
-  if AC_TRY_EVAL(ac_assemble); then
-    $NM conftest.o >/dev/null 2>&1
-    gmp_rc=$?
-    if test "$gmp_rc" != "0"; then
-      echo "configure: $NM failure, using default"
-      break
-    fi
-    if $NM conftest.o | grep gurkmacka >/dev/null; then true; else
-      gmp_cv_check_asm_lsym_prefix="$gmp_tmp_pre"
-      break
-    fi
-  else
-    echo "configure: failed program was:" >&AC_FD_CC
-    cat conftest.s >&AC_FD_CC
-    # Use default.
-  fi
-done
-rm -f conftest*
-])
-echo ["define(<LSYM_PREFIX>, <${gmp_cv_check_asm_lsym_prefix}>)"] >> $gmp_tmpconfigm4
-])
-
-dnl  GMP_CHECK_ASM_W32
-dnl  How to [define] a 32-bit word.
-dnl  Requires NM to be set to nm for target.
-AC_DEFUN(GMP_CHECK_ASM_W32,
-[AC_REQUIRE([GMP_CHECK_ASM_DATA])
-AC_REQUIRE([GMP_CHECK_ASM_GLOBL])
-AC_REQUIRE([GMP_CHECK_ASM_LABEL_SUFFIX])
-AC_CACHE_CHECK([how to [define] a 32-bit word],
-	       gmp_cv_check_asm_w32,
-[if test -z "$NM"; then
-  echo; echo ["configure: $0: fatal: need nm"]
-  exit 1
-fi
-
-# FIXME: HPUX puts first symbol at 0x40000000, breaking our assumption
-# that it's at 0x0.  We'll have to declare another symbol before the
-# .long/.word and look at the distance between the two symbols.  The
-# only problem is that the sed expression(s) barfs (on Solaris, for
-# example) for the symbol with value 0.  For now, HPUX uses .word.
-
-case "$target" in 
-  *-*-hpux*)
-    gmp_cv_check_asm_w32=".word"
-    ;;
-  *-*-*)
-    ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-    for gmp_tmp_op in .long .word; do
-      cat > conftest.s <<EOF
-	$gmp_cv_check_asm_data
-	$gmp_cv_check_asm_globl	foo
-	$gmp_tmp_op	0
-foo${gmp_cv_check_asm_label_suffix}
-	.byte	0
-EOF
-      if AC_TRY_EVAL(ac_assemble); then
-        changequote(<,>)
-        gmp_tmp_val=`$NM conftest.o | grep foo | sed -e 's;[[][0-9][]]\(.*\);\1;' \
-             -e 's;[^1-9]*\([0-9]*\).*;\1;'`
-        changequote([, ])dnl
-        if test "$gmp_tmp_val" = "4"; then
-          gmp_cv_check_asm_w32="$gmp_tmp_op"
-          break
-        fi
-      fi
-    done
-    ;;
-esac
-
-if test -z "$gmp_cv_check_asm_w32"; then
-  echo; echo ["configure: $0: fatal: do not know how to define a 32-bit word"]
-  exit 1
-fi
-rm -f conftest*
-])
-echo ["define(<W32>, <$gmp_cv_check_asm_w32>)"] >> $gmp_tmpconfigm4
-])
-
-dnl  GMP_CHECK_ASM_MMX([ACTION-IF-FOUND, [ACTION-IF-NOT-FOUND]])
-dnl  Can we assemble MMX insns?
-AC_DEFUN(GMP_CHECK_ASM_MMX,
-[AC_REQUIRE([GMP_CHECK_ASM_TEXT])
-AC_CACHE_CHECK([if the assembler knows about MMX instructions],
-		gmp_cv_check_asm_mmx,
-[cat > conftest.s <<EOF
-	$gmp_cv_check_asm_text
-	por	%mm0, %mm0
-EOF
-ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-if AC_TRY_EVAL(ac_assemble); then
-  gmp_cv_check_asm_mmx=yes
-else 
-  gmp_cv_check_asm_mmx=no
-fi
-rm -f conftest*
-])
-if test "$gmp_cv_check_asm_mmx" = "yes"; then
-  ifelse([$1], , :, [$1])
-else
-  AC_MSG_WARN([+----------------------------------------------------------])
-  AC_MSG_WARN([| WARNING WARNING WARNING])
-  AC_MSG_WARN([| Target CPU has MMX code, but it can't be assembled by])
-  AC_MSG_WARN([|     $CCAS $CFLAGS])
-  AC_MSG_WARN([| Non-MMX replacements will be used.])
-  AC_MSG_WARN([| This will be an inferior build.])
-  AC_MSG_WARN([+----------------------------------------------------------])
-  ifelse([$2], , :, [$2])
-fi
-])dnl
-
-dnl  GMP_CHECK_ASM_SHLDL_CL([ACTION-IF-FOUND, [ACTION-IF-NOT-FOUND]])
-AC_DEFUN(GMP_CHECK_ASM_SHLDL_CL,
-[AC_REQUIRE([GMP_CHECK_ASM_TEXT])
-AC_CACHE_CHECK([if the assembler takes cl with shldl],
-		gmp_cv_check_asm_shldl_cl,
-[cat > conftest.s <<EOF
-	$gmp_cv_check_asm_text
-	shldl	%cl, %eax, %ebx
-EOF
-ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-if AC_TRY_EVAL(ac_assemble); then
-  gmp_cv_check_asm_shldl_cl=yes
-else 
-  gmp_cv_check_asm_shldl_cl=no
-fi
-rm -f conftest*
-])
-if test "$gmp_cv_check_asm_shldl_cl" = "yes"; then
-  ifelse([$1], , :, [$1])
-else
-  ifelse([$2], , :, [$2])
-fi
-])dnl
-
-dnl  GMP_PROG_CC_WORKS(CC, CFLAGS, ACTION-IF-WORKS, [ACTION-IF-NOT-WORKS])
-dnl  Check if CC can compile and link.  Perform various target specific tests.
-dnl  FIXME: Require `$target'.
-AC_DEFUN(GMP_PROG_CC_WORKS,
-[AC_LANG_C	dnl  Note: Destructive.
-CC="[$1]"
-CFLAGS="[$2]"
-AC_MSG_CHECKING([if the C compiler ($CC) works with flags $CFLAGS])
-
-# Simple test for all targets.
-AC_TRY_COMPILER([int main(){return(0);}],
-                tmp_works, tmp_cross)
-
-# Target specific tests.
-if test "$tmp_works" = "yes"; then
-  case "$target" in 
-    *-*-aix*)	# Returning a funcptr.
-      AC_TRY_COMPILE( , [} void *g(); void *f() { return g(); } int bar(){],
-                      tmp_works=yes, tmp_works=no)
-      ;;
-  esac
-fi
-
-if test "$tmp_works" = "yes"; then
-  [$3]
-else
-  ifelse([$4], , :, [$4])
-fi
-
-AC_MSG_RESULT($tmp_works)
-])dnl
-
-
-dnl  GMP_C_ANSI2KNR
-dnl  --------------
-dnl  Setup to use ansi2knr if necessary.
-dnl
-dnl  The test here is simply that if an ANSI style function works then
-dnl  ansi2knr isn't needed.  The normal tests for whether $CC works mean we
-dnl  don't need to worry here about anything badly broken.
-dnl
-dnl  AM_C_PROTOTYPES is the normal way to set up ansi2knr, but (in automake
-dnl  March 2000) it gives the wrong answer on a C++ compiler because its
-dnl  test requires that the compiler accept both ANSI and K&R, or otherwise
-dnl  ansi2knr is used.  A C++ compiler fails on the K&R part, which makes
-dnl  AM_C_PROTOTYPES think it needs ansi2knr!  GMP has no bare K&R so we
-dnl  only need ANSI or K&R to work, not both.
-
-AC_DEFUN(GMP_C_ANSI2KNR,
-[AC_CACHE_CHECK([if ansi2knr should be used],
-                gmp_cv_c_ansi2knr,
-[cat >conftest.c <<EOF
-int main (int argc, char *argv[]) { return 0; }
-EOF
-if AC_TRY_EVAL(ac_compile); then
-  gmp_cv_c_ansi2knr=no
-else
-  gmp_cv_c_ansi2knr=yes
-fi
-rm -f conftest.*
-])
-if test $gmp_cv_c_ansi2knr = no; then
-  U= ANSI2KNR=
-else
-  U=_ ANSI2KNR=./ansi2knr
-  # Ensure some checks needed by ansi2knr itself.
-  AC_HEADER_STDC
-  AC_CHECK_HEADERS(string.h)
-fi
-AC_SUBST(U)
-AC_SUBST(ANSI2KNR)
-])
-
-
-dnl  Deal with bad synchronization of Autoconf with Libtool.
-AC_DEFUN(AC_CANONICAL_BUILD, [_AC_CANONICAL_BUILD])
-AC_DEFUN(AC_CHECK_TOOL_PREFIX, [_AC_CHECK_TOOL_PREFIX])
diff --git a/ghc/rts/gmp/aclocal.m4 b/ghc/rts/gmp/aclocal.m4
deleted file mode 100644
index 086c77915c..0000000000
--- a/ghc/rts/gmp/aclocal.m4
+++ /dev/null
@@ -1,1963 +0,0 @@
-dnl aclocal.m4 generated automatically by aclocal 1.4a
-
-dnl Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
-dnl This file is free software; the Free Software Foundation
-dnl gives unlimited permission to copy and/or distribute it,
-dnl with or without modifications, as long as this notice is preserved.
-
-dnl This program is distributed in the hope that it will be useful,
-dnl but WITHOUT ANY WARRANTY, to the extent permitted by law; without
-dnl even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-dnl PARTICULAR PURPOSE.
-
-dnl  GMP specific autoconf macros
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl
-dnl  This file is part of the GNU MP Library.
-dnl
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-dnl
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-dnl
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-dnl  GMP_HEADER_GETVAL(NAME,FILE)
-dnl  ----------------------------
-dnl  Expand to the value of a "#define NAME" from the given FILE.
-dnl  The regexps here aren't very rugged, but are enough for gmp.
-dnl  /dev/null as a parameter prevents a hang if $2 is accidentally omitted.
-
-define(GMP_HEADER_GETVAL,
-[patsubst(patsubst(
-esyscmd([grep "^#define $1 " $2 /dev/null 2>/dev/null]),
-[^.*$1[ 	]+],[]),
-[[
- 	]*$],[])])
-
-
-dnl  GMP_VERSION
-dnl  -----------
-dnl  The gmp version number, extracted from the #defines in gmp.h.
-dnl  Two digits like 3.0 if patchlevel <= 0, or three digits like 3.0.1 if
-dnl  patchlevel > 0.
-
-define(GMP_VERSION,
-[GMP_HEADER_GETVAL(__GNU_MP_VERSION,gmp.h)[]dnl
-.GMP_HEADER_GETVAL(__GNU_MP_VERSION_MINOR,gmp.h)[]dnl
-ifelse(m4_eval(GMP_HEADER_GETVAL(__GNU_MP_VERSION_PATCHLEVEL,gmp.h) > 0),1,
-[.GMP_HEADER_GETVAL(__GNU_MP_VERSION_PATCHLEVEL,gmp.h)])])
-
-
-dnl  GMP_PROG_M4()
-dnl  -------------
-dnl
-dnl  Find a working m4, either in $PATH or likely locations, and setup $M4
-dnl  and an AC_SUBST accordingly.  If $M4 is already set then it's a user
-dnl  choice and is accepted with no checks.  GMP_PROG_M4 is like
-dnl  AC_PATH_PROG or AC_CHECK_PROG, but it tests each m4 found to see if
-dnl  it's good enough.
-dnl 
-dnl  See mpn/asm-defs.m4 for details on the known bad m4s.
-
-AC_DEFUN(GMP_PROG_M4,
-[AC_CACHE_CHECK([for suitable m4],
-                gmp_cv_prog_m4,
-[if test -n "$M4"; then
-  gmp_cv_prog_m4="$M4"
-else
-  cat >conftest.m4 <<\EOF
-dnl  must protect this against being expanded during autoconf m4!
-[define(dollarhash,``$][#'')dnl
-ifelse(dollarhash(x),1,`define(t1,Y)',
-``bad: $][# not supported (SunOS /usr/bin/m4)
-'')dnl
-ifelse(eval(89),89,`define(t2,Y)',
-`bad: eval() doesnt support 8 or 9 in a constant (OpenBSD 2.6 m4)
-')dnl
-ifelse(t1`'t2,YY,`good
-')dnl]
-EOF
-  echo "trying m4" 1>&AC_FD_CC
-  gmp_tmp_val="`(m4 conftest.m4) 2>&AC_FD_CC`"
-  echo "$gmp_tmp_val" 1>&AC_FD_CC
-  if test "$gmp_tmp_val" = good; then
-    gmp_cv_prog_m4="m4"
-  else
-    IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
-dnl $ac_dummy forces splitting on constant user-supplied paths.
-dnl POSIX.2 word splitting is done only on the output of word expansions,
-dnl not every word.  This closes a longstanding sh security hole.
-    ac_dummy="$PATH:/usr/5bin"
-    for ac_dir in $ac_dummy; do
-      test -z "$ac_dir" && ac_dir=.
-      echo "trying $ac_dir/m4" 1>&AC_FD_CC
-      gmp_tmp_val="`($ac_dir/m4 conftest.m4) 2>&AC_FD_CC`"
-      echo "$gmp_tmp_val" 1>&AC_FD_CC
-      if test "$gmp_tmp_val" = good; then
-        gmp_cv_prog_m4="$ac_dir/m4"
-        break
-      fi
-    done
-    IFS="$ac_save_ifs"
-    if test -z "$gmp_cv_prog_m4"; then
-      AC_MSG_ERROR([No usable m4 in \$PATH or /usr/5bin (see config.log for reasons).])
-    fi
-  fi
-  rm -f conftest.m4
-fi])
-M4="$gmp_cv_prog_m4"
-AC_SUBST(M4)
-])
-
-
-dnl  GMP_PROG_CC_FIND([CC_LIST], [REQ_64BIT_CC])
-dnl  Find first working compiler in CC_LIST.
-dnl  If REQ_64BIT_CC is "yes", the compiler is required to be able to 
-dnl  produce 64-bit code.
-dnl  NOTE: If a compiler needs any special flags for producing 64-bit code,
-dnl  these have to be found in shell variable `gmp_cflags64_{cc}', where `{cc}'
-dnl  is the name of the compiler.
-dnl  Set CC to the name of the first working compiler.
-dnl  If a 64-bit compiler is found, set CC64 to the name of the compiler and
-dnl  CFLAGS64 to flags to use.
-dnl  This macro does not test if any of the compilers found is a GNU compiler.
-dnl  To do this, when you have finally made up your mind on which one to use, 
-dnl  and set CC accordingly, invoke [GMP_PROG_CC_SELECT].  That macro will 
-dnl  also make sure that your selection of CFLAGS is valid.
-dnl
-AC_DEFUN(GMP_PROG_CC_FIND,
-[AC_BEFORE([$0], [CC_PROG_CPP])
-ifelse([$1], , gmp_cc_list="gcc cc", gmp_cc_list="[$1]")
-ifelse([$2], , gmp_req_64bit_cc="no", gmp_req_64bit_cc="[$2]")
-
-CC32=
-CC64=
-for c in $gmp_cc_list; do
-  # Avoid cache hits.
-  unset CC
-  unset ac_cv_prog_CC
-  AC_CHECK_TOOL(CC, $c, $c)
-  if test -n "$CC"; then
-    eval c_flags=\$gmp_cflags_$c
-    GMP_PROG_CC_WORKS($CC, $c_flags,
-		      gmp_prog_cc_works=yes, 
-		      gmp_prog_cc_works=no)
-
-    if test "$gmp_prog_cc_works" != "yes"; then
-      continue
-    fi
-
-    # Save first working compiler, whether 32- or 64-bit capable.
-    if test -z "$CC32"; then
-      CC32="$CC"
-    fi
-    if test "$gmp_req_64bit_cc" = "yes"; then
-      eval c_flags=\$gmp_cflags64_$c
-
-      # Verify that the compiler works in 64-bit mode as well.
-      # /usr/ucb/cc on Solaris 7 can *compile* in 64-bit mode, but not link.
-      GMP_PROG_CC_WORKS($c, $c_flags,
-		      	gmp_prog_cc_works=yes, 
-		      	gmp_prog_cc_works=no)
-
-      if test "$gmp_prog_cc_works" = "yes"; then
-        GMP_CHECK_CC_64BIT($c, $c_flags)
-        if test "$gmp_cv_cc_64bit" = "yes"; then
-          test -z "$CC64" && CC64="$c"
-          test -z "$CFLAGS64" && CFLAGS64="$c_flags"
-	  # We have CC64 so we're done.
-          break
-        fi
-      fi
-    else
-      # We have CC32, and we don't need a 64-bit compiler so we're done.
-      break
-    fi
-  fi
-done
-CC="$CC32"
-])dnl
-
-dnl  GMP_PROG_CC_SELECT
-dnl  Check that `CC' works with `CFLAGS'.  Check if `CC' is a GNU compiler.
-dnl  Cache the result as `ac_cv_prog_CC'.
-AC_DEFUN(GMP_PROG_CC_SELECT,
-[AC_BEFORE([$0], [CC_PROG_CPP])
-AC_PROG_CC_WORKS
-AC_PROG_CC_GNU
-
-if test "$ac_cv_prog_gcc" = "yes"; then
-  GCC=yes
-else
-  GCC=
-fi
-
-# Set CFLAGS if not already set.
-if test -z "$CFLAGS"; then
-  CFLAGS="-g"
-  if test "$GCC" = "yes"; then
-    CFLAGS="$CFLAGS -O2"
-  fi
-fi
-
-AC_SUBST(CC)
-AC_CACHE_VAL(ac_cv_prog_CC, ac_cv_prog_CC="$CC")
-AC_PROVIDE([AC_PROG_CC])
-])dnl
-
-dnl  GMP_CHECK_CC_64BIT(cc, cflags64)
-dnl  Find out if `CC' can produce 64-bit code.
-dnl  Requires NM to be set to nm for target.
-dnl  FIXME: Cache result.
-AC_DEFUN(GMP_CHECK_CC_64BIT,
-[
-  gmp_tmp_CC_save="$CC"
-  CC="[$1]"
-  AC_MSG_CHECKING([whether the C compiler ($CC) is 64-bit capable])
-  if test -z "$NM"; then
-    echo; echo ["configure: $0: fatal: need nm"]
-    exit 1
-  fi
-  gmp_tmp_CFLAGS_save="$CFLAGS"
-  CFLAGS="[$2]"
-
-  case "$target" in 
-    hppa2.0*-*-*)
-      # FIXME: If gcc is installed under another name than "gcc", we will 
-      # test the wrong thing.
-      if test "$CC" != "gcc"; then
-        dnl Let compiler version A.10.32.30 or higher be ok.
-        dnl Bad compiler output:
-        dnl   ccom: HP92453-01 G.10.32.05 HP C Compiler
-        dnl Good compiler output:
-        dnl   ccom: HP92453-01 A.10.32.30 HP C Compiler
-        echo >conftest.c
-        gmp_tmp_vs=`$CC $CFLAGS -V -c -o conftest.o conftest.c 2>&1 | grep "^ccom:"`
-        rm conftest*
-        gmp_tmp_v1=`echo $gmp_tmp_vs | sed 's/.* .\.\(.*\)\..*\..* HP C.*/\1/'`
-        gmp_tmp_v2=`echo $gmp_tmp_vs | sed 's/.* .\..*\.\(.*\)\..* HP C.*/\1/'`
-        gmp_tmp_v3=`echo $gmp_tmp_vs | sed 's/.* .\..*\..*\.\(.*\) HP C.*/\1/'`
-	gmp_cv_cc_64bit=no
-	test -n "$gmp_tmp_v1" && test "$gmp_tmp_v1" -ge "10" \
-  	  && test -n "$gmp_tmp_v2" && test "$gmp_tmp_v2" -ge "32" \
-    	  && test -n "$gmp_tmp_v3" && test "$gmp_tmp_v3" -ge "30" \
-	  && gmp_cv_cc_64bit=yes
-      else	# gcc
-	# FIXME: Compile a minimal file and determine if the resulting object 
-	# file is an ELF file.  If so, gcc can produce 64-bit code.
-	# Do we have file(1) for target?
-	gmp_cv_cc_64bit=no
-      fi
-      ;;
-    mips-sgi-irix6.*)
-      # We use `-n32' to cc and `-mabi=n32' to gcc, resulting in 64-bit 
-      # arithmetic but not 64-bit pointers, so the general test for sizeof
-      # (void *) is not valid.
-      # Simply try to compile an empty main.  If that succeeds return
-      # true.
-      AC_TRY_COMPILE( , ,
-                     gmp_cv_cc_64bit=yes, gmp_cv_cc_64bit=no,
-                     gmp_cv_cc_64bit=no)
-      ;;
-    *-*-*)
-      # Allocate an array of size sizeof (void *) and use nm to determine its 
-      # size.  We depend on the first declared variable being put at address 0.
-      cat >conftest.c <<EOF
-[char arr[sizeof (void *)]={0};
-char post=0;]
-EOF
-      gmp_compile="$CC $CFLAGS -c conftest.c 1>&AC_FD_CC"
-      if AC_TRY_EVAL(gmp_compile); then
-        changequote(<,>)dnl
-	gmp_tmp_val=`$NM conftest.o | grep post | sed -e 's;[[][0-9][]]\(.*\);\1;' \
-          -e 's;[^1-9]*\([0-9]*\).*;\1;'`
-        changequote([, ])dnl
-        if test "$gmp_tmp_val" = "8"; then
-	  gmp_cv_cc_64bit=yes
-	else
-	  gmp_cv_cc_64bit=no
-        fi
-      else
-        echo "configure: failed program was:" >&AC_FD_CC
-        cat conftest.$ac_ext >&AC_FD_CC
-        gmp_cv_cc_64bit=no
-      fi
-      rm -f conftest*
-      ;;
-  esac
-
-  CC="$gmp_tmp_CC_save"
-  CFLAGS="$gmp_tmp_CFLAGS_save"
-  AC_MSG_RESULT($gmp_cv_cc_64bit)
-])dnl
-
-dnl  GMP_INIT([M4-DEF-FILE])
-dnl  
-AC_DEFUN(GMP_INIT,
-[ifelse([$1], , gmp_configm4=config.m4, gmp_configm4="[$1]")
-gmp_tmpconfigm4=cnfm4.tmp
-gmp_tmpconfigm4i=cnfm4i.tmp
-gmp_tmpconfigm4p=cnfm4p.tmp
-test -f $gmp_tmpconfigm4 && rm $gmp_tmpconfigm4
-test -f $gmp_tmpconfigm4i && rm $gmp_tmpconfigm4i
-test -f $gmp_tmpconfigm4p && rm $gmp_tmpconfigm4p
-])dnl
-
-dnl  GMP_FINISH
-dnl  ----------
-dnl  Create config.m4 from its accumulated parts.
-dnl
-dnl  __CONFIG_M4_INCLUDED__ is used so that a second or subsequent include
-dnl  of config.m4 is harmless.
-dnl
-dnl  A separate ifdef on the angle bracket quoted part ensures the quoting
-dnl  style there is respected.  The basic defines from gmp_tmpconfigm4 are
-dnl  fully quoted but are still put under an ifdef in case any have been
-dnl  redefined by one of the m4 include files.
-dnl
-dnl  Doing a big ifdef within asm-defs.m4 and/or other macro files wouldn't
-dnl  work, since it'd interpret parentheses and quotes in dnl comments, and
-dnl  having a whole file as a macro argument would overflow the string space
-dnl  on BSD m4.
-
-AC_DEFUN(GMP_FINISH,
-[AC_REQUIRE([GMP_INIT])
-echo "creating $gmp_configm4"
-echo ["dnl $gmp_configm4.  Generated automatically by configure."] > $gmp_configm4
-if test -f $gmp_tmpconfigm4; then
-  echo ["changequote(<,>)dnl"] >> $gmp_configm4
-  echo ["ifdef(<__CONFIG_M4_INCLUDED__>,,<"] >> $gmp_configm4
-  cat $gmp_tmpconfigm4 >> $gmp_configm4
-  echo [">)"] >> $gmp_configm4
-  echo ["changequote(\`,')dnl"] >> $gmp_configm4
-  rm $gmp_tmpconfigm4
-fi
-echo ["ifdef(\`__CONFIG_M4_INCLUDED__',,\`"] >> $gmp_configm4
-if test -f $gmp_tmpconfigm4i; then
-  cat $gmp_tmpconfigm4i >> $gmp_configm4
-  rm $gmp_tmpconfigm4i
-fi
-if test -f $gmp_tmpconfigm4p; then
-  cat $gmp_tmpconfigm4p >> $gmp_configm4
-  rm $gmp_tmpconfigm4p
-fi
-echo ["')"] >> $gmp_configm4
-echo ["define(\`__CONFIG_M4_INCLUDED__')"] >> $gmp_configm4
-])dnl
-
-dnl  GMP_INCLUDE(FILE)
-AC_DEFUN(GMP_INCLUDE,
-[AC_REQUIRE([GMP_INIT])
-echo ["include(\`$1')"] >> $gmp_tmpconfigm4i
-])dnl
-
-dnl  GMP_SINCLUDE(FILE)
-AC_DEFUN(GMP_SINCLUDE,
-[AC_REQUIRE([GMP_INIT])
-echo ["sinclude(\`$1')"] >> $gmp_tmpconfigm4i
-])dnl
-
-dnl GMP_DEFINE(MACRO, DEFINITION [, LOCATION])
-dnl [ Define M4 macro MACRO as DEFINITION in temporary file.		]
-dnl [ If LOCATION is `POST', the definition will appear after any	]
-dnl [ include() directives inserted by GMP_INCLUDE/GMP_SINCLUDE.	]
-dnl [ Mind the quoting!  No shell variables will get expanded.		]
-dnl [ Don't forget to invoke GMP_FINISH to create file config.m4.	]
-dnl [ config.m4 uses `<' and '>' as quote characters for all defines.	]
-AC_DEFUN(GMP_DEFINE, 
-[AC_REQUIRE([GMP_INIT])
-echo ['define(<$1>, <$2>)'] >> ifelse([$3], [POST], $gmp_tmpconfigm4p, $gmp_tmpconfigm4)
-])dnl
-
-dnl GMP_DEFINE_RAW(STRING, [, LOCATION])
-dnl [ Put STRING in temporary file.					]
-dnl [ If LOCATION is `POST', the definition will appear after any	]
-dnl [ include() directives inserted by GMP_INCLUDE/GMP_SINCLUDE.	]
-dnl [ Don't forget to invoke GMP_FINISH to create file config.m4.	]
-AC_DEFUN(GMP_DEFINE_RAW,
-[AC_REQUIRE([GMP_INIT])
-echo [$1] >> ifelse([$2], [POST], $gmp_tmpconfigm4p, $gmp_tmpconfigm4)
-])dnl
-
-dnl  GMP_CHECK_ASM_LABEL_SUFFIX
-dnl  Should a label have a colon or not?
-AC_DEFUN(GMP_CHECK_ASM_LABEL_SUFFIX,
-[AC_CACHE_CHECK([what assembly label suffix to use],
-               gmp_cv_check_asm_label_suffix,
-[case "$target" in 
-  *-*-hpux*) gmp_cv_check_asm_label_suffix=[""] ;;
-  *) gmp_cv_check_asm_label_suffix=[":"] ;;
-esac
-])
-echo ["define(<LABEL_SUFFIX>, <\$][1$gmp_cv_check_asm_label_suffix>)"] >> $gmp_tmpconfigm4
-])dnl
-
-dnl  GMP_CHECK_ASM_UNDERSCORE([ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
-dnl  Shamelessly borrowed from glibc.
-AC_DEFUN(GMP_CHECK_ASM_UNDERSCORE,
-[AC_CACHE_CHECK([if symbols are prefixed by underscore], 
-	        gmp_cv_check_asm_underscore,
-[cat > conftest.$ac_ext <<EOF
-dnl This sometimes fails to find confdefs.h, for some reason.
-dnl [#]line __oline__ "[$]0"
-[#]line __oline__ "configure"
-#include "confdefs.h"
-int underscore_test() {
-return; }
-EOF
-if AC_TRY_EVAL(ac_compile); then
-  if grep _underscore_test conftest* >/dev/null; then
-    gmp_cv_check_asm_underscore=yes
-  else
-    gmp_cv_check_asm_underscore=no
-  fi
-else
-  echo "configure: failed program was:" >&AC_FD_CC
-  cat conftest.$ac_ext >&AC_FD_CC
-fi
-rm -f conftest*
-])
-if test "$gmp_cv_check_asm_underscore" = "yes"; then
-  GMP_DEFINE(GSYM_PREFIX, [_])
-  ifelse([$1], , :, [$1])
-else
-  GMP_DEFINE(GSYM_PREFIX, [])
-  ifelse([$2], , :, [$2])
-fi    
-])dnl
-
-dnl  GMP_CHECK_ASM_ALIGN_LOG([ACTION-IF-FOUND [, ACTION-IF-NOT-FOUND]])
-dnl  Is parameter to `.align' logarithmic?
-dnl  Requires NM to be set to nm for target.
-AC_DEFUN(GMP_CHECK_ASM_ALIGN_LOG,
-[AC_REQUIRE([GMP_CHECK_ASM_GLOBL])
-AC_REQUIRE([GMP_CHECK_ASM_DATA])
-AC_REQUIRE([GMP_CHECK_ASM_LABEL_SUFFIX])
-AC_CACHE_CHECK([if .align assembly directive is logarithmic],
-		gmp_cv_check_asm_align_log,
-[if test -z "$NM"; then
-  echo; echo ["configure: $0: fatal: need nm"]
-  exit 1
-fi
-cat > conftest.s <<EOF
-      	$gmp_cv_check_asm_data
-      	.align  4
-	$gmp_cv_check_asm_globl	foo
-	.byte	1
-	.align	4
-foo$gmp_cv_check_asm_label_suffix
-	.byte	2
-EOF
-ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-if AC_TRY_EVAL(ac_assemble); then
-  changequote(<,>)
-  gmp_tmp_val=`$NM conftest.o | grep foo | sed -e 's;[[][0-9][]]\(.*\);\1;' \
-       -e 's;[^1-9]*\([0-9]*\).*;\1;'`
-  changequote([, ])dnl
-  if test "$gmp_tmp_val" = "10" || test "$gmp_tmp_val" = "16"; then
-    gmp_cv_check_asm_align_log=yes
-  else
-    gmp_cv_check_asm_align_log=no
-  fi
-else 
-  echo "configure: failed program was:" >&AC_FD_CC
-  cat conftest.s >&AC_FD_CC
-fi
-rm -f conftest*
-])
-GMP_DEFINE_RAW(["define(<ALIGN_LOGARITHMIC>,<$gmp_cv_check_asm_align_log>)"])
-if test "$gmp_cv_check_asm_align_log" = "yes"; then
-  ifelse([$1], , :, [$1])
-else
-  ifelse([$2], , :, [$2])
-fi  
-])dnl
-
-
-dnl  GMP_CHECK_ASM_ALIGN_FILL_0x90
-dnl  -----------------------------
-dnl  Determine whether a ",0x90" suffix works on a .align directive.
-dnl  This is only meant for use on x86, where 0x90 is a "nop".
-dnl
-dnl  Old gas, eg. 1.92.3 - needs ",0x90" or else the fill is an invalid 0x00.
-dnl  New gas, eg. 2.91 - generates the good multibyte nop fills even when
-dnl                      ",0x90" is given.
-dnl  Solaris 2.6 as - doesn't allow ",0x90", gives a fatal error.
-dnl  Solaris 2.8 as - gives a warning for ",0x90", no ill effect.
-dnl
-dnl  Note that both solaris "as"s only care about ",0x90" if they actually
-dnl  have to use it to fill something, hence the .byte in the sample.  It's
-dnl  only the second .align that provokes an error or warning.
-dnl
-dnl  We prefer to suppress the warning from solaris 2.8 to stop anyone
-dnl  worrying something might be wrong.
-
-AC_DEFUN(GMP_CHECK_ASM_ALIGN_FILL_0x90,
-[AC_CACHE_CHECK([if the .align directive accepts an 0x90 fill in .text],
-                gmp_cv_check_asm_align_fill_0x90,
-[AC_REQUIRE([GMP_CHECK_ASM_TEXT])
-cat > conftest.s <<EOF
-      	$gmp_cv_check_asm_text
-      	.align  4, 0x90
-	.byte   0
-      	.align  4, 0x90
-EOF
-gmp_tmp_val="`$CCAS $CFLAGS conftest.s 2>&1`"
-if test $? = 0; then
-  echo "$gmp_tmp_val" 1>&AC_FD_CC
-  if echo "$gmp_tmp_val" | grep "Warning: Fill parameter ignored for executable section"; then
-    echo "Supressing this warning by omitting 0x90" 1>&AC_FD_CC
-    gmp_cv_check_asm_align_fill_0x90=no
-  else
-    gmp_cv_check_asm_align_fill_0x90=yes
-  fi
-else
-  echo "Non-zero exit code" 1>&AC_FD_CC
-  echo "$gmp_tmp_val" 1>&AC_FD_CC
-  gmp_cv_check_asm_align_fill_0x90=no
-fi
-rm -f conftest*
-])
-GMP_DEFINE_RAW(
-["define(<ALIGN_FILL_0x90>,<$gmp_cv_check_asm_align_fill_0x90>)"])
-])
-
-
-dnl  GMP_CHECK_ASM_TEXT
-AC_DEFUN(GMP_CHECK_ASM_TEXT,
-[AC_CACHE_CHECK([how to switch to text section], gmp_cv_check_asm_text,
-[case "$target" in
-  *-*-aix*)
-    changequote({, })
-    gmp_cv_check_asm_text={".csect .text[PR]"}
-    changequote([, ])
-    ;;
-  *-*-hpux*) gmp_cv_check_asm_text=[".code"] ;;
-  *) gmp_cv_check_asm_text=[".text"] ;;
-esac
-])
-echo ["define(<TEXT>, <$gmp_cv_check_asm_text>)"] >> $gmp_tmpconfigm4
-])dnl
-
-dnl  GMP_CHECK_ASM_DATA
-dnl  Can we say `.data'?
-AC_DEFUN(GMP_CHECK_ASM_DATA,
-[AC_CACHE_CHECK([how to switch to data section], gmp_cv_check_asm_data,
-[case "$target" in
-  *-*-aix*)
-    changequote({, })
-    gmp_cv_check_asm_data={".csect .data[RW]"}
-    changequote([, ])
-    ;;
-  *) gmp_cv_check_asm_data=[".data"] ;;
-esac
-])
-echo ["define(<DATA>, <$gmp_cv_check_asm_data>)"] >> $gmp_tmpconfigm4
-])dnl
-
-dnl  GMP_CHECK_ASM_GLOBL
-dnl  Can we say `.global'?
-AC_DEFUN(GMP_CHECK_ASM_GLOBL,
-[AC_CACHE_CHECK([how to export a symbol], gmp_cv_check_asm_globl,
-[case "$target" in
-  *-*-hpux*) gmp_cv_check_asm_globl=[".export"] ;;
-  *) gmp_cv_check_asm_globl=[".globl"] ;;
-esac
-])
-echo ["define(<GLOBL>, <$gmp_cv_check_asm_globl>)"] >> $gmp_tmpconfigm4
-])dnl
-
-dnl  GMP_CHECK_ASM_TYPE
-dnl  Can we say `.type'?
-AC_DEFUN(GMP_CHECK_ASM_TYPE,
-[AC_CACHE_CHECK([how the .type assembly directive should be used],
-gmp_cv_check_asm_type,
-[ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-for gmp_tmp_prefix in @ \# %; do
-  echo "	.type	sym,${gmp_tmp_prefix}function" > conftest.s
-  if AC_TRY_EVAL(ac_assemble); then
-    gmp_cv_check_asm_type="[.type	\$][1,${gmp_tmp_prefix}\$][2]"
-    break
-  fi
-done
-if test -z "$gmp_cv_check_asm_type"; then
-  gmp_cv_check_asm_type="[dnl]"
-fi
-])
-echo ["define(<TYPE>, <$gmp_cv_check_asm_type>)"] >> $gmp_tmpconfigm4
-])dnl
-
-dnl  GMP_CHECK_ASM_SIZE
-dnl  Can we say `.size'?
-AC_DEFUN(GMP_CHECK_ASM_SIZE,
-[AC_CACHE_CHECK([if the .size assembly directive works], gmp_cv_check_asm_size,
-[ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-echo '	.size	sym,1' > conftest.s
-if AC_TRY_EVAL(ac_assemble); then
-  gmp_cv_check_asm_size="[.size	\$][1,\$][2]"
-else
-  gmp_cv_check_asm_size="[dnl]"
-fi
-])
-echo ["define(<SIZE>, <$gmp_cv_check_asm_size>)"] >> $gmp_tmpconfigm4
-])dnl
-
-dnl  GMP_CHECK_ASM_LSYM_PREFIX
-dnl  What is the prefix for a local label?
-dnl  Requires NM to be set to nm for target.
-AC_DEFUN(GMP_CHECK_ASM_LSYM_PREFIX,
-[AC_REQUIRE([GMP_CHECK_ASM_LABEL_SUFFIX])
-AC_CACHE_CHECK([what prefix to use for a local label], 
-gmp_cv_check_asm_lsym_prefix,
-[if test -z "$NM"; then
-  echo; echo ["$0: fatal: need nm"]
-  exit 1
-fi
-ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-gmp_cv_check_asm_lsym_prefix="L"
-for gmp_tmp_pre in L .L $ L$; do
-  cat > conftest.s <<EOF
-dummy${gmp_cv_check_asm_label_suffix}
-${gmp_tmp_pre}gurkmacka${gmp_cv_check_asm_label_suffix}
-	.byte 0
-EOF
-  if AC_TRY_EVAL(ac_assemble); then
-    $NM conftest.o >/dev/null 2>&1
-    gmp_rc=$?
-    if test "$gmp_rc" != "0"; then
-      echo "configure: $NM failure, using default"
-      break
-    fi
-    if $NM conftest.o | grep gurkmacka >/dev/null; then true; else
-      gmp_cv_check_asm_lsym_prefix="$gmp_tmp_pre"
-      break
-    fi
-  else
-    echo "configure: failed program was:" >&AC_FD_CC
-    cat conftest.s >&AC_FD_CC
-    # Use default.
-  fi
-done
-rm -f conftest*
-])
-echo ["define(<LSYM_PREFIX>, <${gmp_cv_check_asm_lsym_prefix}>)"] >> $gmp_tmpconfigm4
-])
-
-dnl  GMP_CHECK_ASM_W32
-dnl  How to [define] a 32-bit word.
-dnl  Requires NM to be set to nm for target.
-AC_DEFUN(GMP_CHECK_ASM_W32,
-[AC_REQUIRE([GMP_CHECK_ASM_DATA])
-AC_REQUIRE([GMP_CHECK_ASM_GLOBL])
-AC_REQUIRE([GMP_CHECK_ASM_LABEL_SUFFIX])
-AC_CACHE_CHECK([how to [define] a 32-bit word],
-	       gmp_cv_check_asm_w32,
-[if test -z "$NM"; then
-  echo; echo ["configure: $0: fatal: need nm"]
-  exit 1
-fi
-
-# FIXME: HPUX puts first symbol at 0x40000000, breaking our assumption
-# that it's at 0x0.  We'll have to declare another symbol before the
-# .long/.word and look at the distance between the two symbols.  The
-# only problem is that the sed expression(s) barfs (on Solaris, for
-# example) for the symbol with value 0.  For now, HPUX uses .word.
-
-case "$target" in 
-  *-*-hpux*)
-    gmp_cv_check_asm_w32=".word"
-    ;;
-  *-*-*)
-    ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-    for gmp_tmp_op in .long .word; do
-      cat > conftest.s <<EOF
-	$gmp_cv_check_asm_data
-	$gmp_cv_check_asm_globl	foo
-	$gmp_tmp_op	0
-foo${gmp_cv_check_asm_label_suffix}
-	.byte	0
-EOF
-      if AC_TRY_EVAL(ac_assemble); then
-        changequote(<,>)
-        gmp_tmp_val=`$NM conftest.o | grep foo | sed -e 's;[[][0-9][]]\(.*\);\1;' \
-             -e 's;[^1-9]*\([0-9]*\).*;\1;'`
-        changequote([, ])dnl
-        if test "$gmp_tmp_val" = "4"; then
-          gmp_cv_check_asm_w32="$gmp_tmp_op"
-          break
-        fi
-      fi
-    done
-    ;;
-esac
-
-if test -z "$gmp_cv_check_asm_w32"; then
-  echo; echo ["configure: $0: fatal: do not know how to define a 32-bit word"]
-  exit 1
-fi
-rm -f conftest*
-])
-echo ["define(<W32>, <$gmp_cv_check_asm_w32>)"] >> $gmp_tmpconfigm4
-])
-
-dnl  GMP_CHECK_ASM_MMX([ACTION-IF-FOUND, [ACTION-IF-NOT-FOUND]])
-dnl  Can we assemble MMX insns?
-AC_DEFUN(GMP_CHECK_ASM_MMX,
-[AC_REQUIRE([GMP_CHECK_ASM_TEXT])
-AC_CACHE_CHECK([if the assembler knows about MMX instructions],
-		gmp_cv_check_asm_mmx,
-[cat > conftest.s <<EOF
-	$gmp_cv_check_asm_text
-	por	%mm0, %mm0
-EOF
-ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-if AC_TRY_EVAL(ac_assemble); then
-  gmp_cv_check_asm_mmx=yes
-else 
-  gmp_cv_check_asm_mmx=no
-fi
-rm -f conftest*
-])
-if test "$gmp_cv_check_asm_mmx" = "yes"; then
-  ifelse([$1], , :, [$1])
-else
-  AC_MSG_WARN([+----------------------------------------------------------])
-  AC_MSG_WARN([| WARNING WARNING WARNING])
-  AC_MSG_WARN([| Target CPU has MMX code, but it can't be assembled by])
-  AC_MSG_WARN([|     $CCAS $CFLAGS])
-  AC_MSG_WARN([| Non-MMX replacements will be used.])
-  AC_MSG_WARN([| This will be an inferior build.])
-  AC_MSG_WARN([+----------------------------------------------------------])
-  ifelse([$2], , :, [$2])
-fi
-])dnl
-
-dnl  GMP_CHECK_ASM_SHLDL_CL([ACTION-IF-FOUND, [ACTION-IF-NOT-FOUND]])
-AC_DEFUN(GMP_CHECK_ASM_SHLDL_CL,
-[AC_REQUIRE([GMP_CHECK_ASM_TEXT])
-AC_CACHE_CHECK([if the assembler takes cl with shldl],
-		gmp_cv_check_asm_shldl_cl,
-[cat > conftest.s <<EOF
-	$gmp_cv_check_asm_text
-	shldl	%cl, %eax, %ebx
-EOF
-ac_assemble="$CCAS $CFLAGS conftest.s 1>&AC_FD_CC"
-if AC_TRY_EVAL(ac_assemble); then
-  gmp_cv_check_asm_shldl_cl=yes
-else 
-  gmp_cv_check_asm_shldl_cl=no
-fi
-rm -f conftest*
-])
-if test "$gmp_cv_check_asm_shldl_cl" = "yes"; then
-  ifelse([$1], , :, [$1])
-else
-  ifelse([$2], , :, [$2])
-fi
-])dnl
-
-dnl  GMP_PROG_CC_WORKS(CC, CFLAGS, ACTION-IF-WORKS, [ACTION-IF-NOT-WORKS])
-dnl  Check if CC can compile and link.  Perform various target specific tests.
-dnl  FIXME: Require `$target'.
-AC_DEFUN(GMP_PROG_CC_WORKS,
-[AC_LANG_C	dnl  Note: Destructive.
-CC="[$1]"
-CFLAGS="[$2]"
-AC_MSG_CHECKING([if the C compiler ($CC) works with flags $CFLAGS])
-
-# Simple test for all targets.
-AC_TRY_COMPILER([int main(){return(0);}],
-                tmp_works, tmp_cross)
-
-# Target specific tests.
-if test "$tmp_works" = "yes"; then
-  case "$target" in 
-    *-*-aix*)	# Returning a funcptr.
-      AC_TRY_COMPILE( , [} void *g(); void *f() { return g(); } int bar(){],
-                      tmp_works=yes, tmp_works=no)
-      ;;
-  esac
-fi
-
-if test "$tmp_works" = "yes"; then
-  [$3]
-else
-  ifelse([$4], , :, [$4])
-fi
-
-AC_MSG_RESULT($tmp_works)
-])dnl
-
-
-dnl  GMP_C_ANSI2KNR
-dnl  --------------
-dnl  Setup to use ansi2knr if necessary.
-dnl
-dnl  The test here is simply that if an ANSI style function works then
-dnl  ansi2knr isn't needed.  The normal tests for whether $CC works mean we
-dnl  don't need to worry here about anything badly broken.
-dnl
-dnl  AM_C_PROTOTYPES is the normal way to set up ansi2knr, but (in automake
-dnl  March 2000) it gives the wrong answer on a C++ compiler because its
-dnl  test requires that the compiler accept both ANSI and K&R, or otherwise
-dnl  ansi2knr is used.  A C++ compiler fails on the K&R part, which makes
-dnl  AM_C_PROTOTYPES think it needs ansi2knr!  GMP has no bare K&R so we
-dnl  only need ANSI or K&R to work, not both.
-
-AC_DEFUN(GMP_C_ANSI2KNR,
-[AC_CACHE_CHECK([if ansi2knr should be used],
-                gmp_cv_c_ansi2knr,
-[cat >conftest.c <<EOF
-int main (int argc, char *argv[]) { return 0; }
-EOF
-if AC_TRY_EVAL(ac_compile); then
-  gmp_cv_c_ansi2knr=no
-else
-  gmp_cv_c_ansi2knr=yes
-fi
-rm -f conftest.*
-])
-if test $gmp_cv_c_ansi2knr = no; then
-  U= ANSI2KNR=
-else
-  U=_ ANSI2KNR=./ansi2knr
-  # Ensure some checks needed by ansi2knr itself.
-  AC_HEADER_STDC
-  AC_CHECK_HEADERS(string.h)
-fi
-AC_SUBST(U)
-AC_SUBST(ANSI2KNR)
-])
-
-
-dnl  Deal with bad synchronization of Autoconf with Libtool.
-AC_DEFUN(AC_CANONICAL_BUILD, [_AC_CANONICAL_BUILD])
-AC_DEFUN(AC_CHECK_TOOL_PREFIX, [_AC_CHECK_TOOL_PREFIX])
-
-
-# serial 1
-
-AC_DEFUN(AM_C_PROTOTYPES,
-[AC_REQUIRE([AM_PROG_CC_STDC])
-AC_REQUIRE([AC_PROG_CPP])
-AC_MSG_CHECKING([for function prototypes])
-if test "$am_cv_prog_cc_stdc" != no; then
-  AC_MSG_RESULT(yes)
-  AC_DEFINE(PROTOTYPES,1,[Define if compiler has function prototypes])
-  U= ANSI2KNR=
-else
-  AC_MSG_RESULT(no)
-  U=_ ANSI2KNR=./ansi2knr
-  # Ensure some checks needed by ansi2knr itself.
-  AC_HEADER_STDC
-  AC_CHECK_HEADERS(string.h)
-fi
-AC_SUBST(U)dnl
-AC_SUBST(ANSI2KNR)dnl
-])
-
-
-# serial 1
-
-# @defmac AC_PROG_CC_STDC
-# @maindex PROG_CC_STDC
-# @ovindex CC
-# If the C compiler in not in ANSI C mode by default, try to add an option
-# to output variable @code{CC} to make it so.  This macro tries various
-# options that select ANSI C on some system or another.  It considers the
-# compiler to be in ANSI C mode if it handles function prototypes correctly.
-#
-# If you use this macro, you should check after calling it whether the C
-# compiler has been set to accept ANSI C; if not, the shell variable
-# @code{am_cv_prog_cc_stdc} is set to @samp{no}.  If you wrote your source
-# code in ANSI C, you can make an un-ANSIfied copy of it by using the
-# program @code{ansi2knr}, which comes with Ghostscript.
-# @end defmac
-
-AC_DEFUN(AM_PROG_CC_STDC,
-[AC_REQUIRE([AC_PROG_CC])
-AC_BEFORE([$0], [AC_C_INLINE])
-AC_BEFORE([$0], [AC_C_CONST])
-dnl Force this before AC_PROG_CPP.  Some cpp's, eg on HPUX, require
-dnl a magic option to avoid problems with ANSI preprocessor commands
-dnl like #elif.
-dnl FIXME: can't do this because then AC_AIX won't work due to a
-dnl circular dependency.
-dnl AC_BEFORE([$0], [AC_PROG_CPP])
-AC_MSG_CHECKING(for ${CC-cc} option to accept ANSI C)
-AC_CACHE_VAL(am_cv_prog_cc_stdc,
-[am_cv_prog_cc_stdc=no
-ac_save_CC="$CC"
-# Don't try gcc -ansi; that turns off useful extensions and
-# breaks some systems' header files.
-# AIX			-qlanglvl=ansi
-# Ultrix and OSF/1	-std1
-# HP-UX 10.20 and later	-Ae
-# HP-UX older versions	-Aa -D_HPUX_SOURCE
-# SVR4			-Xc -D__EXTENSIONS__
-for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
-do
-  CC="$ac_save_CC $ac_arg"
-  AC_TRY_COMPILE(
-[#include <stdarg.h>
-#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-/* Most of the following tests are stolen from RCS 5.7's src/conf.sh.  */
-struct buf { int x; };
-FILE * (*rcsopen) (struct buf *, struct stat *, int);
-static char *e (p, i)
-     char **p;
-     int i;
-{
-  return p[i];
-}
-static char *f (char * (*g) (char **, int), char **p, ...)
-{
-  char *s;
-  va_list v;
-  va_start (v,p);
-  s = g (p, va_arg (v,int));
-  va_end (v);
-  return s;
-}
-int test (int i, double x);
-struct s1 {int (*f) (int a);};
-struct s2 {int (*f) (double a);};
-int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
-int argc;
-char **argv;
-], [
-return f (e, argv, 0) != argv[0]  ||  f (e, argv, 1) != argv[1];
-],
-[am_cv_prog_cc_stdc="$ac_arg"; break])
-done
-CC="$ac_save_CC"
-])
-if test -z "$am_cv_prog_cc_stdc"; then
-  AC_MSG_RESULT([none needed])
-else
-  AC_MSG_RESULT($am_cv_prog_cc_stdc)
-fi
-case "x$am_cv_prog_cc_stdc" in
-  x|xno) ;;
-  *) CC="$CC $am_cv_prog_cc_stdc" ;;
-esac
-])
-
-# Do all the work for Automake.  This macro actually does too much --
-# some checks are only needed if your package does certain things.
-# But this isn't really a big deal.
-
-# serial 1
-
-dnl Usage:
-dnl AM_INIT_AUTOMAKE(package,version, [no-define])
-
-AC_DEFUN(AM_INIT_AUTOMAKE,
-[AC_REQUIRE([AC_PROG_INSTALL])
-dnl We require 2.13 because we rely on SHELL being computed by configure.
-AC_PREREQ([2.13])
-PACKAGE=[$1]
-AC_SUBST(PACKAGE)
-VERSION=[$2]
-AC_SUBST(VERSION)
-dnl test to see if srcdir already configured
-if test "`CDPATH=: && cd $srcdir && pwd`" != "`pwd`" &&
-   test -f $srcdir/config.status; then
-  AC_MSG_ERROR([source directory already configured; run "make distclean" there first])
-fi
-ifelse([$3],,
-AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE", [Name of package])
-AC_DEFINE_UNQUOTED(VERSION, "$VERSION", [Version number of package]))
-AC_REQUIRE([AM_SANITY_CHECK])
-AC_REQUIRE([AC_ARG_PROGRAM])
-AM_MISSING_PROG(ACLOCAL, aclocal)
-AM_MISSING_PROG(AUTOCONF, autoconf)
-AM_MISSING_PROG(AUTOMAKE, automake)
-AM_MISSING_PROG(AUTOHEADER, autoheader)
-AM_MISSING_PROG(MAKEINFO, makeinfo)
-AM_MISSING_PROG(AMTAR, tar)
-AM_MISSING_INSTALL_SH
-dnl We need awk for the "check" target.  The system "awk" is bad on
-dnl some platforms.
-AC_REQUIRE([AC_PROG_AWK])
-AC_REQUIRE([AC_PROG_MAKE_SET])
-AC_REQUIRE([AM_DEP_TRACK])
-AC_REQUIRE([AM_SET_DEPDIR])
-ifdef([AC_PROVIDE_AC_PROG_CC], [AM_DEPENDENCIES(CC)], [
-   define([AC_PROG_CC], defn([AC_PROG_CC])[AM_DEPENDENCIES(CC)])])
-ifdef([AC_PROVIDE_AC_PROG_CXX], [AM_DEPENDENCIES(CXX)], [
-   define([AC_PROG_CXX], defn([AC_PROG_CXX])[AM_DEPENDENCIES(CXX)])])
-])
-
-#
-# Check to make sure that the build environment is sane.
-#
-
-AC_DEFUN(AM_SANITY_CHECK,
-[AC_MSG_CHECKING([whether build environment is sane])
-# Just in case
-sleep 1
-echo timestamp > conftestfile
-# Do `set' in a subshell so we don't clobber the current shell's
-# arguments.  Must try -L first in case configure is actually a
-# symlink; some systems play weird games with the mod time of symlinks
-# (eg FreeBSD returns the mod time of the symlink's containing
-# directory).
-if (
-   set X `ls -Lt $srcdir/configure conftestfile 2> /dev/null`
-   if test "[$]*" = "X"; then
-      # -L didn't work.
-      set X `ls -t $srcdir/configure conftestfile`
-   fi
-   if test "[$]*" != "X $srcdir/configure conftestfile" \
-      && test "[$]*" != "X conftestfile $srcdir/configure"; then
-
-      # If neither matched, then we have a broken ls.  This can happen
-      # if, for instance, CONFIG_SHELL is bash and it inherits a
-      # broken ls alias from the environment.  This has actually
-      # happened.  Such a system could not be considered "sane".
-      AC_MSG_ERROR([ls -t appears to fail.  Make sure there is not a broken
-alias in your environment])
-   fi
-
-   test "[$]2" = conftestfile
-   )
-then
-   # Ok.
-   :
-else
-   AC_MSG_ERROR([newly created file is older than distributed files!
-Check your system clock])
-fi
-rm -f conftest*
-AC_MSG_RESULT(yes)])
-
-dnl AM_MISSING_PROG(NAME, PROGRAM)
-AC_DEFUN(AM_MISSING_PROG, [
-AC_REQUIRE([AM_MISSING_HAS_RUN])
-$1=${$1-"${am_missing_run}$2"}
-AC_SUBST($1)])
-
-dnl Like AM_MISSING_PROG, but only looks for install-sh.
-dnl AM_MISSING_INSTALL_SH()
-AC_DEFUN(AM_MISSING_INSTALL_SH, [
-AC_REQUIRE([AM_MISSING_HAS_RUN])
-if test -z "$install_sh"; then
-   install_sh="$ac_aux_dir/install-sh"
-   test -f "$install_sh" || install_sh="$ac_aux_dir/install.sh"
-   test -f "$install_sh" || install_sh="${am_missing_run}${ac_auxdir}/install-sh"
-   dnl FIXME: an evil hack: we remove the SHELL invocation from
-   dnl install_sh because automake adds it back in.  Sigh.
-   install_sh="`echo $install_sh | sed -e 's/\${SHELL}//'`"
-fi
-AC_SUBST(install_sh)])
-
-dnl AM_MISSING_HAS_RUN.
-dnl Define MISSING if not defined so far and test if it supports --run.
-dnl If it does, set am_missing_run to use it, otherwise, to nothing.
-AC_DEFUN([AM_MISSING_HAS_RUN], [
-test x"${MISSING+set}" = xset || \
-  MISSING="\${SHELL} `CDPATH=: && cd $ac_aux_dir && pwd`/missing"
-dnl Use eval to expand $SHELL
-if eval "$MISSING --run :"; then
-  am_missing_run="$MISSING --run "
-else
-  am_missing_run=
-  am_backtick='`'
-  AC_MSG_WARN([${am_backtick}missing' script is too old or missing])
-fi
-])
-
-dnl See how the compiler implements dependency checking.
-dnl Usage:
-dnl AM_DEPENDENCIES(NAME)
-dnl NAME is "CC", "CXX" or "OBJC".
-
-dnl We try a few techniques and use that to set a single cache variable.
-
-AC_DEFUN(AM_DEPENDENCIES,[
-AC_REQUIRE([AM_SET_DEPDIR])
-AC_REQUIRE([AM_OUTPUT_DEPENDENCY_COMMANDS])
-ifelse([$1],CC,[
-AC_REQUIRE([AC_PROG_CC])
-AC_REQUIRE([AC_PROG_CPP])
-depcc="$CC"
-depcpp="$CPP"],[$1],CXX,[
-AC_REQUIRE([AC_PROG_CXX])
-AC_REQUIRE([AC_PROG_CXXCPP])
-depcc="$CXX"
-depcpp="$CXXCPP"],[$1],OBJC,[
-am_cv_OBJC_dependencies_compiler_type=gcc],[
-AC_REQUIRE([AC_PROG_][$1])
-depcc="$[$1]"
-depcpp=""])
-AC_MSG_CHECKING([dependency style of $depcc])
-AC_CACHE_VAL(am_cv_[$1]_dependencies_compiler_type,[
-if test -z "$AMDEP"; then
-  echo '#include "conftest.h"' > conftest.c
-  echo 'int i;' > conftest.h
-
-  am_cv_[$1]_dependencies_compiler_type=none
-  for depmode in `sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < "$am_depcomp"`; do
-    case "$depmode" in
-    nosideeffect)
-      # after this tag, mechanisms are not by side-effect, so they'll
-      # only be used when explicitly requested
-      if test "x$enable_dependency_tracking" = xyes; then
-	continue
-      else
-	break
-      fi
-      ;;
-    none) break ;;
-    esac
-    if depmode="$depmode" \
-       source=conftest.c object=conftest.o \
-       depfile=conftest.Po tmpdepfile=conftest.TPo \
-       $SHELL $am_depcomp $depcc -c conftest.c 2>/dev/null &&
-       grep conftest.h conftest.Po > /dev/null 2>&1; then
-      am_cv_[$1]_dependencies_compiler_type="$depmode"
-      break
-    fi
-  done
-
-  rm -f conftest.*
-else
-  am_cv_[$1]_dependencies_compiler_type=none
-fi
-])
-AC_MSG_RESULT($am_cv_[$1]_dependencies_compiler_type)
-[$1]DEPMODE="depmode=$am_cv_[$1]_dependencies_compiler_type"
-AC_SUBST([$1]DEPMODE)
-])
-
-dnl Choose a directory name for dependency files.
-dnl This macro is AC_REQUIREd in AM_DEPENDENCIES
-
-AC_DEFUN(AM_SET_DEPDIR,[
-if test -d .deps || mkdir .deps 2> /dev/null || test -d .deps; then
-  DEPDIR=.deps
-else
-  DEPDIR=_deps
-fi
-AC_SUBST(DEPDIR)
-])
-
-AC_DEFUN(AM_DEP_TRACK,[
-AC_ARG_ENABLE(dependency-tracking,
-[  --disable-dependency-tracking Speeds up one-time builds
-  --enable-dependency-tracking  Do not reject slow dependency extractors])
-if test "x$enable_dependency_tracking" = xno; then
-  AMDEP="#"
-else
-  am_depcomp="$ac_aux_dir/depcomp"
-  if test ! -f "$am_depcomp"; then
-    AMDEP="#"
-  else
-    AMDEP=
-  fi
-fi
-AC_SUBST(AMDEP)
-if test -z "$AMDEP"; then
-  AMDEPBACKSLASH='\'
-else
-  AMDEPBACKSLASH=
-fi
-pushdef([subst], defn([AC_SUBST]))
-subst(AMDEPBACKSLASH)
-popdef([subst])
-])
-
-dnl Generate code to set up dependency tracking.
-dnl This macro should only be invoked once -- use via AC_REQUIRE.
-dnl Usage:
-dnl AM_OUTPUT_DEPENDENCY_COMMANDS
-
-dnl
-dnl This code is only required when automatic dependency tracking
-dnl is enabled.  FIXME.  This creates each `.P' file that we will
-dnl need in order to bootstrap the dependency handling code.
-AC_DEFUN(AM_OUTPUT_DEPENDENCY_COMMANDS,[
-AC_OUTPUT_COMMANDS([
-test x"$AMDEP" != x"" ||
-for mf in $CONFIG_FILES; do
-  case "$mf" in
-  Makefile) dirpart=.;;
-  */Makefile) dirpart=`echo "$mf" | sed -e 's|/[^/]*$||'`;;
-  *) continue;;
-  esac
-  grep '^DEP_FILES *= *[^ #]' < "$mf" > /dev/null || continue
-  # Extract the definition of DEP_FILES from the Makefile without
-  # running `make'.
-  DEPDIR=`sed -n -e '/^DEPDIR = / s///p' < "$mf"`
-  test -z "$DEPDIR" && continue
-  # When using ansi2knr, U may be empty or an underscore; expand it
-  U=`sed -n -e '/^U = / s///p' < "$mf"`
-  test -d "$dirpart/$DEPDIR" || mkdir "$dirpart/$DEPDIR"
-  # We invoke sed twice because it is the simplest approach to
-  # changing $(DEPDIR) to its actual value in the expansion.
-  for file in `sed -n -e '
-    /^DEP_FILES = .*\\\\$/ {
-      s/^DEP_FILES = //
-      :loop
-	s/\\\\$//
-	p
-	n
-	/\\\\$/ b loop
-      p
-    }
-    /^DEP_FILES = / s/^DEP_FILES = //p' < "$mf" | \
-       sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g' -e 's/\$U/'"$U"'/g'`; do
-    # Make sure the directory exists.
-    test -f "$dirpart/$file" && continue
-    fdir=`echo "$file" | sed -e 's|/[^/]*$||'`
-    $ac_aux_dir/mkinstalldirs "$dirpart/$fdir" > /dev/null 2>&1
-    # echo "creating $dirpart/$file"
-    echo '# dummy' > "$dirpart/$file"
-  done
-done
-], [AMDEP="$AMDEP"
-ac_aux_dir="$ac_aux_dir"])])
-
-# Like AC_CONFIG_HEADER, but automatically create stamp file.
-
-AC_DEFUN(AM_CONFIG_HEADER,
-[AC_PREREQ([2.12])
-AC_CONFIG_HEADER([$1])
-dnl When config.status generates a header, we must update the stamp-h file.
-dnl This file resides in the same directory as the config header
-dnl that is generated.  We must strip everything past the first ":",
-dnl and everything past the last "/".
-AC_OUTPUT_COMMANDS(changequote(<<,>>)dnl
-ifelse(patsubst(<<$1>>, <<[^ ]>>, <<>>), <<>>,
-<<test -z "<<$>>CONFIG_HEADERS" || echo timestamp > patsubst(<<$1>>, <<^\([^:]*/\)?.*>>, <<\1>>)stamp-h<<>>dnl>>,
-<<am_indx=1
-for am_file in <<$1>>; do
-  case " <<$>>CONFIG_HEADERS " in
-  *" <<$>>am_file "*<<)>>
-    echo timestamp > `echo <<$>>am_file | sed -e 's%:.*%%' -e 's%[^/]*$%%'`stamp-h$am_indx
-    ;;
-  esac
-  am_indx=`expr "<<$>>am_indx" + 1`
-done<<>>dnl>>)
-changequote([,]))])
-
-# Add --enable-maintainer-mode option to configure.
-# From Jim Meyering
-
-# serial 1
-
-AC_DEFUN(AM_MAINTAINER_MODE,
-[AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles])
-  dnl maintainer-mode is disabled by default
-  AC_ARG_ENABLE(maintainer-mode,
-[  --enable-maintainer-mode enable make rules and dependencies not useful
-                          (and sometimes confusing) to the casual installer],
-      USE_MAINTAINER_MODE=$enableval,
-      USE_MAINTAINER_MODE=no)
-  AC_MSG_RESULT($USE_MAINTAINER_MODE)
-  AM_CONDITIONAL(MAINTAINER_MODE, test $USE_MAINTAINER_MODE = yes)
-  MAINT=$MAINTAINER_MODE_TRUE
-  AC_SUBST(MAINT)dnl
-]
-)
-
-# Define a conditional.
-
-AC_DEFUN(AM_CONDITIONAL,
-[AC_SUBST($1_TRUE)
-AC_SUBST($1_FALSE)
-if $2; then
-  $1_TRUE=
-  $1_FALSE='#'
-else
-  $1_TRUE='#'
-  $1_FALSE=
-fi])
-
-
-# serial 42 AC_PROG_LIBTOOL
-AC_DEFUN(AC_PROG_LIBTOOL,
-[AC_REQUIRE([AC_LIBTOOL_SETUP])dnl
-
-# Save cache, so that ltconfig can load it
-AC_CACHE_SAVE
-
-# Actually configure libtool.  ac_aux_dir is where install-sh is found.
-AR="$AR" CC="$CC" CFLAGS="$CFLAGS" CPPFLAGS="$CPPFLAGS" \
-MAGIC="$MAGIC" LD="$LD" LDFLAGS="$LDFLAGS" LIBS="$LIBS" \
-LN_S="$LN_S" NM="$NM" RANLIB="$RANLIB" STRIP="$STRIP" \
-AS="$AS" DLLTOOL="$DLLTOOL" OBJDUMP="$OBJDUMP" \
-objext="$OBJEXT" exeext="$EXEEXT" reload_flag="$reload_flag" \
-deplibs_check_method="$deplibs_check_method" file_magic_cmd="$file_magic_cmd" \
-${CONFIG_SHELL-/bin/sh} $ac_aux_dir/ltconfig --no-reexec \
-$libtool_flags --no-verify --build="$build" $ac_aux_dir/ltmain.sh $lt_target \
-|| AC_MSG_ERROR([libtool configure failed])
-
-# Reload cache, that may have been modified by ltconfig
-AC_CACHE_LOAD
-
-# This can be used to rebuild libtool when needed
-LIBTOOL_DEPS="$ac_aux_dir/ltconfig $ac_aux_dir/ltmain.sh"
-
-# Always use our own libtool.
-LIBTOOL='$(SHELL) $(top_builddir)/libtool'
-AC_SUBST(LIBTOOL)dnl
-
-# Redirect the config.log output again, so that the ltconfig log is not
-# clobbered by the next message.
-exec 5>>./config.log
-])
-
-AC_DEFUN(AC_LIBTOOL_SETUP,
-[AC_PREREQ(2.13)dnl
-AC_REQUIRE([AC_ENABLE_SHARED])dnl
-AC_REQUIRE([AC_ENABLE_STATIC])dnl
-AC_REQUIRE([AC_ENABLE_FAST_INSTALL])dnl
-AC_REQUIRE([AC_CANONICAL_HOST])dnl
-AC_REQUIRE([AC_CANONICAL_BUILD])dnl
-AC_REQUIRE([AC_PROG_CC])dnl
-AC_REQUIRE([AC_PROG_LD])dnl
-AC_REQUIRE([AC_PROG_LD_RELOAD_FLAG])dnl
-AC_REQUIRE([AC_PROG_NM])dnl
-AC_REQUIRE([AC_PROG_LN_S])dnl
-AC_REQUIRE([AC_DEPLIBS_CHECK_METHOD])dnl
-AC_REQUIRE([AC_OBJEXT])dnl
-AC_REQUIRE([AC_EXEEXT])dnl
-dnl
-
-# Only perform the check for file, if the check method requires it
-case "$deplibs_check_method" in
-file_magic*)
-  if test "$file_magic_cmd" = '${MAGIC}'; then
-    AC_PATH_MAGIC
-  fi
-  ;;
-esac
-
-case "$target" in
-NONE) lt_target="$host" ;;
-*) lt_target="$target" ;;
-esac
-
-AC_CHECK_TOOL(RANLIB, ranlib, :)
-AC_CHECK_TOOL(STRIP, strip, :)
-
-# Check for any special flags to pass to ltconfig.
-libtool_flags="--cache-file=$cache_file"
-test "$enable_shared" = no && libtool_flags="$libtool_flags --disable-shared"
-test "$enable_static" = no && libtool_flags="$libtool_flags --disable-static"
-test "$enable_fast_install" = no && libtool_flags="$libtool_flags --disable-fast-install"
-test "$ac_cv_prog_gcc" = yes && libtool_flags="$libtool_flags --with-gcc"
-test "$ac_cv_prog_gnu_ld" = yes && libtool_flags="$libtool_flags --with-gnu-ld"
-ifdef([AC_PROVIDE_AC_LIBTOOL_DLOPEN],
-[libtool_flags="$libtool_flags --enable-dlopen"])
-ifdef([AC_PROVIDE_AC_LIBTOOL_WIN32_DLL],
-[libtool_flags="$libtool_flags --enable-win32-dll"])
-AC_ARG_ENABLE(libtool-lock,
-  [  --disable-libtool-lock  avoid locking (might break parallel builds)])
-test "x$enable_libtool_lock" = xno && libtool_flags="$libtool_flags --disable-lock"
-test x"$silent" = xyes && libtool_flags="$libtool_flags --silent"
-
-AC_ARG_WITH(pic,
-  [  --with-pic              try to use only PIC/non-PIC objects [default=use both]],
-     pic_mode="$withval", pic_mode=default)
-test x"$pic_mode" = xyes && libtool_flags="$libtool_flags --prefer-pic"
-test x"$pic_mode" = xno && libtool_flags="$libtool_flags --prefer-non-pic"
-
-# Some flags need to be propagated to the compiler or linker for good
-# libtool support.
-case "$lt_target" in
-*-*-irix6*)
-  # Find out which ABI we are using.
-  echo '[#]line __oline__ "configure"' > conftest.$ac_ext
-  if AC_TRY_EVAL(ac_compile); then
-    case "`/usr/bin/file conftest.o`" in
-    *32-bit*)
-      LD="${LD-ld} -32"
-      ;;
-    *N32*)
-      LD="${LD-ld} -n32"
-      ;;
-    *64-bit*)
-      LD="${LD-ld} -64"
-      ;;
-    esac
-  fi
-  rm -rf conftest*
-  ;;
-
-*-*-sco3.2v5*)
-  # On SCO OpenServer 5, we need -belf to get full-featured binaries.
-  SAVE_CFLAGS="$CFLAGS"
-  CFLAGS="$CFLAGS -belf"
-  AC_CACHE_CHECK([whether the C compiler needs -belf], lt_cv_cc_needs_belf,
-    [AC_LANG_SAVE
-     AC_LANG_C
-     AC_TRY_LINK([],[],[lt_cv_cc_needs_belf=yes],[lt_cv_cc_needs_belf=no])
-     AC_LANG_RESTORE])
-  if test x"$lt_cv_cc_needs_belf" != x"yes"; then
-    # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
-    CFLAGS="$SAVE_CFLAGS"
-  fi
-  ;;
-
-ifdef([AC_PROVIDE_AC_LIBTOOL_WIN32_DLL],
-[*-*-cygwin* | *-*-mingw*)
-  AC_CHECK_TOOL(DLLTOOL, dlltool, false)
-  AC_CHECK_TOOL(AS, as, false)
-  AC_CHECK_TOOL(OBJDUMP, objdump, false)
-
-  # recent cygwin and mingw systems supply a stub DllMain which the user
-  # can override, but on older systems we have to supply one
-  AC_CACHE_CHECK([if libtool should supply DllMain function], lt_cv_need_dllmain,
-    [AC_TRY_LINK([],
-      [extern int __attribute__((__stdcall__)) DllMain(void*, int, void*);
-      DllMain (0, 0, 0);],
-      [lt_cv_need_dllmain=no],[lt_cv_need_dllmain=yes])])
-
-  case "$lt_target/$CC" in
-  *-*-cygwin*/gcc*-mno-cygwin*|*-*-mingw*)
-    # old mingw systems require "-dll" to link a DLL, while more recent ones
-    # require "-mdll"
-    SAVE_CFLAGS="$CFLAGS"
-    CFLAGS="$CFLAGS -mdll"
-    AC_CACHE_CHECK([how to link DLLs], lt_cv_cc_dll_switch,
-      [AC_TRY_LINK([], [], [lt_cv_cc_dll_switch=-mdll],[lt_cv_cc_dll_switch=-dll])])
-    CFLAGS="$SAVE_CFLAGS" ;;
-  *-*-cygwin*)
-    # cygwin systems need to pass --dll to the linker, and not link
-    # crt.o which will require a WinMain@16 definition.
-    lt_cv_cc_dll_switch="-Wl,--dll -nostartfiles" ;;
-  esac
-  ;;
-  ])
-esac
-])
-
-# AC_LIBTOOL_DLOPEN - enable checks for dlopen support
-AC_DEFUN(AC_LIBTOOL_DLOPEN, [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])])
-
-# AC_LIBTOOL_WIN32_DLL - declare package support for building win32 dll's
-AC_DEFUN(AC_LIBTOOL_WIN32_DLL, [AC_BEFORE([$0], [AC_LIBTOOL_SETUP])])
-
-# AC_ENABLE_SHARED - implement the --enable-shared flag
-# Usage: AC_ENABLE_SHARED[(DEFAULT)]
-#   Where DEFAULT is either `yes' or `no'.  If omitted, it defaults to
-#   `yes'.
-AC_DEFUN(AC_ENABLE_SHARED, [dnl
-define([AC_ENABLE_SHARED_DEFAULT], ifelse($1, no, no, yes))dnl
-AC_ARG_ENABLE(shared,
-changequote(<<, >>)dnl
-<<  --enable-shared[=PKGS]  build shared libraries [default=>>AC_ENABLE_SHARED_DEFAULT],
-changequote([, ])dnl
-[p=${PACKAGE-default}
-case "$enableval" in
-yes) enable_shared=yes ;;
-no) enable_shared=no ;;
-*)
-  enable_shared=no
-  # Look at the argument we got.  We use all the common list separators.
-  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
-  for pkg in $enableval; do
-    if test "X$pkg" = "X$p"; then
-      enable_shared=yes
-    fi
-  done
-  IFS="$ac_save_ifs"
-  ;;
-esac],
-enable_shared=AC_ENABLE_SHARED_DEFAULT)dnl
-])
-
-# AC_DISABLE_SHARED - set the default shared flag to --disable-shared
-AC_DEFUN(AC_DISABLE_SHARED, [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
-AC_ENABLE_SHARED(no)])
-
-# AC_ENABLE_STATIC - implement the --enable-static flag
-# Usage: AC_ENABLE_STATIC[(DEFAULT)]
-#   Where DEFAULT is either `yes' or `no'.  If omitted, it defaults to
-#   `yes'.
-AC_DEFUN(AC_ENABLE_STATIC, [dnl
-define([AC_ENABLE_STATIC_DEFAULT], ifelse($1, no, no, yes))dnl
-AC_ARG_ENABLE(static,
-changequote(<<, >>)dnl
-<<  --enable-static[=PKGS]  build static libraries [default=>>AC_ENABLE_STATIC_DEFAULT],
-changequote([, ])dnl
-[p=${PACKAGE-default}
-case "$enableval" in
-yes) enable_static=yes ;;
-no) enable_static=no ;;
-*)
-  enable_static=no
-  # Look at the argument we got.  We use all the common list separators.
-  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
-  for pkg in $enableval; do
-    if test "X$pkg" = "X$p"; then
-      enable_static=yes
-    fi
-  done
-  IFS="$ac_save_ifs"
-  ;;
-esac],
-enable_static=AC_ENABLE_STATIC_DEFAULT)dnl
-])
-
-# AC_DISABLE_STATIC - set the default static flag to --disable-static
-AC_DEFUN(AC_DISABLE_STATIC, [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
-AC_ENABLE_STATIC(no)])
-
-
-# AC_ENABLE_FAST_INSTALL - implement the --enable-fast-install flag
-# Usage: AC_ENABLE_FAST_INSTALL[(DEFAULT)]
-#   Where DEFAULT is either `yes' or `no'.  If omitted, it defaults to
-#   `yes'.
-AC_DEFUN(AC_ENABLE_FAST_INSTALL, [dnl
-define([AC_ENABLE_FAST_INSTALL_DEFAULT], ifelse($1, no, no, yes))dnl
-AC_ARG_ENABLE(fast-install,
-changequote(<<, >>)dnl
-<<  --enable-fast-install[=PKGS]  optimize for fast installation [default=>>AC_ENABLE_FAST_INSTALL_DEFAULT],
-changequote([, ])dnl
-[p=${PACKAGE-default}
-case "$enableval" in
-yes) enable_fast_install=yes ;;
-no) enable_fast_install=no ;;
-*)
-  enable_fast_install=no
-  # Look at the argument we got.  We use all the common list separators.
-  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
-  for pkg in $enableval; do
-    if test "X$pkg" = "X$p"; then
-      enable_fast_install=yes
-    fi
-  done
-  IFS="$ac_save_ifs"
-  ;;
-esac],
-enable_fast_install=AC_ENABLE_FAST_INSTALL_DEFAULT)dnl
-])
-
-# AC_ENABLE_FAST_INSTALL - set the default to --disable-fast-install
-AC_DEFUN(AC_DISABLE_FAST_INSTALL, [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
-AC_ENABLE_FAST_INSTALL(no)])
-
-
-# AC_PATH_TOOL_PREFIX - find a file program which can recognise shared library
-AC_DEFUN(AC_PATH_TOOL_PREFIX,
-[AC_MSG_CHECKING([for $1])
-AC_CACHE_VAL(lt_cv_path_MAGIC,
-[case "$MAGIC" in
-  /*)
-  lt_cv_path_MAGIC="$MAGIC" # Let the user override the test with a path.
-  ;;
-  ?:/*)
-  ac_cv_path_MAGIC="$MAGIC" # Let the user override the test with a dos path.
-  ;;
-  *)
-  ac_save_MAGIC="$MAGIC"
-  IFS="${IFS=   }"; ac_save_ifs="$IFS"; IFS=":"
-dnl $ac_dummy forces splitting on constant user-supplied paths.
-dnl POSIX.2 word splitting is done only on the output of word expansions,
-dnl not every word.  This closes a longstanding sh security hole.
-  ac_dummy="ifelse([$2], , $PATH, [$2])"
-  for ac_dir in $ac_dummy; do
-    test -z "$ac_dir" && ac_dir=.
-    if test -f $ac_dir/$1; then
-      lt_cv_path_MAGIC="$ac_dir/$1"
-      if test -n "$file_magic_test_file"; then
-	case "$deplibs_check_method" in
-	"file_magic "*)
-	  file_magic_regex="`expr \"$deplibs_check_method\" : \"file_magic \(.*\)\"`"
-	  MAGIC="$lt_cv_path_MAGIC"
-	  if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
-	    egrep "$file_magic_regex" > /dev/null; then
-	    :
-	  else
-	    cat <<EOF 1>&2
-
-*** Warning: the command libtool uses to detect shared libraries,
-*** $file_magic_cmd, produces output that libtool cannot recognize.
-*** The result is that libtool may fail to recognize shared libraries
-*** as such.  This will affect the creation of libtool libraries that
-*** depend on shared libraries, but programs linked with such libtool
-*** libraries will work regardless of this problem.  Nevertheless, you
-*** may want to report the problem to your system manager and/or to
-*** bug-libtool@gnu.org
-
-EOF
-	  fi ;;
-	esac
-      fi
-      break
-    fi
-  done
-  IFS="$ac_save_ifs"
-  MAGIC="$ac_save_MAGIC"
-  ;;
-esac])
-MAGIC="$lt_cv_path_MAGIC"
-if test -n "$MAGIC"; then
-  AC_MSG_RESULT($MAGIC)
-else
-  AC_MSG_RESULT(no)
-fi
-])
-
-
-# AC_PATH_MAGIC - find a file program which can recognise a shared library
-AC_DEFUN(AC_PATH_MAGIC,
-[AC_REQUIRE([AC_CHECK_TOOL_PREFIX])dnl
-AC_PATH_TOOL_PREFIX(${ac_tool_prefix}file, /usr/bin:$PATH)
-if test -z "$lt_cv_path_MAGIC"; then
-  if test -n "$ac_tool_prefix"; then
-    AC_PATH_TOOL_PREFIX(file, /usr/bin:$PATH)
-  else
-    MAGIC=:
-  fi
-fi
-])
-
-
-# AC_PROG_LD - find the path to the GNU or non-GNU linker
-AC_DEFUN(AC_PROG_LD,
-[AC_ARG_WITH(gnu-ld,
-[  --with-gnu-ld           assume the C compiler uses GNU ld [default=no]],
-test "$withval" = no || with_gnu_ld=yes, with_gnu_ld=no)
-AC_REQUIRE([AC_PROG_CC])dnl
-AC_REQUIRE([AC_CANONICAL_HOST])dnl
-AC_REQUIRE([AC_CANONICAL_BUILD])dnl
-ac_prog=ld
-if test "$ac_cv_prog_gcc" = yes; then
-  # Check if gcc -print-prog-name=ld gives a path.
-  AC_MSG_CHECKING([for ld used by GCC])
-  case $lt_target in
-  *-*-mingw*)
-    # gcc leaves a trailing carriage return which upsets mingw
-    ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
-  *)
-    ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
-  esac
-  case "$ac_prog" in
-    # Accept absolute paths.
-changequote(,)dnl
-    [\\/]* | [A-Za-z]:[\\/]*)
-      re_direlt='/[^/][^/]*/\.\./'
-changequote([,])dnl
-      # Canonicalize the path of ld
-      ac_prog=`echo $ac_prog| sed 's%\\\\%/%g'`
-      while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do
-	ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"`
-      done
-      test -z "$LD" && LD="$ac_prog"
-      ;;
-  "")
-    # If it fails, then pretend we aren't using GCC.
-    ac_prog=ld
-    ;;
-  *)
-    # If it is relative, then search for the first ld in PATH.
-    with_gnu_ld=unknown
-    ;;
-  esac
-elif test "$with_gnu_ld" = yes; then
-  AC_MSG_CHECKING([for GNU ld])
-else
-  AC_MSG_CHECKING([for non-GNU ld])
-fi
-AC_CACHE_VAL(ac_cv_path_LD,
-[if test -z "$LD"; then
-  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR-:}"
-  for ac_dir in $PATH; do
-    test -z "$ac_dir" && ac_dir=.
-    if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
-      ac_cv_path_LD="$ac_dir/$ac_prog"
-      # Check to see if the program is GNU ld.  I'd rather use --version,
-      # but apparently some GNU ld's only accept -v.
-      # Break only if it was the GNU/non-GNU ld that we prefer.
-      if "$ac_cv_path_LD" -v 2>&1 < /dev/null | egrep '(GNU|with BFD)' > /dev/null; then
-	test "$with_gnu_ld" != no && break
-      else
-	test "$with_gnu_ld" != yes && break
-      fi
-    fi
-  done
-  IFS="$ac_save_ifs"
-else
-  ac_cv_path_LD="$LD" # Let the user override the test with a path.
-fi])
-LD="$ac_cv_path_LD"
-if test -n "$LD"; then
-  AC_MSG_RESULT($LD)
-else
-  AC_MSG_RESULT(no)
-fi
-test -z "$LD" && AC_MSG_ERROR([no acceptable ld found in \$PATH])
-AC_PROG_LD_GNU
-])
-
-AC_DEFUN(AC_PROG_LD_GNU,
-[AC_CACHE_CHECK([if the linker ($LD) is GNU ld], ac_cv_prog_gnu_ld,
-[# I'd rather use --version here, but apparently some GNU ld's only accept -v.
-if $LD -v 2>&1 </dev/null | egrep '(GNU|with BFD)' 1>&5; then
-  ac_cv_prog_gnu_ld=yes
-else
-  ac_cv_prog_gnu_ld=no
-fi])
-with_gnu_ld=$ac_cv_prog_gnu_ld
-])
-
-# AC_PROG_LD_RELOAD_FLAG - find reload flag for linker
-#   -- PORTME Some linkers may need a different reload flag.
-AC_DEFUN(AC_PROG_LD_RELOAD_FLAG,
-[AC_CACHE_CHECK([for $LD option to reload object files], lt_cv_ld_reload_flag,
-[lt_cv_ld_reload_flag='-r'])
-reload_flag=$lt_cv_ld_reload_flag
-test -n "$reload_flag" && reload_flag=" $reload_flag"
-])
-
-# AC_DEPLIBS_CHECK_METHOD - how to check for library dependencies
-#  -- PORTME fill in with the dynamic library characteristics
-AC_DEFUN(AC_DEPLIBS_CHECK_METHOD,
-[AC_CACHE_CHECK([how to recognise dependant libraries],
-lt_cv_deplibs_check_method,
-[lt_cv_file_magic_cmd='${MAGIC}'
-lt_cv_file_magic_test_file=
-lt_cv_deplibs_check_method='unknown'
-# Need to set the preceding variable on all platforms that support
-# interlibrary dependencies.
-# 'none' -- dependencies not supported.
-# `unknown' -- same as none, but documents that we really don't know.
-# 'pass_all' -- all dependencies passed with no checks.
-# 'test_compile' -- check by making test program.
-# 'file_magic [regex]' -- check by looking for files in library path
-# which responds to the $file_magic_cmd with a given egrep regex.
-# If you have `file' or equivalent on your system and you're not sure
-# whether `pass_all' will *always* work, you probably want this one.
-
-case "$host_os" in
-aix4* | beos*)
-  lt_cv_deplibs_check_method=pass_all
-  ;;
-
-bsdi4*)
-  changequote(,)dnl
-  lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)'
-  changequote([, ])dnl
-  lt_cv_file_magic_test_file=/shlib/libc.so
-  ;;
-
-cygwin* | mingw*)
-  lt_cv_deplibs_check_method='file_magic file format pei*-i386(.*architecture: i386)?'
-  lt_cv_file_magic_cmd='${OBJDUMP} -f'
-  ;;
-
-freebsd*)
-  case "$version_type" in
-  freebsd-elf*)
-    lt_cv_deplibs_check_method=pass_all
-    ;;
-  esac
-  ;;
-
-gnu*)
-  lt_cv_deplibs_check_method=pass_all
-  ;;
-
-irix5* | irix6*)
-  case "$host_os" in
-  irix5*)
-    # this will be overridden with pass_all, but let us keep it just in case
-    lt_cv_deplibs_check_method="file_magic ELF 32-bit MSB dynamic lib MIPS - version 1"
-    ;;
-  *)
-    case "$LD" in
-    *-32|*"-32 ") libmagic=32-bit;;
-    *-n32|*"-n32 ") libmagic=N32;;
-    *-64|*"-64 ") libmagic=64-bit;;
-    *) libmagic=never-match;;
-    esac
-    # this will be overridden with pass_all, but let us keep it just in case
-    changequote(,)dnl
-    lt_cv_deplibs_check_method="file_magic ELF ${libmagic} MSB mips-[1234] dynamic lib MIPS - version 1"
-    changequote([, ])dnl
-    ;;
-  esac
-  lt_cv_file_magic_test_file=`echo /lib${libsuff}/libc.so*`
-  lt_cv_deplibs_check_method=pass_all
-  ;;
-
-# This must be Linux ELF.
-linux-gnu*)
-  case "$host_cpu" in
-  alpha* | i*86 | powerpc* | sparc* )
-    lt_cv_deplibs_check_method=pass_all ;;
-  *)
-    # glibc up to 2.1.1 does not perform some relocations on ARM
-    changequote(,)dnl
-    lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )' ;;
-    changequote([, ])dnl
-  esac
-  lt_cv_file_magic_test_file=`echo /lib/libc.so* /lib/libc-*.so`
-  ;;
-
-osf3* | osf4* | osf5*)
-  # this will be overridden with pass_all, but let us keep it just in case
-  lt_cv_deplibs_check_method='file_magic COFF format alpha shared library'
-  lt_cv_file_magic_test_file=/shlib/libc.so
-  lt_cv_deplibs_check_method=pass_all
-  ;;
-
-sco3.2v5*)
-  lt_cv_deplibs_check_method=pass_all
-  ;;
-
-solaris*)
-  lt_cv_deplibs_check_method=pass_all
-  lt_cv_file_magic_test_file=/lib/libc.so
-  ;;
-
-sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
-  case "$host_vendor" in
-  ncr)
-    lt_cv_deplibs_check_method=pass_all
-    ;;
-  motorola)
-    changequote(,)dnl
-    lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]'
-    changequote([, ])dnl
-    lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*`
-    ;;
-  esac
-  ;;
-esac
-])
-file_magic_cmd=$lt_cv_file_magic_cmd
-deplibs_check_method=$lt_cv_deplibs_check_method
-])
-
-
-# AC_PROG_NM - find the path to a BSD-compatible name lister
-AC_DEFUN(AC_PROG_NM,
-[AC_MSG_CHECKING([for BSD-compatible nm])
-AC_CACHE_VAL(ac_cv_path_NM,
-[if test -n "$NM"; then
-  # Let the user override the test.
-  ac_cv_path_NM="$NM"
-else
-  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR-:}"
-  for ac_dir in $PATH /usr/ccs/bin /usr/ucb /bin; do
-    test -z "$ac_dir" && ac_dir=.
-    if test -f $ac_dir/nm || test -f $ac_dir/nm$ac_exeext ; then
-      # Check to see if the nm accepts a BSD-compat flag.
-      # Adding the `sed 1q' prevents false positives on HP-UX, which says:
-      #   nm: unknown option "B" ignored
-      if ($ac_dir/nm -B /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then
-	ac_cv_path_NM="$ac_dir/nm -B"
-	break
-      elif ($ac_dir/nm -p /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then
-	ac_cv_path_NM="$ac_dir/nm -p"
-	break
-      else
-	ac_cv_path_NM=${ac_cv_path_NM="$ac_dir/nm"} # keep the first match, but
-	continue # so that we can try to find one that supports BSD flags
-      fi
-    fi
-  done
-  IFS="$ac_save_ifs"
-  test -z "$ac_cv_path_NM" && ac_cv_path_NM=nm
-fi])
-NM="$ac_cv_path_NM"
-AC_MSG_RESULT([$NM])
-])
-
-# AC_CHECK_LIBM - check for math library
-AC_DEFUN(AC_CHECK_LIBM,
-[AC_REQUIRE([AC_CANONICAL_HOST])dnl
-LIBM=
-case "$lt_target" in
-*-*-beos* | *-*-cygwin*)
-  # These system don't have libm
-  ;;
-*-ncr-sysv4.3*)
-  AC_CHECK_LIB(mw, _mwvalidcheckl, LIBM="-lmw")
-  AC_CHECK_LIB(m, main, LIBM="$LIBM -lm")
-  ;;
-*)
-  AC_CHECK_LIB(m, main, LIBM="-lm")
-  ;;
-esac
-])
-
-# AC_LIBLTDL_CONVENIENCE[(dir)] - sets LIBLTDL to the link flags for
-# the libltdl convenience library, adds --enable-ltdl-convenience to
-# the configure arguments.  Note that LIBLTDL is not AC_SUBSTed, nor
-# is AC_CONFIG_SUBDIRS called.  If DIR is not provided, it is assumed
-# to be `${top_builddir}/libltdl'.  Make sure you start DIR with
-# '${top_builddir}/' (note the single quotes!) if your package is not
-# flat, and, if you're not using automake, define top_builddir as
-# appropriate in the Makefiles.
-AC_DEFUN(AC_LIBLTDL_CONVENIENCE, [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
-  case "$enable_ltdl_convenience" in
-  no) AC_MSG_ERROR([this package needs a convenience libltdl]) ;;
-  "") enable_ltdl_convenience=yes
-      ac_configure_args="$ac_configure_args --enable-ltdl-convenience" ;;
-  esac
-  LIBLTDL=ifelse($#,1,$1,['${top_builddir}/libltdl'])/libltdlc.la
-  INCLTDL=ifelse($#,1,-I$1,['-I${top_srcdir}/libltdl'])
-])
-
-# AC_LIBLTDL_INSTALLABLE[(dir)] - sets LIBLTDL to the link flags for
-# the libltdl installable library, and adds --enable-ltdl-install to
-# the configure arguments.  Note that LIBLTDL is not AC_SUBSTed, nor
-# is AC_CONFIG_SUBDIRS called.  If DIR is not provided, it is assumed
-# to be `${top_builddir}/libltdl'.  Make sure you start DIR with
-# '${top_builddir}/' (note the single quotes!) if your package is not
-# flat, and, if you're not using automake, define top_builddir as
-# appropriate in the Makefiles.
-# In the future, this macro may have to be called after AC_PROG_LIBTOOL.
-AC_DEFUN(AC_LIBLTDL_INSTALLABLE, [AC_BEFORE([$0],[AC_LIBTOOL_SETUP])dnl
-  AC_CHECK_LIB(ltdl, main,
-  [test x"$enable_ltdl_install" != xyes && enable_ltdl_install=no],
-  [if test x"$enable_ltdl_install" = xno; then
-     AC_MSG_WARN([libltdl not installed, but installation disabled])
-   else
-     enable_ltdl_install=yes
-   fi
-  ])
-  if test x"$enable_ltdl_install" = x"yes"; then
-    ac_configure_args="$ac_configure_args --enable-ltdl-install"
-    LIBLTDL=ifelse($#,1,$1,['${top_builddir}/libltdl'])/libltdl.la
-    INCLTDL=ifelse($#,1,-I$1,['-I${top_srcdir}/libltdl'])
-  else
-    ac_configure_args="$ac_configure_args --enable-ltdl-install=no"
-    LIBLTDL="-lltdl"
-    INCLTDL=
-  fi
-])
-
-dnl old names
-AC_DEFUN(AM_PROG_LIBTOOL, [indir([AC_PROG_LIBTOOL])])dnl
-AC_DEFUN(AM_ENABLE_SHARED, [indir([AC_ENABLE_SHARED], $@)])dnl
-AC_DEFUN(AM_ENABLE_STATIC, [indir([AC_ENABLE_STATIC], $@)])dnl
-AC_DEFUN(AM_DISABLE_SHARED, [indir([AC_DISABLE_SHARED], $@)])dnl
-AC_DEFUN(AM_DISABLE_STATIC, [indir([AC_DISABLE_STATIC], $@)])dnl
-AC_DEFUN(AM_PROG_LD, [indir([AC_PROG_LD])])dnl
-AC_DEFUN(AM_PROG_NM, [indir([AC_PROG_NM])])dnl
-
-dnl This is just to silence aclocal about the macro not being used
-ifelse([AC_DISABLE_FAST_INSTALL])dnl
-
diff --git a/ghc/rts/gmp/ansi2knr.1 b/ghc/rts/gmp/ansi2knr.1
deleted file mode 100644
index f9ee5a631c..0000000000
--- a/ghc/rts/gmp/ansi2knr.1
+++ /dev/null
@@ -1,36 +0,0 @@
-.TH ANSI2KNR 1 "19 Jan 1996"
-.SH NAME
-ansi2knr \- convert ANSI C to Kernighan & Ritchie C
-.SH SYNOPSIS
-.I ansi2knr
-[--varargs] input_file [output_file]
-.SH DESCRIPTION
-If no output_file is supplied, output goes to stdout.
-.br
-There are no error messages.
-.sp
-.I ansi2knr
-recognizes function definitions by seeing a non-keyword identifier at the left
-margin, followed by a left parenthesis, with a right parenthesis as the last
-character on the line, and with a left brace as the first token on the
-following line (ignoring possible intervening comments).  It will recognize a
-multi-line header provided that no intervening line ends with a left or right
-brace or a semicolon.  These algorithms ignore whitespace and comments, except
-that the function name must be the first thing on the line.
-.sp
-The following constructs will confuse it:
-.br
-     - Any other construct that starts at the left margin and follows the
-above syntax (such as a macro or function call).
-.br
-     - Some macros that tinker with the syntax of the function header.
-.sp
-The --varargs switch is obsolete, and is recognized only for
-backwards compatibility.  The present version of
-.I ansi2knr
-will always attempt to convert a ... argument to va_alist and va_dcl.
-.SH AUTHOR
-L. Peter Deutsch <ghost@aladdin.com> wrote the original ansi2knr and
-continues to maintain the current version; most of the code in the current
-version is his work.  ansi2knr also includes contributions by Francois
-Pinard <pinard@iro.umontreal.ca> and Jim Avera <jima@netcom.com>.
diff --git a/ghc/rts/gmp/ansi2knr.c b/ghc/rts/gmp/ansi2knr.c
deleted file mode 100644
index 937c731886..0000000000
--- a/ghc/rts/gmp/ansi2knr.c
+++ /dev/null
@@ -1,677 +0,0 @@
-/* Copyright (C) 1989, 1997, 1998, 1999 Aladdin Enterprises.  All rights reserved. */
-
-/* Convert ANSI C function definitions to K&R ("traditional C") syntax */
-
-/*
-ansi2knr is distributed in the hope that it will be useful, but WITHOUT ANY
-WARRANTY.  No author or distributor accepts responsibility to anyone for the
-consequences of using it or for whether it serves any particular purpose or
-works at all, unless he says so in writing.  Refer to the GNU General Public
-License (the "GPL") for full details.
-
-Everyone is granted permission to copy, modify and redistribute ansi2knr,
-but only under the conditions described in the GPL.  A copy of this license
-is supposed to have been given to you along with ansi2knr so you can know
-your rights and responsibilities.  It should be in a file named COPYLEFT,
-or, if there is no file named COPYLEFT, a file named COPYING.  Among other
-things, the copyright notice and this notice must be preserved on all
-copies.
-
-We explicitly state here what we believe is already implied by the GPL: if
-the ansi2knr program is distributed as a separate set of sources and a
-separate executable file which are aggregated on a storage medium together
-with another program, this in itself does not bring the other program under
-the GPL, nor does the mere fact that such a program or the procedures for
-constructing it invoke the ansi2knr executable bring any other part of the
-program under the GPL.
-*/
-
-/*
- * Usage:
-	ansi2knr [--filename FILENAME] [INPUT_FILE [OUTPUT_FILE]]
- * --filename provides the file name for the #line directive in the output,
- * overriding input_file (if present).
- * If no input_file is supplied, input is read from stdin.
- * If no output_file is supplied, output goes to stdout.
- * There are no error messages.
- *
- * ansi2knr recognizes function definitions by seeing a non-keyword
- * identifier at the left margin, followed by a left parenthesis,
- * with a right parenthesis as the last character on the line,
- * and with a left brace as the first token on the following line
- * (ignoring possible intervening comments), except that a line
- * consisting of only
- *	identifier1(identifier2)
- * will not be considered a function definition unless identifier2 is
- * the word "void", and a line consisting of
- *	identifier1(identifier2, <<arbitrary>>)
- * will not be considered a function definition.
- * ansi2knr will recognize a multi-line header provided
- * that no intervening line ends with a left or right brace or a semicolon.
- * These algorithms ignore whitespace and comments, except that
- * the function name must be the first thing on the line.
- * The following constructs will confuse it:
- *	- Any other construct that starts at the left margin and
- *	    follows the above syntax (such as a macro or function call).
- *	- Some macros that tinker with the syntax of function headers.
- */
-
-/*
- * The original and principal author of ansi2knr is L. Peter Deutsch
- * <ghost@aladdin.com>.  Other authors are noted in the change history
- * that follows (in reverse chronological order):
-	lpd 1999-04-12 added minor fixes from Pavel Roskin
-		<pavel_roskin@geocities.com> for clean compilation with
-		gcc -W -Wall
-	lpd 1999-03-22 added hack to recognize lines consisting of
-		identifier1(identifier2, xxx) as *not* being procedures
-	lpd 1999-02-03 made indentation of preprocessor commands consistent
-	lpd 1999-01-28 fixed two bugs: a '/' in an argument list caused an
-		endless loop; quoted strings within an argument list
-		confused the parser
-	lpd 1999-01-24 added a check for write errors on the output,
-		suggested by Jim Meyering <meyering@ascend.com>
-	lpd 1998-11-09 added further hack to recognize identifier(void)
-		as being a procedure
-	lpd 1998-10-23 added hack to recognize lines consisting of
-		identifier1(identifier2) as *not* being procedures
-	lpd 1997-12-08 made input_file optional; only closes input and/or
-		output file if not stdin or stdout respectively; prints
-		usage message on stderr rather than stdout; adds
-		--filename switch (changes suggested by
-		<ceder@lysator.liu.se>)
-	lpd 1996-01-21 added code to cope with not HAVE_CONFIG_H and with
-		compilers that don't understand void, as suggested by
-		Tom Lane
-	lpd 1996-01-15 changed to require that the first non-comment token
-		on the line following a function header be a left brace,
-		to reduce sensitivity to macros, as suggested by Tom Lane
-		<tgl@sss.pgh.pa.us>
-	lpd 1995-06-22 removed #ifndefs whose sole purpose was to define
-		undefined preprocessor symbols as 0; changed all #ifdefs
-		for configuration symbols to #ifs
-	lpd 1995-04-05 changed copyright notice to make it clear that
-		including ansi2knr in a program does not bring the entire
-		program under the GPL
-	lpd 1994-12-18 added conditionals for systems where ctype macros
-		don't handle 8-bit characters properly, suggested by
-		Francois Pinard <pinard@iro.umontreal.ca>;
-		removed --varargs switch (this is now the default)
-	lpd 1994-10-10 removed CONFIG_BROKETS conditional
-	lpd 1994-07-16 added some conditionals to help GNU `configure',
-		suggested by Francois Pinard <pinard@iro.umontreal.ca>;
-		properly erase prototype args in function parameters,
-		contributed by Jim Avera <jima@netcom.com>;
-		correct error in writeblanks (it shouldn't erase EOLs)
-	lpd 1989-xx-xx original version
- */
-
-/* Most of the conditionals here are to make ansi2knr work with */
-/* or without the GNU configure machinery. */
-
-#if HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include <stdio.h>
-#include <ctype.h>
-
-#if HAVE_CONFIG_H
-
-/*
-   For properly autoconfiguring ansi2knr, use AC_CONFIG_HEADER(config.h).
-   This will define HAVE_CONFIG_H and so, activate the following lines.
- */
-
-# if STDC_HEADERS || HAVE_STRING_H
-#  include <string.h>
-# else
-#  include <strings.h>
-# endif
-
-#else /* not HAVE_CONFIG_H */
-
-/* Otherwise do it the hard way */
-
-# ifdef BSD
-#  include <strings.h>
-# else
-#  ifdef VMS
-    extern int strlen(), strncmp();
-#  else
-#   include <string.h>
-#  endif
-# endif
-
-#endif /* not HAVE_CONFIG_H */
-
-#if STDC_HEADERS
-# include <stdlib.h>
-#else
-/*
-   malloc and free should be declared in stdlib.h,
-   but if you've got a K&R compiler, they probably aren't.
- */
-# ifdef MSDOS
-#  include <malloc.h>
-# else
-#  ifdef VMS
-     extern char *malloc();
-     extern void free();
-#  else
-     extern char *malloc();
-     extern int free();
-#  endif
-# endif
-
-#endif
-
-/* Define NULL (for *very* old compilers). */
-#ifndef NULL
-# define NULL (0)
-#endif
-
-/*
- * The ctype macros don't always handle 8-bit characters correctly.
- * Compensate for this here.
- */
-#ifdef isascii
-# undef HAVE_ISASCII		/* just in case */
-# define HAVE_ISASCII 1
-#else
-#endif
-#if STDC_HEADERS || !HAVE_ISASCII
-# define is_ascii(c) 1
-#else
-# define is_ascii(c) isascii(c)
-#endif
-
-#define is_space(c) (is_ascii(c) && isspace(c))
-#define is_alpha(c) (is_ascii(c) && isalpha(c))
-#define is_alnum(c) (is_ascii(c) && isalnum(c))
-
-/* Scanning macros */
-#define isidchar(ch) (is_alnum(ch) || (ch) == '_')
-#define isidfirstchar(ch) (is_alpha(ch) || (ch) == '_')
-
-/* Forward references */
-char *skipspace();
-char *scanstring();
-int writeblanks();
-int test1();
-int convert1();
-
-/* The main program */
-int
-main(argc, argv)
-    int argc;
-    char *argv[];
-{	FILE *in = stdin;
-	FILE *out = stdout;
-	char *filename = 0;
-	char *program_name = argv[0];
-	char *output_name = 0;
-#define bufsize 5000			/* arbitrary size */
-	char *buf;
-	char *line;
-	char *more;
-	char *usage =
-	  "Usage: ansi2knr [--filename FILENAME] [INPUT_FILE [OUTPUT_FILE]]\n";
-	/*
-	 * In previous versions, ansi2knr recognized a --varargs switch.
-	 * If this switch was supplied, ansi2knr would attempt to convert
-	 * a ... argument to va_alist and va_dcl; if this switch was not
-	 * supplied, ansi2knr would simply drop any such arguments.
-	 * Now, ansi2knr always does this conversion, and we only
-	 * check for this switch for backward compatibility.
-	 */
-	int convert_varargs = 1;
-	int output_error;
-
-	while ( argc > 1 && argv[1][0] == '-' ) {
-	  if ( !strcmp(argv[1], "--varargs") ) {
-	    convert_varargs = 1;
-	    argc--;
-	    argv++;
-	    continue;
-	  }
-	  if ( !strcmp(argv[1], "--filename") && argc > 2 ) {
-	    filename = argv[2];
-	    argc -= 2;
-	    argv += 2;
-	    continue;
-	  }
-	  fprintf(stderr, "%s: Unrecognized switch: %s\n", program_name,
-		  argv[1]);
-	  fprintf(stderr, usage);
-	  exit(1);
-	}
-	switch ( argc )
-	   {
-	default:
-		fprintf(stderr, usage);
-		exit(0);
-	case 3:
-		output_name = argv[2];
-		out = fopen(output_name, "w");
-		if ( out == NULL ) {
-		  fprintf(stderr, "%s: Cannot open output file %s\n",
-			  program_name, output_name);
-		  exit(1);
-		}
-		/* falls through */
-	case 2:
-		in = fopen(argv[1], "r");
-		if ( in == NULL ) {
-		  fprintf(stderr, "%s: Cannot open input file %s\n",
-			  program_name, argv[1]);
-		  exit(1);
-		}
-		if ( filename == 0 )
-		  filename = argv[1];
-		/* falls through */
-	case 1:
-		break;
-	   }
-	if ( filename )
-	  fprintf(out, "#line 1 \"%s\"\n", filename);
-	buf = malloc(bufsize);
-	if ( buf == NULL )
-	   {
-		fprintf(stderr, "Unable to allocate read buffer!\n");
-		exit(1);
-	   }
-	line = buf;
-	while ( fgets(line, (unsigned)(buf + bufsize - line), in) != NULL )
-	   {
-test:		line += strlen(line);
-		switch ( test1(buf) )
-		   {
-		case 2:			/* a function header */
-			convert1(buf, out, 1, convert_varargs);
-			break;
-		case 1:			/* a function */
-			/* Check for a { at the start of the next line. */
-			more = ++line;
-f:			if ( line >= buf + (bufsize - 1) ) /* overflow check */
-			  goto wl;
-			if ( fgets(line, (unsigned)(buf + bufsize - line), in) == NULL )
-			  goto wl;
-			switch ( *skipspace(more, 1) )
-			  {
-			  case '{':
-			    /* Definitely a function header. */
-			    convert1(buf, out, 0, convert_varargs);
-			    fputs(more, out);
-			    break;
-			  case 0:
-			    /* The next line was blank or a comment: */
-			    /* keep scanning for a non-comment. */
-			    line += strlen(line);
-			    goto f;
-			  default:
-			    /* buf isn't a function header, but */
-			    /* more might be. */
-			    fputs(buf, out);
-			    strcpy(buf, more);
-			    line = buf;
-			    goto test;
-			  }
-			break;
-		case -1:		/* maybe the start of a function */
-			if ( line != buf + (bufsize - 1) ) /* overflow check */
-			  continue;
-			/* falls through */
-		default:		/* not a function */
-wl:			fputs(buf, out);
-			break;
-		   }
-		line = buf;
-	   }
-	if ( line != buf )
-	  fputs(buf, out);
-	free(buf);
-	if ( output_name ) {
-	  output_error = ferror(out);
-	  output_error |= fclose(out);
-	} else {		/* out == stdout */
-	  fflush(out);
-	  output_error = ferror(out);
-	}
-	if ( output_error ) {
-	  fprintf(stderr, "%s: error writing to %s\n", program_name,
-		  (output_name ? output_name : "stdout"));
-	  exit(1);
-	}
-	if ( in != stdin )
-	  fclose(in);
-	return 0;
-}
-
-/* Skip over whitespace and comments, in either direction. */
-char *
-skipspace(p, dir)
-    register char *p;
-    register int dir;			/* 1 for forward, -1 for backward */
-{	for ( ; ; )
-	   {	while ( is_space(*p) )
-		  p += dir;
-		if ( !(*p == '/' && p[dir] == '*') )
-		  break;
-		p += dir;  p += dir;
-		while ( !(*p == '*' && p[dir] == '/') )
-		   {	if ( *p == 0 )
-			  return p;	/* multi-line comment?? */
-			p += dir;
-		   }
-		p += dir;  p += dir;
-	   }
-	return p;
-}
-
-/* Scan over a quoted string, in either direction. */
-char *
-scanstring(p, dir)
-    register char *p;
-    register int dir;
-{
-    for (p += dir; ; p += dir)
-	if (*p == '"' && p[-dir] != '\\')
-	    return p + dir;
-}
-
-/*
- * Write blanks over part of a string.
- * Don't overwrite end-of-line characters.
- */
-int
-writeblanks(start, end)
-    char *start;
-    char *end;
-{	char *p;
-	for ( p = start; p < end; p++ )
-	  if ( *p != '\r' && *p != '\n' )
-	    *p = ' ';
-	return 0;
-}
-
-/*
- * Test whether the string in buf is a function definition.
- * The string may contain and/or end with a newline.
- * Return as follows:
- *	0 - definitely not a function definition;
- *	1 - definitely a function definition;
- *	2 - definitely a function prototype (NOT USED);
- *	-1 - may be the beginning of a function definition,
- *		append another line and look again.
- * The reason we don't attempt to convert function prototypes is that
- * Ghostscript's declaration-generating macros look too much like
- * prototypes, and confuse the algorithms.
- */
-int
-test1(buf)
-    char *buf;
-{	register char *p = buf;
-	char *bend;
-	char *endfn;
-	int contin;
-
-	if ( !isidfirstchar(*p) )
-	  return 0;		/* no name at left margin */
-	bend = skipspace(buf + strlen(buf) - 1, -1);
-	switch ( *bend )
-	   {
-	   case ';': contin = 0 /*2*/; break;
-	   case ')': contin = 1; break;
-	   case '{': return 0;		/* not a function */
-	   case '}': return 0;		/* not a function */
-	   default: contin = -1;
-	   }
-	while ( isidchar(*p) )
-	  p++;
-	endfn = p;
-	p = skipspace(p, 1);
-	if ( *p++ != '(' )
-	  return 0;		/* not a function */
-	p = skipspace(p, 1);
-	if ( *p == ')' )
-	  return 0;		/* no parameters */
-	/* Check that the apparent function name isn't a keyword. */
-	/* We only need to check for keywords that could be followed */
-	/* by a left parenthesis (which, unfortunately, is most of them). */
-	   {	static char *words[] =
-		   {	"asm", "auto", "case", "char", "const", "double",
-			"extern", "float", "for", "if", "int", "long",
-			"register", "return", "short", "signed", "sizeof",
-			"static", "switch", "typedef", "unsigned",
-			"void", "volatile", "while", 0
-		   };
-		char **key = words;
-		char *kp;
-		unsigned len = endfn - buf;
-
-		while ( (kp = *key) != 0 )
-		   {	if ( strlen(kp) == len && !strncmp(kp, buf, len) )
-			  return 0;	/* name is a keyword */
-			key++;
-		   }
-	   }
-	   {
-	       char *id = p;
-	       int len;
-	       /*
-		* Check for identifier1(identifier2) and not
-		* identifier1(void), or identifier1(identifier2, xxxx).
-		*/
-
-	       while ( isidchar(*p) )
-		   p++;
-	       len = p - id;
-	       p = skipspace(p, 1);
-	       if (*p == ',' ||
-		   (*p == ')' && (len != 4 || strncmp(id, "void", 4)))
-		   )
-		   return 0;	/* not a function */
-	   }
-	/*
-	 * If the last significant character was a ), we need to count
-	 * parentheses, because it might be part of a formal parameter
-	 * that is a procedure.
-	 */
-	if (contin > 0) {
-	    int level = 0;
-
-	    for (p = skipspace(buf, 1); *p; p = skipspace(p + 1, 1))
-		level += (*p == '(' ? 1 : *p == ')' ? -1 : 0);
-	    if (level > 0)
-		contin = -1;
-	}
-	return contin;
-}
-
-/* Convert a recognized function definition or header to K&R syntax. */
-int
-convert1(buf, out, header, convert_varargs)
-    char *buf;
-    FILE *out;
-    int header;			/* Boolean */
-    int convert_varargs;	/* Boolean */
-{	char *endfn;
-	register char *p;
-	/*
-	 * The breaks table contains pointers to the beginning and end
-	 * of each argument.
-	 */
-	char **breaks;
-	unsigned num_breaks = 2;	/* for testing */
-	char **btop;
-	char **bp;
-	char **ap;
-	char *vararg = 0;
-
-	/* Pre-ANSI implementations don't agree on whether strchr */
-	/* is called strchr or index, so we open-code it here. */
-	for ( endfn = buf; *(endfn++) != '('; )
-	  ;
-top:	p = endfn;
-	breaks = (char **)malloc(sizeof(char *) * num_breaks * 2);
-	if ( breaks == NULL )
-	   {	/* Couldn't allocate break table, give up */
-		fprintf(stderr, "Unable to allocate break table!\n");
-		fputs(buf, out);
-		return -1;
-	   }
-	btop = breaks + num_breaks * 2 - 2;
-	bp = breaks;
-	/* Parse the argument list */
-	do
-	   {	int level = 0;
-		char *lp = NULL;
-		char *rp = NULL;
-		char *end = NULL;
-
-		if ( bp >= btop )
-		   {	/* Filled up break table. */
-			/* Allocate a bigger one and start over. */
-			free((char *)breaks);
-			num_breaks <<= 1;
-			goto top;
-		   }
-		*bp++ = p;
-		/* Find the end of the argument */
-		for ( ; end == NULL; p++ )
-		   {	switch(*p)
-			   {
-			   case ',':
-				if ( !level ) end = p;
-				break;
-			   case '(':
-				if ( !level ) lp = p;
-				level++;
-				break;
-			   case ')':
-				if ( --level < 0 ) end = p;
-				else rp = p;
-				break;
-			   case '/':
-				if (p[1] == '*')
-				    p = skipspace(p, 1) - 1;
-				break;
-			   case '"':
-			       p = scanstring(p, 1) - 1;
-			       break;
-			   default:
-				;
-			   }
-		   }
-		/* Erase any embedded prototype parameters. */
-		if ( lp && rp )
-		  writeblanks(lp + 1, rp);
-		p--;			/* back up over terminator */
-		/* Find the name being declared. */
-		/* This is complicated because of procedure and */
-		/* array modifiers. */
-		for ( ; ; )
-		   {	p = skipspace(p - 1, -1);
-			switch ( *p )
-			   {
-			   case ']':	/* skip array dimension(s) */
-			   case ')':	/* skip procedure args OR name */
-			   {	int level = 1;
-				while ( level )
-				 switch ( *--p )
-				   {
-				   case ']': case ')':
-				       level++;
-				       break;
-				   case '[': case '(':
-				       level--;
-				       break;
-				   case '/':
-				       if (p > buf && p[-1] == '*')
-					   p = skipspace(p, -1) + 1;
-				       break;
-				   case '"':
-				       p = scanstring(p, -1) + 1;
-				       break;
-				   default: ;
-				   }
-			   }
-				if ( *p == '(' && *skipspace(p + 1, 1) == '*' )
-				   {	/* We found the name being declared */
-					while ( !isidfirstchar(*p) )
-					  p = skipspace(p, 1) + 1;
-					goto found;
-				   }
-				break;
-			   default:
-				goto found;
-			   }
-		   }
-found:		if ( *p == '.' && p[-1] == '.' && p[-2] == '.' )
-		  {	if ( convert_varargs )
-			  {	*bp++ = "va_alist";
-				vararg = p-2;
-			  }
-			else
-			  {	p++;
-				if ( bp == breaks + 1 )	/* sole argument */
-				  writeblanks(breaks[0], p);
-				else
-				  writeblanks(bp[-1] - 1, p);
-				bp--;
-			  }
-		   }
-		else
-		   {	while ( isidchar(*p) ) p--;
-			*bp++ = p+1;
-		   }
-		p = end;
-	   }
-	while ( *p++ == ',' );
-	*bp = p;
-	/* Make a special check for 'void' arglist */
-	if ( bp == breaks+2 )
-	   {	p = skipspace(breaks[0], 1);
-		if ( !strncmp(p, "void", 4) )
-		   {	p = skipspace(p+4, 1);
-			if ( p == breaks[2] - 1 )
-			   {	bp = breaks;	/* yup, pretend arglist is empty */
-				writeblanks(breaks[0], p + 1);
-			   }
-		   }
-	   }
-	/* Put out the function name and left parenthesis. */
-	p = buf;
-	while ( p != endfn ) putc(*p, out), p++;
-	/* Put out the declaration. */
-	if ( header )
-	  {	fputs(");", out);
-		for ( p = breaks[0]; *p; p++ )
-		  if ( *p == '\r' || *p == '\n' )
-		    putc(*p, out);
-	  }
-	else
-	  {	for ( ap = breaks+1; ap < bp; ap += 2 )
-		  {	p = *ap;
-			while ( isidchar(*p) )
-			  putc(*p, out), p++;
-			if ( ap < bp - 1 )
-			  fputs(", ", out);
-		  }
-		fputs(")  ", out);
-		/* Put out the argument declarations */
-		for ( ap = breaks+2; ap <= bp; ap += 2 )
-		  (*ap)[-1] = ';';
-		if ( vararg != 0 )
-		  {	*vararg = 0;
-			fputs(breaks[0], out);		/* any prior args */
-			fputs("va_dcl", out);		/* the final arg */
-			fputs(bp[0], out);
-		  }
-		else
-		  fputs(breaks[0], out);
-	  }
-	free((char *)breaks);
-	return 0;
-}
diff --git a/ghc/rts/gmp/assert.c b/ghc/rts/gmp/assert.c
deleted file mode 100644
index 65eccfa30b..0000000000
--- a/ghc/rts/gmp/assert.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/* GMP assertion failure handler. */
-
-/*
-Copyright (C) 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-#include <stdio.h>
-#include "gmp.h"
-#include "gmp-impl.h"
-
-
-int
-#if __STDC__
-__gmp_assert_fail (const char *filename, int linenum,
-                   const char *expr)
-#else
-__gmp_assert_fail (filename, linenum, expr)
-char *filename;
-int  linenum;
-char *expr;
-#endif
-{
-  if (filename != NULL && filename[0] != '\0')
-    {
-      fprintf (stderr, "%s:", filename);
-      if (linenum != -1)
-        fprintf (stderr, "%d: ", linenum);
-    }
-
-  fprintf (stderr, "GNU MP assertion failed: %s\n", expr);
-  abort();
-
-  /*NOTREACHED*/
-  return 0;
-}
diff --git a/ghc/rts/gmp/compat.c b/ghc/rts/gmp/compat.c
deleted file mode 100644
index ab7529f52f..0000000000
--- a/ghc/rts/gmp/compat.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/* Old function entrypoints retained for binary compatibility. */
-
-/*
-Copyright (C) 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-#include <stdio.h>
-#include "gmp.h"
-#include "gmp-impl.h"
-
-
-/* mpn_divexact_by3 was a function in gmp 3.0, but as of gmp 3.1 it's a
-   macro calling mpn_divexact_by3c.  */
-int
-__MPN (divexact_by3) (mp_ptr dst, mp_srcptr src, mp_size_t size)
-{
-  mpn_divexact_by3 (dst, src, size);
-}
-
-
-/* mpn_divmod_1 was a function in gmp 3.0 and earlier, but marked obsolete
-   in gmp 2 and 3.  As of gmp 3.1 it's a macro calling mpn_divrem_1. */
-int
-__MPN (divmod_1) (mp_ptr dst, mp_srcptr src, mp_size_t size, mp_limb_t divisor)
-{
-  mpn_divmod_1 (dst, src, size, divisor);
-}
-
-
diff --git a/ghc/rts/gmp/config.guess b/ghc/rts/gmp/config.guess
deleted file mode 100644
index 08018f497d..0000000000
--- a/ghc/rts/gmp/config.guess
+++ /dev/null
@@ -1,1373 +0,0 @@
-#! /bin/sh
-# Attempt to guess a canonical system name.
-#
-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000
-# Free Software Foundation, Inc.
-#
-# This file is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
-
-# Written by Per Bothner <bothner@cygnus.com>.
-# Please send patches to <config-patches@gnu.org>.
-#
-# This script attempts to guess a canonical system name similar to
-# config.sub.  If it succeeds, it prints the system name on stdout, and
-# exits with 0.  Otherwise, it exits with 1.
-#
-# The plan is that this can be called by configure scripts if you
-# don't specify an explicit system type (host/target name).
-#
-# Only a few systems have been added to this list; please add others
-# (but try to keep the structure clean).
-#
-
-
-# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
-# (ghazi@noc.rutgers.edu 8/24/94.)
-if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
-	PATH=$PATH:/.attbin ; export PATH
-fi
-
-UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
-UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
-UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
-UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
-
-dummy=dummy-$$
-trap 'rm -f $dummy.c $dummy.o $dummy ${dummy}1.s ${dummy}2.c ; exit 1' 1 2 15
-
-# Use $HOST_CC if defined. $CC may point to a cross-compiler
-if test x"$CC_FOR_BUILD" = x; then
-  if test x"$HOST_CC" != x; then
-    CC_FOR_BUILD="$HOST_CC"
-  else
-    if test x"$CC" != x; then
-      CC_FOR_BUILD="$CC"
-    else
-      echo 'dummy(){}' >$dummy.c
-      for c in cc c89 gcc; do 
-	  ($c $dummy.c -c) >/dev/null 2>&1
-	  if test $? = 0; then
-	      CC_FOR_BUILD="$c"; break
-	  fi
-      done
-      rm -f $dummy.c $dummy.o
-      if test x"$CC_FOR_BUILD" = x; then
-	CC_FOR_BUILD=no_compiler_found
-      fi
-    fi
-  fi
-fi
-
-
-# First make a best effort at recognizing x86 CPU type and leave it in X86CPU.
-# If we fail, set X86CPU to UNAME_MACHINE
-#
-# DJGPP v2 (or 2.03 at least) always gives "pc" for uname -m, and the
-# OEM for uname -s.  Eg. pc:MS-DOS:6:2 on MS-DOS 6.21.  The list of
-# possible OEMs is in src/libc/dos/dos/getdos_v.c of djlsr203.zip, but
-# just pc:*:*:* seems ok.
-
-case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
-    i?86:*:*:* | i86pc:*:*:* | pc:*:*:*)
-	case "${UNAME_MACHINE}" in
-	i86pc | pc)  UNAME_MACHINE=i386 ;;
-	esac
-	cat <<EOF >${dummy}1.s
-	.globl cpuid
-	.globl _cpuid
-cpuid:
-_cpuid:
-	pushl %esi
-	pushl %ebx
-	movl 16(%esp),%eax
-	.byte 0x0f
-	.byte 0xa2
-	movl 12(%esp),%esi
-	movl %ebx,(%esi)
-	movl %edx,4(%esi)
-	movl %ecx,8(%esi)
-	popl %ebx
-	popl %esi
-	ret
-EOF
-	cat <<EOF >${dummy}2.c
-main ()
-{
-  char vendor_string[13];
-  char dummy_string[12];
-  long fms;
-  int family, model;
-  char *modelstr;
-
-  cpuid (vendor_string, 0);
-  vendor_string[12] = 0;
-
-  fms = cpuid (dummy_string, 1);
-
-  family = (fms >> 8) & 15;
-  model = (fms >> 4) & 15;
-
-  modelstr = "i486";
-  if (strcmp (vendor_string, "GenuineIntel") == 0)
-    {
-      switch (family)
-	{
-	case 5:
-	  if (model <= 2)
-	    modelstr = "pentium";
-	  else if (model >= 4)
-	    modelstr = "pentiummmx";
-	  break;
-	case 6:
-	  if (model == 1)
-	    modelstr = "pentiumpro";
-	  else if (model <= 6)
-	    modelstr = "pentium2";
-	  else
-	    modelstr = "pentium3";
-	  break;
-	}
-    }
-  else if (strcmp (vendor_string, "AuthenticAMD") == 0)
-    {
-      switch (family)
-	{
-	case 5:
-	  if (model <= 3)
-	    modelstr = "k5";
-	  else if (model <= 7)
-	    modelstr = "k6";
-	  else if (model <= 8)
-	    modelstr = "k62";
-	  else if (model <= 9)
-	    modelstr = "k63";
-	  break;
-	case 6:
-	  modelstr = "athlon";
-	  break;
-	}
-    }
-  else if (strcmp (vendor_string, "CyrixInstead") == 0)
-    {
-      /* Should recognize Cyrix' processors too.  */
-    }
-
-  printf ("%s\n", modelstr);
-  return 0;
-}
-EOF
-	$CC_FOR_BUILD ${dummy}1.s ${dummy}2.c -o $dummy >/dev/null 2>&1
-	if test "$?" = 0 ; then
-	  X86CPU=`./$dummy`
-	fi
-
-
-	# Default to believing uname -m if the program fails to compile or
-	# run.  Will fail to run on 386 since cpuid was only added on 486.
-	if test -z "$X86CPU"
-	then
-	    X86CPU="$UNAME_MACHINE"
-	fi
-	rm -f ${dummy}1.s ${dummy}2.c $dummy
-  ;;
-esac
-
-# Note: order is significant - the case branches are not exclusive.
-
-case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
-    alpha:OSF1:*:*)
-	if test $UNAME_RELEASE = "V4.0"; then
-		UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'`
-	fi
-	# A Vn.n version is a released version.
-	# A Tn.n version is a released field test version.
-	# A Xn.n version is an unreleased experimental baselevel.
-	# 1.2 uses "1.2" for uname -r.
-	cat <<EOF >$dummy.s
-	.data
-\$Lformat:
-	.byte 37,100,45,37,120,10,0	# "%d-%x\n"
-
-	.text
-	.globl main
-	.align 4
-	.ent main
-main:
-	.frame \$30,16,\$26,0
-	ldgp \$29,0(\$27)
-	.prologue 1
-	.long 0x47e03d80 # implver \$0
-	lda \$2,-1
-	.long 0x47e20c21 # amask \$2,\$1
-	lda \$16,\$Lformat
-	mov \$0,\$17
-	not \$1,\$18
-	jsr \$26,printf
-	ldgp \$29,0(\$26)
-	mov 0,\$16
-	jsr \$26,exit
-	.end main
-EOF
-	$CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null
-	if test "$?" = 0 ; then
-		case `./$dummy` in
-			0-0)
-				UNAME_MACHINE="alpha"
-				;;
-			1-0)
-				UNAME_MACHINE="alphaev5"
-				;;
-			1-1)
-				UNAME_MACHINE="alphaev56"
-				;;
-			1-101)
-				UNAME_MACHINE="alphapca56"
-				;;
-			2-303)
-				UNAME_MACHINE="alphaev6"
-				;;
-			2-307)
-				UNAME_MACHINE="alphaev67"
-				;;
-		esac
-	fi
-	rm -f $dummy.s $dummy
-	echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[VTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'`
-	exit 0 ;;
-    alpha:NetBSD:*:* | alpha:FreeBSD:*:*)
-	cat <<EOF >$dummy.s
-	.globl main
-	.ent main
-main:
-	.frame \$30,0,\$26,0
-	.prologue 0
-	.long 0x47e03d80 # implver $0
-	lda \$2,259
-	.long 0x47e20c21 # amask $2,$1
-	srl \$1,8,\$2
-	sll \$2,2,\$2
-	sll \$0,3,\$0
-	addl \$1,\$0,\$0
-	addl \$2,\$0,\$0
-	ret \$31,(\$26),1
-	.end main
-EOF
-	$CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null
-	if test "$?" = 0 ; then
-		./$dummy
-		case "$?" in
-			7)
-				UNAME_MACHINE="alpha"
-				;;
-			15)
-				UNAME_MACHINE="alphaev5"
-				;;
-			14)
-				UNAME_MACHINE="alphaev56"
-				;;
-			10)
-				UNAME_MACHINE="alphapca56"
-				;;
-			16)
-				UNAME_MACHINE="alphaev6"
-				;;
-		esac
-	fi
-	rm -f $dummy.s $dummy
-	echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM}${UNAME_RELEASE} | sed -e 's/^[VTX]//' -e 's/[-(].*//' | tr [[A-Z]] [[a-z]]`
-	exit 0 ;;
-    Alpha\ *:Windows_NT*:*)
-	# How do we know it's Interix rather than the generic POSIX subsystem?
-	# Should we change UNAME_MACHINE based on the output of uname instead
-	# of the specific Alpha model?
-	echo alpha-pc-interix
-	exit 0 ;;
-    21064:Windows_NT:50:3)
-	echo alpha-dec-winnt3.5
-	exit 0 ;;
-    Amiga*:UNIX_System_V:4.0:*)
-	echo m68k-cbm-sysv4
-	exit 0;;
-    amiga:NetBSD:*:*)
-      echo m68k-cbm-netbsd${UNAME_RELEASE}
-      exit 0 ;;
-    amiga:OpenBSD:*:*)
-	echo m68k-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    *:[Aa]miga[Oo][Ss]:*:*)
-	echo ${UNAME_MACHINE}-unknown-amigaos
-	exit 0 ;;
-    arc64:OpenBSD:*:*)
-	echo mips64el-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    arc:OpenBSD:*:*)
-	echo mipsel-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    hkmips:OpenBSD:*:*)
-	echo mips-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    pmax:OpenBSD:*:*)
-	echo mipsel-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    sgi:OpenBSD:*:*)
-	echo mips-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    wgrisc:OpenBSD:*:*)
-	echo mipsel-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    *:OS/390:*:*)
-	echo i370-ibm-openedition
-	exit 0 ;;
-    arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
-	echo arm-acorn-riscix${UNAME_RELEASE}
-	exit 0;;
-    arm32:NetBSD:*:*)
-	echo arm-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
-	exit 0 ;;
-    SR2?01:HI-UX/MPP:*:*)
-	echo hppa1.1-hitachi-hiuxmpp
-	exit 0;;
-    Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*)
-	# akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE.
-	if test "`(/bin/universe) 2>/dev/null`" = att ; then
-		echo pyramid-pyramid-sysv3
-	else
-		echo pyramid-pyramid-bsd
-	fi
-	exit 0 ;;
-    NILE*:*:*:dcosx)
-	echo pyramid-pyramid-svr4
-	exit 0 ;;
-    sun4H:SunOS:5.*:*)
-	echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
-	exit 0 ;;
-    sun4[md]:SunOS:5.*:*)
-	echo sparcv8-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
-	exit 0 ;;
-    sun4u:SunOS:5.*:*)
-	echo sparcv9-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
-	exit 0 ;;
-    sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
-	echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
-	exit 0 ;;
-    i386:SunOS:5.*:*)
-	echo ${X86CPU}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
-	exit 0 ;;
-    sun4[md]:SunOS:*:*)
-	case "`/usr/bin/arch -k`" in
-	    Series*|S4*)
-		UNAME_RELEASE=`uname -v`
-		;;
-	esac
-	# Japanese Language versions have a version number like `4.1.3-JL'.
-	echo sparcv8-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
-	exit 0 ;;
-    sun4*:SunOS:*:*)
-	case "`/usr/bin/arch -k`" in
-	    Series*|S4*)
-		UNAME_RELEASE=`uname -v`
-		;;
-	esac
-	# Japanese Language versions have a version number like `4.1.3-JL'.
-	echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
-	exit 0 ;;
-    sun3*:SunOS:*:*)
-	echo m68k-sun-sunos${UNAME_RELEASE}
-	exit 0 ;;
-    sun*:*:4.2BSD:*)
-	UNAME_RELEASE=`(head -1 /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null`
-	test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3
-	case "`/bin/arch`" in
-	    sun3)
-		echo m68k-sun-sunos${UNAME_RELEASE}
-		;;
-	    sun4)
-		echo sparc-sun-sunos${UNAME_RELEASE}
-		;;
-	esac
-	exit 0 ;;
-    aushp:SunOS:*:*)
-	echo sparc-auspex-sunos${UNAME_RELEASE}
-	exit 0 ;;
-    atari*:NetBSD:*:*)
-	echo m68k-atari-netbsd${UNAME_RELEASE}
-	exit 0 ;;
-    atari*:OpenBSD:*:*)
-	echo m68k-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    # The situation for MiNT is a little confusing.  The machine name
-    # can be virtually everything (everything which is not
-    # "atarist" or "atariste" at least should have a processor
-    # > m68000).  The system name ranges from "MiNT" over "FreeMiNT"
-    # to the lowercase version "mint" (or "freemint").  Finally
-    # the system name "TOS" denotes a system which is actually not
-    # MiNT.  But MiNT is downward compatible to TOS, so this should
-    # be no problem.
-    atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*)
-        echo m68k-atari-mint${UNAME_RELEASE}
-	exit 0 ;;
-    atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*)
-	echo m68k-atari-mint${UNAME_RELEASE}
-        exit 0 ;;
-    *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*)
-        echo m68k-atari-mint${UNAME_RELEASE}
-	exit 0 ;;
-    milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*)
-        echo m68k-milan-mint${UNAME_RELEASE}
-        exit 0 ;;
-    hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*)
-        echo m68k-hades-mint${UNAME_RELEASE}
-        exit 0 ;;
-    *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*)
-        echo m68k-unknown-mint${UNAME_RELEASE}
-        exit 0 ;;
-    sun3*:NetBSD:*:*)
-	echo m68k-sun-netbsd${UNAME_RELEASE}
-	exit 0 ;;
-    sun3*:OpenBSD:*:*)
-	echo m68k-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    mac68k:NetBSD:*:*)
-	echo m68k-apple-netbsd${UNAME_RELEASE}
-	exit 0 ;;
-    mac68k:OpenBSD:*:*)
-	echo m68k-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    macppc:NetBSD:*:*)
-	echo powerpc-apple-netbsd${UNAME_RELEASE}
-	exit 0 ;;
-    mvme68k:OpenBSD:*:*)
-	echo m68k-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    mvme88k:OpenBSD:*:*)
-	echo m88k-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    powerpc:machten:*:*)
-	echo powerpc-apple-machten${UNAME_RELEASE}
-	exit 0 ;;
-    RISC*:Mach:*:*)
-	echo mips-dec-mach_bsd4.3
-	exit 0 ;;
-    RISC*:ULTRIX:*:*)
-	echo mips-dec-ultrix${UNAME_RELEASE}
-	exit 0 ;;
-    VAX*:ULTRIX*:*:*)
-	echo vax-dec-ultrix${UNAME_RELEASE}
-	exit 0 ;;
-    2020:CLIX:*:* | 2430:CLIX:*:*)
-	echo clipper-intergraph-clix${UNAME_RELEASE}
-	exit 0 ;;
-    mips:*:*:UMIPS | mips:*:*:RISCos)
-	sed 's/^	//' << EOF >$dummy.c
-#ifdef __cplusplus
-#include <stdio.h>  /* for printf() prototype */
-	int main (int argc, char *argv[]) {
-#else
-	int main (argc, argv) int argc; char *argv[]; {
-#endif
-	#if defined (host_mips) && defined (MIPSEB)
-	#if defined (SYSTYPE_SYSV)
-	  printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0);
-	#endif
-	#if defined (SYSTYPE_SVR4)
-	  printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0);
-	#endif
-	#if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD)
-	  printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0);
-	#endif
-	#endif
-	  exit (-1);
-	}
-EOF
-	$CC_FOR_BUILD $dummy.c -o $dummy \
-	  && ./$dummy `echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` \
-	  && rm $dummy.c $dummy && exit 0
-	rm -f $dummy.c $dummy
-	echo mips-mips-riscos${UNAME_RELEASE}
-	exit 0 ;;
-    Night_Hawk:Power_UNIX:*:*)
-	echo powerpc-harris-powerunix
-	exit 0 ;;
-    m88k:CX/UX:7*:*)
-	echo m88k-harris-cxux7
-	exit 0 ;;
-    m88k:*:4*:R4*)
-	echo m88k-motorola-sysv4
-	exit 0 ;;
-    m88k:*:3*:R3*)
-	echo m88k-motorola-sysv3
-	exit 0 ;;
-    AViiON:dgux:*:*)
-        # DG/UX returns AViiON for all architectures
-        UNAME_PROCESSOR=`/usr/bin/uname -p`
-	if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ]
-	then
-	    if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \
-	       [ ${TARGET_BINARY_INTERFACE}x = x ]
-	    then
-		echo m88k-dg-dgux${UNAME_RELEASE}
-	    else
-		echo m88k-dg-dguxbcs${UNAME_RELEASE}
-	    fi
-	else
-	    echo i586-dg-dgux${UNAME_RELEASE}
-	fi
- 	exit 0 ;;
-    M88*:DolphinOS:*:*)	# DolphinOS (SVR3)
-	echo m88k-dolphin-sysv3
-	exit 0 ;;
-    M88*:*:R3*:*)
-	# Delta 88k system running SVR3
-	echo m88k-motorola-sysv3
-	exit 0 ;;
-    XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
-	echo m88k-tektronix-sysv3
-	exit 0 ;;
-    Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
-	echo m68k-tektronix-bsd
-	exit 0 ;;
-    *:IRIX*:*:*)
-	echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
-	exit 0 ;;
-    ????????:AIX?:[12].1:2)   # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
-	echo romp-ibm-aix      # uname -m gives an 8 hex-code CPU id
-	exit 0 ;;              # Note that: echo "'`uname -s`'" gives 'AIX '
-    i?86:AIX:*:*)
-	echo i386-ibm-aix
-	exit 0 ;;
-    *:AIX:2:3)
-	if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
-		sed 's/^		//' << EOF >$dummy.c
-		#include <sys/systemcfg.h>
-
-		main()
-			{
-			if (!__power_pc())
-				exit(1);
-			puts("powerpc-ibm-aix3.2.5");
-			exit(0);
-			}
-EOF
-		$CC_FOR_BUILD $dummy.c -o $dummy && ./$dummy && rm $dummy.c $dummy && exit 0
-		rm -f $dummy.c $dummy
-		echo rs6000-ibm-aix3.2.5
-	elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
-		echo rs6000-ibm-aix3.2.4
-	else
-		echo rs6000-ibm-aix3.2
-	fi
-	exit 0 ;;
-    *:AIX:*:4)
-	sed 's/^	//' << EOF >$dummy.c
-	#include <stdio.h>
-	#include <sys/systemcfg.h>
-	main ()
-	{
-	  if (_system_configuration.architecture == POWER_RS
-	      || _system_configuration.implementation == POWER_601)
-	    puts ("power");
-	  else
-	    {
-	      if (_system_configuration.width == 64)
-		puts ("powerpc64");
-	      else
-		puts ("powerpc");
-	    }
-	  exit (0);
-	}
-EOF
-	$CC_FOR_BUILD $dummy.c -o $dummy
-	IBM_ARCH=`./$dummy`
-	rm -f $dummy.c $dummy
-	if [ -x /usr/bin/oslevel ] ; then
-		IBM_REV=`/usr/bin/oslevel`
-	else
-		IBM_REV=4.${UNAME_RELEASE}
-	fi
-	echo ${IBM_ARCH}-ibm-aix${IBM_REV}
-	exit 0 ;;
-    *:AIX:*:*)
-	echo rs6000-ibm-aix
-	exit 0 ;;
-    ibmrt:4.4BSD:*|romp-ibm:BSD:*)
-	echo romp-ibm-bsd4.4
-	exit 0 ;;
-    ibmrt:*BSD:*|romp-ibm:BSD:*)            # covers RT/PC BSD and
-	echo romp-ibm-bsd${UNAME_RELEASE}   # 4.3 with uname added to
-	exit 0 ;;                           # report: romp-ibm BSD 4.3
-    *:BOSX:*:*)
-	echo rs6000-bull-bosx
-	exit 0 ;;
-    DPX/2?00:B.O.S.:*:*)
-	echo m68k-bull-sysv3
-	exit 0 ;;
-    9000/[34]??:4.3bsd:1.*:*)
-	echo m68k-hp-bsd
-	exit 0 ;;
-    hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
-	echo m68k-hp-bsd4.4
-	exit 0 ;;
-    9000/[34678]??:HP-UX:*:*)
-	case "${UNAME_MACHINE}" in
-	    9000/31? )            HP_ARCH=m68000 ;;
-	    9000/[34]?? )         HP_ARCH=m68k ;;
-	    9000/[678][0-9][0-9])
-              sed 's/^              //' << EOF >$dummy.c
-
-              #define _HPUX_SOURCE
-              #include <stdlib.h>
-              #include <unistd.h>
-
-              int main ()
-              {
-              #if defined(_SC_KERNEL_BITS)
-                  long bits = sysconf(_SC_KERNEL_BITS);
-              #endif
-                  long cpu  = sysconf (_SC_CPU_VERSION);
-
-                  switch (cpu)
-              	{
-              	case CPU_PA_RISC1_0: puts ("hppa1.0"); break;
-              	case CPU_PA_RISC1_1: puts ("hppa1.1"); break;
-              	case CPU_PA_RISC2_0:
-              #if defined(_SC_KERNEL_BITS)
-              	    switch (bits)
-              		{
-              		case 64: puts ("hppa2.0w"); break;
-              		case 32: puts ("hppa2.0n"); break;
-              		default: puts ("hppa2.0"); break;
-              		} break;
-              #else  /* !defined(_SC_KERNEL_BITS) */
-              	    puts ("hppa2.0"); break;
-              #endif
-              	default: puts ("hppa1.0"); break;
-              	}
-                  exit (0);
-              }
-EOF
-	(CCOPTS= $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null ) && HP_ARCH=`./$dummy`
-	rm -f $dummy.c $dummy
-	esac
-	HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
-	echo ${HP_ARCH}-hp-hpux${HPUX_REV}
-	exit 0 ;;
-    3050*:HI-UX:*:*)
-	sed 's/^	//' << EOF >$dummy.c
-	#include <unistd.h>
-	int
-	main ()
-	{
-	  long cpu = sysconf (_SC_CPU_VERSION);
-	  /* The order matters, because CPU_IS_HP_MC68K erroneously returns
-	     true for CPU_PA_RISC1_0.  CPU_IS_PA_RISC returns correct
-	     results, however.  */
-	  if (CPU_IS_PA_RISC (cpu))
-	    {
-	      switch (cpu)
-		{
-		  case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
-		  case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
-		  case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
-		  default: puts ("hppa-hitachi-hiuxwe2"); break;
-		}
-	    }
-	  else if (CPU_IS_HP_MC68K (cpu))
-	    puts ("m68k-hitachi-hiuxwe2");
-	  else puts ("unknown-hitachi-hiuxwe2");
-	  exit (0);
-	}
-EOF
-	$CC_FOR_BUILD $dummy.c -o $dummy && ./$dummy && rm $dummy.c $dummy && exit 0
-	rm -f $dummy.c $dummy
-	echo unknown-hitachi-hiuxwe2
-	exit 0 ;;
-    9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* )
-	echo hppa1.1-hp-bsd
-	exit 0 ;;
-    9000/8??:4.3bsd:*:*)
-	echo hppa1.0-hp-bsd
-	exit 0 ;;
-    *9??*:MPE/iX:*:*)
-	echo hppa1.0-hp-mpeix
-	exit 0 ;;
-    hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* )
-	echo hppa1.1-hp-osf
-	exit 0 ;;
-    hp8??:OSF1:*:*)
-	echo hppa1.0-hp-osf
-	exit 0 ;;
-    i?86:OSF1:*:*)
-	if [ -x /usr/sbin/sysversion ] ; then
-	    echo ${UNAME_MACHINE}-unknown-osf1mk
-	else
-	    echo ${UNAME_MACHINE}-unknown-osf1
-	fi
-	exit 0 ;;
-    parisc*:Lites*:*:*)
-	echo hppa1.1-hp-lites
-	exit 0 ;;
-    hppa*:OpenBSD:*:*)
-	echo hppa-unknown-openbsd
-	exit 0 ;;
-    C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
-	echo c1-convex-bsd
-        exit 0 ;;
-    C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
-	if getsysinfo -f scalar_acc
-	then echo c32-convex-bsd
-	else echo c2-convex-bsd
-	fi
-        exit 0 ;;
-    C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
-	echo c34-convex-bsd
-        exit 0 ;;
-    C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
-	echo c38-convex-bsd
-        exit 0 ;;
-    C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
-	echo c4-convex-bsd
-        exit 0 ;;
-    CRAY*X-MP:*:*:*)
-	echo xmp-cray-unicos
-        exit 0 ;;
-    CRAY*Y-MP:*:*:*)
-	echo ymp-cray-unicos${UNAME_RELEASE}
-	exit 0 ;;
-    CRAY*[A-Z]90:*:*:*)
-	echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \
-	| sed -e 's/CRAY.*\([A-Z]90\)/\1/' \
-	      -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/
-	exit 0 ;;
-    CRAY*TS:*:*:*)
-	echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
-	exit 0 ;;
-    CRAY*T3D:*:*:*)
-	echo alpha-cray-unicos
-	exit 0 ;;
-    CRAY*T3E:*:*:*)
-	echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
-	exit 0 ;;
-    CRAY*SV1:*:*:*)
-	echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/'
-	exit 0 ;;
-    CRAY-2:*:*:*)
-	echo cray2-cray-unicos
-        exit 0 ;;
-    F300:UNIX_System_V:*:*)
-        FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'`
-        FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'`
-        echo "f300-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}"
-        exit 0 ;;
-    F301:UNIX_System_V:*:*)
-       echo f301-fujitsu-uxpv`echo $UNAME_RELEASE | sed 's/ .*//'`
-       exit 0 ;;
-    hp3[0-9][05]:NetBSD:*:*)
-	echo m68k-hp-netbsd${UNAME_RELEASE}
-	exit 0 ;;
-    hp300:OpenBSD:*:*)
-	echo m68k-unknown-openbsd${UNAME_RELEASE}
-	exit 0 ;;
-    i?86:BSD/386:*:* | i?86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*)
-	echo ${X86CPU}-pc-bsdi${UNAME_RELEASE}
-	exit 0 ;;
-    sparc*:BSD/OS:*:*)
-	echo sparc-unknown-bsdi${UNAME_RELEASE}
-	exit 0 ;;
-    *:BSD/OS:*:*)
-	echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
-	exit 0 ;;
-    i386:FreeBSD:*:*)
-	echo ${X86CPU}-pc-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
-	exit 0 ;;
-    *:FreeBSD:*:*)
-	echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
-	exit 0 ;;
-    i386:NetBSD:*:*)
-	echo ${X86CPU}-pc-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
-	exit 0 ;;
-    *:NetBSD:*:*)
-	echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
-	exit 0 ;;
-    i386:OpenBSD:*:*)
-	echo ${X86CPU}-pc-openbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
-	exit 0 ;;
-    *:OpenBSD:*:*)
-	echo ${UNAME_MACHINE}-unknown-openbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
-	exit 0 ;;
-    i*:CYGWIN*:*)
-	echo ${X86CPU}-pc-cygwin
-	exit 0 ;;
-    i*:MINGW*:*)
-	echo ${UNAME_MACHINE}-pc-mingw32
-	exit 0 ;;
-    i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
-	# How do we know it's Interix rather than the generic POSIX subsystem?
-	# It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
-	# UNAME_MACHINE based on the output of uname instead of i386?
-	echo i386-pc-interix
-	exit 0 ;;
-    i*:UWIN*:*)
-	echo ${UNAME_MACHINE}-pc-uwin
-	exit 0 ;;
-    p*:CYGWIN*:*)
-	echo powerpcle-unknown-cygwin
-	exit 0 ;;
-    prep*:SunOS:5.*:*)
-	echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
-	exit 0 ;;
-    *:GNU:*:*)
-	echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
-	exit 0 ;;
-    *:Linux:*:*)
-
-	# The BFD linker knows what the default object file format is, so
-	# first see if it will tell us. cd to the root directory to prevent
-	# problems with other programs or directories called `ld' in the path.
-	ld_help_string=`cd /; ld --help 2>&1`
-	ld_supported_emulations=`echo $ld_help_string \
-			 | sed -ne '/supported emulations:/!d
-				    s/[ 	][ 	]*/ /g
-				    s/.*supported emulations: *//
-				    s/ .*//
-				    p'`
-        case "$ld_supported_emulations" in
-	  *ia64)
-		echo "${UNAME_MACHINE}-unknown-linux"
-		exit 0
-		;;
-	  i?86linux)
-		echo "${X86CPU}-pc-linux-gnuaout"
-		exit 0
-		;;
-	  i?86coff)
-		echo "${X86CPU}-pc-linux-gnucoff"
-		exit 0
-		;;
-	  sparclinux)
-		echo "${UNAME_MACHINE}-unknown-linux-gnuaout"
-		exit 0
-		;;
-	  armlinux)
-		echo "${UNAME_MACHINE}-unknown-linux-gnuaout"
-		exit 0
-		;;
-	  elf32arm*)
-		echo "${UNAME_MACHINE}-unknown-linux-gnuoldld"
-		exit 0
-		;;
-	  armelf_linux*)
-		echo "${UNAME_MACHINE}-unknown-linux-gnu"
-		exit 0
-		;;
-	  m68klinux)
-		echo "${UNAME_MACHINE}-unknown-linux-gnuaout"
-		exit 0
-		;;
-	  elf32ppc | elf32ppclinux)
-		# Determine Lib Version
-		cat >$dummy.c <<EOF
-#include <features.h>
-#if defined(__GLIBC__)
-extern char __libc_version[];
-extern char __libc_release[];
-#endif
-main(argc, argv)
-     int argc;
-     char *argv[];
-{
-#if defined(__GLIBC__)
-  printf("%s %s\n", __libc_version, __libc_release);
-#else
-  printf("unkown\n");
-#endif
-  return 0;
-}
-EOF
-		LIBC=""
-		$CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null
-		if test "$?" = 0 ; then
-			./$dummy | grep 1\.99 > /dev/null
-			if test "$?" = 0 ; then
-				LIBC="libc1"
-			fi
-		fi
-		rm -f $dummy.c $dummy
-		echo powerpc-unknown-linux-gnu${LIBC}
-		exit 0
-		;;
-	esac
-
-	if test "${UNAME_MACHINE}" = "alpha" ; then
-		cat <<EOF >$dummy.s
-			.data
-		\$Lformat:
-			.byte 37,100,45,37,120,10,0	# "%d-%x\n"
-
-			.text
-			.globl main
-			.align 4
-			.ent main
-		main:
-			.frame \$30,16,\$26,0
-			ldgp \$29,0(\$27)
-			.prologue 1
-			.long 0x47e03d80 # implver \$0
-			lda \$2,-1
-			.long 0x47e20c21 # amask \$2,\$1
-			lda \$16,\$Lformat
-			mov \$0,\$17
-			not \$1,\$18
-			jsr \$26,printf
-			ldgp \$29,0(\$26)
-			mov 0,\$16
-			jsr \$26,exit
-			.end main
-EOF
-		LIBC=""
-		$CC_FOR_BUILD $dummy.s -o $dummy 2>/dev/null
-		if test "$?" = 0 ; then
-			case `./$dummy` in
-			0-0)
-				UNAME_MACHINE="alpha"
-				;;
-			1-0)
-				UNAME_MACHINE="alphaev5"
-				;;
-			1-1)
-				UNAME_MACHINE="alphaev56"
-				;;
-			1-101)
-				UNAME_MACHINE="alphapca56"
-				;;
-			2-303)
-				UNAME_MACHINE="alphaev6"
-				;;
-			2-307)
-				UNAME_MACHINE="alphaev67"
-				;;
-			esac
-
-			objdump --private-headers $dummy | \
-			  grep ld.so.1 > /dev/null
-			if test "$?" = 0 ; then
-				LIBC="libc1"
-			fi
-		fi
-		rm -f $dummy.s $dummy
-		echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} ; exit 0
-	elif test "${UNAME_MACHINE}" = "mips" ; then
-	  cat >$dummy.c <<EOF
-#ifdef __cplusplus
-#include <stdio.h>  /* for printf() prototype */
-	int main (int argc, char *argv[]) {
-#else
-	int main (argc, argv) int argc; char *argv[]; {
-#endif
-#ifdef __MIPSEB__
-  printf ("%s-unknown-linux-gnu\n", argv[1]);
-#endif
-#ifdef __MIPSEL__
-  printf ("%sel-unknown-linux-gnu\n", argv[1]);
-#endif
-  return 0;
-}
-EOF
-	  $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy "${UNAME_MACHINE}" && rm $dummy.c $dummy && exit 0
-	  rm -f $dummy.c $dummy
-	elif test "${UNAME_MACHINE}" = "s390"; then
-	  echo s390-ibm-linux && exit 0
-	else
-	  # Either a pre-BFD a.out linker (linux-gnuoldld)
-	  # or one that does not give us useful --help.
-	  # GCC wants to distinguish between linux-gnuoldld and linux-gnuaout.
-	  # If ld does not provide *any* "supported emulations:"
-	  # that means it is gnuoldld.
-	  echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations:"
-	  test $? != 0 && echo "${X86CPU}-pc-linux-gnuoldld" && exit 0
-
-	  case "${UNAME_MACHINE}" in
-	  i?86)
-	    VENDOR=pc;
-	    UNAME_MACHINE=${X86CPU}
-	    ;;
-	  *)
-	    VENDOR=unknown;
-	    ;;
-	  esac
-	  # Determine whether the default compiler is a.out or elf
-	  cat >$dummy.c <<EOF
-#include <features.h>
-#ifdef __cplusplus
-#include <stdio.h>  /* for printf() prototype */
-	int main (int argc, char *argv[]) {
-#else
-	int main (argc, argv) int argc; char *argv[]; {
-#endif
-#ifdef __ELF__
-# ifdef __GLIBC__
-#  if __GLIBC__ >= 2
-    printf ("%s-${VENDOR}-linux-gnu\n", argv[1]);
-#  else
-    printf ("%s-${VENDOR}-linux-gnulibc1\n", argv[1]);
-#  endif
-# else
-   printf ("%s-${VENDOR}-linux-gnulibc1\n", argv[1]);
-# endif
-#else
-  printf ("%s-${VENDOR}-linux-gnuaout\n", argv[1]);
-#endif
-  return 0;
-}
-EOF
-	  $CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy "${UNAME_MACHINE}" && rm $dummy.c $dummy && exit 0
-	  rm -f $dummy.c $dummy
-	fi ;;
-# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.  earlier versions
-# are messed up and put the nodename in both sysname and nodename.
-    i?86:DYNIX/ptx:4*:*)
-	echo i386-sequent-sysv4
-	exit 0 ;;
-    i?86:UNIX_SV:4.2MP:2.*)
-        # Unixware is an offshoot of SVR4, but it has its own version
-        # number series starting with 2...
-        # I am not positive that other SVR4 systems won't match this,
-	# I just have to hope.  -- rms.
-        # Use sysv4.2uw... so that sysv4* matches it.
-	echo ${X86CPU}-pc-sysv4.2uw${UNAME_VERSION}
-	exit 0 ;;
-    i?86:*:4.*:* | i?86:SYSTEM_V:4.*:*)
-	UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'`
-	if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
-		echo ${X86CPU}-univel-sysv${UNAME_REL}
-	else
-		echo ${X86CPU}-pc-sysv${UNAME_REL}
-	fi
-	exit 0 ;;
-    i?86:*:5:7*)
-        # Fixed at (any) Pentium or better
-        UNAME_MACHINE=i586
-        if [ ${UNAME_SYSTEM} = "UnixWare" ] ; then
-	    echo ${X86CPU}-sco-sysv${UNAME_RELEASE}uw${UNAME_VERSION}
-	else
-	    echo ${X86CPU}-pc-sysv${UNAME_RELEASE}
-	fi
-	exit 0 ;;
-    i?86:*:3.2:*)
-	if test -f /usr/options/cb.name; then
-		UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
-		echo ${X86CPU}-pc-isc$UNAME_REL
-	elif /bin/uname -X 2>/dev/null >/dev/null ; then
-		UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')`
-		(/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486
-		(/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \
-			&& UNAME_MACHINE=i586
-		(/bin/uname -X|egrep '^Machine.*Pent ?II' >/dev/null) \
-			&& UNAME_MACHINE=i686
-		(/bin/uname -X|egrep '^Machine.*Pentium Pro' >/dev/null) \
-			&& UNAME_MACHINE=i686
-		echo ${X86CPU}-pc-sco$UNAME_REL
-	else
-		echo ${X86CPU}-pc-sysv32
-	fi
-	exit 0 ;;
-    i?86:*DOS:*:*)
-	echo ${X86CPU}-pc-msdosdjgpp
-	exit 0 ;;
-    pc:*:*:*)
-	# Left here for compatibility:
-        # uname -m prints for DJGPP always 'pc', but it prints nothing about
-        # the processor, so we play safe by assuming i386.
-	echo i386-pc-msdosdjgpp
-        exit 0 ;;
-    Intel:Mach:3*:*)
-	echo i386-pc-mach3
-	exit 0 ;;
-    paragon:*:*:*)
-	echo i860-intel-osf1
-	exit 0 ;;
-    i860:*:4.*:*) # i860-SVR4
-	if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
-	  echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
-	else # Add other i860-SVR4 vendors below as they are discovered.
-	  echo i860-unknown-sysv${UNAME_RELEASE}  # Unknown i860-SVR4
-	fi
-	exit 0 ;;
-    mini*:CTIX:SYS*5:*)
-	# "miniframe"
-	echo m68010-convergent-sysv
-	exit 0 ;;
-    M68*:*:R3V[567]*:*)
-	test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;;
-    3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 4850:*:4.0:3.0)
-	OS_REL=''
-	test -r /etc/.relid \
-	&& OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid`
-	/bin/uname -p 2>/dev/null | grep 86 >/dev/null \
-	  && echo i486-ncr-sysv4.3${OS_REL} && exit 0
-	/bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \
-	  && echo i586-ncr-sysv4.3${OS_REL} && exit 0 ;;
-    3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
-        /bin/uname -p 2>/dev/null | grep 86 >/dev/null \
-          && echo i486-ncr-sysv4 && exit 0 ;;
-    m68*:LynxOS:2.*:*)
-	echo m68k-unknown-lynxos${UNAME_RELEASE}
-	exit 0 ;;
-    mc68030:UNIX_System_V:4.*:*)
-	echo m68k-atari-sysv4
-	exit 0 ;;
-    i?86:LynxOS:2.*:* | i?86:LynxOS:3.[01]*:*)
-	echo i386-unknown-lynxos${UNAME_RELEASE}
-	exit 0 ;;
-    TSUNAMI:LynxOS:2.*:*)
-	echo sparc-unknown-lynxos${UNAME_RELEASE}
-	exit 0 ;;
-    rs6000:LynxOS:2.*:* | PowerPC:LynxOS:2.*:*)
-	echo rs6000-unknown-lynxos${UNAME_RELEASE}
-	exit 0 ;;
-    SM[BE]S:UNIX_SV:*:*)
-	echo mips-dde-sysv${UNAME_RELEASE}
-	exit 0 ;;
-    RM*:ReliantUNIX-*:*:*)
-	echo mips-sni-sysv4
-	exit 0 ;;
-    RM*:SINIX-*:*:*)
-	echo mips-sni-sysv4
-	exit 0 ;;
-    *:SINIX-*:*:*)
-	if uname -p 2>/dev/null >/dev/null ; then
-		UNAME_MACHINE=`(uname -p) 2>/dev/null`
-		echo ${UNAME_MACHINE}-sni-sysv4
-	else
-		echo ns32k-sni-sysv
-	fi
-	exit 0 ;;
-    PENTIUM:CPunix:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort
-                           # says <Richard.M.Bartel@ccMail.Census.GOV>
-        echo i586-unisys-sysv4
-        exit 0 ;;
-    *:UNIX_System_V:4*:FTX*)
-	# From Gerald Hewes <hewes@openmarket.com>.
-	# How about differentiating between stratus architectures? -djm
-	echo hppa1.1-stratus-sysv4
-	exit 0 ;;
-    *:*:*:FTX*)
-	# From seanf@swdc.stratus.com.
-	echo i860-stratus-sysv4
-	exit 0 ;;
-    mc68*:A/UX:*:*)
-	echo m68k-apple-aux${UNAME_RELEASE}
-	exit 0 ;;
-    news*:NEWS-OS:*:6*)
-	echo mips-sony-newsos6
-	exit 0 ;;
-    R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*)
-	if [ -d /usr/nec ]; then
-	        echo mips-nec-sysv${UNAME_RELEASE}
-	else
-	        echo mips-unknown-sysv${UNAME_RELEASE}
-	fi
-        exit 0 ;;
-    BeBox:BeOS:*:*)	# BeOS running on hardware made by Be, PPC only.
-	echo powerpc-be-beos
-	exit 0 ;;
-    BeMac:BeOS:*:*)	# BeOS running on Mac or Mac clone, PPC only.
-	echo powerpc-apple-beos
-	exit 0 ;;
-    BePC:BeOS:*:*)	# BeOS running on Intel PC compatible.
-	echo i586-pc-beos
-	exit 0 ;;
-    SX-4:SUPER-UX:*:*)
-	echo sx4-nec-superux${UNAME_RELEASE}
-	exit 0 ;;
-    SX-5:SUPER-UX:*:*)
-	echo sx5-nec-superux${UNAME_RELEASE}
-	exit 0 ;;
-    Power*:Rhapsody:*:*)
-	echo powerpc-apple-rhapsody${UNAME_RELEASE}
-	exit 0 ;;
-    *:Rhapsody:*:*)
-	echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE}
-	exit 0 ;;
-    Power*:Mac*OS:*:*)
-	echo powerpc-apple-macos${UNAME_RELEASE}
-	exit 0 ;;
-    *:Mac*OS:*:*)
-	echo ${UNAME_MACHINE}-apple-macos${UNAME_RELEASE}
-	exit 0 ;;
-    *:Darwin:*:*)
-	echo `uname -p`-apple-darwin${UNAME_RELEASE}
-	exit 0 ;;
-    *:procnto*:*:* | *:QNX:[0123456789]*:*)
-	if test "${UNAME_MACHINE}" = "x86pc"; then
-		UNAME_MACHINE=pc
-	fi
-	echo `uname -p`-${UNAME_MACHINE}-nto-qnx
-	exit 0 ;;
-    *:QNX:*:4*)
-	echo i386-pc-qnx
-	exit 0 ;;
-    NSR-W:NONSTOP_KERNEL:*:*)
-	echo nsr-tandem-nsk${UNAME_RELEASE}
-	exit 0 ;;
-    BS2000:POSIX*:*:*)
-	echo bs2000-siemens-sysv
-	exit 0 ;;
-esac
-
-#echo '(No uname command or uname output not recognized.)' 1>&2
-#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2
-
-cat >$dummy.c <<EOF
-#ifdef _SEQUENT_
-# include <sys/types.h>
-# include <sys/utsname.h>
-#endif
-main ()
-{
-#if defined (sony)
-#if defined (MIPSEB)
-  /* BFD wants "bsd" instead of "newsos".  Perhaps BFD should be changed,
-     I don't know....  */
-  printf ("mips-sony-bsd\n"); exit (0);
-#else
-#include <sys/param.h>
-  printf ("m68k-sony-newsos%s\n",
-#ifdef NEWSOS4
-          "4"
-#else
-	  ""
-#endif
-         ); exit (0);
-#endif
-#endif
-
-#if defined (__arm) && defined (__acorn) && defined (__unix)
-  printf ("arm-acorn-riscix"); exit (0);
-#endif
-
-#if defined (hp300) && !defined (hpux)
-  printf ("m68k-hp-bsd\n"); exit (0);
-#endif
-
-#if defined (NeXT)
-#if !defined (__ARCHITECTURE__)
-#define __ARCHITECTURE__ "m68k"
-#endif
-  int version;
-  version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
-  if (version < 4)
-    printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version);
-  else
-    printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version);
-  exit (0);
-#endif
-
-#if defined (MULTIMAX) || defined (n16)
-#if defined (UMAXV)
-  printf ("ns32k-encore-sysv\n"); exit (0);
-#else
-#if defined (CMU)
-  printf ("ns32k-encore-mach\n"); exit (0);
-#else
-  printf ("ns32k-encore-bsd\n"); exit (0);
-#endif
-#endif
-#endif
-
-#if defined (__386BSD__)
-  printf ("i386-pc-bsd\n"); exit (0);
-#endif
-
-#if defined (sequent)
-#if defined (i386)
-  printf ("i386-sequent-dynix\n"); exit (0);
-#endif
-#if defined (ns32000)
-  printf ("ns32k-sequent-dynix\n"); exit (0);
-#endif
-#endif
-
-#if defined (_SEQUENT_)
-    struct utsname un;
-
-    uname(&un);
-
-    if (strncmp(un.version, "V2", 2) == 0) {
-	printf ("i386-sequent-ptx2\n"); exit (0);
-    }
-    if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */
-	printf ("i386-sequent-ptx1\n"); exit (0);
-    }
-    printf ("i386-sequent-ptx\n"); exit (0);
-
-#endif
-
-#if defined (vax)
-#if !defined (ultrix)
-  printf ("vax-dec-bsd\n"); exit (0);
-#else
-  printf ("vax-dec-ultrix\n"); exit (0);
-#endif
-#endif
-
-#if defined (alliant) && defined (i860)
-  printf ("i860-alliant-bsd\n"); exit (0);
-#endif
-
-  exit (1);
-}
-EOF
-
-$CC_FOR_BUILD $dummy.c -o $dummy 2>/dev/null && ./$dummy && rm $dummy.c $dummy && exit 0
-rm -f $dummy.c $dummy
-
-# Apollos put the system type in the environment.
-
-test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; }
-
-# Convex versions that predate uname can use getsysinfo(1)
-
-if [ -x /usr/convex/getsysinfo ]
-then
-    case `getsysinfo -f cpu_type` in
-    c1*)
-	echo c1-convex-bsd
-	exit 0 ;;
-    c2*)
-	if getsysinfo -f scalar_acc
-	then echo c32-convex-bsd
-	else echo c2-convex-bsd
-	fi
-	exit 0 ;;
-    c34*)
-	echo c34-convex-bsd
-	exit 0 ;;
-    c38*)
-	echo c38-convex-bsd
-	exit 0 ;;
-    c4*)
-	echo c4-convex-bsd
-	exit 0 ;;
-    esac
-fi
-
-#echo '(Unable to guess system type)' 1>&2
-
-exit 1
diff --git a/ghc/rts/gmp/config.in b/ghc/rts/gmp/config.in
deleted file mode 100644
index 8b2546ef16..0000000000
--- a/ghc/rts/gmp/config.in
+++ /dev/null
@@ -1,162 +0,0 @@
-/* config.in.  Generated automatically from configure.in by autoheader.  */
-/*
-Copyright (C) 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-
-/* Define if a limb is long long. */
-#undef _LONG_LONG_LIMB
-
-/* Define if we have native implementation of function. */
-#undef HAVE_NATIVE_
-#undef HAVE_NATIVE_mpn_add                 
-#undef HAVE_NATIVE_mpn_add_1               
-#undef HAVE_NATIVE_mpn_add_n               
-#undef HAVE_NATIVE_mpn_add_nc              
-#undef HAVE_NATIVE_mpn_addmul_1            
-#undef HAVE_NATIVE_mpn_addmul_1c
-#undef HAVE_NATIVE_mpn_addsub_n            
-#undef HAVE_NATIVE_mpn_addsub_nc
-#undef HAVE_NATIVE_mpn_and_n               
-#undef HAVE_NATIVE_mpn_andn_n              
-#undef HAVE_NATIVE_mpn_bdivmod             
-#undef HAVE_NATIVE_mpn_cmp                 
-#undef HAVE_NATIVE_mpn_com_n               
-#undef HAVE_NATIVE_mpn_copyd               
-#undef HAVE_NATIVE_mpn_copyi               
-#undef HAVE_NATIVE_mpn_divexact_by3c
-#undef HAVE_NATIVE_mpn_divrem              
-#undef HAVE_NATIVE_mpn_divrem_1            
-#undef HAVE_NATIVE_mpn_divrem_1c
-#undef HAVE_NATIVE_mpn_divrem_2            
-#undef HAVE_NATIVE_mpn_divrem_newton       
-#undef HAVE_NATIVE_mpn_divrem_classic      
-#undef HAVE_NATIVE_mpn_dump                
-#undef HAVE_NATIVE_mpn_gcd                 
-#undef HAVE_NATIVE_mpn_gcd_1               
-#undef HAVE_NATIVE_mpn_gcdext              
-#undef HAVE_NATIVE_mpn_get_str             
-#undef HAVE_NATIVE_mpn_hamdist             
-#undef HAVE_NATIVE_mpn_invert_limb
-#undef HAVE_NATIVE_mpn_ior_n               
-#undef HAVE_NATIVE_mpn_iorn_n              
-#undef HAVE_NATIVE_mpn_lshift              
-#undef HAVE_NATIVE_mpn_mod_1               
-#undef HAVE_NATIVE_mpn_mod_1c
-#undef HAVE_NATIVE_mpn_mul                 
-#undef HAVE_NATIVE_mpn_mul_1               
-#undef HAVE_NATIVE_mpn_mul_1c
-#undef HAVE_NATIVE_mpn_mul_basecase        
-#undef HAVE_NATIVE_mpn_mul_n               
-#undef HAVE_NATIVE_mpn_nand_n              
-#undef HAVE_NATIVE_mpn_nior_n              
-#undef HAVE_NATIVE_mpn_perfect_square_p    
-#undef HAVE_NATIVE_mpn_popcount            
-#undef HAVE_NATIVE_mpn_preinv_mod_1        
-#undef HAVE_NATIVE_mpn_random2             
-#undef HAVE_NATIVE_mpn_random              
-#undef HAVE_NATIVE_mpn_rawrandom           
-#undef HAVE_NATIVE_mpn_rshift              
-#undef HAVE_NATIVE_mpn_scan0               
-#undef HAVE_NATIVE_mpn_scan1               
-#undef HAVE_NATIVE_mpn_set_str             
-#undef HAVE_NATIVE_mpn_sqrtrem             
-#undef HAVE_NATIVE_mpn_sqr_basecase        
-#undef HAVE_NATIVE_mpn_sub                 
-#undef HAVE_NATIVE_mpn_sub_1               
-#undef HAVE_NATIVE_mpn_sub_n               
-#undef HAVE_NATIVE_mpn_sub_nc              
-#undef HAVE_NATIVE_mpn_submul_1            
-#undef HAVE_NATIVE_mpn_submul_1c
-#undef HAVE_NATIVE_mpn_udiv_w_sdiv         
-#undef HAVE_NATIVE_mpn_umul_ppmm
-#undef HAVE_NATIVE_mpn_udiv_qrnnd
-#undef HAVE_NATIVE_mpn_xor_n               
-#undef HAVE_NATIVE_mpn_xnor_n              
-
-/* Define to 1 if you have the declaration of `optarg', and to 0 if you don't.
-   */
-#undef HAVE_DECL_OPTARG
-
-/* ./configure --enable-assert option, to enable some ASSERT()s */
-#undef WANT_ASSERT
-
-/* Define if you have the <sys/sysctl.h> header file. */
-#undef HAVE_SYS_SYSCTL_H
-
-/* Define if you have the `strtoul' function. */
-#undef HAVE_STRTOUL
-
-/* Name of package */
-#undef PACKAGE
-
-/* Define if you have the `sysctlbyname' function. */
-#undef HAVE_SYSCTLBYNAME
-
-/* Define if the system has the type `void'. */
-#undef HAVE_VOID
-
-/* Define if you have the `popen' function. */
-#undef HAVE_POPEN
-
-/* ./configure --disable-alloca option, to use stack-alloc.c, not alloca */
-#undef USE_STACK_ALLOC
-
-/* Define if cpp supports the ANSI # stringizing operator. */
-#undef HAVE_STRINGIZE
-
-/* Define if you have the <sys/time.h> header file. */
-#undef HAVE_SYS_TIME_H
-
-/* Define if you have the `sysconf' function. */
-#undef HAVE_SYSCONF
-
-/* Define if you have the `getpagesize' function. */
-#undef HAVE_GETPAGESIZE
-
-/* Define if you have the `processor_info' function. */
-#undef HAVE_PROCESSOR_INFO
-
-/* Version number of package */
-#undef VERSION
-
-/* Define if you have the `getopt_long' function. */
-#undef HAVE_GETOPT_LONG
-
-/* Define if you have the <getopt.h> header file. */
-#undef HAVE_GETOPT_H
-
-/* Define if you have the ANSI C header files. */
-#undef STDC_HEADERS
-
-/* Define if a speed_cyclecounter exists (for the tune programs) */
-#undef HAVE_SPEED_CYCLECOUNTER
-
-/* Define if mpn/tests has calling conventions checking for the CPU */
-#undef HAVE_CALLING_CONVENTIONS
-
-/* ./configure --enable-fft option, to enable FFTs for multiplication */
-#undef WANT_FFT
-
-/* Define if you have the <string.h> header file. */
-#undef HAVE_STRING_H
-
-/* Define if you have the <unistd.h> header file. */
-#undef HAVE_UNISTD_H
diff --git a/ghc/rts/gmp/config.sub b/ghc/rts/gmp/config.sub
deleted file mode 100644
index c4123f28ff..0000000000
--- a/ghc/rts/gmp/config.sub
+++ /dev/null
@@ -1,1273 +0,0 @@
-#! /bin/sh
-# Configuration validation subroutine script, version 1.1.
-#   Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000
-#   Free Software Foundation, Inc.
-#
-# This file is (in principle) common to ALL GNU software.
-# The presence of a machine in this file suggests that SOME GNU software
-# can handle that machine.  It does not imply ALL GNU software can.
-#
-# This file is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
-
-# Written by Per Bothner <bothner@cygnus.com>.
-# Please send patches to <config-patches@gnu.org>.
-#
-# Configuration subroutine to validate and canonicalize a configuration type.
-# Supply the specified configuration type as an argument.
-# If it is invalid, we print an error message on stderr and exit with code 1.
-# Otherwise, we print the canonical config type on stdout and succeed.
-
-# This file is supposed to be the same for all GNU packages
-# and recognize all the CPU types, system types and aliases
-# that are meaningful with *any* GNU software.
-# Each package is responsible for reporting which valid configurations
-# it does not support.  The user should be able to distinguish
-# a failure to support a valid configuration from a meaningless
-# configuration.
-
-# The goal of this file is to map all the various variations of a given
-# machine specification into a single specification in the form:
-#	CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
-# or in some cases, the newer four-part form:
-#	CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM
-# It is wrong to echo any other type of specification.
-
-if [ x$1 = x ]
-then
-	echo Configuration name missing. 1>&2
-	echo "Usage: $0 CPU-MFR-OPSYS" 1>&2
-	echo "or     $0 ALIAS" 1>&2
-	echo where ALIAS is a recognized configuration type. 1>&2
-	exit 1
-fi
-
-# First pass through any local machine types.
-case $1 in
-	*local*)
-		echo $1
-		exit 0
-		;;
-	*)
-	;;
-esac
-
-# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any).
-# Here we must recognize all the valid KERNEL-OS combinations.
-maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
-case $maybe_os in
-  nto-qnx* | linux-gnu*)
-    os=-$maybe_os
-    basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
-    ;;
-  *)
-    basic_machine=`echo $1 | sed 's/-[^-]*$//'`
-    if [ $basic_machine != $1 ]
-    then os=`echo $1 | sed 's/.*-/-/'`
-    else os=; fi
-    ;;
-esac
-
-### Let's recognize common machines as not being operating systems so
-### that things like config.sub decstation-3100 work.  We also
-### recognize some manufacturers as not being operating systems, so we
-### can provide default operating systems below.
-case $os in
-	-sun*os*)
-		# Prevent following clause from handling this invalid input.
-		;;
-	-dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
-	-att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
-	-unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
-	-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
-	-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
-	-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
-	-apple)
-		os=
-		basic_machine=$1
-		;;
-	-sim | -cisco | -oki | -wec | -winbond)
-		os=
-		basic_machine=$1
-		;;
-	-scout)
-		;;
-	-wrs)
-		os=-vxworks
-		basic_machine=$1
-		;;
-	-hiux*)
-		os=-hiuxwe2
-		;;
-	-sco5)
-		os=-sco3.2v5
-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
-		;;
-	-sco4)
-		os=-sco3.2v4
-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
-		;;
-	-sco3.2.[4-9]*)
-		os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
-		;;
-	-sco3.2v[4-9]*)
-		# Don't forget version if it is 3.2v4 or newer.
-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
-		;;
-	-sco*)
-		os=-sco3.2v2
-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
-		;;
-	-udk*)
-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
-		;;
-	-isc)
-		os=-isc2.2
-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
-		;;
-	-clix*)
-		basic_machine=clipper-intergraph
-		;;
-	-isc*)
-		basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'`
-		;;
-	-lynx*)
-		os=-lynxos
-		;;
-	-ptx*)
-		basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
-		;;
-	-windowsnt*)
-		os=`echo $os | sed -e 's/windowsnt/winnt/'`
-		;;
-	-psos*)
-		os=-psos
-		;;
-	-mint | -mint[0-9]*)
-		basic_machine=m68k-atari
-		os=-mint
-		;;
-esac
-
-# Decode aliases for certain CPU-COMPANY combinations.
-case $basic_machine in
-	# Recognize the basic CPU types without company name.
-	# Some are omitted here because they have special meanings below.
-	tahoe | i860 | ia64 | m32r | m68k | m68000 | m88k | ns32k | arc | arm \
-		| arme[lb] | pyramid | mn10200 | mn10300 | tron | a29k \
-		| 580 | i960 | h8300 \
-		| x86 | ppcbe | mipsbe | mipsle | shbe | shle | armbe | armle \
-		| hppa | hppa1.0 | hppa1.1 | hppa2.0 | hppa2.0w | hppa2.0n \
-		| alpha | alphaev[4-8] | alphaev56 | alphapca5[67] \
-		| alphaev6[78] \
-		| we32k | ns16k | clipper | i370 | sh | powerpc | powerpcle \
-		| 1750a | dsp16xx | pdp11 | mips16 | mips64 | mipsel | mips64el \
-		| mips64orion | mips64orionel | mipstx39 | mipstx39el \
-		| mips64vr4300 | mips64vr4300el | mips64vr4100 | mips64vr4100el \
-		| mips64vr5000 | miprs64vr5000el | mcore \
-		| sparc | sparclet | sparclite | sparc64 | sparcv9 | v850 | c4x \
-		| powerpc64 | sparcv8 | supersparc | microsparc | ultrasparc \
-		| thumb | d10v | fr30 | avr)
-		basic_machine=$basic_machine-unknown
-		;;
-	m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | z8k | v70 | h8500 | w65 | pj | pjl)
-		;;
-
-	# We use `pc' rather than `unknown'
-	# because (1) that's what they normally are, and
-	# (2) the word "unknown" tends to confuse beginning users.
-	i[34567]86 | pentium[23] | k[56] | k6[23] | athlon)
-	  basic_machine=$basic_machine-pc
-	  ;;
-	# Object if more than one company name word.
-	*-*-*)
-		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
-		exit 1
-		;;
-	# Recognize the basic CPU types with company name.
-	vax-* | tahoe-* | i[34567]86-* | pentium[23]-* | i860-* | ia64-* | m32r-* | m68k-* | m68000-* \
-	      | m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | arm-* | c[123]* \
-	      | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \
-	      | power-* | none-* | 580-* | cray2-* | h8300-* | h8500-* | i960-* \
-	      | xmp-* | ymp-* \
-	      | x86-* | ppcbe-* | mipsbe-* | mipsle-* | shbe-* | shle-* | armbe-* | armle-* \
-	      | hppa-* | hppa1.0-* | hppa1.1-* | hppa2.0-* | hppa2.0w-* | hppa2.0n-* \
-	      | alpha-* | alphaev[4-8]-* | alphaev56-* | alphapca5[67]-* \
-	      | alphaev6[78]-* \
-	      | we32k-* | cydra-* | ns16k-* | pn-* | np1-* | xps100-* \
-	      | clipper-* | orion-* \
-	      | sparclite-* | pdp11-* | sh-* | powerpc-* | powerpcle-* \
-	      | sparc64-* | sparcv9-* | sparc86x-* | mips16-* | mips64-* | mipsel-* \
-	      | mips64el-* | mips64orion-* | mips64orionel-* \
-	      | mips64vr4100-* | mips64vr4100el-* | mips64vr4300-* | mips64vr4300el-* \
-	      | mipstx39-* | mipstx39el-* | mcore-* \
-	      | f301-* | armv*-* | s390-* | sv1-* | t3e-* \
-	      | m88110-* | m680[01234]0-* | m683?2-* | m68360-* | z8k-* | d10v-* \
-	      | k[56]-* | k6[23]-* | athlon-* | powerpc64-* \
-	      | sparcv8-* | supersparc-* | microsparc-* | ultrasparc-* \
-	      | thumb-* | v850-* | d30v-* | tic30-* | c30-* | fr30-* )
-		;;
-	# Recognize the various machine names and aliases which stand
-	# for a CPU type and a company and sometimes even an OS.
-	3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
-		basic_machine=m68000-att
-		;;
-	3b*)
-		basic_machine=we32k-att
-		;;
-	a29khif)
-		basic_machine=a29k-amd
-		os=-udi
-		;;
-	adobe68k)
-		basic_machine=m68010-adobe
-		os=-scout
-		;;
-	alliant | fx80)
-		basic_machine=fx80-alliant
-		;;
-	altos | altos3068)
-		basic_machine=m68k-altos
-		;;
-	am29k)
-		basic_machine=a29k-none
-		os=-bsd
-		;;
-	amdahl)
-		basic_machine=580-amdahl
-		os=-sysv
-		;;
-	amiga | amiga-*)
-		basic_machine=m68k-cbm
-		;;
-	amigaos | amigados)
-		basic_machine=m68k-cbm
-		os=-amigaos
-		;;
-	amigaunix | amix)
-		basic_machine=m68k-cbm
-		os=-sysv4
-		;;
-	apollo68)
-		basic_machine=m68k-apollo
-		os=-sysv
-		;;
-	apollo68bsd)
-		basic_machine=m68k-apollo
-		os=-bsd
-		;;
-	aux)
-		basic_machine=m68k-apple
-		os=-aux
-		;;
-	balance)
-		basic_machine=ns32k-sequent
-		os=-dynix
-		;;
-	convex-c1)
-		basic_machine=c1-convex
-		os=-bsd
-		;;
-	convex-c2)
-		basic_machine=c2-convex
-		os=-bsd
-		;;
-	convex-c32)
-		basic_machine=c32-convex
-		os=-bsd
-		;;
-	convex-c34)
-		basic_machine=c34-convex
-		os=-bsd
-		;;
-	convex-c38)
-		basic_machine=c38-convex
-		os=-bsd
-		;;
-	cray | ymp)
-		basic_machine=ymp-cray
-		os=-unicos
-		;;
-	cray2)
-		basic_machine=cray2-cray
-		os=-unicos
-		;;
-	[ctj]90-cray)
-		basic_machine=c90-cray
-		os=-unicos
-		;;
-	crds | unos)
-		basic_machine=m68k-crds
-		;;
-	da30 | da30-*)
-		basic_machine=m68k-da30
-		;;
-	decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
-		basic_machine=mips-dec
-		;;
-	delta | 3300 | motorola-3300 | motorola-delta \
-	      | 3300-motorola | delta-motorola)
-		basic_machine=m68k-motorola
-		;;
-	delta88)
-		basic_machine=m88k-motorola
-		os=-sysv3
-		;;
-	dpx20 | dpx20-*)
-		basic_machine=rs6000-bull
-		os=-bosx
-		;;
-	dpx2* | dpx2*-bull)
-		basic_machine=m68k-bull
-		os=-sysv3
-		;;
-	ebmon29k)
-		basic_machine=a29k-amd
-		os=-ebmon
-		;;
-	elxsi)
-		basic_machine=elxsi-elxsi
-		os=-bsd
-		;;
-	encore | umax | mmax)
-		basic_machine=ns32k-encore
-		;;
-	es1800 | OSE68k | ose68k | ose | OSE)
-		basic_machine=m68k-ericsson
-		os=-ose
-		;;
-	fx2800)
-		basic_machine=i860-alliant
-		;;
-	genix)
-		basic_machine=ns32k-ns
-		;;
-	gmicro)
-		basic_machine=tron-gmicro
-		os=-sysv
-		;;
-	h3050r* | hiux*)
-		basic_machine=hppa1.1-hitachi
-		os=-hiuxwe2
-		;;
-	h8300hms)
-		basic_machine=h8300-hitachi
-		os=-hms
-		;;
-	h8300xray)
-		basic_machine=h8300-hitachi
-		os=-xray
-		;;
-	h8500hms)
-		basic_machine=h8500-hitachi
-		os=-hms
-		;;
-	harris)
-		basic_machine=m88k-harris
-		os=-sysv3
-		;;
-	hp300-*)
-		basic_machine=m68k-hp
-		;;
-	hp300bsd)
-		basic_machine=m68k-hp
-		os=-bsd
-		;;
-	hp300hpux)
-		basic_machine=m68k-hp
-		os=-hpux
-		;;
-	hp3k9[0-9][0-9] | hp9[0-9][0-9])
-		basic_machine=hppa1.0-hp
-		;;
-	hp9k2[0-9][0-9] | hp9k31[0-9])
-		basic_machine=m68000-hp
-		;;
-	hp9k3[2-9][0-9])
-		basic_machine=m68k-hp
-		;;
-	hp9k6[0-9][0-9] | hp6[0-9][0-9])
-		basic_machine=hppa1.0-hp
-		;;
-	hp9k7[0-79][0-9] | hp7[0-79][0-9])
-		basic_machine=hppa1.1-hp
-		;;
-	hp9k78[0-9] | hp78[0-9])
-		basic_machine=hppa2.0-hp
-		;;
-	hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893)
-		basic_machine=hppa2.0-hp
-		;;
-	hp9k8[0-9][13679] | hp8[0-9][13679])
-		basic_machine=hppa1.1-hp
-		;;
-	hp9k8[0-9][0-9] | hp8[0-9][0-9])
-		basic_machine=hppa1.0-hp
-		;;
-	hppa-next)
-		os=-nextstep3
-		;;
-	hppaosf)
-		basic_machine=hppa1.1-hp
-		os=-osf
-		;;
-	hppro)
-		basic_machine=hppa1.1-hp
-		os=-proelf
-		;;
-	i370-ibm* | ibm*)
-		basic_machine=i370-ibm
-		;;
-# I'm not sure what "Sysv32" means.  Should this be sysv3.2?
-	i[34567]86v32)
-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
-		os=-sysv32
-		;;
-	i[34567]86v4*)
-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
-		os=-sysv4
-		;;
-	i[34567]86v)
-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
-		os=-sysv
-		;;
-	i[34567]86sol2)
-		basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
-		os=-solaris2
-		;;
-	i386mach)
-		basic_machine=i386-mach
-		os=-mach
-		;;
-	i386-vsta | vsta)
-		basic_machine=i386-unknown
-		os=-vsta
-		;;
-	i386-go32 | go32)
-		basic_machine=i386-unknown
-		os=-go32
-		;;
-	i386-mingw32 | mingw32)
-		basic_machine=i386-unknown
-		os=-mingw32
-		;;
-	iris | iris4d)
-		basic_machine=mips-sgi
-		case $os in
-		    -irix*)
-			;;
-		    *)
-			os=-irix4
-			;;
-		esac
-		;;
-	isi68 | isi)
-		basic_machine=m68k-isi
-		os=-sysv
-		;;
-	macppc*)
-		basic_machine=powerpc-apple
-		;;
-	m88k-omron*)
-		basic_machine=m88k-omron
-		;;
-	magnum | m3230)
-		basic_machine=mips-mips
-		os=-sysv
-		;;
-	merlin)
-		basic_machine=ns32k-utek
-		os=-sysv
-		;;
-	miniframe)
-		basic_machine=m68000-convergent
-		;;
-	*mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*)
-		basic_machine=m68k-atari
-		os=-mint
-		;;
-	mipsel*-linux*)
-		basic_machine=mipsel-unknown
-		os=-linux-gnu
-		;;
-	mips*-linux*)
-		basic_machine=mips-unknown
-		os=-linux-gnu
-		;;
-	mips3*-*)
-		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
-		;;
-	mips3*)
-		basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
-		;;
-	mmix*)
-		basic_machine=mmix-knuth
-		os=-mmixware
-		;;
-	monitor)
-		basic_machine=m68k-rom68k
-		os=-coff
-		;;
-	msdos)
-		basic_machine=i386-unknown
-		os=-msdos
-		;;
-	mvs)
-		basic_machine=i370-ibm
-		os=-mvs
-		;;
-	ncr3000)
-		basic_machine=i486-ncr
-		os=-sysv4
-		;;
-	netbsd386)
-		basic_machine=i386-unknown
-		os=-netbsd
-		;;
-	netwinder)
-		basic_machine=armv4l-rebel
-		os=-linux
-		;;
-	news | news700 | news800 | news900)
-		basic_machine=m68k-sony
-		os=-newsos
-		;;
-	news1000)
-		basic_machine=m68030-sony
-		os=-newsos
-		;;
-	news-3600 | risc-news)
-		basic_machine=mips-sony
-		os=-newsos
-		;;
-	necv70)
-		basic_machine=v70-nec
-		os=-sysv
-		;;
-	next | m*-next )
-		basic_machine=m68k-next
-		case $os in
-		    -nextstep* )
-			;;
-		    -ns2*)
-		      os=-nextstep2
-			;;
-		    *)
-		      os=-nextstep3
-			;;
-		esac
-		;;
-	nh3000)
-		basic_machine=m68k-harris
-		os=-cxux
-		;;
-	nh[45]000)
-		basic_machine=m88k-harris
-		os=-cxux
-		;;
-	nindy960)
-		basic_machine=i960-intel
-		os=-nindy
-		;;
-	mon960)
-		basic_machine=i960-intel
-		os=-mon960
-		;;
-	np1)
-		basic_machine=np1-gould
-		;;
-	nsr-tandem)
-		basic_machine=nsr-tandem
-		;;
-	op50n-* | op60c-*)
-		basic_machine=hppa1.1-oki
-		os=-proelf
-		;;
-	OSE68000 | ose68000)
-		basic_machine=m68000-ericsson
-		os=-ose
-		;;
-	os68k)
-		basic_machine=m68k-none
-		os=-os68k
-		;;
-	pa-hitachi)
-		basic_machine=hppa1.1-hitachi
-		os=-hiuxwe2
-		;;
-	paragon)
-		basic_machine=i860-intel
-		os=-osf
-		;;
-	pbd)
-		basic_machine=sparc-tti
-		;;
-	pbb)
-		basic_machine=m68k-tti
-		;;
-        pc532 | pc532-*)
-		basic_machine=ns32k-pc532
-		;;
-	pentiummmx | p55)
-		basic_machine=pentiummmx-pc
-		;;
-	pentium | p5 | i586)
-		basic_machine=pentium-pc
-		;;
-	pentiumpro | p6)
-		basic_machine=pentiumpro-pc
-		;;
-	pentiummmx-* | p55-*)
-		basic_machine=pentiummmx-`echo $basic_machine | sed 's/^[^-]*-//'`
-		;;
-	pentium-* | p5-* | i586-*)
-		basic_machine=pentium-`echo $basic_machine | sed 's/^[^-]*-//'`
-		;;
-	pentiumpro-* | p6-*)
-		basic_machine=pentiumpro-`echo $basic_machine | sed 's/^[^-]*-//'`
-		;;
-	nexen)
-		# We don't have specific support for Nexgen yet, so just call it a Pentium
-		basic_machine=i586-nexgen
-		;;
-	pn)
-		basic_machine=pn-gould
-		;;
-	power)	basic_machine=rs6000-ibm
-		;;
-	ppc)	basic_machine=powerpc-unknown
-	        ;;
-	ppc-*)	basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
-		;;
-	ppc64)	basic_machine=powerpc64-unknown
-	        ;;
-	ppc64-*)
-		basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`
-		;;
-	ppcle | powerpclittle | ppc-le | powerpc-little)
-		basic_machine=powerpcle-unknown
-	        ;;
-	ppcle-* | powerpclittle-*)
-		basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`
-		;;
-	ps2)
-		basic_machine=i386-ibm
-		;;
-	rom68k)
-		basic_machine=m68k-rom68k
-		os=-coff
-		;;
-	rm[46]00)
-		basic_machine=mips-siemens
-		;;
-	rtpc | rtpc-*)
-		basic_machine=romp-ibm
-		;;
-	sa29200)
-		basic_machine=a29k-amd
-		os=-udi
-		;;
-	sequent)
-		basic_machine=i386-sequent
-		;;
-	sh)
-		basic_machine=sh-hitachi
-		os=-hms
-		;;
-	sparclite-wrs)
-		basic_machine=sparclite-wrs
-		os=-vxworks
-		;;
-	sps7)
-		basic_machine=m68k-bull
-		os=-sysv2
-		;;
-	spur)
-		basic_machine=spur-unknown
-		;;
-	st2000)
-		basic_machine=m68k-tandem
-		;;
-	stratus)
-		basic_machine=i860-stratus
-		os=-sysv4
-		;;
-	sun2)
-		basic_machine=m68000-sun
-		;;
-	sun2os3)
-		basic_machine=m68000-sun
-		os=-sunos3
-		;;
-	sun2os4)
-		basic_machine=m68000-sun
-		os=-sunos4
-		;;
-	sun3os3)
-		basic_machine=m68k-sun
-		os=-sunos3
-		;;
-	sun3os4)
-		basic_machine=m68k-sun
-		os=-sunos4
-		;;
-	sun4os3)
-		basic_machine=sparc-sun
-		os=-sunos3
-		;;
-	sun4os4)
-		basic_machine=sparc-sun
-		os=-sunos4
-		;;
-	sun4sol2)
-		basic_machine=sparc-sun
-		os=-solaris2
-		;;
-	sun3 | sun3-*)
-		basic_machine=m68k-sun
-		;;
-	sun4)
-		basic_machine=sparc-sun
-		;;
-	sun386 | sun386i | roadrunner)
-		basic_machine=i386-sun
-		;;
-	sv1)
-		basic_machine=sv1-cray
-		os=-unicos
-		;;
-	symmetry)
-		basic_machine=i386-sequent
-		os=-dynix
-		;;
-	t3e)
-		basic_machine=t3e-cray
-		os=-unicos
-		;;
-	tx39)
-		basic_machine=mipstx39-unknown
-		;;
-	tx39el)
-		basic_machine=mipstx39el-unknown
-		;;
-	tower | tower-32)
-		basic_machine=m68k-ncr
-		;;
-	udi29k)
-		basic_machine=a29k-amd
-		os=-udi
-		;;
-	ultra3)
-		basic_machine=a29k-nyu
-		os=-sym1
-		;;
-	v810 | necv810)
-		basic_machine=v810-nec
-		os=-none
-		;;
-	vaxv)
-		basic_machine=vax-dec
-		os=-sysv
-		;;
-	vms)
-		basic_machine=vax-dec
-		os=-vms
-		;;
-	vpp*|vx|vx-*)
-               basic_machine=f301-fujitsu
-               ;;
-	vxworks960)
-		basic_machine=i960-wrs
-		os=-vxworks
-		;;
-	vxworks68)
-		basic_machine=m68k-wrs
-		os=-vxworks
-		;;
-	vxworks29k)
-		basic_machine=a29k-wrs
-		os=-vxworks
-		;;
-	w65*)
-		basic_machine=w65-wdc
-		os=-none
-		;;
-	w89k-*)
-		basic_machine=hppa1.1-winbond
-		os=-proelf
-		;;
-	xmp)
-		basic_machine=xmp-cray
-		os=-unicos
-		;;
-        xps | xps100)
-		basic_machine=xps100-honeywell
-		;;
-	z8k-*-coff)
-		basic_machine=z8k-unknown
-		os=-sim
-		;;
-	none)
-		basic_machine=none-none
-		os=-none
-		;;
-
-# Here we handle the default manufacturer of certain CPU types.  It is in
-# some cases the only manufacturer, in others, it is the most popular.
-	w89k)
-		basic_machine=hppa1.1-winbond
-		;;
-	op50n)
-		basic_machine=hppa1.1-oki
-		;;
-	op60c)
-		basic_machine=hppa1.1-oki
-		;;
-	mips)
-		if [ x$os = x-linux-gnu ]; then
-			basic_machine=mips-unknown
-		else
-			basic_machine=mips-mips
-		fi
-		;;
-	romp)
-		basic_machine=romp-ibm
-		;;
-	rs6000)
-		basic_machine=rs6000-ibm
-		;;
-	vax)
-		basic_machine=vax-dec
-		;;
-	pdp11)
-		basic_machine=pdp11-dec
-		;;
-	we32k)
-		basic_machine=we32k-att
-		;;
-	sparc | sparcv9)
-		basic_machine=sparc-sun
-		;;
-        cydra)
-		basic_machine=cydra-cydrome
-		;;
-	orion)
-		basic_machine=orion-highlevel
-		;;
-	orion105)
-		basic_machine=clipper-highlevel
-		;;
-	mac | mpw | mac-mpw)
-		basic_machine=m68k-apple
-		;;
-	pmac | pmac-mpw)
-		basic_machine=powerpc-apple
-		;;
-	c4x*)
-		basic_machine=c4x-none
-		os=-coff
-		;;
-	*)
-		echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
-		exit 1
-		;;
-esac
-
-# Here we canonicalize certain aliases for manufacturers.
-case $basic_machine in
-	*-digital*)
-		basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`
-		;;
-	*-commodore*)
-		basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`
-		;;
-	*)
-		;;
-esac
-
-# Decode manufacturer-specific aliases for certain operating systems.
-
-if [ x"$os" != x"" ]
-then
-case $os in
-        # First match some system type aliases
-        # that might get confused with valid system types.
-	# -solaris* is a basic system type, with this one exception.
-	-solaris1 | -solaris1.*)
-		os=`echo $os | sed -e 's|solaris1|sunos4|'`
-		;;
-	-solaris)
-		os=-solaris2
-		;;
-	-svr4*)
-		os=-sysv4
-		;;
-	-unixware*)
-		os=-sysv4.2uw
-		;;
-	-gnu/linux*)
-		os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
-		;;
-	# First accept the basic system types.
-	# The portable systems comes first.
-	# Each alternative MUST END IN A *, to match a version number.
-	# -sysv* is not here because it comes later, after sysvr4.
-	-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
-	      | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\
-	      | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
-	      | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
-	      | -aos* \
-	      | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
-	      | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
-	      | -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \
-	      | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
-	      | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
-	      | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
-	      | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
-	      | -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \
-	      | -interix* | -uwin* | -rhapsody* | -darwin* | -opened* \
-	      | -openstep* | -oskit*)
-	# Remember, each alternative MUST END IN *, to match a version number.
-		;;
-	-qnx*)
-		case $basic_machine in
-		    x86-* | i[34567]86-*)
-			;;
-		    *)
-			os=-nto$os
-			;;
-		esac
-		;;
-	-nto*)
-		os=-nto-qnx
-		;;
-	-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
-	      | -windows* | -osx | -abug | -netware* | -os9* | -beos* \
-	      | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
-		;;
-	-mac*)
-		os=`echo $os | sed -e 's|mac|macos|'`
-		;;
-	-linux*)
-		os=`echo $os | sed -e 's|linux|linux-gnu|'`
-		;;
-	-sunos5*)
-		os=`echo $os | sed -e 's|sunos5|solaris2|'`
-		;;
-	-sunos6*)
-		os=`echo $os | sed -e 's|sunos6|solaris3|'`
-		;;
-	-opened*)
-		os=-openedition
-		;;
-	-wince*)
-		os=-wince
-		;;
-	-osfrose*)
-		os=-osfrose
-		;;
-	-osf*)
-		os=-osf
-		;;
-	-utek*)
-		os=-bsd
-		;;
-	-dynix*)
-		os=-bsd
-		;;
-	-acis*)
-		os=-aos
-		;;
-	-386bsd)
-		os=-bsd
-		;;
-	-ctix* | -uts*)
-		os=-sysv
-		;;
-	-ns2 )
-	        os=-nextstep2
-		;;
-	-nsk)
-		os=-nsk
-		;;
-	# Preserve the version number of sinix5.
-	-sinix5.*)
-		os=`echo $os | sed -e 's|sinix|sysv|'`
-		;;
-	-sinix*)
-		os=-sysv4
-		;;
-	-triton*)
-		os=-sysv3
-		;;
-	-oss*)
-		os=-sysv3
-		;;
-	-svr4)
-		os=-sysv4
-		;;
-	-svr3)
-		os=-sysv3
-		;;
-	-sysvr4)
-		os=-sysv4
-		;;
-	# This must come after -sysvr4.
-	-sysv*)
-		;;
-	-ose*)
-		os=-ose
-		;;
-	-es1800*)
-		os=-ose
-		;;
-	-xenix)
-		os=-xenix
-		;;
-        -*mint | -*MiNT)
-	        os=-mint
-		;;
-	-none)
-		;;
-	*)
-		# Get rid of the `-' at the beginning of $os.
-		os=`echo $os | sed 's/[^-]*-//'`
-		echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2
-		exit 1
-		;;
-esac
-else
-
-# Here we handle the default operating systems that come with various machines.
-# The value should be what the vendor currently ships out the door with their
-# machine or put another way, the most popular os provided with the machine.
-
-# Note that if you're going to try to match "-MANUFACTURER" here (say,
-# "-sun"), then you have to tell the case statement up towards the top
-# that MANUFACTURER isn't an operating system.  Otherwise, code above
-# will signal an error saying that MANUFACTURER isn't an operating
-# system, and we'll never get to this point.
-
-case $basic_machine in
-	*-acorn)
-		os=-riscix1.2
-		;;
-	arm*-rebel)
-		os=-linux
-		;;
-	arm*-semi)
-		os=-aout
-		;;
-        pdp11-*)
-		os=-none
-		;;
-	*-dec | vax-*)
-		os=-ultrix4.2
-		;;
-	m68*-apollo)
-		os=-domain
-		;;
-	i386-sun)
-		os=-sunos4.0.2
-		;;
-	m68000-sun)
-		os=-sunos3
-		# This also exists in the configure program, but was not the
-		# default.
-		# os=-sunos4
-		;;
-	m68*-cisco)
-		os=-aout
-		;;
-	mips*-cisco)
-		os=-elf
-		;;
-	mips*-*)
-		os=-elf
-		;;
-	*-tti)	# must be before sparc entry or we get the wrong os.
-		os=-sysv3
-		;;
-	sparc-* | *-sun)
-		os=-sunos4.1.1
-		;;
-	*-be)
-		os=-beos
-		;;
-	*-ibm)
-		os=-aix
-		;;
-	*-wec)
-		os=-proelf
-		;;
-	*-winbond)
-		os=-proelf
-		;;
-	*-oki)
-		os=-proelf
-		;;
-	*-hp)
-		os=-hpux
-		;;
-	*-hitachi)
-		os=-hiux
-		;;
-	i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
-		os=-sysv
-		;;
-	*-cbm)
-		os=-amigaos
-		;;
-	*-dg)
-		os=-dgux
-		;;
-	*-dolphin)
-		os=-sysv3
-		;;
-	m68k-ccur)
-		os=-rtu
-		;;
-	m88k-omron*)
-		os=-luna
-		;;
-	*-next )
-		os=-nextstep
-		;;
-	*-sequent)
-		os=-ptx
-		;;
-	*-crds)
-		os=-unos
-		;;
-	*-ns)
-		os=-genix
-		;;
-	i370-*)
-		os=-mvs
-		;;
-	*-next)
-		os=-nextstep3
-		;;
-        *-gould)
-		os=-sysv
-		;;
-        *-highlevel)
-		os=-bsd
-		;;
-	*-encore)
-		os=-bsd
-		;;
-        *-sgi)
-		os=-irix
-		;;
-        *-siemens)
-		os=-sysv4
-		;;
-	*-masscomp)
-		os=-rtu
-		;;
-	f301-fujitsu)
-		os=-uxpv
-		;;
-	*-rom68k)
-		os=-coff
-		;;
-	*-*bug)
-		os=-coff
-		;;
-	*-apple)
-		os=-macos
-		;;
-	*-atari*)
-		os=-mint
-		;;
-	*)
-		os=-none
-		;;
-esac
-fi
-
-# Here we handle the case where we know the os, and the CPU type, but not the
-# manufacturer.  We pick the logical manufacturer.
-vendor=unknown
-case $basic_machine in
-	*-unknown)
-		case $os in
-			-riscix*)
-				vendor=acorn
-				;;
-			-sunos*)
-				vendor=sun
-				;;
-			-aix*)
-				vendor=ibm
-				;;
-			-beos*)
-				vendor=be
-				;;
-			-hpux*)
-				vendor=hp
-				;;
-			-mpeix*)
-				vendor=hp
-				;;
-			-hiux*)
-				vendor=hitachi
-				;;
-			-unos*)
-				vendor=crds
-				;;
-			-dgux*)
-				vendor=dg
-				;;
-			-luna*)
-				vendor=omron
-				;;
-			-genix*)
-				vendor=ns
-				;;
-			-mvs* | -opened*)
-				vendor=ibm
-				;;
-			-ptx*)
-				vendor=sequent
-				;;
-			-vxsim* | -vxworks*)
-				vendor=wrs
-				;;
-			-aux*)
-				vendor=apple
-				;;
-			-hms*)
-				vendor=hitachi
-				;;
-			-mpw* | -macos*)
-				vendor=apple
-				;;
-			-*mint | -*MiNT)
-				vendor=atari
-				;;
-		esac
-		basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
-		;;
-esac
-
-echo $basic_machine$os
diff --git a/ghc/rts/gmp/configure b/ghc/rts/gmp/configure
deleted file mode 100644
index 8294680486..0000000000
--- a/ghc/rts/gmp/configure
+++ /dev/null
@@ -1,5216 +0,0 @@
-#! /bin/sh
-# From configure.in Revision: 1.129.2.2
-# Guess values for system-dependent variables and create Makefiles.
-# Generated automatically using Autoconf version 2.14a.
-# Copyright (C) 1992, 93, 94, 95, 96, 98, 99, 2000
-# Free Software Foundation, Inc.
-#
-# This configure script is free software; the Free Software Foundation
-# gives unlimited permission to copy, distribute and modify it.
-
-# Defaults:
-ac_default_prefix=/usr/local
-# Any additions from configure.in:
-
-# Initialize some variables set by options.
-ac_init_help=false
-ac_init_version=false
-# The variables have the same names as the options, with
-# dashes changed to underlines.
-build=NONE
-cache_file=./config.cache
-exec_prefix=NONE
-host=NONE
-no_create=
-nonopt=NONE
-no_recursion=
-prefix=NONE
-program_prefix=NONE
-program_suffix=NONE
-program_transform_name=s,x,x,
-silent=
-site=
-srcdir=
-target=NONE
-verbose=
-x_includes=NONE
-x_libraries=NONE
-bindir='${exec_prefix}/bin'
-sbindir='${exec_prefix}/sbin'
-libexecdir='${exec_prefix}/libexec'
-datadir='${prefix}/share'
-sysconfdir='${prefix}/etc'
-sharedstatedir='${prefix}/com'
-localstatedir='${prefix}/var'
-libdir='${exec_prefix}/lib'
-includedir='${prefix}/include'
-oldincludedir='/usr/include'
-infodir='${prefix}/info'
-mandir='${prefix}/man'
-
-# Initialize some other variables.
-subdirs=
-MFLAGS= MAKEFLAGS=
-SHELL=${CONFIG_SHELL-/bin/sh}
-# Maximum number of lines to put in a shell here document.
-: ${ac_max_here_lines=48}
-# Sed expression to map a string onto a valid sh and CPP variable names.
-ac_tr_sh='sed -e y%*+%pp%;s%[^a-zA-Z0-9_]%_%g'
-ac_tr_cpp='sed -e y%*abcdefghijklmnopqrstuvwxyz%PABCDEFGHIJKLMNOPQRSTUVWXYZ%;s%[^A-Z0-9_]%_%g'
-
-ac_prev=
-for ac_option
-do
-  # If the previous option needs an argument, assign it.
-  if test -n "$ac_prev"; then
-    eval "$ac_prev=\$ac_option"
-    ac_prev=
-    continue
-  fi
-
-  ac_optarg=`echo "$ac_option" | sed -n 's/^[^=]*=//p'`
-
-  # Accept the important Cygnus configure options, so we can diagnose typos.
-
-  case "$ac_option" in
-
-  -bindir | --bindir | --bindi | --bind | --bin | --bi)
-    ac_prev=bindir ;;
-  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
-    bindir="$ac_optarg" ;;
-
-  -build | --build | --buil | --bui | --bu)
-    ac_prev=build ;;
-  -build=* | --build=* | --buil=* | --bui=* | --bu=*)
-    build="$ac_optarg" ;;
-
-  -cache-file | --cache-file | --cache-fil | --cache-fi \
-  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
-    ac_prev=cache_file ;;
-  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
-  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
-    cache_file="$ac_optarg" ;;
-
-  -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
-    ac_prev=datadir ;;
-  -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
-  | --da=*)
-    datadir="$ac_optarg" ;;
-
-  -disable-* | --disable-*)
-    ac_feature=`echo "$ac_option"|sed -e 's/-*disable-//'`
-    # Reject names that are not valid shell variable names.
-    if echo "$ac_feature" | grep '[^-a-zA-Z0-9_]' >/dev/null 2>&1; then
-      { echo "configure: error: invalid feature: $ac_feature" 1>&2; exit 1; }
-    fi
-    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
-    eval "enable_${ac_feature}=no" ;;
-
-  -enable-* | --enable-*)
-    ac_feature=`echo "$ac_option"|sed -e 's/-*enable-//' -e 's/=.*//'`
-    # Reject names that are not valid shell variable names.
-    if echo "$ac_feature" | grep '[^-a-zA-Z0-9_]' >/dev/null 2>&1; then
-      { echo "configure: error: invalid feature: $ac_feature" 1>&2; exit 1; }
-    fi
-    ac_feature=`echo $ac_feature| sed 's/-/_/g'`
-    case "$ac_option" in
-      *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
-      *) ac_optarg=yes ;;
-    esac
-    eval "enable_${ac_feature}='$ac_optarg'" ;;
-
-  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
-  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
-  | --exec | --exe | --ex)
-    ac_prev=exec_prefix ;;
-  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
-  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
-  | --exec=* | --exe=* | --ex=*)
-    exec_prefix="$ac_optarg" ;;
-
-  -gas | --gas | --ga | --g)
-    # Obsolete; use --with-gas.
-    with_gas=yes ;;
-
-  -help | --help | --hel | --he | -h)
-    ac_init_help=: ;;
-  -host | --host | --hos | --ho)
-    ac_prev=host ;;
-  -host=* | --host=* | --hos=* | --ho=*)
-    host="$ac_optarg" ;;
-
-  -includedir | --includedir | --includedi | --included | --include \
-  | --includ | --inclu | --incl | --inc)
-    ac_prev=includedir ;;
-  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
-  | --includ=* | --inclu=* | --incl=* | --inc=*)
-    includedir="$ac_optarg" ;;
-
-  -infodir | --infodir | --infodi | --infod | --info | --inf)
-    ac_prev=infodir ;;
-  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
-    infodir="$ac_optarg" ;;
-
-  -libdir | --libdir | --libdi | --libd)
-    ac_prev=libdir ;;
-  -libdir=* | --libdir=* | --libdi=* | --libd=*)
-    libdir="$ac_optarg" ;;
-
-  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
-  | --libexe | --libex | --libe)
-    ac_prev=libexecdir ;;
-  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
-  | --libexe=* | --libex=* | --libe=*)
-    libexecdir="$ac_optarg" ;;
-
-  -localstatedir | --localstatedir | --localstatedi | --localstated \
-  | --localstate | --localstat | --localsta | --localst \
-  | --locals | --local | --loca | --loc | --lo)
-    ac_prev=localstatedir ;;
-  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
-  | --localstate=* | --localstat=* | --localsta=* | --localst=* \
-  | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
-    localstatedir="$ac_optarg" ;;
-
-  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
-    ac_prev=mandir ;;
-  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
-    mandir="$ac_optarg" ;;
-
-  -nfp | --nfp | --nf)
-    # Obsolete; use --without-fp.
-    with_fp=no ;;
-
-  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
-  | --no-cr | --no-c)
-    no_create=yes ;;
-
-  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
-  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
-    no_recursion=yes ;;
-
-  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
-  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
-  | --oldin | --oldi | --old | --ol | --o)
-    ac_prev=oldincludedir ;;
-  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
-  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
-  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
-    oldincludedir="$ac_optarg" ;;
-
-  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
-    ac_prev=prefix ;;
-  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
-    prefix="$ac_optarg" ;;
-
-  -program-prefix | --program-prefix | --program-prefi | --program-pref \
-  | --program-pre | --program-pr | --program-p)
-    ac_prev=program_prefix ;;
-  -program-prefix=* | --program-prefix=* | --program-prefi=* \
-  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
-    program_prefix="$ac_optarg" ;;
-
-  -program-suffix | --program-suffix | --program-suffi | --program-suff \
-  | --program-suf | --program-su | --program-s)
-    ac_prev=program_suffix ;;
-  -program-suffix=* | --program-suffix=* | --program-suffi=* \
-  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
-    program_suffix="$ac_optarg" ;;
-
-  -program-transform-name | --program-transform-name \
-  | --program-transform-nam | --program-transform-na \
-  | --program-transform-n | --program-transform- \
-  | --program-transform | --program-transfor \
-  | --program-transfo | --program-transf \
-  | --program-trans | --program-tran \
-  | --progr-tra | --program-tr | --program-t)
-    ac_prev=program_transform_name ;;
-  -program-transform-name=* | --program-transform-name=* \
-  | --program-transform-nam=* | --program-transform-na=* \
-  | --program-transform-n=* | --program-transform-=* \
-  | --program-transform=* | --program-transfor=* \
-  | --program-transfo=* | --program-transf=* \
-  | --program-trans=* | --program-tran=* \
-  | --progr-tra=* | --program-tr=* | --program-t=*)
-    program_transform_name="$ac_optarg" ;;
-
-  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
-  | -silent | --silent | --silen | --sile | --sil)
-    silent=yes ;;
-
-  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
-    ac_prev=sbindir ;;
-  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
-  | --sbi=* | --sb=*)
-    sbindir="$ac_optarg" ;;
-
-  -sharedstatedir | --sharedstatedir | --sharedstatedi \
-  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
-  | --sharedst | --shareds | --shared | --share | --shar \
-  | --sha | --sh)
-    ac_prev=sharedstatedir ;;
-  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
-  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
-  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
-  | --sha=* | --sh=*)
-    sharedstatedir="$ac_optarg" ;;
-
-  -site | --site | --sit)
-    ac_prev=site ;;
-  -site=* | --site=* | --sit=*)
-    site="$ac_optarg" ;;
-
-  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
-    ac_prev=srcdir ;;
-  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
-    srcdir="$ac_optarg" ;;
-
-  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
-  | --syscon | --sysco | --sysc | --sys | --sy)
-    ac_prev=sysconfdir ;;
-  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
-  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
-    sysconfdir="$ac_optarg" ;;
-
-  -target | --target | --targe | --targ | --tar | --ta | --t)
-    ac_prev=target ;;
-  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
-    target="$ac_optarg" ;;
-
-  -v | -verbose | --verbose | --verbos | --verbo | --verb)
-    verbose=yes ;;
-
-  -version | --version | --versio | --versi | --vers | -V)
-    ac_init_version=: ;;
-
-  -with-* | --with-*)
-    ac_package=`echo "$ac_option"|sed -e 's/-*with-//' -e 's/=.*//'`
-    # Reject names that are not valid shell variable names.
-    if echo "$ac_package" | grep '[^-a-zA-Z0-9_]' >/dev/null 2>&1; then
-      { echo "configure: error: invalid package: $ac_package" 1>&2; exit 1; }
-    fi
-    ac_package=`echo $ac_package| sed 's/-/_/g'`
-    case "$ac_option" in
-      *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
-      *) ac_optarg=yes ;;
-    esac
-    eval "with_${ac_package}='$ac_optarg'" ;;
-
-  -without-* | --without-*)
-    ac_package=`echo "$ac_option"|sed -e 's/-*without-//'`
-    # Reject names that are not valid shell variable names.
-    if echo "$ac_package" | grep '[^-a-zA-Z0-9_]' >/dev/null 2>&1; then
-      { echo "configure: error: invalid package: $ac_package" 1>&2; exit 1; }
-    fi
-    ac_package=`echo $ac_package| sed 's/-/_/g'`
-    eval "with_${ac_package}=no" ;;
-
-  --x)
-    # Obsolete; use --with-x.
-    with_x=yes ;;
-
-  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
-  | --x-incl | --x-inc | --x-in | --x-i)
-    ac_prev=x_includes ;;
-  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
-  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
-    x_includes="$ac_optarg" ;;
-
-  -x-libraries | --x-libraries | --x-librarie | --x-librari \
-  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
-    ac_prev=x_libraries ;;
-  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
-  | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
-    x_libraries="$ac_optarg" ;;
-
-  -*) { echo "configure: error: unrecognized option: $ac_option
-Try \`configure --help' for more information." 1>&2; exit 1; }
-    ;;
-
-  *=*)
-    ac_envvar=`echo "$ac_option" | sed -e 's/=.*//'`
-    # Reject names that are not valid shell variable names.
-    if echo "$ac_envvar" | grep '[^a-zA-Z0-9_]' >/dev/null 2>&1; then
-      { echo "configure: error: invalid variable name: $ac_envvar" 1>&2; exit 1; }
-    fi
-    ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
-    eval "$ac_envvar='$ac_optarg'"
-    export $ac_envvar ;;
-
-  *)
-    if echo "$ac_option" | grep '[^-a-zA-Z0-9.]' >/dev/null 2>&1; then
-      echo "configure: warning: invalid host type: $ac_option" 1>&2
-    fi
-    if test "x$nonopt" != xNONE; then
-      { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
-    fi
-    nonopt="$ac_option"
-    ;;
-
-  esac
-done
-
-if test -n "$ac_prev"; then
-  { echo "configure: error: missing argument to --\`echo $ac_prev | sed 's/_/-/g'\`" 1>&2; exit 1; }
-fi
-if $ac_init_help; then
-  # Omit some internal or obsolete options to make the list less imposing.
-  # This message is too long to be a string in the A/UX 3.1 sh.
-  cat <<\EOF
-`configure' configures software source code packages to adapt to many kinds
-of systems.
-
-Usage: configure [OPTION]... [VAR=VALUE]... [HOST]
-
-To safely assign special values to environment variables (e.g., CC,
-CFLAGS...), give to `configure' the definition as VAR=VALUE.
-
-Defaults for the options are specified in brackets.
-
-Configuration:
-  -h, --help              print this message
-  -V, --version           print the version of autoconf that created configure
-  -q, --quiet, --silent   do not print `checking...' messages
-      --cache-file=FILE   cache test results in FILE
-  -n, --no-create         do not create output files
-
-EOF
-
-  cat <<EOF
-Directories:
-  --prefix=PREFIX         install architecture-independent files in PREFIX
-                          [$ac_default_prefix]
-  --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX
-                          [same as prefix]
-  --bindir=DIR            user executables in DIR [EPREFIX/bin]
-  --sbindir=DIR           system admin executables in DIR [EPREFIX/sbin]
-  --libexecdir=DIR        program executables in DIR [EPREFIX/libexec]
-  --datadir=DIR           read-only architecture-independent data in DIR
-                          [PREFIX/share]
-  --sysconfdir=DIR        read-only single-machine data in DIR [PREFIX/etc]
-  --sharedstatedir=DIR    modifiable architecture-independent data in DIR
-                          [PREFIX/com]
-  --localstatedir=DIR     modifiable single-machine data in DIR [PREFIX/var]
-  --libdir=DIR            object code libraries in DIR [EPREFIX/lib]
-  --includedir=DIR        C header files in DIR [PREFIX/include]
-  --oldincludedir=DIR     C header files for non-gcc in DIR [/usr/include]
-  --infodir=DIR           info documentation in DIR [PREFIX/info]
-  --mandir=DIR            man documentation in DIR [PREFIX/man]
-  --srcdir=DIR            find the sources in DIR [configure dir or ..]
-EOF
-
-  cat <<\EOF
-
-Host type:
-  --build=BUILD      configure for building on BUILD [BUILD=HOST]
-  --host=HOST        configure for HOST [guessed]
-  --target=TARGET    configure for TARGET [TARGET=HOST]
-EOF
-
-  cat <<\EOF
-
-Program names:
-  --program-prefix=PREFIX            prepend PREFIX to installed program names
-  --program-suffix=SUFFIX            append SUFFIX to installed program names
-  --program-transform-name=PROGRAM   run sed PROGRAM on installed program names
-
-Optional Features:
-  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
-  --enable-FEATURE=ARG  include FEATURE ARG=yes
-  --disable-dependency-tracking Speeds up one-time builds
-  --enable-dependency-tracking  Do not reject slow dependency extractors
-  --enable-maintainer-mode enable make rules and dependencies not useful
-                          (and sometimes confusing) to the casual installer
-  --enable-assert         enable ASSERT checking default=no
-  --enable-alloca         use alloca for temp space default=yes
-  --enable-fft            enable FFTs for multiplication default=no
-  --enable-mpbsd          build Berkley MP compatibility library default=no
-  --enable-mpfr           build MPFR default=no
-  --enable-shared=PKGS  build shared libraries default=yes
-  --enable-static=PKGS  build static libraries default=yes
-  --enable-fast-install=PKGS  optimize for fast installation default=yes
-  --disable-libtool-lock  avoid locking (might break parallel builds)
-
-Optional Packages:
-  --with-PACKAGE=ARG    use PACKAGE ARG=yes
-  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)
-  --with-gnu-ld           assume the C compiler uses GNU ld default=no
-  --with-pic              try to use only PIC/non-PIC objects default=use both
-EOF
-  exit 0
-fi
-if $ac_init_version; then
-  cat <<\EOF
-Generated automatically using Autoconf version 2.14a.
-Copyright (C) 1992, 93, 94, 95, 96, 98, 99, 2000
-Free Software Foundation, Inc.
-
-This configure script is free software; the Free Software Foundation
-gives unlimited permission to copy, distribute and modify it.
-EOF
-  exit 0
-fi
-trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
-
-# Keep a trace of the command line.
-# Strip out --no-create and --no-recursion so they do not pile up.
-# Also quote any args containing shell meta-characters.
-ac_configure_args=
-for ac_arg
-do
-  case "$ac_arg" in
-  -no-create | --no-create | --no-creat | --no-crea | --no-cre \
-  | --no-cr | --no-c) ;;
-  -no-recursion | --no-recursion | --no-recursio | --no-recursi \
-  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
-  *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
-  ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"`
-  ac_configure_args="$ac_configure_args '$ac_arg'" ;;
-  *) ac_configure_args="$ac_configure_args $ac_arg" ;;
-  esac
-done
-
-# File descriptor usage:
-# 0 standard input
-# 1 file creation
-# 2 errors and warnings
-# 3 some systems may open it to /dev/tty
-# 4 used on the Kubota Titan
-# 6 checking for... messages and results
-# 5 compiler messages saved in config.log
-if test "$silent" = yes; then
-  exec 6>/dev/null
-else
-  exec 6>&1
-fi
-exec 5>./config.log
-
-echo "\
-This file contains any messages produced by compilers while
-running configure, to aid debugging if configure makes a mistake.
-
-It was created by configure version 2.14a, executed with
- > $0 $ac_configure_args
-" 1>&5
-
-# NLS nuisances.
-# Only set these to C if already set.  These must not be set unconditionally
-# because not all systems understand e.g. LANG=C (notably SCO).
-# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
-# Non-C LC_CTYPE values break the ctype check.
-if test "${LANG+set}"   = set; then LANG=C;   export LANG;   fi
-if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
-if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
-if test "${LC_CTYPE+set}"    = set; then LC_CTYPE=C;    export LC_CTYPE;    fi
-
-# confdefs.h avoids OS command line length limits that DEFS can exceed.
-rm -rf conftest* confdefs.h
-# AIX cpp loses on an empty file, so make sure it contains at least a newline.
-echo >confdefs.h
-
-# A filename unique to this package, relative to the directory that
-# configure is in, which we can look for to find out if srcdir is correct.
-ac_unique_file=
-
-# Find the source files, if location was not specified.
-if test -z "$srcdir"; then
-  ac_srcdir_defaulted=yes
-  # Try the directory containing this script, then its parent.
-  ac_prog=$0
-  ac_confdir=`echo "$ac_prog" | sed 's%/[^/][^/]*$%%'`
-  test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
-  srcdir=$ac_confdir
-  if test ! -r $srcdir/$ac_unique_file; then
-    srcdir=..
-  fi
-else
-  ac_srcdir_defaulted=no
-fi
-if test ! -r $srcdir/$ac_unique_file; then
-  if test "$ac_srcdir_defaulted" = yes; then
-    { echo "configure: error: cannot find sources in $ac_confdir or .." 1>&2; exit 1; }
-  else
-    { echo "configure: error: cannot find sources in $srcdir" 1>&2; exit 1; }
-  fi
-fi
-srcdir=`echo "$srcdir" | sed 's%\([^/]\)/*$%\1%'`
-
-# Prefer explicitly selected file to automatically selected ones.
-if test -z "$CONFIG_SITE"; then
-  if test "x$prefix" != xNONE; then
-    CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
-  else
-    CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
-  fi
-fi
-for ac_site_file in $CONFIG_SITE; do
-  if test -r "$ac_site_file"; then
-    echo "loading site script $ac_site_file"
-    . "$ac_site_file"
-  fi
-done
-
-if test -r "$cache_file"; then
-  echo "loading cache $cache_file"
-      test -f "$cache_file" && . $cache_file
-else
-  echo "creating cache $cache_file"
-  >$cache_file
-fi
-
-ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-
-ac_exeext=
-ac_objext=o
-# Factoring default headers for most tests.
-ac_includes_default="\
-#include <stdio.h>
-#include <sys/types.h>
-#if STDC_HEADERS
-# include <stdlib.h>
-# include <stddef.h>
-#else
-# if HAVE_STDLIB_H
-#  include <stdlib.h>
-# endif
-#endif
-#if HAVE_STRING_H
-# if !STDC_HEADERS && HAVE_MEMORY_H
-#  include <memory.h>
-# endif
-# include <string.h>
-#else
-# if HAVE_STRINGS_H
-#  include <strings.h>
-# endif
-#endif
-#if HAVE_INTTYPES_H
-# include <inttypes.h>
-#endif
-#if HAVE_UNISTD_H
-# include <unistd.h>
-#endif"
-
-if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
-  # Stardent Vistra SVR4 grep lacks -e, says Kaveh R. Ghazi.
-  if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
-    ECHO_N= ECHO_C='
-' ECHO_T='	'
-  else
-    ECHO_N=-n ECHO_C= ECHO_T=
-  fi
-else
-  ECHO_N= ECHO_C='\c' ECHO_T=
-fi
-
-ac_aux_dir=
-for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
-  if test -f $ac_dir/install-sh; then
-    ac_aux_dir=$ac_dir
-    ac_install_sh="$ac_aux_dir/install-sh -c"
-    break
-  elif test -f $ac_dir/install.sh; then
-    ac_aux_dir=$ac_dir
-    ac_install_sh="$ac_aux_dir/install.sh -c"
-    break
-  elif test -f $ac_dir/shtool; then
-    ac_aux_dir=$ac_dir
-    ac_install_sh="$ac_aux_dir/shtool install -c"
-    break
-  fi
-done
-if test -z "$ac_aux_dir"; then
-  { echo "configure: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
-fi
-ac_config_guess="$SHELL $ac_aux_dir/config.guess"
-ac_config_sub="$SHELL $ac_aux_dir/config.sub"
-ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure.
-
-echo $ECHO_N "checking host system type... $ECHO_C" 1>&6
-echo "configure:636: checking host system type" 1>&5
-if test "x$ac_cv_host" = "x" || (test "x$host" != "xNONE" && test "x$host" != "x$ac_cv_host_alias"); then
-
-  # Make sure we can run config.sub.
-  if $ac_config_sub sun4 >/dev/null 2>&1; then :; else
-    { echo "configure: error: cannot run $ac_config_sub" 1>&2; exit 1; }
-  fi
-
-  ac_cv_host_alias=$host
-  case "$ac_cv_host_alias" in
-  NONE)
-    case $nonopt in
-    NONE)
-      if ac_cv_host_alias=`$ac_config_guess`; then :
-      else { echo "configure: error: cannot guess host type; you must specify one" 1>&2; exit 1; }
-      fi ;;    *) ac_cv_host_alias=$nonopt ;;
-    esac ;;
-  esac
-
-  ac_cv_host=`$ac_config_sub $ac_cv_host_alias` || exit 1
-  ac_cv_host_cpu=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-  ac_cv_host_vendor=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-  ac_cv_host_os=`echo $ac_cv_host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-else
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-fi
-
-echo "$ECHO_T""$ac_cv_host" 1>&6
-
-host=$ac_cv_host
-host_alias=$ac_cv_host_alias
-host_cpu=$ac_cv_host_cpu
-host_vendor=$ac_cv_host_vendor
-host_os=$ac_cv_host_os
-
-echo $ECHO_N "checking target system type... $ECHO_C" 1>&6
-echo "configure:672: checking target system type" 1>&5
-if test "x$ac_cv_target" = "x" || (test "x$target" != "xNONE" && test "x$target" != "x$ac_cv_target_alias"); then
-
-  # Make sure we can run config.sub.
-  if $ac_config_sub sun4 >/dev/null 2>&1; then :; else
-    { echo "configure: error: cannot run $ac_config_sub" 1>&2; exit 1; }
-  fi
-
-  ac_cv_target_alias=$target
-  case "$ac_cv_target_alias" in
-  NONE)
-    case $nonopt in
-    NONE)
-      ac_cv_target_alias=$host_alias ;;
-    *) ac_cv_target_alias=$nonopt ;;
-    esac ;;
-  esac
-
-  ac_cv_target=`$ac_config_sub $ac_cv_target_alias` || exit 1
-  ac_cv_target_cpu=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-  ac_cv_target_vendor=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-  ac_cv_target_os=`echo $ac_cv_target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-else
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-fi
-
-echo "$ECHO_T""$ac_cv_target" 1>&6
-
-target=$ac_cv_target
-target_alias=$ac_cv_target_alias
-target_cpu=$ac_cv_target_cpu
-target_vendor=$ac_cv_target_vendor
-target_os=$ac_cv_target_os
-
-echo $ECHO_N "checking build system type... $ECHO_C" 1>&6
-echo "configure:707: checking build system type" 1>&5
-if test "x$ac_cv_build" = "x" || (test "x$build" != "xNONE" && test "x$build" != "x$ac_cv_build_alias"); then
-
-  # Make sure we can run config.sub.
-  if $ac_config_sub sun4 >/dev/null 2>&1; then :; else
-    { echo "configure: error: cannot run $ac_config_sub" 1>&2; exit 1; }
-  fi
-
-  ac_cv_build_alias=$build
-  case "$ac_cv_build_alias" in
-  NONE)
-    case $nonopt in
-    NONE)
-      ac_cv_build_alias=$host_alias ;;
-    *) ac_cv_build_alias=$nonopt ;;
-    esac ;;
-  esac
-
-  ac_cv_build=`$ac_config_sub $ac_cv_build_alias` || exit 1
-  ac_cv_build_cpu=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-  ac_cv_build_vendor=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-  ac_cv_build_os=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-else
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-fi
-
-echo "$ECHO_T""$ac_cv_build" 1>&6
-
-build=$ac_cv_build
-build_alias=$ac_cv_build_alias
-build_cpu=$ac_cv_build_cpu
-build_vendor=$ac_cv_build_vendor
-build_os=$ac_cv_build_os
-
-# Do some error checking and defaulting for the host and target type.
-# The inputs are:
-#    configure --host=HOST --target=TARGET --build=BUILD NONOPT
-#
-# The rules are:
-# 1. You are not allowed to specify --host, --target, and nonopt at the
-#    same time.
-# 2. Host defaults to nonopt.
-# 3. If nonopt is not specified, then host defaults to the current host,
-#    as determined by config.guess.
-# 4. Target and build default to nonopt.
-# 5. If nonopt is not specified, then target and build default to host.
-
-# The aliases save the names the user supplied, while $host etc.
-# will get canonicalized.
-case $host---$target---$nonopt in
-NONE---*---* | *---NONE---* | *---*---NONE) ;;
-*) { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } ;;
-esac
-
-test "$host_alias" != "$target_alias" &&
-  test "$program_prefix$program_suffix$program_transform_name" = \
-    NONENONEs,x,x, &&
-  program_prefix=${target_alias}-
-
-# Find a good install program.  We prefer a C program (faster),
-# so one script is as good as another.  But avoid the broken or
-# incompatible versions:
-# SysV /etc/install, /usr/sbin/install
-# SunOS /usr/etc/install
-# IRIX /sbin/install
-# AIX /bin/install
-# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
-# AFS /usr/afsws/bin/install, which mishandles nonexistent args
-# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
-# ./install, which can be erroneously created by make from ./install.sh.
-echo $ECHO_N "checking for a BSD compatible install... $ECHO_C" 1>&6
-echo "configure:778: checking for a BSD compatible install" 1>&5
-if test -z "$INSTALL"; then
-if test "${ac_cv_path_install+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-    IFS="${IFS= 	}"; ac_save_IFS="$IFS"; IFS=":"
-  for ac_dir in $PATH; do
-    # Account for people who put trailing slashes in PATH elements.
-    case "$ac_dir/" in
-    /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
-    *)
-      # OSF1 and SCO ODT 3.0 have their own names for install.
-      # Don't use installbsd from OSF since it installs stuff as root
-      # by default.
-      for ac_prog in ginstall scoinst install; do
-        if test -f $ac_dir/$ac_prog; then
-	  if test $ac_prog = install &&
-            grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
-	    # AIX install.  It has an incompatible calling convention.
-	    :
-	  elif test $ac_prog = install &&
-	    grep pwplus $ac_dir/$ac_prog >/dev/null 2>&1; then
-	    # program-specific install script used by HP pwplus--don't use.
-	    :
-	  else
-	    ac_cv_path_install="$ac_dir/$ac_prog -c"
-	    break 2
-	  fi
-	fi
-      done
-      ;;
-    esac
-  done
-  IFS="$ac_save_IFS"
-
-fi
-  if test "${ac_cv_path_install+set}" = set; then
-    INSTALL="$ac_cv_path_install"
-  else
-    # As a last resort, use the slow shell script.  We don't cache a
-    # path for INSTALL within a source directory, because that will
-    # break other packages using the cache if that directory is
-    # removed, or if the path is relative.
-    INSTALL="$ac_install_sh"
-  fi
-fi
-echo "$ECHO_T""$INSTALL" 1>&6
-
-# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
-# It thinks the first close brace ends the variable substitution.
-test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
-
-test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
-
-test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
-
-echo $ECHO_N "checking whether build environment is sane... $ECHO_C" 1>&6
-echo "configure:835: checking whether build environment is sane" 1>&5
-# Just in case
-sleep 1
-echo timestamp > conftestfile
-# Do `set' in a subshell so we don't clobber the current shell's
-# arguments.  Must try -L first in case configure is actually a
-# symlink; some systems play weird games with the mod time of symlinks
-# (eg FreeBSD returns the mod time of the symlink's containing
-# directory).
-if (
-   set X `ls -Lt $srcdir/configure conftestfile 2> /dev/null`
-   if test "$*" = "X"; then
-      # -L didn't work.
-      set X `ls -t $srcdir/configure conftestfile`
-   fi
-   if test "$*" != "X $srcdir/configure conftestfile" \
-      && test "$*" != "X conftestfile $srcdir/configure"; then
-
-      # If neither matched, then we have a broken ls.  This can happen
-      # if, for instance, CONFIG_SHELL is bash and it inherits a
-      # broken ls alias from the environment.  This has actually
-      # happened.  Such a system could not be considered "sane".
-      { echo "configure: error: ls -t appears to fail.  Make sure there is not a broken
-alias in your environment" 1>&2; exit 1; }
-   fi
-
-   test "$2" = conftestfile
-   )
-then
-   # Ok.
-   :
-else
-   { echo "configure: error: newly created file is older than distributed files!
-Check your system clock" 1>&2; exit 1; }
-fi
-rm -f conftest*
-echo "$ECHO_T""yes" 1>&6
-if test "$program_transform_name" = s,x,x,; then
-  program_transform_name=
-else
-  # Double any \ or $.  echo might interpret backslashes.
-  cat <<\EOF >conftestsed
-s,\\,\\\\,g; s,\$,$$,g
-EOF
-  program_transform_name=`echo $program_transform_name | sed -f conftestsed`
-  rm -f conftestsed
-fi
-test "$program_prefix" != NONE &&
-  program_transform_name="s,^,${program_prefix},;$program_transform_name"
-# Use a double $ so make ignores it.
-test "$program_suffix" != NONE &&
-  program_transform_name="s,\$\$,${program_suffix},;$program_transform_name"
-
-# sed with no file args requires a program.
-test "$program_transform_name" = "" && program_transform_name="s,x,x,"
-
-test x"${MISSING+set}" = xset || \
-  MISSING="\${SHELL} `CDPATH=: && cd $ac_aux_dir && pwd`/missing"
-if eval "$MISSING --run :"; then
-  am_missing_run="$MISSING --run "
-else
-  am_missing_run=
-  am_backtick='`'
-  echo "configure: warning: ${am_backtick}missing' script is too old or missing" 1>&2
-fi
-
-for ac_prog in mawk gawk nawk awk
-do
-# Extract the first word of "$ac_prog", so it can be a program name with args.
-set dummy $ac_prog; ac_word=$2
-echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
-echo "configure:906: checking for $ac_word" 1>&5
-if test "${ac_cv_prog_AWK+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -n "$AWK"; then
-  ac_cv_prog_AWK="$AWK" # Let the user override the test.
-else
-  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
-ac_dummy="$PATH"
-for ac_dir in $ac_dummy; do
-  test -z "$ac_dir" && ac_dir=.
-  if test -f $ac_dir/$ac_word; then
-    echo "$ac_dir/$ac_word"
-  fi
-done
-IFS="$ac_save_ifs"
-`; do
-    ac_cv_prog_AWK="$ac_prog"
-    break
-  done
-fi
-fi
-AWK="$ac_cv_prog_AWK"
-if test -n "$AWK"; then
-  echo "$ECHO_T""$AWK" 1>&6
-else
-  echo "$ECHO_T""no" 1>&6
-fi
-
-test -n "$AWK" && break
-done
-
-echo $ECHO_N "checking whether ${MAKE-make} sets \${MAKE}... $ECHO_C" 1>&6
-echo "configure:939: checking whether ${MAKE-make} sets \${MAKE}" 1>&5
-set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
-if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  cat >conftestmake <<\EOF
-all:
-	@echo 'ac_maketemp="${MAKE}"'
-EOF
-# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
-eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
-if test -n "$ac_maketemp"; then
-  eval ac_cv_prog_make_${ac_make}_set=yes
-else
-  eval ac_cv_prog_make_${ac_make}_set=no
-fi
-rm -f conftestmake
-fi
-if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
-  echo "$ECHO_T""yes" 1>&6
-  SET_MAKE=
-else
-  echo "$ECHO_T""no" 1>&6
-  SET_MAKE="MAKE=${MAKE-make}"
-fi
-
-# Check whether --enable-dependency-tracking or --disable-dependency-tracking was given.
-if test "${enable_dependency_tracking+set}" = set; then
-  enableval="$enable_dependency_tracking"
-
-fi
-if test "x$enable_dependency_tracking" = xno; then
-  AMDEP="#"
-else
-  am_depcomp="$ac_aux_dir/depcomp"
-  if test ! -f "$am_depcomp"; then
-    AMDEP="#"
-  else
-    AMDEP=
-  fi
-fi
-
-if test -z "$AMDEP"; then
-  AMDEPBACKSLASH='\'
-else
-  AMDEPBACKSLASH=
-fi
-
-if test -d .deps || mkdir .deps 2> /dev/null || test -d .deps; then
-  DEPDIR=.deps
-else
-  DEPDIR=_deps
-fi
-
-PACKAGE=gmp
-
-VERSION=3.1.1
-
-if test "`CDPATH=: && cd $srcdir && pwd`" != "`pwd`" &&
-   test -f $srcdir/config.status; then
-  { echo "configure: error: source directory already configured; run "make distclean" there first" 1>&2; exit 1; }
-fi
-cat >>confdefs.h <<EOF
-#define PACKAGE "$PACKAGE"
-EOF
-
-cat >>confdefs.h <<EOF
-#define VERSION "$VERSION"
-EOF
-
-ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal"}
-
-AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"}
-
-AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake"}
-
-AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"}
-
-MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"}
-
-AMTAR=${AMTAR-"${am_missing_run}tar"}
-
-if test -z "$install_sh"; then
-   install_sh="$ac_aux_dir/install-sh"
-   test -f "$install_sh" || install_sh="$ac_aux_dir/install.sh"
-   test -f "$install_sh" || install_sh="${am_missing_run}${ac_auxdir}/install-sh"
-         install_sh="`echo $install_sh | sed -e 's/\${SHELL}//'`"
-fi
-
-echo $ECHO_N "checking whether to enable maintainer-specific portions of Makefiles... $ECHO_C" 1>&6
-echo "configure:1029: checking whether to enable maintainer-specific portions of Makefiles" 1>&5
-    # Check whether --enable-maintainer-mode or --disable-maintainer-mode was given.
-if test "${enable_maintainer_mode+set}" = set; then
-  enableval="$enable_maintainer_mode"
-  USE_MAINTAINER_MODE=$enableval
-else
-  USE_MAINTAINER_MODE=no
-fi
-  echo "$ECHO_T""$USE_MAINTAINER_MODE" 1>&6
-
-if test $USE_MAINTAINER_MODE = yes; then
-  MAINTAINER_MODE_TRUE=
-  MAINTAINER_MODE_FALSE='#'
-else
-  MAINTAINER_MODE_TRUE='#'
-  MAINTAINER_MODE_FALSE=
-fi
-  MAINT=$MAINTAINER_MODE_TRUE
-
-gmp_configm4="config.m4"
-gmp_tmpconfigm4=cnfm4.tmp
-gmp_tmpconfigm4i=cnfm4i.tmp
-gmp_tmpconfigm4p=cnfm4p.tmp
-test -f $gmp_tmpconfigm4 && rm $gmp_tmpconfigm4
-test -f $gmp_tmpconfigm4i && rm $gmp_tmpconfigm4i
-test -f $gmp_tmpconfigm4p && rm $gmp_tmpconfigm4p
-
-# Check whether --enable-assert or --disable-assert was given.
-if test "${enable_assert+set}" = set; then
-  enableval="$enable_assert"
-  case "${enableval}" in
-yes|no) ;;
-*) { echo "configure: error: bad value ${enableval} for --enable-assert, need yes or no" 1>&2; exit 1; } ;;
-esac
-else
-  enable_assert=no
-fi
-
-if test "$enable_assert" = "yes"; then
-  cat >>confdefs.h <<\EOF
-#define WANT_ASSERT 1
-EOF
-
-fi
-
-# Check whether --enable-alloca or --disable-alloca was given.
-if test "${enable_alloca+set}" = set; then
-  enableval="$enable_alloca"
-  case "${enableval}" in
-yes|no) ;;
-*) { echo "configure: error: bad value ${enableval} for --enable-alloca, need yes or no" 1>&2; exit 1; } ;;
-esac
-else
-  enable_alloca=yes
-fi
-
-if test "$enable_alloca" = "no"; then
-  cat >>confdefs.h <<\EOF
-#define USE_STACK_ALLOC 1
-EOF
-
-fi
-
-# Check whether --enable-fft or --disable-fft was given.
-if test "${enable_fft+set}" = set; then
-  enableval="$enable_fft"
-  case "${enableval}" in
-yes|no) ;;
-*) { echo "configure: error: bad value ${enableval} for --enable-fft, need yes or no" 1>&2; exit 1; } ;;
-esac
-else
-  enable_fft=no
-fi
-
-if test "$enable_fft" = "yes"; then
-  cat >>confdefs.h <<\EOF
-#define WANT_FFT 1
-EOF
-
-fi
-
-# Check whether --enable-mpbsd or --disable-mpbsd was given.
-if test "${enable_mpbsd+set}" = set; then
-  enableval="$enable_mpbsd"
-  case "${enableval}" in
-yes|no) ;;
-*) { echo "configure: error: bad value ${enableval} for --enable-mpbsd, need yes or no" 1>&2; exit 1; } ;;
-esac
-else
-  enable_mpbsd=no
-fi
-
-if test "$enable_mpbsd" = "yes"; then
-  WANT_MPBSD_TRUE=
-  WANT_MPBSD_FALSE='#'
-else
-  WANT_MPBSD_TRUE='#'
-  WANT_MPBSD_FALSE=
-fi
-
-# Check whether --enable-mpfr or --disable-mpfr was given.
-if test "${enable_mpfr+set}" = set; then
-  enableval="$enable_mpfr"
-  case "${enableval}" in
-yes|no) ;;
-*) { echo "configure: error: bad value ${enableval} for --enable-mpfr, need yes or no" 1>&2; exit 1; } ;;
-esac
-else
-  enable_mpfr=no
-fi
-
-if test "$enable_mpfr" = "yes"; then
-  WANT_MPFR_TRUE=
-  WANT_MPFR_FALSE='#'
-else
-  WANT_MPFR_TRUE='#'
-  WANT_MPFR_FALSE=
-fi
-
-os_64bit="no"
-cclist="gcc cc"		# FIXME: Prefer c89 to cc.
-gmp_cflags_gcc="-g -O2"
-gmp_cflags64_gcc="-g -O2"
-gmp_cflags_cc="-g"
-gmp_cflags64_cc="-g"
-
-case "$target" in
-  # Alpha
-  alpha*-cray-unicos*)
-    # Don't perform any assembly syntax tests on this beast.
-    gmp_no_asm_syntax_testing=yes
-    cclist=cc
-    gmp_cflags_cc="$gmp_cflags_cc -O"
-    ;;
-  alpha*-*-osf*)
-    flavour=`echo $target_cpu | sed 's/^alpha//g'`
-    if test -n "$flavour"; then
-      case $flavour in	   # compilers don't seem to understand `ev67' and such.
-	ev6? | ev7*) flavour=ev6;;
-      esac
-      gmp_optcflags_gcc="-mcpu=$flavour"
-      # FIXME: We shouldn't fail fatally if none of these work, but that's
-      # how xoptcflags work and we don't have any other mechanism right now.
-      # Why do we need this here and not for alpha*-*-* below?
-      gmp_xoptcflags_gcc="-Wa,-arch,${flavour} -Wa,-m${flavour}"
-      gmp_optcflags_cc="-arch $flavour -tune $flavour"
-    fi
-    ;;
-  alpha*-*-*)
-    cclist="gcc"
-    flavour=`echo $target_cpu | sed 's/^alpha//g'`
-    if test -n "$flavour"; then
-      case $flavour in
-	ev6? | ev7*) flavour=ev6;;
-      esac
-      gmp_optcflags_gcc="-mcpu=$flavour"
-    fi
-    ;;
-  # Cray vector machines.  This must come after alpha* so that we can
-  # recognize present and future vector processors with a wildcard.
-  *-cray-unicos*)
-    # Don't perform any assembly syntax tests on this beast.
-    gmp_no_asm_syntax_testing=yes
-    cclist=cc
-    # Don't inherit default gmp_cflags_cc value; it comes with -g which
-    # disables all optimization on Cray vector systems
-    gmp_cflags_cc="-O"
-    ;;
-
-  # AMD and Intel x86 configurations
-  i?86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-*)
-    # Rumour has it -O2 used to give worse register allocation than just -O.
-    gmp_cflags_gcc="-g -O -fomit-frame-pointer"
-
-    case "${target}" in
-      i386*-*-*)    gmp_optcflags_gcc="-mcpu=i386 -march=i386";;
-      i486*-*-*)    gmp_optcflags_gcc="-mcpu=i486 -march=i486";;
-      i586*-*-* | pentium-*-* | pentiummmx-*-*)
-                    gmp_optcflags_gcc="-mcpu=pentium -march=pentium";;
-
-      # -march=pentiumpro not used because mpz/powm.c (swox cvs rev 1.4)
-      # tickles a bug in gcc 2.95.2 (believed fixed in 2.96).
-      i686*-*-* | pentiumpro-*-* | pentium[23]-*-*)
-                    gmp_optcflags_gcc="-mcpu=pentiumpro";;
-
-      k6*-*-*)      gmp_optcflags_gcc="-mcpu=k6 -march=k6";;
-
-      # Athlon instruction costs are close to p6: 3 cycle load latency, 4-6
-      # cycle mul, 40 cycle div, pairable adc, ...
-      # FIXME: Change this when gcc gets something specific for Athlon.
-      # -march=pentiumpro not used, per i686 above.
-      athlon-*-*)   gmp_optcflags_gcc="-mcpu=pentiumpro";;
-    esac
-    ;;
-
-  # Sparc
-  ultrasparc*-*-solaris2.[7-9] | sparcv9-*-solaris2.[7-9])
-    os_64bit=yes
-    gmp_cflags_gcc="$gmp_cflags_gcc -Wa,-xarch=v8plus"
-    gmp_xoptcflags_gcc="-mcpu=v9 -mcpu=v8 -mv8"
-    gmp_cflags64_gcc="$gmp_cflags64_gcc -m64 -mptr64 -Wa,-xarch=v9 -mcpu=v9"
-    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4"
-    gmp_cflags64_cc="-xtarget=native -xarch=v9 -xO4"
-    ;;
-  sparc64-*-linux*)
-    # Need to think more about the options passed here.  This isn't good for
-    # some sparc64 linux distros, since we end up not optimizing when all the
-    # options below fail.
-    os_64bit=yes
-    gmp_cflags64_gcc="$gmp_cflags64_gcc -m64 -mptr64 -Wa,-xarch=v9 -mcpu=v9"
-    gmp_cflags_gcc="$gmp_cflags_gcc -m32"
-    gmp_xoptflags_gcc="-mcpu=ultrasparc -mvis"
-    ;;
-  ultrasparc*-*-* | sparcv9-*-*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -Wa,-xarch=v8plus"
-    gmp_xoptcflags_gcc="-mcpu=v9 -mcpu=v8 -mv8"
-    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4"
-    ;;
-  sparcv8*-*-solaris2.* | microsparc*-*-solaris2.*)
-    gmp_cflags_gcc="$gmp_cflags_gcc"
-    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
-    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4"
-    ;;
-  sparcv8*-*-* | microsparc*-*-*)		# SunOS, Linux, *BSD
-    cclist="gcc acc cc"
-    gmp_cflags_gcc="$gmp_cflags_gcc"
-    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
-    gmp_cflags_acc="-g -O2 -cg92"
-    gmp_cflags_cc="-O2"		# FIXME: Flag for v8?
-    ;;
-  supersparc*-*-solaris2.*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -DSUPERSPARC"
-    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
-    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4 -DSUPERSPARC"
-    ;;
-  supersparc*-*-*)		# SunOS, Linux, *BSD
-    cclist="gcc acc cc"
-    gmp_cflags_gcc="$gmp_cflags_gcc -DSUPERSPARC"
-    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
-    gmp_cflags_acc="-g -O2 -cg92 -DSUPERSPARC"
-    gmp_cflags_cc="-O2 -DSUPERSPARC"	# FIXME: Flag for v8?
-    ;;
-  *sparc*-*-*)
-    cclist="gcc acc cc"
-    gmp_cflags_acc="-g -O2"
-    gmp_cflags_cc="-g -O2"
-    ;;
-
-  # POWER/PowerPC
-  powerpc64-*-aix*)
-    cclist="gcc xlc"
-    gmp_cflags_gcc="$gmp_cflags_gcc -maix64 -mpowerpc64"
-    gmp_cflags_xlc="-g -O2 -q64 -qtune=pwr3"
-    ;;
-  powerpc*-*-aix*)
-    cclist="gcc xlc"
-    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc"
-    gmp_cflags_xlc="$gmp_cflags_cc -qarch=ppc -O2"
-    ;;
-  power-*-aix*)
-    cclist="gcc xlc"
-    gmp_cflags_gcc="$gmp_cflags_gcc -mpower"
-    gmp_cflags_xlc="$gmp_cflags_cc -qarch=pwr -O2"
-    ;;
-  powerpc64*-*-*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc64"
-    cat >>confdefs.h <<\EOF
-#define _LONG_LONG_LIMB 1
-EOF
-	    ;;
-  powerpc-apple-darwin* | powerpc-apple-macosx*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc -traditional-cpp"
-    ;;
-  powerpc*-*-*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc"
-    ;;
-
-  # MIPS
-  mips-sgi-irix6.*)
-    os_64bit=yes
-    gmp_cflags64_gcc="-g -O2 -mabi=n32"
-    gmp_cflags64_cc="$gmp_cflags64_cc -O2 -n32"
-    ;;
-
-  # Motorola 68k family
-  m88110*-*-*)
-    gmp_cflags_gcc="-g -O -m88110"	    ;;
-  m68*-*-*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -fomit-frame-pointer"
-    ;;
-
-  # HP
-  hppa1.0*-*-*)
-    cclist="gcc c89 cc"
-    gmp_cflags_c89="$gmp_cflags_cc +O2"
-    gmp_cflags_cc="$gmp_cflags_cc +O2"
-    ;;
-  hppa2.0w*-*-*)
-    cclist="c89 cc"
-    gmp_cflags_c89="+DD64 +O3"
-    gmp_cflags_cc="+DD64 +O3"
-    ;;
-  hppa2.0*-*-*)
-    os_64bit=yes
-    cclist="gcc c89 cc"
-    gmp_cflags64_gcc="$gmp_cflags64_gcc -mWHAT -D_LONG_LONG_LIMB"
-    # +O2 to cc triggers bug in mpz/powm.c (1.4)
-    gmp_cflags64_c89="+DA2.0 +e +O3 -D_LONG_LONG_LIMB"
-    gmp_cflags64_cc="+DA2.0 +e +O3 -D_LONG_LONG_LIMB"
-    gmp_cflags_c89="$gmp_cflags_cc +O2"
-    gmp_cflags_cc="$gmp_cflags_cc +O2"
-    ;;
-
-  # VAX
-  vax*-*-*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -fomit-frame-pointer"
-    ;;
-
-  # Fujitsu
-  f30[01]-fujitsu-sysv*)
-    cclist="gcc vcc"
-    gmp_cflags_vcc="-g"		# FIXME: flags for vcc?
-    ;;
-esac
-
-case "${target}" in
-  *-*-mingw32) gmp_cflags_gcc="$gmp_cflags_gcc -mno-cygwin";;
-esac
-
-echo $ECHO_N "checking for BSD-compatible nm... $ECHO_C" 1>&6
-echo "configure:1352: checking for BSD-compatible nm" 1>&5
-if test "${ac_cv_path_NM+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -n "$NM"; then
-  # Let the user override the test.
-  ac_cv_path_NM="$NM"
-else
-  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR-:}"
-  for ac_dir in $PATH /usr/ccs/bin /usr/ucb /bin; do
-    test -z "$ac_dir" && ac_dir=.
-    if test -f $ac_dir/nm || test -f $ac_dir/nm$ac_exeext ; then
-      # Check to see if the nm accepts a BSD-compat flag.
-      # Adding the `sed 1q' prevents false positives on HP-UX, which says:
-      #   nm: unknown option "B" ignored
-      if ($ac_dir/nm -B /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then
-	ac_cv_path_NM="$ac_dir/nm -B"
-	break
-      elif ($ac_dir/nm -p /dev/null 2>&1 | sed '1q'; exit 0) | egrep /dev/null >/dev/null; then
-	ac_cv_path_NM="$ac_dir/nm -p"
-	break
-      else
-	ac_cv_path_NM=${ac_cv_path_NM="$ac_dir/nm"} # keep the first match, but
-	continue # so that we can try to find one that supports BSD flags
-      fi
-    fi
-  done
-  IFS="$ac_save_ifs"
-  test -z "$ac_cv_path_NM" && ac_cv_path_NM=nm
-fi
-fi
-
-NM="$ac_cv_path_NM"
-echo "$ECHO_T""$NM" 1>&6
-	# nm on 64-bit AIX needs to know the object file format
-case "$target" in
-  powerpc64*-*-aix*)
-    NM="$NM -X 64"
-    ;;
-esac
-
-# Save CFLAGS given on command line.
-gmp_user_CFLAGS="$CFLAGS"
-
-if test -z "$CC"; then
-  # Find compiler.
-
-if test $host != $build; then
-  ac_tool_prefix=${host_alias}-
-else
-  ac_tool_prefix=
-fi
-
-gmp_cc_list="$cclist"
-gmp_req_64bit_cc="$os_64bit"
-
-CC32=
-CC64=
-for c in $gmp_cc_list; do
-  # Avoid cache hits.
-  unset CC
-  unset ac_cv_prog_CC
-
-# Extract the first word of "${ac_tool_prefix}$c", so it can be a program name with args.
-set dummy ${ac_tool_prefix}$c; ac_word=$2
-echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
-echo "configure:1418: checking for $ac_word" 1>&5
-if test "${ac_cv_prog_CC+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -n "$CC"; then
-  ac_cv_prog_CC="$CC" # Let the user override the test.
-else
-  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
-ac_dummy="$PATH"
-for ac_dir in $ac_dummy; do
-  test -z "$ac_dir" && ac_dir=.
-  if test -f $ac_dir/$ac_word; then
-    echo "$ac_dir/$ac_word"
-  fi
-done
-IFS="$ac_save_ifs"
-`; do
-    ac_cv_prog_CC="${ac_tool_prefix}$c"
-    break
-  done
-fi
-fi
-CC="$ac_cv_prog_CC"
-if test -n "$CC"; then
-  echo "$ECHO_T""$CC" 1>&6
-else
-  echo "$ECHO_T""no" 1>&6
-fi
-
-if test -z "$ac_cv_prog_CC"; then
-  if test -n "$ac_tool_prefix"; then
-    # Extract the first word of "$c", so it can be a program name with args.
-set dummy $c; ac_word=$2
-echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
-echo "configure:1452: checking for $ac_word" 1>&5
-if test "${ac_cv_prog_CC+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -n "$CC"; then
-  ac_cv_prog_CC="$CC" # Let the user override the test.
-else
-  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
-ac_dummy="$PATH"
-for ac_dir in $ac_dummy; do
-  test -z "$ac_dir" && ac_dir=.
-  if test -f $ac_dir/$ac_word; then
-    echo "$ac_dir/$ac_word"
-  fi
-done
-IFS="$ac_save_ifs"
-`; do
-    ac_cv_prog_CC="$c"
-    break
-  done
-  test -z "$ac_cv_prog_CC" && ac_cv_prog_CC="$c"
-fi
-fi
-CC="$ac_cv_prog_CC"
-if test -n "$CC"; then
-  echo "$ECHO_T""$CC" 1>&6
-else
-  echo "$ECHO_T""no" 1>&6
-fi
-
-  else
-    CC="$c"
-  fi
-fi
-
-  if test -n "$CC"; then
-    eval c_flags=\$gmp_cflags_$c
-    ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-	CC="$CC"
-CFLAGS="$c_flags"
-echo $ECHO_N "checking if the C compiler ($CC) works with flags $CFLAGS... $ECHO_C" 1>&6
-echo "configure:1498: checking if the C compiler ($CC) works with flags $CFLAGS" 1>&5
-
-# Simple test for all targets.
-cat >conftest.$ac_ext <<EOF
-
-#line 1503 "configure"
-#include "confdefs.h"
-
-int main(){return(0);}
-EOF
-if { (eval echo configure:1508: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  tmp_works=yes
-  # If we can't run a trivial program, we are probably using a cross compiler.
-  if (./conftest; exit) 2>/dev/null; then
-    tmp_cross=no
-  else
-    tmp_cross=yes
-  fi
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  tmp_works=no
-fi
-rm -fr conftest*
-
-# Target specific tests.
-if test "$tmp_works" = "yes"; then
-  case "$target" in
-    *-*-aix*)	# Returning a funcptr.
-      cat >conftest.$ac_ext <<EOF
-#line 1528 "configure"
-#include "confdefs.h"
-
-int
-main ()
-{
-} void *g(); void *f() { return g(); } int bar(){
-  ;
-  return 0;
-}
-EOF
-if { (eval echo configure:1539: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
-  rm -rf conftest*
-  tmp_works=yes
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  tmp_works=no
-fi
-rm -f conftest*
-      ;;
-  esac
-fi
-
-if test "$tmp_works" = "yes"; then
-  gmp_prog_cc_works=yes
-else
-  gmp_prog_cc_works=no
-fi
-
-echo "$ECHO_T""$tmp_works" 1>&6
-
-    if test "$gmp_prog_cc_works" != "yes"; then
-      continue
-    fi
-
-    # Save first working compiler, whether 32- or 64-bit capable.
-    if test -z "$CC32"; then
-      CC32="$CC"
-    fi
-    if test "$gmp_req_64bit_cc" = "yes"; then
-      eval c_flags=\$gmp_cflags64_$c
-
-      # Verify that the compiler works in 64-bit mode as well.
-      # /usr/ucb/cc on Solaris 7 can *compile* in 64-bit mode, but not link.
-      ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-	CC="$c"
-CFLAGS="$c_flags"
-echo $ECHO_N "checking if the C compiler ($CC) works with flags $CFLAGS... $ECHO_C" 1>&6
-echo "configure:1583: checking if the C compiler ($CC) works with flags $CFLAGS" 1>&5
-
-# Simple test for all targets.
-cat >conftest.$ac_ext <<EOF
-
-#line 1588 "configure"
-#include "confdefs.h"
-
-int main(){return(0);}
-EOF
-if { (eval echo configure:1593: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  tmp_works=yes
-  # If we can't run a trivial program, we are probably using a cross compiler.
-  if (./conftest; exit) 2>/dev/null; then
-    tmp_cross=no
-  else
-    tmp_cross=yes
-  fi
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  tmp_works=no
-fi
-rm -fr conftest*
-
-# Target specific tests.
-if test "$tmp_works" = "yes"; then
-  case "$target" in
-    *-*-aix*)	# Returning a funcptr.
-      cat >conftest.$ac_ext <<EOF
-#line 1613 "configure"
-#include "confdefs.h"
-
-int
-main ()
-{
-} void *g(); void *f() { return g(); } int bar(){
-  ;
-  return 0;
-}
-EOF
-if { (eval echo configure:1624: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
-  rm -rf conftest*
-  tmp_works=yes
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  tmp_works=no
-fi
-rm -f conftest*
-      ;;
-  esac
-fi
-
-if test "$tmp_works" = "yes"; then
-  gmp_prog_cc_works=yes
-else
-  gmp_prog_cc_works=no
-fi
-
-echo "$ECHO_T""$tmp_works" 1>&6
-
-      if test "$gmp_prog_cc_works" = "yes"; then
-
-  gmp_tmp_CC_save="$CC"
-  CC="$c"
-  echo $ECHO_N "checking whether the C compiler ($CC) is 64-bit capable... $ECHO_C" 1>&6
-echo "configure:1651: checking whether the C compiler ($CC) is 64-bit capable" 1>&5
-  if test -z "$NM"; then
-    echo; echo "configure: GMP_CHECK_CC_64BIT: fatal: need nm"
-    exit 1
-  fi
-  gmp_tmp_CFLAGS_save="$CFLAGS"
-  CFLAGS="$c_flags"
-
-  case "$target" in
-    hppa2.0*-*-*)
-      # FIXME: If gcc is installed under another name than "gcc", we will
-      # test the wrong thing.
-      if test "$CC" != "gcc"; then
-                                                echo >conftest.c
-        gmp_tmp_vs=`$CC $CFLAGS -V -c -o conftest.o conftest.c 2>&1 | grep "^ccom:"`
-        rm conftest*
-        gmp_tmp_v1=`echo $gmp_tmp_vs | sed 's/.* .\.\(.*\)\..*\..* HP C.*/\1/'`
-        gmp_tmp_v2=`echo $gmp_tmp_vs | sed 's/.* .\..*\.\(.*\)\..* HP C.*/\1/'`
-        gmp_tmp_v3=`echo $gmp_tmp_vs | sed 's/.* .\..*\..*\.\(.*\) HP C.*/\1/'`
-	gmp_cv_cc_64bit=no
-	test -n "$gmp_tmp_v1" && test "$gmp_tmp_v1" -ge "10" \
-  	  && test -n "$gmp_tmp_v2" && test "$gmp_tmp_v2" -ge "32" \
-    	  && test -n "$gmp_tmp_v3" && test "$gmp_tmp_v3" -ge "30" \
-	  && gmp_cv_cc_64bit=yes
-      else	# gcc
-	# FIXME: Compile a minimal file and determine if the resulting object
-	# file is an ELF file.  If so, gcc can produce 64-bit code.
-	# Do we have file(1) for target?
-	gmp_cv_cc_64bit=no
-      fi
-      ;;
-    mips-sgi-irix6.*)
-      # We use `-n32' to cc and `-mabi=n32' to gcc, resulting in 64-bit
-      # arithmetic but not 64-bit pointers, so the general test for sizeof
-      # (void *) is not valid.
-      # Simply try to compile an empty main.  If that succeeds return
-      # true.
-      cat >conftest.$ac_ext <<EOF
-#line 1689 "configure"
-#include "confdefs.h"
-
-int
-main ()
-{
-
-  ;
-  return 0;
-}
-EOF
-if { (eval echo configure:1700: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
-  rm -rf conftest*
-  gmp_cv_cc_64bit=yes
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  gmp_cv_cc_64bit=no
-fi
-rm -f conftest*
-      ;;
-    *-*-*)
-      # Allocate an array of size sizeof (void *) and use nm to determine its
-      # size.  We depend on the first declared variable being put at address 0.
-      cat >conftest.c <<EOF
-char arr[sizeof (void *)]={0};
-char post=0;
-EOF
-      gmp_compile="$CC $CFLAGS -c conftest.c 1>&5"
-      if { (eval echo configure:1719: \"$gmp_compile\") 1>&5; (eval $gmp_compile) 2>&5; }; then
-        	gmp_tmp_val=`$NM conftest.o | grep post | sed -e 's;[[][0-9][]]\(.*\);\1;' \
-          -e 's;[^1-9]*\([0-9]*\).*;\1;'`
-                if test "$gmp_tmp_val" = "8"; then
-	  gmp_cv_cc_64bit=yes
-	else
-	  gmp_cv_cc_64bit=no
-        fi
-      else
-        echo "configure: failed program was:" >&5
-        cat conftest.$ac_ext >&5
-        gmp_cv_cc_64bit=no
-      fi
-      rm -f conftest*
-      ;;
-  esac
-
-  CC="$gmp_tmp_CC_save"
-  CFLAGS="$gmp_tmp_CFLAGS_save"
-  echo "$ECHO_T""$gmp_cv_cc_64bit" 1>&6
-
-        if test "$gmp_cv_cc_64bit" = "yes"; then
-          test -z "$CC64" && CC64="$c"
-          test -z "$CFLAGS64" && CFLAGS64="$c_flags"
-	  # We have CC64 so we're done.
-          break
-        fi
-      fi
-    else
-      # We have CC32, and we don't need a 64-bit compiler so we're done.
-      break
-    fi
-  fi
-done
-CC="$CC32"
-
-  # If 64-bit OS and we have a 64-bit compiler, use it.
-  if test -n "$os_64bit" && test -n "$CC64"; then
-    CC=$CC64
-    CFLAGS=$CFLAGS64
-  else
-    eval CFLAGS=\$gmp_cflags_$CC
-  fi
-
-  # Try compiler flags that may work with only some compiler versions.
-  # gmp_optcflags: All or nothing.
-  eval optcflags=\$gmp_optcflags_$CC
-  if test -n "$optcflags"; then
-    CFLAGS_save="$CFLAGS"
-    CFLAGS="$CFLAGS $optcflags"
-    echo $ECHO_N "checking whether $CC accepts $optcflags... $ECHO_C" 1>&6
-echo "configure:1770: checking whether $CC accepts $optcflags" 1>&5
-    ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-
-    cat >conftest.$ac_ext <<EOF
-
-#line 1780 "configure"
-#include "confdefs.h"
-
-int main(){return(0);}
-EOF
-if { (eval echo configure:1785: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  optok=yes
-  # If we can't run a trivial program, we are probably using a cross compiler.
-  if (./conftest; exit) 2>/dev/null; then
-    cross=no
-  else
-    cross=yes
-  fi
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  optok=no
-fi
-rm -fr conftest*
-    if test "$optok" = "yes"; then
-      echo "$ECHO_T""yes" 1>&6
-    else
-      echo "$ECHO_T""no" 1>&6
-      CFLAGS="$CFLAGS_save"
-    fi
-  fi
-  # gmp_xoptcflags: First is best, one has to work.
-  eval xoptcflags=\$gmp_xoptcflags_$CC
-  if test -n "$xoptcflags"; then
-    gmp_found="no"
-    for xopt in $xoptcflags; do
-      CFLAGS_save="$CFLAGS"
-      CFLAGS="$CFLAGS $xopt"
-      echo $ECHO_N "checking whether $CC accepts $xopt... $ECHO_C" 1>&6
-echo "configure:1814: checking whether $CC accepts $xopt" 1>&5
-      ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-
-      cat >conftest.$ac_ext <<EOF
-
-#line 1824 "configure"
-#include "confdefs.h"
-
-int main(){return(0);}
-EOF
-if { (eval echo configure:1829: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  optok=yes
-  # If we can't run a trivial program, we are probably using a cross compiler.
-  if (./conftest; exit) 2>/dev/null; then
-    cross=no
-  else
-    cross=yes
-  fi
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  optok=no
-fi
-rm -fr conftest*
-      if test "$optok" = "yes"; then
-        echo "$ECHO_T""yes" 1>&6
-        gmp_found="yes"
-        break
-      else
-        echo "$ECHO_T""no" 1>&6
-        CFLAGS="$CFLAGS_save"
-      fi
-    done
-    if test "$gmp_found" = "no"; then
-      echo "$0: fatal: need a compiler that understands one of $xoptcflags"
-      exit 1
-    fi
-  fi
-fi
-
-# Restore CFLAGS given on command line.
-# FIXME: We've run through quite some unnecessary code looking for a
-# nice compiler and working flags for it, just to spoil that with user
-# supplied flags.
-test -n "$gmp_user_CFLAGS" && CFLAGS="$gmp_user_CFLAGS"
-
-# Select chosen compiler.
-
-echo $ECHO_N "checking whether the C compiler ($CC $CFLAGS $CPPFLAGS $LDFLAGS) works... $ECHO_C" 1>&6
-echo "configure:1868: checking whether the C compiler ($CC $CFLAGS $CPPFLAGS $LDFLAGS) works" 1>&5
-
-ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-
-cat >conftest.$ac_ext <<EOF
-
-#line 1879 "configure"
-#include "confdefs.h"
-
-int main(){return(0);}
-EOF
-if { (eval echo configure:1884: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  ac_cv_prog_cc_works=yes
-  # If we can't run a trivial program, we are probably using a cross compiler.
-  if (./conftest; exit) 2>/dev/null; then
-    ac_cv_prog_cc_cross=no
-  else
-    ac_cv_prog_cc_cross=yes
-  fi
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  ac_cv_prog_cc_works=no
-fi
-rm -fr conftest*
-ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-
-echo "$ECHO_T""$ac_cv_prog_cc_works" 1>&6
-if test $ac_cv_prog_cc_works = no; then
-  { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 77; }
-fi
-echo $ECHO_N "checking whether the C compiler ($CC $CFLAGS $CPPFLAGS $LDFLAGS) is a cross-compiler... $ECHO_C" 1>&6
-echo "configure:1910: checking whether the C compiler ($CC $CFLAGS $CPPFLAGS $LDFLAGS) is a cross-compiler" 1>&5
-echo "$ECHO_T""$ac_cv_prog_cc_cross" 1>&6
-cross_compiling=$ac_cv_prog_cc_cross
-
-echo $ECHO_N "checking whether we are using GNU C... $ECHO_C" 1>&6
-echo "configure:1915: checking whether we are using GNU C" 1>&5
-if test "${ac_cv_prog_gcc+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  cat >conftest.c <<EOF
-#ifdef __GNUC__
-  yes;
-#endif
-EOF
-if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1924: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
-  ac_cv_prog_gcc=yes
-else
-  ac_cv_prog_gcc=no
-fi
-fi
-echo "$ECHO_T""$ac_cv_prog_gcc" 1>&6
-
-if test "$ac_cv_prog_gcc" = "yes"; then
-  GCC=yes
-else
-  GCC=
-fi
-
-# Set CFLAGS if not already set.
-if test -z "$CFLAGS"; then
-  CFLAGS="-g"
-  if test "$GCC" = "yes"; then
-    CFLAGS="$CFLAGS -O2"
-  fi
-fi
-
-if test "${ac_cv_prog_CC+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  ac_cv_prog_CC="$CC"
-fi
-
-# How to assemble.
-CCAS="$CC -c"
-
-echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" 1>&6
-echo "configure:1956: checking how to run the C preprocessor" 1>&5
-# On Suns, sometimes $CPP names a directory.
-if test -n "$CPP" && test -d "$CPP"; then
-  CPP=
-fi
-if test -z "$CPP"; then
-if test "${ac_cv_prog_CPP+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-    # This must be in double quotes, not single quotes, because CPP may get
-  # substituted into the Makefile and "${CC-cc}" will confuse make.
-  CPP="${CC-cc} -E"
-  # On the NeXT, cc -E runs the code through the compiler's parser,
-  # not just through cpp.
-
-cat >conftest.$ac_ext <<EOF
-#line 1972 "configure"
-#include "confdefs.h"
-#include <assert.h>
-Syntax Error
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1978: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
-  :
-else
-  echo "$ac_err" >&5
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  CPP="${CC-cc} -E -traditional-cpp"
-
-cat >conftest.$ac_ext <<EOF
-#line 1990 "configure"
-#include "confdefs.h"
-#include <assert.h>
-Syntax Error
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:1996: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
-  :
-else
-  echo "$ac_err" >&5
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  CPP="${CC-cc} -nologo -E"
-
-cat >conftest.$ac_ext <<EOF
-#line 2008 "configure"
-#include "confdefs.h"
-#include <assert.h>
-Syntax Error
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:2014: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
-  :
-else
-  echo "$ac_err" >&5
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  CPP=/lib/cpp
-fi
-rm -f conftest*
-fi
-rm -f conftest*
-fi
-rm -f conftest*
-  ac_cv_prog_CPP="$CPP"
-fi
-  CPP="$ac_cv_prog_CPP"
-else
-  ac_cv_prog_CPP="$CPP"
-fi
-echo "$ECHO_T""$CPP" 1>&6
-
-# Find a good install program.  We prefer a C program (faster),
-# so one script is as good as another.  But avoid the broken or
-# incompatible versions:
-# SysV /etc/install, /usr/sbin/install
-# SunOS /usr/etc/install
-# IRIX /sbin/install
-# AIX /bin/install
-# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
-# AFS /usr/afsws/bin/install, which mishandles nonexistent args
-# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
-# ./install, which can be erroneously created by make from ./install.sh.
-echo $ECHO_N "checking for a BSD compatible install... $ECHO_C" 1>&6
-echo "configure:2050: checking for a BSD compatible install" 1>&5
-if test -z "$INSTALL"; then
-if test "${ac_cv_path_install+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-    IFS="${IFS= 	}"; ac_save_IFS="$IFS"; IFS=":"
-  for ac_dir in $PATH; do
-    # Account for people who put trailing slashes in PATH elements.
-    case "$ac_dir/" in
-    /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
-    *)
-      # OSF1 and SCO ODT 3.0 have their own names for install.
-      # Don't use installbsd from OSF since it installs stuff as root
-      # by default.
-      for ac_prog in ginstall scoinst install; do
-        if test -f $ac_dir/$ac_prog; then
-	  if test $ac_prog = install &&
-            grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
-	    # AIX install.  It has an incompatible calling convention.
-	    :
-	  elif test $ac_prog = install &&
-	    grep pwplus $ac_dir/$ac_prog >/dev/null 2>&1; then
-	    # program-specific install script used by HP pwplus--don't use.
-	    :
-	  else
-	    ac_cv_path_install="$ac_dir/$ac_prog -c"
-	    break 2
-	  fi
-	fi
-      done
-      ;;
-    esac
-  done
-  IFS="$ac_save_IFS"
-
-fi
-  if test "${ac_cv_path_install+set}" = set; then
-    INSTALL="$ac_cv_path_install"
-  else
-    # As a last resort, use the slow shell script.  We don't cache a
-    # path for INSTALL within a source directory, because that will
-    # break other packages using the cache if that directory is
-    # removed, or if the path is relative.
-    INSTALL="$ac_install_sh"
-  fi
-fi
-echo "$ECHO_T""$INSTALL" 1>&6
-
-# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
-# It thinks the first close brace ends the variable substitution.
-test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
-
-test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
-
-test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
-
-echo $ECHO_N "checking whether ln -s works... $ECHO_C" 1>&6
-echo "configure:2107: checking whether ln -s works" 1>&5
-if test "${ac_cv_prog_LN_S+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  rm -f conftestdata
-if ln -s X conftestdata 2>/dev/null
-then
-  rm -f conftestdata
-  ac_cv_prog_LN_S="ln -s"
-else
-  ac_cv_prog_LN_S=ln
-fi
-fi
-LN_S="$ac_cv_prog_LN_S"
-if test "$ac_cv_prog_LN_S" = "ln -s"; then
-  echo "$ECHO_T""yes" 1>&6
-else
-  echo "$ECHO_T""no" 1>&6
-fi
-
-echo $ECHO_N "checking for suitable m4... $ECHO_C" 1>&6
-echo "configure:2128: checking for suitable m4" 1>&5
-if test "${gmp_cv_prog_m4+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -n "$M4"; then
-  gmp_cv_prog_m4="$M4"
-else
-  cat >conftest.m4 <<\EOF
-define(dollarhash,``$#'')dnl
-ifelse(dollarhash(x),1,`define(t1,Y)',
-``bad: $# not supported (SunOS /usr/bin/m4)
-'')dnl
-ifelse(eval(89),89,`define(t2,Y)',
-`bad: eval() doesnt support 8 or 9 in a constant (OpenBSD 2.6 m4)
-')dnl
-ifelse(t1`'t2,YY,`good
-')dnl
-EOF
-  echo "trying m4" 1>&5
-  gmp_tmp_val="`(m4 conftest.m4) 2>&5`"
-  echo "$gmp_tmp_val" 1>&5
-  if test "$gmp_tmp_val" = good; then
-    gmp_cv_prog_m4="m4"
-  else
-    IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
-    ac_dummy="$PATH:/usr/5bin"
-    for ac_dir in $ac_dummy; do
-      test -z "$ac_dir" && ac_dir=.
-      echo "trying $ac_dir/m4" 1>&5
-      gmp_tmp_val="`($ac_dir/m4 conftest.m4) 2>&5`"
-      echo "$gmp_tmp_val" 1>&5
-      if test "$gmp_tmp_val" = good; then
-        gmp_cv_prog_m4="$ac_dir/m4"
-        break
-      fi
-    done
-    IFS="$ac_save_ifs"
-    if test -z "$gmp_cv_prog_m4"; then
-      { echo "configure: error: No usable m4 in \$PATH or /usr/5bin (see config.log for reasons)." 1>&2; exit 1; }
-    fi
-  fi
-  rm -f conftest.m4
-fi
-fi
-echo "$ECHO_T""$gmp_cv_prog_m4" 1>&6
-M4="$gmp_cv_prog_m4"
-
-# Extract the first word of "ar", so it can be a program name with args.
-set dummy ar; ac_word=$2
-echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
-echo "configure:2178: checking for $ac_word" 1>&5
-if test "${ac_cv_prog_AR+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -n "$AR"; then
-  ac_cv_prog_AR="$AR" # Let the user override the test.
-else
-  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
-ac_dummy="$PATH"
-for ac_dir in $ac_dummy; do
-  test -z "$ac_dir" && ac_dir=.
-  if test -f $ac_dir/$ac_word; then
-    echo "$ac_dir/$ac_word"
-  fi
-done
-IFS="$ac_save_ifs"
-`; do
-    ac_cv_prog_AR="ar"
-    break
-  done
-fi
-fi
-AR="$ac_cv_prog_AR"
-if test -n "$AR"; then
-  echo "$ECHO_T""$AR" 1>&6
-else
-  echo "$ECHO_T""no" 1>&6
-fi
-
-# ar on AIX needs to know the object file format
-case "$target" in
-  powerpc64*-*-aix*)
-    AR="$AR -X 64"
-    ;;
-esac
-
-if test "$gmp_no_asm_syntax_testing" != "yes"; then
-  echo $ECHO_N "checking how to switch to text section... $ECHO_C" 1>&6
-echo "configure:2216: checking how to switch to text section" 1>&5
-if test "${gmp_cv_check_asm_text+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  case "$target" in
-  *-*-aix*)
-
-    gmp_cv_check_asm_text=".csect .text[PR]"
-
-    ;;
-  *-*-hpux*) gmp_cv_check_asm_text=".code" ;;
-  *) gmp_cv_check_asm_text=".text" ;;
-esac
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_text" 1>&6
-echo "define(<TEXT>, <$gmp_cv_check_asm_text>)" >> $gmp_tmpconfigm4
-
-  echo $ECHO_N "checking how to switch to data section... $ECHO_C" 1>&6
-echo "configure:2235: checking how to switch to data section" 1>&5
-if test "${gmp_cv_check_asm_data+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  case "$target" in
-  *-*-aix*)
-
-    gmp_cv_check_asm_data=".csect .data[RW]"
-
-    ;;
-  *) gmp_cv_check_asm_data=".data" ;;
-esac
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_data" 1>&6
-echo "define(<DATA>, <$gmp_cv_check_asm_data>)" >> $gmp_tmpconfigm4
-
-  echo $ECHO_N "checking how to export a symbol... $ECHO_C" 1>&6
-echo "configure:2253: checking how to export a symbol" 1>&5
-if test "${gmp_cv_check_asm_globl+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  case "$target" in
-  *-*-hpux*) gmp_cv_check_asm_globl=".export" ;;
-  *) gmp_cv_check_asm_globl=".globl" ;;
-esac
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_globl" 1>&6
-echo "define(<GLOBL>, <$gmp_cv_check_asm_globl>)" >> $gmp_tmpconfigm4
-
-  echo $ECHO_N "checking what assembly label suffix to use... $ECHO_C" 1>&6
-echo "configure:2267: checking what assembly label suffix to use" 1>&5
-if test "${gmp_cv_check_asm_label_suffix+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  case "$target" in
-  *-*-hpux*) gmp_cv_check_asm_label_suffix="" ;;
-  *) gmp_cv_check_asm_label_suffix=":" ;;
-esac
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_label_suffix" 1>&6
-echo "define(<LABEL_SUFFIX>, <\$1$gmp_cv_check_asm_label_suffix>)" >> $gmp_tmpconfigm4
-
-  echo $ECHO_N "checking how the .type assembly directive should be used... $ECHO_C" 1>&6
-echo "configure:2281: checking how the .type assembly directive should be used" 1>&5
-if test "${gmp_cv_check_asm_type+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
-for gmp_tmp_prefix in @ \# %; do
-  echo "	.type	sym,${gmp_tmp_prefix}function" > conftest.s
-  if { (eval echo configure:2288: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
-    gmp_cv_check_asm_type=".type	\$1,${gmp_tmp_prefix}\$2"
-    break
-  fi
-done
-if test -z "$gmp_cv_check_asm_type"; then
-  gmp_cv_check_asm_type="dnl"
-fi
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_type" 1>&6
-echo "define(<TYPE>, <$gmp_cv_check_asm_type>)" >> $gmp_tmpconfigm4
-
-  echo $ECHO_N "checking if the .size assembly directive works... $ECHO_C" 1>&6
-echo "configure:2302: checking if the .size assembly directive works" 1>&5
-if test "${gmp_cv_check_asm_size+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
-echo '	.size	sym,1' > conftest.s
-if { (eval echo configure:2308: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
-  gmp_cv_check_asm_size=".size	\$1,\$2"
-else
-  gmp_cv_check_asm_size="dnl"
-fi
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_size" 1>&6
-echo "define(<SIZE>, <$gmp_cv_check_asm_size>)" >> $gmp_tmpconfigm4
-
-echo $ECHO_N "checking what prefix to use for a local label... $ECHO_C" 1>&6
-echo "configure:2319: checking what prefix to use for a local label" 1>&5
-if test "${gmp_cv_check_asm_lsym_prefix+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -z "$NM"; then
-  echo; echo "GMP_CHECK_ASM_LSYM_PREFIX: fatal: need nm"
-  exit 1
-fi
-ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
-gmp_cv_check_asm_lsym_prefix="L"
-for gmp_tmp_pre in L .L $ L$; do
-  cat > conftest.s <<EOF
-dummy${gmp_cv_check_asm_label_suffix}
-${gmp_tmp_pre}gurkmacka${gmp_cv_check_asm_label_suffix}
-	.byte 0
-EOF
-  if { (eval echo configure:2335: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
-    $NM conftest.o >/dev/null 2>&1
-    gmp_rc=$?
-    if test "$gmp_rc" != "0"; then
-      echo "configure: $NM failure, using default"
-      break
-    fi
-    if $NM conftest.o | grep gurkmacka >/dev/null; then true; else
-      gmp_cv_check_asm_lsym_prefix="$gmp_tmp_pre"
-      break
-    fi
-  else
-    echo "configure: failed program was:" >&5
-    cat conftest.s >&5
-    # Use default.
-  fi
-done
-rm -f conftest*
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_lsym_prefix" 1>&6
-echo "define(<LSYM_PREFIX>, <${gmp_cv_check_asm_lsym_prefix}>)" >> $gmp_tmpconfigm4
-
-echo $ECHO_N "checking how to define a 32-bit word... $ECHO_C" 1>&6
-echo "configure:2359: checking how to [define] a 32-bit word" 1>&5
-if test "${gmp_cv_check_asm_w32+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -z "$NM"; then
-  echo; echo "configure: GMP_CHECK_ASM_W32: fatal: need nm"
-  exit 1
-fi
-
-# FIXME: HPUX puts first symbol at 0x40000000, breaking our assumption
-# that it's at 0x0.  We'll have to declare another symbol before the
-# .long/.word and look at the distance between the two symbols.  The
-# only problem is that the sed expression(s) barfs (on Solaris, for
-# example) for the symbol with value 0.  For now, HPUX uses .word.
-
-case "$target" in
-  *-*-hpux*)
-    gmp_cv_check_asm_w32=".word"
-    ;;
-  *-*-*)
-    ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
-    for gmp_tmp_op in .long .word; do
-      cat > conftest.s <<EOF
-	$gmp_cv_check_asm_data
-	$gmp_cv_check_asm_globl	foo
-	$gmp_tmp_op	0
-foo${gmp_cv_check_asm_label_suffix}
-	.byte	0
-EOF
-      if { (eval echo configure:2388: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
-
-        gmp_tmp_val=`$NM conftest.o | grep foo | sed -e 's;[[][0-9][]]\(.*\);\1;' \
-             -e 's;[^1-9]*\([0-9]*\).*;\1;'`
-                if test "$gmp_tmp_val" = "4"; then
-          gmp_cv_check_asm_w32="$gmp_tmp_op"
-          break
-        fi
-      fi
-    done
-    ;;
-esac
-
-if test -z "$gmp_cv_check_asm_w32"; then
-  echo; echo "configure: GMP_CHECK_ASM_W32: fatal: do not know how to define a 32-bit word"
-  exit 1
-fi
-rm -f conftest*
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_w32" 1>&6
-echo "define(<W32>, <$gmp_cv_check_asm_w32>)" >> $gmp_tmpconfigm4
-
-  echo $ECHO_N "checking if symbols are prefixed by underscore... $ECHO_C" 1>&6
-echo "configure:2412: checking if symbols are prefixed by underscore" 1>&5
-if test "${gmp_cv_check_asm_underscore+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  cat > conftest.$ac_ext <<EOF
-#line 2417 "configure"
-#include "confdefs.h"
-int underscore_test() {
-return; }
-EOF
-if { (eval echo configure:2422: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
-  if grep _underscore_test conftest* >/dev/null; then
-    gmp_cv_check_asm_underscore=yes
-  else
-    gmp_cv_check_asm_underscore=no
-  fi
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-fi
-rm -f conftest*
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_underscore" 1>&6
-if test "$gmp_cv_check_asm_underscore" = "yes"; then
-
-echo 'define(<GSYM_PREFIX>, <_>)' >> $gmp_tmpconfigm4
-
-  underscore=yes
-else
-
-echo 'define(<GSYM_PREFIX>, <>)' >> $gmp_tmpconfigm4
-
-  underscore=no
-fi
-
-echo $ECHO_N "checking if .align assembly directive is logarithmic... $ECHO_C" 1>&6
-echo "configure:2449: checking if .align assembly directive is logarithmic" 1>&5
-if test "${gmp_cv_check_asm_align_log+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -z "$NM"; then
-  echo; echo "configure: GMP_CHECK_ASM_ALIGN_LOG: fatal: need nm"
-  exit 1
-fi
-cat > conftest.s <<EOF
-      	$gmp_cv_check_asm_data
-      	.align  4
-	$gmp_cv_check_asm_globl	foo
-	.byte	1
-	.align	4
-foo$gmp_cv_check_asm_label_suffix
-	.byte	2
-EOF
-ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
-if { (eval echo configure:2467: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
-
-  gmp_tmp_val=`$NM conftest.o | grep foo | sed -e 's;[[][0-9][]]\(.*\);\1;' \
-       -e 's;[^1-9]*\([0-9]*\).*;\1;'`
-    if test "$gmp_tmp_val" = "10" || test "$gmp_tmp_val" = "16"; then
-    gmp_cv_check_asm_align_log=yes
-  else
-    gmp_cv_check_asm_align_log=no
-  fi
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.s >&5
-fi
-rm -f conftest*
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_align_log" 1>&6
-
-echo "define(<ALIGN_LOGARITHMIC>,<$gmp_cv_check_asm_align_log>)" >> $gmp_tmpconfigm4
-
-if test "$gmp_cv_check_asm_align_log" = "yes"; then
-  asm_align=log
-else
-  asm_align=nolog
-fi
-
-fi
-
-family=generic
-
-case ${target} in
-  arm*-*-*)
-    path="arm"
-    ;;
-  sparcv9*-*-solaris2.[789]* | sparc64*-*-solaris2.[789]* | ultrasparc*-*-solaris2.[789]*)
-    if test -n "$CC64"
-      then path="sparc64"
-      else path="sparc32/v9 sparc32/v8 sparc32"
-    fi
-    ;;
-  sparc64-*-linux*)
-    if test -n "$CC64"
-      then path="sparc64"
-      else path="sparc32/v9 sparc32/v8 sparc32"
-    fi
-    ;;
-  sparcv8*-*-* | microsparc*-*-*)
-	path="sparc32/v8 sparc32"
-	if test x${floating_point} = xno
-	  then extra_functions="udiv_nfp"
-	  else extra_functions="udiv_fp"
-	fi
-	;;
-  sparcv9*-*-* | ultrasparc*-*-*)
-	path="sparc32/v9 sparc32/v8 sparc32"
-	extra_functions="udiv_fp"
-	;;
-  supersparc*-*-*)
-	path="sparc32/v8/supersparc sparc32/v8 sparc32"
-	extra_functions="udiv"
-	;;
-  sparc*-*-*) path="sparc32"
-	if test x${floating_point} = xno
-	  then extra_functions="udiv_nfp"
-	  else extra_functions="udiv_fp"
-	fi
-	;;
-  hppa7000*-*-*)
-    path="hppa/hppa1_1 hppa"
-    extra_functions="udiv_qrnnd"
-    ;;
-  hppa1.0*-*-*)
-    path="hppa"
-    extra_functions="udiv_qrnnd"
-    ;;
-  hppa2.0w-*-*)
-    path="pa64w"
-    extra_functions="umul_ppmm udiv_qrnnd"
-    ;;
-  hppa2.0*-*-*)
-    if test -n "$CC64"; then
-      path="pa64"
-      extra_functions="umul_ppmm udiv_qrnnd"
-      # We need to use the system compiler, or actually the system assembler,
-      # since GAS has not been ported to understand the 2.0 instructions.
-      CCAS="$CC64 -c"
-    else
-      # FIXME: path should be "hppa/hppa2_0 hppa/hppa1_1 hppa"
-      path="hppa/hppa1_1 hppa"
-      extra_functions="udiv_qrnnd"
-    fi
-    ;;
-  hppa*-*-*)					#assume pa7100
-    path="hppa/hppa1_1/pa7100 hppa/hppa1_1 hppa"
-    extra_functions="udiv_qrnnd";;
-  f30[01]-fujitsu-sysv*)
-    path=fujitsu;;
-  alphaev6*-*-*) path="alpha/ev6 alpha"; extra_functions="invert_limb cntlz";;
-  alphaev5*-*-*) path="alpha/ev5 alpha"; extra_functions="invert_limb cntlz";;
-  alpha*-*-*) path="alpha"; extra_functions="invert_limb cntlz";;
-  # Cray vector machines.  This must come after alpha* so that we can
-  # recognize present and future vector processors with a wildcard.
-  *-cray-unicos*)
-    path="cray"
-    extra_functions="mulww";;
-  am29000*-*-*) path="a29k";;
-  a29k*-*-*) path="a29k";;
-
-  # AMD and Intel x86 configurations
-
-  i?86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-*)
-    gmp_m4postinc="x86/x86-defs.m4"
-    extra_functions="udiv umul"
-    CALLING_CONVENTIONS_OBJS="x86call.o x86check.o"
-
-echo $ECHO_N "checking if the assembler takes cl with shldl... $ECHO_C" 1>&6
-echo "configure:2583: checking if the assembler takes cl with shldl" 1>&5
-if test "${gmp_cv_check_asm_shldl_cl+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  cat > conftest.s <<EOF
-	$gmp_cv_check_asm_text
-	shldl	%cl, %eax, %ebx
-EOF
-ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
-if { (eval echo configure:2592: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
-  gmp_cv_check_asm_shldl_cl=yes
-else
-  gmp_cv_check_asm_shldl_cl=no
-fi
-rm -f conftest*
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_shldl_cl" 1>&6
-if test "$gmp_cv_check_asm_shldl_cl" = "yes"; then
-
-echo 'define(<WANT_SHLDL_CL>, <1>)' >> $gmp_tmpconfigm4
-
-else
-
-echo 'define(<WANT_SHLDL_CL>, <0>)' >> $gmp_tmpconfigm4
-
-fi
-
-    echo $ECHO_N "checking if the .align directive accepts an 0x90 fill in .text... $ECHO_C" 1>&6
-echo "configure:2612: checking if the .align directive accepts an 0x90 fill in .text" 1>&5
-if test "${gmp_cv_check_asm_align_fill_0x90+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-
-cat > conftest.s <<EOF
-      	$gmp_cv_check_asm_text
-      	.align  4, 0x90
-	.byte   0
-      	.align  4, 0x90
-EOF
-gmp_tmp_val="`$CCAS $CFLAGS conftest.s 2>&1`"
-if test $? = 0; then
-  echo "$gmp_tmp_val" 1>&5
-  if echo "$gmp_tmp_val" | grep "Warning: Fill parameter ignored for executable section"; then
-    echo "Supressing this warning by omitting 0x90" 1>&5
-    gmp_cv_check_asm_align_fill_0x90=no
-  else
-    gmp_cv_check_asm_align_fill_0x90=yes
-  fi
-else
-  echo "Non-zero exit code" 1>&5
-  echo "$gmp_tmp_val" 1>&5
-  gmp_cv_check_asm_align_fill_0x90=no
-fi
-rm -f conftest*
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_align_fill_0x90" 1>&6
-
-echo "define(<ALIGN_FILL_0x90>,<$gmp_cv_check_asm_align_fill_0x90>)" >> $gmp_tmpconfigm4
-
-    # the CPUs below wanting to know about mmx
-    case ${target} in
-      pentiummmx-*-* | pentium[23]-*-* | k6*-*-* | athlon-*-*)
-
-echo $ECHO_N "checking if the assembler knows about MMX instructions... $ECHO_C" 1>&6
-echo "configure:2649: checking if the assembler knows about MMX instructions" 1>&5
-if test "${gmp_cv_check_asm_mmx+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  cat > conftest.s <<EOF
-	$gmp_cv_check_asm_text
-	por	%mm0, %mm0
-EOF
-ac_assemble="$CCAS $CFLAGS conftest.s 1>&5"
-if { (eval echo configure:2658: \"$ac_assemble\") 1>&5; (eval $ac_assemble) 2>&5; }; then
-  gmp_cv_check_asm_mmx=yes
-else
-  gmp_cv_check_asm_mmx=no
-fi
-rm -f conftest*
-
-fi
-echo "$ECHO_T""$gmp_cv_check_asm_mmx" 1>&6
-if test "$gmp_cv_check_asm_mmx" = "yes"; then
-  tmp_mmx=yes
-else
-  echo "configure: warning: +----------------------------------------------------------" 1>&2
-  echo "configure: warning: | WARNING WARNING WARNING" 1>&2
-  echo "configure: warning: | Target CPU has MMX code, but it can't be assembled by" 1>&2
-  echo "configure: warning: |     $CCAS $CFLAGS" 1>&2
-  echo "configure: warning: | Non-MMX replacements will be used." 1>&2
-  echo "configure: warning: | This will be an inferior build." 1>&2
-  echo "configure: warning: +----------------------------------------------------------" 1>&2
-  tmp_mmx=no
-fi
-
-        ;;
-    esac
-
-    # default for anything not otherwise mentioned
-    path="x86"
-
-    case ${target} in
-      i[34]86*-*-*)
-        path="x86"
-        ;;
-      k5*-*-*)
-        # don't know what best suits k5
-        path="x86"
-        ;;
-      i586*-*-* | pentium-*-*)
-	path="x86/pentium x86"
-        ;;
-      pentiummmx-*-*)
-	path="x86/pentium x86"
-	if test "$tmp_mmx" = yes; then
-          path="x86/pentium/mmx $path"
-        fi
-        ;;
-      i686*-*-* | pentiumpro-*-*)
-	path="x86/p6 x86"
-        ;;
-      pentium2-*-*)
-	path="x86/p6 x86"
-	# The pentium/mmx lshift and rshift are good on p6 and can be used
-        # until there's something specific for p6.
-	if test "$tmp_mmx" = yes; then
-          path="x86/p6/mmx x86/pentium/mmx $path"
-        fi
-        ;;
-      pentium3-*-*)
-	path="x86/p6 x86"
-	# The pentium/mmx lshift and rshift are good on p6 and can be used
-        # until there's something specific for p6.
-	if test "$tmp_mmx" = yes; then
-          path="x86/p6/p3mmx x86/p6/mmx x86/pentium/mmx $path"
-        fi
-        ;;
-      k6[23]*-*-*)
-	path="x86/k6 x86"
-	if test "$tmp_mmx" = yes; then
-          path="x86/k6/k62mmx x86/k6/mmx $path"
-        fi
-        ;;
-      k6*-*-*)
-	path="x86/k6 x86"
-	if test "$tmp_mmx" = yes; then
-          path="x86/k6/mmx $path"
-        fi
-        ;;
-      athlon-*-*)
-	path="x86/k7 x86"
-	if test "$tmp_mmx" = yes; then
-          path="x86/k7/mmx $path"
-        fi
-        ;;
-    esac
-    ;;
-
-  i960*-*-*) path="i960";;
-
-  ia64*-*-*) path="ia64";;
-
-# Motorola 68k configurations.  Let m68k mean 68020-68040.
-  m680[234]0*-*-* | m68k*-*-* | \
-  m68*-next-nextstep*)		# Nexts are at least '020
-    path="m68k/mc68020 m68k"
-    family=m68k
-    ;;
-  m68000*-*-*)
-    path="m68k"
-    family=m68k
-    ;;
-
-  m88k*-*-* | m88k*-*-*) path="m88k";;
-  m88110*-*-*) path="m88k/mc88110 m88k";;
-  ns32k*-*-*) path="ns32k";;
-
-  pyramid-*-*) path="pyr";;
-
-  ppc601-*-*) path="power powerpc32";;
-  powerpc64*-*-*) path="powerpc64";;
-  powerpc*-*-*) path="powerpc32";;
-  rs6000-*-* | power-*-* | power2-*-*)
-    path="power"
-    extra_functions="udiv_w_sdiv"
-    ;;
-
-  sh-*-*) path="sh";;
-  sh2-*-*) path="sh/sh2 sh";;
-
-  mips[34]*-*-*) path="mips3";;
-  mips*-*-irix6*) path="mips3";;
-  mips*-*-*) path="mips2";;
-
-  vax*-*-*) path="vax"; extra_functions="udiv_w_sdiv";;
-
-  z8000x*-*-*) path="z8000x"; extra_functions="udiv_w_sdiv";;
-  z8000*-*-*) path="z8000"; extra_functions="udiv_w_sdiv";;
-
-  clipper*-*-*) path="clipper";;
-esac
-
-if test -n "$CALLING_CONVENTIONS_OBJS"; then
-  cat >>confdefs.h <<\EOF
-#define HAVE_CALLING_CONVENTIONS 1
-EOF
-
-fi
-
-case ${target} in
-  i[5-8]86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-*)
-    # rdtsc is in pentium and up, not in i386 and i486
-    SPEED_CYCLECOUNTER_OBJS=pentium.lo
-    ;;
-  alpha*-*-*)
-    SPEED_CYCLECOUNTER_OBJS=alpha.lo
-    ;;
-  sparcv9*-*-* | ultrasparc*-*-* | sparc64*-*-*)
-    SPEED_CYCLECOUNTER_OBJS=sparcv9.lo
-    ;;
-  hppa2*-*-*)
-    SPEED_CYCLECOUNTER_OBJS=hppa2.lo
-    ;;
-  hppa*-*-*)
-    SPEED_CYCLECOUNTER_OBJS=hppa.lo
-    ;;
-esac
-
-if test -n "$SPEED_CYCLECOUNTER_OBJS"
-then
-  cat >>confdefs.h <<\EOF
-#define HAVE_SPEED_CYCLECOUNTER 1
-EOF
-
-fi
-
-echo $ECHO_N "checking for Cygwin environment... $ECHO_C" 1>&6
-echo "configure:2822: checking for Cygwin environment" 1>&5
-if test "${ac_cv_cygwin+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  cat >conftest.$ac_ext <<EOF
-#line 2827 "configure"
-#include "confdefs.h"
-
-int
-main ()
-{
-#ifndef __CYGWIN__
-# define __CYGWIN__ __CYGWIN32__
-#endif
-return __CYGWIN__;
-  ;
-  return 0;
-}
-EOF
-if { (eval echo configure:2841: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
-  rm -rf conftest*
-  ac_cv_cygwin=yes
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  ac_cv_cygwin=no
-fi
-rm -f conftest*
-fi
-echo "$ECHO_T""$ac_cv_cygwin" 1>&6
-CYGWIN=
-test "$ac_cv_cygwin" = yes && CYGWIN=yes
-echo $ECHO_N "checking for mingw32 environment... $ECHO_C" 1>&6
-echo "configure:2856: checking for mingw32 environment" 1>&5
-if test "${ac_cv_mingw32+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  cat >conftest.$ac_ext <<EOF
-#line 2861 "configure"
-#include "confdefs.h"
-
-int
-main ()
-{
-return __MINGW32__;
-  ;
-  return 0;
-}
-EOF
-if { (eval echo configure:2872: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
-  rm -rf conftest*
-  ac_cv_mingw32=yes
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  ac_cv_mingw32=no
-fi
-rm -f conftest*
-fi
-echo "$ECHO_T""$ac_cv_mingw32" 1>&6
-MINGW32=
-test "$ac_cv_mingw32" = yes && MINGW32=yes
-echo $ECHO_N "checking for EMX OS/2 environment... $ECHO_C" 1>&6
-echo "configure:2887: checking for EMX OS/2 environment" 1>&5
-if test "${ac_cv_emxos2+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  cat >conftest.$ac_ext <<EOF
-#line 2892 "configure"
-#include "confdefs.h"
-
-int
-main ()
-{
-return __EMX__;
-  ;
-  return 0;
-}
-EOF
-if { (eval echo configure:2903: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
-  rm -rf conftest*
-  ac_cv_emxos2=yes
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  ac_cv_emxos2=no
-fi
-rm -f conftest*
-fi
-echo "$ECHO_T""$ac_cv_emxos2" 1>&6
-EMXOS2=
-test "$ac_cv_emxos2" = yes && EMXOS2=yes
-
-echo $ECHO_N "checking for executable suffix... $ECHO_C" 1>&6
-echo "configure:2919: checking for executable suffix" 1>&5
-if test "${ac_cv_exeext+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test "$CYGWIN" = yes || test "$MINGW32" = yes || test "$EMXOS2" = yes; then
-  ac_cv_exeext=.exe
-else
-  rm -f conftest*
-  echo 'int main () { return 0; }' >conftest.$ac_ext
-  ac_cv_exeext=
-  if { (eval echo configure:2929: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
-    for ac_file in conftest.*; do
-      case $ac_file in
-      *.c | *.C | *.o | *.obj | *.xcoff) ;;
-      *) ac_cv_exeext=`echo $ac_file | sed -e s/conftest//` ;;
-      esac
-    done
-  else
-    { echo "configure: error: installation or configuration problem: compiler cannot create executables." 1>&2; exit 1; }
-  fi
-  rm -f conftest*
-  test x"${ac_cv_exeext}" = x && ac_cv_exeext=no
-fi
-fi
-
-EXEEXT=""
-test x"${ac_cv_exeext}" != xno && EXEEXT=${ac_cv_exeext}
-echo "$ECHO_T""${ac_cv_exeext}" 1>&6
-ac_exeext=$EXEEXT
-
-echo $ECHO_N "checking for object suffix... $ECHO_C" 1>&6
-echo "configure:2950: checking for object suffix" 1>&5
-if test "${ac_cv_objext+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  rm -f conftest*
-echo 'int i = 1;' >conftest.$ac_ext
-if { (eval echo configure:2956: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
-  for ac_file in conftest.*; do
-    case $ac_file in
-    *.c) ;;
-    *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;;
-    esac
-  done
-else
-  { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; }
-fi
-rm -f conftest*
-fi
-
-echo "$ECHO_T""$ac_cv_objext" 1>&6
-OBJEXT=$ac_cv_objext
-ac_objext=$ac_cv_objext
-
-case "$target" in
-  *-*-aix4.[3-9]*) enable_shared=no ;;
-esac
-# Check whether --enable-shared or --disable-shared was given.
-if test "${enable_shared+set}" = set; then
-  enableval="$enable_shared"
-  p=${PACKAGE-default}
-case "$enableval" in
-yes) enable_shared=yes ;;
-no) enable_shared=no ;;
-*)
-  enable_shared=no
-  # Look at the argument we got.  We use all the common list separators.
-  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
-  for pkg in $enableval; do
-    if test "X$pkg" = "X$p"; then
-      enable_shared=yes
-    fi
-  done
-  IFS="$ac_save_ifs"
-  ;;
-esac
-else
-  enable_shared=yes
-fi
-# Check whether --enable-static or --disable-static was given.
-if test "${enable_static+set}" = set; then
-  enableval="$enable_static"
-  p=${PACKAGE-default}
-case "$enableval" in
-yes) enable_static=yes ;;
-no) enable_static=no ;;
-*)
-  enable_static=no
-  # Look at the argument we got.  We use all the common list separators.
-  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
-  for pkg in $enableval; do
-    if test "X$pkg" = "X$p"; then
-      enable_static=yes
-    fi
-  done
-  IFS="$ac_save_ifs"
-  ;;
-esac
-else
-  enable_static=yes
-fi
-# Check whether --enable-fast-install or --disable-fast-install was given.
-if test "${enable_fast_install+set}" = set; then
-  enableval="$enable_fast_install"
-  p=${PACKAGE-default}
-case "$enableval" in
-yes) enable_fast_install=yes ;;
-no) enable_fast_install=no ;;
-*)
-  enable_fast_install=no
-  # Look at the argument we got.  We use all the common list separators.
-  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}:,"
-  for pkg in $enableval; do
-    if test "X$pkg" = "X$p"; then
-      enable_fast_install=yes
-    fi
-  done
-  IFS="$ac_save_ifs"
-  ;;
-esac
-else
-  enable_fast_install=yes
-fi
-
-echo $ECHO_N "checking build system type... $ECHO_C" 1>&6
-echo "configure:3044: checking build system type" 1>&5
-if test "x$ac_cv_build" = "x" || (test "x$build" != "xNONE" && test "x$build" != "x$ac_cv_build_alias"); then
-
-  # Make sure we can run config.sub.
-  if $ac_config_sub sun4 >/dev/null 2>&1; then :; else
-    { echo "configure: error: cannot run $ac_config_sub" 1>&2; exit 1; }
-  fi
-
-  ac_cv_build_alias=$build
-  case "$ac_cv_build_alias" in
-  NONE)
-    case $nonopt in
-    NONE)
-      ac_cv_build_alias=$host_alias ;;
-    *) ac_cv_build_alias=$nonopt ;;
-    esac ;;
-  esac
-
-  ac_cv_build=`$ac_config_sub $ac_cv_build_alias` || exit 1
-  ac_cv_build_cpu=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-  ac_cv_build_vendor=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-  ac_cv_build_os=`echo $ac_cv_build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-else
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-fi
-
-echo "$ECHO_T""$ac_cv_build" 1>&6
-
-build=$ac_cv_build
-build_alias=$ac_cv_build_alias
-build_cpu=$ac_cv_build_cpu
-build_vendor=$ac_cv_build_vendor
-build_os=$ac_cv_build_os
-
-# Check whether --with-gnu-ld or --without-gnu-ld was given.
-if test "${with_gnu_ld+set}" = set; then
-  withval="$with_gnu_ld"
-  test "$withval" = no || with_gnu_ld=yes
-else
-  with_gnu_ld=no
-fi
-
-ac_prog=ld
-if test "$ac_cv_prog_gcc" = yes; then
-  # Check if gcc -print-prog-name=ld gives a path.
-  echo $ECHO_N "checking for ld used by GCC... $ECHO_C" 1>&6
-echo "configure:3090: checking for ld used by GCC" 1>&5
-  case $target in
-  *-*-mingw*)
-    # gcc leaves a trailing carriage return which upsets mingw
-    ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;;
-  *)
-    ac_prog=`($CC -print-prog-name=ld) 2>&5` ;;
-  esac
-  case "$ac_prog" in
-    # Accept absolute paths.
-    [\\/]* | [A-Za-z]:[\\/]*)
-      re_direlt='/[^/][^/]*/\.\./'
-      # Canonicalize the path of ld
-      ac_prog=`echo $ac_prog| sed 's%\\\\%/%g'`
-      while echo $ac_prog | grep "$re_direlt" > /dev/null 2>&1; do
-	ac_prog=`echo $ac_prog| sed "s%$re_direlt%/%"`
-      done
-      test -z "$LD" && LD="$ac_prog"
-      ;;
-  "")
-    # If it fails, then pretend we aren't using GCC.
-    ac_prog=ld
-    ;;
-  *)
-    # If it is relative, then search for the first ld in PATH.
-    with_gnu_ld=unknown
-    ;;
-  esac
-elif test "$with_gnu_ld" = yes; then
-  echo $ECHO_N "checking for GNU ld... $ECHO_C" 1>&6
-echo "configure:3120: checking for GNU ld" 1>&5
-else
-  echo $ECHO_N "checking for non-GNU ld... $ECHO_C" 1>&6
-echo "configure:3123: checking for non-GNU ld" 1>&5
-fi
-if test "${ac_cv_path_LD+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -z "$LD"; then
-  IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR-:}"
-  for ac_dir in $PATH; do
-    test -z "$ac_dir" && ac_dir=.
-    if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then
-      ac_cv_path_LD="$ac_dir/$ac_prog"
-      # Check to see if the program is GNU ld.  I'd rather use --version,
-      # but apparently some GNU ld's only accept -v.
-      # Break only if it was the GNU/non-GNU ld that we prefer.
-      if "$ac_cv_path_LD" -v 2>&1 < /dev/null | egrep '(GNU|with BFD)' > /dev/null; then
-	test "$with_gnu_ld" != no && break
-      else
-	test "$with_gnu_ld" != yes && break
-      fi
-    fi
-  done
-  IFS="$ac_save_ifs"
-else
-  ac_cv_path_LD="$LD" # Let the user override the test with a path.
-fi
-fi
-
-LD="$ac_cv_path_LD"
-if test -n "$LD"; then
-  echo "$ECHO_T""$LD" 1>&6
-else
-  echo "$ECHO_T""no" 1>&6
-fi
-test -z "$LD" && { echo "configure: error: no acceptable ld found in \$PATH" 1>&2; exit 1; }
-echo $ECHO_N "checking if the linker ($LD) is GNU ld... $ECHO_C" 1>&6
-echo "configure:3158: checking if the linker ($LD) is GNU ld" 1>&5
-if test "${ac_cv_prog_gnu_ld+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  # I'd rather use --version here, but apparently some GNU ld's only accept -v.
-if $LD -v 2>&1 </dev/null | egrep '(GNU|with BFD)' 1>&5; then
-  ac_cv_prog_gnu_ld=yes
-else
-  ac_cv_prog_gnu_ld=no
-fi
-fi
-echo "$ECHO_T""$ac_cv_prog_gnu_ld" 1>&6
-with_gnu_ld=$ac_cv_prog_gnu_ld
-
-echo $ECHO_N "checking for $LD option to reload object files... $ECHO_C" 1>&6
-echo "configure:3173: checking for $LD option to reload object files" 1>&5
-if test "${lt_cv_ld_reload_flag+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  lt_cv_ld_reload_flag='-r'
-fi
-echo "$ECHO_T""$lt_cv_ld_reload_flag" 1>&6
-reload_flag=$lt_cv_ld_reload_flag
-test -n "$reload_flag" && reload_flag=" $reload_flag"
-
-echo $ECHO_N "checking how to recognise dependant libraries... $ECHO_C" 1>&6
-echo "configure:3184: checking how to recognise dependant libraries" 1>&5
-if test "${lt_cv_deplibs_check_method+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  lt_cv_file_magic_cmd='${MAGIC}'
-lt_cv_file_magic_test_file=
-lt_cv_deplibs_check_method='unknown'
-# Need to set the preceding variable on all platforms that support
-# interlibrary dependencies.
-# 'none' -- dependencies not supported.
-# `unknown' -- same as none, but documents that we really don't know.
-# 'pass_all' -- all dependencies passed with no checks.
-# 'test_compile' -- check by making test program.
-# 'file_magic [regex]' -- check by looking for files in library path
-# which responds to the $file_magic_cmd with a given egrep regex.
-# If you have `file' or equivalent on your system and you're not sure
-# whether `pass_all' will *always* work, you probably want this one.
-
-case "$host_os" in
-aix4* | beos*)
-  lt_cv_deplibs_check_method=pass_all
-  ;;
-
-bsdi4*)
-    lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)'
-    lt_cv_file_magic_test_file=/shlib/libc.so
-  ;;
-
-cygwin* | mingw*)
-  lt_cv_deplibs_check_method='file_magic file format pei*-i386(.*architecture: i386)?'
-  lt_cv_file_magic_cmd='${OBJDUMP} -f'
-  ;;
-
-freebsd*)
-  case "$version_type" in
-  freebsd-elf*)
-    lt_cv_deplibs_check_method=pass_all
-    ;;
-  esac
-  ;;
-
-gnu*)
-  lt_cv_deplibs_check_method=pass_all
-  ;;
-
-irix5* | irix6*)
-  case "$host_os" in
-  irix5*)
-    # this will be overridden with pass_all, but let us keep it just in case
-    lt_cv_deplibs_check_method="file_magic ELF 32-bit MSB dynamic lib MIPS - version 1"
-    ;;
-  *)
-    case "$LD" in
-    *-32|*"-32 ") libmagic=32-bit;;
-    *-n32|*"-n32 ") libmagic=N32;;
-    *-64|*"-64 ") libmagic=64-bit;;
-    *) libmagic=never-match;;
-    esac
-    # this will be overridden with pass_all, but let us keep it just in case
-        lt_cv_deplibs_check_method="file_magic ELF ${libmagic} MSB mips-[1234] dynamic lib MIPS - version 1"
-        ;;
-  esac
-  lt_cv_file_magic_test_file=`echo /lib${libsuff}/libc.so*`
-  lt_cv_deplibs_check_method=pass_all
-  ;;
-
-# This must be Linux ELF.
-linux-gnu*)
-  case "$host_cpu" in
-  alpha* | i*86 | powerpc* | sparc* )
-    lt_cv_deplibs_check_method=pass_all ;;
-  *)
-    # glibc up to 2.1.1 does not perform some relocations on ARM
-        lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )' ;;
-      esac
-  lt_cv_file_magic_test_file=`echo /lib/libc.so* /lib/libc-*.so`
-  ;;
-
-osf3* | osf4* | osf5*)
-  # this will be overridden with pass_all, but let us keep it just in case
-  lt_cv_deplibs_check_method='file_magic COFF format alpha shared library'
-  lt_cv_file_magic_test_file=/shlib/libc.so
-  lt_cv_deplibs_check_method=pass_all
-  ;;
-
-sco3.2v5*)
-  lt_cv_deplibs_check_method=pass_all
-  ;;
-
-solaris*)
-  lt_cv_deplibs_check_method=pass_all
-  lt_cv_file_magic_test_file=/lib/libc.so
-  ;;
-
-sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
-  case "$host_vendor" in
-  ncr)
-    lt_cv_deplibs_check_method=pass_all
-    ;;
-  motorola)
-        lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]'
-        lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*`
-    ;;
-  esac
-  ;;
-esac
-
-fi
-echo "$ECHO_T""$lt_cv_deplibs_check_method" 1>&6
-file_magic_cmd=$lt_cv_file_magic_cmd
-deplibs_check_method=$lt_cv_deplibs_check_method
-
-if test $host != $build; then
-  ac_tool_prefix=${host_alias}-
-else
-  ac_tool_prefix=
-fi
-
-# Only perform the check for file, if the check method requires it
-case "$deplibs_check_method" in
-file_magic*)
-  if test "$file_magic_cmd" = '${MAGIC}'; then
-
-echo $ECHO_N "checking for ${ac_tool_prefix}file... $ECHO_C" 1>&6
-echo "configure:3308: checking for ${ac_tool_prefix}file" 1>&5
-if test "${lt_cv_path_MAGIC+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  case "$MAGIC" in
-  /*)
-  lt_cv_path_MAGIC="$MAGIC" # Let the user override the test with a path.
-  ;;
-  ?:/*)
-  ac_cv_path_MAGIC="$MAGIC" # Let the user override the test with a dos path.
-  ;;
-  *)
-  ac_save_MAGIC="$MAGIC"
-  IFS="${IFS=   }"; ac_save_ifs="$IFS"; IFS=":"
-  ac_dummy="/usr/bin:$PATH"
-  for ac_dir in $ac_dummy; do
-    test -z "$ac_dir" && ac_dir=.
-    if test -f $ac_dir/${ac_tool_prefix}file; then
-      lt_cv_path_MAGIC="$ac_dir/${ac_tool_prefix}file"
-      if test -n "$file_magic_test_file"; then
-	case "$deplibs_check_method" in
-	"file_magic "*)
-	  file_magic_regex="`expr \"$deplibs_check_method\" : \"file_magic \(.*\)\"`"
-	  MAGIC="$lt_cv_path_MAGIC"
-	  if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
-	    egrep "$file_magic_regex" > /dev/null; then
-	    :
-	  else
-	    cat <<EOF 1>&2
-
-*** Warning: the command libtool uses to detect shared libraries,
-*** $file_magic_cmd, produces output that libtool cannot recognize.
-*** The result is that libtool may fail to recognize shared libraries
-*** as such.  This will affect the creation of libtool libraries that
-*** depend on shared libraries, but programs linked with such libtool
-*** libraries will work regardless of this problem.  Nevertheless, you
-*** may want to report the problem to your system manager and/or to
-*** bug-libtool@gnu.org
-
-EOF
-	  fi ;;
-	esac
-      fi
-      break
-    fi
-  done
-  IFS="$ac_save_ifs"
-  MAGIC="$ac_save_MAGIC"
-  ;;
-esac
-fi
-
-MAGIC="$lt_cv_path_MAGIC"
-if test -n "$MAGIC"; then
-  echo "$ECHO_T""$MAGIC" 1>&6
-else
-  echo "$ECHO_T""no" 1>&6
-fi
-
-if test -z "$lt_cv_path_MAGIC"; then
-  if test -n "$ac_tool_prefix"; then
-    echo $ECHO_N "checking for file... $ECHO_C" 1>&6
-echo "configure:3370: checking for file" 1>&5
-if test "${lt_cv_path_MAGIC+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  case "$MAGIC" in
-  /*)
-  lt_cv_path_MAGIC="$MAGIC" # Let the user override the test with a path.
-  ;;
-  ?:/*)
-  ac_cv_path_MAGIC="$MAGIC" # Let the user override the test with a dos path.
-  ;;
-  *)
-  ac_save_MAGIC="$MAGIC"
-  IFS="${IFS=   }"; ac_save_ifs="$IFS"; IFS=":"
-  ac_dummy="/usr/bin:$PATH"
-  for ac_dir in $ac_dummy; do
-    test -z "$ac_dir" && ac_dir=.
-    if test -f $ac_dir/file; then
-      lt_cv_path_MAGIC="$ac_dir/file"
-      if test -n "$file_magic_test_file"; then
-	case "$deplibs_check_method" in
-	"file_magic "*)
-	  file_magic_regex="`expr \"$deplibs_check_method\" : \"file_magic \(.*\)\"`"
-	  MAGIC="$lt_cv_path_MAGIC"
-	  if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null |
-	    egrep "$file_magic_regex" > /dev/null; then
-	    :
-	  else
-	    cat <<EOF 1>&2
-
-*** Warning: the command libtool uses to detect shared libraries,
-*** $file_magic_cmd, produces output that libtool cannot recognize.
-*** The result is that libtool may fail to recognize shared libraries
-*** as such.  This will affect the creation of libtool libraries that
-*** depend on shared libraries, but programs linked with such libtool
-*** libraries will work regardless of this problem.  Nevertheless, you
-*** may want to report the problem to your system manager and/or to
-*** bug-libtool@gnu.org
-
-EOF
-	  fi ;;
-	esac
-      fi
-      break
-    fi
-  done
-  IFS="$ac_save_ifs"
-  MAGIC="$ac_save_MAGIC"
-  ;;
-esac
-fi
-
-MAGIC="$lt_cv_path_MAGIC"
-if test -n "$MAGIC"; then
-  echo "$ECHO_T""$MAGIC" 1>&6
-else
-  echo "$ECHO_T""no" 1>&6
-fi
-
-  else
-    MAGIC=:
-  fi
-fi
-
-  fi
-  ;;
-esac
-
-case "$target" in
-NONE) lt_target="$host" ;;
-*) lt_target="$target" ;;
-esac
-
-# Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
-set dummy ${ac_tool_prefix}ranlib; ac_word=$2
-echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
-echo "configure:3446: checking for $ac_word" 1>&5
-if test "${ac_cv_prog_RANLIB+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -n "$RANLIB"; then
-  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
-else
-  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
-ac_dummy="$PATH"
-for ac_dir in $ac_dummy; do
-  test -z "$ac_dir" && ac_dir=.
-  if test -f $ac_dir/$ac_word; then
-    echo "$ac_dir/$ac_word"
-  fi
-done
-IFS="$ac_save_ifs"
-`; do
-    ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
-    break
-  done
-fi
-fi
-RANLIB="$ac_cv_prog_RANLIB"
-if test -n "$RANLIB"; then
-  echo "$ECHO_T""$RANLIB" 1>&6
-else
-  echo "$ECHO_T""no" 1>&6
-fi
-
-if test -z "$ac_cv_prog_RANLIB"; then
-  if test -n "$ac_tool_prefix"; then
-    # Extract the first word of "ranlib", so it can be a program name with args.
-set dummy ranlib; ac_word=$2
-echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
-echo "configure:3480: checking for $ac_word" 1>&5
-if test "${ac_cv_prog_RANLIB+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -n "$RANLIB"; then
-  ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
-else
-  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
-ac_dummy="$PATH"
-for ac_dir in $ac_dummy; do
-  test -z "$ac_dir" && ac_dir=.
-  if test -f $ac_dir/$ac_word; then
-    echo "$ac_dir/$ac_word"
-  fi
-done
-IFS="$ac_save_ifs"
-`; do
-    ac_cv_prog_RANLIB="ranlib"
-    break
-  done
-  test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
-fi
-fi
-RANLIB="$ac_cv_prog_RANLIB"
-if test -n "$RANLIB"; then
-  echo "$ECHO_T""$RANLIB" 1>&6
-else
-  echo "$ECHO_T""no" 1>&6
-fi
-
-  else
-    RANLIB=":"
-  fi
-fi
-
-# Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args.
-set dummy ${ac_tool_prefix}strip; ac_word=$2
-echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
-echo "configure:3518: checking for $ac_word" 1>&5
-if test "${ac_cv_prog_STRIP+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -n "$STRIP"; then
-  ac_cv_prog_STRIP="$STRIP" # Let the user override the test.
-else
-  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
-ac_dummy="$PATH"
-for ac_dir in $ac_dummy; do
-  test -z "$ac_dir" && ac_dir=.
-  if test -f $ac_dir/$ac_word; then
-    echo "$ac_dir/$ac_word"
-  fi
-done
-IFS="$ac_save_ifs"
-`; do
-    ac_cv_prog_STRIP="${ac_tool_prefix}strip"
-    break
-  done
-fi
-fi
-STRIP="$ac_cv_prog_STRIP"
-if test -n "$STRIP"; then
-  echo "$ECHO_T""$STRIP" 1>&6
-else
-  echo "$ECHO_T""no" 1>&6
-fi
-
-if test -z "$ac_cv_prog_STRIP"; then
-  if test -n "$ac_tool_prefix"; then
-    # Extract the first word of "strip", so it can be a program name with args.
-set dummy strip; ac_word=$2
-echo $ECHO_N "checking for $ac_word... $ECHO_C" 1>&6
-echo "configure:3552: checking for $ac_word" 1>&5
-if test "${ac_cv_prog_STRIP+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  if test -n "$STRIP"; then
-  ac_cv_prog_STRIP="$STRIP" # Let the user override the test.
-else
-  for ac_path in `IFS="${IFS= 	}"; ac_save_ifs="$IFS"; IFS=":"
-ac_dummy="$PATH"
-for ac_dir in $ac_dummy; do
-  test -z "$ac_dir" && ac_dir=.
-  if test -f $ac_dir/$ac_word; then
-    echo "$ac_dir/$ac_word"
-  fi
-done
-IFS="$ac_save_ifs"
-`; do
-    ac_cv_prog_STRIP="strip"
-    break
-  done
-  test -z "$ac_cv_prog_STRIP" && ac_cv_prog_STRIP=":"
-fi
-fi
-STRIP="$ac_cv_prog_STRIP"
-if test -n "$STRIP"; then
-  echo "$ECHO_T""$STRIP" 1>&6
-else
-  echo "$ECHO_T""no" 1>&6
-fi
-
-  else
-    STRIP=":"
-  fi
-fi
-
-# Check for any special flags to pass to ltconfig.
-libtool_flags="--cache-file=$cache_file"
-test "$enable_shared" = no && libtool_flags="$libtool_flags --disable-shared"
-test "$enable_static" = no && libtool_flags="$libtool_flags --disable-static"
-test "$enable_fast_install" = no && libtool_flags="$libtool_flags --disable-fast-install"
-test "$ac_cv_prog_gcc" = yes && libtool_flags="$libtool_flags --with-gcc"
-test "$ac_cv_prog_gnu_ld" = yes && libtool_flags="$libtool_flags --with-gnu-ld"
-
-# Check whether --enable-libtool-lock or --disable-libtool-lock was given.
-if test "${enable_libtool_lock+set}" = set; then
-  enableval="$enable_libtool_lock"
-
-fi
-test "x$enable_libtool_lock" = xno && libtool_flags="$libtool_flags --disable-lock"
-test x"$silent" = xyes && libtool_flags="$libtool_flags --silent"
-
-# Check whether --with-pic or --without-pic was given.
-if test "${with_pic+set}" = set; then
-  withval="$with_pic"
-  pic_mode="$withval"
-else
-  pic_mode=default
-fi
-test x"$pic_mode" = xyes && libtool_flags="$libtool_flags --prefer-pic"
-test x"$pic_mode" = xno && libtool_flags="$libtool_flags --prefer-non-pic"
-
-# Some flags need to be propagated to the compiler or linker for good
-# libtool support.
-case "$lt_target" in
-*-*-irix6*)
-  # Find out which ABI we are using.
-  echo '#line 3618 "configure"' > conftest.$ac_ext
-  if { (eval echo configure:3619: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
-    case "`/usr/bin/file conftest.o`" in
-    *32-bit*)
-      LD="${LD-ld} -32"
-      ;;
-    *N32*)
-      LD="${LD-ld} -n32"
-      ;;
-    *64-bit*)
-      LD="${LD-ld} -64"
-      ;;
-    esac
-  fi
-  rm -rf conftest*
-  ;;
-
-*-*-sco3.2v5*)
-  # On SCO OpenServer 5, we need -belf to get full-featured binaries.
-  SAVE_CFLAGS="$CFLAGS"
-  CFLAGS="$CFLAGS -belf"
-  echo $ECHO_N "checking whether the C compiler needs -belf... $ECHO_C" 1>&6
-echo "configure:3640: checking whether the C compiler needs -belf" 1>&5
-if test "${lt_cv_cc_needs_belf+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-
-     ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-
-     cat >conftest.$ac_ext <<EOF
-#line 3653 "configure"
-#include "confdefs.h"
-
-int
-main()
-{
-
-  ;
-  return 0;
-}
-EOF
-if { (eval echo configure:3664: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  rm -rf conftest*
-  lt_cv_cc_needs_belf=yes
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  lt_cv_cc_needs_belf=no
-fi
-rm -f conftest*
-
-     ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-cross_compiling=$ac_cv_prog_cc_cross
-
-fi
-echo "$ECHO_T""$lt_cv_cc_needs_belf" 1>&6
-  if test x"$lt_cv_cc_needs_belf" != x"yes"; then
-    # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf
-    CFLAGS="$SAVE_CFLAGS"
-  fi
-  ;;
-
-esac
-
-# Save cache, so that ltconfig can load it
-cat >confcache <<\EOF
-# This file is a shell script that caches the results of configure
-# tests run on this system so they can be shared between configure
-# scripts and configure runs.  It is not useful on other systems.
-# If it contains results you don't want to keep, you may remove or edit it.
-#
-# By default, configure uses ./config.cache as the cache file,
-# creating it if it does not exist already.  You can give configure
-# the --cache-file=FILE option to use a different cache file; that is
-# what configure does when it calls configure scripts in
-# subdirectories, so they share the cache.
-# Giving --cache-file=/dev/null disables caching, for debugging configure.
-# config.status only pays attention to the cache file if you give it the
-# --recheck option to rerun configure.
-#
-EOF
-# The following way of writing the cache mishandles newlines in values,
-# but we know of no workaround that is simple, portable, and efficient.
-# So, don't put newlines in cache variables' values.
-# Ultrix sh set writes to stderr and can't be redirected directly,
-# and sets the high bit in the cache file unless we assign to the vars.
-(set) 2>&1 |
-  case `(ac_space=' '; set | grep ac_space) 2>&1` in
-  *ac_space=\ *)
-    # `set' does not quote correctly, so add quotes (double-quote substitution
-    # turns \\\\ into \\, and sed turns \\ into \).
-    sed -n \
-      -e "s/'/'\\\\''/g" \
-      -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
-    ;;
-  *)
-    # `set' quotes correctly as required by POSIX, so do not add quotes.
-    sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
-    ;;
-  esac >>confcache
-if cmp -s $cache_file confcache; then :; else
-  if test -w $cache_file; then
-    echo "updating cache $cache_file"
-    cat confcache >$cache_file
-  else
-    echo "not updating unwritable cache $cache_file"
-  fi
-fi
-rm -f confcache
-
-# Actually configure libtool.  ac_aux_dir is where install-sh is found.
-AR="$AR" CC="$CC" CFLAGS="$CFLAGS" CPPFLAGS="$CPPFLAGS" \
-MAGIC="$MAGIC" LD="$LD" LDFLAGS="$LDFLAGS" LIBS="$LIBS" \
-LN_S="$LN_S" NM="$NM" RANLIB="$RANLIB" STRIP="$STRIP" \
-AS="$AS" DLLTOOL="$DLLTOOL" OBJDUMP="$OBJDUMP" \
-objext="$OBJEXT" exeext="$EXEEXT" reload_flag="$reload_flag" \
-deplibs_check_method="$deplibs_check_method" file_magic_cmd="$file_magic_cmd" \
-${CONFIG_SHELL-/bin/sh} $ac_aux_dir/ltconfig --no-reexec \
-$libtool_flags --no-verify --build="$build" $ac_aux_dir/ltmain.sh $lt_target \
-|| { echo "configure: error: libtool configure failed" 1>&2; exit 1; }
-
-# Reload cache, that may have been modified by ltconfig
-if test -r "$cache_file"; then
-  echo "loading cache $cache_file"
-      test -f "$cache_file" && . $cache_file
-else
-  echo "creating cache $cache_file"
-  >$cache_file
-fi
-
-# This can be used to rebuild libtool when needed
-LIBTOOL_DEPS="$ac_aux_dir/ltconfig $ac_aux_dir/ltmain.sh"
-
-# Always use our own libtool.
-LIBTOOL='$(SHELL) $(top_builddir)/libtool'
-
-# Redirect the config.log output again, so that the ltconfig log is not
-# clobbered by the next message.
-exec 5>>./config.log
-
-echo $ECHO_N "checking whether optarg is declared... $ECHO_C" 1>&6
-echo "configure:3769: checking whether optarg is declared" 1>&5
-if test "${ac_cv_have_decl_optarg+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  cat >conftest.$ac_ext <<EOF
-#line 3774 "configure"
-#include "confdefs.h"
-$ac_includes_default
-int
-main ()
-{
-#ifndef optarg
-  char *p = (char *) optarg;
-#endif
-
-  ;
-  return 0;
-}
-EOF
-if { (eval echo configure:3788: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
-  rm -rf conftest*
-  ac_cv_have_decl_optarg=yes
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  ac_cv_have_decl_optarg=no
-fi
-rm -f conftest*
-fi
-echo "$ECHO_T""$ac_cv_have_decl_optarg" 1>&6
-if test $ac_cv_have_decl_optarg = yes; then
-  cat >>confdefs.h <<EOF
-#define HAVE_DECL_OPTARG 1
-EOF
-
-else
-  cat >>confdefs.h <<EOF
-#define HAVE_DECL_OPTARG 0
-EOF
-
-fi
-
-echo $ECHO_N "checking for ANSI C header files... $ECHO_C" 1>&6
-echo "configure:3813: checking for ANSI C header files" 1>&5
-if test "${ac_cv_header_stdc+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-
-cat >conftest.$ac_ext <<EOF
-#line 3819 "configure"
-#include "confdefs.h"
-#include <stdlib.h>
-#include <stdarg.h>
-#include <string.h>
-#include <float.h>
-
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:3828: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
-  rm -rf conftest*
-  ac_cv_header_stdc=yes
-else
-  echo "$ac_err" >&5
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-if test $ac_cv_header_stdc = yes; then
-  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
-
-cat >conftest.$ac_ext <<EOF
-#line 3846 "configure"
-#include "confdefs.h"
-#include <string.h>
-
-EOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
-  egrep "memchr" >/dev/null 2>&1; then
-  :
-else
-  rm -rf conftest*
-  ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-fi
-
-if test $ac_cv_header_stdc = yes; then
-  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
-
-cat >conftest.$ac_ext <<EOF
-#line 3866 "configure"
-#include "confdefs.h"
-#include <stdlib.h>
-
-EOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
-  egrep "free" >/dev/null 2>&1; then
-  :
-else
-  rm -rf conftest*
-  ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-fi
-
-if test $ac_cv_header_stdc = yes; then
-  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
-if test "$cross_compiling" = yes; then
-  :
-else
-  cat >conftest.$ac_ext <<EOF
-#line 3888 "configure"
-#include "confdefs.h"
-#include <ctype.h>
-#if ((' ' & 0x0FF) == 0x020)
-# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
-# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
-#else
-# define ISLOWER(c) (('a' <= (c) && (c) <= 'i') \
-                     || ('j' <= (c) && (c) <= 'r') \
-                     || ('s' <= (c) && (c) <= 'z'))
-# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
-#endif
-
-#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
-int
-main ()
-{
-  int i;
-  for (i = 0; i < 256; i++)
-    if (XOR (islower (i), ISLOWER (i))
-        || toupper (i) != TOUPPER (i))
-      exit(2);
-  exit (0);
-}
-EOF
-if { (eval echo configure:3913: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
-  :
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -fr conftest*
-  ac_cv_header_stdc=no
-fi
-rm -fr conftest*
-
-fi
-
-fi
-fi
-echo "$ECHO_T""$ac_cv_header_stdc" 1>&6
-if test $ac_cv_header_stdc = yes; then
-  cat >>confdefs.h <<\EOF
-#define STDC_HEADERS 1
-EOF
-
-fi
-
-for ac_header in getopt.h unistd.h sys/sysctl.h sys/time.h
-do
-ac_ac_Header=`echo "ac_cv_header_$ac_header" | $ac_tr_sh`
-echo $ECHO_N "checking for $ac_header... $ECHO_C" 1>&6
-echo "configure:3940: checking for $ac_header" 1>&5
-if eval "test \"\${$ac_ac_Header+set}\" = set"; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-
-cat >conftest.$ac_ext <<EOF
-#line 3946 "configure"
-#include "confdefs.h"
-#include <$ac_header>
-
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:3952: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
-  rm -rf conftest*
-  eval "$ac_ac_Header=yes"
-else
-  echo "$ac_err" >&5
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  eval "$ac_ac_Header=no"
-fi
-rm -f conftest*
-fi
-echo "$ECHO_T""`eval echo '${'$ac_ac_Header'}'`" 1>&6
-if test `eval echo '${'$ac_ac_Header'}'` = yes; then
-  cat >>confdefs.h <<EOF
-#define `echo "HAVE_$ac_header" | $ac_tr_cpp` 1
-EOF
-
-fi
-done
-
-echo $ECHO_N "checking for void... $ECHO_C" 1>&6
-echo "configure:3976: checking for void" 1>&5
-if test "${ac_cv_type_void+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  cat >conftest.$ac_ext <<EOF
-#line 3981 "configure"
-#include "confdefs.h"
-$ac_includes_default
-int
-main ()
-{
-if ((void *) 0)
-  return 0;
-if (sizeof (void))
-  return 0;
-  ;
-  return 0;
-}
-EOF
-if { (eval echo configure:3995: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
-  rm -rf conftest*
-  ac_cv_type_void=yes
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  ac_cv_type_void=no
-fi
-rm -f conftest*
-fi
-echo "$ECHO_T""$ac_cv_type_void" 1>&6
-if test $ac_cv_type_void = yes; then
-  cat >>confdefs.h <<EOF
-#define HAVE_VOID 1
-EOF
-
-fi
-
-echo $ECHO_N "checking for preprocessor stringizing operator... $ECHO_C" 1>&6
-echo "configure:4015: checking for preprocessor stringizing operator" 1>&5
-if test "${ac_cv_c_stringize+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-
-cat >conftest.$ac_ext <<EOF
-#line 4021 "configure"
-#include "confdefs.h"
-
-#define x(y) #y
-
-char *s = x(teststring);
-
-EOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
-  egrep "#teststring" >/dev/null 2>&1; then
-  rm -rf conftest*
-  ac_cv_c_stringize=no
-else
-  rm -rf conftest*
-  ac_cv_c_stringize=yes
-fi
-rm -f conftest*
-
-fi
-
-if test "${ac_cv_c_stringize}" = yes; then
-  cat >>confdefs.h <<\EOF
-#define HAVE_STRINGIZE 1
-EOF
-
-fi
-echo "$ECHO_T""${ac_cv_c_stringize}" 1>&6
-
-for ac_func in getopt_long getpagesize popen processor_info strtoul sysconf sysctlbyname
-do
-ac_ac_var=`echo "ac_cv_func_$ac_func" | $ac_tr_sh`
-echo $ECHO_N "checking for $ac_func... $ECHO_C" 1>&6
-echo "configure:4053: checking for $ac_func" 1>&5
-if eval "test \"\${$ac_ac_var+set}\" = set"; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  cat >conftest.$ac_ext <<EOF
-#line 4058 "configure"
-#include "confdefs.h"
-/* System header to define __stub macros and hopefully few prototypes,
-    which can conflict with char $ac_func(); below.  */
-#include <assert.h>
-/* Override any gcc2 internal prototype to avoid an error.  */
-/* We use char because int might match the return type of a gcc2
-    builtin and then its argument prototype would still apply.  */
-char $ac_func();
-char (*f)();
-
-int
-main()
-{
-
-/* The GNU C library defines this for functions which it implements
-    to always fail with ENOSYS.  Some functions are actually named
-    something starting with __ and the normal name is an alias.  */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-f = $ac_func;
-#endif
-
-  ;
-  return 0;
-}
-EOF
-if { (eval echo configure:4086: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  rm -rf conftest*
-  eval "$ac_ac_var=yes"
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  eval "$ac_ac_var=no"
-fi
-rm -f conftest*
-
-fi
-echo "$ECHO_T""`eval echo '${'$ac_ac_var'}'`" 1>&6
-if test `eval echo '${'$ac_ac_var'}'` = yes; then
-  cat >>confdefs.h <<EOF
-#define `echo "HAVE_$ac_func" | $ac_tr_cpp` 1
-EOF
-
-fi
-done
-
-echo $ECHO_N "checking if ansi2knr should be used... $ECHO_C" 1>&6
-echo "configure:4108: checking if ansi2knr should be used" 1>&5
-if test "${gmp_cv_c_ansi2knr+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-  cat >conftest.c <<EOF
-int main (int argc, char *argv) { return 0; }
-EOF
-if { (eval echo configure:4115: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
-  gmp_cv_c_ansi2knr=no
-else
-  gmp_cv_c_ansi2knr=yes
-fi
-rm -f conftest.*
-
-fi
-echo "$ECHO_T""$gmp_cv_c_ansi2knr" 1>&6
-if test $gmp_cv_c_ansi2knr = no; then
-  U= ANSI2KNR=
-else
-  U=_ ANSI2KNR=./ansi2knr
-  # Ensure some checks needed by ansi2knr itself.
-
-echo $ECHO_N "checking for ANSI C header files... $ECHO_C" 1>&6
-echo "configure:4131: checking for ANSI C header files" 1>&5
-if test "${ac_cv_header_stdc+set}" = set; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-
-cat >conftest.$ac_ext <<EOF
-#line 4137 "configure"
-#include "confdefs.h"
-#include <stdlib.h>
-#include <stdarg.h>
-#include <string.h>
-#include <float.h>
-
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:4146: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
-  rm -rf conftest*
-  ac_cv_header_stdc=yes
-else
-  echo "$ac_err" >&5
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-if test $ac_cv_header_stdc = yes; then
-  # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
-
-cat >conftest.$ac_ext <<EOF
-#line 4164 "configure"
-#include "confdefs.h"
-#include <string.h>
-
-EOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
-  egrep "memchr" >/dev/null 2>&1; then
-  :
-else
-  rm -rf conftest*
-  ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-fi
-
-if test $ac_cv_header_stdc = yes; then
-  # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
-
-cat >conftest.$ac_ext <<EOF
-#line 4184 "configure"
-#include "confdefs.h"
-#include <stdlib.h>
-
-EOF
-if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
-  egrep "free" >/dev/null 2>&1; then
-  :
-else
-  rm -rf conftest*
-  ac_cv_header_stdc=no
-fi
-rm -f conftest*
-
-fi
-
-if test $ac_cv_header_stdc = yes; then
-  # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
-if test "$cross_compiling" = yes; then
-  :
-else
-  cat >conftest.$ac_ext <<EOF
-#line 4206 "configure"
-#include "confdefs.h"
-#include <ctype.h>
-#if ((' ' & 0x0FF) == 0x020)
-# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
-# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
-#else
-# define ISLOWER(c) (('a' <= (c) && (c) <= 'i') \
-                     || ('j' <= (c) && (c) <= 'r') \
-                     || ('s' <= (c) && (c) <= 'z'))
-# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c))
-#endif
-
-#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
-int
-main ()
-{
-  int i;
-  for (i = 0; i < 256; i++)
-    if (XOR (islower (i), ISLOWER (i))
-        || toupper (i) != TOUPPER (i))
-      exit(2);
-  exit (0);
-}
-EOF
-if { (eval echo configure:4231: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
-then
-  :
-else
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -fr conftest*
-  ac_cv_header_stdc=no
-fi
-rm -fr conftest*
-
-fi
-
-fi
-fi
-echo "$ECHO_T""$ac_cv_header_stdc" 1>&6
-if test $ac_cv_header_stdc = yes; then
-  cat >>confdefs.h <<\EOF
-#define STDC_HEADERS 1
-EOF
-
-fi
-
-  for ac_header in string.h
-do
-ac_ac_Header=`echo "ac_cv_header_$ac_header" | $ac_tr_sh`
-echo $ECHO_N "checking for $ac_header... $ECHO_C" 1>&6
-echo "configure:4258: checking for $ac_header" 1>&5
-if eval "test \"\${$ac_ac_Header+set}\" = set"; then
-  echo $ECHO_N "(cached) $ECHO_C" 1>&6
-else
-
-cat >conftest.$ac_ext <<EOF
-#line 4264 "configure"
-#include "confdefs.h"
-#include <$ac_header>
-
-EOF
-ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
-{ (eval echo configure:4270: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
-  rm -rf conftest*
-  eval "$ac_ac_Header=yes"
-else
-  echo "$ac_err" >&5
-  echo "configure: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  eval "$ac_ac_Header=no"
-fi
-rm -f conftest*
-fi
-echo "$ECHO_T""`eval echo '${'$ac_ac_Header'}'`" 1>&6
-if test `eval echo '${'$ac_ac_Header'}'` = yes; then
-  cat >>confdefs.h <<EOF
-#define `echo "HAVE_$ac_header" | $ac_tr_cpp` 1
-EOF
-
-fi
-done
-
-fi
-
-syntax=
-# For now, we use the old switch for setting syntax.
-# FIXME: Remove when conversion to .asm is completed.
-case "${target}" in
-  m680[234]0*-*-linuxaout* | m68k*-*-linuxaout* | \
-  m68k-next-nextstep* | \
-  m68000*-*-*)
-    syntax=mit
-    ;;
-  m680[234]0*-*-linux* | m68k*-*-linux*)
-    syntax=elf
-    ;;
-  m680[234]0*-*-* | m68k*-*-*)
-    syntax=mit
-    ;;
-esac
-
-# Now build an asm-syntax.h file for targets that include that from the
-# assembly files.
-# FIXME: Remove when conversion to .asm is completed.
-case "${family}-${underscore}-${asm_align}-${syntax}" in
-  m68k-yes-log-mit)
-    echo '#define MIT_SYNTAX' >asm-syntax.h
-    cat $srcdir/mpn/underscore.h >>asm-syntax.h
-    echo '#include "'$srcdir'/mpn/m68k/syntax.h"' >>asm-syntax.h;;
-  m68k-no-nolog-elf)
-    echo '#define ELF_SYNTAX' >asm-syntax.h
-    echo '#define C_SYMBOL_NAME(name) name' >>asm-syntax.h
-    echo '#include "'$srcdir'/mpn/m68k/syntax.h"' >>asm-syntax.h;;
-esac
-
-# The pattern here tests for an absolute path the same way as
-# _AC_OUTPUT_FILES in autoconf acgeneral.m4.
-
-echo "dnl  CONFIG_TOP_SRCDIR is a path from the mpn builddir to the top srcdir" >> $gmp_tmpconfigm4
-
-case "$srcdir" in
-[\\/]* | ?:[\\/]* )
-
-echo "define(<CONFIG_TOP_SRCDIR>,<\`$srcdir'>)" >> $gmp_tmpconfigm4
-    ;;
-*)
-
-echo "define(<CONFIG_TOP_SRCDIR>,<\`../$srcdir'>)" >> $gmp_tmpconfigm4
- ;;
-esac
-
-echo "include(CONFIG_TOP_SRCDIR\`/mpn/asm-defs.m4')" >> $gmp_tmpconfigm4p
-
-# Must be after asm-defs.m4
-
-echo "define_not_for_expansion(\`HAVE_TARGET_CPU_$target_cpu')" >> $gmp_tmpconfigm4p
-
-case "$target" in
-  alpha*-cray-unicos*)
-    gmp_m4postinc="alpha/unicos.m4"
-    ;;
-  alpha*-*-*)
-    gmp_m4postinc="alpha/default.m4"
-    ;;
-  power*-*-*)
-    case "$target" in
-      *-*-mach* | *-*-rhapsody* | *-*-nextstep* | *-*-darwin* | *-*-macosx*)
-        ;;	# these use non-conventional assembly syntax.
-      powerpc64-*-aix*)
-	gmp_m4postinc="powerpc32/regmap.m4 powerpc64/aix.m4"
-        ;;
-      *-*-aix*)
-	gmp_m4postinc="powerpc32/regmap.m4 powerpc32/aix.m4"
-        ;;
-      *)
-	gmp_m4postinc="powerpc32/regmap.m4"
-	;;
-    esac
-    ;;
-esac
-
-for tmp_f in $gmp_m4postinc; do
-
-echo "include_mpn(\`$tmp_f')" >> $gmp_tmpconfigm4p
-
-done
-
-# Set up `gmp_links'.  It's a list of link:file pairs that configure will
-# process to create link -> file.
-gmp_links=
-
-# If the user specified `MPN_PATH', use that instead of the path we've
-# come up with.
-if test -z "$MPN_PATH"; then
-  path="$path generic"
-else
-  path="$MPN_PATH"
-fi
-
-# Pick the correct source files in $path and link them to mpn/.
-# $gmp_mpn_functions lists all functions we need.
-#
-# The rule is to find a file with the function name and a .asm, .S,
-# .s, or .c extension.  Certain multi-function files with special names
-# can provide some functions too.  (mpn/Makefile.am passes
-# -DOPERATION_<func> to get them to generate the right code.)
-
-# FIXME: udiv and umul aren't in $gmp_mpn_functions_optional yet since
-# there's some versions of those files which should be checked for bit
-# rot first.  Put them in $extra_functions for each target for now,
-# change to standard optionals when all are ready.
-
-# Note: The following lines defining $gmp_mpn_functions_optional
-#       and $gmp_mpn_functions are parsed by the "macos/configure"
-#       Perl script. So if you change the lines in a major way
-#       make sure to run and examine the output from
-#
-#           % (cd macos; perl configure)
-
-gmp_mpn_functions_optional="copyi copyd com_n		\
-  and_n andn_n nand_n ior_n iorn_n nior_n xor_n xnor_n"
-
-gmp_mpn_functions="${extra_functions} inlines add_n sub_n mul_1 addmul_1   \
-  submul_1 lshift rshift diveby3 divrem divrem_1 divrem_2                  \
-  mod_1 mod_1_rs pre_mod_1 dump                                            \
-  mul mul_fft mul_n mul_basecase sqr_basecase random                       \
-  random2 sqrtrem get_str set_str scan0 scan1 popcount hamdist cmp perfsqr \
-  bdivmod gcd_1 gcd gcdext tdiv_qr bz_divrem_n sb_divrem_mn jacbase        \
-  $gmp_mpn_functions_optional"
-
-# the list of all object files used by mpn/Makefile.in and the
-# top-level Makefile.in, respectively
-mpn_objects=
-mpn_objs_in_libgmp="mpn/mp_bases.lo"
-
-# SLPJ trace
-echo "Peering at file structure (takes a while)..." 1>&6
-
-for tmp_fn in ${gmp_mpn_functions} ; do
-# SLPJ trace
-  echo "...$tmp_fn..." 1>&6
-
-# This line was
-#    rm -f mpn/${tmp_fn}.[Ssc] mpn/${tmp_fn}.asm
-# but I found that on my NT workstation the command
-# would unpredictably hang.  rm wasn't an active process,
-# but absolutlely nothing was happening.  
-# I *think* that expanding the [Ssc] cures the problem
-#    SLPJ May 01
-  rm -f mpn/${tmp_fn}.S mpn/${tmp_fn}.s mpn/${tmp_fn}.c mpn/${tmp_fn}.asm
-
-  echo "...$tmp_fn (done rm)..." 1>&6
-
-  # functions that can be provided by multi-function files
-  tmp_mulfunc=
-  case $tmp_fn in
-  add_n|sub_n)       tmp_mulfunc="aors_n"    ;;
-  addmul_1|submul_1) tmp_mulfunc="aorsmul_1" ;;
-  popcount|hamdist)  tmp_mulfunc="popham"    ;;
-  and_n|andn_n|nand_n | ior_n|iorn_n|nior_n | xor_n|xnor_n)
-                     tmp_mulfunc="logops_n"  ;;
-  esac
-
-  found=no
-  for tmp_dir in $path; do
-
-# SLPJ trace
-# We get stuck sometimes
-	echo "  ...dir $tmp_dir..." 1>&6
-    for tmp_base in $tmp_fn $tmp_mulfunc; do
-
-# SLPJ trace
-# We get stuck sometimes
-	echo "   ...base $tmp_base..." 1>&6
-      for tmp_ext in asm S s c; do
-        tmp_file=$srcdir/mpn/$tmp_dir/$tmp_base.$tmp_ext
-
-# SLPJ trace
-# We get stuck sometimes
-	echo "   ...$tmp_file..." 1>&6
-
-        if test -f $tmp_file; then
-          found=yes
-
-          mpn_objects="$mpn_objects ${tmp_fn}.lo"
-          mpn_objs_in_libgmp="$mpn_objs_in_libgmp mpn/${tmp_fn}.lo"
-          gmp_links="$gmp_links mpn/$tmp_fn.$tmp_ext:mpn/$tmp_dir/$tmp_base.$tmp_ext"
-
-          # duplicate AC_DEFINEs are harmless, so it doesn't matter
-          # that multi-function files get grepped here repeatedly
-          gmp_ep="`
-            sed -n 's/^[ 	]*MULFUNC_PROLOGUE(\(.*\))/\1/p' $tmp_file ;
-            sed -n 's/^[ 	]*PROLOGUE.*(\(.*\))/\1/p' $tmp_file
-          `"
-          for gmp_tmp in $gmp_ep; do
-            cat >>confdefs.h <<EOF
-#define HAVE_NATIVE_${gmp_tmp} 1
-EOF
-
-          done
-
-          break
-        fi
-      done
-      if test $found = yes; then break ; fi
-    done
-    if test $found = yes; then break ; fi
-  done
-
-  if test $found = no; then
-    for tmp_optional in $gmp_mpn_functions_optional; do
-      if test $tmp_optional = $tmp_fn; then
-        found=yes
-      fi
-    done
-    if test $found = no; then
-      { echo "configure: error: no version of $tmp_fn found in path: $path" 1>&2; exit 1; }
-    fi
-  fi
-done
-
-
-# Create link for gmp-mparam.h.
-
-# SLPJ trace
-echo "Creating link for gmp-mparam.h..." 1>&6
-
-for tmp_dir in $path ; do
-  rm -f gmp-mparam.h
-  if test -f $srcdir/mpn/${tmp_dir}/gmp-mparam.h ; then
-    gmp_links="$gmp_links gmp-mparam.h:mpn/${tmp_dir}/gmp-mparam.h"
-
-    # Copy any KARATSUBA_SQR_THRESHOLD in gmp-mparam.h to config.m4.
-    # Some versions of sqr_basecase.asm use this.
-    tmp_gmp_karatsuba_sqr_threshold="`sed -n 's/^#define KARATSUBA_SQR_THRESHOLD[ 	]*\([0-9][0-9]*\).*$/\1/p' $srcdir/mpn/${tmp_dir}/gmp-mparam.h`"
-    if test -n "$tmp_gmp_karatsuba_sqr_threshold"; then
-
-echo "define(<KARATSUBA_SQR_THRESHOLD>,<$tmp_gmp_karatsuba_sqr_threshold>)" >> $gmp_tmpconfigm4
-
-    fi
-
-    break
-  fi
-done
-
-# SLPJ trace
-echo "Digging out links to include in DISTCLEANFILES..." 1>&6
-
-# Dig out the links from `gmp_links' for inclusion in DISTCLEANFILES.
-gmp_srclinks=
-for f in $gmp_links; do
-  gmp_srclinks="$gmp_srclinks `echo $f | sed 's/\(.*\):.*/\1/'`"
-done
-
-echo "creating $gmp_configm4"
-echo "dnl $gmp_configm4.  Generated automatically by configure." > $gmp_configm4
-if test -f $gmp_tmpconfigm4; then
-  echo "changequote(<,>)dnl" >> $gmp_configm4
-  echo "ifdef(<__CONFIG_M4_INCLUDED__>,,<" >> $gmp_configm4
-  cat $gmp_tmpconfigm4 >> $gmp_configm4
-  echo ">)" >> $gmp_configm4
-  echo "changequote(\`,')dnl" >> $gmp_configm4
-  rm $gmp_tmpconfigm4
-fi
-echo "ifdef(\`__CONFIG_M4_INCLUDED__',,\`" >> $gmp_configm4
-if test -f $gmp_tmpconfigm4i; then
-  cat $gmp_tmpconfigm4i >> $gmp_configm4
-  rm $gmp_tmpconfigm4i
-fi
-if test -f $gmp_tmpconfigm4p; then
-  cat $gmp_tmpconfigm4p >> $gmp_configm4
-  rm $gmp_tmpconfigm4p
-fi
-echo "')" >> $gmp_configm4
-echo "define(\`__CONFIG_M4_INCLUDED__')" >> $gmp_configm4
-
-trap '' 1 2 15
-cat >confcache <<\EOF
-# This file is a shell script that caches the results of configure
-# tests run on this system so they can be shared between configure
-# scripts and configure runs.  It is not useful on other systems.
-# If it contains results you don't want to keep, you may remove or edit it.
-#
-# By default, configure uses ./config.cache as the cache file,
-# creating it if it does not exist already.  You can give configure
-# the --cache-file=FILE option to use a different cache file; that is
-# what configure does when it calls configure scripts in
-# subdirectories, so they share the cache.
-# Giving --cache-file=/dev/null disables caching, for debugging configure.
-# config.status only pays attention to the cache file if you give it the
-# --recheck option to rerun configure.
-#
-EOF
-# The following way of writing the cache mishandles newlines in values,
-# but we know of no workaround that is simple, portable, and efficient.
-# So, don't put newlines in cache variables' values.
-# Ultrix sh set writes to stderr and can't be redirected directly,
-# and sets the high bit in the cache file unless we assign to the vars.
-(set) 2>&1 |
-  case `(ac_space=' '; set | grep ac_space) 2>&1` in
-  *ac_space=\ *)
-    # `set' does not quote correctly, so add quotes (double-quote substitution
-    # turns \\\\ into \\, and sed turns \\ into \).
-    sed -n \
-      -e "s/'/'\\\\''/g" \
-      -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
-    ;;
-  *)
-    # `set' quotes correctly as required by POSIX, so do not add quotes.
-    sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
-    ;;
-  esac >>confcache
-if cmp -s $cache_file confcache; then :; else
-  if test -w $cache_file; then
-    echo "updating cache $cache_file"
-    cat confcache >$cache_file
-  else
-    echo "not updating unwritable cache $cache_file"
-  fi
-fi
-rm -f confcache
-
-trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
-
-test "x$prefix" = xNONE && prefix=$ac_default_prefix
-# Let make expand exec_prefix.
-test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
-
-# Any assignment to VPATH causes Sun make to only execute
-# the first set of double-colon rules, so remove it if not needed.
-# If there is a colon in the path, we need to keep it.
-if test "x$srcdir" = x.; then
-  ac_vpsub='/^[ 	]*VPATH[ 	]*=[^:]*$/d'
-fi
-
-DEFS=-DHAVE_CONFIG_H
-
-: ${CONFIG_STATUS=./config.status}
-trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
-echo creating $CONFIG_STATUS
-cat >$CONFIG_STATUS <<EOF
-#! /bin/sh
-# Generated automatically by configure.
-# Run this file to recreate the current configuration.
-# This directory was configured as follows,
-# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
-#
-# $0 $ac_configure_args
-#
-# Compiler output produced by configure, useful for debugging
-# configure, is in ./config.log if it exists.
-
-# Files that config.status was made for.
-config_files="\\
-  Makefile mpn/Makefile mpz/Makefile"
-config_headers="\\
-  config.h:config.in"
-config_links="\\
-  $gmp_links"
-config_commands="\\
-  default-1"
-
-ac_cs_usage="\\
-\\\`$CONFIG_STATUS' instantiates files from templates according to the
-current configuration.
-
-Usage: $CONFIG_STATUS [OPTIONS] FILE...
-
-  --recheck    Update $CONFIG_STATUS by reconfiguring in the same conditions
-  --version    Print the version of Autoconf and exit
-  --help       Display this help and exit
-  --file=FILE[:TEMPLATE]
-               Instantiate the configuration file FILE
-  --header=FILE[:TEMPLATE]
-               Instantiate the configuration header FILE
-
-Configuration files:
-\$config_files
-
-Configuration headers:
-\$config_headers
-
-Configuration links:
-\$config_links
-
-Configuration commands:
-\$config_commands
-
-Report bugs to <bug-autoconf@gnu.org>."
-
-ac_cs_version="\\
-$CONFIG_STATUS generated by autoconf version 2.14a.
-Configured on host `(hostname || uname -n) 2>/dev/null | sed 1q` by
-  `echo "$0 $ac_configure_args" | sed 's/[\\"\`\$]/\\\\&/g'`"
-
-# Root of the tmp file names.  Use pid to allow concurrent executions.
-ac_cs_root=cs\$\$
-ac_given_srcdir=$srcdir
-ac_given_INSTALL="$INSTALL"
-
-# If no file are specified by the user, then we need to provide default
-# value.  By we need to know if files were specified by the user.
-ac_need_defaults=:
-while test \$# != 0
-do
-  case "\$1" in
-  --*=*)
-    ac_option=\`echo "\$1" | sed -e 's/=.*//'\`
-    ac_optarg=\`echo "\$1" | sed -e 's/[^=]*=//'\`
-    shift
-    set dummy "\$ac_option" "\$ac_optarg" \${1+"\$@"}
-    shift
-    ;;
-  -*);;
-  *) # This is not an option, so the user has probably given explicit
-     # arguments.
-     ac_need_defaults=false;;
-  esac
-
-  case "\$1" in
-
-  # Handling of the options.
-  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
-    echo "running \${CONFIG_SHELL-/bin/sh} $0 `echo "$ac_configure_args" | sed 's/[\\"\`\$]/\\\\&/g'` --no-create --no-recursion"
-    exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
-  -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
-    echo "\$ac_cs_version"; exit 0 ;;
-  --he | --h)
-    # Conflict between --help and --header
-    echo "$CONFIG_STATUS: ambiguous option: \$ac_option
-Try \\\`$CONFIG_STATUS --help' for more information."; exit 1 ;;
-  -help | --help | --hel )
-    echo "\$ac_cs_usage"; exit 0 ;;
-  --file | --fil | --fi | --f )
-    shift
-    CONFIG_FILES="\$CONFIG_FILES \$1"
-    ac_need_defaults=false;;
-  --header | --heade | --head | --hea )
-    shift
-    CONFIG_HEADERS="\$CONFIG_FILES \$1"
-    ac_need_defaults=false;;
-
-  # Handling of arguments.
-  'Makefile' ) CONFIG_FILES="\$CONFIG_FILES Makefile" ;;
-  'mpz/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpz/Makefile" ;;
-  'mpn/Makefile' ) CONFIG_FILES="\$CONFIG_FILES mpn/Makefile" ;;
-  '$gmp_links' ) CONFIG_LINKS="\$CONFIG_LINKS $gmp_links" ;;
-  'default-1' ) CONFIG_COMMANDS="\$CONFIG_COMMANDS default-1" ;;
-  'config.h' ) CONFIG_HEADERS="\$CONFIG_HEADERS config.h:config.in" ;;
-
-  # This is an error.
-  -*) echo "$CONFIG_STATUS: unrecognized option: \$1
-Try \\\`$CONFIG_STATUS --help' for more information."; exit 1 ;;
-  *) echo "$CONFIG_STATUS: invalid argument: \$1"; exit 1 ;;
-  esac
-  shift
-done
-
-EOF
-
-cat >>$CONFIG_STATUS <<\EOF
-# If the user did not use the arguments to specify the items to instantiate,
-# then the envvar interface is used.  Set only those that are not.
-if $ac_need_defaults; then
-  : ${CONFIG_FILES=$config_files}
-  : ${CONFIG_HEADERS=$config_headers}
-  : ${CONFIG_LINKS=$config_links}
-  : ${CONFIG_COMMANDS=$config_commands}
-fi
-
-# Trap to remove the temp files.
-trap 'rm -fr $ac_cs_root*; exit 1' 1 2 15
-
-EOF
-
-cat >>$CONFIG_STATUS <<EOF
-#
-# INIT-COMMANDS section.
-#
-
-EOF
-
-cat >>$CONFIG_STATUS <<EOF
-
-#
-# CONFIG_FILES section.
-#
-
-# No need to generate the scripts if there are no CONFIG_FILES.
-# This happens for instance when ./config.status config.h
-if test -n "\$CONFIG_FILES"; then
-  # Protect against being on the right side of a sed subst in config.status.
-  sed 's/%@/@@/; s/@%/@@/; s/%;t t\$/@;t t/; /@;t t\$/s/[\\\\&%]/\\\\&/g;
-   s/@@/%@/; s/@@/@%/; s/@;t t\$/%;t t/' >\$ac_cs_root.subs <<\\CEOF
-s%@exec_prefix@%$exec_prefix%;t t
-s%@prefix@%$prefix%;t t
-s%@program_transform_name@%$program_transform_name%;t t
-s%@bindir@%$bindir%;t t
-s%@sbindir@%$sbindir%;t t
-s%@libexecdir@%$libexecdir%;t t
-s%@datadir@%$datadir%;t t
-s%@sysconfdir@%$sysconfdir%;t t
-s%@sharedstatedir@%$sharedstatedir%;t t
-s%@localstatedir@%$localstatedir%;t t
-s%@libdir@%$libdir%;t t
-s%@includedir@%$includedir%;t t
-s%@oldincludedir@%$oldincludedir%;t t
-s%@infodir@%$infodir%;t t
-s%@mandir@%$mandir%;t t
-s%@SHELL@%$SHELL%;t t
-s%@ECHO_C@%$ECHO_C%;t t
-s%@ECHO_N@%$ECHO_N%;t t
-s%@ECHO_T@%$ECHO_T%;t t
-s%@CFLAGS@%$CFLAGS%;t t
-s%@CPPFLAGS@%$CPPFLAGS%;t t
-s%@CXXFLAGS@%$CXXFLAGS%;t t
-s%@FFLAGS@%$FFLAGS%;t t
-s%@DEFS@%$DEFS%;t t
-s%@LDFLAGS@%$LDFLAGS%;t t
-s%@LIBS@%$LIBS%;t t
-s%@host@%$host%;t t
-s%@host_alias@%$host_alias%;t t
-s%@host_cpu@%$host_cpu%;t t
-s%@host_vendor@%$host_vendor%;t t
-s%@host_os@%$host_os%;t t
-s%@target@%$target%;t t
-s%@target_alias@%$target_alias%;t t
-s%@target_cpu@%$target_cpu%;t t
-s%@target_vendor@%$target_vendor%;t t
-s%@target_os@%$target_os%;t t
-s%@build@%$build%;t t
-s%@build_alias@%$build_alias%;t t
-s%@build_cpu@%$build_cpu%;t t
-s%@build_vendor@%$build_vendor%;t t
-s%@build_os@%$build_os%;t t
-s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%;t t
-s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%;t t
-s%@INSTALL_DATA@%$INSTALL_DATA%;t t
-s%@PACKAGE@%$PACKAGE%;t t
-s%@VERSION@%$VERSION%;t t
-s%@ACLOCAL@%$ACLOCAL%;t t
-s%@AUTOCONF@%$AUTOCONF%;t t
-s%@AUTOMAKE@%$AUTOMAKE%;t t
-s%@AUTOHEADER@%$AUTOHEADER%;t t
-s%@MAKEINFO@%$MAKEINFO%;t t
-s%@AMTAR@%$AMTAR%;t t
-s%@install_sh@%$install_sh%;t t
-s%@AWK@%$AWK%;t t
-s%@SET_MAKE@%$SET_MAKE%;t t
-s%@AMDEP@%$AMDEP%;t t
-s%@AMDEPBACKSLASH@%$AMDEPBACKSLASH%;t t
-s%@DEPDIR@%$DEPDIR%;t t
-s%@MAINTAINER_MODE_TRUE@%$MAINTAINER_MODE_TRUE%;t t
-s%@MAINTAINER_MODE_FALSE@%$MAINTAINER_MODE_FALSE%;t t
-s%@MAINT@%$MAINT%;t t
-s%@WANT_MPBSD_TRUE@%$WANT_MPBSD_TRUE%;t t
-s%@WANT_MPBSD_FALSE@%$WANT_MPBSD_FALSE%;t t
-s%@WANT_MPFR_TRUE@%$WANT_MPFR_TRUE%;t t
-s%@WANT_MPFR_FALSE@%$WANT_MPFR_FALSE%;t t
-s%@CC@%$CC%;t t
-s%@CCAS@%$CCAS%;t t
-s%@CPP@%$CPP%;t t
-s%@LN_S@%$LN_S%;t t
-s%@M4@%$M4%;t t
-s%@AR@%$AR%;t t
-s%@CALLING_CONVENTIONS_OBJS@%$CALLING_CONVENTIONS_OBJS%;t t
-s%@SPEED_CYCLECOUNTER_OBJS@%$SPEED_CYCLECOUNTER_OBJS%;t t
-s%@EXEEXT@%$EXEEXT%;t t
-s%@OBJEXT@%$OBJEXT%;t t
-s%@RANLIB@%$RANLIB%;t t
-s%@STRIP@%$STRIP%;t t
-s%@LIBTOOL@%$LIBTOOL%;t t
-s%@U@%$U%;t t
-s%@ANSI2KNR@%$ANSI2KNR%;t t
-s%@mpn_objects@%$mpn_objects%;t t
-s%@mpn_objs_in_libgmp@%$mpn_objs_in_libgmp%;t t
-s%@gmp_srclinks@%$gmp_srclinks%;t t
-CEOF
-
-EOF
-
-  cat >>$CONFIG_STATUS <<\EOF
-  # Split the substitutions into bite-sized pieces for seds with
-  # small command number limits, like on Digital OSF/1 and HP-UX.
-  ac_max_sed_lines=48
-  ac_sed_frag=1 # Number of current file.
-  ac_beg=1 # First line for current file.
-  ac_end=$ac_max_sed_lines # Line after last line for current file.
-  ac_more_lines=:
-  ac_sed_cmds=""
-  while $ac_more_lines; do
-    if test $ac_beg -gt 1; then
-      sed "1,${ac_beg}d; ${ac_end}q" $ac_cs_root.subs >$ac_cs_root.sfrag
-    else
-      sed "${ac_end}q" $ac_cs_root.subs >$ac_cs_root.sfrag
-    fi
-    if test ! -s $ac_cs_root.sfrag; then
-      ac_more_lines=false
-      rm -f $ac_cs_root.sfrag
-    else
-      # The purpose of the label and of the branching condition is to
-      # speed up the sed processing (if there are no `@' at all, there
-      # is no need to browse any of the substitutions).
-      # These are the two extra sed commands mentioned above.
-      (echo ':t
-  /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $ac_cs_root.sfrag) >$ac_cs_root.s$ac_sed_frag
-      if test -z "$ac_sed_cmds"; then
-  	ac_sed_cmds="sed -f $ac_cs_root.s$ac_sed_frag"
-      else
-  	ac_sed_cmds="$ac_sed_cmds | sed -f $ac_cs_root.s$ac_sed_frag"
-      fi
-      ac_sed_frag=`expr $ac_sed_frag + 1`
-      ac_beg=$ac_end
-      ac_end=`expr $ac_end + $ac_max_sed_lines`
-    fi
-  done
-  if test -z "$ac_sed_cmds"; then
-    ac_sed_cmds=cat
-  fi
-fi # test -n "$CONFIG_FILES"
-
-EOF
-cat >>$CONFIG_STATUS <<\EOF
-for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
-  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
-  case "$ac_file" in
-  *:*) ac_file_in=`echo "$ac_file" | sed 's%[^:]*:%%'`
-       ac_file=`echo "$ac_file" | sed 's%:.*%%'` ;;
-  *) ac_file_in="${ac_file}.in" ;;
-  esac
-
-  # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
-
-  # Remove last slash and all that follows it.  Not all systems have dirname.
-  ac_dir=`echo "$ac_file" | sed 's%/[^/][^/]*$%%'`
-  if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
-    # The file is in a subdirectory.
-    test ! -d "$ac_dir" && mkdir "$ac_dir"
-    ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
-    # A "../" for each directory in $ac_dir_suffix.
-    ac_dots=`echo "$ac_dir_suffix" | sed 's%/[^/]*%../%g'`
-  else
-    ac_dir_suffix= ac_dots=
-  fi
-
-  case "$ac_given_srcdir" in
-  .)  srcdir=.
-      if test -z "$ac_dots"; then top_srcdir=.
-      else top_srcdir=`echo $ac_dots | sed 's%/$%%'`; fi ;;
-  [\\/]* | ?:[\\/]* )
-      srcdir="$ac_given_srcdir$ac_dir_suffix";
-      top_srcdir=$ac_given_srcdir ;;
-  *) # Relative path.
-    srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
-    top_srcdir="$ac_dots$ac_given_srcdir" ;;
-  esac
-
-  case "$ac_given_INSTALL" in
-  [\\/$]* | ?:[\\/]* ) INSTALL="$ac_given_INSTALL" ;;
-  *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
-  esac
-
-  echo creating "$ac_file"
-  rm -f "$ac_file"
-  configure_input="Generated automatically from `echo $ac_file_in |
-                                                 sed 's%.*/%%'` by configure."
-  case "$ac_file" in
-  *[Mm]akefile*) ac_comsub="1i\\
-# $configure_input" ;;
-  *) ac_comsub= ;;
-  esac
-
-  # Don't redirect the output to AC_FILE directly: use `mv' so that updating
-  # is atomic, and doesn't need trapping.
-  ac_file_inputs=`echo "$ac_file_in" |
-                  sed -e "s%:% $ac_given_srcdir/%g;s%^%$ac_given_srcdir/%"`
-  for ac_file_input in $ac_file_inputs;
-  do
-    test -f "$ac_file_input" ||
-        { echo "configure: error: cannot find input file \`$ac_file_input'" 1>&2; exit 1; }
-  done
-EOF
-cat >>$CONFIG_STATUS <<EOF
-  sed -e "$ac_comsub
-$ac_vpsub
-$extrasub
-EOF
-cat >>$CONFIG_STATUS <<\EOF
-:t
-/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
-s%@configure_input@%$configure_input%;t t
-s%@srcdir@%$srcdir%;t t
-s%@top_srcdir@%$top_srcdir%;t t
-s%@INSTALL@%$INSTALL%;t t
-" $ac_file_inputs | (eval "$ac_sed_cmds") >$ac_cs_root.out
-  mv $ac_cs_root.out $ac_file
-
-fi; done
-rm -f $ac_cs_root.s*
-EOF
-cat >>$CONFIG_STATUS <<\EOF
-
-#
-# CONFIG_HEADER section.
-#
-
-# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where
-# NAME is the cpp macro being defined and VALUE is the value it is being given.
-#
-# ac_d sets the value in "#define NAME VALUE" lines.
-ac_dA='s%^\([ 	]*\)#\([ 	]*define[ 	][ 	]*\)'
-ac_dB='[ 	].*$%\1#\2'
-ac_dC=' '
-ac_dD='%;t'
-# ac_u turns "#undef NAME" without trailing blanks into "#define NAME VALUE".
-ac_uA='s%^\([ 	]*\)#\([ 	]*\)undef\([ 	][ 	]*\)'
-ac_uB='$%\1#\2define\3'
-ac_uC=' '
-ac_uD='%;t'
-
-for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then
-  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
-  case "$ac_file" in
-  *:*) ac_file_in=`echo "$ac_file" | sed 's%[^:]*:%%'`
-       ac_file=`echo "$ac_file" | sed 's%:.*%%'` ;;
-  *) ac_file_in="${ac_file}.in" ;;
-  esac
-
-  echo creating $ac_file
-
-  rm -f $ac_cs_root.frag $ac_cs_root.in $ac_cs_root.out
-  ac_file_inputs=`echo "$ac_file_in" |
-                  sed -e "s%:% $ac_given_srcdir/%g;s%^%$ac_given_srcdir/%"`
-    for ac_file_input in $ac_file_inputs;
-  do
-    test -f "$ac_file_input" ||
-        { echo "configure: error: cannot find input file \`$ac_file_input'" 1>&2; exit 1; }
-  done
-  # Remove the trailing spaces.
-  sed -e 's/[ 	]*$//' $ac_file_inputs >$ac_cs_root.in
-
-EOF
-
-# Transform confdefs.h into two sed scripts, `conftest.defines' and
-# `conftest.undefs', that substitutes the proper values into
-# config.h.in to produce config.h.  The first handles `#define'
-# templates, and the second `#undef' templates.
-# And first: Protect against being on the right side of a sed subst in
-# config.status.  Protect against being in an unquoted here document
-# in config.status.
-rm -f conftest.defines conftest.undefs
-ac_cs_root=conftest
-cat >$ac_cs_root.hdr <<\EOF
-s/[\\&%]/\\&/g
-s%[\\$`]%\\&%g
-t clear
-: clear
-s%^[ 	]*#[ 	]*define[ 	][ 	]*\(\([^ 	(][^ 	(]*\)([^)]*)\)[ 	]*\(.*\)$%${ac_dA}\2${ac_dB}\1${ac_dC}\3${ac_dD}%gp
-t cleanup
-s%^[ 	]*#[ 	]*define[ 	][ 	]*\([^ 	][^ 	]*\)[ 	]*\(.*\)$%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp
-: cleanup
-EOF
-# If some macros were called several times there might be several times
-# the same #defines, which is useless.  Nevertheless, we may not want to
-# sort them, since we want the *last* AC_DEFINE to be honored.
-uniq confdefs.h | sed -n -f $ac_cs_root.hdr >conftest.defines
-sed -e 's/ac_d/ac_u/g' conftest.defines >conftest.undefs
-rm -f $ac_cs_root.hdr
-
-# This sed command replaces #undef with comments.  This is necessary, for
-# example, in the case of _POSIX_SOURCE, which is predefined and required
-# on some systems where configure will not decide to define it.
-cat >>conftest.undefs <<\EOF
-s%^[ 	]*#[ 	]*undef[ 	][ 	]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */%
-EOF
-
-# Break up conftest.defines because some shells have a limit on the size
-# of here documents, and old seds have small limits too (100 cmds).
-echo '  # Handle all the #define templates only if necessary.' >>$CONFIG_STATUS
-echo '  if egrep "^[ 	]*#[ 	]*define" $ac_cs_root.in >/dev/null; then' >>$CONFIG_STATUS
-echo '  # If there are no defines, we may have an empty if/fi' >>$CONFIG_STATUS
-echo '  :' >>$CONFIG_STATUS
-rm -f conftest.tail
-while grep . conftest.defines >/dev/null
-do
-  # Write a limited-size here document to $ac_cs_root.frag.
-  echo '  cat >$ac_cs_root.frag <<CEOF' >>$CONFIG_STATUS
-  echo '/^[ 	]*#[ 	]*define/!b' >>$CONFIG_STATUS
-  sed ${ac_max_here_lines}q conftest.defines >>$CONFIG_STATUS
-  echo 'CEOF
-  sed -f $ac_cs_root.frag $ac_cs_root.in >$ac_cs_root.out
-  rm -f $ac_cs_root.in
-  mv $ac_cs_root.out $ac_cs_root.in
-' >>$CONFIG_STATUS
-  sed 1,${ac_max_here_lines}d conftest.defines >conftest.tail
-  rm -f conftest.defines
-  mv conftest.tail conftest.defines
-done
-rm -f conftest.defines
-echo '  fi # egrep' >>$CONFIG_STATUS
-echo >>$CONFIG_STATUS
-
-# Break up conftest.undefs because some shells have a limit on the size
-# of here documents, and old seds have small limits too (100 cmds).
-echo '  # Handle all the #undef templates' >>$CONFIG_STATUS
-rm -f conftest.tail
-while grep . conftest.undefs >/dev/null
-do
-  # Write a limited-size here document to $ac_cs_root.frag.
-  echo '  cat >$ac_cs_root.frag <<CEOF' >>$CONFIG_STATUS
-  echo '/^[ 	]*#[ 	]*undef/!b' >>$CONFIG_STATUS
-  sed ${ac_max_here_lines}q conftest.undefs >>$CONFIG_STATUS
-  echo 'CEOF
-  sed -f $ac_cs_root.frag $ac_cs_root.in >$ac_cs_root.out
-  rm -f $ac_cs_root.in
-  mv $ac_cs_root.out $ac_cs_root.in
-' >>$CONFIG_STATUS
-  sed 1,${ac_max_here_lines}d conftest.undefs >conftest.tail
-  rm -f conftest.undefs
-  mv conftest.tail conftest.undefs
-done
-rm -f conftest.undefs
-
-cat >>$CONFIG_STATUS <<\EOF
-  rm -f $ac_cs_root.frag $ac_cs_root.h
-  echo "/* $ac_file.  Generated automatically by configure.  */" >$ac_cs_root.h
-  cat $ac_cs_root.in >>$ac_cs_root.h
-  rm -f $ac_cs_root.in
-  if cmp -s $ac_file $ac_cs_root.h 2>/dev/null; then
-    echo "$ac_file is unchanged"
-    rm -f $ac_cs_root.h
-  else
-    # Remove last slash and all that follows it.  Not all systems have dirname.
-    ac_dir=`echo "$ac_file" | sed 's%/[^/][^/]*$%%'`
-    if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
-      # The file is in a subdirectory.
-      test ! -d "$ac_dir" && mkdir "$ac_dir"
-    fi
-    rm -f $ac_file
-    mv $ac_cs_root.h $ac_file
-  fi
-fi; done
-EOF
-cat >>$CONFIG_STATUS <<\EOF
-
-#
-# CONFIG_LINKS section.
-#
-srcdir=$ac_given_srcdir
-
-for ac_file in : $CONFIG_LINKS; do if test "x$ac_file" != x:; then
-  ac_dest=`echo "$ac_file" | sed 's%:.*%%'`
-  ac_source=`echo "$ac_file" | sed 's%[^:]*:%%'`
-
-  echo "copying $srcdir/$ac_source to $ac_dest"
-
-  if test ! -r $srcdir/$ac_source; then
-    { echo "configure: error: $srcdir/$ac_source: File not found" 1>&2; exit 1; }
-  fi
-  rm -f $ac_dest
-
-  # Make relative symlinks.
-  # Remove last slash and all that follows it.  Not all systems have dirname.
-  ac_dest_dir=`echo $ac_dest | sed 's%/[^/][^/]*$%%'`
-  if test "$ac_dest_dir" != "$ac_dest" && test "$ac_dest_dir" != .; then
-    # The dest file is in a subdirectory.
-    test ! -d "$ac_dest_dir" && mkdir "$ac_dest_dir"
-    ac_dest_dir_suffix="/`echo $ac_dest_dir|sed 's%^\./%%'`"
-    # A "../" for each directory in $ac_dest_dir_suffix.
-    ac_dots=`echo $ac_dest_dir_suffix|sed 's%/[^/]*%../%g'`
-  else
-    ac_dest_dir_suffix= ac_dots=
-  fi
-
-  case "$srcdir" in
-  [\\/$]* | ?:[\\/]* ) ac_rel_source="$srcdir/$ac_source" ;;
-      *) ac_rel_source="$ac_dots$srcdir/$ac_source" ;;
-  esac
-
-  # Note: Dodgy local mods to 'make things work' in an environment (cygwin)
-  # that supports symlinks (through silly hack) using tools that don't
-  # understand them (mingw). The end sometimes justifies the means, son.
-  #
-  # Make a symlink if possible; otherwise try a hard link.
-  #if ln -s $ac_rel_source $ac_dest 2>/dev/null ||
-  #   ln $srcdir/$ac_source $ac_dest; then :
-  # 
-  # Note: If the -p offends your 'cp', just drop it; no harm done, you'll just 
-  # get more recompilations.
-  # 
-  if cp -p $srcdir/$ac_source $ac_dest; then :
-  else
-    { echo "configure: error: cannot copy $ac_dest to $srcdir/$ac_source" 1>&2; exit 1; }
-  fi
-fi; done
-EOF
-cat >>$CONFIG_STATUS <<\EOF
-
-#
-# CONFIG_COMMANDS section.
-#
-for ac_file in .. $CONFIG_COMMANDS; do if test "x$ac_file" != x..; then
-  ac_dest=`echo "$ac_file" | sed 's%:.*%%'`
-  ac_source=`echo "$ac_file" | sed 's%[^:]*:%%'`
-
-  case "$ac_dest" in
-    default-1 ) test -z "$CONFIG_HEADERS" || echo timestamp > stamp-h ;;
-  esac
-fi;done
-EOF
-
-cat >>$CONFIG_STATUS <<\EOF
-
-exit 0
-EOF
-chmod +x $CONFIG_STATUS
-rm -fr confdefs* $ac_clean_files
-trap 'exit 1' 1 2 15
-
-test "$no_create" = yes || $SHELL $CONFIG_STATUS || exit 1
diff --git a/ghc/rts/gmp/configure.in b/ghc/rts/gmp/configure.in
deleted file mode 100644
index 18f610fe29..0000000000
--- a/ghc/rts/gmp/configure.in
+++ /dev/null
@@ -1,950 +0,0 @@
-dnl  Process this file with autoconf to produce a configure script.
-
-
-dnl  Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
-dnl
-dnl  This file is part of the GNU MP Library.
-dnl
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-dnl
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-dnl
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-AC_REVISION($Revision: 1.8 $)dnl
-AC_PREREQ(2.14)dnl
-AC_INIT(gmp-impl.h)
-
-dnl Check system.
-AC_CANONICAL_SYSTEM
-
-dnl  Automake
-AM_INIT_AUTOMAKE(gmp, GMP_VERSION)
-AM_CONFIG_HEADER(config.h:config.in)
-AM_MAINTAINER_MODE
-
-dnl  GMP specific
-GMP_INIT(config.m4)
-
-
-AC_ARG_ENABLE(assert,
-AC_HELP_STRING([--enable-assert],[enable ASSERT checking [default=no]]),
-[case "${enableval}" in
-yes|no) ;;
-*) AC_MSG_ERROR([bad value ${enableval} for --enable-assert, need yes or no]) ;;
-esac],
-[enable_assert=no])
-
-if test "$enable_assert" = "yes"; then
-  AC_DEFINE(WANT_ASSERT,1,
-  [./configure --enable-assert option, to enable some ASSERT()s])
-fi
-
-
-AC_ARG_ENABLE(alloca,
-AC_HELP_STRING([--enable-alloca],[use alloca for temp space [default=yes]]),
-[case "${enableval}" in
-yes|no) ;;
-*) AC_MSG_ERROR([bad value ${enableval} for --enable-alloca, need yes or no]) ;;
-esac],
-[enable_alloca=yes])
-
-if test "$enable_alloca" = "no"; then
-  AC_DEFINE(USE_STACK_ALLOC,1,
-  [./configure --disable-alloca option, to use stack-alloc.c, not alloca])
-fi
-
-
-AC_ARG_ENABLE(fft,
-AC_HELP_STRING([--enable-fft],[enable FFTs for multiplication [default=no]]),
-[case "${enableval}" in
-yes|no) ;;
-*) AC_MSG_ERROR([bad value ${enableval} for --enable-fft, need yes or no]) ;;
-esac],
-[enable_fft=no])
-
-if test "$enable_fft" = "yes"; then
-  AC_DEFINE(WANT_FFT,1,
-  [./configure --enable-fft option, to enable FFTs for multiplication])
-fi
-
-
-AC_ARG_ENABLE(mpbsd,
-AC_HELP_STRING([--enable-mpbsd],[build Berkley MP compatibility library [default=no]]),
-[case "${enableval}" in
-yes|no) ;;
-*) AC_MSG_ERROR([bad value ${enableval} for --enable-mpbsd, need yes or no]) ;;
-esac],
-[enable_mpbsd=no])
-AM_CONDITIONAL(WANT_MPBSD, test "$enable_mpbsd" = "yes")
-
-
-AC_ARG_ENABLE(mpfr,
-AC_HELP_STRING([--enable-mpfr],[build MPFR [default=no]]),
-[case "${enableval}" in
-yes|no) ;;
-*) AC_MSG_ERROR([bad value ${enableval} for --enable-mpfr, need yes or no]) ;;
-esac],
-[enable_mpfr=no])
-AM_CONDITIONAL(WANT_MPFR, test "$enable_mpfr" = "yes")
-
-
-dnl Switch on OS and determine what compiler to use.
-dnl
-dnl  os_64bit	           Set to "yes" if OS is 64-bit capable.
-dnl                        FIXME: Rename to `check_64bit_compiler'!
-dnl  cclist		   List of compilers, best first.
-dnl  gmp_cflags_{cc}	   Flags for compiler named {cc}.
-dnl  gmp_cflags64_{cc}     Flags for compiler named {cc} for 64-bit code.
-dnl  gmp_optcflags_{cc}	   Optional compiler flags.
-dnl  gmp_xoptcflags_{cc}   Exclusive optional compiler flags.
-dnl
-os_64bit="no"
-cclist="gcc cc"		# FIXME: Prefer c89 to cc.
-gmp_cflags_gcc="-g -O2"
-gmp_cflags64_gcc="-g -O2"
-gmp_cflags_cc="-g"
-gmp_cflags64_cc="-g"
-
-case "$target" in
-  # Alpha
-  alpha*-cray-unicos*)
-    # Don't perform any assembly syntax tests on this beast.
-    gmp_no_asm_syntax_testing=yes
-    cclist=cc
-    gmp_cflags_cc="$gmp_cflags_cc -O"
-    ;;
-  alpha*-*-osf*)
-    flavour=`echo $target_cpu | sed 's/^alpha//g'`
-    if test -n "$flavour"; then
-      case $flavour in	   # compilers don't seem to understand `ev67' and such.
-	ev6? | ev7*) flavour=ev6;;
-      esac
-      gmp_optcflags_gcc="-mcpu=$flavour"
-      # FIXME: We shouldn't fail fatally if none of these work, but that's
-      # how xoptcflags work and we don't have any other mechanism right now.
-      # Why do we need this here and not for alpha*-*-* below?
-      gmp_xoptcflags_gcc="-Wa,-arch,${flavour} -Wa,-m${flavour}"
-      gmp_optcflags_cc="-arch $flavour -tune $flavour"
-    fi
-    ;;
-  alpha*-*-*)
-    cclist="gcc"
-    flavour=`echo $target_cpu | sed 's/^alpha//g'`
-    if test -n "$flavour"; then
-      case $flavour in
-	ev6? | ev7*) flavour=ev6;;
-      esac
-      gmp_optcflags_gcc="-mcpu=$flavour"
-    fi
-    ;;
-  # Cray vector machines.  This must come after alpha* so that we can
-  # recognize present and future vector processors with a wildcard.
-  *-cray-unicos*)
-    # Don't perform any assembly syntax tests on this beast.
-    gmp_no_asm_syntax_testing=yes
-    cclist=cc
-    # Don't inherit default gmp_cflags_cc value; it comes with -g which
-    # disables all optimization on Cray vector systems
-    gmp_cflags_cc="-O"
-    ;;
-
-  # AMD and Intel x86 configurations
-  [i?86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-*])
-    # Rumour has it -O2 used to give worse register allocation than just -O.
-    gmp_cflags_gcc="-g -O -fomit-frame-pointer"
-
-    case "${target}" in
-      i386*-*-*)    gmp_optcflags_gcc="-mcpu=i386 -march=i386";;
-      i486*-*-*)    gmp_optcflags_gcc="-mcpu=i486 -march=i486";;
-      i586*-*-* | pentium-*-* | pentiummmx-*-*)
-                    gmp_optcflags_gcc="-mcpu=pentium -march=pentium";;
-
-      # -march=pentiumpro not used because mpz/powm.c (swox cvs rev 1.4)
-      # tickles a bug in gcc 2.95.2 (believed fixed in 2.96).
-      [i686*-*-* | pentiumpro-*-* | pentium[23]-*-*])
-                    gmp_optcflags_gcc="-mcpu=pentiumpro";;
-
-      k6*-*-*)      gmp_optcflags_gcc="-mcpu=k6 -march=k6";;
-
-      # Athlon instruction costs are close to p6: 3 cycle load latency, 4-6
-      # cycle mul, 40 cycle div, pairable adc, ...
-      # FIXME: Change this when gcc gets something specific for Athlon.
-      # -march=pentiumpro not used, per i686 above.
-      athlon-*-*)   gmp_optcflags_gcc="-mcpu=pentiumpro";;
-    esac
-    ;;
-
-  # Sparc
-  [ultrasparc*-*-solaris2.[7-9] | sparcv9-*-solaris2.[7-9]])
-    os_64bit=yes
-    gmp_cflags_gcc="$gmp_cflags_gcc -Wa,-xarch=v8plus"
-    gmp_xoptcflags_gcc="-mcpu=v9 -mcpu=v8 -mv8"
-    gmp_cflags64_gcc="$gmp_cflags64_gcc -m64 -mptr64 -Wa,-xarch=v9 -mcpu=v9"
-    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4"
-    gmp_cflags64_cc="-xtarget=native -xarch=v9 -xO4"
-    ;;
-  sparc64-*-linux*)
-    # Need to think more about the options passed here.  This isn't good for
-    # some sparc64 linux distros, since we end up not optimizing when all the
-    # options below fail.
-    os_64bit=yes
-    gmp_cflags64_gcc="$gmp_cflags64_gcc -m64 -mptr64 -Wa,-xarch=v9 -mcpu=v9"
-    gmp_cflags_gcc="$gmp_cflags_gcc -m32"
-    gmp_xoptflags_gcc="-mcpu=ultrasparc -mvis"
-    ;;
-  ultrasparc*-*-* | sparcv9-*-*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -Wa,-xarch=v8plus"
-    gmp_xoptcflags_gcc="-mcpu=v9 -mcpu=v8 -mv8"
-    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4"
-    ;;
-  sparcv8*-*-solaris2.* | microsparc*-*-solaris2.*)
-    gmp_cflags_gcc="$gmp_cflags_gcc"
-    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
-    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4"
-    ;;
-  sparcv8*-*-* | microsparc*-*-*)		# SunOS, Linux, *BSD
-    cclist="gcc acc cc"
-    gmp_cflags_gcc="$gmp_cflags_gcc"
-    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
-    gmp_cflags_acc="-g -O2 -cg92"
-    gmp_cflags_cc="-O2"		# FIXME: Flag for v8?
-    ;;
-  supersparc*-*-solaris2.*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -DSUPERSPARC"
-    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
-    gmp_cflags_cc="-xtarget=native -xarch=v8 -xO4 -DSUPERSPARC"
-    ;;
-  supersparc*-*-*)		# SunOS, Linux, *BSD
-    cclist="gcc acc cc"
-    gmp_cflags_gcc="$gmp_cflags_gcc -DSUPERSPARC"
-    gmp_xoptcflags_gcc="-mcpu=v8 -mv8"
-    gmp_cflags_acc="-g -O2 -cg92 -DSUPERSPARC"
-    gmp_cflags_cc="-O2 -DSUPERSPARC"	# FIXME: Flag for v8?
-    ;;
-  *sparc*-*-*)
-    cclist="gcc acc cc"
-    gmp_cflags_acc="-g -O2"
-    gmp_cflags_cc="-g -O2"
-    ;;
-
-  # POWER/PowerPC
-  powerpc64-*-aix*)
-    cclist="gcc xlc"
-    gmp_cflags_gcc="$gmp_cflags_gcc -maix64 -mpowerpc64"
-    gmp_cflags_xlc="-g -O2 -q64 -qtune=pwr3"
-    ;;
-  powerpc*-*-aix*)
-    cclist="gcc xlc"
-    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc"
-    gmp_cflags_xlc="$gmp_cflags_cc -qarch=ppc -O2"
-    ;;
-  power-*-aix*)
-    cclist="gcc xlc"
-    gmp_cflags_gcc="$gmp_cflags_gcc -mpower"
-    gmp_cflags_xlc="$gmp_cflags_cc -qarch=pwr -O2"
-    ;;
-  powerpc64*-*-*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc64"
-    AC_DEFINE(_LONG_LONG_LIMB)	dnl FIXME: Remove.
-    ;;
-  powerpc-apple-darwin* | powerpc-apple-macosx*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc -traditional-cpp"
-    ;;
-  powerpc*-*-*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -mpowerpc"
-    ;;
-
-  # MIPS
-  mips-sgi-irix6.*)
-    os_64bit=yes
-    gmp_cflags64_gcc="-g -O2 -mabi=n32"
-    gmp_cflags64_cc="$gmp_cflags64_cc -O2 -n32"
-    ;;
-
-  # Motorola 68k family
-  m88110*-*-*)
-    gmp_cflags_gcc="-g -O -m88110"	dnl  FIXME: Use `-O2'?
-    ;;
-  m68*-*-*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -fomit-frame-pointer"
-    ;;
-
-  # HP
-  hppa1.0*-*-*)
-    cclist="gcc c89 cc"
-    gmp_cflags_c89="$gmp_cflags_cc +O2"
-    gmp_cflags_cc="$gmp_cflags_cc +O2"
-    ;;
-  hppa2.0w*-*-*)
-    cclist="c89 cc"
-    gmp_cflags_c89="+DD64 +O3"
-    gmp_cflags_cc="+DD64 +O3"
-    ;;
-  hppa2.0*-*-*)
-    os_64bit=yes
-    cclist="gcc c89 cc"
-    gmp_cflags64_gcc="$gmp_cflags64_gcc -mWHAT -D_LONG_LONG_LIMB"
-    # +O2 to cc triggers bug in mpz/powm.c (1.4)
-    gmp_cflags64_c89="+DA2.0 +e +O3 -D_LONG_LONG_LIMB"
-    gmp_cflags64_cc="+DA2.0 +e +O3 -D_LONG_LONG_LIMB"
-    gmp_cflags_c89="$gmp_cflags_cc +O2"
-    gmp_cflags_cc="$gmp_cflags_cc +O2"
-    ;;
-
-  # VAX
-  vax*-*-*)
-    gmp_cflags_gcc="$gmp_cflags_gcc -fomit-frame-pointer"
-    ;;
-
-  # Fujitsu
-  [f30[01]-fujitsu-sysv*])
-    cclist="gcc vcc"
-    gmp_cflags_vcc="-g"		# FIXME: flags for vcc?
-    ;;
-esac
-
-case "${target}" in
-  *-*-mingw32) gmp_cflags_gcc="$gmp_cflags_gcc -mno-cygwin";;
-esac
-
-dnl  Check for programs needed by macros for finding compiler.
-dnl  More programs are checked for below, when a compiler is found.
-AC_PROG_NM	dnl  Macro from Libtool.
-# nm on 64-bit AIX needs to know the object file format 
-case "$target" in
-  powerpc64*-*-aix*)
-    NM="$NM -X 64"
-    ;;
-esac   
-
-# Save CFLAGS given on command line.
-gmp_user_CFLAGS="$CFLAGS"
-
-if test -z "$CC"; then
-  # Find compiler.
-  GMP_PROG_CC_FIND($cclist, $os_64bit)
-
-  # If 64-bit OS and we have a 64-bit compiler, use it.
-  if test -n "$os_64bit" && test -n "$CC64"; then
-    CC=$CC64
-    CFLAGS=$CFLAGS64
-  else
-    eval CFLAGS=\$gmp_cflags_$CC  
-  fi
-
-  # Try compiler flags that may work with only some compiler versions.
-  # gmp_optcflags: All or nothing.
-  eval optcflags=\$gmp_optcflags_$CC
-  if test -n "$optcflags"; then
-    CFLAGS_save="$CFLAGS"
-    CFLAGS="$CFLAGS $optcflags"
-    AC_MSG_CHECKING([whether $CC accepts $optcflags])
-    AC_LANG_C
-    AC_TRY_COMPILER([int main(){return(0);}], optok, cross)
-    if test "$optok" = "yes"; then
-      AC_MSG_RESULT([yes])
-    else
-      AC_MSG_RESULT([no])
-      CFLAGS="$CFLAGS_save"
-    fi
-  fi
-  # gmp_xoptcflags: First is best, one has to work.
-  eval xoptcflags=\$gmp_xoptcflags_$CC
-  if test -n "$xoptcflags"; then
-    gmp_found="no"
-    for xopt in $xoptcflags; do
-      CFLAGS_save="$CFLAGS"
-      CFLAGS="$CFLAGS $xopt"
-      AC_MSG_CHECKING([whether $CC accepts $xopt])
-      AC_LANG_C
-      AC_TRY_COMPILER([int main(){return(0);}], optok, cross)
-      if test "$optok" = "yes"; then
-        AC_MSG_RESULT([yes])
-        gmp_found="yes"
-        break
-      else
-        AC_MSG_RESULT([no])
-        CFLAGS="$CFLAGS_save"
-      fi
-    done
-    if test "$gmp_found" = "no"; then
-      echo ["$0: fatal: need a compiler that understands one of $xoptcflags"]
-      exit 1
-    fi
-  fi
-fi
-
-# Restore CFLAGS given on command line.
-# FIXME: We've run through quite some unnecessary code looking for a
-# nice compiler and working flags for it, just to spoil that with user
-# supplied flags.
-test -n "$gmp_user_CFLAGS" && CFLAGS="$gmp_user_CFLAGS"
-
-# Select chosen compiler.
-GMP_PROG_CC_SELECT
-
-# How to assemble.
-CCAS="$CC -c"
-AC_SUBST(CCAS)
-
-dnl Checks for programs.
-dnl --------------------
-AC_PROG_CPP
-AC_PROG_INSTALL
-AC_PROG_LN_S
-GMP_PROG_M4
-AC_CHECK_PROG(AR, ar, ar)
-# ar on AIX needs to know the object file format 
-case "$target" in
-  powerpc64*-*-aix*)
-    AR="$AR -X 64"
-    ;;
-esac   
-dnl  FIXME: Find good ld?  /usr/ucb/ld on Solaris won't work.
-
-dnl Checks for assembly syntax.
-if test "$gmp_no_asm_syntax_testing" != "yes"; then
-  GMP_CHECK_ASM_TEXT
-  GMP_CHECK_ASM_DATA
-  GMP_CHECK_ASM_GLOBL
-  GMP_CHECK_ASM_LABEL_SUFFIX
-  GMP_CHECK_ASM_TYPE
-  GMP_CHECK_ASM_SIZE
-  GMP_CHECK_ASM_LSYM_PREFIX
-  GMP_CHECK_ASM_W32
-  GMP_CHECK_ASM_UNDERSCORE(underscore=yes, underscore=no)
-  GMP_CHECK_ASM_ALIGN_LOG(asm_align=log, asm_align=nolog)
-fi
-
-dnl  FIXME: Check for FPU and set `floating_point' appropriately.
-
-dnl  ========================================
-dnl  Configuring mpn.
-dnl  ----------------------------------------
-dnl  Set the following target specific variables:
-dnl  path		where to search for source files
-dnl  family		processor family (Needed for building 
-dnl 			asm-syntax.h for now.  FIXME: Remove.)
-dnl  extra_functions	extra functions
-
-family=generic
-
-case ${target} in
-  arm*-*-*)
-    path="arm"
-    ;;
-  [sparcv9*-*-solaris2.[789]* | sparc64*-*-solaris2.[789]* | ultrasparc*-*-solaris2.[789]*])
-    if test -n "$CC64"
-      then path="sparc64"
-      else path="sparc32/v9 sparc32/v8 sparc32"
-    fi
-    ;;
-  sparc64-*-linux*)
-    if test -n "$CC64"
-      then path="sparc64"
-      else path="sparc32/v9 sparc32/v8 sparc32"
-    fi
-    ;;
-  sparcv8*-*-* | microsparc*-*-*)
-	path="sparc32/v8 sparc32"
-	if test x${floating_point} = xno
-	  then extra_functions="udiv_nfp"
-	  else extra_functions="udiv_fp"
-	fi
-	;;
-  sparcv9*-*-* | ultrasparc*-*-*)
-	path="sparc32/v9 sparc32/v8 sparc32"
-	extra_functions="udiv_fp"
-	;;
-  supersparc*-*-*)
-	path="sparc32/v8/supersparc sparc32/v8 sparc32"
-	extra_functions="udiv"
-	;;
-  sparc*-*-*) path="sparc32"
-	if test x${floating_point} = xno
-	  then extra_functions="udiv_nfp"
-	  else extra_functions="udiv_fp"
-	fi
-	;;
-  hppa7000*-*-*)
-    path="hppa/hppa1_1 hppa"
-    extra_functions="udiv_qrnnd"
-    ;;
-  hppa1.0*-*-*)
-    path="hppa"
-    extra_functions="udiv_qrnnd"
-    ;;
-  hppa2.0w-*-*)
-    path="pa64w"
-    extra_functions="umul_ppmm udiv_qrnnd"
-    ;;
-  hppa2.0*-*-*)
-    if test -n "$CC64"; then
-      path="pa64"
-      extra_functions="umul_ppmm udiv_qrnnd"
-      # We need to use the system compiler, or actually the system assembler,
-      # since GAS has not been ported to understand the 2.0 instructions.
-      CCAS="$CC64 -c"
-    else
-      # FIXME: path should be "hppa/hppa2_0 hppa/hppa1_1 hppa"
-      path="hppa/hppa1_1 hppa"
-      extra_functions="udiv_qrnnd"
-    fi
-    ;;
-  hppa*-*-*)					#assume pa7100
-    path="hppa/hppa1_1/pa7100 hppa/hppa1_1 hppa"
-    extra_functions="udiv_qrnnd";;
-  [f30[01]-fujitsu-sysv*])
-    path=fujitsu;;
-  alphaev6*-*-*) path="alpha/ev6 alpha"; extra_functions="invert_limb cntlz";;
-  alphaev5*-*-*) path="alpha/ev5 alpha"; extra_functions="invert_limb cntlz";;
-  alpha*-*-*) path="alpha"; extra_functions="invert_limb cntlz";;
-  # Cray vector machines.  This must come after alpha* so that we can
-  # recognize present and future vector processors with a wildcard.
-  *-cray-unicos*)
-    path="cray"
-    extra_functions="mulww";;
-  am29000*-*-*) path="a29k";;
-  a29k*-*-*) path="a29k";;
-
-  # AMD and Intel x86 configurations
-
-  [i?86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-*])
-    gmp_m4postinc="x86/x86-defs.m4"
-    extra_functions="udiv umul"
-    CALLING_CONVENTIONS_OBJS="x86call.o x86check.o"
-
-    GMP_CHECK_ASM_SHLDL_CL(
-      [GMP_DEFINE(WANT_SHLDL_CL,1)],
-      [GMP_DEFINE(WANT_SHLDL_CL,0)])
-    GMP_CHECK_ASM_ALIGN_FILL_0x90
-
-    # the CPUs below wanting to know about mmx
-    case ${target} in
-      [pentiummmx-*-* | pentium[23]-*-* | k6*-*-* | athlon-*-*])
-	GMP_CHECK_ASM_MMX(tmp_mmx=yes, tmp_mmx=no)
-        ;;
-    esac
-
-    # default for anything not otherwise mentioned
-    path="x86"
- 
-    case ${target} in
-      [i[34]86*-*-*])
-        path="x86"
-        ;;
-      k5*-*-*)
-        # don't know what best suits k5
-        path="x86"
-        ;;
-      i586*-*-* | pentium-*-*)
-	path="x86/pentium x86"
-        ;;
-      pentiummmx-*-*)
-	path="x86/pentium x86"
-	if test "$tmp_mmx" = yes; then
-          path="x86/pentium/mmx $path"
-        fi
-        ;;
-      i686*-*-* | pentiumpro-*-*)
-	path="x86/p6 x86"
-        ;;
-      pentium2-*-*)
-	path="x86/p6 x86"
-	# The pentium/mmx lshift and rshift are good on p6 and can be used
-        # until there's something specific for p6.
-	if test "$tmp_mmx" = yes; then
-          path="x86/p6/mmx x86/pentium/mmx $path"
-        fi
-        ;;
-      pentium3-*-*)
-	path="x86/p6 x86"
-	# The pentium/mmx lshift and rshift are good on p6 and can be used
-        # until there's something specific for p6.
-	if test "$tmp_mmx" = yes; then
-          path="x86/p6/p3mmx x86/p6/mmx x86/pentium/mmx $path"
-        fi
-        ;;
-      [k6[23]*-*-*])
-	path="x86/k6 x86"
-	if test "$tmp_mmx" = yes; then
-          path="x86/k6/k62mmx x86/k6/mmx $path"
-        fi
-        ;;
-      k6*-*-*)
-	path="x86/k6 x86"
-	if test "$tmp_mmx" = yes; then
-          path="x86/k6/mmx $path"
-        fi
-        ;;
-      athlon-*-*)
-	path="x86/k7 x86"
-	if test "$tmp_mmx" = yes; then
-          path="x86/k7/mmx $path"
-        fi
-        ;;
-    esac
-    ;;
-
-
-  i960*-*-*) path="i960";;
-
-  ia64*-*-*) path="ia64";;
-
-# Motorola 68k configurations.  Let m68k mean 68020-68040.
-  [m680[234]0*-*-* | m68k*-*-* | \
-  m68*-next-nextstep*])		# Nexts are at least '020
-    path="m68k/mc68020 m68k"
-    family=m68k
-    ;;
-  m68000*-*-*)
-    path="m68k"
-    family=m68k
-    ;;
-
-  m88k*-*-* | m88k*-*-*) path="m88k";;
-  m88110*-*-*) path="m88k/mc88110 m88k";;
-  ns32k*-*-*) path="ns32k";;
-
-  pyramid-*-*) path="pyr";;
-
-  ppc601-*-*) path="power powerpc32";;
-  powerpc64*-*-*) path="powerpc64";;
-  powerpc*-*-*) path="powerpc32";;
-  rs6000-*-* | power-*-* | power2-*-*)
-    path="power"
-    extra_functions="udiv_w_sdiv"
-    ;;
-
-  sh-*-*) path="sh";;
-  sh2-*-*) path="sh/sh2 sh";;
-
-  [mips[34]*-*-*]) path="mips3";;
-  mips*-*-irix6*) path="mips3";;
-  mips*-*-*) path="mips2";;
-
-  vax*-*-*) path="vax"; extra_functions="udiv_w_sdiv";;
-
-  z8000x*-*-*) path="z8000x"; extra_functions="udiv_w_sdiv";;
-  z8000*-*-*) path="z8000"; extra_functions="udiv_w_sdiv";;
-
-  clipper*-*-*) path="clipper";;
-esac
-
-AC_SUBST(CALLING_CONVENTIONS_OBJS)
-if test -n "$CALLING_CONVENTIONS_OBJS"; then
-  AC_DEFINE(HAVE_CALLING_CONVENTIONS,1,
-  [Define if mpn/tests has calling conventions checking for the CPU])
-fi
-
-
-case ${target} in
-  [i[5-8]86*-*-* | k[5-8]*-*-* | pentium*-*-* | athlon-*-*])
-    # rdtsc is in pentium and up, not in i386 and i486
-    SPEED_CYCLECOUNTER_OBJS=pentium.lo
-    ;;
-  alpha*-*-*)
-    SPEED_CYCLECOUNTER_OBJS=alpha.lo
-    ;;
-  sparcv9*-*-* | ultrasparc*-*-* | sparc64*-*-*)
-    SPEED_CYCLECOUNTER_OBJS=sparcv9.lo
-    ;;
-  hppa2*-*-*)
-    SPEED_CYCLECOUNTER_OBJS=hppa2.lo
-    ;;
-  hppa*-*-*)
-    SPEED_CYCLECOUNTER_OBJS=hppa.lo
-    ;;
-esac
-
-AC_SUBST(SPEED_CYCLECOUNTER_OBJS)
-
-if test -n "$SPEED_CYCLECOUNTER_OBJS"
-then
-  AC_DEFINE(HAVE_SPEED_CYCLECOUNTER, 1,
-  [Define if a speed_cyclecounter exists (for the tune programs)])
-fi
-
-
-dnl Extensions for executable and object files.
-dnl -------------------------------------------
-AC_EXEEXT
-AC_OBJEXT
-
-dnl Use Libtool.
-dnl ------------
-dnl  FIXME: Shared libs seem to fail on aix4.3.
-dnl  FIXME: Should invoke [AC_DISABLE_SHARED], but m4 recurses to death.
-case "$target" in
-  [*-*-aix4.[3-9]*]) enable_shared=no ;;
-esac
-AC_PROG_LIBTOOL
-
-dnl Checks for libraries.
-dnl ---------------------
-AC_CHECK_DECLS((optarg))
-
-dnl Checks for header files.
-dnl ------------------------
-AC_HEADER_STDC
-AC_CHECK_HEADERS(getopt.h unistd.h sys/sysctl.h sys/time.h)
-
-dnl Checks for typedefs, structures, and compiler characteristics.
-dnl --------------------------------------------------------------
-AC_CHECK_TYPES((void))
-AC_C_STRINGIZE
-
-dnl Checks for library functions.
-dnl -----------------------------
-dnl Most of these are only for the benefit of supplementary programs.  The
-dnl library itself doesn't use anything weird.
-dnl AC_FUNC_MEMCMP
-dnl AC_TYPE_SIGNAL
-dnl AC_CHECK_FUNCS(strtol)
-AC_CHECK_FUNCS(getopt_long getpagesize popen processor_info strtoul sysconf sysctlbyname)
-
-dnl Trick automake into thinking we've run AM_C_PROTOTYPES which it wants
-dnl for ansi2knr, and instead use our own test.  (It's only a warning
-dnl automake prints, but it's good to suppress it.)
-ifelse(0,1,[
-AM_C_PROTOTYPES
-])
-GMP_C_ANSI2KNR
-
-
-dnl  Set `syntax' to one of <blank>, "mit", "elf", "aix", "macho".
-syntax=
-# For now, we use the old switch for setting syntax.  
-# FIXME: Remove when conversion to .asm is completed.
-changequote(,)dnl
-case "${target}" in
-  m680[234]0*-*-linuxaout* | m68k*-*-linuxaout* | \
-  m68k-next-nextstep* | \
-  m68000*-*-*)
-    syntax=mit
-    ;;
-  m680[234]0*-*-linux* | m68k*-*-linux*)
-    syntax=elf
-    ;;
-  m680[234]0*-*-* | m68k*-*-*)
-    syntax=mit
-    ;;
-esac
-changequote([,])dnl
-
-dnl  ----------------------------------------
-# Now build an asm-syntax.h file for targets that include that from the
-# assembly files.
-# FIXME: Remove when conversion to .asm is completed.
-case "${family}-${underscore}-${asm_align}-${syntax}" in
-  m68k-yes-log-mit)
-    echo '#define MIT_SYNTAX' >asm-syntax.h
-    cat $srcdir/mpn/underscore.h >>asm-syntax.h
-    echo '#include "'$srcdir'/mpn/m68k/syntax.h"' >>asm-syntax.h;;
-  m68k-no-nolog-elf)
-    echo '#define ELF_SYNTAX' >asm-syntax.h
-    echo '#define C_SYMBOL_NAME(name) name' >>asm-syntax.h
-    echo '#include "'$srcdir'/mpn/m68k/syntax.h"' >>asm-syntax.h;;
-esac
-
-
-# The pattern here tests for an absolute path the same way as
-# _AC_OUTPUT_FILES in autoconf acgeneral.m4.
-GMP_DEFINE_RAW(["dnl  CONFIG_TOP_SRCDIR is a path from the mpn builddir to the top srcdir"])
-case "$srcdir" in
-[[\\/]]* | ?:[[\\/]]* )
-     GMP_DEFINE_RAW(["define(<CONFIG_TOP_SRCDIR>,<\`$srcdir'>)"])    ;;
-*)   GMP_DEFINE_RAW(["define(<CONFIG_TOP_SRCDIR>,<\`../$srcdir'>)"]) ;;
-esac
- 
-GMP_DEFINE_RAW(["include(CONFIG_TOP_SRCDIR\`/mpn/asm-defs.m4')"], POST)
-
-# Must be after asm-defs.m4
-GMP_DEFINE_RAW("define_not_for_expansion(\`HAVE_TARGET_CPU_$target_cpu')", POST)
-
-
-dnl  config.m4 post-includes
-dnl  -----------------------
-dnl  (Note x86 post include set with $path above.)
-changequote(,)dnl
-case "$target" in
-  alpha*-cray-unicos*)
-    gmp_m4postinc="alpha/unicos.m4"
-    ;;
-  alpha*-*-*)
-    gmp_m4postinc="alpha/default.m4"
-    ;;
-  power*-*-*)
-    case "$target" in
-      *-*-mach* | *-*-rhapsody* | *-*-nextstep* | *-*-darwin* | *-*-macosx*)
-        ;;	# these use non-conventional assembly syntax.
-      powerpc64-*-aix*)
-	gmp_m4postinc="powerpc32/regmap.m4 powerpc64/aix.m4"
-        ;;
-      *-*-aix*)
-	gmp_m4postinc="powerpc32/regmap.m4 powerpc32/aix.m4"
-        ;;
-      *)
-	gmp_m4postinc="powerpc32/regmap.m4"
-	;;
-    esac
-    ;;
-esac
-changequote([, ])dnl
-
-for tmp_f in $gmp_m4postinc; do
-  GMP_DEFINE_RAW(["include_mpn(\`$tmp_f')"], POST)
-done
-
-
-# Set up `gmp_links'.  It's a list of link:file pairs that configure will
-# process to create link -> file.
-gmp_links=
-
-# If the user specified `MPN_PATH', use that instead of the path we've
-# come up with.
-if test -z "$MPN_PATH"; then
-  path="$path generic"
-else
-  path="$MPN_PATH"
-fi
-
-# Pick the correct source files in $path and link them to mpn/.
-# $gmp_mpn_functions lists all functions we need.
-#
-# The rule is to find a file with the function name and a .asm, .S,
-# .s, or .c extension.  Certain multi-function files with special names
-# can provide some functions too.  (mpn/Makefile.am passes
-# -DOPERATION_<func> to get them to generate the right code.)
-
-# FIXME: udiv and umul aren't in $gmp_mpn_functions_optional yet since
-# there's some versions of those files which should be checked for bit
-# rot first.  Put them in $extra_functions for each target for now,
-# change to standard optionals when all are ready.
-
-# Note: The following lines defining $gmp_mpn_functions_optional
-#       and $gmp_mpn_functions are parsed by the "macos/configure"
-#       Perl script. So if you change the lines in a major way
-#       make sure to run and examine the output from
-#       
-#           % (cd macos; perl configure)
-
-gmp_mpn_functions_optional="copyi copyd com_n		\
-  and_n andn_n nand_n ior_n iorn_n nior_n xor_n xnor_n"
-
-gmp_mpn_functions="${extra_functions} inlines add_n sub_n mul_1 addmul_1   \
-  submul_1 lshift rshift diveby3 divrem divrem_1 divrem_2                  \
-  mod_1 mod_1_rs pre_mod_1 dump                                            \
-  mul mul_fft mul_n mul_basecase sqr_basecase random                       \
-  random2 sqrtrem get_str set_str scan0 scan1 popcount hamdist cmp perfsqr \
-  bdivmod gcd_1 gcd gcdext tdiv_qr bz_divrem_n sb_divrem_mn jacbase        \
-  $gmp_mpn_functions_optional"
-
-# the list of all object files used by mpn/Makefile.in and the
-# top-level Makefile.in, respectively
-mpn_objects=
-mpn_objs_in_libgmp="mpn/mp_bases.lo"
-
-for tmp_fn in ${gmp_mpn_functions} ; do
-  [rm -f mpn/${tmp_fn}.[Ssc] mpn/${tmp_fn}.asm]
-
-  # functions that can be provided by multi-function files
-  tmp_mulfunc=
-  case $tmp_fn in
-  add_n|sub_n)       tmp_mulfunc="aors_n"    ;;
-  addmul_1|submul_1) tmp_mulfunc="aorsmul_1" ;;
-  popcount|hamdist)  tmp_mulfunc="popham"    ;;
-  and_n|andn_n|nand_n | ior_n|iorn_n|nior_n | xor_n|xnor_n)
-                     tmp_mulfunc="logops_n"  ;;
-  esac
-
-  found=no
-  for tmp_dir in $path; do
-    for tmp_base in $tmp_fn $tmp_mulfunc; do
-      for tmp_ext in asm S s c; do
-        tmp_file=$srcdir/mpn/$tmp_dir/$tmp_base.$tmp_ext
-        if test -f $tmp_file; then
-          found=yes
-
-          mpn_objects="$mpn_objects ${tmp_fn}.lo"
-          mpn_objs_in_libgmp="$mpn_objs_in_libgmp mpn/${tmp_fn}.lo"
-          gmp_links="$gmp_links mpn/$tmp_fn.$tmp_ext:mpn/$tmp_dir/$tmp_base.$tmp_ext"
-
-          # duplicate AC_DEFINEs are harmless, so it doesn't matter
-          # that multi-function files get grepped here repeatedly
-          gmp_ep=["`
-            sed -n 's/^[ 	]*MULFUNC_PROLOGUE(\(.*\))/\1/p' $tmp_file ;
-            sed -n 's/^[ 	]*PROLOGUE.*(\(.*\))/\1/p' $tmp_file
-          `"]
-          for gmp_tmp in $gmp_ep; do
-            AC_DEFINE_UNQUOTED(HAVE_NATIVE_${gmp_tmp})
-          done
-
-          break
-        fi
-      done
-      if test $found = yes; then break ; fi
-    done
-    if test $found = yes; then break ; fi
-  done
-
-  if test $found = no; then
-    for tmp_optional in $gmp_mpn_functions_optional; do
-      if test $tmp_optional = $tmp_fn; then
-        found=yes
-      fi
-    done
-    if test $found = no; then
-      AC_MSG_ERROR([no version of $tmp_fn found in path: $path])
-    fi
-  fi
-done
-
-# Create link for gmp-mparam.h.
-for tmp_dir in $path ; do
-  rm -f gmp-mparam.h
-  if test -f $srcdir/mpn/${tmp_dir}/gmp-mparam.h ; then
-    gmp_links="$gmp_links gmp-mparam.h:mpn/${tmp_dir}/gmp-mparam.h"
-
-    # Copy any KARATSUBA_SQR_THRESHOLD in gmp-mparam.h to config.m4.
-    # Some versions of sqr_basecase.asm use this.
-    tmp_gmp_karatsuba_sqr_threshold="`sed -n 's/^#define KARATSUBA_SQR_THRESHOLD[ 	]*\([0-9][0-9]*\).*$/\1/p' $srcdir/mpn/${tmp_dir}/gmp-mparam.h`"
-    if test -n "$tmp_gmp_karatsuba_sqr_threshold"; then
-      GMP_DEFINE_RAW(["define(<KARATSUBA_SQR_THRESHOLD>,<$tmp_gmp_karatsuba_sqr_threshold>)"])
-    fi
-
-    break
-  fi
-done
-
-# Dig out the links from `gmp_links' for inclusion in DISTCLEANFILES.
-gmp_srclinks=
-for f in $gmp_links; do
-  gmp_srclinks="$gmp_srclinks `echo $f | sed 's/\(.*\):.*/\1/'`"
-done
-
-AC_SUBST(mpn_objects)
-AC_SUBST(mpn_objs_in_libgmp)
-AC_SUBST(gmp_srclinks)
-
-dnl  ----------------------------------------
-dnl  Make links.
-AC_CONFIG_LINKS($gmp_links)
-
-dnl  Create config.m4.
-GMP_FINISH
-
-dnl  Create Makefiles
-dnl  FIXME: Upcoming version of autoconf/automake may not like broken lines.
-AC_OUTPUT(Makefile mpz/Makefile mpn/Makefile)
diff --git a/ghc/rts/gmp/depcomp b/ghc/rts/gmp/depcomp
deleted file mode 100644
index 7906096738..0000000000
--- a/ghc/rts/gmp/depcomp
+++ /dev/null
@@ -1,269 +0,0 @@
-#! /bin/sh
-
-# depcomp - compile a program generating dependencies as side-effects
-# Copyright (C) 1999 Free Software Foundation, Inc.
-
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-# 02111-1307, USA.
-
-# Originally written by Alexandre Oliva <oliva@dcc.unicamp.br>.
-
-if test -z "$depmode" || test -z "$source" || test -z "$object"; then
-  echo "depcomp: Variables source, object and depmode must be set" 1>&2
-  exit 1
-fi
-# `libtool' can also be set to `yes' or `no'.
-
-depfile=${depfile-`echo "$object" | sed 's,\([^/]*\)$,.deps/\1,;s/\.\([^.]*\)$/.P\1/'`}
-tmpdepfile=${tmpdepfile-`echo "$depfile" | sed 's/\.\([^.]*\)$/.T\1/'`}
-
-rm -f "$tmpdepfile"
-
-# Some modes work just like other modes, but use different flags.  We
-# parameterize here, but still list the modes in the big case below,
-# to make depend.m4 easier to write.  Note that we *cannot* use a case
-# here, because this file can only contain one case statement.
-if test "$depmode" = hp; then
-  # HP compiler uses -M and no extra arg.
-  gccflag=-M
-  depmode=gcc
-fi
-
-if test "$depmode" = dashXmstdout; then
-   # This is just like dashmstdout with a different argument.
-   dashmflag=-xM
-   depmode=dashmstdout
-fi
-
-case "$depmode" in
-gcc)
-## There are various ways to get dependency output from gcc.  Here's
-## why we pick this rather obscure method:
-## - Don't want to use -MD because we'd like the dependencies to end
-##   up in a subdir.  Having to rename by hand is ugly.
-##   (We might end up doing this anyway to support other compilers.)
-## - The DEPENDENCIES_OUTPUT environment variable makes gcc act like
-##   -MM, not -M (despite what the docs say).
-## - Using -M directly means running the compiler twice (even worse
-##   than renaming).
-  if test -z "$gccflag"; then
-    gccflag=-MD,
-  fi
-  if "$@" -Wp,"$gccflag$tmpdepfile"; then :
-  else
-    stat=$?
-    rm -f "$tmpdepfile"
-    exit $stat
-  fi
-  rm -f "$depfile" 
-  echo "$object : \\" > "$depfile"
-  sed 's/^[^:]*: / /' < "$tmpdepfile" >> "$depfile"
-## This next piece of magic avoids the `deleted header file' problem.
-## The problem is that when a header file which appears in a .P file
-## is deleted, the dependency causes make to die (because there is
-## typically no way to rebuild the header).  We avoid this by adding
-## dummy dependencies for each header file.  Too bad gcc doesn't do
-## this for us directly.
-  tr ' ' '
-' < "$tmpdepfile" |
-## Some versions of gcc put a space before the `:'.  On the theory
-## that the space means something, we add a space to the output as
-## well.
-## Some versions of the HPUX 10.20 sed can't process this invocation
-## correctly.  Breaking it into two sed invocations is a workaround.
-    sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
-  rm -f "$tmpdepfile"
-  ;;
-
-hp)
-  # This case exists only to let depend.m4 do its work.  It works by
-  # looking at the text of this script.  This case will never be run,
-  # since it is checked for above.
-  exit 1
-  ;;
-
-dashmd)
-  # The Java front end to gcc doesn't run cpp, so we can't use the -Wp
-  # trick.  Instead we must use -M and then rename the resulting .d
-  # file.  This is also the case for older versions of gcc, which
-  # don't implement -Wp.
-  if "$@" -MD; then :
-  else
-    stat=$?
-    rm -f FIXME
-    exit $stat
-  fi
-  FIXME: rewrite the file
-  ;;
-
-sgi)
-  if test "$libtool" = yes; then
-    "$@" "-Wc,-MDupdate,$tmpdepfile"
-  else
-    "$@" -MDupdate "$tmpdepfile"
-  fi
-  stat=$?
-  if test $stat -eq 0; then :
-  else
-    stat=$?
-    rm -f "$tmpdepfile"
-    exit $stat
-  fi
-  rm -f "$depfile" 
-  echo "$object : \\" > "$depfile"
-  sed 's/^[^:]*: / /' < "$tmpdepfile" >> "$depfile"
-  tr ' ' '
-' < "$tmpdepfile" | \
-## Some versions of the HPUX 10.20 sed can't process this invocation
-## correctly.  Breaking it into two sed invocations is a workaround.
-    sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
-  rm -f "$tmpdepfile"
-  ;;
-
-#nosideeffect)
-  # This comment above is used by automake to tell side-effect
-  # dependency tracking mechanisms from slower ones.
-
-dashmstdout)
-  # Important note: in order to support this mode, a compiler *must*
-  # always write the proprocessed file to stdout, regardless of -o,
-  # because we must use -o when running libtool.
-  test -z "$dashmflag" && dashmflag=-M
-  ( IFS=" "
-    case " $* " in
-    *" --mode=compile "*) # this is libtool, let us make it quiet
-      for arg
-      do # cycle over the arguments
-        case "$arg" in
-	"--mode=compile")
-	  # insert --quiet before "--mode=compile"
-	  set fnord "$@" --quiet
-	  shift # fnord
-	  ;;
-	esac
-	set fnord "$@" "$arg"
-	shift # fnord
-	shift # "$arg"
-      done
-      ;;
-    esac
-    "$@" $dashmflag | sed 's:^[^:]*\:[ 	]*:'"$object"'\: :' > "$tmpdepfile"
-  ) &
-  proc=$!
-  "$@"
-  stat=$?
-  wait "$proc"
-  if test "$stat" != 0; then exit $stat; fi
-  rm -f "$depfile" 
-  cat < "$tmpdepfile" > "$depfile"
-  tr ' ' '
-' < "$tmpdepfile" | \
-## Some versions of the HPUX 10.20 sed can't process this invocation
-## correctly.  Breaking it into two sed invocations is a workaround.
-    sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
-  rm -f "$tmpdepfile"
-  ;;
-
-dashXmstdout)
-  # This case only exists to satisfy depend.m4.  It is never actually
-  # run, as this mode is specially recognized in the preamble.
-  exit 1
-  ;;
-
-makedepend)
-  # X makedepend
-  (
-    shift
-    cleared=no
-    for arg in "$@"; do
-      case $cleared in no)
-        set ""; shift
-	cleared=yes
-      esac
-      case "$arg" in
-        -D*|-I*)
-	  set fnord "$@" "$arg"; shift;;
-	-*)
-	  ;;
-	*)
-	  set fnord "$@" "$arg"; shift;;
-      esac
-    done
-    obj_suffix="`echo $object | sed 's/^.*\././'`"
-    touch "$tmpdepfile"
-    ${MAKEDEPEND-makedepend} 2>/dev/null -o"$obj_suffix" -f"$tmpdepfile" "$@"
-  ) &
-  proc=$!
-  "$@"
-  stat=$?
-  wait "$proc"
-  if test "$stat" != 0; then exit $stat; fi
-  rm -f "$depfile" 
-  cat < "$tmpdepfile" > "$depfile"
-  tail +3 "$tmpdepfile" | tr ' ' '
-' | \
-## Some versions of the HPUX 10.20 sed can't process this invocation
-## correctly.  Breaking it into two sed invocations is a workaround.
-    sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' | sed -e 's/$/ :/' >> "$depfile"
-  rm -f "$tmpdepfile" "$tmpdepfile".bak
-  ;;
-
-cpp)
-  # Important note: in order to support this mode, a compiler *must*
-  # always write the proprocessed file to stdout, regardless of -o,
-  # because we must use -o when running libtool.
-  ( IFS=" "
-    case " $* " in
-    *" --mode=compile "*)
-      for arg
-      do # cycle over the arguments
-        case "$arg" in
-	"--mode=compile")
-	  # insert --quiet before "--mode=compile"
-	  set fnord "$@" --quiet
-	  shift # fnord
-	  ;;
-	esac
-	set fnord "$@" "$arg"
-	shift # fnord
-	shift # "$arg"
-      done
-      ;;
-    esac
-    "$@" -E |
-    sed -n '/^# [0-9][0-9]* "\([^"]*\)"/ s::'"$object"'\: \1:p' > "$tmpdepfile"
-  ) &
-  proc=$!
-  "$@"
-  stat=$?
-  wait "$proc"
-  if test "$stat" != 0; then exit $stat; fi
-  rm -f "$depfile"
-  cat < "$tmpdepfile" > "$depfile"
-  sed < "$tmpdepfile" -e 's/^[^:]*: //' -e 's/$/ :/' >> "$depfile"
-  rm -f "$tmpdepfile"
-  ;;
-
-none)
-  exec "$@"
-  ;;
-
-*)
-  echo "Unknown depmode $depmode" 1>&2
-  exit 1
-  ;;
-esac
-
-exit 0
diff --git a/ghc/rts/gmp/errno.c b/ghc/rts/gmp/errno.c
deleted file mode 100644
index 7dd223c19c..0000000000
--- a/ghc/rts/gmp/errno.c
+++ /dev/null
@@ -1,26 +0,0 @@
-/* gmp_errno -- The largest and most complex file in GMP.
-
-Copyright (C) 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int gmp_errno = 0;
diff --git a/ghc/rts/gmp/extract-dbl.c b/ghc/rts/gmp/extract-dbl.c
deleted file mode 100644
index 2d70d9a3b2..0000000000
--- a/ghc/rts/gmp/extract-dbl.c
+++ /dev/null
@@ -1,187 +0,0 @@
-/* __gmp_extract_double -- convert from double to array of mp_limb_t.
-
-Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-#ifdef XDEBUG
-#undef _GMP_IEEE_FLOATS
-#endif
-
-#ifndef _GMP_IEEE_FLOATS
-#define _GMP_IEEE_FLOATS 0
-#endif
-
-/* Extract a non-negative double in d.  */
-
-int
-#if __STDC__
-__gmp_extract_double (mp_ptr rp, double d)
-#else
-__gmp_extract_double (rp, d)
-     mp_ptr rp;
-     double d;
-#endif
-{
-  long exp;
-  unsigned sc;
-  mp_limb_t manh, manl;
-
-  /* BUGS
-
-     1. Should handle Inf and NaN in IEEE specific code.
-     2. Handle Inf and NaN also in default code, to avoid hangs.
-     3. Generalize to handle all BITS_PER_MP_LIMB >= 32.
-     4. This lits is incomplete and misspelled.
-   */
-
-  if (d == 0.0)
-    {
-      rp[0] = 0;
-      rp[1] = 0;
-#if BITS_PER_MP_LIMB == 32
-      rp[2] = 0;
-#endif
-      return 0;
-    }
-
-#if _GMP_IEEE_FLOATS
-  {
-#if defined (__alpha) && __GNUC__ == 2 && __GNUC_MINOR__ == 8
-    /* Work around alpha-specific bug in GCC 2.8.x.  */
-    volatile
-#endif
-    union ieee_double_extract x;
-    x.d = d;
-    exp = x.s.exp;
-#if BITS_PER_MP_LIMB == 64
-    manl = (((mp_limb_t) 1 << 63)
-	    | ((mp_limb_t) x.s.manh << 43) | ((mp_limb_t) x.s.manl << 11));
-    if (exp == 0)
-      {
-	/* Denormalized number.  Don't try to be clever about this,
-	   since it is not an important case to make fast.  */
-	exp = 1;
-	do
-	  {
-	    manl = manl << 1;
-	    exp--;
-	  }
-	while ((mp_limb_signed_t) manl >= 0);
-      }
-#else
-    manh = ((mp_limb_t) 1 << 31) | (x.s.manh << 11) | (x.s.manl >> 21);
-    manl = x.s.manl << 11;
-    if (exp == 0)
-      {
-	/* Denormalized number.  Don't try to be clever about this,
-	   since it is not an important case to make fast.  */
-	exp = 1;
-	do
-	  {
-	    manh = (manh << 1) | (manl >> 31);
-	    manl = manl << 1;
-	    exp--;
-	  }
-	while ((mp_limb_signed_t) manh >= 0);
-      }
-#endif
-    exp -= 1022;		/* Remove IEEE bias.  */
-  }
-#else
-  {
-    /* Unknown (or known to be non-IEEE) double format.  */
-    exp = 0;
-    if (d >= 1.0)
-      {
-	if (d * 0.5 == d)
-	  abort ();
-
-	while (d >= 32768.0)
-	  {
-	    d *= (1.0 / 65536.0);
-	    exp += 16;
-	  }
-	while (d >= 1.0)
-	  {
-	    d *= 0.5;
-	    exp += 1;
-	  }
-      }
-    else if (d < 0.5)
-      {
-	while (d < (1.0 / 65536.0))
-	  {
-	    d *=  65536.0;
-	    exp -= 16;
-	  }
-	while (d < 0.5)
-	  {
-	    d *= 2.0;
-	    exp -= 1;
-	  }
-      }
-
-    d *= MP_BASE_AS_DOUBLE;
-#if BITS_PER_MP_LIMB == 64
-    manl = d;
-#else
-    manh = d;
-    manl = (d - manh) * MP_BASE_AS_DOUBLE;
-#endif
-  }
-#endif
-
-  sc = (unsigned) exp % BITS_PER_MP_LIMB;
-
-  /* We add something here to get rounding right.  */
-  exp = (exp + 2048) / BITS_PER_MP_LIMB - 2048 / BITS_PER_MP_LIMB + 1;
-
-#if BITS_PER_MP_LIMB == 64
-  if (sc != 0)
-    {
-      rp[1] = manl >> (BITS_PER_MP_LIMB - sc);
-      rp[0] = manl << sc;
-    }
-  else
-    {
-      rp[1] = manl;
-      rp[0] = 0;
-      exp--;
-    }
-#else
-  if (sc != 0)
-    {
-      rp[2] = manh >> (BITS_PER_MP_LIMB - sc);
-      rp[1] = (manl >> (BITS_PER_MP_LIMB - sc)) | (manh << sc);
-      rp[0] = manl << sc;
-    }
-  else
-    {
-      rp[2] = manh;
-      rp[1] = manl;
-      rp[0] = 0;
-      exp--;
-    }
-#endif
-
-  return exp;
-}
diff --git a/ghc/rts/gmp/gmp-impl.h b/ghc/rts/gmp/gmp-impl.h
deleted file mode 100644
index 3c7ac26e7d..0000000000
--- a/ghc/rts/gmp/gmp-impl.h
+++ /dev/null
@@ -1,1072 +0,0 @@
-/* Include file for internal GNU MP types and definitions.
-
-   THE CONTENTS OF THIS FILE ARE FOR INTERNAL USE AND ARE ALMOST CERTAIN TO
-   BE SUBJECT TO INCOMPATIBLE CHANGES IN FUTURE GNU MP RELEASES.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1996, 1997, 1999, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "config.h"
-#include "gmp-mparam.h"
-/* #include "longlong.h" */
-
-/* When using gcc, make sure to use its builtin alloca.  */
-#if ! defined (alloca) && defined (__GNUC__)
-#define alloca __builtin_alloca
-#define HAVE_ALLOCA 1
-#endif
-
-/* When using cc, do whatever necessary to allow use of alloca.  For many
-   machines, this means including alloca.h.  IBM's compilers need a #pragma
-   in "each module that needs to use alloca".  */
-#if ! defined (alloca)
-/* We need lots of variants for MIPS, to cover all versions and perversions
-   of OSes for MIPS.  */
-#if defined (__mips) || defined (MIPSEL) || defined (MIPSEB) \
- || defined (_MIPSEL) || defined (_MIPSEB) || defined (__sgi) \
- || defined (__alpha) || defined (__sparc) || defined (sparc) \
- || defined (__ksr__)
-#include <alloca.h>
-#define HAVE_ALLOCA
-#endif
-#if defined (_IBMR2)
-#pragma alloca
-#define HAVE_ALLOCA
-#endif
-#if defined (__DECC)
-#define alloca(x) __ALLOCA(x)
-#define HAVE_ALLOCA
-#endif
-#endif
-
-#if defined (alloca)
-# ifndef HAVE_ALLOCA
-#define HAVE_ALLOCA
-# endif
-#endif
-
-#if ! defined (HAVE_ALLOCA) || USE_STACK_ALLOC
-#include "stack-alloc.h"
-#else
-#define TMP_DECL(m)
-#define TMP_ALLOC(x) alloca(x)
-#define TMP_MARK(m)
-#define TMP_FREE(m)
-#endif
-
-/* Allocating various types. */
-#define TMP_ALLOC_TYPE(n,type) ((type *) TMP_ALLOC ((n) * sizeof (type)))
-#define TMP_ALLOC_LIMBS(n)     TMP_ALLOC_TYPE(n,mp_limb_t)
-#define TMP_ALLOC_MP_PTRS(n)   TMP_ALLOC_TYPE(n,mp_ptr)
-
-
-#if ! defined (__GNUC__)	/* FIXME: Test for C++ compilers here,
-				   __DECC understands __inline */
-#define inline			/* Empty */
-#endif
-
-#define ABS(x) (x >= 0 ? x : -x)
-#define MIN(l,o) ((l) < (o) ? (l) : (o))
-#define MAX(h,i) ((h) > (i) ? (h) : (i))
-#define numberof(x)  (sizeof (x) / sizeof ((x)[0]))
-
-/* Field access macros.  */
-#define SIZ(x) ((x)->_mp_size)
-#define ABSIZ(x) ABS (SIZ (x))
-#define PTR(x) ((x)->_mp_d)
-#define LIMBS(x) ((x)->_mp_d)
-#define EXP(x) ((x)->_mp_exp)
-#define PREC(x) ((x)->_mp_prec)
-#define ALLOC(x) ((x)->_mp_alloc)
-
-/* Extra casts because shorts are promoted to ints by "~" and "<<".  "-1"
-   rather than "1" in SIGNED_TYPE_MIN avoids warnings from some compilers
-   about arithmetic overflow.  */
-#define UNSIGNED_TYPE_MAX(type)      ((type) ~ (type) 0)
-#define UNSIGNED_TYPE_HIGHBIT(type)  ((type) ~ (UNSIGNED_TYPE_MAX(type) >> 1))
-#define SIGNED_TYPE_MIN(type)        (((type) -1) << (8*sizeof(type)-1))
-#define SIGNED_TYPE_MAX(type)        ((type) ~ SIGNED_TYPE_MIN(type))
-#define SIGNED_TYPE_HIGHBIT(type)    SIGNED_TYPE_MIN(type)
-
-#define MP_LIMB_T_MAX      UNSIGNED_TYPE_MAX (mp_limb_t)
-#define MP_LIMB_T_HIGHBIT  UNSIGNED_TYPE_HIGHBIT (mp_limb_t)
-
-#define MP_SIZE_T_MAX      SIGNED_TYPE_MAX (mp_size_t)
-
-#ifndef ULONG_MAX
-#define ULONG_MAX          UNSIGNED_TYPE_MAX (unsigned long)
-#endif
-#define ULONG_HIGHBIT      UNSIGNED_TYPE_HIGHBIT (unsigned long)
-#define LONG_HIGHBIT       SIGNED_TYPE_HIGHBIT (long)
-#ifndef LONG_MAX
-#define LONG_MAX           SIGNED_TYPE_MAX (long)
-#endif
-
-#ifndef USHORT_MAX
-#define USHORT_MAX         UNSIGNED_TYPE_MAX (unsigned short)
-#endif
-#define USHORT_HIGHBIT     UNSIGNED_TYPE_HIGHBIT (unsigned short)
-#define SHORT_HIGHBIT      SIGNED_TYPE_HIGHBIT (short)
-#ifndef SHORT_MAX
-#define SHORT_MAX          SIGNED_TYPE_MAX (short)
-#endif
-
-
-/* Swap macros. */
-
-#define MP_LIMB_T_SWAP(x, y)                    \
-  do {                                          \
-    mp_limb_t __mp_limb_t_swap__tmp = (x);      \
-    (x) = (y);                                  \
-    (y) = __mp_limb_t_swap__tmp;                \
-  } while (0)
-#define MP_SIZE_T_SWAP(x, y)                    \
-  do {                                          \
-    mp_size_t __mp_size_t_swap__tmp = (x);      \
-    (x) = (y);                                  \
-    (y) = __mp_size_t_swap__tmp;                \
-  } while (0)
-
-#define MP_PTR_SWAP(x, y)               \
-  do {                                  \
-    mp_ptr __mp_ptr_swap__tmp = (x);    \
-    (x) = (y);                          \
-    (y) = __mp_ptr_swap__tmp;           \
-  } while (0)
-#define MP_SRCPTR_SWAP(x, y)                    \
-  do {                                          \
-    mp_srcptr __mp_srcptr_swap__tmp = (x);      \
-    (x) = (y);                                  \
-    (y) = __mp_srcptr_swap__tmp;                \
-  } while (0)
-
-#define MPN_PTR_SWAP(xp,xs, yp,ys)      \
-  do {                                  \
-    MP_PTR_SWAP (xp, yp);               \
-    MP_SIZE_T_SWAP (xs, ys);            \
-  } while(0)
-#define MPN_SRCPTR_SWAP(xp,xs, yp,ys)   \
-  do {                                  \
-    MP_SRCPTR_SWAP (xp, yp);            \
-    MP_SIZE_T_SWAP (xs, ys);            \
-  } while(0)
-
-#define MPZ_PTR_SWAP(x, y)              \
-  do {                                  \
-    mpz_ptr __mpz_ptr_swap__tmp = (x);  \
-    (x) = (y);                          \
-    (y) = __mpz_ptr_swap__tmp;          \
-  } while (0)
-#define MPZ_SRCPTR_SWAP(x, y)                   \
-  do {                                          \
-    mpz_srcptr __mpz_srcptr_swap__tmp = (x);    \
-    (x) = (y);                                  \
-    (y) = __mpz_srcptr_swap__tmp;               \
-  } while (0)
-
-
-#if defined (__cplusplus)
-extern "C" {
-#endif
-
-/* FIXME: These are purely internal, so do a search and replace to change
-   them to __gmp forms, rather than using these macros. */
-#define _mp_allocate_func      __gmp_allocate_func
-#define _mp_reallocate_func    __gmp_reallocate_func
-#define _mp_free_func          __gmp_free_func
-#define _mp_default_allocate   __gmp_default_allocate
-#define _mp_default_reallocate __gmp_default_reallocate
-#define _mp_default_free       __gmp_default_free
-
-extern void *	(*_mp_allocate_func) _PROTO ((size_t));
-extern void *	(*_mp_reallocate_func) _PROTO ((void *, size_t, size_t));
-extern void	(*_mp_free_func) _PROTO ((void *, size_t));
-
-void *_mp_default_allocate _PROTO ((size_t));
-void *_mp_default_reallocate _PROTO ((void *, size_t, size_t));
-void _mp_default_free _PROTO ((void *, size_t));
-
-#define _MP_ALLOCATE_FUNC_TYPE(n,type) \
-  ((type *) (*_mp_allocate_func) ((n) * sizeof (type)))
-#define _MP_ALLOCATE_FUNC_LIMBS(n)   _MP_ALLOCATE_FUNC_TYPE(n,mp_limb_t)
-
-#define _MP_FREE_FUNC_TYPE(p,n,type) (*_mp_free_func) (p, (n) * sizeof (type))
-#define _MP_FREE_FUNC_LIMBS(p,n)     _MP_FREE_FUNC_TYPE(p,n,mp_limb_t)
-
-
-#if (__STDC__-0) || defined (__cplusplus)
-
-#else
-
-#define const			/* Empty */
-#define signed			/* Empty */
-
-#endif
-
-#if defined (__GNUC__) && defined (__i386__)
-#if 0			/* check that these actually improve things */
-#define MPN_COPY_INCR(DST, SRC, N)					\
-  __asm__ ("cld\n\trep\n\tmovsl" : :					\
-	   "D" (DST), "S" (SRC), "c" (N) :				\
-	   "cx", "di", "si", "memory")
-#define MPN_COPY_DECR(DST, SRC, N)					\
-  __asm__ ("std\n\trep\n\tmovsl" : :					\
-	   "D" ((DST) + (N) - 1), "S" ((SRC) + (N) - 1), "c" (N) :	\
-	   "cx", "di", "si", "memory")
-#define MPN_NORMALIZE_NOT_ZERO(P, N)					\
-  do {									\
-    __asm__ ("std\n\trepe\n\tscasl" : "=c" (N) :			\
-	     "a" (0), "D" ((P) + (N) - 1), "0" (N) :			\
-	     "cx", "di");						\
-    (N)++;								\
-  } while (0)
-#endif
-#endif
-
-#if HAVE_NATIVE_mpn_copyi
-#define mpn_copyi __MPN(copyi)
-void mpn_copyi _PROTO ((mp_ptr, mp_srcptr, mp_size_t));
-#endif
-
-/* Remap names of internal mpn functions.  */
-#define __clz_tab               __MPN(clz_tab)
-#define mpn_udiv_w_sdiv		__MPN(udiv_w_sdiv)
-#define mpn_reciprocal		__MPN(reciprocal)
-
-#define mpn_sb_divrem_mn	__MPN(sb_divrem_mn)
-#define mpn_bz_divrem_n		__MPN(bz_divrem_n)
-/* #define mpn_tdiv_q		__MPN(tdiv_q) */
-
-#define mpn_kara_mul_n	__MPN(kara_mul_n)
-void mpn_kara_mul_n _PROTO((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t, mp_ptr));
-
-#define mpn_kara_sqr_n  __MPN(kara_sqr_n)
-void mpn_kara_sqr_n _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_ptr));
-
-#define mpn_toom3_mul_n  __MPN(toom3_mul_n)
-void mpn_toom3_mul_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t,mp_ptr));
-
-#define mpn_toom3_sqr_n  __MPN(toom3_sqr_n)
-void mpn_toom3_sqr_n _PROTO((mp_ptr, mp_srcptr, mp_size_t, mp_ptr));
-
-#define mpn_fft_best_k  __MPN(fft_best_k)
-int mpn_fft_best_k _PROTO ((mp_size_t n, int sqr));
-
-#define mpn_mul_fft  __MPN(mul_fft)
-void mpn_mul_fft _PROTO ((mp_ptr op, mp_size_t pl,
-                          mp_srcptr n, mp_size_t nl,
-                          mp_srcptr m, mp_size_t ml,
-                          int k));
-
-#define mpn_mul_fft_full  __MPN(mul_fft_full)
-void mpn_mul_fft_full _PROTO ((mp_ptr op,
-                               mp_srcptr n, mp_size_t nl,
-                               mp_srcptr m, mp_size_t ml));
-
-#define mpn_fft_next_size  __MPN(fft_next_size)
-mp_size_t mpn_fft_next_size _PROTO ((mp_size_t pl, int k));
-
-mp_limb_t mpn_sb_divrem_mn _PROTO ((mp_ptr, mp_ptr, mp_size_t, mp_srcptr, mp_size_t));
-mp_limb_t mpn_bz_divrem_n _PROTO ((mp_ptr, mp_ptr, mp_srcptr, mp_size_t));
-/* void mpn_tdiv_q _PROTO ((mp_ptr, mp_size_t, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t)); */
-
-/* Copy NLIMBS *limbs* from SRC to DST, NLIMBS==0 allowed.  */
-#ifndef MPN_COPY_INCR
-#if HAVE_NATIVE_mpn_copyi
-#define MPN_COPY_INCR(DST, SRC, NLIMBS)   mpn_copyi (DST, SRC, NLIMBS)
-#else
-#define MPN_COPY_INCR(DST, SRC, NLIMBS) \
-  do {									\
-    mp_size_t __i;							\
-    for (__i = 0; __i < (NLIMBS); __i++)				\
-      (DST)[__i] = (SRC)[__i];						\
-  } while (0)
-#endif
-#endif
-
-#if HAVE_NATIVE_mpn_copyd
-#define mpn_copyd __MPN(copyd)
-void mpn_copyd _PROTO ((mp_ptr, mp_srcptr, mp_size_t));
-#endif
-
-/* NLIMBS==0 allowed */
-#ifndef MPN_COPY_DECR
-#if HAVE_NATIVE_mpn_copyd
-#define MPN_COPY_DECR(DST, SRC, NLIMBS)   mpn_copyd (DST, SRC, NLIMBS)
-#else
-#define MPN_COPY_DECR(DST, SRC, NLIMBS) \
-  do {									\
-    mp_size_t __i;							\
-    for (__i = (NLIMBS) - 1; __i >= 0; __i--)				\
-      (DST)[__i] = (SRC)[__i];						\
-  } while (0)
-#endif
-#endif
-
-/* Define MPN_COPY for vector computers.  Since #pragma cannot be in a macro,
-   rely on function inlining. */
-#if defined (_CRAY) || defined (__uxp__)
-static inline void
-_MPN_COPY (d, s, n) mp_ptr d; mp_srcptr s; mp_size_t n;
-{
-  int i;				/* Faster for Cray with plain int */
-#pragma _CRI ivdep			/* Cray PVP systems */
-#pragma loop noalias d,s		/* Fujitsu VPP systems */
-  for (i = 0; i < n; i++)
-    d[i] = s[i];
-}
-#define MPN_COPY _MPN_COPY
-#endif
-
-#ifndef MPN_COPY
-#define MPN_COPY MPN_COPY_INCR
-#endif
-
-/* Zero NLIMBS *limbs* AT DST.  */
-#ifndef MPN_ZERO
-#define MPN_ZERO(DST, NLIMBS) \
-  do {									\
-    mp_size_t __i;							\
-    for (__i = 0; __i < (NLIMBS); __i++)				\
-      (DST)[__i] = 0;							\
-  } while (0)
-#endif
-
-#ifndef MPN_NORMALIZE
-#define MPN_NORMALIZE(DST, NLIMBS) \
-  do {									\
-    while (NLIMBS > 0)							\
-      {									\
-	if ((DST)[(NLIMBS) - 1] != 0)					\
-	  break;							\
-	NLIMBS--;							\
-      }									\
-  } while (0)
-#endif
-#ifndef MPN_NORMALIZE_NOT_ZERO
-#define MPN_NORMALIZE_NOT_ZERO(DST, NLIMBS) \
-  do {									\
-    while (1)								\
-      {									\
-	if ((DST)[(NLIMBS) - 1] != 0)					\
-	  break;							\
-	NLIMBS--;							\
-      }									\
-  } while (0)
-#endif
-
-/* Strip least significant zero limbs from ptr,size by incrementing ptr and
-   decrementing size.  The number in ptr,size must be non-zero, ie. size!=0
-   and somewhere a non-zero limb.  */
-#define MPN_STRIP_LOW_ZEROS_NOT_ZERO(ptr, size) \
-  do                                            \
-    {                                           \
-      ASSERT ((size) != 0);                     \
-      while ((ptr)[0] == 0)                     \
-        {                                       \
-          (ptr)++;                              \
-          (size)--;                             \
-          ASSERT (size >= 0);                   \
-	}                                       \
-    }                                           \
-  while (0)
-
-/* Initialize X of type mpz_t with space for NLIMBS limbs.  X should be a
-   temporary variable; it will be automatically cleared out at function
-   return.  We use __x here to make it possible to accept both mpz_ptr and
-   mpz_t arguments.  */
-#define MPZ_TMP_INIT(X, NLIMBS) \
-  do {									\
-    mpz_ptr __x = (X);							\
-    __x->_mp_alloc = (NLIMBS);						\
-    __x->_mp_d = (mp_ptr) TMP_ALLOC ((NLIMBS) * BYTES_PER_MP_LIMB);	\
-  } while (0)
-
-/* Realloc for an mpz_t WHAT if it has less thann NEEDED limbs.  */
-#define MPZ_REALLOC(what,needed) \
-  do {								\
-    if ((needed) > ALLOC (what))				\
-      _mpz_realloc (what, needed);				\
-  } while (0)
-
-/* If KARATSUBA_MUL_THRESHOLD is not already defined, define it to a
-   value which is good on most machines.  */
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD 32
-#endif
-
-/* If TOOM3_MUL_THRESHOLD is not already defined, define it to a
-   value which is good on most machines.  */
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD 256
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD (2*KARATSUBA_MUL_THRESHOLD)
-#endif
-
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD (2*TOOM3_MUL_THRESHOLD)
-#endif
-
-/* First k to use for an FFT modF multiply.  A modF FFT is an order
-   log(2^k)/log(2^(k-1)) algorithm, so k=3 is merely 1.5 like karatsuba,
-   whereas k=4 is 1.33 which is faster than toom3 at 1.485.    */
-#define FFT_FIRST_K  4
-
-/* Threshold at which FFT should be used to do a modF NxN -> N multiply. */
-#ifndef FFT_MODF_MUL_THRESHOLD
-#define FFT_MODF_MUL_THRESHOLD   (TOOM3_MUL_THRESHOLD * 3)
-#endif
-#ifndef FFT_MODF_SQR_THRESHOLD
-#define FFT_MODF_SQR_THRESHOLD   (TOOM3_SQR_THRESHOLD * 3)
-#endif
-
-/* Threshold at which FFT should be used to do an NxN -> 2N multiply.  This
-   will be a size where FFT is using k=7 or k=8, since an FFT-k used for an
-   NxN->2N multiply and not recursing into itself is an order
-   log(2^k)/log(2^(k-2)) algorithm, so it'll be at least k=7 at 1.39 which
-   is the first better than toom3.  */
-#ifndef FFT_MUL_THRESHOLD
-#define FFT_MUL_THRESHOLD   (FFT_MODF_MUL_THRESHOLD * 10)
-#endif
-#ifndef FFT_SQR_THRESHOLD
-#define FFT_SQR_THRESHOLD   (FFT_MODF_SQR_THRESHOLD * 10)
-#endif
-
-/* Table of thresholds for successive modF FFT "k"s.  The first entry is
-   where FFT_FIRST_K+1 should be used, the second FFT_FIRST_K+2,
-   etc.  See mpn_fft_best_k(). */
-#ifndef FFT_MUL_TABLE
-#define FFT_MUL_TABLE                           \
-  { TOOM3_MUL_THRESHOLD * 4,   /* k=5 */        \
-    TOOM3_MUL_THRESHOLD * 8,   /* k=6 */        \
-    TOOM3_MUL_THRESHOLD * 16,  /* k=7 */        \
-    TOOM3_MUL_THRESHOLD * 32,  /* k=8 */        \
-    TOOM3_MUL_THRESHOLD * 96,  /* k=9 */        \
-    TOOM3_MUL_THRESHOLD * 288, /* k=10 */       \
-    0 }
-#endif
-#ifndef FFT_SQR_TABLE
-#define FFT_SQR_TABLE                           \
-  { TOOM3_SQR_THRESHOLD * 4,   /* k=5 */        \
-    TOOM3_SQR_THRESHOLD * 8,   /* k=6 */        \
-    TOOM3_SQR_THRESHOLD * 16,  /* k=7 */        \
-    TOOM3_SQR_THRESHOLD * 32,  /* k=8 */        \
-    TOOM3_SQR_THRESHOLD * 96,  /* k=9 */        \
-    TOOM3_SQR_THRESHOLD * 288, /* k=10 */       \
-    0 }
-#endif
-
-#ifndef FFT_TABLE_ATTRS
-#define FFT_TABLE_ATTRS   static const
-#endif
-
-#define MPN_FFT_TABLE_SIZE  16
-
-
-/* Return non-zero if xp,xsize and yp,ysize overlap.
-   If xp+xsize<=yp there's no overlap, or if yp+ysize<=xp there's no
-   overlap.  If both these are false, there's an overlap. */
-#define MPN_OVERLAP_P(xp, xsize, yp, ysize) \
-  ((xp) + (xsize) > (yp) && (yp) + (ysize) > (xp))
-
-
-/* ASSERT() is a private assertion checking scheme, similar to <assert.h>.
-   ASSERT() does the check only if WANT_ASSERT is selected, ASSERT_ALWAYS()
-   does it always.  Generally assertions are meant for development, but
-   might help when looking for a problem later too.
-
-   ASSERT_NOCARRY() uses ASSERT() to check the expression is zero, but if
-   assertion checking is disabled, the expression is still evaluated.  This
-   is meant for use with routines like mpn_add_n() where the return value
-   represents a carry or whatever that shouldn't occur.  For example,
-   ASSERT_NOCARRY (mpn_add_n (rp, s1p, s2p, size)); */
-
-#ifdef __LINE__
-#define ASSERT_LINE  __LINE__
-#else
-#define ASSERT_LINE  -1
-#endif
-
-#ifdef __FILE__
-#define ASSERT_FILE  __FILE__
-#else
-#define ASSERT_FILE  ""
-#endif
-
-int __gmp_assert_fail _PROTO((const char *filename, int linenum,
-                              const char *expr));
-
-#if HAVE_STRINGIZE
-#define ASSERT_FAIL(expr)  __gmp_assert_fail (ASSERT_FILE, ASSERT_LINE, #expr)
-#else
-#define ASSERT_FAIL(expr)  __gmp_assert_fail (ASSERT_FILE, ASSERT_LINE, "expr")
-#endif
-
-#if HAVE_VOID
-#define CAST_TO_VOID        (void)
-#else
-#define CAST_TO_VOID
-#endif
-
-#define ASSERT_ALWAYS(expr) ((expr) ? 0 : ASSERT_FAIL (expr))
-
-#if WANT_ASSERT
-#define ASSERT(expr)           ASSERT_ALWAYS (expr)
-#define ASSERT_NOCARRY(expr)   ASSERT_ALWAYS ((expr) == 0)
-
-#else
-#define ASSERT(expr)           (CAST_TO_VOID 0)
-#define ASSERT_NOCARRY(expr)   (expr)
-#endif
-
-
-#if HAVE_NATIVE_mpn_com_n
-#define mpn_com_n __MPN(com_n)
-void mpn_com_n _PROTO ((mp_ptr, mp_srcptr, mp_size_t));
-#else
-#define mpn_com_n(d,s,n)        \
-  do                            \
-    {                           \
-      mp_ptr     __d = (d);     \
-      mp_srcptr  __s = (s);     \
-      mp_size_t  __n = (n);     \
-      do                        \
-        *__d++ = ~ *__s++;      \
-      while (--__n);            \
-    }                           \
-  while (0)
-#endif
-
-#define MPN_LOGOPS_N_INLINE(d,s1,s2,n,dop,op,s2op)      \
-  do                                                    \
-    {                                                   \
-      mp_ptr     __d = (d);                             \
-      mp_srcptr  __s1 = (s1);                           \
-      mp_srcptr  __s2 = (s2);                           \
-      mp_size_t  __n = (n);                             \
-      do                                                \
-        *__d++ = dop (*__s1++ op s2op *__s2++);         \
-      while (--__n);                                    \
-    }                                                   \
-  while (0)
-
-#if HAVE_NATIVE_mpn_and_n
-#define mpn_and_n __MPN(and_n)
-void mpn_and_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-#else
-#define mpn_and_n(d,s1,s2,n)  MPN_LOGOPS_N_INLINE(d,s1,s2,n, ,&, )
-#endif
-
-#if HAVE_NATIVE_mpn_andn_n
-#define mpn_andn_n __MPN(andn_n)
-void mpn_andn_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-#else
-#define mpn_andn_n(d,s1,s2,n) MPN_LOGOPS_N_INLINE(d,s1,s2,n, ,&,~)
-#endif
-
-#if HAVE_NATIVE_mpn_nand_n
-#define mpn_nand_n __MPN(nand_n)
-void mpn_nand_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-#else
-#define mpn_nand_n(d,s1,s2,n) MPN_LOGOPS_N_INLINE(d,s1,s2,n,~,&, )
-#endif
-
-#if HAVE_NATIVE_mpn_ior_n
-#define mpn_ior_n __MPN(ior_n)
-void mpn_ior_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-#else
-#define mpn_ior_n(d,s1,s2,n)  MPN_LOGOPS_N_INLINE(d,s1,s2,n, ,|, )
-#endif
-
-#if HAVE_NATIVE_mpn_iorn_n
-#define mpn_iorn_n __MPN(iorn_n)
-void mpn_iorn_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-#else
-#define mpn_iorn_n(d,s1,s2,n) MPN_LOGOPS_N_INLINE(d,s1,s2,n, ,|,~)
-#endif
-
-#if HAVE_NATIVE_mpn_nior_n
-#define mpn_nior_n __MPN(nior_n)
-void mpn_nior_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-#else
-#define mpn_nior_n(d,s1,s2,n) MPN_LOGOPS_N_INLINE(d,s1,s2,n,~,|, )
-#endif
-
-#if HAVE_NATIVE_mpn_xor_n
-#define mpn_xor_n __MPN(xor_n)
-void mpn_xor_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-#else
-#define mpn_xor_n(d,s1,s2,n)  MPN_LOGOPS_N_INLINE(d,s1,s2,n, ,^, )
-#endif
-
-#if HAVE_NATIVE_mpn_xnor_n
-#define mpn_xnor_n __MPN(xnor_n)
-void mpn_xnor_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-#else
-#define mpn_xnor_n(d,s1,s2,n) MPN_LOGOPS_N_INLINE(d,s1,s2,n,~,^, )
-#endif
-
-/* Structure for conversion between internal binary format and
-   strings in base 2..36.  */
-struct bases
-{
-  /* Number of digits in the conversion base that always fits in an mp_limb_t.
-     For example, for base 10 on a machine where a mp_limb_t has 32 bits this
-     is 9, since 10**9 is the largest number that fits into a mp_limb_t.  */
-  int chars_per_limb;
-
-  /* log(2)/log(conversion_base) */
-  double chars_per_bit_exactly;
-
-  /* base**chars_per_limb, i.e. the biggest number that fits a word, built by
-     factors of base.  Exception: For 2, 4, 8, etc, big_base is log2(base),
-     i.e. the number of bits used to represent each digit in the base.  */
-  mp_limb_t big_base;
-
-  /* A BITS_PER_MP_LIMB bit approximation to 1/big_base, represented as a
-     fixed-point number.  Instead of dividing by big_base an application can
-     choose to multiply by big_base_inverted.  */
-  mp_limb_t big_base_inverted;
-};
-
-#define __mp_bases __MPN(mp_bases)
-extern const struct bases __mp_bases[];
-extern mp_size_t __gmp_default_fp_limb_precision;
-
-#if defined (__i386__)
-#define TARGET_REGISTER_STARVED 1
-#else
-#define TARGET_REGISTER_STARVED 0
-#endif
-
-/* Use a library function for invert_limb, if available. */
-#if ! defined (invert_limb) && HAVE_NATIVE_mpn_invert_limb
-#define mpn_invert_limb  __MPN(invert_limb)
-mp_limb_t mpn_invert_limb _PROTO ((mp_limb_t));
-#define invert_limb(invxl,xl)  (invxl = __MPN(invert_limb) (xl))
-#endif
-
-#ifndef invert_limb
-#define invert_limb(invxl,xl) \
-  do {									\
-    mp_limb_t dummy;							\
-    if (xl << 1 == 0)							\
-      invxl = ~(mp_limb_t) 0;						\
-    else								\
-      udiv_qrnnd (invxl, dummy, -xl, 0, xl);				\
-  } while (0)
-#endif
-
-/* Divide the two-limb number in (NH,,NL) by D, with DI being the largest
-   limb not larger than (2**(2*BITS_PER_MP_LIMB))/D - (2**BITS_PER_MP_LIMB).
-   If this would yield overflow, DI should be the largest possible number
-   (i.e., only ones).  For correct operation, the most significant bit of D
-   has to be set.  Put the quotient in Q and the remainder in R.  */
-#define udiv_qrnnd_preinv(q, r, nh, nl, d, di) \
-  do {									\
-    mp_limb_t _q, _ql, _r;						\
-    mp_limb_t _xh, _xl;							\
-    umul_ppmm (_q, _ql, (nh), (di));					\
-    _q += (nh);			/* DI is 2**BITS_PER_MP_LIMB too small */\
-    umul_ppmm (_xh, _xl, _q, (d));					\
-    sub_ddmmss (_xh, _r, (nh), (nl), _xh, _xl);				\
-    if (_xh != 0)							\
-      {									\
-	sub_ddmmss (_xh, _r, _xh, _r, 0, (d));				\
-	_q += 1;							\
-	if (_xh != 0)							\
-	  {								\
-	    sub_ddmmss (_xh, _r, _xh, _r, 0, (d));			\
-	    _q += 1;							\
-	  }								\
-      }									\
-    if (_r >= (d))							\
-      {									\
-	_r -= (d);							\
-	_q += 1;							\
-      }									\
-    (r) = _r;								\
-    (q) = _q;								\
-  } while (0)
-/* Like udiv_qrnnd_preinv, but for for any value D.  DNORM is D shifted left
-   so that its most significant bit is set.  LGUP is ceil(log2(D)).  */
-#define udiv_qrnnd_preinv2gen(q, r, nh, nl, d, di, dnorm, lgup) \
-  do {									\
-    mp_limb_t _n2, _n10, _n1, _nadj, _q1;				\
-    mp_limb_t _xh, _xl;							\
-    _n2 = ((nh) << (BITS_PER_MP_LIMB - (lgup))) + ((nl) >> 1 >> (l - 1));\
-    _n10 = (nl) << (BITS_PER_MP_LIMB - (lgup));				\
-    _n1 = ((mp_limb_signed_t) _n10 >> (BITS_PER_MP_LIMB - 1));		\
-    _nadj = _n10 + (_n1 & (dnorm));					\
-    umul_ppmm (_xh, _xl, di, _n2 - _n1);				\
-    add_ssaaaa (_xh, _xl, _xh, _xl, 0, _nadj);				\
-    _q1 = ~(_n2 + _xh);							\
-    umul_ppmm (_xh, _xl, _q1, d);					\
-    add_ssaaaa (_xh, _xl, _xh, _xl, nh, nl);				\
-    _xh -= (d);								\
-    (r) = _xl + ((d) & _xh);						\
-    (q) = _xh - _q1;							\
-  } while (0)
-/* Exactly like udiv_qrnnd_preinv, but branch-free.  It is not clear which
-   version to use.  */
-#define udiv_qrnnd_preinv2norm(q, r, nh, nl, d, di) \
-  do {									\
-    mp_limb_t _n2, _n10, _n1, _nadj, _q1;				\
-    mp_limb_t _xh, _xl;							\
-    _n2 = (nh);								\
-    _n10 = (nl);							\
-    _n1 = ((mp_limb_signed_t) _n10 >> (BITS_PER_MP_LIMB - 1));		\
-    _nadj = _n10 + (_n1 & (d));						\
-    umul_ppmm (_xh, _xl, di, _n2 - _n1);				\
-    add_ssaaaa (_xh, _xl, _xh, _xl, 0, _nadj);				\
-    _q1 = ~(_n2 + _xh);							\
-    umul_ppmm (_xh, _xl, _q1, d);					\
-    add_ssaaaa (_xh, _xl, _xh, _xl, nh, nl);				\
-    _xh -= (d);								\
-    (r) = _xl + ((d) & _xh);						\
-    (q) = _xh - _q1;							\
-  } while (0)
-
-
-/* modlimb_invert() sets "inv" to the multiplicative inverse of "n" modulo
-   2^BITS_PER_MP_LIMB, ie. so that inv*n == 1 mod 2^BITS_PER_MP_LIMB.
-   "n" must be odd (otherwise such an inverse doesn't exist).
-
-   This is not to be confused with invert_limb(), which is completely
-   different.
-
-   The table lookup gives an inverse with the low 8 bits valid, and each
-   multiply step doubles the number of bits.  See Jebelean's exact division
-   paper, end of section 4 (reference in gmp.texi). */
-
-#define modlimb_invert_table  __gmp_modlimb_invert_table
-extern const unsigned char  modlimb_invert_table[128];
-
-#if BITS_PER_MP_LIMB <= 32
-#define modlimb_invert(inv,n)                                   \
-  do {                                                          \
-    mp_limb_t  __n = (n);                                       \
-    mp_limb_t  __inv;                                           \
-    ASSERT ((__n & 1) == 1);                                    \
-    __inv = modlimb_invert_table[(__n&0xFF)/2]; /*  8 */        \
-    __inv = 2 * __inv - __inv * __inv * __n;    /* 16 */        \
-    __inv = 2 * __inv - __inv * __inv * __n;    /* 32 */        \
-    ASSERT (__inv * __n == 1);                                  \
-    (inv) = __inv;                                              \
-  } while (0)
-#endif
-
-#if BITS_PER_MP_LIMB > 32 && BITS_PER_MP_LIMB <= 64
-#define modlimb_invert(inv,n)                                   \
-  do {                                                          \
-    mp_limb_t  __n = (n);                                       \
-    mp_limb_t  __inv;                                           \
-    ASSERT ((__n & 1) == 1);                                    \
-    __inv = modlimb_invert_table[(__n&0xFF)/2]; /*  8 */        \
-    __inv = 2 * __inv - __inv * __inv * __n;    /* 16 */        \
-    __inv = 2 * __inv - __inv * __inv * __n;    /* 32 */        \
-    __inv = 2 * __inv - __inv * __inv * __n;    /* 64 */        \
-    ASSERT (__inv * __n == 1);                                  \
-    (inv) = __inv;                                              \
-  } while (0)
-#endif
-
-
-/* The `mode' attribute was introduced in GCC 2.2, but we can only distinguish
-   between GCC 2 releases from 2.5, since __GNUC_MINOR__ wasn't introduced
-   until then.  */
-#if (__GNUC__ - 0 > 2 || defined (__GNUC_MINOR__)) && ! defined (__APPLE_CC__)
-/* Define stuff for longlong.h.  */
-typedef unsigned int UQItype	__attribute__ ((mode (QI)));
-typedef		 int SItype	__attribute__ ((mode (SI)));
-typedef unsigned int USItype	__attribute__ ((mode (SI)));
-typedef		 int DItype	__attribute__ ((mode (DI)));
-typedef unsigned int UDItype	__attribute__ ((mode (DI)));
-#else
-typedef unsigned char UQItype;
-typedef		 long SItype;
-typedef unsigned long USItype;
-#if defined _LONGLONG || defined _LONG_LONG_LIMB
-typedef	long long int DItype;
-typedef unsigned long long int UDItype;
-#else /* Assume `long' gives us a wide enough type.  Needed for hppa2.0w.  */
-typedef long int DItype;
-typedef unsigned long int UDItype;
-#endif
-#endif
-
-typedef mp_limb_t UWtype;
-typedef unsigned int UHWtype;
-#define W_TYPE_SIZE BITS_PER_MP_LIMB
-
-/* Define ieee_double_extract and _GMP_IEEE_FLOATS.  */
-
-#if (defined (__arm__) && (defined (__ARMWEL__) || defined (__linux__)))
-/* Special case for little endian ARM since floats remain in big-endian.  */
-#define _GMP_IEEE_FLOATS 1
-union ieee_double_extract
-{
-  struct
-    {
-      unsigned int manh:20;
-      unsigned int exp:11;
-      unsigned int sig:1;
-      unsigned int manl:32;
-    } s;
-  double d;
-};
-#else
-#if defined (_LITTLE_ENDIAN) || defined (__LITTLE_ENDIAN__)		\
- || defined (__alpha)							\
- || defined (__clipper__)						\
- || defined (__cris)							\
- || defined (__i386__)							\
- || defined (__i860__)							\
- || defined (__i960__)							\
- || defined (MIPSEL) || defined (_MIPSEL)				\
- || defined (__ns32000__)						\
- || defined (__WINNT) || defined (_WIN32)
-#define _GMP_IEEE_FLOATS 1
-union ieee_double_extract
-{
-  struct
-    {
-      unsigned int manl:32;
-      unsigned int manh:20;
-      unsigned int exp:11;
-      unsigned int sig:1;
-    } s;
-  double d;
-};
-#else /* Need this as an #else since the tests aren't made exclusive.  */
-#if defined (_BIG_ENDIAN) || defined (__BIG_ENDIAN__)			\
- || defined (__a29k__) || defined (_AM29K)				\
- || defined (__arm__)							\
- || (defined (__convex__) && defined (_IEEE_FLOAT_))			\
- || defined (_CRAYMPP)							\
- || defined (__i370__) || defined (__mvs__)				\
- || defined (__mc68000__) || defined (__mc68020__) || defined (__m68k__)\
-    || defined(mc68020)							\
- || defined (__m88000__)						\
- || defined (MIPSEB) || defined (_MIPSEB)				\
- || defined (__hppa) || defined (__hppa__)				\
- || defined (__pyr__)							\
- || defined (__ibm032__)						\
- || defined (_IBMR2) || defined (_ARCH_PPC)				\
- || defined (__sh__)							\
- || defined (__sparc) || defined (sparc)				\
- || defined (__we32k__)
-#define _GMP_IEEE_FLOATS 1
-union ieee_double_extract
-{
-  struct
-    {
-      unsigned int sig:1;
-      unsigned int exp:11;
-      unsigned int manh:20;
-      unsigned int manl:32;
-    } s;
-  double d;
-};
-#endif
-#endif
-#endif
-
-/* Using "(2.0 * ((mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1)))" doesn't work on
-   SunOS 4.1.4 native /usr/ucb/cc (K&R), it comes out as -4294967296.0,
-   presumably due to treating the mp_limb_t constant as signed rather than
-   unsigned. */
-#define MP_BASE_AS_DOUBLE (4.0 * ((mp_limb_t) 1 << (BITS_PER_MP_LIMB - 2)))
-#if BITS_PER_MP_LIMB == 64
-#define LIMBS_PER_DOUBLE 2
-#else
-#define LIMBS_PER_DOUBLE 3
-#endif
-
-double __gmp_scale2 _PROTO ((double, int));
-int __gmp_extract_double _PROTO ((mp_ptr, double));
-
-extern int __gmp_junk;
-extern const int __gmp_0;
-#define GMP_ERROR(code)   (gmp_errno |= (code), __gmp_junk = 10/__gmp_0)
-#define DIVIDE_BY_ZERO    GMP_ERROR(GMP_ERROR_DIVISION_BY_ZERO)
-#define SQRT_OF_NEGATIVE  GMP_ERROR(GMP_ERROR_SQRT_OF_NEGATIVE)
-
-#if defined _LONG_LONG_LIMB
-#if defined (__STDC__)
-#define CNST_LIMB(C) C##LL
-#else
-#define CNST_LIMB(C) C/**/LL
-#endif
-#else /* not _LONG_LONG_LIMB */
-#if defined (__STDC__)
-#define CNST_LIMB(C) C##L
-#else
-#define CNST_LIMB(C) C/**/L
-#endif
-#endif /* _LONG_LONG_LIMB */
-
-/*** Stuff used by mpn/generic/prefsqr.c and mpn/generic/next_prime.c ***/
-#if BITS_PER_MP_LIMB == 32
-#define PP 0xC0CFD797L		/* 3 x 5 x 7 x 11 x 13 x ... x 29 */
-#define PP_INVERTED 0x53E5645CL
-#define PP_MAXPRIME 29
-#define PP_MASK 0x208A28A8L
-#endif
-
-#if BITS_PER_MP_LIMB == 64
-#define PP CNST_LIMB(0xE221F97C30E94E1D)	/* 3 x 5 x 7 x 11 x 13 x ... x 53 */
-#define PP_INVERTED CNST_LIMB(0x21CFE6CFC938B36B)
-#define PP_MAXPRIME 53
-#define PP_MASK CNST_LIMB(0x208A20A08A28A8)
-#endif
-
-
-/* BIT1 means a result value in bit 1 (second least significant bit), with a
-   zero bit representing +1 and a one bit representing -1.  Bits other than
-   bit 1 are garbage.
-
-   JACOBI_TWOS_U_BIT1 and JACOBI_RECIP_UU_BIT1 are used in mpn_jacobi_base
-   and their speed is important.  Expressions are used rather than
-   conditionals to accumulate sign changes, which effectively means XORs
-   instead of conditional JUMPs. */
-
-/* (a/0), with a signed; is 1 if a=+/-1, 0 otherwise */
-#define JACOBI_S0(a) \
-  (((a) == 1) | ((a) == -1))
-
-/* (a/0), with a unsigned; is 1 if a=+/-1, 0 otherwise */
-#define JACOBI_U0(a) \
-  ((a) == 1)
-
-/* (a/0), with a an mpz_t; is 1 if a=+/-1, 0 otherwise
-   An mpz_t always has at least one limb of allocated space, so the fetch of
-   the low limb is valid. */
-#define JACOBI_Z0(a) \
-  (((SIZ(a) == 1) | (SIZ(a) == -1)) & (PTR(a)[0] == 1))
-
-/* Convert a bit1 to +1 or -1. */
-#define JACOBI_BIT1_TO_PN(result_bit1) \
-  (1 - ((result_bit1) & 2))
-
-/* (2/b), with b unsigned and odd;
-   is (-1)^((b^2-1)/8) which is 1 if b==1,7mod8 or -1 if b==3,5mod8 and
-   hence obtained from (b>>1)^b */
-#define JACOBI_TWO_U_BIT1(b) \
-  (ASSERT (b & 1), (((b) >> 1) ^ (b)))
-
-/* (2/b)^twos, with b unsigned and odd */
-#define JACOBI_TWOS_U_BIT1(twos, b) \
-  (((twos) << 1) & JACOBI_TWO_U_BIT1 (b))
-
-/* (2/b)^twos, with b unsigned and odd */
-#define JACOBI_TWOS_U(twos, b) \
-  (JACOBI_BIT1_TO_PN (JACOBI_TWOS_U_BIT1 (twos, b)))
-
-/* (a/b) effect due to sign of a: signed/unsigned, b odd;
-   is (-1)^((b-1)/2) if a<0, or +1 if a>=0 */
-#define JACOBI_ASGN_SU_BIT1(a, b) \
-  ((((a) < 0) << 1) & (b))
-
-/* (a/b) effect due to sign of b: signed/mpz;
-   is -1 if a and b both negative, +1 otherwise */
-#define JACOBI_BSGN_SZ_BIT1(a, b) \
-  ((((a) < 0) & (SIZ(b) < 0)) << 1)
-
-/* (a/b) effect due to sign of b: mpz/signed */
-#define JACOBI_BSGN_ZS_BIT1(a, b) \
-  JACOBI_BSGN_SZ_BIT1(b, a)
-
-/* (a/b) reciprocity to switch to (b/a), a,b both unsigned and odd.
-   Is (-1)^((a-1)*(b-1)/4), which means +1 if either a,b==1mod4 or -1 if
-   both a,b==3mod4, achieved in bit 1 by a&b.  No ASSERT()s about a,b odd
-   because this is used in a couple of places with only bit 1 of a or b
-   valid. */
-#define JACOBI_RECIP_UU_BIT1(a, b) \
-  ((a) & (b))
-
-
-/* For testing and debugging.  */
-#define MPZ_CHECK_FORMAT(z)                                     	\
-  (ASSERT_ALWAYS (SIZ(z) == 0 || PTR(z)[ABSIZ(z) - 1] != 0),    	\
-   ASSERT_ALWAYS (ALLOC(z) >= ABSIZ(z)))
-#define MPZ_PROVOKE_REALLOC(z)						\
-  do { ALLOC(z) = ABSIZ(z); } while (0)
-
-
-#if TUNE_PROGRAM_BUILD
-/* Some extras wanted when recompiling some .c files for use by the tune
-   program.  Not part of a normal build. */
-
-extern mp_size_t  mul_threshold[];
-extern mp_size_t  fft_modf_mul_threshold;
-extern mp_size_t  sqr_threshold[];
-extern mp_size_t  fft_modf_sqr_threshold;
-extern mp_size_t  bz_threshold[];
-extern mp_size_t  fib_threshold[];
-extern mp_size_t  powm_threshold[];
-extern mp_size_t  gcd_accel_threshold[];
-extern mp_size_t  gcdext_threshold[];
-
-#undef KARATSUBA_MUL_THRESHOLD
-#undef TOOM3_MUL_THRESHOLD
-#undef FFT_MUL_TABLE
-#undef FFT_MUL_THRESHOLD
-#undef FFT_MODF_MUL_THRESHOLD
-#undef KARATSUBA_SQR_THRESHOLD
-#undef TOOM3_SQR_THRESHOLD
-#undef FFT_SQR_TABLE
-#undef FFT_SQR_THRESHOLD
-#undef FFT_MODF_SQR_THRESHOLD
-#undef BZ_THRESHOLD
-#undef FIB_THRESHOLD
-#undef POWM_THRESHOLD
-#undef GCD_ACCEL_THRESHOLD
-#undef GCDEXT_THRESHOLD
-
-#define KARATSUBA_MUL_THRESHOLD  mul_threshold[0]
-#define TOOM3_MUL_THRESHOLD      mul_threshold[1]
-#define FFT_MUL_TABLE            0
-#define FFT_MUL_THRESHOLD        mul_threshold[2]
-#define FFT_MODF_MUL_THRESHOLD   fft_modf_mul_threshold
-#define KARATSUBA_SQR_THRESHOLD  sqr_threshold[0]
-#define TOOM3_SQR_THRESHOLD      sqr_threshold[1]
-#define FFT_SQR_TABLE            0
-#define FFT_SQR_THRESHOLD        sqr_threshold[2]
-#define FFT_MODF_SQR_THRESHOLD   fft_modf_sqr_threshold
-#define BZ_THRESHOLD             bz_threshold[0]
-#define FIB_THRESHOLD            fib_threshold[0]
-#define POWM_THRESHOLD           powm_threshold[0]
-#define GCD_ACCEL_THRESHOLD      gcd_accel_threshold[0]
-#define GCDEXT_THRESHOLD         gcdext_threshold[0]
-
-#define TOOM3_MUL_THRESHOLD_LIMIT  700
-
-#undef  FFT_TABLE_ATTRS
-#define FFT_TABLE_ATTRS
-extern mp_size_t mpn_fft_table[2][MPN_FFT_TABLE_SIZE];
-
-#endif /* TUNE_PROGRAM_BUILD */
-
-#if defined (__cplusplus)
-}
-#endif
diff --git a/ghc/rts/gmp/gmp.h b/ghc/rts/gmp/gmp.h
deleted file mode 100644
index 0f1b9510e9..0000000000
--- a/ghc/rts/gmp/gmp.h
+++ /dev/null
@@ -1,1083 +0,0 @@
-/* gmp.h -- Definitions for GNU multiple precision functions.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1996, 1997, 1999, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#ifndef __GMP_H__
-
-#ifndef __GNU_MP__		/* to allow inclusion of both gmp.h and mp.h */
-#define __GNU_MP__ 2
-#define __need_size_t
-#include <stddef.h>
-#undef __need_size_t
-
-#ifndef STG_H
-/* Get DLL_IMPORT */
-#include "../../includes/ghcconfig.h"
-#include "../../includes/StgDLL.h"
-#endif
-
-#if defined (__mips) && defined (_ABIN32)
-/* Force the use of 64-bit limbs for all 64-bit MIPS CPUs if ABI permits.  */
-#define _LONG_LONG_LIMB
-#endif
-
-#if (__STDC__-0) || defined (__cplusplus)
-#define __gmp_const const
-#define __gmp_signed signed
-#else
-#define __gmp_const
-#define __gmp_signed
-#endif
-
-#if defined (__GNUC__)
-#define __gmp_inline __inline__
-#else
-#define __gmp_inline
-#endif
-
-#ifndef _EXTERN_INLINE
-#ifdef __GNUC__
-#define _EXTERN_INLINE extern __inline__
-#else
-#define _EXTERN_INLINE static
-#endif
-#endif
-
-#ifdef _SHORT_LIMB
-typedef unsigned int		mp_limb_t;
-typedef int			mp_limb_signed_t;
-#else
-#ifdef _LONG_LONG_LIMB
-typedef unsigned long long int	mp_limb_t;
-typedef long long int		mp_limb_signed_t;
-#else
-typedef unsigned long int	mp_limb_t;
-typedef long int		mp_limb_signed_t;
-#endif
-#endif
-
-typedef mp_limb_t *		mp_ptr;
-typedef __gmp_const mp_limb_t *	mp_srcptr;
-#if defined (_CRAY) && ! defined (_CRAYMPP)
-/* plain `int' is much faster (48 bits) */
-typedef int			mp_size_t;
-typedef int			mp_exp_t;
-#else
-typedef long int		mp_size_t;
-typedef long int		mp_exp_t;
-#endif
-
-typedef struct
-{
-  int _mp_alloc;		/* Number of *limbs* allocated and pointed
-				   to by the _mp_d field.  */
-  int _mp_size;			/* abs(_mp_size) is the number of limbs the
-				   last field points to.  If _mp_size is
-				   negative this is a negative number.  */
-  mp_limb_t *_mp_d;		/* Pointer to the limbs.  */
-} __mpz_struct;
-#endif /* __GNU_MP__ */
-
-typedef __mpz_struct MP_INT;
-typedef __mpz_struct mpz_t[1];
-
-typedef struct
-{
-  __mpz_struct _mp_num;
-  __mpz_struct _mp_den;
-} __mpq_struct;
-
-typedef __mpq_struct MP_RAT;
-typedef __mpq_struct mpq_t[1];
-
-typedef struct
-{
-  int _mp_prec;			/* Max precision, in number of `mp_limb_t's.
-				   Set by mpf_init and modified by
-				   mpf_set_prec.  The area pointed to by the
-				   _mp_d field contains `prec' + 1 limbs.  */
-  int _mp_size;			/* abs(_mp_size) is the number of limbs the
-				   last field points to.  If _mp_size is
-				   negative this is a negative number.  */
-  mp_exp_t _mp_exp;		/* Exponent, in the base of `mp_limb_t'.  */
-  mp_limb_t *_mp_d;		/* Pointer to the limbs.  */
-} __mpf_struct;
-
-/* typedef __mpf_struct MP_FLOAT; */
-typedef __mpf_struct mpf_t[1];
-
-/* Available random number generation algorithms.  */
-typedef enum
-{
-  GMP_RAND_ALG_DEFAULT = 0,
-  GMP_RAND_ALG_LC = GMP_RAND_ALG_DEFAULT /* Linear congruential.  */
-} gmp_randalg_t;
-
-/* Linear congruential data struct.  */
-typedef struct {
-  mpz_t a;			/* Multiplier. */
-  unsigned long int c;		/* Adder. */
-  mpz_t m;			/* Modulus (valid only if m2exp == 0).  */
-  unsigned long int m2exp;	/* If != 0, modulus is 2 ^ m2exp.  */
-} __gmp_randata_lc;
-
-/* Random state struct.  */
-typedef struct
-{
-  mpz_t seed;			/* Current seed.  */
-  gmp_randalg_t alg;		/* Algorithm used.  */
-  union {			/* Algorithm specific data.  */
-    __gmp_randata_lc *lc;	/* Linear congruential.  */
-  } algdata;
-} __gmp_randstate_struct;
-typedef __gmp_randstate_struct gmp_randstate_t[1];
-
-/* Types for function declarations in gmp files.  */
-/* ??? Should not pollute user name space with these ??? */
-typedef __gmp_const __mpz_struct *mpz_srcptr;
-typedef __mpz_struct *mpz_ptr;
-typedef __gmp_const __mpf_struct *mpf_srcptr;
-typedef __mpf_struct *mpf_ptr;
-typedef __gmp_const __mpq_struct *mpq_srcptr;
-typedef __mpq_struct *mpq_ptr;
-
-#ifndef _PROTO
-#if (__STDC__-0) || defined (__cplusplus)
-#define _PROTO(x) x
-#else
-#define _PROTO(x) ()
-#endif
-#endif
-
-#ifndef __MPN
-/* Really use `defined (__STDC__)' here; we want it to be true for Sun C */
-#if defined (__STDC__) || defined (__cplusplus)
-#define __MPN(x) __gmpn_##x
-#else
-#define __MPN(x) __gmpn_/**/x
-#endif
-#endif
-
-#if defined (FILE) || defined (H_STDIO) || defined (_H_STDIO) \
- || defined (_STDIO_H) || defined (_STDIO_H_) || defined (__STDIO_H__) \
- || defined (_STDIO_INCLUDED) || defined (__dj_include_stdio_h_)
-#define _GMP_H_HAVE_FILE 1
-#endif
-
-#if defined (__cplusplus)
-extern "C" {
-#endif
-
-#define mp_set_memory_functions __gmp_set_memory_functions
-DLL_IMPORT void mp_set_memory_functions _PROTO ((void *(*) (size_t),
-				      void *(*) (void *, size_t, size_t),
-				      void (*) (void *, size_t)));
-
-#define mp_bits_per_limb __gmp_bits_per_limb
-DLL_IMPORT extern __gmp_const int mp_bits_per_limb;
-
-#if defined (__cplusplus)
-}
-#endif
-
-
-/**************** Random number routines.  ****************/
-
-#define _gmp_rand __gmp_rand
-#define gmp_randinit __gmp_randinit
-#define gmp_randinit_lc __gmp_randinit_lc
-#define gmp_randinit_lc_2exp __gmp_randinit_lc_2exp
-#define gmp_randseed __gmp_randseed
-#define gmp_randseed_ui __gmp_randseed_ui
-#define gmp_randclear __gmp_randclear
-
-#if defined (__cplusplus)
-extern "C" {
-#endif
-
-DLL_IMPORT void _gmp_rand _PROTO ((mp_ptr, gmp_randstate_t, unsigned long int));
-DLL_IMPORT void gmp_randinit _PROTO ((gmp_randstate_t, gmp_randalg_t, ...));
-DLL_IMPORT void gmp_randinit_lc _PROTO ((gmp_randstate_t, mpz_t, unsigned long int,
-			      mpz_t));
-DLL_IMPORT void gmp_randinit_lc_2exp _PROTO ((gmp_randstate_t, mpz_t, unsigned long int,
-				   unsigned long int));
-DLL_IMPORT void gmp_randseed _PROTO ((gmp_randstate_t, mpz_t));
-DLL_IMPORT void gmp_randseed_ui _PROTO ((gmp_randstate_t, unsigned long int));
-DLL_IMPORT void gmp_randclear _PROTO ((gmp_randstate_t));
-
-#if defined (__cplusplus)
-}
-#endif
-
-/**************** Integer (i.e. Z) routines.  ****************/
-
-#define _mpz_realloc __gmpz_realloc
-#define mpz_realloc __gmpz_realloc
-#define mpz_abs __gmpz_abs
-#define mpz_add __gmpz_add
-#define mpz_add_ui __gmpz_add_ui
-#define mpz_addmul_ui __gmpz_addmul_ui
-#define mpz_and __gmpz_and
-#define mpz_array_init __gmpz_array_init
-#define mpz_bin_ui __gmpz_bin_ui
-#define mpz_bin_uiui __gmpz_bin_uiui
-#define mpz_cdiv_q __gmpz_cdiv_q
-#define mpz_cdiv_q_ui __gmpz_cdiv_q_ui
-#define mpz_cdiv_qr __gmpz_cdiv_qr
-#define mpz_cdiv_qr_ui __gmpz_cdiv_qr_ui
-#define mpz_cdiv_r __gmpz_cdiv_r
-#define mpz_cdiv_r_ui __gmpz_cdiv_r_ui
-#define mpz_cdiv_ui __gmpz_cdiv_ui
-#define mpz_clear __gmpz_clear
-#define mpz_clrbit __gmpz_clrbit
-#define mpz_cmp __gmpz_cmp
-#define _mpz_cmp_si __gmpz_cmp_si
-#define _mpz_cmp_ui __gmpz_cmp_ui
-#define mpz_cmpabs __gmpz_cmpabs
-#define mpz_cmpabs_ui __gmpz_cmpabs_ui
-#define mpz_com __gmpz_com
-#define mpz_divexact __gmpz_divexact
-#define mpz_dump __gmpz_dump
-#define mpz_fac_ui __gmpz_fac_ui
-#define mpz_fdiv_q __gmpz_fdiv_q
-#define mpz_fdiv_q_2exp __gmpz_fdiv_q_2exp
-#define mpz_fdiv_q_ui __gmpz_fdiv_q_ui
-#define mpz_fdiv_qr __gmpz_fdiv_qr
-#define mpz_fdiv_qr_ui __gmpz_fdiv_qr_ui
-#define mpz_fdiv_r __gmpz_fdiv_r
-#define mpz_fdiv_r_2exp __gmpz_fdiv_r_2exp
-#define mpz_fdiv_r_ui __gmpz_fdiv_r_ui
-#define mpz_fdiv_ui __gmpz_fdiv_ui
-#define mpz_fib_ui __gmpz_fib_ui
-#define mpz_fits_sint_p __gmpz_fits_sint_p
-#define mpz_fits_slong_p __gmpz_fits_slong_p
-#define mpz_fits_sshort_p __gmpz_fits_sshort_p
-#define mpz_fits_uint_p __gmpz_fits_uint_p
-#define mpz_fits_ulong_p __gmpz_fits_ulong_p
-#define mpz_fits_ushort_p __gmpz_fits_ushort_p
-#define mpz_gcd __gmpz_gcd
-#define mpz_gcd_ui __gmpz_gcd_ui
-#define mpz_gcdext __gmpz_gcdext
-#define mpz_get_d __gmpz_get_d
-#define mpz_get_si __gmpz_get_si
-#define mpz_get_str __gmpz_get_str
-#define mpz_get_ui __gmpz_get_ui
-#define mpz_getlimbn __gmpz_getlimbn
-#define mpz_hamdist __gmpz_hamdist
-#define mpz_init __gmpz_init
-#define mpz_inp_binary __gmpz_inp_binary
-#define mpz_inp_raw __gmpz_inp_raw
-#define mpz_inp_str __gmpz_inp_str
-#define mpz_init_set __gmpz_init_set
-#define mpz_init_set_d __gmpz_init_set_d
-#define mpz_init_set_si __gmpz_init_set_si
-#define mpz_init_set_str __gmpz_init_set_str
-#define mpz_init_set_ui __gmpz_init_set_ui
-#define mpz_invert __gmpz_invert
-#define mpz_ior __gmpz_ior
-#define mpz_jacobi __gmpz_jacobi
-#define mpz_lcm __gmpz_lcm
-#define mpz_legendre __gmpz_legendre
-#define mpz_mod __gmpz_mod
-#define mpz_mul __gmpz_mul
-#define mpz_mul_2exp __gmpz_mul_2exp
-#define mpz_neg __gmpz_neg
-#define mpz_nextprime __gmpz_nextprime
-#define mpz_out_binary __gmpz_out_binary
-#define mpz_out_raw __gmpz_out_raw
-#define mpz_out_str __gmpz_out_str
-#define mpz_perfect_power_p __gmpz_perfect_power_p
-#define mpz_perfect_square_p __gmpz_perfect_square_p
-#define mpz_popcount __gmpz_popcount
-#define mpz_pow_ui __gmpz_pow_ui
-#define mpz_powm __gmpz_powm
-#define mpz_powm_ui __gmpz_powm_ui
-#define mpz_probab_prime_p __gmpz_probab_prime_p
-#define mpz_random __gmpz_random
-#define mpz_random2 __gmpz_random2
-#define mpz_remove __gmpz_remove
-#define mpz_root __gmpz_root
-#define mpz_rrandomb __gmpz_rrandomb
-#define mpz_scan0 __gmpz_scan0
-#define mpz_scan1 __gmpz_scan1
-#define mpz_set __gmpz_set
-#define mpz_set_d __gmpz_set_d
-#define mpz_set_f __gmpz_set_f
-#define mpz_set_q __gmpz_set_q
-#define mpz_set_si __gmpz_set_si
-#define mpz_set_str __gmpz_set_str
-#define mpz_set_ui __gmpz_set_ui
-#define mpz_setbit __gmpz_setbit
-#define mpz_size __gmpz_size
-#define mpz_sizeinbase __gmpz_sizeinbase
-#define mpz_sqrt __gmpz_sqrt
-#define mpz_sqrtrem __gmpz_sqrtrem
-#define mpz_sub __gmpz_sub
-#define mpz_sub_ui __gmpz_sub_ui
-#define mpz_swap __gmpz_swap
-#define mpz_tdiv_ui __gmpz_tdiv_ui
-#define mpz_tdiv_q __gmpz_tdiv_q
-#define mpz_tdiv_q_2exp __gmpz_tdiv_q_2exp
-#define mpz_tdiv_q_ui __gmpz_tdiv_q_ui
-#define mpz_tdiv_qr __gmpz_tdiv_qr
-#define mpz_tdiv_qr_ui __gmpz_tdiv_qr_ui
-#define mpz_tdiv_r __gmpz_tdiv_r
-#define mpz_tdiv_r_2exp __gmpz_tdiv_r_2exp
-#define mpz_tdiv_r_ui __gmpz_tdiv_r_ui
-#define mpz_tstbit __gmpz_tstbit
-#define mpz_ui_pow_ui __gmpz_ui_pow_ui
-#define mpz_urandomb __gmpz_urandomb
-#define mpz_urandomm __gmpz_urandomm
-#define mpz_xor __gmpz_xor
-#define mpz_eor __gmpz_xor
-
-#if defined (__cplusplus)
-extern "C" {
-#endif
-DLL_IMPORT void *_mpz_realloc _PROTO ((mpz_ptr, mp_size_t));
-
-DLL_IMPORT void mpz_abs _PROTO ((mpz_ptr, mpz_srcptr));
-DLL_IMPORT void mpz_add _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_add_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_addmul_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_and _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_array_init _PROTO ((mpz_ptr, mp_size_t, mp_size_t));
-DLL_IMPORT void mpz_bin_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_bin_uiui _PROTO ((mpz_ptr, unsigned long int, unsigned long int));
-DLL_IMPORT void mpz_cdiv_q _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT unsigned long int mpz_cdiv_q_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_cdiv_qr _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT unsigned long int mpz_cdiv_qr_ui _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_cdiv_r _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT unsigned long int mpz_cdiv_r_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT unsigned long int mpz_cdiv_ui _PROTO ((mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_clear _PROTO ((mpz_ptr));
-DLL_IMPORT void mpz_clrbit _PROTO ((mpz_ptr, unsigned long int));
-DLL_IMPORT int mpz_cmp _PROTO ((mpz_srcptr, mpz_srcptr));
-DLL_IMPORT int _mpz_cmp_si _PROTO ((mpz_srcptr, signed long int));
-DLL_IMPORT int _mpz_cmp_ui _PROTO ((mpz_srcptr, unsigned long int));
-DLL_IMPORT int mpz_cmpabs _PROTO ((mpz_srcptr, mpz_srcptr));
-DLL_IMPORT int mpz_cmpabs_ui _PROTO ((mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_com _PROTO ((mpz_ptr, mpz_srcptr));
-DLL_IMPORT void mpz_divexact _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_dump _PROTO ((mpz_srcptr));
-DLL_IMPORT void mpz_fac_ui _PROTO ((mpz_ptr, unsigned long int));
-DLL_IMPORT void mpz_fdiv_q _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_fdiv_q_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT unsigned long int mpz_fdiv_q_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_fdiv_qr _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT unsigned long int mpz_fdiv_qr_ui _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_fdiv_r _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_fdiv_r_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT unsigned long int mpz_fdiv_r_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT unsigned long int mpz_fdiv_ui _PROTO ((mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_fib_ui _PROTO ((mpz_ptr, unsigned long int));
-DLL_IMPORT int mpz_fits_sint_p _PROTO ((mpz_srcptr));
-DLL_IMPORT int mpz_fits_slong_p _PROTO ((mpz_srcptr));
-DLL_IMPORT int mpz_fits_sshort_p _PROTO ((mpz_srcptr));
-DLL_IMPORT int mpz_fits_uint_p _PROTO ((mpz_srcptr));
-DLL_IMPORT int mpz_fits_ulong_p _PROTO ((mpz_srcptr));
-DLL_IMPORT int mpz_fits_ushort_p _PROTO ((mpz_srcptr));
-DLL_IMPORT void mpz_gcd _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT unsigned long int mpz_gcd_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_gcdext _PROTO ((mpz_ptr, mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT double mpz_get_d _PROTO ((mpz_srcptr));
-/* signed */ long int mpz_get_si _PROTO ((mpz_srcptr));
-DLL_IMPORT char *mpz_get_str _PROTO ((char *, int, mpz_srcptr));
-DLL_IMPORT unsigned long int mpz_get_ui _PROTO ((mpz_srcptr));
-DLL_IMPORT mp_limb_t mpz_getlimbn _PROTO ((mpz_srcptr, mp_size_t));
-DLL_IMPORT unsigned long int mpz_hamdist _PROTO ((mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_init _PROTO ((mpz_ptr));
-#ifdef _GMP_H_HAVE_FILE
-DLL_IMPORT size_t mpz_inp_binary _PROTO ((mpz_ptr, FILE *));
-DLL_IMPORT size_t mpz_inp_raw _PROTO ((mpz_ptr, FILE *));
-DLL_IMPORT size_t mpz_inp_str _PROTO ((mpz_ptr, FILE *, int));
-#endif
-DLL_IMPORT void mpz_init_set _PROTO ((mpz_ptr, mpz_srcptr));
-DLL_IMPORT void mpz_init_set_d _PROTO ((mpz_ptr, double));
-DLL_IMPORT void mpz_init_set_si _PROTO ((mpz_ptr, signed long int));
-DLL_IMPORT int mpz_init_set_str _PROTO ((mpz_ptr, __gmp_const char *, int));
-DLL_IMPORT void mpz_init_set_ui _PROTO ((mpz_ptr, unsigned long int));
-DLL_IMPORT int mpz_invert _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_ior _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT int mpz_jacobi _PROTO ((mpz_srcptr, mpz_srcptr));
-
-#define mpz_kronecker_si __gmpz_kronecker_si
-DLL_IMPORT int mpz_kronecker_si _PROTO ((mpz_srcptr, long));
-
-#define mpz_kronecker_ui __gmpz_kronecker_ui
-DLL_IMPORT int mpz_kronecker_ui _PROTO ((mpz_srcptr, unsigned long));
-
-#define mpz_si_kronecker __gmpz_si_kronecker
-DLL_IMPORT int mpz_si_kronecker _PROTO ((long, mpz_srcptr));
-
-#define mpz_ui_kronecker __gmpz_ui_kronecker
-DLL_IMPORT int mpz_ui_kronecker _PROTO ((unsigned long, mpz_srcptr));
-
-DLL_IMPORT void mpz_lcm _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT int mpz_legendre _PROTO ((mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_mod _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_mul _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_mul_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-
-#define mpz_mul_si __gmpz_mul_si
-DLL_IMPORT void mpz_mul_si _PROTO ((mpz_ptr, mpz_srcptr, long int));
-
-#define mpz_mul_ui __gmpz_mul_ui
-DLL_IMPORT void mpz_mul_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-
-DLL_IMPORT void mpz_neg _PROTO ((mpz_ptr, mpz_srcptr));
-DLL_IMPORT void mpz_nextprime _PROTO ((mpz_ptr, mpz_srcptr));
-#ifdef _GMP_H_HAVE_FILE
-DLL_IMPORT size_t mpz_out_binary _PROTO ((FILE *, mpz_srcptr));
-DLL_IMPORT size_t mpz_out_raw _PROTO ((FILE *, mpz_srcptr));
-DLL_IMPORT size_t mpz_out_str _PROTO ((FILE *, int, mpz_srcptr));
-#endif
-DLL_IMPORT int mpz_perfect_power_p _PROTO ((mpz_srcptr));
-DLL_IMPORT int mpz_perfect_square_p _PROTO ((mpz_srcptr));
-DLL_IMPORT unsigned long int mpz_popcount _PROTO ((mpz_srcptr));
-DLL_IMPORT void mpz_pow_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_powm _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_powm_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int, mpz_srcptr));
-DLL_IMPORT int mpz_probab_prime_p _PROTO ((mpz_srcptr, int));
-DLL_IMPORT void mpz_random _PROTO ((mpz_ptr, mp_size_t));
-DLL_IMPORT void mpz_random2 _PROTO ((mpz_ptr, mp_size_t));
-DLL_IMPORT unsigned long int mpz_remove _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT int mpz_root _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_rrandomb _PROTO ((mpz_ptr, gmp_randstate_t, unsigned long int));
-DLL_IMPORT unsigned long int mpz_scan0 _PROTO ((mpz_srcptr, unsigned long int));
-DLL_IMPORT unsigned long int mpz_scan1 _PROTO ((mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_set _PROTO ((mpz_ptr, mpz_srcptr));
-DLL_IMPORT void mpz_set_d _PROTO ((mpz_ptr, double));
-DLL_IMPORT void mpz_set_f _PROTO ((mpz_ptr, mpf_srcptr));
-DLL_IMPORT void mpz_set_q _PROTO ((mpz_ptr, mpq_srcptr));
-DLL_IMPORT void mpz_set_si _PROTO ((mpz_ptr, signed long int));
-DLL_IMPORT int mpz_set_str _PROTO ((mpz_ptr, __gmp_const char *, int));
-DLL_IMPORT void mpz_set_ui _PROTO ((mpz_ptr, unsigned long int));
-DLL_IMPORT void mpz_setbit _PROTO ((mpz_ptr, unsigned long int));
-DLL_IMPORT size_t mpz_size _PROTO ((mpz_srcptr));
-DLL_IMPORT size_t mpz_sizeinbase _PROTO ((mpz_srcptr, int));
-DLL_IMPORT void mpz_sqrt _PROTO ((mpz_ptr, mpz_srcptr));
-DLL_IMPORT void mpz_sqrtrem _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr));
-DLL_IMPORT void mpz_sub _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_sub_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_swap _PROTO ((mpz_ptr, mpz_ptr));
-DLL_IMPORT void mpz_tdiv_q _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_tdiv_q_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT unsigned long int mpz_tdiv_ui _PROTO ((mpz_srcptr, unsigned long int));
-DLL_IMPORT unsigned long int mpz_tdiv_q_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_tdiv_qr _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT unsigned long int mpz_tdiv_qr_ui _PROTO ((mpz_ptr, mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_tdiv_r _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-DLL_IMPORT void mpz_tdiv_r_2exp _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT unsigned long int mpz_tdiv_r_ui _PROTO ((mpz_ptr, mpz_srcptr, unsigned long int));
-DLL_IMPORT int mpz_tstbit _PROTO ((mpz_srcptr, unsigned long int));
-DLL_IMPORT void mpz_ui_pow_ui _PROTO ((mpz_ptr, unsigned long int, unsigned long int));
-DLL_IMPORT void mpz_urandomb _PROTO ((mpz_t, gmp_randstate_t, unsigned long int));
-DLL_IMPORT void mpz_urandomm _PROTO ((mpz_t, gmp_randstate_t, mpz_t));
-DLL_IMPORT void mpz_xor _PROTO ((mpz_ptr, mpz_srcptr, mpz_srcptr));
-#if defined (__cplusplus)
-}
-#endif
-
-/**************** Rational (i.e. Q) routines.  ****************/
-
-#define mpq_init __gmpq_init
-#define mpq_clear __gmpq_clear
-#define mpq_set __gmpq_set
-#define mpq_set_ui __gmpq_set_ui
-#define mpq_set_si __gmpq_set_si
-#define mpq_set_z __gmpq_set_z
-#define mpq_add __gmpq_add
-#define mpq_sub __gmpq_sub
-#define mpq_mul __gmpq_mul
-#define mpq_div __gmpq_div
-#define mpq_neg __gmpq_neg
-#define mpq_cmp __gmpq_cmp
-#define _mpq_cmp_ui __gmpq_cmp_ui
-#define mpq_equal __gmpq_equal
-#define mpq_inv __gmpq_inv
-#define mpq_set_num __gmpq_set_num
-#define mpq_set_den __gmpq_set_den
-#define mpq_get_num __gmpq_get_num
-#define mpq_get_den __gmpq_get_den
-#define mpq_get_d __gmpq_get_d
-#define mpq_set_d __gmpq_set_d
-#define mpq_canonicalize __gmpq_canonicalize
-
-#if defined (__cplusplus)
-extern "C" {
-#endif
-DLL_IMPORT void mpq_init _PROTO ((mpq_ptr));
-DLL_IMPORT void mpq_clear _PROTO ((mpq_ptr));
-DLL_IMPORT void mpq_set _PROTO ((mpq_ptr, mpq_srcptr));
-DLL_IMPORT void mpq_set_ui _PROTO ((mpq_ptr, unsigned long int, unsigned long int));
-DLL_IMPORT void mpq_set_si _PROTO ((mpq_ptr, signed long int, unsigned long int));
-DLL_IMPORT void mpq_set_z _PROTO ((mpq_ptr, mpz_srcptr));
-DLL_IMPORT void mpq_add _PROTO ((mpq_ptr, mpq_srcptr, mpq_srcptr));
-DLL_IMPORT void mpq_sub _PROTO ((mpq_ptr, mpq_srcptr, mpq_srcptr));
-DLL_IMPORT void mpq_mul _PROTO ((mpq_ptr, mpq_srcptr, mpq_srcptr));
-DLL_IMPORT void mpq_div _PROTO ((mpq_ptr, mpq_srcptr, mpq_srcptr));
-DLL_IMPORT void mpq_neg _PROTO ((mpq_ptr, mpq_srcptr));
-DLL_IMPORT int mpq_cmp _PROTO ((mpq_srcptr, mpq_srcptr));
-DLL_IMPORT int _mpq_cmp_ui _PROTO ((mpq_srcptr, unsigned long int, unsigned long int));
-DLL_IMPORT int mpq_equal _PROTO ((mpq_srcptr, mpq_srcptr));
-DLL_IMPORT void mpq_inv _PROTO ((mpq_ptr, mpq_srcptr));
-DLL_IMPORT void mpq_set_num _PROTO ((mpq_ptr, mpz_srcptr));
-DLL_IMPORT void mpq_set_den _PROTO ((mpq_ptr, mpz_srcptr));
-DLL_IMPORT void mpq_get_num _PROTO ((mpz_ptr, mpq_srcptr));
-DLL_IMPORT void mpq_get_den _PROTO ((mpz_ptr, mpq_srcptr));
-DLL_IMPORT double mpq_get_d _PROTO ((mpq_srcptr));
-DLL_IMPORT void mpq_set_d _PROTO ((mpq_ptr, double));
-DLL_IMPORT void mpq_canonicalize _PROTO ((mpq_ptr));
-
-#define mpq_swap __gmpq_swap
-DLL_IMPORT void mpq_swap _PROTO ((mpq_ptr, mpq_ptr));
-
-#ifdef _GMP_H_HAVE_FILE
-#define mpq_out_str __gmpq_out_str
-DLL_IMPORT size_t mpq_out_str _PROTO ((FILE *, int, mpq_srcptr));
-#endif
-
-#if defined (__cplusplus)
-}
-#endif
-
-/**************** Float (i.e. F) routines.  ****************/
-
-#define mpf_abs __gmpf_abs
-#define mpf_add __gmpf_add
-#define mpf_add_ui __gmpf_add_ui
-#define mpf_ceil __gmpf_ceil
-#define mpf_clear __gmpf_clear
-#define mpf_cmp __gmpf_cmp
-#define mpf_cmp_si __gmpf_cmp_si
-#define mpf_cmp_ui __gmpf_cmp_ui
-#define mpf_div __gmpf_div
-#define mpf_div_2exp __gmpf_div_2exp
-#define mpf_div_ui __gmpf_div_ui
-#define mpf_dump __gmpf_dump
-#define mpf_floor __gmpf_floor
-#define mpf_eq __gmpf_eq
-#define mpf_get_d __gmpf_get_d
-#define mpf_get_prec __gmpf_get_prec
-#define mpf_get_str __gmpf_get_str
-#define mpf_init __gmpf_init
-#define mpf_init2 __gmpf_init2
-#define mpf_inp_str __gmpf_inp_str
-#define mpf_init_set __gmpf_init_set
-#define mpf_init_set_d __gmpf_init_set_d
-#define mpf_init_set_si __gmpf_init_set_si
-#define mpf_init_set_str __gmpf_init_set_str
-#define mpf_init_set_ui __gmpf_init_set_ui
-#define mpf_mul __gmpf_mul
-#define mpf_mul_2exp __gmpf_mul_2exp
-#define mpf_mul_ui __gmpf_mul_ui
-#define mpf_neg __gmpf_neg
-#define mpf_out_str __gmpf_out_str
-#define mpf_pow_ui __gmpf_pow_ui
-#define mpf_random2 __gmpf_random2
-#define mpf_reldiff __gmpf_reldiff
-#define mpf_set __gmpf_set
-#define mpf_set_d __gmpf_set_d
-#define mpf_set_default_prec __gmpf_set_default_prec
-#define mpf_set_prec __gmpf_set_prec
-#define mpf_set_prec_raw __gmpf_set_prec_raw
-#define mpf_set_q __gmpf_set_q
-#define mpf_set_si __gmpf_set_si
-#define mpf_set_str __gmpf_set_str
-#define mpf_set_ui __gmpf_set_ui
-#define mpf_set_z __gmpf_set_z
-#define mpf_size __gmpf_size
-#define mpf_sqrt __gmpf_sqrt
-#define mpf_sqrt_ui __gmpf_sqrt_ui
-#define mpf_sub __gmpf_sub
-#define mpf_sub_ui __gmpf_sub_ui
-#define mpf_trunc __gmpf_trunc
-#define mpf_ui_div __gmpf_ui_div
-#define mpf_ui_sub __gmpf_ui_sub
-#define mpf_urandomb __gmpf_urandomb
-
-#if defined (__cplusplus)
-extern "C" {
-#endif
-DLL_IMPORT void mpf_abs _PROTO ((mpf_ptr, mpf_srcptr));
-DLL_IMPORT void mpf_add _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
-DLL_IMPORT void mpf_add_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
-DLL_IMPORT void mpf_ceil _PROTO ((mpf_ptr, mpf_srcptr));
-DLL_IMPORT void mpf_clear _PROTO ((mpf_ptr));
-DLL_IMPORT int mpf_cmp _PROTO ((mpf_srcptr, mpf_srcptr));
-DLL_IMPORT int mpf_cmp_si _PROTO ((mpf_srcptr, signed long int));
-DLL_IMPORT int mpf_cmp_ui _PROTO ((mpf_srcptr, unsigned long int));
-DLL_IMPORT void mpf_div _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
-DLL_IMPORT void mpf_div_2exp _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
-DLL_IMPORT void mpf_div_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
-DLL_IMPORT void mpf_dump _PROTO ((mpf_srcptr));
-DLL_IMPORT int mpf_eq _PROTO ((mpf_srcptr, mpf_srcptr, unsigned long int));
-DLL_IMPORT void mpf_floor _PROTO ((mpf_ptr, mpf_srcptr));
-DLL_IMPORT double mpf_get_d _PROTO ((mpf_srcptr));
-DLL_IMPORT unsigned long int mpf_get_prec _PROTO ((mpf_srcptr));
-char *mpf_get_str _PROTO ((char *, mp_exp_t *, int, size_t, mpf_srcptr));
-DLL_IMPORT void mpf_init _PROTO ((mpf_ptr));
-DLL_IMPORT void mpf_init2 _PROTO ((mpf_ptr, unsigned long int));
-#ifdef _GMP_H_HAVE_FILE
-DLL_IMPORT size_t mpf_inp_str _PROTO ((mpf_ptr, FILE *, int));
-#endif
-DLL_IMPORT void mpf_init_set _PROTO ((mpf_ptr, mpf_srcptr));
-DLL_IMPORT void mpf_init_set_d _PROTO ((mpf_ptr, double));
-DLL_IMPORT void mpf_init_set_si _PROTO ((mpf_ptr, signed long int));
-DLL_IMPORT int mpf_init_set_str _PROTO ((mpf_ptr, __gmp_const char *, int));
-DLL_IMPORT void mpf_init_set_ui _PROTO ((mpf_ptr, unsigned long int));
-DLL_IMPORT void mpf_mul _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
-DLL_IMPORT void mpf_mul_2exp _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
-DLL_IMPORT void mpf_mul_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
-DLL_IMPORT void mpf_neg _PROTO ((mpf_ptr, mpf_srcptr));
-#ifdef _GMP_H_HAVE_FILE
-DLL_IMPORT size_t mpf_out_str _PROTO ((FILE *, int, size_t, mpf_srcptr));
-#endif
-DLL_IMPORT void mpf_pow_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
-DLL_IMPORT void mpf_random2 _PROTO ((mpf_ptr, mp_size_t, mp_exp_t));
-DLL_IMPORT void mpf_reldiff _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
-DLL_IMPORT void mpf_set _PROTO ((mpf_ptr, mpf_srcptr));
-DLL_IMPORT void mpf_set_d _PROTO ((mpf_ptr, double));
-DLL_IMPORT void mpf_set_default_prec _PROTO ((unsigned long int));
-DLL_IMPORT void mpf_set_prec _PROTO ((mpf_ptr, unsigned long int));
-DLL_IMPORT void mpf_set_prec_raw _PROTO ((mpf_ptr, unsigned long int));
-DLL_IMPORT void mpf_set_q _PROTO ((mpf_ptr, mpq_srcptr));
-DLL_IMPORT void mpf_set_si _PROTO ((mpf_ptr, signed long int));
-DLL_IMPORT int mpf_set_str _PROTO ((mpf_ptr, __gmp_const char *, int));
-DLL_IMPORT void mpf_set_ui _PROTO ((mpf_ptr, unsigned long int));
-DLL_IMPORT void mpf_set_z _PROTO ((mpf_ptr, mpz_srcptr));
-DLL_IMPORT size_t mpf_size _PROTO ((mpf_srcptr));
-DLL_IMPORT void mpf_sqrt _PROTO ((mpf_ptr, mpf_srcptr));
-DLL_IMPORT void mpf_sqrt_ui _PROTO ((mpf_ptr, unsigned long int));
-DLL_IMPORT void mpf_sub _PROTO ((mpf_ptr, mpf_srcptr, mpf_srcptr));
-DLL_IMPORT void mpf_sub_ui _PROTO ((mpf_ptr, mpf_srcptr, unsigned long int));
-DLL_IMPORT void mpf_trunc _PROTO ((mpf_ptr, mpf_srcptr));
-DLL_IMPORT void mpf_ui_div _PROTO ((mpf_ptr, unsigned long int, mpf_srcptr));
-DLL_IMPORT void mpf_ui_sub _PROTO ((mpf_ptr, unsigned long int, mpf_srcptr));
-DLL_IMPORT void mpf_urandomb _PROTO ((mpf_t, gmp_randstate_t, unsigned long int));
-
-#define mpf_swap __gmpf_swap
-DLL_IMPORT void mpf_swap _PROTO ((mpf_ptr, mpf_ptr));
-
-#if defined (__cplusplus)
-}
-#endif
-/************ Low level positive-integer (i.e. N) routines.  ************/
-
-/* This is ugly, but we need to make user calls reach the prefixed function. */
-#define mpn_add			__MPN(add)
-#define mpn_add_1		__MPN(add_1)
-#define mpn_add_n		__MPN(add_n)
-#define mpn_add_nc		__MPN(add_nc)
-#define mpn_addmul_1		__MPN(addmul_1)
-#define mpn_addsub_n		__MPN(addsub_n)
-#define mpn_addsub_nc		__MPN(addsub_nc)
-/* #define mpn_and_n		__MPN(and_n) */
-/* #define mpn_andn_n		__MPN(andn_n) */
-#define mpn_bdivmod		__MPN(bdivmod)
-#define mpn_cmp			__MPN(cmp)
-/* #define mpn_com_n		__MPN(com_n) */
-#define mpn_copyd		__MPN(copyd)
-#define mpn_copyi		__MPN(copyi)
-#define mpn_divrem		__MPN(divrem)
-#define mpn_divrem_1		__MPN(divrem_1)
-#define mpn_divrem_2		__MPN(divrem_2)
-#define mpn_dump		__MPN(dump)
-#define mpn_gcd			__MPN(gcd)
-#define mpn_gcd_1		__MPN(gcd_1)
-#define mpn_gcdext		__MPN(gcdext)
-#define mpn_get_str		__MPN(get_str)
-#define mpn_hamdist		__MPN(hamdist)
-#define mpn_invert_limb 	__MPN(invert_limb)
-/* #define mpn_ior_n		__MPN(ior_n) */
-/* #define mpn_iorn_n		__MPN(iorn_n) */
-/* #define mpn_kara_mul_n	__MPN(kara_mul_n)  internal */
-/* #define mpn_kara_sqr_n	__MPN(kara_sqr_n)  internal */
-#define mpn_lshift		__MPN(lshift)
-#define mpn_lshiftc		__MPN(lshiftc)
-#define mpn_mod_1		__MPN(mod_1)
-#define mpn_mul			__MPN(mul)
-#define mpn_mul_1		__MPN(mul_1)
-#define mpn_mul_basecase	__MPN(mul_basecase)
-#define mpn_mul_n		__MPN(mul_n)
-#define mpn_perfect_square_p	__MPN(perfect_square_p)
-#define mpn_popcount		__MPN(popcount)
-#define mpn_preinv_mod_1	__MPN(preinv_mod_1)
-/* #define mpn_nand_n		__MPN(nand_n) */
-/* #define mpn_nior_n		__MPN(nior_n) */
-#define mpn_random		__MPN(random)
-#define mpn_random2		__MPN(random2)
-#define mpn_rshift		__MPN(rshift)
-#define mpn_rshiftc		__MPN(rshiftc)
-#define mpn_scan0		__MPN(scan0)
-#define mpn_scan1		__MPN(scan1)
-#define mpn_set_str		__MPN(set_str)
-#define mpn_sqr_basecase	__MPN(sqr_basecase)
-#define mpn_sqr_n		__MPN(sqr_n)
-#define mpn_sqrtrem		__MPN(sqrtrem)
-#define mpn_sub			__MPN(sub)
-#define mpn_sub_1		__MPN(sub_1)
-#define mpn_sub_n		__MPN(sub_n)
-#define mpn_sub_nc		__MPN(sub_nc)
-#define mpn_submul_1		__MPN(submul_1)
-/* #define mpn_toom3_mul_n		__MPN(toom3_mul_n)  internal */
-/* #define mpn_toom3_sqr_n		__MPN(toom3_sqr_n)  internal */
-/* #define mpn_xnor_n		__MPN(xnor_n) */
-/* #define mpn_xor_n		__MPN(xor_n) */
-
-#if defined (__cplusplus)
-extern "C" {
-#endif
-
-DLL_IMPORT mp_limb_t mpn_add _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_srcptr,mp_size_t));
-DLL_IMPORT mp_limb_t mpn_add_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
-DLL_IMPORT mp_limb_t mpn_add_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-DLL_IMPORT mp_limb_t mpn_add_nc _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t, mp_limb_t));
-
-DLL_IMPORT mp_limb_t mpn_addmul_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
-
-#define mpn_addmul_1c  __MPN(addmul_1c)
-DLL_IMPORT mp_limb_t mpn_addmul_1c _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t, mp_limb_t));
-
-DLL_IMPORT mp_limb_t mpn_addsub_n _PROTO ((mp_ptr, mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-DLL_IMPORT mp_limb_t mpn_bdivmod _PROTO ((mp_ptr, mp_ptr, mp_size_t, mp_srcptr, mp_size_t, unsigned long int));
-DLL_IMPORT int mpn_cmp _PROTO ((mp_srcptr, mp_srcptr, mp_size_t));
-
-#define mpn_divexact_by3(dst, src, size)  mpn_divexact_by3c (dst, src, size, 0)
-
-#define mpn_divexact_by3c  __MPN(divexact_by3c)
-DLL_IMPORT mp_limb_t mpn_divexact_by3c _PROTO ((mp_ptr dst, mp_srcptr src,
-                                     mp_size_t size, mp_limb_t carry));
-
-#define mpn_divmod_1(qp,np,nsize,dlimb) mpn_divrem_1 (qp,0,np,nsize,dlimb)
-
-DLL_IMPORT mp_limb_t mpn_divrem _PROTO((mp_ptr, mp_size_t, mp_ptr, mp_size_t, mp_srcptr, mp_size_t));
-
-DLL_IMPORT mp_limb_t mpn_divrem_1 _PROTO ((mp_ptr, mp_size_t, mp_srcptr, mp_size_t, mp_limb_t));
-
-#define mpn_divrem_1c  __MPN(divrem_1c)
-DLL_IMPORT mp_limb_t mpn_divrem_1c _PROTO ((mp_ptr, mp_size_t, mp_srcptr, mp_size_t,
-                                 mp_limb_t, mp_limb_t));
-
-DLL_IMPORT mp_limb_t mpn_divrem_2 _PROTO ((mp_ptr, mp_size_t, mp_ptr, mp_size_t, mp_srcptr));
-DLL_IMPORT void mpn_dump _PROTO ((mp_srcptr, mp_size_t));
-mp_size_t mpn_gcd _PROTO ((mp_ptr, mp_ptr, mp_size_t, mp_ptr, mp_size_t));
-DLL_IMPORT mp_limb_t mpn_gcd_1 _PROTO ((mp_srcptr, mp_size_t, mp_limb_t));
-mp_size_t mpn_gcdext _PROTO ((mp_ptr, mp_ptr, mp_size_t *, mp_ptr, mp_size_t, mp_ptr, mp_size_t));
-DLL_IMPORT size_t mpn_get_str _PROTO ((unsigned char *, int, mp_ptr, mp_size_t));
-DLL_IMPORT unsigned long int mpn_hamdist _PROTO ((mp_srcptr, mp_srcptr, mp_size_t));
-
-#define mpn_jacobi_base __MPN(jacobi_base)
-DLL_IMPORT int mpn_jacobi_base _PROTO ((mp_limb_t a, mp_limb_t b, int result_bit1));
-
-DLL_IMPORT mp_limb_t mpn_lshift _PROTO ((mp_ptr, mp_srcptr, mp_size_t, unsigned int));
-DLL_IMPORT mp_limb_t mpn_mod_1 _PROTO ((mp_srcptr, mp_size_t, mp_limb_t));
-
-#define mpn_mod_1c  __MPN(mod_1c)
-DLL_IMPORT mp_limb_t mpn_mod_1c _PROTO ((mp_srcptr, mp_size_t, mp_limb_t, mp_limb_t));
-
-#define mpn_mod_1_rshift __MPN(mod_1_rshift)
-DLL_IMPORT mp_limb_t mpn_mod_1_rshift _PROTO ((mp_srcptr, mp_size_t, unsigned,mp_limb_t));
-
-DLL_IMPORT mp_limb_t mpn_mul _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t));
-DLL_IMPORT mp_limb_t mpn_mul_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
-
-#define mpn_mul_1c  __MPN(mul_1c)
-DLL_IMPORT mp_limb_t mpn_mul_1c _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t, mp_limb_t));
-
-DLL_IMPORT void mpn_mul_basecase _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t));
-DLL_IMPORT void mpn_mul_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-DLL_IMPORT int mpn_perfect_square_p _PROTO ((mp_srcptr, mp_size_t));
-DLL_IMPORT unsigned long int mpn_popcount _PROTO ((mp_srcptr, mp_size_t));
-DLL_IMPORT mp_limb_t mpn_preinv_mod_1 _PROTO ((mp_srcptr, mp_size_t, mp_limb_t, mp_limb_t));
-DLL_IMPORT void mpn_random _PROTO ((mp_ptr, mp_size_t));
-DLL_IMPORT void mpn_random2 _PROTO ((mp_ptr, mp_size_t));
-DLL_IMPORT mp_limb_t mpn_rshift _PROTO ((mp_ptr, mp_srcptr, mp_size_t, unsigned int));
-DLL_IMPORT unsigned long int mpn_scan0 _PROTO ((mp_srcptr, unsigned long int));
-DLL_IMPORT unsigned long int mpn_scan1 _PROTO ((mp_srcptr, unsigned long int));
-mp_size_t mpn_set_str _PROTO ((mp_ptr, __gmp_const unsigned char *, size_t, int));
-DLL_IMPORT void mpn_sqr_n _PROTO ((mp_ptr, mp_srcptr, mp_size_t));
-DLL_IMPORT void mpn_sqr_basecase _PROTO ((mp_ptr, mp_srcptr, mp_size_t));
-mp_size_t mpn_sqrtrem _PROTO ((mp_ptr, mp_ptr, mp_srcptr, mp_size_t));
-DLL_IMPORT mp_limb_t mpn_sub _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_srcptr,mp_size_t));
-DLL_IMPORT mp_limb_t mpn_sub_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
-DLL_IMPORT mp_limb_t mpn_sub_n _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-DLL_IMPORT mp_limb_t mpn_sub_nc _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t, mp_limb_t));
-DLL_IMPORT mp_limb_t mpn_submul_1 _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t));
-
-#define mpn_submul_1c  __MPN(submul_1c)
-DLL_IMPORT mp_limb_t mpn_submul_1c _PROTO ((mp_ptr, mp_srcptr, mp_size_t, mp_limb_t, mp_limb_t));
-
-#define mpn_tdiv_qr  __MPN(tdiv_qr)
-DLL_IMPORT void mpn_tdiv_qr _PROTO ((mp_ptr, mp_ptr, mp_size_t, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t));
-
-#if defined (__cplusplus)
-}
-#endif
-
-#define mpn_incr_u(p,incr) \
-  do { mp_limb_t __x; mp_ptr __p = p;			\
-    __x = *__p + incr;					\
-    *__p = __x;						\
-    if (__x < incr)					\
-      while (++(*(++__p)) == 0)				\
-        ;						\
-  } while (0)
-
-#define mpn_decr_u(p,incr) \
-  do { mp_limb_t __x; mp_ptr __p = p;			\
-    __x = *__p;						\
-    *__p = __x - incr;					\
-    if (__x < incr)					\
-      while ((*(++__p))-- == 0)				\
-        ;						\
-  } while (0)
-
-#if defined (__GNUC__) || defined (_FORCE_INLINES)
-_EXTERN_INLINE mp_limb_t
-#if (__STDC__-0) || defined (__cplusplus)
-mpn_add_1 (register mp_ptr res_ptr,
-	   register mp_srcptr s1_ptr,
-	   register mp_size_t s1_size,
-	   register mp_limb_t s2_limb)
-#else
-mpn_add_1 (res_ptr, s1_ptr, s1_size, s2_limb)
-     register mp_ptr res_ptr;
-     register mp_srcptr s1_ptr;
-     register mp_size_t s1_size;
-     register mp_limb_t s2_limb;
-#endif
-{
-  register mp_limb_t x;
-
-  x = *s1_ptr++;
-  s2_limb = x + s2_limb;
-  *res_ptr++ = s2_limb;
-  if (s2_limb < x)
-    {
-      while (--s1_size != 0)
-	{
-	  x = *s1_ptr++ + 1;
-	  *res_ptr++ = x;
-	  if (x != 0)
-	    goto fin;
-	}
-
-      return 1;
-    }
-
- fin:
-  if (res_ptr != s1_ptr)
-    {
-      mp_size_t i;
-      for (i = 0; i < s1_size - 1; i++)
-	res_ptr[i] = s1_ptr[i];
-    }
-  return 0;
-}
-
-_EXTERN_INLINE mp_limb_t
-#if (__STDC__-0) || defined (__cplusplus)
-mpn_add (register mp_ptr res_ptr,
-	 register mp_srcptr s1_ptr,
-	 register mp_size_t s1_size,
-	 register mp_srcptr s2_ptr,
-	 register mp_size_t s2_size)
-#else
-mpn_add (res_ptr, s1_ptr, s1_size, s2_ptr, s2_size)
-     register mp_ptr res_ptr;
-     register mp_srcptr s1_ptr;
-     register mp_size_t s1_size;
-     register mp_srcptr s2_ptr;
-     register mp_size_t s2_size;
-#endif
-{
-  mp_limb_t cy_limb = 0;
-
-  if (s2_size != 0)
-    cy_limb = mpn_add_n (res_ptr, s1_ptr, s2_ptr, s2_size);
-
-  if (s1_size - s2_size != 0)
-    cy_limb = mpn_add_1 (res_ptr + s2_size,
-			 s1_ptr + s2_size,
-			 s1_size - s2_size,
-			 cy_limb);
-  return cy_limb;
-}
-
-_EXTERN_INLINE mp_limb_t
-#if (__STDC__-0) || defined (__cplusplus)
-mpn_sub_1 (register mp_ptr res_ptr,
-	   register mp_srcptr s1_ptr,
-	   register mp_size_t s1_size,
-	   register mp_limb_t s2_limb)
-#else
-mpn_sub_1 (res_ptr, s1_ptr, s1_size, s2_limb)
-     register mp_ptr res_ptr;
-     register mp_srcptr s1_ptr;
-     register mp_size_t s1_size;
-     register mp_limb_t s2_limb;
-#endif
-{
-  register mp_limb_t x;
-
-  x = *s1_ptr++;
-  s2_limb = x - s2_limb;
-  *res_ptr++ = s2_limb;
-  if (s2_limb > x)
-    {
-      while (--s1_size != 0)
-	{
-	  x = *s1_ptr++;
-	  *res_ptr++ = x - 1;
-	  if (x != 0)
-	    goto fin;
-	}
-
-      return 1;
-    }
-
- fin:
-  if (res_ptr != s1_ptr)
-    {
-      mp_size_t i;
-      for (i = 0; i < s1_size - 1; i++)
-	res_ptr[i] = s1_ptr[i];
-    }
-  return 0;
-}
-
-_EXTERN_INLINE mp_limb_t
-#if (__STDC__-0) || defined (__cplusplus)
-mpn_sub (register mp_ptr res_ptr,
-	 register mp_srcptr s1_ptr,
-	 register mp_size_t s1_size,
-	 register mp_srcptr s2_ptr,
-	 register mp_size_t s2_size)
-#else
-mpn_sub (res_ptr, s1_ptr, s1_size, s2_ptr, s2_size)
-     register mp_ptr res_ptr;
-     register mp_srcptr s1_ptr;
-     register mp_size_t s1_size;
-     register mp_srcptr s2_ptr;
-     register mp_size_t s2_size;
-#endif
-{
-  mp_limb_t cy_limb = 0;
-
-  if (s2_size != 0)
-    cy_limb = mpn_sub_n (res_ptr, s1_ptr, s2_ptr, s2_size);
-
-  if (s1_size - s2_size != 0)
-    cy_limb = mpn_sub_1 (res_ptr + s2_size,
-			 s1_ptr + s2_size,
-			 s1_size - s2_size,
-			 cy_limb);
-  return cy_limb;
-}
-#endif /* __GNUC__ */
-
-/* Allow faster testing for negative, zero, and positive.  */
-#define mpz_sgn(Z) ((Z)->_mp_size < 0 ? -1 : (Z)->_mp_size > 0)
-#define mpf_sgn(F) ((F)->_mp_size < 0 ? -1 : (F)->_mp_size > 0)
-#define mpq_sgn(Q) ((Q)->_mp_num._mp_size < 0 ? -1 : (Q)->_mp_num._mp_size > 0)
-
-/* When using GCC, optimize certain common comparisons.  */
-#if defined (__GNUC__)
-#define mpz_cmp_ui(Z,UI) \
-  (__builtin_constant_p (UI) && (UI) == 0				\
-   ? mpz_sgn (Z) : _mpz_cmp_ui (Z,UI))
-#define mpz_cmp_si(Z,SI) \
-  (__builtin_constant_p (SI) && (SI) == 0 ? mpz_sgn (Z)			\
-   : __builtin_constant_p (SI) && (SI) > 0				\
-    ? _mpz_cmp_ui (Z, (unsigned long int) SI)				\
-   : _mpz_cmp_si (Z,SI))
-#define mpq_cmp_ui(Q,NUI,DUI) \
-  (__builtin_constant_p (NUI) && (NUI) == 0				\
-   ? mpq_sgn (Q) : _mpq_cmp_ui (Q,NUI,DUI))
-#else
-#define mpz_cmp_ui(Z,UI) _mpz_cmp_ui (Z,UI)
-#define mpz_cmp_si(Z,UI) _mpz_cmp_si (Z,UI)
-#define mpq_cmp_ui(Q,NUI,DUI) _mpq_cmp_ui (Q,NUI,DUI)
-#endif
-
-
-/* Using "&" rather than "&&" means these can come out branch-free.  Every
-   mpz_t has at least one limb allocated, so fetching the low limb is always
-   allowed.  */
-#define mpz_odd_p(z)   ((int) ((z)->_mp_size != 0) & (int) (z)->_mp_d[0])
-#define mpz_even_p(z)  (! mpz_odd_p (z))
-
-
-/* Allow direct user access to numerator and denominator of a mpq_t object.  */
-#define mpq_numref(Q) (&((Q)->_mp_num))
-#define mpq_denref(Q) (&((Q)->_mp_den))
-
-
-/* Compatibility with GMP 2 and earlier. */
-#define mpn_divmod(qp,np,nsize,dp,dsize) mpn_divrem (qp,0,np,nsize,dp,dsize)
-
-/* Compatibility with GMP 1.  */
-#define mpz_mdiv	mpz_fdiv_q
-#define mpz_mdivmod	mpz_fdiv_qr
-#define mpz_mmod	mpz_fdiv_r
-#define mpz_mdiv_ui	mpz_fdiv_q_ui
-#define mpz_mdivmod_ui(q,r,n,d) \
-  ((r == 0) ? mpz_fdiv_q_ui (q,n,d) : mpz_fdiv_qr_ui (q,r,n,d))
-#define mpz_mmod_ui(r,n,d) \
-  ((r == 0) ? mpz_fdiv_ui (n,d) : mpz_fdiv_r_ui (r,n,d))
-
-/* Useful synonyms, but not quite compatible with GMP 1.  */
-#define mpz_div		mpz_fdiv_q
-#define mpz_divmod	mpz_fdiv_qr
-#define mpz_div_ui	mpz_fdiv_q_ui
-#define mpz_divmod_ui	mpz_fdiv_qr_ui
-#define mpz_mod_ui	mpz_fdiv_r_ui
-#define mpz_div_2exp	mpz_fdiv_q_2exp
-#define mpz_mod_2exp	mpz_fdiv_r_2exp
-
-#define gmp_errno __gmp_errno
-extern int gmp_errno;
-
-enum
-{
-  GMP_ERROR_NONE = 0,
-  GMP_ERROR_UNSUPPORTED_ARGUMENT = 1,
-  GMP_ERROR_DIVISION_BY_ZERO = 2,
-  GMP_ERROR_SQRT_OF_NEGATIVE = 4,
-  GMP_ERROR_INVALID_ARGUMENT = 8,
-  GMP_ERROR_ALLOCATE = 16,
-  GMP_ERROR_BAD_STRING = 32,
-  GMP_ERROR_UNUSED_ERROR
-};
-
-/* Note: major version number is in mp.h too */
-#define __GNU_MP_VERSION 3
-#define __GNU_MP_VERSION_MINOR 1
-#define __GNU_MP_VERSION_PATCHLEVEL 1
-
-#define gmp_version __gmp_version
-extern __gmp_const char *gmp_version;
-
-#define __GMP_H__
-#endif /* __GMP_H__ */
diff --git a/ghc/rts/gmp/insert-dbl.c b/ghc/rts/gmp/insert-dbl.c
deleted file mode 100644
index dc88a56f62..0000000000
--- a/ghc/rts/gmp/insert-dbl.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/* __gmp_insert_double -- convert from array of mp_limb_t to double.
-
-Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-#ifdef XDEBUG
-#undef _GMP_IEEE_FLOATS
-#endif
-
-#ifndef _GMP_IEEE_FLOATS
-#define _GMP_IEEE_FLOATS 0
-#endif
-
-double
-#if __STDC__
-__gmp_scale2 (double d, int exp)
-#else
-__gmp_scale2 (d, exp)
-     double d;
-     int exp;
-#endif
-{
-#if _GMP_IEEE_FLOATS
-  {
-#if defined (__alpha) && __GNUC__ == 2 && __GNUC_MINOR__ == 8
-    /* Work around alpha-specific bug in GCC 2.8.x.  */
-    volatile
-#endif
-    union ieee_double_extract x;
-    x.d = d;
-    exp += x.s.exp;
-    x.s.exp = exp;
-    if (exp >= 2047)
-      {
-	/* Return +-infinity */
-	x.s.exp = 2047;
-	x.s.manl = x.s.manh = 0;
-      }
-    else if (exp < 1)
-      {
-	x.s.exp = 1;		/* smallest exponent (biased) */
-	/* Divide result by 2 until we have scaled it to the right IEEE
-	   denormalized number, but stop if it becomes zero.  */
-	while (exp < 1 && x.d != 0)
-	  {
-	    x.d *= 0.5;
-	    exp++;
-	  }
-      }
-    return x.d;
-  }
-#else
-  {
-    double factor, r;
-
-    factor = 2.0;
-    if (exp < 0)
-      {
-	factor = 0.5;
-	exp = -exp;
-      }
-    r = d;
-    if (exp != 0)
-      {
-	if ((exp & 1) != 0)
-	  r *= factor;
-	exp >>= 1;
-	while (exp != 0)
-	  {
-	    factor *= factor;
-	    if ((exp & 1) != 0)
-	      r *= factor;
-	    exp >>= 1;
-	  }
-      }
-    return r;
-  }
-#endif
-}
diff --git a/ghc/rts/gmp/install-sh b/ghc/rts/gmp/install-sh
deleted file mode 100644
index e9de23842d..0000000000
--- a/ghc/rts/gmp/install-sh
+++ /dev/null
@@ -1,251 +0,0 @@
-#!/bin/sh
-#
-# install - install a program, script, or datafile
-# This comes from X11R5 (mit/util/scripts/install.sh).
-#
-# Copyright 1991 by the Massachusetts Institute of Technology
-#
-# Permission to use, copy, modify, distribute, and sell this software and its
-# documentation for any purpose is hereby granted without fee, provided that
-# the above copyright notice appear in all copies and that both that
-# copyright notice and this permission notice appear in supporting
-# documentation, and that the name of M.I.T. not be used in advertising or
-# publicity pertaining to distribution of the software without specific,
-# written prior permission.  M.I.T. makes no representations about the
-# suitability of this software for any purpose.  It is provided "as is"
-# without express or implied warranty.
-#
-# Calling this script install-sh is preferred over install.sh, to prevent
-# `make' implicit rules from creating a file called install from it
-# when there is no Makefile.
-#
-# This script is compatible with the BSD install script, but was written
-# from scratch.  It can only install one file at a time, a restriction
-# shared with many OS's install programs.
-
-
-# set DOITPROG to echo to test this script
-
-# Don't use :- since 4.3BSD and earlier shells don't like it.
-doit="${DOITPROG-}"
-
-
-# put in absolute paths if you don't have them in your path; or use env. vars.
-
-mvprog="${MVPROG-mv}"
-cpprog="${CPPROG-cp}"
-chmodprog="${CHMODPROG-chmod}"
-chownprog="${CHOWNPROG-chown}"
-chgrpprog="${CHGRPPROG-chgrp}"
-stripprog="${STRIPPROG-strip}"
-rmprog="${RMPROG-rm}"
-mkdirprog="${MKDIRPROG-mkdir}"
-
-transformbasename=""
-transform_arg=""
-instcmd="$mvprog"
-chmodcmd="$chmodprog 0755"
-chowncmd=""
-chgrpcmd=""
-stripcmd=""
-rmcmd="$rmprog -f"
-mvcmd="$mvprog"
-src=""
-dst=""
-dir_arg=""
-
-while [ x"$1" != x ]; do
-    case $1 in
-	-c) instcmd="$cpprog"
-	    shift
-	    continue;;
-
-	-d) dir_arg=true
-	    shift
-	    continue;;
-
-	-m) chmodcmd="$chmodprog $2"
-	    shift
-	    shift
-	    continue;;
-
-	-o) chowncmd="$chownprog $2"
-	    shift
-	    shift
-	    continue;;
-
-	-g) chgrpcmd="$chgrpprog $2"
-	    shift
-	    shift
-	    continue;;
-
-	-s) stripcmd="$stripprog"
-	    shift
-	    continue;;
-
-	-t=*) transformarg=`echo $1 | sed 's/-t=//'`
-	    shift
-	    continue;;
-
-	-b=*) transformbasename=`echo $1 | sed 's/-b=//'`
-	    shift
-	    continue;;
-
-	*)  if [ x"$src" = x ]
-	    then
-		src=$1
-	    else
-		# this colon is to work around a 386BSD /bin/sh bug
-		:
-		dst=$1
-	    fi
-	    shift
-	    continue;;
-    esac
-done
-
-if [ x"$src" = x ]
-then
-	echo "install:	no input file specified"
-	exit 1
-else
-	true
-fi
-
-if [ x"$dir_arg" != x ]; then
-	dst=$src
-	src=""
-	
-	if [ -d $dst ]; then
-		instcmd=:
-		chmodcmd=""
-	else
-		instcmd=mkdir
-	fi
-else
-
-# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
-# might cause directories to be created, which would be especially bad 
-# if $src (and thus $dsttmp) contains '*'.
-
-	if [ -f $src -o -d $src ]
-	then
-		true
-	else
-		echo "install:  $src does not exist"
-		exit 1
-	fi
-	
-	if [ x"$dst" = x ]
-	then
-		echo "install:	no destination specified"
-		exit 1
-	else
-		true
-	fi
-
-# If destination is a directory, append the input filename; if your system
-# does not like double slashes in filenames, you may need to add some logic
-
-	if [ -d $dst ]
-	then
-		dst="$dst"/`basename $src`
-	else
-		true
-	fi
-fi
-
-## this sed command emulates the dirname command
-dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
-
-# Make sure that the destination directory exists.
-#  this part is taken from Noah Friedman's mkinstalldirs script
-
-# Skip lots of stat calls in the usual case.
-if [ ! -d "$dstdir" ]; then
-defaultIFS='	
-'
-IFS="${IFS-${defaultIFS}}"
-
-oIFS="${IFS}"
-# Some sh's can't handle IFS=/ for some reason.
-IFS='%'
-set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
-IFS="${oIFS}"
-
-pathcomp=''
-
-while [ $# -ne 0 ] ; do
-	pathcomp="${pathcomp}${1}"
-	shift
-
-	if [ ! -d "${pathcomp}" ] ;
-        then
-		$mkdirprog "${pathcomp}"
-	else
-		true
-	fi
-
-	pathcomp="${pathcomp}/"
-done
-fi
-
-if [ x"$dir_arg" != x ]
-then
-	$doit $instcmd $dst &&
-
-	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
-	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
-	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
-	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
-else
-
-# If we're going to rename the final executable, determine the name now.
-
-	if [ x"$transformarg" = x ] 
-	then
-		dstfile=`basename $dst`
-	else
-		dstfile=`basename $dst $transformbasename | 
-			sed $transformarg`$transformbasename
-	fi
-
-# don't allow the sed command to completely eliminate the filename
-
-	if [ x"$dstfile" = x ] 
-	then
-		dstfile=`basename $dst`
-	else
-		true
-	fi
-
-# Make a temp file name in the proper directory.
-
-	dsttmp=$dstdir/#inst.$$#
-
-# Move or copy the file name to the temp name
-
-	$doit $instcmd $src $dsttmp &&
-
-	trap "rm -f ${dsttmp}" 0 &&
-
-# and set any options; do chmod last to preserve setuid bits
-
-# If any of these fail, we abort the whole thing.  If we want to
-# ignore errors from any of these, just make sure not to ignore
-# errors from the above "$doit $instcmd $src $dsttmp" command.
-
-	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
-	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
-	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
-	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
-
-# Now rename the file to the real destination.
-
-	$doit $rmcmd -f $dstdir/$dstfile &&
-	$doit $mvcmd $dsttmp $dstdir/$dstfile 
-
-fi &&
-
-
-exit 0
diff --git a/ghc/rts/gmp/longlong.h b/ghc/rts/gmp/longlong.h
deleted file mode 100644
index 9a12755053..0000000000
--- a/ghc/rts/gmp/longlong.h
+++ /dev/null
@@ -1,1347 +0,0 @@
-/* longlong.h -- definitions for mixed size 32/64 bit arithmetic.
-
-Copyright (C) 1991, 1992, 1993, 1994, 1996, 1997, 1999, 2000 Free Software
-Foundation, Inc.
-
-This file is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-This file is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with this file; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/* You have to define the following before including this file:
-
-   UWtype -- An unsigned type, default type for operations (typically a "word")
-   UHWtype -- An unsigned type, at least half the size of UWtype.
-   UDWtype -- An unsigned type, at least twice as large a UWtype
-   W_TYPE_SIZE -- size in bits of UWtype
-
-   SItype, USItype -- Signed and unsigned 32 bit types.
-   DItype, UDItype -- Signed and unsigned 64 bit types.
-
-   On a 32 bit machine UWtype should typically be USItype;
-   on a 64 bit machine, UWtype should typically be UDItype.
-*/
-
-#define __BITS4 (W_TYPE_SIZE / 4)
-#define __ll_B ((UWtype) 1 << (W_TYPE_SIZE / 2))
-#define __ll_lowpart(t) ((UWtype) (t) & (__ll_B - 1))
-#define __ll_highpart(t) ((UWtype) (t) >> (W_TYPE_SIZE / 2))
-
-/* This is used to make sure no undesirable sharing between different libraries
-   that use this file takes place.  */
-#ifndef __MPN
-#define __MPN(x) __##x
-#endif
-
-#ifndef _PROTO
-#if (__STDC__-0) || defined (__cplusplus)
-#define _PROTO(x) x
-#else
-#define _PROTO(x) ()
-#endif
-#endif
-
-/* Define auxiliary asm macros.
-
-   1) umul_ppmm(high_prod, low_prod, multipler, multiplicand) multiplies two
-   UWtype integers MULTIPLER and MULTIPLICAND, and generates a two UWtype
-   word product in HIGH_PROD and LOW_PROD.
-
-   2) __umulsidi3(a,b) multiplies two UWtype integers A and B, and returns a
-   UDWtype product.  This is just a variant of umul_ppmm.
-
-   3) udiv_qrnnd(quotient, remainder, high_numerator, low_numerator,
-   denominator) divides a UDWtype, composed by the UWtype integers
-   HIGH_NUMERATOR and LOW_NUMERATOR, by DENOMINATOR and places the quotient
-   in QUOTIENT and the remainder in REMAINDER.  HIGH_NUMERATOR must be less
-   than DENOMINATOR for correct operation.  If, in addition, the most
-   significant bit of DENOMINATOR must be 1, then the pre-processor symbol
-   UDIV_NEEDS_NORMALIZATION is defined to 1.
-
-   4) sdiv_qrnnd(quotient, remainder, high_numerator, low_numerator,
-   denominator).  Like udiv_qrnnd but the numbers are signed.  The quotient
-   is rounded towards 0.
-
-   5) count_leading_zeros(count, x) counts the number of zero-bits from the
-   msb to the first non-zero bit in the UWtype X.  This is the number of
-   steps X needs to be shifted left to set the msb.  Undefined for X == 0,
-   unless the symbol COUNT_LEADING_ZEROS_0 is defined to some value.
-
-   6) count_trailing_zeros(count, x) like count_leading_zeros, but counts
-   from the least significant end.
-
-   7) add_ssaaaa(high_sum, low_sum, high_addend_1, low_addend_1,
-   high_addend_2, low_addend_2) adds two UWtype integers, composed by
-   HIGH_ADDEND_1 and LOW_ADDEND_1, and HIGH_ADDEND_2 and LOW_ADDEND_2
-   respectively.  The result is placed in HIGH_SUM and LOW_SUM.  Overflow
-   (i.e. carry out) is not stored anywhere, and is lost.
-
-   8) sub_ddmmss(high_difference, low_difference, high_minuend, low_minuend,
-   high_subtrahend, low_subtrahend) subtracts two two-word UWtype integers,
-   composed by HIGH_MINUEND_1 and LOW_MINUEND_1, and HIGH_SUBTRAHEND_2 and
-   LOW_SUBTRAHEND_2 respectively.  The result is placed in HIGH_DIFFERENCE
-   and LOW_DIFFERENCE.  Overflow (i.e. carry out) is not stored anywhere,
-   and is lost.
-
-   If any of these macros are left undefined for a particular CPU,
-   C macros are used.  */
-
-/* The CPUs come in alphabetical order below.
-
-   Please add support for more CPUs here, or improve the current support
-   for the CPUs below!  */
-
-#if defined (__alpha) && W_TYPE_SIZE == 64
-#if defined (__GNUC__)
-#define umul_ppmm(ph, pl, m0, m1) \
-  do {									\
-    UDItype __m0 = (m0), __m1 = (m1);					\
-    __asm__ ("umulh %r1,%2,%0"						\
-	     : "=r" (ph)						\
-	     : "%rJ" (m0), "rI" (m1));					\
-    (pl) = __m0 * __m1;							\
-  } while (0)
-#define UMUL_TIME 18
-#ifndef LONGLONG_STANDALONE
-#define udiv_qrnnd(q, r, n1, n0, d) \
-  do { UDItype __di;							\
-    __di = __MPN(invert_limb) (d);					\
-    udiv_qrnnd_preinv (q, r, n1, n0, d, __di);				\
-  } while (0)
-#define UDIV_NEEDS_NORMALIZATION 1
-#define UDIV_TIME 220
-long __MPN(count_leading_zeros) ();
-#define count_leading_zeros(count, x) \
-  ((count) = __MPN(count_leading_zeros) (x))
-#endif /* LONGLONG_STANDALONE */
-#else /* ! __GNUC__ */
-#include <machine/builtins.h>
-#define umul_ppmm(ph, pl, m0, m1) \
-  do {									\
-    UDItype __m0 = (m0), __m1 = (m1);					\
-    (ph) = __UMULH (m0, m1);						\
-    (pl) = __m0 * __m1;							\
-  } while (0)
-#endif
-#endif /* __alpha */
-
-#if defined (__hppa) && W_TYPE_SIZE == 64
-/* We put the result pointer parameter last here, since it makes passing
-   of the other parameters more efficient.  */
-#ifndef LONGLONG_STANDALONE
-#define umul_ppmm(wh, wl, u, v) \
-  do {									\
-    UDItype __p0;							\
-    (wh) = __MPN(umul_ppmm) (u, v, &__p0);				\
-    (wl) = __p0;							\
-  } while (0)
-extern UDItype __MPN(umul_ppmm) _PROTO ((UDItype, UDItype, UDItype *));
-#define udiv_qrnnd(q, r, n1, n0, d) \
-  do { UDItype __r;							\
-    (q) = __MPN(udiv_qrnnd) (n1, n0, d, &__r);				\
-    (r) = __r;								\
-  } while (0)
-extern UDItype __MPN(udiv_qrnnd) _PROTO ((UDItype, UDItype, UDItype, UDItype *));
-#define UMUL_TIME 8
-#define UDIV_TIME 60
-#endif /* LONGLONG_STANDALONE */
-#endif /* hppa */
-
-#if defined (__ia64) && W_TYPE_SIZE == 64
-#if defined (__GNUC__)
-#define umul_ppmm(ph, pl, m0, m1) \
-  do {									\
-    UDItype __m0 = (m0), __m1 = (m1);					\
-    __asm__ ("xma.hu %0 = %1, %2, f0"					\
-	     : "=e" (ph)						\
-	     : "e" (m0), "e" (m1));					\
-    (pl) = __m0 * __m1;							\
-  } while (0)
-#endif
-#endif
-
-
-#if defined (__GNUC__) && !defined (NO_ASM)
-
-/* We sometimes need to clobber "cc" with gcc2, but that would not be
-   understood by gcc1.  Use cpp to avoid major code duplication.  */
-#if __GNUC__ < 2
-#define __CLOBBER_CC
-#define __AND_CLOBBER_CC
-#else /* __GNUC__ >= 2 */
-#define __CLOBBER_CC : "cc"
-#define __AND_CLOBBER_CC , "cc"
-#endif /* __GNUC__ < 2 */
-
-#if (defined (__a29k__) || defined (_AM29K)) && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("add %1,%4,%5\n\taddc %0,%2,%3"				\
-	   : "=r" (sh), "=&r" (sl)					\
-	   : "%r" (ah), "rI" (bh), "%r" (al), "rI" (bl))
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("sub %1,%4,%5\n\tsubc %0,%2,%3"				\
-	   : "=r" (sh),	"=&r" (sl)					\
-	   : "r" (ah), "rI" (bh), "r" (al), "rI" (bl))
-#define umul_ppmm(xh, xl, m0, m1) \
-  do {									\
-    USItype __m0 = (m0), __m1 = (m1);					\
-    __asm__ ("multiplu %0,%1,%2"					\
-	     : "=r" (xl)						\
-	     : "r" (__m0), "r" (__m1));					\
-    __asm__ ("multmu %0,%1,%2"						\
-	     : "=r" (xh)						\
-	     : "r" (__m0), "r" (__m1));					\
-  } while (0)
-#define udiv_qrnnd(q, r, n1, n0, d) \
-  __asm__ ("dividu %0,%3,%4"						\
-	   : "=r" (q), "=q" (r)						\
-	   : "1" (n1), "r" (n0), "r" (d))
-#define count_leading_zeros(count, x) \
-    __asm__ ("clz %0,%1"						\
-	     : "=r" (count)						\
-	     : "r" (x))
-#define COUNT_LEADING_ZEROS_0 32
-#endif /* __a29k__ */
-
-#if defined (__arm__) && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("adds\t%1, %4, %5\n\tadc\t%0, %2, %3"			\
-	   : "=r" (sh), "=&r" (sl)					\
-	   : "%r" (ah), "rI" (bh), "%r" (al), "rI" (bl))
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("subs\t%1, %4, %5\n\tsbc\t%0, %2, %3"			\
-	   : "=r" (sh),	"=&r" (sl)					\
-	   : "r" (ah), "rI" (bh), "r" (al), "rI" (bl))
-#if 1 || defined (__arm_m__)		/* `M' series has widening multiply support */
-#define umul_ppmm(xh, xl, a, b) \
-  __asm__ ("umull %0,%1,%2,%3" : "=&r" (xl), "=&r" (xh) : "r" (a), "r" (b))
-#define smul_ppmm(xh, xl, a, b) \
-  __asm__ ("smull %0,%1,%2,%3" : "=&r" (xl), "=&r" (xh) : "r" (a), "r" (b))
-#define UMUL_TIME 5
-#else
-#define umul_ppmm(xh, xl, a, b) \
-  __asm__ ("%@ Inlined umul_ppmm\n"		\
-	"mov	%|r0, %2, lsr #16\n"		\
-	"mov	%|r2, %3, lsr #16\n"		\
-	"bic	%|r1, %2, %|r0, lsl #16\n"	\
-	"bic	%|r2, %3, %|r2, lsl #16\n"	\
-	"mul	%1, %|r1, %|r2\n"		\
-	"mul	%|r2, %|r0, %|r2\n"		\
-	"mul	%|r1, %0, %|r1\n"		\
-	"mul	%0, %|r0, %0\n"			\
-	"adds	%|r1, %|r2, %|r1\n"		\
-	"addcs	%0, %0, #65536\n"		\
-	"adds	%1, %1, %|r1, lsl #16\n"	\
-	"adc	%0, %0, %|r1, lsr #16"					\
-	   : "=&r" (xh), "=r" (xl)					\
-	   : "r" (a), "r" (b)						\
-	   : "r0", "r1", "r2")
-#define UMUL_TIME 20
-#endif
-#define UDIV_TIME 100
-#endif /* __arm__ */
-
-#if defined (__clipper__) && W_TYPE_SIZE == 32
-#define umul_ppmm(w1, w0, u, v) \
-  ({union {UDItype __ll;						\
-	   struct {USItype __l, __h;} __i;				\
-	  } __x;							\
-  __asm__ ("mulwux %2,%0"						\
-	   : "=r" (__x.__ll)						\
-	   : "%0" ((USItype)(u)), "r" ((USItype)(v)));			\
-  (w1) = __x.__i.__h; (w0) = __x.__i.__l;})
-#define smul_ppmm(w1, w0, u, v) \
-  ({union {DItype __ll;							\
-	   struct {SItype __l, __h;} __i;				\
-	  } __x;							\
-  __asm__ ("mulwx %2,%0"						\
-	   : "=r" (__x.__ll)						\
-	   : "%0" ((SItype)(u)), "r" ((SItype)(v)));			\
-  (w1) = __x.__i.__h; (w0) = __x.__i.__l;})
-#define __umulsidi3(u, v) \
-  ({UDItype __w;							\
-    __asm__ ("mulwux %2,%0"						\
-	     : "=r" (__w) : "%0" ((USItype)(u)), "r" ((USItype)(v)));	\
-    __w; })
-#endif /* __clipper__ */
-
-/* Fujitsu vector computers.  */
-#if defined (__uxp__) && W_TYPE_SIZE == 32
-#define umul_ppmm(ph, pl, u, v) \
-  do {									\
-    union {UDItype __ll;						\
-	   struct {USItype __h, __l;} __i;				\
-	  } __x;							\
-    __asm__ ("mult.lu %1,%2,%0"	: "=r" (__x.__ll) : "%r" (u), "rK" (v));\
-    (ph) = __x.__i.__h;							\
-    (pl) = __x.__i.__l;							\
-  } while (0)
-#define smul_ppmm(ph, pl, u, v) \
-  do {									\
-    union {UDItype __ll;						\
-	   struct {USItype __h, __l;} __i;				\
-	  } __x;							\
-    __asm__ ("mult.l %1,%2,%0" : "=r" (__x.__ll) : "%r" (u), "rK" (v));	\
-    (ph) = __x.__i.__h;							\
-    (pl) = __x.__i.__l;							\
-  } while (0)
-#endif
-
-#if defined (__gmicro__) && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("add.w %5,%1\n\taddx %3,%0"					\
-	   : "=g" ((USItype)(sh)), "=&g" ((USItype)(sl))		\
-	   : "%0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
-	     "%1" ((USItype)(al)), "g" ((USItype)(bl)))
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("sub.w %5,%1\n\tsubx %3,%0"					\
-	   : "=g" ((USItype)(sh)), "=&g" ((USItype)(sl))		\
-	   : "0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
-	     "1" ((USItype)(al)), "g" ((USItype)(bl)))
-#define umul_ppmm(ph, pl, m0, m1) \
-  __asm__ ("mulx %3,%0,%1"						\
-	   : "=g" ((USItype)(ph)), "=r" ((USItype)(pl))			\
-	   : "%0" ((USItype)(m0)), "g" ((USItype)(m1)))
-#define udiv_qrnnd(q, r, nh, nl, d) \
-  __asm__ ("divx %4,%0,%1"						\
-	   : "=g" ((USItype)(q)), "=r" ((USItype)(r))			\
-	   : "1" ((USItype)(nh)), "0" ((USItype)(nl)), "g" ((USItype)(d)))
-#define count_leading_zeros(count, x) \
-  __asm__ ("bsch/1 %1,%0"						\
-	   : "=g" (count) : "g" ((USItype)(x)), "0" ((USItype)0))
-#endif
-
-#if defined (__hppa) && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("add %4,%5,%1\n\taddc %2,%3,%0"				\
-	   : "=r" (sh), "=&r" (sl)					\
-	   : "%rM" (ah), "rM" (bh), "%rM" (al), "rM" (bl))
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("sub %4,%5,%1\n\tsubb %2,%3,%0"				\
-	   : "=r" (sh), "=&r" (sl)					\
-	   : "rM" (ah), "rM" (bh), "rM" (al), "rM" (bl))
-#if defined (_PA_RISC1_1)
-#define umul_ppmm(wh, wl, u, v) \
-  do {									\
-    union {UDItype __ll;						\
-	   struct {USItype __h, __l;} __i;				\
-	  } __x;							\
-    __asm__ ("xmpyu %1,%2,%0" : "=*f" (__x.__ll) : "*f" (u), "*f" (v));	\
-    (wh) = __x.__i.__h;							\
-    (wl) = __x.__i.__l;							\
-  } while (0)
-#define UMUL_TIME 8
-#define UDIV_TIME 60
-#else
-#define UMUL_TIME 40
-#define UDIV_TIME 80
-#endif
-#ifndef LONGLONG_STANDALONE
-#define udiv_qrnnd(q, r, n1, n0, d) \
-  do { USItype __r;							\
-    (q) = __MPN(udiv_qrnnd) (&__r, (n1), (n0), (d));			\
-    (r) = __r;								\
-  } while (0)
-extern USItype __MPN(udiv_qrnnd) _PROTO ((USItype *, USItype, USItype, USItype));
-#endif /* LONGLONG_STANDALONE */
-#define count_leading_zeros(count, x) \
-  do {									\
-    USItype __tmp;							\
-    __asm__ (								\
-       "ldi		2,%0\n"							\
-	"extru,=		%1,15,16,%%r0		; Bits 31..16 zero?\n"	\
-	"extru,tr	%1,15,16,%1		; No.  Shift down, skip add.\n"	\
-	"ldo		16(%0),%0		; Yes.  Perform add.\n"		\
-	"extru,=		%1,23,8,%%r0		; Bits 15..8 zero?\n"	\
-	"extru,tr	%1,23,8,%1		; No.  Shift down, skip add.\n"	\
-	"ldo		8(%0),%0		; Yes.  Perform add.\n"		\
-	"extru,=		%1,27,4,%%r0		; Bits 7..4 zero?\n"	\
-	"extru,tr	%1,27,4,%1		; No.  Shift down, skip add.\n"	\
-	"ldo		4(%0),%0		; Yes.  Perform add.\n"		\
-	"extru,=		%1,29,2,%%r0		; Bits 3..2 zero?\n"	\
-	"extru,tr	%1,29,2,%1		; No.  Shift down, skip add.\n"	\
-	"ldo		2(%0),%0		; Yes.  Perform add.\n"		\
-	"extru		%1,30,1,%1		; Extract bit 1.\n"		\
-	"sub		%0,%1,%0		; Subtract it.\n"	\
-	: "=r" (count), "=r" (__tmp) : "1" (x));			\
-  } while (0)
-#endif /* hppa */
-
-#if (defined (__i370__) || defined (__mvs__)) && W_TYPE_SIZE == 32
-#define smul_ppmm(xh, xl, m0, m1) \
-  do {									\
-    union {DItype __ll;							\
-	   struct {USItype __h, __l;} __i;				\
-	  } __x;							\
-    __asm__ ("mr %0,%3"							\
-	     : "=r" (__x.__i.__h), "=r" (__x.__i.__l)			\
-	     : "%1" (m0), "r" (m1));					\
-    (xh) = __x.__i.__h; (xl) = __x.__i.__l;				\
-  } while (0)
-#define sdiv_qrnnd(q, r, n1, n0, d) \
-  do {									\
-    union {DItype __ll;							\
-	   struct {USItype __h, __l;} __i;				\
-	  } __x;							\
-    __x.__i.__h = n1; __x.__i.__l = n0;					\
-    __asm__ ("dr %0,%2"							\
-	     : "=r" (__x.__ll)						\
-	     : "0" (__x.__ll), "r" (d));				\
-    (q) = __x.__i.__l; (r) = __x.__i.__h;				\
-  } while (0)
-#endif
-
-#if (defined (__i386__) || defined (__i486__)) && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("addl %5,%1\n\tadcl %3,%0"					\
-	   : "=r" ((USItype)(sh)), "=&r" ((USItype)(sl))		\
-	   : "%0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
-	     "%1" ((USItype)(al)), "g" ((USItype)(bl)))
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("subl %5,%1\n\tsbbl %3,%0"					\
-	   : "=r" ((USItype)(sh)), "=&r" ((USItype)(sl))		\
-	   : "0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
-	     "1" ((USItype)(al)), "g" ((USItype)(bl)))
-#define umul_ppmm(w1, w0, u, v) \
-  __asm__ ("mull %3"							\
-	   : "=a" (w0), "=d" (w1)					\
-	   : "%0" ((USItype)(u)), "rm" ((USItype)(v)))
-#define udiv_qrnnd(q, r, n1, n0, d) \
-  __asm__ ("divl %4"							\
-	   : "=a" (q), "=d" (r)						\
-	   : "0" ((USItype)(n0)), "1" ((USItype)(n1)), "rm" ((USItype)(d)))
-#define count_leading_zeros(count, x) \
-  do {									\
-    USItype __cbtmp;							\
-    __asm__ ("bsrl %1,%0" : "=r" (__cbtmp) : "rm" ((USItype)(x)));	\
-    (count) = __cbtmp ^ 31;						\
-  } while (0)
-#define count_trailing_zeros(count, x) \
-  __asm__ ("bsfl %1,%0" : "=r" (count) : "rm" ((USItype)(x)))
-#ifndef UMUL_TIME
-#define UMUL_TIME 10
-#endif
-#ifndef UDIV_TIME
-#define UDIV_TIME 40
-#endif
-#endif /* 80x86 */
-
-#if defined (__i860__) && W_TYPE_SIZE == 32
-#define rshift_rhlc(r,h,l,c) \
-  __asm__ ("shr %3,r0,r0\;shrd %1,%2,%0"				\
-	   "=r" (r) : "r" (h), "r" (l), "rn" (c))
-#endif /* i860 */
-
-#if defined (__i960__) && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("cmpo 1,0\;addc %5,%4,%1\;addc %3,%2,%0"			\
-	   : "=r" (sh), "=&r" (sl)					\
-	   : "%dI" (ah), "dI" (bh), "%dI" (al), "dI" (bl))
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("cmpo 0,0\;subc %5,%4,%1\;subc %3,%2,%0"			\
-	   : "=r" (sh), "=&r" (sl)					\
-	   : "dI" (ah), "dI" (bh), "dI" (al), "dI" (bl))
-#define umul_ppmm(w1, w0, u, v) \
-  ({union {UDItype __ll;						\
-	   struct {USItype __l, __h;} __i;				\
-	  } __x;							\
-  __asm__ ("emul %2,%1,%0"						\
-	   : "=d" (__x.__ll) : "%dI" (u), "dI" (v));			\
-  (w1) = __x.__i.__h; (w0) = __x.__i.__l;})
-#define __umulsidi3(u, v) \
-  ({UDItype __w;							\
-    __asm__ ("emul %2,%1,%0" : "=d" (__w) : "%dI" (u), "dI" (v));	\
-    __w; })
-#define udiv_qrnnd(q, r, nh, nl, d) \
-  do {									\
-    union {UDItype __ll;						\
-	   struct {USItype __l, __h;} __i;				\
-	  } __nn;							\
-    __nn.__i.__h = (nh); __nn.__i.__l = (nl);				\
-    __asm__ ("ediv %d,%n,%0"						\
-	   : "=d" (__rq.__ll) : "dI" (__nn.__ll), "dI" (d));		\
-    (r) = __rq.__i.__l; (q) = __rq.__i.__h;				\
-  } while (0)
-#define count_leading_zeros(count, x) \
-  do {									\
-    USItype __cbtmp;							\
-    __asm__ ("scanbit %1,%0" : "=r" (__cbtmp) : "r" (x));		\
-    (count) = __cbtmp ^ 31;						\
-  } while (0)
-#define COUNT_LEADING_ZEROS_0 (-32) /* sic */
-#if defined (__i960mx)		/* what is the proper symbol to test??? */
-#define rshift_rhlc(r,h,l,c) \
-  do {									\
-    union {UDItype __ll;						\
-	   struct {USItype __l, __h;} __i;				\
-	  } __nn;							\
-    __nn.__i.__h = (h); __nn.__i.__l = (l);				\
-    __asm__ ("shre %2,%1,%0" : "=d" (r) : "dI" (__nn.__ll), "dI" (c));	\
-  }
-#endif /* i960mx */
-#endif /* i960 */
-
-#if (defined (__mc68000__) || defined (__mc68020__) || defined(mc68020) \
-     || defined (__m68k__) || defined (__mc5200__) || defined (__mc5206e__) \
-     || defined (__mc5307__)) && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("add%.l %5,%1\n\taddx%.l %3,%0"				\
-	   : "=d" ((USItype)(sh)), "=&d" ((USItype)(sl))		\
-	   : "%0" ((USItype)(ah)), "d" ((USItype)(bh)),			\
-	     "%1" ((USItype)(al)), "g" ((USItype)(bl)))
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("sub%.l %5,%1\n\tsubx%.l %3,%0"				\
-	   : "=d" ((USItype)(sh)), "=&d" ((USItype)(sl))		\
-	   : "0" ((USItype)(ah)), "d" ((USItype)(bh)),			\
-	     "1" ((USItype)(al)), "g" ((USItype)(bl)))
-/* The '020, '030, '040 and CPU32 have 32x32->64 and 64/32->32q-32r.  */
-#if defined (__mc68020__) || defined(mc68020) \
-     || defined (__mc68030__) || defined (mc68030) \
-     || defined (__mc68040__) || defined (mc68040) \
-     || defined (__mc68332__) || defined (mc68332) \
-     || defined (__NeXT__)
-#define umul_ppmm(w1, w0, u, v) \
-  __asm__ ("mulu%.l %3,%1:%0"						\
-	   : "=d" ((USItype)(w0)), "=d" ((USItype)(w1))			\
-	   : "%0" ((USItype)(u)), "dmi" ((USItype)(v)))
-#define UMUL_TIME 45
-#define udiv_qrnnd(q, r, n1, n0, d) \
-  __asm__ ("divu%.l %4,%1:%0"						\
-	   : "=d" ((USItype)(q)), "=d" ((USItype)(r))			\
-	   : "0" ((USItype)(n0)), "1" ((USItype)(n1)), "dmi" ((USItype)(d)))
-#define UDIV_TIME 90
-#define sdiv_qrnnd(q, r, n1, n0, d) \
-  __asm__ ("divs%.l %4,%1:%0"						\
-	   : "=d" ((USItype)(q)), "=d" ((USItype)(r))			\
-	   : "0" ((USItype)(n0)), "1" ((USItype)(n1)), "dmi" ((USItype)(d)))
-#else /* for other 68k family members use 16x16->32 multiplication */
-#define umul_ppmm(xh, xl, a, b) \
-  do { USItype __umul_tmp1, __umul_tmp2;				\
-	__asm__ ("| Inlined umul_ppmm\n"			\
-	"move%.l	%5,%3\n"				\
-	"move%.l	%2,%0\n"				\
-	"move%.w	%3,%1\n"				\
-	"swap	%3\n"						\
-	"swap	%0\n"						\
-	"mulu%.w	%2,%1\n"				\
-	"mulu%.w	%3,%0\n"				\
-	"mulu%.w	%2,%3\n"				\
-	"swap	%2\n"						\
-	"mulu%.w	%5,%2\n"				\
-	"add%.l	%3,%2\n"					\
-	"jcc	1f\n"						\
-	"add%.l	%#0x10000,%0\n"					\
-"1:	move%.l	%2,%3\n"					\
-	"clr%.w	%2\n"						\
-	"swap	%2\n"						\
-	"swap	%3\n"						\
-	"clr%.w	%3\n"						\
-	"add%.l	%3,%1\n"					\
-	"addx%.l	%2,%0\n"				\
-	"| End inlined umul_ppmm"				\
-	      : "=&d" ((USItype)(xh)), "=&d" ((USItype)(xl)),	\
-	        "=d" (__umul_tmp1), "=&d" (__umul_tmp2)		\
-	      : "%2" ((USItype)(a)), "d" ((USItype)(b)));	\
-  } while (0)
-#define UMUL_TIME 100
-#define UDIV_TIME 400
-#endif /* not mc68020 */
-/* The '020, '030, '040 and '060 have bitfield insns.  */
-#if defined (__mc68020__) || defined (mc68020) \
-     || defined (__mc68030__) || defined (mc68030) \
-     || defined (__mc68040__) || defined (mc68040) \
-     || defined (__mc68060__) || defined (mc68060) \
-     || defined (__NeXT__)
-#define count_leading_zeros(count, x) \
-  __asm__ ("bfffo %1{%b2:%b2},%0"					\
-	   : "=d" ((USItype) (count))					\
-	   : "od" ((USItype) (x)), "n" (0))
-#define COUNT_LEADING_ZEROS_0 32
-#endif
-#endif /* mc68000 */
-
-#if defined (__m88000__) && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("addu.co %1,%r4,%r5\n\taddu.ci %0,%r2,%r3"			\
-	   : "=r" (sh), "=&r" (sl)					\
-	   : "%rJ" (ah), "rJ" (bh), "%rJ" (al), "rJ" (bl))
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("subu.co %1,%r4,%r5\n\tsubu.ci %0,%r2,%r3"			\
-	   : "=r" (sh), "=&r" (sl)					\
-	   : "rJ" (ah), "rJ" (bh), "rJ" (al), "rJ" (bl))
-#define count_leading_zeros(count, x) \
-  do {									\
-    USItype __cbtmp;							\
-    __asm__ ("ff1 %0,%1" : "=r" (__cbtmp) : "r" (x));			\
-    (count) = __cbtmp ^ 31;						\
-  } while (0)
-#define COUNT_LEADING_ZEROS_0 63 /* sic */
-#if defined (__m88110__)
-#define umul_ppmm(wh, wl, u, v) \
-  do {									\
-    union {UDItype __ll;						\
-	   struct {USItype __h, __l;} __i;				\
-	  } __x;							\
-    __asm__ ("mulu.d %0,%1,%2" : "=r" (__x.__ll) : "r" (u), "r" (v));	\
-    (wh) = __x.__i.__h;							\
-    (wl) = __x.__i.__l;							\
-  } while (0)
-#define udiv_qrnnd(q, r, n1, n0, d) \
-  ({union {UDItype __ll;						\
-	   struct {USItype __h, __l;} __i;				\
-	  } __x, __q;							\
-  __x.__i.__h = (n1); __x.__i.__l = (n0);				\
-  __asm__ ("divu.d %0,%1,%2"						\
-	   : "=r" (__q.__ll) : "r" (__x.__ll), "r" (d));		\
-  (r) = (n0) - __q.__l * (d); (q) = __q.__l; })
-#define UMUL_TIME 5
-#define UDIV_TIME 25
-#else
-#define UMUL_TIME 17
-#define UDIV_TIME 150
-#endif /* __m88110__ */
-#endif /* __m88000__ */
-
-#if defined (__mips) && W_TYPE_SIZE == 32
-#if __GNUC__ > 2 || __GNUC_MINOR__ >= 7
-#define umul_ppmm(w1, w0, u, v) \
-  __asm__ ("multu %2,%3" : "=l" (w0), "=h" (w1) : "d" (u), "d" (v))
-#else
-#define umul_ppmm(w1, w0, u, v) \
-  __asm__ ("multu %2,%3\n\tmflo %0\n\tmfhi %1"				\
-	   : "=d" (w0), "=d" (w1) : "d" (u), "d" (v))
-#endif
-#define UMUL_TIME 10
-#define UDIV_TIME 100
-#endif /* __mips */
-
-#if (defined (__mips) && __mips >= 3) && W_TYPE_SIZE == 64
-#if __GNUC__ > 2 || __GNUC_MINOR__ >= 7
-#define umul_ppmm(w1, w0, u, v) \
-  __asm__ ("dmultu %2,%3" : "=l" (w0), "=h" (w1) : "d" (u), "d" (v))
-#else
-#define umul_ppmm(w1, w0, u, v) \
-  __asm__ ("dmultu %2,%3\n\tmflo %0\n\tmfhi %1"				\
-	   : "=d" (w0), "=d" (w1) : "d" (u), "d" (v))
-#endif
-#define UMUL_TIME 20
-#define UDIV_TIME 140
-#endif /* __mips */
-
-#if defined (__ns32000__) && W_TYPE_SIZE == 32
-#define umul_ppmm(w1, w0, u, v) \
-  ({union {UDItype __ll;						\
-	   struct {USItype __l, __h;} __i;				\
-	  } __x;							\
-  __asm__ ("meid %2,%0"							\
-	   : "=g" (__x.__ll)						\
-	   : "%0" ((USItype)(u)), "g" ((USItype)(v)));			\
-  (w1) = __x.__i.__h; (w0) = __x.__i.__l;})
-#define __umulsidi3(u, v) \
-  ({UDItype __w;							\
-    __asm__ ("meid %2,%0"						\
-	     : "=g" (__w)						\
-	     : "%0" ((USItype)(u)), "g" ((USItype)(v)));		\
-    __w; })
-#define udiv_qrnnd(q, r, n1, n0, d) \
-  ({union {UDItype __ll;						\
-	   struct {USItype __l, __h;} __i;				\
-	  } __x;							\
-  __x.__i.__h = (n1); __x.__i.__l = (n0);				\
-  __asm__ ("deid %2,%0"							\
-	   : "=g" (__x.__ll)						\
-	   : "0" (__x.__ll), "g" ((USItype)(d)));			\
-  (r) = __x.__i.__l; (q) = __x.__i.__h; })
-#define count_trailing_zeros(count,x) \
-  do {									\
-    __asm__ ("ffsd	%2,%0"						\
-	     : "=r" ((USItype) (count))					\
-	     : "0" ((USItype) 0), "r" ((USItype) (x)));			\
-  } while (0)
-#endif /* __ns32000__ */
-
-/* We should test _IBMR2 here when we add assembly support for the system
-   vendor compilers.  */
-#if (defined (_ARCH_PPC) || defined (_ARCH_PWR) || defined (__powerpc__)) && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  do {									\
-    if (__builtin_constant_p (bh) && (bh) == 0)				\
-      __asm__ ("{a%I4|add%I4c} %1,%3,%4\n\t{aze|addze} %0,%2"		\
-	     : "=r" (sh), "=&r" (sl) : "%r" (ah), "%r" (al), "rI" (bl));\
-    else if (__builtin_constant_p (bh) && (bh) == ~(USItype) 0)		\
-      __asm__ ("{a%I4|add%I4c} %1,%3,%4\n\t{ame|addme} %0,%2"		\
-	     : "=r" (sh), "=&r" (sl) : "%r" (ah), "%r" (al), "rI" (bl));\
-    else								\
-      __asm__ ("{a%I5|add%I5c} %1,%4,%5\n\t{ae|adde} %0,%2,%3"		\
-	     : "=r" (sh), "=&r" (sl)					\
-	     : "%r" (ah), "r" (bh), "%r" (al), "rI" (bl));		\
-  } while (0)
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  do {									\
-    if (__builtin_constant_p (ah) && (ah) == 0)				\
-      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{sfze|subfze} %0,%2"	\
-	       : "=r" (sh), "=&r" (sl) : "r" (bh), "rI" (al), "r" (bl));\
-    else if (__builtin_constant_p (ah) && (ah) == ~(USItype) 0)		\
-      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{sfme|subfme} %0,%2"	\
-	       : "=r" (sh), "=&r" (sl) : "r" (bh), "rI" (al), "r" (bl));\
-    else if (__builtin_constant_p (bh) && (bh) == 0)			\
-      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{ame|addme} %0,%2"		\
-	       : "=r" (sh), "=&r" (sl) : "r" (ah), "rI" (al), "r" (bl));\
-    else if (__builtin_constant_p (bh) && (bh) == ~(USItype) 0)		\
-      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{aze|addze} %0,%2"		\
-	       : "=r" (sh), "=&r" (sl) : "r" (ah), "rI" (al), "r" (bl));\
-    else								\
-      __asm__ ("{sf%I4|subf%I4c} %1,%5,%4\n\t{sfe|subfe} %0,%3,%2"	\
-	       : "=r" (sh), "=&r" (sl)					\
-	       : "r" (ah), "r" (bh), "rI" (al), "r" (bl));		\
-  } while (0)
-#define count_leading_zeros(count, x) \
-  __asm__ ("{cntlz|cntlzw} %0,%1" : "=r" (count) : "r" (x))
-#define COUNT_LEADING_ZEROS_0 32
-#if defined (_ARCH_PPC) || defined (__powerpc__)
-#define umul_ppmm(ph, pl, m0, m1) \
-  do {									\
-    USItype __m0 = (m0), __m1 = (m1);					\
-    __asm__ ("mulhwu %0,%1,%2" : "=r" (ph) : "%r" (m0), "r" (m1));	\
-    (pl) = __m0 * __m1;							\
-  } while (0)
-#define UMUL_TIME 15
-#define smul_ppmm(ph, pl, m0, m1) \
-  do {									\
-    SItype __m0 = (m0), __m1 = (m1);					\
-    __asm__ ("mulhw %0,%1,%2" : "=r" (ph) : "%r" (m0), "r" (m1));	\
-    (pl) = __m0 * __m1;							\
-  } while (0)
-#define SMUL_TIME 14
-#define UDIV_TIME 120
-#else
-#define UMUL_TIME 8
-#define smul_ppmm(xh, xl, m0, m1) \
-  __asm__ ("mul %0,%2,%3" : "=r" (xh), "=q" (xl) : "r" (m0), "r" (m1))
-#define SMUL_TIME 4
-#define sdiv_qrnnd(q, r, nh, nl, d) \
-  __asm__ ("div %0,%2,%4" : "=r" (q), "=q" (r) : "r" (nh), "1" (nl), "r" (d))
-#define UDIV_TIME 100
-#endif
-#endif /* 32-bit POWER architecture variants.  */
-
-/* We should test _IBMR2 here when we add assembly support for the system
-   vendor compilers.  */
-#if (defined (_ARCH_PPC) || defined (__powerpc__)) && W_TYPE_SIZE == 64
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  do {									\
-    if (__builtin_constant_p (bh) && (bh) == 0)				\
-      __asm__ ("{a%I4|add%I4c} %1,%3,%4\n\t{aze|addze} %0,%2"		\
-	     : "=r" (sh), "=&r" (sl) : "%r" (ah), "%r" (al), "rI" (bl));\
-    else if (__builtin_constant_p (bh) && (bh) == ~(UDItype) 0)		\
-      __asm__ ("{a%I4|add%I4c} %1,%3,%4\n\t{ame|addme} %0,%2"		\
-	     : "=r" (sh), "=&r" (sl) : "%r" (ah), "%r" (al), "rI" (bl));\
-    else								\
-      __asm__ ("{a%I5|add%I5c} %1,%4,%5\n\t{ae|adde} %0,%2,%3"		\
-	     : "=r" (sh), "=&r" (sl)					\
-	     : "%r" (ah), "r" (bh), "%r" (al), "rI" (bl));		\
-  } while (0)
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  do {									\
-    if (__builtin_constant_p (ah) && (ah) == 0)				\
-      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{sfze|subfze} %0,%2"	\
-	       : "=r" (sh), "=&r" (sl) : "r" (bh), "rI" (al), "r" (bl));\
-    else if (__builtin_constant_p (ah) && (ah) == ~(UDItype) 0)		\
-      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{sfme|subfme} %0,%2"	\
-	       : "=r" (sh), "=&r" (sl) : "r" (bh), "rI" (al), "r" (bl));\
-    else if (__builtin_constant_p (bh) && (bh) == 0)			\
-      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{ame|addme} %0,%2"		\
-	       : "=r" (sh), "=&r" (sl) : "r" (ah), "rI" (al), "r" (bl));\
-    else if (__builtin_constant_p (bh) && (bh) == ~(UDItype) 0)		\
-      __asm__ ("{sf%I3|subf%I3c} %1,%4,%3\n\t{aze|addze} %0,%2"		\
-	       : "=r" (sh), "=&r" (sl) : "r" (ah), "rI" (al), "r" (bl));\
-    else								\
-      __asm__ ("{sf%I4|subf%I4c} %1,%5,%4\n\t{sfe|subfe} %0,%3,%2"	\
-	       : "=r" (sh), "=&r" (sl)					\
-	       : "r" (ah), "r" (bh), "rI" (al), "r" (bl));		\
-  } while (0)
-#define count_leading_zeros(count, x) \
-  __asm__ ("cntlzd %0,%1" : "=r" (count) : "r" (x))
-#define COUNT_LEADING_ZEROS_0 64
-#define umul_ppmm(ph, pl, m0, m1) \
-  do {									\
-    UDItype __m0 = (m0), __m1 = (m1);					\
-    __asm__ ("mulhdu %0,%1,%2" : "=r" (ph) : "%r" (m0), "r" (m1));	\
-    (pl) = __m0 * __m1;							\
-  } while (0)
-#define UMUL_TIME 15
-#define smul_ppmm(ph, pl, m0, m1) \
-  do {									\
-    DItype __m0 = (m0), __m1 = (m1);					\
-    __asm__ ("mulhd %0,%1,%2" : "=r" (ph) : "%r" (m0), "r" (m1));	\
-    (pl) = __m0 * __m1;							\
-  } while (0)
-#define SMUL_TIME 14  /* ??? */
-#define UDIV_TIME 120 /* ??? */
-#endif /* 64-bit PowerPC.  */
-
-#if defined (__pyr__) && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("addw %5,%1\n\taddwc %3,%0"					\
-	   : "=r" ((USItype)(sh)), "=&r" ((USItype)(sl))		\
-	   : "%0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
-	     "%1" ((USItype)(al)), "g" ((USItype)(bl)))
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("subw %5,%1\n\tsubwb %3,%0"					\
-	   : "=r" ((USItype)(sh)), "=&r" ((USItype)(sl))		\
-	   : "0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
-	     "1" ((USItype)(al)), "g" ((USItype)(bl)))
-/* This insn works on Pyramids with AP, XP, or MI CPUs, but not with SP.  */
-#define umul_ppmm(w1, w0, u, v) \
-  ({union {UDItype __ll;						\
-	   struct {USItype __h, __l;} __i;				\
-	  } __x;							\
-  __asm__ ("movw %1,%R0\n\tuemul %2,%0"					\
-	   : "=&r" (__x.__ll)						\
-	   : "g" ((USItype) (u)), "g" ((USItype)(v)));			\
-  (w1) = __x.__i.__h; (w0) = __x.__i.__l;})
-#endif /* __pyr__ */
-
-#if defined (__ibm032__) /* RT/ROMP */  && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("a %1,%5\n\tae %0,%3"					\
-	   : "=r" ((USItype)(sh)), "=&r" ((USItype)(sl))		\
-	   : "%0" ((USItype)(ah)), "r" ((USItype)(bh)),			\
-	     "%1" ((USItype)(al)), "r" ((USItype)(bl)))
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("s %1,%5\n\tse %0,%3"					\
-	   : "=r" ((USItype)(sh)), "=&r" ((USItype)(sl))		\
-	   : "0" ((USItype)(ah)), "r" ((USItype)(bh)),			\
-	     "1" ((USItype)(al)), "r" ((USItype)(bl)))
-#define smul_ppmm(ph, pl, m0, m1) \
-  __asm__ (								\
-       "s	r2,r2\n"				\
-	"mts r10,%2\n"					\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"m	r2,%3\n"				\
-	"cas	%0,r2,r0\n"				\
-	"mfs	r10,%1"					\
-	   : "=r" ((USItype)(ph)), "=r" ((USItype)(pl))	\
-	   : "%r" ((USItype)(m0)), "r" ((USItype)(m1))	\
-	   : "r2");					\
-#define UMUL_TIME 20
-#define UDIV_TIME 200
-#define count_leading_zeros(count, x) \
-  do {									\
-    if ((x) >= 0x10000)							\
-      __asm__ ("clz	%0,%1"						\
-	       : "=r" ((USItype)(count)) : "r" ((USItype)(x) >> 16));	\
-    else								\
-      {									\
-	__asm__ ("clz	%0,%1"						\
-		 : "=r" ((USItype)(count)) : "r" ((USItype)(x)));	\
-	(count) += 16;							\
-      }									\
-  } while (0)
-#endif /* RT/ROMP */
-
-#if defined (__sh2__) && W_TYPE_SIZE == 32
-#define umul_ppmm(w1, w0, u, v) \
-  __asm__ ("dmulu.l %2,%3\n\tsts macl,%1\n\tsts mach,%0"		\
-	   : "=r" (w1), "=r" (w0) : "r" (u), "r" (v) : "macl", "mach")
-#define UMUL_TIME 5
-#endif
-
-#if defined (__sparc__) && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("addcc %r4,%5,%1\n\taddx %r2,%3,%0"				\
-	   : "=r" (sh), "=&r" (sl)					\
-	   : "%rJ" (ah), "rI" (bh),"%rJ" (al), "rI" (bl)		\
-	   __CLOBBER_CC)
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("subcc %r4,%5,%1\n\tsubx %r2,%3,%0"				\
-	   : "=r" (sh), "=&r" (sl)					\
-	   : "rJ" (ah), "rI" (bh), "rJ" (al), "rI" (bl)	\
-	   __CLOBBER_CC)
-#if defined (__sparc_v9__) || defined (__sparcv9)
-/* Perhaps we should use floating-point operations here?  */
-#if 0
-/* Triggers a bug making mpz/tests/t-gcd.c fail.
-   Perhaps we simply need explicitly zero-extend the inputs?  */
-#define umul_ppmm(w1, w0, u, v) \
-  __asm__ ("mulx %2,%3,%%g1; srl %%g1,0,%1; srlx %%g1,32,%0" :		\
-	   "=r" (w1), "=r" (w0) : "r" (u), "r" (v) : "g1")
-#else
-/* Use v8 umul until above bug is fixed.  */
-#define umul_ppmm(w1, w0, u, v) \
-  __asm__ ("umul %2,%3,%1;rd %%y,%0" : "=r" (w1), "=r" (w0) : "r" (u), "r" (v))
-#endif
-/* Use a plain v8 divide for v9.  */
-#define udiv_qrnnd(q, r, n1, n0, d) \
-  do {									\
-    USItype __q;							\
-    __asm__ ("mov %1,%%y;nop;nop;nop;udiv %2,%3,%0"			\
-	     : "=r" (__q) : "r" (n1), "r" (n0), "r" (d));		\
-    (r) = (n0) - __q * (d);						\
-    (q) = __q;								\
-  } while (0)
-#else
-#if defined (__sparc_v8__)
-/* Don't match immediate range because, 1) it is not often useful,
-   2) the 'I' flag thinks of the range as a 13 bit signed interval,
-   while we want to match a 13 bit interval, sign extended to 32 bits,
-   but INTERPRETED AS UNSIGNED.  */
-#define umul_ppmm(w1, w0, u, v) \
-  __asm__ ("umul %2,%3,%1;rd %%y,%0" : "=r" (w1), "=r" (w0) : "r" (u), "r" (v))
-#define UMUL_TIME 5
-#ifndef SUPERSPARC	/* SuperSPARC's udiv only handles 53 bit dividends */
-#define udiv_qrnnd(q, r, n1, n0, d) \
-  do {									\
-    USItype __q;							\
-    __asm__ ("mov %1,%%y;nop;nop;nop;udiv %2,%3,%0"			\
-	     : "=r" (__q) : "r" (n1), "r" (n0), "r" (d));		\
-    (r) = (n0) - __q * (d);						\
-    (q) = __q;								\
-  } while (0)
-#define UDIV_TIME 25
-#else
-#define UDIV_TIME 60		/* SuperSPARC timing */
-#endif /* SUPERSPARC */
-#else /* ! __sparc_v8__ */
-#if defined (__sparclite__)
-/* This has hardware multiply but not divide.  It also has two additional
-   instructions scan (ffs from high bit) and divscc.  */
-#define umul_ppmm(w1, w0, u, v) \
-  __asm__ ("umul %2,%3,%1;rd %%y,%0" : "=r" (w1), "=r" (w0) : "r" (u), "r" (v))
-#define UMUL_TIME 5
-#define udiv_qrnnd(q, r, n1, n0, d) \
-  __asm__ ("! Inlined udiv_qrnnd\n"					\
-	"wr	%%g0,%2,%%y	! Not a delayed write for sparclite\n"	\
-	"tst	%%g0\n"							\
-	"divscc	%3,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%%g1\n"						\
-	"divscc	%%g1,%4,%0\n"						\
-	"rd	%%y,%1\n"						\
-	"bl,a 1f\n"							\
-	"add	%1,%4,%1\n"						\
-"1:	! End of inline udiv_qrnnd"					\
-	   : "=r" (q), "=r" (r) : "r" (n1), "r" (n0), "rI" (d)		\
-	   : "%g1" __AND_CLOBBER_CC)
-#define UDIV_TIME 37
-#define count_leading_zeros(count, x) \
-  __asm__ ("scan %1,0,%0" : "=r" (x) : "r" (count))
-/* Early sparclites return 63 for an argument of 0, but they warn that future
-   implementations might change this.  Therefore, leave COUNT_LEADING_ZEROS_0
-   undefined.  */
-#endif /* __sparclite__ */
-#endif /* __sparc_v8__ */
-#endif /* __sparc_v9__ */
-/* Default to sparc v7 versions of umul_ppmm and udiv_qrnnd.  */
-#ifndef umul_ppmm
-#define umul_ppmm(w1, w0, u, v) \
-  __asm__ ("! Inlined umul_ppmm\n"						\
-	"wr	%%g0,%2,%%y	! SPARC has 0-3 delay insn after a wr\n"	\
-	"sra	%3,31,%%g2	! Don't move this insn\n"			\
-	"and	%2,%%g2,%%g2	! Don't move this insn\n"			\
-	"andcc	%%g0,0,%%g1	! Don't move this insn\n"			\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,%3,%%g1\n"							\
-	"mulscc	%%g1,0,%%g1\n"							\
-	"add	%%g1,%%g2,%0\n"							\
-	"rd	%%y,%1"								\
-	   : "=r" (w1), "=r" (w0) : "%rI" (u), "r" (v)				\
-	   : "%g1", "%g2" __AND_CLOBBER_CC)
-#define UMUL_TIME 39		/* 39 instructions */
-#endif
-#ifndef udiv_qrnnd
-#ifndef LONGLONG_STANDALONE
-#define udiv_qrnnd(q, r, n1, n0, d) \
-  do { USItype __r;							\
-    (q) = __MPN(udiv_qrnnd) (&__r, (n1), (n0), (d));			\
-    (r) = __r;								\
-  } while (0)
-extern USItype __MPN(udiv_qrnnd) _PROTO ((USItype *, USItype, USItype, USItype));
-#ifndef UDIV_TIME
-#define UDIV_TIME 140
-#endif
-#endif /* LONGLONG_STANDALONE */
-#endif /* udiv_qrnnd */
-#endif /* __sparc__ */
-
-#if defined (__vax__) && W_TYPE_SIZE == 32
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("addl2 %5,%1\n\tadwc %3,%0"					\
-	   : "=g" ((USItype)(sh)), "=&g" ((USItype)(sl))		\
-	   : "%0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
-	     "%1" ((USItype)(al)), "g" ((USItype)(bl)))
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("subl2 %5,%1\n\tsbwc %3,%0"					\
-	   : "=g" ((USItype)(sh)), "=&g" ((USItype)(sl))		\
-	   : "0" ((USItype)(ah)), "g" ((USItype)(bh)),			\
-	     "1" ((USItype)(al)), "g" ((USItype)(bl)))
-#define smul_ppmm(xh, xl, m0, m1) \
-  do {									\
-    union {UDItype __ll;						\
-	   struct {USItype __l, __h;} __i;				\
-	  } __x;							\
-    USItype __m0 = (m0), __m1 = (m1);					\
-    __asm__ ("emul %1,%2,$0,%0"						\
-	     : "=g" (__x.__ll) : "g" (__m0), "g" (__m1));		\
-    (xh) = __x.__i.__h; (xl) = __x.__i.__l;				\
-  } while (0)
-#define sdiv_qrnnd(q, r, n1, n0, d) \
-  do {									\
-    union {DItype __ll;							\
-	   struct {SItype __l, __h;} __i;				\
-	  } __x;							\
-    __x.__i.__h = n1; __x.__i.__l = n0;					\
-    __asm__ ("ediv %3,%2,%0,%1"						\
-	     : "=g" (q), "=g" (r) : "g" (__x.__ll), "g" (d));		\
-  } while (0)
-#endif /* __vax__ */
-
-#if defined (__z8000__) && W_TYPE_SIZE == 16
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  __asm__ ("add	%H1,%H5\n\tadc	%H0,%H3"				\
-	   : "=r" ((unsigned int)(sh)), "=&r" ((unsigned int)(sl))	\
-	   : "%0" ((unsigned int)(ah)), "r" ((unsigned int)(bh)),	\
-	     "%1" ((unsigned int)(al)), "rQR" ((unsigned int)(bl)))
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  __asm__ ("sub	%H1,%H5\n\tsbc	%H0,%H3"				\
-	   : "=r" ((unsigned int)(sh)), "=&r" ((unsigned int)(sl))	\
-	   : "0" ((unsigned int)(ah)), "r" ((unsigned int)(bh)),	\
-	     "1" ((unsigned int)(al)), "rQR" ((unsigned int)(bl)))
-#define umul_ppmm(xh, xl, m0, m1) \
-  do {									\
-    union {long int __ll;						\
-	   struct {unsigned int __h, __l;} __i;				\
-	  } __x;							\
-    unsigned int __m0 = (m0), __m1 = (m1);				\
-    __asm__ ("mult	%S0,%H3"					\
-	     : "=r" (__x.__i.__h), "=r" (__x.__i.__l)			\
-	     : "%1" (m0), "rQR" (m1));					\
-    (xh) = __x.__i.__h; (xl) = __x.__i.__l;				\
-    (xh) += ((((signed int) __m0 >> 15) & __m1)				\
-	     + (((signed int) __m1 >> 15) & __m0));			\
-  } while (0)
-#endif /* __z8000__ */
-
-#endif /* __GNUC__ */
-
-
-#if !defined (umul_ppmm) && defined (__umulsidi3)
-#define umul_ppmm(ph, pl, m0, m1) \
-  {									\
-    UDWtype __ll = __umulsidi3 (m0, m1);				\
-    ph = (UWtype) (__ll >> W_TYPE_SIZE);				\
-    pl = (UWtype) __ll;							\
-  }
-#endif
-
-#if !defined (__umulsidi3)
-#define __umulsidi3(u, v) \
-  ({UWtype __hi, __lo;							\
-    umul_ppmm (__hi, __lo, u, v);					\
-    ((UDWtype) __hi << W_TYPE_SIZE) | __lo; })
-#endif
-
-
-/* Note the prototypes are under !define(umul_ppmm) etc too, since the HPPA
-   versions above are different and we don't want to conflict.  */
-
-#if ! defined (umul_ppmm) && HAVE_NATIVE_mpn_umul_ppmm
-#define mpn_umul_ppmm  __MPN(umul_ppmm)
-extern mp_limb_t mpn_umul_ppmm _PROTO ((mp_limb_t *, mp_limb_t, mp_limb_t));
-#define umul_ppmm(wh, wl, u, v)                                 \
-  do {                                                          \
-    mp_limb_t __umul_ppmm__p0;                                  \
-    (wh) = __MPN(umul_ppmm) (&__umul_ppmm__p0,                  \
-                             (mp_limb_t) (u), (mp_limb_t) (v)); \
-    (wl) = __umul_ppmm__p0;                                     \
-  } while (0)
-#endif
-
-#if ! defined (udiv_qrnnd) && HAVE_NATIVE_mpn_udiv_qrnnd
-#define mpn_udiv_qrnnd  __MPN(udiv_qrnnd)
-extern mp_limb_t mpn_udiv_qrnnd _PROTO ((mp_limb_t *,
-                                         mp_limb_t, mp_limb_t, mp_limb_t));
-#define udiv_qrnnd(q, r, n1, n0, d)                                           \
-  do {                                                                        \
-    mp_limb_t __udiv_qrnnd__r;                                                \
-    (q) = mpn_udiv_qrnnd (&__udiv_qrnnd__r,                                   \
-                          (mp_limb_t) (n1), (mp_limb_t) (n0), (mp_limb_t) d); \
-    (r) = __udiv_qrnnd__r;                                                    \
-  } while (0)
-#endif
-
-
-/* If this machine has no inline assembler, use C macros.  */
-
-#if !defined (add_ssaaaa)
-#define add_ssaaaa(sh, sl, ah, al, bh, bl) \
-  do {									\
-    UWtype __x;								\
-    __x = (al) + (bl);							\
-    (sh) = (ah) + (bh) + (__x < (al));					\
-    (sl) = __x;								\
-  } while (0)
-#endif
-
-#if !defined (sub_ddmmss)
-#define sub_ddmmss(sh, sl, ah, al, bh, bl) \
-  do {									\
-    UWtype __x;								\
-    __x = (al) - (bl);							\
-    (sh) = (ah) - (bh) - (__x > (al));					\
-    (sl) = __x;								\
-  } while (0)
-#endif
-
-/* If we lack umul_ppmm but have smul_ppmm, define umul_ppmm in terms of
-   smul_ppmm.  */
-#if !defined (umul_ppmm) && defined (smul_ppmm)
-#define umul_ppmm(w1, w0, u, v)						\
-  do {									\
-    UWtype __w1;							\
-    UWtype __xm0 = (u), __xm1 = (v);					\
-    smul_ppmm (__w1, w0, __xm0, __xm1);					\
-    (w1) = __w1 + (-(__xm0 >> (W_TYPE_SIZE - 1)) & __xm1)		\
-		+ (-(__xm1 >> (W_TYPE_SIZE - 1)) & __xm0);		\
-  } while (0)
-#endif
-
-/* If we still don't have umul_ppmm, define it using plain C.  */
-#if !defined (umul_ppmm)
-#define umul_ppmm(w1, w0, u, v)						\
-  do {									\
-    UWtype __x0, __x1, __x2, __x3;					\
-    UHWtype __ul, __vl, __uh, __vh;					\
-    UWtype __u = (u), __v = (v);					\
-									\
-    __ul = __ll_lowpart (__u);						\
-    __uh = __ll_highpart (__u);						\
-    __vl = __ll_lowpart (__v);						\
-    __vh = __ll_highpart (__v);						\
-									\
-    __x0 = (UWtype) __ul * __vl;					\
-    __x1 = (UWtype) __ul * __vh;					\
-    __x2 = (UWtype) __uh * __vl;					\
-    __x3 = (UWtype) __uh * __vh;					\
-									\
-    __x1 += __ll_highpart (__x0);/* this can't give carry */		\
-    __x1 += __x2;		/* but this indeed can */		\
-    if (__x1 < __x2)		/* did we get it? */			\
-      __x3 += __ll_B;		/* yes, add it in the proper pos. */	\
-									\
-    (w1) = __x3 + __ll_highpart (__x1);					\
-    (w0) = (__x1 << W_TYPE_SIZE/2) + __ll_lowpart (__x0);		\
-  } while (0)
-#endif
-
-/* If we don't have smul_ppmm, define it using umul_ppmm (which surely will
-   exist in one form or another.  */
-#if !defined (smul_ppmm)
-#define smul_ppmm(w1, w0, u, v)						\
-  do {									\
-    UWtype __w1;							\
-    UWtype __xm0 = (u), __xm1 = (v);					\
-    umul_ppmm (__w1, w0, __xm0, __xm1);					\
-    (w1) = __w1 - (-(__xm0 >> (W_TYPE_SIZE - 1)) & __xm1)		\
-		- (-(__xm1 >> (W_TYPE_SIZE - 1)) & __xm0);		\
-  } while (0)
-#endif
-
-/* Define this unconditionally, so it can be used for debugging.  */
-#define __udiv_qrnnd_c(q, r, n1, n0, d) \
-  do {									\
-    UWtype __d1, __d0, __q1, __q0, __r1, __r0, __m;			\
-    __d1 = __ll_highpart (d);						\
-    __d0 = __ll_lowpart (d);						\
-									\
-    __q1 = (n1) / __d1;							\
-    __r1 = (n1) - __q1 * __d1;						\
-    __m = (UWtype) __q1 * __d0;						\
-    __r1 = __r1 * __ll_B | __ll_highpart (n0);				\
-    if (__r1 < __m)							\
-      {									\
-	__q1--, __r1 += (d);						\
-	if (__r1 >= (d)) /* i.e. we didn't get carry when adding to __r1 */\
-	  if (__r1 < __m)						\
-	    __q1--, __r1 += (d);					\
-      }									\
-    __r1 -= __m;							\
-									\
-    __q0 = __r1 / __d1;							\
-    __r0 = __r1  - __q0 * __d1;						\
-    __m = (UWtype) __q0 * __d0;						\
-    __r0 = __r0 * __ll_B | __ll_lowpart (n0);				\
-    if (__r0 < __m)							\
-      {									\
-	__q0--, __r0 += (d);						\
-	if (__r0 >= (d))						\
-	  if (__r0 < __m)						\
-	    __q0--, __r0 += (d);					\
-      }									\
-    __r0 -= __m;							\
-									\
-    (q) = (UWtype) __q1 * __ll_B | __q0;				\
-    (r) = __r0;								\
-  } while (0)
-
-/* If the processor has no udiv_qrnnd but sdiv_qrnnd, go through
-   __udiv_w_sdiv (defined in libgcc or elsewhere).  */
-#if !defined (udiv_qrnnd) && defined (sdiv_qrnnd)
-#define udiv_qrnnd(q, r, nh, nl, d) \
-  do {									\
-    UWtype __r;								\
-    (q) = __MPN(udiv_w_sdiv) (&__r, nh, nl, d);				\
-    (r) = __r;								\
-  } while (0)
-#endif
-
-/* If udiv_qrnnd was not defined for this processor, use __udiv_qrnnd_c.  */
-#if !defined (udiv_qrnnd)
-#define UDIV_NEEDS_NORMALIZATION 1
-#define udiv_qrnnd __udiv_qrnnd_c
-#endif
-
-#if !defined (count_leading_zeros)
-extern
-#if __STDC__
-const
-#endif
-unsigned char __clz_tab[];
-#define count_leading_zeros(count, x) \
-  do {									\
-    UWtype __xr = (x);							\
-    UWtype __a;								\
-									\
-    if (W_TYPE_SIZE <= 32)						\
-      {									\
-	__a = __xr < ((UWtype) 1 << 2*__BITS4)				\
-	  ? (__xr < ((UWtype) 1 << __BITS4) ? 0 : __BITS4)		\
-	  : (__xr < ((UWtype) 1 << 3*__BITS4) ?  2*__BITS4 : 3*__BITS4);\
-      }									\
-    else								\
-      {									\
-	for (__a = W_TYPE_SIZE - 8; __a > 0; __a -= 8)			\
-	  if (((__xr >> __a) & 0xff) != 0)				\
-	    break;							\
-      }									\
-									\
-    (count) = W_TYPE_SIZE - (__clz_tab[__xr >> __a] + __a);		\
-  } while (0)
-/* This version gives a well-defined value for zero. */
-#define COUNT_LEADING_ZEROS_0 W_TYPE_SIZE
-#define COUNT_LEADING_ZEROS_NEED_CLZ_TAB
-#endif
-
-#if !defined (count_trailing_zeros)
-/* Define count_trailing_zeros using count_leading_zeros.  The latter might be
-   defined in asm, but if it is not, the C version above is good enough.  */
-#define count_trailing_zeros(count, x) \
-  do {									\
-    UWtype __ctz_x = (x);						\
-    UWtype __ctz_c;							\
-    count_leading_zeros (__ctz_c, __ctz_x & -__ctz_x);			\
-    (count) = W_TYPE_SIZE - 1 - __ctz_c;				\
-  } while (0)
-#endif
-
-#ifndef UDIV_NEEDS_NORMALIZATION
-#define UDIV_NEEDS_NORMALIZATION 0
-#endif
-
-/* Give defaults for UMUL_TIME and UDIV_TIME.  */
-#ifndef UMUL_TIME
-#define UMUL_TIME 1
-#endif
-
-#ifndef UDIV_TIME
-#define UDIV_TIME UMUL_TIME
-#endif
-
-/* count_trailing_zeros is often on the slow side, so make that the default */
-#ifndef COUNT_TRAILING_ZEROS_TIME
-#define COUNT_TRAILING_ZEROS_TIME  15  /* cycles */
-#endif
-
-
diff --git a/ghc/rts/gmp/ltconfig b/ghc/rts/gmp/ltconfig
deleted file mode 100644
index 6d8cf33e8f..0000000000
--- a/ghc/rts/gmp/ltconfig
+++ /dev/null
@@ -1,3109 +0,0 @@
-#! /bin/sh
-
-# ltconfig - Create a system-specific libtool.
-# Copyright (C) 1996-2000 Free Software Foundation, Inc.
-# Originally by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
-#
-# This file is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
-
-# A lot of this script is taken from autoconf-2.10.
-
-# Check that we are running under the correct shell.
-SHELL=${CONFIG_SHELL-/bin/sh}
-echo=echo
-if test "X$1" = X--no-reexec; then
-  # Discard the --no-reexec flag, and continue.
-  shift
-elif test "X$1" = X--fallback-echo; then
-  # Avoid inline document here, it may be left over
-  :
-elif test "X`($echo '\t') 2>/dev/null`" = 'X\t'; then
-  # Yippee, $echo works!
-  :
-else
-  # Restart under the correct shell.
-  exec "$SHELL" "$0" --no-reexec ${1+"$@"}
-fi
-
-if test "X$1" = X--fallback-echo; then
-  # used as fallback echo
-  shift
-  cat <<EOF
-$*
-EOF
-  exit 0
-fi
-
-# Find the correct PATH separator.  Usually this is `:', but
-# DJGPP uses `;' like DOS.
-if test "X${PATH_SEPARATOR+set}" != Xset; then
-  UNAME=${UNAME-`uname 2>/dev/null`}
-  case X$UNAME in
-    *-DOS) PATH_SEPARATOR=';' ;;
-    *)     PATH_SEPARATOR=':' ;;
-  esac
-fi
-
-# The HP-UX ksh and POSIX shell print the target directory to stdout
-# if CDPATH is set.
-if test "X${CDPATH+set}" = Xset; then CDPATH=:; export CDPATH; fi
-
-if test "X${echo_test_string+set}" != Xset; then
-  # find a string as large as possible, as long as the shell can cope with it
-  for cmd in 'sed 50q "$0"' 'sed 20q "$0"' 'sed 10q "$0"' 'sed 2q "$0"' 'echo test'; do
-    # expected sizes: less than 2Kb, 1Kb, 512 bytes, 16 bytes, ...
-    if (echo_test_string="`eval $cmd`") 2>/dev/null &&
-       echo_test_string="`eval $cmd`" &&
-       (test "X$echo_test_string" = "X$echo_test_string") 2>/dev/null; then
-      break
-    fi
-  done
-fi
-
-if test "X`($echo '\t') 2>/dev/null`" = 'X\t' &&
-   echo_testing_string=`($echo "$echo_test_string") 2>/dev/null` &&
-   test "X$echo_testing_string" = "X$echo_test_string"; then
-  :
-else
-  # The Solaris, AIX, and Digital Unix default echo programs unquote
-  # backslashes.  This makes it impossible to quote backslashes using
-  #   echo "$something" | sed 's/\\/\\\\/g'
-  #
-  # So, first we look for a working echo in the user's PATH.
-
-  IFS="${IFS= 	}"; save_ifs="$IFS"; IFS="${IFS}${PATH_SEPARATOR}"
-  for dir in $PATH /usr/ucb; do
-    if (test -f $dir/echo || test -f $dir/echo$ac_exeext) &&
-       test "X`($dir/echo '\t') 2>/dev/null`" = 'X\t' &&
-       echo_testing_string=`($dir/echo "$echo_test_string") 2>/dev/null` &&
-       test "X$echo_testing_string" = "X$echo_test_string"; then
-      echo="$dir/echo"
-      break
-    fi
-  done
-  IFS="$save_ifs"
-
-  if test "X$echo" = Xecho; then
-    # We didn't find a better echo, so look for alternatives.
-    if test "X`(print -r '\t') 2>/dev/null`" = 'X\t' &&
-       echo_testing_string=`(print -r "$echo_test_string") 2>/dev/null` &&
-       test "X$echo_testing_string" = "X$echo_test_string"; then
-      # This shell has a builtin print -r that does the trick.
-      echo='print -r'
-    elif (test -f /bin/ksh || test -f /bin/ksh$ac_exeext) &&
-	 test "X$CONFIG_SHELL" != X/bin/ksh; then
-      # If we have ksh, try running ltconfig again with it.
-      ORIGINAL_CONFIG_SHELL="${CONFIG_SHELL-/bin/sh}"
-      export ORIGINAL_CONFIG_SHELL
-      CONFIG_SHELL=/bin/ksh
-      export CONFIG_SHELL
-      exec "$CONFIG_SHELL" "$0" --no-reexec ${1+"$@"}
-    else
-      # Try using printf.
-      echo='printf "%s\n"'
-      if test "X`($echo '\t') 2>/dev/null`" = 'X\t' &&
-	 echo_testing_string=`($echo "$echo_test_string") 2>/dev/null` &&
-	 test "X$echo_testing_string" = "X$echo_test_string"; then
-	# Cool, printf works
-	:
-      elif echo_testing_string=`("$ORIGINAL_CONFIG_SHELL" "$0" --fallback-echo '\t') 2>/dev/null` &&
-	   test "X$echo_testing_string" = 'X\t' &&
-	   echo_testing_string=`("$ORIGINAL_CONFIG_SHELL" "$0" --fallback-echo "$echo_test_string") 2>/dev/null` &&
-	   test "X$echo_testing_string" = "X$echo_test_string"; then
-	CONFIG_SHELL="$ORIGINAL_CONFIG_SHELL"
-	export CONFIG_SHELL
-	SHELL="$CONFIG_SHELL"
-	export SHELL
-	echo="$CONFIG_SHELL $0 --fallback-echo"
-      elif echo_testing_string=`("$CONFIG_SHELL" "$0" --fallback-echo '\t') 2>/dev/null` &&
-	   test "X$echo_testing_string" = 'X\t' &&
-	   echo_testing_string=`("$CONFIG_SHELL" "$0" --fallback-echo "$echo_test_string") 2>/dev/null` &&
-	   test "X$echo_testing_string" = "X$echo_test_string"; then
-	echo="$CONFIG_SHELL $0 --fallback-echo"
-      else
-	# maybe with a smaller string...
-	prev=:
-
-	for cmd in 'echo test' 'sed 2q "$0"' 'sed 10q "$0"' 'sed 20q "$0"' 'sed 50q "$0"'; do
-	  if (test "X$echo_test_string" = "X`eval $cmd`") 2>/dev/null; then
-	    break
-	  fi
-	  prev="$cmd"
-	done
-
-	if test "$prev" != 'sed 50q "$0"'; then
-	  echo_test_string=`eval $prev`
-	  export echo_test_string
-	  exec "${ORIGINAL_CONFIG_SHELL}" "$0" ${1+"$@"}
-	else
-	  # Oops.  We lost completely, so just stick with echo.
-	  echo=echo
-	fi
-      fi
-    fi
-  fi
-fi
-
-# Sed substitution that helps us do robust quoting.  It backslashifies
-# metacharacters that are still active within double-quoted strings.
-Xsed='sed -e s/^X//'
-sed_quote_subst='s/\([\\"\\`$\\\\]\)/\\\1/g'
-
-# Same as above, but do not quote variable references.
-double_quote_subst='s/\([\\"\\`\\\\]\)/\\\1/g'
-
-# Sed substitution to delay expansion of an escaped shell variable in a
-# double_quote_subst'ed string.
-delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g'
-
-# The name of this program.
-progname=`$echo "X$0" | $Xsed -e 's%^.*/%%'`
-
-# Constants:
-PROGRAM=ltconfig
-PACKAGE=libtool
-VERSION=1.3c
-TIMESTAMP=" (1.696 2000/03/14 20:22:42)"
-ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
-ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
-rm="rm -f"
-
-help="Try \`$progname --help' for more information."
-
-# Global variables:
-default_ofile=libtool
-can_build_shared=yes
-enable_shared=yes
-# All known linkers require a `.a' archive for static linking (except M$VC,
-# which needs '.lib').
-enable_static=yes
-enable_fast_install=yes
-enable_dlopen=unknown
-enable_win32_dll=no
-pic_mode=default
-ltmain=
-silent=
-srcdir=
-ac_config_guess=
-ac_config_sub=
-host=
-build=NONE
-nonopt=NONE
-ofile="$default_ofile"
-verify_host=yes
-with_gcc=no
-with_gnu_ld=no
-need_locks=yes
-ac_ext=c
-libext=a
-cache_file=
-
-old_AR="$AR"
-old_CC="$CC"
-old_CFLAGS="$CFLAGS"
-old_CPPFLAGS="$CPPFLAGS"
-old_LDFLAGS="$LDFLAGS"
-old_LIBS="$LIBS"
-old_MAGIC="$MAGIC"
-old_LD="$LD"
-old_LN_S="$LN_S"
-old_NM="$NM"
-old_RANLIB="$RANLIB"
-old_STRIP="$STRIP"
-old_AS="$AS"
-old_DLLTOOL="$DLLTOOL"
-old_OBJDUMP="$OBJDUMP"
-old_OBJEXT="$OBJEXT"
-old_EXEEXT="$EXEEXT"
-old_reload_Flag="$reload_flag"
-old_deplibs_check_method="$deplibs_check_method"
-old_file_magic_cmd="$file_magic_cmd"
-
-# Parse the command line options.
-args=
-prev=
-for option
-do
-  case "$option" in
-  -*=*) optarg=`echo "$option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
-  *) optarg= ;;
-  esac
-
-  # If the previous option needs an argument, assign it.
-  if test -n "$prev"; then
-    eval "$prev=\$option"
-    prev=
-    continue
-  fi
-
-  case "$option" in
-  --help) cat <<EOM
-Usage: $progname [OPTION]... LTMAIN [HOST]
-
-Generate a system-specific libtool script.
-
-    --build                configure for building on BUILD [BUILD=HOST]
-    --debug                enable verbose shell tracing
-    --disable-shared       do not build shared libraries
-    --disable-static       do not build static libraries
-    --disable-fast-install do not optimize for fast installation
-    --enable-dlopen        enable dlopen support
-    --enable-win32-dll     enable building dlls on win32 hosts
-    --help                 display this help and exit
-    --no-verify            do not verify that HOST is a valid host type
--o, --output=FILE          specify the output file [default=$default_ofile]
-    --quiet                same as \`--silent'
-    --silent               do not print informational messages
-    --srcdir=DIR           find \`config.guess' in DIR
-    --version              output version information and exit
-    --with-gcc             assume that the GNU C compiler will be used
-    --with-gnu-ld          assume that the C compiler uses the GNU linker
-    --prefer-pic           try to use only PIC objects
-    --prefer-non-pic       try to use only non-PIC objects
-    --disable-lock         disable file locking
-    --cache-file=FILE      configure cache file
-
-LTMAIN is the \`ltmain.sh' shell script fragment or \`ltmain.c' program
-that provides basic libtool functionality.
-
-HOST is the canonical host system name [default=guessed].
-EOM
-  exit 0
-  ;;
-
-  --build) prev=build ;;
-  --build=*) build="$optarg" ;;
-
-  --debug)
-    echo "$progname: enabling shell trace mode"
-    set -x
-    ;;
-
-  --disable-shared) enable_shared=no ;;
-
-  --disable-static) enable_static=no ;;
-
-  --disable-fast-install) enable_fast_install=no ;;
-
-  --enable-dlopen) enable_dlopen=yes ;;
-
-  --enable-win32-dll) enable_win32_dll=yes ;;
-
-  --quiet | --silent) silent=yes ;;
-
-  --srcdir) prev=srcdir ;;
-  --srcdir=*) srcdir="$optarg" ;;
-
-  --no-verify) verify_host=no ;;
-
-  --output | -o) prev=ofile ;;
-  --output=*) ofile="$optarg" ;;
-
-  --version) echo "$PROGRAM (GNU $PACKAGE) $VERSION$TIMESTAMP"; exit 0 ;;
-
-  --with-gcc) with_gcc=yes ;;
-  --with-gnu-ld) with_gnu_ld=yes ;;
-
-  --prefer-pic) pic_mode=yes ;;
-  --prefer-non-pic) pic_mode=no ;;
-
-  --disable-lock) need_locks=no ;;
-
-  --cache-file=*) cache_file="$optarg" ;;
-
-  -*)
-    echo "$progname: unrecognized option \`$option'" 1>&2
-    echo "$help" 1>&2
-    exit 1
-    ;;
-
-  *)
-    if test -z "$ltmain"; then
-      ltmain="$option"
-    elif test -z "$host"; then
-# This generates an unnecessary warning for sparc-sun-solaris4.1.3_U1
-#      if test -n "`echo $option| sed 's/[-a-z0-9.]//g'`"; then
-#        echo "$progname: warning \`$option' is not a valid host type" 1>&2
-#      fi
-      host="$option"
-    else
-      echo "$progname: too many arguments" 1>&2
-      echo "$help" 1>&2
-      exit 1
-    fi ;;
-  esac
-done
-
-if test -z "$ltmain"; then
-  echo "$progname: you must specify a LTMAIN file" 1>&2
-  echo "$help" 1>&2
-  exit 1
-fi
-
-if test ! -f "$ltmain"; then
-  echo "$progname: \`$ltmain' does not exist" 1>&2
-  echo "$help" 1>&2
-  exit 1
-fi
-
-# Quote any args containing shell metacharacters.
-ltconfig_args=
-for arg
-do
-  case "$arg" in
-  *" "*|*"	"*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
-  ltconfig_args="$ltconfig_args '$arg'" ;;
-  *) ltconfig_args="$ltconfig_args $arg" ;;
-  esac
-done
-
-# A relevant subset of AC_INIT.
-
-# File descriptor usage:
-# 0 standard input
-# 1 file creation
-# 2 errors and warnings
-# 3 some systems may open it to /dev/tty
-# 4 used on the Kubota Titan
-# 5 compiler messages saved in config.log
-# 6 checking for... messages and results
-if test "$silent" = yes; then
-  exec 6>/dev/null
-else
-  exec 6>&1
-fi
-exec 5>>./config.log
-
-# NLS nuisances.
-# Only set LANG and LC_ALL to C if already set.
-# These must not be set unconditionally because not all systems understand
-# e.g. LANG=C (notably SCO).
-if test "X${LC_ALL+set}" = Xset; then LC_ALL=C; export LC_ALL; fi
-if test "X${LANG+set}"   = Xset; then LANG=C;   export LANG;   fi
-
-if test -n "$cache_file" && test -r "$cache_file"; then
-  echo "loading cache $cache_file within ltconfig"
-  . $cache_file
-fi
-
-if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
-  # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
-  if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
-    ac_n= ac_c='
-' ac_t='	'
-  else
-    ac_n=-n ac_c= ac_t=
-  fi
-else
-  ac_n= ac_c='\c' ac_t=
-fi
-
-if test -z "$srcdir"; then
-  # Assume the source directory is the same one as the path to LTMAIN.
-  srcdir=`$echo "X$ltmain" | $Xsed -e 's%/[^/]*$%%'`
-  test "$srcdir" = "$ltmain" && srcdir=.
-fi
-
-trap "$rm conftest*; exit 1" 1 2 15
-if test "$verify_host" = yes; then
-  # Check for config.guess and config.sub.
-  ac_aux_dir=
-  for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
-    if test -f $ac_dir/config.guess; then
-      ac_aux_dir=$ac_dir
-      break
-    fi
-  done
-  if test -z "$ac_aux_dir"; then
-    echo "$progname: cannot find config.guess in $srcdir $srcdir/.. $srcdir/../.." 1>&2
-    echo "$help" 1>&2
-    exit 1
-  fi
-  ac_config_guess=$ac_aux_dir/config.guess
-  ac_config_sub=$ac_aux_dir/config.sub
-
-  # Make sure we can run config.sub.
-  if $SHELL $ac_config_sub sun4 >/dev/null 2>&1; then :
-  else
-    echo "$progname: cannot run $ac_config_sub" 1>&2
-    echo "$help" 1>&2
-    exit 1
-  fi
-
-  echo $ac_n "checking host system type""... $ac_c" 1>&6
-
-  host_alias=$host
-  case "$host_alias" in
-  "")
-    if host_alias=`$SHELL $ac_config_guess`; then :
-    else
-      echo "$progname: cannot guess host type; you must specify one" 1>&2
-      echo "$help" 1>&2
-      exit 1
-    fi ;;
-  esac
-  host=`$SHELL $ac_config_sub $host_alias`
-  echo "$ac_t$host" 1>&6
-
-  # Make sure the host verified.
-  test -z "$host" && exit 1
-
-  # Check for the build system type
-  echo $ac_n "checking build system type... $ac_c" 1>&6
-
-  build_alias=$build
-  case "$build_alias" in
-  NONE)
-    case $nonopt in
-    NONE) build_alias=$host_alias ;;
-    *) build_alias=$nonopt ;;
-    esac ;;
-  esac
-
-  build=`$SHELL $ac_config_sub $build_alias`
-  build_cpu=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-  build_vendor=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-  build_os=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-  echo "$ac_t""$build" 1>&6
-
-elif test -z "$host"; then
-  echo "$progname: you must specify a host type if you use \`--no-verify'" 1>&2
-  echo "$help" 1>&2
-  exit 1
-else
-  host_alias=$host
-  build_alias=$host_alias
-  build=$host
-fi
-
-if test x"$host" != x"$build"; then
-  ac_tool_prefix=${host_alias}-
-else
-  ac_tool_prefix=
-fi
-
-host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
-host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
-host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
-
-# Transform linux* to *-*-linux-gnu*, to support old configure scripts.
-case "$host_os" in
-linux-gnu*) ;;
-linux*) host=`echo $host | sed 's/^\(.*-.*-linux\)\(.*\)$/\1-gnu\2/'`
-esac
-
-case "$host_os" in
-aix3*)
-  # AIX sometimes has problems with the GCC collect2 program.  For some
-  # reason, if we set the COLLECT_NAMES environment variable, the problems
-  # vanish in a puff of smoke.
-  if test "X${COLLECT_NAMES+set}" != Xset; then
-    COLLECT_NAMES=
-    export COLLECT_NAMES
-  fi
-  ;;
-esac
-
-# Determine commands to create old-style static archives.
-old_archive_cmds='$AR cru $oldlib$oldobjs$old_deplibs'
-old_postinstall_cmds='chmod 644 $oldlib'
-old_postuninstall_cmds=
-
-# Set sane defaults for various variables
-test -z "$AR" && AR=ar
-test -z "$AS" && AS=as
-test -z "$CC" && CC=cc
-test -z "$DLLTOOL" && DLLTOOL=dlltool
-test -z "$MAGIC" && MAGIC=file
-test -z "$LD" && LD=ld
-test -z "$LN_S" && LN_S="ln -s"
-test -z "$NM" && NM=nm
-test -z "$OBJDUMP" && OBJDUMP=objdump
-test -z "$RANLIB" && RANLIB=:
-test -z "$STRIP" && STRIP=:
-test -z "$objext" && objext=o
-
-echo $ac_n "checking for objdir... $ac_c" 1>&6
-rm -f .libs 2>/dev/null
-mkdir .libs 2>/dev/null
-if test -d .libs; then
-  objdir=.libs
-else
-  # MS-DOS does not allow filenames that begin with a dot.
-  objdir=_libs
-fi
-rmdir .libs 2>/dev/null
-echo "$ac_t$objdir" 1>&6
-
-# Allow CC to be a program name with arguments.
-set dummy $CC
-compiler="$2"
-
-# We assume here that the value for ac_cv_prog_cc_pic will not be cached
-# in isolation, and that seeing it set (from the cache) indicates that
-# the associated values are set (in the cache) correctly too.
-echo $ac_n "checking for $compiler option to produce PIC... $ac_c" 1>&6
-echo "$progname:563:checking for $compiler option to produce PIC" 1>&5
-if test "X${ac_cv_prog_cc_pic+set}" = Xset; then
-  echo $ac_n "(cached) $ac_c" 1>&6
-else
-  ac_cv_prog_cc_pic=
-  ac_cv_prog_cc_shlib=
-  ac_cv_prog_cc_wl=
-  ac_cv_prog_cc_static=
-  ac_cv_prog_cc_no_builtin=
-  ac_cv_prog_cc_can_build_shared=$can_build_shared
-
-  if test "$with_gcc" = yes; then
-    ac_cv_prog_cc_wl='-Wl,'
-    ac_cv_prog_cc_static='-static'
-
-    case "$host_os" in
-    beos* | irix5* | irix6* | osf3* | osf4* | osf5*)
-      # PIC is the default for these OSes.
-      ;;
-    aix*)
-      # Below there is a dirty hack to force normal static linking with -ldl
-      # The problem is because libdl dynamically linked with both libc and
-      # libC (AIX C++ library), which obviously doesn't included in libraries
-      # list by gcc. This cause undefined symbols with -static flags.
-      # This hack allows C programs to be linked with "-static -ldl", but
-      # we not sure about C++ programs.
-      ac_cv_prog_cc_static="$ac_cv_prog_cc_static ${ac_cv_prog_cc_wl}-lC"
-      ;;
-    cygwin* | mingw* | os2*)
-      # This hack is so that the source file can tell whether it is being
-      # built for inclusion in a dll (and should export symbols for example).
-      ac_cv_prog_cc_pic='-DDLL_EXPORT'
-      ;;
-    amigaos*)
-      # FIXME: we need at least 68020 code to build shared libraries, but
-      # adding the `-m68020' flag to GCC prevents building anything better,
-      # like `-m68040'.
-      ac_cv_prog_cc_pic='-m68020 -resident32 -malways-restore-a4'
-      ;;
-    sysv4*MP*)
-      if test -d /usr/nec; then
-	 ac_cv_prog_cc_pic=-Kconform_pic
-      fi
-      ;;
-    *)
-      ac_cv_prog_cc_pic='-fPIC'
-      ;;
-    esac
-  else
-    # PORTME Check for PIC flags for the system compiler.
-    case "$host_os" in
-    aix3* | aix4*)
-     # All AIX code is PIC.
-      ac_cv_prog_cc_static='-bnso -bI:/lib/syscalls.exp'
-      ;;
-
-    hpux9* | hpux10* | hpux11*)
-      # Is there a better ac_cv_prog_cc_static that works with the bundled CC?
-      ac_cv_prog_cc_wl='-Wl,'
-      ac_cv_prog_cc_static="${ac_cv_prog_cc_wl}-a ${ac_cv_prog_cc_wl}archive"
-      ac_cv_prog_cc_pic='+Z'
-      ;;
-
-    irix5* | irix6*)
-      ac_cv_prog_cc_wl='-Wl,'
-      ac_cv_prog_cc_static='-non_shared'
-      # PIC (with -KPIC) is the default.
-      ;;
-
-    cygwin* | mingw* | os2*)
-      # This hack is so that the source file can tell whether it is being
-      # built for inclusion in a dll (and should export symbols for example).
-      ac_cv_prog_cc_pic='-DDLL_EXPORT'
-      ;;
-
-    osf3* | osf4* | osf5*)
-      # All OSF/1 code is PIC.
-      ac_cv_prog_cc_wl='-Wl,'
-      ac_cv_prog_cc_static='-non_shared'
-      ;;
-
-    sco3.2v5*)
-      ac_cv_prog_cc_pic='-Kpic'
-      ac_cv_prog_cc_static='-dn'
-      ac_cv_prog_cc_shlib='-belf'
-      ;;
-
-    solaris*)
-      ac_cv_prog_cc_pic='-KPIC'
-      ac_cv_prog_cc_static='-Bstatic'
-      ac_cv_prog_cc_wl='-Wl,'
-      ;;
-
-    sunos4*)
-      ac_cv_prog_cc_pic='-PIC'
-      ac_cv_prog_cc_static='-Bstatic'
-      ac_cv_prog_cc_wl='-Qoption ld '
-      ;;
-
-    sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
-      ac_cv_prog_cc_pic='-KPIC'
-      ac_cv_prog_cc_static='-Bstatic'
-      ac_cv_prog_cc_wl='-Wl,'
-      ;;
-
-    uts4*)
-      ac_cv_prog_cc_pic='-pic'
-      ac_cv_prog_cc_static='-Bstatic'
-      ;;
-
-    sysv4*MP*)
-      if test -d /usr/nec ;then
-	ac_cv_prog_cc_pic='-Kconform_pic'
-	ac_cv_prog_cc_static='-Bstatic'
-      fi
-      ;;
-
-    *)
-      ac_cv_prog_cc_can_build_shared=no
-      ;;
-    esac
-  fi
-fi
-if test -z "$ac_cv_prog_cc_pic"; then
-  echo "$ac_t"none 1>&6
-else
-  echo "$ac_t""$ac_cv_prog_cc_pic" 1>&6
-
-  # Check to make sure the pic_flag actually works.
-  echo $ac_n "checking if $compiler PIC flag $ac_cv_prog_cc_pic works... $ac_c" 1>&6
-  echo "$progname:693:checking that $compiler PIC flag $ac_cv_prog_cc_pic works." 1>&5
-  if test "X${ac_cv_prog_cc_pic_works+set}" = Xset; then
-    echo $ac_n "(cached) $ac_c" 1>&6
-  else
-    ac_cv_prog_cc_pic_works=yes
-    $rm conftest*
-    echo "int some_variable = 0;" > conftest.c
-    save_CFLAGS="$CFLAGS"
-    CFLAGS="$CFLAGS $ac_cv_prog_cc_pic -DPIC"
-    if { (eval echo $progname:702: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>conftest.err; } && test -s conftest.$objext; then
-      # Append any warnings to the config.log.
-      cat conftest.err 1>&5
-
-      case "$host_os" in
-      hpux9* | hpux10* | hpux11*)
-	# On HP-UX, both CC and GCC only warn that PIC is supported... then
-	# they create non-PIC objects.  So, if there were any warnings, we
-	# assume that PIC is not supported.
-	if test -s conftest.err; then
-	  ac_cv_prog_cc_pic_works=no
-	  ac_cv_prog_cc_can_build_shared=no
-	  ac_cv_prog_cc_pic=
-	else
-	  ac_cv_prog_cc_pic_works=yes
-	  ac_cv_prog_cc_pic=" $ac_cv_prog_cc_pic"
-	fi
-	;;
-      *)
-	ac_cv_prog_cc_pic_works=yes
-	ac_cv_prog_cc_pic=" $ac_cv_prog_cc_pic"
-	;;
-      esac
-    else
-      # Append any errors to the config.log.
-      cat conftest.err 1>&5
-      ac_cv_prog_cc_pic_works=no
-      ac_cv_prog_cc_can_build_shared=no
-      ac_cv_prog_cc_pic=
-    fi
-    CFLAGS="$save_CFLAGS"
-    $rm conftest*
-  fi
-  # Belt *and* braces to stop my trousers falling down:
-  if test "X$ac_cv_prog_cc_pic_works" = Xno; then
-    ac_cv_prog_cc_pic=
-    ac_cv_prog_cc_can_build_shared=no
-  fi
-  echo "$ac_t""$ac_cv_prog_cc_pic_works" 1>&6
-fi
-
-# Check for any special shared library compilation flags.
-if test -n "$ac_cv_prog_cc_shlib"; then
-  echo "$progname: warning: \`$CC' requires \`$ac_cv_prog_cc_shlib' to build shared libraries" 1>&2
-  if echo "$old_CC $old_CFLAGS " | egrep -e "[ 	]$ac_cv_prog_cc_shlib[ 	]" >/dev/null; then :
-  else
-    echo "$progname: add \`$ac_cv_prog_cc_shlib' to the CC or CFLAGS env variable and reconfigure" 1>&2
-    ac_cv_prog_cc_can_build_shared=no
-  fi
-fi
-
-echo $ac_n "checking if $compiler static flag $ac_cv_prog_cc_static works... $ac_c" 1>&6
-echo "$progname:754: checking if $compiler static flag $ac_cv_prog_cc_static works" >&5
-if test "X${ac_cv_prog_cc_static_works+set}" = Xset; then
-  echo $ac_n "(cached) $ac_c" 1>&6
-else
-  $rm conftest*
-  echo 'main(){return(0);}' > conftest.c
-  save_LDFLAGS="$LDFLAGS"
-  LDFLAGS="$LDFLAGS $ac_cv_prog_cc_static"
-  if { (eval echo $progname:762: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
-    ac_cv_prog_cc_static_works=yes
-  else
-    ac_cv_prog_cc_static_works=no
-    ac_cv_prog_cc_static=
-  fi
-  LDFLAGS="$save_LDFLAGS"
-  $rm conftest*
-fi
-# Belt *and* braces to stop my trousers falling down:
-if test "X$ac_cv_prog_cc_static_works" = Xno; then
-  ac_cv_prog_cc_static=
-fi
-echo "$ac_t""$ac_cv_prog_cc_static_works" 1>&6
-pic_flag="$ac_cv_prog_cc_pic"
-special_shlib_compile_flags="$ac_cv_prog_cc_shlib"
-wl="$ac_cv_prog_cc_wl"
-link_static_flag="$ac_cv_prog_cc_static"
-no_builtin_flag="$ac_cv_prog_cc_no_builtin"
-can_build_shared="$ac_cv_prog_cc_can_build_shared"
-
-# Check to see if options -o and -c are simultaneously supported by compiler
-echo $ac_n "checking if $compiler supports -c -o file.o... $ac_c" 1>&6
-$rm -r conftest 2>/dev/null
-mkdir conftest
-cd conftest
-$rm conftest*
-echo "int some_variable = 0;" > conftest.c
-mkdir out
-# According to Tom Tromey, Ian Lance Taylor reported there are C compilers
-# that will create temporary files in the current directory regardless of
-# the output directory.  Thus, making CWD read-only will cause this test
-# to fail, enabling locking or at least warning the user not to do parallel
-# builds.
-chmod -w .
-save_CFLAGS="$CFLAGS"
-CFLAGS="$CFLAGS -o out/conftest2.o"
-echo "$progname:799: checking if $compiler supports -c -o file.o" >&5
-if { (eval echo $progname:800: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>out/conftest.err; } && test -s out/conftest2.o; then
-
-  # The compiler can only warn and ignore the option if not recognized
-  # So say no if there are warnings
-    if test -s out/conftest.err; then
-      echo "$ac_t"no 1>&6
-      compiler_c_o=no
-    else
-      echo "$ac_t"yes 1>&6
-      compiler_c_o=yes
-    fi
-else
-  # Append any errors to the config.log.
-  cat out/conftest.err 1>&5
-  compiler_c_o=no
-  echo "$ac_t"no 1>&6
-fi
-CFLAGS="$save_CFLAGS"
-chmod u+w .
-$rm conftest* out/*
-rmdir out
-cd ..
-rmdir conftest
-$rm -r conftest 2>/dev/null
-
-if test x"$compiler_c_o" = x"yes"; then
-  # Check to see if we can write to a .lo
-  echo $ac_n "checking if $compiler supports -c -o file.lo... $ac_c" 1>&6
-  $rm conftest*
-  echo "int some_variable = 0;" > conftest.c
-  save_CFLAGS="$CFLAGS"
-  CFLAGS="$CFLAGS -c -o conftest.lo"
-  echo "$progname:832: checking if $compiler supports -c -o file.lo" >&5
-if { (eval echo $progname:833: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>conftest.err; } && test -s conftest.lo; then
-
-    # The compiler can only warn and ignore the option if not recognized
-    # So say no if there are warnings
-      if test -s conftest.err; then
-	echo "$ac_t"no 1>&6
-	compiler_o_lo=no
-      else
-	echo "$ac_t"yes 1>&6
-	compiler_o_lo=yes
-      fi
-  else
-    # Append any errors to the config.log.
-    cat conftest.err 1>&5
-    compiler_o_lo=no
-    echo "$ac_t"no 1>&6
-  fi
-  CFLAGS="$save_CFLAGS"
-  $rm conftest*
-else
-  compiler_o_lo=no
-fi
-
-# Check to see if we can do hard links to lock some files if needed
-hard_links="nottested"
-if test "$compiler_c_o" = no && test "$need_locks" != no; then
-  # do not overwrite the value of need_locks provided by the user
-  echo $ac_n "checking if we can lock with hard links... $ac_c" 1>&6
-  hard_links=yes
-  $rm conftest*
-  ln conftest.a conftest.b 2>/dev/null && hard_links=no
-  touch conftest.a
-  ln conftest.a conftest.b 2>&5 || hard_links=no
-  ln conftest.a conftest.b 2>/dev/null && hard_links=no
-  echo "$ac_t$hard_links" 1>&6
-  $rm conftest*
-  if test "$hard_links" = no; then
-    echo "*** WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2
-    need_locks=warn
-  fi
-else
-  need_locks=no
-fi
-
-if test "$with_gcc" = yes; then
-  # Check to see if options -fno-rtti -fno-exceptions are supported by compiler
-  echo $ac_n "checking if $compiler supports -fno-rtti -fno-exceptions ... $ac_c" 1>&6
-  $rm conftest*
-  echo "int some_variable = 0;" > conftest.c
-  save_CFLAGS="$CFLAGS"
-  CFLAGS="$CFLAGS -fno-rtti -fno-exceptions -c conftest.c"
-  echo "$progname:884: checking if $compiler supports -fno-rtti -fno-exceptions" >&5
-  if { (eval echo $progname:885: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>conftest.err; } && test -s conftest.o; then
-
-    # The compiler can only warn and ignore the option if not recognized
-    # So say no if there are warnings
-      if test -s conftest.err; then
-	echo "$ac_t"no 1>&6
-	compiler_rtti_exceptions=no
-      else
-	echo "$ac_t"yes 1>&6
-	compiler_rtti_exceptions=yes
-      fi
-  else
-    # Append any errors to the config.log.
-    cat conftest.err 1>&5
-    compiler_rtti_exceptions=no
-    echo "$ac_t"no 1>&6
-  fi
-  CFLAGS="$save_CFLAGS"
-  $rm conftest*
-
-  if test "$compiler_rtti_exceptions" = "yes"; then
-    no_builtin_flag=' -fno-builtin -fno-rtti -fno-exceptions'
-  else
-    no_builtin_flag=' -fno-builtin'
-  fi
-
-fi
-
-# See if the linker supports building shared libraries.
-echo $ac_n "checking whether the linker ($LD) supports shared libraries... $ac_c" 1>&6
-
-allow_undefined_flag=
-no_undefined_flag=
-need_lib_prefix=unknown
-need_version=unknown
-# when you set need_version to no, make sure it does not cause -set_version
-# flags to be left without arguments
-archive_cmds=
-archive_expsym_cmds=
-old_archive_from_new_cmds=
-old_archive_from_expsyms_cmds=
-striplib=
-old_striplib=
-export_dynamic_flag_spec=
-whole_archive_flag_spec=
-thread_safe_flag_spec=
-hardcode_into_libs=no
-hardcode_libdir_flag_spec=
-hardcode_libdir_separator=
-hardcode_direct=no
-hardcode_minus_L=no
-hardcode_shlibpath_var=unsupported
-runpath_var=
-link_all_deplibs=unknown
-always_export_symbols=no
-export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | sed '\''s/.* //'\'' | sort | uniq > $export_symbols'
-# include_expsyms should be a list of space-separated symbols to be *always*
-# included in the symbol list
-include_expsyms=
-# exclude_expsyms can be an egrep regular expression of symbols to exclude
-# it will be wrapped by ` (' and `)$', so one must not match beginning or
-# end of line.  Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc',
-# as well as any symbol that contains `d'.
-exclude_expsyms="_GLOBAL_OFFSET_TABLE_"
-# Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out
-# platforms (ab)use it in PIC code, but their linkers get confused if
-# the symbol is explicitly referenced.  Since portable code cannot
-# rely on this symbol name, it's probably fine to never include it in
-# preloaded symbol tables.
-extract_expsyms_cmds=
-
-case "$host_os" in
-cygwin* | mingw*)
-  # FIXME: the MSVC++ port hasn't been tested in a loooong time
-  # When not using gcc, we currently assume that we are using
-  # Microsoft Visual C++.
-  if test "$with_gcc" != yes; then
-    with_gnu_ld=no
-  fi
-  ;;
-
-esac
-
-ld_shlibs=yes
-if test "$with_gnu_ld" = yes; then
-  # If archive_cmds runs LD, not CC, wlarc should be empty
-  wlarc='${wl}'
-
-  # See if GNU ld supports shared libraries.
-  case "$host_os" in
-  aix3* | aix4*)
-    # On AIX, the GNU linker is very broken
-    ld_shlibs=no
-    cat <<EOF 1>&2
-
-*** Warning: the GNU linker, at least up to release 2.9.1, is reported
-*** to be unable to reliably create shared libraries on AIX.
-*** Therefore, libtool is disabling shared libraries support.  If you
-*** really care for shared libraries, you may want to modify your PATH
-*** so that a non-GNU linker is found, and then restart.
-
-EOF
-    ;;
-
-  amigaos*)
-    archive_cmds='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR cru $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
-    hardcode_libdir_flag_spec='-L$libdir'
-    hardcode_minus_L=yes
-
-    # Samuel A. Falvo II <kc5tja@dolphin.openprojects.net> reports
-    # that the semantics of dynamic libraries on AmigaOS, at least up
-    # to version 4, is to share data among multiple programs linked
-    # with the same dynamic library.  Since this doesn't match the
-    # behavior of shared libraries on other platforms, we can use
-    # them.
-    ld_shlibs=no
-    ;;
-
-  beos*)
-    if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
-      allow_undefined_flag=unsupported
-      # Joseph Beckenbach <jrb3@best.com> says some releases of gcc
-      # support --undefined.  This deserves some investigation.  FIXME
-      archive_cmds='$CC -nostart $libobjs $deplibs $linker_flags ${wl}-soname $wl$soname -o $lib'
-    else
-      ld_shlibs=no
-    fi
-    ;;
-
-  cygwin* | mingw*)
-    # hardcode_libdir_flag_spec is actually meaningless, as there is
-    # no search path for DLLs.
-    hardcode_libdir_flag_spec='-L$libdir'
-    allow_undefined_flag=unsupported
-    always_export_symbols=yes
-
-    extract_expsyms_cmds='test -f $output_objdir/impgen.c || \
-      sed -e "/^# \/\* impgen\.c starts here \*\//,/^# \/\* impgen.c ends here \*\// { s/^# //; p; }" -e d < $0 > $output_objdir/impgen.c~
-      test -f $output_objdir/impgen.exe || (cd $output_objdir && \
-      if test "x$HOST_CC" != "x" ; then $HOST_CC -o impgen impgen.c ; \
-      else $CC -o impgen impgen.c ; fi)~
-      $output_objdir/impgen $dir/$soname > $output_objdir/$soname-def'
-
-    old_archive_from_expsyms_cmds='$DLLTOOL --as=$AS --dllname $soname --def $output_objdir/$soname-def --output-lib $output_objdir/$newlib'
-
-    # cygwin and mingw dlls have different entry points and sets of symbols
-    # to exclude.
-    # FIXME: what about values for MSVC?
-    dll_entry=__cygwin_dll_entry@12
-    dll_exclude_symbols=DllMain@12,_cygwin_dll_entry@12,_cygwin_noncygwin_dll_entry@12~
-    case "$host_os" in
-    mingw*)
-      # mingw values
-      dll_entry=_DllMainCRTStartup@12
-      dll_exclude_symbols=DllMain@12,DllMainCRTStartup@12,DllEntryPoint@12~
-      ;;
-    esac
-
-    # mingw and cygwin differ, and it's simplest to just exclude the union
-    # of the two symbol sets.
-    dll_exclude_symbols=DllMain@12,_cygwin_dll_entry@12,_cygwin_noncygwin_dll_entry@12,DllMainCRTStartup@12,DllEntryPoint@12
-
-    # recent cygwin and mingw systems supply a stub DllMain which the user
-    # can override, but on older systems we have to supply one (in ltdll.c)
-    if test "x$lt_cv_need_dllmain" = "xyes"; then
-      ltdll_obj='$output_objdir/$soname-ltdll.'"$objext "
-      ltdll_cmds='test -f $output_objdir/$soname-ltdll.c || sed -e "/^# \/\* ltdll\.c starts here \*\//,/^# \/\* ltdll.c ends here \*\// { s/^# //; p; }" -e d < $0 > $output_objdir/$soname-ltdll.c~
-	test -f $output_objdir/$soname-ltdll.$objext || (cd $output_objdir && $CC -c $soname-ltdll.c)~'
-    else
-      ltdll_obj=
-      ltdll_cmds=
-    fi
-
-    # Extract the symbol export list from an `--export-all' def file,
-    # then regenerate the def file from the symbol export list, so that
-    # the compiled dll only exports the symbol export list.
-    # Be careful not to strip the DATA tag left be newer dlltools.
-    export_symbols_cmds="$ltdll_cmds"'
-      $DLLTOOL --export-all --exclude-symbols '$dll_exclude_symbols' --output-def $output_objdir/$soname-def '$ltdll_obj'$libobjs $convenience~
-      sed -e "1,/EXPORTS/d" -e "s/ @ [0-9]*//" -e "s/ *;.*$//" < $output_objdir/$soname-def > $export_symbols'
-
-    # If DATA tags from a recent dlltool are present, honour them!
-    archive_expsym_cmds='echo EXPORTS > $output_objdir/$soname-def~
-      _lt_hint=1;
-      cat $export_symbols | while read symbol; do
-	set dummy \$symbol;
-	case \$# in
-	  2) echo "	\$2 @ \$_lt_hint ; " >> $output_objdir/$soname-def;;
-	  *) echo "     \$2 @ \$_lt_hint \$3 ; " >> $output_objdir/$soname-def;;
-	esac;
-	_lt_hint=`expr 1 + \$_lt_hint`;
-      done~
-      '"$ltdll_cmds"'
-      $CC -Wl,--base-file,$output_objdir/$soname-base '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $lib '$ltdll_obj'$libobjs $deplibs $compiler_flags~
-      $DLLTOOL --as=$AS --dllname $soname --exclude-symbols '$dll_exclude_symbols' --def $output_objdir/$soname-def --base-file $output_objdir/$soname-base --output-exp $output_objdir/$soname-exp~
-      $CC -Wl,--base-file,$output_objdir/$soname-base $output_objdir/$soname-exp '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $lib '$ltdll_obj'$libobjs $deplibs $compiler_flags~
-      $DLLTOOL --as=$AS --dllname $soname --exclude-symbols '$dll_exclude_symbols' --def $output_objdir/$soname-def --base-file $output_objdir/$soname-base --output-exp $output_objdir/$soname-exp~
-      $CC $output_objdir/$soname-exp '$lt_cv_cc_dll_switch' -Wl,-e,'$dll_entry' -o $lib '$ltdll_obj'$libobjs $deplibs $compiler_flags'
-    ;;
-
-  netbsd*)
-    if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
-      archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
-      archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
-    else
-      archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib'
-    fi
-    ;;
-
-  solaris* | sysv5*)
-    if $LD -v 2>&1 | egrep 'BFD 2\.8' > /dev/null; then
-      ld_shlibs=no
-      cat <<EOF 1>&2
-
-*** Warning: The releases 2.8.* of the GNU linker cannot reliably
-*** create shared libraries on Solaris systems.  Therefore, libtool
-*** is disabling shared libraries support.  We urge you to upgrade GNU
-*** binutils to release 2.9.1 or newer.  Another option is to modify
-*** your PATH or compiler configuration so that the native linker is
-*** used, and then restart.
-
-EOF
-    elif $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
-      archive_cmds='$CC -shared $libobjs $deplibs $linker_flags ${wl}-soname $wl$soname -o $lib'
-      archive_expsym_cmds='$CC -shared $libobjs $deplibs $linker_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
-    else
-      ld_shlibs=no
-    fi
-    ;;
-
-  sunos4*)
-    archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags'
-    wlarc=
-    hardcode_direct=yes
-    hardcode_shlibpath_var=no
-    ;;
-
-  *)
-    if $LD --help 2>&1 | egrep ': supported targets:.* elf' > /dev/null; then
-      archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib'
-      archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib'
-    else
-      ld_shlibs=no
-    fi
-    ;;
-  esac
-
-  if test "$ld_shlibs" = yes; then
-    runpath_var=LD_RUN_PATH
-    hardcode_libdir_flag_spec='${wl}--rpath ${wl}$libdir'
-    export_dynamic_flag_spec='${wl}--export-dynamic'
-    case $host_os in
-    cygwin* | mingw*)
-      # dlltool doesn't understand --whole-archive et. al.
-      whole_archive_flag_spec=
-      ;;
-    *)
-      # ancient GNU ld didn't support --whole-archive et. al.
-      if $LD --help 2>&1 | egrep 'no-whole-archive' > /dev/null; then
-	whole_archive_flag_spec="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive'
-      else
-	whole_archive_flag_spec=
-      fi
-      ;;
-    esac
-  fi
-else
-  # PORTME fill in a description of your system's linker (not GNU ld)
-  case "$host_os" in
-  aix3*)
-    allow_undefined_flag=unsupported
-    always_export_symbols=yes
-    archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR cru $lib $output_objdir/$soname'
-    # Note: this linker hardcodes the directories in LIBPATH if there
-    # are no directories specified by -L.
-    hardcode_minus_L=yes
-    if test "$with_gcc" = yes && test -z "$link_static_flag"; then
-      # Neither direct hardcoding nor static linking is supported with a
-      # broken collect2.
-      hardcode_direct=unsupported
-    fi
-    ;;
-
-  aix4*)
-    hardcode_libdir_flag_spec='${wl}-b ${wl}nolibpath ${wl}-b ${wl}libpath:$libdir:/usr/lib:/lib'
-    hardcode_libdir_separator=':'
-    if test "$with_gcc" = yes; then
-      collect2name=`${CC} -print-prog-name=collect2`
-      if test -f "$collect2name" && \
-	 strings "$collect2name" | grep resolve_lib_name >/dev/null
-      then
-	# We have reworked collect2
-	hardcode_direct=yes
-      else
-	# We have old collect2
-	hardcode_direct=unsupported
-	# It fails to find uninstalled libraries when the uninstalled
-	# path is not listed in the libpath.  Setting hardcode_minus_L
-	# to unsupported forces relinking
-	hardcode_minus_L=yes
-	hardcode_libdir_flag_spec='-L$libdir'
-	hardcode_libdir_separator=
-      fi
-      shared_flag='-shared'
-    else
-      shared_flag='${wl}-bM:SRE'
-      hardcode_direct=yes
-    fi
-    allow_undefined_flag=' ${wl}-berok'
-    archive_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs $compiler_flags ${wl}-bexpall ${wl}-bnoentry${allow_undefined_flag}'
-    archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs $compiler_flags ${wl}-bE:$export_symbols ${wl}-bnoentry${allow_undefined_flag}'
-    case "$host_os" in aix4.[01]|aix4.[01].*)
-      # According to Greg Wooledge, -bexpall is only supported from AIX 4.2 on
-      always_export_symbols=yes ;;
-    esac
-   ;;
-
-  amigaos*)
-    archive_cmds='$rm $output_objdir/a2ixlibrary.data~$echo "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$echo "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$echo "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$echo "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR cru $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)'
-    hardcode_libdir_flag_spec='-L$libdir'
-    hardcode_minus_L=yes
-    # see comment about different semantics on the GNU ld section
-    ld_shlibs=no
-    ;;
-
-  cygwin* | mingw*)
-    # When not using gcc, we currently assume that we are using
-    # Microsoft Visual C++.
-    # hardcode_libdir_flag_spec is actually meaningless, as there is
-    # no search path for DLLs.
-    hardcode_libdir_flag_spec=' '
-    allow_undefined_flag=unsupported
-    # Tell ltmain to make .lib files, not .a files.
-    libext=lib
-    # FIXME: Setting linknames here is a bad hack.
-    archive_cmds='$CC -o $lib $libobjs $compiler_flags `echo "$deplibs" | sed -e '\''s/ -lc$//'\''` -link -dll~linknames='
-    # The linker will automatically build a .lib file if we build a DLL.
-    old_archive_from_new_cmds='true'
-    # FIXME: Should let the user specify the lib program.
-    old_archive_cmds='lib /OUT:$oldlib$oldobjs$old_deplibs'
-    fix_srcfile_path='`cygpath -w $srcfile`'
-    ;;
-
-  freebsd1*)
-    ld_shlibs=no
-    ;;
-
-  # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor
-  # support.  Future versions do this automatically, but an explicit c++rt0.o
-  # does not break anything, and helps significantly (at the cost of a little
-  # extra space).
-  freebsd2.2*)
-    archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o'
-    hardcode_libdir_flag_spec='-R$libdir'
-    hardcode_direct=yes
-    hardcode_shlibpath_var=no
-    ;;
-
-  # Unfortunately, older versions of FreeBSD 2 do not have this feature.
-  freebsd2*)
-    archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
-    hardcode_direct=yes
-    hardcode_minus_L=yes
-    hardcode_shlibpath_var=no
-    ;;
-
-  # FreeBSD 3 and greater uses gcc -shared to do shared libraries.
-  freebsd*)
-    archive_cmds='$CC -shared -o $lib $libobjs $deplibs $compiler_flags'
-    hardcode_libdir_flag_spec='-R$libdir'
-    hardcode_direct=yes
-    hardcode_shlibpath_var=no
-    ;;
-
-  hpux9* | hpux10* | hpux11*)
-    case "$host_os" in
-    hpux9*) archive_cmds='$rm $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' ;;
-    *) archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' ;;
-    esac
-    hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir'
-    hardcode_libdir_separator=:
-    hardcode_direct=yes
-    hardcode_minus_L=yes # Not in the search PATH, but as the default
-			 # location of the library.
-    export_dynamic_flag_spec='${wl}-E'
-    ;;
-
-  irix5* | irix6*)
-    if test "$with_gcc" = yes; then
-      archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
-    else
-      archive_cmds='$LD -shared $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
-    fi
-    hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
-    hardcode_libdir_separator=:
-    link_all_deplibs=yes
-    ;;
-
-  netbsd*)
-    if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
-      archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'  # a.out
-    else
-      archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags'      # ELF
-    fi
-    hardcode_libdir_flag_spec='${wl}-R$libdir'
-    hardcode_direct=yes
-    hardcode_shlibpath_var=no
-    ;;
-
-  openbsd*)
-    archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags'
-    hardcode_libdir_flag_spec='-R$libdir'
-    hardcode_direct=yes
-    hardcode_shlibpath_var=no
-    ;;
-
-  os2*)
-    hardcode_libdir_flag_spec='-L$libdir'
-    hardcode_minus_L=yes
-    allow_undefined_flag=unsupported
-    archive_cmds='$echo "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$echo "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~$echo DATA >> $output_objdir/$libname.def~$echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~$echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def'
-    old_archive_from_new_cmds='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def'
-    ;;
-
-  osf3*)
-    if test "$with_gcc" = yes; then
-      allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
-      archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
-    else
-      allow_undefined_flag=' -expect_unresolved \*'
-      archive_cmds='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
-    fi
-    hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
-    hardcode_libdir_separator=:
-    ;;
-
-  osf4* | osf5*)	# as osf3* with the addition of -msym flag
-    if test "$with_gcc" = yes; then
-      allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*'
-      archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && echo ${wl}-set_version ${wl}$verstring` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib'
-    else
-      allow_undefined_flag=' -expect_unresolved \*'
-      archive_cmds='$LD -shared${allow_undefined_flag} $libobjs $deplibs $linker_flags -msym -soname $soname `test -n "$verstring" && echo -set_version $verstring` -update_registry ${output_objdir}/so_locations -o $lib'
-    fi
-    hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir'
-    hardcode_libdir_separator=:
-    ;;
-
-  sco3.2v5*)
-    archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
-    hardcode_shlibpath_var=no
-    runpath_var=LD_RUN_PATH
-    hardcode_runpath_var=yes
-    ;;
-
-  solaris*)
-    no_undefined_flag=' -z text'
-    # $CC -shared without GNU ld will not create a library from C++
-    # object files and a static libstdc++, better avoid it by now
-    archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
-    archive_expsym_cmds='$echo "{ global:" > $lib.exp~cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~
-		$LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp'
-    hardcode_libdir_flag_spec='-R$libdir'
-    hardcode_shlibpath_var=no
-    case "$host_os" in
-    solaris2.[0-5] | solaris2.[0-5].*) ;;
-    *) # Supported since Solaris 2.6 (maybe 2.5.1?)
-      whole_archive_flag_spec='-z allextract$convenience -z defaultextract' ;;
-    esac
-    link_all_deplibs=yes
-    ;;
-
-  sunos4*)
-    archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags'
-    hardcode_libdir_flag_spec='-L$libdir'
-    hardcode_direct=yes
-    hardcode_minus_L=yes
-    hardcode_shlibpath_var=no
-    ;;
-
-  sysv4)
-    archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
-    runpath_var='LD_RUN_PATH'
-    hardcode_shlibpath_var=no
-    hardcode_direct=no #Motorola manual says yes, but my tests say they lie
-    ;;
-
-  sysv4.3*)
-    archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
-    hardcode_shlibpath_var=no
-    export_dynamic_flag_spec='-Bexport'
-    ;;
-
-  sysv5*)
-    no_undefined_flag=' -z text'
-    # $CC -shared without GNU ld will not create a library from C++
-    # object files and a static libstdc++, better avoid it by now
-    archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags'
-    archive_expsym_cmds='$echo "{ global:" > $lib.exp~cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $lib.exp~$echo "local: *; };" >> $lib.exp~
-		$LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$rm $lib.exp'
-    hardcode_libdir_flag_spec=
-    hardcode_shlibpath_var=no
-    runpath_var='LD_RUN_PATH'
-    ;;
-
-  uts4*)
-    archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
-    hardcode_libdir_flag_spec='-L$libdir'
-    hardcode_shlibpath_var=no
-    ;;
-
-  dgux*)
-    archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
-    hardcode_libdir_flag_spec='-L$libdir'
-    hardcode_shlibpath_var=no
-    ;;
-
-  sysv4*MP*)
-    if test -d /usr/nec; then
-      archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
-      hardcode_shlibpath_var=no
-      runpath_var=LD_RUN_PATH
-      hardcode_runpath_var=yes
-      ld_shlibs=yes
-    fi
-    ;;
-
-  sysv4.2uw2*)
-    archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags'
-    hardcode_direct=yes
-    hardcode_minus_L=no
-    hardcode_shlibpath_var=no
-    hardcode_runpath_var=yes
-    runpath_var=LD_RUN_PATH
-    ;;
-
-  unixware7*)
-    archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags'
-    runpath_var='LD_RUN_PATH'
-    hardcode_shlibpath_var=no
-    ;;
-
-  *)
-    ld_shlibs=no
-    ;;
-  esac
-fi
-echo "$ac_t$ld_shlibs" 1>&6
-test "$ld_shlibs" = no && can_build_shared=no
-
-# Check hardcoding attributes.
-echo $ac_n "checking how to hardcode library paths into programs... $ac_c" 1>&6
-hardcode_action=
-if test -n "$hardcode_libdir_flag_spec" || \
-   test -n "$runpath_var"; then
-
-  # We can hardcode non-existant directories.
-  if test "$hardcode_direct" != no &&
-     # If the only mechanism to avoid hardcoding is shlibpath_var, we
-     # have to relink, otherwise we might link with an installed library
-     # when we should be linking with a yet-to-be-installed one
-     ## test "$hardcode_shlibpath_var" != no &&
-     test "$hardcode_minus_L" != no; then
-    # Linking always hardcodes the temporary library directory.
-    hardcode_action=relink
-  else
-    # We can link without hardcoding, and we can hardcode nonexisting dirs.
-    hardcode_action=immediate
-  fi
-else
-  # We cannot hardcode anything, or else we can only hardcode existing
-  # directories.
-  hardcode_action=unsupported
-fi
-echo "$ac_t$hardcode_action" 1>&6
-
-echo $ac_n "checking whether stripping libraries is possible... $ac_c" 1>&6
-if test -n "$STRIP" && $STRIP -V 2>&1 | grep "GNU strip" >/dev/null; then
-  test -z "$old_striplib" && old_striplib="$STRIP --strip-debug"
-  test -z "$striplib" && striplib="$STRIP --strip-unneeded"
-  echo "${ac_t}yes" 1>&6
-else
-  echo "${ac_t}no" 1>&6
-fi
-
-reload_cmds='$LD$reload_flag -o $output$reload_objs'
-test -z "$deplibs_check_method" && deplibs_check_method=unknown
-
-# PORTME Fill in your ld.so characteristics
-library_names_spec=
-libname_spec='lib$name'
-soname_spec=
-postinstall_cmds=
-postuninstall_cmds=
-finish_cmds=
-finish_eval=
-shlibpath_var=
-shlibpath_overrides_runpath=unknown
-version_type=none
-dynamic_linker="$host_os ld.so"
-sys_lib_dlsearch_path_spec="/lib /usr/lib"
-sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib"
-
-echo $ac_n "checking dynamic linker characteristics... $ac_c" 1>&6
-case "$host_os" in
-aix3*)
-  version_type=linux
-  library_names_spec='${libname}${release}.so$versuffix $libname.a'
-  shlibpath_var=LIBPATH
-
-  # AIX has no versioning support, so we append a major version to the name.
-  soname_spec='${libname}${release}.so$major'
-  ;;
-
-aix4*)
-  version_type=linux
-  # AIX has no versioning support, so currently we can not hardcode correct
-  # soname into executable. Probably we can add versioning support to
-  # collect2, so additional links can be useful in future.
-  # We preserve .a as extension for shared libraries though AIX4.2
-  # and later linker supports .so
-  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.a'
-  shlibpath_var=LIBPATH
-  ;;
-
-amigaos*)
-  library_names_spec='$libname.ixlibrary $libname.a'
-  # Create ${libname}_ixlibrary.a entries in /sys/libs.
-  finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`$echo "X$lib" | $Xsed -e '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $rm /sys/libs/${libname}_ixlibrary.a; $show "(cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a)"; (cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a) || exit 1; done'
-  ;;
-
-beos*)
-  library_names_spec='${libname}.so'
-  dynamic_linker="$host_os ld.so"
-  shlibpath_var=LIBRARY_PATH
-  lt_cv_dlopen="load_add_on"
-  lt_cv_dlopen_libs=
-  lt_cv_dlopen_self=yes
-  ;;
-
-bsdi4*)
-  version_type=linux
-  need_version=no
-  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
-  soname_spec='${libname}${release}.so$major'
-  finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir'
-  shlibpath_var=LD_LIBRARY_PATH
-  sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib"
-  sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib"
-  export_dynamic_flag_spec=-rdynamic
-  # the default ld.so.conf also contains /usr/contrib/lib and
-  # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow
-  # libtool to hard-code these into programs
-  ;;
-
-cygwin* | mingw*)
-  version_type=windows
-  need_version=no
-  need_lib_prefix=no
-  if test "$with_gcc" = yes; then
-    library_names_spec='${libname}`echo ${release} | sed -e 's/[.]/-/g'`${versuffix}.dll'
-  else
-    library_names_spec='${libname}`echo ${release} | sed -e 's/[.]/-/g'`${versuffix}.dll $libname.lib'
-  fi
-  dynamic_linker='Win32 ld.exe'
-  # FIXME: first we should search . and the directory the executable is in
-  shlibpath_var=PATH
-  lt_cv_dlopen="LoadLibrary"
-  lt_cv_dlopen_libs=
-  ;;
-
-freebsd1*)
-  dynamic_linker=no
-  ;;
-
-freebsd*)
-  objformat=`test -x /usr/bin/objformat && /usr/bin/objformat || echo aout`
-  version_type=freebsd-$objformat
-  case "$version_type" in
-    freebsd-elf*)
-      library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so $libname.so'
-      need_version=no
-      need_lib_prefix=no
-      ;;
-    freebsd-*)
-      library_names_spec='${libname}${release}.so$versuffix $libname.so$versuffix'
-      need_version=yes
-      ;;
-  esac
-  shlibpath_var=LD_LIBRARY_PATH
-  case "$host_os" in
-  freebsd2*)
-    shlibpath_overrides_runpath=yes
-    ;;
-  freebsd3.[01]* | freebsdelf3.[01]*)
-    shlibpath_overrides_runpath=yes
-    hardcode_into_libs=yes
-    ;;
-  *) # from 3.2 on
-    shlibpath_overrides_runpath=no
-    hardcode_into_libs=yes
-    ;;
-  esac
-  ;;
-
-gnu*)
-  version_type=linux
-  need_lib_prefix=no
-  need_version=no
-  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so${major} ${libname}.so'
-  soname_spec='${libname}${release}.so$major'
-  shlibpath_var=LD_LIBRARY_PATH
-  hardcode_into_libs=yes
-  ;;
-
-hpux9* | hpux10* | hpux11*)
-  # Give a soname corresponding to the major version so that dld.sl refuses to
-  # link against other versions.
-  dynamic_linker="$host_os dld.sl"
-  version_type=sunos
-  need_lib_prefix=no
-  need_version=no
-  shlibpath_var=SHLIB_PATH
-  shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH
-  library_names_spec='${libname}${release}.sl$versuffix ${libname}${release}.sl$major $libname.sl'
-  soname_spec='${libname}${release}.sl$major'
-  # HP-UX runs *really* slowly unless shared libraries are mode 555.
-  postinstall_cmds='chmod 555 $lib'
-  ;;
-
-irix5* | irix6*)
-  version_type=irix
-  need_lib_prefix=no
-  need_version=no
-  soname_spec='${libname}${release}.so.$major'
-  library_names_spec='${libname}${release}.so.$versuffix ${libname}${release}.so.$major ${libname}${release}.so $libname.so'
-  case "$host_os" in
-  irix5*)
-    libsuff= shlibsuff=
-    ;;
-  *)
-    case "$LD" in # libtool.m4 will add one of these switches to LD
-    *-32|*"-32 ") libsuff= shlibsuff= libmagic=32-bit;;
-    *-n32|*"-n32 ") libsuff=32 shlibsuff=N32 libmagic=N32;;
-    *-64|*"-64 ") libsuff=64 shlibsuff=64 libmagic=64-bit;;
-    *) libsuff= shlibsuff= libmagic=never-match;;
-    esac
-    ;;
-  esac
-  shlibpath_var=LD_LIBRARY${shlibsuff}_PATH
-  shlibpath_overrides_runpath=no
-  sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}"
-  sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}"
-  ;;
-
-# No shared lib support for Linux oldld, aout, or coff.
-linux-gnuoldld* | linux-gnuaout* | linux-gnucoff*)
-  dynamic_linker=no
-  ;;
-
-# This must be Linux ELF.
-linux-gnu*)
-  version_type=linux
-  need_lib_prefix=no
-  need_version=no
-  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
-  soname_spec='${libname}${release}.so$major'
-  finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir'
-  shlibpath_var=LD_LIBRARY_PATH
-  shlibpath_overrides_runpath=no
-  # This implies no fast_install, which is unacceptable.
-  # Some rework will be needed to allow for fast_install
-  # before this can be enabled.
-  hardcode_into_libs=yes
-
-  if test -f /lib/ld.so.1; then
-    dynamic_linker='GNU ld.so'
-  else
-    # Only the GNU ld.so supports shared libraries on MkLinux.
-    case "$host_cpu" in
-    powerpc*) dynamic_linker=no ;;
-    *) dynamic_linker='Linux ld.so' ;;
-    esac
-  fi
-  ;;
-
-netbsd*)
-  version_type=sunos
-  if echo __ELF__ | $CC -E - | grep __ELF__ >/dev/null; then
-    library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
-    finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
-    dynamic_linker='NetBSD (a.out) ld.so'
-  else
-    library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major ${libname}${release}.so ${libname}.so'
-    soname_spec='${libname}${release}.so$major'
-    dynamic_linker='NetBSD ld.elf_so'
-  fi
-  shlibpath_var=LD_LIBRARY_PATH
-  ;;
-
-openbsd*)
-  version_type=sunos
-  if test "$with_gnu_ld" = yes; then
-    need_lib_prefix=no
-    need_version=no
-  fi
-  library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
-  finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir'
-  shlibpath_var=LD_LIBRARY_PATH
-  ;;
-
-os2*)
-  libname_spec='$name'
-  need_lib_prefix=no
-  library_names_spec='$libname.dll $libname.a'
-  dynamic_linker='OS/2 ld.exe'
-  shlibpath_var=LIBPATH
-  ;;
-
-osf3* | osf4* | osf5*)
-  version_type=osf
-  need_version=no
-  soname_spec='${libname}${release}.so'
-  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so $libname.so'
-  shlibpath_var=LD_LIBRARY_PATH
-  sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib"
-  sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec"
-  ;;
-
-sco3.2v5*)
-  version_type=osf
-  soname_spec='${libname}${release}.so$major'
-  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
-  shlibpath_var=LD_LIBRARY_PATH
-  ;;
-
-solaris*)
-  version_type=linux
-  need_lib_prefix=no
-  need_version=no
-  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
-  soname_spec='${libname}${release}.so$major'
-  shlibpath_var=LD_LIBRARY_PATH
-  shlibpath_overrides_runpath=yes
-  hardcode_into_libs=yes
-  # ldd complains unless libraries are executable
-  postinstall_cmds='chmod +x $lib'
-  ;;
-
-sunos4*)
-  version_type=sunos
-  library_names_spec='${libname}${release}.so$versuffix ${libname}.so$versuffix'
-  finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir'
-  shlibpath_var=LD_LIBRARY_PATH
-  shlibpath_overrides_runpath=yes
-  if test "$with_gnu_ld" = yes; then
-    need_lib_prefix=no
-  fi
-  need_version=yes
-  ;;
-
-sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*)
-  version_type=linux
-  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
-  soname_spec='${libname}${release}.so$major'
-  shlibpath_var=LD_LIBRARY_PATH
-  case "$host_vendor" in
-    motorola)
-      need_lib_prefix=no
-      need_version=no
-      shlibpath_overrides_runpath=no
-      sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib'
-      ;;
-  esac
-  ;;
-
-uts4*)
-  version_type=linux
-  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
-  soname_spec='${libname}${release}.so$major'
-  shlibpath_var=LD_LIBRARY_PATH
-  ;;
-
-dgux*)
-  version_type=linux
-  need_lib_prefix=no
-  need_version=no
-  library_names_spec='${libname}${release}.so$versuffix ${libname}${release}.so$major $libname.so'
-  soname_spec='${libname}${release}.so$major'
-  shlibpath_var=LD_LIBRARY_PATH
-  ;;
-
-sysv4*MP*)
-  if test -d /usr/nec ;then
-    version_type=linux
-    library_names_spec='$libname.so.$versuffix $libname.so.$major $libname.so'
-    soname_spec='$libname.so.$major'
-    shlibpath_var=LD_LIBRARY_PATH
-  fi
-  ;;
-
-*)
-  dynamic_linker=no
-  ;;
-esac
-echo "$ac_t$dynamic_linker" 1>&6
-test "$dynamic_linker" = no && can_build_shared=no
-
-# Check for command to grab the raw symbol name followed by C symbol from nm.
-echo $ac_n "checking command to parse $NM output... $ac_c" 1>&6
-
-# These are sane defaults that work on at least a few old systems.
-# [They come from Ultrix.  What could be older than Ultrix?!! ;)]
-
-# Character class describing NM global symbol codes.
-symcode='[BCDEGRST]'
-
-# Regexp to match symbols that can be accessed directly from C.
-sympat='\([_A-Za-z][_A-Za-z0-9]*\)'
-
-# Transform the above into a raw symbol and a C symbol.
-symxfrm='\1 \2\3 \3'
-
-# Transform an extracted symbol line into a proper C declaration
-global_symbol_to_cdecl="sed -n -e 's/^. .* \(.*\)$/extern char \1;/p'"
-
-# Define system-specific variables.
-case "$host_os" in
-aix*)
-  symcode='[BCDT]'
-  ;;
-cygwin* | mingw*)
-  symcode='[ABCDGISTW]'
-  ;;
-hpux*) # Its linker distinguishes data from code symbols
-  global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern char \1();/p' -e 's/^. .* \(.*\)$/extern char \1;/p'"
-  ;;
-irix*)
-  symcode='[BCDEGRST]'
-  ;;
-solaris* | sysv5*)
-  symcode='[BDT]'
-  ;;
-sysv4)
-  symcode='[DFNSTU]'
-  ;;
-esac
-
-# Handle CRLF in mingw too chain
-opt_cr=
-case "$host_os" in
-mingw*)
-  opt_cr=`echo 'x\{0,1\}' | tr x '\015'` # option cr in regexp
-  ;;
-esac
-
-# If we're using GNU nm, then use its standard symbol codes.
-if $NM -V 2>&1 | egrep '(GNU|with BFD)' > /dev/null; then
-  symcode='[ABCDGISTW]'
-fi
-
-# Try without a prefix undercore, then with it.
-for ac_symprfx in "" "_"; do
-
-  # Write the raw and C identifiers.
-global_symbol_pipe="sed -n -e 's/^.*[ 	]\($symcode\)[ 	][ 	]*\($ac_symprfx\)$sympat$opt_cr$/$symxfrm/p'"
-
-  # Check to see that the pipe works correctly.
-  pipe_works=no
-  $rm conftest*
-  cat > conftest.c <<EOF
-#ifdef __cplusplus
-extern "C" {
-#endif
-char nm_test_var;
-void nm_test_func(){}
-#ifdef __cplusplus
-}
-#endif
-main(){nm_test_var='a';nm_test_func();return(0);}
-EOF
-
-  echo "$progname:1867: checking if global_symbol_pipe works" >&5
-  if { (eval echo $progname:1868: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; } && test -s conftest.$objext; then
-    # Now try to grab the symbols.
-    nlist=conftest.nm
-    if { echo "$progname:1871: eval \"$NM conftest.$objext | $global_symbol_pipe > $nlist\"" >&5; eval "$NM conftest.$objext | $global_symbol_pipe > $nlist 2>&5"; } && test -s "$nlist"; then
-
-      # Try sorting and uniquifying the output.
-      if sort "$nlist" | uniq > "$nlist"T; then
-	mv -f "$nlist"T "$nlist"
-      else
-	rm -f "$nlist"T
-      fi
-
-      # Make sure that we snagged all the symbols we need.
-      if egrep ' nm_test_var$' "$nlist" >/dev/null; then
-	if egrep ' nm_test_func$' "$nlist" >/dev/null; then
-	  cat <<EOF > conftest.c
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-EOF
-	  # Now generate the symbol file.
-	  eval "$global_symbol_to_cdecl"' < "$nlist" >> conftest.c'
-
-	  cat <<EOF >> conftest.c
-#if defined (__STDC__) && __STDC__
-# define lt_ptr_t void *
-#else
-# define lt_ptr_t char *
-# define const
-#endif
-
-/* The mapping between symbol names and symbols. */
-const struct {
-  const char *name;
-  lt_ptr_t address;
-}
-lt_preloaded_symbols[] =
-{
-EOF
-	  sed 's/^. \(.*\) \(.*\)$/  {"\2", (lt_ptr_t) \&\2},/' < "$nlist" >> conftest.c
-	  cat <<\EOF >> conftest.c
-  {0, (lt_ptr_t) 0}
-};
-
-#ifdef __cplusplus
-}
-#endif
-EOF
-	  # Now try linking the two files.
-	  mv conftest.$objext conftstm.$objext
-	  save_LIBS="$LIBS"
-	  save_CFLAGS="$CFLAGS"
-	  LIBS="conftstm.$objext"
-	  CFLAGS="$CFLAGS$no_builtin_flag"
-	  if { (eval echo $progname:1923: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then
-	    pipe_works=yes
-	  else
-	    echo "$progname: failed program was:" >&5
-	    cat conftest.c >&5
-	  fi
-	  LIBS="$save_LIBS"
-	else
-	  echo "cannot find nm_test_func in $nlist" >&5
-	fi
-      else
-	echo "cannot find nm_test_var in $nlist" >&5
-      fi
-    else
-      echo "cannot run $global_symbol_pipe" >&5
-    fi
-  else
-    echo "$progname: failed program was:" >&5
-    cat conftest.c >&5
-  fi
-  $rm conftest* conftst*
-
-  # Do not use the global_symbol_pipe unless it works.
-  if test "$pipe_works" = yes; then
-    break
-  else
-    global_symbol_pipe=
-  fi
-done
-if test "$pipe_works" = yes; then
-  echo "${ac_t}ok" 1>&6
-else
-  echo "${ac_t}failed" 1>&6
-fi
-
-if test -z "$global_symbol_pipe"; then
-  global_symbol_to_cdecl=
-fi
-
-# Report the final consequences.
-echo "checking if libtool supports shared libraries... $can_build_shared" 1>&6
-
-# Only try to build win32 dlls if AC_LIBTOOL_WIN32_DLL was used in
-# configure.in, otherwise build static only libraries.
-case "$host_os" in
-cygwin* | mingw* | os2*)
-  if test x$can_build_shared = xyes; then
-    test x$enable_win32_dll = xno && can_build_shared=no
-    echo "checking if package supports dlls... $can_build_shared" 1>&6
-  fi
-;;
-esac
-
-echo $ac_n "checking whether to build shared libraries... $ac_c" 1>&6
-test "$can_build_shared" = "no" && enable_shared=no
-
-# On AIX, shared libraries and static libraries use the same namespace, and
-# are all built from PIC.
-case "$host_os" in
-aix3*)
-  test "$enable_shared" = yes && enable_static=no
-  if test -n "$RANLIB"; then
-    archive_cmds="$archive_cmds~\$RANLIB \$lib"
-    postinstall_cmds='$RANLIB $lib'
-  fi
-  ;;
-
-aix4*)
-  test "$enable_shared" = yes && enable_static=no
-  ;;
-esac
-
-echo "$ac_t$enable_shared" 1>&6
-
-# Make sure either enable_shared or enable_static is yes.
-test "$enable_shared" = yes || enable_static=yes
-
-echo "checking whether to build static libraries... $enable_static" 1>&6
-
-if test "$hardcode_action" = relink || test "$hardcode_into_libs" = all; then
-  # Fast installation is not supported
-  enable_fast_install=no
-elif test "$shlibpath_overrides_runpath" = yes ||
-     test "$enable_shared" = no; then
-  # Fast installation is not necessary
-  enable_fast_install=needless
-fi
-
-# Check whether we must set pic_mode to default
-test -z "$pic_flag" && pic_mode=default
-# On Cygwin there's no "real" PIC flag so we must build both object types
-case "$host_os" in
-cygwin* | mingw* | os2*)
-  pic_mode=default
-  ;;
-esac
-if test $pic_mode = no && test "$deplibs_check_method" != pass_all; then
-  # non-PIC code in shared libraries is not supported
-  pic_mode=default
-fi
-
-if test "x$enable_dlopen" != xyes; then
-  enable_dlopen=unknown
-  enable_dlopen_self=unknown
-  enable_dlopen_self_static=unknown
-else
-if test "X${lt_cv_dlopen+set}" != Xset; then
-  lt_cv_dlopen=no lt_cv_dlopen_libs=
-echo $ac_n "checking for dlopen in -ldl""... $ac_c" 1>&6
-echo "$progname:2032: checking for dlopen in -ldl" >&5
-if test "X${ac_cv_lib_dl_dlopen+set}" = Xset; then
-  echo $ac_n "(cached) $ac_c" 1>&6
-else
-  ac_save_LIBS="$LIBS"
-LIBS="-ldl  $LIBS"
-cat > conftest.$ac_ext <<EOF
-#line 2039 "ltconfig"
-/* Override any gcc2 internal prototype to avoid an error.  */
-/* We use char because int might match the return type of a gcc2
-    builtin and then its argument prototype would still apply.  */
-#ifdef __cplusplus
-extern "C"
-#endif
-char dlopen();
-
-int main() {
-dlopen()
-; return 0; }
-EOF
-if { (eval echo $progname:2052: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  rm -rf conftest*
-  ac_cv_lib_dl_dlopen=yes
-else
-  echo "$progname: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  ac_cv_lib_dl_dlopen=no
-fi
-rm -f conftest*
-LIBS="$ac_save_LIBS"
-
-fi
-if test "X$ac_cv_lib_dl_dlopen" = Xyes; then
-  echo "$ac_t""yes" 1>&6
-  lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl"
-else
-  echo "$ac_t""no" 1>&6
-echo $ac_n "checking for dlopen""... $ac_c" 1>&6
-echo "$progname:2071: checking for dlopen" >&5
-if test "X${ac_cv_func_dlopen+set}" = Xset; then
-  echo $ac_n "(cached) $ac_c" 1>&6
-else
-  cat > conftest.$ac_ext <<EOF
-#line 2076 "ltconfig"
-/* System header to define __stub macros and hopefully few prototypes,
-    which can conflict with char dlopen(); below.  */
-#include <assert.h>
-/* Override any gcc2 internal prototype to avoid an error.  */
-/* We use char because int might match the return type of a gcc2
-    builtin and then its argument prototype would still apply.  */
-#ifdef __cplusplus
-extern "C"
-#endif
-char dlopen();
-
-int main() {
-
-/* The GNU C library defines this for functions which it implements
-    to always fail with ENOSYS.  Some functions are actually named
-    something starting with __ and the normal name is an alias.  */
-#if defined (__stub_dlopen) || defined (__stub___dlopen)
-choke me
-#else
-dlopen();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo $progname:2101: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  rm -rf conftest*
-  ac_cv_func_dlopen=yes
-else
-  echo "$progname: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  ac_cv_func_dlopen=no
-fi
-rm -f conftest*
-fi
-if test "X$ac_cv_func_dlopen" = Xyes; then
-  echo "$ac_t""yes" 1>&6
-  lt_cv_dlopen="dlopen"
-else
-  echo "$ac_t""no" 1>&6
-echo $ac_n "checking for dld_link in -ldld""... $ac_c" 1>&6
-echo "$progname:2118: checking for dld_link in -ldld" >&5
-if test "X${ac_cv_lib_dld_dld_link+set}" = Xset; then
-  echo $ac_n "(cached) $ac_c" 1>&6
-else
-  ac_save_LIBS="$LIBS"
-LIBS="-ldld  $LIBS"
-cat > conftest.$ac_ext <<EOF
-#line 2125 "ltconfig"
-/* Override any gcc2 internal prototype to avoid an error.  */
-/* We use char because int might match the return type of a gcc2
-    builtin and then its argument prototype would still apply.  */
-#ifdef __cplusplus
-extern "C"
-#endif
-char dld_link();
-
-int main() {
-dld_link()
-; return 0; }
-EOF
-if { (eval echo $progname:2138: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  rm -rf conftest*
-  ac_cv_lib_dld_dld_link=yes
-else
-  echo "$progname: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  ac_cv_lib_dld_dld_link=no
-fi
-rm -f conftest*
-LIBS="$ac_save_LIBS"
-
-fi
-if test "X$ac_cv_lib_dld_dld_link" = Xyes; then
-  echo "$ac_t""yes" 1>&6
-  lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-ldld"
-else
-  echo "$ac_t""no" 1>&6
-echo $ac_n "checking for shl_load""... $ac_c" 1>&6
-echo "$progname:2157: checking for shl_load" >&5
-if test "X${ac_cv_func_shl_load+set}" = Xset; then
-  echo $ac_n "(cached) $ac_c" 1>&6
-else
-  cat > conftest.$ac_ext <<EOF
-#line 2162 "ltconfig"
-/* System header to define __stub macros and hopefully few prototypes,
-    which can conflict with char shl_load(); below.  */
-#include <assert.h>
-/* Override any gcc2 internal prototype to avoid an error.  */
-/* We use char because int might match the return type of a gcc2
-    builtin and then its argument prototype would still apply.  */
-#ifdef __cplusplus
-extern "C"
-#endif
-char shl_load();
-
-int main() {
-
-/* The GNU C library defines this for functions which it implements
-    to always fail with ENOSYS.  Some functions are actually named
-    something starting with __ and the normal name is an alias.  */
-#if defined (__stub_shl_load) || defined (__stub___shl_load)
-choke me
-#else
-shl_load();
-#endif
-
-; return 0; }
-EOF
-if { (eval echo $progname:2187: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  rm -rf conftest*
-  ac_cv_func_shl_load=yes
-else
-  echo "$progname: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  ac_cv_func_shl_load=no
-fi
-rm -f conftest*
-fi
-
-if test "X$ac_cv_func_shl_load" = Xyes; then
-  echo "$ac_t""yes" 1>&6
-  lt_cv_dlopen="shl_load"
-else
-  echo "$ac_t""no" 1>&6
-echo $ac_n "checking for shl_load in -ldld""... $ac_c" 1>&6
-echo "$progname:2205: checking for shl_load in -ldld" >&5
-if test "X${ac_cv_lib_dld_shl_load+set}" = Xset; then
-  echo $ac_n "(cached) $ac_c" 1>&6
-else
-  ac_save_LIBS="$LIBS"
-LIBS="-ldld  $LIBS"
-cat > conftest.$ac_ext <<EOF
-#line 2212 "ltconfig"
-#include "confdefs.h"
-/* Override any gcc2 internal prototype to avoid an error.  */
-/* We use char because int might match the return type of a gcc2
-    builtin and then its argument prototype would still apply.  */
-#ifdef __cplusplus
-extern "C"
-#endif
-char shl_load();
-
-int main() {
-shl_load()
-; return 0; }
-EOF
-if { (eval echo $progname:2226: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
-  rm -rf conftest*
-  ac_cv_lib_dld_shl_load=yes
-else
-  echo "$progname: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  ac_cv_lib_dld_shl_load=no
-fi
-rm -f conftest*
-LIBS="$ac_save_LIBS"
-
-fi
-if test "X$ac_cv_lib_dld_shl_load" = Xyes; then
-  echo "$ac_t""yes" 1>&6
-  lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-ldld"
-else
-  echo "$ac_t""no" 1>&6
-fi
-
-
-fi
-
-
-fi
-
-
-fi
-
-
-fi
-
-fi
-
-  if test "x$lt_cv_dlopen" != xno; then
-    enable_dlopen=yes
-  fi
-
-  case "$lt_cv_dlopen" in
-  dlopen)
-for ac_hdr in dlfcn.h; do
-ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
-echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
-echo "$progname:2269: checking for $ac_hdr" >&5
-if eval "test \"`echo 'X$''{'ac_cv_header_$ac_safe'+set}'`\" = Xset"; then
-  echo $ac_n "(cached) $ac_c" 1>&6
-else
-  cat > conftest.$ac_ext <<EOF
-#line 2274 "ltconfig"
-#include <$ac_hdr>
-int fnord = 0;
-int main () { }
-EOF
-ac_try="$ac_compile >/dev/null 2>conftest.out"
-{ (eval echo $progname:2280: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
-ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
-if test -z "$ac_err"; then
-  rm -rf conftest*
-  eval "ac_cv_header_$ac_safe=yes"
-else
-  echo "$ac_err" >&5
-  echo "$progname: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -rf conftest*
-  eval "ac_cv_header_$ac_safe=no"
-fi
-rm -f conftest*
-fi
-if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
-  echo "$ac_t""yes" 1>&6
-else
-  echo "$ac_t""no" 1>&6
-fi
-done
-
-    if test "x$ac_cv_header_dlfcn_h" = xyes; then
-      CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H"
-    fi
-    eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\"
-    LIBS="$lt_cv_dlopen_libs $LIBS"
-
-  echo $ac_n "checking whether a program can dlopen itself""... $ac_c" 1>&6
-echo "$progname:2308: checking whether a program can dlopen itself" >&5
-if test "X${lt_cv_dlopen_self+set}" = Xset; then
-  echo $ac_n "(cached) $ac_c" 1>&6
-else
-  if test "$cross_compiling" = yes; then
-    lt_cv_dlopen_self=cross
-  else
-    cat > conftest.c <<EOF
-#line 2316 "ltconfig"
-
-#if HAVE_DLFCN_H
-#include <dlfcn.h>
-#endif
-
-#include <stdio.h>
-
-#ifdef RTLD_GLOBAL
-# define LTDL_GLOBAL	RTLD_GLOBAL
-#else
-# ifdef DL_GLOBAL
-#  define LTDL_GLOBAL	DL_GLOBAL
-# else
-#  define LTDL_GLOBAL	0
-# endif
-#endif
-
-/* We may have to define LTDL_LAZY_OR_NOW in the command line if we
-   find out it does not work in some platform. */
-#ifndef LTDL_LAZY_OR_NOW
-# ifdef RTLD_LAZY
-#  define LTDL_LAZY_OR_NOW	RTLD_LAZY
-# else
-#  ifdef DL_LAZY
-#   define LTDL_LAZY_OR_NOW	DL_LAZY
-#  else
-#   ifdef RTLD_NOW
-#    define LTDL_LAZY_OR_NOW	RTLD_NOW
-#   else
-#    ifdef DL_NOW
-#     define LTDL_LAZY_OR_NOW	DL_NOW
-#    else
-#     define LTDL_LAZY_OR_NOW	0
-#    endif
-#   endif
-#  endif
-# endif
-#endif
-
-fnord() { int i=42;}
-main() { void *self, *ptr1, *ptr2; self=dlopen(0,LTDL_GLOBAL|LTDL_LAZY_OR_NOW);
-    if(self) { ptr1=dlsym(self,"fnord"); ptr2=dlsym(self,"_fnord");
-	       if(ptr1 || ptr2) { dlclose(self); exit(0); } } exit(1); }
-
-EOF
-if { (eval echo $progname:2362: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
-then
-  lt_cv_dlopen_self=yes
-else
-  echo "$progname: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -fr conftest*
-  lt_cv_dlopen_self=no
-fi
-rm -fr conftest*
-fi
-
-fi
-
-echo "$ac_t""$lt_cv_dlopen_self" 1>&6
-
-  if test "$lt_cv_dlopen_self" = yes; then
-    LDFLAGS="$LDFLAGS $link_static_flag"
-  echo $ac_n "checking whether a statically linked program can dlopen itself""... $ac_c" 1>&6
-echo "$progname:2381: checking whether a statically linked program can dlopen itself" >&5
-if test "X${lt_cv_dlopen_self_static+set}" = Xset; then
-  echo $ac_n "(cached) $ac_c" 1>&6
-else
-  if test "$cross_compiling" = yes; then
-    lt_cv_dlopen_self_static=cross
-  else
-    cat > conftest.c <<EOF
-#line 2389 "ltconfig"
-
-#if HAVE_DLFCN_H
-#include <dlfcn.h>
-#endif
-
-#include <stdio.h>
-
-#ifdef RTLD_GLOBAL
-# define LTDL_GLOBAL	RTLD_GLOBAL
-#else
-# ifdef DL_GLOBAL
-#  define LTDL_GLOBAL	DL_GLOBAL
-# else
-#  define LTDL_GLOBAL	0
-# endif
-#endif
-
-/* We may have to define LTDL_LAZY_OR_NOW in the command line if we
-   find out it does not work in some platform. */
-#ifndef LTDL_LAZY_OR_NOW
-# ifdef RTLD_LAZY
-#  define LTDL_LAZY_OR_NOW	RTLD_LAZY
-# else
-#  ifdef DL_LAZY
-#   define LTDL_LAZY_OR_NOW	DL_LAZY
-#  else
-#   ifdef RTLD_NOW
-#    define LTDL_LAZY_OR_NOW	RTLD_NOW
-#   else
-#    ifdef DL_NOW
-#     define LTDL_LAZY_OR_NOW	DL_NOW
-#    else
-#     define LTDL_LAZY_OR_NOW	0
-#    endif
-#   endif
-#  endif
-# endif
-#endif
-
-fnord() { int i=42;}
-main() { void *self, *ptr1, *ptr2; self=dlopen(0,LTDL_GLOBAL|LTDL_LAZY_OR_NOW);
-    if(self) { ptr1=dlsym(self,"fnord"); ptr2=dlsym(self,"_fnord");
-    if(ptr1 || ptr2) { dlclose(self); exit(0); } } exit(1); }
-
-EOF
-if { (eval echo $progname:2435: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>/dev/null
-then
-  lt_cv_dlopen_self_static=yes
-else
-  echo "$progname: failed program was:" >&5
-  cat conftest.$ac_ext >&5
-  rm -fr conftest*
-  lt_cv_dlopen_self_static=no
-fi
-rm -fr conftest*
-fi
-
-fi
-
-echo "$ac_t""$lt_cv_dlopen_self_static" 1>&6
-fi
-    ;;
-  esac
-
-  case "$lt_cv_dlopen_self" in
-  yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;;
-  *) enable_dlopen_self=unknown ;;
-  esac
-
-  case "$lt_cv_dlopen_self_static" in
-  yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;;
-  *) enable_dlopen_self_static=unknown ;;
-  esac
-fi
-
-# Copy echo and quote the copy, instead of the original, because it is
-# used later.
-ltecho="$echo"
-if test "X$ltecho" = "X$CONFIG_SHELL $0 --fallback-echo"; then
-   ltecho="$CONFIG_SHELL \$0 --fallback-echo"
-fi
-LTSHELL="$SHELL"
-
-LTCONFIG_VERSION="$VERSION"
-
-# Only quote variables if we're using ltmain.sh.
-case "$ltmain" in
-*.sh)
-  # Now quote all the things that may contain metacharacters.
-  for var in ltecho old_AR old_CC old_CFLAGS old_CPPFLAGS \
-    old_MAGIC old_LD old_LDFLAGS old_LIBS \
-    old_LN_S old_NM old_RANLIB old_STRIP \
-    old_AS old_DLLTOOL old_OBJDUMP \
-    old_OBJEXT old_EXEEXT old_reload_flag \
-    old_deplibs_check_method old_file_magic_cmd \
-    AR CC LD LN_S NM LTSHELL LTCONFIG_VERSION \
-    reload_flag reload_cmds wl \
-    pic_flag link_static_flag no_builtin_flag export_dynamic_flag_spec \
-    thread_safe_flag_spec whole_archive_flag_spec libname_spec \
-    library_names_spec soname_spec \
-    RANLIB old_archive_cmds old_archive_from_new_cmds old_postinstall_cmds \
-    old_postuninstall_cmds archive_cmds archive_expsym_cmds postinstall_cmds \
-    postuninstall_cmds extract_expsyms_cmds old_archive_from_expsyms_cmds \
-    old_striplib striplib file_magic_cmd export_symbols_cmds \
-    deplibs_check_method allow_undefined_flag no_undefined_flag \
-    finish_cmds finish_eval global_symbol_pipe global_symbol_to_cdecl \
-    hardcode_libdir_flag_spec hardcode_libdir_separator  \
-    sys_lib_search_path_spec sys_lib_dlsearch_path_spec \
-    compiler_c_o compiler_o_lo need_locks exclude_expsyms include_expsyms; do
-
-    case "$var" in
-    reload_cmds | old_archive_cmds | old_archive_from_new_cmds | \
-    old_postinstall_cmds | old_postuninstall_cmds | \
-    export_symbols_cmds | archive_cmds | archive_expsym_cmds | \
-    extract_expsyms_cmds | old_archive_from_expsyms_cmds | \
-    postinstall_cmds | postuninstall_cmds | \
-    finish_cmds | sys_lib_search_path_spec | sys_lib_dlsearch_path_spec)
-      # Double-quote double-evaled strings.
-      eval "$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$double_quote_subst\" -e \"\$sed_quote_subst\" -e \"\$delay_variable_subst\"\`\\\"" ### testsuite: skip nested quoting test
-      ;;
-    *)
-      eval "$var=\\\"\`\$echo \"X\$$var\" | \$Xsed -e \"\$sed_quote_subst\"\`\\\"" ### testsuite: skip nested quoting test
-      ;;
-    esac
-  done
-
-  case "$ltecho" in
-  *'\$0 --fallback-echo"')
-    ltecho=`$echo "X$ltecho" | $Xsed -e 's/\\\\\\\$0 --fallback-echo"$/$0 --fallback-echo"/'`
-    ;;
-  esac
-
-  trap "$rm \"$ofile\"; exit 1" 1 2 15
-  echo "creating $ofile"
-  $rm "$ofile"
-  cat <<EOF > "$ofile"
-#! $SHELL
-
-# `$echo "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services.
-# Generated automatically by $PROGRAM (GNU $PACKAGE $VERSION$TIMESTAMP)
-# NOTE: Changes made to this file will be lost: look at ltconfig or ltmain.sh.
-#
-# Copyright (C) 1996-2000 Free Software Foundation, Inc.
-# Originally by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
-
-# Sed that helps us avoid accidentally triggering echo(1) options like -n.
-Xsed="sed -e s/^X//"
-
-# The HP-UX ksh and POSIX shell print the target directory to stdout
-# if CDPATH is set.
-if test "X\${CDPATH+set}" = Xset; then CDPATH=:; export CDPATH; fi
-
-### BEGIN LIBTOOL CONFIG
-EOF
-  cfgfile="$ofile"
-  ;;
-
-*)
-  # Double-quote the variables that need it (for aesthetics).
-  for var in old_AR old_CC old_CFLAGS old_CPPFLAGS \
-    old_MAGIC old_LD old_LDFLAGS old_LIBS \
-    old_LN_S old_NM old_RANLIB old_STRIP \
-    old_AS old_DLLTOOL old_OBJDUMP \
-    old_OBJEXT old_EXEEXT old_reload_flag \
-    old_deplibs_check_method old_file_magic_cmd; do
-    eval "$var=\\\"\$var\\\""
-  done
-
-  # Just create a config file.
-  cfgfile="$ofile.cfg"
-  trap "$rm \"$cfgfile\"; exit 1" 1 2 15
-  echo "creating $cfgfile"
-  $rm "$cfgfile"
-  cat <<EOF > "$cfgfile"
-# `$echo "$cfgfile" | sed 's%^.*/%%'` - Libtool configuration file.
-# Generated automatically by $PROGRAM (GNU $PACKAGE $VERSION$TIMESTAMP)
-EOF
-  ;;
-esac
-
-cat <<EOF >> "$cfgfile"
-# Libtool was configured as follows, on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
-#
-# AR=$old_AR CC=$old_CC CFLAGS=$old_CFLAGS CPPFLAGS=$old_CPPFLAGS \\
-# MAGIC=$old_MAGIC LD=$old_LD LDFLAGS=$old_LDFLAGS LIBS=$old_LIBS \\
-# LN_S=$old_LN_S NM=$old_NM RANLIB=$old_RANLIB STRIP=$old_STRIP \\
-# AS=$old_AS DLLTOOL=$old_DLLTOOL OBJDUMP=$old_OBJDUMP \\
-# objext=$old_OBJEXT exeext=$old_EXEEXT reload_flag=$old_reload_flag \\
-# deplibs_check_method=$old_deplibs_check_method file_magic_cmd=$old_file_magic_cmd \\
-#   $0$ltconfig_args
-#
-# Compiler and other test output produced by $progname, useful for
-# debugging $progname, is in ./config.log if it exists.
-# The version of $progname that generated this script.
-LTCONFIG_VERSION=$LTCONFIG_VERSION
-
-# Shell to use when invoking shell scripts.
-SHELL=$LTSHELL
-
-# Whether or not to build shared libraries.
-build_libtool_libs=$enable_shared
-
-# Whether or not to build static libraries.
-build_old_libs=$enable_static
-
-# Whether or not to optimize for fast installation.
-fast_install=$enable_fast_install
-
-# The host system.
-host_alias=$host_alias
-host=$host
-
-# An echo program that does not interpret backslashes.
-echo=$ltecho
-
-# The archiver.
-AR=$AR
-
-# The default C compiler.
-CC=$CC
-
-# The linker used to build libraries.
-LD=$LD
-
-# Whether we need hard or soft links.
-LN_S=$LN_S
-
-# A BSD-compatible nm program.
-NM=$NM
-
-# A symbol stripping program
-STRIP=$STRIP
-
-# Used to examine libraries when file_magic_cmd begins "file"
-MAGIC=$MAGIC
-
-# Used on cygwin: DLL creation program.
-DLLTOOL="$DLLTOOL"
-
-# Used on cygwin: object dumper.
-OBJDUMP="$OBJDUMP"
-
-# Used on cygwin: assembler.
-AS="$AS"
-
-# The name of the directory that contains temporary libtool files.
-objdir=$objdir
-
-# How to create reloadable object files.
-reload_flag=$reload_flag
-reload_cmds=$reload_cmds
-
-# How to pass a linker flag through the compiler.
-wl=$wl
-
-# Object file suffix (normally "o").
-objext="$objext"
-
-# Old archive suffix (normally "a").
-libext="$libext"
-
-# Executable file suffix (normally "").
-exeext="$exeext"
-
-# Additional compiler flags for building library objects.
-pic_flag=$pic_flag
-pic_mode=$pic_mode
-
-# Does compiler simultaneously support -c and -o options?
-compiler_c_o=$compiler_c_o
-
-# Can we write directly to a .lo ?
-compiler_o_lo=$compiler_o_lo
-
-# Must we lock files when doing compilation ?
-need_locks=$need_locks
-
-# Do we need the lib prefix for modules?
-need_lib_prefix=$need_lib_prefix
-
-# Do we need a version for libraries?
-need_version=$need_version
-
-# Whether dlopen is supported.
-dlopen_support=$enable_dlopen
-
-# Whether dlopen of programs is supported.
-dlopen_self=$enable_dlopen_self
-
-# Whether dlopen of statically linked programs is supported.
-dlopen_self_static=$enable_dlopen_self_static
-
-# Compiler flag to prevent dynamic linking.
-link_static_flag=$link_static_flag
-
-# Compiler flag to turn off builtin functions.
-no_builtin_flag=$no_builtin_flag
-
-# Compiler flag to allow reflexive dlopens.
-export_dynamic_flag_spec=$export_dynamic_flag_spec
-
-# Compiler flag to generate shared objects directly from archives.
-whole_archive_flag_spec=$whole_archive_flag_spec
-
-# Compiler flag to generate thread-safe objects.
-thread_safe_flag_spec=$thread_safe_flag_spec
-
-# Library versioning type.
-version_type=$version_type
-
-# Format of library name prefix.
-libname_spec=$libname_spec
-
-# List of archive names.  First name is the real one, the rest are links.
-# The last name is the one that the linker finds with -lNAME.
-library_names_spec=$library_names_spec
-
-# The coded name of the library, if different from the real name.
-soname_spec=$soname_spec
-
-# Commands used to build and install an old-style archive.
-RANLIB=$RANLIB
-old_archive_cmds=$old_archive_cmds
-old_postinstall_cmds=$old_postinstall_cmds
-old_postuninstall_cmds=$old_postuninstall_cmds
-
-# Create an old-style archive from a shared archive.
-old_archive_from_new_cmds=$old_archive_from_new_cmds
-
-# Create a temporary old-style archive to link instead of a shared archive.
-old_archive_from_expsyms_cmds=$old_archive_from_expsyms_cmds
-
-# Commands used to build and install a shared archive.
-archive_cmds=$archive_cmds
-archive_expsym_cmds=$archive_expsym_cmds
-postinstall_cmds=$postinstall_cmds
-postuninstall_cmds=$postuninstall_cmds
-
-# Commands to strip libraries.
-old_striplib=$old_striplib
-striplib=$striplib
-
-# Method to check whether dependent libraries are shared objects.
-deplibs_check_method=$deplibs_check_method
-
-# Command to use when deplibs_check_method == file_magic.
-file_magic_cmd=$file_magic_cmd
-
-# Flag that allows shared libraries with undefined symbols to be built.
-allow_undefined_flag=$allow_undefined_flag
-
-# Flag that forces no undefined symbols.
-no_undefined_flag=$no_undefined_flag
-
-# Commands used to finish a libtool library installation in a directory.
-finish_cmds=$finish_cmds
-
-# Same as above, but a single script fragment to be evaled but not shown.
-finish_eval=$finish_eval
-
-# Take the output of nm and produce a listing of raw symbols and C names.
-global_symbol_pipe=$global_symbol_pipe
-
-# Transform the output of nm in a proper C declaration
-global_symbol_to_cdecl=$global_symbol_to_cdecl
-
-# This is the shared library runtime path variable.
-runpath_var=$runpath_var
-
-# This is the shared library path variable.
-shlibpath_var=$shlibpath_var
-
-# Is shlibpath searched before the hard-coded library search path?
-shlibpath_overrides_runpath=$shlibpath_overrides_runpath
-
-# How to hardcode a shared library path into an executable.
-hardcode_action=$hardcode_action
-
-# Whether we should hardcode library paths into libraries.
-hardcode_into_libs=$hardcode_into_libs
-
-# Flag to hardcode \$libdir into a binary during linking.
-# This must work even if \$libdir does not exist.
-hardcode_libdir_flag_spec=$hardcode_libdir_flag_spec
-
-# Whether we need a single -rpath flag with a separated argument.
-hardcode_libdir_separator=$hardcode_libdir_separator
-
-# Set to yes if using DIR/libNAME.so during linking hardcodes DIR into the
-# resulting binary.
-hardcode_direct=$hardcode_direct
-
-# Set to yes if using the -LDIR flag during linking hardcodes DIR into the
-# resulting binary.
-hardcode_minus_L=$hardcode_minus_L
-
-# Set to yes if using SHLIBPATH_VAR=DIR during linking hardcodes DIR into
-# the resulting binary.
-hardcode_shlibpath_var=$hardcode_shlibpath_var
-
-# Whether libtool must link a program against all its dependency libraries.
-link_all_deplibs=$link_all_deplibs
-
-# Compile-time system search path for libraries
-sys_lib_search_path_spec=$sys_lib_search_path_spec
-
-# Run-time system search path for libraries
-sys_lib_dlsearch_path_spec=$sys_lib_dlsearch_path_spec
-
-# Fix the shell variable \$srcfile for the compiler.
-fix_srcfile_path="$fix_srcfile_path"
-
-# Set to yes if exported symbols are required.
-always_export_symbols=$always_export_symbols
-
-# The commands to list exported symbols.
-export_symbols_cmds=$export_symbols_cmds
-
-# The commands to extract the exported symbol list from a shared archive.
-extract_expsyms_cmds=$extract_expsyms_cmds
-
-# Symbols that should not be listed in the preloaded symbols.
-exclude_expsyms=$exclude_expsyms
-
-# Symbols that must always be exported.
-include_expsyms=$include_expsyms
-
-EOF
-
-case "$ltmain" in
-*.sh)
-  echo '### END LIBTOOL CONFIG' >> "$ofile"
-  echo >> "$ofile"
-  case "$host_os" in
-  aix3*)
-    cat <<\EOF >> "$ofile"
-
-# AIX sometimes has problems with the GCC collect2 program.  For some
-# reason, if we set the COLLECT_NAMES environment variable, the problems
-# vanish in a puff of smoke.
-if test "X${COLLECT_NAMES+set}" != Xset; then
-  COLLECT_NAMES=
-  export COLLECT_NAMES
-fi
-EOF
-    ;;
-  esac
-  case "$host" in
-  *-*-cygwin* | *-*-mingw* | *-*-os2*)
-    cat <<'EOF' >> "$ofile"
-      # This is a source program that is used to create dlls on Windows
-      # Don't remove nor modify the starting and closing comments
-# /* ltdll.c starts here */
-# #define WIN32_LEAN_AND_MEAN
-# #include <windows.h>
-# #undef WIN32_LEAN_AND_MEAN
-# #include <stdio.h>
-#
-# #ifndef __CYGWIN__
-# #  ifdef __CYGWIN32__
-# #    define __CYGWIN__ __CYGWIN32__
-# #  endif
-# #endif
-#
-# #ifdef __cplusplus
-# extern "C" {
-# #endif
-# BOOL APIENTRY DllMain (HINSTANCE hInst, DWORD reason, LPVOID reserved);
-# #ifdef __cplusplus
-# }
-# #endif
-#
-# #ifdef __CYGWIN__
-# #include <cygwin/cygwin_dll.h>
-# DECLARE_CYGWIN_DLL( DllMain );
-# #endif
-# HINSTANCE __hDllInstance_base;
-#
-# BOOL APIENTRY
-# DllMain (HINSTANCE hInst, DWORD reason, LPVOID reserved)
-# {
-#   __hDllInstance_base = hInst;
-#   return TRUE;
-# }
-# /* ltdll.c ends here */
-      # This is a source program that is used to create import libraries
-      # on Windows for dlls which lack them. Don't remove nor modify the
-      # starting and closing comments
-# /* impgen.c starts here */
-# /*   Copyright (C) 1999-2000 Free Software Foundation, Inc.
-#
-#  This file is part of GNU libtool.
-#
-#  This program is free software; you can redistribute it and/or modify
-#  it under the terms of the GNU General Public License as published by
-#  the Free Software Foundation; either version 2 of the License, or
-#  (at your option) any later version.
-#
-#  This program is distributed in the hope that it will be useful,
-#  but WITHOUT ANY WARRANTY; without even the implied warranty of
-#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-#  GNU General Public License for more details.
-#
-#  You should have received a copy of the GNU General Public License
-#  along with this program; if not, write to the Free Software
-#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#  */
-#
-#  #include <stdio.h>		/* for printf() */
-#  #include <unistd.h>		/* for open(), lseek(), read() */
-#  #include <fcntl.h>		/* for O_RDONLY, O_BINARY */
-#  #include <string.h>		/* for strdup() */
-#
-#  /* O_BINARY isn't required (or even defined sometimes) under Unix */
-#  #ifndef O_BINARY
-#  #define O_BINARY 0
-#  #endif
-#
-#  static unsigned int
-#  pe_get16 (fd, offset)
-#       int fd;
-#       int offset;
-#  {
-#    unsigned char b[2];
-#    lseek (fd, offset, SEEK_SET);
-#    read (fd, b, 2);
-#    return b[0] + (b[1]<<8);
-#  }
-#
-#  static unsigned int
-#  pe_get32 (fd, offset)
-#      int fd;
-#      int offset;
-#  {
-#    unsigned char b[4];
-#    lseek (fd, offset, SEEK_SET);
-#    read (fd, b, 4);
-#    return b[0] + (b[1]<<8) + (b[2]<<16) + (b[3]<<24);
-#  }
-#
-#  static unsigned int
-#  pe_as32 (ptr)
-#       void *ptr;
-#  {
-#    unsigned char *b = ptr;
-#    return b[0] + (b[1]<<8) + (b[2]<<16) + (b[3]<<24);
-#  }
-#
-#  int
-#  main (argc, argv)
-#      int argc;
-#      char *argv[];
-#  {
-#      int dll;
-#      unsigned long pe_header_offset, opthdr_ofs, num_entries, i;
-#      unsigned long export_rva, export_size, nsections, secptr, expptr;
-#      unsigned long name_rvas, nexp;
-#      unsigned char *expdata, *erva;
-#      char *filename, *dll_name;
-#
-#      filename = argv[1];
-#
-#      dll = open(filename, O_RDONLY|O_BINARY);
-#      if (!dll)
-#  	return 1;
-#
-#      dll_name = filename;
-#
-#      for (i=0; filename[i]; i++)
-#  	if (filename[i] == '/' || filename[i] == '\\'  || filename[i] == ':')
-#  	    dll_name = filename + i +1;
-#
-#      pe_header_offset = pe_get32 (dll, 0x3c);
-#      opthdr_ofs = pe_header_offset + 4 + 20;
-#      num_entries = pe_get32 (dll, opthdr_ofs + 92);
-#
-#      if (num_entries < 1) /* no exports */
-#  	return 1;
-#
-#      export_rva = pe_get32 (dll, opthdr_ofs + 96);
-#      export_size = pe_get32 (dll, opthdr_ofs + 100);
-#      nsections = pe_get16 (dll, pe_header_offset + 4 +2);
-#      secptr = (pe_header_offset + 4 + 20 +
-#  	      pe_get16 (dll, pe_header_offset + 4 + 16));
-#
-#      expptr = 0;
-#      for (i = 0; i < nsections; i++)
-#      {
-#  	char sname[8];
-#  	unsigned long secptr1 = secptr + 40 * i;
-#  	unsigned long vaddr = pe_get32 (dll, secptr1 + 12);
-#  	unsigned long vsize = pe_get32 (dll, secptr1 + 16);
-#  	unsigned long fptr = pe_get32 (dll, secptr1 + 20);
-#  	lseek(dll, secptr1, SEEK_SET);
-#  	read(dll, sname, 8);
-#  	if (vaddr <= export_rva && vaddr+vsize > export_rva)
-#  	{
-#  	    expptr = fptr + (export_rva - vaddr);
-#  	    if (export_rva + export_size > vaddr + vsize)
-#  		export_size = vsize - (export_rva - vaddr);
-#  	    break;
-#  	}
-#      }
-#
-#      expdata = (unsigned char*)malloc(export_size);
-#      lseek (dll, expptr, SEEK_SET);
-#      read (dll, expdata, export_size);
-#      erva = expdata - export_rva;
-#
-#      nexp = pe_as32 (expdata+24);
-#      name_rvas = pe_as32 (expdata+32);
-#
-#      printf ("EXPORTS\n");
-#      for (i = 0; i<nexp; i++)
-#      {
-#  	unsigned long name_rva = pe_as32 (erva+name_rvas+i*4);
-#  	printf ("\t%s @ %ld ;\n", erva+name_rva, 1+ i);
-#      }
-#
-#      return 0;
-#  }
-# /* impgen.c ends here */
-
-EOF
-    ;;
-  esac
-
-
-  # Append the ltmain.sh script.
-  sed '$q' "$ltmain" >> "$ofile" || (rm -f "$ofile"; exit 1)
-  # We use sed instead of cat because bash on DJGPP gets confused if
-  # if finds mixed CR/LF and LF-only lines.  Since sed operates in
-  # text mode, it properly converts lines to CR/LF.  This bash problem
-  # is reportedly fixed, but why not run on old versions too?
-
-  chmod +x "$ofile"
-  ;;
-
-*)
-  # Compile the libtool program.
-  echo "FIXME: would compile $ltmain"
-  ;;
-esac
-
-test -n "$cache_file" || exit 0
-
-# AC_CACHE_SAVE
-trap '' 1 2 15
-cat > confcache <<\EOF
-# This file is a shell script that caches the results of configure
-# tests run on this system so they can be shared between configure
-# scripts and configure runs.  It is not useful on other systems.
-# If it contains results you don't want to keep, you may remove or edit it.
-#
-# By default, configure uses ./config.cache as the cache file,
-# creating it if it does not exist already.  You can give configure
-# the --cache-file=FILE option to use a different cache file; that is
-# what configure does when it calls configure scripts in
-# subdirectories, so they share the cache.
-# Giving --cache-file=/dev/null disables caching, for debugging configure.
-# config.status only pays attention to the cache file if you give it the
-# --recheck option to rerun configure.
-#
-EOF
-# The following way of writing the cache mishandles newlines in values,
-# but we know of no workaround that is simple, portable, and efficient.
-# So, don't put newlines in cache variables' values.
-# Ultrix sh set writes to stderr and can't be redirected directly,
-# and sets the high bit in the cache file unless we assign to the vars.
-(set) 2>&1 |
-  case `(ac_space=' '; set | grep ac_space) 2>&1` in
-  *ac_space=\ *)
-    # `set' does not quote correctly, so add quotes (double-quote substitution
-    # turns \\\\ into \\, and sed turns \\ into \).
-    sed -n \
-      -e "s/'/'\\\\''/g" \
-      -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
-    ;;
-  *)
-    # `set' quotes correctly as required by POSIX, so do not add quotes.
-    sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
-    ;;
-  esac >> confcache
-if cmp -s $cache_file confcache; then
-  :
-else
-  if test -w $cache_file; then
-    echo "updating cache $cache_file"
-    cat confcache > $cache_file
-  else
-    echo "not updating unwritable cache $cache_file"
-  fi
-fi
-rm -f confcache
-
-exit 0
-
-# Local Variables:
-# mode:shell-script
-# sh-indentation:2
-# End:
diff --git a/ghc/rts/gmp/ltmain.sh b/ghc/rts/gmp/ltmain.sh
deleted file mode 100644
index d81d89f878..0000000000
--- a/ghc/rts/gmp/ltmain.sh
+++ /dev/null
@@ -1,4692 +0,0 @@
-# ltmain.sh - Provide generalized library-building support services.
-# NOTE: Changing this file will not affect anything until you rerun ltconfig.
-#
-# Copyright (C) 1996-2000 Free Software Foundation, Inc.
-# Originally by Gordon Matzigkeit <gord@gnu.ai.mit.edu>, 1996
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-#
-# As a special exception to the GNU General Public License, if you
-# distribute this file as part of a program that contains a
-# configuration script generated by Autoconf, you may include it under
-# the same distribution terms that you use for the rest of that program.
-
-# Check that we have a working $echo.
-if test "X$1" = X--no-reexec; then
-  # Discard the --no-reexec flag, and continue.
-  shift
-elif test "X$1" = X--fallback-echo; then
-  # Avoid inline document here, it may be left over
-  :
-elif test "X`($echo '\t') 2>/dev/null`" = 'X\t'; then
-  # Yippee, $echo works!
-  :
-else
-  # Restart under the correct shell, and then maybe $echo will work.
-  exec $SHELL "$0" --no-reexec ${1+"$@"}
-fi
-
-if test "X$1" = X--fallback-echo; then
-  # used as fallback echo
-  shift
-  cat <<EOF
-$*
-EOF
-  exit 0
-fi
-
-# The name of this program.
-progname=`$echo "$0" | sed 's%^.*/%%'`
-modename="$progname"
-
-# Constants.
-PROGRAM=ltmain.sh
-PACKAGE=libtool
-VERSION=1.3c
-TIMESTAMP=" (1.696 2000/03/14 20:22:42)"
-
-default_mode=
-help="Try \`$progname --help' for more information."
-magic="%%%MAGIC variable%%%"
-mkdir="mkdir"
-mv="mv -f"
-rm="rm -f"
-
-# Sed substitution that helps us do robust quoting.  It backslashifies
-# metacharacters that are still active within double-quoted strings.
-Xsed='sed -e 1s/^X//'
-sed_quote_subst='s/\([\\`\\"$\\\\]\)/\\\1/g'
-SP2NL='tr \040 \012'
-NL2SP='tr \015\012 \040\040'
-
-# NLS nuisances.
-# Only set LANG and LC_ALL to C if already set.
-# These must not be set unconditionally because not all systems understand
-# e.g. LANG=C (notably SCO).
-# We save the old values to restore during execute mode.
-if test "${LC_ALL+set}" = set; then
-  save_LC_ALL="$LC_ALL"; LC_ALL=C; export LC_ALL
-fi
-if test "${LANG+set}" = set; then
-  save_LANG="$LANG"; LANG=C; export LANG
-fi
-
-if test "$LTCONFIG_VERSION" != "$VERSION"; then
-  echo "$modename: ltconfig version \`$LTCONFIG_VERSION' does not match $PROGRAM version \`$VERSION'" 1>&2
-  echo "Fatal configuration error.  See the $PACKAGE docs for more information." 1>&2
-  exit 1
-fi
-
-if test "$build_libtool_libs" != yes && test "$build_old_libs" != yes; then
-  echo "$modename: not configured to build any kind of library" 1>&2
-  echo "Fatal configuration error.  See the $PACKAGE docs for more information." 1>&2
-  exit 1
-fi
-
-# Global variables.
-mode=$default_mode
-nonopt=
-prev=
-prevopt=
-run=
-show="$echo"
-show_help=
-execute_dlfiles=
-lo2o="s/\\.lo\$/.${objext}/"
-o2lo="s/\\.${objext}\$/.lo/"
-
-# Parse our command line options once, thoroughly.
-while test $# -gt 0
-do
-  arg="$1"
-  shift
-
-  case "$arg" in
-  -*=*) optarg=`$echo "X$arg" | $Xsed -e 's/[-_a-zA-Z0-9]*=//'` ;;
-  *) optarg= ;;
-  esac
-
-  # If the previous option needs an argument, assign it.
-  if test -n "$prev"; then
-    case "$prev" in
-    execute_dlfiles)
-      eval "$prev=\"\$$prev \$arg\""
-      ;;
-    *)
-      eval "$prev=\$arg"
-      ;;
-    esac
-
-    prev=
-    prevopt=
-    continue
-  fi
-
-  # Have we seen a non-optional argument yet?
-  case "$arg" in
-  --help)
-    show_help=yes
-    ;;
-
-  --version)
-    echo "$PROGRAM (GNU $PACKAGE) $VERSION$TIMESTAMP"
-    exit 0
-    ;;
-
-  --config)
-    sed -e '1,/^### BEGIN LIBTOOL CONFIG/d' -e '/^### END LIBTOOL CONFIG/,$d' $0
-    exit 0
-    ;;
-
-  --debug)
-    echo "$progname: enabling shell trace mode"
-    set -x
-    ;;
-
-  --dry-run | -n)
-    run=:
-    ;;
-
-  --features)
-    echo "host: $host"
-    if test "$build_libtool_libs" = yes; then
-      echo "enable shared libraries"
-    else
-      echo "disable shared libraries"
-    fi
-    if test "$build_old_libs" = yes; then
-      echo "enable static libraries"
-    else
-      echo "disable static libraries"
-    fi
-    exit 0
-    ;;
-
-  --finish) mode="finish" ;;
-
-  --mode) prevopt="--mode" prev=mode ;;
-  --mode=*) mode="$optarg" ;;
-
-  --quiet | --silent)
-    show=:
-    ;;
-
-  -dlopen)
-    prevopt="-dlopen"
-    prev=execute_dlfiles
-    ;;
-
-  -*)
-    $echo "$modename: unrecognized option \`$arg'" 1>&2
-    $echo "$help" 1>&2
-    exit 1
-    ;;
-
-  *)
-    nonopt="$arg"
-    break
-    ;;
-  esac
-done
-
-if test -n "$prevopt"; then
-  $echo "$modename: option \`$prevopt' requires an argument" 1>&2
-  $echo "$help" 1>&2
-  exit 1
-fi
-
-if test -z "$show_help"; then
-
-  # Infer the operation mode.
-  if test -z "$mode"; then
-    case "$nonopt" in
-    *cc | *++ | gcc* | *-gcc*)
-      mode=link
-      for arg
-      do
-	case "$arg" in
-	-c)
-	   mode=compile
-	   break
-	   ;;
-	esac
-      done
-      ;;
-    *db | *dbx | *strace | *truss)
-      mode=execute
-      ;;
-    *install*|cp|mv)
-      mode=install
-      ;;
-    *rm)
-      mode=uninstall
-      ;;
-    *)
-      # If we have no mode, but dlfiles were specified, then do execute mode.
-      test -n "$execute_dlfiles" && mode=execute
-
-      # Just use the default operation mode.
-      if test -z "$mode"; then
-	if test -n "$nonopt"; then
-	  $echo "$modename: warning: cannot infer operation mode from \`$nonopt'" 1>&2
-	else
-	  $echo "$modename: warning: cannot infer operation mode without MODE-ARGS" 1>&2
-	fi
-      fi
-      ;;
-    esac
-  fi
-
-  # Only execute mode is allowed to have -dlopen flags.
-  if test -n "$execute_dlfiles" && test "$mode" != execute; then
-    $echo "$modename: unrecognized option \`-dlopen'" 1>&2
-    $echo "$help" 1>&2
-    exit 1
-  fi
-
-  # Change the help message to a mode-specific one.
-  generic_help="$help"
-  help="Try \`$modename --help --mode=$mode' for more information."
-
-  # These modes are in order of execution frequency so that they run quickly.
-  case "$mode" in
-  # libtool compile mode
-  compile)
-    modename="$modename: compile"
-    # Get the compilation command and the source file.
-    base_compile=
-    prev=
-    lastarg=
-    srcfile="$nonopt"
-    suppress_output=
-
-    user_target=no
-    for arg
-    do
-      case "$prev" in
-      "") ;;
-      xcompiler)
-	# Aesthetically quote the previous argument.
-	prev=
-	lastarg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`
-
-	case "$arg" in
-	# Double-quote args containing other shell metacharacters.
-	# Many Bourne shells cannot handle close brackets correctly
-	# in scan sets, so we specify it separately.
-	*[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
-	  arg="\"$arg\""
-	  ;;
-	esac
-
-	# Add the previous argument to base_compile.
-	if test -z "$base_compile"; then
-	  base_compile="$lastarg"
-	else
-	  base_compile="$base_compile $lastarg"
-	fi
-	continue
-	;;
-      esac
-
-      # Accept any command-line options.
-      case "$arg" in
-      -o)
-	if test "$user_target" != "no"; then
-	  $echo "$modename: you cannot specify \`-o' more than once" 1>&2
-	  exit 1
-	fi
-	user_target=next
-	;;
-
-      -static)
-	build_old_libs=yes
-	continue
-	;;
-
-      -Xcompiler)
-	prev=xcompiler
-	continue
-	;;
-
-      -Wc,*)
-	args=`$echo "X$arg" | $Xsed -e "s/^-Wc,//"`
-	lastarg=
-	IFS="${IFS= 	}"; save_ifs="$IFS"; IFS=','
-	for arg in $args; do
-	  IFS="$save_ifs"
-
-	  # Double-quote args containing other shell metacharacters.
-	  # Many Bourne shells cannot handle close brackets correctly
-	  # in scan sets, so we specify it separately.
-	  case "$arg" in
-	    *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
-	    arg="\"$arg\""
-	    ;;
-	  esac
-	  lastarg="$lastarg $arg"
-	done
-	IFS="$save_ifs"
-	lastarg=`$echo "X$lastarg" | $Xsed -e "s/^ //"`
-
-	# Add the arguments to base_compile.
-	if test -z "$base_compile"; then
-	  base_compile="$lastarg"
-	else
-	  base_compile="$base_compile $lastarg"
-	fi
-	continue
-	;;
-      esac
-
-      case "$user_target" in
-      next)
-	# The next one is the -o target name
-	user_target=yes
-	continue
-	;;
-      yes)
-	# We got the output file
-	user_target=set
-	libobj="$arg"
-	continue
-	;;
-      esac
-
-      # Accept the current argument as the source file.
-      lastarg="$srcfile"
-      srcfile="$arg"
-
-      # Aesthetically quote the previous argument.
-
-      # Backslashify any backslashes, double quotes, and dollar signs.
-      # These are the only characters that are still specially
-      # interpreted inside of double-quoted scrings.
-      lastarg=`$echo "X$lastarg" | $Xsed -e "$sed_quote_subst"`
-
-      # Double-quote args containing other shell metacharacters.
-      # Many Bourne shells cannot handle close brackets correctly
-      # in scan sets, so we specify it separately.
-      case "$lastarg" in
-      *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
-	lastarg="\"$lastarg\""
-	;;
-      esac
-
-      # Add the previous argument to base_compile.
-      if test -z "$base_compile"; then
-	base_compile="$lastarg"
-      else
-	base_compile="$base_compile $lastarg"
-      fi
-    done
-
-    case "$user_target" in
-    set)
-      ;;
-    no)
-      # Get the name of the library object.
-      libobj=`$echo "X$srcfile" | $Xsed -e 's%^.*/%%'`
-      ;;
-    *)
-      $echo "$modename: you must specify a target with \`-o'" 1>&2
-      exit 1
-      ;;
-    esac
-
-    # Recognize several different file suffixes.
-    # If the user specifies -o file.o, it is replaced with file.lo
-    xform='[cCFSfmso]'
-    case "$libobj" in
-    *.ada) xform=ada ;;
-    *.adb) xform=adb ;;
-    *.ads) xform=ads ;;
-    *.asm) xform=asm ;;
-    *.c++) xform=c++ ;;
-    *.cc) xform=cc ;;
-    *.cpp) xform=cpp ;;
-    *.cxx) xform=cxx ;;
-    *.f90) xform=f90 ;;
-    *.for) xform=for ;;
-    esac
-
-    libobj=`$echo "X$libobj" | $Xsed -e "s/\.$xform$/.lo/"`
-
-    case "$libobj" in
-    *.lo) obj=`$echo "X$libobj" | $Xsed -e "$lo2o"` ;;
-    *)
-      $echo "$modename: cannot determine name of library object from \`$libobj'" 1>&2
-      exit 1
-      ;;
-    esac
-
-    if test -z "$base_compile"; then
-      $echo "$modename: you must specify a compilation command" 1>&2
-      $echo "$help" 1>&2
-      exit 1
-    fi
-
-    # Delete any leftover library objects.
-    if test "$build_old_libs" = yes; then
-      removelist="$obj $libobj"
-    else
-      removelist="$libobj"
-    fi
-
-    $run $rm $removelist
-    trap "$run $rm $removelist; exit 1" 1 2 15
-
-    # Calculate the filename of the output object if compiler does
-    # not support -o with -c
-    if test "$compiler_c_o" = no; then
-      output_obj=`$echo "X$srcfile" | $Xsed -e 's%^.*/%%' -e 's%\..*$%%'`.${objext}
-      lockfile="$output_obj.lock"
-      removelist="$removelist $output_obj $lockfile"
-      trap "$run $rm $removelist; exit 1" 1 2 15
-    else
-      need_locks=no
-      lockfile=
-    fi
-
-    # Lock this critical section if it is needed
-    # We use this script file to make the link, it avoids creating a new file
-    if test "$need_locks" = yes; then
-      until ln "$0" "$lockfile" 2>/dev/null; do
-	$show "Waiting for $lockfile to be removed"
-	sleep 2
-      done
-    elif test "$need_locks" = warn; then
-      if test -f "$lockfile"; then
-	echo "\
-*** ERROR, $lockfile exists and contains:
-`cat $lockfile 2>/dev/null`
-
-This indicates that another process is trying to use the same
-temporary object file, and libtool could not work around it because
-your compiler does not support \`-c' and \`-o' together.  If you
-repeat this compilation, it may succeed, by chance, but you had better
-avoid parallel builds (make -j) in this platform, or get a better
-compiler."
-
-	$run $rm $removelist
-	exit 1
-      fi
-      echo $srcfile > "$lockfile"
-    fi
-
-    if test -n "$fix_srcfile_path"; then
-      eval srcfile=\"$fix_srcfile_path\"
-    fi
-
-    # Only build a PIC object if we are building libtool libraries.
-    if test "$build_libtool_libs" = yes; then
-      # Without this assignment, base_compile gets emptied.
-      fbsd_hideous_sh_bug=$base_compile
-
-      if test "$pic_mode" != no; then
-	# All platforms use -DPIC, to notify preprocessed assembler code.
-	command="$base_compile $srcfile $pic_flag -DPIC"
-      else
-	# Don't build PIC code
-	command="$base_compile $srcfile"
-      fi
-      if test "$build_old_libs" = yes; then
-	lo_libobj="$libobj"
-	dir=`$echo "X$libobj" | $Xsed -e 's%/[^/]*$%%'`
-	if test "X$dir" = "X$libobj"; then
-	  dir="$objdir"
-	else
-	  dir="$dir/$objdir"
-	fi
-	libobj="$dir/"`$echo "X$libobj" | $Xsed -e 's%^.*/%%'`
-
-	if test -d "$dir"; then
-	  $show "$rm $libobj"
-	  $run $rm $libobj
-	else
-	  $show "$mkdir $dir"
-	  $run $mkdir $dir
-	  status=$?
-	  if test $status -ne 0 && test ! -d $dir; then
-	    exit $status
-	  fi
-	fi
-      fi
-      if test "$compiler_o_lo" = yes; then
-	output_obj="$libobj"
-	command="$command -o $output_obj"
-      elif test "$compiler_c_o" = yes; then
-	output_obj="$obj"
-	command="$command -o $output_obj"
-      fi
-
-      $run $rm "$output_obj"
-      $show "$command"
-      if $run eval "$command"; then :
-      else
-	test -n "$output_obj" && $run $rm $removelist
-	exit 1
-      fi
-
-      if test "$need_locks" = warn &&
-	 test x"`cat $lockfile 2>/dev/null`" != x"$srcfile"; then
-	echo "\
-*** ERROR, $lockfile contains:
-`cat $lockfile 2>/dev/null`
-
-but it should contain:
-$srcfile
-
-This indicates that another process is trying to use the same
-temporary object file, and libtool could not work around it because
-your compiler does not support \`-c' and \`-o' together.  If you
-repeat this compilation, it may succeed, by chance, but you had better
-avoid parallel builds (make -j) in this platform, or get a better
-compiler."
-
-	$run $rm $removelist
-	exit 1
-      fi
-
-      # Just move the object if needed, then go on to compile the next one
-      if test x"$output_obj" != x"$libobj"; then
-	$show "$mv $output_obj $libobj"
-	if $run $mv $output_obj $libobj; then :
-	else
-	  error=$?
-	  $run $rm $removelist
-	  exit $error
-	fi
-      fi
-
-      # If we have no pic_flag, then copy the object into place and finish.
-      if (test -z "$pic_flag" || test "$pic_mode" != default) &&
-	 test "$build_old_libs" = yes; then
-	# Rename the .lo from within objdir to obj
-	if test -f $obj; then
-	  $show $rm $obj
-	  $run $rm $obj
-	fi
-
-	$show "$mv $libobj $obj"
-	if $run $mv $libobj $obj; then :
-	else
-	  error=$?
-	  $run $rm $removelist
-	  exit $error
-	fi
-
-	xdir=`$echo "X$obj" | $Xsed -e 's%/[^/]*$%%'`
-	if test "X$xdir" = "X$obj"; then
-	  xdir="."
-	else
-	  xdir="$xdir"
-	fi
-	baseobj=`$echo "X$obj" | $Xsed -e "s%.*/%%"`
-	libobj=`$echo "X$baseobj" | $Xsed -e "$o2lo"`
-	# Now arrange that obj and lo_libobj become the same file
-	$show "(cd $xdir && $LN_S $baseobj $libobj)"
-	if $run eval '(cd $xdir && $LN_S $baseobj $libobj)'; then
-	  exit 0
-	else
-	  error=$?
-	  $run $rm $removelist
-	  exit $error
-	fi
-      fi
-
-      # Allow error messages only from the first compilation.
-      suppress_output=' >/dev/null 2>&1'
-    fi
-
-    # Only build a position-dependent object if we build old libraries.
-    if test "$build_old_libs" = yes; then
-      if test "$pic_mode" != yes; then
-	# Don't build PIC code
-	command="$base_compile $srcfile"
-      else
-	# All platforms use -DPIC, to notify preprocessed assembler code.
-	command="$base_compile $srcfile $pic_flag -DPIC"
-      fi
-      if test "$compiler_c_o" = yes; then
-	command="$command -o $obj"
-	output_obj="$obj"
-      fi
-
-      # Suppress compiler output if we already did a PIC compilation.
-      command="$command$suppress_output"
-      $run $rm "$output_obj"
-      $show "$command"
-      if $run eval "$command"; then :
-      else
-	$run $rm $removelist
-	exit 1
-      fi
-
-      if test "$need_locks" = warn &&
-	 test x"`cat $lockfile 2>/dev/null`" != x"$srcfile"; then
-	echo "\
-*** ERROR, $lockfile contains:
-`cat $lockfile 2>/dev/null`
-
-but it should contain:
-$srcfile
-
-This indicates that another process is trying to use the same
-temporary object file, and libtool could not work around it because
-your compiler does not support \`-c' and \`-o' together.  If you
-repeat this compilation, it may succeed, by chance, but you had better
-avoid parallel builds (make -j) in this platform, or get a better
-compiler."
-
-	$run $rm $removelist
-	exit 1
-      fi
-
-      # Just move the object if needed
-      if test x"$output_obj" != x"$obj"; then
-	$show "$mv $output_obj $obj"
-	if $run $mv $output_obj $obj; then :
-	else
-	  error=$?
-	  $run $rm $removelist
-	  exit $error
-	fi
-      fi
-
-      # Create an invalid libtool object if no PIC, so that we do not
-      # accidentally link it into a program.
-      if test "$build_libtool_libs" != yes; then
-	$show "echo timestamp > $libobj"
-	$run eval "echo timestamp > \$libobj" || exit $?
-      else
-	# Move the .lo from within objdir
-	$show "$mv $libobj $lo_libobj"
-	if $run $mv $libobj $lo_libobj; then :
-	else
-	  error=$?
-	  $run $rm $removelist
-	  exit $error
-	fi
-      fi
-    fi
-
-    # Unlock the critical section if it was locked
-    if test "$need_locks" != no; then
-      $rm "$lockfile"
-    fi
-
-    exit 0
-    ;;
-
-  # libtool link mode
-  link | relink)
-    modename="$modename: link"
-    case "$host" in
-    *-*-cygwin* | *-*-mingw* | *-*-os2*)
-      # It is impossible to link a dll without this setting, and
-      # we shouldn't force the makefile maintainer to figure out
-      # which system we are compiling for in order to pass an extra
-      # flag for every libtool invokation.
-      # allow_undefined=no
-
-      # FIXME: Unfortunately, there are problems with the above when trying
-      # to make a dll which has undefined symbols, in which case not
-      # even a static library is built.  For now, we need to specify
-      # -no-undefined on the libtool link line when we can be certain
-      # that all symbols are satisfied, otherwise we get a static library.
-      allow_undefined=yes
-      ;;
-    *)
-      allow_undefined=yes
-      ;;
-    esac
-    libtool_args="$nonopt"
-    compile_command="$nonopt"
-    finalize_command="$nonopt"
-
-    compile_rpath=
-    finalize_rpath=
-    compile_shlibpath=
-    finalize_shlibpath=
-    convenience=
-    old_convenience=
-    deplibs=
-    old_deplibs=
-    compiler_flags=
-    linker_flags=
-    dllsearchpath=
-    lib_search_path=`pwd`
-
-    avoid_version=no
-    dlfiles=
-    dlprefiles=
-    dlself=no
-    export_dynamic=no
-    export_symbols=
-    export_symbols_regex=
-    generated=
-    libobjs=
-    ltlibs=
-    module=no
-    no_install=no
-    objs=
-    prefer_static_libs=no
-    preload=no
-    prev=
-    prevarg=
-    release=
-    rpath=
-    xrpath=
-    perm_rpath=
-    temp_rpath=
-    thread_safe=no
-    vinfo=
-
-    # We need to know -static, to get the right output filenames.
-    for arg
-    do
-      case "$arg" in
-      -all-static | -static)
-	if test "X$arg" = "X-all-static"; then
-	  if test "$build_libtool_libs" = yes && test -z "$link_static_flag"; then
-	    $echo "$modename: warning: complete static linking is impossible in this configuration" 1>&2
-	  fi
-	  if test -n "$link_static_flag"; then
-	    dlopen_self=$dlopen_self_static
-	  fi
-	else
-	  if test -z "$pic_flag" && test -n "$link_static_flag"; then
-	    dlopen_self=$dlopen_self_static
-	  fi
-	fi
-	build_libtool_libs=no
-	build_old_libs=yes
-	prefer_static_libs=yes
-	break
-	;;
-      esac
-    done
-
-    # See if our shared archives depend on static archives.
-    test -n "$old_archive_from_new_cmds" && build_old_libs=yes
-
-    # Go through the arguments, transforming them on the way.
-    while test $# -gt 0; do
-      arg="$1"
-      shift
-      case "$arg" in
-      *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
-	qarg=\"`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`\" ### testsuite: skip nested quoting test
-	;;
-      *) qarg=$arg ;;
-      esac
-      libtool_args="$libtool_args $qarg"
-
-      # If the previous option needs an argument, assign it.
-      if test -n "$prev"; then
-	case "$prev" in
-	output)
-	  compile_command="$compile_command @OUTPUT@"
-	  finalize_command="$finalize_command @OUTPUT@"
-	  ;;
-	esac
-
-	case "$prev" in
-	dlfiles|dlprefiles)
-	  if test "$preload" = no; then
-	    # Add the symbol object into the linking commands.
-	    compile_command="$compile_command @SYMFILE@"
-	    finalize_command="$finalize_command @SYMFILE@"
-	    preload=yes
-	  fi
-	  case "$arg" in
-	  *.la | *.lo) ;;  # We handle these cases below.
-	  force)
-	    if test "$dlself" = no; then
-	      dlself=needless
-	      export_dynamic=yes
-	    fi
-	    prev=
-	    continue
-	    ;;
-	  self)
-	    if test "$prev" = dlprefiles; then
-	      dlself=yes
-	    elif test "$prev" = dlfiles && test "$dlopen_self" != yes; then
-	      dlself=yes
-	    else
-	      dlself=needless
-	      export_dynamic=yes
-	    fi
-	    prev=
-	    continue
-	    ;;
-	  *)
-	    if test "$prev" = dlfiles; then
-	      dlfiles="$dlfiles $arg"
-	    else
-	      dlprefiles="$dlprefiles $arg"
-	    fi
-	    prev=
-	    continue
-	    ;;
-	  esac
-	  ;;
-	expsyms)
-	  export_symbols="$arg"
-	  if test ! -f "$arg"; then
-	    $echo "$modename: symbol file \`$arg' does not exist"
-	    exit 1
-	  fi
-	  prev=
-	  continue
-	  ;;
-	expsyms_regex)
-	  export_symbols_regex="$arg"
-	  prev=
-	  continue
-	  ;;
-	release)
-	  release="-$arg"
-	  prev=
-	  continue
-	  ;;
-	rpath | xrpath)
-	  # We need an absolute path.
-	  case "$arg" in
-	  [\\/]* | [A-Za-z]:[\\/]*) ;;
-	  *)
-	    $echo "$modename: only absolute run-paths are allowed" 1>&2
-	    exit 1
-	    ;;
-	  esac
-	  if test "$prev" = rpath; then
-	    case "$rpath " in
-	    *" $arg "*) ;;
-	    *) rpath="$rpath $arg" ;;
-	    esac
-	  else
-	    case "$xrpath " in
-	    *" $arg "*) ;;
-	    *) xrpath="$xrpath $arg" ;;
-	    esac
-	  fi
-	  prev=
-	  continue
-	  ;;
-	xcompiler)
-	  compiler_flags="$compiler_flags $qarg"
-	  prev=
-	  compile_command="$compile_command $qarg"
-	  finalize_command="$finalize_command $qarg"
-	  continue
-	  ;;
-	xlinker)
-	  linker_flags="$linker_flags $qarg"
-	  compiler_flags="$compiler_flags $wl$qarg"
-	  prev=
-	  compile_command="$compile_command $wl$qarg"
-	  finalize_command="$finalize_command $wl$qarg"
-	  continue
-	  ;;
-	*)
-	  eval "$prev=\"\$arg\""
-	  prev=
-	  continue
-	  ;;
-	esac
-      fi
-
-      prevarg="$arg"
-
-      case "$arg" in
-      -all-static)
-	if test -n "$link_static_flag"; then
-	  compile_command="$compile_command $link_static_flag"
-	  finalize_command="$finalize_command $link_static_flag"
-	fi
-	continue
-	;;
-
-      -allow-undefined)
-	# FIXME: remove this flag sometime in the future.
-	$echo "$modename: \`-allow-undefined' is deprecated because it is the default" 1>&2
-	continue
-	;;
-
-      -avoid-version)
-	avoid_version=yes
-	continue
-	;;
-
-      -dlopen)
-	prev=dlfiles
-	continue
-	;;
-
-      -dlpreopen)
-	prev=dlprefiles
-	continue
-	;;
-
-      -export-dynamic)
-	export_dynamic=yes
-	continue
-	;;
-
-      -export-symbols | -export-symbols-regex)
-	if test -n "$export_symbols" || test -n "$export_symbols_regex"; then
-	  $echo "$modename: not more than one -exported-symbols argument allowed"
-	  exit 1
-	fi
-	if test "X$arg" = "X-export-symbols"; then
-	  prev=expsyms
-	else
-	  prev=expsyms_regex
-	fi
-	continue
-	;;
-
-      -L*)
-	dir=`$echo "X$arg" | $Xsed -e 's/^-L//'`
-	# We need an absolute path.
-	case "$dir" in
-	[\\/]* | [A-Za-z]:[\\/]*) ;;
-	*)
-	  absdir=`cd "$dir" && pwd`
-	  if test -z "$absdir"; then
-	    $echo "$modename: cannot determine absolute directory name of \`$dir'" 1>&2
-	    exit 1
-	  fi
-	  dir="$absdir"
-	  ;;
-	esac
-	case "$deplibs " in
-	*" -L$dir "*) ;;
-	*)
-	  deplibs="$deplibs -L$dir"
-	  lib_search_path="$lib_search_path $dir"
-	  ;;
-	esac
-	case "$host" in
-	*-*-cygwin* | *-*-mingw* | *-*-os2*)
-	  case ":$dllsearchpath:" in
-	  *":$dir:"*) ;;
-	  *) dllsearchpath="$dllsearchpath:$dir";;
-	  esac
-	  ;;
-	esac
-	continue
-	;;
-
-      -l*)
-	if test "$arg" = "-lc"; then
-	  case "$host" in
-	  *-*-cygwin* | *-*-mingw* | *-*-os2* | *-*-beos*)
-	    # These systems don't actually have c library (as such)
-	    continue
-	    ;;
-	  esac
-	elif test "$arg" = "-lm"; then
-	  case "$host" in
-	  *-*-cygwin* | *-*-beos*)
-	    # These systems don't actually have math library (as such)
-	    continue
-	    ;;
-	  esac
-	fi
-	deplibs="$deplibs $arg"
-	continue
-	;;
-
-      -module)
-	module=yes
-	continue
-	;;
-
-      -no-fast-install)
-	fast_install=no
-	continue
-	;;
-
-      -no-install)
-	case "$host" in
-	*-*-cygwin* | *-*-mingw* | *-*-os2*)
-	  # The PATH hackery in wrapper scripts is required on Windows
-	  # in order for the loader to find any dlls it needs.
-	  $echo "$modename: warning: \`-no-install' is ignored for $host" 1>&2
-	  $echo "$modename: warning: assuming \`-no-fast-install' instead" 1>&2
-	  fast_install=no
-	  ;;
-	*)
-	  no_install=yes
-	  ;;
-	esac
-	continue
-	;;
-
-      -no-undefined)
-	allow_undefined=no
-	continue
-	;;
-
-      -o) prev=output ;;
-
-      -release)
-	prev=release
-	continue
-	;;
-
-      -rpath)
-	prev=rpath
-	continue
-	;;
-
-      -R)
-	prev=xrpath
-	continue
-	;;
-
-      -R*)
-	dir=`$echo "X$arg" | $Xsed -e 's/^-R//'`
-	# We need an absolute path.
-	case "$dir" in
-	[\\/]* | [A-Za-z]:[\\/]*) ;;
-	*)
-	  $echo "$modename: only absolute run-paths are allowed" 1>&2
-	  exit 1
-	  ;;
-	esac
-	case "$xrpath " in
-	*" $dir "*) ;;
-	*) xrpath="$xrpath $dir" ;;
-	esac
-	continue
-	;;
-
-      -static)
-	# If we have no pic_flag, then this is the same as -all-static.
-	if test -z "$pic_flag" && test -n "$link_static_flag"; then
-	  compile_command="$compile_command $link_static_flag"
-	  finalize_command="$finalize_command $link_static_flag"
-	fi
-	continue
-	;;
-
-      -thread-safe)
-	thread_safe=yes
-	continue
-	;;
-
-      -version-info)
-	prev=vinfo
-	continue
-	;;
-
-      -Wc,*)
-	args=`$echo "X$arg" | $Xsed -e "$sed_quote_subst" -e 's/^-Wc,//'`
-	arg=
-	IFS="${IFS= 	}"; save_ifs="$IFS"; IFS=','
-	for flag in $args; do
-	  IFS="$save_ifs"
-	  case "$flag" in
-	    *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
-	    flag="\"$flag\""
-	    ;;
-	  esac
-	  arg="$arg $wl$flag"
-	  compiler_flags="$compiler_flags $flag"
-	done
-	IFS="$save_ifs"
-	arg=`$echo "X$arg" | $Xsed -e "s/^ //"`
-	;;
-
-      -Wl,*)
-	args=`$echo "X$arg" | $Xsed -e "$sed_quote_subst" -e 's/^-Wl,//'`
-	arg=
-	IFS="${IFS= 	}"; save_ifs="$IFS"; IFS=','
-	for flag in $args; do
-	  IFS="$save_ifs"
-	  case "$flag" in
-	    *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
-	    flag="\"$flag\""
-	    ;;
-	  esac
-	  arg="$arg $wl$flag"
-	  compiler_flags="$compiler_flags $wl$flag"
-	  linker_flags="$linker_flags $flag"
-	done
-	IFS="$save_ifs"
-	arg=`$echo "X$arg" | $Xsed -e "s/^ //"`
-	;;
-
-      -Xcompiler)
-	prev=xcompiler
-	continue
-	;;
-
-      -Xlinker)
-	prev=xlinker
-	continue
-	;;
-
-      # Some other compiler flag.
-      -* | +*)
-	# Unknown arguments in both finalize_command and compile_command need
-	# to be aesthetically quoted because they are evaled later.
-	arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`
-	case "$arg" in
-	*[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
-	  arg="\"$arg\""
-	  ;;
-	esac
-	;;
-
-      *.$objext)
-	# A standard object.
-	objs="$objs $arg"
-	;;
-
-      *.lo)
-	# A library object.
-	if test "$prev" = dlfiles; then
-	  # This file was specified with -dlopen.
-	  if test "$build_libtool_libs" = yes && test "$dlopen_support" = yes; then
-	    dlfiles="$dlfiles $arg"
-	    prev=
-	    continue
-	  else
-	    # If libtool objects are unsupported, then we need to preload.
-	    prev=dlprefiles
-	  fi
-	fi
-
-	if test "$prev" = dlprefiles; then
-	  # Preload the old-style object.
-	  dlprefiles="$dlprefiles "`$echo "X$arg" | $Xsed -e "$lo2o"`
-	  prev=
-	else
-	  libobjs="$libobjs $arg"
-	fi
-	;;
-
-      *.$libext)
-	# An archive.
-	deplibs="$deplibs $arg"
-	old_deplibs="$old_deplibs $arg"
-	continue
-	;;
-
-      *.la)
-	# A libtool-controlled library.
-
-	if test "$prev" = dlfiles; then
-	  # This library was specified with -dlopen.
-	  dlfiles="$dlfiles $arg"
-	  prev=
-	elif test "$prev" = dlprefiles; then
-	  # The library was specified with -dlpreopen.
-	  dlprefiles="$dlprefiles $arg"
-	  prev=
-	else
-	  deplibs="$deplibs $arg"
-	fi
-	continue
-	;;
-
-      # Some other compiler argument.
-      *)
-	# Unknown arguments in both finalize_command and compile_command need
-	# to be aesthetically quoted because they are evaled later.
-	arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`
-	case "$arg" in
-	*[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*|"")
-	  arg="\"$arg\""
-	  ;;
-	esac
-	;;
-      esac
-
-      # Now actually substitute the argument into the commands.
-      if test -n "$arg"; then
-	compile_command="$compile_command $arg"
-	finalize_command="$finalize_command $arg"
-      fi
-    done
-
-    if test -n "$prev"; then
-      $echo "$modename: the \`$prevarg' option requires an argument" 1>&2
-      $echo "$help" 1>&2
-      exit 1
-    fi
-
-    if test "$export_dynamic" = yes && test -n "$export_dynamic_flag_spec"; then
-      eval arg=\"$export_dynamic_flag_spec\"
-      compile_command="$compile_command $arg"
-      finalize_command="$finalize_command $arg"
-    fi
-
-    oldlibs=
-    # calculate the name of the file, without its directory
-    outputname=`$echo "X$output" | $Xsed -e 's%^.*/%%'`
-    libobjs_save="$libobjs"
-
-    if test -n "$shlibpath_var"; then
-      # get the directories listed in $shlibpath_var
-      eval shlib_search_path=\`\$echo \"X \${$shlibpath_var}\" \| \$Xsed -e \'s/:/ /g\'\`
-    else
-      shlib_search_path=
-    fi
-    eval sys_lib_search_path=\"$sys_lib_search_path_spec\"
-    eval sys_lib_dlsearch_path=\"$sys_lib_dlsearch_path_spec\"
-    lib_search_path="$lib_search_path $sys_lib_search_path $shlib_search_path"
-
-    output_objdir=`$echo "X$output" | $Xsed -e 's%/[^/]*$%%'`
-    if test "X$output_objdir" = "X$output"; then
-      output_objdir="$objdir"
-    else
-      output_objdir="$output_objdir/$objdir"
-    fi
-    # Create the object directory.
-    if test ! -d $output_objdir; then
-      $show "$mkdir $output_objdir"
-      $run $mkdir $output_objdir
-      status=$?
-      if test $status -ne 0 && test ! -d $output_objdir; then
-	exit $status
-      fi
-    fi
-
-    case "$output" in
-    "")
-      $echo "$modename: you must specify an output file" 1>&2
-      $echo "$help" 1>&2
-      exit 1
-      ;;
-    *.$libext)
-      linkmode=oldlib ;;
-    *.lo | *.$objext)
-      linkmode=obj ;;
-    *.la)
-      linkmode=lib ;;
-    *) # Anything else should be a program.
-      linkmode=prog ;;
-    esac
-
-    specialdeplibs=
-    libs=
-    # Find all interdependent deplibs that
-    # are linked more than once (e.g. -la -lb -la)
-    for deplib in $deplibs; do
-      case "$libs " in
-      *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
-      esac
-      libs="$libs $deplib"
-    done
-    deplibs=
-    newdependency_libs=
-    uninst_path= # paths that contain uninstalled libtool libraries
-    new_lib_search_path=
-    need_relink=no # whether we're linking any uninstalled libtool libraries
-    case $linkmode in
-    lib)
-	passes="link"
-	for file in $dlfiles $dlprefiles; do
-	  case "$file" in
-	  *.la) ;;
-	  *)
-	    $echo "$modename: libraries can \`-dlopen' only libtool libraries" 1>&2
-	    exit 1
-	    ;;
-	  esac
-	done
-	;;
-    prog)
-	compile_deplibs=
-	finalize_deplibs=
-	alldeplibs=no
-	newdlfiles=
-	newdlprefiles=
-	link_against_libtool_libs=
-	passes="scan dlopen dlpreopen link"
-	;;
-    *)	passes="link"
-	;;
-    esac
-    for pass in $passes; do
-      if test $linkmode = prog; then
-	case $pass in
-	dlopen) libs="$dlfiles" ;;
-	dlpreopen) libs="$dlprefiles" ;;
-	link) libs="$deplibs %DEPLIBS% $dependency_libs" ;;
-	esac
-      fi
-      if test $pass = dlopen; then
-	# Collect dlpreopened libraries
-	save_deplibs="$deplibs"
-	deplibs=
-      fi
-      for deplib in $libs; do
-	lib=
-	found=no
-	case "$deplib" in
-	-l*)
-	  if test $linkmode != lib && test $linkmode != prog; then
-	    $echo "$modename: warning: \`-l' is ignored for archives/objects" 1>&2
-	    continue
-	  fi
-	  name=`$echo "X$deplib" | $Xsed -e 's/^-l//'`
-	  for searchdir in $lib_search_path; do
-	    # Search the libtool library
-	    lib="$searchdir/lib${name}.la"
-	    if test -f "$lib"; then
-	      found=yes
-	      break
-	    fi
-	  done
-	  if test "$found" != yes; then
-	    if test "$linkmode,$pass" = "prog,link"; then
-	      compile_deplibs="$deplib $compile_deplibs"
-	      finalize_deplibs="$deplib $finalize_deplibs"
-	    else
-	      deplibs="$deplib $deplibs"
-	      test $linkmode = lib && newdependency_libs="$deplib $newdependency_libs"
-	    fi
-	    continue
-	  fi
-	  ;;
-	-L*)
-	  case $linkmode in
-	  lib)
-	    deplibs="$deplib $deplibs"
-	    newdependency_libs="$deplib $newdependency_libs"
-	    new_lib_search_path="$new_lib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'`
-	    ;;
-	  prog)
-	    if test $pass = scan; then
-	      deplibs="$deplib $deplibs"
-	      new_lib_search_path="$new_lib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'`
-	    else
-	      compile_deplibs="$deplib $compile_deplibs"
-	      finalize_deplibs="$deplib $finalize_deplibs"
-	    fi
-	    ;;
-	  *)
-	    $echo "$modename: warning: \`-L' is ignored for archives/objects" 1>&2
-	    ;;
-	  esac
-	  continue
-	  ;;
-	-R*)
-	  if test "$linkmode,$pass" = "prog,link"; then
-	    dir=`$echo "X$deplib" | $Xsed -e 's/^-R//'`
-	    # Make sure the xrpath contains only unique directories.
-	    case "$xrpath " in
-	    *" $dir "*) ;;
-	    *) xrpath="$xrpath $dir" ;;
-	    esac
-	  fi
-	  continue
-	  ;;
-	*.la) lib="$deplib" ;;
-	*.$libext)
-	  case $linkmode in
-	  lib)
-	    if test "$deplibs_check_method" != pass_all; then
-	      echo
-	      echo "*** Warning: This library needs some functionality provided by $deplib."
-	      echo "*** I have the capability to make that library automatically link in when"
-	      echo "*** you link to this library.  But I can only do this if you have a"
-	      echo "*** shared version of the library, which you do not appear to have."
-	    else
-	      echo
-	      echo "*** Warning: Linking the shared library $output against the"
-	      echo "*** static library $deplib is not portable!"
-	      deplibs="$deplib $deplibs"
-	    fi
-	    continue
-	    ;;
-	  prog)
-	    if test $pass != link; then
-	      deplibs="$deplib $deplibs"
-	    else
-	      compile_deplibs="$deplib $compile_deplibs"
-	      finalize_deplibs="$deplib $finalize_deplibs"
-	    fi
-	    continue
-	    ;;
-	  esac
-	  ;;
-	*.lo | *.$objext)
-	  if test $linkmode = prog; then
-	    if test $pass = dlpreopen || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then
-	      # If there is no dlopen support or we're linking statically,
-	      # we need to preload.
-	      newdlprefiles="$newdlprefiles $deplib"
-	      compile_deplibs="$deplib $compile_deplibs"
-	      finalize_deplibs="$deplib $finalize_deplibs"
-	    else
-	      newdlfiles="$newdlfiles $deplib"
-	    fi
-	  fi
-	  continue
-	  ;;
-	%DEPLIBS%)
-	  alldeplibs=yes
-	  continue
-	  ;;
-	esac
-	if test $found = yes || test -f "$lib"; then :
-	else
-	  $echo "$modename: cannot find the library \`$lib'" 1>&2
-	  exit 1
-	fi
-
-	# Check to see that this really is a libtool archive.
-	if (sed -e '2q' $lib | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then :
-	else
-	  $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2
-	  exit 1
-	fi
-
-	ladir=`$echo "X$lib" | $Xsed -e 's%/[^/]*$%%'`
-	test "X$ladir" = "X$lib" && ladir="."
-
-	dlname=
-	dlopen=
-	dlpreopen=
-	libdir=
-	library_names=
-	old_library=
-	# If the library was installed with an old release of libtool,
-	# it will not redefine variable installed.
-	installed=yes
-
-	# Read the .la file
-	case "$lib" in
-	*/* | *\\*) . $lib ;;
-	*) . ./$lib ;;
-	esac
-
-	if test $linkmode = lib || test "$linkmode,$pass" = "prog,scan"; then
-	  test -n "$dlopen" && dlfiles="$dlfiles $dlopen"
-	  test -n "$dlpreopen" && dlprefiles="$dlprefiles $dlpreopen"
-	fi
-
-	if test $linkmode != lib && test $linkmode != prog; then
-	  # only check for convenience libraries
-	  if test -z "$old_library"; then
-	    $echo "$modename: cannot find name of link library for \`$lib'" 1>&2
-	    exit 1
-	  fi
-	  if test -n "$libdir"; then
-	    $echo "$modename: \`$lib' is not a convenience library" 1>&2
-	    exit 1
-	  fi
-	  # It is a libtool convenience library, so add in its objects.
-	  convenience="$convenience $ladir/$objdir/$old_library"
-	  old_convenience="$old_convenience $ladir/$objdir/$old_library"
-	  continue
-	fi
-
-	# Get the name of the library we link against.
-	linklib=
-	for l in $old_library $library_names; do
-	  linklib="$l"
-	done
-	if test -z "$linklib"; then
-	  $echo "$modename: cannot find name of link library for \`$lib'" 1>&2
-	  exit 1
-	fi
-
-	# This library was specified with -dlopen.
-	if test $pass = dlopen; then
-	  if test -z "$dlname" || test "$dlopen_support" != yes || test "$build_libtool_libs" = no; then
-	    # If there is no dlname, no dlopen support or we're linking statically,
-	    # we need to preload.
-	    dlprefiles="$dlprefiles $lib"
-	  else
-	    newdlfiles="$newdlfiles $lib"
-	  fi
-	  continue
-	fi
-
-	# We need an absolute path.
-	case "$ladir" in
-	[\\/]* | [A-Za-z]:[\\/]*) abs_ladir="$ladir" ;;
-	*)
-	  abs_ladir=`cd "$ladir" && pwd`
-	  if test -z "$abs_ladir"; then
-	    $echo "$modename: warning: cannot determine absolute directory name of \`$ladir'" 1>&2
-	    $echo "$modename: passing it literally to the linker, although it might fail" 1>&2
-	    abs_ladir="$ladir"
-	  fi
-	  ;;
-	esac
-	laname=`$echo "X$lib" | $Xsed -e 's%^.*/%%'`
-
-	# Find the relevant object directory and library name.
-	if test "X$installed" = Xyes; then
-	  if test ! -f "$libdir/$linklib" && test -f "$abs_ladir/$linklib"; then
-	    $echo "$modename: warning: library \`$lib' was moved." 1>&2
-	    dir="$ladir"
-	    absdir="$abs_ladir"
-	    libdir="$abs_ladir"
-	  else
-	    dir="$libdir"
-	    absdir="$libdir"
-	  fi
-	else
-	  dir="$ladir/$objdir"
-	  absdir="$abs_ladir/$objdir"
-	  # Remove this search path later
-	  uninst_path="$uninst_path $abs_ladir"
-	fi
-	name=`$echo "X$laname" | $Xsed -e 's/\.la$//' -e 's/^lib//'`
-
-	# This library was specified with -dlpreopen.
-	if test $pass = dlpreopen; then
-	  # Prefer using a static library (so that no silly _DYNAMIC symbols
-	  # are required to link).
-	  if test -n "$old_library"; then
-	    newdlprefiles="$newdlprefiles $dir/$old_library"
-	  else
-	    newdlprefiles="$newdlprefiles $dir/$linklib"
-	  fi
-	fi
-
-	if test $linkmode = prog && test $pass != link; then
-	  new_lib_search_path="$new_lib_search_path $ladir"
-	  deplibs="$lib $deplibs"
-
-	  linkalldeplibs=no
-	  if test "$link_all_deplibs" != no || test "$fast_install" != no || \
-	     test "$build_libtool_libs" = no || test -z "$library_names"; then
-	    linkalldeplibs=yes
-	  fi
-
-	  tmp_libs=
-	  for deplib in $dependency_libs; do
-	    case "$deplib" in
-	    -L*) new_lib_search_path="$new_lib_search_path "`$echo "X$deplib" | $Xsed -e 's/^-L//'`;; ### testsuite: skip nested quoting test
-	    esac
-	    # Need to link against all dependency_libs?
-	    if test $linkalldeplibs = yes; then
-	      deplibs="$deplib $deplibs"
-	    else
-	      # Need to hardcode shared library paths
-	      # or/and link against static libraries
-	      newdependency_libs="$deplib $newdependency_libs"
-	    fi
-	    case "$tmp_libs " in
-	    *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
-	    esac
-	    tmp_libs="$tmp_libs $deplib"
-	  done
-	  continue
-	fi
-
-	if test -z "$libdir"; then
-	  # It is a libtool convenience library, so add in its objects.
-	  convenience="$convenience $dir/$old_library"
-	  old_convenience="$old_convenience $dir/$old_library"
-	  if test $linkmode = lib; then
-	    deplibs="$dir/$old_library $deplibs"
-	    tmp_libs=
-	    for deplib in $dependency_libs; do
-	      newdependency_libs="$deplib $newdependency_libs"
-	      case "$tmp_libs " in
-	      *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
-	      esac
-	      tmp_libs="$tmp_libs $deplib"
-	    done
-	  elif test "$linkmode,$pass" = "prog,link"; then
-	    compile_deplibs="$dir/$old_library $compile_deplibs"
-	    finalize_deplibs="$dir/$old_library $finalize_deplibs"
-	  fi
-	  continue
-	fi
-
-	if test "$linkmode,$pass" = "prog,link"; then
-	  if test -n "$library_names" &&
-	     { test "$hardcode_into_libs" != all || test "$alldeplibs" != yes; } &&
-	     { test "$prefer_static_libs" = no || test -z "$old_library"; }; then
-	    # We need to hardcode the library path
-	    if test -n "$shlibpath_var"; then
-	      # Make sure the rpath contains only unique directories.
-	      case "$temp_rpath " in
-	      *" $dir "*) ;;
-	      *" $absdir "*) ;;
-	      *) temp_rpath="$temp_rpath $dir" ;;
-	      esac
-	    fi
-
-	    # Hardcode the library path.
-	    # Skip directories that are in the system default run-time
-	    # search path.
-	    case " $sys_lib_dlsearch_path " in
-	    *" $absdir "*) ;;
-	    *)
-	      case "$compile_rpath " in
-	      *" $absdir "*) ;;
-	      *) compile_rpath="$compile_rpath $absdir"
-	      esac
-	      ;;
-	    esac
-
-	    case " $sys_lib_dlsearch_path " in
-	    *" $libdir "*) ;;
-	    *)
-	      case "$finalize_rpath " in
-	      *" $libdir "*) ;;
-	      *) finalize_rpath="$finalize_rpath $libdir"
-	      esac
-	      ;;
-	    esac
-	  fi
-
-	  if test "$alldeplibs" = yes &&
-	     { test "$deplibs_check_method" = pass_all ||
-	       { test "$build_libtool_libs" = yes &&
-		 test -n "$library_names"; }; }; then
-	    # Do we only need to link against static libraries?
-	    continue
-	  fi
-	fi
-
-	link_static=no # Whether this library is linked statically
-	if test -n "$library_names" &&
-	   { test "$prefer_static_libs" = no || test -z "$old_library"; }; then
-	  link_against_libtool_libs="$link_against_libtool_libs $lib"
-	  test "X$installed" = xno && need_relink=yes
-	  # This is a shared library
-	  if test $linkmode = lib && test "$hardcode_into_libs" = all; then
-	    # Hardcode the library path.
-	    # Skip directories that are in the system default run-time
-	    # search path.
-	    case " $sys_lib_dlsearch_path " in
-	    *" $absdir "*) ;;
-	    *)
-	      case "$compile_rpath " in
-	      *" $absdir "*) ;;
-	      *) compile_rpath="$compile_rpath $absdir"
-	      esac
-	      ;;
-	    esac
-	    case " $sys_lib_dlsearch_path " in
-	    *" $libdir "*) ;;
-	    *)
-	      case "$finalize_rpath " in
-	      *" $libdir "*) ;;
-	      *) finalize_rpath="$finalize_rpath $libdir"
-	      esac
-	      ;;
-	    esac
-	  fi
-
-	  if test -n "$old_archive_from_expsyms_cmds"; then
-	    # figure out the soname
-	    set dummy $library_names
-	    realname="$2"
-	    shift; shift
-	    libname=`eval \\$echo \"$libname_spec\"`
-	    if test -n "$soname_spec"; then
-	      eval soname=\"$soname_spec\"
-	    else
-	      soname="$realname"
-	    fi
-
-	    # Make a new name for the extract_expsyms_cmds to use
-	    newlib="libimp-`echo $soname | sed 's/^lib//;s/\.dll$//'`.a"
-
-	    # If the library has no export list, then create one now
-	    if test -f "$output_objdir/$soname-def"; then :
-	    else
-	      $show "extracting exported symbol list from \`$soname'"
-	      IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
-	      eval cmds=\"$extract_expsyms_cmds\"
-	      for cmd in $cmds; do
-		IFS="$save_ifs"
-		$show "$cmd"
-		$run eval "$cmd" || exit $?
-	      done
-	      IFS="$save_ifs"
-	    fi
-
-	    # Create $newlib
-	    if test -f "$output_objdir/$newlib"; then :; else
-	      $show "generating import library for \`$soname'"
-	      IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
-	      eval cmds=\"$old_archive_from_expsyms_cmds\"
-	      for cmd in $cmds; do
-		IFS="$save_ifs"
-		$show "$cmd"
-		$run eval "$cmd" || exit $?
-	      done
-	      IFS="$save_ifs"
-	    fi
-	    # make sure the library variables are pointing to the new library
-	    dir=$output_objdir
-	    linklib=$newlib
-	  fi
-
-	  if test $linkmode = prog || test "$mode" != relink; then
-	    add_shlibpath=
-	    add_dir=
-	    add=
-	    lib_linked=yes
-	    case "$hardcode_action" in
-	    immediate | unsupported)
-	      if test "$hardcode_direct" = no; then
-		add="$dir/$linklib"
-	      elif test "$hardcode_minus_L" = no; then
-		case "$host" in
-		*-*-sunos*) add_shlibpath="$dir" ;;
-		esac
-		add_dir="-L$dir"
-		add="-l$name"
-	      elif test "$hardcode_shlibpath_var" = no; then
-		add_shlibpath="$dir"
-		add="-l$name"
-	      else
-		lib_linked=no
-	      fi
-	      ;;
-	    relink)
-	      if test "$hardcode_direct" = yes; then
-		add="$dir/$linklib"
-	      elif test "$hardcode_minus_L" = yes; then
-		add_dir="-L$dir"
-		add="-l$name"
-	      elif test "$hardcode_shlibpath_var" = yes; then
-		add_shlibpath="$dir"
-		add="-l$name"
-	      else
-		lib_linked=no
-	      fi
-	      ;;
-	    *) lib_linked=no ;;
-	    esac
-
-	    if test "$lib_linked" != yes; then
-	      $echo "$modename: configuration error: unsupported hardcode properties"
-	      exit 1
-	    fi
-
-	    if test -n "$add_shlibpath"; then
-	      case ":$compile_shlibpath:" in
-	      *":$add_shlibpath:"*) ;;
-	      *) compile_shlibpath="$compile_shlibpath$add_shlibpath:" ;;
-	      esac
-	    fi
-	    if test $linkmode = prog; then
-	      test -n "$add_dir" && compile_deplibs="$add_dir $compile_deplibs"
-	      test -n "$add" && compile_deplibs="$add $compile_deplibs"
-	    else
-	      test -n "$add_dir" && deplibs="$add_dir $deplibs"
-	      test -n "$add" && deplibs="$add $deplibs"
-	      if test "$hardcode_direct" != yes && \
-		 test "$hardcode_minus_L" != yes && \
-		 test "$hardcode_shlibpath_var" = yes; then
-		case ":$finalize_shlibpath:" in
-		*":$libdir:"*) ;;
-		*) finalize_shlibpath="$finalize_shlibpath$libdir:" ;;
-		esac
-	      fi
-	    fi
-	  fi
-
-	  if test $linkmode = prog || test "$mode" = relink; then
-	    add_shlibpath=
-	    add_dir=
-	    add=
-	    # Finalize command for both is simple: just hardcode it.
-	    if test "$hardcode_direct" = yes; then
-	      add="$libdir/$linklib"
-	    elif test "$hardcode_minus_L" = yes; then
-	      add_dir="-L$libdir"
-	      add="-l$name"
-	    elif test "$hardcode_shlibpath_var" = yes; then
-	      case ":$finalize_shlibpath:" in
-	      *":$libdir:"*) ;;
-	      *) finalize_shlibpath="$finalize_shlibpath$libdir:" ;;
-	      esac
-	      add="-l$name"
-	    else
-	      # We cannot seem to hardcode it, guess we'll fake it.
-	      add_dir="-L$libdir"
-	      add="-l$name"
-	    fi
-
-	    if test $linkmode = prog; then
-	      test -n "$add_dir" && finalize_deplibs="$add_dir $finalize_deplibs"
-	      test -n "$add" && finalize_deplibs="$add $finalize_deplibs"
-	    else
-	      test -n "$add_dir" && deplibs="$add_dir $deplibs"
-	      test -n "$add" && deplibs="$add deplibs"
-	    fi
-	  fi
-	elif test $linkmode = prog; then
-	  # Here we assume that one of hardcode_direct or hardcode_minus_L
-	  # is not unsupported.  This is valid on all known static and
-	  # shared platforms.
-	  if test "$hardcode_direct" != unsupported; then
-	    test -n "$old_library" && linklib="$old_library"
-	    compile_deplibs="$dir/$linklib $compile_deplibs"
-	    finalize_deplibs="$dir/$linklib $finalize_deplibs"
-	  else
-	    compile_deplibs="-l$name -L$dir $compile_deplibs"
-	    finalize_deplibs="-l$name -L$dir $finalize_deplibs"
-	  fi
-	elif test "$build_libtool_libs" = yes; then
-	  # Not a shared library
-	  if test "$deplibs_check_method" != pass_all; then
-	    # We're trying link a shared library against a static one
-	    # but the system doesn't support it.
-	    # Just print a warning and add the library to dependency_libs so
-	    # that the program can be linked against the static library.
-	    echo
-	    echo "*** Warning: This library needs some functionality provided by $lib."
-	    echo "*** I have the capability to make that library automatically link in when"
-	    echo "*** you link to this library.  But I can only do this if you have a"
-	    echo "*** shared version of the library, which you do not appear to have."
-	  else
-	    convenience="$convenience $dir/$old_library"
-	    old_convenience="$old_convenience $dir/$old_library"
-	    deplibs="$dir/$old_library $deplibs"
-	    link_static=yes
-	  fi
-	fi
-
-	if test $linkmode = lib; then
-	  if test -n "$dependency_libs" &&
-	     { test "$hardcode_into_libs" = no || test $build_old_libs = yes ||
-	       test $link_static = yes; }; then
-	    # Extract -R from dependency_libs
-	    temp_deplibs=
-	    for libdir in $dependency_libs; do
-	      case "$libdir" in
-	      -R*) temp_xrpath=`$echo "X$libdir" | $Xsed -e 's/^-R//'`
-		   case " $xrpath " in
-		   *" $temp_xrpath "*) ;;
-		   *) xrpath="$xrpath $temp_xrpath";;
-		   esac;;
-	      *) temp_deplibs="$temp_deplibs $libdir";;
-	      esac
-	    done
-	    dependency_libs="$temp_deplibs"
-	  fi
-
-	  new_lib_search_path="$new_lib_search_path $absdir"
-	  # Link against this library
-	  test "$link_static" = no && newdependency_libs="$abs_ladir/$laname $newdependency_libs"
-	  # ... and its dependency_libs
-	  tmp_libs=
-	  for deplib in $dependency_libs; do
-	    newdependency_libs="$deplib $newdependency_libs"
-	    case "$tmp_libs " in
-	    *" $deplib "*) specialdeplibs="$specialdeplibs $deplib" ;;
-	    esac
-	    tmp_libs="$tmp_libs $deplib"
-	  done
-
-	  if test $link_all_deplibs != no; then
-	    # Add the search paths of all dependency libraries
-	    for deplib in $dependency_libs; do
-	      case "$deplib" in
-	      -L*) path="$deplib" ;;
-	      *.la)
-		dir=`$echo "X$deplib" | $Xsed -e 's%/[^/]*$%%'`
-		test "X$dir" = "X$deplib" && dir="."
-		# We need an absolute path.
-		case "$dir" in
-		[\\/]* | [A-Za-z]:[\\/]*) absdir="$dir" ;;
-		*)
-		  absdir=`cd "$dir" && pwd`
-		  if test -z "$absdir"; then
-		    $echo "$modename: warning: cannot determine absolute directory name of \`$dir'" 1>&2
-		    absdir="$dir"
-		  fi
-		  ;;
-		esac
-		if grep "^installed=no" $deplib > /dev/null; then
-		  path="-L$absdir/$objdir"
-		else
-		  eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $deplib`
-		  if test -z "$libdir"; then
-		    $echo "$modename: \`$deplib' is not a valid libtool archive" 1>&2
-		    exit 1
-		  fi
-		  if test "$absdir" != "$libdir"; then
-		    $echo "$modename: warning: \`$deplib' seems to be moved" 1>&2
-		  fi
-		  path="-L$absdir"
-		fi
-		;;
-	      *) continue ;;
-	      esac
-	      case " $deplibs " in
-	      *" $path "*) ;;
-	      *) deplibs="$deplibs $path" ;;
-	      esac
-	    done
-	  fi
-	fi
-      done
-      dependency_libs="$newdependency_libs"
-      if test $pass = dlpreopen; then
-	# Link the dlpreopened libraries before other libraries
-	deplibs="$deplibs $save_deplibs"
-      elif test $pass != dlopen; then
-	# Make sure lib_search_path contains only unique directories.
-	lib_search_path=
-	for dir in $new_lib_search_path; do
-	  case "$lib_search_path " in
-	  *" $dir "*) ;;
-	  *) lib_search_path="$lib_search_path $dir" ;;
-	  esac
-	done
-	lib_search_path="$lib_search_path $sys_lib_search_path"
-
-	if test "$linkmode,$pass" != "prog,link"; then
-	  vars="deplibs"
-	else
-	  vars="compile_deplibs finalize_deplibs"
-	fi
-	for var in $vars dependency_libs; do
-	  # Make sure that $var contains only unique libraries
-	  # and add them in reverse order
-	  eval tmp_libs=\"\$$var\"
-	  new_libs=
-	  for deplib in $tmp_libs; do
-	    case "$deplib" in
-	    -L*) new_libs="$deplib $new_libs" ;;
-	    *)
-	      case " $specialdeplibs " in
-	      *" $deplib "*) new_libs="$deplib $new_libs" ;;
-	      *)
-		case " $new_libs " in
-		*" $deplib "*) ;;
-		*) new_libs="$deplib $new_libs" ;;
-		esac
-		;;
-	      esac
-	      ;;
-	    esac
-	  done
-	  tmp_libs=
-	  for deplib in $new_libs; do
-	    case "$deplib" in
-	    -L*)
-	      case " $tmp_libs " in
-	      *" $deplib "*) ;;
-	      *) tmp_libs="$tmp_libs $deplib" ;;
-	      esac
-	      ;;
-	    *) tmp_libs="$tmp_libs $deplib" ;;
-	    esac
-	  done
-	  eval $var=\"$tmp_libs\"
-	done
-      fi
-    done
-    if test $linkmode = prog; then
-      dlfiles="$newdlfiles"
-      dlprefiles="$newdlprefiles"
-    fi
-
-    case $linkmode in
-    oldlib)
-      if test -n "$deplibs"; then
-	$echo "$modename: warning: \`-l' and \`-L' are ignored for archives" 1>&2
-      fi
-
-      if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
-	$echo "$modename: warning: \`-dlopen' is ignored for archives" 1>&2
-      fi
-
-      if test -n "$rpath"; then
-	$echo "$modename: warning: \`-rpath' is ignored for archives" 1>&2
-      fi
-
-      if test -n "$xrpath"; then
-	$echo "$modename: warning: \`-R' is ignored for archives" 1>&2
-      fi
-
-      if test -n "$vinfo"; then
-	$echo "$modename: warning: \`-version-info' is ignored for archives" 1>&2
-      fi
-
-      if test -n "$release"; then
-	$echo "$modename: warning: \`-release' is ignored for archives" 1>&2
-      fi
-
-      if test -n "$export_symbols" || test -n "$export_symbols_regex"; then
-	$echo "$modename: warning: \`-export-symbols' is ignored for archives" 1>&2
-      fi
-
-      # Now set the variables for building old libraries.
-      build_libtool_libs=no
-      oldlibs="$output"
-      objs="$objs$old_deplibs"
-      ;;
-
-    lib)
-      # Make sure we only generate libraries of the form `libNAME.la'.
-      case "$outputname" in
-      lib*)
-	name=`$echo "X$outputname" | $Xsed -e 's/\.la$//' -e 's/^lib//'`
-	eval libname=\"$libname_spec\"
-	;;
-      *)
-	if test "$module" = no; then
-	  $echo "$modename: libtool library \`$output' must begin with \`lib'" 1>&2
-	  $echo "$help" 1>&2
-	  exit 1
-	fi
-	if test "$need_lib_prefix" != no; then
-	  # Add the "lib" prefix for modules if required
-	  name=`$echo "X$outputname" | $Xsed -e 's/\.la$//'`
-	  eval libname=\"$libname_spec\"
-	else
-	  libname=`$echo "X$outputname" | $Xsed -e 's/\.la$//'`
-	fi
-	;;
-      esac
-
-      if test -n "$objs"; then
-	if test "$deplibs_check_method" != pass_all; then
-	  $echo "$modename: cannot build libtool library \`$output' from non-libtool objects on this host:$objs" 2>&1
-	  exit 1
-	else
-	  echo
-	  echo "*** Warning: Linking the shared library $output against the non-libtool"
-	  echo "*** objects $objs is not portable!"
-	  libobjs="$libobjs $objs"
-	fi
-      fi
-
-      if test "$dlself" != no; then
-	$echo "$modename: warning: \`-dlopen self' is ignored for libtool libraries" 1>&2
-      fi
-
-      set dummy $rpath
-      if test $# -gt 2; then
-	$echo "$modename: warning: ignoring multiple \`-rpath's for a libtool library" 1>&2
-      fi
-      install_libdir="$2"
-
-      oldlibs=
-      if test -z "$rpath"; then
-	if test "$build_libtool_libs" = yes; then
-	  # Building a libtool convenience library.
-	  libext=al
-	  oldlibs="$output_objdir/$libname.$libext $oldlibs"
-	  build_libtool_libs=convenience
-	  build_old_libs=yes
-	fi
-
-	if test -n "$vinfo"; then
-	  $echo "$modename: warning: \`-version-info' is ignored for convenience libraries" 1>&2
-	fi
-
-	if test -n "$release"; then
-	  $echo "$modename: warning: \`-release' is ignored for convenience libraries" 1>&2
-	fi
-      else
-
-	# Parse the version information argument.
-	IFS="${IFS= 	}"; save_ifs="$IFS"; IFS=':'
-	set dummy $vinfo 0 0 0
-	IFS="$save_ifs"
-
-	if test -n "$8"; then
-	  $echo "$modename: too many parameters to \`-version-info'" 1>&2
-	  $echo "$help" 1>&2
-	  exit 1
-	fi
-
-	current="$2"
-	revision="$3"
-	age="$4"
-
-	# Check that each of the things are valid numbers.
-	case "$current" in
-	0 | [1-9] | [1-9][0-9]*) ;;
-	*)
-	  $echo "$modename: CURRENT \`$current' is not a nonnegative integer" 1>&2
-	  $echo "$modename: \`$vinfo' is not valid version information" 1>&2
-	  exit 1
-	  ;;
-	esac
-
-	case "$revision" in
-	0 | [1-9] | [1-9][0-9]*) ;;
-	*)
-	  $echo "$modename: REVISION \`$revision' is not a nonnegative integer" 1>&2
-	  $echo "$modename: \`$vinfo' is not valid version information" 1>&2
-	  exit 1
-	  ;;
-	esac
-
-	case "$age" in
-	0 | [1-9] | [1-9][0-9]*) ;;
-	*)
-	  $echo "$modename: AGE \`$age' is not a nonnegative integer" 1>&2
-	  $echo "$modename: \`$vinfo' is not valid version information" 1>&2
-	  exit 1
-	  ;;
-	esac
-
-	if test $age -gt $current; then
-	  $echo "$modename: AGE \`$age' is greater than the current interface number \`$current'" 1>&2
-	  $echo "$modename: \`$vinfo' is not valid version information" 1>&2
-	  exit 1
-	fi
-
-	# Calculate the version variables.
-	major=
-	versuffix=
-	verstring=
-	case "$version_type" in
-	none) ;;
-
-	irix)
-	  major=`expr $current - $age + 1`
-	  versuffix="$major.$revision"
-	  verstring="sgi$major.$revision"
-
-	  # Add in all the interfaces that we are compatible with.
-	  loop=$revision
-	  while test $loop != 0; do
-	    iface=`expr $revision - $loop`
-	    loop=`expr $loop - 1`
-	    verstring="sgi$major.$iface:$verstring"
-	  done
-	  ;;
-
-	linux)
-	  major=.`expr $current - $age`
-	  versuffix="$major.$age.$revision"
-	  ;;
-
-	osf)
-	  major=`expr $current - $age`
-	  versuffix=".$current.$age.$revision"
-	  verstring="$current.$age.$revision"
-
-	  # Add in all the interfaces that we are compatible with.
-	  loop=$age
-	  while test $loop != 0; do
-	    iface=`expr $current - $loop`
-	    loop=`expr $loop - 1`
-	    verstring="$verstring:${iface}.0"
-	  done
-
-	  # Make executables depend on our current version.
-	  verstring="$verstring:${current}.0"
-	  ;;
-
-	sunos)
-	  major=".$current"
-	  versuffix=".$current.$revision"
-	  ;;
-
-	freebsd-aout)
-	  major=".$current"
-	  versuffix=".$current.$revision";
-	  ;;
-
-	freebsd-elf)
-	  major=".$current"
-	  versuffix=".$current";
-	  ;;
-
-	windows)
-	  # Like Linux, but with '-' rather than '.', since we only
-	  # want one extension on Windows 95.
-	  major=`expr $current - $age`
-	  versuffix="-$major-$age-$revision"
-	  ;;
-
-	*)
-	  $echo "$modename: unknown library version type \`$version_type'" 1>&2
-	  echo "Fatal configuration error.  See the $PACKAGE docs for more information." 1>&2
-	  exit 1
-	  ;;
-	esac
-
-	# Clear the version info if we defaulted, and they specified a release.
-	if test -z "$vinfo" && test -n "$release"; then
-	  major=
-	  verstring="0.0"
-	  if test "$need_version" = no; then
-	    versuffix=
-	  else
-	    versuffix=".0.0"
-	  fi
-	fi
-
-	# Remove version info from name if versioning should be avoided
-	if test "$avoid_version" = yes && test "$need_version" = no; then
-	  major=
-	  versuffix=
-	  verstring=""
-	fi
-
-	# Check to see if the archive will have undefined symbols.
-	if test "$allow_undefined" = yes; then
-	  if test "$allow_undefined_flag" = unsupported; then
-	    $echo "$modename: warning: undefined symbols not allowed in $host shared libraries" 1>&2
-	    build_libtool_libs=no
-	    build_old_libs=yes
-	  fi
-	else
-	  # Don't allow undefined symbols.
-	  allow_undefined_flag="$no_undefined_flag"
-	fi
-      fi
-
-      if test "$mode" != relink; then
-	# Remove our outputs.
-	$show "${rm}r $output_objdir/$outputname $output_objdir/$libname.* $output_objdir/${libname}${release}.*"
-	$run ${rm}r $output_objdir/$outputname $output_objdir/$libname.* $output_objdir/${libname}${release}.*
-      fi
-
-      # Now set the variables for building old libraries.
-      if test "$build_old_libs" = yes && test "$build_libtool_libs" != convenience ; then
-	oldlibs="$oldlibs $output_objdir/$libname.$libext"
-
-	# Transform .lo files to .o files.
-	oldobjs="$objs "`$echo "X$libobjs" | $SP2NL | $Xsed -e '/\.'${libext}'$/d' -e "$lo2o" | $NL2SP`
-      fi
-
-      # Eliminate all temporary directories.
-      for path in $uninst_path; do
-	lib_search_path=`echo "$lib_search_path " | sed -e 's% $path % %g'`
-	deplibs=`echo "$deplibs " | sed -e 's% -L$path % %g'`
-	dependency_libs=`echo "$dependency_libs " | sed -e 's% -L$path % %g'`
-      done
-
-      if test -n "$xrpath"; then
-	# If the user specified any rpath flags, then add them.
-	temp_xrpath=
-	for libdir in $xrpath; do
-	  temp_xrpath="$temp_xrpath -R$libdir"
-	  case "$finalize_rpath " in
-	  *" $libdir "*) ;;
-	  *) finalize_rpath="$finalize_rpath $libdir" ;;
-	  esac
-	done
-	if test "$hardcode_into_libs" = no || test $build_old_libs = yes; then
-	  dependency_libs="$temp_xrpath $dependency_libs"
-	fi
-      fi
-
-      # Make sure dlfiles contains only unique files that won't be dlpreopened
-      old_dlfiles="$dlfiles"
-      dlfiles=
-      for lib in $old_dlfiles; do
-	case " $dlprefiles $dlfiles " in
-	*" $lib "*) ;;
-	*) dlfiles="$dlfiles $lib" ;;
-	esac
-      done
-
-      # Make sure dlprefiles contains only unique files
-      old_dlprefiles="$dlprefiles"
-      dlprefiles=
-      for lib in $old_dlprefiles; do
-	case "$dlprefiles " in
-	*" $lib "*) ;;
-	*) dlprefiles="$dlprefiles $lib" ;;
-	esac
-      done
-
-      if test "$build_libtool_libs" = yes; then
-	if test -n "$rpath"; then
-	  case "$host" in
-	  *-*-cygwin* | *-*-mingw* | *-*-os2* | *-*-beos*)
-	    # these systems don't actually have a c library (as such)!
-	    ;;
-	  *)
-	    # Add libc to deplibs on all other systems.
-	    deplibs="$deplibs -lc"
-	    ;;
-	  esac
-	fi
-
-	# Transform deplibs into only deplibs that can be linked in shared.
-	name_save=$name
-	libname_save=$libname
-	release_save=$release
-	versuffix_save=$versuffix
-	major_save=$major
-	# I'm not sure if I'm treating the release correctly.  I think
-	# release should show up in the -l (ie -lgmp5) so we don't want to
-	# add it in twice.  Is that correct?
-	release=""
-	versuffix=""
-	major=""
-	newdeplibs=
-	droppeddeps=no
-	case "$deplibs_check_method" in
-	pass_all)
-	  # Don't check for shared/static.  Everything works.
-	  # This might be a little naive.  We might want to check
-	  # whether the library exists or not.  But this is on
-	  # osf3 & osf4 and I'm not really sure... Just
-	  # implementing what was already the behaviour.
-	  newdeplibs=$deplibs
-	  ;;
-	test_compile)
-	  # This code stresses the "libraries are programs" paradigm to its
-	  # limits. Maybe even breaks it.  We compile a program, linking it
-	  # against the deplibs as a proxy for the library.  Then we can check
-	  # whether they linked in statically or dynamically with ldd.
-	  $rm conftest.c
-	  cat > conftest.c <<EOF
-	  int main() { return 0; }
-EOF
-	  $rm conftest
-	  $CC -o conftest conftest.c $deplibs
-	  if test $? -eq 0 ; then
-	    ldd_output=`ldd conftest`
-	    for i in $deplibs; do
-	      name="`expr $i : '-l\(.*\)'`"
-	      # If $name is empty we are operating on a -L argument.
-	      if test "$name" != "" ; then
-		libname=`eval \\$echo \"$libname_spec\"`
-		deplib_matches=`eval \\$echo \"$library_names_spec\"`
-		set dummy $deplib_matches
-		deplib_match=$2
-		if test `expr "$ldd_output" : ".*$deplib_match"` -ne 0 ; then
-		  newdeplibs="$newdeplibs $i"
-		else
-		  droppeddeps=yes
-		  echo
-		  echo "*** Warning: This library needs some functionality provided by $i."
-		  echo "*** I have the capability to make that library automatically link in when"
-		  echo "*** you link to this library.  But I can only do this if you have a"
-		  echo "*** shared version of the library, which you do not appear to have."
-		fi
-	      else
-		newdeplibs="$newdeplibs $i"
-	      fi
-	    done
-	  else
-	    # Error occured in the first compile.  Let's try to salvage the situation:
-	    # Compile a seperate program for each library.
-	    for i in $deplibs; do
-	      name="`expr $i : '-l\(.*\)'`"
-	     # If $name is empty we are operating on a -L argument.
-	      if test "$name" != "" ; then
-		$rm conftest
-		$CC -o conftest conftest.c $i
-		# Did it work?
-		if test $? -eq 0 ; then
-		  ldd_output=`ldd conftest`
-		  libname=`eval \\$echo \"$libname_spec\"`
-		  deplib_matches=`eval \\$echo \"$library_names_spec\"`
-		  set dummy $deplib_matches
-		  deplib_match=$2
-		  if test `expr "$ldd_output" : ".*$deplib_match"` -ne 0 ; then
-		    newdeplibs="$newdeplibs $i"
-		  else
-		    droppeddeps=yes
-		    echo
-		    echo "*** Warning: This library needs some functionality provided by $i."
-		    echo "*** I have the capability to make that library automatically link in when"
-		    echo "*** you link to this library.  But I can only do this if you have a"
-		    echo "*** shared version of the library, which you do not appear to have."
-		  fi
-		else
-		  droppeddeps=yes
-		  echo
-		  echo "*** Warning!  Library $i is needed by this library but I was not able to"
-		  echo "***  make it link in!  You will probably need to install it or some"
-		  echo "*** library that it depends on before this library will be fully"
-		  echo "*** functional.  Installing it before continuing would be even better."
-		fi
-	      else
-		newdeplibs="$newdeplibs $i"
-	      fi
-	    done
-	  fi
-	  ;;
-	file_magic*)
-	  set dummy $deplibs_check_method
-	  file_magic_regex=`expr "$deplibs_check_method" : "$2 \(.*\)"`
-	  for a_deplib in $deplibs; do
-	    name="`expr $a_deplib : '-l\(.*\)'`"
-	    # If $name is empty we are operating on a -L argument.
-	    if test "$name" != "" ; then
-	      libname=`eval \\$echo \"$libname_spec\"`
-	      for i in $lib_search_path; do
-		    potential_libs=`ls $i/$libname[.-]* 2>/dev/null`
-		    for potent_lib in $potential_libs; do
-		      # Follow soft links.
-		      if ls -lLd "$potent_lib" 2>/dev/null \
-			 | grep " -> " >/dev/null; then
-			continue
-		      fi
-		      # The statement above tries to avoid entering an
-		      # endless loop below, in case of cyclic links.
-		      # We might still enter an endless loop, since a link
-		      # loop can be closed while we follow links,
-		      # but so what?
-		      potlib="$potent_lib"
-		      while test -h "$potlib" 2>/dev/null; do
-			potliblink=`ls -ld $potlib | sed 's/.* -> //'`
-			case "$potliblink" in
-			[\\/]* | [A-Za-z]:[\\/]*) potlib="$potliblink";;
-			*) potlib=`$echo "X$potlib" | $Xsed -e 's,[^/]*$,,'`"$potliblink";;
-			esac
-		      done
-		      if eval $file_magic_cmd \"\$potlib\" 2>/dev/null \
-			 | sed 10q \
-			 | egrep "$file_magic_regex" > /dev/null; then
-			newdeplibs="$newdeplibs $a_deplib"
-			a_deplib=""
-			break 2
-		      fi
-		    done
-	      done
-	      if test -n "$a_deplib" ; then
-		droppeddeps=yes
-		echo
-		echo "*** Warning: This library needs some functionality provided by $a_deplib."
-		echo "*** I have the capability to make that library automatically link in when"
-		echo "*** you link to this library.  But I can only do this if you have a"
-		echo "*** shared version of the library, which you do not appear to have."
-	      fi
-	    else
-	      # Add a -L argument.
-	      newdeplibs="$newdeplibs $a_deplib"
-	    fi
-	  done # Gone through all deplibs.
-	  ;;
-	none | unknown | *)
-	  newdeplibs=""
-	  if $echo "X $deplibs" | $Xsed -e 's/ -lc$//' \
-	       -e 's/ -[LR][^ ]*//g' -e 's/[ 	]//g' |
-	     grep . >/dev/null; then
-	    echo
-	    if test "X$deplibs_check_method" = "Xnone"; then
-	      echo "*** Warning: inter-library dependencies are not supported in this platform."
-	    else
-	      echo "*** Warning: inter-library dependencies are not known to be supported."
-	    fi
-	    echo "*** All declared inter-library dependencies are being dropped."
-	    droppeddeps=yes
-	  fi
-	  ;;
-	esac
-	versuffix=$versuffix_save
-	major=$major_save
-	release=$release_save
-	libname=$libname_save
-	name=$name_save
-
-	if test "$droppeddeps" = yes; then
-	  if test "$module" = yes; then
-	    echo
-	    echo "*** Warning: libtool could not satisfy all declared inter-library"
-	    echo "*** dependencies of module $libname.  Therefore, libtool will create"
-	    echo "*** a static module, that should work as long as the dlopening"
-	    echo "*** application is linked with the -dlopen flag."
-	    if test -z "$global_symbol_pipe"; then
-	      echo
-	      echo "*** However, this would only work if libtool was able to extract symbol"
-	      echo "*** lists from a program, using \`nm' or equivalent, but libtool could"
-	      echo "*** not find such a program.  So, this module is probably useless."
-	      echo "*** \`nm' from GNU binutils and a full rebuild may help."
-	    fi
-	    if test "$build_old_libs" = no; then
-	      oldlibs="$output_objdir/$libname.$libext"
-	      build_libtool_libs=module
-	      build_old_libs=yes
-	    else
-	      build_libtool_libs=no
-	    fi
-	  else
-	    echo "*** The inter-library dependencies that have been dropped here will be"
-	    echo "*** automatically added whenever a program is linked with this library"
-	    echo "*** or is declared to -dlopen it."
-	  fi
-	fi
-	# Done checking deplibs!
-	deplibs=$newdeplibs
-      fi
-
-      # All the library-specific variables (install_libdir is set above).
-      library_names=
-      old_library=
-      dlname=
-
-      # Test again, we may have decided not to build it any more
-      if test "$build_libtool_libs" = yes; then
-	if test "$hardcode_into_libs" != no; then
-	  # Hardcode the library paths
-	  hardcode_libdirs=
-	  dep_rpath=
-	  rpath="$finalize_rpath"
-	  test "$mode" != relink && rpath="$compile_rpath$rpath"
-	  for libdir in $rpath; do
-	    if test -n "$hardcode_libdir_flag_spec"; then
-	      if test -n "$hardcode_libdir_separator"; then
-		if test -z "$hardcode_libdirs"; then
-		  hardcode_libdirs="$libdir"
-		else
-		  # Just accumulate the unique libdirs.
-		  case "$hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator" in
-		  *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
-		    ;;
-		  *)
-		    hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir"
-		    ;;
-		  esac
-		fi
-	      else
-		eval flag=\"$hardcode_libdir_flag_spec\"
-		dep_rpath="$dep_rpath $flag"
-	      fi
-	    elif test -n "$runpath_var"; then
-	      case "$perm_rpath " in
-	      *" $libdir "*) ;;
-	      *) perm_rpath="$perm_rpath $libdir" ;;
-	      esac
-	    fi
-	  done
-	  # Substitute the hardcoded libdirs into the rpath.
-	  if test -n "$hardcode_libdir_separator" &&
-	     test -n "$hardcode_libdirs"; then
-	    libdir="$hardcode_libdirs"
-	    eval dep_rpath=\"$hardcode_libdir_flag_spec\"
-	  fi
-	  if test -n "$runpath_var" && test -n "$perm_rpath"; then
-	    # We should set the runpath_var.
-	    rpath=
-	    for dir in $perm_rpath; do
-	      rpath="$rpath$dir:"
-	    done
-	    eval "$runpath_var='$rpath\$$runpath_var'; export $runpath_var"
-	  fi
-	  test -n "$dep_rpath" && deplibs="$dep_rpath $deplibs"
-	fi
-
-	shlibpath="$finalize_shlibpath"
-	test "$mode" != relink && shlibpath="$compile_shlibpath$shlibpath"
-	if test -n "$shlibpath"; then
-	  eval "$shlibpath_var='$shlibpath\$$shlibpath_var'; export $shlibpath_var"
-	fi
-
-	# Get the real and link names of the library.
-	eval library_names=\"$library_names_spec\"
-	set dummy $library_names
-	realname="$2"
-	shift; shift
-
-	if test -n "$soname_spec"; then
-	  eval soname=\"$soname_spec\"
-	else
-	  soname="$realname"
-	fi
-
-	lib="$output_objdir/$realname"
-	for link
-	do
-	  linknames="$linknames $link"
-	done
-
-	# Ensure that we have .o objects for linkers which dislike .lo
-	# (e.g. aix) in case we are running --disable-static
-	for obj in $libobjs; do
-	  xdir=`$echo "X$obj" | $Xsed -e 's%/[^/]*$%%'`
-	  if test "X$xdir" = "X$obj"; then
-	    xdir="."
-	  else
-	    xdir="$xdir"
-	  fi
-	  baseobj=`$echo "X$obj" | $Xsed -e 's%^.*/%%'`
-	  oldobj=`$echo "X$baseobj" | $Xsed -e "$lo2o"`
-	  if test ! -f $xdir/$oldobj; then
-	    $show "(cd $xdir && ${LN_S} $baseobj $oldobj)"
-	    $run eval '(cd $xdir && ${LN_S} $baseobj $oldobj)' || exit $?
-	  fi
-	done
-
-	# Use standard objects if they are pic
-	test -z "$pic_flag" && libobjs=`$echo "X$libobjs" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
-
-	# Prepare the list of exported symbols
-	if test -z "$export_symbols"; then
-	  if test "$always_export_symbols" = yes || test -n "$export_symbols_regex"; then
-	    $show "generating symbol list for \`$libname.la'"
-	    export_symbols="$output_objdir/$libname.exp"
-	    $run $rm $export_symbols
-	    eval cmds=\"$export_symbols_cmds\"
-	    IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
-	    for cmd in $cmds; do
-	      IFS="$save_ifs"
-	      $show "$cmd"
-	      $run eval "$cmd" || exit $?
-	    done
-	    IFS="$save_ifs"
-	    if test -n "$export_symbols_regex"; then
-	      $show "egrep -e \"$export_symbols_regex\" \"$export_symbols\" > \"${export_symbols}T\""
-	      $run eval 'egrep -e "$export_symbols_regex" "$export_symbols" > "${export_symbols}T"'
-	      $show "$mv \"${export_symbols}T\" \"$export_symbols\""
-	      $run eval '$mv "${export_symbols}T" "$export_symbols"'
-	    fi
-	  fi
-	fi
-
-	if test -n "$export_symbols" && test -n "$include_expsyms"; then
-	  $run eval '$echo "X$include_expsyms" | $SP2NL >> "$export_symbols"'
-	fi
-
-	if test -n "$convenience"; then
-	  if test -n "$whole_archive_flag_spec"; then
-	    eval libobjs=\"\$libobjs $whole_archive_flag_spec\"
-	  else
-	    gentop="$output_objdir/${outputname}x"
-	    $show "${rm}r $gentop"
-	    $run ${rm}r "$gentop"
-	    $show "mkdir $gentop"
-	    $run mkdir "$gentop"
-	    status=$?
-	    if test $status -ne 0 && test ! -d "$gentop"; then
-	      exit $status
-	    fi
-	    generated="$generated $gentop"
-
-	    for xlib in $convenience; do
-	      # Extract the objects.
-	      case "$xlib" in
-	      [\\/]* | [A-Za-z]:[\\/]*) xabs="$xlib" ;;
-	      *) xabs=`pwd`"/$xlib" ;;
-	      esac
-	      xlib=`$echo "X$xlib" | $Xsed -e 's%^.*/%%'`
-	      xdir="$gentop/$xlib"
-
-	      $show "${rm}r $xdir"
-	      $run ${rm}r "$xdir"
-	      $show "mkdir $xdir"
-	      $run mkdir "$xdir"
-	      status=$?
-	      if test $status -ne 0 && test ! -d "$xdir"; then
-		exit $status
-	      fi
-	      $show "(cd $xdir && $AR x $xabs)"
-	      $run eval "(cd \$xdir && $AR x \$xabs)" || exit $?
-
-	      libobjs="$libobjs "`find $xdir -name \*.o -print -o -name \*.lo -print | $NL2SP`
-	    done
-	  fi
-	fi
-
-	if test "$thread_safe" = yes && test -n "$thread_safe_flag_spec"; then
-	  eval flag=\"$thread_safe_flag_spec\"
-	  linker_flags="$linker_flags $flag"
-	fi
-
-	# Make a backup of the uninstalled library when relinking
-	if test "$mode" = relink && test "$hardcode_into_libs" = all; then
-	  $run eval '(cd $output_objdir && $rm ${realname}U && $mv $realname ${realname}U)' || exit $?
-	fi
-
-	# Do each of the archive commands.
-	if test -n "$export_symbols" && test -n "$archive_expsym_cmds"; then
-	  eval cmds=\"$archive_expsym_cmds\"
-	else
-	  eval cmds=\"$archive_cmds\"
-	fi
-	IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
-	for cmd in $cmds; do
-	  IFS="$save_ifs"
-	  $show "$cmd"
-	  $run eval "$cmd" || exit $?
-	done
-	IFS="$save_ifs"
-
-	# Restore the uninstalled library and exit
-	if test "$mode" = relink && test "$hardcode_into_libs" = all; then
-	  $run eval '(cd $output_objdir && $rm ${realname}T && $mv $realname ${realname}T && $mv "$realname"U $realname)' || exit $?
-	  exit 0
-	fi
-
-	# Create links to the real library.
-	for linkname in $linknames; do
-	  if test "$realname" != "$linkname"; then
-	    $show "(cd $output_objdir && $rm $linkname && $LN_S $realname $linkname)"
-	    $run eval '(cd $output_objdir && $rm $linkname && $LN_S $realname $linkname)' || exit $?
-	  fi
-	done
-
-	# If -module or -export-dynamic was specified, set the dlname.
-	if test "$module" = yes || test "$export_dynamic" = yes; then
-	  # On all known operating systems, these are identical.
-	  dlname="$soname"
-	fi
-      fi
-      ;;
-
-    obj)
-      if test -n "$deplibs"; then
-	$echo "$modename: warning: \`-l' and \`-L' are ignored for objects" 1>&2
-      fi
-
-      if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
-	$echo "$modename: warning: \`-dlopen' is ignored for objects" 1>&2
-      fi
-
-      if test -n "$rpath"; then
-	$echo "$modename: warning: \`-rpath' is ignored for objects" 1>&2
-      fi
-
-      if test -n "$xrpath"; then
-	$echo "$modename: warning: \`-R' is ignored for objects" 1>&2
-      fi
-
-      if test -n "$vinfo"; then
-	$echo "$modename: warning: \`-version-info' is ignored for objects" 1>&2
-      fi
-
-      if test -n "$release"; then
-	$echo "$modename: warning: \`-release' is ignored for objects" 1>&2
-      fi
-
-      case "$output" in
-      *.lo)
-	if test -n "$objs$old_deplibs"; then
-	  $echo "$modename: cannot build library object \`$output' from non-libtool objects" 1>&2
-	  exit 1
-	fi
-	libobj="$output"
-	obj=`$echo "X$output" | $Xsed -e "$lo2o"`
-	;;
-      *)
-	libobj=
-	obj="$output"
-	;;
-      esac
-
-      # Delete the old objects.
-      $run $rm $obj $libobj
-
-      # Objects from convenience libraries.  This assumes
-      # single-version convenience libraries.  Whenever we create
-      # different ones for PIC/non-PIC, this we'll have to duplicate
-      # the extraction.
-      reload_conv_objs=
-      gentop=
-      # reload_cmds runs $LD directly, so let us get rid of
-      # -Wl from whole_archive_flag_spec
-      wl=
-
-      if test -n "$convenience"; then
-	if test -n "$whole_archive_flag_spec"; then
-	  eval reload_conv_objs=\"\$reload_objs $whole_archive_flag_spec\"
-	else
-	  gentop="$output_objdir/${obj}x"
-	  $show "${rm}r $gentop"
-	  $run ${rm}r "$gentop"
-	  $show "mkdir $gentop"
-	  $run mkdir "$gentop"
-	  status=$?
-	  if test $status -ne 0 && test ! -d "$gentop"; then
-	    exit $status
-	  fi
-	  generated="$generated $gentop"
-
-	  for xlib in $convenience; do
-	    # Extract the objects.
-	    case "$xlib" in
-	    [\\/]* | [A-Za-z]:[\\/]*) xabs="$xlib" ;;
-	    *) xabs=`pwd`"/$xlib" ;;
-	    esac
-	    xlib=`$echo "X$xlib" | $Xsed -e 's%^.*/%%'`
-	    xdir="$gentop/$xlib"
-
-	    $show "${rm}r $xdir"
-	    $run ${rm}r "$xdir"
-	    $show "mkdir $xdir"
-	    $run mkdir "$xdir"
-	    status=$?
-	    if test $status -ne 0 && test ! -d "$xdir"; then
-	      exit $status
-	    fi
-	    $show "(cd $xdir && $AR x $xabs)"
-	    $run eval "(cd \$xdir && $AR x \$xabs)" || exit $?
-
-	    reload_conv_objs="$reload_objs "`find $xdir -name \*.o -print -o -name \*.lo -print | $NL2SP`
-	  done
-	fi
-      fi
-
-      # Create the old-style object.
-      reload_objs="$objs$old_deplibs "`$echo "X$libobjs" | $SP2NL | $Xsed -e '/\.'${libext}$'/d' -e '/\.lib$/d' -e "$lo2o" | $NL2SP`" $reload_conv_objs" ### testsuite: skip nested quoting test
-
-      output="$obj"
-      eval cmds=\"$reload_cmds\"
-      IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
-      for cmd in $cmds; do
-	IFS="$save_ifs"
-	$show "$cmd"
-	$run eval "$cmd" || exit $?
-      done
-      IFS="$save_ifs"
-
-      # Exit if we aren't doing a library object file.
-      if test -z "$libobj"; then
-	if test -n "$gentop"; then
-	  $show "${rm}r $gentop"
-	  $run ${rm}r $gentop
-	fi
-
-	exit 0
-      fi
-
-      if test "$build_libtool_libs" != yes; then
-	if test -n "$gentop"; then
-	  $show "${rm}r $gentop"
-	  $run ${rm}r $gentop
-	fi
-
-	# Create an invalid libtool object if no PIC, so that we don't
-	# accidentally link it into a program.
-	$show "echo timestamp > $libobj"
-	$run eval "echo timestamp > $libobj" || exit $?
-	exit 0
-      fi
-
-      if test -n "$pic_flag" || test "$pic_mode" != default; then
-	# Only do commands if we really have different PIC objects.
-	reload_objs="$libobjs $reload_conv_objs"
-	output="$libobj"
-	eval cmds=\"$reload_cmds\"
-	IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
-	for cmd in $cmds; do
-	  IFS="$save_ifs"
-	  $show "$cmd"
-	  $run eval "$cmd" || exit $?
-	done
-	IFS="$save_ifs"
-      else
-	# Just create a symlink.
-	$show $rm $libobj
-	$run $rm $libobj
-	xdir=`$echo "X$libobj" | $Xsed -e 's%/[^/]*$%%'`
-	if test "X$xdir" = "X$libobj"; then
-	  xdir="."
-	else
-	  xdir="$xdir"
-	fi
-	baseobj=`$echo "X$libobj" | $Xsed -e 's%^.*/%%'`
-	oldobj=`$echo "X$baseobj" | $Xsed -e "$lo2o"`
-	$show "(cd $xdir && $LN_S $oldobj $baseobj)"
-	$run eval '(cd $xdir && $LN_S $oldobj $baseobj)' || exit $?
-      fi
-
-      if test -n "$gentop"; then
-	$show "${rm}r $gentop"
-	$run ${rm}r $gentop
-      fi
-
-      exit 0
-      ;;
-
-    prog)
-      if test -n "$vinfo"; then
-	$echo "$modename: warning: \`-version-info' is ignored for programs" 1>&2
-      fi
-
-      if test -n "$release"; then
-	$echo "$modename: warning: \`-release' is ignored for programs" 1>&2
-      fi
-
-      if test "$preload" = yes; then
-	if test "$dlopen_support" = unknown && test "$dlopen_self" = unknown &&
-	   test "$dlopen_self_static" = unknown; then
-	  $echo "$modename: warning: \`AC_LIBTOOL_DLOPEN' not used. Assuming no dlopen support."
-	fi
-      fi
-
-      compile_command="$compile_command $compile_deplibs"
-      finalize_command="$finalize_command $finalize_deplibs"
-
-      if test -n "$rpath$xrpath"; then
-	# If the user specified any rpath flags, then add them.
-	for libdir in $rpath $xrpath; do
-	  # This is the magic to use -rpath.
-	  case "$finalize_rpath " in
-	  *" $libdir "*) ;;
-	  *) finalize_rpath="$finalize_rpath $libdir" ;;
-	  esac
-	done
-      fi
-
-      # Now hardcode the library paths
-      rpath=
-      hardcode_libdirs=
-      for libdir in $compile_rpath $finalize_rpath; do
-	if test -n "$hardcode_libdir_flag_spec"; then
-	  if test -n "$hardcode_libdir_separator"; then
-	    if test -z "$hardcode_libdirs"; then
-	      hardcode_libdirs="$libdir"
-	    else
-	      # Just accumulate the unique libdirs.
-	      case "$hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator" in
-	      *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
-		;;
-	      *)
-		hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir"
-		;;
-	      esac
-	    fi
-	  else
-	    eval flag=\"$hardcode_libdir_flag_spec\"
-	    rpath="$rpath $flag"
-	  fi
-	elif test -n "$runpath_var"; then
-	  case "$perm_rpath " in
-	  *" $libdir "*) ;;
-	  *) perm_rpath="$perm_rpath $libdir" ;;
-	  esac
-	fi
-	case "$host" in
-	*-*-cygwin* | *-*-mingw* | *-*-os2*)
-	  case ":$dllsearchpath:" in
-	  *":$libdir:"*) ;;
-	  *) dllsearchpath="$dllsearchpath:$libdir";;
-	  esac
-	  ;;
-	esac
-      done
-      # Substitute the hardcoded libdirs into the rpath.
-      if test -n "$hardcode_libdir_separator" &&
-	 test -n "$hardcode_libdirs"; then
-	libdir="$hardcode_libdirs"
-	eval rpath=\" $hardcode_libdir_flag_spec\"
-      fi
-      compile_rpath="$rpath"
-
-      rpath=
-      hardcode_libdirs=
-      for libdir in $finalize_rpath; do
-	if test -n "$hardcode_libdir_flag_spec"; then
-	  if test -n "$hardcode_libdir_separator"; then
-	    if test -z "$hardcode_libdirs"; then
-	      hardcode_libdirs="$libdir"
-	    else
-	      # Just accumulate the unique libdirs.
-	      case "$hardcode_libdir_separator$hardcode_libdirs$hardcode_libdir_separator" in
-	      *"$hardcode_libdir_separator$libdir$hardcode_libdir_separator"*)
-		;;
-	      *)
-		hardcode_libdirs="$hardcode_libdirs$hardcode_libdir_separator$libdir"
-		;;
-	      esac
-	    fi
-	  else
-	    eval flag=\"$hardcode_libdir_flag_spec\"
-	    rpath="$rpath $flag"
-	  fi
-	elif test -n "$runpath_var"; then
-	  case "$finalize_perm_rpath " in
-	  *" $libdir "*) ;;
-	  *) finalize_perm_rpath="$finalize_perm_rpath $libdir" ;;
-	  esac
-	fi
-      done
-      # Substitute the hardcoded libdirs into the rpath.
-      if test -n "$hardcode_libdir_separator" &&
-	 test -n "$hardcode_libdirs"; then
-	libdir="$hardcode_libdirs"
-	eval rpath=\" $hardcode_libdir_flag_spec\"
-      fi
-      finalize_rpath="$rpath"
-
-      if test -n "$libobjs" && test "$build_old_libs" = yes; then
-	# Transform all the library objects into standard objects.
-	compile_command=`$echo "X$compile_command" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
-	finalize_command=`$echo "X$finalize_command" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
-      fi
-
-      dlsyms=
-      if test -n "$dlfiles$dlprefiles" || test "$dlself" != no; then
-	if test -n "$NM" && test -n "$global_symbol_pipe"; then
-	  dlsyms="${outputname}S.c"
-	else
-	  $echo "$modename: not configured to extract global symbols from dlpreopened files" 1>&2
-	fi
-      fi
-
-      if test -n "$dlsyms"; then
-	case "$dlsyms" in
-	"") ;;
-	*.c)
-	  # Discover the nlist of each of the dlfiles.
-	  nlist="$output_objdir/${outputname}.nm"
-
-	  $show "$rm $nlist ${nlist}S ${nlist}T"
-	  $run $rm "$nlist" "${nlist}S" "${nlist}T"
-
-	  # Parse the name list into a source file.
-	  $show "creating $output_objdir/$dlsyms"
-
-	  test -z "$run" && $echo > "$output_objdir/$dlsyms" "\
-/* $dlsyms - symbol resolution table for \`$outputname' dlsym emulation. */
-/* Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP */
-
-#ifdef __cplusplus
-extern \"C\" {
-#endif
-
-/* Prevent the only kind of declaration conflicts we can make. */
-#define lt_preloaded_symbols some_other_symbol
-
-/* External symbol declarations for the compiler. */\
-"
-
-	  if test "$dlself" = yes; then
-	    $show "generating symbol list for \`$output'"
-
-	    test -z "$run" && $echo ': @PROGRAM@ ' > "$nlist"
-
-	    # Add our own program objects to the symbol list.
-	    progfiles=`$echo "X$objs$old_deplibs" | $SP2NL | $Xsed -e "$lo2o" | $NL2SP`
-	    for arg in $progfiles; do
-	      $show "extracting global C symbols from \`$arg'"
-	      $run eval "$NM $arg | $global_symbol_pipe >> '$nlist'"
-	    done
-
-	    if test -n "$exclude_expsyms"; then
-	      $run eval 'egrep -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T'
-	      $run eval '$mv "$nlist"T "$nlist"'
-	    fi
-
-	    if test -n "$export_symbols_regex"; then
-	      $run eval 'egrep -e "$export_symbols_regex" "$nlist" > "$nlist"T'
-	      $run eval '$mv "$nlist"T "$nlist"'
-	    fi
-
-	    # Prepare the list of exported symbols
-	    if test -z "$export_symbols"; then
-	      export_symbols="$output_objdir/$output.exp"
-	      $run $rm $export_symbols
-	      $run eval "sed -n -e '/^: @PROGRAM@$/d' -e 's/^.* \(.*\)$/\1/p' "'< "$nlist" > "$export_symbols"'
-	    else
-	      $run eval "sed -e 's/\([][.*^$]\)/\\\1/g' -e 's/^/ /' -e 's/$/$/'"' < "$export_symbols" > "$output_objdir/$output.exp"'
-	      $run eval 'grep -f "$output_objdir/$output.exp" < "$nlist" > "$nlist"T'
-	      $run eval 'mv "$nlist"T "$nlist"'
-	    fi
-	  fi
-
-	  for arg in $dlprefiles; do
-	    $show "extracting global C symbols from \`$arg'"
-	    name=`echo "$arg" | sed -e 's%^.*/%%'`
-	    $run eval 'echo ": $name " >> "$nlist"'
-	    $run eval "$NM $arg | $global_symbol_pipe >> '$nlist'"
-	  done
-
-	  if test -z "$run"; then
-	    # Make sure we have at least an empty file.
-	    test -f "$nlist" || : > "$nlist"
-
-	    if test -n "$exclude_expsyms"; then
-	      egrep -v " ($exclude_expsyms)$" "$nlist" > "$nlist"T
-	      $mv "$nlist"T "$nlist"
-	    fi
-
-	    # Try sorting and uniquifying the output.
-	    if grep -v "^: " < "$nlist" | sort +2 | uniq > "$nlist"S; then
-	      :
-	    else
-	      grep -v "^: " < "$nlist" > "$nlist"S
-	    fi
-
-	    if test -f "$nlist"S; then
-	      eval "$global_symbol_to_cdecl"' < "$nlist"S >> "$output_objdir/$dlsyms"'
-	    else
-	      echo '/* NONE */' >> "$output_objdir/$dlsyms"
-	    fi
-
-	    $echo >> "$output_objdir/$dlsyms" "\
-
-#undef lt_preloaded_symbols
-
-#if defined (__STDC__) && __STDC__
-# define lt_ptr_t void *
-#else
-# define lt_ptr_t char *
-# define const
-#endif
-
-/* The mapping between symbol names and symbols. */
-const struct {
-  const char *name;
-  lt_ptr_t address;
-}
-lt_preloaded_symbols[] =
-{\
-"
-
-	    sed -n -e 's/^: \([^ ]*\) $/  {\"\1\", (lt_ptr_t) 0},/p' \
-		-e 's/^. \([^ ]*\) \([^ ]*\)$/  {"\2", (lt_ptr_t) \&\2},/p' \
-		  < "$nlist" >> "$output_objdir/$dlsyms"
-
-	    $echo >> "$output_objdir/$dlsyms" "\
-  {0, (lt_ptr_t) 0}
-};
-
-/* This works around a problem in FreeBSD linker */
-#ifdef FREEBSD_WORKAROUND
-static const void *lt_preloaded_setup() {
-  return lt_preloaded_symbols;
-}
-#endif
-
-#ifdef __cplusplus
-}
-#endif\
-"
-	  fi
-
-	  pic_flag_for_symtable=
-	  case "$host" in
-	  # compiling the symbol table file with pic_flag works around
-	  # a FreeBSD bug that causes programs to crash when -lm is
-	  # linked before any other PIC object.  But we must not use
-	  # pic_flag when linking with -static.  The problem exists in
-	  # FreeBSD 2.2.6 and is fixed in FreeBSD 3.1.
-	  *-*-freebsd2*|*-*-freebsd3.0*|*-*-freebsdelf3.0*)
-	    case "$compile_command " in
-	    *" -static "*) ;;
-	    *) pic_flag_for_symtable=" $pic_flag -DPIC -DFREEBSD_WORKAROUND";;
-	    esac;;
-	  *-*-hpux*)
-	    case "$compile_command " in
-	    *" -static "*) ;;
-	    *) pic_flag_for_symtable=" $pic_flag -DPIC";;
-	    esac
-	  esac
-
-	  # Now compile the dynamic symbol file.
-	  $show "(cd $output_objdir && $CC -c$no_builtin_flag$pic_flag_for_symtable \"$dlsyms\")"
-	  $run eval '(cd $output_objdir && $CC -c$no_builtin_flag$pic_flag_for_symtable "$dlsyms")' || exit $?
-
-	  # Clean up the generated files.
-	  $show "$rm $output_objdir/$dlsyms $nlist ${nlist}S ${nlist}T"
-	  $run $rm "$output_objdir/$dlsyms" "$nlist" "${nlist}S" "${nlist}T"
-
-	  # Transform the symbol file into the correct name.
-	  compile_command=`$echo "X$compile_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}S.${objext}%"`
-	  finalize_command=`$echo "X$finalize_command" | $Xsed -e "s%@SYMFILE@%$output_objdir/${outputname}S.${objext}%"`
-	  ;;
-	*)
-	  $echo "$modename: unknown suffix for \`$dlsyms'" 1>&2
-	  exit 1
-	  ;;
-	esac
-      else
-	# We keep going just in case the user didn't refer to
-	# lt_preloaded_symbols.  The linker will fail if global_symbol_pipe
-	# really was required.
-
-	# Nullify the symbol file.
-	compile_command=`$echo "X$compile_command" | $Xsed -e "s% @SYMFILE@%%"`
-	finalize_command=`$echo "X$finalize_command" | $Xsed -e "s% @SYMFILE@%%"`
-      fi
-
-      if test -z "$link_against_libtool_libs" || test "$build_libtool_libs" != yes; then
-	# Replace the output file specification.
-	compile_command=`$echo "X$compile_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'`
-	link_command="$compile_command$compile_rpath"
-
-	# We have no uninstalled library dependencies, so finalize right now.
-	$show "$link_command"
-	$run eval "$link_command"
-	status=$?
-
-	# Delete the generated files.
-	if test -n "$dlsyms"; then
-	  $show "$rm $output_objdir/${outputname}S.${objext}"
-	  $run $rm "$output_objdir/${outputname}S.${objext}"
-	fi
-
-	exit $status
-      fi
-
-      if test -n "$shlibpath_var"; then
-	# We should set the shlibpath_var
-	rpath=
-	for dir in $temp_rpath; do
-	  case "$dir" in
-	  [\\/]* | [A-Za-z]:[\\/]*)
-	    # Absolute path.
-	    rpath="$rpath$dir:"
-	    ;;
-	  *)
-	    # Relative path: add a thisdir entry.
-	    rpath="$rpath\$thisdir/$dir:"
-	    ;;
-	  esac
-	done
-	temp_rpath="$rpath"
-      fi
-
-      if test -n "$compile_shlibpath$finalize_shlibpath"; then
-	compile_command="$shlibpath_var=\"$compile_shlibpath$finalize_shlibpath\$$shlibpath_var\" $compile_command"
-      fi
-      if test -n "$finalize_shlibpath"; then
-	finalize_command="$shlibpath_var=\"$finalize_shlibpath\$$shlibpath_var\" $finalize_command"
-      fi
-
-      compile_var=
-      finalize_var=
-      if test -n "$runpath_var"; then
-	if test -n "$perm_rpath"; then
-	  # We should set the runpath_var.
-	  rpath=
-	  for dir in $perm_rpath; do
-	    rpath="$rpath$dir:"
-	  done
-	  compile_var="$runpath_var=\"$rpath\$$runpath_var\" "
-	fi
-	if test -n "$finalize_perm_rpath"; then
-	  # We should set the runpath_var.
-	  rpath=
-	  for dir in $finalize_perm_rpath; do
-	    rpath="$rpath$dir:"
-	  done
-	  finalize_var="$runpath_var=\"$rpath\$$runpath_var\" "
-	fi
-      fi
-
-      if test "$no_install" = yes; then
-	# We don't need to create a wrapper script.
-	link_command="$compile_var$compile_command$compile_rpath"
-	# Replace the output file specification.
-	link_command=`$echo "X$link_command" | $Xsed -e 's%@OUTPUT@%'"$output"'%g'`
-	# Delete the old output file.
-	$run $rm $output
-	# Link the executable and exit
-	$show "$link_command"
-	$run eval "$link_command" || exit $?
-	exit 0
-      fi
-
-      if test "$hardcode_action" = relink || test "$hardcode_into_libs" = all; then
-	# Fast installation is not supported
-	link_command="$compile_var$compile_command$compile_rpath"
-	relink_command="$finalize_var$finalize_command$finalize_rpath"
-
-	$echo "$modename: warning: this platform does not like uninstalled shared libraries" 1>&2
-	$echo "$modename: \`$output' will be relinked during installation" 1>&2
-      else
-	if test "$fast_install" != no; then
-	  link_command="$finalize_var$compile_command$finalize_rpath"
-	  if test "$fast_install" = yes; then
-	    relink_command=`$echo "X$compile_var$compile_command$compile_rpath" | $Xsed -e 's%@OUTPUT@%\$progdir/\$file%g'`
-	  else
-	    # fast_install is set to needless
-	    relink_command=
-	  fi
-	else
-	  link_command="$compile_var$compile_command$compile_rpath"
-	  relink_command="$finalize_var$finalize_command$finalize_rpath"
-	fi
-      fi
-
-      # Replace the output file specification.
-      link_command=`$echo "X$link_command" | $Xsed -e 's%@OUTPUT@%'"$output_objdir/$outputname"'%g'`
-
-      # Delete the old output files.
-      $run $rm $output $output_objdir/$outputname $output_objdir/lt-$outputname
-
-      $show "$link_command"
-      $run eval "$link_command" || exit $?
-
-      # Now create the wrapper script.
-      $show "creating $output"
-
-      # Quote the relink command for shipping.
-      if test -n "$relink_command"; then
-	relink_command="cd `pwd`; $relink_command"
-	relink_command=`$echo "X$relink_command" | $Xsed -e "$sed_quote_subst"`
-      fi
-
-      # Quote $echo for shipping.
-      if test "X$echo" = "X$SHELL $0 --fallback-echo"; then
-	case "$0" in
-	[\\/]* | [A-Za-z]:[\\/]*) qecho="$SHELL $0 --fallback-echo";;
-	*) qecho="$SHELL `pwd`/$0 --fallback-echo";;
-	esac
-	qecho=`$echo "X$qecho" | $Xsed -e "$sed_quote_subst"`
-      else
-	qecho=`$echo "X$echo" | $Xsed -e "$sed_quote_subst"`
-      fi
-
-      # Only actually do things if our run command is non-null.
-      if test -z "$run"; then
-	# win32 will think the script is a binary if it has
-	# a .exe suffix, so we strip it off here.
-	case $output in
-	  *.exe) output=`echo $output|sed 's,.exe$,,'` ;;
-	esac
-	$rm $output
-	trap "$rm $output; exit 1" 1 2 15
-
-	$echo > $output "\
-#! $SHELL
-
-# $output - temporary wrapper script for $objdir/$outputname
-# Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP
-#
-# The $output program cannot be directly executed until all the libtool
-# libraries that it depends on are installed.
-#
-# This wrapper script should never be moved out of the build directory.
-# If it is, it will not operate correctly.
-
-# Sed substitution that helps us do robust quoting.  It backslashifies
-# metacharacters that are still active within double-quoted strings.
-Xsed='sed -e 1s/^X//'
-sed_quote_subst='$sed_quote_subst'
-
-# The HP-UX ksh and POSIX shell print the target directory to stdout
-# if CDPATH is set.
-if test \"\${CDPATH+set}\" = set; then CDPATH=:; export CDPATH; fi
-
-relink_command=\"$relink_command\"
-
-# This environment variable determines our operation mode.
-if test \"\$libtool_install_magic\" = \"$magic\"; then
-  # install mode needs the following variable:
-  link_against_libtool_libs='$link_against_libtool_libs'
-else
-  # When we are sourced in execute mode, \$file and \$echo are already set.
-  if test \"\$libtool_execute_magic\" != \"$magic\"; then
-    echo=\"$qecho\"
-    file=\"\$0\"
-    # Make sure echo works.
-    if test \"X\$1\" = X--no-reexec; then
-      # Discard the --no-reexec flag, and continue.
-      shift
-    elif test \"X\`(\$echo '\t') 2>/dev/null\`\" = 'X\t'; then
-      # Yippee, \$echo works!
-      :
-    else
-      # Restart under the correct shell, and then maybe \$echo will work.
-      exec $SHELL \"\$0\" --no-reexec \${1+\"\$@\"}
-    fi
-  fi\
-"
-	$echo >> $output "\
-
-  # Find the directory that this script lives in.
-  thisdir=\`\$echo \"X\$file\" | \$Xsed -e 's%/[^/]*$%%'\`
-  test \"x\$thisdir\" = \"x\$file\" && thisdir=.
-
-  # Follow symbolic links until we get to the real thisdir.
-  file=\`ls -ld \"\$file\" | sed -n 's/.*-> //p'\`
-  while test -n \"\$file\"; do
-    destdir=\`\$echo \"X\$file\" | \$Xsed -e 's%/[^/]*\$%%'\`
-
-    # If there was a directory component, then change thisdir.
-    if test \"x\$destdir\" != \"x\$file\"; then
-      case \"\$destdir\" in
-      [\\/]* | [A-Za-z]:[\\/]*) thisdir=\"\$destdir\" ;;
-      *) thisdir=\"\$thisdir/\$destdir\" ;;
-      esac
-    fi
-
-    file=\`\$echo \"X\$file\" | \$Xsed -e 's%^.*/%%'\`
-    file=\`ls -ld \"\$thisdir/\$file\" | sed -n 's/.*-> //p'\`
-  done
-
-  # Try to get the absolute directory name.
-  absdir=\`cd \"\$thisdir\" && pwd\`
-  test -n \"\$absdir\" && thisdir=\"\$absdir\"
-"
-
-	if test "$fast_install" = yes; then
-	  echo >> $output "\
-  program=lt-'$outputname'
-  progdir=\"\$thisdir/$objdir\"
-
-  if test ! -f \"\$progdir/\$program\" || \\
-     { file=\`ls -1dt \"\$progdir/\$program\" \"\$progdir/../\$program\" 2>/dev/null | sed 1q\`; \\
-       test \"X\$file\" != \"X\$progdir/\$program\"; }; then
-
-    file=\"\$\$-\$program\"
-
-    if test ! -d \"\$progdir\"; then
-      $mkdir \"\$progdir\"
-    else
-      $rm \"\$progdir/\$file\"
-    fi"
-
-	  echo >> $output "\
-
-    # relink executable if necessary
-    if test -n \"\$relink_command\"; then
-      if (eval \$relink_command); then :
-      else
-	$rm \"\$progdir/\$file\"
-	exit 1
-      fi
-    fi
-
-    $mv \"\$progdir/\$file\" \"\$progdir/\$program\" 2>/dev/null ||
-    { $rm \"\$progdir/\$program\";
-      $mv \"\$progdir/\$file\" \"\$progdir/\$program\"; }
-    $rm \"\$progdir/\$file\"
-  fi"
-	else
-	  echo >> $output "\
-  program='$outputname'
-  progdir=\"\$thisdir/$objdir\"
-"
-	fi
-
-	echo >> $output "\
-
-  if test -f \"\$progdir/\$program\"; then"
-
-	# Export our shlibpath_var if we have one.
-	if test "$shlibpath_overrides_runpath" = yes && test -n "$shlibpath_var" && test -n "$temp_rpath"; then
-	  $echo >> $output "\
-    # Add our own library path to $shlibpath_var
-    $shlibpath_var=\"$temp_rpath\$$shlibpath_var\"
-
-    # Some systems cannot cope with colon-terminated $shlibpath_var
-    # The second colon is a workaround for a bug in BeOS R4 sed
-    $shlibpath_var=\`\$echo \"X\$$shlibpath_var\" | \$Xsed -e 's/::*\$//'\`
-
-    export $shlibpath_var
-"
-	fi
-
-	# fixup the dll searchpath if we need to.
-	if test -n "$dllsearchpath"; then
-	  $echo >> $output "\
-    # Add the dll search path components to the executable PATH
-    PATH=$dllsearchpath:\$PATH
-"
-	fi
-
-	$echo >> $output "\
-    if test \"\$libtool_execute_magic\" != \"$magic\"; then
-      # Run the actual program with our arguments.
-"
-	case $host in
-	*-*-cygwin* | *-*-mingw | *-*-os2*)
-	  # win32 systems need to use the prog path for dll
-	  # lookup to work
-	  $echo >> $output "\
-      exec \$progdir\\\\\$program \${1+\"\$@\"}
-"
-	  ;;
-	*)
-	  $echo >> $output "\
-      # Export the path to the program.
-      PATH=\"\$progdir:\$PATH\"
-      export PATH
-
-      exec \$program \${1+\"\$@\"}
-"
-	  ;;
-	esac
-	$echo >> $output "\
-      \$echo \"\$0: cannot exec \$program \${1+\"\$@\"}\"
-      exit 1
-    fi
-  else
-    # The program doesn't exist.
-    \$echo \"\$0: error: \$progdir/\$program does not exist\" 1>&2
-    \$echo \"This script is just a wrapper for \$program.\" 1>&2
-    echo \"See the $PACKAGE documentation for more information.\" 1>&2
-    exit 1
-  fi
-fi\
-"
-	chmod +x $output
-      fi
-      exit 0
-      ;;
-    esac
-
-    # See if we need to build an old-fashioned archive.
-    for oldlib in $oldlibs; do
-
-      if test "$build_libtool_libs" = convenience; then
-	oldobjs="$libobjs_save"
-	addlibs="$convenience"
-	build_libtool_libs=no
-      else
-	if test "$build_libtool_libs" = module; then
-	  oldobjs="$libobjs_save"
-	  build_libtool_libs=no
-	else
-	  oldobjs="$objs$old_deplibs "`$echo "X$libobjs_save" | $SP2NL | $Xsed -e '/\.'${libext}'$/d' -e '/\.lib$/d' -e "$lo2o" | $NL2SP`
-	fi
-	addlibs="$old_convenience"
-      fi
-
-      if test -n "$addlibs"; then
-	gentop="$output_objdir/${outputname}x"
-	$show "${rm}r $gentop"
-	$run ${rm}r "$gentop"
-	$show "mkdir $gentop"
-	$run mkdir "$gentop"
-	status=$?
-	if test $status -ne 0 && test ! -d "$gentop"; then
-	  exit $status
-	fi
-	generated="$generated $gentop"
-
-	# Add in members from convenience archives.
-	for xlib in $addlibs; do
-	  # Extract the objects.
-	  case "$xlib" in
-	  [\\/]* | [A-Za-z]:[\\/]*) xabs="$xlib" ;;
-	  *) xabs=`pwd`"/$xlib" ;;
-	  esac
-	  xlib=`$echo "X$xlib" | $Xsed -e 's%^.*/%%'`
-	  xdir="$gentop/$xlib"
-
-	  $show "${rm}r $xdir"
-	  $run ${rm}r "$xdir"
-	  $show "mkdir $xdir"
-	  $run mkdir "$xdir"
-	  status=$?
-	  if test $status -ne 0 && test ! -d "$xdir"; then
-	    exit $status
-	  fi
-	  $show "(cd $xdir && $AR x $xabs)"
-	  $run eval "(cd \$xdir && $AR x \$xabs)" || exit $?
-
-	  oldobjs="$oldobjs "`find $xdir -name \*.${objext} -print -o -name \*.lo -print | $NL2SP`
-	done
-      fi
-
-      # Do each command in the archive commands.
-      if test -n "$old_archive_from_new_cmds" && test "$build_libtool_libs" = yes; then
-	eval cmds=\"$old_archive_from_new_cmds\"
-      else
-	# Ensure that we have .o objects in place in case we decided
-	# not to build a shared library, and have fallen back to building
-	# static libs even though --disable-static was passed!
-	for oldobj in $oldobjs; do
-	  if test ! -f $oldobj; then
-	    xdir=`$echo "X$oldobj" | $Xsed -e 's%/[^/]*$%%'`
-	    if test "X$xdir" = "X$oldobj"; then
-	      xdir="."
-	    else
-	      xdir="$xdir"
-	    fi
-	    baseobj=`$echo "X$oldobj" | $Xsed -e 's%^.*/%%'`
-	    obj=`$echo "X$baseobj" | $Xsed -e "$o2lo"`
-	    $show "(cd $xdir && ${LN_S} $obj $baseobj)"
-	    $run eval '(cd $xdir && ${LN_S} $obj $baseobj)' || exit $?
-	  fi
-	done
-
-	eval cmds=\"$old_archive_cmds\"
-      fi
-      IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
-      for cmd in $cmds; do
-	IFS="$save_ifs"
-	$show "$cmd"
-	$run eval "$cmd" || exit $?
-      done
-      IFS="$save_ifs"
-    done
-
-    if test -n "$generated"; then
-      $show "${rm}r$generated"
-      $run ${rm}r$generated
-    fi
-
-    # Now create the libtool archive.
-    case "$output" in
-    *.la)
-      old_library=
-      test "$build_old_libs" = yes && old_library="$libname.$libext"
-      $show "creating $output"
-
-      # Quote the link command for shipping.
-      relink_command="cd `pwd`; $SHELL $0 --mode=relink $libtool_args"
-      relink_command=`$echo "X$relink_command" | $Xsed -e "$sed_quote_subst"`
-
-      # Only create the output if not a dry run.
-      if test -z "$run"; then
-	for installed in no yes; do
-	  if test "$installed" = yes; then
-	    if test -z "$install_libdir"; then
-	      break
-	    fi
-	    output="$output_objdir/$outputname"i
-	    # Replace all uninstalled libtool libraries with the installed ones
-	    newdependency_libs=
-	    for deplib in $dependency_libs; do
-	      case "$deplib" in
-	      *.la)
-		name=`$echo "X$deplib" | $Xsed -e 's%^.*/%%'`
-		eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $deplib`
-		if test -z "$libdir"; then
-		  $echo "$modename: \`$deplib' is not a valid libtool archive" 1>&2
-		  exit 1
-		fi
-		newdependency_libs="$newdependency_libs $libdir/$name"
-		;;
-	      *) newdependency_libs="$newdependency_libs $deplib" ;;
-	      esac
-	    done
-	    dependency_libs="$newdependency_libs"
-	    newdlfiles=
-	    for lib in $dlfiles; do
-	      name=`$echo "X$lib" | $Xsed -e 's%^.*/%%'`
-	      eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
-	      if test -z "$libdir"; then
-		$echo "$modename: \`$lib' is not a valid libtool archive" 1>&2
-		exit 1
-	      fi
-	      newdlfiles="$newdlfiles $libdir/$name"
-	    done
-	    dlfiles="$newdlfiles"
-	    newdlprefiles=
-	    for lib in $dlprefiles; do
-	      name=`$echo "X$lib" | $Xsed -e 's%^.*/%%'`
-	      eval libdir=`sed -n -e 's/^libdir=\(.*\)$/\1/p' $lib`
-	      if test -z "$libdir"; then
-		$echo "$modename: \`$lib' is not a valid libtool archive" 1>&2
-		exit 1
-	      fi
-	      newdlprefiles="$newdlprefiles $libdir/$name"
-	    done
-	    dlprefiles="$newdlprefiles"
-	  fi
-	  $rm $output
-	  $echo > $output "\
-# $outputname - a libtool library file
-# Generated by $PROGRAM - GNU $PACKAGE $VERSION$TIMESTAMP
-#
-# Please DO NOT delete this file!
-# It is necessary for linking the library.
-
-# The name that we can dlopen(3).
-dlname='$dlname'
-
-# Names of this library.
-library_names='$library_names'
-
-# The name of the static archive.
-old_library='$old_library'
-
-# Libraries that this one depends upon.
-dependency_libs='$dependency_libs'
-
-# Version information for $libname.
-current=$current
-age=$age
-revision=$revision
-
-# Is this an already installed library?
-installed=$installed
-
-# Files to dlopen/dlpreopen
-dlopen='$dlfiles'
-dlpreopen='$dlprefiles'
-
-# Directory that this library needs to be installed in:
-libdir='$install_libdir'"
-	  if test "$installed" = no; then
-	    $echo >> $output "\
-relink_command=\"$relink_command\""
-	  fi
-	done
-      fi
-
-      # Do a symbolic link so that the libtool archive can be found in
-      # LD_LIBRARY_PATH before the program is installed.
-      $show "(cd $output_objdir && $rm $outputname && $LN_S ../$outputname $outputname)"
-      $run eval '(cd $output_objdir && $rm $outputname && $LN_S ../$outputname $outputname)' || exit $?
-      ;;
-    esac
-    exit 0
-    ;;
-
-  # libtool install mode
-  install)
-    modename="$modename: install"
-
-    # There may be an optional sh(1) argument at the beginning of
-    # install_prog (especially on Windows NT).
-    if test "$nonopt" = "$SHELL" || test "$nonopt" = /bin/sh; then
-      # Aesthetically quote it.
-      arg=`$echo "X$nonopt" | $Xsed -e "$sed_quote_subst"`
-      case "$arg" in
-      *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*)
-	arg="\"$arg\""
-	;;
-      esac
-      install_prog="$arg "
-      arg="$1"
-      shift
-    else
-      install_prog=
-      arg="$nonopt"
-    fi
-
-    # The real first argument should be the name of the installation program.
-    # Aesthetically quote it.
-    arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`
-    case "$arg" in
-    *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*)
-      arg="\"$arg\""
-      ;;
-    esac
-    install_prog="$install_prog$arg"
-
-    # We need to accept at least all the BSD install flags.
-    dest=
-    files=
-    opts=
-    prev=
-    install_type=
-    isdir=no
-    stripme=
-    for arg
-    do
-      if test -n "$dest"; then
-	files="$files $dest"
-	dest="$arg"
-	continue
-      fi
-
-      case "$arg" in
-      -d) isdir=yes ;;
-      -f) prev="-f" ;;
-      -g) prev="-g" ;;
-      -m) prev="-m" ;;
-      -o) prev="-o" ;;
-      -s)
-	stripme=" -s"
-	continue
-	;;
-      -*) ;;
-
-      *)
-	# If the previous option needed an argument, then skip it.
-	if test -n "$prev"; then
-	  prev=
-	else
-	  dest="$arg"
-	  continue
-	fi
-	;;
-      esac
-
-      # Aesthetically quote the argument.
-      arg=`$echo "X$arg" | $Xsed -e "$sed_quote_subst"`
-      case "$arg" in
-      *[\[\~\#\^\&\*\(\)\{\}\|\;\<\>\?\'\ \	]*|*]*)
-	arg="\"$arg\""
-	;;
-      esac
-      install_prog="$install_prog $arg"
-    done
-
-    if test -z "$install_prog"; then
-      $echo "$modename: you must specify an install program" 1>&2
-      $echo "$help" 1>&2
-      exit 1
-    fi
-
-    if test -n "$prev"; then
-      $echo "$modename: the \`$prev' option requires an argument" 1>&2
-      $echo "$help" 1>&2
-      exit 1
-    fi
-
-    if test -z "$files"; then
-      if test -z "$dest"; then
-	$echo "$modename: no file or destination specified" 1>&2
-      else
-	$echo "$modename: you must specify a destination" 1>&2
-      fi
-      $echo "$help" 1>&2
-      exit 1
-    fi
-
-    # Strip any trailing slash from the destination.
-    dest=`$echo "X$dest" | $Xsed -e 's%/$%%'`
-
-    # Check to see that the destination is a directory.
-    test -d "$dest" && isdir=yes
-    if test "$isdir" = yes; then
-      destdir="$dest"
-      destname=
-    else
-      destdir=`$echo "X$dest" | $Xsed -e 's%/[^/]*$%%'`
-      test "X$destdir" = "X$dest" && destdir=.
-      destname=`$echo "X$dest" | $Xsed -e 's%^.*/%%'`
-
-      # Not a directory, so check to see that there is only one file specified.
-      set dummy $files
-      if test $# -gt 2; then
-	$echo "$modename: \`$dest' is not a directory" 1>&2
-	$echo "$help" 1>&2
-	exit 1
-      fi
-    fi
-    case "$destdir" in
-    [\\/]* | [A-Za-z]:[\\/]*) ;;
-    *)
-      for file in $files; do
-	case "$file" in
-	*.lo) ;;
-	*)
-	  $echo "$modename: \`$destdir' must be an absolute directory name" 1>&2
-	  $echo "$help" 1>&2
-	  exit 1
-	  ;;
-	esac
-      done
-      ;;
-    esac
-
-    # This variable tells wrapper scripts just to set variables rather
-    # than running their programs.
-    libtool_install_magic="$magic"
-
-    staticlibs=
-    future_libdirs=
-    current_libdirs=
-    for file in $files; do
-
-      # Do each installation.
-      case "$file" in
-      *.$libext)
-	# Do the static libraries later.
-	staticlibs="$staticlibs $file"
-	;;
-
-      *.la)
-	# Check to see that this really is a libtool archive.
-	if (sed -e '2q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then :
-	else
-	  $echo "$modename: \`$file' is not a valid libtool archive" 1>&2
-	  $echo "$help" 1>&2
-	  exit 1
-	fi
-
-	library_names=
-	old_library=
-	relink_command=
-	# If there is no directory component, then add one.
-	case "$file" in
-	*/* | *\\*) . $file ;;
-	*) . ./$file ;;
-	esac
-
-	# Add the libdir to current_libdirs if it is the destination.
-	if test "X$destdir" = "X$libdir"; then
-	  case "$current_libdirs " in
-	  *" $libdir "*) ;;
-	  *) current_libdirs="$current_libdirs $libdir" ;;
-	  esac
-	else
-	  # Note the libdir as a future libdir.
-	  case "$future_libdirs " in
-	  *" $libdir "*) ;;
-	  *) future_libdirs="$future_libdirs $libdir" ;;
-	  esac
-	fi
-
-	dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'`/
-	test "X$dir" = "X$file/" && dir=
-	dir="$dir$objdir"
-
-	if test "$hardcode_into_libs" = all; then
-	  if test -z "$relink_command"; then
-	    $echo "$modename: invalid libtool pseudo library \`$file'" 1>&2
-	    exit 1
-	  fi
-	  $echo "$modename: warning: relinking \`$file'" 1>&2
-	  $show "$relink_command"
-	  if $run eval "$relink_command"; then :
-	  else
-	    $echo "$modename: error: relink \`$file' with the above command before installing it" 1>&2
-	    continue
-	  fi
-	fi
-
-	# See the names of the shared library.
-	set dummy $library_names
-	if test -n "$2"; then
-	  realname="$2"
-	  shift
-	  shift
-
-	  srcname="$realname"
-	  test "$hardcode_into_libs" = all && srcname="$realname"T
-
-	  # Install the shared library and build the symlinks.
-	  $show "$install_prog $dir/$srcname $destdir/$realname"
-	  $run eval "$install_prog $dir/$srcname $destdir/$realname" || exit $?
-	  if test -n "$stripme" && test -n "$striplib"; then
-	    $show "$striplib $destdir/$realname"
-	    $run eval "$striplib $destdir/$realname" || exit $?
-	  fi
-
-	  if test $# -gt 0; then
-	    # Delete the old symlinks, and create new ones.
-	    for linkname
-	    do
-	      if test "$linkname" != "$realname"; then
-		$show "(cd $destdir && $rm $linkname && $LN_S $realname $linkname)"
-		$run eval "(cd $destdir && $rm $linkname && $LN_S $realname $linkname)"
-	      fi
-	    done
-	  fi
-
-	  # Do each command in the postinstall commands.
-	  lib="$destdir/$realname"
-	  eval cmds=\"$postinstall_cmds\"
-	  IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
-	  for cmd in $cmds; do
-	    IFS="$save_ifs"
-	    $show "$cmd"
-	    $run eval "$cmd" || exit $?
-	  done
-	  IFS="$save_ifs"
-	fi
-
-	# Install the pseudo-library for information purposes.
-	name=`$echo "X$file" | $Xsed -e 's%^.*/%%'`
-	instname="$dir/$name"i
-	$show "$install_prog $instname $destdir/$name"
-	$run eval "$install_prog $instname $destdir/$name" || exit $?
-
-	# Maybe install the static library, too.
-	test -n "$old_library" && staticlibs="$staticlibs $dir/$old_library"
-	;;
-
-      *.lo)
-	# Install (i.e. copy) a libtool object.
-
-	# Figure out destination file name, if it wasn't already specified.
-	if test -n "$destname"; then
-	  destfile="$destdir/$destname"
-	else
-	  destfile=`$echo "X$file" | $Xsed -e 's%^.*/%%'`
-	  destfile="$destdir/$destfile"
-	fi
-
-	# Deduce the name of the destination old-style object file.
-	case "$destfile" in
-	*.lo)
-	  staticdest=`$echo "X$destfile" | $Xsed -e "$lo2o"`
-	  ;;
-	*.$objext)
-	  staticdest="$destfile"
-	  destfile=
-	  ;;
-	*)
-	  $echo "$modename: cannot copy a libtool object to \`$destfile'" 1>&2
-	  $echo "$help" 1>&2
-	  exit 1
-	  ;;
-	esac
-
-	# Install the libtool object if requested.
-	if test -n "$destfile"; then
-	  $show "$install_prog $file $destfile"
-	  $run eval "$install_prog $file $destfile" || exit $?
-	fi
-
-	# Install the old object if enabled.
-	if test "$build_old_libs" = yes; then
-	  # Deduce the name of the old-style object file.
-	  staticobj=`$echo "X$file" | $Xsed -e "$lo2o"`
-
-	  $show "$install_prog $staticobj $staticdest"
-	  $run eval "$install_prog \$staticobj \$staticdest" || exit $?
-	fi
-	exit 0
-	;;
-
-      *)
-	# Figure out destination file name, if it wasn't already specified.
-	if test -n "$destname"; then
-	  destfile="$destdir/$destname"
-	else
-	  destfile=`$echo "X$file" | $Xsed -e 's%^.*/%%'`
-	  destfile="$destdir/$destfile"
-	fi
-
-	# Do a test to see if this is really a libtool program.
-	if (sed -e '4q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then
-	  link_against_libtool_libs=
-	  relink_command=
-
-	  # If there is no directory component, then add one.
-	  case "$file" in
-	  */* | *\\*) . $file ;;
-	  *) . ./$file ;;
-	  esac
-
-	  # Check the variables that should have been set.
-	  if test -z "$link_against_libtool_libs"; then
-	    $echo "$modename: invalid libtool wrapper script \`$file'" 1>&2
-	    exit 1
-	  fi
-
-	  finalize=yes
-	  for lib in $link_against_libtool_libs; do
-	    # Check to see that each library is installed.
-	    libdir=
-	    if test -f "$lib"; then
-	      # If there is no directory component, then add one.
-	      case "$lib" in
-	      */* | *\\*) . $lib ;;
-	      *) . ./$lib ;;
-	      esac
-	    fi
-	    libfile="$libdir/"`$echo "X$lib" | $Xsed -e 's%^.*/%%g'` ### testsuite: skip nested quoting test
-	    if test -n "$libdir" && test ! -f "$libfile"; then
-	      $echo "$modename: warning: \`$lib' has not been installed in \`$libdir'" 1>&2
-	      finalize=no
-	    fi
-	  done
-
-	  relink_command=
-	  # If there is no directory component, then add one.
-	  case "$file" in
-	  */* | *\\*) . $file ;;
-	  *) . ./$file ;;
-	  esac
-
-	  outputname=
-	  if test "$fast_install" = no && test -n "$relink_command"; then
-	    if test "$finalize" = yes && test -z "$run"; then
-	      tmpdir="/tmp"
-	      test -n "$TMPDIR" && tmpdir="$TMPDIR"
-	      tmpdir="$tmpdir/libtool-$$"
-	      if $mkdir -p "$tmpdir" && chmod 700 "$tmpdir"; then :
-	      else
-		$echo "$modename: error: cannot create temporary directory \`$tmpdir'" 1>&2
-		continue
-	      fi
-	      outputname="$tmpdir/$file"
-	      # Replace the output file specification.
-	      relink_command=`$echo "X$relink_command" | $Xsed -e 's%@OUTPUT@%'"$outputname"'%g'`
-
-	      $show "$relink_command"
-	      if $run eval "$relink_command"; then :
-	      else
-		$echo "$modename: error: relink \`$file' with the above command before installing it" 1>&2
-		${rm}r "$tmpdir"
-		continue
-	      fi
-	      file="$outputname"
-	    else
-	      $echo "$modename: warning: cannot relink \`$file'" 1>&2
-	    fi
-	  else
-	    # Install the binary that we compiled earlier.
-	    file=`$echo "X$file" | $Xsed -e "s%\([^/]*\)$%$objdir/\1%"`
-	  fi
-	fi
-
-	$show "$install_prog$stripme $file $destfile"
-	$run eval "$install_prog\$stripme \$file \$destfile" || exit $?
-	test -n "$outputname" && ${rm}r "$tmpdir"
-	;;
-      esac
-    done
-
-    for file in $staticlibs; do
-      name=`$echo "X$file" | $Xsed -e 's%^.*/%%'`
-
-      # Set up the ranlib parameters.
-      oldlib="$destdir/$name"
-
-      $show "$install_prog $file $oldlib"
-      $run eval "$install_prog \$file \$oldlib" || exit $?
-
-      if test -n "$stripme" && test -n "$striplib"; then
-	$show "$old_striplib $oldlib"
-	$run eval "$old_striplib $oldlib" || exit $?
-      fi
-
-      # Do each command in the postinstall commands.
-      eval cmds=\"$old_postinstall_cmds\"
-      IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
-      for cmd in $cmds; do
-	IFS="$save_ifs"
-	$show "$cmd"
-	$run eval "$cmd" || exit $?
-      done
-      IFS="$save_ifs"
-    done
-
-    if test -n "$future_libdirs"; then
-      $echo "$modename: warning: remember to run \`$progname --finish$future_libdirs'" 1>&2
-    fi
-
-    if test -n "$current_libdirs"; then
-      # Maybe just do a dry run.
-      test -n "$run" && current_libdirs=" -n$current_libdirs"
-      exec $SHELL $0 --finish$current_libdirs
-      exit 1
-    fi
-
-    exit 0
-    ;;
-
-  # libtool finish mode
-  finish)
-    modename="$modename: finish"
-    libdirs="$nonopt"
-    admincmds=
-
-    if test -n "$finish_cmds$finish_eval" && test -n "$libdirs"; then
-      for dir
-      do
-	libdirs="$libdirs $dir"
-      done
-
-      for libdir in $libdirs; do
-	if test -n "$finish_cmds"; then
-	  # Do each command in the finish commands.
-	  eval cmds=\"$finish_cmds\"
-	  IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
-	  for cmd in $cmds; do
-	    IFS="$save_ifs"
-	    $show "$cmd"
-	    $run eval "$cmd" || admincmds="$admincmds
-       $cmd"
-	  done
-	  IFS="$save_ifs"
-	fi
-	if test -n "$finish_eval"; then
-	  # Do the single finish_eval.
-	  eval cmds=\"$finish_eval\"
-	  $run eval "$cmds" || admincmds="$admincmds
-       $cmds"
-	fi
-      done
-    fi
-
-    # Exit here if they wanted silent mode.
-    test "$show" = : && exit 0
-
-    echo "----------------------------------------------------------------------"
-    echo "Libraries have been installed in:"
-    for libdir in $libdirs; do
-      echo "   $libdir"
-    done
-    echo
-    echo "If you ever happen to want to link against installed libraries"
-    echo "in a given directory, LIBDIR, you must either use libtool, and"
-    echo "specify the full pathname of the library, or use \`-LLIBDIR'"
-    echo "flag during linking and do at least one of the following:"
-    if test -n "$shlibpath_var"; then
-      echo "   - add LIBDIR to the \`$shlibpath_var' environment variable"
-      echo "     during execution"
-    fi
-    if test -n "$runpath_var"; then
-      echo "   - add LIBDIR to the \`$runpath_var' environment variable"
-      echo "     during linking"
-    fi
-    if test -n "$hardcode_libdir_flag_spec"; then
-      libdir=LIBDIR
-      eval flag=\"$hardcode_libdir_flag_spec\"
-
-      echo "   - use the \`$flag' linker flag"
-    fi
-    if test -n "$admincmds"; then
-      echo "   - have your system administrator run these commands:$admincmds"
-    fi
-    if test -f /etc/ld.so.conf; then
-      echo "   - have your system administrator add LIBDIR to \`/etc/ld.so.conf'"
-    fi
-    echo
-    echo "See any operating system documentation about shared libraries for"
-    echo "more information, such as the ld(1) and ld.so(8) manual pages."
-    echo "----------------------------------------------------------------------"
-    exit 0
-    ;;
-
-  # libtool execute mode
-  execute)
-    modename="$modename: execute"
-
-    # The first argument is the command name.
-    cmd="$nonopt"
-    if test -z "$cmd"; then
-      $echo "$modename: you must specify a COMMAND" 1>&2
-      $echo "$help"
-      exit 1
-    fi
-
-    # Handle -dlopen flags immediately.
-    for file in $execute_dlfiles; do
-      if test ! -f "$file"; then
-	$echo "$modename: \`$file' is not a file" 1>&2
-	$echo "$help" 1>&2
-	exit 1
-      fi
-
-      dir=
-      case "$file" in
-      *.la)
-	# Check to see that this really is a libtool archive.
-	if (sed -e '2q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then :
-	else
-	  $echo "$modename: \`$lib' is not a valid libtool archive" 1>&2
-	  $echo "$help" 1>&2
-	  exit 1
-	fi
-
-	# Read the libtool library.
-	dlname=
-	library_names=
-
-	# If there is no directory component, then add one.
-	case "$file" in
-	*/* | *\\*) . $file ;;
-	*) . ./$file ;;
-	esac
-
-	# Skip this library if it cannot be dlopened.
-	if test -z "$dlname"; then
-	  # Warn if it was a shared library.
-	  test -n "$library_names" && $echo "$modename: warning: \`$file' was not linked with \`-export-dynamic'"
-	  continue
-	fi
-
-	dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'`
-	test "X$dir" = "X$file" && dir=.
-
-	if test -f "$dir/$objdir/$dlname"; then
-	  dir="$dir/$objdir"
-	else
-	  $echo "$modename: cannot find \`$dlname' in \`$dir' or \`$dir/$objdir'" 1>&2
-	  exit 1
-	fi
-	;;
-
-      *.lo)
-	# Just add the directory containing the .lo file.
-	dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'`
-	test "X$dir" = "X$file" && dir=.
-	;;
-
-      *)
-	$echo "$modename: warning \`-dlopen' is ignored for non-libtool libraries and objects" 1>&2
-	continue
-	;;
-      esac
-
-      # Get the absolute pathname.
-      absdir=`cd "$dir" && pwd`
-      test -n "$absdir" && dir="$absdir"
-
-      # Now add the directory to shlibpath_var.
-      if eval "test -z \"\$$shlibpath_var\""; then
-	eval "$shlibpath_var=\"\$dir\""
-      else
-	eval "$shlibpath_var=\"\$dir:\$$shlibpath_var\""
-      fi
-    done
-
-    # This variable tells wrapper scripts just to set shlibpath_var
-    # rather than running their programs.
-    libtool_execute_magic="$magic"
-
-    # Check if any of the arguments is a wrapper script.
-    args=
-    for file
-    do
-      case "$file" in
-      -*) ;;
-      *)
-	# Do a test to see if this is really a libtool program.
-	if (sed -e '4q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then
-	  # If there is no directory component, then add one.
-	  case "$file" in
-	  */* | *\\*) . $file ;;
-	  *) . ./$file ;;
-	  esac
-
-	  # Transform arg to wrapped name.
-	  file="$progdir/$program"
-	fi
-	;;
-      esac
-      # Quote arguments (to preserve shell metacharacters).
-      file=`$echo "X$file" | $Xsed -e "$sed_quote_subst"`
-      args="$args \"$file\""
-    done
-
-    if test -z "$run"; then
-      if test -n "$shlibpath_var"; then
-	# Export the shlibpath_var.
-	eval "export $shlibpath_var"
-      fi
-
-      # Restore saved enviroment variables
-      if test "${save_LC_ALL+set}" = set; then
-	LC_ALL="$save_LC_ALL"; export LC_ALL
-      fi
-      if test "${save_LANG+set}" = set; then
-	LANG="$save_LANG"; export LANG
-      fi
-
-      # Now actually exec the command.
-      eval "exec \$cmd$args"
-
-      $echo "$modename: cannot exec \$cmd$args"
-      exit 1
-    else
-      # Display what would be done.
-      if test -n "$shlibpath_var"; then
-	eval "\$echo \"\$shlibpath_var=\$$shlibpath_var\""
-	$echo "export $shlibpath_var"
-      fi
-      $echo "$cmd$args"
-      exit 0
-    fi
-    ;;
-
-  # libtool clean and uninstall mode
-  clean | uninstall)
-    modename="$modename: $mode"
-    rm="$nonopt"
-    files=
-
-    # This variable tells wrapper scripts just to set variables rather
-    # than running their programs.
-    libtool_install_magic="$magic"
-
-    for arg
-    do
-      case "$arg" in
-      -*) rm="$rm $arg" ;;
-      *) files="$files $arg" ;;
-      esac
-    done
-
-    if test -z "$rm"; then
-      $echo "$modename: you must specify an RM program" 1>&2
-      $echo "$help" 1>&2
-      exit 1
-    fi
-
-    for file in $files; do
-      dir=`$echo "X$file" | $Xsed -e 's%/[^/]*$%%'`
-      if test "X$dir" = "X$file"; then
-	dir=.
-	objdir="$objdir"
-      else
-	objdir="$dir/$objdir"
-      fi
-      name=`$echo "X$file" | $Xsed -e 's%^.*/%%'`
-      test $mode = uninstall && objdir="$dir"
-
-      rmfiles="$file"
-
-      case "$name" in
-      *.la)
-	# Possibly a libtool archive, so verify it.
-	if (sed -e '2q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then
-	  . $dir/$name
-
-	  # Delete the libtool libraries and symlinks.
-	  for n in $library_names; do
-	    rmfiles="$rmfiles $objdir/$n"
-	  done
-	  test -n "$old_library" && rmfiles="$rmfiles $objdir/$old_library"
-	  test $mode = clean && rmfiles="$rmfiles $objdir/$name $objdir/${name}i"
-
-	  if test $mode = uninstall; then
-	    if test -n "$library_names"; then
-	      # Do each command in the postuninstall commands.
-	      eval cmds=\"$postuninstall_cmds\"
-	      IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
-	      for cmd in $cmds; do
-		IFS="$save_ifs"
-		$show "$cmd"
-		$run eval "$cmd"
-	      done
-	      IFS="$save_ifs"
-	    fi
-
-	    if test -n "$old_library"; then
-	      # Do each command in the old_postuninstall commands.
-	      eval cmds=\"$old_postuninstall_cmds\"
-	      IFS="${IFS= 	}"; save_ifs="$IFS"; IFS='~'
-	      for cmd in $cmds; do
-		IFS="$save_ifs"
-		$show "$cmd"
-		$run eval "$cmd"
-	      done
-	      IFS="$save_ifs"
-	    fi
-	    # FIXME: should reinstall the best remaining shared library.
-	  fi
-	fi
-	;;
-
-      *.lo)
-	if test "$build_old_libs" = yes; then
-	  oldobj=`$echo "X$name" | $Xsed -e "$lo2o"`
-	  rmfiles="$rmfiles $dir/$oldobj"
-	fi
-	;;
-
-      *)
-	# Do a test to see if this is a libtool program.
-	if test $mode = clean &&
-	   (sed -e '4q' $file | egrep "^# Generated by .*$PACKAGE") >/dev/null 2>&1; then
-	  relink_command=
-	  . $dir/$file
-
-	  rmfiles="$rmfiles $objdir/$name $objdir/${name}S.${objext}"
-	  if test "$fast_install" = yes && test -n "$relink_command"; then
-	    rmfiles="$rmfiles $objdir/lt-$name"
-	  fi
-	fi
-	;;
-      esac
-      $show "$rm $rmfiles"
-      $run $rm $rmfiles
-    done
-    exit 0
-    ;;
-
-  "")
-    $echo "$modename: you must specify a MODE" 1>&2
-    $echo "$generic_help" 1>&2
-    exit 1
-    ;;
-  esac
-
-  $echo "$modename: invalid operation mode \`$mode'" 1>&2
-  $echo "$generic_help" 1>&2
-  exit 1
-fi # test -z "$show_help"
-
-# We need to display help for each of the modes.
-case "$mode" in
-"") $echo \
-"Usage: $modename [OPTION]... [MODE-ARG]...
-
-Provide generalized library-building support services.
-
-    --config          show all configuration variables
-    --debug           enable verbose shell tracing
--n, --dry-run         display commands without modifying any files
-    --features        display basic configuration information and exit
-    --finish          same as \`--mode=finish'
-    --help            display this help message and exit
-    --mode=MODE       use operation mode MODE [default=inferred from MODE-ARGS]
-    --quiet           same as \`--silent'
-    --silent          don't print informational messages
-    --version         print version information
-
-MODE must be one of the following:
-
-      clean           remove files from the build directory
-      compile         compile a source file into a libtool object
-      execute         automatically set library path, then run a program
-      finish          complete the installation of libtool libraries
-      install         install libraries or executables
-      link            create a library or an executable
-      uninstall       remove libraries from an installed directory
-
-MODE-ARGS vary depending on the MODE.  Try \`$modename --help --mode=MODE' for
-a more detailed description of MODE."
-  exit 0
-  ;;
-
-clean)
-  $echo \
-"Usage: $modename [OPTION]... --mode=clean RM [RM-OPTION]... FILE...
-
-Remove files from the build directory.
-
-RM is the name of the program to use to delete files associated with each FILE
-(typically \`/bin/rm').  RM-OPTIONS are options (such as \`-f') to be passed
-to RM.
-
-If FILE is a libtool library, object or program, all the files associated
-with it are deleted. Otherwise, only FILE itself is deleted using RM."
-  ;;
-
-compile)
-  $echo \
-"Usage: $modename [OPTION]... --mode=compile COMPILE-COMMAND... SOURCEFILE
-
-Compile a source file into a libtool library object.
-
-This mode accepts the following additional options:
-
-  -o OUTPUT-FILE    set the output file name to OUTPUT-FILE
-  -static           always build a \`.o' file suitable for static linking
-
-COMPILE-COMMAND is a command to be used in creating a \`standard' object file
-from the given SOURCEFILE.
-
-The output file name is determined by removing the directory component from
-SOURCEFILE, then substituting the C source code suffix \`.c' with the
-library object suffix, \`.lo'."
-  ;;
-
-execute)
-  $echo \
-"Usage: $modename [OPTION]... --mode=execute COMMAND [ARGS]...
-
-Automatically set library path, then run a program.
-
-This mode accepts the following additional options:
-
-  -dlopen FILE      add the directory containing FILE to the library path
-
-This mode sets the library path environment variable according to \`-dlopen'
-flags.
-
-If any of the ARGS are libtool executable wrappers, then they are translated
-into their corresponding uninstalled binary, and any of their required library
-directories are added to the library path.
-
-Then, COMMAND is executed, with ARGS as arguments."
-  ;;
-
-finish)
-  $echo \
-"Usage: $modename [OPTION]... --mode=finish [LIBDIR]...
-
-Complete the installation of libtool libraries.
-
-Each LIBDIR is a directory that contains libtool libraries.
-
-The commands that this mode executes may require superuser privileges.  Use
-the \`--dry-run' option if you just want to see what would be executed."
-  ;;
-
-install)
-  $echo \
-"Usage: $modename [OPTION]... --mode=install INSTALL-COMMAND...
-
-Install executables or libraries.
-
-INSTALL-COMMAND is the installation command.  The first component should be
-either the \`install' or \`cp' program.
-
-The rest of the components are interpreted as arguments to that command (only
-BSD-compatible install options are recognized)."
-  ;;
-
-link)
-  $echo \
-"Usage: $modename [OPTION]... --mode=link LINK-COMMAND...
-
-Link object files or libraries together to form another library, or to
-create an executable program.
-
-LINK-COMMAND is a command using the C compiler that you would use to create
-a program from several object files.
-
-The following components of LINK-COMMAND are treated specially:
-
-  -all-static       do not do any dynamic linking at all
-  -avoid-version    do not add a version suffix if possible
-  -dlopen FILE      \`-dlpreopen' FILE if it cannot be dlopened at runtime
-  -dlpreopen FILE   link in FILE and add its symbols to lt_preloaded_symbols
-  -export-dynamic   allow symbols from OUTPUT-FILE to be resolved with dlsym(3)
-  -export-symbols SYMFILE
-		    try to export only the symbols listed in SYMFILE
-  -export-symbols-regex REGEX
-		    try to export only the symbols matching REGEX
-  -LLIBDIR          search LIBDIR for required installed libraries
-  -lNAME            OUTPUT-FILE requires the installed library libNAME
-  -module           build a library that can dlopened
-  -no-fast-install  disable the fast-install mode
-  -no-install       link a not-installable executable
-  -no-undefined     declare that a library does not refer to external symbols
-  -o OUTPUT-FILE    create OUTPUT-FILE from the specified objects
-  -release RELEASE  specify package release information
-  -rpath LIBDIR     the created library will eventually be installed in LIBDIR
-  -R[ ]LIBDIR       add LIBDIR to the runtime path of programs and libraries
-  -static           do not do any dynamic linking of libtool libraries
-  -version-info CURRENT[:REVISION[:AGE]]
-		    specify library version info [each variable defaults to 0]
-
-All other options (arguments beginning with \`-') are ignored.
-
-Every other argument is treated as a filename.  Files ending in \`.la' are
-treated as uninstalled libtool libraries, other files are standard or library
-object files.
-
-If the OUTPUT-FILE ends in \`.la', then a libtool library is created,
-only library objects (\`.lo' files) may be specified, and \`-rpath' is
-required, except when creating a convenience library.
-
-If OUTPUT-FILE ends in \`.a' or \`.lib', then a standard library is created
-using \`ar' and \`ranlib', or on Windows using \`lib'.
-
-If OUTPUT-FILE ends in \`.lo' or \`.${objext}', then a reloadable object file
-is created, otherwise an executable program is created."
-  ;;
-
-uninstall)
-  $echo \
-"Usage: $modename [OPTION]... --mode=uninstall RM [RM-OPTION]... FILE...
-
-Remove libraries from an installation directory.
-
-RM is the name of the program to use to delete files associated with each FILE
-(typically \`/bin/rm').  RM-OPTIONS are options (such as \`-f') to be passed
-to RM.
-
-If FILE is a libtool library, all the files associated with it are deleted.
-Otherwise, only FILE itself is deleted using RM."
-  ;;
-
-*)
-  $echo "$modename: invalid operation mode \`$mode'" 1>&2
-  $echo "$help" 1>&2
-  exit 1
-  ;;
-esac
-
-echo
-$echo "Try \`$modename --help' for more information about other modes."
-
-exit 0
-
-# Local Variables:
-# mode:shell-script
-# sh-indentation:2
-# End:
diff --git a/ghc/rts/gmp/mdate-sh b/ghc/rts/gmp/mdate-sh
deleted file mode 100644
index 37171f21fb..0000000000
--- a/ghc/rts/gmp/mdate-sh
+++ /dev/null
@@ -1,92 +0,0 @@
-#!/bin/sh
-# Get modification time of a file or directory and pretty-print it.
-# Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
-# written by Ulrich Drepper <drepper@gnu.ai.mit.edu>, June 1995
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software Foundation,
-# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-# Prevent date giving response in another language.
-LANG=C
-export LANG
-LC_ALL=C
-export LC_ALL
-LC_TIME=C
-export LC_TIME
-
-# Get the extended ls output of the file or directory.
-# On HPUX /bin/sh, "set" interprets "-rw-r--r--" as options, so the "x" below.
-if ls -L /dev/null 1>/dev/null 2>&1; then
-  set - x`ls -L -l -d $1`
-else
-  set - x`ls -l -d $1`
-fi
-# The month is at least the fourth argument
-# (3 shifts here, the next inside the loop).
-shift
-shift
-shift
-
-# Find the month.  Next argument is day, followed by the year or time.
-month=
-until test $month
-do
-  shift
-  case $1 in
-    Jan) month=January; nummonth=1;;
-    Feb) month=February; nummonth=2;;
-    Mar) month=March; nummonth=3;;
-    Apr) month=April; nummonth=4;;
-    May) month=May; nummonth=5;;
-    Jun) month=June; nummonth=6;;
-    Jul) month=July; nummonth=7;;
-    Aug) month=August; nummonth=8;;
-    Sep) month=September; nummonth=9;;
-    Oct) month=October; nummonth=10;;
-    Nov) month=November; nummonth=11;;
-    Dec) month=December; nummonth=12;;
-  esac
-done
-
-day=$2
-
-# Here we have to deal with the problem that the ls output gives either
-# the time of day or the year.
-case $3 in
-  *:*) set `date`; eval year=\$$#
-       case $2 in
-	 Jan) nummonthtod=1;;
-	 Feb) nummonthtod=2;;
-	 Mar) nummonthtod=3;;
-	 Apr) nummonthtod=4;;
-	 May) nummonthtod=5;;
-	 Jun) nummonthtod=6;;
-	 Jul) nummonthtod=7;;
-	 Aug) nummonthtod=8;;
-	 Sep) nummonthtod=9;;
-	 Oct) nummonthtod=10;;
-	 Nov) nummonthtod=11;;
-	 Dec) nummonthtod=12;;
-       esac
-       # For the first six month of the year the time notation can also
-       # be used for files modified in the last year.
-       if (expr $nummonth \> $nummonthtod) > /dev/null;
-       then
-	 year=`expr $year - 1`
-       fi;;
-  *) year=$3;;
-esac
-
-# The result.
-echo $day $month $year
diff --git a/ghc/rts/gmp/memory.c b/ghc/rts/gmp/memory.c
deleted file mode 100644
index 9df440ce22..0000000000
--- a/ghc/rts/gmp/memory.c
+++ /dev/null
@@ -1,160 +0,0 @@
-/* Memory allocation routines.
-
-Copyright (C) 1991, 1993, 1994, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h>
-#include <stdlib.h> /* for malloc, realloc, free */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-#ifdef __NeXT__
-#define static
-#endif
-
-
-void *	(*_mp_allocate_func) _PROTO ((size_t)) = _mp_default_allocate;
-void *	(*_mp_reallocate_func) _PROTO ((void *, size_t, size_t))
-     = _mp_default_reallocate;
-void	(*_mp_free_func) _PROTO ((void *, size_t)) = _mp_default_free;
-
-
-/* Default allocation functions.  In case of failure to allocate/reallocate
-   an error message is written to stderr and the program aborts.  */
-
-void *
-#if __STDC__
-_mp_default_allocate (size_t size)
-#else
-_mp_default_allocate (size)
-     size_t size;
-#endif
-{
-  void *ret;
-#ifdef DEBUG
-  size_t req_size = size;
-  size += 2 * BYTES_PER_MP_LIMB;
-#endif
-  ret = malloc (size);
-  if (ret == 0)
-    {
-      perror ("cannot allocate in gmp");
-      abort ();
-    }
-  
-#ifdef DEBUG
-  {
-    mp_ptr p = ret;
-    p++;
-    p[-1] = (0xdeadbeef << 31) + 0xdeafdeed;
-    if (req_size % BYTES_PER_MP_LIMB == 0)
-      p[req_size / BYTES_PER_MP_LIMB] = ~((0xdeadbeef << 31) + 0xdeafdeed);
-    ret = p;
-  }
-#endif
-  return ret;
-}
-
-void *
-#if __STDC__
-_mp_default_reallocate (void *oldptr, size_t old_size, size_t new_size)
-#else
-_mp_default_reallocate (oldptr, old_size, new_size)
-     void *oldptr;
-     size_t old_size;
-     size_t new_size;
-#endif
-{
-  void *ret;
-
-#ifdef DEBUG
-  size_t req_size = new_size;
-
-  if (old_size != 0)
-    {
-      mp_ptr p = oldptr;
-      if (p[-1] != (0xdeadbeef << 31) + 0xdeafdeed)
-	{
-	  fprintf (stderr, "gmp: (realloc) data clobbered before allocation block\n");
-	  abort ();
-	}
-      if (old_size % BYTES_PER_MP_LIMB == 0)
-	if (p[old_size / BYTES_PER_MP_LIMB] != ~((0xdeadbeef << 31) + 0xdeafdeed))
-	  {
-	    fprintf (stderr, "gmp: (realloc) data clobbered after allocation block\n");
-	    abort ();
-	  }
-      oldptr = p - 1;
-    }
-
-  new_size += 2 * BYTES_PER_MP_LIMB;
-#endif
-
-  ret = realloc (oldptr, new_size);
-  if (ret == 0)
-    {
-      perror ("cannot allocate in gmp");
-      abort ();
-    }
-
-#ifdef DEBUG
-  {
-    mp_ptr p = ret;
-    p++;
-    p[-1] = (0xdeadbeef << 31) + 0xdeafdeed;
-    if (req_size % BYTES_PER_MP_LIMB == 0)
-      p[req_size / BYTES_PER_MP_LIMB] = ~((0xdeadbeef << 31) + 0xdeafdeed);
-    ret = p;
-  }
-#endif
-  return ret;
-}
-
-void
-#if __STDC__
-_mp_default_free (void *blk_ptr, size_t blk_size)
-#else
-_mp_default_free (blk_ptr, blk_size)
-     void *blk_ptr;
-     size_t blk_size;
-#endif
-{
-#ifdef DEBUG
-  {
-    mp_ptr p = blk_ptr;
-    if (blk_size != 0)
-      {
-	if (p[-1] != (0xdeadbeef << 31) + 0xdeafdeed)
-	  {
-	    fprintf (stderr, "gmp: (free) data clobbered before allocation block\n");
-	    abort ();
-	  }
-	if (blk_size % BYTES_PER_MP_LIMB == 0)
-	  if (p[blk_size / BYTES_PER_MP_LIMB] != ~((0xdeadbeef << 31) + 0xdeafdeed))
-	    {
-	      fprintf (stderr, "gmp: (free) data clobbered after allocation block\n");
-	      abort ();
-	    }
-      }
-    blk_ptr = p - 1;
-  }
-#endif
-  free (blk_ptr);
-}
diff --git a/ghc/rts/gmp/missing b/ghc/rts/gmp/missing
deleted file mode 100644
index c60e9d772f..0000000000
--- a/ghc/rts/gmp/missing
+++ /dev/null
@@ -1,244 +0,0 @@
-#! /bin/sh
-# Common stub for a few missing GNU programs while installing.
-# Copyright (C) 1996, 1997, 1999 Free Software Foundation, Inc.
-# Originally by Fran,cois Pinard <pinard@iro.umontreal.ca>, 1996.
-
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-# 02111-1307, USA.
-
-if test $# -eq 0; then
-  echo 1>&2 "Try \`$0 --help' for more information"
-  exit 1
-fi
-
-run=:
-
-case "$1" in
---run)
-  # Try to run requested program, and just exit if it succeeds.
-  run=
-  shift
-  "$@" && exit 0
-  ;;
-esac
-
-# If it does not exist, or fails to run (possibly an outdated version),
-# try to emulate it.
-case "$1" in
-
-  -h|--h|--he|--hel|--help)
-    echo "\
-$0 [OPTION]... PROGRAM [ARGUMENT]...
-
-Handle \`PROGRAM [ARGUMENT]...' for when PROGRAM is missing, or return an
-error status if there is no known handling for PROGRAM.
-
-Options:
-  -h, --help      display this help and exit
-  -v, --version   output version information and exit
-  --run           try to run the given command, and emulate it if it fails
-
-Supported PROGRAM values:
-  aclocal      touch file \`aclocal.m4'
-  autoconf     touch file \`configure'
-  autoheader   touch file \`config.h.in'
-  automake     touch all \`Makefile.in' files
-  bison        create \`y.tab.[ch]', if possible, from existing .[ch]
-  flex         create \`lex.yy.c', if possible, from existing .c
-  lex          create \`lex.yy.c', if possible, from existing .c
-  makeinfo     touch the output file
-  tar          try tar, gnutar, gtar, then tar without non-portable flags
-  yacc         create \`y.tab.[ch]', if possible, from existing .[ch]"
-    ;;
-
-  -v|--v|--ve|--ver|--vers|--versi|--versio|--version)
-    echo "missing 0.2 - GNU automake"
-    ;;
-
-  -*)
-    echo 1>&2 "$0: Unknown \`$1' option"
-    echo 1>&2 "Try \`$0 --help' for more information"
-    exit 1
-    ;;
-
-  aclocal)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified \`acinclude.m4' or \`configure.in'.  You might want
-         to install the \`Automake' and \`Perl' packages.  Grab them from
-         any GNU archive site."
-    touch aclocal.m4
-    ;;
-
-  autoconf)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified \`configure.in'.  You might want to install the
-         \`Autoconf' and \`GNU m4' packages.  Grab them from any GNU
-         archive site."
-    touch configure
-    ;;
-
-  autoheader)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified \`acconfig.h' or \`configure.in'.  You might want
-         to install the \`Autoconf' and \`GNU m4' packages.  Grab them
-         from any GNU archive site."
-    files=`sed -n 's/^[ ]*A[CM]_CONFIG_HEADER(\([^)]*\)).*/\1/p' configure.in`
-    test -z "$files" && files="config.h"
-    touch_files=
-    for f in $files; do
-      case "$f" in
-      *:*) touch_files="$touch_files "`echo "$f" |
-				       sed -e 's/^[^:]*://' -e 's/:.*//'`;;
-      *) touch_files="$touch_files $f.in";;
-      esac
-    done
-    touch $touch_files
-    ;;
-
-  automake)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified \`Makefile.am', \`acinclude.m4' or \`configure.in'.
-         You might want to install the \`Automake' and \`Perl' packages.
-         Grab them from any GNU archive site."
-    find . -type f -name Makefile.am -print |
-	   sed 's/\.am$/.in/' |
-	   while read f; do touch "$f"; done
-    ;;
-
-  bison|yacc)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified a \`.y' file.  You may need the \`Bison' package
-         in order for those modifications to take effect.  You can get
-         \`Bison' from any GNU archive site."
-    rm -f y.tab.c y.tab.h
-    if [ $# -ne 1 ]; then
-        eval LASTARG="\${$#}"
-	case "$LASTARG" in
-	*.y)
-	    SRCFILE=`echo "$LASTARG" | sed 's/y$/c/'`
-	    if [ -f "$SRCFILE" ]; then
-	         cp "$SRCFILE" y.tab.c
-	    fi
-	    SRCFILE=`echo "$LASTARG" | sed 's/y$/h/'`
-	    if [ -f "$SRCFILE" ]; then
-	         cp "$SRCFILE" y.tab.h
-	    fi
-	  ;;
-	esac
-    fi
-    if [ ! -f y.tab.h ]; then
-	echo >y.tab.h
-    fi
-    if [ ! -f y.tab.c ]; then
-	echo 'main() { return 0; }' >y.tab.c
-    fi
-    ;;
-
-  lex|flex)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified a \`.l' file.  You may need the \`Flex' package
-         in order for those modifications to take effect.  You can get
-         \`Flex' from any GNU archive site."
-    rm -f lex.yy.c
-    if [ $# -ne 1 ]; then
-        eval LASTARG="\${$#}"
-	case "$LASTARG" in
-	*.l)
-	    SRCFILE=`echo "$LASTARG" | sed 's/l$/c/'`
-	    if [ -f "$SRCFILE" ]; then
-	         cp "$SRCFILE" lex.yy.c
-	    fi
-	  ;;
-	esac
-    fi
-    if [ ! -f lex.yy.c ]; then
-	echo 'main() { return 0; }' >lex.yy.c
-    fi
-    ;;
-
-  makeinfo)
-    echo 1>&2 "\
-WARNING: \`$1' is missing on your system.  You should only need it if
-         you modified a \`.texi' or \`.texinfo' file, or any other file
-         indirectly affecting the aspect of the manual.  The spurious
-         call might also be the consequence of using a buggy \`make' (AIX,
-         DU, IRIX).  You might want to install the \`Texinfo' package or
-         the \`GNU make' package.  Grab either from any GNU archive site."
-    file=`echo "$*" | sed -n 's/.*-o \([^ ]*\).*/\1/p'`
-    if test -z "$file"; then
-      file=`echo "$*" | sed 's/.* \([^ ]*\) *$/\1/'`
-      file=`sed -n '/^@setfilename/ { s/.* \([^ ]*\) *$/\1/; p; q; }' $file`
-    fi
-    touch $file
-    ;;
-
-  tar)
-    shift
-    if test -n "$run"; then
-      echo 1>&2 "ERROR: \`tar' requires --run"
-      exit 1
-    fi
-
-    # We have already tried tar in the generic part.
-    # Look for gnutar/gtar before invocation to avoid ugly error
-    # messages.
-    if (gnutar --version > /dev/null 2>&1); then
-       gnutar ${1+"$@"} && exit 0
-    fi
-    if (gtar --version > /dev/null 2>&1); then
-       gtar ${1+"$@"} && exit 0
-    fi
-    firstarg="$1"
-    if shift; then
-	case "$firstarg" in
-	*o*)
-	    firstarg=`echo "$firstarg" | sed s/o//`
-	    tar "$firstarg" ${1+"$@"} && exit 0
-	    ;;
-	esac
-	case "$firstarg" in
-	*h*)
-	    firstarg=`echo "$firstarg" | sed s/h//`
-	    tar "$firstarg" ${1+"$@"} && exit 0
-	    ;;
-	esac
-    fi
-
-    echo 1>&2 "\
-WARNING: I can't seem to be able to run \`tar' with the given arguments.
-         You may want to install GNU tar or Free paxutils, or check the
-         command line arguments."
-    exit 1
-    ;;
-
-  *)
-    echo 1>&2 "\
-WARNING: \`$1' is needed, and you do not seem to have it handy on your
-         system.  You might have modified some files without having the
-         proper tools for further handling them.  Check the \`README' file,
-         it often tells you about the needed prerequirements for installing
-         this package.  You may also peek at any GNU archive site, in case
-         some other package would contain this missing \`$1' program."
-    exit 1
-    ;;
-esac
-
-exit 0
diff --git a/ghc/rts/gmp/mkinstalldirs b/ghc/rts/gmp/mkinstalldirs
deleted file mode 100644
index 5e17cd39fb..0000000000
--- a/ghc/rts/gmp/mkinstalldirs
+++ /dev/null
@@ -1,38 +0,0 @@
-#! /bin/sh
-# mkinstalldirs --- make directory hierarchy
-# Author: Noah Friedman <friedman@prep.ai.mit.edu>
-# Created: 1993-05-16
-# Public domain
-
-errstatus=0
-
-for file
-do
-   set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'`
-   shift
-
-   pathcomp=
-   for d
-   do
-     pathcomp="$pathcomp$d"
-     case "$pathcomp" in
-       -* ) pathcomp=./$pathcomp ;;
-     esac
-
-     if test ! -d "$pathcomp"; then
-        echo "mkdir $pathcomp"
-
-        mkdir "$pathcomp" || lasterr=$?
-
-        if test ! -d "$pathcomp"; then
-  	  errstatus=$lasterr
-        fi
-     fi
-
-     pathcomp="$pathcomp/"
-   done
-done
-
-exit $errstatus
-
-# mkinstalldirs ends here
diff --git a/ghc/rts/gmp/mp.h b/ghc/rts/gmp/mp.h
deleted file mode 100644
index ffab4cba82..0000000000
--- a/ghc/rts/gmp/mp.h
+++ /dev/null
@@ -1,124 +0,0 @@
-/* mp.h -- Definitions for Berkeley compatible multiple precision functions.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1996, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#ifndef __MP_H__
-
-#ifndef __GNU_MP__		/* to allow inclusion of both gmp.h and mp.h */
-#define __GNU_MP__ 3
-#define __need_size_t
-#include <stddef.h>
-#undef __need_size_t
-
-#if defined (__STDC__) || defined (__cplusplus)
-#define __gmp_const const
-#else
-#define __gmp_const
-#endif
-
-#if defined (__GNUC__)
-#define __gmp_inline __inline__
-#else
-#define __gmp_inline
-#endif
-
-#ifndef _EXTERN_INLINE
-#ifdef __GNUC__
-#define _EXTERN_INLINE extern __inline__
-#else
-#define _EXTERN_INLINE static
-#endif
-#endif
-
-#ifdef _SHORT_LIMB
-typedef unsigned int		mp_limb_t;
-typedef int			mp_limb_signed_t;
-#else
-#ifdef _LONG_LONG_LIMB
-typedef unsigned long long int	mp_limb_t;
-typedef long long int		mp_limb_signed_t;
-#else
-typedef unsigned long int	mp_limb_t;
-typedef long int		mp_limb_signed_t;
-#endif
-#endif
-
-typedef mp_limb_t *		mp_ptr;
-typedef __gmp_const mp_limb_t *	mp_srcptr;
-typedef int			mp_size_t;
-typedef long int		mp_exp_t;
-
-typedef struct
-{
-  int _mp_alloc;		/* Number of *limbs* allocated and pointed
-				   to by the D field.  */
-  int _mp_size;			/* abs(SIZE) is the number of limbs
-				   the last field points to.  If SIZE
-				   is negative this is a negative
-				   number.  */
-  mp_limb_t *_mp_d;		/* Pointer to the limbs.  */
-} __mpz_struct;
-#endif /* __GNU_MP__ */
-
-/* User-visible types.  */
-typedef __mpz_struct MINT;
-
-
-#ifndef _PROTO
-#if (__STDC__-0) || defined (__cplusplus)
-#define _PROTO(x) x
-#else
-#define _PROTO(x) ()
-#endif
-#endif
-
-#if defined (__cplusplus)
-extern "C" {
-#endif
-
-#define mp_set_memory_functions __gmp_set_memory_functions
-void mp_set_memory_functions _PROTO ((void *(*) (size_t),
-                                      void *(*) (void *, size_t, size_t),
-                                      void (*) (void *, size_t)));
-MINT *itom _PROTO ((signed short int));
-MINT *xtom _PROTO ((const char *));
-void move _PROTO ((const MINT *, MINT *));
-void madd _PROTO ((const MINT *, const MINT *, MINT *));
-void msub _PROTO ((const MINT *, const MINT *, MINT *));
-void mult _PROTO ((const MINT *, const MINT *, MINT *));
-void mdiv _PROTO ((const MINT *, const MINT *, MINT *, MINT *));
-void sdiv _PROTO ((const MINT *, signed short int, MINT *, signed short int *));
-void msqrt _PROTO ((const MINT *, MINT *, MINT *));
-void pow _PROTO ((const MINT *, const MINT *, const MINT *, MINT *));
-void rpow _PROTO ((const MINT *, signed short int, MINT *));
-void gcd _PROTO ((const MINT *, const MINT *, MINT *));
-int mcmp _PROTO ((const MINT *, const MINT *));
-void min _PROTO ((MINT *));
-void mout _PROTO ((const MINT *));
-char *mtox _PROTO ((const MINT *));
-void mfree _PROTO ((MINT *));
-
-#if defined (__cplusplus)
-}
-#endif
-
-#define __MP_H__
-#endif /* __MP_H__ */
diff --git a/ghc/rts/gmp/mp_bpl.c b/ghc/rts/gmp/mp_bpl.c
deleted file mode 100644
index df8b03e5ab..0000000000
--- a/ghc/rts/gmp/mp_bpl.c
+++ /dev/null
@@ -1,27 +0,0 @@
-/*
-Copyright (C) 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-const int mp_bits_per_limb = BITS_PER_MP_LIMB;
-const int __gmp_0 = 0;
-int __gmp_junk;
diff --git a/ghc/rts/gmp/mp_clz_tab.c b/ghc/rts/gmp/mp_clz_tab.c
deleted file mode 100644
index 1bbd1d6a66..0000000000
--- a/ghc/rts/gmp/mp_clz_tab.c
+++ /dev/null
@@ -1,36 +0,0 @@
-/* __clz_tab -- support for longlong.h
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-const
-unsigned char __clz_tab[] =
-{
-  0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
-  6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
-  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
-  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
-  8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
-  8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
-  8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
-  8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
-};
diff --git a/ghc/rts/gmp/mp_minv_tab.c b/ghc/rts/gmp/mp_minv_tab.c
deleted file mode 100644
index 4afff85cfc..0000000000
--- a/ghc/rts/gmp/mp_minv_tab.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/* A table of data supporting modlimb_invert().
-
-   THE CONTENTS OF THIS FILE ARE FOR INTERNAL USE AND MAY CHANGE
-   INCOMPATIBLY OR DISAPPEAR IN A FUTURE GNU MP RELEASE.  */
-
-/*
-Copyright (C) 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.  */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-
-/* modlimb_invert_table[i] is the multiplicative inverse of 2*i+1 mod 256,
-   ie. (modlimb_invert_table[i] * (2*i+1)) % 256 == 1 */
-
-const unsigned char  modlimb_invert_table[128] = {
-  0x01, 0xAB, 0xCD, 0xB7, 0x39, 0xA3, 0xC5, 0xEF,
-  0xF1, 0x1B, 0x3D, 0xA7, 0x29, 0x13, 0x35, 0xDF,
-  0xE1, 0x8B, 0xAD, 0x97, 0x19, 0x83, 0xA5, 0xCF,
-  0xD1, 0xFB, 0x1D, 0x87, 0x09, 0xF3, 0x15, 0xBF,
-  0xC1, 0x6B, 0x8D, 0x77, 0xF9, 0x63, 0x85, 0xAF,
-  0xB1, 0xDB, 0xFD, 0x67, 0xE9, 0xD3, 0xF5, 0x9F,
-  0xA1, 0x4B, 0x6D, 0x57, 0xD9, 0x43, 0x65, 0x8F,
-  0x91, 0xBB, 0xDD, 0x47, 0xC9, 0xB3, 0xD5, 0x7F,
-  0x81, 0x2B, 0x4D, 0x37, 0xB9, 0x23, 0x45, 0x6F,
-  0x71, 0x9B, 0xBD, 0x27, 0xA9, 0x93, 0xB5, 0x5F,
-  0x61, 0x0B, 0x2D, 0x17, 0x99, 0x03, 0x25, 0x4F,
-  0x51, 0x7B, 0x9D, 0x07, 0x89, 0x73, 0x95, 0x3F,
-  0x41, 0xEB, 0x0D, 0xF7, 0x79, 0xE3, 0x05, 0x2F,
-  0x31, 0x5B, 0x7D, 0xE7, 0x69, 0x53, 0x75, 0x1F,
-  0x21, 0xCB, 0xED, 0xD7, 0x59, 0xC3, 0xE5, 0x0F,
-  0x11, 0x3B, 0x5D, 0xC7, 0x49, 0x33, 0x55, 0xFF
-};
diff --git a/ghc/rts/gmp/mp_set_fns.c b/ghc/rts/gmp/mp_set_fns.c
deleted file mode 100644
index 55d4d9d6e4..0000000000
--- a/ghc/rts/gmp/mp_set_fns.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/* mp_set_memory_functions -- Set the allocate, reallocate, and free functions
-   for use by the mp package.
-
-Copyright (C) 1991, 1993, 1994 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mp_set_memory_functions (void *(*alloc_func) (size_t),
-			 void *(*realloc_func) (void *, size_t, size_t),
-			 void (*free_func) (void *, size_t))
-#else
-mp_set_memory_functions (alloc_func, realloc_func, free_func)
-     void *(*alloc_func) ();
-     void *(*realloc_func) ();
-     void (*free_func) ();
-#endif
-{
-  if (alloc_func == 0)
-    alloc_func = _mp_default_allocate;
-  if (realloc_func == 0)
-    realloc_func = _mp_default_reallocate;
-  if (free_func == 0)
-    free_func = _mp_default_free;
-
-  _mp_allocate_func = alloc_func;
-  _mp_reallocate_func = realloc_func;
-  _mp_free_func = free_func;
-}
diff --git a/ghc/rts/gmp/mpn/Makefile.am b/ghc/rts/gmp/mpn/Makefile.am
deleted file mode 100644
index 1c49ccda25..0000000000
--- a/ghc/rts/gmp/mpn/Makefile.am
+++ /dev/null
@@ -1,94 +0,0 @@
-## Process this file with automake to generate Makefile.in
-
-# Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
-#
-# This file is part of the GNU MP Library.
-#
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-#
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-AUTOMAKE_OPTIONS = gnu no-dependencies
-SUBDIRS = tests
-
-CPP	= @CPP@
-
-# -DOPERATION_$* tells multi-function files which function to produce.
-INCLUDES = -I$(top_srcdir) -DOPERATION_$*
-
-GENERIC_SOURCES = mp_bases.c
-OFILES = @mpn_objects@
-
-noinst_LTLIBRARIES = libmpn.la
-libmpn_la_SOURCES = $(GENERIC_SOURCES)
-libmpn_la_LIBADD = $(OFILES)
-libmpn_la_DEPENDENCIES = $(OFILES)
-
-TARG_DIST = a29k alpha arm clipper cray generic hppa i960 lisp m68k m88k \
-  mips2 mips3 ns32k pa64 pa64w power powerpc32 powerpc64 pyr sh sparc32 \
-  sparc64 thumb vax x86 z8000 z8000x
-
-EXTRA_DIST = underscore.h asm-defs.m4 $(TARG_DIST)
-
-# COMPILE minus CC.  FIXME: Really pass *_CFLAGS to CPP?
-COMPILE_FLAGS =	\
-	$(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
-
-SUFFIXES = .s .S .asm
-
-# *.s are not preprocessed at all.
-.s.o:
-	$(CCAS) $(COMPILE_FLAGS) $<
-.s.obj:
-	$(CCAS) $(COMPILE_FLAGS) `cygpath -w $<`
-.s.lo:
-	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) $<
-
-# *.S are preprocessed with CPP.
-.S.o:
-	$(CPP) $(COMPILE_FLAGS) $< | grep -v '^#' >tmp-$*.s
-	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
-	rm -f tmp-$*.s
-.S.obj:
-	$(CPP) $(COMPILE_FLAGS) `cygpath -w $<` | grep -v '^#' >tmp-$*.s
-	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
-	rm -f tmp-$*.s
-
-# We have to rebuild the static object file without passing -DPIC to
-# preprocessor.  The overhead cost is one extra assemblation.  FIXME:
-# Teach libtool how to assemble with a preprocessor pass (CPP or m4).
-
-.S.lo:
-	$(CPP) $(COMPILE_FLAGS) -DPIC $< | grep -v '^#' >tmp-$*.s
-	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
-	$(CPP) $(COMPILE_FLAGS) $< | grep -v '^#' >tmp-$*.s
-	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $*.o
-	rm -f tmp-$*.s
-
-# *.m4 are preprocessed with m4.
-.asm.o:
-	$(M4) -DOPERATION_$* $< >tmp-$*.s
-	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
-	rm -f tmp-$*.s
-.asm.obj:
-	$(M4) -DOPERATION_$* `cygpath -w $<` >tmp-$*.s
-	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
-	rm -f tmp-$*.s
-.asm.lo:
-	$(M4) -DPIC -DOPERATION_$* $< >tmp-$*.s
-	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
-	$(M4) -DOPERATION_$* $< >tmp-$*.s
-	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $*.o
-	rm -f tmp-$*.s
diff --git a/ghc/rts/gmp/mpn/Makefile.in b/ghc/rts/gmp/mpn/Makefile.in
deleted file mode 100644
index 59ee958c92..0000000000
--- a/ghc/rts/gmp/mpn/Makefile.in
+++ /dev/null
@@ -1,472 +0,0 @@
-# Makefile.in generated automatically by automake 1.4a from Makefile.am
-
-# Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
-# This Makefile.in is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
-# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-# PARTICULAR PURPOSE.
-
-SHELL = @SHELL@
-
-srcdir = @srcdir@
-top_srcdir = @top_srcdir@
-VPATH = @srcdir@
-prefix = @prefix@
-exec_prefix = @exec_prefix@
-
-bindir = @bindir@
-sbindir = @sbindir@
-libexecdir = @libexecdir@
-datadir = @datadir@
-sysconfdir = @sysconfdir@
-sharedstatedir = @sharedstatedir@
-localstatedir = @localstatedir@
-libdir = @libdir@
-infodir = @infodir@
-mandir = @mandir@
-includedir = @includedir@
-oldincludedir = /usr/include
-
-DESTDIR =
-
-pkgdatadir = $(datadir)/@PACKAGE@
-pkglibdir = $(libdir)/@PACKAGE@
-pkgincludedir = $(includedir)/@PACKAGE@
-
-top_builddir = ..
-
-ACLOCAL = @ACLOCAL@
-AUTOCONF = @AUTOCONF@
-AUTOMAKE = @AUTOMAKE@
-AUTOHEADER = @AUTOHEADER@
-
-INSTALL = @INSTALL@
-INSTALL_PROGRAM = @INSTALL_PROGRAM@
-INSTALL_DATA = @INSTALL_DATA@
-INSTALL_SCRIPT = @INSTALL_SCRIPT@
-INSTALL_STRIP_FLAG =
-transform = @program_transform_name@
-
-NORMAL_INSTALL = :
-PRE_INSTALL = :
-POST_INSTALL = :
-NORMAL_UNINSTALL = :
-PRE_UNINSTALL = :
-POST_UNINSTALL = :
-
-@SET_MAKE@
-build_alias = @build_alias@
-build_triplet = @build@
-host_alias = @host_alias@
-host_triplet = @host@
-target_alias = @target_alias@
-target_triplet = @target@
-AMDEP = @AMDEP@
-AMTAR = @AMTAR@
-AR = @AR@
-AS = @AS@
-AWK = @AWK@
-CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
-CC = @CC@
-CCAS = @CCAS@
-CPP = @CPP@
-CXX = @CXX@
-CXXCPP = @CXXCPP@
-DEPDIR = @DEPDIR@
-DLLTOOL = @DLLTOOL@
-EXEEXT = @EXEEXT@
-LIBTOOL = @LIBTOOL@
-LN_S = @LN_S@
-M4 = @M4@
-MAINT = @MAINT@
-MAKEINFO = @MAKEINFO@
-OBJDUMP = @OBJDUMP@
-OBJEXT = @OBJEXT@
-PACKAGE = @PACKAGE@
-RANLIB = @RANLIB@
-SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
-STRIP = @STRIP@
-U = @U@
-VERSION = @VERSION@
-gmp_srclinks = @gmp_srclinks@
-install_sh = @install_sh@
-mpn_objects = @mpn_objects@
-mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
-
-# Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
-#
-# This file is part of the GNU MP Library.
-#
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-#
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-AUTOMAKE_OPTIONS = gnu no-dependencies
-SUBDIRS =
-
-CPP = @CPP@
-
-# -DOPERATION_$* tells multi-function files which function to produce.
-INCLUDES = -I$(top_srcdir) -DOPERATION_$*
-
-GENERIC_SOURCES = mp_bases.c
-OFILES = @mpn_objects@
-
-noinst_LTLIBRARIES = libmpn.la
-libmpn_la_SOURCES = $(GENERIC_SOURCES)
-libmpn_la_LIBADD = $(OFILES)
-libmpn_la_DEPENDENCIES = $(OFILES)
-
-TARG_DIST = a29k alpha arm clipper cray generic hppa i960 lisp m68k m88k \
-  mips2 mips3 ns32k pa64 pa64w power powerpc32 powerpc64 pyr sh sparc32 \
-  sparc64 thumb vax x86 z8000 z8000x
-
-
-EXTRA_DIST = underscore.h asm-defs.m4 $(TARG_DIST)
-
-# COMPILE minus CC.  FIXME: Really pass *_CFLAGS to CPP?
-COMPILE_FLAGS = \
-	$(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
-
-
-SUFFIXES = .s .S .asm
-subdir = mpn
-mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
-CONFIG_HEADER = ../config.h
-CONFIG_CLEAN_FILES = 
-LTLIBRARIES =  $(noinst_LTLIBRARIES)
-
-
-DEFS = @DEFS@ -I. -I$(srcdir) -I..
-CPPFLAGS = @CPPFLAGS@
-LDFLAGS = @LDFLAGS@
-LIBS = @LIBS@
-libmpn_la_LDFLAGS = 
-am_libmpn_la_OBJECTS =  mp_bases.lo
-libmpn_la_OBJECTS =  $(am_libmpn_la_OBJECTS)
-COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
-LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
-CFLAGS = @CFLAGS@
-CCLD = $(CC)
-LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
-DIST_SOURCES =  $(libmpn_la_SOURCES)
-DIST_COMMON =  README Makefile.am Makefile.in
-
-
-DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
-
-GZIP_ENV = --best
-depcomp = 
-SOURCES = $(libmpn_la_SOURCES)
-OBJECTS = $(am_libmpn_la_OBJECTS)
-
-all: all-redirect
-.SUFFIXES:
-.SUFFIXES: .S .asm .c .lo .o .obj .s
-$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
-	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpn/Makefile
-
-Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
-	cd $(top_builddir) \
-	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
-
-
-mostlyclean-noinstLTLIBRARIES:
-
-clean-noinstLTLIBRARIES:
-	-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
-
-distclean-noinstLTLIBRARIES:
-
-maintainer-clean-noinstLTLIBRARIES:
-
-mostlyclean-compile:
-	-rm -f *.o core *.core
-	-rm -f *.$(OBJEXT)
-
-clean-compile:
-
-distclean-compile:
-	-rm -f *.tab.c
-
-maintainer-clean-compile:
-
-mostlyclean-libtool:
-	-rm -f *.lo
-
-clean-libtool:
-	-rm -rf .libs _libs
-
-distclean-libtool:
-
-maintainer-clean-libtool:
-
-libmpn.la: $(libmpn_la_OBJECTS) $(libmpn_la_DEPENDENCIES)
-	$(LINK)  $(libmpn_la_LDFLAGS) $(libmpn_la_OBJECTS) $(libmpn_la_LIBADD) $(LIBS)
-.c.o:
-	$(COMPILE) -c $<
-.c.obj:
-	$(COMPILE) -c `cygpath -w $<`
-.c.lo:
-	$(LTCOMPILE) -c -o $@ $<
-
-# This directory's subdirectories are mostly independent; you can cd
-# into them and run `make' without going through this Makefile.
-# To change the values of `make' variables: instead of editing Makefiles,
-# (1) if the variable is set in `config.status', edit `config.status'
-#     (which will cause the Makefiles to be regenerated when you run `make');
-# (2) otherwise, pass the desired values on the `make' command line.
-
-all-recursive install-data-recursive install-exec-recursive \
-installdirs-recursive install-recursive uninstall-recursive  \
-check-recursive installcheck-recursive info-recursive dvi-recursive:
-	@set fnord $(MAKEFLAGS); amf=$$2; \
-	dot_seen=no; \
-	target=`echo $@ | sed s/-recursive//`; \
-	list='$(SUBDIRS)'; for subdir in $$list; do \
-	  echo "Making $$target in $$subdir"; \
-	  if test "$$subdir" = "."; then \
-	    dot_seen=yes; \
-	    local_target="$$target-am"; \
-	  else \
-	    local_target="$$target"; \
-	  fi; \
-	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
-	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
-	done; \
-	if test "$$dot_seen" = "no"; then \
-	  $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
-	fi; test -z "$$fail"
-
-mostlyclean-recursive clean-recursive distclean-recursive \
-maintainer-clean-recursive:
-	@set fnord $(MAKEFLAGS); amf=$$2; \
-	dot_seen=no; \
-	rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
-	  rev="$$subdir $$rev"; \
-	  if test "$$subdir" = "."; then dot_seen=yes; else :; fi; \
-	done; \
-	test "$$dot_seen" = "no" && rev=". $$rev"; \
-	target=`echo $@ | sed s/-recursive//`; \
-	for subdir in $$rev; do \
-	  echo "Making $$target in $$subdir"; \
-	  if test "$$subdir" = "."; then \
-	    local_target="$$target-am"; \
-	  else \
-	    local_target="$$target"; \
-	  fi; \
-	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
-	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
-	done && test -z "$$fail"
-tags-recursive:
-	list='$(SUBDIRS)'; for subdir in $$list; do \
-	  test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
-	done
-
-tags: TAGS
-
-ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
-	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
-	unique=`for i in $$list; do \
-	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
-	  done | \
-	  $(AWK) '    { files[$$0] = 1; } \
-	       END { for (i in files) print i; }'`; \
-	mkid -f$$here/ID $$unique $(LISP)
-
-TAGS: tags-recursive $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
-		$(TAGS_FILES) $(LISP)
-	tags=; \
-	here=`pwd`; \
-	list='$(SUBDIRS)'; for subdir in $$list; do \
-   if test "$$subdir" = .; then :; else \
-	    test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
-   fi; \
-	done; \
-	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
-	unique=`for i in $$list; do \
-	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
-	  done | \
-	  $(AWK) '    { files[$$0] = 1; } \
-	       END { for (i in files) print i; }'`; \
-	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
-	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
-
-mostlyclean-tags:
-
-clean-tags:
-
-distclean-tags:
-	-rm -f TAGS ID
-
-maintainer-clean-tags:
-
-distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
-
-distdir: $(DISTFILES)
-	@for file in $(DISTFILES); do \
-	  d=$(srcdir); \
-	  if test -d $$d/$$file; then \
-	    cp -pR $$d/$$file $(distdir); \
-	  else \
-	    test -f $(distdir)/$$file \
-	    || cp -p $$d/$$file $(distdir)/$$file || :; \
-	  fi; \
-	done
-	for subdir in $(SUBDIRS); do \
-	  if test "$$subdir" = .; then :; else \
-	    test -d $(distdir)/$$subdir \
-	    || mkdir $(distdir)/$$subdir \
-	    || exit 1; \
-	    (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(top_distdir) distdir=../$(distdir)/$$subdir distdir) \
-	      || exit 1; \
-	  fi; \
-	done
-info-am:
-info: info-recursive
-dvi-am:
-dvi: dvi-recursive
-check-am: all-am
-check: check-recursive
-installcheck-am:
-installcheck: installcheck-recursive
-install-exec-am:
-install-exec: install-exec-recursive
-
-install-data-am:
-install-data: install-data-recursive
-
-install-am: all-am
-	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
-install: install-recursive
-uninstall-am:
-uninstall: uninstall-recursive
-all-am: Makefile $(LTLIBRARIES)
-all-redirect: all-recursive
-install-strip:
-	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
-installdirs: installdirs-recursive
-installdirs-am:
-
-
-mostlyclean-generic:
-
-clean-generic:
-
-distclean-generic:
-	-rm -f Makefile $(CONFIG_CLEAN_FILES)
-	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
-
-maintainer-clean-generic:
-	-rm -f Makefile.in
-mostlyclean-am:  mostlyclean-noinstLTLIBRARIES mostlyclean-compile \
-		mostlyclean-libtool mostlyclean-tags \
-		mostlyclean-generic
-
-mostlyclean: mostlyclean-recursive
-
-clean-am:  clean-noinstLTLIBRARIES clean-compile clean-libtool \
-		clean-tags clean-generic mostlyclean-am
-
-clean: clean-recursive
-
-distclean-am:  distclean-noinstLTLIBRARIES distclean-compile \
-		distclean-libtool distclean-tags distclean-generic \
-		clean-am
-	-rm -f libtool
-
-distclean: distclean-recursive
-
-maintainer-clean-am:  maintainer-clean-noinstLTLIBRARIES \
-		maintainer-clean-compile maintainer-clean-libtool \
-		maintainer-clean-tags maintainer-clean-generic \
-		distclean-am
-	@echo "This command is intended for maintainers to use;"
-	@echo "it deletes files that may require special tools to rebuild."
-
-maintainer-clean: maintainer-clean-recursive
-
-.PHONY: mostlyclean-noinstLTLIBRARIES distclean-noinstLTLIBRARIES \
-clean-noinstLTLIBRARIES maintainer-clean-noinstLTLIBRARIES \
-mostlyclean-compile distclean-compile clean-compile \
-maintainer-clean-compile mostlyclean-libtool distclean-libtool \
-clean-libtool maintainer-clean-libtool install-recursive \
-uninstall-recursive install-data-recursive uninstall-data-recursive \
-install-exec-recursive uninstall-exec-recursive installdirs-recursive \
-uninstalldirs-recursive all-recursive check-recursive \
-installcheck-recursive info-recursive dvi-recursive \
-mostlyclean-recursive distclean-recursive clean-recursive \
-maintainer-clean-recursive tags tags-recursive mostlyclean-tags \
-distclean-tags clean-tags maintainer-clean-tags distdir info-am info \
-dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
-install-exec install-data-am install-data install-am install \
-uninstall-am uninstall all-redirect all-am all install-strip \
-installdirs-am installdirs mostlyclean-generic distclean-generic \
-clean-generic maintainer-clean-generic clean mostlyclean distclean \
-maintainer-clean
-
-
-# *.s are not preprocessed at all.
-.s.o:
-	$(CCAS) $(COMPILE_FLAGS) $<
-.s.obj:
-	$(CCAS) $(COMPILE_FLAGS) `cygpath -w $<`
-.s.lo:
-	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) $<
-
-# *.S are preprocessed with CPP.
-.S.o:
-	$(CPP) $(COMPILE_FLAGS) $< | grep -v '^#' >tmp-$*.s
-	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
-	rm -f tmp-$*.s
-.S.obj:
-	$(CPP) $(COMPILE_FLAGS) `cygpath -w $<` | grep -v '^#' >tmp-$*.s
-	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
-	rm -f tmp-$*.s
-
-# We have to rebuild the static object file without passing -DPIC to
-# preprocessor.  The overhead cost is one extra assemblation.  FIXME:
-# Teach libtool how to assemble with a preprocessor pass (CPP or m4).
-
-.S.lo:
-	$(CPP) $(COMPILE_FLAGS) -DPIC $< | grep -v '^#' >tmp-$*.s
-	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
-	$(CPP) $(COMPILE_FLAGS) $< | grep -v '^#' >tmp-$*.s
-	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $*.o
-	rm -f tmp-$*.s
-
-# *.m4 are preprocessed with m4.
-.asm.o:
-	$(M4) -DOPERATION_$* $< >tmp-$*.s
-	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
-	rm -f tmp-$*.s
-.asm.obj:
-	$(M4) -DOPERATION_$* `cygpath -w $<` >tmp-$*.s
-	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
-	rm -f tmp-$*.s
-.asm.lo:
-	$(M4) -DPIC -DOPERATION_$* $< >tmp-$*.s
-	$(LIBTOOL) --mode=compile $(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $@
-	$(M4) -DOPERATION_$* $< >tmp-$*.s
-	$(CCAS) $(COMPILE_FLAGS) tmp-$*.s -o $*.o
-	rm -f tmp-$*.s
-
-# Tell versions [3.59,3.63) of GNU make to not export all variables.
-# Otherwise a system limit (for SysV at least) may be exceeded.
-.NOEXPORT:
diff --git a/ghc/rts/gmp/mpn/README b/ghc/rts/gmp/mpn/README
deleted file mode 100644
index 7453c9d03e..0000000000
--- a/ghc/rts/gmp/mpn/README
+++ /dev/null
@@ -1,13 +0,0 @@
-This directory contains all code for the mpn layer of GMP.
-
-Most subdirectories contain machine-dependent code, written in assembly or C.
-The `generic' subdirectory contains default code, used when there is no
-machine-dependent replacement for a particular machine.
-
-There is one subdirectory for each ISA family.  Note that e.g., 32-bit SPARC
-and 64-bit SPARC are very different ISA's, and thus cannot share any code.
-
-A particular compile will only use code from one subdirectory, and the
-`generic' subdirectory.  The ISA-specific subdirectories contain hierachies of
-directories for various architecture variants and implementations; the
-top-most level contains code that runs correctly on all variants.
diff --git a/ghc/rts/gmp/mpn/a29k/add_n.s b/ghc/rts/gmp/mpn/a29k/add_n.s
deleted file mode 100644
index e3ee6dfa60..0000000000
--- a/ghc/rts/gmp/mpn/a29k/add_n.s
+++ /dev/null
@@ -1,120 +0,0 @@
-; 29000 __gmpn_add -- Add two limb vectors of the same length > 0 and store
-; sum in a third limb vector.
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	lr2
-; s1_ptr	lr3
-; s2_ptr	lr4
-; size		lr5
-
-; We use the loadm/storem instructions and operate on chunks of 8
-; limbs/per iteration, until less than 8 limbs remain.
-
-; The 29k has no addition or subtraction instructions that doesn't
-; affect carry, so we need to save and restore that as soon as we
-; adjust the pointers.  gr116 is used for this purpose.  Note that
-; gr116==0 means that carry should be set.
-
-	.sect .lit,lit
-	.text
-	.align	4
-	.global	___gmpn_add_n
-	.word	0x60000
-___gmpn_add_n:
-	srl	gr117,lr5,3
-	sub	gr118,gr117,1
-	jmpt	gr118,Ltail
-	 constn	gr116,-1		; init cy reg
-	sub	gr117,gr117,2		; count for jmpfdec
-
-; Main loop working 8 limbs/iteration.
-Loop:	mtsrim	cr,(8-1)
-	loadm	0,0,gr96,lr3
-	add	lr3,lr3,32
-	mtsrim	cr,(8-1)
-	loadm	0,0,gr104,lr4
-	add	lr4,lr4,32
-
-	subr	gr116,gr116,0		; restore carry
-	addc	gr96,gr96,gr104
-	addc	gr97,gr97,gr105
-	addc	gr98,gr98,gr106
-	addc	gr99,gr99,gr107
-	addc	gr100,gr100,gr108
-	addc	gr101,gr101,gr109
-	addc	gr102,gr102,gr110
-	addc	gr103,gr103,gr111
-	subc	gr116,gr116,gr116	; gr116 = not(cy)
-
-	mtsrim	cr,(8-1)
-	storem	0,0,gr96,lr2
-	jmpfdec	gr117,Loop
-	 add	lr2,lr2,32
-
-; Code for the last up-to-7 limbs.
-; This code might look very strange, but it's hard to write it
-; differently without major slowdown.
-
-	and	lr5,lr5,(8-1)
-Ltail:	sub	gr118,lr5,1		; count for CR
-	jmpt	gr118,Lend
-	 sub	gr117,lr5,2		; count for jmpfdec
-
-	mtsr	cr,gr118
-	loadm	0,0,gr96,lr3
-	mtsr	cr,gr118
-	loadm	0,0,gr104,lr4
-
-	subr	gr116,gr116,0		; restore carry
-
-	jmpfdec	gr117,L1
-	 addc	gr96,gr96,gr104
-	jmp	Lstore
-	 mtsr	cr,gr118
-L1:	jmpfdec	gr117,L2
-	 addc	gr97,gr97,gr105
-	jmp	Lstore
-	 mtsr	cr,gr118
-L2:	jmpfdec	gr117,L3
-	 addc	gr98,gr98,gr106
-	jmp	Lstore
-	 mtsr	cr,gr118
-L3:	jmpfdec	gr117,L4
-	 addc	gr99,gr99,gr107
-	jmp	Lstore
-	 mtsr	cr,gr118
-L4:	jmpfdec	gr117,L5
-	 addc	gr100,gr100,gr108
-	jmp	Lstore
-	 mtsr	cr,gr118
-L5:	jmpfdec	gr117,L6
-	 addc	gr101,gr101,gr109
-	jmp	Lstore
-	 mtsr	cr,gr118
-L6:	addc	gr102,gr102,gr110
-
-Lstore:	storem	0,0,gr96,lr2
-	subc	gr116,gr116,gr116	; gr116 = not(cy)
-
-Lend:	jmpi	lr0
-	 add	gr96,gr116,1
diff --git a/ghc/rts/gmp/mpn/a29k/addmul_1.s b/ghc/rts/gmp/mpn/a29k/addmul_1.s
deleted file mode 100644
index f51b6d7af6..0000000000
--- a/ghc/rts/gmp/mpn/a29k/addmul_1.s
+++ /dev/null
@@ -1,113 +0,0 @@
-; 29000 __gmpn_addmul_1 -- Multiply a limb vector with a single limb and
-; add the product to a second limb vector.
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	lr2
-; s1_ptr	lr3
-; size		lr4
-; s2_limb	lr5
-
-	.cputype 29050
-	.sect .lit,lit
-	.text
-	.align	4
-	.global	___gmpn_addmul_1
-	.word	0x60000
-___gmpn_addmul_1:
-	sub	lr4,lr4,8
-	jmpt	lr4,Ltail
-	 const	gr120,0			; init cylimb reg
-
-	srl	gr117,lr4,3		; divide by 8
-	sub	gr117,gr117,1		; count for jmpfdec
-
-Loop:	mtsrim	cr,(8-1)
-	loadm	0,0,gr96,lr3
-	add	lr3,lr3,32
-
-	multiplu gr104,gr96,lr5
-	multmu	 gr96,gr96,lr5
-	multiplu gr105,gr97,lr5
-	multmu	 gr97,gr97,lr5
-	multiplu gr106,gr98,lr5
-	multmu	 gr98,gr98,lr5
-	multiplu gr107,gr99,lr5
-	multmu	 gr99,gr99,lr5
-	multiplu gr108,gr100,lr5
-	multmu	 gr100,gr100,lr5
-	multiplu gr109,gr101,lr5
-	multmu	 gr101,gr101,lr5
-	multiplu gr110,gr102,lr5
-	multmu	 gr102,gr102,lr5
-	multiplu gr111,gr103,lr5
-	multmu	 gr103,gr103,lr5
-
-	add	gr104,gr104,gr120
-	addc	gr105,gr105,gr96
-	addc	gr106,gr106,gr97
-	addc	gr107,gr107,gr98
-	addc	gr108,gr108,gr99
-	addc	gr109,gr109,gr100
-	addc	gr110,gr110,gr101
-	addc	gr111,gr111,gr102
-	addc	gr120,gr103,0
-
-	mtsrim	cr,(8-1)
-	loadm	0,0,gr96,lr2
-
-	add	gr104,gr96,gr104
-	addc	gr105,gr97,gr105
-	addc	gr106,gr98,gr106
-	addc	gr107,gr99,gr107
-	addc	gr108,gr100,gr108
-	addc	gr109,gr101,gr109
-	addc	gr110,gr102,gr110
-	addc	gr111,gr103,gr111
-	addc	gr120,gr120,0
-
-	mtsrim	cr,(8-1)
-	storem	0,0,gr104,lr2
-	jmpfdec	gr117,Loop
-	 add	lr2,lr2,32
-
-Ltail:	and	lr4,lr4,(8-1)
-	sub	gr118,lr4,1		; count for CR
-	jmpt	gr118,Lend
-	 sub	lr4,lr4,2
-	sub	lr2,lr2,4		; offset res_ptr by one limb
-
-Loop2:	load	0,0,gr116,lr3
-	add	lr3,lr3,4
-	multiplu gr117,gr116,lr5
-	multmu	gr118,gr116,lr5
-	add	lr2,lr2,4
-	load	0,0,gr119,lr2
-	add	gr117,gr117,gr120
-	addc	gr118,gr118,0
-	add	gr117,gr117,gr119
-	store	0,0,gr117,lr2
-	jmpfdec	lr4,Loop2
-	 addc	gr120,gr118,0
-
-Lend:	jmpi	lr0
-	 or	gr96,gr120,0		; copy
diff --git a/ghc/rts/gmp/mpn/a29k/lshift.s b/ghc/rts/gmp/mpn/a29k/lshift.s
deleted file mode 100644
index 93e1917127..0000000000
--- a/ghc/rts/gmp/mpn/a29k/lshift.s
+++ /dev/null
@@ -1,93 +0,0 @@
-; 29000 __gmpn_lshift --
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	lr2
-; s1_ptr	lr3
-; s2_ptr	lr4
-; size		lr5
-
-; We use the loadm/storem instructions and operate on chunks of 8
-; limbs/per iteration, until less than 8 limbs remain.
-
-	.sect .lit,lit
-	.text
-	.align	4
-	.global	___gmpn_lshift
-	.word	0x60000
-___gmpn_lshift:
-	sll	gr116,lr4,2
-	add	lr3,gr116,lr3
-	add	lr2,gr116,lr2
-	sub	lr3,lr3,4
-	load	0,0,gr119,lr3
-
-	subr	gr116,lr5,32
-	srl	gr96,gr119,gr116	; return value
-	sub	lr4,lr4,1		; actual loop count is SIZE - 1
-
-	srl	gr117,lr4,3		; chuck count = (actual count) / 8
-	cpeq	gr118,gr117,0
-	jmpt	gr118,Ltail
-	 mtsr	fc,lr5
-
-	sub	gr117,gr117,2		; count for jmpfdec
-
-; Main loop working 8 limbs/iteration.
-Loop:	sub	lr3,lr3,32
-	mtsrim	cr,(8-1)
-	loadm	0,0,gr100,lr3
-
-	extract	gr109,gr119,gr107
-	extract	gr108,gr107,gr106
-	extract	gr107,gr106,gr105
-	extract	gr106,gr105,gr104
-	extract	gr105,gr104,gr103
-	extract	gr104,gr103,gr102
-	extract	gr103,gr102,gr101
-	extract	gr102,gr101,gr100
-
-	sub	lr2,lr2,32
-	mtsrim	cr,(8-1)
-	storem	0,0,gr102,lr2
-	jmpfdec	gr117,Loop
-	 or	gr119,gr100,0
-
-; Code for the last up-to-7 limbs.
-
-	and	lr4,lr4,(8-1)
-Ltail:	cpeq	gr118,lr4,0
-	jmpt	gr118,Lend
-	 sub	lr4,lr4,2		; count for jmpfdec
-
-Loop2:	sub	lr3,lr3,4
-	load	0,0,gr116,lr3
-	extract	gr117,gr119,gr116
-	sub	lr2,lr2,4
-	store	0,0,gr117,lr2
-	jmpfdec	lr4,Loop2
-	 or	gr119,gr116,0
-
-Lend:	extract	gr117,gr119,0
-	sub	lr2,lr2,4
-	jmpi	lr0
-	 store	0,0,gr117,lr2
diff --git a/ghc/rts/gmp/mpn/a29k/mul_1.s b/ghc/rts/gmp/mpn/a29k/mul_1.s
deleted file mode 100644
index 6bcf7ce0cf..0000000000
--- a/ghc/rts/gmp/mpn/a29k/mul_1.s
+++ /dev/null
@@ -1,97 +0,0 @@
-; 29000 __gmpn_mul_1 -- Multiply a limb vector with a single limb and
-; store the product in a second limb vector.
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	lr2
-; s1_ptr	lr3
-; size		lr4
-; s2_limb	lr5
-
-	.cputype 29050
-	.sect .lit,lit
-	.text
-	.align	4
-	.global	___gmpn_mul_1
-	.word	0x60000
-___gmpn_mul_1:
-	sub	lr4,lr4,8
-	jmpt	lr4,Ltail
-	 const	gr120,0			; init cylimb reg
-
-	srl	gr117,lr4,3		; divide by 8
-	sub	gr117,gr117,1		; count for jmpfdec
-
-Loop:	mtsrim	cr,(8-1)
-	loadm	0,0,gr96,lr3
-	add	lr3,lr3,32
-
-	multiplu gr104,gr96,lr5
-	multmu	 gr96,gr96,lr5
-	multiplu gr105,gr97,lr5
-	multmu	 gr97,gr97,lr5
-	multiplu gr106,gr98,lr5
-	multmu	 gr98,gr98,lr5
-	multiplu gr107,gr99,lr5
-	multmu	 gr99,gr99,lr5
-	multiplu gr108,gr100,lr5
-	multmu	 gr100,gr100,lr5
-	multiplu gr109,gr101,lr5
-	multmu	 gr101,gr101,lr5
-	multiplu gr110,gr102,lr5
-	multmu	 gr102,gr102,lr5
-	multiplu gr111,gr103,lr5
-	multmu	 gr103,gr103,lr5
-
-	add	gr104,gr104,gr120
-	addc	gr105,gr105,gr96
-	addc	gr106,gr106,gr97
-	addc	gr107,gr107,gr98
-	addc	gr108,gr108,gr99
-	addc	gr109,gr109,gr100
-	addc	gr110,gr110,gr101
-	addc	gr111,gr111,gr102
-	addc	gr120,gr103,0
-
-	mtsrim	cr,(8-1)
-	storem	0,0,gr104,lr2
-	jmpfdec	gr117,Loop
-	 add	lr2,lr2,32
-
-Ltail:	and	lr4,lr4,(8-1)
-	sub	gr118,lr4,1		; count for CR
-	jmpt	gr118,Lend
-	 sub	lr4,lr4,2
-	sub	lr2,lr2,4		; offset res_ptr by one limb
-
-Loop2:	load	0,0,gr116,lr3
-	add	lr3,lr3,4
-	multiplu gr117,gr116,lr5
-	multmu	gr118,gr116,lr5
-	add	lr2,lr2,4
-	add	gr117,gr117,gr120
-	store	0,0,gr117,lr2
-	jmpfdec	lr4,Loop2
-	 addc	gr120,gr118,0
-
-Lend:	jmpi	lr0
-	 or	gr96,gr120,0		; copy
diff --git a/ghc/rts/gmp/mpn/a29k/rshift.s b/ghc/rts/gmp/mpn/a29k/rshift.s
deleted file mode 100644
index ea163bff2b..0000000000
--- a/ghc/rts/gmp/mpn/a29k/rshift.s
+++ /dev/null
@@ -1,89 +0,0 @@
-; 29000 __gmpn_rshift --
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	lr2
-; s1_ptr	lr3
-; s2_ptr	lr4
-; size		lr5
-
-; We use the loadm/storem instructions and operate on chunks of 8
-; limbs/per iteration, until less than 8 limbs remain.
-
-	.sect .lit,lit
-	.text
-	.align	4
-	.global	___gmpn_rshift
-	.word	0x60000
-___gmpn_rshift:
-	load	0,0,gr119,lr3
-	add	lr3,lr3,4
-
-	subr	gr116,lr5,32
-	sll	gr96,gr119,gr116	; return value
-	sub	lr4,lr4,1		; actual loop count is SIZE - 1
-
-	srl	gr117,lr4,3		; chuck count = (actual count) / 8
-	cpeq	gr118,gr117,0
-	jmpt	gr118,Ltail
-	 mtsr	fc,gr116
-
-	sub	gr117,gr117,2		; count for jmpfdec
-
-; Main loop working 8 limbs/iteration.
-Loop:	mtsrim	cr,(8-1)
-	loadm	0,0,gr100,lr3
-	add	lr3,lr3,32
-
-	extract	gr98,gr100,gr119
-	extract	gr99,gr101,gr100
-	extract	gr100,gr102,gr101
-	extract	gr101,gr103,gr102
-	extract	gr102,gr104,gr103
-	extract	gr103,gr105,gr104
-	extract	gr104,gr106,gr105
-	extract	gr105,gr107,gr106
-
-	mtsrim	cr,(8-1)
-	storem	0,0,gr98,lr2
-	add	lr2,lr2,32
-	jmpfdec	gr117,Loop
-	 or	gr119,gr107,0
-
-; Code for the last up-to-7 limbs.
-
-	and	lr4,lr4,(8-1)
-Ltail:	cpeq	gr118,lr4,0
-	jmpt	gr118,Lend
-	 sub	lr4,lr4,2		; count for jmpfdec
-
-Loop2:	load	0,0,gr100,lr3
-	add	lr3,lr3,4
-	extract	gr117,gr100,gr119
-	store	0,0,gr117,lr2
-	add	lr2,lr2,4
-	jmpfdec	lr4,Loop2
-	 or	gr119,gr100,0
-
-Lend:	srl	gr117,gr119,lr5
-	jmpi	lr0
-	 store	0,0,gr117,lr2
diff --git a/ghc/rts/gmp/mpn/a29k/sub_n.s b/ghc/rts/gmp/mpn/a29k/sub_n.s
deleted file mode 100644
index c6b64c5bee..0000000000
--- a/ghc/rts/gmp/mpn/a29k/sub_n.s
+++ /dev/null
@@ -1,120 +0,0 @@
-; 29000 __gmpn_sub -- Subtract two limb vectors of the same length > 0 and
-; store difference in a third limb vector.
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	lr2
-; s1_ptr	lr3
-; s2_ptr	lr4
-; size		lr5
-
-; We use the loadm/storem instructions and operate on chunks of 8
-; limbs/per iteration, until less than 8 limbs remain.
-
-; The 29k has no addition or subtraction instructions that doesn't
-; affect carry, so we need to save and restore that as soon as we
-; adjust the pointers.  gr116 is used for this purpose.  Note that
-; gr116==0 means that carry should be set.
-
-	.sect .lit,lit
-	.text
-	.align	4
-	.global	___gmpn_sub_n
-	.word	0x60000
-___gmpn_sub_n:
-	srl	gr117,lr5,3
-	sub	gr118,gr117,1
-	jmpt	gr118,Ltail
-	 constn	gr116,-1		; init cy reg
-	sub	gr117,gr117,2		; count for jmpfdec
-
-; Main loop working 8 limbs/iteration.
-Loop:	mtsrim	cr,(8-1)
-	loadm	0,0,gr96,lr3
-	add	lr3,lr3,32
-	mtsrim	cr,(8-1)
-	loadm	0,0,gr104,lr4
-	add	lr4,lr4,32
-
-	subr	gr116,gr116,0		; restore carry
-	subc	gr96,gr96,gr104
-	subc	gr97,gr97,gr105
-	subc	gr98,gr98,gr106
-	subc	gr99,gr99,gr107
-	subc	gr100,gr100,gr108
-	subc	gr101,gr101,gr109
-	subc	gr102,gr102,gr110
-	subc	gr103,gr103,gr111
-	subc	gr116,gr116,gr116	; gr116 = not(cy)
-
-	mtsrim	cr,(8-1)
-	storem	0,0,gr96,lr2
-	jmpfdec	gr117,Loop
-	 add	lr2,lr2,32
-
-; Code for the last up-to-7 limbs.
-; This code might look very strange, but it's hard to write it
-; differently without major slowdown.
-
-	and	lr5,lr5,(8-1)
-Ltail:	sub	gr118,lr5,1		; count for CR
-	jmpt	gr118,Lend
-	 sub	gr117,lr5,2		; count for jmpfdec
-
-	mtsr	cr,gr118
-	loadm	0,0,gr96,lr3
-	mtsr	cr,gr118
-	loadm	0,0,gr104,lr4
-
-	subr	gr116,gr116,0		; restore carry
-
-	jmpfdec	gr117,L1
-	 subc	gr96,gr96,gr104
-	jmp	Lstore
-	 mtsr	cr,gr118
-L1:	jmpfdec	gr117,L2
-	 subc	gr97,gr97,gr105
-	jmp	Lstore
-	 mtsr	cr,gr118
-L2:	jmpfdec	gr117,L3
-	 subc	gr98,gr98,gr106
-	jmp	Lstore
-	 mtsr	cr,gr118
-L3:	jmpfdec	gr117,L4
-	 subc	gr99,gr99,gr107
-	jmp	Lstore
-	 mtsr	cr,gr118
-L4:	jmpfdec	gr117,L5
-	 subc	gr100,gr100,gr108
-	jmp	Lstore
-	 mtsr	cr,gr118
-L5:	jmpfdec	gr117,L6
-	 subc	gr101,gr101,gr109
-	jmp	Lstore
-	 mtsr	cr,gr118
-L6:	subc	gr102,gr102,gr110
-
-Lstore:	storem	0,0,gr96,lr2
-	subc	gr116,gr116,gr116	; gr116 = not(cy)
-
-Lend:	jmpi	lr0
-	 add	gr96,gr116,1
diff --git a/ghc/rts/gmp/mpn/a29k/submul_1.s b/ghc/rts/gmp/mpn/a29k/submul_1.s
deleted file mode 100644
index ef97d8d4e5..0000000000
--- a/ghc/rts/gmp/mpn/a29k/submul_1.s
+++ /dev/null
@@ -1,116 +0,0 @@
-; 29000 __gmpn_submul_1 -- Multiply a limb vector with a single limb and
-; subtract the product from a second limb vector.
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	lr2
-; s1_ptr	lr3
-; size		lr4
-; s2_limb	lr5
-
-	.cputype 29050
-	.sect .lit,lit
-	.text
-	.align	4
-	.global	___gmpn_submul_1
-	.word	0x60000
-___gmpn_submul_1:
-	sub	lr4,lr4,8
-	jmpt	lr4,Ltail
-	 const	gr120,0			; init cylimb reg
-
-	srl	gr117,lr4,3		; divide by 8
-	sub	gr117,gr117,1		; count for jmpfdec
-
-Loop:	mtsrim	cr,(8-1)
-	loadm	0,0,gr96,lr3
-	add	lr3,lr3,32
-
-	multiplu gr104,gr96,lr5
-	multmu	 gr96,gr96,lr5
-	multiplu gr105,gr97,lr5
-	multmu	 gr97,gr97,lr5
-	multiplu gr106,gr98,lr5
-	multmu	 gr98,gr98,lr5
-	multiplu gr107,gr99,lr5
-	multmu	 gr99,gr99,lr5
-	multiplu gr108,gr100,lr5
-	multmu	 gr100,gr100,lr5
-	multiplu gr109,gr101,lr5
-	multmu	 gr101,gr101,lr5
-	multiplu gr110,gr102,lr5
-	multmu	 gr102,gr102,lr5
-	multiplu gr111,gr103,lr5
-	multmu	 gr103,gr103,lr5
-
-	add	gr104,gr104,gr120
-	addc	gr105,gr105,gr96
-	addc	gr106,gr106,gr97
-	addc	gr107,gr107,gr98
-	addc	gr108,gr108,gr99
-	addc	gr109,gr109,gr100
-	addc	gr110,gr110,gr101
-	addc	gr111,gr111,gr102
-	addc	gr120,gr103,0
-
-	mtsrim	cr,(8-1)
-	loadm	0,0,gr96,lr2
-
-	sub	gr96,gr96,gr104
-	subc	gr97,gr97,gr105
-	subc	gr98,gr98,gr106
-	subc	gr99,gr99,gr107
-	subc	gr100,gr100,gr108
-	subc	gr101,gr101,gr109
-	subc	gr102,gr102,gr110
-	subc	gr103,gr103,gr111
-
-	add	gr104,gr103,gr111	; invert carry from previus sub
-	addc	gr120,gr120,0
-
-	mtsrim	cr,(8-1)
-	storem	0,0,gr96,lr2
-	jmpfdec	gr117,Loop
-	 add	lr2,lr2,32
-
-Ltail:	and	lr4,lr4,(8-1)
-	sub	gr118,lr4,1		; count for CR
-	jmpt	gr118,Lend
-	 sub	lr4,lr4,2
-	sub	lr2,lr2,4		; offset res_ptr by one limb
-
-Loop2:	load	0,0,gr116,lr3
-	add	lr3,lr3,4
-	multiplu gr117,gr116,lr5
-	multmu	gr118,gr116,lr5
-	add	lr2,lr2,4
-	load	0,0,gr119,lr2
-	add	gr117,gr117,gr120
-	addc	gr118,gr118,0
-	sub	gr119,gr119,gr117
-	add	gr104,gr119,gr117	; invert carry from previus sub
-	store	0,0,gr119,lr2
-	jmpfdec	lr4,Loop2
-	 addc	gr120,gr118,0
-
-Lend:	jmpi	lr0
-	 or	gr96,gr120,0		; copy
diff --git a/ghc/rts/gmp/mpn/a29k/udiv.s b/ghc/rts/gmp/mpn/a29k/udiv.s
deleted file mode 100644
index fdd53a9a88..0000000000
--- a/ghc/rts/gmp/mpn/a29k/udiv.s
+++ /dev/null
@@ -1,30 +0,0 @@
-; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-	.sect .lit,lit
-	.text
-	.align 4
-	.global ___udiv_qrnnd
-	.word 0x60000
-___udiv_qrnnd:
-	mtsr q,lr3
-	dividu gr96,lr4,lr5
-	mfsr gr116,q
-	jmpi lr0
-	store 0,0,gr116,lr2
diff --git a/ghc/rts/gmp/mpn/a29k/umul.s b/ghc/rts/gmp/mpn/a29k/umul.s
deleted file mode 100644
index 7741981167..0000000000
--- a/ghc/rts/gmp/mpn/a29k/umul.s
+++ /dev/null
@@ -1,29 +0,0 @@
-; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-	.sect .lit,lit
-	.text
-	.align 4
-	.global ___umul_ppmm
-	.word 0x50000
-___umul_ppmm:
-	multiplu gr116,lr3,lr4
-	multmu gr96,lr3,lr4
-	jmpi lr0
-	store 0,0,gr116,lr2
diff --git a/ghc/rts/gmp/mpn/alpha/README b/ghc/rts/gmp/mpn/alpha/README
deleted file mode 100644
index 744260c7c5..0000000000
--- a/ghc/rts/gmp/mpn/alpha/README
+++ /dev/null
@@ -1,224 +0,0 @@
-This directory contains mpn functions optimized for DEC Alpha processors.
-
-ALPHA ASSEMBLY RULES AND REGULATIONS
-
-The `.prologue N' pseudo op marks the end of instruction that needs
-special handling by unwinding.  It also says whether $27 is really
-needed for computing the gp.  The `.mask M' pseudo op says which
-registers are saved on the stack, and at what offset in the frame.
-
-Cray code is very very different...
-
-
-RELEVANT OPTIMIZATION ISSUES
-
-EV4
-
-1. This chip has very limited store bandwidth.  The on-chip L1 cache is
-   write-through, and a cache line is transfered from the store buffer to
-   the off-chip L2 in as much 15 cycles on most systems.  This delay hurts
-   mpn_add_n, mpn_sub_n, mpn_lshift, and mpn_rshift.
-
-2. Pairing is possible between memory instructions and integer arithmetic
-   instructions.
-
-3. mulq and umulh are documented to have a latency of 23 cycles, but 2 of
-   these cycles are pipelined.  Thus, multiply instructions can be issued at
-   a rate of one each 21st cycle.
-
-EV5
-
-1. The memory bandwidth of this chip seems excellent, both for loads and
-   stores.  Even when the working set is larger than the on-chip L1 and L2
-   caches, the performance remain almost unaffected.
-
-2. mulq has a latency of 12 cycles and an issue rate of 1 each 8th cycle.
-   umulh has a measured latency of 14 cycles and an issue rate of 1 each
-   10th cycle.  But the exact timing is somewhat confusing.
-
-3. mpn_add_n.  With 4-fold unrolling, we need 37 instructions, whereof 12
-   are memory operations.  This will take at least
-	ceil(37/2) [dual issue] + 1 [taken branch] = 19 cycles
-   We have 12 memory cycles, plus 4 after-store conflict cycles, or 16 data
-   cache cycles, which should be completely hidden in the 19 issue cycles.
-   The computation is inherently serial, with these dependencies:
-
-	       ldq  ldq
-		 \  /\
-	  (or)   addq |
-	   |\   /   \ |
-	   | addq  cmpult
-	    \  |     |
-	     cmpult  |
-		 \  /
-		  or
-
-   I.e., 3 operations are needed between carry-in and carry-out, making 12
-   cycles the absolute minimum for the 4 limbs.  We could replace the `or'
-   with a cmoveq/cmovne, which could issue one cycle earlier that the `or',
-   but that might waste a cycle on EV4.  The total depth remain unaffected,
-   since cmov has a latency of 2 cycles.
-
-     addq
-     /   \
-   addq  cmpult
-     |      \
-   cmpult -> cmovne
-
-Montgomery has a slightly different way of computing carry that requires one
-less instruction, but has depth 4 (instead of the current 3).  Since the
-code is currently instruction issue bound, Montgomery's idea should save us
-1/2 cycle per limb, or bring us down to a total of 17 cycles or 4.25
-cycles/limb.  Unfortunately, this method will not be good for the EV6.
-
-EV6
-
-Here we have a really parallel pipeline, capable of issuing up to 4 integer
-instructions per cycle.  One integer multiply instruction can issue each
-cycle.  To get optimal speed, we need to pretend we are vectorizing the code,
-i.e., minimize the iterative dependencies.
-
-There are two dependencies to watch out for.  1) Address arithmetic
-dependencies, and 2) carry propagation dependencies.
-
-We can avoid serializing due to address arithmetic by unrolling the loop, so
-that addresses don't depend heavily on an index variable.  Avoiding
-serializing because of carry propagation is trickier; the ultimate performance
-of the code will be determined of the number of latency cycles it takes from
-accepting carry-in to a vector point until we can generate carry-out.
-
-Most integer instructions can execute in either the L0, U0, L1, or U1
-pipelines.  Shifts only execute in U0 and U1, and multiply only in U1.
-
-CMOV instructions split into two internal instructions, CMOV1 and CMOV2, but
-the execute efficiently.  But CMOV split the mapping process (see pg 2-26 in
-cmpwrgd.pdf), suggesting the CMOV should always be placed as the last
-instruction of an aligned 4 instruction block (?).
-
-Perhaps the most important issue is the latency between the L0/U0 and L1/U1
-clusters; a result obtained on either cluster has an extra cycle of latency
-for consumers in the opposite cluster.  Because of the dynamic nature of the
-implementation, it is hard to predict where an instruction will execute.
-
-The shift loops need (per limb):
-    1 load (Lx pipes)
-    1 store (Lx pipes)
-    2 shift (Ux pipes)
-    1 iaddlog (Lx pipes, Ux pipes)
-Obviously, since the pipes are very equally loaded, we should get 4 insn/cycle, or 1.25 cycles/limb.
-
-For mpn_add_n, we currently have
-    2 load (Lx pipes)
-    1 store (Lx pipes)
-    5 iaddlog (Lx pipes, Ux pipes)
-
-Again, we have a perfect balance and will be limited by carry propagation
-delays, currently three cycles.  The superoptimizer indicates that ther
-might be sequences that--using a final cmov--have a carry propagation delay
-of just two.  Montgomery's subtraction sequence could perhaps be used, by
-complementing some operands.  All in all, we should get down to 2 cycles
-without much problems.
-
-For mpn_mul_1, we could do, just like for mpn_add_n:
-    not		newlo,notnewlo
-    addq	cylimb,newlo,newlo  ||    cmpult	cylimb,notnewlo,cyout
-    addq	cyout,newhi,cylimb
-and get 2-cycle carry propagation.  The instructions needed will be
-    1 ld (Lx pipes)
-    1 st (Lx pipes)
-    2 mul (U1 pipe)
-    4 iaddlog (Lx pipes, Ux pipes)
-issue1: addq not mul ld
-issue2: cmpult addq mul st
-Conclusion: no cluster delays and 2-cycle carry delays will give us 2 cycles/limb!
-
-Last, we have mpn_addmul_1.  Almost certainly, we will get down to 3
-cycles/limb, which would be absolutely awesome.
-
-Old, perhaps obsolete addmul_1 dependency diagram (needs 175 columns wide screen):
-
-   i  
-   s
-   s  i
-   u  n
-   e  s
-   d  t
-      r
-   i  u
-l  n  c
-i  s  t
-v  t  i
-e  r  o
-   u  n
-v  c	
-a  t  t
-l  i  y
-u  o  p
-e  n  e
-s  s  s
-        issue
-         in
-        cycle
-         -1     ldq
-               /    \
-          0   |      \
-              |       \
-          1   |        |
-              |        |
-          2   |        |                   ldq
-              |        |                  /    \
-          3   |       mulq               |      \
-              |           \              |       \
-          4  umulh         \             |        |
-               |            |            |        |
-          5    |            |            |        |                   ldq
-               |            |            |        |                  /    \
-    4calm 6    |            |   ldq      |       mulq               |      \
-               |            |  /         |           \              |       \
-    4casm 7    |            | /         umulh         \             |        |
-6              |            ||            |            |            |        |
-    3aal  8    |            ||            |            |            |        |                   ldq
-7              |            ||            |            |            |        |                  /    \
-    4calm 9    |            ||            |            |   ldq      |       mulq               |      \
-9              |            ||            |            |  /         |           \              |       \
-    4casm 10   |            ||            |            | /         umulh         \             |        |
-9              |            ||            |            ||            |            |            |        |
-    3aal  11   |           addq           |            ||            |            |            |        |                   ldq
-9              |          //   \          |            ||            |            |            |        |                  /    \
-    4calm 12    \     cmpult    addq<-cy  |            ||            |            |   ldq      |       mulq               |      \
-13               \    /       //   \      |            ||            |            |  /         |           \              |       \
-    4casm 13      addq   cmpult     stq   |            ||            |            | /         umulh         \             |        |
-11                    \  /                |            ||            |            ||            |            |            |        |
-    3aal  14          addq                |           addq           |            ||            |            |            |        |                   ldq
-10                        \               |          //   \          |            ||            |            |            |        |                  /    \
-    4calm 15                cy ---->       \     cmpult    addq<-cy  |            ||            |            |   ldq      |       mulq               |      \
-13                                          \    /       //   \      |            ||            |            |  /         |           \              |       \
-    4casm 16                                 addq   cmpult     stq   |            ||            |            | /         umulh         \             |        |
-11                                               \  /                |            ||            |            ||            |            |            |        |
-    3aal  17                                     addq                |           addq           |            ||            |            |            |        |
-10                                                   \               |          //   \          |            ||            |            |            |        |
-    4calm 18                                           cy ---->       \     cmpult    addq<-cy  |            ||            |            |   ldq      |       mulq
-13                                                                     \    /       //   \      |            ||            |            |  /         |           \
-    4casm 19                                                            addq   cmpult     stq   |            ||            |            | /         umulh         \
-11                                                                          \  /                |            ||            |            ||            |            |
-    3aal  20                                                                addq                |           addq           |            ||            |            |
-10                                                                              \               |          //   \          |            ||            |            |
-    4calm 21                                                                      cy ---->       \     cmpult    addq<-cy  |            ||            |            |   ldq
-                                                                                                  \    /       //   \      |            ||            |            |  /
-          22                                                                                       addq   cmpult     stq   |            ||            |            | /
-                                                                                                       \  /                |            ||            |            ||
-          23                                                                                           addq                |           addq           |            ||
-                                                                                                           \               |          //   \          |            ||
-          24                                                                                                 cy ---->       \     cmpult    addq<-cy  |            ||
-                                                                                                                             \    /       //   \      |            ||
-          25                                                                                                                  addq   cmpult     stq   |            ||
-                                                                                                                                  \  /                |            ||
-          26                                                                                                                      addq                |           addq
-                                                                                                                                      \               |          //   \
-          27                                                                                                                            cy ---->       \     cmpult    addq<-cy
-                                                                                                                                                        \    /       //   \
-          28                                                                                                                                             addq   cmpult     stq
-                                                                                                                                                             \  /
-As many as 6 consecutive points will be under execution simultaneously, or if we                                                                             addq
-schedule loads even further away, maybe 7 or 8.  But the number of live quantities                                                                               \
-is reasonable, and can easily be satisfied.                                                                                                                        cy ---->    
diff --git a/ghc/rts/gmp/mpn/alpha/add_n.asm b/ghc/rts/gmp/mpn/alpha/add_n.asm
deleted file mode 100644
index 08d6a9f7b8..0000000000
--- a/ghc/rts/gmp/mpn/alpha/add_n.asm
+++ /dev/null
@@ -1,114 +0,0 @@
-dnl  Alpha mpn_add_n -- Add two limb vectors of the same length > 0 and
-dnl  store sum in a third limb vector.
-
-dnl  Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  INPUT PARAMETERS
-dnl  res_ptr	r16
-dnl  s1_ptr	r17
-dnl  s2_ptr	r18
-dnl  size	r19
-
-ASM_START()
-PROLOGUE(mpn_add_n)
-	ldq	r3,0(r17)
-	ldq	r4,0(r18)
-
-	subq	r19,1,r19
-	and	r19,4-1,r2	C number of limbs in first loop
-	bis	r31,r31,r0
-	beq	r2,$L0		C if multiple of 4 limbs, skip first loop
-
-	subq	r19,r2,r19
-
-$Loop0:	subq	r2,1,r2
-	ldq	r5,8(r17)
-	addq	r4,r0,r4
-	ldq	r6,8(r18)
-	cmpult	r4,r0,r1
-	addq	r3,r4,r4
-	cmpult	r4,r3,r0
-	stq	r4,0(r16)
-	bis	r0,r1,r0
-
-	addq	r17,8,r17
-	addq	r18,8,r18
-	bis	r5,r5,r3
-	bis	r6,r6,r4
-	addq	r16,8,r16
-	bne	r2,$Loop0
-
-$L0:	beq	r19,$Lend
-
-	ALIGN(8)
-$Loop:	subq	r19,4,r19
-
-	ldq	r5,8(r17)
-	addq	r4,r0,r4
-	ldq	r6,8(r18)
-	cmpult	r4,r0,r1
-	addq	r3,r4,r4
-	cmpult	r4,r3,r0
-	stq	r4,0(r16)
-	bis	r0,r1,r0
-
-	ldq	r3,16(r17)
-	addq	r6,r0,r6
-	ldq	r4,16(r18)
-	cmpult	r6,r0,r1
-	addq	r5,r6,r6
-	cmpult	r6,r5,r0
-	stq	r6,8(r16)
-	bis	r0,r1,r0
-
-	ldq	r5,24(r17)
-	addq	r4,r0,r4
-	ldq	r6,24(r18)
-	cmpult	r4,r0,r1
-	addq	r3,r4,r4
-	cmpult	r4,r3,r0
-	stq	r4,16(r16)
-	bis	r0,r1,r0
-
-	ldq	r3,32(r17)
-	addq	r6,r0,r6
-	ldq	r4,32(r18)
-	cmpult	r6,r0,r1
-	addq	r5,r6,r6
-	cmpult	r6,r5,r0
-	stq	r6,24(r16)
-	bis	r0,r1,r0
-
-	addq	r17,32,r17
-	addq	r18,32,r18
-	addq	r16,32,r16
-	bne	r19,$Loop
-
-$Lend:	addq	r4,r0,r4
-	cmpult	r4,r0,r1
-	addq	r3,r4,r4
-	cmpult	r4,r3,r0
-	stq	r4,0(r16)
-	bis	r0,r1,r0
-	ret	r31,(r26),1
-EPILOGUE(mpn_add_n)
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/addmul_1.asm b/ghc/rts/gmp/mpn/alpha/addmul_1.asm
deleted file mode 100644
index 4ea900be6b..0000000000
--- a/ghc/rts/gmp/mpn/alpha/addmul_1.asm
+++ /dev/null
@@ -1,87 +0,0 @@
-dnl Alpha __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
-dnl the result to a second limb vector.
-
-dnl  Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  INPUT PARAMETERS
-dnl  res_ptr	r16
-dnl  s1_ptr	r17
-dnl  size	r18
-dnl  s2_limb	r19
-
-dnl  This code runs at 42 cycles/limb on EV4, 18 cycles/limb on EV5, and 7
-dnl  cycles/limb on EV6.
-
-ASM_START()
-PROLOGUE(mpn_addmul_1)
-	ldq	r2,0(r17)	C r2 = s1_limb
-	addq	r17,8,r17	C s1_ptr++
-	subq	r18,1,r18	C size--
-	mulq	r2,r19,r3	C r3 = prod_low
-	ldq	r5,0(r16)	C r5 = *res_ptr
-	umulh	r2,r19,r0	C r0 = prod_high
-	beq	r18,$Lend1	C jump if size was == 1
-	ldq	r2,0(r17)	C r2 = s1_limb
-	addq	r17,8,r17	C s1_ptr++
-	subq	r18,1,r18	C size--
-	addq	r5,r3,r3
-	cmpult	r3,r5,r4
-	stq	r3,0(r16)
-	addq	r16,8,r16	C res_ptr++
-	beq	r18,$Lend2	C jump if size was == 2
-
-	ALIGN(8)
-$Loop:	mulq	r2,r19,r3	C r3 = prod_low
-	ldq	r5,0(r16)	C r5 = *res_ptr
-	addq	r4,r0,r0	C cy_limb = cy_limb + 'cy'
-	subq	r18,1,r18	C size--
-	umulh	r2,r19,r4	C r4 = cy_limb
-	ldq	r2,0(r17)	C r2 = s1_limb
-	addq	r17,8,r17	C s1_ptr++
-	addq	r3,r0,r3	C r3 = cy_limb + prod_low
-	cmpult	r3,r0,r0	C r0 = carry from (cy_limb + prod_low)
-	addq	r5,r3,r3
-	cmpult	r3,r5,r5
-	stq	r3,0(r16)
-	addq	r16,8,r16	C res_ptr++
-	addq	r5,r0,r0	C combine carries
-	bne	r18,$Loop
-
-$Lend2:	mulq	r2,r19,r3	C r3 = prod_low
-	ldq	r5,0(r16)	C r5 = *res_ptr
-	addq	r4,r0,r0	C cy_limb = cy_limb + 'cy'
-	umulh	r2,r19,r4	C r4 = cy_limb
-	addq	r3,r0,r3	C r3 = cy_limb + prod_low
-	cmpult	r3,r0,r0	C r0 = carry from (cy_limb + prod_low)
-	addq	r5,r3,r3
-	cmpult	r3,r5,r5
-	stq	r3,0(r16)
-	addq	r5,r0,r0	C combine carries
-	addq	r4,r0,r0	C cy_limb = prod_high + cy
-	ret	r31,(r26),1
-$Lend1:	addq	r5,r3,r3
-	cmpult	r3,r5,r5
-	stq	r3,0(r16)
-	addq	r0,r5,r0
-	ret	r31,(r26),1
-EPILOGUE(mpn_addmul_1)
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/cntlz.asm b/ghc/rts/gmp/mpn/alpha/cntlz.asm
deleted file mode 100644
index febb3b70d9..0000000000
--- a/ghc/rts/gmp/mpn/alpha/cntlz.asm
+++ /dev/null
@@ -1,68 +0,0 @@
-dnl  Alpha auxiliary for longlong.h's count_leading_zeros
-
-dnl  Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  DISCUSSION:
-
-dnl  Other methods have been tried, and using a 128-entry table actually trims
-dnl  about 10% of the execution time (on a 21164) when the table is in the L1
-dnl  cache.  But under non-benchmarking conditions, the table will hardly be in
-dnl  the L1 cache.  Tricky bit-fiddling methods with multiplies and magic tables
-dnl  are also possible, but they require many more instructions than the current
-dnl  code.  (But for count_trailing_zeros, such tricks are beneficial.)
-dnl  Finally, converting to floating-point and extracting the exponent is much
-dnl  slower.
-
-ASM_START()
-PROLOGUE(MPN(count_leading_zeros))
-	bis	r31,63,r0		C initialize partial result count
-
-	srl	r16,32,r1		C shift down 32 steps -> r1
-	cmovne	r1,r1,r16		C select r1 if non-zero
-	cmovne	r1,31,r0		C if r1 is nonzero choose smaller count
-
-	srl	r16,16,r1		C shift down 16 steps -> r1
-	subq	r0,16,r2		C generate new partial result count
-	cmovne	r1,r1,r16		C choose new r1 if non-zero
-	cmovne	r1,r2,r0		C choose new count if r1 was non-zero
-
-	srl	r16,8,r1
-	subq	r0,8,r2
-	cmovne	r1,r1,r16
-	cmovne	r1,r2,r0
-
-	srl	r16,4,r1
-	subq	r0,4,r2
-	cmovne	r1,r1,r16
-	cmovne	r1,r2,r0
-
-	srl	r16,2,r1
-	subq	r0,2,r2
-	cmovne	r1,r1,r16
-	cmovne	r1,r2,r0
-
-	srl	r16,1,r1		C extract bit 1
-	subq	r0,r1,r0		C subtract it from partial result
-
-	ret	r31,(r26),1
-EPILOGUE(MPN(count_leading_zeros))
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/default.m4 b/ghc/rts/gmp/mpn/alpha/default.m4
deleted file mode 100644
index 5f4c48dc73..0000000000
--- a/ghc/rts/gmp/mpn/alpha/default.m4
+++ /dev/null
@@ -1,77 +0,0 @@
-divert(-1)
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-define(`ASM_START',
-	`
-	.set noreorder
-	.set noat')
-
-define(`X',`0x$1')
-define(`FLOAT64',
-	`
-	.align	3
-$1:	.t_floating $2')
-
-define(`PROLOGUE',
-	`
-	.text
-	.align	3
-	.globl	$1
-	.ent	$1
-$1:
-	.frame r30,0,r26
-	.prologue 0')
-
-define(`PROLOGUE_GP',
-	`
-	.text
-	.align	3
-	.globl	$1
-	.ent	$1
-$1:
-	ldgp	r29,0(r27)
-	.frame	r30,0,r26
-	.prologue 1')
-
-define(`EPILOGUE',
-	`
-	.end	$1')
-
-dnl Map register names r0, r1, etc, to `$0', `$1', etc.
-dnl This is needed on all systems but Unicos
-forloop(i,0,31,
-`define(`r'i,``$''i)'
-)
-forloop(i,0,31,
-`define(`f'i,``$f''i)'
-)
-
-define(`DATASTART',
-	`dnl
-	DATA
-$1:')
-define(`DATAEND',`dnl')
-
-define(`ASM_END',`dnl')
-
-divert
diff --git a/ghc/rts/gmp/mpn/alpha/ev5/add_n.asm b/ghc/rts/gmp/mpn/alpha/ev5/add_n.asm
deleted file mode 100644
index 716d6404ae..0000000000
--- a/ghc/rts/gmp/mpn/alpha/ev5/add_n.asm
+++ /dev/null
@@ -1,143 +0,0 @@
-dnl  Alpha EV5 __gmpn_add_n -- Add two limb vectors of the same length > 0 and
-dnl  store sum in a third limb vector.
-
-dnl  Copyright (C) 1995, 1999, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  INPUT PARAMETERS
-dnl  res_ptr	r16
-dnl  s1_ptr	r17
-dnl  s2_ptr	r18
-dnl  size	r19
-
-ASM_START()
-PROLOGUE(mpn_add_n)
-	bis	r31,r31,r25		C clear cy
-	subq	r19,4,r19		C decr loop cnt
-	blt	r19,$Lend2		C if less than 4 limbs, goto 2nd loop
-C Start software pipeline for 1st loop
-	ldq	r0,0(r18)
-	ldq	r4,0(r17)
-	ldq	r1,8(r18)
-	ldq	r5,8(r17)
-	addq	r17,32,r17		C update s1_ptr
-	ldq	r2,16(r18)
-	addq	r0,r4,r20		C 1st main add
-	ldq	r3,24(r18)
-	subq	r19,4,r19		C decr loop cnt
-	ldq	r6,-16(r17)
-	cmpult	r20,r0,r25		C compute cy from last add
-	ldq	r7,-8(r17)
-	addq	r1,r5,r28		C 2nd main add
-	addq	r18,32,r18		C update s2_ptr
-	addq	r28,r25,r21		C 2nd carry add
-	cmpult	r28,r5,r8		C compute cy from last add
-	blt	r19,$Lend1		C if less than 4 limbs remain, jump
-C 1st loop handles groups of 4 limbs in a software pipeline
-	ALIGN(16)
-$Loop:	cmpult	r21,r28,r25		C compute cy from last add
-	ldq	r0,0(r18)
-	bis	r8,r25,r25		C combine cy from the two adds
-	ldq	r1,8(r18)
-	addq	r2,r6,r28		C 3rd main add
-	ldq	r4,0(r17)
-	addq	r28,r25,r22		C 3rd carry add
-	ldq	r5,8(r17)
-	cmpult	r28,r6,r8		C compute cy from last add
-	cmpult	r22,r28,r25		C compute cy from last add
-	stq	r20,0(r16)
-	bis	r8,r25,r25		C combine cy from the two adds
-	stq	r21,8(r16)
-	addq	r3,r7,r28		C 4th main add
-	addq	r28,r25,r23		C 4th carry add
-	cmpult	r28,r7,r8		C compute cy from last add
-	cmpult	r23,r28,r25		C compute cy from last add
-		addq	r17,32,r17		C update s1_ptr
-	bis	r8,r25,r25		C combine cy from the two adds
-		addq	r16,32,r16		C update res_ptr
-	addq	r0,r4,r28		C 1st main add
-	ldq	r2,16(r18)
-	addq	r25,r28,r20		C 1st carry add
-	ldq	r3,24(r18)
-	cmpult	r28,r4,r8		C compute cy from last add
-	ldq	r6,-16(r17)
-	cmpult	r20,r28,r25		C compute cy from last add
-	ldq	r7,-8(r17)
-	bis	r8,r25,r25		C combine cy from the two adds
-	subq	r19,4,r19		C decr loop cnt
-	stq	r22,-16(r16)
-	addq	r1,r5,r28		C 2nd main add
-	stq	r23,-8(r16)
-	addq	r25,r28,r21		C 2nd carry add
-		addq	r18,32,r18		C update s2_ptr
-	cmpult	r28,r5,r8		C compute cy from last add
-	bge	r19,$Loop
-C Finish software pipeline for 1st loop
-$Lend1:	cmpult	r21,r28,r25		C compute cy from last add
-	bis	r8,r25,r25		C combine cy from the two adds
-	addq	r2,r6,r28		C 3rd main add
-	addq	r28,r25,r22		C 3rd carry add
-	cmpult	r28,r6,r8		C compute cy from last add
-	cmpult	r22,r28,r25		C compute cy from last add
-	stq	r20,0(r16)
-	bis	r8,r25,r25		C combine cy from the two adds
-	stq	r21,8(r16)
-	addq	r3,r7,r28		C 4th main add
-	addq	r28,r25,r23		C 4th carry add
-	cmpult	r28,r7,r8		C compute cy from last add
-	cmpult	r23,r28,r25		C compute cy from last add
-	bis	r8,r25,r25		C combine cy from the two adds
-	addq	r16,32,r16		C update res_ptr
-	stq	r22,-16(r16)
-	stq	r23,-8(r16)
-$Lend2:	addq	r19,4,r19		C restore loop cnt
-	beq	r19,$Lret
-C Start software pipeline for 2nd loop
-	ldq	r0,0(r18)
-	ldq	r4,0(r17)
-	subq	r19,1,r19
-	beq	r19,$Lend0
-C 2nd loop handles remaining 1-3 limbs
-	ALIGN(16)
-$Loop0:	addq	r0,r4,r28		C main add
-	ldq	r0,8(r18)
-	cmpult	r28,r4,r8		C compute cy from last add
-	ldq	r4,8(r17)
-	addq	r28,r25,r20		C carry add
-	addq	r18,8,r18
-	addq	r17,8,r17
-	stq	r20,0(r16)
-	cmpult	r20,r28,r25		C compute cy from last add
-	subq	r19,1,r19		C decr loop cnt
-	bis	r8,r25,r25		C combine cy from the two adds
-	addq	r16,8,r16
-	bne	r19,$Loop0
-$Lend0:	addq	r0,r4,r28		C main add
-	addq	r28,r25,r20		C carry add
-	cmpult	r28,r4,r8		C compute cy from last add
-	cmpult	r20,r28,r25		C compute cy from last add
-	stq	r20,0(r16)
-	bis	r8,r25,r25		C combine cy from the two adds
-
-$Lret:	bis	r25,r31,r0		C return cy
-	ret	r31,(r26),1
-EPILOGUE(mpn_add_n)
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/ev5/lshift.asm b/ghc/rts/gmp/mpn/alpha/ev5/lshift.asm
deleted file mode 100644
index cb181dda66..0000000000
--- a/ghc/rts/gmp/mpn/alpha/ev5/lshift.asm
+++ /dev/null
@@ -1,169 +0,0 @@
-dnl  Alpha EV5 __gmpn_lshift -- Shift a number left.
-
-dnl  Copyright (C) 1994, 1995, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  INPUT PARAMETERS
-dnl  res_ptr	r16
-dnl  s1_ptr	r17
-dnl  size	r18
-dnl  cnt	r19
-
-dnl  This code runs at 3.25 cycles/limb on the EV5.
-
-ASM_START()
-PROLOGUE(mpn_lshift)
-	s8addq	r18,r17,r17	C make r17 point at end of s1
-	ldq	r4,-8(r17)	C load first limb
-	subq	r31,r19,r20
-	s8addq	r18,r16,r16	C make r16 point at end of RES
-	subq	r18,1,r18
-	and	r18,4-1,r28	C number of limbs in first loop
-	srl	r4,r20,r0	C compute function result
-
-	beq	r28,$L0
-	subq	r18,r28,r18
-
-	ALIGN(8)
-$Loop0:	ldq	r3,-16(r17)
-	subq	r16,8,r16
-	sll	r4,r19,r5
-	subq	r17,8,r17
-	subq	r28,1,r28
-	srl	r3,r20,r6
-	bis	r3,r3,r4
-	bis	r5,r6,r8
-	stq	r8,0(r16)
-	bne	r28,$Loop0
-
-$L0:	sll	r4,r19,r24
-	beq	r18,$Lend
-C warm up phase 1
-	ldq	r1,-16(r17)
-	subq	r18,4,r18
-	ldq	r2,-24(r17)
-	ldq	r3,-32(r17)
-	ldq	r4,-40(r17)
-	beq	r18,$Lend1
-C warm up phase 2
-	srl	r1,r20,r7
-	sll	r1,r19,r21
-	srl	r2,r20,r8
-	ldq	r1,-48(r17)
-	sll	r2,r19,r22
-	ldq	r2,-56(r17)
-	srl	r3,r20,r5
-	bis	r7,r24,r7
-	sll	r3,r19,r23
-	bis	r8,r21,r8
-	srl	r4,r20,r6
-	ldq	r3,-64(r17)
-	sll	r4,r19,r24
-	ldq	r4,-72(r17)
-	subq	r18,4,r18
-	beq	r18,$Lend2
-	ALIGN(16)
-C main loop
-$Loop:	stq	r7,-8(r16)
-	bis	r5,r22,r5
-	stq	r8,-16(r16)
-	bis	r6,r23,r6
-
-	srl	r1,r20,r7
-	subq	r18,4,r18
-	sll	r1,r19,r21
-	unop	C ldq	r31,-96(r17)
-
-	srl	r2,r20,r8
-	ldq	r1,-80(r17)
-	sll	r2,r19,r22
-	ldq	r2,-88(r17)
-
-	stq	r5,-24(r16)
-	bis	r7,r24,r7
-	stq	r6,-32(r16)
-	bis	r8,r21,r8
-
-	srl	r3,r20,r5
-	unop	C ldq	r31,-96(r17)
-	sll	r3,r19,r23
-	subq	r16,32,r16
-
-	srl	r4,r20,r6
-	ldq	r3,-96(r17)
-	sll	r4,r19,r24
-	ldq	r4,-104(r17)
-
-	subq	r17,32,r17
-	bne	r18,$Loop
-C cool down phase 2/1
-$Lend2:	stq	r7,-8(r16)
-	bis	r5,r22,r5
-	stq	r8,-16(r16)
-	bis	r6,r23,r6
-	srl	r1,r20,r7
-	sll	r1,r19,r21
-	srl	r2,r20,r8
-	sll	r2,r19,r22
-	stq	r5,-24(r16)
-	bis	r7,r24,r7
-	stq	r6,-32(r16)
-	bis	r8,r21,r8
-	srl	r3,r20,r5
-	sll	r3,r19,r23
-	srl	r4,r20,r6
-	sll	r4,r19,r24
-C cool down phase 2/2
-	stq	r7,-40(r16)
-	bis	r5,r22,r5
-	stq	r8,-48(r16)
-	bis	r6,r23,r6
-	stq	r5,-56(r16)
-	stq	r6,-64(r16)
-C cool down phase 2/3
-	stq	r24,-72(r16)
-	ret	r31,(r26),1
-
-C cool down phase 1/1
-$Lend1:	srl	r1,r20,r7
-	sll	r1,r19,r21
-	srl	r2,r20,r8
-	sll	r2,r19,r22
-	srl	r3,r20,r5
-	bis	r7,r24,r7
-	sll	r3,r19,r23
-	bis	r8,r21,r8
-	srl	r4,r20,r6
-	sll	r4,r19,r24
-C cool down phase 1/2
-	stq	r7,-8(r16)
-	bis	r5,r22,r5
-	stq	r8,-16(r16)
-	bis	r6,r23,r6
-	stq	r5,-24(r16)
-	stq	r6,-32(r16)
-	stq	r24,-40(r16)
-	ret	r31,(r26),1
-
-$Lend:	stq	r24,-8(r16)
-	ret	r31,(r26),1
-EPILOGUE(mpn_lshift)
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/ev5/rshift.asm b/ghc/rts/gmp/mpn/alpha/ev5/rshift.asm
deleted file mode 100644
index 9940d83fad..0000000000
--- a/ghc/rts/gmp/mpn/alpha/ev5/rshift.asm
+++ /dev/null
@@ -1,167 +0,0 @@
-dnl  Alpha EV5 __gmpn_rshift -- Shift a number right.
-
-dnl  Copyright (C) 1994, 1995, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  INPUT PARAMETERS
-dnl  res_ptr	r16
-dnl  s1_ptr	r17
-dnl  size	r18
-dnl  cnt	r19
-
-dnl  This code runs at 3.25 cycles/limb on the EV5.
-
-ASM_START()
-PROLOGUE(mpn_rshift)
-	ldq	r4,0(r17)	C load first limb
-	subq	r31,r19,r20
-	subq	r18,1,r18
-	and	r18,4-1,r28	C number of limbs in first loop
-	sll	r4,r20,r0	C compute function result
-
-	beq	r28,$L0
-	subq	r18,r28,r18
-
-	ALIGN(8)
-$Loop0:	ldq	r3,8(r17)
-	addq	r16,8,r16
-	srl	r4,r19,r5
-	addq	r17,8,r17
-	subq	r28,1,r28
-	sll	r3,r20,r6
-	bis	r3,r3,r4
-	bis	r5,r6,r8
-	stq	r8,-8(r16)
-	bne	r28,$Loop0
-
-$L0:	srl	r4,r19,r24
-	beq	r18,$Lend
-C warm up phase 1
-	ldq	r1,8(r17)
-	subq	r18,4,r18
-	ldq	r2,16(r17)
-	ldq	r3,24(r17)
-	ldq	r4,32(r17)
-	beq	r18,$Lend1
-C warm up phase 2
-	sll	r1,r20,r7
-	srl	r1,r19,r21
-	sll	r2,r20,r8
-	ldq	r1,40(r17)
-	srl	r2,r19,r22
-	ldq	r2,48(r17)
-	sll	r3,r20,r5
-	bis	r7,r24,r7
-	srl	r3,r19,r23
-	bis	r8,r21,r8
-	sll	r4,r20,r6
-	ldq	r3,56(r17)
-	srl	r4,r19,r24
-	ldq	r4,64(r17)
-	subq	r18,4,r18
-	beq	r18,$Lend2
-	ALIGN(16)
-C main loop
-$Loop:	stq	r7,0(r16)
-	bis	r5,r22,r5
-	stq	r8,8(r16)
-	bis	r6,r23,r6
-
-	sll	r1,r20,r7
-	subq	r18,4,r18
-	srl	r1,r19,r21
-	unop	C ldq	r31,-96(r17)
-
-	sll	r2,r20,r8
-	ldq	r1,72(r17)
-	srl	r2,r19,r22
-	ldq	r2,80(r17)
-
-	stq	r5,16(r16)
-	bis	r7,r24,r7
-	stq	r6,24(r16)
-	bis	r8,r21,r8
-
-	sll	r3,r20,r5
-	unop	C ldq	r31,-96(r17)
-	srl	r3,r19,r23
-	addq	r16,32,r16
-
-	sll	r4,r20,r6
-	ldq	r3,88(r17)
-	srl	r4,r19,r24
-	ldq	r4,96(r17)
-
-	addq	r17,32,r17
-	bne	r18,$Loop
-C cool down phase 2/1
-$Lend2:	stq	r7,0(r16)
-	bis	r5,r22,r5
-	stq	r8,8(r16)
-	bis	r6,r23,r6
-	sll	r1,r20,r7
-	srl	r1,r19,r21
-	sll	r2,r20,r8
-	srl	r2,r19,r22
-	stq	r5,16(r16)
-	bis	r7,r24,r7
-	stq	r6,24(r16)
-	bis	r8,r21,r8
-	sll	r3,r20,r5
-	srl	r3,r19,r23
-	sll	r4,r20,r6
-	srl	r4,r19,r24
-C cool down phase 2/2
-	stq	r7,32(r16)
-	bis	r5,r22,r5
-	stq	r8,40(r16)
-	bis	r6,r23,r6
-	stq	r5,48(r16)
-	stq	r6,56(r16)
-C cool down phase 2/3
-	stq	r24,64(r16)
-	ret	r31,(r26),1
-
-C cool down phase 1/1
-$Lend1:	sll	r1,r20,r7
-	srl	r1,r19,r21
-	sll	r2,r20,r8
-	srl	r2,r19,r22
-	sll	r3,r20,r5
-	bis	r7,r24,r7
-	srl	r3,r19,r23
-	bis	r8,r21,r8
-	sll	r4,r20,r6
-	srl	r4,r19,r24
-C cool down phase 1/2
-	stq	r7,0(r16)
-	bis	r5,r22,r5
-	stq	r8,8(r16)
-	bis	r6,r23,r6
-	stq	r5,16(r16)
-	stq	r6,24(r16)
-	stq	r24,32(r16)
-	ret	r31,(r26),1
-
-$Lend:	stq	r24,0(r16)
-	ret	r31,(r26),1
-EPILOGUE(mpn_rshift)
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/ev5/sub_n.asm b/ghc/rts/gmp/mpn/alpha/ev5/sub_n.asm
deleted file mode 100644
index 5248a2aa38..0000000000
--- a/ghc/rts/gmp/mpn/alpha/ev5/sub_n.asm
+++ /dev/null
@@ -1,143 +0,0 @@
-dnl  Alpha EV5 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0
-dnl  and store difference in a third limb vector.
-
-dnl  Copyright (C) 1995, 1999, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  INPUT PARAMETERS
-dnl  res_ptr	r16
-dnl  s1_ptr	r17
-dnl  s2_ptr	r18
-dnl  size	r19
-
-ASM_START()
-PROLOGUE(mpn_sub_n)
-	bis	r31,r31,r25		C clear cy
-	subq	r19,4,r19		C decr loop cnt
-	blt	r19,$Lend2		C if less than 4 limbs, goto 2nd loop
-C Start software pipeline for 1st loop
-	ldq	r0,0(r18)
-	ldq	r4,0(r17)
-	ldq	r1,8(r18)
-	ldq	r5,8(r17)
-	addq	r17,32,r17		C update s1_ptr
-	ldq	r2,16(r18)
-	subq	r4,r0,r20		C 1st main subtract
-	ldq	r3,24(r18)
-	subq	r19,4,r19		C decr loop cnt
-	ldq	r6,-16(r17)
-	cmpult	r4,r0,r25		C compute cy from last subtract
-	ldq	r7,-8(r17)
-	subq	r5,r1,r28		C 2nd main subtract
-	addq	r18,32,r18		C update s2_ptr
-	subq	r28,r25,r21		C 2nd carry subtract
-	cmpult	r5,r1,r8		C compute cy from last subtract
-	blt	r19,$Lend1		C if less than 4 limbs remain, jump
-C 1st loop handles groups of 4 limbs in a software pipeline
-	ALIGN(16)
-$Loop:	cmpult	r28,r25,r25		C compute cy from last subtract
-	ldq	r0,0(r18)
-	bis	r8,r25,r25		C combine cy from the two subtracts
-	ldq	r1,8(r18)
-	subq	r6,r2,r28		C 3rd main subtract
-	ldq	r4,0(r17)
-	subq	r28,r25,r22		C 3rd carry subtract
-	ldq	r5,8(r17)
-	cmpult	r6,r2,r8		C compute cy from last subtract
-	cmpult	r28,r25,r25		C compute cy from last subtract
-	stq	r20,0(r16)
-	bis	r8,r25,r25		C combine cy from the two subtracts
-	stq	r21,8(r16)
-	subq	r7,r3,r28		C 4th main subtract
-	subq	r28,r25,r23		C 4th carry subtract
-	cmpult	r7,r3,r8		C compute cy from last subtract
-	cmpult	r28,r25,r25		C compute cy from last subtract
-		addq	r17,32,r17		C update s1_ptr
-	bis	r8,r25,r25		C combine cy from the two subtracts
-		addq	r16,32,r16		C update res_ptr
-	subq	r4,r0,r28		C 1st main subtract
-	ldq	r2,16(r18)
-	subq	r28,r25,r20		C 1st carry subtract
-	ldq	r3,24(r18)
-	cmpult	r4,r0,r8		C compute cy from last subtract
-	ldq	r6,-16(r17)
-	cmpult	r28,r25,r25		C compute cy from last subtract
-	ldq	r7,-8(r17)
-	bis	r8,r25,r25		C combine cy from the two subtracts
-	subq	r19,4,r19		C decr loop cnt
-	stq	r22,-16(r16)
-	subq	r5,r1,r28		C 2nd main subtract
-	stq	r23,-8(r16)
-	subq	r28,r25,r21		C 2nd carry subtract
-		addq	r18,32,r18		C update s2_ptr
-	cmpult	r5,r1,r8		C compute cy from last subtract
-	bge	r19,$Loop
-C Finish software pipeline for 1st loop
-$Lend1:	cmpult	r28,r25,r25		C compute cy from last subtract
-	bis	r8,r25,r25		C combine cy from the two subtracts
-	subq	r6,r2,r28		C cy add
-	subq	r28,r25,r22		C 3rd main subtract
-	cmpult	r6,r2,r8		C compute cy from last subtract
-	cmpult	r28,r25,r25		C compute cy from last subtract
-	stq	r20,0(r16)
-	bis	r8,r25,r25		C combine cy from the two subtracts
-	stq	r21,8(r16)
-	subq	r7,r3,r28		C cy add
-	subq	r28,r25,r23		C 4th main subtract
-	cmpult	r7,r3,r8		C compute cy from last subtract
-	cmpult	r28,r25,r25		C compute cy from last subtract
-	bis	r8,r25,r25		C combine cy from the two subtracts
-	addq	r16,32,r16		C update res_ptr
-	stq	r22,-16(r16)
-	stq	r23,-8(r16)
-$Lend2:	addq	r19,4,r19		C restore loop cnt
-	beq	r19,$Lret
-C Start software pipeline for 2nd loop
-	ldq	r0,0(r18)
-	ldq	r4,0(r17)
-	subq	r19,1,r19
-	beq	r19,$Lend0
-C 2nd loop handles remaining 1-3 limbs
-	ALIGN(16)
-$Loop0:	subq	r4,r0,r28		C main subtract
-	cmpult	r4,r0,r8		C compute cy from last subtract
-	ldq	r0,8(r18)
-	ldq	r4,8(r17)
-	subq	r28,r25,r20		C carry subtract
-	addq	r18,8,r18
-	addq	r17,8,r17
-	stq	r20,0(r16)
-	cmpult	r28,r25,r25		C compute cy from last subtract
-	subq	r19,1,r19		C decr loop cnt
-	bis	r8,r25,r25		C combine cy from the two subtracts
-	addq	r16,8,r16
-	bne	r19,$Loop0
-$Lend0:	subq	r4,r0,r28		C main subtract
-	subq	r28,r25,r20		C carry subtract
-	cmpult	r4,r0,r8		C compute cy from last subtract
-	cmpult	r28,r25,r25		C compute cy from last subtract
-	stq	r20,0(r16)
-	bis	r8,r25,r25		C combine cy from the two subtracts
-
-$Lret:	bis	r25,r31,r0		C return cy
-	ret	r31,(r26),1
-EPILOGUE(mpn_sub_n)
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/ev6/addmul_1.asm b/ghc/rts/gmp/mpn/alpha/ev6/addmul_1.asm
deleted file mode 100644
index 2f588626a5..0000000000
--- a/ghc/rts/gmp/mpn/alpha/ev6/addmul_1.asm
+++ /dev/null
@@ -1,474 +0,0 @@
-dnl Alpha ev6 mpn_addmul_1 -- Multiply a limb vector with a limb and add
-dnl the result to a second limb vector.
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  INPUT PARAMETERS
-dnl  res_ptr	r16
-dnl  s1_ptr	r17
-dnl  size	r18
-dnl  s2_limb	r19
-
-dnl  This code runs at 42 cycles/limb on EV4, 18 cycles/limb on EV5, and
-dnl  exactly 3.625 cycles/limb on EV6...
-
-dnl This code was written in close cooperation with ev6 pipeline expert
-dnl Steve Root (root@toober.hlo.dec.com).  Any errors are tege's fault, though.
-dnl
-dnl   Register usages for unrolled loop:
-dnl	  0-3     mul's
-dnl	  4-7     acc's
-dnl	  8-15    mul results
-dnl	  20,21   carry's
-dnl	  22,23   save for stores
-
-dnl   Sustains 8 mul-adds in 29 cycles in the unrolled inner loop.
-
-dnl   The stores can issue a cycle late so we have paired no-op's to 'catch'
-dnl   them, so that further disturbance to the schedule is damped.
-
-dnl   We couldn't pair the loads, because the entangled schedule of the
-dnl   carry's has to happen on one side {0} of the machine. Note, the total
-dnl   use of U0, and the total use of L0 (after attending to the stores).
-dnl   which is part of the reason why....
-
-dnl   This is a great schedule for the d_cache, a poor schedule for the
-dnl   b_cache. The lockup on U0 means that any stall can't be recovered
-dnl   from. Consider a ldq in L1.  say that load gets stalled because it
-dnl   collides with a fill from the b_Cache. On the next cycle, this load
-dnl   gets priority. If first looks at L0, and goes there. The instruction
-dnl   we intended for L0 gets to look at L1, which is NOT where we want
-dnl   it. It either stalls 1, because it can't go in L0, or goes there, and
-dnl   causes a further instruction to stall.
-
-dnl   So for b_cache, we're likely going to want to put one or more cycles
-dnl   back into the code! And, of course, put in prefetches. For the
-dnl   accumulator, lds, intent to modify.  For the multiplier, you might
-dnl   want ldq, evict next, if you're not wanting to use it again soon. Use
-dnl   256 ahead of present pointer value. At a place where we have an mt
-dnl   followed by a bookkeeping, put the bookkeeping in upper, and the
-dnl   prefetch into lower.
-
-dnl   Note, the usage of physical registers per cycle is smoothed off, as
-dnl   much as possible.
-
-dnl   Note, the ldq's and stq's are at the end of the quadpacks.  note, we'd
-dnl   like not to have a ldq or stq to preceded a conditional branch in a
-dnl   quadpack. The conditional branch moves the retire pointer one cycle
-dnl   later.
-
-dnl   Optimization notes:
-dnl   Callee-saves regs: r9 r10 r11 r12 r13 r14 r15 r26 ?r27?
-dnl   Reserved regs:	 r29 r30 r31
-dnl   Free caller-saves regs in unrolled code: r24 r25 r28
-dnl   We should swap some of the callee-saves regs for some of the free
-dnl   caller-saves regs, saving some overhead cycles.
-dnl   Most importantly, we should write fast code for the 0-7 case.
-dnl   The code we use there are for the 21164, and runs at 7 cycles/limb
-dnl   on the 21264.  Should not be hard, if we write specialized code for
-dnl   1-7 limbs (the one for 0 limbs should be straightforward).  We then just
-dnl   need a jump table indexed by the low 3 bits of the count argument.
-
-
-ASM_START()
-PROLOGUE(mpn_addmul_1)
-	cmpult	r18,	8,	r1
-	beq	r1,	$Large
-
-	ldq	r2,	0(r17)		C r2 = s1_limb
-	addq	r17,	8,	r17	C s1_ptr++
-	subq	r18,	1,	r18	C size--
-	mulq	r2,	r19,	r3	C r3 = prod_low
-	ldq	r5,	0(r16)		C r5 = *res_ptr
-	umulh	r2,	r19,	r0	C r0 = prod_high
-	beq	r18,	$Lend0b		C jump if size was == 1
-	ldq	r2,	0(r17)		C r2 = s1_limb
-	addq	r17,	8,	r17	C s1_ptr++
-	subq	r18,	1,	r18	C size--
-	addq	r5,	r3,	r3
-	cmpult	r3,	r5,	r4
-	stq	r3,	0(r16)
-	addq	r16,	8,	r16	C res_ptr++
-	beq	r18,	$Lend0a		C jump if size was == 2
-
-	ALIGN(8)
-$Loop0:	mulq	r2,	r19,	r3	C r3 = prod_low
-	ldq	r5,	0(r16)		C r5 = *res_ptr
-	addq	r4,	r0,	r0	C cy_limb = cy_limb + 'cy'
-	subq	r18,	1,	r18	C size--
-	umulh	r2,	r19,	r4	C r4 = cy_limb
-	ldq	r2,	0(r17)		C r2 = s1_limb
-	addq	r17,	8,	r17	C s1_ptr++
-	addq	r3,	r0,	r3	C r3 = cy_limb + prod_low
-	cmpult	r3,	r0,	r0	C r0 = carry from (cy_limb + prod_low)
-	addq	r5,	r3,	r3
-	cmpult	r3,	r5,	r5
-	stq	r3,	0(r16)
-	addq	r16,	8,	r16	C res_ptr++
-	addq	r5,	r0,	r0	C combine carries
-	bne	r18,	$Loop0
-$Lend0a:
-	mulq	r2,	r19,	r3	C r3 = prod_low
-	ldq	r5,	0(r16)		C r5 = *res_ptr
-	addq	r4,	r0,	r0	C cy_limb = cy_limb + 'cy'
-	umulh	r2,	r19,	r4	C r4 = cy_limb
-	addq	r3,	r0,	r3	C r3 = cy_limb + prod_low
-	cmpult	r3,	r0,	r0	C r0 = carry from (cy_limb + prod_low)
-	addq	r5,	r3,	r3
-	cmpult	r3,	r5,	r5
-	stq	r3,	0(r16)
-	addq	r5,	r0,	r0	C combine carries
-	addq	r4,	r0,	r0	C cy_limb = prod_high + cy
-	ret	r31,	(r26),	1
-$Lend0b:
-	addq	r5,	r3,	r3
-	cmpult	r3,	r5,	r5
-	stq	r3,	0(r16)
-	addq	r0,	r5,	r0
-	ret	r31,	(r26),	1
-
-$Large:
-	lda	$30,	-240($30)
-	stq	$9,	8($30)
-	stq	$10,	16($30)
-	stq	$11,	24($30)
-	stq	$12,	32($30)
-	stq	$13,	40($30)
-	stq	$14,	48($30)
-	stq	$15,	56($30)
-
-	and	r18,	7,	r20	C count for the first loop, 0-7
-	srl	r18,	3,	r18	C count for unrolled loop
-	bis	r31,	r31,	r0
-	beq	r20,	$Lunroll
-	ldq	r2,	0(r17)		C r2 = s1_limb
-	addq	r17,	8,	r17	C s1_ptr++
-	subq	r20,	1,	r20	C size--
-	mulq	r2,	r19,	r3	C r3 = prod_low
-	ldq	r5,	0(r16)		C r5 = *res_ptr
-	umulh	r2,	r19,	r0	C r0 = prod_high
-	beq	r20,	$Lend1b		C jump if size was == 1
-	ldq	r2,	0(r17)		C r2 = s1_limb
-	addq	r17,	8,	r17	C s1_ptr++
-	subq	r20,	1,	r20	C size--
-	addq	r5,	r3,	r3
-	cmpult	r3,	r5,	r4
-	stq	r3,	0(r16)
-	addq	r16,	8,	r16	C res_ptr++
-	beq	r20,	$Lend1a		C jump if size was == 2
-
-	ALIGN(8)
-$Loop1:	mulq	r2,	r19,	r3	C r3 = prod_low
-	ldq	r5,	0(r16)		C r5 = *res_ptr
-	addq	r4,	r0,	r0	C cy_limb = cy_limb + 'cy'
-	subq	r20,	1,	r20	C size--
-	umulh	r2,	r19,	r4	C r4 = cy_limb
-	ldq	r2,	0(r17)		C r2 = s1_limb
-	addq	r17,	8,	r17	C s1_ptr++
-	addq	r3,	r0,	r3	C r3 = cy_limb + prod_low
-	cmpult	r3,	r0,	r0	C r0 = carry from (cy_limb + prod_low)
-	addq	r5,	r3,	r3
-	cmpult	r3,	r5,	r5
-	stq	r3,	0(r16)
-	addq	r16,	8,	r16	C res_ptr++
-	addq	r5,	r0,	r0	C combine carries
-	bne	r20,	$Loop1
-
-$Lend1a:
-	mulq	r2,	r19,	r3	C r3 = prod_low
-	ldq	r5,	0(r16)		C r5 = *res_ptr
-	addq	r4,	r0,	r0	C cy_limb = cy_limb + 'cy'
-	umulh	r2,	r19,	r4	C r4 = cy_limb
-	addq	r3,	r0,	r3	C r3 = cy_limb + prod_low
-	cmpult	r3,	r0,	r0	C r0 = carry from (cy_limb + prod_low)
-	addq	r5,	r3,	r3
-	cmpult	r3,	r5,	r5
-	stq	r3,	0(r16)
-	addq	r16,	8,	r16	C res_ptr++
-	addq	r5,	r0,	r0	C combine carries
-	addq	r4,	r0,	r0	C cy_limb = prod_high + cy
-	br	r31,	$Lunroll
-$Lend1b:
-	addq	r5,	r3,	r3
-	cmpult	r3,	r5,	r5
-	stq	r3,	0(r16)
-	addq	r16,	8,	r16	C res_ptr++
-	addq	r0,	r5,	r0
-
-$Lunroll:
-	lda	r17,	-16(r17)	C L1 bookkeeping
-	lda	r16,	-16(r16)	C L1 bookkeeping
-	bis	r0,	r31,	r12
-
-C ____ UNROLLED LOOP SOFTWARE PIPELINE STARTUP ____
-
-	ldq	r2,	16(r17)		C L1
-	ldq	r3,	24(r17)		C L1
-	lda	r18,	-1(r18)		C L1 bookkeeping
-	ldq	r6,	16(r16)		C L1
-	ldq	r7,	24(r16)		C L1
-	ldq	r0,	32(r17)		C L1
-	mulq	r19,	r2,	r13	C U1
-	ldq	r1,	40(r17)		C L1
-	umulh	r19,	r2,	r14	C U1
-	mulq	r19,	r3,	r15	C U1
-	lda	r17,	64(r17)		C L1 bookkeeping
-	ldq	r4,	32(r16)		C L1
-	ldq	r5,	40(r16)		C L1
-	umulh	r19,	r3,	r8	C U1
-	ldq	r2,	-16(r17)	C L1
-	mulq	r19,	r0,	r9	C U1
-	ldq	r3,	-8(r17)		C L1
-	umulh	r19,	r0,	r10	C U1
-	addq	r6,	r13,	r6	C L0 lo + acc
-	mulq	r19,	r1,	r11	C U1
-	cmpult	r6,	r13,	r20	C L0 lo add => carry
-	lda	r16,	64(r16)		C L1 bookkeeping
-	addq	r6,	r12,	r22	C U0 hi add => answer
-	cmpult	r22,	r12,	r21	C L0 hi add => carry
-	addq	r14,	r20,	r14	C U0 hi mul + carry
-	ldq	r6,	-16(r16)	C L1
-	addq	r7,	r15,	r23	C L0 lo + acc
-	addq	r14,	r21,	r14	C U0 hi mul + carry
-	ldq	r7,	-8(r16)		C L1
-	umulh	r19,	r1,	r12	C U1
-	cmpult	r23,	r15,	r20	C L0 lo add => carry
-	addq	r23,	r14,	r23	C U0 hi add => answer
-	ldq	r0,	0(r17)		C L1
-	mulq	r19,	r2,	r13	C U1
-	cmpult	r23,	r14,	r21	C L0 hi add => carry
-	addq	r8,	r20,	r8	C U0 hi mul + carry
-	ldq	r1,	8(r17)		C L1
-	umulh	r19,	r2,	r14	C U1
-	addq	r4,	r9,	r4	C L0 lo + acc
-	stq	r22,	-48(r16)	C L0
-	stq	r23,	-40(r16)	C L1
-	mulq	r19,	r3,	r15	C U1
-	addq	r8,	r21,	r8	C U0 hi mul + carry
-	cmpult	r4,	r9,	r20	C L0 lo add => carry
-	addq	r4,	r8,	r22	C U0 hi add => answer
-	ble	r18,	$Lend		C U1 bookkeeping
-
-C ____ MAIN UNROLLED LOOP ____
-	ALIGN(16)
-$Loop:
-	bis	r31,	r31,	r31	C U1 mt
-	cmpult	r22,	r8,	r21	C L0 hi add => carry
-	addq	r10,	r20,	r10	C U0 hi mul + carry
-	ldq	r4,	0(r16)		C L1
-
-	bis	r31,	r31,	r31	C U1 mt
-	addq	r5,	r11,	r23	C L0 lo + acc
-	addq	r10,	r21,	r10	C L0 hi mul + carry
-	ldq	r5,	8(r16)		C L1
-
-	umulh	r19,	r3,	r8	C U1
-	cmpult	r23,	r11,	r20	C L0 lo add => carry
-	addq	r23,	r10,	r23	C U0 hi add => answer
-	ldq	r2,	16(r17)		C L1
-
-	mulq	r19,	r0,	r9	C U1
-	cmpult	r23,	r10,	r21	C L0 hi add => carry
-	addq	r12,	r20,	r12	C U0 hi mul + carry
-	ldq	r3,	24(r17)		C L1
-
-	umulh	r19,	r0,	r10	C U1
-	addq	r6,	r13,	r6	C L0 lo + acc
-	stq	r22,	-32(r16)	C L0
-	stq	r23,	-24(r16)	C L1
-
-	bis	r31,	r31,	r31	C L0 st slosh
-	mulq	r19,	r1,	r11	C U1
-	bis	r31,	r31,	r31	C L1 st slosh
-	addq	r12,	r21,	r12	C U0 hi mul + carry
-
-	cmpult	r6,	r13,	r20	C L0 lo add => carry
-	bis	r31,	r31,	r31	C U1 mt
-	lda	r18,	-1(r18)		C L1 bookkeeping
-	addq	r6,	r12,	r22	C U0 hi add => answer
-
-	bis	r31,	r31,	r31	C U1 mt
-	cmpult	r22,	r12,	r21	C L0 hi add => carry
-	addq	r14,	r20,	r14	C U0 hi mul + carry
-	ldq	r6,	16(r16)		C L1
-
-	bis	r31,	r31,	r31	C U1 mt
-	addq	r7,	r15,	r23	C L0 lo + acc
-	addq	r14,	r21,	r14	C U0 hi mul + carry
-	ldq	r7,	24(r16)		C L1
-
-	umulh	r19,	r1,	r12	C U1
-	cmpult	r23,	r15,	r20	C L0 lo add => carry
-	addq	r23,	r14,	r23	C U0 hi add => answer
-	ldq	r0,	32(r17)		C L1
-
-	mulq	r19,	r2,	r13	C U1
-	cmpult	r23,	r14,	r21	C L0 hi add => carry
-	addq	r8,	r20,	r8	C U0 hi mul + carry
-	ldq	r1,	40(r17)		C L1
-
-	umulh	r19,	r2,	r14	C U1
-	addq	r4,	r9,	r4	C U0 lo + acc
-	stq	r22,	-16(r16)	C L0
-	stq	r23,	-8(r16)		C L1
-
-	bis	r31,	r31,	r31	C L0 st slosh
-	mulq	r19,	r3,	r15	C U1
-	bis	r31,	r31,	r31	C L1 st slosh
-	addq	r8,	r21,	r8	C L0 hi mul + carry
-
-	cmpult	r4,	r9,	r20	C L0 lo add => carry
-	bis	r31,	r31,	r31	C U1 mt
-	lda	r17,	64(r17)		C L1 bookkeeping
-	addq	r4,	r8,	r22	C U0 hi add => answer
-
-	bis	r31,	r31,	r31	C U1 mt
-	cmpult	r22,	r8,	r21	C L0 hi add => carry
-	addq	r10,	r20,	r10	C U0 hi mul + carry
-	ldq	r4,	32(r16)		C L1
-
-	bis	r31,	r31,	r31	C U1 mt
-	addq	r5,	r11,	r23	C L0 lo + acc
-	addq	r10,	r21,	r10	C L0 hi mul + carry
-	ldq	r5,	40(r16)		C L1
-
-	umulh	r19,	r3,	r8	C U1
-	cmpult	r23,	r11,	r20	C L0 lo add => carry
-	addq	r23,	r10,	r23	C U0 hi add => answer
-	ldq	r2,	-16(r17)	C L1
-
-	mulq	r19,	r0,	r9	C U1
-	cmpult	r23,	r10,	r21	C L0 hi add => carry
-	addq	r12,	r20,	r12	C U0 hi mul + carry
-	ldq	r3,	-8(r17)		C L1
-
-	umulh	r19,	r0,	r10	C U1
-	addq	r6,	r13,	r6	C L0 lo + acc
-	stq	r22,	0(r16)		C L0
-	stq	r23,	8(r16)		C L1
-
-	bis	r31,	r31,	r31	C L0 st slosh
-	mulq	r19,	r1,	r11	C U1
-	bis	r31,	r31,	r31	C L1 st slosh
-	addq	r12,	r21,	r12	C U0 hi mul + carry
-
-	cmpult	r6,	r13,	r20	C L0 lo add => carry
-	bis	r31,	r31,	r31	C U1 mt
-	lda	r16,	64(r16)		C L1 bookkeeping
-	addq	r6,	r12,	r22	C U0 hi add => answer
-
-	bis	r31,	r31,	r31	C U1 mt
-	cmpult	r22,	r12,	r21	C L0 hi add => carry
-	addq	r14,	r20,	r14	C U0 hi mul + carry
-	ldq	r6,	-16(r16)	C L1
-
-	bis	r31,	r31,	r31	C U1 mt
-	addq	r7,	r15,	r23	C L0 lo + acc
-	addq	r14,	r21,	r14	C U0 hi mul + carry
-	ldq	r7,	-8(r16)		C L1
-
-	umulh	r19,	r1,	r12	C U1
-	cmpult	r23,	r15,	r20	C L0 lo add => carry
-	addq	r23,	r14,	r23	C U0 hi add => answer
-	ldq	r0,	0(r17)		C L1
-
-	mulq	r19,	r2,	r13	C U1
-	cmpult	r23,	r14,	r21	C L0 hi add => carry
-	addq	r8,	r20,	r8	C U0 hi mul + carry
-	ldq	r1,	8(r17)		C L1
-
-	umulh	r19,	r2,	r14	C U1
-	addq	r4,	r9,	r4	C L0 lo + acc
-	stq	r22,	-48(r16)	C L0
-	stq	r23,	-40(r16)	C L1
-
-	bis	r31,	r31,	r31	C L0 st slosh
-	mulq	r19,	r3,	r15	C U1
-	bis	r31,	r31,	r31	C L1 st slosh
-	addq	r8,	r21,	r8	C U0 hi mul + carry
-
-	cmpult	r4,	r9,	r20	C L0 lo add => carry
-	addq	r4,	r8,	r22	C U0 hi add => answer
-	bis	r31,	r31,	r31	C L1 mt
-	bgt	r18,	$Loop		C U1 bookkeeping
-
-C ____ UNROLLED LOOP SOFTWARE PIPELINE FINISH ____
-$Lend:
-	cmpult	r22,	r8,	r21	C L0 hi add => carry
-	addq	r10,	r20,	r10	C U0 hi mul + carry
-	ldq	r4,	0(r16)		C L1
-	addq	r5,	r11,	r23	C L0 lo + acc
-	addq	r10,	r21,	r10	C L0 hi mul + carry
-	ldq	r5,	8(r16)		C L1
-	umulh	r19,	r3,	r8	C U1
-	cmpult	r23,	r11,	r20	C L0 lo add => carry
-	addq	r23,	r10,	r23	C U0 hi add => answer
-	mulq	r19,	r0,	r9	C U1
-	cmpult	r23,	r10,	r21	C L0 hi add => carry
-	addq	r12,	r20,	r12	C U0 hi mul + carry
-	umulh	r19,	r0,	r10	C U1
-	addq	r6,	r13,	r6	C L0 lo + acc
-	stq	r22,	-32(r16)	C L0
-	stq	r23,	-24(r16)	C L1
-	mulq	r19,	r1,	r11	C U1
-	addq	r12,	r21,	r12	C U0 hi mul + carry
-	cmpult	r6,	r13,	r20	C L0 lo add => carry
-	addq	r6,	r12,	r22	C U0 hi add => answer
-	cmpult	r22,	r12,	r21	C L0 hi add => carry
-	addq	r14,	r20,	r14	C U0 hi mul + carry
-	addq	r7,	r15,	r23	C L0 lo + acc
-	addq	r14,	r21,	r14	C U0 hi mul + carry
-	umulh	r19,	r1,	r12	C U1
-	cmpult	r23,	r15,	r20	C L0 lo add => carry
-	addq	r23,	r14,	r23	C U0 hi add => answer
-	cmpult	r23,	r14,	r21	C L0 hi add => carry
-	addq	r8,	r20,	r8	C U0 hi mul + carry
-	addq	r4,	r9,	r4	C U0 lo + acc
-	stq	r22,	-16(r16)	C L0
-	stq	r23,	-8(r16)		C L1
-	bis	r31,	r31,	r31	C L0 st slosh
-	addq	r8,	r21,	r8	C L0 hi mul + carry
-	cmpult	r4,	r9,	r20	C L0 lo add => carry
-	addq	r4,	r8,	r22	C U0 hi add => answer
-	cmpult	r22,	r8,	r21	C L0 hi add => carry
-	addq	r10,	r20,	r10	C U0 hi mul + carry
-	addq	r5,	r11,	r23	C L0 lo + acc
-	addq	r10,	r21,	r10	C L0 hi mul + carry
-	cmpult	r23,	r11,	r20	C L0 lo add => carry
-	addq	r23,	r10,	r23	C U0 hi add => answer
-	cmpult	r23,	r10,	r21	C L0 hi add => carry
-	addq	r12,	r20,	r12	C U0 hi mul + carry
-	stq	r22,	0(r16)		C L0
-	stq	r23,	8(r16)		C L1
-	addq	r12,	r21,	r0	C U0 hi mul + carry
-
-	ldq	$9,	8($30)
-	ldq	$10,	16($30)
-	ldq	$11,	24($30)
-	ldq	$12,	32($30)
-	ldq	$13,	40($30)
-	ldq	$14,	48($30)
-	ldq	$15,	56($30)
-	lda	$30,	240($30)
-	ret	r31,	(r26),	1
-EPILOGUE(mpn_addmul_1)
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/ev6/gmp-mparam.h b/ghc/rts/gmp/mpn/alpha/ev6/gmp-mparam.h
deleted file mode 100644
index 7ea20577f8..0000000000
--- a/ghc/rts/gmp/mpn/alpha/ev6/gmp-mparam.h
+++ /dev/null
@@ -1,62 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 64
-#define BYTES_PER_MP_LIMB 8
-#define BITS_PER_LONGINT 64
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-/* Generated by tuneup.c, 2000-08-02. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD     47
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD         70
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD     94
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD        101
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD                33
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD               70
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD              29
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD         46
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD            33
-#endif
diff --git a/ghc/rts/gmp/mpn/alpha/gmp-mparam.h b/ghc/rts/gmp/mpn/alpha/gmp-mparam.h
deleted file mode 100644
index 054ff2fe5f..0000000000
--- a/ghc/rts/gmp/mpn/alpha/gmp-mparam.h
+++ /dev/null
@@ -1,64 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 64
-#define BYTES_PER_MP_LIMB 8
-#define BITS_PER_LONGINT 64
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-/* These values are for the 21164 family.  The 21264 will require
-   different values, since it has such quick multiplication.  */
-/* Generated by tuneup.c, 2000-07-19. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD   22
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD       53
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD   31
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD       47
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD              64
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD             98
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            17
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD        4
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD           4
-#endif
diff --git a/ghc/rts/gmp/mpn/alpha/invert_limb.asm b/ghc/rts/gmp/mpn/alpha/invert_limb.asm
deleted file mode 100644
index a921b32b3f..0000000000
--- a/ghc/rts/gmp/mpn/alpha/invert_limb.asm
+++ /dev/null
@@ -1,345 +0,0 @@
-dnl  Alpha mpn_invert_limb -- Invert a normalized limb.
-
-dnl  Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-dnl 
-dnl  This is based on sophie:/gmp-stuff/dbg-inv-limb.c.
-dnl  The ideas are due to Peter L. Montgomery
-dnl 
-dnl  The table below uses 4096 bytes.  The file mentioned above has an
-dnl  alternative function that doesn't require the table, but it runs 50%
-dnl  slower than this.
-
-include(`../config.m4')
-
-ASM_START()
-
-FLOAT64($C36,9223372036854775808.0)		C 2^63
-
-PROLOGUE_GP(mpn_invert_limb)
-	lda	r30,-16(r30)
-	addq	r16,r16,r1
-	bne	r1,$73
-	lda	r0,-1
-	br	r31,$Lend
-$73:
-	srl	r16,1,r1
-	stq	r1,0(r30)
-	ldt	f11,0(r30)
-	cvtqt	f11,f1
-	lda	r1,$C36
-	ldt	f10,0(r1)
-	divt	f10,f1,f10
-	lda	r2,$invtab-4096
-	srl	r16,52,r1
-	addq	r1,r1,r1
-	addq	r1,r2,r1
-	bic	r1,6,r2
-	ldq	r2,0(r2)
-	bic	r1,1,r1
-	extwl	r2,r1,r2
-	sll	r2,48,r0
-	umulh	r16,r0,r1
-	addq	r16,r1,r3
-	stq	r3,0(r30)
-	ldt	f11,0(r30)
-	cvtqt	f11,f1
-	mult	f1,f10,f1
-	cvttqc	f1,f1
-	stt	f1,0(r30)
-	ldq	r4,0(r30)
-	subq	r0,r4,r0
-	umulh	r16,r0,r1
-	mulq	r16,r0,r2
-	addq	r16,r1,r3
-	bge	r3,$Loop2
-$Loop1:	addq	r2,r16,r2
-	cmpult	r2,r16,r1
-	addq	r3,r1,r3
-	addq	r0,1,r0
-	blt	r3,$Loop1
-$Loop2:	cmpult	r2,r16,r1
-	subq	r0,1,r0
-	subq	r3,r1,r3
-	subq	r2,r16,r2
-	bge	r3,$Loop2
-$Lend:
-	lda	r30,16(r30)
-	ret	r31,(r26),1
-EPILOGUE(mpn_invert_limb)
-DATASTART(`$invtab',4)
-	.word 0xffff,0xffc0,0xff80,0xff40,0xff00,0xfec0,0xfe81,0xfe41
-	.word 0xfe01,0xfdc2,0xfd83,0xfd43,0xfd04,0xfcc5,0xfc86,0xfc46
-	.word 0xfc07,0xfbc8,0xfb8a,0xfb4b,0xfb0c,0xfacd,0xfa8e,0xfa50
-	.word 0xfa11,0xf9d3,0xf994,0xf956,0xf918,0xf8d9,0xf89b,0xf85d
-	.word 0xf81f,0xf7e1,0xf7a3,0xf765,0xf727,0xf6ea,0xf6ac,0xf66e
-	.word 0xf631,0xf5f3,0xf5b6,0xf578,0xf53b,0xf4fd,0xf4c0,0xf483
-	.word 0xf446,0xf409,0xf3cc,0xf38f,0xf352,0xf315,0xf2d8,0xf29c
-	.word 0xf25f,0xf222,0xf1e6,0xf1a9,0xf16d,0xf130,0xf0f4,0xf0b8
-	.word 0xf07c,0xf03f,0xf003,0xefc7,0xef8b,0xef4f,0xef14,0xeed8
-	.word 0xee9c,0xee60,0xee25,0xede9,0xedae,0xed72,0xed37,0xecfb
-	.word 0xecc0,0xec85,0xec4a,0xec0e,0xebd3,0xeb98,0xeb5d,0xeb22
-	.word 0xeae8,0xeaad,0xea72,0xea37,0xe9fd,0xe9c2,0xe988,0xe94d
-	.word 0xe913,0xe8d8,0xe89e,0xe864,0xe829,0xe7ef,0xe7b5,0xe77b
-	.word 0xe741,0xe707,0xe6cd,0xe694,0xe65a,0xe620,0xe5e6,0xe5ad
-	.word 0xe573,0xe53a,0xe500,0xe4c7,0xe48d,0xe454,0xe41b,0xe3e2
-	.word 0xe3a9,0xe370,0xe336,0xe2fd,0xe2c5,0xe28c,0xe253,0xe21a
-	.word 0xe1e1,0xe1a9,0xe170,0xe138,0xe0ff,0xe0c7,0xe08e,0xe056
-	.word 0xe01e,0xdfe5,0xdfad,0xdf75,0xdf3d,0xdf05,0xdecd,0xde95
-	.word 0xde5d,0xde25,0xdded,0xddb6,0xdd7e,0xdd46,0xdd0f,0xdcd7
-	.word 0xdca0,0xdc68,0xdc31,0xdbf9,0xdbc2,0xdb8b,0xdb54,0xdb1d
-	.word 0xdae6,0xdaae,0xda78,0xda41,0xda0a,0xd9d3,0xd99c,0xd965
-	.word 0xd92f,0xd8f8,0xd8c1,0xd88b,0xd854,0xd81e,0xd7e8,0xd7b1
-	.word 0xd77b,0xd745,0xd70e,0xd6d8,0xd6a2,0xd66c,0xd636,0xd600
-	.word 0xd5ca,0xd594,0xd55f,0xd529,0xd4f3,0xd4bd,0xd488,0xd452
-	.word 0xd41d,0xd3e7,0xd3b2,0xd37c,0xd347,0xd312,0xd2dd,0xd2a7
-	.word 0xd272,0xd23d,0xd208,0xd1d3,0xd19e,0xd169,0xd134,0xd100
-	.word 0xd0cb,0xd096,0xd061,0xd02d,0xcff8,0xcfc4,0xcf8f,0xcf5b
-	.word 0xcf26,0xcef2,0xcebe,0xce89,0xce55,0xce21,0xcded,0xcdb9
-	.word 0xcd85,0xcd51,0xcd1d,0xcce9,0xccb5,0xcc81,0xcc4e,0xcc1a
-	.word 0xcbe6,0xcbb3,0xcb7f,0xcb4c,0xcb18,0xcae5,0xcab1,0xca7e
-	.word 0xca4b,0xca17,0xc9e4,0xc9b1,0xc97e,0xc94b,0xc918,0xc8e5
-	.word 0xc8b2,0xc87f,0xc84c,0xc819,0xc7e7,0xc7b4,0xc781,0xc74f
-	.word 0xc71c,0xc6e9,0xc6b7,0xc684,0xc652,0xc620,0xc5ed,0xc5bb
-	.word 0xc589,0xc557,0xc524,0xc4f2,0xc4c0,0xc48e,0xc45c,0xc42a
-	.word 0xc3f8,0xc3c7,0xc395,0xc363,0xc331,0xc300,0xc2ce,0xc29c
-	.word 0xc26b,0xc239,0xc208,0xc1d6,0xc1a5,0xc174,0xc142,0xc111
-	.word 0xc0e0,0xc0af,0xc07e,0xc04d,0xc01c,0xbfeb,0xbfba,0xbf89
-	.word 0xbf58,0xbf27,0xbef6,0xbec5,0xbe95,0xbe64,0xbe33,0xbe03
-	.word 0xbdd2,0xbda2,0xbd71,0xbd41,0xbd10,0xbce0,0xbcb0,0xbc80
-	.word 0xbc4f,0xbc1f,0xbbef,0xbbbf,0xbb8f,0xbb5f,0xbb2f,0xbaff
-	.word 0xbacf,0xba9f,0xba6f,0xba40,0xba10,0xb9e0,0xb9b1,0xb981
-	.word 0xb951,0xb922,0xb8f2,0xb8c3,0xb894,0xb864,0xb835,0xb806
-	.word 0xb7d6,0xb7a7,0xb778,0xb749,0xb71a,0xb6eb,0xb6bc,0xb68d
-	.word 0xb65e,0xb62f,0xb600,0xb5d1,0xb5a2,0xb574,0xb545,0xb516
-	.word 0xb4e8,0xb4b9,0xb48a,0xb45c,0xb42e,0xb3ff,0xb3d1,0xb3a2
-	.word 0xb374,0xb346,0xb318,0xb2e9,0xb2bb,0xb28d,0xb25f,0xb231
-	.word 0xb203,0xb1d5,0xb1a7,0xb179,0xb14b,0xb11d,0xb0f0,0xb0c2
-	.word 0xb094,0xb067,0xb039,0xb00b,0xafde,0xafb0,0xaf83,0xaf55
-	.word 0xaf28,0xaefb,0xaecd,0xaea0,0xae73,0xae45,0xae18,0xadeb
-	.word 0xadbe,0xad91,0xad64,0xad37,0xad0a,0xacdd,0xacb0,0xac83
-	.word 0xac57,0xac2a,0xabfd,0xabd0,0xaba4,0xab77,0xab4a,0xab1e
-	.word 0xaaf1,0xaac5,0xaa98,0xaa6c,0xaa40,0xaa13,0xa9e7,0xa9bb
-	.word 0xa98e,0xa962,0xa936,0xa90a,0xa8de,0xa8b2,0xa886,0xa85a
-	.word 0xa82e,0xa802,0xa7d6,0xa7aa,0xa77e,0xa753,0xa727,0xa6fb
-	.word 0xa6d0,0xa6a4,0xa678,0xa64d,0xa621,0xa5f6,0xa5ca,0xa59f
-	.word 0xa574,0xa548,0xa51d,0xa4f2,0xa4c6,0xa49b,0xa470,0xa445
-	.word 0xa41a,0xa3ef,0xa3c4,0xa399,0xa36e,0xa343,0xa318,0xa2ed
-	.word 0xa2c2,0xa297,0xa26d,0xa242,0xa217,0xa1ed,0xa1c2,0xa197
-	.word 0xa16d,0xa142,0xa118,0xa0ed,0xa0c3,0xa098,0xa06e,0xa044
-	.word 0xa01a,0x9fef,0x9fc5,0x9f9b,0x9f71,0x9f47,0x9f1c,0x9ef2
-	.word 0x9ec8,0x9e9e,0x9e74,0x9e4b,0x9e21,0x9df7,0x9dcd,0x9da3
-	.word 0x9d79,0x9d50,0x9d26,0x9cfc,0x9cd3,0x9ca9,0x9c80,0x9c56
-	.word 0x9c2d,0x9c03,0x9bda,0x9bb0,0x9b87,0x9b5e,0x9b34,0x9b0b
-	.word 0x9ae2,0x9ab9,0x9a8f,0x9a66,0x9a3d,0x9a14,0x99eb,0x99c2
-	.word 0x9999,0x9970,0x9947,0x991e,0x98f6,0x98cd,0x98a4,0x987b
-	.word 0x9852,0x982a,0x9801,0x97d8,0x97b0,0x9787,0x975f,0x9736
-	.word 0x970e,0x96e5,0x96bd,0x9695,0x966c,0x9644,0x961c,0x95f3
-	.word 0x95cb,0x95a3,0x957b,0x9553,0x952b,0x9503,0x94db,0x94b3
-	.word 0x948b,0x9463,0x943b,0x9413,0x93eb,0x93c3,0x939b,0x9374
-	.word 0x934c,0x9324,0x92fd,0x92d5,0x92ad,0x9286,0x925e,0x9237
-	.word 0x920f,0x91e8,0x91c0,0x9199,0x9172,0x914a,0x9123,0x90fc
-	.word 0x90d4,0x90ad,0x9086,0x905f,0x9038,0x9011,0x8fea,0x8fc3
-	.word 0x8f9c,0x8f75,0x8f4e,0x8f27,0x8f00,0x8ed9,0x8eb2,0x8e8b
-	.word 0x8e65,0x8e3e,0x8e17,0x8df1,0x8dca,0x8da3,0x8d7d,0x8d56
-	.word 0x8d30,0x8d09,0x8ce3,0x8cbc,0x8c96,0x8c6f,0x8c49,0x8c23
-	.word 0x8bfc,0x8bd6,0x8bb0,0x8b8a,0x8b64,0x8b3d,0x8b17,0x8af1
-	.word 0x8acb,0x8aa5,0x8a7f,0x8a59,0x8a33,0x8a0d,0x89e7,0x89c1
-	.word 0x899c,0x8976,0x8950,0x892a,0x8904,0x88df,0x88b9,0x8893
-	.word 0x886e,0x8848,0x8823,0x87fd,0x87d8,0x87b2,0x878d,0x8767
-	.word 0x8742,0x871d,0x86f7,0x86d2,0x86ad,0x8687,0x8662,0x863d
-	.word 0x8618,0x85f3,0x85ce,0x85a9,0x8583,0x855e,0x8539,0x8514
-	.word 0x84f0,0x84cb,0x84a6,0x8481,0x845c,0x8437,0x8412,0x83ee
-	.word 0x83c9,0x83a4,0x8380,0x835b,0x8336,0x8312,0x82ed,0x82c9
-	.word 0x82a4,0x8280,0x825b,0x8237,0x8212,0x81ee,0x81ca,0x81a5
-	.word 0x8181,0x815d,0x8138,0x8114,0x80f0,0x80cc,0x80a8,0x8084
-	.word 0x8060,0x803c,0x8018,0x7ff4,0x7fd0,0x7fac,0x7f88,0x7f64
-	.word 0x7f40,0x7f1c,0x7ef8,0x7ed4,0x7eb1,0x7e8d,0x7e69,0x7e45
-	.word 0x7e22,0x7dfe,0x7ddb,0x7db7,0x7d93,0x7d70,0x7d4c,0x7d29
-	.word 0x7d05,0x7ce2,0x7cbf,0x7c9b,0x7c78,0x7c55,0x7c31,0x7c0e
-	.word 0x7beb,0x7bc7,0x7ba4,0x7b81,0x7b5e,0x7b3b,0x7b18,0x7af5
-	.word 0x7ad2,0x7aaf,0x7a8c,0x7a69,0x7a46,0x7a23,0x7a00,0x79dd
-	.word 0x79ba,0x7997,0x7975,0x7952,0x792f,0x790c,0x78ea,0x78c7
-	.word 0x78a4,0x7882,0x785f,0x783c,0x781a,0x77f7,0x77d5,0x77b2
-	.word 0x7790,0x776e,0x774b,0x7729,0x7706,0x76e4,0x76c2,0x76a0
-	.word 0x767d,0x765b,0x7639,0x7617,0x75f5,0x75d2,0x75b0,0x758e
-	.word 0x756c,0x754a,0x7528,0x7506,0x74e4,0x74c2,0x74a0,0x747e
-	.word 0x745d,0x743b,0x7419,0x73f7,0x73d5,0x73b4,0x7392,0x7370
-	.word 0x734f,0x732d,0x730b,0x72ea,0x72c8,0x72a7,0x7285,0x7264
-	.word 0x7242,0x7221,0x71ff,0x71de,0x71bc,0x719b,0x717a,0x7158
-	.word 0x7137,0x7116,0x70f5,0x70d3,0x70b2,0x7091,0x7070,0x704f
-	.word 0x702e,0x700c,0x6feb,0x6fca,0x6fa9,0x6f88,0x6f67,0x6f46
-	.word 0x6f26,0x6f05,0x6ee4,0x6ec3,0x6ea2,0x6e81,0x6e60,0x6e40
-	.word 0x6e1f,0x6dfe,0x6dde,0x6dbd,0x6d9c,0x6d7c,0x6d5b,0x6d3a
-	.word 0x6d1a,0x6cf9,0x6cd9,0x6cb8,0x6c98,0x6c77,0x6c57,0x6c37
-	.word 0x6c16,0x6bf6,0x6bd6,0x6bb5,0x6b95,0x6b75,0x6b54,0x6b34
-	.word 0x6b14,0x6af4,0x6ad4,0x6ab4,0x6a94,0x6a73,0x6a53,0x6a33
-	.word 0x6a13,0x69f3,0x69d3,0x69b3,0x6993,0x6974,0x6954,0x6934
-	.word 0x6914,0x68f4,0x68d4,0x68b5,0x6895,0x6875,0x6855,0x6836
-	.word 0x6816,0x67f6,0x67d7,0x67b7,0x6798,0x6778,0x6758,0x6739
-	.word 0x6719,0x66fa,0x66db,0x66bb,0x669c,0x667c,0x665d,0x663e
-	.word 0x661e,0x65ff,0x65e0,0x65c0,0x65a1,0x6582,0x6563,0x6544
-	.word 0x6524,0x6505,0x64e6,0x64c7,0x64a8,0x6489,0x646a,0x644b
-	.word 0x642c,0x640d,0x63ee,0x63cf,0x63b0,0x6391,0x6373,0x6354
-	.word 0x6335,0x6316,0x62f7,0x62d9,0x62ba,0x629b,0x627c,0x625e
-	.word 0x623f,0x6221,0x6202,0x61e3,0x61c5,0x61a6,0x6188,0x6169
-	.word 0x614b,0x612c,0x610e,0x60ef,0x60d1,0x60b3,0x6094,0x6076
-	.word 0x6058,0x6039,0x601b,0x5ffd,0x5fdf,0x5fc0,0x5fa2,0x5f84
-	.word 0x5f66,0x5f48,0x5f2a,0x5f0b,0x5eed,0x5ecf,0x5eb1,0x5e93
-	.word 0x5e75,0x5e57,0x5e39,0x5e1b,0x5dfd,0x5de0,0x5dc2,0x5da4
-	.word 0x5d86,0x5d68,0x5d4a,0x5d2d,0x5d0f,0x5cf1,0x5cd3,0x5cb6
-	.word 0x5c98,0x5c7a,0x5c5d,0x5c3f,0x5c21,0x5c04,0x5be6,0x5bc9
-	.word 0x5bab,0x5b8e,0x5b70,0x5b53,0x5b35,0x5b18,0x5afb,0x5add
-	.word 0x5ac0,0x5aa2,0x5a85,0x5a68,0x5a4b,0x5a2d,0x5a10,0x59f3
-	.word 0x59d6,0x59b8,0x599b,0x597e,0x5961,0x5944,0x5927,0x590a
-	.word 0x58ed,0x58d0,0x58b3,0x5896,0x5879,0x585c,0x583f,0x5822
-	.word 0x5805,0x57e8,0x57cb,0x57ae,0x5791,0x5775,0x5758,0x573b
-	.word 0x571e,0x5702,0x56e5,0x56c8,0x56ac,0x568f,0x5672,0x5656
-	.word 0x5639,0x561c,0x5600,0x55e3,0x55c7,0x55aa,0x558e,0x5571
-	.word 0x5555,0x5538,0x551c,0x5500,0x54e3,0x54c7,0x54aa,0x548e
-	.word 0x5472,0x5456,0x5439,0x541d,0x5401,0x53e5,0x53c8,0x53ac
-	.word 0x5390,0x5374,0x5358,0x533c,0x5320,0x5304,0x52e8,0x52cb
-	.word 0x52af,0x5293,0x5277,0x525c,0x5240,0x5224,0x5208,0x51ec
-	.word 0x51d0,0x51b4,0x5198,0x517c,0x5161,0x5145,0x5129,0x510d
-	.word 0x50f2,0x50d6,0x50ba,0x509f,0x5083,0x5067,0x504c,0x5030
-	.word 0x5015,0x4ff9,0x4fdd,0x4fc2,0x4fa6,0x4f8b,0x4f6f,0x4f54
-	.word 0x4f38,0x4f1d,0x4f02,0x4ee6,0x4ecb,0x4eb0,0x4e94,0x4e79
-	.word 0x4e5e,0x4e42,0x4e27,0x4e0c,0x4df0,0x4dd5,0x4dba,0x4d9f
-	.word 0x4d84,0x4d69,0x4d4d,0x4d32,0x4d17,0x4cfc,0x4ce1,0x4cc6
-	.word 0x4cab,0x4c90,0x4c75,0x4c5a,0x4c3f,0x4c24,0x4c09,0x4bee
-	.word 0x4bd3,0x4bb9,0x4b9e,0x4b83,0x4b68,0x4b4d,0x4b32,0x4b18
-	.word 0x4afd,0x4ae2,0x4ac7,0x4aad,0x4a92,0x4a77,0x4a5d,0x4a42
-	.word 0x4a27,0x4a0d,0x49f2,0x49d8,0x49bd,0x49a3,0x4988,0x496e
-	.word 0x4953,0x4939,0x491e,0x4904,0x48e9,0x48cf,0x48b5,0x489a
-	.word 0x4880,0x4865,0x484b,0x4831,0x4817,0x47fc,0x47e2,0x47c8
-	.word 0x47ae,0x4793,0x4779,0x475f,0x4745,0x472b,0x4711,0x46f6
-	.word 0x46dc,0x46c2,0x46a8,0x468e,0x4674,0x465a,0x4640,0x4626
-	.word 0x460c,0x45f2,0x45d8,0x45be,0x45a5,0x458b,0x4571,0x4557
-	.word 0x453d,0x4523,0x4509,0x44f0,0x44d6,0x44bc,0x44a2,0x4489
-	.word 0x446f,0x4455,0x443c,0x4422,0x4408,0x43ef,0x43d5,0x43bc
-	.word 0x43a2,0x4388,0x436f,0x4355,0x433c,0x4322,0x4309,0x42ef
-	.word 0x42d6,0x42bc,0x42a3,0x428a,0x4270,0x4257,0x423d,0x4224
-	.word 0x420b,0x41f2,0x41d8,0x41bf,0x41a6,0x418c,0x4173,0x415a
-	.word 0x4141,0x4128,0x410e,0x40f5,0x40dc,0x40c3,0x40aa,0x4091
-	.word 0x4078,0x405f,0x4046,0x402d,0x4014,0x3ffb,0x3fe2,0x3fc9
-	.word 0x3fb0,0x3f97,0x3f7e,0x3f65,0x3f4c,0x3f33,0x3f1a,0x3f01
-	.word 0x3ee8,0x3ed0,0x3eb7,0x3e9e,0x3e85,0x3e6c,0x3e54,0x3e3b
-	.word 0x3e22,0x3e0a,0x3df1,0x3dd8,0x3dc0,0x3da7,0x3d8e,0x3d76
-	.word 0x3d5d,0x3d45,0x3d2c,0x3d13,0x3cfb,0x3ce2,0x3cca,0x3cb1
-	.word 0x3c99,0x3c80,0x3c68,0x3c50,0x3c37,0x3c1f,0x3c06,0x3bee
-	.word 0x3bd6,0x3bbd,0x3ba5,0x3b8d,0x3b74,0x3b5c,0x3b44,0x3b2b
-	.word 0x3b13,0x3afb,0x3ae3,0x3acb,0x3ab2,0x3a9a,0x3a82,0x3a6a
-	.word 0x3a52,0x3a3a,0x3a22,0x3a09,0x39f1,0x39d9,0x39c1,0x39a9
-	.word 0x3991,0x3979,0x3961,0x3949,0x3931,0x3919,0x3901,0x38ea
-	.word 0x38d2,0x38ba,0x38a2,0x388a,0x3872,0x385a,0x3843,0x382b
-	.word 0x3813,0x37fb,0x37e3,0x37cc,0x37b4,0x379c,0x3785,0x376d
-	.word 0x3755,0x373e,0x3726,0x370e,0x36f7,0x36df,0x36c8,0x36b0
-	.word 0x3698,0x3681,0x3669,0x3652,0x363a,0x3623,0x360b,0x35f4
-	.word 0x35dc,0x35c5,0x35ae,0x3596,0x357f,0x3567,0x3550,0x3539
-	.word 0x3521,0x350a,0x34f3,0x34db,0x34c4,0x34ad,0x3496,0x347e
-	.word 0x3467,0x3450,0x3439,0x3422,0x340a,0x33f3,0x33dc,0x33c5
-	.word 0x33ae,0x3397,0x3380,0x3368,0x3351,0x333a,0x3323,0x330c
-	.word 0x32f5,0x32de,0x32c7,0x32b0,0x3299,0x3282,0x326c,0x3255
-	.word 0x323e,0x3227,0x3210,0x31f9,0x31e2,0x31cb,0x31b5,0x319e
-	.word 0x3187,0x3170,0x3159,0x3143,0x312c,0x3115,0x30fe,0x30e8
-	.word 0x30d1,0x30ba,0x30a4,0x308d,0x3076,0x3060,0x3049,0x3033
-	.word 0x301c,0x3005,0x2fef,0x2fd8,0x2fc2,0x2fab,0x2f95,0x2f7e
-	.word 0x2f68,0x2f51,0x2f3b,0x2f24,0x2f0e,0x2ef8,0x2ee1,0x2ecb
-	.word 0x2eb4,0x2e9e,0x2e88,0x2e71,0x2e5b,0x2e45,0x2e2e,0x2e18
-	.word 0x2e02,0x2dec,0x2dd5,0x2dbf,0x2da9,0x2d93,0x2d7c,0x2d66
-	.word 0x2d50,0x2d3a,0x2d24,0x2d0e,0x2cf8,0x2ce1,0x2ccb,0x2cb5
-	.word 0x2c9f,0x2c89,0x2c73,0x2c5d,0x2c47,0x2c31,0x2c1b,0x2c05
-	.word 0x2bef,0x2bd9,0x2bc3,0x2bad,0x2b97,0x2b81,0x2b6c,0x2b56
-	.word 0x2b40,0x2b2a,0x2b14,0x2afe,0x2ae8,0x2ad3,0x2abd,0x2aa7
-	.word 0x2a91,0x2a7c,0x2a66,0x2a50,0x2a3a,0x2a25,0x2a0f,0x29f9
-	.word 0x29e4,0x29ce,0x29b8,0x29a3,0x298d,0x2977,0x2962,0x294c
-	.word 0x2937,0x2921,0x290c,0x28f6,0x28e0,0x28cb,0x28b5,0x28a0
-	.word 0x288b,0x2875,0x2860,0x284a,0x2835,0x281f,0x280a,0x27f5
-	.word 0x27df,0x27ca,0x27b4,0x279f,0x278a,0x2774,0x275f,0x274a
-	.word 0x2735,0x271f,0x270a,0x26f5,0x26e0,0x26ca,0x26b5,0x26a0
-	.word 0x268b,0x2676,0x2660,0x264b,0x2636,0x2621,0x260c,0x25f7
-	.word 0x25e2,0x25cd,0x25b8,0x25a2,0x258d,0x2578,0x2563,0x254e
-	.word 0x2539,0x2524,0x250f,0x24fa,0x24e5,0x24d1,0x24bc,0x24a7
-	.word 0x2492,0x247d,0x2468,0x2453,0x243e,0x2429,0x2415,0x2400
-	.word 0x23eb,0x23d6,0x23c1,0x23ad,0x2398,0x2383,0x236e,0x235a
-	.word 0x2345,0x2330,0x231c,0x2307,0x22f2,0x22dd,0x22c9,0x22b4
-	.word 0x22a0,0x228b,0x2276,0x2262,0x224d,0x2239,0x2224,0x2210
-	.word 0x21fb,0x21e6,0x21d2,0x21bd,0x21a9,0x2194,0x2180,0x216c
-	.word 0x2157,0x2143,0x212e,0x211a,0x2105,0x20f1,0x20dd,0x20c8
-	.word 0x20b4,0x20a0,0x208b,0x2077,0x2063,0x204e,0x203a,0x2026
-	.word 0x2012,0x1ffd,0x1fe9,0x1fd5,0x1fc1,0x1fac,0x1f98,0x1f84
-	.word 0x1f70,0x1f5c,0x1f47,0x1f33,0x1f1f,0x1f0b,0x1ef7,0x1ee3
-	.word 0x1ecf,0x1ebb,0x1ea7,0x1e93,0x1e7f,0x1e6a,0x1e56,0x1e42
-	.word 0x1e2e,0x1e1a,0x1e06,0x1df3,0x1ddf,0x1dcb,0x1db7,0x1da3
-	.word 0x1d8f,0x1d7b,0x1d67,0x1d53,0x1d3f,0x1d2b,0x1d18,0x1d04
-	.word 0x1cf0,0x1cdc,0x1cc8,0x1cb5,0x1ca1,0x1c8d,0x1c79,0x1c65
-	.word 0x1c52,0x1c3e,0x1c2a,0x1c17,0x1c03,0x1bef,0x1bdb,0x1bc8
-	.word 0x1bb4,0x1ba0,0x1b8d,0x1b79,0x1b66,0x1b52,0x1b3e,0x1b2b
-	.word 0x1b17,0x1b04,0x1af0,0x1add,0x1ac9,0x1ab6,0x1aa2,0x1a8f
-	.word 0x1a7b,0x1a68,0x1a54,0x1a41,0x1a2d,0x1a1a,0x1a06,0x19f3
-	.word 0x19e0,0x19cc,0x19b9,0x19a5,0x1992,0x197f,0x196b,0x1958
-	.word 0x1945,0x1931,0x191e,0x190b,0x18f8,0x18e4,0x18d1,0x18be
-	.word 0x18ab,0x1897,0x1884,0x1871,0x185e,0x184b,0x1837,0x1824
-	.word 0x1811,0x17fe,0x17eb,0x17d8,0x17c4,0x17b1,0x179e,0x178b
-	.word 0x1778,0x1765,0x1752,0x173f,0x172c,0x1719,0x1706,0x16f3
-	.word 0x16e0,0x16cd,0x16ba,0x16a7,0x1694,0x1681,0x166e,0x165b
-	.word 0x1648,0x1635,0x1623,0x1610,0x15fd,0x15ea,0x15d7,0x15c4
-	.word 0x15b1,0x159f,0x158c,0x1579,0x1566,0x1553,0x1541,0x152e
-	.word 0x151b,0x1508,0x14f6,0x14e3,0x14d0,0x14bd,0x14ab,0x1498
-	.word 0x1485,0x1473,0x1460,0x144d,0x143b,0x1428,0x1416,0x1403
-	.word 0x13f0,0x13de,0x13cb,0x13b9,0x13a6,0x1394,0x1381,0x136f
-	.word 0x135c,0x1349,0x1337,0x1325,0x1312,0x1300,0x12ed,0x12db
-	.word 0x12c8,0x12b6,0x12a3,0x1291,0x127f,0x126c,0x125a,0x1247
-	.word 0x1235,0x1223,0x1210,0x11fe,0x11ec,0x11d9,0x11c7,0x11b5
-	.word 0x11a3,0x1190,0x117e,0x116c,0x1159,0x1147,0x1135,0x1123
-	.word 0x1111,0x10fe,0x10ec,0x10da,0x10c8,0x10b6,0x10a4,0x1091
-	.word 0x107f,0x106d,0x105b,0x1049,0x1037,0x1025,0x1013,0x1001
-	.word 0x0fef,0x0fdc,0x0fca,0x0fb8,0x0fa6,0x0f94,0x0f82,0x0f70
-	.word 0x0f5e,0x0f4c,0x0f3a,0x0f28,0x0f17,0x0f05,0x0ef3,0x0ee1
-	.word 0x0ecf,0x0ebd,0x0eab,0x0e99,0x0e87,0x0e75,0x0e64,0x0e52
-	.word 0x0e40,0x0e2e,0x0e1c,0x0e0a,0x0df9,0x0de7,0x0dd5,0x0dc3
-	.word 0x0db2,0x0da0,0x0d8e,0x0d7c,0x0d6b,0x0d59,0x0d47,0x0d35
-	.word 0x0d24,0x0d12,0x0d00,0x0cef,0x0cdd,0x0ccb,0x0cba,0x0ca8
-	.word 0x0c97,0x0c85,0x0c73,0x0c62,0x0c50,0x0c3f,0x0c2d,0x0c1c
-	.word 0x0c0a,0x0bf8,0x0be7,0x0bd5,0x0bc4,0x0bb2,0x0ba1,0x0b8f
-	.word 0x0b7e,0x0b6c,0x0b5b,0x0b4a,0x0b38,0x0b27,0x0b15,0x0b04
-	.word 0x0af2,0x0ae1,0x0ad0,0x0abe,0x0aad,0x0a9c,0x0a8a,0x0a79
-	.word 0x0a68,0x0a56,0x0a45,0x0a34,0x0a22,0x0a11,0x0a00,0x09ee
-	.word 0x09dd,0x09cc,0x09bb,0x09a9,0x0998,0x0987,0x0976,0x0965
-	.word 0x0953,0x0942,0x0931,0x0920,0x090f,0x08fe,0x08ec,0x08db
-	.word 0x08ca,0x08b9,0x08a8,0x0897,0x0886,0x0875,0x0864,0x0853
-	.word 0x0842,0x0831,0x081f,0x080e,0x07fd,0x07ec,0x07db,0x07ca
-	.word 0x07b9,0x07a8,0x0798,0x0787,0x0776,0x0765,0x0754,0x0743
-	.word 0x0732,0x0721,0x0710,0x06ff,0x06ee,0x06dd,0x06cd,0x06bc
-	.word 0x06ab,0x069a,0x0689,0x0678,0x0668,0x0657,0x0646,0x0635
-	.word 0x0624,0x0614,0x0603,0x05f2,0x05e1,0x05d1,0x05c0,0x05af
-	.word 0x059e,0x058e,0x057d,0x056c,0x055c,0x054b,0x053a,0x052a
-	.word 0x0519,0x0508,0x04f8,0x04e7,0x04d6,0x04c6,0x04b5,0x04a5
-	.word 0x0494,0x0484,0x0473,0x0462,0x0452,0x0441,0x0431,0x0420
-	.word 0x0410,0x03ff,0x03ef,0x03de,0x03ce,0x03bd,0x03ad,0x039c
-	.word 0x038c,0x037b,0x036b,0x035b,0x034a,0x033a,0x0329,0x0319
-	.word 0x0309,0x02f8,0x02e8,0x02d7,0x02c7,0x02b7,0x02a6,0x0296
-	.word 0x0286,0x0275,0x0265,0x0255,0x0245,0x0234,0x0224,0x0214
-	.word 0x0204,0x01f3,0x01e3,0x01d3,0x01c3,0x01b2,0x01a2,0x0192
-	.word 0x0182,0x0172,0x0161,0x0151,0x0141,0x0131,0x0121,0x0111
-	.word 0x0101,0x00f0,0x00e0,0x00d0,0x00c0,0x00b0,0x00a0,0x0090
-	.word 0x0080,0x0070,0x0060,0x0050,0x0040,0x0030,0x0020,0x0010
-DATAEND()
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/lshift.asm b/ghc/rts/gmp/mpn/alpha/lshift.asm
deleted file mode 100644
index 87c46f6fe7..0000000000
--- a/ghc/rts/gmp/mpn/alpha/lshift.asm
+++ /dev/null
@@ -1,104 +0,0 @@
-dnl  Alpha mpn_lshift -- Shift a number left.
-
-dnl  Copyright (C) 1994, 1995, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  INPUT PARAMETERS
-dnl  res_ptr	r16
-dnl  s1_ptr	r17
-dnl  size	r18
-dnl  cnt	r19
-
-dnl  This code runs at 4.8 cycles/limb on the 21064.  With infinite unrolling,
-dnl  it would take 4 cycles/limb.  It should be possible to get down to 3
-dnl  cycles/limb since both ldq and stq can be paired with the other used
-dnl  instructions.  But there are many restrictions in the 21064 pipeline that
-dnl  makes it hard, if not impossible, to get down to 3 cycles/limb:
-
-dnl  1. ldq has a 3 cycle delay, srl and sll have a 2 cycle delay.
-dnl  2. Only aligned instruction pairs can be paired.
-dnl  3. The store buffer or silo might not be able to deal with the bandwidth.
-
-ASM_START()
-PROLOGUE(mpn_lshift)
-	s8addq	r18,r17,r17	C make r17 point at end of s1
-	ldq	r4,-8(r17)	C load first limb
-	subq	r17,8,r17
-	subq	r31,r19,r7
-	s8addq	r18,r16,r16	C make r16 point at end of RES
-	subq	r18,1,r18
-	and	r18,4-1,r20	C number of limbs in first loop
-	srl	r4,r7,r0	C compute function result
-
-	beq	r20,$L0
-	subq	r18,r20,r18
-
-	ALIGN(8)
-$Loop0:
-	ldq	r3,-8(r17)
-	subq	r16,8,r16
-	subq	r17,8,r17
-	subq	r20,1,r20
-	sll	r4,r19,r5
-	srl	r3,r7,r6
-	bis	r3,r3,r4
-	bis	r5,r6,r8
-	stq	r8,0(r16)
-	bne	r20,$Loop0
-
-$L0:	beq	r18,$Lend
-
-	ALIGN(8)
-$Loop:	ldq	r3,-8(r17)
-	subq	r16,32,r16
-	subq	r18,4,r18
-	sll	r4,r19,r5
-	srl	r3,r7,r6
-
-	ldq	r4,-16(r17)
-	sll	r3,r19,r1
-	bis	r5,r6,r8
-	stq	r8,24(r16)
-	srl	r4,r7,r2
-
-	ldq	r3,-24(r17)
-	sll	r4,r19,r5
-	bis	r1,r2,r8
-	stq	r8,16(r16)
-	srl	r3,r7,r6
-
-	ldq	r4,-32(r17)
-	sll	r3,r19,r1
-	bis	r5,r6,r8
-	stq	r8,8(r16)
-	srl	r4,r7,r2
-
-	subq	r17,32,r17
-	bis	r1,r2,r8
-	stq	r8,0(r16)
-
-	bgt	r18,$Loop
-
-$Lend:	sll	r4,r19,r8
-	stq	r8,-8(r16)
-	ret	r31,(r26),1
-EPILOGUE(mpn_lshift)
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/mul_1.asm b/ghc/rts/gmp/mpn/alpha/mul_1.asm
deleted file mode 100644
index 46b8df34f5..0000000000
--- a/ghc/rts/gmp/mpn/alpha/mul_1.asm
+++ /dev/null
@@ -1,71 +0,0 @@
-dnl  Alpha __gmpn_mul_1 -- Multiply a limb vector with a limb and store
-dnl  the result in a second limb vector.
-
-dnl  Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  INPUT PARAMETERS
-dnl  res_ptr	r16
-dnl  s1_ptr	r17
-dnl  size	r18
-dnl  s2_limb	r19
-
-dnl  This code runs at 42 cycles/limb on EV4, 18 cycles/limb on EV5, and 7
-dnl  cycles/limb on EV6.
-
-ASM_START()
-PROLOGUE(mpn_mul_1)
-	ldq	r2,0(r17)	C r2 = s1_limb
-	subq	r18,1,r18	C size--
-	mulq	r2,r19,r3	C r3 = prod_low
-	bic	r31,r31,r4	C clear cy_limb
-	umulh	r2,r19,r0	C r0 = prod_high
-	beq	r18,$Lend1	C jump if size was == 1
-	ldq	r2,8(r17)	C r2 = s1_limb
-	subq	r18,1,r18	C size--
-	stq	r3,0(r16)
-	beq	r18,$Lend2	C jump if size was == 2
-
-	ALIGN(8)
-$Loop:	mulq	r2,r19,r3	C r3 = prod_low
-	addq	r4,r0,r0	C cy_limb = cy_limb + 'cy'
-	subq	r18,1,r18	C size--
-	umulh	r2,r19,r4	C r4 = cy_limb
-	ldq	r2,16(r17)	C r2 = s1_limb
-	addq	r17,8,r17	C s1_ptr++
-	addq	r3,r0,r3	C r3 = cy_limb + prod_low
-	stq	r3,8(r16)
-	cmpult	r3,r0,r0	C r0 = carry from (cy_limb + prod_low)
-	addq	r16,8,r16	C res_ptr++
-	bne	r18,$Loop
-
-$Lend2:	mulq	r2,r19,r3	C r3 = prod_low
-	addq	r4,r0,r0	C cy_limb = cy_limb + 'cy'
-	umulh	r2,r19,r4	C r4 = cy_limb
-	addq	r3,r0,r3	C r3 = cy_limb + prod_low
-	cmpult	r3,r0,r0	C r0 = carry from (cy_limb + prod_low)
-	stq	r3,8(r16)
-	addq	r4,r0,r0	C cy_limb = prod_high + cy
-	ret	r31,(r26),1
-$Lend1:	stq	r3,0(r16)
-	ret	r31,(r26),1
-EPILOGUE(mpn_mul_1)
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/rshift.asm b/ghc/rts/gmp/mpn/alpha/rshift.asm
deleted file mode 100644
index aa25eda54e..0000000000
--- a/ghc/rts/gmp/mpn/alpha/rshift.asm
+++ /dev/null
@@ -1,102 +0,0 @@
-dnl  Alpha mpn_rshift -- Shift a number right.
-
-dnl  Copyright (C) 1994, 1995, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  INPUT PARAMETERS
-dnl  res_ptr	r16
-dnl  s1_ptr	r17
-dnl  size	r18
-dnl  cnt	r19
-
-dnl  This code runs at 4.8 cycles/limb on the 21064.  With infinite unrolling,
-dnl  it would take 4 cycles/limb.  It should be possible to get down to 3
-dnl  cycles/limb since both ldq and stq can be paired with the other used
-dnl  instructions.  But there are many restrictions in the 21064 pipeline that
-dnl  makes it hard, if not impossible, to get down to 3 cycles/limb:
-
-dnl  1. ldq has a 3 cycle delay, srl and sll have a 2 cycle delay.
-dnl  2. Only aligned instruction pairs can be paired.
-dnl  3. The store buffer or silo might not be able to deal with the bandwidth.
-
-ASM_START()
-PROLOGUE(mpn_rshift)
-	ldq	r4,0(r17)	C load first limb
-	addq	r17,8,r17
-	subq	r31,r19,r7
-	subq	r18,1,r18
-	and	r18,4-1,r20	C number of limbs in first loop
-	sll	r4,r7,r0	C compute function result
-
-	beq	r20,$L0
-	subq	r18,r20,r18
-
-	ALIGN(8)
-$Loop0:
-	ldq	r3,0(r17)
-	addq	r16,8,r16
-	addq	r17,8,r17
-	subq	r20,1,r20
-	srl	r4,r19,r5
-	sll	r3,r7,r6
-	bis	r3,r3,r4
-	bis	r5,r6,r8
-	stq	r8,-8(r16)
-	bne	r20,$Loop0
-
-$L0:	beq	r18,$Lend
-
-	ALIGN(8)
-$Loop:	ldq	r3,0(r17)
-	addq	r16,32,r16
-	subq	r18,4,r18
-	srl	r4,r19,r5
-	sll	r3,r7,r6
-
-	ldq	r4,8(r17)
-	srl	r3,r19,r1
-	bis	r5,r6,r8
-	stq	r8,-32(r16)
-	sll	r4,r7,r2
-
-	ldq	r3,16(r17)
-	srl	r4,r19,r5
-	bis	r1,r2,r8
-	stq	r8,-24(r16)
-	sll	r3,r7,r6
-
-	ldq	r4,24(r17)
-	srl	r3,r19,r1
-	bis	r5,r6,r8
-	stq	r8,-16(r16)
-	sll	r4,r7,r2
-
-	addq	r17,32,r17
-	bis	r1,r2,r8
-	stq	r8,-8(r16)
-
-	bgt	r18,$Loop
-
-$Lend:	srl	r4,r19,r8
-	stq	r8,0(r16)
-	ret	r31,(r26),1
-EPILOGUE(mpn_rshift)
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/sub_n.asm b/ghc/rts/gmp/mpn/alpha/sub_n.asm
deleted file mode 100644
index 718f657141..0000000000
--- a/ghc/rts/gmp/mpn/alpha/sub_n.asm
+++ /dev/null
@@ -1,114 +0,0 @@
-dnl  Alpha mpn_sub_n -- Subtract two limb vectors of the same length > 0 and
-dnl  store difference in a third limb vector.
-
-dnl  Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  INPUT PARAMETERS
-dnl  res_ptr	r16
-dnl  s1_ptr	r17
-dnl  s2_ptr	r18
-dnl  size	r19
-
-ASM_START()
-PROLOGUE(mpn_sub_n)
-	ldq	r3,0(r17)
-	ldq	r4,0(r18)
-
-	subq	r19,1,r19
-	and	r19,4-1,r2	C number of limbs in first loop
-	bis	r31,r31,r0
-	beq	r2,$L0		C if multiple of 4 limbs, skip first loop
-
-	subq	r19,r2,r19
-
-$Loop0:	subq	r2,1,r2
-	ldq	r5,8(r17)
-	addq	r4,r0,r4
-	ldq	r6,8(r18)
-	cmpult	r4,r0,r1
-	subq	r3,r4,r4
-	cmpult	r3,r4,r0
-	stq	r4,0(r16)
-	bis	r0,r1,r0
-
-	addq	r17,8,r17
-	addq	r18,8,r18
-	bis	r5,r5,r3
-	bis	r6,r6,r4
-	addq	r16,8,r16
-	bne	r2,$Loop0
-
-$L0:	beq	r19,$Lend
-
-	ALIGN(8)
-$Loop:	subq	r19,4,r19
-
-	ldq	r5,8(r17)
-	addq	r4,r0,r4
-	ldq	r6,8(r18)
-	cmpult	r4,r0,r1
-	subq	r3,r4,r4
-	cmpult	r3,r4,r0
-	stq	r4,0(r16)
-	bis	r0,r1,r0
-
-	ldq	r3,16(r17)
-	addq	r6,r0,r6
-	ldq	r4,16(r18)
-	cmpult	r6,r0,r1
-	subq	r5,r6,r6
-	cmpult	r5,r6,r0
-	stq	r6,8(r16)
-	bis	r0,r1,r0
-
-	ldq	r5,24(r17)
-	addq	r4,r0,r4
-	ldq	r6,24(r18)
-	cmpult	r4,r0,r1
-	subq	r3,r4,r4
-	cmpult	r3,r4,r0
-	stq	r4,16(r16)
-	bis	r0,r1,r0
-
-	ldq	r3,32(r17)
-	addq	r6,r0,r6
-	ldq	r4,32(r18)
-	cmpult	r6,r0,r1
-	subq	r5,r6,r6
-	cmpult	r5,r6,r0
-	stq	r6,24(r16)
-	bis	r0,r1,r0
-
-	addq	r17,32,r17
-	addq	r18,32,r18
-	addq	r16,32,r16
-	bne	r19,$Loop
-
-$Lend:	addq	r4,r0,r4
-	cmpult	r4,r0,r1
-	subq	r3,r4,r4
-	cmpult	r3,r4,r0
-	stq	r4,0(r16)
-	bis	r0,r1,r0
-	ret	r31,(r26),1
-EPILOGUE(mpn_sub_n)
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/submul_1.asm b/ghc/rts/gmp/mpn/alpha/submul_1.asm
deleted file mode 100644
index caec1a720b..0000000000
--- a/ghc/rts/gmp/mpn/alpha/submul_1.asm
+++ /dev/null
@@ -1,87 +0,0 @@
-dnl  Alpha __gmpn_submul_1 -- Multiply a limb vector with a limb and
-dnl  subtract the result from a second limb vector.
-
-dnl  Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-dnl  INPUT PARAMETERS
-dnl  res_ptr	r16
-dnl  s1_ptr	r17
-dnl  size	r18
-dnl  s2_limb	r19
-
-dnl  This code runs at 42 cycles/limb on EV4, 18 cycles/limb on EV5, and 7
-dnl  cycles/limb on EV6.
-
-ASM_START()
-PROLOGUE(mpn_submul_1)
-	ldq	r2,0(r17)	C r2 = s1_limb
-	addq	r17,8,r17	C s1_ptr++
-	subq	r18,1,r18	C size--
-	mulq	r2,r19,r3	C r3 = prod_low
-	ldq	r5,0(r16)	C r5 = *res_ptr
-	umulh	r2,r19,r0	C r0 = prod_high
-	beq	r18,$Lend1	C jump if size was == 1
-	ldq	r2,0(r17)	C r2 = s1_limb
-	addq	r17,8,r17	C s1_ptr++
-	subq	r18,1,r18	C size--
-	subq	r5,r3,r3
-	cmpult	r5,r3,r4
-	stq	r3,0(r16)
-	addq	r16,8,r16	C res_ptr++
-	beq	r18,$Lend2	C jump if size was == 2
-
-	ALIGN(8)
-$Loop:	mulq	r2,r19,r3	C r3 = prod_low
-	ldq	r5,0(r16)	C r5 = *res_ptr
-	addq	r4,r0,r0	C cy_limb = cy_limb + 'cy'
-	subq	r18,1,r18	C size--
-	umulh	r2,r19,r4	C r4 = cy_limb
-	ldq	r2,0(r17)	C r2 = s1_limb
-	addq	r17,8,r17	C s1_ptr++
-	addq	r3,r0,r3	C r3 = cy_limb + prod_low
-	cmpult	r3,r0,r0	C r0 = carry from (cy_limb + prod_low)
-	subq	r5,r3,r3
-	cmpult	r5,r3,r5
-	stq	r3,0(r16)
-	addq	r16,8,r16	C res_ptr++
-	addq	r5,r0,r0	C combine carries
-	bne	r18,$Loop
-
-$Lend2:	mulq	r2,r19,r3	C r3 = prod_low
-	ldq	r5,0(r16)	C r5 = *res_ptr
-	addq	r4,r0,r0	C cy_limb = cy_limb + 'cy'
-	umulh	r2,r19,r4	C r4 = cy_limb
-	addq	r3,r0,r3	C r3 = cy_limb + prod_low
-	cmpult	r3,r0,r0	C r0 = carry from (cy_limb + prod_low)
-	subq	r5,r3,r3
-	cmpult	r5,r3,r5
-	stq	r3,0(r16)
-	addq	r5,r0,r0	C combine carries
-	addq	r4,r0,r0	C cy_limb = prod_high + cy
-	ret	r31,(r26),1
-$Lend1:	subq	r5,r3,r3
-	cmpult	r5,r3,r5
-	stq	r3,0(r16)
-	addq	r0,r5,r0
-	ret	r31,(r26),1
-EPILOGUE(mpn_submul_1)
-ASM_END()
diff --git a/ghc/rts/gmp/mpn/alpha/udiv_qrnnd.S b/ghc/rts/gmp/mpn/alpha/udiv_qrnnd.S
deleted file mode 100644
index 53814bbcb0..0000000000
--- a/ghc/rts/gmp/mpn/alpha/udiv_qrnnd.S
+++ /dev/null
@@ -1,151 +0,0 @@
- # Alpha 21064 __udiv_qrnnd
-
- # Copyright (C) 1992, 1994, 1995, 1997, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
-	.set noreorder
-	.set noat
-.text
-	.align	3
-	.globl	__gmpn_udiv_qrnnd
-	.ent	__gmpn_udiv_qrnnd
-__gmpn_udiv_qrnnd:
-	.frame $30,0,$26,0
-	.prologue 0
-#define cnt	$2
-#define tmp	$3
-#define rem_ptr	$16
-#define n1	$17
-#define n0	$18
-#define d	$19
-#define qb	$20
-
-	ldiq	cnt,16
-	blt	d,.Largedivisor
-
-.Loop1:	cmplt	n0,0,tmp
-	addq	n1,n1,n1
-	bis	n1,tmp,n1
-	addq	n0,n0,n0
-	cmpule	d,n1,qb
-	subq	n1,d,tmp
-	cmovne	qb,tmp,n1
-	bis	n0,qb,n0
-	cmplt	n0,0,tmp
-	addq	n1,n1,n1
-	bis	n1,tmp,n1
-	addq	n0,n0,n0
-	cmpule	d,n1,qb
-	subq	n1,d,tmp
-	cmovne	qb,tmp,n1
-	bis	n0,qb,n0
-	cmplt	n0,0,tmp
-	addq	n1,n1,n1
-	bis	n1,tmp,n1
-	addq	n0,n0,n0
-	cmpule	d,n1,qb
-	subq	n1,d,tmp
-	cmovne	qb,tmp,n1
-	bis	n0,qb,n0
-	cmplt	n0,0,tmp
-	addq	n1,n1,n1
-	bis	n1,tmp,n1
-	addq	n0,n0,n0
-	cmpule	d,n1,qb
-	subq	n1,d,tmp
-	cmovne	qb,tmp,n1
-	bis	n0,qb,n0
-	subq	cnt,1,cnt
-	bgt	cnt,.Loop1
-	stq	n1,0(rem_ptr)
-	bis	$31,n0,$0
-	ret	$31,($26),1
-
-.Largedivisor:
-	and	n0,1,$4
-
-	srl	n0,1,n0
-	sll	n1,63,tmp
-	or	tmp,n0,n0
-	srl	n1,1,n1
-
-	and	d,1,$6
-	srl	d,1,$5
-	addq	$5,$6,$5
-
-.Loop2:	cmplt	n0,0,tmp
-	addq	n1,n1,n1
-	bis	n1,tmp,n1
-	addq	n0,n0,n0
-	cmpule	$5,n1,qb
-	subq	n1,$5,tmp
-	cmovne	qb,tmp,n1
-	bis	n0,qb,n0
-	cmplt	n0,0,tmp
-	addq	n1,n1,n1
-	bis	n1,tmp,n1
-	addq	n0,n0,n0
-	cmpule	$5,n1,qb
-	subq	n1,$5,tmp
-	cmovne	qb,tmp,n1
-	bis	n0,qb,n0
-	cmplt	n0,0,tmp
-	addq	n1,n1,n1
-	bis	n1,tmp,n1
-	addq	n0,n0,n0
-	cmpule	$5,n1,qb
-	subq	n1,$5,tmp
-	cmovne	qb,tmp,n1
-	bis	n0,qb,n0
-	cmplt	n0,0,tmp
-	addq	n1,n1,n1
-	bis	n1,tmp,n1
-	addq	n0,n0,n0
-	cmpule	$5,n1,qb
-	subq	n1,$5,tmp
-	cmovne	qb,tmp,n1
-	bis	n0,qb,n0
-	subq	cnt,1,cnt
-	bgt	cnt,.Loop2
-
-	addq	n1,n1,n1
-	addq	$4,n1,n1
-	bne	$6,.LOdd
-	stq	n1,0(rem_ptr)
-	bis	$31,n0,$0
-	ret	$31,($26),1
-
-.LOdd:
-	/* q' in n0. r' in n1 */
-	addq	n1,n0,n1
-	cmpult	n1,n0,tmp	# tmp := carry from addq
-	beq	tmp,.LLp6
-	addq	n0,1,n0
-	subq	n1,d,n1
-.LLp6:	cmpult	n1,d,tmp
-	bne	tmp,.LLp7
-	addq	n0,1,n0
-	subq	n1,d,n1
-.LLp7:
-	stq	n1,0(rem_ptr)
-	bis	$31,n0,$0
-	ret	$31,($26),1
-
-	.end	__gmpn_udiv_qrnnd
diff --git a/ghc/rts/gmp/mpn/alpha/umul.asm b/ghc/rts/gmp/mpn/alpha/umul.asm
deleted file mode 100644
index 44428ed5f5..0000000000
--- a/ghc/rts/gmp/mpn/alpha/umul.asm
+++ /dev/null
@@ -1,39 +0,0 @@
-dnl  Currently unused.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published by
-dnl  the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl  option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-	.set noreorder
-	.set volatile
-	.set noat
-
-.text
-	.align 3
-	.globl __umul_ppmm
-	.ent __umul_ppmm
-__umul_ppmm:
-__umul_ppmm..ng:
-	.frame $30,0,$26,0
-	.prologue 0
-	mulq $17,$18,$1
-	umulh $17,$18,$0
-	stq $1,0($16)
-	ret $31,($26),1
-	.end __umul_ppmm
diff --git a/ghc/rts/gmp/mpn/alpha/unicos.m4 b/ghc/rts/gmp/mpn/alpha/unicos.m4
deleted file mode 100644
index 7ff26c090c..0000000000
--- a/ghc/rts/gmp/mpn/alpha/unicos.m4
+++ /dev/null
@@ -1,63 +0,0 @@
-divert(-1)
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-define(`ASM_START',
-	`.ident	dummy')
-
-define(`X',`^X$1')
-define(`FLOAT64',
-	`dnl
-	.psect	$1@crud,data
-$1:	.t_floating $2
-	.endp')
-
-define(`PROLOGUE',
-	`dnl
-	.stack	192		; What does this mean?  Only Cray knows.
-	.psect	$1@code,code,cache
-$1::')
-define(`PROLOGUE_GP', `PROLOGUE($1)')
-
-define(`EPILOGUE',
-	`dnl
-	.endp')
-
-define(`DATASTART',
-	`dnl
-	.psect	$1@crud,data
-$1:')
-define(`DATAEND',
-	`dnl
-	.endp')
-
-define(`ASM_END',
-	`dnl
-	.end')
-
-define(`unop',`bis r31,r31,r31') ; Unicos assembler lacks unop
-define(`cvttqc',`cvttq/c')
-
-define(`ALIGN',`')		; Unicos assembler seems to align using garbage
-
-divert
-
diff --git a/ghc/rts/gmp/mpn/arm/add_n.S b/ghc/rts/gmp/mpn/arm/add_n.S
deleted file mode 100644
index fb3f8f703b..0000000000
--- a/ghc/rts/gmp/mpn/arm/add_n.S
+++ /dev/null
@@ -1,77 +0,0 @@
-@ ARM mpn_add -- Add two limb vectors of the same length > 0 and store sum in
-@ a third limb vector.
-@ Contributed by Robert Harley.
-
-@ Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-@ This file is part of the GNU MP Library.
-
-@ The GNU MP Library is free software; you can redistribute it and/or modify
-@ it under the terms of the GNU Lesser General Public License as published by
-@ the Free Software Foundation; either version 2.1 of the License, or (at your
-@ option) any later version.
-
-@ The GNU MP Library is distributed in the hope that it will be useful, but
-@ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-@ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-@ License for more details.
-
-@ You should have received a copy of the GNU Lesser General Public License
-@ along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-@ MA 02111-1307, USA.
-
-#define s r0
-#define a r1
-#define b r2
-#define n r3
-
-#define sl r10
-#define fp r11
-#define ip r12
-#define sp r13
-#define lr r14
-#define pc r15
-
-.text
-	.align	0
-	.global __gmpn_add_n
-	.type	__gmpn_add_n,%function
-__gmpn_add_n:
-	stmfd	sp!, { r8, r9, lr }
-	movs	n, n, lsr #1
-	bcc	skip1
-	ldr	ip, [a], #4
-	ldr	lr, [b], #4
-	adds	ip, ip, lr
-	str	ip, [s], #4
-skip1:
-	tst	n, #1
-	beq	skip2
-	ldmia	a!, { r8, r9 }
-	ldmia	b!, { ip, lr }
-	adcs	r8, r8, ip
-	adcs	r9, r9, lr
-	stmia	s!, { r8, r9 }
-skip2:
-	bics	n, n, #1
-	beq	return
-	stmfd	sp!, { r4, r5, r6, r7 }
-add_n_loop:
-	ldmia	a!, { r4, r5, r6, r7 }
-	ldmia	b!, { r8, r9, ip, lr }
-	adcs	r4, r4, r8
-	ldr	r8, [s] /* Bring stuff into cache. */
-	adcs	r5, r5, r9
-	adcs	r6, r6, ip
-	adcs	r7, r7, lr
-	stmia	s!, { r4, r5, r6, r7 }
-	sub	n, n, #2
-	teq	n, #0
-	bne	add_n_loop
-	ldmfd	sp!, { r4, r5, r6, r7 }
-return:
-	adc	r0, n, #0
-	ldmfd	sp!, { r8, r9, pc }
-end:
-	.size	__gmpn_add_n, end - __gmpn_add_n
diff --git a/ghc/rts/gmp/mpn/arm/addmul_1.S b/ghc/rts/gmp/mpn/arm/addmul_1.S
deleted file mode 100644
index 396fff77a3..0000000000
--- a/ghc/rts/gmp/mpn/arm/addmul_1.S
+++ /dev/null
@@ -1,89 +0,0 @@
-@ ARM mpn_mul_1 -- Multiply a limb vector with a limb and add the result to a
-@ second limb vector.
-@ Contributed by Robert Harley.
-
-@ Copyright (C) 1998, 2000 Free Software Foundation, Inc.
-
-@ This file is part of the GNU MP Library.
-
-@ The GNU MP Library is free software; you can redistribute it and/or modify
-@ it under the terms of the GNU Lesser General Public License as published by
-@ the Free Software Foundation; either version 2.1 of the License, or (at your
-@ option) any later version.
-
-@ The GNU MP Library is distributed in the hope that it will be useful, but
-@ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-@ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-@ License for more details.
-
-@ You should have received a copy of the GNU Lesser General Public License
-@ along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-@ MA 02111-1307, USA.
-
-#define p r0
-#define a r1
-#define n r2
-#define w r3
-
-#define z r11
-
-#define ip r12
-#define sp r13
-#define lr r14
-#define pc r15
-
-.text
-	.align	0
-	.global	__gmpn_addmul_1
-	.type	__gmpn_addmul_1,%function
-__gmpn_addmul_1:
-	stmfd	sp!, { r8-r11, lr }
-	mov	z, #0
-	mov	ip, #0
-	movs	n, n, lsr #1
-	bcc	skip1
-	ldr	lr, [a], #4
-	ldr	r9, [p]
-	umlal	r9, ip, w, lr
-	str	r9, [p], #4
-skip1:
-	movs	n, n, lsr #1
-	bcc	skip2
-	ldmia	p, { r9, r10 }
-	adds	r8, ip, r9
-	adc	r9, z, #0
-	ldmia	a!, { ip, lr }
-	umlal	r8, r9, w, ip
-	adds	r9, r9, r10
-	adc	ip, z, #0
-	umlal	r9, ip, w, lr
-	stmia	p!, { r8, r9 }
-skip2:
-	teq	n, #0
-	beq	return
-	stmfd	sp!, { r4-r7 }
-addmul_loop:
-	ldmia	p, { r5, r6, r7, r8 }
-	adds	r4, ip, r5
-	adc	r5, z, #0
-	ldmia	a!, { r9, r10, ip, lr }
-	umlal	r4, r5, w, r9
-	adds	r5, r5, r6
-	adc	r6, z, #0
-	umlal	r5, r6, w, r10
-	adds	r6, r6, r7
-	adc	r7, z, #0
-	umlal	r6, r7, w, ip
-	adds	r7, r7, r8
-	adc	ip, z, #0
-	umlal	r7, ip, w, lr
-	subs	n, n, #1
-	stmia	p!, { r4, r5, r6, r7 }
-	bne	addmul_loop
-	ldmfd	sp!, { r4-r7 }
-return:
-	mov	r0, ip
-	ldmfd	sp!, { r8-r11, pc }
-end:
-	.size	__gmpn_addmul_1, end - __gmpn_addmul_1
diff --git a/ghc/rts/gmp/mpn/arm/gmp-mparam.h b/ghc/rts/gmp/mpn/arm/gmp-mparam.h
deleted file mode 100644
index a35b0c7b66..0000000000
--- a/ghc/rts/gmp/mpn/arm/gmp-mparam.h
+++ /dev/null
@@ -1,34 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 32
-#define BYTES_PER_MP_LIMB 4
-#define BITS_PER_LONGINT 32
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD 21
-#endif
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD 48
-#endif
diff --git a/ghc/rts/gmp/mpn/arm/mul_1.S b/ghc/rts/gmp/mpn/arm/mul_1.S
deleted file mode 100644
index bae526a0f0..0000000000
--- a/ghc/rts/gmp/mpn/arm/mul_1.S
+++ /dev/null
@@ -1,81 +0,0 @@
-@ ARM mpn_addmul_1 -- Multiply a limb vector with a limb and store the result
-@ in a second limb vector.
-@ Contributed by Robert Harley.
-
-@ Copyright (C) 1998, 2000 Free Software Foundation, Inc.
-
-@ This file is part of the GNU MP Library.
-
-@ The GNU MP Library is free software; you can redistribute it and/or modify
-@ it under the terms of the GNU Lesser General Public License as published by
-@ the Free Software Foundation; either version 2.1 of the License, or (at your
-@ option) any later version.
-
-@ The GNU MP Library is distributed in the hope that it will be useful, but
-@ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-@ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-@ License for more details.
-
-@ You should have received a copy of the GNU Lesser General Public License
-@ along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-@ MA 02111-1307, USA.
-
-#define p r0
-#define a r1
-#define n r2
-#define w r3
-
-#define sl r10
-#define fp r11
-#define ip r12
-#define sp r13
-#define lr r14
-#define pc r15
-
-.text
-	.align	0
-	.global	__gmpn_mul_1
-	.type	__gmpn_mul_1,%function
-__gmpn_mul_1:
-	stmfd	sp!, { r8, r9, lr }
-	ands	ip, n, #1
-	beq	skip1
-	ldr	lr, [a], #4
-	umull	r9, ip, w, lr
-	str	r9, [p], #4
-skip1:
-	tst	n, #2
-	beq	skip2
-	mov	r8, ip
-	ldmia	a!, { ip, lr }
-	mov	r9, #0
-	umlal	r8, r9, w, ip
-	mov	ip, #0
-	umlal	r9, ip, w, lr
-	stmia	p!, { r8, r9 }
-skip2:
-	bics	n, n, #3
-	beq	return
-	stmfd	sp!, { r6, r7 }
-mul_1_loop:
-	mov	r6, ip
-	ldmia	a!, { r8, r9, ip, lr }
-	ldr	r7, [p] /* Bring stuff into cache. */
-	mov	r7, #0
-	umlal	r6, r7, w, r8
-	mov	r8, #0
-	umlal	r7, r8, w, r9
-	mov	r9, #0
-	umlal	r8, r9, w, ip
-	mov	ip, #0
-	umlal	r9, ip, w, lr
-	subs	n, n, #4
-	stmia	p!, { r6, r7, r8, r9 }
-	bne	mul_1_loop
-	ldmfd	sp!, { r6, r7 }
-return:
-	mov	r0, ip
-	ldmfd	sp!, { r8, r9, pc }
-end:
-	.size	__gmpn_mul_1, end - __gmpn_mul_1
diff --git a/ghc/rts/gmp/mpn/arm/sub_n.S b/ghc/rts/gmp/mpn/arm/sub_n.S
deleted file mode 100644
index 856505fe21..0000000000
--- a/ghc/rts/gmp/mpn/arm/sub_n.S
+++ /dev/null
@@ -1,79 +0,0 @@
-@ ARM mpn_sub -- Subtract two limb vectors of the same length > 0 and store
-@ difference in a third limb vector.
-@ Contributed by Robert Harley.
-
-@ Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-@ This file is part of the GNU MP Library.
-
-@ The GNU MP Library is free software; you can redistribute it and/or modify
-@ it under the terms of the GNU Lesser General Public License as published by
-@ the Free Software Foundation; either version 2.1 of the License, or (at your
-@ option) any later version.
-
-@ The GNU MP Library is distributed in the hope that it will be useful, but
-@ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-@ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-@ License for more details.
-
-@ You should have received a copy of the GNU Lesser General Public License
-@ along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-@ MA 02111-1307, USA.
-
-#define d r0
-#define a r1
-#define b r2
-#define n r3
-
-#define sl r10
-#define fp r11
-#define ip r12
-#define sp r13
-#define lr r14
-#define pc r15
-
-.text
-	.align	0
-	.global	__gmpn_sub_n
-	.type	__gmpn_sub_n,%function
-__gmpn_sub_n:
-	stmfd	sp!, { r8, r9, lr }
-	subs	ip, ip, ip
-	tst	n, #1
-	beq	skip1
-	ldr	ip, [a], #4
-	ldr	lr, [b], #4
-	subs	ip, ip, lr
-	str	ip, [d], #4
-skip1:
-	tst	n, #2
-	beq	skip2
-	ldmia	a!, { r8, r9 }
-	ldmia	b!, { ip, lr }
-	sbcs	r8, r8, ip
-	sbcs	r9, r9, lr
-	stmia	d!, { r8, r9 }
-skip2:
-	bics	n, n, #3
-	beq	return
-	stmfd	sp!, { r4, r5, r6, r7 }
-sub_n_loop:
-	ldmia	a!, { r4, r5, r6, r7 }
-	ldmia	b!, { r8, r9, ip, lr }
-	sbcs	r4, r4, r8
-	ldr	r8, [d] /* Bring stuff into cache. */
-	sbcs	r5, r5, r9
-	sbcs	r6, r6, ip
-	sbcs	r7, r7, lr
-	stmia	d!, { r4, r5, r6, r7 }
-	sub	n, n, #4
-	teq	n, #0
-	bne	sub_n_loop
-	ldmfd	sp!, { r4, r5, r6, r7 }
-return:
-	sbc	r0, r0, r0
-	and	r0, r0, #1
-	ldmfd	sp!, { r8, r9, pc }
-end:
-	.size	__gmpn_sub_n, end - __gmpn_sub_n
diff --git a/ghc/rts/gmp/mpn/asm-defs.m4 b/ghc/rts/gmp/mpn/asm-defs.m4
deleted file mode 100644
index aa2024138b..0000000000
--- a/ghc/rts/gmp/mpn/asm-defs.m4
+++ /dev/null
@@ -1,1182 +0,0 @@
-divert(-1)
-dnl
-dnl  m4 macros for gmp assembly code, shared by all CPUs.
-dnl
-dnl  These macros are designed for use with any m4 and have been used on
-dnl  GNU, FreeBSD, OpenBSD and SysV.
-dnl
-dnl  GNU m4 and OpenBSD 2.7 m4 will give filenames and line numbers in error
-dnl  messages.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-dnl  Macros:
-dnl
-dnl  Most new m4 specific macros have an "m4_" prefix to emphasise they're
-dnl  m4 expansions.  But new defining things like deflit() and defreg() are
-dnl  named like the builtin define(), and forloop() is named following the
-dnl  GNU m4 example on which it's based.
-dnl
-dnl  GNU m4 with the -P option uses "m4_" as a prefix for builtins, but that
-dnl  option isn't going to be used, so there's no conflict or confusion.
-dnl
-dnl
-dnl  Comments in output:
-dnl
-dnl  The m4 comment delimiters are left at # and \n, the normal assembler
-dnl  commenting for most CPUs.  m4 passes comment text through without
-dnl  expanding macros in it, which is generally a good thing since it stops
-dnl  unexpected expansions and possible resultant errors.
-dnl
-dnl  But note that when a quoted string is being read, a # isn't special, so
-dnl  apostrophes in comments in quoted strings must be avoided or they'll be
-dnl  interpreted as a closing quote mark.  But when the quoted text is
-dnl  re-read # will still act like a normal comment, supressing macro
-dnl  expansion.
-dnl
-dnl  For example,
-dnl
-dnl          # apostrophes in comments that're outside quotes are ok
-dnl          # and using macro names like PROLOGUE is ok too
-dnl          ...
-dnl          ifdef(`PIC',`
-dnl                  # but apostrophes aren't ok inside quotes
-dnl                  #                     ^--wrong
-dnl                  ...
-dnl                  # though macro names like PROLOGUE are still ok
-dnl                  ...
-dnl          ')
-dnl
-dnl  If macro expansion in a comment is wanted, use `#' in the .asm (ie. a
-dnl  quoted hash symbol), which will turn into # in the .s but get
-dnl  expansions done on that line.  This can make the .s more readable to
-dnl  humans, but it won't make a blind bit of difference to the assembler.
-dnl
-dnl  All the above applies, mutatis mutandis, when changecom() is used to
-dnl  select @ ! ; or whatever other commenting.
-dnl
-dnl
-dnl  Variations in m4 affecting gmp:
-dnl
-dnl  $# - When a macro is called as "foo" with no brackets, BSD m4 sets $#
-dnl       to 1, whereas GNU or SysV m4 set it to 0.  In all cases though
-dnl       "foo()" sets $# to 1.  This is worked around in various places.
-dnl
-dnl  len() - When "len()" is given an empty argument, BSD m4 evaluates to
-dnl       nothing, whereas GNU, SysV, and the new OpenBSD, evaluate to 0.
-dnl       See m4_length() below which works around this.
-dnl
-dnl  translit() - GNU m4 accepts character ranges like A-Z, and the new
-dnl       OpenBSD m4 does under option -g, but basic BSD and SysV don't.
-dnl
-dnl  popdef() - in BSD and SysV m4 popdef() takes multiple arguments and
-dnl       pops each, but GNU m4 only takes one argument.
-dnl
-dnl  push back - BSD m4 has some limits on the amount of text that can be
-dnl       pushed back.  The limit is reasonably big and so long as macros
-dnl       don't gratuitously duplicate big arguments it isn't a problem.
-dnl       Normally an error message is given, but sometimes it just hangs.
-dnl
-dnl  eval() &,|,^ - GNU and SysV m4 have bitwise operators &,|,^ available,
-dnl       but BSD m4 doesn't (contrary to what the man page suggests) and
-dnl       instead ^ is exponentiation.
-dnl
-dnl  eval() ?: - The C ternary operator "?:" is available in BSD m4, but not
-dnl       in SysV or GNU m4 (as of GNU m4 1.4 and betas of 1.5).
-dnl
-dnl  eval() -2^31 - BSD m4 has a bug where an eval() resulting in -2^31
-dnl       (ie. -2147483648) gives "-(".  Using -2147483648 within an
-dnl       expression is ok, it just can't be a final result.  "-(" will of
-dnl       course upset parsing, with all sorts of strange effects.
-dnl
-dnl  eval() <<,>> - SysV m4 doesn't support shift operators in eval() (on
-dnl       SunOS 5.7 /usr/xpg4/m4 has them but /usr/ccs/m4 doesn't).  See
-dnl       m4_lshift() and m4_rshift() below for workarounds.
-dnl
-dnl  m4wrap() - in BSD m4, m4wrap() replaces any previous m4wrap() string,
-dnl       in SysV m4 it appends to it, and in GNU m4 it prepends.  See
-dnl       m4wrap_prepend() below which brings uniformity to this.
-dnl
-dnl  __file__,__line__ - GNU m4 and OpenBSD 2.7 m4 provide these, and
-dnl       they're used here to make error messages more informative.  GNU m4
-dnl       gives an unhelpful "NONE 0" in an m4wrap(), but that's worked
-dnl       around.
-dnl
-dnl  __file__ quoting - OpenBSD m4, unlike GNU m4, doesn't quote the
-dnl       filename in __file__, so care should be taken that no macro has
-dnl       the same name as a file, or an unwanted expansion will occur when
-dnl       printing an error or warning.
-dnl
-dnl  OpenBSD 2.6 m4 - this m4 rejects decimal constants containing an 8 or 9
-dnl       in eval(), making it pretty much unusable.  This bug is confined
-dnl       to version 2.6 (it's not in 2.5, and has been fixed in 2.7).
-dnl
-dnl  SunOS /usr/bin/m4 - this m4 lacks a number of desired features,
-dnl       including $# and $@, defn(), m4exit(), m4wrap(), pushdef(),
-dnl       popdef().  /usr/5bin/m4 is a SysV style m4 which should always be
-dnl       available, and "configure" will reject /usr/bin/m4 in favour of
-dnl       /usr/5bin/m4 (if necessary).
-dnl
-dnl       The sparc code actually has modest m4 requirements currently and
-dnl       could manage with /usr/bin/m4, but there's no reason to put our
-dnl       macros through contortions when /usr/5bin/m4 is available or GNU
-dnl       m4 can be installed.
-
-
-ifdef(`__ASM_DEFS_M4_INCLUDED__',
-`m4_error(`asm-defs.m4 already included, dont include it twice
-')m4exit(1)')
-define(`__ASM_DEFS_M4_INCLUDED__')
-
-
-dnl  Detect and give a message about the unsuitable OpenBSD 2.6 m4.
-
-ifelse(eval(89),89,,
-`errprint(
-`This m4 doesnt accept 8 and/or 9 in constants in eval(), making it unusable.
-This is probably OpenBSD 2.6 m4 (September 1999).  Upgrade to OpenBSD 2.7,
-or get a bug fix from the CVS (expr.c rev 1.9), or get GNU m4.  Dont forget
-to configure with M4=/wherever/m4 if you install one of these in a directory
-not in $PATH.
-')m4exit(1)')
-
-
-dnl  Detect and give a message about the unsuitable SunOS /usr/bin/m4.
-dnl
-dnl  Unfortunately this test doesn't work when m4 is run in the normal way
-dnl  from mpn/Makefile with "m4 -DOPERATION_foo foo.asm", since the bad m4
-dnl  takes "-" in "-D..." to mean read stdin, so it will look like it just
-dnl  hangs.  But running "m4 asm-defs.m4" to try it out will work.
-dnl
-dnl  We'd like to abort immediately on finding a problem, but unfortunately
-dnl  the bad m4 doesn't have an m4exit(), nor does an invalid eval() kill
-dnl  it.  Unexpanded $#'s in some m4_assert_numargs() later on will comment
-dnl  out some closing parentheses and kill it with "m4: arg stack overflow".
-
-define(m4_dollarhash_works_test,``$#'')
-ifelse(m4_dollarhash_works_test(x),1,,
-`errprint(
-`This m4 doesnt support $# and cant be used for GMP asm processing.
-If this is on SunOS, ./configure should choose /usr/5bin/m4 if you have that
-or can get it, otherwise install GNU m4.  Dont forget to configure with
-M4=/wherever/m4 if you install in a directory not in $PATH.
-')')
-undefine(`m4_dollarhash_works_test')
-
-
-dnl  --------------------------------------------------------------------------
-dnl  Basic error handling things.
-
-
-dnl  Usage: m4_dollarhash_1_if_noparen_p
-dnl
-dnl  Expand to 1 if a call "foo" gives $# set to 1 (as opposed to 0 like GNU
-dnl  and SysV m4 give).
-
-define(m4_dollarhash_1_if_noparen_test,`$#')
-define(m4_dollarhash_1_if_noparen_p,
-eval(m4_dollarhash_1_if_noparen_test==1))
-undefine(`m4_dollarhash_1_if_noparen_test')
-
-
-dnl  Usage: m4wrap_prepend(string)
-dnl
-dnl  Prepend the given string to what will be exapanded under m4wrap at the
-dnl  end of input.
-dnl
-dnl  This macro exists to work around variations in m4wrap() behaviour in
-dnl  the various m4s (notes at the start of this file).  Don't use m4wrap()
-dnl  directly since it will interfere with this scheme.
-
-define(m4wrap_prepend,
-m4_assert_numargs(1)
-`define(`m4wrap_string',`$1'defn(`m4wrap_string'))')
-
-m4wrap(`m4wrap_string')
-define(m4wrap_string,`')
-
-
-dnl  Usage: m4_file_and_line
-dnl
-dnl  Expand to the current file and line number, if the GNU m4 extensions
-dnl  __file__ and __line__ are available.
-dnl
-dnl  In GNU m4 1.4 at the end of input when m4wrap text is expanded,
-dnl  __file__ is NONE and __line__ is 0, which is not a helpful thing to
-dnl  print.  If m4_file_seen() has been called to note the last file seen,
-dnl  then that file at a big line number is used, otherwise "end of input"
-dnl  is used (although "end of input" won't parse as an error message).
-
-define(m4_file_and_line,
-`ifdef(`__file__',
-`ifelse(__file__`'__line__,`NONE0',
-`ifdef(`m4_file_seen_last',`m4_file_seen_last: 999999: ',`end of input: ')',
-`__file__: __line__: ')')')
-
-
-dnl  Usage: m4_errprint_commas(arg,...)
-dnl
-dnl  The same as errprint(), but commas are printed between arguments
-dnl  instead of spaces.
-
-define(m4_errprint_commas,
-`errprint(`$1')dnl
-ifelse(eval($#>1),1,`errprint(`,')m4_errprint_commas(shift($@))')')
-
-
-dnl  Usage: m4_error(args...)
-dnl         m4_warning(args...)
-dnl
-dnl  Print an error message, using m4_errprint_commas, prefixed with the
-dnl  current filename and line number (if available).  m4_error sets up to
-dnl  give an error exit at the end of processing, m4_warning just prints.
-dnl  These macros are the recommended way to print errors.
-dnl
-dnl  The arguments here should be quoted in the usual way to prevent them
-dnl  being expanded when the macro call is read.  (m4_error takes care not
-dnl  to do any further expansion.)
-dnl
-dnl  For example,
-dnl
-dnl         m4_error(`some error message
-dnl         ')
-dnl
-dnl  which prints
-dnl
-dnl         foo.asm:123: some error message
-dnl
-dnl  or if __file__ and __line__ aren't available
-dnl
-dnl         some error message
-dnl
-dnl  The "file:line:" format is a basic style, used by gcc and GNU m4, so
-dnl  emacs and other editors will recognise it in their normal error message
-dnl  parsing.
-
-define(m4_warning,
-`m4_errprint_commas(m4_file_and_line`'$@)')
-
-define(m4_error,
-`define(`m4_error_occurred',1)m4_warning($@)')
-
-define(`m4_error_occurred',0)
-
-dnl  This m4wrap_prepend() is first, so it'll be executed last.
-m4wrap_prepend(
-`ifelse(m4_error_occurred,1,
-`m4_error(`Errors occurred during m4 processing
-')m4exit(1)')')
-
-
-dnl  Usage: m4_assert_numargs(num)
-dnl
-dnl  Put this unquoted on a line on its own at the start of a macro
-dnl  definition to add some code to check that num many arguments get passed
-dnl  to the macro.  For example,
-dnl
-dnl         define(foo,
-dnl         m4_assert_numargs(2)
-dnl         `something `$1' and `$2' blah blah')
-dnl
-dnl  Then a call like foo(one,two,three) will provoke an error like
-dnl
-dnl         file:10: foo expected 2 arguments, got 3 arguments
-dnl
-dnl  Here are some calls and how many arguments they're interpreted as passing.
-dnl
-dnl         foo(abc,def)  2
-dnl         foo(xyz)      1
-dnl         foo()         0
-dnl         foo          -1
-dnl
-dnl  The -1 for no parentheses at all means a macro that's meant to be used
-dnl  that way can be checked with m4_assert_numargs(-1).  For example,
-dnl
-dnl         define(SPECIAL_SUFFIX,
-dnl         m4_assert_numargs(-1)
-dnl         `ifdef(`FOO',`_foo',`_bar')')
-dnl
-dnl  But as an alternative see also deflit() below where parenthesized
-dnl  expressions following a macro are passed through to the output.
-dnl
-dnl  Note that in BSD m4 there's no way to differentiate calls "foo" and
-dnl  "foo()", so in BSD m4 the distinction between the two isn't enforced.
-dnl  (In GNU and SysV m4 it can be checked, and is.)
-
-
-dnl  m4_assert_numargs is able to check its own arguments by calling
-dnl  assert_numargs_internal directly.
-dnl
-dnl  m4_doublequote($`'0) expands to ``$0'', whereas ``$`'0'' would expand
-dnl  to `$`'0' and do the wrong thing, and likewise for $1.  The same is
-dnl  done in other assert macros.
-dnl
-dnl  $`#' leaves $# in the new macro being defined, and stops # being
-dnl  interpreted as a comment character.
-dnl
-dnl  `dnl ' means an explicit dnl isn't necessary when m4_assert_numargs is
-dnl  used.  The space means that if there is a dnl it'll still work.
-
-dnl  Usage: m4_doublequote(x) expands to ``x''
-define(m4_doublequote,
-`m4_assert_numargs_internal(`$0',1,$#,len(`$1'))``$1''')
-
-define(m4_assert_numargs,
-`m4_assert_numargs_internal(`$0',1,$#,len(`$1'))dnl
-`m4_assert_numargs_internal'(m4_doublequote($`'0),$1,$`#',`len'(m4_doublequote($`'1)))`dnl '')
-
-dnl  Called: m4_assert_numargs_internal(`macroname',wantargs,$#,len(`$1'))
-define(m4_assert_numargs_internal,
-`m4_assert_numargs_internal_check(`$1',`$2',m4_numargs_count(`$3',`$4'))')
-
-dnl  Called: m4_assert_numargs_internal_check(`macroname',wantargs,gotargs)
-dnl
-dnl  If m4_dollarhash_1_if_noparen_p (BSD m4) then gotargs can be 0 when it
-dnl  should be -1.  If wantargs is -1 but gotargs is 0 and the two can't be
-dnl  distinguished then it's allowed to pass.
-dnl
-define(m4_assert_numargs_internal_check,
-`ifelse(eval($2 == $3
-             || ($2==-1 && $3==0 && m4_dollarhash_1_if_noparen_p)),0,
-`m4_error(`$1 expected 'm4_Narguments(`$2')`, got 'm4_Narguments(`$3')
-)')')
-
-dnl  Called: m4_numargs_count($#,len(`$1'))
-dnl  If $#==0 then -1 args, if $#==1 but len(`$1')==0 then 0 args, otherwise
-dnl  $# args.
-define(m4_numargs_count,
-`ifelse($1,0, -1,
-`ifelse(eval($1==1 && $2-0==0),1, 0, $1)')')
-
-dnl  Usage: m4_Narguments(N)
-dnl  "$1 argument" or "$1 arguments" with the plural according to $1.
-define(m4_Narguments,
-`$1 argument`'ifelse(`$1',1,,s)')
-
-
-dnl  --------------------------------------------------------------------------
-dnl  Additional error checking things.
-
-
-dnl  Usage: m4_file_seen()
-dnl
-dnl  Record __file__ for the benefit of m4_file_and_line in m4wrap text.
-dnl  The basic __file__ macro comes out quoted, like `foo.asm', and
-dnl  m4_file_seen_last is defined like that too.
-dnl
-dnl  This only needs to be used with something that could generate an error
-dnl  message in m4wrap text.  The x86 PROLOGUE is the only such at the
-dnl  moment (at end of input its m4wrap checks for missing EPILOGUE).  A few
-dnl  include()s can easily trick this scheme, but you'd expect an EPILOGUE
-dnl  in the same file as the PROLOGUE.
-
-define(m4_file_seen,
-m4_assert_numargs(0)
-`ifelse(__file__,`NONE',,
-`define(`m4_file_seen_last',m4_doublequote(__file__))')')
-
-
-dnl  Usage: m4_assert_onearg()
-dnl
-dnl  Put this, unquoted, at the start of a macro definition to add some code
-dnl  to check that one argument is passed to the macro, but with that
-dnl  argument allowed to be empty.  For example,
-dnl
-dnl          define(foo,
-dnl          m4_assert_onearg()
-dnl          `blah blah $1 blah blah')
-dnl
-dnl  Calls "foo(xyz)" or "foo()" are accepted.  A call "foo(xyz,abc)" fails.
-dnl  A call "foo" fails too, but BSD m4 can't detect this case (GNU and SysV
-dnl  m4 can).
-
-define(m4_assert_onearg,
-m4_assert_numargs(0)
-`m4_assert_onearg_internal'(m4_doublequote($`'0),$`#')`dnl ')
-
-dnl  Called: m4_assert_onearg(`macroname',$#)
-define(m4_assert_onearg_internal,
-`ifelse($2,1,,
-`m4_error(`$1 expected 1 argument, got 'm4_Narguments(`$2')
-)')')
-
-
-dnl  Usage: m4_assert_numargs_range(low,high)
-dnl
-dnl  Put this, unquoted, at the start of a macro definition to add some code
-dnl  to check that between low and high many arguments get passed to the
-dnl  macro.  For example,
-dnl
-dnl         define(foo,
-dnl         m4_assert_numargs_range(3,5)
-dnl         `mandatory $1 $2 $3 optional $4 $5 end')
-dnl
-dnl  See m4_assert_numargs() for more info.
-
-define(m4_assert_numargs_range,
-m4_assert_numargs(2)
-``m4_assert_numargs_range_internal'(m4_doublequote($`'0),$1,$2,$`#',`len'(m4_doublequote($`'1)))`dnl '')
-
-dnl  Called: m4_assert_numargs_range_internal(`name',low,high,$#,len(`$1'))
-define(m4_assert_numargs_range_internal,
-m4_assert_numargs(5)
-`m4_assert_numargs_range_check(`$1',`$2',`$3',m4_numargs_count(`$4',`$5'))')
-
-dnl  Called: m4_assert_numargs_range_check(`name',low,high,gotargs)
-dnl
-dnl  If m4_dollarhash_1_if_noparen_p (BSD m4) then gotargs can be 0 when it
-dnl  should be -1.  To ensure a `high' of -1 works, a fudge is applied to
-dnl  gotargs if it's 0 and the 0 and -1 cases can't be distinguished.
-dnl
-define(m4_assert_numargs_range_check,
-m4_assert_numargs(4)
-`ifelse(eval($2 <= $4 &&
-             ($4 - ($4==0 && m4_dollarhash_1_if_noparen_p) <= $3)),0,
-`m4_error(`$1 expected $2 to $3 arguments, got 'm4_Narguments(`$4')
-)')')
-
-
-dnl  Usage: m4_assert_defined(symbol)
-dnl
-dnl  Put this unquoted on a line of its own at the start of a macro
-dnl  definition to add some code to check that the given symbol is defined
-dnl  when the macro is used.  For example,
-dnl
-dnl          define(foo,
-dnl          m4_assert_defined(`FOO_PREFIX')
-dnl          `FOO_PREFIX whatever')
-dnl
-dnl  This is a convenient way to check that the user or ./configure or
-dnl  whatever has defined the things needed by a macro, as opposed to
-dnl  silently generating garbage.
-
-define(m4_assert_defined,
-m4_assert_numargs(1)
-``m4_assert_defined_internal'(m4_doublequote($`'0),``$1'')`dnl '')
-
-dnl  Called: m4_assert_defined_internal(`macroname',`define_required')
-define(m4_assert_defined_internal,
-m4_assert_numargs(2)
-`ifdef(`$2',,
-`m4_error(`$1 needs $2 defined
-')')')
-
-
-dnl  Usage: m4_not_for_expansion(`SYMBOL')
-dnl         define_not_for_expansion(`SYMBOL')
-dnl
-dnl  m4_not_for_expansion turns SYMBOL, if defined, into something which
-dnl  will give an error if expanded.  For example,
-dnl
-dnl         m4_not_for_expansion(`PIC')
-dnl
-dnl  define_not_for_expansion is the same, but always makes a definition.
-dnl
-dnl  These are for symbols that should be tested with ifdef(`FOO',...)
-dnl  rather than be expanded as such.  They guard against accidentally
-dnl  omitting the quotes, as in ifdef(FOO,...).  Note though that they only
-dnl  catches this when FOO is defined, so be sure to test code both with and
-dnl  without each definition.
-
-define(m4_not_for_expansion,
-m4_assert_numargs(1)
-`ifdef(`$1',`define_not_for_expansion(`$1')')')
-
-define(define_not_for_expansion,
-m4_assert_numargs(1)
-`ifelse(defn(`$1'),,,
-`m4_error(``$1' has a non-empty value, maybe it shouldnt be munged with m4_not_for_expansion()
-')')dnl
-define(`$1',`m4_not_for_expansion_internal(`$1')')')
-
-define(m4_not_for_expansion_internal,
-`m4_error(``$1' is not meant to be expanded, perhaps you mean `ifdef(`$1',...)'
-')')
-
-
-dnl  --------------------------------------------------------------------------
-dnl  Various generic m4 things.
-
-
-dnl  Usage: m4_ifdef_anyof_p(`symbol',...)
-dnl
-dnl  Expand to 1 if any of the symbols in the argument list are defined, or
-dnl  to 0 if not.
-
-define(m4_ifdef_anyof_p,
-`ifelse(eval($#<=1 && m4_length(`$1')==0),1, 0,
-`ifdef(`$1', 1,
-`m4_ifdef_anyof_p(shift($@))')')')
-
-
-dnl  Usage: m4_length(string)
-dnl
-dnl  Determine the length of a string.  This is the same as len(), but
-dnl  always expands to a number, working around the BSD len() which
-dnl  evaluates to nothing given an empty argument.
-
-define(m4_length,
-m4_assert_onearg()
-`eval(len(`$1')-0)')
-
-
-dnl  Usage: m4_stringequal_p(x,y)
-dnl
-dnl  Expand to 1 or 0 according as strings x and y are equal or not.
-
-define(m4_stringequal_p,
-`ifelse(`$1',`$2',1,0)')
-
-
-dnl  Usage: m4_incr_or_decr(n,last)
-dnl
-dnl  Do an incr(n) or decr(n), whichever is in the direction of "last".
-dnl  Both n and last must be numbers of course.
-
-define(m4_incr_or_decr,
-m4_assert_numargs(2)
-`ifelse(eval($1<$2),1,incr($1),decr($1))')
-
-
-dnl  Usage: forloop(i, first, last, statement)
-dnl
-dnl  Based on GNU m4 examples/forloop.m4, but extended.
-dnl
-dnl  statement is expanded repeatedly, with i successively defined as
-dnl
-dnl         first, first+1, ..., last-1, last
-dnl
-dnl  Or if first > last, then it's
-dnl
-dnl         first, first-1, ..., last+1, last
-dnl
-dnl  If first == last, then one expansion is done.
-dnl
-dnl  A pushdef/popdef of i is done to preserve any previous definition (or
-dnl  lack of definition).  first and last are eval()ed and so can be
-dnl  expressions.
-dnl
-dnl  forloop_first is defined to 1 on the first iteration, 0 on the rest.
-dnl  forloop_last is defined to 1 on the last iteration, 0 on the others.
-dnl  Nested forloops are allowed, in which case forloop_first and
-dnl  forloop_last apply to the innermost loop that's open.
-dnl
-dnl  A simple example,
-dnl
-dnl         forloop(i, 1, 2*2+1, `dnl
-dnl         iteration number i ... ifelse(forloop_first,1,FIRST)
-dnl         ')
-
-
-dnl  "i" and "statement" are carefully quoted, but "first" and "last" are
-dnl  just plain numbers once eval()ed.
-
-define(`forloop',
-m4_assert_numargs(4)
-`pushdef(`$1',eval(`$2'))dnl
-pushdef(`forloop_first',1)dnl
-pushdef(`forloop_last',0)dnl
-forloop_internal(`$1',eval(`$3'),`$4')`'dnl
-popdef(`forloop_first')dnl
-popdef(`forloop_last')dnl
-popdef(`$1')')
-
-dnl  Called: forloop_internal(`var',last,statement)
-define(`forloop_internal',
-m4_assert_numargs(3)
-`ifelse($1,$2,
-`define(`forloop_last',1)$3',
-`$3`'dnl
-define(`forloop_first',0)dnl
-define(`$1',m4_incr_or_decr($1,$2))dnl
-forloop_internal(`$1',$2,`$3')')')
-
-
-dnl  Usage: m4_toupper(x)
-dnl         m4_tolower(x)
-dnl
-dnl  Convert the argument string to upper or lower case, respectively.
-dnl  Only one argument accepted.
-dnl
-dnl  BSD m4 doesn't take ranges like a-z in translit(), so the full alphabet
-dnl  is written out.
-
-define(m4_alphabet_lower, `abcdefghijklmnopqrstuvwxyz')
-define(m4_alphabet_upper, `ABCDEFGHIJKLMNOPQRSTUVWXYZ')
-
-define(m4_toupper,
-m4_assert_onearg()
-`translit(`$1', m4_alphabet_lower, m4_alphabet_upper)')
-
-define(m4_tolower,
-m4_assert_onearg()
-`translit(`$1', m4_alphabet_upper, m4_alphabet_lower)')
-
-
-dnl  Usage: m4_empty_if_zero(x)
-dnl
-dnl  Evaluate to x, or to nothing if x is 0.  x is eval()ed and so can be an
-dnl  expression.
-dnl
-dnl  This is useful for x86 addressing mode displacements since forms like
-dnl  (%ebx) are one byte shorter than 0(%ebx).  A macro `foo' for use as
-dnl  foo(%ebx) could be defined with the following so it'll be empty if the
-dnl  expression comes out zero.
-dnl
-dnl	   deflit(`foo', `m4_empty_if_zero(a+b*4-c)')
-dnl
-dnl  Naturally this shouldn't be done if, say, a computed jump depends on
-dnl  the code being a particular size.
-
-define(m4_empty_if_zero,
-m4_assert_onearg()
-`ifelse(eval($1),0,,eval($1))')
-
-
-dnl  Usage: m4_log2(x)
-dnl
-dnl  Calculate a logarithm to base 2.
-dnl  x must be an integral power of 2, between 2**0 and 2**30.
-dnl  x is eval()ed, so it can be an expression.
-dnl  An error results if x is invalid.
-dnl
-dnl  2**31 isn't supported, because an unsigned 2147483648 is out of range
-dnl  of a 32-bit signed int.  Also, the bug in BSD m4 where an eval()
-dnl  resulting in 2147483648 (or -2147483648 as the case may be) gives `-('
-dnl  means tests like eval(1<<31==(x)) would be necessary, but that then
-dnl  gives an unattractive explosion of eval() error messages if x isn't
-dnl  numeric.
-
-define(m4_log2,
-m4_assert_numargs(1)
-`m4_log2_internal(0,1,eval(`$1'))')
-
-dnl  Called: m4_log2_internal(n,2**n,target)
-define(m4_log2_internal,
-m4_assert_numargs(3)
-`ifelse($2,$3,$1,
-`ifelse($1,30,
-`m4_error(`m4_log2() argument too big or not a power of two: $3
-')',
-`m4_log2_internal(incr($1),eval(2*$2),$3)')')')
-
-
-dnl  Usage:  m4_div2_towards_zero
-dnl
-dnl  m4 division is probably whatever a C signed division is, and C doesn't
-dnl  specify what rounding gets used on negatives, so this expression forces
-dnl  a rounding towards zero.
-
-define(m4_div2_towards_zero,
-m4_assert_numargs(1)
-`eval((($1) + ((($1)<0) & ($1))) / 2)')
-
-
-dnl  Usage: m4_lshift(n,count)
-dnl         m4_rshift(n,count)
-dnl
-dnl  Calculate n shifted left or right by count many bits.  Both n and count
-dnl  are eval()ed and so can be expressions.
-dnl
-dnl  Negative counts are allowed and mean a shift in the opposite direction.
-dnl  Negative n is allowed and right shifts will be arithmetic (meaning
-dnl  divide by 2**count, rounding towards zero, also meaning the sign bit is
-dnl  duplicated).
-dnl
-dnl  Use these macros instead of << and >> in eval() since the basic ccs
-dnl  SysV m4 doesn't have those operators.
-
-define(m4_rshift,
-m4_assert_numargs(2)
-`m4_lshift(`$1',-(`$2'))')
-
-define(m4_lshift,
-m4_assert_numargs(2)
-`m4_lshift_internal(eval(`$1'),eval(`$2'))')
-
-define(m4_lshift_internal,
-m4_assert_numargs(2)
-`ifelse(eval($2-0==0),1,$1,
-`ifelse(eval($2>0),1,
-`m4_lshift_internal(eval($1*2),decr($2))',
-`m4_lshift_internal(m4_div2_towards_zero($1),incr($2))')')')
-
-
-dnl  Usage: deflit(name,value)
-dnl
-dnl  Like define(), but "name" expands like a literal, rather than taking
-dnl  arguments.  For example "name(%eax)" expands to "value(%eax)".
-dnl
-dnl  Limitations:
-dnl
-dnl  $ characters in the value part must have quotes to stop them looking
-dnl  like macro parameters.  For example, deflit(reg,`123+$`'4+567').  See
-dnl  defreg() below for handling simple register definitions like $7 etc.
-dnl
-dnl  "name()" is turned into "name", unfortunately.  In GNU and SysV m4 an
-dnl  error is generated when this happens, but in BSD m4 it will happen
-dnl  silently.  The problem is that in BSD m4 $# is 1 in both "name" or
-dnl  "name()", so there's no way to differentiate them.  Because we want
-dnl  plain "name" to turn into plain "value", we end up with "name()"
-dnl  turning into plain "value" too.
-dnl
-dnl  "name(foo)" will lose any whitespace after commas in "foo", for example
-dnl  "disp(%eax, %ecx)" would become "128(%eax,%ecx)".
-dnl
-dnl  These parentheses oddities shouldn't matter in assembler text, but if
-dnl  they do the suggested workaround is to write "name ()" or "name (foo)"
-dnl  to stop the parentheses looking like a macro argument list.  If a space
-dnl  isn't acceptable in the output, then write "name`'()" or "name`'(foo)".
-dnl  The `' is stripped when read, but again stops the parentheses looking
-dnl  like parameters.
-
-dnl  Quoting for deflit_emptyargcheck is similar to m4_assert_numargs.  The
-dnl  stuff in the ifelse gives a $#, $1 and $@ evaluated in the new macro
-dnl  created, not in deflit.
-define(deflit,
-m4_assert_numargs(2)
-`define(`$1',
-`deflit_emptyargcheck'(``$1'',$`#',m4_doublequote($`'1))`dnl
-$2`'dnl
-ifelse(eval($'`#>1 || m4_length('m4_doublequote($`'1)`)!=0),1,($'`@))')')
-
-dnl  Called: deflit_emptyargcheck(macroname,$#,`$1')
-define(deflit_emptyargcheck,
-`ifelse(eval($2==1 && !m4_dollarhash_1_if_noparen_p && m4_length(`$3')==0),1,
-`m4_error(`dont use a deflit as $1() because it loses the brackets (see deflit in asm-incl.m4 for more information)
-')')')
-
-
-dnl  Usage: m4_assert(`expr')
-dnl
-dnl  Test a compile-time requirement with an m4 expression.  The expression
-dnl  should be quoted, and will be eval()ed and expected to be non-zero.
-dnl  For example,
-dnl
-dnl         m4_assert(`FOO*2+6 < 14')
-
-define(m4_assert,
-m4_assert_numargs(1)
-`ifelse(eval($1),1,,
-`m4_error(`assertion failed: $1
-')')')
-
-
-dnl  --------------------------------------------------------------------------
-dnl  Various assembler things, not specific to any particular CPU.
-dnl
-
-
-dnl  Usage: include_mpn(`filename')
-dnl
-dnl  Like include(), but adds a path to the mpn source directory.  For
-dnl  example,
-dnl
-dnl         include_mpn(`sparc64/addmul_1h.asm')
-
-define(include_mpn,
-m4_assert_numargs(1)
-m4_assert_defined(`CONFIG_TOP_SRCDIR')
-`include(CONFIG_TOP_SRCDIR`/mpn/$1')')
-
-
-dnl  Usage: C comment ...
-dnl
-dnl  "C" works like a FORTRAN-style comment character.  This can be used for
-dnl  comments to the right of assembly instructions, where just dnl would
-dnl  remove the linefeed, and concatenate adjacent lines.
-dnl
-dnl  "C" and/or "dnl" are useful when an assembler doesn't support comments,
-dnl  or where different assemblers for a particular CPU have different
-dnl  comment styles.  The intermediate ".s" files will end up with no
-dnl  comments, just code.
-dnl
-dnl  Using "C" is not intended to cause offence to anyone who doesn't like
-dnl  FORTRAN; but if that happens it's an unexpected bonus.
-
-define(C, `
-dnl')
-
-
-dnl  Various possible defines passed from the Makefile that are to be tested
-dnl  with ifdef() rather than be expanded.
-
-m4_not_for_expansion(`PIC')
-
-dnl  aors_n
-m4_not_for_expansion(`OPERATION_add_n')
-m4_not_for_expansion(`OPERATION_sub_n')
-
-dnl  aorsmul_n
-m4_not_for_expansion(`OPERATION_addmul_1')
-m4_not_for_expansion(`OPERATION_submul_1')
-
-dnl  logops_n
-m4_not_for_expansion(`OPERATION_and_n')
-m4_not_for_expansion(`OPERATION_andn_n')
-m4_not_for_expansion(`OPERATION_nand_n')
-m4_not_for_expansion(`OPERATION_ior_n')
-m4_not_for_expansion(`OPERATION_iorn_n')
-m4_not_for_expansion(`OPERATION_nior_n')
-m4_not_for_expansion(`OPERATION_xor_n')
-m4_not_for_expansion(`OPERATION_xnor_n')
-
-dnl  popham
-m4_not_for_expansion(`OPERATION_popcount')
-m4_not_for_expansion(`OPERATION_hamdist')
-
-
-dnl  Usage: m4_config_gmp_mparam(`symbol')
-dnl
-dnl  Check that `symbol' is defined.  If it isn't, issue an error and
-dnl  terminate immediately.  The error message explains that the symbol
-dnl  should be in config.m4, copied from gmp-mparam.h.
-dnl
-dnl  Processing is terminated immediately since missing something like
-dnl  KARATSUBA_SQR_THRESHOLD can lead to infinite loops with endless error
-dnl  messages.
-
-define(m4_config_gmp_mparam,
-m4_assert_numargs(1)
-`ifdef(`$1',,
-`m4_error(`$1 is not defined.
-	"configure" should have extracted this from gmp-mparam.h and put it
-	in config.m4, but somehow this has failed.
-')m4exit(1)')')
-
-
-dnl  Usage: defreg(name,reg)
-dnl
-dnl  Give a name to a $ style register.  For example,
-dnl
-dnl         defreg(foo,$12)
-dnl
-dnl  defreg() inserts an extra pair of quotes after the $ so that it's not
-dnl  interpreted as an m4 macro parameter, ie. foo is actually $`'12.  m4
-dnl  strips those quotes when foo is expanded.
-dnl
-dnl  deflit() is used to make the new definition, so it will expand
-dnl  literally even if followed by parentheses ie. foo(99) will become
-dnl  $12(99).  (But there's nowhere that would be used is there?)
-dnl
-dnl  When making further definitions from existing defreg() macros, remember
-dnl  to use defreg() again to protect the $ in the new definitions too.  For
-dnl  example,
-dnl
-dnl         defreg(a0,$4)
-dnl         defreg(a1,$5)
-dnl         ...
-dnl
-dnl         defreg(PARAM_DST,a0)
-dnl
-dnl  This is only because a0 is expanding at the time the PARAM_DST
-dnl  definition is made, leaving a literal $4 that must be re-quoted.  On
-dnl  the other hand in something like the following ra is only expanded when
-dnl  ret is used and its $`'31 protection will have its desired effect at
-dnl  that time.
-dnl
-dnl         defreg(ra,$31)
-dnl         ...
-dnl         define(ret,`j ra')
-dnl
-dnl  Note that only $n forms are meant to be used here, and something like
-dnl  128($30) doesn't get protected and will come out wrong.
-
-define(defreg,
-m4_assert_numargs(2)
-`deflit(`$1',
-substr(`$2',0,1)``''substr(`$2',1))')
-
-
-dnl  Usage: m4_instruction_wrapper(num)
-dnl
-dnl  Put this, unquoted, on a line on its own, at the start of a macro
-dnl  that's a wrapper around an assembler instruction.  It adds code to give
-dnl  a descriptive error message if the macro is invoked without arguments.
-dnl
-dnl  For example, suppose jmp needs to be wrapped,
-dnl
-dnl         define(jmp,
-dnl         m4_instruction_wrapper()
-dnl         m4_assert_numargs(1)
-dnl                 `.byte 0x42
-dnl                 .long  $1
-dnl                 nop')
-dnl
-dnl  The point of m4_instruction_wrapper is to get a better error message
-dnl  than m4_assert_numargs would give if jmp is accidentally used as plain
-dnl  "jmp foo" instead of the intended "jmp( foo)".  "jmp()" with no
-dnl  argument also provokes the error message.
-dnl
-dnl  m4_instruction_wrapper should only be used with wrapped instructions
-dnl  that take arguments, since obviously something meant to be used as
-dnl  plain "ret", say, doesn't want to give an error when used that way.
-
-define(m4_instruction_wrapper,
-m4_assert_numargs(0)
-``m4_instruction_wrapper_internal'(m4_doublequote($`'0),dnl
-m4_doublequote(ifdef(`__file__',__file__,`the m4 sources')),dnl
-$`#',m4_doublequote($`'1))`dnl'')
-
-dnl  Called: m4_instruction_wrapper_internal($0,`filename',$#,$1)
-define(m4_instruction_wrapper_internal,
-`ifelse(eval($3<=1 && m4_length(`$4')==0),1,
-`m4_error(`$1 is a macro replacing that instruction and needs arguments, see $2 for details
-')')')
-
-
-dnl  Usage: UNROLL_LOG2, UNROLL_MASK, UNROLL_BYTES
-dnl         CHUNK_LOG2, CHUNK_MASK, CHUNK_BYTES
-dnl
-dnl  When code supports a variable amount of loop unrolling, the convention
-dnl  is to define UNROLL_COUNT to the number of limbs processed per loop.
-dnl  When testing code this can be varied to see how much the loop overhead
-dnl  is costing.  For example,
-dnl
-dnl         deflit(UNROLL_COUNT, 32)
-dnl
-dnl  If the forloop() generating the unrolled loop has a pattern processing
-dnl  more than one limb, the convention is to express this with CHUNK_COUNT.
-dnl  For example,
-dnl
-dnl         deflit(CHUNK_COUNT, 2)
-dnl
-dnl  The LOG2, MASK and BYTES definitions below are derived from these COUNT
-dnl  definitions.  If COUNT is redefined, the LOG2, MASK and BYTES follow
-dnl  the new definition automatically.
-dnl
-dnl  LOG2 is the log base 2 of COUNT.  MASK is COUNT-1, which can be used as
-dnl  a bit mask.  BYTES is BYTES_PER_MP_LIMB*COUNT, the number of bytes
-dnl  processed in each unrolled loop.
-dnl
-dnl  BYTES_PER_MP_LIMB is defined in a CPU specific m4 include file.  It
-dnl  exists only so the BYTES definitions here can be common to all CPUs.
-dnl  In the actual code for a given CPU, an explicit 4 or 8 may as well be
-dnl  used because the code is only for a particular CPU, it doesn't need to
-dnl  be general.
-dnl
-dnl  Note that none of these macros do anything except give conventional
-dnl  names to commonly used things.  You still have to write your own
-dnl  expressions for a forloop() and the resulting address displacements.
-dnl  Something like the following would be typical for 4 bytes per limb.
-dnl
-dnl         forloop(`i',0,UNROLL_COUNT-1,`
-dnl                 deflit(`disp',eval(i*4))
-dnl                 ...
-dnl         ')
-dnl
-dnl  Or when using CHUNK_COUNT,
-dnl
-dnl         forloop(`i',0,UNROLL_COUNT/CHUNK_COUNT-1,`
-dnl                 deflit(`disp0',eval(i*CHUNK_COUNT*4))
-dnl                 deflit(`disp1',eval(disp0+4))
-dnl                 ...
-dnl         ')
-dnl
-dnl  Clearly `i' can be run starting from 1, or from high to low or whatever
-dnl  best suits.
-
-deflit(UNROLL_LOG2,
-m4_assert_defined(`UNROLL_COUNT')
-`m4_log2(UNROLL_COUNT)')
-
-deflit(UNROLL_MASK,
-m4_assert_defined(`UNROLL_COUNT')
-`eval(UNROLL_COUNT-1)')
-
-deflit(UNROLL_BYTES,
-m4_assert_defined(`UNROLL_COUNT')
-m4_assert_defined(`BYTES_PER_MP_LIMB')
-`eval(UNROLL_COUNT * BYTES_PER_MP_LIMB)')
- 
-deflit(CHUNK_LOG2,
-m4_assert_defined(`CHUNK_COUNT')
-`m4_log2(CHUNK_COUNT)')
-
-deflit(CHUNK_MASK,
-m4_assert_defined(`CHUNK_COUNT')
-`eval(CHUNK_COUNT-1)')
-
-deflit(CHUNK_BYTES,
-m4_assert_defined(`CHUNK_COUNT')
-m4_assert_defined(`BYTES_PER_MP_LIMB')
-`eval(CHUNK_COUNT * BYTES_PER_MP_LIMB)')
-
-
-dnl  Usage: MPN(name)
-dnl
-dnl  Add MPN_PREFIX to a name.
-dnl  MPN_PREFIX defaults to "__gmpn_" if not defined.
-
-ifdef(`MPN_PREFIX',,
-`define(`MPN_PREFIX',`__gmpn_')')
-
-define(MPN,
-m4_assert_numargs(1)
-`MPN_PREFIX`'$1')
-
-
-dnl  Usage: mpn_add_n, etc
-dnl
-dnl  Convenience definitions using MPN(), like the #defines in gmp.h.  Each
-dnl  function that might be implemented in assembler is here.
-
-define(define_mpn,
-m4_assert_numargs(1)
-`define(`mpn_$1',`MPN(`$1')')')
-
-define_mpn(add)
-define_mpn(add_1)
-define_mpn(add_n)
-define_mpn(add_nc)
-define_mpn(addmul_1)
-define_mpn(addmul_1c)
-define_mpn(addsub_n)
-define_mpn(addsub_nc)
-define_mpn(and_n)
-define_mpn(andn_n)
-define_mpn(bdivmod)
-define_mpn(cmp)
-define_mpn(com_n)
-define_mpn(copyd)
-define_mpn(copyi)
-define_mpn(divexact_by3c)
-define_mpn(divrem)
-define_mpn(divrem_1)
-define_mpn(divrem_1c)
-define_mpn(divrem_2)
-define_mpn(divrem_classic)
-define_mpn(divrem_newton)
-define_mpn(dump)
-define_mpn(gcd)
-define_mpn(gcd_1)
-define_mpn(gcdext)
-define_mpn(get_str)
-define_mpn(hamdist)
-define_mpn(invert_limb)
-define_mpn(ior_n)
-define_mpn(iorn_n)
-define_mpn(kara_mul_n)
-define_mpn(kara_sqr_n)
-define_mpn(lshift)
-define_mpn(lshiftc)
-define_mpn(mod_1)
-define_mpn(mod_1c)
-define_mpn(mul)
-define_mpn(mul_1)
-define_mpn(mul_1c)
-define_mpn(mul_basecase)
-define_mpn(mul_n)
-define_mpn(perfect_square_p)
-define_mpn(popcount)
-define_mpn(preinv_mod_1)
-define_mpn(nand_n)
-define_mpn(nior_n)
-define_mpn(random)
-define_mpn(random2)
-define_mpn(rshift)
-define_mpn(rshiftc)
-define_mpn(scan0)
-define_mpn(scan1)
-define_mpn(set_str)
-define_mpn(sqr_basecase)
-define_mpn(sub_n)
-define_mpn(sqrtrem)
-define_mpn(sub)
-define_mpn(sub_1)
-define_mpn(sub_n)
-define_mpn(sub_nc)
-define_mpn(submul_1)
-define_mpn(submul_1c)
-define_mpn(toom3_mul_n)
-define_mpn(toom3_sqr_n)
-define_mpn(umul_ppmm)
-define_mpn(udiv_qrnnd)
-define_mpn(xnor_n)
-define_mpn(xor_n)
-
-define(`ASM_START',
-	`')
-
-define(`PROLOGUE',
-	`
-	TEXT
-	ALIGN(4)
-	GLOBL	GSYM_PREFIX`$1'
-	TYPE(GSYM_PREFIX`$1',`function')
-GSYM_PREFIX`$1':')
-
-define(`EPILOGUE',
-	`
-	SIZE(GSYM_PREFIX`$1',.-GSYM_PREFIX`$1')')
-
-dnl  LSYM_PREFIX might be L$, so defn() must be used to quote it or the L
-dnl  will expand as the L macro, an infinite recursion.
-define(`L',`defn(`LSYM_PREFIX')$1')
-
-define(`INT32',
-	`
-	ALIGN(4)
-$1:
-	W32	$2
-	')
-
-define(`INT64',
-	`
-	ALIGN(8)
-$1:
-	W32	$2
-	W32	$3
-	')
-
-
-dnl  Usage: ALIGN(bytes)
-dnl
-dnl  Emit a ".align" directive.  The alignment is specified in bytes, and
-dnl  will normally need to be a power of 2.  The actual ".align" generated
-dnl  is either bytes or logarithmic according to what ./configure detects.
-dnl
-dnl  ALIGN_FILL_0x90, if defined and equal to "yes", means a ", 0x90" should
-dnl  be appended (this is for x86).
-
-define(ALIGN,
-m4_assert_numargs(1)
-m4_assert_defined(`ALIGN_LOGARITHMIC')
-`.align	ifelse(ALIGN_LOGARITHMIC,yes,`m4_log2($1)',`eval($1)')dnl
-ifelse(ALIGN_FILL_0x90,yes,`, 0x90')')
-
-
-dnl  Usage: MULFUNC_PROLOGUE(function function...)
-dnl
-dnl  A dummy macro which is grepped for by ./configure to know what
-dnl  functions a multi-function file is providing.  Use this if there aren't
-dnl  explicit PROLOGUE()s for each possible function.
-dnl
-dnl  Multiple MULFUNC_PROLOGUEs can be used, or just one with the function
-dnl  names separated by spaces.
-
-define(`MULFUNC_PROLOGUE',
-m4_assert_numargs(1)
-`')
-
-
-divert`'dnl
diff --git a/ghc/rts/gmp/mpn/clipper/add_n.s b/ghc/rts/gmp/mpn/clipper/add_n.s
deleted file mode 100644
index 538a1caed0..0000000000
--- a/ghc/rts/gmp/mpn/clipper/add_n.s
+++ /dev/null
@@ -1,48 +0,0 @@
-; Clipper __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
-; sum in a third limb vector.
-
-; Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-.text
-	.align 16
-.globl ___gmpn_add_n
-___gmpn_add_n:
-	subq	$8,sp
-	storw	r6,(sp)
-	loadw	12(sp),r2
-	loadw	16(sp),r3
-	loadq	$0,r6		; clear carry-save register
-
-.Loop:	loadw	(r1),r4
-	loadw	(r2),r5
-	addwc	r6,r6		; restore carry from r6
-	addwc	r5,r4
-	storw	r4,(r0)
-	subwc	r6,r6		; save carry in r6
-	addq	$4,r0
-	addq	$4,r1
-	addq	$4,r2
-	subq	$1,r3
-	brne	.Loop
-
-	negw	r6,r0
-	loadw	(sp),r6
-	addq	$8,sp
-	ret	sp
diff --git a/ghc/rts/gmp/mpn/clipper/mul_1.s b/ghc/rts/gmp/mpn/clipper/mul_1.s
deleted file mode 100644
index c0c756488c..0000000000
--- a/ghc/rts/gmp/mpn/clipper/mul_1.s
+++ /dev/null
@@ -1,47 +0,0 @@
-; Clipper __gmpn_mul_1 -- Multiply a limb vector with a limb and store
-; the result in a second limb vector.
-
-; Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-.text
-	.align	16
-.globl	___gmpn_mul_1
-___gmpn_mul_1:
-	subq	$8,sp
-	storw	r6,(sp)
-	loadw	12(sp),r2
-	loadw	16(sp),r3
-	loadq	$0,r6		; clear carry limb
-
-.Loop:	loadw	(r1),r4
-	mulwux	r3,r4
-	addw	r6,r4		; add old carry limb into low product limb
-	loadq	$0,r6
-	addwc	r5,r6		; propagate cy into high product limb
-	storw	r4,(r0)
-	addq	$4,r0
-	addq	$4,r1
-	subq	$1,r2
-	brne	.Loop
-
-	movw	r6,r0
-	loadw	0(sp),r6
-	addq	$8,sp
-	ret	sp
diff --git a/ghc/rts/gmp/mpn/clipper/sub_n.s b/ghc/rts/gmp/mpn/clipper/sub_n.s
deleted file mode 100644
index 44d8797289..0000000000
--- a/ghc/rts/gmp/mpn/clipper/sub_n.s
+++ /dev/null
@@ -1,48 +0,0 @@
-; Clipper __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
-; store difference in a third limb vector.
-
-; Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-.text
-	.align 16
-.globl ___gmpn_sub_n
-___gmpn_sub_n:
-	subq	$8,sp
-	storw	r6,(sp)
-	loadw	12(sp),r2
-	loadw	16(sp),r3
-	loadq	$0,r6		; clear carry-save register
-
-.Loop:	loadw	(r1),r4
-	loadw	(r2),r5
-	addwc	r6,r6		; restore carry from r6
-	subwc	r5,r4
-	storw	r4,(r0)
-	subwc	r6,r6		; save carry in r6
-	addq	$4,r0
-	addq	$4,r1
-	addq	$4,r2
-	subq	$1,r3
-	brne	.Loop
-
-	negw	r6,r0
-	loadw	(sp),r6
-	addq	$8,sp
-	ret	sp
diff --git a/ghc/rts/gmp/mpn/cray/README b/ghc/rts/gmp/mpn/cray/README
deleted file mode 100644
index 8195c67e21..0000000000
--- a/ghc/rts/gmp/mpn/cray/README
+++ /dev/null
@@ -1,14 +0,0 @@
-The (poorly optimized) code in this directory was originally written for a
-j90 system, but finished on a c90.  It should work on all Cray vector
-computers.  For the T3E and T3D systems, the `alpha' subdirectory at the
-same level as the directory containing this file, is much better.
-
-* `+' seems to be faster than `|' when combining carries.
-
-* It is possible that the best multiply performance would be achived by
-  storing only 24 bits per element, and using lazy carry propagation.  Before
-  calling i24mult, full carry propagation would be needed.
-
-* Supply tasking versions of the C loops.
-
-
diff --git a/ghc/rts/gmp/mpn/cray/add_n.c b/ghc/rts/gmp/mpn/cray/add_n.c
deleted file mode 100644
index 1fdb394993..0000000000
--- a/ghc/rts/gmp/mpn/cray/add_n.c
+++ /dev/null
@@ -1,96 +0,0 @@
-/* mpn_add_n -- Add two limb vectors of equal, non-zero length.
-   For Cray vector processors.
-
-   Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-   This file is part of the GNU MP Library.
-
-   The GNU MP Library is free software; you can redistribute it and/or modify
-   it under the terms of the GNU Lesser General Public License as published by
-   the Free Software Foundation; either version 2.1 of the License, or (at your
-   option) any later version.
-
-   The GNU MP Library is distributed in the hope that it will be useful, but
-   WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-   License for more details.
-
-   You should have received a copy of the GNU Lesser General Public License
-   along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-   the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-   MA 02111-1307, USA.  */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-mp_limb_t
-mpn_add_n (c, a, b, n)
-     mp_ptr c;
-     mp_srcptr a, b;
-     mp_size_t n;
-{
-  mp_size_t i;
-  mp_size_t nm1 = n - 1;
-  int more_carries = 0;
-  int carry_out;
-
-  /* For small operands the non-vector code is faster.  */
-  if (n < 16)
-    goto sequential;
-
-  if (a == c || b == c)
-    {
-      TMP_DECL (marker);
-      TMP_MARK (marker);
-      if (c == a)
-	{
-	  /* allocate temp space for a */
-	  mp_ptr ax = (mp_ptr) TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-	  MPN_COPY (ax, a, n);
-	  a = (mp_srcptr) ax;
-	}
-      if (c == b)
-	{
-	  /* allocate temp space for b */
-	  mp_ptr bx = (mp_ptr) TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-	  MPN_COPY (bx, b, n);
-	  b = (mp_srcptr) bx;
-	}
-      carry_out = mpn_add_n (c, a, b, n);
-      TMP_FREE (marker);
-      return carry_out;
-    }
-
-  carry_out = a[nm1] + b[nm1] < a[nm1];
-
-#pragma _CRI ivdep			/* Cray PVP systems */
-  for (i = nm1; i > 0; i--)
-    {
-      int cy_in;
-      cy_in = a[i - 1] + b[i - 1] < a[i - 1];
-      c[i] = a[i] + b[i] + cy_in;
-      more_carries += c[i] < cy_in;
-    }
-  c[0] = a[0] + b[0];
-
-  if (more_carries)
-    {
-      /* This won't vectorize, but we should come here rarely.  */
-      int cy;
-    sequential:
-      cy = 0;
-      for (i = 0; i < n; i++)
-	{
-	  mp_limb_t ai, ci, t;
-	  ai = a[i];
-	  t = b[i] + cy;
-	  cy = t < cy;
-	  ci = ai + t;
-	  cy += ci < ai;
-	  c[i] = ci;
-	}
-      carry_out = cy;
-    }
-
-  return carry_out;
-}
diff --git a/ghc/rts/gmp/mpn/cray/addmul_1.c b/ghc/rts/gmp/mpn/cray/addmul_1.c
deleted file mode 100644
index 031b4e8e8d..0000000000
--- a/ghc/rts/gmp/mpn/cray/addmul_1.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/* mpn_addmul_1 for Cray PVP.
-
-Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.  */
-
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-mp_limb_t
-mpn_addmul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t limb)
-{
-  mp_ptr p0, p1, tp;
-  mp_limb_t cy_limb;
-  TMP_DECL (marker);
-  TMP_MARK (marker);
-
-  p1 = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-  p0 = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-  tp = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-
-  GMPN_MULWW (p1, p0, up, &n, &limb);
-  cy_limb = mpn_add_n (tp, rp, p0, n);
-  rp[0] = tp[0];
-  cy_limb += mpn_add_n (rp + 1, tp + 1, p1, n - 1);
-  cy_limb += p1[n - 1];
-
-  TMP_FREE (marker);
-  return cy_limb;
-}
diff --git a/ghc/rts/gmp/mpn/cray/gmp-mparam.h b/ghc/rts/gmp/mpn/cray/gmp-mparam.h
deleted file mode 100644
index 14f7b8e05b..0000000000
--- a/ghc/rts/gmp/mpn/cray/gmp-mparam.h
+++ /dev/null
@@ -1,27 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 64
-#define BYTES_PER_MP_LIMB 8
-#define BITS_PER_LONGINT 64
-#define BITS_PER_INT 64
-#define BITS_PER_SHORTINT 32
-#define BITS_PER_CHAR 8
diff --git a/ghc/rts/gmp/mpn/cray/mul_1.c b/ghc/rts/gmp/mpn/cray/mul_1.c
deleted file mode 100644
index 0c8750b4ac..0000000000
--- a/ghc/rts/gmp/mpn/cray/mul_1.c
+++ /dev/null
@@ -1,44 +0,0 @@
-/* mpn_mul_1 for Cray PVP.
-
-Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.  */
-
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-mp_limb_t
-mpn_mul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t limb)
-{
-  mp_ptr p0, p1;
-  mp_limb_t cy_limb;
-  TMP_DECL (marker);
-  TMP_MARK (marker);
-
-  p1 = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-  p0 = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-
-  GMPN_MULWW (p1, p0, up, &n, &limb);
-  rp[0] = p0[0];
-  cy_limb = mpn_add_n (rp + 1, p0 + 1, p1, n - 1);
-  cy_limb += p1[n - 1];
-
-  TMP_FREE (marker);
-  return cy_limb;
-}
diff --git a/ghc/rts/gmp/mpn/cray/mulww.f b/ghc/rts/gmp/mpn/cray/mulww.f
deleted file mode 100644
index 99507c1e44..0000000000
--- a/ghc/rts/gmp/mpn/cray/mulww.f
+++ /dev/null
@@ -1,54 +0,0 @@
-c     Helper for mpn_mul_1, mpn_addmul_1, and mpn_submul_1 for Cray PVP.
-
-c     Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-c     This file is part of the GNU MP Library.
-
-c     The GNU MP Library is free software; you can redistribute it and/or
-c     modify it under the terms of the GNU Lesser General Public License as
-c     published by the Free Software Foundation; either version 2.1 of the
-c     License, or (at your option) any later version.
-
-c     The GNU MP Library is distributed in the hope that it will be useful,
-c     but WITHOUT ANY WARRANTY; without even the implied warranty of
-c     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-c     Lesser General Public License for more details.
-
-c     You should have received a copy of the GNU Lesser General Public
-c     License along with the GNU MP Library; see the file COPYING.LIB.  If
-c     not, write to the Free Software Foundation, Inc., 59 Temple Place -
-c     Suite 330, Boston, MA 02111-1307, USA.
-
-c     p1[] = hi(a[]*s); the upper limbs of each product
-c     p0[] = low(a[]*s); the corresponding lower limbs
-c     n is number of limbs in the vectors
-
-      subroutine gmpn_mulww(p1,p0,a,n,s)
-      integer*8 p1(0:*),p0(0:*),a(0:*),s
-      integer n
-
-      integer*8 a0,a1,a2,s0,s1,s2,c
-      integer*8 ai,t0,t1,t2,t3,t4
-
-      s0 = shiftl(and(s,4194303),24)
-      s1 = shiftl(and(shiftr(s,22),4194303),24)
-      s2 = shiftl(and(shiftr(s,44),4194303),24)
-
-      do i = 0,n-1
-         ai = a(i)
-         a0 = shiftl(and(ai,4194303),24)
-         a1 = shiftl(and(shiftr(ai,22),4194303),24)
-         a2 = shiftl(and(shiftr(ai,44),4194303),24)
-
-         t0 = i24mult(a0,s0)
-         t1 = i24mult(a0,s1)+i24mult(a1,s0)
-         t2 = i24mult(a0,s2)+i24mult(a1,s1)+i24mult(a2,s0)
-         t3 = i24mult(a1,s2)+i24mult(a2,s1)
-         t4 = i24mult(a2,s2)
-
-         p0(i)=shiftl(t2,44)+shiftl(t1,22)+t0
-         c=shiftr(shiftr(t0,22)+and(t1,4398046511103)+
-     $        shiftl(and(t2,1048575),22),42)
-         p1(i)=shiftl(t4,24)+shiftl(t3,2)+shiftr(t2,20)+shiftr(t1,42)+c
-      end do
-      end
diff --git a/ghc/rts/gmp/mpn/cray/mulww.s b/ghc/rts/gmp/mpn/cray/mulww.s
deleted file mode 100644
index 890cdcf94d..0000000000
--- a/ghc/rts/gmp/mpn/cray/mulww.s
+++ /dev/null
@@ -1,245 +0,0 @@
-*     Helper for mpn_mul_1, mpn_addmul_1, and mpn_submul_1 for Cray PVP.
-
-*     Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-*     This file is generated from mulww.f in this same directory.
-
-*     This file is part of the GNU MP Library.
-
-*     The GNU MP Library is free software; you can redistribute it and/or
-*     modify it under the terms of the GNU Lesser General Public License as
-*     published by the Free Software Foundation; either version 2.1 of the
-*     License, or (at your option) any later version.
-
-*     The GNU MP Library is distributed in the hope that it will be useful,
-*     but WITHOUT ANY WARRANTY; without even the implied warranty of
-*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-*     Lesser General Public License for more details.
-
-*     You should have received a copy of the GNU Lesser General Public
-*     License along with the GNU MP Library; see the file COPYING.LIB.  If
-*     not, write to the Free Software Foundation, Inc., 59 Temple Place -
-*     Suite 330, Boston, MA 02111-1307, USA.
-
-            IDENT           GMPN_MULWW
-**********************************************
-*      Assemble with Cal Version 2.0         *
-*                                            *
-* Generated by CFT77   6.0.4.19              *
-*           on 06/27/00 at 04:34:13          *
-*                                            *
-**********************************************
-* ALLOW UNDERSCORES IN IDENTIFIERS
-            EDIT            OFF
-            FORMAT          NEW
-@DATA       SECTION         DATA,CM
-@DATA       =               W.*
-            CON             O'0000000000040000000000
-            CON             O'0435152404713723252514        ;GMPN_MUL       1
-            CON             O'0535270000000000000000        ;WW             1
-            CON             O'0000000000000001200012        ;trbk tbl       1
-            VWD             32/0,32/P.GMPN_MULWW            ;trbk tbl       1
-            CON             O'0014003000000000001416        ;trbk tbl       1
-            CON             O'0000000000000000000011        ;trbk tbl       1
-            CON             O'0000000000000000000215        ;trbk tbl       1
-            BSSZ            1                               ;trbk tbl       1
-@CODE       SECTION         CODE
-@CODE       =               P.*
-L3          =               P.*                             ;               1
-            A0              A6                              ;arg base       1
-            A5              6                               ;num Darg       1
-            B03,A5          0,A0                            ;load DAs       1
-            A0              A1+A2                           ;               1
-            A5              1                               ;num Ts         1
-            0,A0            T00,A5                          ;               1
-            B02             A2                              ;new base       1
-            B66             A3                              ;stk top        1
-            B01             A6                              ;arg base       1
-            A7              P.L4                            ;ofrn rtn       1
-            B00             A7                              ;return         1
-            A6              @DATA                           ;               1
-            J               $STKOFEN                        ;$STKOFEN       1
-GMPN_MULWW  =               P.*                             ;               1
-            A0              @DATA+3                         ;(trbk)         1
-            B77             A0                              ;(trbk)         1
-            A1              13                              ;num Bs         1
-            A0              B66                             ;stk top        1
-            A2              B66                             ;stk tmp        1
-            A4              B67                             ;stk limt       1
-            0,A0            B77,A1                          ;               1
-            A7              782                             ;stk size       1
-            A3              A2+A7                           ;               1
-            A0              A4-A3                           ;               1
-            JAM             L3                              ;overflow       1
-            A0              A6                              ;arg base       1
-            A5              6                               ;num Darg       1
-            B03,A5          0,A0                            ;load DAs       1
-            A0              A1+A2                           ;               1
-            A5              1                               ;num Ts         1
-            0,A0            T00,A5                          ;               1
-            B02             A2                              ;new base       1
-            B66             A3                              ;new top        1
-            B01             A6                              ;arg base       1
-L4          =               P.*                             ;ofrn rtn       1
-            A7              B07                             ;regs          14
-            S7              0,A7                            ;              14
-            A6              B10                             ;regs           9
-            S6              0,A6                            ;               9
-            S5              1                               ;              14
-            S4              <22                             ;               9
-            S7              S7-S5                           ;              14
-            S5              #S7                             ;              14
-            T00             S6                              ;regs          10
-            S6              S6>22                           ;              10
-            S7              T00                             ;regs          11
-            S7              S7>44                           ;              11
-            S3              T00                             ;regs           9
-            S3              S3&S4                           ;               9
-            S6              S6&S4                           ;              10
-            S7              S7&S4                           ;              11
-            S3              S3<24                           ;               9
-            S6              S6<24                           ;              10
-            S7              S7<24                           ;              11
-            S0              S5                              ;regs          14
-            S4              S5                              ;regs          14
-            S1              S6                              ;regs          14
-            S2              S3                              ;regs          14
-            S3              S7                              ;regs          14
-            JSP             L5                              ;              14
-L6          =               P.*                             ;              14
-            S7              -S4                             ;              14
-            A2              S7                              ;regs          14
-            VL              A2                              ;regs          14
-            A3              B06                             ;s_bt_sp       14
-            A5              B05                             ;s_bt_sp       14
-            A4              B04                             ;s_bt_sp       14
-            A1              VL                              ;              14
-            A2              S4                              ;regs          14
-L7          =               P.*                             ;              14
-            A0              A3                              ;regs          15
-            VL              A1                              ;regs          15
-            V7              ,A0,1                           ;              15
-            B11             A5                              ;s_bt_sp       15
-            A7              22                              ;              17
-            B12             A4                              ;s_bt_sp       17
-            V6              V7>A7                           ;              17
-            B13             A3                              ;s_bt_sp       17
-            S7              <22                             ;              17
-            A3              B02                             ;s_bt_sp       17
-            V5              S7&V6                           ;              17
-            A6              24                              ;              17
-            V4              V5<A6                           ;              17
-            V3              S1*FV4                          ;              22
-            V2              S7&V7                           ;              16
-            V1              V2<A6                           ;              16
-            V0              S3*FV1                          ;              22
-            V6              V0+V3                           ;              22
-            A5              44                              ;              18
-            V5              V7>A5                           ;              18
-            V2              S1*FV1                          ;              21
-            V3              S7&V5                           ;              18
-            A0              14                              ;              34
-            B77             A0                              ;regs          34
-            A4              B77                             ;regs          34
-            A0              A4+A3                           ;              34
-            ,A0,1           V2                              ;v_ld_str      34
-            V0              V3<A6                           ;              18
-            V7              S2*FV1                          ;              20
-            A4              142                             ;              34
-            A0              A4+A3                           ;              34
-            ,A0,1           V7                              ;v_ld_str      34
-            V5              V7>A7                           ;              28
-            V2              S2*FV0                          ;              22
-            V3              V6+V2                           ;              22
-            S7              <20                             ;              28
-            V1              S7&V3                           ;              28
-            A4              270                             ;              34
-            A0              A4+A3                           ;              34
-            ,A0,1           V0                              ;v_ld_str      34
-            A4              14                              ;              34
-            A0              A4+A3                           ;              34
-            V7              ,A0,1                           ;v_ld_str      34
-            V6              V1<A7                           ;              28
-            V2              S2*FV4                          ;              21
-            V0              V7+V2                           ;              21
-            S7              <42                             ;              28
-            V1              S7&V0                           ;              28
-            A4              398                             ;              34
-            A0              A4+A3                           ;              34
-            ,A0,1           V0                              ;v_ld_str      34
-            V7              S3*FV4                          ;              23
-            V2              V5+V1                           ;              28
-            V0              V3<A5                           ;              26
-            A5              526                             ;              34
-            A0              A5+A3                           ;              34
-            ,A0,1           V0                              ;v_ld_str      34
-            A5              270                             ;              34
-            A0              A5+A3                           ;              34
-            V4              ,A0,1                           ;v_ld_str      34
-            V5              V2+V6                           ;              28
-            A5              20                              ;              32
-            V1              V3>A5                           ;              32
-            V0              S1*FV4                          ;              23
-            A5              654                             ;              34
-            A0              A5+A3                           ;              34
-            ,A0,1           V1                              ;v_ld_str      34
-            V6              V7+V0                           ;              23
-            A5              2                               ;              32
-            V2              V6<A5                           ;              32
-            V3              S3*FV4                          ;              24
-            A5              142                             ;              34
-            A0              A5+A3                           ;              34
-            V1              ,A0,1                           ;v_ld_str      34
-            A5              526                             ;              34
-            A0              A5+A3                           ;              34
-            V7              ,A0,1                           ;v_ld_str      34
-            V0              V1+V7                           ;              26
-            V6              V3<A6                           ;              32
-            V4              V6+V2                           ;              32
-            A6              42                              ;              28
-            V7              V5>A6                           ;              28
-            A5              654                             ;              34
-            CPW                                             ;cmr_vrsp      34
-            A0              A5+A3                           ;              34
-            V1              ,A0,1                           ;v_ld_str      34
-            A5              398                             ;              34
-            A0              A5+A3                           ;              34
-            V3              ,A0,1                           ;v_ld_str      34
-            V6              V4+V1                           ;              32
-            V2              V3>A6                           ;              32
-            V5              V6+V2                           ;              32
-            A6              B12                             ;s_bt_sp       32
-            V4              V3<A7                           ;              26
-            A7              B13                             ;regs          34
-            A3              A7+A1                           ;              34
-            A7              B11                             ;regs          34
-            A5              A7+A1                           ;              34
-            A4              A6+A1                           ;              34
-            A7              A2+A1                           ;              34
-            A0              A2+A1                           ;              34
-            A2              128                             ;              34
-            B13             A0                              ;s_bt_sp       34
-            V1              V0+V4                           ;              26
-            A0              B11                             ;regs          31
-            ,A0,1           V1                              ;              31
-            V6              V5+V7                           ;              33
-            A0              A6                              ;regs          33
-            ,A0,1           V6                              ;              33
-            A0              B13                             ;regs          34
-            A1              A2                              ;regs          34
-            A2              A7                              ;regs          34
-            JAN             L7                              ;              34
-L8          =               P.*                             ;              34
-L5          =               P.*                             ;              34
-            S1              0                               ;              35
-            A0              B02                             ;              35
-            A2              B02                             ;              35
-            A1              13                              ;num Bs        35
-            B66             A0                              ;              35
-            B77,A1          0,A0                            ;              35
-            A0              A2+A1                           ;              35
-            A1              1                               ;num Ts        35
-            T00,A1          0,A0                            ;              35
-            J               B00                             ;              35
-            EXT             $STKOFEN:p
-            ENTRY           GMPN_MULWW
-            END
diff --git a/ghc/rts/gmp/mpn/cray/sub_n.c b/ghc/rts/gmp/mpn/cray/sub_n.c
deleted file mode 100644
index 902e07a727..0000000000
--- a/ghc/rts/gmp/mpn/cray/sub_n.c
+++ /dev/null
@@ -1,97 +0,0 @@
-/* mpn_sub_n -- Subtract two limb vectors of equal, non-zero length.
-   For Cray vector processors.
-
-   Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-   This file is part of the GNU MP Library.
-
-   The GNU MP Library is free software; you can redistribute it and/or modify
-   it under the terms of the GNU Lesser General Public License as published by
-   the Free Software Foundation; either version 2.1 of the License, or (at your
-   option) any later version.
-
-   The GNU MP Library is distributed in the hope that it will be useful, but
-   WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-   License for more details.
-
-   You should have received a copy of the GNU Lesser General Public License
-   along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-   the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-   MA 02111-1307, USA.  */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-mp_limb_t
-mpn_sub_n (c, a, b, n)
-     mp_ptr c;
-     mp_srcptr a, b;
-     mp_size_t n;
-{
-  mp_size_t i;
-  mp_size_t nm1 = n - 1;
-  int more_carries = 0;
-  int carry_out;
-
-  /* For small operands the non-vector code is faster.  */
-  if (n < 16)
-    goto sequential;
-
-  if (a == c || b == c)
-    {
-      TMP_DECL (marker);
-      TMP_MARK (marker);
-      if (c == a)
-	{
-	  /* allocate temp space for a */
-	  mp_ptr ax = (mp_ptr) TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-	  MPN_COPY (ax, a, n);
-	  a = (mp_srcptr) ax;
-	}
-      if (c == b)
-	{
-	  /* allocate temp space for b */
-	  mp_ptr bx = (mp_ptr) TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-	  MPN_COPY (bx, b, n);
-	  b = (mp_srcptr) bx;
-	}
-      carry_out = mpn_sub_n (c, a, b, n);
-      TMP_FREE (marker);
-      return carry_out;
-    }
-
-  carry_out = a[nm1] < b[nm1];
-
-#pragma _CRI ivdep			/* Cray PVP systems */
-  for (i = nm1; i > 0; i--)
-    {
-      int cy_in; mp_limb_t t;
-      cy_in = a[i - 1] < b[i - 1];
-      t = a[i] - b[i];
-      more_carries += t < cy_in;
-      c[i] = t - cy_in;
-    }
-  c[0] = a[0] - b[0];
-
-  if (more_carries)
-    {
-      /* This won't vectorize, but we should come here rarely.  */
-      int cy;
-    sequential:
-      cy = 0;
-      for (i = 0; i < n; i++)
-	{
-	  mp_limb_t ai, ci, t;
-	  ai = a[i];
-	  t = b[i] + cy;
-	  cy = t < cy;
-	  ci = ai - t;
-	  cy += ci > ai;
-	  c[i] = ci;
-	}
-      carry_out = cy;
-    }
-
-  return carry_out;
-}
diff --git a/ghc/rts/gmp/mpn/cray/submul_1.c b/ghc/rts/gmp/mpn/cray/submul_1.c
deleted file mode 100644
index 4d2fb13c62..0000000000
--- a/ghc/rts/gmp/mpn/cray/submul_1.c
+++ /dev/null
@@ -1,46 +0,0 @@
-/* mpn_submul_1 for Cray PVP.
-
-Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.  */
-
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-mp_limb_t
-mpn_submul_1 (mp_ptr rp, mp_srcptr up, mp_size_t n, mp_limb_t limb)
-{
-  mp_ptr p0, p1, tp;
-  mp_limb_t cy_limb;
-  TMP_DECL (marker);
-  TMP_MARK (marker);
-
-  p1 = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-  p0 = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-  tp = TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-
-  GMPN_MULWW (p1, p0, up, &n, &limb);
-  cy_limb = mpn_sub_n (tp, rp, p0, n);
-  rp[0] = tp[0];
-  cy_limb += mpn_sub_n (rp + 1, tp + 1, p1, n - 1);
-  cy_limb += p1[n - 1];
-
-  TMP_FREE (marker);
-  return cy_limb;
-}
diff --git a/ghc/rts/gmp/mpn/generic/add_n.c b/ghc/rts/gmp/mpn/generic/add_n.c
deleted file mode 100644
index 5fcb7e4835..0000000000
--- a/ghc/rts/gmp/mpn/generic/add_n.c
+++ /dev/null
@@ -1,62 +0,0 @@
-/* mpn_add_n -- Add two limb vectors of equal, non-zero length.
-
-Copyright (C) 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-mp_limb_t
-#if __STDC__
-mpn_add_n (mp_ptr res_ptr, mp_srcptr s1_ptr, mp_srcptr s2_ptr, mp_size_t size)
-#else
-mpn_add_n (res_ptr, s1_ptr, s2_ptr, size)
-     register mp_ptr res_ptr;
-     register mp_srcptr s1_ptr;
-     register mp_srcptr s2_ptr;
-     mp_size_t size;
-#endif
-{
-  register mp_limb_t x, y, cy;
-  register mp_size_t j;
-
-  /* The loop counter and index J goes from -SIZE to -1.  This way
-     the loop becomes faster.  */
-  j = -size;
-
-  /* Offset the base pointers to compensate for the negative indices.  */
-  s1_ptr -= j;
-  s2_ptr -= j;
-  res_ptr -= j;
-
-  cy = 0;
-  do
-    {
-      y = s2_ptr[j];
-      x = s1_ptr[j];
-      y += cy;			/* add previous carry to one addend */
-      cy = (y < cy);		/* get out carry from that addition */
-      y = x + y;		/* add other addend */
-      cy = (y < x) + cy;	/* get out carry from that add, combine */
-      res_ptr[j] = y;
-    }
-  while (++j != 0);
-
-  return cy;
-}
diff --git a/ghc/rts/gmp/mpn/generic/addmul_1.c b/ghc/rts/gmp/mpn/generic/addmul_1.c
deleted file mode 100644
index 746ae31307..0000000000
--- a/ghc/rts/gmp/mpn/generic/addmul_1.c
+++ /dev/null
@@ -1,65 +0,0 @@
-/* mpn_addmul_1 -- multiply the S1_SIZE long limb vector pointed to by S1_PTR
-   by S2_LIMB, add the S1_SIZE least significant limbs of the product to the
-   limb vector pointed to by RES_PTR.  Return the most significant limb of
-   the product, adjusted for carry-out from the addition.
-
-Copyright (C) 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-mp_limb_t
-mpn_addmul_1 (res_ptr, s1_ptr, s1_size, s2_limb)
-     register mp_ptr res_ptr;
-     register mp_srcptr s1_ptr;
-     mp_size_t s1_size;
-     register mp_limb_t s2_limb;
-{
-  register mp_limb_t cy_limb;
-  register mp_size_t j;
-  register mp_limb_t prod_high, prod_low;
-  register mp_limb_t x;
-
-  /* The loop counter and index J goes from -SIZE to -1.  This way
-     the loop becomes faster.  */
-  j = -s1_size;
-
-  /* Offset the base pointers to compensate for the negative indices.  */
-  res_ptr -= j;
-  s1_ptr -= j;
-
-  cy_limb = 0;
-  do
-    {
-      umul_ppmm (prod_high, prod_low, s1_ptr[j], s2_limb);
-
-      prod_low += cy_limb;
-      cy_limb = (prod_low < cy_limb) + prod_high;
-
-      x = res_ptr[j];
-      prod_low = x + prod_low;
-      cy_limb += (prod_low < x);
-      res_ptr[j] = prod_low;
-    }
-  while (++j != 0);
-
-  return cy_limb;
-}
diff --git a/ghc/rts/gmp/mpn/generic/addsub_n.c b/ghc/rts/gmp/mpn/generic/addsub_n.c
deleted file mode 100644
index c9bab3ef60..0000000000
--- a/ghc/rts/gmp/mpn/generic/addsub_n.c
+++ /dev/null
@@ -1,167 +0,0 @@
-/* mpn_addsub_n -- Add and Subtract two limb vectors of equal, non-zero length.
-
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-#ifndef L1_CACHE_SIZE
-#define L1_CACHE_SIZE 8192	/* only 68040 has less than this */
-#endif
-
-#define PART_SIZE (L1_CACHE_SIZE / BYTES_PER_MP_LIMB / 6)
-
-
-/* mpn_addsub_n.
-   r1[] = s1[] + s2[]
-   r2[] = s1[] - s2[]
-   All operands have n limbs.
-   In-place operations allowed.  */
-mp_limb_t
-#if __STDC__
-mpn_addsub_n (mp_ptr r1p, mp_ptr r2p, mp_srcptr s1p, mp_srcptr s2p, mp_size_t n)
-#else
-mpn_addsub_n (r1p, r2p, s1p, s2p, n)
-     mp_ptr r1p, r2p;
-     mp_srcptr s1p, s2p;
-     mp_size_t n;
-#endif
-{
-  mp_limb_t acyn, acyo;		/* carry for add */
-  mp_limb_t scyn, scyo;		/* carry for subtract */
-  mp_size_t off;		/* offset in operands */
-  mp_size_t this_n;		/* size of current chunk */
-
-  /* We alternatingly add and subtract in chunks that fit into the (L1)
-     cache.  Since the chunks are several hundred limbs, the function call
-     overhead is insignificant, but we get much better locality.  */
-
-  /* We have three variant of the inner loop, the proper loop is chosen
-     depending on whether r1 or r2 are the same operand as s1 or s2.  */
-
-  if (r1p != s1p && r1p != s2p)
-    {
-      /* r1 is not identical to either input operand.  We can therefore write
-	 to r1 directly, without using temporary storage.  */
-      acyo = 0;
-      scyo = 0;
-      for (off = 0; off < n; off += PART_SIZE)
-	{
-	  this_n = MIN (n - off, PART_SIZE);
-#if HAVE_NATIVE_mpn_add_nc || !HAVE_NATIVE_mpn_add_n
-	  acyo = mpn_add_nc (r1p + off, s1p + off, s2p + off, this_n, acyo);
-#else
-	  acyn = mpn_add_n (r1p + off, s1p + off, s2p + off, this_n);
-	  acyo = acyn + mpn_add_1 (r1p + off, r1p + off, this_n, acyo);
-#endif
-#if HAVE_NATIVE_mpn_sub_nc || !HAVE_NATIVE_mpn_sub_n
-	  scyo = mpn_sub_nc (r2p + off, s1p + off, s2p + off, this_n, scyo);
-#else
-	  scyn = mpn_sub_n (r2p + off, s1p + off, s2p + off, this_n);
-	  scyo = scyn + mpn_sub_1 (r2p + off, r2p + off, this_n, scyo);
-#endif
-	}
-    }
-  else if (r2p != s1p && r2p != s2p)
-    {
-      /* r2 is not identical to either input operand.  We can therefore write
-	 to r2 directly, without using temporary storage.  */
-      acyo = 0;
-      scyo = 0;
-      for (off = 0; off < n; off += PART_SIZE)
-	{
-	  this_n = MIN (n - off, PART_SIZE);
-#if HAVE_NATIVE_mpn_sub_nc || !HAVE_NATIVE_mpn_sub_n
-	  scyo = mpn_sub_nc (r2p + off, s1p + off, s2p + off, this_n, scyo);
-#else
-	  scyn = mpn_sub_n (r2p + off, s1p + off, s2p + off, this_n);
-	  scyo = scyn + mpn_sub_1 (r2p + off, r2p + off, this_n, scyo);
-#endif
-#if HAVE_NATIVE_mpn_add_nc || !HAVE_NATIVE_mpn_add_n
-	  acyo = mpn_add_nc (r1p + off, s1p + off, s2p + off, this_n, acyo);
-#else
-	  acyn = mpn_add_n (r1p + off, s1p + off, s2p + off, this_n);
-	  acyo = acyn + mpn_add_1 (r1p + off, r1p + off, this_n, acyo);
-#endif
-	}
-    }
-  else
-    {
-      /* r1 and r2 are identical to s1 and s2 (r1==s1 and r2=s2 or vice versa)
-	 Need temporary storage.  */
-      mp_limb_t tp[PART_SIZE];
-      acyo = 0;
-      scyo = 0;
-      for (off = 0; off < n; off += PART_SIZE)
-	{
-	  this_n = MIN (n - off, PART_SIZE);
-#if HAVE_NATIVE_mpn_add_nc || !HAVE_NATIVE_mpn_add_n
-	  acyo = mpn_add_nc (tp, s1p + off, s2p + off, this_n, acyo);
-#else
-	  acyn = mpn_add_n (tp, s1p + off, s2p + off, this_n);
-	  acyo = acyn + mpn_add_1 (tp, tp, this_n, acyo);
-#endif
-#if HAVE_NATIVE_mpn_sub_nc || !HAVE_NATIVE_mpn_sub_n
-	  scyo = mpn_sub_nc (r2p + off, s1p + off, s2p + off, this_n, scyo);
-#else
-	  scyn = mpn_sub_n (r2p + off, s1p + off, s2p + off, this_n);
-	  scyo = scyn + mpn_sub_1 (r2p + off, r2p + off, this_n, scyo);
-#endif
-	  MPN_COPY (r1p + off, tp, this_n);
-	}
-    }
-
-  return 2 * acyo + scyo;
-}
-
-#ifdef MAIN
-#include <stdlib.h>
-#include <stdio.h>
-#include "timing.h"
-
-long cputime ();
-
-int
-main (int argc, char **argv)
-{
-  mp_ptr r1p, r2p, s1p, s2p;
-  double t;
-  mp_size_t n;
-
-  n = strtol (argv[1], 0, 0);
-
-  r1p = malloc (n * BYTES_PER_MP_LIMB);
-  r2p = malloc (n * BYTES_PER_MP_LIMB);
-  s1p = malloc (n * BYTES_PER_MP_LIMB);
-  s2p = malloc (n * BYTES_PER_MP_LIMB);
-  TIME (t,(mpn_add_n(r1p,s1p,s2p,n),mpn_sub_n(r1p,s1p,s2p,n)));
-  printf ("              separate add and sub: %.3f\n", t);
-  TIME (t,mpn_addsub_n(r1p,r2p,s1p,s2p,n));
-  printf ("combined addsub separate variables: %.3f\n", t);
-  TIME (t,mpn_addsub_n(r1p,r2p,r1p,s2p,n));
-  printf ("        combined addsub r1 overlap: %.3f\n", t);
-  TIME (t,mpn_addsub_n(r1p,r2p,r1p,s2p,n));
-  printf ("        combined addsub r2 overlap: %.3f\n", t);
-  TIME (t,mpn_addsub_n(r1p,r2p,r1p,r2p,n));
-  printf ("          combined addsub in-place: %.3f\n", t);
-
-  return 0;
-}
-#endif
diff --git a/ghc/rts/gmp/mpn/generic/bdivmod.c b/ghc/rts/gmp/mpn/generic/bdivmod.c
deleted file mode 100644
index c4bcb414e6..0000000000
--- a/ghc/rts/gmp/mpn/generic/bdivmod.c
+++ /dev/null
@@ -1,120 +0,0 @@
-/* mpn/bdivmod.c: mpn_bdivmod for computing U/V mod 2^d.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1996, 1999, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/* q_high = mpn_bdivmod (qp, up, usize, vp, vsize, d).
-
-   Puts the low d/BITS_PER_MP_LIMB limbs of Q = U / V mod 2^d at qp, and
-   returns the high d%BITS_PER_MP_LIMB bits of Q as the result.
-
-   Also, U - Q * V mod 2^(usize*BITS_PER_MP_LIMB) is placed at up.  Since the
-   low d/BITS_PER_MP_LIMB limbs of this difference are zero, the code allows
-   the limb vectors at qp to overwrite the low limbs at up, provided qp <= up.
-
-   Preconditions:
-   1.  V is odd.
-   2.  usize * BITS_PER_MP_LIMB >= d.
-   3.  If Q and U overlap, qp <= up.
-
-   Ken Weber (kweber@mat.ufrgs.br, kweber@mcs.kent.edu)
-
-   Funding for this work has been partially provided by Conselho Nacional
-   de Desenvolvimento Cienti'fico e Tecnolo'gico (CNPq) do Brazil, Grant
-   301314194-2, and was done while I was a visiting reseacher in the Instituto
-   de Matema'tica at Universidade Federal do Rio Grande do Sul (UFRGS).
-
-   References:
-       T. Jebelean, An algorithm for exact division, Journal of Symbolic
-       Computation, v. 15, 1993, pp. 169-180.
-
-       K. Weber, The accelerated integer GCD algorithm, ACM Transactions on
-       Mathematical Software, v. 21 (March), 1995, pp. 111-122.  */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-mp_limb_t
-#if __STDC__
-mpn_bdivmod (mp_ptr qp, mp_ptr up, mp_size_t usize,
-	     mp_srcptr vp, mp_size_t vsize, unsigned long int d)
-#else
-mpn_bdivmod (qp, up, usize, vp, vsize, d)
-     mp_ptr qp;
-     mp_ptr up;
-     mp_size_t usize;
-     mp_srcptr vp;
-     mp_size_t vsize;
-     unsigned long int d;
-#endif
-{
-  mp_limb_t v_inv;
-
-  /* 1/V mod 2^BITS_PER_MP_LIMB. */
-  modlimb_invert (v_inv, vp[0]);
-
-  /* Fast code for two cases previously used by the accel part of mpn_gcd.
-     (Could probably remove this now it's inlined there.) */
-  if (usize == 2 && vsize == 2 &&
-      (d == BITS_PER_MP_LIMB || d == 2*BITS_PER_MP_LIMB))
-    {
-      mp_limb_t hi, lo;
-      mp_limb_t q = up[0] * v_inv;
-      umul_ppmm (hi, lo, q, vp[0]);
-      up[0] = 0, up[1] -= hi + q*vp[1], qp[0] = q;
-      if (d == 2*BITS_PER_MP_LIMB)
-	q = up[1] * v_inv, up[1] = 0, qp[1] = q;
-      return 0;
-    }
-
-  /* Main loop.  */
-  while (d >= BITS_PER_MP_LIMB)
-    {
-      mp_limb_t q = up[0] * v_inv;
-      mp_limb_t b = mpn_submul_1 (up, vp, MIN (usize, vsize), q);
-      if (usize > vsize)
-	mpn_sub_1 (up + vsize, up + vsize, usize - vsize, b);
-      d -= BITS_PER_MP_LIMB;
-      up += 1, usize -= 1;
-      *qp++ = q;
-    }
-
-  if (d)
-    {
-      mp_limb_t b;
-      mp_limb_t q = (up[0] * v_inv) & (((mp_limb_t)1<<d) - 1);
-      if (q <= 1)
-	{
-	  if (q == 0)
-	    return 0;
-	  else
-	    b = mpn_sub_n (up, up, vp, MIN (usize, vsize));
-	}
-      else
-	b = mpn_submul_1 (up, vp, MIN (usize, vsize), q);
-
-      if (usize > vsize)
-	mpn_sub_1 (up + vsize, up + vsize, usize - vsize, b);
-      return q;
-    }
-
-  return 0;
-}
diff --git a/ghc/rts/gmp/mpn/generic/bz_divrem_n.c b/ghc/rts/gmp/mpn/generic/bz_divrem_n.c
deleted file mode 100644
index d234b22af5..0000000000
--- a/ghc/rts/gmp/mpn/generic/bz_divrem_n.c
+++ /dev/null
@@ -1,153 +0,0 @@
-/* mpn_bz_divrem_n and auxilliary routines.
-
-   THE FUNCTIONS IN THIS FILE ARE INTERNAL FUNCTIONS WITH MUTABLE
-   INTERFACES.  IT IS ONLY SAFE TO REACH THEM THROUGH DOCUMENTED INTERFACES.
-   IN FACT, IT IS ALMOST GUARANTEED THAT THEY'LL CHANGE OR DISAPPEAR IN A
-   FUTURE GNU MP RELEASE.
-
-
-Copyright (C) 2000 Free Software Foundation, Inc.
-Contributed by Paul Zimmermann.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-/*
-[1] Fast Recursive Division, by Christoph Burnikel and Joachim Ziegler,
-    Technical report MPI-I-98-1-022, october 1998.
-    http://www.mpi-sb.mpg.de/~ziegler/TechRep.ps.gz
-*/
-
-static mp_limb_t mpn_bz_div_3_halves_by_2
-  _PROTO ((mp_ptr qp, mp_ptr np, mp_srcptr dp, mp_size_t n));
-
-
-/* mpn_bz_divrem_n(n) calls 2*mul(n/2)+2*div(n/2), thus to be faster than
-   div(n) = 4*div(n/2), we need mul(n/2) to be faster than the classic way,
-   i.e. n/2 >= KARATSUBA_MUL_THRESHOLD */
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD (7 * KARATSUBA_MUL_THRESHOLD)
-#endif
-
-#if 0
-static
-unused_mpn_divrem (qp, qxn, np, nn, dp, dn)
-     mp_ptr qp;
-     mp_size_t qxn;
-     mp_ptr np;
-     mp_size_t nn;
-     mp_srcptr dp;
-     mp_size_t dn;
-{
-  /* This might be useful: */
-  if (qxn != 0)
-    {
-      mp_limb_t c;
-      mp_ptr tp = alloca ((nn + qxn) * BYTES_PER_MP_LIMB);
-      MPN_COPY (tp + qxn - nn, np, nn);
-      MPN_ZERO (tp, qxn);
-      c = mpn_divrem (qp, 0L, tp, nn + qxn, dp, dn);
-      /* Maybe copy proper part of tp to np?  Documentation is unclear about
-	 the returned np value when qxn != 0 */
-      return c;
-    }
-}
-#endif
-
-
-/* mpn_bz_divrem_n - Implements algorithm of page 8 in [1]: divides (np,2n)
-   by (dp,n) and puts the quotient in (qp,n), the remainder in (np,n).
-   Returns most significant limb of the quotient, which is 0 or 1.
-   Requires that the most significant bit of the divisor is set.  */
-
-mp_limb_t
-#if __STDC__
-mpn_bz_divrem_n (mp_ptr qp, mp_ptr np, mp_srcptr dp, mp_size_t n)
-#else
-mpn_bz_divrem_n (qp, np, dp, n)
-     mp_ptr qp;
-     mp_ptr np;
-     mp_srcptr dp;
-     mp_size_t n;
-#endif
-{
-  mp_limb_t qhl, cc;
-
-  if (n % 2 != 0)
-    {
-      qhl = mpn_bz_divrem_n (qp + 1, np + 2, dp + 1, n - 1);
-      cc = mpn_submul_1 (np + 1, qp + 1, n - 1, dp[0]);
-      cc = mpn_sub_1 (np + n, np + n, 1, cc);
-      if (qhl) cc += mpn_sub_1 (np + n, np + n, 1, dp[0]);
-      while (cc)
-        {
-          qhl -= mpn_sub_1 (qp + 1, qp + 1, n - 1, (mp_limb_t) 1);
-          cc -= mpn_add_n (np + 1, np + 1, dp, n);
-        }
-      qhl += mpn_add_1 (qp + 1, qp + 1, n - 1,
-                        mpn_sb_divrem_mn (qp, np, n + 1, dp, n));
-    }
-  else
-    {
-      mp_size_t n2 = n/2;
-      qhl = mpn_bz_div_3_halves_by_2 (qp + n2, np + n2, dp, n2);
-      qhl += mpn_add_1 (qp + n2, qp + n2, n2,
-                        mpn_bz_div_3_halves_by_2 (qp, np, dp, n2));
-    }
-  return qhl;
-}
-
-
-/* divides (np, 3n) by (dp, 2n) and puts the quotient in (qp, n),
-   the remainder in (np, 2n) */
-
-static mp_limb_t
-#if __STDC__
-mpn_bz_div_3_halves_by_2 (mp_ptr qp, mp_ptr np, mp_srcptr dp, mp_size_t n)
-#else
-mpn_bz_div_3_halves_by_2 (qp, np, dp, n)
-     mp_ptr qp;
-     mp_ptr np;
-     mp_srcptr dp;
-     mp_size_t n;
-#endif
-{
-  mp_size_t twon = n + n; 
-  mp_limb_t qhl, cc;
-  mp_ptr tmp;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-  if (n < BZ_THRESHOLD)
-    qhl = mpn_sb_divrem_mn (qp, np + n, twon, dp + n, n);
-  else
-    qhl = mpn_bz_divrem_n (qp, np + n, dp + n, n);
-  tmp = (mp_ptr) TMP_ALLOC (twon * BYTES_PER_MP_LIMB);
-  mpn_mul_n (tmp, qp, dp, n);
-  cc = mpn_sub_n (np, np, tmp, twon);
-  TMP_FREE (marker);
-  if (qhl) cc += mpn_sub_n (np + n, np + n, dp, n);
-  while (cc)
-    {
-      qhl -= mpn_sub_1 (qp, qp, n, (mp_limb_t) 1);
-      cc -= mpn_add_n (np, np, dp, twon);
-    }
-  return qhl;
-}
diff --git a/ghc/rts/gmp/mpn/generic/cmp.c b/ghc/rts/gmp/mpn/generic/cmp.c
deleted file mode 100644
index 8e9792f54e..0000000000
--- a/ghc/rts/gmp/mpn/generic/cmp.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/* mpn_cmp -- Compare two low-level natural-number integers.
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-/* Compare OP1_PTR/OP1_SIZE with OP2_PTR/OP2_SIZE.
-   There are no restrictions on the relative sizes of
-   the two arguments.
-   Return 1 if OP1 > OP2, 0 if they are equal, and -1 if OP1 < OP2.  */
-
-int
-#if __STDC__
-mpn_cmp (mp_srcptr op1_ptr, mp_srcptr op2_ptr, mp_size_t size)
-#else
-mpn_cmp (op1_ptr, op2_ptr, size)
-     mp_srcptr op1_ptr;
-     mp_srcptr op2_ptr;
-     mp_size_t size;
-#endif
-{
-  mp_size_t i;
-  mp_limb_t op1_word, op2_word;
-
-  for (i = size - 1; i >= 0; i--)
-    {
-      op1_word = op1_ptr[i];
-      op2_word = op2_ptr[i];
-      if (op1_word != op2_word)
-	goto diff;
-    }
-  return 0;
- diff:
-  /* This can *not* be simplified to
-	op2_word - op2_word
-     since that expression might give signed overflow.  */
-  return (op1_word > op2_word) ? 1 : -1;
-}
diff --git a/ghc/rts/gmp/mpn/generic/diveby3.c b/ghc/rts/gmp/mpn/generic/diveby3.c
deleted file mode 100644
index a2fb552bfa..0000000000
--- a/ghc/rts/gmp/mpn/generic/diveby3.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/* mpn_divexact_by3 -- mpn division by 3, expecting no remainder. */
-
-/*
-Copyright (C) 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-
-/* Multiplicative inverse of 3, modulo 2^BITS_PER_MP_LIMB.
-   0xAAAAAAAB for 32 bits, 0xAAAAAAAAAAAAAAAB for 64 bits. */
-#define INVERSE_3      ((MP_LIMB_T_MAX / 3) * 2 + 1)
-
-
-/* The "c += ..."s are adding the high limb of 3*l to c.  That high limb
-   will be 0, 1 or 2.  Doing two separate "+="s seems to turn out better
-   code on gcc (as of 2.95.2 at least).
-
-   When a subtraction of a 0,1,2 carry value causes a borrow, that leaves a
-   limb value of either 0xFF...FF or 0xFF...FE and the multiply by INVERSE_3
-   gives 0x55...55 or 0xAA...AA respectively, producing a further borrow of
-   only 0 or 1 respectively.  Hence the carry out of each stage and for the
-   return value is always only 0, 1 or 2.  */
-
-mp_limb_t
-#if __STDC__
-mpn_divexact_by3c (mp_ptr dst, mp_srcptr src, mp_size_t size, mp_limb_t c)
-#else
-mpn_divexact_by3c (dst, src, size, c)
-     mp_ptr    dst;
-     mp_srcptr src;
-     mp_size_t size;
-     mp_limb_t c;
-#endif
-{
-  mp_size_t  i;
-
-  ASSERT (size >= 1);
-
-  i = 0;
-  do
-    {
-      mp_limb_t  l, s;
-
-      s = src[i];
-      l = s - c;
-      c = (l > s);
-
-      l *= INVERSE_3;
-      dst[i] = l;
-
-      c += (l > MP_LIMB_T_MAX/3);
-      c += (l > (MP_LIMB_T_MAX/3)*2);
-    }
-  while (++i < size);
-
-  return c;
-}
diff --git a/ghc/rts/gmp/mpn/generic/divrem.c b/ghc/rts/gmp/mpn/generic/divrem.c
deleted file mode 100644
index 30673e76d9..0000000000
--- a/ghc/rts/gmp/mpn/generic/divrem.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/* mpn_divrem -- Divide natural numbers, producing both remainder and
-   quotient.  This is now just a middle layer for calling the new
-   internal mpn_tdiv_qr.
-
-Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-mp_limb_t
-#if __STDC__
-mpn_divrem (mp_ptr qp, mp_size_t qxn,
-	    mp_ptr np, mp_size_t nn,
-	    mp_srcptr dp, mp_size_t dn)
-#else
-mpn_divrem (qp, qxn, np, nn, dp, dn)
-     mp_ptr qp;
-     mp_size_t qxn;
-     mp_ptr np;
-     mp_size_t nn;
-     mp_srcptr dp;
-     mp_size_t dn;
-#endif
-{
-  if (dn == 1)
-    {
-      mp_limb_t ret;
-      mp_ptr q2p;
-      mp_size_t qn;
-      TMP_DECL (marker);
-
-      TMP_MARK (marker);
-      q2p = (mp_ptr) TMP_ALLOC ((nn + qxn) * BYTES_PER_MP_LIMB);
-
-      np[0] = mpn_divrem_1 (q2p, qxn, np, nn, dp[0]);
-      qn = nn + qxn - 1;
-      MPN_COPY (qp, q2p, qn);
-      ret = q2p[qn];
-
-      TMP_FREE (marker);
-      return ret;
-    }
-  else if (dn == 2)
-    {
-      return mpn_divrem_2 (qp, qxn, np, nn, dp);
-    }
-  else
-    {
-      mp_ptr rp, q2p;
-      mp_limb_t qhl;
-      mp_size_t qn;
-      TMP_DECL (marker);
-
-      TMP_MARK (marker);
-      if (qxn != 0)
-	{
-	  mp_ptr n2p;
-	  n2p = (mp_ptr) TMP_ALLOC ((nn + qxn) * BYTES_PER_MP_LIMB);
-	  MPN_ZERO (n2p, qxn);
-	  MPN_COPY (n2p + qxn, np, nn);
-	  q2p = (mp_ptr) TMP_ALLOC ((nn - dn + qxn + 1) * BYTES_PER_MP_LIMB);
-	  rp = (mp_ptr) TMP_ALLOC (dn * BYTES_PER_MP_LIMB);
-	  mpn_tdiv_qr (q2p, rp, 0L, n2p, nn + qxn, dp, dn);
-	  MPN_COPY (np, rp, dn);
-	  qn = nn - dn + qxn;
-	  MPN_COPY (qp, q2p, qn);
-	  qhl = q2p[qn];
-	}
-      else
-	{
-	  q2p = (mp_ptr) TMP_ALLOC ((nn - dn + 1) * BYTES_PER_MP_LIMB);
-	  rp = (mp_ptr) TMP_ALLOC (dn * BYTES_PER_MP_LIMB);
-	  mpn_tdiv_qr (q2p, rp, 0L, np, nn, dp, dn);
-	  MPN_COPY (np, rp, dn);	/* overwrite np area with remainder */
-	  qn = nn - dn;
-	  MPN_COPY (qp, q2p, qn);
-	  qhl = q2p[qn];
-	}
-      TMP_FREE (marker);
-      return qhl;
-    }
-}
diff --git a/ghc/rts/gmp/mpn/generic/divrem_1.c b/ghc/rts/gmp/mpn/generic/divrem_1.c
deleted file mode 100644
index e93f241c9d..0000000000
--- a/ghc/rts/gmp/mpn/generic/divrem_1.c
+++ /dev/null
@@ -1,248 +0,0 @@
-/* mpn_divrem_1(quot_ptr, qsize, dividend_ptr, dividend_size, divisor_limb) --
-   Divide (DIVIDEND_PTR,,DIVIDEND_SIZE) by DIVISOR_LIMB.
-   Write DIVIDEND_SIZE limbs of quotient at QUOT_PTR.
-   Return the single-limb remainder.
-   There are no constraints on the value of the divisor.
-
-   QUOT_PTR and DIVIDEND_PTR might point to the same limb.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1998, 1999, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-
-/* __gmpn_divmod_1_internal(quot_ptr,dividend_ptr,dividend_size,divisor_limb)
-   Divide (DIVIDEND_PTR,,DIVIDEND_SIZE) by DIVISOR_LIMB.
-   Write DIVIDEND_SIZE limbs of quotient at QUOT_PTR.
-   Return the single-limb remainder.
-   There are no constraints on the value of the divisor.
-
-   QUOT_PTR and DIVIDEND_PTR might point to the same limb. */
-
-#ifndef UMUL_TIME
-#define UMUL_TIME 1
-#endif
-
-#ifndef UDIV_TIME
-#define UDIV_TIME UMUL_TIME
-#endif
-
-static mp_limb_t
-#if __STDC__
-__gmpn_divmod_1_internal (mp_ptr quot_ptr,
-	      mp_srcptr dividend_ptr, mp_size_t dividend_size,
-	      mp_limb_t divisor_limb)
-#else
-__gmpn_divmod_1_internal (quot_ptr, dividend_ptr, dividend_size, divisor_limb)
-     mp_ptr quot_ptr;
-     mp_srcptr dividend_ptr;
-     mp_size_t dividend_size;
-     mp_limb_t divisor_limb;
-#endif
-{
-  mp_size_t i;
-  mp_limb_t n1, n0, r;
-  int dummy;
-
-  /* ??? Should this be handled at all?  Rely on callers?  */
-  if (dividend_size == 0)
-    return 0;
-
-  /* If multiplication is much faster than division, and the
-     dividend is large, pre-invert the divisor, and use
-     only multiplications in the inner loop.  */
-
-  /* This test should be read:
-       Does it ever help to use udiv_qrnnd_preinv?
-	 && Does what we save compensate for the inversion overhead?  */
-  if (UDIV_TIME > (2 * UMUL_TIME + 6)
-      && (UDIV_TIME - (2 * UMUL_TIME + 6)) * dividend_size > UDIV_TIME)
-    {
-      int normalization_steps;
-
-      count_leading_zeros (normalization_steps, divisor_limb);
-      if (normalization_steps != 0)
-	{
-	  mp_limb_t divisor_limb_inverted;
-
-	  divisor_limb <<= normalization_steps;
-	  invert_limb (divisor_limb_inverted, divisor_limb);
-
-	  n1 = dividend_ptr[dividend_size - 1];
-	  r = n1 >> (BITS_PER_MP_LIMB - normalization_steps);
-
-	  /* Possible optimization:
-	     if (r == 0
-	     && divisor_limb > ((n1 << normalization_steps)
-			     | (dividend_ptr[dividend_size - 2] >> ...)))
-	     ...one division less... */
-
-	  for (i = dividend_size - 2; i >= 0; i--)
-	    {
-	      n0 = dividend_ptr[i];
-	      udiv_qrnnd_preinv (quot_ptr[i + 1], r, r,
-				 ((n1 << normalization_steps)
-				  | (n0 >> (BITS_PER_MP_LIMB - normalization_steps))),
-				 divisor_limb, divisor_limb_inverted);
-	      n1 = n0;
-	    }
-	  udiv_qrnnd_preinv (quot_ptr[0], r, r,
-			     n1 << normalization_steps,
-			     divisor_limb, divisor_limb_inverted);
-	  return r >> normalization_steps;
-	}
-      else
-	{
-	  mp_limb_t divisor_limb_inverted;
-
-	  invert_limb (divisor_limb_inverted, divisor_limb);
-
-	  i = dividend_size - 1;
-	  r = dividend_ptr[i];
-
-	  if (r >= divisor_limb)
-	    r = 0;
-	  else
-	    {
-	      quot_ptr[i] = 0;
-	      i--;
-	    }
-
-	  for (; i >= 0; i--)
-	    {
-	      n0 = dividend_ptr[i];
-	      udiv_qrnnd_preinv (quot_ptr[i], r, r,
-				 n0, divisor_limb, divisor_limb_inverted);
-	    }
-	  return r;
-	}
-    }
-  else
-    {
-      if (UDIV_NEEDS_NORMALIZATION)
-	{
-	  int normalization_steps;
-
-	  count_leading_zeros (normalization_steps, divisor_limb);
-	  if (normalization_steps != 0)
-	    {
-	      divisor_limb <<= normalization_steps;
-
-	      n1 = dividend_ptr[dividend_size - 1];
-	      r = n1 >> (BITS_PER_MP_LIMB - normalization_steps);
-
-	      /* Possible optimization:
-		 if (r == 0
-		 && divisor_limb > ((n1 << normalization_steps)
-				 | (dividend_ptr[dividend_size - 2] >> ...)))
-		 ...one division less... */
-
-	      for (i = dividend_size - 2; i >= 0; i--)
-		{
-		  n0 = dividend_ptr[i];
-		  udiv_qrnnd (quot_ptr[i + 1], r, r,
-			      ((n1 << normalization_steps)
-			       | (n0 >> (BITS_PER_MP_LIMB - normalization_steps))),
-			      divisor_limb);
-		  n1 = n0;
-		}
-	      udiv_qrnnd (quot_ptr[0], r, r,
-			  n1 << normalization_steps,
-			  divisor_limb);
-	      return r >> normalization_steps;
-	    }
-	}
-      /* No normalization needed, either because udiv_qrnnd doesn't require
-	 it, or because DIVISOR_LIMB is already normalized.  */
-
-      i = dividend_size - 1;
-      r = dividend_ptr[i];
-
-      if (r >= divisor_limb)
-	r = 0;
-      else
-	{
-	  quot_ptr[i] = 0;
-	  i--;
-	}
-
-      for (; i >= 0; i--)
-	{
-	  n0 = dividend_ptr[i];
-	  udiv_qrnnd (quot_ptr[i], r, r, n0, divisor_limb);
-	}
-      return r;
-    }
-}
-
-
-
-mp_limb_t
-#if __STDC__
-mpn_divrem_1 (mp_ptr qp, mp_size_t qxn,
-	      mp_srcptr np, mp_size_t nn,
-	      mp_limb_t d)
-#else
-mpn_divrem_1 (qp, qxn, np, nn, d)
-     mp_ptr qp;
-     mp_size_t qxn;
-     mp_srcptr np;
-     mp_size_t nn;
-     mp_limb_t d;
-#endif
-{
-  mp_limb_t rlimb;
-  mp_size_t i;
-
-  /* Develop integer part of quotient.  */
-  rlimb = __gmpn_divmod_1_internal (qp + qxn, np, nn, d);
-
-  /* Develop fraction part of quotient.  This is not as fast as it should;
-     the preinvert stuff from __gmpn_divmod_1_internal ought to be used here
-     too.  */
-  if (UDIV_NEEDS_NORMALIZATION)
-    {
-      int normalization_steps;
-
-      count_leading_zeros (normalization_steps, d);
-      if (normalization_steps != 0)
-	{
-	  d <<= normalization_steps;
-	  rlimb <<= normalization_steps;
-
-	  for (i = qxn - 1; i >= 0; i--)
-	    udiv_qrnnd (qp[i], rlimb, rlimb, 0, d);
-
-	  return rlimb >> normalization_steps;
-	}
-      else
-	/* fall out */
-	;
-    }
-
-  for (i = qxn - 1; i >= 0; i--)
-    udiv_qrnnd (qp[i], rlimb, rlimb, 0, d);
-
-  return rlimb;
-}
diff --git a/ghc/rts/gmp/mpn/generic/divrem_2.c b/ghc/rts/gmp/mpn/generic/divrem_2.c
deleted file mode 100644
index 0bc31ae2e7..0000000000
--- a/ghc/rts/gmp/mpn/generic/divrem_2.c
+++ /dev/null
@@ -1,151 +0,0 @@
-/* mpn_divrem_2 -- Divide natural numbers, producing both remainder and
-   quotient.  The divisor is two limbs.
-
-   THIS FILE CONTAINS INTERNAL FUNCTIONS WITH MUTABLE INTERFACES.  IT IS
-   ONLY SAFE TO REACH THEM THROUGH DOCUMENTED INTERFACES.  IN FACT, IT IS
-   ALMOST GUARANTEED THAT THEY'LL CHANGE OR DISAPPEAR IN A FUTURE GNU MP
-   RELEASE.
-
-
-Copyright (C) 1993, 1994, 1995, 1996, 1999, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-/* Divide num (NP/NSIZE) by den (DP/2) and write
-   the NSIZE-2 least significant quotient limbs at QP
-   and the 2 long remainder at NP.  If QEXTRA_LIMBS is
-   non-zero, generate that many fraction bits and append them after the
-   other quotient limbs.
-   Return the most significant limb of the quotient, this is always 0 or 1.
-
-   Preconditions:
-   0. NSIZE >= 2.
-   1. The most significant bit of the divisor must be set.
-   2. QP must either not overlap with the input operands at all, or
-      QP + 2 >= NP must hold true.  (This means that it's
-      possible to put the quotient in the high part of NUM, right after the
-      remainder in NUM.
-   3. NSIZE >= 2, even if QEXTRA_LIMBS is non-zero.  */
-
-mp_limb_t
-#if __STDC__
-mpn_divrem_2 (mp_ptr qp, mp_size_t qxn,
-	      mp_ptr np, mp_size_t nsize,
-	      mp_srcptr dp)
-#else
-mpn_divrem_2 (qp, qxn, np, nsize, dp)
-     mp_ptr qp;
-     mp_size_t qxn;
-     mp_ptr np;
-     mp_size_t nsize;
-     mp_srcptr dp;
-#endif
-{
-  mp_limb_t most_significant_q_limb = 0;
-  mp_size_t i;
-  mp_limb_t n1, n0, n2;
-  mp_limb_t d1, d0;
-  mp_limb_t d1inv;
-  int have_preinv;
-
-  np += nsize - 2;
-  d1 = dp[1];
-  d0 = dp[0];
-  n1 = np[1];
-  n0 = np[0];
-
-  if (n1 >= d1 && (n1 > d1 || n0 >= d0))
-    {
-      sub_ddmmss (n1, n0, n1, n0, d1, d0);
-      most_significant_q_limb = 1;
-    }
-
-  /* If multiplication is much faster than division, preinvert the most 
-     significant divisor limb before entering the loop.  */
-  if (UDIV_TIME > 2 * UMUL_TIME + 6)
-    {
-      have_preinv = 0;
-      if ((UDIV_TIME - (2 * UMUL_TIME + 6)) * (nsize - 2) > UDIV_TIME)
-	{
-	  invert_limb (d1inv, d1);
-	  have_preinv = 1;
-	}
-    }
-
-  for (i = qxn + nsize - 2 - 1; i >= 0; i--)
-    {
-      mp_limb_t q;
-      mp_limb_t r;
-
-      if (i >= qxn)
-	np--;
-      else
-	np[0] = 0;
-
-      if (n1 == d1)
-	{
-	  /* Q should be either 111..111 or 111..110.  Need special treatment
-	     of this rare case as normal division would give overflow.  */
-	  q = ~(mp_limb_t) 0;
-
-	  r = n0 + d1;
-	  if (r < d1)	/* Carry in the addition? */
-	    {
-	      add_ssaaaa (n1, n0, r - d0, np[0], 0, d0);
-	      qp[i] = q;
-	      continue;
-	    }
-	  n1 = d0 - (d0 != 0);
-	  n0 = -d0;
-	}
-      else
-	{
-	  if (UDIV_TIME > 2 * UMUL_TIME + 6 && have_preinv)
-	    udiv_qrnnd_preinv (q, r, n1, n0, d1, d1inv);
-	  else
-	    udiv_qrnnd (q, r, n1, n0, d1);
-	  umul_ppmm (n1, n0, d0, q);
-	}
-
-      n2 = np[0];
-
-    q_test:
-      if (n1 > r || (n1 == r && n0 > n2))
-	{
-	  /* The estimated Q was too large.  */
-	  q--;
-
-	  sub_ddmmss (n1, n0, n1, n0, 0, d0);
-	  r += d1;
-	  if (r >= d1)	/* If not carry, test Q again.  */
-	    goto q_test;
-	}
-
-      qp[i] = q;
-      sub_ddmmss (n1, n0, r, n2, n1, n0);
-    }
-  np[1] = n1;
-  np[0] = n0;
-
-  return most_significant_q_limb;
-}
diff --git a/ghc/rts/gmp/mpn/generic/dump.c b/ghc/rts/gmp/mpn/generic/dump.c
deleted file mode 100644
index 66f375c74b..0000000000
--- a/ghc/rts/gmp/mpn/generic/dump.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/* THIS IS AN INTERNAL FUNCTION WITH A MUTABLE INTERFACE.  IT IS NOT SAFE TO
-   CALL THIS FUNCTION DIRECTLY.  IN FACT, IT IS ALMOST GUARANTEED THAT THIS
-   FUNCTION WILL CHANGE OR DISAPPEAR IN A FUTURE GNU MP RELEASE.
-
-
-Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-#include <stdio.h>
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpn_dump (mp_srcptr ptr, mp_size_t size)
-#else
-mpn_dump (ptr, size)
-     mp_srcptr ptr;
-     mp_size_t size;
-#endif
-{
-  MPN_NORMALIZE (ptr, size);
-
-  if (size == 0)
-    printf ("0\n");
-  else
-    {
-      size--;
-      if (BYTES_PER_MP_LIMB > sizeof (long))
-	{
-	  if ((ptr[size] >> BITS_PER_MP_LIMB/2) != 0)
-	    {
-	      printf ("%lX",
-		      (unsigned long) (ptr[size] >> BITS_PER_MP_LIMB/2));
-	      printf ("%0*lX", (int) (BYTES_PER_MP_LIMB),
-		      (unsigned long) ptr[size]);
-	    }
-	  else
-	    printf ("%lX", (unsigned long) ptr[size]);
-	}
-      else
-	printf ("%lX", ptr[size]);
-
-      while (size)
-	{
-	  size--;
-	  if (BYTES_PER_MP_LIMB > sizeof (long))
-	    {
-	      printf ("%0*lX", (int) (BYTES_PER_MP_LIMB),
-		(unsigned long) (ptr[size] >> BITS_PER_MP_LIMB/2));
-	      printf ("%0*lX", (int) (BYTES_PER_MP_LIMB),
-		(unsigned long) ptr[size]);
-	    }
-	  else
-	    printf ("%0*lX", (int) (2 * BYTES_PER_MP_LIMB), ptr[size]);
-	}
-      printf ("\n");
-    }
-}
diff --git a/ghc/rts/gmp/mpn/generic/gcd.c b/ghc/rts/gmp/mpn/generic/gcd.c
deleted file mode 100644
index 059e219a06..0000000000
--- a/ghc/rts/gmp/mpn/generic/gcd.c
+++ /dev/null
@@ -1,414 +0,0 @@
-/* mpn/gcd.c: mpn_gcd for gcd of two odd integers.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1996, 1997, 1998, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/* Integer greatest common divisor of two unsigned integers, using
-   the accelerated algorithm (see reference below).
-
-   mp_size_t mpn_gcd (up, usize, vp, vsize).
-
-   Preconditions [U = (up, usize) and V = (vp, vsize)]:
-
-   1.  V is odd.
-   2.  numbits(U) >= numbits(V).
-
-   Both U and V are destroyed by the operation.  The result is left at vp,
-   and its size is returned.
-
-   Ken Weber (kweber@mat.ufrgs.br, kweber@mcs.kent.edu)
-
-   Funding for this work has been partially provided by Conselho Nacional
-   de Desenvolvimento Cienti'fico e Tecnolo'gico (CNPq) do Brazil, Grant
-   301314194-2, and was done while I was a visiting reseacher in the Instituto
-   de Matema'tica at Universidade Federal do Rio Grande do Sul (UFRGS).
-
-   Refer to
-	K. Weber, The accelerated integer GCD algorithm, ACM Transactions on
-	Mathematical Software, v. 21 (March), 1995, pp. 111-122.  */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-/* If MIN (usize, vsize) >= GCD_ACCEL_THRESHOLD, then the accelerated
-   algorithm is used, otherwise the binary algorithm is used.  This may be
-   adjusted for different architectures.  */
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD 5
-#endif
-
-/* When U and V differ in size by more than BMOD_THRESHOLD, the accelerated
-   algorithm reduces using the bmod operation.  Otherwise, the k-ary reduction
-   is used.  0 <= BMOD_THRESHOLD < BITS_PER_MP_LIMB.  */
-enum
-  {
-    BMOD_THRESHOLD = BITS_PER_MP_LIMB/2
-  };
-
-
-/* Use binary algorithm to compute V <-- GCD (V, U) for usize, vsize == 2.
-   Both U and V must be odd.  */
-static __gmp_inline mp_size_t
-#if __STDC__
-gcd_2 (mp_ptr vp, mp_srcptr up)
-#else
-gcd_2 (vp, up)
-     mp_ptr vp;
-     mp_srcptr up;
-#endif
-{
-  mp_limb_t u0, u1, v0, v1;
-  mp_size_t vsize;
-
-  u0 = up[0], u1 = up[1], v0 = vp[0], v1 = vp[1];
-
-  while (u1 != v1 && u0 != v0)
-    {
-      unsigned long int r;
-      if (u1 > v1)
-	{
-	  u1 -= v1 + (u0 < v0), u0 -= v0;
-	  count_trailing_zeros (r, u0);
-	  u0 = u1 << (BITS_PER_MP_LIMB - r) | u0 >> r;
-	  u1 >>= r;
-	}
-      else  /* u1 < v1.  */
-	{
-	  v1 -= u1 + (v0 < u0), v0 -= u0;
-	  count_trailing_zeros (r, v0);
-	  v0 = v1 << (BITS_PER_MP_LIMB - r) | v0 >> r;
-	  v1 >>= r;
-	}
-    }
-
-  vp[0] = v0, vp[1] = v1, vsize = 1 + (v1 != 0);
-
-  /* If U == V == GCD, done.  Otherwise, compute GCD (V, |U - V|).  */
-  if (u1 == v1 && u0 == v0)
-    return vsize;
-
-  v0 = (u0 == v0) ? (u1 > v1) ? u1-v1 : v1-u1 : (u0 > v0) ? u0-v0 : v0-u0;
-  vp[0] = mpn_gcd_1 (vp, vsize, v0);
-
-  return 1;
-}
-
-/* The function find_a finds 0 < N < 2^BITS_PER_MP_LIMB such that there exists
-   0 < |D| < 2^BITS_PER_MP_LIMB, and N == D * C mod 2^(2*BITS_PER_MP_LIMB).
-   In the reference article, D was computed along with N, but it is better to
-   compute D separately as D <-- N / C mod 2^(BITS_PER_MP_LIMB + 1), treating
-   the result as a twos' complement signed integer.
-
-   Initialize N1 to C mod 2^(2*BITS_PER_MP_LIMB).  According to the reference
-   article, N2 should be initialized to 2^(2*BITS_PER_MP_LIMB), but we use
-   2^(2*BITS_PER_MP_LIMB) - N1 to start the calculations within double
-   precision.  If N2 > N1 initially, the first iteration of the while loop
-   will swap them.  In all other situations, N1 >= N2 is maintained.  */
-
-static
-#if ! defined (__i386__)
-__gmp_inline			/* don't inline this for the x86 */
-#endif
-mp_limb_t
-#if __STDC__
-find_a (mp_srcptr cp)
-#else
-find_a (cp)
-     mp_srcptr cp;
-#endif
-{
-  unsigned long int leading_zero_bits = 0;
-
-  mp_limb_t n1_l = cp[0];	/* N1 == n1_h * 2^BITS_PER_MP_LIMB + n1_l.  */
-  mp_limb_t n1_h = cp[1];
-
-  mp_limb_t n2_l = -n1_l;	/* N2 == n2_h * 2^BITS_PER_MP_LIMB + n2_l.  */
-  mp_limb_t n2_h = ~n1_h;
-
-  /* Main loop.  */
-  while (n2_h)			/* While N2 >= 2^BITS_PER_MP_LIMB.  */
-    {
-      /* N1 <-- N1 % N2.  */
-      if ((MP_LIMB_T_HIGHBIT >> leading_zero_bits & n2_h) == 0)
-	{
-	  unsigned long int i;
-	  count_leading_zeros (i, n2_h);
-	  i -= leading_zero_bits, leading_zero_bits += i;
-	  n2_h = n2_h<<i | n2_l>>(BITS_PER_MP_LIMB - i), n2_l <<= i;
-	  do
-	    {
-	      if (n1_h > n2_h || (n1_h == n2_h && n1_l >= n2_l))
-		n1_h -= n2_h + (n1_l < n2_l), n1_l -= n2_l;
-	      n2_l = n2_l>>1 | n2_h<<(BITS_PER_MP_LIMB - 1), n2_h >>= 1;
-	      i -= 1;
-	    }
-	  while (i);
-	}
-      if (n1_h > n2_h || (n1_h == n2_h && n1_l >= n2_l))
-	n1_h -= n2_h + (n1_l < n2_l), n1_l -= n2_l;
-
-      MP_LIMB_T_SWAP (n1_h, n2_h);
-      MP_LIMB_T_SWAP (n1_l, n2_l);
-    }
-
-  return n2_l;
-}
-
-mp_size_t
-#if __STDC__
-mpn_gcd (mp_ptr gp, mp_ptr up, mp_size_t usize, mp_ptr vp, mp_size_t vsize)
-#else
-mpn_gcd (gp, up, usize, vp, vsize)
-     mp_ptr gp;
-     mp_ptr up;
-     mp_size_t usize;
-     mp_ptr vp;
-     mp_size_t vsize;
-#endif
-{
-  mp_ptr orig_vp = vp;
-  mp_size_t orig_vsize = vsize;
-  int binary_gcd_ctr;		/* Number of times binary gcd will execute.  */
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-
-  /* Use accelerated algorithm if vsize is over GCD_ACCEL_THRESHOLD.
-     Two EXTRA limbs for U and V are required for kary reduction.  */
-  if (vsize >= GCD_ACCEL_THRESHOLD)
-    {
-      unsigned long int vbitsize, d;
-      mp_ptr orig_up = up;
-      mp_size_t orig_usize = usize;
-      mp_ptr anchor_up = (mp_ptr) TMP_ALLOC ((usize + 2) * BYTES_PER_MP_LIMB);
-
-      MPN_COPY (anchor_up, orig_up, usize);
-      up = anchor_up;
-
-      count_leading_zeros (d, up[usize-1]);
-      d = usize * BITS_PER_MP_LIMB - d;
-      count_leading_zeros (vbitsize, vp[vsize-1]);
-      vbitsize = vsize * BITS_PER_MP_LIMB - vbitsize;
-      d = d - vbitsize + 1;
-
-      /* Use bmod reduction to quickly discover whether V divides U.  */
-      up[usize++] = 0;				/* Insert leading zero.  */
-      mpn_bdivmod (up, up, usize, vp, vsize, d);
-
-      /* Now skip U/V mod 2^d and any low zero limbs.  */
-      d /= BITS_PER_MP_LIMB, up += d, usize -= d;
-      while (usize != 0 && up[0] == 0)
-	up++, usize--;
-
-      if (usize == 0)				/* GCD == ORIG_V.  */
-	goto done;
-
-      vp = (mp_ptr) TMP_ALLOC ((vsize + 2) * BYTES_PER_MP_LIMB);
-      MPN_COPY (vp, orig_vp, vsize);
-
-      do					/* Main loop.  */
-	{
-          /* mpn_com_n can't be used here because anchor_up and up may
-             partially overlap */
-	  if (up[usize-1] & MP_LIMB_T_HIGHBIT)  /* U < 0; take twos' compl. */
-	    {
-	      mp_size_t i;
-	      anchor_up[0] = -up[0];
-	      for (i = 1; i < usize; i++)
-		anchor_up[i] = ~up[i];
-	      up = anchor_up;
-	    }
-
-	  MPN_NORMALIZE_NOT_ZERO (up, usize);
-
-	  if ((up[0] & 1) == 0)			/* Result even; remove twos. */
-	    {
-	      unsigned int r;
-	      count_trailing_zeros (r, up[0]);
-	      mpn_rshift (anchor_up, up, usize, r);
-	      usize -= (anchor_up[usize-1] == 0);
-	    }
-	  else if (anchor_up != up)
-	    MPN_COPY_INCR (anchor_up, up, usize);
-
-	  MPN_PTR_SWAP (anchor_up,usize, vp,vsize);
-	  up = anchor_up;
-
-	  if (vsize <= 2)		/* Kary can't handle < 2 limbs and  */
-	    break;			/* isn't efficient for == 2 limbs.  */
-
-	  d = vbitsize;
-	  count_leading_zeros (vbitsize, vp[vsize-1]);
-	  vbitsize = vsize * BITS_PER_MP_LIMB - vbitsize;
-	  d = d - vbitsize + 1;
-
-	  if (d > BMOD_THRESHOLD)	/* Bmod reduction.  */
-	    {
-	      up[usize++] = 0;
-	      mpn_bdivmod (up, up, usize, vp, vsize, d);
-	      d /= BITS_PER_MP_LIMB, up += d, usize -= d;
-	    }
-	  else				/* Kary reduction.  */
-	    {
-	      mp_limb_t bp[2], cp[2];
-
-	      /* C <-- V/U mod 2^(2*BITS_PER_MP_LIMB).  */
-              {
-                mp_limb_t u_inv, hi, lo;
-                modlimb_invert (u_inv, up[0]);
-                cp[0] = vp[0] * u_inv;
-                umul_ppmm (hi, lo, cp[0], up[0]);
-                cp[1] = (vp[1] - hi - cp[0] * up[1]) * u_inv;
-              }
-
-	      /* U <-- find_a (C)  *  U.  */
-	      up[usize] = mpn_mul_1 (up, up, usize, find_a (cp));
-	      usize++;
-
-	      /* B <-- A/C == U/V mod 2^(BITS_PER_MP_LIMB + 1).
-		  bp[0] <-- U/V mod 2^BITS_PER_MP_LIMB and
-		  bp[1] <-- ( (U - bp[0] * V)/2^BITS_PER_MP_LIMB ) / V mod 2
-
-                 Like V/U above, but simplified because only the low bit of
-                 bp[1] is wanted. */
-              {
-                mp_limb_t  v_inv, hi, lo;
-                modlimb_invert (v_inv, vp[0]);
-                bp[0] = up[0] * v_inv;
-                umul_ppmm (hi, lo, bp[0], vp[0]);
-                bp[1] = (up[1] + hi + (bp[0]&vp[1])) & 1;
-              }
-
-	      up[usize++] = 0;
-	      if (bp[1])	/* B < 0: U <-- U + (-B)  * V.  */
-		{
-		   mp_limb_t c = mpn_addmul_1 (up, vp, vsize, -bp[0]);
-		   mpn_add_1 (up + vsize, up + vsize, usize - vsize, c);
-		}
-	      else		/* B >= 0:  U <-- U - B * V.  */
-		{
-		  mp_limb_t b = mpn_submul_1 (up, vp, vsize, bp[0]);
-		  mpn_sub_1 (up + vsize, up + vsize, usize - vsize, b);
-		}
-
-	      up += 2, usize -= 2;  /* At least two low limbs are zero.  */
-	    }
-
-	  /* Must remove low zero limbs before complementing.  */
-	  while (usize != 0 && up[0] == 0)
-	    up++, usize--;
-	}
-      while (usize);
-
-      /* Compute GCD (ORIG_V, GCD (ORIG_U, V)).  Binary will execute twice.  */
-      up = orig_up, usize = orig_usize;
-      binary_gcd_ctr = 2;
-    }
-  else
-    binary_gcd_ctr = 1;
-
-  /* Finish up with the binary algorithm.  Executes once or twice.  */
-  for ( ; binary_gcd_ctr--; up = orig_vp, usize = orig_vsize)
-    {
-      if (usize > 2)		/* First make U close to V in size.  */
-	{
-	  unsigned long int vbitsize, d;
-	  count_leading_zeros (d, up[usize-1]);
-	  d = usize * BITS_PER_MP_LIMB - d;
-	  count_leading_zeros (vbitsize, vp[vsize-1]);
-	  vbitsize = vsize * BITS_PER_MP_LIMB - vbitsize;
-	  d = d - vbitsize - 1;
-	  if (d != -(unsigned long int)1 && d > 2)
-	    {
-	      mpn_bdivmod (up, up, usize, vp, vsize, d);  /* Result > 0.  */
-	      d /= (unsigned long int)BITS_PER_MP_LIMB, up += d, usize -= d;
-	    }
-	}
-
-      /* Start binary GCD.  */
-      do
-	{
-	  mp_size_t zeros;
-
-	  /* Make sure U is odd.  */
-	  MPN_NORMALIZE (up, usize);
-	  while (up[0] == 0)
-	    up += 1, usize -= 1;
-	  if ((up[0] & 1) == 0)
-	    {
-	      unsigned int r;
-	      count_trailing_zeros (r, up[0]);
-	      mpn_rshift (up, up, usize, r);
-	      usize -= (up[usize-1] == 0);
-	    }
-
-	  /* Keep usize >= vsize.  */
-	  if (usize < vsize)
-	    MPN_PTR_SWAP (up, usize, vp, vsize);
-
-	  if (usize <= 2)				/* Double precision. */
-	    {
-	      if (vsize == 1)
-		vp[0] = mpn_gcd_1 (up, usize, vp[0]);
-	      else
-		vsize = gcd_2 (vp, up);
-	      break;					/* Binary GCD done.  */
-	    }
-
-	  /* Count number of low zero limbs of U - V.  */
-	  for (zeros = 0; up[zeros] == vp[zeros] && ++zeros != vsize; )
-	    continue;
-
-	  /* If U < V, swap U and V; in any case, subtract V from U.  */
-	  if (zeros == vsize)				/* Subtract done.  */
-	    up += zeros, usize -= zeros;
-	  else if (usize == vsize)
-	    {
-	      mp_size_t size = vsize;
-	      do
-		size--;
-	      while (up[size] == vp[size]);
-	      if (up[size] < vp[size])			/* usize == vsize.  */
-		MP_PTR_SWAP (up, vp);
-	      up += zeros, usize = size + 1 - zeros;
-	      mpn_sub_n (up, up, vp + zeros, usize);
-	    }
-	  else
-	    {
-	      mp_size_t size = vsize - zeros;
-	      up += zeros, usize -= zeros;
-	      if (mpn_sub_n (up, up, vp + zeros, size))
-		{
-		  while (up[size] == 0)			/* Propagate borrow. */
-		    up[size++] = -(mp_limb_t)1;
-		  up[size] -= 1;
-		}
-	    }
-	}
-      while (usize);					/* End binary GCD.  */
-    }
-
-done:
-  if (vp != gp)
-    MPN_COPY (gp, vp, vsize);
-  TMP_FREE (marker);
-  return vsize;
-}
diff --git a/ghc/rts/gmp/mpn/generic/gcd_1.c b/ghc/rts/gmp/mpn/generic/gcd_1.c
deleted file mode 100644
index 1832636636..0000000000
--- a/ghc/rts/gmp/mpn/generic/gcd_1.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/* mpn_gcd_1 --
-
-Copyright (C) 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-/* Does not work for U == 0 or V == 0.  It would be tough to make it work for
-   V == 0 since gcd(x,0) = x, and U does not generally fit in an mp_limb_t.  */
-
-mp_limb_t
-#if __STDC__
-mpn_gcd_1 (mp_srcptr up, mp_size_t size, mp_limb_t vlimb)
-#else
-mpn_gcd_1 (up, size, vlimb)
-     mp_srcptr up;
-     mp_size_t size;
-     mp_limb_t vlimb;
-#endif
-{
-  mp_limb_t ulimb;
-  unsigned long int u_low_zero_bits, v_low_zero_bits;
-
-  if (size > 1)
-    {
-      ulimb = mpn_mod_1 (up, size, vlimb);
-      if (ulimb == 0)
-	return vlimb;
-    }
-  else
-    ulimb = up[0];
-
-  /*  Need to eliminate low zero bits.  */
-  count_trailing_zeros (u_low_zero_bits, ulimb);
-  ulimb >>= u_low_zero_bits;
-
-  count_trailing_zeros (v_low_zero_bits, vlimb);
-  vlimb >>= v_low_zero_bits;
-
-  while (ulimb != vlimb)
-    {
-      if (ulimb > vlimb)
-	{
-	  ulimb -= vlimb;
-	  do
-	    ulimb >>= 1;
-	  while ((ulimb & 1) == 0);
-	}
-      else /*  vlimb > ulimb.  */
-	{
-	  vlimb -= ulimb;
-	  do
-	    vlimb >>= 1;
-	  while ((vlimb & 1) == 0);
-	}
-    }
-
-  return  ulimb << MIN (u_low_zero_bits, v_low_zero_bits);
-}
diff --git a/ghc/rts/gmp/mpn/generic/gcdext.c b/ghc/rts/gmp/mpn/generic/gcdext.c
deleted file mode 100644
index fe22d779a6..0000000000
--- a/ghc/rts/gmp/mpn/generic/gcdext.c
+++ /dev/null
@@ -1,700 +0,0 @@
-/* mpn_gcdext -- Extended Greatest Common Divisor.
-
-Copyright (C) 1996, 1998, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD 17
-#endif
-
-#ifndef EXTEND
-#define EXTEND 1
-#endif
-
-#if STAT
-int arr[BITS_PER_MP_LIMB];
-#endif
-
-
-/* mpn_gcdext (GP, SP, SSIZE, UP, USIZE, VP, VSIZE)
-
-   Compute the extended GCD of {UP,USIZE} and {VP,VSIZE} and store the
-   greatest common divisor at GP (unless it is 0), and the first cofactor at
-   SP.  Write the size of the cofactor through the pointer SSIZE.  Return the
-   size of the value at GP.  Note that SP might be a negative number; this is
-   denoted by storing the negative of the size through SSIZE.
-
-   {UP,USIZE} and {VP,VSIZE} are both clobbered.
-
-   The space allocation for all four areas needs to be USIZE+1.
-
-   Preconditions: 1) U >= V.
-		  2) V > 0.  */
-
-/* We use Lehmer's algorithm.  The idea is to extract the most significant
-   bits of the operands, and compute the continued fraction for them.  We then
-   apply the gathered cofactors to the full operands.
-
-   Idea 1: After we have performed a full division, don't shift operands back,
-	   but instead account for the extra factors-of-2 thus introduced.
-   Idea 2: Simple generalization to use divide-and-conquer would give us an
-	   algorithm that runs faster than O(n^2).
-   Idea 3: The input numbers need less space as the computation progresses,
-	   while the s0 and s1 variables need more space.  To save memory, we
-	   could make them share space, and have the latter variables grow
-	   into the former.
-   Idea 4: We should not do double-limb arithmetic from the start.  Instead,
-	   do things in single-limb arithmetic until the quotients differ,
-	   and then switch to double-limb arithmetic.  */
-
-
-/* Division optimized for small quotients.  If the quotient is more than one limb,
-   store 1 in *qh and return 0.  */
-static mp_limb_t
-#if __STDC__
-div2 (mp_limb_t *qh, mp_limb_t n1, mp_limb_t n0, mp_limb_t d1, mp_limb_t d0)
-#else
-div2 (qh, n1, n0, d1, d0)
-     mp_limb_t *qh;
-     mp_limb_t n1;
-     mp_limb_t n0;
-     mp_limb_t d1;
-     mp_limb_t d0;
-#endif
-{
-  if (d1 == 0)
-    {
-      *qh = 1;
-      return 0;
-    }
-
-  if ((mp_limb_signed_t) n1 < 0)
-    {
-      mp_limb_t q;
-      int cnt;
-      for (cnt = 1; (mp_limb_signed_t) d1 >= 0; cnt++)
-	{
-	  d1 = (d1 << 1) | (d0 >> (BITS_PER_MP_LIMB - 1));
-	  d0 = d0 << 1;
-	}
-
-      q = 0;
-      while (cnt)
-	{
-	  q <<= 1;
-	  if (n1 > d1 || (n1 == d1 && n0 >= d0))
-	    {
-	      sub_ddmmss (n1, n0, n1, n0, d1, d0);
-	      q |= 1;
-	    }
-	  d0 = (d1 << (BITS_PER_MP_LIMB - 1)) | (d0 >> 1);
-	  d1 = d1 >> 1;
-	  cnt--;
-	}
-
-      *qh = 0;
-      return q;
-    }
-  else
-    {
-      mp_limb_t q;
-      int cnt;
-      for (cnt = 0; n1 > d1 || (n1 == d1 && n0 >= d0); cnt++)
-	{
-	  d1 = (d1 << 1) | (d0 >> (BITS_PER_MP_LIMB - 1));
-	  d0 = d0 << 1;
-	}
-
-      q = 0;
-      while (cnt)
-	{
-	  d0 = (d1 << (BITS_PER_MP_LIMB - 1)) | (d0 >> 1);
-	  d1 = d1 >> 1;
-	  q <<= 1;
-	  if (n1 > d1 || (n1 == d1 && n0 >= d0))
-	    {
-	      sub_ddmmss (n1, n0, n1, n0, d1, d0);
-	      q |= 1;
-	    }
-	  cnt--;
-	}
-
-      *qh = 0;
-      return q;
-    }
-}
-
-mp_size_t
-#if EXTEND
-#if __STDC__
-mpn_gcdext (mp_ptr gp, mp_ptr s0p, mp_size_t *s0size,
-	    mp_ptr up, mp_size_t size, mp_ptr vp, mp_size_t vsize)
-#else
-mpn_gcdext (gp, s0p, s0size, up, size, vp, vsize)
-     mp_ptr gp;
-     mp_ptr s0p;
-     mp_size_t *s0size;
-     mp_ptr up;
-     mp_size_t size;
-     mp_ptr vp;
-     mp_size_t vsize;
-#endif
-#else
-#if __STDC__
-mpn_gcd (mp_ptr gp,
-	 mp_ptr up, mp_size_t size, mp_ptr vp, mp_size_t vsize)
-#else
-mpn_gcd (gp, up, size, vp, vsize)
-     mp_ptr gp;
-     mp_ptr up;
-     mp_size_t size;
-     mp_ptr vp;
-     mp_size_t vsize;
-#endif
-#endif
-{
-  mp_limb_t A, B, C, D;
-  int cnt;
-  mp_ptr tp, wp;
-#if RECORD
-  mp_limb_t max = 0;
-#endif
-#if EXTEND
-  mp_ptr s1p;
-  mp_ptr orig_s0p = s0p;
-  mp_size_t ssize;
-  int sign = 1;
-#endif
-  int use_double_flag;
-  TMP_DECL (mark);
-
-  TMP_MARK (mark);
-
-  use_double_flag = (size >= GCDEXT_THRESHOLD);
-
-  tp = (mp_ptr) TMP_ALLOC ((size + 1) * BYTES_PER_MP_LIMB);
-  wp = (mp_ptr) TMP_ALLOC ((size + 1) * BYTES_PER_MP_LIMB);
-#if EXTEND
-  s1p = (mp_ptr) TMP_ALLOC ((size + 1) * BYTES_PER_MP_LIMB);
-
-  MPN_ZERO (s0p, size);
-  MPN_ZERO (s1p, size);
-
-  s0p[0] = 1;
-  s1p[0] = 0;
-  ssize = 1;
-#endif
-
-  if (size > vsize)
-    {
-      /* Normalize V (and shift up U the same amount).  */
-      count_leading_zeros (cnt, vp[vsize - 1]);
-      if (cnt != 0)
-	{
-	  mp_limb_t cy;
-	  mpn_lshift (vp, vp, vsize, cnt);
-	  cy = mpn_lshift (up, up, size, cnt);
-	  up[size] = cy;
-	  size += cy != 0;
-	}
-
-      mpn_divmod (up + vsize, up, size, vp, vsize);
-#if EXTEND
-      /* This is really what it boils down to in this case... */
-      s0p[0] = 0;
-      s1p[0] = 1;
-      sign = -sign;
-#endif
-      size = vsize;
-      if (cnt != 0)
-	{
-	  mpn_rshift (up, up, size, cnt);
-	  mpn_rshift (vp, vp, size, cnt);
-	}
-      MP_PTR_SWAP (up, vp);
-    }
-
-  for (;;)
-    {
-      mp_limb_t asign;
-      /* Figure out exact size of V.  */
-      vsize = size;
-      MPN_NORMALIZE (vp, vsize);
-      if (vsize <= 1)
-	break;
-
-      if (use_double_flag)
-	{
-	  mp_limb_t uh, vh, ul, vl;
-	  /* Let UH,UL be the most significant limbs of U, and let VH,VL be
-	     the corresponding bits from V.  */
-	  uh = up[size - 1];
-	  vh = vp[size - 1];
-	  ul = up[size - 2];
-	  vl = vp[size - 2];
-	  count_leading_zeros (cnt, uh);
-	  if (cnt != 0)
-	    {
-	      uh = (uh << cnt) | (ul >> (BITS_PER_MP_LIMB - cnt));
-	      vh = (vh << cnt) | (vl >> (BITS_PER_MP_LIMB - cnt));
-	      vl <<= cnt;
-	      ul <<= cnt;
-	      if (size >= 3)
-		{
-		  ul |= (up[size - 3] >> (BITS_PER_MP_LIMB - cnt));
-		  vl |= (vp[size - 3] >> (BITS_PER_MP_LIMB - cnt));
-		}
-	    }
-
-	  A = 1;
-	  B = 0;
-	  C = 0;
-	  D = 1;
-
-	  asign = 0;
-	  for (;;)
-	    {
-	      mp_limb_t T;
-	      mp_limb_t qh, q1, q2;
-	      mp_limb_t nh, nl, dh, dl;
-	      mp_limb_t t1, t0;
-	      mp_limb_t Th, Tl;
-
-	      sub_ddmmss (dh, dl, vh, vl, 0, C);
-	      if ((dl | dh) == 0)
-		break;
-	      add_ssaaaa (nh, nl, uh, ul, 0, A);
-	      q1 = div2 (&qh, nh, nl, dh, dl);
-	      if (qh != 0)
-		break;		/* could handle this */
-
-	      add_ssaaaa (dh, dl, vh, vl, 0, D);
-	      if ((dl | dh) == 0)
-		break;
-	      sub_ddmmss (nh, nl, uh, ul, 0, B);
-	      q2 = div2 (&qh, nh, nl, dh, dl);
-	      if (qh != 0)
-		break;		/* could handle this */
-
-	      if (q1 != q2)
-		break;
-
-	      asign = ~asign;
-
-	      T = A + q1 * C;
-	      A = C;
-	      C = T;
-	      T = B + q1 * D;
-	      B = D;
-	      D = T;
-	      umul_ppmm (t1, t0, q1, vl);
-	      t1 += q1 * vh;
-	      sub_ddmmss (Th, Tl, uh, ul, t1, t0);
-	      uh = vh, ul = vl;
-	      vh = Th, vl = Tl;
-
-	      add_ssaaaa (dh, dl, vh, vl, 0, C);
-	      sub_ddmmss (nh, nl, uh, ul, 0, A);
-	      q1 = div2 (&qh, nh, nl, dh, dl);
-	      if (qh != 0)
-		break;		/* could handle this */
-
-	      sub_ddmmss (dh, dl, vh, vl, 0, D);
-	      if ((dl | dh) == 0)
-		break;
-	      add_ssaaaa (nh, nl, uh, ul, 0, B);
-	      q2 = div2 (&qh, nh, nl, dh, dl);
-	      if (qh != 0)
-		break;		/* could handle this */
-
-	      if (q1 != q2)
-		break;
-
-	      asign = ~asign;
-
-	      T = A + q1 * C;
-	      A = C;
-	      C = T;
-	      T = B + q1 * D;
-	      B = D;
-	      D = T;
-	      umul_ppmm (t1, t0, q1, vl);
-	      t1 += q1 * vh;
-	      sub_ddmmss (Th, Tl, uh, ul, t1, t0);
-	      uh = vh, ul = vl;
-	      vh = Th, vl = Tl;
-	    }
-#if EXTEND
-	  if (asign)
-	    sign = -sign;
-#endif
-	}
-      else /* Same, but using single-limb calculations.  */
-	{
-	  mp_limb_t uh, vh;
-	  /* Make UH be the most significant limb of U, and make VH be
-	     corresponding bits from V.  */
-	  uh = up[size - 1];
-	  vh = vp[size - 1];
-	  count_leading_zeros (cnt, uh);
-	  if (cnt != 0)
-	    {
-	      uh = (uh << cnt) | (up[size - 2] >> (BITS_PER_MP_LIMB - cnt));
-	      vh = (vh << cnt) | (vp[size - 2] >> (BITS_PER_MP_LIMB - cnt));
-	    }
-
-	  A = 1;
-	  B = 0;
-	  C = 0;
-	  D = 1;
-
-	  asign = 0;
-	  for (;;)
-	    {
-	      mp_limb_t q, T;
-	      if (vh - C == 0 || vh + D == 0)
-		break;
-
-	      q = (uh + A) / (vh - C);
-	      if (q != (uh - B) / (vh + D))
-		break;
-
-	      asign = ~asign;
-
-	      T = A + q * C;
-	      A = C;
-	      C = T;
-	      T = B + q * D;
-	      B = D;
-	      D = T;
-	      T = uh - q * vh;
-	      uh = vh;
-	      vh = T;
-
-	      if (vh - D == 0)
-		break;
-
-	      q = (uh - A) / (vh + C);
-	      if (q != (uh + B) / (vh - D))
-		break;
-
-	      asign = ~asign;
-
-	      T = A + q * C;
-	      A = C;
-	      C = T;
-	      T = B + q * D;
-	      B = D;
-	      D = T;
-	      T = uh - q * vh;
-	      uh = vh;
-	      vh = T;
-	    }
-#if EXTEND
-	  if (asign)
-	    sign = -sign;
-#endif
-	}
-
-#if RECORD
-      max = MAX (A, max);  max = MAX (B, max);
-      max = MAX (C, max);  max = MAX (D, max);
-#endif
-
-      if (B == 0)
-	{
-	  mp_limb_t qh;
-	  mp_size_t i;
-	  /* This is quite rare.  I.e., optimize something else!  */
-
-	  /* Normalize V (and shift up U the same amount).  */
-	  count_leading_zeros (cnt, vp[vsize - 1]);
-	  if (cnt != 0)
-	    {
-	      mp_limb_t cy;
-	      mpn_lshift (vp, vp, vsize, cnt);
-	      cy = mpn_lshift (up, up, size, cnt);
-	      up[size] = cy;
-	      size += cy != 0;
-	    }
-
-	  qh = mpn_divmod (up + vsize, up, size, vp, vsize);
-#if EXTEND
-	  MPN_COPY (tp, s0p, ssize);
-	  {
-	    mp_size_t qsize;
-
-	    qsize = size - vsize; /* size of stored quotient from division */
-	    if (ssize < qsize)
-	      {
-		MPN_ZERO (tp + ssize, qsize - ssize);
-		MPN_ZERO (s1p + ssize, qsize); /* zero s1 too */
-		for (i = 0; i < ssize; i++)
-		  {
-		    mp_limb_t cy;
-		    cy = mpn_addmul_1 (tp + i, up + vsize, qsize, s1p[i]);
-		    tp[qsize + i] = cy;
-		  }
-		if (qh != 0)
-		  {
-		    mp_limb_t cy;
-		    cy = mpn_add_n (tp + qsize, tp + qsize, s1p, ssize);
-		    if (cy != 0)
-		      abort ();
-		  }
-	      }
-	    else
-	      {
-		MPN_ZERO (s1p + ssize, qsize); /* zero s1 too */
-		for (i = 0; i < qsize; i++)
-		  {
-		    mp_limb_t cy;
-		    cy = mpn_addmul_1 (tp + i, s1p, ssize, up[vsize + i]);
-		    tp[ssize + i] = cy;
-		  }
-		if (qh != 0)
-		  {
-		    mp_limb_t cy;
-		    cy = mpn_add_n (tp + qsize, tp + qsize, s1p, ssize);
-		    if (cy != 0)
-		      {
-			tp[qsize + ssize] = cy;
-			s1p[qsize + ssize] = 0;
-			ssize++;
-		      }
-		  }
-	      }
-	    ssize += qsize;
-	    ssize -= tp[ssize - 1] == 0;
-	  }
-
-	  sign = -sign;
-	  MP_PTR_SWAP (s0p, s1p);
-	  MP_PTR_SWAP (s1p, tp);
-#endif
-	  size = vsize;
-	  if (cnt != 0)
-	    {
-	      mpn_rshift (up, up, size, cnt);
-	      mpn_rshift (vp, vp, size, cnt);
-	    }
-	  MP_PTR_SWAP (up, vp);
-	}
-      else
-	{
-#if EXTEND
-	  mp_size_t tsize, wsize;
-#endif
-	  /* T = U*A + V*B
-	     W = U*C + V*D
-	     U = T
-	     V = W	   */
-
-#if STAT
-	  { mp_limb_t x; x = A | B | C | D; count_leading_zeros (cnt, x);
-	  arr[BITS_PER_MP_LIMB - cnt]++; }
-#endif
-	  if (A == 0)
-	    {
-	      /* B == 1 and C == 1 (D is arbitrary) */
-	      mp_limb_t cy;
-	      MPN_COPY (tp, vp, size);
-	      MPN_COPY (wp, up, size);
-	      mpn_submul_1 (wp, vp, size, D);
-	      MP_PTR_SWAP (tp, up);
-	      MP_PTR_SWAP (wp, vp);
-#if EXTEND
-	      MPN_COPY (tp, s1p, ssize);
-	      tsize = ssize;
-	      tp[ssize] = 0;	/* must zero since wp might spill below */
-	      MPN_COPY (wp, s0p, ssize);
-	      cy = mpn_addmul_1 (wp, s1p, ssize, D);
-	      wp[ssize] = cy;
-	      wsize = ssize + (cy != 0);
-	      MP_PTR_SWAP (tp, s0p);
-	      MP_PTR_SWAP (wp, s1p);
-	      ssize = MAX (wsize, tsize);
-#endif
-	    }
-	  else
-	    {
-	      if (asign)
-		{
-		  mp_limb_t cy;
-		  mpn_mul_1 (tp, vp, size, B);
-		  mpn_submul_1 (tp, up, size, A);
-		  mpn_mul_1 (wp, up, size, C);
-		  mpn_submul_1 (wp, vp, size, D);
-		  MP_PTR_SWAP (tp, up);
-		  MP_PTR_SWAP (wp, vp);
-#if EXTEND
-		  cy = mpn_mul_1 (tp, s1p, ssize, B);
-		  cy += mpn_addmul_1 (tp, s0p, ssize, A);
-		  tp[ssize] = cy;
-		  tsize = ssize + (cy != 0);
-		  cy = mpn_mul_1 (wp, s0p, ssize, C);
-		  cy += mpn_addmul_1 (wp, s1p, ssize, D);
-		  wp[ssize] = cy;
-		  wsize = ssize + (cy != 0);
-		  MP_PTR_SWAP (tp, s0p);
-		  MP_PTR_SWAP (wp, s1p);
-		  ssize = MAX (wsize, tsize);
-#endif
-		}
-	      else
-		{
-		  mp_limb_t cy;
-		  mpn_mul_1 (tp, up, size, A);
-		  mpn_submul_1 (tp, vp, size, B);
-		  mpn_mul_1 (wp, vp, size, D);
-		  mpn_submul_1 (wp, up, size, C);
-		  MP_PTR_SWAP (tp, up);
-		  MP_PTR_SWAP (wp, vp);
-#if EXTEND
-		  cy = mpn_mul_1 (tp, s0p, ssize, A);
-		  cy += mpn_addmul_1 (tp, s1p, ssize, B);
-		  tp[ssize] = cy;
-		  tsize = ssize + (cy != 0);
-		  cy = mpn_mul_1 (wp, s1p, ssize, D);
-		  cy += mpn_addmul_1 (wp, s0p, ssize, C);
-		  wp[ssize] = cy;
-		  wsize = ssize + (cy != 0);
-		  MP_PTR_SWAP (tp, s0p);
-		  MP_PTR_SWAP (wp, s1p);
-		  ssize = MAX (wsize, tsize);
-#endif
-		}
-	    }
-
-	  size -= up[size - 1] == 0;
-	}
-    }
-
-#if RECORD
-  printf ("max: %lx\n", max);
-#endif
-
-#if STAT
- {int i; for (i = 0; i < BITS_PER_MP_LIMB; i++) printf ("%d:%d\n", i, arr[i]);}
-#endif
-
-  if (vsize == 0)
-    {
-      if (gp != up && gp != 0)
-	MPN_COPY (gp, up, size);
-#if EXTEND
-      MPN_NORMALIZE (s0p, ssize);
-      if (orig_s0p != s0p)
-	MPN_COPY (orig_s0p, s0p, ssize);
-      *s0size = sign >= 0 ? ssize : -ssize;
-#endif
-      TMP_FREE (mark);
-      return size;
-    }
-  else
-    {
-      mp_limb_t vl, ul, t;
-#if EXTEND
-      mp_size_t qsize, i;
-#endif
-      vl = vp[0];
-#if EXTEND
-      t = mpn_divmod_1 (wp, up, size, vl);
-
-      MPN_COPY (tp, s0p, ssize);
-
-      qsize = size - (wp[size - 1] == 0); /* size of quotient from division */
-      if (ssize < qsize)
-	{
-	  MPN_ZERO (tp + ssize, qsize - ssize);
-	  MPN_ZERO (s1p + ssize, qsize); /* zero s1 too */
-	  for (i = 0; i < ssize; i++)
-	    {
-	      mp_limb_t cy;
-	      cy = mpn_addmul_1 (tp + i, wp, qsize, s1p[i]);
-	      tp[qsize + i] = cy;
-	    }
-	}
-      else
-	{
-	  MPN_ZERO (s1p + ssize, qsize); /* zero s1 too */
-	  for (i = 0; i < qsize; i++)
-	    {
-	      mp_limb_t cy;
-	      cy = mpn_addmul_1 (tp + i, s1p, ssize, wp[i]);
-	      tp[ssize + i] = cy;
-	    }
-	}
-      ssize += qsize;
-      ssize -= tp[ssize - 1] == 0;
-
-      sign = -sign;
-      MP_PTR_SWAP (s0p, s1p);
-      MP_PTR_SWAP (s1p, tp);
-#else
-      t = mpn_mod_1 (up, size, vl);
-#endif
-      ul = vl;
-      vl = t;
-      while (vl != 0)
-	{
-	  mp_limb_t t;
-#if EXTEND
-	  mp_limb_t q;
-	  q = ul / vl;
-	  t = ul - q * vl;
-
-	  MPN_COPY (tp, s0p, ssize);
-
-	  MPN_ZERO (s1p + ssize, 1); /* zero s1 too */
-
-	  {
-	    mp_limb_t cy;
-	    cy = mpn_addmul_1 (tp, s1p, ssize, q);
-	    tp[ssize] = cy;
-	  }
-
-	  ssize += 1;
-	  ssize -= tp[ssize - 1] == 0;
-
-	  sign = -sign;
-	  MP_PTR_SWAP (s0p, s1p);
-	  MP_PTR_SWAP (s1p, tp);
-#else
-	  t = ul % vl;
-#endif
-	  ul = vl;
-	  vl = t;
-	}
-      if (gp != 0)
-	gp[0] = ul;
-#if EXTEND
-      MPN_NORMALIZE (s0p, ssize);
-      if (orig_s0p != s0p)
-	MPN_COPY (orig_s0p, s0p, ssize);
-      *s0size = sign >= 0 ? ssize : -ssize;
-#endif
-      TMP_FREE (mark);
-      return 1;
-    }
-}
diff --git a/ghc/rts/gmp/mpn/generic/get_str.c b/ghc/rts/gmp/mpn/generic/get_str.c
deleted file mode 100644
index a713b61825..0000000000
--- a/ghc/rts/gmp/mpn/generic/get_str.c
+++ /dev/null
@@ -1,216 +0,0 @@
-/* mpn_get_str -- Convert a MSIZE long limb vector pointed to by MPTR
-   to a printable string in STR in base BASE.
-
-Copyright (C) 1991, 1992, 1993, 1994, 1996, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-/* Convert the limb vector pointed to by MPTR and MSIZE long to a
-   char array, using base BASE for the result array.  Store the
-   result in the character array STR.  STR must point to an array with
-   space for the largest possible number represented by a MSIZE long
-   limb vector + 1 extra character.
-
-   The result is NOT in Ascii, to convert it to printable format, add
-   '0' or 'A' depending on the base and range.
-
-   Return the number of digits in the result string.
-   This may include some leading zeros.
-
-   The limb vector pointed to by MPTR is clobbered.  */
-
-size_t
-#if __STDC__
-mpn_get_str (unsigned char *str, int base, mp_ptr mptr, mp_size_t msize)
-#else
-mpn_get_str (str, base, mptr, msize)
-     unsigned char *str;
-     int base;
-     mp_ptr mptr;
-     mp_size_t msize;
-#endif
-{
-  mp_limb_t big_base;
-#if UDIV_NEEDS_NORMALIZATION || UDIV_TIME > 2 * UMUL_TIME
-  int normalization_steps;
-#endif
-#if UDIV_TIME > 2 * UMUL_TIME
-  mp_limb_t big_base_inverted;
-#endif
-  unsigned int dig_per_u;
-  mp_size_t out_len;
-  register unsigned char *s;
-
-  big_base = __mp_bases[base].big_base;
-
-  s = str;
-
-  /* Special case zero, as the code below doesn't handle it.  */
-  if (msize == 0)
-    {
-      s[0] = 0;
-      return 1;
-    }
-
-  if ((base & (base - 1)) == 0)
-    {
-      /* The base is a power of 2.  Make conversion from most
-	 significant side.  */
-      mp_limb_t n1, n0;
-      register int bits_per_digit = big_base;
-      register int x;
-      register int bit_pos;
-      register int i;
-
-      n1 = mptr[msize - 1];
-      count_leading_zeros (x, n1);
-
-	/* BIT_POS should be R when input ends in least sign. nibble,
-	   R + bits_per_digit * n when input ends in n:th least significant
-	   nibble. */
-
-      {
-	int bits;
-
-	bits = BITS_PER_MP_LIMB * msize - x;
-	x = bits % bits_per_digit;
-	if (x != 0)
-	  bits += bits_per_digit - x;
-	bit_pos = bits - (msize - 1) * BITS_PER_MP_LIMB;
-      }
-
-      /* Fast loop for bit output.  */
-      i = msize - 1;
-      for (;;)
-	{
-	  bit_pos -= bits_per_digit;
-	  while (bit_pos >= 0)
-	    {
-	      *s++ = (n1 >> bit_pos) & ((1 << bits_per_digit) - 1);
-	      bit_pos -= bits_per_digit;
-	    }
-	  i--;
-	  if (i < 0)
-	    break;
-	  n0 = (n1 << -bit_pos) & ((1 << bits_per_digit) - 1);
-	  n1 = mptr[i];
-	  bit_pos += BITS_PER_MP_LIMB;
-	  *s++ = n0 | (n1 >> bit_pos);
-	}
-
-      *s = 0;
-
-      return s - str;
-    }
-  else
-    {
-      /* General case.  The base is not a power of 2.  Make conversion
-	 from least significant end.  */
-
-      /* If udiv_qrnnd only handles divisors with the most significant bit
-	 set, prepare BIG_BASE for being a divisor by shifting it to the
-	 left exactly enough to set the most significant bit.  */
-#if UDIV_NEEDS_NORMALIZATION || UDIV_TIME > 2 * UMUL_TIME
-      count_leading_zeros (normalization_steps, big_base);
-      big_base <<= normalization_steps;
-#if UDIV_TIME > 2 * UMUL_TIME
-      /* Get the fixed-point approximation to 1/(BIG_BASE << NORMALIZATION_STEPS).  */
-      big_base_inverted = __mp_bases[base].big_base_inverted;
-#endif
-#endif
-
-      dig_per_u = __mp_bases[base].chars_per_limb;
-      out_len = ((size_t) msize * BITS_PER_MP_LIMB
-		 * __mp_bases[base].chars_per_bit_exactly) + 1;
-      s += out_len;
-
-      while (msize != 0)
-	{
-	  int i;
-	  mp_limb_t n0, n1;
-
-#if UDIV_NEEDS_NORMALIZATION || UDIV_TIME > 2 * UMUL_TIME
-	  /* If we shifted BIG_BASE above, shift the dividend too, to get
-	     the right quotient.  We need to do this every loop,
-	     since the intermediate quotients are OK, but the quotient from
-	     one turn in the loop is going to be the dividend in the
-	     next turn, and the dividend needs to be up-shifted.  */
-	  if (normalization_steps != 0)
-	    {
-	      n0 = mpn_lshift (mptr, mptr, msize, normalization_steps);
-
-	      /* If the shifting gave a carry out limb, store it and
-		 increase the length.  */
-	      if (n0 != 0)
-		{
-		  mptr[msize] = n0;
-		  msize++;
-		}
-	    }
-#endif
-
-	  /* Divide the number at TP with BIG_BASE to get a quotient and a
-	     remainder.  The remainder is our new digit in base BIG_BASE.  */
-	  i = msize - 1;
-	  n1 = mptr[i];
-
-	  if (n1 >= big_base)
-	    n1 = 0;
-	  else
-	    {
-	      msize--;
-	      i--;
-	    }
-
-	  for (; i >= 0; i--)
-	    {
-	      n0 = mptr[i];
-#if UDIV_TIME > 2 * UMUL_TIME
-	      udiv_qrnnd_preinv (mptr[i], n1, n1, n0, big_base, big_base_inverted);
-#else
-	      udiv_qrnnd (mptr[i], n1, n1, n0, big_base);
-#endif
-	    }
-
-#if UDIV_NEEDS_NORMALIZATION || UDIV_TIME > 2 * UMUL_TIME
-	  /* If we shifted above (at previous UDIV_NEEDS_NORMALIZATION tests)
-	     the remainder will be up-shifted here.  Compensate.  */
-	  n1 >>= normalization_steps;
-#endif
-
-	  /* Convert N1 from BIG_BASE to a string of digits in BASE
-	     using single precision operations.  */
-	  for (i = dig_per_u - 1; i >= 0; i--)
-	    {
-	      *--s = n1 % base;
-	      n1 /= base;
-	      if (n1 == 0 && msize == 0)
-		break;
-	    }
-	}
-
-      while (s != str)
-	*--s = 0;
-      return out_len;
-    }
-}
diff --git a/ghc/rts/gmp/mpn/generic/gmp-mparam.h b/ghc/rts/gmp/mpn/generic/gmp-mparam.h
deleted file mode 100644
index 14bcaece83..0000000000
--- a/ghc/rts/gmp/mpn/generic/gmp-mparam.h
+++ /dev/null
@@ -1,27 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 32
-#define BYTES_PER_MP_LIMB 4
-#define BITS_PER_LONGINT 32
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
diff --git a/ghc/rts/gmp/mpn/generic/hamdist.c b/ghc/rts/gmp/mpn/generic/hamdist.c
deleted file mode 100644
index 35c10e8450..0000000000
--- a/ghc/rts/gmp/mpn/generic/hamdist.c
+++ /dev/null
@@ -1,94 +0,0 @@
-/* mpn_hamdist --
-
-Copyright (C) 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-#if defined __GNUC__
-/* No processor claiming to be SPARC v9 compliant seem to
-   implement the POPC instruction.  Disable pattern for now.  */
-#if 0 && defined __sparc_v9__ && BITS_PER_MP_LIMB == 64
-#define popc_limb(a) \
-  ({									\
-    DItype __res;							\
-    asm ("popc %1,%0" : "=r" (__res) : "rI" (a));			\
-    __res;								\
-  })
-#endif
-#endif
-
-#ifndef popc_limb
-
-/* Cool population count of a mp_limb_t.
-   You have to figure out how this works, I won't tell you!  */
-
-static inline unsigned int
-#if __STDC__
-popc_limb (mp_limb_t x)
-#else
-popc_limb (x)
-     mp_limb_t x;
-#endif
-{
-#if BITS_PER_MP_LIMB == 64
-  /* We have to go into some trouble to define these constants.
-     (For mp_limb_t being `long long'.)  */
-  mp_limb_t cnst;
-  cnst = 0xaaaaaaaaL | ((mp_limb_t) 0xaaaaaaaaL << BITS_PER_MP_LIMB/2);
-  x -= (x & cnst) >> 1;
-  cnst = 0x33333333L | ((mp_limb_t) 0x33333333L << BITS_PER_MP_LIMB/2);
-  x = ((x & ~cnst) >> 2) + (x & cnst);
-  cnst = 0x0f0f0f0fL | ((mp_limb_t) 0x0f0f0f0fL << BITS_PER_MP_LIMB/2);
-  x = ((x >> 4) + x) & cnst;
-  x = ((x >> 8) + x);
-  x = ((x >> 16) + x);
-  x = ((x >> 32) + x) & 0xff;
-#endif
-#if BITS_PER_MP_LIMB == 32
-  x -= (x & 0xaaaaaaaa) >> 1;
-  x = ((x >> 2) & 0x33333333L) + (x & 0x33333333L);
-  x = ((x >> 4) + x) & 0x0f0f0f0fL;
-  x = ((x >> 8) + x);
-  x = ((x >> 16) + x) & 0xff;
-#endif
-  return x;
-}
-#endif
-
-unsigned long int
-#if __STDC__
-mpn_hamdist (mp_srcptr up, mp_srcptr vp, mp_size_t size)
-#else
-mpn_hamdist (up, vp, size)
-     register mp_srcptr up;
-     register mp_srcptr vp;
-     register mp_size_t size;
-#endif
-{
-  unsigned long int hamdist;
-  mp_size_t i;
-
-  hamdist = 0;
-  for (i = 0; i < size; i++)
-    hamdist += popc_limb (up[i] ^ vp[i]);
-
-  return hamdist;
-}
diff --git a/ghc/rts/gmp/mpn/generic/inlines.c b/ghc/rts/gmp/mpn/generic/inlines.c
deleted file mode 100644
index 9487e58cf2..0000000000
--- a/ghc/rts/gmp/mpn/generic/inlines.c
+++ /dev/null
@@ -1,24 +0,0 @@
-/*
-Copyright (C) 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-#define _FORCE_INLINES
-#define _EXTERN_INLINE /* empty */
-#include "gmp.h"
diff --git a/ghc/rts/gmp/mpn/generic/jacbase.c b/ghc/rts/gmp/mpn/generic/jacbase.c
deleted file mode 100644
index dd437f1ac1..0000000000
--- a/ghc/rts/gmp/mpn/generic/jacbase.c
+++ /dev/null
@@ -1,136 +0,0 @@
-/* mpn_jacobi_base -- limb/limb Jacobi symbol with restricted arguments.
-
-   THIS INTERFACE IS PRELIMINARY AND MIGHT DISAPPEAR OR BE SUBJECT TO
-   INCOMPATIBLE CHANGES IN A FUTURE RELEASE OF GMP. */
-
-/*
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.  */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-#if COUNT_TRAILING_ZEROS_TIME <= 7
-/* If count_trailing_zeros is fast, use it.
-   K7 at 7 cycles and P6 at 2 are good here.  K6 at 12-27 and P5 at 18-42
-   are not.  The default 15 in longlong.h is meant to mean not good here.  */
-
-#define PROCESS_TWOS_ANY                                \
-  {                                                     \
-    mp_limb_t  twos;                                    \
-    count_trailing_zeros (twos, a);                     \
-    result_bit1 ^= JACOBI_TWOS_U_BIT1 (twos, b);        \
-    a >>= twos;                                         \
-  }
-
-#define PROCESS_TWOS_EVEN  PROCESS_TWOS_ANY
-
-#else
-/* Use a loop instead.  With "a" uniformly distributed there will usually be
-   only a few trailing zeros.
-
-   Unfortunately the branch for the while loop here will be on a 50/50
-   chance of a 1 or 0, which is bad for branch prediction.  */
-
-#define PROCESS_TWOS_EVEN               \
-  {                                     \
-    int  two;                           \
-    two = JACOBI_TWO_U_BIT1 (b);        \
-    do                                  \
-      {                                 \
-        a >>= 1;                        \
-        result_bit1 ^= two;             \
-        ASSERT (a != 0);                \
-      }                                 \
-    while ((a & 1) == 0);               \
-  }
-
-#define PROCESS_TWOS_ANY        \
-  if ((a & 1) == 0)             \
-    PROCESS_TWOS_EVEN;
-
-#endif
-
-
-/* Calculate the value of the Jacobi symbol (a/b) of two mp_limb_t's, but
-   with a restricted range of inputs accepted, namely b>1, b odd, and a<=b.
-
-   The initial result_bit1 is taken as a parameter for the convenience of
-   mpz_kronecker_zi_ui() et al.  The sign changes both here and in those
-   routines accumulate nicely in bit 1, see the JACOBI macros.
-
-   The return value here is the normal +1, 0, or -1.  Note that +1 and -1
-   have bit 1 in the "BIT1" sense, which could be useful if the caller is
-   accumulating it into some extended calculation.
-
-   Duplicating the loop body to avoid the MP_LIMB_T_SWAP(a,b) would be
-   possible, but a couple of tests suggest it's not a significant speedup,
-   and may even be a slowdown, so what's here is good enough for now.
-
-   Future: The code doesn't demand a<=b actually, so maybe this could be
-   relaxed.  All the places this is used currently call with a<=b though.  */
-
-int
-#if __STDC__
-mpn_jacobi_base (mp_limb_t a, mp_limb_t b, int result_bit1)
-#else
-mpn_jacobi_base (a, b, result_bit1)
-     mp_limb_t a;
-     mp_limb_t b;
-     int       result_bit1;
-#endif
-{
-  ASSERT (b & 1);  /* b odd */
-  ASSERT (b != 1);
-  ASSERT (a <= b);
-
-  if (a == 0)
-    return 0;
-
-  PROCESS_TWOS_ANY;
-  if (a == 1)
-    goto done;
-
-  for (;;)
-    {
-      result_bit1 ^= JACOBI_RECIP_UU_BIT1 (a, b);
-      MP_LIMB_T_SWAP (a, b);
-
-      do
-	{
-          /* working on (a/b), a,b odd, a>=b */
-          ASSERT (a & 1);
-          ASSERT (b & 1);
-          ASSERT (a >= b);
-
-	  if ((a -= b) == 0)
-	    return 0;
-
-          PROCESS_TWOS_EVEN;
-	  if (a == 1)
-	    goto done;
-	}
-      while (a >= b);
-    }
-
- done:
-  return JACOBI_BIT1_TO_PN (result_bit1);
-}
diff --git a/ghc/rts/gmp/mpn/generic/lshift.c b/ghc/rts/gmp/mpn/generic/lshift.c
deleted file mode 100644
index 0b58389658..0000000000
--- a/ghc/rts/gmp/mpn/generic/lshift.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/* mpn_lshift -- Shift left low level.
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-/* Shift U (pointed to by UP and USIZE digits long) CNT bits to the left
-   and store the USIZE least significant digits of the result at WP.
-   Return the bits shifted out from the most significant digit.
-
-   Argument constraints:
-   1. 0 < CNT < BITS_PER_MP_LIMB
-   2. If the result is to be written over the input, WP must be >= UP.
-*/
-
-mp_limb_t
-#if __STDC__
-mpn_lshift (register mp_ptr wp,
-	    register mp_srcptr up, mp_size_t usize,
-	    register unsigned int cnt)
-#else
-mpn_lshift (wp, up, usize, cnt)
-     register mp_ptr wp;
-     register mp_srcptr up;
-     mp_size_t usize;
-     register unsigned int cnt;
-#endif
-{
-  register mp_limb_t high_limb, low_limb;
-  register unsigned sh_1, sh_2;
-  register mp_size_t i;
-  mp_limb_t retval;
-
-#ifdef DEBUG
-  if (usize == 0 || cnt == 0)
-    abort ();
-#endif
-
-  sh_1 = cnt;
-#if 0
-  if (sh_1 == 0)
-    {
-      if (wp != up)
-	{
-	  /* Copy from high end to low end, to allow specified input/output
-	     overlapping.  */
-	  for (i = usize - 1; i >= 0; i--)
-	    wp[i] = up[i];
-	}
-      return 0;
-    }
-#endif
-
-  wp += 1;
-  sh_2 = BITS_PER_MP_LIMB - sh_1;
-  i = usize - 1;
-  low_limb = up[i];
-  retval = low_limb >> sh_2;
-  high_limb = low_limb;
-  while (--i >= 0)
-    {
-      low_limb = up[i];
-      wp[i] = (high_limb << sh_1) | (low_limb >> sh_2);
-      high_limb = low_limb;
-    }
-  wp[i] = high_limb << sh_1;
-
-  return retval;
-}
diff --git a/ghc/rts/gmp/mpn/generic/mod_1.c b/ghc/rts/gmp/mpn/generic/mod_1.c
deleted file mode 100644
index 168ec9df49..0000000000
--- a/ghc/rts/gmp/mpn/generic/mod_1.c
+++ /dev/null
@@ -1,175 +0,0 @@
-/* mpn_mod_1(dividend_ptr, dividend_size, divisor_limb) --
-   Divide (DIVIDEND_PTR,,DIVIDEND_SIZE) by DIVISOR_LIMB.
-   Return the single-limb remainder.
-   There are no constraints on the value of the divisor.
-
-Copyright (C) 1991, 1993, 1994, 1999 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-#ifndef UMUL_TIME
-#define UMUL_TIME 1
-#endif
-
-#ifndef UDIV_TIME
-#define UDIV_TIME UMUL_TIME
-#endif
-
-mp_limb_t
-#if __STDC__
-mpn_mod_1 (mp_srcptr dividend_ptr, mp_size_t dividend_size,
-	   mp_limb_t divisor_limb)
-#else
-mpn_mod_1 (dividend_ptr, dividend_size, divisor_limb)
-     mp_srcptr dividend_ptr;
-     mp_size_t dividend_size;
-     mp_limb_t divisor_limb;
-#endif
-{
-  mp_size_t i;
-  mp_limb_t n1, n0, r;
-  int dummy;
-
-  /* Botch: Should this be handled at all?  Rely on callers?  */
-  if (dividend_size == 0)
-    return 0;
-
-  /* If multiplication is much faster than division, and the
-     dividend is large, pre-invert the divisor, and use
-     only multiplications in the inner loop.  */
-
-  /* This test should be read:
-       Does it ever help to use udiv_qrnnd_preinv?
-	 && Does what we save compensate for the inversion overhead?  */
-  if (UDIV_TIME > (2 * UMUL_TIME + 6)
-      && (UDIV_TIME - (2 * UMUL_TIME + 6)) * dividend_size > UDIV_TIME)
-    {
-      int normalization_steps;
-
-      count_leading_zeros (normalization_steps, divisor_limb);
-      if (normalization_steps != 0)
-	{
-	  mp_limb_t divisor_limb_inverted;
-
-	  divisor_limb <<= normalization_steps;
-	  invert_limb (divisor_limb_inverted, divisor_limb);
-
-	  n1 = dividend_ptr[dividend_size - 1];
-	  r = n1 >> (BITS_PER_MP_LIMB - normalization_steps);
-
-	  /* Possible optimization:
-	     if (r == 0
-	     && divisor_limb > ((n1 << normalization_steps)
-			     | (dividend_ptr[dividend_size - 2] >> ...)))
-	     ...one division less... */
-
-	  for (i = dividend_size - 2; i >= 0; i--)
-	    {
-	      n0 = dividend_ptr[i];
-	      udiv_qrnnd_preinv (dummy, r, r,
-				 ((n1 << normalization_steps)
-				  | (n0 >> (BITS_PER_MP_LIMB - normalization_steps))),
-				 divisor_limb, divisor_limb_inverted);
-	      n1 = n0;
-	    }
-	  udiv_qrnnd_preinv (dummy, r, r,
-			     n1 << normalization_steps,
-			     divisor_limb, divisor_limb_inverted);
-	  return r >> normalization_steps;
-	}
-      else
-	{
-	  mp_limb_t divisor_limb_inverted;
-
-	  invert_limb (divisor_limb_inverted, divisor_limb);
-
-	  i = dividend_size - 1;
-	  r = dividend_ptr[i];
-
-	  if (r >= divisor_limb)
-	    r = 0;
-	  else
-	    i--;
-
-	  for (; i >= 0; i--)
-	    {
-	      n0 = dividend_ptr[i];
-	      udiv_qrnnd_preinv (dummy, r, r,
-				 n0, divisor_limb, divisor_limb_inverted);
-	    }
-	  return r;
-	}
-    }
-  else
-    {
-      if (UDIV_NEEDS_NORMALIZATION)
-	{
-	  int normalization_steps;
-
-	  count_leading_zeros (normalization_steps, divisor_limb);
-	  if (normalization_steps != 0)
-	    {
-	      divisor_limb <<= normalization_steps;
-
-	      n1 = dividend_ptr[dividend_size - 1];
-	      r = n1 >> (BITS_PER_MP_LIMB - normalization_steps);
-
-	      /* Possible optimization:
-		 if (r == 0
-		 && divisor_limb > ((n1 << normalization_steps)
-				 | (dividend_ptr[dividend_size - 2] >> ...)))
-		 ...one division less... */
-
-	      for (i = dividend_size - 2; i >= 0; i--)
-		{
-		  n0 = dividend_ptr[i];
-		  udiv_qrnnd (dummy, r, r,
-			      ((n1 << normalization_steps)
-			       | (n0 >> (BITS_PER_MP_LIMB - normalization_steps))),
-			      divisor_limb);
-		  n1 = n0;
-		}
-	      udiv_qrnnd (dummy, r, r,
-			  n1 << normalization_steps,
-			  divisor_limb);
-	      return r >> normalization_steps;
-	    }
-	}
-      /* No normalization needed, either because udiv_qrnnd doesn't require
-	 it, or because DIVISOR_LIMB is already normalized.  */
-
-      i = dividend_size - 1;
-      r = dividend_ptr[i];
-
-      if (r >= divisor_limb)
-	r = 0;
-      else
-	i--;
-
-      for (; i >= 0; i--)
-	{
-	  n0 = dividend_ptr[i];
-	  udiv_qrnnd (dummy, r, r, n0, divisor_limb);
-	}
-      return r;
-    }
-}
diff --git a/ghc/rts/gmp/mpn/generic/mod_1_rs.c b/ghc/rts/gmp/mpn/generic/mod_1_rs.c
deleted file mode 100644
index 62aaa94b92..0000000000
--- a/ghc/rts/gmp/mpn/generic/mod_1_rs.c
+++ /dev/null
@@ -1,111 +0,0 @@
-/* mpn_mod_1_rshift -- mpn remainder under hypothetical right shift.
-
-   THE FUNCTION IN THIS FILE IS FOR INTERNAL USE AND HAS A MUTABLE
-   INTERFACE.  IT IS ONLY SAFE TO REACH IT THROUGH DOCUMENTED INTERFACES.
-   IT'S ALMOST GUARANTEED THAT IT'LL CHANGE OR DISAPPEAR IN A FUTURE GNU MP
-   RELEASE. */
-
-/*
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.  */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-/* When testing on a CPU with UDIV_NEEDS_NORMALIZATION equal to 0, it can be
-   changed to 1 temporarily to test the code under that case too. */
-#if 0
-#undef UDIV_NEEDS_NORMALIZATION
-#define UDIV_NEEDS_NORMALIZATION 1
-#endif
-
-
-/* Calculate the remainder "(ptr,size >> shift) % divisor".  Note ptr,size
-   is unchanged, the shift is only for its effect on the remainder.
-   The shift doesn't even need to be considered until the last limb.
-
-   This function has the normal size!=0 restriction, unlike the basic
-   mpn_mod_1. */
-
-mp_limb_t
-#if __STDC__
-mpn_mod_1_rshift (mp_srcptr ptr, mp_size_t size, unsigned shift,
-                  mp_limb_t divisor)
-#else
-mpn_mod_1_rshift (ptr, size, shift, divisor)
-     mp_srcptr ptr;
-     mp_size_t size;
-     unsigned  shift;
-     mp_limb_t divisor;
-#endif
-{
-  mp_limb_t  quot, rem;
-
-  ASSERT (shift >= 1);
-  ASSERT (shift < BITS_PER_MP_LIMB);
-  ASSERT (size >= 1);
-
-  if (size == 1)
-    return (ptr[0] >> shift) % divisor;
-
-#if UDIV_NEEDS_NORMALIZATION 
-  {
-    int  norm;
-    int  delta;
-
-    count_leading_zeros (norm, divisor);
-    divisor <<= norm;
-
-    delta = shift - norm;
-    if (delta == 0)
-      return mpn_mod_1 (ptr, size, divisor) >> norm;
-
-    if (delta > 0)
-      {
-        rem = mpn_mod_1 (ptr+1, size-1, divisor);
-        udiv_qrnnd (quot, rem,
-                    rem >> delta,
-                    (rem << (BITS_PER_MP_LIMB-delta)) | (ptr[0] >> delta),
-                    divisor);
-        return rem >> norm;
-      }
-    else
-      {
-        rem = mpn_mod_1 (ptr, size, divisor);
-        udiv_qrnnd (quot, rem,
-                    rem >> (BITS_PER_MP_LIMB+delta),
-                    rem << -delta,
-                    divisor);
-        return rem >> norm;
-      }
-  }
-
-#else /* !UDIV_NEEDS_NORMALIZATION */
-
-  rem = mpn_mod_1 (ptr+1, size-1, divisor);
-  udiv_qrnnd (quot, rem,
-              rem >> shift,
-              (rem << (BITS_PER_MP_LIMB-shift)) | (ptr[0] >> shift),
-              divisor);
-  return rem;
-
-#endif
-}
diff --git a/ghc/rts/gmp/mpn/generic/mul.c b/ghc/rts/gmp/mpn/generic/mul.c
deleted file mode 100644
index cecfa19ca1..0000000000
--- a/ghc/rts/gmp/mpn/generic/mul.c
+++ /dev/null
@@ -1,190 +0,0 @@
-/* mpn_mul -- Multiply two natural numbers.
-
-   THE HELPER FUNCTIONS IN THIS FILE (meaning everything except mpn_mul)
-   ARE INTERNAL FUNCTIONS WITH MUTABLE INTERFACES.  IT IS ONLY SAFE TO REACH
-   THEM THROUGH DOCUMENTED INTERFACES.  IN FACT, IT IS ALMOST GUARANTEED
-   THAT THEY'LL CHANGE OR DISAPPEAR IN A FUTURE GNU MP RELEASE.
-
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 1999, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-/* Multiply the natural numbers u (pointed to by UP, with UN limbs) and v
-   (pointed to by VP, with VN limbs), and store the result at PRODP.  The
-   result is UN + VN limbs.  Return the most significant limb of the result.
-
-   NOTE: The space pointed to by PRODP is overwritten before finished with U
-   and V, so overlap is an error.
-
-   Argument constraints:
-   1. UN >= VN.
-   2. PRODP != UP and PRODP != VP, i.e. the destination must be distinct from
-      the multiplier and the multiplicand.  */
-
-void
-#if __STDC__
-mpn_sqr_n (mp_ptr prodp,
-         mp_srcptr up, mp_size_t un)
-#else
-mpn_sqr_n (prodp, up, un)
-     mp_ptr prodp;
-     mp_srcptr up;
-     mp_size_t un;
-#endif
-{
-  if (un < KARATSUBA_SQR_THRESHOLD)
-    { /* plain schoolbook multiplication */
-      if (un == 0)
-	return;
-      mpn_sqr_basecase (prodp, up, un);
-    }
-  else if (un < TOOM3_SQR_THRESHOLD)
-    { /* karatsuba multiplication */
-      mp_ptr tspace;
-      TMP_DECL (marker);
-      TMP_MARK (marker);
-      tspace = (mp_ptr) TMP_ALLOC (2 * (un + BITS_PER_MP_LIMB) * BYTES_PER_MP_LIMB);
-      mpn_kara_sqr_n (prodp, up, un, tspace);
-      TMP_FREE (marker);
-    }
-#if WANT_FFT || TUNE_PROGRAM_BUILD
-  else if (un < FFT_SQR_THRESHOLD)
-#else
-  else
-#endif
-    { /* toom3 multiplication */
-      mp_ptr tspace;
-      TMP_DECL (marker);
-      TMP_MARK (marker);
-      tspace = (mp_ptr) TMP_ALLOC (2 * (un + BITS_PER_MP_LIMB) * BYTES_PER_MP_LIMB);
-      mpn_toom3_sqr_n (prodp, up, un, tspace);
-      TMP_FREE (marker);
-    }
-#if WANT_FFT || TUNE_PROGRAM_BUILD
-  else
-    {
-      /* schoenhage multiplication */
-      mpn_mul_fft_full (prodp, up, un, up, un);
-    }
-#endif
-}
-
-mp_limb_t
-#if __STDC__
-mpn_mul (mp_ptr prodp,
-	 mp_srcptr up, mp_size_t un,
-	 mp_srcptr vp, mp_size_t vn)
-#else
-mpn_mul (prodp, up, un, vp, vn)
-     mp_ptr prodp;
-     mp_srcptr up;
-     mp_size_t un;
-     mp_srcptr vp;
-     mp_size_t vn;
-#endif
-{
-  mp_size_t l;
-  mp_limb_t c;
-
-  if (up == vp && un == vn)
-    {
-      mpn_sqr_n (prodp, up, un);
-      return prodp[2 * un - 1];
-    }
-
-  if (vn < KARATSUBA_MUL_THRESHOLD)
-    { /* long multiplication */
-      mpn_mul_basecase (prodp, up, un, vp, vn);
-      return prodp[un + vn - 1];
-    }
-
-  mpn_mul_n (prodp, up, vp, vn);
-  if (un != vn)
-    { mp_limb_t t;
-      mp_ptr ws;
-      TMP_DECL (marker);
-      TMP_MARK (marker);
-
-      prodp += vn;
-      l = vn;
-      up += vn;
-      un -= vn;
-
-      if (un < vn) 
-	{
-	  /* Swap u's and v's. */
-          MPN_SRCPTR_SWAP (up,un, vp,vn);
-	}
-
-      ws = (mp_ptr) TMP_ALLOC (((vn >= KARATSUBA_MUL_THRESHOLD ? vn : un) + vn)
-			       * BYTES_PER_MP_LIMB);
-
-      t = 0;
-      while (vn >= KARATSUBA_MUL_THRESHOLD)
-	{
-	  mpn_mul_n (ws, up, vp, vn);
-	  if (l <= 2*vn) 
-	    {
-	      t += mpn_add_n (prodp, prodp, ws, l);
-	      if (l != 2*vn)
-		{
-		  t = mpn_add_1 (prodp + l, ws + l, 2*vn - l, t);
-		  l = 2*vn;
-		}
-	    }
-	  else
-	    {
-	      c = mpn_add_n (prodp, prodp, ws, 2*vn);
-	      t += mpn_add_1 (prodp + 2*vn, prodp + 2*vn, l - 2*vn, c);
-	    }
-	  prodp += vn;
-	  l -= vn;
-	  up += vn;
-	  un -= vn;
-	  if (un < vn) 
-	    {
-	      /* Swap u's and v's. */
-              MPN_SRCPTR_SWAP (up,un, vp,vn);
-	    }
-	}
-
-      if (vn)
-	{
-	  mpn_mul_basecase (ws, up, un, vp, vn);
-	  if (l <= un + vn) 
-	    {
-	      t += mpn_add_n (prodp, prodp, ws, l);
-	      if (l != un + vn)
-		t = mpn_add_1 (prodp + l, ws + l, un + vn - l, t);
-	    } 
-	  else
-	    {
-	      c = mpn_add_n (prodp, prodp, ws, un + vn);
-	      t += mpn_add_1 (prodp + un + vn, prodp + un + vn, l - un - vn, c);
-	    }
-	}
-
-    TMP_FREE (marker);
-  }
-  return prodp[un + vn - 1];
-}
diff --git a/ghc/rts/gmp/mpn/generic/mul_1.c b/ghc/rts/gmp/mpn/generic/mul_1.c
deleted file mode 100644
index 1c36b5fb1f..0000000000
--- a/ghc/rts/gmp/mpn/generic/mul_1.c
+++ /dev/null
@@ -1,59 +0,0 @@
-/* mpn_mul_1 -- Multiply a limb vector with a single limb and
-   store the product in a second limb vector.
-
-Copyright (C) 1991, 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-mp_limb_t
-mpn_mul_1 (res_ptr, s1_ptr, s1_size, s2_limb)
-     register mp_ptr res_ptr;
-     register mp_srcptr s1_ptr;
-     mp_size_t s1_size;
-     register mp_limb_t s2_limb;
-{
-  register mp_limb_t cy_limb;
-  register mp_size_t j;
-  register mp_limb_t prod_high, prod_low;
-
-  /* The loop counter and index J goes from -S1_SIZE to -1.  This way
-     the loop becomes faster.  */
-  j = -s1_size;
-
-  /* Offset the base pointers to compensate for the negative indices.  */
-  s1_ptr -= j;
-  res_ptr -= j;
-
-  cy_limb = 0;
-  do
-    {
-      umul_ppmm (prod_high, prod_low, s1_ptr[j], s2_limb);
-
-      prod_low += cy_limb;
-      cy_limb = (prod_low < cy_limb) + prod_high;
-
-      res_ptr[j] = prod_low;
-    }
-  while (++j != 0);
-
-  return cy_limb;
-}
diff --git a/ghc/rts/gmp/mpn/generic/mul_basecase.c b/ghc/rts/gmp/mpn/generic/mul_basecase.c
deleted file mode 100644
index 00c06aa5c4..0000000000
--- a/ghc/rts/gmp/mpn/generic/mul_basecase.c
+++ /dev/null
@@ -1,87 +0,0 @@
-/* mpn_mul_basecase -- Internal routine to multiply two natural numbers
-   of length m and n.
-
-   THIS IS AN INTERNAL FUNCTION WITH A MUTABLE INTERFACE.  IT IS ONLY
-   SAFE TO REACH THIS FUNCTION THROUGH DOCUMENTED INTERFACES.
-
-
-Copyright (C) 1991, 1992, 1993, 1994, 1996, 1997, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-/* Handle simple cases with traditional multiplication.
-
-   This is the most critical code of multiplication.  All multiplies rely on
-   this, both small and huge.  Small ones arrive here immediately, huge ones
-   arrive here as this is the base case for Karatsuba's recursive algorithm. */
-
-void
-#if __STDC__
-mpn_mul_basecase (mp_ptr prodp,
-		     mp_srcptr up, mp_size_t usize,
-		     mp_srcptr vp, mp_size_t vsize)
-#else
-mpn_mul_basecase (prodp, up, usize, vp, vsize)
-     mp_ptr prodp;
-     mp_srcptr up;
-     mp_size_t usize;
-     mp_srcptr vp;
-     mp_size_t vsize;
-#endif
-{
-  /* We first multiply by the low order one or two limbs, as the result can
-     be stored, not added, to PROD.  We also avoid a loop for zeroing this
-     way.  */
-#if HAVE_NATIVE_mpn_mul_2
-  if (vsize >= 2)
-    {
-      prodp[usize + 1] = mpn_mul_2 (prodp, up, usize, vp[0], vp[1]);
-      prodp += 2, vp += 2, vsize -= 2;
-    }
-  else
-    {
-      prodp[usize] = mpn_mul_1 (prodp, up, usize, vp[0]);
-      return;
-    }
-#else
-  prodp[usize] = mpn_mul_1 (prodp, up, usize, vp[0]);
-  prodp += 1, vp += 1, vsize -= 1;
-#endif
-
-#if HAVE_NATIVE_mpn_addmul_2
-  while (vsize >= 2)
-    {
-      prodp[usize + 1] = mpn_addmul_2 (prodp, up, usize, vp[0], vp[1]);
-      prodp += 2, vp += 2, vsize -= 2;
-    }
-  if (vsize != 0)
-    prodp[usize] = mpn_addmul_1 (prodp, up, usize, vp[0]);
-#else
-  /* For each iteration in the loop, multiply U with one limb from V, and
-     add the result to PROD.  */
-  while (vsize != 0)
-    {
-      prodp[usize] = mpn_addmul_1 (prodp, up, usize, vp[0]);
-      prodp += 1, vp += 1, vsize -= 1;
-    }
-#endif
-}
diff --git a/ghc/rts/gmp/mpn/generic/mul_fft.c b/ghc/rts/gmp/mpn/generic/mul_fft.c
deleted file mode 100644
index 00fd6d72de..0000000000
--- a/ghc/rts/gmp/mpn/generic/mul_fft.c
+++ /dev/null
@@ -1,772 +0,0 @@
-/* An implementation in GMP of Scho"nhage's fast multiplication algorithm
-   modulo 2^N+1, by Paul Zimmermann, INRIA Lorraine, February 1998.
-
-   THE CONTENTS OF THIS FILE ARE FOR INTERNAL USE AND THE FUNCTIONS HAVE
-   MUTABLE INTERFACES.  IT IS ONLY SAFE TO REACH THEM THROUGH DOCUMENTED
-   INTERFACES.  IT IS ALMOST GUARANTEED THAT THEY'LL CHANGE OR DISAPPEAR IN
-   A FUTURE GNU MP RELEASE.
-
-Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-
-/* References:
-
-   Schnelle Multiplikation grosser Zahlen, by Arnold Scho"nhage and Volker
-   Strassen, Computing 7, p. 281-292, 1971.
-
-   Asymptotically fast algorithms for the numerical multiplication
-   and division of polynomials with complex coefficients, by Arnold Scho"nhage,
-   Computer Algebra, EUROCAM'82, LNCS 144, p. 3-15, 1982.
-
-   Tapes versus Pointers, a study in implementing fast algorithms,
-   by Arnold Scho"nhage, Bulletin of the EATCS, 30, p. 23-32, 1986.
-
-   See also http://www.loria.fr/~zimmerma/bignum
-
-
-   Future:
-
-   K==2 isn't needed in the current uses of this code and the bits specific
-   for that could be dropped.
-
-   It might be possible to avoid a small number of MPN_COPYs by using a
-   rotating temporary or two.
-
-   Multiplications of unequal sized operands can be done with this code, but
-   it needs a tighter test for identifying squaring (same sizes as well as
-   same pointers).  */
-
-
-#include <stdio.h>
-#include "gmp.h"
-#include "gmp-impl.h"
-
-
-/* Change this to "#define TRACE(x) x" for some traces. */
-#define TRACE(x)
-
-
-
-FFT_TABLE_ATTRS mp_size_t mpn_fft_table[2][MPN_FFT_TABLE_SIZE] = {
-  FFT_MUL_TABLE,
-  FFT_SQR_TABLE
-};
-
-
-static void mpn_mul_fft_internal
-_PROTO ((mp_limb_t *op, mp_srcptr n, mp_srcptr m, mp_size_t pl,
-         int k, int K,
-         mp_limb_t **Ap, mp_limb_t **Bp,
-         mp_limb_t *A, mp_limb_t *B,
-         mp_size_t nprime, mp_size_t l, mp_size_t Mp, int **_fft_l,
-         mp_limb_t *T, int rec));
-
-
-/* Find the best k to use for a mod 2^(n*BITS_PER_MP_LIMB)+1 FFT.
-   sqr==0 if for a multiply, sqr==1 for a square */
-int
-#if __STDC__
-mpn_fft_best_k (mp_size_t n, int sqr)
-#else
-mpn_fft_best_k (n, sqr)
-     mp_size_t n;
-     int       sqr;
-#endif
-{
-  mp_size_t  t;
-  int        i;
-
-  for (i = 0; mpn_fft_table[sqr][i] != 0; i++)
-    if (n < mpn_fft_table[sqr][i])
-      return i + FFT_FIRST_K;
-
-  /* treat 4*last as one further entry */
-  if (i == 0 || n < 4*mpn_fft_table[sqr][i-1])
-    return i + FFT_FIRST_K;
-  else
-    return i + FFT_FIRST_K + 1;
-}
-
-
-/* Returns smallest possible number of limbs >= pl for a fft of size 2^k.
-   FIXME: Is this simply pl rounded up to the next multiple of 2^k ?  */
-
-mp_size_t
-#if __STDC__
-mpn_fft_next_size (mp_size_t pl, int k)
-#else
-mpn_fft_next_size (pl, k)
-     mp_size_t pl;
-     int       k;
-#endif
-{
-  mp_size_t N, M;
-  int       K;
-
-  /*  if (k==0) k = mpn_fft_best_k (pl, sqr); */
-  N = pl*BITS_PER_MP_LIMB;
-  K = 1<<k;
-  if (N%K) N=(N/K+1)*K;
-  M = N/K;
-  if (M%BITS_PER_MP_LIMB) N=((M/BITS_PER_MP_LIMB)+1)*BITS_PER_MP_LIMB*K;
-  return (N/BITS_PER_MP_LIMB);
-}
-
-
-static void
-#if __STDC__
-mpn_fft_initl(int **l, int k)
-#else
-mpn_fft_initl(l, k)
-     int  **l;
-     int  k;
-#endif
-{
-    int i,j,K;
-
-    l[0][0] = 0;
-    for (i=1,K=2;i<=k;i++,K*=2) {
-	for (j=0;j<K/2;j++) {
-	    l[i][j] = 2*l[i-1][j];
-	    l[i][K/2+j] = 1+l[i][j];
-	}
-    }
-}
-
-
-/* a <- -a mod 2^(n*BITS_PER_MP_LIMB)+1 */
-static void
-#if __STDC__
-mpn_fft_neg_modF(mp_limb_t *ap, mp_size_t n)
-#else
-mpn_fft_neg_modF(ap, n)
-     mp_limb_t *ap;
-     mp_size_t n;
-#endif
-{
-  mp_limb_t c;
-
-  c = ap[n]+2;
-  mpn_com_n (ap, ap, n);
-  ap[n]=0; mpn_incr_u(ap, c);
-}
-
-
-/* a <- a*2^e mod 2^(n*BITS_PER_MP_LIMB)+1 */
-static void
-#if __STDC__
-mpn_fft_mul_2exp_modF(mp_limb_t *ap, int e, mp_size_t n, mp_limb_t *tp)
-#else
-mpn_fft_mul_2exp_modF(ap, e, n, tp)
-     mp_limb_t *ap;
-     int e;
-     mp_size_t n;
-     mp_limb_t *tp;
-#endif
-{
-  int d, sh, i; mp_limb_t cc;
-
-  d = e%(n*BITS_PER_MP_LIMB); /* 2^e = (+/-) 2^d */
-  sh = d % BITS_PER_MP_LIMB;
-  if (sh) mpn_lshift(tp, ap, n+1, sh); /* no carry here */
-  else MPN_COPY(tp, ap, n+1);
-  d /= BITS_PER_MP_LIMB; /* now shift of d limbs to the left */
- if (d) { 
-   /* ap[d..n-1] = tp[0..n-d-1], ap[0..d-1] = -tp[n-d..n-1] */
-   /* mpn_xor would be more efficient here */
-   for (i=d-1;i>=0;i--) ap[i] = ~tp[n-d+i];
-   cc = 1-mpn_add_1(ap, ap, d, 1);
-   if (cc) cc=mpn_sub_1(ap+d, tp, n-d, 1);
-   else MPN_COPY(ap+d, tp, n-d);
-   if (cc+=mpn_sub_1(ap+d, ap+d, n-d, tp[n]))
-     ap[n]=mpn_add_1(ap, ap, n, cc);
-   else ap[n]=0;
-  }
-  else if ((ap[n]=mpn_sub_1(ap, tp, n, tp[n]))) {
-    ap[n]=mpn_add_1(ap, ap, n, 1);
-  }
-  if ((e/(n*BITS_PER_MP_LIMB))%2) mpn_fft_neg_modF(ap, n);
-}
-
-
-/* a <- a+b mod 2^(n*BITS_PER_MP_LIMB)+1 */
-static void
-#if __STDC__
-mpn_fft_add_modF (mp_limb_t *ap, mp_limb_t *bp, int n)
-#else
-mpn_fft_add_modF (ap, bp, n)
-     mp_limb_t *ap,*bp;
-     int n;
-#endif
-{
-  mp_limb_t c;
-
-  c = ap[n] + bp[n] + mpn_add_n(ap, ap, bp, n);
-  if (c>1) c -= 1+mpn_sub_1(ap,ap,n,1);
-  ap[n]=c;
-}
-
-
-/* input: A[0] ... A[inc*(K-1)] are residues mod 2^N+1 where
-          N=n*BITS_PER_MP_LIMB 
-          2^omega is a primitive root mod 2^N+1
-   output: A[inc*l[k][i]] <- \sum (2^omega)^(ij) A[inc*j] mod 2^N+1 */
-
-static void
-#if __STDC__
-mpn_fft_fft_sqr (mp_limb_t **Ap, mp_size_t K, int **ll,
-                 mp_size_t omega, mp_size_t n, mp_size_t inc, mp_limb_t *tp)
-#else
-mpn_fft_fft_sqr(Ap,K,ll,omega,n,inc,tp)
-mp_limb_t **Ap,*tp;
-mp_size_t K,omega,n,inc;
-int       **ll;
-#endif
-{
-  if (K==2) {
-#ifdef ADDSUB
-      if (mpn_addsub_n(Ap[0], Ap[inc], Ap[0], Ap[inc], n+1) & 1)
-#else
-      MPN_COPY(tp, Ap[0], n+1);
-      mpn_add_n(Ap[0], Ap[0], Ap[inc],n+1);
-      if (mpn_sub_n(Ap[inc], tp, Ap[inc],n+1))
-#endif
-      	Ap[inc][n] = mpn_add_1(Ap[inc], Ap[inc], n, 1);
-    }
-    else {
-      int       j, inc2=2*inc;
-      int       *lk = *ll;
-      mp_limb_t *tmp;
-      TMP_DECL(marker);
-
-      TMP_MARK(marker);
-      tmp = TMP_ALLOC_LIMBS (n+1);
-	mpn_fft_fft_sqr(Ap, K/2,ll-1,2*omega,n,inc2, tp);
-	mpn_fft_fft_sqr(Ap+inc, K/2,ll-1,2*omega,n,inc2, tp);
-	/* A[2*j*inc]   <- A[2*j*inc] + omega^l[k][2*j*inc] A[(2j+1)inc]
-	   A[(2j+1)inc] <- A[2*j*inc] + omega^l[k][(2j+1)inc] A[(2j+1)inc] */
-	for (j=0;j<K/2;j++,lk+=2,Ap+=2*inc) {
-	  MPN_COPY(tp, Ap[inc], n+1);
-	  mpn_fft_mul_2exp_modF(Ap[inc], lk[1]*omega, n, tmp);
-	  mpn_fft_add_modF(Ap[inc], Ap[0], n);
-	  mpn_fft_mul_2exp_modF(tp,lk[0]*omega, n, tmp);
-	  mpn_fft_add_modF(Ap[0], tp, n);
-	}
-        TMP_FREE(marker);
-    }
-}
-
-
-/* input: A[0] ... A[inc*(K-1)] are residues mod 2^N+1 where
-          N=n*BITS_PER_MP_LIMB 
-         2^omega is a primitive root mod 2^N+1 
-   output: A[inc*l[k][i]] <- \sum (2^omega)^(ij) A[inc*j] mod 2^N+1 */
-
-static void
-#if __STDC__
-mpn_fft_fft (mp_limb_t **Ap, mp_limb_t **Bp, mp_size_t K, int **ll,
-             mp_size_t omega, mp_size_t n, mp_size_t inc, mp_limb_t *tp)
-#else
-mpn_fft_fft(Ap,Bp,K,ll,omega,n,inc,tp)
-     mp_limb_t **Ap,**Bp,*tp;
-     mp_size_t K,omega,n,inc;
-     int       **ll;
-#endif
-{
-  if (K==2) {
-#ifdef ADDSUB
-      if (mpn_addsub_n(Ap[0], Ap[inc], Ap[0], Ap[inc], n+1) & 1)
-#else
-      MPN_COPY(tp, Ap[0], n+1);
-      mpn_add_n(Ap[0], Ap[0], Ap[inc],n+1);
-      if (mpn_sub_n(Ap[inc], tp, Ap[inc],n+1))
-#endif
-      	Ap[inc][n] = mpn_add_1(Ap[inc], Ap[inc], n, 1);
-#ifdef ADDSUB
-      if (mpn_addsub_n(Bp[0], Bp[inc], Bp[0], Bp[inc], n+1) & 1)
-#else
-      MPN_COPY(tp, Bp[0], n+1);
-      mpn_add_n(Bp[0], Bp[0], Bp[inc],n+1);
-      if (mpn_sub_n(Bp[inc], tp, Bp[inc],n+1))
-#endif
-      	Bp[inc][n] = mpn_add_1(Bp[inc], Bp[inc], n, 1);
-    }
-    else {
-	int       j, inc2=2*inc;
-        int       *lk=*ll;
-        mp_limb_t *tmp;
-	TMP_DECL(marker);
-
-	TMP_MARK(marker);
-	tmp = TMP_ALLOC_LIMBS (n+1);
-	mpn_fft_fft(Ap, Bp, K/2,ll-1,2*omega,n,inc2, tp);
-	mpn_fft_fft(Ap+inc, Bp+inc, K/2,ll-1,2*omega,n,inc2, tp);
-	/* A[2*j*inc]   <- A[2*j*inc] + omega^l[k][2*j*inc] A[(2j+1)inc]
-	   A[(2j+1)inc] <- A[2*j*inc] + omega^l[k][(2j+1)inc] A[(2j+1)inc] */
-	for (j=0;j<K/2;j++,lk+=2,Ap+=2*inc,Bp+=2*inc) {
-	  MPN_COPY(tp, Ap[inc], n+1);
-	  mpn_fft_mul_2exp_modF(Ap[inc], lk[1]*omega, n, tmp);
-	  mpn_fft_add_modF(Ap[inc], Ap[0], n);
-	  mpn_fft_mul_2exp_modF(tp,lk[0]*omega, n, tmp);
-	  mpn_fft_add_modF(Ap[0], tp, n);
-	  MPN_COPY(tp, Bp[inc], n+1);
-	  mpn_fft_mul_2exp_modF(Bp[inc], lk[1]*omega, n, tmp);
-	  mpn_fft_add_modF(Bp[inc], Bp[0], n);
-	  mpn_fft_mul_2exp_modF(tp,lk[0]*omega, n, tmp);
-	  mpn_fft_add_modF(Bp[0], tp, n);
-	}
-	TMP_FREE(marker);
-    }
-}
-
-
-/* a[i] <- a[i]*b[i] mod 2^(n*BITS_PER_MP_LIMB)+1 for 0 <= i < K */
-static void
-#if __STDC__
-mpn_fft_mul_modF_K (mp_limb_t **ap, mp_limb_t **bp, mp_size_t n, int K) 
-#else
-mpn_fft_mul_modF_K(ap, bp, n, K) 
-     mp_limb_t **ap, **bp;
-     mp_size_t n;
-     int       K;
-#endif
-{
-  int  i;
-  int  sqr = (ap == bp);
-  TMP_DECL(marker);
-  
-  TMP_MARK(marker); 
-
-  if (n >= (sqr ? FFT_MODF_SQR_THRESHOLD : FFT_MODF_MUL_THRESHOLD)) {
-    int k, K2,nprime2,Nprime2,M2,maxLK,l,Mp2;
-    int       **_fft_l;
-    mp_limb_t **Ap,**Bp,*A,*B,*T;
-
-    k = mpn_fft_best_k (n, sqr);
-    K2 = 1<<k;
-    maxLK = (K2>BITS_PER_MP_LIMB) ? K2 : BITS_PER_MP_LIMB;
-    M2 = n*BITS_PER_MP_LIMB/K2;
-    l = n/K2;
-    Nprime2 = ((2*M2+k+2+maxLK)/maxLK)*maxLK; /* ceil((2*M2+k+3)/maxLK)*maxLK*/
-    nprime2 = Nprime2/BITS_PER_MP_LIMB;
-    Mp2 = Nprime2/K2;
-
-    Ap = TMP_ALLOC_MP_PTRS (K2);
-    Bp = TMP_ALLOC_MP_PTRS (K2);
-    A = TMP_ALLOC_LIMBS (2*K2*(nprime2+1));
-    T = TMP_ALLOC_LIMBS (nprime2+1);
-    B = A + K2*(nprime2+1);
-    _fft_l = TMP_ALLOC_TYPE (k+1, int*);
-    for (i=0;i<=k;i++)
-      _fft_l[i] = TMP_ALLOC_TYPE (1<<i, int);
-    mpn_fft_initl(_fft_l, k);
-
-    TRACE (printf("recurse: %dx%d limbs -> %d times %dx%d (%1.2f)\n", n,
-                  n, K2, nprime2, nprime2, 2.0*(double)n/nprime2/K2));
-
-    for (i=0;i<K;i++,ap++,bp++)
-      mpn_mul_fft_internal(*ap, *ap, *bp, n, k, K2, Ap, Bp, A, B, nprime2,
-	 l, Mp2, _fft_l, T, 1);
-  }
-  else {
-     mp_limb_t *a, *b, cc, *tp, *tpn; int n2=2*n;
-     tp = TMP_ALLOC_LIMBS (n2);
-     tpn = tp+n;
-     TRACE (printf ("  mpn_mul_n %d of %d limbs\n", K, n));
-     for (i=0;i<K;i++) {
-        a = *ap++; b=*bp++;
-        if (sqr)
-          mpn_sqr_n(tp, a, n);
-        else
-          mpn_mul_n(tp, b, a, n);
-	if (a[n]) cc=mpn_add_n(tpn, tpn, b, n); else cc=0;
-	if (b[n]) cc += mpn_add_n(tpn, tpn, a, n) + a[n];
-	if (cc) {
-          cc = mpn_add_1(tp, tp, n2, cc);
-          ASSERT_NOCARRY (mpn_add_1(tp, tp, n2, cc));
-        }
-	a[n] = mpn_sub_n(a, tp, tpn, n) && mpn_add_1(a, a, n, 1); 
-     }
-  }
-  TMP_FREE(marker); 
-}
-
-
-/* input: A^[l[k][0]] A^[l[k][1]] ... A^[l[k][K-1]]
-   output: K*A[0] K*A[K-1] ... K*A[1] */
-
-static void
-#if __STDC__
-mpn_fft_fftinv (mp_limb_t **Ap, int K, mp_size_t omega, mp_size_t n,
-                mp_limb_t *tp)
-#else
-mpn_fft_fftinv(Ap,K,omega,n,tp)
-     mp_limb_t **Ap, *tp;
-     int       K;
-     mp_size_t omega, n;
-#endif
-{
-    if (K==2) {
-#ifdef ADDSUB
-      if (mpn_addsub_n(Ap[0], Ap[1], Ap[0], Ap[1], n+1) & 1)
-#else
-      MPN_COPY(tp, Ap[0], n+1);
-      mpn_add_n(Ap[0], Ap[0], Ap[1], n+1);
-      if (mpn_sub_n(Ap[1], tp, Ap[1], n+1))
-#endif
-        Ap[1][n] = mpn_add_1(Ap[1], Ap[1], n, 1);
-    }
-    else {
-	int j, K2=K/2; mp_limb_t **Bp=Ap+K2, *tmp; 
-	TMP_DECL(marker);
-
-	TMP_MARK(marker);
-	tmp = TMP_ALLOC_LIMBS (n+1);
-	mpn_fft_fftinv(Ap, K2, 2*omega, n, tp);
-	mpn_fft_fftinv(Bp, K2, 2*omega, n, tp);
-	/* A[j]     <- A[j] + omega^j A[j+K/2]
-	   A[j+K/2] <- A[j] + omega^(j+K/2) A[j+K/2] */
-        for (j=0;j<K2;j++,Ap++,Bp++) {
-	  MPN_COPY(tp, Bp[0], n+1);
-	  mpn_fft_mul_2exp_modF(Bp[0], (j+K2)*omega, n, tmp);
-	  mpn_fft_add_modF(Bp[0], Ap[0], n);
-	  mpn_fft_mul_2exp_modF(tp, j*omega, n, tmp);
-	  mpn_fft_add_modF(Ap[0], tp, n);
-	}
-	TMP_FREE(marker);
-    }
-}
-
-
-/* A <- A/2^k mod 2^(n*BITS_PER_MP_LIMB)+1 */
-static void
-#if __STDC__
-mpn_fft_div_2exp_modF (mp_limb_t *ap, int k, mp_size_t n, mp_limb_t *tp)
-#else
-mpn_fft_div_2exp_modF(ap,k,n,tp)
-     mp_limb_t *ap,*tp;
-     int       k;
-     mp_size_t n;
-#endif
-{
-    int i;
-    
-    i = 2*n*BITS_PER_MP_LIMB;
-    i = (i-k) % i;
-    mpn_fft_mul_2exp_modF(ap,i,n,tp); 
-    /* 1/2^k = 2^(2nL-k) mod 2^(n*BITS_PER_MP_LIMB)+1 */
-    /* normalize so that A < 2^(n*BITS_PER_MP_LIMB)+1 */
-    if (ap[n]==1) {
-      for (i=0;i<n && ap[i]==0;i++);
-      if (i<n) {
-	ap[n]=0;
-	mpn_sub_1(ap, ap, n, 1);
-      }
-    }
-}
-
-
-/* R <- A mod 2^(n*BITS_PER_MP_LIMB)+1, n<=an<=3*n */
-static void
-#if __STDC__
-mpn_fft_norm_modF(mp_limb_t *rp, mp_limb_t *ap, mp_size_t n, mp_size_t an) 
-#else
-mpn_fft_norm_modF(rp, ap, n, an)
-     mp_limb_t *rp;
-     mp_limb_t *ap;
-     mp_size_t n;
-     mp_size_t an;
-#endif
-{
-  mp_size_t l;
-
-   if (an>2*n) {
-     l = n;
-     rp[n] = mpn_add_1(rp+an-2*n, ap+an-2*n, 3*n-an, 
-		       mpn_add_n(rp,ap,ap+2*n,an-2*n));
-   }
-   else {
-     l = an-n;
-     MPN_COPY(rp, ap, n);
-     rp[n]=0;
-   }
-   if (mpn_sub_n(rp,rp,ap+n,l)) {
-     if (mpn_sub_1(rp+l,rp+l,n+1-l,1))
-       rp[n]=mpn_add_1(rp,rp,n,1); 
-   }
-}
-
-
-static void
-#if __STDC__
-mpn_mul_fft_internal(mp_limb_t *op, mp_srcptr n, mp_srcptr m, mp_size_t pl,
-                     int k, int K,
-                     mp_limb_t **Ap, mp_limb_t **Bp,
-                     mp_limb_t *A, mp_limb_t *B,
-                     mp_size_t nprime, mp_size_t l, mp_size_t Mp,
-                     int **_fft_l,
-                     mp_limb_t *T, int rec)
-#else
-mpn_mul_fft_internal(op,n,m,pl,k,K,Ap,Bp,A,B,nprime,l,Mp,_fft_l,T,rec)
-     mp_limb_t *op;
-     mp_srcptr n, m;
-     mp_limb_t **Ap,**Bp,*A,*B,*T;
-     mp_size_t pl,nprime;
-     int       **_fft_l;
-     int       k,K,l,Mp,rec;
-#endif
-{
-  int       i, sqr, pla, lo, sh, j;
-  mp_limb_t *p;
-
-    sqr = (n==m);
-
-    TRACE (printf ("pl=%d k=%d K=%d np=%d l=%d Mp=%d rec=%d sqr=%d\n",
-                   pl,k,K,nprime,l,Mp,rec,sqr));
-
-    /* decomposition of inputs into arrays Ap[i] and Bp[i] */
-    if (rec) for (i=0;i<K;i++) {
-      Ap[i] = A+i*(nprime+1); Bp[i] = B+i*(nprime+1);
-      /* store the next M bits of n into A[i] */
-      /* supposes that M is a multiple of BITS_PER_MP_LIMB */
-      MPN_COPY(Ap[i], n, l); n+=l; MPN_ZERO(Ap[i]+l, nprime+1-l);
-      /* set most significant bits of n and m (important in recursive calls) */
-      if (i==K-1) Ap[i][l]=n[0];
-      mpn_fft_mul_2exp_modF(Ap[i], i*Mp, nprime, T);
-      if (!sqr) {
-	MPN_COPY(Bp[i], m, l); m+=l; MPN_ZERO(Bp[i]+l, nprime+1-l);
-	if (i==K-1) Bp[i][l]=m[0];
-	mpn_fft_mul_2exp_modF(Bp[i], i*Mp, nprime, T);
-      }
-    }
-
-    /* direct fft's */
-    if (sqr) mpn_fft_fft_sqr(Ap,K,_fft_l+k,2*Mp,nprime,1, T);
-    else mpn_fft_fft(Ap,Bp,K,_fft_l+k,2*Mp,nprime,1, T);
-
-    /* term to term multiplications */
-    mpn_fft_mul_modF_K(Ap, (sqr) ? Ap : Bp, nprime, K);
-
-    /* inverse fft's */
-    mpn_fft_fftinv(Ap, K, 2*Mp, nprime, T);
-
-    /* division of terms after inverse fft */
-    for (i=0;i<K;i++) mpn_fft_div_2exp_modF(Ap[i],k+((K-i)%K)*Mp,nprime, T);
-
-    /* addition of terms in result p */
-    MPN_ZERO(T,nprime+1); 
-    pla = l*(K-1)+nprime+1; /* number of required limbs for p */
-    p = B; /* B has K*(n'+1) limbs, which is >= pla, i.e. enough */
-    MPN_ZERO(p, pla);
-    sqr=0; /* will accumulate the (signed) carry at p[pla] */
-    for (i=K-1,lo=l*i+nprime,sh=l*i;i>=0;i--,lo-=l,sh-=l) {
-        mp_ptr n = p+sh;
-	j = (K-i)%K;
-	if (mpn_add_n(n,n,Ap[j],nprime+1))
-	  sqr += mpn_add_1(n+nprime+1,n+nprime+1,pla-sh-nprime-1,1);
-	T[2*l]=i+1; /* T = (i+1)*2^(2*M) */
-	if (mpn_cmp(Ap[j],T,nprime+1)>0) { /* subtract 2^N'+1 */
-	  sqr -= mpn_sub_1(n,n,pla-sh,1);
-	  sqr -= mpn_sub_1(p+lo,p+lo,pla-lo,1);
-	}
-    }
-    if (sqr==-1) {
-      if ((sqr=mpn_add_1(p+pla-pl,p+pla-pl,pl,1))) {
-	/* p[pla-pl]...p[pla-1] are all zero */
-        mpn_sub_1(p+pla-pl-1,p+pla-pl-1,pl+1,1);
-	mpn_sub_1(p+pla-1,p+pla-1,1,1);
-      }
-    }
-    else if (sqr==1) {
-	    if (pla>=2*pl)
-	      while ((sqr=mpn_add_1(p+pla-2*pl,p+pla-2*pl,2*pl,sqr)));
-	    else {
-	      sqr = mpn_sub_1(p+pla-pl,p+pla-pl,pl,sqr);
-              ASSERT (sqr == 0);
-	    }
-    }
-    else
-      ASSERT (sqr == 0);
-
-    /* here p < 2^(2M) [K 2^(M(K-1)) + (K-1) 2^(M(K-2)) + ... ]
-              < K 2^(2M) [2^(M(K-1)) + 2^(M(K-2)) + ... ]
-	      < K 2^(2M) 2^(M(K-1))*2 = 2^(M*K+M+k+1) */
-    mpn_fft_norm_modF(op,p,pl,pla);
-}
-
-
-/* op <- n*m mod 2^N+1 with fft of size 2^k where N=pl*BITS_PER_MP_LIMB
-   n and m have respectively nl and ml limbs
-   op must have space for pl+1 limbs
-   One must have pl = mpn_fft_next_size(pl, k).
-*/
-
-void
-#if __STDC__
-mpn_mul_fft (mp_ptr op, mp_size_t pl,
-             mp_srcptr n, mp_size_t nl,
-             mp_srcptr m, mp_size_t ml,
-             int k)
-#else
-mpn_mul_fft (op, pl, n, nl, m, ml, k)
-     mp_ptr    op;
-     mp_size_t pl;
-     mp_srcptr n;
-     mp_size_t nl;
-     mp_srcptr m;
-     mp_size_t ml;
-     int k;
-#endif
-{
-    int        K,maxLK,i,j;
-    mp_size_t  N,Nprime,nprime,M,Mp,l;
-    mp_limb_t  **Ap,**Bp,*A,*T,*B;
-    int        **_fft_l;
-    int        sqr = (n==m && nl==ml);
-    TMP_DECL(marker);
-
-    TRACE (printf ("\nmpn_mul_fft pl=%ld nl=%ld ml=%ld k=%d\n",
-                   pl, nl, ml, k));
-    ASSERT_ALWAYS (mpn_fft_next_size(pl, k) == pl);
-
-    TMP_MARK(marker);
-    N = pl*BITS_PER_MP_LIMB;
-    _fft_l = TMP_ALLOC_TYPE (k+1, int*);
-    for (i=0;i<=k;i++)
-      _fft_l[i] = TMP_ALLOC_TYPE (1<<i, int);
-    mpn_fft_initl(_fft_l, k);
-    K = 1<<k;
-    M = N/K;	/* N = 2^k M */
-    l = M/BITS_PER_MP_LIMB;
-    maxLK = (K>BITS_PER_MP_LIMB) ? K : BITS_PER_MP_LIMB;
-
-    Nprime = ((2*M+k+2+maxLK)/maxLK)*maxLK; /* ceil((2*M+k+3)/maxLK)*maxLK; */
-    nprime = Nprime/BITS_PER_MP_LIMB; 
-    TRACE (printf ("N=%d K=%d, M=%d, l=%d, maxLK=%d, Np=%d, np=%d\n",
-                   N, K, M, l, maxLK, Nprime, nprime));
-    if (nprime >= (sqr ? FFT_MODF_SQR_THRESHOLD : FFT_MODF_MUL_THRESHOLD)) {
-      maxLK = (1<<mpn_fft_best_k(nprime,n==m))*BITS_PER_MP_LIMB;
-      if (Nprime % maxLK) {
-	Nprime=((Nprime/maxLK)+1)*maxLK;
-	nprime = Nprime/BITS_PER_MP_LIMB;
-      }
-      TRACE (printf ("new maxLK=%d, Np=%d, np=%d\n", maxLK, Nprime, nprime));
-    }
-
-    T = TMP_ALLOC_LIMBS (nprime+1);
-    Mp = Nprime/K;
-
-    TRACE (printf("%dx%d limbs -> %d times %dx%d limbs (%1.2f)\n",
-                  pl,pl,K,nprime,nprime,2.0*(double)N/Nprime/K);
-           printf("   temp space %ld\n", 2*K*(nprime+1)));
-
-    A = _MP_ALLOCATE_FUNC_LIMBS (2*K*(nprime+1));
-    B = A+K*(nprime+1);
-    Ap = TMP_ALLOC_MP_PTRS (K); 
-    Bp = TMP_ALLOC_MP_PTRS (K); 
-    /* special decomposition for main call */
-    for (i=0;i<K;i++) {
-      Ap[i] = A+i*(nprime+1); Bp[i] = B+i*(nprime+1);
-      /* store the next M bits of n into A[i] */
-      /* supposes that M is a multiple of BITS_PER_MP_LIMB */
-      if (nl>0) {
-	j = (nl>=l) ? l : nl; /* limbs to store in Ap[i] */
-	MPN_COPY(Ap[i], n, j); n+=l; MPN_ZERO(Ap[i]+j, nprime+1-j);
-	mpn_fft_mul_2exp_modF(Ap[i], i*Mp, nprime, T);
-      }
-      else MPN_ZERO(Ap[i], nprime+1);
-      nl -= l;
-      if (n!=m) {
-	if (ml>0) {
-	  j = (ml>=l) ? l : ml; /* limbs to store in Bp[i] */
-	  MPN_COPY(Bp[i], m, j); m+=l; MPN_ZERO(Bp[i]+j, nprime+1-j);
-	  mpn_fft_mul_2exp_modF(Bp[i], i*Mp, nprime, T);
-	}
-	else MPN_ZERO(Bp[i], nprime+1);
-      }
-      ml -= l;
-    }
-    mpn_mul_fft_internal(op,n,m,pl,k,K,Ap,Bp,A,B,nprime,l,Mp,_fft_l,T,0);
-    TMP_FREE(marker);
-    _MP_FREE_FUNC_LIMBS (A, 2*K*(nprime+1));
-}
-
-
-#if WANT_ASSERT
-static int
-#if __STDC__
-mpn_zero_p (mp_ptr p, mp_size_t n)
-#else
-     mpn_zero_p (p, n)
-     mp_ptr p;
-     mp_size_t n;
-#endif
-{
-  mp_size_t i;
-
-  for (i = 0; i < n; i++)
-    {
-      if (p[i] != 0)
-        return 0;
-    }
-
-  return 1;
-}
-#endif
-
-
-/* Multiply {n,nl}*{m,ml} and write the result to {op,nl+ml}.
-
-   FIXME: Duplicating the result like this is wasteful, do something better
-   perhaps at the norm_modF stage above. */
-
-void
-#if __STDC__
-mpn_mul_fft_full (mp_ptr op,
-                  mp_srcptr n, mp_size_t nl,
-                  mp_srcptr m, mp_size_t ml)
-#else
-mpn_mul_fft_full (op, n, nl, m, ml)
-     mp_ptr    op;
-     mp_srcptr n;
-     mp_size_t nl;
-     mp_srcptr m;
-     mp_size_t ml;
-#endif
-{
-  mp_ptr     pad_op;
-  mp_size_t  pl;
-  int        k;
-  int        sqr = (n==m && nl==ml);
-
-  k = mpn_fft_best_k (nl+ml, sqr);
-  pl = mpn_fft_next_size (nl+ml, k);
-
-  TRACE (printf ("mpn_mul_fft_full nl=%ld ml=%ld -> pl=%ld k=%d\n",
-                 nl, ml, pl, k));
-
-  pad_op = _MP_ALLOCATE_FUNC_LIMBS (pl+1);
-  mpn_mul_fft (pad_op, pl, n, nl, m, ml, k);
-
-  ASSERT (mpn_zero_p (pad_op+nl+ml, pl+1-(nl+ml)));
-  MPN_COPY (op, pad_op, nl+ml);
-
-  _MP_FREE_FUNC_LIMBS (pad_op, pl+1);
-}
diff --git a/ghc/rts/gmp/mpn/generic/mul_n.c b/ghc/rts/gmp/mpn/generic/mul_n.c
deleted file mode 100644
index b7563be2d3..0000000000
--- a/ghc/rts/gmp/mpn/generic/mul_n.c
+++ /dev/null
@@ -1,1343 +0,0 @@
-/* mpn_mul_n and helper function -- Multiply/square natural numbers.
-
-   THE HELPER FUNCTIONS IN THIS FILE (meaning everything except mpn_mul_n)
-   ARE INTERNAL FUNCTIONS WITH MUTABLE INTERFACES.  IT IS ONLY SAFE TO REACH
-   THEM THROUGH DOCUMENTED INTERFACES.  IN FACT, IT IS ALMOST GUARANTEED
-   THAT THEY'LL CHANGE OR DISAPPEAR IN A FUTURE GNU MP RELEASE.
-
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 1998, 1999, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-/* Multiplicative inverse of 3, modulo 2^BITS_PER_MP_LIMB.
-   0xAAAAAAAB for 32 bits, 0xAAAAAAAAAAAAAAAB for 64 bits. */
-#define INVERSE_3      ((MP_LIMB_T_MAX / 3) * 2 + 1)
-
-#if !defined (__alpha) && !defined (__mips)
-/* For all other machines, we want to call mpn functions for the compund
-   operations instead of open-coding them.  */
-#define USE_MORE_MPN
-#endif
-
-/*== Function declarations =================================================*/
-
-static void evaluate3 _PROTO ((mp_ptr, mp_ptr, mp_ptr,
-                               mp_ptr, mp_ptr, mp_ptr,
-                               mp_srcptr, mp_srcptr, mp_srcptr,
-                               mp_size_t, mp_size_t));
-static void interpolate3 _PROTO ((mp_srcptr,
-                                  mp_ptr, mp_ptr, mp_ptr,
-                                  mp_srcptr,
-                                  mp_ptr, mp_ptr, mp_ptr,
-                                  mp_size_t, mp_size_t));
-static mp_limb_t add2Times _PROTO ((mp_ptr, mp_srcptr, mp_srcptr, mp_size_t));
-
-
-/*-- mpn_kara_mul_n ---------------------------------------------------------------*/
-
-/* Multiplies using 3 half-sized mults and so on recursively.
- * p[0..2*n-1] := product of a[0..n-1] and b[0..n-1].
- * No overlap of p[...] with a[...] or b[...].
- * ws is workspace.
- */
-
-void
-#if __STDC__
-mpn_kara_mul_n (mp_ptr p, mp_srcptr a, mp_srcptr b, mp_size_t n, mp_ptr ws)
-#else
-mpn_kara_mul_n(p, a, b, n, ws)
-     mp_ptr    p;
-     mp_srcptr a;
-     mp_srcptr b;
-     mp_size_t n;
-     mp_ptr    ws;
-#endif
-{
-  mp_limb_t i, sign, w, w0, w1;
-  mp_size_t n2;
-  mp_srcptr x, y;
-
-  n2 = n >> 1;
-  ASSERT (n2 > 0);
-
-  if (n & 1)
-    {
-      /* Odd length. */
-      mp_size_t n1, n3, nm1;
-
-      n3 = n - n2;
-
-      sign = 0;
-      w = a[n2];
-      if (w != 0)
-	w -= mpn_sub_n (p, a, a + n3, n2);
-      else
-	{
-	  i = n2;
-	  do
-	    {
-	      --i;
-	      w0 = a[i];
-	      w1 = a[n3+i];
-	    }
-	  while (w0 == w1 && i != 0);
-	  if (w0 < w1)
-	    {
-	      x = a + n3;
-	      y = a;
-	      sign = 1;
-	    }
-	  else
-	    {
-	      x = a;
-	      y = a + n3;
-	    }
-	  mpn_sub_n (p, x, y, n2);
-	}
-      p[n2] = w;
-
-      w = b[n2];
-      if (w != 0)
-	w -= mpn_sub_n (p + n3, b, b + n3, n2);
-      else
-	{
-	  i = n2;
-	  do 
-	    {
-	      --i;
-	      w0 = b[i]; 
-	      w1 = b[n3+i];
-	    }
-	  while (w0 == w1 && i != 0);
-	  if (w0 < w1)
-	    {
-	      x = b + n3;
-	      y = b;
-	      sign ^= 1;
-	    }
-	  else
-	    {
-	      x = b;
-	      y = b + n3;
-	    }
-	  mpn_sub_n (p + n3, x, y, n2);
-	}
-      p[n] = w;
-
-      n1 = n + 1;
-      if (n2 < KARATSUBA_MUL_THRESHOLD)
-	{
-	  if (n3 < KARATSUBA_MUL_THRESHOLD)
-	    {
-	      mpn_mul_basecase (ws, p, n3, p + n3, n3);
-	      mpn_mul_basecase (p, a, n3, b, n3);
-	    }
-	  else
-	    {
-	      mpn_kara_mul_n (ws, p, p + n3, n3, ws + n1);
-	      mpn_kara_mul_n (p, a, b, n3, ws + n1);
-	    }
-	  mpn_mul_basecase (p + n1, a + n3, n2, b + n3, n2);
-	}
-      else
-	{
-	  mpn_kara_mul_n (ws, p, p + n3, n3, ws + n1);
-	  mpn_kara_mul_n (p, a, b, n3, ws + n1);
-	  mpn_kara_mul_n (p + n1, a + n3, b + n3, n2, ws + n1);
-	}
-
-      if (sign)
-	mpn_add_n (ws, p, ws, n1);
-      else
-	mpn_sub_n (ws, p, ws, n1);
-
-      nm1 = n - 1;
-      if (mpn_add_n (ws, p + n1, ws, nm1))
-	{
-	  mp_limb_t x = ws[nm1] + 1;
-	  ws[nm1] = x;
-	  if (x == 0)
-	    ++ws[n];
-	}
-      if (mpn_add_n (p + n3, p + n3, ws, n1))
-	{
-	  mp_limb_t x;
-	  i = n1 + n3;
-	  do
-	    {
-	      x = p[i] + 1;
-	      p[i] = x;
-	      ++i;
-	    } while (x == 0);
-	}
-    }
-  else
-    {
-      /* Even length. */
-      mp_limb_t t;
-
-      i = n2;
-      do
-	{
-	  --i;
-	  w0 = a[i];
-	  w1 = a[n2+i];
-	}
-      while (w0 == w1 && i != 0);
-      sign = 0;
-      if (w0 < w1)
-	{
-	  x = a + n2;
-	  y = a;
-	  sign = 1;
-	}
-      else
-	{
-	  x = a;
-	  y = a + n2;
-	}
-      mpn_sub_n (p, x, y, n2);
-
-      i = n2;
-      do 
-	{
-	  --i;
-	  w0 = b[i];
-	  w1 = b[n2+i];
-	}
-      while (w0 == w1 && i != 0);
-      if (w0 < w1)
-	{
-	  x = b + n2;
-	  y = b;
-	  sign ^= 1;
-	}
-      else
-	{
-	  x = b;
-	  y = b + n2;
-	}
-      mpn_sub_n (p + n2, x, y, n2);
-
-      /* Pointwise products. */
-      if (n2 < KARATSUBA_MUL_THRESHOLD)
-	{
-	  mpn_mul_basecase (ws, p, n2, p + n2, n2);
-	  mpn_mul_basecase (p, a, n2, b, n2);
-	  mpn_mul_basecase (p + n, a + n2, n2, b + n2, n2);
-	}
-      else
-	{
-	  mpn_kara_mul_n (ws, p, p + n2, n2, ws + n);
-	  mpn_kara_mul_n (p, a, b, n2, ws + n);
-	  mpn_kara_mul_n (p + n, a + n2, b + n2, n2, ws + n);
-	}
-
-      /* Interpolate. */
-      if (sign)
-	w = mpn_add_n (ws, p, ws, n);
-      else
-	w = -mpn_sub_n (ws, p, ws, n);
-      w += mpn_add_n (ws, p + n, ws, n);
-      w += mpn_add_n (p + n2, p + n2, ws, n);
-      /* TO DO: could put "if (w) { ... }" here.
-       * Less work but badly predicted branch.
-       * No measurable difference in speed on Alpha.
-       */
-      i = n + n2;
-      t = p[i] + w;
-      p[i] = t;
-      if (t < w)
-	{
-	  do
-	    {
-	      ++i;
-	      w = p[i] + 1;
-	      p[i] = w;
-	    }
-	  while (w == 0);
-	}
-    }
-}
-
-void
-#if __STDC__
-mpn_kara_sqr_n (mp_ptr p, mp_srcptr a, mp_size_t n, mp_ptr ws)
-#else
-mpn_kara_sqr_n (p, a, n, ws)
-     mp_ptr    p;
-     mp_srcptr a;
-     mp_size_t n;
-     mp_ptr    ws;
-#endif
-{
-  mp_limb_t i, sign, w, w0, w1;
-  mp_size_t n2;
-  mp_srcptr x, y;
-
-  n2 = n >> 1;
-  ASSERT (n2 > 0);
-
-  if (n & 1)
-    {
-      /* Odd length. */
-      mp_size_t n1, n3, nm1;
-
-      n3 = n - n2;
-
-      sign = 0;
-      w = a[n2];
-      if (w != 0)
-	w -= mpn_sub_n (p, a, a + n3, n2);
-      else
-	{
-	  i = n2;
-	  do
-	    {
-	      --i;
-	      w0 = a[i];
-	      w1 = a[n3+i];
-	    }
-	  while (w0 == w1 && i != 0);
-	  if (w0 < w1)
-	    {
-	      x = a + n3;
-	      y = a;
-	      sign = 1;
-	    }
-	  else
-	    {
-	      x = a;
-	      y = a + n3;
-	    }
-	  mpn_sub_n (p, x, y, n2);
-	}
-      p[n2] = w;
-
-      w = a[n2];
-      if (w != 0)
-	w -= mpn_sub_n (p + n3, a, a + n3, n2);
-      else
-	{
-	  i = n2;
-	  do 
-	    {
-	      --i;
-	      w0 = a[i]; 
-	      w1 = a[n3+i];
-	    }
-	  while (w0 == w1 && i != 0);
-	  if (w0 < w1)
-	    {
-	      x = a + n3;
-	      y = a;
-	      sign ^= 1;
-	    }
-	  else
-	    {
-	      x = a;
-	      y = a + n3;
-	    }
-	  mpn_sub_n (p + n3, x, y, n2);
-	}
-      p[n] = w;
-
-      n1 = n + 1;
-      if (n2 < KARATSUBA_SQR_THRESHOLD)
-	{
-	  if (n3 < KARATSUBA_SQR_THRESHOLD)
-	    {
-	      mpn_sqr_basecase (ws, p, n3);
-	      mpn_sqr_basecase (p, a, n3);
-	    }
-	  else
-	    {
-	      mpn_kara_sqr_n (ws, p, n3, ws + n1);
-	      mpn_kara_sqr_n (p, a, n3, ws + n1);
-	    }
-	  mpn_sqr_basecase (p + n1, a + n3, n2);
-	}
-      else
-	{
-	  mpn_kara_sqr_n (ws, p, n3, ws + n1);
-	  mpn_kara_sqr_n (p, a, n3, ws + n1);
-	  mpn_kara_sqr_n (p + n1, a + n3, n2, ws + n1);
-	}
-
-      if (sign)
-	mpn_add_n (ws, p, ws, n1);
-      else
-	mpn_sub_n (ws, p, ws, n1);
-
-      nm1 = n - 1;
-      if (mpn_add_n (ws, p + n1, ws, nm1))
-	{
-	  mp_limb_t x = ws[nm1] + 1;
-	  ws[nm1] = x;
-	  if (x == 0)
-	    ++ws[n];
-	}
-      if (mpn_add_n (p + n3, p + n3, ws, n1))
-	{
-	  mp_limb_t x;
-	  i = n1 + n3;
-	  do
-	    {
-	      x = p[i] + 1;
-	      p[i] = x;
-	      ++i;
-	    } while (x == 0);
-	}
-    }
-  else
-    {
-      /* Even length. */
-      mp_limb_t t;
-
-      i = n2;
-      do
-	{
-	  --i;
-	  w0 = a[i];
-	  w1 = a[n2+i];
-	}
-      while (w0 == w1 && i != 0);
-      sign = 0;
-      if (w0 < w1)
-	{
-	  x = a + n2;
-	  y = a;
-	  sign = 1;
-	}
-      else
-	{
-	  x = a;
-	  y = a + n2;
-	}
-      mpn_sub_n (p, x, y, n2);
-
-      i = n2;
-      do 
-	{
-	  --i;
-	  w0 = a[i];
-	  w1 = a[n2+i];
-	}
-      while (w0 == w1 && i != 0);
-      if (w0 < w1)
-	{
-	  x = a + n2;
-	  y = a;
-	  sign ^= 1;
-	}
-      else
-	{
-	  x = a;
-	  y = a + n2;
-	}
-      mpn_sub_n (p + n2, x, y, n2);
-
-      /* Pointwise products. */
-      if (n2 < KARATSUBA_SQR_THRESHOLD)
-	{
-	  mpn_sqr_basecase (ws, p, n2);
-	  mpn_sqr_basecase (p, a, n2);
-	  mpn_sqr_basecase (p + n, a + n2, n2);
-	}
-      else
-	{
-	  mpn_kara_sqr_n (ws, p, n2, ws + n);
-	  mpn_kara_sqr_n (p, a, n2, ws + n);
-	  mpn_kara_sqr_n (p + n, a + n2, n2, ws + n);
-	}
-
-      /* Interpolate. */
-      if (sign)
-	w = mpn_add_n (ws, p, ws, n);
-      else
-	w = -mpn_sub_n (ws, p, ws, n);
-      w += mpn_add_n (ws, p + n, ws, n);
-      w += mpn_add_n (p + n2, p + n2, ws, n);
-      /* TO DO: could put "if (w) { ... }" here.
-       * Less work but badly predicted branch.
-       * No measurable difference in speed on Alpha.
-       */
-      i = n + n2;
-      t = p[i] + w;
-      p[i] = t;
-      if (t < w)
-	{
-	  do
-	    {
-	      ++i;
-	      w = p[i] + 1;
-	      p[i] = w;
-	    }
-	  while (w == 0);
-	}
-    }
-}
-
-/*-- add2Times -------------------------------------------------------------*/
-
-/* z[] = x[] + 2 * y[]
-   Note that z and x might point to the same vectors. */
-#ifdef USE_MORE_MPN
-static inline mp_limb_t
-#if __STDC__
-add2Times (mp_ptr z, mp_srcptr x, mp_srcptr y, mp_size_t n)
-#else
-add2Times (z, x, y, n)
-     mp_ptr    z;
-     mp_srcptr x;
-     mp_srcptr y;
-     mp_size_t n;
-#endif
-{
-  mp_ptr t;
-  mp_limb_t c;
-  TMP_DECL (marker);
-  TMP_MARK (marker);
-  t = (mp_ptr) TMP_ALLOC (n * BYTES_PER_MP_LIMB);
-  c = mpn_lshift (t, y, n, 1);
-  c += mpn_add_n (z, x, t, n);
-  TMP_FREE (marker);
-  return c;
-}
-#else
-
-static mp_limb_t
-#if __STDC__
-add2Times (mp_ptr z, mp_srcptr x, mp_srcptr y, mp_size_t n)
-#else
-add2Times (z, x, y, n)
-     mp_ptr    z;
-     mp_srcptr x;
-     mp_srcptr y;
-     mp_size_t n;
-#endif
-{
-  mp_limb_t c, v, w;
-
-  ASSERT (n > 0);
-  v = *x; w = *y;
-  c = w >> (BITS_PER_MP_LIMB - 1);
-  w <<= 1;
-  v += w;
-  c += v < w;
-  *z = v;
-  ++x; ++y; ++z;
-  while (--n)
-    {
-      v = *x;
-      w = *y;
-      v += c;
-      c = v < c;
-      c += w >> (BITS_PER_MP_LIMB - 1);
-      w <<= 1;
-      v += w;
-      c += v < w;
-      *z = v;
-      ++x; ++y; ++z;
-    }
-
-  return c;
-}
-#endif
-
-/*-- evaluate3 -------------------------------------------------------------*/
-
-/* Evaluates:
- *   ph := 4*A+2*B+C
- *   p1 := A+B+C
- *   p2 := A+2*B+4*C
- * where:
- *   ph[], p1[], p2[], A[] and B[] all have length len,
- *   C[] has length len2 with len-len2 = 0, 1 or 2.
- * Returns top words (overflow) at pth, pt1 and pt2 respectively.
- */
-#ifdef USE_MORE_MPN
-static void
-#if __STDC__
-evaluate3 (mp_ptr ph, mp_ptr p1, mp_ptr p2, mp_ptr pth, mp_ptr pt1, mp_ptr pt2,
-	   mp_srcptr A, mp_srcptr B, mp_srcptr C, mp_size_t len, mp_size_t len2)
-#else
-evaluate3 (ph, p1, p2, pth, pt1, pt2,
-           A, B, C, len, len2)
-     mp_ptr    ph;
-     mp_ptr    p1;
-     mp_ptr    p2;
-     mp_ptr    pth;
-     mp_ptr    pt1;
-     mp_ptr    pt2;
-     mp_srcptr A;
-     mp_srcptr B;
-     mp_srcptr C;
-     mp_size_t len;
-     mp_size_t len2;
-#endif
-{
-  mp_limb_t c, d, e;
-  
-  ASSERT (len - len2 <= 2);
-
-  e = mpn_lshift (p1, B, len, 1);
-
-  c = mpn_lshift (ph, A, len, 2);
-  c += e + mpn_add_n (ph, ph, p1, len);
-  d = mpn_add_n (ph, ph, C, len2);
-  if (len2 == len) c += d; else c += mpn_add_1 (ph + len2, ph + len2, len-len2, d);
-  ASSERT (c < 7);
-  *pth = c;
-
-  c = mpn_lshift (p2, C, len2, 2);
-#if 1
-  if (len2 != len) { p2[len-1] = 0; p2[len2] = c; c = 0; }
-  c += e + mpn_add_n (p2, p2, p1, len);
-#else
-  d = mpn_add_n (p2, p2, p1, len2);
-  c += d;
-  if (len2 != len) c = mpn_add_1 (p2+len2, p1+len2, len-len2, c);
-  c += e;
-#endif
-  c += mpn_add_n (p2, p2, A, len);
-  ASSERT (c < 7);
-  *pt2 = c;
-
-  c = mpn_add_n (p1, A, B, len);
-  d = mpn_add_n (p1, p1, C, len2);
-  if (len2 == len) c += d;
-  else c += mpn_add_1 (p1+len2, p1+len2, len-len2, d);
-  ASSERT (c < 3);
-  *pt1 = c;
-
-}
-
-#else
-
-static void
-#if __STDC__
-evaluate3 (mp_ptr ph, mp_ptr p1, mp_ptr p2, mp_ptr pth, mp_ptr pt1, mp_ptr pt2,
-	   mp_srcptr A, mp_srcptr B, mp_srcptr C, mp_size_t l, mp_size_t ls)
-#else
-evaluate3 (ph, p1, p2, pth, pt1, pt2,
-           A, B, C, l, ls)
-     mp_ptr    ph;
-     mp_ptr    p1;
-     mp_ptr    p2;
-     mp_ptr    pth;
-     mp_ptr    pt1;
-     mp_ptr    pt2;
-     mp_srcptr A;
-     mp_srcptr B;
-     mp_srcptr C;
-     mp_size_t l;
-     mp_size_t ls;
-#endif
-{
-  mp_limb_t a,b,c, i, t, th,t1,t2, vh,v1,v2;
-
-  ASSERT (l - ls <= 2);
-
-  th = t1 = t2 = 0;
-  for (i = 0; i < l; ++i)
-    {
-      a = *A;
-      b = *B;
-      c = i < ls ? *C : 0;
-
-      /* TO DO: choose one of the following alternatives. */
-#if 0
-      t = a << 2;
-      vh = th + t;
-      th = vh < t;
-      th += a >> (BITS_PER_MP_LIMB - 2);
-      t = b << 1;
-      vh += t;
-      th += vh < t;
-      th += b >> (BITS_PER_MP_LIMB - 1);
-      vh += c;
-      th += vh < c;
-#else
-      vh = th + c;
-      th = vh < c;
-      t = b << 1;
-      vh += t;
-      th += vh < t;
-      th += b >> (BITS_PER_MP_LIMB - 1);
-      t = a << 2;
-      vh += t;
-      th += vh < t;
-      th += a >> (BITS_PER_MP_LIMB - 2);
-#endif
-
-      v1 = t1 + a;
-      t1 = v1 < a;
-      v1 += b;
-      t1 += v1 < b;
-      v1 += c;
-      t1 += v1 < c;
-
-      v2 = t2 + a;
-      t2 = v2 < a;
-      t = b << 1;
-      v2 += t;
-      t2 += v2 < t;
-      t2 += b >> (BITS_PER_MP_LIMB - 1);
-      t = c << 2;
-      v2 += t;
-      t2 += v2 < t;
-      t2 += c >> (BITS_PER_MP_LIMB - 2);
-
-      *ph = vh;
-      *p1 = v1;
-      *p2 = v2;
-
-      ++A; ++B; ++C;
-      ++ph; ++p1; ++p2;
-    }
-
-  ASSERT (th < 7);
-  ASSERT (t1 < 3);
-  ASSERT (t2 < 7);
-
-  *pth = th;
-  *pt1 = t1;
-  *pt2 = t2;
-}
-#endif
-
-
-/*-- interpolate3 ----------------------------------------------------------*/
-
-/* Interpolates B, C, D (in-place) from:
- *   16*A+8*B+4*C+2*D+E
- *   A+B+C+D+E
- *   A+2*B+4*C+8*D+16*E
- * where:
- *   A[], B[], C[] and D[] all have length l,
- *   E[] has length ls with l-ls = 0, 2 or 4.
- *
- * Reads top words (from earlier overflow) from ptb, ptc and ptd,
- * and returns new top words there.
- */
-
-#ifdef USE_MORE_MPN
-static void
-#if __STDC__
-interpolate3 (mp_srcptr A, mp_ptr B, mp_ptr C, mp_ptr D, mp_srcptr E,
-              mp_ptr ptb, mp_ptr ptc, mp_ptr ptd, mp_size_t len, mp_size_t len2)
-#else
-interpolate3 (A, B, C, D, E,
-              ptb, ptc, ptd, len, len2)
-     mp_srcptr A;
-     mp_ptr    B;
-     mp_ptr    C;
-     mp_ptr    D;
-     mp_srcptr E;
-     mp_ptr    ptb;
-     mp_ptr    ptc;
-     mp_ptr    ptd;
-     mp_size_t len;
-     mp_size_t len2;
-#endif
-{
-  mp_ptr ws;
-  mp_limb_t t, tb,tc,td;
-  TMP_DECL (marker);
-  TMP_MARK (marker);
-
-  ASSERT (len - len2 == 0 || len - len2 == 2 || len - len2 == 4);
-
-  /* Let x1, x2, x3 be the values to interpolate.  We have:
-   *         b = 16*a + 8*x1 + 4*x2 + 2*x3 +    e
-   *         c =    a +   x1 +   x2 +   x3 +    e
-   *         d =    a + 2*x1 + 4*x2 + 8*x3 + 16*e
-   */
-
-  ws = (mp_ptr) TMP_ALLOC (len * BYTES_PER_MP_LIMB);
-
-  tb = *ptb; tc = *ptc; td = *ptd;
-
-
-  /* b := b - 16*a -    e
-   * c := c -    a -    e
-   * d := d -    a - 16*e
-   */
-
-  t = mpn_lshift (ws, A, len, 4);
-  tb -= t + mpn_sub_n (B, B, ws, len);
-  t = mpn_sub_n (B, B, E, len2);
-  if (len2 == len) tb -= t;
-  else tb -= mpn_sub_1 (B+len2, B+len2, len-len2, t);
-
-  tc -= mpn_sub_n (C, C, A, len);
-  t = mpn_sub_n (C, C, E, len2);
-  if (len2 == len) tc -= t;
-  else tc -= mpn_sub_1 (C+len2, C+len2, len-len2, t);
-
-  t = mpn_lshift (ws, E, len2, 4);
-  t += mpn_add_n (ws, ws, A, len2);
-#if 1
-  if (len2 != len) t = mpn_add_1 (ws+len2, A+len2, len-len2, t);
-  td -= t + mpn_sub_n (D, D, ws, len);
-#else
-  t += mpn_sub_n (D, D, ws, len2);
-  if (len2 != len) {
-    t = mpn_sub_1 (D+len2, D+len2, len-len2, t);
-    t += mpn_sub_n (D+len2, D+len2, A+len2, len-len2);
-  } /* end if/else */
-  td -= t;
-#endif
-
-
-  /* b, d := b + d, b - d */
-
-#ifdef HAVE_MPN_ADD_SUB_N
-  /* #error TO DO ... */
-#else
-  t = tb + td + mpn_add_n (ws, B, D, len);  
-  td = tb - td - mpn_sub_n (D, B, D, len);
-  tb = t;
-  MPN_COPY (B, ws, len);
-#endif
-  
-  /* b := b-8*c */
-  t = 8 * tc + mpn_lshift (ws, C, len, 3);
-  tb -= t + mpn_sub_n (B, B, ws, len);
-
-  /* c := 2*c - b */
-  tc = 2 * tc + mpn_lshift (C, C, len, 1);
-  tc -= tb + mpn_sub_n (C, C, B, len);
-
-  /* d := d/3 */
-  td = (td - mpn_divexact_by3 (D, D, len)) * INVERSE_3;
-
-  /* b, d := b + d, b - d */
-#ifdef HAVE_MPN_ADD_SUB_N
-  /* #error TO DO ... */
-#else
-  t = tb + td + mpn_add_n (ws, B, D, len);  
-  td = tb - td - mpn_sub_n (D, B, D, len);
-  tb = t;
-  MPN_COPY (B, ws, len);
-#endif
-
-      /* Now:
-       *	 b = 4*x1
-       *	 c = 2*x2
-       *	 d = 4*x3
-       */
-
-  ASSERT(!(*B & 3));
-  mpn_rshift (B, B, len, 2);
-  B[len-1] |= tb<<(BITS_PER_MP_LIMB-2);
-  ASSERT((long)tb >= 0);
-  tb >>= 2;
-
-  ASSERT(!(*C & 1));
-  mpn_rshift (C, C, len, 1);
-  C[len-1] |= tc<<(BITS_PER_MP_LIMB-1);
-  ASSERT((long)tc >= 0);
-  tc >>= 1;
-
-  ASSERT(!(*D & 3));
-  mpn_rshift (D, D, len, 2);
-  D[len-1] |= td<<(BITS_PER_MP_LIMB-2);
-  ASSERT((long)td >= 0);
-  td >>= 2;
-
-#if WANT_ASSERT
-  ASSERT (tb < 2);
-  if (len == len2)
-    {
-      ASSERT (tc < 3);
-      ASSERT (td < 2);
-    }
-  else
-    {
-      ASSERT (tc < 2);
-      ASSERT (!td);
-    }
-#endif
-
-  *ptb = tb;
-  *ptc = tc;
-  *ptd = td;
-
-  TMP_FREE (marker);
-}
-
-#else
-
-static void
-#if __STDC__
-interpolate3 (mp_srcptr A, mp_ptr B, mp_ptr C, mp_ptr D, mp_srcptr E,
-	      mp_ptr ptb, mp_ptr ptc, mp_ptr ptd, mp_size_t l, mp_size_t ls)
-#else
-interpolate3 (A, B, C, D, E,
-              ptb, ptc, ptd, l, ls)
-     mp_srcptr A;
-     mp_ptr    B;
-     mp_ptr    C;
-     mp_ptr    D;
-     mp_srcptr E;
-     mp_ptr    ptb;
-     mp_ptr    ptc;
-     mp_ptr    ptd;
-     mp_size_t l;
-     mp_size_t ls;
-#endif
-{
-  mp_limb_t a,b,c,d,e,t, i, sb,sc,sd, ob,oc,od;
-  const mp_limb_t maskOffHalf = (~(mp_limb_t) 0) << (BITS_PER_MP_LIMB >> 1);
-
-#if WANT_ASSERT
-  t = l - ls;
-  ASSERT (t == 0 || t == 2 || t == 4);
-#endif
-
-  sb = sc = sd = 0;
-  for (i = 0; i < l; ++i)
-    {
-      mp_limb_t tb, tc, td, tt;
-
-      a = *A;
-      b = *B;
-      c = *C;
-      d = *D;
-      e = i < ls ? *E : 0;
-
-      /* Let x1, x2, x3 be the values to interpolate.  We have:
-       *	 b = 16*a + 8*x1 + 4*x2 + 2*x3 +    e
-       *	 c =	a +   x1 +   x2 +   x3 +    e
-       *	 d =	a + 2*x1 + 4*x2 + 8*x3 + 16*e
-       */
-
-      /* b := b - 16*a -    e
-       * c := c -    a -    e
-       * d := d -    a - 16*e
-       */
-      t = a << 4;
-      tb = -(a >> (BITS_PER_MP_LIMB - 4)) - (b < t);
-      b -= t;
-      tb -= b < e;
-      b -= e;
-      tc = -(c < a);
-      c -= a;
-      tc -= c < e;
-      c -= e;
-      td = -(d < a);
-      d -= a;
-      t = e << 4;
-      td = td - (e >> (BITS_PER_MP_LIMB - 4)) - (d < t);
-      d -= t;
-
-      /* b, d := b + d, b - d */
-      t = b + d;
-      tt = tb + td + (t < b);
-      td = tb - td - (b < d);
-      d = b - d;
-      b = t;
-      tb = tt;
-
-      /* b := b-8*c */
-      t = c << 3;
-      tb = tb - (tc << 3) - (c >> (BITS_PER_MP_LIMB - 3)) - (b < t);
-      b -= t;
-
-      /* c := 2*c - b */
-      t = c << 1;
-      tc = (tc << 1) + (c >> (BITS_PER_MP_LIMB - 1)) - tb - (t < b);
-      c = t - b;
-
-      /* d := d/3 */
-      d *= INVERSE_3;
-      td = td - (d >> (BITS_PER_MP_LIMB - 1)) - (d*3 < d);
-      td *= INVERSE_3;
-
-      /* b, d := b + d, b - d */
-      t = b + d;
-      tt = tb + td + (t < b);
-      td = tb - td - (b < d);
-      d = b - d;
-      b = t;
-      tb = tt;
-
-      /* Now:
-       *	 b = 4*x1
-       *	 c = 2*x2
-       *	 d = 4*x3
-       */
-
-      /* sb has period 2. */
-      b += sb;
-      tb += b < sb;
-      sb &= maskOffHalf;
-      sb |= sb >> (BITS_PER_MP_LIMB >> 1);
-      sb += tb;
-
-      /* sc has period 1. */
-      c += sc;
-      tc += c < sc;
-      /* TO DO: choose one of the following alternatives. */
-#if 1
-      sc = (mp_limb_t)((long)sc >> (BITS_PER_MP_LIMB - 1));
-      sc += tc;
-#else
-      sc = tc - ((long)sc < 0L);
-#endif
-
-      /* sd has period 2. */
-      d += sd;
-      td += d < sd;
-      sd &= maskOffHalf;
-      sd |= sd >> (BITS_PER_MP_LIMB >> 1);
-      sd += td;
-
-      if (i != 0)
-	{
-	  B[-1] = ob | b << (BITS_PER_MP_LIMB - 2);
-	  C[-1] = oc | c << (BITS_PER_MP_LIMB - 1);
-	  D[-1] = od | d << (BITS_PER_MP_LIMB - 2);
-	}
-      ob = b >> 2;
-      oc = c >> 1;
-      od = d >> 2;
-
-      ++A; ++B; ++C; ++D; ++E;
-    }
-
-  /* Handle top words. */
-  b = *ptb;
-  c = *ptc;
-  d = *ptd;
-
-  t = b + d;
-  d = b - d;
-  b = t;
-  b -= c << 3;
-  c = (c << 1) - b;
-  d *= INVERSE_3;
-  t = b + d;
-  d = b - d;
-  b = t;
-
-  b += sb;
-  c += sc;
-  d += sd;
-
-  B[-1] = ob | b << (BITS_PER_MP_LIMB - 2);
-  C[-1] = oc | c << (BITS_PER_MP_LIMB - 1);
-  D[-1] = od | d << (BITS_PER_MP_LIMB - 2);
-
-  b >>= 2;
-  c >>= 1;
-  d >>= 2;
-
-#if WANT_ASSERT
-  ASSERT (b < 2);
-  if (l == ls)
-    {
-      ASSERT (c < 3);
-      ASSERT (d < 2);
-    }
-  else
-    {
-      ASSERT (c < 2);
-      ASSERT (!d);
-    }
-#endif
-
-  *ptb = b;
-  *ptc = c;
-  *ptd = d;
-}
-#endif
-
-
-/*-- mpn_toom3_mul_n --------------------------------------------------------------*/
-
-/* Multiplies using 5 mults of one third size and so on recursively.
- * p[0..2*n-1] := product of a[0..n-1] and b[0..n-1].
- * No overlap of p[...] with a[...] or b[...].
- * ws is workspace.
- */
-
-/* TO DO: If TOOM3_MUL_THRESHOLD is much bigger than KARATSUBA_MUL_THRESHOLD then the
- *        recursion in mpn_toom3_mul_n() will always bottom out with mpn_kara_mul_n()
- *        because the "n < KARATSUBA_MUL_THRESHOLD" test here will always be false.
- */
-
-#define TOOM3_MUL_REC(p, a, b, n, ws) \
-  do {								\
-    if (n < KARATSUBA_MUL_THRESHOLD)				\
-      mpn_mul_basecase (p, a, n, b, n);				\
-    else if (n < TOOM3_MUL_THRESHOLD)				\
-      mpn_kara_mul_n (p, a, b, n, ws);				\
-    else							\
-      mpn_toom3_mul_n (p, a, b, n, ws);				\
-  } while (0)
-
-void
-#if __STDC__
-mpn_toom3_mul_n (mp_ptr p, mp_srcptr a, mp_srcptr b, mp_size_t n, mp_ptr ws)
-#else
-mpn_toom3_mul_n (p, a, b, n, ws)
-     mp_ptr    p;
-     mp_srcptr a;
-     mp_srcptr b;
-     mp_size_t n;
-     mp_ptr    ws;
-#endif
-{
-  mp_limb_t cB,cC,cD, dB,dC,dD, tB,tC,tD;
-  mp_limb_t *A,*B,*C,*D,*E, *W;
-  mp_size_t l,l2,l3,l4,l5,ls;
-
-  /* Break n words into chunks of size l, l and ls.
-   * n = 3*k   => l = k,   ls = k
-   * n = 3*k+1 => l = k+1, ls = k-1
-   * n = 3*k+2 => l = k+1, ls = k
-   */
-  {
-    mp_limb_t m;
-
-    ASSERT (n >= TOOM3_MUL_THRESHOLD);
-    l = ls = n / 3;
-    m = n - l * 3;
-    if (m != 0)
-      ++l;
-    if (m == 1)
-      --ls;
-
-    l2 = l * 2;
-    l3 = l * 3;
-    l4 = l * 4;
-    l5 = l * 5;
-    A = p;
-    B = ws;
-    C = p + l2;
-    D = ws + l2;
-    E = p + l4;
-    W = ws + l4;
-  }
-
-  /** First stage: evaluation at points 0, 1/2, 1, 2, oo. **/
-  evaluate3 (A, B, C, &cB, &cC, &cD, a, a + l, a + l2, l, ls);
-  evaluate3 (A + l, B + l, C + l, &dB, &dC, &dD, b, b + l, b + l2, l, ls);
-
-  /** Second stage: pointwise multiplies. **/
-  TOOM3_MUL_REC(D, C, C + l, l, W);
-  tD = cD*dD;
-  if (cD) tD += mpn_addmul_1 (D + l, C + l, l, cD);
-  if (dD) tD += mpn_addmul_1 (D + l, C, l, dD);
-  ASSERT (tD < 49);
-  TOOM3_MUL_REC(C, B, B + l, l, W);
-  tC = cC*dC;
-  /* TO DO: choose one of the following alternatives. */
-#if 0
-  if (cC) tC += mpn_addmul_1 (C + l, B + l, l, cC);
-  if (dC) tC += mpn_addmul_1 (C + l, B, l, dC);
-#else
-  if (cC)
-    {
-      if (cC == 1) tC += mpn_add_n (C + l, C + l, B + l, l);
-      else tC += add2Times (C + l, C + l, B + l, l);
-    }
-  if (dC)
-    {
-      if (dC == 1) tC += mpn_add_n (C + l, C + l, B, l);
-      else tC += add2Times (C + l, C + l, B, l);
-    }
-#endif
-  ASSERT (tC < 9);
-  TOOM3_MUL_REC(B, A, A + l, l, W);
-  tB = cB*dB;
-  if (cB) tB += mpn_addmul_1 (B + l, A + l, l, cB);
-  if (dB) tB += mpn_addmul_1 (B + l, A, l, dB);
-  ASSERT (tB < 49);
-  TOOM3_MUL_REC(A, a, b, l, W);
-  TOOM3_MUL_REC(E, a + l2, b + l2, ls, W);
-
-  /** Third stage: interpolation. **/
-  interpolate3 (A, B, C, D, E, &tB, &tC, &tD, l2, ls << 1);
-
-  /** Final stage: add up the coefficients. **/
-  {
-    mp_limb_t i, x, y;
-    tB += mpn_add_n (p + l, p + l, B, l2);
-    tD += mpn_add_n (p + l3, p + l3, D, l2);
-    mpn_incr_u (p + l3, tB);
-    mpn_incr_u (p + l4, tC);
-    mpn_incr_u (p + l5, tD);
-  }
-}
-
-/*-- mpn_toom3_sqr_n --------------------------------------------------------------*/
-
-/* Like previous function but for squaring */
-
-#define TOOM3_SQR_REC(p, a, n, ws) \
-  do {								\
-    if (n < KARATSUBA_SQR_THRESHOLD)				\
-      mpn_sqr_basecase (p, a, n);				\
-    else if (n < TOOM3_SQR_THRESHOLD)				\
-      mpn_kara_sqr_n (p, a, n, ws);				\
-    else							\
-      mpn_toom3_sqr_n (p, a, n, ws);				\
-  } while (0)
-
-void
-#if __STDC__
-mpn_toom3_sqr_n (mp_ptr p, mp_srcptr a, mp_size_t n, mp_ptr ws)
-#else
-mpn_toom3_sqr_n (p, a, n, ws)
-     mp_ptr    p;
-     mp_srcptr a;
-     mp_size_t n;
-     mp_ptr    ws;
-#endif
-{
-  mp_limb_t cB,cC,cD, tB,tC,tD;
-  mp_limb_t *A,*B,*C,*D,*E, *W;
-  mp_size_t l,l2,l3,l4,l5,ls;
-
-  /* Break n words into chunks of size l, l and ls.
-   * n = 3*k   => l = k,   ls = k
-   * n = 3*k+1 => l = k+1, ls = k-1
-   * n = 3*k+2 => l = k+1, ls = k
-   */
-  {
-    mp_limb_t m;
-
-    ASSERT (n >= TOOM3_MUL_THRESHOLD);
-    l = ls = n / 3;
-    m = n - l * 3;
-    if (m != 0)
-      ++l;
-    if (m == 1)
-      --ls;
-
-    l2 = l * 2;
-    l3 = l * 3;
-    l4 = l * 4;
-    l5 = l * 5;
-    A = p;
-    B = ws;
-    C = p + l2;
-    D = ws + l2;
-    E = p + l4;
-    W = ws + l4;
-  }
-
-  /** First stage: evaluation at points 0, 1/2, 1, 2, oo. **/
-  evaluate3 (A, B, C, &cB, &cC, &cD, a, a + l, a + l2, l, ls);
-
-  /** Second stage: pointwise multiplies. **/
-  TOOM3_SQR_REC(D, C, l, W);
-  tD = cD*cD;
-  if (cD) tD += mpn_addmul_1 (D + l, C, l, 2*cD);
-  ASSERT (tD < 49);
-  TOOM3_SQR_REC(C, B, l, W);
-  tC = cC*cC;
-  /* TO DO: choose one of the following alternatives. */
-#if 0
-  if (cC) tC += mpn_addmul_1 (C + l, B, l, 2*cC);
-#else
-  if (cC >= 1)
-    {
-      tC += add2Times (C + l, C + l, B, l);
-      if (cC == 2)
-        tC += add2Times (C + l, C + l, B, l);
-    }
-#endif
-  ASSERT (tC < 9);
-  TOOM3_SQR_REC(B, A, l, W);
-  tB = cB*cB;
-  if (cB) tB += mpn_addmul_1 (B + l, A, l, 2*cB);
-  ASSERT (tB < 49);
-  TOOM3_SQR_REC(A, a, l, W);
-  TOOM3_SQR_REC(E, a + l2, ls, W);
-
-  /** Third stage: interpolation. **/
-  interpolate3 (A, B, C, D, E, &tB, &tC, &tD, l2, ls << 1);
-
-  /** Final stage: add up the coefficients. **/
-  {
-    mp_limb_t i, x, y;
-    tB += mpn_add_n (p + l, p + l, B, l2);
-    tD += mpn_add_n (p + l3, p + l3, D, l2);
-    mpn_incr_u (p + l3, tB);
-    mpn_incr_u (p + l4, tC);
-    mpn_incr_u (p + l5, tD);
-  }
-}
-
-void
-#if __STDC__
-mpn_mul_n (mp_ptr p, mp_srcptr a, mp_srcptr b, mp_size_t n)
-#else
-mpn_mul_n (p, a, b, n)
-     mp_ptr    p;
-     mp_srcptr a;
-     mp_srcptr b;
-     mp_size_t n;
-#endif
-{
-  if (n < KARATSUBA_MUL_THRESHOLD)
-    mpn_mul_basecase (p, a, n, b, n);
-  else if (n < TOOM3_MUL_THRESHOLD)
-    {
-      /* Allocate workspace of fixed size on stack: fast! */
-#if TUNE_PROGRAM_BUILD
-      mp_limb_t ws[2 * (TOOM3_MUL_THRESHOLD_LIMIT-1) + 2 * BITS_PER_MP_LIMB];
-#else
-      mp_limb_t ws[2 * (TOOM3_MUL_THRESHOLD-1) + 2 * BITS_PER_MP_LIMB];
-#endif
-      mpn_kara_mul_n (p, a, b, n, ws);
-    }
-#if WANT_FFT || TUNE_PROGRAM_BUILD
-  else if (n < FFT_MUL_THRESHOLD)
-#else
-  else
-#endif
-    {
-      /* Use workspace of unknown size in heap, as stack space may
-       * be limited.  Since n is at least TOOM3_MUL_THRESHOLD, the
-       * multiplication will take much longer than malloc()/free().  */
-      mp_limb_t wsLen, *ws;
-      wsLen = 2 * n + 3 * BITS_PER_MP_LIMB;
-      ws = (mp_ptr) (*_mp_allocate_func) ((size_t) wsLen * sizeof (mp_limb_t));
-      mpn_toom3_mul_n (p, a, b, n, ws);
-      (*_mp_free_func) (ws, (size_t) wsLen * sizeof (mp_limb_t));
-    }
-#if WANT_FFT || TUNE_PROGRAM_BUILD
-  else
-    {
-      mpn_mul_fft_full (p, a, n, b, n);      
-    }
-#endif
-}
diff --git a/ghc/rts/gmp/mpn/generic/perfsqr.c b/ghc/rts/gmp/mpn/generic/perfsqr.c
deleted file mode 100644
index 42ee3405d7..0000000000
--- a/ghc/rts/gmp/mpn/generic/perfsqr.c
+++ /dev/null
@@ -1,123 +0,0 @@
-/* mpn_perfect_square_p(u,usize) -- Return non-zero if U is a perfect square,
-   zero otherwise.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h> /* for NULL */
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-/* sq_res_0x100[x mod 0x100] == 1 iff x mod 0x100 is a quadratic residue
-   modulo 0x100.  */
-static unsigned char const sq_res_0x100[0x100] =
-{
-  1,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
-  0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
-  1,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
-  0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
-  0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
-  0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
-  0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
-  0,1,0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
-};
-
-int
-#if __STDC__
-mpn_perfect_square_p (mp_srcptr up, mp_size_t usize)
-#else
-mpn_perfect_square_p (up, usize)
-     mp_srcptr up;
-     mp_size_t usize;
-#endif
-{
-  mp_limb_t rem;
-  mp_ptr root_ptr;
-  int res;
-  TMP_DECL (marker);
-
-  /* The first test excludes 55/64 (85.9%) of the perfect square candidates
-     in O(1) time.  */
-  if ((sq_res_0x100[(unsigned int) up[0] % 0x100] & 1) == 0)
-    return 0;
-
-#if defined (PP)
-  /* The second test excludes 30652543/30808063 (99.5%) of the remaining
-     perfect square candidates in O(n) time.  */
-
-  /* Firstly, compute REM = A mod PP.  */
-  if (UDIV_TIME > (2 * UMUL_TIME + 6))
-    rem = mpn_preinv_mod_1 (up, usize, (mp_limb_t) PP, (mp_limb_t) PP_INVERTED);
-  else
-    rem = mpn_mod_1 (up, usize, (mp_limb_t) PP);
-
-  /* Now decide if REM is a quadratic residue modulo the factors in PP.  */
-
-  /* If A is just a few limbs, computing the square root does not take long
-     time, so things might run faster if we limit this loop according to the
-     size of A.  */
-
-#if BITS_PER_MP_LIMB == 64
-  if (((CNST_LIMB(0x12DD703303AED3) >> rem % 53) & 1) == 0)
-    return 0;
-  if (((CNST_LIMB(0x4351B2753DF) >> rem % 47) & 1) == 0)
-    return 0;
-  if (((CNST_LIMB(0x35883A3EE53) >> rem % 43) & 1) == 0)
-    return 0;
-  if (((CNST_LIMB(0x1B382B50737) >> rem % 41) & 1) == 0)
-    return 0;
-  if (((CNST_LIMB(0x165E211E9B) >> rem % 37) & 1) == 0)
-    return 0;
-  if (((CNST_LIMB(0x121D47B7) >> rem % 31) & 1) == 0)
-    return 0;
-#endif
-  if (((0x13D122F3L >> rem % 29) & 1) == 0)
-    return 0;
-  if (((0x5335FL >> rem % 23) & 1) == 0)
-    return 0;
-  if (((0x30AF3L >> rem % 19) & 1) == 0)
-    return 0;
-  if (((0x1A317L >> rem % 17) & 1) == 0)
-    return 0;
-  if (((0x161BL >> rem % 13) & 1) == 0)
-    return 0;
-  if (((0x23BL >> rem % 11) & 1) == 0)
-    return 0;
-  if (((0x017L >> rem % 7) & 1) == 0)
-    return 0;
-  if (((0x13L >> rem % 5) & 1) == 0)
-    return 0;
-  if (((0x3L >> rem % 3) & 1) == 0)
-    return 0;
-#endif
-
-  TMP_MARK (marker);
-
-  /* For the third and last test, we finally compute the square root,
-     to make sure we've really got a perfect square.  */
-  root_ptr = (mp_ptr) TMP_ALLOC ((usize + 1) / 2 * BYTES_PER_MP_LIMB);
-
-  /* Iff mpn_sqrtrem returns zero, the square is perfect.  */
-  res = ! mpn_sqrtrem (root_ptr, NULL, up, usize);
-  TMP_FREE (marker);
-  return res;
-}
diff --git a/ghc/rts/gmp/mpn/generic/popcount.c b/ghc/rts/gmp/mpn/generic/popcount.c
deleted file mode 100644
index 387be9536d..0000000000
--- a/ghc/rts/gmp/mpn/generic/popcount.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/* popcount.c
-
-Copyright (C) 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-#if defined __GNUC__
-/* No processor claiming to be SPARC v9 compliant seem to
-   implement the POPC instruction.  Disable pattern for now.  */
-#if 0 && defined __sparc_v9__ && BITS_PER_MP_LIMB == 64
-#define popc_limb(a) \
-  ({									\
-    DItype __res;							\
-    asm ("popc %1,%0" : "=r" (__res) : "rI" (a));			\
-    __res;								\
-  })
-#endif
-#endif
-
-#ifndef popc_limb
-
-/* Cool population count of a mp_limb_t.
-   You have to figure out how this works, I won't tell you!  */
-
-static inline unsigned int
-#if __STDC__
-popc_limb (mp_limb_t x)
-#else
-popc_limb (x)
-     mp_limb_t x;
-#endif
-{
-#if BITS_PER_MP_LIMB == 64
-  /* We have to go into some trouble to define these constants.
-     (For mp_limb_t being `long long'.)  */
-  mp_limb_t cnst;
-  cnst = 0xaaaaaaaaL | ((mp_limb_t) 0xaaaaaaaaL << BITS_PER_MP_LIMB/2);
-  x -= (x & cnst) >> 1;
-  cnst = 0x33333333L | ((mp_limb_t) 0x33333333L << BITS_PER_MP_LIMB/2);
-  x = ((x & ~cnst) >> 2) + (x & cnst);
-  cnst = 0x0f0f0f0fL | ((mp_limb_t) 0x0f0f0f0fL << BITS_PER_MP_LIMB/2);
-  x = ((x >> 4) + x) & cnst;
-  x = ((x >> 8) + x);
-  x = ((x >> 16) + x);
-  x = ((x >> 32) + x) & 0xff;
-#endif
-#if BITS_PER_MP_LIMB == 32
-  x -= (x & 0xaaaaaaaa) >> 1;
-  x = ((x >> 2) & 0x33333333L) + (x & 0x33333333L);
-  x = ((x >> 4) + x) & 0x0f0f0f0fL;
-  x = ((x >> 8) + x);
-  x = ((x >> 16) + x) & 0xff;
-#endif
-  return x;
-}
-#endif
-
-unsigned long int
-#if __STDC__
-mpn_popcount (register mp_srcptr p, register mp_size_t size)
-#else
-mpn_popcount (p, size)
-     register mp_srcptr p;
-     register mp_size_t size;
-#endif
-{
-  unsigned long int popcnt;
-  mp_size_t i;
-
-  popcnt = 0;
-  for (i = 0; i < size; i++)
-    popcnt += popc_limb (p[i]);
-
-  return popcnt;
-}
diff --git a/ghc/rts/gmp/mpn/generic/pre_mod_1.c b/ghc/rts/gmp/mpn/generic/pre_mod_1.c
deleted file mode 100644
index 27179683b3..0000000000
--- a/ghc/rts/gmp/mpn/generic/pre_mod_1.c
+++ /dev/null
@@ -1,69 +0,0 @@
-/* mpn_preinv_mod_1 (dividend_ptr, dividend_size, divisor_limb,
-		       divisor_limb_inverted) --
-   Divide (DIVIDEND_PTR,,DIVIDEND_SIZE) by the normalized DIVISOR_LIMB.
-   DIVISOR_LIMB_INVERTED should be 2^(2*BITS_PER_MP_LIMB) / DIVISOR_LIMB +
-   - 2^BITS_PER_MP_LIMB.
-   Return the single-limb remainder.
-
-Copyright (C) 1991, 1993, 1994, Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-#ifndef UMUL_TIME
-#define UMUL_TIME 1
-#endif
-
-#ifndef UDIV_TIME
-#define UDIV_TIME UMUL_TIME
-#endif
-
-mp_limb_t
-#if __STDC__
-mpn_preinv_mod_1 (mp_srcptr dividend_ptr, mp_size_t dividend_size,
-		  mp_limb_t divisor_limb, mp_limb_t divisor_limb_inverted)
-#else
-mpn_preinv_mod_1 (dividend_ptr, dividend_size, divisor_limb, divisor_limb_inverted)
-     mp_srcptr dividend_ptr;
-     mp_size_t dividend_size;
-     mp_limb_t divisor_limb;
-     mp_limb_t divisor_limb_inverted;
-#endif
-{
-  mp_size_t i;
-  mp_limb_t n0, r;
-  int dummy;
-
-  i = dividend_size - 1;
-  r = dividend_ptr[i];
-
-  if (r >= divisor_limb)
-    r = 0;
-  else
-    i--;
-
-  for (; i >= 0; i--)
-    {
-      n0 = dividend_ptr[i];
-      udiv_qrnnd_preinv (dummy, r, r, n0, divisor_limb, divisor_limb_inverted);
-    }
-  return r;
-}
diff --git a/ghc/rts/gmp/mpn/generic/random.c b/ghc/rts/gmp/mpn/generic/random.c
deleted file mode 100644
index dea4e20e56..0000000000
--- a/ghc/rts/gmp/mpn/generic/random.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/* mpn_random -- Generate random numbers.
-
-Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "urandom.h"
-
-void
-#if __STDC__
-mpn_random (mp_ptr res_ptr, mp_size_t size)
-#else
-mpn_random (res_ptr, size)
-     mp_ptr res_ptr;
-     mp_size_t size;
-#endif
-{
-  mp_size_t i;
-
-  for (i = 0; i < size; i++)
-    res_ptr[i] = urandom ();
-
-  /* Make sure the most significant limb is non-zero.  */
-  while (res_ptr[size - 1] == 0)
-    res_ptr[size - 1] = urandom ();
-}
diff --git a/ghc/rts/gmp/mpn/generic/random2.c b/ghc/rts/gmp/mpn/generic/random2.c
deleted file mode 100644
index 86682f81fa..0000000000
--- a/ghc/rts/gmp/mpn/generic/random2.c
+++ /dev/null
@@ -1,105 +0,0 @@
-/* mpn_random2 -- Generate random numbers with relatively long strings
-   of ones and zeroes.  Suitable for border testing.
-
-Copyright (C) 1992, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-#if defined (__hpux) || defined (__alpha)  || defined (__svr4__) || defined (__SVR4)
-/* HPUX lacks random().  DEC OSF/1 1.2 random() returns a double.  */
-long mrand48 ();
-static inline long
-random ()
-{
-  return mrand48 ();
-}
-#elif defined(_WIN32) && !(defined(__CYGWIN__) || defined(__CYGWIN32__))
-/* MS CRT supplies just the poxy rand(), with an upper bound of 0x7fff */
-static inline unsigned long
-random ()
-{
-  return rand () ^ (rand () << 16) ^ (rand() << 32);
-}
-
-#else
-long random ();
-#endif
-
-/* It's a bit tricky to get this right, so please test the code well
-   if you hack with it.  Some early versions of the function produced
-   random numbers with the leading limb == 0, and some versions never
-   made the most significant bit set.  */
-
-void
-#if __STDC__
-mpn_random2 (mp_ptr res_ptr, mp_size_t size)
-#else
-mpn_random2 (res_ptr, size)
-     mp_ptr res_ptr;
-     mp_size_t size;
-#endif
-{
-  int n_bits;
-  int bit_pos;
-  mp_size_t limb_pos;
-  unsigned int ran;
-  mp_limb_t limb;
-
-  limb = 0;
-
-  /* Start off in a random bit position in the most significant limb.  */
-  bit_pos = random () & (BITS_PER_MP_LIMB - 1);
-
-  /* Least significant bit of RAN chooses string of ones/string of zeroes.
-     Make most significant limb be non-zero by setting bit 0 of RAN.  */
-  ran = random () | 1;
-
-  for (limb_pos = size - 1; limb_pos >= 0; )
-    {
-      n_bits = (ran >> 1) % BITS_PER_MP_LIMB + 1;
-      if ((ran & 1) != 0)
-	{
-	  /* Generate a string of ones.  */
-	  if (n_bits >= bit_pos)
-	    {
-	      res_ptr[limb_pos--] = limb | ((((mp_limb_t) 2) << bit_pos) - 1);
-	      bit_pos += BITS_PER_MP_LIMB;
-	      limb = (~(mp_limb_t) 0) << (bit_pos - n_bits);
-	    }
-	  else
-	    {
-	      limb |= ((((mp_limb_t) 1) << n_bits) - 1) << (bit_pos - n_bits + 1);
-	    }
-	}
-      else
-	{
-	  /* Generate a string of zeroes.  */
-	  if (n_bits >= bit_pos)
-	    {
-	      res_ptr[limb_pos--] = limb;
-	      limb = 0;
-	      bit_pos += BITS_PER_MP_LIMB;
-	    }
-	}
-      bit_pos -= n_bits;
-      ran = random ();
-    }
-}
diff --git a/ghc/rts/gmp/mpn/generic/rshift.c b/ghc/rts/gmp/mpn/generic/rshift.c
deleted file mode 100644
index 59caf73529..0000000000
--- a/ghc/rts/gmp/mpn/generic/rshift.c
+++ /dev/null
@@ -1,88 +0,0 @@
-/* mpn_rshift -- Shift right a low-level natural-number integer.
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-/* Shift U (pointed to by UP and USIZE limbs long) CNT bits to the right
-   and store the USIZE least significant limbs of the result at WP.
-   The bits shifted out to the right are returned.
-
-   Argument constraints:
-   1. 0 < CNT < BITS_PER_MP_LIMB
-   2. If the result is to be written over the input, WP must be <= UP.
-*/
-
-mp_limb_t
-#if __STDC__
-mpn_rshift (register mp_ptr wp,
-	    register mp_srcptr up, mp_size_t usize,
-	    register unsigned int cnt)
-#else
-mpn_rshift (wp, up, usize, cnt)
-     register mp_ptr wp;
-     register mp_srcptr up;
-     mp_size_t usize;
-     register unsigned int cnt;
-#endif
-{
-  register mp_limb_t high_limb, low_limb;
-  register unsigned sh_1, sh_2;
-  register mp_size_t i;
-  mp_limb_t retval;
-
-#ifdef DEBUG
-  if (usize == 0 || cnt == 0)
-    abort ();
-#endif
-
-  sh_1 = cnt;
-
-#if 0
-  if (sh_1 == 0)
-    {
-      if (wp != up)
-	{
-	  /* Copy from low end to high end, to allow specified input/output
-	     overlapping.  */
-	  for (i = 0; i < usize; i++)
-	    wp[i] = up[i];
-	}
-      return usize;
-    }
-#endif
-
-  wp -= 1;
-  sh_2 = BITS_PER_MP_LIMB - sh_1;
-  high_limb = up[0];
-  retval = high_limb << sh_2;
-  low_limb = high_limb;
-
-  for (i = 1; i < usize; i++)
-    {
-      high_limb = up[i];
-      wp[i] = (low_limb >> sh_1) | (high_limb << sh_2);
-      low_limb = high_limb;
-    }
-  wp[i] = low_limb >> sh_1;
-
-  return retval;
-}
diff --git a/ghc/rts/gmp/mpn/generic/sb_divrem_mn.c b/ghc/rts/gmp/mpn/generic/sb_divrem_mn.c
deleted file mode 100644
index a269e34f5f..0000000000
--- a/ghc/rts/gmp/mpn/generic/sb_divrem_mn.c
+++ /dev/null
@@ -1,201 +0,0 @@
-/* mpn_sb_divrem_mn -- Divide natural numbers, producing both remainder and
-   quotient.
-
-   THE FUNCTIONS IN THIS FILE ARE INTERNAL FUNCTIONS WITH MUTABLE
-   INTERFACES.  IT IS ONLY SAFE TO REACH THEM THROUGH DOCUMENTED INTERFACES.
-   IN FACT, IT IS ALMOST GUARANTEED THAT THEY'LL CHANGE OR DISAPPEAR IN A
-   FUTURE GNU MP RELEASE.
-
-
-Copyright (C) 1993, 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-/* Divide num (NP/NSIZE) by den (DP/DSIZE) and write
-   the NSIZE-DSIZE least significant quotient limbs at QP
-   and the DSIZE long remainder at NP.  If QEXTRA_LIMBS is
-   non-zero, generate that many fraction bits and append them after the
-   other quotient limbs.
-   Return the most significant limb of the quotient, this is always 0 or 1.
-
-   Preconditions:
-   0. NSIZE >= DSIZE.
-   1. The most significant bit of the divisor must be set.
-   2. QP must either not overlap with the input operands at all, or
-      QP + DSIZE >= NP must hold true.  (This means that it's
-      possible to put the quotient in the high part of NUM, right after the
-      remainder in NUM.
-   3. NSIZE >= DSIZE, even if QEXTRA_LIMBS is non-zero.
-   4. DSIZE >= 2.  */
-
-
-#define PREINVERT_VIABLE \
-  (UDIV_TIME > 2 * UMUL_TIME + 6 /* && ! TARGET_REGISTER_STARVED */)
-
-mp_limb_t
-#if __STDC__
-mpn_sb_divrem_mn (mp_ptr qp,
-	       mp_ptr np, mp_size_t nsize,
-	       mp_srcptr dp, mp_size_t dsize)
-#else
-mpn_sb_divrem_mn (qp, np, nsize, dp, dsize)
-     mp_ptr qp;
-     mp_ptr np;
-     mp_size_t nsize;
-     mp_srcptr dp;
-     mp_size_t dsize;
-#endif
-{
-  mp_limb_t most_significant_q_limb = 0;
-  mp_size_t i;
-  mp_limb_t dx, d1, n0;
-  mp_limb_t dxinv;
-  int have_preinv;
-
-  ASSERT_ALWAYS (dsize > 2);
-
-  np += nsize - dsize;
-  dx = dp[dsize - 1];
-  d1 = dp[dsize - 2];
-  n0 = np[dsize - 1];
-
-  if (n0 >= dx)
-    {
-      if (n0 > dx || mpn_cmp (np, dp, dsize - 1) >= 0)
-	{
-	  mpn_sub_n (np, np, dp, dsize);
-	  most_significant_q_limb = 1;
-	}
-    }
-
-  /* If multiplication is much faster than division, preinvert the
-     most significant divisor limb before entering the loop.  */
-  if (PREINVERT_VIABLE)
-    {
-      have_preinv = 0;
-      if ((UDIV_TIME - (2 * UMUL_TIME + 6)) * (nsize - dsize) > UDIV_TIME)
-	{
-	  invert_limb (dxinv, dx);
-	  have_preinv = 1;
-	}
-    }
-
-  for (i = nsize - dsize - 1; i >= 0; i--)
-    {
-      mp_limb_t q;
-      mp_limb_t nx;
-      mp_limb_t cy_limb;
-
-      nx = np[dsize - 1];
-      np--;
-
-      if (nx == dx)
-	{
-	  /* This might over-estimate q, but it's probably not worth
-	     the extra code here to find out.  */
-	  q = ~(mp_limb_t) 0;
-
-#if 1
-	  cy_limb = mpn_submul_1 (np, dp, dsize, q);
-#else
-	  /* This should be faster on many machines */
-	  cy_limb = mpn_sub_n (np + 1, np + 1, dp, dsize);
-	  cy = mpn_add_n (np, np, dp, dsize);
-	  np[dsize] += cy;
-#endif
-
-	  if (nx != cy_limb)
-	    {
-	      mpn_add_n (np, np, dp, dsize);
-	      q--;
-	    }
-
-	  qp[i] = q;
-	}
-      else
-	{
-	  mp_limb_t rx, r1, r0, p1, p0;
-
-          /* "workaround" avoids a problem with gcc 2.7.2.3 i386 register
-             usage when np[dsize-1] is used in an asm statement like
-             umul_ppmm in udiv_qrnnd_preinv.  The symptom is seg faults due
-             to registers being clobbered.  gcc 2.95 i386 doesn't have the
-             problem. */
-          {
-            mp_limb_t  workaround = np[dsize - 1];
-            if (PREINVERT_VIABLE && have_preinv)
-              udiv_qrnnd_preinv (q, r1, nx, workaround, dx, dxinv);
-            else
-              udiv_qrnnd (q, r1, nx, workaround, dx);
-          }
-	  umul_ppmm (p1, p0, d1, q);
-
-	  r0 = np[dsize - 2];
-	  rx = 0;
-	  if (r1 < p1 || (r1 == p1 && r0 < p0))
-	    {
-	      p1 -= p0 < d1;
-	      p0 -= d1;
-	      q--;
-	      r1 += dx;
-	      rx = r1 < dx;
-	    }
-
-	  p1 += r0 < p0;	/* cannot carry! */
-	  rx -= r1 < p1;	/* may become 11..1 if q is still too large */
-	  r1 -= p1;
-	  r0 -= p0;
-
-	  cy_limb = mpn_submul_1 (np, dp, dsize - 2, q);
-
-	  {
-	    mp_limb_t cy1, cy2;
-	    cy1 = r0 < cy_limb;
-	    r0 -= cy_limb;
-	    cy2 = r1 < cy1;
-	    r1 -= cy1;
-	    np[dsize - 1] = r1;
-	    np[dsize - 2] = r0;
-	    if (cy2 != rx)
-	      {
-		mpn_add_n (np, np, dp, dsize);
-		q--;
-	      }
-	  }
-	  qp[i] = q;
-	}
-    }
-
-  /* ______ ______ ______
-    |__rx__|__r1__|__r0__|		partial remainder
-	    ______ ______
-	 - |__p1__|__p0__|		partial product to subtract
-	    ______ ______
-	 - |______|cylimb|		
-
-     rx is -1, 0 or 1.  If rx=1, then q is correct (it should match
-     carry out).  If rx=-1 then q is too large.  If rx=0, then q might
-     be too large, but it is most likely correct.
-  */
-
-  return most_significant_q_limb;
-}
diff --git a/ghc/rts/gmp/mpn/generic/scan0.c b/ghc/rts/gmp/mpn/generic/scan0.c
deleted file mode 100644
index 96f05ce854..0000000000
--- a/ghc/rts/gmp/mpn/generic/scan0.c
+++ /dev/null
@@ -1,62 +0,0 @@
-/* mpn_scan0 -- Scan from a given bit position for the next clear bit.
-
-Copyright (C) 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-/* Design issues:
-   1. What if starting_bit is not within U?  Caller's problem?
-   2. Bit index should be 'unsigned'?
-
-   Argument constraints:
-   1. U must sooner ot later have a limb with a clear bit.
- */
-
-unsigned long int
-#if __STDC__
-mpn_scan0 (register mp_srcptr up,
-	   register unsigned long int starting_bit)
-#else
-mpn_scan0 (up, starting_bit)
-     register mp_srcptr up;
-     register unsigned long int starting_bit;
-#endif
-{
-  mp_size_t starting_word;
-  mp_limb_t alimb;
-  int cnt;
-  mp_srcptr p;
-
-  /* Start at the word implied by STARTING_BIT.  */
-  starting_word = starting_bit / BITS_PER_MP_LIMB;
-  p = up + starting_word;
-  alimb = ~*p++;
-
-  /* Mask off any bits before STARTING_BIT in the first limb.  */
-  alimb &= - (mp_limb_t) 1 << (starting_bit % BITS_PER_MP_LIMB);
-
-  while (alimb == 0)
-    alimb = ~*p++;
-
-  count_leading_zeros (cnt, alimb & -alimb);
-  return (p - up) * BITS_PER_MP_LIMB - 1 - cnt;
-}
diff --git a/ghc/rts/gmp/mpn/generic/scan1.c b/ghc/rts/gmp/mpn/generic/scan1.c
deleted file mode 100644
index 98e2e0dcc0..0000000000
--- a/ghc/rts/gmp/mpn/generic/scan1.c
+++ /dev/null
@@ -1,62 +0,0 @@
-/* mpn_scan1 -- Scan from a given bit position for the next set bit.
-
-Copyright (C) 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-/* Design issues:
-   1. What if starting_bit is not within U?  Caller's problem?
-   2. Bit index should be 'unsigned'?
-
-   Argument constraints:
-   1. U must sooner ot later have a limb != 0.
- */
-
-unsigned long int
-#if __STDC__
-mpn_scan1 (register mp_srcptr up,
-	   register unsigned long int starting_bit)
-#else
-mpn_scan1 (up, starting_bit)
-     register mp_srcptr up;
-     register unsigned long int starting_bit;
-#endif
-{
-  mp_size_t starting_word;
-  mp_limb_t alimb;
-  int cnt;
-  mp_srcptr p;
-
-  /* Start at the word implied by STARTING_BIT.  */
-  starting_word = starting_bit / BITS_PER_MP_LIMB;
-  p = up + starting_word;
-  alimb = *p++;
-
-  /* Mask off any bits before STARTING_BIT in the first limb.  */
-  alimb &= - (mp_limb_t) 1 << (starting_bit % BITS_PER_MP_LIMB);
-
-  while (alimb == 0)
-    alimb = *p++;
-
-  count_leading_zeros (cnt, alimb & -alimb);
-  return (p - up) * BITS_PER_MP_LIMB - 1 - cnt;
-}
diff --git a/ghc/rts/gmp/mpn/generic/set_str.c b/ghc/rts/gmp/mpn/generic/set_str.c
deleted file mode 100644
index e6ccc92154..0000000000
--- a/ghc/rts/gmp/mpn/generic/set_str.c
+++ /dev/null
@@ -1,159 +0,0 @@
-/* mpn_set_str (mp_ptr res_ptr, const char *str, size_t str_len, int base)
-   -- Convert a STR_LEN long base BASE byte string pointed to by STR to a
-   limb vector pointed to by RES_PTR.  Return the number of limbs in
-   RES_PTR.
-
-Copyright (C) 1991, 1992, 1993, 1994, 1996, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-mp_size_t
-#if __STDC__
-mpn_set_str (mp_ptr xp, const unsigned char *str, size_t str_len, int base)
-#else
-mpn_set_str (xp, str, str_len, base)
-     mp_ptr xp;
-     const unsigned char *str;
-     size_t str_len;
-     int base;
-#endif
-{
-  mp_size_t size;
-  mp_limb_t big_base;
-  int indigits_per_limb;
-  mp_limb_t res_digit;
-
-  big_base = __mp_bases[base].big_base;
-  indigits_per_limb = __mp_bases[base].chars_per_limb;
-
-/*   size = str_len / indigits_per_limb + 1;  */
-
-  size = 0;
-
-  if ((base & (base - 1)) == 0)
-    {
-      /* The base is a power of 2.  Read the input string from
-	 least to most significant character/digit.  */
-
-      const unsigned char *s;
-      int next_bitpos;
-      int bits_per_indigit = big_base;
-
-      res_digit = 0;
-      next_bitpos = 0;
-
-      for (s = str + str_len - 1; s >= str; s--)
-	{
-	  int inp_digit = *s;
-
-	  res_digit |= (mp_limb_t) inp_digit << next_bitpos;
-	  next_bitpos += bits_per_indigit;
-	  if (next_bitpos >= BITS_PER_MP_LIMB)
-	    {
-	      xp[size++] = res_digit;
-	      next_bitpos -= BITS_PER_MP_LIMB;
-	      res_digit = inp_digit >> (bits_per_indigit - next_bitpos);
-	    }
-	}
-
-      if (res_digit != 0)
-	xp[size++] = res_digit;
-    }
-  else
-    {
-      /* General case.  The base is not a power of 2.  */
-
-      size_t i;
-      int j;
-      mp_limb_t cy_limb;
-
-      for (i = indigits_per_limb; i < str_len; i += indigits_per_limb)
-	{
-	  res_digit = *str++;
-	  if (base == 10)
-	    { /* This is a common case.
-		 Help the compiler to avoid multiplication.  */
-	      for (j = 1; j < indigits_per_limb; j++)
-		res_digit = res_digit * 10 + *str++;
-	    }
-	  else
-	    {
-	      for (j = 1; j < indigits_per_limb; j++)
-		res_digit = res_digit * base + *str++;
-	    }
-
-	  if (size == 0)
-	    {
-	      if (res_digit != 0)
-		{
-		  xp[0] = res_digit;
-		  size = 1;
-		}
-	    }
-	  else
-	    {
-	      cy_limb = mpn_mul_1 (xp, xp, size, big_base);
-	      cy_limb += mpn_add_1 (xp, xp, size, res_digit);
-	      if (cy_limb != 0)
-		xp[size++] = cy_limb;
-	    }
-	}
-
-      big_base = base;
-      res_digit = *str++;
-      if (base == 10)
-	{ /* This is a common case.
-	     Help the compiler to avoid multiplication.  */
-	  for (j = 1; j < str_len - (i - indigits_per_limb); j++)
-	    {
-	      res_digit = res_digit * 10 + *str++;
-	      big_base *= 10;
-	    }
-	}
-      else
-	{
-	  for (j = 1; j < str_len - (i - indigits_per_limb); j++)
-	    {
-	      res_digit = res_digit * base + *str++;
-	      big_base *= base;
-	    }
-	}
-
-      if (size == 0)
-	{
-	  if (res_digit != 0)
-	    {
-	      xp[0] = res_digit;
-	      size = 1;
-	    }
-	}
-      else
-	{
-	  cy_limb = mpn_mul_1 (xp, xp, size, big_base);
-	  cy_limb += mpn_add_1 (xp, xp, size, res_digit);
-	  if (cy_limb != 0)
-	    xp[size++] = cy_limb;
-	}
-    }
-
-  return size;
-}
diff --git a/ghc/rts/gmp/mpn/generic/sqr_basecase.c b/ghc/rts/gmp/mpn/generic/sqr_basecase.c
deleted file mode 100644
index 760258a3e0..0000000000
--- a/ghc/rts/gmp/mpn/generic/sqr_basecase.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/* mpn_sqr_basecase -- Internal routine to square two natural numbers
-   of length m and n.
-
-   THIS IS AN INTERNAL FUNCTION WITH A MUTABLE INTERFACE.  IT IS ONLY
-   SAFE TO REACH THIS FUNCTION THROUGH DOCUMENTED INTERFACES.
-
-
-Copyright (C) 1991, 1992, 1993, 1994, 1996, 1997, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-void
-#if __STDC__
-mpn_sqr_basecase (mp_ptr prodp, mp_srcptr up, mp_size_t n)
-#else
-mpn_sqr_basecase (prodp, up, n)
-     mp_ptr prodp;
-     mp_srcptr up;
-     mp_size_t n;
-#endif
-{
-  mp_size_t i;
-
-  {
-    /* N.B.!  We need the superfluous indirection through argh to work around
-       a reloader bug in GCC 2.7.*.  */
-    mp_limb_t x;
-    mp_limb_t argh;
-    x = up[0];
-    umul_ppmm (argh, prodp[0], x, x);
-    prodp[1] = argh;
-  }
-  if (n > 1)
-    {
-      mp_limb_t tarr[2 * KARATSUBA_SQR_THRESHOLD];
-      mp_ptr tp = tarr;
-      mp_limb_t cy;
-
-      /* must fit 2*n limbs in tarr */
-      ASSERT (n <= KARATSUBA_SQR_THRESHOLD);
-
-      cy = mpn_mul_1 (tp, up + 1, n - 1, up[0]);
-      tp[n - 1] = cy;
-      for (i = 2; i < n; i++)
-	{
-	  mp_limb_t cy;
-	  cy = mpn_addmul_1 (tp + 2 * i - 2, up + i, n - i, up[i - 1]);
-	  tp[n + i - 2] = cy;
-	}
-      for (i = 1; i < n; i++)
-	{
-	  mp_limb_t x;
-	  x = up[i];
-	  umul_ppmm (prodp[2 * i + 1], prodp[2 * i], x, x);
-	}
-      {
-	mp_limb_t cy;
-	cy = mpn_lshift (tp, tp, 2 * n - 2, 1);
-	cy += mpn_add_n (prodp + 1, prodp + 1, tp, 2 * n - 2);
-	prodp[2 * n - 1] += cy;
-      }
-    }
-}
diff --git a/ghc/rts/gmp/mpn/generic/sqrtrem.c b/ghc/rts/gmp/mpn/generic/sqrtrem.c
deleted file mode 100644
index ee3b5144dd..0000000000
--- a/ghc/rts/gmp/mpn/generic/sqrtrem.c
+++ /dev/null
@@ -1,509 +0,0 @@
-/* mpn_sqrtrem (root_ptr, rem_ptr, op_ptr, op_size)
-
-   Write the square root of {OP_PTR, OP_SIZE} at ROOT_PTR.
-   Write the remainder at REM_PTR, if REM_PTR != NULL.
-   Return the size of the remainder.
-   (The size of the root is always half of the size of the operand.)
-
-   OP_PTR and ROOT_PTR may not point to the same object.
-   OP_PTR and REM_PTR may point to the same object.
-
-   If REM_PTR is NULL, only the root is computed and the return value of
-   the function is 0 if OP is a perfect square, and *any* non-zero number
-   otherwise.
-
-Copyright (C) 1993, 1994, 1996, 1997, 1998, 1999, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/* This code is just correct if "unsigned char" has at least 8 bits.  It
-   doesn't help to use CHAR_BIT from limits.h, as the real problem is
-   the static arrays.  */
-
-#include <stdio.h> /* for NULL */
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-/* Square root algorithm:
-
-   1. Shift OP (the input) to the left an even number of bits s.t. there
-      are an even number of words and either (or both) of the most
-      significant bits are set.  This way, sqrt(OP) has exactly half as
-      many words as OP, and has its most significant bit set.
-
-   2. Get a 9-bit approximation to sqrt(OP) using the pre-computed tables.
-      This approximation is used for the first single-precision
-      iterations of Newton's method, yielding a full-word approximation
-      to sqrt(OP).
-
-   3. Perform multiple-precision Newton iteration until we have the
-      exact result.  Only about half of the input operand is used in
-      this calculation, as the square root is perfectly determinable
-      from just the higher half of a number.  */
-
-/* Define this macro for IEEE P854 machines with a fast sqrt instruction.  */
-#if defined __GNUC__ && ! defined __SOFT_FLOAT
-
-#if defined (__sparc__) && BITS_PER_MP_LIMB == 32
-#define SQRT(a) \
-  ({									\
-    double __sqrt_res;							\
-    asm ("fsqrtd %1,%0" : "=f" (__sqrt_res) : "f" (a));			\
-    __sqrt_res;								\
-  })
-#endif
-
-#if defined (__HAVE_68881__)
-#define SQRT(a) \
-  ({									\
-    double __sqrt_res;							\
-    asm ("fsqrtx %1,%0" : "=f" (__sqrt_res) : "f" (a));			\
-    __sqrt_res;								\
-  })
-#endif
-
-#if defined (__hppa) && BITS_PER_MP_LIMB == 32
-#define SQRT(a) \
-  ({									\
-    double __sqrt_res;							\
-    asm ("fsqrt,dbl %1,%0" : "=fx" (__sqrt_res) : "fx" (a));		\
-    __sqrt_res;								\
-  })
-#endif
-
-#if defined (_ARCH_PWR2) && BITS_PER_MP_LIMB == 32
-#define SQRT(a) \
-  ({									\
-    double __sqrt_res;							\
-    asm ("fsqrt %0,%1" : "=f" (__sqrt_res) : "f" (a));			\
-    __sqrt_res;								\
-  })
-#endif
-
-#if 0
-#if defined (__i386__) || defined (__i486__)
-#define SQRT(a) \
-  ({									\
-    double __sqrt_res;							\
-    asm ("fsqrt" : "=t" (__sqrt_res) : "0" (a));			\
-    __sqrt_res;								\
-  })
-#endif
-#endif
-
-#endif
-
-#ifndef SQRT
-
-/* Tables for initial approximation of the square root.  These are
-   indexed with bits 1-8 of the operand for which the square root is
-   calculated, where bit 0 is the most significant non-zero bit.  I.e.
-   the most significant one-bit is not used, since that per definition
-   is one.  Likewise, the tables don't return the highest bit of the
-   result.  That bit must be inserted by or:ing the returned value with
-   0x100.  This way, we get a 9-bit approximation from 8-bit tables!  */
-
-/* Table to be used for operands with an even total number of bits.
-   (Exactly as in the decimal system there are similarities between the
-   square root of numbers with the same initial digits and an even
-   difference in the total number of digits.  Consider the square root
-   of 1, 10, 100, 1000, ...)  */
-static const unsigned char even_approx_tab[256] =
-{
-  0x6a, 0x6a, 0x6b, 0x6c, 0x6c, 0x6d, 0x6e, 0x6e,
-  0x6f, 0x70, 0x71, 0x71, 0x72, 0x73, 0x73, 0x74,
-  0x75, 0x75, 0x76, 0x77, 0x77, 0x78, 0x79, 0x79,
-  0x7a, 0x7b, 0x7b, 0x7c, 0x7d, 0x7d, 0x7e, 0x7f,
-  0x80, 0x80, 0x81, 0x81, 0x82, 0x83, 0x83, 0x84,
-  0x85, 0x85, 0x86, 0x87, 0x87, 0x88, 0x89, 0x89,
-  0x8a, 0x8b, 0x8b, 0x8c, 0x8d, 0x8d, 0x8e, 0x8f,
-  0x8f, 0x90, 0x90, 0x91, 0x92, 0x92, 0x93, 0x94,
-  0x94, 0x95, 0x96, 0x96, 0x97, 0x97, 0x98, 0x99,
-  0x99, 0x9a, 0x9b, 0x9b, 0x9c, 0x9c, 0x9d, 0x9e,
-  0x9e, 0x9f, 0xa0, 0xa0, 0xa1, 0xa1, 0xa2, 0xa3,
-  0xa3, 0xa4, 0xa4, 0xa5, 0xa6, 0xa6, 0xa7, 0xa7,
-  0xa8, 0xa9, 0xa9, 0xaa, 0xaa, 0xab, 0xac, 0xac,
-  0xad, 0xad, 0xae, 0xaf, 0xaf, 0xb0, 0xb0, 0xb1,
-  0xb2, 0xb2, 0xb3, 0xb3, 0xb4, 0xb5, 0xb5, 0xb6,
-  0xb6, 0xb7, 0xb7, 0xb8, 0xb9, 0xb9, 0xba, 0xba,
-  0xbb, 0xbb, 0xbc, 0xbd, 0xbd, 0xbe, 0xbe, 0xbf,
-  0xc0, 0xc0, 0xc1, 0xc1, 0xc2, 0xc2, 0xc3, 0xc3,
-  0xc4, 0xc5, 0xc5, 0xc6, 0xc6, 0xc7, 0xc7, 0xc8,
-  0xc9, 0xc9, 0xca, 0xca, 0xcb, 0xcb, 0xcc, 0xcc,
-  0xcd, 0xce, 0xce, 0xcf, 0xcf, 0xd0, 0xd0, 0xd1,
-  0xd1, 0xd2, 0xd3, 0xd3, 0xd4, 0xd4, 0xd5, 0xd5,
-  0xd6, 0xd6, 0xd7, 0xd7, 0xd8, 0xd9, 0xd9, 0xda,
-  0xda, 0xdb, 0xdb, 0xdc, 0xdc, 0xdd, 0xdd, 0xde,
-  0xde, 0xdf, 0xe0, 0xe0, 0xe1, 0xe1, 0xe2, 0xe2,
-  0xe3, 0xe3, 0xe4, 0xe4, 0xe5, 0xe5, 0xe6, 0xe6,
-  0xe7, 0xe7, 0xe8, 0xe8, 0xe9, 0xea, 0xea, 0xeb,
-  0xeb, 0xec, 0xec, 0xed, 0xed, 0xee, 0xee, 0xef,
-  0xef, 0xf0, 0xf0, 0xf1, 0xf1, 0xf2, 0xf2, 0xf3,
-  0xf3, 0xf4, 0xf4, 0xf5, 0xf5, 0xf6, 0xf6, 0xf7,
-  0xf7, 0xf8, 0xf8, 0xf9, 0xf9, 0xfa, 0xfa, 0xfb,
-  0xfb, 0xfc, 0xfc, 0xfd, 0xfd, 0xfe, 0xfe, 0xff,
-};
-
-/* Table to be used for operands with an odd total number of bits.
-   (Further comments before previous table.)  */
-static const unsigned char odd_approx_tab[256] =
-{
-  0x00, 0x00, 0x00, 0x01, 0x01, 0x02, 0x02, 0x03,
-  0x03, 0x04, 0x04, 0x05, 0x05, 0x06, 0x06, 0x07,
-  0x07, 0x08, 0x08, 0x09, 0x09, 0x0a, 0x0a, 0x0b,
-  0x0b, 0x0c, 0x0c, 0x0d, 0x0d, 0x0e, 0x0e, 0x0f,
-  0x0f, 0x10, 0x10, 0x10, 0x11, 0x11, 0x12, 0x12,
-  0x13, 0x13, 0x14, 0x14, 0x15, 0x15, 0x16, 0x16,
-  0x16, 0x17, 0x17, 0x18, 0x18, 0x19, 0x19, 0x1a,
-  0x1a, 0x1b, 0x1b, 0x1b, 0x1c, 0x1c, 0x1d, 0x1d,
-  0x1e, 0x1e, 0x1f, 0x1f, 0x20, 0x20, 0x20, 0x21,
-  0x21, 0x22, 0x22, 0x23, 0x23, 0x23, 0x24, 0x24,
-  0x25, 0x25, 0x26, 0x26, 0x27, 0x27, 0x27, 0x28,
-  0x28, 0x29, 0x29, 0x2a, 0x2a, 0x2a, 0x2b, 0x2b,
-  0x2c, 0x2c, 0x2d, 0x2d, 0x2d, 0x2e, 0x2e, 0x2f,
-  0x2f, 0x30, 0x30, 0x30, 0x31, 0x31, 0x32, 0x32,
-  0x32, 0x33, 0x33, 0x34, 0x34, 0x35, 0x35, 0x35,
-  0x36, 0x36, 0x37, 0x37, 0x37, 0x38, 0x38, 0x39,
-  0x39, 0x39, 0x3a, 0x3a, 0x3b, 0x3b, 0x3b, 0x3c,
-  0x3c, 0x3d, 0x3d, 0x3d, 0x3e, 0x3e, 0x3f, 0x3f,
-  0x40, 0x40, 0x40, 0x41, 0x41, 0x41, 0x42, 0x42,
-  0x43, 0x43, 0x43, 0x44, 0x44, 0x45, 0x45, 0x45,
-  0x46, 0x46, 0x47, 0x47, 0x47, 0x48, 0x48, 0x49,
-  0x49, 0x49, 0x4a, 0x4a, 0x4b, 0x4b, 0x4b, 0x4c,
-  0x4c, 0x4c, 0x4d, 0x4d, 0x4e, 0x4e, 0x4e, 0x4f,
-  0x4f, 0x50, 0x50, 0x50, 0x51, 0x51, 0x51, 0x52,
-  0x52, 0x53, 0x53, 0x53, 0x54, 0x54, 0x54, 0x55,
-  0x55, 0x56, 0x56, 0x56, 0x57, 0x57, 0x57, 0x58,
-  0x58, 0x59, 0x59, 0x59, 0x5a, 0x5a, 0x5a, 0x5b,
-  0x5b, 0x5b, 0x5c, 0x5c, 0x5d, 0x5d, 0x5d, 0x5e,
-  0x5e, 0x5e, 0x5f, 0x5f, 0x60, 0x60, 0x60, 0x61,
-  0x61, 0x61, 0x62, 0x62, 0x62, 0x63, 0x63, 0x63,
-  0x64, 0x64, 0x65, 0x65, 0x65, 0x66, 0x66, 0x66,
-  0x67, 0x67, 0x67, 0x68, 0x68, 0x68, 0x69, 0x69,
-};
-#endif
-
-
-mp_size_t
-#if __STDC__
-mpn_sqrtrem (mp_ptr root_ptr, mp_ptr rem_ptr, mp_srcptr op_ptr, mp_size_t op_size)
-#else
-mpn_sqrtrem (root_ptr, rem_ptr, op_ptr, op_size)
-     mp_ptr root_ptr;
-     mp_ptr rem_ptr;
-     mp_srcptr op_ptr;
-     mp_size_t op_size;
-#endif
-{
-  /* R (root result) */
-  mp_ptr rp;			/* Pointer to least significant word */
-  mp_size_t rsize;		/* The size in words */
-
-  /* T (OP shifted to the left a.k.a. normalized) */
-  mp_ptr tp;			/* Pointer to least significant word */
-  mp_size_t tsize;		/* The size in words */
-  mp_ptr t_end_ptr;		/* Pointer right beyond most sign. word */
-  mp_limb_t t_high0, t_high1;	/* The two most significant words */
-
-  /* TT (temporary for numerator/remainder) */
-  mp_ptr ttp;			/* Pointer to least significant word */
-
-  /* X (temporary for quotient in main loop) */
-  mp_ptr xp;			/* Pointer to least significant word */
-  mp_size_t xsize;		/* The size in words */
-
-  unsigned cnt;
-  mp_limb_t initial_approx;	/* Initially made approximation */
-  mp_size_t tsizes[BITS_PER_MP_LIMB];	/* Successive calculation precisions */
-  mp_size_t tmp;
-  mp_size_t i;
-
-  mp_limb_t cy_limb;
-  TMP_DECL (marker);
-
-  /* If OP is zero, both results are zero.  */
-  if (op_size == 0)
-    return 0;
-
-  count_leading_zeros (cnt, op_ptr[op_size - 1]);
-  tsize = op_size;
-  if ((tsize & 1) != 0)
-    {
-      cnt += BITS_PER_MP_LIMB;
-      tsize++;
-    }
-
-  rsize = tsize / 2;
-  rp = root_ptr;
-
-  TMP_MARK (marker);
-
-  /* Shift OP an even number of bits into T, such that either the most or
-     the second most significant bit is set, and such that the number of
-     words in T becomes even.  This way, the number of words in R=sqrt(OP)
-     is exactly half as many as in OP, and the most significant bit of R
-     is set.
-
-     Also, the initial approximation is simplified by this up-shifted OP.
-
-     Finally, the Newtonian iteration which is the main part of this
-     program performs division by R.  The fast division routine expects
-     the divisor to be "normalized" in exactly the sense of having the
-     most significant bit set.  */
-
-  tp = (mp_ptr) TMP_ALLOC (tsize * BYTES_PER_MP_LIMB);
-
-  if ((cnt & ~1) % BITS_PER_MP_LIMB != 0)
-    t_high0 = mpn_lshift (tp + cnt / BITS_PER_MP_LIMB, op_ptr, op_size,
-			  (cnt & ~1) % BITS_PER_MP_LIMB);
-  else
-    MPN_COPY (tp + cnt / BITS_PER_MP_LIMB, op_ptr, op_size);
-
-  if (cnt >= BITS_PER_MP_LIMB)
-    tp[0] = 0;
-
-  t_high0 = tp[tsize - 1];
-  t_high1 = tp[tsize - 2];	/* Never stray.  TSIZE is >= 2.  */
-
-/* Is there a fast sqrt instruction defined for this machine?  */
-#ifdef SQRT
-  {
-    initial_approx = SQRT (t_high0 * MP_BASE_AS_DOUBLE + t_high1);
-    /* If t_high0,,t_high1 is big, the result in INITIAL_APPROX might have
-       become incorrect due to overflow in the conversion from double to
-       mp_limb_t above.  It will typically be zero in that case, but might be
-       a small number on some machines.  The most significant bit of
-       INITIAL_APPROX should be set, so that bit is a good overflow
-       indication.  */
-    if ((mp_limb_signed_t) initial_approx >= 0)
-      initial_approx = ~(mp_limb_t)0;
-  }
-#else
-  /* Get a 9 bit approximation from the tables.  The tables expect to
-     be indexed with the 8 high bits right below the highest bit.
-     Also, the highest result bit is not returned by the tables, and
-     must be or:ed into the result.  The scheme gives 9 bits of start
-     approximation with just 256-entry 8 bit tables.  */
-
-  if ((cnt & 1) == 0)
-    {
-      /* The most significant bit of t_high0 is set.  */
-      initial_approx = t_high0 >> (BITS_PER_MP_LIMB - 8 - 1);
-      initial_approx &= 0xff;
-      initial_approx = even_approx_tab[initial_approx];
-    }
-  else
-    {
-      /* The most significant bit of t_high0 is unset,
-	 the second most significant is set.  */
-      initial_approx = t_high0 >> (BITS_PER_MP_LIMB - 8 - 2);
-      initial_approx &= 0xff;
-      initial_approx = odd_approx_tab[initial_approx];
-    }
-  initial_approx |= 0x100;
-  initial_approx <<= BITS_PER_MP_LIMB - 8 - 1;
-
-  /* Perform small precision Newtonian iterations to get a full word
-     approximation.  For small operands, these iterations will do the
-     entire job.  */
-  if (t_high0 == ~(mp_limb_t)0)
-    initial_approx = t_high0;
-  else
-    {
-      mp_limb_t quot;
-
-      if (t_high0 >= initial_approx)
-	initial_approx = t_high0 + 1;
-
-      /* First get about 18 bits with pure C arithmetics.  */
-      quot = t_high0 / (initial_approx >> BITS_PER_MP_LIMB/2) << BITS_PER_MP_LIMB/2;
-      initial_approx = (initial_approx + quot) / 2;
-      initial_approx |= (mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1);
-
-      /* Now get a full word by one (or for > 36 bit machines) several
-	 iterations.  */
-      for (i = 18; i < BITS_PER_MP_LIMB; i <<= 1)
-	{
-	  mp_limb_t ignored_remainder;
-
-	  udiv_qrnnd (quot, ignored_remainder,
-		      t_high0, t_high1, initial_approx);
-	  initial_approx = (initial_approx + quot) / 2;
-	  initial_approx |= (mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1);
-	}
-    }
-#endif
-
-  rp[0] = initial_approx;
-  rsize = 1;
-
-#ifdef SQRT_DEBUG
-	  printf ("\n\nT = ");
-	  mpn_dump (tp, tsize);
-#endif
-
-  if (tsize > 2)
-    {
-      /* Determine the successive precisions to use in the iteration.  We
-	 minimize the precisions, beginning with the highest (i.e. last
-	 iteration) to the lowest (i.e. first iteration).  */
-
-      xp = (mp_ptr) TMP_ALLOC (tsize * BYTES_PER_MP_LIMB);
-      ttp = (mp_ptr) TMP_ALLOC (tsize * BYTES_PER_MP_LIMB);
-
-      t_end_ptr = tp + tsize;
-
-      tmp = tsize / 2;
-      for (i = 0;; i++)
-	{
-	  tsize = (tmp + 1) / 2;
-	  if (tmp == tsize)
-	    break;
-	  tsizes[i] = tsize + tmp;
-	  tmp = tsize;
-	}
-
-      /* Main Newton iteration loop.  For big arguments, most of the
-	 time is spent here.  */
-
-      /* It is possible to do a great optimization here.  The successive
-	 divisors in the mpn_divmod call below have more and more leading
-	 words equal to its predecessor.  Therefore the beginning of
-	 each division will repeat the same work as did the last
-	 division.  If we could guarantee that the leading words of two
-	 consecutive divisors are the same (i.e. in this case, a later
-	 divisor has just more digits at the end) it would be a simple
-	 matter of just using the old remainder of the last division in
-	 a subsequent division, to take care of this optimization.  This
-	 idea would surely make a difference even for small arguments.  */
-
-      /* Loop invariants:
-
-	 R <= shiftdown_to_same_size(floor(sqrt(OP))) < R + 1.
-	 X - 1 < shiftdown_to_same_size(floor(sqrt(OP))) <= X.
-	 R <= shiftdown_to_same_size(X).  */
-
-      while (--i >= 0)
-	{
-	  mp_limb_t cy;
-#ifdef SQRT_DEBUG
-	  mp_limb_t old_least_sign_r = rp[0];
-	  mp_size_t old_rsize = rsize;
-
-	  printf ("R = ");
-	  mpn_dump (rp, rsize);
-#endif
-	  tsize = tsizes[i];
-
-	  /* Need to copy the numerator into temporary space, as
-	     mpn_divmod overwrites its numerator argument with the
-	     remainder (which we currently ignore).  */
-	  MPN_COPY (ttp, t_end_ptr - tsize, tsize);
-	  cy = mpn_divmod (xp, ttp, tsize, rp, rsize);
-	  xsize = tsize - rsize;
-
-#ifdef SQRT_DEBUG
-	  printf ("X =%d ", cy);
-	  mpn_dump (xp, xsize);
-#endif
-
-	  /* Add X and R with the most significant limbs aligned,
-	     temporarily ignoring at least one limb at the low end of X.  */
-	  tmp = xsize - rsize;
-	  cy += mpn_add_n (xp + tmp, rp, xp + tmp, rsize);
-
-	  /* If T begins with more than 2 x BITS_PER_MP_LIMB of ones, we get
-	     intermediate roots that'd need an extra bit.  We don't want to
-	     handle that since it would make the subsequent divisor
-	     non-normalized, so round such roots down to be only ones in the
-	     current precision.  */
-	  if (cy == 2)
-	    {
-	      mp_size_t j;
-	      for (j = xsize; j >= 0; j--)
-		xp[j] = ~(mp_limb_t)0;
-	    }
-
-	  /* Divide X by 2 and put the result in R.  This is the new
-	     approximation.  Shift in the carry from the addition.  */
-	  mpn_rshift (rp, xp, xsize, 1);
-	  rp[xsize - 1] |= ((mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1));
-	  rsize = xsize;
-#ifdef SQRT_DEBUG
-	  if (old_least_sign_r != rp[rsize - old_rsize])
-	    printf (">>>>>>>> %d: %0*lX, %0*lX <<<<<<<<\n",
-		    i, 2 * BYTES_PER_MP_LIMB, old_least_sign_r,
-		    2 * BYTES_PER_MP_LIMB, rp[rsize - old_rsize]);
-#endif
-	}
-    }
-
-#ifdef SQRT_DEBUG
-  printf ("(final) R = ");
-  mpn_dump (rp, rsize);
-#endif
-
-  /* We computed the square root of OP * 2**(2*floor(cnt/2)).
-     This has resulted in R being 2**floor(cnt/2) to large.
-     Shift it down here to fix that.  */
-  if (cnt / 2 != 0)
-    {
-      mpn_rshift (rp, rp, rsize, cnt/2);
-      rsize -= rp[rsize - 1] == 0;
-    }
-
-  /* Calculate the remainder.  */
-  mpn_mul_n (tp, rp, rp, rsize);
-  tsize = rsize + rsize;
-  tsize -= tp[tsize - 1] == 0;
-  if (op_size < tsize
-      || (op_size == tsize && mpn_cmp (op_ptr, tp, op_size) < 0))
-    {
-      /* R is too large.  Decrement it.  */
-
-      /* These operations can't overflow.  */
-      cy_limb  = mpn_sub_n (tp, tp, rp, rsize);
-      cy_limb += mpn_sub_n (tp, tp, rp, rsize);
-      mpn_decr_u (tp + rsize, cy_limb);
-      mpn_incr_u (tp, (mp_limb_t) 1);
-
-      mpn_decr_u (rp, (mp_limb_t) 1);
-
-#ifdef SQRT_DEBUG
-      printf ("(adjusted) R = ");
-      mpn_dump (rp, rsize);
-#endif
-    }
-
-  if (rem_ptr != NULL)
-    {
-      cy_limb = mpn_sub (rem_ptr, op_ptr, op_size, tp, tsize);
-      MPN_NORMALIZE (rem_ptr, op_size);
-      TMP_FREE (marker);
-      return op_size;
-    }
-  else
-    {
-      int res;
-      res = op_size != tsize || mpn_cmp (op_ptr, tp, op_size);
-      TMP_FREE (marker);
-      return res;
-    }
-}
diff --git a/ghc/rts/gmp/mpn/generic/sub_n.c b/ghc/rts/gmp/mpn/generic/sub_n.c
deleted file mode 100644
index 4f2f06099c..0000000000
--- a/ghc/rts/gmp/mpn/generic/sub_n.c
+++ /dev/null
@@ -1,62 +0,0 @@
-/* mpn_sub_n -- Subtract two limb vectors of equal, non-zero length.
-
-Copyright (C) 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-mp_limb_t
-#if __STDC__
-mpn_sub_n (mp_ptr res_ptr, mp_srcptr s1_ptr, mp_srcptr s2_ptr, mp_size_t size)
-#else
-mpn_sub_n (res_ptr, s1_ptr, s2_ptr, size)
-     register mp_ptr res_ptr;
-     register mp_srcptr s1_ptr;
-     register mp_srcptr s2_ptr;
-     mp_size_t size;
-#endif
-{
-  register mp_limb_t x, y, cy;
-  register mp_size_t j;
-
-  /* The loop counter and index J goes from -SIZE to -1.  This way
-     the loop becomes faster.  */
-  j = -size;
-
-  /* Offset the base pointers to compensate for the negative indices.  */
-  s1_ptr -= j;
-  s2_ptr -= j;
-  res_ptr -= j;
-
-  cy = 0;
-  do
-    {
-      y = s2_ptr[j];
-      x = s1_ptr[j];
-      y += cy;			/* add previous carry to subtrahend */
-      cy = (y < cy);		/* get out carry from that addition */
-      y = x - y;		/* main subtract */
-      cy = (y > x) + cy;	/* get out carry from the subtract, combine */
-      res_ptr[j] = y;
-    }
-  while (++j != 0);
-
-  return cy;
-}
diff --git a/ghc/rts/gmp/mpn/generic/submul_1.c b/ghc/rts/gmp/mpn/generic/submul_1.c
deleted file mode 100644
index c7c08ee4af..0000000000
--- a/ghc/rts/gmp/mpn/generic/submul_1.c
+++ /dev/null
@@ -1,65 +0,0 @@
-/* mpn_submul_1 -- multiply the S1_SIZE long limb vector pointed to by S1_PTR
-   by S2_LIMB, subtract the S1_SIZE least significant limbs of the product
-   from the limb vector pointed to by RES_PTR.  Return the most significant
-   limb of the product, adjusted for carry-out from the subtraction.
-
-Copyright (C) 1992, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-mp_limb_t
-mpn_submul_1 (res_ptr, s1_ptr, s1_size, s2_limb)
-     register mp_ptr res_ptr;
-     register mp_srcptr s1_ptr;
-     mp_size_t s1_size;
-     register mp_limb_t s2_limb;
-{
-  register mp_limb_t cy_limb;
-  register mp_size_t j;
-  register mp_limb_t prod_high, prod_low;
-  register mp_limb_t x;
-
-  /* The loop counter and index J goes from -SIZE to -1.  This way
-     the loop becomes faster.  */
-  j = -s1_size;
-
-  /* Offset the base pointers to compensate for the negative indices.  */
-  res_ptr -= j;
-  s1_ptr -= j;
-
-  cy_limb = 0;
-  do
-    {
-      umul_ppmm (prod_high, prod_low, s1_ptr[j], s2_limb);
-
-      prod_low += cy_limb;
-      cy_limb = (prod_low < cy_limb) + prod_high;
-
-      x = res_ptr[j];
-      prod_low = x - prod_low;
-      cy_limb += (prod_low > x);
-      res_ptr[j] = prod_low;
-    }
-  while (++j != 0);
-
-  return cy_limb;
-}
diff --git a/ghc/rts/gmp/mpn/generic/tdiv_qr.c b/ghc/rts/gmp/mpn/generic/tdiv_qr.c
deleted file mode 100644
index b748b5d810..0000000000
--- a/ghc/rts/gmp/mpn/generic/tdiv_qr.c
+++ /dev/null
@@ -1,401 +0,0 @@
-/* mpn_tdiv_qr -- Divide the numerator (np,nn) by the denominator (dp,dn) and
-   write the nn-dn+1 quotient limbs at qp and the dn remainder limbs at rp.  If
-   qxn is non-zero, generate that many fraction limbs and append them after the
-   other quotient limbs, and update the remainder accordningly.  The input
-   operands are unaffected.
-
-   Preconditions:
-   1. The most significant limb of of the divisor must be non-zero.
-   2. No argument overlap is permitted.  (??? relax this ???)
-   3. nn >= dn, even if qxn is non-zero.  (??? relax this ???)
-
-   The time complexity of this is O(qn*qn+M(dn,qn)), where M(m,n) is the time
-   complexity of multiplication.
-
-Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD (7 * KARATSUBA_MUL_THRESHOLD)
-#endif
-
-/* Extract the middle limb from ((h,,l) << cnt) */
-#define SHL(h,l,cnt) \
-  ((h << cnt) | ((l >> 1) >> ((~cnt) & (BITS_PER_MP_LIMB - 1))))
-
-void
-#if __STDC__
-mpn_tdiv_qr (mp_ptr qp, mp_ptr rp, mp_size_t qxn,
-	     mp_srcptr np, mp_size_t nn, mp_srcptr dp, mp_size_t dn)
-#else
-mpn_tdiv_qr (qp, rp, qxn, np, nn, dp, dn)
-     mp_ptr qp;
-     mp_ptr rp;
-     mp_size_t qxn;
-     mp_srcptr np;
-     mp_size_t nn;
-     mp_srcptr dp;
-     mp_size_t dn;
-#endif
-{
-  /* FIXME:
-     1. qxn
-     2. pass allocated storage in additional parameter?
-  */
-  if (qxn != 0)
-    abort ();
-
-  switch (dn)
-    {
-    case 0:
-      DIVIDE_BY_ZERO;
-
-    case 1:
-      {
-	rp[0] = mpn_divmod_1 (qp, np, nn, dp[0]);
-	return;
-      }
-
-    case 2:
-      {
-	int cnt;
-	mp_ptr n2p, d2p;
-	mp_limb_t qhl, cy;
-	TMP_DECL (marker);
-	TMP_MARK (marker);
-	count_leading_zeros (cnt, dp[dn - 1]);
-	if (cnt != 0)
-	  {
-	    d2p = (mp_ptr) TMP_ALLOC (dn * BYTES_PER_MP_LIMB);
-	    mpn_lshift (d2p, dp, dn, cnt);
-	    n2p = (mp_ptr) TMP_ALLOC ((nn + 1) * BYTES_PER_MP_LIMB);
-	    cy = mpn_lshift (n2p, np, nn, cnt);
-	    n2p[nn] = cy;
-	    qhl = mpn_divrem_2 (qp, 0L, n2p, nn + (cy != 0), d2p);
-	    if (cy == 0)
-	      qp[nn - 2] = qhl;	/* always store nn-dn+1 quotient limbs */
-	  }
-	else
-	  {
-	    d2p = (mp_ptr) dp;
-	    n2p = (mp_ptr) TMP_ALLOC (nn * BYTES_PER_MP_LIMB);
-	    MPN_COPY (n2p, np, nn);
-	    qhl = mpn_divrem_2 (qp, 0L, n2p, nn, d2p);
-	    qp[nn - 2] = qhl;	/* always store nn-dn+1 quotient limbs */
-	  }
-
-	if (cnt != 0)
-	  mpn_rshift (rp, n2p, dn, cnt);
-	else
-	  MPN_COPY (rp, n2p, dn);
-	TMP_FREE (marker);
-	return;
-      }
-
-    default:
-      {
-	int adjust;
-	TMP_DECL (marker);
-	TMP_MARK (marker);
-	adjust = np[nn - 1] >= dp[dn - 1];	/* conservative tests for quotient size */
-	if (nn + adjust >= 2 * dn)
-	  {
-	    mp_ptr n2p, d2p;
-	    mp_limb_t cy;
-	    int cnt;
-	    count_leading_zeros (cnt, dp[dn - 1]);
-
-	    qp[nn - dn] = 0;			/* zero high quotient limb */
-	    if (cnt != 0)			/* normalize divisor if needed */
-	      {
-		d2p = (mp_ptr) TMP_ALLOC (dn * BYTES_PER_MP_LIMB);
-		mpn_lshift (d2p, dp, dn, cnt);
-		n2p = (mp_ptr) TMP_ALLOC ((nn + 1) * BYTES_PER_MP_LIMB);
-		cy = mpn_lshift (n2p, np, nn, cnt);
-		n2p[nn] = cy;
-		nn += adjust;
-	      }
-	    else
-	      {
-		d2p = (mp_ptr) dp;
-		n2p = (mp_ptr) TMP_ALLOC ((nn + 1) * BYTES_PER_MP_LIMB);
-		MPN_COPY (n2p, np, nn);
-		n2p[nn] = 0;
-		nn += adjust;
-	      }
-
-	    if (dn == 2)
-	      mpn_divrem_2 (qp, 0L, n2p, nn, d2p);
-	    else if (dn < BZ_THRESHOLD)
-	      mpn_sb_divrem_mn (qp, n2p, nn, d2p, dn);
-	    else
-	      {
-		/* Perform 2*dn / dn limb divisions as long as the limbs
-		   in np last.  */
-		mp_ptr q2p = qp + nn - 2 * dn;
-		n2p += nn - 2 * dn;
-		mpn_bz_divrem_n (q2p, n2p, d2p, dn);
-		nn -= dn;
-		while (nn >= 2 * dn)
-		  {
-		    mp_limb_t c;
-		    q2p -= dn;  n2p -= dn;
-		    c = mpn_bz_divrem_n (q2p, n2p, d2p, dn);
-		    ASSERT_ALWAYS (c == 0);
-		    nn -= dn;
-		  }
-
-		if (nn != dn)
-		  {
-		    n2p -= nn - dn;
-		    /* In theory, we could fall out to the cute code below
-		       since we now have exactly the situation that code
-		       is designed to handle.  We botch this badly and call
-		       the basic mpn_sb_divrem_mn!  */
-		    if (dn == 2)
-		      mpn_divrem_2 (qp, 0L, n2p, nn, d2p);
-		    else
-		      mpn_sb_divrem_mn (qp, n2p, nn, d2p, dn);
-		  }
-	      }
-
-
-	    if (cnt != 0)
-	      mpn_rshift (rp, n2p, dn, cnt);
-	    else
-	      MPN_COPY (rp, n2p, dn);
-	    TMP_FREE (marker);
-	    return;
-	  }
-
-	/* When we come here, the numerator/partial remainder is less
-	   than twice the size of the denominator.  */
-
-	  {
-	    /* Problem:
-
-	       Divide a numerator N with nn limbs by a denominator D with dn
-	       limbs forming a quotient of nn-dn+1 limbs.  When qn is small
-	       compared to dn, conventional division algorithms perform poorly.
-	       We want an algorithm that has an expected running time that is
-	       dependent only on qn.  It is assumed that the most significant
-	       limb of the numerator is smaller than the most significant limb
-	       of the denominator.
-
-	       Algorithm (very informally stated):
-
-	       1) Divide the 2 x qn most significant limbs from the numerator
-		  by the qn most significant limbs from the denominator.  Call
-		  the result qest.  This is either the correct quotient, but
-		  might be 1 or 2 too large.  Compute the remainder from the
-		  division.  (This step is implemented by a mpn_divrem call.)
-
-	       2) Is the most significant limb from the remainder < p, where p
-		  is the product of the most significant limb from the quotient
-		  and the next(d).  (Next(d) denotes the next ignored limb from
-		  the denominator.)  If it is, decrement qest, and adjust the
-		  remainder accordingly.
-
-	       3) Is the remainder >= qest?  If it is, qest is the desired
-		  quotient.  The algorithm terminates.
-
-	       4) Subtract qest x next(d) from the remainder.  If there is
-		  borrow out, decrement qest, and adjust the remainder
-		  accordingly.
-
-	       5) Skip one word from the denominator (i.e., let next(d) denote
-		  the next less significant limb.  */
-
-	    mp_size_t qn;
-	    mp_ptr n2p, d2p;
-	    mp_ptr tp;
-	    mp_limb_t cy;
-	    mp_size_t in, rn;
-	    mp_limb_t quotient_too_large;
-	    int cnt;
-
-	    qn = nn - dn;
-	    qp[qn] = 0;				/* zero high quotient limb */
-	    qn += adjust;			/* qn cannot become bigger */
-
-	    if (qn == 0)
-	      {
-		MPN_COPY (rp, np, dn);
-		TMP_FREE (marker);
-		return;
-	      }
-
-	    in = dn - qn;		/* (at least partially) ignored # of limbs in ops */
-	    /* Normalize denominator by shifting it to the left such that its
-	       most significant bit is set.  Then shift the numerator the same
-	       amount, to mathematically preserve quotient.  */
-	    count_leading_zeros (cnt, dp[dn - 1]);
-	    if (cnt != 0)
-	      {
-		d2p = (mp_ptr) TMP_ALLOC (qn * BYTES_PER_MP_LIMB);
-
-		mpn_lshift (d2p, dp + in, qn, cnt);
-		d2p[0] |= dp[in - 1] >> (BITS_PER_MP_LIMB - cnt);
-
-		n2p = (mp_ptr) TMP_ALLOC ((2 * qn + 1) * BYTES_PER_MP_LIMB);
-		cy = mpn_lshift (n2p, np + nn - 2 * qn, 2 * qn, cnt);
-		if (adjust)
-		  {
-		    n2p[2 * qn] = cy;
-		    n2p++;
-		  }
-		else
-		  {
-		    n2p[0] |= np[nn - 2 * qn - 1] >> (BITS_PER_MP_LIMB - cnt);
-		  }
-	      }
-	    else
-	      {
-		d2p = (mp_ptr) dp + in;
-
-		n2p = (mp_ptr) TMP_ALLOC ((2 * qn + 1) * BYTES_PER_MP_LIMB);
-		MPN_COPY (n2p, np + nn - 2 * qn, 2 * qn);
-		if (adjust)
-		  {
-		    n2p[2 * qn] = 0;
-		    n2p++;
-		  }
-	      }
-
-	    /* Get an approximate quotient using the extracted operands.  */
-	    if (qn == 1)
-	      {
-		mp_limb_t q0, r0;
-		mp_limb_t gcc272bug_n1, gcc272bug_n0, gcc272bug_d0;
-		/* Due to a gcc 2.7.2.3 reload pass bug, we have to use some
-		   temps here.  This doesn't hurt code quality on any machines
-		   so we do it unconditionally.  */
-		gcc272bug_n1 = n2p[1];
-		gcc272bug_n0 = n2p[0];
-		gcc272bug_d0 = d2p[0];
-		udiv_qrnnd (q0, r0, gcc272bug_n1, gcc272bug_n0, gcc272bug_d0);
-		n2p[0] = r0;
-		qp[0] = q0;
-	      }
-	    else if (qn == 2)
-	      mpn_divrem_2 (qp, 0L, n2p, 4L, d2p);
-	    else if (qn < BZ_THRESHOLD)
-	      mpn_sb_divrem_mn (qp, n2p, qn * 2, d2p, qn);
-	    else
-	      mpn_bz_divrem_n (qp, n2p, d2p, qn);
-
-	    rn = qn;
-	    /* Multiply the first ignored divisor limb by the most significant
-	       quotient limb.  If that product is > the partial remainder's
-	       most significant limb, we know the quotient is too large.  This
-	       test quickly catches most cases where the quotient is too large;
-	       it catches all cases where the quotient is 2 too large.  */
-	    {
-	      mp_limb_t dl, x;
-	      mp_limb_t h, l;
-
-	      if (in - 2 < 0)
-		dl = 0;
-	      else
-		dl = dp[in - 2];
-
-	      x = SHL (dp[in - 1], dl, cnt);
-	      umul_ppmm (h, l, x, qp[qn - 1]);
-
-	      if (n2p[qn - 1] < h)
-		{
-		  mp_limb_t cy;
-
-		  mpn_decr_u (qp, (mp_limb_t) 1);
-		  cy = mpn_add_n (n2p, n2p, d2p, qn);
-		  if (cy)
-		    {
-		      /* The partial remainder is safely large.  */
-		      n2p[qn] = cy;
-		      ++rn;
-		    }
-		}
-	    }
-
-	    quotient_too_large = 0;
-	    if (cnt != 0)
-	      {
-		mp_limb_t cy1, cy2;
-
-		/* Append partially used numerator limb to partial remainder.  */
-		cy1 = mpn_lshift (n2p, n2p, rn, BITS_PER_MP_LIMB - cnt);
-		n2p[0] |= np[in - 1] & (~(mp_limb_t) 0 >> cnt);
-
-		/* Update partial remainder with partially used divisor limb.  */
-		cy2 = mpn_submul_1 (n2p, qp, qn, dp[in - 1] & (~(mp_limb_t) 0 >> cnt));
-		if (qn != rn)
-		  {
-		    if (n2p[qn] < cy2)
-		      abort ();
-		    n2p[qn] -= cy2;
-		  }
-		else
-		  {
-		    n2p[qn] = cy1 - cy2;
-
-		    quotient_too_large = (cy1 < cy2);
-		    ++rn;
-		  }
-		--in;
-	      }
-	    /* True: partial remainder now is neutral, i.e., it is not shifted up.  */
-
-	    tp = (mp_ptr) TMP_ALLOC (dn * BYTES_PER_MP_LIMB);
-
-	    if (in < qn)
-	      {
-		if (in == 0)
-		  {
-		    MPN_COPY (rp, n2p, rn);
-		    if (rn != dn)
-		      abort ();
-		    goto foo;
-		  }
-		mpn_mul (tp, qp, qn, dp, in);
-	      }
-	    else
-	      mpn_mul (tp, dp, in, qp, qn);
-
-	    cy = mpn_sub (n2p, n2p, rn, tp + in, qn);
-	    MPN_COPY (rp + in, n2p, dn - in);
-	    quotient_too_large |= cy;
-	    cy = mpn_sub_n (rp, np, tp, in);
-	    cy = mpn_sub_1 (rp + in, rp + in, rn, cy);
-	    quotient_too_large |= cy;
-	  foo:
-	    if (quotient_too_large)
-	      {
-		mpn_decr_u (qp, (mp_limb_t) 1);
-		mpn_add_n (rp, rp, dp, dn);
-	      }
-	  }
-	TMP_FREE (marker);
-	return;
-      }
-    }
-}
diff --git a/ghc/rts/gmp/mpn/generic/udiv_w_sdiv.c b/ghc/rts/gmp/mpn/generic/udiv_w_sdiv.c
deleted file mode 100644
index 061cce86e1..0000000000
--- a/ghc/rts/gmp/mpn/generic/udiv_w_sdiv.c
+++ /dev/null
@@ -1,131 +0,0 @@
-/* mpn_udiv_w_sdiv -- implement udiv_qrnnd on machines with only signed
-   division.
-
-   Contributed by Peter L. Montgomery.
-
-   THIS IS AN INTERNAL FUNCTION WITH A MUTABLE INTERFACE.  IT IS ONLY SAFE
-   TO REACH THIS FUNCTION THROUGH DOCUMENTED INTERFACES.  IN FACT, IT IS
-   ALMOST GUARANTEED THAT THIS FUNCTION WILL CHANGE OR DISAPPEAR IN A FUTURE
-   GNU MP RELEASE.
-
-
-Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-mp_limb_t
-mpn_udiv_w_sdiv (rp, a1, a0, d)
-     mp_limb_t *rp, a1, a0, d;
-{
-  mp_limb_t q, r;
-  mp_limb_t c0, c1, b1;
-
-  if ((mp_limb_signed_t) d >= 0)
-    {
-      if (a1 < d - a1 - (a0 >> (BITS_PER_MP_LIMB - 1)))
-	{
-	  /* dividend, divisor, and quotient are nonnegative */
-	  sdiv_qrnnd (q, r, a1, a0, d);
-	}
-      else
-	{
-	  /* Compute c1*2^32 + c0 = a1*2^32 + a0 - 2^31*d */
-	  sub_ddmmss (c1, c0, a1, a0, d >> 1, d << (BITS_PER_MP_LIMB - 1));
-	  /* Divide (c1*2^32 + c0) by d */
-	  sdiv_qrnnd (q, r, c1, c0, d);
-	  /* Add 2^31 to quotient */
-	  q += (mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1);
-	}
-    }
-  else
-    {
-      b1 = d >> 1;			/* d/2, between 2^30 and 2^31 - 1 */
-      c1 = a1 >> 1;			/* A/2 */
-      c0 = (a1 << (BITS_PER_MP_LIMB - 1)) + (a0 >> 1);
-
-      if (a1 < b1)			/* A < 2^32*b1, so A/2 < 2^31*b1 */
-	{
-	  sdiv_qrnnd (q, r, c1, c0, b1); /* (A/2) / (d/2) */
-
-	  r = 2*r + (a0 & 1);		/* Remainder from A/(2*b1) */
-	  if ((d & 1) != 0)
-	    {
-	      if (r >= q)
-		r = r - q;
-	      else if (q - r <= d)
-		{
-		  r = r - q + d;
-		  q--;
-		}
-	      else
-		{
-		  r = r - q + 2*d;
-		  q -= 2;
-		}
-	    }
-	}
-      else if (c1 < b1)			/* So 2^31 <= (A/2)/b1 < 2^32 */
-	{
-	  c1 = (b1 - 1) - c1;
-	  c0 = ~c0;			/* logical NOT */
-
-	  sdiv_qrnnd (q, r, c1, c0, b1); /* (A/2) / (d/2) */
-
-	  q = ~q;			/* (A/2)/b1 */
-	  r = (b1 - 1) - r;
-
-	  r = 2*r + (a0 & 1);		/* A/(2*b1) */
-
-	  if ((d & 1) != 0)
-	    {
-	      if (r >= q)
-		r = r - q;
-	      else if (q - r <= d)
-		{
-		  r = r - q + d;
-		  q--;
-		}
-	      else
-		{
-		  r = r - q + 2*d;
-		  q -= 2;
-		}
-	    }
-	}
-      else				/* Implies c1 = b1 */
-	{				/* Hence a1 = d - 1 = 2*b1 - 1 */
-	  if (a0 >= -d)
-	    {
-	      q = -1;
-	      r = a0 + d;
-	    }
-	  else
-	    {
-	      q = -2;
-	      r = a0 + 2*d;
-	    }
-	}
-    }
-
-  *rp = r;
-  return q;
-}
diff --git a/ghc/rts/gmp/mpn/hppa/README b/ghc/rts/gmp/mpn/hppa/README
deleted file mode 100644
index 97e7abe011..0000000000
--- a/ghc/rts/gmp/mpn/hppa/README
+++ /dev/null
@@ -1,91 +0,0 @@
-This directory contains mpn functions for various HP PA-RISC chips.  Code
-that runs faster on the PA7100 and later implementations, is in the pa7100
-directory.
-
-RELEVANT OPTIMIZATION ISSUES
-
-  Load and Store timing
-
-On the PA7000 no memory instructions can issue the two cycles after a store.
-For the PA7100, this is reduced to one cycle.
-
-The PA7100 has a lookup-free cache, so it helps to schedule loads and the
-dependent instruction really far from each other.
-
-STATUS
-
-1. mpn_mul_1 could be improved to 6.5 cycles/limb on the PA7100, using the
-   instructions below (but some sw pipelining is needed to avoid the
-   xmpyu-fstds delay):
-
-	fldds	s1_ptr
-
-	xmpyu
-	fstds	N(%r30)
-	xmpyu
-	fstds	N(%r30)
-
-	ldws	N(%r30)
-	ldws	N(%r30)
-	ldws	N(%r30)
-	ldws	N(%r30)
-
-	addc
-	stws	res_ptr
-	addc
-	stws	res_ptr
-
-	addib	Loop
-
-2. mpn_addmul_1 could be improved from the current 10 to 7.5 cycles/limb
-   (asymptotically) on the PA7100, using the instructions below.  With proper
-   sw pipelining and the unrolling level below, the speed becomes 8
-   cycles/limb.
-
-	fldds	s1_ptr
-	fldds	s1_ptr
-
-	xmpyu
-	fstds	N(%r30)
-	xmpyu
-	fstds	N(%r30)
-	xmpyu
-	fstds	N(%r30)
-	xmpyu
-	fstds	N(%r30)
-
-	ldws	N(%r30)
-	ldws	N(%r30)
-	ldws	N(%r30)
-	ldws	N(%r30)
-	ldws	N(%r30)
-	ldws	N(%r30)
-	ldws	N(%r30)
-	ldws	N(%r30)
-	addc
-	addc
-	addc
-	addc
-	addc	%r0,%r0,cy-limb
-
-	ldws	res_ptr
-	ldws	res_ptr
-	ldws	res_ptr
-	ldws	res_ptr
-	add
-	stws	res_ptr
-	addc
-	stws	res_ptr
-	addc
-	stws	res_ptr
-	addc
-	stws	res_ptr
-
-	addib
-
-3. For the PA8000 we have to stick to using 32-bit limbs before compiler
-   support emerges.  But we want to use 64-bit operations whenever possible,
-   in particular for loads and stores.  It is possible to handle mpn_add_n
-   efficiently by rotating (when s1/s2 are aligned), masking+bit field
-   inserting when (they are not).  The speed should double compared to the
-   code used today.
diff --git a/ghc/rts/gmp/mpn/hppa/add_n.s b/ghc/rts/gmp/mpn/hppa/add_n.s
deleted file mode 100644
index c53b2f71b3..0000000000
--- a/ghc/rts/gmp/mpn/hppa/add_n.s
+++ /dev/null
@@ -1,58 +0,0 @@
-; HP-PA  __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
-; sum in a third limb vector.
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; s2_ptr	gr24
-; size		gr23
-
-; One might want to unroll this as for other processors, but it turns
-; out that the data cache contention after a store makes such
-; unrolling useless.  We can't come under 5 cycles/limb anyway.
-
-	.code
-	.export		__gmpn_add_n
-__gmpn_add_n
-	.proc
-	.callinfo	frame=0,no_calls
-	.entry
-
-	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-
-	addib,=		-1,%r23,L$end	; check for (SIZE == 1)
-	 add		%r20,%r19,%r28	; add first limbs ignoring cy
-
-L$loop	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-	stws,ma		%r28,4(0,%r26)
-	addib,<>	-1,%r23,L$loop
-	 addc		%r20,%r19,%r28
-
-L$end	stws		%r28,0(0,%r26)
-	bv		0(%r2)
-	 addc		%r0,%r0,%r28
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/gmp-mparam.h b/ghc/rts/gmp/mpn/hppa/gmp-mparam.h
deleted file mode 100644
index 98b6d9ce3c..0000000000
--- a/ghc/rts/gmp/mpn/hppa/gmp-mparam.h
+++ /dev/null
@@ -1,63 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 32
-#define BYTES_PER_MP_LIMB 4
-#define BITS_PER_LONGINT 32
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-/* These values are for the PA7100 using GCC.  */
-/* Generated by tuneup.c, 2000-07-25. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD   30
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD      172
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD   59
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD      185
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD              96
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD            122
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            18
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD       46
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD          33
-#endif
diff --git a/ghc/rts/gmp/mpn/hppa/hppa1_1/addmul_1.s b/ghc/rts/gmp/mpn/hppa/hppa1_1/addmul_1.s
deleted file mode 100644
index c7d218f922..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa1_1/addmul_1.s
+++ /dev/null
@@ -1,102 +0,0 @@
-; HP-PA-1.1 __gmpn_addmul_1 -- Multiply a limb vector with a limb and
-; add the result to a second limb vector.
-
-; Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	r26
-; s1_ptr	r25
-; size		r24
-; s2_limb	r23
-
-; This runs at 11 cycles/limb on a PA7000.  With the used instructions, it
-; can not become faster due to data cache contention after a store.  On the
-; PA7100 it runs at 10 cycles/limb, and that can not be improved either,
-; since only the xmpyu does not need the integer pipeline, so the only
-; dual-issue we will get are addc+xmpyu.  Unrolling could gain a cycle/limb
-; on the PA7100.
-
-; There are some ideas described in mul_1.s that applies to this code too.
-
-	.code
-	.export		__gmpn_addmul_1
-__gmpn_addmul_1
-	.proc
-	.callinfo	frame=64,no_calls
-	.entry
-
-	ldo		64(%r30),%r30
-	fldws,ma	4(%r25),%fr5
-	stw		%r23,-16(%r30)		; move s2_limb ...
-	addib,=		-1,%r24,L$just_one_limb
-	 fldws		-16(%r30),%fr4		; ... into fr4
-	add		%r0,%r0,%r0		; clear carry
-	xmpyu		%fr4,%fr5,%fr6
-	fldws,ma	4(%r25),%fr7
-	fstds		%fr6,-16(%r30)
-	xmpyu		%fr4,%fr7,%fr8
-	ldw		-12(%r30),%r19		; least significant limb in product
-	ldw		-16(%r30),%r28
-
-	fstds		%fr8,-16(%r30)
-	addib,=		-1,%r24,L$end
-	 ldw		-12(%r30),%r1
-
-; Main loop
-L$loop	ldws		0(%r26),%r29
-	fldws,ma	4(%r25),%fr5
-	add		%r29,%r19,%r19
-	stws,ma		%r19,4(%r26)
-	addc		%r28,%r1,%r19
-	xmpyu		%fr4,%fr5,%fr6
-	ldw		-16(%r30),%r28
-	fstds		%fr6,-16(%r30)
-	addc		%r0,%r28,%r28
-	addib,<>	-1,%r24,L$loop
-	 ldw		-12(%r30),%r1
-
-L$end	ldw		0(%r26),%r29
-	add		%r29,%r19,%r19
-	stws,ma		%r19,4(%r26)
-	addc		%r28,%r1,%r19
-	ldw		-16(%r30),%r28
-	ldws		0(%r26),%r29
-	addc		%r0,%r28,%r28
-	add		%r29,%r19,%r19
-	stws,ma		%r19,4(%r26)
-	addc		%r0,%r28,%r28
-	bv		0(%r2)
-	 ldo		-64(%r30),%r30
-
-L$just_one_limb
-	xmpyu		%fr4,%fr5,%fr6
-	ldw		0(%r26),%r29
-	fstds		%fr6,-16(%r30)
-	ldw		-12(%r30),%r1
-	ldw		-16(%r30),%r28
-	add		%r29,%r1,%r19
-	stw		%r19,0(%r26)
-	addc		%r0,%r28,%r28
-	bv		0(%r2)
-	 ldo		-64(%r30),%r30
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/hppa1_1/mul_1.s b/ghc/rts/gmp/mpn/hppa/hppa1_1/mul_1.s
deleted file mode 100644
index 4512fddec9..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa1_1/mul_1.s
+++ /dev/null
@@ -1,98 +0,0 @@
-; HP-PA-1.1 __gmpn_mul_1 -- Multiply a limb vector with a limb and store
-; the result in a second limb vector.
-
-; Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	r26
-; s1_ptr	r25
-; size		r24
-; s2_limb	r23
-
-; This runs at 9 cycles/limb on a PA7000.  With the used instructions, it can
-; not become faster due to data cache contention after a store.  On the
-; PA7100 it runs at 7 cycles/limb, and that can not be improved either, since
-; only the xmpyu does not need the integer pipeline, so the only dual-issue
-; we will get are addc+xmpyu.  Unrolling would not help either CPU.
-
-; We could use fldds to read two limbs at a time from the S1 array, and that
-; could bring down the times to 8.5 and 6.5 cycles/limb for the PA7000 and
-; PA7100, respectively.  We don't do that since it does not seem worth the
-; (alignment) troubles...
-
-; At least the PA7100 is rumored to be able to deal with cache-misses
-; without stalling instruction issue.  If this is true, and the cache is
-; actually also lockup-free, we should use a deeper software pipeline, and
-; load from S1 very early!  (The loads and stores to -12(sp) will surely be
-; in the cache.)
-
-	.code
-	.export		__gmpn_mul_1
-__gmpn_mul_1
-	.proc
-	.callinfo	frame=64,no_calls
-	.entry
-
-	ldo		64(%r30),%r30
-	fldws,ma	4(%r25),%fr5
-	stw		%r23,-16(%r30)		; move s2_limb ...
-	addib,=		-1,%r24,L$just_one_limb
-	 fldws		-16(%r30),%fr4		; ... into fr4
-	add		%r0,%r0,%r0		; clear carry
-	xmpyu		%fr4,%fr5,%fr6
-	fldws,ma	4(%r25),%fr7
-	fstds	 	%fr6,-16(%r30)
-	xmpyu		%fr4,%fr7,%fr8
-	ldw		-12(%r30),%r19		; least significant limb in product
-	ldw		-16(%r30),%r28
-
-	fstds		%fr8,-16(%r30)
-	addib,=		-1,%r24,L$end
-	 ldw		-12(%r30),%r1
-
-; Main loop
-L$loop	fldws,ma	4(%r25),%fr5
-	stws,ma		%r19,4(%r26)
-	addc		%r28,%r1,%r19
-	xmpyu		%fr4,%fr5,%fr6
-	ldw		-16(%r30),%r28
-	fstds		%fr6,-16(%r30)
-	addib,<>	-1,%r24,L$loop
-	 ldw		-12(%r30),%r1
-
-L$end	stws,ma		%r19,4(%r26)
-	addc		%r28,%r1,%r19
-	ldw		-16(%r30),%r28
-	stws,ma		%r19,4(%r26)
-	addc		%r0,%r28,%r28
-	bv		0(%r2)
-	 ldo		-64(%r30),%r30
-
-L$just_one_limb
-	xmpyu		%fr4,%fr5,%fr6
-	fstds		%fr6,-16(%r30)
-	ldw		-16(%r30),%r28
-	ldo		-64(%r30),%r30
-	bv		0(%r2)
-	 fstws		%fr6R,0(%r26)
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/add_n.s b/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/add_n.s
deleted file mode 100644
index 4f4be08b37..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/add_n.s
+++ /dev/null
@@ -1,75 +0,0 @@
-; HP-PA  __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
-; sum in a third limb vector.
-; This is optimized for the PA7100, where is runs at 4.25 cycles/limb
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; s2_ptr	gr24
-; size		gr23
-
-	.code
-	.export		__gmpn_add_n
-__gmpn_add_n
-	.proc
-	.callinfo	frame=0,no_calls
-	.entry
-
-	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-
-	addib,<=	-5,%r23,L$rest
-	 add		%r20,%r19,%r28	; add first limbs ignoring cy
-
-L$loop	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-	stws,ma		%r28,4(0,%r26)
-	addc		%r20,%r19,%r28
-	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-	stws,ma		%r28,4(0,%r26)
-	addc		%r20,%r19,%r28
-	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-	stws,ma		%r28,4(0,%r26)
-	addc		%r20,%r19,%r28
-	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-	stws,ma		%r28,4(0,%r26)
-	addib,>		-4,%r23,L$loop
-	addc		%r20,%r19,%r28
-
-L$rest	addib,=		4,%r23,L$end
-	nop
-L$eloop	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-	stws,ma		%r28,4(0,%r26)
-	addib,>		-1,%r23,L$eloop
-	addc		%r20,%r19,%r28
-
-L$end	stws		%r28,0(0,%r26)
-	bv		0(%r2)
-	 addc		%r0,%r0,%r28
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/addmul_1.S b/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/addmul_1.S
deleted file mode 100644
index 04db06822e..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/addmul_1.S
+++ /dev/null
@@ -1,189 +0,0 @@
-; HP-PA 7100/7200 __gmpn_addmul_1 -- Multiply a limb vector with a limb and
-; add the result to a second limb vector.
-
-; Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-; INPUT PARAMETERS
-#define res_ptr	%r26
-#define s1_ptr	%r25
-#define size	%r24
-#define s2_limb	%r23
-
-#define cylimb	%r28
-#define s0	%r19
-#define s1	%r20
-#define s2	%r3
-#define s3	%r4
-#define lo0	%r21
-#define lo1	%r5
-#define lo2	%r6
-#define lo3	%r7
-#define hi0	%r22
-#define hi1	%r23				/* safe to reuse */
-#define hi2	%r29
-#define hi3	%r1
-
-	.code
-	.export		__gmpn_addmul_1
-__gmpn_addmul_1
-	.proc
-	.callinfo	frame=128,no_calls
-	.entry
-
-	ldo	128(%r30),%r30
-	stws	s2_limb,-16(%r30)
-	add	 %r0,%r0,cylimb			; clear cy and cylimb
-	addib,<	-4,size,L$few_limbs
-	fldws	-16(%r30),%fr31R
-
-	ldo	-112(%r30),%r31
-	stw	%r3,-96(%r30)
-	stw	%r4,-92(%r30)
-	stw	%r5,-88(%r30)
-	stw	%r6,-84(%r30)
-	stw	%r7,-80(%r30)
-
-	bb,>=,n	 s1_ptr,29,L$0
-
-	fldws,ma 4(s1_ptr),%fr4
-	ldws	 0(res_ptr),s0
-	xmpyu	 %fr4,%fr31R,%fr5
-	fstds	 %fr5,-16(%r31)
-	ldws	-16(%r31),cylimb
-	ldws	-12(%r31),lo0
-	add	 s0,lo0,s0
-	addib,< -1,size,L$few_limbs
-	stws,ma	 s0,4(res_ptr)
-
-; start software pipeline ----------------------------------------------------
-L$0	fldds,ma 8(s1_ptr),%fr4
-	fldds,ma 8(s1_ptr),%fr8
-
-	xmpyu	 %fr4L,%fr31R,%fr5
-	xmpyu	 %fr4R,%fr31R,%fr6
-	xmpyu	 %fr8L,%fr31R,%fr9
-	xmpyu	 %fr8R,%fr31R,%fr10
-
-	fstds	 %fr5,-16(%r31)
-	fstds	 %fr6,-8(%r31)
-	fstds	 %fr9,0(%r31)
-	fstds	 %fr10,8(%r31)
-
-	ldws   -16(%r31),hi0
-	ldws   -12(%r31),lo0
-	ldws	-8(%r31),hi1
-	ldws	-4(%r31),lo1
-	ldws	 0(%r31),hi2
-	ldws	 4(%r31),lo2
-	ldws	 8(%r31),hi3
-	ldws	12(%r31),lo3
-
-	addc	 lo0,cylimb,lo0
-	addc	 lo1,hi0,lo1
-	addc	 lo2,hi1,lo2
-	addc	 lo3,hi2,lo3
-
-	addib,<	 -4,size,L$end
-	addc	 %r0,hi3,cylimb			; propagate carry into cylimb
-; main loop ------------------------------------------------------------------
-L$loop	fldds,ma 8(s1_ptr),%fr4
-	fldds,ma 8(s1_ptr),%fr8
-
-	ldws	 0(res_ptr),s0
-	xmpyu	 %fr4L,%fr31R,%fr5
-	ldws	 4(res_ptr),s1
-	xmpyu	 %fr4R,%fr31R,%fr6
-	ldws	 8(res_ptr),s2
-	xmpyu	 %fr8L,%fr31R,%fr9
-	ldws	12(res_ptr),s3
-	xmpyu	 %fr8R,%fr31R,%fr10
-
-	fstds	 %fr5,-16(%r31)
-	add	 s0,lo0,s0
-	fstds	 %fr6,-8(%r31)
-	addc	 s1,lo1,s1
-	fstds	 %fr9,0(%r31)
-	addc	 s2,lo2,s2
-	fstds	 %fr10,8(%r31)
-	addc	 s3,lo3,s3
-
-	ldws   -16(%r31),hi0
-	ldws   -12(%r31),lo0
-	ldws	-8(%r31),hi1
-	ldws	-4(%r31),lo1
-	ldws	 0(%r31),hi2
-	ldws	 4(%r31),lo2
-	ldws	 8(%r31),hi3
-	ldws	12(%r31),lo3
-
-	addc	 lo0,cylimb,lo0
-	stws,ma	 s0,4(res_ptr)
-	addc	 lo1,hi0,lo1
-	stws,ma	 s1,4(res_ptr)
-	addc	 lo2,hi1,lo2
-	stws,ma	 s2,4(res_ptr)
-	addc	 lo3,hi2,lo3
-	stws,ma	 s3,4(res_ptr)
-
-	addib,>= -4,size,L$loop
-	addc	 %r0,hi3,cylimb			; propagate carry into cylimb
-; finish software pipeline ---------------------------------------------------
-L$end	ldws	 0(res_ptr),s0
-	ldws	 4(res_ptr),s1
-	ldws	 8(res_ptr),s2
-	ldws	12(res_ptr),s3
-
-	add	 s0,lo0,s0
-	stws,ma	 s0,4(res_ptr)
-	addc	 s1,lo1,s1
-	stws,ma	 s1,4(res_ptr)
-	addc	 s2,lo2,s2
-	stws,ma	 s2,4(res_ptr)
-	addc	 s3,lo3,s3
-	stws,ma	 s3,4(res_ptr)
-
-; restore callee-saves registers ---------------------------------------------
-	ldw	-96(%r30),%r3
-	ldw	-92(%r30),%r4
-	ldw	-88(%r30),%r5
-	ldw	-84(%r30),%r6
-	ldw	-80(%r30),%r7
-
-L$few_limbs
-	addib,=,n 4,size,L$ret
-L$loop2	fldws,ma 4(s1_ptr),%fr4
-	ldws	 0(res_ptr),s0
-	xmpyu	 %fr4,%fr31R,%fr5
-	fstds	 %fr5,-16(%r30)
-	ldws	-16(%r30),hi0
-	ldws	-12(%r30),lo0
-	addc	 lo0,cylimb,lo0
-	addc	 %r0,hi0,cylimb
-	add	 s0,lo0,s0
-	stws,ma	 s0,4(res_ptr)
-	addib,<> -1,size,L$loop2
-	nop
-
-L$ret	addc	 %r0,cylimb,cylimb
-	bv	 0(%r2)
-	ldo	 -128(%r30),%r30
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/lshift.s b/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/lshift.s
deleted file mode 100644
index 31669b1a55..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/lshift.s
+++ /dev/null
@@ -1,83 +0,0 @@
-; HP-PA  __gmpn_lshift --
-; This is optimized for the PA7100, where is runs at 3.25 cycles/limb
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s_ptr		gr25
-; size		gr24
-; cnt		gr23
-
-	.code
-	.export		__gmpn_lshift
-__gmpn_lshift
-	.proc
-	.callinfo	frame=64,no_calls
-	.entry
-
-	sh2add		%r24,%r25,%r25
-	sh2add		%r24,%r26,%r26
-	ldws,mb		-4(0,%r25),%r22
-	subi		32,%r23,%r1
-	mtsar		%r1
-	addib,=		-1,%r24,L$0004
-	vshd		%r0,%r22,%r28		; compute carry out limb
-	ldws,mb		-4(0,%r25),%r29
-	addib,<=	-5,%r24,L$rest
-	vshd		%r22,%r29,%r20
-
-L$loop	ldws,mb		-4(0,%r25),%r22
-	stws,mb		%r20,-4(0,%r26)
-	vshd		%r29,%r22,%r20
-	ldws,mb		-4(0,%r25),%r29
-	stws,mb		%r20,-4(0,%r26)
-	vshd		%r22,%r29,%r20
-	ldws,mb		-4(0,%r25),%r22
-	stws,mb		%r20,-4(0,%r26)
-	vshd		%r29,%r22,%r20
-	ldws,mb		-4(0,%r25),%r29
-	stws,mb		%r20,-4(0,%r26)
-	addib,>		-4,%r24,L$loop
-	vshd		%r22,%r29,%r20
-
-L$rest	addib,=		4,%r24,L$end1
-	nop
-L$eloop	ldws,mb		-4(0,%r25),%r22
-	stws,mb		%r20,-4(0,%r26)
-	addib,<=	-1,%r24,L$end2
-	vshd		%r29,%r22,%r20
-	ldws,mb		-4(0,%r25),%r29
-	stws,mb		%r20,-4(0,%r26)
-	addib,>		-1,%r24,L$eloop
-	vshd		%r22,%r29,%r20
-
-L$end1	stws,mb		%r20,-4(0,%r26)
-	vshd		%r29,%r0,%r20
-	bv		0(%r2)
-	stw		%r20,-4(0,%r26)
-L$end2	stws,mb		%r20,-4(0,%r26)
-L$0004	vshd		%r22,%r0,%r20
-	bv		0(%r2)
-	stw		%r20,-4(0,%r26)
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/rshift.s b/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/rshift.s
deleted file mode 100644
index d32b10b4b1..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/rshift.s
+++ /dev/null
@@ -1,80 +0,0 @@
-; HP-PA  __gmpn_rshift --
-; This is optimized for the PA7100, where is runs at 3.25 cycles/limb
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s_ptr		gr25
-; size		gr24
-; cnt		gr23
-
-	.code
-	.export		__gmpn_rshift
-__gmpn_rshift
-	.proc
-	.callinfo	frame=64,no_calls
-	.entry
-
-	ldws,ma		4(0,%r25),%r22
-	mtsar		%r23
-	addib,=		-1,%r24,L$0004
-	vshd		%r22,%r0,%r28		; compute carry out limb
-	ldws,ma		4(0,%r25),%r29
-	addib,<=	-5,%r24,L$rest
-	vshd		%r29,%r22,%r20
-
-L$loop	ldws,ma		4(0,%r25),%r22
-	stws,ma		%r20,4(0,%r26)
-	vshd		%r22,%r29,%r20
-	ldws,ma		4(0,%r25),%r29
-	stws,ma		%r20,4(0,%r26)
-	vshd		%r29,%r22,%r20
-	ldws,ma		4(0,%r25),%r22
-	stws,ma		%r20,4(0,%r26)
-	vshd		%r22,%r29,%r20
-	ldws,ma		4(0,%r25),%r29
-	stws,ma		%r20,4(0,%r26)
-	addib,>		-4,%r24,L$loop
-	vshd		%r29,%r22,%r20
-
-L$rest	addib,=		4,%r24,L$end1
-	nop
-L$eloop	ldws,ma		4(0,%r25),%r22
-	stws,ma		%r20,4(0,%r26)
-	addib,<=	-1,%r24,L$end2
-	vshd		%r22,%r29,%r20
-	ldws,ma		4(0,%r25),%r29
-	stws,ma		%r20,4(0,%r26)
-	addib,>		-1,%r24,L$eloop
-	vshd		%r29,%r22,%r20
-
-L$end1	stws,ma		%r20,4(0,%r26)
-	vshd		%r0,%r29,%r20
-	bv		0(%r2)
-	stw		%r20,0(0,%r26)
-L$end2	stws,ma		%r20,4(0,%r26)
-L$0004	vshd		%r0,%r22,%r20
-	bv		0(%r2)
-	stw		%r20,0(0,%r26)
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/sub_n.s b/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/sub_n.s
deleted file mode 100644
index 0eec41c4b3..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/sub_n.s
+++ /dev/null
@@ -1,76 +0,0 @@
-; HP-PA  __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
-; store difference in a third limb vector.
-; This is optimized for the PA7100, where is runs at 4.25 cycles/limb
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; s2_ptr	gr24
-; size		gr23
-
-	.code
-	.export		__gmpn_sub_n
-__gmpn_sub_n
-	.proc
-	.callinfo	frame=0,no_calls
-	.entry
-
-	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-
-	addib,<=	-5,%r23,L$rest
-	 sub		%r20,%r19,%r28	; subtract first limbs ignoring cy
-
-L$loop	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-	stws,ma		%r28,4(0,%r26)
-	subb		%r20,%r19,%r28
-	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-	stws,ma		%r28,4(0,%r26)
-	subb		%r20,%r19,%r28
-	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-	stws,ma		%r28,4(0,%r26)
-	subb		%r20,%r19,%r28
-	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-	stws,ma		%r28,4(0,%r26)
-	addib,>		-4,%r23,L$loop
-	subb		%r20,%r19,%r28
-
-L$rest	addib,=		4,%r23,L$end
-	nop
-L$eloop	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-	stws,ma		%r28,4(0,%r26)
-	addib,>		-1,%r23,L$eloop
-	subb		%r20,%r19,%r28
-
-L$end	stws		%r28,0(0,%r26)
-	addc		%r0,%r0,%r28
-	bv		0(%r2)
-	 subi		1,%r28,%r28
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/submul_1.S b/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/submul_1.S
deleted file mode 100644
index 0fba21dcef..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa1_1/pa7100/submul_1.S
+++ /dev/null
@@ -1,195 +0,0 @@
-; HP-PA 7100/7200 __gmpn_submul_1 -- Multiply a limb vector with a limb and
-; subtract the result from a second limb vector.
-
-; Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-; INPUT PARAMETERS
-#define res_ptr	%r26
-#define s1_ptr	%r25
-#define size	%r24
-#define s2_limb	%r23
-
-#define cylimb	%r28
-#define s0	%r19
-#define s1	%r20
-#define s2	%r3
-#define s3	%r4
-#define lo0	%r21
-#define lo1	%r5
-#define lo2	%r6
-#define lo3	%r7
-#define hi0	%r22
-#define hi1	%r23				/* safe to reuse */
-#define hi2	%r29
-#define hi3	%r1
-
-	.code
-	.export		__gmpn_submul_1
-__gmpn_submul_1
-	.proc
-	.callinfo	frame=128,no_calls
-	.entry
-
-	ldo	128(%r30),%r30
-	stws	s2_limb,-16(%r30)
-	add	 %r0,%r0,cylimb			; clear cy and cylimb
-	addib,<	-4,size,L$few_limbs
-	fldws	-16(%r30),%fr31R
-
-	ldo	-112(%r30),%r31
-	stw	%r3,-96(%r30)
-	stw	%r4,-92(%r30)
-	stw	%r5,-88(%r30)
-	stw	%r6,-84(%r30)
-	stw	%r7,-80(%r30)
-
-	bb,>=,n	 s1_ptr,29,L$0
-
-	fldws,ma 4(s1_ptr),%fr4
-	ldws	 0(res_ptr),s0
-	xmpyu	 %fr4,%fr31R,%fr5
-	fstds	 %fr5,-16(%r31)
-	ldws	-16(%r31),cylimb
-	ldws	-12(%r31),lo0
-	sub	 s0,lo0,s0
-	add	 s0,lo0,%r0			; invert cy
-	addib,< -1,size,L$few_limbs
-	stws,ma	 s0,4(res_ptr)
-
-; start software pipeline ----------------------------------------------------
-L$0	fldds,ma 8(s1_ptr),%fr4
-	fldds,ma 8(s1_ptr),%fr8
-
-	xmpyu	 %fr4L,%fr31R,%fr5
-	xmpyu	 %fr4R,%fr31R,%fr6
-	xmpyu	 %fr8L,%fr31R,%fr9
-	xmpyu	 %fr8R,%fr31R,%fr10
-
-	fstds	 %fr5,-16(%r31)
-	fstds	 %fr6,-8(%r31)
-	fstds	 %fr9,0(%r31)
-	fstds	 %fr10,8(%r31)
-
-	ldws   -16(%r31),hi0
-	ldws   -12(%r31),lo0
-	ldws	-8(%r31),hi1
-	ldws	-4(%r31),lo1
-	ldws	 0(%r31),hi2
-	ldws	 4(%r31),lo2
-	ldws	 8(%r31),hi3
-	ldws	12(%r31),lo3
-
-	addc	 lo0,cylimb,lo0
-	addc	 lo1,hi0,lo1
-	addc	 lo2,hi1,lo2
-	addc	 lo3,hi2,lo3
-
-	addib,<	 -4,size,L$end
-	addc	 %r0,hi3,cylimb			; propagate carry into cylimb
-; main loop ------------------------------------------------------------------
-L$loop	fldds,ma 8(s1_ptr),%fr4
-	fldds,ma 8(s1_ptr),%fr8
-
-	ldws	 0(res_ptr),s0
-	xmpyu	 %fr4L,%fr31R,%fr5
-	ldws	 4(res_ptr),s1
-	xmpyu	 %fr4R,%fr31R,%fr6
-	ldws	 8(res_ptr),s2
-	xmpyu	 %fr8L,%fr31R,%fr9
-	ldws	12(res_ptr),s3
-	xmpyu	 %fr8R,%fr31R,%fr10
-
-	fstds	 %fr5,-16(%r31)
-	sub	 s0,lo0,s0
-	fstds	 %fr6,-8(%r31)
-	subb	 s1,lo1,s1
-	fstds	 %fr9,0(%r31)
-	subb	 s2,lo2,s2
-	fstds	 %fr10,8(%r31)
-	subb	 s3,lo3,s3
-	subb	 %r0,%r0,lo0			; these two insns ...
-	add	 lo0,lo0,%r0			; ... just invert cy
-
-	ldws   -16(%r31),hi0
-	ldws   -12(%r31),lo0
-	ldws	-8(%r31),hi1
-	ldws	-4(%r31),lo1
-	ldws	 0(%r31),hi2
-	ldws	 4(%r31),lo2
-	ldws	 8(%r31),hi3
-	ldws	12(%r31),lo3
-
-	addc	 lo0,cylimb,lo0
-	stws,ma	 s0,4(res_ptr)
-	addc	 lo1,hi0,lo1
-	stws,ma	 s1,4(res_ptr)
-	addc	 lo2,hi1,lo2
-	stws,ma	 s2,4(res_ptr)
-	addc	 lo3,hi2,lo3
-	stws,ma	 s3,4(res_ptr)
-
-	addib,>= -4,size,L$loop
-	addc	 %r0,hi3,cylimb			; propagate carry into cylimb
-; finish software pipeline ---------------------------------------------------
-L$end	ldws	 0(res_ptr),s0
-	ldws	 4(res_ptr),s1
-	ldws	 8(res_ptr),s2
-	ldws	12(res_ptr),s3
-
-	sub	 s0,lo0,s0
-	stws,ma	 s0,4(res_ptr)
-	subb	 s1,lo1,s1
-	stws,ma	 s1,4(res_ptr)
-	subb	 s2,lo2,s2
-	stws,ma	 s2,4(res_ptr)
-	subb	 s3,lo3,s3
-	stws,ma	 s3,4(res_ptr)
-	subb	 %r0,%r0,lo0			; these two insns ...
-	add	 lo0,lo0,%r0			; ... invert cy
-
-; restore callee-saves registers ---------------------------------------------
-	ldw	-96(%r30),%r3
-	ldw	-92(%r30),%r4
-	ldw	-88(%r30),%r5
-	ldw	-84(%r30),%r6
-	ldw	-80(%r30),%r7
-
-L$few_limbs
-	addib,=,n 4,size,L$ret
-L$loop2	fldws,ma 4(s1_ptr),%fr4
-	ldws	 0(res_ptr),s0
-	xmpyu	 %fr4,%fr31R,%fr5
-	fstds	 %fr5,-16(%r30)
-	ldws	-16(%r30),hi0
-	ldws	-12(%r30),lo0
-	addc	 lo0,cylimb,lo0
-	addc	 %r0,hi0,cylimb
-	sub	 s0,lo0,s0
-	add	 s0,lo0,%r0			; invert cy
-	stws,ma	 s0,4(res_ptr)
-	addib,<> -1,size,L$loop2
-	nop
-
-L$ret	addc	 %r0,cylimb,cylimb
-	bv	 0(%r2)
-	ldo	 -128(%r30),%r30
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/hppa1_1/submul_1.s b/ghc/rts/gmp/mpn/hppa/hppa1_1/submul_1.s
deleted file mode 100644
index 20a5b5ce0a..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa1_1/submul_1.s
+++ /dev/null
@@ -1,111 +0,0 @@
-; HP-PA-1.1 __gmpn_submul_1 -- Multiply a limb vector with a limb and
-; subtract the result from a second limb vector.
-
-; Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	r26
-; s1_ptr	r25
-; size		r24
-; s2_limb	r23
-
-; This runs at 12 cycles/limb on a PA7000.  With the used instructions, it
-; can not become faster due to data cache contention after a store.  On the
-; PA7100 it runs at 11 cycles/limb, and that can not be improved either,
-; since only the xmpyu does not need the integer pipeline, so the only
-; dual-issue we will get are addc+xmpyu.  Unrolling could gain a cycle/limb
-; on the PA7100.
-
-; There are some ideas described in mul_1.s that applies to this code too.
-
-; It seems possible to make this run as fast as __gmpn_addmul_1, if we use
-; 	sub,>>=	%r29,%r19,%r22
-;	addi	1,%r28,%r28
-; but that requires reworking the hairy software pipeline...
-
-	.code
-	.export		__gmpn_submul_1
-__gmpn_submul_1
-	.proc
-	.callinfo	frame=64,no_calls
-	.entry
-
-	ldo		64(%r30),%r30
-	fldws,ma	4(%r25),%fr5
-	stw		%r23,-16(%r30)		; move s2_limb ...
-	addib,=		-1,%r24,L$just_one_limb
-	 fldws		-16(%r30),%fr4		; ... into fr4
-	add		%r0,%r0,%r0		; clear carry
-	xmpyu		%fr4,%fr5,%fr6
-	fldws,ma	4(%r25),%fr7
-	fstds		%fr6,-16(%r30)
-	xmpyu		%fr4,%fr7,%fr8
-	ldw		-12(%r30),%r19		; least significant limb in product
-	ldw		-16(%r30),%r28
-
-	fstds		%fr8,-16(%r30)
-	addib,=		-1,%r24,L$end
-	 ldw		-12(%r30),%r1
-
-; Main loop
-L$loop	ldws		0(%r26),%r29
-	fldws,ma	4(%r25),%fr5
-	sub		%r29,%r19,%r22
-	add		%r22,%r19,%r0
-	stws,ma		%r22,4(%r26)
-	addc		%r28,%r1,%r19
-	xmpyu		%fr4,%fr5,%fr6
-	ldw		-16(%r30),%r28
-	fstds		%fr6,-16(%r30)
-	addc		%r0,%r28,%r28
-	addib,<>	-1,%r24,L$loop
-	 ldw		-12(%r30),%r1
-
-L$end	ldw		0(%r26),%r29
-	sub		%r29,%r19,%r22
-	add		%r22,%r19,%r0
-	stws,ma		%r22,4(%r26)
-	addc		%r28,%r1,%r19
-	ldw		-16(%r30),%r28
-	ldws		0(%r26),%r29
-	addc		%r0,%r28,%r28
-	sub		%r29,%r19,%r22
-	add		%r22,%r19,%r0
-	stws,ma		%r22,4(%r26)
-	addc		%r0,%r28,%r28
-	bv		0(%r2)
-	 ldo		-64(%r30),%r30
-
-L$just_one_limb
-	xmpyu		%fr4,%fr5,%fr6
-	ldw		0(%r26),%r29
-	fstds		%fr6,-16(%r30)
-	ldw		-12(%r30),%r1
-	ldw		-16(%r30),%r28
-	sub		%r29,%r1,%r22
-	add		%r22,%r1,%r0
-	stw		%r22,0(%r26)
-	addc		%r0,%r28,%r28
-	bv		0(%r2)
-	 ldo		-64(%r30),%r30
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/hppa1_1/udiv_qrnnd.S b/ghc/rts/gmp/mpn/hppa/hppa1_1/udiv_qrnnd.S
deleted file mode 100644
index b83d6f4dd2..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa1_1/udiv_qrnnd.S
+++ /dev/null
@@ -1,80 +0,0 @@
-; HP-PA  __udiv_qrnnd division support, used from longlong.h.
-; This version runs fast on PA 7000 and later.
-
-; Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; rem_ptr	gr26
-; n1		gr25
-; n0		gr24
-; d		gr23
-
-	.code
-L$0000	.word		0x43f00000		; 2^64
-	.word		0x0
-	.export		__gmpn_udiv_qrnnd
-__gmpn_udiv_qrnnd
-	.proc
-	.callinfo	frame=64,no_calls
-	.entry
-	ldo		64(%r30),%r30
-
-	stws		%r25,-16(0,%r30)	; n_hi
-	stws		%r24,-12(0,%r30)	; n_lo
-#ifdef PIC
-	addil		LT%L$0000,%r19
-	ldo		RT%L$0000(%r1),%r19
-#else
-	ldil		L%L$0000,%r19
-	ldo		R%L$0000(%r19),%r19
-#endif	
-	fldds		-16(0,%r30),%fr5
-	stws		%r23,-12(0,%r30)
-	comib,<=	0,%r25,L$1
-	fcnvxf,dbl,dbl	%fr5,%fr5
-	fldds		0(0,%r19),%fr4
-	fadd,dbl	%fr4,%fr5,%fr5
-L$1
-	fcpy,sgl	%fr0,%fr6L
-	fldws		-12(0,%r30),%fr6R
-	fcnvxf,dbl,dbl	%fr6,%fr4
-
-	fdiv,dbl	%fr5,%fr4,%fr5
-
-	fcnvfx,dbl,dbl	%fr5,%fr4
-	fstws		%fr4R,-16(%r30)
-	xmpyu		%fr4R,%fr6R,%fr6
-	ldws		-16(%r30),%r28
-	fstds		%fr6,-16(0,%r30)
-	ldws		-12(0,%r30),%r21
-	ldws		-16(0,%r30),%r20
-	sub		%r24,%r21,%r22
-	subb		%r25,%r20,%r19
-	comib,=		0,%r19,L$2
-	ldo		-64(%r30),%r30
-
-	add		%r22,%r23,%r22
-	ldo		-1(%r28),%r28
-L$2	bv		0(%r2)
-	stws		%r22,0(0,%r26)
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/hppa1_1/umul.s b/ghc/rts/gmp/mpn/hppa/hppa1_1/umul.s
deleted file mode 100644
index 1f1300ac9b..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa1_1/umul.s
+++ /dev/null
@@ -1,42 +0,0 @@
-; Copyright (C) 1999 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-	.code
-	.export		__umul_ppmm
-	.align 4
-__umul_ppmm
-	.proc
-	.callinfo frame=64,no_calls
-	.entry
-
-	ldo 64(%r30),%r30
-	stw %r25,-16(0,%r30)
-	fldws -16(0,%r30),%fr22R
-	stw %r24,-16(0,%r30)
-	fldws -16(0,%r30),%fr22L
-	xmpyu %fr22R,%fr22L,%fr22
-	fstds %fr22,-16(0,%r30)
-	ldw -16(0,%r30),%r28
-	ldw -12(0,%r30),%r29
-	stw %r29,0(0,%r26)
-	bv 0(%r2)
-	ldo -64(%r30),%r30
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/hppa2_0/add_n.s b/ghc/rts/gmp/mpn/hppa/hppa2_0/add_n.s
deleted file mode 100644
index 6e97278a39..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa2_0/add_n.s
+++ /dev/null
@@ -1,88 +0,0 @@
-; HP-PA 2.0 32-bit __gmpn_add_n -- Add two limb vectors of the same length > 0
-; and store sum in a third limb vector.
-
-; Copyright (C) 1997, 1998, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; s2_ptr	gr24
-; size		gr23
-
-; This runs at 2 cycles/limb on PA8000.
-
-	.code
-	.export	__gmpn_add_n
-__gmpn_add_n
-	.proc
-	.callinfo frame=0,no_calls
-	.entry
-
-	sub		%r0,%r23,%r22
-	zdep		%r22,30,3,%r28		; r28 = 2 * (-n & 7)
-	zdep		%r22,29,3,%r22		; r22 = 4 * (-n & 7)
-	sub		%r25,%r22,%r25		; offset s1_ptr
-	sub		%r24,%r22,%r24		; offset s2_ptr
-	sub		%r26,%r22,%r26		; offset res_ptr
-	blr		%r28,%r0		; branch into loop
-	add		%r0,%r0,%r0		; reset carry
-
-L$loop	ldw		0(%r25),%r20
-	ldw		0(%r24),%r31
-	addc		%r20,%r31,%r20
-	stw		%r20,0(%r26)
-L$7	ldw		4(%r25),%r21
-	ldw		4(%r24),%r19
-	addc		%r21,%r19,%r21
-	stw		%r21,4(%r26)
-L$6	ldw		8(%r25),%r20
-	ldw		8(%r24),%r31
-	addc		%r20,%r31,%r20
-	stw		%r20,8(%r26)
-L$5	ldw		12(%r25),%r21
-	ldw		12(%r24),%r19
-	addc		%r21,%r19,%r21
-	stw		%r21,12(%r26)
-L$4	ldw		16(%r25),%r20
-	ldw		16(%r24),%r31
-	addc		%r20,%r31,%r20
-	stw		%r20,16(%r26)
-L$3	ldw		20(%r25),%r21
-	ldw		20(%r24),%r19
-	addc		%r21,%r19,%r21
-	stw		%r21,20(%r26)
-L$2	ldw		24(%r25),%r20
-	ldw		24(%r24),%r31
-	addc		%r20,%r31,%r20
-	stw		%r20,24(%r26)
-L$1	ldw		28(%r25),%r21
-	ldo		32(%r25),%r25
-	ldw		28(%r24),%r19
-	addc		%r21,%r19,%r21
-	stw		%r21,28(%r26)
-	ldo		32(%r24),%r24
-	addib,>		-8,%r23,L$loop
-	ldo		32(%r26),%r26
-
-	bv		(%r2)
-	.exit
-	addc		%r0,%r0,%r28
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/hppa2_0/sub_n.s b/ghc/rts/gmp/mpn/hppa/hppa2_0/sub_n.s
deleted file mode 100644
index 7d9b50fc27..0000000000
--- a/ghc/rts/gmp/mpn/hppa/hppa2_0/sub_n.s
+++ /dev/null
@@ -1,88 +0,0 @@
-; HP-PA 2.0 32-bit __gmpn_sub_n -- Subtract two limb vectors of the same
-; length > 0 and store difference in a third limb vector.
-
-; Copyright (C) 1997, 1998, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; s2_ptr	gr24
-; size		gr23
-
-; This runs at 2 cycles/limb on PA8000.
-
-	.code
-	.export	__gmpn_sub_n
-__gmpn_sub_n
-	.proc
-	.callinfo frame=0,no_calls
-	.entry
-
-	sub		%r0,%r23,%r22
-	zdep		%r22,30,3,%r28		; r28 = 2 * (-n & 7)
-	zdep		%r22,29,3,%r22		; r22 = 4 * (-n & 7)
-	sub		%r25,%r22,%r25		; offset s1_ptr
-	sub		%r24,%r22,%r24		; offset s2_ptr
-	blr		%r28,%r0		; branch into loop
-	sub		%r26,%r22,%r26		; offset res_ptr and set carry
-
-L$loop	ldw		0(%r25),%r20
-	ldw		0(%r24),%r31
-	subb		%r20,%r31,%r20
-	stw		%r20,0(%r26)
-L$7	ldw		4(%r25),%r21
-	ldw		4(%r24),%r19
-	subb		%r21,%r19,%r21
-	stw		%r21,4(%r26)
-L$6	ldw		8(%r25),%r20
-	ldw		8(%r24),%r31
-	subb		%r20,%r31,%r20
-	stw		%r20,8(%r26)
-L$5	ldw		12(%r25),%r21
-	ldw		12(%r24),%r19
-	subb		%r21,%r19,%r21
-	stw		%r21,12(%r26)
-L$4	ldw		16(%r25),%r20
-	ldw		16(%r24),%r31
-	subb		%r20,%r31,%r20
-	stw		%r20,16(%r26)
-L$3	ldw		20(%r25),%r21
-	ldw		20(%r24),%r19
-	subb		%r21,%r19,%r21
-	stw		%r21,20(%r26)
-L$2	ldw		24(%r25),%r20
-	ldw		24(%r24),%r31
-	subb		%r20,%r31,%r20
-	stw		%r20,24(%r26)
-L$1	ldw		28(%r25),%r21
-	ldo		32(%r25),%r25
-	ldw		28(%r24),%r19
-	subb		%r21,%r19,%r21
-	stw		%r21,28(%r26)
-	ldo		32(%r24),%r24
-	addib,>		-8,%r23,L$loop
-	ldo		32(%r26),%r26
-
-	addc		%r0,%r0,%r28
-	bv		(%r2)
-	.exit
-	subi		1,%r28,%r28
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/lshift.s b/ghc/rts/gmp/mpn/hppa/lshift.s
deleted file mode 100644
index f5a2daad60..0000000000
--- a/ghc/rts/gmp/mpn/hppa/lshift.s
+++ /dev/null
@@ -1,66 +0,0 @@
-; HP-PA  __gmpn_lshift --
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s_ptr		gr25
-; size		gr24
-; cnt		gr23
-
-	.code
-	.export		__gmpn_lshift
-__gmpn_lshift
-	.proc
-	.callinfo	frame=64,no_calls
-	.entry
-
-	sh2add		%r24,%r25,%r25
-	sh2add		%r24,%r26,%r26
-	ldws,mb		-4(0,%r25),%r22
-	subi		32,%r23,%r1
-	mtsar		%r1
-	addib,=		-1,%r24,L$0004
-	vshd		%r0,%r22,%r28		; compute carry out limb
-	ldws,mb		-4(0,%r25),%r29
-	addib,=		-1,%r24,L$0002
-	vshd		%r22,%r29,%r20
-
-L$loop	ldws,mb		-4(0,%r25),%r22
-	stws,mb		%r20,-4(0,%r26)
-	addib,=		-1,%r24,L$0003
-	vshd		%r29,%r22,%r20
-	ldws,mb		-4(0,%r25),%r29
-	stws,mb		%r20,-4(0,%r26)
-	addib,<>	-1,%r24,L$loop
-	vshd		%r22,%r29,%r20
-
-L$0002	stws,mb		%r20,-4(0,%r26)
-	vshd		%r29,%r0,%r20
-	bv		0(%r2)
-	stw		%r20,-4(0,%r26)
-L$0003	stws,mb		%r20,-4(0,%r26)
-L$0004	vshd		%r22,%r0,%r20
-	bv		0(%r2)
-	stw		%r20,-4(0,%r26)
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/rshift.s b/ghc/rts/gmp/mpn/hppa/rshift.s
deleted file mode 100644
index e05e2f10b5..0000000000
--- a/ghc/rts/gmp/mpn/hppa/rshift.s
+++ /dev/null
@@ -1,63 +0,0 @@
-; HP-PA  __gmpn_rshift -- 
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s_ptr		gr25
-; size		gr24
-; cnt		gr23
-
-	.code
-	.export		__gmpn_rshift
-__gmpn_rshift
-	.proc
-	.callinfo	frame=64,no_calls
-	.entry
-
-	ldws,ma		4(0,%r25),%r22
-	mtsar		%r23
-	addib,=		-1,%r24,L$0004
-	vshd		%r22,%r0,%r28		; compute carry out limb
-	ldws,ma		4(0,%r25),%r29
-	addib,=		-1,%r24,L$0002
-	vshd		%r29,%r22,%r20
-
-L$loop	ldws,ma		4(0,%r25),%r22
-	stws,ma		%r20,4(0,%r26)
-	addib,=		-1,%r24,L$0003
-	vshd		%r22,%r29,%r20
-	ldws,ma		4(0,%r25),%r29
-	stws,ma		%r20,4(0,%r26)
-	addib,<>	-1,%r24,L$loop
-	vshd		%r29,%r22,%r20
-
-L$0002	stws,ma		%r20,4(0,%r26)
-	vshd		%r0,%r29,%r20
-	bv		0(%r2)
-	stw		%r20,0(0,%r26)
-L$0003	stws,ma		%r20,4(0,%r26)
-L$0004	vshd		%r0,%r22,%r20
-	bv		0(%r2)
-	stw		%r20,0(0,%r26)
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/sub_n.s b/ghc/rts/gmp/mpn/hppa/sub_n.s
deleted file mode 100644
index 8f770ad1ad..0000000000
--- a/ghc/rts/gmp/mpn/hppa/sub_n.s
+++ /dev/null
@@ -1,59 +0,0 @@
-; HP-PA  __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
-; store difference in a third limb vector.
-
-; Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; s2_ptr	gr24
-; size		gr23
-
-; One might want to unroll this as for other processors, but it turns
-; out that the data cache contention after a store makes such
-; unrolling useless.  We can't come under 5 cycles/limb anyway.
-
-	.code
-	.export		__gmpn_sub_n
-__gmpn_sub_n
-	.proc
-	.callinfo	frame=0,no_calls
-	.entry
-
-	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-
-	addib,=		-1,%r23,L$end	; check for (SIZE == 1)
-	 sub		%r20,%r19,%r28	; subtract first limbs ignoring cy
-
-L$loop	ldws,ma		4(0,%r25),%r20
-	ldws,ma		4(0,%r24),%r19
-	stws,ma		%r28,4(0,%r26)
-	addib,<>	-1,%r23,L$loop
-	 subb		%r20,%r19,%r28
-
-L$end	stws		%r28,0(0,%r26)
-	addc		%r0,%r0,%r28
-	bv		0(%r2)
-	 subi		1,%r28,%r28
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/hppa/udiv_qrnnd.s b/ghc/rts/gmp/mpn/hppa/udiv_qrnnd.s
deleted file mode 100644
index 9aa3b8a830..0000000000
--- a/ghc/rts/gmp/mpn/hppa/udiv_qrnnd.s
+++ /dev/null
@@ -1,286 +0,0 @@
-; HP-PA  __udiv_qrnnd division support, used from longlong.h.
-; This version runs fast on pre-PA7000 CPUs.
-
-; Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; rem_ptr	gr26
-; n1		gr25
-; n0		gr24
-; d		gr23
-
-; The code size is a bit excessive.  We could merge the last two ds;addc
-; sequences by simply moving the "bb,< Odd" instruction down.  The only
-; trouble is the FFFFFFFF code that would need some hacking.
-
-	.code
-	.export		__gmpn_udiv_qrnnd
-__gmpn_udiv_qrnnd
-	.proc
-	.callinfo	frame=0,no_calls
-	.entry
-
-	comb,<		%r23,0,L$largedivisor
-	 sub		%r0,%r23,%r1		; clear cy as side-effect
-	ds		%r0,%r1,%r0
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r23,%r25
-	addc		%r24,%r24,%r28
-	ds		%r25,%r23,%r25
-	comclr,>=	%r25,%r0,%r0
-	addl		%r25,%r23,%r25
-	stws		%r25,0(0,%r26)
-	bv		0(%r2)
-	 addc		%r28,%r28,%r28
-
-L$largedivisor
-	extru		%r24,31,1,%r19		; r19 = n0 & 1
-	bb,<		%r23,31,L$odd
-	 extru		%r23,30,31,%r22		; r22 = d >> 1
-	shd		%r25,%r24,1,%r24	; r24 = new n0
-	extru		%r25,30,31,%r25		; r25 = new n1
-	sub		%r0,%r22,%r21
-	ds		%r0,%r21,%r0
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	comclr,>=	%r25,%r0,%r0
-	addl		%r25,%r22,%r25
-	sh1addl		%r25,%r19,%r25
-	stws		%r25,0(0,%r26)
-	bv		0(%r2)
-	 addc		%r24,%r24,%r28
-
-L$odd	addib,sv,n	1,%r22,L$FF..		; r22 = (d / 2 + 1)
-	shd		%r25,%r24,1,%r24	; r24 = new n0
-	extru		%r25,30,31,%r25		; r25 = new n1
-	sub		%r0,%r22,%r21
-	ds		%r0,%r21,%r0
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r24
-	ds		%r25,%r22,%r25
-	addc		%r24,%r24,%r28
-	comclr,>=	%r25,%r0,%r0
-	addl		%r25,%r22,%r25
-	sh1addl		%r25,%r19,%r25
-; We have computed (n1,,n0) / (d + 1), q' = r28, r' = r25
-	add,nuv		%r28,%r25,%r25
-	addl		%r25,%r1,%r25
-	addc		%r0,%r28,%r28
-	sub,<<		%r25,%r23,%r0
-	addl		%r25,%r1,%r25
-	stws		%r25,0(0,%r26)
-	bv		0(%r2)
-	 addc		%r0,%r28,%r28
-
-; This is just a special case of the code above.
-; We come here when d == 0xFFFFFFFF
-L$FF..	add,uv		%r25,%r24,%r24
-	sub,<<		%r24,%r23,%r0
-	ldo		1(%r24),%r24
-	stws		%r24,0(0,%r26)
-	bv		0(%r2)
-	 addc		%r0,%r25,%r28
-
-	.exit
-	.procend
diff --git a/ghc/rts/gmp/mpn/i960/README b/ghc/rts/gmp/mpn/i960/README
deleted file mode 100644
index d68a0a83eb..0000000000
--- a/ghc/rts/gmp/mpn/i960/README
+++ /dev/null
@@ -1,9 +0,0 @@
-This directory contains mpn functions for Intel i960 processors.
-
-RELEVANT OPTIMIZATION ISSUES
-
-The code in this directory is not well optimized.
-
-STATUS
-
-The code in this directory has not been tested.
diff --git a/ghc/rts/gmp/mpn/i960/add_n.s b/ghc/rts/gmp/mpn/i960/add_n.s
deleted file mode 100644
index 387317a397..0000000000
--- a/ghc/rts/gmp/mpn/i960/add_n.s
+++ /dev/null
@@ -1,43 +0,0 @@
-# I960 __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
-# sum in a third limb vector.
-
-# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-.text
-	.align 4
-	.globl ___gmpn_add_n
-___gmpn_add_n:
-	mov	0,g6		# clear carry-save register
-	cmpo	1,0		# clear cy
-
-Loop:	subo	1,g3,g3		# update loop counter
-	ld	(g1),g5		# load from s1_ptr
-	addo	4,g1,g1		# s1_ptr++
-	ld	(g2),g4		# load from s2_ptr
-	addo	4,g2,g2		# s2_ptr++
-	cmpo	g6,1		# restore cy from g6, relies on cy being 0
-	addc	g4,g5,g4	# main add
-	subc	0,0,g6		# save cy in g6
-	st	g4,(g0)		# store result to res_ptr
-	addo	4,g0,g0		# res_ptr++
-	cmpobne	0,g3,Loop	# when branch is taken, clears C bit
-
-	mov	g6,g0
-	ret
diff --git a/ghc/rts/gmp/mpn/i960/addmul_1.s b/ghc/rts/gmp/mpn/i960/addmul_1.s
deleted file mode 100644
index 7df1418356..0000000000
--- a/ghc/rts/gmp/mpn/i960/addmul_1.s
+++ /dev/null
@@ -1,48 +0,0 @@
-# I960 __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
-# the result to a second limb vector.
-
-# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-.text
-	.align	4
-	.globl	___gmpn_mul_1
-___gmpn_mul_1:
-	subo	g2,0,g2
-	shlo	2,g2,g4
-	subo	g4,g1,g1
-	subo	g4,g0,g13
-	mov	0,g0
-
-	cmpo	1,0		# clear C bit on AC.cc
-
-Loop:	ld	(g1)[g2*4],g5
-	emul	g3,g5,g6
-	ld	(g13)[g2*4],g5
-
-	addc	g0,g6,g6	# relies on that C bit is clear
-	addc	0,g7,g7
-	addc	g5,g6,g6	# relies on that C bit is clear
-	st	g6,(g13)[g2*4]
-	addc	0,g7,g0
-
-	addo	g2,1,g2
-	cmpobne	0,g2,Loop	# when branch is taken, clears C bit
-
-	ret
diff --git a/ghc/rts/gmp/mpn/i960/mul_1.s b/ghc/rts/gmp/mpn/i960/mul_1.s
deleted file mode 100644
index 5c0c985aa5..0000000000
--- a/ghc/rts/gmp/mpn/i960/mul_1.s
+++ /dev/null
@@ -1,45 +0,0 @@
-# I960 __gmpn_mul_1 -- Multiply a limb vector with a limb and store
-# the result in a second limb vector.
-
-# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-.text
-	.align	4
-	.globl	___gmpn_mul_1
-___gmpn_mul_1:
-	subo	g2,0,g2
-	shlo	2,g2,g4
-	subo	g4,g1,g1
-	subo	g4,g0,g13
-	mov	0,g0
-
-	cmpo	1,0		# clear C bit on AC.cc
-
-Loop:	ld	(g1)[g2*4],g5
-	emul	g3,g5,g6
-
-	addc	g0,g6,g6	# relies on that C bit is clear
-	st	g6,(g13)[g2*4]
-	addc	0,g7,g0
-
-	addo	g2,1,g2
-	cmpobne	0,g2,Loop	# when branch is taken, clears C bit
-
-	ret
diff --git a/ghc/rts/gmp/mpn/i960/sub_n.s b/ghc/rts/gmp/mpn/i960/sub_n.s
deleted file mode 100644
index 2db2d46aad..0000000000
--- a/ghc/rts/gmp/mpn/i960/sub_n.s
+++ /dev/null
@@ -1,43 +0,0 @@
-# I960 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
-# store difference in a third limb vector.
-
-# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-.text
-	.align 4
-	.globl ___gmpn_sub_n
-___gmpn_sub_n:
-	mov	1,g6		# set carry-save register
-	cmpo	1,0		# clear cy
-
-Loop:	subo	1,g3,g3		# update loop counter
-	ld	(g1),g5		# load from s1_ptr
-	addo	4,g1,g1		# s1_ptr++
-	ld	(g2),g4		# load from s2_ptr
-	addo	4,g2,g2		# s2_ptr++
-	cmpo	g6,1		# restore cy from g6, relies on cy being 0
-	subc	g4,g5,g4	# main subtract
-	subc	0,0,g6		# save cy in g6
-	st	g4,(g0)		# store result to res_ptr
-	addo	4,g0,g0		# res_ptr++
-	cmpobne	0,g3,Loop	# when branch is taken, cy will be 0
-
-	mov	g6,g0
-	ret
diff --git a/ghc/rts/gmp/mpn/lisp/gmpasm-mode.el b/ghc/rts/gmp/mpn/lisp/gmpasm-mode.el
deleted file mode 100644
index 5d9da7fa1f..0000000000
--- a/ghc/rts/gmp/mpn/lisp/gmpasm-mode.el
+++ /dev/null
@@ -1,351 +0,0 @@
-;;; gmpasm-mode.el -- GNU MP asm and m4 editing mode.
-
-
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-;;
-;; This file is part of the GNU MP Library.
-;;
-;; The GNU MP Library is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU Lesser General Public License as published by
-;; the Free Software Foundation; either version 2.1 of the License, or (at your
-;; option) any later version.
-;;
-;; The GNU MP Library is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-;; License for more details.
-;;
-;; You should have received a copy of the GNU Lesser General Public License
-;; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-;; MA 02111-1307, USA.
-
-
-;;; Commentary:
-;;
-;; gmpasm-mode is an editing mode for m4 processed assembler code and m4
-;; macro files in GMP.  It's similar to m4-mode, but has a number of
-;; settings better suited to GMP.
-;;
-;;
-;; Install
-;; -------
-;;
-;; To make M-x gmpasm-mode available, put gmpasm-mode.el somewhere in the
-;; load-path and the following in .emacs
-;;
-;;	(autoload 'gmpasm-mode "gmpasm-mode" nil t)
-;;
-;; To use gmpasm-mode automatically on all .asm and .m4 files, put the
-;; following in .emacs
-;;
-;;	(add-to-list 'auto-mode-alist '("\\.asm\\'" . gmpasm-mode))
-;;	(add-to-list 'auto-mode-alist '("\\.m4\\'" . gmpasm-mode))
-;;
-;; To have gmpasm-mode only on gmp files, try instead something like the
-;; following, which uses it only in a directory starting with "gmp", or a
-;; sub-directory of such.
-;;
-;;	(add-to-list 'auto-mode-alist
-;;	             '("/gmp.*/.*\\.\\(asm\\|m4\\)\\'" . gmpasm-mode))
-;;
-;; Byte compiling will slightly speed up loading.  If you want a docstring
-;; in the autoload you can use M-x update-file-autoloads if you set it up
-;; right.
-;;
-;;
-;; Emacsen
-;; -------
-;;
-;; FSF Emacs 20.x - gmpasm-mode is designed for this.
-;; XEmacs 20.x - seems to work.
-;;
-;; FSF Emacs 19.x - should work if replacements for some 20.x-isms are
-;;    available.  comment-region with "C" won't really do the right thing
-;;    though.
-
-
-;;; Code:
-
-(defgroup gmpasm nil
-  "GNU MP m4 and asm editing."
-  :prefix "gmpasm-"
-  :group 'languages)
-
-(defcustom gmpasm-mode-hook nil
-  "*Hook called by `gmpasm-mode'."
-  :type 'hook
-  :group 'gmpasm)
-
-(defcustom gmpasm-comment-start-regexp "[#;!@C]"
-  "*Regexp matching possible comment styles.
-See `gmpasm-mode' docstring for how this is used."
-  :type 'regexp
-  :group 'gmpasm)
-
-
-(defun gmpasm-add-to-list-second (list-var element)
-  "(gmpasm-add-to-list-second LIST-VAR ELEMENT)
-
-Add ELEMENT to LIST-VAR as the second element in the list, if it isn't
-already in the list.  If LIST-VAR is nil, then ELEMENT is just added as the
-sole element in the list.
-
-This is like `add-to-list', but it puts the new value second in the list.
-
-The first cons cell is copied rather than changed in-place, so references to
-the list elsewhere won't be affected."
-
-  (if (member element (symbol-value list-var))
-      (symbol-value list-var)
-    (set list-var
-	 (if (symbol-value list-var)
-	     (cons (car (symbol-value list-var))
-		   (cons element
-			 (cdr (symbol-value list-var))))
-	   (list element)))))
-
-
-(defun gmpasm-delete-from-list (list-var element)
-  "(gmpasm-delete-from-list LIST-VAR ELEMENT)
-
-Delete ELEMENT from LIST-VAR, using `delete'.
-This is like `add-to-list', but the element is deleted from the list.
-The list is copied rather than changed in-place, so references to it elsewhere
-won't be affected."
-
-  (set list-var (delete element (copy-sequence (symbol-value list-var)))))
-
-
-(defvar gmpasm-mode-map
-  (let ((map (make-sparse-keymap)))
-    
-    ;; assembler and dnl commenting
-    (define-key map "\C-c\C-c" 'comment-region)
-    (define-key map "\C-c\C-d" 'gmpasm-comment-region-dnl)
-    
-    ;; kill an M-x compile, since it's not hard to put m4 into an infinite
-    ;; loop
-    (define-key map "\C-c\C-k" 'kill-compilation)
-    
-    map)
-  "Keymap for `gmpasm-mode'.")
-
-
-(defvar gmpasm-mode-syntax-table
-  (let ((table (make-syntax-table)))
-    ;; underscore left as a symbol char, like C mode
-    
-    ;; m4 quotes
-    (modify-syntax-entry ?`  "('"  table)
-    (modify-syntax-entry ?'  ")`"  table)
-
-    table)
-  "Syntax table used in `gmpasm-mode'.
-
-m4 ignores quote marks in # comments at the top level, but inside quotes #
-isn't special and all quotes are active.  There seems no easy way to express
-this in the syntax table, so nothing is done for comments.  Usually this is
-best, since it picks up invalid apostrophes in comments inside quotes.")
-
-
-(defvar gmpasm-font-lock-keywords
-  (eval-when-compile
-    (list
-     (cons
-      (concat
-       "\\b"
-       (regexp-opt
-	'("deflit" "defreg" "defframe" "defframe_pushl"
-	  "define_not_for_expansion"
-	  "ASM_START" "ASM_END" "PROLOGUE" "EPILOGUE"
-	  "forloop"
-	  "TEXT" "DATA" "ALIGN" "W32"
-	  "builtin" "changecom" "changequote" "changeword" "debugfile"
-	  "debugmode" "decr" "define" "defn" "divert" "divnum" "dumpdef"
-	  "errprint" "esyscmd" "eval" "__file__" "format" "gnu" "ifdef"
-	  "ifelse" "include" "incr" "index" "indir" "len" "__line__"
-	  "m4exit" "m4wrap" "maketemp" "patsubst" "popdef" "pushdef"
-	  "regexp" "shift" "sinclude" "substr" "syscmd" "sysval"
-	  "traceoff" "traceon" "translit" "undefine" "undivert" "unix")
-	t)
-       "\\b") 'font-lock-keyword-face)))
-
-  "`font-lock-keywords' for `gmpasm-mode'.
-
-The keywords are m4 builtins and some of the GMP macros used in asm files.
-L and LF don't look good fontified, so they're omitted.
-
-The right assembler comment regexp is added dynamically buffer-local (with
-dnl too).")
-
-
-;; Initialized if gmpasm-mode finds filladapt loaded.
-(defvar gmpasm-filladapt-token-table nil
-  "Filladapt token table used in `gmpasm-mode'.")
-(defvar gmpasm-filladapt-token-match-table nil
-  "Filladapt token match table used in `gmpasm-mode'.")
-(defvar gmpasm-filladapt-token-conversion-table nil
-  "Filladapt token conversion table used in `gmpasm-mode'.")
-
-
-;;;###autoload
-(defun gmpasm-mode ()
-  "A major mode for editing GNU MP asm and m4 files.
-
-\\{gmpasm-mode-map}
-`comment-start' and `comment-end' are set buffer-local to assembler
-commenting appropriate for the CPU by looking for something matching
-`gmpasm-comment-start-regexp' at the start of a line, or \"#\" is used if
-there's no match (if \"#\" isn't what you want, type in a desired comment
-and do \\[gmpasm-mode] to reinitialize).
-
-`adaptive-fill-regexp' is set buffer-local to the standard regexp with
-`comment-start' and dnl added.  If filladapt.el has been loaded it similarly
-gets `comment-start' and dnl added as buffer-local fill prefixes.
-
-Font locking has the m4 builtins, some of the GMP macros, m4 dnl commenting,
-and assembler commenting (based on the `comment-start' determined).
-
-Note that `gmpasm-comment-start-regexp' is only matched as a whole word, so
-the `C' in it is only matched as a whole word, not on something that happens
-to start with `C'.  Also it's only the particular `comment-start' determined
-that's added for filling etc, not the whole `gmpasm-comment-start-regexp'.
-
-`gmpasm-mode-hook' is run after initializations are complete.
-"
-
-  (interactive)
-  (kill-all-local-variables)
-  (setq major-mode 'gmpasm-mode
-        mode-name  "gmpasm")
-  (use-local-map gmpasm-mode-map)
-  (set-syntax-table gmpasm-mode-syntax-table)
-  (setq fill-column 76)
-
-  ;; Short instructions might fit with 32, but anything with labels or
-  ;; expressions soon needs the comments pushed out to column 40.
-  (setq comment-column 40)
-
-  ;; Don't want to find out the hard way which dumb assemblers don't like a
-  ;; missing final newline.
-  (set (make-local-variable 'require-final-newline) t)
-
-  ;; The first match of gmpasm-comment-start-regexp at the start of a line
-  ;; determines comment-start, or "#" if no match.
-  (set (make-local-variable 'comment-start)
-       (save-excursion
-	 (goto-char (point-min))
-	 (if (re-search-forward
-	      (concat "^\\(" gmpasm-comment-start-regexp "\\)\\(\\s-\\|$\\)")
-	      nil t)
-	     (match-string 1)
-	   "#")))
-  (set (make-local-variable 'comment-end) "")
-
-  ;; If comment-start ends in an alphanumeric then \b is used to match it
-  ;; only as a separate word.  The test is for an alphanumeric rather than
-  ;; \w since we might try # or ! as \w characters but without wanting \b.
-  (let ((comment-regexp
-	 (concat (regexp-quote comment-start)
-		 (if (string-match "[a-zA-Z0-9]\\'" comment-start) "\\b"))))
-    
-    ;; Whitespace is required before a comment-start so m4 $# doesn't match
-    ;; when comment-start is "#".
-    ;; Only spaces or tabs match after, so newline isn't included in the
-    ;; font lock below.
-    (set (make-local-variable 'comment-start-skip)
-	 (concat "\\(^\\|\\s-\\)" comment-regexp "[ \t]*"))
-
-    ;; Comment fontification based on comment-start, matching through to the
-    ;; end of the line.
-    (add-to-list (make-local-variable 'gmpasm-font-lock-keywords)
-		 (cons (concat
-			"\\(\\bdnl\\b\\|" comment-start-skip "\\).*$")
-		       'font-lock-comment-face))
-
-    (set (make-local-variable 'font-lock-defaults)
-	 '(gmpasm-font-lock-keywords
-	   t	         ; no syntactic fontification (of strings etc)
-	   nil           ; no case-fold
-	   ((?_ . "w"))  ; _ part of a word while fontifying
-	   ))
-
-    ;; Paragraphs are separated by blank lines, or lines with only dnl or
-    ;; comment-start.
-    (set (make-local-variable 'paragraph-separate)
-	 (concat "[ \t\f]*\\(\\(" comment-regexp "\\|dnl\\)[ \t]*\\)*$"))
-    (set (make-local-variable 'paragraph-start)
-	 (concat "\f\\|" paragraph-separate))
- 
-    ;; Adaptive fill gets dnl and comment-start as comment style prefixes on
-    ;; top of the standard regexp (which has # and ; already actually).
-    (set (make-local-variable 'adaptive-fill-regexp)
-	 (concat "[ \t]*\\(\\("
-		 comment-regexp
-		 "\\|dnl\\|[-|#;>*]+\\|(?[0-9]+[.)]\\)[ \t]*\\)*"))
-    (set (make-local-variable 'adaptive-fill-first-line-regexp)
-	 "\\`\\([ \t]*dnl\\)?[ \t]*\\'")
-
-    (when (fboundp 'filladapt-mode)
-      (when (not gmpasm-filladapt-token-table)
-	(setq gmpasm-filladapt-token-table
-	      filladapt-token-table)
-	(setq gmpasm-filladapt-token-match-table
-	      filladapt-token-match-table)
-	(setq gmpasm-filladapt-token-conversion-table
-	      filladapt-token-conversion-table)
-	
-	;; Numbered bullet points like "2.1" get matched at the start of a
-	;; line when it's really something like "2.1 cycles/limb", so delete
-	;; this from the list.  The regexp for "1.", "2." etc is left
-	;; though.
-	(gmpasm-delete-from-list 'gmpasm-filladapt-token-table
-				 '("[0-9]+\\(\\.[0-9]+\\)+[ \t]"
-				   bullet))
-	  
-	;; "%" as a comment prefix interferes with x86 register names
-	;; like %eax, so delete this.
-	(gmpasm-delete-from-list 'gmpasm-filladapt-token-table
-				 '("%+" postscript-comment))
-	
-	(add-to-list 'gmpasm-filladapt-token-match-table
-		     '(gmpasm-comment gmpasm-comment))
-	(add-to-list 'gmpasm-filladapt-token-conversion-table
-		     '(gmpasm-comment . exact))
-	)
-      
-      (set (make-local-variable 'filladapt-token-table)
-	   gmpasm-filladapt-token-table)
-      (set (make-local-variable 'filladapt-token-match-table)
-	   gmpasm-filladapt-token-match-table)
-      (set (make-local-variable 'filladapt-token-conversion-table)
-	   gmpasm-filladapt-token-conversion-table)
-    
-      ;; Add dnl and comment-start as fill prefixes.
-      ;; Comments in filladapt.el say filladapt-token-table must begin
-      ;; with ("^" beginning-of-line), so put our addition second.
-      (gmpasm-add-to-list-second 'filladapt-token-table
-				 (list (concat "dnl[ \t]\\|" comment-regexp)
-				       'gmpasm-comment))
-      ))
-  
-  (run-hooks 'gmpasm-mode-hook))
-
-
-(defun gmpasm-comment-region-dnl (beg end &optional arg)
-  "(gmpasm-comment-region BEG END &option ARG)
-
-Comment or uncomment each line in the region using `dnl'.
-With \\[universal-argument] prefix arg, uncomment each line in region.
-This is `comment-region', but using \"dnl\"."
-
-  (interactive "r\nP")
-  (let ((comment-start "dnl")
-	(comment-end ""))
-    (comment-region beg end arg)))
-
-
-(provide 'gmpasm-mode)
-
-;;; gmpasm-mode.el ends here
diff --git a/ghc/rts/gmp/mpn/m68k/add_n.S b/ghc/rts/gmp/mpn/m68k/add_n.S
deleted file mode 100644
index 9e1d89d64f..0000000000
--- a/ghc/rts/gmp/mpn/m68k/add_n.S
+++ /dev/null
@@ -1,79 +0,0 @@
-/* mc68020 __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
-   sum in a third limb vector.
-
-Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/*
-  INPUT PARAMETERS
-  res_ptr	(sp + 4)
-  s1_ptr	(sp + 8)
-  s2_ptr	(sp + 16)
-  size		(sp + 12)
-*/
-
-#include "asm-syntax.h"
-
-	TEXT
-	ALIGN
-	GLOBL	C_SYMBOL_NAME(__gmpn_add_n)
-
-C_SYMBOL_NAME(__gmpn_add_n:)
-PROLOG(__gmpn_add_n)
-/* Save used registers on the stack.  */
-	movel	R(d2),MEM_PREDEC(sp)
-	movel	R(a2),MEM_PREDEC(sp)
-
-/* Copy the arguments to registers.  Better use movem?  */
-	movel	MEM_DISP(sp,12),R(a2)
-	movel	MEM_DISP(sp,16),R(a0)
-	movel	MEM_DISP(sp,20),R(a1)
-	movel	MEM_DISP(sp,24),R(d2)
-
-	eorw	#1,R(d2)
-	lsrl	#1,R(d2)
-	bcc	L(L1)
-	subql	#1,R(d2)	/* clears cy as side effect */
-
-L(Loop:)
-	movel	MEM_POSTINC(a0),R(d0)
-	movel	MEM_POSTINC(a1),R(d1)
-	addxl	R(d1),R(d0)
-	movel	R(d0),MEM_POSTINC(a2)
-L(L1:)	movel	MEM_POSTINC(a0),R(d0)
-	movel	MEM_POSTINC(a1),R(d1)
-	addxl	R(d1),R(d0)
-	movel	R(d0),MEM_POSTINC(a2)
-
-	dbf	R(d2),L(Loop)		/* loop until 16 lsb of %4 == -1 */
-	subxl	R(d0),R(d0)	/* d0 <= -cy; save cy as 0 or -1 in d0 */
-	subl	#0x10000,R(d2)
-	bcs	L(L2)
-	addl	R(d0),R(d0)	/* restore cy */
-	bra	L(Loop)
-
-L(L2:)
-	negl	R(d0)
-
-/* Restore used registers from stack frame.  */
-	movel	MEM_POSTINC(sp),R(a2)
-	movel	MEM_POSTINC(sp),R(d2)
-
-	rts
-EPILOG(__gmpn_add_n)
diff --git a/ghc/rts/gmp/mpn/m68k/lshift.S b/ghc/rts/gmp/mpn/m68k/lshift.S
deleted file mode 100644
index a539d5d42e..0000000000
--- a/ghc/rts/gmp/mpn/m68k/lshift.S
+++ /dev/null
@@ -1,150 +0,0 @@
-/* mc68020 __gmpn_lshift -- Shift left a low-level natural-number integer.
-
-Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/*
-  INPUT PARAMETERS
-  res_ptr	(sp + 4)
-  s_ptr		(sp + 8)
-  s_size	(sp + 16)
-  cnt		(sp + 12)
-*/
-
-#include "asm-syntax.h"
-
-#define res_ptr a1
-#define s_ptr a0
-#define s_size d6
-#define cnt d4
-
-	TEXT
-	ALIGN
-	GLOBL	C_SYMBOL_NAME(__gmpn_lshift)
-
-C_SYMBOL_NAME(__gmpn_lshift:)
-PROLOG(__gmpn_lshift)
-
-/* Save used registers on the stack.  */
-	moveml	R(d2)-R(d6)/R(a2),MEM_PREDEC(sp)
-
-/* Copy the arguments to registers.  */
-	movel	MEM_DISP(sp,28),R(res_ptr)
-	movel	MEM_DISP(sp,32),R(s_ptr)
-	movel	MEM_DISP(sp,36),R(s_size)
-	movel	MEM_DISP(sp,40),R(cnt)
-
-	moveql	#1,R(d5)
-	cmpl	R(d5),R(cnt)
-	bne	L(Lnormal)
-	cmpl	R(s_ptr),R(res_ptr)
-	bls	L(Lspecial)		/* jump if s_ptr >= res_ptr */
-#if (defined (__mc68020__) || defined (__NeXT__) || defined(mc68020))
-	lea	MEM_INDX1(s_ptr,s_size,l,4),R(a2)
-#else /* not mc68020 */
-	movel	R(s_size),R(d0)
-	asll	#2,R(d0)
-	lea	MEM_INDX(s_ptr,d0,l),R(a2)
-#endif
-	cmpl	R(res_ptr),R(a2)
-	bls	L(Lspecial)		/* jump if res_ptr >= s_ptr + s_size */
-
-L(Lnormal:)
-	moveql	#32,R(d5)
-	subl	R(cnt),R(d5)
-
-#if (defined (__mc68020__) || defined (__NeXT__) || defined(mc68020))
-	lea	MEM_INDX1(s_ptr,s_size,l,4),R(s_ptr)
-	lea	MEM_INDX1(res_ptr,s_size,l,4),R(res_ptr)
-#else /* not mc68000 */
-	movel	R(s_size),R(d0)
-	asll	#2,R(d0)
-	addl	R(s_size),R(s_ptr)
-	addl	R(s_size),R(res_ptr)
-#endif
-	movel	MEM_PREDEC(s_ptr),R(d2)
-	movel	R(d2),R(d0)
-	lsrl	R(d5),R(d0)		/* compute carry limb */
-
-	lsll	R(cnt),R(d2)
-	movel	R(d2),R(d1)
-	subql	#1,R(s_size)
-	beq	L(Lend)
-	lsrl	#1,R(s_size)
-	bcs	L(L1)
-	subql	#1,R(s_size)
-
-L(Loop:)
-	movel	MEM_PREDEC(s_ptr),R(d2)
-	movel	R(d2),R(d3)
-	lsrl	R(d5),R(d3)
-	orl	R(d3),R(d1)
-	movel	R(d1),MEM_PREDEC(res_ptr)
-	lsll	R(cnt),R(d2)
-L(L1:)
-	movel	MEM_PREDEC(s_ptr),R(d1)
-	movel	R(d1),R(d3)
-	lsrl	R(d5),R(d3)
-	orl	R(d3),R(d2)
-	movel	R(d2),MEM_PREDEC(res_ptr)
-	lsll	R(cnt),R(d1)
-
-	dbf	R(s_size),L(Loop)
-	subl	#0x10000,R(s_size)
-	bcc	L(Loop)
-
-L(Lend:)
-	movel	R(d1),MEM_PREDEC(res_ptr) /* store least significant limb */
-
-/* Restore used registers from stack frame.  */
-	moveml	MEM_POSTINC(sp),R(d2)-R(d6)/R(a2)
-	rts
-
-/* We loop from least significant end of the arrays, which is only
-   permissable if the source and destination don't overlap, since the
-   function is documented to work for overlapping source and destination.  */
-
-L(Lspecial:)
-	clrl	R(d0)			/* initialize carry */
-	eorw	#1,R(s_size)
-	lsrl	#1,R(s_size)
-	bcc	L(LL1)
-	subql	#1,R(s_size)
-
-L(LLoop:)
-	movel	MEM_POSTINC(s_ptr),R(d2)
-	addxl	R(d2),R(d2)
-	movel	R(d2),MEM_POSTINC(res_ptr)
-L(LL1:)
-	movel	MEM_POSTINC(s_ptr),R(d2)
-	addxl	R(d2),R(d2)
-	movel	R(d2),MEM_POSTINC(res_ptr)
-
-	dbf	R(s_size),L(LLoop)
-	addxl	R(d0),R(d0)		/* save cy in lsb */
-	subl	#0x10000,R(s_size)
-	bcs	L(LLend)
-	lsrl	#1,R(d0)		/* restore cy */
-	bra	L(LLoop)
-
-L(LLend:)
-/* Restore used registers from stack frame.  */
-	moveml	MEM_POSTINC(sp),R(d2)-R(d6)/R(a2)
-	rts
-EPILOG(__gmpn_lshift)
diff --git a/ghc/rts/gmp/mpn/m68k/mc68020/addmul_1.S b/ghc/rts/gmp/mpn/m68k/mc68020/addmul_1.S
deleted file mode 100644
index 6638115d71..0000000000
--- a/ghc/rts/gmp/mpn/m68k/mc68020/addmul_1.S
+++ /dev/null
@@ -1,83 +0,0 @@
-/* mc68020 __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
-   the result to a second limb vector.
-
-Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/*
-  INPUT PARAMETERS
-  res_ptr	(sp + 4)
-  s1_ptr	(sp + 8)
-  s1_size	(sp + 12)
-  s2_limb	(sp + 16)
-*/
-
-#include "asm-syntax.h"
-
-	TEXT
-	ALIGN
-	GLOBL	C_SYMBOL_NAME(__gmpn_addmul_1)
-
-C_SYMBOL_NAME(__gmpn_addmul_1:)
-PROLOG(__gmpn_addmul_1)
-
-#define res_ptr a0
-#define s1_ptr a1
-#define s1_size d2
-#define s2_limb d4
-
-/* Save used registers on the stack.  */
-	moveml	R(d2)-R(d5),MEM_PREDEC(sp)
-
-/* Copy the arguments to registers.  Better use movem?  */
-	movel	MEM_DISP(sp,20),R(res_ptr)
-	movel	MEM_DISP(sp,24),R(s1_ptr)
-	movel	MEM_DISP(sp,28),R(s1_size)
-	movel	MEM_DISP(sp,32),R(s2_limb)
-
-	eorw	#1,R(s1_size)
-	clrl	R(d1)
-	clrl	R(d5)
-	lsrl	#1,R(s1_size)
-	bcc	L(L1)
-	subql	#1,R(s1_size)
-	subl	R(d0),R(d0)		/* (d0,cy) <= (0,0) */
-
-L(Loop:)
-	movel	MEM_POSTINC(s1_ptr),R(d3)
-	mulul	R(s2_limb),R(d1):R(d3)
-	addxl	R(d0),R(d3)
-	addxl	R(d5),R(d1)
-	addl	R(d3),MEM_POSTINC(res_ptr)
-L(L1:)	movel	MEM_POSTINC(s1_ptr),R(d3)
-	mulul	R(s2_limb),R(d0):R(d3)
-	addxl	R(d1),R(d3)
-	addxl	R(d5),R(d0)
-	addl	R(d3),MEM_POSTINC(res_ptr)
-
-	dbf	R(s1_size),L(Loop)
-	addxl	R(d5),R(d0)
-	subl	#0x10000,R(s1_size)
-	bcc	L(Loop)
-
-/* Restore used registers from stack frame.  */
-	moveml	MEM_POSTINC(sp),R(d2)-R(d5)
-
-	rts
-EPILOG(__gmpn_addmul_1)
diff --git a/ghc/rts/gmp/mpn/m68k/mc68020/mul_1.S b/ghc/rts/gmp/mpn/m68k/mc68020/mul_1.S
deleted file mode 100644
index fdd4c39d70..0000000000
--- a/ghc/rts/gmp/mpn/m68k/mc68020/mul_1.S
+++ /dev/null
@@ -1,90 +0,0 @@
-/* mc68020 __gmpn_mul_1 -- Multiply a limb vector with a limb and store
-   the result in a second limb vector.
-
-Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/*
-  INPUT PARAMETERS
-  res_ptr	(sp + 4)
-  s1_ptr	(sp + 8)
-  s1_size	(sp + 12)
-  s2_limb	(sp + 16)
-*/
-
-#include "asm-syntax.h"
-
-	TEXT
-	ALIGN
-	GLOBL	C_SYMBOL_NAME(__gmpn_mul_1)
-
-C_SYMBOL_NAME(__gmpn_mul_1:)
-PROLOG(__gmpn_mul_1)
-
-#define res_ptr a0
-#define s1_ptr a1
-#define s1_size d2
-#define s2_limb d4
-
-/* Save used registers on the stack.  */
-	moveml	R(d2)-R(d4),MEM_PREDEC(sp)
-#if 0
-	movel	R(d2),MEM_PREDEC(sp)
-	movel	R(d3),MEM_PREDEC(sp)
-	movel	R(d4),MEM_PREDEC(sp)
-#endif
-
-/* Copy the arguments to registers.  Better use movem?  */
-	movel	MEM_DISP(sp,16),R(res_ptr)
-	movel	MEM_DISP(sp,20),R(s1_ptr)
-	movel	MEM_DISP(sp,24),R(s1_size)
-	movel	MEM_DISP(sp,28),R(s2_limb)
-
-	eorw	#1,R(s1_size)
-	clrl	R(d1)
-	lsrl	#1,R(s1_size)
-	bcc	L(L1)
-	subql	#1,R(s1_size)
-	subl	R(d0),R(d0)	/* (d0,cy) <= (0,0) */
-
-L(Loop:)
-	movel	MEM_POSTINC(s1_ptr),R(d3)
-	mulul	R(s2_limb),R(d1):R(d3)
-	addxl	R(d0),R(d3)
-	movel	R(d3),MEM_POSTINC(res_ptr)
-L(L1:)	movel	MEM_POSTINC(s1_ptr),R(d3)
-	mulul	R(s2_limb),R(d0):R(d3)
-	addxl	R(d1),R(d3)
-	movel	R(d3),MEM_POSTINC(res_ptr)
-
-	dbf	R(s1_size),L(Loop)
-	clrl	R(d3)
-	addxl	R(d3),R(d0)
-	subl	#0x10000,R(s1_size)
-	bcc	L(Loop)
-
-/* Restore used registers from stack frame.  */
-	moveml	MEM_POSTINC(sp),R(d2)-R(d4)
-#if 0
-	movel	MEM_POSTINC(sp),R(d4)
-	movel	MEM_POSTINC(sp),R(d3)
-	movel	MEM_POSTINC(sp),R(d2)
-#endif
-	rts
-EPILOG(__gmpn_mul_1)
diff --git a/ghc/rts/gmp/mpn/m68k/mc68020/submul_1.S b/ghc/rts/gmp/mpn/m68k/mc68020/submul_1.S
deleted file mode 100644
index 3c36b70166..0000000000
--- a/ghc/rts/gmp/mpn/m68k/mc68020/submul_1.S
+++ /dev/null
@@ -1,83 +0,0 @@
-/* mc68020 __gmpn_submul_1 -- Multiply a limb vector with a limb and subtract
-   the result from a second limb vector.
-
-Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/*
-  INPUT PARAMETERS
-  res_ptr	(sp + 4)
-  s1_ptr	(sp + 8)
-  s1_size	(sp + 12)
-  s2_limb	(sp + 16)
-*/
-
-#include "asm-syntax.h"
-
-	TEXT
-	ALIGN
-	GLOBL	C_SYMBOL_NAME(__gmpn_submul_1)
-
-C_SYMBOL_NAME(__gmpn_submul_1:)
-PROLOG(__gmpn_submul_1)
-
-#define res_ptr a0
-#define s1_ptr a1
-#define s1_size d2
-#define s2_limb d4
-
-/* Save used registers on the stack.  */
-	moveml	R(d2)-R(d5),MEM_PREDEC(sp)
-
-/* Copy the arguments to registers.  Better use movem?  */
-	movel	MEM_DISP(sp,20),R(res_ptr)
-	movel	MEM_DISP(sp,24),R(s1_ptr)
-	movel	MEM_DISP(sp,28),R(s1_size)
-	movel	MEM_DISP(sp,32),R(s2_limb)
-
-	eorw	#1,R(s1_size)
-	clrl	R(d1)
-	clrl	R(d5)
-	lsrl	#1,R(s1_size)
-	bcc	L(L1)
-	subql	#1,R(s1_size)
-	subl	R(d0),R(d0)	/* (d0,cy) <= (0,0) */
-
-L(Loop:)
-	movel	MEM_POSTINC(s1_ptr),R(d3)
-	mulul	R(s2_limb),R(d1):R(d3)
-	addxl	R(d0),R(d3)
-	addxl	R(d5),R(d1)
-	subl	R(d3),MEM_POSTINC(res_ptr)
-L(L1:)	movel	MEM_POSTINC(s1_ptr),R(d3)
-	mulul	R(s2_limb),R(d0):R(d3)
-	addxl	R(d1),R(d3)
-	addxl	R(d5),R(d0)
-	subl	R(d3),MEM_POSTINC(res_ptr)
-
-	dbf	R(s1_size),L(Loop)
-	addxl	R(d5),R(d0)
-	subl	#0x10000,R(s1_size)
-	bcc	L(Loop)
-
-/* Restore used registers from stack frame.  */
-	moveml	MEM_POSTINC(sp),R(d2)-R(d5)
-
-	rts
-EPILOG(__gmpn_submul_1)
diff --git a/ghc/rts/gmp/mpn/m68k/mc68020/udiv.S b/ghc/rts/gmp/mpn/m68k/mc68020/udiv.S
deleted file mode 100644
index d00cf13558..0000000000
--- a/ghc/rts/gmp/mpn/m68k/mc68020/udiv.S
+++ /dev/null
@@ -1,31 +0,0 @@
-/*
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-.text
-	.even
-.globl ___udiv_qrnnd
-___udiv_qrnnd:
-	movel sp@(4),a0
-	movel sp@(8),d1
-	movel sp@(12),d0
-	divul sp@(16),d1:d0
-	movel d1,a0@
-	rts
diff --git a/ghc/rts/gmp/mpn/m68k/mc68020/umul.S b/ghc/rts/gmp/mpn/m68k/mc68020/umul.S
deleted file mode 100644
index a34ae6c543..0000000000
--- a/ghc/rts/gmp/mpn/m68k/mc68020/umul.S
+++ /dev/null
@@ -1,31 +0,0 @@
-/*
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-.text
-	.even
-.globl ___umul_ppmm
-___umul_ppmm:
-	movel sp@(4),a0
-	movel sp@(8),d1
-	movel sp@(12),d0
-	mulul d0,d0:d1
-	movel d1,a0@
-	rts
diff --git a/ghc/rts/gmp/mpn/m68k/rshift.S b/ghc/rts/gmp/mpn/m68k/rshift.S
deleted file mode 100644
index b47a48e52a..0000000000
--- a/ghc/rts/gmp/mpn/m68k/rshift.S
+++ /dev/null
@@ -1,149 +0,0 @@
-/* mc68020 __gmpn_rshift -- Shift right a low-level natural-number integer.
-
-Copyright (C) 1996, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/*
-  INPUT PARAMETERS
-  res_ptr	(sp + 4)
-  s_ptr		(sp + 8)
-  s_size	(sp + 16)
-  cnt		(sp + 12)
-*/
-
-#include "asm-syntax.h"
-
-#define res_ptr a1
-#define s_ptr a0
-#define s_size d6
-#define cnt d4
-
-	TEXT
-	ALIGN
-	GLOBL	C_SYMBOL_NAME(__gmpn_rshift)
-
-C_SYMBOL_NAME(__gmpn_rshift:)
-PROLOG(__gmpn_rshift)
-/* Save used registers on the stack.  */
-	moveml	R(d2)-R(d6)/R(a2),MEM_PREDEC(sp)
-
-/* Copy the arguments to registers.  */
-	movel	MEM_DISP(sp,28),R(res_ptr)
-	movel	MEM_DISP(sp,32),R(s_ptr)
-	movel	MEM_DISP(sp,36),R(s_size)
-	movel	MEM_DISP(sp,40),R(cnt)
-
-	moveql	#1,R(d5)
-	cmpl	R(d5),R(cnt)
-	bne	L(Lnormal)
-	cmpl	R(res_ptr),R(s_ptr)
-	bls	L(Lspecial)		/* jump if res_ptr >= s_ptr */
-#if (defined (__mc68020__) || defined (__NeXT__) || defined(mc68020))
-	lea	MEM_INDX1(res_ptr,s_size,l,4),R(a2)
-#else /* not mc68020 */
-	movel	R(s_size),R(d0)
-	asll	#2,R(d0)
-	lea	MEM_INDX(res_ptr,d0,l),R(a2)
-#endif
-	cmpl	R(s_ptr),R(a2)
-	bls	L(Lspecial)		/* jump if s_ptr >= res_ptr + s_size */
-
-L(Lnormal:)
-	moveql	#32,R(d5)
-	subl	R(cnt),R(d5)
-	movel	MEM_POSTINC(s_ptr),R(d2)
-	movel	R(d2),R(d0)
-	lsll	R(d5),R(d0)		/* compute carry limb */
-
-	lsrl	R(cnt),R(d2)
-	movel	R(d2),R(d1)
-	subql	#1,R(s_size)
-	beq	L(Lend)
-	lsrl	#1,R(s_size)
-	bcs	L(L1)
-	subql	#1,R(s_size)
-
-L(Loop:)
-	movel	MEM_POSTINC(s_ptr),R(d2)
-	movel	R(d2),R(d3)
-	lsll	R(d5),R(d3)
-	orl	R(d3),R(d1)
-	movel	R(d1),MEM_POSTINC(res_ptr)
-	lsrl	R(cnt),R(d2)
-L(L1:)
-	movel	MEM_POSTINC(s_ptr),R(d1)
-	movel	R(d1),R(d3)
-	lsll	R(d5),R(d3)
-	orl	R(d3),R(d2)
-	movel	R(d2),MEM_POSTINC(res_ptr)
-	lsrl	R(cnt),R(d1)
-
-	dbf	R(s_size),L(Loop)
-	subl	#0x10000,R(s_size)
-	bcc	L(Loop)
-
-L(Lend:)
-	movel	R(d1),MEM(res_ptr) /* store most significant limb */
-
-/* Restore used registers from stack frame.  */
-	moveml	MEM_POSTINC(sp),R(d2)-R(d6)/R(a2)
-	rts
-
-/* We loop from most significant end of the arrays, which is only
-   permissable if the source and destination don't overlap, since the
-   function is documented to work for overlapping source and destination.  */
-
-L(Lspecial:)
-#if (defined (__mc68020__) || defined (__NeXT__) || defined(mc68020))
-	lea	MEM_INDX1(s_ptr,s_size,l,4),R(s_ptr)
-	lea	MEM_INDX1(res_ptr,s_size,l,4),R(res_ptr)
-#else /* not mc68000 */
-	movel	R(s_size),R(d0)
-	asll	#2,R(d0)
-	addl	R(s_size),R(s_ptr)
-	addl	R(s_size),R(res_ptr)
-#endif
-
-	clrl	R(d0)			/* initialize carry */
-	eorw	#1,R(s_size)
-	lsrl	#1,R(s_size)
-	bcc	L(LL1)
-	subql	#1,R(s_size)
-
-L(LLoop:)
-	movel	MEM_PREDEC(s_ptr),R(d2)
-	roxrl	#1,R(d2)
-	movel	R(d2),MEM_PREDEC(res_ptr)
-L(LL1:)
-	movel	MEM_PREDEC(s_ptr),R(d2)
-	roxrl	#1,R(d2)
-	movel	R(d2),MEM_PREDEC(res_ptr)
-
-	dbf	R(s_size),L(LLoop)
-	roxrl	#1,R(d0)		/* save cy in msb */
-	subl	#0x10000,R(s_size)
-	bcs	L(LLend)
-	addl	R(d0),R(d0)		/* restore cy */
-	bra	L(LLoop)
-
-L(LLend:)
-/* Restore used registers from stack frame.  */
-	moveml	MEM_POSTINC(sp),R(d2)-R(d6)/R(a2)
-	rts
-EPILOG(__gmpn_rshift)
diff --git a/ghc/rts/gmp/mpn/m68k/sub_n.S b/ghc/rts/gmp/mpn/m68k/sub_n.S
deleted file mode 100644
index ce45b24db5..0000000000
--- a/ghc/rts/gmp/mpn/m68k/sub_n.S
+++ /dev/null
@@ -1,79 +0,0 @@
-/* mc68020 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
-   store difference in a third limb vector.
-
-Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/*
-  INPUT PARAMETERS
-  res_ptr	(sp + 4)
-  s1_ptr	(sp + 8)
-  s2_ptr	(sp + 16)
-  size		(sp + 12)
-*/
-
-#include "asm-syntax.h"
-
-	TEXT
-	ALIGN
-	GLOBL	C_SYMBOL_NAME(__gmpn_sub_n)
-
-C_SYMBOL_NAME(__gmpn_sub_n:)
-PROLOG(__gmpn_sub_n)
-/* Save used registers on the stack.  */
-	movel	R(d2),MEM_PREDEC(sp)
-	movel	R(a2),MEM_PREDEC(sp)
-
-/* Copy the arguments to registers.  Better use movem?  */
-	movel	MEM_DISP(sp,12),R(a2)
-	movel	MEM_DISP(sp,16),R(a0)
-	movel	MEM_DISP(sp,20),R(a1)
-	movel	MEM_DISP(sp,24),R(d2)
-
-	eorw	#1,R(d2)
-	lsrl	#1,R(d2)
-	bcc	L(L1)
-	subql	#1,R(d2)	/* clears cy as side effect */
-
-L(Loop:)
-	movel	MEM_POSTINC(a0),R(d0)
-	movel	MEM_POSTINC(a1),R(d1)
-	subxl	R(d1),R(d0)
-	movel	R(d0),MEM_POSTINC(a2)
-L(L1:)	movel	MEM_POSTINC(a0),R(d0)
-	movel	MEM_POSTINC(a1),R(d1)
-	subxl	R(d1),R(d0)
-	movel	R(d0),MEM_POSTINC(a2)
-
-	dbf	R(d2),L(Loop)		/* loop until 16 lsb of %4 == -1 */
-	subxl	R(d0),R(d0)	/* d0 <= -cy; save cy as 0 or -1 in d0 */
-	subl	#0x10000,R(d2)
-	bcs	L(L2)
-	addl	R(d0),R(d0)	/* restore cy */
-	bra	L(Loop)
-
-L(L2:)
-	negl	R(d0)
-
-/* Restore used registers from stack frame.  */
-	movel	MEM_POSTINC(sp),R(a2)
-	movel	MEM_POSTINC(sp),R(d2)
-
-	rts
-EPILOG(__gmpn_sub_n)
diff --git a/ghc/rts/gmp/mpn/m68k/syntax.h b/ghc/rts/gmp/mpn/m68k/syntax.h
deleted file mode 100644
index 9eec279c06..0000000000
--- a/ghc/rts/gmp/mpn/m68k/syntax.h
+++ /dev/null
@@ -1,177 +0,0 @@
-/* asm.h -- Definitions for 68k syntax variations.
-
-Copyright (C) 1992, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.  */
-
-#undef ALIGN
-
-#ifdef MIT_SYNTAX
-#define PROLOG(name)
-#define EPILOG(name)
-#define R(r)r
-#define MEM(base)base@
-#define MEM_DISP(base,displacement)base@(displacement)
-#define MEM_INDX(base,idx,size_suffix)base@(idx:size_suffix)
-#define MEM_INDX1(base,idx,size_suffix,scale)base@(idx:size_suffix:scale)
-#define MEM_PREDEC(memory_base)memory_base@-
-#define MEM_POSTINC(memory_base)memory_base@+
-#define L(label) label
-#define TEXT .text
-#define ALIGN .even
-#define GLOBL .globl
-#define moveql moveq
-/* Use variable sized opcodes.  */
-#define bcc jcc
-#define bcs jcs
-#define bls jls
-#define beq jeq
-#define bne jne
-#define bra jra
-#endif
-
-#ifdef SONY_SYNTAX
-#define PROLOG(name)
-#define EPILOG(name)
-#define R(r)r
-#define MEM(base)(base)
-#define MEM_DISP(base,displacement)(displacement,base)
-#define MEM_INDX(base,idx,size_suffix)(base,idx.size_suffix)
-#define MEM_INDX1(base,idx,size_suffix,scale)(base,idx.size_suffix*scale)
-#define MEM_PREDEC(memory_base)-(memory_base)
-#define MEM_POSTINC(memory_base)(memory_base)+
-#define L(label) label
-#define TEXT .text
-#define ALIGN .even
-#define GLOBL .globl
-#endif
-
-#ifdef MOTOROLA_SYNTAX
-#define PROLOG(name)
-#define EPILOG(name)
-#define R(r)r
-#define MEM(base)(base)
-#define MEM_DISP(base,displacement)(displacement,base)
-#define MEM_INDX(base,idx,size_suffix)(base,idx.size_suffix)
-#define MEM_INDX1(base,idx,size_suffix,scale)(base,idx.size_suffix*scale)
-#define MEM_PREDEC(memory_base)-(memory_base)
-#define MEM_POSTINC(memory_base)(memory_base)+
-#define L(label) label
-#define TEXT
-#define ALIGN
-#define GLOBL XDEF
-#define lea LEA
-#define movel MOVE.L
-#define moveml MOVEM.L
-#define moveql MOVEQ.L
-#define cmpl CMP.L
-#define orl OR.L
-#define clrl CLR.L
-#define eorw EOR.W
-#define lsrl LSR.L
-#define lsll LSL.L
-#define roxrl ROXR.L
-#define roxll ROXL.L
-#define addl ADD.L
-#define addxl ADDX.L
-#define addql ADDQ.L
-#define subl SUB.L
-#define subxl SUBX.L
-#define subql SUBQ.L
-#define negl NEG.L
-#define mulul MULU.L
-#define bcc BCC
-#define bcs BCS
-#define bls BLS
-#define beq BEQ
-#define bne BNE
-#define bra BRA
-#define dbf DBF
-#define rts RTS
-#define d0 D0
-#define d1 D1
-#define d2 D2
-#define d3 D3
-#define d4 D4
-#define d5 D5
-#define d6 D6
-#define d7 D7
-#define a0 A0
-#define a1 A1
-#define a2 A2
-#define a3 A3
-#define a4 A4
-#define a5 A5
-#define a6 A6
-#define a7 A7
-#define sp SP
-#endif
-
-#ifdef ELF_SYNTAX
-#define PROLOG(name) .type name,@function
-#define EPILOG(name) .size name,.-name
-#define MEM(base)(R(base))
-#define MEM_DISP(base,displacement)(displacement,R(base))
-#define MEM_PREDEC(memory_base)-(R(memory_base))
-#define MEM_POSTINC(memory_base)(R(memory_base))+
-#ifdef __STDC__
-#define R_(r)%##r
-#define R(r)R_(r)
-#define MEM_INDX_(base,idx,size_suffix)(R(base),R(idx##.##size_suffix))
-#define MEM_INDX(base,idx,size_suffix)MEM_INDX_(base,idx,size_suffix)
-#define MEM_INDX1_(base,idx,size_suffix,scale)(R(base),R(idx##.##size_suffix*scale))
-#define MEM_INDX1(base,idx,size_suffix,scale)MEM_INDX1_(base,idx,size_suffix,scale)
-#define L(label) .##label
-#else
-#define R(r)%/**/r
-#define MEM_INDX(base,idx,size_suffix)(R(base),R(idx).size_suffix)
-#define MEM_INDX1(base,idx,size_suffix,scale)(R(base),R(idx).size_suffix*scale)
-#define L(label) ./**/label
-#endif
-#define TEXT .text
-#define ALIGN .align 2
-#define GLOBL .globl
-#define bcc jbcc
-#define bcs jbcs
-#define bls jbls
-#define beq jbeq
-#define bne jbne
-#define bra jbra
-#endif
-
-#if defined (SONY_SYNTAX) || defined (ELF_SYNTAX)
-#define movel move.l
-#define moveml movem.l
-#define moveql moveq.l
-#define cmpl cmp.l
-#define orl or.l
-#define clrl clr.l
-#define eorw eor.w
-#define lsrl lsr.l
-#define lsll lsl.l
-#define roxrl roxr.l
-#define roxll roxl.l
-#define addl add.l
-#define addxl addx.l
-#define addql addq.l
-#define subl sub.l
-#define subxl subx.l
-#define subql subq.l
-#define negl neg.l
-#define mulul mulu.l
-#endif
diff --git a/ghc/rts/gmp/mpn/m88k/add_n.s b/ghc/rts/gmp/mpn/m88k/add_n.s
deleted file mode 100644
index 0b776c618a..0000000000
--- a/ghc/rts/gmp/mpn/m88k/add_n.s
+++ /dev/null
@@ -1,104 +0,0 @@
-; mc88100 __gmpn_add -- Add two limb vectors of the same length > 0 and store
-; sum in a third limb vector.
-
-; Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	r2
-; s1_ptr	r3
-; s2_ptr	r4
-; size		r5
-
-; This code has been optimized to run one instruction per clock, avoiding
-; load stalls and writeback contention.  As a result, the instruction
-; order is not always natural.
-
-; The speed is about 4.6 clocks/limb + 18 clocks/limb-vector on an 88100,
-; but on the 88110, it seems to run much slower, 6.6 clocks/limb.
-
-	text
-	align	 16
-	global	 ___gmpn_add_n
-___gmpn_add_n:
-	ld	r6,r3,0			; read first limb from s1_ptr
-	extu	r10,r5,3
-	ld	r7,r4,0			; read first limb from s2_ptr
-
-	subu.co	r5,r0,r5		; (clear carry as side effect)
-	mak	r5,r5,3<4>
-	bcnd	eq0,r5,Lzero
-
-	or	r12,r0,lo16(Lbase)
-	or.u	r12,r12,hi16(Lbase)
-	addu	r12,r12,r5		; r12 is address for entering in loop
-
-	extu	r5,r5,2			; divide by 4
-	subu	r2,r2,r5		; adjust res_ptr
-	subu	r3,r3,r5		; adjust s1_ptr
-	subu	r4,r4,r5		; adjust s2_ptr
-
-	or	r8,r6,r0
-
-	jmp.n	r12
-	 or	r9,r7,r0
-
-Loop:	addu	r3,r3,32
-	st	r8,r2,28
-	addu	r4,r4,32
-	ld	r6,r3,0
-	addu	r2,r2,32
-	ld	r7,r4,0
-Lzero:	subu	r10,r10,1		; add 0 + 8r limbs (adj loop cnt)
-Lbase:	ld	r8,r3,4
-	addu.cio r6,r6,r7
-	ld	r9,r4,4
-	st	r6,r2,0
-	ld	r6,r3,8			; add 7 + 8r limbs
-	addu.cio r8,r8,r9
-	ld	r7,r4,8
-	st	r8,r2,4
-	ld	r8,r3,12		; add 6 + 8r limbs
-	addu.cio r6,r6,r7
-	ld	r9,r4,12
-	st	r6,r2,8
-	ld	r6,r3,16		; add 5 + 8r limbs
-	addu.cio r8,r8,r9
-	ld	r7,r4,16
-	st	r8,r2,12
-	ld	r8,r3,20		; add 4 + 8r limbs
-	addu.cio r6,r6,r7
-	ld	r9,r4,20
-	st	r6,r2,16
-	ld	r6,r3,24		; add 3 + 8r limbs
-	addu.cio r8,r8,r9
-	ld	r7,r4,24
-	st	r8,r2,20
-	ld	r8,r3,28		; add 2 + 8r limbs
-	addu.cio r6,r6,r7
-	ld	r9,r4,28
-	st	r6,r2,24
-	bcnd.n	ne0,r10,Loop		; add 1 + 8r limbs
-	 addu.cio r8,r8,r9
-
-	st	r8,r2,28		; store most significant limb
-
-	jmp.n	 r1
-	 addu.ci r2,r0,r0		; return carry-out from most sign. limb
diff --git a/ghc/rts/gmp/mpn/m88k/mc88110/add_n.S b/ghc/rts/gmp/mpn/m88k/mc88110/add_n.S
deleted file mode 100644
index 843a50dded..0000000000
--- a/ghc/rts/gmp/mpn/m88k/mc88110/add_n.S
+++ /dev/null
@@ -1,200 +0,0 @@
-; mc88110 __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
-; sum in a third limb vector.
-
-; Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-#define res_ptr	r2
-#define s1_ptr	r3
-#define s2_ptr	r4
-#define size	r5
-
-#include "sysdep.h"
-
-	text
-	align	16
-	global	C_SYMBOL_NAME(__gmpn_add_n)
-C_SYMBOL_NAME(__gmpn_add_n):
-	addu.co	 r0,r0,r0		; clear cy flag
-	xor	 r12,s2_ptr,res_ptr
-	bb1	 2,r12,L1
-; **  V1a  **
-L0:	bb0	 2,res_ptr,L_v1		; branch if res_ptr is aligned?
-/* Add least significant limb separately to align res_ptr and s2_ptr */
-	ld	 r10,s1_ptr,0
-	addu	 s1_ptr,s1_ptr,4
-	ld	 r8,s2_ptr,0
-	addu	 s2_ptr,s2_ptr,4
-	subu	 size,size,1
-	addu.co	 r6,r10,r8
-	st	 r6,res_ptr,0
-	addu	 res_ptr,res_ptr,4
-L_v1:	cmp	 r12,size,2
-	bb1	 lt,r12,Lend2
-
-	ld	 r10,s1_ptr,0
-	ld	 r12,s1_ptr,4
-	ld.d	 r8,s2_ptr,0
-	subu	 size,size,10
-	bcnd	 lt0,size,Lfin1
-/* Add blocks of 8 limbs until less than 8 limbs remain */
-	align	 8
-Loop1:	subu	 size,size,8
-	addu.cio r6,r10,r8
-	ld	 r10,s1_ptr,8
-	addu.cio r7,r12,r9
-	ld	 r12,s1_ptr,12
-	ld.d	 r8,s2_ptr,8
-	st.d	 r6,res_ptr,0
-	addu.cio r6,r10,r8
-	ld	 r10,s1_ptr,16
-	addu.cio r7,r12,r9
-	ld	 r12,s1_ptr,20
-	ld.d	 r8,s2_ptr,16
-	st.d	 r6,res_ptr,8
-	addu.cio r6,r10,r8
-	ld	 r10,s1_ptr,24
-	addu.cio r7,r12,r9
-	ld	 r12,s1_ptr,28
-	ld.d	 r8,s2_ptr,24
-	st.d	 r6,res_ptr,16
-	addu.cio r6,r10,r8
-	ld	 r10,s1_ptr,32
-	addu.cio r7,r12,r9
-	ld	 r12,s1_ptr,36
-	addu	 s1_ptr,s1_ptr,32
-	ld.d	 r8,s2_ptr,32
-	addu	 s2_ptr,s2_ptr,32
-	st.d	 r6,res_ptr,24
-	addu	 res_ptr,res_ptr,32
-	bcnd	 ge0,size,Loop1
-
-Lfin1:	addu	 size,size,8-2
-	bcnd	 lt0,size,Lend1
-/* Add blocks of 2 limbs until less than 2 limbs remain */
-Loope1:	addu.cio r6,r10,r8
-	ld	 r10,s1_ptr,8
-	addu.cio r7,r12,r9
-	ld	 r12,s1_ptr,12
-	ld.d	 r8,s2_ptr,8
-	st.d	 r6,res_ptr,0
-	subu	 size,size,2
-	addu	 s1_ptr,s1_ptr,8
-	addu	 s2_ptr,s2_ptr,8
-	addu	 res_ptr,res_ptr,8
-	bcnd	 ge0,size,Loope1
-Lend1:	addu.cio r6,r10,r8
-	addu.cio r7,r12,r9
-	st.d	 r6,res_ptr,0
-
-	bb0	 0,size,Lret1
-/* Add last limb */
-	ld	 r10,s1_ptr,8
-	ld	 r8,s2_ptr,8
-	addu.cio r6,r10,r8
-	st	 r6,res_ptr,8
-
-Lret1:	jmp.n	 r1
-	addu.ci	 r2,r0,r0		; return carry-out from most sign. limb
-
-L1:	xor	 r12,s1_ptr,res_ptr
-	bb1	 2,r12,L2
-; **  V1b  **
-	or	 r12,r0,s2_ptr
-	or	 s2_ptr,r0,s1_ptr
-	or	 s1_ptr,r0,r12
-	br	 L0
-
-; **  V2  **
-/* If we come here, the alignment of s1_ptr and res_ptr as well as the
-   alignment of s2_ptr and res_ptr differ.  Since there are only two ways
-   things can be aligned (that we care about) we now know that the alignment
-   of s1_ptr and s2_ptr are the same.  */
-
-L2:	cmp	 r12,size,1
-	bb1	 eq,r12,Ljone
-	bb0	 2,s1_ptr,L_v2		; branch if s1_ptr is aligned
-/* Add least significant limb separately to align res_ptr and s2_ptr */
-	ld	 r10,s1_ptr,0
-	addu	 s1_ptr,s1_ptr,4
-	ld	 r8,s2_ptr,0
-	addu	 s2_ptr,s2_ptr,4
-	subu	 size,size,1
-	addu.co	 r6,r10,r8
-	st	 r6,res_ptr,0
-	addu	 res_ptr,res_ptr,4
-
-L_v2:	subu	 size,size,8
-	bcnd	 lt0,size,Lfin2
-/* Add blocks of 8 limbs until less than 8 limbs remain */
-	align	 8
-Loop2:	subu	 size,size,8
-	ld.d	 r8,s1_ptr,0
-	ld.d	 r6,s2_ptr,0
-	addu.cio r8,r8,r6
-	st	 r8,res_ptr,0
-	addu.cio r9,r9,r7
-	st	 r9,res_ptr,4
-	ld.d	 r8,s1_ptr,8
-	ld.d	 r6,s2_ptr,8
-	addu.cio r8,r8,r6
-	st	 r8,res_ptr,8
-	addu.cio r9,r9,r7
-	st	 r9,res_ptr,12
-	ld.d	 r8,s1_ptr,16
-	ld.d	 r6,s2_ptr,16
-	addu.cio r8,r8,r6
-	st	 r8,res_ptr,16
-	addu.cio r9,r9,r7
-	st	 r9,res_ptr,20
-	ld.d	 r8,s1_ptr,24
-	ld.d	 r6,s2_ptr,24
-	addu.cio r8,r8,r6
-	st	 r8,res_ptr,24
-	addu.cio r9,r9,r7
-	st	 r9,res_ptr,28
-	addu	 s1_ptr,s1_ptr,32
-	addu	 s2_ptr,s2_ptr,32
-	addu	 res_ptr,res_ptr,32
-	bcnd	 ge0,size,Loop2
-
-Lfin2:	addu	 size,size,8-2
-	bcnd	 lt0,size,Lend2
-Loope2:	ld.d	 r8,s1_ptr,0
-	ld.d	 r6,s2_ptr,0
-	addu.cio r8,r8,r6
-	st	 r8,res_ptr,0
-	addu.cio r9,r9,r7
-	st	 r9,res_ptr,4
-	subu	 size,size,2
-	addu	 s1_ptr,s1_ptr,8
-	addu	 s2_ptr,s2_ptr,8
-	addu	 res_ptr,res_ptr,8
-	bcnd	 ge0,size,Loope2
-Lend2:	bb0	 0,size,Lret2
-/* Add last limb */
-Ljone:	ld	 r10,s1_ptr,0
-	ld	 r8,s2_ptr,0
-	addu.cio r6,r10,r8
-	st	 r6,res_ptr,0
-
-Lret2:	jmp.n	 r1
-	addu.ci	 r2,r0,r0		; return carry-out from most sign. limb
diff --git a/ghc/rts/gmp/mpn/m88k/mc88110/addmul_1.s b/ghc/rts/gmp/mpn/m88k/mc88110/addmul_1.s
deleted file mode 100644
index 7d97c87c79..0000000000
--- a/ghc/rts/gmp/mpn/m88k/mc88110/addmul_1.s
+++ /dev/null
@@ -1,61 +0,0 @@
-; mc88110 __gmpn_addmul_1 -- Multiply a limb vector with a single limb and
-; store the product in a second limb vector.
-
-; Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	r2
-; s1_ptr	r3
-; size		r4
-; s2_limb	r5
-
-	text
-	align	16
-	global	___gmpn_addmul_1
-___gmpn_addmul_1:
-	lda	 r3,r3[r4]
-	lda	 r8,r2[r4]		; RES_PTR in r8 since r2 is retval
-	subu	 r4,r0,r4
-	addu.co	 r2,r0,r0		; r2 = cy = 0
-
-	ld	 r6,r3[r4]
-	addu	 r4,r4,1
-	subu	 r8,r8,4
-	bcnd.n	 eq0,r4,Lend
-	 mulu.d	 r10,r6,r5
-
-Loop:	ld	 r7,r8[r4]
-	ld	 r6,r3[r4]
-	addu.cio r9,r11,r2
-	addu.ci	 r2,r10,r0
-	addu.co	 r9,r9,r7
-	st	 r9,r8[r4]
-	addu	 r4,r4,1
-	mulu.d	 r10,r6,r5
-	bcnd	 ne0,r4,Loop
-
-Lend:	ld	 r7,r8,0
-	addu.cio r9,r11,r2
-	addu.ci	 r2,r10,r0
-	addu.co	 r9,r9,r7
-	st	 r9,r8,0
-	jmp.n	 r1
-	 addu.ci r2,r2,r0
diff --git a/ghc/rts/gmp/mpn/m88k/mc88110/mul_1.s b/ghc/rts/gmp/mpn/m88k/mc88110/mul_1.s
deleted file mode 100644
index b8483afa91..0000000000
--- a/ghc/rts/gmp/mpn/m88k/mc88110/mul_1.s
+++ /dev/null
@@ -1,59 +0,0 @@
-; mc88110 __gmpn_mul_1 -- Multiply a limb vector with a single limb and
-; store the product in a second limb vector.
-
-; Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	r2
-; s1_ptr	r3
-; size		r4
-; s2_limb	r5
-
-	text
-	align	16
-	global	___gmpn_mul_1
-___gmpn_mul_1:
-	; Make S1_PTR and RES_PTR point at the end of their blocks
-	; and negate SIZE.
-	lda	 r3,r3[r4]
-	lda	 r8,r2[r4]		; RES_PTR in r8 since r2 is retval
-	subu	 r4,r0,r4
-
-	addu.co	 r2,r0,r0		; r2 = cy = 0
-
-	ld	 r6,r3[r4]
-	addu	 r4,r4,1
-	mulu.d	 r10,r6,r5
-	bcnd.n	 eq0,r4,Lend
-	 subu	 r8,r8,8
-
-Loop:	ld	 r6,r3[r4]
-	addu.cio r9,r11,r2
-	or	 r2,r10,r0		; could be avoided if unrolled
-	addu	 r4,r4,1
-	mulu.d	 r10,r6,r5
-	bcnd.n	 ne0,r4,Loop
-	 st	 r9,r8[r4]
-
-Lend:	addu.cio r9,r11,r2
-	st	 r9,r8,4
-	jmp.n	 r1
-	 addu.ci r2,r10,r0
diff --git a/ghc/rts/gmp/mpn/m88k/mc88110/sub_n.S b/ghc/rts/gmp/mpn/m88k/mc88110/sub_n.S
deleted file mode 100644
index 715a3faf25..0000000000
--- a/ghc/rts/gmp/mpn/m88k/mc88110/sub_n.S
+++ /dev/null
@@ -1,276 +0,0 @@
-; mc88110 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
-; store difference in a third limb vector.
-
-; Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-#define res_ptr	r2
-#define s1_ptr	r3
-#define s2_ptr	r4
-#define size	r5
-
-#include "sysdep.h"
-
-	text
-	align	16
-	global	C_SYMBOL_NAME(__gmpn_sub_n)
-C_SYMBOL_NAME(__gmpn_sub_n):
-	subu.co	 r0,r0,r0		; set cy flag
-	xor	 r12,s2_ptr,res_ptr
-	bb1	 2,r12,L1
-; **  V1a  **
-L0:	bb0	 2,res_ptr,L_v1		; branch if res_ptr is aligned
-/* Add least significant limb separately to align res_ptr and s2_ptr */
-	ld	 r10,s1_ptr,0
-	addu	 s1_ptr,s1_ptr,4
-	ld	 r8,s2_ptr,0
-	addu	 s2_ptr,s2_ptr,4
-	subu	 size,size,1
-	subu.co	 r6,r10,r8
-	st	 r6,res_ptr,0
-	addu	 res_ptr,res_ptr,4
-L_v1:	cmp	 r12,size,2
-	bb1	 lt,r12,Lend2
-
-	ld	 r10,s1_ptr,0
-	ld	 r12,s1_ptr,4
-	ld.d	 r8,s2_ptr,0
-	subu	 size,size,10
-	bcnd	 lt0,size,Lfin1
-/* Add blocks of 8 limbs until less than 8 limbs remain */
-	align	 8
-Loop1:	subu	 size,size,8
-	subu.cio r6,r10,r8
-	ld	 r10,s1_ptr,8
-	subu.cio r7,r12,r9
-	ld	 r12,s1_ptr,12
-	ld.d	 r8,s2_ptr,8
-	st.d	 r6,res_ptr,0
-	subu.cio r6,r10,r8
-	ld	 r10,s1_ptr,16
-	subu.cio r7,r12,r9
-	ld	 r12,s1_ptr,20
-	ld.d	 r8,s2_ptr,16
-	st.d	 r6,res_ptr,8
-	subu.cio r6,r10,r8
-	ld	 r10,s1_ptr,24
-	subu.cio r7,r12,r9
-	ld	 r12,s1_ptr,28
-	ld.d	 r8,s2_ptr,24
-	st.d	 r6,res_ptr,16
-	subu.cio r6,r10,r8
-	ld	 r10,s1_ptr,32
-	subu.cio r7,r12,r9
-	ld	 r12,s1_ptr,36
-	addu	 s1_ptr,s1_ptr,32
-	ld.d	 r8,s2_ptr,32
-	addu	 s2_ptr,s2_ptr,32
-	st.d	 r6,res_ptr,24
-	addu	 res_ptr,res_ptr,32
-	bcnd	 ge0,size,Loop1
-
-Lfin1:	addu	 size,size,8-2
-	bcnd	 lt0,size,Lend1
-/* Add blocks of 2 limbs until less than 2 limbs remain */
-Loope1:	subu.cio r6,r10,r8
-	ld	 r10,s1_ptr,8
-	subu.cio r7,r12,r9
-	ld	 r12,s1_ptr,12
-	ld.d	 r8,s2_ptr,8
-	st.d	 r6,res_ptr,0
-	subu	 size,size,2
-	addu	 s1_ptr,s1_ptr,8
-	addu	 s2_ptr,s2_ptr,8
-	addu	 res_ptr,res_ptr,8
-	bcnd	 ge0,size,Loope1
-Lend1:	subu.cio r6,r10,r8
-	subu.cio r7,r12,r9
-	st.d	 r6,res_ptr,0
-
-	bb0	 0,size,Lret1
-/* Add last limb */
-	ld	 r10,s1_ptr,8
-	ld	 r8,s2_ptr,8
-	subu.cio r6,r10,r8
-	st	 r6,res_ptr,8
-
-Lret1:	addu.ci r2,r0,r0		; return carry-out from most sign. limb
-	jmp.n	 r1
-	 xor	r2,r2,1
-
-L1:	xor	 r12,s1_ptr,res_ptr
-	bb1	 2,r12,L2
-; **  V1b  **
-	bb0	 2,res_ptr,L_v1b	; branch if res_ptr is aligned
-/* Add least significant limb separately to align res_ptr and s1_ptr */
-	ld	 r10,s2_ptr,0
-	addu	 s2_ptr,s2_ptr,4
-	ld	 r8,s1_ptr,0
-	addu	 s1_ptr,s1_ptr,4
-	subu	 size,size,1
-	subu.co	 r6,r8,r10
-	st	 r6,res_ptr,0
-	addu	 res_ptr,res_ptr,4
-L_v1b:	cmp	 r12,size,2
-	bb1	 lt,r12,Lend2
-
-	ld	 r10,s2_ptr,0
-	ld	 r12,s2_ptr,4
-	ld.d	 r8,s1_ptr,0
-	subu	 size,size,10
-	bcnd	 lt0,size,Lfin1b
-/* Add blocks of 8 limbs until less than 8 limbs remain */
-	align	 8
-Loop1b:	subu	 size,size,8
-	subu.cio r6,r8,r10
-	ld	 r10,s2_ptr,8
-	subu.cio r7,r9,r12
-	ld	 r12,s2_ptr,12
-	ld.d	 r8,s1_ptr,8
-	st.d	 r6,res_ptr,0
-	subu.cio r6,r8,r10
-	ld	 r10,s2_ptr,16
-	subu.cio r7,r9,r12
-	ld	 r12,s2_ptr,20
-	ld.d	 r8,s1_ptr,16
-	st.d	 r6,res_ptr,8
-	subu.cio r6,r8,r10
-	ld	 r10,s2_ptr,24
-	subu.cio r7,r9,r12
-	ld	 r12,s2_ptr,28
-	ld.d	 r8,s1_ptr,24
-	st.d	 r6,res_ptr,16
-	subu.cio r6,r8,r10
-	ld	 r10,s2_ptr,32
-	subu.cio r7,r9,r12
-	ld	 r12,s2_ptr,36
-	addu	 s2_ptr,s2_ptr,32
-	ld.d	 r8,s1_ptr,32
-	addu	 s1_ptr,s1_ptr,32
-	st.d	 r6,res_ptr,24
-	addu	 res_ptr,res_ptr,32
-	bcnd	 ge0,size,Loop1b
-
-Lfin1b:	addu	 size,size,8-2
-	bcnd	 lt0,size,Lend1b
-/* Add blocks of 2 limbs until less than 2 limbs remain */
-Loope1b:subu.cio r6,r8,r10
-	ld	 r10,s2_ptr,8
-	subu.cio r7,r9,r12
-	ld	 r12,s2_ptr,12
-	ld.d	 r8,s1_ptr,8
-	st.d	 r6,res_ptr,0
-	subu	 size,size,2
-	addu	 s1_ptr,s1_ptr,8
-	addu	 s2_ptr,s2_ptr,8
-	addu	 res_ptr,res_ptr,8
-	bcnd	 ge0,size,Loope1b
-Lend1b:	subu.cio r6,r8,r10
-	subu.cio r7,r9,r12
-	st.d	 r6,res_ptr,0
-
-	bb0	 0,size,Lret1b
-/* Add last limb */
-	ld	 r10,s2_ptr,8
-	ld	 r8,s1_ptr,8
-	subu.cio r6,r8,r10
-	st	 r6,res_ptr,8
-
-Lret1b:	addu.ci r2,r0,r0		; return carry-out from most sign. limb
-	jmp.n	 r1
-	 xor	r2,r2,1
-
-; **  V2  **
-/* If we come here, the alignment of s1_ptr and res_ptr as well as the
-   alignment of s2_ptr and res_ptr differ.  Since there are only two ways
-   things can be aligned (that we care about) we now know that the alignment
-   of s1_ptr and s2_ptr are the same.  */
-
-L2:	cmp	 r12,size,1
-	bb1	 eq,r12,Ljone
-	bb0	 2,s1_ptr,L_v2		; branch if s1_ptr is aligned
-/* Add least significant limb separately to align res_ptr and s2_ptr */
-	ld	 r10,s1_ptr,0
-	addu	 s1_ptr,s1_ptr,4
-	ld	 r8,s2_ptr,0
-	addu	 s2_ptr,s2_ptr,4
-	subu	 size,size,1
-	subu.co	 r6,r10,r8
-	st	 r6,res_ptr,0
-	addu	 res_ptr,res_ptr,4
-
-L_v2:	subu	 size,size,8
-	bcnd	 lt0,size,Lfin2
-/* Add blocks of 8 limbs until less than 8 limbs remain */
-	align	 8
-Loop2:	subu	 size,size,8
-	ld.d	 r8,s1_ptr,0
-	ld.d	 r6,s2_ptr,0
-	subu.cio r8,r8,r6
-	st	 r8,res_ptr,0
-	subu.cio r9,r9,r7
-	st	 r9,res_ptr,4
-	ld.d	 r8,s1_ptr,8
-	ld.d	 r6,s2_ptr,8
-	subu.cio r8,r8,r6
-	st	 r8,res_ptr,8
-	subu.cio r9,r9,r7
-	st	 r9,res_ptr,12
-	ld.d	 r8,s1_ptr,16
-	ld.d	 r6,s2_ptr,16
-	subu.cio r8,r8,r6
-	st	 r8,res_ptr,16
-	subu.cio r9,r9,r7
-	st	 r9,res_ptr,20
-	ld.d	 r8,s1_ptr,24
-	ld.d	 r6,s2_ptr,24
-	subu.cio r8,r8,r6
-	st	 r8,res_ptr,24
-	subu.cio r9,r9,r7
-	st	 r9,res_ptr,28
-	addu	 s1_ptr,s1_ptr,32
-	addu	 s2_ptr,s2_ptr,32
-	addu	 res_ptr,res_ptr,32
-	bcnd	 ge0,size,Loop2
-
-Lfin2:	addu	 size,size,8-2
-	bcnd	 lt0,size,Lend2
-Loope2:	ld.d	 r8,s1_ptr,0
-	ld.d	 r6,s2_ptr,0
-	subu.cio r8,r8,r6
-	st	 r8,res_ptr,0
-	subu.cio r9,r9,r7
-	st	 r9,res_ptr,4
-	subu	 size,size,2
-	addu	 s1_ptr,s1_ptr,8
-	addu	 s2_ptr,s2_ptr,8
-	addu	 res_ptr,res_ptr,8
-	bcnd	 ge0,size,Loope2
-Lend2:	bb0	 0,size,Lret2
-/* Add last limb */
-Ljone:	ld	 r10,s1_ptr,0
-	ld	 r8,s2_ptr,0
-	subu.cio r6,r10,r8
-	st	 r6,res_ptr,0
-
-Lret2:	addu.ci r2,r0,r0		; return carry-out from most sign. limb
-	jmp.n	 r1
-	 xor	r2,r2,1
diff --git a/ghc/rts/gmp/mpn/m88k/mul_1.s b/ghc/rts/gmp/mpn/m88k/mul_1.s
deleted file mode 100644
index 06370837ef..0000000000
--- a/ghc/rts/gmp/mpn/m88k/mul_1.s
+++ /dev/null
@@ -1,127 +0,0 @@
-; mc88100 __gmpn_mul_1 -- Multiply a limb vector with a single limb and
-; store the product in a second limb vector.
-
-; Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	r2
-; s1_ptr	r3
-; size		r4
-; s2_limb	r5
-
-; Common overhead is about 11 cycles/invocation.
-
-; The speed for S2_LIMB >= 0x10000 is approximately 21 cycles/limb.  (The
-; pipeline stalls 2 cycles due to WB contention.)
-
-; The speed for S2_LIMB < 0x10000 is approximately 16 cycles/limb.  (The
-; pipeline stalls 2 cycles due to WB contention and 1 cycle due to latency.)
-
-; To enhance speed:
-; 1. Unroll main loop 4-8 times.
-; 2. Schedule code to avoid WB contention.  It might be tempting to move the
-;    ld instruction in the loops down to save 2 cycles (less WB contention),
-;    but that looses because the ultimate value will be read from outside
-;    the allocated space.  But if we handle the ultimate multiplication in
-;    the tail, we can do this.
-; 3. Make the multiplication with less instructions.  I think the code for
-;    (S2_LIMB >= 0x10000) is not minimal.
-; With these techniques the (S2_LIMB >= 0x10000) case would run in 17 or
-; less cycles/limb; the (S2_LIMB < 0x10000) case would run in 11
-; cycles/limb.  (Assuming infinite unrolling.)
-
-	text
-	align	 16
-	global	 ___gmpn_mul_1
-___gmpn_mul_1:
-
-	; Make S1_PTR and RES_PTR point at the end of their blocks
-	; and negate SIZE.
-	lda	 r3,r3[r4]
-	lda	 r6,r2[r4]	; RES_PTR in r6 since r2 is retval
-	subu	 r4,r0,r4
-
-	addu.co	 r2,r0,r0	; r2 = cy = 0
-	ld	 r9,r3[r4]
-	mask	 r7,r5,0xffff	; r7 = lo(S2_LIMB)
-	extu	 r8,r5,16	; r8 = hi(S2_LIMB)
-	bcnd.n	 eq0,r8,Lsmall	; jump if (hi(S2_LIMB) == 0)
-	 subu	 r6,r6,4
-
-; General code for any value of S2_LIMB.
-
-	; Make a stack frame and save r25 and r26
-	subu	 r31,r31,16
-	st.d	 r25,r31,8
-
-	; Enter the loop in the middle
-	br.n	L1
-	addu	 r4,r4,1
-
-Loop:	ld	 r9,r3[r4]
-	st	 r26,r6[r4]
-; bcnd	ne0,r0,0		; bubble
-	addu	 r4,r4,1
-L1:	mul	 r26,r9,r5	; low word of product	mul_1	WB ld
-	mask	 r12,r9,0xffff	; r12 = lo(s1_limb)	mask_1
-	mul	 r11,r12,r7	; r11 =  prod_0		mul_2	WB mask_1
-	mul	 r10,r12,r8	; r10 = prod_1a		mul_3
-	extu	 r13,r9,16	; r13 = hi(s1_limb)	extu_1	WB mul_1
-	mul	 r12,r13,r7	; r12 = prod_1b		mul_4	WB extu_1
-	mul	 r25,r13,r8	; r25  = prod_2		mul_5	WB mul_2
-	extu	 r11,r11,16	; r11 = hi(prod_0)	extu_2	WB mul_3
-	addu	 r10,r10,r11	;			addu_1	WB extu_2
-; bcnd	ne0,r0,0		; bubble			WB addu_1
-	addu.co	 r10,r10,r12	;				WB mul_4
-	mask.u	 r10,r10,0xffff	; move the 16 most significant bits...
-	addu.ci	 r10,r10,r0	; ...to the low half of the word...
-	rot	 r10,r10,16	; ...and put carry in pos 16.
-	addu.co	 r26,r26,r2	; add old carry limb
-	bcnd.n	 ne0,r4,Loop
-	 addu.ci r2,r25,r10	; compute new carry limb
-
-	st	 r26,r6[r4]
-	ld.d	 r25,r31,8
-	jmp.n	 r1
-	 addu	 r31,r31,16
-
-; Fast code for S2_LIMB < 0x10000
-Lsmall:
-	; Enter the loop in the middle
-	br.n	SL1
-	addu	 r4,r4,1
-
-SLoop:	ld	 r9,r3[r4]	;
-	st	 r8,r6[r4]	;
-	addu	 r4,r4,1	;
-SL1:	mul	 r8,r9,r5	; low word of product
-	mask	 r12,r9,0xffff	; r12 = lo(s1_limb)
-	extu	 r13,r9,16	; r13 = hi(s1_limb)
-	mul	 r11,r12,r7	; r11 =  prod_0
-	mul	 r12,r13,r7	; r12 = prod_1b
-	addu.cio r8,r8,r2	; add old carry limb
-	extu	 r10,r11,16	; r11 = hi(prod_0)
-	addu	 r10,r10,r12	;
-	bcnd.n	 ne0,r4,SLoop
-	extu	 r2,r10,16	; r2 = new carry limb
-
-	jmp.n	 r1
-	st	 r8,r6[r4]
diff --git a/ghc/rts/gmp/mpn/m88k/sub_n.s b/ghc/rts/gmp/mpn/m88k/sub_n.s
deleted file mode 100644
index 2fd345a135..0000000000
--- a/ghc/rts/gmp/mpn/m88k/sub_n.s
+++ /dev/null
@@ -1,106 +0,0 @@
-; mc88100 __gmpn_sub -- Subtract two limb vectors of the same length > 0 and
-; store difference in a third limb vector.
-
-; Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	r2
-; s1_ptr	r3
-; s2_ptr	r4
-; size		r5
-
-; This code has been optimized to run one instruction per clock, avoiding
-; load stalls and writeback contention.  As a result, the instruction
-; order is not always natural.
-
-; The speed is about 4.6 clocks/limb + 18 clocks/limb-vector on an 88100,
-; but on the 88110, it seems to run much slower, 6.6 clocks/limb.
-
-	text
-	align	 16
-	global	 ___gmpn_sub_n
-___gmpn_sub_n:
-	ld	r6,r3,0			; read first limb from s1_ptr
-	extu	r10,r5,3
-	ld	r7,r4,0			; read first limb from s2_ptr
-
-	subu	r5,r0,r5
-	mak	r5,r5,3<4>
-	bcnd.n	eq0,r5,Lzero
-	subu.co	r0,r0,r0		; initialize carry
-
-	or	r12,r0,lo16(Lbase)
-	or.u	r12,r12,hi16(Lbase)
-	addu	r12,r12,r5		; r12 is address for entering in loop
-
-	extu	r5,r5,2			; divide by 4
-	subu	r2,r2,r5		; adjust res_ptr
-	subu	r3,r3,r5		; adjust s1_ptr
-	subu	r4,r4,r5		; adjust s2_ptr
-
-	or	r8,r6,r0
-
-	jmp.n	r12
-	 or	r9,r7,r0
-
-Loop:	addu	r3,r3,32
-	st	r8,r2,28
-	addu	r4,r4,32
-	ld	r6,r3,0
-	addu	r2,r2,32
-	ld	r7,r4,0
-Lzero:	subu	r10,r10,1		; subtract 0 + 8r limbs (adj loop cnt)
-Lbase:	ld	r8,r3,4
-	subu.cio r6,r6,r7
-	ld	r9,r4,4
-	st	r6,r2,0
-	ld	r6,r3,8			; subtract 7 + 8r limbs
-	subu.cio r8,r8,r9
-	ld	r7,r4,8
-	st	r8,r2,4
-	ld	r8,r3,12		; subtract 6 + 8r limbs
-	subu.cio r6,r6,r7
-	ld	r9,r4,12
-	st	r6,r2,8
-	ld	r6,r3,16		; subtract 5 + 8r limbs
-	subu.cio r8,r8,r9
-	ld	r7,r4,16
-	st	r8,r2,12
-	ld	r8,r3,20		; subtract 4 + 8r limbs
-	subu.cio r6,r6,r7
-	ld	r9,r4,20
-	st	r6,r2,16
-	ld	r6,r3,24		; subtract 3 + 8r limbs
-	subu.cio r8,r8,r9
-	ld	r7,r4,24
-	st	r8,r2,20
-	ld	r8,r3,28		; subtract 2 + 8r limbs
-	subu.cio r6,r6,r7
-	ld	r9,r4,28
-	st	r6,r2,24
-	bcnd.n	ne0,r10,Loop		; subtract 1 + 8r limbs
-	 subu.cio r8,r8,r9
-
-	st	r8,r2,28		; store most significant limb
-
-	addu.ci r2,r0,r0		; return carry-out from most sign. limb
-	jmp.n	 r1
-	 xor	r2,r2,1
diff --git a/ghc/rts/gmp/mpn/mips2/add_n.s b/ghc/rts/gmp/mpn/mips2/add_n.s
deleted file mode 100644
index 5c3c7fc8a1..0000000000
--- a/ghc/rts/gmp/mpn/mips2/add_n.s
+++ /dev/null
@@ -1,120 +0,0 @@
- # MIPS2 __gmpn_add_n -- Add two limb vectors of the same length > 0 and
- # store sum in a third limb vector.
-
- # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # s1_ptr	$5
- # s2_ptr	$6
- # size		$7
-
-	.text
-	.align	2
-	.globl	__gmpn_add_n
-	.ent	__gmpn_add_n
-__gmpn_add_n:
-	.set	noreorder
-	.set	nomacro
-
-	lw	$10,0($5)
-	lw	$11,0($6)
-
-	addiu	$7,$7,-1
-	and	$9,$7,4-1	# number of limbs in first loop
-	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
-	 move	$2,$0
-
-	subu	$7,$7,$9
-
-.Loop0:	addiu	$9,$9,-1
-	lw	$12,4($5)
-	addu	$11,$11,$2
-	lw	$13,4($6)
-	sltu	$8,$11,$2
-	addu	$11,$10,$11
-	sltu	$2,$11,$10
-	sw	$11,0($4)
-	or	$2,$2,$8
-
-	addiu	$5,$5,4
-	addiu	$6,$6,4
-	move	$10,$12
-	move	$11,$13
-	bne	$9,$0,.Loop0
-	 addiu	$4,$4,4
-
-.L0:	beq	$7,$0,.Lend
-	 nop
-
-.Loop:	addiu	$7,$7,-4
-
-	lw	$12,4($5)
-	addu	$11,$11,$2
-	lw	$13,4($6)
-	sltu	$8,$11,$2
-	addu	$11,$10,$11
-	sltu	$2,$11,$10
-	sw	$11,0($4)
-	or	$2,$2,$8
-
-	lw	$10,8($5)
-	addu	$13,$13,$2
-	lw	$11,8($6)
-	sltu	$8,$13,$2
-	addu	$13,$12,$13
-	sltu	$2,$13,$12
-	sw	$13,4($4)
-	or	$2,$2,$8
-
-	lw	$12,12($5)
-	addu	$11,$11,$2
-	lw	$13,12($6)
-	sltu	$8,$11,$2
-	addu	$11,$10,$11
-	sltu	$2,$11,$10
-	sw	$11,8($4)
-	or	$2,$2,$8
-
-	lw	$10,16($5)
-	addu	$13,$13,$2
-	lw	$11,16($6)
-	sltu	$8,$13,$2
-	addu	$13,$12,$13
-	sltu	$2,$13,$12
-	sw	$13,12($4)
-	or	$2,$2,$8
-
-	addiu	$5,$5,16
-	addiu	$6,$6,16
-
-	bne	$7,$0,.Loop
-	 addiu	$4,$4,16
-
-.Lend:	addu	$11,$11,$2
-	sltu	$8,$11,$2
-	addu	$11,$10,$11
-	sltu	$2,$11,$10
-	sw	$11,0($4)
-	j	$31
-	or	$2,$2,$8
-
-	.end	__gmpn_add_n
diff --git a/ghc/rts/gmp/mpn/mips2/addmul_1.s b/ghc/rts/gmp/mpn/mips2/addmul_1.s
deleted file mode 100644
index 1e5037751b..0000000000
--- a/ghc/rts/gmp/mpn/mips2/addmul_1.s
+++ /dev/null
@@ -1,97 +0,0 @@
- # MIPS __gmpn_addmul_1 -- Multiply a limb vector with a single limb and
- # add the product to a second limb vector.
-
- # Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # s1_ptr	$5
- # size		$6
- # s2_limb	$7
-
-	.text
-	.align	 4
-	.globl	 __gmpn_addmul_1
-	.ent	__gmpn_addmul_1
-__gmpn_addmul_1:
-	.set    noreorder
-	.set    nomacro
-
- # warm up phase 0
-	lw	$8,0($5)
-
- # warm up phase 1
-	addiu	$5,$5,4
-	multu	$8,$7
-
-	addiu	$6,$6,-1
-	beq	$6,$0,$LC0
-	 move	$2,$0		# zero cy2
-
-	addiu	$6,$6,-1
-	beq	$6,$0,$LC1
-	lw	$8,0($5)	# load new s1 limb as early as possible
-
-Loop:	lw	$10,0($4)
-	mflo	$3
-	mfhi	$9
-	addiu	$5,$5,4
-	addu	$3,$3,$2	# add old carry limb to low product limb
-	multu	$8,$7
-	lw	$8,0($5)	# load new s1 limb as early as possible
-	addiu	$6,$6,-1	# decrement loop counter
-	sltu	$2,$3,$2	# carry from previous addition -> $2
-	addu	$3,$10,$3
-	sltu	$10,$3,$10
-	addu	$2,$2,$10
-	sw	$3,0($4)
-	addiu	$4,$4,4
-	bne	$6,$0,Loop
-	 addu	$2,$9,$2	# add high product limb and carry from addition
-
- # cool down phase 1
-$LC1:	lw	$10,0($4)
-	mflo	$3
-	mfhi	$9
-	addu	$3,$3,$2
-	sltu	$2,$3,$2
-	multu	$8,$7
-	addu	$3,$10,$3
-	sltu	$10,$3,$10
-	addu	$2,$2,$10
-	sw	$3,0($4)
-	addiu	$4,$4,4
-	addu	$2,$9,$2	# add high product limb and carry from addition
-
- # cool down phase 0
-$LC0:	lw	$10,0($4)
-	mflo	$3
-	mfhi	$9
-	addu	$3,$3,$2
-	sltu	$2,$3,$2
-	addu	$3,$10,$3
-	sltu	$10,$3,$10
-	addu	$2,$2,$10
-	sw	$3,0($4)
-	j	$31
-	addu	$2,$9,$2	# add high product limb and carry from addition
-
-	.end	__gmpn_addmul_1
diff --git a/ghc/rts/gmp/mpn/mips2/lshift.s b/ghc/rts/gmp/mpn/mips2/lshift.s
deleted file mode 100644
index 2ca3a3c800..0000000000
--- a/ghc/rts/gmp/mpn/mips2/lshift.s
+++ /dev/null
@@ -1,95 +0,0 @@
- # MIPS2 __gmpn_lshift --
-
- # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # src_ptr	$5
- # size		$6
- # cnt		$7
-
-	.text
-	.align	2
-	.globl	__gmpn_lshift
-	.ent	__gmpn_lshift
-__gmpn_lshift:
-	.set	noreorder
-	.set	nomacro
-
-	sll	$2,$6,2
-	addu	$5,$5,$2	# make r5 point at end of src
-	lw	$10,-4($5)	# load first limb
-	subu	$13,$0,$7
-	addu	$4,$4,$2	# make r4 point at end of res
-	addiu	$6,$6,-1
-	and	$9,$6,4-1	# number of limbs in first loop
-	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
-	 srl	$2,$10,$13	# compute function result
-
-	subu	$6,$6,$9
-
-.Loop0:	lw	$3,-8($5)
-	addiu	$4,$4,-4
-	addiu	$5,$5,-4
-	addiu	$9,$9,-1
-	sll	$11,$10,$7
-	srl	$12,$3,$13
-	move	$10,$3
-	or	$8,$11,$12
-	bne	$9,$0,.Loop0
-	 sw	$8,0($4)
-
-.L0:	beq	$6,$0,.Lend
-	 nop
-
-.Loop:	lw	$3,-8($5)
-	addiu	$4,$4,-16
-	addiu	$6,$6,-4
-	sll	$11,$10,$7
-	srl	$12,$3,$13
-
-	lw	$10,-12($5)
-	sll	$14,$3,$7
-	or	$8,$11,$12
-	sw	$8,12($4)
-	srl	$9,$10,$13
-
-	lw	$3,-16($5)
-	sll	$11,$10,$7
-	or	$8,$14,$9
-	sw	$8,8($4)
-	srl	$12,$3,$13
-
-	lw	$10,-20($5)
-	sll	$14,$3,$7
-	or	$8,$11,$12
-	sw	$8,4($4)
-	srl	$9,$10,$13
-
-	addiu	$5,$5,-16
-	or	$8,$14,$9
-	bgtz	$6,.Loop
-	 sw	$8,0($4)
-
-.Lend:	sll	$8,$10,$7
-	j	$31
-	sw	$8,-4($4)
-	.end	__gmpn_lshift
diff --git a/ghc/rts/gmp/mpn/mips2/mul_1.s b/ghc/rts/gmp/mpn/mips2/mul_1.s
deleted file mode 100644
index ea8aa26809..0000000000
--- a/ghc/rts/gmp/mpn/mips2/mul_1.s
+++ /dev/null
@@ -1,85 +0,0 @@
- # MIPS __gmpn_mul_1 -- Multiply a limb vector with a single limb and
- # store the product in a second limb vector.
-
- # Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # s1_ptr	$5
- # size		$6
- # s2_limb	$7
-
-	.text
-	.align	 4
-	.globl	 __gmpn_mul_1
-	.ent	__gmpn_mul_1
-__gmpn_mul_1:
-	.set    noreorder
-	.set    nomacro
-
- # warm up phase 0
-	lw	$8,0($5)
-
- # warm up phase 1
-	addiu	$5,$5,4
-	multu	$8,$7
-
-	addiu	$6,$6,-1
-	beq	$6,$0,$LC0
-	 move	$2,$0		# zero cy2
-
-	addiu	$6,$6,-1
-	beq	$6,$0,$LC1
-	lw	$8,0($5)	# load new s1 limb as early as possible
-
-Loop:	mflo	$10
-	mfhi	$9
-	addiu	$5,$5,4
-	addu	$10,$10,$2	# add old carry limb to low product limb
-	multu	$8,$7
-	lw	$8,0($5)	# load new s1 limb as early as possible
-	addiu	$6,$6,-1	# decrement loop counter
-	sltu	$2,$10,$2	# carry from previous addition -> $2
-	sw	$10,0($4)
-	addiu	$4,$4,4
-	bne	$6,$0,Loop
-	 addu	$2,$9,$2	# add high product limb and carry from addition
-
- # cool down phase 1
-$LC1:	mflo	$10
-	mfhi	$9
-	addu	$10,$10,$2
-	sltu	$2,$10,$2
-	multu	$8,$7
-	sw	$10,0($4)
-	addiu	$4,$4,4
-	addu	$2,$9,$2	# add high product limb and carry from addition
-
- # cool down phase 0
-$LC0:	mflo	$10
-	mfhi	$9
-	addu	$10,$10,$2
-	sltu	$2,$10,$2
-	sw	$10,0($4)
-	j	$31
-	addu	$2,$9,$2	# add high product limb and carry from addition
-
-	.end	__gmpn_mul_1
diff --git a/ghc/rts/gmp/mpn/mips2/rshift.s b/ghc/rts/gmp/mpn/mips2/rshift.s
deleted file mode 100644
index 37c8f39cb4..0000000000
--- a/ghc/rts/gmp/mpn/mips2/rshift.s
+++ /dev/null
@@ -1,92 +0,0 @@
- # MIPS2 __gmpn_rshift --
-
- # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # src_ptr	$5
- # size		$6
- # cnt		$7
-
-	.text
-	.align	2
-	.globl	__gmpn_rshift
-	.ent	__gmpn_rshift
-__gmpn_rshift:
-	.set	noreorder
-	.set	nomacro
-
-	lw	$10,0($5)	# load first limb
-	subu	$13,$0,$7
-	addiu	$6,$6,-1
-	and	$9,$6,4-1	# number of limbs in first loop
-	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
-	 sll	$2,$10,$13	# compute function result
-
-	subu	$6,$6,$9
-
-.Loop0:	lw	$3,4($5)
-	addiu	$4,$4,4
-	addiu	$5,$5,4
-	addiu	$9,$9,-1
-	srl	$11,$10,$7
-	sll	$12,$3,$13
-	move	$10,$3
-	or	$8,$11,$12
-	bne	$9,$0,.Loop0
-	 sw	$8,-4($4)
-
-.L0:	beq	$6,$0,.Lend
-	 nop
-
-.Loop:	lw	$3,4($5)
-	addiu	$4,$4,16
-	addiu	$6,$6,-4
-	srl	$11,$10,$7
-	sll	$12,$3,$13
-
-	lw	$10,8($5)
-	srl	$14,$3,$7
-	or	$8,$11,$12
-	sw	$8,-16($4)
-	sll	$9,$10,$13
-
-	lw	$3,12($5)
-	srl	$11,$10,$7
-	or	$8,$14,$9
-	sw	$8,-12($4)
-	sll	$12,$3,$13
-
-	lw	$10,16($5)
-	srl	$14,$3,$7
-	or	$8,$11,$12
-	sw	$8,-8($4)
-	sll	$9,$10,$13
-
-	addiu	$5,$5,16
-	or	$8,$14,$9
-	bgtz	$6,.Loop
-	 sw	$8,-4($4)
-
-.Lend:	srl	$8,$10,$7
-	j	$31
-	sw	$8,0($4)
-	.end	__gmpn_rshift
diff --git a/ghc/rts/gmp/mpn/mips2/sub_n.s b/ghc/rts/gmp/mpn/mips2/sub_n.s
deleted file mode 100644
index 51d34f3ac3..0000000000
--- a/ghc/rts/gmp/mpn/mips2/sub_n.s
+++ /dev/null
@@ -1,120 +0,0 @@
- # MIPS2 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
- # store difference in a third limb vector.
-
- # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # s1_ptr	$5
- # s2_ptr	$6
- # size		$7
-
-	.text
-	.align	2
-	.globl	__gmpn_sub_n
-	.ent	__gmpn_sub_n
-__gmpn_sub_n:
-	.set	noreorder
-	.set	nomacro
-
-	lw	$10,0($5)
-	lw	$11,0($6)
-
-	addiu	$7,$7,-1
-	and	$9,$7,4-1	# number of limbs in first loop
-	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
-	 move	$2,$0
-
-	subu	$7,$7,$9
-
-.Loop0:	addiu	$9,$9,-1
-	lw	$12,4($5)
-	addu	$11,$11,$2
-	lw	$13,4($6)
-	sltu	$8,$11,$2
-	subu	$11,$10,$11
-	sltu	$2,$10,$11
-	sw	$11,0($4)
-	or	$2,$2,$8
-
-	addiu	$5,$5,4
-	addiu	$6,$6,4
-	move	$10,$12
-	move	$11,$13
-	bne	$9,$0,.Loop0
-	 addiu	$4,$4,4
-
-.L0:	beq	$7,$0,.Lend
-	 nop
-
-.Loop:	addiu	$7,$7,-4
-
-	lw	$12,4($5)
-	addu	$11,$11,$2
-	lw	$13,4($6)
-	sltu	$8,$11,$2
-	subu	$11,$10,$11
-	sltu	$2,$10,$11
-	sw	$11,0($4)
-	or	$2,$2,$8
-
-	lw	$10,8($5)
-	addu	$13,$13,$2
-	lw	$11,8($6)
-	sltu	$8,$13,$2
-	subu	$13,$12,$13
-	sltu	$2,$12,$13
-	sw	$13,4($4)
-	or	$2,$2,$8
-
-	lw	$12,12($5)
-	addu	$11,$11,$2
-	lw	$13,12($6)
-	sltu	$8,$11,$2
-	subu	$11,$10,$11
-	sltu	$2,$10,$11
-	sw	$11,8($4)
-	or	$2,$2,$8
-
-	lw	$10,16($5)
-	addu	$13,$13,$2
-	lw	$11,16($6)
-	sltu	$8,$13,$2
-	subu	$13,$12,$13
-	sltu	$2,$12,$13
-	sw	$13,12($4)
-	or	$2,$2,$8
-
-	addiu	$5,$5,16
-	addiu	$6,$6,16
-
-	bne	$7,$0,.Loop
-	 addiu	$4,$4,16
-
-.Lend:	addu	$11,$11,$2
-	sltu	$8,$11,$2
-	subu	$11,$10,$11
-	sltu	$2,$10,$11
-	sw	$11,0($4)
-	j	$31
-	or	$2,$2,$8
-
-	.end	__gmpn_sub_n
diff --git a/ghc/rts/gmp/mpn/mips2/submul_1.s b/ghc/rts/gmp/mpn/mips2/submul_1.s
deleted file mode 100644
index 495dea3ba2..0000000000
--- a/ghc/rts/gmp/mpn/mips2/submul_1.s
+++ /dev/null
@@ -1,97 +0,0 @@
- # MIPS __gmpn_submul_1 -- Multiply a limb vector with a single limb and
- # subtract the product from a second limb vector.
-
- # Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # s1_ptr	$5
- # size		$6
- # s2_limb	$7
-
-	.text
-	.align	 4
-	.globl	 __gmpn_submul_1
-	.ent	__gmpn_submul_1
-__gmpn_submul_1:
-	.set    noreorder
-	.set    nomacro
-
- # warm up phase 0
-	lw	$8,0($5)
-
- # warm up phase 1
-	addiu	$5,$5,4
-	multu	$8,$7
-
-	addiu	$6,$6,-1
-	beq	$6,$0,$LC0
-	 move	$2,$0		# zero cy2
-
-	addiu	$6,$6,-1
-	beq	$6,$0,$LC1
-	lw	$8,0($5)	# load new s1 limb as early as possible
-
-Loop:	lw	$10,0($4)
-	mflo	$3
-	mfhi	$9
-	addiu	$5,$5,4
-	addu	$3,$3,$2	# add old carry limb to low product limb
-	multu	$8,$7
-	lw	$8,0($5)	# load new s1 limb as early as possible
-	addiu	$6,$6,-1	# decrement loop counter
-	sltu	$2,$3,$2	# carry from previous addition -> $2
-	subu	$3,$10,$3
-	sgtu	$10,$3,$10
-	addu	$2,$2,$10
-	sw	$3,0($4)
-	addiu	$4,$4,4
-	bne	$6,$0,Loop
-	 addu	$2,$9,$2	# add high product limb and carry from addition
-
- # cool down phase 1
-$LC1:	lw	$10,0($4)
-	mflo	$3
-	mfhi	$9
-	addu	$3,$3,$2
-	sltu	$2,$3,$2
-	multu	$8,$7
-	subu	$3,$10,$3
-	sgtu	$10,$3,$10
-	addu	$2,$2,$10
-	sw	$3,0($4)
-	addiu	$4,$4,4
-	addu	$2,$9,$2	# add high product limb and carry from addition
-
- # cool down phase 0
-$LC0:	lw	$10,0($4)
-	mflo	$3
-	mfhi	$9
-	addu	$3,$3,$2
-	sltu	$2,$3,$2
-	subu	$3,$10,$3
-	sgtu	$10,$3,$10
-	addu	$2,$2,$10
-	sw	$3,0($4)
-	j	$31
-	addu	$2,$9,$2	# add high product limb and carry from addition
-
-	.end	__gmpn_submul_1
diff --git a/ghc/rts/gmp/mpn/mips2/umul.s b/ghc/rts/gmp/mpn/mips2/umul.s
deleted file mode 100644
index 40e847614c..0000000000
--- a/ghc/rts/gmp/mpn/mips2/umul.s
+++ /dev/null
@@ -1,30 +0,0 @@
- # Copyright (C) 1999 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-	.text
-	.align	2
-	.globl	__umul_ppmm
-	.ent	__umul_ppmm
-__umul_ppmm:
-	multu $5,$6
-	mflo	$3
-	mfhi	$2
-	sw	$3,0($4)
-	j	$31
-	.end	__umul_ppmm
diff --git a/ghc/rts/gmp/mpn/mips3/README b/ghc/rts/gmp/mpn/mips3/README
deleted file mode 100644
index e94b2c7460..0000000000
--- a/ghc/rts/gmp/mpn/mips3/README
+++ /dev/null
@@ -1,23 +0,0 @@
-This directory contains mpn functions optimized for MIPS3.  Example of
-processors that implement MIPS3 are R4000, R4400, R4600, R4700, and R8000.
-
-RELEVANT OPTIMIZATION ISSUES
-
-1. On the R4000 and R4400, branches, both the plain and the "likely" ones,
-   take 3 cycles to execute.  (The fastest possible loop will take 4 cycles,
-   because of the delay insn.)
-
-   On the R4600, branches takes a single cycle
-
-   On the R8000, branches often take no noticable cycles, as they are
-   executed in a separate function unit..
-
-2. The R4000 and R4400 have a load latency of 4 cycles.
-
-3. On the R4000 and R4400, multiplies take a data-dependent number of
-   cycles, contrary to the SGI documentation.  There seem to be 3 or 4
-   possible latencies.
-
-STATUS
-
-Good...
diff --git a/ghc/rts/gmp/mpn/mips3/add_n.s b/ghc/rts/gmp/mpn/mips3/add_n.s
deleted file mode 100644
index adad0beaef..0000000000
--- a/ghc/rts/gmp/mpn/mips3/add_n.s
+++ /dev/null
@@ -1,120 +0,0 @@
- # MIPS3 __gmpn_add_n -- Add two limb vectors of the same length > 0 and
- # store sum in a third limb vector.
-
- # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # s1_ptr	$5
- # s2_ptr	$6
- # size		$7
-
-	.text
-	.align	2
-	.globl	__gmpn_add_n
-	.ent	__gmpn_add_n
-__gmpn_add_n:
-	.set	noreorder
-	.set	nomacro
-
-	ld	$10,0($5)
-	ld	$11,0($6)
-
-	daddiu	$7,$7,-1
-	and	$9,$7,4-1	# number of limbs in first loop
-	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
-	 move	$2,$0
-
-	dsubu	$7,$7,$9
-
-.Loop0:	daddiu	$9,$9,-1
-	ld	$12,8($5)
-	daddu	$11,$11,$2
-	ld	$13,8($6)
-	sltu	$8,$11,$2
-	daddu	$11,$10,$11
-	sltu	$2,$11,$10
-	sd	$11,0($4)
-	or	$2,$2,$8
-
-	daddiu	$5,$5,8
-	daddiu	$6,$6,8
-	move	$10,$12
-	move	$11,$13
-	bne	$9,$0,.Loop0
-	 daddiu	$4,$4,8
-
-.L0:	beq	$7,$0,.Lend
-	 nop
-
-.Loop:	daddiu	$7,$7,-4
-
-	ld	$12,8($5)
-	daddu	$11,$11,$2
-	ld	$13,8($6)
-	sltu	$8,$11,$2
-	daddu	$11,$10,$11
-	sltu	$2,$11,$10
-	sd	$11,0($4)
-	or	$2,$2,$8
-
-	ld	$10,16($5)
-	daddu	$13,$13,$2
-	ld	$11,16($6)
-	sltu	$8,$13,$2
-	daddu	$13,$12,$13
-	sltu	$2,$13,$12
-	sd	$13,8($4)
-	or	$2,$2,$8
-
-	ld	$12,24($5)
-	daddu	$11,$11,$2
-	ld	$13,24($6)
-	sltu	$8,$11,$2
-	daddu	$11,$10,$11
-	sltu	$2,$11,$10
-	sd	$11,16($4)
-	or	$2,$2,$8
-
-	ld	$10,32($5)
-	daddu	$13,$13,$2
-	ld	$11,32($6)
-	sltu	$8,$13,$2
-	daddu	$13,$12,$13
-	sltu	$2,$13,$12
-	sd	$13,24($4)
-	or	$2,$2,$8
-
-	daddiu	$5,$5,32
-	daddiu	$6,$6,32
-
-	bne	$7,$0,.Loop
-	 daddiu	$4,$4,32
-
-.Lend:	daddu	$11,$11,$2
-	sltu	$8,$11,$2
-	daddu	$11,$10,$11
-	sltu	$2,$11,$10
-	sd	$11,0($4)
-	j	$31
-	or	$2,$2,$8
-
-	.end	__gmpn_add_n
diff --git a/ghc/rts/gmp/mpn/mips3/addmul_1.s b/ghc/rts/gmp/mpn/mips3/addmul_1.s
deleted file mode 100644
index d390e2298e..0000000000
--- a/ghc/rts/gmp/mpn/mips3/addmul_1.s
+++ /dev/null
@@ -1,97 +0,0 @@
- # MIPS3 __gmpn_addmul_1 -- Multiply a limb vector with a single limb and
- # add the product to a second limb vector.
-
- # Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # s1_ptr	$5
- # size		$6
- # s2_limb	$7
-
-	.text
-	.align	4
-	.globl	__gmpn_addmul_1
-	.ent	__gmpn_addmul_1
-__gmpn_addmul_1:
-	.set    noreorder
-	.set    nomacro
-
- # warm up phase 0
-	ld	$8,0($5)
-
- # warm up phase 1
-	daddiu	$5,$5,8
-	dmultu	$8,$7
-
-	daddiu	$6,$6,-1
-	beq	$6,$0,$LC0
-	 move	$2,$0		# zero cy2
-
-	daddiu	$6,$6,-1
-	beq	$6,$0,$LC1
-	ld	$8,0($5)	# load new s1 limb as early as possible
-
-Loop:	ld	$10,0($4)
-	mflo	$3
-	mfhi	$9
-	daddiu	$5,$5,8
-	daddu	$3,$3,$2	# add old carry limb to low product limb
-	dmultu	$8,$7
-	ld	$8,0($5)	# load new s1 limb as early as possible
-	daddiu	$6,$6,-1	# decrement loop counter
-	sltu	$2,$3,$2	# carry from previous addition -> $2
-	daddu	$3,$10,$3
-	sltu	$10,$3,$10
-	daddu	$2,$2,$10
-	sd	$3,0($4)
-	daddiu	$4,$4,8
-	bne	$6,$0,Loop
-	 daddu	$2,$9,$2	# add high product limb and carry from addition
-
- # cool down phase 1
-$LC1:	ld	$10,0($4)
-	mflo	$3
-	mfhi	$9
-	daddu	$3,$3,$2
-	sltu	$2,$3,$2
-	dmultu	$8,$7
-	daddu	$3,$10,$3
-	sltu	$10,$3,$10
-	daddu	$2,$2,$10
-	sd	$3,0($4)
-	daddiu	$4,$4,8
-	daddu	$2,$9,$2	# add high product limb and carry from addition
-
- # cool down phase 0
-$LC0:	ld	$10,0($4)
-	mflo	$3
-	mfhi	$9
-	daddu	$3,$3,$2
-	sltu	$2,$3,$2
-	daddu	$3,$10,$3
-	sltu	$10,$3,$10
-	daddu	$2,$2,$10
-	sd	$3,0($4)
-	j	$31
-	daddu	$2,$9,$2	# add high product limb and carry from addition
-
-	.end	__gmpn_addmul_1
diff --git a/ghc/rts/gmp/mpn/mips3/gmp-mparam.h b/ghc/rts/gmp/mpn/mips3/gmp-mparam.h
deleted file mode 100644
index 656e90c7b0..0000000000
--- a/ghc/rts/gmp/mpn/mips3/gmp-mparam.h
+++ /dev/null
@@ -1,58 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 64
-#define BYTES_PER_MP_LIMB 8
-#define BITS_PER_LONGINT 32
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-/* These values are for the R10000 usign the system cc.  */
-/* Generated by tuneup.c, 2000-07-25. */
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD 16
-#endif
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD 32
-#endif
-
-/* Supressed the TOOM3 values as they looked absolutely crazy
-   (698 and 21 respectively) */
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD              58
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD             54
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            82
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD        4
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD         159
-#endif
diff --git a/ghc/rts/gmp/mpn/mips3/lshift.s b/ghc/rts/gmp/mpn/mips3/lshift.s
deleted file mode 100644
index 372606fddf..0000000000
--- a/ghc/rts/gmp/mpn/mips3/lshift.s
+++ /dev/null
@@ -1,95 +0,0 @@
- # MIPS3 __gmpn_lshift --
-
- # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # src_ptr	$5
- # size		$6
- # cnt		$7
-
-	.text
-	.align	2
-	.globl	__gmpn_lshift
-	.ent	__gmpn_lshift
-__gmpn_lshift:
-	.set	noreorder
-	.set	nomacro
-
-	dsll	$2,$6,3
-	daddu	$5,$5,$2	# make r5 point at end of src
-	ld	$10,-8($5)	# load first limb
-	dsubu	$13,$0,$7
-	daddu	$4,$4,$2	# make r4 point at end of res
-	daddiu	$6,$6,-1
-	and	$9,$6,4-1	# number of limbs in first loop
-	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
-	 dsrl	$2,$10,$13	# compute function result
-
-	dsubu	$6,$6,$9
-
-.Loop0:	ld	$3,-16($5)
-	daddiu	$4,$4,-8
-	daddiu	$5,$5,-8
-	daddiu	$9,$9,-1
-	dsll	$11,$10,$7
-	dsrl	$12,$3,$13
-	move	$10,$3
-	or	$8,$11,$12
-	bne	$9,$0,.Loop0
-	 sd	$8,0($4)
-
-.L0:	beq	$6,$0,.Lend
-	 nop
-
-.Loop:	ld	$3,-16($5)
-	daddiu	$4,$4,-32
-	daddiu	$6,$6,-4
-	dsll	$11,$10,$7
-	dsrl	$12,$3,$13
-
-	ld	$10,-24($5)
-	dsll	$14,$3,$7
-	or	$8,$11,$12
-	sd	$8,24($4)
-	dsrl	$9,$10,$13
-
-	ld	$3,-32($5)
-	dsll	$11,$10,$7
-	or	$8,$14,$9
-	sd	$8,16($4)
-	dsrl	$12,$3,$13
-
-	ld	$10,-40($5)
-	dsll	$14,$3,$7
-	or	$8,$11,$12
-	sd	$8,8($4)
-	dsrl	$9,$10,$13
-
-	daddiu	$5,$5,-32
-	or	$8,$14,$9
-	bgtz	$6,.Loop
-	 sd	$8,0($4)
-
-.Lend:	dsll	$8,$10,$7
-	j	$31
-	sd	$8,-8($4)
-	.end	__gmpn_lshift
diff --git a/ghc/rts/gmp/mpn/mips3/mul_1.s b/ghc/rts/gmp/mpn/mips3/mul_1.s
deleted file mode 100644
index 6659e2b4eb..0000000000
--- a/ghc/rts/gmp/mpn/mips3/mul_1.s
+++ /dev/null
@@ -1,85 +0,0 @@
- # MIPS3 __gmpn_mul_1 -- Multiply a limb vector with a single limb and
- # store the product in a second limb vector.
-
- # Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # s1_ptr	$5
- # size		$6
- # s2_limb	$7
-
-	.text
-	.align	4
-	.globl	__gmpn_mul_1
-	.ent	__gmpn_mul_1
-__gmpn_mul_1:
-	.set    noreorder
-	.set    nomacro
-
- # warm up phase 0
-	ld	$8,0($5)
-
- # warm up phase 1
-	daddiu	$5,$5,8
-	dmultu	$8,$7
-
-	daddiu	$6,$6,-1
-	beq	$6,$0,$LC0
-	 move	$2,$0		# zero cy2
-
-	daddiu	$6,$6,-1
-	beq	$6,$0,$LC1
-	ld	$8,0($5)	# load new s1 limb as early as possible
-
-Loop:	mflo	$10
-	mfhi	$9
-	daddiu	$5,$5,8
-	daddu	$10,$10,$2	# add old carry limb to low product limb
-	dmultu	$8,$7
-	ld	$8,0($5)	# load new s1 limb as early as possible
-	daddiu	$6,$6,-1	# decrement loop counter
-	sltu	$2,$10,$2	# carry from previous addition -> $2
-	sd	$10,0($4)
-	daddiu	$4,$4,8
-	bne	$6,$0,Loop
-	 daddu	$2,$9,$2	# add high product limb and carry from addition
-
- # cool down phase 1
-$LC1:	mflo	$10
-	mfhi	$9
-	daddu	$10,$10,$2
-	sltu	$2,$10,$2
-	dmultu	$8,$7
-	sd	$10,0($4)
-	daddiu	$4,$4,8
-	daddu	$2,$9,$2	# add high product limb and carry from addition
-
- # cool down phase 0
-$LC0:	mflo	$10
-	mfhi	$9
-	daddu	$10,$10,$2
-	sltu	$2,$10,$2
-	sd	$10,0($4)
-	j	$31
-	daddu	$2,$9,$2	# add high product limb and carry from addition
-
-	.end	__gmpn_mul_1
diff --git a/ghc/rts/gmp/mpn/mips3/rshift.s b/ghc/rts/gmp/mpn/mips3/rshift.s
deleted file mode 100644
index 59c7fd3492..0000000000
--- a/ghc/rts/gmp/mpn/mips3/rshift.s
+++ /dev/null
@@ -1,92 +0,0 @@
- # MIPS3 __gmpn_rshift --
-
- # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # src_ptr	$5
- # size		$6
- # cnt		$7
-
-	.text
-	.align	2
-	.globl	__gmpn_rshift
-	.ent	__gmpn_rshift
-__gmpn_rshift:
-	.set	noreorder
-	.set	nomacro
-
-	ld	$10,0($5)	# load first limb
-	dsubu	$13,$0,$7
-	daddiu	$6,$6,-1
-	and	$9,$6,4-1	# number of limbs in first loop
-	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
-	 dsll	$2,$10,$13	# compute function result
-
-	dsubu	$6,$6,$9
-
-.Loop0:	ld	$3,8($5)
-	daddiu	$4,$4,8
-	daddiu	$5,$5,8
-	daddiu	$9,$9,-1
-	dsrl	$11,$10,$7
-	dsll	$12,$3,$13
-	move	$10,$3
-	or	$8,$11,$12
-	bne	$9,$0,.Loop0
-	 sd	$8,-8($4)
-
-.L0:	beq	$6,$0,.Lend
-	 nop
-
-.Loop:	ld	$3,8($5)
-	daddiu	$4,$4,32
-	daddiu	$6,$6,-4
-	dsrl	$11,$10,$7
-	dsll	$12,$3,$13
-
-	ld	$10,16($5)
-	dsrl	$14,$3,$7
-	or	$8,$11,$12
-	sd	$8,-32($4)
-	dsll	$9,$10,$13
-
-	ld	$3,24($5)
-	dsrl	$11,$10,$7
-	or	$8,$14,$9
-	sd	$8,-24($4)
-	dsll	$12,$3,$13
-
-	ld	$10,32($5)
-	dsrl	$14,$3,$7
-	or	$8,$11,$12
-	sd	$8,-16($4)
-	dsll	$9,$10,$13
-
-	daddiu	$5,$5,32
-	or	$8,$14,$9
-	bgtz	$6,.Loop
-	 sd	$8,-8($4)
-
-.Lend:	dsrl	$8,$10,$7
-	j	$31
-	sd	$8,0($4)
-	.end	__gmpn_rshift
diff --git a/ghc/rts/gmp/mpn/mips3/sub_n.s b/ghc/rts/gmp/mpn/mips3/sub_n.s
deleted file mode 100644
index c57c824b04..0000000000
--- a/ghc/rts/gmp/mpn/mips3/sub_n.s
+++ /dev/null
@@ -1,120 +0,0 @@
- # MIPS3 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
- # store difference in a third limb vector.
-
- # Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # s1_ptr	$5
- # s2_ptr	$6
- # size		$7
-
-	.text
-	.align	2
-	.globl	__gmpn_sub_n
-	.ent	__gmpn_sub_n
-__gmpn_sub_n:
-	.set	noreorder
-	.set	nomacro
-
-	ld	$10,0($5)
-	ld	$11,0($6)
-
-	daddiu	$7,$7,-1
-	and	$9,$7,4-1	# number of limbs in first loop
-	beq	$9,$0,.L0	# if multiple of 4 limbs, skip first loop
-	 move	$2,$0
-
-	dsubu	$7,$7,$9
-
-.Loop0:	daddiu	$9,$9,-1
-	ld	$12,8($5)
-	daddu	$11,$11,$2
-	ld	$13,8($6)
-	sltu	$8,$11,$2
-	dsubu	$11,$10,$11
-	sltu	$2,$10,$11
-	sd	$11,0($4)
-	or	$2,$2,$8
-
-	daddiu	$5,$5,8
-	daddiu	$6,$6,8
-	move	$10,$12
-	move	$11,$13
-	bne	$9,$0,.Loop0
-	 daddiu	$4,$4,8
-
-.L0:	beq	$7,$0,.Lend
-	 nop
-
-.Loop:	daddiu	$7,$7,-4
-
-	ld	$12,8($5)
-	daddu	$11,$11,$2
-	ld	$13,8($6)
-	sltu	$8,$11,$2
-	dsubu	$11,$10,$11
-	sltu	$2,$10,$11
-	sd	$11,0($4)
-	or	$2,$2,$8
-
-	ld	$10,16($5)
-	daddu	$13,$13,$2
-	ld	$11,16($6)
-	sltu	$8,$13,$2
-	dsubu	$13,$12,$13
-	sltu	$2,$12,$13
-	sd	$13,8($4)
-	or	$2,$2,$8
-
-	ld	$12,24($5)
-	daddu	$11,$11,$2
-	ld	$13,24($6)
-	sltu	$8,$11,$2
-	dsubu	$11,$10,$11
-	sltu	$2,$10,$11
-	sd	$11,16($4)
-	or	$2,$2,$8
-
-	ld	$10,32($5)
-	daddu	$13,$13,$2
-	ld	$11,32($6)
-	sltu	$8,$13,$2
-	dsubu	$13,$12,$13
-	sltu	$2,$12,$13
-	sd	$13,24($4)
-	or	$2,$2,$8
-
-	daddiu	$5,$5,32
-	daddiu	$6,$6,32
-
-	bne	$7,$0,.Loop
-	 daddiu	$4,$4,32
-
-.Lend:	daddu	$11,$11,$2
-	sltu	$8,$11,$2
-	dsubu	$11,$10,$11
-	sltu	$2,$10,$11
-	sd	$11,0($4)
-	j	$31
-	or	$2,$2,$8
-
-	.end	__gmpn_sub_n
diff --git a/ghc/rts/gmp/mpn/mips3/submul_1.s b/ghc/rts/gmp/mpn/mips3/submul_1.s
deleted file mode 100644
index 531f9705a6..0000000000
--- a/ghc/rts/gmp/mpn/mips3/submul_1.s
+++ /dev/null
@@ -1,97 +0,0 @@
- # MIPS3 __gmpn_submul_1 -- Multiply a limb vector with a single limb and
- # subtract the product from a second limb vector.
-
- # Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
-
- # This file is part of the GNU MP Library.
-
- # The GNU MP Library is free software; you can redistribute it and/or modify
- # it under the terms of the GNU Lesser General Public License as published by
- # the Free Software Foundation; either version 2.1 of the License, or (at your
- # option) any later version.
-
- # The GNU MP Library is distributed in the hope that it will be useful, but
- # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
- # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
- # License for more details.
-
- # You should have received a copy of the GNU Lesser General Public License
- # along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
- # the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- # MA 02111-1307, USA.
-
-
- # INPUT PARAMETERS
- # res_ptr	$4
- # s1_ptr	$5
- # size		$6
- # s2_limb	$7
-
-	.text
-	.align	4
-	.globl	__gmpn_submul_1
-	.ent	__gmpn_submul_1
-__gmpn_submul_1:
-	.set    noreorder
-	.set    nomacro
-
- # warm up phase 0
-	ld	$8,0($5)
-
- # warm up phase 1
-	daddiu	$5,$5,8
-	dmultu	$8,$7
-
-	daddiu	$6,$6,-1
-	beq	$6,$0,$LC0
-	 move	$2,$0		# zero cy2
-
-	daddiu	$6,$6,-1
-	beq	$6,$0,$LC1
-	ld	$8,0($5)	# load new s1 limb as early as possible
-
-Loop:	ld	$10,0($4)
-	mflo	$3
-	mfhi	$9
-	daddiu	$5,$5,8
-	daddu	$3,$3,$2	# add old carry limb to low product limb
-	dmultu	$8,$7
-	ld	$8,0($5)	# load new s1 limb as early as possible
-	daddiu	$6,$6,-1	# decrement loop counter
-	sltu	$2,$3,$2	# carry from previous addition -> $2
-	dsubu	$3,$10,$3
-	sgtu	$10,$3,$10
-	daddu	$2,$2,$10
-	sd	$3,0($4)
-	daddiu	$4,$4,8
-	bne	$6,$0,Loop
-	 daddu	$2,$9,$2	# add high product limb and carry from addition
-
- # cool down phase 1
-$LC1:	ld	$10,0($4)
-	mflo	$3
-	mfhi	$9
-	daddu	$3,$3,$2
-	sltu	$2,$3,$2
-	dmultu	$8,$7
-	dsubu	$3,$10,$3
-	sgtu	$10,$3,$10
-	daddu	$2,$2,$10
-	sd	$3,0($4)
-	daddiu	$4,$4,8
-	daddu	$2,$9,$2	# add high product limb and carry from addition
-
- # cool down phase 0
-$LC0:	ld	$10,0($4)
-	mflo	$3
-	mfhi	$9
-	daddu	$3,$3,$2
-	sltu	$2,$3,$2
-	dsubu	$3,$10,$3
-	sgtu	$10,$3,$10
-	daddu	$2,$2,$10
-	sd	$3,0($4)
-	j	$31
-	daddu	$2,$9,$2	# add high product limb and carry from addition
-
-	.end	__gmpn_submul_1
diff --git a/ghc/rts/gmp/mpn/mp_bases.c b/ghc/rts/gmp/mpn/mp_bases.c
deleted file mode 100644
index 011c328c80..0000000000
--- a/ghc/rts/gmp/mpn/mp_bases.c
+++ /dev/null
@@ -1,550 +0,0 @@
-/* __mp_bases -- Structure for conversion between internal binary
-   format and strings in base 2..255.  The fields are explained in
-   gmp-impl.h.
-
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-
-#if BITS_PER_MP_LIMB == 32
-const struct bases __mp_bases[256] =
-{
-  /*  0 */ {0, 0.0, 0, 0},
-  /*  1 */ {0, 1e38, 0, 0},
-  /*  2 */ {32, 1.0000000000000000, 0x1, 0x0},
-  /*  3 */ {20, 0.6309297535714575, 0xcfd41b91, 0x3b563c24},
-  /*  4 */ {16, 0.5000000000000000, 0x2, 0x0},
-  /*  5 */ {13, 0.4306765580733931, 0x48c27395, 0xc25c2684},
-  /*  6 */ {12, 0.3868528072345416, 0x81bf1000, 0xf91bd1b6},
-  /*  7 */ {11, 0.3562071871080222, 0x75db9c97, 0x1607a2cb},
-  /*  8 */ {10, 0.3333333333333334, 0x3, 0x0},
-  /*  9 */ {10, 0.3154648767857287, 0xcfd41b91, 0x3b563c24},
-  /* 10 */ {9, 0.3010299956639811, 0x3b9aca00, 0x12e0be82},
-  /* 11 */ {9, 0.2890648263178878, 0x8c8b6d2b, 0xd24cde04},
-  /* 12 */ {8, 0.2789429456511298, 0x19a10000, 0x3fa39ab5},
-  /* 13 */ {8, 0.2702381544273197, 0x309f1021, 0x50f8ac5f},
-  /* 14 */ {8, 0.2626495350371936, 0x57f6c100, 0x74843b1e},
-  /* 15 */ {8, 0.2559580248098155, 0x98c29b81, 0xad0326c2},
-  /* 16 */ {8, 0.2500000000000000, 0x4, 0x0},
-  /* 17 */ {7, 0.2446505421182260, 0x18754571, 0x4ef0b6bd},
-  /* 18 */ {7, 0.2398124665681315, 0x247dbc80, 0xc0fc48a1},
-  /* 19 */ {7, 0.2354089133666382, 0x3547667b, 0x33838942},
-  /* 20 */ {7, 0.2313782131597592, 0x4c4b4000, 0xad7f29ab},
-  /* 21 */ {7, 0.2276702486969530, 0x6b5a6e1d, 0x313c3d15},
-  /* 22 */ {7, 0.2242438242175754, 0x94ace180, 0xb8cca9e0},
-  /* 23 */ {7, 0.2210647294575037, 0xcaf18367, 0x42ed6de9},
-  /* 24 */ {6, 0.2181042919855316, 0xb640000, 0x67980e0b},
-  /* 25 */ {6, 0.2153382790366965, 0xe8d4a51, 0x19799812},
-  /* 26 */ {6, 0.2127460535533632, 0x1269ae40, 0xbce85396},
-  /* 27 */ {6, 0.2103099178571525, 0x17179149, 0x62c103a9},
-  /* 28 */ {6, 0.2080145976765095, 0x1cb91000, 0x1d353d43},
-  /* 29 */ {6, 0.2058468324604344, 0x23744899, 0xce1decea},
-  /* 30 */ {6, 0.2037950470905062, 0x2b73a840, 0x790fc511},
-  /* 31 */ {6, 0.2018490865820999, 0x34e63b41, 0x35b865a0},
-  /* 32 */ {6, 0.2000000000000000, 0x5, 0x0},
-  /* 33 */ {6, 0.1982398631705605, 0x4cfa3cc1, 0xa9aed1b3},
-  /* 34 */ {6, 0.1965616322328226, 0x5c13d840, 0x63dfc229},
-  /* 35 */ {6, 0.1949590218937863, 0x6d91b519, 0x2b0fee30},
-  /* 36 */ {6, 0.1934264036172708, 0x81bf1000, 0xf91bd1b6},
-  /* 37 */ {6, 0.1919587200065601, 0x98ede0c9, 0xac89c3a9},
-  /* 38 */ {6, 0.1905514124267734, 0xb3773e40, 0x6d2c32fe},
-  /* 39 */ {6, 0.1892003595168700, 0xd1bbc4d1, 0x387907c9},
-  /* 40 */ {6, 0.1879018247091076, 0xf4240000, 0xc6f7a0b},
-  /* 41 */ {5, 0.1866524112389434, 0x6e7d349, 0x28928154},
-  /* 42 */ {5, 0.1854490234153689, 0x7ca30a0, 0x6e8629d},
-  /* 43 */ {5, 0.1842888331487062, 0x8c32bbb, 0xd373dca0},
-  /* 44 */ {5, 0.1831692509136336, 0x9d46c00, 0xa0b17895},
-  /* 45 */ {5, 0.1820879004699383, 0xaffacfd, 0x746811a5},
-  /* 46 */ {5, 0.1810425967800402, 0xc46bee0, 0x4da6500f},
-  /* 47 */ {5, 0.1800313266566926, 0xdab86ef, 0x2ba23582},
-  /* 48 */ {5, 0.1790522317510414, 0xf300000, 0xdb20a88},
-  /* 49 */ {5, 0.1781035935540111, 0x10d63af1, 0xe68d5ce4},
-  /* 50 */ {5, 0.1771838201355579, 0x12a05f20, 0xb7cdfd9d},
-  /* 51 */ {5, 0.1762914343888821, 0x1490aae3, 0x8e583933},
-  /* 52 */ {5, 0.1754250635819545, 0x16a97400, 0x697cc3ea},
-  /* 53 */ {5, 0.1745834300480449, 0x18ed2825, 0x48a5ca6c},
-  /* 54 */ {5, 0.1737653428714400, 0x1b5e4d60, 0x2b52db16},
-  /* 55 */ {5, 0.1729696904450771, 0x1dff8297, 0x111586a6},
-  /* 56 */ {5, 0.1721954337940981, 0x20d38000, 0xf31d2b36},
-  /* 57 */ {5, 0.1714416005739134, 0x23dd1799, 0xc8d76d19},
-  /* 58 */ {5, 0.1707072796637201, 0x271f35a0, 0xa2cb1eb4},
-  /* 59 */ {5, 0.1699916162869140, 0x2a9ce10b, 0x807c3ec3},
-  /* 60 */ {5, 0.1692938075987814, 0x2e593c00, 0x617ec8bf},
-  /* 61 */ {5, 0.1686130986895011, 0x3257844d, 0x45746cbe},
-  /* 62 */ {5, 0.1679487789570419, 0x369b13e0, 0x2c0aa273},
-  /* 63 */ {5, 0.1673001788101741, 0x3b27613f, 0x14f90805},
-  /* 64 */ {5, 0.1666666666666667, 0x6, 0x0},
-  /* 65 */ {5, 0.1660476462159378, 0x4528a141, 0xd9cf0829},
-  /* 66 */ {5, 0.1654425539190583, 0x4aa51420, 0xb6fc4841},
-  /* 67 */ {5, 0.1648508567221604, 0x50794633, 0x973054cb},
-  /* 68 */ {5, 0.1642720499620502, 0x56a94400, 0x7a1dbe4b},
-  /* 69 */ {5, 0.1637056554452156, 0x5d393975, 0x5f7fcd7f},
-  /* 70 */ {5, 0.1631512196835108, 0x642d7260, 0x47196c84},
-  /* 71 */ {5, 0.1626083122716341, 0x6b8a5ae7, 0x30b43635},
-  /* 72 */ {5, 0.1620765243931223, 0x73548000, 0x1c1fa5f6},
-  /* 73 */ {5, 0.1615554674429964, 0x7b908fe9, 0x930634a},
-  /* 74 */ {5, 0.1610447717564445, 0x84435aa0, 0xef7f4a3c},
-  /* 75 */ {5, 0.1605440854340214, 0x8d71d25b, 0xcf5552d2},
-  /* 76 */ {5, 0.1600530732548213, 0x97210c00, 0xb1a47c8e},
-  /* 77 */ {5, 0.1595714156699382, 0xa1563f9d, 0x9634b43e},
-  /* 78 */ {5, 0.1590988078692941, 0xac16c8e0, 0x7cd3817d},
-  /* 79 */ {5, 0.1586349589155960, 0xb768278f, 0x65536761},
-  /* 80 */ {5, 0.1581795909397823, 0xc3500000, 0x4f8b588e},
-  /* 81 */ {5, 0.1577324383928644, 0xcfd41b91, 0x3b563c24},
-  /* 82 */ {5, 0.1572932473495469, 0xdcfa6920, 0x28928154},
-  /* 83 */ {5, 0.1568617748594410, 0xeac8fd83, 0x1721bfb0},
-  /* 84 */ {5, 0.1564377883420716, 0xf9461400, 0x6e8629d},
-  /* 85 */ {4, 0.1560210650222250, 0x31c84b1, 0x491cc17c},
-  /* 86 */ {4, 0.1556113914024940, 0x342ab10, 0x3a11d83b},
-  /* 87 */ {4, 0.1552085627701551, 0x36a2c21, 0x2be074cd},
-  /* 88 */ {4, 0.1548123827357682, 0x3931000, 0x1e7a02e7},
-  /* 89 */ {4, 0.1544226628011101, 0x3bd5ee1, 0x11d10edd},
-  /* 90 */ {4, 0.1540392219542636, 0x3e92110, 0x5d92c68},
-  /* 91 */ {4, 0.1536618862898642, 0x4165ef1, 0xf50dbfb2},
-  /* 92 */ {4, 0.1532904886526781, 0x4452100, 0xdf9f1316},
-  /* 93 */ {4, 0.1529248683028321, 0x4756fd1, 0xcb52a684},
-  /* 94 */ {4, 0.1525648706011593, 0x4a75410, 0xb8163e97},
-  /* 95 */ {4, 0.1522103467132434, 0x4dad681, 0xa5d8f269},
-  /* 96 */ {4, 0.1518611533308632, 0x5100000, 0x948b0fcd},
-  /* 97 */ {4, 0.1515171524096389, 0x546d981, 0x841e0215},
-  /* 98 */ {4, 0.1511782109217764, 0x57f6c10, 0x74843b1e},
-  /* 99 */ {4, 0.1508442006228941, 0x5b9c0d1, 0x65b11e6e},
-  /* 100 */ {4, 0.1505149978319906, 0x5f5e100, 0x5798ee23},
-  /* 101 */ {4, 0.1501904832236879, 0x633d5f1, 0x4a30b99b},
-  /* 102 */ {4, 0.1498705416319474, 0x673a910, 0x3d6e4d94},
-  /* 103 */ {4, 0.1495550618645152, 0x6b563e1, 0x314825b0},
-  /* 104 */ {4, 0.1492439365274121, 0x6f91000, 0x25b55f2e},
-  /* 105 */ {4, 0.1489370618588283, 0x73eb721, 0x1aadaccb},
-  /* 106 */ {4, 0.1486343375718350, 0x7866310, 0x10294ba2},
-  /* 107 */ {4, 0.1483356667053617, 0x7d01db1, 0x620f8f6},
-  /* 108 */ {4, 0.1480409554829326, 0x81bf100, 0xf91bd1b6},
-  /* 109 */ {4, 0.1477501131786861, 0x869e711, 0xe6d37b2a},
-  /* 110 */ {4, 0.1474630519902391, 0x8ba0a10, 0xd55cff6e},
-  /* 111 */ {4, 0.1471796869179852, 0x90c6441, 0xc4ad2db2},
-  /* 112 */ {4, 0.1468999356504447, 0x9610000, 0xb4b985cf},
-  /* 113 */ {4, 0.1466237184553111, 0x9b7e7c1, 0xa5782bef},
-  /* 114 */ {4, 0.1463509580758620, 0xa112610, 0x96dfdd2a},
-  /* 115 */ {4, 0.1460815796324244, 0xa6cc591, 0x88e7e509},
-  /* 116 */ {4, 0.1458155105286054, 0xacad100, 0x7b8813d3},
-  /* 117 */ {4, 0.1455526803620167, 0xb2b5331, 0x6eb8b595},
-  /* 118 */ {4, 0.1452930208392428, 0xb8e5710, 0x627289db},
-  /* 119 */ {4, 0.1450364656948130, 0xbf3e7a1, 0x56aebc07},
-  /* 120 */ {4, 0.1447829506139581, 0xc5c1000, 0x4b66dc33},
-  /* 121 */ {4, 0.1445324131589439, 0xcc6db61, 0x4094d8a3},
-  /* 122 */ {4, 0.1442847926987864, 0xd345510, 0x3632f7a5},
-  /* 123 */ {4, 0.1440400303421672, 0xda48871, 0x2c3bd1f0},
-  /* 124 */ {4, 0.1437980688733775, 0xe178100, 0x22aa4d5f},
-  /* 125 */ {4, 0.1435588526911310, 0xe8d4a51, 0x19799812},
-  /* 126 */ {4, 0.1433223277500932, 0xf05f010, 0x10a523e5},
-  /* 127 */ {4, 0.1430884415049874, 0xf817e01, 0x828a237},
-  /* 128 */ {4, 0.1428571428571428, 0x7, 0x0},
-  /* 129 */ {4, 0.1426283821033600, 0x10818201, 0xf04ec452},
-  /* 130 */ {4, 0.1424021108869747, 0x11061010, 0xe136444a},
-  /* 131 */ {4, 0.1421782821510107, 0x118db651, 0xd2af9589},
-  /* 132 */ {4, 0.1419568500933153, 0x12188100, 0xc4b42a83},
-  /* 133 */ {4, 0.1417377701235801, 0x12a67c71, 0xb73dccf5},
-  /* 134 */ {4, 0.1415209988221527, 0x1337b510, 0xaa4698c5},
-  /* 135 */ {4, 0.1413064939005528, 0x13cc3761, 0x9dc8f729},
-  /* 136 */ {4, 0.1410942141636095, 0x14641000, 0x91bf9a30},
-  /* 137 */ {4, 0.1408841194731412, 0x14ff4ba1, 0x86257887},
-  /* 138 */ {4, 0.1406761707131039, 0x159df710, 0x7af5c98c},
-  /* 139 */ {4, 0.1404703297561400, 0x16401f31, 0x702c01a0},
-  /* 140 */ {4, 0.1402665594314587, 0x16e5d100, 0x65c3ceb1},
-  /* 141 */ {4, 0.1400648234939879, 0x178f1991, 0x5bb91502},
-  /* 142 */ {4, 0.1398650865947379, 0x183c0610, 0x5207ec23},
-  /* 143 */ {4, 0.1396673142523192, 0x18eca3c1, 0x48ac9c19},
-  /* 144 */ {4, 0.1394714728255649, 0x19a10000, 0x3fa39ab5},
-  /* 145 */ {4, 0.1392775294872041, 0x1a592841, 0x36e98912},
-  /* 146 */ {4, 0.1390854521985406, 0x1b152a10, 0x2e7b3140},
-  /* 147 */ {4, 0.1388952096850913, 0x1bd51311, 0x2655840b},
-  /* 148 */ {4, 0.1387067714131417, 0x1c98f100, 0x1e7596ea},
-  /* 149 */ {4, 0.1385201075671774, 0x1d60d1b1, 0x16d8a20d},
-  /* 150 */ {4, 0.1383351890281539, 0x1e2cc310, 0xf7bfe87},
-  /* 151 */ {4, 0.1381519873525671, 0x1efcd321, 0x85d2492},
-  /* 152 */ {4, 0.1379704747522905, 0x1fd11000, 0x179a9f4},
-  /* 153 */ {4, 0.1377906240751463, 0x20a987e1, 0xf59e80eb},
-  /* 154 */ {4, 0.1376124087861776, 0x21864910, 0xe8b768db},
-  /* 155 */ {4, 0.1374358029495937, 0x226761f1, 0xdc39d6d5},
-  /* 156 */ {4, 0.1372607812113589, 0x234ce100, 0xd021c5d1},
-  /* 157 */ {4, 0.1370873187823978, 0x2436d4d1, 0xc46b5e37},
-  /* 158 */ {4, 0.1369153914223921, 0x25254c10, 0xb912f39c},
-  /* 159 */ {4, 0.1367449754241439, 0x26185581, 0xae150294},
-  /* 160 */ {4, 0.1365760475984821, 0x27100000, 0xa36e2eb1},
-  /* 161 */ {4, 0.1364085852596902, 0x280c5a81, 0x991b4094},
-  /* 162 */ {4, 0.1362425662114337, 0x290d7410, 0x8f19241e},
-  /* 163 */ {4, 0.1360779687331669, 0x2a135bd1, 0x8564e6b7},
-  /* 164 */ {4, 0.1359147715670014, 0x2b1e2100, 0x7bfbb5b4},
-  /* 165 */ {4, 0.1357529539050150, 0x2c2dd2f1, 0x72dadcc8},
-  /* 166 */ {4, 0.1355924953769863, 0x2d428110, 0x69ffc498},
-  /* 167 */ {4, 0.1354333760385373, 0x2e5c3ae1, 0x6167f154},
-  /* 168 */ {4, 0.1352755763596663, 0x2f7b1000, 0x5911016e},
-  /* 169 */ {4, 0.1351190772136599, 0x309f1021, 0x50f8ac5f},
-  /* 170 */ {4, 0.1349638598663645, 0x31c84b10, 0x491cc17c},
-  /* 171 */ {4, 0.1348099059658079, 0x32f6d0b1, 0x417b26d8},
-  /* 172 */ {4, 0.1346571975321549, 0x342ab100, 0x3a11d83b},
-  /* 173 */ {4, 0.1345057169479844, 0x3563fc11, 0x32dee622},
-  /* 174 */ {4, 0.1343554469488779, 0x36a2c210, 0x2be074cd},
-  /* 175 */ {4, 0.1342063706143054, 0x37e71341, 0x2514bb58},
-  /* 176 */ {4, 0.1340584713587980, 0x39310000, 0x1e7a02e7},
-  /* 177 */ {4, 0.1339117329233981, 0x3a8098c1, 0x180ea5d0},
-  /* 178 */ {4, 0.1337661393673756, 0x3bd5ee10, 0x11d10edd},
-  /* 179 */ {4, 0.1336216750601996, 0x3d311091, 0xbbfb88e},
-  /* 180 */ {4, 0.1334783246737591, 0x3e921100, 0x5d92c68},
-  /* 181 */ {4, 0.1333360731748201, 0x3ff90031, 0x1c024c},
-  /* 182 */ {4, 0.1331949058177136, 0x4165ef10, 0xf50dbfb2},
-  /* 183 */ {4, 0.1330548081372441, 0x42d8eea1, 0xea30efa3},
-  /* 184 */ {4, 0.1329157659418126, 0x44521000, 0xdf9f1316},
-  /* 185 */ {4, 0.1327777653067443, 0x45d16461, 0xd555c0c9},
-  /* 186 */ {4, 0.1326407925678156, 0x4756fd10, 0xcb52a684},
-  /* 187 */ {4, 0.1325048343149731, 0x48e2eb71, 0xc193881f},
-  /* 188 */ {4, 0.1323698773862368, 0x4a754100, 0xb8163e97},
-  /* 189 */ {4, 0.1322359088617821, 0x4c0e0f51, 0xaed8b724},
-  /* 190 */ {4, 0.1321029160581950, 0x4dad6810, 0xa5d8f269},
-  /* 191 */ {4, 0.1319708865228925, 0x4f535d01, 0x9d15039d},
-  /* 192 */ {4, 0.1318398080287045, 0x51000000, 0x948b0fcd},
-  /* 193 */ {4, 0.1317096685686114, 0x52b36301, 0x8c394d1d},
-  /* 194 */ {4, 0.1315804563506306, 0x546d9810, 0x841e0215},
-  /* 195 */ {4, 0.1314521597928493, 0x562eb151, 0x7c3784f8},
-  /* 196 */ {4, 0.1313247675185968, 0x57f6c100, 0x74843b1e},
-  /* 197 */ {4, 0.1311982683517524, 0x59c5d971, 0x6d02985d},
-  /* 198 */ {4, 0.1310726513121843, 0x5b9c0d10, 0x65b11e6e},
-  /* 199 */ {4, 0.1309479056113158, 0x5d796e61, 0x5e8e5c64},
-  /* 200 */ {4, 0.1308240206478128, 0x5f5e1000, 0x5798ee23},
-  /* 201 */ {4, 0.1307009860033912, 0x614a04a1, 0x50cf7bde},
-  /* 202 */ {4, 0.1305787914387386, 0x633d5f10, 0x4a30b99b},
-  /* 203 */ {4, 0.1304574268895465, 0x65383231, 0x43bb66bd},
-  /* 204 */ {4, 0.1303368824626505, 0x673a9100, 0x3d6e4d94},
-  /* 205 */ {4, 0.1302171484322746, 0x69448e91, 0x374842ee},
-  /* 206 */ {4, 0.1300982152363760, 0x6b563e10, 0x314825b0},
-  /* 207 */ {4, 0.1299800734730872, 0x6d6fb2c1, 0x2b6cde75},
-  /* 208 */ {4, 0.1298627138972530, 0x6f910000, 0x25b55f2e},
-  /* 209 */ {4, 0.1297461274170591, 0x71ba3941, 0x2020a2c5},
-  /* 210 */ {4, 0.1296303050907487, 0x73eb7210, 0x1aadaccb},
-  /* 211 */ {4, 0.1295152381234257, 0x7624be11, 0x155b891f},
-  /* 212 */ {4, 0.1294009178639407, 0x78663100, 0x10294ba2},
-  /* 213 */ {4, 0.1292873358018581, 0x7aafdeb1, 0xb160fe9},
-  /* 214 */ {4, 0.1291744835645007, 0x7d01db10, 0x620f8f6},
-  /* 215 */ {4, 0.1290623529140715, 0x7f5c3a21, 0x14930ef},
-  /* 216 */ {4, 0.1289509357448472, 0x81bf1000, 0xf91bd1b6},
-  /* 217 */ {4, 0.1288402240804449, 0x842a70e1, 0xefdcb0c7},
-  /* 218 */ {4, 0.1287302100711567, 0x869e7110, 0xe6d37b2a},
-  /* 219 */ {4, 0.1286208859913518, 0x891b24f1, 0xddfeb94a},
-  /* 220 */ {4, 0.1285122442369443, 0x8ba0a100, 0xd55cff6e},
-  /* 221 */ {4, 0.1284042773229231, 0x8e2ef9d1, 0xcceced50},
-  /* 222 */ {4, 0.1282969778809442, 0x90c64410, 0xc4ad2db2},
-  /* 223 */ {4, 0.1281903386569819, 0x93669481, 0xbc9c75f9},
-  /* 224 */ {4, 0.1280843525090381, 0x96100000, 0xb4b985cf},
-  /* 225 */ {4, 0.1279790124049077, 0x98c29b81, 0xad0326c2},
-  /* 226 */ {4, 0.1278743114199984, 0x9b7e7c10, 0xa5782bef},
-  /* 227 */ {4, 0.1277702427352035, 0x9e43b6d1, 0x9e1771a9},
-  /* 228 */ {4, 0.1276667996348261, 0xa1126100, 0x96dfdd2a},
-  /* 229 */ {4, 0.1275639755045533, 0xa3ea8ff1, 0x8fd05c41},
-  /* 230 */ {4, 0.1274617638294791, 0xa6cc5910, 0x88e7e509},
-  /* 231 */ {4, 0.1273601581921741, 0xa9b7d1e1, 0x8225759d},
-  /* 232 */ {4, 0.1272591522708010, 0xacad1000, 0x7b8813d3},
-  /* 233 */ {4, 0.1271587398372755, 0xafac2921, 0x750eccf9},
-  /* 234 */ {4, 0.1270589147554692, 0xb2b53310, 0x6eb8b595},
-  /* 235 */ {4, 0.1269596709794558, 0xb5c843b1, 0x6884e923},
-  /* 236 */ {4, 0.1268610025517973, 0xb8e57100, 0x627289db},
-  /* 237 */ {4, 0.1267629036018709, 0xbc0cd111, 0x5c80c07b},
-  /* 238 */ {4, 0.1266653683442337, 0xbf3e7a10, 0x56aebc07},
-  /* 239 */ {4, 0.1265683910770258, 0xc27a8241, 0x50fbb19b},
-  /* 240 */ {4, 0.1264719661804097, 0xc5c10000, 0x4b66dc33},
-  /* 241 */ {4, 0.1263760881150453, 0xc91209c1, 0x45ef7c7c},
-  /* 242 */ {4, 0.1262807514205999, 0xcc6db610, 0x4094d8a3},
-  /* 243 */ {4, 0.1261859507142915, 0xcfd41b91, 0x3b563c24},
-  /* 244 */ {4, 0.1260916806894653, 0xd3455100, 0x3632f7a5},
-  /* 245 */ {4, 0.1259979361142023, 0xd6c16d31, 0x312a60c3},
-  /* 246 */ {4, 0.1259047118299582, 0xda488710, 0x2c3bd1f0},
-  /* 247 */ {4, 0.1258120027502338, 0xdddab5a1, 0x2766aa45},
-  /* 248 */ {4, 0.1257198038592741, 0xe1781000, 0x22aa4d5f},
-  /* 249 */ {4, 0.1256281102107963, 0xe520ad61, 0x1e06233c},
-  /* 250 */ {4, 0.1255369169267456, 0xe8d4a510, 0x19799812},
-  /* 251 */ {4, 0.1254462191960791, 0xec940e71, 0x15041c33},
-  /* 252 */ {4, 0.1253560122735751, 0xf05f0100, 0x10a523e5},
-  /* 253 */ {4, 0.1252662914786691, 0xf4359451, 0xc5c2749},
-  /* 254 */ {4, 0.1251770521943144, 0xf817e010, 0x828a237},
-  /* 255 */ {4, 0.1250882898658681, 0xfc05fc01, 0x40a1423},
-};
-#endif
-#if BITS_PER_MP_LIMB == 64
-const struct bases __mp_bases[256] =
-{
-  /*  0 */ {0, 0.0, 0, 0},
-  /*  1 */ {0, 1e38, 0, 0},
-  /*  2 */ {64, 1.0000000000000000, CNST_LIMB(0x1), CNST_LIMB(0x0)},
-  /*  3 */ {40, 0.6309297535714574, CNST_LIMB(0xa8b8b452291fe821), CNST_LIMB(0x846d550e37b5063d)},
-  /*  4 */ {32, 0.5000000000000000, CNST_LIMB(0x2), CNST_LIMB(0x0)},
-  /*  5 */ {27, 0.4306765580733931, CNST_LIMB(0x6765c793fa10079d), CNST_LIMB(0x3ce9a36f23c0fc90)},
-  /*  6 */ {24, 0.3868528072345416, CNST_LIMB(0x41c21cb8e1000000), CNST_LIMB(0xf24f62335024a295)},
-  /*  7 */ {22, 0.3562071871080222, CNST_LIMB(0x3642798750226111), CNST_LIMB(0x2df495ccaa57147b)},
-  /*  8 */ {21, 0.3333333333333334, CNST_LIMB(0x3), CNST_LIMB(0x0)},
-  /*  9 */ {20, 0.3154648767857287, CNST_LIMB(0xa8b8b452291fe821), CNST_LIMB(0x846d550e37b5063d)},
-  /* 10 */ {19, 0.3010299956639811, CNST_LIMB(0x8ac7230489e80000), CNST_LIMB(0xd83c94fb6d2ac34a)},
-  /* 11 */ {18, 0.2890648263178878, CNST_LIMB(0x4d28cb56c33fa539), CNST_LIMB(0xa8adf7ae45e7577b)},
-  /* 12 */ {17, 0.2789429456511298, CNST_LIMB(0x1eca170c00000000), CNST_LIMB(0xa10c2bec5da8f8f)},
-  /* 13 */ {17, 0.2702381544273197, CNST_LIMB(0x780c7372621bd74d), CNST_LIMB(0x10f4becafe412ec3)},
-  /* 14 */ {16, 0.2626495350371936, CNST_LIMB(0x1e39a5057d810000), CNST_LIMB(0xf08480f672b4e86)},
-  /* 15 */ {16, 0.2559580248098155, CNST_LIMB(0x5b27ac993df97701), CNST_LIMB(0x6779c7f90dc42f48)},
-  /* 16 */ {16, 0.2500000000000000, CNST_LIMB(0x4), CNST_LIMB(0x0)},
-  /* 17 */ {15, 0.2446505421182260, CNST_LIMB(0x27b95e997e21d9f1), CNST_LIMB(0x9c71e11bab279323)},
-  /* 18 */ {15, 0.2398124665681315, CNST_LIMB(0x5da0e1e53c5c8000), CNST_LIMB(0x5dfaa697ec6f6a1c)},
-  /* 19 */ {15, 0.2354089133666382, CNST_LIMB(0xd2ae3299c1c4aedb), CNST_LIMB(0x3711783f6be7e9ec)},
-  /* 20 */ {14, 0.2313782131597592, CNST_LIMB(0x16bcc41e90000000), CNST_LIMB(0x6849b86a12b9b01e)},
-  /* 21 */ {14, 0.2276702486969530, CNST_LIMB(0x2d04b7fdd9c0ef49), CNST_LIMB(0x6bf097ba5ca5e239)},
-  /* 22 */ {14, 0.2242438242175754, CNST_LIMB(0x5658597bcaa24000), CNST_LIMB(0x7b8015c8d7af8f08)},
-  /* 23 */ {14, 0.2210647294575037, CNST_LIMB(0xa0e2073737609371), CNST_LIMB(0x975a24b3a3151b38)},
-  /* 24 */ {13, 0.2181042919855316, CNST_LIMB(0xc29e98000000000), CNST_LIMB(0x50bd367972689db1)},
-  /* 25 */ {13, 0.2153382790366965, CNST_LIMB(0x14adf4b7320334b9), CNST_LIMB(0x8c240c4aecb13bb5)},
-  /* 26 */ {13, 0.2127460535533632, CNST_LIMB(0x226ed36478bfa000), CNST_LIMB(0xdbd2e56854e118c9)},
-  /* 27 */ {13, 0.2103099178571525, CNST_LIMB(0x383d9170b85ff80b), CNST_LIMB(0x2351ffcaa9c7c4ae)},
-  /* 28 */ {13, 0.2080145976765095, CNST_LIMB(0x5a3c23e39c000000), CNST_LIMB(0x6b24188ca33b0636)},
-  /* 29 */ {13, 0.2058468324604344, CNST_LIMB(0x8e65137388122bcd), CNST_LIMB(0xcc3dceaf2b8ba99d)},
-  /* 30 */ {13, 0.2037950470905062, CNST_LIMB(0xdd41bb36d259e000), CNST_LIMB(0x2832e835c6c7d6b6)},
-  /* 31 */ {12, 0.2018490865820999, CNST_LIMB(0xaee5720ee830681), CNST_LIMB(0x76b6aa272e1873c5)},
-  /* 32 */ {12, 0.2000000000000000, CNST_LIMB(0x5), CNST_LIMB(0x0)},
-  /* 33 */ {12, 0.1982398631705605, CNST_LIMB(0x172588ad4f5f0981), CNST_LIMB(0x61eaf5d402c7bf4f)},
-  /* 34 */ {12, 0.1965616322328226, CNST_LIMB(0x211e44f7d02c1000), CNST_LIMB(0xeeb658123ffb27ec)},
-  /* 35 */ {12, 0.1949590218937863, CNST_LIMB(0x2ee56725f06e5c71), CNST_LIMB(0x5d5e3762e6fdf509)},
-  /* 36 */ {12, 0.1934264036172708, CNST_LIMB(0x41c21cb8e1000000), CNST_LIMB(0xf24f62335024a295)},
-  /* 37 */ {12, 0.1919587200065601, CNST_LIMB(0x5b5b57f8a98a5dd1), CNST_LIMB(0x66ae7831762efb6f)},
-  /* 38 */ {12, 0.1905514124267734, CNST_LIMB(0x7dcff8986ea31000), CNST_LIMB(0x47388865a00f544)},
-  /* 39 */ {12, 0.1892003595168700, CNST_LIMB(0xabd4211662a6b2a1), CNST_LIMB(0x7d673c33a123b54c)},
-  /* 40 */ {12, 0.1879018247091076, CNST_LIMB(0xe8d4a51000000000), CNST_LIMB(0x19799812dea11197)},
-  /* 41 */ {11, 0.1866524112389434, CNST_LIMB(0x7a32956ad081b79), CNST_LIMB(0xc27e62e0686feae)},
-  /* 42 */ {11, 0.1854490234153689, CNST_LIMB(0x9f49aaff0e86800), CNST_LIMB(0x9b6e7507064ce7c7)},
-  /* 43 */ {11, 0.1842888331487062, CNST_LIMB(0xce583bb812d37b3), CNST_LIMB(0x3d9ac2bf66cfed94)},
-  /* 44 */ {11, 0.1831692509136336, CNST_LIMB(0x109b79a654c00000), CNST_LIMB(0xed46bc50ce59712a)},
-  /* 45 */ {11, 0.1820879004699383, CNST_LIMB(0x1543beff214c8b95), CNST_LIMB(0x813d97e2c89b8d46)},
-  /* 46 */ {11, 0.1810425967800402, CNST_LIMB(0x1b149a79459a3800), CNST_LIMB(0x2e81751956af8083)},
-  /* 47 */ {11, 0.1800313266566926, CNST_LIMB(0x224edfb5434a830f), CNST_LIMB(0xdd8e0a95e30c0988)},
-  /* 48 */ {11, 0.1790522317510413, CNST_LIMB(0x2b3fb00000000000), CNST_LIMB(0x7ad4dd48a0b5b167)},
-  /* 49 */ {11, 0.1781035935540111, CNST_LIMB(0x3642798750226111), CNST_LIMB(0x2df495ccaa57147b)},
-  /* 50 */ {11, 0.1771838201355579, CNST_LIMB(0x43c33c1937564800), CNST_LIMB(0xe392010175ee5962)},
-  /* 51 */ {11, 0.1762914343888821, CNST_LIMB(0x54411b2441c3cd8b), CNST_LIMB(0x84eaf11b2fe7738e)},
-  /* 52 */ {11, 0.1754250635819545, CNST_LIMB(0x6851455acd400000), CNST_LIMB(0x3a1e3971e008995d)},
-  /* 53 */ {11, 0.1745834300480449, CNST_LIMB(0x80a23b117c8feb6d), CNST_LIMB(0xfd7a462344ffce25)},
-  /* 54 */ {11, 0.1737653428714400, CNST_LIMB(0x9dff7d32d5dc1800), CNST_LIMB(0x9eca40b40ebcef8a)},
-  /* 55 */ {11, 0.1729696904450771, CNST_LIMB(0xc155af6faeffe6a7), CNST_LIMB(0x52fa161a4a48e43d)},
-  /* 56 */ {11, 0.1721954337940981, CNST_LIMB(0xebb7392e00000000), CNST_LIMB(0x1607a2cbacf930c1)},
-  /* 57 */ {10, 0.1714416005739134, CNST_LIMB(0x50633659656d971), CNST_LIMB(0x97a014f8e3be55f1)},
-  /* 58 */ {10, 0.1707072796637201, CNST_LIMB(0x5fa8624c7fba400), CNST_LIMB(0x568df8b76cbf212c)},
-  /* 59 */ {10, 0.1699916162869140, CNST_LIMB(0x717d9faa73c5679), CNST_LIMB(0x20ba7c4b4e6ef492)},
-  /* 60 */ {10, 0.1692938075987814, CNST_LIMB(0x86430aac6100000), CNST_LIMB(0xe81ee46b9ef492f5)},
-  /* 61 */ {10, 0.1686130986895011, CNST_LIMB(0x9e64d9944b57f29), CNST_LIMB(0x9dc0d10d51940416)},
-  /* 62 */ {10, 0.1679487789570419, CNST_LIMB(0xba5ca5392cb0400), CNST_LIMB(0x5fa8ed2f450272a5)},
-  /* 63 */ {10, 0.1673001788101741, CNST_LIMB(0xdab2ce1d022cd81), CNST_LIMB(0x2ba9eb8c5e04e641)},
-  /* 64 */ {10, 0.1666666666666667, CNST_LIMB(0x6), CNST_LIMB(0x0)},
-  /* 65 */ {10, 0.1660476462159378, CNST_LIMB(0x12aeed5fd3e2d281), CNST_LIMB(0xb67759cc00287bf1)},
-  /* 66 */ {10, 0.1654425539190583, CNST_LIMB(0x15c3da1572d50400), CNST_LIMB(0x78621feeb7f4ed33)},
-  /* 67 */ {10, 0.1648508567221604, CNST_LIMB(0x194c05534f75ee29), CNST_LIMB(0x43d55b5f72943bc0)},
-  /* 68 */ {10, 0.1642720499620502, CNST_LIMB(0x1d56299ada100000), CNST_LIMB(0x173decb64d1d4409)},
-  /* 69 */ {10, 0.1637056554452156, CNST_LIMB(0x21f2a089a4ff4f79), CNST_LIMB(0xe29fb54fd6b6074f)},
-  /* 70 */ {10, 0.1631512196835108, CNST_LIMB(0x2733896c68d9a400), CNST_LIMB(0xa1f1f5c210d54e62)},
-  /* 71 */ {10, 0.1626083122716341, CNST_LIMB(0x2d2cf2c33b533c71), CNST_LIMB(0x6aac7f9bfafd57b2)},
-  /* 72 */ {10, 0.1620765243931223, CNST_LIMB(0x33f506e440000000), CNST_LIMB(0x3b563c2478b72ee2)},
-  /* 73 */ {10, 0.1615554674429964, CNST_LIMB(0x3ba43bec1d062211), CNST_LIMB(0x12b536b574e92d1b)},
-  /* 74 */ {10, 0.1610447717564444, CNST_LIMB(0x4455872d8fd4e400), CNST_LIMB(0xdf86c03020404fa5)},
-  /* 75 */ {10, 0.1605440854340214, CNST_LIMB(0x4e2694539f2f6c59), CNST_LIMB(0xa34adf02234eea8e)},
-  /* 76 */ {10, 0.1600530732548213, CNST_LIMB(0x5938006c18900000), CNST_LIMB(0x6f46eb8574eb59dd)},
-  /* 77 */ {10, 0.1595714156699382, CNST_LIMB(0x65ad9912474aa649), CNST_LIMB(0x42459b481df47cec)},
-  /* 78 */ {10, 0.1590988078692941, CNST_LIMB(0x73ae9ff4241ec400), CNST_LIMB(0x1b424b95d80ca505)},
-  /* 79 */ {10, 0.1586349589155960, CNST_LIMB(0x836612ee9c4ce1e1), CNST_LIMB(0xf2c1b982203a0dac)},
-  /* 80 */ {10, 0.1581795909397823, CNST_LIMB(0x9502f90000000000), CNST_LIMB(0xb7cdfd9d7bdbab7d)},
-  /* 81 */ {10, 0.1577324383928644, CNST_LIMB(0xa8b8b452291fe821), CNST_LIMB(0x846d550e37b5063d)},
-  /* 82 */ {10, 0.1572932473495469, CNST_LIMB(0xbebf59a07dab4400), CNST_LIMB(0x57931eeaf85cf64f)},
-  /* 83 */ {10, 0.1568617748594410, CNST_LIMB(0xd7540d4093bc3109), CNST_LIMB(0x305a944507c82f47)},
-  /* 84 */ {10, 0.1564377883420716, CNST_LIMB(0xf2b96616f1900000), CNST_LIMB(0xe007ccc9c22781a)},
-  /* 85 */ {9, 0.1560210650222250, CNST_LIMB(0x336de62af2bca35), CNST_LIMB(0x3e92c42e000eeed4)},
-  /* 86 */ {9, 0.1556113914024940, CNST_LIMB(0x39235ec33d49600), CNST_LIMB(0x1ebe59130db2795e)},
-  /* 87 */ {9, 0.1552085627701551, CNST_LIMB(0x3f674e539585a17), CNST_LIMB(0x268859e90f51b89)},
-  /* 88 */ {9, 0.1548123827357682, CNST_LIMB(0x4645b6958000000), CNST_LIMB(0xd24cde0463108cfa)},
-  /* 89 */ {9, 0.1544226628011101, CNST_LIMB(0x4dcb74afbc49c19), CNST_LIMB(0xa536009f37adc383)},
-  /* 90 */ {9, 0.1540392219542636, CNST_LIMB(0x56064e1d18d9a00), CNST_LIMB(0x7cea06ce1c9ace10)},
-  /* 91 */ {9, 0.1536618862898642, CNST_LIMB(0x5f04fe2cd8a39fb), CNST_LIMB(0x58db032e72e8ba43)},
-  /* 92 */ {9, 0.1532904886526781, CNST_LIMB(0x68d74421f5c0000), CNST_LIMB(0x388cc17cae105447)},
-  /* 93 */ {9, 0.1529248683028321, CNST_LIMB(0x738df1f6ab4827d), CNST_LIMB(0x1b92672857620ce0)},
-  /* 94 */ {9, 0.1525648706011593, CNST_LIMB(0x7f3afbc9cfb5e00), CNST_LIMB(0x18c6a9575c2ade4)},
-  /* 95 */ {9, 0.1522103467132434, CNST_LIMB(0x8bf187fba88f35f), CNST_LIMB(0xd44da7da8e44b24f)},
-  /* 96 */ {9, 0.1518611533308632, CNST_LIMB(0x99c600000000000), CNST_LIMB(0xaa2f78f1b4cc6794)},
-  /* 97 */ {9, 0.1515171524096389, CNST_LIMB(0xa8ce21eb6531361), CNST_LIMB(0x843c067d091ee4cc)},
-  /* 98 */ {9, 0.1511782109217764, CNST_LIMB(0xb92112c1a0b6200), CNST_LIMB(0x62005e1e913356e3)},
-  /* 99 */ {9, 0.1508442006228941, CNST_LIMB(0xcad7718b8747c43), CNST_LIMB(0x4316eed01dedd518)},
-  /* 100 */ {9, 0.1505149978319906, CNST_LIMB(0xde0b6b3a7640000), CNST_LIMB(0x2725dd1d243aba0e)},
-  /* 101 */ {9, 0.1501904832236879, CNST_LIMB(0xf2d8cf5fe6d74c5), CNST_LIMB(0xddd9057c24cb54f)},
-  /* 102 */ {9, 0.1498705416319474, CNST_LIMB(0x1095d25bfa712600), CNST_LIMB(0xedeee175a736d2a1)},
-  /* 103 */ {9, 0.1495550618645152, CNST_LIMB(0x121b7c4c3698faa7), CNST_LIMB(0xc4699f3df8b6b328)},
-  /* 104 */ {9, 0.1492439365274121, CNST_LIMB(0x13c09e8d68000000), CNST_LIMB(0x9ebbe7d859cb5a7c)},
-  /* 105 */ {9, 0.1489370618588283, CNST_LIMB(0x15876ccb0b709ca9), CNST_LIMB(0x7c828b9887eb2179)},
-  /* 106 */ {9, 0.1486343375718350, CNST_LIMB(0x17723c2976da2a00), CNST_LIMB(0x5d652ab99001adcf)},
-  /* 107 */ {9, 0.1483356667053617, CNST_LIMB(0x198384e9c259048b), CNST_LIMB(0x4114f1754e5d7b32)},
-  /* 108 */ {9, 0.1480409554829326, CNST_LIMB(0x1bbde41dfeec0000), CNST_LIMB(0x274b7c902f7e0188)},
-  /* 109 */ {9, 0.1477501131786861, CNST_LIMB(0x1e241d6e3337910d), CNST_LIMB(0xfc9e0fbb32e210c)},
-  /* 110 */ {9, 0.1474630519902391, CNST_LIMB(0x20b91cee9901ee00), CNST_LIMB(0xf4afa3e594f8ea1f)},
-  /* 111 */ {9, 0.1471796869179852, CNST_LIMB(0x237ff9079863dfef), CNST_LIMB(0xcd85c32e9e4437b0)},
-  /* 112 */ {9, 0.1468999356504447, CNST_LIMB(0x267bf47000000000), CNST_LIMB(0xa9bbb147e0dd92a8)},
-  /* 113 */ {9, 0.1466237184553111, CNST_LIMB(0x29b08039fbeda7f1), CNST_LIMB(0x8900447b70e8eb82)},
-  /* 114 */ {9, 0.1463509580758620, CNST_LIMB(0x2d213df34f65f200), CNST_LIMB(0x6b0a92adaad5848a)},
-  /* 115 */ {9, 0.1460815796324244, CNST_LIMB(0x30d201d957a7c2d3), CNST_LIMB(0x4f990ad8740f0ee5)},
-  /* 116 */ {9, 0.1458155105286054, CNST_LIMB(0x34c6d52160f40000), CNST_LIMB(0x3670a9663a8d3610)},
-  /* 117 */ {9, 0.1455526803620167, CNST_LIMB(0x3903f855d8f4c755), CNST_LIMB(0x1f5c44188057be3c)},
-  /* 118 */ {9, 0.1452930208392428, CNST_LIMB(0x3d8de5c8ec59b600), CNST_LIMB(0xa2bea956c4e4977)},
-  /* 119 */ {9, 0.1450364656948130, CNST_LIMB(0x4269541d1ff01337), CNST_LIMB(0xed68b23033c3637e)},
-  /* 120 */ {9, 0.1447829506139581, CNST_LIMB(0x479b38e478000000), CNST_LIMB(0xc99cf624e50549c5)},
-  /* 121 */ {9, 0.1445324131589439, CNST_LIMB(0x4d28cb56c33fa539), CNST_LIMB(0xa8adf7ae45e7577b)},
-  /* 122 */ {9, 0.1442847926987864, CNST_LIMB(0x5317871fa13aba00), CNST_LIMB(0x8a5bc740b1c113e5)},
-  /* 123 */ {9, 0.1440400303421672, CNST_LIMB(0x596d2f44de9fa71b), CNST_LIMB(0x6e6c7efb81cfbb9b)},
-  /* 124 */ {9, 0.1437980688733775, CNST_LIMB(0x602fd125c47c0000), CNST_LIMB(0x54aba5c5cada5f10)},
-  /* 125 */ {9, 0.1435588526911310, CNST_LIMB(0x6765c793fa10079d), CNST_LIMB(0x3ce9a36f23c0fc90)},
-  /* 126 */ {9, 0.1433223277500932, CNST_LIMB(0x6f15be069b847e00), CNST_LIMB(0x26fb43de2c8cd2a8)},
-  /* 127 */ {9, 0.1430884415049874, CNST_LIMB(0x7746b3e82a77047f), CNST_LIMB(0x12b94793db8486a1)},
-  /* 128 */ {9, 0.1428571428571428, CNST_LIMB(0x7), CNST_LIMB(0x0)},
-  /* 129 */ {9, 0.1426283821033600, CNST_LIMB(0x894953f7ea890481), CNST_LIMB(0xdd5deca404c0156d)},
-  /* 130 */ {9, 0.1424021108869747, CNST_LIMB(0x932abffea4848200), CNST_LIMB(0xbd51373330291de0)},
-  /* 131 */ {9, 0.1421782821510107, CNST_LIMB(0x9dacb687d3d6a163), CNST_LIMB(0x9fa4025d66f23085)},
-  /* 132 */ {9, 0.1419568500933153, CNST_LIMB(0xa8d8102a44840000), CNST_LIMB(0x842530ee2db4949d)},
-  /* 133 */ {9, 0.1417377701235801, CNST_LIMB(0xb4b60f9d140541e5), CNST_LIMB(0x6aa7f2766b03dc25)},
-  /* 134 */ {9, 0.1415209988221527, CNST_LIMB(0xc15065d4856e4600), CNST_LIMB(0x53035ba7ebf32e8d)},
-  /* 135 */ {9, 0.1413064939005528, CNST_LIMB(0xceb1363f396d23c7), CNST_LIMB(0x3d12091fc9fb4914)},
-  /* 136 */ {9, 0.1410942141636095, CNST_LIMB(0xdce31b2488000000), CNST_LIMB(0x28b1cb81b1ef1849)},
-  /* 137 */ {9, 0.1408841194731412, CNST_LIMB(0xebf12a24bca135c9), CNST_LIMB(0x15c35be67ae3e2c9)},
-  /* 138 */ {9, 0.1406761707131039, CNST_LIMB(0xfbe6f8dbf88f4a00), CNST_LIMB(0x42a17bd09be1ff0)},
-  /* 139 */ {8, 0.1404703297561400, CNST_LIMB(0x1ef156c084ce761), CNST_LIMB(0x8bf461f03cf0bbf)},
-  /* 140 */ {8, 0.1402665594314587, CNST_LIMB(0x20c4e3b94a10000), CNST_LIMB(0xf3fbb43f68a32d05)},
-  /* 141 */ {8, 0.1400648234939879, CNST_LIMB(0x22b0695a08ba421), CNST_LIMB(0xd84f44c48564dc19)},
-  /* 142 */ {8, 0.1398650865947379, CNST_LIMB(0x24b4f35d7a4c100), CNST_LIMB(0xbe58ebcce7956abe)},
-  /* 143 */ {8, 0.1396673142523192, CNST_LIMB(0x26d397284975781), CNST_LIMB(0xa5fac463c7c134b7)},
-  /* 144 */ {8, 0.1394714728255649, CNST_LIMB(0x290d74100000000), CNST_LIMB(0x8f19241e28c7d757)},
-  /* 145 */ {8, 0.1392775294872041, CNST_LIMB(0x2b63b3a37866081), CNST_LIMB(0x799a6d046c0ae1ae)},
-  /* 146 */ {8, 0.1390854521985406, CNST_LIMB(0x2dd789f4d894100), CNST_LIMB(0x6566e37d746a9e40)},
-  /* 147 */ {8, 0.1388952096850913, CNST_LIMB(0x306a35e51b58721), CNST_LIMB(0x526887dbfb5f788f)},
-  /* 148 */ {8, 0.1387067714131417, CNST_LIMB(0x331d01712e10000), CNST_LIMB(0x408af3382b8efd3d)},
-  /* 149 */ {8, 0.1385201075671774, CNST_LIMB(0x35f14200a827c61), CNST_LIMB(0x2fbb374806ec05f1)},
-  /* 150 */ {8, 0.1383351890281539, CNST_LIMB(0x38e858b62216100), CNST_LIMB(0x1fe7c0f0afce87fe)},
-  /* 151 */ {8, 0.1381519873525671, CNST_LIMB(0x3c03b2c13176a41), CNST_LIMB(0x11003d517540d32e)},
-  /* 152 */ {8, 0.1379704747522905, CNST_LIMB(0x3f44c9b21000000), CNST_LIMB(0x2f5810f98eff0dc)},
-  /* 153 */ {8, 0.1377906240751463, CNST_LIMB(0x42ad23cef3113c1), CNST_LIMB(0xeb72e35e7840d910)},
-  /* 154 */ {8, 0.1376124087861776, CNST_LIMB(0x463e546b19a2100), CNST_LIMB(0xd27de19593dc3614)},
-  /* 155 */ {8, 0.1374358029495937, CNST_LIMB(0x49f9fc3f96684e1), CNST_LIMB(0xbaf391fd3e5e6fc2)},
-  /* 156 */ {8, 0.1372607812113589, CNST_LIMB(0x4de1c9c5dc10000), CNST_LIMB(0xa4bd38c55228c81d)},
-  /* 157 */ {8, 0.1370873187823978, CNST_LIMB(0x51f77994116d2a1), CNST_LIMB(0x8fc5a8de8e1de782)},
-  /* 158 */ {8, 0.1369153914223921, CNST_LIMB(0x563cd6bb3398100), CNST_LIMB(0x7bf9265bea9d3a3b)},
-  /* 159 */ {8, 0.1367449754241439, CNST_LIMB(0x5ab3bb270beeb01), CNST_LIMB(0x69454b325983dccd)},
-  /* 160 */ {8, 0.1365760475984821, CNST_LIMB(0x5f5e10000000000), CNST_LIMB(0x5798ee2308c39df9)},
-  /* 161 */ {8, 0.1364085852596902, CNST_LIMB(0x643dce0ec16f501), CNST_LIMB(0x46e40ba0fa66a753)},
-  /* 162 */ {8, 0.1362425662114337, CNST_LIMB(0x6954fe21e3e8100), CNST_LIMB(0x3717b0870b0db3a7)},
-  /* 163 */ {8, 0.1360779687331669, CNST_LIMB(0x6ea5b9755f440a1), CNST_LIMB(0x2825e6775d11cdeb)},
-  /* 164 */ {8, 0.1359147715670014, CNST_LIMB(0x74322a1c0410000), CNST_LIMB(0x1a01a1c09d1b4dac)},
-  /* 165 */ {8, 0.1357529539050150, CNST_LIMB(0x79fc8b6ae8a46e1), CNST_LIMB(0xc9eb0a8bebc8f3e)},
-  /* 166 */ {8, 0.1355924953769863, CNST_LIMB(0x80072a66d512100), CNST_LIMB(0xffe357ff59e6a004)},
-  /* 167 */ {8, 0.1354333760385373, CNST_LIMB(0x86546633b42b9c1), CNST_LIMB(0xe7dfd1be05fa61a8)},
-  /* 168 */ {8, 0.1352755763596663, CNST_LIMB(0x8ce6b0861000000), CNST_LIMB(0xd11ed6fc78f760e5)},
-  /* 169 */ {8, 0.1351190772136599, CNST_LIMB(0x93c08e16a022441), CNST_LIMB(0xbb8db609dd29ebfe)},
-  /* 170 */ {8, 0.1349638598663645, CNST_LIMB(0x9ae49717f026100), CNST_LIMB(0xa71aec8d1813d532)},
-  /* 171 */ {8, 0.1348099059658079, CNST_LIMB(0xa25577ae24c1a61), CNST_LIMB(0x93b612a9f20fbc02)},
-  /* 172 */ {8, 0.1346571975321549, CNST_LIMB(0xaa15f068e610000), CNST_LIMB(0x814fc7b19a67d317)},
-  /* 173 */ {8, 0.1345057169479844, CNST_LIMB(0xb228d6bf7577921), CNST_LIMB(0x6fd9a03f2e0a4b7c)},
-  /* 174 */ {8, 0.1343554469488779, CNST_LIMB(0xba91158ef5c4100), CNST_LIMB(0x5f4615a38d0d316e)},
-  /* 175 */ {8, 0.1342063706143054, CNST_LIMB(0xc351ad9aec0b681), CNST_LIMB(0x4f8876863479a286)},
-  /* 176 */ {8, 0.1340584713587980, CNST_LIMB(0xcc6db6100000000), CNST_LIMB(0x4094d8a3041b60eb)},
-  /* 177 */ {8, 0.1339117329233981, CNST_LIMB(0xd5e85d09025c181), CNST_LIMB(0x32600b8ed883a09b)},
-  /* 178 */ {8, 0.1337661393673756, CNST_LIMB(0xdfc4e816401c100), CNST_LIMB(0x24df8c6eb4b6d1f1)},
-  /* 179 */ {8, 0.1336216750601996, CNST_LIMB(0xea06b4c72947221), CNST_LIMB(0x18097a8ee151acef)},
-  /* 180 */ {8, 0.1334783246737591, CNST_LIMB(0xf4b139365210000), CNST_LIMB(0xbd48cc8ec1cd8e3)},
-  /* 181 */ {8, 0.1333360731748201, CNST_LIMB(0xffc80497d520961), CNST_LIMB(0x3807a8d67485fb)},
-  /* 182 */ {8, 0.1331949058177136, CNST_LIMB(0x10b4ebfca1dee100), CNST_LIMB(0xea5768860b62e8d8)},
-  /* 183 */ {8, 0.1330548081372441, CNST_LIMB(0x117492de921fc141), CNST_LIMB(0xd54faf5b635c5005)},
-  /* 184 */ {8, 0.1329157659418126, CNST_LIMB(0x123bb2ce41000000), CNST_LIMB(0xc14a56233a377926)},
-  /* 185 */ {8, 0.1327777653067443, CNST_LIMB(0x130a8b6157bdecc1), CNST_LIMB(0xae39a88db7cd329f)},
-  /* 186 */ {8, 0.1326407925678156, CNST_LIMB(0x13e15dede0e8a100), CNST_LIMB(0x9c10bde69efa7ab6)},
-  /* 187 */ {8, 0.1325048343149731, CNST_LIMB(0x14c06d941c0ca7e1), CNST_LIMB(0x8ac36c42a2836497)},
-  /* 188 */ {8, 0.1323698773862368, CNST_LIMB(0x15a7ff487a810000), CNST_LIMB(0x7a463c8b84f5ef67)},
-  /* 189 */ {8, 0.1322359088617821, CNST_LIMB(0x169859ddc5c697a1), CNST_LIMB(0x6a8e5f5ad090fd4b)},
-  /* 190 */ {8, 0.1321029160581950, CNST_LIMB(0x1791c60f6fed0100), CNST_LIMB(0x5b91a2943596fc56)},
-  /* 191 */ {8, 0.1319708865228925, CNST_LIMB(0x18948e8c0e6fba01), CNST_LIMB(0x4d4667b1c468e8f0)},
-  /* 192 */ {8, 0.1318398080287045, CNST_LIMB(0x19a1000000000000), CNST_LIMB(0x3fa39ab547994daf)},
-  /* 193 */ {8, 0.1317096685686114, CNST_LIMB(0x1ab769203dafc601), CNST_LIMB(0x32a0a9b2faee1e2a)},
-  /* 194 */ {8, 0.1315804563506306, CNST_LIMB(0x1bd81ab557f30100), CNST_LIMB(0x26357ceac0e96962)},
-  /* 195 */ {8, 0.1314521597928493, CNST_LIMB(0x1d0367a69fed1ba1), CNST_LIMB(0x1a5a6f65caa5859e)},
-  /* 196 */ {8, 0.1313247675185968, CNST_LIMB(0x1e39a5057d810000), CNST_LIMB(0xf08480f672b4e86)},
-  /* 197 */ {8, 0.1311982683517524, CNST_LIMB(0x1f7b2a18f29ac3e1), CNST_LIMB(0x4383340615612ca)},
-  /* 198 */ {8, 0.1310726513121843, CNST_LIMB(0x20c850694c2aa100), CNST_LIMB(0xf3c77969ee4be5a2)},
-  /* 199 */ {8, 0.1309479056113158, CNST_LIMB(0x222173cc014980c1), CNST_LIMB(0xe00993cc187c5ec9)},
-  /* 200 */ {8, 0.1308240206478128, CNST_LIMB(0x2386f26fc1000000), CNST_LIMB(0xcd2b297d889bc2b6)},
-  /* 201 */ {8, 0.1307009860033912, CNST_LIMB(0x24f92ce8af296d41), CNST_LIMB(0xbb214d5064862b22)},
-  /* 202 */ {8, 0.1305787914387386, CNST_LIMB(0x2678863cd0ece100), CNST_LIMB(0xa9e1a7ca7ea10e20)},
-  /* 203 */ {8, 0.1304574268895465, CNST_LIMB(0x280563f0a9472d61), CNST_LIMB(0x99626e72b39ea0cf)},
-  /* 204 */ {8, 0.1303368824626505, CNST_LIMB(0x29a02e1406210000), CNST_LIMB(0x899a5ba9c13fafd9)},
-  /* 205 */ {8, 0.1302171484322746, CNST_LIMB(0x2b494f4efe6d2e21), CNST_LIMB(0x7a80a705391e96ff)},
-  /* 206 */ {8, 0.1300982152363760, CNST_LIMB(0x2d0134ef21cbc100), CNST_LIMB(0x6c0cfe23de23042a)},
-  /* 207 */ {8, 0.1299800734730872, CNST_LIMB(0x2ec84ef4da2ef581), CNST_LIMB(0x5e377df359c944dd)},
-  /* 208 */ {8, 0.1298627138972530, CNST_LIMB(0x309f102100000000), CNST_LIMB(0x50f8ac5fc8f53985)},
-  /* 209 */ {8, 0.1297461274170591, CNST_LIMB(0x3285ee02a1420281), CNST_LIMB(0x44497266278e35b7)},
-  /* 210 */ {8, 0.1296303050907487, CNST_LIMB(0x347d6104fc324100), CNST_LIMB(0x382316831f7ee175)},
-  /* 211 */ {8, 0.1295152381234257, CNST_LIMB(0x3685e47dade53d21), CNST_LIMB(0x2c7f377833b8946e)},
-  /* 212 */ {8, 0.1294009178639407, CNST_LIMB(0x389ff6bb15610000), CNST_LIMB(0x2157c761ab4163ef)},
-  /* 213 */ {8, 0.1292873358018581, CNST_LIMB(0x3acc1912ebb57661), CNST_LIMB(0x16a7071803cc49a9)},
-  /* 214 */ {8, 0.1291744835645007, CNST_LIMB(0x3d0acff111946100), CNST_LIMB(0xc6781d80f8224fc)},
-  /* 215 */ {8, 0.1290623529140715, CNST_LIMB(0x3f5ca2e692eaf841), CNST_LIMB(0x294092d370a900b)},
-  /* 216 */ {8, 0.1289509357448472, CNST_LIMB(0x41c21cb8e1000000), CNST_LIMB(0xf24f62335024a295)},
-  /* 217 */ {8, 0.1288402240804449, CNST_LIMB(0x443bcb714399a5c1), CNST_LIMB(0xe03b98f103fad6d2)},
-  /* 218 */ {8, 0.1287302100711567, CNST_LIMB(0x46ca406c81af2100), CNST_LIMB(0xcee3d32cad2a9049)},
-  /* 219 */ {8, 0.1286208859913518, CNST_LIMB(0x496e106ac22aaae1), CNST_LIMB(0xbe3f9df9277fdada)},
-  /* 220 */ {8, 0.1285122442369443, CNST_LIMB(0x4c27d39fa5410000), CNST_LIMB(0xae46f0d94c05e933)},
-  /* 221 */ {8, 0.1284042773229231, CNST_LIMB(0x4ef825c296e43ca1), CNST_LIMB(0x9ef2280fb437a33d)},
-  /* 222 */ {8, 0.1282969778809442, CNST_LIMB(0x51dfa61f5ad88100), CNST_LIMB(0x9039ff426d3f284b)},
-  /* 223 */ {8, 0.1281903386569819, CNST_LIMB(0x54def7a6d2f16901), CNST_LIMB(0x82178c6d6b51f8f4)},
-  /* 224 */ {8, 0.1280843525090381, CNST_LIMB(0x57f6c10000000000), CNST_LIMB(0x74843b1ee4c1e053)},
-  /* 225 */ {8, 0.1279790124049077, CNST_LIMB(0x5b27ac993df97701), CNST_LIMB(0x6779c7f90dc42f48)},
-  /* 226 */ {8, 0.1278743114199984, CNST_LIMB(0x5e7268b9bbdf8100), CNST_LIMB(0x5af23c74f9ad9fe9)},
-  /* 227 */ {8, 0.1277702427352035, CNST_LIMB(0x61d7a7932ff3d6a1), CNST_LIMB(0x4ee7eae2acdc617e)},
-  /* 228 */ {8, 0.1276667996348261, CNST_LIMB(0x65581f53c8c10000), CNST_LIMB(0x43556aa2ac262a0b)},
-  /* 229 */ {8, 0.1275639755045533, CNST_LIMB(0x68f48a385b8320e1), CNST_LIMB(0x3835949593b8ddd1)},
-  /* 230 */ {8, 0.1274617638294791, CNST_LIMB(0x6cada69ed07c2100), CNST_LIMB(0x2d837fbe78458762)},
-  /* 231 */ {8, 0.1273601581921741, CNST_LIMB(0x70843718cdbf27c1), CNST_LIMB(0x233a7e150a54a555)},
-  /* 232 */ {8, 0.1272591522708010, CNST_LIMB(0x7479027ea1000000), CNST_LIMB(0x19561984a50ff8fe)},
-  /* 233 */ {8, 0.1271587398372755, CNST_LIMB(0x788cd40268f39641), CNST_LIMB(0xfd211159fe3490f)},
-  /* 234 */ {8, 0.1270589147554692, CNST_LIMB(0x7cc07b437ecf6100), CNST_LIMB(0x6aa563e655033e3)},
-  /* 235 */ {8, 0.1269596709794558, CNST_LIMB(0x8114cc6220762061), CNST_LIMB(0xfbb614b3f2d3b14c)},
-  /* 236 */ {8, 0.1268610025517973, CNST_LIMB(0x858aa0135be10000), CNST_LIMB(0xeac0f8837fb05773)},
-  /* 237 */ {8, 0.1267629036018709, CNST_LIMB(0x8a22d3b53c54c321), CNST_LIMB(0xda6e4c10e8615ca5)},
-  /* 238 */ {8, 0.1266653683442337, CNST_LIMB(0x8ede496339f34100), CNST_LIMB(0xcab755a8d01fa67f)},
-  /* 239 */ {8, 0.1265683910770258, CNST_LIMB(0x93bde80aec3a1481), CNST_LIMB(0xbb95a9ae71aa3e0c)},
-  /* 240 */ {8, 0.1264719661804097, CNST_LIMB(0x98c29b8100000000), CNST_LIMB(0xad0326c296b4f529)},
-  /* 241 */ {8, 0.1263760881150453, CNST_LIMB(0x9ded549671832381), CNST_LIMB(0x9ef9f21eed31b7c1)},
-  /* 242 */ {8, 0.1262807514205999, CNST_LIMB(0xa33f092e0b1ac100), CNST_LIMB(0x91747422be14b0b2)},
-  /* 243 */ {8, 0.1261859507142915, CNST_LIMB(0xa8b8b452291fe821), CNST_LIMB(0x846d550e37b5063d)},
-  /* 244 */ {8, 0.1260916806894653, CNST_LIMB(0xae5b564ac3a10000), CNST_LIMB(0x77df79e9a96c06f6)},
-  /* 245 */ {8, 0.1259979361142023, CNST_LIMB(0xb427f4b3be74c361), CNST_LIMB(0x6bc6019636c7d0c2)},
-  /* 246 */ {8, 0.1259047118299582, CNST_LIMB(0xba1f9a938041e100), CNST_LIMB(0x601c4205aebd9e47)},
-  /* 247 */ {8, 0.1258120027502338, CNST_LIMB(0xc0435871d1110f41), CNST_LIMB(0x54ddc59756f05016)},
-  /* 248 */ {8, 0.1257198038592741, CNST_LIMB(0xc694446f01000000), CNST_LIMB(0x4a0648979c838c18)},
-  /* 249 */ {8, 0.1256281102107963, CNST_LIMB(0xcd137a5b57ac3ec1), CNST_LIMB(0x3f91b6e0bb3a053d)},
-  /* 250 */ {8, 0.1255369169267456, CNST_LIMB(0xd3c21bcecceda100), CNST_LIMB(0x357c299a88ea76a5)},
-  /* 251 */ {8, 0.1254462191960791, CNST_LIMB(0xdaa150410b788de1), CNST_LIMB(0x2bc1e517aecc56e3)},
-  /* 252 */ {8, 0.1253560122735751, CNST_LIMB(0xe1b24521be010000), CNST_LIMB(0x225f56ceb3da9f5d)},
-  /* 253 */ {8, 0.1252662914786691, CNST_LIMB(0xe8f62df12777c1a1), CNST_LIMB(0x1951136d53ad63ac)},
-  /* 254 */ {8, 0.1251770521943144, CNST_LIMB(0xf06e445906fc0100), CNST_LIMB(0x1093d504b3cd7d93)},
-  /* 255 */ {8, 0.1250882898658681, CNST_LIMB(0xf81bc845c81bf801), CNST_LIMB(0x824794d1ec1814f)},
-};
-#endif
diff --git a/ghc/rts/gmp/mpn/ns32k/add_n.s b/ghc/rts/gmp/mpn/ns32k/add_n.s
deleted file mode 100644
index bd063d07d9..0000000000
--- a/ghc/rts/gmp/mpn/ns32k/add_n.s
+++ /dev/null
@@ -1,46 +0,0 @@
-# ns32000 __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
-# sum in a third limb vector.
-
-# Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-	.align 1
-.globl ___gmpn_add_n
-___gmpn_add_n:
-	save	[r3,r4,r5]
-	negd	28(sp),r3
-	movd	r3,r0
-	lshd	2,r0
-	movd	24(sp),r4
-	subd	r0,r4			# r4 -> to end of S2
-	movd	20(sp),r5
-	subd	r0,r5			# r5 -> to end of S1
-	movd	16(sp),r2
-	subd	r0,r2			# r2 -> to end of RES
-	subd	r0,r0			# cy = 0
-
-Loop:	movd	r5[r3:d],r0
-	addcd	r4[r3:d],r0
-	movd	r0,r2[r3:d]
-	acbd	1,r3,Loop
-
-	scsd	r0			# r0 = cy.
-	restore	[r5,r4,r3]
-	ret	0
diff --git a/ghc/rts/gmp/mpn/ns32k/addmul_1.s b/ghc/rts/gmp/mpn/ns32k/addmul_1.s
deleted file mode 100644
index df0dcdd4af..0000000000
--- a/ghc/rts/gmp/mpn/ns32k/addmul_1.s
+++ /dev/null
@@ -1,48 +0,0 @@
-# ns32000 __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
-# the result to a second limb vector.
-
-# Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-	.align 1
-.globl ___gmpn_addmul_1
-___gmpn_addmul_1:
-	save	[r3,r4,r5,r6,r7]
-	negd	24(sp),r4
-	movd	r4,r0
-	lshd	2,r0
-	movd	20(sp),r5
-	subd	r0,r5			# r5 -> to end of S1
-	movd	16(sp),r6
-	subd	r0,r6			# r6 -> to end of RES
-	subd	r0,r0			# r0 = 0, cy = 0
-	movd	28(sp),r7		# r7 = s2_limb
-
-Loop:	movd	r5[r4:d],r2
-	meid	r7,r2			# r2 = low_prod, r3 = high_prod
-	addcd	r0,r2			# r2 = low_prod + cy_limb
-	movd	r3,r0			# r0 = new cy_limb
-	addcd	0,r0
-	addd	r2,r6[r4:d]
-	acbd	1,r4,Loop
-
-	addcd	0,r0
-	restore	[r7,r6,r5,r4,r3]
-	ret	0
diff --git a/ghc/rts/gmp/mpn/ns32k/mul_1.s b/ghc/rts/gmp/mpn/ns32k/mul_1.s
deleted file mode 100644
index 0a77efba29..0000000000
--- a/ghc/rts/gmp/mpn/ns32k/mul_1.s
+++ /dev/null
@@ -1,47 +0,0 @@
-# ns32000 __gmpn_mul_1 -- Multiply a limb vector with a limb and store
-# the result in a second limb vector.
-
-# Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-	.align 1
-.globl ___gmpn_mul_1
-___gmpn_mul_1:
-	save	[r3,r4,r5,r6,r7]
-	negd	24(sp),r4
-	movd	r4,r0
-	lshd	2,r0
-	movd	20(sp),r5
-	subd	r0,r5			# r5 -> to end of S1
-	movd	16(sp),r6
-	subd	r0,r6			# r6 -> to end of RES
-	subd	r0,r0			# r0 = 0, cy = 0
-	movd	28(sp),r7		# r7 = s2_limb
-
-Loop:	movd	r5[r4:d],r2
-	meid	r7,r2			# r2 = low_prod, r3 = high_prod
-	addcd	r0,r2			# r2 = low_prod + cy_limb
-	movd	r3,r0			# r0 = new cy_limb
-	movd	r2,r6[r4:d]
-	acbd	1,r4,Loop
-
-	addcd	0,r0
-	restore	[r7,r6,r5,r4,r3]
-	ret	0
diff --git a/ghc/rts/gmp/mpn/ns32k/sub_n.s b/ghc/rts/gmp/mpn/ns32k/sub_n.s
deleted file mode 100644
index cd89f4fd3f..0000000000
--- a/ghc/rts/gmp/mpn/ns32k/sub_n.s
+++ /dev/null
@@ -1,46 +0,0 @@
-# ns32000 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
-# store difference in a third limb vector.
-
-# Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-	.align 1
-.globl ___gmpn_sub_n
-___gmpn_sub_n:
-	save	[r3,r4,r5]
-	negd	28(sp),r3
-	movd	r3,r0
-	lshd	2,r0
-	movd	24(sp),r4
-	subd	r0,r4			# r4 -> to end of S2
-	movd	20(sp),r5
-	subd	r0,r5			# r5 -> to end of S1
-	movd	16(sp),r2
-	subd	r0,r2			# r2 -> to end of RES
-	subd	r0,r0			# cy = 0
-
-Loop:	movd	r5[r3:d],r0
-	subcd	r4[r3:d],r0
-	movd	r0,r2[r3:d]
-	acbd	1,r3,Loop
-
-	scsd	r0			# r0 = cy.
-	restore	[r5,r4,r3]
-	ret	0
diff --git a/ghc/rts/gmp/mpn/ns32k/submul_1.s b/ghc/rts/gmp/mpn/ns32k/submul_1.s
deleted file mode 100644
index f811aedcf1..0000000000
--- a/ghc/rts/gmp/mpn/ns32k/submul_1.s
+++ /dev/null
@@ -1,48 +0,0 @@
-# ns32000 __gmpn_submul_1 -- Multiply a limb vector with a limb and subtract
-# the result from a second limb vector.
-
-# Copyright (C) 1992, 1994, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-	.align 1
-.globl ___gmpn_submul_1
-___gmpn_submul_1:
-	save	[r3,r4,r5,r6,r7]
-	negd	24(sp),r4
-	movd	r4,r0
-	lshd	2,r0
-	movd	20(sp),r5
-	subd	r0,r5			# r5 -> to end of S1
-	movd	16(sp),r6
-	subd	r0,r6			# r6 -> to end of RES
-	subd	r0,r0			# r0 = 0, cy = 0
-	movd	28(sp),r7		# r7 = s2_limb
-
-Loop:	movd	r5[r4:d],r2
-	meid	r7,r2			# r2 = low_prod, r3 = high_prod
-	addcd	r0,r2			# r2 = low_prod + cy_limb
-	movd	r3,r0			# r0 = new cy_limb
-	addcd	0,r0
-	subd	r2,r6[r4:d]
-	acbd	1,r4,Loop
-
-	addcd	0,r0
-	restore	[r7,r6,r5,r4,r3]
-	ret	0
diff --git a/ghc/rts/gmp/mpn/pa64/README b/ghc/rts/gmp/mpn/pa64/README
deleted file mode 100644
index 8d2976dabc..0000000000
--- a/ghc/rts/gmp/mpn/pa64/README
+++ /dev/null
@@ -1,38 +0,0 @@
-This directory contains mpn functions for 64-bit PA-RISC 2.0.
-
-RELEVANT OPTIMIZATION ISSUES
-
-The PA8000 has a multi-issue pipeline with large buffers for instructions
-awaiting pending results.  Therefore, no latency scheduling is necessary
-(and might actually be harmful).
-
-Two 64-bit loads can be completed per cycle.  One 64-bit store can be
-completed per cycle.  A store cannot complete in the same cycle as a load.
-
-STATUS
-
-* mpn_lshift, mpn_rshift, mpn_add_n, mpn_sub_n are all well-tuned and run at
-  the peak cache bandwidth; 1.5 cycles/limb for shifting and 2.0 cycles/limb
-  for add/subtract.
-
-* The multiplication functions run at 11 cycles/limb.  The cache bandwidth
-  allows 7.5 cycles/limb.  Perhaps it would be possible, using unrolling or
-  better scheduling, to get closer to the cache bandwidth limit.
-
-* xaddmul_1.S contains a quicker method for forming the 128 bit product.  It
-  uses some fewer operations, and keep the carry flag live across the loop
-  boundary.  But it seems hard to make it run more than 1/4 cycle faster
-  than the old code.  Perhaps we really ought to unroll this loop be 2x?
-  2x should suffice since register latency schedling is never needed,
-  but the unrolling would hide the store-load latency.  Here is a sketch:
-
-	1. A multiply and store 64-bit products
-	2. B sum 64-bit products 128-bit product
-	3. B load  64-bit products to integer registers
-	4. B multiply and store 64-bit products
-	5. A sum 64-bit products 128-bit product
-	6. A load  64-bit products to integer registers
-	7. goto 1
-
-  In practice, adjacent groups (1 and 2, 2 and 3, etc) will be interleaved
-  for better instruction mix.
diff --git a/ghc/rts/gmp/mpn/pa64/add_n.s b/ghc/rts/gmp/mpn/pa64/add_n.s
deleted file mode 100644
index 22ff19c184..0000000000
--- a/ghc/rts/gmp/mpn/pa64/add_n.s
+++ /dev/null
@@ -1,90 +0,0 @@
-; HP-PA 2.0 __gmpn_add_n -- Add two limb vectors of the same length > 0 and
-; store sum in a third limb vector.
-
-; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; s2_ptr	gr24
-; size		gr23
-
-; This runs at 2 cycles/limb on PA8000.
-
-	.level	2.0n
-	.code
-	.export	__gmpn_add_n,entry
-__gmpn_add_n
-	.proc
-	.callinfo frame=0,args_saved
-	.entry
-
-	sub		%r0,%r23,%r22
-	depw,z		%r22,30,3,%r28		; r28 = 2 * (-n & 7)
-	depw,z		%r22,28,3,%r22		; r22 = 8 * (-n & 7)
-	sub		%r25,%r22,%r25		; offset s1_ptr
-	sub		%r24,%r22,%r24		; offset s2_ptr
-	sub		%r26,%r22,%r26		; offset res_ptr
-	blr		%r28,%r0		; branch into loop
-	add		%r0,%r0,%r0		; reset carry
-
-L$loop	ldd		0(%r25),%r20
-	ldd		0(%r24),%r31
-	add,dc		%r20,%r31,%r20
-	std		%r20,0(%r26)
-L$7	ldd		8(%r25),%r21
-	ldd		8(%r24),%r19
-	add,dc		%r21,%r19,%r21
-	std		%r21,8(%r26)
-L$6	ldd		16(%r25),%r20
-	ldd		16(%r24),%r31
-	add,dc		%r20,%r31,%r20
-	std		%r20,16(%r26)
-L$5	ldd		24(%r25),%r21
-	ldd		24(%r24),%r19
-	add,dc		%r21,%r19,%r21
-	std		%r21,24(%r26)
-L$4	ldd		32(%r25),%r20
-	ldd		32(%r24),%r31
-	add,dc		%r20,%r31,%r20
-	std		%r20,32(%r26)
-L$3	ldd		40(%r25),%r21
-	ldd		40(%r24),%r19
-	add,dc		%r21,%r19,%r21
-	std		%r21,40(%r26)
-L$2	ldd		48(%r25),%r20
-	ldd		48(%r24),%r31
-	add,dc		%r20,%r31,%r20
-	std		%r20,48(%r26)
-L$1	ldd		56(%r25),%r21
-	ldo		64(%r25),%r25
-	ldd		56(%r24),%r19
-	add,dc		%r21,%r19,%r21
-	std		%r21,56(%r26)
-	ldo		64(%r24),%r24
-	addib,>		-8,%r23,L$loop
-	ldo		64(%r26),%r26
-
-	add,dc		%r0,%r0,%r29
-	bve		(%r2)
-	.exit
-	ldi		0,%r28
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64/addmul_1.S b/ghc/rts/gmp/mpn/pa64/addmul_1.S
deleted file mode 100644
index b1885b432c..0000000000
--- a/ghc/rts/gmp/mpn/pa64/addmul_1.S
+++ /dev/null
@@ -1,167 +0,0 @@
-; HP-PA 2.0 64-bit __gmpn_addmul_1 -- Multiply a limb vector with a limb and
-; add the result to a second limb vector.
-
-; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-; INPUT PARAMETERS
-#define rptr		%r26
-#define sptr		%r25
-#define size		%r24
-#define s2limb		-56(%r30)
-
-; This runs at 11 cycles/limb on a PA8000.  It might be possible to make
-; it faster, but the PA8000 pipeline is not publically documented and it
-; is very complex to reverse engineer
-
-#define t1 %r19
-#define rlimb %r20
-#define hi %r21
-#define lo %r22
-#define m0 %r28
-#define m1 %r3
-#define cylimb %r29
-#define t3 %r4
-#define t2 %r6
-#define t5 %r23
-#define t4 %r31
-	.level  2.0n
-	.code
-	.export __gmpn_addmul_1,entry
-__gmpn_addmul_1
-	.proc
-	.callinfo frame=128,no_calls
-	.entry
-        fldd		-56(%r30),%fr5		; s2limb passed on stack
-	ldo		128(%r30),%r30
-	add		%r0,%r0,cylimb		; clear cy and cylimb
-
-	std		%r3,-96(%r30)
-	std		%r4,-88(%r30)
-	std		%r5,-80(%r30)
-	std		%r6,-72(%r30)
-	depdi,z		1,31,1,%r5
-
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	addib,=		-1,%r24,L$end1
-	nop
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-	addib,=		-1,%r24,L$end2
-	nop
-L$loop
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		0(rptr),rlimb
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m1
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	add		cylimb,rlimb,rlimb
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	add,dc		t2,hi,cylimb
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	add		t4,rlimb,t3
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	add,dc		%r0,cylimb,cylimb
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-	std		t3,0(rptr)
-	addib,<>	-1,%r24,L$loop
-	ldo		8(rptr),rptr
-L$end2
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		0(rptr),rlimb
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m0
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	add		cylimb,rlimb,rlimb
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	add,dc		t2,hi,cylimb
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	add		t4,rlimb,t3
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	add,dc		%r0,cylimb,cylimb
-	std		t3,0(rptr)
-	ldo		8(rptr),rptr
-L$end1
-	ldd		0(rptr),rlimb
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m0
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	add		cylimb,rlimb,rlimb
-	add,dc		t2,hi,cylimb
-	add		t4,rlimb,t3
-	add,dc		%r0,cylimb,cylimb
-	std		t3,0(rptr)
-	ldo		8(rptr),rptr
-
-	ldd		-96(%r30),%r3
-	ldd		-88(%r30),%r4
-	ldd		-80(%r30),%r5
-	ldd		-72(%r30),%r6
-
-	extrd,u		cylimb,31,32,%r28
-	bve		(%r2)
-	.exit
-	ldo		-128(%r30),%r30
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64/gmp-mparam.h b/ghc/rts/gmp/mpn/pa64/gmp-mparam.h
deleted file mode 100644
index 847735b987..0000000000
--- a/ghc/rts/gmp/mpn/pa64/gmp-mparam.h
+++ /dev/null
@@ -1,65 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 64
-#define BYTES_PER_MP_LIMB 8
-#define BITS_PER_LONGINT 64
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-/* These values were measured in a PA8000 using the system compiler version
-   A.10.32.30.  Presumably the PA8200 and PA8500 have the same timing
-   characteristic, but GCC might give somewhat different results.  */
-/* Generated by tuneup.c, 2000-07-25. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD   16
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD      105
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD   40
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD      116
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD              72
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD             94
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            50
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD       46
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD           1
-#endif
diff --git a/ghc/rts/gmp/mpn/pa64/lshift.s b/ghc/rts/gmp/mpn/pa64/lshift.s
deleted file mode 100644
index 994bc1c4d6..0000000000
--- a/ghc/rts/gmp/mpn/pa64/lshift.s
+++ /dev/null
@@ -1,103 +0,0 @@
-; HP-PA 2.0 __gmpn_lshift --
-
-; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; size		gr24
-; cnt		gr23
-
-; This runs at 1.5 cycles/limb on PA8000.
-
-	.level	2.0n
-	.code
-	.export	__gmpn_lshift,entry
-__gmpn_lshift
-	.proc
-	.callinfo frame=0,args_saved
-	.entry
-
-	shladd		%r24,3,%r25,%r25
-	shladd		%r24,3,%r26,%r26
-	subi		64,%r23,%r23
-	mtsar		%r23
-	ldd		-8(%r25),%r21
-	addib,=		-1,%r24,L$end
-	shrpd		%r0,%r21,%sar,%r29	; compute carry out limb
-	depw,z		%r24,31,3,%r28		; r28 = (size & 7)
-	sub		%r0,%r24,%r22
-	depw,z		%r22,28,3,%r22		; r22 = 8 * (-size & 7)
-	add		%r25,%r22,%r25		; offset s1_ptr
-	blr		%r28,%r0		; branch into jump table
-	add		%r26,%r22,%r26		; offset res_ptr
-	b		L$0
-	nop
-	b		L$1
-	copy		%r21,%r20
-	b		L$2
-	nop
-	b		L$3
-	copy		%r21,%r20
-	b		L$4
-	nop
-	b		L$5
-	copy		%r21,%r20
-	b		L$6
-	nop
-	b		L$7
-	copy		%r21,%r20
-
-L$loop
-L$0	ldd		-16(%r25),%r20
-	shrpd		%r21,%r20,%sar,%r21
-	std		%r21,-8(%r26)
-L$7	ldd		-24(%r25),%r21
-	shrpd		%r20,%r21,%sar,%r20
-	std		%r20,-16(%r26)
-L$6	ldd		-32(%r25),%r20
-	shrpd		%r21,%r20,%sar,%r21
-	std		%r21,-24(%r26)
-L$5	ldd		-40(%r25),%r21
-	shrpd		%r20,%r21,%sar,%r20
-	std		%r20,-32(%r26)
-L$4	ldd		-48(%r25),%r20
-	shrpd		%r21,%r20,%sar,%r21
-	std		%r21,-40(%r26)
-L$3	ldd		-56(%r25),%r21
-	shrpd		%r20,%r21,%sar,%r20
-	std		%r20,-48(%r26)
-L$2	ldd		-64(%r25),%r20
-	shrpd		%r21,%r20,%sar,%r21
-	std		%r21,-56(%r26)
-L$1	ldd		-72(%r25),%r21
-	ldo		-64(%r25),%r25
-	shrpd		%r20,%r21,%sar,%r20
-	std		%r20,-64(%r26)
-	addib,>		-8,%r24,L$loop
-	ldo		-64(%r26),%r26
-
-L$end	shrpd		%r21,%r0,%sar,%r21
-	std		%r21,-8(%r26)
-	bve		(%r2)
-	.exit
-	extrd,u		%r29,31,32,%r28
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64/mul_1.S b/ghc/rts/gmp/mpn/pa64/mul_1.S
deleted file mode 100644
index ab310c1264..0000000000
--- a/ghc/rts/gmp/mpn/pa64/mul_1.S
+++ /dev/null
@@ -1,158 +0,0 @@
-; HP-PA 2.0 64-bit __gmpn_mul_1 -- Multiply a limb vector with a limb and
-; store the result in a second limb vector.
-
-; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-; INPUT PARAMETERS
-#define rptr		%r26
-#define sptr		%r25
-#define size		%r24
-#define s2limb		-56(%r30)
-
-; This runs at 11 cycles/limb on a PA8000.  It might be possible to make
-; it faster, but the PA8000 pipeline is not publically documented and it
-; is very complex to reverse engineer
-
-#define t1 %r19
-#define rlimb %r20
-#define hi %r21
-#define lo %r22
-#define m0 %r28
-#define m1 %r3
-#define cylimb %r29
-#define t3 %r4
-#define t2 %r6
-#define t5 %r23
-#define t4 %r31
-	.level  2.0n
-	.code
-	.export __gmpn_mul_1,entry
-__gmpn_mul_1
-	.proc
-	.callinfo frame=128,no_calls
-	.entry
-        fldd		-56(%r30),%fr5		; s2limb passed on stack
-	ldo		128(%r30),%r30
-	add		%r0,%r0,cylimb		; clear cy and cylimb
-
-	std		%r3,-96(%r30)
-	std		%r4,-88(%r30)
-	std		%r5,-80(%r30)
-	std		%r6,-72(%r30)
-	depdi,z		1,31,1,%r5
-
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	addib,=		-1,%r24,L$end1
-	nop
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-	addib,=		-1,%r24,L$end2
-	nop
-L$loop
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m1
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	add		cylimb,t4,t3
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	add,dc		t2,hi,cylimb
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-	std		t3,0(rptr)
-	addib,<>	-1,%r24,L$loop
-	ldo		8(rptr),rptr
-L$end2
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m0
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	add		cylimb,t4,t3
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	add,dc		t2,hi,cylimb
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	std		t3,0(rptr)
-	ldo		8(rptr),rptr
-L$end1
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t2 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m0
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	add		cylimb,t4,t3
-	add,dc		t2,hi,cylimb
-	std		t3,0(rptr)
-	ldo		8(rptr),rptr
-
-	ldd		-96(%r30),%r3
-	ldd		-88(%r30),%r4
-	ldd		-80(%r30),%r5
-	ldd		-72(%r30),%r6
-
-	extrd,u		cylimb,31,32,%r28
-	bve		(%r2)
-	.exit
-	ldo		-128(%r30),%r30
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64/rshift.s b/ghc/rts/gmp/mpn/pa64/rshift.s
deleted file mode 100644
index f0730e2a91..0000000000
--- a/ghc/rts/gmp/mpn/pa64/rshift.s
+++ /dev/null
@@ -1,100 +0,0 @@
-; HP-PA 2.0 __gmpn_rshift --
-
-; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; size		gr24
-; cnt		gr23
-
-; This runs at 1.5 cycles/limb on PA8000.
-
-	.level	2.0n
-	.code
-	.export	__gmpn_rshift,entry
-__gmpn_rshift
-	.proc
-	.callinfo frame=0,args_saved
-	.entry
-
-	mtsar		%r23
-	ldd		0(%r25),%r21
-	addib,=		-1,%r24,L$end
-	shrpd		%r21,%r0,%sar,%r29	; compute carry out limb
-	depw,z		%r24,31,3,%r28		; r28 = (size & 7)
-	sub		%r0,%r24,%r22
-	depw,z		%r22,28,3,%r22		; r22 = 8 * (-size & 7)
-	sub		%r25,%r22,%r25		; offset s1_ptr
-	blr		%r28,%r0		; branch into jump table
-	sub		%r26,%r22,%r26		; offset res_ptr
-	b		L$0
-	nop
-	b		L$1
-	copy		%r21,%r20
-	b		L$2
-	nop
-	b		L$3
-	copy		%r21,%r20
-	b		L$4
-	nop
-	b		L$5
-	copy		%r21,%r20
-	b		L$6
-	nop
-	b		L$7
-	copy		%r21,%r20
-
-L$loop
-L$0	ldd		8(%r25),%r20
-	shrpd		%r20,%r21,%sar,%r21
-	std		%r21,0(%r26)
-L$7	ldd		16(%r25),%r21
-	shrpd		%r21,%r20,%sar,%r20
-	std		%r20,8(%r26)
-L$6	ldd		24(%r25),%r20
-	shrpd		%r20,%r21,%sar,%r21
-	std		%r21,16(%r26)
-L$5	ldd		32(%r25),%r21
-	shrpd		%r21,%r20,%sar,%r20
-	std		%r20,24(%r26)
-L$4	ldd		40(%r25),%r20
-	shrpd		%r20,%r21,%sar,%r21
-	std		%r21,32(%r26)
-L$3	ldd		48(%r25),%r21
-	shrpd		%r21,%r20,%sar,%r20
-	std		%r20,40(%r26)
-L$2	ldd		56(%r25),%r20
-	shrpd		%r20,%r21,%sar,%r21
-	std		%r21,48(%r26)
-L$1	ldd		64(%r25),%r21
-	ldo		64(%r25),%r25
-	shrpd		%r21,%r20,%sar,%r20
-	std		%r20,56(%r26)
-	addib,>		-8,%r24,L$loop
-	ldo		64(%r26),%r26
-
-L$end	shrpd		%r0,%r21,%sar,%r21
-	std		%r21,0(%r26)
-	bve		(%r2)
-	.exit
-	extrd,u		%r29,31,32,%r28
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64/sub_n.s b/ghc/rts/gmp/mpn/pa64/sub_n.s
deleted file mode 100644
index dda1f54b34..0000000000
--- a/ghc/rts/gmp/mpn/pa64/sub_n.s
+++ /dev/null
@@ -1,90 +0,0 @@
-; HP-PA 2.0 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0
-; and store difference in a third limb vector.
-
-; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; s2_ptr	gr24
-; size		gr23
-
-; This runs at 2 cycles/limb on PA8000.
-
-	.level	2.0n
-	.code
-	.export	__gmpn_sub_n,entry
-__gmpn_sub_n
-	.proc
-	.callinfo frame=0,args_saved
-	.entry
-
-	sub		%r0,%r23,%r22
-	depw,z		%r22,30,3,%r28		; r28 = 2 * (-n & 7)
-	depw,z		%r22,28,3,%r22		; r22 = 8 * (-n & 7)
-	sub		%r25,%r22,%r25		; offset s1_ptr
-	sub		%r24,%r22,%r24		; offset s2_ptr
-	blr		%r28,%r0		; branch into loop
-	sub		%r26,%r22,%r26		; offset res_ptr and set carry
-
-L$loop	ldd		0(%r25),%r20
-	ldd		0(%r24),%r31
-	sub,db		%r20,%r31,%r20
-	std		%r20,0(%r26)
-L$7	ldd		8(%r25),%r21
-	ldd		8(%r24),%r19
-	sub,db		%r21,%r19,%r21
-	std		%r21,8(%r26)
-L$6	ldd		16(%r25),%r20
-	ldd		16(%r24),%r31
-	sub,db		%r20,%r31,%r20
-	std		%r20,16(%r26)
-L$5	ldd		24(%r25),%r21
-	ldd		24(%r24),%r19
-	sub,db		%r21,%r19,%r21
-	std		%r21,24(%r26)
-L$4	ldd		32(%r25),%r20
-	ldd		32(%r24),%r31
-	sub,db		%r20,%r31,%r20
-	std		%r20,32(%r26)
-L$3	ldd		40(%r25),%r21
-	ldd		40(%r24),%r19
-	sub,db		%r21,%r19,%r21
-	std		%r21,40(%r26)
-L$2	ldd		48(%r25),%r20
-	ldd		48(%r24),%r31
-	sub,db		%r20,%r31,%r20
-	std		%r20,48(%r26)
-L$1	ldd		56(%r25),%r21
-	ldo		64(%r25),%r25
-	ldd		56(%r24),%r19
-	sub,db		%r21,%r19,%r21
-	std		%r21,56(%r26)
-	ldo		64(%r24),%r24
-	addib,>		-8,%r23,L$loop
-	ldo		64(%r26),%r26
-
-	add,dc		%r0,%r0,%r29
-	subi		1,%r29,%r29
-	bve		(%r2)
-	.exit
-	ldi		0,%r28
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64/submul_1.S b/ghc/rts/gmp/mpn/pa64/submul_1.S
deleted file mode 100644
index 27666b99df..0000000000
--- a/ghc/rts/gmp/mpn/pa64/submul_1.S
+++ /dev/null
@@ -1,170 +0,0 @@
-; HP-PA 2.0 64-bit __gmpn_submul_1 -- Multiply a limb vector with a limb and
-; subtract the result from a second limb vector.
-
-; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-; INPUT PARAMETERS
-#define rptr		%r26
-#define sptr		%r25
-#define size		%r24
-#define s2limb		-56(%r30)
-
-; This runs at 11 cycles/limb on a PA8000.  It might be possible to make
-; it faster, but the PA8000 pipeline is not publically documented and it
-; is very complex to reverse engineer
-
-#define t1 %r19
-#define rlimb %r20
-#define hi %r21
-#define lo %r22
-#define m0 %r28
-#define m1 %r3
-#define cylimb %r29
-#define t3 %r4
-#define t2 %r6
-#define t5 %r23
-#define t4 %r31
-	.level  2.0n
-	.code
-	.export __gmpn_submul_1,entry
-__gmpn_submul_1
-	.proc
-	.callinfo frame=128,no_calls
-	.entry
-        fldd		-56(%r30),%fr5		; s2limb passed on stack
-	ldo		128(%r30),%r30
-	add		%r0,%r0,cylimb		; clear cy and cylimb
-
-	std		%r3,-96(%r30)
-	std		%r4,-88(%r30)
-	std		%r5,-80(%r30)
-	std		%r6,-72(%r30)
-	depdi,z		1,31,1,%r5
-
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	addib,=		-1,%r24,L$end1
-	nop
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-	addib,=		-1,%r24,L$end2
-	nop
-L$loop
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		0(rptr),rlimb
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m1
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	add		cylimb,t4,t4
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	add,dc		t2,hi,cylimb
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	sub		rlimb,t4,t3
-	add		t4,t3,%r0
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	add,dc		%r0,cylimb,cylimb
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-	std		t3,0(rptr)
-	addib,<>	-1,%r24,L$loop
-	ldo		8(rptr),rptr
-L$end2
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		0(rptr),rlimb
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m0
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	add		cylimb,t4,t4
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	add,dc		t2,hi,cylimb
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	sub		rlimb,t4,t3
-	add		t4,t3,%r0
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	add,dc		%r0,cylimb,cylimb
-	std		t3,0(rptr)
-	ldo		8(rptr),rptr
-L$end1
-	ldd		0(rptr),rlimb
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m0
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	add		cylimb,t4,t4
-	add,dc		t2,hi,cylimb
-	sub		rlimb,t4,t3
-	add		t4,t3,%r0
-	add,dc		%r0,cylimb,cylimb
-	std		t3,0(rptr)
-	ldo		8(rptr),rptr
-
-	ldd		-96(%r30),%r3
-	ldd		-88(%r30),%r4
-	ldd		-80(%r30),%r5
-	ldd		-72(%r30),%r6
-
-	extrd,u		cylimb,31,32,%r28
-	bve		(%r2)
-	.exit
-	ldo		-128(%r30),%r30
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64/udiv_qrnnd.c b/ghc/rts/gmp/mpn/pa64/udiv_qrnnd.c
deleted file mode 100644
index 1c9fe084db..0000000000
--- a/ghc/rts/gmp/mpn/pa64/udiv_qrnnd.c
+++ /dev/null
@@ -1,111 +0,0 @@
-/*
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-#define TWO64 18446744073709551616.0
-
-mp_limb_t
-#if __STDC__
-__MPN(udiv_qrnnd) (mp_limb_t n1, mp_limb_t n0, mp_limb_t d, mp_limb_t *r)
-#else
-__MPN(udiv_qrnnd) (n1, n0, d, r)
-     mp_limb_t n1;
-     mp_limb_t n0;
-     mp_limb_t d;
-     mp_limb_t *r;
-#endif
-{
-  mp_limb_t q1, q2, q;
-  mp_limb_t p1, p0;
-  double di, dq;
-
-  di = 1.0 / d;
-
-  /* Generate upper 53 bits of quotient.  Be careful here; the `double'
-     quotient may be rounded to 2^64 which we cannot safely convert back
-     to a 64-bit integer.  */
-  dq = (TWO64 * (double) n1 + (double) n0) * di;
-  if (dq >= TWO64)
-    q1 = 0xfffffffffffff800LL;
-  else
-    q1 = (mp_limb_t) dq;
-
-  /* Multiply back in order to compare the product to the dividend.  */
-  umul_ppmm (p1, p0, q1, d);
-
-  /* Was the 53-bit quotient greater that our sought quotient?  Test the
-     sign of the partial remainder to find out.  */
-  if (n1 < p1 || (n1 == p1 && n0 < p0))
-    {
-      /* 53-bit quotient too large.  Partial remainder is negative.
-	 Compute the absolute value of the remainder in n1,,n0.  */
-      n1 = p1 - (n1 + (p0 < n0));
-      n0 = p0 - n0;
-
-      /* Now use the partial remainder as new dividend to compute more bits of
-	 quotient.  This is an adjustment for the one we got previously.  */
-      q2 = (mp_limb_t) ((TWO64 * (double) n1 + (double) n0) * di);
-      umul_ppmm (p1, p0, q2, d);
-
-      q = q1 - q2;
-      if (n1 < p1 || (n1 == p1 && n0 <= p0))
-	{
-	  n0 = p0 - n0;
-	}
-      else
-	{
-	  n0 = p0 - n0;
-	  n0 += d;
-	  q--;
-	}
-    }
-  else
-    {
-      n1 = n1 - (p1 + (n0 < p0));
-      n0 = n0 - p0;
-
-      q2 = (mp_limb_t) ((TWO64 * (double) n1 + (double) n0) * di);
-      umul_ppmm (p1, p0, q2, d);
-
-      q = q1 + q2;
-      if (n1 < p1 || (n1 == p1 && n0 < p0))
-	{
-	  n0 = n0 - p0;
-	  n0 += d;
-	  q--;
-	}
-      else
-	{
-	  n0 = n0 - p0;
-	  if (n0 >= d)
-	    {
-	      n0 -= d;
-	      q++;
-	    }
-	}
-    }
-
-  *r = n0;
-  return q;
-}
diff --git a/ghc/rts/gmp/mpn/pa64/umul_ppmm.S b/ghc/rts/gmp/mpn/pa64/umul_ppmm.S
deleted file mode 100644
index ceff2d752f..0000000000
--- a/ghc/rts/gmp/mpn/pa64/umul_ppmm.S
+++ /dev/null
@@ -1,74 +0,0 @@
-; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-#define p0	%r28
-#define p1	%r29
-#define t32	%r19
-#define t0	%r20
-#define t1	%r21
-#define x	%r22
-#define m0	%r23
-#define m1	%r24
-	.level  2.0n
-	.code
-	.export __gmpn_umul_ppmm,entry
-__gmpn_umul_ppmm
-	.proc
-	.callinfo frame=128,no_calls
-	.entry
-	ldo		128(%r30),%r30
-	depd		%r25,31,32,%r26
-	std		%r26,-64(%r30)
-	depd		%r23,31,32,%r24
-	std		%r24,-56(%r30)
-
-	ldw		-180(%r30),%r31
-
-        fldd		-64(%r30),%fr4
-        fldd		-56(%r30),%fr5
-
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-
-	depdi,z		1,31,1,t32		; t32 = 2^32
-
-	ldd		-128(%r30),p0		; lo = low 64 bit of product
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	ldd		-104(%r30),p1		; hi = high 64 bit of product
-
-	add,l,*nuv	m0,m1,x			; x = m1+m0
-	 add,l		t32,p1,p1		; propagate carry to mid of p1
-	depd,z		x,31,32,t0		; lo32(m1+m0)
-	add		t0,p0,p0
-	extrd,u		x,31,32,t1		; hi32(m1+m0)
-	add,dc		t1,p1,p1
-
-	std		p0,0(%r31)		; store low half of product
-	extrd,u		p1,31,32,%r28		; return high half of product
-	bve		(%r2)
-	.exit
-	ldo		-128(%r30),%r30
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64w/README b/ghc/rts/gmp/mpn/pa64w/README
deleted file mode 100644
index cf590a7b98..0000000000
--- a/ghc/rts/gmp/mpn/pa64w/README
+++ /dev/null
@@ -1,2 +0,0 @@
-This directory contains mpn functions for 64-bit PA-RISC 2.0
-using 64-bit pointers (2.0W).
diff --git a/ghc/rts/gmp/mpn/pa64w/add_n.s b/ghc/rts/gmp/mpn/pa64w/add_n.s
deleted file mode 100644
index 1bb9e8fbc7..0000000000
--- a/ghc/rts/gmp/mpn/pa64w/add_n.s
+++ /dev/null
@@ -1,90 +0,0 @@
-; HP-PA 2.0 __gmpn_add_n -- Add two limb vectors of the same length > 0 and
-; store sum in a third limb vector.
-
-; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; s2_ptr	gr24
-; size		gr23
-
-; This runs at 2 cycles/limb on PA8000.
-
-	.level	2.0w
-	.code
-	.export	__gmpn_add_n,entry
-__gmpn_add_n
-	.proc
-	.callinfo frame=0,args_saved
-	.entry
-
-	sub		%r0,%r23,%r22
-	depw,z		%r22,30,3,%r28		; r28 = 2 * (-n & 7)
-	depw,z		%r22,28,3,%r22		; r22 = 8 * (-n & 7)
-	sub		%r25,%r22,%r25		; offset s1_ptr
-	sub		%r24,%r22,%r24		; offset s2_ptr
-	sub		%r26,%r22,%r26		; offset res_ptr
-	blr		%r28,%r0		; branch into loop
-	add		%r0,%r0,%r0		; reset carry
-
-L$loop	ldd		0(%r25),%r20
-	ldd		0(%r24),%r31
-	add,dc		%r20,%r31,%r20
-	std		%r20,0(%r26)
-L$7	ldd		8(%r25),%r21
-	ldd		8(%r24),%r19
-	add,dc		%r21,%r19,%r21
-	std		%r21,8(%r26)
-L$6	ldd		16(%r25),%r20
-	ldd		16(%r24),%r31
-	add,dc		%r20,%r31,%r20
-	std		%r20,16(%r26)
-L$5	ldd		24(%r25),%r21
-	ldd		24(%r24),%r19
-	add,dc		%r21,%r19,%r21
-	std		%r21,24(%r26)
-L$4	ldd		32(%r25),%r20
-	ldd		32(%r24),%r31
-	add,dc		%r20,%r31,%r20
-	std		%r20,32(%r26)
-L$3	ldd		40(%r25),%r21
-	ldd		40(%r24),%r19
-	add,dc		%r21,%r19,%r21
-	std		%r21,40(%r26)
-L$2	ldd		48(%r25),%r20
-	ldd		48(%r24),%r31
-	add,dc		%r20,%r31,%r20
-	std		%r20,48(%r26)
-L$1	ldd		56(%r25),%r21
-	ldo		64(%r25),%r25
-	ldd		56(%r24),%r19
-	add,dc		%r21,%r19,%r21
-	std		%r21,56(%r26)
-	ldo		64(%r24),%r24
-	addib,>		-8,%r23,L$loop
-	ldo		64(%r26),%r26
-
-	add,dc		%r0,%r0,%r29
-	bve		(%r2)
-	.exit
-	copy		%r29,%r28
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64w/addmul_1.S b/ghc/rts/gmp/mpn/pa64w/addmul_1.S
deleted file mode 100644
index 4799f90fc5..0000000000
--- a/ghc/rts/gmp/mpn/pa64w/addmul_1.S
+++ /dev/null
@@ -1,168 +0,0 @@
-; HP-PA 2.0 64-bit __gmpn_addmul_1 -- Multiply a limb vector with a limb and
-; add the result to a second limb vector.
-
-; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-; INPUT PARAMETERS
-#define rptr		%r26
-#define sptr		%r25
-#define size		%r24
-#define s2limb		%r23
-
-; This runs at 11 cycles/limb on a PA8000.  It might be possible to make
-; it faster, but the PA8000 pipeline is not publically documented and it
-; is very complex to reverse engineer
-
-#define t1 %r19
-#define rlimb %r20
-#define hi %r21
-#define lo %r22
-#define m0 %r28
-#define m1 %r3
-#define cylimb %r29
-#define t3 %r4
-#define t2 %r6
-#define t5 %r23
-#define t4 %r31
-	.level  2.0w
-	.code
-	.export __gmpn_addmul_1,entry
-__gmpn_addmul_1
-	.proc
-	.callinfo frame=128,no_calls
-	.entry
-	std		s2limb,-56(%r30)
-        fldd		-56(%r30),%fr5
-	ldo		128(%r30),%r30
-	add		%r0,%r0,cylimb		; clear cy and cylimb
-
-	std		%r3,-96(%r30)
-	std		%r4,-88(%r30)
-	std		%r5,-80(%r30)
-	std		%r6,-72(%r30)
-	depdi,z		1,31,1,%r5
-
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	addib,=		-1,%r24,L$end1
-	nop
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-	addib,=		-1,%r24,L$end2
-	nop
-L$loop
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		0(rptr),rlimb
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m1
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	add		cylimb,rlimb,rlimb
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	add,dc		t2,hi,cylimb
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	add		t4,rlimb,t3
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	add,dc		%r0,cylimb,cylimb
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-	std		t3,0(rptr)
-	addib,<>	-1,%r24,L$loop
-	ldo		8(rptr),rptr
-L$end2
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		0(rptr),rlimb
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m0
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	add		cylimb,rlimb,rlimb
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	add,dc		t2,hi,cylimb
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	add		t4,rlimb,t3
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	add,dc		%r0,cylimb,cylimb
-	std		t3,0(rptr)
-	ldo		8(rptr),rptr
-L$end1
-	ldd		0(rptr),rlimb
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m0
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	add		cylimb,rlimb,rlimb
-	add,dc		t2,hi,cylimb
-	add		t4,rlimb,t3
-	add,dc		%r0,cylimb,cylimb
-	std		t3,0(rptr)
-	ldo		8(rptr),rptr
-
-	ldd		-96(%r30),%r3
-	ldd		-88(%r30),%r4
-	ldd		-80(%r30),%r5
-	ldd		-72(%r30),%r6
-
-	copy		cylimb,%r28
-	bve		(%r2)
-	.exit
-	ldo		-128(%r30),%r30
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64w/gmp-mparam.h b/ghc/rts/gmp/mpn/pa64w/gmp-mparam.h
deleted file mode 100644
index ee5a0a3ab7..0000000000
--- a/ghc/rts/gmp/mpn/pa64w/gmp-mparam.h
+++ /dev/null
@@ -1,65 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 64
-#define BYTES_PER_MP_LIMB 8
-#define BITS_PER_LONGINT 64
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-/* These values were measured on a PA8500 using the system compiler version
-   A.11.01.02.  Presumably the PA8000 and PA8200 have the same timing
-   characteristic, but GCC might give somewhat different results..  */
-/* Generated by tuneup.c, 2000-07-25. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD   18
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD      105
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD   46
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD       83
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD              58
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD            134
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            56
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD       26
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD           1
-#endif
diff --git a/ghc/rts/gmp/mpn/pa64w/lshift.s b/ghc/rts/gmp/mpn/pa64w/lshift.s
deleted file mode 100644
index 84f925a105..0000000000
--- a/ghc/rts/gmp/mpn/pa64w/lshift.s
+++ /dev/null
@@ -1,103 +0,0 @@
-; HP-PA 2.0 __gmpn_lshift --
-
-; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; size		gr24
-; cnt		gr23
-
-; This runs at 1.5 cycles/limb on PA8000.
-
-	.level	2.0w
-	.code
-	.export	__gmpn_lshift,entry
-__gmpn_lshift
-	.proc
-	.callinfo frame=0,args_saved
-	.entry
-
-	shladd		%r24,3,%r25,%r25
-	shladd		%r24,3,%r26,%r26
-	subi		64,%r23,%r23
-	mtsar		%r23
-	ldd		-8(%r25),%r21
-	addib,=		-1,%r24,L$end
-	shrpd		%r0,%r21,%sar,%r29	; compute carry out limb
-	depw,z		%r24,31,3,%r28		; r28 = (size & 7)
-	sub		%r0,%r24,%r22
-	depw,z		%r22,28,3,%r22		; r22 = 8 * (-size & 7)
-	add		%r25,%r22,%r25		; offset s1_ptr
-	blr		%r28,%r0		; branch into jump table
-	add		%r26,%r22,%r26		; offset res_ptr
-	b		L$0
-	nop
-	b		L$1
-	copy		%r21,%r20
-	b		L$2
-	nop
-	b		L$3
-	copy		%r21,%r20
-	b		L$4
-	nop
-	b		L$5
-	copy		%r21,%r20
-	b		L$6
-	nop
-	b		L$7
-	copy		%r21,%r20
-
-L$loop
-L$0	ldd		-16(%r25),%r20
-	shrpd		%r21,%r20,%sar,%r21
-	std		%r21,-8(%r26)
-L$7	ldd		-24(%r25),%r21
-	shrpd		%r20,%r21,%sar,%r20
-	std		%r20,-16(%r26)
-L$6	ldd		-32(%r25),%r20
-	shrpd		%r21,%r20,%sar,%r21
-	std		%r21,-24(%r26)
-L$5	ldd		-40(%r25),%r21
-	shrpd		%r20,%r21,%sar,%r20
-	std		%r20,-32(%r26)
-L$4	ldd		-48(%r25),%r20
-	shrpd		%r21,%r20,%sar,%r21
-	std		%r21,-40(%r26)
-L$3	ldd		-56(%r25),%r21
-	shrpd		%r20,%r21,%sar,%r20
-	std		%r20,-48(%r26)
-L$2	ldd		-64(%r25),%r20
-	shrpd		%r21,%r20,%sar,%r21
-	std		%r21,-56(%r26)
-L$1	ldd		-72(%r25),%r21
-	ldo		-64(%r25),%r25
-	shrpd		%r20,%r21,%sar,%r20
-	std		%r20,-64(%r26)
-	addib,>		-8,%r24,L$loop
-	ldo		-64(%r26),%r26
-
-L$end	shrpd		%r21,%r0,%sar,%r21
-	std		%r21,-8(%r26)
-	bve		(%r2)
-	.exit
-	copy		%r29,%r28
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64w/mul_1.S b/ghc/rts/gmp/mpn/pa64w/mul_1.S
deleted file mode 100644
index 48f13fbd1b..0000000000
--- a/ghc/rts/gmp/mpn/pa64w/mul_1.S
+++ /dev/null
@@ -1,159 +0,0 @@
-; HP-PA 2.0 64-bit __gmpn_mul_1 -- Multiply a limb vector with a limb and
-; store the result in a second limb vector.
-
-; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-; INPUT PARAMETERS
-#define rptr		%r26
-#define sptr		%r25
-#define size		%r24
-#define s2limb		%r23
-
-; This runs at 11 cycles/limb on a PA8000.  It might be possible to make
-; it faster, but the PA8000 pipeline is not publically documented and it
-; is very complex to reverse engineer
-
-#define t1 %r19
-#define rlimb %r20
-#define hi %r21
-#define lo %r22
-#define m0 %r28
-#define m1 %r3
-#define cylimb %r29
-#define t3 %r4
-#define t2 %r6
-#define t5 %r23
-#define t4 %r31
-	.level  2.0w
-	.code
-	.export __gmpn_mul_1,entry
-__gmpn_mul_1
-	.proc
-	.callinfo frame=128,no_calls
-	.entry
-	std		s2limb,-56(%r30)
-        fldd		-56(%r30),%fr5
-	ldo		128(%r30),%r30
-	add		%r0,%r0,cylimb		; clear cy and cylimb
-
-	std		%r3,-96(%r30)
-	std		%r4,-88(%r30)
-	std		%r5,-80(%r30)
-	std		%r6,-72(%r30)
-	depdi,z		1,31,1,%r5
-
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	addib,=		-1,%r24,L$end1
-	nop
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-	addib,=		-1,%r24,L$end2
-	nop
-L$loop
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m1
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	add		cylimb,t4,t3
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	add,dc		t2,hi,cylimb
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-	std		t3,0(rptr)
-	addib,<>	-1,%r24,L$loop
-	ldo		8(rptr),rptr
-L$end2
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m0
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	add		cylimb,t4,t3
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	add,dc		t2,hi,cylimb
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	std		t3,0(rptr)
-	ldo		8(rptr),rptr
-L$end1
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t2 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m0
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	add		cylimb,t4,t3
-	add,dc		t2,hi,cylimb
-	std		t3,0(rptr)
-	ldo		8(rptr),rptr
-
-	ldd		-96(%r30),%r3
-	ldd		-88(%r30),%r4
-	ldd		-80(%r30),%r5
-	ldd		-72(%r30),%r6
-
-	copy		cylimb,%r28
-	bve		(%r2)
-	.exit
-	ldo		-128(%r30),%r30
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64w/rshift.s b/ghc/rts/gmp/mpn/pa64w/rshift.s
deleted file mode 100644
index 2517cb1f87..0000000000
--- a/ghc/rts/gmp/mpn/pa64w/rshift.s
+++ /dev/null
@@ -1,100 +0,0 @@
-; HP-PA 2.0 __gmpn_rshift --
-
-; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; size		gr24
-; cnt		gr23
-
-; This runs at 1.5 cycles/limb on PA8000.
-
-	.level	2.0w
-	.code
-	.export	__gmpn_rshift,entry
-__gmpn_rshift
-	.proc
-	.callinfo frame=0,args_saved
-	.entry
-
-	mtsar		%r23
-	ldd		0(%r25),%r21
-	addib,=		-1,%r24,L$end
-	shrpd		%r21,%r0,%sar,%r29	; compute carry out limb
-	depw,z		%r24,31,3,%r28		; r28 = (size & 7)
-	sub		%r0,%r24,%r22
-	depw,z		%r22,28,3,%r22		; r22 = 8 * (-size & 7)
-	sub		%r25,%r22,%r25		; offset s1_ptr
-	blr		%r28,%r0		; branch into jump table
-	sub		%r26,%r22,%r26		; offset res_ptr
-	b		L$0
-	nop
-	b		L$1
-	copy		%r21,%r20
-	b		L$2
-	nop
-	b		L$3
-	copy		%r21,%r20
-	b		L$4
-	nop
-	b		L$5
-	copy		%r21,%r20
-	b		L$6
-	nop
-	b		L$7
-	copy		%r21,%r20
-
-L$loop
-L$0	ldd		8(%r25),%r20
-	shrpd		%r20,%r21,%sar,%r21
-	std		%r21,0(%r26)
-L$7	ldd		16(%r25),%r21
-	shrpd		%r21,%r20,%sar,%r20
-	std		%r20,8(%r26)
-L$6	ldd		24(%r25),%r20
-	shrpd		%r20,%r21,%sar,%r21
-	std		%r21,16(%r26)
-L$5	ldd		32(%r25),%r21
-	shrpd		%r21,%r20,%sar,%r20
-	std		%r20,24(%r26)
-L$4	ldd		40(%r25),%r20
-	shrpd		%r20,%r21,%sar,%r21
-	std		%r21,32(%r26)
-L$3	ldd		48(%r25),%r21
-	shrpd		%r21,%r20,%sar,%r20
-	std		%r20,40(%r26)
-L$2	ldd		56(%r25),%r20
-	shrpd		%r20,%r21,%sar,%r21
-	std		%r21,48(%r26)
-L$1	ldd		64(%r25),%r21
-	ldo		64(%r25),%r25
-	shrpd		%r21,%r20,%sar,%r20
-	std		%r20,56(%r26)
-	addib,>		-8,%r24,L$loop
-	ldo		64(%r26),%r26
-
-L$end	shrpd		%r0,%r21,%sar,%r21
-	std		%r21,0(%r26)
-	bve		(%r2)
-	.exit
-	copy		%r29,%r28
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64w/sub_n.s b/ghc/rts/gmp/mpn/pa64w/sub_n.s
deleted file mode 100644
index ad01e24aa7..0000000000
--- a/ghc/rts/gmp/mpn/pa64w/sub_n.s
+++ /dev/null
@@ -1,90 +0,0 @@
-; HP-PA 2.0 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0
-; and store difference in a third limb vector.
-
-; Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-
-; INPUT PARAMETERS
-; res_ptr	gr26
-; s1_ptr	gr25
-; s2_ptr	gr24
-; size		gr23
-
-; This runs at 2 cycles/limb on PA8000.
-
-	.level	2.0w
-	.code
-	.export	__gmpn_sub_n,entry
-__gmpn_sub_n
-	.proc
-	.callinfo frame=0,args_saved
-	.entry
-
-	sub		%r0,%r23,%r22
-	depw,z		%r22,30,3,%r28		; r28 = 2 * (-n & 7)
-	depw,z		%r22,28,3,%r22		; r22 = 8 * (-n & 7)
-	sub		%r25,%r22,%r25		; offset s1_ptr
-	sub		%r24,%r22,%r24		; offset s2_ptr
-	blr		%r28,%r0		; branch into loop
-	sub		%r26,%r22,%r26		; offset res_ptr and set carry
-
-L$loop	ldd		0(%r25),%r20
-	ldd		0(%r24),%r31
-	sub,db		%r20,%r31,%r20
-	std		%r20,0(%r26)
-L$7	ldd		8(%r25),%r21
-	ldd		8(%r24),%r19
-	sub,db		%r21,%r19,%r21
-	std		%r21,8(%r26)
-L$6	ldd		16(%r25),%r20
-	ldd		16(%r24),%r31
-	sub,db		%r20,%r31,%r20
-	std		%r20,16(%r26)
-L$5	ldd		24(%r25),%r21
-	ldd		24(%r24),%r19
-	sub,db		%r21,%r19,%r21
-	std		%r21,24(%r26)
-L$4	ldd		32(%r25),%r20
-	ldd		32(%r24),%r31
-	sub,db		%r20,%r31,%r20
-	std		%r20,32(%r26)
-L$3	ldd		40(%r25),%r21
-	ldd		40(%r24),%r19
-	sub,db		%r21,%r19,%r21
-	std		%r21,40(%r26)
-L$2	ldd		48(%r25),%r20
-	ldd		48(%r24),%r31
-	sub,db		%r20,%r31,%r20
-	std		%r20,48(%r26)
-L$1	ldd		56(%r25),%r21
-	ldo		64(%r25),%r25
-	ldd		56(%r24),%r19
-	sub,db		%r21,%r19,%r21
-	std		%r21,56(%r26)
-	ldo		64(%r24),%r24
-	addib,>		-8,%r23,L$loop
-	ldo		64(%r26),%r26
-
-	add,dc		%r0,%r0,%r29
-	subi		1,%r29,%r29
-	bve		(%r2)
-	.exit
-	copy		%r29,%r28
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64w/submul_1.S b/ghc/rts/gmp/mpn/pa64w/submul_1.S
deleted file mode 100644
index 294f6239b2..0000000000
--- a/ghc/rts/gmp/mpn/pa64w/submul_1.S
+++ /dev/null
@@ -1,171 +0,0 @@
-; HP-PA 2.0 64-bit __gmpn_submul_1 -- Multiply a limb vector with a limb and
-; subtract the result from a second limb vector.
-
-; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-; INPUT PARAMETERS
-#define rptr		%r26
-#define sptr		%r25
-#define size		%r24
-#define s2limb		%r23
-
-; This runs at 11 cycles/limb on a PA8000.  It might be possible to make
-; it faster, but the PA8000 pipeline is not publically documented and it
-; is very complex to reverse engineer
-
-#define t1 %r19
-#define rlimb %r20
-#define hi %r21
-#define lo %r22
-#define m0 %r28
-#define m1 %r3
-#define cylimb %r29
-#define t3 %r4
-#define t2 %r6
-#define t5 %r23
-#define t4 %r31
-	.level  2.0w
-	.code
-	.export __gmpn_submul_1,entry
-__gmpn_submul_1
-	.proc
-	.callinfo frame=128,no_calls
-	.entry
-	std		s2limb,-56(%r30)
-        fldd		-56(%r30),%fr5
-	ldo		128(%r30),%r30
-	add		%r0,%r0,cylimb		; clear cy and cylimb
-
-	std		%r3,-96(%r30)
-	std		%r4,-88(%r30)
-	std		%r5,-80(%r30)
-	std		%r6,-72(%r30)
-	depdi,z		1,31,1,%r5
-
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	addib,=		-1,%r24,L$end1
-	nop
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-	addib,=		-1,%r24,L$end2
-	nop
-L$loop
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		0(rptr),rlimb
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m1
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	add		cylimb,t4,t4
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	add,dc		t2,hi,cylimb
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	sub		rlimb,t4,t3
-	add		t4,t3,%r0
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	add,dc		%r0,cylimb,cylimb
-	fldd		0(sptr),%fr4
-	ldo		8(sptr),sptr
-	std		t3,0(rptr)
-	addib,<>	-1,%r24,L$loop
-	ldo		8(rptr),rptr
-L$end2
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-	ldd		0(rptr),rlimb
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m0
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	ldd		-128(%r30),lo		; lo = low 64 bit of product
-	add		cylimb,t4,t4
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	add,dc		t2,hi,cylimb
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	sub		rlimb,t4,t3
-	add		t4,t3,%r0
-	ldd		-104(%r30),hi		; hi = high 64 bit of product
-	add,dc		%r0,cylimb,cylimb
-	std		t3,0(rptr)
-	ldo		8(rptr),rptr
-L$end1
-	ldd		0(rptr),rlimb
-	extrd,u		lo,31,32,t1		; t1 = hi32(lo)
-	extrd,u		lo,63,32,t4		; t4 = lo32(lo)
-	add,l		m0,t1,t1		; t1 += m0
-	add,l,*nuv	m1,t1,t1		; t1 += m0
-	 add,l		%r5,hi,hi		; propagate carry
-	extrd,u		t1,31,32,t2		; t2 = hi32(t1)
-	depd,z		t1,31,32,t5		; t5 = lo32(t1)
-	add,l		t5,t4,t4		; t4 += lo32(t1)
-	add		cylimb,t4,t4
-	add,dc		t2,hi,cylimb
-	sub		rlimb,t4,t3
-	add		t4,t3,%r0
-	add,dc		%r0,cylimb,cylimb
-	std		t3,0(rptr)
-	ldo		8(rptr),rptr
-
-	ldd		-96(%r30),%r3
-	ldd		-88(%r30),%r4
-	ldd		-80(%r30),%r5
-	ldd		-72(%r30),%r6
-
-	copy		cylimb,%r28
-	bve		(%r2)
-	.exit
-	ldo		-128(%r30),%r30
-	.procend
diff --git a/ghc/rts/gmp/mpn/pa64w/udiv_qrnnd.c b/ghc/rts/gmp/mpn/pa64w/udiv_qrnnd.c
deleted file mode 100644
index 1852913000..0000000000
--- a/ghc/rts/gmp/mpn/pa64w/udiv_qrnnd.c
+++ /dev/null
@@ -1,117 +0,0 @@
-/*
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-#define TWO64 18446744073709551616.0
-#define TWO63 9223372036854775808.0
-
-mp_limb_t
-#if __STDC__
-__MPN(udiv_qrnnd) (mp_limb_t n1, mp_limb_t n0, mp_limb_t d, mp_limb_t *r)
-#else
-__MPN(udiv_qrnnd) (n1, n0, d, r)
-     mp_limb_t n1;
-     mp_limb_t n0;
-     mp_limb_t d;
-     mp_limb_t *r;
-#endif
-{
-  mp_limb_t q1, q2, q;
-  mp_limb_t p1, p0;
-  double di, dq;
-
-  di = 1.0 / d;
-
-  /* Generate upper 53 bits of quotient.  Be careful here; the `double'
-     quotient may be rounded to 2^64 which we cannot safely convert back
-     to a 64-bit integer.  */
-  dq = (TWO64 * (double) n1 + (double) n0) * di;
-  if (dq >= TWO64)
-    q1 = 0xfffffffffffff800L;
-#ifndef __GNUC__
-  /* Work around HP compiler bug.  */
-  else if (dq > TWO63)
-    q1 = (mp_limb_t) (dq - TWO63) + 0x8000000000000000L;
-#endif
-  else
-    q1 = (mp_limb_t) dq;
-
-  /* Multiply back in order to compare the product to the dividend.  */
-  umul_ppmm (p1, p0, q1, d);
-
-  /* Was the 53-bit quotient greater that our sought quotient?  Test the
-     sign of the partial remainder to find out.  */
-  if (n1 < p1 || (n1 == p1 && n0 < p0))
-    {
-      /* 53-bit quotient too large.  Partial remainder is negative.
-	 Compute the absolute value of the remainder in n1,,n0.  */
-      n1 = p1 - (n1 + (p0 < n0));
-      n0 = p0 - n0;
-
-      /* Now use the partial remainder as new dividend to compute more bits of
-	 quotient.  This is an adjustment for the one we got previously.  */
-      q2 = (mp_limb_t) ((TWO64 * (double) n1 + (double) n0) * di);
-      umul_ppmm (p1, p0, q2, d);
-
-      q = q1 - q2;
-      if (n1 < p1 || (n1 == p1 && n0 <= p0))
-	{
-	  n0 = p0 - n0;
-	}
-      else
-	{
-	  n0 = p0 - n0;
-	  n0 += d;
-	  q--;
-	}
-    }
-  else
-    {
-      n1 = n1 - (p1 + (n0 < p0));
-      n0 = n0 - p0;
-
-      q2 = (mp_limb_t) ((TWO64 * (double) n1 + (double) n0) * di);
-      umul_ppmm (p1, p0, q2, d);
-
-      q = q1 + q2;
-      if (n1 < p1 || (n1 == p1 && n0 < p0))
-	{
-	  n0 = n0 - p0;
-	  n0 += d;
-	  q--;
-	}
-      else
-	{
-	  n0 = n0 - p0;
-	  if (n0 >= d)
-	    {
-	      n0 -= d;
-	      q++;
-	    }
-	}
-    }
-
-  *r = n0;
-  return q;
-}
diff --git a/ghc/rts/gmp/mpn/pa64w/umul_ppmm.S b/ghc/rts/gmp/mpn/pa64w/umul_ppmm.S
deleted file mode 100644
index d9fb92be8c..0000000000
--- a/ghc/rts/gmp/mpn/pa64w/umul_ppmm.S
+++ /dev/null
@@ -1,72 +0,0 @@
-; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-; This file is part of the GNU MP Library.
-
-; The GNU MP Library is free software; you can redistribute it and/or modify
-; it under the terms of the GNU Lesser General Public License as published by
-; the Free Software Foundation; either version 2.1 of the License, or (at your
-; option) any later version.
-
-; The GNU MP Library is distributed in the hope that it will be useful, but
-; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-; License for more details.
-
-; You should have received a copy of the GNU Lesser General Public License
-; along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-; MA 02111-1307, USA.
-
-#define p0	%r28
-#define p1	%r29
-#define t32	%r19
-#define t0	%r20
-#define t1	%r21
-#define x	%r22
-#define m0	%r23
-#define m1	%r24
-	.level  2.0w
-	.code
-	.export __gmpn_umul_ppmm,entry
-__gmpn_umul_ppmm
-	.proc
-	.callinfo frame=128,no_calls
-	.entry
-	ldo		128(%r30),%r30
-	std		%r26,-64(%r30)
-	std		%r25,-56(%r30)
-
-	copy		%r24,%r31
-
-        fldd		-64(%r30),%fr4
-        fldd		-56(%r30),%fr5
-
-	xmpyu		%fr5R,%fr4R,%fr6
-	fstd		%fr6,-128(%r30)
-	xmpyu		%fr5R,%fr4L,%fr7
-	fstd		%fr7,-120(%r30)
-	xmpyu		%fr5L,%fr4R,%fr8
-	fstd		%fr8,-112(%r30)
-	xmpyu		%fr5L,%fr4L,%fr9
-	fstd		%fr9,-104(%r30)
-
-	depdi,z		1,31,1,t32		; t32 = 2^32
-
-	ldd		-128(%r30),p0		; lo = low 64 bit of product
-	ldd		-120(%r30),m0		; m0 = mid0 64 bit of product
-	ldd		-112(%r30),m1		; m1 = mid1 64 bit of product
-	ldd		-104(%r30),p1		; hi = high 64 bit of product
-
-	add,l,*nuv	m0,m1,x			; x = m1+m0
-	 add,l		t32,p1,p1		; propagate carry to mid of p1
-	depd,z		x,31,32,t0		; lo32(m1+m0)
-	add		t0,p0,p0
-	extrd,u		x,31,32,t1		; hi32(m1+m0)
-	add,dc		t1,p1,p1
-
-	std		p0,0(%r31)		; store low half of product
-	copy		p1,%r28			; return high half of product
-	bve		(%r2)
-	.exit
-	ldo		-128(%r30),%r30
-	.procend
diff --git a/ghc/rts/gmp/mpn/power/add_n.s b/ghc/rts/gmp/mpn/power/add_n.s
deleted file mode 100644
index 0f9f48f1cc..0000000000
--- a/ghc/rts/gmp/mpn/power/add_n.s
+++ /dev/null
@@ -1,79 +0,0 @@
-# IBM POWER __gmpn_add_n -- Add two limb vectors of equal, non-zero length.
-
-# Copyright (C) 1992, 1994, 1995, 1996, 1999, 2000 Free Software Foundation,
-# Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# s2_ptr	r5
-# size		r6
-
-	.toc
-	.globl	__gmpn_add_n
-	.globl	.__gmpn_add_n
-	.csect	__gmpn_add_n[DS]
-__gmpn_add_n:
-	.long	.__gmpn_add_n, TOC[tc0], 0
-	.csect	.text[PR]
-	.align	2
-.__gmpn_add_n:
-	andil.	10,6,1		# odd or even number of limbs?
-	l	8,0(4)		# load least significant s1 limb
-	l	0,0(5)		# load least significant s2 limb
-	cal	3,-4(3)		# offset res_ptr, it's updated before it's used
-	sri	10,6,1		# count for unrolled loop
-	a	7,0,8		# add least significant limbs, set cy
-	mtctr	10		# copy count into CTR
-	beq	0,Leven		# branch if even # of limbs (# of limbs >= 2)
-
-# We have an odd # of limbs.  Add the first limbs separately.
-	cmpi	1,10,0		# is count for unrolled loop zero?
-	bc	4,6,L1		# bne cr1,L1 (misassembled by gas)
-	st	7,4(3)
-	aze	3,10		# use the fact that r10 is zero...
-	br			# return
-
-# We added least significant limbs.  Now reload the next limbs to enter loop.
-L1:	lu	8,4(4)		# load s1 limb and update s1_ptr
-	lu	0,4(5)		# load s2 limb and update s2_ptr
-	stu	7,4(3)
-	ae	7,0,8		# add limbs, set cy
-Leven:	lu	9,4(4)		# load s1 limb and update s1_ptr
-	lu	10,4(5)		# load s2 limb and update s2_ptr
-	bdz	Lend		# If done, skip loop
-
-Loop:	lu	8,4(4)		# load s1 limb and update s1_ptr
-	lu	0,4(5)		# load s2 limb and update s2_ptr
-	ae	11,9,10		# add previous limbs with cy, set cy
-	stu	7,4(3)		# 
-	lu	9,4(4)		# load s1 limb and update s1_ptr
-	lu	10,4(5)		# load s2 limb and update s2_ptr
-	ae	7,0,8		# add previous limbs with cy, set cy
-	stu	11,4(3)		# 
-	bdn	Loop		# decrement CTR and loop back
-
-Lend:	ae	11,9,10		# add limbs with cy, set cy
-	st	7,4(3)		# 
-	st	11,8(3)		# 
-	lil	3,0		# load cy into ...
-	aze	3,3		# ... return value register
-	br
diff --git a/ghc/rts/gmp/mpn/power/addmul_1.s b/ghc/rts/gmp/mpn/power/addmul_1.s
deleted file mode 100644
index 8ecc651579..0000000000
--- a/ghc/rts/gmp/mpn/power/addmul_1.s
+++ /dev/null
@@ -1,122 +0,0 @@
-# IBM POWER __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
-# the result to a second limb vector.
-
-# Copyright (C) 1992, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# size		r5
-# s2_limb	r6
-
-# The POWER architecture has no unsigned 32x32->64 bit multiplication
-# instruction.  To obtain that operation, we have to use the 32x32->64 signed
-# multiplication instruction, and add the appropriate compensation to the high
-# limb of the result.  We add the multiplicand if the multiplier has its most
-# significant bit set, and we add the multiplier if the multiplicand has its
-# most significant bit set.  We need to preserve the carry flag between each
-# iteration, so we have to compute the compensation carefully (the natural,
-# srai+and doesn't work).  Since the POWER architecture has a branch unit we
-# can branch in zero cycles, so that's how we perform the additions.
-
-	.toc
-	.globl	__gmpn_addmul_1
-	.globl	.__gmpn_addmul_1
-	.csect	__gmpn_addmul_1[DS]
-__gmpn_addmul_1:
-	.long	.__gmpn_addmul_1, TOC[tc0], 0
-	.csect	.text[PR]
-	.align	2
-.__gmpn_addmul_1:
-
-	cal	3,-4(3)
-	l	0,0(4)
-	cmpi	0,6,0
-	mtctr	5
-	mul	9,0,6
-	srai	7,0,31
-	and	7,7,6
-	mfmq	8
-	cax	9,9,7
-	l	7,4(3)
-	a	8,8,7		# add res_limb
-	blt	Lneg
-Lpos:	bdz	Lend
-
-Lploop:	lu	0,4(4)
-	stu	8,4(3)
-	cmpi	0,0,0
-	mul	10,0,6
-	mfmq	0
-	ae	8,0,9		# low limb + old_cy_limb + old cy
-	l	7,4(3)
-	aze	10,10		# propagate cy to new cy_limb
-	a	8,8,7		# add res_limb
-	bge	Lp0
-	cax	10,10,6		# adjust high limb for negative limb from s1
-Lp0:	bdz	Lend0
-	lu	0,4(4)
-	stu	8,4(3)
-	cmpi	0,0,0
-	mul	9,0,6
-	mfmq	0
-	ae	8,0,10
-	l	7,4(3)
-	aze	9,9
-	a	8,8,7
-	bge	Lp1
-	cax	9,9,6		# adjust high limb for negative limb from s1
-Lp1:	bdn	Lploop
-
-	b	Lend
-
-Lneg:	cax	9,9,0
-	bdz	Lend
-Lnloop:	lu	0,4(4)
-	stu	8,4(3)
-	cmpi	0,0,0
-	mul	10,0,6
-	mfmq	7
-	ae	8,7,9
-	l	7,4(3)
-	ae	10,10,0		# propagate cy to new cy_limb
-	a	8,8,7		# add res_limb
-	bge	Ln0
-	cax	10,10,6		# adjust high limb for negative limb from s1
-Ln0:	bdz	Lend0
-	lu	0,4(4)
-	stu	8,4(3)
-	cmpi	0,0,0
-	mul	9,0,6
-	mfmq	7
-	ae	8,7,10
-	l	7,4(3)
-	ae	9,9,0		# propagate cy to new cy_limb
-	a	8,8,7		# add res_limb
-	bge	Ln1
-	cax	9,9,6		# adjust high limb for negative limb from s1
-Ln1:	bdn	Lnloop
-	b	Lend
-
-Lend0:	cal	9,0(10)
-Lend:	st	8,4(3)
-	aze	3,9
-	br
diff --git a/ghc/rts/gmp/mpn/power/lshift.s b/ghc/rts/gmp/mpn/power/lshift.s
deleted file mode 100644
index ab71fb7727..0000000000
--- a/ghc/rts/gmp/mpn/power/lshift.s
+++ /dev/null
@@ -1,56 +0,0 @@
-# IBM POWER __gmpn_lshift -- 
-
-# Copyright (C) 1992, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s_ptr		r4
-# size		r5
-# cnt		r6
-
-	.toc
-	.globl	__gmpn_lshift
-	.globl	.__gmpn_lshift
-	.csect	__gmpn_lshift[DS]
-__gmpn_lshift:
-	.long	.__gmpn_lshift, TOC[tc0], 0
-	.csect	.text[PR]
-	.align	2
-.__gmpn_lshift:
-	sli	0,5,2
-	cax	9,3,0
-	cax	4,4,0
-	sfi	8,6,32
-	mtctr	5		# put limb count in CTR loop register
-	lu	0,-4(4)		# read most significant limb
-	sre	3,0,8		# compute carry out limb, and init MQ register
-	bdz	Lend2		# if just one limb, skip loop
-	lu	0,-4(4)		# read 2:nd most significant limb
-	sreq	7,0,8		# compute most significant limb of result
-	bdz	Lend		# if just two limb, skip loop
-Loop:	lu	0,-4(4)		# load next lower limb
-	stu	7,-4(9)		# store previous result during read latency
-	sreq	7,0,8		# compute result limb
-	bdn	Loop		# loop back until CTR is zero
-Lend:	stu	7,-4(9)		# store 2:nd least significant limb
-Lend2:	sle	7,0,6		# compute least significant limb
-	st      7,-4(9)		# store it"				\
-	br
diff --git a/ghc/rts/gmp/mpn/power/mul_1.s b/ghc/rts/gmp/mpn/power/mul_1.s
deleted file mode 100644
index 4e08ade583..0000000000
--- a/ghc/rts/gmp/mpn/power/mul_1.s
+++ /dev/null
@@ -1,109 +0,0 @@
-# IBM POWER __gmpn_mul_1 -- Multiply a limb vector with a limb and store
-# the result in a second limb vector.
-
-# Copyright (C) 1992, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# size		r5
-# s2_limb	r6
-
-# The POWER architecture has no unsigned 32x32->64 bit multiplication
-# instruction.  To obtain that operation, we have to use the 32x32->64 signed
-# multiplication instruction, and add the appropriate compensation to the high
-# limb of the result.  We add the multiplicand if the multiplier has its most
-# significant bit set, and we add the multiplier if the multiplicand has its
-# most significant bit set.  We need to preserve the carry flag between each
-# iteration, so we have to compute the compensation carefully (the natural,
-# srai+and doesn't work).  Since the POWER architecture has a branch unit we
-# can branch in zero cycles, so that's how we perform the additions.
-
-	.toc
-	.globl	__gmpn_mul_1
-	.globl	.__gmpn_mul_1
-	.csect	__gmpn_mul_1[DS]
-__gmpn_mul_1:
-	.long	.__gmpn_mul_1, TOC[tc0], 0
-	.csect	.text[PR]
-	.align	2
-.__gmpn_mul_1:
-
-	cal	3,-4(3)
-	l	0,0(4)
-	cmpi	0,6,0
-	mtctr	5
-	mul	9,0,6
-	srai	7,0,31
-	and	7,7,6
-	mfmq	8
-	ai	0,0,0		# reset carry
-	cax	9,9,7
-	blt	Lneg
-Lpos:	bdz	Lend
-Lploop:	lu	0,4(4)
-	stu	8,4(3)
-	cmpi	0,0,0
-	mul	10,0,6
-	mfmq	0
-	ae	8,0,9
-	bge	Lp0
-	cax	10,10,6		# adjust high limb for negative limb from s1
-Lp0:	bdz	Lend0
-	lu	0,4(4)
-	stu	8,4(3)
-	cmpi	0,0,0
-	mul	9,0,6
-	mfmq	0
-	ae	8,0,10
-	bge	Lp1
-	cax	9,9,6		# adjust high limb for negative limb from s1
-Lp1:	bdn	Lploop
-	b	Lend
-
-Lneg:	cax	9,9,0
-	bdz	Lend
-Lnloop:	lu	0,4(4)
-	stu	8,4(3)
-	cmpi	0,0,0
-	mul	10,0,6
-	cax	10,10,0		# adjust high limb for negative s2_limb
-	mfmq	0
-	ae	8,0,9
-	bge	Ln0
-	cax	10,10,6		# adjust high limb for negative limb from s1
-Ln0:	bdz	Lend0
-	lu	0,4(4)
-	stu	8,4(3)
-	cmpi	0,0,0
-	mul	9,0,6
-	cax	9,9,0		# adjust high limb for negative s2_limb
-	mfmq	0
-	ae	8,0,10
-	bge	Ln1
-	cax	9,9,6		# adjust high limb for negative limb from s1
-Ln1:	bdn	Lnloop
-	b	Lend
-
-Lend0:	cal	9,0(10)
-Lend:	st	8,4(3)
-	aze	3,9
-	br
diff --git a/ghc/rts/gmp/mpn/power/rshift.s b/ghc/rts/gmp/mpn/power/rshift.s
deleted file mode 100644
index 65b3945f8a..0000000000
--- a/ghc/rts/gmp/mpn/power/rshift.s
+++ /dev/null
@@ -1,54 +0,0 @@
-# IBM POWER __gmpn_rshift -- 
-
-# Copyright (C) 1992, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s_ptr		r4
-# size		r5
-# cnt		r6
-
-	.toc
-	.globl	__gmpn_rshift
-	.globl	.__gmpn_rshift
-	.csect	__gmpn_rshift[DS]
-__gmpn_rshift:
-	.long	.__gmpn_rshift, TOC[tc0], 0
-	.csect	.text[PR]
-	.align	2
-.__gmpn_rshift:
-	sfi	8,6,32
-	mtctr	5		# put limb count in CTR loop register
-	l	0,0(4)		# read least significant limb
-	ai	9,3,-4		# adjust res_ptr since it's offset in the stu:s
-	sle	3,0,8		# compute carry limb, and init MQ register
-	bdz	Lend2		# if just one limb, skip loop
-	lu	0,4(4)		# read 2:nd least significant limb
-	sleq	7,0,8		# compute least significant limb of result
-	bdz	Lend		# if just two limb, skip loop
-Loop:	lu	0,4(4)		# load next higher limb
-	stu	7,4(9)		# store previous result during read latency
-	sleq	7,0,8		# compute result limb
-	bdn	Loop		# loop back until CTR is zero
-Lend:	stu	7,4(9)		# store 2:nd most significant limb
-Lend2:	sre	7,0,6		# compute most significant limb
-	st      7,4(9)		# store it"				\
-	br
diff --git a/ghc/rts/gmp/mpn/power/sdiv.s b/ghc/rts/gmp/mpn/power/sdiv.s
deleted file mode 100644
index 81da622fbc..0000000000
--- a/ghc/rts/gmp/mpn/power/sdiv.s
+++ /dev/null
@@ -1,34 +0,0 @@
-# Copyright (C) 1999 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-	.toc
-	.globl	__sdiv_qrnnd
-	.globl	.__sdiv_qrnnd
-	.csect	__sdiv_qrnnd[DS]
-__sdiv_qrnnd:
-	.long	.__sdiv_qrnnd, TOC[tc0], 0
-	.csect	.text[PR]
-	.align	2
-.__sdiv_qrnnd:
-	mtmq	5
-	div	0,4,6
-	mfmq	9
-	st	9,0(3)
-	mr	3,0
-	br
diff --git a/ghc/rts/gmp/mpn/power/sub_n.s b/ghc/rts/gmp/mpn/power/sub_n.s
deleted file mode 100644
index aa09cf5bc1..0000000000
--- a/ghc/rts/gmp/mpn/power/sub_n.s
+++ /dev/null
@@ -1,80 +0,0 @@
-# IBM POWER __gmpn_sub_n -- Subtract two limb vectors of equal, non-zero length.
-
-# Copyright (C) 1992, 1994, 1995, 1996, 1999, 2000 Free Software Foundation,
-# Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# s2_ptr	r5
-# size		r6
-
-	.toc
-	.globl	__gmpn_sub_n
-	.globl	.__gmpn_sub_n
-	.csect	__gmpn_sub_n[DS]
-__gmpn_sub_n:
-	.long	.__gmpn_sub_n, TOC[tc0], 0
-	.csect	.text[PR]
-	.align	2
-.__gmpn_sub_n:
-	andil.	10,6,1		# odd or even number of limbs?
-	l	8,0(4)		# load least significant s1 limb
-	l	0,0(5)		# load least significant s2 limb
-	cal	3,-4(3)		# offset res_ptr, it's updated before it's used
-	sri	10,6,1		# count for unrolled loop
-	sf	7,0,8		# subtract least significant limbs, set cy
-	mtctr	10		# copy count into CTR
-	beq	0,Leven		# branch if even # of limbs (# of limbs >= 2)
-
-# We have an odd # of limbs.  Add the first limbs separately.
-	cmpi	1,10,0		# is count for unrolled loop zero?
-	bc	4,6,L1		# bne cr1,L1 (misassembled by gas)
-	st	7,4(3)
-	sfe	3,0,0		# load !cy into ...
-	sfi	3,3,0		# ... return value register
-	br			# return
-
-# We added least significant limbs.  Now reload the next limbs to enter loop.
-L1:	lu	8,4(4)		# load s1 limb and update s1_ptr
-	lu	0,4(5)		# load s2 limb and update s2_ptr
-	stu	7,4(3)
-	sfe	7,0,8		# subtract limbs, set cy
-Leven:	lu	9,4(4)		# load s1 limb and update s1_ptr
-	lu	10,4(5)		# load s2 limb and update s2_ptr
-	bdz	Lend		# If done, skip loop
-
-Loop:	lu	8,4(4)		# load s1 limb and update s1_ptr
-	lu	0,4(5)		# load s2 limb and update s2_ptr
-	sfe	11,10,9		# subtract previous limbs with cy, set cy
-	stu	7,4(3)		# 
-	lu	9,4(4)		# load s1 limb and update s1_ptr
-	lu	10,4(5)		# load s2 limb and update s2_ptr
-	sfe	7,0,8		# subtract previous limbs with cy, set cy
-	stu	11,4(3)		# 
-	bdn	Loop		# decrement CTR and loop back
-
-Lend:	sfe	11,10,9		# subtract limbs with cy, set cy
-	st	7,4(3)		# 
-	st	11,8(3)		# 
-	sfe	3,0,0		# load !cy into ...
-	sfi	3,3,0		# ... return value register
-	br
diff --git a/ghc/rts/gmp/mpn/power/submul_1.s b/ghc/rts/gmp/mpn/power/submul_1.s
deleted file mode 100644
index bc01b7c95d..0000000000
--- a/ghc/rts/gmp/mpn/power/submul_1.s
+++ /dev/null
@@ -1,127 +0,0 @@
-# IBM POWER __gmpn_submul_1 -- Multiply a limb vector with a limb and subtract
-# the result from a second limb vector.
-
-# Copyright (C) 1992, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# size		r5
-# s2_limb	r6
-
-# The POWER architecture has no unsigned 32x32->64 bit multiplication
-# instruction.  To obtain that operation, we have to use the 32x32->64 signed
-# multiplication instruction, and add the appropriate compensation to the high
-# limb of the result.  We add the multiplicand if the multiplier has its most
-# significant bit set, and we add the multiplier if the multiplicand has its
-# most significant bit set.  We need to preserve the carry flag between each
-# iteration, so we have to compute the compensation carefully (the natural,
-# srai+and doesn't work).  Since the POWER architecture has a branch unit we
-# can branch in zero cycles, so that's how we perform the additions.
-
-	.toc
-	.globl	__gmpn_submul_1
-	.globl	.__gmpn_submul_1
-	.csect	__gmpn_submul_1[DS]
-__gmpn_submul_1:
-	.long	.__gmpn_submul_1, TOC[tc0], 0
-	.csect	.text[PR]
-	.align	2
-.__gmpn_submul_1:
-
-	cal	3,-4(3)
-	l	0,0(4)
-	cmpi	0,6,0
-	mtctr	5
-	mul	9,0,6
-	srai	7,0,31
-	and	7,7,6
-	mfmq	11
-	cax	9,9,7
-	l	7,4(3)
-	sf	8,11,7		# add res_limb
-	a	11,8,11		# invert cy (r11 is junk)
-	blt	Lneg
-Lpos:	bdz	Lend
-
-Lploop:	lu	0,4(4)
-	stu	8,4(3)
-	cmpi	0,0,0
-	mul	10,0,6
-	mfmq	0
-	ae	11,0,9		# low limb + old_cy_limb + old cy
-	l	7,4(3)
-	aze	10,10		# propagate cy to new cy_limb
-	sf	8,11,7		# add res_limb
-	a	11,8,11		# invert cy (r11 is junk)
-	bge	Lp0
-	cax	10,10,6		# adjust high limb for negative limb from s1
-Lp0:	bdz	Lend0
-	lu	0,4(4)
-	stu	8,4(3)
-	cmpi	0,0,0
-	mul	9,0,6
-	mfmq	0
-	ae	11,0,10
-	l	7,4(3)
-	aze	9,9
-	sf	8,11,7
-	a	11,8,11		# invert cy (r11 is junk)
-	bge	Lp1
-	cax	9,9,6		# adjust high limb for negative limb from s1
-Lp1:	bdn	Lploop
-
-	b	Lend
-
-Lneg:	cax	9,9,0
-	bdz	Lend
-Lnloop:	lu	0,4(4)
-	stu	8,4(3)
-	cmpi	0,0,0
-	mul	10,0,6
-	mfmq	7
-	ae	11,7,9
-	l	7,4(3)
-	ae	10,10,0		# propagate cy to new cy_limb
-	sf	8,11,7		# add res_limb
-	a	11,8,11		# invert cy (r11 is junk)
-	bge	Ln0
-	cax	10,10,6		# adjust high limb for negative limb from s1
-Ln0:	bdz	Lend0
-	lu	0,4(4)
-	stu	8,4(3)
-	cmpi	0,0,0
-	mul	9,0,6
-	mfmq	7
-	ae	11,7,10
-	l	7,4(3)
-	ae	9,9,0		# propagate cy to new cy_limb
-	sf	8,11,7		# add res_limb
-	a	11,8,11		# invert cy (r11 is junk)
-	bge	Ln1
-	cax	9,9,6		# adjust high limb for negative limb from s1
-Ln1:	bdn	Lnloop
-	b	Lend
-
-Lend0:	cal	9,0(10)
-Lend:	st	8,4(3)
-	aze	3,9
-	br
diff --git a/ghc/rts/gmp/mpn/power/umul.s b/ghc/rts/gmp/mpn/power/umul.s
deleted file mode 100644
index 8c77496380..0000000000
--- a/ghc/rts/gmp/mpn/power/umul.s
+++ /dev/null
@@ -1,38 +0,0 @@
-# Copyright (C) 1999 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-	.toc
-	.globl	__umul_ppmm
-	.globl	.__umul_ppmm
-	.csect	__umul_ppmm[DS]
-__umul_ppmm:
-	.long	.__umul_ppmm, TOC[tc0], 0
-	.csect	.text[PR]
-	.align	2
-.__umul_ppmm:
-	mul	9,4,5
-	srai	0,4,31
-	and	0,0,5
-	srai	5,5,31
-	and	5,5,4
-	cax	0,0,5
-	mfmq	11
-	st	11,0(3)
-	cax	3,9,0
-	br
diff --git a/ghc/rts/gmp/mpn/powerpc32/add_n.asm b/ghc/rts/gmp/mpn/powerpc32/add_n.asm
deleted file mode 100644
index 81ed04b162..0000000000
--- a/ghc/rts/gmp/mpn/powerpc32/add_n.asm
+++ /dev/null
@@ -1,61 +0,0 @@
-dnl PowerPC-32 mpn_add_n -- Add two limb vectors of the same length > 0 and
-dnl store sum in a third limb vector.
-
-dnl Copyright (C) 1995, 1997, 2000 Free Software Foundation, Inc.
-
-dnl This file is part of the GNU MP Library.
-
-dnl The GNU MP Library is free software; you can redistribute it and/or modify
-dnl it under the terms of the GNU Lesser General Public License as published by
-dnl the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl option) any later version.
-
-dnl The GNU MP Library is distributed in the hope that it will be useful, but
-dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl License for more details.
-
-dnl You should have received a copy of the GNU Lesser General Public License
-dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl MA 02111-1307, USA.
-
-
-dnl INPUT PARAMETERS
-dnl res_ptr	r3
-dnl s1_ptr	r4
-dnl s2_ptr	r5
-dnl size	r6
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_add_n)
-	mtctr	r6		C copy size into CTR
-	addic	r0,r0,0		C clear cy
-	lwz	r8,0(r4)	C load least significant s1 limb
-	lwz	r0,0(r5)	C load least significant s2 limb
-	addi	r3,r3,-4	C offset res_ptr, it's updated before it's used
-	bdz	.Lend		C If done, skip loop
-.Loop:	lwz	r9,4(r4)	C load s1 limb
-	lwz	r10,4(r5)	C load s2 limb
-	adde	r7,r0,r8	C add limbs with cy, set cy
-	stw	r7,4(r3)	C store result limb
-	bdz	.Lexit		C decrement CTR and exit if done
-	lwzu	r8,8(r4)	C load s1 limb and update s1_ptr
-	lwzu	r0,8(r5)	C load s2 limb and update s2_ptr
-	adde	r7,r10,r9	C add limbs with cy, set cy
-	stwu	r7,8(r3)	C store result limb and update res_ptr
-	bdnz	.Loop		C decrement CTR and loop back
-
-.Lend:	adde	r7,r0,r8
-	stw	r7,4(r3)	C store ultimate result limb
-	li	r3,0		C load cy into ...
-	addze	r3,r3		C ... return value register
-	blr
-.Lexit:	adde	r7,r10,r9
-	stw	r7,8(r3)
-	li	r3,0		C load cy into ...
-	addze	r3,r3		C ... return value register
-	blr
-EPILOGUE(mpn_add_n)
diff --git a/ghc/rts/gmp/mpn/powerpc32/addmul_1.asm b/ghc/rts/gmp/mpn/powerpc32/addmul_1.asm
deleted file mode 100644
index 3ef75b1532..0000000000
--- a/ghc/rts/gmp/mpn/powerpc32/addmul_1.asm
+++ /dev/null
@@ -1,124 +0,0 @@
-dnl PowerPC-32 mpn_addmul_1 -- Multiply a limb vector with a limb and add
-dnl the result to a second limb vector.
-
-dnl Copyright (C) 1995, 1997, 1998, 2000 Free Software Foundation, Inc.
-
-dnl This file is part of the GNU MP Library.
-
-dnl The GNU MP Library is free software; you can redistribute it and/or modify
-dnl it under the terms of the GNU Lesser General Public License as published by
-dnl the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl option) any later version.
-
-dnl The GNU MP Library is distributed in the hope that it will be useful, but
-dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl License for more details.
-
-dnl You should have received a copy of the GNU Lesser General Public License
-dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl MA 02111-1307, USA.
-
-
-dnl INPUT PARAMETERS
-dnl res_ptr	r3
-dnl s1_ptr	r4
-dnl size	r5
-dnl s2_limb	r6
-
-dnl This is optimized for the PPC604.  It has not been tested on PPC601, PPC603
-dnl or PPC750 since I don't have access to any such machines.
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_addmul_1)
-	cmpi	cr0,r5,9	C more than 9 limbs?
-	bgt	cr0,.Lbig	C branch if more than 9 limbs
-
-	mtctr	r5
-	lwz	r0,0(r4)
-	mullw	r7,r0,r6
-	mulhwu	r10,r0,r6
-	lwz	r9,0(r3)
-	addc	r8,r7,r9
-	addi	r3,r3,-4
-	bdz	.Lend
-.Lloop:
-	lwzu	r0,4(r4)
-	stwu	r8,4(r3)
-	mullw	r8,r0,r6
-	adde	r7,r8,r10
-	mulhwu	r10,r0,r6
-	lwz	r9,4(r3)
-	addze	r10,r10
-	addc	r8,r7,r9
-	bdnz	.Lloop
-.Lend:	stw	r8,4(r3)
-	addze	r3,r10
-	blr
-
-.Lbig:	stmw	r30,-32(r1)
-	addi	r5,r5,-1
-	srwi	r0,r5,2
-	mtctr	r0
-
-	lwz	r7,0(r4)
-	mullw	r8,r7,r6
-	mulhwu	r0,r7,r6
-	lwz	r7,0(r3)
-	addc	r8,r8,r7
-	stw	r8,0(r3)
-
-.LloopU:
-	lwz	r7,4(r4)
-	lwz	r12,8(r4)
-	lwz	r30,12(r4)
-	lwzu	r31,16(r4)
-	mullw	r8,r7,r6
-	mullw	r9,r12,r6
-	mullw	r10,r30,r6
-	mullw	r11,r31,r6
-	adde	r8,r8,r0	C add cy_limb
-	mulhwu	r0,r7,r6
-	lwz	r7,4(r3)
-	adde	r9,r9,r0
-	mulhwu	r0,r12,r6
-	lwz	r12,8(r3)
-	adde	r10,r10,r0
-	mulhwu	r0,r30,r6
-	lwz	r30,12(r3)
-	adde	r11,r11,r0
-	mulhwu	r0,r31,r6
-	lwz	r31,16(r3)
-	addze	r0,r0		C new cy_limb
-	addc	r8,r8,r7
-	stw	r8,4(r3)
-	adde	r9,r9,r12
-	stw	r9,8(r3)
-	adde	r10,r10,r30
-	stw	r10,12(r3)
-	adde	r11,r11,r31
-	stwu	r11,16(r3)
-	bdnz	.LloopU
-
-	andi.	r31,r5,3
-	mtctr	r31
-	beq	cr0,.Lendx
-
-.LloopE:
-	lwzu	r7,4(r4)
-	mullw	r8,r7,r6
-	adde	r8,r8,r0	C add cy_limb
-	mulhwu	r0,r7,r6
-	lwz	r7,4(r3)
-	addze	r0,r0		C new cy_limb
-	addc	r8,r8,r7
-	stwu	r8,4(r3)
-	bdnz	.LloopE
-.Lendx:
-	addze	r3,r0
-	lmw	r30,-32(r1)
-	blr
-EPILOGUE(mpn_addmul_1)
diff --git a/ghc/rts/gmp/mpn/powerpc32/aix.m4 b/ghc/rts/gmp/mpn/powerpc32/aix.m4
deleted file mode 100644
index 2bd8425817..0000000000
--- a/ghc/rts/gmp/mpn/powerpc32/aix.m4
+++ /dev/null
@@ -1,39 +0,0 @@
-divert(-1)
-dnl  m4 macros for AIX 32-bit assembly.
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-define(`ASM_START',
-	`.toc')
-	
-define(`PROLOGUE',
-	`
-	.globl	$1
-	.globl	.$1
-	.csect	$1[DS],2
-$1:
-	.long	.$1, TOC[tc0], 0
-	.csect	.text[PR]
-	.align	2
-.$1:')
-
-define(`EPILOGUE', `')
-
-divert
diff --git a/ghc/rts/gmp/mpn/powerpc32/gmp-mparam.h b/ghc/rts/gmp/mpn/powerpc32/gmp-mparam.h
deleted file mode 100644
index b283185789..0000000000
--- a/ghc/rts/gmp/mpn/powerpc32/gmp-mparam.h
+++ /dev/null
@@ -1,66 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 32
-#define BYTES_PER_MP_LIMB 4
-#define BITS_PER_LONGINT 32
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-/* These values are for the 604.  Presumably, these should be considerably
-   different for the 603 and 750 that have much slower multiply
-   instructions.  */
-
-/* Generated by tuneup.c, 2000-05-26. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD   26	/* tuneup says 20 */
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD      228
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD   46	/* tuneup says 44 */
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD      262
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD              52
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD             86
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            23
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD        7
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD          53
-#endif
diff --git a/ghc/rts/gmp/mpn/powerpc32/lshift.asm b/ghc/rts/gmp/mpn/powerpc32/lshift.asm
deleted file mode 100644
index 73a85430ab..0000000000
--- a/ghc/rts/gmp/mpn/powerpc32/lshift.asm
+++ /dev/null
@@ -1,145 +0,0 @@
-dnl  PowerPC-32 mpn_lshift -- Shift a number left.
-
-dnl Copyright (C) 1995, 1998, 2000 Free Software Foundation, Inc.
-
-dnl This file is part of the GNU MP Library.
-
-dnl The GNU MP Library is free software; you can redistribute it and/or modify
-dnl it under the terms of the GNU Lesser General Public License as published by
-dnl the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl option) any later version.
-
-dnl The GNU MP Library is distributed in the hope that it will be useful, but
-dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl License for more details.
-
-dnl You should have received a copy of the GNU Lesser General Public License
-dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl MA 02111-1307, USA.
-
-
-dnl INPUT PARAMETERS
-dnl res_ptr	r3
-dnl s1_ptr	r4
-dnl size	r5
-dnl cnt		r6
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_lshift)
-	cmpi	cr0,r5,12	C more than 12 limbs?
-	slwi	r0,r5,2
-	add	r4,r4,r0	C make r4 point at end of s1
-	add	r7,r3,r0	C make r7 point at end of res
-	bgt	.LBIG		C branch if more than 12 limbs
-
-	mtctr	r5		C copy size into CTR
-	subfic	r8,r6,32
-	lwzu	r11,-4(r4)	C load first s1 limb
-	srw	r3,r11,r8	C compute function return value
-	bdz	.Lend1
-
-.Loop:	lwzu	r10,-4(r4)
-	slw	r9,r11,r6
-	srw	r12,r10,r8
-	or	r9,r9,r12
-	stwu	r9,-4(r7)
-	bdz	.Lend2
-	lwzu	r11,-4(r4)
-	slw	r9,r10,r6
-	srw	r12,r11,r8
-	or	r9,r9,r12
-	stwu	r9,-4(r7)
-	bdnz	.Loop
-
-.Lend1:	slw	r0,r11,r6
-	stw	r0,-4(r7)
-	blr
-.Lend2:	slw	r0,r10,r6
-	stw	r0,-4(r7)
-	blr
-
-.LBIG:
-	stmw	r24,-32(r1)	C save registers we are supposed to preserve
-	lwzu	r9,-4(r4)
-	subfic	r8,r6,32
-	srw	r3,r9,r8	C compute function return value
-	slw	r0,r9,r6
-	addi	r5,r5,-1
-
-	andi.	r10,r5,3	C count for spill loop
-	beq	.Le
-	mtctr	r10
-	lwzu	r28,-4(r4)
-	bdz	.Lxe0
-
-.Loop0:	slw	r12,r28,r6
-	srw	r24,r28,r8
-	lwzu	r28,-4(r4)
-	or	r24,r0,r24
-	stwu	r24,-4(r7)
-	mr	r0,r12
-	bdnz	.Loop0		C taken at most once!
-
-.Lxe0:	slw	r12,r28,r6
-	srw	r24,r28,r8
-	or	r24,r0,r24
-	stwu	r24,-4(r7)
-	mr	r0,r12
-
-.Le:	srwi	r5,r5,2		C count for unrolled loop
-	addi	r5,r5,-1
-	mtctr	r5
-	lwz	r28,-4(r4)
-	lwz	r29,-8(r4)
-	lwz	r30,-12(r4)
-	lwzu	r31,-16(r4)
-
-.LoopU:	slw	r9,r28,r6
-	srw	r24,r28,r8
-	lwz	r28,-4(r4)
-	slw	r10,r29,r6
-	srw	r25,r29,r8
-	lwz	r29,-8(r4)
-	slw	r11,r30,r6
-	srw	r26,r30,r8
-	lwz	r30,-12(r4)
-	slw	r12,r31,r6
-	srw	r27,r31,r8
-	lwzu	r31,-16(r4)
-	or	r24,r0,r24
-	stw	r24,-4(r7)
-	or	r25,r9,r25
-	stw	r25,-8(r7)
-	or	r26,r10,r26
-	stw	r26,-12(r7)
-	or	r27,r11,r27
-	stwu	r27,-16(r7)
-	mr	r0,r12
-	bdnz	.LoopU
-
-	slw	r9,r28,r6
-	srw	r24,r28,r8
-	slw	r10,r29,r6
-	srw	r25,r29,r8
-	slw	r11,r30,r6
-	srw	r26,r30,r8
-	slw	r12,r31,r6
-	srw	r27,r31,r8
-	or	r24,r0,r24
-	stw	r24,-4(r7)
-	or	r25,r9,r25
-	stw	r25,-8(r7)
-	or	r26,r10,r26
-	stw	r26,-12(r7)
-	or	r27,r11,r27
-	stwu	r27,-16(r7)
-	mr	r0,r12
-
-	stw	r0,-4(r7)
-	lmw	r24,-32(r1)	C restore registers
-	blr
-EPILOGUE(mpn_lshift)
diff --git a/ghc/rts/gmp/mpn/powerpc32/mul_1.asm b/ghc/rts/gmp/mpn/powerpc32/mul_1.asm
deleted file mode 100644
index ec878b54d5..0000000000
--- a/ghc/rts/gmp/mpn/powerpc32/mul_1.asm
+++ /dev/null
@@ -1,86 +0,0 @@
-dnl PowerPC-32 mpn_mul_1 -- Multiply a limb vector with a limb and store
-dnl the result in a second limb vector.
-
-dnl Copyright (C) 1995, 1997, 2000 Free Software Foundation, Inc.
-
-dnl This file is part of the GNU MP Library.
-
-dnl The GNU MP Library is free software; you can redistribute it and/or modify
-dnl it under the terms of the GNU Lesser General Public License as published by
-dnl the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl option) any later version.
-
-dnl The GNU MP Library is distributed in the hope that it will be useful, but
-dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl License for more details.
-
-dnl You should have received a copy of the GNU Lesser General Public License
-dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl MA 02111-1307, USA.
-
-
-dnl INPUT PARAMETERS
-dnl res_ptr	r3
-dnl s1_ptr	r4
-dnl size	r5
-dnl s2_limb	r6
-
-dnl This is optimized for the PPC604 but it runs decently even on PPC601.  It
-dnl has not been tested on a PPC603 since I don't have access to any such
-dnl machines.
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_mul_1)
-	mtctr	r5
-	addi	r3,r3,-4	C adjust res_ptr, it's offset before it's used
-	li	r12,0		C clear upper product reg
-	addic	r0,r0,0		C clear cy
-C Start software pipeline
-	lwz	r8,0(r4)
-	bdz	.Lend3
-	stmw	r30,-8(r1)	C save registers we are supposed to preserve
-	lwzu	r9,4(r4)
-	mullw	r11,r8,r6
-	mulhwu	r0,r8,r6
-	bdz	.Lend1
-C Software pipelined main loop
-.Loop:	lwz	r8,4(r4)
-	mullw	r10,r9,r6
-	adde	r30,r11,r12
-	mulhwu	r12,r9,r6
-	stw	r30,4(r3)
-	bdz	.Lend2
-	lwzu	r9,8(r4)
-	mullw	r11,r8,r6
-	adde	r31,r10,r0
-	mulhwu	r0,r8,r6
-	stwu	r31,8(r3)
-	bdnz	.Loop
-C Finish software pipeline
-.Lend1:	mullw	r10,r9,r6
-	adde	r30,r11,r12
-	mulhwu	r12,r9,r6
-	stw	r30,4(r3)
-	adde	r31,r10,r0
-	stwu	r31,8(r3)
-	addze	r3,r12
-	lmw	r30,-8(r1)	C restore registers from stack
-	blr
-.Lend2:	mullw	r11,r8,r6
-	adde	r31,r10,r0
-	mulhwu	r0,r8,r6
-	stwu	r31,8(r3)
-	adde	r30,r11,r12
-	stw	r30,4(r3)
-	addze	r3,r0
-	lmw	r30,-8(r1)	C restore registers from stack
-	blr
-.Lend3:	mullw	r11,r8,r6
-	stw	r11,4(r3)
-	mulhwu	r3,r8,r6
-	blr
-EPILOGUE(mpn_mul_1)
diff --git a/ghc/rts/gmp/mpn/powerpc32/regmap.m4 b/ghc/rts/gmp/mpn/powerpc32/regmap.m4
deleted file mode 100644
index 978f18902a..0000000000
--- a/ghc/rts/gmp/mpn/powerpc32/regmap.m4
+++ /dev/null
@@ -1,34 +0,0 @@
-divert(-1)
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-dnl Map register names r0, r1, etc, to just `0', `1', etc.
-dnl This is needed on all systems but NeXT, Rhapsody, and MacOS-X
-forloop(i,0,31,
-`define(`r'i,i)'
-)
-
-dnl Likewise for cr0, cr1, etc.
-forloop(i,0,7,
-`define(`cr'i,i)'
-)
-
-divert
diff --git a/ghc/rts/gmp/mpn/powerpc32/rshift.asm b/ghc/rts/gmp/mpn/powerpc32/rshift.asm
deleted file mode 100644
index a09ba04938..0000000000
--- a/ghc/rts/gmp/mpn/powerpc32/rshift.asm
+++ /dev/null
@@ -1,60 +0,0 @@
-dnl PowerPC-32 mpn_rshift -- Shift a number right.
-
-dnl Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-dnl This file is part of the GNU MP Library.
-
-dnl The GNU MP Library is free software; you can redistribute it and/or modify
-dnl it under the terms of the GNU Lesser General Public License as published by
-dnl the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl option) any later version.
-
-dnl The GNU MP Library is distributed in the hope that it will be useful, but
-dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl License for more details.
-
-dnl You should have received a copy of the GNU Lesser General Public License
-dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl MA 02111-1307, USA.
-
-
-dnl INPUT PARAMETERS
-dnl res_ptr	r3
-dnl s1_ptr	r4
-dnl size	r5
-dnl cnt		r6
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_rshift)
-	mtctr	r5		C copy size into CTR
-	addi	r7,r3,-4	C move adjusted res_ptr to free return reg
-	subfic	r8,r6,32
-	lwz	r11,0(r4)	C load first s1 limb
-	slw	r3,r11,r8	C compute function return value
-	bdz	.Lend1
-
-.Loop:	lwzu	r10,4(r4)
-	srw	r9,r11,r6
-	slw	r12,r10,r8
-	or	r9,r9,r12
-	stwu	r9,4(r7)
-	bdz	.Lend2
-	lwzu	r11,4(r4)
-	srw	r9,r10,r6
-	slw	r12,r11,r8
-	or	r9,r9,r12
-	stwu	r9,4(r7)
-	bdnz	.Loop
-
-.Lend1:	srw	r0,r11,r6
-	stw	r0,4(r7)
-	blr
-
-.Lend2:	srw	r0,r10,r6
-	stw	r0,4(r7)
-	blr
-EPILOGUE(mpn_rshift)
diff --git a/ghc/rts/gmp/mpn/powerpc32/sub_n.asm b/ghc/rts/gmp/mpn/powerpc32/sub_n.asm
deleted file mode 100644
index b04b4192ef..0000000000
--- a/ghc/rts/gmp/mpn/powerpc32/sub_n.asm
+++ /dev/null
@@ -1,61 +0,0 @@
-dnl PowerPC-32 mpn_sub_n -- Subtract two limb vectors of the same length > 0
-dnl and store difference in a third limb vector.
-
-dnl Copyright (C) 1995, 1997, 2000 Free Software Foundation, Inc.
-
-dnl This file is part of the GNU MP Library.
-
-dnl The GNU MP Library is free software; you can redistribute it and/or modify
-dnl it under the terms of the GNU Lesser General Public License as published by
-dnl the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl option) any later version.
-
-dnl The GNU MP Library is distributed in the hope that it will be useful, but
-dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl License for more details.
-
-dnl You should have received a copy of the GNU Lesser General Public License
-dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl MA 02111-1307, USA.
-
-
-dnl INPUT PARAMETERS
-dnl res_ptr	r3
-dnl s1_ptr	r4
-dnl s2_ptr	r5
-dnl size	r6
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_sub_n)
-	mtctr	r6		C copy size into CTR
-	addic	r0,r6,-1	C set cy
-	lwz	r8,0(r4)	C load least significant s1 limb
-	lwz	r0,0(r5)	C load least significant s2 limb
-	addi	r3,r3,-4	C offset res_ptr, it's updated before it's used
-	bdz	.Lend		C If done, skip loop
-.Loop:	lwz	r9,4(r4)	C load s1 limb
-	lwz	r10,4(r5)	C load s2 limb
-	subfe	r7,r0,r8	C subtract limbs with cy, set cy
-	stw	r7,4(r3)	C store result limb
-	bdz	.Lexit		C decrement CTR and exit if done
-	lwzu	r8,8(r4)	C load s1 limb and update s1_ptr
-	lwzu	r0,8(r5)	C load s2 limb and update s2_ptr
-	subfe	r7,r10,r9	C subtract limbs with cy, set cy
-	stwu	r7,8(r3)	C store result limb and update res_ptr
-	bdnz	.Loop		C decrement CTR and loop back
-
-.Lend:	subfe	r7,r0,r8
-	stw	r7,4(r3)	C store ultimate result limb
-	subfe	r3,r0,r0	C load !cy into ...
-	subfic	r3,r3,0		C ... return value register
-	blr
-.Lexit:	subfe	r7,r10,r9
-	stw	r7,8(r3)
-	subfe	r3,r0,r0	C load !cy into ...
-	subfic	r3,r3,0		C ... return value register
-	blr
-EPILOGUE(mpn_sub_n)
diff --git a/ghc/rts/gmp/mpn/powerpc32/submul_1.asm b/ghc/rts/gmp/mpn/powerpc32/submul_1.asm
deleted file mode 100644
index a129e9f9ea..0000000000
--- a/ghc/rts/gmp/mpn/powerpc32/submul_1.asm
+++ /dev/null
@@ -1,130 +0,0 @@
-dnl PowerPC-32 mpn_submul_1 -- Multiply a limb vector with a limb and subtract
-dnl the result from a second limb vector.
-
-dnl Copyright (C) 1995, 1997, 1998, 2000 Free Software Foundation, Inc.
-
-dnl This file is part of the GNU MP Library.
-
-dnl The GNU MP Library is free software; you can redistribute it and/or modify
-dnl it under the terms of the GNU Lesser General Public License as published by
-dnl the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl option) any later version.
-
-dnl The GNU MP Library is distributed in the hope that it will be useful, but
-dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl License for more details.
-
-dnl You should have received a copy of the GNU Lesser General Public License
-dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl MA 02111-1307, USA.
-
-
-dnl INPUT PARAMETERS
-dnl res_ptr	r3
-dnl s1_ptr	r4
-dnl size	r5
-dnl s2_limb	r6
-
-dnl This is optimized for the PPC604.  It has not been tested on PPC601, PPC603
-dnl or PPC750 since I don't have access to any such machines.
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_submul_1)
-	cmpi	cr0,r5,9	C more than 9 limbs?
-	bgt	cr0,.Lbig	C branch if more than 9 limbs
-
-	mtctr	r5
-	lwz	r0,0(r4)
-	mullw	r7,r0,r6
-	mulhwu	r10,r0,r6
-	lwz	r9,0(r3)
-	subfc	r8,r7,r9
-	addc	r7,r7,r8	C invert cy (r7 is junk)
-	addi	r3,r3,-4
-	bdz	.Lend
-.Lloop:
-	lwzu	r0,4(r4)
-	stwu	r8,4(r3)
-	mullw	r8,r0,r6
-	adde	r7,r8,r10
-	mulhwu	r10,r0,r6
-	lwz	r9,4(r3)
-	addze	r10,r10
-	subfc	r8,r7,r9
-	addc	r7,r7,r8	C invert cy (r7 is junk)
-	bdnz	.Lloop
-.Lend:	stw	r8,4(r3)
-	addze	r3,r10
-	blr
-
-.Lbig:	stmw	r30,-32(r1)
-	addi	r5,r5,-1
-	srwi	r0,r5,2
-	mtctr	r0
-
-	lwz	r7,0(r4)
-	mullw	r8,r7,r6
-	mulhwu	r0,r7,r6
-	lwz	r7,0(r3)
-	subfc	r7,r8,r7
-	addc	r8,r8,r7
-	stw	r7,0(r3)
-
-.LloopU:
-	lwz	r7,4(r4)
-	lwz	r12,8(r4)
-	lwz	r30,12(r4)
-	lwzu	r31,16(r4)
-	mullw	r8,r7,r6
-	mullw	r9,r12,r6
-	mullw	r10,r30,r6
-	mullw	r11,r31,r6
-	adde	r8,r8,r0	C add cy_limb
-	mulhwu	r0,r7,r6
-	lwz	r7,4(r3)
-	adde	r9,r9,r0
-	mulhwu	r0,r12,r6
-	lwz	r12,8(r3)
-	adde	r10,r10,r0
-	mulhwu	r0,r30,r6
-	lwz	r30,12(r3)
-	adde	r11,r11,r0
-	mulhwu	r0,r31,r6
-	lwz	r31,16(r3)
-	addze	r0,r0		C new cy_limb
-	subfc	r7,r8,r7
-	stw	r7,4(r3)
-	subfe	r12,r9,r12
-	stw	r12,8(r3)
-	subfe	r30,r10,r30
-	stw	r30,12(r3)
-	subfe	r31,r11,r31
-	stwu	r31,16(r3)
-	subfe	r11,r11,r11	C invert ...
-	addic	r11,r11,1	C ... carry
-	bdnz	.LloopU
-
-	andi.	r31,r5,3
-	mtctr	r31
-	beq	cr0,.Lendx
-
-.LloopE:
-	lwzu	r7,4(r4)
-	mullw	r8,r7,r6
-	adde	r8,r8,r0	C add cy_limb
-	mulhwu	r0,r7,r6
-	lwz	r7,4(r3)
-	addze	r0,r0		C new cy_limb
-	subfc	r7,r8,r7
-	addc	r8,r8,r7
-	stwu	r7,4(r3)
-	bdnz	.LloopE
-.Lendx:
-	addze	r3,r0
-	lmw	r30,-32(r1)
-	blr
-EPILOGUE(mpn_submul_1)
diff --git a/ghc/rts/gmp/mpn/powerpc32/umul.asm b/ghc/rts/gmp/mpn/powerpc32/umul.asm
deleted file mode 100644
index eeaa0a4dc8..0000000000
--- a/ghc/rts/gmp/mpn/powerpc32/umul.asm
+++ /dev/null
@@ -1,32 +0,0 @@
-dnl PowerPC-32 umul_ppmm -- support for longlong.h
-
-dnl Copyright (C) 2000 Free Software Foundation, Inc.
-
-dnl This file is part of the GNU MP Library.
-
-dnl The GNU MP Library is free software; you can redistribute it and/or modify
-dnl it under the terms of the GNU Lesser General Public License as published by
-dnl the Free Software Foundation; either version 2.1 of the License, or (at your
-dnl option) any later version.
-
-dnl The GNU MP Library is distributed in the hope that it will be useful, but
-dnl WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl License for more details.
-
-dnl You should have received a copy of the GNU Lesser General Public License
-dnl along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_umul_ppmm)
-	mullw	0,4,5
-	mulhwu	9,4,5
-	stw	0,0(3)
-	mr	3,9
-	blr
-EPILOGUE(mpn_umul_ppmm)
diff --git a/ghc/rts/gmp/mpn/powerpc64/README b/ghc/rts/gmp/mpn/powerpc64/README
deleted file mode 100644
index c779276917..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/README
+++ /dev/null
@@ -1,36 +0,0 @@
-PPC630 (aka Power3) pipeline information:
-
-Decoding is 4-way and issue is 8-way with some out-of-order capability.
-LS1  - ld/st unit 1
-LS2  - ld/st unit 2
-FXU1 - integer unit 1, handles any simple integer instructions
-FXU2 - integer unit 2, handles any simple integer instructions
-FXU3 - integer unit 3, handles integer multiply and divide
-FPU1 - floating-point unit 1
-FPU2 - floating-point unit 2
-
-Memory:		  Any two memory operations can issue, but memory subsystem
-		  can sustain just one store per cycle.
-Simple integer:	  2 operations (such as add, rl*)
-Integer multiply: 1 operation every 9th cycle worst case; exact timing depends
-		  on 2nd operand most significant bit position (10 bits per
-		  cycle).  Multiply unit is not pipelined, only one multiply
-		  operation in progress is allowed.
-Integer divide:	  ?
-Floating-point:	  Any plain 2 arithmetic instructions (such as fmul, fadd, fmadd)
-		  Latency = 4.
-Floating-point divide:
-		  ?
-Floating-point square root:
-		  ?
-
-Best possible times for the main loops:
-shift:	      1.5 cycles limited by integer unit contention.
-	      With 63 special loops, one for each shift count, we could
-	      reduce the needed integer instructions to 2, which would
-	      reduce the best possible time to 1 cycle.
-add/sub:      1.5 cycles, limited by ld/st unit contention.
-mul:	      18 cycles (average) unless floating-point operations are used,
-	      but that would only help for multiplies of perhaps 10 and more
-	      limbs.
-addmul/submul:Same situation as for mul.
diff --git a/ghc/rts/gmp/mpn/powerpc64/add_n.asm b/ghc/rts/gmp/mpn/powerpc64/add_n.asm
deleted file mode 100644
index c3325376dc..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/add_n.asm
+++ /dev/null
@@ -1,61 +0,0 @@
-# PowerPC-64 mpn_add_n -- Add two limb vectors of the same length > 0 and
-# store sum in a third limb vector.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# s2_ptr	r5
-# size		r6
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_add_n)
-	mtctr	r6		# copy size into CTR
-	addic	r0,r0,0		# clear cy
-	ld	r8,0(r4)	# load least significant s1 limb
-	ld	r0,0(r5)	# load least significant s2 limb
-	addi	r3,r3,-8	# offset res_ptr, it's updated before it's used
-	bdz	.Lend		# If done, skip loop
-.Loop:	ld	r9,8(r4)	# load s1 limb
-	ld	r10,8(r5)	# load s2 limb
-	adde	r7,r0,r8	# add limbs with cy, set cy
-	std	r7,8(r3)	# store result limb
-	bdz	.Lexit		# decrement CTR and exit if done
-	ldu	r8,16(r4)	# load s1 limb and update s1_ptr
-	ldu	r0,16(r5)	# load s2 limb and update s2_ptr
-	adde	r7,r10,r9	# add limbs with cy, set cy
-	stdu	r7,16(r3)	# store result limb and update res_ptr
-	bdnz	.Loop		# decrement CTR and loop back
-
-.Lend:	adde	r7,r0,r8
-	std	r7,8(r3)	# store ultimate result limb
-	li	r3,0		# load cy into ...
-	addze	r3,r3		# ... return value register
-	blr
-.Lexit:	adde	r7,r10,r9
-	std	r7,16(r3)
-	li	r3,0		# load cy into ...
-	addze	r3,r3		# ... return value register
-	blr
-EPILOGUE(mpn_add_n)
diff --git a/ghc/rts/gmp/mpn/powerpc64/addmul_1.asm b/ghc/rts/gmp/mpn/powerpc64/addmul_1.asm
deleted file mode 100644
index 81774482fe..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/addmul_1.asm
+++ /dev/null
@@ -1,52 +0,0 @@
-# PowerPC-64 mpn_addmul_1 -- Multiply a limb vector with a limb and add
-# the result to a second limb vector.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# size		r5
-# s2_limb	r6
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_addmul_1)
-	mtctr	5
-	li	9,0		# cy_limb = 0
-	addic	0,0,0
-	cal	3,-8(3)
-	cal	4,-8(4)
-.Loop:
-	ldu	0,8(4)
-	ld	10,8(3)
-	mulld	7,0,6
-	adde	7,7,9
-	mulhdu	9,0,6
-	addze	9,9
-	addc	7,7,10
-	stdu	7,8(3)
-	bdnz	.Loop
-
-	addze	3,9
-	blr
-EPILOGUE(mpn_addmul_1)
diff --git a/ghc/rts/gmp/mpn/powerpc64/addsub_n.asm b/ghc/rts/gmp/mpn/powerpc64/addsub_n.asm
deleted file mode 100644
index 4ed40d71ae..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/addsub_n.asm
+++ /dev/null
@@ -1,107 +0,0 @@
-# PowerPC-64 mpn_addsub_n -- Simultaneous add and sub.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# s2_ptr	r5
-# size		r6
-
-include(`asm-syntax.m4')
-
-define(SAVE_BORROW_RESTORE_CARRY,
-	`sldi $1,$1,63
-	adde $1,$1,$1')
-define(SAVE_CARRY_RESTORE_BORROW,
-	`sldi $1,$1,63
-	adde $1,$1,$1')
-
-# 19991117
-
-# This is just crafted for testing some ideas, and verifying that we can make
-# it run fast.  It runs at 2.55 cycles/limb on the 630, which is very good.
-# We should play a little with the schedule.  No time has been spent on that.
-
-# To finish this, the loop warm up and cool down code needs to be written,
-# and the result need to be tested.  Also, the proper calling sequence should
-# be used.
-
-#             r1p r2p s1p s2p n
-# Use reg r0, r3, r4, r5, r6, r7, r8, r9, r10, r11, r12
-
-ASM_START()
-PROLOGUE(mpn_addsub_n)
-	std	r14,-64(1)
-	std	r15,-56(1)
-	std	r16,-48(1)
-	std	r17,-40(1)
-	std	r18,-32(1)
-	std	r19,-24(1)
-
-	srdi	r7,r7,2
-	mtctr	r7		# copy size into CTR
-	addic	r0,r0,0		# clear cy
-	addi	r3,r3,-8	# offset res_ptr, it's updated before it's used
-	addi	r4,r4,-8	# offset res_ptr, it's updated before it's used
-
-.Loop:
-	adde	r12,r8,r9
-	std	r12,8(r3)
-	adde	r12,r10,r11
-	std	r12,16(r3)
-
-	SAVE_CARRY_RESTORE_BORROW(r0)
-
-	subfe	r12,r8,r9
-	std	r12,8(r4)
-	ld	r8,8(r5)	# s1 L 1
-	ld	r9,8(r6)	# s2 L 1
-	subfe	r12,r10,r11
-	std	r12,16(r4)
-	ld	r10,16(r5)	# s1 L 2
-	ld	r11,16(r6)	# s2 L 2
-# pair -------------------------
-	subfe	r12,r14,r15
-	std	r12,24(r4)
-	subfe	r12,r16,r17
-	stdu	r12,32(r4)
-
-	SAVE_BORROW_RESTORE_CARRY(r0)
-
-	adde	r12,r14,r15
-	std	r12,24(r3)
-	ld	r14,24(r5)	# s1 L 3
-	ld	r15,24(r6)	# s2 L 3
-	adde	r12,r16,r17
-	stdu	r12,32(r3)
-	ldu	r16,32(r5)	# s1 L 4
-	ldu	r17,32(r6)	# s2 L 4
-	bdnz	.Loop
-
-	ld	r14,-64(1)
-	ld	r15,-56(1)
-	ld	r16,-48(1)
-	ld	r17,-40(1)
-	ld	r18,-32(1)
-	ld	r19,-24(1)
-	blr
-EPILOGUE(mpn_addsub_n)
diff --git a/ghc/rts/gmp/mpn/powerpc64/aix.m4 b/ghc/rts/gmp/mpn/powerpc64/aix.m4
deleted file mode 100644
index aee9f1f97a..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/aix.m4
+++ /dev/null
@@ -1,40 +0,0 @@
-divert(-1)
-dnl  m4 macros for AIX 64-bit assembly.
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-define(`ASM_START',
-	`.machine	"ppc64"
-	.toc')
-	
-define(`PROLOGUE',
-	`
-	.globl	$1
-	.globl	.$1
-	.csect	$1[DS],3
-$1:
-	.llong	.$1, TOC[tc0], 0
-	.csect	.text[PR]
-	.align	2
-.$1:')
-
-define(`EPILOGUE', `')
-
-divert
diff --git a/ghc/rts/gmp/mpn/powerpc64/copyd.asm b/ghc/rts/gmp/mpn/powerpc64/copyd.asm
deleted file mode 100644
index d06e8c25fd..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/copyd.asm
+++ /dev/null
@@ -1,45 +0,0 @@
-# PowerPC-64 mpn_copyd -- Copy a limb vector.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# rptr	r3
-# sptr	r4
-# n	r5
-
-include(`../config.m4')
-
-# Unrolling this analogous to sparc64/copyi.s doesn't help for any
-# operand sizes.
-
-ASM_START()
-PROLOGUE(mpn_copyd)
-	cmpdi	cr0,r5,0
-	mtctr	r5
-	sldi	r5,r5,3
-	add	r4,r4,r5
-	add	r3,r3,r5
-	beq	cr0,.Lend
-.Loop:	ldu	r0,-8(r4)
-	stdu	r0,-8(r3)
-	bdnz	.Loop
-.Lend:	blr
-EPILOGUE(mpn_copyd)
diff --git a/ghc/rts/gmp/mpn/powerpc64/copyi.asm b/ghc/rts/gmp/mpn/powerpc64/copyi.asm
deleted file mode 100644
index a1bedc4c5b..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/copyi.asm
+++ /dev/null
@@ -1,44 +0,0 @@
-# PowerPC-64 mpn_copyi -- Copy a limb vector.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# rptr	r3
-# sptr	r4
-# n	r5
-
-include(`../config.m4')
-
-# Unrolling this analogous to sparc64/copyi.s doesn't help for any
-# operand sizes.
-
-ASM_START()
-PROLOGUE(mpn_copyi)
-	cmpdi	cr0,r5,0
-	mtctr	r5
-	addi	r4,r4,-8
-	addi	r3,r3,-8
-	beq	cr0,.Lend
-.Loop:	ldu	r0,8(r4)
-	stdu	r0,8(r3)
-	bdnz	.Loop
-.Lend:	blr
-EPILOGUE(mpn_copyi)
diff --git a/ghc/rts/gmp/mpn/powerpc64/gmp-mparam.h b/ghc/rts/gmp/mpn/powerpc64/gmp-mparam.h
deleted file mode 100644
index 6fefb960cd..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/gmp-mparam.h
+++ /dev/null
@@ -1,62 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 64
-#define BYTES_PER_MP_LIMB 8
-#define BITS_PER_LONGINT 64
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-/* Generated by tuneup.c, 2000-07-16. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD   10
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD       57
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD   16
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD       89
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD              28
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD            216
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            14
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD        6
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD         163
-#endif
diff --git a/ghc/rts/gmp/mpn/powerpc64/lshift.asm b/ghc/rts/gmp/mpn/powerpc64/lshift.asm
deleted file mode 100644
index cef3a81fdd..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/lshift.asm
+++ /dev/null
@@ -1,159 +0,0 @@
-#  PowerPC-64 mpn_lshift -- Shift a number left.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# size		r5
-# cnt		r6
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_lshift)
-	cmpdi	cr0,r5,20	# more than 20 limbs?
-	sldi	r0,r5,3
-	add	r4,r4,r0	# make r4 point at end of s1
-	add	r7,r3,r0	# make r7 point at end of res
-	bgt	.LBIG		# branch if more than 12 limbs
-
-	mtctr	r5		# copy size into CTR
-	subfic	r8,r6,64
-	ldu	r11,-8(r4)	# load first s1 limb
-	srd	r3,r11,r8	# compute function return value
-	bdz	.Lend1
-
-.Loop:	ldu	r10,-8(r4)
-	sld	r9,r11,r6
-	srd	r12,r10,r8
-	or	r9,r9,r12
-	stdu	r9,-8(r7)
-	bdz	.Lend2
-	ldu	r11,-8(r4)
-	sld	r9,r10,r6
-	srd	r12,r11,r8
-	or	r9,r9,r12
-	stdu	r9,-8(r7)
-	bdnz	.Loop
-
-.Lend1:	sld	r0,r11,r6
-	std	r0,-8(r7)
-	blr
-.Lend2:	sld	r0,r10,r6
-	std	r0,-8(r7)
-	blr
-
-.LBIG:
-	std	r24,-64(1)
-	std	r25,-56(1)
-	std	r26,-48(1)
-	std	r27,-40(1)
-	std	r28,-32(1)
-	std	r29,-24(1)
-	std	r30,-16(1)
-	std	r31,-8(1)
-	ldu	r9,-8(r4)
-	subfic	r8,r6,64
-	srd	r3,r9,r8	# compute function return value
-	sld	r0,r9,r6
-	addi	r5,r5,-1
-
-	andi.	r10,r5,3	# count for spill loop
-	beq	.Le
-	mtctr	r10
-	ldu	r28,-8(r4)
-	bdz	.Lxe0
-
-.Loop0:	sld	r12,r28,r6
-	srd	r24,r28,r8
-	ldu	r28,-8(r4)
-	or	r24,r0,r24
-	stdu	r24,-8(r7)
-	mr	r0,r12
-	bdnz	.Loop0		# taken at most once!
-
-.Lxe0:	sld	r12,r28,r6
-	srd	r24,r28,r8
-	or	r24,r0,r24
-	stdu	r24,-8(r7)
-	mr	r0,r12
-
-.Le:	srdi	r5,r5,2		# count for unrolled loop
-	addi	r5,r5,-1
-	mtctr	r5
-	ld	r28,-8(r4)
-	ld	r29,-16(r4)
-	ld	r30,-24(r4)
-	ldu	r31,-32(r4)
-
-.LoopU:	sld	r9,r28,r6
-	srd	r24,r28,r8
-	ld	r28,-8(r4)
-	sld	r10,r29,r6
-	srd	r25,r29,r8
-	ld	r29,-16(r4)
-	sld	r11,r30,r6
-	srd	r26,r30,r8
-	ld	r30,-24(r4)
-	sld	r12,r31,r6
-	srd	r27,r31,r8
-	ldu	r31,-32(r4)
-	or	r24,r0,r24
-	std	r24,-8(r7)
-	or	r25,r9,r25
-	std	r25,-16(r7)
-	or	r26,r10,r26
-	std	r26,-24(r7)
-	or	r27,r11,r27
-	stdu	r27,-32(r7)
-	mr	r0,r12
-	bdnz	.LoopU
-
-	sld	r9,r28,r6
-	srd	r24,r28,r8
-	sld	r10,r29,r6
-	srd	r25,r29,r8
-	sld	r11,r30,r6
-	srd	r26,r30,r8
-	sld	r12,r31,r6
-	srd	r27,r31,r8
-	or	r24,r0,r24
-	std	r24,-8(r7)
-	or	r25,r9,r25
-	std	r25,-16(r7)
-	or	r26,r10,r26
-	std	r26,-24(r7)
-	or	r27,r11,r27
-	stdu	r27,-32(r7)
-	mr	r0,r12
-
-	std	r0,-8(r7)
-	ld	r24,-64(1)
-	ld	r25,-56(1)
-	ld	r26,-48(1)
-	ld	r27,-40(1)
-	ld	r28,-32(1)
-	ld	r29,-24(1)
-	ld	r30,-16(1)
-	ld	r31,-8(1)
-	blr
-EPILOGUE(mpn_lshift)
diff --git a/ghc/rts/gmp/mpn/powerpc64/mul_1.asm b/ghc/rts/gmp/mpn/powerpc64/mul_1.asm
deleted file mode 100644
index 47597283ff..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/mul_1.asm
+++ /dev/null
@@ -1,49 +0,0 @@
-# PowerPC-64 mpn_mul_1 -- Multiply a limb vector with a limb and store
-# the result in a second limb vector.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# size		r5
-# s2_limb	r6
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_mul_1)
-	mtctr	5
-	li	9,0		# cy_limb = 0
-	addic	0,0,0
-	cal	3,-8(3)
-	cal	4,-8(4)
-.Loop:
-	ldu	0,8(4)
-	mulld	7,0,6
-	adde	7,7,9
-	mulhdu	9,0,6
-	stdu	7,8(3)
-	bdnz	.Loop
-
-	addze	3,9
-	blr
-EPILOGUE(mpn_mul_1)
diff --git a/ghc/rts/gmp/mpn/powerpc64/rshift.asm b/ghc/rts/gmp/mpn/powerpc64/rshift.asm
deleted file mode 100644
index 88272c7fa9..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/rshift.asm
+++ /dev/null
@@ -1,60 +0,0 @@
-# PowerPC-64 mpn_rshift -- Shift a number right.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# size		r5
-# cnt		r6
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_rshift)
-	mtctr	r5		# copy size into CTR
-	addi	r7,r3,-8	# move adjusted res_ptr to free return reg
-	subfic	r8,r6,64
-	ld	r11,0(r4)	# load first s1 limb
-	sld	r3,r11,r8	# compute function return value
-	bdz	.Lend1
-
-.Loop:	ldu	r10,8(r4)
-	srd	r9,r11,r6
-	sld	r12,r10,r8
-	or	r9,r9,r12
-	stdu	r9,8(r7)
-	bdz	.Lend2
-	ldu	r11,8(r4)
-	srd	r9,r10,r6
-	sld	r12,r11,r8
-	or	r9,r9,r12
-	stdu	r9,8(r7)
-	bdnz	.Loop
-
-.Lend1:	srd	r0,r11,r6
-	std	r0,8(r7)
-	blr
-
-.Lend2:	srd	r0,r10,r6
-	std	r0,8(r7)
-	blr
-EPILOGUE(mpn_rshift)
diff --git a/ghc/rts/gmp/mpn/powerpc64/sub_n.asm b/ghc/rts/gmp/mpn/powerpc64/sub_n.asm
deleted file mode 100644
index 4de3de69c7..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/sub_n.asm
+++ /dev/null
@@ -1,61 +0,0 @@
-# PowerPC-64 mpn_sub_n -- Subtract two limb vectors of the same length > 0
-# and store difference in a third limb vector.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.b
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# s2_ptr	r5
-# size		r6
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_sub_n)
-	mtctr	r6		# copy size into CTR
-	addic	r0,r6,-1	# set cy
-	ld	r8,0(r4)	# load least significant s1 limb
-	ld	r0,0(r5)	# load least significant s2 limb
-	addi	r3,r3,-8	# offset res_ptr, it's updated before it's used
-	bdz	.Lend		# If done, skip loop
-.Loop:	ld	r9,8(r4)	# load s1 limb
-	ld	r10,8(r5)	# load s2 limb
-	subfe	r7,r0,r8	# subtract limbs with cy, set cy
-	std	r7,8(r3)	# store result limb
-	bdz	.Lexit		# decrement CTR and exit if done
-	ldu	r8,16(r4)	# load s1 limb and update s1_ptr
-	ldu	r0,16(r5)	# load s2 limb and update s2_ptr
-	subfe	r7,r10,r9	# subtract limbs with cy, set cy
-	stdu	r7,16(r3)	# store result limb and update res_ptr
-	bdnz	.Loop		# decrement CTR and loop back
-
-.Lend:	subfe	r7,r0,r8
-	std	r7,8(r3)	# store ultimate result limb
-	subfe	r3,r0,r0	# load !cy into ...
-	subfic	r3,r3,0		# ... return value register
-	blr
-.Lexit:	subfe	r7,r10,r9
-	std	r7,16(r3)
-	subfe	r3,r0,r0	# load !cy into ...
-	subfic	r3,r3,0		# ... return value register
-	blr
-EPILOGUE(mpn_sub_n)
diff --git a/ghc/rts/gmp/mpn/powerpc64/submul_1.asm b/ghc/rts/gmp/mpn/powerpc64/submul_1.asm
deleted file mode 100644
index 17f6369a38..0000000000
--- a/ghc/rts/gmp/mpn/powerpc64/submul_1.asm
+++ /dev/null
@@ -1,54 +0,0 @@
-# PowerPC-64 mpn_submul_1 -- Multiply a limb vector with a limb and subtract
-# the result from a second limb vector.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	r3
-# s1_ptr	r4
-# size		r5
-# s2_limb	r6
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_submul_1)
-	mtctr	5
-	li	9,0		# cy_limb = 0
-	addic	0,0,0
-	cal	3,-8(3)
-	cal	4,-8(4)
-.Loop:
-	ldu	0,8(4)
-	ld	10,8(3)
-	mulld	7,0,6
-	adde	7,7,9
-	mulhdu	9,0,6
-	addze	9,9
-	subfc	7,7,10
-	stdu	7,8(3)
-	subfe	11,11,11	# invert ...
-	addic	11,11,1		# ... carry
-	bdnz	.Loop
-
-	addze	3,9
-	blr
-EPILOGUE(mpn_submul_1)
diff --git a/ghc/rts/gmp/mpn/pyr/add_n.s b/ghc/rts/gmp/mpn/pyr/add_n.s
deleted file mode 100644
index e1fc535846..0000000000
--- a/ghc/rts/gmp/mpn/pyr/add_n.s
+++ /dev/null
@@ -1,76 +0,0 @@
-# Pyramid __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
-# sum in a third limb vector.
-
-# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-.text
-	.align	2
-.globl	___gmpn_add_n
-___gmpn_add_n:
-	movw	$-1,tr0		# representation for carry clear
-
-	movw	pr3,tr2
-	andw	$3,tr2
-	beq	Lend0
-	subw	tr2,pr3
-
-Loop0:	rsubw	$0,tr0		# restore carry bit from carry-save register
-
-	movw	(pr1),tr1
-	addwc	(pr2),tr1
-	movw	tr1,(pr0)
-
-	subwb	tr0,tr0
-	addw	$4,pr0
-	addw	$4,pr1
-	addw	$4,pr2
-	addw	$-1,tr2
-	bne	Loop0
-
-	mtstw	pr3,pr3
-	beq	Lend
-Lend0:
-Loop:	rsubw	$0,tr0		# restore carry bit from carry-save register
-
-	movw	(pr1),tr1
-	addwc	(pr2),tr1
-	movw	tr1,(pr0)
-
-	movw	4(pr1),tr1
-	addwc	4(pr2),tr1
-	movw	tr1,4(pr0)
-
-	movw	8(pr1),tr1
-	addwc	8(pr2),tr1
-	movw	tr1,8(pr0)
-
-	movw	12(pr1),tr1
-	addwc	12(pr2),tr1
-	movw	tr1,12(pr0)
-
-	subwb	tr0,tr0
-	addw	$16,pr0
-	addw	$16,pr1
-	addw	$16,pr2
-	addw	$-4,pr3
-	bne	Loop
-Lend:
-	mnegw	tr0,pr0
-	ret
diff --git a/ghc/rts/gmp/mpn/pyr/addmul_1.s b/ghc/rts/gmp/mpn/pyr/addmul_1.s
deleted file mode 100644
index 65c3f8f008..0000000000
--- a/ghc/rts/gmp/mpn/pyr/addmul_1.s
+++ /dev/null
@@ -1,45 +0,0 @@
-# Pyramid __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
-# the result to a second limb vector.
-
-# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-.text
-	.align	2
-.globl	___gmpn_addmul_1
-___gmpn_addmul_1:
-	mova	(pr0)[pr2*4],pr0
-	mova	(pr1)[pr2*4],pr1
-	mnegw	pr2,pr2
-	movw	$0,tr3
-
-Loop:	movw	(pr1)[pr2*4],tr1
-	uemul	pr3,tr0
-	addw	tr3,tr1
-	movw	$0,tr3
-	addwc	tr0,tr3
-	movw	(pr0)[pr2*0x4],tr0
-	addw	tr0,tr1
-	addwc	$0,tr3
-	movw	tr1,(pr0)[pr2*4]
-	addw	$1,pr2
-	bne	Loop
-
-	movw	tr3,pr0
-	ret
diff --git a/ghc/rts/gmp/mpn/pyr/mul_1.s b/ghc/rts/gmp/mpn/pyr/mul_1.s
deleted file mode 100644
index 1272297c42..0000000000
--- a/ghc/rts/gmp/mpn/pyr/mul_1.s
+++ /dev/null
@@ -1,42 +0,0 @@
-# Pyramid __gmpn_mul_1 -- Multiply a limb vector with a limb and store
-# the result in a second limb vector.
-
-# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-.text
-	.align	2
-.globl	___gmpn_mul_1
-___gmpn_mul_1:
-	mova	(pr0)[pr2*4],pr0
-	mova	(pr1)[pr2*4],pr1
-	mnegw	pr2,pr2
-	movw	$0,tr3
-
-Loop:	movw	(pr1)[pr2*4],tr1
-	uemul	pr3,tr0
-	addw	tr3,tr1
-	movw	$0,tr3
-	addwc	tr0,tr3
-	movw	tr1,(pr0)[pr2*4]
-	addw	$1,pr2
-	bne	Loop
-
-	movw	tr3,pr0
-	ret
diff --git a/ghc/rts/gmp/mpn/pyr/sub_n.s b/ghc/rts/gmp/mpn/pyr/sub_n.s
deleted file mode 100644
index 1fd2eb0f17..0000000000
--- a/ghc/rts/gmp/mpn/pyr/sub_n.s
+++ /dev/null
@@ -1,76 +0,0 @@
-# Pyramid __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
-# store difference in a third limb vector.
-
-# Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-.text
-	.align	2
-.globl	___gmpn_sub_n
-___gmpn_sub_n:
-	movw	$-1,tr0		# representation for carry clear
-
-	movw	pr3,tr2
-	andw	$3,tr2
-	beq	Lend0
-	subw	tr2,pr3
-
-Loop0:	rsubw	$0,tr0		# restore carry bit from carry-save register
-
-	movw	(pr1),tr1
-	subwb	(pr2),tr1
-	movw	tr1,(pr0)
-
-	subwb	tr0,tr0
-	addw	$4,pr0
-	addw	$4,pr1
-	addw	$4,pr2
-	addw	$-1,tr2
-	bne	Loop0
-
-	mtstw	pr3,pr3
-	beq	Lend
-Lend0:
-Loop:	rsubw	$0,tr0		# restore carry bit from carry-save register
-
-	movw	(pr1),tr1
-	subwb	(pr2),tr1
-	movw	tr1,(pr0)
-
-	movw	4(pr1),tr1
-	subwb	4(pr2),tr1
-	movw	tr1,4(pr0)
-
-	movw	8(pr1),tr1
-	subwb	8(pr2),tr1
-	movw	tr1,8(pr0)
-
-	movw	12(pr1),tr1
-	subwb	12(pr2),tr1
-	movw	tr1,12(pr0)
-
-	subwb	tr0,tr0
-	addw	$16,pr0
-	addw	$16,pr1
-	addw	$16,pr2
-	addw	$-4,pr3
-	bne	Loop
-Lend:
-	mnegw	tr0,pr0
-	ret
diff --git a/ghc/rts/gmp/mpn/sh/add_n.s b/ghc/rts/gmp/mpn/sh/add_n.s
deleted file mode 100644
index df388b31a3..0000000000
--- a/ghc/rts/gmp/mpn/sh/add_n.s
+++ /dev/null
@@ -1,47 +0,0 @@
-! SH __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
-! sum in a third limb vector.
-
-! Copyright (C) 1995, 1997, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	r4
-! s1_ptr	r5
-! s2_ptr	r6
-! size		r7
-
-	.text
-	.align 2
-	.global	___gmpn_add_n
-___gmpn_add_n:
-	mov	#0,r3		! clear cy save reg
-
-Loop:	mov.l	@r5+,r1
-	mov.l	@r6+,r2
-	shlr	r3		! restore cy
-	addc	r2,r1
-	movt	r3		! save cy
-	mov.l	r1,@r4
-	dt	r7
-	bf.s	Loop
-	 add	#4,r4
-
-	rts
-	mov	r3,r0		! return carry-out from most sign. limb
diff --git a/ghc/rts/gmp/mpn/sh/sh2/addmul_1.s b/ghc/rts/gmp/mpn/sh/sh2/addmul_1.s
deleted file mode 100644
index f34a7f0503..0000000000
--- a/ghc/rts/gmp/mpn/sh/sh2/addmul_1.s
+++ /dev/null
@@ -1,53 +0,0 @@
-! SH2 __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
-! the result to a second limb vector.
-
-! Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	r4
-! s1_ptr	r5
-! size		r6
-! s2_limb	r7
-
-	.text
-	.align 1
-	.global	___gmpn_addmul_1
-___gmpn_addmul_1:
-	mov	#0,r2		! cy_limb = 0
-	mov	#0,r0		! Keep r0 = 0 for entire loop
-	clrt
-
-Loop:	mov.l	@r5+,r3
-	dmulu.l	r3,r7
-	sts	macl,r1
-	addc	r2,r1		! lo_prod += old cy_limb
-	sts	mach,r2		! new cy_limb = hi_prod
-	mov.l	@r4,r3
-	addc	r0,r2		! cy_limb += T, T = 0
-	addc	r3,r1
-	addc	r0,r2		! cy_limb += T, T = 0
-	dt	r6
-	mov.l	r1,@r4
-	bf.s	Loop
-	add	#4,r4
-
-	rts
-	mov	r2,r0
diff --git a/ghc/rts/gmp/mpn/sh/sh2/mul_1.s b/ghc/rts/gmp/mpn/sh/sh2/mul_1.s
deleted file mode 100644
index 2a117a3175..0000000000
--- a/ghc/rts/gmp/mpn/sh/sh2/mul_1.s
+++ /dev/null
@@ -1,50 +0,0 @@
-! SH2 __gmpn_mul_1 -- Multiply a limb vector with a limb and store
-! the result in a second limb vector.
-
-! Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	r4
-! s1_ptr	r5
-! size		r6
-! s2_limb	r7
-
-	.text
-	.align 1
-	.global	___gmpn_mul_1
-___gmpn_mul_1:
-	mov	#0,r2		! cy_limb = 0
-	mov	#0,r0		! Keep r0 = 0 for entire loop
-	clrt
-
-Loop:	mov.l	@r5+,r3
-	dmulu.l	r3,r7
-	sts	macl,r1
-	addc	r2,r1
-	sts	mach,r2
-	addc	r0,r2		! propagate carry to cy_limb (dt clobbers T)
-	dt	r6
-	mov.l	r1,@r4
-	bf.s	Loop
-	add	#4,r4
-
-	rts
-	mov	r2,r0
diff --git a/ghc/rts/gmp/mpn/sh/sh2/submul_1.s b/ghc/rts/gmp/mpn/sh/sh2/submul_1.s
deleted file mode 100644
index eb9a27dde3..0000000000
--- a/ghc/rts/gmp/mpn/sh/sh2/submul_1.s
+++ /dev/null
@@ -1,53 +0,0 @@
-! SH2 __gmpn_submul_1 -- Multiply a limb vector with a limb and subtract
-! the result from a second limb vector.
-
-! Copyright (C) 1995, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	r4
-! s1_ptr	r5
-! size		r6
-! s2_limb	r7
-
-	.text
-	.align 1
-	.global	___gmpn_submul_1
-___gmpn_submul_1:
-	mov	#0,r2		! cy_limb = 0
-	mov	#0,r0		! Keep r0 = 0 for entire loop
-	clrt
-
-Loop:	mov.l	@r5+,r3
-	dmulu.l	r3,r7
-	sts	macl,r1
-	addc	r2,r1		! lo_prod += old cy_limb
-	sts	mach,r2		! new cy_limb = hi_prod
-	mov.l	@r4,r3
-	addc	r0,r2		! cy_limb += T, T = 0
-	subc	r3,r1
-	addc	r0,r2		! cy_limb += T, T = 0
-	dt	r6
-	mov.l	r1,@r4
-	bf.s	Loop
-	add	#4,r4
-
-	rts
-	mov	r2,r0
diff --git a/ghc/rts/gmp/mpn/sh/sub_n.s b/ghc/rts/gmp/mpn/sh/sub_n.s
deleted file mode 100644
index 5f818c95a8..0000000000
--- a/ghc/rts/gmp/mpn/sh/sub_n.s
+++ /dev/null
@@ -1,47 +0,0 @@
-! SH __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and store
-! difference in a third limb vector.
-
-! Copyright (C) 1995, 1997, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	r4
-! s1_ptr	r5
-! s2_ptr	r6
-! size		r7
-
-	.text
-	.align 2
-	.global	___gmpn_sub_n
-___gmpn_sub_n:
-	mov	#0,r3		! clear cy save reg
-
-Loop:	mov.l	@r5+,r1
-	mov.l	@r6+,r2
-	shlr	r3		! restore cy
-	subc	r2,r1
-	movt	r3		! save cy
-	mov.l	r1,@r4
-	dt	r7
-	bf.s	Loop
-	 add	#4,r4
-
-	rts
-	mov	r3,r0		! return carry-out from most sign. limb
diff --git a/ghc/rts/gmp/mpn/sparc32/README b/ghc/rts/gmp/mpn/sparc32/README
deleted file mode 100644
index 7c19df7bc4..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/README
+++ /dev/null
@@ -1,36 +0,0 @@
-This directory contains mpn functions for various SPARC chips.  Code that
-runs only on version 8 SPARC implementations, is in the v8 subdirectory.
-
-RELEVANT OPTIMIZATION ISSUES
-
-  Load and Store timing
-
-On most early SPARC implementations, the ST instructions takes multiple
-cycles, while a STD takes just a single cycle more than an ST.  For the CPUs
-in SPARCstation I and II, the times are 3 and 4 cycles, respectively.
-Therefore, combining two ST instrucitons into a STD when possible is a
-significant optimiation.
-
-Later SPARC implementations have single cycle ST.
-
-For SuperSPARC, we can perform just one memory instruction per cycle, even
-if up to two integer instructions can be executed in its pipeline.  For
-programs that perform so many memory operations that there are not enough
-non-memory operations to issue in parallel with all memory operations, using
-LDD and STD when possible helps.
-
-STATUS
-
-1. On a SuperSPARC, mpn_lshift and mpn_rshift run at 3 cycles/limb, or 2.5
-   cycles/limb asymptotically.  We could optimize speed for special counts
-   by using ADDXCC.
-
-2. On a SuperSPARC, mpn_add_n and mpn_sub_n runs at 2.5 cycles/limb, or 2
-   cycles/limb asymptotically.
-
-3. mpn_mul_1 runs at what is believed to be optimal speed.
-
-4. On SuperSPARC, mpn_addmul_1 and mpn_submul_1 could both be improved by a
-   cycle by avoiding one of the add instrucitons.  See a29k/addmul_1.
-
-The speed of the code for other SPARC implementations is uncertain.
diff --git a/ghc/rts/gmp/mpn/sparc32/add_n.asm b/ghc/rts/gmp/mpn/sparc32/add_n.asm
deleted file mode 100644
index 5f1d00c0e0..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/add_n.asm
+++ /dev/null
@@ -1,236 +0,0 @@
-dnl  SPARC mpn_add_n -- Add two limb vectors of the same length > 0 and store
-dnl  sum in a third limb vector.
-
-dnl  Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-define(res_ptr,%o0)
-define(s1_ptr,%o1)
-define(s2_ptr,%o2)
-define(n,%o3)
-
-ASM_START()
-PROLOGUE(mpn_add_n)
-	xor	s2_ptr,res_ptr,%g1
-	andcc	%g1,4,%g0
-	bne	L(1)			C branch if alignment differs
-	nop
-C **  V1a  **
-L(0):	andcc	res_ptr,4,%g0		C res_ptr unaligned? Side effect: cy=0
-	be	L(v1)			C if no, branch
-	nop
-C Add least significant limb separately to align res_ptr and s2_ptr
-	ld	[s1_ptr],%g4
-	add	s1_ptr,4,s1_ptr
-	ld	[s2_ptr],%g2
-	add	s2_ptr,4,s2_ptr
-	add	n,-1,n
-	addcc	%g4,%g2,%o4
-	st	%o4,[res_ptr]
-	add	res_ptr,4,res_ptr
-L(v1):	addx	%g0,%g0,%o4		C save cy in register
-	cmp	n,2			C if n < 2 ...
-	bl	L(end2)			C ... branch to tail code
-	subcc	%g0,%o4,%g0		C restore cy
-
-	ld	[s1_ptr+0],%g4
-	addcc	n,-10,n
-	ld	[s1_ptr+4],%g1
-	ldd	[s2_ptr+0],%g2
-	blt	L(fin1)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add blocks of 8 limbs until less than 8 limbs remain
-L(loop1):
-	addxcc	%g4,%g2,%o4
-	ld	[s1_ptr+8],%g4
-	addxcc	%g1,%g3,%o5
-	ld	[s1_ptr+12],%g1
-	ldd	[s2_ptr+8],%g2
-	std	%o4,[res_ptr+0]
-	addxcc	%g4,%g2,%o4
-	ld	[s1_ptr+16],%g4
-	addxcc	%g1,%g3,%o5
-	ld	[s1_ptr+20],%g1
-	ldd	[s2_ptr+16],%g2
-	std	%o4,[res_ptr+8]
-	addxcc	%g4,%g2,%o4
-	ld	[s1_ptr+24],%g4
-	addxcc	%g1,%g3,%o5
-	ld	[s1_ptr+28],%g1
-	ldd	[s2_ptr+24],%g2
-	std	%o4,[res_ptr+16]
-	addxcc	%g4,%g2,%o4
-	ld	[s1_ptr+32],%g4
-	addxcc	%g1,%g3,%o5
-	ld	[s1_ptr+36],%g1
-	ldd	[s2_ptr+32],%g2
-	std	%o4,[res_ptr+24]
-	addx	%g0,%g0,%o4		C save cy in register
-	addcc	n,-8,n
-	add	s1_ptr,32,s1_ptr
-	add	s2_ptr,32,s2_ptr
-	add	res_ptr,32,res_ptr
-	bge	L(loop1)
-	subcc	%g0,%o4,%g0		C restore cy
-
-L(fin1):
-	addcc	n,8-2,n
-	blt	L(end1)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add blocks of 2 limbs until less than 2 limbs remain
-L(loope1):
-	addxcc	%g4,%g2,%o4
-	ld	[s1_ptr+8],%g4
-	addxcc	%g1,%g3,%o5
-	ld	[s1_ptr+12],%g1
-	ldd	[s2_ptr+8],%g2
-	std	%o4,[res_ptr+0]
-	addx	%g0,%g0,%o4		C save cy in register
-	addcc	n,-2,n
-	add	s1_ptr,8,s1_ptr
-	add	s2_ptr,8,s2_ptr
-	add	res_ptr,8,res_ptr
-	bge	L(loope1)
-	subcc	%g0,%o4,%g0		C restore cy
-L(end1):
-	addxcc	%g4,%g2,%o4
-	addxcc	%g1,%g3,%o5
-	std	%o4,[res_ptr+0]
-	addx	%g0,%g0,%o4		C save cy in register
-
-	andcc	n,1,%g0
-	be	L(ret1)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add last limb
-	ld	[s1_ptr+8],%g4
-	ld	[s2_ptr+8],%g2
-	addxcc	%g4,%g2,%o4
-	st	%o4,[res_ptr+8]
-
-L(ret1):
-	retl
-	addx	%g0,%g0,%o0	C return carry-out from most sign. limb
-
-L(1):	xor	s1_ptr,res_ptr,%g1
-	andcc	%g1,4,%g0
-	bne	L(2)
-	nop
-C **  V1b  **
-	mov	s2_ptr,%g1
-	mov	s1_ptr,s2_ptr
-	b	L(0)
-	mov	%g1,s1_ptr
-
-C **  V2  **
-C If we come here, the alignment of s1_ptr and res_ptr as well as the
-C alignment of s2_ptr and res_ptr differ.  Since there are only two ways
-C things can be aligned (that we care about) we now know that the alignment
-C of s1_ptr and s2_ptr are the same.
-
-L(2):	cmp	n,1
-	be	L(jone)
-	nop
-	andcc	s1_ptr,4,%g0		C s1_ptr unaligned? Side effect: cy=0
-	be	L(v2)			C if no, branch
-	nop
-C Add least significant limb separately to align s1_ptr and s2_ptr
-	ld	[s1_ptr],%g4
-	add	s1_ptr,4,s1_ptr
-	ld	[s2_ptr],%g2
-	add	s2_ptr,4,s2_ptr
-	add	n,-1,n
-	addcc	%g4,%g2,%o4
-	st	%o4,[res_ptr]
-	add	res_ptr,4,res_ptr
-
-L(v2):	addx	%g0,%g0,%o4		C save cy in register
-	addcc	n,-8,n
-	blt	L(fin2)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add blocks of 8 limbs until less than 8 limbs remain
-L(loop2):
-	ldd	[s1_ptr+0],%g2
-	ldd	[s2_ptr+0],%o4
-	addxcc	%g2,%o4,%g2
-	st	%g2,[res_ptr+0]
-	addxcc	%g3,%o5,%g3
-	st	%g3,[res_ptr+4]
-	ldd	[s1_ptr+8],%g2
-	ldd	[s2_ptr+8],%o4
-	addxcc	%g2,%o4,%g2
-	st	%g2,[res_ptr+8]
-	addxcc	%g3,%o5,%g3
-	st	%g3,[res_ptr+12]
-	ldd	[s1_ptr+16],%g2
-	ldd	[s2_ptr+16],%o4
-	addxcc	%g2,%o4,%g2
-	st	%g2,[res_ptr+16]
-	addxcc	%g3,%o5,%g3
-	st	%g3,[res_ptr+20]
-	ldd	[s1_ptr+24],%g2
-	ldd	[s2_ptr+24],%o4
-	addxcc	%g2,%o4,%g2
-	st	%g2,[res_ptr+24]
-	addxcc	%g3,%o5,%g3
-	st	%g3,[res_ptr+28]
-	addx	%g0,%g0,%o4		C save cy in register
-	addcc	n,-8,n
-	add	s1_ptr,32,s1_ptr
-	add	s2_ptr,32,s2_ptr
-	add	res_ptr,32,res_ptr
-	bge	L(loop2)
-	subcc	%g0,%o4,%g0		C restore cy
-
-L(fin2):
-	addcc	n,8-2,n
-	blt	L(end2)
-	subcc	%g0,%o4,%g0		C restore cy
-L(loope2):
-	ldd	[s1_ptr+0],%g2
-	ldd	[s2_ptr+0],%o4
-	addxcc	%g2,%o4,%g2
-	st	%g2,[res_ptr+0]
-	addxcc	%g3,%o5,%g3
-	st	%g3,[res_ptr+4]
-	addx	%g0,%g0,%o4		C save cy in register
-	addcc	n,-2,n
-	add	s1_ptr,8,s1_ptr
-	add	s2_ptr,8,s2_ptr
-	add	res_ptr,8,res_ptr
-	bge	L(loope2)
-	subcc	%g0,%o4,%g0		C restore cy
-L(end2):
-	andcc	n,1,%g0
-	be	L(ret2)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add last limb
-L(jone):
-	ld	[s1_ptr],%g4
-	ld	[s2_ptr],%g2
-	addxcc	%g4,%g2,%o4
-	st	%o4,[res_ptr]
-
-L(ret2):
-	retl
-	addx	%g0,%g0,%o0	C return carry-out from most sign. limb
-EPILOGUE(mpn_add_n)
diff --git a/ghc/rts/gmp/mpn/sparc32/addmul_1.asm b/ghc/rts/gmp/mpn/sparc32/addmul_1.asm
deleted file mode 100644
index 80c94e4251..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/addmul_1.asm
+++ /dev/null
@@ -1,146 +0,0 @@
-dnl  SPARC mpn_addmul_1 -- Multiply a limb vector with a limb and add the
-dnl  result to a second limb vector.
-
-dnl  Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	o0
-C s1_ptr	o1
-C size		o2
-C s2_limb	o3
-
-ASM_START()
-PROLOGUE(mpn_addmul_1)
-	C Make S1_PTR and RES_PTR point at the end of their blocks
-	C and put (- 4 x SIZE) in index/loop counter.
-	sll	%o2,2,%o2
-	add	%o0,%o2,%o4	C RES_PTR in o4 since o0 is retval
-	add	%o1,%o2,%o1
-	sub	%g0,%o2,%o2
-
-	cmp	%o3,0xfff
-	bgu	L(large)
-	nop
-
-	ld	[%o1+%o2],%o5
-	mov	0,%o0
-	b	L(0)
-	 add	%o4,-4,%o4
-L(loop0):
-	addcc	%o5,%g1,%g1
-	ld	[%o1+%o2],%o5
-	addx	%o0,%g0,%o0
-	st	%g1,[%o4+%o2]
-L(0):	wr	%g0,%o3,%y
-	sra	%o5,31,%g2
-	and	%o3,%g2,%g2
-	andcc	%g1,0,%g1
-	mulscc	%g1,%o5,%g1
- 	mulscc	%g1,%o5,%g1
- 	mulscc	%g1,%o5,%g1
- 	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,0,%g1
-	sra	%g1,20,%g4
-	sll	%g1,12,%g1
- 	rd	%y,%g3
-	srl	%g3,20,%g3
-	or	%g1,%g3,%g1
-
-	addcc	%g1,%o0,%g1
-	addx	%g2,%g4,%o0	C add sign-compensation and cy to hi limb
-	addcc	%o2,4,%o2	C loop counter
-	bne	L(loop0)
-	 ld	[%o4+%o2],%o5
-
-	addcc	%o5,%g1,%g1
-	addx	%o0,%g0,%o0
-	retl
-	st	%g1,[%o4+%o2]
-
-L(large):
-	ld	[%o1+%o2],%o5
-	mov	0,%o0
-	sra	%o3,31,%g4	C g4 = mask of ones iff S2_LIMB < 0
-	b	L(1)
-	 add	%o4,-4,%o4
-L(loop):
-	addcc	%o5,%g3,%g3
-	ld	[%o1+%o2],%o5
-	addx	%o0,%g0,%o0
-	st	%g3,[%o4+%o2]
-L(1):	wr	%g0,%o5,%y
-	and	%o5,%g4,%g2
-	andcc	%g0,%g0,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%g0,%g1
-	rd	%y,%g3
-	addcc	%g3,%o0,%g3
-	addx	%g2,%g1,%o0
-	addcc	%o2,4,%o2
-	bne	L(loop)
-	 ld	[%o4+%o2],%o5
-
-	addcc	%o5,%g3,%g3
-	addx	%o0,%g0,%o0
-	retl
-	st	%g3,[%o4+%o2]
-EPILOGUE(mpn_addmul_1)
diff --git a/ghc/rts/gmp/mpn/sparc32/lshift.asm b/ghc/rts/gmp/mpn/sparc32/lshift.asm
deleted file mode 100644
index 529733ac2d..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/lshift.asm
+++ /dev/null
@@ -1,97 +0,0 @@
-dnl  SPARC mpn_lshift -- Shift a number left.
-dnl  
-
-dnl  Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	%o0
-C src_ptr	%o1
-C size		%o2
-C cnt		%o3
-
-ASM_START()
-PROLOGUE(mpn_lshift)
-	sll	%o2,2,%g1
-	add	%o1,%g1,%o1	C make %o1 point at end of src
-	ld	[%o1-4],%g2	C load first limb
-	sub	%g0,%o3,%o5	C negate shift count
-	add	%o0,%g1,%o0	C make %o0 point at end of res
-	add	%o2,-1,%o2
-	andcc	%o2,4-1,%g4	C number of limbs in first loop
-	srl	%g2,%o5,%g1	C compute function result
-	be	L(0)		C if multiple of 4 limbs, skip first loop
-	st	%g1,[%sp+80]
-
-	sub	%o2,%g4,%o2	C adjust count for main loop
-
-L(loop0):
-	ld	[%o1-8],%g3
-	add	%o0,-4,%o0
-	add	%o1,-4,%o1
-	addcc	%g4,-1,%g4
-	sll	%g2,%o3,%o4
-	srl	%g3,%o5,%g1
-	mov	%g3,%g2
-	or	%o4,%g1,%o4
-	bne	L(loop0)
-	 st	%o4,[%o0+0]
-
-L(0):	tst	%o2
-	be	L(end)
-	 nop
-
-L(loop):
-	ld	[%o1-8],%g3
-	add	%o0,-16,%o0
-	addcc	%o2,-4,%o2
-	sll	%g2,%o3,%o4
-	srl	%g3,%o5,%g1
-
-	ld	[%o1-12],%g2
-	sll	%g3,%o3,%g4
-	or	%o4,%g1,%o4
-	st	%o4,[%o0+12]
-	srl	%g2,%o5,%g1
-
-	ld	[%o1-16],%g3
-	sll	%g2,%o3,%o4
-	or	%g4,%g1,%g4
-	st	%g4,[%o0+8]
-	srl	%g3,%o5,%g1
-
-	ld	[%o1-20],%g2
-	sll	%g3,%o3,%g4
-	or	%o4,%g1,%o4
-	st	%o4,[%o0+4]
-	srl	%g2,%o5,%g1
-
-	add	%o1,-16,%o1
-	or	%g4,%g1,%g4
-	bne	L(loop)
-	 st	%g4,[%o0+0]
-
-L(end):	sll	%g2,%o3,%g2
-	st	%g2,[%o0-4]
-	retl
-	ld	[%sp+80],%o0
-EPILOGUE(mpn_lshift)
diff --git a/ghc/rts/gmp/mpn/sparc32/mul_1.asm b/ghc/rts/gmp/mpn/sparc32/mul_1.asm
deleted file mode 100644
index e5fedeabaa..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/mul_1.asm
+++ /dev/null
@@ -1,137 +0,0 @@
-dnl  SPARC mpn_mul_1 -- Multiply a limb vector with a limb and store
-dnl  the result in a second limb vector.
-
-dnl  Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	o0
-C s1_ptr	o1
-C size		o2
-C s2_limb	o3
-
-ASM_START()
-PROLOGUE(mpn_mul_1)
-	C Make S1_PTR and RES_PTR point at the end of their blocks
-	C and put (- 4 x SIZE) in index/loop counter.
-	sll	%o2,2,%o2
-	add	%o0,%o2,%o4	C RES_PTR in o4 since o0 is retval
-	add	%o1,%o2,%o1
-	sub	%g0,%o2,%o2
-
-	cmp	%o3,0xfff
-	bgu	L(large)
-	nop
-
-	ld	[%o1+%o2],%o5
-	mov	0,%o0
-	b	L(0)
-	 add	%o4,-4,%o4
-L(loop0):
-	st	%g1,[%o4+%o2]
-L(0):	wr	%g0,%o3,%y
-	sra	%o5,31,%g2
-	and	%o3,%g2,%g2
-	andcc	%g1,0,%g1
-	mulscc	%g1,%o5,%g1
- 	mulscc	%g1,%o5,%g1
- 	mulscc	%g1,%o5,%g1
- 	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,0,%g1
-	sra	%g1,20,%g4
-	sll	%g1,12,%g1
- 	rd	%y,%g3
-	srl	%g3,20,%g3
-	or	%g1,%g3,%g1
-
-	addcc	%g1,%o0,%g1
-	addx	%g2,%g4,%o0	C add sign-compensation and cy to hi limb
-	addcc	%o2,4,%o2	C loop counter
-	bne,a	L(loop0)
-	 ld	[%o1+%o2],%o5
-
-	retl
-	st	%g1,[%o4+%o2]
-
-
-L(large):
-	ld	[%o1+%o2],%o5
-	mov	0,%o0
-	sra	%o3,31,%g4	C g4 = mask of ones iff S2_LIMB < 0
-	b	L(1)
-	 add	%o4,-4,%o4
-L(loop):
-	st	%g3,[%o4+%o2]
-L(1):	wr	%g0,%o5,%y
-	and	%o5,%g4,%g2	C g2 = S1_LIMB iff S2_LIMB < 0, else 0
-	andcc	%g0,%g0,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%g0,%g1
-	rd	%y,%g3
-	addcc	%g3,%o0,%g3
-	addx	%g2,%g1,%o0	C add sign-compensation and cy to hi limb
-	addcc	%o2,4,%o2	C loop counter
-	bne,a	L(loop)
-	 ld	[%o1+%o2],%o5
-
-	retl
-	st	%g3,[%o4+%o2]
-EPILOGUE(mpn_mul_1)
diff --git a/ghc/rts/gmp/mpn/sparc32/rshift.asm b/ghc/rts/gmp/mpn/sparc32/rshift.asm
deleted file mode 100644
index 9187dbaa6f..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/rshift.asm
+++ /dev/null
@@ -1,93 +0,0 @@
-dnl  SPARC mpn_rshift -- Shift a number right.
-
-dnl  Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	%o0
-C src_ptr	%o1
-C size		%o2
-C cnt		%o3
-
-ASM_START()
-PROLOGUE(mpn_rshift)
-	ld	[%o1],%g2	C load first limb
-	sub	%g0,%o3,%o5	C negate shift count
-	add	%o2,-1,%o2
-	andcc	%o2,4-1,%g4	C number of limbs in first loop
-	sll	%g2,%o5,%g1	C compute function result
-	be	L(0)		C if multiple of 4 limbs, skip first loop
-	st	%g1,[%sp+80]
-
-	sub	%o2,%g4,%o2	C adjust count for main loop
-
-L(loop0):
-	ld	[%o1+4],%g3
-	add	%o0,4,%o0
-	add	%o1,4,%o1
-	addcc	%g4,-1,%g4
-	srl	%g2,%o3,%o4
-	sll	%g3,%o5,%g1
-	mov	%g3,%g2
-	or	%o4,%g1,%o4
-	bne	L(loop0)
-	 st	%o4,[%o0-4]
-
-L(0):	tst	%o2
-	be	L(end)
-	 nop
-
-L(loop):
-	ld	[%o1+4],%g3
-	add	%o0,16,%o0
-	addcc	%o2,-4,%o2
-	srl	%g2,%o3,%o4
-	sll	%g3,%o5,%g1
-
-	ld	[%o1+8],%g2
-	srl	%g3,%o3,%g4
-	or	%o4,%g1,%o4
-	st	%o4,[%o0-16]
-	sll	%g2,%o5,%g1
-
-	ld	[%o1+12],%g3
-	srl	%g2,%o3,%o4
-	or	%g4,%g1,%g4
-	st	%g4,[%o0-12]
-	sll	%g3,%o5,%g1
-
-	ld	[%o1+16],%g2
-	srl	%g3,%o3,%g4
-	or	%o4,%g1,%o4
-	st	%o4,[%o0-8]
-	sll	%g2,%o5,%g1
-
-	add	%o1,16,%o1
-	or	%g4,%g1,%g4
-	bne	L(loop)
-	 st	%g4,[%o0-4]
-
-L(end):	srl	%g2,%o3,%g2
-	st	%g2,[%o0-0]
-	retl
-	ld	[%sp+80],%o0
-EPILOGUE(mpn_rshift)
diff --git a/ghc/rts/gmp/mpn/sparc32/sub_n.asm b/ghc/rts/gmp/mpn/sparc32/sub_n.asm
deleted file mode 100644
index 071909a1b6..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/sub_n.asm
+++ /dev/null
@@ -1,326 +0,0 @@
-dnl  SPARC mpn_sub_n -- Subtract two limb vectors of the same length > 0 and
-dnl  store difference in a third limb vector.
-
-dnl  Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-define(res_ptr,%o0)
-define(s1_ptr,%o1)
-define(s2_ptr,%o2)
-define(n,%o3)
-
-ASM_START()
-PROLOGUE(mpn_sub_n)
-	xor	s2_ptr,res_ptr,%g1
-	andcc	%g1,4,%g0
-	bne	L(1)			C branch if alignment differs
-	nop
-C **  V1a  **
-	andcc	res_ptr,4,%g0		C res_ptr unaligned? Side effect: cy=0
-	be	L(v1)			C if no, branch
-	nop
-C Add least significant limb separately to align res_ptr and s2_ptr
-	ld	[s1_ptr],%g4
-	add	s1_ptr,4,s1_ptr
-	ld	[s2_ptr],%g2
-	add	s2_ptr,4,s2_ptr
-	add	n,-1,n
-	subcc	%g4,%g2,%o4
-	st	%o4,[res_ptr]
-	add	res_ptr,4,res_ptr
-L(v1):	addx	%g0,%g0,%o4		C save cy in register
-	cmp	n,2			C if n < 2 ...
-	bl	L(end2)			C ... branch to tail code
-	subcc	%g0,%o4,%g0		C restore cy
-
-	ld	[s1_ptr+0],%g4
-	addcc	n,-10,n
-	ld	[s1_ptr+4],%g1
-	ldd	[s2_ptr+0],%g2
-	blt	L(fin1)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add blocks of 8 limbs until less than 8 limbs remain
-L(loop1):
-	subxcc	%g4,%g2,%o4
-	ld	[s1_ptr+8],%g4
-	subxcc	%g1,%g3,%o5
-	ld	[s1_ptr+12],%g1
-	ldd	[s2_ptr+8],%g2
-	std	%o4,[res_ptr+0]
-	subxcc	%g4,%g2,%o4
-	ld	[s1_ptr+16],%g4
-	subxcc	%g1,%g3,%o5
-	ld	[s1_ptr+20],%g1
-	ldd	[s2_ptr+16],%g2
-	std	%o4,[res_ptr+8]
-	subxcc	%g4,%g2,%o4
-	ld	[s1_ptr+24],%g4
-	subxcc	%g1,%g3,%o5
-	ld	[s1_ptr+28],%g1
-	ldd	[s2_ptr+24],%g2
-	std	%o4,[res_ptr+16]
-	subxcc	%g4,%g2,%o4
-	ld	[s1_ptr+32],%g4
-	subxcc	%g1,%g3,%o5
-	ld	[s1_ptr+36],%g1
-	ldd	[s2_ptr+32],%g2
-	std	%o4,[res_ptr+24]
-	addx	%g0,%g0,%o4		C save cy in register
-	addcc	n,-8,n
-	add	s1_ptr,32,s1_ptr
-	add	s2_ptr,32,s2_ptr
-	add	res_ptr,32,res_ptr
-	bge	L(loop1)
-	subcc	%g0,%o4,%g0		C restore cy
-
-L(fin1):
-	addcc	n,8-2,n
-	blt	L(end1)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add blocks of 2 limbs until less than 2 limbs remain
-L(loope1):
-	subxcc	%g4,%g2,%o4
-	ld	[s1_ptr+8],%g4
-	subxcc	%g1,%g3,%o5
-	ld	[s1_ptr+12],%g1
-	ldd	[s2_ptr+8],%g2
-	std	%o4,[res_ptr+0]
-	addx	%g0,%g0,%o4		C save cy in register
-	addcc	n,-2,n
-	add	s1_ptr,8,s1_ptr
-	add	s2_ptr,8,s2_ptr
-	add	res_ptr,8,res_ptr
-	bge	L(loope1)
-	subcc	%g0,%o4,%g0		C restore cy
-L(end1):
-	subxcc	%g4,%g2,%o4
-	subxcc	%g1,%g3,%o5
-	std	%o4,[res_ptr+0]
-	addx	%g0,%g0,%o4		C save cy in register
-
-	andcc	n,1,%g0
-	be	L(ret1)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add last limb
-	ld	[s1_ptr+8],%g4
-	ld	[s2_ptr+8],%g2
-	subxcc	%g4,%g2,%o4
-	st	%o4,[res_ptr+8]
-
-L(ret1):
-	retl
-	addx	%g0,%g0,%o0	C return carry-out from most sign. limb
-
-L(1):	xor	s1_ptr,res_ptr,%g1
-	andcc	%g1,4,%g0
-	bne	L(2)
-	nop
-C **  V1b  **
-	andcc	res_ptr,4,%g0		C res_ptr unaligned? Side effect: cy=0
-	be	L(v1b)			C if no, branch
-	nop
-C Add least significant limb separately to align res_ptr and s1_ptr
-	ld	[s2_ptr],%g4
-	add	s2_ptr,4,s2_ptr
-	ld	[s1_ptr],%g2
-	add	s1_ptr,4,s1_ptr
-	add	n,-1,n
-	subcc	%g2,%g4,%o4
-	st	%o4,[res_ptr]
-	add	res_ptr,4,res_ptr
-L(v1b):	addx	%g0,%g0,%o4		C save cy in register
-	cmp	n,2			C if n < 2 ...
-	bl	L(end2)			C ... branch to tail code
-	subcc	%g0,%o4,%g0		C restore cy
-
-	ld	[s2_ptr+0],%g4
-	addcc	n,-10,n
-	ld	[s2_ptr+4],%g1
-	ldd	[s1_ptr+0],%g2
-	blt	L(fin1b)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add blocks of 8 limbs until less than 8 limbs remain
-L(loop1b):
-	subxcc	%g2,%g4,%o4
-	ld	[s2_ptr+8],%g4
-	subxcc	%g3,%g1,%o5
-	ld	[s2_ptr+12],%g1
-	ldd	[s1_ptr+8],%g2
-	std	%o4,[res_ptr+0]
-	subxcc	%g2,%g4,%o4
-	ld	[s2_ptr+16],%g4
-	subxcc	%g3,%g1,%o5
-	ld	[s2_ptr+20],%g1
-	ldd	[s1_ptr+16],%g2
-	std	%o4,[res_ptr+8]
-	subxcc	%g2,%g4,%o4
-	ld	[s2_ptr+24],%g4
-	subxcc	%g3,%g1,%o5
-	ld	[s2_ptr+28],%g1
-	ldd	[s1_ptr+24],%g2
-	std	%o4,[res_ptr+16]
-	subxcc	%g2,%g4,%o4
-	ld	[s2_ptr+32],%g4
-	subxcc	%g3,%g1,%o5
-	ld	[s2_ptr+36],%g1
-	ldd	[s1_ptr+32],%g2
-	std	%o4,[res_ptr+24]
-	addx	%g0,%g0,%o4		C save cy in register
-	addcc	n,-8,n
-	add	s1_ptr,32,s1_ptr
-	add	s2_ptr,32,s2_ptr
-	add	res_ptr,32,res_ptr
-	bge	L(loop1b)
-	subcc	%g0,%o4,%g0		C restore cy
-
-L(fin1b):
-	addcc	n,8-2,n
-	blt	L(end1b)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add blocks of 2 limbs until less than 2 limbs remain
-L(loope1b):
-	subxcc	%g2,%g4,%o4
-	ld	[s2_ptr+8],%g4
-	subxcc	%g3,%g1,%o5
-	ld	[s2_ptr+12],%g1
-	ldd	[s1_ptr+8],%g2
-	std	%o4,[res_ptr+0]
-	addx	%g0,%g0,%o4		C save cy in register
-	addcc	n,-2,n
-	add	s1_ptr,8,s1_ptr
-	add	s2_ptr,8,s2_ptr
-	add	res_ptr,8,res_ptr
-	bge	L(loope1b)
-	subcc	%g0,%o4,%g0		C restore cy
-L(end1b):
-	subxcc	%g2,%g4,%o4
-	subxcc	%g3,%g1,%o5
-	std	%o4,[res_ptr+0]
-	addx	%g0,%g0,%o4		C save cy in register
-
-	andcc	n,1,%g0
-	be	L(ret1b)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add last limb
-	ld	[s2_ptr+8],%g4
-	ld	[s1_ptr+8],%g2
-	subxcc	%g2,%g4,%o4
-	st	%o4,[res_ptr+8]
-
-L(ret1b):
-	retl
-	addx	%g0,%g0,%o0		C return carry-out from most sign. limb
-
-C **  V2  **
-C If we come here, the alignment of s1_ptr and res_ptr as well as the
-C alignment of s2_ptr and res_ptr differ.  Since there are only two ways
-C things can be aligned (that we care about) we now know that the alignment
-C of s1_ptr and s2_ptr are the same.
-
-L(2):	cmp	n,1
-	be	L(jone)
-	nop
-	andcc	s1_ptr,4,%g0		C s1_ptr unaligned? Side effect: cy=0
-	be	L(v2)			C if no, branch
-	nop
-C Add least significant limb separately to align s1_ptr and s2_ptr
-	ld	[s1_ptr],%g4
-	add	s1_ptr,4,s1_ptr
-	ld	[s2_ptr],%g2
-	add	s2_ptr,4,s2_ptr
-	add	n,-1,n
-	subcc	%g4,%g2,%o4
-	st	%o4,[res_ptr]
-	add	res_ptr,4,res_ptr
-
-L(v2):	addx	%g0,%g0,%o4		C save cy in register
-	addcc	n,-8,n
-	blt	L(fin2)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add blocks of 8 limbs until less than 8 limbs remain
-L(loop2):
-	ldd	[s1_ptr+0],%g2
-	ldd	[s2_ptr+0],%o4
-	subxcc	%g2,%o4,%g2
-	st	%g2,[res_ptr+0]
-	subxcc	%g3,%o5,%g3
-	st	%g3,[res_ptr+4]
-	ldd	[s1_ptr+8],%g2
-	ldd	[s2_ptr+8],%o4
-	subxcc	%g2,%o4,%g2
-	st	%g2,[res_ptr+8]
-	subxcc	%g3,%o5,%g3
-	st	%g3,[res_ptr+12]
-	ldd	[s1_ptr+16],%g2
-	ldd	[s2_ptr+16],%o4
-	subxcc	%g2,%o4,%g2
-	st	%g2,[res_ptr+16]
-	subxcc	%g3,%o5,%g3
-	st	%g3,[res_ptr+20]
-	ldd	[s1_ptr+24],%g2
-	ldd	[s2_ptr+24],%o4
-	subxcc	%g2,%o4,%g2
-	st	%g2,[res_ptr+24]
-	subxcc	%g3,%o5,%g3
-	st	%g3,[res_ptr+28]
-	addx	%g0,%g0,%o4		C save cy in register
-	addcc	n,-8,n
-	add	s1_ptr,32,s1_ptr
-	add	s2_ptr,32,s2_ptr
-	add	res_ptr,32,res_ptr
-	bge	L(loop2)
-	subcc	%g0,%o4,%g0		C restore cy
-
-L(fin2):
-	addcc	n,8-2,n
-	blt	L(end2)
-	subcc	%g0,%o4,%g0		C restore cy
-L(loope2):
-	ldd	[s1_ptr+0],%g2
-	ldd	[s2_ptr+0],%o4
-	subxcc	%g2,%o4,%g2
-	st	%g2,[res_ptr+0]
-	subxcc	%g3,%o5,%g3
-	st	%g3,[res_ptr+4]
-	addx	%g0,%g0,%o4		C save cy in register
-	addcc	n,-2,n
-	add	s1_ptr,8,s1_ptr
-	add	s2_ptr,8,s2_ptr
-	add	res_ptr,8,res_ptr
-	bge	L(loope2)
-	subcc	%g0,%o4,%g0		C restore cy
-L(end2):
-	andcc	n,1,%g0
-	be	L(ret2)
-	subcc	%g0,%o4,%g0		C restore cy
-C Add last limb
-L(jone):
-	ld	[s1_ptr],%g4
-	ld	[s2_ptr],%g2
-	subxcc	%g4,%g2,%o4
-	st	%o4,[res_ptr]
-
-L(ret2):
-	retl
-	addx	%g0,%g0,%o0		C return carry-out from most sign. limb
-EPILOGUE(mpn_sub_n)
diff --git a/ghc/rts/gmp/mpn/sparc32/submul_1.asm b/ghc/rts/gmp/mpn/sparc32/submul_1.asm
deleted file mode 100644
index 12abd844ce..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/submul_1.asm
+++ /dev/null
@@ -1,146 +0,0 @@
-dnl  SPARC mpn_submul_1 -- Multiply a limb vector with a limb and subtract
-dnl  the result from a second limb vector.
-
-dnl  Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	o0
-C s1_ptr	o1
-C size		o2
-C s2_limb	o3
-
-ASM_START()
-PROLOGUE(mpn_submul_1)
-	C Make S1_PTR and RES_PTR point at the end of their blocks
-	C and put (- 4 x SIZE) in index/loop counter.
-	sll	%o2,2,%o2
-	add	%o0,%o2,%o4	C RES_PTR in o4 since o0 is retval
-	add	%o1,%o2,%o1
-	sub	%g0,%o2,%o2
-
-	cmp	%o3,0xfff
-	bgu	L(large)
-	nop
-
-	ld	[%o1+%o2],%o5
-	mov	0,%o0
-	b	L(0)
-	 add	%o4,-4,%o4
-L(loop0):
-	subcc	%o5,%g1,%g1
-	ld	[%o1+%o2],%o5
-	addx	%o0,%g0,%o0
-	st	%g1,[%o4+%o2]
-L(0):	wr	%g0,%o3,%y
-	sra	%o5,31,%g2
-	and	%o3,%g2,%g2
-	andcc	%g1,0,%g1
-	mulscc	%g1,%o5,%g1
- 	mulscc	%g1,%o5,%g1
- 	mulscc	%g1,%o5,%g1
- 	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,%o5,%g1
-	mulscc	%g1,0,%g1
-	sra	%g1,20,%g4
-	sll	%g1,12,%g1
- 	rd	%y,%g3
-	srl	%g3,20,%g3
-	or	%g1,%g3,%g1
-
-	addcc	%g1,%o0,%g1
-	addx	%g2,%g4,%o0	C add sign-compensation and cy to hi limb
-	addcc	%o2,4,%o2	C loop counter
-	bne	L(loop0)
-	 ld	[%o4+%o2],%o5
-
-	subcc	%o5,%g1,%g1
-	addx	%o0,%g0,%o0
-	retl
-	st	%g1,[%o4+%o2]
-
-L(large):
-	ld	[%o1+%o2],%o5
-	mov	0,%o0
-	sra	%o3,31,%g4	C g4 = mask of ones iff S2_LIMB < 0
-	b	L(1)
-	 add	%o4,-4,%o4
-L(loop):
-	subcc	%o5,%g3,%g3
-	ld	[%o1+%o2],%o5
-	addx	%o0,%g0,%o0
-	st	%g3,[%o4+%o2]
-L(1):	wr	%g0,%o5,%y
-	and	%o5,%g4,%g2
-	andcc	%g0,%g0,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%o3,%g1
-	mulscc	%g1,%g0,%g1
-	rd	%y,%g3
-	addcc	%g3,%o0,%g3
-	addx	%g2,%g1,%o0
-	addcc	%o2,4,%o2
-	bne	L(loop)
-	 ld	[%o4+%o2],%o5
-
-	subcc	%o5,%g3,%g3
-	addx	%o0,%g0,%o0
-	retl
-	st	%g3,[%o4+%o2]
-EPILOGUE(mpn_submul_1)
diff --git a/ghc/rts/gmp/mpn/sparc32/udiv_fp.asm b/ghc/rts/gmp/mpn/sparc32/udiv_fp.asm
deleted file mode 100644
index e340e147d2..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/udiv_fp.asm
+++ /dev/null
@@ -1,158 +0,0 @@
-dnl  SPARC v7 __udiv_qrnnd division support, used from longlong.h.
-dnl  This is for v7 CPUs with a floating-point unit.
-
-dnl  Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C rem_ptr	i0
-C n1		i1
-C n0		i2
-C d		i3
-
-ASM_START()
-
-ifdef(`PIC',
-`	TEXT
-L(getpc):
-	retl
-	nop')
-
-	TEXT
-	ALIGN(8)
-L(C0):	.double	0r4294967296
-L(C1):	.double	0r2147483648
-
-PROLOGUE(mpn_udiv_qrnnd)
-	save	%sp,-104,%sp
-	st	%i1,[%fp-8]
-	ld	[%fp-8],%f10
-
-ifdef(`PIC',
-`L(pc):	call	L(getpc)		C put address of this insn in %o7
-	ldd	[%o7+L(C0)-L(pc)],%f8',
-`	sethi	%hi(L(C0)),%o7
-	ldd	[%o7+%lo(L(C0))],%f8')
-
-	fitod	%f10,%f4
-	cmp	%i1,0
-	bge	L(248)
-	mov	%i0,%i5
-	faddd	%f4,%f8,%f4
-L(248):
-	st	%i2,[%fp-8]
-	ld	[%fp-8],%f10
-	fmuld	%f4,%f8,%f6
-	cmp	%i2,0
-	bge	L(249)
-	fitod	%f10,%f2
-	faddd	%f2,%f8,%f2
-L(249):
-	st	%i3,[%fp-8]
-	faddd	%f6,%f2,%f2
-	ld	[%fp-8],%f10
-	cmp	%i3,0
-	bge	L(250)
-	fitod	%f10,%f4
-	faddd	%f4,%f8,%f4
-L(250):
-	fdivd	%f2,%f4,%f2
-
-ifdef(`PIC',
-`	ldd	[%o7+L(C1)-L(pc)],%f4',
-`	sethi	%hi(L(C1)),%o7
-	ldd	[%o7+%lo(L(C1))],%f4')
-
-	fcmped	%f2,%f4
-	nop
-	fbge,a	L(251)
-	fsubd	%f2,%f4,%f2
-	fdtoi	%f2,%f2
-	st	%f2,[%fp-8]
-	b	L(252)
-	ld	[%fp-8],%i4
-L(251):
-	fdtoi	%f2,%f2
-	st	%f2,[%fp-8]
-	ld	[%fp-8],%i4
-	sethi	%hi(-2147483648),%g2
-	xor	%i4,%g2,%i4
-L(252):
-	wr	%g0,%i4,%y
-	sra	%i3,31,%g2
-	and	%i4,%g2,%g2
-	andcc	%g0,0,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,%i3,%g1
-	mulscc	%g1,0,%g1
-	add	%g1,%g2,%i0
-	rd	%y,%g3
-	subcc	%i2,%g3,%o7
-	subxcc	%i1,%i0,%g0
-	be	L(253)
-	cmp	%o7,%i3
-
-	add	%i4,-1,%i0
-	add	%o7,%i3,%o7
-	st	%o7,[%i5]
-	ret
-	restore
-L(253):
-	blu	L(246)
-	mov	%i4,%i0
-	add	%i4,1,%i0
-	sub	%o7,%i3,%o7
-L(246):
-	st	%o7,[%i5]
-	ret
-	restore
-EPILOGUE(mpn_udiv_qrnnd)
diff --git a/ghc/rts/gmp/mpn/sparc32/udiv_nfp.asm b/ghc/rts/gmp/mpn/sparc32/udiv_nfp.asm
deleted file mode 100644
index ae19f4c6e9..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/udiv_nfp.asm
+++ /dev/null
@@ -1,193 +0,0 @@
-dnl  SPARC v7 __udiv_qrnnd division support, used from longlong.h.
-dnl  This is for v7 CPUs without a floating-point unit.
-
-dnl  Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
- 
-C INPUT PARAMETERS
-C rem_ptr	o0
-C n1		o1
-C n0		o2
-C d		o3
-
-ASM_START()
-PROLOGUE(mpn_udiv_qrnnd)
-	tst	%o3
-	bneg	L(largedivisor)
-	mov	8,%g1
-
-	b	L(p1)
-	addxcc	%o2,%o2,%o2
-
-L(plop):
-	bcc	L(n1)
-	addxcc	%o2,%o2,%o2
-L(p1):	addx	%o1,%o1,%o1
-	subcc	%o1,%o3,%o4
-	bcc	L(n2)
-	addxcc	%o2,%o2,%o2
-L(p2):	addx	%o1,%o1,%o1
-	subcc	%o1,%o3,%o4
-	bcc	L(n3)
-	addxcc	%o2,%o2,%o2
-L(p3):	addx	%o1,%o1,%o1
-	subcc	%o1,%o3,%o4
-	bcc	L(n4)
-	addxcc	%o2,%o2,%o2
-L(p4):	addx	%o1,%o1,%o1
-	addcc	%g1,-1,%g1
-	bne	L(plop)
-	subcc	%o1,%o3,%o4
-	bcc	L(n5)
-	addxcc	%o2,%o2,%o2
-L(p5):	st	%o1,[%o0]
-	retl
-	xnor	%g0,%o2,%o0
-
-L(nlop):
-	bcc	L(p1)
-	addxcc	%o2,%o2,%o2
-L(n1):	addx	%o4,%o4,%o4
-	subcc	%o4,%o3,%o1
-	bcc	L(p2)
-	addxcc	%o2,%o2,%o2
-L(n2):	addx	%o4,%o4,%o4
-	subcc	%o4,%o3,%o1
-	bcc	L(p3)
-	addxcc	%o2,%o2,%o2
-L(n3):	addx	%o4,%o4,%o4
-	subcc	%o4,%o3,%o1
-	bcc	L(p4)
-	addxcc	%o2,%o2,%o2
-L(n4):	addx	%o4,%o4,%o4
-	addcc	%g1,-1,%g1
-	bne	L(nlop)
-	subcc	%o4,%o3,%o1
-	bcc	L(p5)
-	addxcc	%o2,%o2,%o2
-L(n5):	st	%o4,[%o0]
-	retl
-	xnor	%g0,%o2,%o0
-
-L(largedivisor):
-	and	%o2,1,%o5	C %o5 = n0 & 1
-
-	srl	%o2,1,%o2
-	sll	%o1,31,%g2
-	or	%g2,%o2,%o2	C %o2 = lo(n1n0 >> 1)
-	srl	%o1,1,%o1	C %o1 = hi(n1n0 >> 1)
-
-	and	%o3,1,%g2
-	srl	%o3,1,%g3	C %g3 = floor(d / 2)
-	add	%g3,%g2,%g3	C %g3 = ceil(d / 2)
-
-	b	L(Lp1)
-	addxcc	%o2,%o2,%o2
-
-L(Lplop):
-	bcc	L(Ln1)
-	addxcc	%o2,%o2,%o2
-L(Lp1):	addx	%o1,%o1,%o1
-	subcc	%o1,%g3,%o4
-	bcc	L(Ln2)
-	addxcc	%o2,%o2,%o2
-L(Lp2):	addx	%o1,%o1,%o1
-	subcc	%o1,%g3,%o4
-	bcc	L(Ln3)
-	addxcc	%o2,%o2,%o2
-L(Lp3):	addx	%o1,%o1,%o1
-	subcc	%o1,%g3,%o4
-	bcc	L(Ln4)
-	addxcc	%o2,%o2,%o2
-L(Lp4):	addx	%o1,%o1,%o1
-	addcc	%g1,-1,%g1
-	bne	L(Lplop)
-	subcc	%o1,%g3,%o4
-	bcc	L(Ln5)
-	addxcc	%o2,%o2,%o2
-L(Lp5):	add	%o1,%o1,%o1	C << 1
-	tst	%g2
-	bne	L(oddp)
-	add	%o5,%o1,%o1
-	st	%o1,[%o0]
-	retl
-	xnor	%g0,%o2,%o0
-
-L(Lnlop):
-	bcc	L(Lp1)
-	addxcc	%o2,%o2,%o2
-L(Ln1):	addx	%o4,%o4,%o4
-	subcc	%o4,%g3,%o1
-	bcc	L(Lp2)
-	addxcc	%o2,%o2,%o2
-L(Ln2):	addx	%o4,%o4,%o4
-	subcc	%o4,%g3,%o1
-	bcc	L(Lp3)
-	addxcc	%o2,%o2,%o2
-L(Ln3):	addx	%o4,%o4,%o4
-	subcc	%o4,%g3,%o1
-	bcc	L(Lp4)
-	addxcc	%o2,%o2,%o2
-L(Ln4):	addx	%o4,%o4,%o4
-	addcc	%g1,-1,%g1
-	bne	L(Lnlop)
-	subcc	%o4,%g3,%o1
-	bcc	L(Lp5)
-	addxcc	%o2,%o2,%o2
-L(Ln5):	add	%o4,%o4,%o4	C << 1
-	tst	%g2
-	bne	L(oddn)
-	add	%o5,%o4,%o4
-	st	%o4,[%o0]
-	retl
-	xnor	%g0,%o2,%o0
-
-L(oddp):
-	xnor	%g0,%o2,%o2
-	C q' in %o2. r' in %o1
-	addcc	%o1,%o2,%o1
-	bcc	L(Lp6)
-	addx	%o2,0,%o2
-	sub	%o1,%o3,%o1
-L(Lp6):	subcc	%o1,%o3,%g0
-	bcs	L(Lp7)
-	subx	%o2,-1,%o2
-	sub	%o1,%o3,%o1
-L(Lp7):	st	%o1,[%o0]
-	retl
-	mov	%o2,%o0
-
-L(oddn):
-	xnor	%g0,%o2,%o2
-	C q' in %o2. r' in %o4
-	addcc	%o4,%o2,%o4
-	bcc	L(Ln6)
-	addx	%o2,0,%o2
-	sub	%o4,%o3,%o4
-L(Ln6):	subcc	%o4,%o3,%g0
-	bcs	L(Ln7)
-	subx	%o2,-1,%o2
-	sub	%o4,%o3,%o4
-L(Ln7):	st	%o4,[%o0]
-	retl
-	mov	%o2,%o0
-EPILOGUE(mpn_udiv_qrnnd)
diff --git a/ghc/rts/gmp/mpn/sparc32/umul.asm b/ghc/rts/gmp/mpn/sparc32/umul.asm
deleted file mode 100644
index efa56851d6..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/umul.asm
+++ /dev/null
@@ -1,68 +0,0 @@
-dnl  SPARC mpn_umul_ppmm -- support for longlong.h for non-gcc.
-
-dnl  Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_umul_ppmm)
-	wr	%g0,%o1,%y
-	sra	%o2,31,%g2	C Don't move this insn
-	and	%o1,%g2,%g2	C Don't move this insn
-	andcc	%g0,0,%g1	C Don't move this insn
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,%o2,%g1
-	mulscc	%g1,0,%g1
-	rd	%y,%g3
-	st	%g3,[%o0]
-	retl
-	add	%g1,%g2,%o0
-EPILOGUE(mpn_umul_ppmm)
diff --git a/ghc/rts/gmp/mpn/sparc32/v8/addmul_1.asm b/ghc/rts/gmp/mpn/sparc32/v8/addmul_1.asm
deleted file mode 100644
index da44644b51..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/v8/addmul_1.asm
+++ /dev/null
@@ -1,122 +0,0 @@
-dnl  SPARC v8 mpn_addmul_1 -- Multiply a limb vector with a limb and
-dnl  add the result to a second limb vector.
-
-dnl  Copyright (C) 1992, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	o0
-C s1_ptr	o1
-C size		o2
-C s2_limb	o3
-
-ASM_START()
-PROLOGUE(mpn_addmul_1)
-	orcc	%g0,%g0,%g2
-	ld	[%o1+0],%o4	C 1
-
-	sll	%o2,4,%g1
-	and	%g1,(4-1)<<4,%g1
-ifdef(`PIC',
-`	mov	%o7,%g4		C Save return address register
-0:	call	1f
-	add	%o7,L(1)-0b,%g3
-1:	mov	%g4,%o7		C Restore return address register
-',
-`	sethi	%hi(L(1)),%g3
-	or	%g3,%lo(L(1)),%g3
-')
-	jmp	%g3+%g1
-	nop
-L(1):
-L(L00):	add	%o0,-4,%o0
-	b	L(loop00)	C 4, 8, 12, ...
-	add	%o1,-4,%o1
-	nop
-L(L01):	b	L(loop01)	C 1, 5, 9, ...
-	nop
-	nop
-	nop
-L(L10):	add	%o0,-12,%o0	C 2, 6, 10, ...
-	b	L(loop10)
-	add	%o1,4,%o1
-	nop
-L(L11):	add	%o0,-8,%o0	C 3, 7, 11, ...
-	b	L(loop11)
-	add	%o1,-8,%o1
-	nop
-
-L(loop):
-	addcc	%g3,%g2,%g3	C 1
-	ld	[%o1+4],%o4	C 2
-	rd	%y,%g2		C 1
-	addx	%g0,%g2,%g2
-	ld	[%o0+0],%g1	C 2
-	addcc	%g1,%g3,%g3
-	st	%g3,[%o0+0]	C 1
-L(loop00):
-	umul	%o4,%o3,%g3	C 2
-	ld	[%o0+4],%g1	C 2
-	addxcc	%g3,%g2,%g3	C 2
-	ld	[%o1+8],%o4	C 3
-	rd	%y,%g2		C 2
-	addx	%g0,%g2,%g2
-	nop
-	addcc	%g1,%g3,%g3
-	st	%g3,[%o0+4]	C 2
-L(loop11):
-	umul	%o4,%o3,%g3	C 3
-	addxcc	%g3,%g2,%g3	C 3
-	ld	[%o1+12],%o4	C 4
-	rd	%y,%g2		C 3
-	add	%o1,16,%o1
-	addx	%g0,%g2,%g2
-	ld	[%o0+8],%g1	C 2
-	addcc	%g1,%g3,%g3
-	st	%g3,[%o0+8]	C 3
-L(loop10):
-	umul	%o4,%o3,%g3	C 4
-	addxcc	%g3,%g2,%g3	C 4
-	ld	[%o1+0],%o4	C 1
-	rd	%y,%g2		C 4
-	addx	%g0,%g2,%g2
-	ld	[%o0+12],%g1	C 2
-	addcc	%g1,%g3,%g3
-	st	%g3,[%o0+12]	C 4
-	add	%o0,16,%o0
-	addx	%g0,%g2,%g2
-L(loop01):
-	addcc	%o2,-4,%o2
-	bg	L(loop)
-	umul	%o4,%o3,%g3	C 1
-
-	addcc	%g3,%g2,%g3	C 4
-	rd	%y,%g2		C 4
-	addx	%g0,%g2,%g2
-	ld	[%o0+0],%g1	C 2
-	addcc	%g1,%g3,%g3
-	st	%g3,[%o0+0]	C 4
-	addx	%g0,%g2,%o0
-
-	retl
-	 nop
-EPILOGUE(mpn_addmul_1)
diff --git a/ghc/rts/gmp/mpn/sparc32/v8/mul_1.asm b/ghc/rts/gmp/mpn/sparc32/v8/mul_1.asm
deleted file mode 100644
index 801247553a..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/v8/mul_1.asm
+++ /dev/null
@@ -1,103 +0,0 @@
-dnl  SPARC v8 mpn_mul_1 -- Multiply a limb vector with a single limb and
-dnl  store the product in a second limb vector.
-
-dnl  Copyright (C) 1992, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	o0
-C s1_ptr	o1
-C size		o2
-C s2_limb	o3
-
-ASM_START()
-PROLOGUE(mpn_mul_1)
-	sll	%o2,4,%g1
-	and	%g1,(4-1)<<4,%g1
-ifdef(`PIC',
-`	mov	%o7,%g4		C Save return address register
-0:	call	1f
-	add	%o7,L(1)-0b,%g3
-1:	mov	%g4,%o7		C Restore return address register
-',
-`	sethi	%hi(L(1)),%g3
-	or	%g3,%lo(L(1)),%g3
-')
-	jmp	%g3+%g1
-	ld	[%o1+0],%o4	C 1
-L(1):
-L(L00):	add	%o0,-4,%o0
-	add	%o1,-4,%o1
-	b	L(loop00)	C 4, 8, 12, ...
-	orcc	%g0,%g0,%g2
-L(L01):	b	L(loop01)	C 1, 5, 9, ...
-	orcc	%g0,%g0,%g2
-	nop
-	nop
-L(L10):	add	%o0,-12,%o0	C 2, 6, 10, ...
-	add	%o1,4,%o1
-	b	L(loop10)
-	orcc	%g0,%g0,%g2
-	nop
-L(L11):	add	%o0,-8,%o0	C 3, 7, 11, ...
-	add	%o1,-8,%o1
-	b	L(loop11)
-	orcc	%g0,%g0,%g2
-
-L(loop):
-	addcc	%g3,%g2,%g3	C 1
-	ld	[%o1+4],%o4	C 2
-	st	%g3,[%o0+0]	C 1
-	rd	%y,%g2		C 1
-L(loop00):
-	umul	%o4,%o3,%g3	C 2
-	addxcc	%g3,%g2,%g3	C 2
-	ld	[%o1+8],%o4	C 3
-	st	%g3,[%o0+4]	C 2
-	rd	%y,%g2		C 2
-L(loop11):
-	umul	%o4,%o3,%g3	C 3
-	addxcc	%g3,%g2,%g3	C 3
-	ld	[%o1+12],%o4	C 4
-	add	%o1,16,%o1
-	st	%g3,[%o0+8]	C 3
-	rd	%y,%g2		C 3
-L(loop10):
-	umul	%o4,%o3,%g3	C 4
-	addxcc	%g3,%g2,%g3	C 4
-	ld	[%o1+0],%o4	C 1
-	st	%g3,[%o0+12]	C 4
-	add	%o0,16,%o0
-	rd	%y,%g2		C 4
-	addx	%g0,%g2,%g2
-L(loop01):
-	addcc	%o2,-4,%o2
-	bg	L(loop)
-	umul	%o4,%o3,%g3	C 1
-
-	addcc	%g3,%g2,%g3	C 4
-	st	%g3,[%o0+0]	C 4
-	rd	%y,%g2		C 4
-
-	retl
-	addx	%g0,%g2,%o0
-EPILOGUE(mpn_mul_1)
diff --git a/ghc/rts/gmp/mpn/sparc32/v8/submul_1.asm b/ghc/rts/gmp/mpn/sparc32/v8/submul_1.asm
deleted file mode 100644
index 9ed132f4c1..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/v8/submul_1.asm
+++ /dev/null
@@ -1,58 +0,0 @@
-dnl  SPARC v8 mpn_submul_1 -- Multiply a limb vector with a limb and
-dnl  subtract the result from a second limb vector.
-
-dnl  Copyright (C) 1992, 1993, 1994, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	o0
-C s1_ptr	o1
-C size		o2
-C s2_limb	o3
-
-ASM_START()
-PROLOGUE(mpn_submul_1)
-	sub	%g0,%o2,%o2		C negate ...
-	sll	%o2,2,%o2		C ... and scale size
-	sub	%o1,%o2,%o1		C o1 is offset s1_ptr
-	sub	%o0,%o2,%g1		C g1 is offset res_ptr
-
-	mov	0,%o0			C clear cy_limb
-
-L(loop):
-	ld	[%o1+%o2],%o4
-	ld	[%g1+%o2],%g2
-	umul	%o4,%o3,%o5
-	rd	%y,%g3
-	addcc	%o5,%o0,%o5
-	addx	%g3,0,%o0
-	subcc	%g2,%o5,%g2
-	addx	%o0,0,%o0
-	st	%g2,[%g1+%o2]
-
-	addcc	%o2,4,%o2
-	bne	L(loop)
-	 nop
-
-	retl
-	 nop
-EPILOGUE(mpn_submul_1)
diff --git a/ghc/rts/gmp/mpn/sparc32/v8/supersparc/udiv.asm b/ghc/rts/gmp/mpn/sparc32/v8/supersparc/udiv.asm
deleted file mode 100644
index 0d5e8d415d..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/v8/supersparc/udiv.asm
+++ /dev/null
@@ -1,122 +0,0 @@
-dnl  SuperSPARC mpn_udiv_qrnnd division support, used from longlong.h.
-dnl  This is for SuperSPARC only, to compensate for its semi-functional
-dnl  udiv instruction.
-
-dnl  Copyright (C) 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C rem_ptr	i0
-C n1		i1
-C n0		i2
-C d		i3
-
-ASM_START()
-
-ifdef(`PIC',
-`	TEXT
-L(getpc):
-	retl
-	nop')
-
-	TEXT
-	ALIGN(8)
-L(C0):	.double	0r4294967296
-L(C1):	.double	0r2147483648
-
-PROLOGUE(mpn_udiv_qrnnd)
-	save	%sp,-104,%sp
-	st	%i1,[%fp-8]
-	ld	[%fp-8],%f10
-
-ifdef(`PIC',
-`L(pc):	call	L(getpc)		C put address of this insn in %o7
-	ldd	[%o7+L(C0)-L(pc)],%f8',
-`	sethi	%hi(L(C0)),%o7
-	ldd	[%o7+%lo(L(C0))],%f8')
-
-	fitod	%f10,%f4
-	cmp	%i1,0
-	bge	L(248)
-	mov	%i0,%i5
-	faddd	%f4,%f8,%f4
-L(248):
-	st	%i2,[%fp-8]
-	ld	[%fp-8],%f10
-	fmuld	%f4,%f8,%f6
-	cmp	%i2,0
-	bge	L(249)
-	fitod	%f10,%f2
-	faddd	%f2,%f8,%f2
-L(249):
-	st	%i3,[%fp-8]
-	faddd	%f6,%f2,%f2
-	ld	[%fp-8],%f10
-	cmp	%i3,0
-	bge	L(250)
-	fitod	%f10,%f4
-	faddd	%f4,%f8,%f4
-L(250):
-	fdivd	%f2,%f4,%f2
-
-ifdef(`PIC',
-`	ldd	[%o7+L(C1)-L(pc)],%f4',
-`	sethi	%hi(L(C1)),%o7
-	ldd	[%o7+%lo(L(C1))],%f4')
-
-	fcmped	%f2,%f4
-	nop
-	fbge,a	L(251)
-	fsubd	%f2,%f4,%f2
-	fdtoi	%f2,%f2
-	st	%f2,[%fp-8]
-	b	L(252)
-	ld	[%fp-8],%i4
-L(251):
-	fdtoi	%f2,%f2
-	st	%f2,[%fp-8]
-	ld	[%fp-8],%i4
-	sethi	%hi(-2147483648),%g2
-	xor	%i4,%g2,%i4
-L(252):
-	umul	%i3,%i4,%g3
-	rd	%y,%i0
-	subcc	%i2,%g3,%o7
-	subxcc	%i1,%i0,%g0
-	be	L(253)
-	cmp	%o7,%i3
-
-	add	%i4,-1,%i0
-	add	%o7,%i3,%o7
-	st	%o7,[%i5]
-	ret
-	restore
-L(253):
-	blu	L(246)
-	mov	%i4,%i0
-	add	%i4,1,%i0
-	sub	%o7,%i3,%o7
-L(246):
-	st	%o7,[%i5]
-	ret
-	restore
-EPILOGUE(mpn_udiv_qrnnd)
diff --git a/ghc/rts/gmp/mpn/sparc32/v8/umul.asm b/ghc/rts/gmp/mpn/sparc32/v8/umul.asm
deleted file mode 100644
index ae8f692a0a..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/v8/umul.asm
+++ /dev/null
@@ -1,31 +0,0 @@
-dnl  SPARC v8 mpn_umul_ppmm -- support for longlong.h for non-gcc.
-
-dnl  Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-ASM_START()
-PROLOGUE(mpn_umul_ppmm)
-	umul %o1,%o2,%g2
-	st %g2,[%o0]
-	retl
-	rd %y,%o0
-EPILOGUE(mpn_umul_ppmm)
diff --git a/ghc/rts/gmp/mpn/sparc32/v9/README b/ghc/rts/gmp/mpn/sparc32/v9/README
deleted file mode 100644
index 9b39713271..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/v9/README
+++ /dev/null
@@ -1,4 +0,0 @@
-Code for SPARC processors implementing version 9 of the SPARC architecture.
-This code is for systems that doesn't preserve the full 64-bit contents of
-integer register at context switch.  For other systems (such as Solaris 7 or
-later) use the code in ../../sparc64.
diff --git a/ghc/rts/gmp/mpn/sparc32/v9/addmul_1.asm b/ghc/rts/gmp/mpn/sparc32/v9/addmul_1.asm
deleted file mode 100644
index c1762cc41f..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/v9/addmul_1.asm
+++ /dev/null
@@ -1,288 +0,0 @@
-dnl  SPARC v9 32-bit mpn_addmul_1 -- Multiply a limb vector with a limb and
-dnl  add the result to a second limb vector.
-
-dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	i0
-C s1_ptr	i1
-C size		i2
-C s2_limb	i3
-
-ASM_START()
-
-	TEXT
-	ALIGN(4)
-L(noll):
-	.word	0
-
-PROLOGUE(mpn_addmul_1)
-	save %sp,-256,%sp
-
-ifdef(`PIC',
-`L(pc):	rd	%pc,%o7
-	ld	[%o7+L(noll)-L(pc)],%f10',
-`	sethi	%hi(L(noll)),%g1
-	ld	[%g1+%lo(L(noll))],%f10')
-
-	sethi	%hi(0xffff0000),%o0
-	andn	%i3,%o0,%o0
-	st	%o0,[%fp-16]
-	ld	[%fp-16],%f11
-	fxtod	%f10,%f6
-
-	srl	%i3,16,%o0
-	st	%o0,[%fp-16]
-	ld	[%fp-16],%f11
-	fxtod	%f10,%f8
-
-	mov	0,%g3			C cy = 0
-
-	ld	[%i1],%f11
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(end1)
-	add	%i1,4,%i1		C s1_ptr++
-
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(end2)
-	std	%f12,[%fp-16]
-
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-40]
-	fdtox	%f4,%f12
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(end3)
-	std	%f12,[%fp-32]
-
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	ld	[%i0],%g5
-	ldx	[%fp-24],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-16],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	add	%i0,4,%i0		C res_ptr++
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(end4)
-	std	%f12,[%fp-16]
-
-	b,a	L(loopm)
-
-	.align 16
-C BEGIN LOOP
-L(loop):
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-24],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-16],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-16]
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(loope)
-	add	%i0,4,%i0		C res_ptr++
-L(loopm):
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-40],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-32],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-40]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-32]
-	subcc	%i2,1,%i2
-	bne,pt	%icc,L(loop)
-	add	%i0,4,%i0		C res_ptr++
-C END LOOP
-
-	fxtod	%f10,%f2
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-24],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-16],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	b,a	L(xxx)
-L(loope):
-L(end4):
-	fxtod	%f10,%f2
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-40],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-32],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-40]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-32]
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-24],%g2		C p16
-	ldx	[%fp-16],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	b,a	L(yyy)
-
-L(end3):
-	fxtod	%f10,%f2
-	ld	[%i0],%g5
-	ldx	[%fp-24],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-16],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-L(xxx):	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-16]
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-40],%g2		C p16
-	ldx	[%fp-32],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-24],%g2		C p16
-	ldx	[%fp-16],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-	b,a	L(ret)
-
-L(end2):
-	fxtod	%f10,%f2
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-40]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-32]
-	ld	[%i0],%g5
-	ldx	[%fp-24],%g2		C p16
-	ldx	[%fp-16],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-L(yyy):	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-40],%g2		C p16
-	ldx	[%fp-32],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-	b,a	L(ret)
-
-L(end1):
-	fxtod	%f10,%f2
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-16]
-
-	ld	[%i0],%g5
-	ldx	[%fp-24],%g2		C p16
-	ldx	[%fp-16],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-L(ret):	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	st	%g4,[%i0-4]
-
-	ret
-	restore %g0,%g3,%o0		C sideeffect: put cy in retreg
-EPILOGUE(mpn_addmul_1)
diff --git a/ghc/rts/gmp/mpn/sparc32/v9/gmp-mparam.h b/ghc/rts/gmp/mpn/sparc32/v9/gmp-mparam.h
deleted file mode 100644
index f946b900f0..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/v9/gmp-mparam.h
+++ /dev/null
@@ -1,69 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 32
-#define BYTES_PER_MP_LIMB 4
-#define BITS_PER_LONGINT 32
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-
-/* These values are for UltraSPARC I, II, and IIi.  It is bogus that
-   this file lives in v9, but that will do for now.  */
-
-/* Variations in addmul_1 speed make the multiply and square thresholds
-   doubtful.  TOOM3_SQR_THRESHOLD had to be estimated here.  */
-
-/* Generated by tuneup.c, 2000-07-06. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD   30
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD      200
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD   59
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD      500
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD             107
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD            146
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            29
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD        4
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD           3
-#endif
diff --git a/ghc/rts/gmp/mpn/sparc32/v9/mul_1.asm b/ghc/rts/gmp/mpn/sparc32/v9/mul_1.asm
deleted file mode 100644
index f8f0fdd8c2..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/v9/mul_1.asm
+++ /dev/null
@@ -1,267 +0,0 @@
-dnl  SPARC v9 32-bit mpn_mul_1 -- Multiply a limb vector with a limb and
-dnl  store the result in a second limb vector.
-
-dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	i0
-C s1_ptr	i1
-C size		i2
-C s2_limb	i3
-
-ASM_START()
-
-	TEXT
-	ALIGN(4)
-L(noll):
-	.word	0
-
-PROLOGUE(mpn_mul_1)
-	save %sp,-256,%sp
-
-ifdef(`PIC',
-`L(pc):	rd	%pc,%o7
-	ld	[%o7+L(noll)-L(pc)],%f10',
-`	sethi	%hi(L(noll)),%g1
-	ld	[%g1+%lo(L(noll))],%f10')
-
-	sethi	%hi(0xffff0000),%o0
-	andn	%i3,%o0,%o0
-	st	%o0,[%fp-16]
-	ld	[%fp-16],%f11
-	fxtod	%f10,%f6
-
-	srl	%i3,16,%o0
-	st	%o0,[%fp-16]
-	ld	[%fp-16],%f11
-	fxtod	%f10,%f8
-
-	mov	0,%g3			C cy = 0
-
-	ld	[%i1],%f11
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(end1)
-	add	%i1,4,%i1		C s1_ptr++
-
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(end2)
-	std	%f12,[%fp-16]
-
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-40]
-	fdtox	%f4,%f12
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(end3)
-	std	%f12,[%fp-32]
-
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	ldx	[%fp-24],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-16],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	add	%i0,4,%i0		C res_ptr++
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(end4)
-	std	%f12,[%fp-16]
-
-	b,a	L(loopm)
-
-	.align 16
-C BEGIN LOOP
-L(loop):
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-24],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-16],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-16]
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(loope)
-	add	%i0,4,%i0		C res_ptr++
-L(loopm):
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-40],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-32],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-40]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-32]
-	subcc	%i2,1,%i2
-	bne,pt	%icc,L(loop)
-	add	%i0,4,%i0		C res_ptr++
-C END LOOP
-
-	fxtod	%f10,%f2
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-24],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-16],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	b,a	L(xxx)
-L(loope):
-L(end4):
-	fxtod	%f10,%f2
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-40],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-32],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-40]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-32]
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-24],%g2		C p16
-	ldx	[%fp-16],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	b,a	L(yyy)
-
-L(end3):
-	fxtod	%f10,%f2
-	ldx	[%fp-24],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-16],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-L(xxx):	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-16]
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-40],%g2		C p16
-	ldx	[%fp-32],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-24],%g2		C p16
-	ldx	[%fp-16],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-	b,a	L(ret)
-
-L(end2):
-	fxtod	%f10,%f2
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-40]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-32]
-	ldx	[%fp-24],%g2		C p16
-	ldx	[%fp-16],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-L(yyy):	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-40],%g2		C p16
-	ldx	[%fp-32],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4]
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-	b,a	L(ret)
-
-L(end1):
-	fxtod	%f10,%f2
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-16]
-
-	ldx	[%fp-24],%g2		C p16
-	ldx	[%fp-16],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-L(ret):	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	st	%g4,[%i0-4]
-
-	ret
-	restore %g0,%g3,%o0		C sideeffect: put cy in retreg
-EPILOGUE(mpn_mul_1)
diff --git a/ghc/rts/gmp/mpn/sparc32/v9/submul_1.asm b/ghc/rts/gmp/mpn/sparc32/v9/submul_1.asm
deleted file mode 100644
index 6195ea88ea..0000000000
--- a/ghc/rts/gmp/mpn/sparc32/v9/submul_1.asm
+++ /dev/null
@@ -1,291 +0,0 @@
-dnl  SPARC v9 32-bit mpn_submul_1 -- Multiply a limb vector with a limb and
-dnl  subtract the result from a second limb vector.
-
-dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	i0
-C s1_ptr	i1
-C size		i2
-C s2_limb	i3
-
-ASM_START()
-
-	TEXT
-	ALIGN(4)
-L(noll):
-	.word	0
-
-PROLOGUE(mpn_submul_1)
-	save %sp,-256,%sp
-
-ifdef(`PIC',
-`L(pc):	rd	%pc,%o7
-	ld	[%o7+L(noll)-L(pc)],%f10',
-`	sethi	%hi(L(noll)),%g1
-	ld	[%g1+%lo(L(noll))],%f10')
-
-	sethi	%hi(0xffff0000),%o0
-	andn	%i3,%o0,%o0
-	st	%o0,[%fp-16]
-	ld	[%fp-16],%f11
-	fxtod	%f10,%f6
-
-	srl	%i3,16,%o0
-	st	%o0,[%fp-16]
-	ld	[%fp-16],%f11
-	fxtod	%f10,%f8
-
-	mov	0,%g3			C cy = 0
-
-	ld	[%i1],%f11
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(end1)
-	add	%i1,4,%i1		C s1_ptr++
-
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(end2)
-	std	%f12,[%fp-16]
-
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-40]
-	fdtox	%f4,%f12
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(end3)
-	std	%f12,[%fp-32]
-
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	ld	[%i0],%g5
-	ldx	[%fp-24],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-16],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	add	%i0,4,%i0		C res_ptr++
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(end4)
-	std	%f12,[%fp-16]
-
-	b,a	L(loopm)
-
-	.align 16
-C BEGIN LOOP
-L(loop):
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	add	%g3,%g1,%g4		C p += cy
-	subcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-24],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-16],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4]
-	addx	%g3,0,%g3
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-16]
-	subcc	%i2,1,%i2
-	be,pn	%icc,L(loope)
-	add	%i0,4,%i0		C res_ptr++
-L(loopm):
-	fxtod	%f10,%f2
-	ld	[%i1],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	add	%g3,%g1,%g4		C p += cy
-	subcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-40],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-32],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4]
-	addx	%g3,0,%g3
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-40]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-32]
-	subcc	%i2,1,%i2
-	bne,pt	%icc,L(loop)
-	add	%i0,4,%i0		C res_ptr++
-C END LOOP
-
-	fxtod	%f10,%f2
-	add	%g3,%g1,%g4		C p += cy
-	subcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-24],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-16],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4]
-	b,a	L(xxx)
-L(loope):
-L(end4):
-	fxtod	%f10,%f2
-	add	%g3,%g1,%g4		C p += cy
-	subcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-40],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-32],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-40]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-32]
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-24],%g2		C p16
-	ldx	[%fp-16],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4]
-	b,a	L(yyy)
-
-L(end3):
-	fxtod	%f10,%f2
-	ld	[%i0],%g5
-	ldx	[%fp-24],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-16],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-L(xxx):	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-16]
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-40],%g2		C p16
-	ldx	[%fp-32],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4]
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-24],%g2		C p16
-	ldx	[%fp-16],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4]
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-	b,a	L(ret)
-
-L(end2):
-	fxtod	%f10,%f2
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-40]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-32]
-	ld	[%i0],%g5
-	ldx	[%fp-24],%g2		C p16
-	ldx	[%fp-16],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-L(yyy):	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	ld	[%i0],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-40],%g2		C p16
-	ldx	[%fp-32],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4]
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-	b,a	L(ret)
-
-L(end1):
-	fxtod	%f10,%f2
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-24]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-16]
-
-	ld	[%i0],%g5
-	ldx	[%fp-24],%g2		C p16
-	ldx	[%fp-16],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-L(ret):	add	%g3,%g1,%g4		C p += cy
-	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	srlx	%g4,32,%g3
-	st	%l2,[%i0-4]
-
-	addx	%g3,%g0,%g3
-	ret
-	restore %g0,%g3,%o0		C sideeffect: put cy in retreg
-EPILOGUE(mpn_submul_1)
diff --git a/ghc/rts/gmp/mpn/sparc64/README b/ghc/rts/gmp/mpn/sparc64/README
deleted file mode 100644
index 6923a133f3..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/README
+++ /dev/null
@@ -1,48 +0,0 @@
-This directory contains mpn functions for 64-bit V9 SPARC
-
-RELEVANT OPTIMIZATION ISSUES
-
-The Ultra I/II pipeline executes up to two simple integer arithmetic operations
-per cycle.  The 64-bit integer multiply instruction mulx takes from 5 cycles to
-35 cycles, depending on the position of the most significant bit of the 1st
-source operand.  It cannot overlap with other instructions.  For our use of
-mulx, it will take from 5 to 20 cycles.
-
-Integer conditional move instructions cannot dual-issue with other integer
-instructions.  No conditional move can issue 1-5 cycles after a load.  (Or
-something such bizzare.)
-
-Integer branches can issue with two integer arithmetic instructions.  Likewise
-for integer loads.  Four instructions may issue (arith, arith, ld/st, branch)
-but only if the branch is last.
-
-(The V9 architecture manual recommends that the 2nd operand of a multiply
-instruction be the smaller one.  For UltraSPARC, they got things backwards and
-optimize for the wrong operand!  Really helpful in the light of that multiply
-is incredibly slow on these CPUs!)
-
-STATUS
-
-There is new code in ~/prec/gmp-remote/sparc64.  Not tested or completed, but
-the pipelines are worked out.  Here are the timings:
-
-* lshift, rshift: The code is well-optimized and runs at 2.0 cycles/limb.
-
-* add_n, sub_n: add3.s currently runs at 6 cycles/limb.  We use a bizarre
-  scheme of compares and branches (with some nops and fnops to align things)
-  and carefully stay away from the instructions intended for this application
-  (i.e., movcs and movcc).
-
-  Using movcc/movcs, even with deep unrolling, seems to get down to 7
-  cycles/limb.
-
-  The most promising approach is to split operands in 32-bit pieces using
-  srlx, then use two addccc, and finally compile the results with sllx+or.
-  The result could run at 5 cycles/limb, I think.  It might be possible to
-  do without unrolling, or with minimal unrolling.
-
-* addmul_1/submul_1: Should optimize for when scalar operand < 2^32.
-* addmul_1/submul_1: Since mulx is horrendously slow on UltraSPARC I/II,
-  Karatsuba's method should save up to 16 cycles (i.e. > 20%).
-* mul_1 (and possibly the other multiply functions): Handle carry in the
-  same tricky way as add_n,sub_n.
diff --git a/ghc/rts/gmp/mpn/sparc64/add_n.asm b/ghc/rts/gmp/mpn/sparc64/add_n.asm
deleted file mode 100644
index 72b3895a5b..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/add_n.asm
+++ /dev/null
@@ -1,172 +0,0 @@
-! SPARC v9 __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
-! sum in a third limb vector.
-
-! Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	%o0
-! s1_ptr	%o1
-! s2_ptr	%o2
-! size		%o3
-
-include(`../config.m4')
-
-ASM_START()
-	.register	%g2,#scratch
-	.register	%g3,#scratch
-PROLOGUE(mpn_add_n)
-
-! 12 mem ops >= 12 cycles
-! 8 shift insn >= 8 cycles
-! 8 addccc, executing alone, +8 cycles
-! Unrolling not mandatory...perhaps 2-way is best?
-! Put one ldx/stx and one s?lx per issue tuple, fill with pointer arith and loop ctl
-! All in all, it runs at 5 cycles/limb
-
-	save	%sp,-160,%sp
-
-	addcc	%g0,%g0,%g0
-
-	add	%i3,-4,%i3
-	brlz,pn	%i3,L(there)
-	nop
-
-	ldx	[%i1+0],%l0
-	ldx	[%i2+0],%l4
-	ldx	[%i1+8],%l1
-	ldx	[%i2+8],%l5
-	ldx	[%i1+16],%l2
-	ldx	[%i2+16],%l6
-	ldx	[%i1+24],%l3
-	ldx	[%i2+24],%l7
-	add	%i1,32,%i1
-	add	%i2,32,%i2
-
-	add	%i3,-4,%i3
-	brlz,pn	%i3,L(skip)
-	nop
-	b	L(loop1)	! jump instead of executing many NOPs
-	nop
-	ALIGN(32)
-!---------  Start main loop ---------
-L(loop1):
-	addccc	%l0,%l4,%g1
-!-
-	srlx	%l0,32,%o0
-	ldx	[%i1+0],%l0
-!-
-	srlx	%l4,32,%o4
-	ldx	[%i2+0],%l4
-!-
-	addccc	%o0,%o4,%g0
-!-
-	addccc	%l1,%l5,%g2
-!-
-	srlx	%l1,32,%o1
-	ldx	[%i1+8],%l1
-!-
-	srlx	%l5,32,%o5
-	ldx	[%i2+8],%l5
-!-
-	addccc	%o1,%o5,%g0
-!-
-	addccc	%l2,%l6,%g3
-!-
-	srlx	%l2,32,%o2
-	ldx	[%i1+16],%l2
-!-
-	srlx	%l6,32,%g5	! asymmetry
-	ldx	[%i2+16],%l6
-!-
-	addccc	%o2,%g5,%g0
-!-
-	addccc	%l3,%l7,%g4
-!-
-	srlx	%l3,32,%o3
-	ldx	[%i1+24],%l3
-	add	%i1,32,%i1
-!-
-	srlx	%l7,32,%o7
-	ldx	[%i2+24],%l7
-	add	%i2,32,%i2
-!-
-	addccc	%o3,%o7,%g0
-!-
-	stx	%g1,[%i0+0]
-!-
-	stx	%g2,[%i0+8]
-!-
-	stx	%g3,[%i0+16]
-	add	%i3,-4,%i3
-!-
-	stx	%g4,[%i0+24]
-	add	%i0,32,%i0
-
-	brgez,pt	%i3,L(loop1)
-	nop
-!---------  End main loop ---------
-L(skip):
-	addccc	%l0,%l4,%g1
-	srlx	%l0,32,%o0
-	srlx	%l4,32,%o4
-	addccc	%o0,%o4,%g0
-	addccc	%l1,%l5,%g2
-	srlx	%l1,32,%o1
-	srlx	%l5,32,%o5
-	addccc	%o1,%o5,%g0
-	addccc	%l2,%l6,%g3
-	srlx	%l2,32,%o2
-	srlx	%l6,32,%g5	! asymmetry
-	addccc	%o2,%g5,%g0
-	addccc	%l3,%l7,%g4
-	srlx	%l3,32,%o3
-	srlx	%l7,32,%o7
-	addccc	%o3,%o7,%g0
-	stx	%g1,[%i0+0]
-	stx	%g2,[%i0+8]
-	stx	%g3,[%i0+16]
-	stx	%g4,[%i0+24]
-	add	%i0,32,%i0
-
-L(there):
-	add	%i3,4,%i3
-	brz,pt	%i3,L(end)
-	nop
-
-L(loop2):
-	ldx	[%i1+0],%l0
-	add	%i1,8,%i1
-	ldx	[%i2+0],%l4
-	add	%i2,8,%i2
-	srlx	%l0,32,%g2
-	srlx	%l4,32,%g3
-	addccc	%l0,%l4,%g1
-	addccc	%g2,%g3,%g0
-	stx	%g1,[%i0+0]
-	add	%i0,8,%i0
-	add	%i3,-1,%i3
-	brgz,pt	%i3,L(loop2)
-	nop
-
-L(end):	addc	%g0,%g0,%i0
-	ret
-	restore
-EPILOGUE(mpn_add_n)
diff --git a/ghc/rts/gmp/mpn/sparc64/addmul1h.asm b/ghc/rts/gmp/mpn/sparc64/addmul1h.asm
deleted file mode 100644
index 96cb5f7369..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/addmul1h.asm
+++ /dev/null
@@ -1,203 +0,0 @@
-dnl  SPARC 64-bit addmull/addmulu -- Helper for mpn_addmul_1 and mpn_mul_1.
-
-dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-ifdef(`LOWPART',
-`addmull:',
-`addmulu:')
-	save %sp,-256,%sp
-
-	sethi	%hi(0xffff0000),%o0
-	andn	%i3,%o0,%o0
-	st	%o0,[%fp-17]
-	ld	[%fp-17],%f11
-	fxtod	%f10,%f6
-
-	srl	%i3,16,%o0
-	st	%o0,[%fp-17]
-	ld	[%fp-17],%f11
-	fxtod	%f10,%f8
-
-	mov	0,%g3			C cy = 0
-
-	ld	[%i1+4],%f11
-	subcc	%i2,1,%i2
-dnl	be,pn	%icc,E(end1)
-	add	%i1,4,%i1		C s1_ptr++
-
-	fxtod	%f10,%f2
-	ld	[%i1-4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-25]
-	fdtox	%f4,%f12
-	subcc	%i2,1,%i2
-	be,pn	%icc,E(end2)
-	std	%f12,[%fp-17]
-
-	fxtod	%f10,%f2
-	ld	[%i1+4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-41]
-	fdtox	%f4,%f12
-	subcc	%i2,1,%i2
-dnl	be,pn	%icc,E(end3)
-	std	%f12,[%fp-33]
-
-	fxtod	%f10,%f2
-	ld	[%i1-4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	ld	[%i0+DLO],%g5
-	ldx	[%fp-25],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-17],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-25]
-	fdtox	%f4,%f12
-	add	%i0,4,%i0		C res_ptr++
-	subcc	%i2,1,%i2
-	be,pn	%icc,E(end4)
-	std	%f12,[%fp-17]
-
-	b,a	E(loop)
-	nop				C nop is cheap to nullify
-
-	ALIGN(16)
-C BEGIN LOOP
-E(loop):
-	fxtod	%f10,%f2
-	ld	[%i1+4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	ld	[%i0+DHI],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-41],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-33],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4+DLO]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-41]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-33]
-	sub	%i2,2,%i2
-	add	%i0,4,%i0		C res_ptr++
-
-	fxtod	%f10,%f2
-	ld	[%i1-4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	ld	[%i0+DLO],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-25],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-17],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4+DHI]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-25]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-17]
-	brnz,pt	%i2,E(loop)
-	add	%i0,4,%i0		C res_ptr++
-C END LOOP
-E(loope):
-E(end4):
-	fxtod	%f10,%f2
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	ld	[%i0+DHI],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-41],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-33],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4+DLO]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-41]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-33]
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-	ld	[%i0+DLO],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-25],%g2		C p16
-	ldx	[%fp-17],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4+DHI]
-	b,a	E(yyy)
-
-E(end2):
-	fxtod	%f10,%f2
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-41]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-33]
-	ld	[%i0+DLO],%g5
-	ldx	[%fp-25],%g2		C p16
-	ldx	[%fp-17],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-E(yyy):	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g5,%g1,%g1		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-ifdef(`LOWPART',
-`	ld	[%i0+DHI],%g5')
-	srlx	%g4,32,%g3
-	ldx	[%fp-41],%g2		C p16
-	ldx	[%fp-33],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4+DLO]
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-ifdef(`LOWPART',
-`	add	%g5,%g1,%g1')		C add *res_ptr to p0 (ADD2)
-	add	%g3,%g1,%g4		C p += cy
-ifdef(`LOWPART',
-`	st	%g4,[%i0-4+DHI]
-	srlx	%g4,32,%g4')
-
-	ret
-	restore %g0,%g4,%o0		C sideeffect: put cy in retreg
-ifdef(`LOWPART',
-`EPILOGUE(addmull)',
-`EPILOGUE(addmulu)')
diff --git a/ghc/rts/gmp/mpn/sparc64/addmul_1.asm b/ghc/rts/gmp/mpn/sparc64/addmul_1.asm
deleted file mode 100644
index c3f04cea6a..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/addmul_1.asm
+++ /dev/null
@@ -1,114 +0,0 @@
-dnl  SPARC 64-bit mpn_addmul_1 -- Multiply a limb vector with a limb and
-dnl  add the result to a second limb vector.
-
-dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	i0
-C s1_ptr	i1
-C size		i2
-C s2_limb	i3
-
-ASM_START()
-	.register	%g2,#scratch
-	.register	%g3,#scratch
-
-PROLOGUE(mpn_addmul_1)
-	save	%sp,-256,%sp
-
-C We store 0.0 in f10 and keep it invariant accross thw two
-C function calls below.  Note that this is not ABI conformant,
-C but since the functions are local, that's acceptable.
-ifdef(`PIC',
-`L(pc):	rd	%pc,%o7
-	ld	[%o7+L(noll)-L(pc)],%f10',
-`	sethi	%hh(L(noll)),%g2
-	sethi	%lm(L(noll)),%g1
-	or	%g2,%hm(L(noll)),%g2
-	or	%g1,%lo(L(noll)),%g1
-	sllx	%g2,32,%g2
-	ld	[%g1+%g2],%f10')
-
-	sub	%i1,%i0,%g1
-	srlx	%g1,3,%g1
-	cmp	%g1,%i2
-	bcc,pt	%xcc,L(nooverlap)
-	nop
-
-	sllx	%i2,3,%g2		C compute stack allocation byte count
-	add	%g2,15,%o0
-	and	%o0,-16,%o0
-	sub	%sp,%o0,%sp
-	add	%sp,2223,%o0
-
-	mov	%i1,%o1			C copy s1_ptr to mpn_copyi's srcp
-	call	mpn_copyi
-	mov	%i2,%o2			C copy n to mpn_copyi's count parameter
-
-	add	%sp,2223,%i1
-
-L(nooverlap):
-C First multiply-add with low 32 bits of s2_limb
-	mov	%i0,%o0
-	mov	%i1,%o1
-	add	%i2,%i2,%o2
-	call	addmull
-	srl	%i3,0,%o3
-
-	mov	%o0,%l0			C keep carry-out from accmull
-
-C Now multiply-add with high 32 bits of s2_limb, unless it is zero.
-	srlx	%i3,32,%o3
-	brz,a,pn	%o3,L(small)
-	 mov	%o0,%i0
-	mov	%i1,%o1
-	add	%i2,%i2,%o2
-	call	addmulu
-	add	%i0,4,%o0
-
-	add	%l0,%o0,%i0
-L(small):
-	ret
-	restore	%g0,%g0,%g0
-EPILOGUE(mpn_addmul_1)
-
-C Put a zero in the text segment to allow us to t the address
-C quickly when compiling for PIC
-	TEXT
-	ALIGN(4)
-L(noll):
-	.word	0
-
-define(`LO',`(+4)')
-define(`HI',`(-4)')
-
-define(`DLO',`(+4)')
-define(`DHI',`(-4)')
-define(`LOWPART')
-define(`E',`L(l.$1)')
-include_mpn(`sparc64/addmul1h.asm')
-
-define(`DLO',`(-4)')
-define(`DHI',`(+4)')
-undefine(`LOWPART')
-define(`E',`L(u.$1)')
-include_mpn(`sparc64/addmul1h.asm')
diff --git a/ghc/rts/gmp/mpn/sparc64/copyi.asm b/ghc/rts/gmp/mpn/sparc64/copyi.asm
deleted file mode 100644
index d9957e3c90..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/copyi.asm
+++ /dev/null
@@ -1,79 +0,0 @@
-! SPARC v9 __gmpn_copy -- Copy a limb vector.
-
-! Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! rptr	%o0
-! sptr	%o1
-! n	%o2
-
-include(`../config.m4')
-
-ASM_START()
-	.register	%g2,#scratch
-	.register	%g3,#scratch
-PROLOGUE(mpn_copyi)
-	add	%o2,-8,%o2
-	brlz,pn	%o2,L(skip)
-	nop
-	b,a	L(loop1)
-	nop
-
-	ALIGN(16)
-L(loop1):
-	ldx	[%o1+0],%g1
-	ldx	[%o1+8],%g2
-	ldx	[%o1+16],%g3
-	ldx	[%o1+24],%g4
-	ldx	[%o1+32],%g5
-	ldx	[%o1+40],%o3
-	ldx	[%o1+48],%o4
-	ldx	[%o1+56],%o5
-	add	%o1,64,%o1
-	stx	%g1,[%o0+0]
-	stx	%g2,[%o0+8]
-	stx	%g3,[%o0+16]
-	stx	%g4,[%o0+24]
-	stx	%g5,[%o0+32]
-	stx	%o3,[%o0+40]
-	stx	%o4,[%o0+48]
-	stx	%o5,[%o0+56]
-	add	%o2,-8,%o2
-	brgez,pt	%o2,L(loop1)
-	add	%o0,64,%o0
-
-L(skip):
-	add	%o2,8,%o2
-	brz,pt	%o2,L(end)
-	nop
-
-L(loop2):
-	ldx	[%o1],%g1
-	add	%o1,8,%o1
-	add	%o2,-1,%o2
-	stx	%g1,[%o0]
-	add	%o0,8,%o0
-	brgz,pt	%o2,L(loop2)
-	nop
-
-L(end):	retl
-	nop
-EPILOGUE(mpn_copyi)
diff --git a/ghc/rts/gmp/mpn/sparc64/gmp-mparam.h b/ghc/rts/gmp/mpn/sparc64/gmp-mparam.h
deleted file mode 100644
index 74f61661c1..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/gmp-mparam.h
+++ /dev/null
@@ -1,88 +0,0 @@
-/* Sparc64 gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 64
-#define BYTES_PER_MP_LIMB 8
-#define BITS_PER_LONGINT 64
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-/* Tell the toom3 multiply implementation to call low-level mpn
-   functions instead of open-coding operations in C.  */
-#define USE_MORE_MPN 1
-
-
-/* Run on sun workshop cc. */
-/* Generated by tuneup.c, 2000-07-30. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD     12
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD         95
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD     33
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD        125
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD                27
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD              107
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD              12
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD          4
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD           199
-#endif
-
-#ifndef FFT_MUL_TABLE
-#define FFT_MUL_TABLE  { 304, 608, 1344, 2304, 7168, 20480, 49152, 0 }
-#endif
-#ifndef FFT_MODF_MUL_THRESHOLD
-#define FFT_MODF_MUL_THRESHOLD     320
-#endif
-#ifndef FFT_MUL_THRESHOLD
-#define FFT_MUL_THRESHOLD         1664
-#endif
-
-#ifndef FFT_SQR_TABLE
-#define FFT_SQR_TABLE  { 304, 608, 1344, 2816, 7168, 20480, 49152, 0 }
-#endif
-#ifndef FFT_MODF_SQR_THRESHOLD
-#define FFT_MODF_SQR_THRESHOLD     320
-#endif
-#ifndef FFT_SQR_THRESHOLD
-#define FFT_SQR_THRESHOLD         1664
-#endif
diff --git a/ghc/rts/gmp/mpn/sparc64/lshift.asm b/ghc/rts/gmp/mpn/sparc64/lshift.asm
deleted file mode 100644
index 2d2edc50a7..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/lshift.asm
+++ /dev/null
@@ -1,97 +0,0 @@
-! SPARC v9 __gmpn_lshift --
-
-! Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	%o0
-! src_ptr	%o1
-! size		%o2
-! cnt		%o3
-
-include(`../config.m4')
-
-ASM_START()
-	.register	%g2,#scratch
-	.register	%g3,#scratch
-PROLOGUE(mpn_lshift)
-	sllx	%o2,3,%g1
-	add	%o1,%g1,%o1	! make %o1 point at end of src
-	ldx	[%o1-8],%g2	! load first limb
-	sub	%g0,%o3,%o5	! negate shift count
-	add	%o0,%g1,%o0	! make %o0 point at end of res
-	add	%o2,-1,%o2
-	and	%o2,4-1,%g4	! number of limbs in first loop
-	srlx	%g2,%o5,%g1	! compute function result
-	brz,pn	%g4,L(0)		! if multiple of 4 limbs, skip first loop
-	mov	%g1,%g5
-
-	sub	%o2,%g4,%o2	! adjust count for main loop
-
-L(loop0):
-	ldx	[%o1-16],%g3
-	add	%o0,-8,%o0
-	add	%o1,-8,%o1
-	add	%g4,-1,%g4
-	sllx	%g2,%o3,%o4
-	srlx	%g3,%o5,%g1
-	mov	%g3,%g2
-	or	%o4,%g1,%o4
-	brnz,pt	%g4,L(loop0)
-	 stx	%o4,[%o0+0]
-
-L(0):	brz,pn	%o2,L(end)
-	 nop
-
-L(loop1):
-	ldx	[%o1-16],%g3
-	add	%o0,-32,%o0
-	add	%o2,-4,%o2
-	sllx	%g2,%o3,%o4
-	srlx	%g3,%o5,%g1
-
-	ldx	[%o1-24],%g2
-	sllx	%g3,%o3,%g4
-	or	%o4,%g1,%o4
-	stx	%o4,[%o0+24]
-	srlx	%g2,%o5,%g1
-
-	ldx	[%o1-32],%g3
-	sllx	%g2,%o3,%o4
-	or	%g4,%g1,%g4
-	stx	%g4,[%o0+16]
-	srlx	%g3,%o5,%g1
-
-	ldx	[%o1-40],%g2
-	sllx	%g3,%o3,%g4
-	or	%o4,%g1,%o4
-	stx	%o4,[%o0+8]
-	srlx	%g2,%o5,%g1
-
-	add	%o1,-32,%o1
-	or	%g4,%g1,%g4
-	brnz,pt	%o2,L(loop1)
-	 stx	%g4,[%o0+0]
-
-L(end):	sllx	%g2,%o3,%g2
-	stx	%g2,[%o0-8]
-	retl
-	mov	%g5,%o0
-EPILOGUE(mpn_lshift)
diff --git a/ghc/rts/gmp/mpn/sparc64/mul_1.asm b/ghc/rts/gmp/mpn/sparc64/mul_1.asm
deleted file mode 100644
index f2f2821d51..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/mul_1.asm
+++ /dev/null
@@ -1,113 +0,0 @@
-dnl  SPARC 64-bit mpn_mul_1 -- Multiply a limb vector with a limb and
-dnl  store the result to a second limb vector.
-
-dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	i0
-C s1_ptr	i1
-C size		i2
-C s2_limb	i3
-
-ASM_START()
-	.register	%g2,#scratch
-	.register	%g3,#scratch
-
-PROLOGUE(mpn_mul_1)
-	save	%sp,-256,%sp
-
-C We store 0.0 in f10 and keep it invariant accross thw two
-C function calls below.  Note that this is not ABI conformant,
-C but since the functions are local, that's acceptable.
-ifdef(`PIC',
-`L(pc):	rd	%pc,%o7
-	ld	[%o7+L(noll)-L(pc)],%f10',
-`	sethi	%hh(L(noll)),%g2
-	sethi	%lm(L(noll)),%g1
-	or	%g2,%hm(L(noll)),%g2
-	or	%g1,%lo(L(noll)),%g1
-	sllx	%g2,32,%g2
-	ld	[%g1+%g2],%f10')
-
-	sub	%i1,%i0,%g1
-	srlx	%g1,3,%g1
-	cmp	%g1,%i2
-	bcc,pt	%xcc,L(nooverlap)
-	nop
-
-	sllx	%i2,3,%g2		C compute stack allocation byte count
-	add	%g2,15,%o0
-	and	%o0,-16,%o0
-	sub	%sp,%o0,%sp
-	add	%sp,2223,%o0
-
-	mov	%i1,%o1			C copy s1_ptr to mpn_copyi's srcp
-	call	mpn_copyi
-	mov	%i2,%o2			C copy n to mpn_copyi's count parameter
-
-	add	%sp,2223,%i1
-
-L(nooverlap):
-C First multiply-add with low 32 bits of s2_limb
-	mov	%i0,%o0
-	mov	%i1,%o1
-	add	%i2,%i2,%o2
-	call	mull
-	srl	%i3,0,%o3
-
-	mov	%o0,%l0			C keep carry-out from accmull
-
-C Now multiply-add with high 32 bits of s2_limb, unless it is zero.
-	srlx	%i3,32,%o3
-	brz,a,pn	%o3,L(small)
-	 mov	%o0,%i0
-	mov	%i1,%o1
-	add	%i2,%i2,%o2
-	call	addmulu
-	add	%i0,4,%o0
-
-	add	%l0,%o0,%i0
-L(small):
-	ret
-	restore	%g0,%g0,%g0
-EPILOGUE(mpn_mul_1)
-
-C Put a zero in the text segment to allow us to t the address
-C quickly when compiling for PIC
-	TEXT
-	ALIGN(4)
-L(noll):
-	.word	0
-
-define(`LO',`(+4)')
-define(`HI',`(-4)')
-
-define(`DLO',`(+4)')
-define(`DHI',`(-4)')
-define(`E',`L($1)')
-include_mpn(`sparc64/mul_1h.asm')
-
-define(`DLO',`(-4)')
-define(`DHI',`(+4)')
-undefine(`LOWPART')
-define(`E',`L(u.$1)')
-include_mpn(`sparc64/addmul1h.asm')
diff --git a/ghc/rts/gmp/mpn/sparc64/mul_1h.asm b/ghc/rts/gmp/mpn/sparc64/mul_1h.asm
deleted file mode 100644
index 5078c01c3f..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/mul_1h.asm
+++ /dev/null
@@ -1,183 +0,0 @@
-dnl  SPARC 64-bit mull -- Helper for mpn_mul_1.
-
-dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-mull:
-	save %sp,-256,%sp
-
-	sethi	%hi(0xffff0000),%o0
-	andn	%i3,%o0,%o0
-	st	%o0,[%fp-17]
-	ld	[%fp-17],%f11
-	fxtod	%f10,%f6
-
-	srl	%i3,16,%o0
-	st	%o0,[%fp-17]
-	ld	[%fp-17],%f11
-	fxtod	%f10,%f8
-
-	mov	0,%g3			C cy = 0
-
-	ld	[%i1+4],%f11
-	subcc	%i2,1,%i2
-dnl	be,pn	%icc,E(end1)
-	add	%i1,4,%i1		C s1_ptr++
-
-	fxtod	%f10,%f2
-	ld	[%i1-4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-25]
-	fdtox	%f4,%f12
-	subcc	%i2,1,%i2
-	be,pn	%icc,E(end2)
-	std	%f12,[%fp-17]
-
-	fxtod	%f10,%f2
-	ld	[%i1+4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-41]
-	fdtox	%f4,%f12
-	subcc	%i2,1,%i2
-dnl	be,pn	%icc,E(end3)
-	std	%f12,[%fp-33]
-
-	fxtod	%f10,%f2
-	ld	[%i1-4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	ldx	[%fp-25],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-17],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-25]
-	fdtox	%f4,%f12
-	add	%i0,4,%i0		C res_ptr++
-	subcc	%i2,1,%i2
-	be,pn	%icc,E(end4)
-	std	%f12,[%fp-17]
-
-	b,a	E(loop)
-	nop				C nop is cheap to nullify
-
-	ALIGN(16)
-C BEGIN LOOP
-E(loop):
-	fxtod	%f10,%f2
-	ld	[%i1+4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-41],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-33],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4+DLO]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-41]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-33]
-	sub	%i2,2,%i2
-	add	%i0,4,%i0		C res_ptr++
-
-	fxtod	%f10,%f2
-	ld	[%i1-4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-25],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-17],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4+DHI]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-25]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-17]
-	brnz,pt	%i2,E(loop)
-	add	%i0,4,%i0		C res_ptr++
-C END LOOP
-E(loope):
-E(end4):
-	fxtod	%f10,%f2
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-41],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-33],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4+DLO]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-41]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-33]
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-25],%g2		C p16
-	ldx	[%fp-17],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4+DHI]
-	b,a	E(yyy)
-
-E(end2):
-	fxtod	%f10,%f2
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-41]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-33]
-	ldx	[%fp-25],%g2		C p16
-	ldx	[%fp-17],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-E(yyy):	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	srlx	%g4,32,%g3
-	ldx	[%fp-41],%g2		C p16
-	ldx	[%fp-33],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%g4,[%i0-4+DLO]
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	st	%g4,[%i0-4+DHI]
-	srlx	%g4,32,%g4
-
-	ret
-	restore %g0,%g4,%o0		C sideeffect: put cy in retreg
-EPILOGUE(mull)
diff --git a/ghc/rts/gmp/mpn/sparc64/rshift.asm b/ghc/rts/gmp/mpn/sparc64/rshift.asm
deleted file mode 100644
index baf7920efb..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/rshift.asm
+++ /dev/null
@@ -1,94 +0,0 @@
-! SPARC v9 __gmpn_rshift --
-
-! Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	%o0
-! src_ptr	%o1
-! size		%o2
-! cnt		%o3
-
-include(`../config.m4')
-
-ASM_START()
-	.register	%g2,#scratch
-	.register	%g3,#scratch
-PROLOGUE(mpn_rshift)
-	ldx	[%o1],%g2	! load first limb
-	sub	%g0,%o3,%o5	! negate shift count
-	add	%o2,-1,%o2
-	and	%o2,4-1,%g4	! number of limbs in first loop
-	sllx	%g2,%o5,%g1	! compute function result
-	brz,pn	%g4,L(0)	! if multiple of 4 limbs, skip first loop
-	mov	%g1,%g5
-
-	sub	%o2,%g4,%o2	! adjust count for main loop
-
-L(loop0):
-	ldx	[%o1+8],%g3
-	add	%o0,8,%o0
-	add	%o1,8,%o1
-	add	%g4,-1,%g4
-	srlx	%g2,%o3,%o4
-	sllx	%g3,%o5,%g1
-	mov	%g3,%g2
-	or	%o4,%g1,%o4
-	brnz,pt	%g4,L(loop0)
-	 stx	%o4,[%o0-8]
-
-L(0):	brz,pn	%o2,L(end)
-	 nop
-
-L(loop1):
-	ldx	[%o1+8],%g3
-	add	%o0,32,%o0
-	add	%o2,-4,%o2
-	srlx	%g2,%o3,%o4
-	sllx	%g3,%o5,%g1
-
-	ldx	[%o1+16],%g2
-	srlx	%g3,%o3,%g4
-	or	%o4,%g1,%o4
-	stx	%o4,[%o0-32]
-	sllx	%g2,%o5,%g1
-
-	ldx	[%o1+24],%g3
-	srlx	%g2,%o3,%o4
-	or	%g4,%g1,%g4
-	stx	%g4,[%o0-24]
-	sllx	%g3,%o5,%g1
-
-	ldx	[%o1+32],%g2
-	srlx	%g3,%o3,%g4
-	or	%o4,%g1,%o4
-	stx	%o4,[%o0-16]
-	sllx	%g2,%o5,%g1
-
-	add	%o1,32,%o1
-	or	%g4,%g1,%g4
-	brnz	%o2,L(loop1)
-	 stx	%g4,[%o0-8]
-
-L(end):	srlx	%g2,%o3,%g2
-	stx	%g2,[%o0-0]
-	retl
-	mov	%g5,%o0
-EPILOGUE(mpn_rshift)
diff --git a/ghc/rts/gmp/mpn/sparc64/sub_n.asm b/ghc/rts/gmp/mpn/sparc64/sub_n.asm
deleted file mode 100644
index 61547138e0..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/sub_n.asm
+++ /dev/null
@@ -1,172 +0,0 @@
-! SPARC v9 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
-! store difference in a third limb vector.
-
-! Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	%o0
-! s1_ptr	%o1
-! s2_ptr	%o2
-! size		%o3
-
-include(`../config.m4')
-
-ASM_START()
-	.register	%g2,#scratch
-	.register	%g3,#scratch
-PROLOGUE(mpn_sub_n)
-
-! 12 mem ops >= 12 cycles
-! 8 shift insn >= 8 cycles
-! 8 addccc, executing alone, +8 cycles
-! Unrolling not mandatory...perhaps 2-way is best?
-! Put one ldx/stx and one s?lx per issue tuple, fill with pointer arith and loop ctl
-! All in all, it runs at 5 cycles/limb
-
-	save	%sp,-160,%sp
-
-	addcc	%g0,%g0,%g0
-
-	add	%i3,-4,%i3
-	brlz,pn	%i3,L(there)
-	nop
-
-	ldx	[%i1+0],%l0
-	ldx	[%i2+0],%l4
-	ldx	[%i1+8],%l1
-	ldx	[%i2+8],%l5
-	ldx	[%i1+16],%l2
-	ldx	[%i2+16],%l6
-	ldx	[%i1+24],%l3
-	ldx	[%i2+24],%l7
-	add	%i1,32,%i1
-	add	%i2,32,%i2
-
-	add	%i3,-4,%i3
-	brlz,pn	%i3,L(skip)
-	nop
-	b	L(loop1)	! jump instead of executing many NOPs
-	nop
-	ALIGN(32)
-!---------  Start main loop ---------
-L(loop1):
-	subccc	%l0,%l4,%g1
-!-
-	srlx	%l0,32,%o0
-	ldx	[%i1+0],%l0
-!-
-	srlx	%l4,32,%o4
-	ldx	[%i2+0],%l4
-!-
-	subccc	%o0,%o4,%g0
-!-
-	subccc	%l1,%l5,%g2
-!-
-	srlx	%l1,32,%o1
-	ldx	[%i1+8],%l1
-!-
-	srlx	%l5,32,%o5
-	ldx	[%i2+8],%l5
-!-
-	subccc	%o1,%o5,%g0
-!-
-	subccc	%l2,%l6,%g3
-!-
-	srlx	%l2,32,%o2
-	ldx	[%i1+16],%l2
-!-
-	srlx	%l6,32,%g5	! asymmetry
-	ldx	[%i2+16],%l6
-!-
-	subccc	%o2,%g5,%g0
-!-
-	subccc	%l3,%l7,%g4
-!-
-	srlx	%l3,32,%o3
-	ldx	[%i1+24],%l3
-	add	%i1,32,%i1
-!-
-	srlx	%l7,32,%o7
-	ldx	[%i2+24],%l7
-	add	%i2,32,%i2
-!-
-	subccc	%o3,%o7,%g0
-!-
-	stx	%g1,[%i0+0]
-!-
-	stx	%g2,[%i0+8]
-!-
-	stx	%g3,[%i0+16]
-	add	%i3,-4,%i3
-!-
-	stx	%g4,[%i0+24]
-	add	%i0,32,%i0
-
-	brgez,pt	%i3,L(loop1)
-	nop
-!---------  End main loop ---------
-L(skip):
-	subccc	%l0,%l4,%g1
-	srlx	%l0,32,%o0
-	srlx	%l4,32,%o4
-	subccc	%o0,%o4,%g0
-	subccc	%l1,%l5,%g2
-	srlx	%l1,32,%o1
-	srlx	%l5,32,%o5
-	subccc	%o1,%o5,%g0
-	subccc	%l2,%l6,%g3
-	srlx	%l2,32,%o2
-	srlx	%l6,32,%g5	! asymmetry
-	subccc	%o2,%g5,%g0
-	subccc	%l3,%l7,%g4
-	srlx	%l3,32,%o3
-	srlx	%l7,32,%o7
-	subccc	%o3,%o7,%g0
-	stx	%g1,[%i0+0]
-	stx	%g2,[%i0+8]
-	stx	%g3,[%i0+16]
-	stx	%g4,[%i0+24]
-	add	%i0,32,%i0
-
-L(there):
-	add	%i3,4,%i3
-	brz,pt	%i3,L(end)
-	nop
-
-L(loop2):
-	ldx	[%i1+0],%l0
-	add	%i1,8,%i1
-	ldx	[%i2+0],%l4
-	add	%i2,8,%i2
-	srlx	%l0,32,%g2
-	srlx	%l4,32,%g3
-	subccc	%l0,%l4,%g1
-	subccc	%g2,%g3,%g0
-	stx	%g1,[%i0+0]
-	add	%i0,8,%i0
-	add	%i3,-1,%i3
-	brgz,pt	%i3,L(loop2)
-	nop
-
-L(end):	addc	%g0,%g0,%i0
-	ret
-	restore
-EPILOGUE(mpn_sub_n)
diff --git a/ghc/rts/gmp/mpn/sparc64/submul1h.asm b/ghc/rts/gmp/mpn/sparc64/submul1h.asm
deleted file mode 100644
index 7f51ba59c6..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/submul1h.asm
+++ /dev/null
@@ -1,204 +0,0 @@
-dnl  SPARC 64-bit submull/submulu -- Helper for mpn_submul_1 and mpn_mul_1.
-
-dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-ifdef(`LOWPART',
-`submull:',
-`submulu:')
-	save %sp,-256,%sp
-
-	sethi	%hi(0xffff0000),%o0
-	andn	%i3,%o0,%o0
-	st	%o0,[%fp-17]
-	ld	[%fp-17],%f11
-	fxtod	%f10,%f6
-
-	srl	%i3,16,%o0
-	st	%o0,[%fp-17]
-	ld	[%fp-17],%f11
-	fxtod	%f10,%f8
-
-	mov	0,%g3			C cy = 0
-
-	ld	[%i1+4],%f11
-	subcc	%i2,1,%i2
-dnl	be,pn	%icc,E(end1)
-	add	%i1,4,%i1		C s1_ptr++
-
-	fxtod	%f10,%f2
-	ld	[%i1-4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-25]
-	fdtox	%f4,%f12
-	subcc	%i2,1,%i2
-	be,pn	%icc,E(end2)
-	std	%f12,[%fp-17]
-
-	fxtod	%f10,%f2
-	ld	[%i1+4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-41]
-	fdtox	%f4,%f12
-	subcc	%i2,1,%i2
-dnl	be,pn	%icc,E(end3)
-	std	%f12,[%fp-33]
-
-	fxtod	%f10,%f2
-	ld	[%i1-4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	ld	[%i0+DLO],%g5
-	ldx	[%fp-25],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-17],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-25]
-	fdtox	%f4,%f12
-	add	%i0,4,%i0		C res_ptr++
-	subcc	%i2,1,%i2
-	be,pn	%icc,E(end4)
-	std	%f12,[%fp-17]
-
-	b,a	E(loop)
-	nop				C nop is cheap to nullify
-
-	ALIGN(16)
-C BEGIN LOOP
-E(loop):
-	fxtod	%f10,%f2
-	ld	[%i1+4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	add	%g3,%g1,%g4		C p += cy
-	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	ld	[%i0+DHI],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-41],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-33],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4+DLO]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-41]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-33]
-	sub	%i2,2,%i2
-	add	%i0,4,%i0		C res_ptr++
-
-	fxtod	%f10,%f2
-	ld	[%i1-4],%f11
-	add	%i1,4,%i1		C s1_ptr++
-	add	%g3,%g1,%g4		C p += cy
-	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	ld	[%i0+DLO],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-25],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-17],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4+DHI]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-25]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-17]
-	brnz,pt	%i2,E(loop)
-	add	%i0,4,%i0		C res_ptr++
-C END LOOP
-E(loope):
-E(end4):
-	fxtod	%f10,%f2
-	add	%g3,%g1,%g4		C p += cy
-	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	ld	[%i0+DHI],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-41],%g2		C p16
-	fmuld	%f2,%f8,%f16
-	ldx	[%fp-33],%g1		C p0
-	fmuld	%f2,%f6,%f4
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4+DLO]
-	fdtox	%f16,%f14
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	std	%f14,[%fp-41]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-33]
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-	ld	[%i0+DLO],%g5
-	srlx	%g4,32,%g3
-	ldx	[%fp-25],%g2		C p16
-	ldx	[%fp-17],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4+DHI]
-	b,a	E(yyy)
-
-E(end2):
-	fxtod	%f10,%f2
-	fmuld	%f2,%f8,%f16
-	fmuld	%f2,%f6,%f4
-	fdtox	%f16,%f14
-	std	%f14,[%fp-41]
-	fdtox	%f4,%f12
-	std	%f12,[%fp-33]
-	ld	[%i0+DLO],%g5
-	ldx	[%fp-25],%g2		C p16
-	ldx	[%fp-17],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-E(yyy):	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-	subxcc	%g5,%g4,%l2		C add *res_ptr to p0 (ADD2)
-ifdef(`LOWPART',
-`	ld	[%i0+DHI],%g5')
-	srlx	%g4,32,%g3
-	ldx	[%fp-41],%g2		C p16
-	ldx	[%fp-33],%g1		C p0
-	sllx	%g2,16,%g2		C align p16
-	st	%l2,[%i0-4+DLO]
-	add	%g2,%g1,%g1		C add p16 to p0 (ADD1)
-	add	%i0,4,%i0		C res_ptr++
-
-	add	%g3,%g1,%g4		C p += cy
-ifdef(`LOWPART',
-`	subxcc	%g5,%g4,%l2')		C add *res_ptr to p0 (ADD2)
-ifdef(`LOWPART',
-`	st	%l2,[%i0-4+DHI]
-	srlx	%g4,32,%g4')
-
-	addx	%g4,0,%g4
-	ret
-	restore %g0,%g4,%o0		C sideeffect: put cy in retreg
-ifdef(`LOWPART',
-`EPILOGUE(submull)',
-`EPILOGUE(submulu)')
diff --git a/ghc/rts/gmp/mpn/sparc64/submul_1.asm b/ghc/rts/gmp/mpn/sparc64/submul_1.asm
deleted file mode 100644
index 7c6af0a98b..0000000000
--- a/ghc/rts/gmp/mpn/sparc64/submul_1.asm
+++ /dev/null
@@ -1,114 +0,0 @@
-dnl  SPARC 64-bit mpn_submul_1 -- Multiply a limb vector with a limb and
-dnl  subtract the result from a second limb vector.
-
-dnl  Copyright (C) 1998, 2000 Free Software Foundation, Inc.
-
-dnl  This file is part of the GNU MP Library.
-
-dnl  The GNU MP Library is free software; you can redistribute it and/or modify
-dnl  it under the terms of the GNU Lesser General Public License as published
-dnl  by the Free Software Foundation; either version 2.1 of the License, or (at
-dnl  your option) any later version.
-
-dnl  The GNU MP Library is distributed in the hope that it will be useful, but
-dnl  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-dnl  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-dnl  License for more details.
-
-dnl  You should have received a copy of the GNU Lesser General Public License
-dnl  along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-dnl  the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-dnl  MA 02111-1307, USA.
-
-include(`../config.m4')
-
-C INPUT PARAMETERS
-C res_ptr	i0
-C s1_ptr	i1
-C size		i2
-C s2_limb	i3
-
-ASM_START()
-	.register	%g2,#scratch
-	.register	%g3,#scratch
-
-PROLOGUE(mpn_submul_1)
-	save	%sp,-256,%sp
-
-C We store 0.0 in f10 and keep it invariant accross thw two
-C function calls below.  Note that this is not ABI conformant,
-C but since the functions are local, that's acceptable.
-ifdef(`PIC',
-`L(pc):	rd	%pc,%o7
-	ld	[%o7+L(noll)-L(pc)],%f10',
-`	sethi	%hh(L(noll)),%g2
-	sethi	%lm(L(noll)),%g1
-	or	%g2,%hm(L(noll)),%g2
-	or	%g1,%lo(L(noll)),%g1
-	sllx	%g2,32,%g2
-	ld	[%g1+%g2],%f10')
-
-	sub	%i1,%i0,%g1
-	srlx	%g1,3,%g1
-	cmp	%g1,%i2
-	bcc,pt	%xcc,L(nooverlap)
-	nop
-
-	sllx	%i2,3,%g2		C compute stack allocation byte count
-	add	%g2,15,%o0
-	and	%o0,-16,%o0
-	sub	%sp,%o0,%sp
-	add	%sp,2223,%o0
-
-	mov	%i1,%o1			C copy s1_ptr to mpn_copyi's srcp
-	call	mpn_copyi
-	mov	%i2,%o2			C copy n to mpn_copyi's count parameter
-
-	add	%sp,2223,%i1
-
-L(nooverlap):
-C First multiply-add with low 32 bits of s2_limb
-	mov	%i0,%o0
-	mov	%i1,%o1
-	add	%i2,%i2,%o2
-	call	submull
-	srl	%i3,0,%o3
-
-	mov	%o0,%l0			C keep carry-out from accmull
-
-C Now multiply-add with high 32 bits of s2_limb, unless it is zero.
-	srlx	%i3,32,%o3
-	brz,a,pn	%o3,L(small)
-	 mov	%o0,%i0
-	mov	%i1,%o1
-	add	%i2,%i2,%o2
-	call	submulu
-	add	%i0,4,%o0
-
-	add	%l0,%o0,%i0
-L(small):
-	ret
-	restore	%g0,%g0,%g0
-EPILOGUE(mpn_submul_1)
-
-C Put a zero in the text segment to allow us to t the address
-C quickly when compiling for PIC
-	TEXT
-	ALIGN(4)
-L(noll):
-	.word	0
-
-define(`LO',`(+4)')
-define(`HI',`(-4)')
-
-define(`DLO',`(+4)')
-define(`DHI',`(-4)')
-define(`LOWPART')
-define(`E',`L(l.$1)')
-include_mpn(`sparc64/submul1h.asm')
-
-define(`DLO',`(-4)')
-define(`DHI',`(+4)')
-undefine(`LOWPART')
-define(`E',`L(u.$1)')
-include_mpn(`sparc64/submul1h.asm')
diff --git a/ghc/rts/gmp/mpn/thumb/add_n.s b/ghc/rts/gmp/mpn/thumb/add_n.s
deleted file mode 100644
index c1eeb6ca87..0000000000
--- a/ghc/rts/gmp/mpn/thumb/add_n.s
+++ /dev/null
@@ -1,50 +0,0 @@
-@ ARM/Thumb __gmpn_add -- Add two limb vectors of the same length > 0 and store
-@ sum in a third limb vector.
-
-@ Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-@ This file is part of the GNU MP Library.
-
-@ The GNU MP Library is free software; you can redistribute it and/or modify
-@ it under the terms of the GNU Lesser General Public License as published by
-@ the Free Software Foundation; either version 2.1 of the License, or (at your
-@ option) any later version.
-
-@ The GNU MP Library is distributed in the hope that it will be useful, but
-@ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-@ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-@ License for more details.
-
-@ You should have received a copy of the GNU Lesser General Public License
-@ along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-@ MA 02111-1307, USA.
-
-
-@ INPUT PARAMETERS
-@ RES_ptr	r0
-@ S1_ptr	r1
-@ S2_ptr	r2
-@ SIZE		r3
-
-@ NOT TESTED CODE
-
-	.text
-	.thumb
-	.align	0
-	.global	___gmpn_add_n
-___gmpn_add_n:
-	push	{r4, r5, r6, lr}
-	mov	r6, #1			@ init carry save register
-
-Loop:	sub	r6, #1			@ restore carry (set iff r6 was 0)
-	ldmia	r1!, {r4}		@ load next limb from S1
-	ldmia	r2!, {r5}		@ load next limb from S2
-	adc	r4, r5
-	stmia	r0!, {r4}		@ store result limb to RES
-	sbc	r6, r6			@ save negated carry
-	sub	r3, #1
-	bge	Loop			@ loop back while remaining count >= 4
-
-	mov	r0, r6
-	pop	{r4, r5, r6, pc}
diff --git a/ghc/rts/gmp/mpn/thumb/sub_n.s b/ghc/rts/gmp/mpn/thumb/sub_n.s
deleted file mode 100644
index 53c292375f..0000000000
--- a/ghc/rts/gmp/mpn/thumb/sub_n.s
+++ /dev/null
@@ -1,50 +0,0 @@
-@ ARM/Thumb __gmpn_sub -- Subtract two limb vectors of the same length > 0 and
-@ store difference in a third limb vector.
-
-@ Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-@ This file is part of the GNU MP Library.
-
-@ The GNU MP Library is free software; you can redistribute it and/or modify
-@ it under the terms of the GNU Lesser General Public License as published by
-@ the Free Software Foundation; either version 2.1 of the License, or (at your
-@ option) any later version.
-
-@ The GNU MP Library is distributed in the hope that it will be useful, but
-@ WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-@ or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-@ License for more details.
-
-@ You should have received a copy of the GNU Lesser General Public License
-@ along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-@ the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-@ MA 02111-1307, USA.
-
-
-@ INPUT PARAMETERS
-@ RES_ptr	r0
-@ S1_ptr	r1
-@ S2_ptr	r2
-@ SIZE		r3
-
-@ NOT TESTED CODE
-
-	.text
-	.thumb
-	.align	0
-	.global	___gmpn_sub_n
-___gmpn_sub_n:
-	push	{r4, r5, r6, lr}
-	mov	r6, #1			@ init carry save register
-
-Loop:	sub	r6, #1			@ restore carry (set iff r6 was 0)
-	ldmia	r1!, {r4}		@ load next limb from S1
-	ldmia	r2!, {r5}		@ load next limb from S2
-	sbc	r4, r5
-	stmia	r0!, {r4}		@ store result limb to RES
-	sbc	r6, r6			@ save negated carry
-	sub	r3, #1
-	bge	Loop			@ loop back while remaining count >= 4
-
-	mov	r0, r6
-	pop	{r4, r5, r6, pc}
diff --git a/ghc/rts/gmp/mpn/underscore.h b/ghc/rts/gmp/mpn/underscore.h
deleted file mode 100644
index 240dae0f63..0000000000
--- a/ghc/rts/gmp/mpn/underscore.h
+++ /dev/null
@@ -1,26 +0,0 @@
-/*
-Copyright (C) 1999 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-#if __STDC__
-#define C_SYMBOL_NAME(name) _##name
-#else
-#define C_SYMBOL_NAME(name) _/**/name
-#endif
diff --git a/ghc/rts/gmp/mpn/vax/add_n.s b/ghc/rts/gmp/mpn/vax/add_n.s
deleted file mode 100644
index cf4060f521..0000000000
--- a/ghc/rts/gmp/mpn/vax/add_n.s
+++ /dev/null
@@ -1,61 +0,0 @@
-# VAX __gmpn_add_n -- Add two limb vectors of the same length > 0 and store
-# sum in a third limb vector.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	(sp + 4)
-# s1_ptr	(sp + 8)
-# s2_ptr	(sp + 12)
-# size		(sp + 16)
-
-.text
-	.align 1
-.globl ___gmpn_add_n
-___gmpn_add_n:
-	.word	0x0
-	movl	16(ap),r0
-	movl	12(ap),r1
-	movl	8(ap),r2
-	movl	4(ap),r3
-	mnegl	r0,r5
-	addl2	$3,r0
-	ashl	$-2,r0,r0	# unroll loop count
-	bicl2	$-4,r5		# mask out low 2 bits
-	movaq	(r5)[r5],r5	# 9x
-	jmp	Loop(r5)
-
-Loop:	movl	(r2)+,r4
-	adwc	(r1)+,r4
-	movl	r4,(r3)+
-	movl	(r2)+,r4
-	adwc	(r1)+,r4
-	movl	r4,(r3)+
-	movl	(r2)+,r4
-	adwc	(r1)+,r4
-	movl	r4,(r3)+
-	movl	(r2)+,r4
-	adwc	(r1)+,r4
-	movl	r4,(r3)+
-	sobgtr	r0,Loop
-
-	adwc	r0,r0
-	ret
diff --git a/ghc/rts/gmp/mpn/vax/addmul_1.s b/ghc/rts/gmp/mpn/vax/addmul_1.s
deleted file mode 100644
index 379061dcb7..0000000000
--- a/ghc/rts/gmp/mpn/vax/addmul_1.s
+++ /dev/null
@@ -1,126 +0,0 @@
-# VAX __gmpn_addmul_1 -- Multiply a limb vector with a limb and add
-# the result to a second limb vector.
-
-# Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	(sp + 4)
-# s1_ptr	(sp + 8)
-# size		(sp + 12)
-# s2_limb	(sp + 16)
-
-.text
-	.align 1
-.globl ___gmpn_addmul_1
-___gmpn_addmul_1:
-	.word	0xfc0
-	movl	12(ap),r4
-	movl	8(ap),r8
-	movl	4(ap),r9
-	movl	16(ap),r6
-	jlss	s2_big
-
-	clrl	r3
-	incl	r4
-	ashl	$-1,r4,r7
-	jlbc	r4,L1
-	clrl	r11
-
-# Loop for S2_LIMB < 0x80000000
-Loop1:	movl	(r8)+,r1
-	jlss	L1n0
-	emul	r1,r6,$0,r2
-	addl2	r11,r2
-	adwc	$0,r3
-	addl2	r2,(r9)+
-	adwc	$0,r3
-L1:	movl	(r8)+,r1
-	jlss	L1n1
-L1p1:	emul	r1,r6,$0,r10
-	addl2	r3,r10
-	adwc	$0,r11
-	addl2	r10,(r9)+
-	adwc	$0,r11
-
-	sobgtr	r7,Loop1
-	movl	r11,r0
-	ret
-
-L1n0:	emul	r1,r6,$0,r2
-	addl2	r11,r2
-	adwc	r6,r3
-	addl2	r2,(r9)+
-	adwc	$0,r3
-	movl	(r8)+,r1
-	jgeq	L1p1
-L1n1:	emul	r1,r6,$0,r10
-	addl2	r3,r10
-	adwc	r6,r11
-	addl2	r10,(r9)+
-	adwc	$0,r11
-
-	sobgtr	r7,Loop1
-	movl	r11,r0
-	ret
-
-
-s2_big:	clrl	r3
-	incl	r4
-	ashl	$-1,r4,r7
-	jlbc	r4,L2
-	clrl	r11
-
-# Loop for S2_LIMB >= 0x80000000
-Loop2:	movl	(r8)+,r1
-	jlss	L2n0
-	emul	r1,r6,$0,r2
-	addl2	r11,r2
-	adwc	r1,r3
-	addl2	r2,(r9)+
-	adwc	$0,r3
-L2:	movl	(r8)+,r1
-	jlss	L2n1
-L2p1:	emul	r1,r6,$0,r10
-	addl2	r3,r10
-	adwc	r1,r11
-	addl2	r10,(r9)+
-	adwc	$0,r11
-
-	sobgtr	r7,Loop2
-	movl	r11,r0
-	ret
-
-L2n0:	emul	r1,r6,$0,r2
-	addl2	r11,r2
-	adwc	r6,r3
-	addl2	r2,(r9)+
-	adwc	r1,r3
-	movl	(r8)+,r1
-	jgeq	L2p1
-L2n1:	emul	r1,r6,$0,r10
-	addl2	r3,r10
-	adwc	r6,r11
-	addl2	r10,(r9)+
-	adwc	r1,r11
-
-	sobgtr	r7,Loop2
-	movl	r11,r0
-	ret
diff --git a/ghc/rts/gmp/mpn/vax/lshift.s b/ghc/rts/gmp/mpn/vax/lshift.s
deleted file mode 100644
index fd311a9782..0000000000
--- a/ghc/rts/gmp/mpn/vax/lshift.s
+++ /dev/null
@@ -1,58 +0,0 @@
-# VAX __gmpn_lshift -- left shift.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# rptr		(sp + 4)
-# sptr		(sp + 8)
-# size		(sp + 12)
-# cnt		(sp + 16)
-# r0=retval r1=size r2,r3=itmp r4,r5=otmp	call-used registers
-# r6=sptr r7=rptr r8=cnt r9 r10 r11		call-saved registers
-
-.text
-	.align 1
-.globl ___gmpn_lshift
-___gmpn_lshift:
-	.word	0x1c0
-	movl	4(ap),r7
-	movl	8(ap),r6
-	movl	12(ap),r1
-	movl	16(ap),r8
-
-	moval	(r6)[r1],r6
-	moval	(r7)[r1],r7
-	clrl	r3
-	movl	-(r6),r2
-	ashq	r8,r2,r4
-	movl	r5,r0
-	movl	r2,r3
-	decl	r1
-	jeql	Lend
-
-Loop:	movl	-(r6),r2
-	ashq	r8,r2,r4
-	movl	r5,-(r7)
-	movl	r2,r3
-	jsobgtr	r1,Loop
-
-Lend:	movl	r4,-4(r7)
-	ret
diff --git a/ghc/rts/gmp/mpn/vax/mul_1.s b/ghc/rts/gmp/mpn/vax/mul_1.s
deleted file mode 100644
index 708e8ca6ca..0000000000
--- a/ghc/rts/gmp/mpn/vax/mul_1.s
+++ /dev/null
@@ -1,123 +0,0 @@
-# VAX __gmpn_mul_1 -- Multiply a limb vector with a limb and store
-# the result in a second limb vector.
-
-# Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	(sp + 4)
-# s1_ptr	(sp + 8)
-# size		(sp + 12)
-# s2_limb	(sp + 16)
-
-.text
-	.align 1
-.globl ___gmpn_mul_1
-___gmpn_mul_1:
-	.word	0xfc0
-	movl	12(ap),r4
-	movl	8(ap),r8
-	movl	4(ap),r9
-	movl	16(ap),r6
-	jlss	s2_big
-
-# One might want to combine the addl2 and the store below, but that
-# is actually just slower according to my timing tests.  (VAX 3600)
-
-	clrl	r3
-	incl	r4
-	ashl	$-1,r4,r7
-	jlbc	r4,L1
-	clrl	r11
-
-# Loop for S2_LIMB < 0x80000000
-Loop1:	movl	(r8)+,r1
-	jlss	L1n0
-	emul	r1,r6,$0,r2
-	addl2	r11,r2
-	adwc	$0,r3
-	movl	r2,(r9)+
-L1:	movl	(r8)+,r1
-	jlss	L1n1
-L1p1:	emul	r1,r6,$0,r10
-	addl2	r3,r10
-	adwc	$0,r11
-	movl	r10,(r9)+
-
-	sobgtr	r7,Loop1
-	movl	r11,r0
-	ret
-
-L1n0:	emul	r1,r6,$0,r2
-	addl2	r11,r2
-	adwc	r6,r3
-	movl	r2,(r9)+
-	movl	(r8)+,r1
-	jgeq	L1p1
-L1n1:	emul	r1,r6,$0,r10
-	addl2	r3,r10
-	adwc	r6,r11
-	movl	r10,(r9)+
-
-	sobgtr	r7,Loop1
-	movl	r11,r0
-	ret
-
-
-s2_big:	clrl	r3
-	incl	r4
-	ashl	$-1,r4,r7
-	jlbc	r4,L2
-	clrl	r11
-
-# Loop for S2_LIMB >= 0x80000000
-Loop2:	movl	(r8)+,r1
-	jlss	L2n0
-	emul	r1,r6,$0,r2
-	addl2	r11,r2
-	adwc	r1,r3
-	movl	r2,(r9)+
-L2:	movl	(r8)+,r1
-	jlss	L2n1
-L2p1:	emul	r1,r6,$0,r10
-	addl2	r3,r10
-	adwc	r1,r11
-	movl	r10,(r9)+
-
-	sobgtr	r7,Loop2
-	movl	r11,r0
-	ret
-
-L2n0:	emul	r1,r6,$0,r2
-	addl2	r1,r3
-	addl2	r11,r2
-	adwc	r6,r3
-	movl	r2,(r9)+
-	movl	(r8)+,r1
-	jgeq	L2p1
-L2n1:	emul	r1,r6,$0,r10
-	addl2	r1,r11
-	addl2	r3,r10
-	adwc	r6,r11
-	movl	r10,(r9)+
-
-	sobgtr	r7,Loop2
-	movl	r11,r0
-	ret
diff --git a/ghc/rts/gmp/mpn/vax/rshift.s b/ghc/rts/gmp/mpn/vax/rshift.s
deleted file mode 100644
index 515813208d..0000000000
--- a/ghc/rts/gmp/mpn/vax/rshift.s
+++ /dev/null
@@ -1,56 +0,0 @@
-# VAX __gmpn_rshift -- right shift.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# rptr		(sp + 4)
-# sptr		(sp + 8)
-# size		(sp + 12)
-# cnt		(sp + 16)
-# r0=retval r1=size r2,r3=itmp r4,r5=otmp	call-used registers
-# r6=sptr r7=rptr r8=cnt r9 r10 r11		call-saved registers
-
-.text
-	.align 1
-.globl ___gmpn_rshift
-___gmpn_rshift:
-	.word	0x1c0
-	movl	4(ap),r7
-	movl	8(ap),r6
-	movl	12(ap),r1
-	movl	16(ap),r8
-
-	movl	(r6)+,r2
-	subl3	r8,$32,r8
-	ashl	r8,r2,r0
-	decl	r1
-	jeql	Lend
-
-Loop:	movl	(r6)+,r3
-	ashq	r8,r2,r4
-	movl	r5,(r7)+
-	movl	r3,r2
-	jsobgtr	r1,Loop
-
-Lend:	clrl	r3
-	ashq	r8,r2,r4
-	movl	r5,(r7)
-	ret
diff --git a/ghc/rts/gmp/mpn/vax/sub_n.s b/ghc/rts/gmp/mpn/vax/sub_n.s
deleted file mode 100644
index eff4b1c044..0000000000
--- a/ghc/rts/gmp/mpn/vax/sub_n.s
+++ /dev/null
@@ -1,61 +0,0 @@
-# VAX __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and store
-# difference in a third limb vector.
-
-# Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	(sp + 4)
-# s1_ptr	(sp + 8)
-# s2_ptr	(sp + 12)
-# size		(sp + 16)
-
-.text
-	.align 1
-.globl ___gmpn_sub_n
-___gmpn_sub_n:
-	.word	0x0
-	movl	16(ap),r0
-	movl	12(ap),r1
-	movl	8(ap),r2
-	movl	4(ap),r3
-	mnegl	r0,r5
-	addl2	$3,r0
-	ashl	$-2,r0,r0	# unroll loop count
-	bicl2	$-4,r5		# mask out low 2 bits
-	movaq	(r5)[r5],r5	# 9x
-	jmp	Loop(r5)
-
-Loop:	movl	(r2)+,r4
-	sbwc	(r1)+,r4
-	movl	r4,(r3)+
-	movl	(r2)+,r4
-	sbwc	(r1)+,r4
-	movl	r4,(r3)+
-	movl	(r2)+,r4
-	sbwc	(r1)+,r4
-	movl	r4,(r3)+
-	movl	(r2)+,r4
-	sbwc	(r1)+,r4
-	movl	r4,(r3)+
-	sobgtr	r0,Loop
-
-	adwc	r0,r0
-	ret
diff --git a/ghc/rts/gmp/mpn/vax/submul_1.s b/ghc/rts/gmp/mpn/vax/submul_1.s
deleted file mode 100644
index be42286935..0000000000
--- a/ghc/rts/gmp/mpn/vax/submul_1.s
+++ /dev/null
@@ -1,126 +0,0 @@
-# VAX __gmpn_submul_1 -- Multiply a limb vector with a limb and subtract
-# the result from a second limb vector.
-
-# Copyright (C) 1992, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-# This file is part of the GNU MP Library.
-
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# INPUT PARAMETERS
-# res_ptr	(sp + 4)
-# s1_ptr	(sp + 8)
-# size		(sp + 12)
-# s2_limb	(sp + 16)
-
-.text
-	.align 1
-.globl ___gmpn_submul_1
-___gmpn_submul_1:
-	.word	0xfc0
-	movl	12(ap),r4
-	movl	8(ap),r8
-	movl	4(ap),r9
-	movl	16(ap),r6
-	jlss	s2_big
-
-	clrl	r3
-	incl	r4
-	ashl	$-1,r4,r7
-	jlbc	r4,L1
-	clrl	r11
-
-# Loop for S2_LIMB < 0x80000000
-Loop1:	movl	(r8)+,r1
-	jlss	L1n0
-	emul	r1,r6,$0,r2
-	addl2	r11,r2
-	adwc	$0,r3
-	subl2	r2,(r9)+
-	adwc	$0,r3
-L1:	movl	(r8)+,r1
-	jlss	L1n1
-L1p1:	emul	r1,r6,$0,r10
-	addl2	r3,r10
-	adwc	$0,r11
-	subl2	r10,(r9)+
-	adwc	$0,r11
-
-	sobgtr	r7,Loop1
-	movl	r11,r0
-	ret
-
-L1n0:	emul	r1,r6,$0,r2
-	addl2	r11,r2
-	adwc	r6,r3
-	subl2	r2,(r9)+
-	adwc	$0,r3
-	movl	(r8)+,r1
-	jgeq	L1p1
-L1n1:	emul	r1,r6,$0,r10
-	addl2	r3,r10
-	adwc	r6,r11
-	subl2	r10,(r9)+
-	adwc	$0,r11
-
-	sobgtr	r7,Loop1
-	movl	r11,r0
-	ret
-
-
-s2_big:	clrl	r3
-	incl	r4
-	ashl	$-1,r4,r7
-	jlbc	r4,L2
-	clrl	r11
-
-# Loop for S2_LIMB >= 0x80000000
-Loop2:	movl	(r8)+,r1
-	jlss	L2n0
-	emul	r1,r6,$0,r2
-	addl2	r11,r2
-	adwc	r1,r3
-	subl2	r2,(r9)+
-	adwc	$0,r3
-L2:	movl	(r8)+,r1
-	jlss	L2n1
-L2p1:	emul	r1,r6,$0,r10
-	addl2	r3,r10
-	adwc	r1,r11
-	subl2	r10,(r9)+
-	adwc	$0,r11
-
-	sobgtr	r7,Loop2
-	movl	r11,r0
-	ret
-
-L2n0:	emul	r1,r6,$0,r2
-	addl2	r11,r2
-	adwc	r6,r3
-	subl2	r2,(r9)+
-	adwc	r1,r3
-	movl	(r8)+,r1
-	jgeq	L2p1
-L2n1:	emul	r1,r6,$0,r10
-	addl2	r3,r10
-	adwc	r6,r11
-	subl2	r10,(r9)+
-	adwc	r1,r11
-
-	sobgtr	r7,Loop2
-	movl	r11,r0
-	ret
diff --git a/ghc/rts/gmp/mpn/x86/README b/ghc/rts/gmp/mpn/x86/README
deleted file mode 100644
index 3507548b8c..0000000000
--- a/ghc/rts/gmp/mpn/x86/README
+++ /dev/null
@@ -1,40 +0,0 @@
-
-                      X86 MPN SUBROUTINES
-
-
-This directory contains mpn functions for various 80x86 chips.
-
-
-CODE ORGANIZATION
-
-	x86              i386, i486, generic
-	x86/pentium      Intel Pentium (P5, P54)
-	x86/pentium/mmx  Intel Pentium with MMX (P55)
-	x86/p6           Intel Pentium Pro
-	x86/p6/mmx       Intel Pentium II, III
-	x86/p6/p3mmx     Intel Pentium III
-	x86/k6           AMD K6, K6-2, K6-3
-	x86/k6/mmx
-	x86/k6/k62mmx    AMD K6-2
-	x86/k7           AMD Athlon
-	x86/k7/mmx
-
-
-The x86 directory is also the main support for P6 at the moment, and
-is something of a blended style, meant to be reasonable on all x86s.
-
-	
-
-STATUS
-
-The code is well-optimized for AMD and Intel chips, but not so well
-optimized for Cyrix chips.
-
-
-
-RELEVANT OPTIMIZATION ISSUES
-
-For implementations with slow double shift instructions (SHLD and
-SHRD), it might be better to mimic their operation with SHL+SHR+OR.
-(M2 is likely to benefit from that, but not Pentium due to its slow
-plain SHL and SHR.)
diff --git a/ghc/rts/gmp/mpn/x86/README.family b/ghc/rts/gmp/mpn/x86/README.family
deleted file mode 100644
index 3bc73f58b0..0000000000
--- a/ghc/rts/gmp/mpn/x86/README.family
+++ /dev/null
@@ -1,333 +0,0 @@
-
-                    X86 CPU FAMILY MPN SUBROUTINES
-
-
-This file has some notes on things common to all the x86 family code.
-
-
-
-ASM FILES
-
-The x86 .asm files are BSD style x86 assembler code, first put through m4
-for macro processing.  The generic mpn/asm-defs.m4 is used, together with
-mpn/x86/x86-defs.m4.  Detailed notes are in those files.
-
-The code is meant for use with GNU "gas" or a system "as".  There's no
-support for assemblers that demand Intel style, and with gas freely
-available and easy to use that shouldn't be a problem.
-
-
-
-STACK FRAME
-
-m4 macros are used to define the parameters passed on the stack, and these
-act like comments on what the stack frame looks like too.  For example,
-mpn_mul_1() has the following.
-
-        defframe(PARAM_MULTIPLIER, 16)
-        defframe(PARAM_SIZE,       12)
-        defframe(PARAM_SRC,         8)
-        defframe(PARAM_DST,         4)
-
-Here PARAM_MULTIPLIER gets defined as `FRAME+16(%esp)', and the others
-similarly.  The return address is at offset 0, but there's not normally any
-need to access that.
-
-FRAME is redefined as necessary through the code so it's the number of bytes
-pushed on the stack, and hence the offsets in the parameter macros stay
-correct.  At the start of a routine FRAME should be zero.
-
-        deflit(`FRAME',0)
-	...
-	deflit(`FRAME',4)
-	...
-	deflit(`FRAME',8)
-	...
-
-Helper macros FRAME_pushl(), FRAME_popl(), FRAME_addl_esp() and
-FRAME_subl_esp() exist to adjust FRAME for the effect of those instructions,
-and can be used instead of explicit definitions if preferred.
-defframe_pushl() is a combination FRAME_pushl() and defframe().
-
-There's generally some slackness in redefining FRAME.  If new values aren't
-going to get used, then the redefinitions are omitted to keep from
-cluttering up the code.  This happens for instance at the end of a routine,
-where there might be just four register pops and then a ret, so FRAME isn't
-getting used.
-
-Local variables and saved registers can be similarly defined, with negative
-offsets representing stack space below the initial stack pointer.  For
-example,
-
-	defframe(SAVE_ESI,   -4)
-	defframe(SAVE_EDI,   -8)
-	defframe(VAR_COUNTER,-12)
-
-	deflit(STACK_SPACE, 12)
-
-Here STACK_SPACE gets used in a "subl $STACK_SPACE, %esp" to allocate the
-space, and that instruction must be followed by a redefinition of FRAME
-(setting it equal to STACK_SPACE) to reflect the change in %esp.
-
-Definitions for pushed registers are only put in when they're going to be
-used.  If registers are just saved and restored with pushes and pops then
-definitions aren't made.
-
-
-
-ASSEMBLER EXPRESSIONS
-
-Only addition and subtraction seem to be universally available, certainly
-that's all the Solaris 8 "as" seems to accept.  If expressions are wanted
-then m4 eval() should be used.
-
-In particular note that a "/" anywhere in a line starts a comment in Solaris
-"as", and in some configurations of gas too.
-
-	addl	$32/2, %eax           <-- wrong
-
-	addl	$eval(32/2), %eax     <-- right
-
-Binutils gas/config/tc-i386.c has a choice between "/" being a comment
-anywhere in a line, or only at the start.  FreeBSD patches 2.9.1 to select
-the latter, and as of 2.9.5 it's the default for GNU/Linux too.
-
-
-
-ASSEMBLER COMMENTS
-
-Solaris "as" doesn't support "#" commenting, using /* */ instead,
-unfortunately.  For that reason "C" commenting is used (see asm-defs.m4) and
-the intermediate ".s" files have no comments.
-
-
-
-ZERO DISPLACEMENTS
-
-In a couple of places addressing modes like 0(%ebx) with a byte-sized zero
-displacement are wanted, rather than (%ebx) with no displacement.  These are
-either for computed jumps or to get desirable code alignment.  Explicit
-.byte sequences are used to ensure the assembler doesn't turn 0(%ebx) into
-(%ebx).  The Zdisp() macro in x86-defs.m4 is used for this.
-
-Current gas 2.9.5 or recent 2.9.1 leave 0(%ebx) as written, but old gas
-1.92.3 changes it.  In general changing would be the sort of "optimization"
-an assembler might perform, hence explicit ".byte"s are used where
-necessary.
-
-
-
-SHLD/SHRD INSTRUCTIONS
-
-The %cl count forms of double shift instructions like "shldl %cl,%eax,%ebx"
-must be written "shldl %eax,%ebx" for some assemblers.  gas takes either,
-Solaris "as" doesn't allow %cl, gcc generates %cl for gas and NeXT (which is
-gas), and omits %cl elsewhere.
-
-For GMP an autoconf test is used to determine whether %cl should be used and
-the macros shldl, shrdl, shldw and shrdw in mpn/x86/x86-defs.m4 then pass
-through or omit %cl as necessary.  See comments with those macros for usage.
-
-
-
-DIRECTION FLAG
-
-The x86 calling conventions say that the direction flag should be clear at
-function entry and exit.  (See iBCS2 and SVR4 ABI books, references below.)
-
-Although this has been so since the year dot, it's not absolutely clear
-whether it's universally respected.  Since it's better to be safe than
-sorry, gmp follows glibc and does a "cld" if it depends on the direction
-flag being clear.  This happens only in a few places.
-
-
-
-POSITION INDEPENDENT CODE
-
-Defining the symbol PIC in m4 processing selects position independent code.
-This mainly affects computed jumps, and these are implemented in a
-self-contained fashion (without using the global offset table).  The few
-calls from assembly code to global functions use the normal procedure
-linkage table.
-
-PIC is necessary for ELF shared libraries because they can be mapped into
-different processes at different virtual addresses.  Text relocations in
-shared libraries are allowed, but that presumably means a page with such a
-relocation isn't shared.  The use of the PLT for PIC adds a fixed cost to
-every function call, which is small but might be noticeable when working with
-small operands.
-
-Calls from one library function to another don't need to go through the PLT,
-since of course the call instruction uses a displacement, not an absolute
-address, and the relative locations of object files are known when libgmp.so
-is created.  "ld -Bsymbolic" (or "gcc -Wl,-Bsymbolic") will resolve calls
-this way, so that there's no jump through the PLT, but of course leaving
-setups of the GOT address in %ebx that may be unnecessary.
-
-The %ebx setup could be avoided in assembly if a separate option controlled
-PIC for calls as opposed to computed jumps etc.  But there's only ever
-likely to be a handful of calls out of assembler, and getting the same
-optimization for C intra-library calls would be more important.  There seems
-no easy way to tell gcc that certain functions can be called non-PIC, and
-unfortunately many gmp functions use the global memory allocation variables,
-so they need the GOT anyway.  Object files with no global data references
-and only intra-library calls could go into the library as non-PIC under
--Bsymbolic.  Integrating this into libtool and automake is left as an
-exercise for the reader.
-
-
-
-SIMPLE LOOPS
-
-The overheads in setting up for an unrolled loop can mean that at small
-sizes a simple loop is faster.  Making small sizes go fast is important,
-even if it adds a cycle or two to bigger sizes.  To this end various
-routines choose between a simple loop and an unrolled loop according to
-operand size.  The path to the simple loop, or to special case code for
-small sizes, is always as fast as possible.
-
-Adding a simple loop requires a conditional jump to choose between the
-simple and unrolled code.  The size of a branch misprediction penalty
-affects whether a simple loop is worthwhile.
-
-The convention is for an m4 definition UNROLL_THRESHOLD to set the crossover
-point, with sizes < UNROLL_THRESHOLD using the simple loop, sizes >=
-UNROLL_THRESHOLD using the unrolled loop.  If position independent code adds
-a couple of cycles to an unrolled loop setup, the threshold will vary with
-PIC or non-PIC.  Something like the following is typical.
-
-	ifdef(`PIC',`
-	deflit(UNROLL_THRESHOLD, 10)
-	',`
-	deflit(UNROLL_THRESHOLD, 8)
-	')
-
-There's no automated way to determine the threshold.  Setting it to a small
-value and then to a big value makes it possible to measure the simple and
-unrolled loops each over a range of sizes, from which the crossover point
-can be determined.  Alternately, just adjust the threshold up or down until
-there's no more speedups.
-
-
-
-UNROLLED LOOP CODING
-
-The x86 addressing modes allow a byte displacement of -128 to +127, making
-it possible to access 256 bytes, which is 64 limbs, without adjusting
-pointer registers within the loop.  Dword sized displacements can be used
-too, but they increase code size, and unrolling to 64 ought to be enough.
-
-When unrolling to the full 64 limbs/loop, the limb at the top of the loop
-will have a displacement of -128, so pointers have to have a corresponding
-+128 added before entering the loop.  When unrolling to 32 limbs/loop
-displacements 0 to 127 can be used with 0 at the top of the loop and no
-adjustment needed to the pointers.
-
-Where 64 limbs/loop is supported, the +128 adjustment is done only when 64
-limbs/loop is selected.  Usually the gain in speed using 64 instead of 32 or
-16 is small, so support for 64 limbs/loop is generally only for comparison.
-
-
-
-COMPUTED JUMPS
-
-When working from least significant limb to most significant limb (most
-routines) the computed jump and pointer calculations in preparation for an
-unrolled loop are as follows.
-
-	S = operand size in limbs
-	N = number of limbs per loop (UNROLL_COUNT)
-	L = log2 of unrolling (UNROLL_LOG2)
-	M = mask for unrolling (UNROLL_MASK)
-	C = code bytes per limb in the loop
-	B = bytes per limb (4 for x86)
-	
-	computed jump            (-S & M) * C + entrypoint
-	subtract from pointers   (-S & M) * B
-	initial loop counter     (S-1) >> L
-	displacements            0 to B*(N-1)
-
-The loop counter is decremented at the end of each loop, and the looping
-stops when the decrement takes the counter to -1.  The displacements are for
-the addressing accessing each limb, eg. a load with "movl disp(%ebx), %eax".
-
-Usually the multiply by "C" can be handled without an imul, using instead an
-leal, or a shift and subtract.
-
-When working from most significant to least significant limb (eg. mpn_lshift
-and mpn_copyd), the calculations change as follows.
-
-	add to pointers          (-S & M) * B
-	displacements            0 to -B*(N-1)
-
-
-
-OLD GAS 1.92.3
-
-This version comes with FreeBSD 2.2.8 and has a couple of gremlins that
-affect gmp code.
-
-Firstly, an expression involving two forward references to labels comes out
-as zero.  For example,
-
-		addl	$bar-foo, %eax
-	foo:
-		nop
-	bar:
-
-This should lead to "addl $1, %eax", but it comes out as "addl $0, %eax".
-When only one forward reference is involved, it works correctly, as for
-example,
-
-	foo:
-		addl	$bar-foo, %eax
-		nop
-	bar:
-
-Secondly, an expression involving two labels can't be used as the
-displacement for an leal.  For example,
-
-	foo:
-		nop
-	bar:
-		leal	bar-foo(%eax,%ebx,8), %ecx
-
-A slightly cryptic error is given, "Unimplemented segment type 0 in
-parse_operand".  When only one label is used it's ok, and the label can be a
-forward reference too, as for example,
-
-		leal	foo(%eax,%ebx,8), %ecx
-		nop
-	foo:
-
-These problems only affect PIC computed jump calculations.  The workarounds
-are just to do an leal without a displacement and then an addl, and to make
-sure the code is placed so that there's at most one forward reference in the
-addl.
-
-
-
-REFERENCES
-
-"Intel Architecture Software Developer's Manual", volumes 1 to 3, 1999,
-order numbers 243190, 243191 and 243192.  Available on-line,
-
-	ftp://download.intel.com/design/PentiumII/manuals/243190.htm
-	ftp://download.intel.com/design/PentiumII/manuals/243191.htm
-	ftp://download.intel.com/design/PentiumII/manuals/243192.htm
-
-"Intel386 Family Binary Compatibility Specification 2", Intel Corporation,
-published by McGraw-Hill, 1991, ISBN 0-07-031219-2.
-
-"System V Application Binary Interface", Unix System Laboratories Inc, 1992,
-published by Prentice Hall, ISBN 0-13-880410-9.  And the "Intel386 Processor
-Supplement", AT&T, 1991, ISBN 0-13-877689-X.  (These have details of ELF
-shared library PIC coding.)
-
-
-
-----------------
-Local variables:
-mode: text
-fill-column: 76
-End:
diff --git a/ghc/rts/gmp/mpn/x86/addsub_n.S b/ghc/rts/gmp/mpn/x86/addsub_n.S
deleted file mode 100644
index fe6f648f53..0000000000
--- a/ghc/rts/gmp/mpn/x86/addsub_n.S
+++ /dev/null
@@ -1,174 +0,0 @@
-/* Currently not working and not used. */
-
-/*
-Copyright (C) 1999 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-
-#define SAVE_BORROW_RESTORE_CARRY(r)	adcl r,r; shll $31,r
-#define SAVE_CARRY_RESTORE_BORROW(r)	adcl r,r
-
-	.globl	mpn_addsub_n_0
-	.globl	mpn_addsub_n_1
-
-/* Cute i386/i486/p6 addsub loop for the "full overlap" case r1==s2,r2==s1.
-   We let subtraction and addition alternate in being two limbs
-   ahead of the other, thereby avoiding some SAVE_RESTORE. */
-// r1 = r2 + r1    edi = esi + edi
-// r2 = r2 - r1    esi = esi - edi
-//			s1  s2
-//	                r2  r1
-//	eax,ebx,ecx,edx,esi,edi,ebp
-mpn_addsub_n_0:
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-	pushl	%ebp
-
-	movl	20(%esp),%edi		/* res_ptr */
-	movl	24(%esp),%esi		/* s1_ptr */
-	movl	36(%esp),%ebp		/* size */
-
-	shrl	$2,%ebp
-	xorl	%edx,%edx
-	.align	4
-Loop0:				// L=load E=execute S=store
-	movl	(%esi),%ebx	// sub 0 L
-	movl	4(%esi),%ecx	// sub 1 L
-	sbbl	(%edi),%ebx	// sub 0 LE
-	sbbl	4(%edi),%ecx	// sub 1 LE
-//	SAVE_BORROW_RESTORE_CARRY(%edx)
-	movl	(%esi),%eax	// add 0 L
-	adcl	%eax,(%edi)	// add 0 LES
-	movl	4(%esi),%eax	// add 1 L
-	adcl	%eax,4(%edi)	// add 1 LES
-	movl	%ebx,(%esi)	// sub 0 S
-	movl	%ecx,4(%esi)	// sub 1 S
-	movl	8(%esi),%ebx	// add 2 L
-	adcl	8(%edi),%ebx	// add 2 LE
-	movl	12(%esi),%ecx	// add 3 L
-	adcl	12(%edi),%ecx	// add 3 LE
-//	SAVE_CARRY_RESTORE_BORROW(%edx)
-	movl	8(%edi),%eax	// sub 2 L
-	sbbl	%eax,8(%esi)	// sub 2 LES
-	movl	12(%edi),%eax	// sub 3 L
-	sbbl	%eax,12(%esi)	// sub 3 LES
-	movl	%ebx,8(%edi)	// add 2 S
-	movl	%ecx,12(%edi)	// add 3 S
-	leal	16(%esi),%esi
-	leal	16(%edi),%edi
-	decl	%ebp
-	jnz	Loop0
-
-	popl	%ebp
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-/* Cute i386/i486/p6 addsub loop for the "full overlap" case r1==s1,r2==s2.
-   We let subtraction and addition alternate in being two limbs
-   ahead of the other, thereby avoiding some SAVE_RESTORE. */
-// r1 = r1 + r2    edi = edi + esi
-// r2 = r1 - r2    esi = edi - esi
-//			s2  s1
-//	                r2  r1
-//	eax,ebx,ecx,edx,esi,edi,ebp
-mpn_addsub_n_1:
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-	pushl	%ebp
-
-	movl	20(%esp),%edi		/* res_ptr */
-	movl	24(%esp),%esi		/* s1_ptr */
-	movl	36(%esp),%ebp		/* size */
-
-	shrl	$2,%ebp
-	xorl	%edx,%edx
-	.align	4
-Loop1:				// L=load E=execute S=store
-	movl	(%edi),%ebx	// sub 0 L
-	sbbl	(%esi),%ebx	// sub 0 LE
-	movl	4(%edi),%ecx	// sub 1 L
-	sbbl	4(%esi),%ecx	// sub 1 LE
-//	SAVE_BORROW_RESTORE_CARRY(%edx)
-	movl	(%esi),%eax	// add 0 L
-	adcl	%eax,(%edi)	// add 0 LES
-	movl	4(%esi),%eax	// add 1 L
-	adcl	%eax,4(%edi)	// add 1 LES
-	movl	%ebx,(%esi)	// sub 0 S
-	movl	%ecx,4(%esi)	// sub 1 S
-	movl	8(%esi),%ebx	// add 2 L
-	adcl	8(%edi),%ebx	// add 2 LE
-	movl	12(%esi),%ecx	// add 3 L
-	adcl	12(%edi),%ecx	// add 3 LE
-//	SAVE_CARRY_RESTORE_BORROW(%edx)
-	movl	8(%edi),%eax	// sub 2 L
-	sbbl	8(%esi),%eax	// sub 2 LES
-	movl	%eax,8(%esi)	// sub 2 S
-	movl	12(%edi),%eax	// sub 3 L
-	sbbl	12(%esi),%eax	// sub 3 LE
-	movl	%eax,12(%esi)	// sub 3 S
-	movl	%ebx,8(%edi)	// add 2 S
-	movl	%ecx,12(%edi)	// add 3 S
-	leal	16(%esi),%esi
-	leal	16(%edi),%edi
-	decl	%ebp
-	jnz	Loop1
-
-	popl	%ebp
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-	.globl	mpn_copy
-mpn_copy:
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-	pushl	%ebp
-
-	movl	20(%esp),%edi		/* res_ptr */
-	movl	24(%esp),%esi		/* s1_ptr */
-	movl	28(%esp),%ebp		/* size */
-
-	shrl	$2,%ebp
-	.align	4
-Loop2:
-	movl	(%esi),%eax
-	movl	4(%esi),%ebx
-	movl	%eax,(%edi)
-	movl	%ebx,4(%edi)
-	movl	8(%esi),%eax
-	movl	12(%esi),%ebx
-	movl	%eax,8(%edi)
-	movl	%ebx,12(%edi)
-	leal	16(%esi),%esi
-	leal	16(%edi),%edi
-	decl	%ebp
-	jnz	Loop2
-
-	popl	%ebp
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
diff --git a/ghc/rts/gmp/mpn/x86/aors_n.asm b/ghc/rts/gmp/mpn/x86/aors_n.asm
deleted file mode 100644
index 18ef816b4d..0000000000
--- a/ghc/rts/gmp/mpn/x86/aors_n.asm
+++ /dev/null
@@ -1,187 +0,0 @@
-dnl  x86 mpn_add_n/mpn_sub_n -- mpn addition and subtraction.
-
-dnl  Copyright (C) 1992, 1994, 1995, 1996, 1999, 2000 Free Software
-dnl  Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-ifdef(`OPERATION_add_n',`
-	define(M4_inst,        adcl)
-	define(M4_function_n,  mpn_add_n)
-	define(M4_function_nc, mpn_add_nc)
-
-',`ifdef(`OPERATION_sub_n',`
-	define(M4_inst,        sbbl)
-	define(M4_function_n,  mpn_sub_n)
-	define(M4_function_nc, mpn_sub_nc)
-
-',`m4_error(`Need OPERATION_add_n or OPERATION_sub_n
-')')')
-
-MULFUNC_PROLOGUE(mpn_add_n mpn_add_nc mpn_sub_n mpn_sub_nc)
-
-
-C mp_limb_t M4_function_n (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
-C                          mp_size_t size);
-C mp_limb_t M4_function_nc (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
-C	                    mp_size_t size, mp_limb_t carry);
-
-defframe(PARAM_CARRY,20)
-defframe(PARAM_SIZE, 16)
-defframe(PARAM_SRC2, 12)
-defframe(PARAM_SRC1, 8)
-defframe(PARAM_DST,  4)
-
-	.text
-	ALIGN(8)
-
-PROLOGUE(M4_function_nc)
-deflit(`FRAME',0)
-
-	pushl	%edi		FRAME_pushl()
-	pushl	%esi		FRAME_pushl()
-
-	movl	PARAM_DST,%edi
-	movl	PARAM_SRC1,%esi
-	movl	PARAM_SRC2,%edx
-	movl	PARAM_SIZE,%ecx
-
-	movl	%ecx,%eax
-	shrl	$3,%ecx			C compute count for unrolled loop
-	negl	%eax
-	andl	$7,%eax			C get index where to start loop
-	jz	LF(M4_function_n,oopgo)	C necessary special case for 0
-	incl	%ecx			C adjust loop count
-	shll	$2,%eax			C adjustment for pointers...
-	subl	%eax,%edi		C ... since they are offset ...
-	subl	%eax,%esi		C ... by a constant when we ...
-	subl	%eax,%edx		C ... enter the loop
-	shrl	$2,%eax			C restore previous value
-
-ifdef(`PIC',`
-	C Calculate start address in loop for PIC.  Due to limitations in
-	C old gas, LF(M4_function_n,oop)-L(0a)-3 cannot be put into the leal
-	call	L(0a)
-L(0a):	leal	(%eax,%eax,8),%eax
-	addl	(%esp),%eax
-	addl	$LF(M4_function_n,oop)-L(0a)-3,%eax
-	addl	$4,%esp
-',`
-	C Calculate start address in loop for non-PIC.
- 	leal	LF(M4_function_n,oop)-3(%eax,%eax,8),%eax
-')
-
-	C These lines initialize carry from the 5th parameter.  Should be
-	C possible to simplify.
-	pushl	%ebp		FRAME_pushl()
-	movl	PARAM_CARRY,%ebp
-	shrl	$1,%ebp			C shift bit 0 into carry
-	popl	%ebp		FRAME_popl()
-
-	jmp	*%eax			C jump into loop
-
-EPILOGUE()
-
-
-	ALIGN(8)
-PROLOGUE(M4_function_n)
-deflit(`FRAME',0)
-
-	pushl	%edi		FRAME_pushl()
-	pushl	%esi		FRAME_pushl()
-
-	movl	PARAM_DST,%edi
-	movl	PARAM_SRC1,%esi
-	movl	PARAM_SRC2,%edx
-	movl	PARAM_SIZE,%ecx
-
-	movl	%ecx,%eax
-	shrl	$3,%ecx			C compute count for unrolled loop
-	negl	%eax
-	andl	$7,%eax			C get index where to start loop
-	jz	L(oop)			C necessary special case for 0
-	incl	%ecx			C adjust loop count
-	shll	$2,%eax			C adjustment for pointers...
-	subl	%eax,%edi		C ... since they are offset ...
-	subl	%eax,%esi		C ... by a constant when we ...
-	subl	%eax,%edx		C ... enter the loop
-	shrl	$2,%eax			C restore previous value
-
-ifdef(`PIC',`
-	C Calculate start address in loop for PIC.  Due to limitations in
-	C some assemblers, L(oop)-L(0b)-3 cannot be put into the leal
-	call	L(0b)
-L(0b):	leal	(%eax,%eax,8),%eax
-	addl	(%esp),%eax
-	addl	$L(oop)-L(0b)-3,%eax
-	addl	$4,%esp
-',`
-	C Calculate start address in loop for non-PIC.
- 	leal	L(oop)-3(%eax,%eax,8),%eax
-')
-	jmp	*%eax			C jump into loop
-
-L(oopgo):
-	pushl	%ebp		FRAME_pushl()
-	movl	PARAM_CARRY,%ebp
-	shrl	$1,%ebp			C shift bit 0 into carry
-	popl	%ebp		FRAME_popl()
-
-	ALIGN(8)
-L(oop):	movl	(%esi),%eax
-	M4_inst	(%edx),%eax
-	movl	%eax,(%edi)
-	movl	4(%esi),%eax
-	M4_inst	4(%edx),%eax
-	movl	%eax,4(%edi)
-	movl	8(%esi),%eax
-	M4_inst	8(%edx),%eax
-	movl	%eax,8(%edi)
-	movl	12(%esi),%eax
-	M4_inst	12(%edx),%eax
-	movl	%eax,12(%edi)
-	movl	16(%esi),%eax
-	M4_inst	16(%edx),%eax
-	movl	%eax,16(%edi)
-	movl	20(%esi),%eax
-	M4_inst	20(%edx),%eax
-	movl	%eax,20(%edi)
-	movl	24(%esi),%eax
-	M4_inst	24(%edx),%eax
-	movl	%eax,24(%edi)
-	movl	28(%esi),%eax
-	M4_inst	28(%edx),%eax
-	movl	%eax,28(%edi)
-	leal	32(%edi),%edi
-	leal	32(%esi),%esi
-	leal	32(%edx),%edx
-	decl	%ecx
-	jnz	L(oop)
-
-	sbbl	%eax,%eax
-	negl	%eax
-
-	popl	%esi
-	popl	%edi
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/aorsmul_1.asm b/ghc/rts/gmp/mpn/x86/aorsmul_1.asm
deleted file mode 100644
index f32ad83989..0000000000
--- a/ghc/rts/gmp/mpn/x86/aorsmul_1.asm
+++ /dev/null
@@ -1,134 +0,0 @@
-dnl  x86 __gmpn_addmul_1 (for 386 and 486) -- Multiply a limb vector with a
-dnl  limb and add the result to a second limb vector.
-
-
-dnl  Copyright (C) 1992, 1994, 1997, 1999, 2000 Free Software Foundation,
-dnl  Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-ifdef(`OPERATION_addmul_1',`
-      define(M4_inst,        addl)
-      define(M4_function_1,  mpn_addmul_1)
-
-',`ifdef(`OPERATION_submul_1',`
-      define(M4_inst,        subl)
-      define(M4_function_1,  mpn_submul_1)
-
-',`m4_error(`Need OPERATION_addmul_1 or OPERATION_submul_1
-')')')
-
-MULFUNC_PROLOGUE(mpn_addmul_1 mpn_submul_1)
-
-
-C mp_limb_t M4_function_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                          mp_limb_t mult);
-
-define(PARAM_MULTIPLIER, `FRAME+16(%esp)')
-define(PARAM_SIZE,       `FRAME+12(%esp)')
-define(PARAM_SRC,        `FRAME+8(%esp)')
-define(PARAM_DST,        `FRAME+4(%esp)')
-
-	TEXT
-	ALIGN(8)
-
-PROLOGUE(M4_function_1)
-deflit(`FRAME',0)
-
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-	pushl	%ebp
-deflit(`FRAME',16)
-
-	movl	PARAM_DST,%edi
-	movl	PARAM_SRC,%esi
-	movl	PARAM_SIZE,%ecx
-
-	xorl	%ebx,%ebx
-	andl	$3,%ecx
-	jz	L(end0)
-
-L(oop0):
-	movl	(%esi),%eax
-	mull	PARAM_MULTIPLIER
-	leal	4(%esi),%esi
-	addl	%ebx,%eax
-	movl	$0,%ebx
-	adcl	%ebx,%edx
-	M4_inst	%eax,(%edi)
-	adcl	%edx,%ebx	C propagate carry into cylimb
-
-	leal	4(%edi),%edi
-	decl	%ecx
-	jnz	L(oop0)
-
-L(end0):
-	movl	PARAM_SIZE,%ecx
-	shrl	$2,%ecx
-	jz	L(end)
-
-	ALIGN(8)
-L(oop):	movl	(%esi),%eax
-	mull	PARAM_MULTIPLIER
-	addl	%eax,%ebx
-	movl	$0,%ebp
-	adcl	%edx,%ebp
-
-	movl	4(%esi),%eax
-	mull	PARAM_MULTIPLIER
-	M4_inst	%ebx,(%edi)
-	adcl	%eax,%ebp	C new lo + cylimb
-	movl	$0,%ebx
-	adcl	%edx,%ebx
-
-	movl	8(%esi),%eax
-	mull	PARAM_MULTIPLIER
-	M4_inst	%ebp,4(%edi)
-	adcl	%eax,%ebx	C new lo + cylimb
-	movl	$0,%ebp
-	adcl	%edx,%ebp
-
-	movl	12(%esi),%eax
-	mull	PARAM_MULTIPLIER
-	M4_inst	%ebx,8(%edi)
-	adcl	%eax,%ebp	C new lo + cylimb
-	movl	$0,%ebx
-	adcl	%edx,%ebx
-
-	M4_inst	%ebp,12(%edi)
-	adcl	$0,%ebx		C propagate carry into cylimb
-
-	leal	16(%esi),%esi
-	leal	16(%edi),%edi
-	decl	%ecx
-	jnz	L(oop)
-
-L(end):	movl	%ebx,%eax
-
-	popl	%ebp
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/copyd.asm b/ghc/rts/gmp/mpn/x86/copyd.asm
deleted file mode 100644
index 439640e836..0000000000
--- a/ghc/rts/gmp/mpn/x86/copyd.asm
+++ /dev/null
@@ -1,80 +0,0 @@
-dnl  x86 mpn_copyd -- copy limb vector, decrementing.
-dnl 
-dnl  Future: On P6 an MMX loop should be able to go faster than this code.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C void mpn_copyd (mp_ptr dst, mp_srcptr src, mp_size_t size);
-C
-C Copy src,size to dst,size, working from high to low addresses.
-C
-C The code here is very generic and can be expected to be reasonable on all
-C the x86 family.
-C
-C P5 - 1.0 cycles/limb.
-C
-C P6 - 2.4 cycles/limb, approx 40 cycles startup.
-
-defframe(PARAM_SIZE,12)
-defframe(PARAM_SRC, 8)
-defframe(PARAM_DST, 4)
-deflit(`FRAME',0)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_copyd)
-	C eax	saved esi
-	C ebx
-	C ecx	counter
-	C edx	saved edi
-	C esi	src
-	C edi	dst
-	C ebp
-
-	movl	PARAM_SIZE, %ecx
-	movl	%esi, %eax
-
-	movl	PARAM_SRC, %esi
-	movl	%edi, %edx
-
-	movl	PARAM_DST, %edi
-	leal	-4(%esi,%ecx,4), %esi
-
-	leal	-4(%edi,%ecx,4), %edi
-	
-	std
-
-	rep
-	movsl
-
-	cld
-
-	movl	%eax, %esi
-	movl	%edx, %edi
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/copyi.asm b/ghc/rts/gmp/mpn/x86/copyi.asm
deleted file mode 100644
index 5bc4e36689..0000000000
--- a/ghc/rts/gmp/mpn/x86/copyi.asm
+++ /dev/null
@@ -1,79 +0,0 @@
-dnl  x86 mpn_copyi -- copy limb vector, incrementing.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C void mpn_copyi (mp_ptr dst, mp_srcptr src, mp_size_t size);
-C
-C Copy src,size to dst,size, working from low to high addresses.
-C
-C The code here is very generic and can be expected to be reasonable on all
-C the x86 family.
-C
-C P5 - 1.0 cycles/limb.
-C
-C P6 - 0.75 cycles/limb.  An MMX based copy was tried, but was found to be
-C      slower than a rep movs in all cases.  The fastest MMX found was 0.8
-C      cycles/limb (when fully aligned).  A rep movs seems to have a startup
-C      time of about 15 cycles, but doing something special for small sizes
-C      could lead to a branch misprediction that would destroy any saving.
-C      For now a plain rep movs seems ok for P6.
-
-defframe(PARAM_SIZE,12)
-defframe(PARAM_SRC, 8)
-defframe(PARAM_DST, 4)
-deflit(`FRAME',0)
-
-	.text
-	ALIGN(32)
-
-	C eax	saved esi
-	C ebx
-	C ecx	counter
-	C edx	saved edi
-	C esi	src
-	C edi	dst
-	C ebp
-
-PROLOGUE(mpn_copyi)
-
-	movl	PARAM_SIZE, %ecx
-	movl	%esi, %eax
-
-	movl	PARAM_SRC, %esi
-	movl	%edi, %edx
-
-	movl	PARAM_DST, %edi
-
-	cld	C better safe than sorry, see mpn/x86/README.family
-
-	rep
-	movsl
-
-	movl	%eax, %esi
-	movl	%edx, %edi
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/diveby3.asm b/ghc/rts/gmp/mpn/x86/diveby3.asm
deleted file mode 100644
index df879da9e1..0000000000
--- a/ghc/rts/gmp/mpn/x86/diveby3.asm
+++ /dev/null
@@ -1,115 +0,0 @@
-dnl  x86 mpn_divexact_by3 -- mpn division by 3, expecting no remainder.
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-dnl  The following all have their own optimized versions of this routine,
-dnl  but for reference the code here runs as follows.
-dnl
-dnl       cycles/limb
-dnl  P54     18.0
-dnl  P55     17.0
-dnl  P6      14.5
-dnl  K6      14.0
-dnl  K7      10.0
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_divexact_by3c (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                              mp_limb_t carry);
-
-defframe(PARAM_CARRY,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,   8)
-defframe(PARAM_DST,   4)
-
-dnl  multiplicative inverse of 3, modulo 2^32
-deflit(INVERSE_3,       0xAAAAAAAB)
-
-dnl  ceil(b/3) and ceil(b*2/3) where b=2^32
-deflit(ONE_THIRD_CEIL,  0x55555556)
-deflit(TWO_THIRDS_CEIL, 0xAAAAAAAB)
-
-	.text
-	ALIGN(8)
-
-PROLOGUE(mpn_divexact_by3c)
-deflit(`FRAME',0)
-
-	movl	PARAM_SRC, %ecx
-	pushl	%ebp		FRAME_pushl()
-
-	movl	PARAM_SIZE, %ebp
-	pushl	%edi		FRAME_pushl()
-
-	movl	PARAM_DST, %edi
-	pushl	%esi		FRAME_pushl()
-
-	movl	$INVERSE_3, %esi
-	pushl	%ebx		FRAME_pushl()
-
-	leal	(%ecx,%ebp,4), %ecx
-	movl	PARAM_CARRY, %ebx
-
-	leal	(%edi,%ebp,4), %edi
-	negl	%ebp
-
-
-	ALIGN(8)
-L(top):
-	C eax	scratch, low product
-	C ebx	carry limb (0 to 3)
-	C ecx	&src[size]
-	C edx	scratch, high product
-	C esi	multiplier
-	C edi	&dst[size]
-	C ebp	counter, limbs, negative
-
-	movl	(%ecx,%ebp,4), %eax
-
-	subl	%ebx, %eax
-
-	setc	%bl
-
-	imull	%esi
-
-	cmpl	$ONE_THIRD_CEIL, %eax
-	movl	%eax, (%edi,%ebp,4)
-
-	sbbl	$-1, %ebx	C +1 if eax>=ceil(b/3)
-	cmpl	$TWO_THIRDS_CEIL, %eax
-
-	sbbl	$-1, %ebx	C +1 if eax>=ceil(b*2/3)
-	incl	%ebp
-
-	jnz	L(top)
-
-
-	movl	%ebx, %eax
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	popl	%ebp
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/divrem_1.asm b/ghc/rts/gmp/mpn/x86/divrem_1.asm
deleted file mode 100644
index 12f14676d6..0000000000
--- a/ghc/rts/gmp/mpn/x86/divrem_1.asm
+++ /dev/null
@@ -1,232 +0,0 @@
-dnl  x86 mpn_divrem_1 -- mpn by limb division extending to fractional quotient.
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-dnl        cycles/limb
-dnl  K6        20
-dnl  P5        44
-dnl  P6        39
-dnl  486   approx 43 maybe
-dnl
-dnl
-dnl  The following have their own optimized divrem_1 implementations, but
-dnl  for reference the code here runs as follows.
-dnl
-dnl        cycles/limb
-dnl  P6MMX     39
-dnl  K7        42
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_divrem_1 (mp_ptr dst, mp_size_t xsize,
-C                         mp_srcptr src, mp_size_t size, mp_limb_t divisor);
-C mp_limb_t mpn_divrem_1c (mp_ptr dst, mp_size_t xsize,
-C                          mp_srcptr src, mp_size_t size, mp_limb_t divisor);
-C
-C Divide src,size by divisor and store the quotient in dst+xsize,size.
-C Extend the division to fractional quotient limbs in dst,xsize.  Return the
-C remainder.  Either or both xsize and size can be 0.
-C
-C mpn_divrem_1c takes a carry parameter which is an initial high limb,
-C effectively one extra limb at the top of src,size.  Must have
-C carry<divisor.
-C
-C
-C Essentially the code is the same as the division based part of
-C mpn/generic/divrem_1.c, but has the following advantages.
-C
-C - If gcc isn't being used then divrem_1.c will get the generic C
-C   udiv_qrnnd() and be rather slow.
-C
-C - On K6, using the loop instruction is a 10% speedup, but gcc doesn't
-C   generate that instruction (as of gcc 2.95.2 at least).
-C
-C A test is done to see if the high limb is less the the divisor, and if so
-C one less div is done.  A div is between 20 and 40 cycles on the various
-C x86s, so assuming high<divisor about half the time, then this test saves
-C half that amount.  The branch misprediction penalty on each chip is less
-C than half a div.
-C  	
-C
-C K6: Back-to-back div instructions run at 20 cycles, the same as the loop
-C     here, so it seems there's nothing to gain by rearranging the loop.
-C     Pairing the mov and loop instructions was found to gain nothing.  (The
-C     same is true of the mpn/x86/mod_1.asm loop.)
-C
-C     With a "decl/jnz" rather than a "loop" this code runs at 22 cycles.
-C     The loop_or_decljnz macro is an easy way to get a 10% speedup.
-C
-C     The fast K6 multiply might be thought to suit a multiply-by-inverse,
-C     but that algorithm has been found to suffer from the releatively poor
-C     carry handling on K6 and too many auxiliary instructions.  The
-C     fractional part however could be done at about 13 c/l.
-C
-C P5: Moving the load down to pair with the store might save 1 cycle, but
-C     that doesn't seem worth bothering with, since it'd be only a 2.2%
-C     saving.
-C
-C     Again here the auxiliary instructions hinder a multiply-by-inverse,
-C     though there might be a 10-15% speedup available
-
-
-defframe(PARAM_CARRY,  24)
-defframe(PARAM_DIVISOR,20)
-defframe(PARAM_SIZE,   16)
-defframe(PARAM_SRC,    12)
-defframe(PARAM_XSIZE,  8)
-defframe(PARAM_DST,    4)
-
-	.text
-	ALIGN(16)
-
-PROLOGUE(mpn_divrem_1c)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	pushl	%edi		FRAME_pushl()
-	
-	movl	PARAM_SRC, %edi
-	pushl	%esi		FRAME_pushl()
-
-	movl	PARAM_DIVISOR, %esi
-	pushl	%ebx		FRAME_pushl()
-
-	movl	PARAM_DST, %ebx
-	pushl	%ebp		FRAME_pushl()
-
-	movl	PARAM_XSIZE, %ebp
-	orl	%ecx, %ecx
-
-	movl	PARAM_CARRY, %edx
-	jz	LF(mpn_divrem_1,fraction)
-
-	leal	-4(%ebx,%ebp,4), %ebx	C dst one limb below integer part
-	jmp	LF(mpn_divrem_1,integer_top)
-
-EPILOGUE()
-
-
-PROLOGUE(mpn_divrem_1)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	pushl	%edi		FRAME_pushl()
-	
-	movl	PARAM_SRC, %edi
-	pushl	%esi		FRAME_pushl()
-
-	movl	PARAM_DIVISOR, %esi
-	orl	%ecx,%ecx
-
-	jz	L(size_zero)
-	pushl	%ebx		FRAME_pushl()
-
-	movl	-4(%edi,%ecx,4), %eax	C src high limb
-	xorl	%edx, %edx
-
-	movl	PARAM_DST, %ebx
-	pushl	%ebp		FRAME_pushl()
-
-	movl	PARAM_XSIZE, %ebp
-	cmpl	%esi, %eax
-
-	leal	-4(%ebx,%ebp,4), %ebx	C dst one limb below integer part
-	jae	L(integer_entry)
-
-
-	C high<divisor, so high of dst is zero, and avoid one div
-
-	movl	%edx, (%ebx,%ecx,4)
-	decl	%ecx
-
-	movl	%eax, %edx
-	jz	L(fraction)
-
-
-L(integer_top):
-	C eax	scratch (quotient)
-	C ebx	dst+4*xsize-4
-	C ecx	counter
-	C edx	scratch (remainder)
-	C esi	divisor
-	C edi	src
-	C ebp	xsize
-
-	movl	-4(%edi,%ecx,4), %eax
-L(integer_entry):
-
-	divl	%esi
-
-	movl	%eax, (%ebx,%ecx,4)
-	loop_or_decljnz	L(integer_top)
-
-
-L(fraction):
-	orl	%ebp, %ecx
-	jz	L(done)
-
-	movl	PARAM_DST, %ebx
-
-
-L(fraction_top):
-	C eax	scratch (quotient)
-	C ebx	dst
-	C ecx	counter
-	C edx	scratch (remainder)
-	C esi	divisor
-	C edi
-	C ebp
-
-	xorl	%eax, %eax
-
-	divl	%esi
-
-	movl	%eax, -4(%ebx,%ecx,4)
-	loop_or_decljnz	L(fraction_top)
-
-
-L(done):
-	popl	%ebp
-	movl	%edx, %eax
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-
-L(size_zero):
-deflit(`FRAME',8)
-	movl	PARAM_XSIZE, %ecx
-	xorl	%eax, %eax
-
-	movl	PARAM_DST, %edi
-
-	cld	C better safe than sorry, see mpn/x86/README.family
-
-	rep
-	stosl
-
-	popl	%esi
-	popl	%edi
-	ret
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/README b/ghc/rts/gmp/mpn/x86/k6/README
deleted file mode 100644
index 3ad96c8b89..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/README
+++ /dev/null
@@ -1,237 +0,0 @@
-
-			AMD K6 MPN SUBROUTINES
-
-
-
-This directory contains code optimized for AMD K6 CPUs, meaning K6, K6-2 and
-K6-3.
-
-The mmx and k62mmx subdirectories have routines using MMX instructions.  All
-K6s have MMX, the separate directories are just so that ./configure can omit
-them if the assembler doesn't support MMX.
-
-
-
-
-STATUS
-
-Times for the loops, with all code and data in L1 cache, are as follows.
-
-                                 cycles/limb
-
-	mpn_add_n/sub_n            3.25 normal, 2.75 in-place
-
-	mpn_mul_1                  6.25
-	mpn_add/submul_1           7.65-8.4  (varying with data values)
-
-	mpn_mul_basecase           9.25 cycles/crossproduct (approx)
-	mpn_sqr_basecase           4.7  cycles/crossproduct (approx)
-                                   or 9.2 cycles/triangleproduct (approx)
-
-	mpn_divrem_1              20.0
-	mpn_mod_1                 20.0
-	mpn_divexact_by3          11.0
-
-	mpn_l/rshift               3.0
-
-	mpn_copyi/copyd            1.0
-
-	mpn_com_n                  1.5-1.85  \
-	mpn_and/andn/ior/xor_n     1.5-1.75  | varying with
-	mpn_iorn/xnor_n            2.0-2.25  | data alignment
-	mpn_nand/nior_n            2.0-2.25  /
-
-	mpn_popcount		  12.5
-	mpn_hamdist		  13.0
-
-
-K6-2 and K6-3 have dual-issue MMX and get the following improvements.
-
-	mpn_l/rshift               1.75
-
-	mpn_copyi/copyd            0.56 or 1.0  \
-                                                |
-	mpn_com_n                  1.0-1.2      | varying with
-	mpn_and/andn/ior/xor_n     1.2-1.5      | data alignment
-	mpn_iorn/xnor_n            1.5-2.0      |
-	mpn_nand/nior_n            1.75-2.0     /
-
-	mpn_popcount		   9.0
-	mpn_hamdist		  11.5
-
-
-Prefetching of sources hasn't yet given any joy.  With the 3DNow "prefetch"
-instruction, code seems to run slower, and with just "mov" loads it doesn't
-seem faster.  Results so far are inconsistent.  The K6 does a hardware
-prefetch of the second cache line in a sector, so the penalty for not
-prefetching in software is reduced.
-
-
-
-
-NOTES
-
-All K6 family chips have MMX, but only K6-2 and K6-3 have 3DNow.
-
-Plain K6 executes MMX instructions only in the X pipe, but K6-2 and K6-3 can
-execute them in both X and Y (and together).
-
-Branch misprediction penalty is 1 to 4 cycles (Optimization Manual
-chapter 6 table 12).
-
-Write-allocate L1 data cache means prefetching of destinations is unnecessary.
-Store queue is 7 entries of 64 bits each.
-
-Floating point multiplications can be done in parallel with integer
-multiplications, but there doesn't seem to be any way to make use of this.
-
-
-
-OPTIMIZATIONS
-
-Unrolled loops are used to reduce looping overhead.  The unrolling is
-configurable up to 32 limbs/loop for most routines, up to 64 for some.
-
-Sometimes computed jumps into the unrolling are used to handle sizes not a
-multiple of the unrolling.  An attractive feature of this is that times
-smoothly increase with operand size, but an indirect jump is about 6 cycles
-and the setups about another 6, so it depends on how much the unrolled code
-is faster than a simple loop as to whether a computed jump ought to be used.
-
-Position independent code is implemented using a call to get eip for
-computed jumps and a ret is always done, rather than an addl $4,%esp or a
-popl, so the CPU return address branch prediction stack stays synchronised
-with the actual stack in memory.  Such a call however still costs 4 to 7
-cycles.
-
-Branch prediction, in absence of any history, will guess forward jumps are
-not taken and backward jumps are taken.  Where possible it's arranged that
-the less likely or less important case is under a taken forward jump.
-
-
-
-MMX
-
-Putting emms or femms as late as possible in a routine seems to be fastest.
-Perhaps an emms or femms stalls until all outstanding MMX instructions have
-completed, so putting it later gives them a chance to complete on their own,
-in parallel with other operations (like register popping).
-
-The Optimization Manual chapter 5 recommends using a femms on K6-2 and K6-3
-at the start of a routine, in case it's been preceded by x87 floating point
-operations.  This isn't done because in gmp programs it's expected that x87
-floating point won't be much used and that chances are an mpn routine won't
-have been preceded by any x87 code.
-
-
-
-CODING
-
-Instructions in general code are shown paired if they can decode and execute
-together, meaning two short decode instructions with the second not
-depending on the first, only the first using the shifter, no more than one
-load, and no more than one store.
-
-K6 does some out of order execution so the pairings aren't essential, they
-just show what slots might be available.  When decoding is the limiting
-factor things can be scheduled that might not execute until later.
-
-
-
-NOTES
-
-Code alignment
-
-- if an opcode/modrm or 0Fh/opcode/modrm crosses a cache line boundary,
-  short decode is inhibited.  The cross.pl script detects this.
-
-- loops and branch targets should be aligned to 16 bytes, or ensure at least
-  2 instructions before a 32 byte boundary.  This makes use of the 16 byte
-  cache in the BTB.
-
-Addressing modes
-
-- (%esi) degrades decoding from short to vector.  0(%esi) doesn't have this
-  problem, and can be used as an equivalent, or easier is just to use a
-  different register, like %ebx.
-
-- K6 and pre-CXT core K6-2 have the following problem.  (K6-2 CXT and K6-3
-  have it fixed, these being cpuid function 1 signatures 0x588 to 0x58F).
-
-  If more than 3 bytes are needed to determine instruction length then
-  decoding degrades from direct to long, or from long to vector.  This
-  happens with forms like "0F opcode mod/rm" with mod/rm=00-xxx-100 since
-  with mod=00 the sib determines whether there's a displacement.
-
-  This affects all MMX and 3DNow instructions, and others with an 0F prefix
-  like movzbl.  The modes affected are anything with an index and no
-  displacement, or an index but no base, and this includes (%esp) which is
-  really (,%esp,1).
-
-  The cross.pl script detects problem cases.  The workaround is to always
-  use a displacement, and to do this with Zdisp if it's zero so the
-  assembler doesn't discard it.
-
-  See Optimization Manual rev D page 67 and 3DNow Porting Guide rev B pages
-  13-14 and 36-37.
-
-Calls
-
-- indirect jumps and calls are not branch predicted, they measure about 6
-  cycles.
-
-Various
-
-- adcl      2 cycles of decode, maybe 2 cycles executing in the X pipe
-- bsf       12-27 cycles
-- emms      5 cycles
-- femms     3 cycles
-- jecxz     2 cycles taken, 13 not taken (optimization manual says 7 not taken)
-- divl      20 cycles back-to-back
-- imull     2 decode, 2 execute
-- mull      2 decode, 3 execute (optimization manual decoding sample)
-- prefetch  2 cycles
-- rcll/rcrl implicit by one bit: 2 cycles
-            immediate or %cl count: 11 + 2 per bit for dword
-                                    13 + 4 per bit for byte
-- setCC	    2 cycles
-- xchgl	%eax,reg  1.5 cycles, back-to-back (strange)
-        reg,reg   2 cycles, back-to-back
-
-
-
-
-REFERENCES
-
-"AMD-K6 Processor Code Optimization Application Note", AMD publication
-number 21924, revision D amendment 0, January 2000.  This describes K6-2 and
-K6-3.  Available on-line,
-
-	http://www.amd.com/K6/k6docs/pdf/21924.pdf
-
-"AMD-K6 MMX Enhanced Processor x86 Code Optimization Application Note", AMD
-publication number 21828, revision A amendment 0, August 1997.  This is an
-older edition of the above document, describing plain K6.  Available
-on-line,
-
-	http://www.amd.com/K6/k6docs/pdf/21828.pdf
-
-"3DNow Technology Manual", AMD publication number 21928F/0-August 1999.
-This describes the femms and prefetch instructions, but nothing else from
-3DNow has been used.  Available on-line,
-
-	http://www.amd.com/K6/k6docs/pdf/21928.pdf
-
-"3DNow Instruction Porting Guide", AMD publication number 22621, revision B,
-August 1999.  This has some notes on general K6 optimizations as well as
-3DNow.  Available on-line,
-
-	http://www.amd.com/products/cpg/athlon/techdocs/pdf/22621.pdf
-
-
-
-----------------
-Local variables:
-mode: text
-fill-column: 76
-End:
diff --git a/ghc/rts/gmp/mpn/x86/k6/aors_n.asm b/ghc/rts/gmp/mpn/x86/k6/aors_n.asm
deleted file mode 100644
index 31b05ada51..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/aors_n.asm
+++ /dev/null
@@ -1,329 +0,0 @@
-dnl  AMD K6 mpn_add/sub_n -- mpn addition or subtraction.
-dnl 
-dnl  K6: normal 3.25 cycles/limb, in-place 2.75 cycles/limb.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-ifdef(`OPERATION_add_n', `
-	define(M4_inst,        adcl)
-	define(M4_function_n,  mpn_add_n)
-	define(M4_function_nc, mpn_add_nc)
-	define(M4_description, add)
-',`ifdef(`OPERATION_sub_n', `
-	define(M4_inst,        sbbl)
-	define(M4_function_n,  mpn_sub_n)
-	define(M4_function_nc, mpn_sub_nc)
-	define(M4_description, subtract)
-',`m4_error(`Need OPERATION_add_n or OPERATION_sub_n
-')')')
-
-MULFUNC_PROLOGUE(mpn_add_n mpn_add_nc mpn_sub_n mpn_sub_nc)
-
-
-C mp_limb_t M4_function_n (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
-C                          mp_size_t size);
-C mp_limb_t M4_function_nc (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
-C	                      mp_size_t size, mp_limb_t carry);
-C
-C Calculate src1,size M4_description src2,size, and store the result in
-C dst,size.  The return value is the carry bit from the top of the result
-C (1 or 0).
-C
-C The _nc version accepts 1 or 0 for an initial carry into the low limb of
-C the calculation.  Note values other than 1 or 0 here will lead to garbage
-C results.
-C
-C Instruction decoding limits a normal dst=src1+src2 operation to 3 c/l, and
-C an in-place dst+=src to 2.5 c/l.  The unrolled loops have 1 cycle/loop of
-C loop control, which with 4 limbs/loop means an extra 0.25 c/l.
-
-define(PARAM_CARRY, `FRAME+20(%esp)')
-define(PARAM_SIZE,  `FRAME+16(%esp)')
-define(PARAM_SRC2,  `FRAME+12(%esp)')
-define(PARAM_SRC1,  `FRAME+8(%esp)')
-define(PARAM_DST,   `FRAME+4(%esp)')
-deflit(`FRAME',0)
-
-dnl  minimum 5 because the unrolled code can't handle less
-deflit(UNROLL_THRESHOLD, 5)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(M4_function_nc)
-	movl	PARAM_CARRY, %eax
-	jmp	LF(M4_function_n,start)
-EPILOGUE()
-
-
-PROLOGUE(M4_function_n)
-	xorl	%eax, %eax
-L(start):
-	movl	PARAM_SIZE, %ecx
-	pushl	%ebx
-FRAME_pushl()
-
-	movl	PARAM_SRC1, %ebx
-	pushl	%edi
-FRAME_pushl()
-
-	movl	PARAM_SRC2, %edx
-	cmpl	$UNROLL_THRESHOLD, %ecx
-
-	movl	PARAM_DST, %edi
-	jae	L(unroll)
-
-
-	shrl	%eax		C initial carry flag
-
-	C offset 0x21 here, close enough to aligned
-L(simple):
-	C eax	scratch
-	C ebx	src1
-	C ecx	counter
-	C edx	src2
-	C esi
-	C edi	dst
-	C ebp
-	C
-	C The store to (%edi) could be done with a stosl; it'd be smaller
-	C code, but there's no speed gain and a cld would have to be added
-	C (per mpn/x86/README.family).
-
-	movl	(%ebx), %eax
-	leal	4(%ebx), %ebx
-	
-	M4_inst	(%edx), %eax
-
-	movl	%eax, (%edi)
-	leal	4(%edi), %edi
-
-	leal	4(%edx), %edx
-	loop	L(simple)
-
-	
-	movl	$0, %eax
-	popl	%edi
-
-	setc	%al
-
-	popl	%ebx
-	ret
-
-
-C -----------------------------------------------------------------------------
-L(unroll):
-	C eax	carry
-	C ebx	src1
-	C ecx	counter
-	C edx	src2
-	C esi
-	C edi	dst
-	C ebp
-
-	cmpl	%edi, %ebx
-	pushl	%esi
-
-	je	L(inplace)
-
-ifdef(`OPERATION_add_n',`
-	cmpl	%edi, %edx
-
-	je	L(inplace_reverse)
-')
-
-	movl	%ecx, %esi
-
-	andl	$-4, %ecx
-	andl	$3, %esi
-
-	leal	(%ebx,%ecx,4), %ebx
-	leal	(%edx,%ecx,4), %edx
-	leal	(%edi,%ecx,4), %edi
-
-	negl	%ecx
-	shrl	%eax
-
-	ALIGN(32)
-L(normal_top):
-	C eax	counter, qwords, negative
-	C ebx	src1
-	C ecx	scratch
-	C edx	src2
-	C esi
-	C edi	dst
-	C ebp
-
- 	movl	(%ebx,%ecx,4), %eax
-	leal	5(%ecx), %ecx
- 	M4_inst	-20(%edx,%ecx,4), %eax
- 	movl	%eax, -20(%edi,%ecx,4)
-
- 	movl	4-20(%ebx,%ecx,4), %eax
- 	M4_inst	4-20(%edx,%ecx,4), %eax
- 	movl	%eax, 4-20(%edi,%ecx,4)
-
- 	movl	8-20(%ebx,%ecx,4), %eax
- 	M4_inst	8-20(%edx,%ecx,4), %eax
- 	movl	%eax, 8-20(%edi,%ecx,4)
-
- 	movl	12-20(%ebx,%ecx,4), %eax
- 	M4_inst	12-20(%edx,%ecx,4), %eax
- 	movl	%eax, 12-20(%edi,%ecx,4)
-
-	loop	L(normal_top)
-
-
-	decl	%esi
-	jz	L(normal_finish_one)
-	js	L(normal_done)
-
-	C two or three more limbs
-
- 	movl	(%ebx), %eax
- 	M4_inst	(%edx), %eax
- 	movl	%eax, (%edi)
-
- 	movl	4(%ebx), %eax
- 	M4_inst	4(%edx), %eax
-	decl	%esi
- 	movl	%eax, 4(%edi)
-
-	jz	L(normal_done)
-	movl	$2, %ecx
-
-L(normal_finish_one):
- 	movl	(%ebx,%ecx,4), %eax
- 	M4_inst	(%edx,%ecx,4), %eax
- 	movl	%eax, (%edi,%ecx,4)
-
-L(normal_done):	
-	popl	%esi
-	popl	%edi
-
-	movl	$0, %eax
-	popl	%ebx
-
-	setc	%al
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-
-ifdef(`OPERATION_add_n',`
-L(inplace_reverse):
-	C dst==src2
-
-	movl	%ebx, %edx
-')
-
-L(inplace):
-	C eax	initial carry
-	C ebx
-	C ecx	size
-	C edx	src
-	C esi
-	C edi	dst
-	C ebp
-
-	leal	-1(%ecx), %esi
-	decl	%ecx
-
-	andl	$-4, %ecx
-	andl	$3, %esi
-
- 	movl	(%edx), %ebx		C src low limb
-	leal	(%edx,%ecx,4), %edx
-
-	leal	(%edi,%ecx,4), %edi
-	negl	%ecx
-
-	shrl	%eax
-
-
-	ALIGN(32)
-L(inplace_top):
-	C eax
-	C ebx	next src limb
-	C ecx	size
-	C edx	src
-	C esi
-	C edi	dst
-	C ebp
-
- 	M4_inst	%ebx, (%edi,%ecx,4)
-
- 	movl	4(%edx,%ecx,4), %eax
-	leal	5(%ecx), %ecx
-
- 	M4_inst	%eax, 4-20(%edi,%ecx,4)
-
- 	movl	8-20(%edx,%ecx,4), %eax
- 	movl	12-20(%edx,%ecx,4), %ebx
-
- 	M4_inst	%eax, 8-20(%edi,%ecx,4)
- 	M4_inst	%ebx, 12-20(%edi,%ecx,4)
-
- 	movl	16-20(%edx,%ecx,4), %ebx
-	loop	L(inplace_top)
-
-
-	C now %esi is 0 to 3 representing respectively 1 to 4 limbs more
-
- 	M4_inst	%ebx, (%edi)
-
-	decl	%esi
-	jz	L(inplace_finish_one)
-	js	L(inplace_done)
-
-	C two or three more limbs
-
- 	movl	4(%edx), %eax
- 	movl	8(%edx), %ebx
- 	M4_inst	%eax, 4(%edi)
- 	M4_inst	%ebx, 8(%edi)
-
-	decl	%esi
-	movl	$2, %ecx
-
-	jz	L(normal_done)
-
-L(inplace_finish_one):
- 	movl	4(%edx,%ecx,4), %eax
- 	M4_inst	%eax, 4(%edi,%ecx,4)
-
-L(inplace_done):	
-	popl	%esi
-	popl	%edi
-
-	movl	$0, %eax
-	popl	%ebx
-
-	setc	%al
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/aorsmul_1.asm b/ghc/rts/gmp/mpn/x86/k6/aorsmul_1.asm
deleted file mode 100644
index da4120fe2f..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/aorsmul_1.asm
+++ /dev/null
@@ -1,372 +0,0 @@
-dnl  AMD K6 mpn_addmul_1/mpn_submul_1 -- add or subtract mpn multiple.
-dnl 
-dnl  K6: 7.65 to 8.5 cycles/limb (at 16 limbs/loop and depending on the data),
-dnl  PIC adds about 6 cycles at the start.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  K6:           large multpliers  small multpliers
-dnl  UNROLL_COUNT    cycles/limb       cycles/limb
-dnl        4             9.5              7.78
-dnl        8             9.0              7.78
-dnl       16             8.4              7.65
-dnl       32             8.4              8.2
-dnl
-dnl  Maximum possible unrolling with the current code is 32.
-dnl
-dnl  Unrolling to 16 limbs/loop makes the unrolled loop fit exactly in a 256
-dnl  byte block, which might explain the good speed at that unrolling.
-
-deflit(UNROLL_COUNT, 16)
-
-
-ifdef(`OPERATION_addmul_1', `
-	define(M4_inst,        addl)
-	define(M4_function_1,  mpn_addmul_1)
-	define(M4_function_1c, mpn_addmul_1c)
-	define(M4_description, add it to)
-	define(M4_desc_retval, carry)
-',`ifdef(`OPERATION_submul_1', `
-	define(M4_inst,        subl)
-	define(M4_function_1,  mpn_submul_1)
-	define(M4_function_1c, mpn_submul_1c)
-	define(M4_description, subtract it from)
-	define(M4_desc_retval, borrow)
-',`m4_error(`Need OPERATION_addmul_1 or OPERATION_submul_1
-')')')
-
-MULFUNC_PROLOGUE(mpn_addmul_1 mpn_addmul_1c mpn_submul_1 mpn_submul_1c)
-
-
-C mp_limb_t M4_function_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                          mp_limb_t mult);
-C mp_limb_t M4_function_1c (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                           mp_limb_t mult, mp_limb_t carry);
-C
-C Calculate src,size multiplied by mult and M4_description dst,size.
-C Return the M4_desc_retval limb from the top of the result.
-C
-C The jadcl0()s in the unrolled loop makes the speed data dependent.  Small
-C multipliers (most significant few bits clear) result in few carry bits and
-C speeds up to 7.65 cycles/limb are attained.  Large multipliers (most
-C significant few bits set) make the carry bits 50/50 and lead to something
-C more like 8.4 c/l.  (With adcl's both of these would be 9.3 c/l.)
-C
-C It's important that the gains for jadcl0 on small multipliers don't come
-C at the cost of slowing down other data.  Tests on uniformly distributed
-C random data, designed to confound branch prediction, show about a 7%
-C speed-up using jadcl0 over adcl (8.93 versus 9.57 cycles/limb, with all
-C overheads included).
-C
-C In the simple loop, jadcl0() measures slower than adcl (11.9-14.7 versus
-C 11.0 cycles/limb), and hence isn't used.
-C
-C In the simple loop, note that running ecx from negative to zero and using
-C it as an index in the two movs wouldn't help.  It would save one
-C instruction (2*addl+loop becoming incl+jnz), but there's nothing unpaired
-C that would be collapsed by this.
-C
-C
-C jadcl0
-C ------
-C
-C jadcl0() being faster than adcl $0 seems to be an artifact of two things,
-C firstly the instruction decoding and secondly the fact that there's a
-C carry bit for the jadcl0 only on average about 1/4 of the time.
-C
-C The code in the unrolled loop decodes something like the following.
-C
-C                                         decode cycles
-C		mull	%ebp                    2
-C		M4_inst	%esi, disp(%edi)        1
-C		adcl	%eax, %ecx              2
-C		movl	%edx, %esi            \ 1
-C		jnc	1f                    /
-C		incl	%esi                  \ 1
-C	1:	movl	disp(%ebx), %eax      /
-C                                              ---
-C                                               7
-C
-C In a back-to-back style test this measures 7 with the jnc not taken, or 8
-C with it taken (both when correctly predicted).  This is opposite to the
-C measurements showing small multipliers running faster than large ones.
-C Watch this space for more info ...
-C
-C It's not clear how much branch misprediction might be costing.  The K6
-C doco says it will be 1 to 4 cycles, but presumably it's near the low end
-C of that range to get the measured results.
-C
-C
-C In the code the two carries are more or less the preceding mul product and
-C the calculation is roughly
-C
-C	x*y + u*b+v
-C
-C where b=2^32 is the size of a limb, x*y is the two carry limbs, and u and
-C v are the two limbs it's added to (being the low of the next mul, and a
-C limb from the destination).
-C
-C To get a carry requires x*y+u*b+v >= b^2, which is u*b+v >= b^2-x*y, and
-C there are b^2-(b^2-x*y) = x*y many such values, giving a probability of
-C x*y/b^2.  If x, y, u and v are random and uniformly distributed between 0
-C and b-1, then the total probability can be summed over x and y,
-C
-C	 1    b-1 b-1 x*y    1    b*(b-1)   b*(b-1)
-C	--- * sum sum --- = --- * ------- * ------- = 1/4
-C       b^2   x=0 y=1 b^2   b^4      2         2
-C
-C Actually it's a very tiny bit less than 1/4 of course.  If y is fixed,
-C then the probability is 1/2*y/b thus varying linearly between 0 and 1/2.
-
-
-ifdef(`PIC',`
-deflit(UNROLL_THRESHOLD, 9)
-',`
-deflit(UNROLL_THRESHOLD, 6)
-')
-
-defframe(PARAM_CARRY,     20)
-defframe(PARAM_MULTIPLIER,16)
-defframe(PARAM_SIZE,      12)
-defframe(PARAM_SRC,       8)
-defframe(PARAM_DST,       4)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(M4_function_1c)
-	pushl	%esi
-deflit(`FRAME',4)
-	movl	PARAM_CARRY, %esi
-	jmp	LF(M4_function_1,start_nc)
-EPILOGUE()
-
-PROLOGUE(M4_function_1)
-	push	%esi
-deflit(`FRAME',4)
-	xorl	%esi, %esi	C initial carry
-
-L(start_nc):
-	movl	PARAM_SIZE, %ecx
-	pushl	%ebx
-deflit(`FRAME',8)
-
-	movl	PARAM_SRC, %ebx
-	pushl	%edi
-deflit(`FRAME',12)
-
-	cmpl	$UNROLL_THRESHOLD, %ecx
-	movl	PARAM_DST, %edi
-
-	pushl	%ebp
-deflit(`FRAME',16)
-	jae	L(unroll)
-
-	
-	C simple loop
-
-	movl	PARAM_MULTIPLIER, %ebp
-
-L(simple):
-	C eax	scratch
-	C ebx	src
-	C ecx	counter
-	C edx	scratch
-	C esi	carry
-	C edi	dst
-	C ebp	multiplier
-
-	movl	(%ebx), %eax
-	addl	$4, %ebx
-
-	mull	%ebp
-
-	addl	$4, %edi
-	addl	%esi, %eax
-
-	adcl	$0, %edx
-
-	M4_inst	%eax, -4(%edi)
-
-	adcl	$0, %edx
-
-	movl	%edx, %esi
-	loop	L(simple)
-
-
-	popl	%ebp
-	popl	%edi
-
-	popl	%ebx
-	movl	%esi, %eax
-
-	popl	%esi
-	ret
-
-
-
-C -----------------------------------------------------------------------------
-C The unrolled loop uses a "two carry limbs" scheme.  At the top of the loop
-C the carries are ecx=lo, esi=hi, then they swap for each limb processed.
-C For the computed jump an odd size means they start one way around, an even
-C size the other.
-C
-C VAR_JUMP holds the computed jump temporarily because there's not enough
-C registers at the point of doing the mul for the initial two carry limbs.
-C
-C The add/adc for the initial carry in %esi is necessary only for the
-C mpn_addmul/submul_1c entry points.  Duplicating the startup code to
-C eliminiate this for the plain mpn_add/submul_1 doesn't seem like a good
-C idea.
-
-dnl  overlapping with parameters already fetched
-define(VAR_COUNTER, `PARAM_SIZE')
-define(VAR_JUMP,    `PARAM_DST')
-
-L(unroll):
-	C eax
-	C ebx	src
-	C ecx	size
-	C edx
-	C esi	initial carry
-	C edi	dst
-	C ebp
-
-	movl	%ecx, %edx
-	decl	%ecx
-
-	subl	$2, %edx
-	negl	%ecx
-
-	shrl	$UNROLL_LOG2, %edx
-	andl	$UNROLL_MASK, %ecx
-
-	movl	%edx, VAR_COUNTER
-	movl	%ecx, %edx
-
-	shll	$4, %edx
-	negl	%ecx
-
-	C 15 code bytes per limb
-ifdef(`PIC',`
-	call	L(pic_calc)
-L(here):
-',`
-	leal	L(entry) (%edx,%ecx,1), %edx
-')
-	movl	(%ebx), %eax		C src low limb
-
-	movl	PARAM_MULTIPLIER, %ebp
-	movl	%edx, VAR_JUMP
-
-	mull	%ebp
-
-	addl	%esi, %eax	C initial carry (from _1c)
-	jadcl0(	%edx)
-
-
-	leal	4(%ebx,%ecx,4), %ebx
-	movl	%edx, %esi	C high carry
-
-	movl	VAR_JUMP, %edx
-	leal	(%edi,%ecx,4), %edi
-
-	testl	$1, %ecx
-	movl	%eax, %ecx	C low carry
-
-	jz	L(noswap)
-	movl	%esi, %ecx	C high,low carry other way around
-
-	movl	%eax, %esi
-L(noswap):
-
-	jmp	*%edx
-
-
-ifdef(`PIC',`
-L(pic_calc):
-	C See README.family about old gas bugs
-	leal	(%edx,%ecx,1), %edx
-	addl	$L(entry)-L(here), %edx
-	addl	(%esp), %edx
-	ret
-')
-
-
-C -----------------------------------------------------------
-	ALIGN(32)
-L(top):
-deflit(`FRAME',16)
-	C eax	scratch
-	C ebx	src
-	C ecx	carry lo
-	C edx	scratch
-	C esi	carry hi
-	C edi	dst
-	C ebp	multiplier
-	C
-	C 15 code bytes per limb
-
-	leal	UNROLL_BYTES(%edi), %edi
-
-L(entry):
-forloop(`i', 0, UNROLL_COUNT/2-1, `
-	deflit(`disp0', eval(2*i*4))
-	deflit(`disp1', eval(disp0 + 4))
-
-Zdisp(	movl,	disp0,(%ebx), %eax)
-	mull	%ebp
-Zdisp(	M4_inst,%ecx, disp0,(%edi))
-	adcl	%eax, %esi
-	movl	%edx, %ecx
-	jadcl0(	%ecx)
-
-	movl	disp1(%ebx), %eax
-	mull	%ebp
-	M4_inst	%esi, disp1(%edi)
-	adcl	%eax, %ecx
-	movl	%edx, %esi
-	jadcl0(	%esi)
-')
-
-	decl	VAR_COUNTER
-	leal	UNROLL_BYTES(%ebx), %ebx
-
-	jns	L(top)
-
-
-	popl	%ebp
-	M4_inst	%ecx, UNROLL_BYTES(%edi)
-
-	popl	%edi
-	movl	%esi, %eax
-
-	popl	%ebx
-	jadcl0(	%eax)
-
-	popl	%esi
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/cross.pl b/ghc/rts/gmp/mpn/x86/k6/cross.pl
deleted file mode 100644
index 21734f3e52..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/cross.pl
+++ /dev/null
@@ -1,141 +0,0 @@
-#! /usr/bin/perl
-
-# Copyright (C) 2000 Free Software Foundation, Inc.
-#
-# This file is part of the GNU MP Library.
-#
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published
-# by the Free Software Foundation; either version 2.1 of the License, or (at
-# your option) any later version.
-#
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-# Usage: cross.pl [filename.o]...
-#
-# Produce an annotated disassembly of the given object files, indicating
-# certain code alignment and addressing mode problems afflicting K6 chips.
-# "ZZ" is used on all annotations, so this can be searched for.
-#
-# With no arguments, all .o files corresponding to .asm files are processed.
-# This is good in the mpn object directory of a k6*-*-* build.
-#
-# As far as fixing problems goes, any cache line crossing problems in loops
-# get attention, but as a rule it's too tedious to rearrange code or slip in
-# nops to fix every problem in setup or finishup code.
-#
-# Bugs:
-#
-# Instructions without mod/rm bytes or which are already vector decoded are
-# unaffected by cache line boundary crossing, but not all of these have yet
-# been put in as exceptions.  All that occur in practice in GMP are present
-# though.
-#
-# There's no messages for using the vector decoded addressing mode (%esi),
-# but that mode is easy to avoid when coding.
-
-use strict;
-
-sub disassemble {
-    my ($file) = @_;
-    my ($addr,$b1,$b2,$b3, $prefix,$opcode,$modrm);
-
-    open (IN, "objdump -Srfh $file |")
-	|| die "Cannot open pipe from objdump\n";
-    while (<IN>) {
-	print;
-
-	if (/^[ \t]*[0-9]+[ \t]+\.text[ \t]/ && /2\*\*([0-9]+)$/) {
-	    if ($1 < 5) {
-		print "ZZ need at least 2**5 for predictable cache line crossing\n";
-	    }
-	}
-	
-	if (/^[ \t]*([0-9a-f]*):[ \t]*([0-9a-f]+)[ \t]+([0-9a-f]+)[ \t]+([0-9a-f]+)/) {
-	    ($addr,$b1,$b2,$b3) = ($1,$2,$3,$4);
-
-	} elsif (/^[ \t]*([0-9a-f]*):[ \t]*([0-9a-f]+)[ \t]+([0-9a-f]+)/) {
-	    ($addr,$b1,$b2,$b3) = ($1,$2,$3,'');
-
-	} elsif (/^[ \t]*([0-9a-f]*):[ \t]*([0-9a-f]+)/) {
-	    ($addr,$b1,$b2,$b3) = ($1,$2,'','');
-
-	} else {
-	    next;
-	}
-
-	if ($b1 =~ /0f/) {
-	    $prefix = $b1;
-	    $opcode = $b2;
-	    $modrm = $b3;
-	} else {
-	    $prefix = '';
-	    $opcode = $b1;
-	    $modrm = $b2;
-	}
-
-	# modrm of the form 00-xxx-100 with an 0F prefix is the problem case
-	# for K6 and pre-CXT K6-2
-	if ($prefix =~ /0f/
-	    && $opcode !~ /^8/         # jcond disp32
-	    && $modrm =~ /^[0-3][4c]/) {
-	    print "ZZ ($file) >3 bytes to determine instruction length\n";
-	}
-
-	# with just an opcode, starting 1f mod 20h
-	if ($addr =~ /[13579bdf]f$/
-	    && $prefix !~ /0f/
-	    && $opcode !~ /1[012345]/ # adc
-	    && $opcode !~ /1[89abcd]/ # sbb
-	    && $opcode !~ /68/        # push $imm32
-	    && $opcode !~ /^7/        # jcond disp8
-	    && $opcode !~ /a[89]/     # test+imm
-	    && $opcode !~ /a[a-f]/    # stos/lods/scas
-	    && $opcode !~ /b8/        # movl $imm32,%eax
-	    && $opcode !~ /e[0123]/   # loop/loopz/loopnz/jcxz
-	    && $opcode !~ /e[b9]/     # jmp disp8/disp32
-	    && $opcode !~ /f[89abcd]/ # clc,stc,cli,sti,cld,std
-	    && !($opcode =~ /f[67]/          # grp 1
-		 && $modrm =~ /^[2367abef]/) # mul, imul, div, idiv
-	    && $modrm !~ /^$/) {
-	    print "ZZ ($file) opcode/modrm cross 32-byte boundary\n";
-	}
-
-	# with an 0F prefix, anything starting at 1f mod 20h
-	if ($addr =~ /[13579bdf][f]$/
-	    && $prefix =~ /0f/) {
-	    print "ZZ ($file) prefix/opcode cross 32-byte boundary\n";
-	}
-
-	# with an 0F prefix, anything with mod/rm starting at 1e mod 20h
-	if ($addr =~ /[13579bdf][e]$/
-	    && $prefix =~ /0f/
-	     && $opcode !~ /^8/        # jcond disp32
-	    && $modrm !~ /^$/) {
-	    print "ZZ ($file) prefix/opcode/modrm cross 32-byte boundary\n";
-	}
-    }
-    close IN || die "Error from objdump (or objdump not available)\n";
-}
-
-
-my @files;
-if ($#ARGV >= 0) {
-    @files = @ARGV;
-} else {
-    @files = glob "*.asm";
-    map {s/.asm/.o/} @files;
-}
-
-foreach (@files)  {
-    disassemble($_);
-}
diff --git a/ghc/rts/gmp/mpn/x86/k6/diveby3.asm b/ghc/rts/gmp/mpn/x86/k6/diveby3.asm
deleted file mode 100644
index ffb97bc380..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/diveby3.asm
+++ /dev/null
@@ -1,110 +0,0 @@
-dnl  AMD K6 mpn_divexact_by3 -- mpn division by 3, expecting no remainder.
-dnl 
-dnl  K6: 11.0 cycles/limb
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_divexact_by3c (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                              mp_limb_t carry);
-C
-C Using %esi in (%esi,%ecx,4) or 0(%esi,%ecx,4) addressing modes doesn't
-C lead to vector decoding, unlike plain (%esi) does.
-
-defframe(PARAM_CARRY,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,   8)
-defframe(PARAM_DST,   4)
-
-dnl  multiplicative inverse of 3, modulo 2^32
-deflit(INVERSE_3, 0xAAAAAAAB)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_divexact_by3c)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	pushl	%esi		defframe_pushl(SAVE_ESI)
-
-	movl	PARAM_SRC, %esi
-	pushl	%edi		defframe_pushl(SAVE_EDI)
-
-	movl	PARAM_DST, %edi
-	pushl	%ebx		defframe_pushl(SAVE_EBX)
-
-	movl	PARAM_CARRY, %ebx
-	leal	(%esi,%ecx,4), %esi
-
-	pushl	$3		defframe_pushl(VAR_THREE)
-	leal	(%edi,%ecx,4), %edi
-
-	negl	%ecx
-
-
-	C Need 32 alignment for claimed speed, to avoid the movl store
-	C opcode/modrm crossing a cache line boundary
-
-	ALIGN(32)
-L(top):
-	C eax	scratch, low product
-	C ebx	carry limb (0 to 3)
-	C ecx	counter, limbs, negative
-	C edx	scratch, high product
-	C esi	&src[size]
-	C edi	&dst[size]
-	C ebp
-	C
-	C The 0(%esi,%ecx,4) form pads so the finishup "movl %ebx, %eax"
-	C doesn't cross a 32 byte boundary, saving a couple of cycles
-	C (that's a fixed couple, not per loop).
-
-Zdisp(	movl,	0,(%esi,%ecx,4), %eax)
-	subl	%ebx, %eax
-
-	setc	%bl
-
-	imull	$INVERSE_3, %eax
-
-	movl	%eax, (%edi,%ecx,4)
-	addl	$2, %ecx
-
-	mull	VAR_THREE
-
-	addl	%edx, %ebx
-	loop	L(top)
-
-
-	movl	SAVE_ESI, %esi
-	movl	%ebx, %eax
-
-	movl	SAVE_EBX, %ebx
-
-	movl	SAVE_EDI, %edi
-	addl	$FRAME, %esp
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/gmp-mparam.h b/ghc/rts/gmp/mpn/x86/k6/gmp-mparam.h
deleted file mode 100644
index 77f3948d77..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/gmp-mparam.h
+++ /dev/null
@@ -1,97 +0,0 @@
-/* AMD K6 gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 32
-#define BYTES_PER_MP_LIMB 4
-#define BITS_PER_LONGINT 32
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-
-#ifndef UMUL_TIME
-#define UMUL_TIME   3   /* cycles */
-#endif
-
-#ifndef UDIV_TIME
-#define UDIV_TIME   20  /* cycles */
-#endif
-
-/* bsfl takes 12-27 cycles, put an average for uniform random numbers */
-#ifndef COUNT_TRAILING_ZEROS_TIME
-#define COUNT_TRAILING_ZEROS_TIME   14  /* cycles */
-#endif
-
-
-/* Generated by tuneup.c, 2000-07-04. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD   18
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD      130
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD   34
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD      116
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD              68
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD             98
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            13
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD        4
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD          67
-#endif
-
-#ifndef FFT_MUL_TABLE
-#define FFT_MUL_TABLE  { 528, 1184, 2176, 5632, 14336, 40960, 0 }
-#endif
-#ifndef FFT_MODF_MUL_THRESHOLD
-#define FFT_MODF_MUL_THRESHOLD     472
-#endif
-#ifndef FFT_MUL_THRESHOLD
-#define FFT_MUL_THRESHOLD         4352
-#endif
-
-#ifndef FFT_SQR_TABLE
-#define FFT_SQR_TABLE  { 528, 1184, 2176, 5632, 14336, 40960, 0 }
-#endif
-#ifndef FFT_MODF_SQR_THRESHOLD
-#define FFT_MODF_SQR_THRESHOLD     544
-#endif
-#ifndef FFT_SQR_THRESHOLD
-#define FFT_SQR_THRESHOLD         4352
-#endif
diff --git a/ghc/rts/gmp/mpn/x86/k6/k62mmx/copyd.asm b/ghc/rts/gmp/mpn/x86/k6/k62mmx/copyd.asm
deleted file mode 100644
index 20a33e6ccf..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/k62mmx/copyd.asm
+++ /dev/null
@@ -1,179 +0,0 @@
-dnl  AMD K6-2 mpn_copyd -- copy limb vector, decrementing.
-dnl 
-dnl  K6-2: 0.56 or 1.0 cycles/limb (at 32 limbs/loop), depending on data
-dnl  alignment.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  K6-2 aligned:
-dnl  UNROLL_COUNT cycles/limb
-dnl        8          0.75
-dnl       16          0.625
-dnl       32          0.5625
-dnl       64          0.53
-dnl  Maximum possible with the current code is 64, the minimum is 2.
-
-deflit(UNROLL_COUNT, 32)
-
-
-C void mpn_copyd (mp_ptr dst, mp_srcptr src, mp_size_t size);
-C
-C Copy src,size to dst,size, processing limbs from high to low addresses.
-C
-C The comments in copyi.asm apply here too.
-
-
-defframe(PARAM_SIZE,12)
-defframe(PARAM_SRC, 8)
-defframe(PARAM_DST, 4)
-deflit(`FRAME',0)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_copyd)
-	movl	PARAM_SIZE, %ecx
-	movl	%esi, %eax
-
-	movl	PARAM_SRC, %esi
-	movl	%edi, %edx
-
-	std
-
-	movl	PARAM_DST, %edi
-	cmpl	$UNROLL_COUNT, %ecx
-
-	leal	-4(%esi,%ecx,4), %esi
-
-	leal	-4(%edi,%ecx,4), %edi
-	ja	L(unroll)
-
-L(simple):
-	rep
-	movsl
-
-	cld
-
-	movl	%eax, %esi
-	movl	%edx, %edi
-
-	ret
-
-
-L(unroll):
-	C if src and dst are different alignments mod8, then use rep movs
-	C if src and dst are both 4mod8 then process one limb to get 0mod8
-
-	pushl	%ebx
-	leal	(%esi,%edi), %ebx
-
-	testb	$4, %bl
-	popl	%ebx
-	
-	jnz	L(simple)
-	testl	$4, %esi
-
-	leal	-UNROLL_COUNT(%ecx), %ecx
-	jnz	L(already_aligned)
-
-	movsl
-
-	decl	%ecx
-L(already_aligned):
-
-
-ifelse(UNROLL_BYTES,256,`
-	subl	$128, %esi
-	subl	$128, %edi
-')
-
-	C offset 0x3D here, but gets full speed without further alignment
-L(top):
-	C eax	saved esi
-	C ebx
-	C ecx	counter, limbs
-	C edx	saved edi
-	C esi	src, incrementing
-	C edi	dst, incrementing
-	C ebp
-	C
-	C `disp' is never 0, so don't need to force 0(%esi).
-
-deflit(CHUNK_COUNT, 2)
-forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT-1, `
-	deflit(`disp', eval(-4-i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,+128)))
-	movq	disp(%esi), %mm0
-	movq	%mm0, disp(%edi)
-')
-
-	leal	-UNROLL_BYTES(%esi), %esi
-	subl	$UNROLL_COUNT, %ecx
-
-	leal	-UNROLL_BYTES(%edi), %edi
-	jns	L(top)
-
-
-	C now %ecx is -UNROLL_COUNT to -1 representing repectively 0 to
-	C UNROLL_COUNT-1 limbs remaining
-
-	testb	$eval(UNROLL_COUNT/2), %cl
-
-	leal	UNROLL_COUNT(%ecx), %ecx
-	jz	L(not_half)
-
-
-	C at an unroll count of 32 this block of code is 16 cycles faster than
-	C the rep movs, less 3 or 4 to test whether to do it
-
-forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT/2-1, `
-	deflit(`disp', eval(-4-i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,+128)))
-	movq	disp(%esi), %mm0
-	movq	%mm0, disp(%edi)
-')
-
-	subl	$eval(UNROLL_BYTES/2), %esi
-	subl	$eval(UNROLL_BYTES/2), %edi
-
-	subl	$eval(UNROLL_COUNT/2), %ecx
-L(not_half):
-
-
-ifelse(UNROLL_BYTES,256,`
-	addl	$128, %esi
-	addl	$128, %edi
-')
-
-	rep
-	movsl
-
-	cld
-
-	movl	%eax, %esi
-	movl	%edx, %edi
-
-	femms
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/k62mmx/copyi.asm b/ghc/rts/gmp/mpn/x86/k6/k62mmx/copyi.asm
deleted file mode 100644
index 215d805f2e..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/k62mmx/copyi.asm
+++ /dev/null
@@ -1,196 +0,0 @@
-dnl  AMD K6-2 mpn_copyi -- copy limb vector, incrementing.
-dnl 
-dnl  K6-2: 0.56 or 1.0 cycles/limb (at 32 limbs/loop), depending on data
-dnl  alignment.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  K6-2 aligned:
-dnl  UNROLL_COUNT cycles/limb
-dnl        8          0.75
-dnl       16          0.625
-dnl       32          0.5625
-dnl       64          0.53
-dnl  Maximum possible with the current code is 64, the minimum is 2.
-
-deflit(UNROLL_COUNT, 32)
-
-
-C void mpn_copyi (mp_ptr dst, mp_srcptr src, mp_size_t size);
-C
-C The MMX loop is faster than a rep movs when src and dst are both 0mod8.
-C With one 0mod8 and one 4mod8 it's 1.056 c/l and the rep movs at 1.0 c/l is
-C used instead.
-C
-C         mod8
-C	src  dst
-C	 0    0	   both aligned, use mmx
-C	 0    4    unaligned, use rep movs
-C	 4    0    unaligned, use rep movs
-C	 4    4    do one movs, then both aligned, use mmx
-C
-C The MMX code on aligned data is 0.5 c/l, plus loop overhead of 2
-C cycles/loop, which is 0.0625 c/l at 32 limbs/loop.
-C
-C A pattern of two movq loads and two movq stores (or four and four) was
-C tried, but found to be the same speed as just one of each.
-C
-C Note that this code only suits K6-2 and K6-3.  Plain K6 does only one mmx
-C instruction per cycle, so "movq"s are no faster than the simple 1 c/l rep
-C movs.
-C
-C Enhancement:
-C
-C Addressing modes like disp(%esi,%ecx,4) aren't currently used.  They'd
-C make it possible to avoid incrementing %esi and %edi in the loop and hence
-C get loop overhead down to 1 cycle.  Care would be needed to avoid bad
-C cache line crossings since the "movq"s would then be 5 code bytes rather
-C than 4.
-
-
-defframe(PARAM_SIZE,12)
-defframe(PARAM_SRC, 8)
-defframe(PARAM_DST, 4)
-deflit(`FRAME',0)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_copyi)
-	movl	PARAM_SIZE, %ecx
-	movl	%esi, %eax
-
-	movl	PARAM_SRC, %esi
-	movl	%edi, %edx
-
-	cld
-
-	movl	PARAM_DST, %edi
-	cmpl	$UNROLL_COUNT, %ecx
-
-	ja	L(unroll)
-
-L(simple):
-	rep
-	movsl
-
-	movl	%eax, %esi
-	movl	%edx, %edi
-
-	ret
-
-
-L(unroll):
-	C if src and dst are different alignments mod8, then use rep movs
-	C if src and dst are both 4mod8 then process one limb to get 0mod8
-
-	pushl	%ebx
-	leal	(%esi,%edi), %ebx
-
-	testb	$4, %bl
-	popl	%ebx
-	
-	jnz	L(simple)
-	testl	$4, %esi
-
-	leal	-UNROLL_COUNT(%ecx), %ecx
-	jz	L(already_aligned)
-
-	decl	%ecx
-
-	movsl
-L(already_aligned):
-
-
-ifelse(UNROLL_BYTES,256,`
-	addl	$128, %esi
-	addl	$128, %edi
-')
-
-	C this is offset 0x34, no alignment needed
-L(top):
-	C eax	saved esi
-	C ebx
-	C ecx	counter, limbs
-	C edx	saved edi
-	C esi	src, incrementing
-	C edi	dst, incrementing
-	C ebp
-	C
-	C Zdisp gets 0(%esi) left that way to avoid vector decode, and with
-	C 0(%edi) keeps code aligned to 16 byte boundaries.
-
-deflit(CHUNK_COUNT, 2)
-forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT-1, `
-	deflit(`disp', eval(i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
-Zdisp(	movq,	disp,(%esi), %mm0)
-Zdisp(	movq,	%mm0, disp,(%edi))
-')
-
-	addl	$UNROLL_BYTES, %esi
-	subl	$UNROLL_COUNT, %ecx
-
-	leal	UNROLL_BYTES(%edi), %edi
-	jns	L(top)
-
-
-	C now %ecx is -UNROLL_COUNT to -1 representing repectively 0 to
-	C UNROLL_COUNT-1 limbs remaining
-
-	testb	$eval(UNROLL_COUNT/2), %cl
-
-	leal	UNROLL_COUNT(%ecx), %ecx
-	jz	L(not_half)
-
-	C at an unroll count of 32 this block of code is 16 cycles faster than
-	C the rep movs, less 3 or 4 to test whether to do it
-
-forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT/2-1, `
-	deflit(`disp', eval(i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
-	movq	disp(%esi), %mm0
-	movq	%mm0, disp(%edi)
-')
-	addl	$eval(UNROLL_BYTES/2), %esi
-	addl	$eval(UNROLL_BYTES/2), %edi
-
-	subl	$eval(UNROLL_COUNT/2), %ecx
-L(not_half):
-
-
-ifelse(UNROLL_BYTES,256,`
-	subl	$128, %esi
-	subl	$128, %edi
-')
-
-	rep
-	movsl
-
-	movl	%eax, %esi
-	movl	%edx, %edi
-
-	femms
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/k62mmx/lshift.asm b/ghc/rts/gmp/mpn/x86/k6/k62mmx/lshift.asm
deleted file mode 100644
index f6d54f97a8..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/k62mmx/lshift.asm
+++ /dev/null
@@ -1,286 +0,0 @@
-dnl  AMD K6-2 mpn_lshift -- mpn left shift.
-dnl 
-dnl  K6-2: 1.75 cycles/limb
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_lshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       unsigned shift);
-C
-
-defframe(PARAM_SHIFT,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,  8)
-defframe(PARAM_DST,  4)
-deflit(`FRAME',0)
-
-dnl  used after src has been fetched
-define(VAR_RETVAL,`PARAM_SRC')
-
-dnl  minimum 9, because unrolled loop can't handle less
-deflit(UNROLL_THRESHOLD, 9)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_lshift)
-deflit(`FRAME',0)
-
-	C The 1 limb case can be done without the push %ebx, but it's then
-	C still the same speed.  The push is left as a free helping hand for
-	C the two_or_more code.
-
-	movl	PARAM_SIZE, %eax
-	pushl	%ebx			FRAME_pushl()
-
-	movl	PARAM_SRC, %ebx
-	decl	%eax
-
-	movl	PARAM_SHIFT, %ecx
-	jnz	L(two_or_more)
-
-	movl	(%ebx), %edx		C src limb
-	movl	PARAM_DST, %ebx
-
-	shldl(	%cl, %edx, %eax)	C return value
-
- 	shll	%cl, %edx
-
-	movl	%edx, (%ebx)		C dst limb
-	popl	%ebx
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)	C avoid offset 0x1f
-L(two_or_more):
-	C eax	size-1
-	C ebx	src
-	C ecx	shift
-	C edx
-
-	movl	(%ebx,%eax,4), %edx	C src high limb
-	negl	%ecx
-
-	movd	PARAM_SHIFT, %mm6
-	addl	$32, %ecx		C 32-shift
-
-	shrl	%cl, %edx
-	cmpl	$UNROLL_THRESHOLD-1, %eax
-
-	movl	%edx, VAR_RETVAL
-	jae	L(unroll)
-
-
-	movd	%ecx, %mm7
-	movl	%eax, %ecx
-
-	movl	PARAM_DST, %eax
-
-L(simple):
-	C eax	dst
-	C ebx	src
-	C ecx	counter, size-1 to 1
-	C edx	retval
-	C
-	C mm0	scratch
-	C mm6	shift
-	C mm7	32-shift
-
-	movq	-4(%ebx,%ecx,4), %mm0
-
- 	psrlq	%mm7, %mm0
-
-Zdisp(	movd,	%mm0, 0,(%eax,%ecx,4))
-	loop	L(simple)
-
-
-	movd	(%ebx), %mm0
-	popl	%ebx
-
- 	psllq	%mm6, %mm0
-
-	movd	%mm0, (%eax)
-	movl	%edx, %eax
-
-	femms
-	ret
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)
-L(unroll):
-	C eax	size-1
-	C ebx	src
-	C ecx	32-shift
-	C edx	retval (but instead VAR_RETVAL is used)
-	C
-	C mm6	shift
-
-	addl	$32, %ecx
-	movl	PARAM_DST, %edx
-
-	movd	%ecx, %mm7
-	subl	$7, %eax			C size-8
-
-	leal	(%edx,%eax,4), %ecx		C alignment of dst
-
-	movq	32-8(%ebx,%eax,4), %mm2		C src high qword
-	testb	$4, %cl
-
-	jz	L(dst_aligned)
-	psllq	%mm6, %mm2
-
-	psrlq	$32, %mm2
-	decl	%eax
-
-	movd	%mm2, 32(%edx,%eax,4)		C dst high limb
-	movq	32-8(%ebx,%eax,4), %mm2		C new src high qword
-L(dst_aligned):
-
-	movq	32-16(%ebx,%eax,4), %mm0	C src second highest qword
-
-
-	C This loop is the important bit, the rest is just support for it.
-	C Four src limbs are held at the start, and four more will be read.
-	C Four dst limbs will be written.  This schedule seems necessary for
-	C full speed.
-	C
-	C The use of size-8 lets the loop stop when %eax goes negative and
-	C leaves -4 to -1 which can be tested with test $1 and $2.
-
-L(top):
-	C eax	counter, size-8 step by -4 until <0
-	C ebx	src
-	C ecx
-	C edx	dst
-	C
-	C mm0	src next qword
-	C mm1	scratch
-	C mm2	src prev qword
-	C mm6	shift
-	C mm7	64-shift
-
-	psllq	%mm6, %mm2
-	subl	$4, %eax
-
-	movq	%mm0, %mm1
-	psrlq	%mm7, %mm0
-
-	por	%mm0, %mm2
-	movq	24(%ebx,%eax,4), %mm0
-
-	psllq	%mm6, %mm1
-	movq	%mm2, 40(%edx,%eax,4)
-
-	movq	%mm0, %mm2
-	psrlq	%mm7, %mm0
-
-	por	%mm0, %mm1
-	movq	16(%ebx,%eax,4), %mm0
-
-	movq	%mm1, 32(%edx,%eax,4)
-	jnc	L(top)
-
-
-	C Now have four limbs in mm2 (prev) and mm0 (next), plus eax mod 4.
-	C
-	C 8(%ebx) is the next source, and 24(%edx) is the next destination.
-	C %eax is between -4 and -1, representing respectively 0 to 3 extra
-	C limbs that must be read.
-
-
-	testl	$2, %eax	C testl to avoid bad cache line crossing
-	jz	L(finish_nottwo)
-
-	C Two more limbs: lshift mm2, OR it with rshifted mm0, mm0 becomes
-	C new mm2 and a new mm0 is loaded.
-
-	psllq	%mm6, %mm2
-	movq	%mm0, %mm1
-
-	psrlq	%mm7, %mm0
-	subl	$2, %eax
-
-	por	%mm0, %mm2
-	movq	16(%ebx,%eax,4), %mm0
-
-	movq	%mm2, 32(%edx,%eax,4)
-	movq	%mm1, %mm2
-L(finish_nottwo):
-
-
-	C lshift mm2, OR with rshifted mm0, mm1 becomes lshifted mm0
-
-	testb	$1, %al
-	psllq	%mm6, %mm2
-
-	movq	%mm0, %mm1
-	psrlq	%mm7, %mm0
-
-	por	%mm0, %mm2
-	psllq	%mm6, %mm1
-
-	movq	%mm2, 24(%edx,%eax,4)
-	jz	L(finish_even)
-
-
-	C Size is odd, so mm1 and one extra limb to process.
-
-	movd	(%ebx), %mm0		C src[0]
-	popl	%ebx
-deflit(`FRAME',0)
-
-	movq	%mm0, %mm2
-	psllq	$32, %mm0
-
-	psrlq	%mm7, %mm0
-
-	psllq	%mm6, %mm2
-	por	%mm0, %mm1
-
-	movq	%mm1, 4(%edx)		C dst[1,2]
-	movd	%mm2, (%edx)		C dst[0]
-
-	movl	VAR_RETVAL, %eax
-
-	femms
-	ret
-
-
-	nop	C avoid bad cache line crossing
-L(finish_even):
-deflit(`FRAME',4)
-	C Size is even, so only mm1 left to process.
-
-	movq	%mm1, (%edx)		C dst[0,1]
-	movl	VAR_RETVAL, %eax
-
-	popl	%ebx
-	femms
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/k62mmx/rshift.asm b/ghc/rts/gmp/mpn/x86/k6/k62mmx/rshift.asm
deleted file mode 100644
index 8a8c144241..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/k62mmx/rshift.asm
+++ /dev/null
@@ -1,285 +0,0 @@
-dnl  AMD K6-2 mpn_rshift -- mpn right shift.
-dnl 
-dnl  K6-2: 1.75 cycles/limb
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_rshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       unsigned shift);
-C
-
-defframe(PARAM_SHIFT,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,  8)
-defframe(PARAM_DST,  4)
-deflit(`FRAME',0)
-
-dnl  Minimum 9, because the unrolled loop can't handle less.
-dnl
-deflit(UNROLL_THRESHOLD, 9)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_rshift)
-deflit(`FRAME',0)
-
-	C The 1 limb case can be done without the push %ebx, but it's then
-	C still the same speed.  The push is left as a free helping hand for
-	C the two_or_more code.
-
-	movl	PARAM_SIZE, %eax
-	pushl	%ebx			FRAME_pushl()
-
-	movl	PARAM_SRC, %ebx
-	decl	%eax
-
-	movl	PARAM_SHIFT, %ecx
-	jnz	L(two_or_more)
-
-	movl	(%ebx), %edx		C src limb
-	movl	PARAM_DST, %ebx
-
-	shrdl(	%cl, %edx, %eax)	C return value
-
- 	shrl	%cl, %edx
-
-	movl	%edx, (%ebx)		C dst limb
-	popl	%ebx
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)	C avoid offset 0x1f
-L(two_or_more):
-	C eax	size-1
-	C ebx	src
-	C ecx	shift
-	C edx
-
-	movl	(%ebx), %edx	C src low limb
-	negl	%ecx
-
-	addl	$32, %ecx
-	movd	PARAM_SHIFT, %mm6
-
-	shll	%cl, %edx
-	cmpl	$UNROLL_THRESHOLD-1, %eax
-
-	jae	L(unroll)
-
-
-	C eax	size-1
-	C ebx	src
-	C ecx	32-shift
-	C edx	retval
-	C
-	C mm6	shift
-
-	movl	PARAM_DST, %ecx
-	leal	(%ebx,%eax,4), %ebx
-
-	leal	-4(%ecx,%eax,4), %ecx
-	negl	%eax
-
-	C This loop runs at about 3 cycles/limb, which is the amount of
-	C decoding, and this is despite every second access being unaligned.
-
-L(simple):
-	C eax	counter, -(size-1) to -1
-	C ebx	&src[size-1]
-	C ecx	&dst[size-1]
-	C edx	retval
-	C
-	C mm0	scratch
-	C mm6	shift
-
-Zdisp(	movq,	0,(%ebx,%eax,4), %mm0)
-	incl	%eax
-
- 	psrlq	%mm6, %mm0
-
-Zdisp(	movd,	%mm0, 0,(%ecx,%eax,4))
-	jnz	L(simple)
-
-
-	movq	%mm0, (%ecx)
-	movl	%edx, %eax
-
-	popl	%ebx
-
-	femms
-	ret
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)	
-L(unroll):
-	C eax	size-1
-	C ebx	src
-	C ecx	32-shift
-	C edx	retval
-	C
-	C mm6	shift
-
-	addl	$32, %ecx
-	subl	$7, %eax		C size-8
-
-	movd	%ecx, %mm7
-	movl	PARAM_DST, %ecx
-
-	movq	(%ebx), %mm2		C src low qword
-	leal	(%ebx,%eax,4), %ebx	C src end - 32
-
-	testb	$4, %cl
-	leal	(%ecx,%eax,4), %ecx	C dst end - 32
-
-	notl	%eax			C -(size-7)
-	jz	L(dst_aligned)
-
-	psrlq	%mm6, %mm2
-	incl	%eax
-
-Zdisp(	movd,	%mm2, 0,(%ecx,%eax,4))	C dst low limb
-	movq	4(%ebx,%eax,4), %mm2	C new src low qword
-L(dst_aligned):
-
-	movq	12(%ebx,%eax,4), %mm0	C src second lowest qword
-	nop 	C avoid bad cache line crossing
-
-
-	C This loop is the important bit, the rest is just support for it.
-	C Four src limbs are held at the start, and four more will be read.
-	C Four dst limbs will be written.  This schedule seems necessary for
-	C full speed.
-	C
-	C The use of -(size-7) lets the loop stop when %eax becomes >= 0 and
-	C and leaves 0 to 3 which can be tested with test $1 and $2.
-
-L(top):
-	C eax	counter, -(size-7) step by +4 until >=0
-	C ebx	src end - 32
-	C ecx	dst end - 32
-	C edx	retval
-	C
-	C mm0	src next qword
-	C mm1	scratch
-	C mm2	src prev qword
-	C mm6	shift
-	C mm7	64-shift
-
-	psrlq	%mm6, %mm2
-	addl	$4, %eax
-
-	movq	%mm0, %mm1
-	psllq	%mm7, %mm0
-
-	por	%mm0, %mm2
-	movq	4(%ebx,%eax,4), %mm0
-
-	psrlq	%mm6, %mm1
-	movq	%mm2, -12(%ecx,%eax,4)
-
-	movq	%mm0, %mm2
-	psllq	%mm7, %mm0
-
-	por	%mm0, %mm1
-	movq	12(%ebx,%eax,4), %mm0
-
-	movq	%mm1, -4(%ecx,%eax,4)
-	ja	L(top)		C jump if no carry and not zero
-
-
-
-	C Now have the four limbs in mm2 (low) and mm0 (high), and %eax is 0
-	C to 3 representing respectively 3 to 0 further limbs.
-
-	testl	$2, %eax	C testl to avoid bad cache line crossings
-	jnz	L(finish_nottwo)
-
-	C Two or three extra limbs: rshift mm2, OR it with lshifted mm0, mm0
-	C becomes new mm2 and a new mm0 is loaded.
-
-	psrlq	%mm6, %mm2
-	movq	%mm0, %mm1
-
-	psllq	%mm7, %mm0
-	addl	$2, %eax
-
-	por	%mm0, %mm2
-	movq	12(%ebx,%eax,4), %mm0
-
-	movq	%mm2, -4(%ecx,%eax,4)
-	movq	%mm1, %mm2
-L(finish_nottwo):
-
-
-	testb	$1, %al
-	psrlq	%mm6, %mm2
-
-	movq	%mm0, %mm1
-	psllq	%mm7, %mm0
-
-	por	%mm0, %mm2
-	psrlq	%mm6, %mm1
-
-	movq	%mm2, 4(%ecx,%eax,4)
-	jnz	L(finish_even)
-
-
-	C one further extra limb to process
-
-	movd	32-4(%ebx), %mm0	C src[size-1], most significant limb
-	popl	%ebx
-
-	movq	%mm0, %mm2
-	psllq	%mm7, %mm0
-
-	por	%mm0, %mm1
-	psrlq	%mm6, %mm2
-
-	movq	%mm1, 32-12(%ecx)	C dst[size-3,size-2]
-	movd	%mm2, 32-4(%ecx)	C dst[size-1]
-
-	movl	%edx, %eax		C retval
-
-	femms
-	ret
-
-
-	nop	C avoid bad cache line crossing
-L(finish_even):
-	C no further extra limbs
-
-	movq	%mm1, 32-8(%ecx)	C dst[size-2,size-1]
-	movl	%edx, %eax		C retval
-
-	popl	%ebx
-
-	femms
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/mmx/com_n.asm b/ghc/rts/gmp/mpn/x86/k6/mmx/com_n.asm
deleted file mode 100644
index 8915080f0f..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/mmx/com_n.asm
+++ /dev/null
@@ -1,91 +0,0 @@
-dnl  AMD K6-2 mpn_com_n -- mpn bitwise one's complement.
-dnl   
-dnl     alignment dst/src, A=0mod8 N=4mod8
-dnl        A/A   A/N   N/A   N/N
-dnl  K6-2  1.0   1.18  1.18  1.18  cycles/limb
-dnl  K6    1.5   1.85  1.75  1.85
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C void mpn_com_n (mp_ptr dst, mp_srcptr src, mp_size_t size);
-C
-C Take the bitwise ones-complement of src,size and write it to dst,size.
-
-defframe(PARAM_SIZE,12)
-defframe(PARAM_SRC, 8)
-defframe(PARAM_DST, 4)
-
-	.text
-	ALIGN(32)
-PROLOGUE(mpn_com_n)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	movl	PARAM_SRC, %eax
-	movl	PARAM_DST, %edx
-	shrl	%ecx
-	jnz	L(two_or_more)
-
-	movl	(%eax), %eax
-	notl	%eax
-	movl	%eax, (%edx)
-	ret
-
-
-L(two_or_more):
-	pushl	%ebx
-FRAME_pushl()
-	movl	%ecx, %ebx
-
-	pcmpeqd	%mm7, %mm7	C all ones
-
-
-	ALIGN(16)
-L(top):
-	C eax	src
-	C ebx	floor(size/2)
-	C ecx	counter
-	C edx	dst
-	C esi
-	C edi
-	C ebp
-
-	movq	-8(%eax,%ecx,8), %mm0
-	pxor	%mm7, %mm0
-	movq	%mm0, -8(%edx,%ecx,8)
-	loop	L(top)
-
-
-	jnc	L(no_extra)
-	movl	(%eax,%ebx,8), %eax
-	notl	%eax
-	movl	%eax, (%edx,%ebx,8)
-L(no_extra):
-
-	popl	%ebx
-	emms_or_femms
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/mmx/logops_n.asm b/ghc/rts/gmp/mpn/x86/k6/mmx/logops_n.asm
deleted file mode 100644
index 46cb3b7ea5..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/mmx/logops_n.asm
+++ /dev/null
@@ -1,212 +0,0 @@
-dnl  AMD K6-2 mpn_and_n, mpn_andn_n, mpn_nand_n, mpn_ior_n, mpn_iorn_n,
-dnl  mpn_nior_n, mpn_xor_n, mpn_xnor_n -- mpn bitwise logical operations.
-dnl   
-dnl          alignment dst/src1/src2, A=0mod8, N=4mod8
-dnl       A/A/A A/A/N A/N/A A/N/N N/A/A N/A/N N/N/A N/N/N
-dnl 
-dnl  K6-2  1.2   1.5   1.5   1.2   1.2   1.5   1.5   1.2   and,andn,ior,xor
-dnl  K6-2  1.5   1.75  2.0   1.75  1.75  2.0   1.75  1.5   iorn,xnor
-dnl  K6-2  1.75  2.0   2.0   2.0   2.0   2.0   2.0   1.75  nand,nior
-dnl
-dnl  K6    1.5   1.68  1.75  1.2   1.75  1.75  1.68  1.5   and,andn,ior,xor
-dnl  K6    2.0   2.0   2.25  2.25  2.25  2.25  2.0   2.0   iorn,xnor
-dnl  K6    2.0   2.25  2.25  2.25  2.25  2.25  2.25  2.0   nand,nior
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  M4_p and M4_i are the MMX and integer instructions
-dnl  M4_*_neg_dst means whether to negate the final result before writing
-dnl  M4_*_neg_src2 means whether to negate the src2 values before using them
-
-define(M4_choose_op,
-m4_assert_numargs(7)
-`ifdef(`OPERATION_$1',`
-define(`M4_function',  `mpn_$1')
-define(`M4_operation', `$1')
-define(`M4_p',         `$2')
-define(`M4_p_neg_dst', `$3')
-define(`M4_p_neg_src2',`$4')
-define(`M4_i',         `$5')
-define(`M4_i_neg_dst', `$6')
-define(`M4_i_neg_src2',`$7')
-')')
-
-dnl  xnor is done in "iorn" style because it's a touch faster than "nior"
-dnl  style (the two are equivalent for xor).
-
-M4_choose_op( and_n,  pand,0,0,  andl,0,0)
-M4_choose_op( andn_n, pandn,0,0, andl,0,1)
-M4_choose_op( nand_n, pand,1,0,  andl,1,0)
-M4_choose_op( ior_n,  por,0,0,   orl,0,0)
-M4_choose_op( iorn_n, por,0,1,   orl,0,1)
-M4_choose_op( nior_n, por,1,0,   orl,1,0)
-M4_choose_op( xor_n,  pxor,0,0,  xorl,0,0)
-M4_choose_op( xnor_n, pxor,0,1,  xorl,0,1)
-
-ifdef(`M4_function',,
-`m4_error(`Unrecognised or undefined OPERATION symbol
-')')
-
-MULFUNC_PROLOGUE(mpn_and_n mpn_andn_n mpn_nand_n mpn_ior_n mpn_iorn_n mpn_nior_n mpn_xor_n mpn_xnor_n)
-
-
-C void M4_function (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
-C                   mp_size_t size);
-C
-C Do src1,size M4_operation src2,size, storing the result in dst,size.
-C
-C Unaligned movq loads and stores are a bit slower than aligned ones.  The
-C test at the start of the routine checks the alignment of src1 and if
-C necessary processes one limb separately at the low end to make it aligned.
-C
-C The raw speeds without this alignment switch are as follows.
-C
-C           alignment dst/src1/src2, A=0mod8, N=4mod8
-C     A/A/A  A/A/N  A/N/A  A/N/N  N/A/A  N/A/N  N/N/A  N/N/N
-C
-C K6                 1.5    2.0                 1.5    2.0    and,andn,ior,xor
-C K6                 1.75   2.2                 2.0    2.28   iorn,xnor
-C K6                 2.0    2.25                2.35   2.28   nand,nior
-C
-C
-C Future:
-C
-C K6 can do one 64-bit load per cycle so each of these routines should be
-C able to approach 1.0 c/l, if aligned.  The basic and/andn/ior/xor might be
-C able to get 1.0 with just a 4 limb loop, being 3 instructions per 2 limbs.
-C The others are 4 instructions per 2 limbs, and so can only approach 1.0
-C because there's nowhere to hide some loop control.
-
-defframe(PARAM_SIZE,16)
-defframe(PARAM_SRC2,12)
-defframe(PARAM_SRC1,8)
-defframe(PARAM_DST, 4)
-deflit(`FRAME',0)
-
-	.text
-	ALIGN(32)
-PROLOGUE(M4_function)
-			movl	PARAM_SIZE, %ecx
-			pushl	%ebx
-		FRAME_pushl()
-			movl	PARAM_SRC1, %eax
-			movl	PARAM_SRC2, %ebx
-			cmpl	$1, %ecx
-			movl	PARAM_DST, %edx
-			ja	L(two_or_more)
-
-
-			movl	(%ebx), %ecx
-			popl	%ebx
-ifelse(M4_i_neg_src2,1,`notl	%ecx')
-			M4_i	(%eax), %ecx
-ifelse(M4_i_neg_dst,1,`	notl	%ecx')
-			movl	%ecx, (%edx)
-
-			ret
-
-
-L(two_or_more):
-			C eax	src1
-			C ebx	src2
-			C ecx	size
-			C edx	dst
-			C esi
-			C edi
-			C ebp
-			C
-			C carry bit is low of size
-
-			pushl	%esi
-		FRAME_pushl()
-			testl	$4, %eax
-			jz	L(alignment_ok)
-
-			movl	(%ebx), %esi
-			addl	$4, %ebx
-ifelse(M4_i_neg_src2,1,`notl	%esi')
-			M4_i	(%eax), %esi
-			addl	$4, %eax
-ifelse(M4_i_neg_dst,1,`	notl	%esi')
-			movl	%esi, (%edx)
-			addl	$4, %edx
-			decl	%ecx
-
-L(alignment_ok):
-			movl	%ecx, %esi
-			shrl	%ecx
-			jnz	L(still_two_or_more)
-
-			movl	(%ebx), %ecx
-			popl	%esi
-ifelse(M4_i_neg_src2,1,`notl	%ecx')
-			M4_i	(%eax), %ecx
-ifelse(M4_i_neg_dst,1,`	notl	%ecx')
-			popl	%ebx
-			movl	%ecx, (%edx)
-			ret
-
-
-L(still_two_or_more):
-ifelse(eval(M4_p_neg_src2 || M4_p_neg_dst),1,`
-			pcmpeqd	%mm7, %mm7	C all ones
-')
-
-			ALIGN(16)
-L(top):
-			C eax	src1
-			C ebx	src2
-			C ecx	counter
-			C edx	dst
-			C esi
-			C edi
-			C ebp
-			C
-			C carry bit is low of size
-
-			movq	-8(%ebx,%ecx,8), %mm0
-ifelse(M4_p_neg_src2,1,`pxor	%mm7, %mm0')
-			M4_p	-8(%eax,%ecx,8), %mm0
-ifelse(M4_p_neg_dst,1,`	pxor	%mm7, %mm0')
-			movq	%mm0, -8(%edx,%ecx,8)
-
-			loop	L(top)
-
-
-			jnc	L(no_extra)
-
-			movl	-4(%ebx,%esi,4), %ebx
-ifelse(M4_i_neg_src2,1,`notl	%ebx')
-			M4_i	-4(%eax,%esi,4), %ebx
-ifelse(M4_i_neg_dst,1,`	notl	%ebx')
-			movl	%ebx, -4(%edx,%esi,4)
-L(no_extra):
-
-			popl	%esi
-			popl	%ebx
-			emms_or_femms
-			ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/mmx/lshift.asm b/ghc/rts/gmp/mpn/x86/k6/mmx/lshift.asm
deleted file mode 100644
index f1dc83db46..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/mmx/lshift.asm
+++ /dev/null
@@ -1,122 +0,0 @@
-dnl  AMD K6 mpn_lshift -- mpn left shift.
-dnl 
-dnl  K6: 3.0 cycles/limb
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_lshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       unsigned shift);
-C
-C The loop runs at 3 cycles/limb, limited by decoding and by having 3 mmx
-C instructions.  This is despite every second fetch being unaligned.
-
-
-defframe(PARAM_SHIFT,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,  8)
-defframe(PARAM_DST,  4)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_lshift)
-deflit(`FRAME',0)
-
-	C The 1 limb case can be done without the push %ebx, but it's then
-	C still the same speed.  The push is left as a free helping hand for
-	C the two_or_more code.
-
-	movl	PARAM_SIZE, %eax
-	pushl	%ebx			FRAME_pushl()
-
-	movl	PARAM_SRC, %ebx
-	decl	%eax
-
-	movl	PARAM_SHIFT, %ecx
-	jnz	L(two_or_more)
-
-	movl	(%ebx), %edx		C src limb
-	movl	PARAM_DST, %ebx
-
-	shldl(	%cl, %edx, %eax)	C return value
-
- 	shll	%cl, %edx
-
-	movl	%edx, (%ebx)		C dst limb
-	popl	%ebx
-
-	ret
-
-
-	ALIGN(16)	C avoid offset 0x1f
-	nop		C avoid bad cache line crossing
-L(two_or_more):
-	C eax	size-1
-	C ebx	src
-	C ecx	shift
-	C edx
-
-	movl	(%ebx,%eax,4), %edx	C src high limb
-	negl	%ecx
-
-	movd	PARAM_SHIFT, %mm6
-	addl	$32, %ecx		C 32-shift
-
-	shrl	%cl, %edx
-
-	movd	%ecx, %mm7
-	movl	PARAM_DST, %ecx
-
-L(top):
-	C eax	counter, size-1 to 1
-	C ebx	src
-	C ecx	dst
-	C edx	retval
-	C
-	C mm0	scratch
-	C mm6	shift
-	C mm7	32-shift
-
-	movq	-4(%ebx,%eax,4), %mm0
-	decl	%eax
-
- 	psrlq	%mm7, %mm0
-
-	movd	%mm0, 4(%ecx,%eax,4)
-	jnz	L(top)
-
-
-	movd	(%ebx), %mm0
-	popl	%ebx
-
- 	psllq	%mm6, %mm0
-	movl	%edx, %eax
-
-	movd	%mm0, (%ecx)
-
-	emms
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/mmx/popham.asm b/ghc/rts/gmp/mpn/x86/k6/mmx/popham.asm
deleted file mode 100644
index 2c619252bb..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/mmx/popham.asm
+++ /dev/null
@@ -1,238 +0,0 @@
-dnl  AMD K6-2 mpn_popcount, mpn_hamdist -- mpn bit population count and
-dnl  hamming distance.
-dnl
-dnl         popcount  hamdist
-dnl  K6-2:    9.0       11.5   cycles/limb
-dnl  K6:      12.5      13.0
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C unsigned long mpn_popcount (mp_srcptr src, mp_size_t size);
-C unsigned long mpn_hamdist (mp_srcptr src, mp_srcptr src2, mp_size_t size);
-C
-C The code here isn't optimal, but it's already a 2x speedup over the plain
-C integer mpn/generic/popcount.c,hamdist.c.
-
-
-ifdef(`OPERATION_popcount',,
-`ifdef(`OPERATION_hamdist',,
-`m4_error(`Need OPERATION_popcount or OPERATION_hamdist
-')m4exit(1)')')
-
-define(HAM,
-m4_assert_numargs(1)
-`ifdef(`OPERATION_hamdist',`$1')')
-
-define(POP,
-m4_assert_numargs(1)
-`ifdef(`OPERATION_popcount',`$1')')
-
-HAM(`
-defframe(PARAM_SIZE,   12)
-defframe(PARAM_SRC2,   8)
-defframe(PARAM_SRC,    4)
-define(M4_function,mpn_hamdist)
-')
-POP(`
-defframe(PARAM_SIZE,   8)
-defframe(PARAM_SRC,    4)
-define(M4_function,mpn_popcount)
-')
-
-MULFUNC_PROLOGUE(mpn_popcount mpn_hamdist)
-
-
-ifdef(`PIC',,`
-	dnl  non-PIC
-
-	DATA
-	ALIGN(8)
-
-define(LS,
-m4_assert_numargs(1)
-`LF(M4_function,`$1')')
-
-LS(rodata_AAAAAAAAAAAAAAAA):
-	.long	0xAAAAAAAA
-	.long	0xAAAAAAAA
-
-LS(rodata_3333333333333333):
-	.long	0x33333333
-	.long	0x33333333
-
-LS(rodata_0F0F0F0F0F0F0F0F):
-	.long	0x0F0F0F0F
-	.long	0x0F0F0F0F
-
-LS(rodata_000000FF000000FF):
-	.long	0x000000FF
-	.long	0x000000FF
-')
-
-	.text
-	ALIGN(32)
-
-POP(`ifdef(`PIC', `
-	C avoid shrl crossing a 32-byte boundary
-	nop')')
-
-PROLOGUE(M4_function)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	orl	%ecx, %ecx
-	jz	L(zero)
-
-ifdef(`PIC',`
-	movl	$0xAAAAAAAA, %eax
-	movl	$0x33333333, %edx
-
-	movd	%eax, %mm7
-	movd	%edx, %mm6
-
-	movl	$0x0F0F0F0F, %eax
-	movl	$0x000000FF, %edx
-
-	punpckldq %mm7, %mm7
-	punpckldq %mm6, %mm6
-
-	movd	%eax, %mm5
-	movd	%edx, %mm4
-
-	punpckldq %mm5, %mm5
-	punpckldq %mm4, %mm4
-',`
-
-	movq	LS(rodata_AAAAAAAAAAAAAAAA), %mm7
-	movq	LS(rodata_3333333333333333), %mm6
-	movq	LS(rodata_0F0F0F0F0F0F0F0F), %mm5
-	movq	LS(rodata_000000FF000000FF), %mm4
-')
-
-define(REG_AAAAAAAAAAAAAAAA, %mm7)
-define(REG_3333333333333333, %mm6)
-define(REG_0F0F0F0F0F0F0F0F, %mm5)
-define(REG_000000FF000000FF, %mm4)
-
-
-	movl	PARAM_SRC, %eax
-HAM(`	movl	PARAM_SRC2, %edx')
-
-	pxor	%mm2, %mm2	C total
-
-	shrl	%ecx
-	jnc	L(top)
-
-Zdisp(	movd,	0,(%eax,%ecx,8), %mm1)
-
-HAM(`
-Zdisp(	movd,	0,(%edx,%ecx,8), %mm0)
-	pxor	%mm0, %mm1
-')
-
-	incl	%ecx
-	jmp	L(loaded)
-
-
-	ALIGN(16)
-POP(`	nop	C alignment to avoid crossing 32-byte boundaries')
-
-L(top):
-	C eax	src
-	C ebx
-	C ecx	counter, qwords, decrementing
-	C edx	[hamdist] src2
-	C
-	C mm0	(scratch)
-	C mm1	(scratch)
-	C mm2	total (low dword)
-	C mm3
-	C mm4	\
-	C mm5	| special constants
-	C mm6	|
-	C mm7	/
-
-	movq	-8(%eax,%ecx,8), %mm1
-HAM(`	pxor	-8(%edx,%ecx,8), %mm1')
-
-L(loaded):
-	movq	%mm1, %mm0
-	pand	REG_AAAAAAAAAAAAAAAA, %mm1
-
-	psrlq	$1, %mm1
-HAM(`	nop			C code alignment')
-
-	psubd	%mm1, %mm0	C bit pairs
-HAM(`	nop			C code alignment')
-
-
-	movq	%mm0, %mm1
-	psrlq	$2, %mm0
-
-	pand	REG_3333333333333333, %mm0
-	pand	REG_3333333333333333, %mm1
-
-	paddd	%mm1, %mm0	C nibbles
-
-
-	movq	%mm0, %mm1
-	psrlq	$4, %mm0
-
-	pand	REG_0F0F0F0F0F0F0F0F, %mm0
-	pand	REG_0F0F0F0F0F0F0F0F, %mm1
-
-	paddd	%mm1, %mm0	C bytes
-
-	movq	%mm0, %mm1
-	psrlq	$8, %mm0
-
-
-	paddb	%mm1, %mm0	C words
-
-
-	movq	%mm0, %mm1
-	psrlq	$16, %mm0
-
-	paddd	%mm1, %mm0	C dwords
-
-	pand	REG_000000FF000000FF, %mm0
-
-	paddd	%mm0, %mm2	C low to total
-	psrlq	$32, %mm0
-
-	paddd	%mm0, %mm2	C high to total
-	loop	L(top)
-
-
-
-	movd	%mm2, %eax
-	emms_or_femms
-	ret
-
-L(zero):
-	movl	$0, %eax
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/mmx/rshift.asm b/ghc/rts/gmp/mpn/x86/k6/mmx/rshift.asm
deleted file mode 100644
index cc5948f26c..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/mmx/rshift.asm
+++ /dev/null
@@ -1,122 +0,0 @@
-dnl  AMD K6 mpn_rshift -- mpn right shift.
-dnl 
-dnl  K6: 3.0 cycles/limb
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_rshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       unsigned shift);
-C
-C The loop runs at 3 cycles/limb, limited by decoding and by having 3 mmx
-C instructions.  This is despite every second fetch being unaligned.
-
-
-defframe(PARAM_SHIFT,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,  8)
-defframe(PARAM_DST,  4)
-deflit(`FRAME',0)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_rshift)
-deflit(`FRAME',0)
-
-	C The 1 limb case can be done without the push %ebx, but it's then
-	C still the same speed.  The push is left as a free helping hand for
-	C the two_or_more code.
-
-	movl	PARAM_SIZE, %eax
-	pushl	%ebx			FRAME_pushl()
-
-	movl	PARAM_SRC, %ebx
-	decl	%eax
-
-	movl	PARAM_SHIFT, %ecx
-	jnz	L(two_or_more)
-
-	movl	(%ebx), %edx		C src limb
-	movl	PARAM_DST, %ebx
-
-	shrdl(	%cl, %edx, %eax)	C return value
-
- 	shrl	%cl, %edx
-
-	movl	%edx, (%ebx)		C dst limb
-	popl	%ebx
-
-	ret
-
-
-	ALIGN(16)	C avoid offset 0x1f
-L(two_or_more):
-	C eax	size-1
-	C ebx	src
-	C ecx	shift
-	C edx
-
-	movl	(%ebx), %edx	C src low limb
-	negl	%ecx
-
-	addl	$32, %ecx	C 32-shift
-	movd	PARAM_SHIFT, %mm6
-
-	shll	%cl, %edx	C retval
-	movl	PARAM_DST, %ecx
-
-	leal	(%ebx,%eax,4), %ebx
-
-	leal	-4(%ecx,%eax,4), %ecx
-	negl	%eax
-
-
-L(simple):
-	C eax	counter (negative)
-	C ebx	&src[size-1]
-	C ecx	&dst[size-1]
-	C edx	retval
-	C
-	C mm0	scratch
-	C mm6	shift
-
-Zdisp(	movq,	0,(%ebx,%eax,4), %mm0)
-	incl	%eax
-
- 	psrlq	%mm6, %mm0
-
-Zdisp(	movd,	%mm0, 0,(%ecx,%eax,4))
-	jnz	L(simple)
-
-
-	movq	%mm0, (%ecx)
-	movl	%edx, %eax
-
-	popl	%ebx
-
-	emms
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/mul_1.asm b/ghc/rts/gmp/mpn/x86/k6/mul_1.asm
deleted file mode 100644
index c2220fe4ca..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/mul_1.asm
+++ /dev/null
@@ -1,272 +0,0 @@
-dnl  AMD K6 mpn_mul_1 -- mpn by limb multiply.
-dnl 
-dnl  K6: 6.25 cycles/limb.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_mul_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                      mp_limb_t multiplier);
-C mp_limb_t mpn_mul_1c (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       mp_limb_t multiplier, mp_limb_t carry);
-C
-C Multiply src,size by mult and store the result in dst,size.
-C Return the carry limb from the top of the result.
-C
-C mpn_mul_1c() accepts an initial carry for the calculation, it's added into
-C the low limb of the result.
-
-defframe(PARAM_CARRY,     20)
-defframe(PARAM_MULTIPLIER,16)
-defframe(PARAM_SIZE,      12)
-defframe(PARAM_SRC,       8)
-defframe(PARAM_DST,       4)
-
-dnl  minimum 5 because the unrolled code can't handle less
-deflit(UNROLL_THRESHOLD, 5)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_mul_1c)
-	pushl	%esi
-deflit(`FRAME',4)
-	movl	PARAM_CARRY, %esi
-	jmp	LF(mpn_mul_1,start_nc)
-EPILOGUE()
-
-
-PROLOGUE(mpn_mul_1)
-	push	%esi
-deflit(`FRAME',4)
-	xorl	%esi, %esi	C initial carry
-
-L(start_nc):
-	mov	PARAM_SIZE, %ecx
-	push	%ebx
-FRAME_pushl()
-
-	movl	PARAM_SRC, %ebx
-	push	%edi
-FRAME_pushl()
-
-	movl	PARAM_DST, %edi
-	pushl	%ebp
-FRAME_pushl()
-
-	cmpl	$UNROLL_THRESHOLD, %ecx
-	movl	PARAM_MULTIPLIER, %ebp
-
-	jae	L(unroll)
-
-
-	C code offset 0x22 here, close enough to aligned
-L(simple):
-	C eax	scratch
-	C ebx	src
-	C ecx	counter
-	C edx	scratch
-	C esi	carry
-	C edi	dst
-	C ebp	multiplier
-	C
-	C this loop 8 cycles/limb
-
-	movl	(%ebx), %eax
-	addl	$4, %ebx
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	movl	$0, %esi
-
-	adcl	%edx, %esi
-
-	movl	%eax, (%edi)
-	addl	$4, %edi
-
-	loop	L(simple)
-
-
-	popl	%ebp
-
-	popl	%edi
-	popl	%ebx
-
-	movl	%esi, %eax
-	popl	%esi
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-C The code for each limb is 6 cycles, with instruction decoding being the
-C limiting factor.  At 4 limbs/loop and 1 cycle/loop of overhead it's 6.25
-C cycles/limb in total.
-C
-C The secret ingredient to get 6.25 is to start the loop with the mul and
-C have the load/store pair at the end.  Rotating the load/store to the top
-C is an 0.5 c/l slowdown.  (Some address generation effect probably.)
-C
-C The whole unrolled loop fits nicely in exactly 80 bytes.
-
-
-	ALIGN(16)	C already aligned to 16 here actually
-L(unroll):
-	movl	(%ebx), %eax
-	leal	-16(%ebx,%ecx,4), %ebx
-
-	leal	-16(%edi,%ecx,4), %edi
-	subl	$4, %ecx
-
-	negl	%ecx
-
-
-	ALIGN(16)	C one byte nop for this alignment
-L(top):
-	C eax	scratch
-	C ebx	&src[size-4]
-	C ecx	counter
-	C edx	scratch
-	C esi	carry
-	C edi	&dst[size-4]
-	C ebp	multiplier
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	movl	$0, %esi
-
-	adcl	%edx, %esi
-
-	movl	%eax, (%edi,%ecx,4)
-	movl	4(%ebx,%ecx,4), %eax
-
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	movl	$0, %esi
-
-	adcl	%edx, %esi
-
-	movl	%eax, 4(%edi,%ecx,4)
-	movl	8(%ebx,%ecx,4), %eax
-
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	movl	$0, %esi
-
-	adcl	%edx, %esi
-
-	movl	%eax, 8(%edi,%ecx,4)
-	movl	12(%ebx,%ecx,4), %eax
-
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	movl	$0, %esi
-
-	adcl	%edx, %esi
-
-	movl	%eax, 12(%edi,%ecx,4)
-	movl	16(%ebx,%ecx,4), %eax
-
-
-	addl	$4, %ecx
-	js	L(top)
-
-
-
-	C eax	next src limb
-	C ebx	&src[size-4]
-	C ecx	0 to 3 representing respectively 4 to 1 further limbs
-	C edx
-	C esi	carry
-	C edi	&dst[size-4]
-
-	testb	$2, %cl
-	jnz	L(finish_not_two)
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	movl	$0, %esi
-
-	adcl	%edx, %esi
-
-	movl	%eax, (%edi,%ecx,4)
-	movl	4(%ebx,%ecx,4), %eax
-
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	movl	$0, %esi
-
-	adcl	%edx, %esi
-
-	movl	%eax, 4(%edi,%ecx,4)
-	movl	8(%ebx,%ecx,4), %eax
-
-	addl	$2, %ecx
-L(finish_not_two):
-
-
-	testb	$1, %cl
-	jnz	L(finish_not_one)
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	movl	$0, %esi
-
-	adcl	%edx, %esi
-
-	movl	%eax, 8(%edi)
-	movl	12(%ebx), %eax
-L(finish_not_one):
-
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	popl	%ebp
-
-	adcl	$0, %edx
-
-	movl	%eax, 12(%edi)
-	popl	%edi
-
-	popl	%ebx
-	movl	%edx, %eax
-
-	popl	%esi
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/mul_basecase.asm b/ghc/rts/gmp/mpn/x86/k6/mul_basecase.asm
deleted file mode 100644
index 1f5a3a4b4b..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/mul_basecase.asm
+++ /dev/null
@@ -1,600 +0,0 @@
-dnl  AMD K6 mpn_mul_basecase -- multiply two mpn numbers.
-dnl 
-dnl  K6: approx 9.0 cycles per cross product on 30x30 limbs (with 16 limbs/loop
-dnl      unrolling).
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  K6: UNROLL_COUNT cycles/product (approx)
-dnl           8           9.75
-dnl          16           9.3
-dnl          32           9.3
-dnl  Maximum possible with the current code is 32.
-dnl
-dnl  With 16 the inner unrolled loop fits exactly in a 256 byte block, which
-dnl  might explain it's good performance.
-
-deflit(UNROLL_COUNT, 16)
-
-
-C void mpn_mul_basecase (mp_ptr wp,
-C                        mp_srcptr xp, mp_size_t xsize,
-C                        mp_srcptr yp, mp_size_t ysize);
-C
-C Calculate xp,xsize multiplied by yp,ysize, storing the result in
-C wp,xsize+ysize.
-C
-C This routine is essentially the same as mpn/generic/mul_basecase.c, but
-C it's faster because it does most of the mpn_addmul_1() entry code only
-C once.  The saving is about 10-20% on typical sizes coming from the
-C Karatsuba multiply code.
-C
-C Future:
-C
-C The unrolled loop could be shared by mpn_addmul_1, with some extra stack
-C setups and maybe 2 or 3 wasted cycles at the end.  Code saving would be
-C 256 bytes.
-
-ifdef(`PIC',`
-deflit(UNROLL_THRESHOLD, 8)
-',`
-deflit(UNROLL_THRESHOLD, 8)
-')
-
-defframe(PARAM_YSIZE,20)
-defframe(PARAM_YP,   16)
-defframe(PARAM_XSIZE,12)
-defframe(PARAM_XP,   8)
-defframe(PARAM_WP,   4)
-
-	.text
-	ALIGN(32)
-PROLOGUE(mpn_mul_basecase)
-deflit(`FRAME',0)
-
-	movl	PARAM_XSIZE, %ecx
-	movl	PARAM_YP, %eax
-
-	movl	PARAM_XP, %edx
-	movl	(%eax), %eax	C yp low limb
-
-	cmpl	$2, %ecx
-	ja	L(xsize_more_than_two_limbs)
-	je	L(two_by_something)
-
-
-	C one limb by one limb
-
-	movl	(%edx), %edx	C xp low limb
-	movl	PARAM_WP, %ecx
-	
-	mull	%edx
-
-	movl	%eax, (%ecx)
-	movl	%edx, 4(%ecx)
-	ret
-
-
-C -----------------------------------------------------------------------------
-L(two_by_something):
-	decl	PARAM_YSIZE
-	pushl	%ebx
-deflit(`FRAME',4)
-
-	movl	PARAM_WP, %ebx
-	pushl	%esi
-deflit(`FRAME',8)
-
-	movl	%eax, %ecx	C yp low limb
-	movl	(%edx), %eax	C xp low limb	
-
-	movl	%edx, %esi	C xp
-	jnz	L(two_by_two)
-
-
-	C two limbs by one limb
-
-	mull	%ecx	
-
-	movl	%eax, (%ebx)
-	movl	4(%esi), %eax
-
-	movl	%edx, %esi	C carry
-
-	mull	%ecx
-
-	addl	%eax, %esi
-	movl	%esi, 4(%ebx)
-
-	adcl	$0, %edx
-
-	movl	%edx, 8(%ebx)
-	popl	%esi
-
-	popl	%ebx
-	ret
-	
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)
-L(two_by_two):
-	C eax	xp low limb
-	C ebx	wp
-	C ecx	yp low limb
-	C edx
-	C esi	xp
-	C edi
-	C ebp
-deflit(`FRAME',8)
-
-	mull	%ecx		C xp[0] * yp[0]
-
-	push	%edi
-deflit(`FRAME',12)
-	movl	%eax, (%ebx)
-
-	movl	4(%esi), %eax
-	movl	%edx, %edi	C carry, for wp[1]
-
-	mull	%ecx		C xp[1] * yp[0]
-
-	addl	%eax, %edi
-	movl	PARAM_YP, %ecx
-
-	adcl	$0, %edx
-
-	movl	%edi, 4(%ebx)
-	movl	4(%ecx), %ecx	C yp[1]
-
-	movl	4(%esi), %eax	C xp[1]
-	movl	%edx, %edi	C carry, for wp[2]
-
-	mull	%ecx		C xp[1] * yp[1]
-
-	addl	%eax, %edi
-
-	adcl	$0, %edx
-
-	movl	(%esi), %eax	C xp[0]
-	movl	%edx, %esi	C carry, for wp[3]
-
-	mull	%ecx		C xp[0] * yp[1]
-
-	addl	%eax, 4(%ebx)
-	adcl	%edx, %edi
-	adcl	$0, %esi
-
-	movl	%edi, 8(%ebx)
-	popl	%edi
-
-	movl	%esi, 12(%ebx)
-	popl	%esi
-
-	popl	%ebx
-	ret
-
-	
-C -----------------------------------------------------------------------------
-	ALIGN(16)
-L(xsize_more_than_two_limbs):
-
-C The first limb of yp is processed with a simple mpn_mul_1 style loop
-C inline.  Unrolling this doesn't seem worthwhile since it's only run once
-C (whereas the addmul below is run ysize-1 many times).  A call to the
-C actual mpn_mul_1 will be slowed down by the call and parameter pushing and
-C popping, and doesn't seem likely to be worthwhile on the typical 10-20
-C limb operations the Karatsuba code calls here with.
-
-	C eax	yp[0]
-	C ebx
-	C ecx	xsize
-	C edx	xp
-	C esi
-	C edi
-	C ebp
-deflit(`FRAME',0)
-
-	pushl	%edi		defframe_pushl(SAVE_EDI)
-	pushl	%ebp		defframe_pushl(SAVE_EBP)
-
-	movl	PARAM_WP, %edi
-	pushl	%esi		defframe_pushl(SAVE_ESI)
-
-	movl	%eax, %ebp
-	pushl	%ebx		defframe_pushl(SAVE_EBX)
-
-	leal	(%edx,%ecx,4), %ebx	C xp end
-	xorl	%esi, %esi
-
-	leal	(%edi,%ecx,4), %edi	C wp end of mul1
-	negl	%ecx
-
-
-L(mul1):
-	C eax	scratch
-	C ebx	xp end
-	C ecx	counter, negative
-	C edx	scratch
-	C esi	carry
-	C edi	wp end of mul1
-	C ebp	multiplier
-
-	movl	(%ebx,%ecx,4), %eax
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	movl	$0, %esi
-
-	adcl	%edx, %esi
-
-	movl	%eax, (%edi,%ecx,4)
-	incl	%ecx
-
-	jnz	L(mul1)
-
-
-	movl	PARAM_YSIZE, %edx
-	movl	%esi, (%edi)		C final carry
-
-	movl	PARAM_XSIZE, %ecx
-	decl	%edx
-
-	jnz	L(ysize_more_than_one_limb)
-
-	popl	%ebx
-	popl	%esi
-	popl	%ebp
-	popl	%edi
-	ret
-
-
-L(ysize_more_than_one_limb):
-	cmpl	$UNROLL_THRESHOLD, %ecx
-	movl	PARAM_YP, %eax
-
-	jae	L(unroll)
-
-
-C -----------------------------------------------------------------------------
-C Simple addmul loop.
-C
-C Using ebx and edi pointing at the ends of their respective locations saves
-C a couple of instructions in the outer loop.  The inner loop is still 11
-C cycles, the same as the simple loop in aorsmul_1.asm.
-
-	C eax	yp
-	C ebx	xp end
-	C ecx	xsize
-	C edx	ysize-1
-	C esi
-	C edi	wp end of mul1
-	C ebp
-
-	movl	4(%eax), %ebp		C multiplier
-	negl	%ecx
-
-	movl	%ecx, PARAM_XSIZE	C -xsize
-	xorl	%esi, %esi		C initial carry
-
-	leal	4(%eax,%edx,4), %eax	C yp end
-	negl	%edx
-
-	movl	%eax, PARAM_YP
-	movl	%edx, PARAM_YSIZE
-
-	jmp	L(simple_outer_entry)
-
-
-	C aligning here saves a couple of cycles
-	ALIGN(16)
-L(simple_outer_top):	
-	C edx	ysize counter, negative
-
-	movl	PARAM_YP, %eax		C yp end
-	xorl	%esi, %esi		C carry
-
-	movl	PARAM_XSIZE, %ecx	C -xsize
-	movl	%edx, PARAM_YSIZE
-
-	movl	(%eax,%edx,4), %ebp	C yp limb multiplier
-L(simple_outer_entry):
-	addl	$4, %edi
-
-
-L(simple_inner):
-	C eax	scratch
-	C ebx	xp end
-	C ecx	counter, negative
-	C edx	scratch
-	C esi	carry
-	C edi	wp end of this addmul
-	C ebp	multiplier
-
-	movl	(%ebx,%ecx,4), %eax
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	movl	$0, %esi
-
-	adcl	$0, %edx
-	addl	%eax, (%edi,%ecx,4)
-	adcl	%edx, %esi
-
-	incl	%ecx
-	jnz	L(simple_inner)
-
-
-	movl	PARAM_YSIZE, %edx
-	movl	%esi, (%edi)
-
-	incl	%edx
-	jnz	L(simple_outer_top)
-
-
-	popl	%ebx
-	popl	%esi
-	popl	%ebp
-	popl	%edi
-	ret
-
-
-C -----------------------------------------------------------------------------
-C Unrolled loop.
-C
-C The unrolled inner loop is the same as in aorsmul_1.asm, see that code for
-C some comments.
-C
-C VAR_COUNTER is for the inner loop, running from VAR_COUNTER_INIT down to
-C 0, inclusive.
-C
-C VAR_JMP is the computed jump into the unrolled loop.
-C
-C PARAM_XP and PARAM_WP get offset appropriately for where the unrolled loop
-C is entered.
-C
-C VAR_XP_LOW is the least significant limb of xp, which is needed at the
-C start of the unrolled loop.  This can't just be fetched through the xp
-C pointer because of the offset applied to it.
-C
-C PARAM_YSIZE is the outer loop counter, going from -(ysize-1) up to -1,
-C inclusive.
-C
-C PARAM_YP is offset appropriately so that the PARAM_YSIZE counter can be
-C added to give the location of the next limb of yp, which is the multiplier
-C in the unrolled loop.
-C
-C PARAM_WP is similarly offset so that the PARAM_YSIZE counter can be added
-C to give the starting point in the destination for each unrolled loop (this
-C point is one limb upwards for each limb of yp processed).
-C
-C Having PARAM_YSIZE count negative to zero means it's not necessary to
-C store new values of PARAM_YP and PARAM_WP on each loop.  Those values on
-C the stack remain constant and on each loop an leal adjusts them with the
-C PARAM_YSIZE counter value.
-
-
-defframe(VAR_COUNTER,      -20)
-defframe(VAR_COUNTER_INIT, -24)
-defframe(VAR_JMP,          -28)
-defframe(VAR_XP_LOW,       -32)
-deflit(VAR_STACK_SPACE, 16)
-
-dnl  For some strange reason using (%esp) instead of 0(%esp) is a touch
-dnl  slower in this code, hence the defframe empty-if-zero feature is
-dnl  disabled.
-dnl
-dnl  If VAR_COUNTER is at (%esp), the effect is worse.  In this case the
-dnl  unrolled loop is 255 instead of 256 bytes, but quite how this affects
-dnl  anything isn't clear.
-dnl
-define(`defframe_empty_if_zero_disabled',1)
-
-L(unroll):
-	C eax	yp (not used)
-	C ebx	xp end (not used)
-	C ecx	xsize
-	C edx	ysize-1
-	C esi
-	C edi	wp end of mul1 (not used)
-	C ebp
-deflit(`FRAME', 16)
-
-	leal	-2(%ecx), %ebp	C one limb processed at start,
-	decl	%ecx		C and ebp is one less
-
-	shrl	$UNROLL_LOG2, %ebp
-	negl	%ecx
-
-	subl	$VAR_STACK_SPACE, %esp
-deflit(`FRAME', 16+VAR_STACK_SPACE)
-	andl	$UNROLL_MASK, %ecx
-
-	movl	%ecx, %esi
-	shll	$4, %ecx
-
-	movl	%ebp, VAR_COUNTER_INIT
-	negl	%esi
-
-	C 15 code bytes per limb
-ifdef(`PIC',`
-	call	L(pic_calc)
-L(unroll_here):
-',`
-	leal	L(unroll_entry) (%ecx,%esi,1), %ecx
-')
-
-	movl	PARAM_XP, %ebx
-	movl	%ebp, VAR_COUNTER
-
-	movl	PARAM_WP, %edi
-	movl	%ecx, VAR_JMP
-
-	movl	(%ebx), %eax
-	leal	4(%edi,%esi,4), %edi	C wp adjust for unrolling and mul1
-
-	leal	(%ebx,%esi,4), %ebx	C xp adjust for unrolling
-
-	movl	%eax, VAR_XP_LOW
-
-	movl	%ebx, PARAM_XP
-	movl	PARAM_YP, %ebx
-
-	leal	(%edi,%edx,4), %ecx	C wp adjust for ysize indexing
-	movl	4(%ebx), %ebp		C multiplier (yp second limb)
-
-	leal	4(%ebx,%edx,4), %ebx	C yp adjust for ysize indexing
-
-	movl	%ecx, PARAM_WP
-
-	leal	1(%esi), %ecx	C adjust parity for decl %ecx above
-
-	movl	%ebx, PARAM_YP
-	negl	%edx
-
-	movl	%edx, PARAM_YSIZE
-	jmp	L(unroll_outer_entry)
-
-
-ifdef(`PIC',`
-L(pic_calc):
-	C See README.family about old gas bugs
-	leal	(%ecx,%esi,1), %ecx
-	addl	$L(unroll_entry)-L(unroll_here), %ecx
-	addl	(%esp), %ecx
-	ret
-')
-
-
-C -----------------------------------------------------------------------------
-	C Aligning here saves a couple of cycles per loop.  Using 32 doesn't
-	C cost any extra space, since the inner unrolled loop below is
-	C aligned to 32.
-	ALIGN(32)
-L(unroll_outer_top):
-	C edx	ysize
-
-	movl	PARAM_YP, %eax
-	movl	%edx, PARAM_YSIZE	C incremented ysize counter
-
-	movl	PARAM_WP, %edi
-
-	movl	VAR_COUNTER_INIT, %ebx
-	movl	(%eax,%edx,4), %ebp	C next multiplier
-
-	movl	PARAM_XSIZE, %ecx
-	leal	(%edi,%edx,4), %edi	C adjust wp for where we are in yp
-
-	movl	VAR_XP_LOW, %eax
-	movl	%ebx, VAR_COUNTER
-
-L(unroll_outer_entry):
-	mull	%ebp
-
-	C using testb is a tiny bit faster than testl
-	testb	$1, %cl
-
-	movl	%eax, %ecx	C low carry
-	movl	VAR_JMP, %eax
-
-	movl	%edx, %esi	C high carry
-	movl	PARAM_XP, %ebx
-
-	jnz	L(unroll_noswap)
-	movl	%ecx, %esi	C high,low carry other way around
-
-	movl	%edx, %ecx
-L(unroll_noswap):
-
-	jmp	*%eax
-
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(32)
-L(unroll_top):
-	C eax	scratch
-	C ebx	xp
-	C ecx	carry low
-	C edx	scratch
-	C esi	carry high
-	C edi	wp
-	C ebp	multiplier
-	C VAR_COUNTER  loop counter
-	C
-	C 15 code bytes each limb
-
-	leal	UNROLL_BYTES(%edi), %edi
-
-L(unroll_entry):
-deflit(CHUNK_COUNT,2)
-forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT-1, `
-	deflit(`disp0', eval(i*CHUNK_COUNT*4))
-	deflit(`disp1', eval(disp0 + 4))
-	deflit(`disp2', eval(disp1 + 4))
-
-	movl	disp1(%ebx), %eax
-	mull	%ebp
-Zdisp(	addl,	%ecx, disp0,(%edi))
-	adcl	%eax, %esi
-	movl	%edx, %ecx
-	jadcl0( %ecx)
-
-	movl	disp2(%ebx), %eax
-	mull	%ebp
-	addl	%esi, disp1(%edi)
-	adcl	%eax, %ecx
-	movl	%edx, %esi
-	jadcl0( %esi)
-')
-
-	decl	VAR_COUNTER
-	leal	UNROLL_BYTES(%ebx), %ebx
-
-	jns	L(unroll_top)
-
-
-	movl	PARAM_YSIZE, %edx
-	addl	%ecx, UNROLL_BYTES(%edi)
-
-	adcl	$0, %esi
-
-	incl	%edx
-	movl	%esi, UNROLL_BYTES+4(%edi)
-
-	jnz	L(unroll_outer_top)
-
-
-	movl	SAVE_ESI, %esi
-	movl	SAVE_EBP, %ebp
-	movl	SAVE_EDI, %edi
-	movl	SAVE_EBX, %ebx
-
-	addl	$FRAME, %esp
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k6/sqr_basecase.asm b/ghc/rts/gmp/mpn/x86/k6/sqr_basecase.asm
deleted file mode 100644
index 70d49b3e57..0000000000
--- a/ghc/rts/gmp/mpn/x86/k6/sqr_basecase.asm
+++ /dev/null
@@ -1,672 +0,0 @@
-dnl  AMD K6 mpn_sqr_basecase -- square an mpn number.
-dnl 
-dnl  K6: approx 4.7 cycles per cross product, or 9.2 cycles per triangular
-dnl  product (measured on the speed difference between 17 and 33 limbs,
-dnl  which is roughly the Karatsuba recursing range).
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  KARATSUBA_SQR_THRESHOLD_MAX is the maximum KARATSUBA_SQR_THRESHOLD this
-dnl  code supports.  This value is used only by the tune program to know
-dnl  what it can go up to.  (An attempt to compile with a bigger value will
-dnl  trigger some m4_assert()s in the code, making the build fail.)
-dnl
-dnl  The value is determined by requiring the displacements in the unrolled
-dnl  addmul to fit in single bytes.  This means a maximum UNROLL_COUNT of
-dnl  63, giving a maximum KARATSUBA_SQR_THRESHOLD of 66.
-
-deflit(KARATSUBA_SQR_THRESHOLD_MAX, 66)
-
-
-dnl  Allow a value from the tune program to override config.m4.
-
-ifdef(`KARATSUBA_SQR_THRESHOLD_OVERRIDE',
-`define(`KARATSUBA_SQR_THRESHOLD',KARATSUBA_SQR_THRESHOLD_OVERRIDE)')
-
-
-dnl  UNROLL_COUNT is the number of code chunks in the unrolled addmul.  The
-dnl  number required is determined by KARATSUBA_SQR_THRESHOLD, since
-dnl  mpn_sqr_basecase only needs to handle sizes < KARATSUBA_SQR_THRESHOLD.
-dnl
-dnl  The first addmul is the biggest, and this takes the second least
-dnl  significant limb and multiplies it by the third least significant and
-dnl  up.  Hence for a maximum operand size of KARATSUBA_SQR_THRESHOLD-1
-dnl  limbs, UNROLL_COUNT needs to be KARATSUBA_SQR_THRESHOLD-3.
-
-m4_config_gmp_mparam(`KARATSUBA_SQR_THRESHOLD')
-deflit(UNROLL_COUNT, eval(KARATSUBA_SQR_THRESHOLD-3))
-
-
-C void mpn_sqr_basecase (mp_ptr dst, mp_srcptr src, mp_size_t size);
-C
-C The algorithm is essentially the same as mpn/generic/sqr_basecase.c, but a
-C lot of function call overheads are avoided, especially when the given size
-C is small.
-C
-C The code size might look a bit excessive, but not all of it is executed
-C and so won't fill up the code cache.  The 1x1, 2x2 and 3x3 special cases
-C clearly apply only to those sizes; mid sizes like 10x10 only need part of
-C the unrolled addmul; and big sizes like 35x35 that do need all of it will
-C at least be getting value for money, because 35x35 spends something like
-C 5780 cycles here.
-C
-C Different values of UNROLL_COUNT give slightly different speeds, between
-C 9.0 and 9.2 c/tri-prod measured on the difference between 17 and 33 limbs.
-C This isn't a big difference, but it's presumably some alignment effect
-C which if understood could give a simple speedup.
-
-defframe(PARAM_SIZE,12)
-defframe(PARAM_SRC, 8)
-defframe(PARAM_DST, 4)
-
-	.text
-	ALIGN(32)
-PROLOGUE(mpn_sqr_basecase)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	movl	PARAM_SRC, %eax
-
-	cmpl	$2, %ecx
-	je	L(two_limbs)
-
-	movl	PARAM_DST, %edx
-	ja	L(three_or_more)
-
-
-C -----------------------------------------------------------------------------
-C one limb only
-	C eax	src
-	C ebx
-	C ecx	size
-	C edx	dst
-
-	movl	(%eax), %eax
-	movl	%edx, %ecx
-
-	mull	%eax
-
-	movl	%eax, (%ecx)
-	movl	%edx, 4(%ecx)
-	ret
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)
-L(two_limbs):
-	C eax	src
-	C ebx
-	C ecx	size
-	C edx	dst
-
-	pushl	%ebx
-	movl	%eax, %ebx	C src
-deflit(`FRAME',4)
-
-	movl	(%ebx), %eax
-	movl	PARAM_DST, %ecx
-
-	mull	%eax		C src[0]^2
-
-	movl	%eax, (%ecx)
-	movl	4(%ebx), %eax
-
-	movl	%edx, 4(%ecx)
-
-	mull	%eax		C src[1]^2
-
-	movl	%eax, 8(%ecx)
-	movl	(%ebx), %eax
-
-	movl	%edx, 12(%ecx)
-	movl	4(%ebx), %edx
-
-	mull	%edx		C src[0]*src[1]
-
-	addl	%eax, 4(%ecx)
-
-	adcl	%edx, 8(%ecx)
-	adcl	$0, 12(%ecx)
-
-	popl	%ebx
-	addl	%eax, 4(%ecx)
-
-	adcl	%edx, 8(%ecx)
-	adcl	$0, 12(%ecx)
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-L(three_or_more):
-deflit(`FRAME',0)
-	cmpl	$4, %ecx
-	jae	L(four_or_more)
-
-
-C -----------------------------------------------------------------------------
-C three limbs
-	C eax	src
-	C ecx	size
-	C edx	dst
-
-	pushl	%ebx
-	movl	%eax, %ebx	C src
-
-	movl	(%ebx), %eax
-	movl	%edx, %ecx	C dst
-
-	mull	%eax		C src[0] ^ 2
-
-	movl	%eax, (%ecx)
-	movl	4(%ebx), %eax
-
-	movl	%edx, 4(%ecx)
-	pushl	%esi
-
-	mull	%eax		C src[1] ^ 2
-
-	movl	%eax, 8(%ecx)
-	movl	8(%ebx), %eax
-
-	movl	%edx, 12(%ecx)
-	pushl	%edi
-
-	mull	%eax		C src[2] ^ 2
-
-	movl	%eax, 16(%ecx)
-	movl	(%ebx), %eax
-
-	movl	%edx, 20(%ecx)
-	movl	4(%ebx), %edx
-
-	mull	%edx		C src[0] * src[1]
-
-	movl	%eax, %esi
-	movl	(%ebx), %eax
-
-	movl	%edx, %edi
-	movl	8(%ebx), %edx
-
-	pushl	%ebp
-	xorl	%ebp, %ebp
-
-	mull	%edx		C src[0] * src[2]
-
-	addl	%eax, %edi
-	movl	4(%ebx), %eax
-
-	adcl	%edx, %ebp
-
-	movl	8(%ebx), %edx
-
-	mull	%edx		C src[1] * src[2]
-
-	addl	%eax, %ebp
-
-	adcl	$0, %edx
-
-
-	C eax	will be dst[5]
-	C ebx
-	C ecx	dst
-	C edx	dst[4]
-	C esi	dst[1]
-	C edi	dst[2]
-	C ebp	dst[3]
-
-	xorl	%eax, %eax
-	addl	%esi, %esi
-	adcl	%edi, %edi
-	adcl	%ebp, %ebp
-	adcl	%edx, %edx
-	adcl	$0, %eax
-
-	addl	%esi, 4(%ecx)
-	adcl	%edi, 8(%ecx)
-	adcl	%ebp, 12(%ecx)
-
-	popl	%ebp
-	popl	%edi
-
-	adcl	%edx, 16(%ecx)
-
-	popl	%esi
-	popl	%ebx
-
-	adcl	%eax, 20(%ecx)
-	ASSERT(nc)
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-
-defframe(SAVE_EBX,   -4)
-defframe(SAVE_ESI,   -8)
-defframe(SAVE_EDI,   -12)
-defframe(SAVE_EBP,   -16)
-defframe(VAR_COUNTER,-20)
-defframe(VAR_JMP,    -24)
-deflit(STACK_SPACE, 24)
-
-	ALIGN(16)
-L(four_or_more):
-
-	C eax	src
-	C ebx
-	C ecx	size
-	C edx	dst
-	C esi
-	C edi
-	C ebp
-
-C First multiply src[0]*src[1..size-1] and store at dst[1..size].
-C
-C A test was done calling mpn_mul_1 here to get the benefit of its unrolled
-C loop, but this was only a tiny speedup; at 35 limbs it took 24 cycles off
-C a 5780 cycle operation, which is not surprising since the loop here is 8
-C c/l and mpn_mul_1 is 6.25 c/l.
-
-	subl	$STACK_SPACE, %esp	deflit(`FRAME',STACK_SPACE)
-	
-	movl	%edi, SAVE_EDI
-	leal	4(%edx), %edi
-
-	movl	%ebx, SAVE_EBX
-	leal	4(%eax), %ebx
-
-	movl	%esi, SAVE_ESI
-	xorl	%esi, %esi
-
-	movl	%ebp, SAVE_EBP
-
-	C eax
-	C ebx	src+4
-	C ecx	size
-	C edx
-	C esi
-	C edi	dst+4
-	C ebp
-
-	movl	(%eax), %ebp	C multiplier
-	leal	-1(%ecx), %ecx	C size-1, and pad to a 16 byte boundary
-
-
-	ALIGN(16)
-L(mul_1):
-	C eax	scratch
-	C ebx	src ptr
-	C ecx	counter
-	C edx	scratch
-	C esi	carry
-	C edi	dst ptr
-	C ebp	multiplier
-
-	movl	(%ebx), %eax
-	addl	$4, %ebx
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	movl	$0, %esi
-
-	adcl	%edx, %esi
-
-	movl	%eax, (%edi)
-	addl	$4, %edi
-
-	loop	L(mul_1)
-
-
-C Addmul src[n]*src[n+1..size-1] at dst[2*n-1...], for each n=1..size-2.
-C
-C The last two addmuls, which are the bottom right corner of the product
-C triangle, are left to the end.  These are src[size-3]*src[size-2,size-1]
-C and src[size-2]*src[size-1].  If size is 4 then it's only these corner
-C cases that need to be done.
-C
-C The unrolled code is the same as mpn_addmul_1(), see that routine for some
-C comments.
-C
-C VAR_COUNTER is the outer loop, running from -(size-4) to -1, inclusive.
-C
-C VAR_JMP is the computed jump into the unrolled code, stepped by one code
-C chunk each outer loop.
-C
-C K6 doesn't do any branch prediction on indirect jumps, which is good
-C actually because it's a different target each time.  The unrolled addmul
-C is about 3 cycles/limb faster than a simple loop, so the 6 cycle cost of
-C the indirect jump is quickly recovered.
-
-
-dnl  This value is also implicitly encoded in a shift and add.
-dnl
-deflit(CODE_BYTES_PER_LIMB, 15)
-
-dnl  With the unmodified &src[size] and &dst[size] pointers, the
-dnl  displacements in the unrolled code fit in a byte for UNROLL_COUNT
-dnl  values up to 31.  Above that an offset must be added to them.
-dnl
-deflit(OFFSET,
-ifelse(eval(UNROLL_COUNT>31),1,
-eval((UNROLL_COUNT-31)*4),
-0))
-
-	C eax
-	C ebx	&src[size]
-	C ecx
-	C edx
-	C esi	carry
-	C edi	&dst[size]
-	C ebp
-
-	movl	PARAM_SIZE, %ecx
-	movl	%esi, (%edi)
-
-	subl	$4, %ecx
-	jz	L(corner)
-
-	movl	%ecx, %edx
-ifelse(OFFSET,0,,
-`	subl	$OFFSET, %ebx')
-
-	shll	$4, %ecx
-ifelse(OFFSET,0,,
-`	subl	$OFFSET, %edi')
-
-	negl	%ecx
-
-ifdef(`PIC',`
-	call	L(pic_calc)
-L(here):
-',`
-	leal	L(unroll_inner_end)-eval(2*CODE_BYTES_PER_LIMB)(%ecx,%edx), %ecx
-')
-	negl	%edx
-
-
-	C The calculated jump mustn't be before the start of the available
-	C code.  This is the limitation UNROLL_COUNT puts on the src operand
-	C size, but checked here using the jump address directly.
-	C
-	ASSERT(ae,`
-	movl_text_address( L(unroll_inner_start), %eax)
-	cmpl	%eax, %ecx
-	')
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)
-L(unroll_outer_top):
-	C eax
-	C ebx	&src[size], constant
-	C ecx	VAR_JMP
-	C edx	VAR_COUNTER, limbs, negative
-	C esi	high limb to store
-	C edi	dst ptr, high of last addmul
-	C ebp
-
-	movl	-12+OFFSET(%ebx,%edx,4), %ebp	C multiplier
-	movl	%edx, VAR_COUNTER
-
-	movl	-8+OFFSET(%ebx,%edx,4), %eax	C first limb of multiplicand
-
-	mull	%ebp
-
-	testb	$1, %cl
-
-	movl	%edx, %esi	C high carry
-	movl	%ecx, %edx	C jump
-
-	movl	%eax, %ecx	C low carry
-	leal	CODE_BYTES_PER_LIMB(%edx), %edx
-
-	movl	%edx, VAR_JMP
-	leal	4(%edi), %edi
-
-	C A branch-free version of this using some xors was found to be a
-	C touch slower than just a conditional jump, despite the jump
-	C switching between taken and not taken on every loop.
-
-ifelse(eval(UNROLL_COUNT%2),0,
-	jz,jnz)	L(unroll_noswap)
-	movl	%esi, %eax	C high,low carry other way around
-
-	movl	%ecx, %esi
-	movl	%eax, %ecx
-L(unroll_noswap):
-
-	jmp	*%edx
-
-
-	C Must be on an even address here so the low bit of the jump address
-	C will indicate which way around ecx/esi should start.
-	C
-	C An attempt was made at padding here to get the end of the unrolled
-	C code to come out on a good alignment, to save padding before
-	C L(corner).  This worked, but turned out to run slower than just an
-	C ALIGN(2).  The reason for this is not clear, it might be related
-	C to the different speeds on different UNROLL_COUNTs noted above.
-
-	ALIGN(2)
-
-L(unroll_inner_start):
-	C eax	scratch
-	C ebx	src
-	C ecx	carry low
-	C edx	scratch
-	C esi	carry high
-	C edi	dst
-	C ebp	multiplier
-	C
-	C 15 code bytes each limb
-	C ecx/esi swapped on each chunk
-
-forloop(`i', UNROLL_COUNT, 1, `
-	deflit(`disp_src', eval(-i*4 + OFFSET))
-	deflit(`disp_dst', eval(disp_src - 4))
-
-	m4_assert(`disp_src>=-128 && disp_src<128')
-	m4_assert(`disp_dst>=-128 && disp_dst<128')
-
-ifelse(eval(i%2),0,`
-Zdisp(	movl,	disp_src,(%ebx), %eax)
-	mull	%ebp
-Zdisp(	addl,	%esi, disp_dst,(%edi))
-	adcl	%eax, %ecx
-	movl	%edx, %esi
-	jadcl0( %esi)
-',`
-	dnl  this one comes out last
-Zdisp(	movl,	disp_src,(%ebx), %eax)
-	mull	%ebp
-Zdisp(	addl,	%ecx, disp_dst,(%edi))
-	adcl	%eax, %esi
-	movl	%edx, %ecx
-	jadcl0( %ecx)
-')
-')
-L(unroll_inner_end):
-
-	addl	%esi, -4+OFFSET(%edi)
-
-	movl	VAR_COUNTER, %edx
-	jadcl0(	%ecx)
-
-	movl	%ecx, m4_empty_if_zero(OFFSET)(%edi)
-	movl	VAR_JMP, %ecx
-
-	incl	%edx
-	jnz	L(unroll_outer_top)
-	
-
-ifelse(OFFSET,0,,`
-	addl	$OFFSET, %ebx
-	addl	$OFFSET, %edi
-')
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)
-L(corner):
-	C ebx	&src[size]
-	C edi	&dst[2*size-5]
-
-	movl	-12(%ebx), %ebp
-
-	movl	-8(%ebx), %eax
-	movl	%eax, %ecx
-
-	mull	%ebp
-
-	addl	%eax, -4(%edi)
-	adcl	$0, %edx
-
-	movl	-4(%ebx), %eax
-	movl	%edx, %esi
-	movl	%eax, %ebx
-
-	mull	%ebp
-
-	addl	%esi, %eax
-	adcl	$0, %edx
-
-	addl	%eax, (%edi)
-	adcl	$0, %edx
-
-	movl	%edx, %esi
-	movl	%ebx, %eax
-
-	mull	%ecx
-
-	addl	%esi, %eax
-	movl	%eax, 4(%edi)
-
-	adcl	$0, %edx
-
-	movl	%edx, 8(%edi)
-	
-
-C -----------------------------------------------------------------------------
-C Left shift of dst[1..2*size-2], the bit shifted out becomes dst[2*size-1].
-C The loop measures about 6 cycles/iteration, though it looks like it should
-C decode in 5.
-
-L(lshift_start):
-	movl	PARAM_SIZE, %ecx
-
-	movl	PARAM_DST, %edi
-	subl	$1, %ecx		C size-1 and clear carry
-
-	movl	PARAM_SRC, %ebx
-	movl	%ecx, %edx
-
-	xorl	%eax, %eax		C ready for adcl
-
-
-	ALIGN(16)
-L(lshift):
-	C eax
-	C ebx	src (for later use)
-	C ecx	counter, decrementing
-	C edx	size-1 (for later use)
-	C esi
-	C edi	dst, incrementing
-	C ebp
-
-	rcll	4(%edi)
-	rcll	8(%edi)
-	leal	8(%edi), %edi
-	loop	L(lshift)
-
-
-	adcl	%eax, %eax
-
-	movl	%eax, 4(%edi)		C dst most significant limb
-	movl	(%ebx), %eax		C src[0]
-
-	leal	4(%ebx,%edx,4), %ebx	C &src[size]
-	subl	%edx, %ecx		C -(size-1)
-
-
-C -----------------------------------------------------------------------------
-C Now add in the squares on the diagonal, src[0]^2, src[1]^2, ...,
-C src[size-1]^2.  dst[0] hasn't yet been set at all yet, and just gets the
-C low limb of src[0]^2.
-
-
-	mull	%eax
-
-	movl	%eax, (%edi,%ecx,8)	C dst[0]
-
-
-	ALIGN(16)
-L(diag):
-	C eax	scratch
-	C ebx	&src[size]
-	C ecx	counter, negative
-	C edx	carry
-	C esi	scratch
-	C edi	dst[2*size-2]
-	C ebp
-
-	movl	(%ebx,%ecx,4), %eax
-	movl	%edx, %esi
-
-	mull	%eax
-
-	addl	%esi, 4(%edi,%ecx,8)
-	adcl	%eax, 8(%edi,%ecx,8)
-	adcl	$0, %edx
-
-	incl	%ecx
-	jnz	L(diag)
-
-
-	movl	SAVE_EBX, %ebx
-	movl	SAVE_ESI, %esi
-
-	addl	%edx, 4(%edi)		C dst most significant limb
-
-	movl	SAVE_EDI, %edi
-	movl	SAVE_EBP, %ebp
-	addl	$FRAME, %esp
-	ret
-
-
-
-C -----------------------------------------------------------------------------
-ifdef(`PIC',`
-L(pic_calc):
-        C See README.family about old gas bugs
-	addl	(%esp), %ecx
-	addl	$L(unroll_inner_end)-L(here)-eval(2*CODE_BYTES_PER_LIMB), %ecx
-	addl	%edx, %ecx
-	ret
-')
-
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/README b/ghc/rts/gmp/mpn/x86/k7/README
deleted file mode 100644
index c34315c401..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/README
+++ /dev/null
@@ -1,145 +0,0 @@
-
-                      AMD K7 MPN SUBROUTINES
-
-
-This directory contains code optimized for the AMD Athlon CPU.
-
-The mmx subdirectory has routines using MMX instructions.  All Athlons have
-MMX, the separate directory is just so that configure can omit it if the
-assembler doesn't support MMX.
-
-
-
-STATUS
-
-Times for the loops, with all code and data in L1 cache.
-
-                               cycles/limb
-	mpn_add/sub_n             1.6
-
-	mpn_copyi                 0.75 or 1.0   \ varying with data alignment
-	mpn_copyd                 0.75 or 1.0   /
-
-	mpn_divrem_1             17.0 integer part, 15.0 fractional part
-	mpn_mod_1                17.0
-	mpn_divexact_by3          8.0
-
-	mpn_l/rshift              1.2
-
-	mpn_mul_1                 3.4
-	mpn_addmul/submul_1       3.9
-
-	mpn_mul_basecase          4.42 cycles/crossproduct (approx)
-
-	mpn_popcount		   5.0
-	mpn_hamdist		   6.0
-
-Prefetching of sources hasn't yet been tried.
-
-
-
-NOTES
-
-cmov, MMX, 3DNow and some extensions to MMX and 3DNow are available.
-
-Write-allocate L1 data cache means prefetching of destinations is unnecessary.
-
-Floating point multiplications can be done in parallel with integer
-multiplications, but there doesn't seem to be any way to make use of this.
-
-Unsigned "mul"s can be issued every 3 cycles.  This suggests 3 is a limit on
-the speed of the multiplication routines.  The documentation shows mul
-executing in IEU0 (or maybe in IEU0 and IEU1 together), so it might be that,
-to get near 3 cycles code has to be arranged so that nothing else is issued
-to IEU0.  A busy IEU0 could explain why some code takes 4 cycles and other
-apparently equivalent code takes 5.
-
-
-
-OPTIMIZATIONS
-
-Unrolled loops are used to reduce looping overhead.  The unrolling is
-configurable up to 32 limbs/loop for most routines and up to 64 for some.
-The K7 has 64k L1 code cache so quite big unrolling is allowable.
-
-Computed jumps into the unrolling are used to handle sizes not a multiple of
-the unrolling.  An attractive feature of this is that times increase
-smoothly with operand size, but it may be that some routines should just
-have simple loops to finish up, especially when PIC adds between 2 and 16
-cycles to get %eip.
-
-Position independent code is implemented using a call to get %eip for the
-computed jumps and a ret is always done, rather than an addl $4,%esp or a
-popl, so the CPU return address branch prediction stack stays synchronised
-with the actual stack in memory.
-
-Branch prediction, in absence of any history, will guess forward jumps are
-not taken and backward jumps are taken.  Where possible it's arranged that
-the less likely or less important case is under a taken forward jump.
-
-
-
-CODING
-
-Instructions in general code have been shown grouped if they can execute
-together, which means up to three direct-path instructions which have no
-successive dependencies.  K7 always decodes three and has out-of-order
-execution, but the groupings show what slots might be available and what
-dependency chains exist.
-
-When there's vector-path instructions an effort is made to get triplets of
-direct-path instructions in between them, even if there's dependencies,
-since this maximizes decoding throughput and might save a cycle or two if
-decoding is the limiting factor.
-
-
-
-INSTRUCTIONS
-
-adcl       direct
-divl       39 cycles back-to-back
-lodsl,etc  vector
-loop       1 cycle vector (decl/jnz opens up one decode slot)
-movd reg   vector
-movd mem   direct
-mull       issue every 3 cycles, latency 4 cycles low word, 6 cycles high word
-popl	   vector (use movl for more than one pop)
-pushl	   direct, will pair with a load
-shrdl %cl  vector, 3 cycles, seems to be 3 decode too
-xorl r,r   false read dependency recognised
-
-
-
-REFERENCES
-
-"AMD Athlon Processor X86 Code Optimization Guide", AMD publication number
-22007, revision E, November 1999.  Available on-line,
-
-	http://www.amd.com/products/cpg/athlon/techdocs/pdf/22007.pdf
-
-"3DNow Technology Manual", AMD publication number 21928F/0-August 1999.
-This describes the femms and prefetch instructions.  Available on-line,
-
-	http://www.amd.com/K6/k6docs/pdf/21928.pdf
-
-"AMD Extensions to the 3DNow and MMX Instruction Sets Manual", AMD
-publication number 22466, revision B, August 1999.  This describes
-instructions added in the Athlon processor, such as pswapd and the extra
-prefetch forms.  Available on-line,
-
-	http://www.amd.com/products/cpg/athlon/techdocs/pdf/22466.pdf
-
-"3DNow Instruction Porting Guide", AMD publication number 22621, revision B,
-August 1999.  This has some notes on general Athlon optimizations as well as
-3DNow.  Available on-line,
-
-	http://www.amd.com/products/cpg/athlon/techdocs/pdf/22621.pdf
-
-
-
-
-----------------
-Local variables:
-mode: text
-fill-column: 76
-End:
diff --git a/ghc/rts/gmp/mpn/x86/k7/aors_n.asm b/ghc/rts/gmp/mpn/x86/k7/aors_n.asm
deleted file mode 100644
index 85fa9d3036..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/aors_n.asm
+++ /dev/null
@@ -1,250 +0,0 @@
-dnl  AMD K7 mpn_add_n/mpn_sub_n -- mpn add or subtract.
-dnl 
-dnl  K7: 1.64 cycles/limb (at 16 limb/loop).
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  K7: UNROLL_COUNT cycles/limb
-dnl           8           1.9
-dnl          16           1.64
-dnl          32           1.7
-dnl          64           2.0
-dnl  Maximum possible with the current code is 64.
-
-deflit(UNROLL_COUNT, 16)
-
-
-ifdef(`OPERATION_add_n', `
-	define(M4_inst,        adcl)
-	define(M4_function_n,  mpn_add_n)
-	define(M4_function_nc, mpn_add_nc)
-	define(M4_description, add)
-',`ifdef(`OPERATION_sub_n', `
-	define(M4_inst,        sbbl)
-	define(M4_function_n,  mpn_sub_n)
-	define(M4_function_nc, mpn_sub_nc)
-	define(M4_description, subtract)
-',`m4_error(`Need OPERATION_add_n or OPERATION_sub_n
-')')')
-
-MULFUNC_PROLOGUE(mpn_add_n mpn_add_nc mpn_sub_n mpn_sub_nc)
-
-
-C mp_limb_t M4_function_n (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
-C                         mp_size_t size);
-C mp_limb_t M4_function_nc (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
-C	                   mp_size_t size, mp_limb_t carry);
-C
-C Calculate src1,size M4_description src2,size, and store the result in
-C dst,size.  The return value is the carry bit from the top of the result (1
-C or 0).
-C
-C The _nc version accepts 1 or 0 for an initial carry into the low limb of
-C the calculation.  Note values other than 1 or 0 here will lead to garbage
-C results.
-C
-C This code runs at 1.64 cycles/limb, which is probably the best possible
-C with plain integer operations.  Each limb is 2 loads and 1 store, and in
-C one cycle the K7 can do two loads, or a load and a store, leading to 1.5
-C c/l.
-
-dnl  Must have UNROLL_THRESHOLD >= 2, since the unrolled loop can't handle 1.
-ifdef(`PIC',`
-deflit(UNROLL_THRESHOLD, 8)
-',`
-deflit(UNROLL_THRESHOLD, 8)
-')
-
-defframe(PARAM_CARRY,20)
-defframe(PARAM_SIZE, 16)
-defframe(PARAM_SRC2, 12)
-defframe(PARAM_SRC1, 8)
-defframe(PARAM_DST,  4)
-
-defframe(SAVE_EBP, -4)
-defframe(SAVE_ESI, -8)
-defframe(SAVE_EBX, -12)
-defframe(SAVE_EDI, -16)
-deflit(STACK_SPACE, 16)
-
-	.text
-	ALIGN(32)
-deflit(`FRAME',0)
-
-PROLOGUE(M4_function_nc)
-	movl	PARAM_CARRY, %eax
-	jmp	LF(M4_function_n,start)
-EPILOGUE()
-
-PROLOGUE(M4_function_n)
-
-	xorl	%eax, %eax	C carry
-L(start):
-	movl	PARAM_SIZE, %ecx
-	subl	$STACK_SPACE, %esp
-deflit(`FRAME',STACK_SPACE)
-
-	movl	%edi, SAVE_EDI
-	movl	%ebx, SAVE_EBX
-	cmpl	$UNROLL_THRESHOLD, %ecx
-
-	movl	PARAM_SRC2, %edx
-	movl	PARAM_SRC1, %ebx
-	jae	L(unroll)
-
-	movl	PARAM_DST, %edi
-	leal	(%ebx,%ecx,4), %ebx
-	leal	(%edx,%ecx,4), %edx
-
-	leal	(%edi,%ecx,4), %edi
-	negl	%ecx
-	shrl	%eax
-
-	C This loop in in a single 16 byte code block already, so no
-	C alignment necessary.
-L(simple):
-	C eax	scratch
-	C ebx	src1
-	C ecx	counter
-	C edx	src2
-	C esi
-	C edi	dst
-	C ebp
-
-	movl	(%ebx,%ecx,4), %eax
-	M4_inst	(%edx,%ecx,4), %eax
-	movl	%eax, (%edi,%ecx,4)
-	incl	%ecx
-	jnz	L(simple)
-
-	movl	$0, %eax
-	movl	SAVE_EDI, %edi
-
-	movl	SAVE_EBX, %ebx
-	setc	%al
-	addl	$STACK_SPACE, %esp
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-	C This is at 0x55, close enough to aligned.
-L(unroll):
-deflit(`FRAME',STACK_SPACE)
-	movl	%ebp, SAVE_EBP
-	andl	$-2, %ecx		C size low bit masked out
-	andl	$1, PARAM_SIZE		C size low bit kept
-
-	movl	%ecx, %edi
-	decl	%ecx
-	movl	PARAM_DST, %ebp
-
-	shrl	$UNROLL_LOG2, %ecx
-	negl	%edi
-	movl	%esi, SAVE_ESI
-
-	andl	$UNROLL_MASK, %edi
-
-ifdef(`PIC',`
-	call	L(pic_calc)
-L(here):
-',`
-	leal	L(entry) (%edi,%edi,8), %esi	C 9 bytes per
-')
-	negl	%edi
-	shrl	%eax
-
-	leal	ifelse(UNROLL_BYTES,256,128) (%ebx,%edi,4), %ebx
-	leal	ifelse(UNROLL_BYTES,256,128) (%edx,%edi,4), %edx
-	leal	ifelse(UNROLL_BYTES,256,128) (%ebp,%edi,4), %edi
-
-	jmp	*%esi
-
-
-ifdef(`PIC',`
-L(pic_calc):
-	C See README.family about old gas bugs
-	leal	(%edi,%edi,8), %esi
-	addl	$L(entry)-L(here), %esi
-	addl	(%esp), %esi
-	ret
-')
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(32)
-L(top):
-	C eax	zero
-	C ebx	src1
-	C ecx	counter
-	C edx	src2
-	C esi	scratch (was computed jump)
-	C edi	dst
-	C ebp	scratch
-
-	leal	UNROLL_BYTES(%edx), %edx
-
-L(entry):
-deflit(CHUNK_COUNT, 2)
-forloop(i, 0, UNROLL_COUNT/CHUNK_COUNT-1, `
-	deflit(`disp0', eval(i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
-	deflit(`disp1', eval(disp0 + 4))
-
-Zdisp(	movl,	disp0,(%ebx), %esi)
-	movl	disp1(%ebx), %ebp
-Zdisp(	M4_inst,disp0,(%edx), %esi)
-Zdisp(	movl,	%esi, disp0,(%edi))
-	M4_inst	disp1(%edx), %ebp
-	movl	%ebp, disp1(%edi)
-')
-
-	decl	%ecx
-	leal	UNROLL_BYTES(%ebx), %ebx
-	leal	UNROLL_BYTES(%edi), %edi
-	jns	L(top)
-
-
-	mov	PARAM_SIZE, %esi
-	movl	SAVE_EBP, %ebp
-	movl	$0, %eax
-
-	decl	%esi
-	js	L(even)
-
-	movl	(%ebx), %ecx
-	M4_inst	UNROLL_BYTES(%edx), %ecx
-	movl	%ecx, (%edi)
-L(even):
-
-	movl	SAVE_EDI, %edi
-	movl	SAVE_EBX, %ebx
-	setc	%al
-
-	movl	SAVE_ESI, %esi
-	addl	$STACK_SPACE, %esp
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/aorsmul_1.asm b/ghc/rts/gmp/mpn/x86/k7/aorsmul_1.asm
deleted file mode 100644
index 9f9c3daaf4..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/aorsmul_1.asm
+++ /dev/null
@@ -1,364 +0,0 @@
-dnl  AMD K7 mpn_addmul_1/mpn_submul_1 -- add or subtract mpn multiple.
-dnl 
-dnl  K7: 3.9 cycles/limb.
-dnl 
-dnl  Future: It should be possible to avoid the separate mul after the
-dnl  unrolled loop by moving the movl/adcl to the top.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  K7: UNROLL_COUNT  cycles/limb
-dnl           4            4.42
-dnl           8            4.16
-dnl          16            3.9
-dnl          32            3.9
-dnl          64            3.87
-dnl  Maximum possible with the current code is 64.
-
-deflit(UNROLL_COUNT, 16)
-
-
-ifdef(`OPERATION_addmul_1',`
-	define(M4_inst,        addl)
-	define(M4_function_1,  mpn_addmul_1)
-	define(M4_function_1c, mpn_addmul_1c)
-	define(M4_description, add it to)
-	define(M4_desc_retval, carry)
-',`ifdef(`OPERATION_submul_1',`
-	define(M4_inst,        subl)
-	define(M4_function_1,  mpn_submul_1)
-	define(M4_function_1c, mpn_submul_1c)
-	define(M4_description, subtract it from)
-	define(M4_desc_retval, borrow)
-',`m4_error(`Need OPERATION_addmul_1 or OPERATION_submul_1
-')')')
-
-MULFUNC_PROLOGUE(mpn_addmul_1 mpn_addmul_1c mpn_submul_1 mpn_submul_1c)
-
-
-C mp_limb_t M4_function_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                            mp_limb_t mult);
-C mp_limb_t M4_function_1c (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                             mp_limb_t mult, mp_limb_t carry);
-C
-C Calculate src,size multiplied by mult and M4_description dst,size.
-C Return the M4_desc_retval limb from the top of the result.
-
-ifdef(`PIC',`
-deflit(UNROLL_THRESHOLD, 9)
-',`
-deflit(UNROLL_THRESHOLD, 6)
-')
-
-defframe(PARAM_CARRY,     20)
-defframe(PARAM_MULTIPLIER,16)
-defframe(PARAM_SIZE,      12)
-defframe(PARAM_SRC,       8)
-defframe(PARAM_DST,       4)
-deflit(`FRAME',0)
-
-defframe(SAVE_EBX, -4)
-defframe(SAVE_ESI, -8)
-defframe(SAVE_EDI, -12)
-defframe(SAVE_EBP, -16)
-deflit(SAVE_SIZE, 16)
-
-	.text
-	ALIGN(32)
-PROLOGUE(M4_function_1)
-	movl	PARAM_SIZE, %edx
-	movl	PARAM_SRC, %eax
-	xorl	%ecx, %ecx
-
-	decl	%edx
-	jnz	LF(M4_function_1c,start_1)
-
-	movl	(%eax), %eax
-	movl	PARAM_DST, %ecx
-
-	mull	PARAM_MULTIPLIER
-
-	M4_inst	%eax, (%ecx)
-	adcl	$0, %edx
-	movl	%edx, %eax
-
-	ret
-EPILOGUE()
-
-	ALIGN(16)
-PROLOGUE(M4_function_1c)
-	movl	PARAM_SIZE, %edx
-	movl	PARAM_SRC, %eax
-
-	decl	%edx
-	jnz	L(more_than_one_limb)
-
-	movl	(%eax), %eax
-	movl	PARAM_DST, %ecx
-
-	mull	PARAM_MULTIPLIER
-
-	addl	PARAM_CARRY, %eax
-
-	adcl	$0, %edx
-	M4_inst	%eax, (%ecx)
-
-	adcl	$0, %edx
-	movl	%edx, %eax
-
-	ret
-
-
-	C offset 0x44 so close enough to aligned
-L(more_than_one_limb):
-	movl	PARAM_CARRY, %ecx
-L(start_1):
-	C eax	src
-	C ecx	initial carry
-	C edx	size-1
-	subl	$SAVE_SIZE, %esp
-deflit(`FRAME',16)
-
-	movl	%ebx, SAVE_EBX
-	movl	%esi, SAVE_ESI
-	movl	%edx, %ebx	C size-1
-
-	movl	PARAM_SRC, %esi
-	movl	%ebp, SAVE_EBP
-	cmpl	$UNROLL_THRESHOLD, %edx
-
-	movl	PARAM_MULTIPLIER, %ebp
-	movl	%edi, SAVE_EDI
-
-	movl	(%esi), %eax	C src low limb
-	movl	PARAM_DST, %edi
-	ja	L(unroll)
-
-
-	C simple loop
-
-	leal	4(%esi,%ebx,4), %esi	C point one limb past last
-	leal	(%edi,%ebx,4), %edi	C point at last limb
-	negl	%ebx
-
-	C The movl to load the next source limb is done well ahead of the
-	C mul.  This is necessary for full speed, and leads to one limb
-	C handled separately at the end.
-
-L(simple):
-	C eax	src limb
-	C ebx	loop counter
-	C ecx	carry limb
-	C edx	scratch
-	C esi	src
-	C edi	dst
-	C ebp	multiplier
-
-	mull	%ebp
-
-	addl	%eax, %ecx
-	adcl	$0, %edx
-
-	M4_inst	%ecx, (%edi,%ebx,4)
-	movl	(%esi,%ebx,4), %eax
-	adcl	$0, %edx
-
-	incl	%ebx
-	movl	%edx, %ecx
-	jnz	L(simple)
-
-
-	mull	%ebp
-
-	movl	SAVE_EBX, %ebx
-	movl	SAVE_ESI, %esi
-	movl	SAVE_EBP, %ebp
-
-	addl	%eax, %ecx
-	adcl	$0, %edx
-
-	M4_inst	%ecx, (%edi)
-	adcl	$0, %edx
-	movl	SAVE_EDI, %edi
-
-	addl	$SAVE_SIZE, %esp
-	movl	%edx, %eax
-	ret
-
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)
-L(unroll):
-	C eax	src low limb
-	C ebx	size-1
-	C ecx	carry
-	C edx	size-1
-	C esi	src
-	C edi	dst
-	C ebp	multiplier
-	
-dnl  overlapping with parameters no longer needed
-define(VAR_COUNTER,`PARAM_SIZE')
-define(VAR_JUMP,   `PARAM_MULTIPLIER')
-
-	subl	$2, %ebx	C (size-2)-1
-	decl	%edx		C size-2
-	
-	shrl	$UNROLL_LOG2, %ebx
-	negl	%edx
-
-	movl	%ebx, VAR_COUNTER
-	andl	$UNROLL_MASK, %edx
-
-	movl	%edx, %ebx
-	shll	$4, %edx
-
-ifdef(`PIC',`
-	call	L(pic_calc)
-L(here):
-',`
-	leal	L(entry) (%edx,%ebx,1), %edx
-')
-	negl	%ebx
-	movl	%edx, VAR_JUMP
-
-	mull	%ebp
-
-	addl	%eax, %ecx	C initial carry, becomes low carry
-	adcl	$0, %edx
-	testb	$1, %bl
-
-	movl	4(%esi), %eax	C src second limb
-	leal	ifelse(UNROLL_BYTES,256,128+) 8(%esi,%ebx,4), %esi
-	leal	ifelse(UNROLL_BYTES,256,128)   (%edi,%ebx,4), %edi
-
-	movl	%edx, %ebx	C high carry
-	cmovnz(	%ecx, %ebx)	C high,low carry other way around
-	cmovnz(	%edx, %ecx)
-
-	jmp	*VAR_JUMP
-
-
-ifdef(`PIC',`
-L(pic_calc):
-	C See README.family about old gas bugs
-	leal	(%edx,%ebx,1), %edx
-	addl	$L(entry)-L(here), %edx
-	addl	(%esp), %edx
-	ret
-')
-
-
-C -----------------------------------------------------------------------------
-C This code uses a "two carry limbs" scheme.  At the top of the loop the
-C carries are ebx=lo, ecx=hi, then they swap for each limb processed.  For
-C the computed jump an odd size means they start one way around, an even
-C size the other.  Either way one limb is handled separately at the start of
-C the loop.
-C
-C The positioning of the movl to load the next source limb is important.
-C Moving it after the adcl with a view to avoiding a separate mul at the end
-C of the loop slows the code down.
-
-	ALIGN(32)
-L(top):
-	C eax	src limb
-	C ebx	carry high
-	C ecx	carry low
-	C edx	scratch
-	C esi	src+8
-	C edi	dst
-	C ebp	multiplier
-	C
-	C VAR_COUNTER  loop counter
-	C
-	C 17 bytes each limb
-
-L(entry):
-deflit(CHUNK_COUNT,2)
-forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT-1, `
-	deflit(`disp0', eval(i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
-	deflit(`disp1', eval(disp0 + 4))
-
-	mull	%ebp
-
-Zdisp(	M4_inst,%ecx, disp0,(%edi))
-	movl	$0, %ecx
-
-	adcl	%eax, %ebx
-
-Zdisp(	movl,	disp0,(%esi), %eax)
-	adcl	%edx, %ecx	
-
-
-	mull	%ebp
-
-	M4_inst	%ebx, disp1(%edi)
-	movl	$0, %ebx
-
-	adcl	%eax, %ecx
-
-	movl	disp1(%esi), %eax
-	adcl	%edx, %ebx
-')
-
-	decl	VAR_COUNTER
-	leal	UNROLL_BYTES(%esi), %esi
-	leal	UNROLL_BYTES(%edi), %edi
-
-	jns	L(top)
-
-
-	C eax	src limb
-	C ebx	carry high
-	C ecx	carry low
-	C edx
-	C esi
-	C edi	dst (points at second last limb)
-	C ebp	multiplier
-deflit(`disp0', ifelse(UNROLL_BYTES,256,-128))
-deflit(`disp1', eval(disp0-0 + 4))
-
-	mull	%ebp
-
-	M4_inst	%ecx, disp0(%edi)
-	movl	SAVE_EBP, %ebp
-
-	adcl	%ebx, %eax
-	movl	SAVE_EBX, %ebx
-	movl	SAVE_ESI, %esi
-
-	adcl	$0, %edx
-	M4_inst	%eax, disp1(%edi)
-	movl	SAVE_EDI, %edi
-
-	adcl	$0, %edx
-	addl	$SAVE_SIZE, %esp
-
-	movl	%edx, %eax
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/diveby3.asm b/ghc/rts/gmp/mpn/x86/k7/diveby3.asm
deleted file mode 100644
index 57684958a5..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/diveby3.asm
+++ /dev/null
@@ -1,131 +0,0 @@
-dnl  AMD K7 mpn_divexact_by3 -- mpn division by 3, expecting no remainder.
-dnl 
-dnl  K7: 8.0 cycles/limb
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_divexact_by3c (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                              mp_limb_t carry);
-
-defframe(PARAM_CARRY,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,   8)
-defframe(PARAM_DST,   4)
-
-dnl  multiplicative inverse of 3, modulo 2^32
-deflit(INVERSE_3,        0xAAAAAAAB)
-
-dnl  ceil(b/3) and floor(b*2/3) where b=2^32
-deflit(ONE_THIRD_CEIL,   0x55555556)
-deflit(TWO_THIRDS_FLOOR, 0xAAAAAAAA)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_divexact_by3c)
-deflit(`FRAME',0)
-
-	movl	PARAM_SRC, %ecx
-	pushl	%ebx			defframe_pushl(SAVE_EBX)
-
-	movl	PARAM_CARRY, %ebx
-	pushl	%ebp			defframe_pushl(SAVE_EBP)
-
-	movl	PARAM_SIZE, %ebp
-	pushl	%edi			defframe_pushl(SAVE_EDI)
-
-	movl	(%ecx), %eax		C src low limb
-	pushl	%esi			defframe_pushl(SAVE_ESI)
-
-	movl	PARAM_DST, %edi
-	movl	$TWO_THIRDS_FLOOR, %esi
-	leal	-4(%ecx,%ebp,4), %ecx	C &src[size-1]
-
-	subl	%ebx, %eax
-
-	setc	%bl
-	decl	%ebp
-	jz	L(last)
-
-	leal	(%edi,%ebp,4), %edi	C &dst[size-1]
-	negl	%ebp
-
-
-	ALIGN(16)
-L(top):
-	C eax	src limb, carry subtracted
-	C ebx	carry limb (0 or 1)
-	C ecx	&src[size-1]
-	C edx	scratch
-	C esi	TWO_THIRDS_FLOOR
-	C edi	&dst[size-1]
-	C ebp	counter, limbs, negative
-
-	imull	$INVERSE_3, %eax, %edx
-
-	movl	4(%ecx,%ebp,4), %eax	C next src limb
-	cmpl	$ONE_THIRD_CEIL, %edx
-
-	sbbl	$-1, %ebx		C +1 if result>=ceil(b/3)
-	cmpl	%edx, %esi
-
-	sbbl	%ebx, %eax		C and further 1 if result>=ceil(b*2/3)
-	movl	%edx, (%edi,%ebp,4)
-	incl	%ebp
-
-	setc	%bl			C new carry
-	jnz	L(top)
-
-
-
-L(last):
-	C eax	src limb, carry subtracted
-	C ebx	carry limb (0 or 1)
-	C ecx	&src[size-1]
-	C edx	scratch
-	C esi	multiplier
-	C edi	&dst[size-1]
-	C ebp
-
-	imull	$INVERSE_3, %eax
-
-	cmpl	$ONE_THIRD_CEIL, %eax
-	movl	%eax, (%edi)
-	movl	SAVE_EBP, %ebp
-
-	sbbl	$-1, %ebx		C +1 if eax>=ceil(b/3)
-	cmpl	%eax, %esi
-	movl	$0, %eax
-
-	adcl	%ebx, %eax		C further +1 if eax>=ceil(b*2/3)
-	movl	SAVE_EDI, %edi
-	movl	SAVE_ESI, %esi
-
-	movl	SAVE_EBX, %ebx
-	addl	$FRAME, %esp
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/gmp-mparam.h b/ghc/rts/gmp/mpn/x86/k7/gmp-mparam.h
deleted file mode 100644
index c3bba0afc4..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/gmp-mparam.h
+++ /dev/null
@@ -1,100 +0,0 @@
-/* AMD K7 gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 32
-#define BYTES_PER_MP_LIMB 4
-#define BITS_PER_LONGINT 32
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-
-/* the low limb is ready after 4 cycles, but normally it's the high limb
-   which is of interest, and that comes out after 6 cycles */
-#ifndef UMUL_TIME
-#define UMUL_TIME   6  /* cycles */
-#endif
-
-/* AMD doco says 40, but it measures 39 back-to-back */
-#ifndef UDIV_TIME
-#define UDIV_TIME   39  /* cycles */
-#endif
-
-/* using bsf */
-#ifndef COUNT_TRAILING_ZEROS_TIME
-#define COUNT_TRAILING_ZEROS_TIME   7  /* cycles */
-#endif
-
-
-/* Generated by tuneup.c, 2000-07-06. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD   26
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD      177
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD   52
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD      173
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD              76
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD            114
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            34
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD        5
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD          54
-#endif
-
-#ifndef FFT_MUL_TABLE
-#define FFT_MUL_TABLE  { 720, 1440, 2944, 7680, 18432, 57344, 0 }
-#endif
-#ifndef FFT_MODF_MUL_THRESHOLD
-#define FFT_MODF_MUL_THRESHOLD     736
-#endif
-#ifndef FFT_MUL_THRESHOLD
-#define FFT_MUL_THRESHOLD         6912
-#endif
-
-#ifndef FFT_SQR_TABLE
-#define FFT_SQR_TABLE  { 784, 1696, 3200, 7680, 18432, 57344, 0 }
-#endif
-#ifndef FFT_MODF_SQR_THRESHOLD
-#define FFT_MODF_SQR_THRESHOLD     800
-#endif
-#ifndef FFT_SQR_THRESHOLD
-#define FFT_SQR_THRESHOLD         8448
-#endif
diff --git a/ghc/rts/gmp/mpn/x86/k7/mmx/copyd.asm b/ghc/rts/gmp/mpn/x86/k7/mmx/copyd.asm
deleted file mode 100644
index 33214daa1f..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/mmx/copyd.asm
+++ /dev/null
@@ -1,136 +0,0 @@
-dnl  AMD K7 mpn_copyd -- copy limb vector, decrementing.
-dnl 
-dnl     alignment dst/src, A=0mod8 N=4mod8
-dnl        A/A   A/N   N/A   N/N
-dnl  K7    0.75  1.0   1.0   0.75
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C void mpn_copyd (mp_ptr dst, mp_srcptr src, mp_size_t size);
-C
-C The various comments in mpn/x86/k7/copyi.asm apply here too.
-
-defframe(PARAM_SIZE,12)
-defframe(PARAM_SRC, 8)
-defframe(PARAM_DST, 4)
-deflit(`FRAME',0)
-
-dnl  parameter space reused
-define(SAVE_EBX,`PARAM_SIZE')
-define(SAVE_ESI,`PARAM_SRC')
-
-dnl  minimum 5 since the unrolled code can't handle less than 5
-deflit(UNROLL_THRESHOLD, 5)
-
-	.text
-	ALIGN(32)
-PROLOGUE(mpn_copyd)
-
-	movl	PARAM_SIZE, %ecx
-	movl	%ebx, SAVE_EBX
-
-	movl	PARAM_SRC, %eax
-	movl	PARAM_DST, %edx
-
-	cmpl	$UNROLL_THRESHOLD, %ecx
-	jae	L(unroll)
-
-	orl	%ecx, %ecx
-	jz	L(simple_done)
-
-L(simple):
-	C eax	src
-	C ebx	scratch
-	C ecx	counter
-	C edx	dst
-	C
-	C this loop is 2 cycles/limb
-
-	movl	-4(%eax,%ecx,4), %ebx
-	movl	%ebx, -4(%edx,%ecx,4)
-	decl	%ecx
-	jnz	L(simple)
-
-L(simple_done):
-	movl	SAVE_EBX, %ebx
-	ret
-
-
-L(unroll):
-	movl	%esi, SAVE_ESI
-	leal	(%eax,%ecx,4), %ebx
-	leal	(%edx,%ecx,4), %esi
-
-	andl	%esi, %ebx
-	movl	SAVE_ESI, %esi
-	subl	$4, %ecx		C size-4
-
-	testl	$4, %ebx   C testl to pad code closer to 16 bytes for L(top)
-	jz	L(aligned)
-
-	C both src and dst unaligned, process one limb to align them
-	movl	12(%eax,%ecx,4), %ebx
-	movl	%ebx, 12(%edx,%ecx,4)
-	decl	%ecx
-L(aligned):
-
-
-	ALIGN(16)
-L(top):
-	C eax	src
-	C ebx
-	C ecx	counter, limbs
-	C edx	dst
-
-	movq	8(%eax,%ecx,4), %mm0
-	movq	(%eax,%ecx,4), %mm1
-	subl	$4, %ecx
-	movq	%mm0, 16+8(%edx,%ecx,4)
-	movq	%mm1, 16(%edx,%ecx,4)
-	jns	L(top)
-
-
-	C now %ecx is -4 to -1 representing respectively 0 to 3 limbs remaining
-
-	testb	$2, %cl
-	jz	L(finish_not_two)
-
-	movq	8(%eax,%ecx,4), %mm0
-	movq	%mm0, 8(%edx,%ecx,4)
-L(finish_not_two):
-
-	testb	$1, %cl
-	jz	L(done)
-
-	movl	(%eax), %ebx
-	movl	%ebx, (%edx)
-
-L(done):
-	movl	SAVE_EBX, %ebx
-	emms
-	ret
-
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/mmx/copyi.asm b/ghc/rts/gmp/mpn/x86/k7/mmx/copyi.asm
deleted file mode 100644
index b234a1628c..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/mmx/copyi.asm
+++ /dev/null
@@ -1,147 +0,0 @@
-dnl  AMD K7 mpn_copyi -- copy limb vector, incrementing.
-dnl 
-dnl     alignment dst/src, A=0mod8 N=4mod8
-dnl        A/A   A/N   N/A   N/N
-dnl  K7    0.75  1.0   1.0   0.75
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C void mpn_copyi (mp_ptr dst, mp_srcptr src, mp_size_t size);
-C
-C Copy src,size to dst,size.
-C
-C This code at 0.75 or 1.0 c/l is always faster than a plain rep movsl at
-C 1.33 c/l.
-C
-C The K7 can do two loads, or two stores, or a load and a store, in one
-C cycle, so if those are 64-bit operations then 0.5 c/l should be possible,
-C however nothing under 0.7 c/l is known.
-C
-C If both source and destination are unaligned then one limb is processed at
-C the start to make them aligned and so get 0.75 c/l, whereas if they'd been
-C used unaligned it would be 1.5 c/l.
-
-defframe(PARAM_SIZE,12)
-defframe(PARAM_SRC, 8)
-defframe(PARAM_DST, 4)
-
-dnl  parameter space reused
-define(SAVE_EBX,`PARAM_SIZE')
-
-dnl  minimum 5 since the unrolled code can't handle less than 5
-deflit(UNROLL_THRESHOLD, 5)
-
-	.text
-	ALIGN(32)
-PROLOGUE(mpn_copyi)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	movl	%ebx, SAVE_EBX
-
-	movl	PARAM_SRC, %eax
-	movl	PARAM_DST, %edx
-
-	cmpl	$UNROLL_THRESHOLD, %ecx
-	jae	L(unroll)
-
-	orl	%ecx, %ecx
-	jz	L(simple_done)
-
-L(simple):
-	C eax	src, incrementing
-	C ebx	scratch
-	C ecx	counter
-	C edx	dst, incrementing
-	C
-	C this loop is 2 cycles/limb
-
-	movl	(%eax), %ebx
-	movl	%ebx, (%edx)
-	decl	%ecx
-	leal	4(%eax), %eax
-	leal	4(%edx), %edx
-	jnz	L(simple)
-
-L(simple_done):
-	movl	SAVE_EBX, %ebx
-	ret
-
-
-L(unroll):
-	movl	%eax, %ebx
-	leal	-12(%eax,%ecx,4), %eax	C src end - 12
-	subl	$3, %ecx		C size-3
-
-	andl	%edx, %ebx
-	leal	(%edx,%ecx,4), %edx	C dst end - 12
-	negl	%ecx
-
-	testl	$4, %ebx   C testl to pad code closer to 16 bytes for L(top)
-	jz	L(aligned)
-
-	C both src and dst unaligned, process one limb to align them
-	movl	(%eax,%ecx,4), %ebx
-	movl	%ebx, (%edx,%ecx,4)
-	incl	%ecx
-L(aligned):
-
-
-	ALIGN(16)
-L(top):
-	C eax	src end - 12
-	C ebx
-	C ecx	counter, negative, limbs
-	C edx	dst end - 12
-
-	movq	(%eax,%ecx,4), %mm0
-	movq	8(%eax,%ecx,4), %mm1
-	addl	$4, %ecx
-	movq	%mm0, -16(%edx,%ecx,4)
-	movq	%mm1, -16+8(%edx,%ecx,4)
-	ja	L(top)		C jump no carry and not zero
-
-
-	C now %ecx is 0 to 3 representing respectively 3 to 0 limbs remaining
-
-	testb	$2, %cl
-	jnz	L(finish_not_two)
-
-	movq	(%eax,%ecx,4), %mm0
-	movq	%mm0, (%edx,%ecx,4)
-L(finish_not_two):
-
-	testb	$1, %cl
-	jnz	L(done)
-
-	movl	8(%eax), %ebx
-	movl	%ebx, 8(%edx)
-
-L(done):
-	movl	SAVE_EBX, %ebx
-	emms
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/mmx/divrem_1.asm b/ghc/rts/gmp/mpn/x86/k7/mmx/divrem_1.asm
deleted file mode 100644
index 483ad6a9a1..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/mmx/divrem_1.asm
+++ /dev/null
@@ -1,718 +0,0 @@
-dnl  AMD K7 mpn_divrem_1 -- mpn by limb division.
-dnl 
-dnl  K7: 17.0 cycles/limb integer part, 15.0 cycles/limb fraction part.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_divrem_1 (mp_ptr dst, mp_size_t xsize,
-C                         mp_srcptr src, mp_size_t size,
-C                         mp_limb_t divisor);
-C mp_limb_t mpn_divrem_1c (mp_ptr dst, mp_size_t xsize,
-C                          mp_srcptr src, mp_size_t size,
-C                          mp_limb_t divisor, mp_limb_t carry);
-C
-C The method and nomenclature follow part 8 of "Division by Invariant
-C Integers using Multiplication" by Granlund and Montgomery, reference in
-C gmp.texi.
-C
-C The "and"s shown in the paper are done here with "cmov"s.  "m" is written
-C for m', and "d" for d_norm, which won't cause any confusion since it's
-C only the normalized divisor that's of any use in the code.  "b" is written
-C for 2^N, the size of a limb, N being 32 here.
-C
-C mpn_divrem_1 avoids one division if the src high limb is less than the
-C divisor.  mpn_divrem_1c doesn't check for a zero carry, since in normal
-C circumstances that will be a very rare event.
-C
-C There's a small bias towards expecting xsize==0, by having code for
-C xsize==0 in a straight line and xsize!=0 under forward jumps.
-
-
-dnl  MUL_THRESHOLD is the value of xsize+size at which the multiply by
-dnl  inverse method is used, rather than plain "divl"s.  Minimum value 1.
-dnl
-dnl  The inverse takes about 50 cycles to calculate, but after that the
-dnl  multiply is 17 c/l versus division at 42 c/l.
-dnl
-dnl  At 3 limbs the mul is a touch faster than div on the integer part, and
-dnl  even more so on the fractional part.
-
-deflit(MUL_THRESHOLD, 3)
-
-
-defframe(PARAM_CARRY,  24)
-defframe(PARAM_DIVISOR,20)
-defframe(PARAM_SIZE,   16)
-defframe(PARAM_SRC,    12)
-defframe(PARAM_XSIZE,  8)
-defframe(PARAM_DST,    4)
-
-defframe(SAVE_EBX,    -4)
-defframe(SAVE_ESI,    -8)
-defframe(SAVE_EDI,    -12)
-defframe(SAVE_EBP,    -16)
-
-defframe(VAR_NORM,    -20)
-defframe(VAR_INVERSE, -24)
-defframe(VAR_SRC,     -28)
-defframe(VAR_DST,     -32)
-defframe(VAR_DST_STOP,-36)
-
-deflit(STACK_SPACE, 36)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_divrem_1c)
-deflit(`FRAME',0)
-	movl	PARAM_CARRY, %edx
-	movl	PARAM_SIZE, %ecx
-	subl	$STACK_SPACE, %esp
-deflit(`FRAME',STACK_SPACE)
-
-	movl	%ebx, SAVE_EBX
-	movl	PARAM_XSIZE, %ebx
-
-	movl	%edi, SAVE_EDI
-	movl	PARAM_DST, %edi
-
-	movl	%ebp, SAVE_EBP
-	movl	PARAM_DIVISOR, %ebp
-
-	movl	%esi, SAVE_ESI
-	movl	PARAM_SRC, %esi
-
-	leal	-4(%edi,%ebx,4), %edi
-	jmp	LF(mpn_divrem_1,start_1c)
-
-EPILOGUE()
-
-
-	C offset 0x31, close enough to aligned
-PROLOGUE(mpn_divrem_1)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	movl	$0, %edx		C initial carry (if can't skip a div)
-	subl	$STACK_SPACE, %esp
-deflit(`FRAME',STACK_SPACE)
-
-	movl	%ebp, SAVE_EBP
-	movl	PARAM_DIVISOR, %ebp
-
-	movl	%ebx, SAVE_EBX
-	movl	PARAM_XSIZE, %ebx
-
-	movl	%esi, SAVE_ESI
-	movl	PARAM_SRC, %esi
-	orl	%ecx, %ecx
-
-	movl	%edi, SAVE_EDI
-	movl	PARAM_DST, %edi
-	leal	-4(%edi,%ebx,4), %edi	C &dst[xsize-1]
-
-	jz	L(no_skip_div)
-	movl	-4(%esi,%ecx,4), %eax	C src high limb
-
-	cmpl	%ebp, %eax		C one less div if high<divisor
-	jnb	L(no_skip_div)
-
-	movl	$0, (%edi,%ecx,4)	C dst high limb
-	decl	%ecx			C size-1
-	movl	%eax, %edx		C src high limb as initial carry
-L(no_skip_div):
-
-
-L(start_1c):
-	C eax	
-	C ebx	xsize
-	C ecx	size
-	C edx	carry
-	C esi	src
-	C edi	&dst[xsize-1]
-	C ebp	divisor
-
-	leal	(%ebx,%ecx), %eax	C size+xsize
-	cmpl	$MUL_THRESHOLD, %eax
-	jae	L(mul_by_inverse)
-
-
-C With MUL_THRESHOLD set to 3, the simple loops here only do 0 to 2 limbs.
-C It'd be possible to write them out without the looping, but no speedup
-C would be expected.
-C
-C Using PARAM_DIVISOR instead of %ebp measures 1 cycle/loop faster on the
-C integer part, but curiously not on the fractional part, where %ebp is a
-C (fixed) couple of cycles faster.
-
-	orl	%ecx, %ecx
-	jz	L(divide_no_integer)
-
-L(divide_integer):
-	C eax	scratch (quotient)
-	C ebx	xsize
-	C ecx	counter
-	C edx	scratch (remainder)
-	C esi	src
-	C edi	&dst[xsize-1]
-	C ebp	divisor
-
-	movl	-4(%esi,%ecx,4), %eax
-
-	divl	PARAM_DIVISOR
-
-	movl	%eax, (%edi,%ecx,4)
-	decl	%ecx
-	jnz	L(divide_integer)
-
-
-L(divide_no_integer):
-	movl	PARAM_DST, %edi
-	orl	%ebx, %ebx
-	jnz	L(divide_fraction)
-
-L(divide_done):
-	movl	SAVE_ESI, %esi
-	movl	SAVE_EDI, %edi
-	movl	%edx, %eax
-
-	movl	SAVE_EBX, %ebx
-	movl	SAVE_EBP, %ebp
-	addl	$STACK_SPACE, %esp
-
-	ret
-
-
-L(divide_fraction):
-	C eax	scratch (quotient)
-	C ebx	counter
-	C ecx
-	C edx	scratch (remainder)
-	C esi
-	C edi	dst
-	C ebp	divisor
-
-	movl	$0, %eax
-
-	divl	%ebp
-
-	movl	%eax, -4(%edi,%ebx,4)
-	decl	%ebx
-	jnz	L(divide_fraction)
-
-	jmp	L(divide_done)
-
-
-
-C -----------------------------------------------------------------------------
-
-L(mul_by_inverse):
-	C eax
-	C ebx	xsize
-	C ecx	size
-	C edx	carry
-	C esi	src
-	C edi	&dst[xsize-1]
-	C ebp	divisor
-
-	bsrl	%ebp, %eax		C 31-l
-
-	leal	12(%edi), %ebx
-	leal	4(%edi,%ecx,4), %edi	C &dst[xsize+size]
-
-	movl	%edi, VAR_DST
-	movl	%ebx, VAR_DST_STOP
-
-	movl	%ecx, %ebx		C size
-	movl	$31, %ecx
-
-	movl	%edx, %edi		C carry
-	movl	$-1, %edx
-
-	C
-
-	xorl	%eax, %ecx		C l
-	incl	%eax			C 32-l
-
-	shll	%cl, %ebp		C d normalized
-	movl	%ecx, VAR_NORM
-
-	movd	%eax, %mm7
-
-	movl	$-1, %eax
-	subl	%ebp, %edx		C (b-d)-1 giving edx:eax = b*(b-d)-1
-
-	divl	%ebp			C floor (b*(b-d)-1) / d
-
-	orl	%ebx, %ebx		C size
-	movl	%eax, VAR_INVERSE
-	leal	-12(%esi,%ebx,4), %eax	C &src[size-3]
-
-	jz	L(start_zero)
-	movl	%eax, VAR_SRC
-	cmpl	$1, %ebx
-
-	movl	8(%eax), %esi		C src high limb
-	jz	L(start_one)
-
-L(start_two_or_more):
-	movl	4(%eax), %edx		C src second highest limb
-
-	shldl(	%cl, %esi, %edi)	C n2 = carry,high << l
-
-	shldl(	%cl, %edx, %esi)	C n10 = high,second << l
-
-	cmpl	$2, %ebx
-	je	L(integer_two_left)
-	jmp	L(integer_top)
-
-
-L(start_one):
-	shldl(	%cl, %esi, %edi)	C n2 = carry,high << l
-
-	shll	%cl, %esi		C n10 = high << l
-	movl	%eax, VAR_SRC
-	jmp	L(integer_one_left)
-
-
-L(start_zero):
-	shll	%cl, %edi		C n2 = carry << l
-	movl	$0, %esi		C n10 = 0
-
-	C we're here because xsize+size>=MUL_THRESHOLD, so with size==0 then
-	C must have xsize!=0
-	jmp	L(fraction_some)
-
-
-
-C -----------------------------------------------------------------------------
-C
-C The multiply by inverse loop is 17 cycles, and relies on some out-of-order
-C execution.  The instruction scheduling is important, with various
-C apparently equivalent forms running 1 to 5 cycles slower.
-C
-C A lower bound for the time would seem to be 16 cycles, based on the
-C following successive dependencies.
-C
-C		      cycles
-C		n2+n1	1
-C		mul	6
-C		q1+1	1
-C		mul	6
-C		sub	1
-C		addback	1
-C		       ---
-C		       16
-C
-C This chain is what the loop has already, but 16 cycles isn't achieved.
-C K7 has enough decode, and probably enough execute (depending maybe on what
-C a mul actually consumes), but nothing running under 17 has been found.
-C
-C In theory n2+n1 could be done in the sub and addback stages (by
-C calculating both n2 and n2+n1 there), but lack of registers makes this an
-C unlikely proposition.
-C
-C The jz in the loop keeps the q1+1 stage to 1 cycle.  Handling an overflow
-C from q1+1 with an "sbbl $0, %ebx" would add a cycle to the dependent
-C chain, and nothing better than 18 cycles has been found when using it.
-C The jump is taken only when q1 is 0xFFFFFFFF, and on random data this will
-C be an extremely rare event.
-C
-C Branch mispredictions will hit random occurrances of q1==0xFFFFFFFF, but
-C if some special data is coming out with this always, the q1_ff special
-C case actually runs at 15 c/l.  0x2FFF...FFFD divided by 3 is a good way to
-C induce the q1_ff case, for speed measurements or testing.  Note that
-C 0xFFF...FFF divided by 1 or 2 doesn't induce it.
-C
-C The instruction groupings and empty comments show the cycles for a naive
-C in-order view of the code (conveniently ignoring the load latency on
-C VAR_INVERSE).  This shows some of where the time is going, but is nonsense
-C to the extent that out-of-order execution rearranges it.  In this case
-C there's 19 cycles shown, but it executes at 17.
-
-	ALIGN(16)
-L(integer_top):
-	C eax	scratch
-	C ebx	scratch (nadj, q1)
-	C ecx	scratch (src, dst)
-	C edx	scratch
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-	C
-	C mm0	scratch (src qword)
-	C mm7	rshift for normalization
-
-	cmpl	$0x80000000, %esi  C n1 as 0=c, 1=nc
-	movl	%edi, %eax         C n2
-	movl	VAR_SRC, %ecx
-
-	leal	(%ebp,%esi), %ebx
-	cmovc(	%esi, %ebx)	   C nadj = n10 + (-n1 & d), ignoring overflow
-	sbbl	$-1, %eax          C n2+n1
-
-	mull	VAR_INVERSE        C m*(n2+n1)
-
-	movq	(%ecx), %mm0       C next limb and the one below it
-	subl	$4, %ecx
-
-	movl	%ecx, VAR_SRC
-
-	C
-
-	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
-	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
-	movl	%ebp, %eax	   C d
-
-	C
-
-	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
-	jz	L(q1_ff)
-	movl	VAR_DST, %ecx
-
-	mull	%ebx		   C (q1+1)*d
-
-	psrlq	%mm7, %mm0
-
-	leal	-4(%ecx), %ecx
-
-	C
-
-	subl	%eax, %esi
-	movl	VAR_DST_STOP, %eax
-
-	C
-
-	sbbl	%edx, %edi	   C n - (q1+1)*d
-	movl	%esi, %edi	   C remainder -> n2
-	leal	(%ebp,%esi), %edx
-
-	movd	%mm0, %esi
-
-	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
-	sbbl	$0, %ebx	   C q
-	cmpl	%eax, %ecx
-
-	movl	%ebx, (%ecx)
-	movl	%ecx, VAR_DST
-	jne	L(integer_top)
-
-
-L(integer_loop_done):
-
-
-C -----------------------------------------------------------------------------
-C
-C Here, and in integer_one_left below, an sbbl $0 is used rather than a jz
-C q1_ff special case.  This make the code a bit smaller and simpler, and
-C costs only 1 cycle (each).
-
-L(integer_two_left):
-	C eax	scratch
-	C ebx	scratch (nadj, q1)
-	C ecx	scratch (src, dst)
-	C edx	scratch
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-	C
-	C mm0	src limb, shifted
-	C mm7	rshift
-
-	cmpl	$0x80000000, %esi  C n1 as 0=c, 1=nc
-	movl	%edi, %eax         C n2
-	movl	PARAM_SRC, %ecx
-
-	leal	(%ebp,%esi), %ebx
-	cmovc(	%esi, %ebx)	   C nadj = n10 + (-n1 & d), ignoring overflow
-	sbbl	$-1, %eax          C n2+n1
-
-	mull	VAR_INVERSE        C m*(n2+n1)
-
-	movd	(%ecx), %mm0	   C src low limb
-
-	movl	VAR_DST_STOP, %ecx
-
-	C
-
-	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
-	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
-	movl	%ebp, %eax	   C d
-
-	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
-
-	sbbl	$0, %ebx
-
-	mull	%ebx		   C (q1+1)*d
-
-	psllq	$32, %mm0
-
-	psrlq	%mm7, %mm0
-
-	C
-
-	subl	%eax, %esi
-
-	C
-
-	sbbl	%edx, %edi	   C n - (q1+1)*d
-	movl	%esi, %edi	   C remainder -> n2
-	leal	(%ebp,%esi), %edx
-
-	movd	%mm0, %esi
-
-	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
-	sbbl	$0, %ebx	   C q
-
-	movl	%ebx, -4(%ecx)
-
-
-C -----------------------------------------------------------------------------
-L(integer_one_left):
-	C eax	scratch
-	C ebx	scratch (nadj, q1)
-	C ecx	dst
-	C edx	scratch
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-	C
-	C mm0	src limb, shifted
-	C mm7	rshift
-
-	movl	VAR_DST_STOP, %ecx
-	cmpl	$0x80000000, %esi  C n1 as 0=c, 1=nc
-	movl	%edi, %eax         C n2
-
-	leal	(%ebp,%esi), %ebx
-	cmovc(	%esi, %ebx)	   C nadj = n10 + (-n1 & d), ignoring overflow
-	sbbl	$-1, %eax          C n2+n1
-
-	mull	VAR_INVERSE        C m*(n2+n1)
-
-	C
-
-	C
-
-	C
-
-	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
-	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
-	movl	%ebp, %eax	   C d
-
-	C
-
-	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
-
-	sbbl	$0, %ebx           C q1 if q1+1 overflowed
-
-	mull	%ebx
-
-	C
-
-	C
-
-	C
-
-	subl	%eax, %esi
-
-	C
-
-	sbbl	%edx, %edi	   C n - (q1+1)*d
-	movl	%esi, %edi	   C remainder -> n2
-	leal	(%ebp,%esi), %edx
-
-	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
-	sbbl	$0, %ebx	   C q
-
-	movl	%ebx, -8(%ecx)
-	subl	$8, %ecx
-
-
-
-L(integer_none):
-	cmpl	$0, PARAM_XSIZE
-	jne	L(fraction_some)
-
-	movl	%edi, %eax
-L(fraction_done):
-	movl	VAR_NORM, %ecx
-	movl	SAVE_EBP, %ebp
-
-	movl	SAVE_EDI, %edi
-	movl	SAVE_ESI, %esi
-
-	movl	SAVE_EBX, %ebx
-	addl	$STACK_SPACE, %esp
-
-	shrl	%cl, %eax
-	emms
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-C
-C Special case for q1=0xFFFFFFFF, giving q=0xFFFFFFFF meaning the low dword
-C of q*d is simply -d and the remainder n-q*d = n10+d
-
-L(q1_ff):
-	C eax	(divisor)
-	C ebx	(q1+1 == 0)
-	C ecx
-	C edx
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-
-	movl	VAR_DST, %ecx
-	movl	VAR_DST_STOP, %edx
-	subl	$4, %ecx
-
-	psrlq	%mm7, %mm0
-	leal	(%ebp,%esi), %edi	C n-q*d remainder -> next n2
-	movl	%ecx, VAR_DST
-
-	movd	%mm0, %esi		C next n10
-
-	movl	$-1, (%ecx)
-	cmpl	%ecx, %edx
-	jne	L(integer_top)
-
-	jmp	L(integer_loop_done)
-
-
-
-C -----------------------------------------------------------------------------
-C
-C Being the fractional part, the "source" limbs are all zero, meaning
-C n10=0, n1=0, and hence nadj=0, leading to many instructions eliminated.
-C
-C The loop runs at 15 cycles.  The dependent chain is the same as the
-C general case above, but without the n2+n1 stage (due to n1==0), so 15
-C would seem to be the lower bound.
-C
-C A not entirely obvious simplification is that q1+1 never overflows a limb,
-C and so there's no need for the sbbl $0 or jz q1_ff from the general case.
-C q1 is the high word of m*n2+b*n2 and the following shows q1<=b-2 always.
-C rnd() means rounding down to a multiple of d.
-C
-C	m*n2 + b*n2 <= m*(d-1) + b*(d-1)
-C	             = m*d + b*d - m - b
-C	             = floor((b(b-d)-1)/d)*d + b*d - m - b
-C	             = rnd(b(b-d)-1) + b*d - m - b
-C	             = rnd(b(b-d)-1 + b*d) - m - b
-C	             = rnd(b*b-1) - m - b
-C	             <= (b-2)*b
-C
-C Unchanged from the general case is that the final quotient limb q can be
-C either q1 or q1+1, and the q1+1 case occurs often.  This can be seen from
-C equation 8.4 of the paper which simplifies as follows when n1==0 and
-C n0==0.
-C
-C	n-q1*d = (n2*k+q0*d)/b <= d + (d*d-2d)/b
-C
-C As before, the instruction groupings and empty comments show a naive
-C in-order view of the code, which is made a nonsense by out of order
-C execution.  There's 17 cycles shown, but it executes at 15.
-C
-C Rotating the store q and remainder->n2 instructions up to the top of the
-C loop gets the run time down from 16 to 15.
-
-	ALIGN(16)
-L(fraction_some):
-	C eax
-	C ebx
-	C ecx
-	C edx
-	C esi
-	C edi	carry
-	C ebp	divisor
-
-	movl	PARAM_DST, %esi
-	movl	VAR_DST_STOP, %ecx
-	movl	%edi, %eax
-
-	subl	$8, %ecx
-
-	jmp	L(fraction_entry)
-
-
-	ALIGN(16)
-L(fraction_top):
-	C eax	n2 carry, then scratch
-	C ebx	scratch (nadj, q1)
-	C ecx	dst, decrementing
-	C edx	scratch
-	C esi	dst stop point
-	C edi	(will be n2)
-	C ebp	divisor
-
-	movl	%ebx, (%ecx)	C previous q
-	movl	%eax, %edi	C remainder->n2
-
-L(fraction_entry):
-	mull	VAR_INVERSE	C m*n2
-
-	movl	%ebp, %eax	C d
-	subl	$4, %ecx	C dst
-	leal	1(%edi), %ebx
-
-	C
-
-	C
-
-	C
-
-	C
-
-	addl	%edx, %ebx	C 1 + high(n2<<32 + m*n2) = q1+1
-
-	mull	%ebx		C (q1+1)*d
-
-	C
-
-	C
-
-	C
-
-	negl	%eax		C low of n - (q1+1)*d
-
-	C
-
- 	sbbl	%edx, %edi	C high of n - (q1+1)*d, caring only about carry
- 	leal	(%ebp,%eax), %edx
-
- 	cmovc(	%edx, %eax)	C n - q1*d if underflow from using q1+1
- 	sbbl	$0, %ebx	C q
- 	cmpl	%esi, %ecx
-
-	jne	L(fraction_top)
-
-
-	movl	%ebx, (%ecx)
-	jmp	L(fraction_done)
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/mmx/lshift.asm b/ghc/rts/gmp/mpn/x86/k7/mmx/lshift.asm
deleted file mode 100644
index 4d17c881ec..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/mmx/lshift.asm
+++ /dev/null
@@ -1,472 +0,0 @@
-dnl  AMD K7 mpn_lshift -- mpn left shift.
-dnl 
-dnl  K7: 1.21 cycles/limb (at 16 limbs/loop).
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  K7: UNROLL_COUNT cycles/limb
-dnl           4           1.51
-dnl           8           1.26
-dnl          16           1.21
-dnl          32           1.2
-dnl  Maximum possible with the current code is 64.
-
-deflit(UNROLL_COUNT, 16)
-
-
-C mp_limb_t mpn_lshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       unsigned shift);
-C
-C Shift src,size left by shift many bits and store the result in dst,size.
-C Zeros are shifted in at the right.  The bits shifted out at the left are
-C the return value.
-C
-C The comments in mpn_rshift apply here too.
-
-ifdef(`PIC',`
-deflit(UNROLL_THRESHOLD, 10)
-',`
-deflit(UNROLL_THRESHOLD, 10)
-')
-
-defframe(PARAM_SHIFT,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,  8)
-defframe(PARAM_DST,  4)
-
-defframe(SAVE_EDI, -4)
-defframe(SAVE_ESI, -8)
-defframe(SAVE_EBX, -12)
-deflit(SAVE_SIZE, 12)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_lshift)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %eax
-	movl	PARAM_SRC, %edx
-	subl	$SAVE_SIZE, %esp
-deflit(`FRAME',SAVE_SIZE)
-
-	movl	PARAM_SHIFT, %ecx
-	movl	%edi, SAVE_EDI
-
-	movl	PARAM_DST, %edi
-	decl	%eax
-	jnz	L(more_than_one_limb)
-
-	movl	(%edx), %edx
-
-	shldl(	%cl, %edx, %eax)	C eax was decremented to zero
-
- 	shll	%cl, %edx
-
-	movl	%edx, (%edi)
-	movl	SAVE_EDI, %edi
-	addl	$SAVE_SIZE, %esp
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-L(more_than_one_limb):
-	C eax	size-1
-	C ebx
-	C ecx	shift
-	C edx	src
-	C esi
-	C edi	dst
-	C ebp
-
-	movd	PARAM_SHIFT, %mm6
-	movd	(%edx,%eax,4), %mm5	C src high limb
-	cmp	$UNROLL_THRESHOLD-1, %eax
-
-	jae	L(unroll)
-	negl	%ecx
-	movd	(%edx), %mm4		C src low limb
-
-	addl	$32, %ecx
-
-	movd	%ecx, %mm7
-
-L(simple_top):
-	C eax	loop counter, limbs
-	C ebx
-	C ecx
-	C edx	src
-	C esi
-	C edi	dst
-	C ebp
-	C
-	C mm0	scratch
-	C mm4	src low limb
-	C mm5	src high limb
-	C mm6	shift
-	C mm7	32-shift
-
-	movq	-4(%edx,%eax,4), %mm0
-	decl	%eax
-
- 	psrlq	%mm7, %mm0
-
-	movd	%mm0, 4(%edi,%eax,4)
-	jnz	L(simple_top)
-
-
-	psllq	%mm6, %mm5
- 	psllq	%mm6, %mm4
-
-	psrlq	$32, %mm5
-	movd	%mm4, (%edi)		C dst low limb
-
-	movd	%mm5, %eax		C return value
-
-	movl	SAVE_EDI, %edi
-	addl	$SAVE_SIZE, %esp
-	emms
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)
-L(unroll):
-	C eax	size-1
-	C ebx	(saved)
-	C ecx	shift
-	C edx	src
-	C esi
-	C edi	dst
-	C ebp
-	C
-	C mm5	src high limb, for return value
-	C mm6	lshift
-
-	movl	%esi, SAVE_ESI
-	movl	%ebx, SAVE_EBX
-	leal	-4(%edx,%eax,4), %edx   C &src[size-2]
-
-	testb	$4, %dl
-	movq	(%edx), %mm1		C src high qword
-
-	jz	L(start_src_aligned)
-
-
-	C src isn't aligned, process high limb (marked xxx) separately to
-	C make it so
-	C
-	C  source    -4(edx,%eax,4)
-	C                  |
-	C  +-------+-------+-------+--
-	C  |  xxx          |
-	C  +-------+-------+-------+--
-	C        0mod8   4mod8   0mod8
-	C
-	C  dest      -4(edi,%eax,4)
-	C                  |
-	C  +-------+-------+--
-	C  |  xxx  |       |  
-	C  +-------+-------+--
-
-	psllq	%mm6, %mm1
-	subl	$4, %edx
-	movl	%eax, PARAM_SIZE	C size-1
-
-	psrlq	$32, %mm1
-	decl	%eax			C size-2 is new size-1
-
-	movd	%mm1, 4(%edi,%eax,4)
-	movq	(%edx), %mm1		C new src high qword
-L(start_src_aligned):
-
-
-        leal    -4(%edi,%eax,4), %edi   C &dst[size-2]
-	psllq	%mm6, %mm5
-
-	testl	$4, %edi
-	psrlq	$32, %mm5		C return value
-
-	jz	L(start_dst_aligned)
-
-
-	C dst isn't aligned, subtract 4 bytes to make it so, and pretend the
-	C shift is 32 bits extra.  High limb of dst (marked xxx) handled
-	C here separately.
-	C
-	C  source       %edx
-	C  +-------+-------+--
-	C  |      mm1      |  
-	C  +-------+-------+--
-	C                0mod8   4mod8
-	C
-	C  dest         %edi
-	C  +-------+-------+-------+--
-	C  |  xxx  |          
-	C  +-------+-------+-------+--
-	C        0mod8   4mod8   0mod8
-
-	movq	%mm1, %mm0
-	psllq	%mm6, %mm1
-	addl	$32, %ecx		C shift+32
-
-	psrlq	$32, %mm1
-
-	movd	%mm1, 4(%edi)
-	movq	%mm0, %mm1
-	subl	$4, %edi
-
-	movd	%ecx, %mm6		C new lshift
-L(start_dst_aligned):
-
-	decl	%eax			C size-2, two last limbs handled at end
-	movq	%mm1, %mm2		C copy of src high qword
-	negl	%ecx
-
-	andl	$-2, %eax		C round size down to even
-	addl	$64, %ecx
-
-	movl	%eax, %ebx
-	negl	%eax
-
-	andl	$UNROLL_MASK, %eax
-	decl	%ebx
-
-	shll	%eax
-
-	movd	%ecx, %mm7		C rshift = 64-lshift
-
-ifdef(`PIC',`
-	call	L(pic_calc)
-L(here):
-',`
-	leal	L(entry) (%eax,%eax,4), %esi
-')
-	shrl	$UNROLL_LOG2, %ebx	C loop counter
-
-	leal	ifelse(UNROLL_BYTES,256,128) -8(%edx,%eax,2), %edx
-	leal	ifelse(UNROLL_BYTES,256,128) (%edi,%eax,2), %edi
-	movl	PARAM_SIZE, %eax	C for use at end
-	jmp	*%esi
-
-
-ifdef(`PIC',`
-L(pic_calc):
-	C See README.family about old gas bugs
-	leal	(%eax,%eax,4), %esi
-	addl	$L(entry)-L(here), %esi
-	addl	(%esp), %esi
-
-	ret
-')
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(32)
-L(top):
-	C eax	size (for use at end)
-	C ebx	loop counter
-	C ecx	rshift
-	C edx	src
-	C esi	computed jump
-	C edi	dst
-	C ebp
-	C
-	C mm0	scratch
-	C mm1	\ carry (alternating, mm2 first)
-	C mm2	/
-	C mm6	lshift
-	C mm7	rshift
-	C
-	C 10 code bytes/limb
-	C
-	C The two chunks differ in whether mm1 or mm2 hold the carry.
-	C The computed jump puts the initial carry in both mm1 and mm2.
-	
-L(entry):
-deflit(CHUNK_COUNT, 4)
-forloop(i, 0, UNROLL_COUNT/CHUNK_COUNT-1, `
-	deflit(`disp0', eval(-i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
-	deflit(`disp1', eval(disp0 - 8))
-
- 	movq	disp0(%edx), %mm0
- 	psllq	%mm6, %mm2
-
- 	movq	%mm0, %mm1
- 	psrlq	%mm7, %mm0
-
- 	por	%mm2, %mm0
- 	movq	%mm0, disp0(%edi)
-
-
- 	movq	disp1(%edx), %mm0
- 	psllq	%mm6, %mm1
-
- 	movq	%mm0, %mm2
- 	psrlq	%mm7, %mm0
-
- 	por	%mm1, %mm0
- 	movq	%mm0, disp1(%edi)
-')
-
-	subl	$UNROLL_BYTES, %edx
-	subl	$UNROLL_BYTES, %edi
-	decl	%ebx
-
-	jns	L(top)
-
-
-
-define(`disp', `m4_empty_if_zero(eval($1 ifelse(UNROLL_BYTES,256,-128)))')
-
-L(end):
-	testb	$1, %al
-	movl	SAVE_EBX, %ebx
-	psllq	%mm6, %mm2	C wanted left shifted in all cases below
-
-	movd	%mm5, %eax
-
-	movl	SAVE_ESI, %esi
-	jz	L(end_even)
-
-
-L(end_odd):
-
-	C Size odd, destination was aligned.
-	C
-	C                 source        edx+8   edx+4
-	C                 --+---------------+-------+
-	C                   |      mm2      |       |
-	C                 --+---------------+-------+
-	C
-	C dest                            edi
-	C --+---------------+---------------+-------+
-	C   |   written     |               |       |
-	C --+---------------+---------------+-------+
-	C
-	C mm6 = shift
-	C mm7 = ecx = 64-shift
-
-
-	C Size odd, destination was unaligned.
-	C
-	C                 source        edx+8   edx+4
-	C                 --+---------------+-------+
-	C                   |      mm2      |       |
-	C                 --+---------------+-------+
-	C
-	C         dest                            edi
-	C         --+---------------+---------------+
-	C           |   written     |               |
-	C         --+---------------+---------------+
-	C
-	C mm6 = shift+32
-	C mm7 = ecx = 64-(shift+32)
-
-
-	C In both cases there's one extra limb of src to fetch and combine
-	C with mm2 to make a qword at (%edi), and in the aligned case
-	C there's an extra limb of dst to be formed from that extra src limb
-	C left shifted.
-
-	movd	disp(4) (%edx), %mm0
-	testb	$32, %cl
-
-	movq	%mm0, %mm1
-	psllq	$32, %mm0
-
-	psrlq	%mm7, %mm0
-	psllq	%mm6, %mm1
-
-	por	%mm2, %mm0
-
-	movq	%mm0, disp(0) (%edi)
-	jz	L(end_odd_unaligned)
-	movd	%mm1, disp(-4) (%edi)
-L(end_odd_unaligned):
-
-	movl	SAVE_EDI, %edi
-	addl	$SAVE_SIZE, %esp
-	emms
-
-	ret
-
-
-L(end_even):
-
-	C Size even, destination was aligned.
-	C
-	C                 source        edx+8
-	C                 --+---------------+
-	C                   |      mm2      |
-	C                 --+---------------+
-	C
-	C dest                            edi
-	C --+---------------+---------------+
-	C   |   written     |               |
-	C --+---------------+---------------+
-	C
-	C mm6 = shift
-	C mm7 = ecx = 64-shift
-
-
-	C Size even, destination was unaligned.
-	C
-	C               source          edx+8
-	C                 --+---------------+
-	C                   |      mm2      |
-	C                 --+---------------+
-	C
-	C         dest                  edi+4
-	C         --+---------------+-------+
-	C           |    written    |       |
-	C         --+---------------+-------+
-	C
-	C mm6 = shift+32
-	C mm7 = ecx = 64-(shift+32)
-
-
-	C The movq for the aligned case overwrites the movd for the
-	C unaligned case.
-
-	movq	%mm2, %mm0
-	psrlq	$32, %mm2
-
-	testb	$32, %cl
-	movd	%mm2, disp(4) (%edi)
-
-	jz	L(end_even_unaligned)
-	movq	%mm0, disp(0) (%edi)
-L(end_even_unaligned):
-
-	movl	SAVE_EDI, %edi
-	addl	$SAVE_SIZE, %esp
-	emms
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/mmx/mod_1.asm b/ghc/rts/gmp/mpn/x86/k7/mmx/mod_1.asm
deleted file mode 100644
index 545ca56ddf..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/mmx/mod_1.asm
+++ /dev/null
@@ -1,457 +0,0 @@
-dnl  AMD K7 mpn_mod_1 -- mpn by limb remainder.
-dnl 
-dnl  K7: 17.0 cycles/limb.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_mod_1 (mp_srcptr src, mp_size_t size, mp_limb_t divisor);
-C mp_limb_t mpn_mod_1c (mp_srcptr src, mp_size_t size, mp_limb_t divisor,
-C                       mp_limb_t carry);
-C
-C The code here is the same as mpn_divrem_1, but with the quotient
-C discarded.  See mpn/x86/k7/mmx/divrem_1.c for some comments.
-
-
-dnl  MUL_THRESHOLD is the size at which the multiply by inverse method is
-dnl  used, rather than plain "divl"s.  Minimum value 2.
-dnl
-dnl  The inverse takes about 50 cycles to calculate, but after that the
-dnl  multiply is 17 c/l versus division at 41 c/l.
-dnl
-dnl  Using mul or div is about the same speed at 3 limbs, so the threshold
-dnl  is set to 4 to get the smaller div code used at 3.
-
-deflit(MUL_THRESHOLD, 4)
-
-
-defframe(PARAM_CARRY,  16)
-defframe(PARAM_DIVISOR,12)
-defframe(PARAM_SIZE,    8)
-defframe(PARAM_SRC,     4)
-
-defframe(SAVE_EBX,    -4)
-defframe(SAVE_ESI,    -8)
-defframe(SAVE_EDI,    -12)
-defframe(SAVE_EBP,    -16)
-
-defframe(VAR_NORM,    -20)
-defframe(VAR_INVERSE, -24)
-defframe(VAR_SRC_STOP,-28)
-
-deflit(STACK_SPACE, 28)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_mod_1c)
-deflit(`FRAME',0)
-	movl	PARAM_CARRY, %edx
-	movl	PARAM_SIZE, %ecx
-	subl	$STACK_SPACE, %esp
-deflit(`FRAME',STACK_SPACE)
-
-	movl	%ebp, SAVE_EBP
-	movl	PARAM_DIVISOR, %ebp
-
-	movl	%esi, SAVE_ESI
-	movl	PARAM_SRC, %esi
-	jmp	LF(mpn_mod_1,start_1c)
-
-EPILOGUE()
-
-
-	ALIGN(32)
-PROLOGUE(mpn_mod_1)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	movl	$0, %edx		C initial carry (if can't skip a div)
-	subl	$STACK_SPACE, %esp
-deflit(`FRAME',STACK_SPACE)
-
-	movl	%esi, SAVE_ESI
-	movl	PARAM_SRC, %esi
-
-	movl	%ebp, SAVE_EBP
-	movl	PARAM_DIVISOR, %ebp
-
-	orl	%ecx, %ecx
-	jz	L(divide_done)
-
-	movl	-4(%esi,%ecx,4), %eax	C src high limb
-
-	cmpl	%ebp, %eax		C carry flag if high<divisor
-					
-	cmovc(	%eax, %edx)		C src high limb as initial carry
-	sbbl	$0, %ecx		C size-1 to skip one div
-	jz	L(divide_done)
-
-
-	ALIGN(16)
-L(start_1c):
-	C eax	
-	C ebx
-	C ecx	size
-	C edx	carry
-	C esi	src
-	C edi
-	C ebp	divisor
-
-	cmpl	$MUL_THRESHOLD, %ecx
-	jae	L(mul_by_inverse)
-
-
-
-C With a MUL_THRESHOLD of 4, this "loop" only ever does 1 to 3 iterations,
-C but it's already fast and compact, and there's nothing to gain by
-C expanding it out.
-C
-C Using PARAM_DIVISOR in the divl is a couple of cycles faster than %ebp.
-
-	orl	%ecx, %ecx
-	jz	L(divide_done)
-
-
-L(divide_top):
-	C eax	scratch (quotient)
-	C ebx
-	C ecx	counter, limbs, decrementing
-	C edx	scratch (remainder)
-	C esi	src
-	C edi
-	C ebp
-
-	movl	-4(%esi,%ecx,4), %eax
-
-	divl	PARAM_DIVISOR
-
-	decl	%ecx
-	jnz	L(divide_top)
-
-
-L(divide_done):
-	movl	SAVE_ESI, %esi
-	movl	SAVE_EBP, %ebp
-	addl	$STACK_SPACE, %esp
-
-	movl	%edx, %eax
-
-	ret
-
-
-
-C -----------------------------------------------------------------------------
-
-L(mul_by_inverse):
-	C eax
-	C ebx
-	C ecx	size
-	C edx	carry
-	C esi	src
-	C edi
-	C ebp	divisor
-
-	bsrl	%ebp, %eax		C 31-l
-
-	movl	%ebx, SAVE_EBX
-	leal	-4(%esi), %ebx
-
-	movl	%ebx, VAR_SRC_STOP
-	movl	%edi, SAVE_EDI
-
-	movl	%ecx, %ebx		C size
-	movl	$31, %ecx
-
-	movl	%edx, %edi		C carry
-	movl	$-1, %edx
-
-	C
-
-	xorl	%eax, %ecx		C l
-	incl	%eax			C 32-l
-
-	shll	%cl, %ebp		C d normalized
-	movl	%ecx, VAR_NORM
-
-	movd	%eax, %mm7
-
-	movl	$-1, %eax
-	subl	%ebp, %edx		C (b-d)-1 so  edx:eax = b*(b-d)-1
-
-	divl	%ebp			C floor (b*(b-d)-1) / d
-
-	C
-
-	movl	%eax, VAR_INVERSE
-	leal	-12(%esi,%ebx,4), %eax	C &src[size-3]
-
-	movl	8(%eax), %esi		C src high limb
-	movl	4(%eax), %edx		C src second highest limb
-
-	shldl(	%cl, %esi, %edi)	C n2 = carry,high << l
-
-	shldl(	%cl, %edx, %esi)	C n10 = high,second << l
-
-	movl	%eax, %ecx		C &src[size-3]
-
-
-ifelse(MUL_THRESHOLD,2,`
-	cmpl	$2, %ebx
-	je	L(inverse_two_left)
-')
-
-
-C The dependent chain here is the same as in mpn_divrem_1, but a few
-C instructions are saved by not needing to store the quotient limbs.
-C Unfortunately this doesn't get the code down to the theoretical 16 c/l.
-C
-C There's four dummy instructions in the loop, all of which are necessary
-C for the claimed 17 c/l.  It's a 1 to 3 cycle slowdown if any are removed,
-C or changed from load to store or vice versa.  They're not completely
-C random, since they correspond to what mpn_divrem_1 has, but there's no
-C obvious reason why they're necessary.  Presumably they induce something
-C good in the out of order execution, perhaps through some load/store
-C ordering and/or decoding effects.
-C
-C The q1==0xFFFFFFFF case is handled here the same as in mpn_divrem_1.  On
-C on special data that comes out as q1==0xFFFFFFFF always, the loop runs at
-C about 13.5 c/l.
-
-	ALIGN(32)
-L(inverse_top):
-	C eax	scratch
-	C ebx	scratch (nadj, q1)
-	C ecx	src pointer, decrementing
-	C edx	scratch
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-	C
-	C mm0	scratch (src qword)
-	C mm7	rshift for normalization
-
-	cmpl	$0x80000000, %esi  C n1 as 0=c, 1=nc
-	movl	%edi, %eax         C n2
-	movl	PARAM_SIZE, %ebx   C dummy
-
-	leal	(%ebp,%esi), %ebx
-	cmovc(	%esi, %ebx)	   C nadj = n10 + (-n1 & d), ignoring overflow
-	sbbl	$-1, %eax          C n2+n1
-
-	mull	VAR_INVERSE        C m*(n2+n1)
-
-	movq	(%ecx), %mm0       C next src limb and the one below it
-	subl	$4, %ecx
-
-	movl	%ecx, PARAM_SIZE   C dummy
-
-	C
-
-	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
-	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
-	movl	%ebp, %eax	   C d
-
-	C
-
-	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
-	jz	L(q1_ff)
-	nop                        C dummy
-
-	mull	%ebx		   C (q1+1)*d
-
-	psrlq	%mm7, %mm0
-	leal	0(%ecx), %ecx      C dummy
-
-	C
-
-	C
-
-	subl	%eax, %esi
-	movl	VAR_SRC_STOP, %eax
-
-	C
-
-	sbbl	%edx, %edi	   C n - (q1+1)*d
-	movl	%esi, %edi	   C remainder -> n2
-	leal	(%ebp,%esi), %edx
-
-	movd	%mm0, %esi
-
-	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
-	cmpl	%eax, %ecx
-	jne	L(inverse_top)
-
-
-L(inverse_loop_done):
-
-
-C -----------------------------------------------------------------------------
-
-L(inverse_two_left):
-	C eax	scratch
-	C ebx	scratch (nadj, q1)
-	C ecx	&src[-1]
-	C edx	scratch
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-	C
-	C mm0	scratch (src dword)
-	C mm7	rshift
-
-	cmpl	$0x80000000, %esi  C n1 as 0=c, 1=nc
-	movl	%edi, %eax         C n2
-
-	leal	(%ebp,%esi), %ebx
-	cmovc(	%esi, %ebx)	   C nadj = n10 + (-n1 & d), ignoring overflow
-	sbbl	$-1, %eax          C n2+n1
-
-	mull	VAR_INVERSE        C m*(n2+n1)
-
-	movd	4(%ecx), %mm0	   C src low limb
-
-	C
-
-	C
-
-	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
-	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
-	movl	%ebp, %eax	   C d
-
-	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
-
-	sbbl	$0, %ebx
-
-	mull	%ebx		   C (q1+1)*d
-
-	psllq	$32, %mm0
-
-	psrlq	%mm7, %mm0
-
-	C
-
-	subl	%eax, %esi
-
-	C
-
-	sbbl	%edx, %edi	   C n - (q1+1)*d
-	movl	%esi, %edi	   C remainder -> n2
-	leal	(%ebp,%esi), %edx
-
-	movd	%mm0, %esi
-
-	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
-
-
-C One limb left
-
-	C eax	scratch
-	C ebx	scratch (nadj, q1)
-	C ecx
-	C edx	scratch
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-	C
-	C mm0	src limb, shifted
-	C mm7	rshift
-
-	cmpl	$0x80000000, %esi  C n1 as 0=c, 1=nc
-	movl	%edi, %eax         C n2
-
-	leal	(%ebp,%esi), %ebx
-	cmovc(	%esi, %ebx)	   C nadj = n10 + (-n1 & d), ignoring overflow
-	sbbl	$-1, %eax          C n2+n1
-
-	mull	VAR_INVERSE        C m*(n2+n1)
-
-	movl	VAR_NORM, %ecx     C for final denorm
-
-	C
-
-	C
-
-	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
-	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
-	movl	%ebp, %eax	   C d
-
-	C
-
-	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
-
-	sbbl	$0, %ebx
-
-	mull	%ebx		   C (q1+1)*d
-
-	movl	SAVE_EBX, %ebx
-
-	C
-
-	C
-
-	subl	%eax, %esi
-
-	movl	%esi, %eax	   C remainder
-	movl	SAVE_ESI, %esi
-
-	sbbl	%edx, %edi	   C n - (q1+1)*d
-	leal	(%ebp,%eax), %edx
-	movl	SAVE_EBP, %ebp
-
-	cmovc(	%edx, %eax)	   C n - q1*d if underflow from using q1+1
-	movl	SAVE_EDI, %edi
-
-	shrl	%cl, %eax	   C denorm remainder
-	addl	$STACK_SPACE, %esp
-	emms
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-C
-C Special case for q1=0xFFFFFFFF, giving q=0xFFFFFFFF meaning the low dword
-C of q*d is simply -d and the remainder n-q*d = n10+d
-
-L(q1_ff):
-	C eax	(divisor)
-	C ebx	(q1+1 == 0)
-	C ecx	src pointer
-	C edx
-	C esi	n10
-	C edi	(n2)
-	C ebp	divisor
-
-	movl	VAR_SRC_STOP, %edx
-	leal	(%ebp,%esi), %edi	C n-q*d remainder -> next n2
-	psrlq	%mm7, %mm0
-
-	movd	%mm0, %esi		C next n10
-
-	cmpl	%ecx, %edx
-	jne	L(inverse_top)
-	jmp	L(inverse_loop_done)
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/mmx/popham.asm b/ghc/rts/gmp/mpn/x86/k7/mmx/popham.asm
deleted file mode 100644
index fa7c8c04a5..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/mmx/popham.asm
+++ /dev/null
@@ -1,239 +0,0 @@
-dnl  AMD K7 mpn_popcount, mpn_hamdist -- population count and hamming
-dnl  distance.
-dnl 
-dnl  K7: popcount 5.0 cycles/limb, hamdist 6.0 cycles/limb
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  Only recent versions of gas know psadbw, in particular gas 2.9.1 on
-dnl  FreeBSD 3.3 and 3.4 doesn't recognise it.
-
-define(psadbw_mm4_mm0,
-`ifelse(m4_ifdef_anyof_p(`HAVE_TARGET_CPU_athlon',
-                         `HAVE_TARGET_CPU_pentium3'),1,
-	`.byte 0x0f,0xf6,0xc4	C psadbw %mm4, %mm0',
-
-`m4_warning(`warning, using simulated and only partly functional psadbw, use for testing only
-')	C this works enough for the sum of bytes done below, making it
-	C possible to test on an older cpu
-	leal	-8(%esp), %esp
-	movq	%mm4, (%esp)
-	movq	%mm0, %mm4
-forloop(i,1,7,
-`	psrlq	$ 8, %mm4
-	paddb	%mm4, %mm0
-')
-	pushl	$ 0
-	pushl	$ 0xFF
-	pand	(%esp), %mm0
-	movq	8(%esp), %mm4
-	leal	16(%esp), %esp
-')')
-
-
-C unsigned long mpn_popcount (mp_srcptr src, mp_size_t size);
-C unsigned long mpn_hamdist (mp_srcptr src, mp_srcptr src2, mp_size_t size);
-C
-C The code here is almost certainly not optimal, but is already a 3x speedup
-C over the generic C code.  The main improvement would be to interleave
-C processing of two qwords in the loop so as to fully exploit the available
-C execution units, possibly leading to 3.25 c/l (13 cycles for 4 limbs).
-C
-C The loop is based on the example "Efficient 64-bit population count using
-C MMX instructions" in the Athlon Optimization Guide, AMD document 22007,
-C page 158 of rev E (reference in mpn/x86/k7/README).
-
-ifdef(`OPERATION_popcount',,
-`ifdef(`OPERATION_hamdist',,
-`m4_error(`Need OPERATION_popcount or OPERATION_hamdist defined
-')')')
-
-define(HAM,
-m4_assert_numargs(1)
-`ifdef(`OPERATION_hamdist',`$1')')
-
-define(POP,
-m4_assert_numargs(1)
-`ifdef(`OPERATION_popcount',`$1')')
-
-HAM(`
-defframe(PARAM_SIZE,   12)
-defframe(PARAM_SRC2,   8)
-defframe(PARAM_SRC,    4)
-define(M4_function,mpn_hamdist)
-')
-POP(`
-defframe(PARAM_SIZE,   8)
-defframe(PARAM_SRC,    4)
-define(M4_function,mpn_popcount)
-')
-
-MULFUNC_PROLOGUE(mpn_popcount mpn_hamdist)
-
-
-ifdef(`PIC',,`
-	dnl  non-PIC
-
-	DATA
-	ALIGN(8)
-
-define(LS,
-m4_assert_numargs(1)
-`LF(M4_function,`$1')')
-
-LS(rodata_AAAAAAAAAAAAAAAA):
-	.long	0xAAAAAAAA
-	.long	0xAAAAAAAA
-
-LS(rodata_3333333333333333):
-	.long	0x33333333
-	.long	0x33333333
-
-LS(rodata_0F0F0F0F0F0F0F0F):
-	.long	0x0F0F0F0F
-	.long	0x0F0F0F0F
-')
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(M4_function)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	orl	%ecx, %ecx
-	jz	L(zero)
-
-ifdef(`PIC',`
-	movl	$0xAAAAAAAA, %eax
-	movl	$0x33333333, %edx
-
-	movd	%eax, %mm7
-	movd	%edx, %mm6
-
-	movl	$0x0F0F0F0F, %eax
-
-	punpckldq %mm7, %mm7
-	punpckldq %mm6, %mm6
-
-	movd	%eax, %mm5
-	movd	%edx, %mm4
-
-	punpckldq %mm5, %mm5
-
-',`
-	movq	LS(rodata_AAAAAAAAAAAAAAAA), %mm7
-	movq	LS(rodata_3333333333333333), %mm6
-	movq	LS(rodata_0F0F0F0F0F0F0F0F), %mm5
-')
-	pxor	%mm4, %mm4
-
-define(REG_AAAAAAAAAAAAAAAA,%mm7)
-define(REG_3333333333333333,%mm6)
-define(REG_0F0F0F0F0F0F0F0F,%mm5)
-define(REG_0000000000000000,%mm4)
-
-
-	movl	PARAM_SRC, %eax
-HAM(`	movl	PARAM_SRC2, %edx')
-
-	pxor	%mm2, %mm2	C total
-
-	shrl	%ecx
-	jnc	L(top)
-
-	movd	(%eax,%ecx,8), %mm1
-
-HAM(`	movd	0(%edx,%ecx,8), %mm0
-	pxor	%mm0, %mm1
-')
-	orl	%ecx, %ecx
-	jmp	L(loaded)
-
-
-	ALIGN(16)
-L(top):
-	C eax	src
-	C ebx
-	C ecx	counter, qwords, decrementing
-	C edx	[hamdist] src2
-	C
-	C mm0	(scratch)
-	C mm1	(scratch)
-	C mm2	total (low dword)
-	C mm3
-	C mm4	\
-	C mm5	| special constants
-	C mm6	|
-	C mm7	/
-
-	movq	-8(%eax,%ecx,8), %mm1
-
-HAM(`	pxor	-8(%edx,%ecx,8), %mm1')
-	decl	%ecx
-
-L(loaded):
-	movq	%mm1, %mm0
-	pand	REG_AAAAAAAAAAAAAAAA, %mm1
-
-	psrlq	$1, %mm1
-
-	psubd	%mm1, %mm0	C bit pairs
-
-
-	movq	%mm0, %mm1
-	psrlq	$2, %mm0
-
-	pand	REG_3333333333333333, %mm0
-	pand	REG_3333333333333333, %mm1
-
-	paddd	%mm1, %mm0	C nibbles
-
-
-	movq	%mm0, %mm1
-	psrlq	$4, %mm0
-
-	pand	REG_0F0F0F0F0F0F0F0F, %mm0
-	pand	REG_0F0F0F0F0F0F0F0F, %mm1
-
-	paddd	%mm1, %mm0	C bytes
-
-
-	psadbw_mm4_mm0
-
-	paddd	%mm0, %mm2	C add to total
-	jnz	L(top)
-
-
-	movd	%mm2, %eax
-	emms
-	ret
-
-
-L(zero):
-	movl	$0, %eax
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/mmx/rshift.asm b/ghc/rts/gmp/mpn/x86/k7/mmx/rshift.asm
deleted file mode 100644
index abb546cd5b..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/mmx/rshift.asm
+++ /dev/null
@@ -1,471 +0,0 @@
-dnl  AMD K7 mpn_rshift -- mpn right shift.
-dnl 
-dnl  K7: 1.21 cycles/limb (at 16 limbs/loop).
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  K7: UNROLL_COUNT cycles/limb
-dnl           4           1.51
-dnl           8           1.26
-dnl          16           1.21
-dnl          32           1.2
-dnl  Maximum possible with the current code is 64.
-
-deflit(UNROLL_COUNT, 16)
-
-
-C mp_limb_t mpn_rshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       unsigned shift);
-C
-C Shift src,size right by shift many bits and store the result in dst,size.
-C Zeros are shifted in at the left.  The bits shifted out at the right are
-C the return value.
-C
-C This code uses 64-bit MMX operations, which makes it possible to handle
-C two limbs at a time, for a theoretical 1.0 cycles/limb.  Plain integer
-C code, on the other hand, suffers from shrd being a vector path decode and
-C running at 3 cycles back-to-back.
-C
-C Full speed depends on source and destination being aligned, and some hairy
-C setups and finish-ups are done to arrange this for the loop.
-
-ifdef(`PIC',`
-deflit(UNROLL_THRESHOLD, 10)
-',`
-deflit(UNROLL_THRESHOLD, 10)
-')
-
-defframe(PARAM_SHIFT,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,  8)
-defframe(PARAM_DST,  4)
-
-defframe(SAVE_EDI, -4)
-defframe(SAVE_ESI, -8)
-defframe(SAVE_EBX, -12)
-deflit(SAVE_SIZE, 12)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(mpn_rshift)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %eax
-	movl	PARAM_SRC, %edx
-	subl	$SAVE_SIZE, %esp
-deflit(`FRAME',SAVE_SIZE)
-
-	movl	PARAM_SHIFT, %ecx
-	movl	%edi, SAVE_EDI
-
-	movl	PARAM_DST, %edi
-	decl	%eax
-	jnz	L(more_than_one_limb)
-
-	movl	(%edx), %edx		C src limb
-
-	shrdl(	%cl, %edx, %eax)	C eax was decremented to zero
-
- 	shrl	%cl, %edx
-
-	movl	%edx, (%edi)		C dst limb
-	movl	SAVE_EDI, %edi
-	addl	$SAVE_SIZE, %esp
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-L(more_than_one_limb):
-	C eax	size-1
-	C ebx
-	C ecx	shift
-	C edx	src
-	C esi
-	C edi	dst
-	C ebp
-
-	movd	PARAM_SHIFT, %mm6	C rshift
-	movd	(%edx), %mm5		C src low limb
-	cmp	$UNROLL_THRESHOLD-1, %eax
-
-	jae	L(unroll)
-	leal	(%edx,%eax,4), %edx	C &src[size-1]
-	leal	-4(%edi,%eax,4), %edi	C &dst[size-2]
-
-	movd	(%edx), %mm4		C src high limb
-	negl	%eax
-
-
-L(simple_top):
-	C eax	loop counter, limbs, negative
-	C ebx
-	C ecx	shift
-	C edx	carry
-	C edx	&src[size-1]
-	C edi	&dst[size-2]
-	C ebp
-	C
-	C mm0	scratch
-	C mm4	src high limb
-	C mm5	src low limb
-	C mm6	shift
-
-	movq	(%edx,%eax,4), %mm0
-	incl	%eax
-
- 	psrlq	%mm6, %mm0
-
-	movd	%mm0, (%edi,%eax,4)
-	jnz	L(simple_top)
-
-
-	psllq	$32, %mm5
- 	psrlq	%mm6, %mm4
-
-	psrlq	%mm6, %mm5
-	movd	%mm4, 4(%edi)		C dst high limb
-
-	movd	%mm5, %eax		C return value
-
-	movl	SAVE_EDI, %edi
-	addl	$SAVE_SIZE, %esp
-	emms
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)
-L(unroll):
-	C eax	size-1
-	C ebx
-	C ecx	shift
-	C edx	src
-	C esi
-	C edi	dst
-	C ebp
-	C
-	C mm5	src low limb
-	C mm6	rshift
-
-	testb	$4, %dl
-	movl	%esi, SAVE_ESI
-	movl	%ebx, SAVE_EBX
-
-	psllq	$32, %mm5
-	jz	L(start_src_aligned)
-
-
-	C src isn't aligned, process low limb separately (marked xxx) and
-	C step src and dst by one limb, making src aligned.
-	C
-	C source                  edx
-	C --+-------+-------+-------+
-	C           |          xxx  |
-	C --+-------+-------+-------+
-	C         4mod8   0mod8   4mod8
-	C
-	C         dest            edi
-	C         --+-------+-------+
-	C           |       |  xxx  |  
-	C         --+-------+-------+
-
-	movq	(%edx), %mm0		C src low two limbs
-	addl	$4, %edx
-	movl	%eax, PARAM_SIZE	C size-1
-
-	addl	$4, %edi
-	decl	%eax			C size-2 is new size-1
-
-	psrlq	%mm6, %mm0
-	movl	%edi, PARAM_DST		C new dst
-
-	movd	%mm0, -4(%edi)
-L(start_src_aligned):
-
-
-	movq	(%edx), %mm1		C src low two limbs
-	decl	%eax			C size-2, two last limbs handled at end
-	testl	$4, %edi
-
-	psrlq	%mm6, %mm5
-	jz	L(start_dst_aligned)
-
-
-	C dst isn't aligned, add 4 to make it so, and pretend the shift is
-	C 32 bits extra.  Low limb of dst (marked xxx) handled here separately.
-	C
-	C          source          edx
-	C          --+-------+-------+
-	C            |      mm1      |
-	C          --+-------+-------+
-	C                  4mod8   0mod8
-	C
-	C  dest                    edi
-	C  --+-------+-------+-------+
-	C                    |  xxx  |        
-	C  --+-------+-------+-------+
-	C          4mod8   0mod8   4mod8
-
-	movq	%mm1, %mm0
-	psrlq	%mm6, %mm1
-	addl	$32, %ecx		C shift+32
-
-	movd	%mm1, (%edi)
-	movq	%mm0, %mm1
-	addl	$4, %edi		C new dst
-
-	movd	%ecx, %mm6
-L(start_dst_aligned):
-
-
-	movq	%mm1, %mm2		C copy of src low two limbs
-	negl	%ecx
-	andl	$-2, %eax		C round size down to even
-
-	movl	%eax, %ebx
-	negl	%eax
-	addl	$64, %ecx
-
-	andl	$UNROLL_MASK, %eax
-	decl	%ebx
-
-	shll	%eax
-
-	movd	%ecx, %mm7		C lshift = 64-rshift
-
-ifdef(`PIC',`
-	call	L(pic_calc)
-L(here):
-',`
-	leal	L(entry) (%eax,%eax,4), %esi
-	negl	%eax
-')
-	shrl	$UNROLL_LOG2, %ebx	C loop counter
-
-	leal	ifelse(UNROLL_BYTES,256,128+) 8(%edx,%eax,2), %edx
-	leal	ifelse(UNROLL_BYTES,256,128) (%edi,%eax,2), %edi
-	movl	PARAM_SIZE, %eax	C for use at end
-
-	jmp	*%esi
-
-
-ifdef(`PIC',`
-L(pic_calc):
-	C See README.family about old gas bugs
-	leal	(%eax,%eax,4), %esi
-	addl	$L(entry)-L(here), %esi
-	addl	(%esp), %esi
-	negl	%eax
-
-	ret
-')
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(64)
-L(top):
-	C eax	size, for use at end
-	C ebx	loop counter
-	C ecx	lshift
-	C edx	src
-	C esi	was computed jump
-	C edi	dst
-	C ebp
-	C
-	C mm0	scratch
-	C mm1	\ carry (alternating)
-	C mm2	/
-	C mm6	rshift
-	C mm7	lshift
-	C
-	C 10 code bytes/limb
-	C
-	C The two chunks differ in whether mm1 or mm2 hold the carry.
-	C The computed jump puts the initial carry in both mm1 and mm2.
-	
-L(entry):
-deflit(CHUNK_COUNT, 4)
-forloop(i, 0, UNROLL_COUNT/CHUNK_COUNT-1, `
-	deflit(`disp0', eval(i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
-	deflit(`disp1', eval(disp0 + 8))
-
- 	movq	disp0(%edx), %mm0
- 	psrlq	%mm6, %mm2
-
- 	movq	%mm0, %mm1
- 	psllq	%mm7, %mm0
-
- 	por	%mm2, %mm0
- 	movq	%mm0, disp0(%edi)
-
-
- 	movq	disp1(%edx), %mm0
- 	psrlq	%mm6, %mm1
-
- 	movq	%mm0, %mm2
- 	psllq	%mm7, %mm0
-
- 	por	%mm1, %mm0
- 	movq	%mm0, disp1(%edi)
-')
-
-	addl	$UNROLL_BYTES, %edx
-	addl	$UNROLL_BYTES, %edi
-	decl	%ebx
-
-	jns	L(top)
-
-
-deflit(`disp0', ifelse(UNROLL_BYTES,256,-128))
-deflit(`disp1', eval(disp0-0 + 8))
-
-	testb	$1, %al
-	psrlq	%mm6, %mm2	C wanted rshifted in all cases below
-	movl	SAVE_ESI, %esi
-
-	movd	%mm5, %eax		C return value
-
-	movl	SAVE_EBX, %ebx
-	jz	L(end_even)
-
-	
-	C Size odd, destination was aligned.
-	C
-	C source
-	C       edx
-	C +-------+---------------+--
-	C |       |      mm2      |
-	C +-------+---------------+--
-	C
-	C dest                  edi
-	C +-------+---------------+---------------+--
-	C |       |               |    written    |
-	C +-------+---------------+---------------+--
-	C
-	C mm6 = shift
-	C mm7 = ecx = 64-shift
-
-
-	C Size odd, destination was unaligned.
-	C
-	C source
-	C       edx
-	C +-------+---------------+--
-	C |       |      mm2      |
-	C +-------+---------------+--
-	C
-	C dest          edi
-	C +---------------+---------------+--
-	C |               |    written    |
-	C +---------------+---------------+--
-	C
-	C mm6 = shift+32
-	C mm7 = ecx = 64-(shift+32)
-
-
-	C In both cases there's one extra limb of src to fetch and combine
-	C with mm2 to make a qword to store, and in the aligned case there's
-	C a further extra limb of dst to be formed.
-
-
-	movd	disp0(%edx), %mm0
-	movq	%mm0, %mm1
-
-	psllq	%mm7, %mm0
-	testb	$32, %cl
-
- 	por	%mm2, %mm0
-	psrlq	%mm6, %mm1
-
-	movq	%mm0, disp0(%edi)
-	jz	L(finish_odd_unaligned)
-
-	movd	%mm1, disp1(%edi)
-L(finish_odd_unaligned):
-
-	movl	SAVE_EDI, %edi
-	addl	$SAVE_SIZE, %esp
-	emms
-
-	ret
-
-
-L(end_even):
-
-	C Size even, destination was aligned.
-	C
-	C source
-	C +---------------+--
-	C |      mm2      |
-	C +---------------+--
-	C
-	C dest          edi
-	C +---------------+---------------+--
-	C |               |      mm3      |
-	C +---------------+---------------+--
-	C
-	C mm6 = shift
-	C mm7 = ecx = 64-shift
-
-
-	C Size even, destination was unaligned.
-	C
-	C source
-	C +---------------+--
-	C |      mm2      |
-	C +---------------+--
-	C
-	C dest  edi
-	C +-------+---------------+--
-	C |       |      mm3      |
-	C +-------+---------------+--
-	C
-	C mm6 = shift+32
-	C mm7 = 64-(shift+32)
-
-
-	C The movd for the unaligned case is the same data as the movq for
-	C the aligned case, it's just a choice between whether one or two
-	C limbs should be written.
-
-
-	testb	$32, %cl
-	movd	%mm2, disp0(%edi)
-
-	jz	L(end_even_unaligned)
-
-	movq	%mm2, disp0(%edi)
-L(end_even_unaligned):
-
-	movl	SAVE_EDI, %edi
-	addl	$SAVE_SIZE, %esp
-	emms
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/mul_1.asm b/ghc/rts/gmp/mpn/x86/k7/mul_1.asm
deleted file mode 100644
index 07f7085b10..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/mul_1.asm
+++ /dev/null
@@ -1,265 +0,0 @@
-dnl  AMD K7 mpn_mul_1 -- mpn by limb multiply.
-dnl 
-dnl  K7: 3.4 cycles/limb (at 16 limbs/loop).
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  K7: UNROLL_COUNT cycles/limb
-dnl           8           3.9
-dnl          16           3.4
-dnl          32           3.4
-dnl          64           3.35
-dnl  Maximum possible with the current code is 64.
-
-deflit(UNROLL_COUNT, 16)
-
-
-C mp_limb_t mpn_mul_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                      mp_limb_t multiplier);
-C mp_limb_t mpn_mul_1c (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       mp_limb_t multiplier, mp_limb_t carry);
-C
-C Multiply src,size by mult and store the result in dst,size.
-C Return the carry limb from the top of the result.
-C
-C mpn_mul_1c() accepts an initial carry for the calculation, it's added into
-C the low limb of the destination.
-C
-C Variations on the unrolled loop have been tried, with the current
-C registers or with the counter on the stack to free up ecx.  The current
-C code is the fastest found.
-C
-C An interesting effect is that removing the stores "movl %ebx, disp0(%edi)"
-C from the unrolled loop actually slows it down to 5.0 cycles/limb.  Code
-C with this change can be tested on sizes of the form UNROLL_COUNT*n+1
-C without having to change the computed jump.  There's obviously something
-C fishy going on, perhaps with what execution units the mul needs.
-
-defframe(PARAM_CARRY,     20)
-defframe(PARAM_MULTIPLIER,16)
-defframe(PARAM_SIZE,      12)
-defframe(PARAM_SRC,       8)
-defframe(PARAM_DST,       4)
-
-defframe(SAVE_EBP, -4)
-defframe(SAVE_EDI, -8)
-defframe(SAVE_ESI, -12)
-defframe(SAVE_EBX, -16)
-deflit(STACK_SPACE, 16)
-
-dnl  Must have UNROLL_THRESHOLD >= 2, since the unrolled loop can't handle 1.
-ifdef(`PIC',`
-deflit(UNROLL_THRESHOLD, 7)
-',`
-deflit(UNROLL_THRESHOLD, 5)
-')
-
-	.text
-	ALIGN(32)
-PROLOGUE(mpn_mul_1c)
-deflit(`FRAME',0)
-	movl	PARAM_CARRY, %edx
-	jmp	LF(mpn_mul_1,start_nc)
-EPILOGUE()
-
-
-PROLOGUE(mpn_mul_1)
-deflit(`FRAME',0)
-	xorl	%edx, %edx	C initial carry
-L(start_nc):
-	movl	PARAM_SIZE, %ecx
-	subl	$STACK_SPACE, %esp
-deflit(`FRAME', STACK_SPACE)
-
-	movl	%edi, SAVE_EDI
-	movl	%ebx, SAVE_EBX
-	movl	%edx, %ebx
-
-	movl	%esi, SAVE_ESI
-	movl	PARAM_SRC, %esi
-	cmpl	$UNROLL_THRESHOLD, %ecx
-
-	movl	PARAM_DST, %edi
-	movl	%ebp, SAVE_EBP
-	jae	L(unroll)
-
-	leal	(%esi,%ecx,4), %esi
-	leal	(%edi,%ecx,4), %edi
-	negl	%ecx
-
-	movl	PARAM_MULTIPLIER, %ebp
-
-L(simple):
-	C eax	scratch
-	C ebx	carry
-	C ecx	counter (negative)
-	C edx	scratch
-	C esi	src
-	C edi	dst
-	C ebp	multiplier
-
-	movl	(%esi,%ecx,4), %eax
-
-	mull	%ebp
-
-	addl	%ebx, %eax
-	movl	%eax, (%edi,%ecx,4)
-	movl	$0, %ebx
-
-	adcl	%edx, %ebx
-	incl	%ecx
-	jnz	L(simple)
-
-	movl	%ebx, %eax
-	movl	SAVE_EBX, %ebx
-	movl	SAVE_ESI, %esi
-
-	movl	SAVE_EDI, %edi
-	movl	SAVE_EBP, %ebp
-	addl	$STACK_SPACE, %esp
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-C The mov to load the next source limb is done well ahead of the mul, this
-C is necessary for full speed.  It leads to one limb handled separately
-C after the loop.
-C
-C When unrolling to 32 or more, an offset of +4 is used on the src pointer,
-C to avoid having an 0x80 displacement in the code for the last limb in the
-C unrolled loop.  This is for a fair comparison between 16 and 32 unrolling.
-
-ifelse(eval(UNROLL_COUNT >= 32),1,`
-deflit(SRC_OFFSET,4)
-',`
-deflit(SRC_OFFSET,)
-')
-
-	C this is offset 0x62, so close enough to aligned
-L(unroll):
-	C eax
-	C ebx	initial carry
-	C ecx	size
-	C edx
-	C esi	src
-	C edi	dst
-	C ebp
-deflit(`FRAME', STACK_SPACE)
-
-	leal	-1(%ecx), %edx	C one limb handled at end
-	leal	-2(%ecx), %ecx	C and ecx is one less than edx
-	movl	%ebp, SAVE_EBP
-
-	negl	%edx
-	shrl	$UNROLL_LOG2, %ecx	C unrolled loop counter
-	movl	(%esi), %eax		C src low limb
-
-	andl	$UNROLL_MASK, %edx
-	movl	PARAM_DST, %edi
-
-	movl	%edx, %ebp
-	shll	$4, %edx
-
-	C 17 code bytes per limb
-ifdef(`PIC',`
-	call	L(add_eip_to_edx)
-L(here):
-',`
-	leal	L(entry) (%edx,%ebp), %edx
-')
-	negl	%ebp
-
-	leal	ifelse(UNROLL_BYTES,256,128+) SRC_OFFSET(%esi,%ebp,4), %esi
-	leal	ifelse(UNROLL_BYTES,256,128) (%edi,%ebp,4), %edi
-	movl	PARAM_MULTIPLIER, %ebp
-
-	jmp	*%edx
-
-
-ifdef(`PIC',`
-L(add_eip_to_edx):
-	C See README.family about old gas bugs
-	leal	(%edx,%ebp), %edx
-	addl	$L(entry)-L(here), %edx
-	addl	(%esp), %edx
-	ret
-')
-
-
-C ----------------------------------------------------------------------------
-	ALIGN(32)
-L(top):
-	C eax	next src limb
-	C ebx	carry
-	C ecx	counter
-	C edx	scratch
-	C esi	src+4
-	C edi	dst
-	C ebp	multiplier
-	C
-	C 17 code bytes per limb processed
-
-L(entry):
-forloop(i, 0, UNROLL_COUNT-1, `
-	deflit(`disp_dst', eval(i*4 ifelse(UNROLL_BYTES,256,-128)))
-	deflit(`disp_src', eval(disp_dst + 4-(SRC_OFFSET-0)))
- 
-	mull	%ebp
-	
-	addl	%eax, %ebx
-Zdisp(	movl,	disp_src,(%esi), %eax)
-Zdisp(	movl,	%ebx, disp_dst,(%edi))
-
-	movl	$0, %ebx
-	adcl	%edx, %ebx
-')
-
-	decl	%ecx
-
-	leal	UNROLL_BYTES(%esi), %esi
-	leal	UNROLL_BYTES(%edi), %edi
-	jns	L(top)
-
-
-deflit(`disp0', ifelse(UNROLL_BYTES,256,-128))
-
-	mull	%ebp
-	
-	addl	%eax, %ebx
-	movl	$0, %eax
-	movl	SAVE_ESI, %esi
-
-	movl	%ebx, disp0(%edi)
-	movl	SAVE_EBX, %ebx
-	movl	SAVE_EDI, %edi
-
-	adcl	%edx, %eax
-	movl	SAVE_EBP, %ebp
-	addl	$STACK_SPACE, %esp
-
-	ret
-	
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/mul_basecase.asm b/ghc/rts/gmp/mpn/x86/k7/mul_basecase.asm
deleted file mode 100644
index c4be62e633..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/mul_basecase.asm
+++ /dev/null
@@ -1,593 +0,0 @@
-dnl  AMD K7 mpn_mul_basecase -- multiply two mpn numbers.
-dnl 
-dnl  K7: approx 4.42 cycles per cross product at around 20x20 limbs (16
-dnl      limbs/loop unrolling).
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  K7 UNROLL_COUNT cycles/product (at around 20x20)
-dnl           8           4.67    
-dnl          16           4.59
-dnl          32           4.42
-dnl  Maximum possible with the current code is 32.
-dnl
-dnl  At 32 the typical 13-26 limb sizes from the karatsuba code will get
-dnl  done with a straight run through a block of code, no inner loop.  Using
-dnl  32 gives 1k of code, but the k7 has a 64k L1 code cache.
-
-deflit(UNROLL_COUNT, 32)
-
-
-C void mpn_mul_basecase (mp_ptr wp,
-C                        mp_srcptr xp, mp_size_t xsize,
-C                        mp_srcptr yp, mp_size_t ysize);
-C
-C Calculate xp,xsize multiplied by yp,ysize, storing the result in
-C wp,xsize+ysize.
-C
-C This routine is essentially the same as mpn/generic/mul_basecase.c, but
-C it's faster because it does most of the mpn_addmul_1() startup
-C calculations only once.  The saving is 15-25% on typical sizes coming from
-C the Karatsuba multiply code.
-
-ifdef(`PIC',`
-deflit(UNROLL_THRESHOLD, 5)
-',`
-deflit(UNROLL_THRESHOLD, 5)
-')
-
-defframe(PARAM_YSIZE,20)
-defframe(PARAM_YP,   16)
-defframe(PARAM_XSIZE,12)
-defframe(PARAM_XP,   8)
-defframe(PARAM_WP,   4)
-
-	.text
-	ALIGN(32)
-PROLOGUE(mpn_mul_basecase)
-deflit(`FRAME',0)
-
-	movl	PARAM_XSIZE, %ecx
-	movl	PARAM_YP, %eax
-
-	movl	PARAM_XP, %edx
-	movl	(%eax), %eax	C yp low limb
-
-	cmpl	$2, %ecx
-	ja	L(xsize_more_than_two)
-	je	L(two_by_something)
-
-
-	C one limb by one limb
-
-	mull	(%edx)
-
-	movl	PARAM_WP, %ecx
-	movl	%eax, (%ecx)
-	movl	%edx, 4(%ecx)
-	ret
-
-
-C -----------------------------------------------------------------------------
-L(two_by_something):
-deflit(`FRAME',0)
-	decl	PARAM_YSIZE
-	pushl	%ebx		defframe_pushl(`SAVE_EBX')
-	movl	%eax, %ecx	C yp low limb
-
-	movl	PARAM_WP, %ebx
-	pushl	%esi		defframe_pushl(`SAVE_ESI')
-	movl	%edx, %esi	C xp
-
-	movl	(%edx), %eax	C xp low limb	
-	jnz	L(two_by_two)
-
-
-	C two limbs by one limb
-
-	mull	%ecx	
-
-	movl	%eax, (%ebx)
-	movl	4(%esi), %eax
-	movl	%edx, %esi	C carry
-
-	mull	%ecx
-
-	addl	%eax, %esi
-
-	movl	%esi, 4(%ebx)
-	movl	SAVE_ESI, %esi
-
-	adcl	$0, %edx
-
-	movl	%edx, 8(%ebx)
-	movl	SAVE_EBX, %ebx
-	addl	$FRAME, %esp
-
-	ret
-	
-
-
-C -----------------------------------------------------------------------------
-C Could load yp earlier into another register.
-
-	ALIGN(16)
-L(two_by_two):
-	C eax	xp low limb
-	C ebx	wp
-	C ecx	yp low limb
-	C edx
-	C esi	xp
-	C edi
-	C ebp
-
-dnl  FRAME carries on from previous
-
-	mull	%ecx		C xp[0] * yp[0]
-
-	push	%edi		defframe_pushl(`SAVE_EDI')
-	movl	%edx, %edi	C carry, for wp[1]
-
-	movl	%eax, (%ebx)
-	movl	4(%esi), %eax
-
-	mull	%ecx		C xp[1] * yp[0]
-
-	addl	%eax, %edi
-	movl	PARAM_YP, %ecx
-
-	adcl	$0, %edx
-	movl	4(%ecx), %ecx	C yp[1]
-	movl	%edi, 4(%ebx)
-
-	movl	4(%esi), %eax	C xp[1]
-	movl	%edx, %edi	C carry, for wp[2]
-
-	mull	%ecx		C xp[1] * yp[1]
-
-	addl	%eax, %edi
-
-	adcl	$0, %edx
-	movl	(%esi), %eax	C xp[0]
-
-	movl	%edx, %esi	C carry, for wp[3]
-
-	mull	%ecx		C xp[0] * yp[1]
-
-	addl	%eax, 4(%ebx)
-	adcl	%edx, %edi
-	movl	%edi, 8(%ebx)
-
-	adcl	$0, %esi
-	movl	SAVE_EDI, %edi
-	movl	%esi, 12(%ebx)
-
-	movl	SAVE_ESI, %esi
-	movl	SAVE_EBX, %ebx
-	addl	$FRAME, %esp
-
-	ret
-
-	
-C -----------------------------------------------------------------------------
-	ALIGN(16)
-L(xsize_more_than_two):
-
-C The first limb of yp is processed with a simple mpn_mul_1 style loop
-C inline.  Unrolling this doesn't seem worthwhile since it's only run once
-C (whereas the addmul below is run ysize-1 many times).  A call to the
-C actual mpn_mul_1 will be slowed down by the call and parameter pushing and
-C popping, and doesn't seem likely to be worthwhile on the typical 13-26
-C limb operations the Karatsuba code calls here with.
-
-	C eax	yp[0]
-	C ebx
-	C ecx	xsize
-	C edx	xp
-	C esi
-	C edi
-	C ebp
-
-dnl  FRAME doesn't carry on from previous, no pushes yet here
-defframe(`SAVE_EBX',-4)
-defframe(`SAVE_ESI',-8)
-defframe(`SAVE_EDI',-12)
-defframe(`SAVE_EBP',-16)
-deflit(`FRAME',0)
-
-	subl	$16, %esp
-deflit(`FRAME',16)
-
-	movl	%edi, SAVE_EDI
-	movl	PARAM_WP, %edi
-
-	movl	%ebx, SAVE_EBX
-	movl	%ebp, SAVE_EBP
-	movl	%eax, %ebp
-
-	movl	%esi, SAVE_ESI
-	xorl	%ebx, %ebx
-	leal	(%edx,%ecx,4), %esi	C xp end
-
-	leal	(%edi,%ecx,4), %edi	C wp end of mul1
-	negl	%ecx
-
-
-L(mul1):
-	C eax	scratch
-	C ebx	carry
-	C ecx	counter, negative
-	C edx	scratch
-	C esi	xp end
-	C edi	wp end of mul1
-	C ebp	multiplier
-
-	movl	(%esi,%ecx,4), %eax
-
-	mull	%ebp
-
-	addl	%ebx, %eax
-	movl	%eax, (%edi,%ecx,4)
-	movl	$0, %ebx
-
-	adcl	%edx, %ebx
-	incl	%ecx
-	jnz	L(mul1)
-
-
-	movl	PARAM_YSIZE, %edx
-	movl	PARAM_XSIZE, %ecx
-
-	movl	%ebx, (%edi)		C final carry
-	decl	%edx
-
-	jnz	L(ysize_more_than_one)
-
-
-	movl	SAVE_EDI, %edi
-	movl	SAVE_EBX, %ebx
-
-	movl	SAVE_EBP, %ebp
-	movl	SAVE_ESI, %esi
-	addl	$FRAME, %esp
-
-	ret
-
-
-L(ysize_more_than_one):
-	cmpl	$UNROLL_THRESHOLD, %ecx
-	movl	PARAM_YP, %eax
-
-	jae	L(unroll)
-
-
-C -----------------------------------------------------------------------------
-	C simple addmul looping
-	C
-	C eax	yp
-	C ebx
-	C ecx	xsize
-	C edx	ysize-1
-	C esi	xp end
-	C edi	wp end of mul1
-	C ebp
-
-	leal	4(%eax,%edx,4), %ebp	C yp end
-	negl	%ecx
-	negl	%edx
-
-	movl	(%esi,%ecx,4), %eax	C xp low limb
-	movl	%edx, PARAM_YSIZE	C -(ysize-1)
-	incl	%ecx
-
-	xorl	%ebx, %ebx		C initial carry
-	movl	%ecx, PARAM_XSIZE	C -(xsize-1)
-	movl	%ebp, PARAM_YP
-
-	movl	(%ebp,%edx,4), %ebp	C yp second lowest limb - multiplier
-	jmp	L(simple_outer_entry)
-
-
-	C this is offset 0x121 so close enough to aligned
-L(simple_outer_top):	
-	C ebp	ysize counter, negative
-
-	movl	PARAM_YP, %edx
-	movl	PARAM_XSIZE, %ecx	C -(xsize-1)
-	xorl	%ebx, %ebx		C carry
-
-	movl	%ebp, PARAM_YSIZE
-	addl	$4, %edi		C next position in wp
-
-	movl	(%edx,%ebp,4), %ebp	C yp limb - multiplier
-	movl	-4(%esi,%ecx,4), %eax	C xp low limb
-
-
-L(simple_outer_entry):
-
-L(simple_inner):
-	C eax	xp limb
-	C ebx	carry limb
-	C ecx	loop counter (negative)
-	C edx	scratch
-	C esi	xp end
-	C edi	wp end
-	C ebp	multiplier
-
-	mull	%ebp
-
-	addl	%eax, %ebx
-	adcl	$0, %edx
-
-	addl	%ebx, (%edi,%ecx,4)
-	movl	(%esi,%ecx,4), %eax
-	adcl	$0, %edx
-
-	incl	%ecx
-	movl	%edx, %ebx
-	jnz	L(simple_inner)
-
-
-	mull	%ebp
-
-	movl	PARAM_YSIZE, %ebp
-	addl	%eax, %ebx
-
-	adcl	$0, %edx
-	addl	%ebx, (%edi)
-
-	adcl	$0, %edx
-	incl	%ebp
-
-	movl	%edx, 4(%edi)
-	jnz	L(simple_outer_top)
-
-
-	movl	SAVE_EBX, %ebx
-	movl	SAVE_ESI, %esi
-
-	movl	SAVE_EDI, %edi
-	movl	SAVE_EBP, %ebp
-	addl	$FRAME, %esp
-
-	ret
-
-
-
-C -----------------------------------------------------------------------------
-C
-C The unrolled loop is the same as in mpn_addmul_1(), see that code for some
-C comments.
-C
-C VAR_ADJUST is the negative of how many limbs the leals in the inner loop
-C increment xp and wp.  This is used to adjust back xp and wp, and rshifted
-C to given an initial VAR_COUNTER at the top of the outer loop.
-C
-C VAR_COUNTER is for the unrolled loop, running from VAR_ADJUST/UNROLL_COUNT
-C up to -1, inclusive.
-C
-C VAR_JMP is the computed jump into the unrolled loop.
-C
-C VAR_XP_LOW is the least significant limb of xp, which is needed at the
-C start of the unrolled loop.
-C
-C PARAM_YSIZE is the outer loop counter, going from -(ysize-1) up to -1,
-C inclusive.
-C
-C PARAM_YP is offset appropriately so that the PARAM_YSIZE counter can be
-C added to give the location of the next limb of yp, which is the multiplier
-C in the unrolled loop.
-C
-C The trick with VAR_ADJUST means it's only necessary to do one fetch in the
-C outer loop to take care of xp, wp and the inner loop counter.
-
-defframe(VAR_COUNTER,  -20)
-defframe(VAR_ADJUST,   -24)
-defframe(VAR_JMP,      -28)
-defframe(VAR_XP_LOW,   -32)
-deflit(VAR_EXTRA_SPACE, 16)
-
-
-L(unroll):
-	C eax	yp
-	C ebx
-	C ecx	xsize
-	C edx	ysize-1
-	C esi	xp end
-	C edi	wp end of mul1
-	C ebp
-
-	movl	PARAM_XP, %esi
-	movl	4(%eax), %ebp		C multiplier (yp second limb)
-	leal	4(%eax,%edx,4), %eax	C yp adjust for ysize indexing
-
-	movl	PARAM_WP, %edi
-	movl	%eax, PARAM_YP
-	negl	%edx
-
-	movl	%edx, PARAM_YSIZE
-	leal	UNROLL_COUNT-2(%ecx), %ebx	C (xsize-1)+UNROLL_COUNT-1
-	decl	%ecx				C xsize-1
-
-	movl	(%esi), %eax		C xp low limb
-	andl	$-UNROLL_MASK-1, %ebx
-	negl	%ecx
-
-	subl	$VAR_EXTRA_SPACE, %esp
-deflit(`FRAME',16+VAR_EXTRA_SPACE)
-	negl	%ebx
-	andl	$UNROLL_MASK, %ecx
-
-	movl	%ebx, VAR_ADJUST
-	movl	%ecx, %edx
-	shll	$4, %ecx
-
-	sarl	$UNROLL_LOG2, %ebx
-
-	C 17 code bytes per limb
-ifdef(`PIC',`
-	call	L(pic_calc)
-L(unroll_here):
-',`
-	leal	L(unroll_entry) (%ecx,%edx,1), %ecx
-')
-	negl	%edx
-
-	movl	%eax, VAR_XP_LOW
-	movl	%ecx, VAR_JMP
-	leal	4(%edi,%edx,4), %edi	C wp and xp, adjust for unrolling,
-	leal	4(%esi,%edx,4), %esi	C  and start at second limb
-	jmp	L(unroll_outer_entry)
-
-
-ifdef(`PIC',`
-L(pic_calc):
-	C See README.family about old gas bugs
-	leal	(%ecx,%edx,1), %ecx
-	addl	$L(unroll_entry)-L(unroll_here), %ecx
-	addl	(%esp), %ecx
-	ret
-')
-
-
-C --------------------------------------------------------------------------
-	ALIGN(32)
-L(unroll_outer_top):
-	C ebp	ysize counter, negative
-
-	movl	VAR_ADJUST, %ebx
-	movl	PARAM_YP, %edx
-
-	movl	VAR_XP_LOW, %eax
-	movl	%ebp, PARAM_YSIZE	C store incremented ysize counter
-
-	leal	4(%edi,%ebx,4), %edi
-	leal	(%esi,%ebx,4), %esi
-	sarl	$UNROLL_LOG2, %ebx
-
-	movl	(%edx,%ebp,4), %ebp	C yp next multiplier
-	movl	VAR_JMP, %ecx
-
-L(unroll_outer_entry):
-	mull	%ebp
-
-	testb	$1, %cl		C and clear carry bit
-	movl	%ebx, VAR_COUNTER
-	movl	$0, %ebx
-
-	movl	$0, %ecx
-	cmovz(	%eax, %ecx)	C eax into low carry, zero into high carry limb
-	cmovnz(	%eax, %ebx)
-
-	C Extra fetch of VAR_JMP is bad, but registers are tight
-	jmp	*VAR_JMP
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(32)
-L(unroll_top):
-	C eax	xp limb
-	C ebx	carry high
-	C ecx	carry low
-	C edx	scratch
-	C esi	xp+8
-	C edi	wp
-	C ebp	yp multiplier limb
-	C
-	C VAR_COUNTER  loop counter, negative
-	C
-	C 17 bytes each limb
-
-L(unroll_entry):
-
-deflit(CHUNK_COUNT,2)
-forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT-1, `
-	deflit(`disp0', eval(i*CHUNK_COUNT*4 ifelse(UNROLL_BYTES,256,-128)))
-	deflit(`disp1', eval(disp0 + 4))
-
-Zdisp(	movl,	disp0,(%esi), %eax)
-	adcl	%edx, %ebx
-
-	mull	%ebp
-
-Zdisp(	addl,	%ecx, disp0,(%edi))
-	movl	$0, %ecx
-
-	adcl	%eax, %ebx
-
-
-	movl	disp1(%esi), %eax
-	adcl	%edx, %ecx	
-
-	mull	%ebp
-
-	addl	%ebx, disp1(%edi)
-	movl	$0, %ebx
-
-	adcl	%eax, %ecx
-')
-
-
-	incl	VAR_COUNTER
-	leal	UNROLL_BYTES(%esi), %esi
-	leal	UNROLL_BYTES(%edi), %edi
-
-	jnz	L(unroll_top)
-
-
-	C eax
-	C ebx	zero
-	C ecx	low
-	C edx	high
-	C esi
-	C edi	wp, pointing at second last limb)
-	C ebp
-	C
-	C carry flag to be added to high
-
-deflit(`disp0', ifelse(UNROLL_BYTES,256,-128))
-deflit(`disp1', eval(disp0-0 + 4))
-
-	movl	PARAM_YSIZE, %ebp
-	adcl	$0, %edx
-	addl	%ecx, disp0(%edi)
-
-	adcl	$0, %edx
-	incl	%ebp
-
-	movl	%edx, disp1(%edi)
-	jnz	L(unroll_outer_top)
-
-
-	movl	SAVE_ESI, %esi
-	movl	SAVE_EBP, %ebp
-
-	movl	SAVE_EDI, %edi
-	movl	SAVE_EBX, %ebx
-	addl	$FRAME, %esp
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/k7/sqr_basecase.asm b/ghc/rts/gmp/mpn/x86/k7/sqr_basecase.asm
deleted file mode 100644
index 84861ea66b..0000000000
--- a/ghc/rts/gmp/mpn/x86/k7/sqr_basecase.asm
+++ /dev/null
@@ -1,627 +0,0 @@
-dnl  AMD K7 mpn_sqr_basecase -- square an mpn number.
-dnl 
-dnl  K7: approx 2.3 cycles/crossproduct, or 4.55 cycles/triangular product
-dnl  (measured on the speed difference between 25 and 50 limbs, which is
-dnl  roughly the Karatsuba recursing range).
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  These are the same as mpn/x86/k6/sqr_basecase.asm, see that code for
-dnl  some comments.
-
-deflit(KARATSUBA_SQR_THRESHOLD_MAX, 66)
-
-ifdef(`KARATSUBA_SQR_THRESHOLD_OVERRIDE',
-`define(`KARATSUBA_SQR_THRESHOLD',KARATSUBA_SQR_THRESHOLD_OVERRIDE)')
-
-m4_config_gmp_mparam(`KARATSUBA_SQR_THRESHOLD')
-deflit(UNROLL_COUNT, eval(KARATSUBA_SQR_THRESHOLD-3))
-
-
-C void mpn_sqr_basecase (mp_ptr dst, mp_srcptr src, mp_size_t size);
-C
-C With a KARATSUBA_SQR_THRESHOLD around 50 this code is about 1500 bytes,
-C which is quite a bit, but is considered good value since squares big
-C enough to use most of the code will be spending quite a few cycles in it.
-
-
-defframe(PARAM_SIZE,12)
-defframe(PARAM_SRC, 8)
-defframe(PARAM_DST, 4)
-
-	.text
-	ALIGN(32)
-PROLOGUE(mpn_sqr_basecase)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	movl	PARAM_SRC, %eax
-	cmpl	$2, %ecx
-
-	movl	PARAM_DST, %edx
-	je	L(two_limbs)
-	ja	L(three_or_more)
-
-
-C------------------------------------------------------------------------------
-C one limb only
-	C eax	src
-	C ecx	size
-	C edx	dst
-
-	movl	(%eax), %eax
-	movl	%edx, %ecx
-
-	mull	%eax
-
-	movl	%edx, 4(%ecx)
-	movl	%eax, (%ecx)
-	ret
-
-
-C------------------------------------------------------------------------------
-C
-C Using the read/modify/write "add"s seems to be faster than saving and
-C restoring registers.  Perhaps the loads for the first set hide under the
-C mul latency and the second gets store to load forwarding.
-
-	ALIGN(16)
-L(two_limbs):
-	C eax	src
-	C ebx
-	C ecx	size
-	C edx	dst
-deflit(`FRAME',0)
-
-	pushl	%ebx		FRAME_pushl()
-	movl	%eax, %ebx	C src
-	movl	(%eax), %eax
-
-	movl	%edx, %ecx	C dst
-
-	mull	%eax		C src[0]^2
-
-	movl	%eax, (%ecx)	C dst[0]
-	movl	4(%ebx), %eax
-
-	movl	%edx, 4(%ecx)	C dst[1]
-
-	mull	%eax		C src[1]^2
-
-	movl	%eax, 8(%ecx)	C dst[2]
-	movl	(%ebx), %eax
-
-	movl	%edx, 12(%ecx)	C dst[3]
-
-	mull	4(%ebx)		C src[0]*src[1]
-
-	popl	%ebx
-
- 	addl	%eax, 4(%ecx)
-	adcl	%edx, 8(%ecx)
-	adcl	$0, 12(%ecx)
-	ASSERT(nc)
-
-	addl	%eax, 4(%ecx)
-	adcl	%edx, 8(%ecx)
-	adcl	$0, 12(%ecx)
-	ASSERT(nc)
-
-	ret
-
-
-C------------------------------------------------------------------------------
-defframe(SAVE_EBX,  -4)
-defframe(SAVE_ESI,  -8)
-defframe(SAVE_EDI, -12)
-defframe(SAVE_EBP, -16)
-deflit(STACK_SPACE, 16)
-
-L(three_or_more):
-	subl	$STACK_SPACE, %esp
-	cmpl	$4, %ecx
-	jae	L(four_or_more)
-deflit(`FRAME',STACK_SPACE)
-
-
-C------------------------------------------------------------------------------
-C Three limbs
-C
-C Writing out the loads and stores separately at the end of this code comes
-C out about 10 cycles faster than using adcls to memory.
-
-	C eax	src
-	C ecx	size
-	C edx	dst
-
-	movl	%ebx, SAVE_EBX
-	movl	%eax, %ebx	C src
-	movl	(%eax), %eax
-
-	movl	%edx, %ecx	C dst
-	movl	%esi, SAVE_ESI
-	movl	%edi, SAVE_EDI
-
-	mull	%eax		C src[0] ^ 2
-
-	movl	%eax, (%ecx)
-	movl	4(%ebx), %eax
-	movl	%edx, 4(%ecx)
-
-	mull	%eax		C src[1] ^ 2
-
-	movl	%eax, 8(%ecx)
-	movl	8(%ebx), %eax
-	movl	%edx, 12(%ecx)
-
-	mull	%eax		C src[2] ^ 2
-
-	movl	%eax, 16(%ecx)
-	movl	(%ebx), %eax
-	movl	%edx, 20(%ecx)
-
-	mull	4(%ebx)		C src[0] * src[1]
-
-	movl	%eax, %esi
-	movl	(%ebx), %eax
-	movl	%edx, %edi
-
-	mull	8(%ebx)		C src[0] * src[2]
-
-	addl	%eax, %edi
-	movl	%ebp, SAVE_EBP
-	movl	$0, %ebp
-
-	movl	4(%ebx), %eax
-	adcl	%edx, %ebp
-
-	mull	8(%ebx)		C src[1] * src[2]
-
-	xorl	%ebx, %ebx
-	addl	%eax, %ebp
-
-	adcl	$0, %edx
-
-	C eax
-	C ebx	zero, will be dst[5]
-	C ecx	dst
-	C edx	dst[4]
-	C esi	dst[1]
-	C edi	dst[2]
-	C ebp	dst[3]
-
-	adcl	$0, %edx
-	addl	%esi, %esi
-
-	adcl	%edi, %edi
-	movl	4(%ecx), %eax
-
-	adcl	%ebp, %ebp
-
-	adcl	%edx, %edx
-
-	adcl	$0, %ebx
-	addl	%eax, %esi
-	movl	8(%ecx), %eax
-
-	adcl	%eax, %edi
-	movl	12(%ecx), %eax
-	movl	%esi, 4(%ecx)
-
-	adcl	%eax, %ebp
-	movl	16(%ecx), %eax
-	movl	%edi, 8(%ecx)
-
-	movl	SAVE_ESI, %esi
-	movl	SAVE_EDI, %edi
-
-	adcl	%eax, %edx
-	movl	20(%ecx), %eax
-	movl	%ebp, 12(%ecx)
-
-	adcl	%ebx, %eax
-	ASSERT(nc)
-	movl	SAVE_EBX, %ebx
-	movl	SAVE_EBP, %ebp
-
-	movl	%edx, 16(%ecx)
-	movl	%eax, 20(%ecx)
-	addl	$FRAME, %esp
-
-	ret
-
-
-C------------------------------------------------------------------------------
-L(four_or_more):
-
-C First multiply src[0]*src[1..size-1] and store at dst[1..size].
-C Further products are added in rather than stored.
- 
-	C eax	src
-	C ebx
-	C ecx	size
-	C edx	dst
-	C esi
-	C edi
-	C ebp
-
-defframe(`VAR_COUNTER',-20)
-defframe(`VAR_JMP',    -24)
-deflit(EXTRA_STACK_SPACE, 8)
-
-	movl	%ebx, SAVE_EBX
-	movl	%edi, SAVE_EDI
-	leal	(%edx,%ecx,4), %edi	C &dst[size]
-
-	movl	%esi, SAVE_ESI
-	movl	%ebp, SAVE_EBP
-	leal	(%eax,%ecx,4), %esi	C &src[size]
-
-	movl	(%eax), %ebp		C multiplier
-	movl	$0, %ebx
-	decl	%ecx
-
-	negl	%ecx
-	subl	$EXTRA_STACK_SPACE, %esp
-FRAME_subl_esp(EXTRA_STACK_SPACE)
-
-L(mul_1):
-	C eax	scratch
-	C ebx	carry
-	C ecx	counter
-	C edx	scratch
-	C esi	&src[size]
-	C edi	&dst[size]
-	C ebp	multiplier
-
-        movl    (%esi,%ecx,4), %eax
-
-        mull    %ebp
-
-        addl    %ebx, %eax
-        movl    %eax, (%edi,%ecx,4)
-        movl    $0, %ebx
-
-        adcl    %edx, %ebx
-        incl    %ecx
-        jnz     L(mul_1)
-
-
-C Add products src[n]*src[n+1..size-1] at dst[2*n-1...], for each n=1..size-2.
-C
-C The last two products, which are the bottom right corner of the product
-C triangle, are left to the end.  These are src[size-3]*src[size-2,size-1]
-C and src[size-2]*src[size-1].  If size is 4 then it's only these corner
-C cases that need to be done.
-C
-C The unrolled code is the same as in mpn_addmul_1, see that routine for
-C some comments.
-C
-C VAR_COUNTER is the outer loop, running from -size+4 to -1, inclusive.
-C
-C VAR_JMP is the computed jump into the unrolled code, stepped by one code
-C chunk each outer loop.
-C
-C K7 does branch prediction on indirect jumps, which is bad since it's a
-C different target each time.  There seems no way to avoid this.
-
-dnl  This value also hard coded in some shifts and adds
-deflit(CODE_BYTES_PER_LIMB, 17)
-
-dnl  With the unmodified &src[size] and &dst[size] pointers, the
-dnl  displacements in the unrolled code fit in a byte for UNROLL_COUNT
-dnl  values up to 31, but above that an offset must be added to them.
-
-deflit(OFFSET,
-ifelse(eval(UNROLL_COUNT>31),1,
-eval((UNROLL_COUNT-31)*4),
-0))
-
-dnl  Because the last chunk of code is generated differently, a label placed
-dnl  at the end doesn't work.  Instead calculate the implied end using the
-dnl  start and how many chunks of code there are.
-
-deflit(UNROLL_INNER_END,
-`L(unroll_inner_start)+eval(UNROLL_COUNT*CODE_BYTES_PER_LIMB)')
-
-	C eax
-	C ebx	carry
-	C ecx
-	C edx
-	C esi	&src[size]
-	C edi	&dst[size]
-	C ebp
-
-	movl	PARAM_SIZE, %ecx
-	movl	%ebx, (%edi)
-
-	subl	$4, %ecx
-	jz	L(corner)
-
-	negl	%ecx
-ifelse(OFFSET,0,,`subl	$OFFSET, %edi')
-ifelse(OFFSET,0,,`subl	$OFFSET, %esi')
-
-	movl	%ecx, %edx
-	shll	$4, %ecx
-
-ifdef(`PIC',`
-	call	L(pic_calc)
-L(here):
-',`
-	leal	UNROLL_INNER_END-eval(2*CODE_BYTES_PER_LIMB)(%ecx,%edx), %ecx
-')
-
-
-	C The calculated jump mustn't come out to before the start of the
-	C code available.  This is the limit UNROLL_COUNT puts on the src
-	C operand size, but checked here directly using the jump address.
-	ASSERT(ae,
-	`movl_text_address(L(unroll_inner_start), %eax)
-	cmpl	%eax, %ecx')
-
-
-C------------------------------------------------------------------------------
-	ALIGN(16)
-L(unroll_outer_top):
-	C eax
-	C ebx	high limb to store
-	C ecx	VAR_JMP
-	C edx	VAR_COUNTER, limbs, negative
-	C esi	&src[size], constant
-	C edi	dst ptr, high of last addmul
-	C ebp
-
-	movl	-12+OFFSET(%esi,%edx,4), %ebp	C next multiplier
-	movl	-8+OFFSET(%esi,%edx,4), %eax	C first of multiplicand
-
-	movl	%edx, VAR_COUNTER
-
-	mull	%ebp
-
-define(cmovX,`ifelse(eval(UNROLL_COUNT%2),0,`cmovz($@)',`cmovnz($@)')')
-
-	testb	$1, %cl
-	movl	%edx, %ebx	C high carry
-	movl	%ecx, %edx	C jump
-
-	movl	%eax, %ecx	C low carry
-	cmovX(	%ebx, %ecx)	C high carry reverse
-	cmovX(	%eax, %ebx)	C low carry reverse
-
-	leal	CODE_BYTES_PER_LIMB(%edx), %eax
-	xorl	%edx, %edx
-	leal	4(%edi), %edi
-
-	movl	%eax, VAR_JMP
-
-	jmp	*%eax
-
-
-ifdef(`PIC',`
-L(pic_calc):
-	addl	(%esp), %ecx
-	addl	$UNROLL_INNER_END-eval(2*CODE_BYTES_PER_LIMB)-L(here), %ecx
-	addl	%edx, %ecx
-	ret
-')
-
-
-	C Must be an even address to preserve the significance of the low
-	C bit of the jump address indicating which way around ecx/ebx should
-	C start.
-	ALIGN(2)
-
-L(unroll_inner_start):
-	C eax	next limb
-	C ebx	carry high
-	C ecx	carry low
-	C edx	scratch
-	C esi	src
-	C edi	dst
-	C ebp	multiplier
-
-forloop(`i', UNROLL_COUNT, 1, `
-	deflit(`disp_src', eval(-i*4 + OFFSET))
-	deflit(`disp_dst', eval(disp_src - 4))
-
-	m4_assert(`disp_src>=-128 && disp_src<128')
-	m4_assert(`disp_dst>=-128 && disp_dst<128')
-
-ifelse(eval(i%2),0,`
-Zdisp(	movl,	disp_src,(%esi), %eax)
-        adcl    %edx, %ebx
-
-        mull	%ebp
-
-Zdisp(  addl,	%ecx, disp_dst,(%edi))
-	movl	$0, %ecx
-
-	adcl	%eax, %ebx
-
-',`
-	dnl  this bit comes out last
-Zdisp(  movl,	disp_src,(%esi), %eax)
-	adcl	%edx, %ecx
-
-	mull    %ebp
-
-dnl Zdisp(	addl	%ebx, disp_src,(%edi))
-	addl	%ebx, disp_dst(%edi)
-ifelse(forloop_last,0,
-`	movl	$0, %ebx')
-
-	adcl    %eax, %ecx
-')
-')
-
-	C eax	next limb
-	C ebx	carry high
-	C ecx	carry low
-	C edx	scratch
-	C esi	src
-	C edi	dst
-	C ebp	multiplier
-
-        adcl    $0, %edx
-	addl	%ecx, -4+OFFSET(%edi)
-	movl	VAR_JMP, %ecx
-
-        adcl    $0, %edx
-	
-	movl	%edx, m4_empty_if_zero(OFFSET) (%edi)
-	movl	VAR_COUNTER, %edx
-
-	incl	%edx
-	jnz	L(unroll_outer_top)
-	
-
-ifelse(OFFSET,0,,`
-	addl	$OFFSET, %esi
-	addl	$OFFSET, %edi
-')
-
-
-C------------------------------------------------------------------------------
-L(corner):
-	C esi	&src[size]
-	C edi	&dst[2*size-5]
-
-	movl	-12(%esi), %ebp
-	movl	-8(%esi), %eax
-	movl	%eax, %ecx
-
-	mull	%ebp
-
-	addl	%eax, -4(%edi)
-	movl	-4(%esi), %eax
-
-	adcl	$0, %edx
-	movl	%edx, %ebx
-	movl	%eax, %esi
-
-	mull	%ebp
-
-	addl	%ebx, %eax
-
-	adcl	$0, %edx
-	addl	%eax, (%edi)
-	movl	%esi, %eax
-
-	adcl	$0, %edx
-	movl	%edx, %ebx
-
-	mull	%ecx
-
-	addl	%ebx, %eax
-	movl	%eax, 4(%edi)
-
-	adcl	$0, %edx
-	movl	%edx, 8(%edi)
-	
-
-
-C Left shift of dst[1..2*size-2], high bit shifted out becomes dst[2*size-1].
-
-L(lshift_start):
-	movl	PARAM_SIZE, %eax
-	movl	PARAM_DST, %edi
-	xorl	%ecx, %ecx		C clear carry
-
-	leal	(%edi,%eax,8), %edi
-	notl	%eax			C -size-1, preserve carry
-
-	leal	2(%eax), %eax		C -(size-1)
-
-L(lshift):
-	C eax	counter, negative
-	C ebx
-	C ecx
-	C edx
-	C esi
-	C edi	dst, pointing just after last limb
-	C ebp
-
-	rcll	-4(%edi,%eax,8)
-	rcll	(%edi,%eax,8)
-	incl	%eax
-	jnz	L(lshift)
-
-	setc	%al
-
-	movl	PARAM_SRC, %esi
-	movl	%eax, -4(%edi)		C dst most significant limb
-
-	movl	PARAM_SIZE, %ecx
-
-
-C Now add in the squares on the diagonal, src[0]^2, src[1]^2, ...,
-C src[size-1]^2.  dst[0] hasn't yet been set at all yet, and just gets the
-C low limb of src[0]^2.
-
-	movl	(%esi), %eax		C src[0]
-
-	mull	%eax
-
-	leal	(%esi,%ecx,4), %esi	C src point just after last limb
-	negl	%ecx
-
-	movl	%eax, (%edi,%ecx,8)	C dst[0]
-	incl	%ecx
-
-L(diag):
-	C eax	scratch
-	C ebx	scratch
-	C ecx	counter, negative
-	C edx	carry
-	C esi	src just after last limb
-	C edi	dst just after last limb
-	C ebp
-
-	movl	(%esi,%ecx,4), %eax
-	movl	%edx, %ebx
-
-	mull	%eax
-
-	addl	%ebx, -4(%edi,%ecx,8)
-	adcl	%eax, (%edi,%ecx,8)
-	adcl	$0, %edx
-
-	incl	%ecx
-	jnz	L(diag)
-
-
-	movl	SAVE_ESI, %esi
-	movl	SAVE_EBX, %ebx
-
-	addl	%edx, -4(%edi)		C dst most significant limb
-	movl	SAVE_EDI, %edi
-
-	movl	SAVE_EBP, %ebp
-	addl	$FRAME, %esp
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/lshift.asm b/ghc/rts/gmp/mpn/x86/lshift.asm
deleted file mode 100644
index 4735335cbe..0000000000
--- a/ghc/rts/gmp/mpn/x86/lshift.asm
+++ /dev/null
@@ -1,90 +0,0 @@
-dnl  x86 mpn_lshift -- mpn left shift.
-
-dnl  Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation,
-dnl  Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_lshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       unsigned shift);
-
-defframe(PARAM_SHIFT,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,  8)
-defframe(PARAM_DST,  4)
-
-	.text
-	ALIGN(8)
-PROLOGUE(mpn_lshift)
-
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-deflit(`FRAME',12)
-
-	movl	PARAM_DST,%edi
-	movl	PARAM_SRC,%esi
-	movl	PARAM_SIZE,%edx
-	movl	PARAM_SHIFT,%ecx
-
-	subl	$4,%esi			C adjust src
-
-	movl	(%esi,%edx,4),%ebx	C read most significant limb
-	xorl	%eax,%eax
-	shldl(	%cl, %ebx, %eax)	C compute carry limb
-	decl	%edx
-	jz	L(end)
-	pushl	%eax			C push carry limb onto stack
-	testb	$1,%dl
-	jnz	L(1)			C enter loop in the middle
-	movl	%ebx,%eax
-
-	ALIGN(8)
-L(oop):	movl	(%esi,%edx,4),%ebx	C load next lower limb
-	shldl(	%cl, %ebx, %eax)	C compute result limb
-	movl	%eax,(%edi,%edx,4)	C store it
-	decl	%edx
-L(1):	movl	(%esi,%edx,4),%eax
-	shldl(	%cl, %eax, %ebx)
-	movl	%ebx,(%edi,%edx,4)
-	decl	%edx
-	jnz	L(oop)
-
-	shll	%cl,%eax		C compute least significant limb
-	movl	%eax,(%edi)		C store it
-
-	popl	%eax			C pop carry limb
-
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-L(end):	shll	%cl,%ebx		C compute least significant limb
-	movl	%ebx,(%edi)		C store it
-
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/mod_1.asm b/ghc/rts/gmp/mpn/x86/mod_1.asm
deleted file mode 100644
index 3908161b3e..0000000000
--- a/ghc/rts/gmp/mpn/x86/mod_1.asm
+++ /dev/null
@@ -1,141 +0,0 @@
-dnl  x86 mpn_mod_1 -- mpn by limb remainder.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-dnl        cycles/limb
-dnl  K6        20
-dnl  P5        44
-dnl  P6        39
-dnl  486   approx 42 maybe
-dnl
-dnl  The following have their own optimized mod_1 implementations, but for
-dnl  reference the code here runs as follows.
-dnl
-dnl  P6MMX     39
-dnl  K7        41
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_mod_1 (mp_srcptr src, mp_size_t size, mp_limb_t divisor);
-C mp_limb_t mpn_mod_1c (mp_srcptr src, mp_size_t size, mp_limb_t divisor,
-C                       mp_limb_t carry);
-C
-C Divide src,size by divisor and return the remainder.  The quotient is
-C discarded.
-C
-C See mpn/x86/divrem_1.asm for some comments.
-
-defframe(PARAM_CARRY,  16)
-defframe(PARAM_DIVISOR,12)
-defframe(PARAM_SIZE,   8)
-defframe(PARAM_SRC,    4)
-
-	.text
-	ALIGN(16)
-
-PROLOGUE(mpn_mod_1c)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	pushl	%ebx		FRAME_pushl()
-
-	movl	PARAM_SRC, %ebx
-	pushl	%esi		FRAME_pushl()
-
-	movl	PARAM_DIVISOR, %esi
-	orl	%ecx, %ecx
-
-	movl	PARAM_CARRY, %edx
-	jnz	LF(mpn_mod_1,top)
-
-	popl	%esi
-	movl	%edx, %eax
-
-	popl	%ebx
-	
-	ret
-
-EPILOGUE()
-
-
-PROLOGUE(mpn_mod_1)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	pushl	%ebx		FRAME_pushl()
-
-	movl	PARAM_SRC, %ebx
-	pushl	%esi		FRAME_pushl()
-
-	orl	%ecx, %ecx
-	jz	L(done_zero)
-
-	movl	PARAM_DIVISOR, %esi
-	movl	-4(%ebx,%ecx,4), %eax	C src high limb
-
-	cmpl	%esi, %eax
-
-	sbbl	%edx, %edx		C -1 if high<divisor
-
-	addl	%edx, %ecx		C skip one division if high<divisor
-	jz	L(done_eax)
-
-	andl	%eax, %edx		C carry if high<divisor
-
-
-L(top):
-	C eax	scratch (quotient)
-	C ebx	src
-	C ecx	counter
-	C edx	carry (remainder)
-	C esi	divisor
-	C edi
-	C ebp
-
-	movl	-4(%ebx,%ecx,4), %eax
-
-	divl	%esi
-
-	loop_or_decljnz	L(top)
-
-
-	movl	%edx, %eax
-L(done_eax):
-	popl	%esi
-
-	popl	%ebx
-
-	ret
-
-
-L(done_zero):
-	popl	%esi
-	xorl	%eax, %eax
-
-	popl	%ebx
-
-	ret
-	
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/mul_1.asm b/ghc/rts/gmp/mpn/x86/mul_1.asm
deleted file mode 100644
index 8817f291bc..0000000000
--- a/ghc/rts/gmp/mpn/x86/mul_1.asm
+++ /dev/null
@@ -1,130 +0,0 @@
-dnl  x86 mpn_mul_1 (for 386, 486, and Pentium Pro) -- Multiply a limb vector
-dnl  with a limb and store the result in a second limb vector.
-dnl 
-dnl      cycles/limb
-dnl  P6:     5.5
-dnl
-dnl  The following CPUs have their own optimized code, but for reference the
-dnl  code here runs as follows.
-dnl
-dnl      cycles/limb
-dnl  P5:    12.5
-dnl  K6:    10.5
-dnl  K7:     4.5
-
-
-dnl  Copyright (C) 1992, 1994, 1997, 1998, 1999, 2000 Free Software
-dnl  Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_mul_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                      mp_limb_t multiplier);
-
-defframe(PARAM_MULTIPLIER,16)
-defframe(PARAM_SIZE,      12)
-defframe(PARAM_SRC,       8)
-defframe(PARAM_DST,       4)
-
-	TEXT
-	ALIGN(8)
-PROLOGUE(mpn_mul_1)
-deflit(`FRAME',0)
-
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-	pushl	%ebp
-deflit(`FRAME',16)
-
-	movl	PARAM_DST,%edi
-	movl	PARAM_SRC,%esi
-	movl	PARAM_SIZE,%ecx
-
-	xorl	%ebx,%ebx
-	andl	$3,%ecx
-	jz	L(end0)
-
-L(oop0):
-	movl	(%esi),%eax
-	mull	PARAM_MULTIPLIER
-	leal	4(%esi),%esi
-	addl	%ebx,%eax
-	movl	$0,%ebx
-	adcl	%ebx,%edx
-	movl	%eax,(%edi)
-	movl	%edx,%ebx	C propagate carry into cylimb
-
-	leal	4(%edi),%edi
-	decl	%ecx
-	jnz	L(oop0)
-
-L(end0):
-	movl	PARAM_SIZE,%ecx
-	shrl	$2,%ecx
-	jz	L(end)
-
-
-	ALIGN(8)
-L(oop):	movl	(%esi),%eax
-	mull	PARAM_MULTIPLIER
-	addl	%eax,%ebx
-	movl	$0,%ebp
-	adcl	%edx,%ebp
-
-	movl	4(%esi),%eax
-	mull	PARAM_MULTIPLIER
-	movl	%ebx,(%edi)
-	addl	%eax,%ebp	C new lo + cylimb
-	movl	$0,%ebx
-	adcl	%edx,%ebx
-
-	movl	8(%esi),%eax
-	mull	PARAM_MULTIPLIER
-	movl	%ebp,4(%edi)
-	addl	%eax,%ebx	C new lo + cylimb
-	movl	$0,%ebp
-	adcl	%edx,%ebp
-
-	movl	12(%esi),%eax
-	mull	PARAM_MULTIPLIER
-	movl	%ebx,8(%edi)
-	addl	%eax,%ebp	C new lo + cylimb
-	movl	$0,%ebx
-	adcl	%edx,%ebx
-
-	movl	%ebp,12(%edi)
-
-	leal	16(%esi),%esi
-	leal	16(%edi),%edi
-	decl	%ecx
-	jnz	L(oop)
-
-L(end):	movl	%ebx,%eax
-
-	popl	%ebp
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/mul_basecase.asm b/ghc/rts/gmp/mpn/x86/mul_basecase.asm
deleted file mode 100644
index 3a9b73895b..0000000000
--- a/ghc/rts/gmp/mpn/x86/mul_basecase.asm
+++ /dev/null
@@ -1,209 +0,0 @@
-dnl  x86 mpn_mul_basecase -- Multiply two limb vectors and store the result
-dnl  in a third limb vector.
-
-
-dnl  Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation,
-dnl  Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C void mpn_mul_basecase (mp_ptr wp,
-C                        mp_srcptr xp, mp_size_t xsize,
-C                        mp_srcptr yp, mp_size_t ysize);
-C
-C This was written in a haste since the Pentium optimized code that was used
-C for all x86 machines was slow for the Pentium II.  This code would benefit
-C from some cleanup.
-C
-C To shave off some percentage of the run-time, one should make 4 variants
-C of the Louter loop, for the four different outcomes of un mod 4.  That
-C would avoid Loop0 altogether.  Code expansion would be > 4-fold for that
-C part of the function, but since it is not very large, that would be
-C acceptable.
-C
-C The mul loop (at L(oopM)) might need some tweaking.  It's current speed is
-C unknown.
-
-defframe(PARAM_YSIZE,20)
-defframe(PARAM_YP,   16)
-defframe(PARAM_XSIZE,12)
-defframe(PARAM_XP,   8)
-defframe(PARAM_WP,   4)
-
-defframe(VAR_MULTIPLIER, -4)
-defframe(VAR_COUNTER,    -8)
-deflit(VAR_STACK_SPACE,  8)
-
-	.text
-	ALIGN(8)
-
-PROLOGUE(mpn_mul_basecase)
-deflit(`FRAME',0)
-
-	subl	$VAR_STACK_SPACE,%esp
-	pushl	%esi
-	pushl	%ebp
-	pushl	%edi
-deflit(`FRAME',eval(VAR_STACK_SPACE+12))
-
-	movl	PARAM_XP,%esi
-	movl	PARAM_WP,%edi
-	movl	PARAM_YP,%ebp
-
-	movl	(%esi),%eax		C load xp[0]
-	mull	(%ebp)			C multiply by yp[0]
-	movl	%eax,(%edi)		C store to wp[0]
-	movl	PARAM_XSIZE,%ecx	C xsize
-	decl	%ecx			C If xsize = 1, ysize = 1 too
-	jz	L(done)
-
-	pushl	%ebx
-FRAME_pushl()
-	movl	%edx,%ebx
-
-	leal	4(%esi),%esi
-	leal	4(%edi),%edi
-
-L(oopM):
-	movl	(%esi),%eax		C load next limb at xp[j]
-	leal	4(%esi),%esi
-	mull	(%ebp)
-	addl	%ebx,%eax
-	movl	%edx,%ebx
-	adcl	$0,%ebx
-	movl	%eax,(%edi)
-	leal	4(%edi),%edi
-	decl	%ecx
-	jnz	L(oopM)
-
-	movl	%ebx,(%edi)		C most significant limb of product
-	addl	$4,%edi			C increment wp
-	movl	PARAM_XSIZE,%eax
-	shll	$2,%eax
-	subl	%eax,%edi
-	subl	%eax,%esi
-
-	movl	PARAM_YSIZE,%eax	C ysize
-	decl	%eax
-	jz	L(skip)
-	movl	%eax,VAR_COUNTER	C set index i to ysize
-
-L(outer):
-	movl	PARAM_YP,%ebp		C yp
-	addl	$4,%ebp			C make ebp point to next v limb
-	movl	%ebp,PARAM_YP
-	movl	(%ebp),%eax		C copy y limb ...
-	movl	%eax,VAR_MULTIPLIER	C ... to stack slot
-	movl	PARAM_XSIZE,%ecx
-
-	xorl	%ebx,%ebx
-	andl	$3,%ecx
-	jz	L(end0)
-
-L(oop0):
-	movl	(%esi),%eax
-	mull	VAR_MULTIPLIER
-	leal	4(%esi),%esi
-	addl	%ebx,%eax
-	movl	$0,%ebx
-	adcl	%ebx,%edx
-	addl	%eax,(%edi)
-	adcl	%edx,%ebx		C propagate carry into cylimb
-
-	leal	4(%edi),%edi
-	decl	%ecx
-	jnz	L(oop0)
-
-L(end0):
-	movl	PARAM_XSIZE,%ecx
-	shrl	$2,%ecx
-	jz	L(endX)
-
-	ALIGN(8)
-L(oopX):
-	movl	(%esi),%eax
-	mull	VAR_MULTIPLIER
-	addl	%eax,%ebx
-	movl	$0,%ebp
-	adcl	%edx,%ebp
-
-	movl	4(%esi),%eax
-	mull	VAR_MULTIPLIER
-	addl	%ebx,(%edi)
-	adcl	%eax,%ebp	C new lo + cylimb
-	movl	$0,%ebx
-	adcl	%edx,%ebx
-
-	movl	8(%esi),%eax
-	mull	VAR_MULTIPLIER
-	addl	%ebp,4(%edi)
-	adcl	%eax,%ebx	C new lo + cylimb
-	movl	$0,%ebp
-	adcl	%edx,%ebp
-
-	movl	12(%esi),%eax
-	mull	VAR_MULTIPLIER
-	addl	%ebx,8(%edi)
-	adcl	%eax,%ebp	C new lo + cylimb
-	movl	$0,%ebx
-	adcl	%edx,%ebx
-
-	addl	%ebp,12(%edi)
-	adcl	$0,%ebx		C propagate carry into cylimb
-
-	leal	16(%esi),%esi
-	leal	16(%edi),%edi
-	decl	%ecx
-	jnz	L(oopX)
-
-L(endX):
-	movl	%ebx,(%edi)
-	addl	$4,%edi
-
-	C we incremented wp and xp in the loop above; compensate
-	movl	PARAM_XSIZE,%eax
-	shll	$2,%eax
-	subl	%eax,%edi
-	subl	%eax,%esi
-
-	movl	VAR_COUNTER,%eax
-	decl	%eax
-	movl	%eax,VAR_COUNTER
-	jnz	L(outer)
-
-L(skip):
-	popl	%ebx
-	popl	%edi
-	popl	%ebp
-	popl	%esi
-	addl	$8,%esp
-	ret
-
-L(done):
-	movl	%edx,4(%edi)	   C store to wp[1]
-	popl	%edi
-	popl	%ebp
-	popl	%esi
-	addl	$8,%esp
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/p6/README b/ghc/rts/gmp/mpn/x86/p6/README
deleted file mode 100644
index 7dbc905a0d..0000000000
--- a/ghc/rts/gmp/mpn/x86/p6/README
+++ /dev/null
@@ -1,95 +0,0 @@
-
-                      INTEL P6 MPN SUBROUTINES
-
-
-
-This directory contains code optimized for Intel P6 class CPUs, meaning
-PentiumPro, Pentium II and Pentium III.  The mmx and p3mmx subdirectories
-have routines using MMX instructions.
-
-
-
-STATUS
-
-Times for the loops, with all code and data in L1 cache, are as follows.
-Some of these might be able to be improved.
-
-                               cycles/limb
-
-	mpn_add_n/sub_n           3.7
-
-	mpn_copyi                 0.75
-	mpn_copyd                 2.4
-
-	mpn_divrem_1             39.0
-	mpn_mod_1                39.0
-	mpn_divexact_by3          8.5
-
-	mpn_mul_1                 5.5
-	mpn_addmul/submul_1       6.35
-
-	mpn_l/rshift              2.5
-
-	mpn_mul_basecase          8.2 cycles/crossproduct (approx)
-	mpn_sqr_basecase          4.0 cycles/crossproduct (approx)
-	                          or 7.75 cycles/triangleproduct (approx)
-
-Pentium II and III have MMX and get the following improvements.
-
-	mpn_divrem_1             25.0 integer part, 17.5 fractional part
-	mpn_mod_1                24.0
-
-	mpn_l/rshift              1.75
-
-
-
-
-NOTES
-
-Write-allocate L1 data cache means prefetching of destinations is unnecessary.
-
-Mispredicted branches have a penalty of between 9 and 15 cycles, and even up
-to 26 cycles depending how far speculative execution has gone.  The 9 cycle
-minimum penalty comes from the issue pipeline being 9 stages.
-
-A copy with rep movs seems to copy 16 bytes at a time, since speeds for 4,
-5, 6 or 7 limb operations are all the same.  The 0.75 cycles/limb would be 3
-cycles per 16 byte block.
-
-
-
-
-CODING
-
-Instructions in general code have been shown grouped if they can execute
-together, which means up to three instructions with no successive
-dependencies, and with only the first being a multiple micro-op.
-
-P6 has out-of-order execution, so the groupings are really only showing
-dependent paths where some shuffling might allow some latencies to be
-hidden.
-
-
-
-
-REFERENCES
-
-"Intel Architecture Optimization Reference Manual", 1999, revision 001 dated
-02/99, order number 245127 (order number 730795-001 is in the document too).
-Available on-line:
-
-	http://download.intel.com/design/PentiumII/manuals/245127.htm
-
-"Intel Architecture Optimization Manual", 1997, order number 242816.  This
-is an older document mostly about P5 and not as good as the above.
-Available on-line:
-
-	http://download.intel.com/design/PentiumII/manuals/242816.htm
-
-
-
-----------------
-Local variables:
-mode: text
-fill-column: 76
-End:
diff --git a/ghc/rts/gmp/mpn/x86/p6/aorsmul_1.asm b/ghc/rts/gmp/mpn/x86/p6/aorsmul_1.asm
deleted file mode 100644
index feb364ec0b..0000000000
--- a/ghc/rts/gmp/mpn/x86/p6/aorsmul_1.asm
+++ /dev/null
@@ -1,300 +0,0 @@
-dnl  Intel P6 mpn_addmul_1/mpn_submul_1 -- add or subtract mpn multiple.
-dnl 
-dnl  P6: 6.35 cycles/limb (at 16 limbs/loop).
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  P6 UNROLL_COUNT cycles/limb
-dnl          8           6.7
-dnl         16           6.35
-dnl         32           6.3
-dnl         64           6.3
-dnl  Maximum possible with the current code is 64.
-
-deflit(UNROLL_COUNT, 16)
-
-
-ifdef(`OPERATION_addmul_1', `
-	define(M4_inst,        addl)
-	define(M4_function_1,  mpn_addmul_1)
-	define(M4_function_1c, mpn_addmul_1c)
-	define(M4_description, add it to)
-	define(M4_desc_retval, carry)
-',`ifdef(`OPERATION_submul_1', `
-	define(M4_inst,        subl)
-	define(M4_function_1,  mpn_submul_1)
-	define(M4_function_1c, mpn_submul_1c)
-	define(M4_description, subtract it from)
-	define(M4_desc_retval, borrow)
-',`m4_error(`Need OPERATION_addmul_1 or OPERATION_submul_1
-')')')
-
-MULFUNC_PROLOGUE(mpn_addmul_1 mpn_addmul_1c mpn_submul_1 mpn_submul_1c)
-
-
-C mp_limb_t M4_function_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                            mp_limb_t mult);
-C mp_limb_t M4_function_1c (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                             mp_limb_t mult, mp_limb_t carry);
-C
-C Calculate src,size multiplied by mult and M4_description dst,size.
-C Return the M4_desc_retval limb from the top of the result.
-C
-C This code is pretty much the same as the K6 code.  The unrolled loop is
-C the same, but there's just a few scheduling tweaks in the setups and the
-C simple loop.
-C
-C A number of variations have been tried for the unrolled loop, with one or
-C two carries, and with loads scheduled earlier, but nothing faster than 6
-C cycles/limb has been found.
-
-ifdef(`PIC',`
-deflit(UNROLL_THRESHOLD, 5)
-',`
-deflit(UNROLL_THRESHOLD, 5)
-')
-
-defframe(PARAM_CARRY,     20)
-defframe(PARAM_MULTIPLIER,16)
-defframe(PARAM_SIZE,      12)
-defframe(PARAM_SRC,       8)
-defframe(PARAM_DST,       4)
-
-	.text
-	ALIGN(32)
-
-PROLOGUE(M4_function_1c)
-	pushl	%ebx
-deflit(`FRAME',4)
-	movl	PARAM_CARRY, %ebx
-	jmp	LF(M4_function_1,start_nc)
-EPILOGUE()
-
-PROLOGUE(M4_function_1)
-	push	%ebx
-deflit(`FRAME',4)
-	xorl	%ebx, %ebx	C initial carry
-
-L(start_nc):
-	movl	PARAM_SIZE, %ecx
-	pushl	%esi
-deflit(`FRAME',8)
-
-	movl	PARAM_SRC, %esi
-	pushl	%edi
-deflit(`FRAME',12)
-
-	movl	PARAM_DST, %edi
-	pushl	%ebp
-deflit(`FRAME',16)
-	cmpl	$UNROLL_THRESHOLD, %ecx
-
-	movl	PARAM_MULTIPLIER, %ebp
-	jae	L(unroll)
-
-	
-	C simple loop
-	C this is offset 0x22, so close enough to aligned
-L(simple):
-	C eax	scratch
-	C ebx	carry
-	C ecx	counter
-	C edx	scratch
-	C esi	src
-	C edi	dst
-	C ebp	multiplier
-
-	movl	(%esi), %eax
-	addl	$4, %edi
-
-	mull	%ebp
-
-	addl	%ebx, %eax
-	adcl	$0, %edx
-
-	M4_inst	%eax, -4(%edi)
-	movl	%edx, %ebx
-
-	adcl	$0, %ebx
-	decl	%ecx
-
-	leal	4(%esi), %esi
-	jnz	L(simple)
-
-
-	popl	%ebp
-	popl	%edi
-
-	popl	%esi
-	movl	%ebx, %eax
-
-	popl	%ebx
-	ret
-
-
-
-C------------------------------------------------------------------------------
-C VAR_JUMP holds the computed jump temporarily because there's not enough
-C registers when doing the mul for the initial two carry limbs.
-C
-C The add/adc for the initial carry in %ebx is necessary only for the
-C mpn_add/submul_1c entry points.  Duplicating the startup code to
-C eliminiate this for the plain mpn_add/submul_1 doesn't seem like a good
-C idea.
-
-dnl  overlapping with parameters already fetched
-define(VAR_COUNTER,`PARAM_SIZE')
-define(VAR_JUMP,   `PARAM_DST')
-
-	C this is offset 0x43, so close enough to aligned
-L(unroll):
-	C eax
-	C ebx	initial carry
-	C ecx	size
-	C edx
-	C esi	src
-	C edi	dst
-	C ebp
-
-	movl	%ecx, %edx
-	decl	%ecx
-
-	subl	$2, %edx
-	negl	%ecx
-
-	shrl	$UNROLL_LOG2, %edx
-	andl	$UNROLL_MASK, %ecx
-
-	movl	%edx, VAR_COUNTER
-	movl	%ecx, %edx
-
-	C 15 code bytes per limb
-ifdef(`PIC',`
-	call	L(pic_calc)
-L(here):
-',`
-	shll	$4, %edx
-	negl	%ecx
-
-	leal	L(entry) (%edx,%ecx,1), %edx
-')
-	movl	(%esi), %eax		C src low limb
-
-	movl	%edx, VAR_JUMP
-	leal	ifelse(UNROLL_BYTES,256,128+) 4(%esi,%ecx,4), %esi
-
-	mull	%ebp
-
-	addl	%ebx, %eax	C initial carry (from _1c)
-	adcl	$0, %edx
-
-	movl	%edx, %ebx	C high carry
-	leal	ifelse(UNROLL_BYTES,256,128) (%edi,%ecx,4), %edi
-
-	movl	VAR_JUMP, %edx
-	testl	$1, %ecx
-	movl	%eax, %ecx	C low carry
-
-	cmovnz(	%ebx, %ecx)	C high,low carry other way around
-	cmovnz(	%eax, %ebx)
-
-	jmp	*%edx
-
-
-ifdef(`PIC',`
-L(pic_calc):
-	shll	$4, %edx
-	negl	%ecx
-
-	C See README.family about old gas bugs
-	leal	(%edx,%ecx,1), %edx
-	addl	$L(entry)-L(here), %edx
-
-	addl	(%esp), %edx
-
-	ret
-')
-
-
-C -----------------------------------------------------------
-	ALIGN(32)
-L(top):
-deflit(`FRAME',16)
-	C eax	scratch
-	C ebx	carry hi
-	C ecx	carry lo
-	C edx	scratch
-	C esi	src
-	C edi	dst
-	C ebp	multiplier
-	C
-	C VAR_COUNTER	loop counter
-	C
-	C 15 code bytes per limb
-
-	addl	$UNROLL_BYTES, %edi
-
-L(entry):
-deflit(CHUNK_COUNT,2)
-forloop(`i', 0, UNROLL_COUNT/CHUNK_COUNT-1, `
-	deflit(`disp0', eval(i*4*CHUNK_COUNT ifelse(UNROLL_BYTES,256,-128)))
-	deflit(`disp1', eval(disp0 + 4))
-
-Zdisp(	movl,	disp0,(%esi), %eax)
-	mull	%ebp
-Zdisp(	M4_inst,%ecx, disp0,(%edi))
-	adcl	%eax, %ebx
-	movl	%edx, %ecx
-	adcl	$0, %ecx
-
-	movl	disp1(%esi), %eax
-	mull	%ebp
-	M4_inst	%ebx, disp1(%edi)
-	adcl	%eax, %ecx
-	movl	%edx, %ebx
-	adcl	$0, %ebx
-')
-
-	decl	VAR_COUNTER
-	leal	UNROLL_BYTES(%esi), %esi
-
-	jns	L(top)
-
-
-deflit(`disp0',	eval(UNROLL_BYTES ifelse(UNROLL_BYTES,256,-128)))
-
-	M4_inst	%ecx, disp0(%edi)
-	movl	%ebx, %eax
-
-	popl	%ebp
-	popl	%edi
-
-	popl	%esi
-	popl	%ebx
-	adcl	$0, %eax
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/p6/diveby3.asm b/ghc/rts/gmp/mpn/x86/p6/diveby3.asm
deleted file mode 100644
index a77703ea89..0000000000
--- a/ghc/rts/gmp/mpn/x86/p6/diveby3.asm
+++ /dev/null
@@ -1,37 +0,0 @@
-dnl  Intel P6 mpn_divexact_by3 -- mpn division by 3, expecting no remainder.
-dnl       
-dnl  P6: 8.5 cycles/limb
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-dnl  The P5 code runs well on P6, in fact better than anything else found so
-dnl  far.  An imul is 4 cycles, meaning the two cmp/sbbl pairs on the
-dnl  dependent path are taking 4.5 cycles.
-dnl
-dnl  The destination cache line prefetching is unnecessary on P6, but
-dnl  removing it is a 2 cycle slowdown (approx), so it must be inducing
-dnl  something good in the out of order execution.
-
-include(`../config.m4')
-
-MULFUNC_PROLOGUE(mpn_divexact_by3c)
-include_mpn(`x86/pentium/diveby3.asm')
diff --git a/ghc/rts/gmp/mpn/x86/p6/gmp-mparam.h b/ghc/rts/gmp/mpn/x86/p6/gmp-mparam.h
deleted file mode 100644
index d7bfb6d60c..0000000000
--- a/ghc/rts/gmp/mpn/x86/p6/gmp-mparam.h
+++ /dev/null
@@ -1,96 +0,0 @@
-/* Intel P6 gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-
-#define BITS_PER_MP_LIMB 32
-#define BYTES_PER_MP_LIMB 4
-#define BITS_PER_LONGINT 32
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-
-#ifndef UMUL_TIME
-#define UMUL_TIME   5   /* cycles */
-#endif
-#ifndef UDIV_TIME
-#define UDIV_TIME   39  /* cycles */
-#endif
-
-#ifndef COUNT_TRAILING_ZEROS_TIME
-#define COUNT_TRAILING_ZEROS_TIME   2  /* cycles */
-#endif
-
-
-/* Generated by tuneup.c, 2000-07-06. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD   23
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD      139
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD   52
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD      166
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD             116
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD             66
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            20
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD        4
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD          54
-#endif
-
-#ifndef FFT_MUL_TABLE
-#define FFT_MUL_TABLE  { 592, 1440, 2688, 5632, 14336, 40960, 0 }
-#endif
-#ifndef FFT_MODF_MUL_THRESHOLD
-#define FFT_MODF_MUL_THRESHOLD     608
-#endif
-#ifndef FFT_MUL_THRESHOLD
-#define FFT_MUL_THRESHOLD         5888
-#endif
-
-#ifndef FFT_SQR_TABLE
-#define FFT_SQR_TABLE  { 656, 1504, 2944, 6656, 18432, 57344, 0 }
-#endif
-#ifndef FFT_MODF_SQR_THRESHOLD
-#define FFT_MODF_SQR_THRESHOLD     672
-#endif
-#ifndef FFT_SQR_THRESHOLD
-#define FFT_SQR_THRESHOLD         5888
-#endif
diff --git a/ghc/rts/gmp/mpn/x86/p6/mmx/divrem_1.asm b/ghc/rts/gmp/mpn/x86/p6/mmx/divrem_1.asm
deleted file mode 100644
index f1b011b623..0000000000
--- a/ghc/rts/gmp/mpn/x86/p6/mmx/divrem_1.asm
+++ /dev/null
@@ -1,677 +0,0 @@
-dnl  Intel Pentium-II mpn_divrem_1 -- mpn by limb division.
-dnl 
-dnl  P6MMX: 25.0 cycles/limb integer part, 17.5 cycles/limb fraction part.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_divrem_1 (mp_ptr dst, mp_size_t xsize,
-C                         mp_srcptr src, mp_size_t size,
-C                         mp_limb_t divisor);
-C mp_limb_t mpn_divrem_1c (mp_ptr dst, mp_size_t xsize,
-C                          mp_srcptr src, mp_size_t size,
-C                          mp_limb_t divisor, mp_limb_t carry);
-C
-C This code is a lightly reworked version of mpn/x86/k7/mmx/divrem_1.asm,
-C see that file for some comments.  It's likely what's here can be improved.
-
-
-dnl  MUL_THRESHOLD is the value of xsize+size at which the multiply by
-dnl  inverse method is used, rather than plain "divl"s.  Minimum value 1.
-dnl
-dnl  The different speeds of the integer and fraction parts means that using
-dnl  xsize+size isn't quite right.  The threshold wants to be a bit higher
-dnl  for the integer part and a bit lower for the fraction part.  (Or what's
-dnl  really wanted is to speed up the integer part!)
-dnl
-dnl  The threshold is set to make the integer part right.  At 4 limbs the
-dnl  div and mul are about the same there, but on the fractional part the
-dnl  mul is much faster.
-
-deflit(MUL_THRESHOLD, 4)
-
-
-defframe(PARAM_CARRY,  24)
-defframe(PARAM_DIVISOR,20)
-defframe(PARAM_SIZE,   16)
-defframe(PARAM_SRC,    12)
-defframe(PARAM_XSIZE,  8)
-defframe(PARAM_DST,    4)
-
-defframe(SAVE_EBX,    -4)
-defframe(SAVE_ESI,    -8)
-defframe(SAVE_EDI,    -12)
-defframe(SAVE_EBP,    -16)
-
-defframe(VAR_NORM,    -20)
-defframe(VAR_INVERSE, -24)
-defframe(VAR_SRC,     -28)
-defframe(VAR_DST,     -32)
-defframe(VAR_DST_STOP,-36)
-
-deflit(STACK_SPACE, 36)
-
-	.text
-	ALIGN(16)
-
-PROLOGUE(mpn_divrem_1c)
-deflit(`FRAME',0)
-	movl	PARAM_CARRY, %edx
-
-	movl	PARAM_SIZE, %ecx
-	subl	$STACK_SPACE, %esp
-deflit(`FRAME',STACK_SPACE)
-
-	movl	%ebx, SAVE_EBX
-	movl	PARAM_XSIZE, %ebx
-
-	movl	%edi, SAVE_EDI
-	movl	PARAM_DST, %edi
-
-	movl	%ebp, SAVE_EBP
-	movl	PARAM_DIVISOR, %ebp
-
-	movl	%esi, SAVE_ESI
-	movl	PARAM_SRC, %esi
-
-	leal	-4(%edi,%ebx,4), %edi
-	jmp	LF(mpn_divrem_1,start_1c)
-
-EPILOGUE()
-
-
-	C offset 0x31, close enough to aligned
-PROLOGUE(mpn_divrem_1)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %ecx
-	movl	$0, %edx		C initial carry (if can't skip a div)
-	subl	$STACK_SPACE, %esp
-deflit(`FRAME',STACK_SPACE)
-
-	movl	%ebp, SAVE_EBP
-	movl	PARAM_DIVISOR, %ebp
-
-	movl	%ebx, SAVE_EBX
-	movl	PARAM_XSIZE, %ebx
-
-	movl	%esi, SAVE_ESI
-	movl	PARAM_SRC, %esi
-	orl	%ecx, %ecx
-
-	movl	%edi, SAVE_EDI
-	movl	PARAM_DST, %edi
-
-	leal	-4(%edi,%ebx,4), %edi	C &dst[xsize-1]
-	jz	L(no_skip_div)
-
-	movl	-4(%esi,%ecx,4), %eax	C src high limb
-	cmpl	%ebp, %eax		C one less div if high<divisor
-	jnb	L(no_skip_div)
-
-	movl	$0, (%edi,%ecx,4)	C dst high limb
-	decl	%ecx			C size-1
-	movl	%eax, %edx		C src high limb as initial carry
-L(no_skip_div):
-
-
-L(start_1c):
-	C eax	
-	C ebx	xsize
-	C ecx	size
-	C edx	carry
-	C esi	src
-	C edi	&dst[xsize-1]
-	C ebp	divisor
-
-	leal	(%ebx,%ecx), %eax	C size+xsize
-	cmpl	$MUL_THRESHOLD, %eax
-	jae	L(mul_by_inverse)
-
-	orl	%ecx, %ecx
-	jz	L(divide_no_integer)
-
-L(divide_integer):
-	C eax	scratch (quotient)
-	C ebx	xsize
-	C ecx	counter
-	C edx	scratch (remainder)
-	C esi	src
-	C edi	&dst[xsize-1]
-	C ebp	divisor
-
-	movl	-4(%esi,%ecx,4), %eax
-
-	divl	%ebp
-
-	movl	%eax, (%edi,%ecx,4)
-	decl	%ecx
-	jnz	L(divide_integer)
-
-
-L(divide_no_integer):
-	movl	PARAM_DST, %edi
-	orl	%ebx, %ebx
-	jnz	L(divide_fraction)
-
-L(divide_done):
-	movl	SAVE_ESI, %esi
-
-	movl	SAVE_EDI, %edi
-
-	movl	SAVE_EBX, %ebx
-	movl	%edx, %eax
-
-	movl	SAVE_EBP, %ebp
-	addl	$STACK_SPACE, %esp
-
-	ret
-
-
-L(divide_fraction):
-	C eax	scratch (quotient)
-	C ebx	counter
-	C ecx
-	C edx	scratch (remainder)
-	C esi
-	C edi	dst
-	C ebp	divisor
-
-	movl	$0, %eax
-
-	divl	%ebp
-
-	movl	%eax, -4(%edi,%ebx,4)
-	decl	%ebx
-	jnz	L(divide_fraction)
-
-	jmp	L(divide_done)
-
-
-
-C -----------------------------------------------------------------------------
-
-L(mul_by_inverse):
-	C eax
-	C ebx	xsize
-	C ecx	size
-	C edx	carry
-	C esi	src
-	C edi	&dst[xsize-1]
-	C ebp	divisor
-
-	leal	12(%edi), %ebx
-
-	movl	%ebx, VAR_DST_STOP
-	leal	4(%edi,%ecx,4), %edi	C &dst[xsize+size]
-
-	movl	%edi, VAR_DST
-	movl	%ecx, %ebx		C size
-
-	bsrl	%ebp, %ecx		C 31-l
-	movl	%edx, %edi		C carry
-
-	leal	1(%ecx), %eax		C 32-l
-	xorl	$31, %ecx		C l
-
-	movl	%ecx, VAR_NORM
-	movl	$-1, %edx
-
-	shll	%cl, %ebp		C d normalized
-	movd	%eax, %mm7
-
-	movl	$-1, %eax
-	subl	%ebp, %edx		C (b-d)-1 giving edx:eax = b*(b-d)-1
-
-	divl	%ebp			C floor (b*(b-d)-1) / d
-
-	movl	%eax, VAR_INVERSE
-	orl	%ebx, %ebx		C size
-	leal	-12(%esi,%ebx,4), %eax	C &src[size-3]
-
-	movl	%eax, VAR_SRC
-	jz	L(start_zero)
-
-	movl	8(%eax), %esi		C src high limb
-	cmpl	$1, %ebx
-	jz	L(start_one)
-
-L(start_two_or_more):
-	movl	4(%eax), %edx		C src second highest limb
-
-	shldl(	%cl, %esi, %edi)	C n2 = carry,high << l
-
-	shldl(	%cl, %edx, %esi)	C n10 = high,second << l
-
-	cmpl	$2, %ebx
-	je	L(integer_two_left)
-	jmp	L(integer_top)
-
-
-L(start_one):
-	shldl(	%cl, %esi, %edi)	C n2 = carry,high << l
-
-	shll	%cl, %esi		C n10 = high << l
-	jmp	L(integer_one_left)
-
-
-L(start_zero):
-	shll	%cl, %edi		C n2 = carry << l
-	movl	$0, %esi		C n10 = 0
-
-	C we're here because xsize+size>=MUL_THRESHOLD, so with size==0 then
-	C must have xsize!=0
-	jmp	L(fraction_some)
-
-
-
-C -----------------------------------------------------------------------------
-C
-C This loop runs at about 25 cycles, which is probably sub-optimal, and
-C certainly more than the dependent chain would suggest.  A better loop, or
-C a better rough analysis of what's possible, would be welcomed.
-C
-C In the current implementation, the following successively dependent
-C micro-ops seem to exist.
-C
-C		       uops
-C		n2+n1	1   (addl)
-C		mul	5
-C		q1+1	3   (addl/adcl)
-C		mul	5
-C		sub	3   (subl/sbbl)
-C		addback	2   (cmov)
-C		       ---
-C		       19
-C
-C Lack of registers hinders explicit scheduling and it might be that the
-C normal out of order execution isn't able to hide enough under the mul
-C latencies.
-C
-C Using sarl/negl to pick out n1 for the n2+n1 stage is a touch faster than
-C cmov (and takes one uop off the dependent chain).  A sarl/andl/addl
-C combination was tried for the addback (despite the fact it would lengthen
-C the dependent chain) but found to be no faster.
-
-
-	ALIGN(16)
-L(integer_top):
-	C eax	scratch
-	C ebx	scratch (nadj, q1)
-	C ecx	scratch (src, dst)
-	C edx	scratch
-	C esi	n10
-	C edi	n2
-	C ebp	d
-	C
-	C mm0	scratch (src qword)
-	C mm7	rshift for normalization
-
-	movl	%esi, %eax
-	movl	%ebp, %ebx
-
-	sarl	$31, %eax          C -n1
-	movl	VAR_SRC, %ecx
-
-	andl	%eax, %ebx         C -n1 & d
-	negl	%eax               C n1
-
-	addl	%esi, %ebx         C nadj = n10 + (-n1 & d), ignoring overflow
-	addl	%edi, %eax         C n2+n1
-	movq	(%ecx), %mm0       C next src limb and the one below it
-
-	mull	VAR_INVERSE        C m*(n2+n1)
-
-	subl	$4, %ecx
-
-	movl	%ecx, VAR_SRC
-
-	C
-
-	C
-
-	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
-	movl	%ebp, %eax	   C d
-	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
-
-	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
-	jz	L(q1_ff)
-
-	mull	%ebx		   C (q1+1)*d
-
-	movl	VAR_DST, %ecx
-	psrlq	%mm7, %mm0
-
-	C
-
-	C
-
-	C
-
-	subl	%eax, %esi
-	movl	VAR_DST_STOP, %eax
-
-	sbbl	%edx, %edi	   C n - (q1+1)*d
-	movl	%esi, %edi	   C remainder -> n2
-	leal	(%ebp,%esi), %edx
-
-	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
-	movd	%mm0, %esi
-
-	sbbl	$0, %ebx	   C q
-	subl	$4, %ecx
-
-	movl	%ebx, (%ecx)
-	cmpl	%eax, %ecx
-
-	movl	%ecx, VAR_DST
-	jne	L(integer_top)
-
-
-L(integer_loop_done):
-
-
-C -----------------------------------------------------------------------------
-C
-C Here, and in integer_one_left below, an sbbl $0 is used rather than a jz
-C q1_ff special case.  This make the code a bit smaller and simpler, and
-C costs only 2 cycles (each).
-
-L(integer_two_left):
-	C eax	scratch
-	C ebx	scratch (nadj, q1)
-	C ecx	scratch (src, dst)
-	C edx	scratch
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-	C
-	C mm0	src limb, shifted
-	C mm7	rshift
-
-
- 	movl	%esi, %eax
- 	movl	%ebp, %ebx
-
- 	sarl	$31, %eax          C -n1
- 	movl	PARAM_SRC, %ecx
-
- 	andl	%eax, %ebx         C -n1 & d
- 	negl	%eax               C n1
-
- 	addl	%esi, %ebx         C nadj = n10 + (-n1 & d), ignoring overflow
- 	addl	%edi, %eax         C n2+n1
-
-	mull	VAR_INVERSE        C m*(n2+n1)
-
-	movd	(%ecx), %mm0	   C src low limb
-
-	movl	VAR_DST_STOP, %ecx
-
-	C
-
-	C
-
-	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
-	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
-	movl	%ebp, %eax	   C d
-
-	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
-
-	sbbl	$0, %ebx
-
-	mull	%ebx		   C (q1+1)*d
-
-	psllq	$32, %mm0
-
-	psrlq	%mm7, %mm0
-
-	C
-
-	C
-
-	subl	%eax, %esi
-
-	sbbl	%edx, %edi	   C n - (q1+1)*d
-	movl	%esi, %edi	   C remainder -> n2
-	leal	(%ebp,%esi), %edx
-
-	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
-	movd	%mm0, %esi
-
-	sbbl	$0, %ebx	   C q
-
-	movl	%ebx, -4(%ecx)
-
-
-C -----------------------------------------------------------------------------
-L(integer_one_left):
-	C eax	scratch
-	C ebx	scratch (nadj, q1)
-	C ecx	scratch (dst)
-	C edx	scratch
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-	C
-	C mm0	src limb, shifted
-	C mm7	rshift
-
-
- 	movl	%esi, %eax
- 	movl	%ebp, %ebx
-
- 	sarl	$31, %eax          C -n1
- 	movl	VAR_DST_STOP, %ecx
-
- 	andl	%eax, %ebx         C -n1 & d
- 	negl	%eax               C n1
-
- 	addl	%esi, %ebx         C nadj = n10 + (-n1 & d), ignoring overflow
- 	addl	%edi, %eax         C n2+n1
-
-	mull	VAR_INVERSE        C m*(n2+n1)
-
-	C
-
-	C
-
-	C
-
-	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
-	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
-	movl	%ebp, %eax	   C d
-
-	C
-
-	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
-
-	sbbl	$0, %ebx           C q1 if q1+1 overflowed
-
-	mull	%ebx
-
-	C
-
-	C
-
-	C
-
-	C
-
-	subl	%eax, %esi
-	movl	PARAM_XSIZE, %eax
-
-	sbbl	%edx, %edi	   C n - (q1+1)*d
-	movl	%esi, %edi	   C remainder -> n2
-	leal	(%ebp,%esi), %edx
-
-	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
-
-	sbbl	$0, %ebx	   C q
-
-	movl	%ebx, -8(%ecx)
-	subl	$8, %ecx
-
-
-
-	orl	%eax, %eax         C xsize
-	jnz	L(fraction_some)
-
-	movl	%edi, %eax
-L(fraction_done):
-	movl	VAR_NORM, %ecx
-	movl	SAVE_EBP, %ebp
-
-	movl	SAVE_EDI, %edi
-
-	movl	SAVE_ESI, %esi
-
-	movl	SAVE_EBX, %ebx
-	addl	$STACK_SPACE, %esp
-
-	shrl	%cl, %eax
-	emms
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-C
-C Special case for q1=0xFFFFFFFF, giving q=0xFFFFFFFF meaning the low dword
-C of q*d is simply -d and the remainder n-q*d = n10+d
-
-L(q1_ff):
-	C eax	(divisor)
-	C ebx	(q1+1 == 0)
-	C ecx
-	C edx
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-
-	movl	VAR_DST, %ecx
-	movl	VAR_DST_STOP, %edx
-	subl	$4, %ecx
-
-	movl	%ecx, VAR_DST
-	psrlq	%mm7, %mm0
-	leal	(%ebp,%esi), %edi	C n-q*d remainder -> next n2
-
-	movl	$-1, (%ecx)
-	movd	%mm0, %esi		C next n10
-
-	cmpl	%ecx, %edx
-	jne	L(integer_top)
-
-	jmp	L(integer_loop_done)
-
-
-
-C -----------------------------------------------------------------------------
-C
-C In the current implementation, the following successively dependent
-C micro-ops seem to exist.
-C
-C		       uops
-C		mul	5
-C		q1+1	1   (addl)
-C		mul	5
-C		sub	3   (negl/sbbl)
-C		addback	2   (cmov)
-C		       ---
-C		       16
-C
-C The loop in fact runs at about 17.5 cycles.  Using a sarl/andl/addl for
-C the addback was found to be a touch slower.
-
-
-	ALIGN(16)
-L(fraction_some):
-	C eax
-	C ebx
-	C ecx
-	C edx
-	C esi
-	C edi	carry
-	C ebp	divisor
-
-	movl	PARAM_DST, %esi
-	movl	VAR_DST_STOP, %ecx
-	movl	%edi, %eax
-
-	subl	$8, %ecx
-
-
-	ALIGN(16)
-L(fraction_top):
-	C eax	n2, then scratch
-	C ebx	scratch (nadj, q1)
-	C ecx	dst, decrementing
-	C edx	scratch
-	C esi	dst stop point
-	C edi	n2
-	C ebp	divisor
-
-	mull	VAR_INVERSE	C m*n2
-
-	movl	%ebp, %eax	C d
-	subl	$4, %ecx	C dst
-	leal	1(%edi), %ebx
-
-	C
-
-	C
-
-	C
-
-	addl	%edx, %ebx	C 1 + high(n2<<32 + m*n2) = q1+1
-
-	mull	%ebx		C (q1+1)*d
-
-	C
-
-	C
-
-	C
-
-	C
-
-	negl	%eax		C low of n - (q1+1)*d
-
- 	sbbl	%edx, %edi	C high of n - (q1+1)*d, caring only about carry
-	leal    (%ebp,%eax), %edx
-
- 	cmovc(	%edx, %eax)	C n - q1*d if underflow from using q1+1
-
- 	sbbl	$0, %ebx	C q
-	movl	%eax, %edi	C remainder->n2
- 	cmpl	%esi, %ecx
-
-	movl	%ebx, (%ecx)	C previous q
-	jne	L(fraction_top)
-
-
-	jmp	L(fraction_done)
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/p6/mmx/mod_1.asm b/ghc/rts/gmp/mpn/x86/p6/mmx/mod_1.asm
deleted file mode 100644
index e7d8d94d33..0000000000
--- a/ghc/rts/gmp/mpn/x86/p6/mmx/mod_1.asm
+++ /dev/null
@@ -1,444 +0,0 @@
-dnl  Intel Pentium-II mpn_mod_1 -- mpn by limb remainder.
-dnl 
-dnl  P6MMX: 24.0 cycles/limb.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_mod_1 (mp_srcptr src, mp_size_t size, mp_limb_t divisor);
-C mp_limb_t mpn_mod_1c (mp_srcptr src, mp_size_t size, mp_limb_t divisor,
-C                       mp_limb_t carry);
-C
-C The code here very similar to mpn_divrem_1, but with the quotient
-C discarded.  What's here probably isn't optimal.
-C
-C See mpn/x86/p6/mmx/divrem_1.c and mpn/x86/k7/mmx/mod_1.asm for some
-C comments.
-
-
-dnl  MUL_THRESHOLD is the size at which the multiply by inverse method is
-dnl  used, rather than plain "divl"s.  Minimum value 2.
-
-deflit(MUL_THRESHOLD, 4)
-
-
-defframe(PARAM_CARRY,  16)
-defframe(PARAM_DIVISOR,12)
-defframe(PARAM_SIZE,    8)
-defframe(PARAM_SRC,     4)
-
-defframe(SAVE_EBX,    -4)
-defframe(SAVE_ESI,    -8)
-defframe(SAVE_EDI,    -12)
-defframe(SAVE_EBP,    -16)
-
-defframe(VAR_NORM,    -20)
-defframe(VAR_INVERSE, -24)
-defframe(VAR_SRC_STOP,-28)
-
-deflit(STACK_SPACE, 28)
-
-	.text
-	ALIGN(16)
-
-PROLOGUE(mpn_mod_1c)
-deflit(`FRAME',0)
-	movl	PARAM_CARRY, %edx
-	movl	PARAM_SIZE, %ecx
-	subl	$STACK_SPACE, %esp
-deflit(`FRAME',STACK_SPACE)
-
-	movl	%ebp, SAVE_EBP
-	movl	PARAM_DIVISOR, %ebp
-
-	movl	%esi, SAVE_ESI
-	movl	PARAM_SRC, %esi
-	jmp	LF(mpn_mod_1,start_1c)
-
-EPILOGUE()
-
-
-	ALIGN(16)
-PROLOGUE(mpn_mod_1)
-deflit(`FRAME',0)
-
-	movl	$0, %edx		C initial carry (if can't skip a div)
-	movl	PARAM_SIZE, %ecx
-	subl	$STACK_SPACE, %esp
-deflit(`FRAME',STACK_SPACE)
-
-	movl	%esi, SAVE_ESI
-	movl	PARAM_SRC, %esi
-
-	movl	%ebp, SAVE_EBP
-	movl	PARAM_DIVISOR, %ebp
-
-	orl	%ecx, %ecx
-	jz	L(divide_done)
-
-	movl	-4(%esi,%ecx,4), %eax	C src high limb
-
-	cmpl	%ebp, %eax		C carry flag if high<divisor
-					
-	cmovc(	%eax, %edx)		C src high limb as initial carry
-	sbbl	$0, %ecx		C size-1 to skip one div
-	jz	L(divide_done)
-
-
-	ALIGN(16)
-L(start_1c):
-	C eax	
-	C ebx
-	C ecx	size
-	C edx	carry
-	C esi	src
-	C edi
-	C ebp	divisor
-
-	cmpl	$MUL_THRESHOLD, %ecx
-	jae	L(mul_by_inverse)
-
-
-	orl	%ecx, %ecx
-	jz	L(divide_done)
-
-
-L(divide_top):
-	C eax	scratch (quotient)
-	C ebx
-	C ecx	counter, limbs, decrementing
-	C edx	scratch (remainder)
-	C esi	src
-	C edi
-	C ebp
-
-	movl	-4(%esi,%ecx,4), %eax
-
-	divl	%ebp
-
-	decl	%ecx
-	jnz	L(divide_top)
-
-
-L(divide_done):
-	movl	SAVE_ESI, %esi
-	movl	%edx, %eax
-
-	movl	SAVE_EBP, %ebp
-	addl	$STACK_SPACE, %esp
-
-	ret
-
-
-
-C -----------------------------------------------------------------------------
-
-L(mul_by_inverse):
-	C eax
-	C ebx
-	C ecx	size
-	C edx	carry
-	C esi	src
-	C edi
-	C ebp	divisor
-
-	movl	%ebx, SAVE_EBX
-	leal	-4(%esi), %ebx
-
-	movl	%ebx, VAR_SRC_STOP
-	movl	%ecx, %ebx		C size
-
-	movl	%edi, SAVE_EDI
-	movl	%edx, %edi		C carry
-
-	bsrl	%ebp, %ecx		C 31-l
-	movl	$-1, %edx
-
-	leal	1(%ecx), %eax		C 32-l
-	xorl	$31, %ecx		C l
-
-	movl	%ecx, VAR_NORM
-	shll	%cl, %ebp		C d normalized
-
-	movd	%eax, %mm7
-	movl	$-1, %eax
-	subl	%ebp, %edx		C (b-d)-1 so  edx:eax = b*(b-d)-1
-
-	divl	%ebp			C floor (b*(b-d)-1) / d
-
-	C
-
-	movl	%eax, VAR_INVERSE
-	leal	-12(%esi,%ebx,4), %eax	C &src[size-3]
-
-	movl	8(%eax), %esi		C src high limb
-	movl	4(%eax), %edx		C src second highest limb
-
-	shldl(	%cl, %esi, %edi)	C n2 = carry,high << l
-
-	shldl(	%cl, %edx, %esi)	C n10 = high,second << l
-
-	movl	%eax, %ecx		C &src[size-3]
-
-
-ifelse(MUL_THRESHOLD,2,`
-	cmpl	$2, %ebx
-	je	L(inverse_two_left)
-')
-
-
-C The dependent chain here is the same as in mpn_divrem_1, but a few
-C instructions are saved by not needing to store the quotient limbs.  This
-C gets it down to 24 c/l, which is still a bit away from a theoretical 19
-C c/l.
-
-	ALIGN(16)
-L(inverse_top):
-	C eax	scratch
-	C ebx	scratch (nadj, q1)
-	C ecx	src pointer, decrementing
-	C edx	scratch
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-	C
-	C mm0	scratch (src qword)
-	C mm7	rshift for normalization
-
-
-	movl	%esi, %eax
-	movl	%ebp, %ebx
-
-	sarl	$31, %eax          C -n1
-
-	andl	%eax, %ebx         C -n1 & d
-	negl	%eax               C n1
-
-	addl	%esi, %ebx         C nadj = n10 + (-n1 & d), ignoring overflow
-	addl	%edi, %eax         C n2+n1
-
-	mull	VAR_INVERSE        C m*(n2+n1)
-
-	movq	(%ecx), %mm0       C next src limb and the one below it
-	subl	$4, %ecx
-
-	C
-
-	C
-
-	C
-
-	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
-	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
-	movl	%ebp, %eax	   C d
-
-	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
-	jz	L(q1_ff)
-
-	mull	%ebx		   C (q1+1)*d
-
-	psrlq	%mm7, %mm0
-	movl	VAR_SRC_STOP, %ebx
-
-	C
-
-	C
-
-	C
-
-	subl	%eax, %esi
-
-	sbbl	%edx, %edi	   C n - (q1+1)*d
-	movl	%esi, %edi	   C remainder -> n2
-	leal	(%ebp,%esi), %edx
-
-	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
-	movd	%mm0, %esi
-	cmpl	%ebx, %ecx
-
-	jne	L(inverse_top)
-
-
-L(inverse_loop_done):
-
-
-C -----------------------------------------------------------------------------
-
-L(inverse_two_left):
-	C eax	scratch
-	C ebx	scratch (nadj, q1)
-	C ecx	&src[-1]
-	C edx	scratch
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-	C
-	C mm0	scratch (src dword)
-	C mm7	rshift
-
-	movl	%esi, %eax
-	movl	%ebp, %ebx
-
-	sarl	$31, %eax          C -n1
-
-	andl	%eax, %ebx         C -n1 & d
-	negl	%eax               C n1
-
-	addl	%esi, %ebx         C nadj = n10 + (-n1 & d), ignoring overflow
-	addl	%edi, %eax         C n2+n1
-
-	mull	VAR_INVERSE        C m*(n2+n1)
-
-	movd	4(%ecx), %mm0	   C src low limb
-
-	C
-
-	C
-
-	C
-
-	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
-	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
-
-	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
-
-	sbbl	$0, %ebx
-	movl	%ebp, %eax	   C d
-
-	mull	%ebx		   C (q1+1)*d
-
-	psllq	$32, %mm0
-
-	psrlq	%mm7, %mm0
-
-	C
-
-	C
-
-	subl	%eax, %esi
-
-	sbbl	%edx, %edi	   C n - (q1+1)*d
-	movl	%esi, %edi	   C remainder -> n2
-	leal	(%ebp,%esi), %edx
-
-	cmovc(	%edx, %edi)	   C n - q1*d if underflow from using q1+1
-	movd	%mm0, %esi
-
-
-C One limb left
-
-	C eax	scratch
-	C ebx	scratch (nadj, q1)
-	C ecx
-	C edx	scratch
-	C esi	n10
-	C edi	n2
-	C ebp	divisor
-	C
-	C mm0	src limb, shifted
-	C mm7	rshift
-
-	movl	%esi, %eax
-	movl	%ebp, %ebx
-
-	sarl	$31, %eax          C -n1
-
-	andl	%eax, %ebx         C -n1 & d
-	negl	%eax               C n1
-
-	addl	%esi, %ebx         C nadj = n10 + (-n1 & d), ignoring overflow
-	addl	%edi, %eax         C n2+n1
-
-	mull	VAR_INVERSE        C m*(n2+n1)
-
-	movl	VAR_NORM, %ecx     C for final denorm
-
-	C
-
-	C
-
-	C
-
-	addl	%ebx, %eax         C m*(n2+n1) + nadj, low giving carry flag
-	leal	1(%edi), %ebx      C n2<<32 + m*(n2+n1))
-
-	adcl	%edx, %ebx         C 1 + high(n2<<32 + m*(n2+n1) + nadj) = q1+1
-
-	sbbl	$0, %ebx
-	movl	%ebp, %eax	   C d
-
-	mull	%ebx		   C (q1+1)*d
-
-	movl	SAVE_EBX, %ebx
-
-	C
-
-	C
-
-	C
-
-	subl	%eax, %esi
-
-	sbbl	%edx, %edi	   C n - (q1+1)*d
-	leal	(%ebp,%esi), %edx
-	movl	SAVE_EBP, %ebp
-
-	movl	%esi, %eax	   C remainder
-	movl	SAVE_ESI, %esi
-
-	cmovc(	%edx, %eax)	   C n - q1*d if underflow from using q1+1
-	movl	SAVE_EDI, %edi
-
-	shrl	%cl, %eax	   C denorm remainder
-	addl	$STACK_SPACE, %esp
-	emms
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-C
-C Special case for q1=0xFFFFFFFF, giving q=0xFFFFFFFF meaning the low dword
-C of q*d is simply -d and the remainder n-q*d = n10+d
-
-L(q1_ff):
-	C eax	(divisor)
-	C ebx	(q1+1 == 0)
-	C ecx	src pointer
-	C edx
-	C esi	n10
-	C edi	(n2)
-	C ebp	divisor
-
-	leal	(%ebp,%esi), %edi	C n-q*d remainder -> next n2
-	movl	VAR_SRC_STOP, %edx
-	psrlq	%mm7, %mm0
-
-	movd	%mm0, %esi		C next n10
-	cmpl	%ecx, %edx
-	jne	L(inverse_top)
-
-	jmp	L(inverse_loop_done)
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/p6/mmx/popham.asm b/ghc/rts/gmp/mpn/x86/p6/mmx/popham.asm
deleted file mode 100644
index 50f9a11218..0000000000
--- a/ghc/rts/gmp/mpn/x86/p6/mmx/popham.asm
+++ /dev/null
@@ -1,31 +0,0 @@
-dnl  Intel Pentium-II mpn_popcount, mpn_hamdist -- population count and
-dnl  hamming distance.
-dnl 
-dnl  P6MMX: popcount 11 cycles/limb (approx), hamdist 11.5 cycles/limb
-dnl  (approx)
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-MULFUNC_PROLOGUE(mpn_popcount mpn_hamdist)
-include_mpn(`x86/k6/mmx/popham.asm')
diff --git a/ghc/rts/gmp/mpn/x86/p6/p3mmx/popham.asm b/ghc/rts/gmp/mpn/x86/p6/p3mmx/popham.asm
deleted file mode 100644
index e63fbf334b..0000000000
--- a/ghc/rts/gmp/mpn/x86/p6/p3mmx/popham.asm
+++ /dev/null
@@ -1,30 +0,0 @@
-dnl  Intel Pentium-III mpn_popcount, mpn_hamdist -- population count and
-dnl  hamming distance.
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-dnl  Haven't actually measured it, but the K7 code with the psadbw should be
-dnl  good on P-III.
-
-include(`../config.m4')
-
-MULFUNC_PROLOGUE(mpn_popcount mpn_hamdist)
-include_mpn(`x86/k7/mmx/popham.asm')
diff --git a/ghc/rts/gmp/mpn/x86/p6/sqr_basecase.asm b/ghc/rts/gmp/mpn/x86/p6/sqr_basecase.asm
deleted file mode 100644
index 174c78406a..0000000000
--- a/ghc/rts/gmp/mpn/x86/p6/sqr_basecase.asm
+++ /dev/null
@@ -1,641 +0,0 @@
-dnl  Intel P6 mpn_sqr_basecase -- square an mpn number.
-dnl 
-dnl  P6: approx 4.0 cycles per cross product, or 7.75 cycles per triangular
-dnl  product (measured on the speed difference between 20 and 40 limbs,
-dnl  which is the Karatsuba recursing range).
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-dnl  These are the same as in mpn/x86/k6/sqr_basecase.asm, see that file for
-dnl  a description.  The only difference here is that UNROLL_COUNT can go up
-dnl  to 64 (not 63) making KARATSUBA_SQR_THRESHOLD_MAX 67.
-
-deflit(KARATSUBA_SQR_THRESHOLD_MAX, 67)
-
-ifdef(`KARATSUBA_SQR_THRESHOLD_OVERRIDE',
-`define(`KARATSUBA_SQR_THRESHOLD',KARATSUBA_SQR_THRESHOLD_OVERRIDE)')
-
-m4_config_gmp_mparam(`KARATSUBA_SQR_THRESHOLD')
-deflit(UNROLL_COUNT, eval(KARATSUBA_SQR_THRESHOLD-3))
-
-
-C void mpn_sqr_basecase (mp_ptr dst, mp_srcptr src, mp_size_t size);
-C
-C The algorithm is basically the same as mpn/generic/sqr_basecase.c, but a
-C lot of function call overheads are avoided, especially when the given size
-C is small.
-C
-C The code size might look a bit excessive, but not all of it is executed so
-C it won't all get into the code cache.  The 1x1, 2x2 and 3x3 special cases
-C clearly apply only to those sizes; mid sizes like 10x10 only need part of
-C the unrolled addmul; and big sizes like 40x40 that do use the full
-C unrolling will least be making good use of it, because 40x40 will take
-C something like 7000 cycles.
-
-defframe(PARAM_SIZE,12)
-defframe(PARAM_SRC, 8)
-defframe(PARAM_DST, 4)
-
-	.text
-	ALIGN(32)
-PROLOGUE(mpn_sqr_basecase)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %edx
-
-	movl	PARAM_SRC, %eax
-
-	cmpl	$2, %edx
-	movl	PARAM_DST, %ecx
-	je	L(two_limbs)
-
-	movl	(%eax), %eax
-	ja	L(three_or_more)
-
-
-C -----------------------------------------------------------------------------
-C one limb only
-	C eax	src limb
-	C ebx
-	C ecx	dst
-	C edx
-
-	mull	%eax
-
-	movl	%eax, (%ecx)
-	movl	%edx, 4(%ecx)
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-L(two_limbs):
-	C eax	src
-	C ebx
-	C ecx	dst
-	C edx
-
-defframe(SAVE_ESI, -4)
-defframe(SAVE_EBX, -8)
-defframe(SAVE_EDI, -12)
-defframe(SAVE_EBP, -16)
-deflit(`STACK_SPACE',16)
-
-	subl	$STACK_SPACE, %esp
-deflit(`FRAME',STACK_SPACE)
-
-	movl	%esi, SAVE_ESI
-	movl	%eax, %esi
-	movl	(%eax), %eax
-
-	mull	%eax		C src[0]^2
-
-	movl	%eax, (%ecx)	C dst[0]
-	movl	4(%esi), %eax
-
-	movl	%ebx, SAVE_EBX
-	movl	%edx, %ebx	C dst[1]
-
-	mull	%eax		C src[1]^2
-
-	movl	%edi, SAVE_EDI
-	movl	%eax, %edi	C dst[2]
-	movl	(%esi), %eax
-
-	movl	%ebp, SAVE_EBP
-	movl	%edx, %ebp	C dst[3]
-
-	mull	4(%esi)		C src[0]*src[1]
-
-	addl	%eax, %ebx
-	movl	SAVE_ESI, %esi
-
-	adcl	%edx, %edi
-
-	adcl	$0, %ebp
-	addl	%ebx, %eax
-	movl	SAVE_EBX, %ebx
-
-	adcl	%edi, %edx
-	movl	SAVE_EDI, %edi
-
-	adcl	$0, %ebp
-
-	movl	%eax, 4(%ecx)
-
-	movl	%ebp, 12(%ecx)
-	movl	SAVE_EBP, %ebp
-
-	movl	%edx, 8(%ecx)
-	addl	$FRAME, %esp
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-L(three_or_more):
-	C eax	src low limb
-	C ebx
-	C ecx	dst
-	C edx	size
-deflit(`FRAME',0)
-
-	pushl	%esi	defframe_pushl(`SAVE_ESI')
-	cmpl	$4, %edx
-
-	movl	PARAM_SRC, %esi
-	jae	L(four_or_more)
-
-
-C -----------------------------------------------------------------------------
-C three limbs
-
-	C eax	src low limb
-	C ebx
-	C ecx	dst
-	C edx
-	C esi	src
-	C edi
-	C ebp
-
-	pushl	%ebp	defframe_pushl(`SAVE_EBP')
-	pushl	%edi	defframe_pushl(`SAVE_EDI')
-
-	mull	%eax		C src[0] ^ 2
-
-	movl	%eax, (%ecx)
-	movl	%edx, 4(%ecx)
-
-	movl	4(%esi), %eax
-	xorl	%ebp, %ebp
-
-	mull	%eax		C src[1] ^ 2
-
-	movl	%eax, 8(%ecx)
-	movl	%edx, 12(%ecx)
-	movl	8(%esi), %eax
-
-	pushl	%ebx	defframe_pushl(`SAVE_EBX')
-
-	mull	%eax		C src[2] ^ 2
-
-	movl	%eax, 16(%ecx)
-	movl	%edx, 20(%ecx)
-
-	movl	(%esi), %eax
-
-	mull	4(%esi)		C src[0] * src[1]
-
-	movl	%eax, %ebx
-	movl	%edx, %edi
-
-	movl	(%esi), %eax
-
-	mull	8(%esi)		C src[0] * src[2]
-
-	addl	%eax, %edi
-	movl	%edx, %ebp
-
-	adcl	$0, %ebp
-	movl	4(%esi), %eax
-
-	mull	8(%esi)		C src[1] * src[2]
-
-	xorl	%esi, %esi
-	addl	%eax, %ebp
-
-	C eax
-	C ebx	dst[1]
-	C ecx	dst
-	C edx	dst[4]
-	C esi	zero, will be dst[5]
-	C edi	dst[2]
-	C ebp	dst[3]
-
-	adcl	$0, %edx
-	addl	%ebx, %ebx
-
-	adcl	%edi, %edi
-
-	adcl	%ebp, %ebp
-
-	adcl	%edx, %edx
-	movl	4(%ecx), %eax
-
-	adcl	$0, %esi
-	addl	%ebx, %eax
-
-	movl	%eax, 4(%ecx)
-	movl	8(%ecx), %eax
-
-	adcl	%edi, %eax
-	movl	12(%ecx), %ebx
-
-	adcl	%ebp, %ebx
-	movl	16(%ecx), %edi
-
-	movl	%eax, 8(%ecx)
-	movl	SAVE_EBP, %ebp
-
-	movl	%ebx, 12(%ecx)
-	movl	SAVE_EBX, %ebx
-
-	adcl	%edx, %edi
-	movl	20(%ecx), %eax
-
-	movl	%edi, 16(%ecx)
-	movl	SAVE_EDI, %edi
-
-	adcl	%esi, %eax	C no carry out of this
-	movl	SAVE_ESI, %esi
-
-	movl	%eax, 20(%ecx)
-	addl	$FRAME, %esp
-
-	ret
-
-
-
-C -----------------------------------------------------------------------------
-defframe(VAR_COUNTER,-20)
-defframe(VAR_JMP,    -24)
-deflit(`STACK_SPACE',24)
-
-L(four_or_more):
-	C eax	src low limb
-	C ebx
-	C ecx
-	C edx	size
-	C esi	src
-	C edi
-	C ebp
-deflit(`FRAME',4)  dnl  %esi already pushed
-
-C First multiply src[0]*src[1..size-1] and store at dst[1..size].
- 
-	subl	$STACK_SPACE-FRAME, %esp
-deflit(`FRAME',STACK_SPACE)
-	movl	$1, %ecx
-
-	movl	%edi, SAVE_EDI
-	movl	PARAM_DST, %edi
-
-	movl	%ebx, SAVE_EBX
-	subl	%edx, %ecx		C -(size-1)
-
-	movl	%ebp, SAVE_EBP
-	movl	$0, %ebx		C initial carry
-
-	leal	(%esi,%edx,4), %esi	C &src[size]
-	movl	%eax, %ebp		C multiplier
-
-	leal	-4(%edi,%edx,4), %edi	C &dst[size-1]
-
-
-C This loop runs at just over 6 c/l.
-
-L(mul_1):
-	C eax	scratch
-	C ebx	carry
-	C ecx	counter, limbs, negative, -(size-1) to -1
-	C edx	scratch
-	C esi	&src[size]
-	C edi	&dst[size-1]
-	C ebp	multiplier
-
-	movl	%ebp, %eax
-
-	mull	(%esi,%ecx,4)
-
-	addl	%ebx, %eax
-	movl	$0, %ebx
-
-	adcl	%edx, %ebx
-	movl	%eax, 4(%edi,%ecx,4)
-
-	incl	%ecx
-	jnz	L(mul_1)
-
-
-	movl	%ebx, 4(%edi)
-
-
-C Addmul src[n]*src[n+1..size-1] at dst[2*n-1...], for each n=1..size-2.
-C
-C The last two addmuls, which are the bottom right corner of the product
-C triangle, are left to the end.  These are src[size-3]*src[size-2,size-1]
-C and src[size-2]*src[size-1].  If size is 4 then it's only these corner
-C cases that need to be done.
-C
-C The unrolled code is the same as mpn_addmul_1(), see that routine for some
-C comments.
-C
-C VAR_COUNTER is the outer loop, running from -(size-4) to -1, inclusive.
-C
-C VAR_JMP is the computed jump into the unrolled code, stepped by one code
-C chunk each outer loop.
-
-dnl  This is also hard-coded in the address calculation below.
-deflit(CODE_BYTES_PER_LIMB, 15)
-
-dnl  With &src[size] and &dst[size-1] pointers, the displacements in the
-dnl  unrolled code fit in a byte for UNROLL_COUNT values up to 32, but above
-dnl  that an offset must be added to them.
-deflit(OFFSET,
-ifelse(eval(UNROLL_COUNT>32),1,
-eval((UNROLL_COUNT-32)*4),
-0))
-
-	C eax
-	C ebx	carry
-	C ecx
-	C edx
-	C esi	&src[size]
-	C edi	&dst[size-1]
-	C ebp
-
-	movl	PARAM_SIZE, %ecx
-
-	subl	$4, %ecx
-	jz	L(corner)
-
-	movl	%ecx, %edx
-	negl	%ecx
-
-	shll	$4, %ecx
-ifelse(OFFSET,0,,`subl	$OFFSET, %esi')
-
-ifdef(`PIC',`
-	call	L(pic_calc)
-L(here):
-',`
-	leal	L(unroll_inner_end)-eval(2*CODE_BYTES_PER_LIMB)(%ecx,%edx), %ecx
-')
-	negl	%edx
-
-ifelse(OFFSET,0,,`subl	$OFFSET, %edi')
-
-	C The calculated jump mustn't be before the start of the available
-	C code.  This is the limit that UNROLL_COUNT puts on the src operand
-	C size, but checked here using the jump address directly.
-
-	ASSERT(ae,
-	`movl_text_address( L(unroll_inner_start), %eax)
-	cmpl	%eax, %ecx')
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)
-L(unroll_outer_top):
-	C eax
-	C ebx	high limb to store
-	C ecx	VAR_JMP
-	C edx	VAR_COUNTER, limbs, negative
-	C esi	&src[size], constant
-	C edi	dst ptr, second highest limb of last addmul
-	C ebp
-
-	movl	-12+OFFSET(%esi,%edx,4), %ebp	C multiplier
-	movl	%edx, VAR_COUNTER
-
-	movl	-8+OFFSET(%esi,%edx,4), %eax	C first limb of multiplicand
-
-	mull	%ebp
-
-define(cmovX,`ifelse(eval(UNROLL_COUNT%2),1,`cmovz($@)',`cmovnz($@)')')
-
-	testb	$1, %cl
-
-	movl	%edx, %ebx	C high carry
-	leal	4(%edi), %edi
-
-	movl	%ecx, %edx	C jump
-
-	movl	%eax, %ecx	C low carry
-	leal	CODE_BYTES_PER_LIMB(%edx), %edx
-
-	cmovX(	%ebx, %ecx)	C high carry reverse
-	cmovX(	%eax, %ebx)	C low carry reverse
-	movl	%edx, VAR_JMP
-	jmp	*%edx
-
-
-	C Must be on an even address here so the low bit of the jump address
-	C will indicate which way around ecx/ebx should start.
-
-	ALIGN(2)
-
-L(unroll_inner_start):
-	C eax	scratch
-	C ebx	carry high
-	C ecx	carry low
-	C edx	scratch
-	C esi	src pointer
-	C edi	dst pointer
-	C ebp	multiplier
-	C
-	C 15 code bytes each limb
-	C ecx/ebx reversed on each chunk
-
-forloop(`i', UNROLL_COUNT, 1, `
-	deflit(`disp_src', eval(-i*4 + OFFSET))
-	deflit(`disp_dst', eval(disp_src))
-
-	m4_assert(`disp_src>=-128 && disp_src<128')
-	m4_assert(`disp_dst>=-128 && disp_dst<128')
-
-ifelse(eval(i%2),0,`
-Zdisp(	movl,	disp_src,(%esi), %eax)
-	mull	%ebp
-Zdisp(	addl,	%ebx, disp_dst,(%edi))
-	adcl	%eax, %ecx
-	movl	%edx, %ebx
-	adcl	$0, %ebx
-',`
-	dnl  this one comes out last
-Zdisp(	movl,	disp_src,(%esi), %eax)
-	mull	%ebp
-Zdisp(	addl,	%ecx, disp_dst,(%edi))
-	adcl	%eax, %ebx
-	movl	%edx, %ecx
-	adcl	$0, %ecx
-')
-')
-L(unroll_inner_end):
-
-	addl	%ebx, m4_empty_if_zero(OFFSET)(%edi)
-
-	movl	VAR_COUNTER, %edx
-	adcl	$0, %ecx
-
-	movl	%ecx, m4_empty_if_zero(OFFSET+4)(%edi)
-	movl	VAR_JMP, %ecx
-
-	incl	%edx
-	jnz	L(unroll_outer_top)
-	
-
-ifelse(OFFSET,0,,`
-	addl	$OFFSET, %esi
-	addl	$OFFSET, %edi
-')
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(16)
-L(corner):
-	C eax
-	C ebx
-	C ecx
-	C edx
-	C esi	&src[size]
-	C edi	&dst[2*size-5]
-	C ebp
-
-	movl	-12(%esi), %eax
-
-	mull	-8(%esi)
-
-	addl	%eax, (%edi)
-	movl	-12(%esi), %eax
-	movl	$0, %ebx
-
-	adcl	%edx, %ebx
-
-	mull	-4(%esi)
-
-	addl	%eax, %ebx
-	movl	-8(%esi), %eax
-
-	adcl	$0, %edx
-
-	addl	%ebx, 4(%edi)
-	movl	$0, %ebx
-
-	adcl	%edx, %ebx
-
-	mull	-4(%esi)
-
-	movl	PARAM_SIZE, %ecx
-	addl	%ebx, %eax
-
-	adcl	$0, %edx
-
-	movl	%eax, 8(%edi)
-
-	movl	%edx, 12(%edi)
-	movl	PARAM_DST, %edi
-
-
-C Left shift of dst[1..2*size-2], the bit shifted out becomes dst[2*size-1].
-
-	subl	$1, %ecx		C size-1
-	xorl	%eax, %eax		C ready for final adcl, and clear carry
-
-	movl	%ecx, %edx
-	movl	PARAM_SRC, %esi
-
-
-L(lshift):
-	C eax
-	C ebx
-	C ecx	counter, size-1 to 1
-	C edx	size-1 (for later use)
-	C esi	src (for later use)
-	C edi	dst, incrementing
-	C ebp
-
-	rcll	4(%edi)
-	rcll	8(%edi)
-
-	leal	8(%edi), %edi
-	decl	%ecx
-	jnz	L(lshift)
-
-
-	adcl	%eax, %eax
-
-	movl	%eax, 4(%edi)		C dst most significant limb
-	movl	(%esi), %eax		C src[0]
-
-	leal	4(%esi,%edx,4), %esi	C &src[size]
-	subl	%edx, %ecx		C -(size-1)
-
-
-C Now add in the squares on the diagonal, src[0]^2, src[1]^2, ...,
-C src[size-1]^2.  dst[0] hasn't yet been set at all yet, and just gets the
-C low limb of src[0]^2.
-
-
-	mull	%eax
-
-	movl	%eax, (%edi,%ecx,8)	C dst[0]
-
-
-L(diag):
-	C eax	scratch
-	C ebx	scratch
-	C ecx	counter, negative
-	C edx	carry
-	C esi	&src[size]
-	C edi	dst[2*size-2]
-	C ebp
-
-	movl	(%esi,%ecx,4), %eax
-	movl	%edx, %ebx
-
-	mull	%eax
-
-	addl	%ebx, 4(%edi,%ecx,8)
-	adcl	%eax, 8(%edi,%ecx,8)
-	adcl	$0, %edx
-
-	incl	%ecx
-	jnz	L(diag)
-
-
-	movl	SAVE_ESI, %esi
-	movl	SAVE_EBX, %ebx
-
-	addl	%edx, 4(%edi)		C dst most significant limb
-
-	movl	SAVE_EDI, %edi
-	movl	SAVE_EBP, %ebp
-	addl	$FRAME, %esp
-	ret
-
-
-
-C -----------------------------------------------------------------------------
-ifdef(`PIC',`
-L(pic_calc):
-	addl	(%esp), %ecx
-	addl	$L(unroll_inner_end)-L(here)-eval(2*CODE_BYTES_PER_LIMB), %ecx
-	addl	%edx, %ecx
-	ret
-')
-
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/pentium/README b/ghc/rts/gmp/mpn/x86/pentium/README
deleted file mode 100644
index 3b9ec8ac6f..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/README
+++ /dev/null
@@ -1,77 +0,0 @@
-
-                   INTEL PENTIUM P5 MPN SUBROUTINES
-
-
-This directory contains mpn functions optimized for Intel Pentium (P5,P54)
-processors.  The mmx subdirectory has code for Pentium with MMX (P55).
-
-
-STATUS
-
-                                cycles/limb
-
-	mpn_add_n/sub_n            2.375
-
-	mpn_copyi/copyd            1.0
-
-	mpn_divrem_1              44.0
-	mpn_mod_1                 44.0
-	mpn_divexact_by3          15.0
-
-	mpn_l/rshift               5.375 normal (6.0 on P54)
-				   1.875 special shift by 1 bit
-
-	mpn_mul_1                 13.0
-	mpn_add/submul_1          14.0
-
-	mpn_mul_basecase          14.2 cycles/crossproduct (approx)
-
-	mpn_sqr_basecase           8 cycles/crossproduct (approx)
-                                   or 15.5 cycles/triangleproduct (approx)
-
-Pentium MMX gets the following improvements
-
-	mpn_l/rshift               1.75
-
-
-1. mpn_lshift and mpn_rshift run at about 6 cycles/limb on P5 and P54, but the
-documentation indicates that they should take only 43/8 = 5.375 cycles/limb,
-or 5 cycles/limb asymptotically.  The P55 runs them at the expected speed.
-
-2. mpn_add_n and mpn_sub_n run at asymptotically 2 cycles/limb.  Due to loop
-overhead and other delays (cache refill?), they run at or near 2.5 cycles/limb.
-
-3. mpn_mul_1, mpn_addmul_1, mpn_submul_1 all run 1 cycle faster than they
-should.  Intel documentation says a mul instruction is 10 cycles, but it
-measures 9 and the routines using it run with it as 9.
-
-
-
-RELEVANT OPTIMIZATION ISSUES
-
-1. Pentium doesn't allocate cache lines on writes, unlike most other modern
-processors.  Since the functions in the mpn class do array writes, we have to
-handle allocating the destination cache lines by reading a word from it in the
-loops, to achieve the best performance.
-
-2. Pairing of memory operations requires that the two issued operations refer
-to different cache banks.  The simplest way to insure this is to read/write
-two words from the same object.  If we make operations on different objects,
-they might or might not be to the same cache bank.
-
-
-
-REFERENCES
-
-"Intel Architecture Optimization Manual", 1997, order number 242816.  This
-is mostly about P5, the parts about P6 aren't relevant.  Available on-line:
-
-        http://download.intel.com/design/PentiumII/manuals/242816.htm
-
-
-
-----------------
-Local variables:
-mode: text
-fill-column: 76
-End:
diff --git a/ghc/rts/gmp/mpn/x86/pentium/aors_n.asm b/ghc/rts/gmp/mpn/x86/pentium/aors_n.asm
deleted file mode 100644
index a61082a456..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/aors_n.asm
+++ /dev/null
@@ -1,196 +0,0 @@
-dnl  Intel Pentium mpn_add_n/mpn_sub_n -- mpn addition and subtraction.
-dnl
-dnl  P5: 2.375 cycles/limb
-
-
-dnl  Copyright (C) 1992, 1994, 1995, 1996, 1999, 2000 Free Software
-dnl  Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-ifdef(`OPERATION_add_n',`
-	define(M4_inst,        adcl)
-	define(M4_function_n,  mpn_add_n)
-	define(M4_function_nc, mpn_add_nc)
-
-',`ifdef(`OPERATION_sub_n',`
-	define(M4_inst,        sbbl)
-	define(M4_function_n,  mpn_sub_n)
-	define(M4_function_nc, mpn_sub_nc)
-
-',`m4_error(`Need OPERATION_add_n or OPERATION_sub_n
-')')')
-
-MULFUNC_PROLOGUE(mpn_add_n mpn_add_nc mpn_sub_n mpn_sub_nc)
-
-
-C mp_limb_t M4_function_n (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
-C                          mp_size_t size);
-C mp_limb_t M4_function_nc (mp_ptr dst, mp_srcptr src1, mp_srcptr src2,
-C                           mp_size_t size, mp_limb_t carry);
-
-defframe(PARAM_CARRY,20)
-defframe(PARAM_SIZE, 16)
-defframe(PARAM_SRC2, 12)
-defframe(PARAM_SRC1, 8)
-defframe(PARAM_DST,  4)
-
-	.text
-	ALIGN(8)
-PROLOGUE(M4_function_nc)
-
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-	pushl	%ebp
-deflit(`FRAME',16)
-
-	movl	PARAM_DST,%edi
-	movl	PARAM_SRC1,%esi
-	movl	PARAM_SRC2,%ebp
-	movl	PARAM_SIZE,%ecx
-
-	movl	(%ebp),%ebx
-
-	decl	%ecx
-	movl	%ecx,%edx
-	shrl	$3,%ecx
-	andl	$7,%edx
-	testl	%ecx,%ecx		C zero carry flag
-	jz	L(endgo)
-
-	pushl	%edx
-FRAME_pushl()
-	movl	PARAM_CARRY,%eax
-	shrl	$1,%eax			C shift bit 0 into carry
-	jmp	LF(M4_function_n,oop)
-
-L(endgo):
-deflit(`FRAME',16)
-	movl	PARAM_CARRY,%eax
-	shrl	$1,%eax			C shift bit 0 into carry
-	jmp	LF(M4_function_n,end)
-
-EPILOGUE()
-
-
-	ALIGN(8)
-PROLOGUE(M4_function_n)
-
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-	pushl	%ebp
-deflit(`FRAME',16)
-
-	movl	PARAM_DST,%edi
-	movl	PARAM_SRC1,%esi
-	movl	PARAM_SRC2,%ebp
-	movl	PARAM_SIZE,%ecx
-
-	movl	(%ebp),%ebx
-
-	decl	%ecx
-	movl	%ecx,%edx
-	shrl	$3,%ecx
-	andl	$7,%edx
-	testl	%ecx,%ecx		C zero carry flag
-	jz	L(end)
-	pushl	%edx
-FRAME_pushl()
-
-	ALIGN(8)
-L(oop):	movl	28(%edi),%eax		C fetch destination cache line
-	leal	32(%edi),%edi
-
-L(1):	movl	(%esi),%eax
-	movl	4(%esi),%edx
-	M4_inst	%ebx,%eax
-	movl	4(%ebp),%ebx
-	M4_inst	%ebx,%edx
-	movl	8(%ebp),%ebx
-	movl	%eax,-32(%edi)
-	movl	%edx,-28(%edi)
-
-L(2):	movl	8(%esi),%eax
-	movl	12(%esi),%edx
-	M4_inst	%ebx,%eax
-	movl	12(%ebp),%ebx
-	M4_inst	%ebx,%edx
-	movl	16(%ebp),%ebx
-	movl	%eax,-24(%edi)
-	movl	%edx,-20(%edi)
-
-L(3):	movl	16(%esi),%eax
-	movl	20(%esi),%edx
-	M4_inst	%ebx,%eax
-	movl	20(%ebp),%ebx
-	M4_inst	%ebx,%edx
-	movl	24(%ebp),%ebx
-	movl	%eax,-16(%edi)
-	movl	%edx,-12(%edi)
-
-L(4):	movl	24(%esi),%eax
-	movl	28(%esi),%edx
-	M4_inst	%ebx,%eax
-	movl	28(%ebp),%ebx
-	M4_inst	%ebx,%edx
-	movl	32(%ebp),%ebx
-	movl	%eax,-8(%edi)
-	movl	%edx,-4(%edi)
-
-	leal	32(%esi),%esi
-	leal	32(%ebp),%ebp
-	decl	%ecx
-	jnz	L(oop)
-
-	popl	%edx
-FRAME_popl()
-L(end):
-	decl	%edx			C test %edx w/o clobbering carry
-	js	L(end2)
-	incl	%edx
-L(oop2):
-	leal	4(%edi),%edi
-	movl	(%esi),%eax
-	M4_inst	%ebx,%eax
-	movl	4(%ebp),%ebx
-	movl	%eax,-4(%edi)
-	leal	4(%esi),%esi
-	leal	4(%ebp),%ebp
-	decl	%edx
-	jnz	L(oop2)
-L(end2):
-	movl	(%esi),%eax
-	M4_inst	%ebx,%eax
-	movl	%eax,(%edi)
-
-	sbbl	%eax,%eax
-	negl	%eax
-
-	popl	%ebp
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/pentium/aorsmul_1.asm b/ghc/rts/gmp/mpn/x86/pentium/aorsmul_1.asm
deleted file mode 100644
index 147b55610f..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/aorsmul_1.asm
+++ /dev/null
@@ -1,99 +0,0 @@
-dnl  Intel Pentium mpn_addmul_1 -- mpn by limb multiplication.
-dnl 
-dnl  P5: 14.0 cycles/limb
-
-
-dnl  Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation,
-dnl  Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA. */
-
-
-include(`../config.m4')
-
-
-ifdef(`OPERATION_addmul_1', `
-      define(M4_inst,        addl)
-      define(M4_function_1,  mpn_addmul_1)
-
-',`ifdef(`OPERATION_submul_1', `
-      define(M4_inst,        subl)
-      define(M4_function_1,  mpn_submul_1)
-
-',`m4_error(`Need OPERATION_addmul_1 or OPERATION_submul_1
-')')')
-
-MULFUNC_PROLOGUE(mpn_addmul_1 mpn_submul_1)
-
-
-C mp_limb_t M4_function_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                          mp_limb_t mult);
-
-defframe(PARAM_MULTIPLIER,16)
-defframe(PARAM_SIZE,      12)
-defframe(PARAM_SRC,       8)
-defframe(PARAM_DST,       4)
-
-	.text
-	ALIGN(8)
-
-PROLOGUE(M4_function_1)
-
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-	pushl	%ebp
-deflit(`FRAME',16)
-
-	movl	PARAM_DST, %edi
-	movl	PARAM_SRC, %esi
-	movl	PARAM_SIZE, %ecx
-	movl	PARAM_MULTIPLIER, %ebp
-
-	leal	(%edi,%ecx,4), %edi
-	leal	(%esi,%ecx,4), %esi
-	negl	%ecx
-	xorl	%ebx, %ebx
-	ALIGN(8)
-
-L(oop):	adcl	$0, %ebx
-	movl	(%esi,%ecx,4), %eax
-
-	mull	%ebp
-
-	addl	%ebx, %eax
-	movl	(%edi,%ecx,4), %ebx
-
-	adcl	$0, %edx
-	M4_inst	%eax, %ebx
-
-	movl	%ebx, (%edi,%ecx,4)
-	incl	%ecx
-
-	movl	%edx, %ebx
-	jnz	L(oop)
-
-	adcl	$0, %ebx
-	movl	%ebx, %eax
-	popl	%ebp
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/pentium/diveby3.asm b/ghc/rts/gmp/mpn/x86/pentium/diveby3.asm
deleted file mode 100644
index dbac81642f..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/diveby3.asm
+++ /dev/null
@@ -1,183 +0,0 @@
-dnl  Intel P5 mpn_divexact_by3 -- mpn division by 3, expecting no remainder.
-dnl       
-dnl  P5: 15.0 cycles/limb
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_divexact_by3c (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                              mp_limb_t carry);
-
-defframe(PARAM_CARRY,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,   8)
-defframe(PARAM_DST,   4)
-
-dnl  multiplicative inverse of 3, modulo 2^32
-deflit(INVERSE_3,        0xAAAAAAAB)
-
-dnl  ceil(b/3), ceil(b*2/3) and floor(b*2/3) where b=2^32
-deflit(ONE_THIRD_CEIL,   0x55555556)
-deflit(TWO_THIRDS_CEIL,  0xAAAAAAAB)
-deflit(TWO_THIRDS_FLOOR, 0xAAAAAAAA)
-
-	.text
-	ALIGN(8)
-
-PROLOGUE(mpn_divexact_by3c)
-deflit(`FRAME',0)
-
-	movl	PARAM_SRC, %ecx
-	movl	PARAM_SIZE, %edx
-
-	decl	%edx
-	jnz	L(two_or_more)
-
-	movl	(%ecx), %edx
-	movl	PARAM_CARRY, %eax	C risk of cache bank clash here
-
-	movl	PARAM_DST, %ecx
-	subl	%eax, %edx
-
-	sbbl	%eax, %eax		C 0 or -1
-
-	imull	$INVERSE_3, %edx, %edx
-
-	negl	%eax			C 0 or 1
-	cmpl	$ONE_THIRD_CEIL, %edx
-
-	sbbl	$-1, %eax		C +1 if edx>=ceil(b/3)
-	cmpl	$TWO_THIRDS_CEIL, %edx
-
-	sbbl	$-1, %eax		C +1 if edx>=ceil(b*2/3)
-	movl	%edx, (%ecx)
-
-	ret
-
-
-L(two_or_more):
-	C eax
-	C ebx
-	C ecx	src
-	C edx	size-1
-	C esi
-	C edi
-	C ebp
-
-	pushl	%ebx	FRAME_pushl()
-	pushl	%esi	FRAME_pushl()
-
-	pushl	%edi	FRAME_pushl()
-	pushl	%ebp	FRAME_pushl()
-
-	movl	PARAM_DST, %edi
-	movl	PARAM_CARRY, %esi
-
-	movl	(%ecx), %eax		C src low limb
-	xorl	%ebx, %ebx
-
-	sub	%esi, %eax
-	movl	$TWO_THIRDS_FLOOR, %esi
-
-	leal	(%ecx,%edx,4), %ecx	C &src[size-1]
-	leal	(%edi,%edx,4), %edi	C &dst[size-1]
-
-	adcl	$0, %ebx		C carry, 0 or 1
-	negl	%edx			C -(size-1)
-
-
-C The loop needs a source limb ready at the top, which leads to one limb
-C handled separately at the end, and the special case above for size==1.
-C There doesn't seem to be any scheduling that would keep the speed but move
-C the source load and carry subtract up to the top.
-C
-C The destination cache line prefetching adds 1 cycle to the loop but is
-C considered worthwhile.  The slowdown is a factor of 1.07, but will prevent
-C repeated write-throughs if the destination isn't in L1.  A version using
-C an outer loop to prefetch only every 8 limbs (a cache line) proved to be
-C no faster, due to unavoidable branch mispreditions in the inner loop.
-C
-C setc is 2 cycles on P54, so an adcl is used instead.  If the movl $0,%ebx
-C could be avoided then the src limb fetch could pair up and save a cycle.
-C This would probably mean going to a two limb loop with the carry limb
-C alternately positive or negative, since an sbbl %ebx,%ebx will leave a
-C value which is in the opposite sense to the preceding sbbl/adcl %ebx,%eax.
-C
-C A register is used for TWO_THIRDS_FLOOR because a cmp can't be done as
-C "cmpl %edx, $n" with the immediate as the second operand.
-C
-C The "4" source displacement is in the loop rather than the setup because
-C this gets L(top) aligned to 8 bytes at no cost.
-
-	ALIGN(8)
-L(top):
-	C eax	source limb, carry subtracted
-	C ebx	carry (0 or 1)
-	C ecx	&src[size-1]
-	C edx	counter, limbs, negative
-	C esi	TWO_THIRDS_FLOOR
-	C edi	&dst[size-1]
-	C ebp	scratch (result limb)
-
-	imull	$INVERSE_3, %eax, %ebp
-
-	cmpl	$ONE_THIRD_CEIL, %ebp
-	movl	(%edi,%edx,4), %eax	C dst cache line prefetch
-
-	sbbl	$-1, %ebx		C +1 if ebp>=ceil(b/3)
-	cmpl	%ebp, %esi
-
-	movl	4(%ecx,%edx,4), %eax	C next src limb
-
-	sbbl	%ebx, %eax		C and further -1 if ebp>=ceil(b*2/3)
-	movl	$0, %ebx
-
-	adcl	$0, %ebx		C new carry
-	movl	%ebp, (%edi,%edx,4)
-
-	incl	%edx
-	jnz	L(top)
-
-
-
-	imull	$INVERSE_3, %eax, %edx
-
-	cmpl	$ONE_THIRD_CEIL, %edx
-	movl	%edx, (%edi)
-
-	sbbl	$-1, %ebx	C +1 if edx>=ceil(b/3)
-	cmpl	$TWO_THIRDS_CEIL, %edx
-
-	sbbl	$-1, %ebx	C +1 if edx>=ceil(b*2/3)
-	popl	%ebp
-
-	movl	%ebx, %eax
-	popl	%edi
-
-	popl	%esi
-	popl	%ebx
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/pentium/gmp-mparam.h b/ghc/rts/gmp/mpn/x86/pentium/gmp-mparam.h
deleted file mode 100644
index d3ed3d73ce..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/gmp-mparam.h
+++ /dev/null
@@ -1,97 +0,0 @@
-/* Intel P54 gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-
-#define BITS_PER_MP_LIMB 32
-#define BYTES_PER_MP_LIMB 4
-#define BITS_PER_LONGINT 32
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-
-#ifndef UMUL_TIME
-#define UMUL_TIME   9 /* cycles */
-#endif
-#ifndef UDIV_TIME
-#define UDIV_TIME   41 /* cycles */
-#endif
-
-/* bsf takes 18-42 cycles, put an average for uniform random numbers */
-#ifndef COUNT_TRAILING_ZEROS_TIME
-#define COUNT_TRAILING_ZEROS_TIME   20  /* cycles */
-#endif
-
-
-/* Generated by tuneup.c, 2000-07-06. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD   14
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD      179
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD   22
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD      153
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD              46
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD            110
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            13
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD        4
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD          25
-#endif
-
-#ifndef FFT_MUL_TABLE
-#define FFT_MUL_TABLE  { 496, 928, 1920, 4608, 14336, 40960, 0 }
-#endif
-#ifndef FFT_MODF_MUL_THRESHOLD
-#define FFT_MODF_MUL_THRESHOLD     512
-#endif
-#ifndef FFT_MUL_THRESHOLD
-#define FFT_MUL_THRESHOLD         3840
-#endif
-
-#ifndef FFT_SQR_TABLE
-#define FFT_SQR_TABLE  { 496, 1184, 1920, 5632, 14336, 40960, 0 }
-#endif
-#ifndef FFT_MODF_SQR_THRESHOLD
-#define FFT_MODF_SQR_THRESHOLD     512
-#endif
-#ifndef FFT_SQR_THRESHOLD
-#define FFT_SQR_THRESHOLD         3840
-#endif
diff --git a/ghc/rts/gmp/mpn/x86/pentium/lshift.asm b/ghc/rts/gmp/mpn/x86/pentium/lshift.asm
deleted file mode 100644
index e1e35d4c57..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/lshift.asm
+++ /dev/null
@@ -1,236 +0,0 @@
-dnl  Intel Pentium mpn_lshift -- mpn left shift.
-dnl
-dnl          cycles/limb
-dnl  P5,P54:    6.0
-dnl  P55:       5.375
-
-
-dnl  Copyright (C) 1992, 1994, 1995, 1996, 1999, 2000 Free Software
-dnl  Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_lshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       unsigned shift);
-C
-C The main shift-by-N loop should run at 5.375 c/l and that's what P55 does,
-C but P5 and P54 run only at 6.0 c/l, which is 4 cycles lost somewhere.
-
-defframe(PARAM_SHIFT,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,  8)
-defframe(PARAM_DST,  4)
-
-	.text
-	ALIGN(8)
-PROLOGUE(mpn_lshift)
-
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-	pushl	%ebp
-deflit(`FRAME',16)
-
-	movl	PARAM_DST,%edi
-	movl	PARAM_SRC,%esi
-	movl	PARAM_SIZE,%ebp
-	movl	PARAM_SHIFT,%ecx
-
-C We can use faster code for shift-by-1 under certain conditions. 
-	cmp	$1,%ecx
-	jne	L(normal)
-	leal	4(%esi),%eax
-	cmpl	%edi,%eax
-	jnc	L(special)		C jump if s_ptr + 1 >= res_ptr
-	leal	(%esi,%ebp,4),%eax
-	cmpl	%eax,%edi
-	jnc	L(special)		C jump if res_ptr >= s_ptr + size
-
-L(normal):
-	leal	-4(%edi,%ebp,4),%edi
-	leal	-4(%esi,%ebp,4),%esi
-
-	movl	(%esi),%edx
-	subl	$4,%esi
-	xorl	%eax,%eax
-	shldl(	%cl, %edx, %eax)	C compute carry limb
-	pushl	%eax			C push carry limb onto stack
-
-	decl	%ebp
-	pushl	%ebp
-	shrl	$3,%ebp
-	jz	L(end)
-
-	movl	(%edi),%eax		C fetch destination cache line
-
-	ALIGN(4)
-L(oop):	movl	-28(%edi),%eax		C fetch destination cache line
-	movl	%edx,%ebx
-
-	movl	(%esi),%eax
-	movl	-4(%esi),%edx
-	shldl(	%cl, %eax, %ebx)
-	shldl(	%cl, %edx, %eax)
-	movl	%ebx,(%edi)
-	movl	%eax,-4(%edi)
-
-	movl	-8(%esi),%ebx
-	movl	-12(%esi),%eax
-	shldl(	%cl, %ebx, %edx)
-	shldl(	%cl, %eax, %ebx)
-	movl	%edx,-8(%edi)
-	movl	%ebx,-12(%edi)
-
-	movl	-16(%esi),%edx
-	movl	-20(%esi),%ebx
-	shldl(	%cl, %edx, %eax)
-	shldl(	%cl, %ebx, %edx)
-	movl	%eax,-16(%edi)
-	movl	%edx,-20(%edi)
-
-	movl	-24(%esi),%eax
-	movl	-28(%esi),%edx
-	shldl(	%cl, %eax, %ebx)
-	shldl(	%cl, %edx, %eax)
-	movl	%ebx,-24(%edi)
-	movl	%eax,-28(%edi)
-
-	subl	$32,%esi
-	subl	$32,%edi
-	decl	%ebp
-	jnz	L(oop)
-
-L(end):	popl	%ebp
-	andl	$7,%ebp
-	jz	L(end2)
-L(oop2):
-	movl	(%esi),%eax
-	shldl(	%cl,%eax,%edx)
-	movl	%edx,(%edi)
-	movl	%eax,%edx
-	subl	$4,%esi
-	subl	$4,%edi
-	decl	%ebp
-	jnz	L(oop2)
-
-L(end2):
-	shll	%cl,%edx		C compute least significant limb
-	movl	%edx,(%edi)		C store it
-
-	popl	%eax			C pop carry limb
-
-	popl	%ebp
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-
-C We loop from least significant end of the arrays, which is only
-C permissable if the source and destination don't overlap, since the
-C function is documented to work for overlapping source and destination.
-
-L(special):
-	movl	(%esi),%edx
-	addl	$4,%esi
-
-	decl	%ebp
-	pushl	%ebp
-	shrl	$3,%ebp
-
-	addl	%edx,%edx
-	incl	%ebp
-	decl	%ebp
-	jz	L(Lend)
-
-	movl	(%edi),%eax		C fetch destination cache line
-
-	ALIGN(4)
-L(Loop):
-	movl	28(%edi),%eax		C fetch destination cache line
-	movl	%edx,%ebx
-
-	movl	(%esi),%eax
-	movl	4(%esi),%edx
-	adcl	%eax,%eax
-	movl	%ebx,(%edi)
-	adcl	%edx,%edx
-	movl	%eax,4(%edi)
-
-	movl	8(%esi),%ebx
-	movl	12(%esi),%eax
-	adcl	%ebx,%ebx
-	movl	%edx,8(%edi)
-	adcl	%eax,%eax
-	movl	%ebx,12(%edi)
-
-	movl	16(%esi),%edx
-	movl	20(%esi),%ebx
-	adcl	%edx,%edx
-	movl	%eax,16(%edi)
-	adcl	%ebx,%ebx
-	movl	%edx,20(%edi)
-
-	movl	24(%esi),%eax
-	movl	28(%esi),%edx
-	adcl	%eax,%eax
-	movl	%ebx,24(%edi)
-	adcl	%edx,%edx
-	movl	%eax,28(%edi)
-
-	leal	32(%esi),%esi		C use leal not to clobber carry
-	leal	32(%edi),%edi
-	decl	%ebp
-	jnz	L(Loop)
-
-L(Lend):
-	popl	%ebp
-	sbbl	%eax,%eax		C save carry in %eax
-	andl	$7,%ebp
-	jz	L(Lend2)
-	addl	%eax,%eax		C restore carry from eax
-L(Loop2):
-	movl	%edx,%ebx
-	movl	(%esi),%edx
-	adcl	%edx,%edx
-	movl	%ebx,(%edi)
-
-	leal	4(%esi),%esi		C use leal not to clobber carry
-	leal	4(%edi),%edi
-	decl	%ebp
-	jnz	L(Loop2)
-
-	jmp	L(L1)
-L(Lend2):
-	addl	%eax,%eax		C restore carry from eax
-L(L1):	movl	%edx,(%edi)		C store last limb
-
-	sbbl	%eax,%eax
-	negl	%eax
-
-	popl	%ebp
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/pentium/mmx/gmp-mparam.h b/ghc/rts/gmp/mpn/x86/pentium/mmx/gmp-mparam.h
deleted file mode 100644
index 2379077d0c..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/mmx/gmp-mparam.h
+++ /dev/null
@@ -1,97 +0,0 @@
-/* Intel P55 gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-
-#define BITS_PER_MP_LIMB 32
-#define BYTES_PER_MP_LIMB 4
-#define BITS_PER_LONGINT 32
-#define BITS_PER_INT 32
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
-
-
-#ifndef UMUL_TIME
-#define UMUL_TIME   9 /* cycles */
-#endif
-#ifndef UDIV_TIME
-#define UDIV_TIME   41 /* cycles */
-#endif
-
-/* bsf takes 18-42 cycles, put an average for uniform random numbers */
-#ifndef COUNT_TRAILING_ZEROS_TIME
-#define COUNT_TRAILING_ZEROS_TIME   20  /* cycles */
-#endif
-
-
-/* Generated by tuneup.c, 2000-07-06. */
-
-#ifndef KARATSUBA_MUL_THRESHOLD
-#define KARATSUBA_MUL_THRESHOLD   14
-#endif
-#ifndef TOOM3_MUL_THRESHOLD
-#define TOOM3_MUL_THRESHOLD       99
-#endif
-
-#ifndef KARATSUBA_SQR_THRESHOLD
-#define KARATSUBA_SQR_THRESHOLD   22
-#endif
-#ifndef TOOM3_SQR_THRESHOLD
-#define TOOM3_SQR_THRESHOLD       89
-#endif
-
-#ifndef BZ_THRESHOLD
-#define BZ_THRESHOLD              40
-#endif
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD             98
-#endif
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD            13
-#endif
-
-#ifndef GCD_ACCEL_THRESHOLD
-#define GCD_ACCEL_THRESHOLD        5
-#endif
-#ifndef GCDEXT_THRESHOLD
-#define GCDEXT_THRESHOLD          25
-#endif
-
-#ifndef FFT_MUL_TABLE
-#define FFT_MUL_TABLE  { 496, 1056, 1920, 4608, 14336, 40960, 0 }
-#endif
-#ifndef FFT_MODF_MUL_THRESHOLD
-#define FFT_MODF_MUL_THRESHOLD     512
-#endif
-#ifndef FFT_MUL_THRESHOLD
-#define FFT_MUL_THRESHOLD         3840
-#endif
-
-#ifndef FFT_SQR_TABLE
-#define FFT_SQR_TABLE  { 496, 1184, 2176, 5632, 14336, 40960, 0 }
-#endif
-#ifndef FFT_MODF_SQR_THRESHOLD
-#define FFT_MODF_SQR_THRESHOLD     512
-#endif
-#ifndef FFT_SQR_THRESHOLD
-#define FFT_SQR_THRESHOLD         4352
-#endif
diff --git a/ghc/rts/gmp/mpn/x86/pentium/mmx/lshift.asm b/ghc/rts/gmp/mpn/x86/pentium/mmx/lshift.asm
deleted file mode 100644
index 2225438658..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/mmx/lshift.asm
+++ /dev/null
@@ -1,455 +0,0 @@
-dnl  Intel P5 mpn_lshift -- mpn left shift.
-dnl 
-dnl  P5: 1.75 cycles/limb.
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_lshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       unsigned shift);
-C
-C Shift src,size left by shift many bits and store the result in dst,size.
-C Zeros are shifted in at the right.  Return the bits shifted out at the
-C left.
-C
-C The comments in mpn_rshift apply here too.
-
-defframe(PARAM_SHIFT,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,  8)
-defframe(PARAM_DST,  4)
-deflit(`FRAME',0)
-
-dnl  minimum 5, because the unrolled loop can't handle less
-deflit(UNROLL_THRESHOLD, 5)
-
-	.text
-	ALIGN(8)
-
-PROLOGUE(mpn_lshift)
-
-	pushl	%ebx
-	pushl	%edi
-deflit(`FRAME',8)
-
-	movl	PARAM_SIZE, %eax
-	movl	PARAM_DST, %edx
-
-	movl	PARAM_SRC, %ebx
-	movl	PARAM_SHIFT, %ecx
-
-	cmp	$UNROLL_THRESHOLD, %eax
-	jae	L(unroll)
-
-	movl	-4(%ebx,%eax,4), %edi	C src high limb
-	decl	%eax
-
-	jnz	L(simple)
-
-	shldl(	%cl, %edi, %eax)	C eax was decremented to zero
-
- 	shll	%cl, %edi
-
-	movl	%edi, (%edx)		C dst low limb
-	popl	%edi			C risk of data cache bank clash
-
-	popl	%ebx
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-L(simple):
-	C eax	size-1
-	C ebx	src
-	C ecx	shift
-	C edx	dst
-	C esi
-	C edi
-	C ebp
-deflit(`FRAME',8)
-
-	movd	(%ebx,%eax,4), %mm5	C src high limb
-
- 	movd	%ecx, %mm6		C lshift
-	negl	%ecx
-
-	psllq	%mm6, %mm5
-	addl	$32, %ecx
-
-	movd	%ecx, %mm7
-	psrlq	$32, %mm5		C retval
-
-
-L(simple_top):
-	C eax	counter, limbs, negative
-	C ebx	src
-	C ecx
-	C edx	dst
-	C esi
-	C edi
-	C
-	C mm0	scratch
-	C mm5	return value
-	C mm6	shift
-	C mm7	32-shift
-
-	movq	-4(%ebx,%eax,4), %mm0
-	decl	%eax
-
- 	psrlq	%mm7, %mm0
-
-	C
-
-	movd	%mm0, 4(%edx,%eax,4)
-	jnz	L(simple_top)
-
-
-	movd	(%ebx), %mm0
-
-	movd	%mm5, %eax
- 	psllq	%mm6, %mm0
-
-	popl	%edi
-	popl	%ebx
-
-	movd	%mm0, (%edx)
-
-	emms
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(8)
-L(unroll):
-	C eax	size
-	C ebx	src
-	C ecx	shift
-	C edx	dst
-	C esi
-	C edi
-	C ebp
-deflit(`FRAME',8)
-
-	movd	-4(%ebx,%eax,4), %mm5	C src high limb
-	leal	(%ebx,%eax,4), %edi
-
- 	movd	%ecx, %mm6		C lshift
-	andl	$4, %edi
-
-	psllq	%mm6, %mm5
-	jz	L(start_src_aligned)
-
-
-	C src isn't aligned, process high limb separately (marked xxx) to
-	C make it so.
-	C
-	C  source     -8(ebx,%eax,4)
-	C                  |
-	C  +-------+-------+-------+--
-	C  |               |          
-	C  +-------+-------+-------+--
-	C        0mod8   4mod8   0mod8
-	C
-	C  dest
-	C     -4(edx,%eax,4)
-	C          |
-	C  +-------+-------+--
-	C  |  xxx  |       |  
-	C  +-------+-------+--
-
-	movq	-8(%ebx,%eax,4), %mm0	C unaligned load
-
-	psllq	%mm6, %mm0
-	decl	%eax
-
-	psrlq	$32, %mm0
-
-	C
-
-	movd	%mm0, (%edx,%eax,4)
-L(start_src_aligned):
-
-	movq	-8(%ebx,%eax,4), %mm1	C src high qword
-	leal	(%edx,%eax,4), %edi
-
-	andl	$4, %edi
-	psrlq	$32, %mm5		C return value
-
-	movq	-16(%ebx,%eax,4), %mm3	C src second highest qword
-	jz	L(start_dst_aligned)
-
-	C dst isn't aligned, subtract 4 to make it so, and pretend the shift
-	C is 32 bits extra.  High limb of dst (marked xxx) handled here
-	C separately.
-	C
-	C  source     -8(ebx,%eax,4)
-	C                  |
-	C  +-------+-------+--
-	C  |      mm1      |  
-	C  +-------+-------+--
-	C                0mod8   4mod8
-	C
-	C  dest
-	C     -4(edx,%eax,4)
-	C          |
-	C  +-------+-------+-------+--
-	C  |  xxx  |               |
-	C  +-------+-------+-------+--
-	C        0mod8   4mod8   0mod8
-
-	movq	%mm1, %mm0
-	addl	$32, %ecx		C new shift
-
-	psllq	%mm6, %mm0
-
-	movd	%ecx, %mm6
-	psrlq	$32, %mm0
-
-	C wasted cycle here waiting for %mm0
-
-	movd	%mm0, -4(%edx,%eax,4)
-	subl	$4, %edx
-L(start_dst_aligned):
-
-
- 	psllq	%mm6, %mm1
-	negl	%ecx			C -shift
-
-        addl    $64, %ecx		C 64-shift
- 	movq	%mm3, %mm2
-
-        movd    %ecx, %mm7
-	subl	$8, %eax		C size-8
-
- 	psrlq	%mm7, %mm3
-
- 	por	%mm1, %mm3		C mm3 ready to store
-	jc	L(finish)
-
-
-	C The comments in mpn_rshift apply here too.
-
-	ALIGN(8)
-L(unroll_loop):
-	C eax	counter, limbs
-	C ebx	src
-	C ecx
-	C edx	dst
-	C esi
-	C edi
-	C
-	C mm0
-	C mm1
-	C mm2	src qword from 48(%ebx,%eax,4)
-	C mm3	dst qword ready to store to 56(%edx,%eax,4)
-	C
-	C mm5	return value
-	C mm6	lshift
-	C mm7	rshift
-
- 	movq	8(%ebx,%eax,4), %mm0
- 	psllq	%mm6, %mm2
-
- 	movq	%mm0, %mm1
- 	psrlq	%mm7, %mm0
-
- 	movq	%mm3, 24(%edx,%eax,4)	C prev
- 	por	%mm2, %mm0
-
- 	movq	(%ebx,%eax,4), %mm3	C
- 	psllq	%mm6, %mm1		C
-
- 	movq	%mm0, 16(%edx,%eax,4)
- 	movq	%mm3, %mm2		C
-
- 	psrlq	%mm7, %mm3		C
-	subl	$4, %eax
-
- 	por	%mm1, %mm3		C
-	jnc	L(unroll_loop)
-
-
-
-L(finish):
-	C eax	-4 to -1 representing respectively 0 to 3 limbs remaining
-
-	testb	$2, %al
-
-	jz	L(finish_no_two)
-
- 	movq	8(%ebx,%eax,4), %mm0
- 	psllq	%mm6, %mm2
-
- 	movq	%mm0, %mm1
- 	psrlq	%mm7, %mm0
-
- 	movq	%mm3, 24(%edx,%eax,4)	C prev
- 	por	%mm2, %mm0
-
-	movq	%mm1, %mm2
-	movq	%mm0, %mm3
-
-	subl	$2, %eax
-L(finish_no_two):
-
-
-	C eax	-4 or -3 representing respectively 0 or 1 limbs remaining
-	C
-	C mm2	src prev qword, from 48(%ebx,%eax,4)
-	C mm3	dst qword, for 56(%edx,%eax,4)
-
-	testb	$1, %al
-	movd	%mm5, %eax	C retval
-
-	popl	%edi
-	jz	L(finish_zero)
-
-
-	C One extra src limb, destination was aligned.
-	C
-	C                 source                  ebx
-	C                 --+---------------+-------+
-	C                   |      mm2      |       |
-	C                 --+---------------+-------+
-	C
-	C dest         edx+12           edx+4     edx
-	C --+---------------+---------------+-------+
-	C   |      mm3      |               |       |
-	C --+---------------+---------------+-------+
-	C
-	C mm6 = shift
-	C mm7 = ecx = 64-shift
-
-
-	C One extra src limb, destination was unaligned.
-	C
-	C                 source                  ebx
-	C                 --+---------------+-------+
-	C                   |      mm2      |       |
-	C                 --+---------------+-------+
-	C
-	C         dest         edx+12           edx+4
-	C         --+---------------+---------------+
-	C           |      mm3      |               |
-	C         --+---------------+---------------+
-	C
-	C mm6 = shift+32
-	C mm7 = ecx = 64-(shift+32)
-
-
-	C In both cases there's one extra limb of src to fetch and combine
-	C with mm2 to make a qword at 4(%edx), and in the aligned case
-	C there's an extra limb of dst to be formed from that extra src limb
-	C left shifted.
-
-
-        movd    (%ebx), %mm0
- 	psllq	%mm6, %mm2
-
-	movq	%mm3, 12(%edx)
-	psllq	$32, %mm0
-
-        movq    %mm0, %mm1
-        psrlq   %mm7, %mm0
-
-        por     %mm2, %mm0
-        psllq   %mm6, %mm1
-
-	movq    %mm0, 4(%edx)
-	psrlq	$32, %mm1
-
-        andl	$32, %ecx
-	popl	%ebx
-
-	jz	L(finish_one_unaligned)
-
-	movd	%mm1, (%edx)
-L(finish_one_unaligned):
-
-	emms
-
-        ret
-
-
-L(finish_zero):
-
-	C No extra src limbs, destination was aligned.
-	C
-	C                 source          ebx
-	C                 --+---------------+
-	C                   |      mm2      |
-	C                 --+---------------+
-	C
-	C dest          edx+8             edx
-	C --+---------------+---------------+
-	C   |      mm3      |               |
-	C --+---------------+---------------+
-	C
-	C mm6 = shift
-	C mm7 = ecx = 64-shift
-
-
-	C No extra src limbs, destination was unaligned.
-	C
-	C               source            ebx
-	C                 --+---------------+
-	C                   |      mm2      |
-	C                 --+---------------+
-	C
-	C         dest          edx+8   edx+4
-	C         --+---------------+-------+
-	C           |      mm3      |       |
-	C         --+---------------+-------+
-	C
-	C mm6 = shift+32
-	C mm7 = ecx = 64-(shift+32)
-
-
-	C The movd for the unaligned case writes the same data to 4(%edx)
-	C that the movq does for the aligned case.
-
-
- 	movq	%mm3, 8(%edx)
-	andl	$32, %ecx
-
- 	psllq	%mm6, %mm2
-	jz	L(finish_zero_unaligned)
-
- 	movq	%mm2, (%edx)
-L(finish_zero_unaligned):
-
-	psrlq	$32, %mm2
-	popl	%ebx
-
-	movd	%mm5, %eax	C retval
-
-	movd	%mm2, 4(%edx)
-
-	emms
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/pentium/mmx/popham.asm b/ghc/rts/gmp/mpn/x86/pentium/mmx/popham.asm
deleted file mode 100644
index 587a07ab3d..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/mmx/popham.asm
+++ /dev/null
@@ -1,30 +0,0 @@
-dnl  Intel P55 mpn_popcount, mpn_hamdist -- population count and hamming
-dnl  distance.
-dnl 
-dnl  P55: popcount 11.5 cycles/limb, hamdist 12.0 cycles/limb
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-MULFUNC_PROLOGUE(mpn_popcount mpn_hamdist)
-include_mpn(`x86/k6/mmx/popham.asm')
diff --git a/ghc/rts/gmp/mpn/x86/pentium/mmx/rshift.asm b/ghc/rts/gmp/mpn/x86/pentium/mmx/rshift.asm
deleted file mode 100644
index 7672630d57..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/mmx/rshift.asm
+++ /dev/null
@@ -1,460 +0,0 @@
-dnl  Intel P5 mpn_rshift -- mpn right shift.
-dnl 
-dnl  P5: 1.75 cycles/limb.
-
-
-dnl  Copyright (C) 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_rshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       unsigned shift);
-C
-C Shift src,size right by shift many bits and store the result in dst,size.
-C Zeros are shifted in at the left.  Return the bits shifted out at the
-C right.
-C
-C It takes 6 mmx instructions to process 2 limbs, making 1.5 cycles/limb,
-C and with a 4 limb loop and 1 cycle of loop overhead the total is 1.75 c/l.
-C
-C Full speed depends on source and destination being aligned.  Unaligned mmx
-C loads and stores on P5 don't pair and have a 2 cycle penalty.  Some hairy
-C setups and finish-ups are done to ensure alignment for the loop.
-C
-C MMX shifts work out a bit faster even for the simple loop.
-
-defframe(PARAM_SHIFT,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,  8)
-defframe(PARAM_DST,  4)
-deflit(`FRAME',0)
-
-dnl  Minimum 5, because the unrolled loop can't handle less.
-deflit(UNROLL_THRESHOLD, 5)
-
-	.text
-	ALIGN(8)
-
-PROLOGUE(mpn_rshift)
-
-	pushl	%ebx
-	pushl	%edi
-deflit(`FRAME',8)
-
-	movl	PARAM_SIZE, %eax
-	movl	PARAM_DST, %edx
-
-	movl	PARAM_SRC, %ebx
-	movl	PARAM_SHIFT, %ecx
-
-	cmp	$UNROLL_THRESHOLD, %eax
-	jae	L(unroll)
-
-	decl	%eax
-	movl	(%ebx), %edi		C src low limb
-
-	jnz	L(simple)
-
-	shrdl(	%cl, %edi, %eax)	C eax was decremented to zero
-
- 	shrl	%cl, %edi
-
-	movl	%edi, (%edx)		C dst low limb
-	popl	%edi			C risk of data cache bank clash
-
-	popl	%ebx
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(8)
-L(simple):
-	C eax	size-1
-	C ebx	src
-	C ecx	shift
-	C edx	dst
-	C esi
-	C edi
-	C ebp
-deflit(`FRAME',8)
-
-	movd	(%ebx), %mm5		C src[0]
-	leal	(%ebx,%eax,4), %ebx	C &src[size-1]
-
- 	movd	%ecx, %mm6		C rshift
-	leal	-4(%edx,%eax,4), %edx	C &dst[size-2]
-
-	psllq	$32, %mm5
-	negl	%eax
-
-
-C This loop is 5 or 8 cycles, with every second load unaligned and a wasted
-C cycle waiting for the mm0 result to be ready.  For comparison a shrdl is 4
-C cycles and would be 8 in a simple loop.  Using mmx helps the return value
-C and last limb calculations too.
-
-L(simple_top):
-	C eax	counter, limbs, negative
-	C ebx	&src[size-1]
-	C ecx	return value
-	C edx	&dst[size-2]
-	C
-	C mm0	scratch
-	C mm5	return value
-	C mm6	shift
-
-	movq	(%ebx,%eax,4), %mm0
-	incl	%eax
-
- 	psrlq	%mm6, %mm0
-
-	movd	%mm0, (%edx,%eax,4)
-	jnz	L(simple_top)
-
-
-	movd	(%ebx), %mm0
-	psrlq	%mm6, %mm5		C return value
-
- 	psrlq	%mm6, %mm0
-	popl	%edi
-
-	movd	%mm5, %eax
-	popl	%ebx
-
-	movd	%mm0, 4(%edx)
-
-	emms
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(8)
-L(unroll):
-	C eax	size
-	C ebx	src
-	C ecx	shift
-	C edx	dst
-	C esi
-	C edi
-	C ebp
-deflit(`FRAME',8)
-
-	movd	(%ebx), %mm5		C src[0]
-	movl	$4, %edi
-
- 	movd	%ecx, %mm6		C rshift
-	testl	%edi, %ebx
-
-	psllq	$32, %mm5
-	jz	L(start_src_aligned)
-
-
-	C src isn't aligned, process low limb separately (marked xxx) and
-	C step src and dst by one limb, making src aligned.
-	C
-	C source                  ebx
-	C --+-------+-------+-------+
-	C           |          xxx  |
-	C --+-------+-------+-------+
-	C         4mod8   0mod8   4mod8
-	C
-	C         dest            edx
-	C         --+-------+-------+
-	C           |       |  xxx  |  
-	C         --+-------+-------+
-
-	movq	(%ebx), %mm0		C unaligned load
-
-	psrlq	%mm6, %mm0
-	addl	$4, %ebx
-
-	decl	%eax
-
-	movd	%mm0, (%edx)
-	addl	$4, %edx
-L(start_src_aligned):
-
-
-	movq	(%ebx), %mm1
-	testl	%edi, %edx
-
-	psrlq	%mm6, %mm5		C retval
-	jz	L(start_dst_aligned)
-
-	C dst isn't aligned, add 4 to make it so, and pretend the shift is
-	C 32 bits extra.  Low limb of dst (marked xxx) handled here
-	C separately.
-	C
-	C          source          ebx
-	C          --+-------+-------+
-	C            |      mm1      |
-	C          --+-------+-------+
-	C                  4mod8   0mod8
-	C
-	C  dest                    edx
-	C  --+-------+-------+-------+
-	C                    |  xxx  |        
-	C  --+-------+-------+-------+
-	C          4mod8   0mod8   4mod8
-
-	movq	%mm1, %mm0
-	addl	$32, %ecx		C new shift
-
-	psrlq	%mm6, %mm0
-
-	movd	%ecx, %mm6
-
-	movd	%mm0, (%edx)
-	addl	$4, %edx
-L(start_dst_aligned):
-
-
-	movq	8(%ebx), %mm3
-	negl	%ecx
-
- 	movq	%mm3, %mm2		C mm2 src qword
-        addl    $64, %ecx
-
-        movd    %ecx, %mm7
- 	psrlq	%mm6, %mm1
-
-	leal	-12(%ebx,%eax,4), %ebx
-	leal	-20(%edx,%eax,4), %edx
-
- 	psllq	%mm7, %mm3
-	subl	$7, %eax		C size-7
-
- 	por	%mm1, %mm3		C mm3 ready to store
-	negl	%eax			C -(size-7)
-
-	jns	L(finish)
-
-
-	C This loop is the important bit, the rest is just support.  Careful
-	C instruction scheduling achieves the claimed 1.75 c/l.  The
-	C relevant parts of the pairing rules are:
-	C
-	C - mmx loads and stores execute only in the U pipe
-	C - only one mmx shift in a pair
-	C - wait one cycle before storing an mmx register result
-	C - the usual address generation interlock
-	C
-	C Two qword calculations are slightly interleaved.  The instructions
-	C marked "C" belong to the second qword, and the "C prev" one is for
-	C the second qword from the previous iteration.
-
-	ALIGN(8)
-L(unroll_loop):
-	C eax	counter, limbs, negative
-	C ebx	&src[size-12]
-	C ecx
-	C edx	&dst[size-12]
-	C esi
-	C edi
-	C
-	C mm0
-	C mm1
-	C mm2	src qword from -8(%ebx,%eax,4)
-	C mm3	dst qword ready to store to -8(%edx,%eax,4)
-	C
-	C mm5	return value
-	C mm6	rshift
-	C mm7	lshift
-
- 	movq	(%ebx,%eax,4), %mm0
- 	psrlq	%mm6, %mm2
-
- 	movq	%mm0, %mm1
- 	psllq	%mm7, %mm0
-
- 	movq	%mm3, -8(%edx,%eax,4)	C prev
- 	por	%mm2, %mm0
-
- 	movq	8(%ebx,%eax,4), %mm3	C
- 	psrlq	%mm6, %mm1		C
-
- 	movq	%mm0, (%edx,%eax,4)
- 	movq	%mm3, %mm2		C
-
- 	psllq	%mm7, %mm3		C
-	addl	$4, %eax
-
- 	por	%mm1, %mm3		C
-	js	L(unroll_loop)
-
-
-L(finish):
-	C eax	0 to 3 representing respectively 3 to 0 limbs remaining
-
-	testb	$2, %al
-
-	jnz	L(finish_no_two)
-
- 	movq	(%ebx,%eax,4), %mm0
- 	psrlq	%mm6, %mm2
-
- 	movq	%mm0, %mm1
- 	psllq	%mm7, %mm0
-
- 	movq	%mm3, -8(%edx,%eax,4)	C prev
- 	por	%mm2, %mm0
-
-	movq	%mm1, %mm2
-	movq	%mm0, %mm3
-
-	addl	$2, %eax
-L(finish_no_two):
-
-
-	C eax	2 or 3 representing respectively 1 or 0 limbs remaining
-	C
-	C mm2	src prev qword, from -8(%ebx,%eax,4)
-	C mm3	dst qword, for -8(%edx,%eax,4)
-
-	testb	$1, %al
-	popl	%edi
-
-	movd	%mm5, %eax	C retval
-	jnz	L(finish_zero)
-
-
-	C One extra limb, destination was aligned.
-	C
-	C source                ebx
-	C +-------+---------------+--
-	C |       |      mm2      |
-	C +-------+---------------+--
-	C
-	C dest                                  edx
-	C +-------+---------------+---------------+--
-	C |       |               |      mm3      |
-	C +-------+---------------+---------------+--
-	C
-	C mm6 = shift
-	C mm7 = ecx = 64-shift
-
-
-	C One extra limb, destination was unaligned.
-	C
-	C source                ebx
-	C +-------+---------------+--
-	C |       |      mm2      |
-	C +-------+---------------+--
-	C
-	C dest                          edx
-	C +---------------+---------------+--
-	C |               |      mm3      |
-	C +---------------+---------------+--
-	C
-	C mm6 = shift+32
-	C mm7 = ecx = 64-(shift+32)
-
-
-	C In both cases there's one extra limb of src to fetch and combine
-	C with mm2 to make a qword at 8(%edx), and in the aligned case
-	C there's a further extra limb of dst to be formed.
-
-
-        movd    8(%ebx), %mm0
- 	psrlq	%mm6, %mm2
-
-        movq    %mm0, %mm1
-        psllq   %mm7, %mm0
-
-	movq	%mm3, (%edx)
-        por     %mm2, %mm0
-
-        psrlq   %mm6, %mm1
-        andl	$32, %ecx
-
-	popl	%ebx
-	jz	L(finish_one_unaligned)
-
-        C dst was aligned, must store one extra limb
-	movd	%mm1, 16(%edx)
-L(finish_one_unaligned):
-
-	movq    %mm0, 8(%edx)
-
-	emms
-
-        ret
-
-
-L(finish_zero):
-
-	C No extra limbs, destination was aligned.
-	C
-	C source        ebx
-	C +---------------+--
-	C |      mm2      |
-	C +---------------+--
-	C
-	C dest                        edx+4
-	C +---------------+---------------+--
-	C |               |      mm3      |
-	C +---------------+---------------+--
-	C
-	C mm6 = shift
-	C mm7 = ecx = 64-shift
-
-
-	C No extra limbs, destination was unaligned.
-	C
-	C source        ebx
-	C +---------------+--
-	C |      mm2      |
-	C +---------------+--
-	C
-	C dest                edx+4
-	C +-------+---------------+--
-	C |       |      mm3      |
-	C +-------+---------------+--
-	C
-	C mm6 = shift+32
-	C mm7 = 64-(shift+32)
-
-
-	C The movd for the unaligned case is clearly the same data as the
-	C movq for the aligned case, it's just a choice between whether one
-	C or two limbs should be written.
-
-
- 	movq	%mm3, 4(%edx)
- 	psrlq	%mm6, %mm2
-
- 	movd	%mm2, 12(%edx)
-	andl	$32, %ecx
-
-	popl	%ebx
-	jz	L(finish_zero_unaligned)
-
- 	movq	%mm2, 12(%edx)
-L(finish_zero_unaligned):
-
-	emms
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/pentium/mul_1.asm b/ghc/rts/gmp/mpn/x86/pentium/mul_1.asm
deleted file mode 100644
index 08639eca09..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/mul_1.asm
+++ /dev/null
@@ -1,79 +0,0 @@
-dnl  Intel Pentium mpn_mul_1 -- mpn by limb multiplication.
-dnl
-dnl  P5: 13.0 cycles/limb
-
-dnl  Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation,
-dnl  Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA. */
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_mul_1 (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                      mp_limb_t multiplier);
-
-defframe(PARAM_MULTIPLIER,16)
-defframe(PARAM_SIZE,      12)
-defframe(PARAM_SRC,       8)
-defframe(PARAM_DST,       4)
-
-	.text
-	ALIGN(8)
-PROLOGUE(mpn_mul_1)
-
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-	pushl	%ebp
-deflit(`FRAME',16)
-
-	movl	PARAM_DST, %edi
-	movl	PARAM_SRC, %esi
-	movl	PARAM_SIZE, %ecx
-	movl	PARAM_MULTIPLIER, %ebp
-
-	leal	(%edi,%ecx,4), %edi
-	leal	(%esi,%ecx,4), %esi
-	negl	%ecx
-	xorl	%ebx, %ebx
-	ALIGN(8)
-
-L(oop):	adcl	$0, %ebx
-	movl	(%esi,%ecx,4), %eax
-
-	mull	%ebp
-
-	addl	%eax, %ebx
-
-	movl	%ebx, (%edi,%ecx,4)
-	incl	%ecx
-
-	movl	%edx, %ebx
-	jnz	L(oop)
-
-	adcl	$0, %ebx
-	movl	%ebx, %eax
-	popl	%ebp
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/pentium/mul_basecase.asm b/ghc/rts/gmp/mpn/x86/pentium/mul_basecase.asm
deleted file mode 100644
index d9f79a0831..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/mul_basecase.asm
+++ /dev/null
@@ -1,135 +0,0 @@
-dnl  Intel Pentium mpn_mul_basecase -- mpn by mpn multiplication.
-dnl 
-dnl  P5: 14.2 cycles/crossproduct (approx)
-
-
-dnl  Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C void mpn_mul_basecase (mp_ptr wp,
-C                        mp_srcptr xp, mp_size_t xsize,
-C                        mp_srcptr yp, mp_size_t ysize);
-
-defframe(PARAM_YSIZE, 20)
-defframe(PARAM_YP,    16)
-defframe(PARAM_XSIZE, 12)
-defframe(PARAM_XP,    8)
-defframe(PARAM_WP,    4)
-
-defframe(VAR_COUNTER, -4)
-
-	.text
-	ALIGN(8)
-PROLOGUE(mpn_mul_basecase)
-
-	pushl	%eax			C dummy push for allocating stack slot
-	pushl	%esi
-	pushl	%ebp
-	pushl	%edi
-deflit(`FRAME',16)
-
-	movl	PARAM_XP,%esi
-	movl	PARAM_WP,%edi
-	movl	PARAM_YP,%ebp
-
-	movl	(%esi),%eax		C load xp[0]
-	mull	(%ebp)			C multiply by yp[0]
-	movl	%eax,(%edi)		C store to wp[0]
-	movl	PARAM_XSIZE,%ecx	C xsize
-	decl	%ecx			C If xsize = 1, ysize = 1 too
-	jz	L(done)
-
-	movl	PARAM_XSIZE,%eax
-	pushl	%ebx
-FRAME_pushl()
-	movl	%edx,%ebx
-	leal	(%esi,%eax,4),%esi	C make xp point at end
-	leal	(%edi,%eax,4),%edi	C offset wp by xsize
-	negl	%ecx			C negate j size/index for inner loop
-	xorl	%eax,%eax		C clear carry
-
-	ALIGN(8)
-L(oop1):	adcl	$0,%ebx
-	movl	(%esi,%ecx,4),%eax	C load next limb at xp[j]
-	mull	(%ebp)
-	addl	%ebx,%eax
-	movl	%eax,(%edi,%ecx,4)
-	incl	%ecx
-	movl	%edx,%ebx
-	jnz	L(oop1)
-
-	adcl	$0,%ebx
-	movl	PARAM_YSIZE,%eax
-	movl	%ebx,(%edi)		C most significant limb of product
-	addl	$4,%edi			C increment wp
-	decl	%eax
-	jz	L(skip)
-	movl	%eax,VAR_COUNTER	C set index i to ysize
-
-L(outer):
-	addl	$4,%ebp			C make ebp point to next y limb
-	movl	PARAM_XSIZE,%ecx
-	negl	%ecx
-	xorl	%ebx,%ebx
-
-	C code at 0x61 here, close enough to aligned
-L(oop2):
-	adcl	$0,%ebx
-	movl	(%esi,%ecx,4),%eax
-	mull	(%ebp)
-	addl	%ebx,%eax
-	movl	(%edi,%ecx,4),%ebx
-	adcl	$0,%edx
-	addl	%eax,%ebx
-	movl	%ebx,(%edi,%ecx,4)
-	incl	%ecx
-	movl	%edx,%ebx
-	jnz	L(oop2)
-
-	adcl	$0,%ebx
-
-	movl	%ebx,(%edi)
-	addl	$4,%edi
-	movl	VAR_COUNTER,%eax
-	decl	%eax
-	movl	%eax,VAR_COUNTER
-	jnz	L(outer)
-
-L(skip):
-	popl	%ebx
-	popl	%edi
-	popl	%ebp
-	popl	%esi
-	addl	$4,%esp
-	ret
-
-L(done):
-	movl	%edx,4(%edi)	C store to wp[1]
-	popl	%edi
-	popl	%ebp
-	popl	%esi
-	popl	%eax		C dummy pop for deallocating stack slot
-	ret
-
-EPILOGUE()
-
diff --git a/ghc/rts/gmp/mpn/x86/pentium/rshift.asm b/ghc/rts/gmp/mpn/x86/pentium/rshift.asm
deleted file mode 100644
index e8f5ae8ec8..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/rshift.asm
+++ /dev/null
@@ -1,236 +0,0 @@
-dnl  Intel Pentium mpn_rshift -- mpn right shift.
-dnl
-dnl          cycles/limb
-dnl  P5,P54:    6.0
-dnl  P55:       5.375
-
-
-dnl  Copyright (C) 1992, 1994, 1995, 1996, 1999, 2000 Free Software
-dnl  Foundation, Inc.
-dnl
-dnl  This file is part of the GNU MP Library.
-dnl
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_rshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       unsigned shift);
-C
-C The main shift-by-N loop should run at 5.375 c/l and that's what P55 does,
-C but P5 and P54 run only at 6.0 c/l, which is 4 cycles lost somewhere.
-
-defframe(PARAM_SHIFT,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,  8)
-defframe(PARAM_DST,  4)
-
-	.text
-	ALIGN(8)
-PROLOGUE(mpn_rshift)
-
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-	pushl	%ebp
-deflit(`FRAME',16)
-
-	movl	PARAM_DST,%edi
-	movl	PARAM_SRC,%esi
-	movl	PARAM_SIZE,%ebp
-	movl	PARAM_SHIFT,%ecx
-
-C We can use faster code for shift-by-1 under certain conditions. 
-	cmp	$1,%ecx
-	jne	L(normal)
-	leal	4(%edi),%eax
-	cmpl	%esi,%eax
-	jnc	L(special)		C jump if res_ptr + 1 >= s_ptr
-	leal	(%edi,%ebp,4),%eax
-	cmpl	%eax,%esi
-	jnc	L(special)		C jump if s_ptr >= res_ptr + size
-
-L(normal):
-	movl	(%esi),%edx
-	addl	$4,%esi
-	xorl	%eax,%eax
-	shrdl(	%cl, %edx, %eax)	C compute carry limb
-	pushl	%eax			C push carry limb onto stack
-
-	decl	%ebp
-	pushl	%ebp
-	shrl	$3,%ebp
-	jz	L(end)
-
-	movl	(%edi),%eax		C fetch destination cache line
-
-	ALIGN(4)
-L(oop):	movl	28(%edi),%eax		C fetch destination cache line
-	movl	%edx,%ebx
-
-	movl	(%esi),%eax
-	movl	4(%esi),%edx
-	shrdl(	%cl, %eax, %ebx)
-	shrdl(	%cl, %edx, %eax)
-	movl	%ebx,(%edi)
-	movl	%eax,4(%edi)
-
-	movl	8(%esi),%ebx
-	movl	12(%esi),%eax
-	shrdl(	%cl, %ebx, %edx)
-	shrdl(	%cl, %eax, %ebx)
-	movl	%edx,8(%edi)
-	movl	%ebx,12(%edi)
-
-	movl	16(%esi),%edx
-	movl	20(%esi),%ebx
-	shrdl(	%cl, %edx, %eax)
-	shrdl(	%cl, %ebx, %edx)
-	movl	%eax,16(%edi)
-	movl	%edx,20(%edi)
-
-	movl	24(%esi),%eax
-	movl	28(%esi),%edx
-	shrdl(	%cl, %eax, %ebx)
-	shrdl(	%cl, %edx, %eax)
-	movl	%ebx,24(%edi)
-	movl	%eax,28(%edi)
-
-	addl	$32,%esi
-	addl	$32,%edi
-	decl	%ebp
-	jnz	L(oop)
-
-L(end):	popl	%ebp
-	andl	$7,%ebp
-	jz	L(end2)
-L(oop2):
-	movl	(%esi),%eax
-	shrdl(	%cl,%eax,%edx)		C compute result limb
-	movl	%edx,(%edi)
-	movl	%eax,%edx
-	addl	$4,%esi
-	addl	$4,%edi
-	decl	%ebp
-	jnz	L(oop2)
-
-L(end2):
-	shrl	%cl,%edx		C compute most significant limb
-	movl	%edx,(%edi)		C store it
-
-	popl	%eax			C pop carry limb
-
-	popl	%ebp
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-
-C We loop from least significant end of the arrays, which is only
-C permissable if the source and destination don't overlap, since the
-C function is documented to work for overlapping source and destination.
-
-L(special):
-	leal	-4(%edi,%ebp,4),%edi
-	leal	-4(%esi,%ebp,4),%esi
-
-	movl	(%esi),%edx
-	subl	$4,%esi
-
-	decl	%ebp
-	pushl	%ebp
-	shrl	$3,%ebp
-
-	shrl	%edx
-	incl	%ebp
-	decl	%ebp
-	jz	L(Lend)
-
-	movl	(%edi),%eax		C fetch destination cache line
-
-	ALIGN(4)
-L(Loop):
-	movl	-28(%edi),%eax		C fetch destination cache line
-	movl	%edx,%ebx
-
-	movl	(%esi),%eax
-	movl	-4(%esi),%edx
-	rcrl	%eax
-	movl	%ebx,(%edi)
-	rcrl	%edx
-	movl	%eax,-4(%edi)
-
-	movl	-8(%esi),%ebx
-	movl	-12(%esi),%eax
-	rcrl	%ebx
-	movl	%edx,-8(%edi)
-	rcrl	%eax
-	movl	%ebx,-12(%edi)
-
-	movl	-16(%esi),%edx
-	movl	-20(%esi),%ebx
-	rcrl	%edx
-	movl	%eax,-16(%edi)
-	rcrl	%ebx
-	movl	%edx,-20(%edi)
-
-	movl	-24(%esi),%eax
-	movl	-28(%esi),%edx
-	rcrl	%eax
-	movl	%ebx,-24(%edi)
-	rcrl	%edx
-	movl	%eax,-28(%edi)
-
-	leal	-32(%esi),%esi		C use leal not to clobber carry
-	leal	-32(%edi),%edi
-	decl	%ebp
-	jnz	L(Loop)
-
-L(Lend):
-	popl	%ebp
-	sbbl	%eax,%eax		C save carry in %eax
-	andl	$7,%ebp
-	jz	L(Lend2)
-	addl	%eax,%eax		C restore carry from eax
-L(Loop2):
-	movl	%edx,%ebx
-	movl	(%esi),%edx
-	rcrl	%edx
-	movl	%ebx,(%edi)
-
-	leal	-4(%esi),%esi		C use leal not to clobber carry
-	leal	-4(%edi),%edi
-	decl	%ebp
-	jnz	L(Loop2)
-
-	jmp	L(L1)
-L(Lend2):
-	addl	%eax,%eax		C restore carry from eax
-L(L1):	movl	%edx,(%edi)		C store last limb
-
-	movl	$0,%eax
-	rcrl	%eax
-
-	popl	%ebp
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/pentium/sqr_basecase.asm b/ghc/rts/gmp/mpn/x86/pentium/sqr_basecase.asm
deleted file mode 100644
index c8584df13c..0000000000
--- a/ghc/rts/gmp/mpn/x86/pentium/sqr_basecase.asm
+++ /dev/null
@@ -1,520 +0,0 @@
-dnl  Intel P5 mpn_sqr_basecase -- square an mpn number.
-dnl 
-dnl  P5: approx 8 cycles per crossproduct, or 15.5 cycles per triangular
-dnl  product at around 20x20 limbs.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C void mpn_sqr_basecase (mp_ptr dst, mp_srcptr src, mp_size_t size);
-C
-C Calculate src,size squared, storing the result in dst,2*size.
-C
-C The algorithm is basically the same as mpn/generic/sqr_basecase.c, but a
-C lot of function call overheads are avoided, especially when the size is
-C small.
-
-defframe(PARAM_SIZE,12)
-defframe(PARAM_SRC, 8)
-defframe(PARAM_DST, 4)
-
-	.text
-	ALIGN(8)
-PROLOGUE(mpn_sqr_basecase)
-deflit(`FRAME',0)
-
-	movl	PARAM_SIZE, %edx
-	movl	PARAM_SRC, %eax
-
-	cmpl	$2, %edx
-	movl	PARAM_DST, %ecx
-
-	je	L(two_limbs)
-
-	movl	(%eax), %eax
-	ja	L(three_or_more)
-
-C -----------------------------------------------------------------------------
-C one limb only
-	C eax	src
-	C ebx
-	C ecx	dst
-	C edx
-
-	mull	%eax
-
-	movl	%eax, (%ecx)
-	movl	%edx, 4(%ecx)
-
-	ret
-
-C -----------------------------------------------------------------------------
-	ALIGN(8)
-L(two_limbs):
-	C eax	src
-	C ebx
-	C ecx	dst
-	C edx	size
-
-	pushl	%ebp
-	pushl	%edi
-
-	pushl	%esi
-	pushl	%ebx
-
-	movl	%eax, %ebx
-	movl	(%eax), %eax
-
-	mull	%eax		C src[0]^2
-
-	movl	%eax, (%ecx)	C dst[0]
-	movl	%edx, %esi	C dst[1]
-
-	movl	4(%ebx), %eax
-
-	mull	%eax		C src[1]^2
-
-	movl	%eax, %edi	C dst[2]
-	movl	%edx, %ebp	C dst[3]
-
-	movl	(%ebx), %eax
-
-	mull	4(%ebx)		C src[0]*src[1]
-
-	addl	%eax, %esi
-	popl	%ebx
-
-	adcl	%edx, %edi
-
-	adcl	$0, %ebp
-	addl	%esi, %eax
-
-	adcl	%edi, %edx
-	movl	%eax, 4(%ecx)
-
-	adcl	$0, %ebp
-	popl	%esi
-
-	movl	%edx, 8(%ecx)
-	movl	%ebp, 12(%ecx)
-
-	popl	%edi
-	popl	%ebp
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(8)
-L(three_or_more):
-	C eax	src low limb
-	C ebx
-	C ecx	dst
-	C edx	size
-
-	cmpl	$4, %edx
-	pushl	%ebx
-deflit(`FRAME',4)
-
-	movl	PARAM_SRC, %ebx
-	jae	L(four_or_more)
-
-
-C -----------------------------------------------------------------------------
-C three limbs
-	C eax	src low limb
-	C ebx	src
-	C ecx	dst
-	C edx	size
-
-	pushl	%ebp
-	pushl	%edi
-
-	mull	%eax		C src[0] ^ 2
-
-	movl	%eax, (%ecx)
-	movl	%edx, 4(%ecx)
-
-	movl	4(%ebx), %eax
-	xorl	%ebp, %ebp
-
-	mull	%eax		C src[1] ^ 2
-
-	movl	%eax, 8(%ecx)
-	movl	%edx, 12(%ecx)
-
-	movl	8(%ebx), %eax
-	pushl	%esi		C risk of cache bank clash
-
-	mull	%eax		C src[2] ^ 2
-
-	movl	%eax, 16(%ecx)
-	movl	%edx, 20(%ecx)
-
-	movl	(%ebx), %eax
-
-	mull	4(%ebx)		C src[0] * src[1]
-
-	movl	%eax, %esi
-	movl	%edx, %edi
-
-	movl	(%ebx), %eax
-
-	mull	8(%ebx)		C src[0] * src[2]
-
-	addl	%eax, %edi
-	movl	%edx, %ebp
-
-	adcl	$0, %ebp
-	movl	4(%ebx), %eax
-
-	mull	8(%ebx)		C src[1] * src[2]
-
-	xorl	%ebx, %ebx
-	addl	%eax, %ebp
-
-	C eax
-	C ebx	zero, will be dst[5]
-	C ecx	dst
-	C edx	dst[4]
-	C esi	dst[1]
-	C edi	dst[2]
-	C ebp	dst[3]
-
-	adcl	$0, %edx
-	addl	%esi, %esi
-
-	adcl	%edi, %edi
-
-	adcl	%ebp, %ebp
-
-	adcl	%edx, %edx
-	movl	4(%ecx), %eax
-
-	adcl	$0, %ebx
-	addl	%esi, %eax
-
-	movl	%eax, 4(%ecx)
-	movl	8(%ecx), %eax
-
-	adcl	%edi, %eax
-	movl	12(%ecx), %esi
-
-	adcl	%ebp, %esi
-	movl	16(%ecx), %edi
-
-	movl	%eax, 8(%ecx)
-	movl	%esi, 12(%ecx)
-
-	adcl	%edx, %edi
-	popl	%esi
-
-	movl	20(%ecx), %eax
-	movl	%edi, 16(%ecx)
-
-	popl	%edi
-	popl	%ebp
-
-	adcl	%ebx, %eax	C no carry out of this
-	popl	%ebx
-
-	movl	%eax, 20(%ecx)
-
-	ret
-
-
-C -----------------------------------------------------------------------------
-	ALIGN(8)
-L(four_or_more):
-	C eax	src low limb
-	C ebx	src
-	C ecx	dst
-	C edx	size
-	C esi
-	C edi
-	C ebp
-	C
-	C First multiply src[0]*src[1..size-1] and store at dst[1..size].
-
-deflit(`FRAME',4)
-
-	pushl	%edi
-FRAME_pushl()
-	pushl	%esi
-FRAME_pushl()
-
-	pushl	%ebp
-FRAME_pushl()
-	leal	(%ecx,%edx,4), %edi	C dst end of this mul1
-
-	leal	(%ebx,%edx,4), %esi	C src end
-	movl	%ebx, %ebp		C src
-
-	negl	%edx			C -size
-	xorl	%ebx, %ebx		C clear carry limb and carry flag
-
-	leal	1(%edx), %ecx		C -(size-1)
-
-L(mul1):
-	C eax	scratch
-	C ebx	carry
-	C ecx	counter, negative
-	C edx	scratch
-	C esi	&src[size]
-	C edi	&dst[size]
-	C ebp	src
-
-	adcl	$0, %ebx
-	movl	(%esi,%ecx,4), %eax
-
-	mull	(%ebp)
-
-	addl	%eax, %ebx
-
-	movl	%ebx, (%edi,%ecx,4)
-	incl	%ecx
-
-	movl	%edx, %ebx
-	jnz	L(mul1)
-
-
-	C Add products src[n]*src[n+1..size-1] at dst[2*n-1...], for
-	C n=1..size-2.
-	C
-	C The last two products, which are the end corner of the product
-	C triangle, are handled separately to save looping overhead.  These
-	C are src[size-3]*src[size-2,size-1] and src[size-2]*src[size-1].
-	C If size is 4 then it's only these that need to be done.
-	C
-	C In the outer loop %esi is a constant, and %edi just advances by 1
-	C limb each time.  The size of the operation decreases by 1 limb
-	C each time.
-
-	C eax
-	C ebx	carry (needing carry flag added)
-	C ecx
-	C edx
-	C esi	&src[size]
-	C edi	&dst[size]
-	C ebp
-
-	adcl	$0, %ebx
-	movl	PARAM_SIZE, %edx
-
-	movl	%ebx, (%edi)
-	subl	$4, %edx
-
-	negl	%edx
-	jz	L(corner)
-
-
-L(outer):
-	C ebx	previous carry limb to store
-	C edx	outer loop counter (negative)
-	C esi	&src[size]
-	C edi	dst, pointing at stored carry limb of previous loop
-
-	pushl	%edx			C new outer loop counter
-	leal	-2(%edx), %ecx
-
-	movl	%ebx, (%edi)
-	addl	$4, %edi
-
-	addl	$4, %ebp
-	xorl	%ebx, %ebx		C initial carry limb, clear carry flag
-
-L(inner):
-	C eax	scratch
-	C ebx	carry (needing carry flag added)
-	C ecx	counter, negative
-	C edx	scratch
-	C esi	&src[size]
-	C edi	dst end of this addmul
-	C ebp	&src[j]
-
-	adcl	$0, %ebx
-	movl	(%esi,%ecx,4), %eax
-
-	mull	(%ebp)
-
-	addl	%ebx, %eax
-	movl	(%edi,%ecx,4), %ebx
-
-	adcl	$0, %edx
-	addl	%eax, %ebx
-
-	movl	%ebx, (%edi,%ecx,4)
-	incl	%ecx
-
-	movl	%edx, %ebx
-	jnz	L(inner)
-
-
-	adcl	$0, %ebx
-	popl	%edx		C outer loop counter
-
-	incl	%edx
-	jnz	L(outer)
-
-
-	movl	%ebx, (%edi)
-
-L(corner):
-	C esi	&src[size]
-	C edi	&dst[2*size-4]
-
-	movl	-8(%esi), %eax
-	movl	-4(%edi), %ebx		C risk of data cache bank clash here
-
-	mull	-12(%esi)		C src[size-2]*src[size-3]
-
-	addl	%eax, %ebx
-	movl	%edx, %ecx
-
-	adcl	$0, %ecx
-	movl	-4(%esi), %eax
-
-	mull	-12(%esi)		C src[size-1]*src[size-3]
-
-	addl	%ecx, %eax
-	movl	(%edi), %ecx
-
-	adcl	$0, %edx
-	movl	%ebx, -4(%edi)
-
-	addl	%eax, %ecx
-	movl	%edx, %ebx
-
-	adcl	$0, %ebx
-	movl	-4(%esi), %eax
-
-	mull	-8(%esi)		C src[size-1]*src[size-2]
-
-	movl	%ecx, 0(%edi)
-	addl	%eax, %ebx
-
-	adcl	$0, %edx
-	movl	PARAM_SIZE, %eax
-
-	negl	%eax
-	movl	%ebx, 4(%edi)
-
-	addl	$1, %eax		C -(size-1) and clear carry
-	movl	%edx, 8(%edi)
-
-
-C -----------------------------------------------------------------------------
-C Left shift of dst[1..2*size-2], high bit shifted out becomes dst[2*size-1].
-
-L(lshift):
-	C eax	counter, negative
-	C ebx	next limb
-	C ecx
-	C edx
-	C esi
-	C edi	&dst[2*size-4]
-	C ebp
-
-	movl	12(%edi,%eax,8), %ebx
-
-	rcll	%ebx
-	movl	16(%edi,%eax,8), %ecx
-	
-	rcll	%ecx
-	movl	%ebx, 12(%edi,%eax,8)
-
-	movl	%ecx, 16(%edi,%eax,8)
-	incl	%eax
-
-	jnz	L(lshift)
-
-
-	adcl	%eax, %eax		C high bit out
-	movl	PARAM_SRC, %esi
-
-	movl	PARAM_SIZE, %ecx	C risk of cache bank clash
-	movl	%eax, 12(%edi)		C dst most significant limb
-
-
-C -----------------------------------------------------------------------------
-C Now add in the squares on the diagonal, namely src[0]^2, src[1]^2, ...,
-C src[size-1]^2.  dst[0] hasn't yet been set at all yet, and just gets the
-C low limb of src[0]^2.
-
-	movl	(%esi), %eax		C src[0]
-	leal	(%esi,%ecx,4), %esi	C src end
-
-	negl	%ecx
-
-	mull	%eax
-
-	movl	%eax, 16(%edi,%ecx,8)	C dst[0]
-	movl	%edx, %ebx
-
-	addl	$1, %ecx		C size-1 and clear carry
-
-L(diag):
-	C eax	scratch (low product)
-	C ebx	carry limb
-	C ecx	counter, negative
-	C edx	scratch (high product)
-	C esi	&src[size]
-	C edi	&dst[2*size-4]
-	C ebp	scratch (fetched dst limbs)
-
-	movl	(%esi,%ecx,4), %eax
-	adcl	$0, %ebx
-
-	mull	%eax
-
-	movl	16-4(%edi,%ecx,8), %ebp
-
-	addl	%ebp, %ebx
-	movl	16(%edi,%ecx,8), %ebp
-
-	adcl	%eax, %ebp
-	movl	%ebx, 16-4(%edi,%ecx,8)
-
-	movl	%ebp, 16(%edi,%ecx,8)
-	incl	%ecx
-
-	movl	%edx, %ebx
-	jnz	L(diag)
-
-
-	adcl	$0, %edx
-	movl	16-4(%edi), %eax	C dst most significant limb
-
-	addl	%eax, %edx
-	popl	%ebp
-
-	movl	%edx, 16-4(%edi)
-	popl	%esi		C risk of cache bank clash
-
-	popl	%edi
-	popl	%ebx
-
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/rshift.asm b/ghc/rts/gmp/mpn/x86/rshift.asm
deleted file mode 100644
index c9881fd966..0000000000
--- a/ghc/rts/gmp/mpn/x86/rshift.asm
+++ /dev/null
@@ -1,92 +0,0 @@
-dnl  x86 mpn_rshift -- mpn right shift.
-
-dnl  Copyright (C) 1992, 1994, 1996, 1999, 2000 Free Software Foundation,
-dnl  Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_rshift (mp_ptr dst, mp_srcptr src, mp_size_t size,
-C                       unsigned shift);
-
-defframe(PARAM_SHIFT,16)
-defframe(PARAM_SIZE, 12)
-defframe(PARAM_SRC,  8)
-defframe(PARAM_DST,  4)
-
-	.text
-	ALIGN(8)
-PROLOGUE(mpn_rshift)
-
-	pushl	%edi
-	pushl	%esi
-	pushl	%ebx
-deflit(`FRAME',12)
-
-	movl	PARAM_DST,%edi
-	movl	PARAM_SRC,%esi
-	movl	PARAM_SIZE,%edx
-	movl	PARAM_SHIFT,%ecx
-
-	leal	-4(%edi,%edx,4),%edi
-	leal	(%esi,%edx,4),%esi
-	negl	%edx
-
-	movl	(%esi,%edx,4),%ebx	C read least significant limb
-	xorl	%eax,%eax
-	shrdl(	%cl, %ebx, %eax)	C compute carry limb
-	incl	%edx
-	jz	L(end)
-	pushl	%eax			C push carry limb onto stack
-	testb	$1,%dl
-	jnz	L(1)			C enter loop in the middle
-	movl	%ebx,%eax
-
-	ALIGN(8)
-L(oop):	movl	(%esi,%edx,4),%ebx	C load next higher limb
-	shrdl(	%cl, %ebx, %eax)	C compute result limb
-	movl	%eax,(%edi,%edx,4)	C store it
-	incl	%edx
-L(1):	movl	(%esi,%edx,4),%eax
-	shrdl(	%cl, %eax, %ebx)
-	movl	%ebx,(%edi,%edx,4)
-	incl	%edx
-	jnz	L(oop)
-
-	shrl	%cl,%eax		C compute most significant limb
-	movl	%eax,(%edi)		C store it
-
-	popl	%eax			C pop carry limb
-
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-L(end):	shrl	%cl,%ebx		C compute most significant limb
-	movl	%ebx,(%edi)		C store it
-
-	popl	%ebx
-	popl	%esi
-	popl	%edi
-	ret
-
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/udiv.asm b/ghc/rts/gmp/mpn/x86/udiv.asm
deleted file mode 100644
index 9fe022b107..0000000000
--- a/ghc/rts/gmp/mpn/x86/udiv.asm
+++ /dev/null
@@ -1,44 +0,0 @@
-dnl  x86 mpn_udiv_qrnnd -- 2 by 1 limb division
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_udiv_qrnnd (mp_limb_t *remptr, mp_limb_t high, mp_limb_t low,
-C                           mp_limb_t divisor);
-
-defframe(PARAM_DIVISOR, 16)
-defframe(PARAM_LOW,     12)
-defframe(PARAM_HIGH,    8)
-defframe(PARAM_REMPTR,  4)
-
-	TEXT
-	ALIGN(8)
-PROLOGUE(mpn_udiv_qrnnd)
-deflit(`FRAME',0)
-	movl	PARAM_LOW, %eax
-	movl	PARAM_HIGH, %edx
-	divl	PARAM_DIVISOR
-	movl	PARAM_REMPTR, %ecx
-	movl	%edx, (%ecx)
-	ret
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/umul.asm b/ghc/rts/gmp/mpn/x86/umul.asm
deleted file mode 100644
index 3d289d1784..0000000000
--- a/ghc/rts/gmp/mpn/x86/umul.asm
+++ /dev/null
@@ -1,43 +0,0 @@
-dnl  mpn_umul_ppmm -- 1x1->2 limb multiplication
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl 
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl 
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl 
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-include(`../config.m4')
-
-
-C mp_limb_t mpn_umul_ppmm (mp_limb_t *lowptr, mp_limb_t m1, mp_limb_t m2);
-C
-
-defframe(PARAM_M2,    12)
-defframe(PARAM_M1,     8)
-defframe(PARAM_LOWPTR, 4)
-
-	TEXT
-	ALIGN(8)
-PROLOGUE(mpn_umul_ppmm)
-deflit(`FRAME',0)
-	movl	PARAM_LOWPTR, %ecx
-	movl	PARAM_M1, %eax
-	mull	PARAM_M2
-	movl	%eax, (%ecx)
-	movl	%edx, %eax
-	ret
-EPILOGUE()
diff --git a/ghc/rts/gmp/mpn/x86/x86-defs.m4 b/ghc/rts/gmp/mpn/x86/x86-defs.m4
deleted file mode 100644
index 2dad698002..0000000000
--- a/ghc/rts/gmp/mpn/x86/x86-defs.m4
+++ /dev/null
@@ -1,713 +0,0 @@
-divert(-1)
-
-dnl  m4 macros for x86 assembler.
-
-
-dnl  Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-dnl 
-dnl  This file is part of the GNU MP Library.
-dnl
-dnl  The GNU MP Library is free software; you can redistribute it and/or
-dnl  modify it under the terms of the GNU Lesser General Public License as
-dnl  published by the Free Software Foundation; either version 2.1 of the
-dnl  License, or (at your option) any later version.
-dnl
-dnl  The GNU MP Library is distributed in the hope that it will be useful,
-dnl  but WITHOUT ANY WARRANTY; without even the implied warranty of
-dnl  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-dnl  Lesser General Public License for more details.
-dnl
-dnl  You should have received a copy of the GNU Lesser General Public
-dnl  License along with the GNU MP Library; see the file COPYING.LIB.  If
-dnl  not, write to the Free Software Foundation, Inc., 59 Temple Place -
-dnl  Suite 330, Boston, MA 02111-1307, USA.
-
-
-dnl  Notes:
-dnl
-dnl  m4 isn't perfect for processing BSD style x86 assembler code, the main
-dnl  problems are,
-dnl
-dnl  1. Doing define(foo,123) and then using foo in an addressing mode like
-dnl     foo(%ebx) expands as a macro rather than a constant.  This is worked
-dnl     around by using deflit() from asm-defs.m4, instead of define().
-dnl
-dnl  2. Immediates in macro definitions need a space or `' to stop the $
-dnl     looking like a macro parameter.  For example,
-dnl
-dnl  	        define(foo, `mov $ 123, %eax')
-dnl
-dnl     This is only a problem in macro definitions, not in ordinary text,
-dnl     nor in macro parameters like text passed to forloop() or ifdef().
-
-
-deflit(BYTES_PER_MP_LIMB, 4)
-
-
-dnl  --------------------------------------------------------------------------
-dnl  Replacement PROLOGUE/EPILOGUE with more sophisticated error checking.
-dnl  Nesting and overlapping not allowed.
-dnl
-
-
-dnl  Usage: PROLOGUE(functionname)
-dnl
-dnl  Generate a function prologue.  functionname gets GSYM_PREFIX added.
-dnl  Examples,
-dnl
-dnl         PROLOGUE(mpn_add_n)
-dnl         PROLOGUE(somefun)
-
-define(`PROLOGUE',
-m4_assert_numargs(1)
-m4_assert_defined(`PROLOGUE_cpu')
-`ifdef(`PROLOGUE_current_function',
-`m4_error(`PROLOGUE'(`PROLOGUE_current_function') needs an `EPILOGUE'() before `PROLOGUE'($1)
-)')dnl
-m4_file_seen()dnl
-define(`PROLOGUE_current_function',`$1')dnl
-PROLOGUE_cpu(GSYM_PREFIX`'$1)')
-
-
-dnl  Usage: EPILOGUE()
-dnl
-dnl  Notice the function name is passed to EPILOGUE_cpu(), letting it use $1
-dnl  instead of the long PROLOGUE_current_function symbol.
-
-define(`EPILOGUE',
-m4_assert_numargs(0)
-m4_assert_defined(`EPILOGUE_cpu')
-`ifdef(`PROLOGUE_current_function',,
-`m4_error(`EPILOGUE'() with no `PROLOGUE'()
-)')dnl
-EPILOGUE_cpu(GSYM_PREFIX`'PROLOGUE_current_function)`'dnl
-undefine(`PROLOGUE_current_function')')
-
-m4wrap_prepend(
-`ifdef(`PROLOGUE_current_function',
-`m4_error(`EPILOGUE() for PROLOGUE('PROLOGUE_current_function`) never seen
-')')')
-
-
-dnl  Usage: PROLOGUE_assert_inside()
-dnl
-dnl  Use this unquoted on a line on its own at the start of a macro
-dnl  definition to add some code to check the macro is only used inside a
-dnl  PROLOGUE/EPILOGUE pair, and that hence PROLOGUE_current_function is
-dnl  defined.
-
-define(PROLOGUE_assert_inside,
-m4_assert_numargs(0)
-``PROLOGUE_assert_inside_internal'(m4_doublequote($`'0))`dnl '')
-
-define(PROLOGUE_assert_inside_internal,
-m4_assert_numargs(1)
-`ifdef(`PROLOGUE_current_function',,
-`m4_error(`$1 used outside a PROLOGUE / EPILOGUE pair
-')')')
-
-
-dnl  Usage: L(labelname)
-dnl         LF(functionname,labelname)
-dnl
-dnl  Generate a local label in the current or given function.  For LF(),
-dnl  functionname gets GSYM_PREFIX added, the same as with PROLOGUE().
-dnl
-dnl  For example, in a function mpn_add_n (and with MPN_PREFIX __gmpn),
-dnl
-dnl         L(bar)          => L__gmpn_add_n__bar
-dnl         LF(somefun,bar) => Lsomefun__bar
-dnl
-dnl  The funtion name and label name get two underscores between them rather
-dnl  than one to guard against clashing with a separate external symbol that
-dnl  happened to be called functionname_labelname.  (Though this would only
-dnl  happen if the local label prefix is is empty.)  Underscores are used so
-dnl  the whole label will still be a valid C identifier and so can be easily
-dnl  used in gdb.
-
-dnl  LSYM_PREFIX can be L$, so defn() is used to prevent L expanding as the
-dnl  L macro and making an infinite recursion.
-define(LF,
-m4_assert_numargs(2)
-m4_assert_defined(`LSYM_PREFIX')
-`defn(`LSYM_PREFIX')GSYM_PREFIX`'$1`'__$2')
-
-define(`L',
-m4_assert_numargs(1)
-PROLOGUE_assert_inside()
-`LF(PROLOGUE_current_function,`$1')')
-
-
-dnl  Called: PROLOGUE_cpu(gsym)
-dnl          EPILOGUE_cpu(gsym)
-
-define(PROLOGUE_cpu,
-m4_assert_numargs(1)
-	`GLOBL	$1
-	TYPE($1,`function')
-$1:')
-
-define(EPILOGUE_cpu,
-m4_assert_numargs(1)
-`	SIZE($1,.-$1)')
-
-
-
-dnl  --------------------------------------------------------------------------
-dnl  Various x86 macros.
-dnl
-
-
-dnl  Usage: ALIGN_OFFSET(bytes,offset)
-dnl
-dnl  Align to `offset' away from a multiple of `bytes'.
-dnl
-dnl  This is useful for testing, for example align to something very strict
-dnl  and see what effect offsets from it have, "ALIGN_OFFSET(256,32)".
-dnl
-dnl  Generally you wouldn't execute across the padding, but it's done with
-dnl  nop's so it'll work.
-
-define(ALIGN_OFFSET,
-m4_assert_numargs(2)
-`ALIGN($1)
-forloop(`i',1,$2,`	nop
-')')
-
-
-dnl  Usage: defframe(name,offset)
-dnl
-dnl  Make a definition like the following with which to access a parameter
-dnl  or variable on the stack.
-dnl
-dnl         define(name,`FRAME+offset(%esp)')
-dnl
-dnl  Actually m4_empty_if_zero(FRAME+offset) is used, which will save one
-dnl  byte if FRAME+offset is zero, by putting (%esp) rather than 0(%esp).
-dnl  Use define(`defframe_empty_if_zero_disabled',1) if for some reason the
-dnl  zero offset is wanted.
-dnl
-dnl  The new macro also gets a check that when it's used FRAME is actually
-dnl  defined, and that the final %esp offset isn't negative, which would
-dnl  mean an attempt to access something below the current %esp.
-dnl
-dnl  deflit() is used rather than a plain define(), so the new macro won't
-dnl  delete any following parenthesized expression.  name(%edi) will come
-dnl  out say as 16(%esp)(%edi).  This isn't valid assembler and should
-dnl  provoke an error, which is better than silently giving just 16(%esp).
-dnl
-dnl  See README.family for more on the suggested way to access the stack
-dnl  frame.
-
-define(defframe,
-m4_assert_numargs(2)
-`deflit(`$1',
-m4_assert_defined(`FRAME')
-`defframe_check_notbelow(`$1',$2,FRAME)dnl
-defframe_empty_if_zero(FRAME+($2))(%esp)')')
-
-dnl  Called: defframe_empty_if_zero(expression)
-define(defframe_empty_if_zero,
-`ifelse(defframe_empty_if_zero_disabled,1,
-`eval($1)',
-`m4_empty_if_zero($1)')')
-
-dnl  Called: defframe_check_notbelow(`name',offset,FRAME)
-define(defframe_check_notbelow,
-m4_assert_numargs(3)
-`ifelse(eval(($3)+($2)<0),1,
-`m4_error(`$1 at frame offset $2 used when FRAME is only $3 bytes
-')')')
-
-
-dnl  Usage: FRAME_pushl()
-dnl         FRAME_popl()
-dnl         FRAME_addl_esp(n)
-dnl         FRAME_subl_esp(n)
-dnl
-dnl  Adjust FRAME appropriately for a pushl or popl, or for an addl or subl
-dnl  %esp of n bytes.
-dnl
-dnl  Using these macros is completely optional.  Sometimes it makes more
-dnl  sense to put explicit deflit(`FRAME',N) forms, especially when there's
-dnl  jumps and different sequences of FRAME values need to be used in
-dnl  different places.
-
-define(FRAME_pushl,
-m4_assert_numargs(0)
-m4_assert_defined(`FRAME')
-`deflit(`FRAME',eval(FRAME+4))')
-
-define(FRAME_popl,
-m4_assert_numargs(0)
-m4_assert_defined(`FRAME')
-`deflit(`FRAME',eval(FRAME-4))')
-
-define(FRAME_addl_esp,
-m4_assert_numargs(1)
-m4_assert_defined(`FRAME')
-`deflit(`FRAME',eval(FRAME-($1)))')
-
-define(FRAME_subl_esp,
-m4_assert_numargs(1)
-m4_assert_defined(`FRAME')
-`deflit(`FRAME',eval(FRAME+($1)))')
-
-
-dnl  Usage: defframe_pushl(name)
-dnl
-dnl  Do a combination of a FRAME_pushl() and a defframe() to name the stack
-dnl  location just pushed.  This should come after a pushl instruction.
-dnl  Putting it on the same line works and avoids lengthening the code.  For
-dnl  example,
-dnl
-dnl         pushl   %eax     defframe_pushl(VAR_COUNTER)
-dnl
-dnl  Notice the defframe() is done with an unquoted -FRAME thus giving its
-dnl  current value without tracking future changes.
-
-define(defframe_pushl,
-`FRAME_pushl()defframe(`$1',-FRAME)')
-
-
-dnl  --------------------------------------------------------------------------
-dnl  Assembler instruction macros.
-dnl
-
-
-dnl  Usage: emms_or_femms
-dnl         femms_available_p
-dnl
-dnl  femms_available_p expands to 1 or 0 according to whether the AMD 3DNow
-dnl  femms instruction is available.  emms_or_femms expands to femms if
-dnl  available, or emms if not.
-dnl
-dnl  emms_or_femms is meant for use in the K6 directory where plain K6
-dnl  (without femms) and K6-2 and K6-3 (with a slightly faster femms) are
-dnl  supported together.
-dnl
-dnl  On K7 femms is no longer faster and is just an alias for emms, so plain
-dnl  emms may as well be used.
-
-define(femms_available_p,
-m4_assert_numargs(-1)
-`m4_ifdef_anyof_p(
-	`HAVE_TARGET_CPU_k62',
-	`HAVE_TARGET_CPU_k63',
-	`HAVE_TARGET_CPU_athlon')')
-
-define(emms_or_femms,
-m4_assert_numargs(-1)
-`ifelse(femms_available_p,1,`femms',`emms')')
-
-
-dnl  Usage: femms
-dnl
-dnl  The gas 2.9.1 that comes with FreeBSD 3.4 doesn't support femms, so the
-dnl  following is a replacement using .byte.
-dnl
-dnl  If femms isn't available, an emms is generated instead, for convenience
-dnl  when testing on a machine without femms.
-
-define(femms,
-m4_assert_numargs(-1)
-`ifelse(femms_available_p,1,
-`.byte	15,14	C AMD 3DNow femms',
-`emms`'dnl
-m4_warning(`warning, using emms in place of femms, use for testing only
-')')')
-
-
-dnl  Usage: jadcl0(op)
-dnl
-dnl  Issue a jnc/incl as a substitute for adcl $0,op.  This isn't an exact
-dnl  replacement, since it doesn't set the flags like adcl does.
-dnl
-dnl  This finds a use in K6 mpn_addmul_1, mpn_submul_1, mpn_mul_basecase and
-dnl  mpn_sqr_basecase because on K6 an adcl is slow, the branch
-dnl  misprediction penalty is small, and the multiply algorithm used leads
-dnl  to a carry bit on average only 1/4 of the time.
-dnl
-dnl  jadcl0_disabled can be set to 1 to instead issue an ordinary adcl for
-dnl  comparison.  For example,
-dnl
-dnl		define(`jadcl0_disabled',1)
-dnl
-dnl  When using a register operand, eg. "jadcl0(%edx)", the jnc/incl code is
-dnl  the same size as an adcl.  This makes it possible to use the exact same
-dnl  computed jump code when testing the relative speed of jnc/incl and adcl
-dnl  with jadcl0_disabled.
-
-define(jadcl0,
-m4_assert_numargs(1)
-`ifelse(jadcl0_disabled,1,
-	`adcl	$`'0, $1',
-	`jnc	1f
-	incl	$1
-1:dnl')')
-
-
-dnl  Usage: cmov_available_p
-dnl
-dnl  Expand to 1 if cmov is available, 0 if not.
-
-define(cmov_available_p,
-`m4_ifdef_anyof_p(
-	`HAVE_TARGET_CPU_pentiumpro',
-	`HAVE_TARGET_CPU_pentium2',
-	`HAVE_TARGET_CPU_pentium3',
-	`HAVE_TARGET_CPU_athlon')')
-
-
-dnl  Usage: x86_lookup(target, key,value, key,value, ...)
-dnl         x86_lookup_p(target, key,value, key,value, ...)
-dnl
-dnl  Look for `target' among the `key' parameters.
-dnl
-dnl  x86_lookup expands to the corresponding `value', or generates an error
-dnl  if `target' isn't found.
-dnl
-dnl  x86_lookup_p expands to 1 if `target' is found, or 0 if not.
-
-define(x86_lookup,
-`ifelse(eval($#<3),1,
-`m4_error(`unrecognised part of x86 instruction: $1
-')',
-`ifelse(`$1',`$2', `$3',
-`x86_lookup(`$1',shift(shift(shift($@))))')')')
-
-define(x86_lookup_p,
-`ifelse(eval($#<3),1, `0',
-`ifelse(`$1',`$2',    `1',
-`x86_lookup_p(`$1',shift(shift(shift($@))))')')')
-
-
-dnl  Usage: x86_opcode_reg32(reg)
-dnl         x86_opcode_reg32_p(reg)
-dnl
-dnl  x86_opcode_reg32 expands to the standard 3 bit encoding for the given
-dnl  32-bit register, eg. `%ebp' turns into 5.
-dnl
-dnl  x86_opcode_reg32_p expands to 1 if reg is a valid 32-bit register, or 0
-dnl  if not.
-
-define(x86_opcode_reg32,
-m4_assert_numargs(1)
-`x86_lookup(`$1',x86_opcode_reg32_list)')
-
-define(x86_opcode_reg32_p,
-m4_assert_onearg()
-`x86_lookup_p(`$1',x86_opcode_reg32_list)')
-
-define(x86_opcode_reg32_list,
-``%eax',0,
-`%ecx',1,
-`%edx',2,
-`%ebx',3,
-`%esp',4,
-`%ebp',5,
-`%esi',6,
-`%edi',7')
-
-
-dnl  Usage: x86_opcode_tttn(cond)
-dnl
-dnl  Expand to the 4-bit "tttn" field value for the given x86 branch
-dnl  condition (like `c', `ae', etc).
-
-define(x86_opcode_tttn,
-m4_assert_numargs(1)
-`x86_lookup(`$1',x86_opcode_ttn_list)')
-
-define(x86_opcode_tttn_list,
-``o',  0,
-`no',  1,
-`b',   2, `c',  2, `nae',2,
-`nb',  3, `nc', 3, `ae', 3,
-`e',   4, `z',  4,
-`ne',  5, `nz', 5,
-`be',  6, `na', 6,
-`nbe', 7, `a',  7,
-`s',   8,
-`ns',  9,
-`p',  10, `pe', 10, `npo',10,
-`np', 11, `npe',11, `po', 11,
-`l',  12, `nge',12,
-`nl', 13, `ge', 13,
-`le', 14, `ng', 14,
-`nle',15, `g',  15')
-
-
-dnl  Usage: cmovCC(srcreg,dstreg)
-dnl
-dnl  Generate a cmov instruction if the target supports cmov, or simulate it
-dnl  with a conditional jump if not (the latter being meant only for
-dnl  testing).  For example,
-dnl
-dnl         cmovz(  %eax, %ebx)
-dnl
-dnl  cmov instructions are generated using .byte sequences, since only
-dnl  recent versions of gas know cmov.
-dnl
-dnl  The source operand can only be a plain register.  (m4 code implementing
-dnl  full memory addressing modes exists, believe it or not, but isn't
-dnl  currently needed and isn't included.)
-dnl
-dnl  All the standard conditions are defined.  Attempting to use one without
-dnl  the macro parentheses, such as just "cmovbe %eax, %ebx", will provoke
-dnl  an error.  This ensures the necessary .byte sequences aren't
-dnl  accidentally missed.
-
-dnl  Called: define_cmov_many(cond,tttn,cond,tttn,...)
-define(define_cmov_many,
-`ifelse(m4_length(`$1'),0,,
-`define_cmov(`$1',`$2')define_cmov_many(shift(shift($@)))')')
-
-dnl  Called: define_cmov(cond,tttn)
-define(define_cmov,
-m4_assert_numargs(2)
-`define(`cmov$1',
-m4_instruction_wrapper()
-m4_assert_numargs(2)
-`cmov_internal'(m4_doublequote($`'0),``$1',`$2'',dnl
-m4_doublequote($`'1),m4_doublequote($`'2)))')
-
-define_cmov_many(x86_opcode_tttn_list)
-
-
-dnl  Called: cmov_internal(name,cond,tttn,src,dst)
-define(cmov_internal,
-m4_assert_numargs(5)
-`ifelse(cmov_available_p,1,
-`cmov_bytes_tttn(`$1',`$3',`$4',`$5')',
-`m4_warning(`warning, simulating cmov with jump, use for testing only
-')cmov_simulate(`$2',`$4',`$5')')')
-
-dnl  Called: cmov_simulate(cond,src,dst)
-dnl  If this is going to be used with memory operands for the source it will
-dnl  need to be changed to do a fetch even if the condition is false, so as
-dnl  to trigger exceptions the same way a real cmov does.
-define(cmov_simulate,
-m4_assert_numargs(3)
-	`j$1	1f	C cmov$1 $2, $3
-	jmp	2f
-1:	movl	$2, $3
-2:')
-
-dnl  Called: cmov_bytes_tttn(name,tttn,src,dst)
-define(cmov_bytes_tttn,
-m4_assert_numargs(4)
-`.byte	dnl
-15, dnl
-eval(64+$2), dnl
-eval(192+8*x86_opcode_reg32(`$4')+x86_opcode_reg32(`$3')) dnl
-	C `$1 $3, $4'')
-
-
-dnl  Usage: loop_or_decljnz label
-dnl
-dnl  Generate either a "loop" instruction or a "decl %ecx / jnz", whichever
-dnl  is better.  "loop" is better on K6 and probably on 386, on other chips
-dnl  separate decl/jnz is better.
-dnl
-dnl  This macro is just for mpn/x86/divrem_1.asm and mpn/x86/mod_1.asm where
-dnl  this loop_or_decljnz variation is enough to let the code be shared by
-dnl  all chips.
-
-define(loop_or_decljnz,
-`ifelse(loop_is_better_p,1,
-	`loop',
-	`decl	%ecx
-	jnz')')
-
-define(loop_is_better_p,
-`m4_ifdef_anyof_p(`HAVE_TARGET_CPU_k6',
-                  `HAVE_TARGET_CPU_k62',
-                  `HAVE_TARGET_CPU_k63',
-                  `HAVE_TARGET_CPU_i386')')
-
-
-dnl  Usage: Zdisp(inst,op,op,op)
-dnl
-dnl  Generate explicit .byte sequences if necessary to force a byte-sized
-dnl  zero displacement on an instruction.  For example,
-dnl
-dnl         Zdisp(  movl,   0,(%esi), %eax)
-dnl
-dnl  expands to
-dnl
-dnl                 .byte   139,70,0  C movl 0(%esi), %eax
-dnl
-dnl  If the displacement given isn't 0, then normal assembler code is
-dnl  generated.  For example,
-dnl
-dnl         Zdisp(  movl,   4,(%esi), %eax)
-dnl
-dnl  expands to
-dnl
-dnl                 movl    4(%esi), %eax
-dnl
-dnl  This means a single Zdisp() form can be used with an expression for the
-dnl  displacement, and .byte will be used only if necessary.  The
-dnl  displacement argument is eval()ed.
-dnl
-dnl  Because there aren't many places a 0(reg) form is wanted, Zdisp is
-dnl  implemented with a table of instructions and encodings.  A new entry is
-dnl  needed for any different operation or registers.
-
-define(Zdisp,
-`define(`Zdisp_found',0)dnl
-Zdisp_match( movl, %eax, 0,(%edi), `137,71,0',    $@)`'dnl
-Zdisp_match( movl, %ebx, 0,(%edi), `137,95,0',    $@)`'dnl
-Zdisp_match( movl, %esi, 0,(%edi), `137,119,0',   $@)`'dnl
-Zdisp_match( movl, 0,(%ebx), %eax, `139,67,0',    $@)`'dnl
-Zdisp_match( movl, 0,(%ebx), %esi, `139,115,0',   $@)`'dnl
-Zdisp_match( movl, 0,(%esi), %eax, `139,70,0',    $@)`'dnl
-Zdisp_match( movl, 0,(%esi,%ecx,4), %eax, `0x8b,0x44,0x8e,0x00',      $@)`'dnl
-Zdisp_match( addl, %ebx, 0,(%edi), `1,95,0',      $@)`'dnl
-Zdisp_match( addl, %ecx, 0,(%edi), `1,79,0',      $@)`'dnl
-Zdisp_match( addl, %esi, 0,(%edi), `1,119,0',     $@)`'dnl
-Zdisp_match( subl, %ecx, 0,(%edi), `41,79,0',     $@)`'dnl
-Zdisp_match( adcl, 0,(%edx), %esi, `19,114,0',    $@)`'dnl
-Zdisp_match( sbbl, 0,(%edx), %esi, `27,114,0',    $@)`'dnl
-Zdisp_match( movq, 0,(%eax,%ecx,8), %mm0, `0x0f,0x6f,0x44,0xc8,0x00', $@)`'dnl
-Zdisp_match( movq, 0,(%ebx,%eax,4), %mm0, `0x0f,0x6f,0x44,0x83,0x00', $@)`'dnl
-Zdisp_match( movq, 0,(%ebx,%eax,4), %mm2, `0x0f,0x6f,0x54,0x83,0x00', $@)`'dnl
-Zdisp_match( movq, 0,(%esi),        %mm0, `15,111,70,0',     $@)`'dnl
-Zdisp_match( movq, %mm0,        0,(%edi), `15,127,71,0',     $@)`'dnl
-Zdisp_match( movq, %mm2, 0,(%ecx,%eax,4), `0x0f,0x7f,0x54,0x81,0x00', $@)`'dnl
-Zdisp_match( movq, %mm2, 0,(%edx,%eax,4), `0x0f,0x7f,0x54,0x82,0x00', $@)`'dnl
-Zdisp_match( movq, %mm0, 0,(%edx,%ecx,8), `0x0f,0x7f,0x44,0xca,0x00', $@)`'dnl
-Zdisp_match( movd, 0,(%eax,%ecx,8), %mm1, `0x0f,0x6e,0x4c,0xc8,0x00', $@)`'dnl
-Zdisp_match( movd, 0,(%edx,%ecx,8), %mm0, `0x0f,0x6e,0x44,0xca,0x00', $@)`'dnl
-Zdisp_match( movd, %mm0, 0,(%eax,%ecx,4), `0x0f,0x7e,0x44,0x88,0x00', $@)`'dnl
-Zdisp_match( movd, %mm0, 0,(%ecx,%eax,4), `0x0f,0x7e,0x44,0x81,0x00', $@)`'dnl
-Zdisp_match( movd, %mm2, 0,(%ecx,%eax,4), `0x0f,0x7e,0x54,0x81,0x00', $@)`'dnl
-ifelse(Zdisp_found,0,
-`m4_error(`unrecognised instruction in Zdisp: $1 $2 $3 $4
-')')')
-
-define(Zdisp_match,
-`ifelse(eval(m4_stringequal_p(`$1',`$6')
-	&& m4_stringequal_p(`$2',0)
-	&& m4_stringequal_p(`$3',`$8')
-	&& m4_stringequal_p(`$4',`$9')),1,
-`define(`Zdisp_found',1)dnl
-ifelse(eval(`$7'),0,
-`	.byte	$5  C `$1 0$3, $4'',
-`	$6	$7$8, $9')',
-
-`ifelse(eval(m4_stringequal_p(`$1',`$6')
-	&& m4_stringequal_p(`$2',`$7')
-	&& m4_stringequal_p(`$3',0)
-	&& m4_stringequal_p(`$4',`$9')),1,
-`define(`Zdisp_found',1)dnl
-ifelse(eval(`$8'),0,
-`	.byte	$5  C `$1 $2, 0$4'',
-`	$6	$7, $8$9')')')')
-
-
-dnl  Usage: shldl(count,src,dst)
-dnl         shrdl(count,src,dst)
-dnl         shldw(count,src,dst)
-dnl         shrdw(count,src,dst)
-dnl
-dnl  Generate a double-shift instruction, possibly omitting a %cl count
-dnl  parameter if that's what the assembler requires, as indicated by
-dnl  WANT_SHLDL_CL in config.m4.  For example,
-dnl
-dnl         shldl(  %cl, %eax, %ebx)
-dnl
-dnl  turns into either
-dnl
-dnl         shldl   %cl, %eax, %ebx
-dnl  or
-dnl         shldl   %eax, %ebx
-dnl
-dnl  Immediate counts are always passed through unchanged.  For example,
-dnl
-dnl         shrdl(  $2, %esi, %edi)
-dnl  becomes
-dnl         shrdl   $2, %esi, %edi
-dnl
-dnl
-dnl  If you forget to use the macro form "shldl( ...)" and instead write
-dnl  just a plain "shldl ...", an error results.  This ensures the necessary
-dnl  variant treatment of %cl isn't accidentally bypassed.
-
-define(define_shd_instruction,
-`define($1,
-m4_instruction_wrapper()
-m4_assert_numargs(3)
-`shd_instruction'(m4_doublequote($`'0),m4_doublequote($`'1),dnl
-m4_doublequote($`'2),m4_doublequote($`'3)))')
-
-dnl  Effectively: define(shldl,`shd_instruction(`$0',`$1',`$2',`$3')') etc
-define_shd_instruction(shldl)
-define_shd_instruction(shrdl)
-define_shd_instruction(shldw)
-define_shd_instruction(shrdw)
-
-dnl  Called: shd_instruction(op,count,src,dst)
-define(shd_instruction,
-m4_assert_numargs(4)
-m4_assert_defined(`WANT_SHLDL_CL')
-`ifelse(eval(m4_stringequal_p(`$2',`%cl') && !WANT_SHLDL_CL),1,
-``$1'	`$3', `$4'',
-``$1'	`$2', `$3', `$4'')')
-
-
-dnl  Usage: ASSERT(cond, instructions)
-dnl
-dnl  If WANT_ASSERT is 1, output the given instructions and expect the given
-dnl  flags condition to then be satisfied.  For example,
-dnl
-dnl         ASSERT(ne, `cmpl %eax, %ebx')
-dnl
-dnl  The instructions can be omitted to just assert a flags condition with
-dnl  no extra calculation.  For example,
-dnl
-dnl         ASSERT(nc)
-dnl
-dnl  When `instructions' is not empty, a pushf/popf is added to preserve the
-dnl  flags, but the instructions themselves must preserve any registers that
-dnl  matter.  FRAME is adjusted for the push and pop, so the instructions
-dnl  given can use defframe() stack variables.
-
-define(ASSERT,
-m4_assert_numargs_range(1,2)
-`ifelse(WANT_ASSERT,1,
-	`C ASSERT
-ifelse(`$2',,,`	pushf	ifdef(`FRAME',`FRAME_pushl()')')
-	$2
-	j`$1'	1f
-	ud2	C assertion failed
-1:
-ifelse(`$2',,,`	popf	ifdef(`FRAME',`FRAME_popl()')')
-')')
-
-
-dnl  Usage: movl_text_address(label,register)
-dnl
-dnl  Get the address of a text segment label, using either a plain movl or a
-dnl  position-independent calculation, as necessary.  For example,
-dnl
-dnl         movl_code_address(L(foo),%eax)
-dnl
-dnl  This macro is only meant for use in ASSERT()s or when testing, since
-dnl  the PIC sequence it generates will want to be done with a ret balancing
-dnl  the call on CPUs with return address branch predition.
-dnl
-dnl  The addl generated here has a backward reference to 1b, and so won't
-dnl  suffer from the two forwards references bug in old gas (described in
-dnl  mpn/x86/README.family).
-
-define(movl_text_address,
-`ifdef(`PIC',
-	`call	1f
-1:	popl	$2	C %eip
-	addl	`$'$1-1b, $2',
-	`movl	`$'$1, $2')')
-
-
-divert`'dnl
diff --git a/ghc/rts/gmp/mpn/z8000/add_n.s b/ghc/rts/gmp/mpn/z8000/add_n.s
deleted file mode 100644
index 3a136107fe..0000000000
--- a/ghc/rts/gmp/mpn/z8000/add_n.s
+++ /dev/null
@@ -1,53 +0,0 @@
-! Z8000 __gmpn_add_n -- Add two limb vectors of equal, non-zero length.
-
-! Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	r7
-! s1_ptr	r6
-! s2_ptr	r5
-! size		r4
-
-! If we are really crazy, we can use push to write a few result words
-! backwards, using push just because it is faster than reg+disp.  We'd
-! then add 2x the number of words written to r7...
-
-	unseg
-	.text
-	even
-	global ___gmpn_add_n
-___gmpn_add_n:
-	pop	r0,@r6
-	pop	r1,@r5
-	add	r0,r1
-	ld	@r7,r0
-	dec	r4
-	jr	eq,Lend
-Loop:	pop	r0,@r6
-	pop	r1,@r5
-	adc	r0,r1
-	inc	r7,#2
-	ld	@r7,r0
-	dec	r4
-	jr	ne,Loop
-Lend:	ld	r2,r4		! use 0 already in r4
-	adc	r2,r2
-	ret	t
diff --git a/ghc/rts/gmp/mpn/z8000/gmp-mparam.h b/ghc/rts/gmp/mpn/z8000/gmp-mparam.h
deleted file mode 100644
index 4216df673c..0000000000
--- a/ghc/rts/gmp/mpn/z8000/gmp-mparam.h
+++ /dev/null
@@ -1,27 +0,0 @@
-/* gmp-mparam.h -- Compiler/machine parameter header file.
-
-Copyright (C) 1991, 1993, 1994 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#define BITS_PER_MP_LIMB 16
-#define BYTES_PER_MP_LIMB 2
-#define BITS_PER_LONGINT 32
-#define BITS_PER_INT 16
-#define BITS_PER_SHORTINT 16
-#define BITS_PER_CHAR 8
diff --git a/ghc/rts/gmp/mpn/z8000/mul_1.s b/ghc/rts/gmp/mpn/z8000/mul_1.s
deleted file mode 100644
index 20fadd340a..0000000000
--- a/ghc/rts/gmp/mpn/z8000/mul_1.s
+++ /dev/null
@@ -1,68 +0,0 @@
-! Z8000 __gmpn_mul_1 -- Multiply a limb vector with a limb and store
-! the result in a second limb vector.
-
-! Copyright (C) 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	r7
-! s1_ptr	r6
-! size		r5
-! s2_limb	r4
-
-	unseg
-	.text
-	even
-	global ___gmpn_mul_1
-___gmpn_mul_1:
-	sub	r2,r2		! zero carry limb
-	and	r4,r4
-	jr	mi,Lneg
-
-Lpos:	pop	r1,@r6
-	ld	r9,r1
-	mult	rr8,r4
-	and	r1,r1		! shift msb of loaded limb into cy
-	jr	mi,Lp		! branch if loaded limb's msb is set
-	add	r8,r4		! hi_limb += sign_comp2
-Lp:	add	r9,r2		! lo_limb += cy_limb
-	xor	r2,r2
-	adc	r2,r8
-	ld	@r7,r9
-	inc	r7,#2
-	dec	r5
-	jr	ne,Lpos
-	ret t
-
-Lneg:	pop	r1,@r6
-	ld	r9,r1
-	mult	rr8,r4
-	add	r8,r1		! hi_limb += sign_comp1
-	and	r1,r1
-	jr	mi,Ln
-	add	r8,r4		! hi_limb += sign_comp2
-Ln:	add	r9,r2		! lo_limb += cy_limb
-	xor	r2,r2
-	adc	r2,r8
-	ld	@r7,r9
-	inc	r7,#2
-	dec	r5
-	jr	ne,Lneg
-	ret t
diff --git a/ghc/rts/gmp/mpn/z8000/sub_n.s b/ghc/rts/gmp/mpn/z8000/sub_n.s
deleted file mode 100644
index bd9a7ad409..0000000000
--- a/ghc/rts/gmp/mpn/z8000/sub_n.s
+++ /dev/null
@@ -1,54 +0,0 @@
-! Z8000 __gmpn_sub_n -- Subtract two limb vectors of the same length > 0 and
-! store difference in a third limb vector.
-
-! Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	r7
-! s1_ptr	r6
-! s2_ptr	r5
-! size		r4
-
-! If we are really crazy, we can use push to write a few result words
-! backwards, using push just because it is faster than reg+disp.  We'd
-! then add 2x the number of words written to r7...
-
-	unseg
-	.text
-	even
-	global ___gmpn_sub_n
-___gmpn_sub_n:
-	pop	r0,@r6
-	pop	r1,@r5
-	sub	r0,r1
-	ld	@r7,r0
-	dec	r4
-	jr	eq,Lend
-Loop:	pop	r0,@r6
-	pop	r1,@r5
-	sbc	r0,r1
-	inc	r7,#2
-	ld	@r7,r0
-	dec	r4
-	jr	ne,Loop
-Lend:	ld	r2,r4		! use 0 already in r4
-	adc	r2,r2
-	ret	t
diff --git a/ghc/rts/gmp/mpn/z8000x/add_n.s b/ghc/rts/gmp/mpn/z8000x/add_n.s
deleted file mode 100644
index 7f130785c5..0000000000
--- a/ghc/rts/gmp/mpn/z8000x/add_n.s
+++ /dev/null
@@ -1,56 +0,0 @@
-! Z8000 (32 bit limb version) __gmpn_add_n -- Add two limb vectors of equal,
-! non-zero length.
-
-! Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	r7
-! s1_ptr	r6
-! s2_ptr	r5
-! size		r4
-
-! If we are really crazy, we can use push to write a few result words
-! backwards, using push just because it is faster than reg+disp.  We'd
-! then add 2x the number of words written to r7...
-
-	segm
-	.text
-	even
-	global ___gmpn_add_n
-___gmpn_add_n:
-	popl	rr0,@r6
-	popl	rr8,@r5
-	addl	rr0,rr8
-	ldl	@r7,rr0
-	dec	r4
-	jr	eq,Lend
-Loop:	popl	rr0,@r6
-	popl	rr8,@r5
-	adc	r1,r9
-	adc	r0,r8
-	inc	r7,#4
-	ldl	@r7,rr0
-	dec	r4
-	jr	ne,Loop
-Lend:	ld	r2,r4		! use 0 already in r4
-	ld	r3,r4
-	adc	r2,r2
-	ret	t
diff --git a/ghc/rts/gmp/mpn/z8000x/sub_n.s b/ghc/rts/gmp/mpn/z8000x/sub_n.s
deleted file mode 100644
index f416d1d6eb..0000000000
--- a/ghc/rts/gmp/mpn/z8000x/sub_n.s
+++ /dev/null
@@ -1,56 +0,0 @@
-! Z8000 (32 bit limb version) __gmpn_sub_n -- Subtract two limb vectors of the
-! same length > 0 and store difference in a third limb vector.
-
-! Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc.
-
-! This file is part of the GNU MP Library.
-
-! The GNU MP Library is free software; you can redistribute it and/or modify
-! it under the terms of the GNU Lesser General Public License as published by
-! the Free Software Foundation; either version 2.1 of the License, or (at your
-! option) any later version.
-
-! The GNU MP Library is distributed in the hope that it will be useful, but
-! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-! License for more details.
-
-! You should have received a copy of the GNU Lesser General Public License
-! along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-! the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-! MA 02111-1307, USA.
-
-
-! INPUT PARAMETERS
-! res_ptr	r7
-! s1_ptr	r6
-! s2_ptr	r5
-! size		r4
-
-! If we are really crazy, we can use push to write a few result words
-! backwards, using push just because it is faster than reg+disp.  We'd
-! then add 2x the number of words written to r7...
-
-	segm
-	.text
-	even
-	global ___gmpn_sub_n
-___gmpn_sub_n:
-	popl	rr0,@r6
-	popl	rr8,@r5
-	subl	rr0,rr8
-	ldl	@r7,rr0
-	dec	r4
-	jr	eq,Lend
-Loop:	popl	rr0,@r6
-	popl	rr8,@r5
-	sbc	r1,r9
-	sbc	r0,r8
-	inc	r7,#4
-	ldl	@r7,rr0
-	dec	r4
-	jr	ne,Loop
-Lend:	ld	r2,r4		! use 0 already in r4
-	ld	r3,r4
-	adc	r2,r2
-	ret	t
diff --git a/ghc/rts/gmp/mpz/Makefile.am b/ghc/rts/gmp/mpz/Makefile.am
deleted file mode 100644
index cd6fec4e21..0000000000
--- a/ghc/rts/gmp/mpz/Makefile.am
+++ /dev/null
@@ -1,58 +0,0 @@
-## Process this file with automake to generate Makefile.in
-
-# Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
-#
-# This file is part of the GNU MP Library.
-#
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-#
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-AUTOMAKE_OPTIONS = gnu no-dependencies
-
-SUBDIRS = tests
-
-INCLUDES = -I$(top_srcdir) -DOPERATION_$*
-
-noinst_LTLIBRARIES = libmpz.la
-libmpz_la_SOURCES = \
-  abs.c add.c add_ui.c addmul_ui.c and.c array_init.c \
-  bin_ui.c bin_uiui.c cdiv_q.c \
-  cdiv_q_ui.c cdiv_qr.c cdiv_qr_ui.c cdiv_r.c cdiv_r_ui.c cdiv_ui.c \
-  clear.c clrbit.c cmp.c cmp_si.c cmp_ui.c cmpabs.c cmpabs_ui.c com.c \
-  divexact.c dump.c fac_ui.c fdiv_q.c fdiv_q_2exp.c fdiv_q_ui.c \
-  fdiv_qr.c fdiv_qr_ui.c fdiv_r.c fdiv_r_2exp.c fdiv_r_ui.c fdiv_ui.c \
-  fib_ui.c fits_sint_p.c fits_slong_p.c fits_sshort_p.c fits_uint_p.c \
-  fits_ulong_p.c fits_ushort_p.c gcd.c gcd_ui.c gcdext.c get_d.c get_si.c \
-  get_str.c get_ui.c getlimbn.c hamdist.c init.c inp_raw.c inp_str.c \
-  invert.c ior.c iset.c iset_d.c iset_si.c iset_str.c iset_ui.c \
-  jacobi.c kronsz.c kronuz.c kronzs.c kronzu.c \
-  lcm.c legendre.c mod.c mul.c mul_2exp.c neg.c nextprime.c \
-  out_raw.c out_str.c perfpow.c perfsqr.c popcount.c pow_ui.c powm.c \
-  powm_ui.c pprime_p.c random.c random2.c realloc.c remove.c root.c rrandomb.c \
-  scan0.c scan1.c set.c set_d.c set_f.c set_q.c set_si.c set_str.c \
-  set_ui.c setbit.c size.c sizeinbase.c sqrt.c sqrtrem.c sub.c \
-  sub_ui.c swap.c tdiv_ui.c tdiv_q.c tdiv_q_2exp.c tdiv_q_ui.c tdiv_qr.c \
-  tdiv_qr_ui.c tdiv_r.c tdiv_r_2exp.c tdiv_r_ui.c tstbit.c ui_pow_ui.c \
-  urandomb.c urandomm.c xor.c
-
-EXTRA_DIST = mul_siui.c
-nodist_libmpz_la_SOURCES = mul_si.c mul_ui.c
-CLEANFILES = $(nodist_libmpz_la_SOURCES)
-
-mul_si.c: $(srcdir)/mul_siui.c
-	cp $(srcdir)/mul_siui.c mul_si.c
-mul_ui.c: $(srcdir)/mul_siui.c
-	cp $(srcdir)/mul_siui.c mul_ui.c
diff --git a/ghc/rts/gmp/mpz/Makefile.in b/ghc/rts/gmp/mpz/Makefile.in
deleted file mode 100644
index e0f2cdc133..0000000000
--- a/ghc/rts/gmp/mpz/Makefile.in
+++ /dev/null
@@ -1,457 +0,0 @@
-# Makefile.in generated automatically by automake 1.4a from Makefile.am
-
-# Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
-# This Makefile.in is free software; the Free Software Foundation
-# gives unlimited permission to copy and/or distribute it,
-# with or without modifications, as long as this notice is preserved.
-
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
-# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-# PARTICULAR PURPOSE.
-
-SHELL = @SHELL@
-
-srcdir = @srcdir@
-top_srcdir = @top_srcdir@
-VPATH = @srcdir@
-prefix = @prefix@
-exec_prefix = @exec_prefix@
-
-bindir = @bindir@
-sbindir = @sbindir@
-libexecdir = @libexecdir@
-datadir = @datadir@
-sysconfdir = @sysconfdir@
-sharedstatedir = @sharedstatedir@
-localstatedir = @localstatedir@
-libdir = @libdir@
-infodir = @infodir@
-mandir = @mandir@
-includedir = @includedir@
-oldincludedir = /usr/include
-
-DESTDIR =
-
-pkgdatadir = $(datadir)/@PACKAGE@
-pkglibdir = $(libdir)/@PACKAGE@
-pkgincludedir = $(includedir)/@PACKAGE@
-
-top_builddir = ..
-
-ACLOCAL = @ACLOCAL@
-AUTOCONF = @AUTOCONF@
-AUTOMAKE = @AUTOMAKE@
-AUTOHEADER = @AUTOHEADER@
-
-INSTALL = @INSTALL@
-INSTALL_PROGRAM = @INSTALL_PROGRAM@
-INSTALL_DATA = @INSTALL_DATA@
-INSTALL_SCRIPT = @INSTALL_SCRIPT@
-INSTALL_STRIP_FLAG =
-transform = @program_transform_name@
-
-NORMAL_INSTALL = :
-PRE_INSTALL = :
-POST_INSTALL = :
-NORMAL_UNINSTALL = :
-PRE_UNINSTALL = :
-POST_UNINSTALL = :
-
-@SET_MAKE@
-build_alias = @build_alias@
-build_triplet = @build@
-host_alias = @host_alias@
-host_triplet = @host@
-target_alias = @target_alias@
-target_triplet = @target@
-AMDEP = @AMDEP@
-AMTAR = @AMTAR@
-AR = @AR@
-AS = @AS@
-AWK = @AWK@
-CALLING_CONVENTIONS_OBJS = @CALLING_CONVENTIONS_OBJS@
-CC = @CC@
-CCAS = @CCAS@
-CPP = @CPP@
-CXX = @CXX@
-CXXCPP = @CXXCPP@
-DEPDIR = @DEPDIR@
-DLLTOOL = @DLLTOOL@
-EXEEXT = @EXEEXT@
-LIBTOOL = @LIBTOOL@
-LN_S = @LN_S@
-M4 = @M4@
-MAINT = @MAINT@
-MAKEINFO = @MAKEINFO@
-OBJDUMP = @OBJDUMP@
-OBJEXT = @OBJEXT@
-PACKAGE = @PACKAGE@
-RANLIB = @RANLIB@
-SPEED_CYCLECOUNTER_OBJS = @SPEED_CYCLECOUNTER_OBJS@
-STRIP = @STRIP@
-U = @U@
-VERSION = @VERSION@
-gmp_srclinks = @gmp_srclinks@
-install_sh = @install_sh@
-mpn_objects = @mpn_objects@
-mpn_objs_in_libgmp = @mpn_objs_in_libgmp@
-
-# Copyright (C) 1996, 1998, 1999, 2000 Free Software Foundation, Inc.
-#
-# This file is part of the GNU MP Library.
-#
-# The GNU MP Library is free software; you can redistribute it and/or modify
-# it under the terms of the GNU Lesser General Public License as published by
-# the Free Software Foundation; either version 2.1 of the License, or (at your
-# option) any later version.
-#
-# The GNU MP Library is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-# License for more details.
-#
-# You should have received a copy of the GNU Lesser General Public License
-# along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-# MA 02111-1307, USA.
-
-
-AUTOMAKE_OPTIONS = gnu no-dependencies
-
-SUBDIRS =
-
-INCLUDES = -I$(top_srcdir) -DOPERATION_$*
-
-noinst_LTLIBRARIES = libmpz.la
-libmpz_la_SOURCES = \
-  abs.c add.c add_ui.c addmul_ui.c and.c array_init.c \
-  bin_ui.c bin_uiui.c cdiv_q.c \
-  cdiv_q_ui.c cdiv_qr.c cdiv_qr_ui.c cdiv_r.c cdiv_r_ui.c cdiv_ui.c \
-  clear.c clrbit.c cmp.c cmp_si.c cmp_ui.c cmpabs.c cmpabs_ui.c com.c \
-  divexact.c dump.c fac_ui.c fdiv_q.c fdiv_q_2exp.c fdiv_q_ui.c \
-  fdiv_qr.c fdiv_qr_ui.c fdiv_r.c fdiv_r_2exp.c fdiv_r_ui.c fdiv_ui.c \
-  fib_ui.c fits_sint_p.c fits_slong_p.c fits_sshort_p.c fits_uint_p.c \
-  fits_ulong_p.c fits_ushort_p.c gcd.c gcd_ui.c gcdext.c get_d.c get_si.c \
-  get_str.c get_ui.c getlimbn.c hamdist.c init.c inp_raw.c inp_str.c \
-  invert.c ior.c iset.c iset_d.c iset_si.c iset_str.c iset_ui.c \
-  jacobi.c kronsz.c kronuz.c kronzs.c kronzu.c \
-  lcm.c legendre.c mod.c mul.c mul_2exp.c neg.c nextprime.c \
-  out_raw.c out_str.c perfpow.c perfsqr.c popcount.c pow_ui.c powm.c \
-  powm_ui.c pprime_p.c random.c random2.c realloc.c remove.c root.c rrandomb.c \
-  scan0.c scan1.c set.c set_d.c set_f.c set_q.c set_si.c set_str.c \
-  set_ui.c setbit.c size.c sizeinbase.c sqrt.c sqrtrem.c sub.c \
-  sub_ui.c swap.c tdiv_ui.c tdiv_q.c tdiv_q_2exp.c tdiv_q_ui.c tdiv_qr.c \
-  tdiv_qr_ui.c tdiv_r.c tdiv_r_2exp.c tdiv_r_ui.c tstbit.c ui_pow_ui.c \
-  urandomb.c urandomm.c xor.c
-
-
-EXTRA_DIST = mul_siui.c
-nodist_libmpz_la_SOURCES = mul_si.c mul_ui.c
-CLEANFILES = $(nodist_libmpz_la_SOURCES)
-subdir = mpz
-mkinstalldirs = $(SHELL) $(top_srcdir)/mkinstalldirs
-CONFIG_HEADER = ../config.h
-CONFIG_CLEAN_FILES = 
-LTLIBRARIES =  $(noinst_LTLIBRARIES)
-
-
-DEFS = @DEFS@ -I. -I$(srcdir) -I..
-CPPFLAGS = @CPPFLAGS@
-LDFLAGS = @LDFLAGS@
-LIBS = @LIBS@
-libmpz_la_LDFLAGS = 
-libmpz_la_LIBADD = 
-am_libmpz_la_OBJECTS =  abs.lo add.lo add_ui.lo addmul_ui.lo and.lo \
-array_init.lo bin_ui.lo bin_uiui.lo cdiv_q.lo cdiv_q_ui.lo cdiv_qr.lo \
-cdiv_qr_ui.lo cdiv_r.lo cdiv_r_ui.lo cdiv_ui.lo clear.lo clrbit.lo \
-cmp.lo cmp_si.lo cmp_ui.lo cmpabs.lo cmpabs_ui.lo com.lo divexact.lo \
-dump.lo fac_ui.lo fdiv_q.lo fdiv_q_2exp.lo fdiv_q_ui.lo fdiv_qr.lo \
-fdiv_qr_ui.lo fdiv_r.lo fdiv_r_2exp.lo fdiv_r_ui.lo fdiv_ui.lo \
-fib_ui.lo fits_sint_p.lo fits_slong_p.lo fits_sshort_p.lo \
-fits_uint_p.lo fits_ulong_p.lo fits_ushort_p.lo gcd.lo gcd_ui.lo \
-gcdext.lo get_d.lo get_si.lo get_str.lo get_ui.lo getlimbn.lo \
-hamdist.lo init.lo inp_raw.lo inp_str.lo invert.lo ior.lo iset.lo \
-iset_d.lo iset_si.lo iset_str.lo iset_ui.lo jacobi.lo kronsz.lo \
-kronuz.lo kronzs.lo kronzu.lo lcm.lo legendre.lo mod.lo mul.lo \
-mul_2exp.lo neg.lo nextprime.lo out_raw.lo out_str.lo perfpow.lo \
-perfsqr.lo popcount.lo pow_ui.lo powm.lo powm_ui.lo pprime_p.lo \
-random.lo random2.lo realloc.lo remove.lo root.lo rrandomb.lo scan0.lo \
-scan1.lo set.lo set_d.lo set_f.lo set_q.lo set_si.lo set_str.lo \
-set_ui.lo setbit.lo size.lo sizeinbase.lo sqrt.lo sqrtrem.lo sub.lo \
-sub_ui.lo swap.lo tdiv_ui.lo tdiv_q.lo tdiv_q_2exp.lo tdiv_q_ui.lo \
-tdiv_qr.lo tdiv_qr_ui.lo tdiv_r.lo tdiv_r_2exp.lo tdiv_r_ui.lo \
-tstbit.lo ui_pow_ui.lo urandomb.lo urandomm.lo xor.lo
-nodist_libmpz_la_OBJECTS =  mul_si.lo mul_ui.lo
-libmpz_la_OBJECTS =  $(am_libmpz_la_OBJECTS) $(nodist_libmpz_la_OBJECTS)
-COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
-LTCOMPILE = $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
-CFLAGS = @CFLAGS@
-CCLD = $(CC)
-LINK = $(LIBTOOL) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@
-DIST_SOURCES =  $(libmpz_la_SOURCES)
-DIST_COMMON =  README Makefile.am Makefile.in
-
-
-DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST)
-
-GZIP_ENV = --best
-depcomp = 
-SOURCES = $(libmpz_la_SOURCES) $(nodist_libmpz_la_SOURCES)
-OBJECTS = $(am_libmpz_la_OBJECTS) $(nodist_libmpz_la_OBJECTS)
-
-all: all-redirect
-.SUFFIXES:
-.SUFFIXES: .c .lo .o .obj
-$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) 
-	cd $(top_srcdir) && $(AUTOMAKE) --gnu mpz/Makefile
-
-Makefile: $(srcdir)/Makefile.in  $(top_builddir)/config.status
-	cd $(top_builddir) \
-	  && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
-
-
-mostlyclean-noinstLTLIBRARIES:
-
-clean-noinstLTLIBRARIES:
-	-test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
-
-distclean-noinstLTLIBRARIES:
-
-maintainer-clean-noinstLTLIBRARIES:
-
-mostlyclean-compile:
-	-rm -f *.o core *.core
-	-rm -f *.$(OBJEXT)
-
-clean-compile:
-
-distclean-compile:
-	-rm -f *.tab.c
-
-maintainer-clean-compile:
-
-mostlyclean-libtool:
-	-rm -f *.lo
-
-clean-libtool:
-	-rm -rf .libs _libs
-
-distclean-libtool:
-
-maintainer-clean-libtool:
-
-libmpz.la: $(libmpz_la_OBJECTS) $(libmpz_la_DEPENDENCIES)
-	$(LINK)  $(libmpz_la_LDFLAGS) $(libmpz_la_OBJECTS) $(libmpz_la_LIBADD) $(LIBS)
-.c.o:
-	$(COMPILE) -c $<
-.c.obj:
-	$(COMPILE) -c `cygpath -w $<`
-.c.lo:
-	$(LTCOMPILE) -c -o $@ $<
-
-# This directory's subdirectories are mostly independent; you can cd
-# into them and run `make' without going through this Makefile.
-# To change the values of `make' variables: instead of editing Makefiles,
-# (1) if the variable is set in `config.status', edit `config.status'
-#     (which will cause the Makefiles to be regenerated when you run `make');
-# (2) otherwise, pass the desired values on the `make' command line.
-
-all-recursive install-data-recursive install-exec-recursive \
-installdirs-recursive install-recursive uninstall-recursive  \
-check-recursive installcheck-recursive info-recursive dvi-recursive:
-	@set fnord $(MAKEFLAGS); amf=$$2; \
-	dot_seen=no; \
-	target=`echo $@ | sed s/-recursive//`; \
-	list='$(SUBDIRS)'; for subdir in $$list; do \
-	  echo "Making $$target in $$subdir"; \
-	  if test "$$subdir" = "."; then \
-	    dot_seen=yes; \
-	    local_target="$$target-am"; \
-	  else \
-	    local_target="$$target"; \
-	  fi; \
-	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
-	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
-	done; \
-	if test "$$dot_seen" = "no"; then \
-	  $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
-	fi; test -z "$$fail"
-
-mostlyclean-recursive clean-recursive distclean-recursive \
-maintainer-clean-recursive:
-	@set fnord $(MAKEFLAGS); amf=$$2; \
-	dot_seen=no; \
-	rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
-	  rev="$$subdir $$rev"; \
-	  if test "$$subdir" = "."; then dot_seen=yes; else :; fi; \
-	done; \
-	test "$$dot_seen" = "no" && rev=". $$rev"; \
-	target=`echo $@ | sed s/-recursive//`; \
-	for subdir in $$rev; do \
-	  echo "Making $$target in $$subdir"; \
-	  if test "$$subdir" = "."; then \
-	    local_target="$$target-am"; \
-	  else \
-	    local_target="$$target"; \
-	  fi; \
-	  (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
-	   || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
-	done && test -z "$$fail"
-tags-recursive:
-	list='$(SUBDIRS)'; for subdir in $$list; do \
-	  test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
-	done
-
-tags: TAGS
-
-ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES)
-	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
-	unique=`for i in $$list; do \
-	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
-	  done | \
-	  $(AWK) '    { files[$$0] = 1; } \
-	       END { for (i in files) print i; }'`; \
-	mkid -f$$here/ID $$unique $(LISP)
-
-TAGS: tags-recursive $(HEADERS) $(SOURCES)  $(TAGS_DEPENDENCIES) \
-		$(TAGS_FILES) $(LISP)
-	tags=; \
-	here=`pwd`; \
-	list='$(SUBDIRS)'; for subdir in $$list; do \
-   if test "$$subdir" = .; then :; else \
-	    test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
-   fi; \
-	done; \
-	list='$(SOURCES) $(HEADERS) $(TAGS_FILES)'; \
-	unique=`for i in $$list; do \
-	    if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \
-	  done | \
-	  $(AWK) '    { files[$$0] = 1; } \
-	       END { for (i in files) print i; }'`; \
-	test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
-	  || etags $(ETAGS_ARGS) $$tags  $$unique $(LISP)
-
-mostlyclean-tags:
-
-clean-tags:
-
-distclean-tags:
-	-rm -f TAGS ID
-
-maintainer-clean-tags:
-
-distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
-
-distdir: $(DISTFILES)
-	@for file in $(DISTFILES); do \
-	  d=$(srcdir); \
-	  if test -d $$d/$$file; then \
-	    cp -pR $$d/$$file $(distdir); \
-	  else \
-	    test -f $(distdir)/$$file \
-	    || cp -p $$d/$$file $(distdir)/$$file || :; \
-	  fi; \
-	done
-	for subdir in $(SUBDIRS); do \
-	  if test "$$subdir" = .; then :; else \
-	    test -d $(distdir)/$$subdir \
-	    || mkdir $(distdir)/$$subdir \
-	    || exit 1; \
-	    (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(top_distdir) distdir=../$(distdir)/$$subdir distdir) \
-	      || exit 1; \
-	  fi; \
-	done
-info-am:
-info: info-recursive
-dvi-am:
-dvi: dvi-recursive
-check-am: all-am
-check: check-recursive
-installcheck-am:
-installcheck: installcheck-recursive
-install-exec-am:
-install-exec: install-exec-recursive
-
-install-data-am:
-install-data: install-data-recursive
-
-install-am: all-am
-	@$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
-install: install-recursive
-uninstall-am:
-uninstall: uninstall-recursive
-all-am: Makefile $(LTLIBRARIES)
-all-redirect: all-recursive
-install-strip:
-	$(MAKE) $(AM_MAKEFLAGS) INSTALL_STRIP_FLAG=-s install
-installdirs: installdirs-recursive
-installdirs-am:
-
-
-mostlyclean-generic:
-
-clean-generic:
-	-test -z "$(CLEANFILES)" || rm -f $(CLEANFILES)
-
-distclean-generic:
-	-rm -f Makefile $(CONFIG_CLEAN_FILES)
-	-rm -f config.cache config.log stamp-h stamp-h[0-9]*
-
-maintainer-clean-generic:
-	-rm -f Makefile.in
-mostlyclean-am:  mostlyclean-noinstLTLIBRARIES mostlyclean-compile \
-		mostlyclean-libtool mostlyclean-tags \
-		mostlyclean-generic
-
-mostlyclean: mostlyclean-recursive
-
-clean-am:  clean-noinstLTLIBRARIES clean-compile clean-libtool \
-		clean-tags clean-generic mostlyclean-am
-
-clean: clean-recursive
-
-distclean-am:  distclean-noinstLTLIBRARIES distclean-compile \
-		distclean-libtool distclean-tags distclean-generic \
-		clean-am
-	-rm -f libtool
-
-distclean: distclean-recursive
-
-maintainer-clean-am:  maintainer-clean-noinstLTLIBRARIES \
-		maintainer-clean-compile maintainer-clean-libtool \
-		maintainer-clean-tags maintainer-clean-generic \
-		distclean-am
-	@echo "This command is intended for maintainers to use;"
-	@echo "it deletes files that may require special tools to rebuild."
-
-maintainer-clean: maintainer-clean-recursive
-
-.PHONY: mostlyclean-noinstLTLIBRARIES distclean-noinstLTLIBRARIES \
-clean-noinstLTLIBRARIES maintainer-clean-noinstLTLIBRARIES \
-mostlyclean-compile distclean-compile clean-compile \
-maintainer-clean-compile mostlyclean-libtool distclean-libtool \
-clean-libtool maintainer-clean-libtool install-recursive \
-uninstall-recursive install-data-recursive uninstall-data-recursive \
-install-exec-recursive uninstall-exec-recursive installdirs-recursive \
-uninstalldirs-recursive all-recursive check-recursive \
-installcheck-recursive info-recursive dvi-recursive \
-mostlyclean-recursive distclean-recursive clean-recursive \
-maintainer-clean-recursive tags tags-recursive mostlyclean-tags \
-distclean-tags clean-tags maintainer-clean-tags distdir info-am info \
-dvi-am dvi check check-am installcheck-am installcheck install-exec-am \
-install-exec install-data-am install-data install-am install \
-uninstall-am uninstall all-redirect all-am all install-strip \
-installdirs-am installdirs mostlyclean-generic distclean-generic \
-clean-generic maintainer-clean-generic clean mostlyclean distclean \
-maintainer-clean
-
-
-mul_si.c: $(srcdir)/mul_siui.c
-	cp $(srcdir)/mul_siui.c mul_si.c
-mul_ui.c: $(srcdir)/mul_siui.c
-	cp $(srcdir)/mul_siui.c mul_ui.c
-
-# Tell versions [3.59,3.63) of GNU make to not export all variables.
-# Otherwise a system limit (for SysV at least) may be exceeded.
-.NOEXPORT:
diff --git a/ghc/rts/gmp/mpz/README b/ghc/rts/gmp/mpz/README
deleted file mode 100644
index 06b481d770..0000000000
--- a/ghc/rts/gmp/mpz/README
+++ /dev/null
@@ -1,23 +0,0 @@
-This directory contains functions for GMP's integer function layer.
-
-In this version of GMP, integers are represented like in the figure below.
-(Please note that the format might change between every version, and that
-depending on the internal format in any way is a bad idea.)
-
-   most				least
-significant		     significant
-   limb				limb
-
-				 _mp_d
-				  /
-				 /
-				\/
-	 ____ ____ ____ ____ ____
-	|____|____|____|____|____|
-
-	<------- _mp_size ------->
-
-
-The most significant limb will be non-zero.  The _mp_size field's sign
-reflects the sign of the number.  Its absolute value is the count of limbs
-in the number.
diff --git a/ghc/rts/gmp/mpz/abs.c b/ghc/rts/gmp/mpz/abs.c
deleted file mode 100644
index 0b5eab1ce6..0000000000
--- a/ghc/rts/gmp/mpz/abs.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/* mpz_abs(dst, src) -- Assign the absolute value of SRC to DST.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_abs (mpz_ptr w, mpz_srcptr u)
-#else
-mpz_abs (w, u)
-     mpz_ptr w;
-     mpz_srcptr u;
-#endif
-{
-  mp_ptr wp, up;
-  mp_size_t size;
-
-  size = ABS (u->_mp_size);
-
-  if (u != w)
-    {
-      if (w->_mp_alloc < size)
-	_mpz_realloc (w, size);
-
-      wp = w->_mp_d;
-      up = u->_mp_d;
-
-      MPN_COPY (wp, up, size);
-    }
-
-  w->_mp_size = size;
-}
diff --git a/ghc/rts/gmp/mpz/add.c b/ghc/rts/gmp/mpz/add.c
deleted file mode 100644
index a22c3778fb..0000000000
--- a/ghc/rts/gmp/mpz/add.c
+++ /dev/null
@@ -1,123 +0,0 @@
-/* mpz_add -- Add two integers.
-
-Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#ifdef BERKELEY_MP
-#include "mp.h"
-#endif
-
-#ifndef BERKELEY_MP
-void
-#if __STDC__
-mpz_add (mpz_ptr w, mpz_srcptr u, mpz_srcptr v)
-#else
-mpz_add (w, u, v)
-     mpz_ptr w;
-     mpz_srcptr u;
-     mpz_srcptr v;
-#endif
-#else /* BERKELEY_MP */
-void
-#if __STDC__
-madd (mpz_srcptr u, mpz_srcptr v, mpz_ptr w)
-#else
-madd (u, v, w)
-     mpz_srcptr u;
-     mpz_srcptr v;
-     mpz_ptr w;
-#endif
-#endif /* BERKELEY_MP */
-{
-  mp_srcptr up, vp;
-  mp_ptr wp;
-  mp_size_t usize, vsize, wsize;
-  mp_size_t abs_usize;
-  mp_size_t abs_vsize;
-
-  usize = u->_mp_size;
-  vsize = v->_mp_size;
-  abs_usize = ABS (usize);
-  abs_vsize = ABS (vsize);
-
-  if (abs_usize < abs_vsize)
-    {
-      /* Swap U and V. */
-      MPZ_SRCPTR_SWAP (u, v);
-      MP_SIZE_T_SWAP (usize, vsize);
-      MP_SIZE_T_SWAP (abs_usize, abs_vsize);
-    }
-
-  /* True: ABS_USIZE >= ABS_VSIZE.  */
-
-  /* If not space for w (and possible carry), increase space.  */
-  wsize = abs_usize + 1;
-  if (w->_mp_alloc < wsize)
-    _mpz_realloc (w, wsize);
-
-  /* These must be after realloc (u or v may be the same as w).  */
-  up = u->_mp_d;
-  vp = v->_mp_d;
-  wp = w->_mp_d;
-
-  if ((usize ^ vsize) < 0)
-    {
-      /* U and V have different sign.  Need to compare them to determine
-	 which operand to subtract from which.  */
-
-      /* This test is right since ABS_USIZE >= ABS_VSIZE.  */
-      if (abs_usize != abs_vsize)
-	{
-	  mpn_sub (wp, up, abs_usize, vp, abs_vsize);
-	  wsize = abs_usize;
-	  MPN_NORMALIZE (wp, wsize);
-	  if (usize < 0)
-	    wsize = -wsize;
-	}
-      else if (mpn_cmp (up, vp, abs_usize) < 0)
-	{
-	  mpn_sub_n (wp, vp, up, abs_usize);
-	  wsize = abs_usize;
-	  MPN_NORMALIZE (wp, wsize);
-	  if (usize >= 0)
-	    wsize = -wsize;
-	}
-      else
-	{
-	  mpn_sub_n (wp, up, vp, abs_usize);
-	  wsize = abs_usize;
-	  MPN_NORMALIZE (wp, wsize);
-	  if (usize < 0)
-	    wsize = -wsize;
-	}
-    }
-  else
-    {
-      /* U and V have same sign.  Add them.  */
-      mp_limb_t cy_limb = mpn_add (wp, up, abs_usize, vp, abs_vsize);
-      wp[abs_usize] = cy_limb;
-      wsize = abs_usize + cy_limb;
-      if (usize < 0)
-	wsize = -wsize;
-    }
-
-  w->_mp_size = wsize;
-}
diff --git a/ghc/rts/gmp/mpz/add_ui.c b/ghc/rts/gmp/mpz/add_ui.c
deleted file mode 100644
index 28dbd71f45..0000000000
--- a/ghc/rts/gmp/mpz/add_ui.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/* mpz_add_ui -- Add an mpz_t and an unsigned one-word integer.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1999 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_add_ui (mpz_ptr w, mpz_srcptr u, unsigned long int v)
-#else
-mpz_add_ui (w, u, v)
-     mpz_ptr w;
-     mpz_srcptr u;
-     unsigned long int v;
-#endif
-{
-  mp_srcptr up;
-  mp_ptr wp;
-  mp_size_t usize, wsize;
-  mp_size_t abs_usize;
-
-  usize = u->_mp_size;
-  abs_usize = ABS (usize);
-
-  /* If not space for W (and possible carry), increase space.  */
-  wsize = abs_usize + 1;
-  if (w->_mp_alloc < wsize)
-    _mpz_realloc (w, wsize);
-
-  /* These must be after realloc (U may be the same as W).  */
-  up = u->_mp_d;
-  wp = w->_mp_d;
-
-  if (abs_usize == 0)
-    {
-      wp[0] = v;
-      w->_mp_size = v != 0;
-      return;
-    }
-
-  if (usize >= 0)
-    {
-      mp_limb_t cy;
-      cy = mpn_add_1 (wp, up, abs_usize, (mp_limb_t) v);
-      wp[abs_usize] = cy;
-      wsize = abs_usize + cy;
-    }
-  else
-    {
-      /* The signs are different.  Need exact comparison to determine
-	 which operand to subtract from which.  */
-      if (abs_usize == 1 && up[0] < v)
-	{
-	  wp[0] = v - up[0];
-	  wsize = 1;
-	}
-      else
-	{
-	  mpn_sub_1 (wp, up, abs_usize, (mp_limb_t) v);
-	  /* Size can decrease with at most one limb.  */
-	  wsize = -(abs_usize - (wp[abs_usize - 1] == 0));
-	}
-    }
-
-  w->_mp_size = wsize;
-}
diff --git a/ghc/rts/gmp/mpz/addmul_ui.c b/ghc/rts/gmp/mpz/addmul_ui.c
deleted file mode 100644
index 7b38d3624d..0000000000
--- a/ghc/rts/gmp/mpz/addmul_ui.c
+++ /dev/null
@@ -1,214 +0,0 @@
-/* mpz_addmul_ui(prodsum, multiplier, small_multiplicand) --
-   Add MULTIPLICATOR times SMALL_MULTIPLICAND to PRODSUM.
-
-Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-static mp_limb_t mpn_neg1 _PROTO ((mp_ptr, mp_size_t));
-
-#if 0
-#undef  MPN_NORMALIZE
-#define MPN_NORMALIZE(DST, NLIMBS) \
-  do {									\
-    while (--(NLIMBS) >= 0 && (DST)[NLIMBS] == 0)			\
-      ;									\
-    (NLIMBS)++;								\
-  } while (0)
-#undef  MPN_NORMALIZE_NOT_ZERO
-#define MPN_NORMALIZE_NOT_ZERO(DST, NLIMBS) \
-  do {									\
-    while ((DST)[--(NLIMBS)] == 0)					\
-      ;									\
-    (NLIMBS)++;								\
-  } while (0)
-#endif
-
-void
-#if __STDC__
-mpz_addmul_ui (mpz_ptr rz, mpz_srcptr az, unsigned long int bu)
-#else
-mpz_addmul_ui (rz, az, bu)
-     mpz_ptr rz;
-     mpz_srcptr az;
-     unsigned long int bu;
-#endif
-{
-  mp_size_t rn, an;
-  mp_ptr rp, ap;
-
-  an = SIZ (az);
-
-  /* If either multiplier is zero, result is unaffected.  */
-  if (bu == 0 || an == 0)
-    return;
-
-  rn = SIZ (rz);
-
-  if (rn == 0)
-    {
-      mp_limb_t cy;
-
-      an = ABS (an);
-      if (ALLOC (rz) <= an)
-	_mpz_realloc (rz, an + 1);
-      rp = PTR (rz);
-      ap = PTR (az);
-      cy = mpn_mul_1 (rp, ap, an, (mp_limb_t) bu);
-      rp[an] = cy;
-      an += cy != 0;
-      SIZ (rz) = SIZ (az) >= 0 ? an : -an;
-      return;
-    }
-
-  if ((an ^ rn) >= 0)
-    {
-      /* Sign of operands are the same--really add.  */
-      an = ABS (an);
-      rn = ABS (rn);
-      if (rn > an)
-	{
-	  mp_limb_t cy;
-	  if (ALLOC (rz) <= rn)
-	    _mpz_realloc (rz, rn + 1);
-	  rp = PTR (rz);
-	  ap = PTR (az);
-	  cy = mpn_addmul_1 (rp, ap, an, (mp_limb_t) bu);
-	  cy = mpn_add_1 (rp + an, rp + an, rn - an, cy);
-	  rp[rn] = cy;
-	  rn += cy != 0;
-	  SIZ (rz) = SIZ (rz) >= 0 ? rn : -rn;
-	  return;
-	}
-      else
-	{
-	  mp_limb_t cy;
-	  if (ALLOC (rz) <= an)
-	    _mpz_realloc (rz, an + 1);
-	  rp = PTR (rz);
-	  ap = PTR (az);
-	  cy = mpn_addmul_1 (rp, ap, rn, (mp_limb_t) bu);
-	  if (an != rn)
-	    {
-	      mp_limb_t cy2;
-	      cy2 = mpn_mul_1 (rp + rn, ap + rn, an - rn, (mp_limb_t) bu);
-	      cy = cy2 + mpn_add_1 (rp + rn, rp + rn, an - rn, cy);
-	    }
-	  rn = an;
-	  rp[rn] = cy;
-	  rn += cy != 0;
-	  SIZ (rz) = SIZ (rz) >= 0 ? rn : -rn;
-	  return;
-	}
-    }
-  else
-    {
-      /* Sign of operands are different--actually subtract.  */
-      an = ABS (an);
-      rn = ABS (rn);
-      if (rn > an)
-	{
-	  mp_limb_t cy;
-	  rp = PTR (rz);
-	  ap = PTR (az);
-	  cy = mpn_submul_1 (rp, ap, an, (mp_limb_t) bu);
-	  cy = mpn_sub_1 (rp + an, rp + an, rn - an, cy);
-	  if (cy != 0)
-	    {
-	      mpn_neg1 (rp, rn);
-	      MPN_NORMALIZE_NOT_ZERO (rp, rn);
-	    }
-	  else
-	    {
-	      MPN_NORMALIZE (rp, rn);
-	      rn = -rn;
-	    }
-
-	  SIZ (rz) = SIZ (rz) >= 0 ? -rn : rn;
-	  return;
-	}
-      else
-	{
-	  /* Tricky case.  We need to subtract an operand that might be larger
-	     than the minuend.  To avoid allocating temporary space, we compute
-	     a*b-r instead of r-a*b and then negate.  */
-	  mp_limb_t cy;
-	  if (ALLOC (rz) <= an)
-	    _mpz_realloc (rz, an + 1);
-	  rp = PTR (rz);
-	  ap = PTR (az);
-	  cy = mpn_submul_1 (rp, ap, rn, (mp_limb_t) bu);
-	  if (an != rn)
-	    {
-	      mp_limb_t cy2;
-	      cy -= mpn_neg1 (rp, rn);
-	      cy2 = mpn_mul_1 (rp + rn, ap + rn, an - rn, (mp_limb_t) bu);
-	      if (cy == ~(mp_limb_t) 0)
-		cy = cy2 - mpn_sub_1 (rp + rn, rp + rn, an - rn, (mp_limb_t) 1);
-	      else
-		cy = cy2 + mpn_add_1 (rp + rn, rp + rn, an - rn, cy);
-	      rp[an] = cy;
-	      rn = an + (cy != 0);
-	      rn -= rp[rn - 1] == 0;
-	    }
-	  else if (cy != 0)
-	    {
-	      cy -= mpn_neg1 (rp, rn);
-	      rp[an] = cy;
-	      rn = an + 1;
-	      MPN_NORMALIZE_NOT_ZERO (rp, rn);
-	    }
-	  else
-	    {
-	      rn = an;
-	      MPN_NORMALIZE (rp, rn);
-	      rn = -rn;
-	    }
-
-	  SIZ (rz) = SIZ (rz) >= 0 ? -rn : rn;
-	  return;
-	}
-    }
-}
-
-static mp_limb_t
-#if __STDC__
-mpn_neg1 (mp_ptr rp, mp_size_t rn)
-#else
-mpn_neg1 (rp, rn)
-     mp_ptr rp;
-     mp_size_t rn;
-#endif
-{
-  mp_size_t i;
-
-  while (rn != 0 && rp[0] == 0)
-    rp++, rn--;
-
-  if (rn != 0)
-    {
-      rp[0] = -rp[0];
-      for (i = 1; i < rn; i++)
-	rp[i] = ~rp[i];
-      return 1;
-    }
-  return 0;
-}
diff --git a/ghc/rts/gmp/mpz/and.c b/ghc/rts/gmp/mpz/and.c
deleted file mode 100644
index 354e9455bf..0000000000
--- a/ghc/rts/gmp/mpz/and.c
+++ /dev/null
@@ -1,278 +0,0 @@
-/* mpz_and -- Logical and.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_and (mpz_ptr res, mpz_srcptr op1, mpz_srcptr op2)
-#else
-mpz_and (res, op1, op2)
-     mpz_ptr res;
-     mpz_srcptr op1;
-     mpz_srcptr op2;
-#endif
-{
-  mp_srcptr op1_ptr, op2_ptr;
-  mp_size_t op1_size, op2_size;
-  mp_ptr res_ptr;
-  mp_size_t res_size;
-  mp_size_t i;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-  op1_size = op1->_mp_size;
-  op2_size = op2->_mp_size;
-
-  op1_ptr = op1->_mp_d;
-  op2_ptr = op2->_mp_d;
-  res_ptr = res->_mp_d;
-
-  if (op1_size >= 0)
-    {
-      if (op2_size >= 0)
-	{
-	  res_size = MIN (op1_size, op2_size);
-	  /* First loop finds the size of the result.  */
-	  for (i = res_size - 1; i >= 0; i--)
-	    if ((op1_ptr[i] & op2_ptr[i]) != 0)
-	      break;
-	  res_size = i + 1;
-
-	  /* Handle allocation, now then we know exactly how much space is
-	     needed for the result.  */
-	  if (res->_mp_alloc < res_size)
-	    {
-	      _mpz_realloc (res, res_size);
-	      op1_ptr = op1->_mp_d;
-	      op2_ptr = op2->_mp_d;
-	      res_ptr = res->_mp_d;
-	    }
-
-	  /* Second loop computes the real result.  */
-	  for (i = res_size - 1; i >= 0; i--)
-	    res_ptr[i] = op1_ptr[i] & op2_ptr[i];
-
-	  res->_mp_size = res_size;
-	  return;
-	}
-      else /* op2_size < 0 */
-	{
-	  /* Fall through to the code at the end of the function.  */
-	}
-    }
-  else
-    {
-      if (op2_size < 0)
-	{
-	  mp_ptr opx;
-	  mp_limb_t cy;
-	  mp_size_t res_alloc;
-
-	  /* Both operands are negative, so will be the result.
-	     -((-OP1) & (-OP2)) = -(~(OP1 - 1) & ~(OP2 - 1)) =
-	     = ~(~(OP1 - 1) & ~(OP2 - 1)) + 1 =
-	     = ((OP1 - 1) | (OP2 - 1)) + 1      */
-
-	  /* It might seem as we could end up with an (invalid) result with
-	     a leading zero-limb here when one of the operands is of the
-	     type 1,,0,,..,,.0.  But some analysis shows that we surely
-	     would get carry into the zero-limb in this situation...  */
-
-	  op1_size = -op1_size;
-	  op2_size = -op2_size;
-
-	  res_alloc = 1 + MAX (op1_size, op2_size);
-
-	  opx = (mp_ptr) TMP_ALLOC (op1_size * BYTES_PER_MP_LIMB);
-	  mpn_sub_1 (opx, op1_ptr, op1_size, (mp_limb_t) 1);
-	  op1_ptr = opx;
-
-	  opx = (mp_ptr) TMP_ALLOC (op2_size * BYTES_PER_MP_LIMB);
-	  mpn_sub_1 (opx, op2_ptr, op2_size, (mp_limb_t) 1);
-	  op2_ptr = opx;
-
-	  if (res->_mp_alloc < res_alloc)
-	    {
-	      _mpz_realloc (res, res_alloc);
-	      res_ptr = res->_mp_d;
-	      /* Don't re-read OP1_PTR and OP2_PTR.  They point to
-		 temporary space--never to the space RES->_mp_d used
-		 to point to before reallocation.  */
-	    }
-
-	  if (op1_size >= op2_size)
-	    {
-	      MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size,
-			op1_size - op2_size);
-	      for (i = op2_size - 1; i >= 0; i--)
-		res_ptr[i] = op1_ptr[i] | op2_ptr[i];
-	      res_size = op1_size;
-	    }
-	  else
-	    {
-	      MPN_COPY (res_ptr + op1_size, op2_ptr + op1_size,
-			op2_size - op1_size);
-	      for (i = op1_size - 1; i >= 0; i--)
-		res_ptr[i] = op1_ptr[i] | op2_ptr[i];
-	      res_size = op2_size;
-	    }
-
-	  cy = mpn_add_1 (res_ptr, res_ptr, res_size, (mp_limb_t) 1);
-	  if (cy)
-	    {
-	      res_ptr[res_size] = cy;
-	      res_size++;
-	    }
-
-	  res->_mp_size = -res_size;
-	  TMP_FREE (marker);
-	  return;
-	}
-      else
-	{
-	  /* We should compute -OP1 & OP2.  Swap OP1 and OP2 and fall
-	     through to the code that handles OP1 & -OP2.  */
-          MPZ_SRCPTR_SWAP (op1, op2);
-          MPN_SRCPTR_SWAP (op1_ptr,op1_size, op2_ptr,op2_size);
-	}
-
-    }
-
-  {
-#if ANDNEW
-    mp_size_t op2_lim;
-    mp_size_t count;
-
-    /* OP2 must be negated as with infinite precision.
-
-       Scan from the low end for a non-zero limb.  The first non-zero
-       limb is simply negated (two's complement).  Any subsequent
-       limbs are one's complemented.  Of course, we don't need to
-       handle more limbs than there are limbs in the other, positive
-       operand as the result for those limbs is going to become zero
-       anyway.  */
-
-    /* Scan for the least significant non-zero OP2 limb, and zero the
-       result meanwhile for those limb positions.  (We will surely
-       find a non-zero limb, so we can write the loop with one
-       termination condition only.)  */
-    for (i = 0; op2_ptr[i] == 0; i++)
-      res_ptr[i] = 0;
-    op2_lim = i;
-
-    op2_size = -op2_size;
-
-    if (op1_size <= op2_size)
-      {
-	/* The ones-extended OP2 is >= than the zero-extended OP1.
-	   RES_SIZE <= OP1_SIZE.  Find the exact size.  */
-	for (i = op1_size - 1; i > op2_lim; i--)
-	  if ((op1_ptr[i] & ~op2_ptr[i]) != 0)
-	    break;
-	res_size = i + 1;
-	for (i = res_size - 1; i > op2_lim; i--)
-	  res_ptr[i] = op1_ptr[i] & ~op2_ptr[i];
-	res_ptr[op2_lim] = op1_ptr[op2_lim] & -op2_ptr[op2_lim];
-	/* Yes, this *can* happen!  */
-	MPN_NORMALIZE (res_ptr, res_size);
-      }
-    else
-      {
-	/* The ones-extended OP2 is < than the zero-extended OP1.
-	   RES_SIZE == OP1_SIZE, since OP1 is normalized.  */
-	res_size = op1_size;
-	MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size, op1_size - op2_size);
-	for (i = op2_size - 1; i > op2_lim; i--)
-	  res_ptr[i] = op1_ptr[i] & ~op2_ptr[i];
-	res_ptr[op2_lim] = op1_ptr[op2_lim] & -op2_ptr[op2_lim];
-      }
-
-    res->_mp_size = res_size;
-#else
-
-    /* OP1 is positive and zero-extended,
-       OP2 is negative and ones-extended.
-       The result will be positive.
-       OP1 & -OP2 = OP1 & ~(OP2 - 1).  */
-
-    mp_ptr opx;
-
-    op2_size = -op2_size;
-    opx = (mp_ptr) TMP_ALLOC (op2_size * BYTES_PER_MP_LIMB);
-    mpn_sub_1 (opx, op2_ptr, op2_size, (mp_limb_t) 1);
-    op2_ptr = opx;
-
-    if (op1_size > op2_size)
-      {
-	/* The result has the same size as OP1, since OP1 is normalized
-	   and longer than the ones-extended OP2.  */
-	res_size = op1_size;
-
-	/* Handle allocation, now then we know exactly how much space is
-	   needed for the result.  */
-	if (res->_mp_alloc < res_size)
-	  {
-	    _mpz_realloc (res, res_size);
-	    res_ptr = res->_mp_d;
-	    op1_ptr = op1->_mp_d;
-	    /* Don't re-read OP2_PTR.  It points to temporary space--never
-	       to the space RES->_mp_d used to point to before reallocation.  */
-	  }
-
-	MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size,
-		  res_size - op2_size);
-	for (i = op2_size - 1; i >= 0; i--)
-	  res_ptr[i] = op1_ptr[i] & ~op2_ptr[i];
-
-	res->_mp_size = res_size;
-      }
-    else
-      {
-	/* Find out the exact result size.  Ignore the high limbs of OP2,
-	   OP1 is zero-extended and would make the result zero.  */
-	for (i = op1_size - 1; i >= 0; i--)
-	  if ((op1_ptr[i] & ~op2_ptr[i]) != 0)
-	    break;
-	res_size = i + 1;
-
-	/* Handle allocation, now then we know exactly how much space is
-	   needed for the result.  */
-	if (res->_mp_alloc < res_size)
-	  {
-	    _mpz_realloc (res, res_size);
-	    res_ptr = res->_mp_d;
-	    op1_ptr = op1->_mp_d;
-	    /* Don't re-read OP2_PTR.  It points to temporary space--never
-	       to the space RES->_mp_d used to point to before reallocation.  */
-	  }
-
-	for (i = res_size - 1; i >= 0; i--)
-	  res_ptr[i] = op1_ptr[i] & ~op2_ptr[i];
-
-	res->_mp_size = res_size;
-      }
-#endif
-  }
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/array_init.c b/ghc/rts/gmp/mpz/array_init.c
deleted file mode 100644
index 1c22046986..0000000000
--- a/ghc/rts/gmp/mpz/array_init.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/* mpz_array_init (array, array_size, size_per_elem) --
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_array_init (mpz_ptr arr, mp_size_t arr_size, mp_size_t nbits)
-#else
-mpz_array_init (arr, arr_size, nbits)
-     mpz_ptr arr;
-     mp_size_t arr_size;
-     mp_size_t nbits;
-#endif
-{
-  register mp_ptr p;
-  register size_t i;
-  mp_size_t nlimbs;
-
-  nlimbs = (nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
-  p = (mp_ptr) (*_mp_allocate_func) (arr_size * nlimbs * BYTES_PER_MP_LIMB);
-
-  for (i = 0; i < arr_size; i++)
-    {
-      arr[i]._mp_alloc = nlimbs + 1; /* Yes, lie a little... */
-      arr[i]._mp_size = 0;
-      arr[i]._mp_d = p + i * nlimbs;
-    }
-}
diff --git a/ghc/rts/gmp/mpz/bin_ui.c b/ghc/rts/gmp/mpz/bin_ui.c
deleted file mode 100644
index a7a6c98218..0000000000
--- a/ghc/rts/gmp/mpz/bin_ui.c
+++ /dev/null
@@ -1,141 +0,0 @@
-/* mpz_bin_uiui - compute n over k.
-
-Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-/* This is a poor implementation.  Look at bin_uiui.c for improvement ideas.
-   In fact consider calling mpz_bin_uiui() when the arguments fit, leaving
-   the code here only for big n.
-
-   The identity bin(n,k) = (-1)^k * bin(-n+k-1,k) can be found in Knuth vol
-   1 section 1.2.6 part G. */
-
-
-/* Enhancement: use mpn_divexact_1 when it exists */
-#define DIVIDE()                                        \
-  ASSERT (SIZ(r) > 0);                                  \
-  ASSERT_NOCARRY (mpn_divrem_1 (PTR(r), (mp_size_t) 0,  \
-                                PTR(r), SIZ(r), kacc)); \
-  SIZ(r) -= (PTR(r)[SIZ(r)-1] == 0);
-
-void
-#if __STDC__
-mpz_bin_ui (mpz_ptr r, mpz_srcptr n, unsigned long int k)
-#else
-mpz_bin_ui (r, n, k)
-     mpz_ptr r;
-     mpz_srcptr n;
-     unsigned long int k;
-#endif
-{
-  mpz_t      ni;
-  mp_limb_t  i;
-  mpz_t      nacc;
-  mp_limb_t  kacc;
-  mp_size_t  negate;
-  
-  if (mpz_sgn (n) < 0)
-    {
-      /* bin(n,k) = (-1)^k * bin(-n+k-1,k), and set ni = -n+k-1 - k = -n-1 */
-      mpz_init (ni);
-      mpz_neg (ni, n);
-      mpz_sub_ui (ni, ni, 1L);
-      negate = (k & 1);   /* (-1)^k */
-    }
-  else
-    {
-      /* bin(n,k) == 0 if k>n
-         (no test for this under the n<0 case, since -n+k-1 >= k there) */
-      if (mpz_cmp_ui (n, k) < 0)
-        {
-          mpz_set_ui (r, 0L);
-          return;
-        }
-
-      /* set ni = n-k */
-      mpz_init (ni);
-      mpz_sub_ui (ni, n, k);
-      negate = 0;
-    }
-
-  /* Now wanting bin(ni+k,k), with ni positive, and "negate" is the sign (0
-     for positive, 1 for negative). */
-  mpz_set_ui (r, 1L);
-
-  /* Rewrite bin(n,k) as bin(n,n-k) if that is smaller.  In this case it's
-     whether ni+k-k < k meaning ni<k, and if so change to denominator ni+k-k
-     = ni, and new ni of ni+k-ni = k.  */
-  if (mpz_cmp_ui (ni, k) < 0)
-    {
-      unsigned long  tmp;
-      tmp = k;
-      k = mpz_get_ui (ni);
-      mpz_set_ui (ni, tmp);
-    }
-
-  kacc = 1;
-  mpz_init_set_ui (nacc, 1);
-
-  for (i = 1; i <= k; i++)
-    {
-      mp_limb_t k1, k0;
-
-#if 0
-      mp_limb_t nacclow;
-      int c;
-
-      nacclow = PTR(nacc)[0];
-      for (c = 0; (((kacc | nacclow) & 1) == 0); c++)
-	{
-	  kacc >>= 1;
-	  nacclow >>= 1;
-	}
-      mpz_div_2exp (nacc, nacc, c);
-#endif
-
-      mpz_add_ui (ni, ni, 1);
-      mpz_mul (nacc, nacc, ni);
-      umul_ppmm (k1, k0, kacc, i);
-      if (k1 != 0)
-	{
-	  /* Accumulator overflow.  Perform bignum step.  */
-	  mpz_mul (r, r, nacc);
-	  mpz_set_ui (nacc, 1);
-          DIVIDE ();
-	  kacc = i;
-	}
-      else
-	{
-	  /* Save new products in accumulators to keep accumulating.  */
-	  kacc = k0;
-	}
-    }
-
-  mpz_mul (r, r, nacc);
-  DIVIDE ();
-  SIZ(r) = (SIZ(r) ^ -negate) + negate;
-
-  mpz_clear (nacc);
-  mpz_clear (ni);
-}
diff --git a/ghc/rts/gmp/mpz/bin_uiui.c b/ghc/rts/gmp/mpz/bin_uiui.c
deleted file mode 100644
index b37541ba54..0000000000
--- a/ghc/rts/gmp/mpz/bin_uiui.c
+++ /dev/null
@@ -1,120 +0,0 @@
-/* mpz_bin_uiui - compute n over k.
-
-Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-/* Avoid reallocs by rounding up any new size */
-#define ROUNDUP_MASK  15
-
-/* Enhancement: use mpn_divexact_1 when it exists */
-#define MULDIV()                                                \
-  MPZ_REALLOC (r, (SIZ(r)+1)|ROUNDUP_MASK);                     \
-  PTR(r)[SIZ(r)] = mpn_mul_1 (PTR(r), PTR(r), SIZ(r), nacc);    \
-  ASSERT_NOCARRY (mpn_divrem_1 (PTR(r), (mp_size_t) 0,          \
-                                PTR(r), SIZ(r)+1, kacc));       \
-  SIZ(r) += (PTR(r)[SIZ(r)] != 0);
-
-void
-#if __STDC__
-mpz_bin_uiui (mpz_ptr r, unsigned long int n, unsigned long int k)
-#else
-mpz_bin_uiui (r, n, k)
-     mpz_ptr r;
-     unsigned long int n;
-     unsigned long int k;
-#endif
-{
-  unsigned long int  i, j;
-  mp_limb_t          nacc, kacc;
-  unsigned long int  cnt;
-
-  /* bin(n,k) = 0 if k>n. */
-  if (n < k)
-    {
-      mpz_set_ui (r, 0);
-      return;
-    }
-
-  /* Rewrite bin(n,k) as bin(n,n-k) if that is smaller. */
-  k = MIN (k, n-k);
-
-  /* bin(n,0) = 1 */
-  if (k == 0)
-    {
-      mpz_set_ui (r, 1);
-      return;
-    }
-
-  j = n - k + 1;
-  mpz_set_ui (r, j);
-
-  /* Initialize accumulators.  */
-  nacc = 1;
-  kacc = 1;
-
-  cnt = 0;
-  for (i = 2; i <= k; i++)
-    {
-      mp_limb_t n1, n0, k1, k0;
-
-      j++;
-#if 0
-      /* Remove common multiples of 2.  This will allow us to accumulate
-         more in nacc and kacc before we need a bignum step.  It would make
-         sense to cancel factors of 3, 5, etc too, but this would be best
-         handled by sieving out factors.  Alternatively, we could perform a
-         gcd of the accumulators just as they have overflown, and keep
-         accumulating until the gcd doesn't remove a significant factor.  */
-      while (((nacc | kacc) & 1) == 0)
-        {
-          nacc >>= 1;
-          kacc >>= 1;
-        }
-#else
-      cnt = ((nacc | kacc) & 1) ^ 1;
-      nacc >>= cnt;
-      kacc >>= cnt;
-#endif
-      /* Accumulate next multiples.  */
-      umul_ppmm (n1, n0, nacc, j);
-      umul_ppmm (k1, k0, kacc, i);
-      if (n1 != 0)
-        {
-          /* Accumulator overflow.  Perform bignum step.  */
-          MULDIV ();
-          nacc = j;
-          kacc = i;
-        }
-      else
-        {
-          if (k1 != 0) abort ();
-          /* Save new products in accumulators to keep accumulating.  */
-          nacc = n0;
-          kacc = k0;
-        }
-    }
-
-  /* Take care of whatever is left in accumulators.  */
-  MULDIV ();
-}
diff --git a/ghc/rts/gmp/mpz/cdiv_q.c b/ghc/rts/gmp/mpz/cdiv_q.c
deleted file mode 100644
index b15ba8aaa9..0000000000
--- a/ghc/rts/gmp/mpz/cdiv_q.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/* mpz_cdiv_q -- Division rounding the quotient towards +infinity.  The
-   remainder gets the opposite sign as the denominator.
-
-Copyright (C) 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_cdiv_q (mpz_ptr quot, mpz_srcptr dividend, mpz_srcptr divisor)
-#else
-mpz_cdiv_q (quot, dividend, divisor)
-     mpz_ptr quot;
-     mpz_srcptr dividend;
-     mpz_srcptr divisor;
-#endif
-{
-  mp_size_t dividend_size = dividend->_mp_size;
-  mp_size_t divisor_size = divisor->_mp_size;
-  mpz_t rem;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-
-  MPZ_TMP_INIT (rem, ABS (divisor_size));
-
-  mpz_tdiv_qr (quot, rem, dividend, divisor);
-
-  if ((divisor_size ^ dividend_size) >= 0 && rem->_mp_size != 0)
-    mpz_add_ui (quot, quot, 1L);
-
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/cdiv_q_ui.c b/ghc/rts/gmp/mpz/cdiv_q_ui.c
deleted file mode 100644
index 74f3a90b83..0000000000
--- a/ghc/rts/gmp/mpz/cdiv_q_ui.c
+++ /dev/null
@@ -1,67 +0,0 @@
-/* mpz_cdiv_q_ui -- Division rounding the quotient towards +infinity.  The
-   remainder gets the opposite sign as the denominator.  In order to make it
-   always fit into the return type, the negative of the true remainder is
-   returned.
-
-Copyright (C) 1994, 1996, 1999 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_cdiv_q_ui (mpz_ptr quot, mpz_srcptr dividend, unsigned long int divisor)
-#else
-mpz_cdiv_q_ui (quot, dividend, divisor)
-     mpz_ptr quot;
-     mpz_srcptr dividend;
-     unsigned long int divisor;
-#endif
-{
-  mp_size_t dividend_size;
-  mp_size_t size;
-  mp_ptr quot_ptr;
-  mp_limb_t remainder_limb;
-
-  if (divisor == 0)
-    DIVIDE_BY_ZERO;
-
-  dividend_size = dividend->_mp_size;
-  size = ABS (dividend_size);
-
-  if (quot->_mp_alloc < size)
-    _mpz_realloc (quot, size);
-
-  quot_ptr = quot->_mp_d;
-
-  remainder_limb = mpn_divmod_1 (quot_ptr, dividend->_mp_d, size,
-				   (mp_limb_t) divisor);
-
-  if (remainder_limb != 0 && dividend_size >= 0)
-    {
-      mpn_incr_u (quot_ptr, (mp_limb_t) 1);
-      remainder_limb = divisor - remainder_limb;
-    }
-
-  size -= size != 0 && quot_ptr[size - 1] == 0;
-  quot->_mp_size = dividend_size >= 0 ? size : -size;
-
-  return remainder_limb;
-}
diff --git a/ghc/rts/gmp/mpz/cdiv_qr.c b/ghc/rts/gmp/mpz/cdiv_qr.c
deleted file mode 100644
index 29c7c41a4e..0000000000
--- a/ghc/rts/gmp/mpz/cdiv_qr.c
+++ /dev/null
@@ -1,64 +0,0 @@
-/* mpz_cdiv_qr -- Division rounding the quotient towards +infinity.  The
-   remainder gets the opposite sign as the denominator.
-
-Copyright (C) 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_cdiv_qr (mpz_ptr quot, mpz_ptr rem, mpz_srcptr dividend, mpz_srcptr divisor)
-#else
-mpz_cdiv_qr (quot, rem, dividend, divisor)
-     mpz_ptr quot;
-     mpz_ptr rem;
-     mpz_srcptr dividend;
-     mpz_srcptr divisor;
-#endif
-{
-  mp_size_t divisor_size = divisor->_mp_size;
-  mp_size_t xsize;
-  mpz_t temp_divisor;		/* N.B.: lives until function returns! */
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-
-  /* We need the original value of the divisor after the quotient and
-     remainder have been preliminary calculated.  We have to copy it to
-     temporary space if it's the same variable as either QUOT or REM.  */
-  if (quot == divisor || rem == divisor)
-    {
-      MPZ_TMP_INIT (temp_divisor, ABS (divisor_size));
-      mpz_set (temp_divisor, divisor);
-      divisor = temp_divisor;
-    }
-
-  xsize = dividend->_mp_size ^ divisor_size;;
-  mpz_tdiv_qr (quot, rem, dividend, divisor);
-
-  if (xsize >= 0 && rem->_mp_size != 0)
-    {
-      mpz_add_ui (quot, quot, 1L);
-      mpz_sub (rem, rem, divisor);
-    }
-
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/cdiv_qr_ui.c b/ghc/rts/gmp/mpz/cdiv_qr_ui.c
deleted file mode 100644
index a7873c6e20..0000000000
--- a/ghc/rts/gmp/mpz/cdiv_qr_ui.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/* mpz_cdiv_qr_ui -- Division rounding the quotient towards +infinity.  The
-   remainder gets the opposite sign as the denominator.  In order to make it
-   always fit into the return type, the negative of the true remainder is
-   returned.
-
-Copyright (C) 1994, 1995, 1996, 1999 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_cdiv_qr_ui (mpz_ptr quot, mpz_ptr rem, mpz_srcptr dividend, unsigned long int divisor)
-#else
-mpz_cdiv_qr_ui (quot, rem, dividend, divisor)
-     mpz_ptr quot;
-     mpz_ptr rem;
-     mpz_srcptr dividend;
-     unsigned long int divisor;
-#endif
-{
-  mp_size_t dividend_size;
-  mp_size_t size;
-  mp_ptr quot_ptr;
-  mp_limb_t remainder_limb;
-
-  if (divisor == 0)
-    DIVIDE_BY_ZERO;
-
-  dividend_size = dividend->_mp_size;
-  size = ABS (dividend_size);
-
-  if (quot->_mp_alloc < size)
-    _mpz_realloc (quot, size);
-
-  quot_ptr = quot->_mp_d;
-
-  remainder_limb = mpn_divmod_1 (quot_ptr, dividend->_mp_d, size,
-				 (mp_limb_t) divisor);
-
-  if (remainder_limb != 0 && dividend_size >= 0)
-    {
-      mpn_incr_u (quot_ptr, (mp_limb_t) 1);
-      remainder_limb = divisor - remainder_limb;
-    }
-
-  size -= size != 0 && quot_ptr[size - 1] == 0;
-  quot->_mp_size = dividend_size >= 0 ? size : -size;
-
-  rem->_mp_d[0] = remainder_limb;
-  rem->_mp_size = -(remainder_limb != 0);
-
-  return remainder_limb;
-}
diff --git a/ghc/rts/gmp/mpz/cdiv_r.c b/ghc/rts/gmp/mpz/cdiv_r.c
deleted file mode 100644
index e96ce7e677..0000000000
--- a/ghc/rts/gmp/mpz/cdiv_r.c
+++ /dev/null
@@ -1,59 +0,0 @@
-/* mpz_cdiv_r -- Division rounding the quotient towards +infinity.  The
-   remainder gets the opposite sign as the denominator.
-
-Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_cdiv_r (mpz_ptr rem, mpz_srcptr dividend, mpz_srcptr divisor)
-#else
-mpz_cdiv_r (rem, dividend, divisor)
-     mpz_ptr rem;
-     mpz_srcptr dividend;
-     mpz_srcptr divisor;
-#endif
-{
-  mp_size_t divisor_size = divisor->_mp_size;
-  mpz_t temp_divisor;		/* N.B.: lives until function returns! */
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-
-  /* We need the original value of the divisor after the remainder has been
-     preliminary calculated.  We have to copy it to temporary space if it's
-     the same variable as REM.  */
-  if (rem == divisor)
-    {
-
-      MPZ_TMP_INIT (temp_divisor, ABS (divisor_size));
-      mpz_set (temp_divisor, divisor);
-      divisor = temp_divisor;
-    }
-
-  mpz_tdiv_r (rem, dividend, divisor);
-
-  if ((divisor_size ^ dividend->_mp_size) >= 0 && rem->_mp_size != 0)
-    mpz_sub (rem, rem, divisor);
-
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/cdiv_r_ui.c b/ghc/rts/gmp/mpz/cdiv_r_ui.c
deleted file mode 100644
index e17e2381c0..0000000000
--- a/ghc/rts/gmp/mpz/cdiv_r_ui.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/* mpz_cdiv_r_ui -- Division rounding the quotient towards +infinity.  The
-   remainder gets the opposite sign as the denominator.  In order to make it
-   always fit into the return type, the negative of the true remainder is
-   returned.
-
-Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_cdiv_r_ui (mpz_ptr rem, mpz_srcptr dividend, unsigned long int divisor)
-#else
-mpz_cdiv_r_ui (rem, dividend, divisor)
-     mpz_ptr rem;
-     mpz_srcptr dividend;
-     unsigned long int divisor;
-#endif
-{
-  mp_size_t dividend_size;
-  mp_size_t size;
-  mp_limb_t remainder_limb;
-
-  if (divisor == 0)
-    DIVIDE_BY_ZERO;
-
-  dividend_size = dividend->_mp_size;
-  size = ABS (dividend_size);
-
-  remainder_limb = mpn_mod_1 (dividend->_mp_d, size, (mp_limb_t) divisor);
-
-  if (remainder_limb != 0 && dividend_size >= 0)
-    remainder_limb = divisor - remainder_limb;
-
-  rem->_mp_d[0] = remainder_limb;
-  rem->_mp_size = -(remainder_limb != 0);
-
-  return remainder_limb;
-}
diff --git a/ghc/rts/gmp/mpz/cdiv_ui.c b/ghc/rts/gmp/mpz/cdiv_ui.c
deleted file mode 100644
index 63547a78c0..0000000000
--- a/ghc/rts/gmp/mpz/cdiv_ui.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/* mpz_cdiv_ui -- Division rounding the quotient towards +infinity.  The
-   remainder gets the opposite sign as the denominator.  In order to make it
-   always fit into the return type, the negative of the true remainder is
-   returned.
-
-Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_cdiv_ui (mpz_srcptr dividend, unsigned long int divisor)
-#else
-mpz_cdiv_ui (dividend, divisor)
-     mpz_srcptr dividend;
-     unsigned long int divisor;
-#endif
-{
-  mp_size_t dividend_size;
-  mp_size_t size;
-  mp_limb_t remainder_limb;
-
-  dividend_size = dividend->_mp_size;
-  size = ABS (dividend_size);
-
-  remainder_limb = mpn_mod_1 (dividend->_mp_d, size, (mp_limb_t) divisor);
-
-  if (remainder_limb != 0 && dividend_size >= 0)
-    remainder_limb = divisor - remainder_limb;
-
-  return remainder_limb;
-}
diff --git a/ghc/rts/gmp/mpz/clear.c b/ghc/rts/gmp/mpz/clear.c
deleted file mode 100644
index 5224553f9e..0000000000
--- a/ghc/rts/gmp/mpz/clear.c
+++ /dev/null
@@ -1,35 +0,0 @@
-/* mpz_clear -- de-allocate the space occupied by the dynamic digit space of
-   an integer.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_clear (mpz_ptr m)
-#else
-mpz_clear (m)
-     mpz_ptr m;
-#endif
-{
-  (*_mp_free_func) (m->_mp_d, m->_mp_alloc * BYTES_PER_MP_LIMB);
-}
diff --git a/ghc/rts/gmp/mpz/clrbit.c b/ghc/rts/gmp/mpz/clrbit.c
deleted file mode 100644
index 865d84902f..0000000000
--- a/ghc/rts/gmp/mpz/clrbit.c
+++ /dev/null
@@ -1,114 +0,0 @@
-/* mpz_clrbit -- clear a specified bit.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_clrbit (mpz_ptr d, unsigned long int bit_index)
-#else
-mpz_clrbit (d, bit_index)
-     mpz_ptr d;
-     unsigned long int bit_index;
-#endif
-{
-  mp_size_t dsize = d->_mp_size;
-  mp_ptr dp = d->_mp_d;
-  mp_size_t limb_index;
-
-  limb_index = bit_index / BITS_PER_MP_LIMB;
-  if (dsize >= 0)
-    {
-      if (limb_index < dsize)
-	{
-	  dp[limb_index] &= ~((mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB));
-	  MPN_NORMALIZE (dp, dsize);
-	  d->_mp_size = dsize;
-	}
-      else
-	;
-    }
-  else
-    {
-      mp_size_t zero_bound;
-
-      /* Simulate two's complement arithmetic, i.e. simulate
-	 1. Set OP = ~(OP - 1) [with infinitely many leading ones].
-	 2. clear the bit.
-	 3. Set OP = ~OP + 1.  */
-
-      dsize = -dsize;
-
-      /* No upper bound on this loop, we're sure there's a non-zero limb
-	 sooner ot later.  */
-      for (zero_bound = 0; ; zero_bound++)
-	if (dp[zero_bound] != 0)
-	  break;
-
-      if (limb_index > zero_bound)
-	{
-	  if (limb_index < dsize)
-	    dp[limb_index] |= (mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB);
-	  else
-	    {
-	      /* Ugh.  The bit should be cleared outside of the end of the
-		 number.  We have to increase the size of the number.  */
-	      if (d->_mp_alloc < limb_index + 1)
-		{
-		  _mpz_realloc (d, limb_index + 1);
-		  dp = d->_mp_d;
-		}
-	      MPN_ZERO (dp + dsize, limb_index - dsize);
-	      dp[limb_index] = (mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB);
-	      d->_mp_size = -(limb_index + 1);
-	    }
-	}
-      else if (limb_index == zero_bound)
-	{
-	  dp[limb_index] = ((dp[limb_index] - 1)
-			    | ((mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB))) + 1;
-	  if (dp[limb_index] == 0)
-	    {
-	      mp_size_t i;
-	      for (i = limb_index + 1; i < dsize; i++)
-		{
-		  dp[i] += 1;
-		  if (dp[i] != 0)
-		    goto fin;
-		}
-	      /* We got carry all way out beyond the end of D.  Increase
-		 its size (and allocation if necessary).  */
-	      dsize++;
-	      if (d->_mp_alloc < dsize)
-		{
-		  _mpz_realloc (d, dsize);
-		  dp = d->_mp_d;
-		}
-	      dp[i] = 1;
-	      d->_mp_size = -dsize;
-	    fin:;
-	    }
-	}
-      else
-	;
-    }
-}
diff --git a/ghc/rts/gmp/mpz/cmp.c b/ghc/rts/gmp/mpz/cmp.c
deleted file mode 100644
index 60628348e5..0000000000
--- a/ghc/rts/gmp/mpz/cmp.c
+++ /dev/null
@@ -1,75 +0,0 @@
-/* mpz_cmp(u,v) -- Compare U, V.  Return postive, zero, or negative
-   based on if U > V, U == V, or U < V.
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#ifdef BERKELEY_MP
-#include "mp.h"
-#endif
-#include "gmp.h"
-#include "gmp-impl.h"
-
-#ifndef BERKELEY_MP
-int
-#if __STDC__
-mpz_cmp (mpz_srcptr u, mpz_srcptr v)
-#else
-mpz_cmp (u, v)
-     mpz_srcptr u;
-     mpz_srcptr v;
-#endif
-#else /* BERKELEY_MP */
-int
-#if __STDC__
-mcmp (mpz_srcptr u, mpz_srcptr v)
-#else
-mcmp (u, v)
-     mpz_srcptr u;
-     mpz_srcptr v;
-#endif
-#endif /* BERKELEY_MP */
-{
-  mp_size_t usize = u->_mp_size;
-  mp_size_t vsize = v->_mp_size;
-  mp_size_t size;
-  mp_srcptr up, vp;
-  int cmp;
-
-  if (usize != vsize)
-    return usize - vsize;
-
-  if (usize == 0)
-    return 0;
-
-  size = ABS (usize);
-
-  up = u->_mp_d;
-  vp = v->_mp_d;
-
-  cmp = mpn_cmp (up, vp, size);
-
-  if (cmp == 0)
-    return 0;
-
-  if ((cmp < 0) == (usize < 0))
-    return 1;
-  else
-    return -1;
-}
diff --git a/ghc/rts/gmp/mpz/cmp_si.c b/ghc/rts/gmp/mpz/cmp_si.c
deleted file mode 100644
index 0c2212fbe9..0000000000
--- a/ghc/rts/gmp/mpz/cmp_si.c
+++ /dev/null
@@ -1,64 +0,0 @@
-/* mpz_cmp_si(u,v) -- Compare an integer U with a single-word int V.
-   Return positive, zero, or negative based on if U > V, U == V, or U < V.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1996, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-_mpz_cmp_si (mpz_srcptr u, signed long int v_digit)
-#else
-_mpz_cmp_si (u, v_digit)
-     mpz_srcptr u;
-     signed long int v_digit;
-#endif
-{
-  mp_size_t usize = u->_mp_size;
-  mp_size_t vsize;
-  mp_limb_t u_digit;
-
-  vsize = 0;
-  if (v_digit > 0)
-    vsize = 1;
-  else if (v_digit < 0)
-    {
-      vsize = -1;
-      v_digit = -v_digit;
-    }
-
-  if (usize != vsize)
-    return usize - vsize;
-
-  if (usize == 0)
-    return 0;
-
-  u_digit = u->_mp_d[0];
-
-  if (u_digit == (mp_limb_t) (unsigned long) v_digit)
-    return 0;
-
-  if (u_digit > (mp_limb_t) (unsigned long) v_digit)
-    return usize;
-  else
-    return -usize;
-}
diff --git a/ghc/rts/gmp/mpz/cmp_ui.c b/ghc/rts/gmp/mpz/cmp_ui.c
deleted file mode 100644
index fd84f301c1..0000000000
--- a/ghc/rts/gmp/mpz/cmp_ui.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/* mpz_cmp_ui.c -- Compare a mpz_t a with an mp_limb_t b.  Return positive,
-  zero, or negative based on if a > b, a == b, or a < b.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-_mpz_cmp_ui (mpz_srcptr u, unsigned long int v_digit)
-#else
-_mpz_cmp_ui (u, v_digit)
-     mpz_srcptr u;
-     unsigned long int v_digit;
-#endif
-{
-  mp_size_t usize = u->_mp_size;
-
-  if (usize == 0)
-    return -(v_digit != 0);
-
-  if (usize == 1)
-    {
-      mp_limb_t u_digit;
-
-      u_digit = u->_mp_d[0];
-      if (u_digit > v_digit)
-	return 1;
-      if (u_digit < v_digit)
-	return -1;
-      return 0;
-    }
-
-  return (usize > 0) ? 1 : -1;
-}
diff --git a/ghc/rts/gmp/mpz/cmpabs.c b/ghc/rts/gmp/mpz/cmpabs.c
deleted file mode 100644
index 037d7a9145..0000000000
--- a/ghc/rts/gmp/mpz/cmpabs.c
+++ /dev/null
@@ -1,57 +0,0 @@
-/* mpz_cmpabs(u,v) -- Compare U, V.  Return postive, zero, or negative
-   based on if U > V, U == V, or U < V.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-mpz_cmpabs (mpz_srcptr u, mpz_srcptr v)
-#else
-mpz_cmpabs (u, v)
-     mpz_srcptr u;
-     mpz_srcptr v;
-#endif
-{
-  mp_size_t usize = u->_mp_size;
-  mp_size_t vsize = v->_mp_size;
-  mp_size_t size;
-  mp_srcptr up, vp;
-  int cmp;
-
-  usize = ABS (usize);
-  vsize = ABS (vsize);
-
-  if (usize != vsize)
-    return usize - vsize;
-
-  if (usize == 0)
-    return 0;
-
-  up = u->_mp_d;
-  vp = v->_mp_d;
-
-  cmp = mpn_cmp (up, vp, usize);
-
-  return cmp;
-}
diff --git a/ghc/rts/gmp/mpz/cmpabs_ui.c b/ghc/rts/gmp/mpz/cmpabs_ui.c
deleted file mode 100644
index db816b5820..0000000000
--- a/ghc/rts/gmp/mpz/cmpabs_ui.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/* mpz_cmpabs_ui.c -- Compare a mpz_t a with an mp_limb_t b.  Return positive,
-  zero, or negative based on if a > b, a == b, or a < b.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1997, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-mpz_cmpabs_ui (mpz_srcptr u, unsigned long int v_digit)
-#else
-mpz_cmpabs_ui (u, v_digit)
-     mpz_srcptr u;
-     unsigned long int v_digit;
-#endif
-{
-  mp_size_t usize = u->_mp_size;
-
-  if (usize == 0)
-    return -(v_digit != 0);
-
-  usize = ABS (usize);
-
-  if (usize == 1)
-    {
-      mp_limb_t u_digit;
-
-      u_digit = u->_mp_d[0];
-      if (u_digit > v_digit)
-	return 1;
-      if (u_digit < v_digit)
-	return -1;
-      return 0;
-    }
-
-  return 1;
-}
diff --git a/ghc/rts/gmp/mpz/com.c b/ghc/rts/gmp/mpz/com.c
deleted file mode 100644
index 18d6427779..0000000000
--- a/ghc/rts/gmp/mpz/com.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/* mpz_com(mpz_ptr dst, mpz_ptr src) -- Assign the bit-complemented value of
-   SRC to DST.
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_com (mpz_ptr dst, mpz_srcptr src)
-#else
-mpz_com (dst, src)
-     mpz_ptr dst;
-     mpz_srcptr src;
-#endif
-{
-  mp_size_t size = src->_mp_size;
-  mp_srcptr src_ptr;
-  mp_ptr dst_ptr;
-
-  if (size >= 0)
-    {
-      /* As with infinite precision: one's complement, two's complement.
-	 But this can be simplified using the identity -x = ~x + 1.
-	 So we're going to compute (~~x) + 1 = x + 1!  */
-
-      if (dst->_mp_alloc < size + 1)
-	_mpz_realloc (dst, size + 1);
-
-      src_ptr = src->_mp_d;
-      dst_ptr = dst->_mp_d;
-
-      if (size == 0)
-	{
-	  /* Special case, as mpn_add wants the first arg's size >= the
-	     second arg's size.  */
-	  dst_ptr[0] = 1;
-	  dst->_mp_size = -1;
-	  return;
-	}
-
-      {
-	mp_limb_t cy;
-
-	cy = mpn_add_1 (dst_ptr, src_ptr, size, (mp_limb_t) 1);
-	if (cy)
-	  {
-	    dst_ptr[size] = cy;
-	    size++;
-	  }
-      }
-
-      /* Store a negative size, to indicate ones-extension.  */
-      dst->_mp_size = -size;
-    }
-  else
-    {
-      /* As with infinite precision: two's complement, then one's complement.
-	 But that can be simplified using the identity -x = ~(x - 1).
-	 So we're going to compute ~~(x - 1) = x - 1!  */
-      size = -size;
-
-      if (dst->_mp_alloc < size)
-	_mpz_realloc (dst, size);
-
-      src_ptr = src->_mp_d;
-      dst_ptr = dst->_mp_d;
-
-      mpn_sub_1 (dst_ptr, src_ptr, size, (mp_limb_t) 1);
-      size -= dst_ptr[size - 1] == 0;
-
-      /* Store a positive size, to indicate zero-extension.  */
-      dst->_mp_size = size;
-    }
-}
diff --git a/ghc/rts/gmp/mpz/divexact.c b/ghc/rts/gmp/mpz/divexact.c
deleted file mode 100644
index c2970454fd..0000000000
--- a/ghc/rts/gmp/mpz/divexact.c
+++ /dev/null
@@ -1,125 +0,0 @@
-/* mpz_divexact -- finds quotient when known that quot * den == num && den != 0.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1996, 1997, 1998, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.  */
-
-/*  Ken Weber (kweber@mat.ufrgs.br, kweber@mcs.kent.edu)
-
-    Funding for this work has been partially provided by Conselho Nacional
-    de Desenvolvimento Cienti'fico e Tecnolo'gico (CNPq) do Brazil, Grant
-    301314194-2, and was done while I was a visiting reseacher in the Instituto
-    de Matema'tica at Universidade Federal do Rio Grande do Sul (UFRGS).
-
-    References:
-	T. Jebelean, An algorithm for exact division, Journal of Symbolic
-	Computation, v. 15, 1993, pp. 169-180.	*/
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-void
-#if __STDC__
-mpz_divexact (mpz_ptr quot, mpz_srcptr num, mpz_srcptr den)
-#else
-mpz_divexact (quot, num, den)
-     mpz_ptr quot;
-     mpz_srcptr num;
-     mpz_srcptr den;
-#endif
-{
-  mp_ptr qp, tp;
-  mp_size_t qsize, tsize;
-  mp_srcptr np, dp;
-  mp_size_t nsize, dsize;
-  TMP_DECL (marker);
-
-  nsize = ABS (num->_mp_size);
-  dsize = ABS (den->_mp_size);
-
-  qsize = nsize - dsize + 1;
-  if (quot->_mp_alloc < qsize)
-    _mpz_realloc (quot, qsize);
-
-  np = num->_mp_d;
-  dp = den->_mp_d;
-  qp = quot->_mp_d;
-
-  if (nsize == 0)
-    {
-      if (dsize == 0)
-	DIVIDE_BY_ZERO;
-      quot->_mp_size = 0;
-      return;
-    }
-
-  if (dsize <= 1)
-    {
-      if (dsize == 1)
-	{
-	  mpn_divmod_1 (qp, np, nsize, dp[0]);
-	  qsize -= qp[qsize - 1] == 0;
-	  quot->_mp_size = (num->_mp_size ^ den->_mp_size) >= 0 ? qsize : -qsize;
-	  return;
-	}
-
-      /*  Generate divide-by-zero error since dsize == 0.  */
-      DIVIDE_BY_ZERO;
-    }
-
-  TMP_MARK (marker);
-
-  /*  QUOT <-- NUM/2^r, T <-- DEN/2^r where = r number of twos in DEN.  */
-  while (dp[0] == 0)
-    np += 1, nsize -= 1, dp += 1, dsize -= 1;
-  tsize = MIN (qsize, dsize);
-  if ((dp[0] & 1) != 0)
-    {
-      if (quot == den)		/*  QUOT and DEN overlap.  */
-	{
-	  tp = (mp_ptr) TMP_ALLOC (tsize * BYTES_PER_MP_LIMB);
-	  MPN_COPY (tp, dp, tsize);
-	}
-      else
-	tp = (mp_ptr) dp;
-      if (qp != np)
-	MPN_COPY_INCR (qp, np, qsize);
-    }
-  else
-    {
-      unsigned int r;
-      tp = (mp_ptr) TMP_ALLOC (tsize * BYTES_PER_MP_LIMB);
-      count_trailing_zeros (r, dp[0]);
-      mpn_rshift (tp, dp, tsize, r);
-      if (dsize > tsize)
-	tp[tsize - 1] |= dp[tsize] << (BITS_PER_MP_LIMB - r);
-      mpn_rshift (qp, np, qsize, r);
-      if (nsize > qsize)
-	qp[qsize - 1] |= np[qsize] << (BITS_PER_MP_LIMB - r);
-    }
-
-  /*  Now QUOT <-- QUOT/T.  */
-  mpn_bdivmod (qp, qp, qsize, tp, tsize, qsize * BITS_PER_MP_LIMB);
-  MPN_NORMALIZE (qp, qsize);
-
-  quot->_mp_size = (num->_mp_size ^ den->_mp_size) >= 0 ? qsize : -qsize;
-
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/dump.c b/ghc/rts/gmp/mpz/dump.c
deleted file mode 100644
index dc318ac8cf..0000000000
--- a/ghc/rts/gmp/mpz/dump.c
+++ /dev/null
@@ -1,44 +0,0 @@
-/* mpz_dump - Dump an integer to stdout.
-
-   THIS IS AN INTERNAL FUNCTION WITH A MUTABLE INTERFACE.  IT IS NOT SAFE TO
-   CALL THIS FUNCTION DIRECTLY.  IN FACT, IT IS ALMOST GUARANTEED THAT THIS
-   FUNCTION WILL CHANGE OR DISAPPEAR IN A FUTURE GNU MP RELEASE.
-
-
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h>
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_dump (mpz_srcptr u)
-#else
-mpz_dump (u)
-     mpz_srcptr u;
-#endif
-{
-  char *str;
-
-  str = mpz_get_str (0, 10, u);
-  printf ("%s\n", str);
-  (*_mp_free_func) (str, 0);/* ??? broken alloc interface, pass what size ??? */
-}
diff --git a/ghc/rts/gmp/mpz/fac_ui.c b/ghc/rts/gmp/mpz/fac_ui.c
deleted file mode 100644
index 85f40f271c..0000000000
--- a/ghc/rts/gmp/mpz/fac_ui.c
+++ /dev/null
@@ -1,157 +0,0 @@
-/* mpz_fac_ui(result, n) -- Set RESULT to N!.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#ifdef DBG
-#include <stdio.h>
-#endif
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-void
-#if __STDC__
-mpz_fac_ui (mpz_ptr result, unsigned long int n)
-#else
-mpz_fac_ui (result, n)
-     mpz_ptr result;
-     unsigned long int n;
-#endif
-{
-#if SIMPLE_FAC
-
-  /* Be silly.  Just multiply the numbers in ascending order.  O(n**2).  */
-
-  unsigned long int k;
-
-  mpz_set_ui (result, 1L);
-
-  for (k = 2; k <= n; k++)
-    mpz_mul_ui (result, result, k);
-#else
-
-  /* Be smarter.  Multiply groups of numbers in ascending order until the
-     product doesn't fit in a limb.  Multiply these partial product in a
-     balanced binary tree fashion, to make the operand have as equal sizes
-     as possible.  When the operands have about the same size, mpn_mul
-     becomes faster.  */
-
-  unsigned long int p, k;
-  mp_limb_t p1, p0;
-
-  /* Stack of partial products, used to make the computation balanced
-     (i.e. make the sizes of the multiplication operands equal).  The
-     topmost position of MP_STACK will contain a one-limb partial product,
-     the second topmost will contain a two-limb partial product, and so
-     on.  MP_STACK[0] will contain a partial product with 2**t limbs.
-     To compute n! MP_STACK needs to be less than
-     log(n)**2/log(BITS_PER_MP_LIMB), so 30 is surely enough.  */
-#define MP_STACK_SIZE 30
-  mpz_t mp_stack[MP_STACK_SIZE];
-
-  /* TOP is an index into MP_STACK, giving the topmost element.
-     TOP_LIMIT_SO_FAR is the largets value it has taken so far.  */
-  int top, top_limit_so_far;
-
-  /* Count of the total number of limbs put on MP_STACK so far.  This
-     variable plays an essential role in making the compututation balanced.
-     See below.  */
-  unsigned int tree_cnt;
-
-  top = top_limit_so_far = -1;
-  tree_cnt = 0;
-  p = 1;
-  for (k = 2; k <= n; k++)
-    {
-      /* Multiply the partial product in P with K.  */
-      umul_ppmm (p1, p0, (mp_limb_t) p, (mp_limb_t) k);
-
-      /* Did we get overflow into the high limb, i.e. is the partial
-	 product now more than one limb?  */
-      if (p1 != 0)
-	{
-	  tree_cnt++;
-
-	  if (tree_cnt % 2 == 0)
-	    {
-	      mp_size_t i;
-
-	      /* TREE_CNT is even (i.e. we have generated an even number of
-		 one-limb partial products), which means that we have a
-		 single-limb product on the top of MP_STACK.  */
-
-	      mpz_mul_ui (mp_stack[top], mp_stack[top], p);
-
-	      /* If TREE_CNT is divisable by 4, 8,..., we have two
-		 similar-sized partial products with 2, 4,... limbs at
-		 the topmost two positions of MP_STACK.  Multiply them
-		 to form a new partial product with 4, 8,... limbs.  */
-	      for (i = 4; (tree_cnt & (i - 1)) == 0; i <<= 1)
-		{
-		  mpz_mul (mp_stack[top - 1],
-			   mp_stack[top], mp_stack[top - 1]);
-		  top--;
-		}
-	    }
-	  else
-	    {
-	      /* Put the single-limb partial product in P on the stack.
-		 (The next time we get a single-limb product, we will
-		 multiply the two together.)  */
-	      top++;
-	      if (top > top_limit_so_far)
-		{
-		  if (top > MP_STACK_SIZE)
-		    abort();
-		  /* The stack is now bigger than ever, initialize the top
-		     element.  */
-		  mpz_init_set_ui (mp_stack[top], p);
-		  top_limit_so_far++;
-		}
-	      else
-		mpz_set_ui (mp_stack[top], p);
-	    }
-
-	  /* We ignored the last result from umul_ppmm.  Put K in P as the
-	     first component of the next single-limb partial product.  */
-	  p = k;
-	}
-      else
-	/* We didn't get overflow in umul_ppmm.  Put p0 in P and try
-	   with one more value of K.  */
-	p = p0;			/* bogus if long != mp_limb_t */
-    }
-
-  /* We have partial products in mp_stack[0..top], in descending order.
-     We also have a small partial product in p.
-     Their product is the final result.  */
-  if (top < 0)
-    mpz_set_ui (result, p);
-  else
-    mpz_mul_ui (result, mp_stack[top--], p);
-  while (top >= 0)
-    mpz_mul (result, result, mp_stack[top--]);
-
-  /* Free the storage allocated for MP_STACK.  */
-  for (top = top_limit_so_far; top >= 0; top--)
-    mpz_clear (mp_stack[top]);
-#endif
-}
diff --git a/ghc/rts/gmp/mpz/fdiv_q.c b/ghc/rts/gmp/mpz/fdiv_q.c
deleted file mode 100644
index 9d75ca33d2..0000000000
--- a/ghc/rts/gmp/mpz/fdiv_q.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/* mpz_fdiv_q -- Division rounding the quotient towards -infinity.
-   The remainder gets the same sign as the denominator.
-
-Copyright (C) 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_fdiv_q (mpz_ptr quot, mpz_srcptr dividend, mpz_srcptr divisor)
-#else
-mpz_fdiv_q (quot, dividend, divisor)
-     mpz_ptr quot;
-     mpz_srcptr dividend;
-     mpz_srcptr divisor;
-#endif
-{
-  mp_size_t dividend_size = dividend->_mp_size;
-  mp_size_t divisor_size = divisor->_mp_size;
-  mpz_t rem;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-
-  MPZ_TMP_INIT (rem, ABS (divisor_size));
-
-  mpz_tdiv_qr (quot, rem, dividend, divisor);
-
-  if ((divisor_size ^ dividend_size) < 0 && rem->_mp_size != 0)
-    mpz_sub_ui (quot, quot, 1L);
-
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/fdiv_q_2exp.c b/ghc/rts/gmp/mpz/fdiv_q_2exp.c
deleted file mode 100644
index 8e02180ecc..0000000000
--- a/ghc/rts/gmp/mpz/fdiv_q_2exp.c
+++ /dev/null
@@ -1,104 +0,0 @@
-/* mpz_fdiv_q_2exp -- Divide an integer by 2**CNT.  Round the quotient
-   towards -infinity.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1998, 1999 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_fdiv_q_2exp (mpz_ptr w, mpz_srcptr u, unsigned long int cnt)
-#else
-mpz_fdiv_q_2exp (w, u, cnt)
-     mpz_ptr w;
-     mpz_srcptr u;
-     unsigned long int cnt;
-#endif
-{
-  mp_size_t usize = u->_mp_size;
-  mp_size_t wsize;
-  mp_size_t abs_usize = ABS (usize);
-  mp_size_t limb_cnt;
-  mp_ptr wp;
-  mp_limb_t round = 0;
-
-  limb_cnt = cnt / BITS_PER_MP_LIMB;
-  wsize = abs_usize - limb_cnt;
-  if (wsize <= 0)
-    {
-      wp = w->_mp_d;
-      wsize = 0;
-      /* Set ROUND since we know we skip some non-zero words in this case.
-	 Well, if U is zero, we don't, but then this will be taken care of
-	 below, since rounding only really takes place for negative U.  */
-      round = 1;
-      wp[0] = 1;
-      w->_mp_size = -(usize < 0);
-      return;
-    }
-  else
-    {
-      mp_size_t i;
-      mp_ptr up;
-
-      /* Make sure there is enough space.  We make an extra limb
-	 here to account for possible rounding at the end.  */
-      if (w->_mp_alloc < wsize + 1)
-	_mpz_realloc (w, wsize + 1);
-
-      wp = w->_mp_d;
-      up = u->_mp_d;
-
-      /* Set ROUND if we are about skip some non-zero limbs.  */
-      for (i = 0; i < limb_cnt && round == 0; i++)
-	round = up[i];
-
-      cnt %= BITS_PER_MP_LIMB;
-      if (cnt != 0)
-	{
-	  round |= mpn_rshift (wp, up + limb_cnt, wsize, cnt);
-	  wsize -= wp[wsize - 1] == 0;
-	}
-      else
-	{
-	  MPN_COPY_INCR (wp, up + limb_cnt, wsize);
-	}
-    }
-
-  if (usize < 0 && round != 0)
-    {
-      mp_limb_t cy;
-      if (wsize != 0)
-	{
-	  cy = mpn_add_1 (wp, wp, wsize, (mp_limb_t) 1);
-	  wp[wsize] = cy;
-	  wsize += cy;
-	}
-      else
-	{
-	  /* We shifted something negative to zero.  The result is -1.  */
-	  wp[0] = 1;
-	  wsize = 1;
-	}
-    }
-  w->_mp_size = usize >= 0 ? wsize : -wsize;
-}
diff --git a/ghc/rts/gmp/mpz/fdiv_q_ui.c b/ghc/rts/gmp/mpz/fdiv_q_ui.c
deleted file mode 100644
index 55d2498693..0000000000
--- a/ghc/rts/gmp/mpz/fdiv_q_ui.c
+++ /dev/null
@@ -1,65 +0,0 @@
-/* mpz_fdiv_q_ui -- Division rounding the quotient towards -infinity.
-   The remainder gets the same sign as the denominator.
-
-Copyright (C) 1994, 1995, 1996, 1999 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_fdiv_q_ui (mpz_ptr quot, mpz_srcptr dividend, unsigned long int divisor)
-#else
-mpz_fdiv_q_ui (quot, dividend, divisor)
-     mpz_ptr quot;
-     mpz_srcptr dividend;
-     unsigned long int divisor;
-#endif
-{
-  mp_size_t dividend_size;
-  mp_size_t size;
-  mp_ptr quot_ptr;
-  mp_limb_t remainder_limb;
-
-  if (divisor == 0)
-    DIVIDE_BY_ZERO;
-
-  dividend_size = dividend->_mp_size;
-  size = ABS (dividend_size);
-
-  if (quot->_mp_alloc < size)
-    _mpz_realloc (quot, size);
-
-  quot_ptr = quot->_mp_d;
-
-  remainder_limb = mpn_divmod_1 (quot_ptr, dividend->_mp_d, size,
-				   (mp_limb_t) divisor);
-
-  if (remainder_limb != 0 && dividend_size < 0)
-    {
-      mpn_incr_u (quot_ptr, (mp_limb_t) 1);
-      remainder_limb = divisor - remainder_limb;
-    }
-
-  size -= size != 0 && quot_ptr[size - 1] == 0;
-  quot->_mp_size = dividend_size >= 0 ? size : -size;
-
-  return remainder_limb;
-}
diff --git a/ghc/rts/gmp/mpz/fdiv_qr.c b/ghc/rts/gmp/mpz/fdiv_qr.c
deleted file mode 100644
index 06ce50607b..0000000000
--- a/ghc/rts/gmp/mpz/fdiv_qr.c
+++ /dev/null
@@ -1,64 +0,0 @@
-/* mpz_fdiv_qr -- Division rounding the quotient towards -infinity.
-   The remainder gets the same sign as the denominator.
-
-Copyright (C) 1994, 1995, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_fdiv_qr (mpz_ptr quot, mpz_ptr rem, mpz_srcptr dividend, mpz_srcptr divisor)
-#else
-mpz_fdiv_qr (quot, rem, dividend, divisor)
-     mpz_ptr quot;
-     mpz_ptr rem;
-     mpz_srcptr dividend;
-     mpz_srcptr divisor;
-#endif
-{
-  mp_size_t divisor_size = divisor->_mp_size;
-  mp_size_t xsize;
-  mpz_t temp_divisor;		/* N.B.: lives until function returns! */
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-
-  /* We need the original value of the divisor after the quotient and
-     remainder have been preliminary calculated.  We have to copy it to
-     temporary space if it's the same variable as either QUOT or REM.  */
-  if (quot == divisor || rem == divisor)
-    {
-      MPZ_TMP_INIT (temp_divisor, ABS (divisor_size));
-      mpz_set (temp_divisor, divisor);
-      divisor = temp_divisor;
-    }
-
-  xsize = dividend->_mp_size ^ divisor_size;;
-  mpz_tdiv_qr (quot, rem, dividend, divisor);
-
-  if (xsize < 0 && rem->_mp_size != 0)
-    {
-      mpz_sub_ui (quot, quot, 1L);
-      mpz_add (rem, rem, divisor);
-    }
-
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/fdiv_qr_ui.c b/ghc/rts/gmp/mpz/fdiv_qr_ui.c
deleted file mode 100644
index 600c0dacfc..0000000000
--- a/ghc/rts/gmp/mpz/fdiv_qr_ui.c
+++ /dev/null
@@ -1,69 +0,0 @@
-/* mpz_fdiv_qr_ui -- Division rounding the quotient towards -infinity.
-   The remainder gets the same sign as the denominator.
-
-Copyright (C) 1994, 1995, 1996, 1999 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_fdiv_qr_ui (mpz_ptr quot, mpz_ptr rem, mpz_srcptr dividend, unsigned long int divisor)
-#else
-mpz_fdiv_qr_ui (quot, rem, dividend, divisor)
-     mpz_ptr quot;
-     mpz_ptr rem;
-     mpz_srcptr dividend;
-     unsigned long int divisor;
-#endif
-{
-  mp_size_t dividend_size;
-  mp_size_t size;
-  mp_ptr quot_ptr;
-  mp_limb_t remainder_limb;
-
-  if (divisor == 0)
-    DIVIDE_BY_ZERO;
-
-  dividend_size = dividend->_mp_size;
-  size = ABS (dividend_size);
-
-  if (quot->_mp_alloc < size)
-    _mpz_realloc (quot, size);
-
-  quot_ptr = quot->_mp_d;
-
-  remainder_limb = mpn_divmod_1 (quot_ptr, dividend->_mp_d, size,
-				 (mp_limb_t) divisor);
-
-  if (remainder_limb != 0 && dividend_size < 0)
-    {
-      mpn_incr_u (quot_ptr, (mp_limb_t) 1);
-      remainder_limb = divisor - remainder_limb;
-    }
-
-  size -= size != 0 && quot_ptr[size - 1] == 0;
-  quot->_mp_size = dividend_size >= 0 ? size : -size;
-
-  rem->_mp_d[0] = remainder_limb;
-  rem->_mp_size = remainder_limb != 0;
-
-  return remainder_limb;
-}
diff --git a/ghc/rts/gmp/mpz/fdiv_r.c b/ghc/rts/gmp/mpz/fdiv_r.c
deleted file mode 100644
index a3652838d2..0000000000
--- a/ghc/rts/gmp/mpz/fdiv_r.c
+++ /dev/null
@@ -1,58 +0,0 @@
-/* mpz_fdiv_r -- Division rounding the quotient towards -infinity.
-   The remainder gets the same sign as the denominator.
-
-Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_fdiv_r (mpz_ptr rem, mpz_srcptr dividend, mpz_srcptr divisor)
-#else
-mpz_fdiv_r (rem, dividend, divisor)
-     mpz_ptr rem;
-     mpz_srcptr dividend;
-     mpz_srcptr divisor;
-#endif
-{
-  mp_size_t divisor_size = divisor->_mp_size;
-  mpz_t temp_divisor;		/* N.B.: lives until function returns! */
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-
-  /* We need the original value of the divisor after the remainder has been
-     preliminary calculated.  We have to copy it to temporary space if it's
-     the same variable as REM.  */
-  if (rem == divisor)
-    {
-      MPZ_TMP_INIT (temp_divisor, ABS (divisor_size));
-      mpz_set (temp_divisor, divisor);
-      divisor = temp_divisor;
-    }
-
-  mpz_tdiv_r (rem, dividend, divisor);
-
-  if ((divisor_size ^ dividend->_mp_size) < 0 && rem->_mp_size != 0)
-    mpz_add (rem, rem, divisor);
-
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/fdiv_r_2exp.c b/ghc/rts/gmp/mpz/fdiv_r_2exp.c
deleted file mode 100644
index 081ce19203..0000000000
--- a/ghc/rts/gmp/mpz/fdiv_r_2exp.c
+++ /dev/null
@@ -1,156 +0,0 @@
-/* mpz_fdiv_r_2exp -- Divide a integer by 2**CNT and produce a remainder.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1998, 1999, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_fdiv_r_2exp (mpz_ptr res, mpz_srcptr in, unsigned long int cnt)
-#else
-mpz_fdiv_r_2exp (res, in, cnt)
-     mpz_ptr res;
-     mpz_srcptr in;
-     unsigned long int cnt;
-#endif
-{
-  mp_size_t in_size = ABS (in->_mp_size);
-  mp_size_t res_size;
-  mp_size_t limb_cnt = cnt / BITS_PER_MP_LIMB;
-  mp_srcptr in_ptr = in->_mp_d;
-
-  if (in_size > limb_cnt)
-    {
-      /* The input operand is (probably) greater than 2**CNT.  */
-      mp_limb_t x;
-
-      x = in_ptr[limb_cnt] & (((mp_limb_t) 1 << cnt % BITS_PER_MP_LIMB) - 1);
-      if (x != 0)
-	{
-	  res_size = limb_cnt + 1;
-	  if (res->_mp_alloc < res_size)
-	    _mpz_realloc (res, res_size);
-
-	  res->_mp_d[limb_cnt] = x;
-	}
-      else
-	{
-	  res_size = limb_cnt;
-	  MPN_NORMALIZE (in_ptr, res_size);
-
-	  if (res->_mp_alloc < res_size)
-	    _mpz_realloc (res, res_size);
-
-	  limb_cnt = res_size;
-	}
-    }
-  else
-    {
-      /* The input operand is smaller than 2**CNT.  We perform a no-op,
-	 apart from that we might need to copy IN to RES, and may need
-	 to round the result.  */
-      res_size = in_size;
-      if (res->_mp_alloc < res_size)
-	_mpz_realloc (res, res_size);
-
-      limb_cnt = res_size;
-    }
-
-  if (res != in)
-    MPN_COPY (res->_mp_d, in->_mp_d, limb_cnt);
-  in_size = in->_mp_size;
-  res->_mp_size = res_size;
-  if (in_size < 0 && res_size != 0)
-    {
-      /* Result should be 2^CNT - RES */
-      mpz_t tmp;
-      TMP_DECL (marker);
-      TMP_MARK (marker);
-      MPZ_TMP_INIT (tmp, cnt/BITS_PER_MP_LIMB + 2);
-      mpz_set_ui (tmp, 1L);
-      mpz_mul_2exp (tmp, tmp, cnt);
-      mpz_sub (res, tmp, res);
-      TMP_FREE (marker);
-    }
-}
-
-/* This is an alternative ending of the above function using just low-level
-   functions.  Tested, but perhaps excessive?  */
-#if 0
-  if (in->_mp_size < 0 && res_size != 0)
-    {
-      /* Result should be 2^CNT - RES */
-
-      mp_ptr rp;
-
-      limb_cnt = cnt / BITS_PER_MP_LIMB;
-
-      if (res->_mp_alloc <= limb_cnt)
-	_mpz_realloc (res, limb_cnt + 1);
-      rp = PTR(res);
-      if (res_size > limb_cnt)
-	{
-	  mpn_nz_neg (rp, rp, res_size);
-	  rp[limb_cnt] &= ~(~(mp_limb_t) 0 << cnt % BITS_PER_MP_LIMB);
-	  MPN_NORMALIZE_NOT_ZERO (rp, res_size);
-	}
-      else
-	{
-	  mp_size_t i;
-	  mpn_nz_neg (rp, rp, res_size);
-	  for (i = res_size; i < limb_cnt; i++)
-	    rp[i] = ~ (mp_limb_t) 0;
-	  res_size = limb_cnt;
-	  if (cnt % BITS_PER_MP_LIMB != 0)
-	    {
-	      rp[res_size] = ((mp_limb_t) 1 << (cnt % BITS_PER_MP_LIMB)) - 1;
-	      res_size++;
-	    }
-	  else
-	    MPN_NORMALIZE_NOT_ZERO (rp, res_size);
-	}
-    }
-  SIZ(res) = res_size;
-}
-
-static void
-mpn_nz_neg (rp, sp, n)
-     mp_ptr rp, sp;
-     mp_size_t n;
-{
-  mp_size_t i;
-  mp_limb_t x;
-
-  x = sp[0];
-  rp[0] = -x;
-  for (i = 1; x == 0; i++)
-    {
-      x = sp[i];
-      rp[i] = -x;
-    }
-
-  for (; i < n; i++)
-    {
-      rp[i] = ~sp[i];
-    }
-}
-#endif
diff --git a/ghc/rts/gmp/mpz/fdiv_r_ui.c b/ghc/rts/gmp/mpz/fdiv_r_ui.c
deleted file mode 100644
index dd5c743d27..0000000000
--- a/ghc/rts/gmp/mpz/fdiv_r_ui.c
+++ /dev/null
@@ -1,55 +0,0 @@
-/* mpz_fdiv_r_ui -- Division rounding the quotient towards -infinity.
-   The remainder gets the same sign as the denominator.
-
-Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_fdiv_r_ui (mpz_ptr rem, mpz_srcptr dividend, unsigned long int divisor)
-#else
-mpz_fdiv_r_ui (rem, dividend, divisor)
-     mpz_ptr rem;
-     mpz_srcptr dividend;
-     unsigned long int divisor;
-#endif
-{
-  mp_size_t dividend_size;
-  mp_size_t size;
-  mp_limb_t remainder_limb;
-
-  if (divisor == 0)
-    DIVIDE_BY_ZERO;
-
-  dividend_size = dividend->_mp_size;
-  size = ABS (dividend_size);
-
-  remainder_limb = mpn_mod_1 (dividend->_mp_d, size, (mp_limb_t) divisor);
-
-  if (remainder_limb != 0 && dividend_size < 0)
-    remainder_limb = divisor - remainder_limb;
-
-  rem->_mp_d[0] = remainder_limb;
-  rem->_mp_size = remainder_limb != 0;
-
-  return remainder_limb;
-}
diff --git a/ghc/rts/gmp/mpz/fdiv_ui.c b/ghc/rts/gmp/mpz/fdiv_ui.c
deleted file mode 100644
index f937b5f6d0..0000000000
--- a/ghc/rts/gmp/mpz/fdiv_ui.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/* mpz_fdiv_ui -- Division rounding the quotient towards -infinity.
-   The remainder gets the same sign as the denominator.
-
-Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_fdiv_ui (mpz_srcptr dividend, unsigned long int divisor)
-#else
-mpz_fdiv_ui (dividend, divisor)
-     mpz_srcptr dividend;
-     unsigned long int divisor;
-#endif
-{
-  mp_size_t dividend_size;
-  mp_size_t size;
-  mp_limb_t remainder_limb;
-
-  dividend_size = dividend->_mp_size;
-  size = ABS (dividend_size);
-
-  remainder_limb = mpn_mod_1 (dividend->_mp_d, size, (mp_limb_t) divisor);
-
-  if (remainder_limb != 0 && dividend_size < 0)
-    remainder_limb = divisor - remainder_limb;
-
-  return remainder_limb;
-}
diff --git a/ghc/rts/gmp/mpz/fib_ui.c b/ghc/rts/gmp/mpz/fib_ui.c
deleted file mode 100644
index 4bebb80d94..0000000000
--- a/ghc/rts/gmp/mpz/fib_ui.c
+++ /dev/null
@@ -1,165 +0,0 @@
-/* mpz_fib_ui(result, n) -- Set RESULT to the Nth Fibonacci number.
-
-Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-/* This is fast, but could be made somewhat faster and neater.
-   The timing is somewhat fluctuating for even/odd sizes because
-   of the extra hair used to save variables and operations.  Here
-   are a few things one might want to address:
-     1. Avoid using 4 intermediate variables in mpz_fib_bigcase.
-     2. Call mpn functions directly.  Straightforward for these functions.
-     3. Merge the three functions into one.
-
-Said by Kevin:
-   Consider using the Lucas numbers L[n] as an auxiliary sequence, making
-   it possible to do the "doubling" operation in mpz_fib_bigcase with two
-   squares rather than two multiplies.  The formulas are a little more
-   complicated, something like the following (untested).
-
-       F[2n] = ((F[n]+L[n])^2 - 6*F[n]^2 - 4*(-1)^n) / 2
-       L[2n] = 5*F[n]^2 + 2*(-1)^n
-
-       F[2n+1] = (F[2n] + L[2n]) / 2
-       L[2n+1] = (5*F[2n] + L[2n]) / 2
-
-   The Lucas number that comes for free here could even be returned.
-
-   Maybe there's formulas with two squares using just F[n], but I don't
-   know of any.
-*/
-
-/* Determine the needed storage for Fib(n).  */
-#define FIB_SIZE(n) (((mp_size_t) ((n)*0.695)) / BITS_PER_MP_LIMB + 2)
-
-static void mpz_fib_bigcase _PROTO ((mpz_t, mpz_t, unsigned long int));
-static void mpz_fib_basecase _PROTO ((mpz_t, mpz_t, unsigned long int));
-
-
-#ifndef FIB_THRESHOLD
-#define FIB_THRESHOLD 60
-#endif
-
-void
-#if __STDC__
-mpz_fib_ui (mpz_t r, unsigned long int n)
-#else
-mpz_fib_ui (r, n)
-     mpz_t r;
-     unsigned long int n;
-#endif
-{
-  if (n == 0)
-    mpz_set_ui (r, 0);
-  else
-    {
-      mpz_t t1;
-      mpz_init (t1);
-      if (n < FIB_THRESHOLD)
-	mpz_fib_basecase (t1, r, n);
-      else
-	mpz_fib_bigcase (t1, r, n);
-      mpz_clear (t1);
-    }
-}
-
-static void
-#if __STDC__
-mpz_fib_basecase (mpz_t t1, mpz_t t2, unsigned long int n)
-#else
-mpz_fib_basecase (t1, t2, n)
-     mpz_t t1;
-     mpz_t t2;
-     unsigned long int n;
-#endif
-{
-  unsigned long int m, i;
-
-  mpz_set_ui (t1, 0);
-  mpz_set_ui (t2, 1);
-  m = n/2;
-  for (i = 0; i < m; i++)
-    {
-      mpz_add (t1, t1, t2);
-      mpz_add (t2, t1, t2);
-    }
-  if ((n & 1) == 0)
-    {
-      mpz_sub (t1, t2, t1);
-      mpz_sub (t2, t2, t1);	/* trick: recover t1 value just overwritten */
-    }
-}
-
-static void
-#if __STDC__
-mpz_fib_bigcase (mpz_t t1, mpz_t t2, unsigned long int n)
-#else
-mpz_fib_bigcase (t1, t2, n)
-     mpz_t t1;
-     mpz_t t2;
-     unsigned long int n;
-#endif
-{
-  unsigned long int n2;
-  int ni, i;
-  mpz_t x1, x2, u1, u2;
-
-  ni = 0;
-  for (n2 = n; n2 >= FIB_THRESHOLD; n2 /= 2)
-    ni++;
-
-  mpz_fib_basecase (t1, t2, n2);
-
-  mpz_init (x1);
-  mpz_init (x2);
-  mpz_init (u1);
-  mpz_init (u2);
-
-  for (i = ni - 1; i >= 0; i--)
-    {
-      mpz_mul_2exp (x1, t1, 1);
-      mpz_mul_2exp (x2, t2, 1);
-
-      mpz_add (x1, x1, t2);
-      mpz_sub (x2, x2, t1);
-
-      mpz_mul (u1, t2, x1);
-      mpz_mul (u2, t1, x2);
-
-      if (((n >> i) & 1) == 0)
-	{
-	  mpz_sub (t1, u1, u2);
-	  mpz_set (t2, u1);
-	}
-      else
-	{
-	  mpz_set (t1, u1);
-	  mpz_mul_2exp (t2, u1, 1);
-	  mpz_sub (t2, t2, u2);
-	}
-    }
-
-  mpz_clear (x1);
-  mpz_clear (x2);
-  mpz_clear (u1);
-  mpz_clear (u2);
-}
diff --git a/ghc/rts/gmp/mpz/fits_sint_p.c b/ghc/rts/gmp/mpz/fits_sint_p.c
deleted file mode 100644
index 82e32a24d5..0000000000
--- a/ghc/rts/gmp/mpz/fits_sint_p.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/* int mpz_fits_X_p (mpz_t src) -- Return whether src fits the C type X.
-
-Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-mpz_fits_sint_p (mpz_srcptr src)
-#else
-mpz_fits_sint_p (src)
-     mpz_srcptr src;
-#endif
-{
-  mp_size_t size;
-  mp_limb_t mpl;
-
-  mpl = PTR(src)[0];
-  size = SIZ(src);
-  if (size > 0)
-    {
-      if (size > 1)
-	return 0;
-      return mpl < ~((~(unsigned int) 0) >> 1);
-    }
-  else
-    {
-      if (size < -1)
-	return 0;
-      return mpl <= ~((~(unsigned int) 0) >> 1);
-    }
-}
diff --git a/ghc/rts/gmp/mpz/fits_slong_p.c b/ghc/rts/gmp/mpz/fits_slong_p.c
deleted file mode 100644
index e0669b5aaa..0000000000
--- a/ghc/rts/gmp/mpz/fits_slong_p.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/* int mpz_fits_X_p (mpz_t src) -- Return whether src fits the C type X.
-
-Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-mpz_fits_slong_p (mpz_srcptr src)
-#else
-mpz_fits_slong_p (src)
-     mpz_srcptr src;
-#endif
-{
-  mp_size_t size;
-  mp_limb_t mpl;
-
-  mpl = PTR(src)[0];
-  size = SIZ(src);
-  if (size > 0)
-    {
-      if (size > 1)
-	return 0;
-      return mpl < ~((~(unsigned long int) 0) >> 1);
-    }
-  else
-    {
-      if (size < -1)
-	return 0;
-      return mpl <= ~((~(unsigned long int) 0) >> 1);
-    }
-}
diff --git a/ghc/rts/gmp/mpz/fits_sshort_p.c b/ghc/rts/gmp/mpz/fits_sshort_p.c
deleted file mode 100644
index 5b8e31afae..0000000000
--- a/ghc/rts/gmp/mpz/fits_sshort_p.c
+++ /dev/null
@@ -1,50 +0,0 @@
-/* int mpz_fits_X_p (mpz_t src) -- Return whether src fits the C type X.
-
-Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-mpz_fits_sshort_p (mpz_srcptr src)
-#else
-mpz_fits_sshort_p (src)
-     mpz_srcptr src;
-#endif
-{
-  mp_size_t size;
-  mp_limb_t mpl;
-
-  mpl = PTR(src)[0];
-  size = SIZ(src);
-  if (size > 0)
-    {
-      if (size > 1)
-	return 0;
-      return mpl <= (((unsigned short int) ~(unsigned int) 0) >> 1);
-    }
-  else
-    {
-      if (size < -1)
-	return 0;
-      return mpl <= (((unsigned short int) ~(unsigned int) 0) >> 1) + 1;
-    }
-}
diff --git a/ghc/rts/gmp/mpz/fits_uint_p.c b/ghc/rts/gmp/mpz/fits_uint_p.c
deleted file mode 100644
index 72f62fa723..0000000000
--- a/ghc/rts/gmp/mpz/fits_uint_p.c
+++ /dev/null
@@ -1,41 +0,0 @@
-/* int mpz_fits_X_p (mpz_t src) -- Return whether src fits the C type X.
-
-Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-mpz_fits_uint_p (mpz_srcptr src)
-#else
-mpz_fits_uint_p (src)
-     mpz_srcptr src;
-#endif
-{
-  mp_size_t size;
-  mp_limb_t mpl;
-
-  mpl = PTR(src)[0];
-  size = SIZ(src);
-  if (size < 0 || size > 1)
-    return 0;
-  return mpl <= (~(unsigned int) 0);
-}
diff --git a/ghc/rts/gmp/mpz/fits_ulong_p.c b/ghc/rts/gmp/mpz/fits_ulong_p.c
deleted file mode 100644
index 92eb42e86e..0000000000
--- a/ghc/rts/gmp/mpz/fits_ulong_p.c
+++ /dev/null
@@ -1,41 +0,0 @@
-/* int mpz_fits_X_p (mpz_t src) -- Return whether src fits the C type X.
-
-Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-mpz_fits_ulong_p (mpz_srcptr src)
-#else
-mpz_fits_ulong_p (src)
-     mpz_srcptr src;
-#endif
-{
-  mp_size_t size;
-  mp_limb_t mpl;
-
-  mpl = PTR(src)[0];
-  size = SIZ(src);
-  if (size < 0 || size > 1)
-    return 0;
-  return mpl <= (~(unsigned long int) 0);
-}
diff --git a/ghc/rts/gmp/mpz/fits_ushort_p.c b/ghc/rts/gmp/mpz/fits_ushort_p.c
deleted file mode 100644
index bde0edae6e..0000000000
--- a/ghc/rts/gmp/mpz/fits_ushort_p.c
+++ /dev/null
@@ -1,41 +0,0 @@
-/* int mpz_fits_X_p (mpz_t src) -- Return whether src fits the C type X.
-
-Copyright (C) 1997, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-mpz_fits_ushort_p (mpz_srcptr src)
-#else
-mpz_fits_ushort_p (src)
-     mpz_srcptr src;
-#endif
-{
-  mp_size_t size;
-  mp_limb_t mpl;
-
-  mpl = PTR(src)[0];
-  size = SIZ(src);
-  if (size < 0 || size > 1)
-    return 0;
-  return mpl <= ((unsigned short int) ~(unsigned int) 0);
-}
diff --git a/ghc/rts/gmp/mpz/gcd.c b/ghc/rts/gmp/mpz/gcd.c
deleted file mode 100644
index 0d950dd609..0000000000
--- a/ghc/rts/gmp/mpz/gcd.c
+++ /dev/null
@@ -1,180 +0,0 @@
-/* mpz/gcd.c:   Calculate the greatest common divisor of two integers.
-
-Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-#ifdef BERKELEY_MP
-#include "mp.h"
-#endif
-
-
-#ifndef BERKELEY_MP
-void
-#if __STDC__
-mpz_gcd (mpz_ptr g, mpz_srcptr u, mpz_srcptr v)
-#else
-mpz_gcd (g, u, v)
-     mpz_ptr g;
-     mpz_srcptr u;
-     mpz_srcptr v;
-#endif
-#else /* BERKELEY_MP */
-void
-#if __STDC__
-gcd (mpz_srcptr u, mpz_srcptr v, mpz_ptr g)
-#else
-gcd (u, v, g)
-     mpz_ptr g;
-     mpz_srcptr u;
-     mpz_srcptr v;
-#endif
-#endif /* BERKELEY_MP */
-
-{
-  unsigned long int g_zero_bits, u_zero_bits, v_zero_bits;
-  mp_size_t g_zero_limbs, u_zero_limbs, v_zero_limbs;
-  mp_ptr tp;
-  mp_ptr up = u->_mp_d;
-  mp_size_t usize = ABS (u->_mp_size);
-  mp_ptr vp = v->_mp_d;
-  mp_size_t vsize = ABS (v->_mp_size);
-  mp_size_t gsize;
-  TMP_DECL (marker);
-
-  /* GCD(0, V) == V.  */
-  if (usize == 0)
-    {
-      g->_mp_size = vsize;
-      if (g == v)
-	return;
-      if (g->_mp_alloc < vsize)
-	_mpz_realloc (g, vsize);
-      MPN_COPY (g->_mp_d, vp, vsize);
-      return;
-    }
-
-  /* GCD(U, 0) == U.  */
-  if (vsize == 0)
-    {
-      g->_mp_size = usize;
-      if (g == u)
-	return;
-      if (g->_mp_alloc < usize)
-	_mpz_realloc (g, usize);
-      MPN_COPY (g->_mp_d, up, usize);
-      return;
-    }
-
-  if (usize == 1)
-    {
-      g->_mp_size = 1;
-      g->_mp_d[0] = mpn_gcd_1 (vp, vsize, up[0]);
-      return;
-    }
-
-  if (vsize == 1)
-    {
-      g->_mp_size = 1;
-      g->_mp_d[0] = mpn_gcd_1 (up, usize, vp[0]);
-      return;
-    }
-
-  TMP_MARK (marker);
-
-  /*  Eliminate low zero bits from U and V and move to temporary storage.  */
-  while (*up == 0)
-    up++;
-  u_zero_limbs = up - u->_mp_d;
-  usize -= u_zero_limbs;
-  count_trailing_zeros (u_zero_bits, *up);
-  tp = up;
-  up = (mp_ptr) TMP_ALLOC (usize * BYTES_PER_MP_LIMB);
-  if (u_zero_bits != 0)
-    {
-      mpn_rshift (up, tp, usize, u_zero_bits);
-      usize -= up[usize - 1] == 0;
-    }
-  else
-    MPN_COPY (up, tp, usize);
-
-  while (*vp == 0)
-    vp++;
-  v_zero_limbs = vp - v->_mp_d;
-  vsize -= v_zero_limbs;
-  count_trailing_zeros (v_zero_bits, *vp);
-  tp = vp;
-  vp = (mp_ptr) TMP_ALLOC (vsize * BYTES_PER_MP_LIMB);
-  if (v_zero_bits != 0)
-    {
-      mpn_rshift (vp, tp, vsize, v_zero_bits);
-      vsize -= vp[vsize - 1] == 0;
-    }
-  else
-    MPN_COPY (vp, tp, vsize);
-
-  if (u_zero_limbs > v_zero_limbs)
-    {
-      g_zero_limbs = v_zero_limbs;
-      g_zero_bits = v_zero_bits;
-    }
-  else if (u_zero_limbs < v_zero_limbs)
-    {
-      g_zero_limbs = u_zero_limbs;
-      g_zero_bits = u_zero_bits;
-    }
-  else  /*  Equal.  */
-    {
-      g_zero_limbs = u_zero_limbs;
-      g_zero_bits = MIN (u_zero_bits, v_zero_bits);
-    }
-
-  /*  Call mpn_gcd.  The 2nd argument must not have more bits than the 1st.  */
-  vsize = (usize < vsize || (usize == vsize && up[usize-1] < vp[vsize-1]))
-    ? mpn_gcd (vp, vp, vsize, up, usize)
-    : mpn_gcd (vp, up, usize, vp, vsize);
-
-  /*  Here G <-- V << (g_zero_limbs*BITS_PER_MP_LIMB + g_zero_bits).  */
-  gsize = vsize + g_zero_limbs;
-  if (g_zero_bits != 0)
-    {
-      mp_limb_t cy_limb;
-      gsize += (vp[vsize - 1] >> (BITS_PER_MP_LIMB - g_zero_bits)) != 0;
-      if (g->_mp_alloc < gsize)
-	_mpz_realloc (g, gsize);
-      MPN_ZERO (g->_mp_d, g_zero_limbs);
-
-      tp = g->_mp_d + g_zero_limbs;
-      cy_limb = mpn_lshift (tp, vp, vsize, g_zero_bits);
-      if (cy_limb != 0)
-	tp[vsize] = cy_limb;
-    }
-  else
-    {
-      if (g->_mp_alloc < gsize)
-	_mpz_realloc (g, gsize);
-      MPN_ZERO (g->_mp_d, g_zero_limbs);
-      MPN_COPY (g->_mp_d + g_zero_limbs, vp, vsize);
-    }
-
-  g->_mp_size = gsize;
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/gcd_ui.c b/ghc/rts/gmp/mpz/gcd_ui.c
deleted file mode 100644
index f3bec58829..0000000000
--- a/ghc/rts/gmp/mpz/gcd_ui.c
+++ /dev/null
@@ -1,65 +0,0 @@
-/* mpz_gcd_ui -- Calculate the greatest common divisior of two integers.
-
-Copyright (C) 1994, 1996, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h> /* for NULL */
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_gcd_ui (mpz_ptr w, mpz_srcptr u, unsigned long int v)
-#else
-mpz_gcd_ui (w, u, v)
-     mpz_ptr w;
-     mpz_srcptr u;
-     unsigned long int v;
-#endif
-{
-  mp_size_t size;
-  mp_limb_t res;
-
-  size = ABS (u->_mp_size);
-
-  if (size == 0)
-    res = v;
-  else if (v == 0)
-    {
-      if (w != NULL && u != w)
-	{
-	  if (w->_mp_alloc < size)
-	    _mpz_realloc (w, size);
-
-	  MPN_COPY (w->_mp_d, u->_mp_d, size);
-	}
-      w->_mp_size = size;
-      /* We can't return any useful result for gcd(big,0).  */
-      return size > 1 ? 0 : w->_mp_d[0];
-    }
-  else
-    res = mpn_gcd_1 (u->_mp_d, size, (mp_limb_t) v);
-
-  if (w != NULL)
-    {
-      w->_mp_d[0] = res;
-      w->_mp_size = 1;
-    }
-  return res;
-}
diff --git a/ghc/rts/gmp/mpz/gcdext.c b/ghc/rts/gmp/mpz/gcdext.c
deleted file mode 100644
index 3ba04c84ff..0000000000
--- a/ghc/rts/gmp/mpz/gcdext.c
+++ /dev/null
@@ -1,137 +0,0 @@
-/* mpz_gcdext(g, s, t, a, b) -- Set G to gcd(a, b), and S and T such that
-   g = as + bt.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1996, 1997, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h> /* for NULL */
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_gcdext (mpz_ptr g, mpz_ptr s, mpz_ptr t, mpz_srcptr a, mpz_srcptr b)
-#else
-mpz_gcdext (g, s, t, a, b)
-     mpz_ptr g;
-     mpz_ptr s;
-     mpz_ptr t;
-     mpz_srcptr a;
-     mpz_srcptr b;
-#endif
-{
-  mp_size_t asize, bsize, usize, vsize;
-  mp_srcptr ap, bp;
-  mp_ptr up, vp;
-  mp_size_t gsize, ssize, tmp_ssize;
-  mp_ptr gp, sp, tmp_gp, tmp_sp;
-  mpz_srcptr u, v;
-  mpz_ptr ss, tt;
-  __mpz_struct stmp, gtmp;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-
-  /* mpn_gcdext requires that U >= V.  Therefore, we often have to swap U and
-     V.  This in turn leads to a lot of complications.  The computed cofactor
-     will be the wrong one, so we have to fix that up at the end.  */
-
-  asize = ABS (SIZ (a));
-  bsize = ABS (SIZ (b));
-  ap = PTR (a);
-  bp = PTR (b);
-  if (asize > bsize || (asize == bsize && mpn_cmp (ap, bp, asize) > 0))
-    {
-      usize = asize;
-      vsize = bsize;
-      up = (mp_ptr) TMP_ALLOC ((usize + 1) * BYTES_PER_MP_LIMB);
-      vp = (mp_ptr) TMP_ALLOC ((vsize + 1) * BYTES_PER_MP_LIMB);
-      MPN_COPY (up, ap, usize);
-      MPN_COPY (vp, bp, vsize);
-      u = a;
-      v = b;
-      ss = s;
-      tt = t;
-    }
-  else
-    {
-      usize = bsize;
-      vsize = asize;
-      up = (mp_ptr) TMP_ALLOC ((usize + 1) * BYTES_PER_MP_LIMB);
-      vp = (mp_ptr) TMP_ALLOC ((vsize + 1) * BYTES_PER_MP_LIMB);
-      MPN_COPY (up, bp, usize);
-      MPN_COPY (vp, ap, vsize);
-      u = b;
-      v = a;
-      ss = t;
-      tt = s;
-    }
-
-  tmp_gp = (mp_ptr) TMP_ALLOC ((usize + 1) * BYTES_PER_MP_LIMB);
-  tmp_sp = (mp_ptr) TMP_ALLOC ((usize + 1) * BYTES_PER_MP_LIMB);
-
-  if (vsize == 0)
-    {
-      tmp_sp[0] = 1;
-      tmp_ssize = 1;
-      MPN_COPY (tmp_gp, up, usize);
-      gsize = usize;
-    }
-  else
-    gsize = mpn_gcdext (tmp_gp, tmp_sp, &tmp_ssize, up, usize, vp, vsize);
-  ssize = ABS (tmp_ssize);
-
-  PTR (&gtmp) = tmp_gp;
-  SIZ (&gtmp) = gsize;
-
-  PTR (&stmp) = tmp_sp;
-  SIZ (&stmp) = (tmp_ssize ^ SIZ (u)) >= 0 ? ssize : -ssize;
-
-  if (tt != NULL)
-    {
-      if (SIZ (v) == 0)
-	SIZ (tt) = 0;
-      else
-	{
-	  mpz_t x;
-	  MPZ_TMP_INIT (x, ssize + usize + 1);
-	  mpz_mul (x, &stmp, u);
-	  mpz_sub (x, &gtmp, x);
-	  mpz_tdiv_q (tt, x, v);
-	}
-    }
-
-  if (ss != NULL)
-    {
-      if (ALLOC (ss) < ssize)
-	_mpz_realloc (ss, ssize);
-      sp = PTR (ss);
-      MPN_COPY (sp, tmp_sp, ssize);
-      SIZ (ss) = SIZ (&stmp);
-    }
-
-  if (ALLOC (g) < gsize)
-    _mpz_realloc (g, gsize);
-  gp = PTR (g);
-  MPN_COPY (gp, tmp_gp, gsize);
-  SIZ (g) = gsize;
-
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/get_d.c b/ghc/rts/gmp/mpz/get_d.c
deleted file mode 100644
index 6a7c5856bb..0000000000
--- a/ghc/rts/gmp/mpz/get_d.c
+++ /dev/null
@@ -1,128 +0,0 @@
-/* double mpz_get_d (mpz_t src) -- Return the double approximation to SRC.
-
-Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-static int
-#if __STDC__
-mpn_zero_p (mp_ptr p, mp_size_t n)
-#else
-mpn_zero_p (p, n)
-     mp_ptr p;
-     mp_size_t n;
-#endif
-{
-  mp_size_t i;
-
-  for (i = 0; i < n; i++)
-    {
-      if (p[i] != 0)
-	return 0;
-    }
-
-  return 1;
-}
-
-
-double
-#if __STDC__
-mpz_get_d (mpz_srcptr src)
-#else
-mpz_get_d (src)
-     mpz_srcptr src;
-#endif
-{
-  double res;
-  mp_size_t size;
-  int negative;
-  mp_ptr qp;
-  mp_limb_t hz, lz;
-  int cnt;
-
-  size = SIZ(src);
-  if (size == 0)
-    return 0.0;
-
-  negative = size < 0;
-  size = ABS (size);
-  qp = PTR(src);
-
-  if (size == 1)
-    {
-      res = qp[size - 1];
-    }
-  else if (size == 2)
-    {
-      res = MP_BASE_AS_DOUBLE * qp[size - 1] + qp[size - 2];
-    }
-  else
-    {
-      count_leading_zeros (cnt, qp[size - 1]);
-
-#if BITS_PER_MP_LIMB == 32
-      if (cnt == 0)
-	{
-	  hz = qp[size - 1];
-	  lz = qp[size - 2];
-	}
-      else
-	{
-	  hz = (qp[size - 1] << cnt) | (qp[size - 2] >> BITS_PER_MP_LIMB - cnt);
-	  lz = (qp[size - 2] << cnt) | (qp[size - 3] >> BITS_PER_MP_LIMB - cnt);
-	}
-#if _GMP_IEEE_FLOATS
-      /* Take bits from less significant limbs, but only if they may affect
-	 the result.  */
-      if ((lz & 0x7ff) == 0x400)
-	{
-	  if (cnt != 0)
-	    lz += ((qp[size - 3] << cnt) != 0 || ! mpn_zero_p (qp, size - 3));
-	  else
-	    lz += (! mpn_zero_p (qp, size - 2));
-	}
-#endif
-      res = MP_BASE_AS_DOUBLE * hz + lz;
-      res = __gmp_scale2 (res, (size - 2) * BITS_PER_MP_LIMB - cnt);
-#endif
-#if BITS_PER_MP_LIMB == 64
-      if (cnt == 0)
-	hz = qp[size - 1];
-      else
-	hz = (qp[size - 1] << cnt) | (qp[size - 2] >> BITS_PER_MP_LIMB - cnt);
-#if _GMP_IEEE_FLOATS
-      if ((hz & 0x7ff) == 0x400)
-	{
-	  if (cnt != 0)
-	    hz += ((qp[size - 2] << cnt) != 0 || ! mpn_zero_p (qp, size - 2));
-	  else
-	    hz += (! mpn_zero_p (qp, size - 1));
-	}
-#endif
-      res = hz;
-      res = __gmp_scale2 (res, (size - 1) * BITS_PER_MP_LIMB - cnt);
-#endif
-    }
-
-  return negative ? -res : res;
-}
diff --git a/ghc/rts/gmp/mpz/get_si.c b/ghc/rts/gmp/mpz/get_si.c
deleted file mode 100644
index 8a5d0e4803..0000000000
--- a/ghc/rts/gmp/mpz/get_si.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/* mpz_get_si(integer) -- Return the least significant digit from INTEGER.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-signed long int
-#if __STDC__
-mpz_get_si (mpz_srcptr op)
-#else
-mpz_get_si (op)
-     mpz_srcptr op;
-#endif
-{
-  mp_size_t size = op->_mp_size;
-  mp_limb_t low_limb = op->_mp_d[0];
-
-  if (size > 0)
-    return low_limb % ((mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1));
-  else if (size < 0)
-    /* This convoluted expression is necessary to properly handle 0x80000000 */
-    return ~((low_limb - 1) % ((mp_limb_t) 1 << (BITS_PER_MP_LIMB - 1)));
-  else
-    return 0;
-}
diff --git a/ghc/rts/gmp/mpz/get_str.c b/ghc/rts/gmp/mpz/get_str.c
deleted file mode 100644
index c7278afb52..0000000000
--- a/ghc/rts/gmp/mpz/get_str.c
+++ /dev/null
@@ -1,118 +0,0 @@
-/* mpz_get_str (string, base, mp_src) -- Convert the multiple precision
-   number MP_SRC to a string STRING of base BASE.  If STRING is NULL
-   allocate space for the result.  In any case, return a pointer to the
-   result.  If STRING is not NULL, the caller must ensure enough space is
-   available to store the result.
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-char *
-#if __STDC__
-mpz_get_str (char *res_str, int base, mpz_srcptr x)
-#else
-mpz_get_str (res_str, base, x)
-     char *res_str;
-     int base;
-     mpz_srcptr x;
-#endif
-{
-  mp_ptr xp;
-  mp_size_t x_size = x->_mp_size;
-  unsigned char *str;
-  char *return_str;
-  size_t str_size;
-  char *num_to_text;
-  int i;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-  if (base >= 0)
-    {
-      if (base == 0)
-	base = 10;
-      num_to_text = "0123456789abcdefghijklmnopqrstuvwxyz";
-    }
-  else
-    {
-      base = -base;
-      num_to_text = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
-    }
-
-  /* We allways allocate space for the string.  If the caller passed a
-     NULL pointer for RES_STR, we allocate permanent space and return
-     a pointer to that to the caller.  */
-  str_size = ((size_t) (ABS (x_size) * BITS_PER_MP_LIMB
-			* __mp_bases[base].chars_per_bit_exactly)) + 3;
-  if (res_str == 0)
-    {
-      /* We didn't get a string from the user.  Allocate one (and return
-	 a pointer to it).  */
-      res_str = (char *) (*_mp_allocate_func) (str_size);
-      /* Make str, the variable used for raw result from mpn_get_str,
-	 point to the same string, but just after a possible minus sign.  */
-      str = (unsigned char *) res_str + 1;
-    }
-  else
-    {
-      /* Use TMP_ALLOC to get temporary space, since we need a few extra bytes
-	 that we can't expect to caller to supply us with.  */
-      str = (unsigned char *) TMP_ALLOC (str_size);
-    }
-
-  return_str = res_str;
-
-  if (x_size == 0)
-    {
-      res_str[0] = '0';
-      res_str[1] = 0;
-      TMP_FREE (marker);
-      return res_str;
-    }
-  if (x_size < 0)
-    {
-      *res_str++ = '-';
-      x_size = -x_size;
-    }
-
-  /* Move the number to convert into temporary space, since mpn_get_str
-     clobbers its argument + needs one extra high limb....  */
-  xp = (mp_ptr) TMP_ALLOC ((x_size + 1) * BYTES_PER_MP_LIMB);
-  MPN_COPY (xp, x->_mp_d, x_size);
-
-  str_size = mpn_get_str (str, base, xp, x_size);
-
-  /* mpn_get_str might make some leading zeros.  Skip them.  */
-  while (*str == 0)
-    {
-      str_size--;
-      str++;
-    }
-
-  /* Translate result to printable chars and move result to RES_STR.  */
-  for (i = 0; i < str_size; i++)
-    res_str[i] = num_to_text[str[i]];
-  res_str[str_size] = 0;
-
-  TMP_FREE (marker);
-  return return_str;
-}
diff --git a/ghc/rts/gmp/mpz/get_ui.c b/ghc/rts/gmp/mpz/get_ui.c
deleted file mode 100644
index a8ec9e01a4..0000000000
--- a/ghc/rts/gmp/mpz/get_ui.c
+++ /dev/null
@@ -1,37 +0,0 @@
-/* mpz_get_ui(integer) -- Return the least significant digit from INTEGER.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_get_ui (mpz_srcptr integer)
-#else
-mpz_get_ui (integer)
-     mpz_srcptr integer;
-#endif
-{
-  if (integer->_mp_size == 0)
-    return 0;
-  else
-    return integer->_mp_d[0];
-}
diff --git a/ghc/rts/gmp/mpz/getlimbn.c b/ghc/rts/gmp/mpz/getlimbn.c
deleted file mode 100644
index b772ed05c4..0000000000
--- a/ghc/rts/gmp/mpz/getlimbn.c
+++ /dev/null
@@ -1,38 +0,0 @@
-/* mpz_getlimbn(integer,n) -- Return the N:th limb from INTEGER.
-
-Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-mp_limb_t
-#if __STDC__
-mpz_getlimbn (mpz_srcptr integer, mp_size_t n)
-#else
-mpz_getlimbn (integer, n)
-     mpz_srcptr integer;
-     mp_size_t n;
-#endif
-{
-  if (ABS (integer->_mp_size) <= n || n < 0)
-    return 0;
-  else
-    return integer->_mp_d[n];
-}
diff --git a/ghc/rts/gmp/mpz/hamdist.c b/ghc/rts/gmp/mpz/hamdist.c
deleted file mode 100644
index b039a653d2..0000000000
--- a/ghc/rts/gmp/mpz/hamdist.c
+++ /dev/null
@@ -1,62 +0,0 @@
-/* mpz_hamdist(mpz_ptr op1, mpz_ptr op2) -- Compute the hamming distance
-   between OP1 and OP2.  If one of the operands is negative, return ~0.  (We
-   could make the function well-defined when both operands are negative, but
-   that would probably not be worth the trouble.
-
-Copyright (C) 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_hamdist (mpz_srcptr u, mpz_srcptr v)
-#else
-mpz_hamdist (u, v)
-     mpz_srcptr u;
-     mpz_srcptr v;
-#endif
-{
-  mp_srcptr up, vp;
-  mp_size_t usize, vsize, size;
-  unsigned long int count;
-
-  usize = u->_mp_size;
-  vsize = v->_mp_size;
-
-  if ((usize | vsize) < 0)
-    return ~ (unsigned long int) 0;
-
-  up = u->_mp_d;
-  vp = v->_mp_d;
-
-  if (usize > vsize)
-    {
-      count = mpn_popcount (up + vsize, usize - vsize);
-      size = vsize;
-    }
-  else
-    {
-      count = mpn_popcount (vp + usize, vsize - usize);
-      size = usize;
-    }
-
-  return count + mpn_hamdist (up, vp, size);
-}
diff --git a/ghc/rts/gmp/mpz/init.c b/ghc/rts/gmp/mpz/init.c
deleted file mode 100644
index 2e8e4d2cbd..0000000000
--- a/ghc/rts/gmp/mpz/init.c
+++ /dev/null
@@ -1,36 +0,0 @@
-/* mpz_init() -- Make a new multiple precision number with value 0.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_init (mpz_ptr x)
-#else
-mpz_init (x)
-     mpz_ptr x;
-#endif
-{
-  x->_mp_alloc = 1;
-  x->_mp_d = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
-  x->_mp_size = 0;
-}
diff --git a/ghc/rts/gmp/mpz/inp_raw.c b/ghc/rts/gmp/mpz/inp_raw.c
deleted file mode 100644
index 15e601229d..0000000000
--- a/ghc/rts/gmp/mpz/inp_raw.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/* mpz_inp_raw -- Input a mpz_t in raw, but endianess, and wordsize
-   independent format (as output by mpz_out_raw).
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h>
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-size_t
-#if __STDC__
-mpz_inp_raw (mpz_ptr x, FILE *stream)
-#else
-mpz_inp_raw (x, stream)
-     mpz_ptr x;
-     FILE *stream;
-#endif
-{
-  int i;
-  mp_size_t s;
-  mp_size_t xsize;
-  mp_ptr xp;
-  unsigned int c;
-  mp_limb_t x_limb;
-  mp_size_t in_bytesize;
-  int neg_flag;
-
-  if (stream == 0)
-    stream = stdin;
-
-  /* Read 4-byte size */
-  in_bytesize = 0;
-  for (i = 4 - 1; i >= 0; i--)
-    {
-      c = fgetc (stream);
-      in_bytesize = (in_bytesize << BITS_PER_CHAR) | c;
-    }
-
-  /* Size is stored as a 32 bit word; sign extend in_bytesize for non-32 bit
-     machines.  */
-  if (sizeof (mp_size_t) > 4)
-    in_bytesize |= (-(in_bytesize < 0)) << 31;
-
-  neg_flag = in_bytesize < 0;
-  in_bytesize = ABS (in_bytesize);
-  xsize = (in_bytesize + BYTES_PER_MP_LIMB - 1) / BYTES_PER_MP_LIMB;
-
-  if (xsize == 0)
-    {
-      x->_mp_size = 0;
-      return 4;			/* we've read 4 bytes */
-    }
-
-  if (x->_mp_alloc < xsize)
-    _mpz_realloc (x, xsize);
-  xp = x->_mp_d;
-
-  x_limb = 0;
-  for (i = (in_bytesize - 1) % BYTES_PER_MP_LIMB; i >= 0; i--)
-    {
-      c = fgetc (stream);
-      x_limb = (x_limb << BITS_PER_CHAR) | c;
-    }
-  xp[xsize - 1] = x_limb;
-
-  for (s = xsize - 2; s >= 0; s--)
-    {
-      x_limb = 0;
-      for (i = BYTES_PER_MP_LIMB - 1; i >= 0; i--)
-	{
-	  c = fgetc (stream);
-	  x_limb = (x_limb << BITS_PER_CHAR) | c;
-	}
-      xp[s] = x_limb;
-    }
-
-  if (c == EOF)
-    return 0;			/* error */
-
-  MPN_NORMALIZE (xp, xsize);
-  x->_mp_size = neg_flag ? -xsize : xsize;
-  return in_bytesize + 4;
-}
diff --git a/ghc/rts/gmp/mpz/inp_str.c b/ghc/rts/gmp/mpz/inp_str.c
deleted file mode 100644
index 7aa5e1fc30..0000000000
--- a/ghc/rts/gmp/mpz/inp_str.c
+++ /dev/null
@@ -1,167 +0,0 @@
-/* mpz_inp_str(dest_integer, stream, base) -- Input a number in base
-   BASE from stdio stream STREAM and store the result in DEST_INTEGER.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1998, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h>
-#include <ctype.h>
-#include "gmp.h"
-#include "gmp-impl.h"
-
-static int
-#if __STDC__
-digit_value_in_base (int c, int base)
-#else
-digit_value_in_base (c, base)
-     int c;
-     int base;
-#endif
-{
-  int digit;
-
-  if (isdigit (c))
-    digit = c - '0';
-  else if (islower (c))
-    digit = c - 'a' + 10;
-  else if (isupper (c))
-    digit = c - 'A' + 10;
-  else
-    return -1;
-
-  if (digit < base)
-    return digit;
-  return -1;
-}
-
-size_t
-#if __STDC__
-mpz_inp_str (mpz_ptr x, FILE *stream, int base)
-#else
-mpz_inp_str (x, stream, base)
-     mpz_ptr x;
-     FILE *stream;
-     int base;
-#endif
-{
-  char *str;
-  size_t alloc_size, str_size;
-  int c;
-  int negative;
-  mp_size_t xsize;
-  size_t nread;
-
-  if (stream == 0)
-    stream = stdin;
-
-  nread = 0;
-
-  /* Skip whitespace.  */
-  do
-    {
-      c = getc (stream);
-      nread++;
-    }
-  while (isspace (c));
-
-  negative = 0;
-  if (c == '-')
-    {
-      negative = 1;
-      c = getc (stream);
-      nread++;
-    }
-
-  if (digit_value_in_base (c, base == 0 ? 10 : base) < 0)
-    return 0;			/* error if no digits */
-
-  /* If BASE is 0, try to find out the base by looking at the initial
-     characters.  */
-  if (base == 0)
-    {
-      base = 10;
-      if (c == '0')
-	{
-	  base = 8;
-	  c = getc (stream);
-	  nread++;
-	  if (c == 'x' || c == 'X')
-	    {
-	      base = 16;
-	      c = getc (stream);
-	      nread++;
-	    }
-	  else if (c == 'b' || c == 'B')
-	    {
-	      base = 2;
-	      c = getc (stream);
-	      nread++;
-	    }
-	}
-    }
-
-  /* Skip leading zeros.  */
-  while (c == '0')
-    {
-      c = getc (stream);
-      nread++;
-    }
-
-  alloc_size = 100;
-  str = (char *) (*_mp_allocate_func) (alloc_size);
-  str_size = 0;
-
-  for (;;)
-    {
-      int dig;
-      if (str_size >= alloc_size)
-	{
-	  size_t old_alloc_size = alloc_size;
-	  alloc_size = alloc_size * 3 / 2;
-	  str = (char *) (*_mp_reallocate_func) (str, old_alloc_size, alloc_size);
-	}
-      dig = digit_value_in_base (c, base);
-      if (dig < 0)
-	break;
-      str[str_size++] = dig;
-      c = getc (stream);
-    }
-
-  ungetc (c, stream);
-
-  /* Make sure the string is not empty, mpn_set_str would fail.  */
-  if (str_size == 0)
-    {
-      x->_mp_size = 0;
-      (*_mp_free_func) (str, alloc_size);
-      return nread;
-    }
-
-  xsize = (((mp_size_t) (str_size / __mp_bases[base].chars_per_bit_exactly))
-	   / BITS_PER_MP_LIMB + 2);
-  if (x->_mp_alloc < xsize)
-    _mpz_realloc (x, xsize);
-
-  /* Convert the byte array in base BASE to our bignum format.  */
-  xsize = mpn_set_str (x->_mp_d, (unsigned char *) str, str_size, base);
-  x->_mp_size = negative ? -xsize : xsize;
-
-  (*_mp_free_func) (str, alloc_size);
-  return str_size + nread;
-}
diff --git a/ghc/rts/gmp/mpz/invert.c b/ghc/rts/gmp/mpz/invert.c
deleted file mode 100644
index 749a0969fc..0000000000
--- a/ghc/rts/gmp/mpz/invert.c
+++ /dev/null
@@ -1,77 +0,0 @@
-/* mpz_invert (inv, x, n).  Find multiplicative inverse of X in Z(N).
-   If X has an inverse, return non-zero and store inverse in INVERSE,
-   otherwise, return 0 and put garbage in INVERSE.
-
-Copyright (C) 1996, 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-mpz_invert (mpz_ptr inverse, mpz_srcptr x, mpz_srcptr n)
-#else
-mpz_invert (inverse, x, n)
-     mpz_ptr inverse;
-     mpz_srcptr x, n;
-#endif
-{
-  mpz_t gcd, tmp;
-  mp_size_t xsize, nsize, size;
-  TMP_DECL (marker);
-
-  xsize = SIZ (x);
-  nsize = SIZ (n);
-  xsize = ABS (xsize);
-  nsize = ABS (nsize);
-  size = MAX (xsize, nsize) + 1;
-
-  /* No inverse exists if the leftside operand is 0.  Likewise, no
-     inverse exists if the mod operand is 1.  */
-  if (xsize == 0 || (nsize == 1 && (PTR (n))[0] == 1))
-    return 0;
-
-  TMP_MARK (marker);
-
-  MPZ_TMP_INIT (gcd, size);
-  MPZ_TMP_INIT (tmp, size);
-  mpz_gcdext (gcd, tmp, (mpz_ptr) 0, x, n);
-
-  /* If no inverse existed, return with an indication of that.  */
-  if (gcd->_mp_size != 1 || (gcd->_mp_d)[0] != 1)
-    {
-      TMP_FREE (marker);
-      return 0;
-    }
-
-  /* Make sure we return a positive inverse.  */
-  if (SIZ (tmp) < 0)
-    {
-      if (SIZ (n) < 0)
-	mpz_sub (inverse, tmp, n);
-      else
-	mpz_add (inverse, tmp, n);
-    }
-  else
-    mpz_set (inverse, tmp);
-
-  TMP_FREE (marker);
-  return 1;
-}
diff --git a/ghc/rts/gmp/mpz/ior.c b/ghc/rts/gmp/mpz/ior.c
deleted file mode 100644
index 0bb5a806dc..0000000000
--- a/ghc/rts/gmp/mpz/ior.c
+++ /dev/null
@@ -1,244 +0,0 @@
-/* mpz_ior -- Logical inclusive or.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_ior (mpz_ptr res, mpz_srcptr op1, mpz_srcptr op2)
-#else
-mpz_ior (res, op1, op2)
-     mpz_ptr res;
-     mpz_srcptr op1;
-     mpz_srcptr op2;
-#endif
-{
-  mp_srcptr op1_ptr, op2_ptr;
-  mp_size_t op1_size, op2_size;
-  mp_ptr res_ptr;
-  mp_size_t res_size;
-  mp_size_t i;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-  op1_size = op1->_mp_size;
-  op2_size = op2->_mp_size;
-
-  op1_ptr = op1->_mp_d;
-  op2_ptr = op2->_mp_d;
-  res_ptr = res->_mp_d;
-
-  if (op1_size >= 0)
-    {
-      if (op2_size >= 0)
-	{
-	  if (op1_size >= op2_size)
-	    {
-	      if (res->_mp_alloc < op1_size)
-		{
-		  _mpz_realloc (res, op1_size);
-		  op1_ptr = op1->_mp_d;
-		  op2_ptr = op2->_mp_d;
-		  res_ptr = res->_mp_d;
-		}
-
-	      if (res_ptr != op1_ptr)
-		MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size,
-			  op1_size - op2_size);
-	      for (i = op2_size - 1; i >= 0; i--)
-		res_ptr[i] = op1_ptr[i] | op2_ptr[i];
-	      res_size = op1_size;
-	    }
-	  else
-	    {
-	      if (res->_mp_alloc < op2_size)
-		{
-		  _mpz_realloc (res, op2_size);
-		  op1_ptr = op1->_mp_d;
-		  op2_ptr = op2->_mp_d;
-		  res_ptr = res->_mp_d;
-		}
-
-	      if (res_ptr != op2_ptr)
-		MPN_COPY (res_ptr + op1_size, op2_ptr + op1_size,
-			  op2_size - op1_size);
-	      for (i = op1_size - 1; i >= 0; i--)
-		res_ptr[i] = op1_ptr[i] | op2_ptr[i];
-	      res_size = op2_size;
-	    }
-
-	  res->_mp_size = res_size;
-	  return;
-	}
-      else /* op2_size < 0 */
-	{
-	  /* Fall through to the code at the end of the function.  */
-	}
-    }
-  else
-    {
-      if (op2_size < 0)
-	{
-	  mp_ptr opx;
-	  mp_limb_t cy;
-
-	  /* Both operands are negative, so will be the result.
-	     -((-OP1) | (-OP2)) = -(~(OP1 - 1) | ~(OP2 - 1)) =
-	     = ~(~(OP1 - 1) | ~(OP2 - 1)) + 1 =
-	     = ((OP1 - 1) & (OP2 - 1)) + 1      */
-
-	  op1_size = -op1_size;
-	  op2_size = -op2_size;
-
-	  res_size = MIN (op1_size, op2_size);
-
-	  /* Possible optimization: Decrease mpn_sub precision,
-	     as we won't use the entire res of both.  */
-	  opx = (mp_ptr) TMP_ALLOC (res_size * BYTES_PER_MP_LIMB);
-	  mpn_sub_1 (opx, op1_ptr, res_size, (mp_limb_t) 1);
-	  op1_ptr = opx;
-
-	  opx = (mp_ptr) TMP_ALLOC (res_size * BYTES_PER_MP_LIMB);
-	  mpn_sub_1 (opx, op2_ptr, res_size, (mp_limb_t) 1);
-	  op2_ptr = opx;
-
-	  if (res->_mp_alloc < res_size)
-	    {
-	      _mpz_realloc (res, res_size);
-	      res_ptr = res->_mp_d;
-	      /* Don't re-read OP1_PTR and OP2_PTR.  They point to
-		 temporary space--never to the space RES->_mp_d used
-		 to point to before reallocation.  */
-	    }
-
-	  /* First loop finds the size of the result.  */
-	  for (i = res_size - 1; i >= 0; i--)
-	    if ((op1_ptr[i] & op2_ptr[i]) != 0)
-	      break;
-	  res_size = i + 1;
-
-	  if (res_size != 0)
-	    {
-	      /* Second loop computes the real result.  */
-	      for (i = res_size - 1; i >= 0; i--)
-		res_ptr[i] = op1_ptr[i] & op2_ptr[i];
-
-	      cy = mpn_add_1 (res_ptr, res_ptr, res_size, (mp_limb_t) 1);
-	      if (cy)
-		{
-		  res_ptr[res_size] = cy;
-		  res_size++;
-		}
-	    }
-	  else
-	    {
-	      res_ptr[0] = 1;
-	      res_size = 1;
-	    }
-
-	  res->_mp_size = -res_size;
-	  TMP_FREE (marker);
-	  return;
-	}
-      else
-	{
-	  /* We should compute -OP1 | OP2.  Swap OP1 and OP2 and fall
-	     through to the code that handles OP1 | -OP2.  */
-          MPZ_SRCPTR_SWAP (op1, op2);
-          MPN_SRCPTR_SWAP (op1_ptr,op1_size, op2_ptr,op2_size);
-	}
-    }
-
-  {
-    mp_ptr opx;
-    mp_limb_t cy;
-    mp_size_t res_alloc;
-    mp_size_t count;
-
-    /* Operand 2 negative, so will be the result.
-       -(OP1 | (-OP2)) = -(OP1 | ~(OP2 - 1)) =
-       = ~(OP1 | ~(OP2 - 1)) + 1 =
-       = (~OP1 & (OP2 - 1)) + 1      */
-
-    op2_size = -op2_size;
-
-    res_alloc = op2_size;
-
-    opx = (mp_ptr) TMP_ALLOC (op2_size * BYTES_PER_MP_LIMB);
-    mpn_sub_1 (opx, op2_ptr, op2_size, (mp_limb_t) 1);
-    op2_ptr = opx;
-    op2_size -= op2_ptr[op2_size - 1] == 0;
-
-    if (res->_mp_alloc < res_alloc)
-      {
-	_mpz_realloc (res, res_alloc);
-	op1_ptr = op1->_mp_d;
-	res_ptr = res->_mp_d;
-	/* Don't re-read OP2_PTR.  It points to temporary space--never
-	   to the space RES->_mp_d used to point to before reallocation.  */
-      }
-
-    if (op1_size >= op2_size)
-      {
-	/* We can just ignore the part of OP1 that stretches above OP2,
-	   because the result limbs are zero there.  */
-
-	/* First loop finds the size of the result.  */
-	for (i = op2_size - 1; i >= 0; i--)
-	  if ((~op1_ptr[i] & op2_ptr[i]) != 0)
-	    break;
-	res_size = i + 1;
-	count = res_size;
-      }
-    else
-      {
-	res_size = op2_size;
-
-	/* Copy the part of OP2 that stretches above OP1, to RES.  */
-	MPN_COPY (res_ptr + op1_size, op2_ptr + op1_size, op2_size - op1_size);
-	count = op1_size;
-      }
-
-    if (res_size != 0)
-      {
-	/* Second loop computes the real result.  */
-	for (i = count - 1; i >= 0; i--)
-	  res_ptr[i] = ~op1_ptr[i] & op2_ptr[i];
-
-	cy = mpn_add_1 (res_ptr, res_ptr, res_size, (mp_limb_t) 1);
-	if (cy)
-	  {
-	    res_ptr[res_size] = cy;
-	    res_size++;
-	  }
-      }
-    else
-      {
-	res_ptr[0] = 1;
-	res_size = 1;
-      }
-
-    res->_mp_size = -res_size;
-  }
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/iset.c b/ghc/rts/gmp/mpz/iset.c
deleted file mode 100644
index 114bc2d542..0000000000
--- a/ghc/rts/gmp/mpz/iset.c
+++ /dev/null
@@ -1,49 +0,0 @@
-/* mpz_init_set (src_integer) -- Make a new multiple precision number with
-   a value copied from SRC_INTEGER.
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_init_set (mpz_ptr w, mpz_srcptr u)
-#else
-mpz_init_set (w, u)
-     mpz_ptr w;
-     mpz_srcptr u;
-#endif
-{
-  mp_ptr wp, up;
-  mp_size_t usize, size;
-
-  usize = u->_mp_size;
-  size = ABS (usize);
-
-  w->_mp_alloc = MAX (size, 1);
-  w->_mp_d = (mp_ptr) (*_mp_allocate_func) (w->_mp_alloc * BYTES_PER_MP_LIMB);
-
-  wp = w->_mp_d;
-  up = u->_mp_d;
-
-  MPN_COPY (wp, up, size);
-  w->_mp_size = usize;
-}
diff --git a/ghc/rts/gmp/mpz/iset_d.c b/ghc/rts/gmp/mpz/iset_d.c
deleted file mode 100644
index 502a8933e2..0000000000
--- a/ghc/rts/gmp/mpz/iset_d.c
+++ /dev/null
@@ -1,39 +0,0 @@
-/* mpz_init_set_d(integer, val) -- Initialize and assign INTEGER with a double
-   value VAL.
-
-Copyright (C) 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_init_set_d (mpz_ptr dest, double val)
-#else
-mpz_init_set_d (dest, val)
-     mpz_ptr dest;
-     double val;
-#endif
-{
-  dest->_mp_alloc = 1;
-  dest->_mp_d = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
-  dest->_mp_size = 0;
-  mpz_set_d (dest, val);
-}
diff --git a/ghc/rts/gmp/mpz/iset_si.c b/ghc/rts/gmp/mpz/iset_si.c
deleted file mode 100644
index 842db140ef..0000000000
--- a/ghc/rts/gmp/mpz/iset_si.c
+++ /dev/null
@@ -1,49 +0,0 @@
-/* mpz_init_set_si(val) -- Make a new multiple precision number with
-   value val.
-
-Copyright (C) 1991, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_init_set_si (mpz_ptr x, signed long int val)
-#else
-mpz_init_set_si (x, val)
-     mpz_ptr x;
-     signed long int val;
-#endif
-{
-  x->_mp_alloc = 1;
-  x->_mp_d = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
-  if (val > 0)
-    {
-      x->_mp_d[0] = val;
-      x->_mp_size = 1;
-    }
-  else if (val < 0)
-    {
-      x->_mp_d[0] = (unsigned long) -val;
-      x->_mp_size = -1;
-    }
-  else
-    x->_mp_size = 0;
-}
diff --git a/ghc/rts/gmp/mpz/iset_str.c b/ghc/rts/gmp/mpz/iset_str.c
deleted file mode 100644
index dfb8c6b230..0000000000
--- a/ghc/rts/gmp/mpz/iset_str.c
+++ /dev/null
@@ -1,47 +0,0 @@
-/* mpz_init_set_str(string, base) -- Convert the \0-terminated string
-   STRING in base BASE to a multiple precision integer.  Return a MP_INT
-   structure representing the integer.  Allow white space in the
-   string.  If BASE == 0 determine the base in the C standard way,
-   i.e.  0xhh...h means base 16, 0oo...o means base 8, otherwise
-   assume base 10.
-
-Copyright (C) 1991, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-mpz_init_set_str (mpz_ptr x, const char *str, int base)
-#else
-mpz_init_set_str (x, str, base)
-     mpz_ptr x;
-     const char *str;
-     int base;
-#endif
-{
-  x->_mp_alloc = 1;
-  x->_mp_d = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
-
-  /* if str has no digits mpz_set_str leaves x->_mp_size unset */
-  x->_mp_size = 0;
-
-  return mpz_set_str (x, str, base);
-}
diff --git a/ghc/rts/gmp/mpz/iset_ui.c b/ghc/rts/gmp/mpz/iset_ui.c
deleted file mode 100644
index 759182c556..0000000000
--- a/ghc/rts/gmp/mpz/iset_ui.c
+++ /dev/null
@@ -1,39 +0,0 @@
-/* mpz_init_set_ui(val) -- Make a new multiple precision number with
-   value val.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_init_set_ui (mpz_ptr x, unsigned long int val)
-#else
-mpz_init_set_ui (x, val)
-     mpz_ptr x;
-     unsigned long int val;
-#endif
-{
-  x->_mp_alloc = 1;
-  x->_mp_d = (mp_ptr) (*_mp_allocate_func) (BYTES_PER_MP_LIMB);
-  x->_mp_d[0] = val;
-  x->_mp_size = val != 0;
-}
diff --git a/ghc/rts/gmp/mpz/jacobi.c b/ghc/rts/gmp/mpz/jacobi.c
deleted file mode 100644
index 9d49e1d0c6..0000000000
--- a/ghc/rts/gmp/mpz/jacobi.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/* mpz_jacobi (op1, op2).
-   Contributed by Bennet Yee (bsy) at Carnegie-Mellon University
-
-Copyright (C) 1991, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-
-/* Precondition:  both p and q are positive */
-
-int
-#if	__STDC__
-mpz_jacobi (mpz_srcptr pi, mpz_srcptr qi)
-#else
-mpz_jacobi (pi, qi)
-     mpz_srcptr pi, qi;
-#endif
-{
-#if GCDCHECK
-  int retval;
-  mpz_t gcdval;
-
-  mpz_init (gcdval);
-  mpz_gcd (gcdval, pi, qi);
-  if (!mpz_cmp_ui (gcdval, 1L))
-    {
-      /* J(ab,cb) = J(ab,c)J(ab,b) = J(ab,c)J(0,b) = J(ab,c)*0 */
-      retval = 0;
-    }
-  else
-    retval = mpz_legendre (pi, qi);
-  mpz_clear (gcdval);
-  return retval;
-#else
-  return mpz_legendre (pi, qi);
-#endif
-}
diff --git a/ghc/rts/gmp/mpz/kronsz.c b/ghc/rts/gmp/mpz/kronsz.c
deleted file mode 100644
index c8c6752224..0000000000
--- a/ghc/rts/gmp/mpz/kronsz.c
+++ /dev/null
@@ -1,126 +0,0 @@
-/* mpz_si_kronecker -- Kronecker/Jacobi symbol. */
-
-/*
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-int
-#if __STDC__
-mpz_si_kronecker (long a, mpz_srcptr b)
-#else
-mpz_si_kronecker (a, b)
-     long       a;
-     mpz_srcptr b;
-#endif
-{
-  int        b_abs_size;
-  mp_srcptr  b_ptr;
-  mp_limb_t  b_low;
-  int        twos;
-  int        result_bit1;
-
-  b_abs_size = ABSIZ (b);
-  if (b_abs_size == 0)
-    return JACOBI_S0 (a);  /* (a/0) */
-
-  b_ptr = PTR(b);
-  b_low = b_ptr[0];
-
-  /* (0/b) = 1 if b=+/-1, 0 otherwise */
-  if (a == 0)
-    return (b_abs_size == 1) & (b_low == 1);
-
-  /* account for the effect of the sign of b, so can then ignore it */
-  result_bit1 = JACOBI_BSGN_SZ_BIT1 (a, b);
-
-  if ((b_low & 1) == 0)
-    {
-      /* b even */
-
-      if ((a & 1) == 0)
-        return 0;  /* (a/b)=0 if both a,b even */
-
-      /* Require MP_BITS_PER_LIMB even, so that (a/2)^MP_BITS_PER_LIMB = 1,
-         and so that therefore there's no need to account for how many zero
-         limbs are stripped.  */
-      ASSERT ((BITS_PER_MP_LIMB & 1) == 0);
-
-      MPN_STRIP_LOW_ZEROS_NOT_ZERO (b_ptr, b_abs_size);
-      b_low = b_ptr[0];
-
-      if ((b_low & 1) == 0)
-        {
-          /* odd a, even b */
-
-          mp_limb_t  b_shl_bit1;
-
-          count_trailing_zeros (twos, b_low);
-
-          /* b_shl_bit1 is b>>twos, but with only bit 1 guaranteed */
-          if (twos == BITS_PER_MP_LIMB-1)
-            b_shl_bit1 = (b_abs_size == 1) ? 0 : (b_ptr[1] << 1);
-          else
-            b_shl_bit1 = (b_low >> twos);
-
-          result_bit1 ^= JACOBI_ASGN_SU_BIT1 (a, b_shl_bit1);
-          a = ABS(a);
-
-          if (a == 1)
-            return JACOBI_BIT1_TO_PN (result_bit1);  /* (1/b)=1 */
-
-          /* twos (a/2), reciprocity to (b/a), and (b/a) = (b mod a / b) */
-          return mpn_jacobi_base (mpn_mod_1_rshift (b_ptr, b_abs_size,
-                                                    twos, a),
-                                  a,
-                                  result_bit1
-                                  ^ JACOBI_TWOS_U_BIT1 (twos, a)
-                                  ^ JACOBI_RECIP_UU_BIT1 (a, b_shl_bit1));
-        }
-    }
-
-  /* b odd */
-
-  result_bit1 ^= JACOBI_ASGN_SU_BIT1 (a, b_low);
-  a = ABS(a);
-
-  /* (a/1) = 1 for any a */
-  if (b_abs_size == 1 && b_low == 1)
-    return JACOBI_BIT1_TO_PN (result_bit1);
-
-  /* Note a is cast to unsigned because 0x80..00 doesn't fit in a signed. */
-  if ((a & 1) == 0)
-    {
-      count_trailing_zeros (twos, a);
-      a = ((unsigned long) a) >> twos;
-      result_bit1 ^= JACOBI_TWOS_U_BIT1 (twos, b_low);
-    }
-
-  if (a == 1)
-    return JACOBI_BIT1_TO_PN (result_bit1);  /* (1/b)=1 */
-
-  /* reciprocity to (b/a), and (b/a) == (b mod a / a) */
-  return mpn_jacobi_base (mpn_mod_1 (b_ptr, b_abs_size, a), a,
-                          result_bit1 ^ JACOBI_RECIP_UU_BIT1 (a, b_low));
-}
diff --git a/ghc/rts/gmp/mpz/kronuz.c b/ghc/rts/gmp/mpz/kronuz.c
deleted file mode 100644
index b877e6f64c..0000000000
--- a/ghc/rts/gmp/mpz/kronuz.c
+++ /dev/null
@@ -1,115 +0,0 @@
-/* mpz_ui_kronecker -- Kronecker/Jacobi symbol. */
-
-/*
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-int
-#if __STDC__
-mpz_ui_kronecker (unsigned long a, mpz_srcptr b)
-#else
-mpz_ui_kronecker (a, b)
-     unsigned long a;
-     mpz_srcptr    b;
-#endif
-{
-  int        b_abs_size;
-  mp_srcptr  b_ptr;
-  mp_limb_t  b_low;
-  int        twos;
-  int        result_bit1;
-
-  /* (a/0) */
-  b_abs_size = ABSIZ (b);
-  if (b_abs_size == 0)
-    return JACOBI_U0 (a);
-
-  /* (a/-1)=1 when a>=0, so the sign of b is ignored */
-  b_ptr = PTR(b);
-  b_low = b_ptr[0];
-
-  /* (0/1)=1; (0/-1)=1; (0/b)=0 for b!=+/-1
-     (1/b)=1, for any b */
-  if (a <= 1)
-    return (a == 1) | ((b_abs_size == 1) & (b_low == 1));
-
-  if (b_low & 1)
-    {
-      /* (a/1) = 1 for any a */
-      if (b_abs_size == 1 && b_low == 1)
-        return 1;
-
-      count_trailing_zeros (twos, a);
-      a >>= twos;
-      if (a == 1)
-        return JACOBI_TWOS_U (twos, b_low);  /* powers of (2/b) only */
-
-      /* powers of (2/b); reciprocity to (b/a); (b/a) == (b mod a / a) */
-      return mpn_jacobi_base (mpn_mod_1 (b_ptr, b_abs_size, a),
-                              a,
-                              JACOBI_TWOS_U_BIT1 (twos, b_low)
-                              ^ JACOBI_RECIP_UU_BIT1 (b_low, a));
-    }
-
-  /* b is even; (a/2)=0 if a is even */
-  if ((a & 1) == 0)
-    return 0;
-
-  /* Require MP_BITS_PER_LIMB even, so (a/2)^MP_BITS_PER_LIMB = 1, and so we
-     don't have to pay attention to how many trailing zero limbs are
-     stripped.  */
-  ASSERT ((BITS_PER_MP_LIMB & 1) == 0);
-
-  MPN_STRIP_LOW_ZEROS_NOT_ZERO (b_ptr, b_abs_size);
-  b_low = b_ptr[0];
-
-  if (b_low & 1)
-    /* reciprocity to (b/a); (b/a) == (b mod a / a) */
-    return mpn_jacobi_base (mpn_mod_1 (b_ptr, b_abs_size, a),
-                            a,
-                            JACOBI_RECIP_UU_BIT1 (b_low, a));
-
-  count_trailing_zeros (twos, b_low);
-
-  /* reciprocity to get (b/a) */
-  if (twos == BITS_PER_MP_LIMB-1)
-    {
-      if (b_abs_size == 1)
-        {
-          /* b==0x800...00, one limb high bit only, so (a/2)^(BPML-1) */
-          return JACOBI_TWOS_U (BITS_PER_MP_LIMB-1, a);
-        }
-
-      /* b_abs_size > 1 */
-      result_bit1 = JACOBI_RECIP_UU_BIT1 (a, b_ptr[1] << 1);
-    }
-  else
-    result_bit1 = JACOBI_RECIP_UU_BIT1 (a, b_low >> twos);
-
-  /* powers of (a/2); reciprocity to (b/a); (b/a) == (b mod a / a) */
-  return mpn_jacobi_base (mpn_mod_1_rshift (b_ptr, b_abs_size, twos, a),
-                          a,
-                          JACOBI_TWOS_U_BIT1 (twos, a) ^ result_bit1);
-}
diff --git a/ghc/rts/gmp/mpz/kronzs.c b/ghc/rts/gmp/mpz/kronzs.c
deleted file mode 100644
index edfb465976..0000000000
--- a/ghc/rts/gmp/mpz/kronzs.c
+++ /dev/null
@@ -1,74 +0,0 @@
-/* mpz_kronecker_si -- Kronecker/Jacobi symbol. */
-
-/*
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-/* This function is expected to be often used with b odd, so there's a test
-   for this before invoking count_trailing_zeros().
-
-   After the absolute value of b is established it's treated as an unsigned
-   long, because 0x80..00 doesn't fit in a signed long. */
-
-int
-#if __STDC__
-mpz_kronecker_si (mpz_srcptr a, long b)
-#else
-mpz_kronecker_si (a, b)
-     mpz_srcptr a;
-     long       b;
-#endif
-{
-  int  result_bit1;
-  int  twos;
-
-  if (b == 0)
-    return JACOBI_Z0 (a);
-
-  result_bit1 = JACOBI_BSGN_ZS_BIT1(a, b);
-  b = ABS (b);
-
-  if (b == 1)
-    return JACOBI_BIT1_TO_PN (result_bit1);  /* (a/1) = 1 for any a */
-
-  if (b & 1) 
-    return mpn_jacobi_base (mpz_fdiv_ui (a, b), b, result_bit1);
-      
-  /* result 0 if both a,b even */
-  if (mpz_even_p (a))
-    return 0;
-
-  /* (a/2)=(2/a) when a odd */
-  count_trailing_zeros (twos, b);
-  result_bit1 ^= JACOBI_TWOS_U_BIT1 (twos, PTR(a)[0]);
-
-  b = ((unsigned long) b) >> twos;
-  if (b == 1)
-    return JACOBI_BIT1_TO_PN (result_bit1);
-  else
-    return mpn_jacobi_base (mpz_fdiv_ui (a, b), b, result_bit1);
-}
-
-
diff --git a/ghc/rts/gmp/mpz/kronzu.c b/ghc/rts/gmp/mpz/kronzu.c
deleted file mode 100644
index 749be5df07..0000000000
--- a/ghc/rts/gmp/mpz/kronzu.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/* mpz_kronecker_ui -- Kronecker/Jacobi symbol. */
-
-/*
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.
-*/
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-/* This function is expected to be often used with b an odd prime, so the
-   code for odd b is nice and short. */
-
-int
-#if __STDC__
-mpz_kronecker_ui (mpz_srcptr a, unsigned long b)
-#else
-mpz_kronecker_ui (a, b)
-     mpz_srcptr    a;
-     unsigned long b;
-#endif
-{
-  int  twos;
-
-  if (b & 1)
-    {
-      if (b != 1)
-        return mpn_jacobi_base (mpz_fdiv_ui (a, b), b, 0);
-      else
-        return 1;  /* (a/1)=1 for any a */
-    }
-
-  if (b == 0)
-    return JACOBI_Z0 (a);
-
-  /* (a/2)=0 if a even */
-  if (mpz_even_p (a))
-    return 0;
-
-  /* (a/2)=(2/a) when a odd */
-  count_trailing_zeros (twos, b);  
-  b >>= twos;
-  if (b == 1)
-    return JACOBI_TWOS_U (twos, PTR(a)[0]);
-
-  return mpn_jacobi_base (mpz_fdiv_ui (a, b), b,
-                          JACOBI_TWOS_U_BIT1(twos, PTR(a)[0]));
-}
diff --git a/ghc/rts/gmp/mpz/lcm.c b/ghc/rts/gmp/mpz/lcm.c
deleted file mode 100644
index 7495882ae5..0000000000
--- a/ghc/rts/gmp/mpz/lcm.c
+++ /dev/null
@@ -1,61 +0,0 @@
-/* mpz/lcm.c:   Calculate the least common multiple of two integers.
-
-Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-void *_mpz_realloc ();
-
-void
-#if __STDC__
-mpz_lcm (mpz_ptr r, mpz_srcptr u, mpz_srcptr v)
-#else
-mpz_lcm (r, u, v)
-     mpz_ptr r;
-     mpz_srcptr u;
-     mpz_srcptr v;
-#endif
-{
-  mpz_t g;
-  mp_size_t usize, vsize, size;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-
-  usize = ABS (SIZ (u));
-  vsize = ABS (SIZ (v));
-
-  if (usize == 0 || vsize == 0)
-    {
-      SIZ (r) = 0;
-      return;
-    }
-
-  size = MAX (usize, vsize);
-  MPZ_TMP_INIT (g, size);
-
-  mpz_gcd (g, u, v);
-  mpz_divexact (g, u, g);
-  mpz_mul (r, g, v);
-
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/legendre.c b/ghc/rts/gmp/mpz/legendre.c
deleted file mode 100644
index ab665f70d0..0000000000
--- a/ghc/rts/gmp/mpz/legendre.c
+++ /dev/null
@@ -1,184 +0,0 @@
-/* mpz_legendre (op1, op2).
-   Contributed by Bennet Yee (bsy) at Carnegie-Mellon University
-
-Copyright (C) 1992, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-
-#if defined (DEBUG)
-#include <stdio.h>
-#endif
-
-/* Precondition:  both p and q are positive */
-
-int
-#if __STDC__
-mpz_legendre (mpz_srcptr pi, mpz_srcptr qi)
-#else
-mpz_legendre (pi, qi)
-mpz_srcptr pi, qi;
-#endif
-{
-  mpz_t p, q, qdiv2;
-#ifdef Q_MINUS_1
-  mpz_t q_minus_1;
-#endif
-  mpz_ptr mtmp;
-  register mpz_ptr pptr, qptr;
-  register int retval = 1;
-  register unsigned long int s;
-
-  pptr = p;
-  mpz_init_set (pptr, pi);
-  qptr = q;
-  mpz_init_set (qptr, qi);
-
-#ifdef Q_MINUS_1
-  mpz_init (q_minus_1);
-#endif
-  mpz_init (qdiv2);
-
-tail_recurse2:
-#ifdef DEBUG
-  printf ("tail_recurse2: p=");
-  mpz_out_str (stdout, 10, pptr);
-  printf ("\nq=");
-  mpz_out_str (stdout, 10, qptr);
-  putchar ('\n');
-#endif
-  s = mpz_scan1 (qptr, 0);
-  if (s) mpz_tdiv_q_2exp (qptr, qptr, s); /* J(a,2) = 1 */
-#ifdef DEBUG
-  printf ("2 factor decomposition: p=");
-  mpz_out_str (stdout, 10, pptr);
-  printf ("\nq=");
-  mpz_out_str (stdout, 10, qptr);
-  putchar ('\n');
-#endif
-  /* postcondition q odd */
-  if (!mpz_cmp_ui (qptr, 1L))  /* J(a,1) = 1 */
-    goto done;
-  mpz_mod (pptr, pptr, qptr); /* J(a,q) = J(b,q) when a == b mod q */
-#ifdef DEBUG
-  printf ("mod out by q: p=");
-  mpz_out_str (stdout, 10, pptr);
-  printf ("\nq=");
-  mpz_out_str (stdout, 10, qptr);
-  putchar ('\n');
-#endif
-  /* quick calculation to get approximate size first */
-  /* precondition: p < q */
-  if ((mpz_sizeinbase (pptr, 2) + 1 >= mpz_sizeinbase (qptr,2))
-      && (mpz_tdiv_q_2exp (qdiv2, qptr, 1L), mpz_cmp (pptr, qdiv2) > 0))
-    {
-      /* p > q/2 */
-      mpz_sub (pptr, qptr, pptr);
-      /* J(-1,q) = (-1)^((q-1)/2), q odd */
-      if (mpz_get_ui (qptr) & 2)
-	retval = -retval;
-    }
-  /* p < q/2 */
-#ifdef Q_MINUS_1
-  mpz_sub_ui (q_minus_q, qptr, 1L);
-#endif
-tail_recurse: /* we use tail_recurse only if q has not changed */
-#ifdef DEBUG
-  printf ("tail_recurse1: p=");
-  mpz_out_str (stdout, 10, pptr);
-  printf ("\nq=");
-  mpz_out_str (stdout, 10, qptr);
-  putchar ('\n');
-#endif
-  /*
-   * J(0,q) = 0
-   * this occurs only if gcd(p,q) != 1 which is never true for
-   * Legendre function.
-   */
-  if (!mpz_cmp_ui (pptr, 0L))
-    {
-      retval = 0;
-      goto done;
-    }
-
-  if (!mpz_cmp_ui (pptr, 1L))
-    {
-      /* J(1,q) = 1 */
-      /* retval *= 1; */
-      goto done;
-    }
-#ifdef Q_MINUS_1
-  if (!mpz_cmp (pptr, q_minus_1))
-    {
-      /* J(-1,q) = (-1)^((q-1)/2) */
-      if (mpz_get_ui (qptr) & 2)
-	retval = -retval;
-      /* else    retval *= 1; */
-      goto done;
-    }
-#endif
-  /*
-   * we do not handle J(xy,q) except for x==2
-   * since we do not want to factor
-   */
-  if ((s = mpz_scan1 (pptr, 0)) != 0)
-    {
-      /*
-       * J(2,q) = (-1)^((q^2-1)/8)
-       *
-       * Note that q odd guarantees that q^2-1 is divisible by 8:
-       * Let a: q=2a+1.  q^2 = 4a^2+4a+1, (q^2-1)/8 = a(a+1)/2, qed
-       *
-       * Now, note that this means that the low two bits of _a_
-       * (or the low bits of q shifted over by 1 determines
-       * the factor).
-       */
-      mpz_tdiv_q_2exp (pptr, pptr, s);
-
-      /* even powers of 2 gives J(2,q)^{2n} = 1 */
-      if (s & 1)
-	{
-	  s = mpz_get_ui (qptr) >> 1;
-	  s = s * (s + 1);
-	  if (s & 2)
-	    retval = -retval;
-	}
-      goto tail_recurse;
-    }
-  /*
-   * we know p is odd since we have cast out 2s
-   * precondition that q is odd guarantees both odd.
-   *
-   * quadratic reciprocity
-   * J(p,q) = (-1)^((p-1)(q-1)/4) * J(q,p)
-   */
-  if ((s = mpz_scan1 (pptr, 1)) <= 2 && (s + mpz_scan1 (qptr, 1)) <= 2)
-    retval = -retval;
-
-  mtmp = pptr; pptr = qptr; qptr = mtmp;
-  goto tail_recurse2;
-done:
-  mpz_clear (p);
-  mpz_clear (q);
-  mpz_clear (qdiv2);
-#ifdef Q_MINUS_1
-  mpz_clear (q_minus_1);
-#endif
-  return retval;
-}
diff --git a/ghc/rts/gmp/mpz/mod.c b/ghc/rts/gmp/mpz/mod.c
deleted file mode 100644
index 87033b333b..0000000000
--- a/ghc/rts/gmp/mpz/mod.c
+++ /dev/null
@@ -1,63 +0,0 @@
-/* mpz_mod -- The mathematical mod function.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_mod (mpz_ptr rem, mpz_srcptr dividend, mpz_srcptr divisor)
-#else
-mpz_mod (rem, dividend, divisor)
-     mpz_ptr rem;
-     mpz_srcptr dividend;
-     mpz_srcptr divisor;
-#endif
-{
-  mp_size_t divisor_size = divisor->_mp_size;
-  mpz_t temp_divisor;		/* N.B.: lives until function returns! */
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-
-  /* We need the original value of the divisor after the remainder has been
-     preliminary calculated.  We have to copy it to temporary space if it's
-     the same variable as REM.  */
-  if (rem == divisor)
-    {
-      MPZ_TMP_INIT (temp_divisor, ABS (divisor_size));
-      mpz_set (temp_divisor, divisor);
-      divisor = temp_divisor;
-    }
-
-  mpz_tdiv_r (rem, dividend, divisor);
-
-  if (rem->_mp_size != 0)
-    {
-      if (dividend->_mp_size < 0)
-	if (divisor->_mp_size < 0)
-	  mpz_sub (rem, rem, divisor);
-	else
-	  mpz_add (rem, rem, divisor);
-    }
-
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/mul.c b/ghc/rts/gmp/mpz/mul.c
deleted file mode 100644
index 7854788e50..0000000000
--- a/ghc/rts/gmp/mpz/mul.c
+++ /dev/null
@@ -1,131 +0,0 @@
-/* mpz_mul -- Multiply two integers.
-
-Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h> /* for NULL */
-#include "gmp.h"
-#include "gmp-impl.h"
-#ifdef BERKELEY_MP
-#include "mp.h"
-#endif
-
-#ifndef BERKELEY_MP
-void
-#if __STDC__
-mpz_mul (mpz_ptr w, mpz_srcptr u, mpz_srcptr v)
-#else
-mpz_mul (w, u, v)
-     mpz_ptr w;
-     mpz_srcptr u;
-     mpz_srcptr v;
-#endif
-#else /* BERKELEY_MP */
-void
-#if __STDC__
-mult (mpz_srcptr u, mpz_srcptr v, mpz_ptr w)
-#else
-mult (u, v, w)
-     mpz_srcptr u;
-     mpz_srcptr v;
-     mpz_ptr w;
-#endif
-#endif /* BERKELEY_MP */
-{
-  mp_size_t usize = u->_mp_size;
-  mp_size_t vsize = v->_mp_size;
-  mp_size_t wsize;
-  mp_size_t sign_product;
-  mp_ptr up, vp;
-  mp_ptr wp;
-  mp_ptr free_me = NULL;
-  size_t free_me_size;
-  mp_limb_t cy_limb;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-  sign_product = usize ^ vsize;
-  usize = ABS (usize);
-  vsize = ABS (vsize);
-
-  if (usize < vsize)
-    {
-      /* Swap U and V.  */
-      {const __mpz_struct *t = u; u = v; v = t;}
-      {mp_size_t t = usize; usize = vsize; vsize = t;}
-    }
-
-  up = u->_mp_d;
-  vp = v->_mp_d;
-  wp = w->_mp_d;
-
-  /* Ensure W has space enough to store the result.  */
-  wsize = usize + vsize;
-  if (w->_mp_alloc < wsize)
-    {
-      if (wp == up || wp == vp)
-	{
-	  free_me = wp;
-	  free_me_size = w->_mp_alloc;
-	}
-      else
-	(*_mp_free_func) (wp, w->_mp_alloc * BYTES_PER_MP_LIMB);
-
-      w->_mp_alloc = wsize;
-      wp = (mp_ptr) (*_mp_allocate_func) (wsize * BYTES_PER_MP_LIMB);
-      w->_mp_d = wp;
-    }
-  else
-    {
-      /* Make U and V not overlap with W.  */
-      if (wp == up)
-	{
-	  /* W and U are identical.  Allocate temporary space for U.  */
-	  up = (mp_ptr) TMP_ALLOC (usize * BYTES_PER_MP_LIMB);
-	  /* Is V identical too?  Keep it identical with U.  */
-	  if (wp == vp)
-	    vp = up;
-	  /* Copy to the temporary space.  */
-	  MPN_COPY (up, wp, usize);
-	}
-      else if (wp == vp)
-	{
-	  /* W and V are identical.  Allocate temporary space for V.  */
-	  vp = (mp_ptr) TMP_ALLOC (vsize * BYTES_PER_MP_LIMB);
-	  /* Copy to the temporary space.  */
-	  MPN_COPY (vp, wp, vsize);
-	}
-    }
-
-  if (vsize == 0)
-    {
-      wsize = 0;
-    }
-  else
-    {
-      cy_limb = mpn_mul (wp, up, usize, vp, vsize);
-      wsize = usize + vsize;
-      wsize -= cy_limb == 0;
-    }
-
-  w->_mp_size = sign_product < 0 ? -wsize : wsize;
-  if (free_me != NULL)
-    (*_mp_free_func) (free_me, free_me_size * BYTES_PER_MP_LIMB);
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/mul_2exp.c b/ghc/rts/gmp/mpz/mul_2exp.c
deleted file mode 100644
index abea5fed2c..0000000000
--- a/ghc/rts/gmp/mpz/mul_2exp.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/* mpz_mul_2exp -- Multiply a bignum by 2**CNT
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_mul_2exp (mpz_ptr w, mpz_srcptr u, unsigned long int cnt)
-#else
-mpz_mul_2exp (w, u, cnt)
-     mpz_ptr w;
-     mpz_srcptr u;
-     unsigned long int cnt;
-#endif
-{
-  mp_size_t usize = u->_mp_size;
-  mp_size_t abs_usize = ABS (usize);
-  mp_size_t wsize;
-  mp_size_t limb_cnt;
-  mp_ptr wp;
-  mp_limb_t wlimb;
-
-  if (usize == 0)
-    {
-      w->_mp_size = 0;
-      return;
-    }
-
-  limb_cnt = cnt / BITS_PER_MP_LIMB;
-  wsize = abs_usize + limb_cnt + 1;
-  if (w->_mp_alloc < wsize)
-    _mpz_realloc (w, wsize);
-
-  wp = w->_mp_d;
-  wsize = abs_usize + limb_cnt;
-
-  cnt %= BITS_PER_MP_LIMB;
-  if (cnt != 0)
-    {
-      wlimb = mpn_lshift (wp + limb_cnt, u->_mp_d, abs_usize, cnt);
-      if (wlimb != 0)
-	{
-	  wp[wsize] = wlimb;
-	  wsize++;
-	}
-    }
-  else
-    {
-      MPN_COPY_DECR (wp + limb_cnt, u->_mp_d, abs_usize);
-    }
-
-  /* Zero all whole limbs at low end.  Do it here and not before calling
-     mpn_lshift, not to lose for U == W.  */
-  MPN_ZERO (wp, limb_cnt);
-
-  w->_mp_size = usize >= 0 ? wsize : -wsize;
-}
diff --git a/ghc/rts/gmp/mpz/mul_siui.c b/ghc/rts/gmp/mpz/mul_siui.c
deleted file mode 100644
index 9849cd41b0..0000000000
--- a/ghc/rts/gmp/mpz/mul_siui.c
+++ /dev/null
@@ -1,81 +0,0 @@
-/* mpz_mul_ui/si (product, multiplier, small_multiplicand) -- Set PRODUCT to
-   MULTIPLICATOR times SMALL_MULTIPLICAND.
-
-Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-
-#ifdef OPERATION_mul_ui
-#define FUNCTION              mpz_mul_ui
-#define MULTIPLICAND_UNSIGNED unsigned
-#define MULTIPLICAND_ABS(x)   x
-#else
-#ifdef OPERATION_mul_si
-#define FUNCTION              mpz_mul_si
-#define MULTIPLICAND_UNSIGNED
-#define MULTIPLICAND_ABS(x)   ABS(x)
-#else
-Error, error, unrecognised OPERATION
-#endif
-#endif
-
-
-void
-#if __STDC__
-FUNCTION (mpz_ptr prod, mpz_srcptr mult,
-          MULTIPLICAND_UNSIGNED long int small_mult)
-#else
-FUNCTION (prod, mult, small_mult)
-     mpz_ptr prod;
-     mpz_srcptr mult;
-     MULTIPLICAND_UNSIGNED long int small_mult;
-#endif
-{
-  mp_size_t size = mult->_mp_size;
-  mp_size_t sign_product = size;
-  mp_limb_t cy;
-  mp_size_t prod_size;
-  mp_ptr prod_ptr;
-
-  if (size == 0 || small_mult == 0)
-    {
-      prod->_mp_size = 0;
-      return;
-    }
-  size = ABS (size);
-
-  prod_size = size + 1;
-  if (prod->_mp_alloc < prod_size)
-    _mpz_realloc (prod, prod_size);
-
-  prod_ptr = prod->_mp_d;
-
-  cy = mpn_mul_1 (prod_ptr, mult->_mp_d, size,
-                  (mp_limb_t) MULTIPLICAND_ABS (small_mult));
-  if (cy != 0)
-    {
-      prod_ptr[size] = cy;
-      size++;
-    }
-
-  prod->_mp_size = ((sign_product < 0) ^ (small_mult < 0)) ? -size : size;
-}
diff --git a/ghc/rts/gmp/mpz/neg.c b/ghc/rts/gmp/mpz/neg.c
deleted file mode 100644
index 566c3a95aa..0000000000
--- a/ghc/rts/gmp/mpz/neg.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/* mpz_neg(mpz_ptr dst, mpz_ptr src) -- Assign the negated value of SRC to DST.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_neg (mpz_ptr w, mpz_srcptr u)
-#else
-mpz_neg (w, u)
-     mpz_ptr w;
-     mpz_srcptr u;
-#endif
-{
-  mp_ptr wp, up;
-  mp_size_t usize, size;
-
-  usize = u->_mp_size;
-
-  if (u != w)
-    {
-      size = ABS (usize);
-
-      if (w->_mp_alloc < size)
-	_mpz_realloc (w, size);
-
-      wp = w->_mp_d;
-      up = u->_mp_d;
-
-      MPN_COPY (wp, up, size);
-    }
-
-  w->_mp_size = -usize;
-}
diff --git a/ghc/rts/gmp/mpz/nextprime.c b/ghc/rts/gmp/mpz/nextprime.c
deleted file mode 100644
index f024dd1206..0000000000
--- a/ghc/rts/gmp/mpz/nextprime.c
+++ /dev/null
@@ -1,120 +0,0 @@
-/* mpz_nextprime(p,t) - compute the next prime > t and store that in p.
-
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_nextprime (mpz_ptr p, mpz_srcptr t)
-#else
-mpz_nextprime (p, t)
-     mpz_ptr    p;
-     mpz_srcptr t;
-#endif
-{
-  mpz_add_ui (p, t, 1L);
-  while (! mpz_probab_prime_p (p, 5))
-    mpz_add_ui (p, p, 1L);
-}
-
-#if 0
-/* This code is not yet tested.  Will be enabled in 3.1. */
-
-status unsigned short primes[] =
-{
-3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,
-101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,
-191,193,197,199,211,223,227,229,233,239,241,251,257,263,269,271,277,
-281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,
-389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,
-491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,
-607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,
-719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,
-829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,
-953,967,971,977,983,991,997
-};
-
-#define NUMBER_OF_PRIMES 167
-
-void
-#if __STDC__
-mpz_nextprime (mpz_ptr p, mpz_srcptr n)
-#else
-mpz_nextprime (p, n)
-     mpz_ptr p;
-     mpz_srcptr n;
-#endif
-{
-  mpz_t tmp;
-  unsigned short *moduli;
-  unsigned long difference;
-  int i;
-  int composite;
-
-  /* First handle tiny numbers */
-  if (mpz_cmp_ui (n, 2) < 0)
-    {
-      mpz_set_ui (p, 2);
-      return;
-    }
-  mpz_add_ui (p, n, 1);
-  mpz_setbit (p, 0);
-
-  if (mpz_cmp_ui (p, 7) <= 0)
-    return;
-
-  prime_limit = NUMBER_OF_PRIMES - 1;
-  if (mpz_cmp_ui (p, primes[prime_limit]) <= 0)
-    /* Just use first three entries (3,5,7) of table for small numbers */
-    prime_limit = 3;
-  if (prime_limit)
-    {
-      /* Compute residues modulo small odd primes */
-      moduli = (unsigned short *) TMP_ALLOC (prime_limit * sizeof moduli[0]);
-      for (i = 0; i < prime_limit; i++)
-	moduli[i] = mpz_fdiv_ui (p, primes[i]);
-    }
-  for (difference = 0; ; difference += 2)
-    {
-      composite = 0;
-
-      /* First check residues */
-      for (i = 0; i < prime_limit; i++)
-	{
-	  int acc, pr;
-	  composite |= (moduli[i] == 0);
-	  acc = moduli[i] + 2;
-	  pr = primes[i];
-	  moduli[i] = acc >= pr ? acc - pr : acc;
-	}
-      if (composite)
-	continue;
-
-      mpz_add_ui (p, p, difference);
-      difference = 0;
-
-      /* Miller-Rabin test */
-      if (mpz_millerrabin (p, 2))
-	break;
-    }
-}
-#endif
diff --git a/ghc/rts/gmp/mpz/out_raw.c b/ghc/rts/gmp/mpz/out_raw.c
deleted file mode 100644
index 62709479c5..0000000000
--- a/ghc/rts/gmp/mpz/out_raw.c
+++ /dev/null
@@ -1,89 +0,0 @@
-/* mpz_out_raw -- Output a mpz_t in binary.  Use an endianess and word size
-   independent format.
-
-Copyright (C) 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h>
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-size_t
-#if __STDC__
-mpz_out_raw (FILE *stream, mpz_srcptr x)
-#else
-mpz_out_raw (stream, x)
-     FILE *stream;
-     mpz_srcptr x;
-#endif
-{
-  int i;
-  mp_size_t s;
-  mp_size_t xsize = ABS (x->_mp_size);
-  mp_srcptr xp = x->_mp_d;
-  mp_size_t out_bytesize;
-  mp_limb_t hi_limb;
-  int n_bytes_in_hi_limb;
-
-  if (stream == 0)
-    stream = stdout;
-
-  if (xsize == 0)
-    {
-      for (i = 4 - 1; i >= 0; i--)
-	fputc (0, stream);
-      return ferror (stream) ? 0 : 4;
-    }
-
-  hi_limb = xp[xsize - 1];
-  for (i = BYTES_PER_MP_LIMB - 1; i > 0; i--)
-    {
-      if ((hi_limb >> i * BITS_PER_CHAR) != 0)
-	break;
-    }
-  n_bytes_in_hi_limb = i + 1;
-  out_bytesize = BYTES_PER_MP_LIMB * (xsize - 1) + n_bytes_in_hi_limb;
-  if (x->_mp_size < 0)
-    out_bytesize = -out_bytesize;
-
-  /* Make the size 4 bytes on all machines, to make the format portable.  */
-  for (i = 4 - 1; i >= 0; i--)
-    fputc ((out_bytesize >> (i * BITS_PER_CHAR)) % (1 << BITS_PER_CHAR),
-	   stream);
-
-  /* Output from the most significant limb to the least significant limb,
-     with each limb also output in decreasing significance order.  */
-
-  /* Output the most significant limb separately, since we will only
-     output some of its bytes.  */
-  for (i = n_bytes_in_hi_limb - 1; i >= 0; i--)
-    fputc ((hi_limb >> (i * BITS_PER_CHAR)) % (1 << BITS_PER_CHAR), stream);
-
-  /* Output the remaining limbs.  */
-  for (s = xsize - 2; s >= 0; s--)
-    {
-      mp_limb_t x_limb;
-
-      x_limb = xp[s];
-      for (i = BYTES_PER_MP_LIMB - 1; i >= 0; i--)
-	fputc ((x_limb >> (i * BITS_PER_CHAR)) % (1 << BITS_PER_CHAR), stream);
-    }
-  return ferror (stream) ? 0 : ABS (out_bytesize) + 4;
-}
diff --git a/ghc/rts/gmp/mpz/out_str.c b/ghc/rts/gmp/mpz/out_str.c
deleted file mode 100644
index bf971b0057..0000000000
--- a/ghc/rts/gmp/mpz/out_str.c
+++ /dev/null
@@ -1,108 +0,0 @@
-/* mpz_out_str(stream, base, integer) -- Output to STREAM the multi prec.
-   integer INTEGER in base BASE.
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h>
-#include "gmp.h"
-#include "gmp-impl.h"
-
-size_t
-#if __STDC__
-mpz_out_str (FILE *stream, int base, mpz_srcptr x)
-#else
-mpz_out_str (stream, base, x)
-     FILE *stream;
-     int base;
-     mpz_srcptr x;
-#endif
-{
-  mp_ptr xp;
-  mp_size_t x_size = x->_mp_size;
-  unsigned char *str;
-  size_t str_size;
-  size_t i;
-  size_t written;
-  char *num_to_text;
-  TMP_DECL (marker);
-
-  if (stream == 0)
-    stream = stdout;
-
-  if (base >= 0)
-    {
-      if (base == 0)
-	base = 10;
-      num_to_text = "0123456789abcdefghijklmnopqrstuvwxyz";
-    }
-  else
-    {
-      base = -base;
-      num_to_text = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
-    }
-
-  if (x_size == 0)
-    {
-      fputc ('0', stream);
-      return ferror (stream) ? 0 : 1;
-    }
-
-  written = 0;
-
-  if (x_size < 0)
-    {
-      fputc ('-', stream);
-      x_size = -x_size;
-      written = 1;
-    }
-
-  TMP_MARK (marker);
-  str_size = ((size_t) (x_size * BITS_PER_MP_LIMB
-			* __mp_bases[base].chars_per_bit_exactly)) + 3;
-  str = (unsigned char *) TMP_ALLOC (str_size);
-
-  /* Move the number to convert into temporary space, since mpn_get_str
-     clobbers its argument + needs one extra high limb....  */
-  xp = (mp_ptr) TMP_ALLOC ((x_size + 1) * BYTES_PER_MP_LIMB);
-  MPN_COPY (xp, x->_mp_d, x_size);
-
-  str_size = mpn_get_str (str, base, xp, x_size);
-
-  /* mpn_get_str might make some leading zeros.  Skip them.  */
-  while (*str == 0)
-    {
-      str_size--;
-      str++;
-    }
-
-  /* Translate to printable chars.  */
-  for (i = 0; i < str_size; i++)
-    str[i] = num_to_text[str[i]];
-  str[str_size] = 0;
-
-  {
-    size_t fwret;
-    fwret = fwrite ((char *) str, 1, str_size, stream);
-    written += fwret;
-  }
-
-  TMP_FREE (marker);
-  return ferror (stream) ? 0 : written;
-}
diff --git a/ghc/rts/gmp/mpz/perfpow.c b/ghc/rts/gmp/mpz/perfpow.c
deleted file mode 100644
index e71670a0be..0000000000
--- a/ghc/rts/gmp/mpz/perfpow.c
+++ /dev/null
@@ -1,272 +0,0 @@
-/* mpz_perfect_power_p(arg) -- Return non-zero if ARG is a perfect power,
-   zero otherwise.
-
-Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/*
-  We are to determine if c is a perfect power, c = a ^ b.
-  Assume c is divisible by 2^n and that codd = c/2^n is odd.
-  Assume a is divisible by 2^m and that aodd = a/2^m is odd.
-  It is always true that m divides n.
-
-  * If n is prime, either 1) a is 2*aodd and b = n
-		       or 2) a = c and b = 1.
-    So for n prime, we readily have a solution.
-  * If n is factorable into the non-trivial factors p1,p2,...
-    Since m divides n, m has a subset of n's factors and b = n / m.
-
-    BUG: Should handle negative numbers, since they can be odd perfect powers.
-*/
-
-/* This is a naive approach to recognizing perfect powers.
-   Many things can be improved.  In particular, we should use p-adic
-   arithmetic for computing possible roots.  */
-
-#include <stdio.h> /* for NULL */
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-static unsigned long int gcd _PROTO ((unsigned long int a, unsigned long int b));
-static int isprime _PROTO ((unsigned long int t));
-
-static const unsigned short primes[] =
-{  2,  3,  5,  7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53,
-  59, 61, 67, 71, 73, 79, 83, 89, 97,101,103,107,109,113,127,131,
- 137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,
- 227,229,233,239,241,251,257,263,269,271,277,281,283,293,307,311,
- 313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,
- 419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,
- 509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,
- 617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,
- 727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,
- 829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,
- 947,953,967,971,977,983,991,997,0
-};
-#define SMALLEST_OMITTED_PRIME 1009
-
-
-int
-#if __STDC__
-mpz_perfect_power_p (mpz_srcptr u)
-#else
-mpz_perfect_power_p (u)
-     mpz_srcptr u;
-#endif
-{
-  unsigned long int prime;
-  unsigned long int n, n2;
-  int i;
-  unsigned long int rem;
-  mpz_t u2, q;
-  int exact;
-  mp_size_t uns;
-  TMP_DECL (marker);
-
-  if (mpz_cmp_ui (u, 1) <= 0)
-    return 0;
-
-  n2 = mpz_scan1 (u, 0);
-  if (n2 == 1)
-    return 0;
-
-  TMP_MARK (marker);
-
-  uns = ABSIZ (u) - n2 / BITS_PER_MP_LIMB;
-  MPZ_TMP_INIT (q, uns);
-  MPZ_TMP_INIT (u2, uns);
-
-  mpz_tdiv_q_2exp (u2, u, n2);
-
-  if (isprime (n2))
-    goto n2prime;
-
-  for (i = 1; primes[i] != 0; i++)
-    {
-      prime = primes[i];
-      rem = mpz_tdiv_ui (u2, prime);
-      if (rem == 0)		/* divisable? */
-	{
-	  rem = mpz_tdiv_q_ui (q, u2, prime * prime);
-	  if (rem != 0)
-	    {
-	      TMP_FREE (marker);
-	      return 0;
-	    }
-	  mpz_swap (q, u2);
-	  for (n = 2;;)
-	    {
-	      rem = mpz_tdiv_q_ui (q, u2, prime);
-	      if (rem != 0)
-		break;
-	      mpz_swap (q, u2);
-	      n++;
-	    }
-
-	  n2 = gcd (n2, n);
-	  if (n2 == 1)
-	    {
-	      TMP_FREE (marker);
-	      return 0;
-	    }
-
-	  /* As soon as n2 becomes a prime number, stop factoring.
-	     Either we have u=x^n2 or u is not a perfect power.  */
-	  if (isprime (n2))
-	    goto n2prime;
-	}
-    }
-
-  if (mpz_cmp_ui (u2, 1) == 0)
-    {
-      TMP_FREE (marker);
-      return 1;
-    }
-
-  if (n2 == 0)
-    {
-      unsigned long int nth;
-      /* We did not find any factors above.  We have to consider all values
-	 of n.  */
-      for (nth = 2;; nth++)
-	{
-	  if (! isprime (nth))
-	    continue;
-#if 0
-	  exact = mpz_padic_root (q, u2, nth, PTH);
-	  if (exact)
-#endif
-	    exact = mpz_root (q, u2, nth);
-	  if (exact)
-	    {
-	      TMP_FREE (marker);
-	      return 1;
-	    }
-	  if (mpz_cmp_ui (q, SMALLEST_OMITTED_PRIME) < 0)
-	    {
-	      TMP_FREE (marker);
-	      return 0;
-	    }
-	}
-    }
-  else
-    {
-      unsigned long int nth;
-      /* We found some factors above.  We just need to consider values of n
-	 that divides n2.  */
-      for (nth = 2; nth <= n2; nth++)
-	{
-	  if (! isprime (nth))
-	    continue;
-	  if (n2 % nth != 0)
-	    continue;
-#if 0
-	  exact = mpz_padic_root (q, u2, nth, PTH);
-	  if (exact)
-#endif
-	    exact = mpz_root (q, u2, nth);
-	  if (exact)
-	    {
-	      TMP_FREE (marker);
-	      return 1;
-	    }
-	  if (mpz_cmp_ui (q, SMALLEST_OMITTED_PRIME) < 0)
-	    {
-	      TMP_FREE (marker);
-	      return 0;
-	    }
-	}
-
-      TMP_FREE (marker);
-      return 0;
-    }
-
-n2prime:
-  exact = mpz_root (NULL, u2, n2);
-  TMP_FREE (marker);
-  return exact;
-}
-
-static unsigned long int
-#if __STDC__
-gcd (unsigned long int a, unsigned long int b)
-#else
-gcd (a, b)
-     unsigned long int a, b;
-#endif
-{
-  int an2, bn2, n2;
-
-  if (a == 0)
-    return b;
-  if (b == 0)
-    return a;
-
-  count_trailing_zeros (an2, a);
-  a >>= an2;
-
-  count_trailing_zeros (bn2, b);
-  b >>= bn2;
-
-  n2 = MIN (an2, bn2);
-
-  while (a != b)
-    {
-      if (a > b)
-	{
-	  a -= b;
-	  do
-	    a >>= 1;
-	  while ((a & 1) == 0);
-	}
-      else /*  b > a.  */
-	{
-	  b -= a;
-	  do
-	    b >>= 1;
-	  while ((b & 1) == 0);
-	}
-    }
-
-  return a << n2;
-}
-
-static int
-#if __STDC__
-isprime (unsigned long int t)
-#else
-isprime (t)
-     unsigned long int t;
-#endif
-{
-  unsigned long int q, r, d;
-
-  if (t < 3 || (t & 1) == 0)
-    return t == 2;
-
-  for (d = 3, r = 1; r != 0; d += 2)
-    {
-      q = t / d;
-      r = t - q * d;
-      if (q < d)
-	return 1;
-    }
-  return 0;
-}
diff --git a/ghc/rts/gmp/mpz/perfsqr.c b/ghc/rts/gmp/mpz/perfsqr.c
deleted file mode 100644
index 92e8d08ea9..0000000000
--- a/ghc/rts/gmp/mpz/perfsqr.c
+++ /dev/null
@@ -1,45 +0,0 @@
-/* mpz_perfect_square_p(arg) -- Return non-zero if ARG is a perfect square,
-   zero otherwise.
-
-Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-mpz_perfect_square_p (mpz_srcptr a)
-#else
-mpz_perfect_square_p (a)
-     mpz_srcptr a;
-#endif
-{
-  mp_size_t asize = a->_mp_size;
-
-  /* No negative numbers are perfect squares.  */
-  if (asize < 0)
-    return 0;
-
-  /* Zero is a perfect square.  */
-  if (asize == 0)
-    return 1;
-
-  return mpn_perfect_square_p (a->_mp_d, asize);
-}
diff --git a/ghc/rts/gmp/mpz/popcount.c b/ghc/rts/gmp/mpz/popcount.c
deleted file mode 100644
index 3105258e26..0000000000
--- a/ghc/rts/gmp/mpz/popcount.c
+++ /dev/null
@@ -1,42 +0,0 @@
-/* mpz_popcount(mpz_ptr op) -- Population count of OP.  If the operand is
-   negative, return ~0 (a novel representation of infinity).
-
-Copyright (C) 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_popcount (mpz_srcptr u)
-#else
-mpz_popcount (u)
-     mpz_srcptr u;
-#endif
-{
-  mp_size_t usize;
-
-  usize = u->_mp_size;
-
-  if ((usize) < 0)
-    return ~ (unsigned long int) 0;
-
-  return mpn_popcount (u->_mp_d, usize);
-}
diff --git a/ghc/rts/gmp/mpz/pow_ui.c b/ghc/rts/gmp/mpz/pow_ui.c
deleted file mode 100644
index 96ca114e4d..0000000000
--- a/ghc/rts/gmp/mpz/pow_ui.c
+++ /dev/null
@@ -1,129 +0,0 @@
-/* mpz_pow_ui(res, base, exp) -- Set RES to BASE**EXP.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#ifdef BERKELEY_MP
-#include "mp.h"
-#endif
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-#ifndef BERKELEY_MP
-void
-#if __STDC__
-mpz_pow_ui (mpz_ptr r, mpz_srcptr b, unsigned long int e)
-#else
-mpz_pow_ui (r, b, e)
-     mpz_ptr r;
-     mpz_srcptr b;
-     unsigned long int e;
-#endif
-#else /* BERKELEY_MP */
-void
-#if __STDC__
-rpow (const MINT *b, signed short int e, MINT *r)
-#else
-rpow (b, e, r)
-     const MINT *b;
-     signed short int e;
-     MINT *r;
-#endif
-#endif /* BERKELEY_MP */
-{
-  mp_ptr rp, bp, tp, xp;
-  mp_size_t ralloc, rsize, bsize;
-  int cnt, i;
-  mp_limb_t blimb;
-  TMP_DECL (marker);
-
-  bsize = ABS (b->_mp_size);
-
-  /* Single out cases that give result == 0 or 1.  These tests are here
-     to simplify the general code below, not to optimize.  */
-  if (e == 0)
-    {
-      r->_mp_d[0] = 1;
-      r->_mp_size = 1;
-      return;
-    }
-  if (bsize == 0
-#ifdef BERKELEY_MP
-      || e < 0
-#endif
-      )
-    {
-      r->_mp_size = 0;
-      return;
-    }
-
-  bp = b->_mp_d;
-
-  blimb = bp[bsize - 1];
-  if (bsize == 1 && blimb < 0x100)
-    {
-      /* Estimate space requirements accurately.  Using the code from the
-	 `else' path would over-estimate space requirements wildly.   */
-      float lb = __mp_bases[blimb].chars_per_bit_exactly;
-      ralloc = 3 + ((mp_size_t) (e / lb) / BITS_PER_MP_LIMB);
-    }
-  else
-    {
-      /* Over-estimate space requirements somewhat.  */
-      count_leading_zeros (cnt, blimb);
-      ralloc = bsize * e - cnt * e / BITS_PER_MP_LIMB + 2;
-    }
-
-  TMP_MARK (marker);
-
-  /* The two areas are used to alternatingly hold the input and recieve the
-     product for mpn_mul.  (This scheme is used to fulfill the requirements
-     of mpn_mul; that the product space may not be the same as any of the
-     input operands.)  */
-  rp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
-  tp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
-
-  MPN_COPY (rp, bp, bsize);
-  rsize = bsize;
-  count_leading_zeros (cnt, e);
-
-  for (i = BITS_PER_MP_LIMB - cnt - 2; i >= 0; i--)
-    {
-      mpn_mul_n (tp, rp, rp, rsize);
-      rsize = 2 * rsize;
-      rsize -= tp[rsize - 1] == 0;
-      xp = tp; tp = rp; rp = xp;
-
-      if ((e & ((mp_limb_t) 1 << i)) != 0)
-	{
-	  rsize = rsize + bsize - (mpn_mul (tp, rp, rsize, bp, bsize) == 0);
-	  xp = tp; tp = rp; rp = xp;
-	}
-    }
-
-  /* Now then we know the exact space requirements, reallocate if
-     necessary.  */
-  if (r->_mp_alloc < rsize)
-    _mpz_realloc (r, rsize);
-
-  MPN_COPY (r->_mp_d, rp, rsize);
-  r->_mp_size = (e & 1) == 0 || b->_mp_size >= 0 ? rsize : -rsize;
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/powm.c b/ghc/rts/gmp/mpz/powm.c
deleted file mode 100644
index e6af855a71..0000000000
--- a/ghc/rts/gmp/mpz/powm.c
+++ /dev/null
@@ -1,364 +0,0 @@
-/* mpz_powm(res,base,exp,mod) -- Set RES to (base**exp) mod MOD.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation, Inc.
-Contributed by Paul Zimmermann.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-#ifdef BERKELEY_MP
-#include "mp.h"
-#endif
-
-
-/* set c <- (a*b)/R^n mod m c has to have at least (2n) allocated limbs */
-static void
-#if __STDC__
-mpz_redc (mpz_ptr c, mpz_srcptr a, mpz_srcptr b, mpz_srcptr m, mp_limb_t Nprim)
-#else
-mpz_redc (c, a, b, m, Nprim)
-     mpz_ptr c;
-     mpz_srcptr a;
-     mpz_srcptr b;
-     mpz_srcptr m;
-     mp_limb_t Nprim;
-#endif
-{
-  mp_ptr cp, mp = PTR (m);
-  mp_limb_t cy, cout = 0;
-  mp_limb_t q;
-  size_t j, n = ABSIZ (m);
-
-  ASSERT (ALLOC (c) >= 2 * n);
-
-  mpz_mul (c, a, b);
-  cp = PTR (c);
-  j = ABSIZ (c);
-  MPN_ZERO (cp + j, 2 * n - j);
-  for (j = 0; j < n; j++)
-    {
-      q = cp[0] * Nprim;
-      cy = mpn_addmul_1 (cp, mp, n, q);
-      cout += mpn_add_1 (cp + n, cp + n, n - j, cy);
-      cp++;
-    }
-  cp -= n;
-  if (cout)
-    {
-      cy = cout - mpn_sub_n (cp, cp + n, mp, n);
-      while (cy)
-	cy -= mpn_sub_n (cp, cp, mp, n);
-    }
-  else
-    MPN_COPY (cp, cp + n, n);
-  MPN_NORMALIZE (cp, n);
-  SIZ (c) = SIZ (c) < 0 ? -n : n;
-}
-
-/* average number of calls to redc for an exponent of n bits
-   with the sliding window algorithm of base 2^k: the optimal is
-   obtained for the value of k which minimizes 2^(k-1)+n/(k+1):
-
-   n\k    4     5     6     7     8
-   128    156*  159   171   200   261
-   256    309   307*  316   343   403
-   512    617   607*  610   632   688
-   1024   1231  1204  1195* 1207  1256
-   2048   2461  2399  2366  2360* 2396
-   4096   4918  4787  4707  4665* 4670
-*/
-
-#ifndef BERKELEY_MP
-void
-#if __STDC__
-mpz_powm (mpz_ptr res, mpz_srcptr base, mpz_srcptr e, mpz_srcptr mod)
-#else
-mpz_powm (res, base, e, mod)
-     mpz_ptr res;
-     mpz_srcptr base;
-     mpz_srcptr e;
-     mpz_srcptr mod;
-#endif
-#else /* BERKELEY_MP */
-void
-#if __STDC__
-pow (mpz_srcptr base, mpz_srcptr e, mpz_srcptr mod, mpz_ptr res)
-#else
-pow (base, e, mod, res)
-     mpz_srcptr base;
-     mpz_srcptr e;
-     mpz_srcptr mod;
-     mpz_ptr res;
-#endif
-#endif /* BERKELEY_MP */
-{
-  mp_limb_t invm, *ep, c, mask;
-  mpz_t xx, *g;
-  mp_size_t n, i, K, j, l, k;
-  int sh;
-  int use_redc;
-
-#ifdef POWM_DEBUG
-  mpz_t exp;
-  mpz_init (exp);
-#endif
-
-  n = ABSIZ (mod);
-
-  if (n == 0)
-    DIVIDE_BY_ZERO;
-
-  if (SIZ (e) == 0)
-    {
-      /* Exponent is zero, result is 1 mod MOD, i.e., 1 or 0
-         depending on if MOD equals 1.  */
-      SIZ(res) = (ABSIZ (mod) == 1 && (PTR(mod))[0] == 1) ? 0 : 1;
-      PTR(res)[0] = 1;
-      return;
-    }
-
-  /* Use REDC instead of usual reduction for sizes < POWM_THRESHOLD.
-     In REDC each modular multiplication costs about 2*n^2 limbs operations,
-     whereas using usual reduction it costs 3*K(n), where K(n) is the cost of a
-     multiplication using Karatsuba, and a division is assumed to cost 2*K(n),
-     for example using Burnikel-Ziegler's algorithm. This gives a theoretical
-     threshold of a*KARATSUBA_SQR_THRESHOLD, with a=(3/2)^(1/(2-ln(3)/ln(2))) ~
-     2.66.  */
-  /* For now, also disable REDC when MOD is even, as the inverse can't
-     handle that.  */
-
-#ifndef POWM_THRESHOLD
-#define POWM_THRESHOLD  ((8 * KARATSUBA_SQR_THRESHOLD) / 3)
-#endif
-
-  use_redc = (n < POWM_THRESHOLD && PTR(mod)[0] % 2 != 0);
-  if (use_redc)
-    {
-      /* invm = -1/m mod 2^BITS_PER_MP_LIMB, must have m odd */
-      modlimb_invert (invm, PTR(mod)[0]);
-      invm = -invm;
-    }
-
-  /* determines optimal value of k */
-  l = ABSIZ (e) * BITS_PER_MP_LIMB; /* number of bits of exponent */
-  k = 1;
-  K = 2;
-  while (2 * l > K * (2 + k * (3 + k)))
-    {
-      k++;
-      K *= 2;
-    }
-
-  g = (mpz_t *) (*_mp_allocate_func) (K / 2 * sizeof (mpz_t));
-  /* compute x*R^n where R=2^BITS_PER_MP_LIMB */
-  mpz_init (g[0]);
-  if (use_redc)
-    {
-      mpz_mul_2exp (g[0], base, n * BITS_PER_MP_LIMB);
-      mpz_mod (g[0], g[0], mod);
-    }
-  else
-    mpz_mod (g[0], base, mod);
-
-  /* compute xx^g for odd g < 2^k */
-  mpz_init (xx);
-  if (use_redc)
-    {
-      _mpz_realloc (xx, 2 * n);
-      mpz_redc (xx, g[0], g[0], mod, invm); /* xx = x^2*R^n */
-    }
-  else
-    {
-      mpz_mul (xx, g[0], g[0]);
-      mpz_mod (xx, xx, mod);
-    }
-  for (i = 1; i < K / 2; i++)
-    {
-      mpz_init (g[i]);
-      if (use_redc)
-	{
-	  _mpz_realloc (g[i], 2 * n);
-	  mpz_redc (g[i], g[i - 1], xx, mod, invm); /* g[i] = x^(2i+1)*R^n */
-	}
-      else
-	{
-	  mpz_mul (g[i], g[i - 1], xx);
-	  mpz_mod (g[i], g[i], mod);
-	}
-    }
-
-  /* now starts the real stuff */
-  mask = (mp_limb_t) ((1<<k) - 1);
-  ep = PTR (e);
-  i = ABSIZ (e) - 1;			/* current index */
-  c = ep[i];				/* current limb */
-  count_leading_zeros (sh, c);
-  sh = BITS_PER_MP_LIMB - sh;		/* significant bits in ep[i] */
-  sh -= k;				/* index of lower bit of ep[i] to take into account */
-  if (sh < 0)
-    {					/* k-sh extra bits are needed */
-      if (i > 0)
-	{
-	  i--;
-	  c = (c << (-sh)) | (ep[i] >> (BITS_PER_MP_LIMB + sh));
-	  sh += BITS_PER_MP_LIMB;
-	}
-    }
-  else
-    c = c >> sh;
-#ifdef POWM_DEBUG
-  printf ("-1/m mod 2^%u = %lu\n", BITS_PER_MP_LIMB, invm);
-  mpz_set_ui (exp, c);
-#endif
-  j=0;
-  while (c % 2 == 0)
-    {
-      j++;
-      c = (c >> 1);
-    }
-  mpz_set (xx, g[c >> 1]);
-  while (j--)
-    {
-      if (use_redc)
-	mpz_redc (xx, xx, xx, mod, invm);
-      else
-	{
-	  mpz_mul (xx, xx, xx);
-	  mpz_mod (xx, xx, mod);
-	}
-    }
-
-#ifdef POWM_DEBUG
-  printf ("x^"); mpz_out_str (0, 10, exp);
-  printf ("*2^%u mod m = ", n * BITS_PER_MP_LIMB); mpz_out_str (0, 10, xx);
-  putchar ('\n');
-#endif
-
-  while (i > 0 || sh > 0)
-    {
-      c = ep[i];
-      sh -= k;
-      l = k;				/* number of bits treated */
-      if (sh < 0)
-	{
-	  if (i > 0)
-	    {
-	      i--;
-	      c = (c << (-sh)) | (ep[i] >> (BITS_PER_MP_LIMB + sh));
-	      sh += BITS_PER_MP_LIMB;
-	    }
-	  else
-	    {
-	      l += sh;			/* may be less bits than k here */
-	      c = c & ((1<<l) - 1);
-	    }
-	}
-      else
-	c = c >> sh;
-      c = c & mask;
-
-      /* this while loop implements the sliding window improvement */
-      while ((c & (1 << (k - 1))) == 0 && (i > 0 || sh > 0))
-	{
-	  if (use_redc) mpz_redc (xx, xx, xx, mod, invm);
-	  else
-	    {
-	      mpz_mul (xx, xx, xx);
-	      mpz_mod (xx, xx, mod);
-	    }
-	  if (sh)
-	    {
-	      sh--;
-	      c = (c<<1) + ((ep[i]>>sh) & 1);
-	    }
-	  else
-	    {
-	      i--;
-	      sh = BITS_PER_MP_LIMB - 1;
-	      c = (c<<1) + (ep[i]>>sh);
-	    }
-	}
-
-#ifdef POWM_DEBUG
-      printf ("l=%u c=%lu\n", l, c);
-      mpz_mul_2exp (exp, exp, k);
-      mpz_add_ui (exp, exp, c);
-#endif
-
-      /* now replace xx by xx^(2^k)*x^c */
-      if (c != 0)
-	{
-	  j = 0;
-	  while (c % 2 == 0)
-	    {
-	      j++;
-	      c = c >> 1;
-	    }
-	  /* c0 = c * 2^j, i.e. xx^(2^k)*x^c = (A^(2^(k - j))*c)^(2^j) */
-	  l -= j;
-	  while (l--)
-	    if (use_redc) mpz_redc (xx, xx, xx, mod, invm);
-	    else
-	      {
-		mpz_mul (xx, xx, xx);
-		mpz_mod (xx, xx, mod);
-	      }
-	  if (use_redc)
-	    mpz_redc (xx, xx, g[c >> 1], mod, invm);
-	  else
-	    {
-	      mpz_mul (xx, xx, g[c >> 1]);
-	      mpz_mod (xx, xx, mod);
-	    }
-	}
-      else
-	j = l;				/* case c=0 */
-      while (j--)
-	{
-	  if (use_redc)
-	    mpz_redc (xx, xx, xx, mod, invm);
-	  else
-	    {
-	      mpz_mul (xx, xx, xx);
-	      mpz_mod (xx, xx, mod);
-	    }
-	}
-#ifdef POWM_DEBUG
-      printf ("x^"); mpz_out_str (0, 10, exp);
-      printf ("*2^%u mod m = ", n * BITS_PER_MP_LIMB); mpz_out_str (0, 10, xx);
-      putchar ('\n');
-#endif
-    }
-
-  /* now convert back xx to xx/R^n */
-  if (use_redc)
-    {
-      mpz_set_ui (g[0], 1);
-      mpz_redc (xx, xx, g[0], mod, invm);
-      if (mpz_cmp (xx, mod) >= 0)
-	mpz_sub (xx, xx, mod);
-    }
-  mpz_set (res, xx);
-
-  mpz_clear (xx);
-  for (i = 0; i < K / 2; i++)
-    mpz_clear (g[i]);
-  (*_mp_free_func) (g, K / 2 * sizeof (mpz_t));
-}
diff --git a/ghc/rts/gmp/mpz/powm_ui.c b/ghc/rts/gmp/mpz/powm_ui.c
deleted file mode 100644
index 00f70bd563..0000000000
--- a/ghc/rts/gmp/mpz/powm_ui.c
+++ /dev/null
@@ -1,248 +0,0 @@
-/* mpz_powm_ui(res,base,exp,mod) -- Set RES to (base**exp) mod MOD.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h> /* for NULL */
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-void
-#if __STDC__
-mpz_powm_ui (mpz_ptr res, mpz_srcptr base, unsigned long int exp, mpz_srcptr mod)
-#else
-mpz_powm_ui (res, base, exp, mod)
-     mpz_ptr res;
-     mpz_srcptr base;
-     unsigned long int exp;
-     mpz_srcptr mod;
-#endif
-{
-  mp_ptr rp, mp, bp;
-  mp_size_t msize, bsize, rsize;
-  mp_size_t size;
-  int mod_shift_cnt;
-  int negative_result;
-  mp_limb_t *free_me = NULL;
-  size_t free_me_size;
-  TMP_DECL (marker);
-
-  msize = ABS (mod->_mp_size);
-  size = 2 * msize;
-
-  rp = res->_mp_d;
-
-  if (msize == 0)
-    DIVIDE_BY_ZERO;
-
-  if (exp == 0)
-    {
-      /* Exponent is zero, result is 1 mod MOD, i.e., 1 or 0
-	 depending on if MOD equals 1.  */
-      res->_mp_size = (msize == 1 && (mod->_mp_d)[0] == 1) ? 0 : 1;
-      rp[0] = 1;
-      return;
-    }
-
-  TMP_MARK (marker);
-
-  /* Normalize MOD (i.e. make its most significant bit set) as required by
-     mpn_divmod.  This will make the intermediate values in the calculation
-     slightly larger, but the correct result is obtained after a final
-     reduction using the original MOD value.  */
-
-  mp = (mp_ptr) TMP_ALLOC (msize * BYTES_PER_MP_LIMB);
-  count_leading_zeros (mod_shift_cnt, mod->_mp_d[msize - 1]);
-  if (mod_shift_cnt != 0)
-    mpn_lshift (mp, mod->_mp_d, msize, mod_shift_cnt);
-  else
-    MPN_COPY (mp, mod->_mp_d, msize);
-
-  bsize = ABS (base->_mp_size);
-  if (bsize > msize)
-    {
-      /* The base is larger than the module.  Reduce it.  */
-
-      /* Allocate (BSIZE + 1) with space for remainder and quotient.
-	 (The quotient is (bsize - msize + 1) limbs.)  */
-      bp = (mp_ptr) TMP_ALLOC ((bsize + 1) * BYTES_PER_MP_LIMB);
-      MPN_COPY (bp, base->_mp_d, bsize);
-      /* We don't care about the quotient, store it above the remainder,
-	 at BP + MSIZE.  */
-      mpn_divmod (bp + msize, bp, bsize, mp, msize);
-      bsize = msize;
-      /* Canonicalize the base, since we are going to multiply with it
-	 quite a few times.  */
-      MPN_NORMALIZE (bp, bsize);
-    }
-  else
-    bp = base->_mp_d;
-
-  if (bsize == 0)
-    {
-      res->_mp_size = 0;
-      TMP_FREE (marker);
-      return;
-    }
-
-  if (res->_mp_alloc < size)
-    {
-      /* We have to allocate more space for RES.  If any of the input
-	 parameters are identical to RES, defer deallocation of the old
-	 space.  */
-
-      if (rp == mp || rp == bp)
-	{
-	  free_me = rp;
-	  free_me_size = res->_mp_alloc;
-	}
-      else
-	(*_mp_free_func) (rp, res->_mp_alloc * BYTES_PER_MP_LIMB);
-
-      rp = (mp_ptr) (*_mp_allocate_func) (size * BYTES_PER_MP_LIMB);
-      res->_mp_alloc = size;
-      res->_mp_d = rp;
-    }
-  else
-    {
-      /* Make BASE, EXP and MOD not overlap with RES.  */
-      if (rp == bp)
-	{
-	  /* RES and BASE are identical.  Allocate temp. space for BASE.  */
-	  bp = (mp_ptr) TMP_ALLOC (bsize * BYTES_PER_MP_LIMB);
-	  MPN_COPY (bp, rp, bsize);
-	}
-      if (rp == mp)
-	{
-	  /* RES and MOD are identical.  Allocate temporary space for MOD.  */
-	  mp = (mp_ptr) TMP_ALLOC (msize * BYTES_PER_MP_LIMB);
-	  MPN_COPY (mp, rp, msize);
-	}
-    }
-
-  MPN_COPY (rp, bp, bsize);
-  rsize = bsize;
-
-  {
-    mp_ptr xp = (mp_ptr) TMP_ALLOC (2 * (msize + 1) * BYTES_PER_MP_LIMB);
-    int c;
-    mp_limb_t e;
-    mp_limb_t carry_limb;
-
-    negative_result = (exp & 1) && base->_mp_size < 0;
-
-    e = exp;
-    count_leading_zeros (c, e);
-    e = (e << c) << 1;		/* shift the exp bits to the left, lose msb */
-    c = BITS_PER_MP_LIMB - 1 - c;
-
-    /* Main loop.
-
-       Make the result be pointed to alternately by XP and RP.  This
-       helps us avoid block copying, which would otherwise be necessary
-       with the overlap restrictions of mpn_divmod.  With 50% probability
-       the result after this loop will be in the area originally pointed
-       by RP (==RES->_mp_d), and with 50% probability in the area originally
-       pointed to by XP.  */
-
-    while (c != 0)
-      {
-	mp_ptr tp;
-	mp_size_t xsize;
-
-	mpn_mul_n (xp, rp, rp, rsize);
-	xsize = 2 * rsize;
-	xsize -= xp[xsize - 1] == 0;
-	if (xsize > msize)
-	  {
-	    mpn_divmod (xp + msize, xp, xsize, mp, msize);
-	    xsize = msize;
-	  }
-
-	tp = rp; rp = xp; xp = tp;
-	rsize = xsize;
-
-	if ((mp_limb_signed_t) e < 0)
-	  {
-	    mpn_mul (xp, rp, rsize, bp, bsize);
-	    xsize = rsize + bsize;
-	    xsize -= xp[xsize - 1] == 0;
-	    if (xsize > msize)
-	      {
-		mpn_divmod (xp + msize, xp, xsize, mp, msize);
-		xsize = msize;
-	      }
-
-	    tp = rp; rp = xp; xp = tp;
-	    rsize = xsize;
-	  }
-	e <<= 1;
-	c--;
-      }
-
-    /* We shifted MOD, the modulo reduction argument, left MOD_SHIFT_CNT
-       steps.  Adjust the result by reducing it with the original MOD.
-
-       Also make sure the result is put in RES->_mp_d (where it already
-       might be, see above).  */
-
-    if (mod_shift_cnt != 0)
-      {
-	carry_limb = mpn_lshift (res->_mp_d, rp, rsize, mod_shift_cnt);
-	rp = res->_mp_d;
-	if (carry_limb != 0)
-	  {
-	    rp[rsize] = carry_limb;
-	    rsize++;
-	  }
-      }
-    else
-      {
-	MPN_COPY (res->_mp_d, rp, rsize);
-	rp = res->_mp_d;
-      }
-
-    if (rsize >= msize)
-      {
-	mpn_divmod (rp + msize, rp, rsize, mp, msize);
-	rsize = msize;
-      }
-
-    /* Remove any leading zero words from the result.  */
-    if (mod_shift_cnt != 0)
-      mpn_rshift (rp, rp, rsize, mod_shift_cnt);
-    MPN_NORMALIZE (rp, rsize);
-  }
-
-  if (negative_result && rsize != 0)
-    {
-      if (mod_shift_cnt != 0)
-	mpn_rshift (mp, mp, msize, mod_shift_cnt);
-      mpn_sub (rp, mp, msize, rp, rsize);
-      rsize = msize;
-      MPN_NORMALIZE (rp, rsize);
-    }
-  res->_mp_size = rsize;
-
-  if (free_me != NULL)
-    (*_mp_free_func) (free_me, free_me_size * BYTES_PER_MP_LIMB);
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/pprime_p.c b/ghc/rts/gmp/mpz/pprime_p.c
deleted file mode 100644
index 82eb678238..0000000000
--- a/ghc/rts/gmp/mpz/pprime_p.c
+++ /dev/null
@@ -1,242 +0,0 @@
-/* mpz_probab_prime_p --
-   An implementation of the probabilistic primality test found in Knuth's
-   Seminumerical Algorithms book.  If the function mpz_probab_prime_p()
-   returns 0 then n is not prime.  If it returns 1, then n is 'probably'
-   prime.  If it returns 2, n is surely prime.  The probability of a false
-   positive is (1/4)**reps, where reps is the number of internal passes of the
-   probabilistic algorithm.  Knuth indicates that 25 passes are reasonable.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 1998, 1999, 2000 Free Software
-Foundation, Inc.  Miller-Rabin code contributed by John Amanatides.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-static int isprime _PROTO ((unsigned long int t));
-static int mpz_millerrabin _PROTO ((mpz_srcptr n, int reps));
-
-int
-#if __STDC__
-mpz_probab_prime_p (mpz_srcptr n, int reps)
-#else
-mpz_probab_prime_p (n, reps)
-     mpz_srcptr n;
-     int reps;
-#endif
-{
-  mp_limb_t r;
-
-  /* Handle small and negative n.  */
-  if (mpz_cmp_ui (n, 1000000L) <= 0)
-    {
-      int is_prime;
-      if (mpz_sgn (n) < 0)
-	{
-	  /* Negative number.  Negate and call ourselves.  */
-	  mpz_t n2;
-	  mpz_init (n2);
-	  mpz_neg (n2, n);
-	  is_prime = mpz_probab_prime_p (n2, reps);
-	  mpz_clear (n2);
-	  return is_prime;
-	}
-      is_prime = isprime (mpz_get_ui (n));
-      return is_prime ? 2 : 0;
-    }
-
-  /* If n is now even, it is not a prime.  */
-  if ((mpz_get_ui (n) & 1) == 0)
-    return 0;
-
-  /* Check if n has small factors.  */
-  if (UDIV_TIME > (2 * UMUL_TIME + 6))
-    r = mpn_preinv_mod_1 (PTR(n), SIZ(n), (mp_limb_t) PP, (mp_limb_t) PP_INVERTED);
-  else
-    r = mpn_mod_1 (PTR(n), SIZ(n), (mp_limb_t) PP);
-  if (r % 3 == 0 || r % 5 == 0 || r % 7 == 0 || r % 11 == 0 || r % 13 == 0
-      || r % 17 == 0 || r % 19 == 0 || r % 23 == 0 || r % 29 == 0
-#if BITS_PER_MP_LIMB == 64
-      || r % 31 == 0 || r % 37 == 0 || r % 41 == 0 || r % 43 == 0
-      || r % 47 == 0 || r % 53 == 0
-#endif
-      )
-    {
-      return 0;
-    }
-
-  /* Do more dividing.  We collect small primes, using umul_ppmm, until we
-     overflow a single limb.  We divide our number by the small primes product,
-     and look for factors in the remainder.  */
-  {
-    unsigned long int ln2;
-    unsigned long int q;
-    mp_limb_t p1, p0, p;
-    unsigned int primes[15];
-    int nprimes;
-
-    nprimes = 0;
-    p = 1;
-    ln2 = mpz_sizeinbase (n, 2) / 30; ln2 = ln2 * ln2;
-    for (q = BITS_PER_MP_LIMB == 64 ? 59 : 31; q < ln2; q += 2)
-      {
-	if (isprime (q))
-	  {
-	    umul_ppmm (p1, p0, p, q);
-	    if (p1 != 0)
-	      {
-		r = mpn_mod_1 (PTR(n), SIZ(n), p);
-		while (--nprimes >= 0)
-		  if (r % primes[nprimes] == 0)
-		    {
-		      if (mpn_mod_1 (PTR(n), SIZ(n), (mp_limb_t) primes[nprimes]) != 0)
-			abort ();
-		      return 0;
-		    }
-		p = q;
-		nprimes = 0;
-	      }
-	    else
-	      {
-		p = p0;
-	      }
-	    primes[nprimes++] = q;
-	  }
-      }
-  }
-
-  /* Perform a number of Miller-Rabin tests.  */
-  return mpz_millerrabin (n, reps);
-}
-
-static int
-#if __STDC__
-isprime (unsigned long int t)
-#else
-isprime (t)
-     unsigned long int t;
-#endif
-{
-  unsigned long int q, r, d;
-
-  if (t < 3 || (t & 1) == 0)
-    return t == 2;
-
-  for (d = 3, r = 1; r != 0; d += 2)
-    {
-      q = t / d;
-      r = t - q * d;
-      if (q < d)
-	return 1;
-    }
-  return 0;
-}
-
-static int millerrabin _PROTO ((mpz_srcptr n, mpz_srcptr nm1,
-                                mpz_ptr x, mpz_ptr y,
-                                mpz_srcptr q, unsigned long int k));
-
-static int
-#if __STDC__
-mpz_millerrabin (mpz_srcptr n, int reps)
-#else
-mpz_millerrabin (n, reps)
-     mpz_srcptr n;
-     int reps;
-#endif
-{
-  int r;
-  mpz_t nm1, x, y, q;
-  unsigned long int k;
-  gmp_randstate_t rstate;
-  int is_prime;
-  TMP_DECL (marker);
-  TMP_MARK (marker);
-
-  MPZ_TMP_INIT (nm1, SIZ (n) + 1);
-  mpz_sub_ui (nm1, n, 1L);
-
-  MPZ_TMP_INIT (x, SIZ (n));
-  MPZ_TMP_INIT (y, 2 * SIZ (n)); /* mpz_powm_ui needs excessive memory!!! */
-
-  /* Perform a Fermat test.  */
-  mpz_set_ui (x, 210L);
-  mpz_powm (y, x, nm1, n);
-  if (mpz_cmp_ui (y, 1L) != 0)
-    {
-      TMP_FREE (marker);
-      return 0;
-    }
-
-  MPZ_TMP_INIT (q, SIZ (n));
-
-  /* Find q and k, where q is odd and n = 1 + 2**k * q.  */
-  k = mpz_scan1 (nm1, 0L);
-  mpz_tdiv_q_2exp (q, nm1, k);
-
-  gmp_randinit (rstate, GMP_RAND_ALG_DEFAULT, 32L);
-
-  is_prime = 1;
-  for (r = 0; r < reps && is_prime; r++)
-    {
-      do
-	mpz_urandomb (x, rstate, mpz_sizeinbase (n, 2) - 1);
-      while (mpz_cmp_ui (x, 1L) <= 0);
-
-      is_prime = millerrabin (n, nm1, x, y, q, k);
-    }
-
-  gmp_randclear (rstate);
-
-  TMP_FREE (marker);
-  return is_prime;
-}
-
-static int
-#if __STDC__
-millerrabin (mpz_srcptr n, mpz_srcptr nm1, mpz_ptr x, mpz_ptr y,
-             mpz_srcptr q, unsigned long int k)
-#else
-millerrabin (n, nm1, x, y, q, k)
-     mpz_srcptr n;
-     mpz_srcptr nm1;
-     mpz_ptr x;
-     mpz_ptr y;
-     mpz_srcptr q;
-     unsigned long int k;
-#endif
-{
-  unsigned long int i;
-
-  mpz_powm (y, x, q, n);
-
-  if (mpz_cmp_ui (y, 1L) == 0 || mpz_cmp (y, nm1) == 0)
-    return 1;
-
-  for (i = 1; i < k; i++)
-    {
-      mpz_powm_ui (y, y, 2L, n);
-      if (mpz_cmp (y, nm1) == 0)
-	return 1;
-      if (mpz_cmp_ui (y, 1L) == 0)
-	return 0;
-    }
-  return 0;
-}
diff --git a/ghc/rts/gmp/mpz/random.c b/ghc/rts/gmp/mpz/random.c
deleted file mode 100644
index 60d9113991..0000000000
--- a/ghc/rts/gmp/mpz/random.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/* mpz_random -- Generate a random mpz_t of specified size.
-   This function is non-portable and generates poor random numbers.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "urandom.h"
-
-void
-#if __STDC__
-mpz_random (mpz_ptr x, mp_size_t size)
-#else
-mpz_random (x, size)
-     mpz_ptr x;
-     mp_size_t size;
-#endif
-{
-  mp_size_t i;
-  mp_limb_t ran;
-  mp_ptr xp;
-  mp_size_t abs_size;
-
-  abs_size = ABS (size);
-
-  if (x->_mp_alloc < abs_size)
-    _mpz_realloc (x, abs_size);
-
-  xp = x->_mp_d;
-
-  for (i = 0; i < abs_size; i++)
-    {
-      ran = urandom ();
-      xp[i] = ran;
-    }
-
-  MPN_NORMALIZE (xp, abs_size);
-  x->_mp_size = size < 0 ? -abs_size : abs_size;
-}
diff --git a/ghc/rts/gmp/mpz/random2.c b/ghc/rts/gmp/mpz/random2.c
deleted file mode 100644
index a90af115e9..0000000000
--- a/ghc/rts/gmp/mpz/random2.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/* mpz_random2 -- Generate a positive random mpz_t of specified size, with
-   long runs of consecutive ones and zeros in the binary representation.
-   Meant for testing of other MP routines.
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_random2 (mpz_ptr x, mp_size_t size)
-#else
-mpz_random2 (x, size)
-     mpz_ptr x;
-     mp_size_t size;
-#endif
-{
-  mp_size_t abs_size;
-
-  abs_size = ABS (size);
-  if (abs_size != 0)
-    {
-      if (x->_mp_alloc < abs_size)
-	_mpz_realloc (x, abs_size);
-
-      mpn_random2 (x->_mp_d, abs_size);
-    }
-
-  x->_mp_size = size;
-}
diff --git a/ghc/rts/gmp/mpz/realloc.c b/ghc/rts/gmp/mpz/realloc.c
deleted file mode 100644
index 0b9e447ec3..0000000000
--- a/ghc/rts/gmp/mpz/realloc.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/* _mpz_realloc -- make the mpz_t have NEW_SIZE digits allocated.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void *
-#if __STDC__
-_mpz_realloc (mpz_ptr m, mp_size_t new_size)
-#else
-_mpz_realloc (m, new_size)
-     mpz_ptr m;
-     mp_size_t new_size;
-#endif
-{
-  /* Never allocate zero space. */
-  if (new_size == 0)
-    new_size = 1;
-
-  m->_mp_d = (mp_ptr) (*_mp_reallocate_func) (m->_mp_d,
-					      m->_mp_alloc * BYTES_PER_MP_LIMB,
-					      new_size * BYTES_PER_MP_LIMB);
-  m->_mp_alloc = new_size;
-
-#if 0
-  /* This might break some code that reads the size field after
-     reallocation, in the case the reallocated destination and a
-     source argument are identical.  */
-  if (ABS (m->_mp_size) > new_size)
-    m->_mp_size = 0;
-#endif
-
-  return (void *) m->_mp_d;
-}
diff --git a/ghc/rts/gmp/mpz/remove.c b/ghc/rts/gmp/mpz/remove.c
deleted file mode 100644
index bc6675f972..0000000000
--- a/ghc/rts/gmp/mpz/remove.c
+++ /dev/null
@@ -1,93 +0,0 @@
-/* mpz_remove -- divide out a factor and return its multiplicity.
-
-Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_remove (mpz_ptr dest, mpz_srcptr src, mpz_srcptr f)
-#else
-mpz_remove (dest, src, f)
-     mpz_ptr dest;
-     mpz_srcptr src;
-     mpz_srcptr f;
-#endif
-{
-  mpz_t fpow[40];		/* inexhaustible...until year 2020 or so */
-  mpz_t x, rem;
-  unsigned long int pwr;
-  int p;
-
-  if (mpz_cmp_ui (f, 1) <= 0 || mpz_sgn (src) == 0)
-    DIVIDE_BY_ZERO;
-  if (mpz_cmp_ui (f, 2) == 0)
-    {
-      unsigned long int s0;
-      s0 = mpz_scan1 (src, 0);
-      mpz_div_2exp (dest, src, s0);
-      return s0;
-    }
-
-  /* We could perhaps compute mpz_scan1(src,0)/mpz_scan1(f,0).  It is an
-     upper bound of the result we're seeking.  We could also shift down the
-     operands so that they become odd, to make intermediate values smaller.  */
-
-  mpz_init (rem);
-  mpz_init (x);
-
-  pwr = 0;
-  mpz_init (fpow[0]);
-  mpz_set (fpow[0], f);
-  mpz_set (dest, src);
-
-  /* Divide by f, f^2, ..., f^(2^k) until we get a remainder for f^(2^k).  */
-  for (p = 0;; p++)
-    {
-      mpz_tdiv_qr (x, rem, dest, fpow[p]);
-      if (SIZ (rem) != 0)
-	break;
-      mpz_init (fpow[p + 1]);
-      mpz_mul (fpow[p + 1], fpow[p], fpow[p]);
-      mpz_set (dest, x);
-    }
-
-  pwr = (1 << p) - 1;
-
-  mpz_clear (fpow[p]);
-
-  /* Divide by f^(2^(k-1)), f^(2^(k-2)), ..., f for all divisors that give a
-     zero remainder.  */
-  while (--p >= 0)
-    {
-      mpz_tdiv_qr (x, rem, dest, fpow[p]);
-      if (SIZ (rem) == 0)
-	{
-	  pwr += 1 << p;
-	  mpz_set (dest, x);
-	}
-      mpz_clear (fpow[p]);
-    }
-
-  mpz_clear (x);
-  mpz_clear (rem);
-  return pwr;
-}
diff --git a/ghc/rts/gmp/mpz/root.c b/ghc/rts/gmp/mpz/root.c
deleted file mode 100644
index 0920bf22d3..0000000000
--- a/ghc/rts/gmp/mpz/root.c
+++ /dev/null
@@ -1,183 +0,0 @@
-/* mpz_root(root, u, nth) --  Set ROOT to floor(U^(1/nth)).
-   Return an indication if the result is exact.
-
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-/* Naive implementation of nth root extraction.  It would probably be a
-   better idea to use a division-free Newton iteration.  It is insane
-   to use full precision from iteration 1.  The mpz_scan1 trick compensates
-   to some extent.  It would be natural to avoid representing the low zero
-   bits mpz_scan1 is counting, and at the same time call mpn directly.  */
-
-#include <stdio.h> /* for NULL */
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-int
-#if __STDC__
-mpz_root (mpz_ptr r, mpz_srcptr c, unsigned long int nth)
-#else
-mpz_root (r, c, nth)
-     mpz_ptr r;
-     mpz_srcptr c;
-     unsigned long int nth;
-#endif
-{
-  mpz_t x, t0, t1, t2;
-  __mpz_struct ccs, *cc = &ccs;
-  unsigned long int nbits;
-  int bit;
-  int exact;
-  int i;
-  unsigned long int lowz;
-  unsigned long int rl;
-
-  /* even roots of negatives provoke an exception */
-  if (mpz_sgn (c) < 0 && (nth & 1) == 0)
-    SQRT_OF_NEGATIVE;
-
-  /* root extraction interpreted as c^(1/nth) means a zeroth root should
-     provoke a divide by zero, do this even if c==0 */
-  if (nth == 0)
-    DIVIDE_BY_ZERO;
-
-  if (mpz_sgn (c) == 0)
-    {
-      if (r != NULL)
-	mpz_set_ui (r, 0);
-      return 1;			/* exact result */
-    }
-
-  PTR(cc) = PTR(c);
-  SIZ(cc) = ABSIZ(c);
-
-  nbits = (mpz_sizeinbase (cc, 2) - 1) / nth;
-  if (nbits == 0)
-    {
-      if (r != NULL)
-	mpz_set_ui (r, 1);
-      if (mpz_sgn (c) < 0)
-	{
-	  if (r != NULL)
-	    SIZ(r) = -SIZ(r);
-	  return mpz_cmp_si (c, -1L) == 0;
-	}
-      return mpz_cmp_ui (c, 1L) == 0;
-    }
-
-  mpz_init (x);
-  mpz_init (t0);
-  mpz_init (t1);
-  mpz_init (t2);
-
-  /* Create a one-bit approximation.  */
-  mpz_set_ui (x, 0);
-  mpz_setbit (x, nbits);
-
-  /* Make the approximation better, one bit at a time.  This odd-looking
-     termination criteria makes large nth get better initial approximation,
-     which avoids slow convergence for such values.  */
-  bit = nbits - 1;
-  for (i = 1; (nth >> i) != 0; i++)
-    {
-      mpz_setbit (x, bit);
-      mpz_tdiv_q_2exp (t0, x, bit);
-      mpz_pow_ui (t1, t0, nth);
-      mpz_mul_2exp (t1, t1, bit * nth);
-      if (mpz_cmp (cc, t1) < 0)
-	mpz_clrbit (x, bit);
-
-      bit--;			/* check/set next bit */
-      if (bit < 0)
-	{
-	  /* We're done.  */
-	  mpz_pow_ui (t1, x, nth);
-	  goto done;
-	}
-    }
-  mpz_setbit (x, bit);
-  mpz_set_ui (t2, 0); mpz_setbit (t2, bit);  mpz_add (x, x, t2);
-
-#if DEBUG
-  /* Check that the starting approximation is >= than the root.  */
-  mpz_pow_ui (t1, x, nth);
-  if (mpz_cmp (cc, t1) >= 0)
-    abort ();
-#endif
-
-  mpz_add_ui (x, x, 1);
-
-  /* Main loop */
-  do
-    {
-      lowz = mpz_scan1 (x, 0);
-      mpz_tdiv_q_2exp (t0, x, lowz);
-      mpz_pow_ui (t1, t0, nth - 1);
-      mpz_mul_2exp (t1, t1, lowz * (nth - 1));
-      mpz_tdiv_q (t2, cc, t1);
-      mpz_sub (t2, x, t2);
-      rl = mpz_tdiv_q_ui (t2, t2, nth);
-      mpz_sub (x, x, t2);
-    }
-  while (mpz_sgn (t2) != 0);
-
-  /* If we got a non-zero remainder in the last division, we know our root
-     is too large.  */
-  mpz_sub_ui (x, x, (mp_limb_t) (rl != 0));
-
-  /* Adjustment loop.  If we spend more care on rounding in the loop above,
-     we could probably get rid of this, or greatly simplify it.  */
-  {
-    int bad = 0;
-    lowz = mpz_scan1 (x, 0);
-    mpz_tdiv_q_2exp (t0, x, lowz);
-    mpz_pow_ui (t1, t0, nth);
-    mpz_mul_2exp (t1, t1, lowz * nth);
-    while (mpz_cmp (cc, t1) < 0)
-      {
-	bad++;
-	if (bad > 2)
-	  abort ();			/* abort if our root is far off */
-	mpz_sub_ui (x, x, 1);
-	lowz = mpz_scan1 (x, 0);
-	mpz_tdiv_q_2exp (t0, x, lowz);
-	mpz_pow_ui (t1, t0, nth);
-	mpz_mul_2exp (t1, t1, lowz * nth);
-      }
-  }
-
- done:
-  exact = mpz_cmp (t1, cc) == 0;
-
-  if (r != NULL)
-    {
-      mpz_set (r, x);
-      if (mpz_sgn (c) < 0)
-	SIZ(r) = -SIZ(r);
-    }
-
-  mpz_clear (t2);
-  mpz_clear (t1);
-  mpz_clear (t0);
-  mpz_clear (x);
-
-  return exact;
-}
diff --git a/ghc/rts/gmp/mpz/rrandomb.c b/ghc/rts/gmp/mpz/rrandomb.c
deleted file mode 100644
index 7d78243674..0000000000
--- a/ghc/rts/gmp/mpz/rrandomb.c
+++ /dev/null
@@ -1,117 +0,0 @@
-/* mpz_rrandomb -- Generate a positive random mpz_t of specified bit size, with
-   long runs of consecutive ones and zeros in the binary representation.
-   Meant for testing of other MP routines.
-
-Copyright (C) 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-static void gmp_rrandomb _PROTO ((mp_ptr rp, gmp_randstate_t rstate, unsigned long int nbits));
-
-void
-#if __STDC__
-mpz_rrandomb (mpz_ptr x, gmp_randstate_t rstate, unsigned long int nbits)
-#else
-mpz_rrandomb (x, rstate, nbits)
-     mpz_ptr x;
-     gmp_randstate_t rstate;
-     unsigned long int nbits;
-#endif
-{
-  mp_size_t nl = 0;
-
-  if (nbits != 0)
-    {
-      mp_ptr xp;
-      nl = (nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
-      if (x->_mp_alloc < nl)
-	_mpz_realloc (x, nl);
-
-      xp = PTR(x);
-      gmp_rrandomb (xp, rstate, nbits);
-      MPN_NORMALIZE (xp, nl);
-    }
-
-  SIZ(x) = nl;
-}
-
-#define BITS_PER_CHUNK 4
-
-static void
-#if __STDC__
-gmp_rrandomb (mp_ptr rp, gmp_randstate_t rstate, unsigned long int nbits)
-#else
-gmp_rrandomb (rp, rstate, nbits)
-     mp_ptr rp;
-     gmp_randstate_t rstate;
-     unsigned long int nbits;
-#endif
-{
-  int nb;
-  int bit_pos;
-  mp_size_t limb_pos;
-  mp_limb_t ran, ranm;
-  mp_limb_t acc;
-  mp_size_t n;
-
-  bit_pos = nbits % BITS_PER_MP_LIMB;
-  limb_pos = nbits / BITS_PER_MP_LIMB;
-  if (bit_pos == 0)
-    {
-      bit_pos = BITS_PER_MP_LIMB;
-      limb_pos--;
-    }
-
-  acc = 0;
-  while (limb_pos >= 0)
-    {
-      _gmp_rand (&ranm, rstate, BITS_PER_CHUNK + 1);
-      ran = ranm;
-      nb = (ran >> 1) + 1;
-      if ((ran & 1) != 0)
-	{
-	  /* Generate a string of ones.  */
-	  if (nb > bit_pos)
-	    {
-	      rp[limb_pos--] = acc | ((((mp_limb_t) 1) << bit_pos) - 1);
-	      bit_pos += BITS_PER_MP_LIMB;
-	      bit_pos -= nb;
-	      acc = (~(mp_limb_t) 0) << bit_pos;
-	    }
-	  else
-	    {
-	      bit_pos -= nb;
-	      acc |= ((((mp_limb_t) 1) << nb) - 1) << bit_pos;
-	    }
-	}
-      else
-	{
-	  /* Generate a string of zeroes.  */
-	  if (nb > bit_pos)
-	    {
-	      rp[limb_pos--] = acc;
-	      acc = 0;
-	      bit_pos += BITS_PER_MP_LIMB;
-	    }
-	  bit_pos -= nb;
-	}
-    }
-}
diff --git a/ghc/rts/gmp/mpz/scan0.c b/ghc/rts/gmp/mpz/scan0.c
deleted file mode 100644
index 6c59cf8939..0000000000
--- a/ghc/rts/gmp/mpz/scan0.c
+++ /dev/null
@@ -1,35 +0,0 @@
-/* mpz_scan0(op, startbit) -- Scan for the next set bit, starting at startbit.
-
-Copyright (C) 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_scan0 (mpz_srcptr u, unsigned long int starting_bit)
-#else
-mpz_scan0 (u, starting_bit)
-     mpz_srcptr u;
-     unsigned long int starting_bit;
-#endif
-{
-  return mpn_scan0 (u->_mp_d, starting_bit);
-}
diff --git a/ghc/rts/gmp/mpz/scan1.c b/ghc/rts/gmp/mpz/scan1.c
deleted file mode 100644
index 3b84e3420c..0000000000
--- a/ghc/rts/gmp/mpz/scan1.c
+++ /dev/null
@@ -1,35 +0,0 @@
-/* mpz_scan1(op, startbit) -- Scan for the next set bit, starting at startbit.
-
-Copyright (C) 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_scan1 (mpz_srcptr u, unsigned long int starting_bit)
-#else
-mpz_scan1 (u, starting_bit)
-     mpz_srcptr u;
-     unsigned long int starting_bit;
-#endif
-{
-  return mpn_scan1 (u->_mp_d, starting_bit);
-}
diff --git a/ghc/rts/gmp/mpz/set.c b/ghc/rts/gmp/mpz/set.c
deleted file mode 100644
index 06b2eef511..0000000000
--- a/ghc/rts/gmp/mpz/set.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/* mpz_set (dest_integer, src_integer) -- Assign DEST_INTEGER from SRC_INTEGER.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_set (mpz_ptr w, mpz_srcptr u)
-#else
-mpz_set (w, u)
-     mpz_ptr w;
-     mpz_srcptr u;
-#endif
-{
-  mp_ptr wp, up;
-  mp_size_t usize, size;
-
-  usize = u->_mp_size;
-  size = ABS (usize);
-
-  if (w->_mp_alloc < size)
-    _mpz_realloc (w, size);
-
-  wp = w->_mp_d;
-  up = u->_mp_d;
-
-  MPN_COPY (wp, up, size);
-  w->_mp_size = usize;
-}
diff --git a/ghc/rts/gmp/mpz/set_d.c b/ghc/rts/gmp/mpz/set_d.c
deleted file mode 100644
index e90ed9bc2f..0000000000
--- a/ghc/rts/gmp/mpz/set_d.c
+++ /dev/null
@@ -1,96 +0,0 @@
-/* mpz_set_d(integer, val) -- Assign INTEGER with a double value VAL.
-
-Copyright (C) 1995, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_set_d (mpz_ptr r, double d)
-#else
-mpz_set_d (r, d)
-     mpz_ptr r;
-     double d;
-#endif
-{
-  int negative;
-  mp_limb_t tp[3];
-  mp_ptr rp;
-  mp_size_t rn;
-
-  negative = d < 0;
-  d = ABS (d);
-
-  /* Handle small arguments quickly.  */
-  if (d < MP_BASE_AS_DOUBLE)
-    {
-      mp_limb_t tmp;
-      tmp = d;
-      PTR(r)[0] = tmp;
-      SIZ(r) = negative ? -(tmp != 0) : (tmp != 0);
-      return;
-    }
-
-  rn = __gmp_extract_double (tp, d);
-
-  if (ALLOC(r) < rn)
-    _mpz_realloc (r, rn);
-
-  rp = PTR (r);
-
-#if BITS_PER_MP_LIMB == 32
-  switch (rn)
-    {
-    default:
-      MPN_ZERO (rp, rn - 3);
-      rp += rn - 3;
-      /* fall through */
-    case 3:
-      rp[2] = tp[2];
-      rp[1] = tp[1];
-      rp[0] = tp[0];
-      break;
-    case 2:
-      rp[1] = tp[2];
-      rp[0] = tp[1];
-      break;
-    case 1:
-      /* handled in "small aguments" case above */
-      abort ();
-    }
-#else
-  switch (rn)
-    {
-    default:
-      MPN_ZERO (rp, rn - 2);
-      rp += rn - 2;
-      /* fall through */
-    case 2:
-      rp[1] = tp[1], rp[0] = tp[0];
-      break;
-    case 1:
-      /* handled in "small aguments" case above */
-      abort ();
-    }
-#endif
-
-  SIZ(r) = negative ? -rn : rn;
-}
diff --git a/ghc/rts/gmp/mpz/set_f.c b/ghc/rts/gmp/mpz/set_f.c
deleted file mode 100644
index 2273953dfd..0000000000
--- a/ghc/rts/gmp/mpz/set_f.c
+++ /dev/null
@@ -1,64 +0,0 @@
-/* mpz_set_f (dest_integer, src_float) -- Assign DEST_INTEGER from SRC_FLOAT.
-
-Copyright (C) 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_set_f (mpz_ptr w, mpf_srcptr u)
-#else
-mpz_set_f (w, u)
-     mpz_ptr w;
-     mpf_srcptr u;
-#endif
-{
-  mp_ptr wp, up;
-  mp_size_t usize, size;
-  mp_exp_t exp;
-
-  usize = SIZ (u);
-  size = ABS (usize);
-  exp = EXP (u);
-
-  if (w->_mp_alloc < exp)
-    _mpz_realloc (w, exp);
-
-  wp = w->_mp_d;
-  up = u->_mp_d;
-
-  if (exp <= 0)
-    {
-      SIZ (w) = 0;
-      return;
-    }
-  if (exp < size)
-    {
-      MPN_COPY (wp, up + size - exp, exp);
-    }
-  else
-    {
-      MPN_ZERO (wp, exp - size);
-      MPN_COPY (wp + exp - size, up, size);
-    }
-
-  w->_mp_size = usize >= 0 ? exp : -exp;
-}
diff --git a/ghc/rts/gmp/mpz/set_q.c b/ghc/rts/gmp/mpz/set_q.c
deleted file mode 100644
index 72d3222a80..0000000000
--- a/ghc/rts/gmp/mpz/set_q.c
+++ /dev/null
@@ -1,36 +0,0 @@
-/* mpz_set_q (dest_integer, src_rational) -- Assign DEST_INTEGER from
-   SRC_rational.
-
-Copyright (C) 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_set_q (mpz_ptr w, mpq_srcptr u)
-#else
-mpz_set_q (w, u)
-     mpz_ptr w;
-     mpq_srcptr u;
-#endif
-{
-  mpz_tdiv_q (w, mpq_numref (u), mpq_denref (u));
-}
diff --git a/ghc/rts/gmp/mpz/set_si.c b/ghc/rts/gmp/mpz/set_si.c
deleted file mode 100644
index 9ba2fbaf30..0000000000
--- a/ghc/rts/gmp/mpz/set_si.c
+++ /dev/null
@@ -1,48 +0,0 @@
-/* mpz_set_si(integer, val) -- Assign INTEGER with a small value VAL.
-
-Copyright (C) 1991, 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_set_si (mpz_ptr dest, signed long int val)
-#else
-mpz_set_si (dest, val)
-     mpz_ptr dest;
-     signed long int val;
-#endif
-{
-  /* We don't check if the allocation is enough, since the rest of the
-     package ensures it's at least 1, which is what we need here.  */
-  if (val > 0)
-    {
-      dest->_mp_d[0] = val;
-      dest->_mp_size = 1;
-    }
-  else if (val < 0)
-    {
-      dest->_mp_d[0] = (unsigned long) -val;
-      dest->_mp_size = -1;
-    }
-  else
-    dest->_mp_size = 0;
-}
diff --git a/ghc/rts/gmp/mpz/set_str.c b/ghc/rts/gmp/mpz/set_str.c
deleted file mode 100644
index 3ab79c0e89..0000000000
--- a/ghc/rts/gmp/mpz/set_str.c
+++ /dev/null
@@ -1,157 +0,0 @@
-/* mpz_set_str(mp_dest, string, base) -- Convert the \0-terminated
-   string STRING in base BASE to multiple precision integer in
-   MP_DEST.  Allow white space in the string.  If BASE == 0 determine
-   the base in the C standard way, i.e.  0xhh...h means base 16,
-   0oo...o means base 8, otherwise assume base 10.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 1998, 2000 Free Software
-Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <string.h>
-#include <ctype.h>
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-static int
-#if __STDC__
-digit_value_in_base (int c, int base)
-#else
-digit_value_in_base (c, base)
-     int c;
-     int base;
-#endif
-{
-  int digit;
-
-  if (isdigit (c))
-    digit = c - '0';
-  else if (islower (c))
-    digit = c - 'a' + 10;
-  else if (isupper (c))
-    digit = c - 'A' + 10;
-  else
-    return -1;
-
-  if (digit < base)
-    return digit;
-  return -1;
-}
-
-int
-#if __STDC__
-mpz_set_str (mpz_ptr x, const char *str, int base)
-#else
-mpz_set_str (x, str, base)
-     mpz_ptr x;
-     const char *str;
-     int base;
-#endif
-{
-  size_t str_size;
-  char *s, *begs;
-  size_t i;
-  mp_size_t xsize;
-  int c;
-  int negative;
-  TMP_DECL (marker);
-
-  /* Skip whitespace.  */
-  do
-    c = *str++;
-  while (isspace (c));
-
-  negative = 0;
-  if (c == '-')
-    {
-      negative = 1;
-      c = *str++;
-    }
-
-  if (digit_value_in_base (c, base == 0 ? 10 : base) < 0)
-    return -1;			/* error if no digits */
-
-  /* If BASE is 0, try to find out the base by looking at the initial
-     characters.  */
-  if (base == 0)
-    {
-      base = 10;
-      if (c == '0')
-	{
-	  base = 8;
-	  c = *str++;
-	  if (c == 'x' || c == 'X')
-	    {
-	      base = 16;
-	      c = *str++;
-	    }
-	  else if (c == 'b' || c == 'B')
-	    {
-	      base = 2;
-	      c = *str++;
-	    }
-	}
-    }
-
-  /* Skip leading zeros.  */
-  while (c == '0')
-    c = *str++;
-  /* Make sure the string does not become empty, mpn_set_str would fail.  */
-  if (c == 0)
-    {
-      x->_mp_size = 0;
-      return 0;
-    }
-
-  TMP_MARK (marker);
-  str_size = strlen (str - 1);
-  s = begs = (char *) TMP_ALLOC (str_size + 1);
-
-  /* Remove spaces from the string and convert the result from ASCII to a
-     byte array.  */
-  for (i = 0; i < str_size; i++)
-    {
-      if (!isspace (c))
-	{
-	  int dig = digit_value_in_base (c, base);
-	  if (dig < 0)
-	    {
-	      TMP_FREE (marker);
-	      return -1;
-	    }
-	  *s++ = dig;
-	}
-      c = *str++;
-    }
-
-  str_size = s - begs;
-
-  xsize = (((mp_size_t) (str_size / __mp_bases[base].chars_per_bit_exactly))
-	   / BITS_PER_MP_LIMB + 2);
-  if (x->_mp_alloc < xsize)
-    _mpz_realloc (x, xsize);
-
-  /* Convert the byte array in base BASE to our bignum format.  */
-  xsize = mpn_set_str (x->_mp_d, (unsigned char *) begs, str_size, base);
-  x->_mp_size = negative ? -xsize : xsize;
-
-  TMP_FREE (marker);
-  return 0;
-}
diff --git a/ghc/rts/gmp/mpz/set_ui.c b/ghc/rts/gmp/mpz/set_ui.c
deleted file mode 100644
index d6097c170a..0000000000
--- a/ghc/rts/gmp/mpz/set_ui.c
+++ /dev/null
@@ -1,43 +0,0 @@
-/* mpz_set_ui(integer, val) -- Assign INTEGER with a small value VAL.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_set_ui (mpz_ptr dest, unsigned long int val)
-#else
-mpz_set_ui (dest, val)
-     mpz_ptr dest;
-     unsigned long int val;
-#endif
-{
-  /* We don't check if the allocation is enough, since the rest of the
-     package ensures it's at least 1, which is what we need here.  */
-  if (val > 0)
-    {
-      dest->_mp_d[0] = val;
-      dest->_mp_size = 1;
-    }
-  else
-    dest->_mp_size = 0;
-}
diff --git a/ghc/rts/gmp/mpz/setbit.c b/ghc/rts/gmp/mpz/setbit.c
deleted file mode 100644
index d4249a434e..0000000000
--- a/ghc/rts/gmp/mpz/setbit.c
+++ /dev/null
@@ -1,119 +0,0 @@
-/* mpz_setbit -- set a specified bit.
-
-Copyright (C) 1991, 1993, 1994, 1995, 1997, 1999 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_setbit (mpz_ptr d, unsigned long int bit_index)
-#else
-mpz_setbit (d, bit_index)
-     mpz_ptr d;
-     unsigned long int bit_index;
-#endif
-{
-  mp_size_t dsize = d->_mp_size;
-  mp_ptr dp = d->_mp_d;
-  mp_size_t limb_index;
-
-  limb_index = bit_index / BITS_PER_MP_LIMB;
-  if (dsize >= 0)
-    {
-      if (limb_index < dsize)
-	{
-	  dp[limb_index] |= (mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB);
-	  d->_mp_size = dsize;
-	}
-      else
-	{
-	  /* Ugh.  The bit should be set outside of the end of the
-	     number.  We have to increase the size of the number.  */
-	  if (d->_mp_alloc < limb_index + 1)
-	    {
-	      _mpz_realloc (d, limb_index + 1);
-	      dp = d->_mp_d;
-	    }
-	  MPN_ZERO (dp + dsize, limb_index - dsize);
-	  dp[limb_index] = (mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB);
-	  d->_mp_size = limb_index + 1;
-	}
-    }
-  else
-    {
-      mp_size_t zero_bound;
-
-      /* Simulate two's complement arithmetic, i.e. simulate
-	 1. Set OP = ~(OP - 1) [with infinitely many leading ones].
-	 2. Set the bit.
-	 3. Set OP = ~OP + 1.  */
-
-      dsize = -dsize;
-
-      /* No upper bound on this loop, we're sure there's a non-zero limb
-	 sooner ot later.  */
-      for (zero_bound = 0; ; zero_bound++)
-	if (dp[zero_bound] != 0)
-	  break;
-
-      if (limb_index > zero_bound)
-	{
-	  if (limb_index < dsize)
-	    dp[limb_index] &= ~((mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB));
-	  else
-	    ;
-	}
-      else if (limb_index == zero_bound)
-	{
-	  dp[limb_index] = ((dp[limb_index] - 1)
-			    & ~((mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB))) + 1;
-	  if (dp[limb_index] == 0)
-	    {
-	      mp_size_t i;
-	      for (i = limb_index + 1; i < dsize; i++)
-		{
-		  dp[i] += 1;
-		  if (dp[i] != 0)
-		    goto fin;
-		}
-	      /* We got carry all way out beyond the end of D.  Increase
-		 its size (and allocation if necessary).  */
-	      dsize++;
-	      if (d->_mp_alloc < dsize)
-		{
-		  _mpz_realloc (d, dsize);
-		  dp = d->_mp_d;
-		}
-	      dp[i] = 1;
-	      d->_mp_size = -dsize;
-	    fin:;
-	    }
-	}
-      else
-	{
-	  mpn_decr_u (dp + limb_index,
-		     (mp_limb_t) 1 << (bit_index % BITS_PER_MP_LIMB));
-	  dsize -= dp[dsize - 1] == 0;
-	  d->_mp_size = -dsize;
-	}
-    }
-}
diff --git a/ghc/rts/gmp/mpz/size.c b/ghc/rts/gmp/mpz/size.c
deleted file mode 100644
index 6574756783..0000000000
--- a/ghc/rts/gmp/mpz/size.c
+++ /dev/null
@@ -1,35 +0,0 @@
-/* mpz_size(x) -- return the number of lims currently used by the
-   value of integer X.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-size_t
-#if __STDC__
-mpz_size (mpz_srcptr x)
-#else
-mpz_size (x)
-     mpz_srcptr x;
-#endif
-{
-  return ABS (x->_mp_size);
-}
diff --git a/ghc/rts/gmp/mpz/sizeinbase.c b/ghc/rts/gmp/mpz/sizeinbase.c
deleted file mode 100644
index 734f9c4532..0000000000
--- a/ghc/rts/gmp/mpz/sizeinbase.c
+++ /dev/null
@@ -1,60 +0,0 @@
-/* mpz_sizeinbase(x, base) -- return an approximation to the number of
-   character the integer X would have printed in base BASE.  The
-   approximation is never too small.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-size_t
-#if __STDC__
-mpz_sizeinbase (mpz_srcptr x, int base)
-#else
-mpz_sizeinbase (x, base)
-     mpz_srcptr x;
-     int base;
-#endif
-{
-  mp_size_t size = ABS (x->_mp_size);
-  int lb_base, cnt;
-  size_t totbits;
-
-  /* Special case for X == 0.  */
-  if (size == 0)
-    return 1;
-
-  /* Calculate the total number of significant bits of X.  */
-  count_leading_zeros (cnt, x->_mp_d[size - 1]);
-  totbits = size * BITS_PER_MP_LIMB - cnt;
-
-  if ((base & (base - 1)) == 0)
-    {
-      /* Special case for powers of 2, giving exact result.  */
-
-      count_leading_zeros (lb_base, base);
-      lb_base = BITS_PER_MP_LIMB - lb_base - 1;
-
-      return (totbits + lb_base - 1) / lb_base;
-    }
-  else
-    return (size_t) (totbits * __mp_bases[base].chars_per_bit_exactly) + 1;
-}
diff --git a/ghc/rts/gmp/mpz/sqrt.c b/ghc/rts/gmp/mpz/sqrt.c
deleted file mode 100644
index fe82fe407a..0000000000
--- a/ghc/rts/gmp/mpz/sqrt.c
+++ /dev/null
@@ -1,86 +0,0 @@
-/* mpz_sqrt(root, u) --  Set ROOT to floor(sqrt(U)).
-
-Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h> /* for NULL */
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_sqrt (mpz_ptr root, mpz_srcptr op)
-#else
-mpz_sqrt (root, op)
-     mpz_ptr root;
-     mpz_srcptr op;
-#endif
-{
-  mp_size_t op_size, root_size;
-  mp_ptr root_ptr, op_ptr;
-  mp_ptr free_me = NULL;
-  mp_size_t free_me_size;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-  op_size = op->_mp_size;
-  if (op_size < 0)
-    SQRT_OF_NEGATIVE;
-
-  /* The size of the root is accurate after this simple calculation.  */
-  root_size = (op_size + 1) / 2;
-
-  root_ptr = root->_mp_d;
-  op_ptr = op->_mp_d;
-
-  if (root->_mp_alloc < root_size)
-    {
-      if (root_ptr == op_ptr)
-	{
-	  free_me = root_ptr;
-	  free_me_size = root->_mp_alloc;
-	}
-      else
-	(*_mp_free_func) (root_ptr, root->_mp_alloc * BYTES_PER_MP_LIMB);
-
-      root->_mp_alloc = root_size;
-      root_ptr = (mp_ptr) (*_mp_allocate_func) (root_size * BYTES_PER_MP_LIMB);
-      root->_mp_d = root_ptr;
-    }
-  else
-    {
-      /* Make OP not overlap with ROOT.  */
-      if (root_ptr == op_ptr)
-	{
-	  /* ROOT and OP are identical.  Allocate temporary space for OP.  */
-	  op_ptr = (mp_ptr) TMP_ALLOC (op_size * BYTES_PER_MP_LIMB);
-	  /* Copy to the temporary space.  Hack: Avoid temporary variable
-	     by using ROOT_PTR.  */
-	  MPN_COPY (op_ptr, root_ptr, op_size);
-	}
-    }
-
-  mpn_sqrtrem (root_ptr, NULL, op_ptr, op_size);
-
-  root->_mp_size = root_size;
-
-  if (free_me != NULL)
-    (*_mp_free_func) (free_me, free_me_size * BYTES_PER_MP_LIMB);
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/sqrtrem.c b/ghc/rts/gmp/mpz/sqrtrem.c
deleted file mode 100644
index 99a6453122..0000000000
--- a/ghc/rts/gmp/mpz/sqrtrem.c
+++ /dev/null
@@ -1,111 +0,0 @@
-/* mpz_sqrtrem(root,rem,x) -- Set ROOT to floor(sqrt(X)) and REM
-   to the remainder, i.e. X - ROOT**2.
-
-Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h> /* for NULL */
-#include "gmp.h"
-#include "gmp-impl.h"
-#ifdef BERKELEY_MP
-#include "mp.h"
-#endif
-
-#ifndef BERKELEY_MP
-void
-#if __STDC__
-mpz_sqrtrem (mpz_ptr root, mpz_ptr rem, mpz_srcptr op)
-#else
-mpz_sqrtrem (root, rem, op)
-     mpz_ptr root;
-     mpz_ptr rem;
-     mpz_srcptr op;
-#endif
-#else /* BERKELEY_MP */
-void
-#if __STDC__
-msqrt (mpz_srcptr op, mpz_ptr root, mpz_ptr rem)
-#else
-msqrt (op, root, rem)
-     mpz_srcptr op;
-     mpz_ptr root;
-     mpz_ptr rem;
-#endif
-#endif /* BERKELEY_MP */
-{
-  mp_size_t op_size, root_size, rem_size;
-  mp_ptr root_ptr, op_ptr;
-  mp_ptr free_me = NULL;
-  mp_size_t free_me_size;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-  op_size = op->_mp_size;
-  if (op_size < 0)
-    SQRT_OF_NEGATIVE;
-
-  if (rem->_mp_alloc < op_size)
-    _mpz_realloc (rem, op_size);
-
-  /* The size of the root is accurate after this simple calculation.  */
-  root_size = (op_size + 1) / 2;
-
-  root_ptr = root->_mp_d;
-  op_ptr = op->_mp_d;
-
-  if (root->_mp_alloc < root_size)
-    {
-      if (root_ptr == op_ptr)
-	{
-	  free_me = root_ptr;
-	  free_me_size = root->_mp_alloc;
-	}
-      else
-	(*_mp_free_func) (root_ptr, root->_mp_alloc * BYTES_PER_MP_LIMB);
-
-      root->_mp_alloc = root_size;
-      root_ptr = (mp_ptr) (*_mp_allocate_func) (root_size * BYTES_PER_MP_LIMB);
-      root->_mp_d = root_ptr;
-    }
-  else
-    {
-      /* Make OP not overlap with ROOT.  */
-      if (root_ptr == op_ptr)
-	{
-	  /* ROOT and OP are identical.  Allocate temporary space for OP.  */
-	  op_ptr = (mp_ptr) TMP_ALLOC (op_size * BYTES_PER_MP_LIMB);
-	  /* Copy to the temporary space.  Hack: Avoid temporary variable
-	     by using ROOT_PTR.  */
-	  MPN_COPY (op_ptr, root_ptr, op_size);
-	}
-    }
-
-  rem_size = mpn_sqrtrem (root_ptr, rem->_mp_d, op_ptr, op_size);
-
-  root->_mp_size = root_size;
-
-  /* Write remainder size last, to enable us to define this function to
-     give only the square root remainder, if the user calls if with
-     ROOT == REM.  */
-  rem->_mp_size = rem_size;
-
-  if (free_me != NULL)
-    (*_mp_free_func) (free_me, free_me_size * BYTES_PER_MP_LIMB);
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/sub.c b/ghc/rts/gmp/mpz/sub.c
deleted file mode 100644
index f3ae7c23a0..0000000000
--- a/ghc/rts/gmp/mpz/sub.c
+++ /dev/null
@@ -1,123 +0,0 @@
-/* mpz_sub -- Subtract two integers.
-
-Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#ifdef BERKELEY_MP
-#include "mp.h"
-#endif
-
-#ifndef BERKELEY_MP
-void
-#if __STDC__
-mpz_sub (mpz_ptr w, mpz_srcptr u, mpz_srcptr v)
-#else
-mpz_sub (w, u, v)
-     mpz_ptr w;
-     mpz_srcptr u;
-     mpz_srcptr v;
-#endif
-#else /* BERKELEY_MP */
-void
-#if __STDC__
-msub (mpz_srcptr u, mpz_srcptr v, mpz_ptr w)
-#else
-msub (u, v, w)
-     mpz_srcptr u;
-     mpz_srcptr v;
-     mpz_ptr w;
-#endif
-#endif /* BERKELEY_MP */
-{
-  mp_srcptr up, vp;
-  mp_ptr wp;
-  mp_size_t usize, vsize, wsize;
-  mp_size_t abs_usize;
-  mp_size_t abs_vsize;
-
-  usize = u->_mp_size;
-  vsize = -v->_mp_size;		/* The "-" makes the difference from mpz_add */
-  abs_usize = ABS (usize);
-  abs_vsize = ABS (vsize);
-
-  if (abs_usize < abs_vsize)
-    {
-      /* Swap U and V. */
-      MPZ_SRCPTR_SWAP (u, v);
-      MP_SIZE_T_SWAP (usize, vsize);
-      MP_SIZE_T_SWAP (abs_usize, abs_vsize);
-    }
-
-  /* True: ABS_USIZE >= ABS_VSIZE.  */
-
-  /* If not space for w (and possible carry), increase space.  */
-  wsize = abs_usize + 1;
-  if (w->_mp_alloc < wsize)
-    _mpz_realloc (w, wsize);
-
-  /* These must be after realloc (u or v may be the same as w).  */
-  up = u->_mp_d;
-  vp = v->_mp_d;
-  wp = w->_mp_d;
-
-  if ((usize ^ vsize) < 0)
-    {
-      /* U and V have different sign.  Need to compare them to determine
-	 which operand to subtract from which.  */
-
-      /* This test is right since ABS_USIZE >= ABS_VSIZE.  */
-      if (abs_usize != abs_vsize)
-	{
-	  mpn_sub (wp, up, abs_usize, vp, abs_vsize);
-	  wsize = abs_usize;
-	  MPN_NORMALIZE (wp, wsize);
-	  if (usize < 0)
-	    wsize = -wsize;
-	}
-      else if (mpn_cmp (up, vp, abs_usize) < 0)
-	{
-	  mpn_sub_n (wp, vp, up, abs_usize);
-	  wsize = abs_usize;
-	  MPN_NORMALIZE (wp, wsize);
-	  if (usize >= 0)
-	    wsize = -wsize;
-	}
-      else
-	{
-	  mpn_sub_n (wp, up, vp, abs_usize);
-	  wsize = abs_usize;
-	  MPN_NORMALIZE (wp, wsize);
-	  if (usize < 0)
-	    wsize = -wsize;
-	}
-    }
-  else
-    {
-      /* U and V have same sign.  Add them.  */
-      mp_limb_t cy_limb = mpn_add (wp, up, abs_usize, vp, abs_vsize);
-      wp[abs_usize] = cy_limb;
-      wsize = abs_usize + cy_limb;
-      if (usize < 0)
-	wsize = -wsize;
-    }
-
-  w->_mp_size = wsize;
-}
diff --git a/ghc/rts/gmp/mpz/sub_ui.c b/ghc/rts/gmp/mpz/sub_ui.c
deleted file mode 100644
index 327add8503..0000000000
--- a/ghc/rts/gmp/mpz/sub_ui.c
+++ /dev/null
@@ -1,84 +0,0 @@
-/* mpz_sub_ui -- Subtract an unsigned one-word integer from an MP_INT.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1999 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_sub_ui (mpz_ptr w, mpz_srcptr u, unsigned long int v)
-#else
-mpz_sub_ui (w, u, v)
-     mpz_ptr w;
-     mpz_srcptr u;
-     unsigned long int v;
-#endif
-{
-  mp_srcptr up;
-  mp_ptr wp;
-  mp_size_t usize, wsize;
-  mp_size_t abs_usize;
-
-  usize = u->_mp_size;
-  abs_usize = ABS (usize);
-
-  /* If not space for W (and possible carry), increase space.  */
-  wsize = abs_usize + 1;
-  if (w->_mp_alloc < wsize)
-    _mpz_realloc (w, wsize);
-
-  /* These must be after realloc (U may be the same as W).  */
-  up = u->_mp_d;
-  wp = w->_mp_d;
-
-  if (abs_usize == 0)
-    {
-      wp[0] = v;
-      w->_mp_size = -(v != 0);
-      return;
-    }
-
-  if (usize < 0)
-    {
-      mp_limb_t cy;
-      cy = mpn_add_1 (wp, up, abs_usize, (mp_limb_t) v);
-      wp[abs_usize] = cy;
-      wsize = -(abs_usize + cy);
-    }
-  else
-    {
-      /* The signs are different.  Need exact comparison to determine
-	 which operand to subtract from which.  */
-      if (abs_usize == 1 && up[0] < v)
-	{
-	  wp[0] = v - up[0];
-	  wsize = -1;
-	}
-      else
-	{
-	  mpn_sub_1 (wp, up, abs_usize, (mp_limb_t) v);
-	  /* Size can decrease with at most one limb.  */
-	  wsize = abs_usize - (wp[abs_usize - 1] == 0);
-	}
-    }
-
-  w->_mp_size = wsize;
-}
diff --git a/ghc/rts/gmp/mpz/swap.c b/ghc/rts/gmp/mpz/swap.c
deleted file mode 100644
index 0070d6ff24..0000000000
--- a/ghc/rts/gmp/mpz/swap.c
+++ /dev/null
@@ -1,52 +0,0 @@
-/* mpz_swap (dest_integer, src_integer) -- Swap U and V.
-
-Copyright (C) 1997, 1998 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_swap (mpz_ptr u, mpz_ptr v)
-#else
-mpz_swap (u, v)
-     mpz_ptr u;
-     mpz_ptr v;
-#endif
-{
-  mp_ptr up, vp;
-  mp_size_t usize, vsize;
-  mp_size_t ualloc, valloc;
-
-  ualloc = u->_mp_alloc;
-  valloc = v->_mp_alloc;
-  v->_mp_alloc = ualloc;
-  u->_mp_alloc = valloc;
-
-  usize = u->_mp_size;
-  vsize = v->_mp_size;
-  v->_mp_size = usize;
-  u->_mp_size = vsize;
-
-  up = u->_mp_d;
-  vp = v->_mp_d;
-  v->_mp_d = up;
-  u->_mp_d = vp;
-}
diff --git a/ghc/rts/gmp/mpz/tdiv_q.c b/ghc/rts/gmp/mpz/tdiv_q.c
deleted file mode 100644
index 21db4ab385..0000000000
--- a/ghc/rts/gmp/mpz/tdiv_q.c
+++ /dev/null
@@ -1,91 +0,0 @@
-/* mpz_tdiv_q -- divide two integers and produce a quotient.
-
-Copyright (C) 1991, 1993, 1994, 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-void
-#if __STDC__
-mpz_tdiv_q (mpz_ptr quot, mpz_srcptr num, mpz_srcptr den)
-#else
-mpz_tdiv_q (quot, num, den)
-     mpz_ptr quot;
-     mpz_srcptr num;
-     mpz_srcptr den;
-#endif
-{
-  mp_size_t ql;
-  mp_size_t ns, ds, nl, dl;
-  mp_ptr np, dp, qp, rp;
-  TMP_DECL (marker);
-
-  ns = SIZ (num);
-  ds = SIZ (den);
-  nl = ABS (ns);
-  dl = ABS (ds);
-  ql = nl - dl + 1;
-
-  if (dl == 0)
-    DIVIDE_BY_ZERO;
-
-  if (ql <= 0)
-    {
-      SIZ (quot) = 0;
-      return;
-    }
-
-  MPZ_REALLOC (quot, ql);
-
-  TMP_MARK (marker);
-  qp = PTR (quot);
-  rp = (mp_ptr) TMP_ALLOC (dl * BYTES_PER_MP_LIMB);
-  np = PTR (num);
-  dp = PTR (den);
-
-  /* FIXME: We should think about how to handle the temporary allocation.
-     Perhaps mpn_tdiv_qr should handle it, since it anyway often needs to
-     allocate temp space.  */
-
-  /* Copy denominator to temporary space if it overlaps with the quotient.  */
-  if (dp == qp)
-    {
-      mp_ptr tp;
-      tp = (mp_ptr) TMP_ALLOC (dl * BYTES_PER_MP_LIMB);
-      MPN_COPY (tp, dp, dl);
-      dp = tp;
-    }
-  /* Copy numerator to temporary space if it overlaps with the quotient.  */
-  if (np == qp)
-    {
-      mp_ptr tp;
-      tp = (mp_ptr) TMP_ALLOC (nl * BYTES_PER_MP_LIMB);
-      MPN_COPY (tp, np, nl);
-      np = tp;
-    }
-
-  mpn_tdiv_qr (qp, rp, 0L, np, nl, dp, dl);
-
-  ql -=  qp[ql - 1] == 0;
-
-  SIZ (quot) = (ns ^ ds) >= 0 ? ql : -ql;
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/tdiv_q_2exp.c b/ghc/rts/gmp/mpz/tdiv_q_2exp.c
deleted file mode 100644
index 03d1e01f89..0000000000
--- a/ghc/rts/gmp/mpz/tdiv_q_2exp.c
+++ /dev/null
@@ -1,68 +0,0 @@
-/* mpz_tdiv_q_2exp -- Divide an integer by 2**CNT.  Round the quotient
-   towards -infinity.
-
-Copyright (C) 1991, 1993, 1994, 1996 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_tdiv_q_2exp (mpz_ptr w, mpz_srcptr u, unsigned long int cnt)
-#else
-mpz_tdiv_q_2exp (w, u, cnt)
-     mpz_ptr w;
-     mpz_srcptr u;
-     unsigned long int cnt;
-#endif
-{
-  mp_size_t usize, wsize;
-  mp_size_t limb_cnt;
-
-  usize = u->_mp_size;
-  limb_cnt = cnt / BITS_PER_MP_LIMB;
-  wsize = ABS (usize) - limb_cnt;
-  if (wsize <= 0)
-    w->_mp_size = 0;
-  else
-    {
-      mp_ptr wp;
-      mp_srcptr up;
-
-      if (w->_mp_alloc < wsize)
-	_mpz_realloc (w, wsize);
-
-      wp = w->_mp_d;
-      up = u->_mp_d;
-
-      cnt %= BITS_PER_MP_LIMB;
-      if (cnt != 0)
-	{
-	  mpn_rshift (wp, up + limb_cnt, wsize, cnt);
-	  wsize -= wp[wsize - 1] == 0;
-	}
-      else
-	{
-	  MPN_COPY_INCR (wp, up + limb_cnt, wsize);
-	}
-
-      w->_mp_size = usize >= 0 ? wsize : -wsize;
-    }
-}
diff --git a/ghc/rts/gmp/mpz/tdiv_q_ui.c b/ghc/rts/gmp/mpz/tdiv_q_ui.c
deleted file mode 100644
index a2e3462b76..0000000000
--- a/ghc/rts/gmp/mpz/tdiv_q_ui.c
+++ /dev/null
@@ -1,64 +0,0 @@
-/* mpz_tdiv_q_ui(quot, dividend, divisor_limb)
-   -- Divide DIVIDEND by DIVISOR_LIMB and store the result in QUOT.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1998 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_tdiv_q_ui (mpz_ptr quot, mpz_srcptr dividend, unsigned long int divisor)
-#else
-mpz_tdiv_q_ui (quot, dividend, divisor)
-     mpz_ptr quot;
-     mpz_srcptr dividend;
-     unsigned long int divisor;
-#endif
-{
-  mp_size_t dividend_size;
-  mp_size_t size;
-  mp_ptr quot_ptr;
-  mp_limb_t remainder_limb;
-
-  if (divisor == 0)
-    DIVIDE_BY_ZERO;
-
-  dividend_size = dividend->_mp_size;
-  size = ABS (dividend_size);
-
-  /* No need for temporary allocation and copying if QUOT == DIVIDEND as
-     the divisor is just one limb, and thus no intermediate remainders
-     need to be stored.  */
-
-  if (quot->_mp_alloc < size)
-    _mpz_realloc (quot, size);
-
-  quot_ptr = quot->_mp_d;
-
-  remainder_limb
-    = mpn_divmod_1 (quot_ptr, dividend->_mp_d, size, (mp_limb_t) divisor);
-
-  /* The quotient is SIZE limbs, but the most significant might be zero. */
-  size -= size != 0 && quot_ptr[size - 1] == 0;
-  quot->_mp_size = dividend_size >= 0 ? size : -size;
-
-  return remainder_limb;
-}
diff --git a/ghc/rts/gmp/mpz/tdiv_qr.c b/ghc/rts/gmp/mpz/tdiv_qr.c
deleted file mode 100644
index d66f57d9e5..0000000000
--- a/ghc/rts/gmp/mpz/tdiv_qr.c
+++ /dev/null
@@ -1,130 +0,0 @@
-/* mpz_tdiv_qr(quot,rem,dividend,divisor) -- Set QUOT to DIVIDEND/DIVISOR,
-   and REM to DIVIDEND mod DIVISOR.
-
-Copyright (C) 1991, 1993, 1994, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-#ifdef BERKELEY_MP
-#include "mp.h"
-#endif
-
-
-#ifndef BERKELEY_MP
-
-void
-#if __STDC__
-mpz_tdiv_qr (mpz_ptr quot, mpz_ptr rem, mpz_srcptr num, mpz_srcptr den)
-#else
-mpz_tdiv_qr (quot, rem, num, den)
-     mpz_ptr quot;
-     mpz_ptr rem;
-     mpz_srcptr num;
-     mpz_srcptr den;
-#endif
-
-#else /* BERKELEY_MP */
-
-void
-#if __STDC__
-mdiv (mpz_srcptr num, mpz_srcptr den, mpz_ptr quot, mpz_ptr rem)
-#else
-mdiv (num, den, quot, rem)
-     mpz_srcptr num;
-     mpz_srcptr den;
-     mpz_ptr    quot;
-     mpz_ptr    rem;
-#endif
-
-#endif /* BERKELEY_MP */
-{
-  mp_size_t ql;
-  mp_size_t ns, ds, nl, dl;
-  mp_ptr np, dp, qp, rp;
-  TMP_DECL (marker);
-
-  ns = SIZ (num);
-  ds = SIZ (den);
-  nl = ABS (ns);
-  dl = ABS (ds);
-  ql = nl - dl + 1;
-
-  if (dl == 0)
-    DIVIDE_BY_ZERO;
-
-  MPZ_REALLOC (rem, dl);
-
-  if (ql <= 0)
-    {
-      if (num != rem)
-	{
-	  mp_ptr np, rp;
-	  np = PTR (num);
-	  rp = PTR (rem);
-	  MPN_COPY (rp, np, nl);
-	  SIZ (rem) = SIZ (num);
-	}
-      /* This needs to follow the assignment to rem, in case the
-	 numerator and quotient are the same.  */
-      SIZ (quot) = 0;
-      return;
-    }
-
-  MPZ_REALLOC (quot, ql);
-
-  TMP_MARK (marker);
-  qp = PTR (quot);
-  rp = PTR (rem);
-  np = PTR (num);
-  dp = PTR (den);
-
-  /* FIXME: We should think about how to handle the temporary allocation.
-     Perhaps mpn_tdiv_qr should handle it, since it anyway often needs to
-     allocate temp space.  */
-
-  /* Copy denominator to temporary space if it overlaps with the quotient
-     or remainder.  */
-  if (dp == rp || dp == qp)
-    {
-      mp_ptr tp;
-      tp = (mp_ptr) TMP_ALLOC (dl * BYTES_PER_MP_LIMB);
-      MPN_COPY (tp, dp, dl);
-      dp = tp;
-    }
-  /* Copy numerator to temporary space if it overlaps with the quotient or
-     remainder.  */
-  if (np == rp || np == qp)
-    {
-      mp_ptr tp;
-      tp = (mp_ptr) TMP_ALLOC (nl * BYTES_PER_MP_LIMB);
-      MPN_COPY (tp, np, nl);
-      np = tp;
-    }
-
-  mpn_tdiv_qr (qp, rp, 0L, np, nl, dp, dl);
-
-  ql -=  qp[ql - 1] == 0;
-  MPN_NORMALIZE (rp, dl);
-
-  SIZ (quot) = (ns ^ ds) >= 0 ? ql : -ql;
-  SIZ (rem) = ns >= 0 ? dl : -dl;
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/tdiv_qr_ui.c b/ghc/rts/gmp/mpz/tdiv_qr_ui.c
deleted file mode 100644
index 10368cd340..0000000000
--- a/ghc/rts/gmp/mpz/tdiv_qr_ui.c
+++ /dev/null
@@ -1,76 +0,0 @@
-/* mpz_tdiv_qr_ui(quot,rem,dividend,short_divisor) --
-   Set QUOT to DIVIDEND / SHORT_DIVISOR
-   and REM to DIVIDEND mod SHORT_DIVISOR.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1998 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_tdiv_qr_ui (mpz_ptr quot, mpz_ptr rem, mpz_srcptr dividend, unsigned long int divisor)
-#else
-mpz_tdiv_qr_ui (quot, rem, dividend, divisor)
-     mpz_ptr quot;
-     mpz_ptr rem;
-     mpz_srcptr dividend;
-     unsigned long int divisor;
-#endif
-{
-  mp_size_t dividend_size;
-  mp_size_t size;
-  mp_ptr quot_ptr;
-  mp_limb_t remainder_limb;
-
-  if (divisor == 0)
-    DIVIDE_BY_ZERO;
-
-  dividend_size = dividend->_mp_size;
-  size = ABS (dividend_size);
-
-  /* No need for temporary allocation and copying if QUOT == DIVIDEND as
-     the divisor is just one limb, and thus no intermediate remainders
-     need to be stored.  */
-
-  if (quot->_mp_alloc < size)
-    _mpz_realloc (quot, size);
-
-  quot_ptr = quot->_mp_d;
-
-  remainder_limb = mpn_divmod_1 (quot_ptr, dividend->_mp_d, size,
-				 (mp_limb_t) divisor);
-
-  if (remainder_limb == 0)
-    rem->_mp_size = 0;
-  else
-    {
-      /* Store the single-limb remainder.  We don't check if there's space
-	 for just one limb, since no function ever makes zero space.  */
-      rem->_mp_size = dividend_size >= 0 ? 1 : -1;
-      rem->_mp_d[0] = remainder_limb;
-    }
-
-  /* The quotient is SIZE limbs, but the most significant might be zero. */
-  size -= size != 0 && quot_ptr[size - 1] == 0;
-  quot->_mp_size = dividend_size >= 0 ? size : -size;
-
-  return remainder_limb;
-}
diff --git a/ghc/rts/gmp/mpz/tdiv_r.c b/ghc/rts/gmp/mpz/tdiv_r.c
deleted file mode 100644
index 9eb87dfabf..0000000000
--- a/ghc/rts/gmp/mpz/tdiv_r.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/* mpz_tdiv_r(rem, dividend, divisor) -- Set REM to DIVIDEND mod DIVISOR.
-
-Copyright (C) 1991, 1993, 1994, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-void
-#if __STDC__
-mpz_tdiv_r (mpz_ptr rem, mpz_srcptr num, mpz_srcptr den)
-#else
-mpz_tdiv_r (rem, num, den)
-     mpz_ptr rem;
-     mpz_srcptr num;
-     mpz_srcptr den;
-#endif
-{
-  mp_size_t ql;
-  mp_size_t ns, ds, nl, dl;
-  mp_ptr np, dp, qp, rp;
-  TMP_DECL (marker);
-
-  ns = SIZ (num);
-  ds = SIZ (den);
-  nl = ABS (ns);
-  dl = ABS (ds);
-  ql = nl - dl + 1;
-
-  if (dl == 0)
-    DIVIDE_BY_ZERO;
-
-  MPZ_REALLOC (rem, dl);
-
-  if (ql <= 0)
-    {
-      if (num != rem)
-	{
-	  mp_ptr np, rp;
-	  np = PTR (num);
-	  rp = PTR (rem);
-	  MPN_COPY (rp, np, nl);
-	  SIZ (rem) = SIZ (num);
-	}
-      return;
-    }
-
-  TMP_MARK (marker);
-  qp = (mp_ptr) TMP_ALLOC (ql * BYTES_PER_MP_LIMB);
-  rp = PTR (rem);
-  np = PTR (num);
-  dp = PTR (den);
-
-  /* FIXME: We should think about how to handle the temporary allocation.
-     Perhaps mpn_tdiv_qr should handle it, since it anyway often needs to
-     allocate temp space.  */
-
-  /* Copy denominator to temporary space if it overlaps with the remainder.  */
-  if (dp == rp)
-    {
-      mp_ptr tp;
-      tp = (mp_ptr) TMP_ALLOC (dl * BYTES_PER_MP_LIMB);
-      MPN_COPY (tp, dp, dl);
-      dp = tp;
-    }
-  /* Copy numerator to temporary space if it overlaps with the remainder.  */
-  if (np == rp)
-    {
-      mp_ptr tp;
-      tp = (mp_ptr) TMP_ALLOC (nl * BYTES_PER_MP_LIMB);
-      MPN_COPY (tp, np, nl);
-      np = tp;
-    }
-
-  mpn_tdiv_qr (qp, rp, 0L, np, nl, dp, dl);
-
-  MPN_NORMALIZE (rp, dl);
-
-  SIZ (rem) = ns >= 0 ? dl : -dl;
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/tdiv_r_2exp.c b/ghc/rts/gmp/mpz/tdiv_r_2exp.c
deleted file mode 100644
index 91de170f5c..0000000000
--- a/ghc/rts/gmp/mpz/tdiv_r_2exp.c
+++ /dev/null
@@ -1,79 +0,0 @@
-/* mpz_tdiv_r_2exp -- Divide a integer by 2**CNT and produce a remainder.
-
-Copyright (C) 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_tdiv_r_2exp (mpz_ptr res, mpz_srcptr in, unsigned long int cnt)
-#else
-mpz_tdiv_r_2exp (res, in, cnt)
-     mpz_ptr res;
-     mpz_srcptr in;
-     unsigned long int cnt;
-#endif
-{
-  mp_size_t in_size = ABS (in->_mp_size);
-  mp_size_t res_size;
-  mp_size_t limb_cnt = cnt / BITS_PER_MP_LIMB;
-  mp_srcptr in_ptr = in->_mp_d;
-
-  if (in_size > limb_cnt)
-    {
-      /* The input operand is (probably) greater than 2**CNT.  */
-      mp_limb_t x;
-
-      x = in_ptr[limb_cnt] & (((mp_limb_t) 1 << cnt % BITS_PER_MP_LIMB) - 1);
-      if (x != 0)
-	{
-	  res_size = limb_cnt + 1;
-	  if (res->_mp_alloc < res_size)
-	    _mpz_realloc (res, res_size);
-
-	  res->_mp_d[limb_cnt] = x;
-	}
-      else
-	{
-	  res_size = limb_cnt;
-	  MPN_NORMALIZE (in_ptr, res_size);
-
-	  if (res->_mp_alloc < res_size)
-	    _mpz_realloc (res, res_size);
-
-	  limb_cnt = res_size;
-	}
-    }
-  else
-    {
-      /* The input operand is smaller than 2**CNT.  We perform a no-op,
-	 apart from that we might need to copy IN to RES.  */
-      res_size = in_size;
-      if (res->_mp_alloc < res_size)
-	_mpz_realloc (res, res_size);
-
-      limb_cnt = res_size;
-    }
-
-  if (res != in)
-    MPN_COPY (res->_mp_d, in->_mp_d, limb_cnt);
-  res->_mp_size = in->_mp_size >= 0 ? res_size : -res_size;
-}
diff --git a/ghc/rts/gmp/mpz/tdiv_r_ui.c b/ghc/rts/gmp/mpz/tdiv_r_ui.c
deleted file mode 100644
index 2ea411fda1..0000000000
--- a/ghc/rts/gmp/mpz/tdiv_r_ui.c
+++ /dev/null
@@ -1,63 +0,0 @@
-/* mpz_tdiv_r_ui(rem, dividend, divisor_limb)
-   -- Set REM to DIVDEND mod DIVISOR_LIMB.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1998 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_tdiv_r_ui (mpz_ptr rem, mpz_srcptr dividend, unsigned long int divisor)
-#else
-mpz_tdiv_r_ui (rem, dividend, divisor)
-     mpz_ptr rem;
-     mpz_srcptr dividend;
-     unsigned long int divisor;
-#endif
-{
-  mp_size_t dividend_size;
-  mp_size_t size;
-  mp_limb_t remainder_limb;
-
-  if (divisor == 0)
-    DIVIDE_BY_ZERO;
-
-  dividend_size = dividend->_mp_size;
-  size = ABS (dividend_size);
-
-  /* No need for temporary allocation and copying if QUOT == DIVIDEND as
-     the divisor is just one limb, and thus no intermediate remainders
-     need to be stored.  */
-
-  remainder_limb = mpn_mod_1 (dividend->_mp_d, size, (mp_limb_t) divisor);
-
-  if (remainder_limb == 0)
-    rem->_mp_size = 0;
-  else
-    {
-      /* Store the single-limb remainder.  We don't check if there's space
-	 for just one limb, since no function ever makes zero space.  */
-      rem->_mp_size = dividend_size >= 0 ? 1 : -1;
-      rem->_mp_d[0] = remainder_limb;
-    }
-
-  return remainder_limb;
-}
diff --git a/ghc/rts/gmp/mpz/tdiv_ui.c b/ghc/rts/gmp/mpz/tdiv_ui.c
deleted file mode 100644
index 7a40a6a7f7..0000000000
--- a/ghc/rts/gmp/mpz/tdiv_ui.c
+++ /dev/null
@@ -1,53 +0,0 @@
-/* mpz_tdiv_ui(dividend, divisor_limb)
-   -- Return DIVDEND mod DIVISOR_LIMB.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 1998 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-unsigned long int
-#if __STDC__
-mpz_tdiv_ui (mpz_srcptr dividend, unsigned long int divisor)
-#else
-mpz_tdiv_ui (dividend, divisor)
-     mpz_srcptr dividend;
-     unsigned long int divisor;
-#endif
-{
-  mp_size_t dividend_size;
-  mp_size_t size;
-  mp_limb_t remainder_limb;
-
-  if (divisor == 0)
-    DIVIDE_BY_ZERO;
-
-  dividend_size = dividend->_mp_size;
-  size = ABS (dividend_size);
-
-  /* No need for temporary allocation and copying if QUOT == DIVIDEND as
-     the divisor is just one limb, and thus no intermediate remainders
-     need to be stored.  */
-
-  remainder_limb = mpn_mod_1 (dividend->_mp_d, size, (mp_limb_t) divisor);
-
-  return remainder_limb;
-}
diff --git a/ghc/rts/gmp/mpz/tstbit.c b/ghc/rts/gmp/mpz/tstbit.c
deleted file mode 100644
index b0a8b0b31a..0000000000
--- a/ghc/rts/gmp/mpz/tstbit.c
+++ /dev/null
@@ -1,70 +0,0 @@
-/* mpz_tstbit -- test a specified bit.  Simulate 2's complement representation.
-
-Copyright (C) 1997 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-int
-#if __STDC__
-mpz_tstbit (mpz_srcptr d, unsigned long int bit_index)
-#else
-mpz_tstbit (d, bit_index)
-     mpz_srcptr d;
-     unsigned long int bit_index;
-#endif
-{
-  mp_size_t dsize = d->_mp_size;
-  mp_ptr dp = d->_mp_d;
-  mp_size_t limb_index;
-
-  limb_index = bit_index / BITS_PER_MP_LIMB;
-  if (dsize >= 0)
-    {
-      if (limb_index < dsize)
-	return (dp[limb_index] >> (bit_index % BITS_PER_MP_LIMB)) & 1;
-      else
-	/* Testing a bit outside of a positive number.  */
-	return 0;
-    }
-  else
-    {
-      mp_size_t zero_bound;
-
-      dsize = -dsize;
-
-      /* Locate the least significant non-zero limb.  */
-      for (zero_bound = 0; dp[zero_bound] == 0; zero_bound++)
-	;
-
-      if (limb_index > zero_bound)
-	{
-	  if (limb_index < dsize)
-	    return (~dp[limb_index] >> (bit_index % BITS_PER_MP_LIMB)) & 1;
-	  else
-	    /* Testing a bit outside of a negative number.  */
-	    return 1;
-	}
-      else if (limb_index == zero_bound)
-	return (-dp[limb_index] >> (bit_index % BITS_PER_MP_LIMB)) & 1;
-      else
-	return 0;
-    }
-}
diff --git a/ghc/rts/gmp/mpz/ui_pow_ui.c b/ghc/rts/gmp/mpz/ui_pow_ui.c
deleted file mode 100644
index edd2dee625..0000000000
--- a/ghc/rts/gmp/mpz/ui_pow_ui.c
+++ /dev/null
@@ -1,139 +0,0 @@
-/* mpz_ui_pow_ui(res, base, exp) -- Set RES to BASE**EXP.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-
-static void mpz_pow2 _PROTO ((mpz_ptr r, mp_limb_t blimb, unsigned long int e, mp_limb_t rl));
-
-void
-#if __STDC__
-mpz_ui_pow_ui (mpz_ptr r, unsigned long int b, unsigned long int e)
-#else
-mpz_ui_pow_ui (r, b, e)
-     mpz_ptr r;
-     unsigned long int b;
-     unsigned long int e;
-#endif
-{
-  mp_limb_t blimb = b;
-  mp_limb_t rl;
-
-  if (e == 0)
-    {
-      /* For x^0 we return 1, even if x is 0.  */
-      r->_mp_d[0] = 1;
-      r->_mp_size = 1;
-      return;
-    }
-
-  /* Compute b^e as (b^n)^(e div n) * b^(e mod n), where n is chosen such that
-     the latter factor is the largest number small enough to fit in a limb.  */
-
-  rl = 1;
-  while (e != 0 && blimb < ((mp_limb_t) 1 << BITS_PER_MP_LIMB/2))
-    {
-      if ((e & 1) != 0)
-	rl = rl * blimb;
-      blimb = blimb * blimb;
-      e = e >> 1;
-    }
-
-  /* rl is now b^(e mod n).  (I.e., the latter factor above.)  */
-
-  if (e == 0)
-    {
-      r->_mp_d[0] = rl;
-      r->_mp_size = rl != 0;
-      return;
-    }
-
-  mpz_pow2 (r, blimb, e, rl);
-}
-
-/* Multi-precision part of expontialization code.  */
-static void
-#if __STDC__
-mpz_pow2 (mpz_ptr r, mp_limb_t blimb, unsigned long int e, mp_limb_t rl)
-#else
-mpz_pow2 (r, blimb, e, rl)
-     mpz_ptr r;
-     mp_limb_t blimb;
-     unsigned long int e;
-     mp_limb_t rl;
-#endif
-{
-  mp_ptr rp, tp;
-  mp_size_t ralloc, rsize;
-  int cnt, i;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-
-  /* Over-estimate temporary space requirements somewhat.  */
-  count_leading_zeros (cnt, blimb);
-  ralloc = e - cnt * e / BITS_PER_MP_LIMB + 1;
-
-  /* The two areas are used to alternatingly hold the input and receive the
-     product for mpn_mul.  (Needed since mpn_mul_n requires that the product
-     is distinct from either input operand.)  */
-  rp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
-  tp = (mp_ptr) TMP_ALLOC (ralloc * BYTES_PER_MP_LIMB);
-
-  rp[0] = blimb;
-  rsize = 1;
-
-  count_leading_zeros (cnt, e);
-  for (i = BITS_PER_MP_LIMB - cnt - 2; i >= 0; i--)
-    {
-      mpn_mul_n (tp, rp, rp, rsize);
-      rsize = 2 * rsize;
-      rsize -= tp[rsize - 1] == 0;
-      MP_PTR_SWAP (rp, tp);
-
-      if ((e & ((mp_limb_t) 1 << i)) != 0)
-	{
-	  mp_limb_t cy;
-	  cy = mpn_mul_1 (rp, rp, rsize, blimb);
-	  rp[rsize] = cy;
-	  rsize += cy != 0;
-	}
-    }
-
-  /* We will need rsize or rsize+1 limbs for the result.  */
-  if (r->_mp_alloc <= rsize)
-    _mpz_realloc (r, rsize + 1);
-
-  /* Multiply the two factors (in rp,rsize and rl) and put the final result
-     in place.  */
-  {
-    mp_limb_t cy;
-    cy = mpn_mul_1 (r->_mp_d, rp, rsize, rl);
-    (r->_mp_d)[rsize] = cy;
-    rsize += cy != 0;
-  }
-
-  r->_mp_size = rsize;
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/urandomb.c b/ghc/rts/gmp/mpz/urandomb.c
deleted file mode 100644
index caca086e05..0000000000
--- a/ghc/rts/gmp/mpz/urandomb.c
+++ /dev/null
@@ -1,49 +0,0 @@
-/* mpz_urandomb (rop, state, n) -- Generate a uniform pseudorandom
-   integer in the range 0 to 2^N - 1, inclusive, using STATE as the
-   random state previously initialized by a call to gmp_randinit().
-
-Copyright (C) 1999, 2000  Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_urandomb (mpz_t rop, gmp_randstate_t rstate, unsigned long int nbits)
-#else
-mpz_urandomb (rop, rstate, nbits)
-     mpz_t rop;
-     gmp_randstate_t rstate;
-     unsigned long int nbits;
-#endif
-{
-  mp_ptr rp;
-  mp_size_t size;
-
-  size = (nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
-  if (ALLOC (rop) < size)
-    _mpz_realloc (rop, size);
-
-  rp = PTR (rop);
-
-  _gmp_rand (rp, rstate, nbits);
-  MPN_NORMALIZE (rp, size);
-  SIZ (rop) = size;
-}
diff --git a/ghc/rts/gmp/mpz/urandomm.c b/ghc/rts/gmp/mpz/urandomm.c
deleted file mode 100644
index 69e1bae78a..0000000000
--- a/ghc/rts/gmp/mpz/urandomm.c
+++ /dev/null
@@ -1,78 +0,0 @@
-/* mpz_urandomm (rop, state, n) -- Generate a uniform pseudorandom
-   integer in the range 0 to N-1, using STATE as the random state
-   previously initialized by a call to gmp_randinit().
-
-Copyright (C) 2000  Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-void
-#if __STDC__
-mpz_urandomm (mpz_t rop, gmp_randstate_t rstate, mpz_t n)
-#else
-mpz_urandomm (rop, rstate, n)
-     mpz_t rop;
-     gmp_randstate_t rstate;
-     mpz_t n;
-#endif
-{
-  mpz_t t, p, m;
-  mp_ptr tp;
-  mp_size_t nbits, size;
-  int count;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-
-  /* FIXME: Should check for n == 0 and report error */
-
-  size = SIZ (n);
-  count_leading_zeros (count, PTR (n)[size - 1]);
-  nbits = size * BITS_PER_MP_LIMB - count;
-
-  /* Allocate enough for any mpz function called since a realloc of
-     these will fail.  */
-  MPZ_TMP_INIT (t, size);
-  MPZ_TMP_INIT (m, size + 1);
-  MPZ_TMP_INIT (p, size + 1);
-
-  /* Let m = highest possible random number plus 1.  */
-  mpz_set_ui (m, 0);
-  mpz_setbit (m, nbits);
-
-  /* Let p = floor(m / n) * n.  */
-  mpz_fdiv_q (p, m, n);
-  mpz_mul (p, p, n);
-
-  tp = PTR (t);
-  do
-    {
-      _gmp_rand (tp, rstate, nbits);
-      MPN_NORMALIZE (tp, size);	/* FIXME: Really necessary?  */
-      SIZ (t) = size;
-    }
-  while (mpz_cmp (t, p) >= 0);
-
-  mpz_mod (rop, t, n);
-
-  TMP_FREE (marker);
-}
diff --git a/ghc/rts/gmp/mpz/xor.c b/ghc/rts/gmp/mpz/xor.c
deleted file mode 100644
index 69898d1791..0000000000
--- a/ghc/rts/gmp/mpz/xor.c
+++ /dev/null
@@ -1,217 +0,0 @@
-/* mpz_xor -- Logical xor.
-
-Copyright (C) 1991, 1993, 1994, 1996, 1997, 2000 Free Software Foundation,
-Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-mpz_xor (mpz_ptr res, mpz_srcptr op1, mpz_srcptr op2)
-#else
-mpz_xor (res, op1, op2)
-     mpz_ptr res;
-     mpz_srcptr op1;
-     mpz_srcptr op2;
-#endif
-{
-  mp_srcptr op1_ptr, op2_ptr;
-  mp_size_t op1_size, op2_size;
-  mp_ptr res_ptr;
-  mp_size_t res_size, res_alloc;
-  mp_size_t i;
-  TMP_DECL (marker);
-
-  TMP_MARK (marker);
-  op1_size = op1->_mp_size;
-  op2_size = op2->_mp_size;
-
-  op1_ptr = op1->_mp_d;
-  op2_ptr = op2->_mp_d;
-  res_ptr = res->_mp_d;
-
-  if (op1_size >= 0)
-    {
-      if (op2_size >= 0)
-	{
-	  if (op1_size >= op2_size)
-	    {
-	      if (res->_mp_alloc < op1_size)
-		{
-		  _mpz_realloc (res, op1_size);
-		  op1_ptr = op1->_mp_d;
-		  op2_ptr = op2->_mp_d;
-		  res_ptr = res->_mp_d;
-		}
-
-	      if (res_ptr != op1_ptr)
-		MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size,
-			  op1_size - op2_size);
-	      for (i = op2_size - 1; i >= 0; i--)
-		res_ptr[i] = op1_ptr[i] ^ op2_ptr[i];
-	      res_size = op1_size;
-	    }
-	  else
-	    {
-	      if (res->_mp_alloc < op2_size)
-		{
-		  _mpz_realloc (res, op2_size);
-		  op1_ptr = op1->_mp_d;
-		  op2_ptr = op2->_mp_d;
-		  res_ptr = res->_mp_d;
-		}
-
-	      if (res_ptr != op2_ptr)
-		MPN_COPY (res_ptr + op1_size, op2_ptr + op1_size,
-			  op2_size - op1_size);
-	      for (i = op1_size - 1; i >= 0; i--)
-		res_ptr[i] = op1_ptr[i] ^ op2_ptr[i];
-	      res_size = op2_size;
-	    }
-
-	  MPN_NORMALIZE (res_ptr, res_size);
-	  res->_mp_size = res_size;
-	  return;
-	}
-      else /* op2_size < 0 */
-	{
-	  /* Fall through to the code at the end of the function.  */
-	}
-    }
-  else
-    {
-      if (op2_size < 0)
-	{
-	  mp_ptr opx;
-	  mp_limb_t cy;
-
-	  /* Both operands are negative, the result will be positive.
-	      (-OP1) ^ (-OP2) =
-	     = ~(OP1 - 1) ^ ~(OP2 - 1) =
-	     = (OP1 - 1) ^ (OP2 - 1)  */
-
-	  op1_size = -op1_size;
-	  op2_size = -op2_size;
-
-	  /* Possible optimization: Decrease mpn_sub precision,
-	     as we won't use the entire res of both.  */
-	  opx = (mp_ptr) TMP_ALLOC (op1_size * BYTES_PER_MP_LIMB);
-	  mpn_sub_1 (opx, op1_ptr, op1_size, (mp_limb_t) 1);
-	  op1_ptr = opx;
-
-	  opx = (mp_ptr) TMP_ALLOC (op2_size * BYTES_PER_MP_LIMB);
-	  mpn_sub_1 (opx, op2_ptr, op2_size, (mp_limb_t) 1);
-	  op2_ptr = opx;
-
-	  res_alloc = MAX (op1_size, op2_size);
-	  if (res->_mp_alloc < res_alloc)
-	    {
-	      _mpz_realloc (res, res_alloc);
-	      res_ptr = res->_mp_d;
-	      /* Don't re-read OP1_PTR and OP2_PTR.  They point to
-		 temporary space--never to the space RES->_mp_d used
-		 to point to before reallocation.  */
-	    }
-
-	  if (op1_size > op2_size)
-	    {
-	      MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size,
-			op1_size - op2_size);
-	      for (i = op2_size - 1; i >= 0; i--)
-		res_ptr[i] = op1_ptr[i] ^ op2_ptr[i];
-	      res_size = op1_size;
-	    }
-	  else
-	    {
-	      MPN_COPY (res_ptr + op1_size, op2_ptr + op1_size,
-			op2_size - op1_size);
-	      for (i = op1_size - 1; i >= 0; i--)
-		res_ptr[i] = op1_ptr[i] ^ op2_ptr[i];
-	      res_size = op2_size;
-	    }
-
-	  MPN_NORMALIZE (res_ptr, res_size);
-	  res->_mp_size = res_size;
-	  TMP_FREE (marker);
-	  return;
-	}
-      else
-	{
-	  /* We should compute -OP1 ^ OP2.  Swap OP1 and OP2 and fall
-	     through to the code that handles OP1 ^ -OP2.  */
-          MPZ_SRCPTR_SWAP (op1, op2);
-          MPN_SRCPTR_SWAP (op1_ptr,op1_size, op2_ptr,op2_size);
-	}
-    }
-
-  {
-    mp_ptr opx;
-    mp_limb_t cy;
-    mp_size_t count;
-
-    /* Operand 2 negative, so will be the result.
-       -(OP1 ^ (-OP2)) = -(OP1 ^ ~(OP2 - 1)) =
-       = ~(OP1 ^ ~(OP2 - 1)) + 1 =
-       = (OP1 ^ (OP2 - 1)) + 1      */
-
-    op2_size = -op2_size;
-
-    opx = (mp_ptr) TMP_ALLOC (op2_size * BYTES_PER_MP_LIMB);
-    mpn_sub_1 (opx, op2_ptr, op2_size, (mp_limb_t) 1);
-    op2_ptr = opx;
-
-    res_alloc = MAX (op1_size, op2_size) + 1;
-    if (res->_mp_alloc < res_alloc)
-      {
-	_mpz_realloc (res, res_alloc);
-	op1_ptr = op1->_mp_d;
-	res_ptr = res->_mp_d;
-	/* Don't re-read OP2_PTR.  It points to temporary space--never
-	   to the space RES->_mp_d used to point to before reallocation.  */
-      }
-
-    if (op1_size > op2_size)
-      {
-	MPN_COPY (res_ptr + op2_size, op1_ptr + op2_size, op1_size - op2_size);
-	for (i = op2_size - 1; i >= 0; i--)
-	  res_ptr[i] = op1_ptr[i] ^ op2_ptr[i];
-	res_size = op1_size;
-      }
-    else
-      {
-	MPN_COPY (res_ptr + op1_size, op2_ptr + op1_size, op2_size - op1_size);
-	for (i = op1_size - 1; i >= 0; i--)
-	  res_ptr[i] = op1_ptr[i] ^ op2_ptr[i];
-	res_size = op2_size;
-      }
-
-    cy = mpn_add_1 (res_ptr, res_ptr, res_size, (mp_limb_t) 1);
-    if (cy)
-      {
-	res_ptr[res_size] = cy;
-	res_size++;
-      }
-
-    MPN_NORMALIZE (res_ptr, res_size);
-    res->_mp_size = -res_size;
-    TMP_FREE (marker);
-  }
-}
diff --git a/ghc/rts/gmp/rand.c b/ghc/rts/gmp/rand.c
deleted file mode 100644
index d1f9354511..0000000000
--- a/ghc/rts/gmp/rand.c
+++ /dev/null
@@ -1,171 +0,0 @@
-/* gmp_randinit (state, algorithm, ...) -- Initialize a random state.
-
-Copyright (C) 1999, 2000  Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include <stdio.h> /* for NULL */
-#if __STDC__
-# include <stdarg.h>
-#else
-# include <varargs.h>
-#endif
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-/* Array of CL-schemes, ordered in increasing order of the first
-   member (the 'm2exp' value).  The end of the array is indicated with
-   an entry containing all zeros.  */
-
-/* All multipliers are in the range 0.01*m and 0.99*m, and are
-congruent to 5 (mod 8).
-They all pass the spectral test with Vt >= 2^(30/t) and merit >= 1.
-(Up to and including 196 bits, merit is >= 3.)  */
-
-struct __gmp_rand_lc_scheme_struct
-{
-  unsigned long int m2exp;	/* Modulus is 2 ^ m2exp. */
-  char *astr;			/* Multiplier in string form. */
-  unsigned long int c;		/* Adder. */
-};
-
-struct __gmp_rand_lc_scheme_struct __gmp_rand_lc_scheme[] =
-{
-  {32, "43840821", 	     1},
-  {33, "85943917", 	     1},
-  {34, "171799469", 	     1},
-  {35, "343825285", 	     1},
-  {36, "687285701", 	     1},
-  {37, "1374564613", 	     1},
-  {38, "2749193437", 	     1},
-  {39, "5497652029", 	     1},
-  {40, "10995212661", 	     1},
-  {56, "47988680294711517",  1},
-  {64, "13469374875402548381", 1},
-  {100, "203786806069096950756900463357", 1},	
-  {128, "96573135900076068624591706046897650309", 1},
-  {156, "43051576988660538262511726153887323360449035333", 1},
-  {196, "1611627857640767981443524165616850972435303571524033586421", 1},
-  {200, "491824250216153841876046962368396460896019632211283945747141", 1},
-  {256, "79336254595106925775099152154558630917988041692672147726148065355845551082677", 1},
-  {0, NULL, 0}			/* End of array. */
-};
-
-void
-#if __STDC__
-gmp_randinit (gmp_randstate_t rstate,
-	      gmp_randalg_t alg,
-	      ...)
-#else
-gmp_randinit (va_alist)
-     va_dcl
-#endif
-{
-  va_list ap;
-#if __STDC__
-#else
-  __gmp_randstate_struct *rstate;
-  gmp_randalg_t alg;
-#endif
-
-#if __STDC__
-  va_start (ap, alg);
-#else
-  va_start (ap);
-
-  rstate = va_arg (ap, __gmp_randstate_struct *);
-  alg = va_arg (ap, gmp_randalg_t);
-#endif
-
-  switch (alg)
-    {
-    case GMP_RAND_ALG_LC:	/* Linear congruential.  */
-      {
-	unsigned long int size;
-	struct __gmp_rand_lc_scheme_struct *sp;
-	mpz_t a;
-
-	size = va_arg (ap, unsigned long int);
-
-	/* Pick a scheme.  */
-	for (sp = __gmp_rand_lc_scheme; sp->m2exp != 0; sp++)
-	  if (sp->m2exp / 2 >= size)
-	    break;
-
-	if (sp->m2exp == 0)	/* Nothing big enough found.  */
-	  {
-	    gmp_errno |= GMP_ERROR_INVALID_ARGUMENT;
-	    return;
-	  }
-
-	/* Install scheme.  */
-	mpz_init_set_str (a, sp->astr, 0);
-	gmp_randinit_lc_2exp (rstate, a, sp->c, sp->m2exp);
-	mpz_clear (a);
-	break;
-      }
-
-#if 0
-    case GMP_RAND_ALG_BBS:	/* Blum, Blum, and Shub. */
-      {				
-	mpz_t p, q;
-	mpz_t ztmp;
-
-	/* FIXME: Generate p and q.  They must be ``large'' primes,
-           congruent to 3 mod 4.  Should we ensure that they meet some
-           of the criterias for being ``hard primes''?*/
-
-	/* These are around 128 bits. */
-	mpz_init_set_str (p, "148028650191182616877187862194899201391", 10); 
-	mpz_init_set_str (q, "315270837425234199477225845240496832591", 10);
-	
-	/* Allocate algorithm specific data. */
-	rstate->data.bbs = (__gmp_rand_data_bbs *)
-	  (*_mp_allocate_func) (sizeof (__gmp_rand_data_bbs));
-
-	mpz_init (rstate->data.bbs->bi); /* The Blum integer. */
-	mpz_mul (rstate->data.bbs->bi, p, q);
-
-	/* Find a seed, x, with gcd (x, bi) == 1. */
-	mpz_init (ztmp);
-	while (1)
-	  {
-	    mpz_gcd (ztmp, seed, rstate->data.bbs->bi);
-	    if (!mpz_cmp_ui (ztmp, 1))
-	      break;
-	    mpz_add_ui (seed, seed, 1);
-	  }
-
-	rstate->alg = alg;
-	rstate->size = size;		/* FIXME: Remove. */
-	mpz_set (rstate->seed, seed);
-
-	mpz_clear (p);
-	mpz_clear (q);
-	mpz_clear (ztmp);
-	break;
-      }
-#endif /* 0 */
-
-    default:			/* Bad choice. */
-      gmp_errno |= GMP_ERROR_UNSUPPORTED_ARGUMENT;
-    }
-
-  va_end (ap);
-}
diff --git a/ghc/rts/gmp/randclr.c b/ghc/rts/gmp/randclr.c
deleted file mode 100644
index 5cb0291165..0000000000
--- a/ghc/rts/gmp/randclr.c
+++ /dev/null
@@ -1,54 +0,0 @@
-/* gmp_randclear (state) -- Clear and deallocate random state STATE.
-
-Copyright (C) 1999, 2000  Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-gmp_randclear (gmp_randstate_t rstate)
-#else
-gmp_randclear (rstate)
-     gmp_randstate_t rstate;
-#endif
-{
-  mpz_clear (rstate->seed);
-
-  switch (rstate->alg)
-    {
-    case GMP_RAND_ALG_LC:
-      mpz_clear (rstate->algdata.lc->a);
-      if (rstate->algdata.lc->m2exp == 0)
-	mpz_clear (rstate->algdata.lc->m);
-      (*_mp_free_func) (rstate->algdata.lc, sizeof (*rstate->algdata.lc));
-      break;
-
-#if 0
-    case GMP_RAND_ALG_BBS:
-      mpz_clear (rstate->algdata.bbs->bi);
-      (*_mp_free_func) (rstate->algdata.bbs, sizeof (*rstate->algdata.bbs));
-      break;
-#endif /* 0 */
-
-    default:
-      gmp_errno |= GMP_ERROR_UNSUPPORTED_ARGUMENT;
-    }
-}
diff --git a/ghc/rts/gmp/randlc.c b/ghc/rts/gmp/randlc.c
deleted file mode 100644
index 7079db827e..0000000000
--- a/ghc/rts/gmp/randlc.c
+++ /dev/null
@@ -1,56 +0,0 @@
-/* gmp_randinit_lc (state, a, c, m) -- Initialize a random state for a
-   linear congruential generator with multiplier A, adder C, and
-   modulus M.
-
-Copyright (C) 1999, 2000  Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-gmp_randinit_lc (gmp_randstate_t rstate,
-		 mpz_t a,
-		 unsigned long int c,
-		 mpz_t m)
-#else
-gmp_randinit_lc (rstate, a, c, m)
-     gmp_randstate_t rstate;
-     mpz_t a;
-     unsigned long int c;
-     mpz_t m;
-#endif
-{
-  /* FIXME: Not finished.  We don't handle this in _gmp_rand() yet. */
-  abort ();			
-
-  mpz_init_set_ui (rstate->seed, 1);
-  _mpz_realloc (rstate->seed, ABSIZ (m));
-
-  /* Allocate algorithm specific data. */
-  rstate->algdata.lc = (__gmp_randata_lc *)
-    (*_mp_allocate_func) (sizeof (__gmp_randata_lc));
-
-  mpz_init_set (rstate->algdata.lc->a, a);
-  rstate->algdata.lc->c = c;
-  mpz_init_set (rstate->algdata.lc->m, m);
-
-  rstate->alg = GMP_RAND_ALG_LC;
-}
diff --git a/ghc/rts/gmp/randlc2x.c b/ghc/rts/gmp/randlc2x.c
deleted file mode 100644
index dbd5f041ee..0000000000
--- a/ghc/rts/gmp/randlc2x.c
+++ /dev/null
@@ -1,59 +0,0 @@
-/* gmp_randinit_lc_2exp (state, a, c, m2exp) -- Initialize random
-   state STATE for a linear congruential generator with multiplier A,
-   adder C, and modulus 2 ^ M2EXP.
-
-Copyright (C) 2000  Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-gmp_randinit_lc_2exp (gmp_randstate_t rstate,
-		      mpz_t a,
-		      unsigned long int c,
-		      unsigned long int m2exp)
-#else
-gmp_randinit_lc_2exp (rstate, a, c, m2exp)
-     gmp_randstate_t rstate;
-     mpz_t a;
-     unsigned long int c;
-     unsigned long int m2exp;
-#endif
-{
-  mpz_init_set_ui (rstate->seed, 1);
-  _mpz_realloc (rstate->seed, m2exp / BITS_PER_MP_LIMB
-		+ (m2exp % BITS_PER_MP_LIMB != 0));
-
-  /* Allocate algorithm specific data. */
-  rstate->algdata.lc = (__gmp_randata_lc *)
-    (*_mp_allocate_func) (sizeof (__gmp_randata_lc));
-
-  mpz_init_set (rstate->algdata.lc->a, a);
-  rstate->algdata.lc->c = c;
-
-  /* Cover weird case where m2exp is 0, which means that m is used
-     instead of m2exp.  */
-  if (m2exp == 0)
-    mpz_init_set_ui (rstate->algdata.lc->m, 0);
-  rstate->algdata.lc->m2exp = m2exp;
-
-  rstate->alg = GMP_RAND_ALG_LC;
-}
diff --git a/ghc/rts/gmp/randraw.c b/ghc/rts/gmp/randraw.c
deleted file mode 100644
index c0c3889d33..0000000000
--- a/ghc/rts/gmp/randraw.c
+++ /dev/null
@@ -1,360 +0,0 @@
-/* _gmp_rand (rp, state, nbits) -- Generate a random bitstream of
-   length NBITS in RP.  RP must have enough space allocated to hold
-   NBITS.
-
-Copyright (C) 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-#include "longlong.h"
-
-/* For linear congruential (LC), we use one of algorithms (1) or (2).
-   (gmp-3.0 uses algorithm (1) with 'm' as a power of 2.)
-
-LC algorithm (1).
-
-	X = (aX + c) mod m
-
-[D. Knuth, "The Art of Computer Programming: Volume 2, Seminumerical Algorithms",
-Third Edition, Addison Wesley, 1998, pp. 184-185.]
-
-	X is the seed and the result
-	a is chosen so that
-	    a mod 8 = 5 [3.2.1.2] and [3.2.1.3]
-	    .01m < a < .99m
-	    its binary or decimal digits is not a simple, regular pattern
-	    it has no large quotients when Euclid's algorithm is used to find
-	      gcd(a, m) [3.3.3]
-	    it passes the spectral test [3.3.4]
-	    it passes several tests of [3.3.2]
-	c has no factor in common with m (c=1 or c=a can be good)
-	m is large (2^30)
-	  is a power of 2 [3.2.1.1]
-
-The least significant digits of the generated number are not very
-random.  It should be regarded as a random fraction X/m.  To get a
-random integer between 0 and n-1, multiply X/m by n and truncate.
-(Don't use X/n [ex 3.4.1-3])
-
-The ``accuracy'' in t dimensions is one part in ``the t'th root of m'' [3.3.4].
-
-Don't generate more than about m/1000 numbers without changing a, c, or m.
-
-The sequence length depends on chosen a,c,m.
-
-
-LC algorithm (2).
-
-	X = a * (X mod q) - r * (long) (X/q)
-	if X<0 then X+=m
-
-[Knuth, pp. 185-186.]
-
-	X is the seed and the result
-	  as a seed is nonzero and less than m
-	a is a primitive root of m (which means that a^2 <= m)
-	q is (long) m / a
-	r is m mod a
-	m is a prime number near the largest easily computed integer
-
-which gives
-
-	X = a * (X % ((long) m / a)) -
-	    (M % a) * ((long) (X / ((long) m / a)))
-
-Since m is prime, the least-significant bits of X are just as random as
-the most-significant bits. */
-
-/* Blum, Blum, and Shub.
-
-   [Bruce Schneier, "Applied Cryptography", Second Edition, John Wiley
-   & Sons, Inc., 1996, pp. 417-418.]
-
-   "Find two large prime numbers, p and q, which are congruent to 3
-   modulo 4.  The product of those numbers, n, is a blum integer.
-   Choose another random integer, x, which is relatively prime to n.
-   Compute
-	x[0] = x^2 mod n
-   That's the seed for the generator."
-
-   To generate a random bit, compute
-	x[i] = x[i-1]^2 mod n
-   The least significant bit of x[i] is the one we want.
-
-   We can use more than one bit from x[i], namely the
-	log2(bitlength of x[i])
-   least significant bits of x[i].
-
-   So, for a 32-bit seed we get 5 bits per computation.
-
-   The non-predictability of this generator is based on the difficulty
-   of factoring n.
- */
-
-/* -------------------------------------------------- */
-
-/* lc (rp, state) -- Generate next number in LC sequence.  Return the
-   number of valid bits in the result.  NOTE: If 'm' is a power of 2
-   (m2exp != 0), discard the lower half of the result.  */
-
-static
-unsigned long int
-#if __STDC__
-lc (mp_ptr rp, gmp_randstate_t rstate)
-#else
-lc (rp, rstate)
-     mp_ptr rp;
-     gmp_randstate_t rstate;
-#endif
-{
-  mp_ptr tp, seedp, ap;
-  mp_size_t ta;
-  mp_size_t tn, seedn, an;
-  mp_size_t retval;
-  int shiftcount = 0;
-  unsigned long int m2exp;
-  mp_limb_t c;
-  TMP_DECL (mark);
-
-  m2exp = rstate->algdata.lc->m2exp;
-  c = (mp_limb_t) rstate->algdata.lc->c;
-
-  seedp = PTR (rstate->seed);
-  seedn = SIZ (rstate->seed);
-
-  if (seedn == 0)
-    {
-      /* Seed is 0.  Result is C % M.  */
-      *rp = c;
-
-      if (m2exp != 0)
-	{
-	  /* M is a power of 2.  */
-	  if (m2exp < BITS_PER_MP_LIMB)
-	    {
-	      /* Only necessary when M may be smaller than C.  */
-	      *rp &= (((mp_limb_t) 1 << m2exp) - 1);
-	    }
-	}
-      else
-	{
-	  /* M is not a power of 2.  */
-	  abort ();		/* FIXME.  */
-	}
-
-      /* Save result as next seed.  */
-      *seedp = *rp;
-      SIZ (rstate->seed) = 1;
-      return BITS_PER_MP_LIMB;
-    }
-
-  ap = PTR (rstate->algdata.lc->a);
-  an = SIZ (rstate->algdata.lc->a);
-
-  /* Allocate temporary storage.  Let there be room for calculation of
-     (A * seed + C) % M, or M if bigger than that.  */
-
-  ASSERT_ALWAYS (m2exp != 0);	/* FIXME.  */
-
-  TMP_MARK (mark);
-  ta = an + seedn + 1;
-  tp = (mp_ptr) TMP_ALLOC (ta * BYTES_PER_MP_LIMB);
-  MPN_ZERO (tp, ta);
-
-  /* t = a * seed */
-  if (seedn >= an)
-    mpn_mul_basecase (tp, seedp, seedn, ap, an);
-  else
-    mpn_mul_basecase (tp, ap, an, seedp, seedn);
-  tn = an + seedn;
-
-  /* t = t + c */
-  mpn_incr_u (tp, c);
-
-  /* t = t % m */
-  if (m2exp != 0)
-    {
-      /* M is a power of 2.  The mod operation is trivial.  */
-
-      tp[m2exp / BITS_PER_MP_LIMB] &= ((mp_limb_t) 1 << m2exp % BITS_PER_MP_LIMB) - 1;
-      tn = (m2exp + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
-    }
-  else
-    {
-      abort ();			/* FIXME.  */
-    }
-
-  /* Save result as next seed.  */
-  MPN_COPY (PTR (rstate->seed), tp, tn);
-  SIZ (rstate->seed) = tn;
-
-  if (m2exp != 0)
-    {
-      /* Discard the lower half of the result.  */
-      unsigned long int discardb = m2exp / 2;
-      mp_size_t discardl = discardb / BITS_PER_MP_LIMB;
-
-      tn -= discardl;
-      if (tn > 0)
-	{
-	  if (discardb % BITS_PER_MP_LIMB != 0)
-	    {
-	      mpn_rshift (tp, tp + discardl, tn, discardb % BITS_PER_MP_LIMB);
-	      MPN_COPY (rp, tp, (discardb + BITS_PER_MP_LIMB -1) / BITS_PER_MP_LIMB);
-	    }
-	  else			/* Even limb boundary.  */
-	    MPN_COPY_INCR (rp, tp + discardl, tn);
-	}
-    }
-  else
-    {
-      MPN_COPY (rp, tp, tn);
-    }
-
-  TMP_FREE (mark);
-
-  /* Return number of valid bits in the result.  */
-  if (m2exp != 0)
-    retval = (m2exp + 1) / 2;
-  else
-    retval = SIZ (rstate->algdata.lc->m) * BITS_PER_MP_LIMB - shiftcount;
-  return retval;
-}
-
-#ifdef RAWRANDEBUG
-/* Set even bits to EVENBITS and odd bits to ! EVENBITS in RP.
-   Number of bits is m2exp in state.  */
-/* FIXME: Remove.  */
-unsigned long int
-lc_test (mp_ptr rp, gmp_randstate_t s, const int evenbits)
-{
-  unsigned long int rn, nbits;
-  int f;
-
-  nbits = s->algdata.lc->m2exp / 2;
-  rn = nbits / BITS_PER_MP_LIMB + (nbits % BITS_PER_MP_LIMB != 0);
-  MPN_ZERO (rp, rn);
-
-  for (f = 0; f < nbits; f++)
-    {
-      mpn_lshift (rp, rp, rn, 1);
-      if (f % 2 == ! evenbits)
-	rp[0] += 1;
-    }
-
-  return nbits;
-}
-#endif /* RAWRANDEBUG */
-
-void
-#if __STDC__
-_gmp_rand (mp_ptr rp, gmp_randstate_t rstate, unsigned long int nbits)
-#else
-_gmp_rand (rp, rstate, nbits)
-     mp_ptr rp;
-     gmp_randstate_t rstate;
-     unsigned long int nbits;
-#endif
-{
-  mp_size_t rn;			/* Size of R.  */
-
-  rn = (nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
-
-  switch (rstate->alg)
-    {
-    case GMP_RAND_ALG_LC:
-      {
-	unsigned long int rbitpos;
-	int chunk_nbits;
-	mp_ptr tp;
-	mp_size_t tn;
-	TMP_DECL (lcmark);
-
-	TMP_MARK (lcmark);
-
-	chunk_nbits = rstate->algdata.lc->m2exp / 2;
-	tn = (chunk_nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
-
-	tp = (mp_ptr) TMP_ALLOC (tn * BYTES_PER_MP_LIMB);
-
-	rbitpos = 0;
-	while (rbitpos + chunk_nbits <= nbits)
-	  {
-	    mp_ptr r2p = rp + rbitpos / BITS_PER_MP_LIMB;
-
-	    if (rbitpos % BITS_PER_MP_LIMB != 0)
-	      {
-		mp_limb_t savelimb, rcy;
-		/* Target of of new chunk is not bit aligned.  Use temp space
-		   and align things by shifting it up.  */
-		lc (tp, rstate);
-		savelimb = r2p[0];
-		rcy = mpn_lshift (r2p, tp, tn, rbitpos % BITS_PER_MP_LIMB);
-		r2p[0] |= savelimb;
-/* bogus */	if ((chunk_nbits % BITS_PER_MP_LIMB + rbitpos % BITS_PER_MP_LIMB)
-		    > BITS_PER_MP_LIMB)
-		  r2p[tn] = rcy;
-	      }
-	    else
-	      {
-		/* Target of of new chunk is bit aligned.  Let `lc' put bits
-		   directly into our target variable.  */
-		lc (r2p, rstate);
-	      }
-	    rbitpos += chunk_nbits;
-	  }
-
-	/* Handle last [0..chunk_nbits) bits.  */
-	if (rbitpos != nbits)
-	  {
-	    mp_ptr r2p = rp + rbitpos / BITS_PER_MP_LIMB;
-	    int last_nbits = nbits - rbitpos;
-	    tn = (last_nbits + BITS_PER_MP_LIMB - 1) / BITS_PER_MP_LIMB;
-	    lc (tp, rstate);
-	    if (rbitpos % BITS_PER_MP_LIMB != 0)
-	      {
-		mp_limb_t savelimb, rcy;
-		/* Target of of new chunk is not bit aligned.  Use temp space
-		   and align things by shifting it up.  */
-		savelimb = r2p[0];
-		rcy = mpn_lshift (r2p, tp, tn, rbitpos % BITS_PER_MP_LIMB);
-		r2p[0] |= savelimb;
-		if (rbitpos + tn * BITS_PER_MP_LIMB - rbitpos % BITS_PER_MP_LIMB < nbits)
-		  r2p[tn] = rcy;
-	      }
-	    else
-	      {
-		MPN_COPY (r2p, tp, tn);
-	      }
-	    /* Mask off top bits if needed.  */
-	    if (nbits % BITS_PER_MP_LIMB != 0)
-	      rp[nbits / BITS_PER_MP_LIMB]
-		&= ~ ((~(mp_limb_t) 0) << nbits % BITS_PER_MP_LIMB);
-	  }
-
-	TMP_FREE (lcmark);
-	break;
-      }
-
-    default:
-      gmp_errno |= GMP_ERROR_UNSUPPORTED_ARGUMENT;
-      break;
-    }
-}
diff --git a/ghc/rts/gmp/randsd.c b/ghc/rts/gmp/randsd.c
deleted file mode 100644
index 3bed14b578..0000000000
--- a/ghc/rts/gmp/randsd.c
+++ /dev/null
@@ -1,37 +0,0 @@
-/* gmp_randseed (state, seed) -- Set initial seed SEED in random state
-   STATE.
-
-Copyright (C) 2000  Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-gmp_randseed (gmp_randstate_t rstate,
-	      mpz_t seed)
-#else
-gmp_randseed (rstate, seed)
-     gmp_randstate_t rstate;
-     mpz_t seed;
-#endif
-{
-  mpz_set (rstate->seed, seed);
-}
diff --git a/ghc/rts/gmp/randsdui.c b/ghc/rts/gmp/randsdui.c
deleted file mode 100644
index 92f412f3ea..0000000000
--- a/ghc/rts/gmp/randsdui.c
+++ /dev/null
@@ -1,37 +0,0 @@
-/* gmp_randseed_ui (state, seed) -- Set initial seed SEED in random
-   state STATE.
-
-Copyright (C) 2000  Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-void
-#if __STDC__
-gmp_randseed_ui (gmp_randstate_t rstate,
-		  unsigned long int seed)
-#else
-gmp_randseed_ui (rstate, seed)
-     gmp_randstate_t rstate;
-     mpz_t seed;
-#endif
-{
-  mpz_set_ui (rstate->seed, seed);
-}
diff --git a/ghc/rts/gmp/stack-alloc.c b/ghc/rts/gmp/stack-alloc.c
deleted file mode 100644
index 9ab98fe5f9..0000000000
--- a/ghc/rts/gmp/stack-alloc.c
+++ /dev/null
@@ -1,136 +0,0 @@
-/* Stack allocation routines.  This is intended for machines without support
-   for the `alloca' function.
-
-Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#include "stack-alloc.h"
-
-#define __need_size_t
-#include <stddef.h>
-#undef __need_size_t
-
-/* gmp-impl.h and stack-alloc.h conflict when not USE_STACK_ALLOC, so these
-   declarations are copied here */
-#if __STDC__
-extern void *	(*__gmp_allocate_func) (size_t);
-extern void	(*__gmp_free_func) (void *, size_t);
-#else
-extern void *	(*__gmp_allocate_func) ();
-extern void	(*__gmp_free_func) ();
-#endif
-
-typedef struct tmp_stack tmp_stack;
-
-static unsigned long max_total_allocation = 0;
-static unsigned long current_total_allocation = 0;
-
-static tmp_stack xxx = {&xxx, &xxx, 0};
-static tmp_stack *current = &xxx;
-
-/* The rounded size of the header of each allocation block.  */
-#define HSIZ ((sizeof (tmp_stack) + __TMP_ALIGN - 1) & -__TMP_ALIGN)
-
-/* Allocate a block of exactly <size> bytes.  This should only be called
-   through the TMP_ALLOC macro, which takes care of rounding/alignment.  */
-void *
-#if __STDC__
-__gmp_tmp_alloc (unsigned long size)
-#else
-__gmp_tmp_alloc (size)
-     unsigned long size;
-#endif
-{
-  void *that;
-
-  if (size > (char *) current->end - (char *) current->alloc_point)
-    {
-      void *chunk;
-      tmp_stack *header;
-      unsigned long chunk_size;
-      unsigned long now;
-
-      /* Allocate a chunk that makes the total current allocation somewhat
-	 larger than the maximum allocation ever.  If size is very large, we
-	 allocate that much.  */
-
-      now = current_total_allocation + size;
-      if (now > max_total_allocation)
-	{
-	  /* We need more temporary memory than ever before.  Increase
-	     for future needs.  */
-	  now = now * 3 / 2;
-	  chunk_size = now - current_total_allocation + HSIZ;
-	  current_total_allocation = now;
-	  max_total_allocation = current_total_allocation;
-	}
-      else
-	{
-	  chunk_size = max_total_allocation - current_total_allocation + HSIZ;
-	  current_total_allocation = max_total_allocation;
-	}
-
-      chunk = (*__gmp_allocate_func) (chunk_size);
-      header = (tmp_stack *) chunk;
-      header->end = (char *) chunk + chunk_size;
-      header->alloc_point = (char *) chunk + HSIZ;
-      header->prev = current;
-      current = header;
-    }
-
-  that = current->alloc_point;
-  current->alloc_point = (char *) that + size;
-  return that;
-}
-
-/* Typically called at function entry.  <mark> is assigned so that
-   __gmp_tmp_free can later be used to reclaim all subsequently allocated
-   storage.  */
-void
-#if __STDC__
-__gmp_tmp_mark (tmp_marker *mark)
-#else
-__gmp_tmp_mark (mark)
-     tmp_marker *mark;
-#endif
-{
-  mark->which_chunk = current;
-  mark->alloc_point = current->alloc_point;
-}
-
-/* Free everything allocated since <mark> was assigned by __gmp_tmp_mark */
-void
-#if __STDC__
-__gmp_tmp_free (tmp_marker *mark)
-#else
-__gmp_tmp_free (mark)
-     tmp_marker *mark;
-#endif
-{
-  while (mark->which_chunk != current)
-    {
-      tmp_stack *tmp;
-
-      tmp = current;
-      current = tmp->prev;
-      current_total_allocation -= (((char *) (tmp->end) - (char *) tmp) - HSIZ);
-      (*__gmp_free_func) (tmp, (char *) tmp->end - (char *) tmp);
-    }
-  current->alloc_point = mark->alloc_point;
-}
diff --git a/ghc/rts/gmp/stack-alloc.h b/ghc/rts/gmp/stack-alloc.h
deleted file mode 100644
index f59beec266..0000000000
--- a/ghc/rts/gmp/stack-alloc.h
+++ /dev/null
@@ -1,64 +0,0 @@
-/* Stack allocation routines.  This is intended for machines without support
-   for the `alloca' function.
-
-Copyright (C) 1996, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-struct tmp_stack
-{
-  void *end;
-  void *alloc_point;
-  struct tmp_stack *prev;
-};
-
-struct tmp_marker
-{
-  struct tmp_stack *which_chunk;
-  void *alloc_point;
-};
-
-typedef struct tmp_marker tmp_marker;
-
-#if defined (__cplusplus)
-extern "C" {
-#endif
-
-#if __STDC__
-void *__gmp_tmp_alloc (unsigned long);
-void __gmp_tmp_mark (tmp_marker *);
-void __gmp_tmp_free (tmp_marker *);
-#else
-void *__gmp_tmp_alloc ();
-void __gmp_tmp_mark ();
-void __gmp_tmp_free ();
-#endif
-
-#if defined (__cplusplus)
-}
-#endif
-
-#ifndef __TMP_ALIGN
-#define __TMP_ALIGN 8
-#endif
-
-#define TMP_DECL(marker) tmp_marker marker
-#define TMP_ALLOC(size) \
-  __gmp_tmp_alloc (((unsigned long) (size) + __TMP_ALIGN - 1) & -__TMP_ALIGN)
-#define TMP_MARK(marker) __gmp_tmp_mark (&marker)
-#define TMP_FREE(marker) __gmp_tmp_free (&marker)
diff --git a/ghc/rts/gmp/stamp-h.in b/ghc/rts/gmp/stamp-h.in
deleted file mode 100644
index 9788f70238..0000000000
--- a/ghc/rts/gmp/stamp-h.in
+++ /dev/null
@@ -1 +0,0 @@
-timestamp
diff --git a/ghc/rts/gmp/stamp-vti b/ghc/rts/gmp/stamp-vti
deleted file mode 100644
index e3186186b2..0000000000
--- a/ghc/rts/gmp/stamp-vti
+++ /dev/null
@@ -1,3 +0,0 @@
-@set UPDATED 5 October 2000
-@set EDITION 3.1.1
-@set VERSION 3.1.1
diff --git a/ghc/rts/gmp/urandom.h b/ghc/rts/gmp/urandom.h
deleted file mode 100644
index 313479e8b7..0000000000
--- a/ghc/rts/gmp/urandom.h
+++ /dev/null
@@ -1,86 +0,0 @@
-/* urandom.h -- define urandom returning a full unsigned long random value.
-
-Copyright (C) 1995, 1996, 1997, 2000 Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA. */
-
-#if defined (__hpux) || defined (__svr4__) || defined (__SVR4)
-/* HPUX lacks random().  */
-static inline mp_limb_t
-urandom ()
-{
-  return mrand48 ();
-}
-#define __URANDOM
-#endif
-
-#if defined(_WIN32) && !(defined(__CYGWIN__) || defined(__CYGWIN32__))
-/* MS CRT supplies just the poxy rand(), with an upper bound of 0x7fff */
-static inline unsigned long
-urandom ()
-{
-  return rand () ^ (rand () << 16) ^ (rand() << 32);
-}
-#define __URANDOM
-#endif
-
-#if defined (__alpha) && !defined (__URANDOM)
-/* DEC OSF/1 1.2 random() returns a double.  */
-long mrand48 ();
-static inline mp_limb_t
-urandom ()
-{
-  return mrand48 () | (mrand48 () << 32);
-}
-#define __URANDOM
-#endif
-
-#if BITS_PER_MP_LIMB == 32 && !defined (__URANDOM)
-#if defined (__cplusplus)
-extern "C" {
-#endif
-long random ();
-#if defined (__cplusplus)
-}
-#endif
-static inline mp_limb_t
-urandom ()
-{
-  /* random() returns 31 bits, we want 32.  */
-  return random () ^ (random () << 1);
-}
-#define __URANDOM
-#endif
-
-#if BITS_PER_MP_LIMB == 64 && !defined (__URANDOM)
-#if defined (__cplusplus)
-extern "C" {
-#endif
-long random ();
-#if defined (__cplusplus)
-}
-#endif
-static inline mp_limb_t
-urandom ()
-{
-  /* random() returns 31 bits, we want 64.  */
-  return random () ^ ((mp_limb_t) random () << 31) ^ ((mp_limb_t) random () << 62);
-}
-#define __URANDOM
-#endif
-
diff --git a/ghc/rts/gmp/version.c b/ghc/rts/gmp/version.c
deleted file mode 100644
index 9d544ee1d8..0000000000
--- a/ghc/rts/gmp/version.c
+++ /dev/null
@@ -1,26 +0,0 @@
-/* gmp_version -- version number compiled into the library */
-
-/*
-Copyright (C) 1996, 1999, 2000  Free Software Foundation, Inc.
-
-This file is part of the GNU MP Library.
-
-The GNU MP Library is free software; you can redistribute it and/or modify
-it under the terms of the GNU Lesser General Public License as published by
-the Free Software Foundation; either version 2.1 of the License, or (at your
-option) any later version.
-
-The GNU MP Library is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
-License for more details.
-
-You should have received a copy of the GNU Lesser General Public License
-along with the GNU MP Library; see the file COPYING.LIB.  If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
-MA 02111-1307, USA.  */
-
-#include "gmp.h"
-#include "gmp-impl.h"
-
-const char *gmp_version = VERSION;
diff --git a/ghc/rts/gmp/version.texi b/ghc/rts/gmp/version.texi
deleted file mode 100644
index e3186186b2..0000000000
--- a/ghc/rts/gmp/version.texi
+++ /dev/null
@@ -1,3 +0,0 @@
-@set UPDATED 5 October 2000
-@set EDITION 3.1.1
-@set VERSION 3.1.1
diff --git a/ghc/rts/hooks/FlagDefaults.c b/ghc/rts/hooks/FlagDefaults.c
deleted file mode 100644
index 393d39bc39..0000000000
--- a/ghc/rts/hooks/FlagDefaults.c
+++ /dev/null
@@ -1,20 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * User-overridable RTS hooks.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Rts.h"
-
-void
-defaultsHook (void)
-{ /* this is called *after* RTSflags has had
-     its defaults set, but *before* we start
-     processing the RTS command-line options.
-
-     This default version does *nothing*.
-     The user may provide a more interesting
-     one.
-  */
-}
-
diff --git a/ghc/rts/hooks/InitEachPE.c b/ghc/rts/hooks/InitEachPE.c
deleted file mode 100644
index cc9cdc0dba..0000000000
--- a/ghc/rts/hooks/InitEachPE.c
+++ /dev/null
@@ -1,23 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * User-overridable RTS hooks.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Rts.h"
-
-#ifdef PAR
-void
-InitEachPEHook (void)
-{ /* In a GUM setup this is called on each
-     PE immediately before SynchroniseSystem.
-     It can be used to read in static data 
-     to each PE which has to be available to
-     each PE. See GPH-Maple as an example how to
-     use this in combination with foreign language
-     code:
-       http://www.risc.uni-linz.ac.at/software/ghc-maple/
-     -- HWL
-  */
-}
-#endif
diff --git a/ghc/rts/hooks/MallocFail.c b/ghc/rts/hooks/MallocFail.c
deleted file mode 100644
index 1218d1d8d0..0000000000
--- a/ghc/rts/hooks/MallocFail.c
+++ /dev/null
@@ -1,16 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * User-overridable RTS hooks.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Rts.h"
-
-#include <stdio.h>
-
-void
-MallocFailHook (lnat request_size /* in bytes */, char *msg)
-{
-    fprintf(stderr, "malloc: failed on request for %lu bytes; message: %s\n", request_size, msg);
-}
-
diff --git a/ghc/rts/hooks/OnExit.c b/ghc/rts/hooks/OnExit.c
deleted file mode 100644
index dd4c3b4bb0..0000000000
--- a/ghc/rts/hooks/OnExit.c
+++ /dev/null
@@ -1,19 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * User-overridable RTS hooks.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Rts.h"
-
-/* Note: by the time this hook has been called, Haskell land
- * will have been shut down completely.
- *
- * ToDo: feed the hook info on whether we're shutting down as a result
- * of termination or run-time error ?
- */
- 
-void
-OnExitHook ()
-{
-}
diff --git a/ghc/rts/hooks/OutOfHeap.c b/ghc/rts/hooks/OutOfHeap.c
deleted file mode 100644
index 98db0d7d49..0000000000
--- a/ghc/rts/hooks/OutOfHeap.c
+++ /dev/null
@@ -1,19 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * User-overridable RTS hooks.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Rts.h"
-#include <stdio.h>
-
-void
-OutOfHeapHook (lnat request_size, lnat heap_size) /* both sizes in bytes */
-{
-  /*    fprintf(stderr, "Heap exhausted;\nwhile trying to allocate %lu bytes in a %lu-byte heap;\nuse `+RTS -H<size>' to increase the total heap size.\n", */
-
-  (void)request_size;   /* keep gcc -Wall happy */
-  fprintf(stderr, "Heap exhausted;\nCurrent maximum heap size is %lu bytes (%lu Mb);\nuse `+RTS -M<size>' to increase it.\n",
-	  heap_size, heap_size / (1024*1024));
-}
-
diff --git a/ghc/rts/hooks/RtsOpts.c b/ghc/rts/hooks/RtsOpts.c
deleted file mode 100644
index b934b05f1b..0000000000
--- a/ghc/rts/hooks/RtsOpts.c
+++ /dev/null
@@ -1,13 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * Default RTS options.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Rts.h"
-
-#include <stdlib.h>
-
-// Default RTS options can be given by providing an alternate
-// definition for this variable, pointing to a string of RTS options.
-char *ghc_rts_opts = NULL;
diff --git a/ghc/rts/hooks/ShutdownEachPEHook.c b/ghc/rts/hooks/ShutdownEachPEHook.c
deleted file mode 100644
index f5e3ba9344..0000000000
--- a/ghc/rts/hooks/ShutdownEachPEHook.c
+++ /dev/null
@@ -1,19 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * User-overridable RTS hooks.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Rts.h"
-
-#ifdef PAR
-void
-ShutdownEachPEHook (void)
-{ /* In a GUM setup this routine is called at the end of 
-     shutdownParallelSystem on each PE. Useful for
-     cleaning up stuff, especially when interfacing 
-     with foreign language code.
-     -- HWL 
-  */
-}
-#endif
diff --git a/ghc/rts/hooks/StackOverflow.c b/ghc/rts/hooks/StackOverflow.c
deleted file mode 100644
index a395a3a1a5..0000000000
--- a/ghc/rts/hooks/StackOverflow.c
+++ /dev/null
@@ -1,16 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * User-overridable RTS hooks.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Rts.h"
-
-#include <stdio.h>
-
-void
-StackOverflowHook (lnat stack_size)    /* in bytes */
-{
-    fprintf(stderr, "Stack space overflow: current size %ld bytes.\nUse `+RTS -Ksize' to increase it.\n", stack_size);
-}
-
diff --git a/ghc/rts/package.conf.in b/ghc/rts/package.conf.in
deleted file mode 100644
index 2550415e5a..0000000000
--- a/ghc/rts/package.conf.in
+++ /dev/null
@@ -1,152 +0,0 @@
-/* The RTS is just another package! */
-
-#include "ghcconfig.h"
-#include "RtsConfig.h"
-
-name:		PACKAGE
-version:	1.0
-license:	BSD3
-maintainer:	glasgow-haskell-users@haskell.org
-exposed:	True
-
-exposed-modules:
-hidden-modules:
-
-import-dirs:
-
-#ifdef INSTALLING
-library-dirs:		LIB_DIR
-# ifdef mingw32_HOST_OS
-			, LIB_DIR"/gcc-lib"
-			/* force the dist-provided gcc-lib/ into scope. */
-# endif
-#else /* !INSTALLING */
-library-dirs:		FPTOOLS_TOP_ABS"/ghc/rts"
-# if !defined(HAVE_LIBGMP) && !defined(HAVE_FRAMEWORK_GMP)
-			, FPTOOLS_TOP_ABS"/ghc/rts/gmp"
-# endif
-#endif
-
-hs-libraries:   "HSrts"
-
-extra-libraries:		"m"		/* for ldexp() */
-#ifndef HAVE_FRAMEWORK_GMP
-			      , "gmp"
-#ifdef HAVE_LIBDL
-			      , "dl"
-#endif
-#endif
-#ifdef HAVE_LIBRT
-			      , "rt"
-#endif
-#ifdef mingw32_HOST_OS
-			      ,"wsock32"	/* for the linker */
-#endif
-#ifdef WANT_DOTNET_SUPPORT
-			      , "oleaut32", "ole32", "uuid"
-#endif
-#if defined(DEBUG) && defined(HAVE_LIBBFD)
-			      ,"bfd", "iberty"	/* for debugging */
-#endif
-#ifdef HAVE_LIBMINGWEX
-# ifndef INSTALLING                             /* Bundled Mingw is behind */
-                              ,"mingwex"
-# endif
-#endif
-
-#ifdef INSTALLING
-include-dirs:		INCLUDE_DIR
-# ifdef mingw32_HOST_OS
-			, INCLUDE_DIR"/mingw"
-# endif
-#else /* !INSTALLING */
-include-dirs:		FPTOOLS_TOP_ABS"/ghc/includes"
-#endif
-
-includes:		Stg.h
-depends:	 	
-hugs-options:
-cc-options:
-
-ld-options:
-#ifdef LEADING_UNDERSCORE
-           "-u", "_GHCziBase_Izh_static_info"
-         , "-u", "_GHCziBase_Czh_static_info"
-         , "-u", "_GHCziFloat_Fzh_static_info"
-         , "-u", "_GHCziFloat_Dzh_static_info"
-         , "-u", "_GHCziPtr_Ptr_static_info"
-         , "-u", "_GHCziWord_Wzh_static_info"
-         , "-u", "_GHCziInt_I8zh_static_info"
-         , "-u", "_GHCziInt_I16zh_static_info"
-         , "-u", "_GHCziInt_I32zh_static_info"
-         , "-u", "_GHCziInt_I64zh_static_info"
-         , "-u", "_GHCziWord_W8zh_static_info"
-         , "-u", "_GHCziWord_W16zh_static_info"
-         , "-u", "_GHCziWord_W32zh_static_info"
-         , "-u", "_GHCziWord_W64zh_static_info"
-         , "-u", "_GHCziStable_StablePtr_static_info"
-         , "-u", "_GHCziBase_Izh_con_info"
-         , "-u", "_GHCziBase_Czh_con_info"
-         , "-u", "_GHCziFloat_Fzh_con_info"
-         , "-u", "_GHCziFloat_Dzh_con_info"
-         , "-u", "_GHCziPtr_Ptr_con_info"
-         , "-u", "_GHCziPtr_FunPtr_con_info"
-         , "-u", "_GHCziStable_StablePtr_con_info"
-         , "-u", "_GHCziBase_False_closure"
-         , "-u", "_GHCziBase_True_closure"
-         , "-u", "_GHCziPack_unpackCString_closure"
-         , "-u", "_GHCziIOBase_stackOverflow_closure"
-         , "-u", "_GHCziIOBase_heapOverflow_closure"
-         , "-u", "_GHCziIOBase_NonTermination_closure"
-         , "-u", "_GHCziIOBase_BlockedOnDeadMVar_closure"
-         , "-u", "_GHCziIOBase_BlockedIndefinitely_closure"
-         , "-u", "_GHCziIOBase_Deadlock_closure"
-         , "-u", "_GHCziIOBase_NestedAtomically_closure"
-         , "-u", "_GHCziWeak_runFinalizzerBatch_closure"
-#else
-           "-u", "GHCziBase_Izh_static_info"
-         , "-u", "GHCziBase_Czh_static_info"
-         , "-u", "GHCziFloat_Fzh_static_info"
-         , "-u", "GHCziFloat_Dzh_static_info"
-         , "-u", "GHCziPtr_Ptr_static_info"
-         , "-u", "GHCziWord_Wzh_static_info"
-         , "-u", "GHCziInt_I8zh_static_info"
-         , "-u", "GHCziInt_I16zh_static_info"
-         , "-u", "GHCziInt_I32zh_static_info"
-         , "-u", "GHCziInt_I64zh_static_info"
-         , "-u", "GHCziWord_W8zh_static_info"
-         , "-u", "GHCziWord_W16zh_static_info"
-         , "-u", "GHCziWord_W32zh_static_info"
-         , "-u", "GHCziWord_W64zh_static_info"
-         , "-u", "GHCziStable_StablePtr_static_info"
-         , "-u", "GHCziBase_Izh_con_info"
-         , "-u", "GHCziBase_Czh_con_info"
-         , "-u", "GHCziFloat_Fzh_con_info"
-         , "-u", "GHCziFloat_Dzh_con_info"
-         , "-u", "GHCziPtr_Ptr_con_info"
-         , "-u", "GHCziPtr_FunPtr_con_info"
-         , "-u", "GHCziStable_StablePtr_con_info"
-         , "-u", "GHCziBase_False_closure"
-         , "-u", "GHCziBase_True_closure"
-         , "-u", "GHCziPack_unpackCString_closure"
-         , "-u", "GHCziIOBase_stackOverflow_closure"
-         , "-u", "GHCziIOBase_heapOverflow_closure"
-         , "-u", "GHCziIOBase_NonTermination_closure"
-         , "-u", "GHCziIOBase_BlockedOnDeadMVar_closure"
-         , "-u", "GHCziIOBase_BlockedIndefinitely_closure"
-         , "-u", "GHCziIOBase_Deadlock_closure"
-         , "-u", "GHCziIOBase_NestedAtomically_closure"
-         , "-u", "GHCziWeak_runFinalizzerBatch_closure"
-#endif
-
-framework-dirs:
-
-#ifdef HAVE_FRAMEWORK_GMP
-frameworks:	"GMP"
-#else
-frameworks:
-#endif
-
-haddock-interfaces:
-haddock-html:
-
diff --git a/ghc/rts/parallel/0Hash.c b/ghc/rts/parallel/0Hash.c
deleted file mode 100644
index a471e30a66..0000000000
--- a/ghc/rts/parallel/0Hash.c
+++ /dev/null
@@ -1,320 +0,0 @@
-/*-----------------------------------------------------------------------------
- *
- * (c) The AQUA Project, Glasgow University, 1995-1998
- * (c) The GHC Team, 1999
- *
- * Dynamically expanding linear hash tables, as described in
- * Per-\AAke Larson, ``Dynamic Hash Tables,'' CACM 31(4), April 1988,
- * pp. 446 -- 457.
- * -------------------------------------------------------------------------- */
-
-/* 
-   Replaced with ghc/rts/Hash.c in the new RTS
-*/
-
-#if 0
-
-#include "Rts.h"
-#include "Hash.h"
-#include "RtsUtils.h"
-
-#define HSEGSIZE    1024    /* Size of a single hash table segment */
-			    /* Also the minimum size of a hash table */
-#define HDIRSIZE    1024    /* Size of the segment directory */
-			    /* Maximum hash table size is HSEGSIZE * HDIRSIZE */
-#define HLOAD	    5	    /* Maximum average load of a single hash bucket */
-
-#define HCHUNK	    (1024 * sizeof(W_) / sizeof(HashList))
-			    /* Number of HashList cells to allocate in one go */
-
-
-/* Linked list of (key, data) pairs for separate chaining */
-struct hashlist {
-    StgWord key;
-    void *data;
-    struct hashlist *next;  /* Next cell in bucket chain (same hash value) */
-};
-
-typedef struct hashlist HashList;
-
-struct hashtable {
-    int split;		    /* Next bucket to split when expanding */
-    int max;		    /* Max bucket of smaller table */
-    int mask1;		    /* Mask for doing the mod of h_1 (smaller table) */
-    int mask2;		    /* Mask for doing the mod of h_2 (larger table) */
-    int kcount;		    /* Number of keys */
-    int bcount;		    /* Number of buckets */
-    HashList **dir[HDIRSIZE];	/* Directory of segments */
-};
-
-/* -----------------------------------------------------------------------------
- * Hash first using the smaller table.  If the bucket is less than the
- * next bucket to be split, re-hash using the larger table.
- * -------------------------------------------------------------------------- */
-
-static int
-hash(HashTable *table, W_ key)
-{
-    int bucket;
-
-    /* Strip the boring zero bits */
-    key /= sizeof(StgWord);
-
-    /* Mod the size of the hash table (a power of 2) */
-    bucket = key & table->mask1;
-
-    if (bucket < table->split) {
-	/* Mod the size of the expanded hash table (also a power of 2) */
-	bucket = key & table->mask2;
-    }
-    return bucket;
-}
-
-/* -----------------------------------------------------------------------------
- * Allocate a new segment of the dynamically growing hash table.
- * -------------------------------------------------------------------------- */
-
-static void
-allocSegment(HashTable *table, int segment)
-{
-    table->dir[segment] = stgMallocBytes(HSEGSIZE * sizeof(HashList *), 
-					 "allocSegment");
-}
-
-
-/* -----------------------------------------------------------------------------
- * Expand the larger hash table by one bucket, and split one bucket
- * from the smaller table into two parts.  Only the bucket referenced
- * by @table->split@ is affected by the expansion.
- * -------------------------------------------------------------------------- */
-
-static void
-expand(HashTable *table)
-{
-    int oldsegment;
-    int oldindex;
-    int newbucket;
-    int newsegment;
-    int newindex;
-    HashList *hl;
-    HashList *next;
-    HashList *old, *new;
-
-    if (table->split + table->max >= HDIRSIZE * HSEGSIZE)
-	/* Wow!  That's big.  Too big, so don't expand. */
-	return;
-
-    /* Calculate indices of bucket to split */
-    oldsegment = table->split / HSEGSIZE;
-    oldindex = table->split % HSEGSIZE;
-
-    newbucket = table->max + table->split;
-
-    /* And the indices of the new bucket */
-    newsegment = newbucket / HSEGSIZE;
-    newindex = newbucket % HSEGSIZE;
-
-    if (newindex == 0)
-	allocSegment(table, newsegment);
-
-    if (++table->split == table->max) {
-	table->split = 0;
-	table->max *= 2;
-	table->mask1 = table->mask2;
-	table->mask2 = table->mask2 << 1 | 1;
-    }
-    table->bcount++;
-
-    /* Split the bucket, paying no attention to the original order */
-
-    old = new = NULL;
-    for (hl = table->dir[oldsegment][oldindex]; hl != NULL; hl = next) {
-	next = hl->next;
-	if (hash(table, hl->key) == newbucket) {
-	    hl->next = new;
-	    new = hl;
-	} else {
-	    hl->next = old;
-	    old = hl;
-	}
-    }
-    table->dir[oldsegment][oldindex] = old;
-    table->dir[newsegment][newindex] = new;
-
-    return;
-}
-
-void *
-lookupHashTable(HashTable *table, StgWord key)
-{
-    int bucket;
-    int segment;
-    int index;
-    HashList *hl;
-
-    bucket = hash(table, key);
-    segment = bucket / HSEGSIZE;
-    index = bucket % HSEGSIZE;
-
-    for (hl = table->dir[segment][index]; hl != NULL; hl = hl->next)
-	if (hl->key == key)
-	    return hl->data;
-
-    /* It's not there */
-    return NULL;
-}
-
-/* -----------------------------------------------------------------------------
- * We allocate the hashlist cells in large chunks to cut down on malloc
- * overhead.  Although we keep a free list of hashlist cells, we make
- * no effort to actually return the space to the malloc arena.
- * -------------------------------------------------------------------------- */
-
-static HashList *freeList = NULL;
-
-static HashList *
-allocHashList(void)
-{
-    HashList *hl, *p;
-
-    if ((hl = freeList) != NULL) {
-	freeList = hl->next;
-    } else {
-        hl = stgMallocBytes(HCHUNK * sizeof(HashList), "allocHashList");
-
-	freeList = hl + 1;
-	for (p = freeList; p < hl + HCHUNK - 1; p++)
-	    p->next = p + 1;
-	p->next = NULL;
-    }
-    return hl;
-}
-
-static void
-freeHashList(HashList *hl)
-{
-    hl->next = freeList;
-    freeList = hl;
-}
-
-void
-insertHashTable(HashTable *table, StgWord key, void *data)
-{
-    int bucket;
-    int segment;
-    int index;
-    HashList *hl;
-
-    /* We want no duplicates */
-    ASSERT(lookupHashTable(table, key) == NULL);
-    
-    /* When the average load gets too high, we expand the table */
-    if (++table->kcount >= HLOAD * table->bcount)
-	expand(table);
-
-    bucket = hash(table, key);
-    segment = bucket / HSEGSIZE;
-    index = bucket % HSEGSIZE;
-
-    hl = allocHashList();
-
-    hl->key = key;
-    hl->data = data;
-    hl->next = table->dir[segment][index];
-    table->dir[segment][index] = hl;
-
-}
-
-void *
-removeHashTable(HashTable *table, StgWord key, void *data)
-{
-    int bucket;
-    int segment;
-    int index;
-    HashList *hl;
-    HashList *prev = NULL;
-
-    bucket = hash(table, key);
-    segment = bucket / HSEGSIZE;
-    index = bucket % HSEGSIZE;
-
-    for (hl = table->dir[segment][index]; hl != NULL; hl = hl->next) {
-	if (hl->key == key && (data == NULL || hl->data == data)) {
-	    if (prev == NULL)
-		table->dir[segment][index] = hl->next;
-	    else
-		prev->next = hl->next;
-	    table->kcount--;
-	    return hl->data;
-	}
-	prev = hl;
-    }
-
-    /* It's not there */
-    ASSERT(data == NULL);
-    return NULL;
-}
-
-/* -----------------------------------------------------------------------------
- * When we free a hash table, we are also good enough to free the
- * data part of each (key, data) pair, as long as our caller can tell
- * us how to do it.
- * -------------------------------------------------------------------------- */
-
-void
-freeHashTable(HashTable *table, void (*freeDataFun)(void *) )
-{
-    long segment;
-    long index;
-    HashList *hl;
-    HashList *next;
-
-    /* The last bucket with something in it is table->max + table->split - 1 */
-    segment = (table->max + table->split - 1) / HSEGSIZE;
-    index = (table->max + table->split - 1) % HSEGSIZE;
-
-    while (segment >= 0) {
-	while (index >= 0) {
-	    for (hl = table->dir[segment][index]; hl != NULL; hl = next) {
-		next = hl->next;
-		if (freeDataFun != NULL)
-		    (*freeDataFun)(hl->data);
-		freeHashList(hl);
-	    }
-	    index--;
-	}
-	free(table->dir[segment]);
-	segment--;
-	index = HSEGSIZE - 1;
-    }
-    free(table);
-}
-
-/* -----------------------------------------------------------------------------
- * When we initialize a hash table, we set up the first segment as well,
- * initializing all of the first segment's hash buckets to NULL.
- * -------------------------------------------------------------------------- */
-
-HashTable *
-allocHashTable(void)
-{
-    HashTable *table;
-    HashList **hb;
-
-    table = stgMallocBytes(sizeof(HashTable),"allocHashTable");
-
-    allocSegment(table, 0);
-
-    for (hb = table->dir[0]; hb < table->dir[0] + HSEGSIZE; hb++)
-	*hb = NULL;
-
-    table->split = 0;
-    table->max = HSEGSIZE;
-    table->mask1 = HSEGSIZE - 1;
-    table->mask2 = 2 * HSEGSIZE - 1;
-    table->kcount = 0;
-    table->bcount = HSEGSIZE;
-
-    return table;
-}
-#endif
diff --git a/ghc/rts/parallel/0Parallel.h b/ghc/rts/parallel/0Parallel.h
deleted file mode 100644
index d52bf00fc2..0000000000
--- a/ghc/rts/parallel/0Parallel.h
+++ /dev/null
@@ -1,414 +0,0 @@
-/*
-  Time-stamp: <Mon Oct 04 1999 14:50:28 Stardate: [-30]3692.88 hwloidl>
- 
-  Definitions for parallel machines.
-
-This section contains definitions applicable only to programs compiled
-to run on a parallel machine, i.e. on GUM. Some of these definitions
-are also used when simulating parallel execution, i.e. on GranSim.
-  */
-
-/*
-  ToDo: Check the PAR specfic part of this file 
-        Move stuff into Closures.h and ClosureMacros.h 
-	Clean-up GRAN specific code
-  -- HWL
-  */
-
-#ifndef PARALLEL_H
-#define PARALLEL_H
-
-#if defined(PAR) || defined(GRAN)        /* whole file */
-
-#include "Rts.h"
-#include "GranSim.h"
-//#include "ClosureTypes.h"
-
-//@menu
-//* Basic definitions::		
-//* Externs and types::		
-//* Dummy defs::		
-//* Par specific fixed headers::  
-//* Parallel only heap objects::  
-//* Packing definitions::	
-//* End of File::		
-//@end menu
-//*/
-
-//@node Basic definitions, Externs and types
-//@section Basic definitions
-
-/* SET_PAR_HDR and SET_STATIC_PAR_HDR now live in ClosureMacros.h */
-
-/* Needed for dumping routines */
-#if defined(PAR)
-# define TIME                      ullong
-# define CURRENT_TIME              msTime()
-# define TIME_ON_PROC(p)           msTime()
-# define CURRENT_PROC              thisPE
-# define BINARY_STATS              RtsFlags.ParFlags.granSimStats_Binary
-#elif defined(GRAN)
-# define TIME                      rtsTime
-# define CURRENT_TIME              CurrentTime[CurrentProc]
-# define TIME_ON_PROC(p)           CurrentTime[p]
-# define CURRENT_PROC              CurrentProc
-# define BINARY_STATS              RtsFlags.GranFlags.granSimStats_Binary
-#endif
-
-#if defined(PAR)
-#  define MAX_PES	256		/* Maximum number of processors */
-	/* MAX_PES is enforced by SysMan, which does not
-	   allow more than this many "processors".
-	   This is important because PackGA [GlobAddr.lc]
-	   **assumes** that a PE# can fit in 8+ bits.
-	*/
-#endif
-
-//@node Externs and types, Dummy defs, Basic definitions
-//@section Externs and types
-
-#if defined(PAR)
-/* GUM: one spark queue on each PE, and each PE sees only its own spark queue */
-extern rtsSparkQ pending_sparks_hd;
-extern rtsSparkQ pending_sparks_tl;
-#elif defined(GRAN)
-/* GranSim: a globally visible array of spark queues */
-extern rtsSparkQ pending_sparks_hds[];
-extern rtsSparkQ pending_sparks_tls[];
-#endif
-extern unsigned int /* nat */ spark_queue_len(PEs proc);
-
-extern StgInt SparksAvail;     /* How many sparks are available */
-
-/* prototypes of spark routines */
-/* ToDo: check whether all have to be visible -- HWL */
-#if defined(GRAN)
-rtsSpark *newSpark(StgClosure *node, StgInt name, StgInt gran_info, StgInt size_info, StgInt par_info, StgInt local);
-void disposeSpark(rtsSpark *spark);
-void disposeSparkQ(rtsSparkQ spark);
-void add_to_spark_queue(rtsSpark *spark);
-void delete_from_spark_queue (rtsSpark *spark);
-#endif
-
-#define STATS_FILENAME_MAXLEN	128
-
-/* Where to write the log file */
-//extern FILE *gr_file;
-extern char gr_filename[STATS_FILENAME_MAXLEN];
-
-#if defined(GRAN)
-int init_gr_simulation(char *rts_argv[], int rts_argc, char *prog_argv[], int prog_argc);
-void end_gr_simulation(void);
-#endif 
-
-#if defined(PAR)
-extern I_ do_sp_profile;
-
-extern P_ PendingFetches;
-extern GLOBAL_TASK_ID *PEs;
-
-extern rtsBool IAmMainThread, GlobalStopPending;
-extern rtsBool fishing;
-extern GLOBAL_TASK_ID SysManTask;
-extern int seed;			/*pseudo-random-number generator seed:*/
-					/*Initialised in ParInit*/
-extern I_ threadId;                     /*Number of Threads that have existed on a PE*/
-extern GLOBAL_TASK_ID mytid;
-
-extern int  nPEs;
-
-extern rtsBool InGlobalGC;  	/* Are we in the midst of performing global GC */
-
-extern HashTable *pGAtoGALAtable;
-extern HashTable *LAtoGALAtable;
-extern GALA *freeIndirections;
-extern GALA *liveIndirections;
-extern GALA *freeGALAList;
-extern GALA *liveRemoteGAs;
-extern int thisPE;
-
-void RunParallelSystem (StgPtr program_closure);
-void initParallelSystem();
-void SynchroniseSystem();
-
-void registerTask (GLOBAL_TASK_ID gtid);
-globalAddr *LAGAlookup (P_ addr);
-P_ GALAlookup (globalAddr *ga);
-globalAddr *MakeGlobal (P_ addr, rtsBool preferred);
-globalAddr *setRemoteGA (P_ addr, globalAddr *ga, rtsBool preferred);
-void splitWeight (globalAddr *to, globalAddr *from);
-globalAddr *addWeight (globalAddr *ga);
-void initGAtables();
-W_ taskIDtoPE (GLOBAL_TASK_ID gtid);
-void RebuildLAGAtable();
-
-void *lookupHashTable (HashTable *table, StgWord key);
-void insertHashTable (HashTable *table, StgWord key, void *data);
-void freeHashTable (HashTable *table, void (*freeDataFun) ((void *data)));
-HashTable *allocHashTable();
-void *removeHashTable (HashTable *table, StgWord key, void *data);
-#endif /* PAR */
-
-/* Interface for dumping routines (i.e. writing to log file) */
-void DumpGranEvent(GranEventType name, StgTSO *tso);
-void DumpRawGranEvent(PEs proc, PEs p, GranEventType name, 
- 	              StgTSO *tso, StgClosure *node, StgInt sparkname, StgInt len);
-//void DumpEndEvent(PEs proc, StgTSO *tso, rtsBool mandatory_thread);
-
-//@node Dummy defs, Par specific fixed headers, Externs and types
-//@section Dummy defs
-
-/*
-Get this out of the way.  These are all null definitions.
-*/
-
-
-//#  define GA_HDR_SIZE			0 
-//#  define GA(closure)	        	/*nothing */ 
-  
-//#  define SET_GA(closure,ga)		/* nothing */ 
-//#  define SET_STATIC_GA(closure)	/* nothing */ 
-//#  define SET_GRAN_HDR(closure,pe)      /* nothing */ 
-//#  define SET_STATIC_PROCS(closure)	/* nothing */ 
-  
-//#  define SET_TASK_ACTIVITY(act)	/* nothing */ 
-
-#if defined(GRAN)
-
-#  define GA_HDR_SIZE			1
-
-#  define PROCS_HDR_POSN		PAR_HDR_POSN
-#  define PROCS_HDR_SIZE		1
-
-/* Accessing components of the field */
-#  define PROCS(closure)	        ((closure)->header.gran.procs)
-/* SET_PROCS is now SET_GRAN_HEADER in ClosureMacros.h. */
-#endif
-
-
-//@node Par specific fixed headers, Parallel only heap objects, Dummy defs
-//@section Par specific fixed headers
-
-/*
-Definitions relating to the entire parallel-only fixed-header field.
-
-On GUM, the global addresses for each local closure are stored in a separate
-hash table, rather then with the closure in the heap.  We call @getGA@ to
-look up the global address associated with a local closure (0 is returned
-for local closures that have no global address), and @setGA@ to store a new
-global address for a local closure which did not previously have one.
-*/
-
-#if defined(PAR) 
-
-#  define GA_HDR_SIZE			0
-  
-#  define GA(closure)		        getGA(closure)
-  
-#  define SET_GA(closure, ga)             setGA(closure,ga)
-#  define SET_STATIC_GA(closure)
-#  define SET_GRAN_HDR(closure,pe)
-#  define SET_STATIC_PROCS(closure)
-  
-#  define MAX_GA_WEIGHT			0	/* Treat as 2^n */
-  
-W_ PackGA ((W_, int));
-   /* There was a PACK_GA macro here; but we turned it into the PackGA
-      routine [GlobAddr.lc] (because it needs to do quite a bit of
-      paranoia checking.  Phil & Will (95/08)
-   */
-
-/* At the moment, there is no activity profiling for GUM.  This may change. */
-#  define SET_TASK_ACTIVITY(act)        /* nothing */
-#endif
-
-//@node Parallel only heap objects, Packing definitions, Par specific fixed headers
-//@section Parallel only heap objects
-
-// NB: The following definitons are BOTH for GUM and GrAnSim -- HWL
-
-/*   All in Closures.h and CLosureMacros.h */
-
-//@node Packing definitions, End of File, Parallel only heap objects
-//@section Packing definitions
-
-//@menu
-//* GUM::			
-//* GranSim::			
-//@end menu
-//*/
-
-//@node GUM, GranSim, Packing definitions, Packing definitions
-//@subsection GUM
-
-#if defined(PAR) 
-/*
-Symbolic constants for the packing code.
-
-This constant defines how many words of data we can pack into a single
-packet in the parallel (GUM) system.
-*/
-
-//@menu
-//* Externs::			
-//* Prototypes::		
-//* Macros::			
-//@end menu
-//*/
-
-//@node Externs, Prototypes, GUM, GUM
-//@subsubsection Externs
-
-extern W_      *PackBuffer;      /* size: can be set via option */
-extern long *buffer;             /* HWL_ */
-extern W_ *freeBuffer;           /* HWL_ */
-extern W_ *packBuffer;           /* HWL_ */
-
-extern void    InitPackBuffer(STG_NO_ARGS);
-extern void    InitMoreBuffers(STG_NO_ARGS);
-extern void    InitPendingGABuffer(W_ size); 
-extern void    AllocClosureQueue(W_ size);
-
-//@node Prototypes, Macros, Externs, GUM
-//@subsubsection Prototypes
-
-void	InitPackBuffer();
-P_      PackTSO (P_ tso, W_ *size);
-P_      PackStkO (P_ stko, W_ *size);
-P_	AllocateHeap (W_ size);          /* Doesn't belong */
-
-void    InitClosureQueue ();
-P_      DeQueueClosure();
-void    QueueClosure (P_ closure);
-rtsBool QueueEmpty();
-void    PrintPacket (P_ buffer);
-
-P_      get_closure_info (P_ closure, W_ *size, W_ *ptrs, W_ *nonptrs, W_ *vhs, char *type);
-
-rtsBool isOffset (globalAddr *ga),
-	isFixed (globalAddr *ga);
-
-void    doGlobalGC();
-
-P_      PackNearbyGraph (P_ closure,W_ *size);
-P_      UnpackGraph (W_ *buffer, globalAddr **gamap, W_ *nGAs);
-
-
-//@node Macros,  , Prototypes, GUM
-//@subsubsection Macros
-
-#    define PACK_HEAP_REQUIRED  \
-      ((RtsFlags.ParFlags.packBufferSize - PACK_HDR_SIZE) / (PACK_GA_SIZE + _FHS) * (SPEC_HS + 2))
-
-#  define MAX_GAS 	(RtsFlags.ParFlags.packBufferSize / PACK_GA_SIZE)
-
-
-#  define PACK_GA_SIZE	3	/* Size of a packed GA in words */
-			        /* Size of a packed fetch-me in words */
-#  define PACK_FETCHME_SIZE (PACK_GA_SIZE + FIXED_HS)
-
-#  define PACK_HDR_SIZE	1	/* Words of header in a packet */
-
-#  define PACK_PLC_SIZE	2	/* Size of a packed PLC in words */
-
-#endif /* PAR */
-
-//@node GranSim,  , GUM, Packing definitions
-//@subsection GranSim
-
-#if defined(GRAN)
-/* ToDo: Check which of the PAR routines are needed in GranSim -- HWL */
-
-//@menu
-//* Types::			
-//* Prototypes::		
-//* Macros::			
-//@end menu
-//*/
-
-//@node Types, Prototypes, GranSim, GranSim
-//@subsubsection Types
-
-typedef struct rtsPackBuffer_ {
-  StgInt /* nat */           size;
-  StgInt /* nat */           unpacked_size;
-  StgTSO       *tso;
-  StgClosure  **buffer;  
-} rtsPackBuffer;
-
-//@node Prototypes, Macros, Types, GranSim
-//@subsubsection Prototypes
-
-
-/* main packing functions */
-/*
-rtsPackBuffer *PackNearbyGraph(StgClosure* closure, StgTSO* tso, nat *packbuffersize);
-rtsPackBuffer *PackOneNode(StgClosure* closure, StgTSO* tso, nat *packbuffersize);
-void PrintPacket(rtsPackBuffer *buffer);
-StgClosure *UnpackGraph(rtsPackBuffer* buffer);
-*/
-/* important auxiliary functions */
-
-//StgInfoTable *get_closure_info(StgClosure* node, nat *size, nat *ptrs, nat *nonptrs, nat *vhs, char *info_hdr_ty);
-int IS_BLACK_HOLE(StgClosure* node);
-StgClosure *IS_INDIRECTION(StgClosure* node);
-int IS_THUNK(StgClosure* closure);
-char *display_info_type(StgClosure* closure, char *str);
-
-/* 
-OLD CODE -- HWL
-void  InitPackBuffer(void);
-P_    AllocateHeap (W_ size);
-P_    PackNearbyGraph (P_ closure, P_ tso, W_ *packbuffersize);
-P_    PackOneNode (P_ closure, P_ tso, W_ *packbuffersize);
-P_    UnpackGraph (P_ buffer);
-
-void    InitClosureQueue (void);
-P_      DeQueueClosure(void);
-void    QueueClosure (P_ closure);
-// rtsBool QueueEmpty();
-void    PrintPacket (P_ buffer);
-*/
-
-// StgInfoTable *get_closure_info(StgClosure* node, unsigned int /* nat */ *size, unsigned int /* nat */ *ptrs, unsigned int /* nat */ *nonptrs, unsigned int /* nat */ *vhs, char *info_hdr_ty);
-// int /* rtsBool */ IS_BLACK_HOLE(StgClosure* node)          ;
-
-//@node Macros,  , Prototypes, GranSim
-//@subsubsection Macros
-
-/* These are needed in the packing code to get the size of the packet
-   right. The closures itself are never built in GrAnSim. */
-#  define FETCHME_VHS				IND_VHS
-#  define FETCHME_HS				IND_HS
-  
-#  define FETCHME_GA_LOCN                       FETCHME_HS
-  
-#  define FETCHME_CLOSURE_SIZE(closure)		IND_CLOSURE_SIZE(closure)
-#  define FETCHME_CLOSURE_NoPTRS(closure)		0L
-#  define FETCHME_CLOSURE_NoNONPTRS(closure)	(IND_CLOSURE_SIZE(closure)-IND_VHS)
-  
-#  define MAX_GAS 	(RtsFlags.GranFlags.packBufferSize / PACK_GA_SIZE)
-#  define PACK_GA_SIZE	3	/* Size of a packed GA in words */
-			        /* Size of a packed fetch-me in words */
-#  define PACK_FETCHME_SIZE (PACK_GA_SIZE + FIXED_HS)
-#  define PACK_HDR_SIZE	4	/* Words of header in a packet */
-
-#    define PACK_HEAP_REQUIRED  \
-      (RtsFlags.GranFlags.packBufferSize * sizeofW(StgClosure*) + \
-      2 * sizeofW(StgInt) + sizeofW(StgTSO*))
-
-#    define PACK_FLAG_LOCN           0  
-#    define PACK_TSO_LOCN            1
-#    define PACK_UNPACKED_SIZE_LOCN  2
-#    define PACK_SIZE_LOCN           3
-#    define MAGIC_PACK_FLAG          0xfabc
-
-#endif   /* GRAN */
-
-//@node End of File,  , Packing definitions
-//@section End of File
-
-#endif /* defined(PAR) || defined(GRAN)         whole file */
-#endif /* Parallel_H */
-
-
diff --git a/ghc/rts/parallel/0Unpack.c b/ghc/rts/parallel/0Unpack.c
deleted file mode 100644
index fc4a8e50c3..0000000000
--- a/ghc/rts/parallel/0Unpack.c
+++ /dev/null
@@ -1,440 +0,0 @@
-/*
-  Time-stamp: <Wed Jan 12 2000 13:29:08 Stardate: [-30]4193.85 hwloidl>
-
-  Unpacking closures which have been exported to remote processors
-
-  This module defines routines for unpacking closures in the parallel
-  runtime system (GUM).
-
-  In the case of GrAnSim, this module defines routines for *simulating* the
-  unpacking of closures as it is done in the parallel runtime system.
-*/
-
-/* 
-   Code in this file has been merged with Pack.c 
-*/
-
-#if 0
-
-//@node Unpacking closures, , ,
-//@section Unpacking closures
-
-//@menu
-//* Includes::			
-//* Prototypes::		
-//* GUM code::			
-//* GranSim Code::		
-//* Index::			
-//@end menu
-//*/
-
-//@node Includes, Prototypes, Unpacking closures, Unpacking closures
-//@subsection Includes
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "GranSimRts.h"
-#include "ParallelRts.h"
-#include "ParallelDebug.h"
-#include "FetchMe.h"
-#include "Storage.h"
-
-//@node Prototypes, GUM code, Includes, Unpacking closures
-//@subsection Prototypes
-
-void     InitPacking(void);
-# if defined(PAR)
-void            InitPackBuffer(void);
-# endif
-/* Interface for ADT of closure queues */
-void    	  AllocClosureQueue(nat size);
-void    	  InitClosureQueue(void);
-rtsBool 	  QueueEmpty(void);
-void    	  QueueClosure(StgClosure *closure);
-StgClosure *DeQueueClosure(void);
-
-StgPtr AllocateHeap(nat size);
-
-//@node GUM code, GranSim Code, Prototypes, Unpacking closures
-//@subsection GUM code
-
-#if defined(PAR) 
-
-//@node Local Definitions,  , GUM code, GUM code
-//@subsubsection Local Definitions
-
-//@cindex PendingGABuffer
-static globalAddr *PendingGABuffer;  
-/* is initialised in main; */
-
-//@cindex InitPendingGABuffer
-void
-InitPendingGABuffer(size)
-nat size; 
-{
-  PendingGABuffer = (globalAddr *) 
-                      stgMallocBytes((size-PACK_HDR_SIZE)*2*sizeof(globalAddr),
-				     "InitPendingGABuffer");
-}
-
-/*
-  @CommonUp@ commons up two closures which we have discovered to be
-  variants of the same object.  One is made an indirection to the other.  */
-
-//@cindex CommonUp
-void
-CommonUp(StgClosure *src, StgClosure *dst)
-{
-  StgBlockingQueueElement *bqe;
-
-  ASSERT(src != dst);
-  switch (get_itbl(src)->type) {
-  case BLACKHOLE_BQ:
-    bqe = ((StgBlockingQueue *)src)->blocking_queue;
-    break;
-
-  case FETCH_ME_BQ:
-    bqe = ((StgFetchMeBlockingQueue *)src)->blocking_queue;
-    break;
-    
-  case RBH:
-    bqe = ((StgRBH *)src)->blocking_queue;
-    break;
-    
-  case BLACKHOLE:
-  case FETCH_ME:
-    bqe = END_BQ_QUEUE;
-    break;
-
-  default:
-    /* Don't common up anything else */
-    return;
-  }
-  /* We do not use UPD_IND because that would awaken the bq, too */
-  // UPD_IND(src, dst);
-  updateWithIndirection(get_itbl(src), src, dst);
-  //ASSERT(!IS_BIG_MOTHER(INFO_PTR(dst)));
-  if (bqe != END_BQ_QUEUE)
-    awaken_blocked_queue(bqe, src);
-}
-
-/*
-  @UnpackGraph@ unpacks the graph contained in a message buffer.  It
-  returns a pointer to the new graph.  The @gamap@ parameter is set to
-  point to an array of (oldGA,newGA) pairs which were created as a result
-  of unpacking the buffer; @nGAs@ is set to the number of GA pairs which
-  were created.
-
-  The format of graph in the pack buffer is as defined in @Pack.lc@.  */
-
-//@cindex UnpackGraph
-StgClosure *
-UnpackGraph(packBuffer, gamap, nGAs)
-rtsPackBuffer *packBuffer;
-globalAddr **gamap;
-nat *nGAs;
-{
-  nat size, ptrs, nonptrs, vhs;
-  StgWord **buffer, **bufptr, **slotptr;
-  globalAddr ga, *gaga;
-  StgClosure *closure, *existing,
-             *graphroot, *graph, *parent;
-  StgInfoTable *ip, *oldip;
-  nat bufsize, i,
-      pptr = 0, pptrs = 0, pvhs;
-  char str[80];
-
-  InitPackBuffer();                  /* in case it isn't already init'd */
-  graphroot = (StgClosure *)NULL;
-
-  gaga = PendingGABuffer;
-
-  InitClosureQueue();
-
-  /* Unpack the header */
-  bufsize = packBuffer->size;
-  buffer = packBuffer->buffer;
-  bufptr = buffer;
-
-  /* allocate heap */
-  if (bufsize > 0) {
-    graph = allocate(bufsize);
-    ASSERT(graph != NULL);
-  }
-
-  parent = (StgClosure *)NULL;
-
-  do {
-    /* This is where we will ultimately save the closure's address */
-    slotptr = bufptr;
-
-    /* First, unpack the next GA or PLC */
-    ga.weight = (rtsWeight) *bufptr++;
-
-    if (ga.weight > 0) {
-      ga.payload.gc.gtid = (GlobalTaskId) *bufptr++;
-      ga.payload.gc.slot = (int) *bufptr++;
-    } else
-      ga.payload.plc = (StgPtr) *bufptr++;
-    
-    /* Now unpack the closure body, if there is one */
-    if (isFixed(&ga)) {
-      /* No more to unpack; just set closure to local address */
-      IF_PAR_DEBUG(pack,
-		   belch("Unpacked PLC at %x", ga.payload.plc)); 
-      closure = ga.payload.plc;
-    } else if (isOffset(&ga)) {
-      /* No more to unpack; just set closure to cached address */
-      ASSERT(parent != (StgClosure *)NULL);
-      closure = (StgClosure *) buffer[ga.payload.gc.slot];
-    } else {
-      /* Now we have to build something. */
-
-      ASSERT(bufsize > 0);
-
-      /*
-       * Close your eyes.  You don't want to see where we're looking. You
-       * can't get closure info until you've unpacked the variable header,
-       * but you don't know how big it is until you've got closure info.
-       * So...we trust that the closure in the buffer is organized the
-       * same way as they will be in the heap...at least up through the
-       * end of the variable header.
-       */
-      ip = get_closure_info(bufptr, &size, &ptrs, &nonptrs, &vhs, str);
-	  
-      /* 
-	 Remember, the generic closure layout is as follows:
-	 +-------------------------------------------------+
-	 | FIXED HEADER | VARIABLE HEADER | PTRS | NON-PRS |
-	 +-------------------------------------------------+
-      */
-      /* Fill in the fixed header */
-      for (i = 0; i < FIXED_HS; i++)
-	((StgPtr)graph)[i] = *bufptr++;
-
-      if (ip->type == FETCH_ME)
-	size = ptrs = nonptrs = vhs = 0;
-
-      /* Fill in the packed variable header */
-      for (i = 0; i < vhs; i++)
-	((StgPtr)graph)[FIXED_HS + i] = *bufptr++;
-
-      /* Pointers will be filled in later */
-
-      /* Fill in the packed non-pointers */
-      for (i = 0; i < nonptrs; i++)
-	((StgPtr)graph)[FIXED_HS + i + vhs + ptrs] = *bufptr++;
-                
-      /* Indirections are never packed */
-      // ASSERT(INFO_PTR(graph) != (W_) Ind_info_TO_USE);
-
-      /* Add to queue for processing */
-      QueueClosure(graph);
-	
-      /*
-       * Common up the new closure with any existing closure having the same
-       * GA
-       */
-
-      if ((existing = GALAlookup(&ga)) == NULL) {
-	globalAddr *newGA;
-	/* Just keep the new object */
-	IF_PAR_DEBUG(pack,
-		     belch("Unpacking new (%x, %d, %x)\n", 
-			   ga.payload.gc.gtid, ga.payload.gc.slot, ga.weight));
-
-	closure = graph;
-	newGA = setRemoteGA(graph, &ga, rtsTrue);
-	if (ip->type == FETCH_ME)
-	  // FETCHME_GA(closure) = newGA;
-	  ((StgFetchMe *)closure)->ga = newGA;
-      } else {
-	/* Two closures, one global name.  Someone loses */
-	oldip = get_itbl(existing);
-
-	if ((oldip->type == FETCH_ME || IS_BLACK_HOLE(existing)) &&
-	    ip->type != FETCH_ME) {
-
-	  /* What we had wasn't worth keeping */
-	  closure = graph;
-	  CommonUp(existing, graph);
-	} else {
-
-	  /*
-	   * Either we already had something worthwhile by this name or
-	   * the new thing is just another FetchMe.  However, the thing we
-	   * just unpacked has to be left as-is, or the child unpacking
-	   * code will fail.  Remember that the way pointer words are
-	   * filled in depends on the info pointers of the parents being
-	   * the same as when they were packed.
-	   */
-	  IF_PAR_DEBUG(pack,
-		       belch("Unpacking old (%x, %d, %x), keeping %#lx", 
-			     ga.payload.gc.gtid, ga.payload.gc.slot, ga.weight,
-			     existing));
-
-	  closure = existing;
-	}
-	/* Pool the total weight in the stored ga */
-	(void) addWeight(&ga);
-      }
-
-      /* Sort out the global address mapping */
-      if ((ip_THUNK(ip) && !ip_UNPOINTED(ip)) || 
-	  (ip_MUTABLE(ip) && ip->type != FETCH_ME)) {
-	/* Make up new GAs for single-copy closures */
-	globalAddr *newGA = makeGlobal(closure, rtsTrue);
-	
-	ASSERT(closure == graph);
-
-	/* Create an old GA to new GA mapping */
-	*gaga++ = ga;
-	splitWeight(gaga, newGA);
-	ASSERT(gaga->weight == 1L << (BITS_IN(unsigned) - 1));
-	gaga++;
-      }
-      graph += FIXED_HS + (size < MIN_UPD_SIZE ? MIN_UPD_SIZE : size);
-    }
-
-    /*
-     * Set parent pointer to point to chosen closure.  If we're at the top of
-     * the graph (our parent is NULL), then we want to arrange to return the
-     * chosen closure to our caller (possibly in place of the allocated graph
-     * root.)
-     */
-    if (parent == NULL)
-      graphroot = closure;
-    else
-      ((StgPtr)parent)[FIXED_HS + pvhs + pptr] = (StgWord) closure;
-
-    /* Save closure pointer for resolving offsets */
-    *slotptr = (StgWord) closure;
-
-    /* Locate next parent pointer */
-    pptr++;
-    while (pptr + 1 > pptrs) {
-      parent = DeQueueClosure();
-
-      if (parent == NULL)
-	break;
-      else {
-	(void) get_closure_info(parent, &size, &pptrs, &nonptrs,
-					&pvhs, str);
-	pptr = 0;
-      }
-    }
-  } while (parent != NULL);
-
-  ASSERT(bufsize == 0 || graph - 1 <= SAVE_Hp);
-
-  *gamap = PendingGABuffer;
-  *nGAs = (gaga - PendingGABuffer) / 2;
-
-  /* ToDo: are we *certain* graphroot has been set??? WDP 95/07 */
-  ASSERT(graphroot!=NULL);
-  return (graphroot);
-}
-#endif  /* PAR */
-
-//@node GranSim Code, Index, GUM code, Unpacking closures
-//@subsection GranSim Code
-
-/*
-   For GrAnSim: In general no actual unpacking should be necessary. We just
-   have to walk over the graph and set the bitmasks appropriately. -- HWL */
-
-//@node Unpacking,  , GranSim Code, GranSim Code
-//@subsubsection Unpacking
-
-#if defined(GRAN)
-void
-CommonUp(StgClosure *src, StgClosure *dst)
-{
-  barf("CommonUp: should never be entered in a GranSim setup");
-}
-
-/* This code fakes the unpacking of a somewhat virtual buffer */
-StgClosure*
-UnpackGraph(buffer)
-rtsPackBuffer* buffer;
-{
-  nat size, ptrs, nonptrs, vhs,
-      bufptr = 0;
-  StgClosure *closure, *graphroot, *graph;
-  StgInfoTable *ip;
-  StgWord bufsize, unpackedsize,
-          pptr = 0, pptrs = 0, pvhs;
-  StgTSO* tso;
-  char str[240], str1[80];
-  int i;
-
-  bufptr = 0;
-  graphroot = buffer->buffer[0];
-
-  tso = buffer->tso;
-
-  /* Unpack the header */
-  unpackedsize = buffer->unpacked_size;
-  bufsize = buffer->size;
-
-  IF_GRAN_DEBUG(pack,
-		belch("<<< Unpacking <<%d>> (buffer @ %p):\n    (root @ %p, PE %d,size=%d), demanded by TSO %d (%p)[PE %d]",
-		      buffer->id, buffer, graphroot, where_is(graphroot), 
-		      bufsize, tso->id, tso, 
-		      where_is((StgClosure *)tso)));
-
-  do {
-    closure = buffer->buffer[bufptr++]; /* that's all we need for GrAnSim -- HWL */
-      
-    /* Actually only ip is needed; rest is useful for TESTING -- HWL */
-    ip = get_closure_info(closure, 
-			  &size, &ptrs, &nonptrs, &vhs, str);
-      
-    IF_GRAN_DEBUG(pack,
-		  sprintf(str, "**    (%p): Changing bitmask[%s]: 0x%x ",
-			  closure, (closure_HNF(closure) ? "NF" : "__"),
-			  PROCS(closure)));
-
-    if (ip->type == RBH) {
-      closure->header.gran.procs = PE_NUMBER(CurrentProc);    /* Move node */
-      
-      IF_GRAN_DEBUG(pack,
-		    strcat(str, " (converting RBH) ")); 
-
-      convertFromRBH(closure);   /* In GUM that's done by convertToFetchMe */
-    } else if (IS_BLACK_HOLE(closure)) {
-      closure->header.gran.procs |= PE_NUMBER(CurrentProc); /* Copy node */
-    } else if ( closure->header.gran.procs & PE_NUMBER(CurrentProc) == 0 ) {
-      if (closure_HNF(closure))
-	closure->header.gran.procs |= PE_NUMBER(CurrentProc); /* Copy node */
-      else
-	closure->header.gran.procs = PE_NUMBER(CurrentProc);  /* Move node */
-    }
-
-    IF_GRAN_DEBUG(pack,
-		  sprintf(str1, "0x%x",   PROCS(closure)); strcat(str, str1));
-    IF_GRAN_DEBUG(pack, belch(str));
-    
-  } while (bufptr<buffer->size) ;   /*  (parent != NULL);  */
-
-  /* In GrAnSim we allocate pack buffers dynamically! -- HWL */
-  free(buffer->buffer);
-  free(buffer);
-
-  IF_GRAN_DEBUG(pack,
-		belch("PrintGraph of %p is:", graphroot); PrintGraph(graphroot,0));
-
-  return (graphroot);
-}
-#endif  /* GRAN */
-#endif
-
-//@node Index,  , GranSim Code, Unpacking closures
-//@subsection Index
-
-//@index
-//* CommonUp::  @cindex\s-+CommonUp
-//* InitPendingGABuffer::  @cindex\s-+InitPendingGABuffer
-//* PendingGABuffer::  @cindex\s-+PendingGABuffer
-//* UnpackGraph::  @cindex\s-+UnpackGraph
-//@end index
diff --git a/ghc/rts/parallel/Dist.c b/ghc/rts/parallel/Dist.c
deleted file mode 100644
index eeec780716..0000000000
--- a/ghc/rts/parallel/Dist.c
+++ /dev/null
@@ -1,117 +0,0 @@
-#include "Dist.h"
-
-#ifdef DIST /* whole file */
-
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "ParallelRts.h"
-#include "Parallel.h" // nPEs,allPEs,mytid 
-#include "HLC.h" //for sendReval
-#include "LLC.h" //for pvm stuff
-#include "FetchMe.h"     // for BLOCKED_FETCH_info 
-#include "Storage.h"       // for recordMutable
-
-/* hopefully the result>0  */
-StgWord32 cGetPECount(void)
-{ return nPEs;
-} 
-
-/* return taskID, n is 1..count, n=1 is always the mainPE */
-StgPEId cGetPEId(StgWord32 n)
-{ return allPEs[n-1];
-}
-
-/* return the taskID */
-StgPEId cGetMyPEId(void)
-{ return mytid;
-}
-
-/* return the taskID of the owning PE of an MVar/TSO:
-- MVAR/TSOs get converted to REMOTE_REFs when shipped, and
-  there is no mechanism for using these REMOTE_REFs 
-  apart from this code.
-*/   
-
-StgPEId cGetCertainOwner(StgClosure *mv)
-{ globalAddr *ga; 
-  switch(get_itbl(mv)->type)
-  { case TSO:
-    case MVAR:
-      return  mytid; // must be local 
-    case REMOTE_REF:
-      ga = LAGAlookup(mv);
-      ASSERT(ga);
-      return ga->payload.gc.gtid; // I know its global address
-  }   
-  barf("Dist.c:cGetCertainOwner() wrong closure type %s",info_type(mv));
-}
-
-/* for some additional fun, lets look up a certain host... */
-StgPEId cGetHostOwner(StgByteArray h) //okay h is a C string 
-{ int nArch,nHost,nTask,i;
-  StgPEId dtid;
-  struct pvmhostinfo *host;   
-  struct pvmtaskinfo *task;
-  
-  dtid=0;
-  pvm_config(&nHost,&nArch,&host); 
-  for(i=0;i<nHost;i++)
-    if(strcmp(host[i].hi_name,h)==0) 
-    { dtid=host[i].hi_tid;
-      break;
-    } 
-  if(dtid==0) return 0; // no host of that name
-  
-  for(i=0;i<nPEs;i++)
-  { pvm_tasks(allPEs[i],&nTask,&task);
-    ASSERT(nTask==1); //cause we lookup a single task
-    if(task[0].ti_host==dtid)
-      return allPEs[i];
-  }  
-  return 0;  //know host, put no PE on it
-}
-
-void cRevalIO(StgClosure *job,StgPEId p)
-{ nat size;
-  rtsPackBuffer *buffer=NULL;
-      
-  ASSERT(get_itbl(job)->type==MVAR);  
-  job=((StgMVar*)job)->value; // extract the job from the MVar
-
-  ASSERT(closure_THUNK(job)); // must be a closure!!!!!
-  ASSERT(p!=mytid);
-  
-  buffer = PackNearbyGraph(job, END_TSO_QUEUE, &size,p);
-  ASSERT(buffer != (rtsPackBuffer *)NULL);
-  ASSERT(get_itbl(job)->type==RBH);  
-  
-  IF_PAR_DEBUG(verbose,
-               belch("@;~) %x doing revalIO to %x\n",
-		     mytid,p)); 
-
-  sendReval(p,size,buffer);  
-  
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    globalParStats.tot_reval_mess++;
-  }
-  
-  /* 
-     We turn job into a FETCHME_BQ so that the thread will block
-     when it enters it.
-     
-     Note: it will not receive an ACK, thus no GA.   
-  */
-  
-  ASSERT(get_itbl(job)->type==RBH);  
- 
-   /* put closure on mutables list, while it is still a RBH */
-  recordMutable((StgMutClosure *)job);
-
-  /* actually turn it into a FETCH_ME_BQ */
-  SET_INFO(job, &FETCH_ME_BQ_info);
-  ((StgFetchMe *)job)->ga = 0;     //hope this won't make anyone barf!!!
-  ((StgBlockingQueue*)job)->blocking_queue=END_BQ_QUEUE;
-}
-
-#endif
diff --git a/ghc/rts/parallel/Dist.h b/ghc/rts/parallel/Dist.h
deleted file mode 100644
index c67cce2748..0000000000
--- a/ghc/rts/parallel/Dist.h
+++ /dev/null
@@ -1,20 +0,0 @@
-#ifndef __DIST_H
-#define __DIST_H
-
-#ifdef DIST 
-
-#include "Rts.h"
-
-typedef StgWord32 StgPEId;
-
-// interface functions for Haskell Language calls
-StgWord32 cGetPECount(void);
-StgPEId cGetPEId(StgWord32 n);
-StgPEId cGetMyPEId(void);
-StgPEId cGetCertainOwner(StgClosure *mv);
-void cRevalIO(StgClosure *job,StgPEId p);
-StgPEId cGetHostOwner(StgByteArray h);
-
-#endif /* DIST */
-
-#endif /* __DIST_H */
diff --git a/ghc/rts/parallel/FetchMe.h b/ghc/rts/parallel/FetchMe.h
deleted file mode 100644
index be5cbf6b54..0000000000
--- a/ghc/rts/parallel/FetchMe.h
+++ /dev/null
@@ -1,24 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * Closure types for the parallel system.
- *
- * ---------------------------------------------------------------------------*/
-
-EI_(stg_FETCH_ME_info);
-EF_(stg_FETCH_ME_entry);
-
-EI_(stg_FETCH_ME_BQ_info);
-EF_(stg_FETCH_ME_BQ_entry);
-
-EI_(stg_BLOCKED_FETCH_info);
-EF_(stg_BLOCKED_FETCH_entry);
-
-EI_(stg_REMOTE_REF_info);
-EF_(stg_REMOTE_REF_entry);
-
-EI_(stg_RBH_Save_0_info);
-EF_(stg_RBH_Save_0_entry);
-EI_(stg_RBH_Save_1_info);
-EF_(stg_RBH_Save_1_entry);
-EI_(stg_RBH_Save_2_info);
-EF_(stg_RBH_Save_2_entry);
diff --git a/ghc/rts/parallel/FetchMe.hc b/ghc/rts/parallel/FetchMe.hc
deleted file mode 100644
index f142e9e514..0000000000
--- a/ghc/rts/parallel/FetchMe.hc
+++ /dev/null
@@ -1,180 +0,0 @@
-/* ----------------------------------------------------------------------------
- Time-stamp: <Tue Mar 06 2001 17:01:46 Stardate: [-30]6288.54 hwloidl>
-
- Entry code for a FETCH_ME closure
-
- This module defines routines for handling remote pointers (@FetchMe@s)
- in GUM.  It is threaded (@.hc@) because @FetchMe_entry@ will be
- called during evaluation.
-
- * --------------------------------------------------------------------------*/
- 
-#ifdef PAR /* all of it */
-
-//@menu
-//* Includes::			
-//* Info tables::		
-//* Index::			
-//@end menu
-
-//@node Includes, Info tables
-//@subsection Includes
-
-#include "Stg.h"
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "Storage.h"
-#include "GranSim.h"
-#include "GranSimRts.h"
-#include "Parallel.h"
-#include "ParallelRts.h"
-#include "FetchMe.h"
-#include "HLC.h"
-#include "StgRun.h"	/* for StgReturn and register saving */
-
-/* --------------------------------------------------------------------------
-   FETCH_ME closures.
-
-   A FETCH_ME closure represents data that currently resides on
-   another PE.  We issue a fetch message, and wait for the data to be
-   retrieved.
-
-   A word on the ptr/nonptr fields in the macros: they are unused at the
-   moment; all closures defined here have constant size (ie. no payload
-   that varies from closure to closure). Therefore, all routines that 
-   need to know the size of these closures have to do a sizeofW(StgFetchMe) 
-   etc to get the closure size. See get_closure_info(), evacuate() and
-   checkClosure() (using the same fcts for determining the size of the 
-   closures would be a good idea; at least it would be a nice step towards
-   making this code bug free).
-   ------------------------------------------------------------------------ */
-
-//@node Info tables, Index, Includes
-//@subsection Info tables
-
-//@cindex FETCH_ME_info
-INFO_TABLE(stg_FETCH_ME_info, stg_FETCH_ME_entry, 0,2, FETCH_ME,, EF_,"FETCH_ME","FETCH_ME");
-//@cindex FETCH_ME_entry
-STGFUN(stg_FETCH_ME_entry)
-{
-  FB_
-    TICK_ENT_BH();
-
-    ASSERT(((StgFetchMe *)R1.p)->ga->payload.gc.gtid != mytid);
-  
-    /* Turn the FETCH_ME into a FETCH_ME_BQ, and place the current thread
-     * on the blocking queue.
-     */
-    // ((StgFetchMeBlockingQueue *)R1.cl)->header.info = &FETCH_ME_BQ_info; // does the same as SET_INFO
-    SET_INFO((StgClosure *)R1.cl, &stg_FETCH_ME_BQ_info);
-  
-    /* Remember GA as a global var (used in blockThread); NB: not thread safe! */
-    ASSERT(theGlobalFromGA.payload.gc.gtid == (GlobalTaskId)0);
-    theGlobalFromGA = *((StgFetchMe *)R1.p)->ga; 
-
-    /* Put ourselves on the blocking queue for this black hole */
-    ASSERT(looks_like_ga(((StgFetchMe *)R1.p)->ga));
-    CurrentTSO->link = END_BQ_QUEUE;
-    ((StgFetchMeBlockingQueue *)R1.cl)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
-  
-    /* jot down why and on what closure we are blocked */
-    CurrentTSO->why_blocked = BlockedOnGA;
-    CurrentTSO->block_info.closure = R1.cl;
-    /* closure is mutable since something has just been added to its BQ */
-    //recordMutable((StgMutClosure *)R1.cl);
-
-    /* sendFetch etc is now done in blockThread, which is called from the
-       scheduler -- HWL */
-
-    BLOCK_NP(1); 
-  FE_
-}
-
-/* ---------------------------------------------------------------------------
-   FETCH_ME_BQ
-   
-   On the first entry of a FETCH_ME closure, we turn the closure into
-   a FETCH_ME_BQ, which behaves just like a BLACKHOLE_BQ.  Any thread
-   entering the FETCH_ME_BQ will be placed in the blocking queue.
-   When the data arrives from the remote PE, all waiting threads are
-   woken up and the FETCH_ME_BQ is overwritten with the fetched data.
-
-   FETCH_ME_BQ_entry is almost identical to BLACKHOLE_BQ_entry -- HWL
-   ------------------------------------------------------------------------ */
-
-INFO_TABLE(stg_FETCH_ME_BQ_info, stg_FETCH_ME_BQ_entry,0,2,FETCH_ME_BQ,,EF_,"FETCH_ME_BQ","FETCH_ME_BQ");
-//@cindex FETCH_ME_BQ_info
-STGFUN(stg_FETCH_ME_BQ_entry)
-{
-  FB_
-    TICK_ENT_BH();
-
-    /* Put ourselves on the blocking queue for this node */
-    CurrentTSO->link = (StgTSO*)((StgBlockingQueue *)R1.p)->blocking_queue;
-    ((StgBlockingQueue *)R1.p)->blocking_queue = (StgBlockingQueueElement *)CurrentTSO;
-
-    /* jot down why and on what closure we are blocked */
-    CurrentTSO->why_blocked = BlockedOnGA_NoSend;
-    CurrentTSO->block_info.closure = R1.cl;
-
-    /* stg_gen_block is too heavyweight, use a specialised one */
-    BLOCK_NP(1);
-  FE_
-}
-
-/* ---------------------------------------------------------------------------
-   BLOCKED_FETCH_BQ
-   
-   A BLOCKED_FETCH closure only ever exists in the blocking queue of a
-   globally visible closure i.e. one with a GA. A BLOCKED_FETCH closure
-   indicates that a TSO on another PE is waiting for the result of this
-   computation. Thus, when updating the closure, the result has to be sent
-   to that PE. The relevant routines handling that are awakenBlockedQueue
-   and blockFetch (for putting BLOCKED_FETCH closure into a BQ).
-   ------------------------------------------------------------------------ */
-
-//@cindex BLOCKED_FETCH_info
-INFO_TABLE(stg_BLOCKED_FETCH_info, stg_BLOCKED_FETCH_entry,0,2,BLOCKED_FETCH,,EF_,"BLOCKED_FETCH","BLOCKED_FETCH");
-//@cindex BLOCKED_FETCH_entry
-STGFUN(stg_BLOCKED_FETCH_entry)
-{
-  FB_
-    /* see NON_ENTERABLE_ENTRY_CODE in StgMiscClosures.hc */
-    STGCALL2(fprintf,stderr,"BLOCKED_FETCH object entered!\n");
-    STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);
-  FE_
-}
-
-
-/* ---------------------------------------------------------------------------
-   REMOTE_REF
-   
-   A REMOTE_REF closure is generated whenever we wish to refer to a sticky
-   object on another PE.
-   ------------------------------------------------------------------------ */
-
-//@cindex REMOTE_REF_info
-INFO_TABLE(stg_REMOTE_REF_info, stg_REMOTE_REF_entry,0,2,REMOTE_REF,,EF_,"REMOTE_REF","REMOTE_REF");
-//@cindex REMOTE_REF_entry
-STGFUN(stg_REMOTE_REF_entry)
-{
-  FB_
-    /* see NON_ENTERABLE_ENTRY_CODE in StgMiscClosures.hc */
-    STGCALL2(fprintf,stderr,"REMOTE REF object entered!\n");
-    STGCALL1(shutdownHaskellAndExit, EXIT_FAILURE);
-  FE_
-}
-
-#endif /* PAR */
-
-//@node Index,  , Info tables
-//@subsection Index
-
-//@index
-//* BLOCKED_FETCH_entry::  @cindex\s-+BLOCKED_FETCH_entry
-//* BLOCKED_FETCH_info::  @cindex\s-+BLOCKED_FETCH_info
-//* FETCH_ME_BQ_info::  @cindex\s-+FETCH_ME_BQ_info
-//* FETCH_ME_entry::  @cindex\s-+FETCH_ME_entry
-//* FETCH_ME_info::  @cindex\s-+FETCH_ME_info
-//@end index
diff --git a/ghc/rts/parallel/Global.c b/ghc/rts/parallel/Global.c
deleted file mode 100644
index b2541357e1..0000000000
--- a/ghc/rts/parallel/Global.c
+++ /dev/null
@@ -1,1090 +0,0 @@
-/* ---------------------------------------------------------------------------
-   Time-stamp: <Wed Mar 21 2001 16:32:23 Stardate: [-30]6363.44 hwloidl>
-
-   (c) The AQUA/Parade Projects, Glasgow University, 1995
-       The GdH/APART 624 Projects, Heriot-Watt University, Edinburgh, 1999
-
-   Global Address Manipulation.
-   
-   The GALA and LAGA tables for mapping global addresses to local addresses 
-   (i.e. heap pointers) are defined here. We use the generic hash tables
-   defined in Hash.c.
-   ------------------------------------------------------------------------- */
-
-#ifdef PAR /* whole file */
-
-//@menu
-//* Includes::			
-//* Global tables and lists::	
-//* Fcts on GALA tables::	
-//* Interface to taskId-PE table::  
-//* Interface to LAGA table::	
-//* Interface to GALA table::	
-//* GC functions for GALA tables::  
-//* Index::			
-//@end menu
-//*/
-
-//@node Includes, Global tables and lists, Global Address Manipulation, Global Address Manipulation
-//@subsection Includes
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "Storage.h"
-#include "Hash.h"
-#include "HLC.h"
-#include "ParallelRts.h"
-#if defined(DEBUG)
-# include "Sanity.h"
-#include "ParallelDebug.h"
-#endif
-#if defined(DIST)
-# include "Dist.h"
-#endif
-
-/*
-  @globalAddr@ structures are allocated in chunks to reduce malloc overhead.
-*/
-
-//@node Global tables and lists, Fcts on GALA tables, Includes, Global Address Manipulation
-//@subsection Global tables and lists
-
-//@cindex thisPE
-nat thisPE;
-
-//@menu
-//* Free lists::		
-//* Hash tables::		
-//@end menu
-
-//@node Free lists, Hash tables, Global tables and lists, Global tables and lists
-//@subsubsection Free lists
-
-/* Free list of GALA entries */
-GALA *freeGALAList = NULL;
-
-/* Number of globalAddr cells to allocate in one go */
-#define GCHUNK	    (1024 * sizeof(StgWord) / sizeof(GALA))
-
-/* Free list of indirections */
-
-//@cindex nextIndirection
-static StgInt nextIndirection = 0;
-//@cindex freeIndirections
-GALA *freeIndirections = NULL;
-
-/* The list of live indirections has to be marked for GC (see makeGlobal) */
-//@cindex liveIndirections
-GALA *liveIndirections = NULL;
-
-/* The list of remote indirections has to be marked for GC (see setRemoteGA) */
-//@cindex liveRemoteGAs
-GALA *liveRemoteGAs = NULL;
-
-//@node Hash tables,  , Free lists, Global tables and lists
-//@subsubsection Hash tables
-
-/* Mapping global task ids PEs */
-//@cindex taskIDtoPEtable
-HashTable *taskIDtoPEtable = NULL;
-
-static int nextPE = 0;
-
-/* LAGA table: StgClosure* -> globalAddr*
-               (Remember: globalAddr = (GlobalTaskId, Slot, Weight))
-   Mapping local to global addresses (see interface below) 
-*/
-
-//@cindex LAtoGALAtable
-HashTable *LAtoGALAtable = NULL;
-
-/* GALA table: globalAddr* -> StgClosure*
-               (Remember: globalAddr = (GlobalTaskId, Slot, Weight))
-   Mapping global to local addresses (see interface below) 
-*/
-
-//@cindex pGAtoGALAtable
-HashTable *pGAtoGALAtable = NULL;
-
-//@node Fcts on GALA tables, Interface to taskId-PE table, Global tables and lists, Global Address Manipulation
-//@subsection Fcts on GALA tables
-
-//@cindex allocGALA
-static GALA *
-allocGALA(void)
-{
-  GALA *gl, *p;
-
-  if ((gl = freeGALAList) != NULL) {
-    IF_DEBUG(sanity,
-	     ASSERT(gl->ga.weight==0xdead0add);
-             ASSERT(gl->la==(StgPtr)0xdead00aa));
-    freeGALAList = gl->next;
-  } else {
-    gl = (GALA *) stgMallocBytes(GCHUNK * sizeof(GALA), "allocGALA");
-
-    freeGALAList = gl + 1;
-    for (p = freeGALAList; p < gl + GCHUNK - 1; p++) {
-      p->next = p + 1;
-      IF_DEBUG(sanity,
-	       p->ga.weight=0xdead0add;
-               p->la=(StgPtr)0xdead00aa);
-    }
-    /* last elem in the new block has NULL pointer in link field */
-    p->next = NULL;
-    IF_DEBUG(sanity,
-	     p->ga.weight=0xdead0add;
-	     p->la=(StgPtr)0xdead00aa);
-  }
-  IF_DEBUG(sanity,
-	   gl->ga.weight=0xdead0add;
-           gl->la=(StgPtr)0xdead00aa);
-  return gl;
-}
-
-//@node Interface to taskId-PE table, Interface to LAGA table, Fcts on GALA tables, Global Address Manipulation
-//@subsection Interface to taskId-PE table
-
-/*
-  We don't really like GLOBAL_TASK_ID, so we keep a table of TASK_ID to
-  PE mappings.  The idea is that a PE identifier will fit in 16 bits, whereas 
-  a TASK_ID may not.
-*/
-
-//@cindex taskIDtoPE
-PEs
-taskIDtoPE(GlobalTaskId gtid)
-{
-  return ((PEs) lookupHashTable(taskIDtoPEtable, gtid));
-}
-
-//@cindex registerTask
-void 
-registerTask(GlobalTaskId gtid) { 
-  nextPE++;               //start counting from 1
-  if (gtid == mytid)
-    thisPE = nextPE;
-
-  insertHashTable(taskIDtoPEtable, gtid, (void *) (StgWord) nextPE);
-}
-
-//@node Interface to LAGA table, Interface to GALA table, Interface to taskId-PE table, Global Address Manipulation
-//@subsection Interface to LAGA table
-
-/*
-  The local address to global address mapping returns a globalAddr structure
-  (pe task id, slot, weight) for any closure in the local heap which has a
-  global identity.  Such closures may be copies of normal form objects with
-  a remote `master' location, @FetchMe@ nodes referencing remote objects, or
-  globally visible objects in the local heap (for which we are the master).
-*/
-
-//@cindex LAGAlookup
-globalAddr *
-LAGAlookup(addr)
-StgClosure *addr;
-{
-  GALA *gala;
-
-  /* We never look for GA's on indirections. -- unknown hacker
-     Well, in fact at the moment we do in the new RTS. -- HWL
-     ToDo: unwind INDs when entering them into the hash table
-
-  ASSERT(IS_INDIRECTION(addr) == NULL);
-  */
-  if ((gala = lookupHashTable(LAtoGALAtable, (StgWord) addr)) == NULL)
-    return NULL;
-  else
-    return &(gala->ga);
-}
-
-//@node Interface to GALA table, GC functions for GALA tables, Interface to LAGA table, Global Address Manipulation
-//@subsection Interface to GALA table
-
-/*
-  We also manage a mapping of global addresses to local addresses, so that
-  we can ``common up'' multiple references to the same object as they arrive
-  in data packets from remote PEs.
-
-  The global address to local address mapping is actually managed via a
-  ``packed global address'' to GALA hash table.  The packed global
-  address takes the interesting part of the @globalAddr@ structure
-  (i.e. the pe and slot fields) and packs them into a single word
-  suitable for hashing.
-*/
-
-//@cindex GALAlookup
-StgClosure *
-GALAlookup(ga)
-globalAddr *ga;
-{
-  StgWord pga = PackGA(taskIDtoPE(ga->payload.gc.gtid), ga->payload.gc.slot);
-  GALA *gala;
-
-  if ((gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga)) == NULL)
-    return NULL;
-  else {
-    /* 
-     * Bypass any indirections when returning a local closure to
-     * the caller.  Note that we do not short-circuit the entry in
-     * the GALA tables right now, because we would have to do a
-     * hash table delete and insert in the LAtoGALAtable to keep
-     * that table up-to-date for preferred GALA pairs.  That's
-     * probably a bit expensive.
-     */
-    return UNWIND_IND((StgClosure *)(gala->la));
-  }
-}
-
-/* ga becomes non-preferred (e.g. due to CommonUp) */
-void
-GALAdeprecate(ga)
-globalAddr *ga;
-{
-  StgWord pga = PackGA(taskIDtoPE(ga->payload.gc.gtid), ga->payload.gc.slot);
-  GALA *gala;
-
-  gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga);
-  ASSERT(gala!=NULL);
-  ASSERT(gala->preferred==rtsTrue);
-  gala->preferred = rtsFalse;
-}
-
-/*
-  External references to our globally-visible closures are managed through an
-  indirection table.  The idea is that the closure may move about as the result
-  of local garbage collections, but its global identity is determined by its
-  slot in the indirection table, which never changes.
-
-  The indirection table is maintained implicitly as part of the global
-  address to local address table.  We need only keep track of the
-  highest numbered indirection index allocated so far, along with a free
-  list of lower numbered indices no longer in use.
-*/
-
-/* 
-   Allocate an indirection slot for the closure currently at address @addr@.
-*/
-
-//@cindex allocIndirection
-static GALA *
-allocIndirection(StgClosure *closure)
-{
-  GALA *gala;
-  
-  if ((gala = freeIndirections) != NULL) {
-    IF_DEBUG(sanity,
-	     ASSERT(gala->ga.weight==0xdead0add);
-             ASSERT(gala->la==(StgPtr)0xdead00aa));
-    freeIndirections = gala->next;
-  } else {
-    gala = allocGALA();
-    IF_DEBUG(sanity,
-	     ASSERT(gala->ga.weight==0xdead0add);
-             ASSERT(gala->la==(StgPtr)0xdead00aa));
-    gala->ga.payload.gc.gtid = mytid;
-    gala->ga.payload.gc.slot = nextIndirection++;
-    IF_DEBUG(sanity,
-	     if (nextIndirection>=MAX_SLOTS)
-	       barf("Cannot handle more than %d slots for GA in a sanity-checking setup (this is no error)"));
-  }
-  gala->ga.weight = MAX_GA_WEIGHT;
-  gala->la = (StgPtr)closure;
-  IF_DEBUG(sanity,
-	   gala->next=(struct gala *)0xcccccccc);
-  return gala;
-}
-
-/* 
-   This is only used for sanity checking (see LOOKS_LIKE_SLOT)
-*/
-StgInt
-highest_slot (void) { return nextIndirection; }
-
-/*
-  Make a local closure globally visible.  
-
-  Called from: GlobaliseAndPackGA
-  Args: 
-   closure ... closure to be made visible
-   preferred ... should the new GA become the preferred one (normalle=y true)
-
-  Allocate a GALA structure and add it to the (logical) Indirections table,
-  by inserting it into the LAtoGALAtable hash table and putting it onto the
-  liveIndirections list (only if it is preferred).
-   
-  We have to allocate an indirection slot for it, and update both the local
-  address to global address and global address to local address maps.  
-*/
-
-//@cindex makeGlobal
-globalAddr *
-makeGlobal(closure, preferred)
-StgClosure *closure;
-rtsBool preferred;
-{
-  /* check whether we already have a GA for this local closure */
-  GALA *oldGALA = lookupHashTable(LAtoGALAtable, (StgWord) closure);
-  /* create an entry in the LAGA table */
-  GALA *newGALA = allocIndirection(closure);
-  StgWord pga = PackGA(thisPE, newGALA->ga.payload.gc.slot);
-
-  IF_DEBUG(sanity,
-	   ASSERT(newGALA->next==(struct gala *)0xcccccccc););
-  // ASSERT(HEAP_ALLOCED(closure)); // check that closure might point into the heap; might be static, though
-  ASSERT(GALAlookup(&(newGALA->ga)) == NULL);
-  
-  /* global statistics gathering */
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    globalParStats.local_alloc_GA++;
-  }
-
-  newGALA->la = (StgPtr)closure;
-  newGALA->preferred = preferred;
-
-  if (preferred) {
-    /* The new GA is now the preferred GA for the LA */
-    if (oldGALA != NULL) {
-      oldGALA->preferred = rtsFalse;
-      (void) removeHashTable(LAtoGALAtable, (StgWord) closure, (void *) oldGALA);
-    }
-    insertHashTable(LAtoGALAtable, (StgWord) closure, (void *) newGALA);
-  }
-
-  ASSERT(!isOnLiveIndTable(&(newGALA->ga)));
-  /* put the new GALA entry on the list of live indirections */
-  newGALA->next = liveIndirections;
-  liveIndirections = newGALA;
-  
-  insertHashTable(pGAtoGALAtable, pga, (void *) newGALA);
-  
-  return &(newGALA->ga);
-}
-
-/*
-  Assign an existing remote global address to an existing closure.
-
-  Called from: Unpack in Pack.c
-  Args:
-   local_closure ... a closure that has just been unpacked 
-   remote_ga ... the GA that came with it, ie. the name under which the 
-                 closure is known while being transferred
-   preferred ... should the new GA become the preferred one (normalle=y true)
-
-  Allocate a GALA structure and add it to the (logical) RemoteGA table,
-  by inserting it into the LAtoGALAtable hash table and putting it onto the
-  liveRemoteGAs list (only if it is preferred).
-
-  We do not retain the @globalAddr@ structure that's passed in as an argument,
-  so it can be a static in the calling routine.
-*/
-
-//@cindex setRemoteGA
-globalAddr *
-setRemoteGA(local_closure, remote_ga, preferred)
-StgClosure *local_closure;
-globalAddr *remote_ga;
-rtsBool preferred;
-{
-  /* old entry ie the one with the GA generated when sending off the closure */
-  GALA *oldGALA = lookupHashTable(LAtoGALAtable, (StgWord) local_closure);
-  /* alloc new entry and fill it with contents of the newly arrives GA */
-  GALA *newGALA = allocGALA();
-  StgWord pga = PackGA(taskIDtoPE(remote_ga->payload.gc.gtid), 
-		       remote_ga->payload.gc.slot);
-
-  ASSERT(remote_ga->payload.gc.gtid != mytid);
-  ASSERT(remote_ga->weight > 0);
-  ASSERT(GALAlookup(remote_ga) == NULL);
-
-  newGALA->ga = *remote_ga;
-  newGALA->la = (StgPtr)local_closure;
-  newGALA->preferred = preferred;
-
-  if (preferred) {
-    /* The new GA is now the preferred GA for the LA */
-    if (oldGALA != NULL) {
-      oldGALA->preferred = rtsFalse;
-      (void) removeHashTable(LAtoGALAtable, (StgWord) local_closure, (void *) oldGALA);
-    }
-    insertHashTable(LAtoGALAtable, (StgWord) local_closure, (void *) newGALA);
-  }
-
-  ASSERT(!isOnRemoteGATable(&(newGALA->ga)));
-  /* add new entry to the (logical) RemoteGA table */
-  newGALA->next = liveRemoteGAs;
-  liveRemoteGAs = newGALA;
-  
-  insertHashTable(pGAtoGALAtable, pga, (void *) newGALA);
-  
-  /*
-    The weight carried by the incoming closure is transferred to the newGALA
-    entry (via the structure assign above). Therefore, we have to give back
-    the weight to the GA on the other processor, because that indirection is
-    no longer needed. 
-  */
-  remote_ga->weight = 0;
-  return &(newGALA->ga);
-}
-
-/*
-  Give me a bit of weight to give away on a new reference to a particular
-  global address.  If we run down to nothing, we have to assign a new GA.  
-*/
-
-//@cindex splitWeight
-#if 0
-void
-splitWeight(to, from)
-globalAddr *to, *from;
-{
-  /* Make sure we have enough weight to split */
-  if (from->weight!=MAX_GA_WEIGHT && from->weight<=3)  // fixed by UK in Eden implementation
-    from = makeGlobal(GALAlookup(from), rtsTrue);
-  
-  to->payload = from->payload;
-
-  if (from->weight == MAX_GA_WEIGHT)
-    to->weight = 1L << (BITS_IN(unsigned) - 1);
-  else
-    to->weight = from->weight / 2;
-
-  from->weight -= to->weight;
-}
-#else
-void
-splitWeight(to, from)
-globalAddr *to, *from;
-{
-  /* Make sure we have enough weight to split */
-  /* Splitting at 2 needed, as weight 1 is not legal in packets (UK+KH) */
-  
-  if (from->weight / 2 <= 2) /* old: weight== 1 (UK) */
-      from = makeGlobal(GALAlookup(from), rtsTrue);
-  
-  to->payload = from->payload;
-  
-  if (from->weight <= 1) /* old == 0 (UK) */
-      to->weight = 1L << (BITS_IN(unsigned) - 1);
-  else
-      to->weight = from->weight / 2;
-  
-  from->weight -= to->weight;
-}
-#endif
-/*
-  Here, I am returning a bit of weight that a remote PE no longer needs.
-*/
-
-//@cindex addWeight
-globalAddr *
-addWeight(ga)
-globalAddr *ga;
-{
-  StgWord pga;
-  GALA *gala;
-
-  ASSERT(LOOKS_LIKE_GA(ga));
-
-  pga = PackGA(taskIDtoPE(ga->payload.gc.gtid), ga->payload.gc.slot);
-  gala = (GALA *) lookupHashTable(pGAtoGALAtable, pga);
-
-  IF_PAR_DEBUG(weight,
-	       fprintf(stderr, "@* Adding weight %x to ", ga->weight);
-	       printGA(&(gala->ga));
-	       fputc('\n', stderr));
-
-  gala->ga.weight += ga->weight;    
-  ga->weight = 0;
-
-  return &(gala->ga);
-}
-
-/*
-  Initialize all of the global address structures: the task ID to PE id
-  map, the local address to global address map, the global address to
-  local address map, and the indirection table.
-*/
-
-//@cindex initGAtables
-void
-initGAtables(void)
-{
-  taskIDtoPEtable = allocHashTable();
-  LAtoGALAtable = allocHashTable();
-  pGAtoGALAtable = allocHashTable();
-}
-
-//@cindex PackGA
-StgWord
-PackGA (pe, slot)
-StgWord pe;
-int slot;
-{
-  int pe_shift = (BITS_IN(StgWord)*3)/4;
-  int pe_bits  = BITS_IN(StgWord) - pe_shift;
-
-  if ( pe_bits < 8 || slot >= (1L << pe_shift) ) { /* big trouble */
-    fflush(stdout);
-    fprintf(stderr, "PackGA: slot# too big (%d) or not enough pe_bits (%d)\n",
-	    slot,pe_bits);
-    stg_exit(EXIT_FAILURE);
-  }
-
-  return((((StgWord)(pe)) << pe_shift) | ((StgWord)(slot)));
-	
-    /* the idea is to use 3/4 of the bits (e.g., 24) for indirection-
-       table "slot", and 1/4 for the pe# (e.g., 8).
-       
-       We check for too many bits in "slot", and double-check (at
-       compile-time?) that we have enough bits for "pe".  We *don't*
-       check for too many bits in "pe", because SysMan enforces a
-       MAX_PEs limit at the very very beginning.
-
-       Phil & Will 95/08
-    */
-}
-
-//@node GC functions for GALA tables, Debugging routines, Interface to GALA table, Global Address Manipulation
-//@subsection GC functions for GALA tables
-
-/*
-  When we do a copying collection, we want to evacuate all of the local
-  entries in the GALA table for which there are outstanding remote
-  pointers (i.e. for which the weight is not MAX_GA_WEIGHT.)
-  This routine has to be run BEFORE doing the GC proper (it's a 
-  ``mark roots'' thing).
-*/
-//@cindex markLocalGAs
-void
-markLocalGAs(rtsBool full)
-{
-  GALA *gala, *next, *prev = NULL;
-  StgPtr old_la, new_la;
-  nat n=0, m=0; // debugging only
-  double start_time_GA; // stats only
-
-  IF_PAR_DEBUG(tables,
-	   belch("@@%%%% markLocalGAs (full=%d): Marking LIVE INDIRECTIONS in GALA table starting with GALA at %p\n",
-		 full, liveIndirections);
-	   printLAGAtable());
-
-  PAR_TICKY_MARK_LOCAL_GAS_START();
-
-  for (gala = liveIndirections, m=0; gala != NULL; gala = next, m++) {
-    IF_PAR_DEBUG(tables,
-		 fputs("@@ ",stderr);
-		 printGA(&(gala->ga));
-		 fprintf(stderr, ";@ %d: LA: %p (%s) ",
-			 m, (void*)gala->la, info_type((StgClosure*)gala->la)));
-    next = gala->next;
-    old_la = gala->la;
-    ASSERT(gala->ga.payload.gc.gtid == mytid); /* it's supposed to be local */
-    if (gala->ga.weight != MAX_GA_WEIGHT) {
-      /* Remote references exist, so we must evacuate the local closure */
-      if (get_itbl((StgClosure *)old_la)->type == EVACUATED) {
-	/* somebody else already evacuated this closure */
-	new_la = (StgPtr)((StgEvacuated *)old_la)->evacuee;
-	IF_PAR_DEBUG(tables,
-		 belch(" already evacuated to %p", new_la));
-      } else {
-#if 1
-	/* unwind any indirections we find */
-	StgClosure *foo = UNWIND_IND((StgClosure *)old_la) ; // debugging only
-	//ASSERT(HEAP_ALLOCED(foo));
-	n++;
-
-	new_la = (StgPtr) MarkRoot(foo);
-	IF_PAR_DEBUG(tables,
-		     belch(" evacuated %p to %p", foo, new_la));
-	/* ToDo: is this the right assertion to check that new_la is in to-space?
-	ASSERT(!HEAP_ALLOCED(new_la) || Bdescr(new_la)->evacuated);
-	*/
-#else
-	new_la = MarkRoot(old_la); // or just evacuate(old_ga)
-	IF_PAR_DEBUG(tables,
-		     belch(" evacuated %p to %p", old_la, new_la));
-#endif
-      }
-
-      gala->la = new_la;
-      /* remove old LA and replace with new LA */
-      if (/* !full && */ gala->preferred && new_la != old_la) {
-	GALA *q;
-	ASSERT(lookupHashTable(LAtoGALAtable, (StgWord)old_la));
-	(void) removeHashTable(LAtoGALAtable, (StgWord) old_la, (void *) gala);
-	if ((q = lookupHashTable(LAtoGALAtable, (StgWord) new_la))!=NULL) {
-	  if (q->preferred && gala->preferred) {
-	    q->preferred = rtsFalse;
-	    IF_PAR_DEBUG(tables,
-			 fprintf(stderr, "@@## found hash entry for closure %p (%s): deprecated GA ",
-			   new_la, info_type((StgClosure*)new_la));
-			 printGA(&(q->ga));
-			 fputc('\n', stderr)); 
-	  }
-	} else {
-	  insertHashTable(LAtoGALAtable, (StgWord) new_la, (void *) gala);
-	}
-	IF_PAR_DEBUG(tables,
-		 belch("__## Hash table update (%p --> %p): ",
-		       old_la, new_la));
-      }
-
-      gala->next = prev;
-      prev = gala;
-    } else if(LOOKS_LIKE_STATIC_CLOSURE(gala->la)) {
-      /* to handle the CAFs, is this all?*/
-      MarkRoot(gala->la);
-      IF_PAR_DEBUG(tables,
-		   belch(" processed static closure"));
-      n++;
-      gala->next = prev;
-      prev = gala;   
-    } else {
-      /* Since we have all of the weight, this GA is no longer needed */
-      StgWord pga = PackGA(thisPE, gala->ga.payload.gc.slot);
-      
-      IF_PAR_DEBUG(free,
-		   belch("@@!! Freeing slot %d", 
-			 gala->ga.payload.gc.slot));
-      /* put gala on free indirections list */
-      gala->next = freeIndirections;
-      freeIndirections = gala;
-      (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
-      if (/* !full && */ gala->preferred)
-	(void) removeHashTable(LAtoGALAtable, (W_) gala->la, (void *) gala);
-
-      IF_DEBUG(sanity,
-	       gala->ga.weight = 0xdead0add;
-	       gala->la = (StgPtr) 0xdead00aa);
-    }
-  } /* for gala ... */
-  liveIndirections = prev;  /* list has been reversed during the marking */
-
-
-  PAR_TICKY_MARK_LOCAL_GAS_END(n);
-
-  IF_PAR_DEBUG(tables,
-	       belch("@@%%%% markLocalGAs: %d of %d GALAs marked on PE %x",
-		     n, m, mytid));
-}
-
-/*
-  Traverse the GALA table: for every live remote GA check whether it has been
-  touched during GC; if not it is not needed locally and we can free the 
-  closure (i.e. let go of its heap space and send a free message to the
-  PE holding its GA).
-  This routine has to be run AFTER doing the GC proper.
-*/
-void
-rebuildGAtables(rtsBool full)
-{
-  GALA *gala, *next, *prev;
-  StgClosure *closure;
-  nat n = 0, size_GA = 0; // stats only (no. of GAs, and their heap size in bytes)
-
-  IF_PAR_DEBUG(tables,
-	   belch("@@%%%% rebuildGAtables (full=%d): rebuilding LIVE REMOTE GAs in GALA table starting with GALA at %p\n",
-		 full, liveRemoteGAs));
-
-  PAR_TICKY_REBUILD_GA_TABLES_START();
-
-  prepareFreeMsgBuffers();
-
-  for (gala = liveRemoteGAs, prev = NULL; gala != NULL; gala = next) {
-    IF_PAR_DEBUG(tables,
-		 printGA(&(gala->ga)));
-    next = gala->next;
-    ASSERT(gala->ga.payload.gc.gtid != mytid); /* it's supposed to be remote */
-
-    closure = (StgClosure *) (gala->la);
-    IF_PAR_DEBUG(tables,
-		 fprintf(stderr, " %p (%s) ",
-			 (StgClosure *)closure, info_type(closure)));
-
-    if (/* !full && */ gala->preferred)
-      (void) removeHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
-
-    /* Follow indirection chains to the end, just in case */
-    // should conform with unwinding in markLocalGAs
-    closure = UNWIND_IND(closure);
-
-    /*
-       If closure has been evacuated it is live; otherwise it's dead and we
-       can nuke the GA attached to it in the LAGA table.
-       This approach also drops global aliases for PLCs.
-    */
-
-    //ASSERT(!HEAP_ALLOCED(closure) || !(Bdescr((StgPtr)closure)->evacuated));
-    if (get_itbl(closure)->type == EVACUATED) {
-      closure = ((StgEvacuated *)closure)->evacuee;
-      IF_PAR_DEBUG(tables,
-		   fprintf(stderr, " EVAC %p (%s)\n",
-			   closure, info_type(closure)));
-    } else {
-      /* closure is not alive any more, thus remove GA and send free msg */
-      int pe = taskIDtoPE(gala->ga.payload.gc.gtid);
-      StgWord pga = PackGA(pe, gala->ga.payload.gc.slot);
-
-      /* check that the block containing this closure is not in to-space */
-      IF_PAR_DEBUG(tables,
-		   fprintf(stderr, " !EVAC %p (%s); sending free to PE %d\n",
-			   closure, info_type(closure), pe));
-
-      (void) removeHashTable(pGAtoGALAtable, pga, (void *) gala);
-      freeRemoteGA(pe-1, &(gala->ga)); //-1 cause ids start at 1... not 0
-      gala->next = freeGALAList;
-      freeGALAList = gala;
-      IF_DEBUG(sanity,
-	       gala->ga.weight = 0xdead0add;
-	       gala->la = (StgPtr)0xdead00aa);
-      continue;
-    }
-    gala->la = (StgPtr)closure;
-    if (/* !full && */ gala->preferred) {
-      GALA *q;
-      if ((q = lookupHashTable(LAtoGALAtable, (StgWord) gala->la))!=NULL) {
-	if (q->preferred && gala->preferred) {
-	    q->preferred = rtsFalse;
-	    IF_PAR_DEBUG(tables,
-			 fprintf(stderr, "@@## found hash entry for closure %p (%s): deprecated GA ",
-			   gala->la, info_type((StgClosure*)gala->la));
-			 printGA(&(q->ga));
-			 fputc('\n', stderr)); 
-	}
-      } else {
-	insertHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
-      }
-    }
-    gala->next = prev;
-    prev = gala;
-    /* Global statistics: count GAs and total size
-    if (RtsFlags.ParFlags.ParStats.Global &&
-	RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-      StgInfoTable *info;
-      nat size, ptrs, nonptrs, vhs, i;
-      char str[80];
-
-      info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
-
-      size_GA += size ;
-      n++; // stats: count number of GAs we add to the new table
-    }
-    */
-  }
-  liveRemoteGAs = prev; /* list is reversed during marking */
-
-  /* If we have any remaining FREE messages to send off, do so now */
-  sendFreeMessages();
-
-  PAR_TICKY_CNT_FREE_GA();
-
-  IF_DEBUG(sanity,
-	   checkFreeGALAList();
-	   checkFreeIndirectionsList());
-
-  rebuildLAGAtable();
-
-#if defined(PAR_TICKY)
-  getLAGAtableSize(&n, &size_GA);        // determine no of GAs and global heap
-  PAR_TICKY_REBUILD_GA_TABLES_END(n, size_GA); // record these values
-#endif
-
-  IF_PAR_DEBUG(tables,
-	   belch("@#%%%% rebuildGAtables: After ReBuilding GALA table starting with GALA at %p",
-		 liveRemoteGAs);
-	   printLAGAtable());
-}
-
-/*
-  Rebuild the LA->GA table, assuming that the addresses in the GALAs are
-  correct.  
-  A word on the lookupHashTable check in both loops:
-  After GC we may end up with 2 preferred GAs for the same LA! For example,
-  if we received a closure whose GA already exists on this PE we CommonUp
-  both closures, making one an indirection to the other. Before GC everything
-  is fine: one preferred GA refers to the IND, the other preferred GA refers
-  to the closure it points to. After GC, however, we have short cutted the 
-  IND and suddenly we have 2 preferred GAs for the same closure. We detect
-  this case in the loop below and deprecate one GA, so that we always just
-  have one preferred GA per LA.
-*/
-
-//@cindex rebuildLAGAtable
-void
-rebuildLAGAtable(void)
-{
-  GALA *gala;
-  nat n=0, m=0; // debugging
-
-  /* The old LA->GA table is worthless */
-  freeHashTable(LAtoGALAtable, NULL);
-  LAtoGALAtable = allocHashTable();
-
-  IF_PAR_DEBUG(tables,
-	   belch("@@%%%% rebuildLAGAtable: new LAGA table at %p",
-		 LAtoGALAtable)); 
-  
-  for (gala = liveIndirections; gala != NULL; gala = gala->next) {
-    n++;
-    if (gala->preferred) {
-      GALA *q;
-      if ((q = lookupHashTable(LAtoGALAtable, (StgWord) gala->la))!=NULL) {
-	if (q->preferred && gala->preferred) {
-	  /* this deprecates q (see also GALAdeprecate) */
-	  q->preferred = rtsFalse;
-	  (void) removeHashTable(LAtoGALAtable, (StgWord) gala->la, (void *)q);
-	  IF_PAR_DEBUG(tables,
-		       fprintf(stderr, "@@## found hash entry for closure %p (%s): deprecated GA ",
-			       gala->la, info_type((StgClosure*)gala->la));
-		       printGA(&(q->ga));
-		       fputc('\n', stderr)); 
-	}
-      }
-      insertHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
-    }
-  }
-
-  for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
-    m++;
-    if (gala->preferred) {
-      GALA *q;
-      if ((q = lookupHashTable(LAtoGALAtable, (StgWord) gala->la))!=NULL) {
-	if (q->preferred && gala->preferred) {
-	  /* this deprecates q (see also GALAdeprecate) */
-	  q->preferred = rtsFalse;
-	  (void) removeHashTable(LAtoGALAtable, (StgWord) gala->la, (void *)q);
-	  IF_PAR_DEBUG(tables,
-		       fprintf(stderr, "@@## found hash entry for closure %p (%s): deprecated GA ",
-			       (StgClosure*)gala->la, info_type((StgClosure*)gala->la));
-		       printGA(&(q->ga));
-		       fputc('\n', stderr)); 
-	}
-      }
-      insertHashTable(LAtoGALAtable, (StgWord) gala->la, (void *) gala);
-    }
-  }
-
-  IF_PAR_DEBUG(tables,
-	   belch("@@%%%% rebuildLAGAtable: inserted %d entries from liveIndirections and %d entries from liveRemoteGAs",
-		 n,m)); 
-}
-
-/*
-  Determine the size of the LAGA and GALA tables.
-  Has to be done after rebuilding the tables. 
-  Only used for global statistics gathering.
-*/
-
-//@cindex getLAGAtableSize
-void
-getLAGAtableSize(nat *nP, nat *sizeP)
-{
-  GALA *gala;
-  // nat n=0, tot_size=0;
-  StgClosure *closure;
-  StgInfoTable *info;
-  nat size, ptrs, nonptrs, vhs, i;
-  char str[80];
-  /* IN order to avoid counting closures twice we maintain a hash table
-     of all closures seen so far.
-     ToDo: collect this data while rebuilding the GALA table and make use
-           of the existing hash tables;
-  */
-  HashTable *closureTable;  // hash table for closures encountered already
-
-  closureTable = allocHashTable();
-
-  (*nP) = (*sizeP) = 0;
-  for (gala = liveIndirections; gala != NULL; gala = gala->next) {
-    closure = (StgClosure*) gala->la;
-    if (lookupHashTable(closureTable, (StgWord)closure)==NULL) { // not seen yet
-      insertHashTable(closureTable, (StgWord)closure, (void *)1);
-      info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
-      (*sizeP) += size ;   // stats: measure total heap size of global closures
-      (*nP)++;             // stats: count number of GAs
-    }
-  }
-
-  for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
-    closure = (StgClosure*) gala->la;
-    if (lookupHashTable(closureTable, (StgWord)closure)==NULL) { // not seen yet
-      insertHashTable(closureTable, (StgWord)closure, (void *)1);
-      info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
-      (*sizeP) += size ;   // stats: measure total heap size of global closures
-      (*nP)++;             // stats: count number of GAs
-    }
-  }
-
-  freeHashTable(closureTable, NULL);
-}
-
-//@node Debugging routines, Index, GC functions for GALA tables, Global Address Manipulation
-//@subsection Debugging routines
-
-//@cindex printGA
-void
-printGA (globalAddr *ga)
-{
-  fprintf(stderr, "((%x, %d, %x))", 
-	  ga->payload.gc.gtid,
-	  ga->payload.gc.slot,
-	  ga->weight);
-}
-
-//@cindex printGALA
-void 
-printGALA (GALA *gala)
-{
-  printGA(&(gala->ga));
-  fprintf(stderr, " -> %p (%s)",
-	  (StgClosure*)gala->la, info_type((StgClosure*)gala->la));
-  fprintf(stderr, " %s",
-	  (gala->preferred) ? "PREF" : "____");
-}
-
-/*
-  Printing the LA->GA table.
-*/
-
-//@cindex printLiveIndTable
-void
-printLiveIndTable(void)
-{
-  GALA *gala, *q;
-  nat n=0; // debugging
-
-  belch("@@%%%%:: logical LiveIndTable (%p) (liveIndirections=%p):",
-	LAtoGALAtable, liveIndirections); 
-  
-  for (gala = liveIndirections; gala != NULL; gala = gala->next) {
-    n++;
-    printGALA(gala);
-    /* check whether this gala->la is hashed into the LAGA table */
-    q = lookupHashTable(LAtoGALAtable, (StgWord)(gala->la));
-    fprintf(stderr, "\t%s\n", (q==NULL) ? "...." : (q==gala) ?  "====" : "####");
-    //ASSERT(lookupHashTable(LAtoGALAtable, (StgWord)(gala->la)));
-  }
-  belch("@@%%%%:: %d live indirections",
-	n);
-}
-
-void
-printRemoteGATable(void)
-{
-  GALA *gala, *q;
-  nat m=0; // debugging
-
-  belch("@@%%%%:: logical RemoteGATable (%p) (liveRemoteGAs=%p):",
-	LAtoGALAtable, liveRemoteGAs);
-
-  for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) {
-    m++;
-    printGALA(gala);
-    /* check whether this gala->la is hashed into the LAGA table */
-    q = lookupHashTable(LAtoGALAtable, (StgWord)(gala->la));
-    fprintf(stderr, "\t%s\n", (q==NULL) ? "...." : (q==gala) ? "====" : "####");
-    // ASSERT(lookupHashTable(LAtoGALAtable, (StgWord)(gala->la)));
-  }
-  belch("@@%%%%:: %d remote GAs",
-	m);
-}
-
-//@cindex printLAGAtable
-void
-printLAGAtable(void)
-{
-  belch("@@%%: LAGAtable (%p) with liveIndirections=%p, liveRemoteGAs=%p:",
-	LAtoGALAtable, liveIndirections, liveRemoteGAs); 
-
-  printLiveIndTable();
-  printRemoteGATable();
-}
-
-/*
-  Check whether a GA is already in a list.
-*/
-rtsBool
-isOnLiveIndTable(globalAddr *ga)
-{
-  GALA *gala;
-
-  for (gala = liveIndirections; gala != NULL; gala = gala->next) 
-    if (gala->ga.weight==ga->weight &&
-	gala->ga.payload.gc.slot==ga->payload.gc.slot &&
-	gala->ga.payload.gc.gtid==ga->payload.gc.gtid)
-      return rtsTrue;
-
-  return rtsFalse;
-}
-
-rtsBool
-isOnRemoteGATable(globalAddr *ga)
-{
-  GALA *gala;
-
-  for (gala = liveRemoteGAs; gala != NULL; gala = gala->next) 
-    if (gala->ga.weight==ga->weight &&
-	gala->ga.payload.gc.slot==ga->payload.gc.slot &&
-	gala->ga.payload.gc.gtid==ga->payload.gc.gtid)
-      return rtsTrue;
-
-  return rtsFalse;
-}
-
-/* 
-   Sanity check for free lists.
-*/
-void
-checkFreeGALAList(void) {
-  GALA *gl;
-
-  for (gl=freeGALAList; gl != NULL; gl=gl->next) {
-    ASSERT(gl->ga.weight==0xdead0add);
-    ASSERT(gl->la==(StgPtr)0xdead00aa);
-  }
-}
-
-void
-checkFreeIndirectionsList(void) {
-  GALA *gl;
-
-  for (gl=freeIndirections; gl != NULL; gl=gl->next) {
-    ASSERT(gl->ga.weight==0xdead0add);
-    ASSERT(gl->la==(StgPtr)0xdead00aa);
-  }
-}
-#endif /* PAR -- whole file */
-
-//@node Index,  , Debugging routines, Global Address Manipulation
-//@subsection Index
-
-//@index
-//* DebugPrintLAGAtable::  @cindex\s-+DebugPrintLAGAtable
-//* GALAlookup::  @cindex\s-+GALAlookup
-//* LAGAlookup::  @cindex\s-+LAGAlookup
-//* LAtoGALAtable::  @cindex\s-+LAtoGALAtable
-//* PackGA::  @cindex\s-+PackGA
-//* addWeight::  @cindex\s-+addWeight
-//* allocGALA::  @cindex\s-+allocGALA
-//* allocIndirection::  @cindex\s-+allocIndirection
-//* freeIndirections::  @cindex\s-+freeIndirections
-//* initGAtables::  @cindex\s-+initGAtables
-//* liveIndirections::  @cindex\s-+liveIndirections
-//* liveRemoteGAs::  @cindex\s-+liveRemoteGAs
-//* makeGlobal::  @cindex\s-+makeGlobal
-//* markLocalGAs::  @cindex\s-+markLocalGAs
-//* nextIndirection::  @cindex\s-+nextIndirection
-//* pGAtoGALAtable::  @cindex\s-+pGAtoGALAtable
-//* printGA::  @cindex\s-+printGA
-//* printGALA::  @cindex\s-+printGALA
-//* rebuildLAGAtable::  @cindex\s-+rebuildLAGAtable
-//* registerTask::  @cindex\s-+registerTask
-//* setRemoteGA::  @cindex\s-+setRemoteGA
-//* splitWeight::  @cindex\s-+splitWeight
-//* taskIDtoPE::  @cindex\s-+taskIDtoPE
-//* taskIDtoPEtable::  @cindex\s-+taskIDtoPEtable
-//* thisPE::  @cindex\s-+thisPE
-//@end index
diff --git a/ghc/rts/parallel/GranSim.c b/ghc/rts/parallel/GranSim.c
deleted file mode 100644
index b1cc0962be..0000000000
--- a/ghc/rts/parallel/GranSim.c
+++ /dev/null
@@ -1,3015 +0,0 @@
-/* 
-   Time-stamp: <Tue Mar 06 2001 00:17:42 Stardate: [-30]6285.06 hwloidl>
-
-   Variables and functions specific to GranSim the parallelism simulator
-   for GPH.
-*/
-
-//@node GranSim specific code, , ,
-//@section GranSim specific code
-
-/*
-   Macros for dealing with the new and improved GA field for simulating
-   parallel execution. Based on @CONCURRENT@ package. The GA field now
-   contains a mask, where the n-th bit stands for the n-th processor, where
-   this data can be found. In case of multiple copies, several bits are
-   set. The total number of processors is bounded by @MAX_PROC@, which
-   should be <= the length of a word in bits.  -- HWL 
-*/
-
-//@menu
-//* Includes::			
-//* Prototypes and externs::	
-//* Constants and Variables::	
-//* Initialisation::		
-//* Global Address Operations::	 
-//* Global Event Queue::	
-//* Spark queue functions::	
-//* Scheduling functions::	
-//* Thread Queue routines::	
-//* GranSim functions::		
-//* GranSimLight routines::	
-//* Code for Fetching Nodes::	
-//* Idle PEs::			
-//* Routines directly called from Haskell world::  
-//* Emiting profiling info for GrAnSim::  
-//* Dumping routines::		
-//* Index::			
-//@end menu
-
-//@node Includes, Prototypes and externs, GranSim specific code, GranSim specific code
-//@subsection Includes
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "StgMiscClosures.h"
-#include "StgTypes.h"
-#include "Schedule.h"
-#include "SchedAPI.h"       // for pushClosure
-#include "GranSimRts.h"
-#include "GranSim.h"
-#include "ParallelRts.h"
-#include "ParallelDebug.h"
-#include "Sparks.h"
-#include "Storage.h"       // for recordMutable
-
-
-//@node Prototypes and externs, Constants and Variables, Includes, GranSim specific code
-//@subsection Prototypes and externs
-
-#if defined(GRAN)
-
-/* Prototypes */
-static inline PEs      ga_to_proc(StgWord);
-static inline rtsBool  any_idle(void);
-static inline nat      idlers(void);
-       PEs             where_is(StgClosure *node);
-
-static rtsBool         stealSomething(PEs proc, rtsBool steal_spark, rtsBool steal_thread);
-static rtsBool         stealSpark(PEs proc);
-static rtsBool         stealThread(PEs proc);
-static rtsBool         stealSparkMagic(PEs proc);
-static rtsBool         stealThreadMagic(PEs proc);
-/* subsumed by stealSomething
-static void            stealThread(PEs proc); 
-static void            stealSpark(PEs proc);
-*/
-static rtsTime         sparkStealTime(void);
-static nat             natRandom(nat from, nat to);
-static PEs             findRandomPE(PEs proc);
-static void            sortPEsByTime (PEs proc, PEs *pes_by_time, 
-				      nat *firstp, nat *np);
-
-void GetRoots(void);
-
-#endif /* GRAN */
-
-//@node Constants and Variables, Initialisation, Prototypes and externs, GranSim specific code
-//@subsection Constants and Variables
-
-#if defined(GRAN) || defined(PAR)
-/* See GranSim.h for the definition of the enum gran_event_types */
-char *gran_event_names[] = {
-    "START", "START(Q)",
-    "STEALING", "STOLEN", "STOLEN(Q)",
-    "FETCH", "REPLY", "BLOCK", "RESUME", "RESUME(Q)",
-    "SCHEDULE", "DESCHEDULE",
-    "END",
-    "SPARK", "SPARKAT", "USED", "PRUNED", "EXPORTED", "ACQUIRED",
-    "ALLOC",
-    "TERMINATE",
-    "SYSTEM_START", "SYSTEM_END",           /* only for debugging */
-    "??"
-};
-#endif
-
-#if defined(GRAN)                                              /* whole file */
-char *proc_status_names[] = {
-  "Idle", "Sparking", "Starting", "Fetching", "Fishing", "Busy", 
-  "UnknownProcStatus"
-};
-
-/* For internal use (event statistics) only */
-char *event_names[] =
-    { "ContinueThread", "StartThread", "ResumeThread", 
-      "MoveSpark", "MoveThread", "FindWork",
-      "FetchNode", "FetchReply",
-      "GlobalBlock", "UnblockThread"
-    };
-
-//@cindex CurrentProc
-PEs CurrentProc = 0;
-
-/*
-  ToDo: Create a structure for the processor status and put all the 
-        arrays below into it. 
-  -- HWL */
-
-//@cindex CurrentTime
-/* One clock for each PE */
-rtsTime CurrentTime[MAX_PROC];  
-
-/* Useful to restrict communication; cf fishing model in GUM */
-nat OutstandingFetches[MAX_PROC], OutstandingFishes[MAX_PROC];
-
-/* Status of each PE (new since but independent of GranSim Light) */
-rtsProcStatus procStatus[MAX_PROC];
-
-# if defined(GRAN) && defined(GRAN_CHECK)
-/* To check if the RTS ever tries to run a thread that should be blocked
-   because of fetching remote data */
-StgTSO *BlockedOnFetch[MAX_PROC];
-# define FETCH_MASK_TSO  0x08000000      /* only bits 0, 1, 2 should be used */
-# endif
-
-nat SparksAvail = 0;     /* How many sparks are available */
-nat SurplusThreads = 0;  /* How many excess threads are there */
-
-/* Do we need to reschedule following a fetch? */
-rtsBool NeedToReSchedule = rtsFalse, IgnoreEvents = rtsFalse, IgnoreYields = rtsFalse; 
-rtsTime TimeOfNextEvent, TimeOfLastEvent, EndOfTimeSlice; /* checked from the threaded world! */
-
-//@cindex spark queue
-/* GranSim: a globally visible array of spark queues */
-rtsSparkQ pending_sparks_hds[MAX_PROC];
-rtsSparkQ pending_sparks_tls[MAX_PROC];
-
-nat sparksIgnored = 0, sparksCreated = 0;
-
-GlobalGranStats globalGranStats;
-
-nat gran_arith_cost, gran_branch_cost, gran_load_cost, 
-    gran_store_cost, gran_float_cost;
-
-/*
-Old comment from 0.29. ToDo: Check and update -- HWL
-
-The following variables control the behaviour of GrAnSim. In general, there
-is one RTS option for enabling each of these features. In getting the
-desired setup of GranSim the following questions have to be answered:
-\begin{itemize}
-\item {\em Which scheduling algorithm} to use (@RtsFlags.GranFlags.DoFairSchedule@)? 
-      Currently only unfair scheduling is supported.
-\item What to do when remote data is fetched (@RtsFlags.GranFlags.DoAsyncFetch@)? 
-      Either block and wait for the
-      data or reschedule and do some other work.
-      Thus, if this variable is true, asynchronous communication is
-      modelled. Block on fetch mainly makes sense for incremental fetching.
-
-      There is also a simplified fetch variant available
-      (@RtsFlags.GranFlags.SimplifiedFetch@). This variant does not use events to model
-      communication. It is faster but the results will be less accurate.
-\item How aggressive to be in getting work after a reschedule on fetch
-      (@RtsFlags.GranFlags.FetchStrategy@)?
-      This is determined by the so-called {\em fetching
-      strategy\/}. Currently, there are four possibilities:
-      \begin{enumerate}
-       \item Only run a runnable thread.
-       \item Turn a spark into a thread, if necessary.
-       \item Steal a remote spark, if necessary.
-       \item Steal a runnable thread from another processor, if necessary.
-      \end{itemize}
-      The variable @RtsFlags.GranFlags.FetchStrategy@ determines how far to go in this list
-      when rescheduling on a fetch.
-\item Should sparks or threads be stolen first when looking for work
-      (@RtsFlags.GranFlags.DoStealThreadsFirst@)? 
-      The default is to steal sparks first (much cheaper).
-\item Should the RTS use a lazy thread creation scheme
-      (@RtsFlags.GranFlags.DoAlwaysCreateThreads@)?  By default yes i.e.\ sparks are only
-      turned into threads when work is needed. Also note, that sparks
-      can be discarded by the RTS (this is done in the case of an overflow
-      of the spark pool). Setting @RtsFlags.GranFlags.DoAlwaysCreateThreads@  to @True@ forces
-      the creation of threads at the next possibility (i.e.\ when new work
-      is demanded the next time).
-\item Should data be fetched closure-by-closure or in packets
-      (@RtsFlags.GranFlags.DoBulkFetching@)? The default strategy is a GRIP-like incremental 
-      (i.e.\ closure-by-closure) strategy. This makes sense in a
-      low-latency setting but is bad in a high-latency system. Setting 
-      @RtsFlags.GranFlags.DoBulkFetching@ to @True@ enables bulk (packet) fetching. Other
-      parameters determine the size of the packets (@pack_buffer_size@) and the number of
-      thunks that should be put into one packet (@RtsFlags.GranFlags.ThunksToPack@).
-\item If there is no other possibility to find work, should runnable threads
-      be moved to an idle processor (@RtsFlags.GranFlags.DoThreadMigration@)? In any case, the
-      RTS tried to get sparks (either local or remote ones) first. Thread
-      migration is very expensive, since a whole TSO has to be transferred
-      and probably data locality becomes worse in the process. Note, that
-      the closure, which will be evaluated next by that TSO is not
-      transferred together with the TSO (that might block another thread).
-\item Should the RTS distinguish between sparks created by local nodes and
-      stolen sparks (@RtsFlags.GranFlags.PreferSparksOfLocalNodes@)?  The idea is to improve 
-      data locality by preferring sparks of local nodes (it is more likely
-      that the data for those sparks is already on the local processor). 
-      However, such a distinction also imposes an overhead on the spark
-      queue management, and typically a large number of sparks are
-      generated during execution. By default this variable is set to @False@.
-\item Should the RTS use granularity control mechanisms? The idea of a 
-      granularity control mechanism is to make use of granularity
-      information provided via annotation of the @par@ construct in order
-      to prefer bigger threads when either turning a spark into a thread or
-      when choosing the next thread to schedule. Currently, three such
-      mechanisms are implemented:
-      \begin{itemize}
-        \item Cut-off: The granularity information is interpreted as a
-              priority. If a threshold priority is given to the RTS, then
-              only those sparks with a higher priority than the threshold 
-              are actually created. Other sparks are immediately discarded.
-              This is similar to a usual cut-off mechanism often used in 
-              parallel programs, where parallelism is only created if the 
-              input data is lage enough. With this option, the choice is 
-              hidden in the RTS and only the threshold value has to be 
-              provided as a parameter to the runtime system.
-        \item Priority Sparking: This mechanism keeps priorities for sparks
-              and chooses the spark with the highest priority when turning
-              a spark into a thread. After that the priority information is
-              discarded. The overhead of this mechanism comes from
-              maintaining a sorted spark queue.
-        \item Priority Scheduling: This mechanism keeps the granularity
-              information for threads, to. Thus, on each reschedule the 
-              largest thread is chosen. This mechanism has a higher
-              overhead, as the thread queue is sorted, too.
-       \end{itemize}  
-\end{itemize}
-*/
-
-//@node Initialisation, Global Address Operations, Constants and Variables, GranSim specific code
-//@subsection Initialisation
-
-void 
-init_gr_stats (void) {
-  memset(&globalGranStats, '\0', sizeof(GlobalGranStats));
-#if 0
-  /* event stats */
-  globalGranStats.noOfEvents = 0;
-  for (i=0; i<MAX_EVENT; i++) globalGranStats.event_counts[i]=0;
-
-  /* communication stats */
-  globalGranStats.fetch_misses = 0;
-  globalGranStats.tot_low_pri_sparks = 0;
-
-  /* obscure stats */  
-  globalGranStats.rs_sp_count = 0;
-  globalGranStats.rs_t_count = 0;
-  globalGranStats.ntimes_total = 0, 
-  globalGranStats.fl_total = 0;
-  globalGranStats.no_of_steals = 0;
-
-  /* spark queue stats */
-  globalGranStats.tot_sq_len = 0, 
-  globalGranStats.tot_sq_probes = 0; 
-  globalGranStats.tot_sparks = 0;
-  globalGranStats.withered_sparks = 0;
-  globalGranStats.tot_add_threads = 0;
-  globalGranStats.tot_tq_len = 0;
-  globalGranStats.non_end_add_threads = 0;
-
-  /* thread stats */
-  globalGranStats.tot_threads_created = 0;
-  for (i=0; i<MAX_PROC; i++) globalGranStats.threads_created_on_PE[i]=0;
-#endif /* 0 */
-}
-
-//@node Global Address Operations, Global Event Queue, Initialisation, GranSim specific code
-//@subsection Global Address Operations
-/*
-  ----------------------------------------------------------------------
-  Global Address Operations
-
-  These functions perform operations on the global-address (ga) part of a
-  closure. The ga is the only new field (1 word) in a closure introduced by
-  GrAnSim. It serves as a bitmask, indicating on which processor the
-  closure is residing. Since threads are described by Thread State Object
-  (TSO), which is nothing but another kind of closure, this scheme allows
-  gives placement information about threads.
-
-  A ga is just a bitmask, so the operations on them are mainly bitmask
-  manipulating functions. Note, that there are important macros like PROCS,
-  IS_LOCAL_TO etc. They are defined in @GrAnSim.lh@.
-
-  NOTE: In GrAnSim-light we don't maintain placement information. This
-  allows to simulate an arbitrary number of processors. The price we have
-  to be is the lack of costing any communication properly. In short,
-  GrAnSim-light is meant to reveal the maximal parallelism in a program.
-  From an implementation point of view the important thing is: {\em
-  GrAnSim-light does not maintain global-addresses}.  */
-
-/* ga_to_proc returns the first processor marked in the bitmask ga.
-   Normally only one bit in ga should be set. But for PLCs all bits
-   are set. That shouldn't hurt since we only need IS_LOCAL_TO for PLCs */
- 
-//@cindex ga_to_proc
-
-static inline PEs
-ga_to_proc(StgWord ga)
-{
-    PEs i;
-    for (i = 0; i < RtsFlags.GranFlags.proc && !IS_LOCAL_TO(ga, i); i++);
-    ASSERT(i<RtsFlags.GranFlags.proc);
-    return (i);
-}
-
-/* NB: This takes a *node* rather than just a ga as input */
-//@cindex where_is
-PEs
-where_is(StgClosure *node)
-{ return (ga_to_proc(PROCS(node))); }
-
-// debugging only
-//@cindex is_unique
-rtsBool
-is_unique(StgClosure *node)
-{ 
-  PEs i;
-  rtsBool unique = rtsFalse;
-
-  for (i = 0; i < RtsFlags.GranFlags.proc ; i++)
-    if (IS_LOCAL_TO(PROCS(node), i))
-      if (unique)          // exactly 1 instance found so far
-	return rtsFalse;   // found a 2nd instance => not unique
-      else 
-	unique = rtsTrue;  // found 1st instance 
-  ASSERT(unique);          // otherwise returned from within loop
-  return (unique);
-}
-
-//@cindex any_idle
-static inline rtsBool
-any_idle(void) { /* any (map (\ i -> procStatus[i] == Idle)) [0,..,MAX_PROC] */
- PEs i; 
- rtsBool any_idle; 
- for(i=0, any_idle=rtsFalse; 
-     !any_idle && i<RtsFlags.GranFlags.proc; 
-     any_idle = any_idle || procStatus[i] == Idle, i++) 
- {} ;
-}
-
-//@cindex idlers
-static inline nat
-idlers(void) {  /* number of idle PEs */
- PEs i, j; 
- for(i=0, j=0;
-     i<RtsFlags.GranFlags.proc; 
-     j += (procStatus[i] == Idle) ? 1 : 0, i++) 
- {} ;
- return j;
-}
-
-//@node Global Event Queue, Spark queue functions, Global Address Operations, GranSim specific code
-//@subsection Global Event Queue
-/*
-The following routines implement an ADT of an event-queue (FIFO). 
-ToDo: Put that in an own file(?)
-*/
-
-/* Pointer to the global event queue; events are currently malloc'ed */
-rtsEventQ EventHd = NULL;
-
-//@cindex get_next_event
-rtsEvent *
-get_next_event(void)
-{
-  static rtsEventQ entry = NULL;
-
-  if (EventHd == NULL) {
-    barf("No next event. This may be caused by a circular data dependency in the program.");
-  }
-
-  if (entry != NULL)
-    free((char *)entry);
-
-  if (RtsFlags.GranFlags.GranSimStats.Global) {     /* count events */
-    globalGranStats.noOfEvents++;
-    globalGranStats.event_counts[EventHd->evttype]++;
-  }
-
-  entry = EventHd;
-
-  IF_GRAN_DEBUG(event_trace,
-	   print_event(entry));
-
-  EventHd = EventHd->next;
-  return(entry);
-}
-
-/* When getting the time of the next event we ignore CONTINUETHREAD events:
-   we don't want to be interrupted before the end of the current time slice
-   unless there is something important to handle. 
-*/
-//@cindex get_time_of_next_event
-rtsTime
-get_time_of_next_event(void)
-{ 
-  rtsEventQ event = EventHd;
-
-  while (event != NULL && event->evttype==ContinueThread) {
-    event = event->next;
-  }
-  if(event == NULL)
-      return ((rtsTime) 0);
-  else
-      return (event->time);
-}
-
-/* ToDo: replace malloc/free with a free list */
-//@cindex insert_event
-void
-insert_event(newentry)
-rtsEvent *newentry;
-{
-  rtsEventType evttype = newentry->evttype;
-  rtsEvent *event, **prev;
-
-  /* if(evttype >= CONTINUETHREAD1) evttype = CONTINUETHREAD; */
-
-  /* Search the queue and insert at the right point:
-     FINDWORK before everything, CONTINUETHREAD after everything.
-
-     This ensures that we find any available work after all threads have
-     executed the current cycle.  This level of detail would normally be
-     irrelevant, but matters for ridiculously low latencies...
-  */
-
-  /* Changed the ordering: Now FINDWORK comes after everything but 
-     CONTINUETHREAD. This makes sure that a MOVESPARK comes before a 
-     FINDWORK. This is important when a GranSimSparkAt happens and
-     DoAlwaysCreateThreads is turned on. Also important if a GC occurs
-     when trying to build a new thread (see much_spark)  -- HWL 02/96  */
-
-  if(EventHd == NULL)
-    EventHd = newentry;
-  else {
-    for (event = EventHd, prev=(rtsEvent**)&EventHd; 
-	 event != NULL; 
-         prev = (rtsEvent**)&(event->next), event = event->next) {
-      switch (evttype) {
-        case FindWork: if ( event->time < newentry->time ||
-                            ( (event->time == newentry->time) &&
-			      (event->evttype != ContinueThread) ) )
-                         continue;
-                       else
-                         break;
-        case ContinueThread: if ( event->time <= newentry->time )
-			       continue;
-			     else
-                               break;
-        default: if ( event->time < newentry->time || 
-	              ((event->time == newentry->time) &&
-		       (event->evttype == newentry->evttype)) )
-		   continue;
-		 else
-                   break;
-       }
-       /* Insert newentry here (i.e. before event) */
-       *prev = newentry;
-       newentry->next = event;
-       break;
-    }
-    if (event == NULL)
-      *prev = newentry;
-  }
-}
-
-//@cindex new_event
-void
-new_event(proc,creator,time,evttype,tso,node,spark)
-PEs proc, creator;
-rtsTime time;
-rtsEventType evttype;
-StgTSO *tso;
-StgClosure *node;
-rtsSpark *spark;
-{
-  rtsEvent *newentry = (rtsEvent *) stgMallocBytes(sizeof(rtsEvent), "new_event");
-
-  newentry->proc     = proc;
-  newentry->creator  = creator;
-  newentry->time     = time;
-  newentry->evttype  = evttype;
-  newentry->tso      = tso;
-  newentry->node     = node;
-  newentry->spark    = spark;
-  newentry->gc_info  = 0;
-  newentry->next     = NULL;
-
-  insert_event(newentry);
-
-  IF_DEBUG(gran, 
-	   fprintf(stderr, "GRAN: new_event: \n"); 
-	   print_event(newentry));
-}
-
-//@cindex prepend_event
-void
-prepend_event(event)       /* put event at beginning of EventQueue */
-rtsEvent *event;
-{				  /* only used for GC! */
- event->next = EventHd;
- EventHd = event;
-}
-
-//@cindex grab_event
-rtsEventQ
-grab_event(void)             /* undo prepend_event i.e. get the event */
-{			 /* at the head of EventQ but don't free anything */
- rtsEventQ event = EventHd;
-
- if (EventHd == NULL) {
-   barf("No next event (in grab_event). This may be caused by a circular data dependency in the program.");
- }
-
- EventHd = EventHd->next;
- return (event);
-}
-
-//@cindex traverse_eventq_for_gc
-void 
-traverse_eventq_for_gc(void)
-{
- rtsEventQ event = EventHd;
- StgWord bufsize;
- StgClosure *closurep;
- StgTSO *tsop;
- StgPtr buffer, bufptr;
- PEs proc, creator;
-
- /* Traverse eventq and replace every FETCHREPLY by a FETCHNODE for the
-    orig closure (root of packed graph). This means that a graph, which is
-    between processors at the time of GC is fetched again at the time when
-    it would have arrived, had there been no GC. Slightly inaccurate but
-    safe for GC.
-    This is only needed for GUM style fetchng. -- HWL */
- if (!RtsFlags.GranFlags.DoBulkFetching)
-   return;
-
- for(event = EventHd; event!=NULL; event=event->next) {
-   if (event->evttype==FetchReply) {
-     buffer = stgCast(StgPtr,event->node);
-     ASSERT(buffer[PACK_FLAG_LOCN]==MAGIC_PACK_FLAG);  /* It's a pack buffer */
-     bufsize = buffer[PACK_SIZE_LOCN];
-     closurep = stgCast(StgClosure*,buffer[PACK_HDR_SIZE]);
-     tsop = stgCast(StgTSO*,buffer[PACK_TSO_LOCN]);
-     proc = event->proc;
-     creator = event->creator;                 /* similar to unpacking */
-     for (bufptr=buffer+PACK_HDR_SIZE; 
-	  bufptr<(buffer+bufsize);
-	  bufptr++) {
-	 // if ( (INFO_TYPE(INFO_PTR(*bufptr)) == INFO_SPEC_RBH_TYPE) ||
-	 //      (INFO_TYPE(INFO_PTR(*bufptr)) == INFO_GEN_RBH_TYPE) ) {
-	   if ( GET_INFO(stgCast(StgClosure*,bufptr)) ) {
-	     convertFromRBH(stgCast(StgClosure *,bufptr));
-	 }
-     }
-     free(buffer);
-     event->evttype = FetchNode;
-     event->proc    = creator;
-     event->creator = proc;
-     event->node    = closurep;
-     event->tso     = tsop;
-     event->gc_info = 0;
-   }
- }
-}
-
-void
-markEventQueue(void)
-{ 
-  StgClosure *MarkRoot(StgClosure *root); // prototype
-
-  rtsEventQ event = EventHd;
-  nat len;
-
-  /* iterate over eventq and register relevant fields in event as roots */
-  for(event = EventHd, len =  0; event!=NULL; event=event->next, len++) {
-    switch (event->evttype) {
-      case ContinueThread:  
-	event->tso = (StgTSO *)MarkRoot((StgClosure *)event->tso);
-	break;
-      case StartThread: 
-	event->tso = (StgTSO *)MarkRoot((StgClosure *)event->tso);
-	event->node = (StgClosure *)MarkRoot((StgClosure *)event->node);
-	break;
-      case ResumeThread:
-	event->tso = (StgTSO *)MarkRoot((StgClosure *)event->tso);
-	event->node = (StgClosure *)MarkRoot((StgClosure *)event->node);
-	break;
-      case MoveSpark:
-	event->spark->node = (StgClosure *)MarkRoot((StgClosure *)event->spark->node);
-	break;
-      case MoveThread:
-	event->tso = (StgTSO *)MarkRoot((StgClosure *)event->tso);
-	break;
-      case FindWork:
-	break;
-      case FetchNode: 
-	event->tso = (StgTSO *)MarkRoot((StgClosure *)event->tso);
-	event->node = (StgClosure *)MarkRoot((StgClosure *)event->node);
-  	break;
-      case FetchReply:
-	event->tso = (StgTSO *)MarkRoot((StgClosure *)event->tso);
-	if (RtsFlags.GranFlags.DoBulkFetching)
-	  // ToDo: traverse_eventw_for_gc if GUM-Fetching!!! HWL
-	  belch("ghuH: packets in BulkFetching not marked as roots; mayb be fatal");
-	else
-	  event->node = (StgClosure *)MarkRoot((StgClosure *)event->node);
-	break;
-      case GlobalBlock:
-	event->tso = (StgTSO *)MarkRoot((StgClosure *)event->tso);
-	event->node = (StgClosure *)MarkRoot((StgClosure *)event->node);
-	break;
-      case UnblockThread:
-	event->tso = (StgTSO *)MarkRoot((StgClosure *)event->tso);
-	event->node = (StgClosure *)MarkRoot((StgClosure *)event->node);
-	break;
-      default:
-	barf("markEventQueue: trying to mark unknown event @ %p", event);
-    }}
-  IF_DEBUG(gc,
-	   belch("GC: markEventQueue: %d events in queue", len));
-}
-
-/*
-  Prune all ContinueThread events related to tso or node in the eventq.
-  Currently used if a thread leaves STG land with ThreadBlocked status,
-  i.e. it blocked on a closure and has been put on its blocking queue.  It
-  will be reawakended via a call to awakenBlockedQueue. Until then no
-  event effecting this tso should appear in the eventq.  A bit of a hack,
-  because ideally we shouldn't generate such spurious ContinueThread events
-  in the first place.  
-*/
-//@cindex prune_eventq 
-void 
-prune_eventq(tso, node) 
-StgTSO *tso; 
-StgClosure *node; 
-{ rtsEventQ prev = (rtsEventQ)NULL, event = EventHd;
-
-  /* node unused for now */ 
-  ASSERT(node==NULL); 
-  /* tso must be valid, then */
-  ASSERT(tso!=END_TSO_QUEUE);
-  while (event != NULL) {
-    if (event->evttype==ContinueThread && 
-	(event->tso==tso)) {
-      IF_GRAN_DEBUG(event_trace, // ToDo: use another debug flag
-		    belch("prune_eventq: pruning ContinueThread event for TSO %d (%p) on PE %d @ %lx (%p)",
-			  event->tso->id, event->tso, event->proc, event->time, event));
-      if (prev==(rtsEventQ)NULL) { // beginning of eventq
-	EventHd = event->next;
-	free(event); 
-	event = EventHd;
-      } else {
-	prev->next = event->next;
-	free(event); 
-	event = prev->next;
-      }
-    } else { // no pruning necessary; go to next event
-      prev = event;
-      event = event->next;
-    }
-  }
-}
-
-//@cindex print_event
-void
-print_event(event)
-rtsEvent *event;
-{
-  char str_tso[16], str_node[16];
-  StgThreadID tso_id;
-
-  if (event->tso==END_TSO_QUEUE) {
-    strcpy(str_tso, "______");
-    tso_id = 0;
-  } else { 
-    sprintf(str_tso, "%p", event->tso);
-    tso_id = (event->tso==NULL) ? 0 : event->tso->id;
-  }
-  if  (event->node==(StgClosure*)NULL) {
-    strcpy(str_node, "______");
-  } else {
-    sprintf(str_node, "%p", event->node);
-  }
-  // HWL: shouldn't be necessary; ToDo: nuke
-  //str_tso[6]='\0';
-  //str_node[6]='\0';
-
-  if (event==NULL)
-    fprintf(stderr,"Evt: NIL\n");
-  else
-    fprintf(stderr, "Evt: %s (%u), PE %u [%u], Time %lu, TSO %d (%s), Node %s\n", //"Evt: %s (%u), PE %u [%u], Time %u, TSO %s (%#l), Node %s\n",
-	      event_names[event->evttype], event->evttype,
-              event->proc, event->creator, event->time, 
-	      tso_id, str_tso, str_node
-	      /*, event->spark, event->next */ );
-
-}
-
-//@cindex print_eventq
-void
-print_eventq(hd)
-rtsEvent *hd;
-{
-  rtsEvent *x;
-
-  fprintf(stderr,"Event Queue with root at %p:\n", hd);
-  for (x=hd; x!=NULL; x=x->next) {
-    print_event(x);
-  }
-}
-
-/* 
-   Spark queue functions are now all  in Sparks.c!!
-*/
-//@node Scheduling functions, Thread Queue routines, Spark queue functions, GranSim specific code
-//@subsection Scheduling functions
-
-/* 
-   These functions are variants of thread initialisation and therefore
-   related to initThread and friends in Schedule.c. However, they are
-   specific to a GranSim setup in storing more info in the TSO's statistics
-   buffer and sorting the thread queues etc.  
-*/
-
-/*
-   A large portion of startThread deals with maintaining a sorted thread
-   queue, which is needed for the Priority Sparking option. Without that
-   complication the code boils down to FIFO handling.  
-*/
-//@cindex insertThread
-void
-insertThread(tso, proc)
-StgTSO*     tso;
-PEs         proc;
-{
-  StgTSO *prev = NULL, *next = NULL;
-  nat count = 0;
-  rtsBool found = rtsFalse;
-
-  ASSERT(CurrentProc==proc);
-  ASSERT(!is_on_queue(tso,proc));
-  /* Idle proc: put the thread on the run queue
-     same for pri spark and basic version */
-  if (run_queue_hds[proc] == END_TSO_QUEUE)
-    {
-      /* too strong!
-      ASSERT((CurrentProc==MainProc &&   
-	      CurrentTime[MainProc]==0 &&
-	      procStatus[MainProc]==Idle) ||
-	     procStatus[proc]==Starting);
-      */
-      run_queue_hds[proc] = run_queue_tls[proc] = tso;
-
-      CurrentTime[proc] += RtsFlags.GranFlags.Costs.threadqueuetime;
-
-      /* new_event of ContinueThread has been moved to do_the_startthread */
-
-      /* too strong!
-      ASSERT(procStatus[proc]==Idle || 
-             procStatus[proc]==Fishing || 
-             procStatus[proc]==Starting);
-      procStatus[proc] = Busy;
-      */
-      return;
-    }
-
-  if (RtsFlags.GranFlags.Light)
-    GranSimLight_insertThread(tso, proc);
-
-  /* Only for Pri Scheduling: find place where to insert tso into queue */
-  if (RtsFlags.GranFlags.DoPriorityScheduling && tso->gran.pri!=0)
-    /* {add_to_spark_queue}vo' jInIHta'; Qu' wa'DIch yIleghQo' */
-    for (prev = run_queue_hds[proc], next = run_queue_hds[proc]->link, count=0;
-	 (next != END_TSO_QUEUE) && 
-	 !(found = tso->gran.pri >= next->gran.pri);
-	 prev = next, next = next->link, count++) 
-      { 
-       ASSERT((prev!=(StgTSO*)NULL || next==run_queue_hds[proc]) &&
-	      (prev==(StgTSO*)NULL || prev->link==next));
-      }
-
-  ASSERT(!found || next != END_TSO_QUEUE);
-  ASSERT(procStatus[proc]!=Idle);
- 
-  if (found) {
-     /* found can only be rtsTrue if pri scheduling enabled */ 
-     ASSERT(RtsFlags.GranFlags.DoPriorityScheduling);
-     if (RtsFlags.GranFlags.GranSimStats.Global) 
-       globalGranStats.non_end_add_threads++;
-     /* Add tso to ThreadQueue between prev and next */
-     tso->link = next;
-     if ( next == (StgTSO*)END_TSO_QUEUE ) {
-       run_queue_tl = tso;
-     } else {
-       /* no back link for TSO chain */
-     }
-     
-     if ( prev == (StgTSO*)END_TSO_QUEUE ) {
-       /* Never add TSO as first elem of thread queue; the first */
-       /* element should be the one that is currently running -- HWL */
-       IF_DEBUG(gran,
-		belch("GRAN: Qagh: NewThread (w/ PriorityScheduling): Trying to add TSO %p (PRI=%d) as first elem of threadQ (%p) on proc %u (@ %u)\n",
-		    tso, tso->gran.pri, run_queue_hd, proc,
-		    CurrentTime[proc]));
-     } else {
-      prev->link = tso;
-     }
-  } else { /* !found */ /* or not pri sparking! */
-    /* Add TSO to the end of the thread queue on that processor */
-    run_queue_tls[proc]->link = tso;
-    run_queue_tls[proc] = tso;
-  }
-  ASSERT(RtsFlags.GranFlags.DoPriorityScheduling || count==0);
-  CurrentTime[proc] += count * RtsFlags.GranFlags.Costs.pri_sched_overhead +
-                       RtsFlags.GranFlags.Costs.threadqueuetime;
-
-  /* ToDo: check if this is still needed -- HWL 
-  if (RtsFlags.GranFlags.DoThreadMigration)
-    ++SurplusThreads;
-
-  if (RtsFlags.GranFlags.GranSimStats.Full &&
-      !(( event_type == GR_START || event_type == GR_STARTQ) && 
-	RtsFlags.GranFlags.labelling) )
-    DumpRawGranEvent(proc, creator, event_type+1, tso, node, 
-	             tso->gran.sparkname, spark_queue_len(proc));
-  */
-
-# if defined(GRAN_CHECK)
-  /* Check if thread queue is sorted. Only for testing, really!  HWL */
-  if ( RtsFlags.GranFlags.DoPriorityScheduling && 
-       (RtsFlags.GranFlags.Debug.sortedQ) ) {
-    rtsBool sorted = rtsTrue;
-    StgTSO *prev, *next;
-
-    if (run_queue_hds[proc]==END_TSO_QUEUE || 
-	run_queue_hds[proc]->link==END_TSO_QUEUE) {
-      /* just 1 elem => ok */
-    } else {
-      /* Qu' wa'DIch yIleghQo' (ignore first elem)! */
-      for (prev = run_queue_hds[proc]->link, next = prev->link;
-	   (next != END_TSO_QUEUE) ;
-	   prev = next, next = prev->link) {
-	ASSERT((prev!=(StgTSO*)NULL || next==run_queue_hds[proc]) &&
-	       (prev==(StgTSO*)NULL || prev->link==next));
-	sorted = sorted && 
-	         (prev->gran.pri >= next->gran.pri);
-      }
-    }
-    if (!sorted) {
-      fprintf(stderr,"Qagh: THREADQ on PE %d is not sorted:\n",
-	      CurrentProc);
-      G_THREADQ(run_queue_hd,0x1);
-    }
-  }
-# endif
-}
-
-/*
-  insertThread, which is only used for GranSim Light, is similar to
-  startThread in that it adds a TSO to a thread queue. However, it assumes
-  that the thread queue is sorted by local clocks and it inserts the TSO at
-  the right place in the queue. Don't create any event, just insert.  
-*/
-//@cindex GranSimLight_insertThread
-rtsBool
-GranSimLight_insertThread(tso, proc)
-StgTSO* tso;
-PEs proc;
-{
-  StgTSO *prev, *next;
-  nat count = 0;
-  rtsBool found = rtsFalse;
-
-  ASSERT(RtsFlags.GranFlags.Light);
-
-  /* In GrAnSim-Light we always have an idle `virtual' proc.
-     The semantics of the one-and-only thread queue is different here:
-     all threads in the queue are running (each on its own virtual processor);
-     the queue is only needed internally in the simulator to interleave the
-     reductions of the different processors.
-     The one-and-only thread queue is sorted by the local clocks of the TSOs.
-  */
-  ASSERT(run_queue_hds[proc] != END_TSO_QUEUE);
-  ASSERT(tso->link == END_TSO_QUEUE);
-
-  /* If only one thread in queue so far we emit DESCHEDULE in debug mode */
-  if (RtsFlags.GranFlags.GranSimStats.Full &&
-      (RtsFlags.GranFlags.Debug.checkLight) && 
-      (run_queue_hd->link == END_TSO_QUEUE)) {
-    DumpRawGranEvent(proc, proc, GR_DESCHEDULE,
-		     run_queue_hds[proc], (StgClosure*)NULL, 
-		     tso->gran.sparkname, spark_queue_len(proc)); // ToDo: check spar_queue_len
-    // resched = rtsTrue;
-  }
-
-  /* this routine should only be used in a GrAnSim Light setup */
-  /* && CurrentProc must be 0 in GrAnSim Light setup */
-  ASSERT(RtsFlags.GranFlags.Light && CurrentProc==0);
-
-  /* Idle proc; same for pri spark and basic version */
-  if (run_queue_hd==END_TSO_QUEUE)
-    {
-      run_queue_hd = run_queue_tl = tso;
-      /* MAKE_BUSY(CurrentProc); */
-      return rtsTrue;
-    }
-
-  for (prev = run_queue_hds[proc], next = run_queue_hds[proc]->link, count = 0;
-       (next != END_TSO_QUEUE) && 
-       !(found = (tso->gran.clock < next->gran.clock));
-       prev = next, next = next->link, count++) 
-    { 
-       ASSERT((prev!=(StgTSO*)NULL || next==run_queue_hds[proc]) &&
-	      (prev==(StgTSO*)NULL || prev->link==next));
-    }
-
-  /* found can only be rtsTrue if pri sparking enabled */ 
-  if (found) {
-     /* Add tso to ThreadQueue between prev and next */
-     tso->link = next;
-     if ( next == END_TSO_QUEUE ) {
-       run_queue_tls[proc] = tso;
-     } else {
-       /* no back link for TSO chain */
-     }
-     
-     if ( prev == END_TSO_QUEUE ) {
-       run_queue_hds[proc] = tso;
-     } else {
-       prev->link = tso;
-     }
-  } else { /* !found */ /* or not pri sparking! */
-    /* Add TSO to the end of the thread queue on that processor */
-    run_queue_tls[proc]->link = tso;
-    run_queue_tls[proc] = tso;
-  }
-
-  if ( prev == END_TSO_QUEUE ) {        /* new head of queue */
-    new_event(proc, proc, CurrentTime[proc],
-	      ContinueThread,
-	      tso, (StgClosure*)NULL, (rtsSpark*)NULL);
-  }
-  /*
-  if (RtsFlags.GranFlags.GranSimStats.Full && 
-      !(( event_type == GR_START || event_type == GR_STARTQ) && 
-	RtsFlags.GranFlags.labelling) )
-    DumpRawGranEvent(proc, creator, gr_evttype, tso, node,
-		     tso->gran.sparkname, spark_queue_len(proc));
-  */
-  return rtsTrue;
-}
-
-/*
-  endThread is responsible for general clean-up after the thread tso has
-  finished. This includes emitting statistics into the profile etc.  
-*/
-void
-endThread(StgTSO *tso, PEs proc) 
-{
-  ASSERT(procStatus[proc]==Busy);        // coming straight out of STG land
-  ASSERT(tso->what_next==ThreadComplete);
-  // ToDo: prune ContinueThreads for this TSO from event queue
-  DumpEndEvent(proc, tso, rtsFalse /* not mandatory */);
-
-  /* if this was the last thread on this PE then make it Idle */
-  if (run_queue_hds[proc]==END_TSO_QUEUE) {
-    procStatus[CurrentProc] = Idle;
-  }
-}
-
-//@node Thread Queue routines, GranSim functions, Scheduling functions, GranSim specific code
-//@subsection Thread Queue routines
-
-/* 
-   Check whether given tso resides on the run queue of the current processor.
-   Only used for debugging.
-*/
-   
-//@cindex is_on_queue
-rtsBool
-is_on_queue (StgTSO *tso, PEs proc) 
-{
-  StgTSO *t;
-  rtsBool found;
-
-  for (t=run_queue_hds[proc], found=rtsFalse; 
-       t!=END_TSO_QUEUE && !(found = t==tso);
-       t=t->link)
-    /* nothing */ ;
-
-  return found;
-}
-
-/* This routine  is only  used for keeping   a statistics  of thread  queue
-   lengths to evaluate the impact of priority scheduling. -- HWL 
-   {spark_queue_len}vo' jInIHta'
-*/
-//@cindex thread_queue_len
-nat
-thread_queue_len(PEs proc) 
-{
- StgTSO *prev, *next;
- nat len;
-
- for (len = 0, prev = END_TSO_QUEUE, next = run_queue_hds[proc];
-      next != END_TSO_QUEUE; 
-      len++, prev = next, next = prev->link)
-   {}
-
- return (len);
-}
-
-//@node GranSim functions, GranSimLight routines, Thread Queue routines, GranSim specific code
-//@subsection GranSim functions
-
-/* -----------------------------------------------------------------  */
-/* The main event handling functions; called from Schedule.c (schedule) */
-/* -----------------------------------------------------------------  */
- 
-//@cindex do_the_globalblock
-
-void 
-do_the_globalblock(rtsEvent* event)
-{ 
-  PEs proc          = event->proc;        /* proc that requested node */
-  StgTSO *tso       = event->tso;         /* tso that requested node */
-  StgClosure  *node = event->node;        /* requested, remote node */
-
-  IF_DEBUG(gran, fprintf(stderr, "GRAN: doing the GlobalBlock\n"));
-  /* There should be no GLOBALBLOCKs in GrAnSim Light setup */
-  ASSERT(!RtsFlags.GranFlags.Light);
-  /* GlobalBlock events only valid with GUM fetching */
-  ASSERT(RtsFlags.GranFlags.DoBulkFetching);
-
-  IF_GRAN_DEBUG(bq, // globalBlock,
-    if (IS_LOCAL_TO(PROCS(node),proc)) {
-      belch("## Qagh: GlobalBlock: Blocking TSO %d (%p) on LOCAL node %p (PE %d).\n",
-	    tso->id, tso, node, proc);
-    });
-
-  /* CurrentTime[CurrentProc] += RtsFlags.GranFlags.Costs.munpacktime; */
-  if ( blockFetch(tso,proc,node) != 0 )
-    return;                     /* node has become local by now */
-
-#if 0
- ToDo: check whether anything has to be done at all after blockFetch -- HWL
-
-  if (!RtsFlags.GranFlags.DoAsyncFetch) { /* head of queue is next thread */
-    StgTSO* tso = run_queue_hds[proc];       /* awaken next thread */
-    if (tso != (StgTSO*)NULL) {
-      new_event(proc, proc, CurrentTime[proc],
-		ContinueThread,
-		tso, (StgClosure*)NULL, (rtsSpark*)NULL);
-      CurrentTime[proc] += RtsFlags.GranFlags.Costs.threadcontextswitchtime;
-      if (RtsFlags.GranFlags.GranSimStats.Full)
-        DumpRawGranEvent(proc, CurrentProc, GR_SCHEDULE, tso,
-			 (StgClosure*)NULL, tso->gran.sparkname, spark_queue_len(CurrentProc));  // ToDo: check sparkname and spar_queue_len
-      procStatus[proc] = Busy;                  /* might have been fetching */
-    } else {
-      procStatus[proc] = Idle;                     /* no work on proc now */
-    }
-  } else {  /* RtsFlags.GranFlags.DoAsyncFetch i.e. block-on-fetch */
-	      /* other thread is already running */
-	      /* 'oH 'utbe' 'e' vIHar ; I think that's not needed -- HWL 
-	      new_event(proc,proc,CurrentTime[proc],
-		       CONTINUETHREAD,EVENT_TSO(event),
-		       (RtsFlags.GranFlags.DoBulkFetching ? closure :
-		       EVENT_NODE(event)),NULL);
-	      */
-  }
-#endif
-}
-
-//@cindex do_the_unblock
-
-void 
-do_the_unblock(rtsEvent* event) 
-{
-  PEs proc = event->proc,       /* proc that requested node */
-      creator = event->creator; /* proc that requested node */
-  StgTSO* tso = event->tso;     /* tso that requested node */
-  StgClosure* node = event->node;  /* requested, remote node */
-  
-  IF_DEBUG(gran, fprintf(stderr, "GRAN: doing the UnBlock\n"))
-  /* There should be no UNBLOCKs in GrAnSim Light setup */
-  ASSERT(!RtsFlags.GranFlags.Light);
-  /* UnblockThread means either FetchReply has arrived or
-     a blocking queue has been awakened;
-     ToDo: check with assertions
-  ASSERT(procStatus[proc]==Fetching || IS_BLACK_HOLE(event->node));
-  */
-  if (!RtsFlags.GranFlags.DoAsyncFetch) {  /* block-on-fetch */
-    /* We count block-on-fetch as normal block time */    
-    tso->gran.blocktime += CurrentTime[proc] - tso->gran.blockedat;
-    /* Dumping now done when processing the event
-       No costs for contextswitch or thread queueing in this case 
-       if (RtsFlags.GranFlags.GranSimStats.Full)
-         DumpRawGranEvent(proc, CurrentProc, GR_RESUME, tso, 
-                          (StgClosure*)NULL, tso->gran.sparkname, spark_queue_len(CurrentProc));
-    */
-    /* Maybe do this in FetchReply already 
-    if (procStatus[proc]==Fetching)
-      procStatus[proc] = Busy;
-    */
-    /*
-    new_event(proc, proc, CurrentTime[proc],
-	      ContinueThread,
-	      tso, node, (rtsSpark*)NULL);
-    */
-  } else {
-    /* Asynchr comm causes additional costs here: */
-    /* Bring the TSO from the blocked queue into the threadq */
-  }
-  /* In all cases, the UnblockThread causes a ResumeThread to be scheduled */
-  new_event(proc, proc, 
-	    CurrentTime[proc]+RtsFlags.GranFlags.Costs.threadqueuetime,
-	    ResumeThread,
-	    tso, node, (rtsSpark*)NULL);
-}
-
-//@cindex do_the_fetchnode
-
-void
-do_the_fetchnode(rtsEvent* event)
-{
-  PEs proc = event->proc,       /* proc that holds the requested node */
-      creator = event->creator; /* proc that requested node */
-  StgTSO* tso = event->tso;
-  StgClosure* node = event->node;  /* requested, remote node */
-  rtsFetchReturnCode rc;
-
-  ASSERT(CurrentProc==proc);
-  /* There should be no FETCHNODEs in GrAnSim Light setup */
-  ASSERT(!RtsFlags.GranFlags.Light);
-
-  IF_DEBUG(gran, fprintf(stderr, "GRAN: doing the FetchNode\n"));
-
-  CurrentTime[proc] += RtsFlags.GranFlags.Costs.munpacktime;
-
-  /* ToDo: check whether this is the right place for dumping the event */
-  if (RtsFlags.GranFlags.GranSimStats.Full)
-    DumpRawGranEvent(creator, proc, GR_FETCH, tso, node, (StgInt)0, 0);
-
-  do {
-    rc = handleFetchRequest(node, proc, creator, tso);
-    if (rc == OutOfHeap) {                                   /* trigger GC */
-# if defined(GRAN_CHECK)  && defined(GRAN)
-     if (RtsFlags.GcFlags.giveStats)
-       fprintf(RtsFlags.GcFlags.statsFile,"*****   veQ boSwI'  PackNearbyGraph(node %p, tso %p (%d))\n",
-     	        node, tso, tso->id);
-# endif
-     barf("//// do_the_fetchnode: out of heap after handleFetchRequest; ToDo: call GarbageCollect()");
-     prepend_event(event);
-     GarbageCollect(GetRoots, rtsFalse); 
-     // HWL: ToDo: check whether a ContinueThread has to be issued
-     // HWL old: ReallyPerformThreadGC(PACK_HEAP_REQUIRED, rtsFalse);
-# if 0 && defined(GRAN_CHECK)  && defined(GRAN)
-     if (RtsFlags.GcFlags.giveStats) {
-       fprintf(RtsFlags.GcFlags.statsFile,"*****      SAVE_Hp=%p, SAVE_HpLim=%p, PACK_HEAP_REQUIRED=%d\n",
-     	        Hp, HpLim, 0) ; // PACK_HEAP_REQUIRED);  ???
-       fprintf(stderr,"*****      No. of packets so far: %d (total size: %d)\n", 
-     	        globalGranStats.tot_packets, globalGranStats.tot_packet_size);
-     }
-# endif 
-     event = grab_event();
-     // Hp -= PACK_HEAP_REQUIRED; // ???
-
-     /* GC knows that events are special and follows the pointer i.e. */
-     /* events are valid even if they moved. An EXIT is triggered */
-     /* if there is not enough heap after GC. */
-    }
-  } while (rc == OutOfHeap);
-}
-
-//@cindex do_the_fetchreply
-void 
-do_the_fetchreply(rtsEvent* event)
-{
-  PEs proc = event->proc,       /* proc that requested node */
-      creator = event->creator; /* proc that holds the requested node */
-  StgTSO* tso = event->tso;
-  StgClosure* node = event->node;  /* requested, remote node */
-  StgClosure* closure=(StgClosure*)NULL;
-
-  ASSERT(CurrentProc==proc);
-  ASSERT(RtsFlags.GranFlags.DoAsyncFetch || procStatus[proc]==Fetching);
-
-  IF_DEBUG(gran, fprintf(stderr, "GRAN: doing the FetchReply\n"));
-  /* There should be no FETCHREPLYs in GrAnSim Light setup */
-  ASSERT(!RtsFlags.GranFlags.Light);
-
-  /* assign message unpack costs *before* dumping the event */
-  CurrentTime[proc] += RtsFlags.GranFlags.Costs.munpacktime;
-  
-  /* ToDo: check whether this is the right place for dumping the event */
-  if (RtsFlags.GranFlags.GranSimStats.Full)
-    DumpRawGranEvent(proc, creator, GR_REPLY, tso, node, 
-  		      tso->gran.sparkname, spark_queue_len(proc));
-
-  /* THIS SHOULD NEVER HAPPEN 
-     If tso is in the BQ of node this means that it actually entered the 
-     remote closure, due to a missing GranSimFetch at the beginning of the 
-     entry code; therefore, this is actually a faked fetch, triggered from 
-     within GranSimBlock; 
-     since tso is both in the EVQ and the BQ for node, we have to take it out 
-     of the BQ first before we can handle the FetchReply;
-     ToDo: special cases in awakenBlockedQueue, since the BQ magically moved.
-  */
-  if (tso->block_info.closure!=(StgClosure*)NULL) {
-    IF_GRAN_DEBUG(bq,
-		  belch("## ghuH: TSO %d (%p) in FetchReply is blocked on node %p (shouldn't happen AFAIK)",
-			tso->id, tso, node));
-    // unlink_from_bq(tso, node);
-  }
-    
-  if (RtsFlags.GranFlags.DoBulkFetching) {      /* bulk (packet) fetching */
-    rtsPackBuffer *buffer = (rtsPackBuffer*)node;
-    nat size = buffer->size;
-  
-    /* NB: Fetch misses can't occur with GUM fetching, as */
-    /* updatable closure are turned into RBHs and therefore locked */
-    /* for other processors that try to grab them. */
-  
-    closure = UnpackGraph(buffer);
-    CurrentTime[proc] += size * RtsFlags.GranFlags.Costs.munpacktime;
-  } else  // incremental fetching
-      /* Copy or  move node to CurrentProc */
-      if (fetchNode(node, creator, proc)) {
-        /* Fetch has failed i.e. node has been grabbed by another PE */
-        PEs p = where_is(node);
-        rtsTime fetchtime;
-     
-	if (RtsFlags.GranFlags.GranSimStats.Global)
-	  globalGranStats.fetch_misses++;
-
-	IF_GRAN_DEBUG(thunkStealing,
-		 belch("== Qu'vatlh! fetch miss @ %u: node %p is at proc %u (rather than proc %u)\n",
-		       CurrentTime[proc],node,p,creator));
-
-	CurrentTime[CurrentProc] += RtsFlags.GranFlags.Costs.mpacktime;
-	
-	/* Count fetch again !? */
-	++(tso->gran.fetchcount);
-	tso->gran.fetchtime += RtsFlags.GranFlags.Costs.fetchtime;
-        
-	fetchtime = stg_max(CurrentTime[CurrentProc],CurrentTime[p]) +
-		    RtsFlags.GranFlags.Costs.latency;
-	
-	/* Chase the grabbed node */
-	new_event(p, proc, fetchtime,
-		  FetchNode,
-		  tso, node, (rtsSpark*)NULL);
-
-# if 0 && defined(GRAN_CHECK) && defined(GRAN) /* Just for testing */
-       IF_GRAN_DEBUG(blockOnFetch,
-		     BlockedOnFetch[CurrentProc] = tso;) /*-rtsTrue;-*/
-	
-       IF_GRAN_DEBUG(blockOnFetch_sanity,
-		     tso->type |= FETCH_MASK_TSO;)
-# endif
-
-        CurrentTime[proc] += RtsFlags.GranFlags.Costs.mtidytime;
-	
-        return; /* NB: no REPLy has been processed; tso still sleeping */
-    }
-
-    /* -- Qapla'! Fetch has been successful; node is here, now  */
-    ++(event->tso->gran.fetchcount);
-    event->tso->gran.fetchtime += RtsFlags.GranFlags.Costs.fetchtime;
-
-    /* this is now done at the beginning of this routine
-    if (RtsFlags.GranFlags.GranSimStats.Full)
-       DumpRawGranEvent(proc,event->creator, GR_REPLY, event->tso,
-			(RtsFlags.GranFlags.DoBulkFetching ? 
-			       closure : 
-			       event->node),
-                        tso->gran.sparkname, spark_queue_len(proc));
-    */
-
-    ASSERT(OutstandingFetches[proc] > 0);
-    --OutstandingFetches[proc];
-    new_event(proc, proc, CurrentTime[proc],
-	      ResumeThread,
-	      event->tso, (RtsFlags.GranFlags.DoBulkFetching ? 
-			   closure : 
-			   event->node),
-	      (rtsSpark*)NULL);
-}
-
-//@cindex do_the_movethread
-
-void
-do_the_movethread(rtsEvent* event) {
-  PEs proc = event->proc,       /* proc that requested node */
-      creator = event->creator; /* proc that holds the requested node */
-  StgTSO* tso = event->tso;
-
- IF_DEBUG(gran, fprintf(stderr, "GRAN: doing the MoveThread\n"));
-
- ASSERT(CurrentProc==proc);
- /* There should be no MOVETHREADs in GrAnSim Light setup */
- ASSERT(!RtsFlags.GranFlags.Light);
- /* MOVETHREAD events should never occur without -bM */
- ASSERT(RtsFlags.GranFlags.DoThreadMigration);
- /* Bitmask of moved thread should be 0 */
- ASSERT(PROCS(tso)==0);
- ASSERT(procStatus[proc] == Fishing ||
-	RtsFlags.GranFlags.DoAsyncFetch);
- ASSERT(OutstandingFishes[proc]>0);
-
- /* ToDo: exact costs for unpacking the whole TSO  */
- CurrentTime[proc] +=  5l * RtsFlags.GranFlags.Costs.munpacktime;
-
- /* ToDo: check whether this is the right place for dumping the event */
- if (RtsFlags.GranFlags.GranSimStats.Full)
-   DumpRawGranEvent(proc, creator, 
-		    GR_STOLEN, tso, (StgClosure*)NULL, (StgInt)0, 0);
-
- // ToDo: check cost functions
- --OutstandingFishes[proc];
- SET_GRAN_HDR(tso, ThisPE);         // adjust the bitmask for the TSO
- insertThread(tso, proc);
-
- if (procStatus[proc]==Fishing)
-   procStatus[proc] = Idle;
-
- if (RtsFlags.GranFlags.GranSimStats.Global)
-   globalGranStats.tot_TSOs_migrated++;
-}
-
-//@cindex do_the_movespark
-
-void
-do_the_movespark(rtsEvent* event) {
- PEs proc = event->proc,       /* proc that requested spark */
-     creator = event->creator; /* proc that holds the requested spark */
- StgTSO* tso = event->tso;
- rtsSparkQ spark = event->spark;
-
- IF_DEBUG(gran, fprintf(stderr, "GRAN: doing the MoveSpark\n"))
-
- ASSERT(CurrentProc==proc);
- ASSERT(spark!=NULL);
- ASSERT(procStatus[proc] == Fishing ||
-	RtsFlags.GranFlags.DoAsyncFetch);
- ASSERT(OutstandingFishes[proc]>0); 
-
- CurrentTime[proc] += RtsFlags.GranFlags.Costs.munpacktime;
-          
- /* record movement of spark only if spark profiling is turned on */
- if (RtsFlags.GranFlags.GranSimStats.Sparks)
-    DumpRawGranEvent(proc, creator,
-		     SP_ACQUIRED,
-		     tso, spark->node, spark->name, spark_queue_len(proc));
-
- /* global statistics */
- if ( RtsFlags.GranFlags.GranSimStats.Global &&
-      !closure_SHOULD_SPARK(spark->node))
-   globalGranStats.withered_sparks++;
-   /* Not adding the spark to the spark queue would be the right */
-   /* thing here, but it also would be cheating, as this info can't be */
-   /* available in a real system. -- HWL */
-
- --OutstandingFishes[proc];
-
- add_to_spark_queue(spark);
-
- IF_GRAN_DEBUG(randomSteal, // ToDo: spark-distribution flag
-	       print_sparkq_stats());
-
- /* Should we treat stolen sparks specially? Currently, we don't. */
-
- if (procStatus[proc]==Fishing)
-   procStatus[proc] = Idle;
-
- /* add_to_spark_queue will increase the time of the current proc. */
- /*
-   If proc was fishing, it is Idle now with the new spark in its spark
-   pool. This means that the next time handleIdlePEs is called, a local
-   FindWork will be created on this PE to turn the spark into a thread. Of
-   course another PE might steal the spark in the meantime (that's why we
-   are using events rather than inlining all the operations in the first
-   place). */
-}
-
-/*
-  In the Constellation class version of GranSim the semantics of StarThread
-  events has changed. Now, StartThread has to perform 3 basic operations:
-   - create a new thread (previously this was done in ActivateSpark);
-   - insert the thread into the run queue of the current processor
-   - generate a new event for actually running the new thread
-  Note that the insertThread is called via createThread. 
-*/
-  
-//@cindex do_the_startthread
-
-void
-do_the_startthread(rtsEvent *event)
-{
-  PEs proc          = event->proc;        /* proc that requested node */
-  StgTSO *tso       = event->tso;         /* tso that requested node */
-  StgClosure  *node = event->node;        /* requested, remote node */
-  rtsSpark *spark   = event->spark;
-  GranEventType gr_evttype;
-
-  ASSERT(CurrentProc==proc);
-  ASSERT(!RtsFlags.GranFlags.Light || CurrentProc==0);
-  ASSERT(event->evttype == ResumeThread || event->evttype == StartThread);
-  /* if this was called via StartThread: */
-  ASSERT(event->evttype!=StartThread || tso == END_TSO_QUEUE); // not yet created
-  // ToDo: check: ASSERT(event->evttype!=StartThread || procStatus[proc]==Starting);
-  /* if this was called via ResumeThread: */
-  ASSERT(event->evttype!=ResumeThread || 
-	   RtsFlags.GranFlags.DoAsyncFetch ||!is_on_queue(tso,proc)); 
-
-  /* startThread may have been called from the main event handler upon
-     finding either a ResumeThread or a StartThread event; set the
-     gr_evttype (needed for writing to .gr file) accordingly */
-  // gr_evttype = (event->evttype == ResumeThread) ? GR_RESUME : GR_START;
-
-  if ( event->evttype == StartThread ) {
-    GranEventType gr_evttype = (run_queue_hds[proc]==END_TSO_QUEUE) ? 
-                                 GR_START : GR_STARTQ;
-
-    tso = createThread(BLOCK_SIZE_W, spark->gran_info);// implicit insertThread!
-    pushClosure(tso, node);
-
-    // ToDo: fwd info on local/global spark to thread -- HWL
-    // tso->gran.exported =  spark->exported;
-    // tso->gran.locked =   !spark->global;
-    tso->gran.sparkname = spark->name;
-
-    ASSERT(CurrentProc==proc);
-    if (RtsFlags.GranFlags.GranSimStats.Full)
-      DumpGranEvent(gr_evttype,tso);
-
-    CurrentTime[proc] += RtsFlags.GranFlags.Costs.threadcreatetime;
-  } else { // event->evttype == ResumeThread
-    GranEventType gr_evttype = (run_queue_hds[proc]==END_TSO_QUEUE) ? 
-                                 GR_RESUME : GR_RESUMEQ;
-
-    insertThread(tso, proc);
-
-    ASSERT(CurrentProc==proc);
-    if (RtsFlags.GranFlags.GranSimStats.Full)
-      DumpGranEvent(gr_evttype,tso);
-  }
-
-  ASSERT(run_queue_hds[proc]!=END_TSO_QUEUE); // non-empty run queue
-  procStatus[proc] = Busy;
-  /* make sure that this thread is actually run */
-  new_event(proc, proc, 
-	    CurrentTime[proc],
-	    ContinueThread,
-	    tso, node, (rtsSpark*)NULL);
-  
-  /* A wee bit of statistics gathering */
-  if (RtsFlags.GranFlags.GranSimStats.Global) {
-    globalGranStats.tot_add_threads++;
-    globalGranStats.tot_tq_len += thread_queue_len(CurrentProc);
-  }
-
-}
-
-//@cindex do_the_findwork
-void
-do_the_findwork(rtsEvent* event) 
-{
-  PEs proc = event->proc,       /* proc to search for work */
-      creator = event->creator; /* proc that requested work */
-  rtsSparkQ spark = event->spark;
-  /* ToDo: check that this size is safe -- HWL */
-#if 0
- ToDo: check available heap
-
-  nat req_heap = sizeofW(StgTSO) + MIN_STACK_WORDS;
-                 // add this? -- HWL:RtsFlags.ConcFlags.stkChunkSize;
-#endif
-
-  IF_DEBUG(gran, fprintf(stderr, "GRAN: doing the Findwork\n"));
-
-  /* If GUM style fishing is enabled, the contents of the spark field says
-     what to steal (spark(1) or thread(2)); */
-  ASSERT(!(RtsFlags.GranFlags.Fishing && event->spark==(rtsSpark*)0));
-
-  /* Make sure that we have enough heap for creating a new
-     thread. This is a conservative estimate of the required heap.
-     This eliminates special checks for GC around NewThread within
-     ActivateSpark.                                                 */
-
-#if 0
- ToDo: check available heap
-
-  if (Hp + req_heap > HpLim ) {
-    IF_DEBUG(gc, 
-	     belch("GC: Doing GC from within Findwork handling (that's bloody dangerous if you ask me)");)
-      GarbageCollect(GetRoots);
-      // ReallyPerformThreadGC(req_heap, rtsFalse);   old -- HWL
-      Hp -= req_heap;
-      if (procStatus[CurrentProc]==Sparking) 
-	procStatus[CurrentProc]=Idle;
-      return;
-  }
-#endif
-  
-  if ( RtsFlags.GranFlags.DoAlwaysCreateThreads ||
-       RtsFlags.GranFlags.Fishing ||
-       ((procStatus[proc]==Idle || procStatus[proc]==Sparking) &&
-	(RtsFlags.GranFlags.FetchStrategy >= 2 || 
-	 OutstandingFetches[proc] == 0)) ) 
-   {
-    rtsBool found;
-    rtsSparkQ  prev, spark;
-    
-    /* ToDo: check */
-    ASSERT(procStatus[proc]==Sparking ||
-	   RtsFlags.GranFlags.DoAlwaysCreateThreads ||
-	   RtsFlags.GranFlags.Fishing);
-    
-    /* SImmoHwI' yInej! Search spark queue! */
-    /* gimme_spark (event, &found, &spark); */
-    findLocalSpark(event, &found, &spark);
-
-    if (!found) { /* pagh vumwI' */
-      /*
-        If no spark has been found this can mean 2 things:
-	 1/ The FindWork was a fish (i.e. a message sent by another PE) and 
-	    the spark pool of the receiver is empty
-	    --> the fish has to be forwarded to another PE
-         2/ The FindWork was local to this PE (i.e. no communication; in this
-            case creator==proc) and the spark pool of the PE is not empty 
-	    contains only sparks of closures that should not be sparked 
-	    (note: if the spark pool were empty, handleIdlePEs wouldn't have 
-	    generated a FindWork in the first place)
-	    --> the PE has to be made idle to trigger stealing sparks the next
-	        time handleIdlePEs is performed
-      */ 
-
-      ASSERT(pending_sparks_hds[proc]==(rtsSpark*)NULL);
-      if (creator==proc) {
-	/* local FindWork */
-	if (procStatus[proc]==Busy) {
-	  belch("ghuH: PE %d in Busy state while processing local FindWork (spark pool is empty!) @ %lx",
-		proc, CurrentTime[proc]);
-	  procStatus[proc] = Idle;
-	}
-      } else {
-	/* global FindWork i.e. a Fish */
-	ASSERT(RtsFlags.GranFlags.Fishing);
-	/* actually this generates another request from the originating PE */
-	ASSERT(OutstandingFishes[creator]>0);
-	OutstandingFishes[creator]--;
-	/* ToDo: assign costs for sending fish to proc not to creator */
-	stealSpark(creator); /* might steal from same PE; ToDo: fix */
-	ASSERT(RtsFlags.GranFlags.maxFishes!=1 || procStatus[creator] == Fishing);
-	/* any assertions on state of proc possible here? */
-      }
-    } else {
-      /* DaH chu' Qu' yIchen! Now create new work! */ 
-      IF_GRAN_DEBUG(findWork,
-		    belch("+- munching spark %p; creating thread for node %p",
-			  spark, spark->node));
-      activateSpark (event, spark);
-      ASSERT(spark != (rtsSpark*)NULL);
-      spark = delete_from_sparkq (spark, proc, rtsTrue);
-    }
-
-    IF_GRAN_DEBUG(findWork,
-		  belch("+- Contents of spark queues at the end of FindWork @ %lx",
-			CurrentTime[proc]); 
-		  print_sparkq_stats());
-
-    /* ToDo: check ; not valid if GC occurs in ActivateSpark */
-    ASSERT(!found ||
-	    /* forward fish  or */
-	    (proc!=creator ||
-	    /* local spark  or */
-            (proc==creator && procStatus[proc]==Starting)) || 
-	   //(!found && procStatus[proc]==Idle) ||
-	   RtsFlags.GranFlags.DoAlwaysCreateThreads); 
-   } else {
-    IF_GRAN_DEBUG(findWork,
-		  belch("+- RTS refuses to findWork on PE %d @ %lx",
-			proc, CurrentTime[proc]);
-		  belch("  procStatus[%d]=%s, fetch strategy=%d, outstanding fetches[%d]=%d", 
-			proc, proc_status_names[procStatus[proc]],
-			RtsFlags.GranFlags.FetchStrategy, 
-			proc, OutstandingFetches[proc]));
-   }  
-}
- 
-//@node GranSimLight routines, Code for Fetching Nodes, GranSim functions, GranSim specific code
-//@subsection GranSimLight routines
-
-/* 
-   This code is called from the central scheduler after having rgabbed a
-   new event and is only needed for GranSim-Light. It mainly adjusts the
-   ActiveTSO so that all costs that have to be assigned from within the
-   scheduler are assigned to the right TSO. The choice of ActiveTSO depends
-   on the type of event that has been found.  
-*/
-
-void
-GranSimLight_enter_system(event, ActiveTSOp)
-rtsEvent *event;
-StgTSO **ActiveTSOp;
-{
-  StgTSO *ActiveTSO = *ActiveTSOp;
-
-  ASSERT (RtsFlags.GranFlags.Light);
-  
-  /* Restore local clock of the virtual processor attached to CurrentTSO.
-     All costs will be associated to the `virt. proc' on which the tso
-     is living. */
-  if (ActiveTSO != NULL) {                     /* already in system area */
-    ActiveTSO->gran.clock = CurrentTime[CurrentProc];
-    if (RtsFlags.GranFlags.DoFairSchedule)
-      {
-	if (RtsFlags.GranFlags.GranSimStats.Full &&
-	    RtsFlags.GranFlags.Debug.checkLight)
-	  DumpGranEvent(GR_SYSTEM_END,ActiveTSO);
-      }
-  }
-  switch (event->evttype)
-    { 
-    case ContinueThread: 
-    case FindWork:       /* inaccurate this way */
-      ActiveTSO = run_queue_hd;
-      break;
-    case ResumeThread:   
-    case StartThread:
-    case MoveSpark:      /* has tso of virt proc in tso field of event */
-      ActiveTSO = event->tso;
-      break;
-    default: barf("Illegal event type %s (%d) in GrAnSim Light setup\n",
-		  event_names[event->evttype],event->evttype);
-    }
-  CurrentTime[CurrentProc] = ActiveTSO->gran.clock;
-  if (RtsFlags.GranFlags.DoFairSchedule) {
-      if (RtsFlags.GranFlags.GranSimStats.Full &&
-	  RtsFlags.GranFlags.Debug.checkLight)
-	DumpGranEvent(GR_SYSTEM_START,ActiveTSO);
-  }
-}
-
-void
-GranSimLight_leave_system(event, ActiveTSOp)
-rtsEvent *event;
-StgTSO **ActiveTSOp;
-{
-  StgTSO *ActiveTSO = *ActiveTSOp;
-
-  ASSERT(RtsFlags.GranFlags.Light);
-
-  /* Save time of `virt. proc' which was active since last getevent and
-     restore time of `virt. proc' where CurrentTSO is living on. */
-  if(RtsFlags.GranFlags.DoFairSchedule) {
-    if (RtsFlags.GranFlags.GranSimStats.Full &&
-	RtsFlags.GranFlags.Debug.checkLight) // ToDo: clean up flags
-      DumpGranEvent(GR_SYSTEM_END,ActiveTSO);
-  }
-  ActiveTSO->gran.clock = CurrentTime[CurrentProc];
-  ActiveTSO = (StgTSO*)NULL;
-  CurrentTime[CurrentProc] = CurrentTSO->gran.clock;
-  if (RtsFlags.GranFlags.DoFairSchedule /* &&  resched */ ) {
-    // resched = rtsFalse;
-    if (RtsFlags.GranFlags.GranSimStats.Full &&
-	RtsFlags.GranFlags.Debug.checkLight)
-      DumpGranEvent(GR_SCHEDULE,run_queue_hd);
-  }
-  /* 
-     if (TSO_LINK(ThreadQueueHd)!=PrelBase_Z91Z93_closure &&
-     (TimeOfNextEvent == 0 ||
-     TSO_CLOCK(TSO_LINK(ThreadQueueHd))+1000<TimeOfNextEvent)) {
-     new_event(CurrentProc,CurrentProc,TSO_CLOCK(TSO_LINK(ThreadQueueHd))+1000,
-     CONTINUETHREAD,TSO_LINK(ThreadQueueHd),PrelBase_Z91Z93_closure,NULL);
-     TimeOfNextEvent = get_time_of_next_event();
-     }
-  */
-}
-
-//@node Code for Fetching Nodes, Idle PEs, GranSimLight routines, GranSim specific code
-//@subsection Code for Fetching Nodes
-
-/*
-   The following GrAnSim routines simulate the fetching of nodes from a
-   remote processor. We use a 1 word bitmask to indicate on which processor
-   a node is lying. Thus, moving or copying a node from one processor to
-   another just requires an appropriate change in this bitmask (using
-   @SET_GA@).  Additionally, the clocks have to be updated.
-
-   A special case arises when the node that is needed by processor A has
-   been moved from a processor B to a processor C between sending out a
-   @FETCH@ (from A) and its arrival at B. In that case the @FETCH@ has to
-   be forwarded to C. This is simulated by issuing another FetchNode event
-   on processor C with A as creator.
-*/
- 
-/* ngoqvam che' {GrAnSim}! */
-
-/* Fetch node "node" to processor "p" */
-
-//@cindex fetchNode
-
-rtsFetchReturnCode
-fetchNode(node,from,to)
-StgClosure* node;
-PEs from, to;
-{
-  /* In case of RtsFlags.GranFlags.DoBulkFetching this fct should never be 
-     entered! Instead, UnpackGraph is used in ReSchedule */
-  StgClosure* closure;
-
-  ASSERT(to==CurrentProc);
-  /* Should never be entered  in GrAnSim Light setup */
-  ASSERT(!RtsFlags.GranFlags.Light);
-  /* fetchNode should never be entered with DoBulkFetching */
-  ASSERT(!RtsFlags.GranFlags.DoBulkFetching);
-
-  /* Now fetch the node */
-  if (!IS_LOCAL_TO(PROCS(node),from) &&
-      !IS_LOCAL_TO(PROCS(node),to) ) 
-    return NodeHasMoved;
-  
-  if (closure_HNF(node))                /* node already in head normal form? */
-    node->header.gran.procs |= PE_NUMBER(to);           /* Copy node */
-  else
-    node->header.gran.procs = PE_NUMBER(to);            /* Move node */
-
-  return Ok;
-}
-
-/* 
-   Process a fetch request. 
-   
-   Cost of sending a packet of size n = C + P*n
-   where C = packet construction constant, 
-         P = cost of packing one word into a packet
-   [Should also account for multiple packets].
-*/
-
-//@cindex handleFetchRequest
-
-rtsFetchReturnCode
-handleFetchRequest(node,to,from,tso)
-StgClosure* node;   // the node which is requested
-PEs to, from;       // fetch request: from -> to
-StgTSO* tso;        // the tso which needs the node
-{
-  ASSERT(!RtsFlags.GranFlags.Light);
-  /* ToDo: check assertion */
-  ASSERT(OutstandingFetches[from]>0);
-
-  /* probably wrong place; */
-  ASSERT(CurrentProc==to);
-
-  if (IS_LOCAL_TO(PROCS(node), from)) /* Somebody else moved node already => */
-    {                                 /* start tso */
-      IF_GRAN_DEBUG(thunkStealing,
-		    fprintf(stderr,"ghuH: handleFetchRequest entered with local node %p (%s) (PE %d)\n", 
-			    node, info_type(node), from));
-
-      if (RtsFlags.GranFlags.DoBulkFetching) {
-	nat size;
-	rtsPackBuffer *graph;
-
-	/* Create a 1-node-buffer and schedule a FETCHREPLY now */
-	graph = PackOneNode(node, tso, &size); 
-	new_event(from, to, CurrentTime[to],
-		  FetchReply,
-		  tso, (StgClosure *)graph, (rtsSpark*)NULL);
-      } else {
-	new_event(from, to, CurrentTime[to],
-		  FetchReply,
-		  tso, node, (rtsSpark*)NULL);
-      }
-      IF_GRAN_DEBUG(thunkStealing,
-		    belch("== majQa'! closure %p is local on PE %d already (this is a good thing)", node, from));
-      return (NodeIsLocal);
-    }
-  else if (IS_LOCAL_TO(PROCS(node), to) )   /* Is node still here? */
-    {
-      if (RtsFlags.GranFlags.DoBulkFetching) { /* {GUM}vo' ngoqvam vInIHta' */
-	nat size;                              /* (code from GUM) */
-	StgClosure* graph;
-
-	if (IS_BLACK_HOLE(node)) {   /* block on BH or RBH */
-	  new_event(from, to, CurrentTime[to],
-		    GlobalBlock,
-		    tso, node, (rtsSpark*)NULL);
-	  /* Note: blockFetch is done when handling GLOBALBLOCK event; 
-	           make sure the TSO stays out of the run queue */
-          /* When this thread is reawoken it does the usual: it tries to 
-             enter the updated node and issues a fetch if it's remote.
-             It has forgotten that it has sent a fetch already (i.e. a
-             FETCHNODE is swallowed by a BH, leaving the thread in a BQ) */
-          --OutstandingFetches[from];
-
-	  IF_GRAN_DEBUG(thunkStealing,
-			belch("== majQa'! closure %p on PE %d is a BH (demander=PE %d); faking a FMBQ", 
-			      node, to, from));
-	  if (RtsFlags.GranFlags.GranSimStats.Global) {
-	    globalGranStats.tot_FMBQs++;
-	  }
-	  return (NodeIsBH);
-	}
-
-	/* The tso requesting the node is blocked and cannot be on a run queue */
-	ASSERT(!is_on_queue(tso, from));
-	
-	// ToDo: check whether graph is ever used as an rtsPackBuffer!!
-	if ((graph = (StgClosure *)PackNearbyGraph(node, tso, &size, 0)) == NULL) 
-	  return (OutOfHeap);  /* out of heap */
-
-	/* Actual moving/copying of node is done on arrival; see FETCHREPLY */
-	/* Send a reply to the originator */
-	/* ToDo: Replace that by software costs for doing graph packing! */
-	CurrentTime[to] += size * RtsFlags.GranFlags.Costs.mpacktime;
-
-	new_event(from, to,
-		  CurrentTime[to]+RtsFlags.GranFlags.Costs.latency,
-		  FetchReply,
-		  tso, (StgClosure *)graph, (rtsSpark*)NULL);
-        
-	CurrentTime[to] += RtsFlags.GranFlags.Costs.mtidytime;
-	return (Ok);
-      } else {                   /* incremental (single closure) fetching */
-	/* Actual moving/copying of node is done on arrival; see FETCHREPLY */
-	/* Send a reply to the originator */
-	CurrentTime[to] += RtsFlags.GranFlags.Costs.mpacktime;
-
-	new_event(from, to,
-		  CurrentTime[to]+RtsFlags.GranFlags.Costs.latency,
-		  FetchReply,
-		  tso, node, (rtsSpark*)NULL);
-      
-	CurrentTime[to] += RtsFlags.GranFlags.Costs.mtidytime;
-	return (Ok);
-      }
-    }
-  else       /* Qu'vatlh! node has been grabbed by another proc => forward */
-    {    
-      PEs node_loc = where_is(node);
-      rtsTime fetchtime;
-
-      IF_GRAN_DEBUG(thunkStealing,
-		    belch("== Qu'vatlh! node %p has been grabbed by PE %d from PE %d (demander=%d) @ %d\n",
-			  node,node_loc,to,from,CurrentTime[to]));
-      if (RtsFlags.GranFlags.GranSimStats.Global) {
-	globalGranStats.fetch_misses++;
-      }
-
-      /* Prepare FORWARD message to proc p_new */
-      CurrentTime[to] += RtsFlags.GranFlags.Costs.mpacktime;
-      
-      fetchtime = stg_max(CurrentTime[to], CurrentTime[node_loc]) +
-                  RtsFlags.GranFlags.Costs.latency;
-          
-      new_event(node_loc, from, fetchtime,
-		FetchNode,
-		tso, node, (rtsSpark*)NULL);
-
-      CurrentTime[to] += RtsFlags.GranFlags.Costs.mtidytime;
-
-      return (NodeHasMoved);
-    }
-}
-
-/*
-   blockFetch blocks a BlockedFetch node on some kind of black hole.
-
-   Taken from gum/HLComms.lc.   [find a  better  place for that ?] --  HWL  
-
-   {\bf Note:} In GranSim we don't have @FETCHME@ nodes and therefore don't
-   create @FMBQ@'s (FetchMe blocking queues) to cope with global
-   blocking. Instead, non-local TSO are put into the BQ in the same way as
-   local TSOs. However, we have to check if a TSO is local or global in
-   order to account for the latencies involved and for keeping track of the
-   number of fetches that are really going on.  
-*/
-
-//@cindex blockFetch
-
-rtsFetchReturnCode
-blockFetch(tso, proc, bh)
-StgTSO* tso;                        /* TSO which gets blocked */
-PEs proc;                           /* PE where that tso was running */
-StgClosure* bh;                     /* closure to block on (BH, RBH, BQ) */
-{
-  StgInfoTable *info;
-
-  IF_GRAN_DEBUG(bq,
-		fprintf(stderr,"## blockFetch: blocking TSO %p (%d)[PE %d] on node %p (%s) [PE %d]. No graph is packed!\n", 
-		tso, tso->id, proc, bh, info_type(bh), where_is(bh)));
-
-    if (!IS_BLACK_HOLE(bh)) {                      /* catches BHs and RBHs */
-      IF_GRAN_DEBUG(bq,
-		    fprintf(stderr,"## blockFetch: node %p (%s) is not a BH => awakening TSO %p (%d) [PE %u]\n", 
-			    bh, info_type(bh), tso, tso->id, proc));
-
-      /* No BH anymore => immediately unblock tso */
-      new_event(proc, proc, CurrentTime[proc],
-	        UnblockThread,
-                tso, bh, (rtsSpark*)NULL);
-
-      /* Is this always a REPLY to a FETCH in the profile ? */
-      if (RtsFlags.GranFlags.GranSimStats.Full)
-	DumpRawGranEvent(proc, proc, GR_REPLY, tso, bh, (StgInt)0, 0);
-      return (NodeIsNoBH);
-    }
-
-    /* DaH {BQ}Daq Qu' Suq 'e' wISov!
-       Now we know that we have to put the tso into the BQ.
-       2 cases: If block-on-fetch, tso is at head of threadq => 
-                => take it out of threadq and into BQ
-                If reschedule-on-fetch, tso is only pointed to be event
-                => just put it into BQ
-
-    ngoq ngo'!!
-    if (!RtsFlags.GranFlags.DoAsyncFetch) {
-      GranSimBlock(tso, proc, bh);
-    } else {
-      if (RtsFlags.GranFlags.GranSimStats.Full)
-	DumpRawGranEvent(proc, where_is(bh), GR_BLOCK, tso, bh, (StgInt)0, 0);
-      ++(tso->gran.blockcount);
-      tso->gran.blockedat = CurrentTime[proc];
-    }
-    */
-
-    /* after scheduling the GlobalBlock event the TSO is not put into the
-       run queue again; it is only pointed to via the event we are
-       processing now; in GranSim 4.xx there is no difference between
-       synchr and asynchr comm here */
-    ASSERT(!is_on_queue(tso, proc));
-    ASSERT(tso->link == END_TSO_QUEUE);
-
-    GranSimBlock(tso, proc, bh);  /* GranSim statistics gathering */
-
-    /* Now, put tso into BQ (similar to blocking entry codes) */
-    info = get_itbl(bh);
-    switch (info -> type) {
-      case RBH:
-      case BLACKHOLE:
-      case CAF_BLACKHOLE: // ToDo: check whether this is a possibly ITBL here
-      case SE_BLACKHOLE:   // ToDo: check whether this is a possibly ITBL here
-      case SE_CAF_BLACKHOLE:// ToDo: check whether this is a possibly ITBL here
-	/* basically an inlined version of BLACKHOLE_entry -- HWL */
-	/* Change the BLACKHOLE into a BLACKHOLE_BQ */
-	((StgBlockingQueue *)bh)->header.info = &BLACKHOLE_BQ_info;
-	/* Put ourselves on the blocking queue for this black hole */
-	// tso->link=END_TSO_QUEUE;   not necessary; see assertion above
-	((StgBlockingQueue *)bh)->blocking_queue = (StgBlockingQueueElement *)tso;
-	tso->block_info.closure = bh;
-	recordMutable((StgMutClosure *)bh);
-	break;
-
-    case BLACKHOLE_BQ:
-	/* basically an inlined version of BLACKHOLE_BQ_entry -- HWL */
-	tso->link = (StgTSO *) (((StgBlockingQueue*)bh)->blocking_queue); 
-	((StgBlockingQueue*)bh)->blocking_queue = (StgBlockingQueueElement *)tso;
-	recordMutable((StgMutClosure *)bh);
-
-# if 0 && defined(GC_MUT_REQUIRED)
-	ToDo: check whether recordMutable is necessary -- HWL
-	/*
-	 * If we modify a black hole in the old generation, we have to make 
-	 * sure it goes on the mutables list
-	 */
-
-	if (bh <= StorageMgrInfo.OldLim) {
-	    MUT_LINK(bh) = (W_) StorageMgrInfo.OldMutables;
-	    StorageMgrInfo.OldMutables = bh;
-	} else
-	    MUT_LINK(bh) = MUT_NOT_LINKED;
-# endif
-	break;
-
-    case FETCH_ME_BQ:
-	barf("Qagh: FMBQ closure (%p) found in GrAnSim (TSO=%p (%d))\n",
-	     bh, tso, tso->id);
-
-    default:
-	{
-	  G_PRINT_NODE(bh);
-	  barf("Qagh: thought %p was a black hole (IP %p (%s))",
-		  bh, info, info_type(bh));
-	}
-      }
-    return (Ok);
-}
-
-
-//@node Idle PEs, Routines directly called from Haskell world, Code for Fetching Nodes, GranSim specific code
-//@subsection Idle PEs
-
-/*
-   Export work to idle PEs. This function is called from @ReSchedule@
-   before dispatching on the current event. @HandleIdlePEs@ iterates over
-   all PEs, trying to get work for idle PEs. Note, that this is a
-   simplification compared to GUM's fishing model. We try to compensate for
-   that by making the cost for stealing work dependent on the number of
-   idle processors and thereby on the probability with which a randomly
-   sent fish would find work.  
-*/
-
-//@cindex handleIdlePEs
-
-void
-handleIdlePEs(void)
-{
-  PEs p;
-
-  IF_DEBUG(gran, fprintf(stderr, "GRAN: handling Idle PEs\n"))
-
-  /* Should never be entered in GrAnSim Light setup */
-  ASSERT(!RtsFlags.GranFlags.Light);
-
-  /* Could check whether there are idle PEs if it's a cheap check */
-  for (p = 0; p < RtsFlags.GranFlags.proc; p++) 
-    if (procStatus[p]==Idle)  /*  && IS_SPARKING(p) && IS_STARTING(p) */
-      /* First look for local work i.e. examine local spark pool! */
-      if (pending_sparks_hds[p]!=(rtsSpark *)NULL) {
-	new_event(p, p, CurrentTime[p],
-		  FindWork,
-		  (StgTSO*)NULL, (StgClosure*)NULL, (rtsSpark*)NULL);
-	procStatus[p] = Sparking;
-      } else if ((RtsFlags.GranFlags.maxFishes==0 ||
-		  OutstandingFishes[p]<RtsFlags.GranFlags.maxFishes) ) {
-
-	/* If no local work then try to get remote work! 
-	   Qu' Hopbe' pagh tu'lu'pu'chugh Qu' Hop yISuq ! */
-	if (RtsFlags.GranFlags.DoStealThreadsFirst && 
-	    (RtsFlags.GranFlags.FetchStrategy >= 4 || OutstandingFetches[p] == 0))
-	  {
-	    if (SurplusThreads > 0l)                    /* Steal a thread */
-	      stealThread(p);
-          
-	    if (procStatus[p]!=Idle)
-	      break;
-	  }
-	
-	if (SparksAvail > 0 && 
-	    (RtsFlags.GranFlags.FetchStrategy >= 3 || OutstandingFetches[p] == 0)) /* Steal a spark */
-	  stealSpark(p);
-	
-	if (SurplusThreads > 0 && 
-	    (RtsFlags.GranFlags.FetchStrategy >= 4 || OutstandingFetches[p] == 0)) /* Steal a thread */
-	  stealThread(p);
-      }
-}
-
-/*
-   Steal a spark and schedule moving it to proc. We want to look at PEs in
-   clock order -- most retarded first.  Currently sparks are only stolen
-   from the @ADVISORY_POOL@ never from the @REQUIRED_POOL@. Eventually,
-   this should be changed to first steal from the former then from the
-   latter.
-
-   We model a sort of fishing mechanism by counting the number of sparks
-   and threads we are currently stealing.  */
-
-/* 
-   Return a random nat value in the intervall [from, to) 
-*/
-static nat 
-natRandom(from, to)
-nat from, to;
-{
-  nat r, d;
-
-  ASSERT(from<=to);
-  d = to - from;
-  /* random returns a value in [0, RAND_MAX] */
-  r = (nat) ((float)from + ((float)random()*(float)d)/(float)RAND_MAX);
-  r = (r==to) ? from : r;
-  ASSERT(from<=r && (r<to || from==to));
-  return r;  
-}
-
-/* 
-   Find any PE other than proc. Used for GUM style fishing only.
-*/
-static PEs 
-findRandomPE (proc)
-PEs proc;
-{
-  nat p;
-
-  ASSERT(RtsFlags.GranFlags.Fishing);
-  if (RtsFlags.GranFlags.RandomSteal) {
-    p = natRandom(0,RtsFlags.GranFlags.proc);  /* full range of PEs */
-  } else {
-    p = 0;
-  }
-  IF_GRAN_DEBUG(randomSteal,
-		belch("^^ RANDOM_STEAL (fishing): stealing from PE %d (current proc is %d)",
-		      p, proc));
-    
-  return (PEs)p;
-}
-
-/*
-  Magic code for stealing sparks/threads makes use of global knowledge on
-  spark queues.  
-*/
-static void
-sortPEsByTime (proc, pes_by_time, firstp, np) 
-PEs proc;
-PEs *pes_by_time;
-nat *firstp, *np;
-{
-  PEs p, temp, n, i, j;
-  nat first, upb, r=0, q=0;
-
-  ASSERT(!RtsFlags.GranFlags.Fishing);
-
-#if 0  
-  upb = RtsFlags.GranFlags.proc;            /* full range of PEs */
-
-  if (RtsFlags.GranFlags.RandomSteal) {
-    r = natRandom(0,RtsFlags.GranFlags.proc);  /* full range of PEs */
-  } else {
-    r = 0;
-  }
-#endif
-
-  /* pes_by_time shall contain processors from which we may steal sparks */ 
-  for(n=0, p=0; p < RtsFlags.GranFlags.proc; ++p)
-    if ((proc != p) &&                       // not the current proc
-        (pending_sparks_hds[p] != (rtsSpark *)NULL) && // non-empty spark pool
-        (CurrentTime[p] <= CurrentTime[CurrentProc]))
-      pes_by_time[n++] = p;
-
-  /* sort pes_by_time */
-  for(i=0; i < n; ++i)
-    for(j=i+1; j < n; ++j)
-      if (CurrentTime[pes_by_time[i]] > CurrentTime[pes_by_time[j]]) {
-	rtsTime temp = pes_by_time[i];
-	pes_by_time[i] = pes_by_time[j];
-	pes_by_time[j] = temp;
-      }
-
-  /* Choose random processor to steal spark from; first look at processors */
-  /* that are earlier than the current one (i.e. proc) */
-  for(first=0; 
-      (first < n) && (CurrentTime[pes_by_time[first]] <= CurrentTime[proc]);
-      ++first)
-    /* nothing */ ;
-
-  /* if the assertion below is true we can get rid of first */
-  /* ASSERT(first==n); */
-  /* ToDo: check if first is really needed; find cleaner solution */
-
-  *firstp = first;
-  *np = n;
-}
-
-/* 
-   Steal a spark (piece of work) from any processor and bring it to proc.
-*/
-//@cindex stealSpark
-static rtsBool 
-stealSpark(PEs proc) { stealSomething(proc, rtsTrue, rtsFalse); }
-
-/* 
-   Steal a thread from any processor and bring it to proc i.e. thread migration
-*/
-//@cindex stealThread
-static rtsBool 
-stealThread(PEs proc) { stealSomething(proc, rtsFalse, rtsTrue); }
-
-/* 
-   Steal a spark or a thread and schedule moving it to proc.
-*/
-//@cindex stealSomething
-static rtsBool
-stealSomething(proc, steal_spark, steal_thread)
-PEs proc;                           // PE that needs work (stealer)
-rtsBool steal_spark, steal_thread;  // should a spark and/or thread be stolen
-{
-  PEs p;
-  rtsTime fish_arrival_time;
-  rtsSpark *spark, *prev, *next;
-  rtsBool stolen = rtsFalse;
-
-  ASSERT(steal_spark || steal_thread);
-
-  /* Should never be entered in GrAnSim Light setup */
-  ASSERT(!RtsFlags.GranFlags.Light);
-  ASSERT(!steal_thread || RtsFlags.GranFlags.DoThreadMigration);
-
-  if (!RtsFlags.GranFlags.Fishing) {
-    // ToDo: check if stealing threads is prefered over stealing sparks
-    if (steal_spark) {
-      if (stealSparkMagic(proc))
-	return rtsTrue;
-      else                             // no spark found
-	if (steal_thread)
-	  return stealThreadMagic(proc);
-        else                           // no thread found
-	  return rtsFalse;             
-    } else {                           // ASSERT(steal_thread);
-      return stealThreadMagic(proc);
-    }
-    barf("stealSomething: never reached");
-  }
-
-  /* The rest of this function does GUM style fishing */
-  
-  p = findRandomPE(proc); /* find a random PE other than proc */
-  
-  /* Message packing costs for sending a Fish; qeq jabbI'ID */
-  CurrentTime[proc] += RtsFlags.GranFlags.Costs.mpacktime;
-  
-  /* use another GranEvent for requesting a thread? */
-  if (steal_spark && RtsFlags.GranFlags.GranSimStats.Sparks)
-    DumpRawGranEvent(p, proc, SP_REQUESTED,
-		     (StgTSO*)NULL, (StgClosure *)NULL, (StgInt)0, 0);
-
-  /* time of the fish arrival on the remote PE */
-  fish_arrival_time = CurrentTime[proc] + RtsFlags.GranFlags.Costs.latency;
-  
-  /* Phps use an own Fish event for that? */
-  /* The contents of the spark component is a HACK:
-      1 means give me a spark;
-      2 means give me a thread
-      0 means give me nothing (this should never happen)
-  */
-  new_event(p, proc, fish_arrival_time,
-	    FindWork,
-	    (StgTSO*)NULL, (StgClosure*)NULL, 
-	    (steal_spark ? (rtsSpark*)1 : steal_thread ? (rtsSpark*)2 : (rtsSpark*)0));
-  
-  ++OutstandingFishes[proc];
-  /* only with Async fetching? */
-  if (procStatus[proc]==Idle)  
-    procStatus[proc]=Fishing;
-  
-  /* time needed to clean up buffers etc after sending a message */
-  CurrentTime[proc] += RtsFlags.GranFlags.Costs.mtidytime;
-
-  /* If GUM style fishing stealing always succeeds because it only consists
-     of sending out a fish; of course, when the fish may return
-     empty-handed! */
-  return rtsTrue;
-}
-
-/* 
-   This version of stealing a spark makes use of the global info on all
-   spark pools etc which is not available in a real parallel system.
-   This could be extended to test e.g. the impact of perfect load information.
-*/
-//@cindex stealSparkMagic
-static rtsBool
-stealSparkMagic(proc)
-PEs proc;
-{
-  PEs p=0, i=0, j=0, n=0, first, upb;
-  rtsSpark *spark=NULL, *next;
-  PEs pes_by_time[MAX_PROC];
-  rtsBool stolen = rtsFalse;
-  rtsTime stealtime;
-
-  /* Should never be entered in GrAnSim Light setup */
-  ASSERT(!RtsFlags.GranFlags.Light);
-
-  sortPEsByTime(proc, pes_by_time, &first, &n);
-
-  while (!stolen && n>0) {
-    upb = (first==0) ? n : first;
-    i = natRandom(0,upb);                /* choose a random eligible PE */
-    p = pes_by_time[i];
-
-    IF_GRAN_DEBUG(randomSteal,
-		  belch("^^ stealSparkMagic (random_steal, not fishing): stealing spark from PE %d (current proc is %d)",
-			p, proc));
-      
-    ASSERT(pending_sparks_hds[p]!=(rtsSpark *)NULL); /* non-empty spark pool */
-
-    /* Now go through rtsSparkQ and steal the first eligible spark */
-    
-    spark = pending_sparks_hds[p]; 
-    while (!stolen && spark != (rtsSpark*)NULL)
-      {
-	/* NB: no prev pointer is needed here because all sparks that are not 
-	   chosen are pruned
-	*/
-	if ((procStatus[p]==Idle || procStatus[p]==Sparking || procStatus[p] == Fishing) &&
-	    spark->next==(rtsSpark*)NULL) 
-	  {
-	    /* Be social! Don't steal the only spark of an idle processor 
-	       not {spark} neH yInIH !! */
-	    break; /* next PE */
-	  } 
-	else if (closure_SHOULD_SPARK(spark->node))
-	  {
-	    /* Don't Steal local sparks; 
-	       ToDo: optionally prefer local over global sparks
-	    if (!spark->global) {
-	      prev=spark;
-	      continue;                  next spark
-	    }
-	    */
-	    /* found a spark! */
-
-	    /* Prepare message for sending spark */
-	    CurrentTime[p] += RtsFlags.GranFlags.Costs.mpacktime;
-
-	    if (RtsFlags.GranFlags.GranSimStats.Sparks)
-	      DumpRawGranEvent(p, (PEs)0, SP_EXPORTED,
-			       (StgTSO*)NULL, spark->node,
-			       spark->name, spark_queue_len(p));
-
-	    stealtime = (CurrentTime[p] > CurrentTime[proc] ? 
-			   CurrentTime[p] : 
-			   CurrentTime[proc])
-	                + sparkStealTime();
-
-	    new_event(proc, p /* CurrentProc */, stealtime,
-		      MoveSpark,
-		      (StgTSO*)NULL, spark->node, spark);
-	    
-	    stolen = rtsTrue;
-	    ++OutstandingFishes[proc]; /* no. of sparks currently on the fly */
-	    if (procStatus[proc]==Idle)
-	      procStatus[proc] = Fishing;
-	    ++(spark->global);         /* record that this is a global spark */
-	    ASSERT(SparksAvail>0);
-	    --SparksAvail;            /* on-the-fly sparks are not available */
-	    next = delete_from_sparkq(spark, p, rtsFalse); // don't dispose!
-	    CurrentTime[p] += RtsFlags.GranFlags.Costs.mtidytime;
-	  }
-	else   /* !(closure_SHOULD_SPARK(SPARK_NODE(spark))) */
-	  {
-	   IF_GRAN_DEBUG(checkSparkQ,
-			 belch("^^ pruning spark %p (node %p) in stealSparkMagic",
-			       spark, spark->node));
-
-	    /* if the spark points to a node that should not be sparked,
-	       prune the spark queue at this point */
-	    if (RtsFlags.GranFlags.GranSimStats.Sparks)
-	      DumpRawGranEvent(p, (PEs)0, SP_PRUNED,
-			       (StgTSO*)NULL, spark->node,
-			       spark->name, spark_queue_len(p));
-	    if (RtsFlags.GranFlags.GranSimStats.Global)
-	      globalGranStats.pruned_sparks++;
-	    
-	    ASSERT(SparksAvail>0);
-	    --SparksAvail;
-	    spark = delete_from_sparkq(spark, p, rtsTrue);
-	  }
-	/* unlink spark (may have been freed!) from sparkq;
-	if (prev == NULL) // spark was head of spark queue
-	  pending_sparks_hds[p] = spark->next;
-        else  
-	  prev->next = spark->next;
-	if (spark->next == NULL)
-	  pending_sparks_tls[p] = prev;
-        else  
-	  next->prev = prev;
-	*/
-      }                    /* while ...    iterating over sparkq */
-
-    /* ToDo: assert that PE p still has work left after stealing the spark */
-
-    if (!stolen && (n>0)) {  /* nothing stealable from proc p :( */
-      ASSERT(pes_by_time[i]==p);
-
-      /* remove p from the list (at pos i) */
-      for (j=i; j+1<n; j++)
-	pes_by_time[j] = pes_by_time[j+1];
-      n--;
-      
-      /* update index to first proc which is later (or equal) than proc */
-      for ( ;
-	    (first>0) &&
-	      (CurrentTime[pes_by_time[first-1]]>CurrentTime[proc]);
-	    first--)
-	/* nothing */ ;
-    } 
-  }  /* while ... iterating over PEs in pes_by_time */
-
-  IF_GRAN_DEBUG(randomSteal,
-		if (stolen)
-		  belch("^^ stealSparkMagic: spark %p (node=%p) stolen by PE %d from PE %d (SparksAvail=%d; idlers=%d)",
-		       spark, spark->node, proc, p, 
-		       SparksAvail, idlers());
-		else  
-		  belch("^^ stealSparkMagic: nothing stolen by PE %d (sparkq len after pruning=%d)(SparksAvail=%d; idlers=%d)",
-		        proc, SparksAvail, idlers()));
-
-  if (RtsFlags.GranFlags.GranSimStats.Global &&
-      stolen && (i!=0)) {                          /* only for statistics */
-    globalGranStats.rs_sp_count++;
-    globalGranStats.ntimes_total += n;
-    globalGranStats.fl_total += first;
-    globalGranStats.no_of_steals++;
-  }
-
-  return stolen;
-}
-
-/* 
-   The old stealThread code, which makes use of global info and does not
-   send out fishes.  
-   NB: most of this is the same as in stealSparkMagic;
-       only the pieces specific to processing thread queues are different; 
-       long live polymorphism!  
-*/
-
-//@cindex stealThreadMagic
-static rtsBool
-stealThreadMagic(proc)
-PEs proc;
-{
-  PEs p=0, i=0, j=0, n=0, first, upb;
-  StgTSO *tso=END_TSO_QUEUE;
-  PEs pes_by_time[MAX_PROC];
-  rtsBool stolen = rtsFalse;
-  rtsTime stealtime;
-
-  /* Should never be entered in GrAnSim Light setup */
-  ASSERT(!RtsFlags.GranFlags.Light);
-
-  sortPEsByTime(proc, pes_by_time, &first, &n);
-
-  while (!stolen && n>0) {
-    upb = (first==0) ? n : first;
-    i = natRandom(0,upb);                /* choose a random eligible PE */
-    p = pes_by_time[i];
-
-    IF_GRAN_DEBUG(randomSteal,
-		  belch("^^ stealThreadMagic (random_steal, not fishing): stealing thread from PE %d (current proc is %d)",
-			p, proc));
-      
-    /* Steal the first exportable thread in the runnable queue but
-       never steal the first in the queue for social reasons;
-       not Qu' wa'DIch yInIH !!
-    */
-    /* Would be better to search through queue and have options which of
-       the threads to pick when stealing */
-    if (run_queue_hds[p] == END_TSO_QUEUE) {
-      IF_GRAN_DEBUG(randomSteal,
-		    belch("^^ stealThreadMagic: No thread to steal from PE %d (stealer=PE %d)", 
-			  p, proc));
-    } else {
-      tso = run_queue_hds[p]->link;  /* tso is *2nd* thread in thread queue */
-      /* Found one */
-      stolen = rtsTrue;
-
-      /* update links in queue */
-      run_queue_hds[p]->link = tso->link;
-      if (run_queue_tls[p] == tso)
-	run_queue_tls[p] = run_queue_hds[p];
-      
-      /* ToDo: Turn magic constants into params */
-      
-      CurrentTime[p] += 5l * RtsFlags.GranFlags.Costs.mpacktime;
-      
-      stealtime = (CurrentTime[p] > CurrentTime[proc] ? 
-		   CurrentTime[p] : 
-		   CurrentTime[proc])
-	+ sparkStealTime() 
-	+ 4l * RtsFlags.GranFlags.Costs.additional_latency
-	+ 5l * RtsFlags.GranFlags.Costs.munpacktime;
-
-      /* Move the thread; set bitmask to 0 while TSO is `on-the-fly' */
-      SET_GRAN_HDR(tso,Nowhere /* PE_NUMBER(proc) */); 
-
-      /* Move from one queue to another */
-      new_event(proc, p, stealtime,
-		MoveThread,
-		tso, (StgClosure*)NULL, (rtsSpark*)NULL);
-
-      /* MAKE_BUSY(proc);  not yet; only when thread is in threadq */
-      ++OutstandingFishes[proc];
-      if (procStatus[proc])
-	procStatus[proc] = Fishing;
-      --SurplusThreads;
-
-      if(RtsFlags.GranFlags.GranSimStats.Full)
-	DumpRawGranEvent(p, proc, 
-			 GR_STEALING, 
-			 tso, (StgClosure*)NULL, (StgInt)0, 0);
-      
-      /* costs for tidying up buffer after having sent it */
-      CurrentTime[p] += 5l * RtsFlags.GranFlags.Costs.mtidytime;
-    }
-
-    /* ToDo: assert that PE p still has work left after stealing the spark */
-
-    if (!stolen && (n>0)) {  /* nothing stealable from proc p :( */
-      ASSERT(pes_by_time[i]==p);
-
-      /* remove p from the list (at pos i) */
-      for (j=i; j+1<n; j++)
-	pes_by_time[j] = pes_by_time[j+1];
-      n--;
-      
-      /* update index to first proc which is later (or equal) than proc */
-      for ( ;
-	    (first>0) &&
-	      (CurrentTime[pes_by_time[first-1]]>CurrentTime[proc]);
-	    first--)
-	/* nothing */ ;
-    } 
-  }  /* while ... iterating over PEs in pes_by_time */
-
-  IF_GRAN_DEBUG(randomSteal,
-		if (stolen)
-  		  belch("^^ stealThreadMagic: stolen TSO %d (%p) by PE %d from PE %d (SparksAvail=%d; idlers=%d)",
-		        tso->id, tso, proc, p,
-		        SparksAvail, idlers());
-		else
-		  belch("stealThreadMagic: nothing stolen by PE %d (SparksAvail=%d; idlers=%d)",
-			proc, SparksAvail, idlers()));
-
-  if (RtsFlags.GranFlags.GranSimStats.Global &&
-      stolen && (i!=0)) { /* only for statistics */
-    /* ToDo: more statistics on avg thread queue lenght etc */
-    globalGranStats.rs_t_count++;
-    globalGranStats.no_of_migrates++;
-  }
-
-  return stolen;
-}
-
-//@cindex sparkStealTime
-static rtsTime
-sparkStealTime(void)
-{
-  double fishdelay, sparkdelay, latencydelay;
-  fishdelay =  (double)RtsFlags.GranFlags.proc/2;
-  sparkdelay = fishdelay - 
-          ((fishdelay-1.0)/(double)(RtsFlags.GranFlags.proc-1))*((double)idlers());
-  latencydelay = sparkdelay*((double)RtsFlags.GranFlags.Costs.latency);
-
-  return((rtsTime)latencydelay);
-}
-
-//@node Routines directly called from Haskell world, Emiting profiling info for GrAnSim, Idle PEs, GranSim specific code
-//@subsection Routines directly called from Haskell world
-/* 
-The @GranSim...@ routines in here are directly called via macros from the
-threaded world. 
-
-First some auxiliary routines.
-*/
-
-/* Take the current thread off the thread queue and thereby activate the 
-   next thread. It's assumed that the next ReSchedule after this uses 
-   NEW_THREAD as param. 
-   This fct is called from GranSimBlock and GranSimFetch 
-*/
-
-//@cindex ActivateNextThread
-
-void 
-ActivateNextThread (proc)
-PEs proc;
-{
-  StgTSO *t;
-  /*
-    This routine is entered either via GranSimFetch or via GranSimBlock.
-    It has to prepare the CurrentTSO for being blocked and update the
-    run queue and other statistics on PE proc. The actual enqueuing to the 
-    blocking queue (if coming from GranSimBlock) is done in the entry code 
-    of the BLACKHOLE and BLACKHOLE_BQ closures (see StgMiscClosures.hc).
-  */
-  /* ToDo: add assertions here!! */
-  //ASSERT(run_queue_hds[proc]!=END_TSO_QUEUE);
-
-  // Only necessary if the running thread is at front of the queue
-  // run_queue_hds[proc] = run_queue_hds[proc]->link;
-  ASSERT(CurrentProc==proc);
-  ASSERT(!is_on_queue(CurrentTSO,proc));
-  if (run_queue_hds[proc]==END_TSO_QUEUE) {
-    /* NB: this routine is only entered with asynchr comm (see assertion) */
-    procStatus[proc] = Idle;
-  } else {
-    /* ToDo: check cost assignment */
-    CurrentTime[proc] += RtsFlags.GranFlags.Costs.threadcontextswitchtime;
-    if (RtsFlags.GranFlags.GranSimStats.Full && 
-	(!RtsFlags.GranFlags.Light || RtsFlags.GranFlags.Debug.checkLight)) 
-                                      /* right flag !?? ^^^ */ 
-      DumpRawGranEvent(proc, 0, GR_SCHEDULE, run_queue_hds[proc],
-                       (StgClosure*)NULL, (StgInt)0, 0);
-  }
-}
-
-/* 
-   The following GranSim fcts are stg-called from the threaded world.    
-*/
-
-/* Called from HP_CHK and friends (see StgMacros.h)  */
-//@cindex GranSimAllocate
-void 
-GranSimAllocate(n)
-StgInt n;
-{
-  CurrentTSO->gran.allocs += n;
-  ++(CurrentTSO->gran.basicblocks);
-
-  if (RtsFlags.GranFlags.GranSimStats.Heap) {
-      DumpRawGranEvent(CurrentProc, 0, GR_ALLOC, CurrentTSO,
-                       (StgClosure*)NULL, (StgInt)0, n);
-  }
-  
-  CurrentTSO->gran.exectime += RtsFlags.GranFlags.Costs.heapalloc_cost;
-  CurrentTime[CurrentProc] += RtsFlags.GranFlags.Costs.heapalloc_cost;
-}
-
-/*
-  Subtract the values added above, if a heap check fails and
-  so has to be redone.
-*/
-//@cindex GranSimUnallocate
-void 
-GranSimUnallocate(n)
-StgInt n;
-{
-  CurrentTSO->gran.allocs -= n;
-  --(CurrentTSO->gran.basicblocks);
-  
-  CurrentTSO->gran.exectime -= RtsFlags.GranFlags.Costs.heapalloc_cost;
-  CurrentTime[CurrentProc] -= RtsFlags.GranFlags.Costs.heapalloc_cost;
-}
-
-/* NB: We now inline this code via GRAN_EXEC rather than calling this fct */
-//@cindex GranSimExec
-void 
-GranSimExec(ariths,branches,loads,stores,floats)
-StgWord ariths,branches,loads,stores,floats;
-{
-  StgWord cost = RtsFlags.GranFlags.Costs.arith_cost*ariths + 
-            RtsFlags.GranFlags.Costs.branch_cost*branches + 
-            RtsFlags.GranFlags.Costs.load_cost * loads +
-            RtsFlags.GranFlags.Costs.store_cost*stores + 
-            RtsFlags.GranFlags.Costs.float_cost*floats;
-
-  CurrentTSO->gran.exectime += cost;
-  CurrentTime[CurrentProc] += cost;
-}
-
-/* 
-   Fetch the node if it isn't local
-   -- result indicates whether fetch has been done.
-
-   This is GRIP-style single item fetching.
-*/
-
-//@cindex GranSimFetch
-StgInt 
-GranSimFetch(node /* , liveness_mask */ )
-StgClosure *node;
-/* StgInt liveness_mask; */
-{
-  /* reset the return value (to be checked within STG land) */
-  NeedToReSchedule = rtsFalse;   
-
-  if (RtsFlags.GranFlags.Light) {
-     /* Always reschedule in GrAnSim-Light to prevent one TSO from
-        running off too far 
-     new_event(CurrentProc,CurrentProc,CurrentTime[CurrentProc],
-	      ContinueThread,CurrentTSO,node,NULL);
-     */
-     return(0); 
-  }
-
-  /* Faking an RBH closure:
-     If the bitmask of the closure is 0 then this node is a fake RBH;
-  */
-  if (node->header.gran.procs == Nowhere) {
-    IF_GRAN_DEBUG(bq,
-		  belch("## Found fake RBH (node %p); delaying TSO %d (%p)", 
-			node, CurrentTSO->id, CurrentTSO));
-		  
-    new_event(CurrentProc, CurrentProc, CurrentTime[CurrentProc]+10000,
-	      ContinueThread, CurrentTSO, node, (rtsSpark*)NULL);
-
-    /* Rescheduling (GranSim internal) is necessary */
-    NeedToReSchedule = rtsTrue;
-    
-    return(1); 
-  }
-
-  /* Note: once a node has been fetched, this test will be passed */
-  if (!IS_LOCAL_TO(PROCS(node),CurrentProc))
-    {
-      PEs p = where_is(node);
-      rtsTime fetchtime;
-      
-      IF_GRAN_DEBUG(thunkStealing,
-		    if (p==CurrentProc) 
-		      belch("GranSimFetch: Trying to fetch from own processor%u\n", p););
-      
-      CurrentTime[CurrentProc] += RtsFlags.GranFlags.Costs.mpacktime;
-      /* NB: Fetch is counted on arrival (FetchReply) */
-      
-      fetchtime = stg_max(CurrentTime[CurrentProc],CurrentTime[p]) +
-	RtsFlags.GranFlags.Costs.latency;
-      
-      new_event(p, CurrentProc, fetchtime,
-		FetchNode, CurrentTSO, node, (rtsSpark*)NULL);
-      
-      if (fetchtime<TimeOfNextEvent)
-	TimeOfNextEvent = fetchtime;
-      
-      /* About to block */
-      CurrentTSO->gran.blockedat = CurrentTime[CurrentProc];
-      
-      ++OutstandingFetches[CurrentProc];
-      
-      if (RtsFlags.GranFlags.DoAsyncFetch) 
-	/* if asynchr comm is turned on, activate the next thread in the q */
-	ActivateNextThread(CurrentProc);
-      else
-	procStatus[CurrentProc] = Fetching;
-
-#if 0 
-      /* ToDo: nuke the entire if (anything special for fair schedule?) */
-      if (RtsFlags.GranFlags.DoAsyncFetch) 
-	{
-	  /* Remove CurrentTSO from the queue -- assumes head of queue == CurrentTSO */
-	  if(!RtsFlags.GranFlags.DoFairSchedule)
-	    {
-	      /* now done in do_the_fetchnode 
-	      if (RtsFlags.GranFlags.GranSimStats.Full)
-		DumpRawGranEvent(CurrentProc, p, GR_FETCH, CurrentTSO,
-				 node, (StgInt)0, 0);
-	      */				
-	      ActivateNextThread(CurrentProc);
-              
-# if 0 && defined(GRAN_CHECK)
-	      if (RtsFlags.GranFlags.Debug.blockOnFetch_sanity) {
-		if (TSO_TYPE(CurrentTSO) & FETCH_MASK_TSO) {
-		  fprintf(stderr,"FetchNode: TSO 0x%x has fetch-mask set @ %d\n",
-			  CurrentTSO,CurrentTime[CurrentProc]);
-		  stg_exit(EXIT_FAILURE);
-		} else {
-		  TSO_TYPE(CurrentTSO) |= FETCH_MASK_TSO;
-		}
-	      }
-# endif
-	      CurrentTSO->link = END_TSO_QUEUE;
-	      /* CurrentTSO = END_TSO_QUEUE; */
-	      
-	      /* CurrentTSO is pointed to by the FetchNode event; it is
-		 on no run queue any more */
-	  } else {  /* fair scheduling currently not supported -- HWL */
-	    barf("Asynchr communication is not yet compatible with fair scheduling\n");
-	  }
-	} else {                /* !RtsFlags.GranFlags.DoAsyncFetch */
-	  procStatus[CurrentProc] = Fetching; // ToDo: BlockedOnFetch;
-	  /* now done in do_the_fetchnode 
-	  if (RtsFlags.GranFlags.GranSimStats.Full)
-	    DumpRawGranEvent(CurrentProc, p,
-			     GR_FETCH, CurrentTSO, node, (StgInt)0, 0);
-	  */
-	  IF_GRAN_DEBUG(blockOnFetch, 
-			BlockedOnFetch[CurrentProc] = CurrentTSO;); /*- rtsTrue; -*/
-	}
-#endif /* 0 */
-
-      CurrentTime[CurrentProc] += RtsFlags.GranFlags.Costs.mtidytime;
-      
-      /* Rescheduling (GranSim internal) is necessary */
-      NeedToReSchedule = rtsTrue;
-      
-      return(1); 
-    }
-  return(0);
-}
-
-//@cindex GranSimSpark
-void 
-GranSimSpark(local,node)
-StgInt local;
-StgClosure *node;
-{
-  /* ++SparksAvail;  Nope; do that in add_to_spark_queue */
-  if (RtsFlags.GranFlags.GranSimStats.Sparks)
-    DumpRawGranEvent(CurrentProc, (PEs)0, SP_SPARK,
-		     END_TSO_QUEUE, node, (StgInt)0, spark_queue_len(CurrentProc)-1);
-
-  /* Force the PE to take notice of the spark */
-  if(RtsFlags.GranFlags.DoAlwaysCreateThreads) {
-    new_event(CurrentProc,CurrentProc,CurrentTime[CurrentProc],
-	      FindWork,
-	      END_TSO_QUEUE, (StgClosure*)NULL, (rtsSpark*)NULL);
-    if (CurrentTime[CurrentProc]<TimeOfNextEvent)
-      TimeOfNextEvent = CurrentTime[CurrentProc];
-  }
-
-  if(local)
-    ++CurrentTSO->gran.localsparks;
-  else
-    ++CurrentTSO->gran.globalsparks;
-}
-
-//@cindex GranSimSparkAt
-void 
-GranSimSparkAt(spark,where,identifier)
-rtsSpark *spark;
-StgClosure *where;    /* This should be a node; alternatively could be a GA */
-StgInt identifier;
-{
-  PEs p = where_is(where);
-  GranSimSparkAtAbs(spark,p,identifier);
-}
-
-//@cindex GranSimSparkAtAbs
-void 
-GranSimSparkAtAbs(spark,proc,identifier)
-rtsSpark *spark;
-PEs proc;        
-StgInt identifier;
-{
-  rtsTime exporttime;
-
-  if (spark == (rtsSpark *)NULL) /* Note: Granularity control might have */
-    return;                          /* turned a spark into a NULL. */
-
-  /* ++SparksAvail; Nope; do that in add_to_spark_queue */
-  if(RtsFlags.GranFlags.GranSimStats.Sparks)
-    DumpRawGranEvent(proc,0,SP_SPARKAT,
-		     END_TSO_QUEUE, spark->node, (StgInt)0, spark_queue_len(proc));
-
-  if (proc!=CurrentProc) {
-    CurrentTime[CurrentProc] += RtsFlags.GranFlags.Costs.mpacktime;
-    exporttime = (CurrentTime[proc] > CurrentTime[CurrentProc]? 
-                  CurrentTime[proc]: CurrentTime[CurrentProc])
-                 + RtsFlags.GranFlags.Costs.latency;
-  } else {
-    exporttime = CurrentTime[CurrentProc];
-  }
-
-  if ( RtsFlags.GranFlags.Light )
-    /* Need CurrentTSO in event field to associate costs with creating
-       spark even in a GrAnSim Light setup */
-    new_event(proc, CurrentProc, exporttime,
-	      MoveSpark,
-	      CurrentTSO, spark->node, spark);
-  else
-    new_event(proc, CurrentProc, exporttime,
-	      MoveSpark, (StgTSO*)NULL, spark->node, spark);
-  /* Bit of a hack to treat placed sparks the same as stolen sparks */
-  ++OutstandingFishes[proc];
-
-  /* Force the PE to take notice of the spark (FINDWORK is put after a
-     MoveSpark into the sparkq!) */
-  if (RtsFlags.GranFlags.DoAlwaysCreateThreads) {
-    new_event(CurrentProc,CurrentProc,exporttime+1,
-              FindWork,
-	      (StgTSO*)NULL, (StgClosure*)NULL, (rtsSpark*)NULL);
-  }
-
-  if (exporttime<TimeOfNextEvent)
-    TimeOfNextEvent = exporttime;
-
-  if (proc!=CurrentProc) {
-    CurrentTime[CurrentProc] += RtsFlags.GranFlags.Costs.mtidytime;
-    ++CurrentTSO->gran.globalsparks;
-  } else { 
-    ++CurrentTSO->gran.localsparks;
-  }
-}
-
-/* 
-   This function handles local and global blocking.  It's called either
-   from threaded code (RBH_entry, BH_entry etc) or from blockFetch when
-   trying to fetch an BH or RBH 
-*/
-
-//@cindex GranSimBlock
-void 
-GranSimBlock(tso, proc, node)
-StgTSO *tso;
-PEs proc;
-StgClosure *node;
-{
-  PEs node_proc = where_is(node), 
-      tso_proc = where_is((StgClosure *)tso);
-
-  ASSERT(tso_proc==CurrentProc);
-  // ASSERT(node_proc==CurrentProc);
-  IF_GRAN_DEBUG(bq,
-		if (node_proc!=CurrentProc) 
-		  belch("## ghuH: TSO %d (%lx) [PE %d] blocks on non-local node %p [PE %d] (no simulation of FETCHMEs)",
-		        tso->id, tso, tso_proc, node, node_proc)); 
-  ASSERT(tso->link==END_TSO_QUEUE);
-  ASSERT(!is_on_queue(tso,proc)); // tso must not be on run queue already!
-  //ASSERT(tso==run_queue_hds[proc]);
-
-  IF_DEBUG(gran,
-	   belch("GRAN: TSO %d (%p) [PE %d] blocks on closure %p @ %lx",
-		 tso->id, tso, proc, node, CurrentTime[proc]));
-
-
-    /* THIS SHOULD NEVER HAPPEN!
-       If tso tries to block on a remote node (i.e. node_proc!=CurrentProc)
-       we have missed a GranSimFetch before entering this closure;
-       we hack around it for now, faking a FetchNode; 
-       because GranSimBlock is entered via a BLACKHOLE(_BQ) closure,
-       tso will be blocked on this closure until the FetchReply occurs.
-
-       ngoq Dogh! 
-
-    if (node_proc!=CurrentProc) {
-      StgInt ret;
-      ret = GranSimFetch(node);
-      IF_GRAN_DEBUG(bq,
-                    if (ret)
-		      belch(".. GranSimBlock: faking a FetchNode of node %p from %d to %d",
-			    node, node_proc, CurrentProc););
-      return;
-    }
-    */
-
-  if (RtsFlags.GranFlags.GranSimStats.Full)
-    DumpRawGranEvent(proc,node_proc,GR_BLOCK,tso,node,(StgInt)0,0);
-
-  ++(tso->gran.blockcount);
-  /* Distinction  between local and global block is made in blockFetch */
-  tso->gran.blockedat = CurrentTime[proc];
-
-  CurrentTime[proc] += RtsFlags.GranFlags.Costs.threadqueuetime;
-  ActivateNextThread(proc);
-  /* tso->link = END_TSO_QUEUE;    not really necessary; only for testing */
-}
-
-#endif /* GRAN */
-
-//@node Index,  , Dumping routines, GranSim specific code
-//@subsection Index
-
-//@index
-//* ActivateNextThread::  @cindex\s-+ActivateNextThread
-//* CurrentProc::  @cindex\s-+CurrentProc
-//* CurrentTime::  @cindex\s-+CurrentTime
-//* GranSimAllocate::  @cindex\s-+GranSimAllocate
-//* GranSimBlock::  @cindex\s-+GranSimBlock
-//* GranSimExec::  @cindex\s-+GranSimExec
-//* GranSimFetch::  @cindex\s-+GranSimFetch
-//* GranSimLight_insertThread::  @cindex\s-+GranSimLight_insertThread
-//* GranSimSpark::  @cindex\s-+GranSimSpark
-//* GranSimSparkAt::  @cindex\s-+GranSimSparkAt
-//* GranSimSparkAtAbs::  @cindex\s-+GranSimSparkAtAbs
-//* GranSimUnallocate::  @cindex\s-+GranSimUnallocate
-//* any_idle::  @cindex\s-+any_idle
-//* blockFetch::  @cindex\s-+blockFetch
-//* do_the_fetchnode::  @cindex\s-+do_the_fetchnode
-//* do_the_fetchreply::  @cindex\s-+do_the_fetchreply
-//* do_the_findwork::  @cindex\s-+do_the_findwork
-//* do_the_globalblock::  @cindex\s-+do_the_globalblock
-//* do_the_movespark::  @cindex\s-+do_the_movespark
-//* do_the_movethread::  @cindex\s-+do_the_movethread
-//* do_the_startthread::  @cindex\s-+do_the_startthread
-//* do_the_unblock::  @cindex\s-+do_the_unblock
-//* fetchNode::  @cindex\s-+fetchNode
-//* ga_to_proc::  @cindex\s-+ga_to_proc
-//* get_next_event::  @cindex\s-+get_next_event
-//* get_time_of_next_event::  @cindex\s-+get_time_of_next_event
-//* grab_event::  @cindex\s-+grab_event
-//* handleFetchRequest::  @cindex\s-+handleFetchRequest
-//* handleIdlePEs::  @cindex\s-+handleIdlePEs
-//* idlers::  @cindex\s-+idlers
-//* insertThread::  @cindex\s-+insertThread
-//* insert_event::  @cindex\s-+insert_event
-//* is_on_queue::  @cindex\s-+is_on_queue
-//* is_unique::  @cindex\s-+is_unique
-//* new_event::  @cindex\s-+new_event
-//* prepend_event::  @cindex\s-+prepend_event
-//* print_event::  @cindex\s-+print_event
-//* print_eventq::  @cindex\s-+print_eventq
-//* prune_eventq ::  @cindex\s-+prune_eventq 
-//* spark queue::  @cindex\s-+spark queue
-//* sparkStealTime::  @cindex\s-+sparkStealTime
-//* stealSomething::  @cindex\s-+stealSomething
-//* stealSpark::  @cindex\s-+stealSpark
-//* stealSparkMagic::  @cindex\s-+stealSparkMagic
-//* stealThread::  @cindex\s-+stealThread
-//* stealThreadMagic::  @cindex\s-+stealThreadMagic
-//* thread_queue_len::  @cindex\s-+thread_queue_len
-//* traverse_eventq_for_gc::  @cindex\s-+traverse_eventq_for_gc
-//* where_is::  @cindex\s-+where_is
-//@end index
diff --git a/ghc/rts/parallel/GranSimRts.h b/ghc/rts/parallel/GranSimRts.h
deleted file mode 100644
index fc31a1f0a6..0000000000
--- a/ghc/rts/parallel/GranSimRts.h
+++ /dev/null
@@ -1,268 +0,0 @@
-/* --------------------------------------------------------------------------
-   Time-stamp: <Tue Mar 06 2001 00:18:30 Stardate: [-30]6285.06 hwloidl>
-
-   Variables and functions specific to GranSim.
-   ----------------------------------------------------------------------- */
-
-#ifndef GRANSIM_RTS_H
-#define GRANSIM_RTS_H
-
-//@node Headers for GranSim objs used only in the RTS internally, , ,
-//@section Headers for GranSim objs used only in the RTS internally
-
-//@menu
-//* Event queue::		
-//* Spark handling routines::	
-//* Processor related stuff::	
-//* Local types::		
-//* Statistics gathering::	
-//* Prototypes::		
-//@end menu
-//*/ fool highlight
-
-//@node Event queue, Spark handling routines, Headers for GranSim objs used only in the RTS internally, Headers for GranSim objs used only in the RTS internally
-//@subsection Event queue
-
-#if defined(GRAN) || defined(PAR)
-/* Granularity event types for output (see DumpGranEvent) */
-typedef enum GranEventType_ {
-    GR_START = 0, GR_STARTQ, 
-    GR_STEALING, GR_STOLEN, GR_STOLENQ, 
-    GR_FETCH, GR_REPLY, GR_BLOCK, GR_RESUME, GR_RESUMEQ,
-    GR_SCHEDULE, GR_DESCHEDULE,
-    GR_END,
-    SP_SPARK, SP_SPARKAT, SP_USED, SP_PRUNED, SP_EXPORTED, SP_ACQUIRED, SP_REQUESTED,
-    GR_ALLOC,
-    GR_TERMINATE,
-    GR_SYSTEM_START, GR_SYSTEM_END,            /* only for debugging */
-    GR_EVENT_MAX
-} GranEventType;
-
-extern char *gran_event_names[];
-#endif
-
-#if defined(GRAN)                                            /* whole file */
-
-/* Event Types (internal use only) */
-typedef enum rtsEventType_ {
- ContinueThread = 0,  /* Continue running the first thread in the queue */
- StartThread,         /* Start a newly created thread */
- ResumeThread,        /* Resume a previously running thread */
- MoveSpark,           /* Move a spark from one PE to another */
- MoveThread,          /* Move a thread from one PE to another */
- FindWork,            /* Search for work */
- FetchNode,           /* Fetch a node */
- FetchReply,          /* Receive a node */
- GlobalBlock,         /* Block a TSO on a remote node */
- UnblockThread        /* Make a TSO runnable */
-} rtsEventType;
-
-/* Number of last event type */
-#define MAX_EVENT       9
- 
-typedef struct rtsEvent_ {
-  PEs           proc;    /* Processor id */
-  PEs           creator; /* Processor id of PE that created the event */
-  rtsEventType  evttype; /* rtsEvent type */
-  rtsTime       time;    /* Time at which event happened */
-  StgTSO       *tso;     /* Associated TSO, if relevant */
-  StgClosure   *node;    /* Associated node, if relevant */
-  rtsSpark     *spark;   /* Associated SPARK, if relevant */
-  StgInt        gc_info; /* Counter of heap objects to mark (used in GC only)*/
-  struct rtsEvent_ *next;
-  } rtsEvent;
-
-typedef rtsEvent *rtsEventQ;
-
-extern rtsEventQ EventHd;
-
-/* Interface for ADT of Event Queue */
-rtsEvent *get_next_event(void);
-rtsTime   get_time_of_next_event(void);
-void      insert_event(rtsEvent *newentry);
-void      new_event(PEs proc, PEs creator, rtsTime time, 
-		    rtsEventType evttype, StgTSO *tso, 
-		    StgClosure *node, rtsSpark *spark);
-void      print_event(rtsEvent *event);
-void      print_eventq(rtsEvent *hd);
-void      prepend_event(rtsEvent *event);
-rtsEventQ grab_event(void);
-void      prune_eventq(StgTSO *tso, StgClosure *node); 
-
-void      traverse_eventq_for_gc(void);
-void      markEventQueue(void);
-
-//@node Spark handling routines, Processor related stuff, Event queue, Headers for GranSim objs used only in the RTS internally
-//@subsection Spark handling routines
-
-/* These functions are only used in the RTS internally; see GranSim.h for rest */
-void 	  disposeSpark(rtsSpark *spark);
-void 	  disposeSparkQ(rtsSparkQ spark);
-void 	  print_spark(rtsSpark *spark);
-void      print_sparkq(PEs proc);
-void 	  print_sparkq_stats(void);
-nat  	  spark_queue_len(PEs proc);
-rtsSpark *delete_from_sparkq (rtsSpark *spark, PEs p, rtsBool dispose_too);
-void      markSparkQueue(void);
-
-//@node Processor related stuff, Local types, Spark handling routines, Headers for GranSim objs used only in the RTS internally
-//@subsection Processor related stuff
-
-typedef enum rtsProcStatus_ {
-  Idle = 0,             /* empty threadq */
-  Sparking,             /* non-empty sparkq; FINDWORK has been issued */
-  Starting,             /* STARTTHREAD has been issue */
-  Fetching,             /* waiting for remote data (only if block-on-fetch) */
-  Fishing,              /* waiting for remote spark/thread */
-  Busy                  /* non-empty threadq, with head of queue active */
-} rtsProcStatus;
-
-/*
-#define IS_IDLE(proc)        (procStatus[proc] == Idle)
-#define IS_SPARKING(proc)    (procStatus[proc] == Sparking)
-#define IS_STARTING(proc)    (procStatus[proc] == Starting)
-#define IS_FETCHING(proc)    (procStatus[proc] == Fetching)
-#define IS_FISHING(proc)     (procStatus[proc] == Fishing)
-#define IS_BUSY(proc)        (procStatus[proc] == Busy)    
-#define ANY_IDLE             (any_idle())
-#define MAKE_IDLE(proc)      procStatus[proc] = Idle
-#define MAKE_SPARKING(proc)  procStatus[proc] = Sparking
-#define MAKE_STARTING(proc)  procStatus[proc] = Starting
-#define MAKE_FETCHING(proc)  procStatus[proc] = Fetching
-#define MAKE_FISHING(proc)   procStatus[proc] = Fishing
-#define MAKE_BUSY(proc)      procStatus[proc] = Busy
-*/
-
-//@node Local types, Statistics gathering, Processor related stuff, Headers for GranSim objs used only in the RTS internally
-//@subsection Local types
-
-/* Return codes of HandleFetchRequest:
-    0 ... ok (FETCHREPLY event with a buffer containing addresses of the 
-              nearby graph has been scheduled)
-    1 ... node is already local (fetched by somebody else; no event is
-                                  scheduled in here)
-    2 ... fetch request has been forwrded to the PE that now contains the
-           node
-    3 ... node is a black hole (BH, BQ or RBH); no event is scheduled, and
-           the current TSO is put into the blocking queue of that node
-    4 ... out of heap in PackNearbyGraph; GC should be triggered in calling
-          function to guarantee that the tso and node inputs are valid
-          (they may be moved during GC).
-   Return codes of blockFetch:
-    0 ... ok; tso is now at beginning of BQ attached to the bh closure
-    1 ... the bh closure is no BH any more; tso is immediately unblocked
-*/
-
-typedef enum rtsFetchReturnCode_ {
-  Ok = 0,
-  NodeIsLocal,
-  NodeHasMoved,
-  NodeIsBH,
-  NodeIsNoBH,
-  OutOfHeap,
-} rtsFetchReturnCode;
-  
-//@node Statistics gathering, Prototypes, Local types, Headers for GranSim objs used only in the RTS internally
-//@subsection Statistics gathering
-
-extern unsigned int /* nat */ OutstandingFetches[], OutstandingFishes[];
-extern rtsProcStatus procStatus[];
-extern StgTSO *BlockedOnFetch[];
-
-/* global structure for collecting statistics */
-typedef struct GlobalGranStats_ {
-  /* event stats */
-  nat noOfEvents;
-  nat event_counts[MAX_EVENT];
-
-  /* communication stats */
-  nat fetch_misses;
-  nat tot_fake_fetches;   // GranSim internal; faked Fetches are a kludge!!
-  nat tot_low_pri_sparks;
-
-  /* load distribution statistics */  
-  nat rs_sp_count, rs_t_count, ntimes_total, fl_total, 
-      no_of_steals, no_of_migrates;
-
-  /* spark queue stats */
-  nat tot_sq_len, tot_sq_probes, tot_sparks;
-  nat tot_add_threads, tot_tq_len, non_end_add_threads;
-
-  /* packet statistics */
-  nat tot_packets, tot_packet_size, tot_cuts, tot_thunks;
-
-  /* thread stats */
-  nat tot_threads_created, threads_created_on_PE[MAX_PROC],
-      tot_TSOs_migrated;
-
-  /* spark stats */
-  nat pruned_sparks, withered_sparks;
-  nat tot_sparks_created, sparks_created_on_PE[MAX_PROC];
-
-  /* scheduling stats */
-  nat tot_yields, tot_stackover, tot_heapover;
-
-  /* blocking queue statistics */
-  rtsTime tot_bq_processing_time;
-  nat tot_bq_len, tot_bq_len_local, tot_awbq, tot_FMBQs;
-} GlobalGranStats;
-
-extern GlobalGranStats globalGranStats;
-
-//@node Prototypes,  , Statistics gathering, Headers for GranSim objs used only in the RTS internally
-//@subsection Prototypes
-
-/* Generally useful fcts */
-PEs where_is(StgClosure *node);
-rtsBool is_unique(StgClosure *node);
-
-/* Prototypes of event handling functions; needed in Schedule.c:ReSchedule() */
-void do_the_globalblock (rtsEvent* event);
-void do_the_unblock (rtsEvent* event);
-void do_the_fetchnode (rtsEvent* event);
-void do_the_fetchreply (rtsEvent* event);
-void do_the_movethread (rtsEvent* event);
-void do_the_movespark (rtsEvent* event);
-void do_the_startthread(rtsEvent *event);
-void do_the_findwork(rtsEvent* event);
-void gimme_spark (rtsEvent *event, rtsBool *found_res, rtsSparkQ *spark_res);
-rtsBool munch_spark (rtsEvent *event, rtsSparkQ spark);
-
-/* GranSimLight routines */
-void GranSimLight_enter_system(rtsEvent *event, StgTSO **ActiveTSOp);
-void GranSimLight_leave_system(rtsEvent *event, StgTSO **ActiveTSOp);
-
-/* Communication related routines */
-rtsFetchReturnCode fetchNode(StgClosure* node, PEs from, PEs to);
-rtsFetchReturnCode handleFetchRequest(StgClosure* node, PEs curr_proc, PEs p, StgTSO* tso);
-void               handleIdlePEs(void);
-
-long int random(void); /* used in stealSpark() and stealThread() in GranSim.c */
-
-/* Scheduling fcts defined in GranSim.c */
-void    insertThread(StgTSO *tso, PEs proc);
-void    endThread(StgTSO *tso, PEs proc);
-rtsBool GranSimLight_insertThread(StgTSO *tso, PEs proc);
-nat     thread_queue_len(PEs proc);
-
-/* For debugging */
-rtsBool is_on_queue (StgTSO *tso, PEs proc);
-#endif
-
-#if defined(GRAN) || defined(PAR)
-/* 
-   Interface for dumping routines (i.e. writing to log file).
-   These routines are shared with GUM (and could also be used for SMP).
-*/
-void DumpGranEvent(GranEventType name, StgTSO *tso);
-void DumpEndEvent(PEs proc, StgTSO *tso, rtsBool mandatory_thread);
-void DumpTSO(StgTSO *tso);
-void DumpRawGranEvent(PEs proc, PEs p, GranEventType name, 
- 	              StgTSO *tso, StgClosure *node, 
-		      StgInt sparkname, StgInt len);
-void DumpVeryRawGranEvent(rtsTime time, PEs proc, PEs p, GranEventType name,
-			  StgTSO *tso, StgClosure *node, 
-			  StgInt sparkname, StgInt len);
-#endif
-
-#endif /* GRANSIM_RTS_H  */
diff --git a/ghc/rts/parallel/HLC.h b/ghc/rts/parallel/HLC.h
deleted file mode 100644
index 793ac840f9..0000000000
--- a/ghc/rts/parallel/HLC.h
+++ /dev/null
@@ -1,63 +0,0 @@
-/* --------------------------------------------------------------------------
-   Time-stamp: <Sun Mar 18 2001 20:16:14 Stardate: [-30]6349.22 hwloidl>
-
-   High Level Communications Header (HLC.h)
-
-   Contains the high-level definitions (i.e. communication
-   subsystem independent) used by GUM
-   Phil Trinder, Glasgow University, 12 December 1994
-   H-W. Loidl, Heriot-Watt, November 1999
-   ----------------------------------------------------------------------- */
-
-#ifndef __HLC_H
-#define __HLC_H
-
-#ifdef PAR
-
-#include "LLC.h"
-
-#define NEW_FISH_AGE           0
-#define NEW_FISH_HISTORY       0
-#define NEW_FISH_HUNGER        0
-#define FISH_LIFE_EXPECTANCY  10
-
-
-//@node GUM Message Sending and Unpacking Functions
-//@subsection GUM Message Sending and Unpacking Functions
-
-rtsBool  initMoreBuffers(void);
-
-void 	 sendFetch (globalAddr *ga, globalAddr *bqga, int load);
-void 	 sendResume(globalAddr *rga, int nelem, rtsPackBuffer *packBuffer);
-void 	 sendAck (GlobalTaskId task, int ngas, globalAddr *gagamap);
-void 	 sendFish (GlobalTaskId destPE, GlobalTaskId origPE, int age, int history, int hunger);
-void 	 sendFree (GlobalTaskId destPE, int nelem, P_ data);
-void 	 sendSchedule(GlobalTaskId origPE, int nelem, rtsPackBuffer *packBuffer);
-void 	 sendReval(GlobalTaskId origPE, int nelem, rtsPackBuffer *data);
-
-//@node Message-Processing Functions
-//@subsection Message-Processing Functions
-
-rtsBool	 processMessages(void);
-void 	 processFetches(void);
-void 	 processTheRealFetches(void);
-
-//@node Miscellaneous Functions
-//@subsection Miscellaneous Functions
-
-void 	 prepareFreeMsgBuffers(void);
-void 	 freeRemoteGA (int pe, globalAddr *ga);
-void 	 sendFreeMessages(void);
-
-GlobalTaskId  choosePE(void);
-StgClosure   *createBlockedFetch (globalAddr ga, globalAddr rga);
-void 	      waitForTermination(void);
-
-/* Message bouncing (startup and shutdown, mainly) */
-void          bounceFish(void);
-void          bounceReval(void);
-
-void          DebugPrintGAGAMap (globalAddr *gagamap, int nGAs);
-
-#endif /* PAR */
-#endif /* __HLC_H */
diff --git a/ghc/rts/parallel/HLComms.c b/ghc/rts/parallel/HLComms.c
deleted file mode 100644
index b0982e441c..0000000000
--- a/ghc/rts/parallel/HLComms.c
+++ /dev/null
@@ -1,1810 +0,0 @@
-/* ----------------------------------------------------------------------------
- * Time-stamp: <Wed Mar 21 2001 16:34:41 Stardate: [-30]6363.45 hwloidl>
- *
- * High Level Communications Routines (HLComms.lc)
- *
- * Contains the high-level routines (i.e. communication
- * subsystem independent) used by GUM
- * 
- * GUM 0.2x: Phil Trinder, Glasgow University, 12 December 1994
- * GUM 3.xx: Phil Trinder, Simon Marlow July 1998
- * GUM 4.xx: H-W. Loidl, Heriot-Watt University, November 1999 -
- * 
- * ------------------------------------------------------------------------- */
-
-#ifdef PAR /* whole file */
-
-//@node High Level Communications Routines, , ,
-//@section High Level Communications Routines
-
-//@menu
-//* Macros etc::		
-//* Includes::			
-//* GUM Message Sending and Unpacking Functions::  
-//* Message-Processing Functions::  
-//* GUM Message Processor::	
-//* Miscellaneous Functions::	
-//* Index::			
-//@end menu
-
-//@node Macros etc, Includes, High Level Communications Routines, High Level Communications Routines
-//@subsection Macros etc
-
-/* Evidently not Posix */
-/* #include "PosixSource.h" */
-
-//@node Includes, GUM Message Sending and Unpacking Functions, Macros etc, High Level Communications Routines
-//@subsection Includes
-
-#include "Rts.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "Storage.h"   // for recordMutable
-#include "HLC.h"
-#include "Parallel.h"
-#include "GranSimRts.h"
-#include "ParallelRts.h"
-#include "Sparks.h"
-#include "FetchMe.h"     // for BLOCKED_FETCH_info etc
-#if defined(DEBUG)
-# include "ParallelDebug.h"
-#endif
-#include "StgMacros.h" // inlined IS_... fcts
-
-#ifdef DIST
-#include "SchedAPI.h" //for createIOThread
-extern unsigned int context_switch; 
-#endif /* DIST */
-
-//@node GUM Message Sending and Unpacking Functions, Message-Processing Functions, Includes, High Level Communications Routines
-//@subsection GUM Message Sending and Unpacking Functions
-
-/*
- * GUM Message Sending and Unpacking Functions
- */
-
-/*
- * Allocate space for message processing
- */
-
-//@cindex gumPackBuffer
-static rtsPackBuffer *gumPackBuffer;
-
-//@cindex initMoreBuffers
-rtsBool
-initMoreBuffers(void)
-{
-  if ((gumPackBuffer = (rtsPackBuffer *)stgMallocWords(RtsFlags.ParFlags.packBufferSize, 
-					     "initMoreBuffers")) == NULL)
-    return rtsFalse;
-  return rtsTrue;
-}
-
-/*
- * SendFetch packs the two global addresses and a load into a message +
- * sends it.  
-
-//@cindex FETCH
-
-   Structure of a FETCH message:
-
-         |    GA 1     |        GA 2          |
-         +------------------------------------+------+
-	 | gtid | slot | weight | gtid | slot | load |
-	 +------------------------------------+------+
- */
-
-//@cindex sendFetch
-void
-sendFetch(globalAddr *rga, globalAddr *lga, int load)
-{
-  ASSERT(rga->weight > 0 && lga->weight > 0);
-  IF_PAR_DEBUG(fetch,
-	       belch("~^** Sending Fetch for ((%x, %d, 0)); locally ((%x, %d, %x)), load = %d", 
-		     rga->payload.gc.gtid, rga->payload.gc.slot, 
-		     lga->payload.gc.gtid, lga->payload.gc.slot, lga->weight,
-		     load));
-
-
-  /* ToDo: Dump event
-  DumpRawGranEvent(CURRENT_PROC, taskIDtoPE(rga->payload.gc.gtid), 
-		   GR_FETCH, CurrentTSO, (StgClosure *)(lga->payload.gc.slot),
-		   0, spark_queue_len(ADVISORY_POOL));
-  */
-
-  sendOpV(PP_FETCH, rga->payload.gc.gtid, 6,
-	  (StgWord) rga->payload.gc.gtid, (StgWord) rga->payload.gc.slot, 
-	  (StgWord) lga->weight, (StgWord) lga->payload.gc.gtid, 
-	  (StgWord) lga->payload.gc.slot, (StgWord) load);
-}
-
-/*
- * unpackFetch unpacks a FETCH message into two Global addresses and a load
- * figure.  
-*/
-
-//@cindex unpackFetch
-static void
-unpackFetch(globalAddr *lga, globalAddr *rga, int *load)
-{
-  long buf[6];
-
-  GetArgs(buf, 6); 
-
-  IF_PAR_DEBUG(fetch,
-	       belch("~^** Unpacking Fetch for ((%x, %d, 0)) to ((%x, %d, %x)), load = %d", 
-		     (GlobalTaskId) buf[0], (int) buf[1], 
-		     (GlobalTaskId) buf[3], (int) buf[4], buf[2], buf[5]));
-
-  lga->weight = 1;
-  lga->payload.gc.gtid = (GlobalTaskId) buf[0];
-  lga->payload.gc.slot = (int) buf[1];
-
-  rga->weight = (unsigned) buf[2];
-  rga->payload.gc.gtid = (GlobalTaskId) buf[3];
-  rga->payload.gc.slot = (int) buf[4];
-
-  *load = (int) buf[5];
-
-  ASSERT(rga->weight > 0);
-}
-
-/*
- * SendResume packs the remote blocking queue's GA and data into a message 
- * and sends it.
-
-//@cindex RESUME
-
-   Structure of a RESUME message:
-
-      -------------------------------
-      | weight | slot | n | data ...
-      -------------------------------
-
-   data is a packed graph represented as an rtsPackBuffer
-   n is the size of the graph (as returned by PackNearbyGraph) + packet hdr size
- */
-
-//@cindex sendResume
-void
-sendResume(globalAddr *rga, int nelem, rtsPackBuffer *packBuffer)
-{
-  IF_PAR_DEBUG(fetch,
-	       belch("~^[] Sending Resume (packet <<%d>> with %d elems) for ((%x, %d, %x)) to [%x]", 
-		     packBuffer->id, nelem,
-		     rga->payload.gc.gtid, rga->payload.gc.slot, rga->weight,
-		     rga->payload.gc.gtid));
-  IF_PAR_DEBUG(packet,
-	       PrintPacket(packBuffer));
-
-  ASSERT(nelem==packBuffer->size);
-  /* check for magic end-of-buffer word */
-  IF_DEBUG(sanity, ASSERT(*(packBuffer->buffer+nelem) == END_OF_BUFFER_MARKER));
-
-  sendOpNV(PP_RESUME, rga->payload.gc.gtid, 
-	   nelem + PACK_BUFFER_HDR_SIZE + DEBUG_HEADROOM, (StgPtr)packBuffer, 
-	   2, (rtsWeight) rga->weight, (StgWord) rga->payload.gc.slot);
-}
-
-/*
- * unpackResume unpacks a Resume message into two Global addresses and
- * a data array.
- */
-
-//@cindex unpackResume
-static void
-unpackResume(globalAddr *lga, int *nelem, rtsPackBuffer *packBuffer)
-{
-    long buf[3];
-
-    GetArgs(buf, 3); 
-
-    /*
-      RESUME event is written in awaken_blocked_queue
-    DumpRawGranEvent(CURRENT_PROC, taskIDtoPE(lga->payload.gc.gtid), 
-		     GR_RESUME, END_TSO_QUEUE, (StgClosure *)NULL, 0, 0);
-    */
-
-    lga->weight = (unsigned) buf[0];
-    lga->payload.gc.gtid = mytid;
-    lga->payload.gc.slot = (int) buf[1];
-
-    *nelem = (int) buf[2] - PACK_BUFFER_HDR_SIZE - DEBUG_HEADROOM;
-    GetArgs(packBuffer, *nelem + PACK_BUFFER_HDR_SIZE + DEBUG_HEADROOM);
-
-    IF_PAR_DEBUG(fetch,
-		 belch("~^[] Unpacking Resume (packet <<%d>> with %d elems) for ((%x, %d, %x))", 
-		       packBuffer->id, *nelem, mytid, (int) buf[1], (unsigned) buf[0]));
-
-    /* check for magic end-of-buffer word */
-    IF_DEBUG(sanity, ASSERT(*(packBuffer->buffer+*nelem) == END_OF_BUFFER_MARKER));
-}
-
-/*
- * SendAck packs the global address being acknowledged, together with
- * an array of global addresses for any closures shipped and sends them.
-
-//@cindex ACK
-
-   Structure of an ACK message:
-
-      |        GA 1          |        GA 2          | 
-      +---------------------------------------------+-------
-      | weight | gtid | slot | weight | gtid | slot |  .....  ngas times
-      + --------------------------------------------+------- 
-
- */
-
-//@cindex sendAck
-void
-sendAck(GlobalTaskId task, int ngas, globalAddr *gagamap)
-{
-  static long *buffer;
-  long *p;
-  int i;
-
-  if(ngas==0)
-    return; //don't send unnecessary messages!!
-  
-  buffer = (long *) gumPackBuffer;
-
-  for(i = 0, p = buffer; i < ngas; i++, p += 6) {
-    ASSERT(gagamap[1].weight > 0);
-    p[0] = (long) gagamap->weight;
-    p[1] = (long) gagamap->payload.gc.gtid;
-    p[2] = (long) gagamap->payload.gc.slot;
-    gagamap++;
-    p[3] = (long) gagamap->weight;
-    p[4] = (long) gagamap->payload.gc.gtid;
-    p[5] = (long) gagamap->payload.gc.slot;
-    gagamap++;
-  }
-  IF_PAR_DEBUG(schedule,
-	       belch("~^,, Sending Ack (%d pairs) to [%x]\n", 
-		     ngas, task));
-
-  sendOpN(PP_ACK, task, p - buffer, (StgPtr)buffer);
-}
-
-/*
- * unpackAck unpacks an Acknowledgement message into a Global address,
- * a count of the number of global addresses following and a map of 
- * Global addresses
- */
-
-//@cindex unpackAck
-static void
-unpackAck(int *ngas, globalAddr *gagamap)
-{
-  long GAarraysize;
-  long buf[6];
-  
-  GetArgs(&GAarraysize, 1);
-  
-  *ngas = GAarraysize / 6;
-  
-  IF_PAR_DEBUG(schedule,
-	       belch("~^,, Unpacking Ack (%d pairs) on [%x]\n", 
-		     *ngas, mytid));
-
-  while (GAarraysize > 0) {
-    GetArgs(buf, 6);
-    gagamap->weight = (rtsWeight) buf[0];
-    gagamap->payload.gc.gtid = (GlobalTaskId) buf[1];
-    gagamap->payload.gc.slot = (int) buf[2];
-    gagamap++;
-    gagamap->weight = (rtsWeight) buf[3];
-    gagamap->payload.gc.gtid = (GlobalTaskId) buf[4];
-    gagamap->payload.gc.slot = (int) buf[5];
-    ASSERT(gagamap->weight > 0);
-    gagamap++;
-    GAarraysize -= 6;
-  }
-}
-
-/*
- * SendFish packs the global address being acknowledged, together with
- * an array of global addresses for any closures shipped and sends them.
-
-//@cindex FISH
-
- Structure of a FISH message:
-
-     +----------------------------------+
-     | orig PE | age | history | hunger |
-     +----------------------------------+
- */
-
-//@cindex sendFish
-void
-sendFish(GlobalTaskId destPE, GlobalTaskId origPE, 
-	 int age, int history, int hunger)
-{
-  IF_PAR_DEBUG(fish,
-	       belch("~^$$ Sending Fish to [%x] (%d outstanding fishes)", 
-		     destPE, outstandingFishes));
-
-  sendOpV(PP_FISH, destPE, 4, 
-	  (StgWord) origPE, (StgWord) age, (StgWord) history, (StgWord) hunger);
-
-  if (origPE == mytid) {
-    //fishing = rtsTrue;
-    outstandingFishes++;
-  }
-}
-
-/*
- * unpackFish unpacks a FISH message into the global task id of the
- * originating PE and 3 data fields: the age, history and hunger of the
- * fish. The history + hunger are not currently used.
-
- */
-
-//@cindex unpackFish
-static void
-unpackFish(GlobalTaskId *origPE, int *age, int *history, int *hunger)
-{
-  long buf[4];
-  
-  GetArgs(buf, 4);
-  
-  IF_PAR_DEBUG(fish,
-	       belch("~^$$ Unpacking Fish from [%x] (age=%d)", 
-		     (GlobalTaskId) buf[0], (int) buf[1]));
-
-  *origPE = (GlobalTaskId) buf[0];
-  *age = (int) buf[1];
-  *history = (int) buf[2];
-  *hunger = (int) buf[3];
-}
-
-/*
- * SendFree sends (weight, slot) pairs for GAs that we no longer need
- * references to.  
-
-//@cindex FREE
-
-   Structure of a FREE message:
-   
-       +-----------------------------
-       | n | weight_1 | slot_1 | ...
-       +-----------------------------
- */
-//@cindex sendFree
-void
-sendFree(GlobalTaskId pe, int nelem, StgPtr data)
-{
-    IF_PAR_DEBUG(free,
-		 belch("~^!! Sending Free (%d GAs) to [%x]", 
-		       nelem/2, pe));
-
-    sendOpN(PP_FREE, pe, nelem, data);
-}
-
-/*
- * unpackFree unpacks a FREE message into the amount of data shipped and
- * a data block.
- */
-//@cindex unpackFree
-static void
-unpackFree(int *nelem, StgWord *data)
-{
-  long buf[1];
-  
-  GetArgs(buf, 1);
-  *nelem = (int) buf[0];
-
-  IF_PAR_DEBUG(free,
-	       belch("~^!! Unpacking Free (%d GAs)", 
-		     *nelem/2));
-
-  GetArgs(data, *nelem);
-}
-
-/*
- * SendSchedule sends a closure to be evaluated in response to a Fish
- * message. The message is directed to the PE that originated the Fish
- * (origPE), and includes the packed closure (data) along with its size
- * (nelem).
-
-//@cindex SCHEDULE
-
-   Structure of a SCHEDULE message:
-
-       +------------------------------------
-       | PE | n | pack buffer of a graph ...
-       +------------------------------------
- */
-//@cindex sendSchedule
-void
-sendSchedule(GlobalTaskId origPE, int nelem, rtsPackBuffer *packBuffer) 
-{
-  IF_PAR_DEBUG(schedule,
-	       belch("~^-- Sending Schedule (packet <<%d>> with %d elems) to [%x]\n", 
-		     packBuffer->id, nelem, origPE));
-  IF_PAR_DEBUG(packet,
-	       PrintPacket(packBuffer));
-
-  ASSERT(nelem==packBuffer->size);
-  /* check for magic end-of-buffer word */
-  IF_DEBUG(sanity, ASSERT(*(packBuffer->buffer+nelem) == END_OF_BUFFER_MARKER));
-
-  sendOpN(PP_SCHEDULE, origPE, 
-	  nelem + PACK_BUFFER_HDR_SIZE + DEBUG_HEADROOM, (StgPtr)packBuffer);
-}
-
-/*
- * unpackSchedule unpacks a SCHEDULE message into the Global address of
- * the closure shipped, the amount of data shipped (nelem) and the data
- * block (data).
- */
-
-//@cindex unpackSchedule
-static void
-unpackSchedule(int *nelem, rtsPackBuffer *packBuffer)
-{
-  long buf[1];
-
-  /* first, just unpack 1 word containing the total size (including header) */
-  GetArgs(buf, 1);
-  /* no. of elems, not counting the header of the pack buffer */
-  *nelem = (int) buf[0] - PACK_BUFFER_HDR_SIZE - DEBUG_HEADROOM;
-
-  /* automatic cast of flat pvm-data to rtsPackBuffer */
-  GetArgs(packBuffer, *nelem + PACK_BUFFER_HDR_SIZE + DEBUG_HEADROOM);
-
-  IF_PAR_DEBUG(schedule,
-	       belch("~^-- Unpacking Schedule (packet <<%d>> with %d elems) on [%x]\n", 
-		     packBuffer->id, *nelem, mytid));
-
-  ASSERT(*nelem==packBuffer->size);
-  /* check for magic end-of-buffer word */
-  IF_DEBUG(sanity, ASSERT(*(packBuffer->buffer+*nelem) == END_OF_BUFFER_MARKER));
-}
-
-#ifdef DIST
-/* sendReval is almost identical to the Schedule version, so we can unpack with unpackSchedule */
-void
-sendReval(GlobalTaskId origPE, int nelem, rtsPackBuffer *packBuffer) 
-{  
-  IF_PAR_DEBUG(schedule,
-	       belch("~^-- Sending Reval (packet <<%d>> with %d elems) to [%x]\n", 
-		     packBuffer->id, nelem, origPE));
-  IF_PAR_DEBUG(packet,
-	       PrintPacket(packBuffer));
-
-  ASSERT(nelem==packBuffer->size);
-  /* check for magic end-of-buffer word */
-  IF_DEBUG(sanity, ASSERT(*(packBuffer->buffer+nelem) == END_OF_BUFFER_MARKER));
-
-  sendOpN(PP_REVAL, origPE, 
-	  nelem + PACK_BUFFER_HDR_SIZE + DEBUG_HEADROOM, (StgPtr)packBuffer);
-}
-
-void FinishReval(StgTSO *t)
-{ StgClosure *res;
-  globalAddr ga;
-  nat size;
-  rtsPackBuffer *buffer=NULL;
-  
-  ga.payload.gc.slot = t->revalSlot;
-  ga.payload.gc.gtid = t->revalTid;
-  ga.weight = 0; 
-  
-  //find where the reval result is
-  res = GALAlookup(&ga);
-  ASSERT(res);
-  
-  IF_PAR_DEBUG(schedule,
-    printGA(&ga);
-    belch(" needs the result %08x\n",res));       
-  
-  //send off the result
-  buffer = PackNearbyGraph(res, END_TSO_QUEUE, &size,ga.payload.gc.gtid);
-  ASSERT(buffer != (rtsPackBuffer *)NULL);
-  sendResume(&ga, size, buffer);
-
-  IF_PAR_DEBUG(schedule,
-    belch("@;~) Reval Finished"));
-}
-
-#endif /* DIST */
-
-//@node Message-Processing Functions, GUM Message Processor, GUM Message Sending and Unpacking Functions, High Level Communications Routines
-//@subsection Message-Processing Functions
-
-/*
- * Message-Processing Functions
- *
- * The following routines process incoming GUM messages. Often reissuing
- * messages in response.
- *
- * processFish unpacks a fish message, reissuing it if it's our own,
- * sending work if we have it or sending it onwards otherwise.
- */
-
-/*
- * processFetches constructs and sends resume messages for every
- * BlockedFetch which is ready to be awakened.
- * awaken_blocked_queue (in Schedule.c) is responsible for moving 
- * BlockedFetches from a blocking queue to the PendingFetches queue.
- */
-void GetRoots(void);
-extern StgBlockedFetch *PendingFetches;
-
-nat
-pending_fetches_len(void)
-{
-  StgBlockedFetch *bf;
-  nat n;
-
-  for (n=0, bf=PendingFetches; bf != END_BF_QUEUE; n++, bf = (StgBlockedFetch *)(bf->link)) {
-    ASSERT(get_itbl(bf)->type==BLOCKED_FETCH);
-  }
-  return n;
-}
-
-//@cindex processFetches
-void
-processFetches(void) {
-  StgBlockedFetch *bf, *next;
-  StgClosure *closure;
-  StgInfoTable *ip;
-  globalAddr rga;
-  static rtsPackBuffer *packBuffer;
-    
-  IF_PAR_DEBUG(verbose,
-	       belch("____ processFetches: %d pending fetches (root @ %p)",
-		     pending_fetches_len(), PendingFetches));
-  
-  for (bf = PendingFetches; 
-       bf != END_BF_QUEUE;
-       bf=next) {
-    /* the PendingFetches list contains only BLOCKED_FETCH closures */
-    ASSERT(get_itbl(bf)->type==BLOCKED_FETCH);
-    /* store link (we might overwrite it via blockFetch later on */
-    next = (StgBlockedFetch *)(bf->link);
-
-    /*
-     * Find the target at the end of the indirection chain, and
-     * process it in much the same fashion as the original target
-     * of the fetch.  Though we hope to find graph here, we could
-     * find a black hole (of any flavor) or even a FetchMe.
-     */
-    closure = bf->node;
-    /*
-      We evacuate BQs and update the node fields where necessary in GC.c
-      So, if we find an EVACUATED closure, something has gone Very Wrong
-      (and therefore we let the RTS crash most ungracefully).
-    */
-    ASSERT(get_itbl(closure)->type != EVACUATED);
-      //  closure = ((StgEvacuated *)closure)->evacuee;
-
-    closure = UNWIND_IND(closure);
-    //while ((ind = IS_INDIRECTION(closure)) != NULL) { closure = ind; }
-
-    ip = get_itbl(closure);
-    if (ip->type == FETCH_ME) {
-      /* Forward the Fetch to someone else */
-      rga.payload.gc.gtid = bf->ga.payload.gc.gtid;
-      rga.payload.gc.slot = bf->ga.payload.gc.slot;
-      rga.weight = bf->ga.weight;
-      
-      sendFetch(((StgFetchMe *)closure)->ga, &rga, 0 /* load */);
-
-      // Global statistics: count no. of fetches
-      if (RtsFlags.ParFlags.ParStats.Global &&
-	  RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	globalParStats.tot_fetch_mess++;
-      }
-
-      IF_PAR_DEBUG(fetch,
-		   belch("__-> processFetches: Forwarding fetch from %lx to %lx",
-			 mytid, rga.payload.gc.gtid));
-
-    } else if (IS_BLACK_HOLE(closure)) {
-      IF_PAR_DEBUG(verbose,
-		   belch("__++ processFetches: trying to send a BLACK_HOLE => doing a blockFetch on closure %p (%s)",
-			 closure, info_type(closure)));
-      bf->node = closure;
-      blockFetch(bf, closure);
-    } else {
-      /* We now have some local graph to send back */
-      nat size;
-
-      packBuffer = gumPackBuffer;
-      IF_PAR_DEBUG(verbose,
-		   belch("__*> processFetches: PackNearbyGraph of closure %p (%s)",
-			 closure, info_type(closure)));
-
-      if ((packBuffer = PackNearbyGraph(closure, END_TSO_QUEUE, &size, bf->ga.payload.gc.gtid)) == NULL) {
-	// Put current BF back on list
-	bf->link = (StgBlockingQueueElement *)PendingFetches;
-	PendingFetches = (StgBlockedFetch *)bf;
-	// ToDo: check that nothing more has to be done to prepare for GC!
-	barf("processFetches: out of heap while packing graph; ToDo: call GC here");
-	GarbageCollect(GetRoots, rtsFalse); 
-	bf = PendingFetches;
-	PendingFetches = (StgBlockedFetch *)(bf->link);
-	closure = bf->node;
-	packBuffer = PackNearbyGraph(closure, END_TSO_QUEUE, &size, bf->ga.payload.gc.gtid);
-	ASSERT(packBuffer != (rtsPackBuffer *)NULL);
-      }
-      rga.payload.gc.gtid = bf->ga.payload.gc.gtid;
-      rga.payload.gc.slot = bf->ga.payload.gc.slot;
-      rga.weight = bf->ga.weight;
-      
-      sendResume(&rga, size, packBuffer);
-
-      // Global statistics: count no. of fetches
-      if (RtsFlags.ParFlags.ParStats.Global &&
-	  RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	globalParStats.tot_resume_mess++;
-      }
-    }
-  }
-  PendingFetches = END_BF_QUEUE;
-}
-
-#if 0
-/*
-  Alternatively to sending fetch messages directly from the FETCH_ME_entry
-  code we could just store the data about the remote data in a global
-  variable and send the fetch request from the main scheduling loop (similar
-  to processFetches above). This would save an expensive STGCALL in the entry 
-  code because we have to go back to the scheduler anyway.
-*/
-//@cindex processFetches
-void
-processTheRealFetches(void) {
-  StgBlockedFetch *bf;
-  StgClosure *closure, *next;
-    
-  IF_PAR_DEBUG(verbose,
-	       belch("__ processTheRealFetches: ");
-	       printGA(&theGlobalFromGA);
-	       printGA(&theGlobalToGA));
-
-  ASSERT(theGlobalFromGA.payload.gc.gtid != 0 &&
-	 theGlobalToGA.payload.gc.gtid != 0);
-
-  /* the old version did this in the FETCH_ME entry code */
-  sendFetch(&theGlobalFromGA, &theGlobalToGA, 0/*load*/);
-  
-}
-#endif
-
-
-/* 
-   Way of dealing with unwanted fish.
-   Used during startup/shutdown, or from unknown PEs 
-*/
-void
-bounceFish(void) { 
-  GlobalTaskId origPE;
-  int age, history, hunger;
-  
-  /* IF_PAR_DEBUG(verbose, */
-	       belch(".... [%x] Bouncing unwanted FISH",mytid);
-
-  unpackFish(&origPE, &age, &history, &hunger);
-	  
-  if (origPE == mytid) {
-    //fishing = rtsFalse;                   // fish has come home
-    outstandingFishes--;
-    last_fish_arrived_at = CURRENT_TIME;  // remember time (see schedule fct)
-    return;                               // that's all
-  }
-
-  /* otherwise, send it home to die */
-  sendFish(origPE, origPE, (age + 1), NEW_FISH_HISTORY, NEW_FISH_HUNGER);
-  // Global statistics: count no. of fetches
-      if (RtsFlags.ParFlags.ParStats.Global &&
-	  RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	globalParStats.tot_fish_mess++;
-      }
-}
-   
-/*
- * processFish unpacks a fish message, reissuing it if it's our own,
- * sending work if we have it or sending it onwards otherwise.
- */
-//@cindex processFish
-static void
-processFish(void)
-{
-  GlobalTaskId origPE;
-  int age, history, hunger;
-  rtsSpark spark;
-  static rtsPackBuffer *packBuffer; 
-
-  unpackFish(&origPE, &age, &history, &hunger);
-
-  if (origPE == mytid) {
-    //fishing = rtsFalse;                   // fish has come home
-    outstandingFishes--;
-    last_fish_arrived_at = CURRENT_TIME;  // remember time (see schedule fct)
-    return;                               // that's all
-  }
-
-  ASSERT(origPE != mytid);
-  IF_PAR_DEBUG(fish,
-	       belch("$$__ processing fish; %d sparks available",
-		     spark_queue_len(&(MainRegTable.rSparks))));
-  while ((spark = findSpark(rtsTrue/*for_export*/)) != NULL) {
-    nat size;
-    // StgClosure *graph;
-
-    packBuffer = gumPackBuffer; 
-    ASSERT(closure_SHOULD_SPARK((StgClosure *)spark));
-    if ((packBuffer = PackNearbyGraph(spark, END_TSO_QUEUE, &size,origPE)) == NULL) {
-      IF_PAR_DEBUG(fish,
-		   belch("$$ GC while trying to satisfy FISH via PackNearbyGraph of node %p",
-			 (StgClosure *)spark));
-      barf("processFish: out of heap while packing graph; ToDo: call GC here");
-      GarbageCollect(GetRoots, rtsFalse);
-      /* Now go back and try again */
-    } else {
-      IF_PAR_DEBUG(verbose,
-		   if (RtsFlags.ParFlags.ParStats.Sparks)
-		     belch("==== STEALING spark %x; sending to %x", spark, origPE));
-      
-      IF_PAR_DEBUG(fish,
-		   belch("$$-- Replying to FISH from %x by sending graph @ %p (%s)",
-			 origPE, 
-			 (StgClosure *)spark, info_type((StgClosure *)spark)));
-      sendSchedule(origPE, size, packBuffer);
-      disposeSpark(spark);
-      // Global statistics: count no. of fetches
-      if (RtsFlags.ParFlags.ParStats.Global &&
-	  RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	globalParStats.tot_schedule_mess++;
-      }
-
-      break;
-    }
-  }
-  if (spark == (rtsSpark)NULL) {
-    IF_PAR_DEBUG(fish,
-		 belch("$$^^ No sparks available for FISH from %x",
-		       origPE));
-    /* We have no sparks to give */
-    if (age < FISH_LIFE_EXPECTANCY) {
-      /* and the fish is atill young, send it to another PE to look for work */
-      sendFish(choosePE(), origPE,
-	       (age + 1), NEW_FISH_HISTORY, NEW_FISH_HUNGER);
-
-      // Global statistics: count no. of fetches
-      if (RtsFlags.ParFlags.ParStats.Global &&
-	  RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	globalParStats.tot_fish_mess++;
-      }
-    } else { /* otherwise, send it home to die */
-      sendFish(origPE, origPE, (age + 1), NEW_FISH_HISTORY, NEW_FISH_HUNGER);
-      // Global statistics: count no. of fetches
-      if (RtsFlags.ParFlags.ParStats.Global &&
-	  RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	globalParStats.tot_fish_mess++;
-      }
-    }
-  }
-}  /* processFish */
-
-/*
- * processFetch either returns the requested data (if available) 
- * or blocks the remote blocking queue on a black hole (if not).
- */
-
-//@cindex processFetch
-static void
-processFetch(void)
-{
-  globalAddr ga, rga;
-  int load;
-  StgClosure *closure;
-  StgInfoTable *ip;
-
-  unpackFetch(&ga, &rga, &load);
-  IF_PAR_DEBUG(fetch,
-	       belch("%%%%__ Rcvd Fetch for ((%x, %d, 0)), Resume ((%x, %d, %x)) (load %d) from %x",
-		     ga.payload.gc.gtid, ga.payload.gc.slot,
-		     rga.payload.gc.gtid, rga.payload.gc.slot, rga.weight, load,
-		     rga.payload.gc.gtid));
-
-  closure = GALAlookup(&ga);
-  ASSERT(closure != (StgClosure *)NULL);
-  ip = get_itbl(closure);
-  if (ip->type == FETCH_ME) {
-    /* Forward the Fetch to someone else */
-    sendFetch(((StgFetchMe *)closure)->ga, &rga, load);
-
-    // Global statistics: count no. of fetches
-    if (RtsFlags.ParFlags.ParStats.Global &&
-	RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-      globalParStats.tot_fetch_mess++;
-    }
-  } else if (rga.payload.gc.gtid == mytid) {
-    /* Our own FETCH forwarded back around to us */
-    StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)GALAlookup(&rga);
-    
-    IF_PAR_DEBUG(fetch,
-		 belch("%%%%== Fetch returned to sending PE; closure=%p (%s); receiver=%p (%s)",
-		       closure, info_type(closure), fmbq, info_type((StgClosure*)fmbq)));
-    /* We may have already discovered that the fetch target is our own. */
-    if ((StgClosure *)fmbq != closure) 
-      CommonUp((StgClosure *)fmbq, closure);
-    (void) addWeight(&rga);
-  } else if (IS_BLACK_HOLE(closure)) {
-    /* This includes RBH's and FMBQ's */
-    StgBlockedFetch *bf;
-
-    /* Can we assert something on the remote GA? */
-    ASSERT(GALAlookup(&rga) == NULL);
-
-    /* If we're hitting a BH or RBH or FMBQ we have to put a BLOCKED_FETCH
-       closure into the BQ in order to denote that when updating this node
-       the result should be sent to the originator of this fetch message. */
-    bf = (StgBlockedFetch *)createBlockedFetch(ga, rga);
-    IF_PAR_DEBUG(fetch,
-		 belch("%%++ Blocking Fetch ((%x, %d, %x)) on %p (%s)",
-		       rga.payload.gc.gtid, rga.payload.gc.slot, rga.weight, 
-		       closure, info_type(closure)));
-    blockFetch(bf, closure);
-  } else {			
-    /* The target of the FetchMe is some local graph */
-    nat size;
-    // StgClosure *graph;
-    rtsPackBuffer *buffer = (rtsPackBuffer *)NULL;
-
-    if ((buffer = PackNearbyGraph(closure, END_TSO_QUEUE, &size, rga.payload.gc.gtid)) == NULL) {
-      barf("processFetch: out of heap while packing graph; ToDo: call GC here");
-      GarbageCollect(GetRoots, rtsFalse); 
-      closure = GALAlookup(&ga);
-      buffer = PackNearbyGraph(closure, END_TSO_QUEUE, &size, rga.payload.gc.gtid);
-      ASSERT(buffer != (rtsPackBuffer *)NULL);
-    }
-    sendResume(&rga, size, buffer);
-
-    // Global statistics: count no. of fetches
-    if (RtsFlags.ParFlags.ParStats.Global &&
-	RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-      globalParStats.tot_resume_mess++;
-    }
-  }
-}
-
-/* 
-   The list of pending fetches must be a root-list for GC.
-   This routine is called from GC.c (same as marking GAs etc).
-*/
-void
-markPendingFetches(rtsBool major_gc) {
-
-  /* No need to traverse the list; this is done via the scavenge code
-     for a BLOCKED_FETCH closure, which evacuates the link field */
-
-  if (PendingFetches != END_BF_QUEUE ) {
-    IF_PAR_DEBUG(tables,
-		 fprintf(stderr, "@@@@ PendingFetches is root; evaced from %p to",
-			 PendingFetches));
-
-    PendingFetches = MarkRoot((StgClosure*)PendingFetches);
-
-    IF_PAR_DEBUG(verbose,
-		 fprintf(stderr, " %p\n", PendingFetches));
-
-  } else {
-    IF_PAR_DEBUG(tables,
-		 fprintf(stderr, "@@@@ PendingFetches is empty; no need to mark it\n"));
-  }
-}
-
-/*
- * processFree unpacks a FREE message and adds the weights to our GAs.
- */
-//@cindex processFree
-static void
-processFree(void)
-{
-  int nelem;
-  static StgWord *buffer;
-  int i;
-  globalAddr ga;
-
-  buffer = (StgWord *)gumPackBuffer;
-  unpackFree(&nelem, buffer);
-  IF_PAR_DEBUG(free,
-	       belch("!!__ Rcvd Free (%d GAs)", nelem / 2));
-
-  ga.payload.gc.gtid = mytid;
-  for (i = 0; i < nelem;) {
-    ga.weight = (rtsWeight) buffer[i++];
-    ga.payload.gc.slot = (int) buffer[i++];
-    IF_PAR_DEBUG(free,
-		 fprintf(stderr, "!!-- Processing free "); 
-		 printGA(&ga);
-		 fputc('\n', stderr);
-		 );
-    (void) addWeight(&ga);
-  }
-}
-
-/*
- * processResume unpacks a RESUME message into the graph, filling in
- * the LA -> GA, and GA -> LA tables. Threads blocked on the original
- * FetchMe (now a blocking queue) are awakened, and the blocking queue
- * is converted into an indirection.  Finally it sends an ACK in response
- * which contains any newly allocated GAs.
- */
-
-//@cindex processResume
-static void
-processResume(GlobalTaskId sender)
-{
-  int nelem;
-  nat nGAs;
-  static rtsPackBuffer *packBuffer;
-  StgClosure *newGraph, *old;
-  globalAddr lga;
-  globalAddr *gagamap;
-  
-  packBuffer = (rtsPackBuffer *)gumPackBuffer;
-  unpackResume(&lga, &nelem, packBuffer);
-
-  IF_PAR_DEBUG(fetch,
-	       fprintf(stderr, "[]__ Rcvd Resume for "); 
-	       printGA(&lga);
-	       fputc('\n', stderr));
-  IF_PAR_DEBUG(packet,
-	       PrintPacket((rtsPackBuffer *)packBuffer));
-  
-  /* 
-   * We always unpack the incoming graph, even if we've received the
-   * requested node in some other data packet (and already awakened
-   * the blocking queue).
-  if (SAVE_Hp + packBuffer[0] >= SAVE_HpLim) {
-    ReallyPerformThreadGC(packBuffer[0], rtsFalse);
-    SAVE_Hp -= packBuffer[0];
-  }
-   */
-
-  // ToDo: Check for GC here !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-  /* Do this *after* GC; we don't want to release the object early! */
-
-  if (lga.weight > 0)
-    (void) addWeight(&lga);
-
-  old = GALAlookup(&lga);
-
-  /* ToDo:  The closure that requested this graph must be one of these two?*/
-  ASSERT(get_itbl(old)->type == FETCH_ME_BQ || 
-	 get_itbl(old)->type == RBH);
-
-  if (RtsFlags.ParFlags.ParStats.Full) {
-    StgBlockingQueueElement *bqe, *last_bqe;
-
-    IF_PAR_DEBUG(fetch,
-		 belch("[]-- Resume is REPLY to closure %lx", old));
-
-    /* Write REPLY events to the log file, indicating that the remote
-       data has arrived 
-       NB: we emit a REPLY only for the *last* elem in the queue; this is
-           the one that triggered the fetch message; all other entries
-	   have just added themselves to the queue, waiting for the data 
-	   they know that has been requested (see entry code for FETCH_ME_BQ)
-    */
-    if ((get_itbl(old)->type == FETCH_ME_BQ ||
-	 get_itbl(old)->type == RBH)) {
-      for (bqe = ((StgFetchMeBlockingQueue *)old)->blocking_queue,
-	   last_bqe = END_BQ_QUEUE;
-	     get_itbl(bqe)->type==TSO || 
-	     get_itbl(bqe)->type==BLOCKED_FETCH;
-	   last_bqe = bqe, bqe = bqe->link) { /* nothing */ }
-
-      ASSERT(last_bqe==END_BQ_QUEUE || 
-	     get_itbl((StgClosure *)last_bqe)->type == TSO);
-
-      /* last_bqe now points to the TSO that triggered the FETCH */ 
-      if (get_itbl((StgClosure *)last_bqe)->type == TSO)
-	DumpRawGranEvent(CURRENT_PROC, taskIDtoPE(sender), 
-			 GR_REPLY, ((StgTSO *)last_bqe), ((StgTSO *)last_bqe)->block_info.closure,
-			 0, spark_queue_len(&(MainRegTable.rSparks)));
-    }
-  }
-
-  newGraph = UnpackGraph(packBuffer, &gagamap, &nGAs);
-  ASSERT(newGraph != NULL);
-
-  /* 
-   * Sometimes, unpacking will common up the resumee with the
-   * incoming graph, but if it hasn't, we'd better do so now.
-   */
-   
-  if (get_itbl(old)->type == FETCH_ME_BQ)
-    CommonUp(old, newGraph);
-
-  IF_PAR_DEBUG(fetch,
-	       belch("[]-- Ready to resume unpacked graph at %p (%s)",
-		     newGraph, info_type(newGraph)));
-
-  IF_PAR_DEBUG(tables,
-	       DebugPrintGAGAMap(gagamap, nGAs));
-  
-  sendAck(sender, nGAs, gagamap);
-}
-
-/*
- * processSchedule unpacks a SCHEDULE message into the graph, filling
- * in the LA -> GA, and GA -> LA tables. The root of the graph is added to
- * the local spark queue.  Finally it sends an ACK in response
- * which contains any newly allocated GAs.
- */
-//@cindex processSchedule
-static void
-processSchedule(GlobalTaskId sender)
-{
-  nat nelem, nGAs;
-  rtsBool success;
-  static rtsPackBuffer *packBuffer;
-  StgClosure *newGraph;
-  globalAddr *gagamap;
-  
-  packBuffer = gumPackBuffer;		/* HWL */
-  unpackSchedule(&nelem, packBuffer);
-
-  IF_PAR_DEBUG(schedule,
-	       belch("--__ Rcvd Schedule (%d elems)", nelem));
-  IF_PAR_DEBUG(packet,
-	       PrintPacket(packBuffer));
-
-  /*
-   * For now, the graph is a closure to be sparked as an advisory
-   * spark, but in future it may be a complete spark with
-   * required/advisory status, priority etc.
-   */
-
-  /*
-  space_required = packBuffer[0];
-  if (SAVE_Hp + space_required >= SAVE_HpLim) {
-    ReallyPerformThreadGC(space_required, rtsFalse);
-    SAVE_Hp -= space_required;
-  }
-  */
-  // ToDo: check whether GC is necessary !!!!!!!!!!!!!!!!!!!!!
-  newGraph = UnpackGraph(packBuffer, &gagamap, &nGAs);
-  ASSERT(newGraph != NULL);
-  success = add_to_spark_queue(newGraph, &(MainRegTable.rSparks));
-
-  if (RtsFlags.ParFlags.ParStats.Full && 
-      RtsFlags.ParFlags.ParStats.Sparks && 
-      success) 
-    DumpRawGranEvent(CURRENT_PROC, CURRENT_PROC, 
-		     GR_STOLEN, ((StgTSO *)NULL), newGraph, 
-		     0, 0 /* spark_queue_len(ADVISORY_POOL) */);
-
-  IF_PAR_DEBUG(schedule,
-	       if (success)
-  	         belch("--^^  added spark to unpacked graph %p (%s); %d sparks available on [%x] (%s)", 
-		     newGraph, info_type(newGraph), spark_queue_len(&(MainRegTable.rSparks)), mytid);
-	       else
-                 belch("--^^  received non-sparkable closure %p (%s); nothing added to spark pool; %d sparks available on [%x]", 
-		     newGraph, info_type(newGraph), spark_queue_len(&(MainRegTable.rSparks)), mytid));
-  IF_PAR_DEBUG(packet,
-	       belch("*<    Unpacked graph with root at %p (%s):", 
-		     newGraph, info_type(newGraph));
-	       PrintGraph(newGraph, 0));
-
-  IF_PAR_DEBUG(tables,
-  	       DebugPrintGAGAMap(gagamap, nGAs));
-
-  sendAck(sender, nGAs, gagamap);
-
-  //fishing = rtsFalse;
-  ASSERT(outstandingFishes>0);
-  outstandingFishes--;
-}
-
-/*
- * processAck unpacks an ACK, and uses the GAGA map to convert RBH's
- * (which represent shared thunks that have been shipped) into fetch-mes
- * to remote GAs.
- */
-//@cindex processAck
-static void
-processAck(void)
-{
-  nat nGAs;
-  globalAddr *gaga;
-  globalAddr gagamap[256]; // ToDo: elim magic constant!!   MAX_GAS * 2];??
-
-  unpackAck(&nGAs, gagamap);
-
-  IF_PAR_DEBUG(tables,
-	       belch(",,,, Rcvd Ack (%d pairs)", nGAs);
-	       DebugPrintGAGAMap(gagamap, nGAs));
-
-  IF_DEBUG(sanity,
-	   checkGAGAMap(gagamap, nGAs));
-
-  /*
-   * For each (oldGA, newGA) pair, set the GA of the corresponding
-   * thunk to the newGA, convert the thunk to a FetchMe, and return
-   * the weight from the oldGA.
-   */
-  for (gaga = gagamap; gaga < gagamap + nGAs * 2; gaga += 2) {
-    StgClosure *old_closure = GALAlookup(gaga);
-    StgClosure *new_closure = GALAlookup(gaga + 1);
-
-    ASSERT(old_closure != NULL);
-    if (new_closure == NULL) {
-      /* We don't have this closure, so we make a fetchme for it */
-      globalAddr *ga = setRemoteGA(old_closure, gaga + 1, rtsTrue);
-      
-      /* convertToFetchMe should be done unconditionally here.
-	 Currently, we assign GAs to CONSTRs, too, (a bit of a hack),
-	 so we have to check whether it is an RBH before converting
-
-	 ASSERT(get_itbl(old_closure)==RBH);
-      */
-      if (get_itbl(old_closure)->type==RBH)
-	convertToFetchMe((StgRBH *)old_closure, ga);
-    } else {
-      /* 
-       * Oops...we've got this one already; update the RBH to
-       * point to the object we already know about, whatever it
-       * happens to be.
-       */
-      CommonUp(old_closure, new_closure);
-      
-      /* 
-       * Increase the weight of the object by the amount just
-       * received in the second part of the ACK pair.
-       */
-      (void) addWeight(gaga + 1);
-    }
-    (void) addWeight(gaga);
-  }
-
-  /* check the sanity of the LAGA and GALA tables after mincing them */
-  IF_DEBUG(sanity, checkLAGAtable(rtsFalse));
-}
-
-#ifdef DIST
-
-void
-bounceReval(void) {  
-  barf("Task %x: TODO: should send NACK in response to REVAL",mytid);	  
-}
-
-static void
-processReval(GlobalTaskId sender) //similar to schedule...
-{ nat nelem, space_required, nGAs;
-  static rtsPackBuffer *packBuffer;
-  StgClosure *newGraph;
-  globalAddr *gagamap;
-  StgTSO*     tso;
-  globalAddr *ga;
-  
-  packBuffer = gumPackBuffer;		/* HWL */
-  unpackSchedule(&nelem, packBuffer); /* okay, since the structure is the same */
-
-  IF_PAR_DEBUG(packet,
-	       belch("@;~) [%x] Rcvd Reval (%d elems)", mytid, nelem);
-	       PrintPacket(packBuffer));
-
-  /*
-  space_required = packBuffer[0];
-  if (SAVE_Hp + space_required >= SAVE_HpLim) {
-    ReallyPerformThreadGC(space_required, rtsFalse);
-    SAVE_Hp -= space_required;
-  }
-  */
-  
-  // ToDo: check whether GC is necessary !!!!!!!!!!!!!!!!!!!!!
-  newGraph = UnpackGraph(packBuffer, &gagamap, &nGAs);
-  ASSERT(newGraph != NULL);
-  
-  IF_PAR_DEBUG(packet,
-	       belch("@;~)  Unpacked graph with root at %p (%s):", 
-		     newGraph, info_type(newGraph));
-	       PrintGraph(newGraph, 0));
-
-  IF_PAR_DEBUG(tables,
-  	       DebugPrintGAGAMap(gagamap, nGAs));
-
-  IF_PAR_DEBUG(tables, 
-    printLAGAtable();   
-    DebugPrintGAGAMap(gagamap, nGAs));   
-
-  //We don't send an Ack to the head!!!!
-  ASSERT(nGAs>0);  
-  sendAck(sender, nGAs-1, gagamap+2);
-  
-  IF_PAR_DEBUG(verbose,
-	       belch("@;~)  About to create Reval thread on behalf of %x", 
-		     sender));
-  
-  tso=createGenThread(RtsFlags.GcFlags.initialStkSize,newGraph);
-  tso->priority=RevalPriority;
-  tso->revalSlot=gagamap->payload.gc.slot;//record who sent the reval
-  tso->revalTid =gagamap->payload.gc.gtid;
-  scheduleThread(tso);
-  context_switch = 1; // switch at the earliest opportunity
-} 
-#endif
-
-
-//@node GUM Message Processor, Miscellaneous Functions, Message-Processing Functions, High Level Communications Routines
-//@subsection GUM Message Processor
-
-/*
- * GUM Message Processor
-
- * processMessages processes any messages that have arrived, calling
- * appropriate routines depending on the message tag
- * (opcode). N.B. Unless profiling it assumes that there {\em ARE} messages
- * present and performs a blocking receive! During profiling it
- * busy-waits in order to record idle time.
- */
-
-//@cindex processMessages
-rtsBool
-processMessages(void)
-{
-  rtsPacket packet;
-  OpCode opcode;
-  GlobalTaskId task;
-  rtsBool receivedFinish = rtsFalse;
-
-  do {
-    packet = GetPacket();  /* Get next message; block until one available */
-    getOpcodeAndSender(packet, &opcode, &task);
-
-    if (task==SysManTask) { 
-      switch (opcode) { 
-      case PP_PETIDS:
-	processPEtids();
-	break;
-	  
-      case PP_FINISH:
-	IF_PAR_DEBUG(verbose,
-		     belch("==== received FINISH [%p]", mytid));
-	/* this boolean value is returned and propagated to the main 
-	   scheduling loop, thus shutting-down this PE */
-	receivedFinish = rtsTrue;
-	break;  
-	  
-      default:  
-	barf("Task %x: received unknown opcode %x from SysMan",mytid, opcode);
-      }
-    } else if (taskIDtoPE(task)==0) { 
-      /* When a new PE joins then potentially FISH & REVAL message may
-	 reach PES before they are notified of the new PEs existance.  The
-	 only solution is to bounce/fail these messages back to the sender.
-	 But we will worry about it once we start seeing these race
-	 conditions!  */
-      switch (opcode) { 
-      case PP_FISH:
-	bounceFish();
-	break;
-#ifdef DIST	  
-      case PP_REVAL:
-	bounceReval();
-	break;	  
-#endif          
-      case PP_PETIDS:
-	belch("Task %x: Ignoring PVM session opened by another SysMan %x",mytid,task);
-	break;
-        
-      case PP_FINISH:   
-	break;
-	
-      default:  
-	belch("Task %x: Ignoring opcode %x from unknown PE %x",mytid, opcode, task);
-      }
-    } else
-      switch (opcode) {
-      case PP_FETCH:
-	processFetch();
-	// Global statistics: count no. of fetches
-	if (RtsFlags.ParFlags.ParStats.Global &&
-	    RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	  globalParStats.rec_fetch_mess++;
-	}
-	break;
-
-      case PP_RESUME:
-	processResume(task);
-	// Global statistics: count no. of fetches
-	if (RtsFlags.ParFlags.ParStats.Global &&
-	    RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	  globalParStats.rec_resume_mess++;
-	}
-	break;
-
-      case PP_ACK:
-	processAck();
-	break;
-
-      case PP_FISH:
-	processFish();
-	// Global statistics: count no. of fetches
-	if (RtsFlags.ParFlags.ParStats.Global &&
-	    RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	  globalParStats.rec_fish_mess++;
-	}
-	break;
-
-      case PP_FREE:
-	processFree();
-	break;
-      
-      case PP_SCHEDULE:
-	processSchedule(task);
-	// Global statistics: count no. of fetches
-	if (RtsFlags.ParFlags.ParStats.Global &&
-	    RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	  globalParStats.rec_schedule_mess++;
-	}
-	break;
-      
-#ifdef DIST      
-      case PP_REVAL:
-	processReval(task);
-	// Global statistics: count no. of fetches
-	if (RtsFlags.ParFlags.ParStats.Global &&
-	    RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	  globalParStats.rec_reval_mess++;
-	}
-	break;
-#endif
-      
-      default:
-	/* Anything we're not prepared to deal with. */
-	barf("Task %x: Unexpected opcode %x from %x",
-	     mytid, opcode, task);
-      } /* switch */
-
-  } while (PacketsWaiting());	/* While there are messages: process them */
-  return receivedFinish;
-}				/* processMessages */
-
-//@node Miscellaneous Functions, Index, GUM Message Processor, High Level Communications Routines
-//@subsection Miscellaneous Functions
-
-/*
- * blockFetch blocks a BlockedFetch node on some kind of black hole.
- */
-//@cindex blockFetch
-void
-blockFetch(StgBlockedFetch *bf, StgClosure *bh) {
-  bf->node = bh;
-  switch (get_itbl(bh)->type) {
-  case BLACKHOLE:
-    bf->link = END_BQ_QUEUE;
-    //((StgBlockingQueue *)bh)->header.info = &stg_BLACKHOLE_BQ_info;
-    SET_INFO(bh, &stg_BLACKHOLE_BQ_info); // turn closure into a blocking queue
-    ((StgBlockingQueue *)bh)->blocking_queue = (StgBlockingQueueElement *)bf;
-    
-    // put bh on the mutables list
-    recordMutable((StgMutClosure *)bh);
-    break;
-    
-  case BLACKHOLE_BQ:
-    /* enqueue bf on blocking queue of closure bh */
-    bf->link = ((StgBlockingQueue *)bh)->blocking_queue;
-    ((StgBlockingQueue *)bh)->blocking_queue = (StgBlockingQueueElement *)bf;
-
-    // put bh on the mutables list; ToDo: check
-    recordMutable((StgMutClosure *)bh);
-    break;
-
-  case FETCH_ME_BQ:
-    /* enqueue bf on blocking queue of closure bh */
-    bf->link = ((StgFetchMeBlockingQueue *)bh)->blocking_queue;
-    ((StgFetchMeBlockingQueue *)bh)->blocking_queue = (StgBlockingQueueElement *)bf;
-
-    // put bh on the mutables list; ToDo: check
-    recordMutable((StgMutClosure *)bh);
-    break;
-    
-  case RBH:
-    /* enqueue bf on blocking queue of closure bh */
-    bf->link = ((StgRBH *)bh)->blocking_queue;
-    ((StgRBH *)bh)->blocking_queue = (StgBlockingQueueElement *)bf;
-
-    // put bh on the mutables list; ToDo: check
-    recordMutable((StgMutClosure *)bh);
-    break;
-    
-  default:
-    barf("blockFetch: thought %p was a black hole (IP %#lx, %s)",
-	 (StgClosure *)bh, get_itbl((StgClosure *)bh), 
-	 info_type((StgClosure *)bh));
-  }
-  IF_PAR_DEBUG(bq,
-	       belch("##++ blockFetch: after block the BQ of %p (%s) is:",
-		     bh, info_type(bh));
-	       print_bq(bh));
-}
-
-
-/*
-  @blockThread@ is called from the main scheduler whenever tso returns with
-  a ThreadBlocked return code; tso has already been added to a blocking
-  queue (that's done in the entry code of the closure, because it is a 
-  cheap operation we have to do in any case); the main purpose of this
-  routine is to send a Fetch message in case we are blocking on a FETCHME(_BQ)
-  closure, which is indicated by the tso.why_blocked field;
-  we also write an entry into the log file if we are generating one
-
-  Should update exectime etc in the entry code already; but we don't have
-  something like ``system time'' in the log file anyway, so this should
-  even out the inaccuracies.
-*/
-
-//@cindex blockThread
-void
-blockThread(StgTSO *tso)
-{
-  globalAddr *remote_ga=NULL;
-  globalAddr *local_ga;
-  globalAddr fmbq_ga;
-
-  // ASSERT(we are on some blocking queue)
-  ASSERT(tso->block_info.closure != (StgClosure *)NULL);
-
-  /*
-    We have to check why this thread has been blocked.
-  */
-  switch (tso->why_blocked) {
-    case BlockedOnGA:
-      /* the closure must be a FETCH_ME_BQ; tso came in here via 
-	 FETCH_ME entry code */
-      ASSERT(get_itbl(tso->block_info.closure)->type==FETCH_ME_BQ);
-
-      /* HACK: the link field is used to hold the GA between FETCH_ME_entry
-	 end this point; if something (eg. GC) happens inbetween the whole
-	 thing will blow up 
-	 The problem is that the ga field of the FETCH_ME has been overwritten
-	 with the head of the blocking queue (which is tso). 
-      */
-      ASSERT(looks_like_ga(&theGlobalFromGA));
-      // ASSERT(tso->link!=END_TSO_QUEUE && tso->link!=NULL);
-      remote_ga = &theGlobalFromGA; //tso->link;
-      tso->link = (StgTSO*)END_BQ_QUEUE;
-      /* it was tso which turned node from FETCH_ME into FETCH_ME_BQ =>
-	 we have to send a Fetch message here! */
-      if (RtsFlags.ParFlags.ParStats.Full) {
-	/* Note that CURRENT_TIME may perform an unsafe call */
-	tso->par.exectime += CURRENT_TIME - tso->par.blockedat;
-	tso->par.fetchcount++;
-	tso->par.blockedat = CURRENT_TIME;
-	/* we are about to send off a FETCH message, so dump a FETCH event */
-	DumpRawGranEvent(CURRENT_PROC, 
-			 taskIDtoPE(remote_ga->payload.gc.gtid),
-			 GR_FETCH, tso, tso->block_info.closure, 0, 0);
-      }
-      /* Phil T. claims that this was a workaround for a hard-to-find
-       * bug, hence I'm leaving it out for now --SDM 
-       */
-      /* Assign a brand-new global address to the newly created FMBQ  */
-      local_ga = makeGlobal(tso->block_info.closure, rtsFalse);
-      splitWeight(&fmbq_ga, local_ga);
-      ASSERT(fmbq_ga.weight == 1U << (BITS_IN(unsigned) - 1));
-      
-      sendFetch(remote_ga, &fmbq_ga, 0/*load*/);
-
-      // Global statistics: count no. of fetches
-      if (RtsFlags.ParFlags.ParStats.Global &&
-	  RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-	globalParStats.tot_fetch_mess++;
-      }
-
-      IF_DEBUG(sanity,
-	       theGlobalFromGA.payload.gc.gtid = (GlobalTaskId)0);
-      break;
-
-    case BlockedOnGA_NoSend:
-      /* the closure must be a FETCH_ME_BQ; tso came in here via 
-	 FETCH_ME_BQ entry code */
-      ASSERT(get_itbl(tso->block_info.closure)->type==FETCH_ME_BQ);
-
-      /* Fetch message has been sent already */
-      if (RtsFlags.ParFlags.ParStats.Full) {
-	/* Note that CURRENT_TIME may perform an unsafe call */
-	tso->par.exectime += CURRENT_TIME - tso->par.blockedat;
-	tso->par.blockcount++;
-	tso->par.blockedat = CURRENT_TIME;
-	/* dump a block event, because fetch has been sent already */
-	DumpRawGranEvent(CURRENT_PROC, thisPE,
-			 GR_BLOCK, tso, tso->block_info.closure, 0, 0);
-      }
-      break;
-
-    case BlockedOnMVar:
-    case BlockedOnBlackHole:
-      /* the closure must be a BLACKHOLE_BQ or an RBH; tso came in here via 
-	 BLACKHOLE(_BQ) or CAF_BLACKHOLE or RBH entry code */
-      ASSERT(get_itbl(tso->block_info.closure)->type==MVAR ||
-	     get_itbl(tso->block_info.closure)->type==BLACKHOLE_BQ ||
-	     get_itbl(tso->block_info.closure)->type==RBH);
-
-      /* if collecting stats update the execution time etc */
-      if (RtsFlags.ParFlags.ParStats.Full) {
-	/* Note that CURRENT_TIME may perform an unsafe call */
-	tso->par.exectime += CURRENT_TIME - tso->par.blockedat;
-	tso->par.blockcount++;
-	tso->par.blockedat = CURRENT_TIME;
-	DumpRawGranEvent(CURRENT_PROC, thisPE,
-			 GR_BLOCK, tso, tso->block_info.closure, 0, 0);
-      }
-      break;
-
-    case BlockedOnDelay:
-      /* Whats sort of stats shall we collect for an explicit threadDelay? */
-      IF_PAR_DEBUG(verbose,
-	       belch("##++ blockThread: TSO %d blocked on ThreadDelay",
-		     tso->id));
-      break;
-
-    /* Check that the following is impossible to happen, indeed
-    case BlockedOnException:
-    case BlockedOnRead:
-    case BlockedOnWrite:
-    */
-    default:
-      barf("blockThread: impossible why_blocked code %d for TSO %d",
-	   tso->why_blocked, tso->id);
-  }
-
-  IF_PAR_DEBUG(verbose,
-	       belch("##++ blockThread: TSO %d blocked on closure %p (%s); %s",
-		     tso->id, tso->block_info.closure, info_type(tso->block_info.closure),
-		     (tso->why_blocked==BlockedOnGA) ? "Sent FETCH for GA" : ""));
-  
-  IF_PAR_DEBUG(bq,
-	       print_bq(tso->block_info.closure));
-}
-
-/*
- * ChoosePE selects a GlobalTaskId from the array of PEs 'at random'.
- * Important properties:
- *   - it varies during execution, even if the PE is idle
- *   - it's different for each PE
- *   - we never send a fish to ourselves
- */
-extern long lrand48 (void);
-
-//@cindex choosePE
-GlobalTaskId
-choosePE(void)
-{
-  long temp;
-
-  temp = lrand48() % nPEs;
-  if (allPEs[temp] == mytid) {	/* Never send a FISH to yourself */
-    temp = (temp + 1) % nPEs;
-  }
-  return allPEs[temp];
-}
-
-/* 
- * allocate a BLOCKED_FETCH closure and fill it with the relevant fields
- * of the ga argument; called from processFetch when the local closure is
- * under evaluation
- */
-//@cindex createBlockedFetch
-StgClosure *
-createBlockedFetch (globalAddr ga, globalAddr rga)
-{
-  StgBlockedFetch *bf;
-  StgClosure *closure;
-
-  closure = GALAlookup(&ga);
-  if ((bf = (StgBlockedFetch *)allocate(_HS + sizeofW(StgBlockedFetch))) == NULL) {
-    barf("createBlockedFetch: out of heap while allocating heap for a BlocekdFetch; ToDo: call GC here");
-    GarbageCollect(GetRoots, rtsFalse); 
-    closure = GALAlookup(&ga);
-    bf = (StgBlockedFetch *)allocate(_HS + sizeofW(StgBlockedFetch));
-    // ToDo: check whether really guaranteed to succeed 2nd time around
-  }
-
-  ASSERT(bf != (StgBlockedFetch *)NULL);
-  SET_INFO((StgClosure *)bf, &stg_BLOCKED_FETCH_info);
-  // ToDo: check whether other header info is needed
-  bf->node = closure;
-  bf->ga.payload.gc.gtid = rga.payload.gc.gtid;
-  bf->ga.payload.gc.slot = rga.payload.gc.slot;
-  bf->ga.weight = rga.weight;
-  // bf->link = NULL;  debugging
-
-  IF_PAR_DEBUG(schedule,
-	       fprintf(stderr, "%%%%// created BF: bf=%p (%s) of closure , GA: ",
-		       bf, info_type((StgClosure*)bf));
-	       printGA(&(bf->ga));
-	       fputc('\n',stderr));
-  return (StgClosure *)bf;
-}
-
-/*
- * waitForTermination enters a loop ignoring spurious messages while
- * waiting for the termination sequence to be completed.  
- */
-//@cindex waitForTermination
-void
-waitForTermination(void)
-{
-  do {
-    rtsPacket p = GetPacket();
-    processUnexpectedMessage(p);
-  } while (rtsTrue);
-}
-
-#ifdef DEBUG
-//@cindex DebugPrintGAGAMap
-void
-DebugPrintGAGAMap(globalAddr *gagamap, int nGAs)
-{
-  nat i;
-  
-  for (i = 0; i < nGAs; ++i, gagamap += 2)
-    fprintf(stderr, "__ gagamap[%d] = ((%x, %d, %x)) -> ((%x, %d, %x))\n", i,
-	    gagamap[0].payload.gc.gtid, gagamap[0].payload.gc.slot, gagamap[0].weight,
-	    gagamap[1].payload.gc.gtid, gagamap[1].payload.gc.slot, gagamap[1].weight);
-}
-
-//@cindex checkGAGAMap
-void
-checkGAGAMap(globalAddr *gagamap, int nGAs)
-{
-  nat i;
-  
-  for (i = 0; i < (nat)nGAs; ++i, gagamap += 2) {
-    ASSERT(looks_like_ga(gagamap));
-    ASSERT(looks_like_ga(gagamap+1));
-  }
-}
-#endif
-
-//@cindex freeMsgBuffer
-static StgWord **freeMsgBuffer = NULL;
-//@cindex freeMsgIndex
-static nat      *freeMsgIndex  = NULL;
-
-//@cindex prepareFreeMsgBuffers
-void
-prepareFreeMsgBuffers(void)
-{
-  nat i;
-  
-  /* Allocate the freeMsg buffers just once and then hang onto them. */
-  if (freeMsgIndex == NULL) {
-    freeMsgIndex = (nat *) stgMallocBytes(nPEs * sizeof(nat), 
-					  "prepareFreeMsgBuffers (Index)");
-    freeMsgBuffer = (StgWord **) stgMallocBytes(nPEs * sizeof(long *), 
-					  "prepareFreeMsgBuffers (Buffer)");
-    
-    for(i = 0; i < nPEs; i++) 
-      if (i != (thisPE-1)) 
-	freeMsgBuffer[i] = (StgPtr) stgMallocWords(RtsFlags.ParFlags.packBufferSize,
-					       "prepareFreeMsgBuffers (Buffer #i)");
-      else
-	freeMsgBuffer[i] = 0;
-  }
-  
-  /* Initialize the freeMsg buffer pointers to point to the start of their
-     buffers */
-  for (i = 0; i < nPEs; i++)
-    freeMsgIndex[i] = 0;
-}
-
-//@cindex freeRemoteGA
-void
-freeRemoteGA(int pe, globalAddr *ga)
-{
-  nat i;
-  
-  ASSERT(GALAlookup(ga) == NULL);
-  
-  if ((i = freeMsgIndex[pe]) + 2 >= RtsFlags.ParFlags.packBufferSize) {
-    IF_PAR_DEBUG(free,
-		 belch("!! Filled a free message buffer (sending remaining messages indivisually)"));	
-
-    sendFree(ga->payload.gc.gtid, i, freeMsgBuffer[pe]);
-    i = 0;
-  }
-  freeMsgBuffer[pe][i++] = (StgWord) ga->weight;
-  freeMsgBuffer[pe][i++] = (StgWord) ga->payload.gc.slot;
-  freeMsgIndex[pe] = i;
-
-  IF_DEBUG(sanity,
-	   ga->weight = 0xdead0add;
-	   ga->payload.gc.gtid = 0xbbbbbbbb;
-	   ga->payload.gc.slot = 0xbbbbbbbb;);
-}
-
-//@cindex sendFreeMessages
-void
-sendFreeMessages(void)
-{
-  nat i;
-  
-  for (i = 0; i < nPEs; i++) 
-    if (freeMsgIndex[i] > 0)
-      sendFree(allPEs[i], freeMsgIndex[i], freeMsgBuffer[i]);
-}
-
-/* synchronises with the other PEs. Receives and records in a global
- * variable the task-id of SysMan. If this is the main thread (discovered
- * in main.lc), identifies itself to SysMan. Finally it receives
- * from SysMan an array of the Global Task Ids of each PE, which is
- * returned as the value of the function.
- */
-
-#if defined(PAR_TICKY)
-/* Has to see freeMsgIndex, so must be defined here not in ParTicky.c */
-//@cindex stats_CntFreeGA
-void
-stats_CntFreeGA (void) {  // stats only
-
-  // Global statistics: residency of thread and spark pool
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    nat i, s;
-  
-    globalParStats.cnt_free_GA++;
-    for (i = 0, s = 0; i < nPEs; i++) 
-      s += globalParStats.tot_free_GA += freeMsgIndex[i]/2;
-
-    if ( s > globalParStats.res_free_GA )
-      globalParStats.res_free_GA = s;
-  }
-}
-#endif /* PAR_TICKY */
-
-#endif /* PAR -- whole file */
-
-//@node Index,  , Miscellaneous Functions, High Level Communications Routines
-//@subsection Index
-
-//@index
-//* ACK::  @cindex\s-+ACK
-//* DebugPrintGAGAMap::  @cindex\s-+DebugPrintGAGAMap
-//* FETCH::  @cindex\s-+FETCH
-//* FISH::  @cindex\s-+FISH
-//* FREE::  @cindex\s-+FREE
-//* RESUME::  @cindex\s-+RESUME
-//* SCHEDULE::  @cindex\s-+SCHEDULE
-//* blockFetch::  @cindex\s-+blockFetch
-//* choosePE::  @cindex\s-+choosePE
-//* freeMsgBuffer::  @cindex\s-+freeMsgBuffer
-//* freeMsgIndex::  @cindex\s-+freeMsgIndex
-//* freeRemoteGA::  @cindex\s-+freeRemoteGA
-//* gumPackBuffer::  @cindex\s-+gumPackBuffer
-//* initMoreBuffers::  @cindex\s-+initMoreBuffers
-//* prepareFreeMsgBuffers::  @cindex\s-+prepareFreeMsgBuffers
-//* processAck::  @cindex\s-+processAck
-//* processFetch::  @cindex\s-+processFetch
-//* processFetches::  @cindex\s-+processFetches
-//* processFish::  @cindex\s-+processFish
-//* processFree::  @cindex\s-+processFree
-//* processMessages::  @cindex\s-+processMessages
-//* processResume::  @cindex\s-+processResume
-//* processSchedule::  @cindex\s-+processSchedule
-//* sendAck::  @cindex\s-+sendAck
-//* sendFetch::  @cindex\s-+sendFetch
-//* sendFish::  @cindex\s-+sendFish
-//* sendFree::  @cindex\s-+sendFree
-//* sendFreeMessages::  @cindex\s-+sendFreeMessages
-//* sendResume::  @cindex\s-+sendResume
-//* sendSchedule::  @cindex\s-+sendSchedule
-//* unpackAck::  @cindex\s-+unpackAck
-//* unpackFetch::  @cindex\s-+unpackFetch
-//* unpackFish::  @cindex\s-+unpackFish
-//* unpackFree::  @cindex\s-+unpackFree
-//* unpackResume::  @cindex\s-+unpackResume
-//* unpackSchedule::  @cindex\s-+unpackSchedule
-//* waitForTermination::  @cindex\s-+waitForTermination
-//@end index
diff --git a/ghc/rts/parallel/LLC.h b/ghc/rts/parallel/LLC.h
deleted file mode 100644
index 536e431bef..0000000000
--- a/ghc/rts/parallel/LLC.h
+++ /dev/null
@@ -1,130 +0,0 @@
-/* --------------------------------------------------------------------------
-   Time-stamp: <Sun Mar 18 2001 21:23:50 Stardate: [-30]6349.45 hwloidl>
-
-   Low Level Communications Header (LLC.h)
-
-   Contains the definitions used by the Low-level Communications
-   module of the GUM Haskell runtime environment.
-   Based on the Graph for PVM implementation.
-
-   Phil Trinder, Glasgow University, 13th Dec 1994
-   Adapted for the 4.xx RTS
-   H-W. Loidl, Heriot-Watt, November 1999
-   ----------------------------------------------------------------------- */
-
-#ifndef __LLC_H
-#define __LLC_H
-
-#ifdef PAR
-
-//@node Low Level Communications Header, , ,
-//@section Low Level Communications Header
-
-//@menu
-//* Includes::			
-//* Macros and Constants::	
-//* PVM macros::		
-//* Externs::			
-//@end menu
-
-//@node Includes, Macros and Constants, Low Level Communications Header, Low Level Communications Header
-//@subsection Includes
-
-#include "Rts.h"
-#include "Parallel.h"
-
-#include "PEOpCodes.h"
-#include "pvm3.h"
-
-//@node Macros and Constants, PVM macros, Includes, Low Level Communications Header
-//@subsection Macros and Constants
-
-#define	ANY_TASK	(-1)	/* receive messages from any task */
-#define ANY_GLOBAL_TASK	ANY_TASK
-#define ANY_OPCODE	(-1)	/* receive any opcode */
-#define	ALL_GROUP	(-1)	/* wait for barrier from every group member */
-
-#define	PEGROUP		"PE"
-
-#define	MGRGROUP	"MGR"
-#define	SYSGROUP	"SYS"
-
-
-#define	PETASK		"PE"
-
-//@node PVM macros, Externs, Macros and Constants, Low Level Communications Header
-//@subsection PVM macros
-
-#define	sync(gp,op)		do { \
-                                  broadcast(gp,op); \
-                                  pvm_barrier(gp,ALL_GROUP); \
-                                } while(0)
-
-#define broadcast(gp,op)	do { \
-                                  pvm_initsend(PvmDataDefault); \
-                                  pvm_bcast(gp,op); \
-                                } while(0)
-
-#define checkComms(c,s)		do { \
-                                  if ((c)<0) { \
-                                    pvm_perror(s); \
-                                    stg_exit(EXIT_FAILURE); \
-                                }} while(0)
-
-#define _my_gtid		pvm_mytid()
-#define GetPacket()             pvm_recv(ANY_TASK,ANY_OPCODE)
-#define PacketsWaiting()	(pvm_probe(ANY_TASK,ANY_OPCODE) != 0)
-
-#define SPARK_THREAD_DESCRIPTOR		1
-#define GLOBAL_THREAD_DESCRIPTOR	2
-
-#define _extract_jump_field(v)	(v)
-
-#define MAX_DATA_WORDS_IN_PACKET	1024
-
-/* basic PVM packing */
-#define PutArg1(a)		pvm_pklong((long *)&(a),1,1)
-#define PutArg2(a)		pvm_pklong((long *)&(a),1,1)
-#define PutArgN(n,a)		pvm_pklong((long *)&(a),1,1)
-#define PutArgs(b,n)		pvm_pklong((long *)b,n,1)
-
-#define PutLit(l)		{ int a = l; PutArgN(?,a); }
-
-/* basic PVM unpacking */
-#define GetArg1(a)		pvm_upklong((long *)&(a),1,1)
-#define GetArg2(a)		pvm_upklong((long *)&(a),1,1)
-#define GetArgN(n,a)		pvm_upklong((long *)&(a),1,1)
-#define GetArgs(b,n)		pvm_upklong((long *)b,n,1)
-
-//@node Externs,  , PVM macros, Low Level Communications Header
-//@subsection Externs
-
-/* basic message passing routines */
-extern void sendOp   (OpCode,GlobalTaskId),
-            sendOp1  (OpCode,GlobalTaskId,StgWord),
-            sendOp2  (OpCode,GlobalTaskId,StgWord,StgWord),
-	    sendOpV  (OpCode,GlobalTaskId,int,...), 
-            sendOpN  (OpCode,GlobalTaskId,int,StgPtr),
-            sendOpNV (OpCode,GlobalTaskId,int,StgPtr,int,...);
-
-extern void broadcastOpN(OpCode op, char *group, int n, StgPtr args);
-
-/* extracting data out of a packet */
-OpCode        getOpcode (rtsPacket p);
-void          getOpcodeAndSender (rtsPacket p, OpCode *popcode, 
-			          GlobalTaskId *psender_id);
-GlobalTaskId  senderTask (rtsPacket p);
-rtsPacket     waitForPEOp(OpCode op, GlobalTaskId who, void(*processUnexpected)(rtsPacket) );
-
-/* Init and shutdown routines */
-void          startUpPE (void);
-void          shutDownPE(void);
-int           getExitCode(int nbytes, GlobalTaskId *sender_idp);
-
-/* aux functions */
-char  *getOpName (unsigned op);  // returns string of opcode
-void   processUnexpectedMessage (rtsPacket);
-//void   NullException(void);
-
-#endif /*PAR */
-#endif /*defined __LLC_H */
diff --git a/ghc/rts/parallel/LLComms.c b/ghc/rts/parallel/LLComms.c
deleted file mode 100644
index baa6dddf0c..0000000000
--- a/ghc/rts/parallel/LLComms.c
+++ /dev/null
@@ -1,489 +0,0 @@
-/* ----------------------------------------------------------------------------
- * Time-stamp: <Mon Mar 19 2001 22:10:38 Stardate: [-30]6354.62 hwloidl>
- *
- * GUM Low-Level Inter-Task Communication
- *
- * This module defines PVM Routines for PE-PE  communication.
- *
- * P. Trinder, December 5th. 1994.
- * P. Trinder, July 1998
- * H-W. Loidl, November 1999 -
- --------------------------------------------------------------------------- */
-
-#ifdef PAR /* whole file */
-
-//@node GUM Low-Level Inter-Task Communication, , ,
-//@section GUM Low-Level Inter-Task Communication
-
-/*
- *This module defines the routines which communicate between PEs.  The
- *code is based on Kevin Hammond's GRIP RTS. (OpCodes.h defines
- *PEOp1 etc. in terms of sendOp1 etc.).  
- *
- *Routine	&	Arguments 
- *		&		
- *sendOp	&	0			\\
- *sendOp1	&	1			\\
- *sendOp2	&	2			\\
- *sendOpN	&	vector			\\
- *sendOpV	&	variable		\\
- *sendOpNV	&	variable+ vector	\\
- *
- *First the standard include files.
- */
-
-//@menu
-//* Macros etc::		
-//* Includes::			
-//* Auxiliary functions::	
-//* Index::			
-//@end menu
-
-//@node Macros etc, Includes, GUM Low-Level Inter-Task Communication, GUM Low-Level Inter-Task Communication
-//@subsection Macros etc
-
-/* Evidently not Posix */
-/* #include "PosixSource.h" */
-
-#define UNUSED           /* nothing */
-
-//@node Includes, Auxiliary functions, Macros etc, GUM Low-Level Inter-Task Communication
-//@subsection Includes
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "Parallel.h"
-#include "ParallelRts.h"
-#if defined(DEBUG)
-# include "ParallelDebug.h"
-#endif
-#include "LLC.h"
-
-#ifdef __STDC__
-#include <stdarg.h>
-#else
-#include <varargs.h>
-#endif
-
-/* Cannot use std macro when compiling for SysMan */
-/* debugging enabled */
-// #define IF_PAR_DEBUG(c,s)  { s; }
-/* debugging disabled */
-#define IF_PAR_DEBUG(c,s)  /* nothing */
-
-//@node Auxiliary functions, Index, Includes, GUM Low-Level Inter-Task Communication
-//@subsection Auxiliary functions
-
-/*
- * heapChkCounter tracks the number of heap checks since the last probe.
- * Not currently used! We check for messages when a thread is resheduled.
- */
-int heapChkCounter = 0;
-
-/*
- * Then some miscellaneous functions. 
- * getOpName returns the character-string name of any OpCode.
- */
-
-char *UserPEOpNames[] = { PEOP_NAMES };
-
-//@cindex getOpName
-char *
-getOpName(nat op)
-{
-    if (op >= MIN_PEOPS && op <= MAX_PEOPS)
-	return (UserPEOpNames[op - MIN_PEOPS]);
-    else
-	return ("Unknown PE OpCode");
-}
-
-/*
- * traceSendOp handles the tracing of messages. 
- */
-
-//@cindex traceSendOp
-static void
-traceSendOp(OpCode op, GlobalTaskId dest UNUSED,
-	     unsigned int data1 UNUSED, unsigned int data2 UNUSED)
-{
-    char *OpName;
-
-    OpName = getOpName(op);
-    IF_PAR_DEBUG(trace,
-		 fprintf(stderr," %s [%x,%x] sent from %x to %x", 
-		       OpName, data1, data2, mytid, dest));
-}
-
-/*
- * sendOp sends a 0-argument message with OpCode {\em op} to
- * the global task {\em task}.
- */
-
-//@cindex sendOp
-void
-sendOp(OpCode op, GlobalTaskId task)
-{
-    traceSendOp(op, task,0,0);
-
-    pvm_initsend(PvmDataRaw);
-    pvm_send(task, op);
-}
-
-/*
- * sendOp1 sends a 1-argument message with OpCode {\em op}
- * to the global task {\em task}.
- */
-
-//@cindex sendOp1
-void
-sendOp1(OpCode op, GlobalTaskId task, StgWord arg1)
-{
-    traceSendOp(op, task, arg1,0);
-
-    pvm_initsend(PvmDataRaw);
-    PutArg1(arg1);
-    pvm_send(task, op);
-}
-
-
-/*
- * sendOp2 is used by the FP code only. 
- */
-
-//@cindex sendOp2
-void
-sendOp2(OpCode op, GlobalTaskId task, StgWord arg1, StgWord arg2)
-{
-    traceSendOp(op, task, arg1, arg2);
-
-    pvm_initsend(PvmDataRaw);
-    PutArg1(arg1);
-    PutArg2(arg2);
-    pvm_send(task, op);
-}
-
-/*
- *
- * sendOpV takes a variable number of arguments, as specified by {\em n}.  
- * For example,
- *
- *    sendOpV( PP_STATS, StatsTask, 3, start_time, stop_time, sparkcount);
- */
-
-//@cindex sendOpV
-void
-sendOpV(OpCode op, GlobalTaskId task, int n, ...)
-{
-    va_list ap;
-    int i;
-    StgWord arg;
-
-    va_start(ap, n);
-
-    traceSendOp(op, task, 0, 0);
-
-    pvm_initsend(PvmDataRaw);
-
-    for (i = 0; i < n; ++i) {
-	arg = va_arg(ap, StgWord);
-	PutArgN(i, arg);
-    }
-    va_end(ap);
-
-    pvm_send(task, op);
-}
-
-/*    
- *
- * sendOpNV takes a variable-size datablock, as specified by {\em
- * nelem} and a variable number of arguments, as specified by {\em
- * narg}. N.B. The datablock and the additional arguments are contiguous
- * and are copied over together.  For example,
- *
- *        sendOpNV(PP_RESUME, tsoga.pe, 6, nelem, data,
- *	    (W_) ga.weight, (W_) ga.loc.gc.gtid, (W_) ga.loc.gc.slot, 
- *	    (W_) tsoga.weight, (W_) tsoga.loc.gc.gtid, (W_) tsoga.loc.gc.slot);
- *
- * Important: The variable arguments must all be StgWords.
-
- sendOpNV(_, tid, m, n, data, x1, ..., xm):
-
-                         |   n elems
-     +------------------------------
-     | x1 | ... | xm | n | data ....
-     +------------------------------
- */
-
-//@cindex sendOpNV
-void
-sendOpNV(OpCode op, GlobalTaskId task, int nelem, 
-	 StgWord *datablock, int narg, ...)
-{
-    va_list ap;
-    int i;
-    StgWord arg;
-
-    va_start(ap, narg);
-
-    traceSendOp(op, task, 0, 0);
-    IF_PAR_DEBUG(trace,
-		 fprintf(stderr,"~~ sendOpNV: op = %x (%s), task = %x, narg = %d, nelem = %d",
-		       op, getOpName(op), task, narg, nelem));
-
-    pvm_initsend(PvmDataRaw);
-
-    for (i = 0; i < narg; ++i) {
-	arg = va_arg(ap, StgWord);
-        IF_PAR_DEBUG(trace,
-		     fprintf(stderr,"~~ sendOpNV: arg = %d\n",arg));
-	PutArgN(i, arg);
-    }
-    arg = (StgWord) nelem;
-    PutArgN(narg, arg);
-
-/*  for (i=0; i < nelem; ++i) fprintf(stderr, "%d ",datablock[i]); */
-/*  fprintf(stderr," in sendOpNV\n");*/
-
-    PutArgs(datablock, nelem);
-    va_end(ap);
-
-    pvm_send(task, op);
-}
-
-/*    
- * sendOpN take a variable size array argument, whose size is given by
- * {\em n}.  For example,
- *
- *    sendOpN( PP_STATS, StatsTask, 3, stats_array);
- */
-
-//@cindex sendOpN
-void
-sendOpN(OpCode op, GlobalTaskId task, int n, StgPtr args)
-{
-    long arg;
-
-    traceSendOp(op, task, 0, 0);
-
-    pvm_initsend(PvmDataRaw);
-    arg = (long) n;
-    PutArgN(0, arg);
-    PutArgs(args, n);
-    pvm_send(task, op);
-}
-
-/*    
- * broadcastOpN is as sendOpN but broadcasts to all members of a group.
- */
-
-void
-broadcastOpN(OpCode op, char *group, int n, StgPtr args)
-{
-  long arg;
-
-  //traceSendOp(op, task, 0, 0);
-  
-  pvm_initsend(PvmDataRaw);
-  arg = (long) n;
-  PutArgN(0, arg);
-  PutArgs(args, n);
-  pvm_bcast(group, op);
-}
-
-/*
-   waitForPEOp waits for a packet from global task who with the
-   OpCode op.  If ignore is true all other messages are simply ignored; 
-   otherwise they are handled by processUnexpected.
- */
-//@cindex waitForPEOp
-rtsPacket 
-waitForPEOp(OpCode op, GlobalTaskId who, void(*processUnexpected)(rtsPacket) )
-{
-  rtsPacket p;
-  int nbytes;
-  OpCode opCode;
-  GlobalTaskId sender_id;
-  rtsBool match;
-
-  IF_PAR_DEBUG(verbose,
-	       fprintf(stderr,"~~ waitForPEOp: expecting op = %x (%s), who = [%x]\n", 
-		       op, getOpName(op), who)); 
-
-  do {
-    while((p = pvm_recv(ANY_TASK,ANY_OPCODE)) < 0)
-      pvm_perror("waitForPEOp: Waiting for PEOp");
-      
-    pvm_bufinfo( p, &nbytes, &opCode, &sender_id );
-    match = (op == ANY_OPCODE || op == opCode) && 
-            (who == ANY_TASK || who == sender_id);
-
-    if (match) {
-      IF_PAR_DEBUG(verbose,
-		   fprintf(stderr,
-			   "~~waitForPEOp: Qapla! received: OpCode = %#x (%s), sender_id = [%x]",
-			   opCode, getOpName(opCode), sender_id)); 
-
-      return(p);
-    }
-
-    /* Handle the unexpected OpCodes */
-    if (processUnexpected!=NULL) {
-      (*processUnexpected)(p);
-    } else {
-      IF_PAR_DEBUG(verbose,
-		   fprintf(stderr,
-			   "~~ waitForPEOp: ignoring OpCode = %#x (%s), sender_id = [%x]",
-			   opCode, getOpName(opCode), sender_id)); 
-    }
-
-  } while(rtsTrue);
-}
-
-/*
-  processUnexpected processes unexpected messages. If the message is a
-  FINISH it exits the prgram, and PVM gracefully
- */
-//@cindex processUnexpectedMessage
-void
-processUnexpectedMessage(rtsPacket packet) {
-    OpCode opCode = getOpcode(packet);
-
-    IF_PAR_DEBUG(verbose,
-		 GlobalTaskId sender = senderTask(packet); 
-		 fprintf(stderr,"~~ [%x] processUnexpected: Received %x (%s), sender %x\n",
-		       mytid, opCode, getOpName(opCode), sender)); 
-
-    switch (opCode) {
-    case PP_FINISH:
-        stg_exit(EXIT_SUCCESS);
-	break;
-
-      /* Anything we're not prepared to deal with.  Note that ALL OpCodes
-	 are discarded during termination -- this helps prevent bizarre
-	 race conditions.  */
-      default:
-	// if (!GlobalStopPending) 
-        {
-	  GlobalTaskId errorTask;
-	  OpCode opCode;
-
-	  getOpcodeAndSender(packet, &opCode, &errorTask);
-	  fprintf(stderr,"== Task %x: Unexpected OpCode %x from %x in processUnexpected",
-		mytid, opCode, errorTask );
-            
-	  stg_exit(EXIT_FAILURE);
-	}
-    }
-}
-
-//@cindex getOpcode
-OpCode 
-getOpcode(rtsPacket p)
-{
-  int nbytes;
-  OpCode OpCode;
-  GlobalTaskId sender_id;
-  /* read PVM buffer */
-  pvm_bufinfo(p, &nbytes, &OpCode, &sender_id);
-  /* return tag of the buffer as opcode */
-  return(OpCode);
-}
-
-//@cindex getOpcodeAndSender
-void
-getOpcodeAndSender(rtsPacket p, OpCode *opCodep, GlobalTaskId *senderIdp)
-{
-  int nbytes;
-  /* read PVM buffer */
-  pvm_bufinfo(p, &nbytes, opCodep, senderIdp);
-}
-
-//@cindex senderTask
-GlobalTaskId
-senderTask(rtsPacket p)
-{
-  int nbytes;
-  OpCode opCode;
-  GlobalTaskId sender_id;
-  /* read PVM buffer */
-  pvm_bufinfo(p, &nbytes, &opCode, &sender_id);
-  return(sender_id);
-}
-
-/*
- * startUpPE does the low-level comms specific startup stuff for a
- * PE. It initialises the comms system, joins the appropriate groups
- * allocates the PE buffer
- */
-
-//@cindex startUpPE
-void
-startUpPE(void)
-{ 
-  mytid = _my_gtid;	/* Initialise PVM and get task id into global var.*/
-  
-  IF_PAR_DEBUG(verbose,
-	       fprintf(stderr,"== [%x] PEStartup: Task id = [%x], No. PEs = %d \n", 
-		       mytid, mytid, nPEs));
-  checkComms(pvm_joingroup(PEGROUP), "PEStartup");
-  IF_PAR_DEBUG(verbose,
-	       fprintf(stderr,"== [%x] PEStartup: Joined PEGROUP\n", mytid));
-}
-
-/*
- * PEShutdown does the low-level comms-specific shutdown stuff for a
- * single PE. It leaves the groups and then exits from pvm.
- */
-//@cindex shutDownPE
-void
-shutDownPE(void)
-{    
-  IF_PAR_DEBUG(verbose,
-	       fprintf(stderr, "== [%x] PEshutdown\n", mytid));
-
-  checkComms(pvm_lvgroup(PEGROUP),"PEShutDown");
-  checkComms(pvm_exit(),"PEShutDown");
-}
-
-/* 
-   Extract the exit code out of a PP_FINISH packet (used in SysMan)
-*/
-int
-getExitCode(int nbytes, GlobalTaskId *sender_idp) {
-  int exitCode=0;
-
-  if (nbytes==4) {               // Notification from a task doing pvm_exit
-    GetArgs(sender_idp,1);       // Presumably this must be MainPE Id
-    exitCode = -1;
-  } else if (nbytes==8) {        // Doing a controlled shutdown
-    GetArgs(&exitCode,1);        // HACK: controlled shutdown == 2 values
-    GetArgs(&exitCode,1);
-  } else {
-    exitCode = -2;               // everything else
-  }
-  return exitCode;
-}
-
-#endif /* PAR -- whole file */
-
-//@node Index,  , Auxiliary functions, GUM Low-Level Inter-Task Communication
-//@subsection Index
-
-//@index
-//* getOpName::  @cindex\s-+getOpName
-//* traceSendOp::  @cindex\s-+traceSendOp
-//* sendOp::  @cindex\s-+sendOp
-//* sendOp1::  @cindex\s-+sendOp1
-//* sendOp2::  @cindex\s-+sendOp2
-//* sendOpV::  @cindex\s-+sendOpV
-//* sendOpNV::  @cindex\s-+sendOpNV
-//* sendOpN::  @cindex\s-+sendOpN
-//* waitForPEOp::  @cindex\s-+waitForPEOp
-//* processUnexpectedMessage::  @cindex\s-+processUnexpectedMessage
-//* getOpcode::  @cindex\s-+getOpcode
-//* getOpcodeAndSender::  @cindex\s-+getOpcodeAndSender
-//* senderTask::  @cindex\s-+senderTask
-//* startUpPE::  @cindex\s-+startUpPE
-//* shutDownPE::  @cindex\s-+shutDownPE
-//@end index
diff --git a/ghc/rts/parallel/PEOpCodes.h b/ghc/rts/parallel/PEOpCodes.h
deleted file mode 100644
index 2d18b439f2..0000000000
--- a/ghc/rts/parallel/PEOpCodes.h
+++ /dev/null
@@ -1,58 +0,0 @@
-#ifndef PEOPCODES_H
-#define PEOPCODES_H
-
-/************************************************************************
-*                         PEOpCodes.h                                   *
-*									*
-*	This file contains definitions for all the GUM PE Opcodes       *
-*       It's based on the GRAPH for PVM version                         *
-*       Phil Trinder, Glasgow University 8th December 1994              *
-*									*
-   RFPointon, December 1999
-     - removed PP_SYSMAN_TID, introduced PP_READY
-     - removed PP_MAIN_TASK, introduced PP_NEWPE
-     - added PP_REVAL
-************************************************************************/
-
-#define REPLY_OK		0x00
-
-/*Startup + Shutdown*/
-#define	PP_READY		0x50  /* sent PEs -> SysMan */
-#define	PP_NEWPE		0x51  /* sent via newHost notify -> SysMan */
-#define	PP_FINISH		0x52  /* sent PEs & via taskExit notfiy -> SysMan */
-#define	PP_PETIDS		0x53  /* sent sysman -> PEs */
-
-/* Stats stuff */
-#define	PP_STATS		0x54
-#define PP_STATS_ON		0x55
-#define PP_STATS_OFF		0x56
-
-//#define PP_FAIL		0x57 
-
-/*Garbage Collection*/
-#define PP_GC_INIT              0x58
-#define PP_FULL_SYSTEM          0x59
-#define PP_GC_POLL              0x5a
-
-/*GUM Messages*/
-#define PP_FETCH                0x5b
-#define PP_RESUME               0x5c
-#define PP_ACK                  0x5d
-#define PP_FISH                 0x5e
-#define PP_SCHEDULE             0x5f
-#define PP_FREE			0x60
-#define PP_REVAL		0x61
-
-
-#define	MIN_PEOPS		0x50
-#define	MAX_PEOPS		0x61
-
-#define	PEOP_NAMES		"Ready", "NewPE", \
-				"Finish", "PETIDS", \
-                                "Stats", "Stats_On", "Stats_Off", \
-  				"Fail", \
-                                "GCInit", "FullSystem", "GCPoll", \
-                                "Fetch","Resume","ACK","Fish","Schedule", \
-				"Free","REval"
-
-#endif /* PEOPCODES_H */
diff --git a/ghc/rts/parallel/Pack.c b/ghc/rts/parallel/Pack.c
deleted file mode 100644
index e8653f6303..0000000000
--- a/ghc/rts/parallel/Pack.c
+++ /dev/null
@@ -1,4293 +0,0 @@
-/* 
-   Time-stamp: <Wed Mar 21 2001 16:32:47 Stardate: [-30]6363.44 hwloidl>
-
-   Graph packing and unpacking code for sending it to another processor
-   and retrieving the original graph structure from the packet.
-   In the old RTS the code was split into Pack.c and Unpack.c (now deceased)
-   Used in GUM and GrAnSim.
-
-   The GrAnSim version of the code defines routines for *simulating* the
-   packing of closures in the same way it is done in the parallel runtime
-   system. Basically GrAnSim only puts the addresses of the closures to be
-   transferred into a buffer. This buffer will then be associated with the
-   event of transferring the graph. When this event is scheduled, the
-   @UnpackGraph@ routine is called and the buffer can be discarded
-   afterwards.
-
-   Note that in GranSim we need many buffers, not just one per PE.
-*/
-
-//@node Graph packing, , ,
-//@section Graph packing
-
-#if defined(PAR) || defined(GRAN)   /* whole file */
-
-//@menu
-//* Includes::			
-//* Prototypes::		
-//* Global variables::		
-//* ADT of Closure Queues::	
-//* Initialisation for packing::  
-//* Packing Functions::		
-//* Low level packing routines::  
-//* Unpacking routines::	
-//* Aux fcts for packing::	
-//* Printing Packet Contents::	
-//* End of file::		
-//@end menu
-//*/
-
-//@node Includes, Prototypes, Graph packing, Graph packing
-//@subsection Includes
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "ClosureTypes.h"
-#include "Storage.h"
-#include "Hash.h"
-#include "Parallel.h"
-#include "GranSimRts.h"
-#include "ParallelRts.h"
-# if defined(DEBUG)
-# include "Sanity.h"
-# include "Printer.h"
-# include "ParallelDebug.h"
-# endif
-#include "FetchMe.h"
-
-/* Which RTS flag should be used to get the size of the pack buffer ? */
-# if defined(PAR)
-#  define RTS_PACK_BUFFER_SIZE   RtsFlags.ParFlags.packBufferSize
-# else   /* GRAN */
-#  define RTS_PACK_BUFFER_SIZE   RtsFlags.GranFlags.packBufferSize
-# endif
-
-//@node Prototypes, Global variables, Includes, Graph packing
-//@subsection Prototypes
-/* 
-   Code declarations. 
-*/
-
-//@node ADT of closure queues, Init for packing, Prototypes, Prototypes
-//@subsubsection ADT of closure queues
-
-static inline void    	  InitClosureQueue(void);
-static inline rtsBool 	  QueueEmpty(void);
-static inline void    	  QueueClosure(StgClosure *closure);
-static inline StgClosure *DeQueueClosure(void);
-
-//@node Init for packing, Packing routines, ADT of closure queues, Prototypes
-//@subsubsection Init for packing
-
-static void     InitPacking(rtsBool unpack);
-# if defined(PAR)
-rtsBool         InitPackBuffer(void);
-# elif defined(GRAN)
-rtsPackBuffer  *InstantiatePackBuffer (void);
-static void     reallocPackBuffer (void);
-# endif
-
-//@node Packing routines, Low level packing fcts, Init for packing, Prototypes
-//@subsubsection Packing routines
-
-static void    PackClosure (StgClosure *closure);
-
-//@node Low level packing fcts, Unpacking routines, Packing routines, Prototypes
-//@subsubsection Low level packing fcts
-
-# if defined(GRAN)
-static  void    Pack (StgClosure *data);
-# else
-static  void    Pack (StgWord data);
-
-static void    PackGeneric(StgClosure *closure);
-static void    PackArray(StgClosure *closure);
-static void    PackPLC (StgPtr addr);
-static void    PackOffset (int offset);
-static void    PackPAP(StgPAP *pap);
-static rtsPackBuffer *PackTSO(StgTSO *tso, nat *packBufferSize);
-static rtsPackBuffer *PackStkO(StgPtr stko, nat *packBufferSize);
-static void           PackFetchMe(StgClosure *closure);
-
-static void    GlobaliseAndPackGA (StgClosure *closure);
-# endif
-
-//@node Unpacking routines, Aux fcts for packing, Low level packing fcts, Prototypes
-//@subsubsection Unpacking routines
-
-# if defined(PAR)
-void        InitPendingGABuffer(nat size); 
-void        CommonUp(StgClosure *src, StgClosure *dst);
-static StgClosure *SetGAandCommonUp(globalAddr *gaP, StgClosure *closure, 
-				  rtsBool hasGA);
-static nat         FillInClosure(StgWord ***bufptrP, StgClosure *graph);
-static void        LocateNextParent(StgClosure **parentP,
-				    nat *pptrP, nat *pptrsP, nat *sizeP);
-StgClosure        *UnpackGraph(rtsPackBuffer *packBuffer,
-			       globalAddr **gamap,
-			       nat *nGAs);
-static  StgClosure *UnpackClosure (StgWord ***bufptrP, StgClosure **graphP, 
-				   globalAddr *ga);
-static  StgWord   **UnpackGA(StgWord **bufptr, globalAddr *ga);
-static  StgClosure *UnpackOffset(globalAddr *ga);
-static  StgClosure *UnpackPLC(globalAddr *ga);
-static  void        UnpackArray(StgWord ***bufptrP, StgClosure *graph);
-static  nat         UnpackPAP(StgWord ***bufptrP, StgClosure *graph);
-
-# elif defined(GRAN)
-void        CommonUp(StgClosure *src, StgClosure *dst);
-StgClosure *UnpackGraph(rtsPackBuffer* buffer);
-#endif
-
-//@node Aux fcts for packing,  , Unpacking routines, Prototypes
-//@subsubsection Aux fcts for packing
-
-# if defined(PAR)
-static void 	DonePacking(void);
-static void 	AmPacking(StgClosure *closure);
-static int  	OffsetFor(StgClosure *closure);
-static rtsBool  NotYetPacking(int offset);
-static inline rtsBool  RoomToPack (nat size, nat ptrs);
-static inline rtsBool  isOffset(globalAddr *ga);
-static inline rtsBool  isFixed(globalAddr *ga);
-static inline rtsBool  isConstr(globalAddr *ga);
-static inline rtsBool  isUnglobalised(globalAddr *ga);
-# elif defined(GRAN)
-static void     DonePacking(void);
-static rtsBool  NotYetPacking(StgClosure *closure);
-# endif
-
-//@node Global variables, ADT of Closure Queues, Prototypes, Graph packing
-//@subsection Global variables
-/*
-  Static data declarations
-*/
-
-static nat     pack_locn,           /* ptr to first free loc in pack buffer */
-               clq_size, clq_pos,
-               buf_id = 1;          /* identifier for buffer */
-static nat     unpacked_size;
-static rtsBool roomInBuffer;
-#if defined(PAR)
-static GlobalTaskId dest_gtid=0;    /* destination for message to send */
-#endif
-
-/* 
-   The pack buffer
-   To be pedantic: in GrAnSim we're packing *addresses* of closures,
-   not the closures themselves.
-*/
-static rtsPackBuffer *globalPackBuffer = NULL,    /* for packing a graph */
-                     *globalUnpackBuffer = NULL;  /* for unpacking a graph */
-
-
-/*
-  Bit of a hack for testing if a closure is the root of the graph. This is
-  set in @PackNearbyGraph@ and tested in @PackClosure@.  
-*/
-
-static nat          packed_thunks = 0;
-static StgClosure  *graph_root;
-
-# if defined(PAR)
-/*
-  The offset hash table is used during packing to record the location in
-  the pack buffer of each closure which is packed.
-*/
-//@cindex offsetTable
-static HashTable *offsetTable;
-
-//@cindex PendingGABuffer
-static globalAddr *PendingGABuffer, *gaga;
-
-# endif /* PAR */
-
-
-//@node ADT of Closure Queues, Initialisation for packing, Global variables, Graph packing
-//@subsection ADT of Closure Queues
-
-//@menu
-//* Closure Queues::		
-//* Init routines::		
-//* Basic routines::		
-//@end menu
-
-//@node Closure Queues, Init routines, ADT of Closure Queues, ADT of Closure Queues
-//@subsubsection Closure Queues
-/*
-  Closure Queues
-
-  These routines manage the closure queue.
-*/
-
-static nat clq_pos, clq_size;
-
-static StgClosure **ClosureQueue = NULL;   /* HWL: init in main */
-
-#if defined(DEBUG)
-static char graphFingerPrint[MAX_FINGER_PRINT_LEN];
-#endif
-
-//@node Init routines, Basic routines, Closure Queues, ADT of Closure Queues
-//@subsubsection Init routines
-
-/* @InitClosureQueue@ allocates and initialises the closure queue. */
-
-//@cindex InitClosureQueue
-static inline void
-InitClosureQueue(void)
-{
-  clq_pos = clq_size = 0;
-
-  if (ClosureQueue==NULL)
-    ClosureQueue = (StgClosure**) stgMallocWords(RTS_PACK_BUFFER_SIZE, 
-						 "InitClosureQueue");
-}
-
-//@node Basic routines, Types of Global Addresses, Init routines, ADT of Closure Queues
-//@subsubsection Basic routines
-
-/*
-  QueueEmpty returns rtsTrue if the closure queue is empty; rtsFalse otherwise.
-*/
-
-//@cindex QueueEmpty
-static inline rtsBool
-QueueEmpty(void)
-{
-  return(clq_pos >= clq_size);
-}
-
-/* QueueClosure adds its argument to the closure queue. */
-
-//@cindex QueueClosure
-static inline void
-QueueClosure(closure)
-StgClosure *closure;
-{
-  if(clq_size < RTS_PACK_BUFFER_SIZE ) {
-    IF_PAR_DEBUG(paranoia,
-		 belch(">__> <<%d>> Q: %p (%s); %d elems in q",
-		       globalPackBuffer->id, closure, info_type(closure), clq_size-clq_pos));
-    ClosureQueue[clq_size++] = closure;
-  } else { 
-    barf("Closure Queue Overflow (EnQueueing %p (%s))", 
-	 closure, info_type(closure));
-  }
-}
-
-/* DeQueueClosure returns the head of the closure queue. */
-
-//@cindex DeQueueClosure
-static inline StgClosure * 
-DeQueueClosure(void)
-{
-  if(!QueueEmpty()) {
-    IF_PAR_DEBUG(paranoia,
-		 belch(">__> <<%d>> DeQ: %p (%s); %d elems in q",
-		       globalPackBuffer->id, ClosureQueue[clq_pos], info_type(ClosureQueue[clq_pos]), 
-		       clq_size-clq_pos));
-    return(ClosureQueue[clq_pos++]);
-  } else {
-    return((StgClosure*)NULL);
-  }
-}
-
-/* DeQueueClosure returns the head of the closure queue. */
-
-#if defined(DEBUG)
-//@cindex PrintQueueClosure
-static void
-PrintQueueClosure(void)
-{
-  nat i;
-
-  fputs("Closure queue:", stderr);
-  for (i=clq_pos; i < clq_size; i++)
-    fprintf(stderr, "%p (%s), ", 
-	    (StgClosure *)ClosureQueue[clq_pos++], 
-	    info_type(ClosureQueue[clq_pos++]));
-  fputc('\n', stderr);
-}
-#endif
-
-//@node Types of Global Addresses,  , Basic routines, ADT of Closure Queues
-//@subsubsection Types of Global Addresses
-
-/*
-  Types of Global Addresses
-
-  These routines determine whether a GA is one of a number of special types
-  of GA.
-*/
-
-# if defined(PAR)
-//@cindex isOffset
-static inline rtsBool 
-isOffset(globalAddr *ga)
-{
-    return (ga->weight == 1U && ga->payload.gc.gtid == (GlobalTaskId)0);
-}
-
-//@cindex isFixed
-static inline rtsBool
-isFixed(globalAddr *ga)
-{
-    return (ga->weight == 0U);
-}
-
-//@cindex isConstr
-static inline rtsBool
-isConstr(globalAddr *ga)
-{
-    return (ga->weight == 2U);
-}
-
-//@cindex isUnglobalised
-static inline rtsBool
-isUnglobalised(globalAddr *ga)
-{
-    return (ga->weight == 2U);
-}
-# endif
-
-//@node Initialisation for packing, Packing Functions, ADT of Closure Queues, Graph packing
-//@subsection Initialisation for packing
-/*
-  Simple Packing Routines
-
-  About packet sizes in GrAnSim: In GrAnSim we use a malloced block of
-  gransim_pack_buffer_size words to simulate a packet of pack_buffer_size
-  words.  In the simulated PackBuffer we only keep the addresses of the
-  closures that would be packed in the parallel system (see Pack). To
-  decide if a packet overflow occurs pack_buffer_size must be compared
-  versus unpacked_size (see RoomToPack).  Currently, there is no multi
-  packet strategy implemented, so in the case of an overflow we just stop
-  adding closures to the closure queue.  If an overflow of the simulated
-  packet occurs, we just realloc some more space for it and carry on as
-  usual.  -- HWL
-*/
-
-# if defined(GRAN)
-rtsPackBuffer *
-InstantiatePackBuffer (void) {
-  extern rtsPackBuffer *globalPackBuffer;
-
-  globalPackBuffer = (rtsPackBuffer *) stgMallocWords(sizeofW(rtsPackBuffer), 
-			 "InstantiatePackBuffer: failed to alloc packBuffer");
-  globalPackBuffer->size = RtsFlags.GranFlags.packBufferSize_internal;
-  globalPackBuffer->buffer = (StgWord **) stgMallocWords(RtsFlags.GranFlags.packBufferSize_internal,
-				 "InstantiatePackBuffer: failed to alloc GranSim internal packBuffer");
-  /* NB: gransim_pack_buffer_size instead of pack_buffer_size -- HWL */
-  /* stgMallocWords is now simple allocate in Storage.c */
-
-  return (globalPackBuffer);
-}
-
-/* 
-   Reallocate the GranSim internal pack buffer to make room for more closure
-   pointers. This is independent of the check for packet overflow as in GUM
-*/
-static void
-reallocPackBuffer (void) {
-
-  ASSERT(pack_locn >= (int)globalPackBuffer->size+sizeofW(rtsPackBuffer));
-
-  IF_GRAN_DEBUG(packBuffer,
-		belch("** Increasing size of PackBuffer %p to %d words (PE %u @ %d)\n",
-		      globalPackBuffer, globalPackBuffer->size+REALLOC_SZ,
-		      CurrentProc, CurrentTime[CurrentProc]));
-  
-  globalPackBuffer = (rtsPackBuffer*)realloc(globalPackBuffer, 
-				  sizeof(StgClosure*)*(REALLOC_SZ +
-						       (int)globalPackBuffer->size +
-						       sizeofW(rtsPackBuffer))) ;
-  if (globalPackBuffer==(rtsPackBuffer*)NULL) 
-    barf("Failing to realloc %d more words for PackBuffer %p (PE %u @ %d)\n", 
-	 REALLOC_SZ, globalPackBuffer, CurrentProc, CurrentTime[CurrentProc]);
-  
-  globalPackBuffer->size += REALLOC_SZ;
-
-  ASSERT(pack_locn < globalPackBuffer->size+sizeofW(rtsPackBuffer));
-}
-# endif
-
-# if defined(PAR)
-/* @initPacking@ initialises the packing buffer etc. */
-//@cindex InitPackBuffer
-rtsBool
-InitPackBuffer(void)
-{
-  if (globalPackBuffer==(rtsPackBuffer*)NULL) {
-    if ((globalPackBuffer = (rtsPackBuffer *) 
-	 stgMallocWords(sizeofW(rtsPackBuffer)+RtsFlags.ParFlags.packBufferSize+DEBUG_HEADROOM,
-			"InitPackBuffer")) == NULL)
-      return rtsFalse;
-  }
-  return rtsTrue;
-}
-
-# endif 
-//@cindex InitPacking
-static void
-InitPacking(rtsBool unpack)
-{
-# if defined(GRAN)
-  globalPackBuffer = InstantiatePackBuffer();     /* for GrAnSim only -- HWL */
-                                       /* NB: free in UnpackGraph */
-# elif defined(PAR)
-  if (unpack) {
-    /* allocate a GA-to-GA map (needed for ACK message) */
-    InitPendingGABuffer(RtsFlags.ParFlags.packBufferSize);
-  } else {
-    /* allocate memory to pack the graph into */
-    InitPackBuffer();
-  }
-# endif
-  /* init queue of closures seen during packing */
-  InitClosureQueue();
-
-  if (unpack) 
-    return;
-
-  globalPackBuffer->id = buf_id++;  /* buffer id are only used for debugging! */
-  pack_locn = 0;         /* the index into the actual pack buffer */
-  unpacked_size = 0;     /* the size of the whole graph when unpacked */
-  roomInBuffer = rtsTrue;
-  packed_thunks = 0;   /* total number of thunks packed so far */
-# if defined(PAR)
-  offsetTable = allocHashTable();
-# endif
-}
-
-//@node Packing Functions, Low level packing routines, Initialisation for packing, Graph packing
-//@subsection Packing Functions
-
-//@menu
-//* Packing Sections of Nearby Graph::	
-//* Packing Closures::		
-//@end menu
-
-//@node Packing Sections of Nearby Graph, Packing Closures, Packing Functions, Packing Functions
-//@subsubsection Packing Sections of Nearby Graph
-/*
-  Packing Sections of Nearby Graph
-
-  @PackNearbyGraph@ packs a closure and associated graph into a static
-  buffer (@PackBuffer@).  It returns the address of this buffer and the
-  size of the data packed into the buffer (in its second parameter,
-  @packBufferSize@).  The associated graph is packed in a depth first
-  manner, hence it uses an explicit queue of closures to be packed rather
-  than simply using a recursive algorithm.  Once the packet is full,
-  closures (other than primitive arrays) are packed as FetchMes, and their
-  children are not queued for packing.  */
-
-//@cindex PackNearbyGraph
-
-/* NB: this code is shared between GranSim and GUM;
-       tso only used in GranSim */
-rtsPackBuffer *
-PackNearbyGraph(closure, tso, packBufferSize, dest)
-StgClosure* closure;
-StgTSO* tso;
-nat *packBufferSize;
-GlobalTaskId dest;
-{
-  IF_PAR_DEBUG(resume,
-	       graphFingerPrint[0] = '\0');
-
-  ASSERT(RTS_PACK_BUFFER_SIZE > 0);
-  ASSERT(_HS==1);  // HWL HACK; compile time constant
-
-#if defined(PAR_TICKY) // HWL HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACK
-  PAR_TICKY_PACK_NEARBY_GRAPH_START();
-#endif
-
-  /* ToDo: check that we have enough heap for the packet
-     ngoq ngo'
-     if (Hp + PACK_HEAP_REQUIRED > HpLim) 
-     return NULL;
-  */
-  InitPacking(rtsFalse);
-# if defined(PAR)
-  dest_gtid=dest; //-1 to disable
-# elif defined(GRAN)
-  graph_root = closure;
-# endif
-
-  IF_GRAN_DEBUG(pack,
-		belch(">>> Packing <<%d>> (buffer @ %p); graph root @ %p [PE %d]\n    demanded by TSO %d (%p) [PE %u]",
-		      globalPackBuffer->id, globalPackBuffer, closure, where_is(closure), 
-		      tso->id, tso, where_is((StgClosure*)tso)));
-
-  IF_GRAN_DEBUG(pack,
-		belch("** PrintGraph of %p is:", closure); 
-		PrintGraph(closure,0));
-
-  IF_PAR_DEBUG(resume,
-	       GraphFingerPrint(closure, graphFingerPrint);
-	       ASSERT(strlen(graphFingerPrint)<=MAX_FINGER_PRINT_LEN);
-	       belch(">>> Packing <<%d>> (buffer @ %p); graph root @ %p [%x]\n    demanded by TSO %d (%p); Finger-print is\n    {%s}",
-		     globalPackBuffer->id, globalPackBuffer, closure, mytid,
-		     tso->id, tso, graphFingerPrint)); 
-
-  IF_PAR_DEBUG(packet,
-	       belch("** PrintGraph of %p is:", closure); 
-	       belch("** pack_locn=%d", pack_locn);
-	       PrintGraph(closure,0));
-
-  QueueClosure(closure);
-  do {
-    PackClosure(DeQueueClosure());
-  } while (!QueueEmpty());
-  
-# if defined(PAR)
-
-  /* Record how much space the graph needs in packet and in heap */
-  globalPackBuffer->tso = tso;       // currently unused, I think (debugging?)
-  globalPackBuffer->unpacked_size = unpacked_size;
-  globalPackBuffer->size = pack_locn;
-
-  /* Check for buffer overflow (again) */
-  ASSERT(pack_locn <= RtsFlags.ParFlags.packBufferSize+DEBUG_HEADROOM);
-  IF_DEBUG(sanity,                           // write magic end-of-buffer word
-	   globalPackBuffer->buffer[pack_locn] = END_OF_BUFFER_MARKER);
-  *packBufferSize = pack_locn;
-
-# else  /* GRAN */
-
-  /* Record how much space is needed to unpack the graph */
-  // PackBuffer[PACK_FLAG_LOCN] = (P_) MAGIC_PACK_FLAG;  for testing
-  globalPackBuffer->tso = tso;
-  globalPackBuffer->unpacked_size = unpacked_size;
-
-  // ASSERT(pack_locn <= PackBuffer[PACK_SIZE_LOCN]+PACK_HDR_SIZE);
-  /* ToDo: Print an earlier, more meaningful message */
-  if (pack_locn==0)   /* i.e. packet is empty */
-    barf("EMPTY PACKET! Can't transfer closure %p at all!!\n",
-	 closure);
-  globalPackBuffer->size = pack_locn;
-  *packBufferSize = pack_locn;
-
-# endif
-
-  DonePacking();                               /* {GrAnSim}vaD 'ut'Ha' */
-
-# if defined(GRAN)
-  IF_GRAN_DEBUG(pack ,
-		belch("** Finished <<%d>> packing graph %p; closures packed: %d; thunks packed: %d; size of graph: %d",
-		      globalPackBuffer->id, closure, globalPackBuffer->size, packed_thunks, globalPackBuffer->unpacked_size));
-  if (RtsFlags.GranFlags.GranSimStats.Global) {
-    globalGranStats.tot_packets++; 
-    globalGranStats.tot_packet_size += pack_locn; 
-  }
-  
-  IF_GRAN_DEBUG(pack, PrintPacket(globalPackBuffer));
-# elif defined(PAR)
-  IF_PAR_DEBUG(packet,
-		belch("** Finished <<%d>> packing graph %p (%s); closures packed: %d; thunks packed: %d; size of graph: %d",
-		      globalPackBuffer->id, closure, info_type(closure),
-		      globalPackBuffer->size, packed_thunks, 
-		      globalPackBuffer->unpacked_size));;
-
-  IF_DEBUG(sanity, // do a sanity check on the packet just constructed 
-	   checkPacket(globalPackBuffer));
-# endif   /* GRAN */
-
-#if defined(PAR_TICKY) // HWL HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACK
-  PAR_TICKY_PACK_NEARBY_GRAPH_END(globalPackBuffer->size, packed_thunks);
-#endif
-  
-  return (globalPackBuffer);
-}
-
-//@cindex PackOneNode
-
-# if defined(GRAN)
-/* This version is used when the node is already local */
-
-rtsPackBuffer *
-PackOneNode(closure, tso, packBufferSize)
-StgClosure* closure;
-StgTSO* tso;
-nat *packBufferSize;
-{
-  extern rtsPackBuffer *globalPackBuffer;
-  int i, clpack_locn;
-
-  InitPacking(rtsFalse);
-
-  IF_GRAN_DEBUG(pack,
-		belch("** PackOneNode: %p (%s)[PE %d] requested by TSO %d (%p) [PE %d]",
-		      closure, info_type(closure),
-		      where_is(closure), tso->id, tso, where_is((StgClosure *)tso)));
-
-  Pack(closure);
-
-  /* Record how much space is needed to unpack the graph */
-  globalPackBuffer->tso = tso;
-  globalPackBuffer->unpacked_size = unpacked_size;
-
-  /* Set the size parameter */
-  ASSERT(pack_locn <= RTS_PACK_BUFFER_SIZE);
-  globalPackBuffer->size =  pack_locn;
-  *packBufferSize = pack_locn;
-
-  if (RtsFlags.GranFlags.GranSimStats.Global) {
-    globalGranStats.tot_packets++; 
-    globalGranStats.tot_packet_size += pack_locn; 
-  }
-  IF_GRAN_DEBUG(pack,
-    PrintPacket(globalPackBuffer));
-
-  return (globalPackBuffer);
-}
-# endif  /* GRAN */
-
-#if defined(GRAN)
-
-/*
-   PackTSO and PackStkO are entry points for two special kinds of closure
-   which are used in the parallel RTS.  Compared with other closures they
-   are rather awkward to pack because they don't follow the normal closure
-   layout (where all pointers occur before all non-pointers).  Luckily,
-   they're only needed when migrating threads between processors.  */
-
-//@cindex PackTSO
-rtsPackBuffer*
-PackTSO(tso, packBufferSize)
-StgTSO *tso;
-nat *packBufferSize;
-{
-  extern rtsPackBuffer *globalPackBuffer;
-  IF_GRAN_DEBUG(pack,
-		belch("** Packing TSO %d (%p)", tso->id, tso));
-  *packBufferSize = 0;
-  // PackBuffer[0] = PackBuffer[1] = 0; ???
-  return(globalPackBuffer);
-}
-
-//@cindex PackStkO
-static rtsPackBuffer*
-PackStkO(stko, packBufferSize)
-StgPtr stko;
-nat *packBufferSize;
-{
-  extern rtsPackBuffer *globalPackBuffer;
-  IF_GRAN_DEBUG(pack,
-		belch("** Packing STKO %p", stko));
-  *packBufferSize = 0;
-  // PackBuffer[0] = PackBuffer[1] = 0;
-  return(globalPackBuffer);
-}
-
-static void
-PackFetchMe(StgClosure *closure)
-{
-  barf("{PackFetchMe}Daq Qagh: no FetchMe closures in GRAN!");
-}
-
-#elif defined(PAR)
-
-static rtsPackBuffer*
-PackTSO(tso, packBufferSize)
-StgTSO *tso;
-nat *packBufferSize;
-{
-  barf("{PackTSO}Daq Qagh: trying to pack a TSO %d (%p) of size %d; thread migrations not supported, yet",
-       tso->id, tso, packBufferSize);
-}
-
-rtsPackBuffer*
-PackStkO(stko, packBufferSize)
-StgPtr stko;
-nat *packBufferSize;
-{
-  barf("{PackStkO}Daq Qagh: trying to pack a STKO (%p) of size %d; thread migrations not supported, yet",
-       stko, packBufferSize);
-}
-
-//@cindex PackFetchMe
-static void
-PackFetchMe(StgClosure *closure)
-{
-  StgInfoTable *ip;
-  nat i;
-  int offset;
-#if defined(DEBUG)
-  nat x = pack_locn;
-#endif
-
-#if defined(GRAN)
-  barf("{PackFetchMe}Daq Qagh: no FetchMe closures in GRAN!");
-#else
-  offset = OffsetFor(closure);
-  if (!NotYetPacking(offset)) {
-    IF_PAR_DEBUG(pack,
-		 belch("*>.. Packing FETCH_ME for closure %p (s) as offset to %d",
-		       closure, info_type(closure), offset));
-    PackOffset(offset);
-    // unpacked_size += 0;   // unpacked_size unchanged (closure is shared!!)
-    return;
-  }
-
-  /* Need a GA even when packing a constructed FETCH_ME (cruel world!) */
-  AmPacking(closure);
-  /* FMs must be always globalised */
-  GlobaliseAndPackGA(closure);
-
-  IF_PAR_DEBUG(pack,
-	       belch("*>.. Packing FETCH_ME for closure %p (%s) with GA: ((%x, %d, %x))",
-		     closure, info_type(closure), 
-		     globalPackBuffer->buffer[pack_locn-2],
-		     globalPackBuffer->buffer[pack_locn-1],
-		     globalPackBuffer->buffer[pack_locn-3]));
-
-  /* Pack a FetchMe closure instead of closure */
-  ip = &stg_FETCH_ME_info;
-  /* this assumes that the info ptr is always the first word in a closure*/
-  Pack((StgWord)ip);
-  for (i = 1; i < _HS; ++i)               // pack rest of fixed header
-    Pack((StgWord)*(((StgPtr)closure)+i));
-  
-  unpacked_size += sizeofW(StgFetchMe);
-  /* size of FETCHME in packed is the same as that constant */
-  ASSERT(pack_locn-x==PACK_FETCHME_SIZE);
-  /* In the pack buffer the pointer to a GA (in the FetchMe closure) 
-     is expanded to the full GA; this is a compile-time const */
-  //ASSERT(PACK_FETCHME_SIZE == sizeofW(StgFetchMe)-1+PACK_GA_SIZE);  
-#endif
-}
-
-#endif
-
-#ifdef DIST
-static void
-PackRemoteRef(StgClosure *closure)
-{
-  StgInfoTable *ip;
-  nat i;
-  int offset;
-
-  offset = OffsetFor(closure);
-  if (!NotYetPacking(offset)) {
-    PackOffset(offset);
-    unpacked_size += 2;
-    return;
-  }
-
-  /* Need a GA even when packing a constructed REMOTE_REF (cruel world!) */
-  AmPacking(closure);
-  
-  /* basically we just Globalise, but for sticky things we can't have multiple GAs,
-     so we must prevent the GAs being split.
-     
-     In returning things to the true sticky owner, this case is already handled, but for
-     anything else we just give up at the moment... This needs to be fixed! 
-  */
-  { globalAddr *ga;
-    ga = LAGAlookup(closure); // surely this ga must exist?
-    
-    // ***************************************************************************
-    // ***************************************************************************
-    // REMOTE_REF HACK - dual is in SetGAandCommonUp
-    // - prevents the weight from ever reaching zero
-    if(ga != NULL) 
-      ga->weight=0x06660666; //anything apart from 0 really...
-    // ***************************************************************************
-    // ***************************************************************************
-    
-    if((ga != NULL)&&(ga->weight / 2 <= 2))
-      barf("Cant split the weight any further when packing REMOTE_REF for closure %p (%s) with GA: ((%x, %d, %x))",
-		closure, info_type(closure), 
-	   	ga->payload.gc.gtid, ga->payload.gc.slot, ga->weight);   			     
-  } 
-  GlobaliseAndPackGA(closure);
-      
-  IF_PAR_DEBUG(pack,
-	       belch("*>.. Packing REMOTE_REF for closure %p (%s) with GA: ((%x, %d, %x))",
-		     closure, info_type(closure), 
-		     globalPackBuffer->buffer[pack_locn-2],
-		     globalPackBuffer->buffer[pack_locn-1],
-		     globalPackBuffer->buffer[pack_locn-3]));
-
-  /* Pack a REMOTE_REF closure instead of closure */
-  ip = &stg_REMOTE_REF_info;
-  /* this assumes that the info ptr is always the first word in a closure*/
-  Pack((StgWord)ip);
-  for (i = 1; i < _HS; ++i)               // pack rest of fixed header
-    Pack((StgWord)*(((StgPtr)closure)+i));
-  
-  unpacked_size += PACK_FETCHME_SIZE;
-}
-#endif /* DIST */
-
-//@node Packing Closures,  , Packing Sections of Nearby Graph, Packing Functions
-//@subsubsection Packing Closures
-/*
-  Packing Closures
-
-  @PackClosure@ is the heart of the normal packing code.  It packs a single
-  closure into the pack buffer, skipping over any indirections and
-  globalising it as necessary, queues any child pointers for further
-  packing, and turns it into a @FetchMe@ or revertible black hole (@RBH@)
-  locally if it was a thunk.  Before the actual closure is packed, a
-  suitable global address (GA) is inserted in the pack buffer.  There is
-  always room to pack a fetch-me to the closure (guaranteed by the
-  RoomToPack calculation), and this is packed if there is no room for the
-  entire closure.
-
-  Space is allocated for any primitive array children of a closure, and
-  hence a primitive array can always be packed along with it's parent
-  closure.  */
-
-//@cindex PackClosure
-
-# if defined(PAR)
-
-void
-PackClosure(closure)
-StgClosure *closure;
-{
-  StgInfoTable *info;
-  nat clpack_locn;
-
-  ASSERT(LOOKS_LIKE_GHC_INFO(get_itbl(closure)));
-
-  closure = UNWIND_IND(closure);
-  /* now closure is the thing we want to pack */
-  info = get_itbl(closure);
-
-  clpack_locn = OffsetFor(closure);
-
-  /* If the closure has been packed already, just pack an indirection to it
-     to guarantee that the graph doesn't become a tree when unpacked */
-  if (!NotYetPacking(clpack_locn)) {
-    PackOffset(clpack_locn);
-    return;
-  }
-
-  switch (info->type) {
-
-  case CONSTR_CHARLIKE:
-    IF_PAR_DEBUG(pack,
-		 belch("*>^^ Packing a charlike closure %d", 
-		       ((StgIntCharlikeClosure*)closure)->data));
-    
-    PackPLC((StgPtr)CHARLIKE_CLOSURE(((StgIntCharlikeClosure*)closure)->data));
-    // NB: unpacked_size of a PLC is 0
-    return;
-      
-  case CONSTR_INTLIKE:
-    {
-      StgInt val = ((StgIntCharlikeClosure*)closure)->data;
-
-      if ((val <= MAX_INTLIKE) && (val >= MIN_INTLIKE)) {
-	IF_PAR_DEBUG(pack,
-		     belch("*>^^ Packing a small intlike %d as a PLC", 
-			   val));
-	PackPLC((StgPtr)INTLIKE_CLOSURE(val));
-	// NB: unpacked_size of a PLC is 0
-	return;
-      } else {
-	IF_PAR_DEBUG(pack,
-		     belch("*>^^ Packing a big intlike %d as a normal closure", 
-			   val));
-	PackGeneric(closure);
-	return;
-      }
-    }
-
-  case CONSTR:
-  case CONSTR_1_0:
-  case CONSTR_0_1:
-  case CONSTR_2_0:
-  case CONSTR_1_1:
-  case CONSTR_0_2:
-    /* it's a constructor (i.e. plain data) */
-    IF_PAR_DEBUG(pack,
-		 belch("*>^^ Packing a CONSTR %p (%s) using generic packing", 
-		       closure, info_type(closure)));
-    PackGeneric(closure);
-    return;
-
-  case THUNK_STATIC:       // ToDo: check whether that's ok
-  case FUN_STATIC:       // ToDo: check whether that's ok
-  case CONSTR_STATIC:
-  case CONSTR_NOCAF_STATIC:// For now we ship indirections to CAFs: They are
-			   // evaluated on each PE if needed
-    IF_PAR_DEBUG(pack,
-		 belch("*>~~ Packing a %p (%s) as a PLC", 
-		       closure, info_type(closure)));
-
-    PackPLC((StgPtr)closure);
-    // NB: unpacked_size of a PLC is 0
-    return;
-
-  case THUNK_SELECTOR: 
-    {
-      StgClosure *selectee = ((StgSelector *)closure)->selectee;
-
-      IF_PAR_DEBUG(pack,
-		   belch("*>** Found THUNK_SELECTOR at %p (%s) pointing to %p (%s); using PackGeneric", 
-			 closure, info_type(closure), 
-			 selectee, info_type(selectee)));
-      PackGeneric(closure);
-      /* inlined code; probably could use PackGeneric
-      Pack((StgWord)(*(StgPtr)closure));  
-      Pack((StgWord)(selectee));
-      QueueClosure(selectee);
-      unpacked_size += 2;
-      */
-    }
-    return;
-
-  case  FUN:
-  case	FUN_1_0:
-  case	FUN_0_1:
-  case	FUN_2_0:
-  case	FUN_1_1:
-  case	FUN_0_2:
-  case  THUNK:
-  case	THUNK_1_0:
-  case	THUNK_0_1:
-  case	THUNK_2_0:
-  case	THUNK_1_1:
-  case	THUNK_0_2:
-    PackGeneric(closure);
-    return;
-
-  case AP_UPD:
-  case PAP:
-    /* 
-    barf("*>   Packing of PAP not implemented %p (%s)",
-		       closure, info_type(closure));
-	 
-       Currently we don't pack PAPs; we pack a FETCH_ME to the closure, 
-       instead. Note that since PAPs contain a chunk of stack as payload,
-       implementing packing of PAPs is a first step towards thread migration.
-    IF_PAR_DEBUG(pack,
-		 belch("*>.. Packing a PAP closure at %p (%s) as a FETCH_ME", 
-		       closure, info_type(closure)));
-    PackFetchMe(closure);
-    */
-    PackPAP((StgPAP *)closure);
-    return;
-
-  case CAF_BLACKHOLE:
-  case BLACKHOLE:
-  case BLACKHOLE_BQ:
-  case SE_BLACKHOLE:
-  case SE_CAF_BLACKHOLE:
-  case RBH:
-  case FETCH_ME:
-  case FETCH_ME_BQ:
-
-    /* If it's a (revertible) black-hole, pack a FetchMe closure to it */
-    //ASSERT(pack_locn > PACK_HDR_SIZE);
-    
-    IF_PAR_DEBUG(pack,
-		 belch("*>.. Packing a BH-like closure at %p (%s) as a FETCH_ME", 
-		       closure, info_type(closure)));
-    /* NB: in case of a FETCH_ME this might build up a chain of FETCH_MEs;
-           phps short-cut the GA here */
-    PackFetchMe(closure);
-    return;
-
-#ifdef DIST    
-  case REMOTE_REF:
-    IF_PAR_DEBUG(pack,
-		 belch("*>.. Packing %p (%s) as a REMOTE_REF", 
-		       closure, info_type(closure)));
-    PackRemoteRef(closure);
-    /* we hopefully don't end up with a chain of REMOTE_REFs!!!!!!!!!! */
-
-    return;
-#endif  
-    
-  case TSO:
-  case MVAR:
-#ifdef DIST
-          IF_PAR_DEBUG(pack,
-		 belch("*>.. Packing %p (%s) as a RemoteRef", 
-		       closure, info_type(closure)));
-    PackRemoteRef(closure);
-#else
-    barf("{Pack}Daq Qagh: Only GdH can pack %p (%s)", 
-	 closure, info_type(closure));
-#endif    
-    return;
-    
-  case ARR_WORDS:
-    PackArray(closure);
-    return;
-
-  case MUT_ARR_PTRS:
-  case MUT_ARR_PTRS_FROZEN:
-  case MUT_VAR:
-    /* 
-       Eventually, this should use the same packing routine as ARR_WRODS
-
-       GlobaliseAndPackGA(closure);
-       PackArray(closure);
-       return;
-    */
-    barf("Qagh{Pack}Doq: packing of mutable closures not yet implemented: %p (%s)",
-	 closure, info_type(closure));
-
-#  ifdef DEBUG
-  case BCO:
-    barf("{Pack}Daq Qagh: found BCO closure %p (%s); GUM hates interpreted code", 
-	 closure, info_type(closure));
-    /* never reached */
-    
-    // check error cases only in a debugging setup
-  case RET_BCO:
-  case RET_SMALL:
-  case RET_VEC_SMALL:
-  case RET_BIG:
-  case RET_VEC_BIG:
-  case RET_DYN:
-    barf("{Pack}Daq Qagh: found return vector %p (%s) when packing (thread migration not implemented)", 
-	 closure, info_type(closure));
-    /* never reached */
-    
-  case UPDATE_FRAME:
-  case STOP_FRAME:
-  case CATCH_FRAME:
-  case SEQ_FRAME:
-    barf("{Pack}Daq Qagh: found stack frame %p (%s) when packing (thread migration not implemented)", 
-	 closure, info_type(closure));
-    /* never reached */
-
-  case BLOCKED_FETCH:
-  case EVACUATED:
-    /* something's very wrong */
-    barf("{Pack}Daq Qagh: found %s (%p) when packing", 
-	 info_type(closure), closure);
-    /* never reached */
-
-  case IND:
-  case IND_OLDGEN:
-  case IND_PERM:
-  case IND_OLDGEN_PERM:
-  case IND_STATIC:
-    barf("Pack: found IND_... after shorting out indirections %d (%s)", 
-	 (nat)(info->type), info_type(closure));
-
-  case WEAK:
-  case FOREIGN:
-  case STABLE_NAME:
-    barf("Pack: found foreign thingy; not yet implemented in %d (%s)", 
-	 (nat)(info->type), info_type(closure));
-#endif
-
-  default:
-    barf("Pack: strange closure %d", (nat)(info->type));
-  } /* switch */
-}
-
-/*
-  Pack a constructor of unknown size.
-  Similar to PackGeneric but without creating GAs.
-*/
-#if 0
-//@cindex PackConstr
-static void
-PackConstr(StgClosure *closure)
-{
-  StgInfoTable *info;
-  nat size, ptrs, nonptrs, vhs, i;
-  char str[80];
-
-  ASSERT(LOOKS_LIKE_GHC_INFO(closure->header.info));
-
-  /* get info about basic layout of the closure */
-  info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
-
-  ASSERT(info->type == CONSTR ||
-         info->type == CONSTR_1_0 ||
-         info->type == CONSTR_0_1 ||
-         info->type == CONSTR_2_0 ||
-         info->type == CONSTR_1_1 ||
-         info->type == CONSTR_0_2);
-
-  IF_PAR_DEBUG(pack,
-	       fprintf(stderr, "*>^^ packing a constructor at %p (%s) (size=%d, ptrs=%d, nonptrs=%d)\n",
-		       closure, info_type(closure), size, ptrs, nonptrs));
-
-  /* Primitive arrays have gone; now we have (MUT_)ARR_WORDS etc */
-
-  if (!RoomToPack(PACK_GA_SIZE + _HS + vhs + nonptrs, ptrs)) {
-    IF_PAR_DEBUG(pack,
-		 belch("*>&& pack buffer is full; packing FETCH_ME for closure %p (%s)",
-		       closure, info_type(closure)));
-    PackFetchMe(closure);
-    return;
-  }
-
-  /* Record the location of the GA */
-  AmPacking(closure);
-
-  /* Pack Constructor marker */
-  Pack((StgWord)2);
-
-  /* pack fixed and variable header */
-  for (i = 0; i < _HS + vhs; ++i)
-    Pack((StgWord)*(((StgPtr)closure)+i));
-      
-  /* register all ptrs for further packing */
-  for (i = 0; i < ptrs; ++i)
-    QueueClosure(((StgClosure *) *(((StgPtr)closure)+(_HS+vhs)+i)));
-
-  /* pack non-ptrs */
-  for (i = 0; i < nonptrs; ++i)
-    Pack((StgWord)*(((StgPtr)closure)+(_HS+vhs)+ptrs+i));
-}
-#endif
-
-/*
-  Generic packing code.
-  This code is performed for `ordinary' closures such as CONSTR, THUNK etc.
-*/
-//@cindex PackGeneric
-static void
-PackGeneric(StgClosure *closure)
-{
-  StgInfoTable *info;
-  StgClosure *rbh;
-  nat size, ptrs, nonptrs, vhs, i, m;
-  char str[80];
-
-  ASSERT(LOOKS_LIKE_COOL_CLOSURE(closure));
-
-  /* get info about basic layout of the closure */
-  info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
-
-  ASSERT(!IS_BLACK_HOLE(closure));
-
-  IF_PAR_DEBUG(pack,
-	       fprintf(stderr, "*>== %p (%s): generic packing (size=%d, ptrs=%d, nonptrs=%d)\n",
-		       closure, info_type(closure), size, ptrs, nonptrs));
-
-  /* packing strategies: how many thunks to add to a packet; 
-     default is infinity i.e. RtsFlags.ParFlags.thunksToPack==0 */
-  if (RtsFlags.ParFlags.thunksToPack &&
-      packed_thunks >= RtsFlags.ParFlags.thunksToPack &&
-      closure_THUNK(closure)) {
-    IF_PAR_DEBUG(pack,
-		 belch("*>&& refusing to pack more than %d thunks per packet; packing FETCH_ME for closure %p (%s)",
-		       packed_thunks, closure, info_type(closure)));
-    PackFetchMe(closure);
-    return;
-  }
-
-  /* Primitive arrays have gone; now we have (MUT_)ARR_WORDS etc */
-
-  if (!RoomToPack(PACK_GA_SIZE + _HS + vhs + nonptrs, ptrs)) {
-    IF_PAR_DEBUG(pack,
-		 belch("*>&& pack buffer is full; packing FETCH_ME for closure %p (%s)",
-		       closure, info_type(closure)));
-    PackFetchMe(closure);
-    return;
-  }
-
-  /* Record the location of the GA */
-  AmPacking(closure);
-  /* Allocate a GA for this closure and put it into the buffer */
-  /* Checks for globalisation scheme; default: globalise everything thunks */
-  if ( RtsFlags.ParFlags.globalising == 0 || 
-       (closure_THUNK(closure) && !closure_UNPOINTED(closure)) )
-    GlobaliseAndPackGA(closure);
-  else
-    Pack((StgWord)2);  // marker for unglobalised closure
-
-
-  ASSERT(!(info->type == ARR_WORDS || info->type == MUT_ARR_PTRS ||
-	   info->type == MUT_ARR_PTRS_FROZEN || info->type == MUT_VAR));
-
-  /* At last! A closure we can actually pack! */
-  if (ip_MUTABLE(info) && ((info->type != FETCH_ME)||(info->type != REMOTE_REF)))
-    barf("*>// %p (%s) PackClosure: trying to replicate a Mutable closure!",
-	 closure, info_type(closure));
-      
-  /* 
-     Remember, the generic closure layout is as follows:
-        +-------------------------------------------------+
-	| FIXED HEADER | VARIABLE HEADER | PTRS | NON-PRS |
-        +-------------------------------------------------+
-  */
-  /* pack fixed and variable header */
-  for (i = 0; i < _HS + vhs; ++i)
-    Pack((StgWord)*(((StgPtr)closure)+i));
-      
-  /* register all ptrs for further packing */
-  for (i = 0; i < ptrs; ++i)
-    QueueClosure(((StgClosure *) *(((StgPtr)closure)+(_HS+vhs)+i)));
-
-  /* pack non-ptrs */
-  for (i = 0; i < nonptrs; ++i)
-    Pack((StgWord)*(((StgPtr)closure)+(_HS+vhs)+ptrs+i));
-      
-  // ASSERT(_HS+vhs+ptrs+nonptrs==size);
-  if ((m=_HS+vhs+ptrs+nonptrs)<size) {
-    IF_PAR_DEBUG(pack,
-		 belch("*>** WARNING: slop in closure %p (%s); filling %d words; SHOULD NEVER HAPPEN",
-		       closure, info_type(closure), size-m));
-    for (i=m; i<size; i++) 
-      Pack((StgWord)*(((StgPtr)closure)+i));
-  }
-
-  unpacked_size += size;
-  //unpacked_size += (size < MIN_UPD_SIZE) ? MIN_UPD_SIZE : size;
-
-  /*
-   * Record that this is a revertable black hole so that we can fill in
-   * its address from the fetch reply.  Problem: unshared thunks may cause
-   * space leaks this way, their GAs should be deallocated following an
-   * ACK.
-   */
-      
-  if (closure_THUNK(closure) && !closure_UNPOINTED(closure)) { 
-    rbh = convertToRBH(closure);
-    ASSERT(size>=_HS+MIN_UPD_SIZE); // min size for any updatable closure
-    ASSERT(rbh == closure);         // rbh at the same position (minced version)
-    packed_thunks++;
-  } else if ( closure==graph_root ) {
-    packed_thunks++;                // root of graph is counted as a thunk
-  }
-}
-/*
-  Pack an array of words.
-  ToDo: implement packing of MUT_ARRAYs
-*/
-
-//@cindex PackArray
-static void
-PackArray(StgClosure *closure)
-{
-  StgInfoTable *info;
-  nat size, ptrs, nonptrs, vhs;
-  nat i, n;
-  char str[80];
-
-  /* get info about basic layout of the closure */
-  info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
-
-  ASSERT(info->type == ARR_WORDS || info->type == MUT_ARR_PTRS ||
-	 info->type == MUT_ARR_PTRS_FROZEN || info->type == MUT_VAR);
-
-  n = ((StgArrWords *)closure)->words;
-  // this includes the header!: arr_words_sizeW(stgCast(StgArrWords*,q)); 
-
-  IF_PAR_DEBUG(pack,
-	       belch("*>== %p (%s): packing an array of %d words (size=%d)\n",
-		     closure, info_type(closure), n,
-		     arr_words_sizeW((StgArrWords *)closure)));
-
-  /* check that we have enough room in the pack buffer */
-  if (!RoomToPack(PACK_GA_SIZE + _HS + vhs + nonptrs, ptrs)) {
-    IF_PAR_DEBUG(pack,
-		 belch("*>&& pack buffer is full; packing FETCH_ME for closure %p (%s)",
-		       closure, info_type(closure)));
-    PackFetchMe(closure);
-    return;
-  }
-
-  /* global stats about arrays sent */
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    globalParStats.tot_arrs++;
-    globalParStats.tot_arr_size += ((StgArrWords *)closure)->words;
-  }
-
-  /* record offset of the closure and allocate a GA */
-  AmPacking(closure);
-  /* Checks for globalisation scheme; default: globalise everything thunks */
-  if ( RtsFlags.ParFlags.globalising == 0 || 
-       (closure_THUNK(closure) && !closure_UNPOINTED(closure)) )
-    GlobaliseAndPackGA(closure);
-  else
-    Pack((StgWord)2);  // marker for unglobalised closure
-
-  /* Pack the header (2 words: info ptr and the number of words to follow) */
-  Pack((StgWord)*(StgPtr)closure);
-  Pack(((StgArrWords *)closure)->words);
-
-  /* pack the payload of the closure (all non-ptrs) */
-  for (i=0; i<n; i++)
-    Pack((StgWord)((StgArrWords *)closure)->payload[i]);
-
-  unpacked_size += arr_words_sizeW((StgArrWords *)closure);
-}
-
-/*
-   Pack a PAP closure.
-   Note that the representation of a PAP in the buffer is different from
-   its representation in the heap. In particular, pointers to local
-   closures are packed directly as FETCHME closures, using
-   PACK_FETCHME_SIZE words to represent q 1 word pointer in the orig graph
-   structure. To account for the difference in size we store the packed
-   size of the closure as part of the PAP's variable header in the buffer.
-*/
-
-//@cindex PackPAP
-static void
-PackPAP(StgPAP *pap) {
-  nat n, i, j, pack_start;
-  StgPtr p, q;
-  const StgInfoTable* info;
-  StgWord bitmap;
-  /* debugging only */
-  StgPtr end;
-  nat size, ptrs, nonptrs, vhs;
-  char str[80];
-  nat unpacked_size_before_PAP, FMs_in_PAP=0; // debugging only
-
-  /* This is actually a setup invariant; checked here 'cause it affects PAPs*/
-  //ASSERT(PACK_FETCHME_SIZE == sizeofW(StgFetchMe)-1+PACK_GA_SIZE);
-  ASSERT(NotYetPacking(OffsetFor((StgClosure *)pap)));
-  IF_DEBUG(sanity,
-	   unpacked_size_before_PAP = unpacked_size);
-
-  n = (nat)(pap->n_args);
-
-  /* get info about basic layout of the closure */
-  info = get_closure_info((StgClosure *)pap, &size, &ptrs, &nonptrs, &vhs, str);
-  ASSERT(ptrs==0 && nonptrs==0 && size==pap_sizeW(pap));
-
-  IF_PAR_DEBUG(pack,
-	       belch("*>**  %p (%s): PackPAP: packing PAP with %d words (size=%d; ptrs=%d; nonptrs=%d:", 
-		     (StgClosure *)pap, info_type((StgClosure *)pap),
-		     n, size, ptrs, nonptrs);
-               printClosure((StgClosure *)pap));
-
-  /* check that we have enough room in the pack buffer */
-  if (!RoomToPack(PACK_GA_SIZE + _HS + vhs + nonptrs, ptrs)) {
-    IF_PAR_DEBUG(pack,
-		 belch("*>&& pack buffer is full; packing FETCH_ME for closure %p (%s)",
-		       (StgClosure *)pap, info_type((StgClosure *)pap)));
-    PackFetchMe((StgClosure *)pap);
-    return;
-  }
-
-  /* record offset of the closure and allocate a GA */
-  AmPacking((StgClosure *)pap);
-  /* Checks for globalisation scheme; default: globalise everything thunks */
-  if ( RtsFlags.ParFlags.globalising == 0 || 
-       (closure_THUNK(pap) && !closure_UNPOINTED(pap)) )
-    GlobaliseAndPackGA((StgClosure *)pap);
-  else
-    Pack((StgWord)2);  // marker for unglobalised closure
-
-  /* Pack the PAP header */
-  Pack((StgWord)(pap->header.info));
-  Pack((StgWord)(pap->n_args));
-  Pack((StgWord)(pap->fun));
-  pack_start = pack_locn;   // to compute size of PAP in buffer
-  Pack((StgWord)0);    // this will be filled in later (size of PAP in buffer)
-
-  /* Pack the payload of a PAP i.e. a stack chunk */
-  /* pointers to start of stack chunk */
-  p = (StgPtr)(pap->payload);
-  end = (StgPtr)((nat)pap+pap_sizeW(pap)*sizeof(StgWord)); // (StgPtr)((nat)pap+sizeof(StgPAP)+sizeof(StgPtr)*n);
-  while (p<end) {
-    /* the loop body has been borrowed from scavenge_stack */
-    q = (StgPtr)*p;
-
-    /* If we've got a tag, pack all words in that block */
-    if (IS_ARG_TAG((W_)q)) {   // q stands for the no. of non-ptrs to follow
-      nat m = ARG_TAG((W_)q);      // first word after this block
-      IF_PAR_DEBUG(pack,
-		   belch("*>**    PackPAP @ %p: packing %d words (tagged), starting @ %p", 
-			 p, m, p));
-      for (i=0; i<m+1; i++)
-	Pack((StgWord)*(p+i));
-      p += m+1;                // m words + the tag
-      continue;
-    }
-     
-    /* If q is is a pointer to a (heap allocated) closure we pack a FETCH_ME
-       ToDo: provide RTS flag to also pack these closures
-    */
-    if (! LOOKS_LIKE_GHC_INFO(q) ) {
-      /* distinguish static closure (PLC) from other closures (FM) */
-      switch (get_itbl((StgClosure*)q)->type) {
-      case CONSTR_CHARLIKE:
-	IF_PAR_DEBUG(pack,
-		     belch("*>**    PackPAP: packing a charlike closure %d", 
-			   ((StgIntCharlikeClosure*)q)->data));
-    
-	PackPLC((StgPtr)CHARLIKE_CLOSURE(((StgIntCharlikeClosure*)q)->data));
-	p++;
-	break;
-      
-      case CONSTR_INTLIKE:
-	{
-	  StgInt val = ((StgIntCharlikeClosure*)q)->data;
-      
-	  if ((val <= MAX_INTLIKE) && (val >= MIN_INTLIKE)) {
-	    IF_PAR_DEBUG(pack,
-			 belch("*>**    PackPAP: Packing ptr to a small intlike %d as a PLC", val));
-	    PackPLC((StgPtr)INTLIKE_CLOSURE(val));
-	    p++;
-	    break;
-	  } else {
-	    IF_PAR_DEBUG(pack,
-			 belch("*>**    PackPAP: Packing a ptr to a big intlike %d as a FM", 
-			       val));
-	    Pack((StgWord)(ARGTAG_MAX+1));
-	    PackFetchMe((StgClosure *)q);
-	    p++;
-	    IF_DEBUG(sanity, FMs_in_PAP++);
-	    break;
-	  }
-	}
-	case THUNK_STATIC:       // ToDo: check whether that's ok
-	case FUN_STATIC:       // ToDo: check whether that's ok
-	case CONSTR_STATIC:
-	case CONSTR_NOCAF_STATIC:
-	  {
-	    IF_PAR_DEBUG(pack,
-			 belch("*>**    PackPAP: packing a ptr to a %p (%s) as a PLC", 
-			       q, info_type((StgClosure *)q)));
-	    
-	    PackPLC((StgPtr)q);
-	    p++;
-	    break;
-	  }
-      default:
-	  IF_PAR_DEBUG(pack,
-		       belch("*>**    PackPAP @ %p: packing FM to %p (%s)", 
-			     p, q, info_type((StgClosure*)q)));
-	  Pack((StgWord)(ARGTAG_MAX+1));
-	  PackFetchMe((StgClosure *)q);
-	  p++;
-	  IF_DEBUG(sanity, FMs_in_PAP++);
-	  break;
-      }
-      continue;
-    }
-	
-    /* 
-     * Otherwise, q must be the info pointer of an activation
-     * record.  All activation records have 'bitmap' style layout
-     * info.
-     */
-    info  = get_itbl((StgClosure *)p);
-    switch (info->type) {
-	
-      /* Dynamic bitmap: the mask is stored on the stack */
-    case RET_DYN:
-      IF_PAR_DEBUG(pack,
-		   belch("*>**    PackPAP @ %p: RET_DYN", 
-			 p));
-
-      /* Pack the header as is */
-      Pack((StgWord)(((StgRetDyn *)p)->info));
-      Pack((StgWord)(((StgRetDyn *)p)->liveness));
-      Pack((StgWord)(((StgRetDyn *)p)->ret_addr));
-
-      bitmap = ((StgRetDyn *)p)->liveness;
-      p      = (P_)&((StgRetDyn *)p)->payload[0];
-      goto small_bitmap;
-
-      /* probably a slow-entry point return address: */
-    case FUN:
-    case FUN_STATIC:
-      {
-      IF_PAR_DEBUG(pack,
-		   belch("*>**    PackPAP @ %p: FUN or FUN_STATIC", 
-			 p));
-
-      Pack((StgWord)(((StgClosure *)p)->header.info));
-      p++;
-
-      goto follow_srt; //??
-      }
-
-      /* Using generic code here; could inline as in scavenge_stack */
-    case UPDATE_FRAME:
-      {
-	StgUpdateFrame *frame = (StgUpdateFrame *)p;
-	nat type = get_itbl(frame->updatee)->type;
-
-	ASSERT(type==BLACKHOLE || type==CAF_BLACKHOLE || type==BLACKHOLE_BQ);
-
-	IF_PAR_DEBUG(pack,
-		     belch("*>**    PackPAP @ %p: UPDATE_FRAME (updatee=%p; link=%p)", 
-			   p, frame->updatee, frame->link));
-
-	Pack((StgWord)(frame->header.info));
-	Pack((StgWord)(frame->link));     // ToDo: fix intra-stack pointer
-	Pack((StgWord)(frame->updatee));  // ToDo: follow link 
-
-	p += 3;
-      }
-
-      /* small bitmap (< 32 entries, or 64 on a 64-bit machine) */
-    case STOP_FRAME:
-      {
-	IF_PAR_DEBUG(pack,
-		     belch("*>**    PackPAP @ %p: STOP_FRAME", 
-			   p));
-	Pack((StgWord)((StgStopFrame *)p)->header.info);
-	p++;
-      }
-
-    case CATCH_FRAME:
-      {
-	IF_PAR_DEBUG(pack,
-		     belch("*>**    PackPAP @ %p: CATCH_FRAME (handler=%p)", 
-			   p, ((StgCatchFrame *)p)->handler));
-
-	Pack((StgWord)((StgCatchFrame *)p)->header.info);
-	Pack((StgWord)((StgCatchFrame *)p)->link); // ToDo: fix intra-stack pointer
-	Pack((StgWord)((StgCatchFrame *)p)->exceptions_blocked);
-	Pack((StgWord)((StgCatchFrame *)p)->handler);
-	p += 4;
-      }
-
-    case SEQ_FRAME:
-      {
-	IF_PAR_DEBUG(pack,
-		     belch("*>**    PackPAP @ %p: UPDATE_FRAME (link=%p)", 
-			   p, ((StgSeqFrame *)p)->link));
-
-	Pack((StgWord)((StgSeqFrame *)p)->header.info);
-	Pack((StgWord)((StgSeqFrame *)p)->link); // ToDo: fix intra-stack pointer
-
-        // ToDo: handle bitmap
-        bitmap = info->layout.bitmap;
-
-        p = (StgPtr)&(((StgClosure *)p)->payload);
-        goto small_bitmap;
-      }
-    case RET_BCO:
-    case RET_SMALL:
-    case RET_VEC_SMALL:
-      IF_PAR_DEBUG(pack,
-		   belch("*>**    PackPAP @ %p: RET_{BCO,SMALL,VEC_SMALL} (bitmap=%o)", 
-			 p, info->layout.bitmap));
-
-
-      Pack((StgWord)((StgClosure *)p)->header.info);
-      p++;
-      // ToDo: handle bitmap
-      bitmap = info->layout.bitmap;
-      /* this assumes that the payload starts immediately after the info-ptr */
-
-    small_bitmap:
-      while (bitmap != 0) {
-	if ((bitmap & 1) == 0) {
-	  Pack((StgWord)(ARGTAG_MAX+1));
-	  PackFetchMe((StgClosure *)*p++); // pack a FetchMe to the closure
-	  IF_DEBUG(sanity, FMs_in_PAP++);
-	} else {
-	  Pack((StgWord)*p++);
-	}
-	bitmap = bitmap >> 1;
-      }
-      
-    follow_srt:
-	IF_PAR_DEBUG(pack,
-	             belch("*>--    PackPAP: nothing to do for follow_srt"));
-      continue;
-
-      /* large bitmap (> 32 entries) */
-    case RET_BIG:
-    case RET_VEC_BIG:
-      {
-	StgPtr q;
-	StgLargeBitmap *large_bitmap;
-
-	IF_PAR_DEBUG(pack,
-		     belch("*>**    PackPAP @ %p: RET_{BIG,VEC_BIG} (large_bitmap=%p)", 
-			   p, info->layout.large_bitmap));
-
-
-	Pack((StgWord)((StgClosure *)p)->header.info);
-	p++;
-
-	large_bitmap = info->layout.large_bitmap;
-
-	for (j=0; j<large_bitmap->size; j++) {
-	  bitmap = large_bitmap->bitmap[j];
-	  q = p + BITS_IN(W_);
-	  while (bitmap != 0) {
-	    if ((bitmap & 1) == 0) {
-	      Pack((StgWord)(ARGTAG_MAX+1));
-	      PackFetchMe((StgClosure *)*p++); // ToDo: pack pointer(StgClosure *)*p = evacuate((StgClosure *)*p);
-	      IF_DEBUG(sanity, FMs_in_PAP++);
-	    } else {
-	      Pack((StgWord)*p++);
-	    }
-	    bitmap = bitmap >> 1;
-	  }
-	  if (j+1 < large_bitmap->size) {
-	    while (p < q) {
-	      Pack((StgWord)(ARGTAG_MAX+1));
-	      PackFetchMe((StgClosure *)*p++); // ToDo: pack pointer (StgClosure *)*p = evacuate((StgClosure *)*p);
-	      IF_DEBUG(sanity, FMs_in_PAP++);
-	    }
-	  }
-	}
-
-	/* and don't forget to follow the SRT */
-	goto follow_srt;
-      }
-
-    default:
-      barf("PackPAP: weird activation record found on stack (@ %p): %d", 
-	   p, (int)(info->type));
-    }
-  }
-  // fill in size of the PAP (only the payload!) in buffer
-  globalPackBuffer->buffer[pack_start] = (StgWord)(pack_locn - pack_start - 1*sizeofW(StgWord));
-  /*
-    We can use the generic pap_sizeW macro to compute the size of the
-    unpacked PAP because whenever we pack a new FETCHME as part of the
-    PAP's payload we also adjust unpacked_size accordingly (smart, aren't we?)
-
-    NB: the current PAP (un-)packing code  relies on the fact that
-    the size of the unpacked PAP + size of all unpacked FMs is the same as
-    the size of the packed PAP!!
-  */
-  unpacked_size += pap_sizeW(pap); // sizeofW(pap) + (nat)(globalPackBuffer->buffer[pack_start]);
-  IF_DEBUG(sanity,
-	   ASSERT(unpacked_size-unpacked_size_before_PAP==pap_sizeW(pap)+FMs_in_PAP*sizeofW(StgFetchMe)));
-}
-# else  /* GRAN */
-
-/* Fake the packing of a closure */
-
-void
-PackClosure(closure)
-StgClosure *closure;
-{
-  StgInfoTable *info, *childInfo;
-  nat size, ptrs, nonptrs, vhs;
-  char info_hdr_ty[80];
-  nat i;
-  StgClosure *indirectee, *rbh;
-  char str[80];
-  rtsBool is_mutable, will_be_rbh, no_more_thunks_please;
-
-  is_mutable = rtsFalse;
-
-  /* In GranSim we don't pack and unpack closures -- we just simulate
-     packing by updating the bitmask. So, the graph structure is unchanged
-     i.e. we don't short out indirections here. -- HWL */
-
-  /* Nothing to do with packing but good place to (sanity) check closure;
-     if the closure is a thunk, it must be unique; otherwise we have copied
-     work at some point before that which violates one of our main global
-     assertions in GranSim/GUM */
-  ASSERT(!closure_THUNK(closure) || is_unique(closure));
-
-  IF_GRAN_DEBUG(pack,
-		belch("**  Packing closure %p (%s)",
-		      closure, info_type(closure)));
-
-  if (where_is(closure) != where_is(graph_root)) {
-    IF_GRAN_DEBUG(pack,
-		  belch("**   faking a FETCHME [current PE: %d, closure's PE: %d]",
-			where_is(graph_root), where_is(closure)));
-
-    /* GUM would pack a FETCHME here; simulate that by increasing the */
-    /* unpacked size accordingly but don't pack anything -- HWL */
-    unpacked_size += _HS + 2 ; // sizeofW(StgFetchMe);
-    return; 
-  }
-
-  /* If the closure's not already being packed */
-  if (!NotYetPacking(closure)) 
-    /* Don't have to do anything in GrAnSim if closure is already */
-    /* packed -- HWL */
-    {
-      IF_GRAN_DEBUG(pack,
-		    belch("**    Closure %p is already packed and omitted now!",
-			    closure));
-      return;
-    }
-
-  switch (get_itbl(closure)->type) {
-    /* ToDo: check for sticky bit here? */
-    /* BH-like closures which must not be moved to another PE */
-    case CAF_BLACKHOLE:       /* # of ptrs, nptrs: 0,2 */
-    case SE_BLACKHOLE:        /* # of ptrs, nptrs: 0,2 */
-    case SE_CAF_BLACKHOLE:    /* # of ptrs, nptrs: 0,2 */
-    case BLACKHOLE:           /* # of ptrs, nptrs: 0,2 */
-    case BLACKHOLE_BQ:        /* # of ptrs, nptrs: 1,1 */
-    case RBH:                 /* # of ptrs, nptrs: 1,1 */
-      /* same for these parallel specific closures */
-    case BLOCKED_FETCH:
-    case FETCH_ME:
-    case FETCH_ME_BQ:
-      IF_GRAN_DEBUG(pack,
-	belch("**    Avoid packing BH-like closures (%p, %s)!", 
-	      closure, info_type(closure)));
-      /* Just ignore RBHs i.e. they stay where they are */
-      return;
-
-    case THUNK_SELECTOR:
-      {
-	StgClosure *selectee = ((StgSelector *)closure)->selectee;
-
-	IF_GRAN_DEBUG(pack,
-		      belch("**    Avoid packing THUNK_SELECTOR (%p, %s) but queuing %p (%s)!", 
-			    closure, info_type(closure), selectee, info_type(selectee)));
-	QueueClosure(selectee);
-	IF_GRAN_DEBUG(pack,
-		      belch("**    [%p (%s) (Queueing closure) ....]",
-			    selectee, info_type(selectee)));
-      }
-      return;
-
-    case CONSTR_STATIC:
-    case CONSTR_NOCAF_STATIC:
-                                  /* For now we ship indirections to CAFs:
-				   * They are evaluated on each PE if needed */
-      IF_GRAN_DEBUG(pack,
-	belch("**    Nothing to pack for %p (%s)!", 
-	      closure, info_type(closure)));
-      // Pack(closure); GUM only
-      return;
-
-    case CONSTR_CHARLIKE:
-    case CONSTR_INTLIKE:
-      IF_GRAN_DEBUG(pack,
-	belch("**    Nothing to pack for %s (%p)!", 
-	      closure, info_type(closure)));
-      // PackPLC(((StgIntCharlikeClosure *)closure)->data); GUM only
-      return;
-
-    case AP_UPD:   
-    case PAP:
-      /* partial applications; special treatment necessary? */
-      break;
-
-    case MVAR:
-      barf("{PackClosure}Daq Qagh: found an MVAR (%p, %s); ToDo: implement proper treatment of MVARs",
-	   closure, info_type(closure));
-
-    case ARR_WORDS:
-    case MUT_VAR:
-    case MUT_ARR_PTRS:
-    case MUT_ARR_PTRS_FROZEN:
-      /* Mutable objects; require special treatment to ship all data */
-      is_mutable = rtsTrue;
-      break;	  
-
-    case WEAK:
-    case FOREIGN:
-    case STABLE_NAME:
-	  /* weak pointers and other FFI objects */
-      barf("{PackClosure}Daq Qagh: found an FFI object (%p, %s); FFI not yet supported by GranSim, sorry",
-	   closure, info_type(closure));
-
-    case TSO:
-      /* parallel objects */
-      barf("{PackClosure}Daq Qagh: found a TSO when packing (%p, %s); thread migration not yet implemented, sorry",
-	   closure, info_type(closure));
-
-    case BCO:
-      /* Hugs objects (i.e. closures used by the interpreter) */
-      barf("{PackClosure}Daq Qagh: found a Hugs closure when packing (%p, %s); GranSim not yet integrated with Hugs, sorry",
-	   closure, info_type(closure));
-      
-    case IND:              /* # of ptrs, nptrs: 1,0 */
-    case IND_STATIC:       /* # of ptrs, nptrs: 1,0 */
-    case IND_PERM:         /* # of ptrs, nptrs: 1,1 */
-    case IND_OLDGEN:       /* # of ptrs, nptrs: 1,1 */
-    case IND_OLDGEN_PERM:  /* # of ptrs, nptrs: 1,1 */
-      /* we shouldn't find an indirection here, because we have shorted them
-	 out at the beginning of this functions already.
-      */
-      break;
-      /* should be:
-      barf("{PackClosure}Daq Qagh: found indirection when packing (%p, %s)",
-	   closure, info_type(closure));
-      */
-
-    case UPDATE_FRAME:
-    case CATCH_FRAME:
-    case SEQ_FRAME:
-    case STOP_FRAME:
-      /* stack frames; should never be found when packing for now;
-	 once we support thread migration these have to be covered properly
-      */
-      barf("{PackClosure}Daq Qagh: found stack frame when packing (%p, %s)",
-	   closure, info_type(closure));
-
-    case RET_BCO:
-    case RET_SMALL:
-    case RET_VEC_SMALL:
-    case RET_BIG:
-    case RET_VEC_BIG:
-    case RET_DYN:
-      /* vectored returns; should never be found when packing; */
-      barf("{PackClosure}Daq Qagh: found vectored return (%p, %s)",
-	   closure, info_type(closure));
-
-    case INVALID_OBJECT:
-      barf("{PackClosure}Daq Qagh: found Invalid object (%p, %s)",
-	   closure, info_type(closure));
-
-    default:
-      /* 
-	 Here we know that the closure is a CONSTR, FUN or THUNK (maybe
-	 a specialised version with wired in #ptr/#nptr info; currently
-	 we treat these specialised versions like the generic version)
-      */
-    }     /* switch */
-
-    /* Otherwise it's not Fixed */
-
-    info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
-    will_be_rbh = closure_THUNK(closure) && !closure_UNPOINTED(closure);
-
-    IF_GRAN_DEBUG(pack,
-		belch("**    Info on closure %p (%s): size=%d; ptrs=%d",
-		      closure, info_type(closure),
-		      size, ptrs, 
-		      (will_be_rbh) ? "will become RBH" : "will NOT become RBH"));
-    
-    // check whether IS_UPDATABLE(closure) == !closure_UNPOINTED(closure) -- HWL
-    no_more_thunks_please = 
-      (RtsFlags.GranFlags.ThunksToPack>0) && 
-      (packed_thunks>=RtsFlags.GranFlags.ThunksToPack);
-
-    /*
-      should be covered by get_closure_info
-    if (info->type == FETCH_ME || info->type == FETCH_ME_BQ || 
-	info->type == BLACKHOLE || info->type == RBH )
-      size = ptrs = nonptrs = vhs = 0;
-    */
-    /* Now peek ahead to see whether the closure has any primitive */
-    /* array children */ 
-    /* 
-       ToDo: fix this code
-       for (i = 0; i < ptrs; ++i) {
-       P_ childInfo;
-       W_ childSize, childPtrs, childNonPtrs, childVhs;
-       
-       childInfo = get_closure_info(((StgPtrPtr) (closure))[i + _HS + vhs],
-       &childSize, &childPtrs, &childNonPtrs,
-       &childVhs, junk_str);
-       if (IS_BIG_MOTHER(childInfo)) {
-       reservedPAsize += PACK_GA_SIZE + _HS + 
-       childVhs + childNonPtrs +
-       childPtrs * PACK_FETCHME_SIZE;
-       PAsize += PACK_GA_SIZE + _HS + childSize;
-       PAptrs += childPtrs;
-       }
-       }
-    */
-    /* Don't pack anything (GrAnSim) if it's a black hole, or the buffer
-     * is full and it isn't a primitive array. N.B. Primitive arrays are
-     * always packed (because their parents index into them directly) */
-
-    if (IS_BLACK_HOLE(closure))
-	/*
-	  ToDo: fix this code
-	  || 
-	  !(RoomToPack(PACK_GA_SIZE + _HS + vhs + nonptrs, ptrs) 
-	  || IS_BIG_MOTHER(info))) 
-	  */
-      return;
-
-    /* At last! A closure we can actually pack! */
-
-    if (closure_MUTABLE(closure)) // not nec. && (info->type != FETCHME))
-      belch("ghuH: Replicated a Mutable closure!");
-
-    if (RtsFlags.GranFlags.GranSimStats.Global &&  
-	no_more_thunks_please && will_be_rbh) {
-      globalGranStats.tot_cuts++;
-      if ( RtsFlags.GranFlags.Debug.pack ) 
-	belch("**    PackClosure (w/ ThunksToPack=%d): Cutting tree with root at %#x\n",
-		RtsFlags.GranFlags.ThunksToPack, closure);
-    } else if (will_be_rbh || (closure==graph_root) ) {
-      packed_thunks++;
-      globalGranStats.tot_thunks++;
-    }
-
-    if (no_more_thunks_please && will_be_rbh) 
-      return; /* don't pack anything */
-
-    /* actual PACKING done here --  HWL */
-    Pack(closure);         
-    for (i = 0; i < ptrs; ++i) {
-      /* extract i-th pointer from closure */
-      QueueClosure((StgClosure *)(closure->payload[i]));
-      IF_GRAN_DEBUG(pack,
-		    belch("**    [%p (%s) (Queueing closure) ....]",
-			  closure->payload[i], 
-	                  info_type(*stgCast(StgPtr*,((closure)->payload+(i))))));
-                                  //^^^^^^^^^^^ payloadPtr(closure,i))));
-    }
-
-    /* 
-       for packing words (GUM only) do something like this:
-
-       for (i = 0; i < ptrs; ++i) {
-         Pack(payloadWord(obj,i+j));
-       }
-    */
-    /* Turn thunk into a revertible black hole. */
-    if (will_be_rbh) { 
-	rbh = convertToRBH(closure);
-	ASSERT(rbh != NULL);
-    }
-}
-# endif  /* PAR */
-
-//@node Low level packing routines, Unpacking routines, Packing Functions, Graph packing
-//@subsection Low level packing routines
-
-/*
-   @Pack@ is the basic packing routine.  It just writes a word of data into
-   the pack buffer and increments the pack location.  */
-
-//@cindex Pack
-
-# if defined(PAR)
-static  void
-Pack(data)
-StgWord data;
-{
-  ASSERT(pack_locn < RtsFlags.ParFlags.packBufferSize);
-  globalPackBuffer->buffer[pack_locn++] = data;
-}
-#endif
-
-#if defined(GRAN)
-static  void
-Pack(closure)
-StgClosure *closure;
-{
-  StgInfoTable *info;
-  nat size, ptrs, nonptrs, vhs;
-  char str[80];
-
-  /* This checks the size of the GrAnSim internal pack buffer. The simulated
-     pack buffer is checked via RoomToPack (as in GUM) */
-  if (pack_locn >= (int)globalPackBuffer->size+sizeofW(rtsPackBuffer)) 
-    reallocPackBuffer();
-
-  if (closure==(StgClosure*)NULL) 
-    belch("Qagh {Pack}Daq: Trying to pack 0");
-  globalPackBuffer->buffer[pack_locn++] = closure;
-  /* ASSERT: Data is a closure in GrAnSim here */
-  info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
-  // ToDo: is check for MIN_UPD_SIZE really needed? */
-  unpacked_size += _HS + (size < MIN_UPD_SIZE ? 
-				        MIN_UPD_SIZE : 
-				        size);
-}
-# endif  /* GRAN */
-
-/*
-   If a closure is local, make it global.  Then, divide its weight for
-   export.  The GA is then packed into the pack buffer.  */
-
-# if defined(PAR)
-//@cindex GlobaliseAndPackGA
-static void
-GlobaliseAndPackGA(closure)
-StgClosure *closure;
-{
-  globalAddr *ga;
-  globalAddr packGA;
-
-  if ((ga = LAGAlookup(closure)) == NULL) {
-    ga = makeGlobal(closure, rtsTrue);
-
-    // Global statistics: increase amount of global data by closure-size
-    if (RtsFlags.ParFlags.ParStats.Global &&
-	RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-      StgInfoTable *info;
-      nat size, ptrs, nonptrs, vhs, i, m; // stats only!!
-      char str[80]; // stats only!!
-
-      info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
-      globalParStats.tot_global += size;
-    }
-  }
-  ASSERT(ga->weight==MAX_GA_WEIGHT || ga->weight > 2);
-  
-  if(dest_gtid==ga->payload.gc.gtid)
-  {  packGA.payload = ga->payload;
-     packGA.weight = 0xFFFFFFFF; // 0,1,2 are used already
-  }
-  else
-  { splitWeight(&packGA, ga);
-    ASSERT(packGA.weight > 0);
-  }  
- 
-  IF_PAR_DEBUG(pack,
-	       fprintf(stderr, "*>## %p (%s): Globalising (%s) closure with GA ",
-		       closure, info_type(closure),
-		       ( (ga->payload.gc.gtid==dest_gtid)?"returning":
-		           ( (ga->payload.gc.gtid==mytid)?"creating":"sharing" ) ));
-	       printGA(&packGA);
-	       fputc('\n', stderr));
-
-
-  Pack((StgWord) packGA.weight);
-  Pack((StgWord) packGA.payload.gc.gtid);
-  Pack((StgWord) packGA.payload.gc.slot);
-}
-
-/*
-   @PackPLC@ makes up a bogus GA for a PLC. Weight 0 implies that a PLC
-   address follows instead of PE, slot.  */
-
-//@cindex PackPLC
-
-static void
-PackPLC(addr)
-StgPtr addr;
-{
-  Pack(0L);			/* weight */
-  Pack((StgWord) addr);		/* address */
-}
-
-/*
-   @PackOffset@ packs a special GA value that will be interpreted as an
-   offset to a closure in the pack buffer.  This is used to avoid unfolding
-   the graph structure into a tree.  */
-
-static void
-PackOffset(offset)
-int offset;
-{
-  /*
-  IF_PAR_DEBUG(pack,
-	       belch("** Packing Offset %d at pack location %u",
-		     offset, pack_locn));
-  */
-  Pack(1L);			/* weight */
-  Pack(0L);			/* pe */
-  Pack(offset);		        /* slot/offset */
-}
-# endif  /* PAR */
-
-//@node Unpacking routines, Aux fcts for packing, Low level packing routines, Graph packing
-//@subsection Unpacking routines
-
-/*
-  This was formerly in the (now deceased) module Unpack.c
-
-  Unpacking closures which have been exported to remote processors
-
-  This module defines routines for unpacking closures in the parallel
-  runtime system (GUM).
-
-  In the case of GrAnSim, this module defines routines for *simulating* the
-  unpacking of closures as it is done in the parallel runtime system.
-*/
-
-//@node GUM code, GranSim Code, Unpacking routines, Unpacking routines
-//@subsubsection GUM code
-
-#if defined(PAR) 
-
-//@cindex InitPendingGABuffer
-void
-InitPendingGABuffer(size)
-nat size; 
-{
-  if (PendingGABuffer==(globalAddr *)NULL)
-    PendingGABuffer = (globalAddr *) 
-      stgMallocBytes(size*2*sizeof(globalAddr),
-		     "InitPendingGABuffer");
-
-  /* current location in the buffer */
-  gaga = PendingGABuffer; 
-}
-
-/*
-  @CommonUp@ commons up two closures which we have discovered to be
-  variants of the same object.  One is made an indirection to the other.  */
-
-//@cindex CommonUp
-void
-CommonUp(StgClosure *src, StgClosure *dst)
-{
-  StgBlockingQueueElement *bqe;
-#if defined(DEBUG)
-  StgInfoTable *info;
-  nat size, ptrs, nonptrs, vhs, i;
-  char str[80];
-
-  /* get info about basic layout of the closure */
-  info = get_closure_info(src, &size, &ptrs, &nonptrs, &vhs, str);
-#endif
-
-  ASSERT(src != (StgClosure *)NULL && dst != (StgClosure *)NULL);
-  ASSERT(src != dst);
-
-  IF_PAR_DEBUG(pack,
-	       belch("*___  CommonUp %p (%s) --> %p (%s)",
-		     src, info_type(src), dst, info_type(dst)));
-  
-  switch (get_itbl(src)->type) {
-  case BLACKHOLE_BQ:
-    bqe = ((StgBlockingQueue *)src)->blocking_queue;
-    break;
-
-  case FETCH_ME_BQ:
-    bqe = ((StgFetchMeBlockingQueue *)src)->blocking_queue;
-    break;
-    
-  case RBH:
-    bqe = ((StgRBH *)src)->blocking_queue;
-    break;
-    
-  case BLACKHOLE:
-  case FETCH_ME:
-    bqe = END_BQ_QUEUE;
-    break;
-
-    /* These closures are too small to be updated with an indirection!!! */
-  case CONSTR_1_0:
-  case CONSTR_0_1:
-    ASSERT(size<_HS+MIN_UPD_SIZE); // that's why we have to avoid UPD_IND
-    return;
-
-    /* currently we also common up 2 CONSTRs; this should reduce heap 
-     * consumption but also does more work; not sure whether it's worth doing 
-     */ 
-  case CONSTR:
-  case CONSTR_2_0:
-  case CONSTR_1_1:
-  case CONSTR_0_2:
-  case ARR_WORDS:
-  case MUT_ARR_PTRS:
-  case MUT_ARR_PTRS_FROZEN:
-  case MUT_VAR:
-    break;
-
-  default:
-    /* Don't common up anything else */
-    return;
-  }
-
-  /* closure must be big enough to permit update with ind */
-  ASSERT(size>=_HS+MIN_UPD_SIZE);
-  /* NB: this also awakens the blocking queue for src */
-  UPD_IND(src, dst);
-}
-
-/*
- * Common up the new closure with any existing closure having the same
- * GA
- */
-//@cindex SetGAandCommonUp
-static StgClosure *
-SetGAandCommonUp(globalAddr *ga, StgClosure *closure, rtsBool hasGA)
-{
-  StgClosure *existing;
-  StgInfoTable *ip, *oldip;
-  globalAddr *newGA;
-
-  if (!hasGA)
-    return closure;
-  
-  /* should we already have a local copy? */
-  if (ga->weight==0xFFFFFFFF) { 
-    ASSERT(ga->payload.gc.gtid==mytid); //sanity
-    ga->weight=0;
-    /* probably should also ASSERT that a commonUp takes place...*/
-  }
-  
-  ip = get_itbl(closure);
-  if ((existing = GALAlookup(ga)) == NULL) {
-    /* Just keep the new object */
-    IF_PAR_DEBUG(pack,
-		 belch("*<##  New local object for GA ((%x, %d, %x)) is %p (%s)", 
-		       ga->payload.gc.gtid, ga->payload.gc.slot, ga->weight,
-		       closure, info_type(closure)));
-
-    // make an entry binding closure to ga in the RemoteGA table
-    newGA = setRemoteGA(closure, ga, rtsTrue);
-    // if local closure is a FETCH_ME etc fill in the global indirection
-    if (ip->type == FETCH_ME || ip->type == REMOTE_REF)
-      ((StgFetchMe *)closure)->ga = newGA;
-  } else {
-    
-
-#ifdef DIST 
-// ***************************************************************************
-// ***************************************************************************
-// REMOTE_REF HACK - dual is in PackRemoteRef  
-// - prevents the weight ever being updated
-  if (ip->type == REMOTE_REF)
-    ga->weight=0;
-// ***************************************************************************
-// ***************************************************************************
-#endif /* DIST */
-    
-    /* Two closures, one global name.  Someone loses */
-    oldip = get_itbl(existing);
-    if ((oldip->type == FETCH_ME || 
-	 IS_BLACK_HOLE(existing) ||
-	 /* try to share evaluated closures */
-         oldip->type == CONSTR ||
-	 oldip->type == CONSTR_1_0 ||
-	 oldip->type == CONSTR_0_1 ||
-	 oldip->type == CONSTR_2_0 ||
-	 oldip->type == CONSTR_1_1 ||
-	 oldip->type == CONSTR_0_2 
-	) &&
-	ip->type != FETCH_ME) 
-    {
-      IF_PAR_DEBUG(pack,
-		   belch("*<#-  Duplicate local object for GA ((%x, %d, %x)); redirecting %p (%s) -> %p (%s)",
-			 ga->payload.gc.gtid, ga->payload.gc.slot, ga->weight,
-			 existing, info_type(existing), closure, info_type(closure)));
-
-      /* 
-       * What we had wasn't worth keeping, so make the old closure an
-       * indirection to the new closure (copying BQs if necessary) and
-       * make sure that the old entry is not the preferred one for this
-       * closure.
-       */
-      CommonUp(existing, closure);
-      //GALAdeprecate(ga);
-#if defined(DEBUG)
-      { 
-      	 StgInfoTable *info;
-      	 nat size, ptrs, nonptrs, vhs, i;
-      	 char str[80];
-      
-      	 /* get info about basic layout of the closure */
-      	 info = get_closure_info(GALAlookup(ga), &size, &ptrs, &nonptrs, &vhs, str);
-      
-      	 /* now ga indirectly refers to the new closure */
-      	 ASSERT(size<_HS+MIN_UPD_SIZE || 
-      		UNWIND_IND(GALAlookup(ga))==closure);
-      }
-#endif
-    } else {
-      /*
-       * Either we already had something worthwhile by this name or
-       * the new thing is just another FetchMe.  However, the thing we
-       * just unpacked has to be left as-is, or the child unpacking
-       * code will fail.  Remember that the way pointer words are
-       * filled in depends on the info pointers of the parents being
-       * the same as when they were packed.
-       */
-      IF_PAR_DEBUG(pack,
-		   belch("*<#@  Duplicate local object for GA ((%x, %d, %x)); keeping %p (%s) nuking unpacked %p (%s)", 
-			 ga->payload.gc.gtid, ga->payload.gc.slot, ga->weight,
-			 existing, info_type(existing), closure, info_type(closure)));
-
-      /* overwrite 2nd word; indicates that the closure is garbage */
-      IF_DEBUG(sanity,
-	       ((StgFetchMe*)closure)->ga = (globalAddr*)GARBAGE_MARKER;
-	       IF_PAR_DEBUG(pack,
-			    belch("++++  unpacked closure %p (%s) is garbage: %p",
-				  closure, info_type(closure), *(closure+1))));
-
-      closure = existing;
-#if 0
-      // HACK
-      ty = get_itbl(closure)->type;
-      if (ty == CONSTR ||
-	  ty == CONSTR_1_0 ||
-	  ty == CONSTR_0_1 ||
-	  ty == CONSTR_2_0 ||
-	  ty == CONSTR_1_1 ||
-	  ty == CONSTR_0_2)
-	CommonUp(closure, graph);
-#endif
-    }
-    /* We don't use this GA after all, so give back the weight */
-    (void) addWeight(ga);
-  }
-
-  /* if we have unpacked a FETCH_ME, we have a GA, too */
-  ASSERT(get_itbl(closure)->type!=FETCH_ME || 
-	 looks_like_ga(((StgFetchMe*)closure)->ga));
-
-  /* Sort out the global address mapping */
-  if (ip_THUNK(ip)){ 
-    // || // (ip_THUNK(ip) && !ip_UNPOINTED(ip)) || 
-    //(ip_MUTABLE(ip) && ip->type != FETCH_ME)) {
-    /* Make up new GAs for single-copy closures */
-    globalAddr *newGA = makeGlobal(closure, rtsTrue);
-    
-    // It's a new GA and therefore has the full weight
-    ASSERT(newGA->weight==0);
-
-    /* Create an old GA to new GA mapping */
-    *gaga++ = *ga;
-    splitWeight(gaga, newGA);
-    /* inlined splitWeight; we know that newGALA has full weight 
-    newGA->weight = gaga->weight = 1L << (BITS_IN(unsigned) - 1);    
-    gaga->payload = newGA->payload;
-    */
-    ASSERT(gaga->weight == 1U << (BITS_IN(unsigned) - 1));
-    gaga++;
-  }
-  return closure;
-}
-
-/*
-  Copies a segment of the buffer, starting at @bufptr@, representing a closure
-  into the heap at @graph@.
- */
-//@cindex FillInClosure
-static nat
-FillInClosure(StgWord ***bufptrP, StgClosure *graph)
-{
-  StgInfoTable *ip;
-  StgWord **bufptr = *bufptrP;
-  nat ptrs, nonptrs, vhs, i, size;
-  char str[80];
-
-  ASSERT(LOOKS_LIKE_GHC_INFO(((StgClosure*)bufptr)->header.info));
-
-  /*
-   * Close your eyes.  You don't want to see where we're looking. You
-   * can't get closure info until you've unpacked the variable header,
-   * but you don't know how big it is until you've got closure info.
-   * So...we trust that the closure in the buffer is organized the
-   * same way as they will be in the heap...at least up through the
-   * end of the variable header.
-   */
-  ip = get_closure_info((StgClosure *)bufptr, &size, &ptrs, &nonptrs, &vhs, str);
-	  
-  /* Make sure that nothing sans the fixed header is filled in
-     The ga field of the FETCH_ME is filled in in SetGAandCommonUp */
-  if (ip->type == FETCH_ME || ip->type == REMOTE_REF) {
-    ASSERT(size>=_HS+MIN_UPD_SIZE);    // size of the FM in the heap
-    ptrs = nonptrs = vhs = 0;      // i.e. only unpack FH from buffer
-  }
-  /* ToDo: check whether this is really needed */
-  if (ip->type == ARR_WORDS) {
-    UnpackArray(bufptrP, graph);
-    return arr_words_sizeW((StgArrWords *)bufptr);
-  }
-
-  if (ip->type == PAP || ip->type == AP_UPD) {
-    return UnpackPAP(bufptrP, graph); // includes size of unpackes FMs
-  }
-
-  /* 
-     Remember, the generic closure layout is as follows:
-     +-------------------------------------------------+
-     | FIXED HEADER | VARIABLE HEADER | PTRS | NON-PRS |
-     +-------------------------------------------------+
-  */
-  /* Fill in the fixed header */
-  for (i = 0; i < _HS; i++)
-    ((StgPtr)graph)[i] = (StgWord)*bufptr++;
-
-  /* Fill in the packed variable header */
-  for (i = 0; i < vhs; i++)
-    ((StgPtr)graph)[_HS + i] = (StgWord)*bufptr++;
-  
-  /* Pointers will be filled in later */
-  
-  /* Fill in the packed non-pointers */
-  for (i = 0; i < nonptrs; i++)
-    ((StgPtr)graph)[_HS + i + vhs + ptrs] = (StgWord)*bufptr++;
-
-  /* Indirections are never packed */
-  // ASSERT(INFO_PTR(graph) != (W_) Ind_info_TO_USE);
-  // return bufptr;
-   *bufptrP = bufptr;
-   ASSERT(((ip->type==FETCH_ME || ip->type==REMOTE_REF)&& sizeofW(StgFetchMe)==size) ||
-	  _HS+vhs+ptrs+nonptrs == size);
-   return size; 
-}
-
-/*
-  Find the next pointer field in the parent closure.
-  If the current parent has been completely unpacked already, get the
-  next closure from the global closure queue.
-*/
-//@cindex LocateNextParent
-static void
-LocateNextParent(parentP, pptrP, pptrsP, sizeP)
-StgClosure **parentP;
-nat *pptrP, *pptrsP, *sizeP;
-{
-  StgInfoTable *ip; // debugging
-  nat nonptrs, pvhs;
-  char str[80];
-
-  /* pptr as an index into the current parent; find the next pointer field
-     in the parent by increasing pptr; if that takes us off the closure
-     (i.e. *pptr + 1 > *pptrs) grab a new parent from the closure queue
-  */
-  (*pptrP)++;
-  while (*pptrP + 1 > *pptrsP) {
-    /* *parentP has been constructed (all pointer set); so check it now */
-    IF_DEBUG(sanity,
-	     if ((*parentP!=(StgClosure*)NULL) &&         // not root
-		 (*((StgPtr)(*parentP)+1)!=GARBAGE_MARKER) && // not commoned up
-		 (get_itbl(*parentP)->type != FETCH_ME))
-	       checkClosure(*parentP));
-
-    *parentP = DeQueueClosure();
-    
-    if (*parentP == NULL)
-      break;
-    else {
-      ip = get_closure_info(*parentP, sizeP, pptrsP, &nonptrs,
-			    &pvhs, str);
-      *pptrP = 0;
-    }
-  }
-  /* *parentP points to the new (or old) parent; */
-  /* *pptr, *pptrs and *size have been updated referring to the new parent */
-}
-
-/* 
-   UnpackClosure is the heart of the unpacking routine. It is called for 
-   every closure found in the packBuffer. Any prefix such as GA, PLC marker
-   etc has been unpacked into the *ga structure. 
-   UnpackClosure does the following:
-     - check for the kind of the closure (PLC, Offset, std closure)
-     - copy the contents of the closure from the buffer into the heap
-     - update LAGA tables (in particular if we end up with 2 closures 
-       having the same GA, we make one an indirection to the other)
-     - set the GAGA map in order to send back an ACK message
-
-   At the end of this function *graphP has been updated to point to the
-   next free word in the heap for unpacking the rest of the graph and
-   *bufptrP points to the next word in the pack buffer to be unpacked.
-*/
-
-static  StgClosure*
-UnpackClosure (StgWord ***bufptrP, StgClosure **graphP, globalAddr *ga) {
-  StgClosure *closure;
-  nat size;
-  rtsBool hasGA = rtsFalse, unglobalised = rtsFalse;
-
-  /* Now unpack the closure body, if there is one; three cases:
-     - PLC: closure is just a pointer to a static closure
-     - Offset: closure has been unpacked already
-     - else: copy data from packet into closure
-  */
-  if (isFixed(ga)) {
-    closure = UnpackPLC(ga);
-  } else if (isOffset(ga)) {
-    closure = UnpackOffset(ga);
-  } else {
-    /* if not PLC or Offset it must be a GA and then the closure */
-    ASSERT(RtsFlags.ParFlags.globalising!=0 || LOOKS_LIKE_GA(ga));
-    /* check whether this is an unglobalised closure */
-    unglobalised = isUnglobalised(ga);
-    /* Now we have to build something. */
-    hasGA = !isConstr(ga);
-    /* the new closure will be built here */
-    closure = *graphP;
-
-    /* fill in the closure from the buffer */
-    size = FillInClosure(/*in/out*/bufptrP, /*in*/closure);
-    /* if it is unglobalised, it may not be a thunk!! */
-    ASSERT(!unglobalised || !closure_THUNK(closure));
-    
-   /* Add to queue for processing */
-    QueueClosure(closure);
-
-    /* common up with other graph if necessary */
-    if (!unglobalised)
-      closure = SetGAandCommonUp(ga, closure, hasGA);
-
-    /* if we unpacked a THUNK, check that it is large enough to update */
-    ASSERT(!closure_THUNK(closure) || size>=_HS+MIN_UPD_SIZE);
-    /* graph shall point to next free word in the heap */
-    *graphP += size;
-    //*graphP += (size < _HS+MIN_UPD_SIZE) ? _HS+MIN_UPD_SIZE : size; // see ASSERT
-  }
-  return closure;
-}
-
-/*
-  @UnpackGraph@ unpacks the graph contained in a message buffer.  It
-  returns a pointer to the new graph.  The @gamap@ parameter is set to
-  point to an array of (oldGA,newGA) pairs which were created as a result
-  of unpacking the buffer; @nGAs@ is set to the number of GA pairs which
-  were created.
-
-  The format of graph in the pack buffer is as defined in @Pack.lc@.  */
-
-//@cindex UnpackGraph
-StgClosure *
-UnpackGraph(packBuffer, gamap, nGAs)
-rtsPackBuffer *packBuffer;
-globalAddr **gamap;
-nat *nGAs;
-{
-  StgWord **bufptr, **slotptr;
-  globalAddr gaS;
-  StgClosure *closure, *graphroot, *graph, *parent;
-  nat size, heapsize, bufsize, 
-      pptr = 0, pptrs = 0, pvhs = 0;
-  nat unpacked_closures = 0, unpacked_thunks = 0; // stats only
-
-  IF_PAR_DEBUG(resume,
-	       graphFingerPrint[0] = '\0');
-
-  ASSERT(_HS==1);  // HWL HACK; compile time constant
-
-#if defined(PAR_TICKY) // HWL HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACK
-  PAR_TICKY_UNPACK_GRAPH_START();
-#endif
-  
-  /* Initialisation */
-  InitPacking(rtsTrue);      // same as in PackNearbyGraph
-  globalUnpackBuffer = packBuffer;
-
-  IF_DEBUG(sanity, // do a sanity check on the incoming packet
-	   checkPacket(packBuffer));
-
-  ASSERT(gaga==PendingGABuffer); 
-  graphroot = (StgClosure *)NULL;
-
-  /* Unpack the header */
-  bufsize = packBuffer->size;
-  heapsize = packBuffer->unpacked_size;
-  bufptr = packBuffer->buffer;
-
-  /* allocate heap */
-  if (heapsize > 0) {
-    graph = (StgClosure *)allocate(heapsize);
-    ASSERT(graph != NULL);
-    // parallel global statistics: increase amount of global data
-    if (RtsFlags.ParFlags.ParStats.Global &&
-	RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-      globalParStats.tot_global += heapsize;
-    }
-  }
-
-  /* iterate over the buffer contents and unpack all closures */
-  parent = (StgClosure *)NULL;
-  do {
-    /* check that we aren't at the end of the buffer, yet */
-    IF_DEBUG(sanity, ASSERT(*bufptr != END_OF_BUFFER_MARKER));
-
-    /* This is where we will ultimately save the closure's address */
-    slotptr = bufptr;
-
-    /* fill in gaS from buffer; gaS may receive GA, PLC- or offset-marker */
-    bufptr = UnpackGA(/*in*/bufptr, /*out*/&gaS);
-
-    /* this allocates heap space, updates LAGA tables etc */
-    closure = UnpackClosure (/*in/out*/&bufptr, /*in/out*/&graph, /*in*/&gaS);
-    unpacked_closures++; // stats only; doesn't count FMs in PAP!!!
-    unpacked_thunks += (closure_THUNK(closure)) ? 1 : 0; // stats only
-
-    /*
-     * Set parent pointer to point to chosen closure.  If we're at the top of
-     * the graph (our parent is NULL), then we want to arrange to return the
-     * chosen closure to our caller (possibly in place of the allocated graph
-     * root.)
-     */
-    if (parent == NULL)
-      graphroot = closure;
-    else
-      ((StgPtr)parent)[_HS + pvhs + pptr] = (StgWord) closure;
-
-    /* Save closure pointer for resolving offsets */
-    *slotptr = (StgWord*) closure;
-
-    /* Locate next parent pointer */
-    LocateNextParent(&parent, &pptr, &pptrs, &size);
-
-    IF_DEBUG(sanity,
-	     gaS.weight          = 0xdeadffff;
-	     gaS.payload.gc.gtid = 0xdead;
-	     gaS.payload.gc.slot = 0xdeadbeef;);
-  } while (parent != NULL);
-
-  IF_PAR_DEBUG(resume,
-	       GraphFingerPrint(graphroot, graphFingerPrint);
-	       ASSERT(strlen(graphFingerPrint)<=MAX_FINGER_PRINT_LEN);
-	       belch(">>> Fingerprint of graph rooted at %p (after unpacking <<%d>>:\n    {%s}",
-		     graphroot, packBuffer->id, graphFingerPrint));
-
-  /* we unpacked exactly as many words as there are in the buffer */
-  ASSERT(bufsize == (nat) (bufptr-(packBuffer->buffer)));
-  /* we filled no more heap closure than we allocated at the beginning; 
-     ideally this should be a ==; 
-     NB: test is only valid if we unpacked anything at all (graphroot might
-         end up to be a PLC!), therfore the strange test for HEAP_ALLOCED 
-  */
-
-  /*
-  {
-   StgInfoTable *info = get_itbl(graphroot);
-   ASSERT(!HEAP_ALLOCED(graphroot) || heapsize >= (nat) (graph-graphroot) ||
-          // ToDo: check whether CAFs are really a special case here!!
-          info->type==CAF_BLACKHOLE || info->type==FETCH_ME || info->type==FETCH_ME_BQ); 
-  }
-  */
-
-  /* check for magic end-of-buffer word */
-  IF_DEBUG(sanity, ASSERT(*bufptr == END_OF_BUFFER_MARKER));
-
-  *gamap = PendingGABuffer;
-  *nGAs = (gaga - PendingGABuffer) / 2;
-
-  IF_PAR_DEBUG(tables,
-	       belch("**   LAGA table after unpacking closure %p:",
-		     graphroot);
-	       printLAGAtable());
-
-  /* ToDo: are we *certain* graphroot has been set??? WDP 95/07 */
-  ASSERT(graphroot!=NULL);
-
-  IF_DEBUG(sanity,
-           {
-	     StgPtr p;
-
-	     /* check the unpacked graph */
-	     //checkHeapChunk(graphroot,graph-sizeof(StgWord));
-
-	     // if we do sanity checks, then wipe the pack buffer after unpacking
-	     for (p=(StgPtr)packBuffer->buffer; p<(StgPtr)(packBuffer->buffer)+(packBuffer->size); )
-	       *p++ = 0xdeadbeef;
-            });
-
-  /* reset the global variable */
-  globalUnpackBuffer = (rtsPackBuffer*)NULL;
-
-#if defined(PAR_TICKY) // HWL HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACK
-  PAR_TICKY_UNPACK_GRAPH_END(unpacked_closures, unpacked_thunks);
-#endif
-
-  return (graphroot);
-}
-
-//@cindex UnpackGA
-static  StgWord **
-UnpackGA(StgWord **bufptr, globalAddr *ga)
-{
-  /* First, unpack the next GA or PLC */
-  ga->weight = (rtsWeight) *bufptr++;
-
-  if (ga->weight == 2) {  // unglobalised closure to follow
-    // nothing to do; closure starts at *bufptr
-  } else if (ga->weight > 0) { // fill in GA
-    ga->payload.gc.gtid = (GlobalTaskId) *bufptr++;
-    ga->payload.gc.slot = (int) *bufptr++;
-  } else {
-    ga->payload.plc = (StgPtr) *bufptr++;
-  }
-  return bufptr;
-}
-
-//@cindex UnpackPLC
-static  StgClosure *
-UnpackPLC(globalAddr *ga)
-{
-  /* No more to unpack; just set closure to local address */
-  IF_PAR_DEBUG(pack,
-	       belch("*<^^ Unpacked PLC at %x", ga->payload.plc)); 
-  return (StgClosure*)ga->payload.plc;
-}
-
-//@cindex UnpackOffset
-static  StgClosure *
-UnpackOffset(globalAddr *ga)
-{
-  /* globalUnpackBuffer is a global var init in UnpackGraph */
-  ASSERT(globalUnpackBuffer!=(rtsPackBuffer*)NULL);
-  /* No more to unpack; just set closure to cached address */
-  IF_PAR_DEBUG(pack,
-	       belch("*<__ Unpacked indirection to %p (was OFFSET %d)", 
-		     (StgClosure *)((globalUnpackBuffer->buffer)[ga->payload.gc.slot]),
-		     ga->payload.gc.slot)); 
-  return (StgClosure *)(globalUnpackBuffer->buffer)[ga->payload.gc.slot];
-}
-
-/*
-  Input: *bufptrP, *graphP  ... ptrs to the pack buffer and into the heap.
-
-  *bufptrP points to something that should be unpacked as a FETCH_ME:
-    |
-    v
-    +-------------------------------
-    |    GA    | FH of FM
-    +-------------------------------
-
-  The first 3 words starting at *bufptrP are the GA address; the next
-  word is the generic FM info ptr followed by the remaining FH (if any)
-  The result after unpacking will be a FETCH_ME closure, pointed to by
-  *graphP at the start of the fct;
-    |
-    v
-    +------------------------+
-    | FH of FM | ptr to a GA |
-    +------------------------+
-
-   The ptr field points into the RemoteGA table, which holds the actual GA.
-   *bufptrP has been updated to point to the next word in the buffer.
-   *graphP has been updated to point to the first free word at the end.
-*/
-
-static StgClosure*
-UnpackFetchMe (StgWord ***bufptrP, StgClosure **graphP) {
-  StgClosure *closure, *foo;
-  globalAddr gaS;
-
-  /* This fct relies on size of FM < size of FM in pack buffer */
-  ASSERT(sizeofW(StgFetchMe)<=PACK_FETCHME_SIZE);
-
-  /* fill in gaS from buffer */
-  *bufptrP = UnpackGA(*bufptrP, &gaS);
-  /* might be an offset to a closure in the pack buffer */
-  if (isOffset(&gaS)) {
-    belch("*<   UnpackFetchMe: found OFFSET to %d when unpacking FM at buffer loc %p",
-		  gaS.payload.gc.slot, *bufptrP);
-
-    closure = UnpackOffset(&gaS);
-    /* return address of previously unpacked closure; leaves *graphP unchanged */
-    return closure;
-  }
-
-  /* we have a proper GA at hand */
-  ASSERT(LOOKS_LIKE_GA(&gaS));
-
-  IF_DEBUG(sanity,
-	   if (isFixed(&gaS)) 
-	   barf("*<   UnpackFetchMe: found PLC where FM was expected %p (%s)",
-		*bufptrP, info_type((StgClosure*)*bufptrP)));
-
-  IF_PAR_DEBUG(pack,
-	       belch("*<_- Unpacked @ %p a FETCH_ME to GA ", 
-		     *graphP);
-	       printGA(&gaS);
-	       fputc('\n', stderr));
-
-  /* the next thing must be the IP to a FETCH_ME closure */
-  ASSERT(get_itbl((StgClosure *)*bufptrP)->type == FETCH_ME);
-  
-  closure = *graphP;
-  /* fill in the closure from the buffer */
-  FillInClosure(bufptrP, closure);
-  
-  /* the newly built closure is a FETCH_ME */
-  ASSERT(get_itbl(closure)->type == FETCH_ME);
-  
-  /* common up with other graph if necessary 
-     this also assigns the contents of gaS to the ga field of the FM closure */
-  foo = SetGAandCommonUp(&gaS, closure, rtsTrue);
-  
-  ASSERT(foo!=closure || LOOKS_LIKE_GA(((StgFetchMe*)closure)->ga));
-  
-  IF_PAR_DEBUG(pack,
-	       if (foo==closure) {  // only if not commoned up 
-	         belch("*<_- current FM @ %p next FM @ %p; unpacked FM @ %p is ", 
-		       *graphP, *graphP+sizeofW(StgFetchMe), closure);
-	         printClosure(closure);
-               });
-  *graphP += sizeofW(StgFetchMe);
-  return foo;
-}
-
-/*
-  Unpack an array of words.
-  Could use generic unpack most of the time, but cleaner to separate it.
-  ToDo: implement packing of MUT_ARRAYs
-*/
-
-//@cindex UnackArray
-static void
-UnpackArray(StgWord ***bufptrP, StgClosure *graph)
-{
-  StgInfoTable *info;
-  StgWord **bufptr=*bufptrP;
-  nat size, ptrs, nonptrs, vhs, i, n;
-  char str[80];
-
-  /* yes, I know I am paranoid; but who's asking !? */
-  IF_DEBUG(sanity,
-	   info = get_closure_info((StgClosure*)bufptr, 
-				   &size, &ptrs, &nonptrs, &vhs, str);
-	   ASSERT(info->type == ARR_WORDS || info->type == MUT_ARR_PTRS ||
-		  info->type == MUT_ARR_PTRS_FROZEN || info->type == MUT_VAR));
-
-  n = ((StgArrWords *)bufptr)->words;
-  // this includes the header!: arr_words_sizeW(stgCast(StgArrWords*,q)); 
-
-  IF_PAR_DEBUG(pack,
-               if (n<100) 
-	         belch("*<== unpacking an array of %d words %p (%s) (size=%d) |%s|\n",
-		     n, (StgClosure*)bufptr, info_type((StgClosure*)bufptr), 
-		     arr_words_sizeW((StgArrWords *)bufptr), 
-		       /* print array (string?) */
-                     ((StgArrWords *)graph)->payload);
-               else
-	         belch("*<== unpacking an array of %d words %p (%s) (size=%d)\n",
-		     n, (StgClosure*)bufptr, info_type((StgClosure*)bufptr), 
-		     arr_words_sizeW((StgArrWords *)bufptr)));
-
-  /* Unpack the header (2 words: info ptr and the number of words to follow) */
-  ((StgArrWords *)graph)->header.info = (StgInfoTable*)*bufptr++;  // assumes _HS==1; yuck!
-  ((StgArrWords *)graph)->words = (StgWord)*bufptr++;
-
-  /* unpack the payload of the closure (all non-ptrs) */
-  for (i=0; i<n; i++)
-    ((StgArrWords *)graph)->payload[i] = (StgWord)*bufptr++;
-
-  ASSERT(bufptr==*bufptrP+arr_words_sizeW((StgArrWords *)*bufptrP));
-  *bufptrP = bufptr;
-}
-
-/* 
-   Unpack a PAP in the buffer into a heap closure.
-   For each FETCHME we find in the packed PAP we have to unpack a separate
-   FETCHME closure and insert a pointer to this closure into the PAP. 
-   We unpack all FETCHMEs into an area after the PAP proper (the `FM area').
-   Note that the size of a FETCHME in the buffer is exactly the same as
-   the size of an unpacked FETCHME plus 1 word for the pointer to it.
-   Therefore, we just allocate packed_size words in the heap for the unpacking.
-   After this routine the heap starting from *graph looks like this:
-
-   graph
-     |
-     v             PAP closure                 |   FM area        |
-     +------------------------------------------------------------+
-     | PAP header | n_args | fun | payload ... | FM_1 | FM_2 .... |
-     +------------------------------------------------------------+
-
-   where payload contains pointers to each of the unpacked FM_1, FM_2 ...
-   The size of the PAP closure plus all FMs is _HS+2+packed_size.
-*/
-
-//@cindex UnpackPAP
-static nat
-UnpackPAP(StgWord ***bufptrP, StgClosure *graph) 
-{
-  nat n, i, j, packed_size = 0;
-  StgPtr p, q, end, payload_start, p_FMs;
-  const StgInfoTable* info;
-  StgWord bitmap;
-  StgWord **bufptr = *bufptrP;
-#if defined(DEBUG)
-  nat FMs_in_PAP=0;
-  void checkPAPSanity(StgPAP *graph, StgPtr p_FM_begin, StgPtr p_FM_end);
-#endif
-
-  IF_PAR_DEBUG(pack,
-	       belch("*<** UnpackPAP: unpacking PAP @ %p with %d words to closure %p", 
-			 *bufptr, *(bufptr+1), graph));
-
-  /* Unpack the PAP header (both fixed and variable) */
-  ((StgPAP *)graph)->header.info = (StgInfoTable*)*bufptr++;
-  n = ((StgPAP *)graph)->n_args = (StgWord)*bufptr++;
-  ((StgPAP *)graph)->fun = (StgClosure*)*bufptr++;
-  packed_size = (nat)*bufptr++;
-
-  IF_PAR_DEBUG(pack,
-	       belch("*<** UnpackPAP: PAP header is [%p, %d, %p] %d",
-		     ((StgPAP *)graph)->header.info,
-		     ((StgPAP *)graph)->n_args,
-		     ((StgPAP *)graph)->fun,
-		     packed_size));
-
-  payload_start = (StgPtr)bufptr;
-  /* p points to the current word in the heap */
-  p = (StgPtr)((StgPAP *)graph)->payload;      // payload of PAP will be unpacked here
-  p_FMs = (StgPtr)graph+pap_sizeW((StgPAP*)graph);  // FMs will be unpacked here
-  end = (StgPtr) payload_start+packed_size;
-  /*
-    The main loop unpacks the PAP in *bufptr into *p, with *p_FMS as the
-    FM area for unpacking all FETCHMEs encountered during unpacking.
-  */
-  while ((StgPtr)bufptr<end) {
-    /* be sure that we don't write more than we allocated for this closure */
-    ASSERT(p_FMs <= (StgPtr)(graph+_HS+2+packed_size));
-    /* be sure that the unpacked PAP doesn't run into the FM area */
-    ASSERT(p < (StgPtr)(graph+pap_sizeW((StgPAP*)graph)));
-    /* the loop body has been borrowed from scavenge_stack */
-    q = *bufptr; // let q be the contents of the current pointer into the buffer
-
-    /* Test whether the next thing is a FETCH_ME.
-       In PAPs FETCH_ME are encoded via a starting marker of ARGTAG_MAX+1
-    */
-    if (q==(StgPtr)(ARGTAG_MAX+1)) {
-      IF_PAR_DEBUG(pack,
-		   belch("*<** UnpackPAP @ %p: unpacking FM; filling in ptr to FM area: %p", 
-			 p, p_FMs));
-      bufptr++;         // skip ARGTAG_MAX+1 marker
-      // Unpack a FM into the FM area after the PAP proper and insert pointer
-      *p++ = (StgWord)UnpackFetchMe(&bufptr, (StgClosure**)&p_FMs); 
-      IF_DEBUG(sanity, FMs_in_PAP++);
-      continue;
-    }
-
-    /* Test whether it is a PLC */
-    if (q==(StgPtr)0) { // same as isFixed(q)
-      IF_PAR_DEBUG(pack,
-		   belch("*<** UnpackPAP @ %p: unpacking PLC to %p", 
-			 p, *(bufptr+1)));
-      bufptr++;          // skip 0 marker
-      *p++ = (StgWord)*bufptr++;
-      continue;
-    }
-
-    /* If we've got a tag, pack all words in that block */
-    if (IS_ARG_TAG((W_)q)) {   // q stands for the no. of non-ptrs to follow
-      nat m = ARG_SIZE(q);     // first word after this block
-      IF_PAR_DEBUG(pack,
-		   belch("*<** UnpackPAP @ %p: unpacking %d words (tagged), starting @ %p", 
-			 p, m, p));
-      for (i=0; i<m+1; i++)
-	*p++ = (StgWord)*bufptr++;
-      continue;
-    }
-
-    /* 
-     * Otherwise, q must be the info pointer of an activation
-     * record.  All activation records have 'bitmap' style layout
-     * info.
-     */
-    info  = get_itbl((StgClosure *)q);
-    switch (info->type) {
-	
-      /* Dynamic bitmap: the mask is stored on the stack */
-    case RET_DYN:
-      IF_PAR_DEBUG(pack,
-		   belch("*<** UnpackPAP @ %p: RET_DYN", 
-			 p));
-
-      /* Pack the header as is */
-      ((StgRetDyn *)p)->info     = (StgWord)*bufptr++;
-      ((StgRetDyn *)p)->liveness = (StgWord)*bufptr++;
-      ((StgRetDyn *)p)->ret_addr = (StgWord)*bufptr++;
-      p += 3;
-
-      //bitmap = ((StgRetDyn *)p)->liveness;
-      //p      = (P_)&((StgRetDyn *)p)->payload[0];
-      goto small_bitmap;
-
-      /* probably a slow-entry point return address: */
-    case FUN:
-    case FUN_STATIC:
-      {
-      IF_PAR_DEBUG(pack,
-		   belch("*<** UnpackPAP @ %p: FUN or FUN_STATIC", 
-			 p));
-
-      ((StgClosure *)p)->header.info = (StgInfoTable*)*bufptr;
-      p++;
-
-      goto follow_srt; //??
-      }
-
-      /* Using generic code here; could inline as in scavenge_stack */
-    case UPDATE_FRAME:
-      {
-	StgUpdateFrame *frame = (StgUpdateFrame *)p;
-	//nat type = get_itbl(frame->updatee)->type;
-
-	//ASSERT(type==BLACKHOLE || type==CAF_BLACKHOLE || type==BLACKHOLE_BQ);
-
-	IF_PAR_DEBUG(pack,
-		     belch("*<** UnackPAP @ %p: UPDATE_FRAME", 
-			   p));
-
-	((StgUpdateFrame *)p)->header.info = (StgInfoTable*)*bufptr++;
-	((StgUpdateFrame *)p)->link        = (StgUpdateFrame*)*bufptr++;     // ToDo: fix intra-stack pointer
-	((StgUpdateFrame *)p)->updatee     = (StgClosure*)*bufptr++;   // ToDo: follow link 
-
-	p += 3;
-      }
-
-      /* small bitmap (< 32 entries, or 64 on a 64-bit machine) */
-    case STOP_FRAME:
-      {
-	IF_PAR_DEBUG(pack,
-		     belch("*<** UnpackPAP @ %p: STOP_FRAME", 
-			   p));
-	((StgStopFrame *)p)->header.info = (StgInfoTable*)*bufptr;
-	p++;
-      }
-
-    case CATCH_FRAME:
-      {
-	IF_PAR_DEBUG(pack,
-		     belch("*<** UnpackPAP @ %p: CATCH_FRAME",
-			   p));
-
-	((StgCatchFrame *)p)->header.info = (StgInfoTable*)*bufptr++;
-	((StgCatchFrame *)p)->link        = (StgUpdateFrame*)*bufptr++;
-	((StgCatchFrame *)p)->exceptions_blocked = (StgInt)*bufptr++;
-	((StgCatchFrame *)p)->handler     = (StgClosure*)*bufptr++;
-	p += 4;
-      }
-
-    case SEQ_FRAME:
-      {
-	IF_PAR_DEBUG(pack,
-		     belch("*<** UnpackPAP @ %p: UPDATE_FRAME",
-			   p));
-
-	((StgSeqFrame *)p)->header.info = (StgInfoTable*)*bufptr++;
-	((StgSeqFrame *)p)->link        = (StgUpdateFrame*)*bufptr++;
-
-        // ToDo: handle bitmap
-        bitmap = info->layout.bitmap;
-
-        p = (StgPtr)&(((StgClosure *)p)->payload);
-        goto small_bitmap;
-      }
-    case RET_BCO:
-    case RET_SMALL:
-    case RET_VEC_SMALL:
-      IF_PAR_DEBUG(pack,
-		   belch("*<** UnpackPAP @ %p: RET_{BCO,SMALL,VEC_SMALL}",
-			 p));
-
-
-      ((StgClosure *)p)->header.info = (StgInfoTable*)*bufptr++;
-      p++;
-      // ToDo: handle bitmap
-      bitmap = info->layout.bitmap;
-      /* this assumes that the payload starts immediately after the info-ptr */
-
-    small_bitmap:
-      while (bitmap != 0) {
-	if ((bitmap & 1) == 0) {
-	  *p++ = (StgWord)UnpackFetchMe(&bufptr, (StgClosure**)&p_FMs);
-	  IF_DEBUG(sanity, FMs_in_PAP++);
-	} else {
-	  *p++ = (StgWord)*bufptr++;
-	}
-	bitmap = bitmap >> 1;
-      }
-      
-    follow_srt:
-      belch("*<-- UnpackPAP: nothing to do for follow_srt");
-      continue;
-
-      /* large bitmap (> 32 entries) */
-    case RET_BIG:
-    case RET_VEC_BIG:
-      {
-	StgPtr q;
-	StgLargeBitmap *large_bitmap;
-
-	IF_PAR_DEBUG(pack,
-		     belch("*<** UnpackPAP @ %p: RET_{BIG,VEC_BIG} (large_bitmap=%p)", 
-			   p, info->layout.large_bitmap));
-
-
-	((StgClosure *)p)->header.info = (StgInfoTable*)*bufptr++;
-	p++;
-
-	large_bitmap = info->layout.large_bitmap;
-
-	for (j=0; j<large_bitmap->size; j++) {
-	  bitmap = large_bitmap->bitmap[j];
-	  q = p + BITS_IN(W_);
-	  while (bitmap != 0) {
-	    if ((bitmap & 1) == 0) {
-	      *p++ = (StgWord)UnpackFetchMe(&bufptr, (StgClosure**)&p_FMs);
-	      IF_DEBUG(sanity, FMs_in_PAP++);
-	    } else {
-	      *p++ = (StgWord)*bufptr;
-	    }
-	    bitmap = bitmap >> 1;
-	  }
-	  if (j+1 < large_bitmap->size) {
-	    while (p < q) {
-	      *p++ = (StgWord)UnpackFetchMe(&bufptr, (StgClosure**)&p_FMs);
-	      IF_DEBUG(sanity, FMs_in_PAP++);
-	    }
-	  }
-	}
-
-	/* and don't forget to follow the SRT */
-	goto follow_srt;
-      }
-
-    default:
-      barf("UnpackPAP: weird activation record found on stack: %d", 
-	   (int)(info->type));
-    }
-  }
-  IF_PAR_DEBUG(pack,
-	       belch("*<** UnpackPAP finished; unpacked closure @ %p is:",
-		     (StgClosure *)graph);
-	       printClosure((StgClosure *)graph));
-
-  IF_DEBUG(sanity,               /* check sanity of unpacked PAP */
-	   checkClosure(graph));
-
-  *bufptrP = bufptr;
-  /* 
-     Now p points to the first word after the PAP proper and p_FMs points 
-     to the next free word in the heap; everything between p and p_FMs are 
-     FETCHMEs 
-  */
-  IF_DEBUG(sanity,
-	   checkPAPSanity(graph, p, p_FMs));
-
-  /* we have to return the size of PAP + FMs as size of the unpacked thing */
-  ASSERT(graph+pap_sizeW((StgPAP*)graph)==p);
-  return (nat)((StgClosure*)p_FMs-graph);
-}
-
-#if defined(DEBUG)
-/* 
-   Check sanity of a PAP after unpacking the PAP.
-   This means that there is slice of heap after the PAP containing FETCHMEs
-*/
-void
-checkPAPSanity(StgPAP *graph, StgPtr p_FM_begin, StgPtr p_FM_end)
-{
-  StgPtr xx;
-
-  /* check that the main unpacked closure is a PAP */
-  ASSERT(graph->header.info = &stg_PAP_info);
-  checkClosure(graph);
-  /* check that all of the closures in the FM-area are FETCHMEs */
-  for (xx=p_FM_begin; xx<p_FM_end; xx += sizeofW(StgFetchMe)) {
-    /* must be a FETCHME closure */
-    ASSERT(((StgClosure*)xx)->header.info == &stg_FETCH_ME_info);
-    /* it might have been commoned up (=> marked as garbage);
-       otherwise it points to a GA */
-    ASSERT((((StgFetchMe*)xx)->ga)==GARBAGE_MARKER ||
-	   LOOKS_LIKE_GA(((StgFetchMe*)xx)->ga));
-  }
-  /* traverse the payload of the PAP */
-  for (xx=graph->payload; xx-(StgPtr)(graph->payload)<graph->n_args; xx++) {
-    /* if the current elem is a pointer into the FM area, check that
-       the GA field is ok */
-    ASSERT(!(p_FM_begin<(StgPtr)*xx && (StgPtr)*xx<p_FM_end) ||
-	   LOOKS_LIKE_GA(((StgFetchMe*)*xx)->ga));
-  }
-}
-#endif  /* DEBUG */
-#endif  /* PAR */
-
-//@node GranSim Code,  , GUM code, Unpacking routines
-//@subsubsection GranSim Code
-
-/*
-   For GrAnSim: No actual unpacking should be necessary. We just
-   have to walk over the graph and set the bitmasks appropriately.
-   Since we use RBHs similarly to GUM but without an ACK message/event
-   we have to revert the RBH from within the UnpackGraph routine (good luck!)
-   -- HWL 
-*/
-
-#if defined(GRAN)
-void
-CommonUp(StgClosure *src, StgClosure *dst)
-{
-  barf("CommonUp: should never be entered in a GranSim setup");
-}
-
-StgClosure*
-UnpackGraph(buffer)
-rtsPackBuffer* buffer;
-{
-  nat size, ptrs, nonptrs, vhs,
-      bufptr = 0;
-  StgClosure *closure, *graphroot, *graph;
-  StgInfoTable *ip;
-  StgWord bufsize, unpackedsize,
-          pptr = 0, pptrs = 0, pvhs;
-  StgTSO* tso;
-  char str[240], str1[80];
-  int i;
-
-  bufptr = 0;
-  graphroot = buffer->buffer[0];
-
-  tso = buffer->tso;
-
-  /* Unpack the header */
-  unpackedsize = buffer->unpacked_size;
-  bufsize = buffer->size;
-
-  IF_GRAN_DEBUG(pack,
-		belch("<<< Unpacking <<%d>> (buffer @ %p):\n    (root @ %p, PE %d,size=%d), demanded by TSO %d (%p)[PE %d]",
-		      buffer->id, buffer, graphroot, where_is(graphroot), 
-		      bufsize, tso->id, tso, 
-		      where_is((StgClosure *)tso)));
-
-  do {
-    closure = buffer->buffer[bufptr++]; /* that's all we need for GrAnSim -- HWL */
-      
-    /* Actually only ip is needed; rest is useful for TESTING -- HWL */
-    ip = get_closure_info(closure, 
-			  &size, &ptrs, &nonptrs, &vhs, str);
-      
-    IF_GRAN_DEBUG(pack,
-		  sprintf(str, "**    (%p): Changing bitmask[%s]: 0x%x ",
-			  closure, (closure_HNF(closure) ? "NF" : "__"),
-			  PROCS(closure)));
-
-    if (get_itbl(closure)->type == RBH) {
-      /* if it's an RBH, we have to revert it into a normal closure, thereby
-	 awakening the blocking queue; not that this is code currently not
-	 needed in GUM, but it should be added with the new features in
-	 GdH (and the implementation of an NACK message)
-      */
-      // closure->header.gran.procs = PE_NUMBER(CurrentProc);
-      SET_GRAN_HDR(closure, PE_NUMBER(CurrentProc));    /* Move node */
-
-      IF_GRAN_DEBUG(pack,
-		    strcat(str, " (converting RBH) ")); 
-
-      convertFromRBH(closure);   /* In GUM that's done by convertToFetchMe */
-
-      IF_GRAN_DEBUG(pack,
-		    belch("::  closure %p (%s) is a RBH; after reverting: IP=%p",
-			  closure, info_type(closure), get_itbl(closure)));
-    } else if (IS_BLACK_HOLE(closure)) {
-      IF_GRAN_DEBUG(pack,
-		    belch("::  closure %p (%s) is a BH; copying node to %d",
-			  closure, info_type(closure), CurrentProc));
-      closure->header.gran.procs |= PE_NUMBER(CurrentProc); /* Copy node */
-    } else if ( (closure->header.gran.procs & PE_NUMBER(CurrentProc)) == 0 ) {
-      if (closure_HNF(closure)) {
-	IF_GRAN_DEBUG(pack,
-		      belch("::  closure %p (%s) is a HNF; copying node to %d",
-			    closure, info_type(closure), CurrentProc));
-	closure->header.gran.procs |= PE_NUMBER(CurrentProc); /* Copy node */
-      } else { 
-	IF_GRAN_DEBUG(pack,
-		      belch("::  closure %p (%s) is no (R)BH or HNF; moving node to %d",
-			    closure, info_type(closure), CurrentProc));
-	closure->header.gran.procs = PE_NUMBER(CurrentProc);  /* Move node */
-      }
-    }
-
-    IF_GRAN_DEBUG(pack,
-		  sprintf(str1, "0x%x",   PROCS(closure)); strcat(str, str1));
-    IF_GRAN_DEBUG(pack, belch(str));
-    
-  } while (bufptr<buffer->size) ;   /*  (parent != NULL);  */
-
-  /* In GrAnSim we allocate pack buffers dynamically! -- HWL */
-  free(buffer->buffer);
-  free(buffer);
-
-  IF_GRAN_DEBUG(pack,
-		belch("PrintGraph of %p is:", graphroot); PrintGraph(graphroot,0));
-
-  return (graphroot);
-}
-#endif  /* GRAN */
-
-//@node Aux fcts for packing, Printing Packet Contents, Unpacking routines, Graph packing
-//@subsection Aux fcts for packing
-
-//@menu
-//* Offset table::		
-//* Packet size::		
-//* Types of Global Addresses::	 
-//* Closure Info::		
-//@end menu
-
-//@node Offset table, Packet size, Aux fcts for packing, Aux fcts for packing
-//@subsubsection Offset table
-
-/*
-   DonePacking is called when we've finished packing.  It releases memory
-   etc.  */
-
-//@cindex DonePacking
-
-# if defined(PAR)
-
-static void
-DonePacking(void)
-{
-  freeHashTable(offsetTable, NULL);
-  offsetTable = NULL;
-}
-
-/*
-   AmPacking records that the closure is being packed.  Note the abuse of
-   the data field in the hash table -- this saves calling @malloc@!  */
-
-//@cindex AmPacking
-
-static void
-AmPacking(closure)
-StgClosure *closure;
-{
-  insertHashTable(offsetTable, (StgWord) closure, (void *) (StgWord) pack_locn);
-}
-
-/*
-   OffsetFor returns an offset for a closure which is already being packed.  */
-
-//@cindex OffsetFor
-
-static int
-OffsetFor(closure)
-StgClosure *closure;
-{
-  return (int) (StgWord) lookupHashTable(offsetTable, (StgWord) closure);
-}
-
-/*
-   NotYetPacking determines whether the closure's already being packed.
-   Offsets $<$ @PACK_HDR_SIZE@ (e.g. 0) mean no.  */
-
-//@cindex NotYetPacking
-
-static rtsBool
-NotYetPacking(offset)
-int offset;
-{
-  return(offset == 0); // ToDo: what if root is found again?? FIX 
-}
-
-# else  /* GRAN */
-
-static void
-DonePacking(void)
-{
-  /* nothing */
-}
-
-/* 
-   NotYetPacking searches through the whole pack buffer for closure.  */
-
-static rtsBool
-NotYetPacking(closure)
-StgClosure *closure;
-{ nat i;
-  rtsBool found = rtsFalse;
-
-  for (i=0; (i<pack_locn) && !found; i++)
-    found = globalPackBuffer->buffer[i]==closure;
-
-  return (!found);
-}
-# endif
-
-//@node Packet size, Closure Info, Offset table, Aux fcts for packing
-//@subsubsection Packet size
-
-/* 
-   The size needed if all currently queued closures are packed as FETCH_ME
-   closures. This represents the headroom we must have when packing the
-   buffer in order to maintain all links in the graphs.
-*/
-// ToDo: check and merge cases
-#if defined(PAR)
-static nat
-QueuedClosuresMinSize (nat ptrs) {
-  return ((clq_size - clq_pos) + ptrs) * PACK_FETCHME_SIZE;
-}
-#else /* GRAN */
-static nat
-QueuedClosuresMinSize (nat ptrs) {
-  return ((clq_size - clq_pos) + ptrs) * PACK_FETCHME_SIZE;
-}
-#endif 
-
-/*
-  RoomToPack determines whether there's room to pack the closure into
-  the pack buffer based on 
-
-  o how full the buffer is already,
-  o the closures' size and number of pointers (which must be packed as GAs),
-  o the size and number of pointers held by any primitive arrays that it 
-    points to
-  
-    It has a *side-effect* (naughty, naughty) in assigning roomInBuffer 
-    to rtsFalse.
-*/
-
-//@cindex RoomToPack
-static rtsBool
-RoomToPack(size, ptrs)
-nat size, ptrs;
-{
-# if defined(PAR)
-  if (roomInBuffer &&
-      (pack_locn +                 // where we are in the buffer right now
-       size +                      // space needed for the current closure
-       QueuedClosuresMinSize(ptrs) // space for queued closures as FETCH_MEs
-       + 1                         // headroom (DEBUGGING only)
-       >= 
-       RTS_PACK_BUFFER_SIZE))
-    {
-      roomInBuffer = rtsFalse;
-    }
-# else   /* GRAN */
-  if (roomInBuffer &&
-      (unpacked_size + 
-       size +
-       QueuedClosuresMinSize(ptrs)
-       >= 
-       RTS_PACK_BUFFER_SIZE))
-    {
-      roomInBuffer = rtsFalse;
-    }
-# endif
-  return (roomInBuffer);
-}
-
-//@node Closure Info,  , Packet size, Aux fcts for packing
-//@subsubsection Closure Info
-
-/*
-   Closure Info
-
-   @get_closure_info@ determines the size, number of pointers etc. for this
-   type of closure -- see @SMInfoTables.lh@ for the legal info. types etc.
-
-[Can someone please keep this function up to date.  I keep needing it
- (or something similar) for interpretive code, and it keeps
- bit-rotting.  {\em It really belongs somewhere else too}.  KH @@ 17/2/95] */
-
-#if 0
-
-// {Parallel.h}Daq ngoqvam vIroQpu'
-
-# if defined(GRAN) || defined(PAR)
-/* extracting specific info out of closure; currently only used in GRAN -- HWL */
-//@cindex get_closure_info
-StgInfoTable*
-get_closure_info(node, size, ptrs, nonptrs, vhs, info_hdr_ty)
-StgClosure* node;
-nat *size, *ptrs, *nonptrs, *vhs;
-char *info_hdr_ty;
-{
-  StgInfoTable *info;
-
-  info = get_itbl(node);
-  /* the switch shouldn't be necessary, really; just use default case */
-  switch (info->type) {
-#if 0
-   case CONSTR_1_0:
-   case THUNK_1_0:
-   case FUN_1_0:
-     *size = sizeW_fromITBL(info);
-     *ptrs = (nat) 1; // (info->layout.payload.ptrs);
-     *nonptrs = (nat) 0; // (info->layout.payload.nptrs);
-     *vhs = (nat) 0; // unknown
-     info_hdr_type(node, info_hdr_ty);
-     return info;
-     
-  case CONSTR_0_1:
-  case THUNK_0_1:
-  case FUN_0_1:
-     *size = sizeW_fromITBL(info);
-     *ptrs = (nat) 0; // (info->layout.payload.ptrs);
-     *nonptrs = (nat) 1; // (info->layout.payload.nptrs);
-     *vhs = (nat) 0; // unknown
-     info_hdr_type(node, info_hdr_ty);
-     return info;
-
-  case CONSTR_2_0:
-  case THUNK_2_0:
-  case FUN_2_0:
-     *size = sizeW_fromITBL(info);
-     *ptrs = (nat) 2; // (info->layout.payload.ptrs);
-     *nonptrs = (nat) 0; // (info->layout.payload.nptrs);
-     *vhs = (nat) 0; // unknown
-     info_hdr_type(node, info_hdr_ty);
-     return info;
-
-  case CONSTR_1_1:
-  case THUNK_1_1:
-  case FUN_1_1:
-     *size = sizeW_fromITBL(info);
-     *ptrs = (nat) 1; // (info->layout.payload.ptrs);
-     *nonptrs = (nat) 1; // (info->layout.payload.nptrs);
-     *vhs = (nat) 0; // unknown
-     info_hdr_type(node, info_hdr_ty);
-     return info;
-
-  case CONSTR_0_2:
-  case THUNK_0_2:
-  case FUN_0_2:
-     *size = sizeW_fromITBL(info);
-     *ptrs = (nat) 0; // (info->layout.payload.ptrs);
-     *nonptrs = (nat) 2; // (info->layout.payload.nptrs);
-     *vhs = (nat) 0; // unknown
-     info_hdr_type(node, info_hdr_ty);
-     return info;
-#endif
-  case RBH:
-    {
-      StgInfoTable *rip = REVERT_INFOPTR(info); // closure to revert to
-      *size = sizeW_fromITBL(rip);
-      *ptrs = (nat) (rip->layout.payload.ptrs);
-      *nonptrs = (nat) (rip->layout.payload.nptrs);
-      *vhs = (nat) 0; // unknown
-      info_hdr_type(node, info_hdr_ty);
-      return rip;  // NB: we return the reverted info ptr for a RBH!!!!!!
-    }
-
-  default:
-    *size = sizeW_fromITBL(info);
-    *ptrs = (nat) (info->layout.payload.ptrs);
-    *nonptrs = (nat) (info->layout.payload.nptrs);
-    *vhs = (nat) 0; // unknown
-    info_hdr_type(node, info_hdr_ty);
-    return info;
-  }
-} 
-
-//@cindex IS_BLACK_HOLE
-rtsBool
-IS_BLACK_HOLE(StgClosure* node)          
-{ 
-  StgInfoTable *info;
-  info = get_itbl(node);
-  return ((info->type == BLACKHOLE || info->type == RBH) ? rtsTrue : rtsFalse);
-}
-
-//@cindex IS_INDIRECTION
-StgClosure *
-IS_INDIRECTION(StgClosure* node)          
-{ 
-  StgInfoTable *info;
-  info = get_itbl(node);
-  switch (info->type) {
-    case IND:
-    case IND_OLDGEN:
-    case IND_PERM:
-    case IND_OLDGEN_PERM:
-    case IND_STATIC:
-      /* relies on indirectee being at same place for all these closure types */
-      return (((StgInd*)node) -> indirectee);
-    default:
-      return NULL;
-  }
-}
-
-/*
-rtsBool
-IS_THUNK(StgClosure* node)
-{
-  StgInfoTable *info;
-  info = get_itbl(node);
-  return ((info->type == THUNK ||
-	   info->type == THUNK_STATIC ||
-	   info->type == THUNK_SELECTOR) ? rtsTrue : rtsFalse);
-}
-*/
-
-# endif /* GRAN */
-#endif /* 0 */
-
-# if 0
-/* ngoq ngo' */
-
-P_
-get_closure_info(closure, size, ptrs, nonptrs, vhs, type)
-P_ closure;
-W_ *size, *ptrs, *nonptrs, *vhs;
-char *type;
-{
-   P_ ip = (P_) INFO_PTR(closure);
-
-   if (closure==NULL) {
-     fprintf(stderr, "Qagh {get_closure_info}Daq: NULL closure\n");
-     *size = *ptrs = *nonptrs = *vhs = 0; 
-     strcpy(type,"ERROR in get_closure_info");
-     return;
-   } else if (closure==PrelBase_Z91Z93_closure) {
-     /* fprintf(stderr, "Qagh {get_closure_info}Daq: PrelBase_Z91Z93_closure closure\n"); */
-     *size = *ptrs = *nonptrs = *vhs = 0; 
-     strcpy(type,"PrelBase_Z91Z93_closure");
-     return;
-   };
-
-    ip = (P_) INFO_PTR(closure);
-
-    switch (INFO_TYPE(ip)) {
-    case INFO_SPEC_U_TYPE:
-    case INFO_SPEC_S_TYPE:
-    case INFO_SPEC_N_TYPE:
-	*size = SPEC_CLOSURE_SIZE(closure);
-	*ptrs = SPEC_CLOSURE_NoPTRS(closure);
-	*nonptrs = SPEC_CLOSURE_NoNONPTRS(closure);
-	*vhs = 0 /*SPEC_VHS*/;
-	strcpy(type,"SPEC");
-	break;
-
-    case INFO_GEN_U_TYPE:
-    case INFO_GEN_S_TYPE:
-    case INFO_GEN_N_TYPE:
-	*size = GEN_CLOSURE_SIZE(closure);
-	*ptrs = GEN_CLOSURE_NoPTRS(closure);
-	*nonptrs = GEN_CLOSURE_NoNONPTRS(closure);
-	*vhs = GEN_VHS;
-	strcpy(type,"GEN");
-	break;
-
-    case INFO_DYN_TYPE:
-	*size = DYN_CLOSURE_SIZE(closure);
-	*ptrs = DYN_CLOSURE_NoPTRS(closure);
-	*nonptrs = DYN_CLOSURE_NoNONPTRS(closure);
-	*vhs = DYN_VHS;
-	strcpy(type,"DYN");
-	break;
-
-    case INFO_TUPLE_TYPE:
-	*size = TUPLE_CLOSURE_SIZE(closure);
-	*ptrs = TUPLE_CLOSURE_NoPTRS(closure);
-	*nonptrs = TUPLE_CLOSURE_NoNONPTRS(closure);
-	*vhs = TUPLE_VHS;
-	strcpy(type,"TUPLE");
-	break;
-
-    case INFO_DATA_TYPE:
-	*size = DATA_CLOSURE_SIZE(closure);
-	*ptrs = DATA_CLOSURE_NoPTRS(closure);
-	*nonptrs = DATA_CLOSURE_NoNONPTRS(closure);
-	*vhs = DATA_VHS;
-	strcpy(type,"DATA");
-	break;
-
-    case INFO_IMMUTUPLE_TYPE:
-    case INFO_MUTUPLE_TYPE:
-	*size = MUTUPLE_CLOSURE_SIZE(closure);
-	*ptrs = MUTUPLE_CLOSURE_NoPTRS(closure);
-	*nonptrs = MUTUPLE_CLOSURE_NoNONPTRS(closure);
-	*vhs = MUTUPLE_VHS;
-	strcpy(type,"(IM)MUTUPLE");
-	break;
-
-    case INFO_STATIC_TYPE:
-	*size = STATIC_CLOSURE_SIZE(closure);
-	*ptrs = STATIC_CLOSURE_NoPTRS(closure);
-	*nonptrs = STATIC_CLOSURE_NoNONPTRS(closure);
-	*vhs = STATIC_VHS;
-	strcpy(type,"STATIC");
-	break;
-
-    case INFO_CAF_TYPE:
-    case INFO_IND_TYPE:
-	*size = IND_CLOSURE_SIZE(closure);
-	*ptrs = IND_CLOSURE_NoPTRS(closure);
-	*nonptrs = IND_CLOSURE_NoNONPTRS(closure);
-	*vhs = IND_VHS;
-	strcpy(type,"CAF|IND");
-	break;
-
-    case INFO_CONST_TYPE:
-	*size = CONST_CLOSURE_SIZE(closure);
-	*ptrs = CONST_CLOSURE_NoPTRS(closure);
-	*nonptrs = CONST_CLOSURE_NoNONPTRS(closure);
-	*vhs = CONST_VHS;
-	strcpy(type,"CONST");
-	break;
-
-    case INFO_SPEC_RBH_TYPE:
-	*size = SPEC_RBH_CLOSURE_SIZE(closure);
-	*ptrs = SPEC_RBH_CLOSURE_NoPTRS(closure);
-	*nonptrs = SPEC_RBH_CLOSURE_NoNONPTRS(closure);
-	if (*ptrs <= 2) {
-	    *nonptrs -= (2 - *ptrs);
-	    *ptrs = 1;
-	} else
-	    *ptrs -= 1;
-	*vhs = SPEC_RBH_VHS;
-	strcpy(type,"SPEC_RBH");
-	break;
-
-    case INFO_GEN_RBH_TYPE:
-	*size = GEN_RBH_CLOSURE_SIZE(closure);
-	*ptrs = GEN_RBH_CLOSURE_NoPTRS(closure);
-	*nonptrs = GEN_RBH_CLOSURE_NoNONPTRS(closure);
-	if (*ptrs <= 2) {
-	    *nonptrs -= (2 - *ptrs);
-	    *ptrs = 1;
-	} else
-	    *ptrs -= 1;
-	*vhs = GEN_RBH_VHS;
-	strcpy(type,"GEN_RBH");
-	break;
-
-    case INFO_CHARLIKE_TYPE:
-	*size = CHARLIKE_CLOSURE_SIZE(closure);
-	*ptrs = CHARLIKE_CLOSURE_NoPTRS(closure);
-	*nonptrs = CHARLIKE_CLOSURE_NoNONPTRS(closure);
-	*vhs = CHARLIKE_VHS;
-	strcpy(type,"CHARLIKE");
-	break;
-
-    case INFO_INTLIKE_TYPE:
-	*size = INTLIKE_CLOSURE_SIZE(closure);
-	*ptrs = INTLIKE_CLOSURE_NoPTRS(closure);
-	*nonptrs = INTLIKE_CLOSURE_NoNONPTRS(closure);
-	*vhs = INTLIKE_VHS;
-	strcpy(type,"INTLIKE");
-	break;
-
-#  if !defined(GRAN)
-    case INFO_FETCHME_TYPE:
-	*size = FETCHME_CLOSURE_SIZE(closure);
-        *ptrs = FETCHME_CLOSURE_NoPTRS(closure);
-        *nonptrs = FETCHME_CLOSURE_NoNONPTRS(closure);
-        *vhs = FETCHME_VHS;
-	strcpy(type,"FETCHME");
-	break;
-
-    case INFO_FMBQ_TYPE:
-	*size = FMBQ_CLOSURE_SIZE(closure);
-        *ptrs = FMBQ_CLOSURE_NoPTRS(closure);
-        *nonptrs = FMBQ_CLOSURE_NoNONPTRS(closure);
-        *vhs = FMBQ_VHS;
-	strcpy(type,"FMBQ");
-	break;
-#  endif
-
-    case INFO_BQ_TYPE:
-	*size = BQ_CLOSURE_SIZE(closure);
-        *ptrs = BQ_CLOSURE_NoPTRS(closure);
-        *nonptrs = BQ_CLOSURE_NoNONPTRS(closure);
-        *vhs = BQ_VHS;
-	strcpy(type,"BQ");
-	break;
-
-    case INFO_BH_TYPE:
-	*size = BH_CLOSURE_SIZE(closure);
-        *ptrs = BH_CLOSURE_NoPTRS(closure);
-        *nonptrs = BH_CLOSURE_NoNONPTRS(closure);
-        *vhs = BH_VHS;
-	strcpy(type,"BH");
-	break;
-
-    case INFO_TSO_TYPE:
-	*size = 0; /* TSO_CLOSURE_SIZE(closure); */
-        *ptrs = 0; /* TSO_CLOSURE_NoPTRS(closure); */
-        *nonptrs = 0; /* TSO_CLOSURE_NoNONPTRS(closure); */
-        *vhs = TSO_VHS;
-	strcpy(type,"TSO");
-	break;
-
-    case INFO_STKO_TYPE:
-        *size = 0;
-    	*ptrs = 0;
-        *nonptrs = 0;
-    	*vhs = STKO_VHS;
-    	strcpy(type,"STKO");
-        break;
-
-    default:
-	fprintf(stderr, "get_closure_info:  Unexpected closure type (%lu), closure %lx\n",
-	  INFO_TYPE(ip), (StgWord) closure);
-	EXIT(EXIT_FAILURE);
-    }
-
-    return ip;
-}
-# endif
-
-# if 0
-// Use allocate in Storage.c instead
-/*
-   @AllocateHeap@ will bump the heap pointer by @size@ words if the space
-   is available, but it will not perform garbage collection.
-   ToDo: check whether we can use an existing STG allocation routine -- HWL
-*/
-
-
-//@cindex AllocateHeap
-StgPtr
-AllocateHeap(size)
-nat size;
-{
-  StgPtr newClosure;
-  
-  /* Allocate a new closure */
-  if (Hp + size > HpLim)
-    return NULL;
-  
-  newClosure = Hp + 1;
-  Hp += size;
-  
-  return newClosure;
-}
-# endif
-
-# if defined(PAR)
-
-//@cindex doGlobalGC
-void
-doGlobalGC(void)
-{
-  fprintf(stderr,"Splat -- we just hit global GC!\n");
-  stg_exit(EXIT_FAILURE);
-  //fishing = rtsFalse;
-  outstandingFishes--;
-}
-
-# endif /* PAR */
-
-//@node Printing Packet Contents, End of file, Aux fcts for packing, Graph packing
-//@subsection Printing Packet Contents
-/*
-  Printing Packet Contents
-  */
-
-#if defined(DEBUG) || defined(GRAN_CHECK)
-
-//@cindex PrintPacket
-
-#if defined(PAR)
-void
-PrintPacket(packBuffer)
-rtsPackBuffer *packBuffer;
-{
-  StgClosure *parent, *graphroot, *closure_start;
-  const StgInfoTable *ip;
-  globalAddr ga;
-  StgWord **bufptr, **slotptr;
-
-  nat bufsize;
-  nat pptr = 0, pptrs = 0, pvhs;
-  nat locn = 0;
-  nat i;
-  nat size, ptrs, nonptrs, vhs;
-  char str[80];
-
-  /* disable printing if a non-std globalisation scheme is used; ToDo: FIX */
-  if (RtsFlags.ParFlags.globalising != 0)
-    return;
-
-  /* NB: this whole routine is more or less a copy of UnpackGraph with all
-     unpacking components replaced by printing fcts
-     Long live higher-order fcts!
-  */
-  /* Initialisation */
-  //InitPackBuffer();                  /* in case it isn't already init'd */
-  InitClosureQueue();
-  // ASSERT(gaga==PendingGABuffer); 
-  graphroot = (StgClosure *)NULL;
-
-  /* Unpack the header */
-  bufsize = packBuffer->size;
-  bufptr = packBuffer->buffer;
-
-  fprintf(stderr, "*. Printing <<%d>> (buffer @ %p):\n", 
-	  packBuffer->id, packBuffer);
-  fprintf(stderr, "*.   size: %d; unpacked_size: %d; tso: %p; buffer: %p\n",
-	  packBuffer->size, packBuffer->unpacked_size, 
-	  packBuffer->tso, packBuffer->buffer);
-
-  parent = (StgClosure *)NULL;
-
-  do {
-    /* This is where we will ultimately save the closure's address */
-    slotptr = bufptr;
-    locn = slotptr-(packBuffer->buffer); // index of closure in buffer
-
-    /* First, unpack the next GA or PLC */
-    ga.weight = (rtsWeight) *bufptr++;
-
-    if (ga.weight == 2) {  // unglobalised closure to follow
-      // nothing to do; closure starts at *bufptr
-    } else if (ga.weight > 0) { // fill in GA
-      ga.payload.gc.gtid = (GlobalTaskId) *bufptr++;
-      ga.payload.gc.slot = (int) *bufptr++;
-    } else
-      ga.payload.plc = (StgPtr) *bufptr++;
-    
-    /* Now unpack the closure body, if there is one */
-    if (isFixed(&ga)) {
-      fprintf(stderr, "*. %u: PLC @ %p\n", locn, ga.payload.plc);
-      // closure = ga.payload.plc;
-    } else if (isOffset(&ga)) {
-      fprintf(stderr, "*. %u: OFFSET TO %d\n", locn, ga.payload.gc.slot);
-      // closure = (StgClosure *) buffer[ga.payload.gc.slot];
-    } else {
-      /* Print normal closures */
-
-      ASSERT(bufsize > 0);
-
-      fprintf(stderr, "*. %u: ((%x, %d, %x)) ", locn,
-              ga.payload.gc.gtid, ga.payload.gc.slot, ga.weight);
-
-      closure_start = (StgClosure*)bufptr;
-      ip = get_closure_info((StgClosure *)bufptr, 
-			    &size, &ptrs, &nonptrs, &vhs, str);
-	  
-      /* ToDo: check whether this is really needed */
-      if (ip->type == FETCH_ME || ip->type == REMOTE_REF) {
-	size = _HS;
-	ptrs = nonptrs = vhs = 0;
-      }
-      /* ToDo: check whether this is really needed */
-      if (ip->type == ARR_WORDS) {
-	ptrs = vhs = 0;
-	nonptrs = ((StgArrWords *)bufptr)->words;
-	size = arr_words_sizeW((StgArrWords *)bufptr);
-      }
-
-      /* special code for printing a PAP in a buffer */
-      if (ip->type == PAP || ip->type == AP_UPD) {
-        vhs = 3; 
-	ptrs = 0;
-        nonptrs = (nat)((StgPAP *)bufptr)->payload[0];
-	size = _HS+vhs+ptrs+nonptrs;
-      }
-
-      /* 
-	 Remember, the generic closure layout is as follows:
-	 +-------------------------------------------------+
-	 | FIXED HEADER | VARIABLE HEADER | PTRS | NON-PRS |
-	 +-------------------------------------------------+
-      */
-      /* Print fixed header */
-      fprintf(stderr, "FH ["); 
-      for (i = 0; i < _HS; i++)
-	fprintf(stderr, " %p", *bufptr++);
-
-      if (ip->type == FETCH_ME || ip->type == REMOTE_REF)
-	size = ptrs = nonptrs = vhs = 0;
-
-      // VH is always empty in the new RTS
-      ASSERT(vhs==0 ||
-             ip->type == PAP || ip->type == AP_UPD);
-      /* Print variable header */
-      fprintf(stderr, "] VH ["); 
-      for (i = 0; i < vhs; i++)
-	fprintf(stderr, " %p", *bufptr++);
-
-      //fprintf(stderr, "] %d PTRS [", ptrs); 
-      /* Pointers will be filled in later */
-
-      fprintf(stderr, " ] (%d, %d) [", ptrs, nonptrs); 
-      /* Print non-pointers */
-      for (i = 0; i < nonptrs; i++)
-	fprintf(stderr, " %p", *bufptr++);
-
-      fprintf(stderr, "] (%s)\n", str);
-
-      /* Indirections are never packed */
-      // ASSERT(INFO_PTR(graph) != (W_) Ind_info_TO_USE);
-
-      /* Add to queue for processing 
-	 When just printing the packet we do not have an unpacked closure
-	 in hand, so we feed it the packet entry; 
-	 again, this assumes that at least the fixed header of the closure
-	 has the same layout in the packet; also we may not overwrite entries
-	 in the packet (done in Unpack), but for printing that's a bad idea
-	 anyway */
-      QueueClosure((StgClosure *)closure_start);
-	
-      /* No Common up needed for printing */
-
-      /* No Sort out the global address mapping for printing */
-
-    } /* normal closure case */
-
-    /* Locate next parent pointer */
-    pptr++;
-    while (pptr + 1 > pptrs) {
-      parent = DeQueueClosure();
-
-      if (parent == NULL)
-	break;
-      else {
-	(void) get_closure_info(parent, &size, &pptrs, &nonptrs,
-					&pvhs, str);
-	pptr = 0;
-      }
-    }
-  } while (parent != NULL);
-  fprintf(stderr, "*. --- End packet <<%d>> (claimed size=%d; real size=%d)---\n", 
-	  packBuffer->id, packBuffer->size, size);
-
-}
-
-/*
-  Doing a sanity check on a packet.
-  This does a full iteration over the packet, as in PrintPacket.
-*/
-//@cindex checkPacket
-void
-checkPacket(packBuffer)
-rtsPackBuffer *packBuffer;
-{
-  StgClosure *parent, *graphroot, *closure_start;
-  const StgInfoTable *ip;
-  globalAddr ga;
-  StgWord **bufptr, **slotptr;
-
-  nat bufsize;
-  nat pptr = 0, pptrs = 0, pvhs;
-  nat locn = 0;
-  nat size, ptrs, nonptrs, vhs;
-  char str[80];
-
-  /* NB: this whole routine is more or less a copy of UnpackGraph with all
-     unpacking components replaced by printing fcts
-     Long live higher-order fcts!
-  */
-  /* Initialisation */
-  //InitPackBuffer();                  /* in case it isn't already init'd */
-  InitClosureQueue();
-  // ASSERT(gaga==PendingGABuffer); 
-  graphroot = (StgClosure *)NULL;
-
-  /* Unpack the header */
-  bufsize = packBuffer->size;
-  bufptr = packBuffer->buffer;
-  parent = (StgClosure *)NULL;
-  ASSERT(bufsize > 0);
-  do {
-    /* check that we are not at the end of the buffer, yet */
-    IF_DEBUG(sanity, ASSERT(*bufptr != END_OF_BUFFER_MARKER));
-
-    /* This is where we will ultimately save the closure's address */
-    slotptr = bufptr;
-    locn = slotptr-(packBuffer->buffer); // index of closure in buffer
-    ASSERT(locn<=bufsize);
-  
-    /* First, check whether we have a GA, a PLC, or an OFFSET at hand */
-    ga.weight = (rtsWeight) *bufptr++;
-
-    if (ga.weight == 2) {  // unglobalised closure to follow
-      // nothing to do; closure starts at *bufptr
-    } else if (ga.weight > 0) { // fill in GA
-      ga.payload.gc.gtid = (GlobalTaskId) *bufptr++;
-      ga.payload.gc.slot = (int) *bufptr++;
-    } else
-      ga.payload.plc = (StgPtr) *bufptr++;
-    
-    /* Now unpack the closure body, if there is one */
-    if (isFixed(&ga)) {
-      /* It's a PLC */
-      ASSERT(LOOKS_LIKE_STATIC(ga.payload.plc));
-    } else if (isOffset(&ga)) {
-      ASSERT(ga.payload.gc.slot<=(int)bufsize);
-    } else {
-      /* normal closure */
-      ASSERT(!RtsFlags.ParFlags.globalising==0 || LOOKS_LIKE_GA(&ga));
-
-      closure_start = (StgClosure*)bufptr;
-      ASSERT(LOOKS_LIKE_GHC_INFO((StgPtr)*bufptr));
-      ip = get_closure_info((StgClosure *)bufptr, 
-			    &size, &ptrs, &nonptrs, &vhs, str);
-
-      /* ToDo: check whether this is really needed */
-      if (ip->type == FETCH_ME || ip->type == REMOTE_REF) {
-	size = _HS;
-	ptrs = nonptrs = vhs = 0;
-      }
-      /* ToDo: check whether this is really needed */
-      if (ip->type == ARR_WORDS) {
-	ptrs = vhs = 0;
-	nonptrs = ((StgArrWords *)bufptr)->words+1; // payload+words
-	size = arr_words_sizeW((StgArrWords *)bufptr);
-	ASSERT(size==_HS+vhs+nonptrs);
-      }
-      /* special code for printing a PAP in a buffer */
-      if (ip->type == PAP || ip->type == AP_UPD) {
-        vhs = 3; 
-	ptrs = 0;
-        nonptrs = (nat)((StgPAP *)bufptr)->payload[0];
-	size = _HS+vhs+ptrs+nonptrs;
-      }
-
-      /* no checks on contents of closure (pointers aren't packed anyway) */
-      ASSERT(_HS+vhs+nonptrs>=MIN_NONUPD_SIZE);
-      bufptr += _HS+vhs+nonptrs;
-
-      /* Add to queue for processing */
-      QueueClosure((StgClosure *)closure_start);
-	
-      /* No Common up needed for checking */
-
-      /* No Sort out the global address mapping for checking */
-
-    } /* normal closure case */
-
-    /* Locate next parent pointer */
-    pptr++;
-    while (pptr + 1 > pptrs) {
-      parent = DeQueueClosure();
-
-      if (parent == NULL)
-	break;
-      else {
-	//ASSERT(LOOKS_LIKE_GHC_INFO((StgPtr)*parent));
-	(void) get_closure_info(parent, &size, &pptrs, &nonptrs,
-					&pvhs, str);
-	pptr = 0;
-      }
-    }
-  } while (parent != NULL);
-  /* we unpacked exactly as many words as there are in the buffer */
-  ASSERT(packBuffer->size == bufptr-(packBuffer->buffer));
-  /* check for magic end-of-buffer word */  
-  IF_DEBUG(sanity, ASSERT(*bufptr == END_OF_BUFFER_MARKER));
-}
-#else  /* GRAN */
-void
-PrintPacket(buffer)
-rtsPackBuffer *buffer;
-{
-    // extern char *info_hdr_type(P_ infoptr);  /* defined in Threads.lc */
-    // extern char *display_info_type(P_ infoptr);      /* defined in Threads.lc */
-
-    StgInfoTable *info;
-    nat size, ptrs, nonptrs, vhs;
-    char info_hdr_ty[80];
-    char str1[80], str2[80], junk_str[80];
-
-    /* globalAddr ga; */
-
-    nat bufsize, unpacked_size ;
-    StgClosure *parent;
-    nat pptr = 0, pptrs = 0, pvhs;
-
-    nat unpack_locn = 0;
-    nat gastart = unpack_locn;
-    nat closurestart = unpack_locn;
-
-    StgTSO *tso;
-    StgClosure *closure, *p;
-
-    nat i;
-
-    fprintf(stderr, "*** Printing <<%d>> (buffer @ %p):\n", buffer->id, buffer);
-    fprintf(stderr, "  size: %d; unpacked_size: %d; tso: %d (%p); buffer: %p\n",
-	    buffer->size, buffer->unpacked_size, buffer->tso, buffer->buffer);
-    fputs("  contents: ", stderr);
-    for (unpack_locn=0; unpack_locn<buffer->size; unpack_locn++) {
-      closure = buffer->buffer[unpack_locn];
-      fprintf(stderr, ", %p (%s)", 
-	      closure, info_type(closure)); 
-    }
-    fputc('\n', stderr);
-
-#if 0
-    /* traverse all elements of the graph; omitted for now, but might be usefule */
-    InitClosureQueue();
-
-    tso = buffer->tso;
-
-    /* Unpack the header */
-    unpacked_size = buffer->unpacked_size;
-    bufsize = buffer->size;
-
-    fprintf(stderr, "Packet %p, size %u (unpacked size is %u); demanded by TSO %d (%p)[PE %d]\n--- Begin ---\n", 
-	            buffer, bufsize, unpacked_size,  
-	            tso->id, tso, where_is((StgClosure*)tso));
-
-    do {
-	closurestart = unpack_locn;
-	closure = buffer->buffer[unpack_locn++];
-	
-	fprintf(stderr, "[%u]: (%p) ", closurestart, closure);
-
-	info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str1);
-	strcpy(str2, str1);
-	fprintf(stderr, "(%s|%s) ", str1, str2);
-	
-        if (info->type == FETCH_ME || info->type == FETCH_ME_BQ || 
-	    IS_BLACK_HOLE(closure))
-	  size = ptrs = nonptrs = vhs = 0;
-	
-	if (closure_THUNK(closure)) {
-		if (closure_UNPOINTED(closure))
-		    fputs("UNPOINTED ", stderr);
-		else
-		    fputs("POINTED ", stderr);
-	} 
-        if (IS_BLACK_HOLE(closure)) {
-		fputs("BLACK HOLE\n", stderr);
-	} else {
-		/* Fixed header */
-		fprintf(stderr, "FH ["); 
-		for (i = 0, p = (StgClosure*)&(closure->header); i < _HS; i++, p++)
-		    fprintf(stderr, " %p", *p);
-	
-		/* Variable header 
-		if (vhs > 0) {
-		    fprintf(stderr, "] VH [%p", closure->payload[_HS]);
-	
-		    for (i = 1; i < vhs; i++)
-			fprintf(stderr, " %p", closure->payload[_HS+i]);
-		}
-		*/
-		fprintf(stderr, "] PTRS %u", ptrs);
-	
-		/* Non-pointers */
-		if (nonptrs > 0) {
-		    fprintf(stderr, " NPTRS [%p", closure->payload[_HS+vhs]);
-		
-		    for (i = 1; i < nonptrs; i++)
-			fprintf(stderr, " %p", closure->payload[_HS+vhs+i]);
-	
-		    putc(']', stderr);
-		}
-		putc('\n', stderr);
-	}
-    } while (unpack_locn<bufsize) ;  /* (parent != NULL); */
-
-    fprintf(stderr, "--- End ---\n\n");
-#endif /* 0 */
-}
-#endif /* PAR */
-#endif /* DEBUG || GRAN_CHECK */
-
-#endif /* PAR  || GRAN  -- whole file */
-
-//@node End of file,  , Printing Packet Contents, Graph packing
-//@subsection End of file
-
-//@index
-//* AllocateHeap::  @cindex\s-+AllocateHeap
-//* AmPacking::  @cindex\s-+AmPacking
-//* CommonUp::  @cindex\s-+CommonUp
-//* DeQueueClosure::  @cindex\s-+DeQueueClosure
-//* DeQueueClosure::  @cindex\s-+DeQueueClosure
-//* DonePacking::  @cindex\s-+DonePacking
-//* FillInClosure::  @cindex\s-+FillInClosure
-//* IS_BLACK_HOLE::  @cindex\s-+IS_BLACK_HOLE
-//* IS_INDIRECTION::  @cindex\s-+IS_INDIRECTION
-//* InitClosureQueue::  @cindex\s-+InitClosureQueue
-//* InitPendingGABuffer::  @cindex\s-+InitPendingGABuffer
-//* LocateNextParent::  @cindex\s-+LocateNextParent
-//* NotYetPacking::  @cindex\s-+NotYetPacking
-//* OffsetFor::  @cindex\s-+OffsetFor
-//* Pack::  @cindex\s-+Pack
-//* PackArray::  @cindex\s-+PackArray
-//* PackClosure::  @cindex\s-+PackClosure
-//* PackFetchMe::  @cindex\s-+PackFetchMe
-//* PackGeneric::  @cindex\s-+PackGeneric
-//* PackNearbyGraph::  @cindex\s-+PackNearbyGraph
-//* PackOneNode::  @cindex\s-+PackOneNode
-//* PackPAP::  @cindex\s-+PackPAP
-//* PackPLC::  @cindex\s-+PackPLC
-//* PackStkO::  @cindex\s-+PackStkO
-//* PackTSO::  @cindex\s-+PackTSO
-//* PendingGABuffer::  @cindex\s-+PendingGABuffer
-//* PrintPacket::  @cindex\s-+PrintPacket
-//* QueueClosure::  @cindex\s-+QueueClosure
-//* QueueEmpty::  @cindex\s-+QueueEmpty
-//* RoomToPack::  @cindex\s-+RoomToPack
-//* SetGAandCommonUp::  @cindex\s-+SetGAandCommonUp
-//* UnpackGA::  @cindex\s-+UnpackGA
-//* UnpackGraph::  @cindex\s-+UnpackGraph
-//* UnpackOffset::  @cindex\s-+UnpackOffset
-//* UnpackPLC::  @cindex\s-+UnpackPLC
-//* doGlobalGC::  @cindex\s-+doGlobalGC
-//* get_closure_info::  @cindex\s-+get_closure_info
-//* InitPackBuffer::  @cindex\s-+initPackBuffer
-//* isFixed::  @cindex\s-+isFixed
-//* isOffset::  @cindex\s-+isOffset
-//* offsetTable::  @cindex\s-+offsetTable
-//@end index
-
diff --git a/ghc/rts/parallel/ParInit.c b/ghc/rts/parallel/ParInit.c
deleted file mode 100644
index 22c9119c89..0000000000
--- a/ghc/rts/parallel/ParInit.c
+++ /dev/null
@@ -1,322 +0,0 @@
-/* --------------------------------------------------------------------------
-   Time-stamp: <Wed Mar 21 2001 16:37:16 Stardate: [-30]6363.46 hwloidl>
-
-   Initialising the parallel RTS
-
-   An extension based on Kevin Hammond's GRAPH for PVM version
-   P. Trinder, January 17th 1995.
-   Adapted for the new RTS
-   P. Trinder, July 1997.
-   H-W. Loidl, November 1999.
-
-   ------------------------------------------------------------------------ */
-
-#ifdef PAR /* whole file */
-
-//@menu
-//* Includes::			
-//* Global variables::		
-//* Initialisation Routines::	
-//@end menu
-
-//@node Includes, Global variables
-//@subsection Includes
-
-/* Evidently not Posix */
-/* #include "PosixSource.h" */
-
-#include <setjmp.h>
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "ParallelRts.h"
-#include "Sparks.h"
-#include "LLC.h"
-#include "HLC.h"
-
-//@node Global variables, Initialisation Routines, Includes
-//@subsection Global variables
-
-/* Global conditions defined here. */
-
-rtsBool	IAmMainThread = rtsFalse;	/* Set for the main thread	*/
-
-/* Task identifiers for various interesting global tasks. */
-
-GlobalTaskId IOTask = 0,                /* The IO Task Id		*/
-             SysManTask = 0,            /* The System Manager Task Id	*/
-             mytid = 0;                 /* This PE's Task Id		*/
-
-rtsTime 	main_start_time;	/* When the program started	*/
-rtsTime   	main_stop_time;	    	/* When the program finished    */
-jmp_buf		exit_parallel_system;	/* How to abort from the RTS	*/
-
-
-//rtsBool fishing = rtsFalse;             /* We have no fish out in the stream */
-rtsTime last_fish_arrived_at = 0;       /* Time of arrival of most recent fish*/
-nat     outstandingFishes = 0;          /* Number of active fishes */ 
-
-//@cindex spark queue
-/* GranSim: a globally visible array of spark queues */
-rtsSpark *pending_sparks_hd[SPARK_POOLS],  /* ptr to start of a spark pool */ 
-         *pending_sparks_tl[SPARK_POOLS],  /* ptr to end of a spark pool */ 
-         *pending_sparks_lim[SPARK_POOLS],
-         *pending_sparks_base[SPARK_POOLS]; 
-
-//@cindex spark_limit
-/* max number of sparks permitted on the PE; 
-   see RtsFlags.ParFlags.maxLocalSparks */
-nat spark_limit[SPARK_POOLS];
-
-//@cindex PendingFetches
-/* A list of fetch reply messages not yet processed; this list is filled
-   by awaken_blocked_queue and processed by processFetches */
-StgBlockedFetch *PendingFetches = END_BF_QUEUE;
-
-//@cindex allPEs
-GlobalTaskId *allPEs;
-
-//@cindex nPEs
-nat nPEs = 0;
-
-//@cindex sparksIgnored
-nat sparksIgnored = 0, sparksCreated = 0, 
-    threadsIgnored = 0, threadsCreated = 0;
-
-//@cindex advisory_thread_count
-nat advisory_thread_count = 0;
-
-globalAddr theGlobalFromGA;
-
-/* For flag handling see RtsFlags.h */
-
-//@node Prototypes
-//@subsection Prototypes
-
-/* Needed for FISH messages (initialisation of random number generator) */
-void srand48 (long);
-time_t time (time_t *);
-
-//@node Initialisation Routines,  , Global variables
-//@subsection Initialisation Routines
-
-/*
-  par_exit defines how to terminate the program.  If the exit code is
-  non-zero (i.e. an error has occurred), the PE should not halt until
-  outstanding error messages have been processed.  Otherwise, messages
-  might be sent to non-existent Task Ids.  The infinite loop will actually
-  terminate, since STG_Exception will call myexit\tr{(0)} when
-  it received a PP_FINISH from the system manager task.
-*/
-//@cindex shutdownParallelSystem
-void
-shutdownParallelSystem(StgInt n)
-{
-  /* use the file specified via -S */ 
-  FILE *sf = RtsFlags.GcFlags.statsFile;
-
-  IF_PAR_DEBUG(verbose,
-	       if (n==0)
-  	         belch("==== entered shutdownParallelSystem ...");
-               else
-  	         belch("==== entered shutdownParallelSystem (ERROR %d)...", n);
-	       );
-  
-  stopPEComms(n);
-
-#if 0
-  if (sf!=(FILE*)NULL) 
-    fprintf(sf, "PE %x: %u sparks created, %u sparks Ignored, %u threads created, %u threads Ignored", 
-	    (W_) mytid, sparksCreated, sparksIgnored,
-	    threadsCreated, threadsIgnored);
-#endif
-
-  ShutdownEachPEHook();
-}
-
-//@cindex initParallelSystem
-void
-initParallelSystem(void)
-{
-  /* Don't buffer standard channels... */
-  setbuf(stdout,NULL);
-  setbuf(stderr,NULL);
-  
-  srand48(time(NULL) * getpid()); /* Initialise Random-number generator seed*/
-                                  /* used to select target of FISH message*/
-  if (!InitPackBuffer())
-    barf("InitPackBuffer");
-
-  if (!initMoreBuffers())
-    barf("initMoreBuffers");
-
-  if (!initSparkPools())
-    barf("initSparkPools");
-}
-
-/* 
- * SynchroniseSystem synchronises the reduction task with the system
- * manager, and initialises the Global address tables (LAGA & GALA)
- */
-
-//@cindex synchroniseSystem
-void
-synchroniseSystem(void)
-{
-  /* Only in debug mode? */
-  fprintf(stderr, "==== Starting parallel execution on %d processors ...\n", nPEs);
-
-  InitEachPEHook();                  /* HWL: hook to be execed on each PE */
-
-  /* Initialize global address tables */
-  initGAtables();
-
-  initParallelSystem();
-  
-  startPEComms();
-}
-
-/* 
-  Do the startup stuff (this is PVM specific!).
-  Determines global vars: mytid, IAmMainThread, SysManTask, nPEs
-  Called at the beginning of RtsStartup.startupHaskell
-*/
-void 
-startupParallelSystem(char *argv[]) { 
- mytid = pvm_mytid();	        /* Connect to PVM */
-
- if (*argv[0] == '-') {         /* Look to see whether we're the Main Thread */
-  IAmMainThread = rtsTrue;
-  sscanf(argv[0],"-%0X",&SysManTask);  /* extract SysMan task ID*/	
-  argv++;	                       /* Strip off flag argument */
- } else {
-  SysManTask = pvm_parent();
- }
-
- IF_PAR_DEBUG(verbose,
-	       fprintf(stderr, "==== [%x] %s PE located SysMan at %x\n",
-		       mytid, IAmMainThread?"Main":"Remote", SysManTask));
-
- nPEs = atoi(argv[1]);
-}
-
-/* 
-   Exception handler during startup.
-*/
-void *
-processUnexpectedMessageDuringStartup(rtsPacket p) {
-  OpCode opCode;
-  GlobalTaskId sender_id;
-
-  getOpcodeAndSender(p, &opCode, &sender_id);
-
-  switch(opCode) { 
-      case PP_FISH:
-        bounceFish();
-	break;
-#if defined(DIST)
-      case PP_REVAL:
-	bounceReval();
-	break;
-#endif
-      case PP_FINISH:
-        stg_exit(EXIT_SUCCESS);	
-	break;
-      default:
-	fprintf(stderr,"== Task %x: Unexpected OpCode %x (%s) from %x in startPEComms\n",
-		mytid, opCode, getOpName(opCode), sender_id);
-    }
-}
-
-void 
-startPEComms(void){ 
-
-  startUpPE(); 
-  allPEs = (GlobalTaskId *) stgMallocBytes(sizeof(GlobalTaskId) * MAX_PES,
-					   "(PEs)");
-  
-  /* Send our tid and IAmMainThread flag back to SysMan */
-  sendOp1(PP_READY, SysManTask, (StgWord)IAmMainThread);  
-  /* Wait until we get the PE-Id table from Sysman */    
-  waitForPEOp(PP_PETIDS, SysManTask, processUnexpectedMessageDuringStartup); 
-
-  IF_PAR_DEBUG(verbose,
-               belch("==-- startPEComms: methinks we just received a PP_PETIDS message"));
-
-  /* Digest the PE table we received */
-  processPEtids();
-}
-
-void
-processPEtids(void) { 
-  long newPE;
-  nat i, sentPEs, currentPEs;
-
-  nPEs=0;
-	  
-  currentPEs = nPEs;
-
-  IF_PAR_DEBUG(verbose,
-		belch("==-- processPEtids: starting to iterate over a PVM buffer"));
-  /* ToDo: this has to go into LLComms !!! */
-  GetArgs(&sentPEs,1);
-
-  ASSERT(sentPEs > currentPEs);
-  ASSERT(sentPEs < MAX_PES); /* enforced by SysMan too*/  
-  
-  for (i = 0; i < sentPEs; i++) { 
-    GetArgs(&newPE,1);
-    if (i<currentPEs) { 
-      ASSERT(newPE == allPEs[i]);
-    } else { 
-#if defined(DIST)
-      // breaks with PAR && !DEBUG
-      IF_PAR_DEBUG(verbose,
-	fprintf(stderr, "[%x] registering %d'th %x\n", mytid, i, newPE)); 
-      if(!looks_like_tid(newPE))
-	  barf("unacceptable taskID %x\n",newPE);
-#endif
-      allPEs[i] = newPE;      
-      nPEs++;
-      registerTask(newPE); 
-    }
-  }
-
-  IF_PAR_DEBUG(verbose,
-  	       /* debugging */
-  	       belch("++++ [%x] PE table as I see it:", mytid);
-  	       for (i = 0; i < sentPEs; i++) { 
-  		 belch("++++ allPEs[%d] = %x", i, allPEs[i]);
-               });
-}
-
-void 
-stopPEComms(StgInt n) { 
-  if (n != 0) { 
-    /* In case sysman doesn't know about us yet...
-    pvm_initsend(PvmDataDefault);
-    PutArgs(&IAmMainThread,1);
-    pvm_send(SysManTask, PP_READY);
-     */
-    sendOp(PP_READY, SysManTask);  
-  } 
-  
-  sendOp2(PP_FINISH, SysManTask, n, n);  
-  waitForPEOp(PP_FINISH, SysManTask, NULL);
-  fflush(gr_file);
-  shutDownPE();
-}
-
-#endif /* PAR -- whole file */
-
-//@index
-//* PendingFetches::  @cindex\s-+PendingFetches
-//* SynchroniseSystem::  @cindex\s-+SynchroniseSystem
-//* allPEs::  @cindex\s-+allPEs
-//* initParallelSystem::  @cindex\s-+initParallelSystem
-//* nPEs::  @cindex\s-+nPEs
-//* par_exit::  @cindex\s-+par_exit
-//* spark queue::  @cindex\s-+spark queue
-//* sparksIgnored::  @cindex\s-+sparksIgnored
-//@end index
-
diff --git a/ghc/rts/parallel/ParInit.h b/ghc/rts/parallel/ParInit.h
deleted file mode 100644
index a22a50bae6..0000000000
--- a/ghc/rts/parallel/ParInit.h
+++ /dev/null
@@ -1,19 +0,0 @@
-/* -----------------------------------------------------------------------------
- * ParInit.h,1
- * 
- * Phil Trinder
- * July 1998
- *
- * External Parallel Initialisation Interface
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef PARINIT_H
-#define PARINIT_H
-
-extern void RunParallelSystem (P_);
-extern void initParallelSystem(void);
-extern void SynchroniseSystem(void);
-extern void par_exit(I_);
-
-#endif /* PARINIT_H */
diff --git a/ghc/rts/parallel/ParTicky.c b/ghc/rts/parallel/ParTicky.c
deleted file mode 100644
index 347c2b8bca..0000000000
--- a/ghc/rts/parallel/ParTicky.c
+++ /dev/null
@@ -1,450 +0,0 @@
-/* -------------------------------------------------------------------------
- *
- * (c) Hans-Wolfgang Loidl, 2000-
- *
- * Parallel ticky profiling, monitoring basic RTS operations in GUM.
- * Similar in structure to TICKY_TICKY profiling, but doesn't need a 
- * separate way of building GHC.
- *-------------------------------------------------------------------------- */
-
-#if defined(PAR) && defined(PAR_TICKY)
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-//#include "StoragePriv.h"
-//#include "MBlock.h"
-//#include "Schedule.h"
-#include "GC.h"
-#include "Stats.h"
-#include "ParTicky.h"                       // ToDo: move into Rts.h
-#include "ParallelRts.h"
-
-#if defined(PAR) && defined(HAVE_GETRUSAGE)
-#include <sys/resource.h>
-#endif
-
-/* external data */
-extern double ElapsedTimeStart;
-
-extern ullong GC_tot_alloc;
-extern ullong GC_tot_copied;
-
-extern lnat MaxResidency;     /* in words; for stats only */
-extern lnat ResidencySamples; /* for stats only */
-
-/* ngIplu' {Stats.c}vo' */
-#define BIG_STRING_LEN              512
-
-/* ngIplu' {Ticky.c}vo' */
-#define INTAVG(a,b) ((b == 0) ? 0.0 : ((double) (a) / (double) (b)))
-#define PC(a)	    (100.0 * a)
-
-#define AVG(thing) \
-	StgDouble avg##thing  = INTAVG(tot##thing,ctr##thing)
-
-
-#if 0
-void
-set_foo_time(double *x) {
-  *x = usertime();
-}
-
-double
-get_foo_time(double x) {
-  fprintf(stderr, "get_foo_time: %7.2f (%7.5f,%7.5f) \n", 
-	  usertime()-x,usertime(),x);
-  return (usertime()-x);
-}
-#endif
-
-static double start_time_GA = 0.0;
-static double start_mark = 0.0;
-static double start_pack = 0.0;
-static double start_unpack = 0.0;
-
-void
-par_ticky_Par_start (void) {
-# if !defined(HAVE_GETRUSAGE) || irix_HOST_OS || defined(_WIN32)
-    fprintf(stderr, "|| sorry don't have RUSAGE\n");
-    return ;
-# else
-    FILE *sf = RtsFlags.GcFlags.statsFile;
-    struct rusage t;
-    double utime, stime;
-
-    if (RtsFlags.GcFlags.giveStats>1 && sf != NULL) {
-      getrusage(RUSAGE_SELF, &t);
-      
-      utime = t.ru_utime.tv_sec + 1e-6*t.ru_utime.tv_usec;
-      stime = t.ru_stime.tv_sec + 1e-6*t.ru_stime.tv_usec;
-      
-      fprintf(stderr, "|| user time: %5.2f; system time: %5.2f\n",
-	      utime, stime);
-      fprintf(stderr, "|| max RSS: %ld; int SM size: %ld; int USM data size: %ld; int USS size: %ld\n",
-	      t.ru_maxrss, t.ru_ixrss, t.ru_idrss, t.ru_isrss);
-    }
-#endif
-}
-
-#if 0	    
-FYI:
-            struct rusage
-            {
-                 struct timeval ru_utime; /* user time used */
-                 struct timeval ru_stime; /* system time used */
-                 long ru_maxrss;          /* maximum resident set size */
-                 long ru_ixrss;      /* integral shared memory size */
-                 long ru_idrss;      /* integral unshared data size */
-                 long ru_isrss;      /* integral unshared stack size */
-                 long ru_minflt;          /* page reclaims */
-                 long ru_majflt;          /* page faults */
-                 long ru_nswap;      /* swaps */
-                 long ru_inblock;         /* block input operations */
-                 long ru_oublock;         /* block output operations */
-                 long ru_msgsnd;          /* messages sent */
-                 long ru_msgrcv;          /* messages received */
-                 long ru_nsignals;        /* signals received */
-                 long ru_nvcsw;      /* voluntary context switches */
-                 long ru_nivcsw;          /* involuntary context switches */
-            };
-#endif
-
-
-void
-par_ticky_rebuildGAtables_start(void) {
-  // collect parallel global statistics (currently done together with GC stats)
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    //set_foo_time(&start_time_GA);
-    start_time_GA = usertime();
-  }
-}
-
-void
-par_ticky_rebuildGAtables_end(nat n, nat size_GA) {
-  // collect parallel global statistics (currently done together with GC stats)
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    static double foo = 0.0; 
-    foo = usertime() - start_time_GA; // get_foo_time(start_time_GA);
-    globalParStats.cnt_rebuild_GA++;
-    globalParStats.tot_rebuild_GA += n;
-    if ( n > globalParStats.res_rebuild_GA ) 
-      globalParStats.res_rebuild_GA = n;
-    // fprintf(stderr, "rebuildGAtables: footime=%7.2f (%11.5f, %11.5f)\n", 
-    //    foo, usertime(), start_time_GA);
-    globalParStats.time_rebuild_GA += foo;
-    globalParStats.tot_size_GA += size_GA;
-    if ( size_GA > globalParStats.res_size_GA ) 
-      globalParStats.res_size_GA = size_GA;
-  }
-  // fprintf(stderr, ">> n: %d; size: %d;; tot: %d;  res: %d\n",
-  //	  n, size_GA, globalParStats.tot_size_GA, globalParStats.res_size_GA);
-}
-
-void
-par_ticky_markLocalGAs_start(void) {
-  // collect parallel global statistics (currently done together with GC stats)
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    start_time_GA = usertime();
-  }
-}
-
-void
-par_ticky_markLocalGAs_end(nat n) {
-  // collect parallel global statistics (currently done together with GC stats)
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    globalParStats.cnt_mark_GA++;
-    globalParStats.tot_mark_GA += n;
-    if ( n > globalParStats.res_mark_GA ) 
-      globalParStats.res_mark_GA = n;
-    globalParStats.time_mark_GA += usertime() - start_time_GA;
-  }
-}
-
-void
-par_ticky_markSparkQueue_start(void) {
-  // collect parallel global statistics (currently done together with GC stats)
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    start_mark=usertime();
-  }
-}
-
-void
-par_ticky_markSparkQueue_end(nat n) {
-  // collect parallel global statistics (currently done together with GC stats)
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    globalParStats.time_sparks += usertime() - start_mark;
-
-    globalParStats.tot_sparks_marked += n;
-    if ( n > globalParStats.res_sparks_marked ) 
-      globalParStats.res_sparks_marked = n;
-  }
-}
-
-void
-par_ticky_PackNearbyGraph_start (void) {
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    start_pack=usertime();
-  }
-}
-
-void
-par_ticky_PackNearbyGraph_end(nat n, nat thunks) {
-  // collect parallel global statistics (currently done together with GC stats)
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    globalParStats.time_pack += usertime() - start_pack;
-
-    globalParStats.tot_packets++;
-    globalParStats.tot_packet_size += n;
-    if ( n > globalParStats.res_packet_size ) 
-      globalParStats.res_packet_size = n;
-    globalParStats.tot_thunks += thunks;
-    if ( thunks > globalParStats.res_thunks ) 
-      globalParStats.res_thunks = thunks;
-  }
-}
-
-void
-par_ticky_UnpackGraph_start (void) {
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    start_unpack=usertime();
-  }
-}
-
-void
-par_ticky_UnpackGraph_end(nat n, nat thunks) {
-  // collect parallel global statistics (currently done together with GC stats)
-  if (RtsFlags.ParFlags.ParStats.Global &&
-      RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-    globalParStats.time_unpack += usertime() - start_unpack;
-
-    globalParStats.rec_packets++;
-    globalParStats.rec_packet_size += n;
-    /*
-    if ( n > globalParStats.res_packet_size ) 
-      globalParStats.res_packet_size = n;
-    */
-    globalParStats.rec_thunks += thunks;
-    /*
-    if ( thunks > globalParStats.res_thunks ) 
-      globalParStats.res_thunks = thunks;
-    */
-  }
-}
-
-void
-par_ticky_TP (void) {
-    StgSparkPool *pool;
-    nat tp_size, sp_size; // stats only
-
-    // Global stats gathering
-    /* the spark pool for the current PE */
-    pool = &(MainRegTable.rSparks); // generalise to cap = &MainRegTable
-
-    // Global statistics: residency of thread and spark pool
-    if (RtsFlags.ParFlags.ParStats.Global &&
-	RtsFlags.GcFlags.giveStats > NO_GC_STATS) {
-      tp_size = run_queue_len() + 1; // add the TSO just poped
-      // No: there may be many blocked threads being awoken at the same time
-      // ASSERT(tp_size <= RtsFlags.ParFlags.maxThreads);
-      globalParStats.tot_tp += tp_size;
-      globalParStats.emp_tp += (tp_size==0) ? 1 : 0;
-      globalParStats.cnt_tp++;
-      if ( tp_size > globalParStats.res_tp)
-	globalParStats.res_tp = tp_size;
-      // fprintf(stderr, "run_queue_len() = %d (max %d)\n", run_queue_len(), globalParStats.res_tp);
-      sp_size = spark_queue_len(pool);
-      //ASSERT(sp_size <= RtsFlags.ParFlags.maxLocalSparks);
-      globalParStats.tot_sp += sp_size;
-      globalParStats.emp_sp += (sp_size==0) ? 1 : 0;
-      globalParStats.cnt_sp++;
-      if ( sp_size > globalParStats.res_sp)
-	globalParStats.res_sp = sp_size;
-      // fprintf(stderr, "spark_queue_len(pool) = %d (max %d)\n", spark_queue_len(pool), globalParStats.res_sp);
-    }
-}
-
-void
-globalParStat_exit(void)
-{
-    FILE *sf = RtsFlags.GcFlags.statsFile;
-    double time, etime;
-
-    /* print only if GC stats is enabled, too; i.e. -sstderr */
-    if (!(RtsFlags.ParFlags.ParStats.Global &&
-	RtsFlags.GcFlags.giveStats > NO_GC_STATS)) 
-      return;
-
-    time = usertime();
-    etime = elapsedtime() - ElapsedTimeStart;
-    // fprintf(stderr, "foo=%7.2f\n", time);
-
-    if (sf != NULL){
-        char temp[BIG_STRING_LEN];
-
-	// GC_tot_alloc += alloc;
-	fprintf(sf,"\n");
-
-	fprintf(sf, "%11d threads created\n", 
-		globalParStats.tot_threads_created);
-	/*
-	  Would need to add a ++ to the par macro to use this
-
-	fprintf(sf, "%11d sparks created\n", 
-		globalParStats.tot_sparks_created);
-	fprintf(sf, "%11d sparks ignored\n", 
-		globalParStats.tot_sparks_ignored);
-	*/
-	ullong_format_string(globalParStats.res_tp, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s thread pool residency", temp);
-	fprintf(sf, " (avg: %3.2f; %d times (%2.2f%%) of %d empty)\n", 
-		(double)globalParStats.tot_tp/(double)globalParStats.cnt_tp,
-		globalParStats.emp_tp, 
-		globalParStats.emp_tp*100.0/(double)globalParStats.cnt_tp,
-		globalParStats.cnt_tp);
-	ullong_format_string(globalParStats.res_sp, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s spark pool residency", temp);
-
-	fprintf(sf, " (avg: %3.2f; %d times (%2.2f%%) of %d empty)\n", 
-		(double)globalParStats.tot_sp/(double)globalParStats.cnt_sp,
-		globalParStats.emp_sp, 
-		globalParStats.emp_sp*100.0/(double)globalParStats.cnt_sp,
-		globalParStats.cnt_sp);
-	//ullong_format_string(globalParStats.tot_fishes, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11d messages sent (%d fish, %d fetch, %d resume, %d schedule", 
-		globalParStats.tot_fish_mess+globalParStats.tot_fetch_mess+
-		globalParStats.tot_resume_mess+globalParStats.tot_schedule_mess,
-		globalParStats.tot_fish_mess, globalParStats.tot_fetch_mess, 
-		globalParStats.tot_resume_mess, globalParStats.tot_schedule_mess);
-#if defined(DIST)
-	fprintf(sf, "%d revals", globalParStats.tot_reval_mess);
-#endif
-	fprintf(sf,")\n");
-	fprintf(sf, "%11d messages received (%d fish, %d fetch, %d resume, %d schedule", 
-		globalParStats.rec_fish_mess+globalParStats.rec_fetch_mess+
-		globalParStats.rec_resume_mess+globalParStats.rec_schedule_mess,
-		globalParStats.rec_fish_mess, globalParStats.rec_fetch_mess, 
-		globalParStats.rec_resume_mess, globalParStats.rec_schedule_mess);
-#if defined(DIST)
-	fprintf(sf, "%d revals", globalParStats.rec_reval_mess);
-#endif
-	fprintf(sf,")\n\n");
-
-	ullong_format_string(globalParStats.tot_size_GA*sizeof(W_), temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s bytes of global heap in total ", temp);
-	fprintf(sf, "(%5.2f%% of total allocated heap)\n", 
-		globalParStats.tot_size_GA*sizeof(W_)*100.0/(double)GC_tot_alloc*sizeof(W_));
-	ullong_format_string(globalParStats.res_size_GA*sizeof(W_), temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s bytes global heap residency ", temp);
-	fprintf(sf, "(%5.2f%% of max heap residency)\n", 
-		globalParStats.res_size_GA*sizeof(W_)*100.0/(double)MaxResidency*sizeof(W_));
-
-	//ullong_format_string(globalParStats.res_mark_GA, temp, rtsTrue/*commas*/);
-	//fprintf(sf, "%11s GAs residency in GALA table ", temp);
-	// ullong_format_string(globalParStats.tot_mark_GA, temp, rtsTrue/*commas*/);
-	//fprintf(sf, "(avg %5.2f; %d samples)\n", 
-	//	(double)globalParStats.tot_mark_GA/(double)globalParStats.cnt_mark_GA,
-	//	globalParStats.cnt_mark_GA);
-
-	ullong_format_string(globalParStats.local_alloc_GA, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s GAs locally allocated (calls to makeGlobal)\n", temp);
-
-	ullong_format_string(globalParStats.tot_rebuild_GA, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s live GAs in total (after rebuilding tables)\n", temp);
-	ullong_format_string(globalParStats.res_rebuild_GA, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s GAs residency (after rebuilding tables) ", temp);
-	fprintf(sf, "(avg %5.2f; %d samples)\n", 
-		(double)globalParStats.tot_rebuild_GA/(double)globalParStats.cnt_rebuild_GA,
-		globalParStats.cnt_rebuild_GA);
-	ullong_format_string(globalParStats.res_free_GA, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s residency of freeing GAs", temp);
-	fprintf(sf, " (avg %5.2f; %d samples)\n", 
-		(double)globalParStats.tot_free_GA/(double)globalParStats.cnt_free_GA,
-		globalParStats.cnt_free_GA);
-
-	fprintf(sf, "%11.2fs spent marking GAs (%7.2f%% of %7.2fs)\n", 
-		globalParStats.time_mark_GA,
-		globalParStats.time_mark_GA*100./time, time);
-	fprintf(sf, "%11.2fs spent rebuilding GALA tables (%7.2f%% of %7.2fs; %7.2f%% of %7.2fs)\n", 
-		globalParStats.time_rebuild_GA,
-		globalParStats.time_rebuild_GA*100./time, time,
-		globalParStats.time_rebuild_GA*100./etime, etime);
-
-	ullong_format_string(globalParStats.tot_sparks_marked, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s sparks marked\t", temp);
-	ullong_format_string(globalParStats.res_sparks_marked, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%6s spark mark residency\n", temp);
-	fprintf(sf, "%11.2fs spent marking sparks (%7.2f%% of %7.2fs; %7.2f%% of %7.2fs elapsed)\n", 
-		globalParStats.time_sparks,
-		globalParStats.time_sparks*100./time, time,
-		globalParStats.time_sparks*100./etime, etime);
-
-	fprintf(sf,"\n");
-
-	ullong_format_string(globalParStats.tot_packets, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s packets sent\n", temp);
-	ullong_format_string(globalParStats.tot_packet_size, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s bytes of graph sent in total (max %d; avg %.2f)\n",
-		temp, globalParStats.res_packet_size,
-		(double)globalParStats.tot_packet_size/(double)globalParStats.tot_packets);
-	ullong_format_string(globalParStats.tot_thunks, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s thunks sent in total (max %d; avg %.2f)\n",
-		temp, globalParStats.res_thunks,
-		(double)globalParStats.tot_thunks/(double)globalParStats.tot_packets);
-	fprintf(sf, "%11.2fs spent packing graph structures (%7.2f%% of %7.2fs; %7.2f%% of %7.2fs elapsed)\n", 
-		globalParStats.time_pack,
-		globalParStats.time_pack*100./time, time,
-		globalParStats.time_pack*100./etime, etime);
-
-	ullong_format_string(globalParStats.rec_packets, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s packets received\n", temp);
-	ullong_format_string(globalParStats.rec_packet_size, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s bytes of graph received in total (max %d; avg %.2f)\n",
-		temp, globalParStats.rec_res_packet_size,
-		(double)globalParStats.rec_packet_size/(double)globalParStats.rec_packets);
-	ullong_format_string(globalParStats.rec_thunks, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s thunks received in total (max %d; avg %.2f)\n",
-		temp, globalParStats.rec_res_thunks,
-		(double)globalParStats.rec_thunks/(double)globalParStats.rec_packets);
-	fprintf(sf, "%11.2fs spent unpacking graph structures (%7.2f%% of %7.2fs; %7.2f%% of %7.2fs elapsed)\n", 
-		globalParStats.time_unpack,
-		globalParStats.time_unpack*100./time, time,
-		globalParStats.time_unpack*100./etime, etime);
-
-	fprintf(sf,"\n");
-
-	ullong_format_string(globalParStats.tot_arrs, temp, rtsTrue/*commas*/);
-	fprintf(sf, "%11s bytearrays sent; ", temp);
-	ullong_format_string(globalParStats.tot_arr_size, temp, rtsTrue/*commas*/);
-	fprintf(sf, " %s bytes in total (avg %.2f)\n",
-		temp, 
-		(double)globalParStats.tot_arr_size/(double)globalParStats.tot_arrs);
-	
-	fprintf(sf,"\n");
-
-	fprintf(sf, "%11d yields, %d stack overflows, %d heap overflows\n",
-		globalParStats.tot_yields, globalParStats.tot_stackover,
- 		globalParStats.tot_heapover); 
-
-	fprintf(sf,"\n");
-
-	//fprintf(stderr, "Printing this pathetic statistics took %7.2fs (start @ %7.2f)\n",
-	//	usertime()-time, time);
-
-	fflush(sf);
-	// Open filehandle needed by other stats printing fcts
-	// fclose(sf);
-    }
-}
-
-#endif
-
diff --git a/ghc/rts/parallel/ParTicky.h b/ghc/rts/parallel/ParTicky.h
deleted file mode 100644
index 1d6e7435c9..0000000000
--- a/ghc/rts/parallel/ParTicky.h
+++ /dev/null
@@ -1,60 +0,0 @@
-/* --------------------------------------------------------------------------
- *
- * (c) Hans-Wolfgang Loidl, 2000-
- *
- * Header for ParTicky.c
- *
- * --------------------------------------------------------------------------*/
-
-#if defined(PAR_TICKY)
-
-/* macros */
-#define PAR_TICKY_PAR_START()              par_ticky_Par_start () 
-#define PAR_TICKY_PAR_END()                globalParStat_exit () 
-#define PAR_TICKY_REBUILD_GA_TABLES_START()  par_ticky_rebuildGAtables_start() 
-#define PAR_TICKY_REBUILD_GA_TABLES_END(n, size_GA) par_ticky_rebuildGAtables_end(n, size_GA) 
-#define PAR_TICKY_MARK_LOCAL_GAS_START()     par_ticky_markLocalGAs_start() 
-#define PAR_TICKY_MARK_LOCAL_GAS_END(n)      par_ticky_markLocalGAs_end(n) 
-#define PAR_TICKY_MARK_SPARK_QUEUE_START()   par_ticky_markSparkQueue_start() 
-#define PAR_TICKY_MARK_SPARK_QUEUE_END(n)    par_ticky_markSparkQueue_end(n) 
-#define PAR_TICKY_PACK_NEARBY_GRAPH_START()  (par_ticky_PackNearbyGraph_start())
-#define PAR_TICKY_PACK_NEARBY_GRAPH_END(n, thunks) par_ticky_PackNearbyGraph_end(n, thunks) 
-#define PAR_TICKY_UNPACK_GRAPH_START()      par_ticky_UnpackGraph_start() 
-#define PAR_TICKY_UNPACK_GRAPH_END(n,thunks) par_ticky_UnpackGraph_end(n,thunks)
-#define PAR_TICKY_TP()                     par_ticky_TP() 
-#define PAR_TICKY_CNT_FREE_GA()            stats_CntFreeGA()
-
-/* prototypes */
-extern void par_ticky_Par_start (void) ;
-extern void par_ticky_rebuildGAtables_start(void) ;
-extern void par_ticky_rebuildGAtables_end(nat n, nat size_GA) ;
-extern void par_ticky_markLocalGAs_start(void) ;
-extern void par_ticky_markLocalGAs_end(nat n) ;
-extern void par_ticky_markSparkQueue_start(void) ;
-extern void par_ticky_markSparkQueue_end(nat n) ;
-extern void par_ticky_PackNearbyGraph_start (void) ;
-extern void par_ticky_PackNearbyGraph_end(nat n, nat thunks) ;
-extern void par_ticky_UnpackGraph_start (void) ;
-extern void par_ticky_UnpackGraph_end(nat n, nat thunks) ;
-extern void par_ticky_TP (void) ;
-extern void globalParStat_exit(void);
-
-#else
-
-#define PAR_TICKY_PAR_START()
-#define PAR_TICKY_PAR_END()  
-#define PAR_TICKY_REBUILD_GA_TABLES_START()
-#define PAR_TICKY_REBUILD_GA_TABLES_END(n, size_GA)
-#define PAR_TICKY_MARK_LOCAL_GAS_START()
-#define PAR_TICKY_MARK_LOCAL_GAS_END(n) 
-#define PAR_TICKY_MARK_SPARK_QUEUE_START()
-#define PAR_TICKY_MARK_SPARK_QUEUE_END(n) 
-#define PAR_TICKY_PACK_NEARBY_GRAPH_START () 
-#define PAR_TICKY_PACK_NEARBY_GRAPH_END(n, thunks)
-#define PAR_TICKY_UNPACK_GRAPH_START ()    
-#define PAR_TICKY_UNPACK_GRAPH_END(n, thunks) 
-#define PAR_TICKY_TP ()                    
-#define PAR_TICKY_CNT_FREE_GA()            
-
-#endif
-
diff --git a/ghc/rts/parallel/ParTypes.h b/ghc/rts/parallel/ParTypes.h
deleted file mode 100644
index 910a6f2d99..0000000000
--- a/ghc/rts/parallel/ParTypes.h
+++ /dev/null
@@ -1,38 +0,0 @@
-/* ---------------------------------------------------------------------------
- * Time-stamp: <Tue Nov 09 1999 16:31:38 Stardate: [-30]3873.44 hwloidl>
- *
- * Runtime system types for GUM
- *
- * ------------------------------------------------------------------------- */
-
-#ifndef PARTYPES_H
-#define PARTYPES_H
-
-#ifdef PAR /* all of it */
-
-// now in Parallel.h 
-//typedef struct hashtable  HashTable;
-//typedef struct hashlist   HashList;
-
-/* Global addresses now live in Parallel.h (needed in Closures.h) */
-// gaddr
-
-// now in Parallel.h 
-/* (GA, LA) pairs 
-typedef struct gala {
-    globalAddr   ga;
-    StgPtr       la;
-    struct gala *next;
-    rtsBool      preferred;
-} rtsGaLa;
-*/
-
-#if defined(GRAN)
-typedef unsigned long TIME;
-typedef unsigned char Proc;
-typedef unsigned char EVTTYPE;
-#endif
-
-#endif /* PAR */
-
-#endif /* ! PARTYPES_H */
diff --git a/ghc/rts/parallel/Parallel.c b/ghc/rts/parallel/Parallel.c
deleted file mode 100644
index 414b7e4406..0000000000
--- a/ghc/rts/parallel/Parallel.c
+++ /dev/null
@@ -1,1140 +0,0 @@
-/*
-  Time-stamp: <Wed Mar 21 2001 16:42:40 Stardate: [-30]6363.48 hwloidl>
-
-  Basic functions for use in either GranSim or GUM.
-*/
-
-#if defined(GRAN) || defined(PAR)                              /* whole file */
-
-//@menu
-//* Includes::			
-//* Variables and constants::	
-//* Writing to the log-file::	
-//* Global statistics::		
-//* Dumping routines::		
-//@end menu
-//*/ fool highlight
-
-//@node Includes, Variables and constants
-//@subsection Includes
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "Storage.h"
-#include "GranSimRts.h"
-#include "ParallelRts.h"
-
-//@node Variables and constants, Writing to the log-file, Includes
-//@subsection Variables and constants
-
-/* Where to write the log file */
-FILE *gr_file = NULL;
-char gr_filename[STATS_FILENAME_MAXLEN];
-
-#if defined(PAR)
-/* Global statistics */
-GlobalParStats globalParStats;
-#endif
-
-#if defined(PAR)
-ullong startTime = 0;
-#endif
-
-#if defined(PAR) && !defined(DEBUG)
-// HAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACCCCCCCCCKKKKKKKKKKKK
-// Definitely the wrong place for info_type in !DEBUG (see Printer.c) -- HWL
-
-static char *closure_type_names[] = {
-  "INVALID_OBJECT",          	/* 0  */
-  "CONSTR",                  	/* 1  */
-  "CONSTR_1_0",			/* 2  */
-  "CONSTR_0_1",			/* 3  */
-  "CONSTR_2_0",			/* 4  */
-  "CONSTR_1_1",			/* 5  */
-  "CONSTR_0_2",			/* 6  */
-  "CONSTR_INTLIKE",	        /* 7  */
-  "CONSTR_CHARLIKE",	        /* 8  */
-  "CONSTR_STATIC",	        /* 9  */
-  "CONSTR_NOCAF_STATIC",     	/* 10 */
-  "FUN",		        /* 11 */
-  "FUN_1_0",		  	/* 12 */
-  "FUN_0_1",		  	/* 13 */
-  "FUN_2_0",		  	/* 14 */
-  "FUN_1_1",		  	/* 15 */
-  "FUN_0_2",			/* 16 */
-  "FUN_STATIC",	        	/* 17 */
-  "THUNK",		        /* 18 */
-  "THUNK_1_0",	  		/* 19 */
-  "THUNK_0_1",	  		/* 20 */
-  "THUNK_2_0",	  		/* 21 */
-  "THUNK_1_1",	  		/* 22 */
-  "THUNK_0_2",			/* 23 */
-  "THUNK_STATIC",	        /* 24 */
-  "THUNK_SELECTOR",	        /* 25 */
-  "BCO",		        /* 26 */
-  "AP_UPD",		        /* 27 */
-  "PAP",			/* 28 */
-  "IND",		        /* 29 */
-  "IND_OLDGEN",	        	/* 30 */
-  "IND_PERM",	        	/* 31 */
-  "IND_OLDGEN_PERM",	        /* 32 */
-  "IND_STATIC",	        	/* 33 */
-  "CAF_UNENTERED",           	/* 34 */
-  "CAF_ENTERED",		/* 35 */
-  "CAF_BLACKHOLE",		/* 36 */
-  "RET_BCO",                 	/* 37 */
-  "RET_SMALL",	        	/* 38 */
-  "RET_VEC_SMALL",	        /* 39 */
-  "RET_BIG",		        /* 40 */
-  "RET_VEC_BIG",	        /* 41 */
-  "RET_DYN",		        /* 42 */
-  "UPDATE_FRAME",	        /* 43 */
-  "CATCH_FRAME",	        /* 44 */
-  "STOP_FRAME",	        	/* 45 */
-  "SEQ_FRAME",	        	/* 46 */
-  "BLACKHOLE",	        	/* 47 */
-  "BLACKHOLE_BQ",	        /* 48 */
-  "SE_BLACKHOLE",		/* 49 */
-  "SE_CAF_BLACKHOLE",		/* 50 */
-  "MVAR",		        /* 51 */
-  "ARR_WORDS",	        	/* 52 */
-  "MUT_ARR_PTRS",	        /* 53 */
-  "MUT_ARR_PTRS_FROZEN",     	/* 54 */
-  "MUT_VAR",		        /* 55 */
-  "WEAK",		        /* 56 */
-  "FOREIGN",		        /* 57 */
-  "STABLE_NAME",	        /* 58 */
-  "TSO",		        /* 59 */
-  "BLOCKED_FETCH",	        /* 60 */
-  "FETCH_ME",                   /* 61 */
-  "FETCH_ME_BQ",                /* 62 */
-  "RBH",                        /* 63 */
-  "EVACUATED",                  /* 64 */
-  "REMOTE_REF",                 /* 65 */
-  "N_CLOSURE_TYPES"         	/* 66 */
-};
-
-char *
-info_type(StgClosure *closure){ 
-  return closure_type_names[get_itbl(closure)->type];
-}
-
-char *
-info_type_by_ip(StgInfoTable *ip){ 
-  return closure_type_names[ip->type];
-}
-
-void
-info_hdr_type(StgClosure *closure, char *res){ 
-  strcpy(res,closure_type_names[get_itbl(closure)->type]);
-}
-#endif
-
-//@node Writing to the log-file, Global statistics, Variables and constants
-//@subsection Writing to the log-file
-/*
-  Writing to the log-file
-
-  These routines dump event-based info to the main log-file.
-  The code for writing log files is shared between GranSim and GUM.
-*/
-
-/* 
- * If you're not using GNUC and you're on a 32-bit machine, you're 
- * probably out of luck here.  However, since CONCURRENT currently
- * requires GNUC, I'm not too worried about it.  --JSM
- */
-
-//@cindex init_gr_simulation
-#if defined(GRAN)
-void
-init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv)
-char *prog_argv[], *rts_argv[];
-int prog_argc, rts_argc;
-{
-  nat i;
-  char *extension = RtsFlags.GranFlags.GranSimStats.Binary ? "gb" : "gr";
-
-  if (RtsFlags.GranFlags.GranSimStats.Global)
-    init_gr_stats();
-
-  /* init global constants for costs of basic operations */
-  gran_arith_cost = RtsFlags.GranFlags.Costs.arith_cost;
-  gran_branch_cost = RtsFlags.GranFlags.Costs.branch_cost;
-  gran_load_cost = RtsFlags.GranFlags.Costs.load_cost;
-  gran_store_cost = RtsFlags.GranFlags.Costs.store_cost;
-  gran_float_cost = RtsFlags.GranFlags.Costs.float_cost;
-
-  if (RtsFlags.GranFlags.GranSimStats.Suppressed)
-    return;
-
-  if (!RtsFlags.GranFlags.GranSimStats.Full) 
-    return;
-
-  sprintf(gr_filename, GR_FILENAME_FMT, prog_argv[0], extension);
-
-  if ((gr_file = fopen(gr_filename, "w")) == NULL) {
-    barf("Can't open granularity simulation report file %s\n", 
-	 gr_filename);
-  }
-
-  setbuf(gr_file, NULL);                   /* turn  buffering off */
-
-  /* write header with program name, options and setup to gr_file */
-  fputs("Granularity Simulation for ", gr_file);
-  for (i = 0; i < prog_argc; ++i) {
-    fputs(prog_argv[i], gr_file);
-    fputc(' ', gr_file);
-  }
-
-  if (rts_argc > 0) {
-    fputs("+RTS ", gr_file);
-    
-    for (i = 0; i < rts_argc; ++i) {
-      fputs(rts_argv[i], gr_file);
-      fputc(' ', gr_file);
-    }
-  }
-
-  fputs("\nStart time: ", gr_file);
-  fputs(time_str(), gr_file);               /* defined in RtsUtils.c */
-  fputc('\n', gr_file);
-    
-  fputs("\n\n--------------------\n\n", gr_file);
-
-  fputs("General Parameters:\n\n", gr_file);
-
-  if (RtsFlags.GranFlags.Light) 
-    fprintf(gr_file, "GrAnSim-Light\nPEs infinite, %s Scheduler, %sMigrate Threads %s, %s\n",
-	    RtsFlags.GranFlags.DoFairSchedule?"Fair":"Unfair",
-	    RtsFlags.GranFlags.DoThreadMigration?"":"Don't ",
-	    RtsFlags.GranFlags.DoThreadMigration && RtsFlags.GranFlags.DoStealThreadsFirst?" Before Sparks":"",
-	    RtsFlags.GranFlags.DoAsyncFetch ? "Asynchronous Fetch" :
-	    "Block on Fetch");
-  else 
-    fprintf(gr_file, "PEs %u, %s Scheduler, %sMigrate Threads %s, %s\n",
-	    RtsFlags.GranFlags.proc,RtsFlags.GranFlags.DoFairSchedule?"Fair":"Unfair",
-	    RtsFlags.GranFlags.DoThreadMigration?"":"Don't ",
-	    RtsFlags.GranFlags.DoThreadMigration && RtsFlags.GranFlags.DoStealThreadsFirst?" Before Sparks":"",
-	    RtsFlags.GranFlags.DoAsyncFetch ? "Asynchronous Fetch" :
-	    "Block on Fetch");
-  
-  if (RtsFlags.GranFlags.DoBulkFetching) 
-    if (RtsFlags.GranFlags.ThunksToPack)
-      fprintf(gr_file, "Bulk Fetching: Fetch %d Thunks in Each Packet (Packet Size = %d closures)\n",
-	      RtsFlags.GranFlags.ThunksToPack, 
-	      RtsFlags.GranFlags.packBufferSize);
-    else
-      fprintf(gr_file, "Bulk Fetching: Fetch as many closures as possible (Packet Size = %d closures)\n",
-	      RtsFlags.GranFlags.packBufferSize);
-  else
-    fprintf(gr_file, "Incremental Fetching: Fetch Exactly One Closure in Each Packet\n");
-  
-  fprintf(gr_file, "Fetch Strategy(%u):If outstanding fetches %s\n",
-	  RtsFlags.GranFlags.FetchStrategy,
-	  RtsFlags.GranFlags.FetchStrategy==0 ?
-	    " block (block-on-fetch)":
-	  RtsFlags.GranFlags.FetchStrategy==1 ?
-	    "only run runnable threads":
-	  RtsFlags.GranFlags.FetchStrategy==2 ? 
-	    "create threads only from local sparks":
-	  RtsFlags.GranFlags.FetchStrategy==3 ? 
-	    "create threads from local or global sparks":
-	  RtsFlags.GranFlags.FetchStrategy==4 ?
-	    "create sparks and steal threads if necessary":
-	  "unknown");
-
-  if (RtsFlags.GranFlags.DoPrioritySparking)
-    fprintf(gr_file, "Priority Sparking (i.e. keep sparks ordered by priority)\n");
-
-  if (RtsFlags.GranFlags.DoPriorityScheduling)
-    fprintf(gr_file, "Priority Scheduling (i.e. keep threads ordered by priority)\n");
-
-  fprintf(gr_file, "Thread Creation Time %u, Thread Queue Time %u\n",
-	  RtsFlags.GranFlags.Costs.threadcreatetime, 
-	  RtsFlags.GranFlags.Costs.threadqueuetime);
-  fprintf(gr_file, "Thread DeSchedule Time %u, Thread Schedule Time %u\n",
-	  RtsFlags.GranFlags.Costs.threaddescheduletime, 
-	  RtsFlags.GranFlags.Costs.threadscheduletime);
-  fprintf(gr_file, "Thread Context-Switch Time %u\n",
-	  RtsFlags.GranFlags.Costs.threadcontextswitchtime);
-  fputs("\n\n--------------------\n\n", gr_file);
-
-  fputs("Communication Metrics:\n\n", gr_file);
-  fprintf(gr_file,
-	  "Latency %u (1st) %u (rest), Fetch %u, Notify %u (Global) %u (Local)\n",
-	  RtsFlags.GranFlags.Costs.latency, 
-	  RtsFlags.GranFlags.Costs.additional_latency, 
-	  RtsFlags.GranFlags.Costs.fetchtime,
-	  RtsFlags.GranFlags.Costs.gunblocktime, 
-	  RtsFlags.GranFlags.Costs.lunblocktime);
-  fprintf(gr_file,
-	  "Message Creation %u (+ %u after send), Message Read %u\n",
-	  RtsFlags.GranFlags.Costs.mpacktime, 
-	  RtsFlags.GranFlags.Costs.mtidytime, 
-	  RtsFlags.GranFlags.Costs.munpacktime);
-  fputs("\n\n--------------------\n\n", gr_file);
-
-  fputs("Instruction Metrics:\n\n", gr_file);
-  fprintf(gr_file, "Arith %u, Branch %u, Load %u, Store %u, Float %u, Alloc %u\n",
-	  RtsFlags.GranFlags.Costs.arith_cost, 
-	  RtsFlags.GranFlags.Costs.branch_cost,
-	  RtsFlags.GranFlags.Costs.load_cost, 
-	  RtsFlags.GranFlags.Costs.store_cost, 
-	  RtsFlags.GranFlags.Costs.float_cost, 
-	  RtsFlags.GranFlags.Costs.heapalloc_cost);
-  fputs("\n\n++++++++++++++++++++\n\n", gr_file);
-
-# if 0
-  /* binary log files are currently not supported */
-  if (RtsFlags.GranFlags.GranSimStats.Binary)
-    grputw(sizeof(rtsTime));
-# endif
-
-  return (0);
-}
-
-#elif defined(PAR)
-
-void init_gr_stats (void);
-
-void
-init_gr_simulation(rts_argc, rts_argv, prog_argc, prog_argv)
-char *prog_argv[], *rts_argv[];
-int prog_argc, rts_argc;
-{
-  nat i;
-  char time_string[TIME_STR_LEN], node_str[NODE_STR_LEN];
-  char *extension = RtsFlags.ParFlags.ParStats.Binary ? "gb" : "gr";
-
-  sprintf(gr_filename, GR_FILENAME_FMT_GUM, prog_argv[0], thisPE, extension);
-
-  if (!RtsFlags.ParFlags.ParStats.Full) 
-    return;
-
-  if (RtsFlags.ParFlags.ParStats.Global)
-    init_gr_stats();
-
-  if ((gr_file = fopen(gr_filename, "w")) == NULL)
-    barf("Can't open activity report file %s\n", gr_filename);
-
-  setbuf(gr_file, NULL);                   /* turn  buffering off */
-
-  /* write header with program name, options and setup to gr_file */
-  for (i = 0; i < prog_argc; ++i) {
-    fputs(prog_argv[i], gr_file);
-    fputc(' ', gr_file);
-  }
-
-  if (rts_argc > 0) {
-    fputs("+RTS ", gr_file);
-    
-    for (i = 0; i < rts_argc; ++i) {
-      fputs(rts_argv[i], gr_file);
-      fputc(' ', gr_file);
-    }
-  }
-  fputc('\n', gr_file);
-
-  /* record the absolute start time to allow synchronisation of log-files */
-  fputs("Start-Time: ", gr_file);
-  fputs(time_str(), gr_file);
-  fputc('\n', gr_file);
-
-  ASSERT(startTime==0);
-  // startTime = msTime();
-  startTime = CURRENT_TIME;
-  ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/);
-  fprintf(gr_file, "PE %2u [%s]: TIME\n", thisPE, time_string);
-
-# if 0
-    ngoq Dogh'q' vImuS
-  IF_PAR_DEBUG(verbose,
-	       belch("== Start-time: %ld (%s)",
-		     startTime, time_string));
-
-    if (startTime > LL(1000000000)) {
-      fprintf(gr_file, "PE %2u [%lu%lu]: TIME\n", thisPE, 
-	    (rtsTime) (startTime / LL(1000000000)),
-	    (rtsTime) (startTime % LL(1000000000)));
-    } else {
-      fprintf(gr_file, "PE %2u [%lu]: TIME\n", thisPE, (TIME) startTime);
-    } 
-    /* binary log files are currently not supported */
-    if (RtsFlags.GranFlags.GranSimStats.Binary)
-	grputw(sizeof(rtsTime));
-# endif
-
-    return;
-}
-
-void 
-init_gr_stats (void) {
-  // memset(&globalParStats, '\0', sizeof(GlobalParStats));
-
-  globalParStats.tot_mark_GA = globalParStats.tot_rebuild_GA = globalParStats.tot_free_GA = globalParStats.res_mark_GA = globalParStats.res_rebuild_GA = globalParStats.res_free_GA = globalParStats.tot_size_GA = globalParStats.res_size_GA = globalParStats.tot_global = globalParStats.tot_local = 0;
-  globalParStats.cnt_mark_GA = globalParStats.cnt_rebuild_GA = globalParStats.cnt_free_GA = globalParStats.res_free_GA = globalParStats.local_alloc_GA = 0;
-
-  globalParStats.time_mark_GA = 0.0;
-  globalParStats.time_rebuild_GA = 0.0;
-  globalParStats.time_sparks = 0.0;
-  globalParStats.time_pack = 0.0;
-
-  globalParStats.res_sp = globalParStats.res_tp = globalParStats.tot_sp = globalParStats.tot_tp = globalParStats.cnt_sp = globalParStats.cnt_tp = globalParStats.emp_sp = globalParStats.emp_tp = 0;
-  globalParStats.tot_packets = globalParStats.tot_packet_size = globalParStats.tot_thunks = globalParStats.res_packet_size = globalParStats.res_thunks = globalParStats.rec_res_packet_size = globalParStats.rec_res_thunks = 0;
-
-  globalParStats.tot_fish_mess = globalParStats.tot_fetch_mess = globalParStats.tot_resume_mess = globalParStats.tot_schedule_mess = 0;
-  globalParStats.rec_fish_mess = globalParStats.rec_resume_mess = globalParStats.rec_schedule_mess = 0;
-  globalParStats.rec_fetch_mess = 0;
-#if defined(DIST)
-  globalParStats.tot_reval_mess = 0;
-  globalParStats.rec_reval_mess = 0;
-#endif
-
-  globalParStats.tot_threads_created = globalParStats.tot_sparks_created = globalParStats.tot_sparks_ignored = globalParStats.tot_sparks_marked = globalParStats.res_sparks_created = globalParStats.res_sparks_ignored = globalParStats.res_sparks_marked = 0;
-   globalParStats.tot_yields = globalParStats.tot_stackover = globalParStats.tot_heapover = 0;
-
-   globalParStats.tot_arrs = globalParStats.tot_arr_size = 0; 
-}
-
-#endif /* PAR */
-
-//@cindex end_gr_simulation
-#if defined(GRAN)
-void
-end_gr_simulation(void)
-{
-   char time_string[TIME_STR_LEN];
-
-   ullong_format_string(CURRENT_TIME, time_string, rtsFalse/*no commas!*/);
-
-   if (RtsFlags.GranFlags.GranSimStats.Suppressed)
-     return;
-
-   /* Print event stats */
-   if (RtsFlags.GranFlags.GranSimStats.Global) {
-     nat i;
-   
-     fprintf(stderr,"Total yields: %d\n",
-             globalGranStats.tot_yields);
-
-     fprintf(stderr,"Total number of threads created: %d ; per PE:\n",
-             globalGranStats.tot_threads_created);
-     for (i=0; i<RtsFlags.GranFlags.proc; i++) {
-       fprintf(stderr,"  PE %d: %d\t", 
-	       i, globalGranStats.threads_created_on_PE[i]);
-       if (i+1 % 4 == 0) fprintf(stderr,"\n");
-     }
-     if (RtsFlags.GranFlags.proc+1 % 4 != 0) fprintf(stderr,"\n");
-     fprintf(stderr,"Total number of threads migrated: %d\n",
-             globalGranStats.tot_TSOs_migrated);
-
-     fprintf(stderr,"Total number of sparks created: %d ; per PE:\n",
-             globalGranStats.tot_sparks_created);
-     for (i=0; i<RtsFlags.GranFlags.proc; i++) {
-       fprintf(stderr,"  PE %d: %d\t", 
-	       i, globalGranStats.sparks_created_on_PE[i]);
-       if (i+1 % 4 == 0) fprintf(stderr,"\n");
-     }
-     if (RtsFlags.GranFlags.proc+1 % 4 != 0) fprintf(stderr,"\n");
-
-     fprintf(stderr,"Event statistics (number of events: %d):\n",
-             globalGranStats.noOfEvents);
-     for (i=0; i<=MAX_EVENT; i++) {
-       fprintf(stderr,"  %s (%d): \t%d \t%f%%\t%f%%\n",
-               event_names[i],i,globalGranStats.event_counts[i],
-               (float)(100*globalGranStats.event_counts[i])/(float)(globalGranStats.noOfEvents),
-               (i==ContinueThread ? 0.0 :
-   		   (float)(100*(globalGranStats.event_counts[i])/(float)(globalGranStats.noOfEvents-globalGranStats.event_counts[ContinueThread])) ));
-     }
-     fprintf(stderr,"Randomized steals: %ld sparks, %ld threads \n \t(Sparks: #%u (avg ntimes=%f; avg fl=%f)\n\t(Threads: %ld)", 
-   	             globalGranStats.rs_sp_count, 
-	             globalGranStats.rs_t_count, 
-	             globalGranStats.no_of_steals, 
-   	             (float)globalGranStats.ntimes_total/(float)stg_max(globalGranStats.no_of_steals,1),
-   	             (float)globalGranStats.fl_total/(float)stg_max(globalGranStats.no_of_steals,1),
-	             globalGranStats.no_of_migrates);
-     fprintf(stderr,"Moved sparks: %d  Withered sparks: %d (%.2f %%)\n",
-   	      globalGranStats.tot_sparks, globalGranStats.withered_sparks,
-             ( globalGranStats.tot_sparks == 0 ? 0 :
-                  (float)(100*globalGranStats.withered_sparks)/(float)(globalGranStats.tot_sparks)) );
-     /* Print statistics about priority sparking */
-     if (RtsFlags.GranFlags.DoPrioritySparking) {
-   	fprintf(stderr,"About Priority Sparking:\n");
-   	fprintf(stderr,"  Total no. NewThreads: %d   Avg. spark queue len: %.2f \n", globalGranStats.tot_sq_probes, (float)globalGranStats.tot_sq_len/(float)globalGranStats.tot_sq_probes);
-     }
-     /* Print statistics about priority sparking */
-     if (RtsFlags.GranFlags.DoPriorityScheduling) {
-   	fprintf(stderr,"About Priority Scheduling:\n");
-   	fprintf(stderr,"  Total no. of StartThreads: %d (non-end: %d) Avg. thread queue len: %.2f\n", 
-   		globalGranStats.tot_add_threads, globalGranStats.non_end_add_threads, 
-   		(float)globalGranStats.tot_tq_len/(float)globalGranStats.tot_add_threads);
-     }
-     /* Blocking queue statistics */
-     if (1) {
-   	fprintf(stderr,"Blocking queue statistcs:\n");
-   	fprintf(stderr,"  Total no. of FMBQs generated: %d\n",
-		globalGranStats.tot_FMBQs);
-   	fprintf(stderr,"  Total no. of bqs awakened: %d\n",
-		globalGranStats.tot_awbq);
-   	fprintf(stderr,"  Total length of all bqs: %d\tAvg length of bqs: %.2f\n",
-		globalGranStats.tot_bq_len, (float)globalGranStats.tot_bq_len/(float)globalGranStats.tot_awbq);
-   	fprintf(stderr,"  Percentage of local TSOs in BQs: %.2f\n",
-		(float)globalGranStats.tot_bq_len*100.0/(float)globalGranStats.tot_bq_len);
-   	fprintf(stderr,"  Total time spent processing BQs: %lx\n",
-		globalGranStats.tot_bq_processing_time);
-     }
-
-     /* Fetch misses and thunk stealing */
-     fprintf(stderr,"Number of fetch misses: %d\n", 
-	     globalGranStats.fetch_misses);
-
-     /* Print packet statistics if GUMM fetching is turned on */
-     if (RtsFlags.GranFlags.DoBulkFetching) {
-   	fprintf(stderr,"Packet statistcs:\n");
-   	fprintf(stderr,"  Total no. of packets: %d   Avg. packet size: %.2f \n", globalGranStats.tot_packets, (float)globalGranStats.tot_packet_size/(float)globalGranStats.tot_packets);
-   	fprintf(stderr,"  Total no. of thunks: %d   Avg. thunks/packet: %.2f \n", globalGranStats.tot_thunks, (float)globalGranStats.tot_thunks/(float)globalGranStats.tot_packets);
-   	fprintf(stderr,"  Total no. of cuts: %d   Avg. cuts/packet: %.2f\n", globalGranStats.tot_cuts, (float)globalGranStats.tot_cuts/(float)globalGranStats.tot_packets);
-        /* 
-   	if (closure_queue_overflows>0) 
-   	  fprintf(stderr,"  Number of closure queue overflows: %u\n",
-   		  closure_queue_overflows);
-	*/
-     }
-   } /* RtsFlags.GranFlags.GranSimStats.Global */
-
-#  if defined(GRAN_COUNT)
-#  error "GRAN_COUNT not supported; should be parallel ticky profiling, really"
-    fprintf(stderr,"Update count statistics:\n");
-    fprintf(stderr,"  Total number of updates: %u\n",nUPDs);
-    fprintf(stderr,"  Needed to awaken BQ: %u with avg BQ len of: %f\n",
-	    nUPDs_BQ,(float)BQ_lens/(float)nUPDs_BQ);
-    fprintf(stderr,"  Number of PAPs: %u\n",nPAPs);
-#  endif
-
-    fprintf(stderr, "Simulation finished after @ %s @ cycles. %d sparks created, %d sparks ignored. Check %s for details.\n",
-	    time_string, sparksCreated, sparksIgnored, gr_filename);
-
-    if (RtsFlags.GranFlags.GranSimStats.Full) 
-      fclose(gr_file);
-}
-
-#elif defined(PAR)
-
-/*
-  Under GUM we print only one line. 
-*/
-void
-end_gr_simulation(void)
-{
-  char time_string[TIME_STR_LEN];
-
-  ullong_format_string(CURRENT_TIME-startTime, time_string, rtsFalse/*no commas!*/);
-
-  fprintf(stderr, "Computation finished after @ %s @ ms. %d sparks created, %d sparks ignored. Check %s for details.\n",
-	    time_string, sparksCreated, sparksIgnored, gr_filename);
-
-  if (RtsFlags.ParFlags.ParStats.Full) 
-    fclose(gr_file);
-}
-#endif /* PAR */
-
-//@node Global statistics, Dumping routines, Writing to the log-file
-//@subsection Global statistics
-/* 
-   Called at the end of execution
-*/
-
-//@node Dumping routines,  , Global statistics
-//@subsection Dumping routines
-
-//@cindex DumpGranEvent
-void
-DumpGranEvent(name, tso)
-GranEventType name;
-StgTSO *tso;
-{
-    DumpRawGranEvent(CURRENT_PROC, (PEs)0, name, tso, &stg_END_TSO_QUEUE_closure, (StgInt)0, (StgInt)0);
-}
-
-//@cindex DumpRawGranEvent
-void
-DumpRawGranEvent(proc, p, name, tso, node, sparkname, len)
-PEs proc, p;         /* proc ... where it happens; p ... where node lives */
-GranEventType name;
-StgTSO *tso;
-StgClosure *node;
-StgInt sparkname, len;
-{
-# if defined(GRAN)
-  DumpVeryRawGranEvent(TIME_ON_PROC(proc), 
-		       proc, p, name, tso, node, sparkname, len);
-# elif defined(PAR)
-  DumpVeryRawGranEvent(CURRENT_TIME,
-		       proc, p, name, tso, node, sparkname, len);
-# endif
-}
-
-//@cindex DumpVeryRawGranEvent
-void
-DumpVeryRawGranEvent(time, proc, p, name, tso, node, sparkname, len)
-rtsTime time;
-PEs proc, p;         /* proc ... where it happens; p ... where node lives */
-GranEventType name;
-StgTSO *tso;
-StgClosure *node;
-StgInt sparkname, len;
-{
-  FILE *output_file; // DEBUGGING ONLY !!!!!!!!!!!!!!!!!!!!!!!!!1
-  StgWord id;
-  char time_string[TIME_STR_LEN], node_str[NODE_STR_LEN];
-# if defined(GRAN)
-  ullong_format_string(time,
-		       time_string, rtsFalse/*no commas!*/);
-# elif defined(PAR)
-  ullong_format_string(time,
-		       time_string, rtsFalse/*no commas!*/);
-# endif
-  output_file = gr_file;
-
-# if defined(GRAN)
-
-  if (RtsFlags.GranFlags.GranSimStats.Full) 
-    ASSERT(output_file!=NULL);
-
-  if (RtsFlags.GranFlags.GranSimStats.Suppressed)
-    return;
-# elif defined(PAR)
-
-  if (RtsFlags.ParFlags.ParStats.Full) 
-    ASSERT(output_file!=NULL);
-
-  if (RtsFlags.ParFlags.ParStats.Suppressed)
-    return;
-
-# endif
-
-  id = tso == NULL ? -1 : tso->id;
-  if (node==stgCast(StgClosure*,&stg_END_TSO_QUEUE_closure))
-      strcpy(node_str,"________");  /* "END_TSO_QUEUE"); */
-  else
-      sprintf(node_str,"0x%-6lx",node);
-
-  if (name > GR_EVENT_MAX)
-	name = GR_EVENT_MAX;
-
-  if (BINARY_STATS)
-    barf("binary log files not yet supported");
-#if 0
-    /* ToDo: fix code for writing binary GrAnSim statistics */
-    switch (name) { 
-      case GR_START:
-      case GR_STARTQ:
-                      grputw(name);
-		      grputw(proc);
-		      abort();        /* die please: a single word */
-				      /* doesn't represent long long times */
-		      grputw(TIME_ON_PROC(proc));
-		      grputw((StgWord)node);
-		      break;
-      case GR_FETCH:
-      case GR_REPLY:
-      case GR_BLOCK:
-		      grputw(name);
-		      grputw(proc);
-		      abort();        /* die please: a single word */
-				      /* doesn't represent long long times */
-		      grputw(TIME_ON_PROC(proc));  /* this line is bound to */
-		      grputw(id);                  /*   do the wrong thing */
-		      break;
-      default: 
-                      grputw(name);
-		      grputw(proc);
-		      abort();        /* die please: a single word */
-				      /* doesn't represent long long times */
-		      grputw(TIME_ON_PROC(proc));
-		      grputw((StgWord)node);
-    }
-#endif
-  else /* !BINARY_STATS */
-    switch (name) { 
-     case GR_START:
-     case GR_STARTQ:
-        fprintf(output_file,"PE %2u [%s]: %-9s\t%lx\t%s\t[SN %u]\t[sparks %u]\n", 
-	        proc,time_string,gran_event_names[name],
-	        id,node_str,sparkname,len);
-        break;
-     case GR_FETCH:
-     case GR_REPLY:
-     case GR_BLOCK:
-     case GR_STOLEN:
-     case GR_STOLENQ:
-     case GR_STEALING:
-	fprintf(output_file, "PE %2u [%s]: %-9s\t%lx \t%s\t(from %2u)\n",
-	        proc, time_string, gran_event_names[name], 
-		id,node_str,p);
-	break;
-     case GR_RESUME:
-     case GR_RESUMEQ:
-     case GR_SCHEDULE:
-     case GR_DESCHEDULE:
-        fprintf(output_file,"PE %2u [%s]: %-9s\t%lx \n",
-	        proc,time_string,gran_event_names[name],id);
-        break;
-     case GR_ALLOC:
-        fprintf(output_file,"PE %2u [%s]: %-9s\t%lx\t        \tallocating %u words\n",
-	        proc,time_string,gran_event_names[name],id,len);
-        break;
-     default:
-        fprintf(output_file,"PE %2u [%s]: %-9s\t%lx\t%s\t[sparks %u]\n",
-	        proc,time_string,gran_event_names[name],id,node_str,len);
-    }
-}
-
-//@cindex DumpGranInfo
-void
-DumpEndEvent(proc, tso, mandatory_thread)
-PEs proc;
-StgTSO *tso;
-rtsBool mandatory_thread;
-{
-  FILE *output_file; // DEBUGGING ONLY !!!!!!!!!!!!!!!!!!!!!!!!!1
-  char time_string[TIME_STR_LEN];
-# if defined(GRAN)
-  ullong_format_string(TIME_ON_PROC(proc), 
-		       time_string, rtsFalse/*no commas!*/);
-# elif defined(PAR)
-  ullong_format_string(CURRENT_TIME,
-		       time_string, rtsFalse/*no commas!*/);
-# endif
-
-  output_file = gr_file;
-  ASSERT(output_file!=NULL);
-#if defined(GRAN)
-    if (RtsFlags.GranFlags.GranSimStats.Suppressed)
-      return;
-#endif
-
-    if (BINARY_STATS) {
-    barf("binary log files not yet supported");
-#if 0
-	grputw(GR_END);
-	grputw(proc);
-	abort(); /* die please: a single word doesn't represent long long times */
-	grputw(CURRENT_TIME); /* this line is bound to fail */
-	grputw(tso->id);
-#ifdef PAR
-	grputw(0);
-	grputw(0);
-	grputw(0);
-	grputw(0);
-	grputw(0);
-	grputw(0);
-	grputw(0);
-	grputw(0);
-	grputw(0);
-	grputw(0);
-	grputw(0);
-	grputw(0);
-#else
-	grputw(tso->gran.sparkname);
-	grputw(tso->gran.startedat);
-	grputw(tso->gran.exported);
-	grputw(tso->gran.basicblocks);
-	grputw(tso->gran.allocs);
-	grputw(tso->gran.exectime);
-	grputw(tso->gran.blocktime);
-	grputw(tso->gran.blockcount);
-	grputw(tso->gran.fetchtime);
-	grputw(tso->gran.fetchcount);
-	grputw(tso->gran.localsparks);
-	grputw(tso->gran.globalsparks);
-#endif
-	grputw(mandatory_thread);
-#endif /* 0 */
-    } else {
-
-	/*
-	 * NB: DumpGranEvent cannot be used because PE may be wrong 
-	 * (as well as the extra info)
-	 */
-	fprintf(output_file, "PE %2u [%s]: END %lx, SN %u, ST %lu, EXP %s, BB %u, HA %u, RT %u, BT %u (%u), FT %u (%u), LS %u, GS %u, MY %s\n"
-	  ,proc
-	  ,time_string
-	  ,tso->id
-#if defined(GRAN)		
-	  ,tso->gran.sparkname
-	  ,tso->gran.startedat
-	  ,((tso->gran.exported) ? 'T' : 'F')
-	  ,tso->gran.basicblocks
-	  ,tso->gran.allocs
-	  ,tso->gran.exectime
-	  ,tso->gran.blocktime
-	  ,tso->gran.blockcount
-	  ,tso->gran.fetchtime
-	  ,tso->gran.fetchcount
-	  ,tso->gran.localsparks
-	  ,tso->gran.globalsparks
-#elif defined(PAR)
-	  ,tso->par.sparkname
-	  ,tso->par.startedat
-	  ,(tso->par.exported) ? "T" : "F"
-	  ,tso->par.basicblocks
-	  ,tso->par.allocs
-	  ,tso->par.exectime
-	  ,tso->par.blocktime
-	  ,tso->par.blockcount
-	  ,tso->par.fetchtime
-	  ,tso->par.fetchcount
-	  ,tso->par.localsparks
-	  ,tso->par.globalsparks
-#endif
-	  ,(mandatory_thread ? "T" : "F")
-	  );
-    }
-}
-
-//@cindex DumpTSO
-void
-DumpTSO(tso)
-StgTSO *tso;
-{
-  FILE *output_file; // DEBUGGING ONLY !!!!!!!!!!!!!!!!!!!!!!!!!1
-
-  output_file = gr_file;
-  ASSERT(output_file!=NULL);
-  fprintf(stderr,"TSO 0x%lx, NAME 0x%lx, ID %u, LINK 0x%lx, TYPE %s\n"
-          ,tso
-#if defined(GRAN)
-          ,tso->gran.sparkname
-#elif defined(PAR)
-          ,tso->par.sparkname
-#endif
-          ,tso->id
-          ,tso->link
-          ,/*tso->state==T_MAIN?"MAIN":
-           TSO_TYPE(tso)==T_FAIL?"FAIL":
-           TSO_TYPE(tso)==T_REQUIRED?"REQUIRED":
-           TSO_TYPE(tso)==T_ADVISORY?"ADVISORY":
-	   */
-           "???"
-          );
-          
-  fprintf(output_file,"TSO %lx: SN %u, ST %u, GBL %c, BB %u, HA %u, RT %u, BT %u (%u), FT %u (%u) LS %u, GS %u\n"
-	  ,tso->id
-#if defined(GRAN)
-          ,tso->gran.sparkname
-          ,tso->gran.startedat
-          ,tso->gran.exported?'T':'F'
-          ,tso->gran.basicblocks
-          ,tso->gran.allocs
-          ,tso->gran.exectime
-          ,tso->gran.blocktime
-          ,tso->gran.blockcount
-          ,tso->gran.fetchtime
-          ,tso->gran.fetchcount
-          ,tso->gran.localsparks
-          ,tso->gran.globalsparks
-#elif defined(PAR)
-          ,tso->par.sparkname
-          ,tso->par.startedat
-          ,tso->par.exported?'T':'F'
-          ,tso->par.basicblocks
-          ,tso->par.allocs
-          ,tso->par.exectime
-          ,tso->par.blocktime
-          ,tso->par.blockcount
-          ,tso->par.fetchtime
-          ,tso->par.fetchcount
-          ,tso->par.localsparks
-          ,tso->par.globalsparks
-#endif
-          );
-}
-
-#if 0
-/*
-  ToDo: fix binary output of log files, and support new log file format.
-*/
-/*
-   Output a terminate event and an 8-byte time.
-*/
-
-//@cindex grterminate
-void
-grterminate(v)
-rtsTime v;
-{
-  if (!BINARY_STATS) 
-    barf("grterminate: binary statistics not enabled\n");
-
-# if defined(GRAN)
-    if (RtsFlags.GranFlags.GranSimStats.Suppressed)
-      return;
-# endif
-
-    DumpGranEvent(GR_TERMINATE, stgCast(StgTSO*,&stg_END_TSO_QUEUE_closure));
-
-    if (sizeof(rtsTime) == 4) {
-      putc('\0', gr_file);
-      putc('\0', gr_file);
-      putc('\0', gr_file);
-      putc('\0', gr_file);
-    } else {
-      putc(v >> 56l, gr_file);
-      putc((v >> 48l) & 0xffl, gr_file);
-      putc((v >> 40l) & 0xffl, gr_file);
-      putc((v >> 32l) & 0xffl, gr_file);
-    }
-    putc((v >> 24l) & 0xffl, gr_file);
-    putc((v >> 16l) & 0xffl, gr_file);
-    putc((v >> 8l) & 0xffl, gr_file);
-    putc(v & 0xffl, gr_file);
-}
-
-/*
-   Length-coded output: first 3 bits contain length coding
-
-     00x        1 byte
-     01x        2 bytes
-     10x        4 bytes
-     110        8 bytes
-     111        5 or 9 bytes
-*/
-
-//@cindex grputw
-void
-grputw(v)
-rtsTime v;
-{
-  if (!BINARY_STATS) 
-    barf("grputw: binary statistics not enabled\n");
-
-# if defined(GRAN)
-    if (RtsFlags.GranFlags.GranSimStats.Suppressed)
-      return;
-# endif
-
-    if (v <= 0x3fl) {                           /* length v = 1 byte */ 
-	fputc(v & 0x3f, gr_file);
-    } else if (v <= 0x3fffl) {                  /* length v = 2 byte */ 
-	fputc((v >> 8l) | 0x40l, gr_file);
-	fputc(v & 0xffl, gr_file);
-    } else if (v <= 0x3fffffffl) {              /* length v = 4 byte */ 
-	fputc((v >> 24l) | 0x80l, gr_file);
-	fputc((v >> 16l) & 0xffl, gr_file);
-	fputc((v >> 8l) & 0xffl, gr_file);
-	fputc(v & 0xffl, gr_file);
-    } else if (sizeof(TIME) == 4) {
-	fputc(0x70, gr_file);
-	fputc((v >> 24l) & 0xffl, gr_file);
-	fputc((v >> 16l) & 0xffl, gr_file);
-	fputc((v >> 8l) & 0xffl, gr_file);
-	fputc(v & 0xffl, gr_file);
-    } else {
-	if (v <= 0x3fffffffffffffl)
-	    putc((v >> 56l) | 0x60l, gr_file);
-	else {
-	    putc(0x70, gr_file);
-	    putc((v >> 56l) & 0xffl, gr_file);
-	}
-
-	putc((v >> 48l) & 0xffl, gr_file);
-	putc((v >> 40l) & 0xffl, gr_file);
-	putc((v >> 32l) & 0xffl, gr_file);
-	putc((v >> 24l) & 0xffl, gr_file);
-	putc((v >> 16l) & 0xffl, gr_file);
-	putc((v >> 8l) & 0xffl, gr_file);
-	putc(v & 0xffl, gr_file);
-    }
-}
-#endif /* 0 */
-
-/* 
-   extracting specific info out of a closure; used in packing (GranSim, GUM)
-*/
-//@cindex get_closure_info
-StgInfoTable*
-get_closure_info(StgClosure* node, nat *size, nat *ptrs, nat *nonptrs, 
-		 nat *vhs, char *info_hdr_ty)
-{
-  StgInfoTable *info;
-
-  ASSERT(LOOKS_LIKE_COOL_CLOSURE(node)); 
-  info = get_itbl(node);
-  /* the switch shouldn't be necessary, really; just use default case */
-  switch (info->type) {
-  case RBH:
-    {
-      StgInfoTable *rip = REVERT_INFOPTR(info); // closure to revert to
-      *size = sizeW_fromITBL(rip);
-      *ptrs = (nat) (rip->layout.payload.ptrs);
-      *nonptrs = (nat) (rip->layout.payload.nptrs);
-      *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
-#if 0 /* DEBUG */
-      info_hdr_type(node, info_hdr_ty);
-#else
-      strcpy(info_hdr_ty, "RBH");
-#endif
-      return rip;  // NB: we return the reverted info ptr for a RBH!!!!!!
-    }
-
-#if defined(PAR)
-  /* Closures specific to GUM */
-  case FETCH_ME:
-    *size = sizeofW(StgFetchMe);
-    *ptrs = (nat)0;
-    *nonptrs = (nat)0;
-    *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
-#if 0 /* DEBUG */
-    info_hdr_type(node, info_hdr_ty);
-#else
-    strcpy(info_hdr_ty, "FETCH_ME");
-#endif
-    return info;
-
-#ifdef DIST    
-  case REMOTE_REF: //same as for FETCH_ME...
-    *size = sizeofW(StgFetchMe);
-    *ptrs = (nat)0;
-    *nonptrs = (nat)0;
-    *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
-#if 0 /* DEBUG */
-    info_hdr_type(node, info_hdr_ty);
-#else
-    strcpy(info_hdr_ty, "REMOTE_REF");
-#endif
-    return info; 
-#endif /* DIST */
-    
-  case FETCH_ME_BQ:
-    *size = sizeofW(StgFetchMeBlockingQueue);
-    *ptrs = (nat)0;
-    *nonptrs = (nat)0;
-    *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
-#if 0 /* DEBUG */
-    info_hdr_type(node, info_hdr_ty);
-#else
-    strcpy(info_hdr_ty, "FETCH_ME_BQ");
-#endif
-    return info;
-
-  case BLOCKED_FETCH:
-    *size = sizeofW(StgBlockedFetch);
-    *ptrs = (nat)0;
-    *nonptrs = (nat)0;
-    *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
-#if 0 /* DEBUG */
-    info_hdr_type(node, info_hdr_ty);
-#else
-    strcpy(info_hdr_ty, "BLOCKED_FETCH");
-#endif
-    return info;
-#endif /* PAR */
-    
-  /* these magic constants are outrageous!! why does the ITBL lie about it? */
-  case THUNK_SELECTOR:
-    *size = THUNK_SELECTOR_sizeW();
-    *ptrs = 1;
-    *nonptrs = MIN_UPD_SIZE-*ptrs;   // weird
-    *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
-    return info;
-
-  case ARR_WORDS:
-    /* ToDo: check whether this can be merged with the default case */
-    *size = arr_words_sizeW((StgArrWords *)node); 
-    *ptrs = 0;
-    *nonptrs = ((StgArrWords *)node)->words;
-    *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
-    return info;
-
-  case PAP:
-    /* ToDo: check whether this can be merged with the default case */
-    *size = pap_sizeW((StgPAP *)node); 
-    *ptrs = 0;
-    *nonptrs = 0;
-    *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
-    return info;
-
-  case AP_UPD:
-    /* ToDo: check whether this can be merged with the default case */
-    *size = AP_sizeW(((StgAP_UPD *)node)->n_args); 
-    *ptrs = 0;
-    *nonptrs = 0;
-    *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
-    return info;
-
-  default:
-    *size = sizeW_fromITBL(info);
-    *ptrs = (nat) (info->layout.payload.ptrs);
-    *nonptrs = (nat) (info->layout.payload.nptrs);
-    *vhs = *size - *ptrs - *nonptrs - sizeofW(StgHeader);
-#if 0 /* DEBUG */
-      info_hdr_type(node, info_hdr_ty);
-#else
-      strcpy(info_hdr_ty, "UNKNOWN");
-#endif
-    return info;
-  }
-} 
-
-//@cindex IS_BLACK_HOLE
-rtsBool
-IS_BLACK_HOLE(StgClosure* node)          
-{ 
-  // StgInfoTable *info;
-  ASSERT(LOOKS_LIKE_COOL_CLOSURE(node));
-  switch (get_itbl(node)->type) {
-  case BLACKHOLE:
-  case BLACKHOLE_BQ:
-  case RBH:
-  case FETCH_ME:
-  case FETCH_ME_BQ:
-    return rtsTrue;
-  default:
-    return rtsFalse;
-  }
-//return ((info->type == BLACKHOLE || info->type == RBH) ? rtsTrue : rtsFalse);
-}
-
-//@cindex IS_INDIRECTION
-StgClosure *
-IS_INDIRECTION(StgClosure* node)          
-{ 
-  StgInfoTable *info;
-  ASSERT(LOOKS_LIKE_COOL_CLOSURE(node));
-  info = get_itbl(node);
-  switch (info->type) {
-    case IND:
-    case IND_OLDGEN:
-    case IND_PERM:
-    case IND_OLDGEN_PERM:
-    case IND_STATIC:
-      /* relies on indirectee being at same place for all these closure types */
-      return (((StgInd*)node) -> indirectee);
-#if 0
-    case EVACUATED:           // counting as ind to use in GC routines, too
-      // could use the same code as above (evacuee is at same pos as indirectee)
-      return (((StgEvacuated *)node) -> evacuee);
-#endif
-    default:
-      return NULL;
-  }
-}
-
-//@cindex unwindInd
-StgClosure *
-UNWIND_IND (StgClosure *closure)
-{
-  StgClosure *next;
-
-  while ((next = IS_INDIRECTION((StgClosure *)closure)) != NULL) 
-    closure = next;
-
-  ASSERT(next==(StgClosure *)NULL);
-  ASSERT(LOOKS_LIKE_COOL_CLOSURE(closure)); 
-  return closure;
-}
-
-#endif /* GRAN || PAR   whole file */
diff --git a/ghc/rts/parallel/ParallelDebug.c b/ghc/rts/parallel/ParallelDebug.c
deleted file mode 100644
index b357af6379..0000000000
--- a/ghc/rts/parallel/ParallelDebug.c
+++ /dev/null
@@ -1,1955 +0,0 @@
-/*
-  Time-stamp: <Sun Mar 18 2001 19:32:56 Stardate: [-30]6349.07 hwloidl>
-
-  Various debugging routines for GranSim and GUM
-*/
-
-#if defined(DEBUG) && (defined(GRAN) || defined(PAR))        /* whole file */
-
-//@node Debugging routines for GranSim and GUM, , ,
-//@section Debugging routines for GranSim and GUM
-
-//@menu
-//* Includes::			
-//* Constants and Variables::	
-//* Closures::			
-//* Threads::			
-//* Events::			
-//* Sparks::			
-//* Processors::		
-//* Shortcuts::			
-//* Printing info type::	
-//* Printing Pack:et Contents::	
-//* End of File::		
-//@end menu
-//*/
-
-//@node Includes, Prototypes, Debugging routines for GranSim and GUM, Debugging routines for GranSim and GUM
-//@subsection Includes
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "GranSimRts.h"
-#include "ParallelRts.h"
-#include "StgMiscClosures.h"
-#include "Printer.h"
-# if defined(DEBUG)
-# include "Hash.h" 
-# include "Storage.h"
-# include "ParallelDebug.h"
-# endif
-
-//@node Prototypes, Constants and Variables, Includes, Debugging routines for GranSim and GUM
-//@subsection Prototypes
-/*
-rtsBool  isOffset(globalAddr *ga);
-rtsBool  isFixed(globalAddr *ga);
-*/
-//@node Constants and Variables, Closures, Prototypes, Debugging routines for GranSim and GUM
-//@subsection Constants and Variables
-
-static HashTable *tmpClosureTable;  // used in GraphFingerPrint and PrintGraph
-
-#if defined(PAR)
-static char finger_print_char[] = {
- '/',  /* INVALID_OBJECT          0 */
- 'C', /* CONSTR                  1 */
- 'C', /*	CONSTR_1_0		2 */
- 'C', /*	CONSTR_0_1		3 */
- 'C', /*	CONSTR_2_0		4 */
- 'C', /*	CONSTR_1_1		5 */
- 'C', /*	CONSTR_0_2		6 */
- 'I', /* CONSTR_INTLIKE	        7  */
- 'I', /* CONSTR_CHARLIKE	        8  */
- 'S', /* CONSTR_STATIC	        9  */
- 'S', /* CONSTR_NOCAF_STATIC     10 */
- 'F', /* FUN		        11 */
- 'F', /*	FUN_1_0		  	12 */
- 'F', /*	FUN_0_1		  	13 */
- 'F', /*	FUN_2_0		  	14 */
- 'F', /*	FUN_1_1		  	15 */
- 'F', /*	FUN_0_2			16 */
- 'S', /* FUN_STATIC	        17 */
- 'T', /* THUNK		        18 */
- 'T', /*	THUNK_1_0	19 */
- 'T', /*	THUNK_0_1	20 */
- 'T', /*	THUNK_2_0	21 */
- 'T', /*	THUNK_1_1	22 */
- 'T', /*	THUNK_0_2	23 */
- 'S', /* THUNK_STATIC	        24 */
- 'E', /* THUNK_SELECTOR	        25 */
- 'b', /* BCO		        26 */
- 'p', /* AP_UPD		        27 */
- 'p', /* PAP			28 */
- '_', /* IND		        29 */
- '_', /* IND_OLDGEN	        30 */
- '_', /* IND_PERM	        31 */
- '_', /* IND_OLDGEN_PERM	32 */
- '_', /* IND_STATIC	        33 */
- '?', /* ***unused***	        34 */
- '?', /* ***unused***	        35 */
- '^', /* RET_BCO                36 */
- '^', /* RET_SMALL	        37 */
- '^', /* RET_VEC_SMALL	        38 */
- '^', /* RET_BIG		39 */
- '^', /* RET_VEC_BIG	        40 */
- '^', /* RET_DYN		41 */
- '~', /* UPDATE_FRAME	        42 */
- '~', /* CATCH_FRAME	        43 */
- '~', /* STOP_FRAME	        44 */
- '~', /* SEQ_FRAME	        45 */
- 'o', /* CAF_BLACKHOLE	        46 */
- 'o', /* BLACKHOLE	        47 */
- 'o', /* BLACKHOLE_BQ	        48 */
- 'o', /* SE_BLACKHOLE		49 */
- 'o', /* SE_CAF_BLACKHOLE	50 */
- 'm', /* MVAR		        51 */
- 'a', /* ARR_WORDS	        52 */
- 'a', /* MUT_ARR_PTRS	        53 */
- 'a', /* MUT_ARR_PTRS_FROZEN    54 */
- 'q', /* MUT_VAR		55 */
- 'w', /* WEAK		        56 */
- 'f', /* FOREIGN		57 */
- 's', /* STABLE_NAME	        58 */
- '@', /* TSO		        59 */
- '#', /* BLOCKED_FETCH	        60 */
- '>', /* FETCH_ME               61 */
- '>', /* FETCH_ME_BQ            62 */
- '$', /* RBH                    63 */
- 'v', /* EVACUATED              64 */
- '>' /* REMOTE_REF              65 */  
-     /* ASSERT(there are N_CLOSURE_TYPES (==66) in this arrary) */
-};
-#endif /* PAR */
-
-#if defined(GRAN) && defined(GRAN_CHECK)
-//@node Closures, Threads, Constants and Variables, Debugging routines for GranSim and GUM
-//@subsection Closures
-
-void
-G_PRINT_NODE(node)
-StgClosure* node;
-{
-   StgInfoTable *info_ptr;
-   StgTSO* bqe;
-   nat size = 0, ptrs = 0, nonptrs = 0, i, vhs = 0;
-   char info_hdr_ty[80], info_ty[80];
-
-   if (node==NULL) {
-     fprintf(stderr,"NULL\n");
-     return;
-   } else if (node==END_TSO_QUEUE) {
-     fprintf(stderr,"END_TSO_QUEUE\n");
-     return;
-   }
-   /* size_and_ptrs(node,&size,&ptrs); */
-   info_ptr = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_hdr_ty);
-
-   /* vhs = var_hdr_size(node); */
-   display_info_type(info_ptr,info_ty);
-
-   fprintf(stderr,"Node: 0x%lx", node);
-
-#if defined(PAR)
-   fprintf(stderr," [GA: 0x%lx]",GA(node));
-#endif
-
-#if defined(USE_COST_CENTRES)
-   fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
-#endif
-
-#if defined(GRAN)
-   fprintf(stderr," [Bitmask: 0%lo]",PROCS(node));
-#endif
-
-   if (info_ptr->type==TSO) 
-     fprintf(stderr," TSO: 0x%lx (%x) IP: 0x%lx (%s), type %s \n     ",
-	     (StgTSO*)node, ((StgTSO*)node)->id, info_ptr, info_hdr_ty, info_ty);
-   else
-     fprintf(stderr," IP: 0x%lx (%s), type %s \n       VHS: %d, size: %ld, ptrs:%ld, nonptrs:  %ld\n     ",
-	     info_ptr,info_hdr_ty,info_ty,vhs,size,ptrs,nonptrs);
-
-   /* For now, we ignore the variable header */
-
-   fprintf(stderr," Ptrs: ");
-   for(i=0; i < ptrs; ++i)
-     {
-     if ( (i+1) % 6 == 0)
-       fprintf(stderr,"\n      ");
-     fprintf(stderr," 0x%lx[P]",node->payload[i]);
-     };
-
-   fprintf(stderr," Data: ");
-   for(i=0; i < nonptrs; ++i)
-     {
-       if( (i+1) % 6 == 0)
-         fprintf(stderr,"\n      ");
-       fprintf(stderr," %lu[D]",node->payload[ptrs+i]);
-     }
-   fprintf(stderr, "\n");
-
-
-   switch (info_ptr->type)
-    {
-     case TSO: 
-      fprintf(stderr,"\n TSO_LINK: %#lx", 
-	      ((StgTSO*)node)->link);
-      break;
-
-    case BLACKHOLE:
-    case RBH:
-      bqe = ((StgBlockingQueue*)node)->blocking_queue;
-      fprintf(stderr," BQ of %#lx: ", node);
-      G_PRINT_BQ(bqe);
-      break;
-    case FETCH_ME:
-    case FETCH_ME_BQ:
-      printf("Panic: found FETCH_ME or FETCH_ME_BQ Infotable in GrAnSim system.\n");
-      break;
-    default:
-      /* do nothing */
-    }
-}
-
-void
-G_PPN(node)  /* Extracted from PrintPacket in Pack.lc */
-StgClosure* node;
-{
-   StgInfoTable *info ;
-   nat size = 0, ptrs = 0, nonptrs = 0, i, vhs = 0, locn = 0;
-   char info_type[80];
-
-   /* size_and_ptrs(node,&size,&ptrs); */
-   info = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_type);
-
-   if (info->type == FETCH_ME || info->type == FETCH_ME_BQ || 
-       info->type == BLACKHOLE || info->type == RBH )
-     size = ptrs = nonptrs = vhs = 0;
-
-   if (closure_THUNK(node)) {
-     if (!closure_UNPOINTED(node))
-       fputs("SHARED ", stderr);
-     else
-       fputs("UNSHARED ", stderr);
-   } 
-   if (info->type==BLACKHOLE) {
-     fputs("BLACK HOLE\n", stderr);
-   } else {
-     /* Fixed header */
-     fprintf(stderr, "(%s) FH [%#lx", info_type, node[locn++]);
-     for (i = 1; i < _HS; i++)
-       fprintf(stderr, " %#lx", node[locn++]);
-     
-     /* Variable header */
-     if (vhs > 0) {
-       fprintf(stderr, "] VH [%#lx", node->payload[0]);
-       
-       for (i = 1; i < vhs; i++)
-	 fprintf(stderr, " %#lx", node->payload[i]);
-     }
-     
-     fprintf(stderr, "] PTRS %u", ptrs);
-     
-     /* Non-pointers */
-     if (nonptrs > 0) {
-       fprintf(stderr, " NPTRS [%#lx", node->payload[ptrs]);
-       
-       for (i = 1; i < nonptrs; i++)
-	 fprintf(stderr, " %#lx", node->payload[ptrs+i]);
-       
-       putc(']', stderr);
-     }
-     putc('\n', stderr);
-   }
-   
-}
-
-#if 0
-// ToDo: fix this!! -- HWL
-void
-G_INFO_TABLE(node)
-StgClosure *node;
-{
-  StgInfoTable *info_ptr;
-  nat size = 0, ptrs = 0, nonptrs = 0, vhs = 0;
-  char info_type[80], hdr_type[80];
-
-  info_hdr_type(info_ptr, hdr_type);
-
-  // get_itbl(node);
-  info_ptr = get_closure_info(node, &size, &ptrs, &nonptrs, &vhs, info_type);
-  fprintf(stderr,"%s Info Ptr @0x%lx; Entry: 0x%lx; Size: %lu; Ptrs: %lu\n\n",
-                 info_type,info_ptr,(W_) ENTRY_CODE(info_ptr),
-	         size, ptrs);
-	         // INFO_SIZE(info_ptr),INFO_NoPTRS(info_ptr));
-
-  if (closure_THUNK(node) && !closure_UNPOINTED(node) ) {
-    fprintf(stderr,"  RBH InfoPtr: %#lx\n",
-	    RBH_INFOPTR(info_ptr));
-  }
-
-#if defined(PAR)
-  fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
-#endif
-
-#if defined(USE_COST_CENTRES)
-  fprintf(stderr,"Cost Centre (?):       0x%lx\n",INFO_CAT(info_ptr));
-#endif
-
-#if defined(_INFO_COPYING)
-  fprintf(stderr,"Evacuate Entry:    0x%lx;\tScavenge Entry: 0x%lx\n",
-          INFO_EVAC_2S(info_ptr),INFO_SCAV_2S(info_ptr));
-#endif
-
-#if defined(_INFO_COMPACTING)
-  fprintf(stderr,"Scan Link:         0x%lx;\tScan Move:      0x%lx\n",
-          (W_) INFO_SCAN_LINK_1S(info_ptr), (W_) INFO_SCAN_MOVE_1S(info_ptr));
-  fprintf(stderr,"Mark:              0x%lx;\tMarked:         0x%lx;\t",
-          (W_) INFO_MARK_1S(info_ptr), (W_) INFO_MARKED_1S(info_ptr));
-#if 0 /* avoid INFO_TYPE */
-  if(BASE_INFO_TYPE(info_ptr)==INFO_SPEC_TYPE)
-    fprintf(stderr,"plus specialised code\n");
-  else
-    fprintf(stderr,"Marking:           0x%lx\n",(W_) INFO_MARKING_1S(info_ptr));
-#endif /* 0 */
-#endif /* _INFO_COMPACTING */
-}
-#endif /* 0 */
-
-//@cindex G_PRINT_BQ
-void
-G_PRINT_BQ(node)
-StgClosure* node;
-{
-    StgInfoTable *info;
-    StgTSO *tso, *last;
-    char str[80], str0[80];
-
-    fprintf(stderr,"\n[PE %d] @ %lu BQ: ",
-	            CurrentProc,CurrentTime[CurrentProc]);
-    if ( node == (StgClosure*)NULL ) {
-      fprintf(stderr," NULL.\n");
-      return;
-    }
-    if ( node == END_TSO_QUEUE ) {
-      fprintf(stderr," _|_\n");
-      return;
-    }
-    tso = ((StgBlockingQueue*)node)->blocking_queue;
-    while (node != END_TSO_QUEUE) {
-      PEs proc;                     
-      
-      /* Find where the tso lives */
-      proc = where_is(node);
-      info = get_itbl(node);
-
-      switch (info->type) {
-	  case TSO:
-	    strcpy(str0,"TSO");
-	    break;
-	  case BLOCKED_FETCH:
-	    strcpy(str0,"BLOCKED_FETCH");
-	    break;
-	  default:
-	    strcpy(str0,"???");
-	    break;
-	  }
-
-      if(proc == CurrentProc)
-	fprintf(stderr," %#lx (%x) L %s,", 
-		node, ((StgBlockingQueue*)node)->blocking_queue, str0);
-      else
-	fprintf(stderr," %#lx (%x) G (PE %d) %s,", 
-		node, ((StgBlockingQueue*)node)->blocking_queue, proc, str0);
-
-      last = tso;
-      tso = last->link;
-    }
-    if ( tso == END_TSO_QUEUE ) 
-      fprintf(stderr," _|_\n");
-}
-
-//@node Threads, Events, Closures, Debugging routines for GranSim and GUM
-//@subsection Threads
-
-void
-G_CURR_THREADQ(verbose) 
-StgInt verbose;
-{ 
-  fprintf(stderr,"Thread Queue on proc %d: ", CurrentProc);
-  G_THREADQ(run_queue_hd, verbose);
-}
-
-void 
-G_THREADQ(closure, verbose) 
-StgTSO* closure;
-StgInt verbose;
-{
- StgTSO* x;
-
- fprintf(stderr,"Thread Queue: ");
- for (x=closure; x!=END_TSO_QUEUE; x=x->link)
-   if (verbose) 
-     G_TSO(x,0);
-   else
-     fprintf(stderr," %#lx",x);
-
- if (closure==END_TSO_QUEUE)
-   fprintf(stderr,"NIL\n");
- else
-   fprintf(stderr,"\n");
-}
-
-void 
-G_TSO(closure,verbose) 
-StgTSO* closure;
-StgInt verbose;
-{
- 
- if (closure==END_TSO_QUEUE) {
-   fprintf(stderr,"TSO at %#lx is END_TSO_QUEUE!\n");
-   return;
- }
-
- if ( verbose & 0x08 ) {   /* short info */
-   fprintf(stderr,"[TSO @ %#lx, PE %d]: Id: %#lx, Link: %#lx\n",
-	   closure,where_is(closure),
-	   closure->id,closure->link);
-   return;
- }
-   
- fprintf(stderr,"TSO at %#lx has the following contents:\n",
-                 closure);
-
- fprintf(stderr,"> Id:   \t%#lx",closure->id);
- // fprintf(stderr,"\tstate: \t%#lx",closure->state);
- fprintf(stderr,"\twhat_next: \t%#lx",closure->what_next);
- fprintf(stderr,"\tlink: \t%#lx\n",closure->link);
- fprintf(stderr,"\twhy_blocked: \t%d", closure->why_blocked);
- fprintf(stderr,"\tblock_info: \t%p\n", closure->block_info);
- // fprintf(stderr,"\tType: \t%s\n",type_name[TSO_TYPE(closure)]);
- fprintf(stderr,">PRI: \t%#lx", closure->gran.pri);
- fprintf(stderr,"\tMAGIC: \t%#lx %s\n", closure->gran.magic, 
-	 (closure->gran.magic==TSO_MAGIC ? "it IS a TSO" : "THIS IS NO TSO!!"));
- if ( verbose & 0x04 ) {
-   fprintf(stderr, "Stack: stack @ %#lx (stack_size: %u; max_stack_size: %u)\n", 
-	   closure->stack, closure->stack_size, closure->max_stack_size);
-   fprintf(stderr, "  sp: %#lx, su: %#lx, splim: %#lx\n", 
-	   closure->sp, closure->su, closure->splim);
- }
- // fprintf(stderr,"\n");
- if (verbose & 0x01) {
-   // fprintf(stderr,"} LOCKED: \t%#lx",closure->locked);
-   fprintf(stderr,"} SPARKNAME: \t%#lx\n", closure->gran.sparkname);
-   fprintf(stderr,"} STARTEDAT: \t%#lx", closure->gran.startedat);
-   fprintf(stderr,"\tEXPORTED: \t%#lx\n", closure->gran.exported);
-   fprintf(stderr,"} BASICBLOCKS: \t%#lx", closure->gran.basicblocks);
-   fprintf(stderr,"\tALLOCS: \t%#lx\n", closure->gran.allocs);
-   fprintf(stderr,"} EXECTIME: \t%#lx", closure->gran.exectime);
-   fprintf(stderr,"\tFETCHTIME: \t%#lx\n", closure->gran.fetchtime);
-   fprintf(stderr,"} FETCHCOUNT: \t%#lx", closure->gran.fetchcount);
-   fprintf(stderr,"\tBLOCKTIME: \t%#lx\n", closure->gran.blocktime);
-   fprintf(stderr,"} BLOCKCOUNT: \t%#lx", closure->gran.blockcount);
-   fprintf(stderr,"\tBLOCKEDAT: \t%#lx\n", closure->gran.blockedat);
-   fprintf(stderr,"} GLOBALSPARKS:\t%#lx", closure->gran.globalsparks);
-   fprintf(stderr,"\tLOCALSPARKS:\t%#lx\n", closure->gran.localsparks);
- }
- if ( verbose & 0x02 ) {
-   fprintf(stderr,"BQ that starts with this TSO: ");
-   G_PRINT_BQ(closure);
- }
-}
-
-//@node Events, Sparks, Threads, Debugging routines for GranSim and GUM
-//@subsection Events
-
-void 
-G_EVENT(event, verbose) 
-rtsEventQ event;
-StgInt verbose;
-{
-  if (verbose) {
-    print_event(event);
-  }else{
-    fprintf(stderr," %#lx",event);
-  }
-}
-
-void
-G_EVENTQ(verbose)
-StgInt verbose;
-{
- extern rtsEventQ EventHd;
- rtsEventQ x;
-
- fprintf(stderr,"RtsEventQ (hd @%#lx):\n",EventHd);
- for (x=EventHd; x!=NULL; x=x->next) {
-   G_EVENT(x,verbose);
- }
- if (EventHd==NULL) 
-   fprintf(stderr,"NIL\n");
- else
-   fprintf(stderr,"\n");
-}
-
-void
-G_PE_EQ(pe,verbose)
-PEs pe;
-StgInt verbose;
-{
- extern rtsEventQ EventHd;
- rtsEventQ x;
-
- fprintf(stderr,"RtsEventQ (hd @%#lx):\n",EventHd);
- for (x=EventHd; x!=NULL; x=x->next) {
-   if (x->proc==pe)
-     G_EVENT(x,verbose);
- }
- if (EventHd==NULL) 
-   fprintf(stderr,"NIL\n");
- else
-   fprintf(stderr,"\n");
-}
-
-//@node Sparks, Processors, Events, Debugging routines for GranSim and GUM
-//@subsection Sparks
-
-void 
-G_SPARK(spark, verbose) 
-rtsSparkQ spark;
-StgInt verbose;
-{
- if (spark==(rtsSpark*)NULL) {
-   belch("G_SPARK: NULL spark; aborting");
-   return;
- }
-  if (verbose)
-    print_spark(spark);
-  else
-    fprintf(stderr," %#lx",spark);
-}
-
-void 
-G_SPARKQ(spark,verbose) 
-rtsSparkQ spark;
-StgInt verbose;
-{
- rtsSparkQ x;
-
- if (spark==(rtsSpark*)NULL) {
-   belch("G_SPARKQ: NULL spark; aborting");
-   return;
- }
-   
- fprintf(stderr,"RtsSparkQ (hd @%#lx):\n",spark);
- for (x=spark; x!=NULL; x=x->next) {
-   G_SPARK(x,verbose);
- }
- if (spark==NULL) 
-   fprintf(stderr,"NIL\n");
- else
-   fprintf(stderr,"\n");
-}
-
-void 
-G_CURR_SPARKQ(verbose) 
-StgInt verbose;
-{
-  G_SPARKQ(pending_sparks_hd,verbose);
-}
-
-//@node Processors, Shortcuts, Sparks, Debugging routines for GranSim and GUM
-//@subsection Processors
-
-void 
-G_PROC(proc,verbose)
-StgInt proc;
-StgInt verbose;
-{ 
-  extern rtsEventQ EventHd;
-  extern char *proc_status_names[];
-
-  fprintf(stderr,"Status of proc %d at time %d (%#lx): %s (%s)\n",
-          proc,CurrentTime[proc],CurrentTime[proc],
-          (CurrentProc==proc)?"ACTIVE":"INACTIVE",
-          proc_status_names[procStatus[proc]]);
-  G_THREADQ(run_queue_hds[proc],verbose & 0x2);
-  if ( (CurrentProc==proc) )
-    G_TSO(CurrentTSO,1);
-
-  if (EventHd!=NULL)
-    fprintf(stderr,"Next event (%s) is on proc %d\n",
-            event_names[EventHd->evttype],EventHd->proc);
-
-  if (verbose & 0x1) {
-    fprintf(stderr,"\nREQUIRED sparks: ");
-    G_SPARKQ(pending_sparks_hds[proc],1);
-    fprintf(stderr,"\nADVISORY_sparks: ");
-    G_SPARKQ(pending_sparks_hds[proc],1);
-  }
-}
-
-//@node Shortcuts, Printing info type, Processors, Debugging routines for GranSim and GUM
-//@subsection Shortcuts
-
-/* Debug Processor */
-void 
-GP(proc)
-StgInt proc;
-{ G_PROC(proc,1);
-}
-
-/* Debug Current Processor */
-void
-GCP(){ G_PROC(CurrentProc,2); }
-
-/* Debug TSO */
-void
-GT(StgPtr tso){ 
-  G_TSO(tso,1);
-}
-
-/* Debug CurrentTSO */
-void
-GCT(){ 
-  fprintf(stderr,"Current Proc: %d\n",CurrentProc);
-  G_TSO(CurrentTSO,1);
-}
-
-/* Shorthand for debugging event queue */
-void
-GEQ() { G_EVENTQ(1); }
-
-/* Shorthand for debugging thread queue of a processor */
-void 
-GTQ(PEs p) { G_THREADQ(run_queue_hds[p],1); } 
-
-/* Shorthand for debugging thread queue of current processor */
-void 
-GCTQ() { G_THREADQ(run_queue_hds[CurrentProc],1); } 
-
-/* Shorthand for debugging spark queue of a processor */
-void
-GSQ(PEs p) { G_SPARKQ(pending_sparks_hds[p],1); }
-
-/* Shorthand for debugging spark queue of current processor */
-void
-GCSQ() { G_CURR_SPARKQ(1); }
-
-/* Shorthand for printing a node */
-void
-GN(StgPtr node) { G_PRINT_NODE(node); }
-
-/* Shorthand for printing info table */
-#if 0
-// ToDo: fix -- HWL
-void
-GIT(StgPtr node) { G_INFO_TABLE(node); }
-#endif
-
-void 
-printThreadQPtrs(void)
-{
-  PEs p;
-  for (p=0; p<RtsFlags.GranFlags.proc; p++) {
-    fprintf(stderr,", PE %d: (hd=%p,tl=%p)", 
-	    run_queue_hds[p], run_queue_tls[p]);
-  }
-}
-
-void
-printThreadQ(StgTSO *tso) { G_THREADQ(tso, 0); };
-
-void
-printSparkQ(rtsSpark *spark) { G_SPARKQ(spark, 0); };
-
-void
-printThreadQ_verbose(StgTSO *tso) { G_THREADQ(tso, 1); };
-
-void
-printSparkQ_verbose(rtsSpark *spark) { G_SPARKQ(spark, 1); };
-
-/* Shorthand for some of ADRs debugging functions */
-
-#endif /* GRAN && GRAN_CHECK*/
-
-#if 0
-void
-DEBUG_PRINT_NODE(node)
-StgPtr node;
-{
-   W_ info_ptr = INFO_PTR(node);
-   StgInt size = 0, ptrs = 0, i, vhs = 0;
-   char info_type[80];
-
-   info_hdr_type(info_ptr, info_type);
-
-   size_and_ptrs(node,&size,&ptrs);
-   vhs = var_hdr_size(node);
-
-   fprintf(stderr,"Node: 0x%lx", (W_) node);
-
-#if defined(PAR)
-   fprintf(stderr," [GA: 0x%lx]",GA(node));
-#endif
-
-#if defined(PROFILING)
-   fprintf(stderr," [CC: 0x%lx]",CC_HDR(node));
-#endif
-
-#if defined(GRAN)
-   fprintf(stderr," [Bitmask: 0%lo]",PROCS(node));
-#endif
-
-   fprintf(stderr," IP: 0x%lx (%s), size %ld, %ld ptrs\n",
-                  info_ptr,info_type,size,ptrs);
-
-   /* For now, we ignore the variable header */
-
-   for(i=0; i < size; ++i)
-     {
-       if(i == 0)
-         fprintf(stderr,"Data: ");
-
-       else if(i % 6 == 0)
-         fprintf(stderr,"\n      ");
-
-       if(i < ptrs)
-         fprintf(stderr," 0x%lx[P]",*(node+_HS+vhs+i));
-       else
-         fprintf(stderr," %lu[D]",*(node+_HS+vhs+i));
-     }
-   fprintf(stderr, "\n");
-}
-
-
-#define INFO_MASK       0x80000000
-
-void
-DEBUG_TREE(node)
-StgPtr node;
-{
-  W_ size = 0, ptrs = 0, i, vhs = 0;
-
-  /* Don't print cycles */
-  if((INFO_PTR(node) & INFO_MASK) != 0)
-    return;
-
-  size_and_ptrs(node,&size,&ptrs);
-  vhs = var_hdr_size(node);
-
-  DEBUG_PRINT_NODE(node);
-  fprintf(stderr, "\n");
-
-  /* Mark the node -- may be dangerous */
-  INFO_PTR(node) |= INFO_MASK;
-
-  for(i = 0; i < ptrs; ++i)
-    DEBUG_TREE((StgPtr)node[i+vhs+_HS]);
-
-  /* Unmark the node */
-  INFO_PTR(node) &= ~INFO_MASK;
-}
-
-
-void
-DEBUG_INFO_TABLE(node)
-StgPtr node;
-{
-  W_ info_ptr = INFO_PTR(node);
-  char *iStgPtrtype = info_hdr_type(info_ptr);
-
-  fprintf(stderr,"%s Info Ptr @0x%lx; Entry: 0x%lx; Size: %lu; Ptrs: %lu\n\n",
-                 iStgPtrtype,info_ptr,(W_) ENTRY_CODE(info_ptr),INFO_SIZE(info_ptr),INFO_NoPTRS(info_ptr));
-#if defined(PAR)
-  fprintf(stderr,"Enter Flush Entry: 0x%lx;\tExit Flush Entry: 0x%lx\n",INFO_FLUSHENT(info_ptr),INFO_FLUSH(info_ptr));
-#endif
-
-#if defined(PROFILING)
-  fprintf(stderr,"Cost Centre (?):       0x%lx\n",INFO_CAT(info_ptr));
-#endif
-
-#if defined(_INFO_COPYING)
-  fprintf(stderr,"Evacuate Entry:    0x%lx;\tScavenge Entry: 0x%lx\n",
-          INFO_EVAC_2S(info_ptr),INFO_SCAV_2S(info_ptr));
-#endif
-
-#if defined(_INFO_COMPACTING)
-  fprintf(stderr,"Scan Link:         0x%lx;\tScan Move:      0x%lx\n",
-          (W_) INFO_SCAN_LINK_1S(info_ptr), (W_) INFO_SCAN_MOVE_1S(info_ptr));
-  fprintf(stderr,"Mark:              0x%lx;\tMarked:         0x%lx;\t",
-          (W_) INFO_MARK_1S(info_ptr), (W_) INFO_MARKED_1S(info_ptr));
-#if 0 /* avoid INFO_TYPE */
-  if(BASE_INFO_TYPE(info_ptr)==INFO_SPEC_TYPE)
-    fprintf(stderr,"plus specialised code\n");
-  else
-    fprintf(stderr,"Marking:           0x%lx\n",(W_) INFO_MARKING_1S(info_ptr));
-#endif /* 0 */
-#endif /* _INFO_COMPACTING */
-}
-#endif /* 0 */
-
-//@node Printing info type, Printing Packet Contents, Shortcuts, Debugging routines for GranSim and GUM
-//@subsection Printing info type
-
-char *
-display_info_type(closure, str)
-StgClosure *closure;
-char *str;
-{ 
-  strcpy(str,"");
-  if ( closure_HNF(closure) )
-    strcat(str,"|_HNF ");
-  else if ( closure_BITMAP(closure) )
-    strcat(str,"|_BTM");
-  else if ( !closure_SHOULD_SPARK(closure) )
-    strcat(str,"|_NS");
-  else if ( closure_STATIC(closure) )
-    strcat(str,"|_STA");
-  else if ( closure_THUNK(closure) )
-    strcat(str,"|_THU");
-  else if ( closure_MUTABLE(closure) )
-    strcat(str,"|_MUT");
-  else if ( closure_UNPOINTED(closure) )
-    strcat(str,"|_UPT");
-  else if ( closure_SRT(closure) )
-    strcat(str,"|_SRT");
-
-  return(str);
-}
-
-/*
-  PrintPacket is in Pack.c because it makes use of closure queues
-*/
-
-#if defined(GRAN) || defined(PAR)
-
-/*
-  Print graph rooted at q. The structure of this recursive printing routine
-  should be the same as in the graph traversals when packing a graph in
-  GUM. Thus, it demonstrates the structure of such a generic graph
-  traversal, and in particular, how to extract pointer and non-pointer info
-  from the multitude of different heap objects available. 
-
-  {evacuate}Daq ngoqvam nIHlu'pu'!!
-*/
-
-void
-PrintGraph(StgClosure *p, int indent_level)
-{
-  void PrintGraph_(StgClosure *p, int indent_level);
-
-  ASSERT(tmpClosureTable==NULL);
-
-  /* init hash table */
-  tmpClosureTable = allocHashTable();
-
-  /* now do the real work */
-  PrintGraph_(p, indent_level);
-
-  /* nuke hash table */
-  freeHashTable(tmpClosureTable, NULL);
-  tmpClosureTable = NULL;
-}
-
-/*
-  This is the actual worker functions. 
-  All recursive calls should be made to this function.
-*/
-void
-PrintGraph_(StgClosure *p, int indent_level)
-{
-  StgPtr x, q;
-  rtsBool printed = rtsFalse;
-  nat i, j;
-  const StgInfoTable *info;
-  
-  /* check whether we have met this node already to break cycles */
-  if (lookupHashTable(tmpClosureTable, (StgWord)p)) { // ie. already touched
-    /* indentation */
-    for (j=0; j<indent_level; j++)
-      fputs(" ", stderr);
-
-    fprintf(stderr, "#### cylce to %p", p);
-    return; 
-  }
-
-  /* record that we are processing this closure */
-  insertHashTable(tmpClosureTable, (StgWord) p, (void *)rtsTrue/*non-NULL*/);
-
-  q = p;			/* save ptr to object */
-  
-  /* indentation */
-  for (j=0; j<indent_level; j++)
-    fputs(" ", stderr);
-
-  ASSERT(p!=(StgClosure*)NULL);
-  ASSERT(LOOKS_LIKE_STATIC(p) ||
-	 LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p)) ||
-         IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p)));
-
-  printClosure(p); // prints contents of this one closure
-
-  /* indentation */
-  for (j=0; j<indent_level; j++)
-    fputs(" ", stderr);
-
-  info = get_itbl((StgClosure *)p);
-  /* the rest of this fct recursively traverses the graph */
-  switch (info -> type) {
-  
-  case BCO:
-    {
-  	StgBCO* bco = stgCast(StgBCO*,p);
-  	nat i;
-	fprintf(stderr, "BCO (%p)\n", p);
-        /*
-  	for (i = 0; i < bco->n_ptrs; i++) {
-  	  // bcoConstCPtr(bco,i) = 
-	  PrintGraph_(bcoConstCPtr(bco,i), indent_level+1);
-  	}
-	*/
-  	// p += bco_sizeW(bco);
-  	break;
-    }
-  
-  case MVAR:
-    /* treat MVars specially, because we don't want to PrintGraph the
-     * mut_link field in the middle of the closure.
-     */
-    { 
-  	StgMVar *mvar = ((StgMVar *)p);
-  	// evac_gen = 0;
-	fprintf(stderr, "MVAR (%p) with 3 pointers (head, tail, value)\n", p);
-  	// (StgClosure *)mvar->head = 
-	PrintGraph_((StgClosure *)mvar->head, indent_level+1);
-  	// (StgClosure *)mvar->tail = 
-	PrintGraph_((StgClosure *)mvar->tail, indent_level+1);
-  	//(StgClosure *)mvar->value = 
-	PrintGraph_((StgClosure *)mvar->value, indent_level+1);
-  	// p += sizeofW(StgMVar);
-  	// evac_gen = saved_evac_gen;
-  	break;
-    }
-  
-  case THUNK_2_0:
-    if (!printed) {
-      fprintf(stderr, "THUNK_2_0 (%p) with 2 pointers\n", p);
-      printed = rtsTrue;
-    }
-  case FUN_2_0:
-    if (!printed) {
-      fprintf(stderr, "FUN_2_0 (%p) with 2 pointers\n", p);
-      printed = rtsTrue;
-    }
-    // scavenge_srt(info);
-  case CONSTR_2_0:
-    if (!printed) {
-      fprintf(stderr, "CONSTR_2_0 (%p) with 2 pointers\n", p);
-      printed = rtsTrue;
-    }
-    // ((StgClosure *)p)->payload[0] = 
-    PrintGraph_(((StgClosure *)p)->payload[0],
-	       indent_level+1);
-    // ((StgClosure *)p)->payload[1] = 
-    PrintGraph_(((StgClosure *)p)->payload[1],
-	       indent_level+1);
-    // p += sizeofW(StgHeader) + 2;
-    break;
-  
-  case THUNK_1_0:
-    // scavenge_srt(info);
-    fprintf(stderr, "THUNK_1_0 (%p) with 1 pointer\n", p);
-    // ((StgClosure *)p)->payload[0] = 
-    PrintGraph_(((StgClosure *)p)->payload[0],
-	       indent_level+1);
-    // p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
-    break;
-  
-  case FUN_1_0:
-    if (!printed) {
-      fprintf(stderr, "FUN_1_0 (%p) with 1 pointer\n", p);
-      printed = rtsTrue;
-    }
-    // scavenge_srt(info);
-  case CONSTR_1_0:
-    if (!printed) {
-      fprintf(stderr, "CONSTR_2_0 (%p) with 2 pointers\n", p);
-      printed = rtsTrue;
-    }
-    // ((StgClosure *)p)->payload[0] = 
-    PrintGraph_(((StgClosure *)p)->payload[0],
-	       indent_level+1);
-    // p += sizeofW(StgHeader) + 1;
-    break;
-  
-  case THUNK_0_1:
-    fprintf(stderr, "THUNK_0_1 (%p) with 0 pointers\n", p);
-    // scavenge_srt(info);
-    // p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
-    break;
-  
-  case FUN_0_1:
-    fprintf(stderr, "FUN_0_1 (%p) with 0 pointers\n", p);
-    //scavenge_srt(info);
-  case CONSTR_0_1:
-    fprintf(stderr, "CONSTR_0_1 (%p) with 0 pointers\n", p);
-    //p += sizeofW(StgHeader) + 1;
-    break;
-  
-  case THUNK_0_2:
-    if (!printed) {
-      fprintf(stderr, "THUNK_0_2 (%p) with 0 pointers\n", p);
-      printed = rtsTrue;
-    }
-  case FUN_0_2:
-    if (!printed) {
-      fprintf(stderr, "FUN_0_2 (%p) with 0 pointers\n", p);
-      printed = rtsTrue;
-    }
-    // scavenge_srt(info);
-  case CONSTR_0_2:
-    if (!printed) {
-      fprintf(stderr, "CONSTR_0_2 (%p) with 0 pointers\n", p);
-      printed = rtsTrue;
-    }
-    // p += sizeofW(StgHeader) + 2;
-    break;
-  
-  case THUNK_1_1:
-    if (!printed) {
-      fprintf(stderr, "THUNK_1_1 (%p) with 1 pointer\n", p);
-      printed = rtsTrue;
-    }
-  case FUN_1_1:
-    if (!printed) {
-      fprintf(stderr, "FUN_1_1 (%p) with 1 pointer\n", p);
-      printed = rtsTrue;
-    }
-    // scavenge_srt(info);
-  case CONSTR_1_1:
-    if (!printed) {
-      fprintf(stderr, "CONSTR_1_1 (%p) with 1 pointer\n", p);
-      printed = rtsTrue;
-    }
-    // ((StgClosure *)p)->payload[0] = 
-    PrintGraph_(((StgClosure *)p)->payload[0],
-	       indent_level+1);
-    // p += sizeofW(StgHeader) + 2;
-    break;
-  
-  case FUN:
-    if (!printed) {
-      fprintf(stderr, "FUN (%p) with %d pointers\n", p, info->layout.payload.ptrs);
-      printed = rtsTrue;
-    }
-    /* fall through */
-  
-  case THUNK:
-    if (!printed) {
-      fprintf(stderr, "THUNK (%p) with %d pointers\n", p, info->layout.payload.ptrs);
-      printed = rtsTrue;
-    }
-    // scavenge_srt(info);
-    /* fall through */
-  
-  case CONSTR:
-    if (!printed) {
-      fprintf(stderr, "CONSTR (%p) with %d pointers\n", p, info->layout.payload.ptrs);
-      printed = rtsTrue;
-    }
-    /* basically same as loop in STABLE_NAME case  */
-    for (i=0; i<info->layout.payload.ptrs; i++)
-      PrintGraph_(((StgClosure *)p)->payload[i],
-		 indent_level+1);
-    break;
-    /* NOT fall through */
-  
-  case WEAK:
-    if (!printed) {
-      fprintf(stderr, "WEAK (%p) with %d pointers\n", p, info->layout.payload.ptrs);
-      printed = rtsTrue;
-    }
-    /* fall through */
-  
-  case FOREIGN:
-    if (!printed) {
-      fprintf(stderr, "FOREIGN (%p) with %d pointers\n", p, info->layout.payload.ptrs);
-      printed = rtsTrue;
-    }
-    /* fall through */
-  
-  case STABLE_NAME:
-    {
-      StgPtr end;
-      
-      if (!printed) {
-	fprintf(stderr, "STABLE_NAME (%p) with %d pointers (not followed!)\n", 
-		p, info->layout.payload.ptrs);
-	printed = rtsTrue;
-      }
-      end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
-      for (p = (StgPtr)((StgClosure *)p)->payload; p < end; p++) {
-	// (StgClosure *)*p = 
-	//PrintGraph_((StgClosure *)*p, indent_level+1);
-	fprintf(stderr, ", %p", *p); 
-      }
-      //fputs("\n", stderr);
-      // p += info->layout.payload.nptrs;
-      break;
-    }
-  
-  case IND_PERM:
-    //if (step->gen->no != 0) {
-    //	SET_INFO(((StgClosure *)p), &IND_OLDGEN_PERM_info);
-    //}
-    if (!printed) {
-      fprintf(stderr, "IND_PERM (%p) with indirection to\n", 
-	      p, ((StgIndOldGen *)p)->indirectee);
-      printed = rtsTrue;
-    }
-    /* fall through */
-
-  case IND_OLDGEN_PERM:
-    if (!printed) {
-      fprintf(stderr, "IND_OLDGEN_PERM (%p) with indirection to %p\n", 
-	      p, ((StgIndOldGen *)p)->indirectee);
-      printed = rtsTrue;
-    }
-    // ((StgIndOldGen *)p)->indirectee = 
-    PrintGraph_(((StgIndOldGen *)p)->indirectee,
-	       indent_level+1);
-    //if (failed_to_evac) {
-    //	failed_to_evac = rtsFalse;
-    //	recordOldToNewPtrs((StgMutClosure *)p);
-    //}
-    // p += sizeofW(StgIndOldGen);
-    break;
-  
-  case MUT_VAR:
-    /* ignore MUT_CONSs */
-    fprintf(stderr, "MUT_VAR (%p) pointing to %p\n", p, ((StgMutVar *)p)->var);
-    if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) {
-      //evac_gen = 0;
-      PrintGraph_(((StgMutVar *)p)->var, indent_level+1);
-  	//evac_gen = saved_evac_gen;
-    }
-    //p += sizeofW(StgMutVar);
-    break;
-  
-  case CAF_BLACKHOLE:
-    if (!printed) {
-      fprintf(stderr, "CAF_BLACKHOLE (%p) with 0 pointers\n", p);
-      printed = rtsTrue;
-    }
-  case SE_CAF_BLACKHOLE:
-    if (!printed) {
-      fprintf(stderr, "SE_CAF_BLACKHOLE (%p) with 0 pointers\n", p);
-      printed = rtsTrue;
-    }
-  case SE_BLACKHOLE:
-    if (!printed) {
-      fprintf(stderr, "SE_BLACKHOLE (%p) with 0 pointers\n", p);
-      printed = rtsTrue;
-    }
-  case BLACKHOLE:
-    if (!printed) {
-      fprintf(stderr, "BLACKHOLE (%p) with 0 pointers\n", p);
-      printed = rtsTrue;
-    }
-    //p += BLACKHOLE_sizeW();
-    break;
-  
-  case BLACKHOLE_BQ:
-    { 
-      StgBlockingQueue *bh = (StgBlockingQueue *)p;
-      // (StgClosure *)bh->blocking_queue = 
-      fprintf(stderr, "BLACKHOLE_BQ (%p) pointing to %p\n", 
-	      p, (StgClosure *)bh->blocking_queue);
-      PrintGraph_((StgClosure *)bh->blocking_queue, indent_level+1);
-      //if (failed_to_evac) {
-      //  failed_to_evac = rtsFalse;
-      //  recordMutable((StgMutClosure *)bh);
-      //}
-      // p += BLACKHOLE_sizeW();
-      break;
-    }
-  
-  case THUNK_SELECTOR:
-    { 
-      StgSelector *s = (StgSelector *)p;
-      fprintf(stderr, "THUNK_SELECTOR (%p) pointing to %p\n", 
-	      p, s->selectee);
-      PrintGraph_(s->selectee, indent_level+1);
-      // p += THUNK_SELECTOR_sizeW();
-      break;
-    }
-  
-  case IND:
-    fprintf(stderr, "IND (%p) pointing to %p\n", p, ((StgInd*)p)->indirectee);
-    PrintGraph_(((StgInd*)p)->indirectee, indent_level+1);
-    break;
-
-  case IND_OLDGEN:
-    fprintf(stderr, "IND_OLDGEN (%p) pointing to %p\n", 
-	    p, ((StgIndOldGen*)p)->indirectee);
-    PrintGraph_(((StgIndOldGen*)p)->indirectee, indent_level+1);
-    break;
-  
-  case CONSTR_INTLIKE:
-    fprintf(stderr, "CONSTR_INTLIKE (%p) with 0 pointers\n", p);
-    break;
-  case CONSTR_CHARLIKE:
-    fprintf(stderr, "CONSTR_CHARLIKE (%p) with 0 pointers\n", p);
-    break;
-  case CONSTR_STATIC:
-    fprintf(stderr, "CONSTR_STATIC (%p) with 0 pointers\n", p);
-    break;
-  case CONSTR_NOCAF_STATIC:
-    fprintf(stderr, "CONSTR_NOCAF_STATIC (%p) with 0 pointers\n", p);
-    break;
-  case THUNK_STATIC:
-    fprintf(stderr, "THUNK_STATIC (%p) with 0 pointers\n", p);
-    break;
-  case FUN_STATIC:
-    fprintf(stderr, "FUN_STATIC (%p) with 0 pointers\n", p);
-    break;
-  case IND_STATIC:
-    fprintf(stderr, "IND_STATIC (%p) with 0 pointers\n", p);
-    break;
-  
-  case RET_BCO:
-    fprintf(stderr, "RET_BCO (%p) with 0 pointers\n", p);
-    break;
-  case RET_SMALL:
-    fprintf(stderr, "RET_SMALL (%p) with 0 pointers\n", p);
-    break;
-  case RET_VEC_SMALL:
-    fprintf(stderr, "RET_VEC_SMALL (%p) with 0 pointers\n", p);
-    break;
-  case RET_BIG:
-    fprintf(stderr, "RET_BIG (%p) with 0 pointers\n", p);
-    break;
-  case RET_VEC_BIG:
-    fprintf(stderr, "RET_VEC_BIG (%p) with 0 pointers\n", p);
-    break;
-  case RET_DYN:
-    fprintf(stderr, "RET_DYN (%p) with 0 pointers\n", p);
-    break;
-  case UPDATE_FRAME:
-    fprintf(stderr, "UPDATE_FRAME (%p) with 0 pointers\n", p);
-    break;
-  case STOP_FRAME:
-    fprintf(stderr, "STOP_FRAME (%p) with 0 pointers\n", p);
-    break;
-  case CATCH_FRAME:
-    fprintf(stderr, "CATCH_FRAME (%p) with 0 pointers\n", p);
-    break;
-  case SEQ_FRAME:
-    fprintf(stderr, "SEQ_FRAME (%p) with 0 pointers\n", p);
-    break;
-  
-  case AP_UPD: /* same as PAPs */
-    fprintf(stderr, "AP_UPD (%p) with 0 pointers\n", p);
-  case PAP:
-    /* Treat a PAP just like a section of stack, not forgetting to
-     * PrintGraph_ the function pointer too...
-     */
-    { 
-  	StgPAP* pap = stgCast(StgPAP*,p);
-  
-	fprintf(stderr, "PAP (%p) pointing to %p\n", p, pap->fun);
-  	// pap->fun = 
-	//PrintGraph_(pap->fun, indent_level+1);
-  	//scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
-  	//p += pap_sizeW(pap);
-  	break;
-    }
-    
-  case ARR_WORDS:
-    /* an array of (non-mutable) words */
-    fprintf(stderr, "ARR_WORDS (%p) of %d non-ptrs (maybe a string?)\n", 
-	    p, ((StgArrWords *)q)->words);
-    break;
-
-  case MUT_ARR_PTRS:
-    /* follow everything */
-    {
-  	StgPtr next;
-  
-	fprintf(stderr, "MUT_ARR_PTRS (%p) with %d pointers (not followed)\n", 
-		p, mut_arr_ptrs_sizeW((StgMutArrPtrs*)p));
-  	// evac_gen = 0;		/* repeatedly mutable */
-  	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-  	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-  	  // (StgClosure *)*p = 
-	  // PrintGraph_((StgClosure *)*p, indent_level+1);
-	  fprintf(stderr, ", %p", *p); 
-  	}
-	fputs("\n", stderr);
-  	//evac_gen = saved_evac_gen;
-  	break;
-    }
-  
-  case MUT_ARR_PTRS_FROZEN:
-    /* follow everything */
-    {
-  	StgPtr start = p, next;
-  
-	fprintf(stderr, "MUT_ARR_PTRS (%p) with %d pointers (not followed)", 
-		p, mut_arr_ptrs_sizeW((StgMutArrPtrs*)p));
-  	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-  	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-  	  // (StgClosure *)*p = 
-	  // PrintGraph_((StgClosure *)*p, indent_level+1);
-	  fprintf(stderr, ", %p", *p); 
-  	}
-	fputs("\n", stderr);
-  	//if (failed_to_evac) {
-  	  /* we can do this easier... */
-  	//  recordMutable((StgMutClosure *)start);
-  	//  failed_to_evac = rtsFalse;
-  	//}
-  	break;
-    }
-  
-  case TSO:
-    { 
-  	StgTSO *tso;
-  	
-  	tso = (StgTSO *)p;
-	fprintf(stderr, "TSO (%p) with link field %p\n", p, (StgClosure *)tso->link);
-  	// evac_gen = 0;
-  	/* chase the link field for any TSOs on the same queue */
-  	// (StgClosure *)tso->link = 
-	PrintGraph_((StgClosure *)tso->link, indent_level+1);
-  	//if (tso->blocked_on) {
-  	//  tso->blocked_on = PrintGraph_(tso->blocked_on);
-  	//}
-  	/* scavenge this thread's stack */
-  	//scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
-  	//evac_gen = saved_evac_gen;
-  	//p += tso_sizeW(tso);
-  	break;
-    }
-  
-#if defined(GRAN) || defined(PAR)
-  case RBH:
-    {
-    StgInfoTable *rip = REVERT_INFOPTR(get_itbl(p));
-    //if (LOOKS_LIKE_GHC_INFO(rip))
-    //  fprintf(stderr, "RBH (%p) with 0 pointers (reverted type=%s)\n", 
-	//      p, info_type_by_ip(rip)); 
-    //else
-    fprintf(stderr, "RBH (%p) with 0 pointers (reverted IP=%x)\n", 
-	    p, rip); 
-    }
-    break;
-#endif
-#if defined(PAR)
-  case BLOCKED_FETCH:
-    fprintf(stderr, "BLOCKED_FETCH (%p) with 0 pointers (link=%p)\n", 
-	    p, ((StgBlockedFetch *)p)->link);
-    break;
-  case FETCH_ME:
-    fprintf(stderr, "FETCH_ME (%p) with 0 pointers\n", p);
-    break;
-  case FETCH_ME_BQ:
-    fprintf(stderr, "FETCH_ME_BQ (%p) with 0 pointers (blocking_queue=%p)\n", 
-	    p, ((StgFetchMeBlockingQueue *)p)->blocking_queue);
-    break;
-#endif
-    
-#ifdef DIST    
-  case REMOTE_REF:
-    fprintf(stderr, "REMOTE_REF (%p) with 0 pointers\n", p);
-    break;
-#endif
-
-  case EVACUATED:
-    fprintf(stderr, "EVACUATED (%p) with 0 pointers (evacuee=%p)\n", 
-	    p, ((StgEvacuated *)p)->evacuee);
-    break;
-  
-  default:
-    barf("PrintGraph_: unknown closure %d (%s)",
-	 info -> type, info_type(info));
-  }
-  
-  /* If we didn't manage to promote all the objects pointed to by
-   * the current object, then we have to designate this object as
-   * mutable (because it contains old-to-new generation pointers).
-   */
-  //if (failed_to_evac) {
-  //  mkMutCons((StgClosure *)q, &generations[evac_gen]);
-  //  failed_to_evac = rtsFalse;
-  //}
-}    
-
-# if defined(PAR)
-/*
-  Generate a finger-print for a graph.
-  A finger-print is a string, with each char representing one node; 
-  depth-first traversal
-*/
-
-void
-GraphFingerPrint(StgClosure *p, char *finger_print)
-{
-  void GraphFingerPrint_(StgClosure *p, char *finger_print);
-
-  ASSERT(tmpClosureTable==NULL);
-  ASSERT(strlen(finger_print)==0);
-
-  /* init hash table */
-  tmpClosureTable = allocHashTable();
-
-  /* now do the real work */
-  GraphFingerPrint_(p, finger_print);
-
-  /* nuke hash table */
-  freeHashTable(tmpClosureTable, NULL);
-  tmpClosureTable = NULL;
-}
-
-/*
-  This is the actual worker functions. 
-  All recursive calls should be made to this function.
-*/
-void
-GraphFingerPrint_(StgClosure *p, char *finger_print)
-{
-  StgPtr x, q;
-  rtsBool printed = rtsFalse;
-  nat i, j, len;
-  const StgInfoTable *info;
-
-  q = p;			/* save ptr to object */
-  len = strlen(finger_print);
-  ASSERT(len<=MAX_FINGER_PRINT_LEN);
-  /* at most 7 chars for this node (I think) */
-  if (len+7>=MAX_FINGER_PRINT_LEN)
-    return;
-
-  /* check whether we have met this node already to break cycles */
-  if (lookupHashTable(tmpClosureTable, (StgWord)p)) { // ie. already touched
-    strcat(finger_print, "#");
-    return; 
-  }
-
-  /* record that we are processing this closure */
-  insertHashTable(tmpClosureTable, (StgWord) p, (void *)rtsTrue/*non-NULL*/);
-
-  ASSERT(p!=(StgClosure*)NULL);
-  ASSERT(LOOKS_LIKE_STATIC(p) ||
-	 LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p)) ||
-         IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p)));
-
-  info = get_itbl((StgClosure *)p);
-  // append char for this node
-  finger_print[len] = finger_print_char[info->type]; finger_print[len+1] = '\0'; 
-  /* the rest of this fct recursively traverses the graph */
-  switch (info -> type) {
-  
-  case BCO:
-    {
-  	StgBCO* bco = stgCast(StgBCO*,p);
-  	nat i;
-	//%% fprintf(stderr, "BCO (%p) with %d pointers\n", p, bco->n_ptrs);
-        /*
-  	for (i = 0; i < bco->n_ptrs; i++) {
-  	  // bcoConstCPtr(bco,i) = 
-	  GraphFingerPrint_(bcoConstCPtr(bco,i), finger_print);
-  	}
-	*/
-  	// p += bco_sizeW(bco);
-  	break;
-    }
-  
-  case MVAR:
-    break;
-  
-  case THUNK_2_0:
-  case FUN_2_0:
-  case CONSTR_2_0:
-    // append char for this node
-    strcat(finger_print, "22(");
-    GraphFingerPrint_(((StgClosure *)p)->payload[0], finger_print);
-    GraphFingerPrint_(((StgClosure *)p)->payload[1], finger_print);
-    if (strlen(finger_print)+2<MAX_FINGER_PRINT_LEN)
-      strcat(finger_print, ")");
-    break;
-  
-  case THUNK_1_0:
-  case FUN_1_0:
-  case CONSTR_1_0:
-    // append char for this node
-    strcat(finger_print, "12(");
-    GraphFingerPrint_(((StgClosure *)p)->payload[0], finger_print);
-    if (strlen(finger_print)+2<MAX_FINGER_PRINT_LEN)
-      strcat(finger_print, ")");
-    break;
-  
-  case THUNK_0_1:
-  case FUN_0_1:
-  case CONSTR_0_1:
-    // append char for this node
-    strcat(finger_print, "01");
-    break;
-  
-  case THUNK_0_2:
-  case FUN_0_2:
-  case CONSTR_0_2:
-    // append char for this node
-    strcat(finger_print, "02");
-    break;
-  
-  case THUNK_1_1:
-  case FUN_1_1:
-  case CONSTR_1_1:
-    // append char for this node
-    strcat(finger_print, "11(");
-    GraphFingerPrint_(((StgClosure *)p)->payload[0], finger_print);
-    if (strlen(finger_print)+2<MAX_FINGER_PRINT_LEN)
-      strcat(finger_print, ")");
-    break;
-  
-  case FUN:
-  case THUNK:
-  case CONSTR:
-    /* basically same as loop in STABLE_NAME case  */
-    {
-	char str[6];
-	sprintf(str,"%d?(",info->layout.payload.ptrs);
-	strcat(finger_print,str); 
-	for (i=0; i<info->layout.payload.ptrs; i++)
-	  GraphFingerPrint_(((StgClosure *)p)->payload[i], finger_print);
-	if (strlen(finger_print)+2<MAX_FINGER_PRINT_LEN)
-	  strcat(finger_print, ")");
-    }
-    break;
-  
-  case WEAK:
-  case FOREIGN:
-  case STABLE_NAME:
-    {
-      StgPtr end;
-      char str[6];
-      sprintf(str,"%d?", info->layout.payload.ptrs);
-      strcat(finger_print,str); 
-
-	//end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
-      //for (p = (StgPtr)((StgClosure *)p)->payload; p < end; p++) {
-      // GraphFingerPrint_((StgClosure *)*p, finger_print);
-      //}
-      break;
-    }
-  
-  case IND_PERM:
-  case IND_OLDGEN_PERM:
-    GraphFingerPrint_(((StgIndOldGen *)p)->indirectee, finger_print);
-    break;
-  
-  case MUT_VAR:
-    /* ignore MUT_CONSs */
-    if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) {
-      GraphFingerPrint_(((StgMutVar *)p)->var, finger_print);
-    }
-    break;
-  
-  case CAF_BLACKHOLE:
-  case SE_CAF_BLACKHOLE:
-  case SE_BLACKHOLE:
-  case BLACKHOLE:
-    break;
-  
-  case BLACKHOLE_BQ:
-    { 
-      StgBlockingQueue *bh = (StgBlockingQueue *)p;
-      // GraphFingerPrint_((StgClosure *)bh->blocking_queue, finger_print);
-      break;
-    }
-  
-  case THUNK_SELECTOR:
-    { 
-      StgSelector *s = (StgSelector *)p;
-      GraphFingerPrint_(s->selectee, finger_print);
-      break;
-    }
-  
-  case IND:
-    GraphFingerPrint_(((StgInd*)p)->indirectee, finger_print);
-    break;
-
-  case IND_OLDGEN:
-    GraphFingerPrint_(((StgIndOldGen*)p)->indirectee, finger_print);
-    break;
-
-  case IND_STATIC:
-    GraphFingerPrint_(((StgIndOldGen*)p)->indirectee, finger_print);
-    break;
-  
-  case CONSTR_INTLIKE:
-  case CONSTR_CHARLIKE:
-  case CONSTR_STATIC:
-  case CONSTR_NOCAF_STATIC:
-  case THUNK_STATIC:
-  case FUN_STATIC:
-    break;
-  
-  case RET_BCO:
-  case RET_SMALL:
-  case RET_VEC_SMALL:
-  case RET_BIG:
-  case RET_VEC_BIG:
-  case RET_DYN:
-  case UPDATE_FRAME:
-  case STOP_FRAME:
-  case CATCH_FRAME:
-  case SEQ_FRAME:
-    break;
-  
-  case AP_UPD: /* same as PAPs */
-  case PAP:
-    /* Treat a PAP just like a section of stack, not forgetting to
-     * GraphFingerPrint_ the function pointer too...
-     */
-    { 
-  	StgPAP* pap = stgCast(StgPAP*,p);
-	char str[6];
-	sprintf(str,"%d",pap->n_args);
-	strcat(finger_print,str); 
-	//GraphFingerPrint_(pap->fun, finger_print); // ??
-  	break;
-    }
-    
-  case ARR_WORDS:
-    {
-	char str[6];
-	sprintf(str,"%d",((StgArrWords*)p)->words);
-	strcat(finger_print,str); 
-    }
-    break;
-
-  case MUT_ARR_PTRS:
-    /* follow everything */
-    {
-	char str[6];
-	sprintf(str,"%d",((StgMutArrPtrs*)p)->ptrs);
-	strcat(finger_print,str); 
-    }
-    {
-  	StgPtr next;
-  	//next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-  	//for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	//  GraphFingerPrint_((StgClosure *)*p, finger_print);
-  	//}
-  	break;
-    }
-  
-  case MUT_ARR_PTRS_FROZEN:
-    /* follow everything */
-    {
-	char str[6];
-	sprintf(str,"%d",((StgMutArrPtrs*)p)->ptrs);
-	strcat(finger_print,str); 
-    }
-    {
-  	StgPtr start = p, next;
-  	//next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-  	//for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	//  GraphFingerPrint_((StgClosure *)*p, finger_print);
-  	//}
-  	break;
-    }
-  
-  case TSO:
-    { 
-      StgTSO *tso = (StgTSO *)p;
-      char str[6];
-      sprintf(str,"%d",tso->id);
-      strcat(finger_print,str); 
-    }
-    //GraphFingerPrint_((StgClosure *)tso->link, indent_level+1);
-    break;
-  
-#if defined(GRAN) || defined(PAR)
-  case RBH:
-    {
-      // use this
-      // StgInfoTable *rip = REVERT_INFOPTR(get_itbl(p));
-    }
-    break;
-#endif
-#if defined(PAR)
-  case BLOCKED_FETCH:
-    break;
-  case FETCH_ME:
-    break;
-  case FETCH_ME_BQ:
-    break;
-#endif
-#ifdef DIST    
-  case REMOTE_REF:
-    break;
-#endif
-  case EVACUATED:
-    break;
-  
-  default:
-    barf("GraphFingerPrint_: unknown closure %d (%s)",
-	 info -> type, info_type(info));
-  }
- 
-}    
-# endif /* PAR */
-
-/*
-  Do a sanity check on the whole graph, down to a recursion level of level.
-  Same structure as PrintGraph (nona).
-*/
-void
-checkGraph(StgClosure *p, int rec_level)
-{
-  StgPtr x, q;
-  nat i, j;
-  const StgInfoTable *info;
-  
-  if (rec_level==0)
-    return;
-
-  q = p;			/* save ptr to object */
-
-  /* First, the obvious generic checks */
-  ASSERT(p!=(StgClosure*)NULL);
-  checkClosure(p);              /* see Sanity.c for what's actually checked */
-
-  info = get_itbl((StgClosure *)p);
-  /* the rest of this fct recursively traverses the graph */
-  switch (info -> type) {
-  
-  case BCO:
-    {
-  	StgBCO* bco = stgCast(StgBCO*,p);
-  	nat i;
-        /*
-  	for (i = 0; i < bco->n_ptrs; i++) {
-	  checkGraph(bcoConstCPtr(bco,i), rec_level-1);
-  	}
-	*/
-  	break;
-    }
-  
-  case MVAR:
-    /* treat MVars specially, because we don't want to PrintGraph the
-     * mut_link field in the middle of the closure.
-     */
-    { 
-  	StgMVar *mvar = ((StgMVar *)p);
-	checkGraph((StgClosure *)mvar->head, rec_level-1);
-	checkGraph((StgClosure *)mvar->tail, rec_level-1);
-	checkGraph((StgClosure *)mvar->value, rec_level-1);
-  	break;
-    }
-  
-  case THUNK_2_0:
-  case FUN_2_0:
-  case CONSTR_2_0:
-    checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
-    checkGraph(((StgClosure *)p)->payload[1], rec_level-1);
-    break;
-  
-  case THUNK_1_0:
-    checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
-    break;
-  
-  case FUN_1_0:
-  case CONSTR_1_0:
-    checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
-    break;
-  
-  case THUNK_0_1:
-    break;
-  
-  case FUN_0_1:
-  case CONSTR_0_1:
-    break;
-  
-  case THUNK_0_2:
-  case FUN_0_2:
-  case CONSTR_0_2:
-    break;
-  
-  case THUNK_1_1:
-  case FUN_1_1:
-  case CONSTR_1_1:
-    checkGraph(((StgClosure *)p)->payload[0], rec_level-1);
-    break;
-  
-  case FUN:
-  case THUNK:
-  case CONSTR:
-    for (i=0; i<info->layout.payload.ptrs; i++)
-      checkGraph(((StgClosure *)p)->payload[i], rec_level-1);
-    break;
-  
-  case WEAK:
-  case FOREIGN:
-  case STABLE_NAME:
-    {
-      StgPtr end;
-      
-      end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
-      for (p = (StgPtr)((StgClosure *)p)->payload; p < end; p++) {
-	checkGraph(*(StgClosure **)p, rec_level-1);
-      }
-      break;
-    }
-  
-  case IND_PERM:
-  case IND_OLDGEN_PERM:
-    checkGraph(((StgIndOldGen *)p)->indirectee, rec_level-1);
-    break;
-  
-  case MUT_VAR:
-    /* ignore MUT_CONSs */
-    if (((StgMutVar *)p)->header.info != &stg_MUT_CONS_info) {
-      checkGraph(((StgMutVar *)p)->var, rec_level-1);
-    }
-    break;
-  
-  case CAF_BLACKHOLE:
-  case SE_CAF_BLACKHOLE:
-  case SE_BLACKHOLE:
-  case BLACKHOLE:
-    break;
-  
-  case BLACKHOLE_BQ:
-    break;
-  
-  case THUNK_SELECTOR:
-    { 
-      StgSelector *s = (StgSelector *)p;
-      checkGraph(s->selectee, rec_level-1);
-      break;
-    }
-  
-  case IND:
-    checkGraph(((StgInd*)p)->indirectee, rec_level-1);
-    break;
-
-  case IND_OLDGEN:
-    checkGraph(((StgIndOldGen*)p)->indirectee, rec_level-1);
-    break;
-  
-  case CONSTR_INTLIKE:
-    break;
-  case CONSTR_CHARLIKE:
-    break;
-  case CONSTR_STATIC:
-    break;
-  case CONSTR_NOCAF_STATIC:
-    break;
-  case THUNK_STATIC:
-    break;
-  case FUN_STATIC:
-    break;
-  case IND_STATIC:
-    break;
-  
-  case RET_BCO:
-    break;
-  case RET_SMALL:
-    break;
-  case RET_VEC_SMALL:
-    break;
-  case RET_BIG:
-    break;
-  case RET_VEC_BIG:
-    break;
-  case RET_DYN:
-    break;
-  case UPDATE_FRAME:
-    break;
-  case STOP_FRAME:
-    break;
-  case CATCH_FRAME:
-    break;
-  case SEQ_FRAME:
-    break;
-  
-  case AP_UPD: /* same as PAPs */
-  case PAP:
-    /* Treat a PAP just like a section of stack, not forgetting to
-     * checkGraph the function pointer too...
-     */
-    { 
-  	StgPAP* pap = stgCast(StgPAP*,p);
-  
-	checkGraph(pap->fun, rec_level-1);
-  	break;
-    }
-    
-  case ARR_WORDS:
-    break;
-
-  case MUT_ARR_PTRS:
-    /* follow everything */
-    {
-  	StgPtr next;
-  
-  	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-  	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	  checkGraph(*(StgClosure **)p, rec_level-1);
-  	}
-  	break;
-    }
-  
-  case MUT_ARR_PTRS_FROZEN:
-    /* follow everything */
-    {
-  	StgPtr start = p, next;
-  
-  	next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
-  	for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
-	  checkGraph(*(StgClosure **)p, rec_level-1);
-  	}
-  	break;
-    }
-  
-  case TSO:
-    { 
-  	StgTSO *tso;
-  	
-  	tso = (StgTSO *)p;
-	checkGraph((StgClosure *)tso->link, rec_level-1);
-  	break;
-    }
-  
-#if defined(GRAN) || defined(PAR)
-  case RBH:
-    break;
-#endif
-#if defined(PAR)
-  case BLOCKED_FETCH:
-    break;
-  case FETCH_ME:
-    break;
-  case FETCH_ME_BQ:
-    break;
-#endif
-  case EVACUATED:
-    barf("checkGraph: found EVACUATED closure %p (%s)",
-	 p, info_type(p));
-    break;
-  
-  default:
-  }
-}    
-
-#endif /* GRAN */
-
-#endif /* GRAN || PAR */
-
-//@node End of File,  , Printing Packet Contents, Debugging routines for GranSim and GUM
-//@subsection End of File
diff --git a/ghc/rts/parallel/ParallelDebug.h b/ghc/rts/parallel/ParallelDebug.h
deleted file mode 100644
index f8aaeb85d4..0000000000
--- a/ghc/rts/parallel/ParallelDebug.h
+++ /dev/null
@@ -1,79 +0,0 @@
-/* 
-   Time-stamp: <Tue Mar 06 2001 00:25:14 Stardate: [-30]6285.08 hwloidl>
-
-   Prototypes of all parallel debugging functions.
-*/
-
-#ifndef PARALLEL_DEBUG_H
-#define PARALLEL_DEBUG_H
-
-#if defined(DEBUG) && (defined(GRAN) || defined(PAR))
-/* max length of the string holding a finger-print for a graph */
-#define MAX_FINGER_PRINT_LEN  10000
-// (10*RtsFlags.ParFlags.packBufferSize)
-#endif
-
-#if defined(DEBUG) && defined(GRAN)
-void G_PRINT_NODE(StgClosure* node);
-void G_PPN(StgClosure* node);
-void G_INFO_TABLE(StgClosure* node);
-void G_CURR_THREADQ(StgInt verbose);
-void G_THREADQ(StgTSO* closure, StgInt verbose);
-void G_TSO(StgTSO* closure, StgInt verbose);
-void G_EVENT(rtsEventQ event, StgInt verbose);
-void G_EVENTQ(StgInt verbose);
-void G_PE_EQ(PEs pe, StgInt verbose);
-void G_SPARK(rtsSparkQ spark, StgInt verbose);
-void G_SPARKQ(rtsSparkQ spark, StgInt verbose);
-void G_CURR_SPARKQ(StgInt verbose);
-void G_PROC(StgInt proc, StgInt verbose);
-void GP(StgInt proc);
-void GCP(void);
-void GT(StgPtr tso);
-void GCT(void);
-void GEQ(void);
-void GTQ(PEs p);
-void GCTQ(void);
-void GSQ(PEs p);
-void GCSQ(void);
-void GN(StgPtr node);
-void GIT(StgPtr node);
-#endif
-
-#if defined(GRAN) || defined(PAR)
-
-char  *display_info_type(StgClosure *closure, char *str);
-void   info_hdr_type(StgClosure *closure, char *res);
-char  *info_type(StgClosure *closure);
-char  *info_type_by_ip(StgInfoTable *ip);
-
-void   PrintPacket(rtsPackBuffer *buffer);
-void   PrintGraph(StgClosure *p, int indent_level);
-void   GraphFingerPrint(StgClosure *p, char *finger_print);
-void   checkGraph(StgClosure *p, int rec_level);
-
-void   checkPacket(rtsPackBuffer *packBuffer);
-
-#endif /* GRAN || PAR */
-
-#if defined(PAR)
-
-/* don't want to import Schedule.h and Sanity.h everywhere */
-extern void print_bq (StgClosure *node);
-extern void checkBQ (StgBlockingQueueElement *bqe, StgClosure *closure);
-
-void   checkGAGAMap(globalAddr *gagamap, int nGAs);
-extern rtsBool isOnLiveIndTable(globalAddr *ga);
-extern void rebuildGAtables(rtsBool full);
-extern void rebuildLAGAtable(void);
-extern void checkLAGAtable(rtsBool check_closures);
-extern void checkHeapChunk(StgPtr start, StgPtr end);
-extern void printGA (globalAddr *ga);
-extern void printGALA (GALA *gala);
-extern void printLiveIndTable(void);
-extern void printRemoteGATable(void);
-extern void printLAGAtable(void);
-
-#endif
-
-#endif /* PARALLEL_DEBUG_H */
diff --git a/ghc/rts/parallel/ParallelRts.h b/ghc/rts/parallel/ParallelRts.h
deleted file mode 100644
index d421296d19..0000000000
--- a/ghc/rts/parallel/ParallelRts.h
+++ /dev/null
@@ -1,253 +0,0 @@
-/* --------------------------------------------------------------------------
-   Time-stamp: <Tue Mar 06 2001 00:25:50 Stardate: [-30]6285.08 hwloidl>
-
-   Variables and functions specific to the parallel RTS (i.e. GUM or GranSim)
-   ----------------------------------------------------------------------- */
-
-#ifndef PARALLEL_RTS_H
-#define PARALLEL_RTS_H
-
-#include "ParTicky.h"
-
-/* HWL HACK: compile time sanity checks; shouldn't be necessary at all */
-#if defined(PAR) && defined(GRAN)
-# error "Both PAR and GRAN defined"
-#endif
-
-#if defined(DEBUG)
-/* Paranoia debugging: we add an end-of-buffer marker to every pack buffer 
-                       (only when sanity checking RTS is enabled, of course) */
-#define  DEBUG_HEADROOM        1
-#define  END_OF_BUFFER_MARKER  0x1111bbbb
-#define  GARBAGE_MARKER        0x1111eeee
-#else
-#define  DEBUG_HEADROOM        0
-#endif /* DEBUG */
-
-#if defined(GRAN) || defined(PAR)
-
-#if defined(GRAN)
-
-/* Statistics info */
-extern nat tot_packets, tot_packet_size, tot_cuts, tot_thunks;
-
-/* Pack.c */
-rtsPackBuffer *PackNearbyGraph(StgClosure* closure, StgTSO* tso, 
-			       nat *packBufferSize, GlobalTaskId dest); 
-rtsPackBuffer *PackOneNode(StgClosure* closure, StgTSO* tso, 
-			   nat *packBufferSize);
-rtsPackBuffer *PackTSO(StgTSO *tso, nat *packBufferSize);
-rtsPackBuffer *PackStkO(StgPtr stko, nat *packBufferSize);
-void           PackFetchMe(StgClosure *closure);
-
-/* Unpack.c */
-StgClosure*    UnpackGraph(rtsPackBuffer* buffer);
-void           InitPendingGABuffer(nat size); 
-
-/* RBH.c */
-StgClosure    *convertToRBH(StgClosure *closure);
-void           convertFromRBH(StgClosure *closure);
-
-/* HLComms.c */
-rtsFetchReturnCode blockFetch(StgTSO* tso, PEs proc, StgClosure* bh);
-void               blockThread(StgTSO *tso);
-
-#endif
-#if defined(PAR)
-
-/* Statistics info */
-
-/* global structure for collecting statistics */
-typedef struct GlobalParStats_ {
-  /* GALA and LAGA table info */
-  nat tot_mark_GA, tot_rebuild_GA, tot_free_GA,
-      res_mark_GA, res_rebuild_GA, res_free_GA,
-      cnt_mark_GA, cnt_rebuild_GA, cnt_free_GA,
-      res_size_GA, tot_size_GA, local_alloc_GA, tot_global, tot_local;
-
-  /* time spent managing the GAs */
-  double time_mark_GA, time_rebuild_GA;
-
-  /* spark queue stats */
-  nat res_sp, tot_sp, cnt_sp, emp_sp;
-  // nat tot_sq_len, tot_sq_probes, tot_sparks;
-  /* thread queue stats */
-  nat res_tp, tot_tp, cnt_tp, emp_tp;
-  //nat tot_add_threads, tot_tq_len, non_end_add_threads;
-
-  /* packet statistics */
-  nat tot_packets, tot_packet_size, tot_thunks,
-      res_packet_size, res_thunks,
-      rec_packets, rec_packet_size, rec_thunks,
-      rec_res_packet_size, rec_res_thunks;
-  /* time spent packing stuff */
-  double time_pack, time_unpack;
-
-  /* thread stats */
-  nat tot_threads_created;
-
-  /* spark stats */
-  //nat pruned_sparks, withered_sparks;
-  nat tot_sparks_created, tot_sparks_ignored, tot_sparks_marked,
-      res_sparks_created, res_sparks_ignored, res_sparks_marked; // , sparks_created_on_PE[MAX_PROC];
-  double time_sparks;
-
-  /* scheduling stats */
-  nat tot_yields, tot_stackover, tot_heapover;
-
-  /* message statistics */
-  nat tot_fish_mess, tot_fetch_mess, tot_resume_mess, tot_schedule_mess;
-  nat rec_fish_mess, rec_fetch_mess, rec_resume_mess, rec_schedule_mess;
-#if defined(DIST)
-  nat tot_reval_mess;
-  nat rec_reval_mess;
-#endif
-
-  /* blocking queue statistics
-  rtsTime tot_bq_processing_time;
-  nat tot_bq_len, tot_bq_len_local, tot_awbq, tot_FMBQs;
-  */
-
-  /* specialised info on arrays (for GPH/Maple mainly) */
-  nat tot_arrs, tot_arr_size;
-} GlobalParStats;
-
-extern GlobalParStats globalParStats;
-
-void  globalParStat_exit(void);
-
-/* Pack.c */
-rtsBool        InitPackBuffer(void);
-rtsPackBuffer *PackNearbyGraph(StgClosure* closure, StgTSO* tso, 
-			       nat *packBufferSize, GlobalTaskId dest); 
-
-/* Unpack.c */
-void           CommonUp(StgClosure *src, StgClosure *dst);
-StgClosure    *UnpackGraph(rtsPackBuffer *buffer, globalAddr **gamap, 
-			   nat *nGAs);
-
-/* RBH.c */
-StgClosure    *convertToRBH(StgClosure *closure);
-void           convertToFetchMe(StgRBH *rbh, globalAddr *ga);
-
-/* HLComms.c */
-void           blockFetch(StgBlockedFetch *bf, StgClosure *bh);
-void           blockThread(StgTSO *tso);
-
-/* Global.c */
-void           GALAdeprecate(globalAddr *ga);
-
-/* HLComms.c */
-nat            pending_fetches_len(void);
-
-/* ParInit.c */
-void 	       initParallelSystem(void);
-void 	       shutdownParallelSystem(StgInt n);
-void 	       synchroniseSystem(void);
-void 	       par_exit(I_);
-
-#endif
-
-/* this routine should be moved to a more general module; currently in Pack.c 
-StgInfoTable* get_closure_info(StgClosure* node, 
-			       nat *size, nat *ptrs, nat *nonptrs, nat *vhs, 
-			       char *info_hdr_ty);
-*/
-void doGlobalGC(void); 
-
-//@node GC routines, Debugging routines, Spark handling routines
-//@subsection GC routines
-
-#if defined(PAR)
-/* HLComms.c */
-void      freeRemoteGA(int pe, globalAddr *ga);
-void      sendFreeMessages(void);
-void      markPendingFetches(rtsBool major_gc);
-
-/* Global.c */
-void      markLocalGAs(rtsBool full);
-void      RebuildGAtables(rtsBool full);
-void      RebuildLAGAtable(void);
-#endif
-
-//@node Debugging routines, Generating .gr profiles, GC routines
-//@subsection Debugging routines
-
-#if defined(PAR)
-void      printGA (globalAddr *ga);
-void      printGALA (GALA *gala);
-void      printLAGAtable(void);
-
-rtsBool   isOnLiveIndTable(globalAddr *ga);
-rtsBool   isOnRemoteGATable(globalAddr *ga);
-void      checkFreeGALAList(void);
-void      checkFreeIndirectionsList(void);
-#endif
-
-//@node Generating .gr profiles, Index, Debugging routines
-//@subsection Generating .gr profiles
-
-#define STATS_FILENAME_MAXLEN	128
-
-/* Where to write the log file */
-//@cindex gr_file
-//@cindex gr_filename
-extern FILE *gr_file;
-extern char gr_filename[STATS_FILENAME_MAXLEN];
-
-//@cindex init_gr_stats
-//@cindex init_gr_simulation
-//@cindex end_gr_simulation
-void 	  	init_gr_stats (void);
-void 	  	init_gr_simulation(int rts_argc, char *rts_argv[], 
- 	 			   int prog_argc, char *prog_argv[]);
-void 	  	end_gr_simulation(void);
-
-// TODO: move fcts in here (as static inline)
-StgInfoTable*   get_closure_info(StgClosure* node, nat *size, nat *ptrs, nat *nonptrs, nat *vhs, char *info_hdr_ty);
-rtsBool         IS_BLACK_HOLE(StgClosure* node);
-StgClosure     *IS_INDIRECTION(StgClosure* node)          ;
-StgClosure     *UNWIND_IND (StgClosure *closure);
-
-
-#endif /* defined(PAR) || defined(GRAN) */
-
-//@node Common macros, Index, Generating .gr profiles
-//@subsection Common macros
-
-#define LOOKS_LIKE_PTR(r)    \
-        (LOOKS_LIKE_STATIC_CLOSURE(r) ||  \
-         ((HEAP_ALLOCED(r) && Bdescr((P_)r)->free != (void *)-1)))
-
-/* see Sanity.c for this kind of test; doing this in these basic fcts
-   is paranoid (nuke it after debugging!)
-*/
-
-/* pathetic version of the check whether p can be a closure */
-#define LOOKS_LIKE_COOL_CLOSURE(p)  1
-
-//LOOKS_LIKE_GHC_INFO(get_itbl(p))
-
-    /* Is it a static closure (i.e. in the data segment)? */ \
-    /*
-#define LOOKS_LIKE_COOL_CLOSURE(p)  \
-    ((LOOKS_LIKE_STATIC(p)) ?                                   \
-	closure_STATIC(p)                               \
-      : !closure_STATIC(p) && LOOKS_LIKE_PTR(p))
-    */
-
-#endif /* PARALLEL_RTS_H */
-
-//@node Index,  , Index
-//@subsection Index
-
-//@index
-//* IS_BLACK_HOLE::  @cindex\s-+IS_BLACK_HOLE
-//* IS_INDIRECTION::  @cindex\s-+IS_INDIRECTION
-//* end_gr_simulation::  @cindex\s-+end_gr_simulation
-//* get_closure_info::  @cindex\s-+get_closure_info
-//* gr_file::  @cindex\s-+gr_file
-//* gr_filename::  @cindex\s-+gr_filename
-//* init_gr_simulation::  @cindex\s-+init_gr_simulation
-//* unwindInd::  @cindex\s-+unwindInd
-//@end index
diff --git a/ghc/rts/parallel/RBH.c b/ghc/rts/parallel/RBH.c
deleted file mode 100644
index 1612209027..0000000000
--- a/ghc/rts/parallel/RBH.c
+++ /dev/null
@@ -1,337 +0,0 @@
-/*
-  Time-stamp: <Tue Mar 13 2001 19:07:13 Stardate: [-30]6323.98 hwloidl>
-
-  Revertible Black Hole Manipulation.
-  Used in GUM and GranSim during the packing of closures. These black holes
-  must be revertible because a GC might occur while the packet is being 
-  transmitted. In this case all RBHs have to be reverted.
-  */
-
-#if defined(PAR) || defined(GRAN) /* whole file */
-
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "RtsUtils.h"
-#include "GranSimRts.h"
-#include "ParallelRts.h"
-# if defined(DEBUG)
-# include "ParallelDebug.h"
-# endif
-#include "Storage.h"  // for recordMutable
-#include "StgMacros.h" // inlined IS_... fcts
-
-/*
-   Turn a closure into a revertible black hole.  After the conversion, the
-   first two words of the closure (after the fixed header, of course) will
-   be a link to the mutables list (if appropriate for the garbage
-   collector), and a pointer to the blocking queue.  The blocking queue is
-   terminated by a 2-word SPEC closure which holds the original contents of
-   the first two words of the closure.  
-*/
-
-//@menu
-//* Externs and prototypes::	
-//* Conversion Functions::	
-//* Index::			
-//@end menu
-
-//@node Externs and prototypes, Conversion Functions
-//@section Externs and prototypes
-
-EXTFUN(stg_RBH_Save_0_info);
-EXTFUN(stg_RBH_Save_1_info);
-EXTFUN(stg_RBH_Save_2_info);
-
-//@node Conversion Functions, Index, Externs and prototypes
-//@section Conversion Functions
-
-/*
-  A closure is turned into an RBH upon packing it (see PackClosure in Pack.c).
-  This is needed in case we have to do a GC before the packet is turned
-  into a graph on the PE receiving the packet. 
-*/
-//@cindex convertToRBH
-StgClosure *
-convertToRBH(closure)
-StgClosure *closure;
-{
-  StgRBHSave *rbh_save;
-  StgInfoTable *info_ptr, *rbh_info_ptr, *old_info;
-  nat size, ptrs, nonptrs, vhs;
-  char str[80];
-
-  /*
-     Closure layout before this routine runs amuck:
-       +-------------------
-       |   HEADER   | DATA ...
-       +-------------------
-       | FIXED_HS   |
-  */
-  /* 
-     Turn closure into an RBH.  This is done by modifying the info_ptr,
-     grabbing the info_ptr of the RBH for this closure out of its
-     ITBL. Additionally, we have to save the words from the closure, which
-     will hold the link to the blocking queue.  For this purpose we use the
-     RBH_Save_N closures, with N being the number of pointers for this
-     closure.  */
-  IF_GRAN_DEBUG(pack,
-		belch("*>::   %p (%s): Converting closure into an RBH",
-		      closure, info_type(closure))); 
-  IF_PAR_DEBUG(pack,
-		belch("*>::   %p (%s): Converting closure into an RBH",
-		      closure, info_type(closure))); 
-
-  ASSERT(closure_THUNK(closure));
-
-  IF_GRAN_DEBUG(pack,
-		old_info = get_itbl(closure));
-
-  /* Allocate a new closure for the holding data ripped out of closure */
-  if ((rbh_save = (StgRBHSave *)allocate(_HS + 2)) == NULL)
-    return NULL;  /* have to Garbage Collect; check that in the caller! */
-
-  info_ptr = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs, str);
-  ASSERT(size >= _HS+MIN_UPD_SIZE);
-
-  /* Fill in the RBH_Save closure with the original data from closure */
-  rbh_save->payload[0] = (StgPtr) ((StgRBH *)closure)->blocking_queue;
-  rbh_save->payload[1] = (StgPtr) ((StgRBH *)closure)->mut_link;
-
-  /* Set the info_ptr for the rbh_Save closure according to the number of
-     pointers in the original */
-
-  rbh_info_ptr = (StgInfoTable *) (ptrs == 0 ? &stg_RBH_Save_0_info :
-				   ptrs == 1 ? &stg_RBH_Save_1_info :
-				   &stg_RBH_Save_2_info);
-  SET_INFO(rbh_save, rbh_info_ptr);
-  /* same bitmask as the original closure */
-  SET_GRAN_HDR(rbh_save, PROCS(closure));
-
-  /* Init the blocking queue of the RBH and have it point to the saved data */
-  ((StgRBH *)closure)->blocking_queue = (StgBlockingQueueElement *)rbh_save;
-
-  ASSERT(LOOKS_LIKE_GHC_INFO(RBH_INFOPTR(get_itbl(closure))));
-  /* Turn the closure into a RBH;  a great system, indeed! */
-  SET_INFO(closure, RBH_INFOPTR(get_itbl(closure)));
-
-  /*
-    add closure to the mutable list!
-    do this after having turned the closure into an RBH, because an
-    RBH is mutable but the closure it was before wasn't mutable
-  */
-  recordMutable((StgMutClosure *)closure);
-
-  //IF_GRAN_DEBUG(pack,
-		/* sanity check; make sure that reverting the RBH yields the 
-		   orig closure, again */
-  //ASSERT(REVERT_INFOPTR(get_itbl(closure))==old_info));
-
-  /*
-     Closure layout after this routine has run amuck:
-       +---------------------
-       | RBH-HEADER | |   |  ...
-       +--------------|---|--
-       | FIXED_HS   | |   v
-                      |   Mutable-list ie another StgMutClosure
-		      v
-		      +---------
-		      | RBH_SAVE with 0-2 words of DATA
-		      +---------
-  */
-
-  return closure;
-}
-
-/*
-  An RBH closure is turned into a FETCH_ME when reveiving an ACK message
-  indicating that the transferred closure has been unpacked on the other PE
-  (see processAck in HLComms.c). The ACK also contains the new GA of the
-  closure to which the FETCH_ME closure has to point.
-
-  Converting a closure to a FetchMe is trivial, unless the closure has
-  acquired a blocking queue.  If that has happened, we first have to awaken
-  the blocking queue.  What a nuisance!  Fortunately, @AwakenBlockingQueue@
-  should now know what to do.
-
-  A note on GrAnSim: In GrAnSim we don't have FetchMe closures. However,
-  we have to turn a RBH back to its original form when the simulated
-  transfer of the closure has been finished. Therefore we need the
-  @convertFromRBH@ routine below. After converting the RBH back to its
-  original form and awakening all TSOs, the first TSO will reenter the
-  closure which is now local and carry on merrily reducing it (the other
-  TSO will be less merrily blocked on the now local closure; we're costing
-  the difference between local and global blocks in the BQ code).  -- HWL 
-*/
-
-# if defined(PAR)
-
-EXTFUN(stg_FETCH_ME_info);
-
-//@cindex convertToFetchMe
-void
-convertToFetchMe(rbh, ga)
-StgRBH *rbh;
-globalAddr *ga;
-{
-  // StgInfoTable *ip = get_itbl(rbh);
-  StgBlockingQueueElement *bqe = rbh->blocking_queue;
-
-  ASSERT(get_itbl(rbh)->type==RBH);
-
-  IF_PAR_DEBUG(pack,
-	       belch("**:: Converting RBH %p (%s) into a FETCH_ME for GA ((%x, %d, %x))",
-		     rbh, info_type(rbh), 
-	             ga->payload.gc.gtid, ga->payload.gc.slot, ga->weight)); 
-
-  /* put closure on mutables list, while it is still a RBH */
-  recordMutable((StgMutClosure *)rbh);
-
-  /* actually turn it into a FETCH_ME */
-  SET_INFO((StgClosure *)rbh, &stg_FETCH_ME_info);
-
-  /* set the global pointer in the FETCH_ME closure to the given value */
-  ((StgFetchMe *)rbh)->ga = ga;
-
-  IF_PAR_DEBUG(pack,
-	       if (get_itbl(bqe)->type==TSO || get_itbl(bqe)->type==BLOCKED_FETCH)
-	         belch("**:: Awakening non-empty BQ of RBH closure %p (first TSO is %d (%p)",
-		      rbh, ((StgTSO *)bqe)->id, ((StgTSO *)bqe))); 
-
-  /* awaken all TSOs and BLOCKED_FETCHES on the blocking queue */
-  if (get_itbl(bqe)->type==TSO || get_itbl(bqe)->type==BLOCKED_FETCH)
-    awakenBlockedQueue(bqe, (StgClosure *)rbh);
-}
-# else  /* GRAN */
-/* Prototype */
-// void UnlinkFromMUT(StgPtr closure); 
-
-/*
-  This routine in fact reverts the RBH into its original form; this code 
-  should be of interest for GUM, too, but is not needed in the current version.
-  convertFromRBH is called where GUM uses convertToFetchMe.
-*/
-void
-convertFromRBH(closure)
-StgClosure *closure;
-{
-  StgBlockingQueueElement *bqe = ((StgRBH*)closure)->blocking_queue;
-  char str[NODE_STR_LEN]; // debugging only
-  StgInfoTable *rip = REVERT_INFOPTR(get_itbl(closure));  // debugging only
-
-  IF_GRAN_DEBUG(pack,
-		if (get_itbl(bqe)->type==TSO)
-		  sprintf(str, "%d (%p)", 
-			  ((StgTSO *)bqe)->id, ((StgTSO *)bqe));
-		else 
-		  strcpy(str, "empty");
-		belch("*<:: Reverting RBH %p (%s) into a ??? closure again; BQ start: %s",
-		      closure, info_type(closure), str));
-
-  ASSERT(get_itbl(closure)->type==RBH);
-
-  /* awakenBlockedQueue also restores the RBH_Save closure
-     (have to call it even if there are no TSOs in the queue!) */
-  awakenBlockedQueue(bqe, closure);
-
-  /* Put back old info pointer (grabbed from the RBH's info table).
-     We do that *after* awakening the BQ to be sure node is an RBH when
-     calling awakenBlockedQueue (different in GUM!)
-  */
-  SET_INFO(closure, REVERT_INFOPTR(get_itbl(closure)));
-
-  /* put closure on mutables list */
-  recordMutable((StgMutClosure *)closure);
-
-# if 0 /* rest of this fct */
-    /* ngoq ngo' */
-    /* FETCHME_GA(closure) = ga; */
-    if (IS_MUTABLE(INFO_PTR(bqe))) {
-      PROC old_proc = CurrentProc,        /* NB: For AwakenBlockingQueue, */
-           new_proc = where_is(closure);  /*     CurentProc must be where */
-					  /*     closure lives. */
-      CurrentProc = new_proc;
-
-#  if defined(GRAN_CHECK)
-      if (RTSflags.GranFlags.debug & 0x100)
-        fprintf(stderr,"===== AwBQ of node 0x%lx (%s) [PE %2u]\n",
-	               closure, (isSpec ? "SPEC_RBH" : "GEN_RBH"), new_proc);
-#  endif
-
-      rbh_save = AwakenBlockingQueue(bqe);     /* AwakenBlockingQueue(bqe); */
-      CurrentProc = old_proc;
-    } else {
-        rbh_save = bqe;
-    }
-
-    /* Put data from special RBH save closures back into the closure */
-    if ( rbh_save == NULL ) {
-      fprintf(stderr,"convertFromRBH: No RBH_Save_? closure found at end of BQ!\n");
-      EXIT(EXIT_FAILURE);
-    } else {
-      closure[isSpec ? SPEC_HS : GEN_HS] = rbh_save[SPEC_HS];
-      closure[(isSpec ? SPEC_HS : GEN_HS) + 1] = rbh_save[SPEC_HS + 1];
-    }
-# endif /* 0 */
-
-# if 0 && (defined(GCap) || defined(GCgn))
-    /* ngoq ngo' */
-    /* If we convert from an RBH in the old generation,
-       we have to make sure it goes on the mutables list */
-
-    if(closure <= StorageMgrInfo.OldLim) {
-	if (IS_MUTABLE(INFO_PTR(closure)) && MUT_LINK(closure) == MUT_NOT_LINKED) {
-	    MUT_LINK(closure) = (StgWord) StorageMgrInfo.OldMutables;
-            StorageMgrInfo.OldMutables = closure;
-	}
-    }
-# endif /* 0 */
-}
-#endif /* PAR */
-
-/* Remove closure from the mutables list */
-#if 0
-/* ngoq ngo' */
-void
-UnlinkFromMUT(StgPtr closure) 
-{
-  StgPtr curr = StorageMgrInfo.OldMutables, prev = NULL;
-
-  while (curr != NULL && curr != closure) {
-    ASSERT(MUT_LINK(curr)!=MUT_NOT_LINKED);
-    prev=curr;
-    curr=MUT_LINK(curr); 
-  }
-  if (curr==closure) {   
-   if (prev==NULL) 
-     StorageMgrInfo.OldMutables = MUT_LINK(curr);
-   else   
-     MUT_LINK(prev) = MUT_LINK(curr);
-   MUT_LINK(curr) = MUT_NOT_LINKED;
-  }
-
-#  if 0 && (defined(GCap) || defined(GCgn))
-  {
-    closq newclos;
-    extern closq ex_RBH_q;
-
-    newclos = (closq) stgMallocBytes(sizeof(struct clos), "UnlinkFromMUT");
-    CLOS_CLOSURE(newclos) = closure;
-    CLOS_PREV(newclos) = NULL;
-    CLOS_NEXT(newclos) = ex_RBH_q;
-    if (ex_RBH_q!=NULL)
-      CLOS_PREV(ex_RBH_q) = newclos;
-    ex_RBH_q = newclos;
-  }
-#  endif
-}
-#endif /* PAR */
-
-#endif /* PAR || GRAN -- whole file */
-
-//@node Index,  , Conversion Functions
-//@section Index
-
-//@index
-//* convertToFetchMe::  @cindex\s-+convertToFetchMe
-//* convertToRBH::  @cindex\s-+convertToRBH
-//@end index
diff --git a/ghc/rts/parallel/SysMan.c b/ghc/rts/parallel/SysMan.c
deleted file mode 100644
index 40bcf6a19e..0000000000
--- a/ghc/rts/parallel/SysMan.c
+++ /dev/null
@@ -1,650 +0,0 @@
-/* ----------------------------------------------------------------------------
-   Time-stamp: <Wed Mar 21 2001 17:16:28 Stardate: [-30]6363.59 hwloidl>
-
-   GUM System Manager Program
-   Handles startup, shutdown and global synchronisation of the parallel system.
-
-   The Parade/AQUA Projects, Glasgow University, 1994-1995.
-   GdH/APART Projects, Heriot-Watt University, Edinburgh, 1997-2000.
- 
-   ------------------------------------------------------------------------- */
-
-//@node GUM System Manager Program, , , 
-//@section GUM System Manager Program
-
-//@menu
-//* General docu::		
-//* Includes::			
-//* Macros etc::		
-//* Variables::			
-//* Prototypes::		
-//* Aux startup and shutdown fcts::  
-//* Main fct::			
-//* Message handlers::		
-//* Auxiliary fcts::		
-//* Index::			
-//@end menu
-
-//@node General docu, Includes, GUM System Manager Program, GUM System Manager Program
-//@subsection General docu
-
-/*
-The Sysman task currently controls initiation, termination, of a
-parallel Haskell program running under GUM. In the future it may
-control global GC synchronisation and statistics gathering. Based on
-K. Hammond's SysMan.lc in Graph for PVM. SysMan is unusual in that it
-is not part of the executable produced by ghc: it is a free-standing
-program that spawns PVM tasks (logical PEs) to evaluate the
-program. After initialisation it runs in parallel with the PE tasks,
-awaiting messages.
-
-OK children, buckle down for some serious weirdness, it works like this ...
-
-o The argument vector (argv) for SysMan has one the following 2 shapes:
-
--------------------------------------------------------------------------------
-| SysMan path | debug flag | pvm-executable path | Num. PEs | Program Args ...|
--------------------------------------------------------------------------------
-
--------------------------------------------------------------------
-| SysMan path | pvm-executable path | Num. PEs | Program Args ... |
--------------------------------------------------------------------
-
-The "pvm-executable path" is an absolute path of where PVM stashes the
-code for each PE. The arguments passed on to each PE-executable
-spawned by PVM are:
-
--------------------------------
-| Num. PEs | Program Args ... |
--------------------------------
-
-The arguments passed to the Main-thread PE-executable are
-
--------------------------------------------------------------------
-| main flag | pvm-executable path | Num. PEs | Program Args ... |
--------------------------------------------------------------------
-
-o SysMan's algorithm is as follows.
-
-o use PVM to spawn (nPE-1) PVM tasks 
-o fork SysMan to create the main-thread PE. This permits the main-thread to 
-  read and write to stdin and stdout. 
-o  Wait for all the PE-tasks to reply back saying they are ready and if they were the
-  main thread or not.
-o Broadcast an array of the PE task-ids out to all of the PE-tasks.
-o Enter a loop awaiting incoming messages, e.g. failure, Garbage-collection, 
-  termination.
-
-The forked Main-thread algorithm, in SysMan, is as follows.
-
-o disconnects from PVM.
-o sets a flag in argv to indicate that it is the main thread.
-o `exec's a copy of the pvm-executable (i.e. the program being run)
-
-
-The pvm-executable run by each PE-task, is initialised as follows.
-
-o Registers with PVM, obtaining a task-id.
-o If it was main it gets SysMan's task-id from argv otherwise it can use pvm_parent.
-oSends a ready message to SysMan together with a flag indicating if it was main or not.
-o Receives from SysMan the array of task-ids of the other PEs.
-o If the number of task-ids sent was larger than expected then it must have been a task
-  generated after the rest of the program had started, so it sends its own task-id message
-  to all the tasks it was told about.
-o Begins execution.
-
-*/
-
-//@node Includes, Macros etc, General docu, GUM System Manager Program
-//@subsection Includes
-
-/* Evidently not Posix */
-/* #include "PosixSource.h" */
-
-#include "Rts.h"
-#include "ParTypes.h"
-#include "LLC.h"
-#include "Parallel.h"
-#include "ParallelRts.h" // stats only
-
-//@node Macros etc, Variables, Includes, GUM System Manager Program
-//@subsection Macros etc
-
-/* SysMan is put on top of the GHC routine that does the RtsFlags handling.
-   So, we cannot use the standard macros. For the time being we use a macro
-   that is fixed at compile time.
-*/
-
-#ifdef IF_PAR_DEBUG
-#undef IF_PAR_DEBUG
-#endif
-    
-/* debugging enabled */
-//#define IF_PAR_DEBUG(c,s)  { s; } 
-/* debugging disabled */
-#define IF_PAR_DEBUG(c,s)  /* nothing */
-
-void *stgMallocBytes (int n, char *msg);
-
-//@node Variables, Prototypes, Macros etc, GUM System Manager Program
-//@subsection Variables
-
-/*
-   The following definitions included so that SysMan can be linked with Low
-   Level Communications module (LLComms). They are not used in SysMan.  
-*/
-GlobalTaskId         mytid; 
-
-static unsigned      PEsArrived = 0;
-static GlobalTaskId  gtids[MAX_PES];
-static GlobalTaskId  sysman_id, sender_id;
-static unsigned      PEsTerminated = 0;
-static rtsBool       Finishing = rtsFalse;
-static long          PEbuffer[MAX_PES];
-nat                  nSpawn = 0;    // current no. of spawned tasks (see gtids)
-nat                  nPEs = 0;      // number of PEs specified on startup
-nat                  nextPE;
-/* PVM-ish variables */
-char                 *petask, *pvmExecutable;
-char                 **pargv;
-int                  cc, spawn_flag = PvmTaskDefault;
-
-#if 0 && defined(PAR_TICKY)
-/* ToDo: use allGlobalParStats to collect stats of all PEs */
-GlobalParStats *allGlobalParStats[MAX_PES];
-#endif
-
-//@node Prototypes, Aux startup and shutdown fcts, Variables, GUM System Manager Program
-//@subsection Prototypes
-
-/* prototypes for message handlers called from the main loop of SysMan */
-void newPE(int nbytes, int opcode, int sender_id);
-void readyPE(int nbytes, int opcode, int sender_id);
-void finishPE(int nbytes, int opcode, int sender_id, int exit_code);
-
-//@node Aux startup and shutdown fcts, Main fct, Prototypes, GUM System Manager Program
-//@subsection Aux startup and shutdown fcts
-
-/* 
-   Create the PE Tasks. We spawn (nPEs-1) pvm threads: the Main Thread 
-   (which starts execution and performs IO) is created by forking SysMan 
-*/
-static int
-createPEs(int total_nPEs) {
-  int i, spawn_nPEs, iSpawn = 0, nArch, nHost;
-  struct pvmhostinfo *hostp; 
-  int sysman_host;
-
-  spawn_nPEs = total_nPEs-1;
-  if (spawn_nPEs > 0) {
-    IF_PAR_DEBUG(verbose,
-		 fprintf(stderr, "==== [%x] Spawning %d PEs(%s) ...\n", 
-			 sysman_id, spawn_nPEs, petask);
-		 fprintf(stderr, "  args: ");
-		 for (i = 0; pargv[i]; ++i)
-		   fprintf(stderr, "%s, ", pargv[i]);
-		 fprintf(stderr, "\n"));
-
-    pvm_config(&nHost,&nArch,&hostp);
-    sysman_host=pvm_tidtohost(sysman_id);
-	
-    /* create PEs on the specific machines in the specified order! */
-    for (i=0; (iSpawn<spawn_nPEs) && (i<nHost); i++)
-      if (hostp[i].hi_tid != sysman_host) { 
-	checkComms(pvm_spawn(petask, pargv, spawn_flag+PvmTaskHost, 
-			     hostp[i].hi_name, 1, gtids+iSpawn),
-		   "SysMan startup");
-	IF_PAR_DEBUG(verbose,
-		     fprintf(stderr, "==== [%x] Spawned PE %d onto %s\n",
-			     sysman_id, i, hostp[i].hi_name));
-	iSpawn++;
-      }
-      
-    /* create additional PEs anywhere you like */
-    if (iSpawn<spawn_nPEs) { 
-      checkComms(pvm_spawn(petask, pargv, spawn_flag, "", 
-			   spawn_nPEs-iSpawn, gtids+iSpawn),
-		 "SysMan startup");
-	IF_PAR_DEBUG(verbose,
-		     fprintf(stderr,"==== [%x] Spawned %d additional PEs anywhere\n",
-			     sysman_id, spawn_nPEs-iSpawn));
-      }   
-    }
-
-#if 0
-  /* old code with random placement of PEs; make that a variant? */
-# error "Broken startup in SysMan"
-  { /* let pvm place the PEs anywhere; not used anymore */
-    checkComms(pvm_spawn(petask, pargv, spawn_flag, "", spawn_nPEs, gtids),"SysMan startup");
-    IF_PAR_DEBUG(verbose,
-		 fprintf(stderr,"==== [%x] Spawned\n", sysman_id));
-    
-  }
-#endif    
-
-  // iSpawn=spawn_nPEs; 
-
-  return iSpawn;
-}
-
-/* 
-   Check if this pvm task is in the list of tasks we spawned and are waiting 
-   on, if so then remove it.
-*/
-
-static rtsBool 
-alreadySpawned (GlobalTaskId g) { 
-  unsigned int i;
-
-  for (i=0; i<nSpawn; i++)
-    if (g==gtids[i]) { 
-      nSpawn--;
-      gtids[i] = gtids[nSpawn];  //the last takes its place
-      return rtsTrue;
-    }
-  return rtsFalse;
-}
-
-static void 
-broadcastFinish(void) { 
-  int i,j;
-  int tids[MAX_PES];  /* local buffer of all surviving PEs */
-
-  for (i=0, j=0; i<nPEs; i++) 
-    if (PEbuffer[i]) 
-      tids[j++]=PEbuffer[i]; //extract valid tids
-
-  IF_PAR_DEBUG(verbose,
-    fprintf(stderr,"==== [%x] Broadcasting Finish to %d PEs; initiating shutdown\n", 
-	sysman_id, j));
-
-  /* ToDo: move into LLComms.c */	    	    	    
-  pvm_initsend(PvmDataDefault);
-  pvm_mcast(tids,j,PP_FINISH);
-}
-
-static void 
-broadcastPEtids (void) { 
-  nat i; 
-
-  IF_PAR_DEBUG(verbose,
-    fprintf(stderr,"==== [%x] SysMan sending PE table to all PEs\n", sysman_id);
-    /* debugging */
-    fprintf(stderr,"++++ [%x] PE table as seen by SysMan:\n", mytid);
-    for (i = 0; i < nPEs; i++) { 
-      fprintf(stderr,"++++ PEbuffer[%d] = %x\n", i, PEbuffer[i]);
-    }      	
-  )
-
-  broadcastOpN(PP_PETIDS, PEGROUP, nPEs, &PEbuffer);
-}
-
-//@node Main fct, Message handlers, Aux startup and shutdown fcts, GUM System Manager Program
-//@subsection Main fct
-
-//@cindex main
-int 
-main (int argc, char **argv) {
-  int rbufid;
-  int opcode, nbytes, nSpawn;
-  unsigned int i;
-  
-  setbuf(stdout, NULL);  // disable buffering of stdout
-  setbuf(stderr, NULL);  // disable buffering of stderr
-
-  IF_PAR_DEBUG(verbose,
-	       fprintf(stderr,
-	               "==== RFP: GdH enabled SysMan reporting for duty\n"));
-  
-  if (argc > 1) {
-    if (*argv[1] == '-') {
-      spawn_flag = PvmTaskDebug;
-      argv[1] = argv[0];
-      argv++; argc--;
-    }
-    sysman_id = pvm_mytid();  /* This must be the first PVM call */
-    
-    if (sysman_id<0) { 
-	fprintf(stderr, "==== PVM initialisation failure\n");  
-      	exit(EXIT_FAILURE);  
-    }
-    
-    /* 
-       Get the full path and filename of the pvm executable (stashed in some
-       PVM directory), and the number of PEs from the command line.
-    */
-    pvmExecutable = argv[1];
-    nPEs = atoi(argv[2]);
-    
-    if (nPEs==0) { 
-      /* as usual 0 means infinity: use all PEs specified in PVM config */
-      int nArch, nHost;
-      struct pvmhostinfo *hostp; 
-
-      /* get info on PVM config */
-      pvm_config(&nHost,&nArch,&hostp);
-      nPEs=nHost;
-      sprintf(argv[2],"%d",nPEs); /* ToCheck: does this work on all archs */
-    }	
-
-    /* get the name of the binary to execute */
-    if ((petask = getenv(PETASK)) == NULL)  // PETASK set by driver
-      petask = PETASK;
-
-    IF_PAR_DEBUG(verbose,
-		 fprintf(stderr,"==== [%x] nPEs: %d; executable: |%s|\n", 
-			sysman_id, nPEs, petask));
-    
-    /* Check that we can create the number of PE and IMU tasks requested.
-                                                     ^^^
-       This comment is most entertaining since we haven't been using IMUs 
-       for the last 10 years or so -- HWL */
-    if ((nPEs > MAX_PES) || (nPEs<1)) {
-      fprintf(stderr,"==** SysMan: No more than %d PEs allowed (%d requested)\n     Reconfigure GUM setting MAX_PE in ghc/includes/Parallel.h to a higher value\n", 
-	   MAX_PES, nPEs);
-      exit(EXIT_FAILURE);
-    }
-
-    IF_PAR_DEBUG(verbose,
-		   fprintf(stderr,"==== [%x] is SysMan Task\n", sysman_id));
-
-    /* Initialise the PE task arguments from Sysman's arguments */
-    pargv = argv + 2;
-
-    /* Initialise list of all PE identifiers */
-    PEsArrived=0;  
-    nextPE=1;
-    for (i=0; i<nPEs; i++)
-      PEbuffer[i]=0;
-    
-    /* start up the required number of PEs */
-    nSpawn = createPEs(nPEs);
-    
-    /* 
-       Create the MainThread PE by forking SysMan. This arcane coding 
-       is required to allow MainThread to read stdin and write to stdout.
-       PWT 18/1/96 
-    */
-    //nPEs++;                /* Record that the number of PEs is increasing */
-    if ((cc = fork())) {
-      checkComms(cc,"SysMan fork");         /* Parent continues as SysMan */
-                  
-      PEbuffer[0]=0;    /* we accept the first main and assume its valid. */
-      PEsArrived=1;     /* assume you've got main                         */
-
-      IF_PAR_DEBUG(verbose,
-		   fprintf(stderr,"==== [%x] Sysman successfully initialized!\n",
-			   sysman_id));
-
-//@cindex message handling loop
-      /* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
-      /* Main message handling loop                                         */
-      /* ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
-      /* Process incoming messages */
-      while (1) {
-	if ((rbufid = pvm_recv(ANY_TASK, ANY_OPCODE)) < 0) {
-	  pvm_perror("==** Sysman: Receiving Message (pvm_recv)");
-          /* never reached */
-        }
-
-	pvm_bufinfo(rbufid, &nbytes, &opcode, &sender_id);
-
-        /* very low level debugging
-	IF_PAR_DEBUG(verbose,
-	             fprintf(stderr,"== [%x] SysMan: Message received by SysMan: rbufid=%x, nbytes = %d, opcode = %x, sender_id = %x\n",
-                     sysman_id, rbufid, nbytes, opcode, sender_id));
-	*/
-
-	switch (opcode) {
-	    
-	  case PP_NEWPE: /* a new PE is registering for work */
-	    newPE(nbytes, opcode, sender_id);
-	    break;
-
-          case PP_READY: /* startup complete; let PEs start working */
-	    readyPE(nbytes, opcode, sender_id);
-	    break;
-
-	      
-	  case PP_GC_INIT: /* start global GC */
-	    /* This Function not yet implemented for GUM */
-	    fprintf(stderr,"==** Global GC requested by PE %x. Not yet implemented for GUM!\n", 
-		    sender_id);
-	    break;
-	    
-	  case PP_STATS_ON: /* enable statistics gathering */
-	    fprintf(stderr,"==** PP_STATS_ON requested by %x. Not yet implemented for GUM!\n", 
-		  sender_id);
-	    break;
-
-	  case PP_STATS_OFF: /* disable statistics gathering */
-	    fprintf(stderr,"==** PP_STATS_OFF requested by %x. Not yet implemented for GUM!\n", 
-		  sender_id);
-	    break;
-	    
-	  case PP_FINISH:
-	    { 
-              int exit_code = getExitCode(nbytes, &sender_id);
-	      finishPE(nbytes, opcode, sender_id, exit_code);
-	      break;
-
-	  default:
-	    {
-	     /*		          
-	      char *opname = GetOpName(opcode);
-	      fprintf(stderr,"Sysman: Unrecognised opcode %s (%x)\n",
-	                      opname,opcode);	*/
-	      fprintf(stderr,"==** Qagh: Sysman: Unrecognised opcode (%x)\n",
-		      opcode);
-	    }
-	    break;
-	  } 	/* switch */
-	}	/* else */
-      }		/* while 1 */
-      /* end of SysMan!! */
-    } else {	
-      /* forked main thread begins here */
-      IF_PAR_DEBUG(verbose,
-	           fprintf(stderr, "==== Main Thread PE has been forked; doing an execv(%s,...)\n", 
-	           pvmExecutable));
-      pvmendtask();		 // Disconnect from PVM to avoid confusion:
-                                 // executable reconnects 
-      
-      // RFP: assumes that length(arvv[0])>=9 !!!
-      sprintf(argv[0],"-%08X",sysman_id);  /*flag that its the Main Thread PE and include sysman's id*/
-      execv(pvmExecutable,argv); /* Parent task becomes Main Thread PE */
-    }           /* else */
-  }		/* argc > 1 */  
-}		/* main */
-
-//@node Message handlers, Auxiliary fcts, Main fct, GUM System Manager Program
-//@subsection Message handlers
-
-/*
-   Received PP_NEWPE:
-   A new PE has been added to the configuration.
-*/
-void
-newPE(int nbytes, int opcode, int sender_id) { 
-  IF_PAR_DEBUG(verbose,
-	       fprintf(stderr,"==== [%x] SysMan detected a new host\n",
-		       sysman_id));
-
-  /* Determine the new machine... assume its the last on the config list? */
-  if (nSpawn < MAX_PES) { 
-    int nArch,nHost;
-    struct pvmhostinfo *hostp; 
-
-    /* get conmfiguration of PVM machine */
-    pvm_config(&nHost,&nArch,&hostp);	      
-    nHost--;
-    checkComms(pvm_spawn(petask, pargv, spawn_flag+PvmTaskHost, 
-			 hostp[nHost].hi_name, 1, gtids+nSpawn),
-	       "SysMan loop");
-    nSpawn++;
-    IF_PAR_DEBUG(verbose,
-		 fprintf(stderr, "==== [%x] Spawned onto %s\n",
-			 sysman_id, hostp[nHost].hi_name));
-  }
-}
-	  
-/* 
-   Received PP_READY:
-   Let it be known that PE @sender_id@ participates in the computation.
-*/
-void
-readyPE(int nbytes, int opcode, int sender_id) { 
-  int i = 0, flag = 1;
-  long isMain;
-  int nArch, nHost;
-  struct pvmhostinfo *hostp; 
-
-  //ASSERT(opcode==PP_READY);
-
-  IF_PAR_DEBUG(verbose,
-	       fprintf(stderr,"==== [%x] SysMan received PP_READY message from %x\n",
-		       sysman_id, sender_id));
-
-    pvm_config(&nHost,&nArch,&hostp);
-
-  GetArg1(isMain);
-	      
-  //if ((isMain && (PEbuffer[0]==0)) || alreadySpawned(sender_id)) { 
-    if (nPEs >= MAX_PES) { 
-      fprintf(stderr,"==== [%x] SysMan doesn't need PE %d (max %d PEs allowed)\n",
-	      sysman_id, sender_id, MAX_PES);
-      pvm_kill(sender_id); 
-    } else { 
-      if (isMain) { 
-	IF_PAR_DEBUG(verbose,
-		     fprintf(stderr,"==== [%x] SysMan found Main PE %x\n", 
-			     sysman_id, sender_id));
-	PEbuffer[0]=sender_id;
-      } else { 
-	/* search for PE in list of PEs */
-	for(i=1; i<nPEs; i++)
-	  if (PEbuffer[i]==sender_id) { 
-	    flag=0;
-	    break;
-	  }
-	/* it's a new PE: add it to the list of PEs */
-	if (flag)  
-	  PEbuffer[nextPE++] = sender_id; 
-	
-	IF_PAR_DEBUG(verbose,
-		     fprintf(stderr,"==== [%x] SysMan: found PE %d as [%x] on host %s\n", 
-			     sysman_id, PEsArrived, sender_id, hostp[PEsArrived].hi_name));
-
-	PEbuffer[PEsArrived++] = sender_id;
-      }
-
-		
-      /* enable better handling of unexpected terminations */
-      checkComms( pvm_notify(PvmTaskExit, PP_FINISH, 1, &sender_id),
-	          "SysMan loop");
-
-      /* finished registration of all PEs => enable notification */
-      if ((PEsArrived==nPEs) && PEbuffer[0]) { 
-	checkComms( pvm_notify(PvmHostAdd, PP_NEWPE, -1, 0),
-                    "SysMan startup");
-	IF_PAR_DEBUG(verbose,
-		     fprintf(stderr,"==== [%x] SysMan initialising notificaton for new hosts\n", sysman_id));
-      }
-		
-      /* finished notification => send off the PE ids */
-      if ((PEsArrived>=nPEs) && PEbuffer[0]) { 
-        if (PEsArrived>nPEs) {
-	IF_PAR_DEBUG(verbose,	
-		     fprintf(stderr,"==== [%x] Weird: %d PEs registered, but we only asked for %d\n", sysman_id, PEsArrived, nPEs));
-	// nPEs=PEsArrived;
-        }
-	broadcastPEtids();
-      }
-    }
-}
-
-/* 
-   Received PP_FINISH:
-   Shut down the corresponding PE. Check whether it is a regular shutdown
-   or an uncontrolled termination.
-*/
-void
-finishPE(int nbytes, int opcode, int sender_id, int exitCode) { 
-  int i;
-
-  IF_PAR_DEBUG(verbose,
-	       fprintf(stderr,"==== [%x] SysMan received PP_FINISH message from %x (exit code: %d)\n",
-		       sysman_id, sender_id, exitCode));
-
-  /* Is it relevant to us? Count the first message */
-  for (i=0; i<nPEs; i++) 
-    if (PEbuffer[i] == sender_id) { 
-      PEsTerminated++;
-      PEbuffer[i]=0; 
-	
-      /* handle exit code */
-      if (exitCode<0) {           /* a task exit before a controlled finish? */
-	fprintf(stderr,"==== [%x] Termination at %x with exit(%d)\n", 
-		sysman_id, sender_id, exitCode);
-      } else if (exitCode>0) {		           /* an abnormal exit code? */
-	fprintf(stderr,"==== [%x] Uncontrolled termination at %x with exit(%d)\n", 
-		sysman_id, sender_id, exitCode);	
-      } else if (!Finishing) {             /* exitCode==0 which is good news */
-        if (i!=0) {          /* someone other than main PE terminated first? */
-	 fprintf(stderr,"==== [%x] Unexpected early termination at %x\n", 
-		 sysman_id, sender_id);	
-	} else {
-         /* start shutdown by broadcasting FINISH to other PEs */
-	 IF_PAR_DEBUG(verbose,
-	              fprintf(stderr,"==== [%x] Initiating shutdown (requested by [%x] RIP) (exit code: %d)\n", sysman_id, sender_id, exitCode));
-         Finishing = rtsTrue;
-         broadcastFinish();
-        }
-      }	else {
-         /* we are in a shutdown already */
-	IF_PAR_DEBUG(verbose,
-		     fprintf(stderr,"==== [%x] Finish from %x during shutdown (%d PEs terminated so far; %d total)\n", 
-			     sysman_id, sender_id, PEsTerminated, nPEs));
-      }
-
-      if (PEsTerminated >= nPEs) { 
-        IF_PAR_DEBUG(verbose,
-          fprintf(stderr,"==== [%x] Global Shutdown, Goodbye!! (SysMan has received FINISHes from all PEs)\n", sysman_id));
-        //broadcastFinish();
-	/* received finish from everybody; now, we can exit, too */
-        exit(EXIT_SUCCESS); /* Qapla'! */
-      }
-    }
-}	
-	    
-//@node Auxiliary fcts, Index, Message handlers, GUM System Manager Program
-//@subsection Auxiliary fcts
-
-/* Needed here because its used in loads of places like LLComms etc */
-
-//@cindex stg_exit
-
-/* 
- * called from STG-land to exit the program
- */
-
-void  
-stg_exit(I_ n)
-{
-  fprintf(stderr, "==// [%x] %s in SysMan code; sending PP_FINISH to all PEs ...\n", 
-	    mytid,(n!=0)?"FAILURE":"FINISH");
-  broadcastFinish();
-  //broadcastFinish();
-  pvm_exit();
-  exit(n);
-}
-
-//@node Index,  , Auxiliary fcts, GUM System Manager Program
-//@subsection Index
-
-//@index
-//* main::  @cindex\s-+main
-//* message handling loop::  @cindex\s-+message handling loop
-//* stgMallocBytes::  @cindex\s-+stgMallocBytes
-//* stg_exit::  @cindex\s-+stg_exit
-//@end index
diff --git a/ghc/rts/posix/GetTime.c b/ghc/rts/posix/GetTime.c
deleted file mode 100644
index 3a0764cb91..0000000000
--- a/ghc/rts/posix/GetTime.c
+++ /dev/null
@@ -1,141 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 2005
- *
- * Machine-dependent time measurement functions
- *
- * ---------------------------------------------------------------------------*/
-
-// Not POSIX, due to use of ru_majflt in getPageFaults()
-// #include "PosixSource.h"
-
-#include "Rts.h"
-#include "GetTime.h"
-
-#ifdef HAVE_TIME_H
-# include <time.h>
-#endif
-
-#ifdef HAVE_SYS_TIME_H
-# include <sys/time.h>
-#endif
-
-#if HAVE_SYS_RESOURCE_H
-# include <sys/resource.h>
-#endif
-
-#ifdef HAVE_UNISTD_H
-# include <unistd.h>
-#endif
-
-#ifdef HAVE_SYS_TIMES_H
-# include <sys/times.h>
-#endif
-
-#if ! ((defined(HAVE_GETRUSAGE) && !irix_HOST_OS) || defined(HAVE_TIMES))
-#error No implementation for getProcessCPUTime() available.
-#endif
-
-#if defined(HAVE_GETTIMEOFDAY) && defined(HAVE_GETRUSAGE) && !irix_HOST_OS
-// we'll implement getProcessCPUTime() and getProcessElapsedTime()
-// separately, using getrusage() and gettimeofday() respectively
-
-Ticks getProcessCPUTime(void)
-{
-    struct rusage t;
-    getrusage(RUSAGE_SELF, &t);
-    return (t.ru_utime.tv_sec * TICKS_PER_SECOND + 
-	    ((Ticks)t.ru_utime.tv_usec * TICKS_PER_SECOND)/1000000);
-}
-
-Ticks getProcessElapsedTime(void)
-{
-    struct timeval tv;
-    gettimeofday(&tv, (struct timezone *) NULL);
-    return (tv.tv_sec * TICKS_PER_SECOND +
-	    ((Ticks)tv.tv_usec * TICKS_PER_SECOND)/1000000);
-}
-
-void getProcessTimes(Ticks *user, Ticks *elapsed)
-{
-    *user    = getProcessCPUTime();
-    *elapsed = getProcessElapsedTime();
-}
-
-#elif defined(HAVE_TIMES)
-
-// we'll use the old times() API.
-
-Ticks getProcessCPUTime(void)
-{
-    Ticks user, elapsed;
-    getProcessTimes(&user,&elapsed);
-    return user;
-}
-
-Ticks getProcessElapsedTime(void)
-{
-    Ticks user, elapsed;
-    getProcessTimes(&user,&elapsed);
-    return elapsed;
-}
-
-void getProcessTimes(Ticks *user, Ticks *elapsed)
-{
-    static nat ClockFreq = 0;
-
-    if (ClockFreq == 0) {
-#if defined(HAVE_SYSCONF)
-	long ticks;
-	ticks = sysconf(_SC_CLK_TCK);
-	if ( ticks == -1 ) {
-	    errorBelch("sysconf\n");
-	    stg_exit(EXIT_FAILURE);
-	}
-	ClockFreq = ticks;
-#elif defined(CLK_TCK)		/* defined by POSIX */
-	ClockFreq = CLK_TCK;
-#elif defined(HZ)
-	ClockFreq = HZ;
-#elif defined(CLOCKS_PER_SEC)
-	ClockFreq = CLOCKS_PER_SEC;
-#else
-	errorBelch("can't get clock resolution");
-	stg_exit(EXIT_FAILURE);
-#endif
-    }
-
-    struct tms t;
-    clock_t r = times(&t);
-    *user = (((Ticks)t.tms_utime * TICKS_PER_SECOND) / ClockFreq);
-    *elapsed = (((Ticks)r * TICKS_PER_SECOND) / ClockFreq);
-}
-
-#endif // HAVE_TIMES
-
-Ticks getThreadCPUTime(void)
-{
-#if defined(HAVE_CLOCK_GETTIME) && defined(CLOCK_THREAD_CPUTIME_ID)
-    // clock_gettime() gives us per-thread CPU time.  It isn't
-    // reliable on Linux, but it's the best we have.
-    struct timespec ts;
-    clock_gettime(CLOCK_THREAD_CPUTIME_ID, &ts);
-    return (ts.tv_sec * TICKS_PER_SECOND + 
-	    ((Ticks)ts.tv_nsec * TICKS_PER_SECOND) / 1000000000);
-#else
-    return getProcessCPUTime();
-#endif
-}
-
-nat
-getPageFaults(void)
-{
-#if !defined(HAVE_GETRUSAGE) || irix_HOST_OS
-    return 0;
-#else
-    struct rusage t;
-    getrusage(RUSAGE_SELF, &t);
-    return(t.ru_majflt);
-#endif
-}
-
diff --git a/ghc/rts/posix/Itimer.c b/ghc/rts/posix/Itimer.c
deleted file mode 100644
index 83ed84d6ef..0000000000
--- a/ghc/rts/posix/Itimer.c
+++ /dev/null
@@ -1,226 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1995-1999
- *
- * Interval timer for profiling and pre-emptive scheduling.
- *
- * ---------------------------------------------------------------------------*/
-
-/*
- * The interval timer is used for profiling and for context switching in the
- * threaded build.  Though POSIX 1003.1b includes a standard interface for
- * such things, no one really seems to be implementing them yet.  Even 
- * Solaris 2.3 only seems to provide support for @CLOCK_REAL@, whereas we're
- * keen on getting access to @CLOCK_VIRTUAL@.
- * 
- * Hence, we use the old-fashioned @setitimer@ that just about everyone seems
- * to support.  So much for standards.
- */
-#include "Rts.h"
-#include "RtsFlags.h"
-#include "Timer.h"
-#include "Ticker.h"
-#include "posix/Itimer.h"
-#include "Proftimer.h"
-#include "Schedule.h"
-#include "posix/Select.h"
-
-/* As recommended in the autoconf manual */
-# ifdef TIME_WITH_SYS_TIME
-#  include <sys/time.h>
-#  include <time.h>
-# else
-#  ifdef HAVE_SYS_TIME_H
-#   include <sys/time.h>
-#  else
-#   include <time.h>
-#  endif
-# endif
-
-#ifdef HAVE_SIGNAL_H
-# include <signal.h>
-#endif
-
-/* Major bogosity:
- * 
- * In the threaded RTS, we can't set the virtual timer because the
- * thread which has the virtual timer might be sitting waiting for a
- * capability, and the virtual timer only ticks in CPU time.
- *
- * So, possible solutions:
- *
- * (1) tick in realtime.  Not very good, because this ticker is used for
- *     profiling, and this will give us unreliable time profiling
- *     results.  Furthermore, this requires picking a single OS thread
- *     to be the timekeeper, which is a bad idea because the thread in
- *     question might just be making a temporary call into Haskell land.
- *
- * (2) save/restore the virtual timer around excursions into STG land.
- *     Sounds great, but I tried it and the resolution of the virtual timer
- *     isn't good enough (on Linux) - most of our excursions fall
- *     within the timer's resolution and we never make any progress.
- *   
- * (3) have a virtual timer in every OS thread.  Might be reasonable,
- *     because most of the time there is only ever one of these
- *     threads running, so it approximates a single virtual timer.
- *     But still quite bogus (and I got crashes when I tried this).
- *
- * For now, we're using (1), but this needs a better solution. --SDM
- */
-#ifdef THREADED_RTS
-#define ITIMER_FLAVOUR  ITIMER_REAL
-#define ITIMER_SIGNAL   SIGALRM
-#else
-#define ITIMER_FLAVOUR  ITIMER_VIRTUAL
-#define ITIMER_SIGNAL   SIGVTALRM
-#endif
-
-static
-int
-install_vtalrm_handler(TickProc handle_tick)
-{
-    struct sigaction action;
-
-    action.sa_handler = handle_tick;
-
-    sigemptyset(&action.sa_mask);
-
-#ifdef SA_RESTART
-    // specify SA_RESTART.  One consequence if we don't do this is
-    // that readline gets confused by the -threaded RTS.  It seems
-    // that if a SIGALRM handler is installed without SA_RESTART,
-    // readline installs its own SIGALRM signal handler (see
-    // readline's signals.c), and this somehow causes readline to go
-    // wrong when the input exceeds a single line (try it).
-    action.sa_flags = SA_RESTART;
-#else
-    action.sa_flags = 0;
-#endif
-
-    return sigaction(ITIMER_SIGNAL, &action, NULL);
-}
-
-int
-startTicker(nat ms, TickProc handle_tick)
-{
-# ifndef HAVE_SETITIMER
-  /*    debugBelch("No virtual timer on this system\n"); */
-    return -1;
-# else
-    struct itimerval it;
-
-    install_vtalrm_handler(handle_tick);
-
-#if !defined(THREADED_RTS)
-    timestamp = getourtimeofday();
-#endif
-
-    it.it_value.tv_sec = ms / 1000;
-    it.it_value.tv_usec = 1000 * (ms - (1000 * it.it_value.tv_sec));
-    it.it_interval = it.it_value;
-    return (setitimer(ITIMER_FLAVOUR, &it, NULL));
-# endif
-}
-
-int
-stopTicker()
-{
-# ifndef HAVE_SETITIMER
-  /*    debugBelch("No virtual timer on this system\n"); */
-    return -1;
-# else
-    struct itimerval it;
-  
-    it.it_value.tv_sec = 0;
-    it.it_value.tv_usec = 0;
-    it.it_interval = it.it_value;
-    return (setitimer(ITIMER_FLAVOUR, &it, NULL));
-# endif
-}
-
-# if 0
-/* This is a potential POSIX version */
-int
-startTicker(nat ms)
-{
-    struct sigevent se;
-    struct itimerspec it;
-    timer_t tid;
-
-#if !defined(THREADED_RTS)
-    timestamp = getourtimeofday();
-#endif
-
-    se.sigev_notify = SIGEV_SIGNAL;
-    se.sigev_signo = ITIMER_SIGNAL;
-    se.sigev_value.sival_int = ITIMER_SIGNAL;
-    if (timer_create(CLOCK_VIRTUAL, &se, &tid)) {
-	barf("can't create virtual timer");
-    }
-    it.it_value.tv_sec = ms / 1000;
-    it.it_value.tv_nsec = 1000000 * (ms - 1000 * it.it_value.tv_sec);
-    it.it_interval = it.it_value;
-    return timer_settime(tid, TIMER_RELTIME, &it, NULL);
-}
-
-int
-stopTicker()
-{
-    struct sigevent se;
-    struct itimerspec it;
-    timer_t tid;
-
-#if !defined(THREADED_RTS)
-    timestamp = getourtimeofday();
-#endif
-
-    se.sigev_notify = SIGEV_SIGNAL;
-    se.sigev_signo = ITIMER_SIGNAL;
-    se.sigev_value.sival_int = ITIMER_SIGNAL;
-    if (timer_create(CLOCK_VIRTUAL, &se, &tid)) {
-	barf("can't create virtual timer");
-    }
-    it.it_value.tv_sec = 0;
-    it.it_value.tv_nsec = 0;
-    it.it_interval = it.it_value;
-    return timer_settime(tid, TIMER_RELTIME, &it, NULL);
-}
-# endif
-
-#if 0
-/* Currently unused */
-void
-block_vtalrm_signal(void)
-{
-    sigset_t signals;
-    
-    sigemptyset(&signals);
-    sigaddset(&signals, ITIMER_SIGNAL);
-
-    (void) sigprocmask(SIG_BLOCK, &signals, NULL);
-}
-
-void
-unblock_vtalrm_signal(void)
-{
-    sigset_t signals;
-    
-    sigemptyset(&signals);
-    sigaddset(&signals, ITIMER_SIGNAL);
-
-    (void) sigprocmask(SIG_UNBLOCK, &signals, NULL);
-}
-#endif
-
-/* gettimeofday() takes around 1us on our 500MHz PIII.  Since we're
- * only calling it 50 times/s, it shouldn't have any great impact.
- */
-lnat
-getourtimeofday(void)
-{
-  struct timeval tv;
-  gettimeofday(&tv, (struct timezone *) NULL);
-  	// cast to lnat because nat may be 64 bit when int is only 32 bit
-  return ((lnat)tv.tv_sec * TICK_FREQUENCY +
-	  (lnat)tv.tv_usec * TICK_FREQUENCY / 1000000);
-}
diff --git a/ghc/rts/posix/Itimer.h b/ghc/rts/posix/Itimer.h
deleted file mode 100644
index 09d01bde54..0000000000
--- a/ghc/rts/posix/Itimer.h
+++ /dev/null
@@ -1,19 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1998-2005
- *
- * Interval timer for profiling and pre-emptive scheduling.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef ITIMER_H
-#define ITIMER_H
-
-extern lnat getourtimeofday   ( void );
-#if 0
-/* unused */
-extern void block_vtalrm_signal       ( void );
-extern void unblock_vtalrm_signal     ( void );
-#endif
-
-#endif /* ITIMER_H */
diff --git a/ghc/rts/posix/OSThreads.c b/ghc/rts/posix/OSThreads.c
deleted file mode 100644
index 07bd762130..0000000000
--- a/ghc/rts/posix/OSThreads.c
+++ /dev/null
@@ -1,166 +0,0 @@
-/* ---------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2001-2005
- *
- * Accessing OS threads functionality in a (mostly) OS-independent
- * manner. 
- *
- * --------------------------------------------------------------------------*/
-
-#if defined(DEBUG) && defined(__linux__)
-/* We want GNU extensions in DEBUG mode for mutex error checking */
-#define _GNU_SOURCE
-#endif
-
-#include "Rts.h"
-#if defined(THREADED_RTS)
-#include "OSThreads.h"
-#include "RtsUtils.h"
-
-#if HAVE_STRING_H
-#include <string.h>
-#endif
-
-#if !defined(HAVE_PTHREAD_H)
-#error pthreads.h is required for the threaded RTS on Posix platforms
-#endif
-
-/*
- * This (allegedly) OS threads independent layer was initially
- * abstracted away from code that used Pthreads, so the functions
- * provided here are mostly just wrappers to the Pthreads API.
- *
- */
-
-void
-initCondition( Condition* pCond )
-{
-  pthread_cond_init(pCond, NULL);
-  return;
-}
-
-void
-closeCondition( Condition* pCond )
-{
-  pthread_cond_destroy(pCond);
-  return;
-}
-
-rtsBool
-broadcastCondition ( Condition* pCond )
-{
-  return (pthread_cond_broadcast(pCond) == 0);
-}
-
-rtsBool
-signalCondition ( Condition* pCond )
-{
-  return (pthread_cond_signal(pCond) == 0);
-}
-
-rtsBool
-waitCondition ( Condition* pCond, Mutex* pMut )
-{
-  return (pthread_cond_wait(pCond,pMut) == 0);
-}
-
-void
-yieldThread()
-{
-  sched_yield();
-  return;
-}
-
-void
-shutdownThread()
-{
-  pthread_exit(NULL);
-}
-
-int
-createOSThread (OSThreadId* pId, OSThreadProc *startProc, void *param)
-{
-  int result = pthread_create(pId, NULL, (void *(*)(void *))startProc, param);
-  if(!result)
-    pthread_detach(*pId);
-  return result;
-}
-
-OSThreadId
-osThreadId()
-{
-  return pthread_self();
-}
-
-void
-initMutex(Mutex* pMut)
-{
-#if defined(DEBUG) && defined(linux_HOST_OS)
-    pthread_mutexattr_t attr;
-    pthread_mutexattr_init(&attr);
-    pthread_mutexattr_settype(&attr,PTHREAD_MUTEX_ERRORCHECK_NP);
-    pthread_mutex_init(pMut,&attr);
-#else
-    pthread_mutex_init(pMut,NULL);
-#endif
-    return;
-}
-
-void
-newThreadLocalKey (ThreadLocalKey *key)
-{
-    int r;
-    if ((r = pthread_key_create(key, NULL)) != 0) {
-	barf("newThreadLocalKey: %s", strerror(r));
-    }
-}
-
-void *
-getThreadLocalVar (ThreadLocalKey *key)
-{
-    return pthread_getspecific(*key);
-    // Note: a return value of NULL can indicate that either the key
-    // is not valid, or the key is valid and the data value has not
-    // yet been set.  We need to use the latter case, so we cannot
-    // detect errors here.
-}
-
-void
-setThreadLocalVar (ThreadLocalKey *key, void *value)
-{
-    int r;
-    if ((r = pthread_setspecific(*key,value)) != 0) {
-	barf("setThreadLocalVar: %s", strerror(r));
-    }
-}
-
-static void *
-forkOS_createThreadWrapper ( void * entry )
-{
-    Capability *cap;
-    cap = rts_lock();
-    cap = rts_evalStableIO(cap, (HsStablePtr) entry, NULL);
-    rts_unlock(cap);
-    return NULL;
-}
-
-int
-forkOS_createThread ( HsStablePtr entry )
-{
-    pthread_t tid;
-    int result = pthread_create(&tid, NULL,
-				forkOS_createThreadWrapper, (void*)entry);
-    if(!result)
-        pthread_detach(tid);
-    return result;
-}
-
-#else /* !defined(THREADED_RTS) */
-
-int
-forkOS_createThread ( HsStablePtr entry STG_UNUSED )
-{
-    return -1;
-}
-
-#endif /* !defined(THREADED_RTS) */
diff --git a/ghc/rts/posix/Select.c b/ghc/rts/posix/Select.c
deleted file mode 100644
index e21ced03ab..0000000000
--- a/ghc/rts/posix/Select.c
+++ /dev/null
@@ -1,279 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1995-2002
- *
- * Support for concurrent non-blocking I/O and thread waiting.
- *
- * ---------------------------------------------------------------------------*/
-
-/* we're outside the realms of POSIX here... */
-/* #include "PosixSource.h" */
-
-#include "Rts.h"
-#include "Schedule.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "Timer.h"
-#include "Itimer.h"
-#include "Signals.h"
-#include "Capability.h"
-#include "posix/Select.h"
-
-# ifdef HAVE_SYS_TYPES_H
-#  include <sys/types.h>
-# endif
-
-# ifdef HAVE_SYS_TIME_H
-#  include <sys/time.h>
-# endif
-
-#include <errno.h>
-#include <string.h>
-
-#ifdef HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-
-#if !defined(THREADED_RTS)
-/* last timestamp */
-lnat timestamp = 0;
-
-/* 
- * The threaded RTS uses an IO-manager thread in Haskell instead (see GHC.Conc) 
- */
-
-/* There's a clever trick here to avoid problems when the time wraps
- * around.  Since our maximum delay is smaller than 31 bits of ticks
- * (it's actually 31 bits of microseconds), we can safely check
- * whether a timer has expired even if our timer will wrap around
- * before the target is reached, using the following formula:
- *
- *        (int)((uint)current_time - (uint)target_time) < 0
- *
- * if this is true, then our time has expired.
- * (idea due to Andy Gill).
- */
-static rtsBool
-wakeUpSleepingThreads(lnat ticks)
-{
-    StgTSO *tso;
-    rtsBool flag = rtsFalse;
-
-    while (sleeping_queue != END_TSO_QUEUE &&
-	   (int)(ticks - sleeping_queue->block_info.target) > 0) {
-	tso = sleeping_queue;
-	sleeping_queue = tso->link;
-	tso->why_blocked = NotBlocked;
-	tso->link = END_TSO_QUEUE;
-	IF_DEBUG(scheduler,debugBelch("Waking up sleeping thread %d\n", tso->id));
-	// MainCapability: this code is !THREADED_RTS
-	pushOnRunQueue(&MainCapability,tso);
-	flag = rtsTrue;
-    }
-    return flag;
-}
-
-/* Argument 'wait' says whether to wait for I/O to become available,
- * or whether to just check and return immediately.  If there are
- * other threads ready to run, we normally do the non-waiting variety,
- * otherwise we wait (see Schedule.c).
- *
- * SMP note: must be called with sched_mutex locked.
- *
- * Windows: select only works on sockets, so this doesn't really work,
- * though it makes things better than before. MsgWaitForMultipleObjects
- * should really be used, though it only seems to work for read handles,
- * not write handles.
- *
- */
-void
-awaitEvent(rtsBool wait)
-{
-    StgTSO *tso, *prev, *next;
-    rtsBool ready;
-    fd_set rfd,wfd;
-    int numFound;
-    int maxfd = -1;
-    rtsBool select_succeeded = rtsTrue;
-    rtsBool unblock_all = rtsFalse;
-    struct timeval tv;
-    lnat min, ticks;
-
-    tv.tv_sec  = 0;
-    tv.tv_usec = 0;
-    
-    IF_DEBUG(scheduler,
-	     debugBelch("scheduler: checking for threads blocked on I/O");
-	     if (wait) {
-		 debugBelch(" (waiting)");
-	     }
-	     debugBelch("\n");
-	     );
-
-    /* loop until we've woken up some threads.  This loop is needed
-     * because the select timing isn't accurate, we sometimes sleep
-     * for a while but not long enough to wake up a thread in
-     * a threadDelay.
-     */
-    do {
-
-      ticks = timestamp = getourtimeofday();
-      if (wakeUpSleepingThreads(ticks)) { 
-	  return;
-      }
-
-      if (!wait) {
-	  min = 0;
-      } else if (sleeping_queue != END_TSO_QUEUE) {
-	  min = (sleeping_queue->block_info.target - ticks) 
-	      * TICK_MILLISECS * 1000;
-      } else {
-	  min = 0x7ffffff;
-      }
-
-      /* 
-       * Collect all of the fd's that we're interested in
-       */
-      FD_ZERO(&rfd);
-      FD_ZERO(&wfd);
-
-      for(tso = blocked_queue_hd; tso != END_TSO_QUEUE; tso = next) {
-	next = tso->link;
-
-	switch (tso->why_blocked) {
-	case BlockedOnRead:
-	  { 
-	    int fd = tso->block_info.fd;
-	    if (fd >= FD_SETSIZE) {
-		barf("awaitEvent: descriptor out of range");
-	    }
-	    maxfd = (fd > maxfd) ? fd : maxfd;
-	    FD_SET(fd, &rfd);
-	    continue;
-	  }
-
-	case BlockedOnWrite:
-	  { 
-	    int fd = tso->block_info.fd;
-	    if (fd >= FD_SETSIZE) {
-		barf("awaitEvent: descriptor out of range");
-	    }
-	    maxfd = (fd > maxfd) ? fd : maxfd;
-	    FD_SET(fd, &wfd);
-	    continue;
-	  }
-
-	default:
-	  barf("AwaitEvent");
-	}
-      }
-
-      /* Check for any interesting events */
-      
-      tv.tv_sec  = min / 1000000;
-      tv.tv_usec = min % 1000000;
-
-      while ((numFound = select(maxfd+1, &rfd, &wfd, NULL, &tv)) < 0) {
-	  if (errno != EINTR) {
-	    /* Handle bad file descriptors by unblocking all the
-	       waiting threads. Why? Because a thread might have been
-	       a bit naughty and closed a file descriptor while another
-	       was blocked waiting. This is less-than-good programming
-	       practice, but having the RTS as a result fall over isn't
-	       acceptable, so we simply unblock all the waiting threads
-	       should we see a bad file descriptor & give the threads
-	       a chance to clean up their act. 
-	       
-	       Note: assume here that threads becoming unblocked
-	       will try to read/write the file descriptor before trying
-	       to issue a threadWaitRead/threadWaitWrite again (==> an
-	       IOError will result for the thread that's got the bad
-	       file descriptor.) Hence, there's no danger of a bad
-	       file descriptor being repeatedly select()'ed on, so
-	       the RTS won't loop.
-	    */
-	    if ( errno == EBADF ) {
-	      unblock_all = rtsTrue;
-	      break;
-	    } else {
- 	      perror("select");
-	      barf("select failed");
-	    }
-	  }
-
-	  /* We got a signal; could be one of ours.  If so, we need
-	   * to start up the signal handler straight away, otherwise
-	   * we could block for a long time before the signal is
-	   * serviced.
-	   */
-#if defined(RTS_USER_SIGNALS)
-	  if (signals_pending()) {
-	      startSignalHandlers(&MainCapability);
-	      return; /* still hold the lock */
-	  }
-#endif
-
-	  /* we were interrupted, return to the scheduler immediately.
-	   */
-	  if (sched_state >= SCHED_INTERRUPTING) {
-	      return; /* still hold the lock */
-	  }
-	  
-	  /* check for threads that need waking up 
-	   */
-	  wakeUpSleepingThreads(getourtimeofday());
-	  
-	  /* If new runnable threads have arrived, stop waiting for
-	   * I/O and run them.
-	   */
-	  if (!emptyRunQueue(&MainCapability)) {
-	      return; /* still hold the lock */
-	  }
-      }
-
-      /* Step through the waiting queue, unblocking every thread that now has
-       * a file descriptor in a ready state.
-       */
-
-      prev = NULL;
-      if (select_succeeded || unblock_all) {
-	  for(tso = blocked_queue_hd; tso != END_TSO_QUEUE; tso = next) {
-	      next = tso->link;
-	      switch (tso->why_blocked) {
-	      case BlockedOnRead:
-		  ready = unblock_all || FD_ISSET(tso->block_info.fd, &rfd);
-		  break;
-	      case BlockedOnWrite:
-		  ready = unblock_all || FD_ISSET(tso->block_info.fd, &wfd);
-		  break;
-	      default:
-		  barf("awaitEvent");
-	      }
-      
-	      if (ready) {
-		  IF_DEBUG(scheduler,debugBelch("Waking up blocked thread %d\n", tso->id));
-		  tso->why_blocked = NotBlocked;
-		  tso->link = END_TSO_QUEUE;
-		  pushOnRunQueue(&MainCapability,tso);
-	      } else {
-		  if (prev == NULL)
-		      blocked_queue_hd = tso;
-		  else
-		      prev->link = tso;
-		  prev = tso;
-	      }
-	  }
-
-	  if (prev == NULL)
-	      blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE;
-	  else {
-	      prev->link = END_TSO_QUEUE;
-	      blocked_queue_tl = prev;
-	  }
-      }
-      
-    } while (wait && sched_state == SCHED_RUNNING
-	     && emptyRunQueue(&MainCapability));
-}
-
-#endif /* THREADED_RTS */
diff --git a/ghc/rts/posix/Select.h b/ghc/rts/posix/Select.h
deleted file mode 100644
index 8825562974..0000000000
--- a/ghc/rts/posix/Select.h
+++ /dev/null
@@ -1,26 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 1998-2005
- *
- * Prototypes for functions in Select.c
- *
- * -------------------------------------------------------------------------*/
-
-#ifndef SELECT_H
-#define SELECT_H
-
-#if !defined(THREADED_RTS)
-/* In Select.c */
-extern lnat RTS_VAR(timestamp);
-
-/* awaitEvent(rtsBool wait)
- *
- * Checks for blocked threads that need to be woken.
- *
- * Called from STG :  NO
- * Locks assumed   :  sched_mutex
- */
-void awaitEvent(rtsBool wait);  /* In Select.c */
-#endif
-
-#endif /* SELECT_H */
diff --git a/ghc/rts/posix/Signals.c b/ghc/rts/posix/Signals.c
deleted file mode 100644
index 5f5f77fd39..0000000000
--- a/ghc/rts/posix/Signals.c
+++ /dev/null
@@ -1,510 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Signal processing / handling.
- *
- * ---------------------------------------------------------------------------*/
-
-/* This is non-Posix-compliant.
-   #include "PosixSource.h" 
-*/
-#include "Rts.h"
-#include "SchedAPI.h"
-#include "Schedule.h"
-#include "RtsSignals.h"
-#include "posix/Signals.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-
-#ifdef alpha_HOST_ARCH
-# if defined(linux_HOST_OS)
-#  include <asm/fpu.h>
-# else
-#  include <machine/fpu.h>
-# endif
-#endif
-
-#ifdef HAVE_UNISTD_H
-# include <unistd.h>
-#endif
-
-#ifdef HAVE_SIGNAL_H
-# include <signal.h>
-#endif
-
-#include <stdlib.h>
-
-/* This curious flag is provided for the benefit of the Haskell binding
- * to POSIX.1 to control whether or not to include SA_NOCLDSTOP when
- * installing a SIGCHLD handler. 
- */
-StgInt nocldstop = 0;
-
-/* -----------------------------------------------------------------------------
- * The table of signal handlers
- * -------------------------------------------------------------------------- */
-
-#if defined(RTS_USER_SIGNALS)
-
-/* SUP: The type of handlers is a little bit, well, doubtful... */
-StgInt *signal_handlers = NULL; /* Dynamically grown array of signal handlers */
-static StgInt nHandlers = 0;    /* Size of handlers array */
-
-static nat n_haskell_handlers = 0;
-
-/* -----------------------------------------------------------------------------
- * Allocate/resize the table of signal handlers.
- * -------------------------------------------------------------------------- */
-
-static void
-more_handlers(I_ sig)
-{
-    StgInt i;
-
-    if (sig < nHandlers)
-	return;
-
-    if (signal_handlers == NULL)
-	signal_handlers = (StgInt *)stgMallocBytes((sig + 1) * sizeof(StgInt), "more_handlers");
-    else
-	signal_handlers = (StgInt *)stgReallocBytes(signal_handlers, (sig + 1) * sizeof(StgInt), "more_handlers");
-
-    for(i = nHandlers; i <= sig; i++)
-	// Fill in the new slots with default actions
-	signal_handlers[i] = STG_SIG_DFL;
-
-    nHandlers = sig + 1;
-}
-
-/* -----------------------------------------------------------------------------
- * Pending Handlers
- *
- * The mechanism for starting handlers differs between the threaded
- * (THREADED_RTS) and non-threaded versions of the RTS.
- *
- * When the RTS is single-threaded, we just write the pending signal
- * handlers into a buffer, and start a thread for each one in the
- * scheduler loop.
- *
- * When THREADED_RTS, the problem is that signals might be
- * delivered to multiple threads, so we would need to synchronise
- * access to pending_handler_buf somehow.  Using thread
- * synchronisation from a signal handler isn't possible in general
- * (some OSs support it, eg. MacOS X, but not all).  So instead:
- *
- *   - the signal handler writes the signal number into the pipe
- *     managed by the IO manager thread (see GHC.Conc).
- *   - the IO manager picks up the signal number and calls
- *     startSignalHandler() to start the thread.
- *
- * This also has the nice property that we don't need to arrange to
- * wake up a worker task to start the signal handler: the IO manager
- * wakes up when we write into the pipe.
- *
- * -------------------------------------------------------------------------- */
-
-// Here's the pipe into which we will send our signals
-static int io_manager_pipe = -1;
-
-void
-setIOManagerPipe (int fd)
-{
-    // only called when THREADED_RTS, but unconditionally
-    // compiled here because GHC.Conc depends on it.
-    io_manager_pipe = fd;
-}
-
-#if !defined(THREADED_RTS)
-
-#define N_PENDING_HANDLERS 16
-
-StgPtr pending_handler_buf[N_PENDING_HANDLERS];
-StgPtr *next_pending_handler = pending_handler_buf;
-
-#endif /* THREADED_RTS */
-
-/* -----------------------------------------------------------------------------
- * SIGCONT handler
- *
- * It seems that shells tend to put stdin back into blocking mode
- * following a suspend/resume of the process.  Here we arrange to put
- * it back into non-blocking mode.  We don't do anything to
- * stdout/stderr because these handles don't get put into non-blocking
- * mode at all - see the comments on stdout/stderr in PrelHandle.hsc.
- * -------------------------------------------------------------------------- */
-
-static void
-cont_handler(int sig STG_UNUSED)
-{
-    setNonBlockingFd(0);
-}
-
-/* -----------------------------------------------------------------------------
- * Low-level signal handler
- *
- * Places the requested handler on a stack of pending handlers to be
- * started up at the next context switch.
- * -------------------------------------------------------------------------- */
-
-static void
-generic_handler(int sig)
-{
-    sigset_t signals;
-
-#if defined(THREADED_RTS)
-
-    if (io_manager_pipe != -1)
-    {
-	// Write the signal number into the pipe as a single byte.  We
-	// hope that signals fit into a byte...
-	StgWord8 csig = (StgWord8)sig;
-	write(io_manager_pipe, &csig, 1);
-    }
-    // If the IO manager hasn't told us what the FD of the write end
-    // of its pipe is, there's not much we can do here, so just ignore
-    // the signal..
-
-#else /* not THREADED_RTS */
-
-    /* Can't call allocate from here.  Probably can't call malloc
-       either.  However, we have to schedule a new thread somehow.
-
-       It's probably ok to request a context switch and allow the
-       scheduler to  start the handler thread, but how do we
-       communicate this to the scheduler?
-
-       We need some kind of locking, but with low overhead (i.e. no
-       blocking signals every time around the scheduler).
-       
-       Signal Handlers are atomic (i.e. they can't be interrupted), and
-       we can make use of this.  We just need to make sure the
-       critical section of the scheduler can't be interrupted - the
-       only way to do this is to block signals.  However, we can lower
-       the overhead by only blocking signals when there are any
-       handlers to run, i.e. the set of pending handlers is
-       non-empty.
-    */
-       
-    /* We use a stack to store the pending signals.  We can't
-       dynamically grow this since we can't allocate any memory from
-       within a signal handler.
-
-       Hence unfortunately we have to bomb out if the buffer
-       overflows.  It might be acceptable to carry on in certain
-       circumstances, depending on the signal.  
-    */
-
-    *next_pending_handler++ = deRefStablePtr((StgStablePtr)signal_handlers[sig]);
-
-    // stack full?
-    if (next_pending_handler == &pending_handler_buf[N_PENDING_HANDLERS]) {
-	errorBelch("too many pending signals");
-	stg_exit(EXIT_FAILURE);
-    }
-    
-#endif /* THREADED_RTS */
-
-    // re-establish the signal handler, and carry on
-    sigemptyset(&signals);
-    sigaddset(&signals, sig);
-    sigprocmask(SIG_UNBLOCK, &signals, NULL);
-
-    // *always* do the SIGCONT handler, even if the user overrides it.
-    if (sig == SIGCONT) {
-	cont_handler(sig);
-    }
-
-    context_switch = 1;
-}
-
-/* -----------------------------------------------------------------------------
- * Blocking/Unblocking of the user signals
- * -------------------------------------------------------------------------- */
-
-static sigset_t userSignals;
-static sigset_t savedSignals;
-
-void
-initUserSignals(void)
-{
-    sigemptyset(&userSignals);
-}
-
-void
-blockUserSignals(void)
-{
-    sigprocmask(SIG_BLOCK, &userSignals, &savedSignals);
-}
-
-void
-unblockUserSignals(void)
-{
-    sigprocmask(SIG_SETMASK, &savedSignals, NULL);
-}
-
-rtsBool
-anyUserHandlers(void)
-{
-    return n_haskell_handlers != 0;
-}
-
-#if !defined(THREADED_RTS)
-void
-awaitUserSignals(void)
-{
-    while (!signals_pending() && sched_state == SCHED_RUNNING) {
-	pause();
-    }
-}
-#endif
-
-/* -----------------------------------------------------------------------------
- * Install a Haskell signal handler.
- * -------------------------------------------------------------------------- */
-
-int
-stg_sig_install(int sig, int spi, StgStablePtr *handler, void *mask)
-{
-    sigset_t signals, osignals;
-    struct sigaction action;
-    StgInt previous_spi;
-
-    // Block the signal until we figure out what to do
-    // Count on this to fail if the signal number is invalid
-    if (sig < 0 || sigemptyset(&signals) ||
-	sigaddset(&signals, sig) || sigprocmask(SIG_BLOCK, &signals, &osignals)) {
-	return STG_SIG_ERR;
-    }
-    
-    more_handlers(sig);
-
-    previous_spi = signal_handlers[sig];
-
-    action.sa_flags = 0;
-    
-    switch(spi) {
-    case STG_SIG_IGN:
-    	signal_handlers[sig] = STG_SIG_IGN;
-	sigdelset(&userSignals, sig);
-        action.sa_handler = SIG_IGN;
-    	break;
-    	
-    case STG_SIG_DFL:
-    	signal_handlers[sig] = STG_SIG_DFL;
-	sigdelset(&userSignals, sig);
-        action.sa_handler = SIG_DFL;
-    	break;
-
-    case STG_SIG_HAN:
-    case STG_SIG_RST:
-    	signal_handlers[sig] = (StgInt)*handler;
-	sigaddset(&userSignals, sig);
-    	action.sa_handler = generic_handler;
-	if (spi == STG_SIG_RST) {
-	    action.sa_flags = SA_RESETHAND;
-	}
-	n_haskell_handlers++;
-    	break;
-
-    default:
-        barf("stg_sig_install: bad spi");
-    }
-
-    if (mask != NULL)
-        action.sa_mask = *(sigset_t *)mask;
-    else
-	sigemptyset(&action.sa_mask);
-
-    action.sa_flags |= sig == SIGCHLD && nocldstop ? SA_NOCLDSTOP : 0;
-
-    if (sigaction(sig, &action, NULL) || 
-	sigprocmask(SIG_SETMASK, &osignals, NULL)) 
-    {
-	// need to return an error code, so avoid a stable pointer leak
-	// by freeing the previous handler if there was one.
-	if (previous_spi >= 0) {
-	    freeStablePtr(stgCast(StgStablePtr,signal_handlers[sig]));
-	    n_haskell_handlers--;
-	}
-	return STG_SIG_ERR;
-    }
-
-    if (previous_spi == STG_SIG_DFL || previous_spi == STG_SIG_IGN
-	|| previous_spi == STG_SIG_ERR) {
-	return previous_spi;
-    } else {
-	*handler = (StgStablePtr)previous_spi;
-	return STG_SIG_HAN;
-    }
-}
-
-/* -----------------------------------------------------------------------------
- * Creating new threads for signal handlers.
- * -------------------------------------------------------------------------- */
-
-#if !defined(THREADED_RTS)
-void
-startSignalHandlers(Capability *cap)
-{
-  blockUserSignals();
-  
-  while (next_pending_handler != pending_handler_buf) {
-
-    next_pending_handler--;
-
-    scheduleThread (cap,
-	createIOThread(cap,
-		       RtsFlags.GcFlags.initialStkSize, 
-		       (StgClosure *) *next_pending_handler));
-  }
-
-  unblockUserSignals();
-}
-#endif
-
-/* ----------------------------------------------------------------------------
- * Mark signal handlers during GC.
- *
- * We do this rather than trying to start all the signal handlers
- * prior to GC, because that requires extra heap for the new threads.
- * Signals must be blocked (see blockUserSignals() above) during GC to
- * avoid race conditions.
- * -------------------------------------------------------------------------- */
-
-#if !defined(THREADED_RTS)
-void
-markSignalHandlers (evac_fn evac)
-{
-    StgPtr *p;
-
-    p = next_pending_handler;
-    while (p != pending_handler_buf) {
-	p--;
-	evac((StgClosure **)p);
-    }
-}
-#else
-void
-markSignalHandlers (evac_fn evac STG_UNUSED)
-{
-}
-#endif
-
-#else /* !RTS_USER_SIGNALS */
-StgInt 
-stg_sig_install(StgInt sig STG_UNUSED,
-		StgInt spi STG_UNUSED,
-		StgStablePtr* handler STG_UNUSED,
-		void* mask STG_UNUSED)
-{
-  //barf("User signals not supported");
-  return STG_SIG_DFL;
-}
-
-#endif
-
-#if defined(RTS_USER_SIGNALS)
-/* -----------------------------------------------------------------------------
- * SIGINT handler.
- *
- * We like to shutdown nicely after receiving a SIGINT, write out the
- * stats, write profiling info, close open files and flush buffers etc.
- * -------------------------------------------------------------------------- */
-#ifdef SMP
-pthread_t startup_guy;
-#endif
-
-static void
-shutdown_handler(int sig STG_UNUSED)
-{
-#ifdef SMP
-    // if I'm a worker thread, send this signal to the guy who
-    // originally called startupHaskell().  Since we're handling
-    // the signal, it won't be a "send to all threads" type of signal
-    // (according to the POSIX threads spec).
-    if (pthread_self() != startup_guy) {
-	pthread_kill(startup_guy, sig);
-	return;
-    }
-#endif
-
-    // If we're already trying to interrupt the RTS, terminate with
-    // extreme prejudice.  So the first ^C tries to exit the program
-    // cleanly, and the second one just kills it.
-    if (sched_state >= SCHED_INTERRUPTING) {
-	stg_exit(EXIT_INTERRUPTED);
-    } else {
-	interruptStgRts();
-    }
-}
-
-/* -----------------------------------------------------------------------------
- * Install default signal handlers.
- *
- * The RTS installs a default signal handler for catching
- * SIGINT, so that we can perform an orderly shutdown.
- *
- * Haskell code may install their own SIGINT handler, which is
- * fine, provided they're so kind as to put back the old one
- * when they de-install.
- *
- * In addition to handling SIGINT, the RTS also handles SIGFPE
- * by ignoring it.  Apparently IEEE requires floating-point
- * exceptions to be ignored by default, but alpha-dec-osf3
- * doesn't seem to do so.
- * -------------------------------------------------------------------------- */
-void
-initDefaultHandlers()
-{
-    struct sigaction action,oact;
-
-#ifdef SMP
-    startup_guy = pthread_self();
-#endif
-
-    // install the SIGINT handler
-    action.sa_handler = shutdown_handler;
-    sigemptyset(&action.sa_mask);
-    action.sa_flags = 0;
-    if (sigaction(SIGINT, &action, &oact) != 0) {
-	errorBelch("warning: failed to install SIGINT handler");
-    }
-
-#if defined(HAVE_SIGINTERRUPT)
-    siginterrupt(SIGINT, 1);	// isn't this the default? --SDM
-#endif
-
-    // install the SIGCONT handler
-    action.sa_handler = cont_handler;
-    sigemptyset(&action.sa_mask);
-    action.sa_flags = 0;
-    if (sigaction(SIGCONT, &action, &oact) != 0) {
-	errorBelch("warning: failed to install SIGCONT handler");
-    }
-
-    // install the SIGFPE handler
-
-    // In addition to handling SIGINT, also handle SIGFPE by ignoring it.
-    // Apparently IEEE requires floating-point exceptions to be ignored by
-    // default, but alpha-dec-osf3 doesn't seem to do so.
-
-    // Commented out by SDM 2/7/2002: this causes an infinite loop on
-    // some architectures when an integer division by zero occurs: we
-    // don't recover from the floating point exception, and the
-    // program just generates another one immediately.
-#if 0
-    action.sa_handler = SIG_IGN;
-    sigemptyset(&action.sa_mask);
-    action.sa_flags = 0;
-    if (sigaction(SIGFPE, &action, &oact) != 0) {
-	errorBelch("warning: failed to install SIGFPE handler");
-    }
-#endif
-
-#ifdef alpha_HOST_ARCH
-    ieee_set_fp_control(0);
-#endif
-}
-
-#endif /* RTS_USER_SIGNALS */
diff --git a/ghc/rts/posix/Signals.h b/ghc/rts/posix/Signals.h
deleted file mode 100644
index 39477f8c6a..0000000000
--- a/ghc/rts/posix/Signals.h
+++ /dev/null
@@ -1,26 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2005
- *
- * Signal processing / handling.
- *
- * ---------------------------------------------------------------------------*/
-
-#ifndef POSIX_SIGNALS_H
-#define POSIX_SIGNALS_H
-
-extern rtsBool anyUserHandlers(void);
-
-#if !defined(THREADED_RTS)
-
-extern StgPtr pending_handler_buf[];
-extern StgPtr *next_pending_handler;
-#define signals_pending() (next_pending_handler != pending_handler_buf)
-void startSignalHandlers(Capability *cap);
-
-#endif
-
-extern StgInt *signal_handlers;
-
-#endif /* POSIX_SIGNALS_H */
-
diff --git a/ghc/rts/win32/AsyncIO.c b/ghc/rts/win32/AsyncIO.c
deleted file mode 100644
index 7bcf571cf8..0000000000
--- a/ghc/rts/win32/AsyncIO.c
+++ /dev/null
@@ -1,345 +0,0 @@
-/* AsyncIO.c
- *
- * Integrating Win32 asynchronous I/O with the GHC RTS.
- *
- * (c) sof, 2002-2003.
- */
-#include "Rts.h"
-#include "RtsUtils.h"
-#include <windows.h>
-#include <stdio.h>
-#include "Schedule.h"
-#include "RtsFlags.h"
-#include "Capability.h"
-#include "win32/AsyncIO.h"
-#include "win32/IOManager.h"
-
-/*
- * Overview:
- *
- * Haskell code issue asynchronous I/O requests via the 
- * async{Read,Write,DoOp}# primops. These cause addIORequest()
- * to be invoked, which forwards the request to the underlying
- * asynchronous I/O subsystem. Each request is tagged with a unique
- * ID.
- *
- * addIORequest() returns this ID, so that when the blocked CH
- * thread is added onto blocked_queue, its TSO is annotated with
- * it. Upon completion of an I/O request, the async I/O handling
- * code makes a back-call to signal its completion; the local
- * onIOComplete() routine. It adds the IO request ID (along with
- * its result data) to a queue of completed requests before returning. 
- *
- * The queue of completed IO request is read by the thread operating
- * the RTS scheduler. It de-queues the CH threads corresponding
- * to the request IDs, making them runnable again.
- *
- */
-
-typedef struct CompletedReq {
-    unsigned int   reqID;
-    int            len;
-    int            errCode;
-} CompletedReq;
-
-#define MAX_REQUESTS 200
-
-static CRITICAL_SECTION queue_lock;
-static HANDLE           completed_req_event;
-static HANDLE           abandon_req_wait;
-static HANDLE           wait_handles[2];
-static CompletedReq     completedTable[MAX_REQUESTS];
-static int              completed_hw;
-static HANDLE           completed_table_sema;
-static int              issued_reqs;
-
-static void
-onIOComplete(unsigned int reqID,
-	     int   fd STG_UNUSED,
-	     int   len,
-	     void* buf STG_UNUSED,
-	     int   errCode)
-{
-    DWORD dwRes;
-    /* Deposit result of request in queue/table..when there's room. */
-    dwRes = WaitForSingleObject(completed_table_sema, INFINITE);
-    switch (dwRes) {
-    case WAIT_OBJECT_0:
-	break;
-    default:
-	/* Not likely */
-	fprintf(stderr, "onIOComplete: failed to grab table semaphore, dropping request 0x%x\n", reqID);
-	fflush(stderr);
-	return;
-    }
-    EnterCriticalSection(&queue_lock);
-    if (completed_hw == MAX_REQUESTS) {
-	/* Shouldn't happen */
-	fprintf(stderr, "onIOComplete: ERROR -- Request table overflow (%d); dropping.\n", reqID);
-	fflush(stderr);
-    } else {
-#if 0
-	fprintf(stderr, "onCompl: %d %d %d %d %d\n", 
-		reqID, len, errCode, issued_reqs, completed_hw); 
-	fflush(stderr);
-#endif
-	completedTable[completed_hw].reqID   = reqID;
-	completedTable[completed_hw].len     = len;
-	completedTable[completed_hw].errCode = errCode;
-	completed_hw++;
-	issued_reqs--;
-	if (completed_hw == 1) {
-	    /* The event is used to wake up the scheduler thread should it
-	     * be blocked waiting for requests to complete. The event resets once
-	     * that thread has cleared out the request queue/table.
-	     */
-	    SetEvent(completed_req_event);
-	}
-    }
-    LeaveCriticalSection(&queue_lock);
-}
-
-unsigned int
-addIORequest(int   fd,
-	     int   forWriting,
-	     int   isSock,
-	     int   len,
-	     char* buf)
-{
-    EnterCriticalSection(&queue_lock);
-    issued_reqs++;
-    LeaveCriticalSection(&queue_lock);
-#if 0
-    fprintf(stderr, "addIOReq: %d %d %d\n", fd, forWriting, len); fflush(stderr);
-#endif
-    return AddIORequest(fd,forWriting,isSock,len,buf,onIOComplete);
-}
-
-unsigned int
-addDelayRequest(int msecs)
-{
-    EnterCriticalSection(&queue_lock);
-    issued_reqs++;
-    LeaveCriticalSection(&queue_lock);
-#if 0
-    fprintf(stderr, "addDelayReq: %d\n", msecs); fflush(stderr);
-#endif
-    return AddDelayRequest(msecs,onIOComplete);
-}
-
-unsigned int
-addDoProcRequest(void* proc, void* param)
-{
-    EnterCriticalSection(&queue_lock);
-    issued_reqs++;
-    LeaveCriticalSection(&queue_lock);
-#if 0
-    fprintf(stderr, "addProcReq: %p %p\n", proc, param); fflush(stderr);
-#endif
-    return AddProcRequest(proc,param,onIOComplete);
-}
-
-
-int
-startupAsyncIO()
-{
-    if (!StartIOManager()) {
-	return 0;
-    }
-    InitializeCriticalSection(&queue_lock);
-    /* Create a pair of events:
-     *
-     *    - completed_req_event  -- signals the deposit of request result; manual reset.
-     *    - abandon_req_wait     -- external OS thread tells current RTS/Scheduler
-     *                              thread to abandon wait for IO request completion.
-     *                              Auto reset.
-     */
-    completed_req_event = CreateEvent (NULL, TRUE,  FALSE, NULL);
-    abandon_req_wait    = CreateEvent (NULL, FALSE, FALSE, NULL);
-    wait_handles[0] = completed_req_event;
-    wait_handles[1] = abandon_req_wait;
-    completed_hw = 0;
-    if ( !(completed_table_sema = CreateSemaphore (NULL, MAX_REQUESTS, MAX_REQUESTS, NULL)) ) {
-	DWORD rc = GetLastError();
-	fprintf(stderr, "startupAsyncIO: CreateSemaphore failed 0x%x\n", rc);
-	fflush(stderr);
-    }
-
-    return ( completed_req_event  != INVALID_HANDLE_VALUE &&
-	     abandon_req_wait     != INVALID_HANDLE_VALUE &&
-	     completed_table_sema != NULL );
-}
-
-void
-shutdownAsyncIO()
-{
-    CloseHandle(completed_req_event);
-    ShutdownIOManager();
-}
-
-/*
- * Function: awaitRequests(wait)
- *
- * Check for the completion of external IO work requests. Worker
- * threads signal completion of IO requests by depositing them
- * in a table (completedTable). awaitRequests() matches up 
- * requests in that table with threads on the blocked_queue, 
- * making the threads whose IO requests have completed runnable
- * again.
- * 
- * awaitRequests() is called by the scheduler periodically _or_ if
- * it is out of work, and need to wait for the completion of IO
- * requests to make further progress. In the latter scenario, 
- * awaitRequests() will simply block waiting for worker threads 
- * to complete if the 'completedTable' is empty.
- */
-int
-awaitRequests(rtsBool wait)
-{
-#ifndef THREADED_RTS
-  // none of this is actually used in the threaded RTS
-
-start:
-#if 0
-    fprintf(stderr, "awaitRequests(): %d %d %d\n", issued_reqs, completed_hw, wait);
-    fflush(stderr);
-#endif
-    EnterCriticalSection(&queue_lock);
-    /* Nothing immediately available & we won't wait */
-    if ((!wait && completed_hw == 0)
-#if 0
-	// If we just return when wait==rtsFalse, we'll go into a busy
-	// wait loop, so I disabled this condition --SDM 18/12/2003
-	(issued_reqs == 0 && completed_hw == 0)
-#endif
-	) {
-	LeaveCriticalSection(&queue_lock);
-	return 0;
-    }
-    if (completed_hw == 0) {
-	/* empty table, drop lock and wait */
-	LeaveCriticalSection(&queue_lock);
-	if ( wait && sched_state == SCHED_RUNNING ) {
-	    DWORD dwRes = WaitForMultipleObjects(2, wait_handles, FALSE, INFINITE);
-	    switch (dwRes) {
-	    case WAIT_OBJECT_0:
-		/* a request was completed */
-		break;
-	    case WAIT_OBJECT_0 + 1:
-	    case WAIT_TIMEOUT:
-		/* timeout (unlikely) or told to abandon waiting */
-		return 0;
-	    case WAIT_FAILED: {
-		DWORD dw = GetLastError();
-		fprintf(stderr, "awaitRequests: wait failed -- error code: %lu\n", dw); fflush(stderr);
-		return 0;
-	    }
-	    default:
-		fprintf(stderr, "awaitRequests: unexpected wait return code %lu\n", dwRes); fflush(stderr);
-		return 0;
-	    }
-	} else {
-	    return 0;
-	}
-	goto start;
-    } else {
-	int i;
-	StgTSO *tso, *prev;
-	
-	for (i=0; i < completed_hw; i++) {
-	    /* For each of the completed requests, match up their Ids
-	     * with those of the threads on the blocked_queue. If the
-	     * thread that made the IO request has been subsequently
-	     * killed (and removed from blocked_queue), no match will
-	     * be found for that request Id. 
-	     *
-	     * i.e., killing a Haskell thread doesn't attempt to cancel
-	     * the IO request it is blocked on.
-	     *
-	     */
-	    unsigned int rID = completedTable[i].reqID;
-	    
-	    prev = NULL;
-	    for(tso = blocked_queue_hd ; tso != END_TSO_QUEUE; prev = tso, tso = tso->link) {
-	
-		switch(tso->why_blocked) {
-		case BlockedOnRead:
-		case BlockedOnWrite:
-		case BlockedOnDoProc:
-		    if (tso->block_info.async_result->reqID == rID) {
-			/* Found the thread blocked waiting on request; stodgily fill 
-			 * in its result block. 
-			 */
-			tso->block_info.async_result->len = completedTable[i].len;
-			tso->block_info.async_result->errCode = completedTable[i].errCode;
-			
-			/* Drop the matched TSO from blocked_queue */
-			if (prev) {
-			    prev->link = tso->link;
-			} else {
-			    blocked_queue_hd = tso->link;
-			}
-			if (blocked_queue_tl == tso) {
-			    blocked_queue_tl = prev ? prev : END_TSO_QUEUE;
-			}
-		    
-			/* Terminates the run queue + this inner for-loop. */
-			tso->link = END_TSO_QUEUE;
-			tso->why_blocked = NotBlocked;
-			pushOnRunQueue(&MainCapability, tso);
-			break;
-		    }
-		    break;
-		default:
-		    if (tso->why_blocked != NotBlocked) {
-			barf("awaitRequests: odd thread state");
-		    }
-		    break;
-		}
-	    }
-	    /* Signal that there's completed table slots available */
-	    if ( !ReleaseSemaphore(completed_table_sema, 1, NULL) ) {
-		DWORD dw = GetLastError();
-		fprintf(stderr, "awaitRequests: failed to signal semaphore (error code=0x%x)\n", dw);
-		fflush(stderr);
-	    }
-	}
-	completed_hw = 0;
-	ResetEvent(completed_req_event);
-	LeaveCriticalSection(&queue_lock);
-	return 1;
-    }
-#endif /* !THREADED_RTS */
-}
-
-/*
- * Function: abandonRequestWait()
- *
- * Wake up a thread that's blocked waiting for new IO requests
- * to complete (via awaitRequests().)
- */
-void
-abandonRequestWait( void )
-{
-    /* the event is auto-reset, but in case there's no thread
-     * already waiting on the event, we want to return it to
-     * a non-signalled state.
-     *
-     * Careful!  There is no synchronisation between
-     * abandonRequestWait and awaitRequest, which means that
-     * abandonRequestWait might be called just before a thread
-     * goes into a wait, and we miss the abandon signal.  So we
-     * must SetEvent() here rather than PulseEvent() to ensure
-     * that the event isn't lost.  We can re-optimise by resetting
-     * the event somewhere safe if we know the event has been
-     * properly serviced (see resetAbandon() below).  --SDM 18/12/2003
-     */
-    SetEvent(abandon_req_wait);
-}
-
-void
-resetAbandonRequestWait( void )
-{
-    ResetEvent(abandon_req_wait);
-}
-
diff --git a/ghc/rts/win32/AsyncIO.h b/ghc/rts/win32/AsyncIO.h
deleted file mode 100644
index 2077ea0cf7..0000000000
--- a/ghc/rts/win32/AsyncIO.h
+++ /dev/null
@@ -1,25 +0,0 @@
-/* AsyncIO.h
- *
- * Integrating Win32 asynchronous I/O with the GHC RTS.
- *
- * (c) sof, 2002-2003.
- */
-#ifndef __ASYNCHIO_H__
-#define __ASYNCHIO_H__
-extern unsigned int
-addIORequest(int   fd,
-	     int   forWriting,
-	     int   isSock,
-	     int   len,
-	     char* buf);
-extern unsigned int addDelayRequest(int   msecs);
-extern unsigned int addDoProcRequest(void* proc, void* param);
-extern int  startupAsyncIO(void);
-extern void shutdownAsyncIO(void);
-
-extern int awaitRequests(rtsBool wait);
-
-extern void abandonRequestWait(void);
-extern void resetAbandonRequestWait(void);
-
-#endif /* __ASYNCHIO_H__ */
diff --git a/ghc/rts/win32/AwaitEvent.c b/ghc/rts/win32/AwaitEvent.c
deleted file mode 100644
index 43e188fb34..0000000000
--- a/ghc/rts/win32/AwaitEvent.c
+++ /dev/null
@@ -1,51 +0,0 @@
-#if !defined(THREADED_RTS) /* to the end */
-/*
- * Wait/check for external events. Periodically, the
- * Scheduler checks for the completion of external operations,
- * like the expiration of timers, completion of I/O requests
- * issued by Haskell threads.
- *
- * If the Scheduler is otherwise out of work, it'll block
- * herein waiting for external events to occur.
- *
- * This file mirrors the select()-based functionality 
- * for POSIX / Unix platforms in rts/Select.c, but for
- * Win32.
- *
- */
-#include "Rts.h"
-#include "Schedule.h"
-#include "AwaitEvent.h"
-#include <windows.h>
-#include "win32/AsyncIO.h"
-
-// Used to avoid calling abandonRequestWait() if we don't need to.
-// Protected by sched_mutex.
-static nat workerWaitingForRequests = 0;
-
-void
-awaitEvent(rtsBool wait)
-{
-  int ret;
-
-  do {
-    /* Try to de-queue completed IO requests
-     */
-    workerWaitingForRequests = 1;
-    ret = awaitRequests(wait);
-    workerWaitingForRequests = 0;
-    if (!ret) { 
-      return; /* still hold the lock */
-    }
-
-    // Return to the scheduler if:
-    //
-    //  - we were interrupted
-    //  - new threads have arrived
-
-  } while (wait
-	   && sched_state == SCHED_RUNNING
-	   && emptyRunQueue(&MainCapability)
-      );
-}
-#endif
diff --git a/ghc/rts/win32/ConsoleHandler.c b/ghc/rts/win32/ConsoleHandler.c
deleted file mode 100644
index d7096db632..0000000000
--- a/ghc/rts/win32/ConsoleHandler.c
+++ /dev/null
@@ -1,313 +0,0 @@
-/*
- * Console control handler support.
- *
- */
-#include "Rts.h"
-#include <windows.h>
-#include "ConsoleHandler.h"
-#include "SchedAPI.h"
-#include "Schedule.h"
-#include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "AsyncIO.h"
-#include "RtsSignals.h"
-
-extern int stg_InstallConsoleEvent(int action, StgStablePtr *handler);
-
-static BOOL WINAPI shutdown_handler(DWORD dwCtrlType);
-static BOOL WINAPI generic_handler(DWORD dwCtrlType);
-
-static rtsBool deliver_event = rtsTrue;
-static StgInt console_handler = STG_SIG_DFL;
-
-static HANDLE hConsoleEvent = INVALID_HANDLE_VALUE;
-
-#define N_PENDING_EVENTS 16
-StgInt stg_pending_events = 0;           /* number of undelivered events */
-DWORD stg_pending_buf[N_PENDING_EVENTS]; /* their associated event numbers. */
-
-/*
- * Function: initUserSignals()
- *
- * Initialize the console handling substrate.
- */
-void
-initUserSignals(void)
-{
-    stg_pending_events = 0;
-    console_handler = STG_SIG_DFL;
-    if (hConsoleEvent == INVALID_HANDLE_VALUE) {
-	hConsoleEvent = 
-	    CreateEvent ( NULL,  /* default security attributes */
-			  TRUE,  /* manual-reset event */
-			  FALSE, /* initially non-signalled */
-			  NULL); /* no name */
-    }
-    return;
-}
-
-/*
- * Function: shutdown_handler()
- *
- * Local function that performs the default handling of Ctrl+C kind
- * events; gently shutting down the RTS
- *
- * To repeat Signals.c remark -- user code may choose to override the
- * default handler. Which is fine, assuming they put back the default
- * handler when/if they de-install the custom handler.
- * 
- */
-static BOOL WINAPI shutdown_handler(DWORD dwCtrlType)
-{
-    switch (dwCtrlType) {
-    
-    case CTRL_CLOSE_EVENT:
-	/* see generic_handler() comment re: this event */
-	return FALSE;
-    case CTRL_C_EVENT:
-    case CTRL_BREAK_EVENT:
-
-	// If we're already trying to interrupt the RTS, terminate with
-	// extreme prejudice.  So the first ^C tries to exit the program
-	// cleanly, and the second one just kills it.
-	if (sched_state >= SCHED_INTERRUPTING) {
-	    stg_exit(EXIT_INTERRUPTED);
-	} else {
-	    interruptStgRts();
-	    /* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
-	    abandonRequestWait();
-	    resetAbandonRequestWait();
-	}
-	return TRUE;
-
-	/* shutdown + logoff events are not handled here. */
-    default:
-	return FALSE;
-    }
-}
-
-
-/*
- * Function: initDefaultHandlers()
- *
- * Install any default signal/console handlers. Currently we install a
- * Ctrl+C handler that shuts down the RTS in an orderly manner.
- */
-void initDefaultHandlers(void)
-{
-    if ( !SetConsoleCtrlHandler(shutdown_handler, TRUE) ) {
-	errorBelch("warning: failed to install default console handler");
-    }
-}
-
-
-/*
- * Function: blockUserSignals()
- *
- * Temporarily block the delivery of further console events. Needed to
- * avoid race conditions when GCing the stack of outstanding handlers or
- * when emptying the stack by running the handlers.
- * 
- */
-void
-blockUserSignals(void)
-{
-    deliver_event = rtsFalse;
-}
-
-
-/*
- * Function: unblockUserSignals()
- *
- * The inverse of blockUserSignals(); re-enable the deliver of console events.
- */
-void
-unblockUserSignals(void)
-{
-    deliver_event = rtsTrue;
-}
-
-
-/*
- * Function: awaitUserSignals()
- *
- * Wait for the next console event. Currently a NOP (returns immediately.)
- */
-void awaitUserSignals(void)
-{
-    return;
-}
-
-
-/*
- * Function: startSignalHandlers()
- *
- * Run the handlers associated with the stacked up console events. Console
- * event delivery is blocked for the duration of this call.
- */
-void startSignalHandlers(Capability *cap)
-{
-    StgStablePtr handler;
-
-    if (console_handler < 0) {
-	return;
-    }
-
-    blockUserSignals();
-    ACQUIRE_LOCK(&sched_mutex);
-    
-    handler = deRefStablePtr((StgStablePtr)console_handler);
-    while (stg_pending_events > 0) {
-	stg_pending_events--;
-	scheduleThread(cap,
-	    createIOThread(cap,
-			   RtsFlags.GcFlags.initialStkSize, 
-			   rts_apply(cap,
-				     (StgClosure *)handler,
-				     rts_mkInt(cap,
-					       stg_pending_buf[stg_pending_events]))));
-    }
-    
-    RELEASE_LOCK(&sched_mutex);
-    unblockUserSignals();
-}
-
-/*
- * Function: markSignalHandlers()
- *
- * Evacuate the handler stack. _Assumes_ that console event delivery
- * has already been blocked.
- */
-void markSignalHandlers (evac_fn evac)
-{
-    if (console_handler >= 0) {
-	StgPtr p = deRefStablePtr((StgStablePtr)console_handler);
-	evac((StgClosure**)(void *)&p);
-    }
-}
-
-
-/* 
- * Function: generic_handler()
- *
- * Local function which handles incoming console event (done in a sep OS thread),
- * recording the event in stg_pending_events. 
- */
-static BOOL WINAPI generic_handler(DWORD dwCtrlType)
-{
-    ACQUIRE_LOCK(&sched_mutex);
-
-    /* Ultra-simple -- up the counter + signal a switch. */
-    switch(dwCtrlType) {
-    case CTRL_CLOSE_EVENT:
-	/* Don't support the delivery of this event; if we
-	 * indicate that we've handled it here and the Haskell handler
-	 * doesn't take proper action (e.g., terminate the OS process),
-	 * the user of the app will be unable to kill/close it. Not
-	 * good, so disable the delivery for now.
-	 */
-	return FALSE;
-    default:
-	if (!deliver_event) return TRUE;
-
-	if ( stg_pending_events < N_PENDING_EVENTS ) {
-	    stg_pending_buf[stg_pending_events] = dwCtrlType;
-	    stg_pending_events++;
-	}
-	/* Cheesy pulsing of an event to wake up a waiting RTS thread, if any */
-	abandonRequestWait();
-	resetAbandonRequestWait();
-	return TRUE;
-    }
-
-    RELEASE_LOCK(&sched_mutex);
-}
-
-
-/*
- * Function: rts_InstallConsoleEvent()
- *
- * Install/remove a console event handler.
- */
-int
-rts_InstallConsoleEvent(int action, StgStablePtr *handler)
-{
-    StgInt previous_hdlr = console_handler;
-
-    switch (action) {
-    case STG_SIG_IGN:
-	console_handler = STG_SIG_IGN;
-	if ( !SetConsoleCtrlHandler(NULL, TRUE) ) {
-	    errorBelch("warning: unable to ignore console events");
-	}
-	break;
-    case STG_SIG_DFL:
-	console_handler = STG_SIG_IGN;
-	if ( !SetConsoleCtrlHandler(NULL, FALSE) ) {
-	    errorBelch("warning: unable to restore default console event handling");
-	}
-	break;
-    case STG_SIG_HAN:
-	console_handler = (StgInt)*handler;
-	if ( previous_hdlr < 0 ) {
-	  /* Only install generic_handler() once */
-	  if ( !SetConsoleCtrlHandler(generic_handler, TRUE) ) {
-	    errorBelch("warning: unable to install console event handler");
-	  }
-	}
-	break;
-    }
-    
-    if (previous_hdlr == STG_SIG_DFL || 
-	previous_hdlr == STG_SIG_IGN) {
-	return previous_hdlr;
-    } else {
-	*handler = (StgStablePtr)previous_hdlr;
-	return STG_SIG_HAN;
-    }
-}
-
-/*
- * Function: rts_HandledConsoleEvent()
- *
- * Signal that a Haskell console event handler has completed its run.
- * The explicit notification that a Haskell handler has completed is 
- * required to better handle the delivery of Ctrl-C/Break events whilst
- * an async worker thread is handling a read request on stdin. The 
- * Win32 console implementation will abort such a read request when Ctrl-C
- * is delivered. That leaves the worker thread in a bind: should it 
- * abandon the request (the Haskell thread reading from stdin has been 
- * thrown an exception to signal the delivery of Ctrl-C & hence have 
- * aborted the I/O request) or simply ignore the aborted read and retry?
- * (the Haskell thread reading from stdin isn't concerned with the
- * delivery and handling of Ctrl-C.) With both scenarios being
- * possible, the worker thread needs to be told -- that is, did the
- * console event handler cause the IO request to be abandoned? 
- *
- */
-void
-rts_ConsoleHandlerDone(int ev)
-{
-    if ( (DWORD)ev == CTRL_BREAK_EVENT ||
-	 (DWORD)ev == CTRL_C_EVENT ) {
-	/* only these two cause stdin system calls to abort.. */
-	SetEvent(hConsoleEvent); /* event is manual-reset */
-	Sleep(0); /* yield */
-	ResetEvent(hConsoleEvent); /* turn it back off again */
-    }
-}
-
-/*
- * Function: rts_waitConsoleHandlerCompletion()
- *
- * Esoteric entry point used by worker thread that got woken
- * up as part Ctrl-C delivery.
- */
-int
-rts_waitConsoleHandlerCompletion()
-{
-    /* As long as the worker doesn't need to do a multiple wait,
-     * let's keep this HANDLE private to this 'module'.
-     */
-    return (WaitForSingleObject(hConsoleEvent, INFINITE) == WAIT_OBJECT_0);
-}
diff --git a/ghc/rts/win32/ConsoleHandler.h b/ghc/rts/win32/ConsoleHandler.h
deleted file mode 100644
index b09adf71cb..0000000000
--- a/ghc/rts/win32/ConsoleHandler.h
+++ /dev/null
@@ -1,63 +0,0 @@
-/*
- * Console control handler support.
- *
- */
-#ifndef __CONSOLEHANDLER_H__
-#define __CONSOLEHANDLER_H__
-
-/*
- * Console control handlers lets an application handle Ctrl+C, Ctrl+Break etc.
- * in Haskell under Win32. Akin to the Unix signal SIGINT.
- *
- * The API offered by ConsoleHandler.h is identical to that of the signal handling
- * code (which isn't supported under win32.) Unsurprisingly, the underlying impl 
- * is derived from the signal handling code also.
- */
-
-/*
- * Function: signals_pending() 
- * 
- * Used by the RTS to check whether new signals have been 'recently' reported.
- * If so, the RTS arranges for the delivered signals to be handled by 
- * de-queueing them from their table, running the associated Haskell 
- * signal handler.
- */
-extern StgInt stg_pending_events;
-
-#define signals_pending() ( stg_pending_events > 0)
-
-/* 
- * Function: anyUserHandlers()
- *
- * Used by the Scheduler to decide whether its worth its while to stick
- * around waiting for an external signal when there are no threads
- * runnable. A console handler is used to handle termination events (Ctrl+C)
- * and isn't considered a 'user handler'.
- */
-#define anyUserHandlers() (rtsFalse)
-
-/*
- * Function: startSignalHandlers()
- *
- * Run the handlers associated with the queued up console events. Console
- * event delivery is blocked for the duration of this call.
- */
-extern void startSignalHandlers(Capability *cap);
-
-/*
- * Function: handleSignalsInThisThread()
- * 
- * Have current (OS) thread assume responsibility of handling console events/signals.
- * Currently not used (by the console event handling code.)
- */
-extern void handleSignalsInThisThread(void);
-
-/*
- * Function: rts_waitConsoleHandlerCompletion()
- *
- * Esoteric entry point used by worker thread that got woken
- * up as part Ctrl-C delivery.
- */
-extern int rts_waitConsoleHandlerCompletion(void);
-
-#endif /* __CONSOLEHANDLER_H__ */
diff --git a/ghc/rts/win32/GetTime.c b/ghc/rts/win32/GetTime.c
deleted file mode 100644
index 584b994d53..0000000000
--- a/ghc/rts/win32/GetTime.c
+++ /dev/null
@@ -1,101 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team 2005
- *
- * Machine-dependent time measurement functions
- *
- * ---------------------------------------------------------------------------*/
-
-#include "Rts.h"
-#include "GetTime.h"
-
-#include <windows.h>
-
-#ifdef HAVE_TIME_H
-# include <time.h>
-#endif
-
-#define HNS_PER_SEC 10000000LL /* FILETIMES are in units of 100ns */
-/* Convert FILETIMEs into secs */
-
-static INLINE_ME Ticks
-fileTimeToTicks(FILETIME ft)
-{
-    Ticks t;
-    t = ((Ticks)ft.dwHighDateTime << 32) | ft.dwLowDateTime;
-    t = (t * TICKS_PER_SECOND) / HNS_PER_SEC;
-    return t;
-}    
-
-static int is_win9x = -1;
-
-static INLINE_ME rtsBool
-isWin9x(void)
-{
-    if (is_win9x < 0) {
-	/* figure out whether we're on a Win9x box or not. */
-	OSVERSIONINFO oi;
-	BOOL b;
-	
-	/* Need to init the size field first.*/
-	oi.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
-	b = GetVersionEx(&oi);
-      
-	is_win9x = ( (b && (oi.dwPlatformId & VER_PLATFORM_WIN32_WINDOWS)) ? 1 : 0);
-    }
-    return is_win9x;
-}
-
-
-void
-getProcessTimes(Ticks *user, Ticks *elapsed)
-{
-    *user    = getProcessCPUTime();
-    *elapsed = getProcessElapsedTime();
-}
-
-Ticks
-getProcessCPUTime(void)
-{
-    FILETIME creationTime, exitTime, userTime, kernelTime = {0,0};
-
-    if (isWin9x()) return getProcessElapsedTime();
-
-    if (!GetProcessTimes(GetCurrentProcess(), &creationTime,
-			 &exitTime, &kernelTime, &userTime)) {
-	return 0;
-    }
-
-    return fileTimeToTicks(userTime);
-}
-
-Ticks
-getProcessElapsedTime(void)
-{
-    FILETIME system_time;
-    GetSystemTimeAsFileTime(&system_time);
-    return fileTimeToTicks(system_time);
-}
-
-Ticks
-getThreadCPUTime(void)
-{
-    FILETIME creationTime, exitTime, userTime, kernelTime = {0,0};
-
-    if (isWin9x()) return getProcessCPUTime();
-
-    if (!GetThreadTimes(GetCurrentThread(), &creationTime,
-			&exitTime, &kernelTime, &userTime)) {
-	return 0;
-    }
-
-    return fileTimeToTicks(userTime);
-}
-
-nat
-getPageFaults(void)
-{
-  /* ToDo (on NT): better, get this via the performance data
-     that's stored in the registry. */
-    return 0;
-}
diff --git a/ghc/rts/win32/IOManager.c b/ghc/rts/win32/IOManager.c
deleted file mode 100644
index a67c3504c1..0000000000
--- a/ghc/rts/win32/IOManager.c
+++ /dev/null
@@ -1,510 +0,0 @@
-/* IOManager.c
- *
- * Non-blocking / asynchronous I/O for Win32.
- *
- * (c) sof, 2002-2003.
- */
-#include "Rts.h"
-#include "IOManager.h"
-#include "WorkQueue.h"
-#include "ConsoleHandler.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <io.h>
-#include <winsock.h>
-#include <process.h>
-
-/*
- * Internal state maintained by the IO manager.
- */
-typedef struct IOManagerState {
-    CritSection      manLock;
-    WorkQueue*       workQueue;
-    int              queueSize;
-    int              numWorkers;
-    int              workersIdle;
-    HANDLE           hExitEvent;
-    unsigned int     requestID;
-    /* fields for keeping track of active WorkItems */
-    CritSection      active_work_lock;
-    WorkItem*        active_work_items;
-} IOManagerState;
-
-/* ToDo: wrap up this state via a IOManager handle instead? */
-static IOManagerState* ioMan;
-
-static void RegisterWorkItem  ( IOManagerState* iom, WorkItem* wi);
-static void DeregisterWorkItem( IOManagerState* iom, WorkItem* wi);
-
-/*
- * The routine executed by each worker thread.
- */
-static
-unsigned
-WINAPI
-IOWorkerProc(PVOID param)
-{
-    HANDLE  hWaits[2];
-    DWORD   rc;
-    IOManagerState* iom = (IOManagerState*)param;
-    WorkQueue* pq = iom->workQueue;
-    WorkItem*  work;
-    int        len = 0, fd = 0;
-    DWORD      errCode = 0;
-    void*      complData;
-
-    hWaits[0] = (HANDLE)iom->hExitEvent;
-    hWaits[1] = GetWorkQueueHandle(pq);
-  
-    while (1) {
-	/* The error code is communicated back on completion of request; reset. */
-	errCode = 0;
-	
-	EnterCriticalSection(&iom->manLock);
-	/* Signal that the worker is idle.
-	 *
-	 * 'workersIdle' is used when determining whether or not to
-	 * increase the worker thread pool when adding a new request.
-	 * (see addIORequest().)
-	 */
-	iom->workersIdle++;
-	LeaveCriticalSection(&iom->manLock);
-	
-	/*
-	 * A possible future refinement is to make long-term idle threads
-	 * wake up and decide to shut down should the number of idle threads
-	 * be above some threshold.
-	 *
-	 */
-	rc = WaitForMultipleObjects( 2, hWaits, FALSE, INFINITE );
-
-	if (rc == WAIT_OBJECT_0) {
-	    // we received the exit event
-	    return 0;
-	}
-
-	EnterCriticalSection(&iom->manLock);
-	/* Signal that the thread is 'non-idle' and about to consume 
-	 * a work item.
-	 */
-	iom->workersIdle--;
-	iom->queueSize--;
-	LeaveCriticalSection(&iom->manLock);
-    
-	if ( rc == (WAIT_OBJECT_0 + 1) ) {
-	    /* work item available, fetch it. */
-	    if (FetchWork(pq,(void**)&work)) {
-		work->abandonOp = 0;
-		RegisterWorkItem(iom,work);
-		if ( work->workKind & WORKER_READ ) {
-		    if ( work->workKind & WORKER_FOR_SOCKET ) {
-			len = recv(work->workData.ioData.fd, 
-				   work->workData.ioData.buf,
-				   work->workData.ioData.len,
-				   0);
-			if (len == SOCKET_ERROR) {
-			    errCode = WSAGetLastError();
-			}
-		    } else {
-			while (1) {
-			/* Do the read(), with extra-special handling for Ctrl+C */
-			len = read(work->workData.ioData.fd,
-				   work->workData.ioData.buf,
-				   work->workData.ioData.len);
-			if ( len == 0 && work->workData.ioData.len != 0 ) {
-			    /* Given the following scenario:
-			     *     - a console handler has been registered that handles Ctrl+C
-			     *       events.
-			     *     - we've not tweaked the 'console mode' settings to turn on
-			     *       ENABLE_PROCESSED_INPUT.
-			     *     - we're blocked waiting on input from standard input.
-			     *     - the user hits Ctrl+C.
-			     *
-			     * The OS will invoke the console handler (in a separate OS thread),
-			     * and the above read() (i.e., under the hood, a ReadFile() op) returns
-			     * 0, with the error set to ERROR_OPERATION_ABORTED. We don't
-			     * want to percolate this error condition back to the Haskell user.
-			     * Do this by waiting for the completion of the Haskell console handler.
-			     * If upon completion of the console handler routine, the Haskell thread 
-			     * that issued the request is found to have been thrown an exception, 
-			     * the worker abandons the request (since that's what the Haskell thread 
-			     * has done.) If the Haskell thread hasn't been interrupted, the worker 
-			     * retries the read request as if nothing happened.
-			     */
-			    if ( (GetLastError()) == ERROR_OPERATION_ABORTED ) {
-				/* For now, only abort when dealing with the standard input handle.
-				 * i.e., for all others, an error is raised.
-				 */
-				HANDLE h  = (HANDLE)GetStdHandle(STD_INPUT_HANDLE);
-				if ( _get_osfhandle(work->workData.ioData.fd) == (long)h ) {
-				    if (rts_waitConsoleHandlerCompletion()) {
-					/* If the Scheduler has set work->abandonOp, the Haskell thread has 
-					 * been thrown an exception (=> the worker must abandon this request.)
-					 * We test for this below before invoking the on-completion routine.
-					 */
-					if (work->abandonOp) {
-					    break;
-					} else {
-					    continue;
-					}
-				    } 
-				} else { 
-				    break; /* Treat it like an error */
-				}
-			    } else {
-				break;
-			    }
-			} else {
-			    break;
-			}
-			}
-			if (len == -1) { errCode = errno; }
-		    }
-		    complData = work->workData.ioData.buf;
-		    fd = work->workData.ioData.fd;
-		} else if ( work->workKind & WORKER_WRITE ) {
-		    if ( work->workKind & WORKER_FOR_SOCKET ) {
-			len = send(work->workData.ioData.fd,
-				   work->workData.ioData.buf,
-				   work->workData.ioData.len,
-				   0);
-			if (len == SOCKET_ERROR) {
-			    errCode = WSAGetLastError();
-			}
-		    } else {
-			len = write(work->workData.ioData.fd,
-				    work->workData.ioData.buf,
-				    work->workData.ioData.len);
-			if (len == -1) { errCode = errno; }
-		    }
-		    complData = work->workData.ioData.buf;
-		    fd = work->workData.ioData.fd;
-		} else if ( work->workKind & WORKER_DELAY ) {
-		    /* Approximate implementation of threadDelay;
-		     * 
-		     * Note: Sleep() is in milliseconds, not micros.
-		     */
-		    Sleep(work->workData.delayData.msecs / 1000);
-		    len = work->workData.delayData.msecs;
-		    complData = NULL;
-		    fd = 0;
-		    errCode = 0;
-		} else if ( work->workKind & WORKER_DO_PROC ) {
-		    /* perform operation/proc on behalf of Haskell thread. */
-		    if (work->workData.procData.proc) {
-			/* The procedure is assumed to encode result + success/failure
-			 * via its param.
-			 */
-			errCode=work->workData.procData.proc(work->workData.procData.param);
-		    } else {
-			errCode=1;
-		    }
-		    complData = work->workData.procData.param;
-		} else {
-		    fprintf(stderr, "unknown work request type (%d) , ignoring.\n", work->workKind);
-		    fflush(stderr);
-		    continue;
-		}
-		if (!work->abandonOp) {
-		    work->onCompletion(work->requestID,
-				       fd,
-				       len,
-				       complData,
-				       errCode);
-		}
-		/* Free the WorkItem */
-		DeregisterWorkItem(iom,work);
-		free(work);
-	    } else {
-		fprintf(stderr, "unable to fetch work; fatal.\n"); fflush(stderr);
-		return 1;
-	    }
-	} else {
-	    fprintf(stderr, "waiting failed (%lu); fatal.\n", rc); fflush(stderr);
-	    return 1;
-	}
-    }
-    return 0;
-}
-
-static 
-BOOL
-NewIOWorkerThread(IOManagerState* iom)
-{
-    unsigned threadId;
-    return ( 0 != _beginthreadex(NULL,
-				 0,
-				 IOWorkerProc,
-				 (LPVOID)iom,
-				 0,
-				 &threadId) );
-}
-
-BOOL
-StartIOManager(void)
-{
-    HANDLE hExit;
-    WorkQueue* wq;
-
-    wq = NewWorkQueue();
-    if ( !wq ) return FALSE;  
-  
-    ioMan = (IOManagerState*)malloc(sizeof(IOManagerState));
-  
-    if (!ioMan) {
-	FreeWorkQueue(wq);
-	return FALSE;
-    }
-
-    /* A manual-reset event */
-    hExit = CreateEvent ( NULL, TRUE, FALSE, NULL );
-    if ( !hExit ) {
-	FreeWorkQueue(wq);
-	free(ioMan);
-	return FALSE;
-    }
-  
-    ioMan->hExitEvent = hExit;
-    InitializeCriticalSection(&ioMan->manLock);
-    ioMan->workQueue   = wq;
-    ioMan->numWorkers  = 0;
-    ioMan->workersIdle = 0;
-    ioMan->queueSize   = 0;
-    ioMan->requestID   = 1;
-    InitializeCriticalSection(&ioMan->active_work_lock);
-    ioMan->active_work_items = NULL;
- 
-    return TRUE;
-}
-
-/*
- * Function: depositWorkItem()
- *
- * Local function which deposits a WorkItem onto a work queue,
- * deciding in the process whether or not the thread pool needs
- * to be augmented with another thread to handle the new request.
- *
- */
-static
-int
-depositWorkItem( unsigned int reqID,
-		 WorkItem* wItem )
-{
-    EnterCriticalSection(&ioMan->manLock);
-
-#if 0
-    fprintf(stderr, "depositWorkItem: %d/%d\n", ioMan->workersIdle, ioMan->numWorkers); 
-    fflush(stderr);
-#endif
-    /* A new worker thread is created when there are fewer idle threads
-     * than non-consumed queue requests. This ensures that requests will
-     * be dealt with in a timely manner.
-     *
-     * [Long explanation of why the previous thread pool policy lead to 
-     * trouble]
-     *
-     * Previously, the thread pool was augmented iff no idle worker threads
-     * were available. That strategy runs the risk of repeatedly adding to
-     * the request queue without expanding the thread pool to handle this
-     * sudden spike in queued requests. 
-     * [How? Assume workersIdle is 1, and addIORequest() is called. No new 
-     * thread is created and the request is simply queued. If addIORequest()
-     * is called again _before the OS schedules a worker thread to pull the
-     * request off the queue_, workersIdle is still 1 and another request is 
-     * simply added to the queue. Once the worker thread is run, only one
-     * request is de-queued, leaving the 2nd request in the queue]
-     * 
-     * Assuming none of the queued requests take an inordinate amount of to 
-     * complete, the request queue would eventually be drained. But if that's 
-     * not the case, the later requests will end up languishing in the queue 
-     * indefinitely. The non-timely handling of requests may cause CH applications
-     * to misbehave / hang; bad.
-     *
-     */
-    ioMan->queueSize++;
-    if ( (ioMan->workersIdle < ioMan->queueSize) ) {
-	/* see if giving up our quantum ferrets out some idle threads.
-	 */
-	LeaveCriticalSection(&ioMan->manLock);
-	Sleep(0);
-	EnterCriticalSection(&ioMan->manLock);
-	if ( (ioMan->workersIdle < ioMan->queueSize) ) {
-	    /* No, go ahead and create another. */
-	    ioMan->numWorkers++;
-	    LeaveCriticalSection(&ioMan->manLock);
-	    NewIOWorkerThread(ioMan);
-	} else {
-	    LeaveCriticalSection(&ioMan->manLock);
-	}
-    } else {
-	LeaveCriticalSection(&ioMan->manLock);
-    }
-  
-    if (SubmitWork(ioMan->workQueue,wItem)) {
-	/* Note: the work item has potentially been consumed by a worker thread
-	 *       (and freed) at this point, so we cannot use wItem's requestID.
-	 */
-	return reqID;
-    } else {
-	return 0;
-    }
-}
-
-/*
- * Function: AddIORequest()
- *
- * Conduit to underlying WorkQueue's SubmitWork(); adds IO
- * request to work queue, deciding whether or not to augment
- * the thread pool in the process. 
- */
-int
-AddIORequest ( int   fd,
-	       BOOL  forWriting,
-	       BOOL  isSocket,
-	       int   len,
-	       char* buffer,
-	       CompletionProc onCompletion)
-{
-    WorkItem* wItem    = (WorkItem*)malloc(sizeof(WorkItem));
-    unsigned int reqID = ioMan->requestID++;
-    if (!ioMan || !wItem) return 0;
-  
-    /* Fill in the blanks */
-    wItem->workKind     = ( isSocket   ? WORKER_FOR_SOCKET : 0 ) | 
-	                  ( forWriting ? WORKER_WRITE : WORKER_READ );
-    wItem->workData.ioData.fd  = fd;
-    wItem->workData.ioData.len = len;
-    wItem->workData.ioData.buf = buffer;
-    wItem->link = NULL;
-
-    wItem->onCompletion        = onCompletion;
-    wItem->requestID           = reqID;
-  
-    return depositWorkItem(reqID, wItem);
-}       
-
-/*
- * Function: AddDelayRequest()
- *
- * Like AddIORequest(), but this time adding a delay request to
- * the request queue.
- */
-BOOL
-AddDelayRequest ( unsigned int   msecs,
-		  CompletionProc onCompletion)
-{
-    WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem));
-    unsigned int reqID = ioMan->requestID++;
-    if (!ioMan || !wItem) return FALSE;
-  
-    /* Fill in the blanks */
-    wItem->workKind     = WORKER_DELAY;
-    wItem->workData.delayData.msecs = msecs;
-    wItem->onCompletion = onCompletion;
-    wItem->requestID    = reqID;
-    wItem->link         = NULL;
-
-    return depositWorkItem(reqID, wItem);
-}
-
-/*
- * Function: AddProcRequest()
- *
- * Add an asynchronous procedure request.
- */
-BOOL
-AddProcRequest ( void* proc,
-		 void* param,
-		 CompletionProc onCompletion)
-{
-    WorkItem* wItem = (WorkItem*)malloc(sizeof(WorkItem));
-    unsigned int reqID = ioMan->requestID++;
-    if (!ioMan || !wItem) return FALSE;
-  
-    /* Fill in the blanks */
-    wItem->workKind     = WORKER_DO_PROC;
-    wItem->workData.procData.proc  = proc;
-    wItem->workData.procData.param = param;
-    wItem->onCompletion = onCompletion;
-    wItem->requestID    = reqID;
-    wItem->abandonOp    = 0;
-    wItem->link         = NULL;
-
-    return depositWorkItem(reqID, wItem);
-}
-
-void ShutdownIOManager ( void )
-{
-  SetEvent(ioMan->hExitEvent);
-  // ToDo: we can't free this now, because the worker thread(s)
-  // haven't necessarily finished with it yet.  Perhaps it should
-  // have a reference count or something.
-  // free(ioMan);
-  // ioMan = NULL;
-}
-
-/* Keep track of WorkItems currently being serviced. */
-static 
-void
-RegisterWorkItem(IOManagerState* ioMan, 
-		 WorkItem* wi)
-{
-    EnterCriticalSection(&ioMan->active_work_lock);
-    wi->link = ioMan->active_work_items;
-    ioMan->active_work_items = wi;
-    LeaveCriticalSection(&ioMan->active_work_lock);
-}
-
-static 
-void
-DeregisterWorkItem(IOManagerState* ioMan, 
-		   WorkItem* wi)
-{
-    WorkItem *ptr, *prev;
-    
-    EnterCriticalSection(&ioMan->active_work_lock);
-    for(prev=NULL,ptr=ioMan->active_work_items;ptr;prev=ptr,ptr=ptr->link) {
-	if (wi->requestID == ptr->requestID) {
-	    if (prev==NULL) {
-		ioMan->active_work_items = ptr->link;
-	    } else {
-		prev->link = ptr->link;
-	    }
-	    LeaveCriticalSection(&ioMan->active_work_lock);
-	    return;
-	}
-    }
-    fprintf(stderr, "DeregisterWorkItem: unable to locate work item %d\n", wi->requestID);
-    LeaveCriticalSection(&ioMan->active_work_lock);
-}
-
-
-/*
- * Function: abandonWorkRequest()
- *
- * Signal that a work request isn't of interest. Called by the Scheduler
- * if a blocked Haskell thread has an exception thrown to it.
- *
- * Note: we're not aborting the system call that a worker might be blocked on
- * here, just disabling the propagation of its result once its finished. We
- * may have to go the whole hog here and switch to overlapped I/O so that we
- * can abort blocked system calls.
- */
-void
-abandonWorkRequest ( int reqID )
-{
-    WorkItem *ptr;
-    EnterCriticalSection(&ioMan->active_work_lock);
-    for(ptr=ioMan->active_work_items;ptr;ptr=ptr->link) {
-	if (ptr->requestID == (unsigned int)reqID ) {
-	    ptr->abandonOp = 1;
-	    LeaveCriticalSection(&ioMan->active_work_lock);
-	    return;
-	}
-    }
-    /* Note: if the request ID isn't present, the worker will have
-     * finished sometime since awaitRequests() last drained the completed
-     * request table; i.e., not an error.
-     */
-    LeaveCriticalSection(&ioMan->active_work_lock);
-}
diff --git a/ghc/rts/win32/IOManager.h b/ghc/rts/win32/IOManager.h
deleted file mode 100644
index 4893e2387c..0000000000
--- a/ghc/rts/win32/IOManager.h
+++ /dev/null
@@ -1,110 +0,0 @@
-/* IOManager.h
- *
- * Non-blocking / asynchronous I/O for Win32.
- *
- * (c) sof, 2002-2003
- */
-#ifndef __IOMANAGER_H__
-#define __IOMANAGER_H__
-/* On the yucky side..suppress -Wmissing-declarations warnings when
- * including <windows.h>
- */
-extern void* GetCurrentFiber ( void );
-extern void* GetFiberData ( void );
-#include <windows.h>
-
-/*
- The IOManager subsystem provides a non-blocking view
- of I/O operations. It lets one (or more) OS thread(s)
- issue multiple I/O requests, which the IOManager then 
- handles independently of/concurrent to the thread(s)
- that issued the request. Upon completion, the issuing
- thread can inspect the result of the I/O operation &
- take appropriate action.
-
- The IOManager is intended used with the GHC RTS to
- implement non-blocking I/O in Concurrent Haskell.
- */
-
-/*
- * Our WorkQueue holds WorkItems, encoding IO and
- * delay requests.
- *
- */
-typedef void (*CompletionProc)(unsigned int requestID,
-			       int   fd,
-			       int   len,
-			       void* buf,
-			       int   errCode);
-
-/* 
- * Asynchronous procedure calls executed by a worker thread
- * take a generic state argument pointer and return an int by 
- * default. 
- */
-typedef int (*DoProcProc)(void *param);
-
-typedef union workData {
-    struct {
-	int   fd;
-	int   len;
-	char *buf; 
-    } ioData;
-    struct { 
-	int   msecs;
-    } delayData;
-    struct { 
-	DoProcProc proc;
-	void* param;
-    } procData;
-} WorkData;
-
-typedef struct WorkItem {
-  unsigned int     workKind;
-  WorkData         workData;
-  unsigned int     requestID;
-  CompletionProc   onCompletion;
-  unsigned int     abandonOp;
-  struct WorkItem  *link;
-} WorkItem;
-
-extern CompletionProc onComplete;
-
-/* the kind of operations supported; you could easily imagine
- * that instead of passing a tag describing the work to be performed,
- * a function pointer is passed instead. Maybe later.
- */
-#define WORKER_READ        1
-#define WORKER_WRITE       2
-#define WORKER_DELAY       4
-#define WORKER_FOR_SOCKET  8
-#define WORKER_DO_PROC    16
-
-/*
- * Starting up and shutting down. 
- */ 
-extern BOOL StartIOManager     ( void );
-extern void ShutdownIOManager  ( void );
-
-/*
- * Adding I/O and delay requests. With each request a
- * completion routine is supplied, which the worker thread
- * will invoke upon completion.
- */
-extern int AddDelayRequest ( unsigned int   msecs,
-			     CompletionProc onCompletion);
-
-extern int AddIORequest ( int            fd,
-			  BOOL           forWriting,
-			  BOOL           isSocket,
-			  int            len,
-			  char*          buffer,
-			  CompletionProc onCompletion);
-
-extern int AddProcRequest ( void*          proc,
-			    void*          data,
-			    CompletionProc onCompletion);
-
-extern void abandonWorkRequest ( int reqID );
-
-#endif /* __IOMANAGER_H__ */
diff --git a/ghc/rts/win32/OSThreads.c b/ghc/rts/win32/OSThreads.c
deleted file mode 100644
index c772be38f4..0000000000
--- a/ghc/rts/win32/OSThreads.c
+++ /dev/null
@@ -1,199 +0,0 @@
-/* ---------------------------------------------------------------------------
- *
- * (c) The GHC Team, 2001-2005
- *
- * Accessing OS threads functionality in a (mostly) OS-independent
- * manner. 
- *
- * --------------------------------------------------------------------------*/
-
-#include "Rts.h"
-#if defined(THREADED_RTS)
-#include "OSThreads.h"
-#include "RtsUtils.h"
-
-/* For reasons not yet clear, the entire contents of process.h is protected 
- * by __STRICT_ANSI__ not being defined.
- */
-#undef __STRICT_ANSI__
-#include <process.h>
-
-/* Win32 threads and synchronisation objects */
-
-/* A Condition is represented by a Win32 Event object;
- * a Mutex by a Mutex kernel object.
- *
- * ToDo: go through the defn and usage of these to
- * make sure the semantics match up with that of 
- * the (assumed) pthreads behaviour. This is really
- * just a first pass at getting something compilable.
- */
-
-void
-initCondition( Condition* pCond )
-{
-  HANDLE h =  CreateEvent(NULL, 
-			  FALSE,  /* auto reset */
-			  FALSE,  /* initially not signalled */
-			  NULL); /* unnamed => process-local. */
-  
-  if ( h == NULL ) {
-    errorBelch("initCondition: unable to create");
-  }
-  *pCond = h;
-  return;
-}
-
-void
-closeCondition( Condition* pCond )
-{
-  if ( CloseHandle(*pCond) == 0 ) {
-    errorBelch("closeCondition: failed to close");
-  }
-  return;
-}
-
-rtsBool
-broadcastCondition ( Condition* pCond )
-{
-  PulseEvent(*pCond);
-  return rtsTrue;
-}
-
-rtsBool
-signalCondition ( Condition* pCond )
-{
-    if (SetEvent(*pCond) == 0) {
-	barf("SetEvent: %d", GetLastError());
-    }
-    return rtsTrue;
-}
-
-rtsBool
-waitCondition ( Condition* pCond, Mutex* pMut )
-{
-  RELEASE_LOCK(pMut);
-  WaitForSingleObject(*pCond, INFINITE);
-  /* Hmm..use WaitForMultipleObjects() ? */
-  ACQUIRE_LOCK(pMut);
-  return rtsTrue;
-}
-
-void
-yieldThread()
-{
-  Sleep(0);
-  return;
-}
-
-void
-shutdownThread()
-{
-  _endthreadex(0);
-}
-
-int
-createOSThread (OSThreadId* pId, OSThreadProc *startProc, void *param)
-{
-  
-  return (_beginthreadex ( NULL,  /* default security attributes */
-			   0,
-			   (unsigned (__stdcall *)(void *)) startProc,
-			   param,
-			   0,
-			   (unsigned*)pId) == 0);
-}
-
-OSThreadId
-osThreadId()
-{
-  return GetCurrentThreadId();
-}
-
-#ifdef USE_CRITICAL_SECTIONS
-void
-initMutex (Mutex* pMut)
-{
-    InitializeCriticalSectionAndSpinCount(pMut,4000);
-}
-#else
-void
-initMutex (Mutex* pMut)
-{
-  HANDLE h = CreateMutex ( NULL,  /* default sec. attributes */
-			   FALSE, /* not owned => initially signalled */
-			   NULL
-			   );
-  *pMut = h;
-  return;
-}
-#endif
-
-void
-newThreadLocalKey (ThreadLocalKey *key)
-{
-    DWORD r;
-    r = TlsAlloc();
-    if (r == TLS_OUT_OF_INDEXES) {
-	barf("newThreadLocalKey: out of keys");
-    }
-    *key = r;
-}
-
-void *
-getThreadLocalVar (ThreadLocalKey *key)
-{
-    void *r;
-    r = TlsGetValue(*key);
-#ifdef DEBUG
-    // r is allowed to be NULL - it can mean that either there was an
-    // error or the stored value is in fact NULL.
-    if (GetLastError() != NO_ERROR) {
-	barf("getThreadLocalVar: key not found");
-    }
-#endif
-    return r;
-}
-
-void
-setThreadLocalVar (ThreadLocalKey *key, void *value)
-{
-    BOOL b;
-    b = TlsSetValue(*key, value);
-    if (!b) {
-	barf("setThreadLocalVar: %d", GetLastError());
-    }
-}
-
-
-static unsigned __stdcall
-forkOS_createThreadWrapper ( void * entry )
-{
-    Capability *cap;
-    cap = rts_lock();
-    cap = rts_evalStableIO(cap, (HsStablePtr) entry, NULL);
-    rts_unlock(cap);
-    return 0;
-}
-
-int
-forkOS_createThread ( HsStablePtr entry )
-{
-    unsigned long pId;
-    return (_beginthreadex ( NULL,  /* default security attributes */
-			   0,
-			   forkOS_createThreadWrapper,
-			   (void*)entry,
-			   0,
-			   (unsigned*)&pId) == 0);
-}
-
-#else /* !defined(THREADED_RTS) */
-
-int
-forkOS_createThread ( HsStablePtr entry STG_UNUSED )
-{
-    return -1;
-}
-
-#endif /* !defined(THREADED_RTS) */
diff --git a/ghc/rts/win32/Ticker.c b/ghc/rts/win32/Ticker.c
deleted file mode 100644
index ab791d8dc7..0000000000
--- a/ghc/rts/win32/Ticker.c
+++ /dev/null
@@ -1,124 +0,0 @@
-/*
- * RTS periodic timers.
- * 
- */
-#include "Rts.h"
-#include "Timer.h"
-#include "Ticker.h"
-#include <windows.h>
-#include <stdio.h>
-#include <process.h>
-#include "OSThreads.h"
-
-/*
- * Provide a timer service for the RTS, periodically
- * notifying it that a number of 'ticks' has passed.
- *
- */
-
-/* To signal shutdown of the timer service, we use a local
- * event which the timer thread listens to (and stopVirtTimer()
- * signals.)
- */
-static HANDLE hStopEvent = INVALID_HANDLE_VALUE;
-static HANDLE tickThread = INVALID_HANDLE_VALUE;
-
-static TickProc tickProc = NULL;
-
-/*
- * Ticking is done by a separate thread which periodically
- * wakes up to handle a tick.
- *
- * This is the portable way of providing a timer service under
- * Win32; features like waitable timers or timer queues are only
- * supported by a subset of the Win32 platforms (notably not
- * under Win9x.)
- *
- */
-static
-unsigned
-WINAPI
-TimerProc(PVOID param)
-{
-  int ms = (int)param;
-  DWORD waitRes;
-  
-  /* interpret a < 0 timeout period as 'instantaneous' */ 
- if (ms < 0) ms = 0;
-
-  while (1) {
-    waitRes = WaitForSingleObject(hStopEvent, ms);
-    
-    switch (waitRes) {
-    case WAIT_OBJECT_0:
-      /* event has become signalled */
-      tickProc = NULL;
-      CloseHandle(hStopEvent);
-      return 0;
-    case WAIT_TIMEOUT:
-      /* tick */
-      tickProc(0);
-      break;
-    case WAIT_FAILED: {
-	DWORD dw = GetLastError();
-	fprintf(stderr, "TimerProc: wait failed -- error code: %lu\n", dw); fflush(stderr);
-	break; 
-    }
-    default:
-      fprintf(stderr, "TimerProc: unexpected result %lu\n", waitRes); fflush(stderr);
-      break;
-    }
-  }
-  return 0;
-}
-
-
-int
-startTicker(nat ms, TickProc handle_tick)
-{
-  unsigned threadId;
-  /* 'hStopEvent' is a manual-reset event that's signalled upon
-   * shutdown of timer service (=> timer thread.)
-   */
-  hStopEvent = CreateEvent ( NULL,
-			     TRUE,
-			     FALSE,
-			     NULL);
-  if (hStopEvent == INVALID_HANDLE_VALUE) {
-    return 0;
-  }
-  tickProc = handle_tick;
-  tickThread = (HANDLE)(long)_beginthreadex( NULL,
-			       0,
-			       TimerProc,
-			       (LPVOID)ms,
-			       0,
-			       &threadId);
-  return (tickThread != 0);
-}
-
-int
-stopTicker(void)
-{
-    // We must wait for the ticker thread to terminate, since if we
-    // are in a DLL that is about to be unloaded, the ticker thread
-    // cannot be allowed to return to a missing DLL.
-
-    if (hStopEvent != INVALID_HANDLE_VALUE && 
-	tickThread != INVALID_HANDLE_VALUE) {
-	DWORD exitCode;
-	SetEvent(hStopEvent);
-	while (1) {
-	    WaitForSingleObject(tickThread, 20);
-	    if (!GetExitCodeThread(tickThread, &exitCode)) {
-		return 1;
-	    }
-	    if (exitCode != STILL_ACTIVE) {
-		tickThread = INVALID_HANDLE_VALUE;
-		return 0;
-	    }
-	    TerminateThread(tickThread, 0);
-	}
-    }
-    return 0;
-}
diff --git a/ghc/rts/win32/WorkQueue.c b/ghc/rts/win32/WorkQueue.c
deleted file mode 100644
index 85a23608be..0000000000
--- a/ghc/rts/win32/WorkQueue.c
+++ /dev/null
@@ -1,215 +0,0 @@
-/*
- * A fixed-size queue; MT-friendly.
- * 
- * (c) sof, 2002-2003.
- */
-#include "WorkQueue.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-
-static void queue_error_rc( char* loc, DWORD err);
-static void queue_error( char* loc, char* reason);
-
-
-/* Wrapper around OS call to create semaphore */
-static Semaphore
-newSemaphore(int initCount, int max)
-{
-  Semaphore s;
-  s = CreateSemaphore ( NULL,       /* LPSECURITY_ATTRIBUTES (default) */
-			initCount,  /* LONG lInitialCount */
-			max,        /* LONG lMaxCount */
-			NULL);      /* LPCTSTR (anonymous / no object name) */
-  if ( NULL == s) {
-    queue_error_rc("newSemaphore", GetLastError());
-    return NULL;
-  }
-  return s;
-}
-
-/*
- * Function: NewWorkQueue
- *
- * The queue constructor - semaphores are initialised to match
- * max number of queue entries.
- * 
- */
-WorkQueue*
-NewWorkQueue()
-{
-  WorkQueue* wq = (WorkQueue*)malloc(sizeof(WorkQueue));
-  
-  if (!wq) {
-    queue_error("NewWorkQueue", "malloc() failed");
-    return wq;
-  }
-    
-  wq->head   = 0;
-  wq->tail   = 0;
-  
-  InitializeCriticalSection(&wq->queueLock);
-  wq->workAvailable = newSemaphore(0, WORKQUEUE_SIZE);
-  wq->roomAvailable = newSemaphore(WORKQUEUE_SIZE, WORKQUEUE_SIZE);
-  
-  /* Fail if we were unable to create any of the sync objects. */
-  if ( NULL == wq->workAvailable ||
-       NULL == wq->roomAvailable ) {
-    FreeWorkQueue(wq);
-    return NULL;
-  }
-
-  return wq;
-}
-
-void
-FreeWorkQueue ( WorkQueue* pq )
-{
-  /* Close the semaphores; any threads blocked waiting
-   * on either will as a result be woken up.
-   */ 
-  if ( pq->workAvailable ) {
-    CloseHandle(pq->workAvailable);
-  }
-  if ( pq->roomAvailable ) {
-    CloseHandle(pq->workAvailable);
-  }
-  free(pq);
-  return;
-}
-
-HANDLE
-GetWorkQueueHandle ( WorkQueue* pq )
-{
-  if (!pq) return NULL;
-  
-  return pq->workAvailable;
-}
-
-/*
- * Function: GetWork
- *
- * Fetch a work item from the queue, blocking if none available.
- * Return value indicates of FALSE indicates error/fatal condition.
- */
-BOOL
-GetWork ( WorkQueue* pq, void** ppw )
-{
-  DWORD rc;
-
-  if (!pq) {
-    queue_error("GetWork", "NULL WorkQueue object");
-    return FALSE;
-  }
-  if (!ppw) {
-    queue_error("GetWork", "NULL WorkItem object");
-    return FALSE;
-  }
-  
-  /* Block waiting for work item to become available */
-  if ( (rc = WaitForSingleObject( pq->workAvailable, INFINITE)) != WAIT_OBJECT_0 ) {
-    queue_error_rc("GetWork.WaitForSingleObject(workAvailable)", 
-		   ( (WAIT_FAILED == rc) ? GetLastError() : rc));
-    return FALSE;
-  }
-  
-  return FetchWork(pq,ppw);
-}
-
-/*
- * Function: FetchWork
- *
- * Fetch a work item from the queue, blocking if none available.
- * Return value indicates of FALSE indicates error/fatal condition.
- */
-BOOL
-FetchWork ( WorkQueue* pq, void** ppw )
-{
-  DWORD rc;
-
-  if (!pq) {
-    queue_error("FetchWork", "NULL WorkQueue object");
-    return FALSE;
-  }
-  if (!ppw) {
-    queue_error("FetchWork", "NULL WorkItem object");
-    return FALSE;
-  }
-  
-  EnterCriticalSection(&pq->queueLock);
-  *ppw = pq->items[pq->head];
-  /* For sanity's sake, zero out the pointer. */
-  pq->items[pq->head] = NULL;
-  pq->head = (pq->head + 1) % WORKQUEUE_SIZE;
-  rc = ReleaseSemaphore(pq->roomAvailable,1, NULL);
-  LeaveCriticalSection(&pq->queueLock);
-  if ( 0 == rc ) {
-    queue_error_rc("FetchWork.ReleaseSemaphore()", GetLastError());
-    return FALSE;
-  }
-
-  return TRUE;
-}
-
-/*
- * Function: SubmitWork
- *
- * Add work item to the queue, blocking if no room available.
- * Return value indicates of FALSE indicates error/fatal condition.
- */
-BOOL
-SubmitWork ( WorkQueue* pq, void* pw )
-{
-  DWORD rc;
-
-  if (!pq) {
-    queue_error("SubmitWork", "NULL WorkQueue object");
-    return FALSE;
-  }
-  if (!pw) {
-    queue_error("SubmitWork", "NULL WorkItem object");
-    return FALSE;
-  }
-  
-  /* Block waiting for work item to become available */
-  if ( (rc = WaitForSingleObject( pq->roomAvailable, INFINITE)) != WAIT_OBJECT_0 ) {
-    queue_error_rc("SubmitWork.WaitForSingleObject(workAvailable)", 
-		   ( (WAIT_FAILED == rc) ? GetLastError() : rc));
-
-    return FALSE;
-  }
-  
-  EnterCriticalSection(&pq->queueLock);
-  pq->items[pq->tail] = pw;
-  pq->tail = (pq->tail + 1) % WORKQUEUE_SIZE;
-  rc = ReleaseSemaphore(pq->workAvailable,1, NULL);
-  LeaveCriticalSection(&pq->queueLock);
-  if ( 0 == rc ) {
-    queue_error_rc("SubmitWork.ReleaseSemaphore()", GetLastError());
-    return FALSE;
-  }
-
-  return TRUE;
-}
-
-/* Error handling */
-
-static void
-queue_error_rc( char* loc,
-		DWORD err)
-{
-  fprintf(stderr, "%s failed: return code = 0x%lx\n", loc, err);
-  fflush(stderr);
-  return;
-}
-			    
-
-static void
-queue_error( char* loc,
-	     char* reason)
-{
-  fprintf(stderr, "%s failed: %s\n", loc, reason);
-  fflush(stderr);
-  return;
-}
-
diff --git a/ghc/rts/win32/WorkQueue.h b/ghc/rts/win32/WorkQueue.h
deleted file mode 100644
index bde82a3a77..0000000000
--- a/ghc/rts/win32/WorkQueue.h
+++ /dev/null
@@ -1,37 +0,0 @@
-/* WorkQueue.h
- *
- * A fixed-size queue; MT-friendly.
- * 
- * (c) sof, 2002-2003
- *
- */
-#ifndef __WORKQUEUE_H__
-#define __WORKQUEUE_H__
-#include <windows.h>
-
-/* This is a fixed-size queue. */
-#define WORKQUEUE_SIZE 16
-
-typedef HANDLE           Semaphore;
-typedef CRITICAL_SECTION CritSection;
-
-typedef struct WorkQueue {
-    /* the master lock, need to be grabbed prior to
-       using any of the other elements of the struct. */
-  CritSection   queueLock;
-  /* consumers/workers block waiting for 'workAvailable' */
-  Semaphore     workAvailable;
-  Semaphore     roomAvailable;
-  int           head;
-  int           tail;
-  void**        items[WORKQUEUE_SIZE];
-} WorkQueue;
-
-extern WorkQueue* NewWorkQueue       ( void );
-extern void       FreeWorkQueue      ( WorkQueue* pq );
-extern HANDLE     GetWorkQueueHandle ( WorkQueue* pq );
-extern BOOL       GetWork            ( WorkQueue* pq, void** ppw );
-extern BOOL       FetchWork          ( WorkQueue* pq, void** ppw );
-extern int        SubmitWork         ( WorkQueue* pq, void*   pw );
-
-#endif /* __WORKQUEUE_H__ */
diff --git a/ghc/utils/Makefile b/ghc/utils/Makefile
deleted file mode 100644
index 7348160a74..0000000000
--- a/ghc/utils/Makefile
+++ /dev/null
@@ -1,27 +0,0 @@
-TOP=..
-include $(TOP)/mk/boilerplate.mk
-
-ifneq "$(BIN_DIST_NAME)" ""
-# We're doing a binary-dist, descend into a subset of the dirs.
-SUBDIRS = hp2ps stat2resid unlit
-else
-ifeq "$(BootingFromHc)" "YES"
-SUBDIRS = genapply genprimopcode ghc-pkg unlit
-else
-SUBDIRS = hasktags ghc-pkg hp2ps hsc2hs parallel stat2resid prof unlit genprimopcode genapply runghc
-endif
-endif
-
-ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-SUBDIRS += touchy
-endif
-
-# hstags died when the new parser was introduced.
-#	  hstags	\
-
-# "heap-view" is not in the list because (a) it requires
-#  a Haskell compiler (which you may not have yet), and (b) you are
-#  unlikely to want it desperately.  It is easy to build once you have
-#  a Haskell compiler and if you want it.
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/debugNCG/Diff_Gcc_Nat.hs b/ghc/utils/debugNCG/Diff_Gcc_Nat.hs
deleted file mode 100644
index 02b642821e..0000000000
--- a/ghc/utils/debugNCG/Diff_Gcc_Nat.hs
+++ /dev/null
@@ -1,380 +0,0 @@
-
-module Main where
-import List
-import System
-import Char
-import Array
-
---import IOExts(trace)
-
-type Label = String
-type Code  = [String]
-
-pzipWith f []     []     = []
-pzipWith f (a:as) (b:bs) = (f a b) : pzipWith f as bs
-pzipWith f _      _      = error "pzipWith: unbalanced list"
-
-main 
-   = getArgs >>= \args ->
-     --return ["/home/v-julsew/SOLARIS/NCG/fpt/ghc/tests/codeGen/should_run/cg001.s"]
-     --                                                                     >>= \args ->
-     if   length args /= 1
-     then putStr ("\ndiff_gcc_nat:\n" ++
-                  "   usage: create   File.s-gcc   and   File.s-nat\n" ++
-                  "   then do: diff_gcc_nat File.s > synth.S\n" ++ 
-                  "   and compile synth.S into your program.\n" ++
-                  "diff_gcc_nat is to help debug GHC's native code generator;\n" ++
-                  "it is quite useless for any other purpose.  For details, see\n" ++
-                  "   fptools/ghc/utils/debugNCG/README.\n"++
-                  "\n"
-                 )
-     else
-     do
-        let [f_root] = args
-        f_gcc <- readFile (f_root ++ "-gcc")
-        f_nat <- readFile (f_root ++ "-nat")
-
-        let split_nat0 = breakOn is_split_line (lines f_nat)
-            split_nat  = filter (not.null.getLabels) split_nat0
-
-            split_markers_present
-               = any is_split_line (lines f_nat)
-
-            labels_nat = map getLabels split_nat
-            labels_cls = map (map breakLabel) labels_nat
-
-            labels_merged :: [(Label, [LabelKind])]
-            labels_merged = map mergeBroken labels_cls
-
-            classified :: [(Label, [LabelKind], [String])]
-            classified
-               = pzipWith (\ merged text -> (fst merged, snd merged, text))
-                          labels_merged split_nat
-
-            lines_gcc  = lines f_gcc
-
-            (syncd, gcc_unused)
-               = find_correspondings classified lines_gcc
-            (ok_syncs, nat_unused)
-               = check_syncs syncd
-
-            num_ok = length ok_syncs
-            
-            preamble 
-               = map (\i -> "#define NATIVE_" ++ show i ++ " 0") [1 .. num_ok]
-                 ++ ["",
-                     "#define UNMATCHED_NAT 0",
-                     "#define UNMATCHED_GCC 1",
-                     ""]
-
-            final
-               = preamble 
-                 ++ concat (pzipWith pp_ok_sync ok_syncs [1 .. num_ok])
-                 ++ ["",
-                     "//============== unmatched NAT =================",
-                     "#if UNMATCHED_NAT",
-                     ""] 
-                 ++ nat_unused
-                 ++ ["",
-                     "#endif",
-                     "",
-                     "//============== unmatched GCC =================",
-                     "#if UNMATCHED_GCC"] 
-                 ++ gcc_unused
-                 ++ ["#endif"
-                    ]
-
-        if split_markers_present
-         then putStr (unlines final)
-         else putStr ("\ndiff_gcc_nat:\n"
-                      ++ "   fatal error: NCG output doesn't contain any\n"
-                      ++ "   ___ncg_debug_marker marks.  Can't continue!\n"
-                      ++ "   To fix: enable these markers in\n" 
-                      ++ "   fptools/ghc/compiler/nativeGen/AsmCodeGen.lhs,\n"
-                      ++ "   recompile the compiler, and regenerate the assembly.\n\n")
-
-
-pp_ok_sync :: (Label, [LabelKind], [String], [String])
-           -> Int
-           -> [String]
-pp_ok_sync (lbl, kinds, nat_code, gcc_code) number
-   = reconstruct number nat_code gcc_code
-
-
-check_syncs :: [(Label, [LabelKind], [String], Maybe [String])] -- raw syncd
-            -> ( [(Label, [LabelKind], [String], [String])],  -- ok syncs
-                 [String] )                                   -- nat unsyncd
-
-check_syncs [] = ([],[])
-check_syncs (sync:syncs)
-   = let (syncs_ok, syncs_uu) = check_syncs syncs
-     in  case sync of
-            (lbl, kinds, nat, Nothing)
-               -> (syncs_ok, nat ++ syncs_uu)
-            (lbl, kinds, nat, Just gcc_code)
-               -> ((lbl,kinds,nat,gcc_code):syncs_ok, syncs_uu)
-
-
-find_correspondings :: [(Label, [LabelKind], [String])]  -- native info
-                    -> [String]                          -- gcc initial
-                    -> ( [(Label, [LabelKind], [String], Maybe [String])],
-                         [String] )
-                       -- ( native info + found gcc stuff,
-                       --   unused gcc stuff )
-
-find_correspondings native gcc_init
-   = f native gcc_init
-     where
-        wurble x (xs, gcc_final) = (x:xs, gcc_final)
-
-        f [] gcc_uu = ( [], gcc_uu )
-        f (nat:nats) gcc_uu
-           = case nat of { (lbl, kinds, nat_code) ->
-             case find_corresponding lbl kinds gcc_uu of
-                Just (gcc_code, gcc_uu2)
-                   |  gcc_code == gcc_code
-                   -> --gcc_code `seq` gcc_uu2 `seq`
-                      wurble (lbl, kinds, nat_code, Just gcc_code) (f nats gcc_uu2)
-                Nothing
-                   -> gcc_uu `seq`
-                      wurble (lbl, kinds, nat_code, Nothing) (f nats gcc_uu)
-             }
-
-
-find_corresponding :: Label                      -- root
-                   -> [LabelKind]                -- kinds
-                   -> [String]                   -- gcc text
-                   -> Maybe ([String],[String])  -- (found text, gcc leftovers)
-
-find_corresponding root kinds gcc_lines
- = -- Enable the following trace in order to debug pattern matching problems.
-   --trace (
-   --   case result of 
-   --      Nothing -> show (root,kinds) ++ "\nNothing\n\n"
-   --      Just (found,uu)
-   --         -> show (root, kinds) ++ "\n" ++ unlines found ++ "\n\n"
-   --) 
-   result
-    where
-
-     arr = listArray (1, length gcc_lines) gcc_lines
-     pfxMatch ss t
-         = let clean_t = filter (not.isSpace) t
-           in  any (`isPrefixOf` clean_t) ss 
-
-     result
-      = case kinds of
-
-        [Vtbl]
-           -> let lbl_i = find_label arr (reconstruct_label root Vtbl)
-                  fst_i = search_back arr lbl_i (pfxMatch [".text"])
-              in
-                  splice arr fst_i lbl_i
-
-        [Closure]
-           -> let lbl_i = find_label arr (reconstruct_label root Closure)
-                  fst_i = search_back arr lbl_i (pfxMatch [".data"])
-                  lst_i = search_fwds arr (lbl_i+1) 
-                             (not . pfxMatch [".long",".uaword",".uahalf"])
-              in
-                  splice arr fst_i (lst_i-1)
-
-        [Alt]
-           -> let lbl_i = find_label arr (reconstruct_label root Alt)
-                  fst_i = search_back arr lbl_i (pfxMatch ["."])
-                  lst_i = search_fwds arr lbl_i (pfxMatch [".d", ".t", ".r", ".g"])
-              in
-                  splice arr fst_i (lst_i-1)
-
-        [Dflt]
-           -> let lbl_i = find_label arr (reconstruct_label root Dflt)
-                  fst_i = search_back arr lbl_i (pfxMatch ["."])
-                  lst_i = search_fwds arr lbl_i (pfxMatch [".d", ".t", ".r", ".g"])
-              in
-                  splice arr fst_i (lst_i-1)
-
-        [Info,Entry]
-           -> let info_i  = find_label arr (reconstruct_label root Info)
-                  fst_i   = search_back arr info_i (pfxMatch [".text"])
-                  entry_i = find_label arr (reconstruct_label root Entry)
-                  lst_i   = search_fwds arr entry_i (pfxMatch [".d", ".t", ".r", ".g"])
-              in
-                  splice arr fst_i (lst_i-1)
-
-        [Info,Entry,Fast k]
-           -> let info_i  = find_label arr (reconstruct_label root Info)
-                  fst_i   = search_back arr info_i (pfxMatch [".text"])
-                  fast_i  = find_label arr (reconstruct_label root (Fast k))
-                  lst_i   = search_fwds arr fast_i (pfxMatch [".d", ".t", ".r", ".g"])
-              in
-                  splice arr fst_i (lst_i-1)
-
-        [Info,Ret]
-           -> let info_i  = find_label arr (reconstruct_label root Info)
-                  fst_i   = search_back arr info_i (pfxMatch [".text"])
-                  ret_i   = find_label arr (reconstruct_label root Ret)
-                  lst_i   = search_fwds arr ret_i (pfxMatch [".d", ".t", ".r", ".g"])
-              in
-                  splice arr fst_i (lst_i-1)
-
-        [Srt]
-           -> let lbl_i = find_label arr (reconstruct_label root Srt)
-                  fst_i = search_back arr lbl_i (pfxMatch [".text",".data"])
-                  lst_i = search_fwds arr (lbl_i+1)
-                             (not . pfxMatch [".long",".uaword",".uahalf"])
-              in
-                  splice arr fst_i (lst_i-1)
-
-        [CTbl]
-           -> let lbl_i = find_label arr (reconstruct_label root CTbl)
-                  fst_i = search_back arr lbl_i (pfxMatch [".text"])
-                  lst_i = search_fwds arr (lbl_i+1)
-                             (not . pfxMatch [".long",".uaword",".uahalf"])
-              in
-                  splice arr fst_i (lst_i-1)
-
-        [Init]
-           -> let lbl_i = find_label arr (reconstruct_label root Init)
-                  fst_i = search_back arr lbl_i (pfxMatch [".data"])
-                  lst_i = search_fwds arr lbl_i (pfxMatch [".d", ".t", ".r", ".g"])
-              in
-                  splice arr fst_i (lst_i-1)
-        other 
-           -> error ("find_corresponding: " ++ show kinds)
-
-
-search_back :: Array Int String -> Int -> (String -> Bool) -> Int
-search_back code start_ix pred
-   = let test_ixs = [start_ix, start_ix-1 .. fst (bounds code)]
-     in  case dropWhile (not . pred . (code !)) test_ixs of
-            (ok:_) -> ok
-            []     -> fst (bounds code) - 1
-
-search_fwds :: Array Int String -> Int -> (String -> Bool) -> Int
-search_fwds code start_ix pred
-   = let test_ixs = [start_ix .. snd (bounds code)]
-     in  case dropWhile (not . pred . (code !)) test_ixs of
-            (ok:_) -> ok
-            []     -> snd (bounds code) + 1
-
-
-find_label :: Array Int String -> Label -> Int
-find_label code lbl
-   = --trace (unlines (map show (assocs code))) (
-     case [idx | (idx, lbl2) <- assocs code, lbl == lbl2] of
-        [idx] -> idx
-        other -> error ("find_label `" ++ lbl ++ "'\n")
-     --)
-
-reconstruct_label :: Label -> LabelKind -> Label
-reconstruct_label root Init
-   = "__stginit_" ++ root ++ ":"
-reconstruct_label root kind
-   = root ++ "_" ++ pp kind ++ ":"
-     where
-        pp Info     = "info"
-        pp Entry    = "entry"
-        pp Closure  = "closure"
-        pp Alt      = "alt"
-        pp Vtbl     = "vtbl"
-        pp Default  = "dflt"
-        pp (Fast i) = "fast" ++ show i
-        pp Dflt     = "dflt"
-        pp Srt      = "srt"
-        pp Ret      = "ret"
-        pp CTbl     = "tbl"
-
-splice :: Array Int String -> Int -> Int -> Maybe ([String],[String])
-splice gcc_code lo hi 
-   | lo <= hi && clo <= lo && hi <= chi
-   = Just (map (gcc_code !) ix_used, 
-           map (gcc_code !) (low_ix_uu ++ high_ix_uu))
-   | otherwise
-   = error "splice"
-     where
-        (clo,chi)  = bounds gcc_code
-        low_ix_uu  = [clo .. lo-1]
-        high_ix_uu = [hi+1 .. chi]
-        ix_used    = [lo .. hi]
-
-------------------------------------
-
-getLabels :: [Label] -> [Label]
-getLabels = sort . nub . filter is_interesting_label
-
-data LabelKind
-   = Info | Entry | Fast Int | Closure | Alt | Vtbl | Default 
-   | Dflt | Srt | Ret | CTbl | Init
-     deriving (Eq, Ord, Show)
-
-breakLabel :: Label -> (Label,LabelKind)
-breakLabel s
-   = let sr = reverse s
-         kr = takeWhile (/= '_') sr
-         mr = drop (1 + length kr) sr
-         m  = reverse mr
-         k  = reverse kr
-         kind
-            | take 4 k == "fast"
-            = Fast (read (takeWhile isDigit (drop 4 k)))
-            | otherwise
-            = case k of
-                 "info:"    -> Info
-                 "entry:"   -> Entry
-                 "closure:" -> Closure
-                 "alt:"     -> Alt
-                 "vtbl:"    -> Vtbl
-                 "dflt:"    -> Dflt
-                 "srt:"     -> Srt
-                 "ret:"     -> Ret
-                 "tbl:"     -> CTbl
-                 _ -> error ("breakLabel: " ++ show (s,k,m))
-     in
-        if   head m == '_' && dropWhile (== '_') m == "stginit"
-        then (init k, Init)
-        else (m, kind)
-
-mergeBroken :: [(Label,LabelKind)] -> (Label, [LabelKind])
-mergeBroken pairs
-   = let (roots, kinds) = unzip pairs
-         ok = all (== (head roots)) (tail roots)
-              && length kinds == length (nub kinds)
-     in 
-         if ok 
-         then (head roots, sort kinds)
-         else error ("mergeBroken: " ++ show pairs)
-       
- 
-reconstruct :: Int -> Code -> Code -> Code
-reconstruct number nat_code gcc_code
-   = ["",
-      "//------------------------------------------"]
-     ++ map (comment ("//--     ")) (getLabels gcc_code)
-     ++ ["", "#if NATIVE_" ++ show number, "//nat version", ""]
-     ++ nat_code
-     ++ ["", "#else", "//gcc version", ""]
-     ++ gcc_code
-     ++ ["", "#endif"]
-
-comment str x = str ++ x
-
------------------------------------------------------
-split_marker = "___ncg_debug_marker"
-
-is_split_line s
-   = let m = split_marker
-     in  take 19 s == m || take 19 (drop 2 s) == m
-
-is_interesting_label s
-   = not (null s)
-     && not (any isSpace s)
-     && last s == ':'
-     && '_' `elem` s
-
-breakOn :: (a -> Bool) -> [a] -> [[a]]
-breakOn p [] = []
-breakOn p xs
-   = let ys = takeWhile (not . p) xs
-         rest = drop (1 + length ys) xs
-     in
-         if null ys then breakOn p rest else ys : breakOn p rest
diff --git a/ghc/utils/debugNCG/Makefile b/ghc/utils/debugNCG/Makefile
deleted file mode 100644
index 0ea51a1e06..0000000000
--- a/ghc/utils/debugNCG/Makefile
+++ /dev/null
@@ -1,19 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-INSTALL_PROGS += diff_gcc_nat
-
-SRC_HC_OPTS += -O
-OBJS = Diff_Gcc_Nat.o
-
-CLEAN_FILES += diff_gcc_nat
-
-all :: diff_gcc_nat
-
-diff_gcc_nat: Diff_Gcc_Nat.o
-	$(HC) -o $@ $(HC_OPTS) $(LD_OPTS) $(OBJS)
-
-CLEAN_FILES += diff_gcc_nat
-CLEAN_FILES += $(OBJS)
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/debugNCG/README b/ghc/utils/debugNCG/README
deleted file mode 100644
index 90eb2197cc..0000000000
--- a/ghc/utils/debugNCG/README
+++ /dev/null
@@ -1,46 +0,0 @@
-
-This program is to assist in debugging GHC's native code generator.
-
-Finding out which particular code block the native code block has
-mis-compiled is like finding a needle in a haystack.  This program
-solves that problem.  Given an assembly file created by the NCG (call
-it Foo.s-nat) and one created by gcc (Foo.s-gcc), then
-
-   diff_gcc_nat Foo.s
-
-will pair up corresponding code blocks, wrap each one in an #if and
-spew the entire result out to stdout, along with a load of #defines at
-the top, which you can use to switch between the gcc and ncg versions
-of each code block.  Pipe this into a .S file (I use the name
-synth.S).  Then you can used the #defines to do a binary search to
-quickly arrive at the code block(s) which have been mis-compiled.
-
-Note that the .S suffix tells ghc that this assembly file needs to be
-cpp'd; so you should be sure to use .S and not .s.
-
-The pattern matching can cope with the fact that the code blocks are
-in different orders in the two files.  The result synth.S is ordered
-by in the order of the -nat input; the -gcc input is searched for the
-corresponding stuff.  The search relies on spotting artefacts like
-section changes, so is fragile and susceptible to minor changes in the
-gcc's assembly output.  If that happens, it's well worth the effort
-fixing this program, rather than trying to infer what's wrong with the
-NCG directly from the -nat input.
-
-This is only known to work on x86 linux, sparc-solaris (and possibly
-cygwin).  No idea if the same matching heuristics will work on other
-archs -- if not, we need to have multiple versions of this program, on
-a per-arch basis.
-
-One other IMPORTANT thing: you *must* enable stg-split-markers in the
-native code generator output, otherwise this won't work at all --
-since it won't be able to find out where the code blocks start and
-end.  Enable these markers by compiling ghc (or at least
-ghc/compiler/nativeGen/AsmCodeGen.lhs, function nativeCodeGen) with
--DDEBUG_NCG enabled.
-
-Matching is simple but inefficient; diff-ing a large module could take
-a minute or two.
-
-JRS, 29 June 2000
-
diff --git a/ghc/utils/ext-core/Check.hs b/ghc/utils/ext-core/Check.hs
deleted file mode 100644
index a9a3eac8f4..0000000000
--- a/ghc/utils/ext-core/Check.hs
+++ /dev/null
@@ -1,421 +0,0 @@
-module Check where
-
-import Monad
-import Core
-import Printer
-import List
-import Env
-
-{- Checking is done in a simple error monad.  In addition to
-   allowing errors to be captured, this makes it easy to guarantee
-   that checking itself has been completed for an entire module. -}
-
-data CheckResult a = OkC a | FailC String
-
-instance Monad CheckResult where
-  OkC a >>= k = k a
-  FailC s >>= k = fail s
-  return = OkC
-  fail = FailC
-
-require :: Bool -> String -> CheckResult ()
-require False s = fail s
-require True  _ = return ()
-
-requireM :: CheckResult Bool -> String -> CheckResult ()
-requireM cond s =
-  do b <- cond
-     require b s
-
-{- Environments. -}
-type Tvenv = Env Tvar Kind                    -- type variables  (local only)
-type Tcenv = Env Tcon Kind                    -- type constructors
-type Tsenv = Env Tcon ([Tvar],Ty)             -- type synonyms
-type Cenv = Env Dcon Ty 		      -- data constructors
-type Venv = Env Var Ty 			      -- values
-type Menv = Env Mname Envs		      -- modules
-data Envs = Envs {tcenv_::Tcenv,tsenv_::Tsenv,cenv_::Cenv,venv_::Venv} -- all the exportable envs
-
-{- Extend an environment, checking for illegal shadowing of identifiers. -}
-extendM :: (Ord a, Show a) => Env a b -> (a,b) -> CheckResult (Env a b)
-extendM env (k,d) = 
-   case elookup env k of
-     Just _ -> fail ("multiply-defined identifier: " ++ show k)
-     Nothing -> return (eextend env (k,d))
-
-lookupM :: (Ord a, Show a) => Env a b -> a -> CheckResult b
-lookupM env k =   
-   case elookup env k of
-     Just v -> return v
-     Nothing -> fail ("undefined identifier: " ++ show k)
-            
-{- Main entry point. -}
-checkModule :: Menv -> Module -> CheckResult Menv
-checkModule globalEnv (Module mn tdefs vdefgs) = 
-  do (tcenv,tsenv) <- foldM checkTdef0 (eempty,eempty) tdefs
-     cenv <- foldM (checkTdef tcenv) eempty tdefs
-     (e_venv,l_venv) <- foldM (checkVdefg True (tcenv,tsenv,eempty,cenv)) (eempty,eempty) vdefgs
-     return (eextend globalEnv (mn,Envs{tcenv_=tcenv,tsenv_=tsenv,cenv_=cenv,venv_=e_venv}))
-  where 
-
-    checkTdef0 :: (Tcenv,Tsenv) -> Tdef -> CheckResult (Tcenv,Tsenv)
-    checkTdef0 (tcenv,tsenv) tdef = ch tdef
-      where 
-	ch (Data (m,c) tbs _) = 
-	    do require (m == mn) ("wrong module name in data type declaration:\n" ++ show tdef)
-	       tcenv' <- extendM tcenv (c,k)
-	       return (tcenv',tsenv)
-	    where k = foldr Karrow Klifted (map snd tbs)
-	ch (Newtype (m,c) tbs rhs) = 
-	    do require (m == mn) ("wrong module name in newtype declaration:\n" ++ show tdef)
-	       tcenv' <- extendM tcenv (c,k)
-	       tsenv' <- case rhs of
-			   Nothing -> return tsenv
-			   Just rep -> extendM tsenv (c,(map fst tbs,rep))
-	       return (tcenv', tsenv')
-	    where k = foldr Karrow Klifted (map snd tbs)
-    
-    checkTdef :: Tcenv -> Cenv -> Tdef -> CheckResult Cenv
-    checkTdef tcenv cenv = ch
-       where 
-	 ch (Data (_,c) utbs cdefs) = 
-	    do cbinds <- mapM checkCdef cdefs
-	       foldM extendM cenv cbinds
-	    where checkCdef (cdef@(Constr (m,dcon) etbs ts)) =
-		    do require (m == mn) ("wrong module name in constructor declaration:\n" ++ show cdef)
-		       tvenv <- foldM extendM eempty tbs 
-		       ks <- mapM (checkTy (tcenv,tvenv)) ts
-		       mapM_ (\k -> require (baseKind k)
-					    ("higher-order kind in:\n" ++ show cdef ++ "\n" ++
-					     "kind: " ++ show k) ) ks
-		       return (dcon,t) 
-		    where tbs = utbs ++ etbs
-			  t = foldr Tforall 
-				  (foldr tArrow
-					  (foldl Tapp (Tcon (mn,c))
-						 (map (Tvar . fst) utbs)) ts) tbs
-	 ch (tdef@(Newtype c tbs (Just t))) =  
-	    do tvenv <- foldM extendM eempty tbs
-	       k <- checkTy (tcenv,tvenv) t
-	       require (k==Klifted) ("bad kind:\n" ++ show tdef) 
-	       return cenv
-	 ch (tdef@(Newtype c tbs Nothing)) =
-	    {- should only occur for recursive Newtypes -}
-	    return cenv
-    
-
-    checkVdefg :: Bool -> (Tcenv,Tsenv,Tvenv,Cenv) -> (Venv,Venv) -> Vdefg -> CheckResult (Venv,Venv)
-    checkVdefg top_level (tcenv,tsenv,tvenv,cenv) (e_venv,l_venv) vdefg =
-      case vdefg of
-	Rec vdefs ->
-	    do e_venv' <- foldM extendM e_venv e_vts
-	       l_venv' <- foldM extendM l_venv l_vts
-	       let env' = (tcenv,tsenv,tvenv,cenv,e_venv',l_venv')
-	       mapM_ (\ (vdef@(Vdef ((m,v),t,e))) -> 
-			    do require (m == "" || m == mn) ("wrong module name in value definition:\n" ++ show vdef)
-			       k <- checkTy (tcenv,tvenv) t
-			       require (k==Klifted) ("unlifted kind in:\n" ++ show vdef)
-			       t' <- checkExp env' e
-			       requireM (equalTy tsenv t t') 
-					("declared type doesn't match expression type in:\n"  ++ show vdef ++ "\n" ++  
-					 "declared type: " ++ show t ++ "\n" ++
-					 "expression type: " ++ show t')) vdefs
-	       return (e_venv',l_venv')
-	    where e_vts  = [ (v,t) | Vdef ((m,v),t,_) <- vdefs, m /= "" ]
-	          l_vts  = [ (v,t) | Vdef (("",v),t,_) <- vdefs]
-	Nonrec (vdef@(Vdef ((m,v),t,e))) ->
-	    do require (m == "" || m == mn) ("wrong module name in value definition:\n" ++ show vdef)
-	       k <- checkTy (tcenv,tvenv) t 
-	       require (k /= Kopen) ("open kind in:\n" ++ show vdef)
-	       require ((not top_level) || (k /= Kunlifted)) ("top-level unlifted kind in:\n" ++ show vdef) 
-	       t' <- checkExp (tcenv,tsenv,tvenv,cenv,e_venv,l_venv) e
-	       requireM (equalTy tsenv t t') 
-			("declared type doesn't match expression type in:\n" ++ show vdef  ++ "\n"  ++
-			 "declared type: " ++ show t ++ "\n" ++
-			 "expression type: " ++ show t') 
-	       if m == "" then
-                 do l_venv' <- extendM l_venv (v,t)
-                    return (e_venv,l_venv')
-	        else
-		 do e_venv' <- extendM e_venv (v,t)
-                    return (e_venv',l_venv)
-    
-    checkExp ::  (Tcenv,Tsenv,Tvenv,Cenv,Venv,Venv) -> Exp -> CheckResult Ty
-    checkExp (tcenv,tsenv,tvenv,cenv,e_venv,l_venv) = ch 
-      where 
-	ch e0 = 
-	  case e0 of
-	    Var qv -> 
-	      qlookupM venv_ e_venv l_venv qv
-	    Dcon qc ->
-	      qlookupM cenv_ cenv eempty qc
-	    Lit l -> 
-	      checkLit l
-	    Appt e t -> 
-	      do t' <- ch e
-		 k' <- checkTy (tcenv,tvenv) t
-		 case t' of
-		   Tforall (tv,k) t0 ->
-		     do require (k' <= k) 
-				("kind doesn't match at type application in:\n" ++ show e0 ++ "\n" ++
-				 "operator kind: " ++ show k ++ "\n" ++
-				 "operand kind: " ++ show k') 
-			return (substl [tv] [t] t0)
-		   _ -> fail ("bad operator type in type application:\n" ++ show e0 ++ "\n" ++
-			       "operator type: " ++ show t')
-	    App e1 e2 -> 
-	      do t1 <- ch e1
-		 t2 <- ch e2
-		 case t1 of
-		   Tapp(Tapp(Tcon tc) t') t0 | tc == tcArrow ->
-			do requireM (equalTy tsenv t2 t') 
-				    ("type doesn't match at application in:\n" ++ show e0 ++ "\n" ++ 
-				     "operator type: " ++ show t' ++ "\n" ++ 
-				     "operand type: " ++ show t2) 
-			   return t0
-		   _ -> fail ("bad operator type at application in:\n" ++ show e0 ++ "\n" ++
-			       "operator type: " ++ show t1)
-	    Lam (Tb tb) e ->
-	      do tvenv' <- extendM tvenv tb 
-		 t <- checkExp (tcenv,tsenv,tvenv',cenv,e_venv,l_venv) e 
-		 return (Tforall tb t)
-	    Lam (Vb (vb@(_,vt))) e ->
-	      do k <- checkTy (tcenv,tvenv) vt
-		 require (baseKind k) 	
-			 ("higher-order kind in:\n" ++ show e0 ++ "\n" ++
-			  "kind: " ++ show k) 
-		 l_venv' <- extendM l_venv vb
-		 t <- checkExp (tcenv,tsenv,tvenv,cenv,e_venv,l_venv') e
-		 require (not (isUtupleTy vt)) ("lambda-bound unboxed tuple in:\n" ++ show e0) 
-		 return (tArrow vt t)
-	    Let vdefg e ->
-	      do (e_venv',l_venv') <- checkVdefg False (tcenv,tsenv,tvenv,cenv) (e_venv,l_venv) vdefg 
-		 checkExp (tcenv,tsenv,tvenv,cenv,e_venv',l_venv') e
-	    Case e (v,t) alts ->
-	      do t' <- ch e 
-		 checkTy (tcenv,tvenv) t
-		 requireM (equalTy tsenv t t') 
-			  ("scrutinee declared type doesn't match expression type in:\n" ++ show e0 ++ "\n" ++
-			   "declared type: " ++ show t ++ "\n" ++
-			   "expression type: " ++ show t') 
-		 case (reverse alts) of
-		   (Acon c _ _ _):as ->
-		      let ok ((Acon c _ _ _):as) cs = do require (notElem c cs)
-								 ("duplicate alternative in case:\n" ++ show e0) 
-							 ok as (c:cs)
-			  ok ((Alit _ _):_)      _  = fail ("invalid alternative in constructor case:\n" ++ show e0)
-			  ok [Adefault _]        _  = return ()
-			  ok (Adefault _:_)      _  = fail ("misplaced default alternative in case:\n" ++ show e0)
-			  ok []                  _  = return () 
-		      in ok as [c] 
-		   (Alit l _):as -> 
-		      let ok ((Acon _ _ _ _):_) _  = fail ("invalid alternative in literal case:\n" ++ show e0)
-			  ok ((Alit l _):as)    ls = do require (notElem l ls)
-								("duplicate alternative in case:\n" ++ show e0) 
-							ok as (l:ls)
-			  ok [Adefault _]       _  = return ()
-			  ok (Adefault _:_)     _  = fail ("misplaced default alternative in case:\n" ++ show e0)
-			  ok []                 _  = fail ("missing default alternative in literal case:\n" ++ show e0)
-		      in ok as [l] 
-		   [Adefault _] -> return ()
-		   [] -> fail ("no alternatives in case:\n" ++ show e0) 
-		 l_venv' <- extendM l_venv (v,t)
-		 t:ts <- mapM (checkAlt (tcenv,tsenv,tvenv,cenv,e_venv,l_venv') t) alts  
-		 bs <- mapM (equalTy tsenv t) ts
-		 require (and bs)
-			 ("alternative types don't match in:\n" ++ show e0 ++ "\n" ++
-			  "types: " ++ show (t:ts))
-		 return t
-	    Coerce t e -> 
-	      do ch e 
-		 checkTy (tcenv,tvenv) t 
-		 return t
-	    Note s e -> 
-	      ch e
-	    External _ t -> 
-	      do checkTy (tcenv,eempty) t {- external types must be closed -}
-		 return t
-    
-    checkAlt :: (Tcenv,Tsenv,Tvenv,Cenv,Venv,Venv) -> Ty -> Alt -> CheckResult Ty 
-    checkAlt (env@(tcenv,tsenv,tvenv,cenv,e_venv,l_venv)) t0 = ch
-      where 
-	ch a0 = 
-	  case a0 of 
-	    Acon qc etbs vbs e ->
-	      do let uts = f t0                                      
-		       where f (Tapp t0 t) = f t0 ++ [t]
-			     f _ = []
-		 ct <- qlookupM cenv_ cenv eempty qc
-		 let (tbs,ct_args0,ct_res0) = splitTy ct
-		 {- get universals -}
-		 let (utbs,etbs') = splitAt (length uts) tbs
-		 let utvs = map fst utbs
-		 {- check existentials -}
-		 let (etvs,eks) = unzip etbs
-		 let (etvs',eks') = unzip etbs'
-		 require (eks == eks')  
-			 ("existential kinds don't match in:\n" ++ show a0 ++ "\n" ++
-			  "kinds declared in data constructor: " ++ show eks ++
-			  "kinds declared in case alternative: " ++ show eks') 
-		 tvenv' <- foldM extendM tvenv etbs
-		 {- check term variables -}
-		 let vts = map snd vbs
-		 mapM_ (\vt -> require ((not . isUtupleTy) vt)
-				       ("pattern-bound unboxed tuple in:\n" ++ show a0 ++ "\n" ++
-					"pattern type: " ++ show vt)) vts
-		 vks <- mapM (checkTy (tcenv,tvenv')) vts
-		 mapM_ (\vk -> require (baseKind vk)
-				       ("higher-order kind in:\n" ++ show a0 ++ "\n" ++
-					"kind: " ++ show vk)) vks 
-		 let (ct_res:ct_args) = map (substl (utvs++etvs') (uts++(map Tvar etvs))) (ct_res0:ct_args0)
-		 zipWithM_ 
-		    (\ct_arg vt -> 
-			requireM (equalTy tsenv ct_arg vt)
-			         ("pattern variable type doesn't match constructor argument type in:\n" ++ show a0 ++ "\n" ++
-				  "pattern variable type: " ++ show ct_arg ++ "\n" ++
-				  "constructor argument type: " ++ show vt)) ct_args vts
-		 requireM (equalTy tsenv ct_res t0)
-			  ("pattern constructor type doesn't match scrutinee type in:\n" ++ show a0 ++ "\n" ++
-			   "pattern constructor type: " ++ show ct_res ++ "\n" ++
-			   "scrutinee type: " ++ show t0) 
-		 l_venv' <- foldM extendM l_venv vbs
-		 t <- checkExp (tcenv,tsenv,tvenv',cenv,e_venv,l_venv') e 
-		 checkTy (tcenv,tvenv) t  {- check that existentials don't escape in result type -}
-		 return t
-	    Alit l e ->
-	      do t <- checkLit l
-		 requireM (equalTy tsenv t t0)
-			 ("pattern type doesn't match scrutinee type in:\n" ++ show a0 ++ "\n" ++
-			  "pattern type: " ++ show t ++ "\n" ++
-			  "scrutinee type: " ++ show t0) 
-		 checkExp env e
-	    Adefault e ->
-	      checkExp env e
-    
-    checkTy :: (Tcenv,Tvenv) -> Ty -> CheckResult Kind
-    checkTy (tcenv,tvenv) = ch
-     where
-       ch (Tvar tv) = lookupM tvenv tv
-       ch (Tcon qtc) = qlookupM tcenv_ tcenv eempty qtc
-       ch (t@(Tapp t1 t2)) = 
-	   do k1 <- ch t1
-	      k2 <- ch t2
-	      case k1 of
-		 Karrow k11 k12 ->
-		   do require (k2 <= k11) 
-			     ("kinds don't match in type application: " ++ show t ++ "\n" ++
-			      "operator kind: " ++ show k11 ++ "\n" ++
-			      "operand kind: " ++ show k2) 		
-		      return k12
-		 _ -> fail ("applied type has non-arrow kind: " ++ show t)
-       ch (Tforall tb t) = 
-	    do tvenv' <- extendM tvenv tb 
-	       checkTy (tcenv,tvenv') t
-    
-    {- Type equality modulo newtype synonyms. -}
-    equalTy :: Tsenv -> Ty -> Ty -> CheckResult Bool
-    equalTy tsenv t1 t2 = 
-	    do t1' <- expand t1
-	       t2' <- expand t2
-	       return (t1' == t2')
-      where expand (Tvar v) = return (Tvar v)
-	    expand (Tcon qtc) = return (Tcon qtc)
-	    expand (Tapp t1 t2) = 
-	      do t2' <- expand t2
-		 expapp t1 [t2']
-	    expand (Tforall tb t) = 
-	      do t' <- expand t
-		 return (Tforall tb t')
-	    expapp (t@(Tcon (m,tc))) ts = 
-	      do env <- mlookupM tsenv_ tsenv eempty m
-		 case elookup env tc of 
-		    Just (formals,rhs) | (length formals) == (length ts) -> return (substl formals ts rhs)
-		    _ -> return (foldl Tapp t ts)
-	    expapp (Tapp t1 t2) ts = 
-	      do t2' <- expand t2
-		 expapp t1 (t2':ts)
-	    expapp t ts = 
-	      do t' <- expand t
-		 return (foldl Tapp t' ts)
-    
-
-    mlookupM :: (Envs -> Env a b) -> Env a b -> Env a b -> Mname -> CheckResult (Env a b)
-    mlookupM selector external_env local_env m =   
-      if m == "" then
-        return local_env
-      else if m == mn then
-        return external_env
-      else 
-        case elookup globalEnv m of
-          Just env' -> return (selector env')
-          Nothing -> fail ("undefined module name: " ++ show m)
-
-    qlookupM :: (Ord a, Show a) => (Envs -> Env a b) -> Env a b -> Env a b -> (Mname,a) -> CheckResult b
-    qlookupM selector external_env local_env (m,k) =   
-      do env <- mlookupM selector external_env local_env m
-	 lookupM env k
-
-
-checkLit :: Lit -> CheckResult Ty
-checkLit lit =
-  case lit of
-    Lint _ t -> 
-	  do {- require (elem t [tIntzh, {- tInt32zh,tInt64zh, -} tWordzh, {- tWord32zh,tWord64zh, -} tAddrzh, tCharzh]) 
-		     ("invalid int literal: " ++ show lit ++ "\n" ++ "type: " ++ show t) -}
-	     return t
-    Lrational _ t ->
-	  do {- require (elem t [tFloatzh,tDoublezh]) 
-		     ("invalid rational literal: " ++ show lit ++ "\n" ++ "type: " ++ show t) -}
-	     return t
-    Lchar _ t -> 
-	  do {- require (t == tCharzh) 
-		     ("invalid char literal: " ++ show lit ++ "\n" ++ "type: " ++ show t)  -}
-	     return t	
-    Lstring _ t ->
-	  do {- require (t == tAddrzh) 
-		     ("invalid string literal: " ++ show lit ++ "\n" ++ "type: " ++ show t)  -}
-	     return t
-
-{- Utilities -}
-
-{- Split off tbs, arguments and result of a (possibly abstracted)  arrow type -}
-splitTy :: Ty -> ([Tbind],[Ty],Ty)
-splitTy (Tforall tb t) = (tb:tbs,ts,tr) 
-		where (tbs,ts,tr) = splitTy t
-splitTy (Tapp(Tapp(Tcon tc) t0) t) | tc == tcArrow = (tbs,t0:ts,tr)
-		where (tbs,ts,tr) = splitTy t
-splitTy t = ([],[],t)
-
-
-{- Simultaneous substitution on types for type variables,
-   renaming as neceessary to avoid capture.
-   No checks for correct kindedness. -}
-substl :: [Tvar] -> [Ty] -> Ty -> Ty
-substl tvs ts t = f (zip tvs ts) t
-  where 
-    f env t0 =
-     case t0 of
-       Tcon _ -> t0
-       Tvar v -> case lookup v env of
-                   Just t1 -> t1
-                   Nothing -> t0
-       Tapp t1 t2 -> Tapp (f env t1) (f env t2)
-       Tforall (t,k) t1 -> 
-         if t `elem` free then
-           Tforall (t',k) (f ((t,Tvar t'):env) t1)
-         else 
-	   Tforall (t,k) (f (filter ((/=t).fst) env) t1)
-     where free = foldr union [] (map (freeTvars.snd) env)
-           t' = freshTvar free 
-   
-{- Return free tvars in a type -}
-freeTvars :: Ty -> [Tvar]
-freeTvars (Tcon _) = []
-freeTvars (Tvar v) = [v]
-freeTvars (Tapp t1 t2) = (freeTvars t1) `union` (freeTvars t2)
-freeTvars (Tforall (t,_) t1) = delete t (freeTvars t1) 
-
-{- Return any tvar *not* in the argument list. -}
-freshTvar :: [Tvar] -> Tvar
-freshTvar tvs = maximum ("":tvs) ++ "x" -- one simple way!
-
diff --git a/ghc/utils/ext-core/Core.hs b/ghc/utils/ext-core/Core.hs
deleted file mode 100644
index 2f94f80b3e..0000000000
--- a/ghc/utils/ext-core/Core.hs
+++ /dev/null
@@ -1,150 +0,0 @@
-module Core where
-
-import List (elemIndex)
-
-data Module 
- = Module Mname [Tdef] [Vdefg]
-
-data Tdef 
-  = Data (Qual Tcon) [Tbind] [Cdef]
-  | Newtype (Qual Tcon) [Tbind] (Maybe Ty)
-
-data Cdef 
-  = Constr (Qual Dcon) [Tbind] [Ty]
-
-data Vdefg 
-  = Rec [Vdef]
-  | Nonrec Vdef
-
-newtype Vdef = Vdef (Qual Var,Ty,Exp)
-
-data Exp 
-  = Var (Qual Var)
-  | Dcon (Qual Dcon)
-  | Lit Lit
-  | App Exp Exp
-  | Appt Exp Ty
-  | Lam Bind Exp 	  
-  | Let Vdefg Exp
-  | Case Exp Vbind [Alt] {- non-empty list -}
-  | Coerce Ty Exp 
-  | Note String Exp
-  | External String Ty
-
-data Bind 
-  = Vb Vbind
-  | Tb Tbind
-
-data Alt 
-  = Acon (Qual Dcon) [Tbind] [Vbind] Exp
-  | Alit Lit Exp
-  | Adefault Exp
-
-type Vbind = (Var,Ty)
-type Tbind = (Tvar,Kind)
-
-data Ty 
-  = Tvar Tvar
-  | Tcon (Qual Tcon)
-  | Tapp Ty Ty
-  | Tforall Tbind Ty 
-
-data Kind 
-  = Klifted
-  | Kunlifted
-  | Kopen
-  | Karrow Kind Kind
-  deriving (Eq)
-
-data Lit 
-  = Lint Integer Ty
-  | Lrational Rational Ty
-  | Lchar Char Ty
-  | Lstring String Ty
-  deriving (Eq)  -- with nearlyEqualTy 
-
-type Mname = Id
-type Var = Id
-type Tvar = Id
-type Tcon = Id
-type Dcon = Id
-
-type Qual t = (Mname,t)
-
-type Id = String
-
-{- Doesn't expand out fully applied newtype synonyms
-   (for which an environment is needed). -}
-nearlyEqualTy t1 t2 =  eqTy [] [] t1 t2 
-  where eqTy e1 e2 (Tvar v1) (Tvar v2) =
-	     case (elemIndex v1 e1,elemIndex v2 e2) of
-               (Just i1, Just i2) -> i1 == i2
-               (Nothing, Nothing)  -> v1 == v2
-               _ -> False
-	eqTy e1 e2 (Tcon c1) (Tcon c2) = c1 == c2
-        eqTy e1 e2 (Tapp t1a t1b) (Tapp t2a t2b) =
-	      eqTy e1 e2 t1a t2a && eqTy e1 e2 t1b t2b
-        eqTy e1 e2 (Tforall (tv1,tk1) t1) (Tforall (tv2,tk2) t2) =
-	      tk1 == tk2 && eqTy (tv1:e1) (tv2:e2) t1 t2 
-	eqTy _ _ _ _ = False
-instance Eq Ty where (==) = nearlyEqualTy
-
-
-subKindOf :: Kind -> Kind -> Bool
-_ `subKindOf` Kopen = True
-k1 `subKindOf` k2 = k1 == k2  -- doesn't worry about higher kinds
-
-instance Ord Kind where (<=) = subKindOf
-
-baseKind :: Kind -> Bool
-baseKind (Karrow _ _ ) = False
-baseKind _ = True
-
-primMname = "PrelGHC"
-
-tcArrow :: Qual Tcon
-tcArrow = (primMname, "ZLzmzgZR")
-
-tArrow :: Ty -> Ty -> Ty
-tArrow t1 t2 = Tapp (Tapp (Tcon tcArrow) t1) t2
-
-ktArrow :: Kind
-ktArrow = Karrow Kopen (Karrow Kopen Klifted)
-
-{- Unboxed tuples -}
-
-maxUtuple :: Int
-maxUtuple = 100
-
-tcUtuple :: Int -> Qual Tcon
-tcUtuple n = (primMname,"Z"++ (show n) ++ "H")
-
-ktUtuple :: Int -> Kind
-ktUtuple n = foldr Karrow Kunlifted (replicate n Kopen)
-
-tUtuple :: [Ty] -> Ty
-tUtuple ts = foldl Tapp (Tcon (tcUtuple (length ts))) ts 
-
-isUtupleTy :: Ty -> Bool
-isUtupleTy (Tapp t _) = isUtupleTy t
-isUtupleTy (Tcon tc) = tc `elem` [tcUtuple n | n <- [1..maxUtuple]]
-isUtupleTy _ = False
-
-dcUtuple :: Int -> Qual Dcon
-dcUtuple n = (primMname,"ZdwZ" ++ (show n) ++ "H")
-
-isUtupleDc :: Qual Dcon -> Bool
-isUtupleDc dc = dc `elem` [dcUtuple n | n <- [1..maxUtuple]]
-
-dcUtupleTy :: Int -> Ty
-dcUtupleTy n = 
-     foldr ( \tv t -> Tforall (tv,Kopen) t)
-           (foldr ( \tv t -> tArrow (Tvar tv) t)
-		  (tUtuple (map Tvar tvs)) tvs) 
-           tvs
-     where tvs = map ( \i -> ("a" ++ (show i))) [1..n] 
-
-utuple :: [Ty] -> [Exp] -> Exp
-utuple ts es = foldl App (foldl Appt (Dcon (dcUtuple (length es))) ts) es
-
-
diff --git a/ghc/utils/ext-core/Driver.hs b/ghc/utils/ext-core/Driver.hs
deleted file mode 100644
index 2328eca22a..0000000000
--- a/ghc/utils/ext-core/Driver.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-{- A simple driver that loads, typechecks, prepares, re-typechecks, and interprets the 
-    GHC standard Prelude modules and an application module called Main. 
-
-   Note that, if compiled under GHC, this requires a very large heap to run!
--}
-
-import Monad
-import Core
-import Printer
-import Parser
-import Lex
-import ParseGlue
-import Env
-import Prims
-import Check
-import Prep
-import Interp
-
-process (senv,modules) f = 
-       do putStrLn ("Processing " ++ f)
-          s <- readFile f
-	  case parse s 1 of
-	    OkP m -> do putStrLn "Parse succeeded"
-			{- writeFile (f ++ ".parsed") (show m) -}
-			case checkModule senv m of
-			  OkC senv' -> 
-			    do putStrLn "Check succeeded"
-			       let m' = prepModule senv' m
-                               {- writeFile (f ++ ".prepped") (show m') -}
-			       case checkModule senv m' of
-                                 OkC senv'' ->
-				   do putStrLn "Recheck succeeded"
-                                      return (senv'',modules ++ [m'])
-				 FailC s -> 
-				   do putStrLn ("Recheck failed: " ++ s)
-				      error "quit"
-			  FailC s -> 
-			    do putStrLn ("Check failed: " ++ s)
-			       error "quit"
-            FailP s -> do putStrLn ("Parse failed: " ++ s)
-                          error "quit"
-
-main = do (_,modules) <- foldM process (initialEnv,[]) flist
-	  let result = evalProgram modules
-	  putStrLn ("Result = " ++ show result)
-	  putStrLn "All done"
-       where flist = 	 ["PrelBase.hcr",
-			  "PrelMaybe.hcr",
-			  "PrelTup.hcr",
-			  "PrelList.hcr", 
-			  "PrelShow.hcr",
-			  "PrelEnum.hcr",
-			  "PrelNum.hcr",
-			  "PrelST.hcr",
-			  "PrelArr.hcr",
-			  "PrelDynamic.hcr",
-			  "PrelReal.hcr",
-			  "PrelFloat.hcr",
-			  "PrelRead.hcr",
-			  "PrelIOBase.hcr",
-			  "PrelException.hcr",
-			  "PrelErr.hcr",
-			  "PrelConc.hcr",
-			  "PrelPtr.hcr",
-			  "PrelByteArr.hcr",
-			  "PrelPack.hcr",
-			  "PrelBits.hcr",
-			  "PrelWord.hcr",
-			  "PrelInt.hcr",
-			  "PrelCTypes.hcr",
-			  "PrelStable.hcr",
-			  "PrelCTypesISO.hcr",
-			  "Monad.hcr",
-			  "PrelStorable.hcr",
-			  "PrelMarshalAlloc.hcr",
-			  "PrelMarshalUtils.hcr",
-			  "PrelMarshalArray.hcr",
-			  "PrelCString.hcr",
-			  "PrelMarshalError.hcr",
-			  "PrelCError.hcr",
-			  "PrelPosix.hcr",
-			  "PrelHandle.hcr",
-			  "PrelIO.hcr",
-			  "Prelude.hcr",
-			  "Main.hcr" ] 
-
diff --git a/ghc/utils/ext-core/Env.hs b/ghc/utils/ext-core/Env.hs
deleted file mode 100644
index 6f6973c558..0000000000
--- a/ghc/utils/ext-core/Env.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-{- Environments.
-   Uses lists for simplicity and to make the semantics clear.
-   A real implementation should use balanced trees or hash tables.
--}
-
-module Env (Env,
-	    eempty,
-	    elookup,
-	    eextend,
-            edomain,
-	    efromlist,
-	    efilter,
-	    eremove)
-where
-
-import List
-
-data Env a b = Env [(a,b)] 
- deriving (Show)
-
-eempty :: Env a b 
-eempty = Env []
-
-{- In case of duplicates, returns most recently added entry. -}
-elookup :: (Eq a) => Env a b -> a -> Maybe b
-elookup (Env l) k = lookup k l 
-
-{- May hide existing entries. -}
-eextend :: Env a b -> (a,b) -> Env a b
-eextend (Env l) (k,d) = Env ((k,d):l)
-
-edomain :: (Eq a) => Env a b -> [a]
-edomain (Env l) = nub (map fst l)
-
-{- In case of duplicates, first entry hides others. -}
-efromlist :: [(a,b)] -> Env a b
-efromlist l = Env l
-
-eremove :: (Eq a)  => Env a b -> a -> Env a b
-eremove (Env l) k = Env (filter ((/= k).fst) l)
-
-efilter :: Env a b -> (a -> Bool) -> Env a b
-efilter (Env l) p = Env (filter (p.fst) l)
-
diff --git a/ghc/utils/ext-core/Interp.hs b/ghc/utils/ext-core/Interp.hs
deleted file mode 100644
index 1988ae9cf3..0000000000
--- a/ghc/utils/ext-core/Interp.hs
+++ /dev/null
@@ -1,450 +0,0 @@
-{- 
-Interprets the subset of well-typed Core programs for which
-	(a) All constructor and primop applications are saturated
-	(b) All non-trivial expressions of unlifted kind ('#') are
-             scrutinized in a Case expression.
-
-This is by no means a "minimal" interpreter, in the sense that considerably
-simpler machinary could be used to run programs and get the right answers.
-However, it attempts to mirror the intended use of various Core constructs,
-particularly with respect to heap usage.  So considerations such as unboxed
-tuples, sharing, trimming, black-holing, etc. are all covered.
-The only major omission is garbage collection.
-
-Just a sampling of primitive types and operators are included.
--}
-
-module Interp where
-
-import Core
-import Printer
-import Monad
-import Env
-import List
-import Char
-import Prims
-
-data HeapValue = 
-    Hconstr Dcon [Value]       -- constructed value (note: no qualifier needed!)
-  | Hclos Venv Var Exp         -- function closure
-  | Hthunk Venv Exp            -- unevaluated thunk
-  deriving (Show)
-
-type Ptr = Int
-
-data Value = 
-    Vheap Ptr 		       -- heap pointer (boxed)
-  | Vimm PrimValue     	       -- immediate primitive value (unboxed)
-  | Vutuple [Value]            -- unboxed tuples
-  deriving (Show)
-
-type Venv = Env Var Value       -- values of vars
-
-data PrimValue =                -- values of the (unboxed) primitive types
-    PCharzh Integer		-- actually 31-bit unsigned
-  | PIntzh Integer		-- actually WORD_SIZE_IN_BITS-bit signed
-  | PWordzh Integer		-- actually WORD_SIZE_IN_BITS-bit unsigned
-  | PAddrzh Integer		-- actually native pointer size
-  | PFloatzh Rational		-- actually 32-bit 
-  | PDoublezh Rational		-- actually 64-bit
---  etc., etc.
-  deriving (Eq,Show)
-
-type Menv = Env Mname Venv	-- modules
-
-initialGlobalEnv :: Menv
-initialGlobalEnv =
-    efromlist
-	[(primMname,efromlist [("realWorldzh",Vimm (PIntzh 0))])]
-
-{- Heap management. -}
-{- Nothing is said about garbage collection. -}
-
-data Heap = Heap Ptr (Env Ptr HeapValue) -- last cell allocated; environment of allocated cells
-  deriving (Show)
-
-hallocate :: Heap -> HeapValue -> (Heap,Ptr)
-hallocate (Heap last contents) v = 
-   let next = last+1
-   in (Heap next (eextend contents (next,v)),next)
-
-hupdate :: Heap -> Ptr -> HeapValue -> Heap
-hupdate (Heap last contents) p v =
-   Heap last (eextend contents (p,v))
-
-hlookup:: Heap -> Ptr -> HeapValue
-hlookup (Heap _ contents) p =
-   case elookup contents p of
-     Just v -> v
-     Nothing -> error "Missing heap entry (black hole?)"
-
-hremove :: Heap -> Ptr -> Heap
-hremove (Heap last contents) p = 
-   Heap last (eremove contents p)
-
-hempty :: Heap
-hempty = Heap 0 eempty
-
-{- The evaluation monad manages the heap and the possiblity 
-   of exceptions. -}
-
-type Exn = Value
-
-newtype Eval a = Eval (Heap -> (Heap,Either a Exn))
-
-instance Monad Eval where
-  (Eval m) >>= k = Eval (
-             \h -> case m h of
-                    (h',Left x) -> case k x of
-                                     Eval k' -> k' h'
-                    (h',Right exn) -> (h',Right exn))
-  return x = Eval (\h -> (h,Left x))
-
-hallocateE :: HeapValue -> Eval Ptr
-hallocateE v = Eval (\ h -> 
-   let (h',p) = hallocate h v
-   in (h', Left p))
-
-hupdateE :: Ptr -> HeapValue -> Eval ()
-hupdateE p v = Eval (\h -> (hupdate h p v,Left ()))
-
-hlookupE :: Ptr -> Eval HeapValue
-hlookupE p =  Eval (\h -> (h,Left (hlookup h p)))
-
-hremoveE :: Ptr -> Eval ()
-hremoveE p = Eval (\h -> (hremove h p, Left ()))
-
-raiseE :: Exn -> Eval a
-raiseE exn = Eval (\h -> (h,Right exn))
-
-catchE :: Eval a -> (Exn -> Eval a) -> Eval a
-catchE (Eval m) f = Eval 
-                       (\h -> case m h of
-                               (h',Left x) -> (h',Left x)
-                               (h',Right exn) -> 
-                                       case f exn of
-                                         Eval f' -> f' h')
-
-runE :: Eval a -> a
-runE (Eval f) = 
-  case f hempty of
-    (_,Left v) -> v
-    (_,Right exn) ->  error ("evaluation failed with uncaught exception: " ++ show exn)
-
-
-{- Main entry point -}
-evalProgram :: [Module] -> Value
-evalProgram modules =
- runE(
-  do globalEnv <- foldM evalModule initialGlobalEnv modules
-     Vutuple [_,v] <- evalExp globalEnv eempty (App (Var ("Main","main")) (Var (primMname,"realWorldzh")))
-     return v)
-
-{- Environments:
-
-Evaluating a module just fills an environment with suspensions for all
-the external top-level values; it doesn't actually do any evaluation
-or look anything up.
-
-By the time we actually evaluate an expression, all external values from
-all modules will be in globalEnv.  So evaluation just maintains an environment
-of non-external values (top-level or local).  In particular, only non-external
-values end up in closures (all other values are accessible from globalEnv.)
-
-Throughout:
-
-- globalEnv contains external values (all top-level) from all modules seen so far.
-
-In evalModule:
-
-- e_venv    contains external values (all top-level) seen so far in current module
-- l_venv    contains non-external values (top-level or local)  
-                 seen so far in current module.
-In evalExp:
-
-- env	    contains non-external values (top-level or local) seen so far
-		in current expression.
--}
-
-
-evalModule :: Menv -> Module -> Eval Menv
-evalModule globalEnv (Module mn tdefs vdefgs) = 
-  do (e_venv,l_venv) <- foldM evalVdef (eempty,eempty) vdefgs
-     return (eextend globalEnv (mn,e_venv))
-  where
-    evalVdef :: (Venv,Venv) -> Vdefg -> Eval (Venv,Venv)
-    evalVdef (e_env,l_env) (Nonrec(Vdef((m,x),t,e))) =
-     do p <- hallocateE (suspendExp l_env e)
-	let heaps = 
-	       if m == "" then 
-		 (e_env,eextend l_env (x,Vheap p))
-	       else 
-		 (eextend e_env (x,Vheap p),l_env)
-	return heaps
-    evalVdef (e_env,l_env) (Rec vdefs) =
-      do l_vs0 <- mapM preallocate l_xs
-	 let l_env' = foldl eextend l_env (zip l_xs l_vs0)
-	 let l_hs = map (suspendExp l_env') l_es
-	 mapM_ reallocate (zip l_vs0 l_hs)
-	 let e_hs = map (suspendExp l_env') e_es
-	 e_vs <- mapM allocate e_hs
-	 let e_env' = foldl eextend e_env (zip e_xs e_vs)
-	 return (e_env',l_env')            
-      where 
-	 (l_xs,l_es) = unzip [(x,e) | Vdef(("",x),_,e) <- vdefs]
-	 (e_xs,e_es) = unzip [(x,e) | Vdef((m,x),_,e) <- vdefs, m /= ""]
-	 preallocate _ =
-	   do p <- hallocateE undefined
-	      return (Vheap p)
-	 reallocate (Vheap p0,h) =
-	   hupdateE p0 h
-	 allocate h =
-	   do p <- hallocateE h
-	      return (Vheap p)
-
-    suspendExp:: Venv -> Exp -> HeapValue
-    suspendExp env (Lam (Vb(x,_)) e) = Hclos env' x e
-       where env' = thin env (delete x (freevarsExp e))
-    suspendExp env e = Hthunk env' e
-       where env' = thin env (freevarsExp e)
-	
-
-evalExp :: Menv -> Venv -> Exp -> Eval Value
-evalExp globalEnv env (Var qv) =
-  let v = qlookup globalEnv env qv
-  in case v of 
-       Vheap p ->
-	  do z <- hlookupE p                                  -- can fail due to black-holing
-	     case z of
-	       Hthunk env' e -> 
-		 do hremoveE p                                -- black-hole
-		    w@(Vheap p') <- evalExp globalEnv env' e  -- result is guaranteed to be boxed!
-	            h <- hlookupE p'        
-		    hupdateE p h			
-	            return w
-	       _ -> return v                 -- return pointer to Hclos or Hconstr 
-       _ -> return v                         -- return Vimm or Vutuple
-evalExp globalEnv env (Lit l) = return (Vimm (evalLit l))
-evalExp globalEnv env (Dcon (_,c)) = 
-  do p <- hallocateE (Hconstr c [])
-     return (Vheap p)
-
-evalExp globalEnv env (App e1 e2) = evalApp env e1 [e2] 
-  where
-    evalApp :: Venv -> Exp -> [Exp] -> Eval Value
-    evalApp env (App e1 e2) es = evalApp env e1 (e2:es)
-    evalApp env (op @(Dcon (qdc@(m,c)))) es = 
-      do vs <- suspendExps globalEnv env es
-	 if isUtupleDc qdc then
-	   return (Vutuple vs)
-	  else
-	    {- allocate a thunk -}
-     	    do p <- hallocateE (Hconstr c vs)
-  	       return (Vheap p)
-    evalApp env (op @ (Var(m,p))) es | m == primMname =
-      do vs <- evalExps globalEnv env es
-         case (p,vs) of
-   	   ("raisezh",[exn]) -> raiseE exn
-	   ("catchzh",[body,handler,rws]) -> 
-	      catchE (apply body [rws])
-	             (\exn -> apply handler [exn,rws])
-  	   _ -> evalPrimop p vs
-    evalApp env (External s _) es =
-      do vs <- evalExps globalEnv env es
-	 evalExternal s vs
-    evalApp env (Appt e _) es = evalApp env e es
-    evalApp env (Lam (Tb _) e) es = evalApp env e es
-    evalApp env (Coerce _ e) es = evalApp env e es
-    evalApp env (Note _ e) es = evalApp env e es
-    evalApp env e es = 
-      {- e must now evaluate to a closure -}
-      do vs <- suspendExps globalEnv env es
-	 vop <- evalExp globalEnv env e
-         apply vop vs
-
-    apply :: Value -> [Value] -> Eval Value
-    apply vop [] = return vop
-    apply (Vheap p) (v:vs) =
-      do Hclos env' x b <- hlookupE p 
-         v' <- evalExp globalEnv (eextend env' (x,v)) b
-         apply v' vs
-
-
-evalExp globalEnv env (Appt e _) = evalExp globalEnv env e
-evalExp globalEnv env (Lam (Vb(x,_)) e) = 
-  do p <- hallocateE (Hclos env' x e)
-     return (Vheap p)
-  where env' = thin env (delete x (freevarsExp e)) 
-evalExp globalEnv env (Lam _ e) = evalExp globalEnv env e
-evalExp globalEnv env (Let vdef e) =
-  do env' <- evalVdef globalEnv env vdef
-     evalExp globalEnv env' e
-  where
-    evalVdef :: Menv -> Venv -> Vdefg -> Eval Venv
-    evalVdef globalEnv env (Nonrec(Vdef((m,x),t,e))) =
-      do v <- suspendExp globalEnv env e
-	 return (eextend env (x,v))
-    evalVdef globalEnv env (Rec vdefs) =
-      do vs0 <- mapM preallocate xs
-	 let env' = foldl eextend env (zip xs vs0) 
-	 vs <- suspendExps globalEnv env' es
-	 mapM_ reallocate (zip vs0 vs)
-	 return env'
-      where 
-	(xs,es) = unzip [(x,e) | Vdef((_,x),_,e) <- vdefs]
-	preallocate _ = 
-	  do p <- hallocateE (Hconstr "UGH" [])
-	     return (Vheap p)
-	reallocate (Vheap p0,Vheap p) =
-	  do h <- hlookupE p
-	     hupdateE p0 h
-	
-evalExp globalEnv env (Case e (x,_) alts) =  
-  do z <- evalExp globalEnv env e
-     let env' = eextend env (x,z)
-     case z of
-       Vheap p ->
-	 do h <- hlookupE p   -- can fail due to black-holing
-	    case h of
-	      Hconstr dcon vs -> evalDcAlt env' dcon vs (reverse alts)
-  	      _ -> evalDefaultAlt env' alts
-       Vutuple vs ->
-	 evalUtupleAlt env' vs (reverse alts)
-       Vimm pv ->
-	 evalLitAlt env' pv (reverse alts)
-  where
-    evalDcAlt :: Venv -> Dcon -> [Value] -> [Alt] -> Eval Value
-    evalDcAlt env dcon vs alts = 
-      f alts
-      where 
-	f ((Acon (_,dcon') _ xs e):as) =
-	  if dcon == dcon' then
-	    evalExp globalEnv (foldl eextend env (zip (map fst xs) vs)) e
-	  else f as
-	f [Adefault e] =
-	  evalExp globalEnv env e
-	f _ = error "impossible Case-evalDcAlt"
-    
-    evalUtupleAlt :: Venv -> [Value] -> [Alt] -> Eval Value
-    evalUtupleAlt env vs [Acon _ _ xs e] = 
-       evalExp globalEnv (foldl eextend env (zip (map fst xs) vs)) e
-
-    evalLitAlt :: Venv -> PrimValue -> [Alt] -> Eval Value
-    evalLitAlt env pv alts = 
-      f alts
-      where 
-	f ((Alit lit e):as) = 
-	  let pv' = evalLit lit 
-	  in if pv == pv' then
-	       evalExp globalEnv env e
-             else f as
-	f [Adefault e] =
-	  evalExp globalEnv env e
-	f _ = error "impossible Case-evalLitAlt"
-    
-    evalDefaultAlt :: Venv -> [Alt] -> Eval Value
-    evalDefaultAlt env [Adefault e] = evalExp globalEnv env e
-
-evalExp globalEnv env (Coerce _ e) = evalExp globalEnv env e
-evalExp globalEnv env (Note _ e) = evalExp globalEnv env e
-evalExp globalEnv env (External s t) = evalExternal s []
-
-evalExps :: Menv -> Venv -> [Exp] -> Eval [Value]
-evalExps globalEnv env = mapM (evalExp globalEnv env)
-
-suspendExp:: Menv -> Venv -> Exp -> Eval Value
-suspendExp globalEnv env (Var qv) = return (qlookup globalEnv env qv)
-suspendExp globalEnv env (Lit l) = return (Vimm (evalLit l))
-suspendExp globalEnv env (Lam (Vb(x,_)) e) = 
-   do p <- hallocateE (Hclos env' x e)
-      return (Vheap p)
-   where env' = thin env (delete x (freevarsExp e))
-suspendExp globalEnv env (Lam _ e) = suspendExp globalEnv env e
-suspendExp globalEnv env (Appt e _) = suspendExp globalEnv env e
-suspendExp globalEnv env (Coerce _ e) = suspendExp globalEnv env e
-suspendExp globalEnv env (Note _ e) = suspendExp globalEnv env e
-suspendExp globalEnv env (External s _) = evalExternal s []
-suspendExp globalEnv env e = 
-   do p <- hallocateE (Hthunk env' e)
-      return (Vheap p)
-   where env' = thin env (freevarsExp e)
-
-suspendExps :: Menv -> Venv -> [Exp] -> Eval [Value]
-suspendExps globalEnv env = mapM (suspendExp globalEnv env)
-
-mlookup :: Menv -> Venv -> Mname -> Venv
-mlookup _          env       "" = env
-mlookup globalEnv  _         m  = 
-    case elookup globalEnv m of
-      Just env' -> env'
-      Nothing -> error ("undefined module name: " ++ m)
-
-qlookup :: Menv -> Venv -> (Mname,Var) -> Value
-qlookup globalEnv env (m,k) =   
-  case elookup (mlookup globalEnv env m) k of
-    Just v -> v
-    Nothing -> error ("undefined identifier: " ++ show m ++ "." ++ show k)
-
-evalPrimop :: Var -> [Value] -> Eval Value
-evalPrimop "zpzh" [Vimm (PIntzh i1),Vimm (PIntzh i2)] = return (Vimm (PIntzh (i1+i2)))
-evalPrimop "zmzh" [Vimm (PIntzh i1),Vimm (PIntzh i2)] = return (Vimm (PIntzh (i1-i2)))
-evalPrimop "ztzh" [Vimm (PIntzh i1),Vimm (PIntzh i2)] = return (Vimm (PIntzh (i1*i2)))
-evalPrimop "zgzh" [Vimm (PIntzh i1),Vimm (PIntzh i2)] = mkBool (i1 > i2)
-evalPrimop "remIntzh" [Vimm (PIntzh i1),Vimm (PIntzh i2)] = return (Vimm (PIntzh (i1 `rem` i2)))
--- etc.
-evalPrimop p vs = error ("undefined primop: " ++ p)
-
-evalExternal :: String -> [Value] -> Eval Value
--- etc.
-evalExternal s vs = error "evalExternal undefined for now"  -- etc.,etc.
-    
-evalLit :: Lit -> PrimValue
-evalLit l = 
-    case l of
-      Lint i (Tcon(_,"Intzh")) -> PIntzh i
-      Lint i (Tcon(_,"Wordzh")) -> PWordzh i
-      Lint i (Tcon(_,"Addrzh")) -> PAddrzh i
-      Lint i (Tcon(_,"Charzh")) -> PCharzh i
-      Lrational r (Tcon(_,"Floatzh")) -> PFloatzh r
-      Lrational r (Tcon(_,"Doublezh")) -> PDoublezh r
-      Lchar c (Tcon(_,"Charzh")) -> PCharzh (toEnum (ord c))
-      Lstring s (Tcon(_,"Addrzh")) -> PAddrzh 0	 -- should really be address of non-heap copy of C-format string s
-
-{- Utilities -}
-
-mkBool True = 
-  do p <- hallocateE (Hconstr "ZdwTrue" [])
-     return (Vheap p)
-mkBool False = 
-  do p <- hallocateE (Hconstr "ZdwFalse" [])
-     return (Vheap p)
-    
-thin env vars = efilter env (`elem` vars)
-
-{- Return the free non-external variables in an expression. -}
-
-freevarsExp :: Exp -> [Var]
-freevarsExp (Var ("",v)) = [v]
-freevarsExp (Var qv) = []
-freevarsExp (Dcon _) = []
-freevarsExp (Lit _) = []
-freevarsExp (App e1 e2) = freevarsExp e1 `union` freevarsExp e2
-freevarsExp (Appt e t) = freevarsExp e
-freevarsExp (Lam (Vb(v,_)) e) = delete v (freevarsExp e)
-freevarsExp (Lam _ e) = freevarsExp e
-freevarsExp (Let vdefg e) = freevarsVdefg vdefg `union` freevarsExp e
-  where freevarsVdefg (Rec vdefs) = (foldl union [] (map freevarsExp es)) \\ vs
-            where (vs,es) = unzip [(v,e) | Vdef((_,v),_,e) <- vdefs]	
-        freevarsVdefg (Nonrec (Vdef (_,_,e))) = freevarsExp e
-freevarsExp (Case e (v,_) as) = freevarsExp e `union` [v] `union` freevarsAlts as
-  where freevarsAlts alts = foldl union [] (map freevarsAlt alts)
-        freevarsAlt (Acon _ _ vbs e) = freevarsExp e \\ (map fst vbs) 
-        freevarsAlt (Alit _ e) = freevarsExp e
-        freevarsAlt (Adefault e) = freevarsExp e
-freevarsExp (Coerce _ e) = freevarsExp e
-freevarsExp (Note _ e) =  freevarsExp e
-freevarsExp (External _ _) = []
-
-
-
-
diff --git a/ghc/utils/ext-core/Lex.hs b/ghc/utils/ext-core/Lex.hs
deleted file mode 100644
index ad9d2eb00f..0000000000
--- a/ghc/utils/ext-core/Lex.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-module Lex where
-
-import ParseGlue
-import Ratio
-import Char
-
-isNameChar c = isAlpha c || isDigit c || (c == '_') || (c == '\'') 
-isKeywordChar c = isAlpha c || (c == '_') 
-
-lexer :: (Token -> P a) -> P a 
-lexer cont [] = cont TKEOF []
-lexer cont ('\n':cs) = \line -> lexer cont cs (line+1)
-lexer cont ('-':'>':cs) = cont TKrarrow cs
-lexer cont (c:cs) 
-      | isSpace c = lexer cont cs
-      | isLower c || (c == '_') = lexName cont TKname (c:cs)
-      | isUpper c = lexName cont TKcname (c:cs)
-      | isDigit c || (c == '-') = lexNum cont (c:cs)
-lexer cont ('%':cs) = lexKeyword cont cs
-lexer cont ('\'':cs) = lexChar cont cs
-lexer cont ('\"':cs) = lexString [] cont cs 
-lexer cont ('#':cs) = cont TKhash cs
-lexer cont ('(':cs) = cont TKoparen cs
-lexer cont (')':cs) = cont TKcparen cs
-lexer cont ('{':cs) = cont TKobrace cs
-lexer cont ('}':cs) = cont TKcbrace cs
-lexer cont ('=':cs) = cont TKeq cs
-lexer cont (':':':':cs) = cont TKcoloncolon cs
-lexer cont ('*':cs) = cont TKstar cs
-lexer cont ('.':cs) = cont TKdot cs
-lexer cont ('\\':cs) = cont TKlambda cs
-lexer cont ('/':'\\':cs) = cont TKbiglambda cs
-lexer cont ('@':cs) = cont TKat cs
-lexer cont ('?':cs) = cont TKquestion cs
-lexer cont (';':cs) = cont TKsemicolon cs
-lexer cont (c:cs) = failP "invalid character" [c]
-
-lexChar cont ('\\':'x':h1:h0:'\'':cs)
-	| isHexEscape [h1,h0] =  cont (TKchar (hexToChar h1 h0)) cs
-lexChar cont ('\\':cs) = failP "invalid char character" ('\\':(take 10 cs))
-lexChar cont ('\'':cs) = failP "invalid char character" ['\'']
-lexChar cont ('\"':cs) = failP "invalid char character" ['\"']
-lexChar cont (c:'\'':cs) = cont (TKchar c) cs
-
-lexString s cont ('\\':'x':h1:h0:cs) 
-	| isHexEscape [h1,h0] = lexString (s++[hexToChar h1 h0]) cont cs
-lexString s cont ('\\':cs) = failP "invalid string character" ['\\']
-lexString s cont ('\'':cs) = failP "invalid string character" ['\'']
-lexString s cont ('\"':cs) = cont (TKstring s) cs
-lexString s cont (c:cs) = lexString (s++[c]) cont cs
-
-isHexEscape = all (\c -> isHexDigit c && (isDigit c || isLower c))
-
-hexToChar h1 h0 = 
-	chr(
-	(digitToInt h1) * 16 + 
-	(digitToInt h0))
-
-
-lexNum cont cs =
-  case cs of
-     ('-':cs) ->  f (-1) cs
-     _ -> f 1 cs
- where f sgn cs = 
-         case span isDigit cs of
-          (digits,'.':c:rest) | isDigit c -> 
-	     cont (TKrational (numer % denom)) rest'
-	       where (fpart,rest') = span isDigit (c:rest)
-		     denom = 10^(length fpart)
-		     numer = sgn * ((read digits) * denom + (read fpart))
-          (digits,rest) -> cont (TKinteger (sgn * (read digits))) rest
-
-lexName cont cstr cs = cont (cstr name) rest
-   where (name,rest) = span isNameChar cs
-
-lexKeyword cont cs = 
-   case span isKeywordChar cs of
-      ("module",rest) -> cont TKmodule rest
-      ("data",rest)  -> cont TKdata rest
-      ("newtype",rest) -> cont TKnewtype rest
-      ("forall",rest) -> cont TKforall rest	
-      ("rec",rest) -> cont TKrec rest	
-      ("let",rest) -> cont TKlet rest	
-      ("in",rest) -> cont TKin rest	
-      ("case",rest) -> cont TKcase rest	
-      ("of",rest) -> cont TKof rest	
-      ("coerce",rest) -> cont TKcoerce rest	
-      ("note",rest) -> cont TKnote rest	
-      ("external",rest) -> cont TKexternal rest
-      ("_",rest) -> cont TKwild rest
-      _ -> failP "invalid keyword" ('%':cs) 
-
diff --git a/ghc/utils/ext-core/ParseGlue.hs b/ghc/utils/ext-core/ParseGlue.hs
deleted file mode 100644
index 3dde0c3d75..0000000000
--- a/ghc/utils/ext-core/ParseGlue.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-module ParseGlue where
-
-data ParseResult a = OkP a | FailP String
-type P a = String -> Int -> ParseResult a
-
-thenP :: P a -> (a -> P b) -> P b
-m `thenP`  k = \ s l -> 
-  case m s l of 
-    OkP a -> k a s l
-    FailP s -> FailP s
-
-returnP :: a -> P a
-returnP m _ _ = OkP m
-
-failP :: String -> P a
-failP s s' _ = FailP (s ++ ":" ++ s')
-
-data Token =
-   TKmodule 
- | TKdata 
- | TKnewtype 
- | TKforall 
- | TKrec 
- | TKlet 
- | TKin 
- | TKcase 
- | TKof 
- | TKcoerce 
- | TKnote 
- | TKexternal
- | TKwild
- | TKoparen 
- | TKcparen 
- | TKobrace
- | TKcbrace
- | TKhash
- | TKeq 
- | TKcoloncolon 
- | TKstar 
- | TKrarrow 
- | TKlambda
- | TKbiglambda
- | TKat 
- | TKdot
- | TKquestion
- | TKsemicolon
- | TKname String 
- | TKcname String
- | TKinteger Integer 
- | TKrational Rational
- | TKstring String 
- | TKchar Char 
- | TKEOF
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/ghc/utils/ext-core/Parser.y b/ghc/utils/ext-core/Parser.y
deleted file mode 100644
index 1e1c6a3592..0000000000
--- a/ghc/utils/ext-core/Parser.y
+++ /dev/null
@@ -1,230 +0,0 @@
-{
-module Parser ( parse ) where
-
-import Core
-import ParseGlue
-import Lex
-
-}
-
-%name parse
-%tokentype { Token }
-
-%token
- '%module'	{ TKmodule }
- '%data'	{ TKdata }
- '%newtype'	{ TKnewtype }
- '%forall'	{ TKforall }
- '%rec'		{ TKrec }
- '%let'		{ TKlet }
- '%in'		{ TKin }
- '%case'	{ TKcase }
- '%of'		{ TKof }
- '%coerce'	{ TKcoerce }
- '%note'	{ TKnote }
- '%external'	{ TKexternal }
- '%_'		{ TKwild }
- '('		{ TKoparen }
- ')'		{ TKcparen }
- '{'		{ TKobrace }
- '}'		{ TKcbrace }
- '#' 		{ TKhash}
- '='		{ TKeq }
- '::'		{ TKcoloncolon }
- '*'		{ TKstar }
- '->'		{ TKrarrow }
- '\\'		{ TKlambda}
- '@'		{ TKat }
- '.'		{ TKdot }
- '?'		{ TKquestion}
- ';'            { TKsemicolon }
- NAME		{ TKname $$ }
- CNAME 		{ TKcname $$ }
- INTEGER	{ TKinteger $$ }
- RATIONAL	{ TKrational $$ }
- STRING		{ TKstring $$ }
- CHAR		{ TKchar $$ }
-
-%monad { P } { thenP } { returnP }
-%lexer { lexer } { TKEOF }
-
-%%
-
-module	:: { Module }
-	: '%module' mname tdefs  vdefgs 
-		{ Module $2 $3 $4 }
-
-tdefs	:: { [Tdef] }
-	: {- empty -}	{[]}
-	| tdef ';' tdefs	{$1:$3}
-
-tdef	:: { Tdef }
-	: '%data' qcname tbinds '=' '{' cons1 '}'
-		{ Data $2 $3 $6 }
-	| '%newtype' qcname tbinds trep 
-		{ Newtype $2 $3 $4 }
-
-trep    :: { Maybe Ty }
-        : {- empty -}   {Nothing}
-        | '=' ty        { Just $2 }
-
-tbind	:: { Tbind }
-	:  name { ($1,Klifted) }
-	|  '(' name '::' akind ')'
-		{ ($2,$4) }
-
-tbinds 	:: { [Tbind] }
-	: {- empty -}	{ [] }
-	| tbind tbinds	{ $1:$2 }
-
-
-vbind	:: { Vbind }
-	: '(' name '::' ty')'	{ ($2,$4) }
-
-vbinds	:: { [Vbind] }
-	: {-empty -} 	{ [] }
-	| vbind vbinds	{ $1:$2 }
-
-bind	:: { Bind }
-	: '@' tbind 	{ Tb $2 }
-	| vbind		{ Vb $1 }
-
-binds1 	:: { [Bind] }
-	: bind		{ [$1] }
-	| bind binds1	{ $1:$2 }
-
-attbinds :: { [Tbind] }
-	: {- empty -} 	{ [] }
-	| '@' tbind attbinds 
-			{ $2:$3 }
-
-akind	:: { Kind }
-	: '*' 		{Klifted}	
-	| '#'		{Kunlifted}
-	| '?'		{Kopen}
-        | '(' kind ')'	{ $2 }
-
-kind 	:: { Kind }
-	: akind 	{ $1 }
-	| akind '->' kind 
-		{ Karrow $1 $3 }
-
-cons1	:: { [Cdef] }
-	: con		{ [$1] }
-	| con ';' cons1	{ $1:$3 }
-
-con	:: { Cdef }
-	: qcname attbinds atys 
-		{ Constr $1 $2 $3 }
-
-atys	:: { [Ty] }
-	: {- empty -} { [] }
-	| aty atys      { $1:$2 }
-
-aty	:: { Ty }
-	: name	{ Tvar $1 }
-	| qcname { Tcon $1 }
-	| '(' ty ')' { $2 }
-
-
-bty	:: { Ty }
-	: aty	{ $1 }
-        | bty aty { Tapp $1 $2 }
-
-ty	:: { Ty }
-	: bty	{$1}
-	| bty '->' ty 
-		{ tArrow $1 $3 }
-	| '%forall' tbinds '.' ty 
-		{ foldr Tforall $4 $2 }
-
-vdefgs	:: { [Vdefg] }
-	: {- empty -}	        { [] }
-	| vdefg ';' vdefgs	{$1:$3 }
-
-vdefg	:: { Vdefg }
-	: '%rec' '{' vdefs1 '}'
-		       { Rec $3 }
-	|  vdef { Nonrec $1}
-
-vdefs1	:: { [Vdef] }
-	: vdef		{ [$1] }
-	| vdef ';' vdefs1 { $1:$3 }
-
-vdef	:: { Vdef }
-	: qname '::' ty '=' exp 
-		{ Vdef ($1,$3,$5) }
-
-aexp    :: { Exp }
-	: qname 	{ Var $1 }
-        | qcname 	{ Dcon $1 } 
-	| lit		{ Lit $1 }
-	| '(' exp ')' 	{ $2 }
-
-fexp	:: { Exp }
-	: fexp aexp	{ App $1 $2 }
-	| fexp '@' aty	{ Appt $1 $3 }
-	| aexp		{ $1 }
-
-exp	:: { Exp }
-	: fexp		{ $1 }
-	| '\\' binds1 '->' exp
-		{ foldr Lam $4 $2 }
-	| '%let' vdefg '%in' exp 
-		{ Let $2 $4 }
-	| '%case' aexp '%of' vbind '{' alts1 '}'
-		{ Case $2 $4 $6 }
-	| '%coerce' aty exp 
-		{ Coerce $2 $3 }
-	| '%note' STRING exp 
-		{ Note $2 $3 }
-        | '%external' STRING aty
-                { External $2 $3 }
-
-alts1	:: { [Alt] }
-	: alt		{ [$1] }
-	| alt ';' alts1	{ $1:$3 }
-
-alt	:: { Alt }
-	: qcname attbinds vbinds '->' exp 
-		{ Acon $1 $2 $3 $5 } 
-	| lit '->' exp
-		{ Alit $1 $3 }
-	| '%_' '->' exp
-		{ Adefault $3 }
-
-lit	:: { Lit }
-	: '(' INTEGER '::' aty ')'
-		{ Lint $2 $4 }
-	| '(' RATIONAL '::' aty ')'
-		{ Lrational $2 $4 }
-	| '(' CHAR '::' aty ')'
-		{ Lchar $2 $4 }
-	| '(' STRING '::' aty ')'
-		{ Lstring $2 $4 }
-
-name	:: { Id }
-	: NAME	{ $1 }
-
-cname	:: { Id }
-	: CNAME	{ $1 }
-         
-mname	:: { Id }
-	: CNAME	{ $1 }
-
-qname	:: { (Id,Id) }
-	: name	{ ("",$1) }
-	| mname '.' name 
-		{ ($1,$3) }
-
-qcname	:: { (Id,Id) }
-        : mname '.' cname 
-		{ ($1,$3) }
-
-
-{
-
-happyError :: P a 
-happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l
-
-}
diff --git a/ghc/utils/ext-core/Prep.hs b/ghc/utils/ext-core/Prep.hs
deleted file mode 100644
index ee65eaaba2..0000000000
--- a/ghc/utils/ext-core/Prep.hs
+++ /dev/null
@@ -1,151 +0,0 @@
-{- 
-Preprocess a module to normalize it in the following ways:
-	(1) Saturate all constructor and primop applications. 
-	(2) Arrange that any non-trivial expression of unlifted kind ('#')
-             is turned into the scrutinee of a Case.
-After these preprocessing steps, Core can be interpreted (or given an operational semantics)
-      ignoring type information almost completely.
--}
-
-
-module Prep where
-
-import Prims
-import Core
-import Printer
-import Env
-import Check
-
-primArgTys :: Env Var [Ty]
-primArgTys = efromlist (map f Prims.primVals)
-  where f (v,t) = (v,atys)
-             where (_,atys,_) = splitTy t
-
-prepModule :: Menv -> Module -> Module
-prepModule globalEnv (Module mn tdefs vdefgs) = 
-    Module mn tdefs vdefgs' 
-  where
-    (_,vdefgs') = foldl prepTopVdefg (eempty,[]) vdefgs
-
-    prepTopVdefg (venv,vdefgs) vdefg = (venv',vdefgs ++ [vdefg'])
-       where (venv',vdefg') = prepVdefg (venv,eempty) vdefg
- 
-    prepVdefg (env@(venv,_)) (Nonrec(Vdef(("",x),t,e))) = 
-	(eextend venv (x,t), Nonrec(Vdef(("",x),t,prepExp env e)))
-    prepVdefg (env@(venv,_))  (Nonrec(Vdef(qx,t,e))) = 
-	(venv, Nonrec(Vdef(qx,t,prepExp env e)))
-    prepVdefg (venv,tvenv) (Rec vdefs) = 
-	(venv',Rec [Vdef(qx,t,prepExp (venv',tvenv) e) | Vdef(qx,t,e) <- vdefs])
-	where venv' = foldl eextend venv [(x,t) | Vdef(("",x),t,_) <- vdefs]
-
-    prepExp env (Var qv) = Var qv
-    prepExp env (Dcon qdc) = Dcon qdc
-    prepExp env (Lit l) = Lit l
-    prepExp env e@(App _ _) = unwindApp env e []
-    prepExp env e@(Appt _ _) = unwindApp env e []
-    prepExp (venv,tvenv) (Lam (Vb vb) e) = Lam (Vb vb) (prepExp (eextend venv vb,tvenv) e)
-    prepExp (venv,tvenv) (Lam (Tb tb) e) = Lam (Tb tb) (prepExp (venv,eextend tvenv tb) e)
-    prepExp env@(venv,tvenv) (Let (Nonrec(Vdef(("",x),t,b))) e) | kindof tvenv t == Kunlifted && suspends b =
-		Case (prepExp env b) (x,t) [Adefault (prepExp (eextend venv (x,t),tvenv) e)]
-    prepExp (venv,tvenv) (Let vdefg e) =  Let vdefg' (prepExp (venv',tvenv) e)
-		where (venv',vdefg') = prepVdefg (venv,tvenv) vdefg
-    prepExp env@(venv,tvenv) (Case e vb alts) = Case (prepExp env e) vb (map (prepAlt (eextend venv vb,tvenv)) alts)
-    prepExp env (Coerce t e) = Coerce t (prepExp env e)
-    prepExp env (Note s e) = Note s (prepExp env e)
-    prepExp env (External s t) = External s t
-
-    prepAlt (venv,tvenv) (Acon qdc tbs vbs e) = Acon qdc tbs vbs (prepExp (foldl eextend venv vbs,foldl eextend tvenv tbs) e)
-    prepAlt env (Alit l e) = Alit l (prepExp env e)
-    prepAlt env (Adefault e) = Adefault (prepExp env e)
-
-
-    unwindApp env (App e1 e2) as = unwindApp env e1 (Left e2:as)
-    unwindApp env (Appt e t) as  = unwindApp env e (Right t:as)
-    unwindApp env (op@(Dcon qdc)) as =
-        etaExpand (drop n atys) (rewindApp env op as)
-        where (tbs,atys0,_) = splitTy (qlookup cenv_ eempty qdc)
-	      atys = map (substl (map fst tbs) ts) atys0
-	      ts = [t | Right t <- as]
-              n = length [e | Left e <- as]
-    unwindApp env (op@(Var(m,p))) as | m == primMname =
-	etaExpand (drop n atys) (rewindApp env op as)
-        where Just atys = elookup primArgTys p
-              n = length [e | Left e <- as]
-    unwindApp env op as = rewindApp env op as
-
-
-    etaExpand ts e = foldl g e [('$':(show i),t) | (i,t) <- zip [1..] ts]
-	  where g e (v,t) = Lam (Vb(v,t)) (App e (Var ("",v)))
-
-    rewindApp env e [] = e
-    rewindApp env@(venv,tvenv) e1 (Left e2:as) | kindof tvenv t == Kunlifted && suspends e2 =
-	Case (prepExp env' e2) (v,t)
-		[Adefault (rewindApp env' (App e1 (Var ("",v))) as)]
-        where v = freshVar venv
-              t = typeofExp env e2
-              env' = (eextend venv (v,t),tvenv)
-    rewindApp env e1 (Left e2:as) = rewindApp env (App e1 (prepExp env e2)) as
-    rewindApp env e (Right t:as) = rewindApp env (Appt e t) as
-
-    freshVar venv = maximum ("":edomain venv) ++ "x" -- one simple way!
-
-    typeofExp :: (Venv,Tvenv) -> Exp -> Ty
-    typeofExp (venv,_) (Var qv) = qlookup venv_ venv qv
-    typeofExp env (Dcon qdc) = qlookup cenv_ eempty qdc
-    typeofExp env (Lit l) = typeofLit l
-	where typeofLit (Lint _ t) = t
-	      typeofLit (Lrational _ t) = t
-	      typeofLit (Lchar _ t) = t
-              typeofLit (Lstring _ t) = t
-    typeofExp env (App e1 e2) = t
-          where (Tapp(Tapp _ t0) t) = typeofExp env e1
-    typeofExp env (Appt e t) = substl [tv] [t] t'
-	  where (Tforall (tv,_) t') = typeofExp env e
-    typeofExp (venv,tvenv) (Lam (Vb(v,t)) e) = tArrow t (typeofExp (eextend venv (v,t),tvenv) e)
-    typeofExp (venv,tvenv) (Lam (Tb tb) e) = Tforall tb (typeofExp (venv,eextend tvenv tb) e)
-    typeofExp (venv,tvenv) (Let vdefg e) = typeofExp (venv',tvenv) e
-	  where venv' = case vdefg of
-			  Nonrec (Vdef((_,x),t,_)) -> eextend venv (x,t)
-                          Rec vdefs -> foldl eextend venv [(x,t) | Vdef((_,x),t,_) <- vdefs]
-    typeofExp (venv,tvenv) (Case _ vb (alt:_)) = typeofAlt (eextend venv vb,tvenv) alt
-	where typeofAlt (venv,tvenv) (Acon _ tbs vbs e) = typeofExp (foldl eextend venv vbs,foldl eextend tvenv tbs) e
-	      typeofAlt env (Alit _ e) = typeofExp env e
-	      typeofAlt env (Adefault e) = typeofExp env e
-    typeofExp env (Coerce t _) = t
-    typeofExp env (Note _ e) = typeofExp env e
-    typeofExp env (External _ t) = t
-
-    {- Return false for those expressions for which Interp.suspendExp buidds a thunk. -}
-    suspends (Var _) = False
-    suspends (Lit _) = False
-    suspends (Lam (Vb _) _) = False
-    suspends (Lam _ e) = suspends e
-    suspends (Appt e _) = suspends e
-    suspends (Coerce _ e) = suspends e
-    suspends (Note _ e) = suspends e
-    suspends (External _ _) = False
-    suspends _ = True
-
-    kindof :: Tvenv -> Ty -> Kind
-    kindof tvenv (Tvar tv) = 
-      case elookup tvenv tv of
-	Just k -> k
-        Nothing -> error ("impossible Tyvar " ++ show tv)
-    kindof tvenv (Tcon qtc) = qlookup tcenv_ eempty qtc
-    kindof tvenv (Tapp t1 t2) = k2
-	where Karrow _ k2 = kindof tvenv t1
-    kindof tvenv (Tforall _ t) = kindof tvenv t
-
-    mlookup :: (Envs -> Env a b) -> Env a b -> Mname -> Env a b
-    mlookup _ local_env "" = local_env
-    mlookup selector _  m =   
-      case elookup globalEnv m of
-        Just env -> selector env
-        Nothing -> error ("undefined module name: " ++ m)
-
-    qlookup ::  (Ord a, Show a) => (Envs -> Env a b) -> Env a b -> (Mname,a) -> b
-    qlookup selector local_env (m,k) =   
-      case elookup (mlookup selector local_env m) k of
-        Just v -> v
-        Nothing -> error ("undefined identifier: " ++ show k)
-
diff --git a/ghc/utils/ext-core/Prims.hs b/ghc/utils/ext-core/Prims.hs
deleted file mode 100644
index fd6e827c39..0000000000
--- a/ghc/utils/ext-core/Prims.hs
+++ /dev/null
@@ -1,834 +0,0 @@
-{- This module really should be auto-generated from the master primops.txt file. 
-   It is roughly correct (but may be slightly incomplete) wrt/ GHC5.02. -}
-
-module Prims where
-
-import Core
-import Env
-import Check
-
-initialEnv :: Menv
-initialEnv = efromlist [(primMname,primEnv),
-		     ("PrelErr",errorEnv)]
-
-primEnv :: Envs
-primEnv = Envs {tcenv_=efromlist primTcs,
-		tsenv_=eempty,
-		cenv_=efromlist primDcs,
-		venv_=efromlist primVals}
-
-errorEnv :: Envs
-errorEnv = Envs {tcenv_=eempty,
-		 tsenv_=eempty,
-		 cenv_=eempty,
-		 venv_=efromlist errorVals}
-
-{- Components of static environment -}
-
-primTcs :: [(Tcon,Kind)]
-primTcs = 
-	map (\ ((m,tc),k) -> (tc,k))
-	([(tcArrow,ktArrow),
-	 (tcAddrzh,ktAddrzh),
-	 (tcCharzh,ktCharzh),
-	 (tcDoublezh,ktDoublezh),
-	 (tcFloatzh,ktFloatzh),
-	 (tcIntzh,ktIntzh),
-	 (tcInt32zh,ktInt32zh),
-	 (tcInt64zh,ktInt64zh),
-	 (tcWordzh,ktWordzh),
-	 (tcWord32zh,ktWord32zh),
-	 (tcWord64zh,ktWord64zh),
-	 (tcRealWorld, ktRealWorld),
-	 (tcStatezh, ktStatezh),
-	 (tcArrayzh,ktArrayzh),
-	 (tcByteArrayzh,ktByteArrayzh),
-	 (tcMutableArrayzh,ktMutableArrayzh),
-	 (tcMutableByteArrayzh,ktMutableByteArrayzh),
-	 (tcMutVarzh,ktMutVarzh),
-	 (tcMVarzh,ktMVarzh),
-	 (tcWeakzh,ktWeakzh),
-	 (tcForeignObjzh, ktForeignObjzh),
-	 (tcStablePtrzh, ktStablePtrzh),
-	 (tcThreadIdzh, ktThreadIdzh),
-	 (tcZCTCCallable, ktZCTCCallable),
-	 (tcZCTCReturnable, ktZCTCReturnable)]
-       ++ [(tcUtuple n, ktUtuple n) | n <- [1..maxUtuple]])
-
-
-primDcs :: [(Dcon,Ty)]
-primDcs = map (\ ((m,c),t) -> (c,t))
-	      [(dcUtuple n, dcUtupleTy n) | n <- [1..maxUtuple]]
-
-primVals :: [(Var,Ty)]
-primVals = 
-	opsAddrzh ++
-	opsCharzh ++
-	opsDoublezh ++
-	opsFloatzh ++
-	opsIntzh ++
-	opsInt32zh ++
-	opsInt64zh ++
-	opsIntegerzh ++
-	opsWordzh ++
-	opsWord32zh ++
-	opsWord64zh ++
-	opsSized ++
-	opsArray ++
-	opsMutVarzh ++
-	opsState ++
-	opsExn ++
-	opsMVar ++
-	opsWeak ++
-	opsForeignObjzh ++
-        opsStablePtrzh ++
-	opsConc ++
-	opsMisc
-
-
-dcUtuples :: [(Qual Dcon,Ty)]
-dcUtuples = map ( \n -> (dcUtuple n, typ n)) [1..100]
-     where typ n = foldr ( \tv t -> Tforall (tv,Kopen) t)
-				(foldr ( \tv t -> tArrow (Tvar tv) t)
-					     (tUtuple (map Tvar tvs)) tvs) tvs
-		      where tvs = map ( \i -> ("a" ++ (show i))) [1..n]
-
-
-{- Addrzh -}
-
-tcAddrzh = (primMname,"Addrzh")
-tAddrzh = Tcon tcAddrzh
-ktAddrzh = Kunlifted
-
-opsAddrzh = [
- ("gtAddrzh",tcompare tAddrzh),
- ("geAddrzh",tcompare tAddrzh), 
- ("eqAddrzh",tcompare tAddrzh),  
- ("neAddrzh",tcompare tAddrzh),
- ("ltAddrzh",tcompare tAddrzh),  
- ("leAddrzh",tcompare tAddrzh),
- ("nullAddrzh", tAddrzh),
- ("plusAddrzh", tArrow tAddrzh (tArrow tIntzh tAddrzh)),
- ("minusAddrzh", tArrow tAddrzh (tArrow tAddrzh tIntzh)),
- ("remAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh))]
-
-{- Charzh -}
-
-tcCharzh = (primMname,"Charzh")
-tCharzh = Tcon tcCharzh
-ktCharzh = Kunlifted
-
-opsCharzh = [
- ("gtCharzh", tcompare tCharzh),
- ("geCharzh", tcompare tCharzh),
- ("eqCharzh", tcompare tCharzh),
- ("neCharzh", tcompare tCharzh),
- ("ltCharzh", tcompare tCharzh),
- ("leCharzh", tcompare tCharzh),
- ("ordzh",    tArrow tCharzh tIntzh)]
-
-
-{- Doublezh -}
-
-tcDoublezh = (primMname, "Doublezh")
-tDoublezh = Tcon tcDoublezh
-ktDoublezh = Kunlifted
-
-opsDoublezh = [
- ("zgzhzh", tcompare tDoublezh),
- ("zgzezhzh", tcompare tDoublezh),
- ("zezezhzh", tcompare tDoublezh),
- ("zszezhzh", tcompare tDoublezh),
- ("zlzhzh", tcompare tDoublezh),
- ("zlzezhzh", tcompare tDoublezh),
- ("zpzhzh", tdyadic tDoublezh),
- ("zmzhzh", tdyadic tDoublezh),
- ("ztzhzh", tdyadic tDoublezh),
- ("zszhzh", tdyadic tDoublezh),
- ("negateDoublezh", tmonadic tDoublezh),
- ("double2Intzh", tArrow tDoublezh tIntzh),
- ("double2Floatzh", tArrow tDoublezh tFloatzh),
- ("expDoublezh", tmonadic tDoublezh),
- ("logDoublezh", tmonadic tDoublezh),
- ("sqrtDoublezh", tmonadic tDoublezh),
- ("sinDoublezh", tmonadic tDoublezh),
- ("cosDoublezh", tmonadic tDoublezh),
- ("tanDoublezh", tmonadic tDoublezh),
- ("asinDoublezh", tmonadic tDoublezh),
- ("acosDoublezh", tmonadic tDoublezh),
- ("atanDoublezh", tmonadic tDoublezh),
- ("sinhDoublezh", tmonadic tDoublezh),
- ("coshDoublezh", tmonadic tDoublezh),
- ("tanhDoublezh", tmonadic tDoublezh),
- ("ztztzhzh", tdyadic tDoublezh),
- ("decodeDoublezh", tArrow tDoublezh (tUtuple[tIntzh,tIntzh,tByteArrayzh]))]
-
-
-{- Floatzh -}
-
-tcFloatzh = (primMname, "Floatzh")
-tFloatzh = Tcon tcFloatzh
-ktFloatzh = Kunlifted
-
-opsFloatzh = [
- ("gtFloatzh", tcompare tFloatzh),
- ("geFloatzh", tcompare tFloatzh),
- ("eqFloatzh", tcompare tFloatzh),
- ("neFloatzh", tcompare tFloatzh),
- ("ltFloatzh", tcompare tFloatzh),
- ("leFloatzh", tcompare tFloatzh),
- ("plusFloatzh", tdyadic tFloatzh),
- ("minusFloatzh", tdyadic tFloatzh),
- ("timesFloatzh", tdyadic tFloatzh),
- ("divideFloatzh", tdyadic tFloatzh),
- ("negateFloatzh", tmonadic tFloatzh),
- ("float2Intzh", tArrow tFloatzh tIntzh),
- ("expFloatzh", tmonadic tFloatzh),
- ("logFloatzh", tmonadic tFloatzh),
- ("sqrtFloatzh", tmonadic tFloatzh),
- ("sinFloatzh", tmonadic tFloatzh),
- ("cosFloatzh", tmonadic tFloatzh),
- ("tanFloatzh", tmonadic tFloatzh),
- ("asinFloatzh", tmonadic tFloatzh),
- ("acosFloatzh", tmonadic tFloatzh),
- ("atanFloatzh", tmonadic tFloatzh),
- ("sinhFloatzh", tmonadic tFloatzh),
- ("coshFloatzh", tmonadic tFloatzh),
- ("tanhFloatzh", tmonadic tFloatzh),
- ("powerFloatzh", tdyadic tFloatzh),
- ("float2Doublezh", tArrow tFloatzh tDoublezh),
- ("decodeFloatzh", tArrow tFloatzh (tUtuple[tIntzh,tIntzh,tByteArrayzh]))]
-
-
-{- Intzh -}
-
-tcIntzh = (primMname,"Intzh")
-tIntzh = Tcon tcIntzh
-ktIntzh = Kunlifted
-
-opsIntzh = [
- ("zpzh", tdyadic tIntzh),
- ("zmzh", tdyadic tIntzh),
- ("ztzh", tdyadic tIntzh),
- ("quotIntzh", tdyadic tIntzh),
- ("remIntzh", tdyadic tIntzh),
- ("gcdIntzh", tdyadic tIntzh),
- ("negateIntzh", tmonadic tIntzh),
- ("addIntCzh", tArrow tIntzh (tArrow tIntzh (tUtuple [tIntzh, tIntzh]))),
- ("subIntCzh", tArrow tIntzh (tArrow tIntzh (tUtuple [tIntzh, tIntzh]))),
- ("mulIntCzh", tArrow tIntzh (tArrow tIntzh (tUtuple [tIntzh, tIntzh]))),
- ("zgzh", tcompare tIntzh),
- ("zgzezh", tcompare tIntzh),
- ("zezezh", tcompare tIntzh),
- ("zszezh", tcompare tIntzh),
- ("zlzh", tcompare tIntzh),
- ("zlzezh", tcompare tIntzh),
- ("chrzh", tArrow tIntzh tCharzh),
- ("int2Wordzh", tArrow tIntzh tWordzh),
- ("int2Floatzh", tArrow tIntzh tFloatzh),
- ("int2Doublezh", tArrow tIntzh tDoublezh),
- ("intToInt32zh", tArrow tIntzh tInt32zh),
- ("int2Integerzh", tArrow tIntzh tIntegerzhRes),
- ("iShiftLzh", tdyadic tIntzh),
- ("iShiftRAzh", tdyadic tIntzh),
- ("iShiftRLh", tdyadic tIntzh)]
-
-
-{- Int32zh -}
-
-tcInt32zh = (primMname,"Int32zh")
-tInt32zh = Tcon tcInt32zh
-ktInt32zh = Kunlifted
-
-opsInt32zh = [
- ("int32ToIntzh", tArrow tInt32zh tIntzh),
- ("int32ToIntegerzh", tArrow tInt32zh tIntegerzhRes)]
-
-
-{- Int64zh -}
-
-tcInt64zh = (primMname,"Int64zh")
-tInt64zh = Tcon tcInt64zh
-ktInt64zh = Kunlifted
-
-opsInt64zh = [
- ("int64ToIntegerzh", tArrow tInt64zh tIntegerzhRes)]
-
-{- Integerzh -}
-
--- not actuallly a primitive type
-tIntegerzhRes = tUtuple [tIntzh, tByteArrayzh]
-tIntegerzhTo t = tArrow tIntzh (tArrow tByteArrayzh t)
-tdyadicIntegerzh = tIntegerzhTo (tIntegerzhTo tIntegerzhRes)
-
-opsIntegerzh = [
- ("plusIntegerzh", tdyadicIntegerzh),
- ("minusIntegerzh", tdyadicIntegerzh),
- ("timesIntegerzh", tdyadicIntegerzh),
- ("gcdIntegerzh", tdyadicIntegerzh),
- ("gcdIntegerIntzh", tIntegerzhTo (tArrow tIntzh tIntzh)),
- ("divExactIntegerzh", tdyadicIntegerzh),
- ("quotIntegerzh", tdyadicIntegerzh),
- ("remIntegerzh", tdyadicIntegerzh),
- ("cmpIntegerzh", tIntegerzhTo (tIntegerzhTo tIntzh)),
- ("cmpIntegerIntzh", tIntegerzhTo (tArrow tIntzh tIntzh)),
- ("quotRemIntegerzh", tIntegerzhTo (tIntegerzhTo (tUtuple [tIntzh,tByteArrayzh,tIntzh,tByteArrayzh]))),
- ("divModIntegerzh", tIntegerzhTo (tIntegerzhTo (tUtuple [tIntzh,tByteArrayzh,tIntzh,tByteArrayzh]))),
- ("integer2Intzh", tIntegerzhTo tIntzh),
- ("integer2Wordzh", tIntegerzhTo tWordzh),
- ("integerToInt32zh", tIntegerzhTo tInt32zh),
- ("integerToWord32zh", tIntegerzhTo tWord32zh),
- ("integerToInt64zh", tIntegerzhTo tInt64zh),
- ("integerToWord64zh", tIntegerzhTo tWord64zh),
- ("andIntegerzh", tdyadicIntegerzh),
- ("orIntegerzh", tdyadicIntegerzh),
- ("xorIntegerzh", tdyadicIntegerzh),
- ("complementIntegerzh", tIntegerzhTo tIntegerzhRes)]
-
-
-
-{- Wordzh -}
-
-tcWordzh = (primMname,"Wordzh")
-tWordzh = Tcon tcWordzh
-ktWordzh = Kunlifted
-
-opsWordzh = [
- ("plusWordzh", tdyadic tWordzh),
- ("minusWordzh", tdyadic tWordzh),
- ("timesWordzh", tdyadic tWordzh),
- ("quotWordzh",   tdyadic tWordzh),
- ("remWordzh",   tdyadic tWordzh),
- ("andzh",    tdyadic tWordzh),
- ("orzh",    tdyadic tWordzh),
- ("xorzh",    tdyadic tWordzh),
- ("notzh",    tmonadic tWordzh),
- ("shiftLzh", tArrow tWordzh (tArrow tIntzh tWordzh)),
- ("shiftRLzh", tArrow tWordzh (tArrow tIntzh tWordzh)),
- ("word2Intzh", tArrow tWordzh tIntzh),
- ("wordToWord32zh", tArrow tWordzh tWord32zh),
- ("word2Integerzh", tArrow tWordzh tIntegerzhRes),
- ("gtWordzh", tcompare tWordzh),
- ("geWordzh", tcompare tWordzh),
- ("eqWordzh", tcompare tWordzh),
- ("neWordzh", tcompare tWordzh),
- ("ltWordzh", tcompare tWordzh),
- ("leWordzh", tcompare tWordzh)]
-
-{- Word32zh -}
-
-tcWord32zh = (primMname,"Word32zh")
-tWord32zh = Tcon tcWord32zh
-ktWord32zh = Kunlifted
-
-opsWord32zh = [
- ("word32ToWordzh", tArrow tWord32zh tWordzh),
- ("word32ToIntegerzh", tArrow tWord32zh tIntegerzhRes)]
-
-{- Word64zh -}
-
-tcWord64zh = (primMname,"Word64zh")
-tWord64zh = Tcon tcWord64zh
-ktWord64zh = Kunlifted
-
-opsWord64zh = [
- ("word64ToIntegerzh", tArrow tWord64zh tIntegerzhRes)]
-
-{- Explicitly sized Intzh and Wordzh -}
-
-opsSized = [
- ("narrow8Intzh", tmonadic tIntzh),
- ("narrow16Intzh", tmonadic tIntzh),
- ("narrow32Intzh", tmonadic tIntzh),
- ("narrow8Wordzh", tmonadic tWordzh),
- ("narrow16Wordzh", tmonadic tWordzh),
- ("narrow32Wordzh", tmonadic tWordzh)]
-
-{- Arrays -}
-
-tcArrayzh = (primMname,"Arrayzh")
-tArrayzh t = Tapp (Tcon tcArrayzh) t
-ktArrayzh = Karrow Klifted Kunlifted
-
-tcByteArrayzh = (primMname,"ByteArrayzh")
-tByteArrayzh = Tcon tcByteArrayzh
-ktByteArrayzh = Kunlifted
-
-tcMutableArrayzh = (primMname,"MutableArrayzh")
-tMutableArrayzh s t = Tapp (Tapp (Tcon tcMutableArrayzh) s) t
-ktMutableArrayzh = Karrow Klifted (Karrow Klifted Kunlifted)
-
-tcMutableByteArrayzh = (primMname,"MutableByteArrayzh")
-tMutableByteArrayzh s = Tapp (Tcon tcMutableByteArrayzh) s
-ktMutableByteArrayzh = Karrow Klifted Kunlifted
-
-opsArray = [
- ("newArrayzh", Tforall ("a",Klifted) 
-		       (Tforall ("s",Klifted)
-                                (tArrow tIntzh 
-                                       (tArrow (Tvar "a")
-                                               (tArrow (tStatezh (Tvar "s"))
-                                                       (tUtuple [tStatezh (Tvar "s"),tMutableArrayzh (Tvar "s") (Tvar "a")])))))),
- ("newByteArrayzh", Tforall ("s",Klifted)
-                           (tArrow tIntzh 
-                                   (tArrow (tStatezh (Tvar "s"))
-                                           (tUtuple [tStatezh (Tvar "s"),tMutableByteArrayzh (Tvar "s")])))),
- ("newPinnedByteArrayzh", Tforall ("s",Klifted)
-                           (tArrow tIntzh 
-                                   (tArrow (tStatezh (Tvar "s"))
-                                           (tUtuple [tStatezh (Tvar "s"),tMutableByteArrayzh (Tvar "s")])))),
- ("byteArrayContentszh", tArrow tByteArrayzh tAddrzh),
- ("indexCharArrayzh", tArrow tByteArrayzh (tArrow tIntzh tCharzh)),
- ("indexWideCharArrayzh", tArrow tByteArrayzh (tArrow tIntzh tCharzh)),
- ("indexIntArrayzh", tArrow tByteArrayzh (tArrow tIntzh tIntzh)),
- ("indexWordArrayzh", tArrow tByteArrayzh (tArrow tIntzh tWordzh)),
- ("indexAddrArrayzh", tArrow tByteArrayzh (tArrow tIntzh tAddrzh)),
- ("indexFloatArrayzh", tArrow tByteArrayzh (tArrow tIntzh tFloatzh)),
- ("indexDoubleArrayzh", tArrow tByteArrayzh (tArrow tIntzh tDoublezh)),
- ("indexStablePtrArrayzh", Tforall ("a",Klifted) (tArrow tByteArrayzh (tArrow tIntzh (tStablePtrzh (Tvar "a"))))),
- ("indexInt8Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tIntzh)),
- ("indexInt16Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tIntzh)),
- ("indexInt32Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tInt32zh)),
- ("indexInt64Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tInt64zh)),
- ("indexWord8Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWordzh)),
- ("indexWord16Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWordzh)),
- ("indexWord32Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWord32zh)),
- ("indexWord64Arrayzh", tArrow tByteArrayzh (tArrow tIntzh tWord64zh)),
- ("readCharArrayzh", tReadMutableByteArrayzh tCharzh),
- ("readWideCharArrayzh", tReadMutableByteArrayzh tCharzh),
- ("readIntArrayzh", tReadMutableByteArrayzh tIntzh),
- ("readWordArrayzh", tReadMutableByteArrayzh tWordzh),
- ("readAddrArrayzh", tReadMutableByteArrayzh tAddrzh),
- ("readFloatArrayzh", tReadMutableByteArrayzh tFloatzh),
- ("readDoubleArrayzh", tReadMutableByteArrayzh tDoublezh),
- ("readStablePtrArrayzh", Tforall ("s",Klifted)
-				 (Tforall ("a",Klifted)
-					  (tArrow (tMutableByteArrayzh (Tvar "s"))
-				                  (tArrow tIntzh
-				                         (tArrow (tStatezh (Tvar "s"))
-				                                 (tUtuple [tStatezh (Tvar "s"),tStablePtrzh (Tvar "a")])))))),
- ("readInt8Arrayzh", tReadMutableByteArrayzh tIntzh),
- ("readInt16Arrayzh", tReadMutableByteArrayzh tIntzh),
- ("readInt32Arrayzh", tReadMutableByteArrayzh tInt32zh),
- ("readInt64Arrayzh", tReadMutableByteArrayzh tInt64zh),
- ("readWord8Arrayzh", tReadMutableByteArrayzh tWordzh),
- ("readWord16Arrayzh", tReadMutableByteArrayzh tWordzh),
- ("readWord32Arrayzh", tReadMutableByteArrayzh tWord32zh),
- ("readWord64Arrayzh", tReadMutableByteArrayzh tWord64zh),
-
- ("writeCharArrayzh", tWriteMutableByteArrayzh tCharzh),
- ("writeWideCharArrayzh", tWriteMutableByteArrayzh tCharzh),
- ("writeIntArrayzh", tWriteMutableByteArrayzh tIntzh),
- ("writeWordArrayzh", tWriteMutableByteArrayzh tWordzh),
- ("writeAddrArrayzh", tWriteMutableByteArrayzh tAddrzh),
- ("writeFloatArrayzh", tWriteMutableByteArrayzh tFloatzh),
- ("writeDoubleArrayzh", tWriteMutableByteArrayzh tDoublezh),
- ("writeStablePtrArrayzh", Tforall ("s",Klifted)
-				  (Tforall ("a",Klifted)
-				           (tArrow (tMutableByteArrayzh (Tvar "s"))
-				                   (tArrow tIntzh
-				                          (tArrow (tStablePtrzh (Tvar "a"))
-			  		                          (tArrow (tStatezh (Tvar "s"))
-				                                          (tStatezh (Tvar "s")))))))),
- ("writeInt8Arrayzh", tWriteMutableByteArrayzh tIntzh),
- ("writeInt16Arrayzh", tWriteMutableByteArrayzh tIntzh),
- ("writeInt32Arrayzh", tWriteMutableByteArrayzh tIntzh),
- ("writeInt64Arrayzh", tWriteMutableByteArrayzh tInt64zh),
- ("writeWord8Arrayzh", tWriteMutableByteArrayzh tWordzh),
- ("writeWord16Arrayzh", tWriteMutableByteArrayzh tWordzh),
- ("writeWord32Arrayzh", tWriteMutableByteArrayzh tWord32zh),
- ("writeWord64Arrayzh", tWriteMutableByteArrayzh tWord64zh),
-
- ("indexCharOffAddrzh", tArrow tAddrzh (tArrow tIntzh tCharzh)),
- ("indexWideCharOffAddrzh", tArrow tAddrzh (tArrow tIntzh tCharzh)),
- ("indexIntOffAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh)),
- ("indexWordOffAddrzh", tArrow tAddrzh (tArrow tIntzh tWordzh)),
- ("indexAddrOffAddrzh", tArrow tAddrzh (tArrow tIntzh tAddrzh)),
- ("indexFloatOffAddrzh", tArrow tAddrzh (tArrow tIntzh tFloatzh)),
- ("indexDoubleOffAddrzh", tArrow tAddrzh (tArrow tIntzh tDoublezh)),
- ("indexStablePtrOffAddrzh", Tforall ("a",Klifted) (tArrow tAddrzh (tArrow tIntzh (tStablePtrzh (Tvar "a"))))),
- ("indexInt8OffAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh)),
- ("indexInt16OffAddrzh", tArrow tAddrzh (tArrow tIntzh tIntzh)),
- ("indexInt32OffAddrzh", tArrow tAddrzh (tArrow tIntzh tInt32zh)),
- ("indexInt64OffAddrzh", tArrow tAddrzh (tArrow tIntzh tInt64zh)),
- ("indexWord8OffAddrzh", tArrow tAddrzh (tArrow tIntzh tWordzh)),
- ("indexWord16OffAddrzh", tArrow tAddrzh (tArrow tIntzh tWordzh)),
- ("indexWord32ffAddrzh", tArrow tAddrzh (tArrow tIntzh tWord32zh)),
- ("indexWord64OffAddrzh", tArrow tAddrzh (tArrow tIntzh tWord64zh)),
-
- ("indexCharOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tCharzh)),
- ("indexWideCharOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tCharzh)),
- ("indexIntOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tIntzh)),
- ("indexWordOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWordzh)),
- ("indexAddrOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tAddrzh)),
- ("indexFloatOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tFloatzh)),
- ("indexDoubleOffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tDoublezh)),
- ("indexStablePtrOffForeignObjzh", Tforall ("a",Klifted) (tArrow tForeignObjzh (tArrow tIntzh (tStablePtrzh (Tvar "a"))))),
- ("indexInt8OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tIntzh)),
- ("indexInt16OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tIntzh)),
- ("indexInt32OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tInt32zh)),
- ("indexInt64OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tInt64zh)),
- ("indexWord8OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWordzh)),
- ("indexWord16OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWordzh)),
- ("indexWord32ffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWord32zh)),
- ("indexWord64OffForeignObjzh", tArrow tForeignObjzh (tArrow tIntzh tWord64zh)),
-
- ("readCharOffAddrzh", tReadOffAddrzh tCharzh),
- ("readWideCharOffAddrzh", tReadOffAddrzh tCharzh),
- ("readIntOffAddrzh", tReadOffAddrzh tIntzh),
- ("readWordOffAddrzh", tReadOffAddrzh tWordzh),
- ("readAddrOffAddrzh", tReadOffAddrzh tAddrzh),
- ("readFloatOffAddrzh", tReadOffAddrzh tFloatzh),
- ("readDoubleOffAddrzh", tReadOffAddrzh tDoublezh),
- ("readStablePtrOffAddrzh", Tforall ("s",Klifted) 
-				(Tforall ("a",Klifted)
-			             (tArrow tAddrzh
-			                     (tArrow tIntzh
-                        			    (tArrow (tStatezh (Tvar "s"))
-			                                    (tUtuple [tStatezh (Tvar "s"),tStablePtrzh (Tvar "a")])))))),
- ("readInt8OffAddrzh", tReadOffAddrzh tIntzh),
- ("readInt16OffAddrzh", tReadOffAddrzh tIntzh),
- ("readInt32OffAddrzh", tReadOffAddrzh tInt32zh),
- ("readInt64OffAddrzh", tReadOffAddrzh tInt64zh),
- ("readWord8OffAddrzh", tReadOffAddrzh tWordzh),
- ("readWord16OffAddrzh", tReadOffAddrzh tWordzh),
- ("readWord32OffAddrzh", tReadOffAddrzh tWord32zh),
- ("readWord64OffAddrzh", tReadOffAddrzh tWord64zh),
-
- ("writeCharOffAddrzh", tWriteOffAddrzh tCharzh),
- ("writeWideCharOffAddrzh", tWriteOffAddrzh tCharzh),
- ("writeIntOffAddrzh", tWriteOffAddrzh tIntzh),
- ("writeWordOffAddrzh", tWriteOffAddrzh tWordzh),
- ("writeAddrOffAddrzh", tWriteOffAddrzh tAddrzh),
- ("writeFloatOffAddrzh", tWriteOffAddrzh tFloatzh),
- ("writeDoubleOffAddrzh", tWriteOffAddrzh tDoublezh),
- ("writeStablePtrOffAddrzh", Tforall ("a",Klifted) (tWriteOffAddrzh (tStablePtrzh (Tvar "a")))),
- ("writeInt8OffAddrzh", tWriteOffAddrzh tIntzh),
- ("writeInt16OffAddrzh", tWriteOffAddrzh tIntzh),
- ("writeInt32OffAddrzh", tWriteOffAddrzh tInt32zh),
- ("writeInt64OffAddrzh", tWriteOffAddrzh tInt64zh),
- ("writeWord8OffAddrzh", tWriteOffAddrzh tWordzh),
- ("writeWord16OffAddrzh", tWriteOffAddrzh tWordzh),
- ("writeWord32OffAddrzh", tWriteOffAddrzh tWord32zh),
- ("writeWord64OffAddrzh", tWriteOffAddrzh tWord64zh),
- 
- ("sameMutableArrayzh", Tforall ("s",Klifted)
-                               (Tforall ("a",Klifted)
-                                        (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
-                                                (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
-                                                        tBool)))),
- ("sameMutableByteArrayzh", Tforall ("s",Klifted)
-                                   (tArrow (tMutableByteArrayzh (Tvar "s"))
-                                           (tArrow (tMutableByteArrayzh (Tvar "s"))
-                                                   tBool))),
- ("readArrayzh",Tforall ("s",Klifted)
-                        (Tforall ("a",Klifted)
-                                 (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
-			                 (tArrow tIntzh
-					         (tArrow (tStatezh (Tvar "s"))
-                                                         (tUtuple[tStatezh (Tvar "s"), Tvar "a"])))))),
- ("writeArrayzh",Tforall ("s",Klifted)
-                         (Tforall ("a",Klifted)
-                                  (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
-			                  (tArrow tIntzh
-				  	          (tArrow (Tvar "a")
-					                  (tArrow (tStatezh (Tvar "s"))
-                                                                  (tStatezh (Tvar "s")))))))),
- ("indexArrayzh", Tforall ("a",Klifted)
-                          (tArrow (tArrayzh (Tvar "a"))
-                                  (tArrow tIntzh
-                                          (tUtuple[Tvar "a"])))),
- ("unsafeFreezzeArrayzh",Tforall ("s",Klifted)
-                                (Tforall ("a",Klifted)
-                                         (tArrow (tMutableArrayzh (Tvar "s") (Tvar "a"))
-						 (tArrow (tStatezh (Tvar "s"))
-                                                         (tUtuple[tStatezh (Tvar "s"),tArrayzh (Tvar "a")]))))),
- ("unsafeFreezzeByteArrayzh",Tforall ("s",Klifted)
-                                    (tArrow (tMutableByteArrayzh (Tvar "s"))
-				     	    (tArrow (tStatezh (Tvar "s"))
-                                                    (tUtuple[tStatezh (Tvar "s"),tByteArrayzh])))),
- ("unsafeThawArrayzh",Tforall ("a",Klifted)
-                             (Tforall ("s",Klifted)
-                                      (tArrow (tArrayzh (Tvar "a"))
-					      (tArrow (tStatezh (Tvar "s"))
-                                                      (tUtuple[tStatezh (Tvar "s"),tMutableArrayzh (Tvar "s") (Tvar "a")]))))),
- ("sizzeofByteArrayzh", tArrow tByteArrayzh tIntzh), 
- ("sizzeofMutableByteArrayzh", Tforall ("s",Klifted) (tArrow (tMutableByteArrayzh (Tvar "s")) tIntzh))]
- where
- tReadMutableByteArrayzh t = 
-     Tforall ("s",Klifted)
-             (tArrow (tMutableByteArrayzh (Tvar "s"))
-                     (tArrow tIntzh
-                            (tArrow (tStatezh (Tvar "s"))
-                                    (tUtuple [tStatezh (Tvar "s"),t]))))
-
- tWriteMutableByteArrayzh t = 
-     Tforall ("s",Klifted)
-             (tArrow (tMutableByteArrayzh (Tvar "s"))
-                     (tArrow tIntzh
-                            (tArrow t
-                                    (tArrow (tStatezh (Tvar "s"))
-                                            (tStatezh (Tvar "s"))))))
-
- tReadOffAddrzh t = 
-     Tforall ("s",Klifted)
-             (tArrow tAddrzh
-                     (tArrow tIntzh
-                            (tArrow (tStatezh (Tvar "s"))
-                                    (tUtuple [tStatezh (Tvar "s"),t]))))
-
-
- tWriteOffAddrzh t = 
-     Tforall ("s",Klifted)
-             (tArrow tAddrzh
-                     (tArrow tIntzh
-                            (tArrow t
-                                    (tArrow (tStatezh (Tvar "s"))
-                                            (tStatezh (Tvar "s"))))))
-
-{- MutVars -}
-
-tcMutVarzh = (primMname,"MutVarzh")
-tMutVarzh s t = Tapp (Tapp (Tcon tcMutVarzh) s) t
-ktMutVarzh = Karrow Klifted (Karrow Klifted Kunlifted)
-
-opsMutVarzh = [
- ("newMutVarzh", Tforall ("a",Klifted)    
-                    (Tforall ("s",Klifted)
-                        (tArrow (Tvar "a") (tArrow (tStatezh (Tvar "s"))
-						   (tUtuple [tStatezh (Tvar "s"),
-						             tMutVarzh (Tvar "s") (Tvar "a")]))))),
- ("readMutVarzh", Tforall ("s",Klifted)
-		    (Tforall ("a",Klifted)
-                        (tArrow (tMutVarzh (Tvar "s")(Tvar "a"))
-				(tArrow (tStatezh (Tvar "s"))
-                                        (tUtuple [tStatezh (Tvar "s"), Tvar "a"]))))),
- ("writeMutVarzh", Tforall ("s",Klifted)
-		    (Tforall ("a",Klifted)
-                        (tArrow (tMutVarzh (Tvar "s") (Tvar "a"))
-				(tArrow (Tvar "a")
-                                        (tArrow (tStatezh (Tvar "s"))
-                                                (tStatezh (Tvar "s"))))))),
- ("sameMutVarzh", Tforall ("s",Klifted)
-	   	    (Tforall ("a",Klifted)
-                        (tArrow (tMutVarzh (Tvar "s") (Tvar "a"))
-				(tArrow (tMutVarzh (Tvar "s") (Tvar "a"))
-				        tBool))))]
-
-{- Real world and state. -}
-
-tcRealWorld = (primMname,"RealWorld")
-tRealWorld = Tcon tcRealWorld
-ktRealWorld = Klifted
-
-tcStatezh = (primMname, "Statezh")
-tStatezh t = Tapp (Tcon tcStatezh) t
-ktStatezh = Karrow Klifted Kunlifted
-
-tRWS = tStatezh tRealWorld
-
-opsState = [
-  ("realWorldzh", tRWS)]
-
-{- Exceptions -}
-
--- no primitive type
-opsExn = [
- ("catchzh", 
-	let t' = tArrow tRWS (tUtuple [tRWS, Tvar "a"]) in
-	Tforall ("a",Klifted)
-		(Tforall ("b",Klifted)
-			 (tArrow t'
-				 (tArrow (tArrow (Tvar "b") t') 
-                                         t')))),
-  ("raisezh", Tforall ("a",Klifted)
-		      (Tforall ("b",Klifted)
-			       (tArrow (Tvar "a") (Tvar "b")))),
-  ("blockAsyncExceptionszh", Tforall ("a",Klifted)			
-                                    (tArrow (tArrow tRWS (tUtuple[tRWS,Tvar "a"]))
-					    (tArrow tRWS (tUtuple[tRWS,Tvar "a"])))),
-  ("unblockAsyncExceptionszh", Tforall ("a",Klifted)			
-                                    (tArrow (tArrow tRWS (tUtuple[tRWS,Tvar "a"]))
-					    (tArrow tRWS (tUtuple[tRWS,Tvar "a"]))))]
-
-{- Mvars -} 
-
-tcMVarzh = (primMname, "MVarzh")
-tMVarzh s t = Tapp (Tapp (Tcon tcMVarzh) s) t
-ktMVarzh = Karrow Klifted (Karrow Klifted Kunlifted)
-
-opsMVar = [
- ("newMVarzh", Tforall ("s",Klifted)
-		      (Tforall ("a",Klifted)
-                               (tArrow (tStatezh (Tvar "s"))
-				       (tUtuple[tStatezh (Tvar "s"),tMVarzh (Tvar "s") (Tvar "a")])))),
- ("takeMVarzh", Tforall ("s",Klifted)
-		      (Tforall ("a",Klifted)
-			       (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
-				       (tArrow (tStatezh (Tvar "s"))
-					       (tUtuple[tStatezh (Tvar "s"),Tvar "a"]))))),
- ("tryTakeMVarzh", Tforall ("s",Klifted)
-		      (Tforall ("a",Klifted)
-			       (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
-				       (tArrow (tStatezh (Tvar "s"))
-					       (tUtuple[tStatezh (Tvar "s"),tIntzh,Tvar "a"]))))),
- ("putMVarzh", Tforall ("s",Klifted)
-		      (Tforall ("a",Klifted)
-			       (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
-				       (tArrow (Tvar "a")
-				               (tArrow (tStatezh (Tvar "s"))
-					               (tStatezh (Tvar "s"))))))),
- ("tryPutMVarzh", Tforall ("s",Klifted)
-		      (Tforall ("a",Klifted)
-			       (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
-				       (tArrow (Tvar "a")
-				               (tArrow (tStatezh (Tvar "s"))
-					               (tUtuple [tStatezh (Tvar "s"), tIntzh])))))),
- ("sameMVarzh", Tforall ("s",Klifted)
-		      (Tforall ("a",Klifted)
-			       (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
-				       (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
-					       tBool)))),
- ("isEmptyMVarzh", Tforall ("s",Klifted)
-		      (Tforall ("a",Klifted)
-			       (tArrow (tMVarzh (Tvar "s") (Tvar "a"))
-				       (tArrow (tStatezh (Tvar "s"))
-					       (tUtuple[tStatezh (Tvar "s"),tIntzh])))))]
-
-
-{- Weak Objects -}
-
-tcWeakzh = (primMname, "Weakzh")
-tWeakzh t = Tapp (Tcon tcWeakzh) t
-ktWeakzh = Karrow Klifted Kunlifted
-
-opsWeak = [
-  ("mkWeakzh", Tforall ("o",Kopen)
-                      (Tforall ("b",Klifted)
-			       (Tforall ("c",Klifted)
-					(tArrow (Tvar "o")
-					        (tArrow (Tvar "b")
-							(tArrow (Tvar "c")
-			                                        (tArrow tRWS (tUtuple[tRWS, tWeakzh (Tvar "b")])))))))),
-  ("deRefWeakzh", Tforall ("a",Klifted)
-			 (tArrow (tWeakzh (Tvar "a"))
-			         (tArrow tRWS (tUtuple[tRWS, tIntzh, Tvar "a"])))),
-  ("finalizeWeakzh", Tforall ("a",Klifted)
-			    (tArrow (tWeakzh (Tvar "a"))
-                                    (tArrow tRWS
-					    (tUtuple[tRWS,tIntzh,
-						     tArrow tRWS (tUtuple[tRWS, tUnit])]))))]
-
-
-{- Foreign Objects -}
-
-tcForeignObjzh = (primMname, "ForeignObjzh")
-tForeignObjzh = Tcon tcForeignObjzh
-ktForeignObjzh = Kunlifted
-
-opsForeignObjzh = [
- ("mkForeignObjzh", tArrow tAddrzh
-		           (tArrow tRWS (tUtuple [tRWS,tForeignObjzh]))),
- ("writeForeignObjzh", Tforall ("s",Klifted) 
-		               (tArrow tForeignObjzh
-			               (tArrow tAddrzh
-				               (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s")))))),
- ("foreignObjToAddrzh", tArrow tForeignObjzh tAddrzh),
- ("touchzh", Tforall ("o",Kopen)
-		     (tArrow (Tvar "o")
-			     (tArrow tRWS tRWS)))]
-
-
-{- Stable Pointers (but not names) -}
-
-tcStablePtrzh = (primMname, "StablePtrzh")
-tStablePtrzh t = Tapp (Tcon tcStablePtrzh) t
-ktStablePtrzh = Karrow Klifted Kunlifted
-
-opsStablePtrzh = [
-  ("makeStablePtrzh", Tforall ("a",Klifted) 
-			     (tArrow (Tvar "a")
-				     (tArrow tRWS (tUtuple[tRWS,tStablePtrzh (Tvar "a")])))),
-  ("deRefStablePtrzh", Tforall ("a",Klifted)
-			      (tArrow (tStablePtrzh (Tvar "a"))
-				      (tArrow tRWS (tUtuple[tRWS,Tvar "a"])))),
-  ("eqStablePtrzh", Tforall ("a",Klifted)
-			   (tArrow (tStablePtrzh (Tvar "a"))
-                                   (tArrow (tStablePtrzh (Tvar "a")) tIntzh)))]
-
-{- Concurrency  operations -}
-
-tcThreadIdzh = (primMname,"ThreadIdzh")
-tThreadIdzh = Tcon tcThreadIdzh
-ktThreadIdzh = Kunlifted
-
-opsConc = [
-  ("seqzh", Tforall ("a",Klifted)
-		    (tArrow (Tvar "a") tIntzh)),
-  ("parzh", Tforall ("a",Klifted)
-		    (tArrow (Tvar "a") tIntzh)),
-  ("delayzh", Tforall ("s",Klifted)
-		     (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))),
-  ("waitReadzh", Tforall ("s",Klifted)
-		     (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))),
-  ("waitWritezh", Tforall ("s",Klifted)
-		     (tArrow tIntzh (tArrow (tStatezh (Tvar "s")) (tStatezh (Tvar "s"))))),
-  ("forkzh", Tforall ("a",Klifted)
-		    (tArrow (Tvar "a") 
-			    (tArrow tRWS (tUtuple[tRWS,tThreadIdzh])))),
-  ("killThreadzh", Tforall ("a",Klifted)
-		          (tArrow tThreadIdzh
-			          (tArrow (Tvar "a")
-                                          (tArrow tRWS tRWS)))),
-  ("yieldzh", tArrow tRWS tRWS),
-  ("myThreadIdzh", tArrow tRWS (tUtuple[tRWS, tThreadIdzh]))]
-
-{- Miscellaneous operations -}
-
-opsMisc =  [
-  ("dataToTagzh", Tforall ("a",Klifted) 
-			  (tArrow (Tvar "a") tIntzh)),
-  ("tagToEnumzh", Tforall ("a",Klifted)
-                          (tArrow tIntzh (Tvar "a"))),
-  ("unsafeCoercezh", Tforall ("a",Kopen) 
-                             (Tforall ("b",Kopen) 
-                                      (tArrow (Tvar "a") (Tvar "b")))) -- maybe unneeded
-  ]
-
-{- CCallable and CReturnable.
-   We just define the type constructors for the dictionaries
-   corresponding to these pseudo-classes. -}
-
-tcZCTCCallable = (primMname,"ZCTCCallable")
-ktZCTCCallable = Karrow Kopen Klifted  -- ??
-tcZCTCReturnable = (primMname,"ZCTCReturnable")
-ktZCTCReturnable = Karrow Kopen Klifted  -- ??
-
-{- Non-primitive, but mentioned in the types of primitives. -}
-
-tcUnit = ("PrelBase","Unit")
-tUnit = Tcon tcUnit
-ktUnit = Klifted
-tcBool = ("PrelBase","Bool")
-tBool = Tcon tcBool
-ktBool = Klifted
-
-{- Properly defined in PrelError, but needed in many modules before that. -}
-errorVals = [
- ("error", Tforall ("a",Kopen) (tArrow tString (Tvar "a"))),
- ("irrefutPatError", Tforall ("a",Kopen) (tArrow tString (Tvar "a"))),
- ("patError", Tforall ("a",Kopen) (tArrow tString (Tvar "a")))]
-  
-tcChar = ("PrelBase","Char")
-tChar = Tcon tcChar
-ktChar = Klifted
-tcList = ("PrelBase","ZMZN")
-tList t = Tapp (Tcon tcList) t
-ktList = Karrow Klifted Klifted
-tString = tList tChar
-
-{- Utilities for building types -}
-tmonadic t = tArrow t t
-tdyadic t = tArrow t (tArrow t t)
-tcompare t = tArrow t (tArrow t tBool)
-
diff --git a/ghc/utils/ext-core/Printer.hs b/ghc/utils/ext-core/Printer.hs
deleted file mode 100644
index ded48aadc2..0000000000
--- a/ghc/utils/ext-core/Printer.hs
+++ /dev/null
@@ -1,163 +0,0 @@
-module Printer where
-
-import Pretty
-import Core
-import Char
-import Numeric (fromRat)
-
-instance Show Module where
-  showsPrec d m = shows (pmodule m)
-
-instance Show Tdef where
-  showsPrec d t = shows (ptdef t)
-
-instance Show Cdef where
-  showsPrec d c = shows (pcdef c)
-
-instance Show Vdefg where
-  showsPrec d v = shows (pvdefg v)
-
-instance Show Vdef where
-  showsPrec d v = shows (pvdef v)
-
-instance Show Exp where
-  showsPrec d e = shows (pexp e)
-
-instance Show Alt where
-  showsPrec d a = shows (palt a)
-
-instance Show Ty where
-  showsPrec d t = shows (pty t)
-
-instance Show Kind where
-  showsPrec d k = shows (pkind k)
-
-instance Show Lit where
-  showsPrec d l = shows (plit l)
-
-
-indent = nest 2
-
-pmodule (Module mname tdefs vdefgs) =
-  (text "%module" <+> text mname)
-  $$ indent ((vcat (map ((<> char ';') . ptdef) tdefs))
-	     $$ (vcat (map ((<> char ';') . pvdefg) vdefgs)))
-
-ptdef (Data qtcon tbinds cdefs) =
-  (text "%data" <+> pqname qtcon <+> (hsep (map ptbind tbinds)) <+> char '=')
-  $$ indent (braces ((vcat (punctuate (char ';') (map pcdef cdefs)))))
-
-ptdef (Newtype qtcon tbinds tyopt ) =
-  text "%newtype" <+> pqname qtcon <+> (hsep (map ptbind tbinds)) <+> 
-	(case tyopt of
-           Just ty -> char '=' <+> pty ty 
-           Nothing -> empty)
-
-pcdef (Constr qdcon tbinds tys)  =
-  (pqname qdcon) <+> (sep [hsep (map pattbind tbinds),sep (map paty tys)])
-
-pname id = text id
-
-pqname ("",id) = pname id
-pqname (m,id) = pname m <> char '.' <> pname id
-
-ptbind (t,Klifted) = pname t
-ptbind (t,k) = parens (pname t <> text "::" <> pkind k)
-
-pattbind (t,k) = char '@' <> ptbind (t,k)
-
-pakind (Klifted) = char '*'
-pakind (Kunlifted) = char '#'
-pakind (Kopen) = char '?'
-pakind k = parens (pkind k)
-
-pkind (Karrow k1 k2) = parens (pakind k1 <> text "->" <> pkind k2)
-pkind k = pakind k
-
-paty (Tvar n) = pname n
-paty (Tcon c) = pqname c
-paty t = parens (pty t)
-
-pbty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = parens(fsep [pbty t1, text "->",pty t2])
-pbty (Tapp t1 t2) = pappty t1 [t2] 
-pbty t = paty t
-
-pty (Tapp(Tapp(Tcon tc) t1) t2) | tc == tcArrow = fsep [pbty t1, text "->",pty t2]
-pty (Tforall tb t) = text "%forall" <+> pforall [tb] t
-pty t = pbty t
-
-pappty (Tapp t1 t2) ts = pappty t1 (t2:ts)
-pappty t ts = sep (map paty (t:ts))
-
-pforall tbs (Tforall tb t) = pforall (tbs ++ [tb]) t
-pforall tbs t = hsep (map ptbind tbs) <+> char '.' <+> pty t
-
-pvdefg (Rec vdefs) = text "%rec" $$ braces (indent (vcat (punctuate (char ';') (map pvdef vdefs))))
-pvdefg (Nonrec vdef) = pvdef vdef
-
-pvdef (Vdef (qv,t,e)) = sep [pqname qv <+> text "::" <+> pty t <+> char '=',
-		     indent (pexp e)]
-
-paexp (Var x) = pqname x
-paexp (Dcon x) = pqname x
-paexp (Lit l) = plit l
-paexp e = parens(pexp e)
-
-plamexp bs (Lam b e) = plamexp (bs ++ [b]) e
-plamexp bs e = sep [sep (map pbind bs) <+> text "->",
-		    indent (pexp e)]
-
-pbind (Tb tb) = char '@' <+> ptbind tb
-pbind (Vb vb) = pvbind vb
-
-pfexp (App e1 e2) = pappexp e1 [Left e2]
-pfexp (Appt e t) = pappexp e [Right t]
-pfexp e = paexp e
-
-pappexp (App e1 e2) as = pappexp e1 (Left e2:as)
-pappexp (Appt e t) as = pappexp e (Right t:as)
-pappexp e as = fsep (paexp e : map pa as)
-           where pa (Left e) = paexp e
-		 pa (Right t) = char '@' <+> paty t
-
-pexp (Lam b e) = char '\\' <+> plamexp [b] e
-pexp (Let vd e) = (text "%let" <+> pvdefg vd) $$ (text "%in" <+> pexp e)
-pexp (Case e vb alts) = sep [text "%case" <+> paexp e,
-			     text "%of" <+> pvbind vb]
-			$$ (indent (braces (vcat (punctuate (char ';') (map palt alts)))))
-pexp (Coerce t e) = (text "%coerce" <+> paty t) $$ pexp e
-pexp (Note s e) = (text "%note" <+> pstring s) $$ pexp e
-pexp (External n t) = (text "%extcall" <+> pstring n) $$ paty t
-pexp e = pfexp e
-
-
-pvbind (x,t) = parens(pname x <> text "::" <> pty t)
-
-palt (Acon c tbs vbs e) =
-	sep [pqname c, 
-	     sep (map pattbind tbs),
-	     sep (map pvbind vbs) <+> text "->"]
-        $$ indent (pexp e)
-palt (Alit l e) = 
-	(plit l <+>  text "->")
-	$$ indent (pexp e)
-palt (Adefault e) = 
-	(text "%_ ->")
-	$$ indent (pexp e)
-
-plit (Lint i t) = parens (integer i <> text "::" <> pty t)
-plit (Lrational r t) = parens (text (show (fromRat r)) <>  text "::" <> pty t)
-plit (Lchar c t) = parens (text ("\'" ++ escape [c] ++ "\'") <> text "::" <> pty t)
-plit (Lstring s t) = parens (pstring s <> text "::" <> pty t)
-
-pstring s = doubleQuotes(text (escape s))
-
-escape s = foldr f [] (map ord s)
-    where 
-     f cv rest | (cv < 0x20 || cv > 0x7e || cv == 0x22 || cv == 0x27 || cv == 0x5c) = 
-	 '\\':'x':h1:h0:rest
-           where (q1,r1) = quotRem cv 16
-		 h1 = intToDigit q1
-                 h0 = intToDigit r1
-     f cv rest = (chr cv):rest
-
diff --git a/ghc/utils/ext-core/README b/ghc/utils/ext-core/README
deleted file mode 100644
index 7ec8adf09a..0000000000
--- a/ghc/utils/ext-core/README
+++ /dev/null
@@ -1,9 +0,0 @@
-A set of example programs for handling external core format.
-
-In particular, typechecker and interpreter give a precise semantics.
-
-All can be built using, e.g.,
-
-happy -o Parser.hs Parser.y
-ghc --make -package text -fglasgow-exts  -o Driver Driver.hs
-
diff --git a/ghc/utils/genapply/GenApply.hs b/ghc/utils/genapply/GenApply.hs
deleted file mode 100644
index cdde66fa78..0000000000
--- a/ghc/utils/genapply/GenApply.hs
+++ /dev/null
@@ -1,769 +0,0 @@
-{-# OPTIONS -cpp #-}
-module Main(main) where
-
-#include "../../includes/ghcconfig.h"
-#include "../../includes/MachRegs.h"
-#include "../../includes/Constants.h"
-
-
-#if __GLASGOW_HASKELL__ >= 504
-import Text.PrettyPrint
-import Data.Word
-import Data.Bits
-import Data.List	( intersperse )
-import System.Exit
-import System.Environment
-import System.IO
-#else
-import System
-import IO
-import Bits
-import Word
-import Pretty
-import List		( intersperse )
-#endif
-
--- -----------------------------------------------------------------------------
--- Argument kinds (rougly equivalent to PrimRep)
-
-data ArgRep 
-  = N		-- non-ptr
-  | P		-- ptr
-  | V		-- void
-  | F		-- float
-  | D		-- double
-  | L		-- long (64-bit)
-
--- size of a value in *words*
-argSize :: ArgRep -> Int
-argSize N = 1
-argSize P = 1
-argSize V = 0
-argSize F = 1
-argSize D = (SIZEOF_DOUBLE `quot` SIZEOF_VOID_P :: Int)
-argSize L = (8 `quot` SIZEOF_VOID_P :: Int)
-
-showArg :: ArgRep -> Char
-showArg N = 'n'
-showArg P = 'p'
-showArg V = 'v'
-showArg F = 'f'
-showArg D = 'd'
-showArg L = 'l'
-
--- is a value a pointer?
-isPtr :: ArgRep -> Bool
-isPtr P = True
-isPtr _ = False
-
--- -----------------------------------------------------------------------------
--- Registers
-
-data RegStatus = Registerised | Unregisterised
-
-type Reg = String
-
-availableRegs :: RegStatus -> ([Reg],[Reg],[Reg],[Reg])
-availableRegs Unregisterised = ([],[],[],[])
-availableRegs Registerised =
-  ( vanillaRegs MAX_REAL_VANILLA_REG,
-    floatRegs   MAX_REAL_FLOAT_REG,
-    doubleRegs  MAX_REAL_DOUBLE_REG,
-    longRegs    MAX_REAL_LONG_REG
-  )
-
-vanillaRegs, floatRegs, doubleRegs, longRegs :: Int -> [Reg]
-vanillaRegs n = [ "R" ++ show m | m <- [2..n] ]  -- never use R1
-floatRegs   n = [ "F" ++ show m | m <- [1..n] ]
-doubleRegs  n = [ "D" ++ show m | m <- [1..n] ]
-longRegs    n = [ "L" ++ show m | m <- [1..n] ]
-
--- -----------------------------------------------------------------------------
--- Loading/saving register arguments to the stack
-
-loadRegArgs :: RegStatus -> Int -> [ArgRep] -> (Doc,Int)
-loadRegArgs regstatus sp args 
- = (loadRegOffs reg_locs, sp')
- where (reg_locs, _, sp') = assignRegs regstatus sp args
-
-loadRegOffs :: [(Reg,Int)] -> Doc
-loadRegOffs = vcat . map (uncurry assign_stk_to_reg)
-
-saveRegOffs :: [(Reg,Int)] -> Doc
-saveRegOffs = vcat . map (uncurry assign_reg_to_stk)
-
--- a bit like assignRegs in CgRetConv.lhs
-assignRegs
-	:: RegStatus		-- are we registerised?
-	-> Int			-- Sp of first arg
-	-> [ArgRep]		-- args
-	-> ([(Reg,Int)],	-- regs and offsets to load
-	    [ArgRep],		-- left-over args
-	    Int)		-- Sp of left-over args
-assignRegs regstatus sp args = assign sp args (availableRegs regstatus) []
-
-assign sp [] regs doc = (doc, [], sp)
-assign sp (V : args) regs doc = assign sp args regs doc
-assign sp (arg : args) regs doc
- = case findAvailableReg arg regs of
-    Just (reg, regs') -> assign (sp + argSize arg)  args regs' 
-	    		    ((reg, sp) : doc)
-    Nothing -> (doc, (arg:args), sp)
-
-findAvailableReg N (vreg:vregs, fregs, dregs, lregs) =
-  Just (vreg, (vregs,fregs,dregs,lregs))
-findAvailableReg P (vreg:vregs, fregs, dregs, lregs) =
-  Just (vreg, (vregs,fregs,dregs,lregs))
-findAvailableReg F (vregs, freg:fregs, dregs, lregs) =
-  Just (freg, (vregs,fregs,dregs,lregs))
-findAvailableReg D (vregs, fregs, dreg:dregs, lregs) =
-  Just (dreg, (vregs,fregs,dregs,lregs))
-findAvailableReg L (vregs, fregs, dregs, lreg:lregs) =
-  Just (lreg, (vregs,fregs,dregs,lregs))
-findAvailableReg _ _ = Nothing
-
-assign_reg_to_stk reg sp
-   = loadSpWordOff (regRep reg) sp <> text " = " <> text reg <> semi
-
-assign_stk_to_reg reg sp
-   = text reg <> text " = " <> loadSpWordOff (regRep reg) sp <> semi
-
-regRep ('F':_) = "F_"
-regRep ('D':_) = "D_"
-regRep ('L':_) = "L_"
-regRep _       = "W_"
-
-loadSpWordOff :: String -> Int -> Doc
-loadSpWordOff rep off = text rep <> text "[Sp+WDS(" <> int off <> text ")]"
-
--- make a ptr/non-ptr bitmap from a list of argument types
-mkBitmap :: [ArgRep] -> Word32
-mkBitmap args = foldr f 0 args
- where f arg bm | isPtr arg = bm `shiftL` 1
-		| otherwise = (bm `shiftL` size) .|. ((1 `shiftL` size) - 1)
-	        where size = argSize arg
-
--- -----------------------------------------------------------------------------
--- Generating the application functions
-
--- A SUBTLE POINT about stg_ap functions (can't think of a better
--- place to put this comment --SDM):
---
--- The entry convention to an stg_ap_ function is as follows: all the
--- arguments are on the stack (we might revisit this at some point,
--- but it doesn't make any difference on x86), and THERE IS AN EXTRA
--- EMPTY STACK SLOT at the top of the stack.  
---
--- Why?  Because in several cases, stg_ap_* will need an extra stack
--- slot, eg. to push a return address in the THUNK case, and this is a
--- way of pushing the stack check up into the caller which is probably
--- doing one anyway.  Allocating the extra stack slot in the caller is
--- also probably free, because it will be adjusting Sp after pushing
--- the args anyway (this might not be true of register-rich machines
--- when we start passing args to stg_ap_* in regs).
-
-mkApplyName args
-  = text "stg_ap_" <> text (map showArg args)
-
-mkApplyRetName args
-  = mkApplyName args <> text "_ret"
-
-mkApplyFastName args
-  = mkApplyName args <> text "_fast"
-
-mkApplyInfoName args
-  = mkApplyName args <> text "_info"
-
-genMkPAP regstatus macro jump ticker disamb
-	no_load_regs  	-- don't load argumnet regs before jumping
-	args_in_regs  	-- arguments are already in regs
-	is_pap args all_args_size fun_info_label
-  =  smaller_arity_cases
-  $$ exact_arity_case
-  $$ larger_arity_case
-	
-  where
-    n_args = length args
-
-	-- offset of arguments on the stack at slow apply calls.
-    stk_args_slow_offset = 1
-
-    stk_args_offset
-	| args_in_regs = 0
-	| otherwise    = stk_args_slow_offset
-
--- The SMALLER ARITY cases:
---	if (arity == 1) {
---	    Sp[0] = Sp[1];
---	    Sp[1] = (W_)&stg_ap_1_info;
---	    JMP_(GET_ENTRY(R1.cl));
-    smaller_arity_cases = vcat [ smaller_arity i | i <- [1..n_args-1] ]
-
-    smaller_arity arity
-        =  text "if (arity == " <> int arity <> text ") {" $$
-           nest 4 (vcat [
-	     text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_MANY();",
-
-		-- load up regs for the call, if necessary
-	     load_regs,
-
-		-- If we have more args in registers than are required
-		-- for the call, then we must save some on the stack,
-		-- and set up the stack for the follow-up call.
-		-- If the extra arguments are on the stack, then we must
-		-- instead shuffle them down to make room for the info
-		-- table for the follow-on call.
-	     if overflow_regs
-		then save_extra_regs
-		else shuffle_extra_args,
-
-		-- for a PAP, we have to arrange that the stack contains a
-		-- return address in the even that stg_PAP_entry fails its
-		-- heap check.  See stg_PAP_entry in Apply.hc for details.
-	     if is_pap 
-		then text "R2 = " <> mkApplyInfoName this_call_args <> semi
-
-		else empty,
-	     text "jump " <> text jump <> semi
-	    ]) $$
- 	   text "}"
-
-	where
-		-- offsets in case we need to save regs:
-	     (reg_locs, _, _)
-		= assignRegs regstatus stk_args_offset args
-
-		-- register assignment for *this function call*
-	     (reg_locs', reg_call_leftovers, reg_call_sp_stk_args) 
-		= assignRegs regstatus stk_args_offset (take arity args)
-
-	     load_regs
-		| no_load_regs || args_in_regs = empty
-		| otherwise		       = loadRegOffs reg_locs'
-
-	     (this_call_args, rest_args) = splitAt arity args
-
-		-- the offset of the stack args from initial Sp
-	     sp_stk_args
-		| args_in_regs = stk_args_offset
-		| no_load_regs = stk_args_offset
-		| otherwise    = reg_call_sp_stk_args
-
-		-- the stack args themselves
-	     this_call_stack_args
-		| args_in_regs = reg_call_leftovers -- sp offsets are wrong
-		| no_load_regs = this_call_args
-		| otherwise    = reg_call_leftovers
-
-	     stack_args_size = sum (map argSize this_call_stack_args)
-		
-	     overflow_regs = args_in_regs && length reg_locs > length reg_locs'
-
-	     save_extra_regs
-		= -- we have extra arguments in registers to save
-		  let
-	           extra_reg_locs = drop (length reg_locs') (reverse reg_locs)
-		   adj_reg_locs = [ (reg, off - adj + 1) | 
-				    (reg,off) <- extra_reg_locs ]
-		   adj = case extra_reg_locs of
-			   (reg, fst_off):_ -> fst_off
-		   size = snd (last adj_reg_locs)
-		   in
-	           text "Sp_adj(" <> int (-size - 1) <> text ");" $$
-		   saveRegOffs adj_reg_locs $$
-	     	   loadSpWordOff "W_" 0 <> text " = " <>
-		                mkApplyInfoName rest_args <> semi
-
-	     shuffle_extra_args
-		= vcat (map shuffle_down
-		         [sp_stk_args .. sp_stk_args+stack_args_size-1]) $$
-	     	  loadSpWordOff "W_" (sp_stk_args+stack_args_size-1)
-			<> text " = "
-	                <> mkApplyInfoName rest_args <> semi $$
-	          text "Sp_adj(" <> int (sp_stk_args -  1) <> text ");"
-
-	     shuffle_down i = 
-		  loadSpWordOff "W_" (i-1) <> text " = " <>
-		  loadSpWordOff "W_" i <> semi
-
--- The EXACT ARITY case
---
---	if (arity == 1) {
---	    Sp++;
---	    JMP_(GET_ENTRY(R1.cl));
-
-    exact_arity_case 
-	= text "if (arity == " <> int n_args <> text ") {" $$
-	  let
-	     (reg_doc, sp')
-		| no_load_regs || args_in_regs = (empty, stk_args_offset)
-		| otherwise    = loadRegArgs regstatus stk_args_offset args
-	  in
-	  nest 4 (vcat [
-	    text "TICK_SLOW_CALL_" <> text ticker <> text "_CORRECT();",
-	    reg_doc,
-	    text "Sp_adj(" <> int sp' <> text ");",
-	    if is_pap 
-		then text "R2 = " <> fun_info_label <> semi
-		else empty,
-	    text "jump " <> text jump <> semi
-	  ])
-
--- The LARGER ARITY cases:
---
---	} else /* arity > 1 */ {
---	    BUILD_PAP(1,0,(W_)&stg_ap_v_info);
---	}
-
-    larger_arity_case = 
-	   text "} else {" $$
-	   let
-	     save_regs
-	 	| args_in_regs = 
-		        text "Sp_adj(" <> int (-sp_offset) <> text ");" $$
-			saveRegOffs  reg_locs
-		| otherwise =
-			empty
-	   in
-	   nest 4 (vcat [
-	  	text "TICK_SLOW_CALL_" <> text ticker <> text "_TOO_FEW();",
-		save_regs,
-		text macro <> char '(' <> int n_args <> comma <> 
-					int all_args_size <>  
-					text "," <> fun_info_label <>
-					text "," <> text disamb <>
-					text ");"
-	   ]) $$
-	   char '}'
-	where
-	  -- offsets in case we need to save regs:
-	  (reg_locs, leftovers, sp_offset) 
-		= assignRegs regstatus stk_args_slow_offset args
-		-- BUILD_PAP assumes args start at offset 1
-
--- -----------------------------------------------------------------------------
--- generate an apply function
-
--- args is a list of 'p', 'n', 'f', 'd' or 'l'
-
-genApply regstatus args =
-   let
-    fun_ret_label  = mkApplyRetName args
-    fun_info_label = mkApplyInfoName args
-    all_args_size  = sum (map argSize args)
-   in
-    vcat [
-      text "INFO_TABLE_RET(" <> mkApplyName args <> text ", " <>
-        int all_args_size <> text "/*framsize*/," <>
-	int (fromIntegral (mkBitmap args)) <> text "/*bitmap*/, " <>
-        text "RET_SMALL)\n{",
-      nest 4 (vcat [
-       text "W_ info;",
-       text "W_ arity;",
-
---    if fast == 1:
---        print "static void *lbls[] ="
---        print "  { [FUN]             &&fun_lbl,"
---        print "    [FUN_1_0]         &&fun_lbl,"
---        print "    [FUN_0_1]	      &&fun_lbl,"
---        print "    [FUN_2_0]	      &&fun_lbl,"
---        print "    [FUN_1_1]	      &&fun_lbl,"
---        print "    [FUN_0_2]	      &&fun_lbl,"
---        print "    [FUN_STATIC]      &&fun_lbl,"
---        print "    [PAP]             &&pap_lbl,"
---        print "    [THUNK]           &&thunk_lbl,"
---        print "    [THUNK_1_0]	      &&thunk_lbl,"
---        print "    [THUNK_0_1]	      &&thunk_lbl,"
---        print "    [THUNK_2_0]	      &&thunk_lbl,"
---        print "    [THUNK_1_1]	      &&thunk_lbl,"
---        print "    [THUNK_0_2]	      &&thunk_lbl,"
---        print "    [THUNK_STATIC]    &&thunk_lbl,"
---        print "    [THUNK_SELECTOR]  &&thunk_lbl,"
---        print "    [IND]	      &&ind_lbl,"
---        print "    [IND_OLDGEN]      &&ind_lbl,"
---        print "    [IND_STATIC]      &&ind_lbl,"
---        print "    [IND_PERM]	      &&ind_lbl,"
---        print "    [IND_OLDGEN_PERM] &&ind_lbl"
---        print "  };"
-    
-       text "",
-       text "IF_DEBUG(apply,foreign \"C\" debugBelch(\"" <> fun_ret_label <> 
-	  text "... \"); foreign \"C\" printClosure(R1 \"ptr\"));",
-
-       text "IF_DEBUG(sanity,foreign \"C\" checkStackFrame(Sp+WDS(" <> int (1 + all_args_size)
-	<> text ")\"ptr\"));",
-
---       text "IF_DEBUG(sanity,checkStackChunk(Sp+" <> int (1 + all_args_size) <>
---	  text ", CurrentTSO->stack + CurrentTSO->stack_size));",
-    
-       text "TICK_SLOW_CALL(" <> int (length args) <> text ");",
-
-       let do_assert [] _ = []
-	   do_assert (arg:args) offset
-		| isPtr arg = this : rest
-		| otherwise = rest
-	        where this = text "ASSERT(LOOKS_LIKE_CLOSURE_PTR(Sp(" 
-				 <> int offset <> text ")));"
-		      rest = do_assert args (offset + argSize arg)
-       in
-       vcat (do_assert args 1),
-
-       text  "again:",
-       text  "info = %INFO_PTR(R1);",
-
---    if fast == 1:
---        print "    goto *lbls[info->type];";
---    else:
-        text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (%INFO_TYPE(%STD_INFO(info))) {",
-	nest 4 (vcat [
-
---    if fast == 1:
---        print "    bco_lbl:"
---    else:
-	text "case BCO: {",
-	nest 4 (vcat [
-	  text "arity = TO_W_(StgBCO_arity(R1));",
-	  text "ASSERT(arity > 0);",
-	  genMkPAP regstatus "BUILD_PAP" "ENTRY_LBL(stg_BCO)" "FUN" "BCO"
-		True{-stack apply-} False{-args on stack-} False{-not a PAP-}
-		args all_args_size fun_info_label
-	 ]),
-	text "}",
-
---    if fast == 1:
---        print "    fun_lbl:"
---    else:
-        text "case FUN,",
-        text "     FUN_1_0,",
-        text "     FUN_0_1,",
-        text "     FUN_2_0,",
-        text "     FUN_1_1,",
-        text "     FUN_0_2,",
-        text "     FUN_STATIC: {",
-	nest 4 (vcat [
-	  text "arity = TO_W_(StgFunInfoExtra_arity(%FUN_INFO(info)));",
-	  text "ASSERT(arity > 0);",
-          genMkPAP regstatus "BUILD_PAP" "%GET_ENTRY(R1)" "FUN" "FUN"
-		False{-reg apply-} False{-args on stack-} False{-not a PAP-}
-		args all_args_size fun_info_label
-	 ]),
-	text "}",
-
---    if fast == 1:
---        print "    pap_lbl:"
---    else:
-
-	text "case PAP: {",
-	nest 4 (vcat [
- 	  text "arity = TO_W_(StgPAP_arity(R1));",
-	  text "ASSERT(arity > 0);",
-	  genMkPAP regstatus "NEW_PAP" "stg_PAP_apply" "PAP" "PAP"
-		True{-stack apply-} False{-args on stack-} True{-is a PAP-}
-		args all_args_size fun_info_label
-	 ]),
-	text "}",
-
-	text "",
-
---    if fast == 1:
---        print "    thunk_lbl:"
---    else:
-	text "case AP,",
-	text "     AP_STACK,",
-	text "     CAF_BLACKHOLE,",
-	text "     BLACKHOLE,",
-	text "     SE_BLACKHOLE,",
-	text "     SE_CAF_BLACKHOLE,",
-        text "     THUNK,",
-        text "     THUNK_1_0,",
-        text "     THUNK_0_1,",
-        text "     THUNK_2_0,",
-        text "     THUNK_1_1,",
-        text "     THUNK_0_2,",
-        text "     THUNK_STATIC,",
-        text "     THUNK_SELECTOR: {",
-	nest 4 (vcat [
-          text "TICK_SLOW_CALL_UNEVALD(" <> int (length args) <> text ");",
-	  text "Sp(0) = " <> fun_info_label <> text ";",
-	  -- CAREFUL! in SMP mode, the info table may already have been
-	  -- overwritten by an indirection, so we must enter the original
-	  -- info pointer we read, don't read it again, because it might
-	  -- not be enterable any more.
-	  text "jump %ENTRY_CODE(info);",
-	  text ""
-	 ]),
-	text "}",
-
---    if fast == 1:
---        print "    ind_lbl:"
---    else:
-        text "case IND,",
-        text "     IND_OLDGEN,",
-        text "     IND_STATIC,",
-        text "     IND_PERM,",
-        text "     IND_OLDGEN_PERM: {",
-	nest 4 (vcat [
-	  text "R1 = StgInd_indirectee(R1);",
-	  text "goto again;"
-	 ]),
-	text "}",
-	text "",
-
---    if fast == 0:
-
-       text "default: {",
-       nest 4 (
-         text "foreign \"C\" barf(\"" <> fun_ret_label <> text "\");"
-       ),
-       text "}"
-	
-	]),
-       text "}"
-      ]),
-      text "}"
-    ]
-
--- -----------------------------------------------------------------------------
--- Making a fast unknown application, args are in regs
-
-genApplyFast regstatus args =
-   let
-    fun_fast_label = mkApplyFastName args
-    fun_ret_label  = text "RET_LBL" <> parens (mkApplyName args)
-    fun_info_label = mkApplyInfoName args
-    all_args_size  = sum (map argSize args)
-   in
-    vcat [
-     fun_fast_label,
-     char '{',
-     nest 4 (vcat [     
-        text "W_ info;",
-        text "W_ arity;",
-        text  "info = %GET_STD_INFO(R1);",
-        text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (%INFO_TYPE(info)) {",
-	nest 4 (vcat [
-          text "case FUN,",
-          text "     FUN_1_0,",
-          text "     FUN_0_1,",
-          text "     FUN_2_0,",
-          text "     FUN_1_1,",
-          text "     FUN_0_2,",
-          text "     FUN_STATIC: {",
-	  nest 4 (vcat [
-	    text "arity = TO_W_(StgFunInfoExtra_arity(%GET_FUN_INFO(R1)));",
-	    text "ASSERT(arity > 0);",
-            genMkPAP regstatus "BUILD_PAP" "%GET_ENTRY(R1)" "FUN" "FUN"
-	  	False{-reg apply-} True{-args in regs-} False{-not a PAP-}
-	  	args all_args_size fun_info_label
-	   ]),
-	  char '}',
-	  
-	  text "default: {",
-	  let
-	     (reg_locs, leftovers, sp_offset) = assignRegs regstatus 1 args
-		-- leave a one-word space on the top of the stack when
-		-- calling the slow version
-	  in
-	  nest 4 (vcat [
-	     text "Sp_adj" <> parens (int (-sp_offset)) <> semi,
-	     saveRegOffs reg_locs,
-	     text "jump" <+> fun_ret_label <> semi
-	  ]),
-	  char '}'
-	]),
-	char '}'
-      ]),
-     char '}'
-   ]
-
--- -----------------------------------------------------------------------------
--- Making a stack apply
-
--- These little functions are like slow entry points.  They provide
--- the layer between the PAP entry code and the function's fast entry
--- point: namely they load arguments off the stack into registers (if
--- available) and jump to the function's entry code.
---
--- On entry: R1 points to the function closure
---	     arguments are on the stack starting at Sp
---
--- Invariant: the list of arguments never contains void.  Since we're only
--- interested in loading arguments off the stack here, we can ignore
--- void arguments.
-
-mkStackApplyEntryLabel:: [ArgRep] -> Doc
-mkStackApplyEntryLabel args = text "stg_ap_stk_" <> text (map showArg args)
-
-genStackApply :: RegStatus -> [ArgRep] -> Doc
-genStackApply regstatus args = 
-  let fn_entry_label = mkStackApplyEntryLabel args in
-  vcat [
-    fn_entry_label,
-    text "{", nest 4 body, text "}"
-   ]
- where
-   (assign_regs, sp') = loadRegArgs regstatus 0 args
-   body = vcat [assign_regs,
-		text "Sp_adj" <> parens (int sp') <> semi,
-		text "jump %GET_ENTRY(R1);"
-		]
-
--- -----------------------------------------------------------------------------
--- Stack save entry points.
---
--- These code fragments are used to save registers on the stack at a heap
--- check failure in the entry code for a function.  We also have to save R1
--- and the return address (stg_gc_fun_info) on the stack.  See stg_gc_fun_gen
--- in HeapStackCheck.hc for more details.
-
-mkStackSaveEntryLabel :: [ArgRep] -> Doc
-mkStackSaveEntryLabel args = text "stg_stk_save_" <> text (map showArg args)
-
-genStackSave :: RegStatus -> [ArgRep] -> Doc
-genStackSave regstatus args =
-  let fn_entry_label= mkStackSaveEntryLabel args in
-  vcat [
-    fn_entry_label,
-    text "{", nest 4 body, text "}"
-   ]
- where
-   body = vcat [text "Sp_adj" <> parens (int (-sp_offset)) <> semi,
-		saveRegOffs reg_locs,
-		text "Sp(2) = R1;",
-		text "Sp(1) =" <+> int stk_args <> semi,
-		text "Sp(0) = stg_gc_fun_info;",
-		text "jump stg_gc_noregs;"
-		]
-
-   std_frame_size = 3 -- the std bits of the frame. See StgRetFun in Closures.h,
-		      -- and the comment on stg_fun_gc_gen in HeapStackCheck.hc.
-   (reg_locs, leftovers, sp_offset) = assignRegs regstatus std_frame_size args
-
-   -- number of words of arguments on the stack.
-   stk_args = sum (map argSize leftovers) + sp_offset - std_frame_size
-
--- -----------------------------------------------------------------------------
--- The prologue...
-
-main = do
-  args <- getArgs
-  regstatus <- case args of
-		 [] -> return Registerised
-		 ["-u"] -> return Unregisterised
-		 _other -> do hPutStrLn stderr "syntax: genapply [-u]"
-			      exitWith (ExitFailure 1)
-  let the_code = vcat [
-		text "// DO NOT EDIT!",
-		text "// Automatically generated by GenApply.hs",
-		text "",
-		text "#include \"Cmm.h\"",
-		text "#include \"AutoApply.h\"",
-		text "",
-
-		vcat (intersperse (text "") $ 
-		   map (genApply regstatus) applyTypes),
-		vcat (intersperse (text "") $ 
-		   map (genStackFns regstatus) stackApplyTypes),
-
-		vcat (intersperse (text "") $ 
-		   map (genApplyFast regstatus) applyTypes),
-
-		genStackApplyArray stackApplyTypes,
-		genStackSaveArray stackApplyTypes,
-		genBitmapArray stackApplyTypes,
-
-		text ""  -- add a newline at the end of the file
-	    ]
-  -- in
-  putStr (render the_code)
-
--- These have been shown to cover about 99% of cases in practice...
-applyTypes = [
-	[V],
-	[F],
-	[D],
-	[L],
-	[N],
-	[P],
-	[P,V],
-	[P,P],
-	[P,P,V],
-	[P,P,P],
-	[P,P,P,V],
-	[P,P,P,P],
-	[P,P,P,P,P],
-	[P,P,P,P,P,P]
-   ]
-
--- No need for V args in the stack apply cases.
--- ToDo: the stack apply and stack save code doesn't make a distinction
--- between N and P (they both live in the same register), only the bitmap
--- changes, so we could share the apply/save code between lots of cases.
-stackApplyTypes = [
-	[],
-	[N],
-	[P],
-	[F],
-	[D],
-	[L],
-	[N,N],
-	[N,P],
-	[P,N],
-	[P,P],
-	[N,N,N],
-	[N,N,P],
-	[N,P,N],
-	[N,P,P],
-	[P,N,N],
-	[P,N,P],
-	[P,P,N],
-	[P,P,P],
-	[P,P,P,P],
-	[P,P,P,P,P],
-	[P,P,P,P,P,P],
-	[P,P,P,P,P,P,P],
-	[P,P,P,P,P,P,P,P]
-   ]
-
-genStackFns regstatus args 
-  =  genStackApply regstatus args
-  $$ genStackSave regstatus args
-
-
-genStackApplyArray types =
-  vcat [
-    text "section \"rodata\" {",
-    text "stg_ap_stack_entries:",
-    text "W_ 0; W_ 0; W_ 0;", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO
-    vcat (map arr_ent types),
-    text "}"
-  ]
- where
-  arr_ent ty = text "W_" <+> mkStackApplyEntryLabel ty <> semi
-
-genStackSaveArray types =
-  vcat [
-    text "section \"rodata\" {",
-    text "stg_stack_save_entries:",
-    text "W_ 0; W_ 0; W_ 0;", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO
-    vcat (map arr_ent types),
-    text "}"
-  ]
- where
-  arr_ent ty = text "W_" <+> mkStackSaveEntryLabel ty <> semi
-
-genBitmapArray :: [[ArgRep]] -> Doc
-genBitmapArray types =
-  vcat [
-    text "section \"rodata\" {",
-    text "stg_arg_bitmaps:",
-    text "W_ 0; W_ 0; W_ 0;", -- ARG_GEN, ARG_GEN_BIG, ARG_BCO
-    vcat (map gen_bitmap types),
-    text "}"
-  ]
-  where
-   gen_bitmap ty = text "W_" <+> int bitmap_val <> semi
-	where bitmap_val = 
-		(fromIntegral (mkBitmap ty) `shiftL` BITMAP_BITS_SHIFT)
-		 .|. sum (map argSize ty)
-
diff --git a/ghc/utils/genapply/Makefile b/ghc/utils/genapply/Makefile
deleted file mode 100644
index 41084d6c5c..0000000000
--- a/ghc/utils/genapply/Makefile
+++ /dev/null
@@ -1,25 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-HS_PROG = $(GHC_GENAPPLY_PGM)
-
-# genapply is needed to boot in ghc/rts...
-ifneq "$(BootingFromHc)" "YES"
-boot :: all
-endif
-
-ifeq "$(ghc_ge_504)" "NO"
-SRC_HC_OPTS +=  -package lang -package util -package text
-endif
-
-ifeq "$(GhcUnregisterised)" "YES"
-SRC_HC_OPTS += -DNO_REGS
-endif
-
-# Try to get dependencies right...
-SRC_HC_OPTS += -no-recomp
-GenApply.o : $(GHC_INCLUDE_DIR)/ghcconfig.h
-GenApply.o : $(GHC_INCLUDE_DIR)/MachRegs.h
-GenApply.o : $(GHC_INCLUDE_DIR)/Constants.h
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/genprimopcode/Main.hs b/ghc/utils/genprimopcode/Main.hs
deleted file mode 100644
index f08b7d5602..0000000000
--- a/ghc/utils/genprimopcode/Main.hs
+++ /dev/null
@@ -1,787 +0,0 @@
-{-# OPTIONS -cpp #-}
-------------------------------------------------------------------
--- A primop-table mangling program                              --
-------------------------------------------------------------------
-
-module Main where
-
-#if __GLASGOW_HASKELL__ >= 504
-import Text.ParserCombinators.Parsec
-#else
-import Parsec
-#endif
-
-import Monad
-import Char
-import List
-import System ( getArgs )
-import Maybe ( catMaybes )
-
-main = getArgs >>= \args ->
-       if length args /= 1 || head args `notElem` known_args
-       then error ("usage: genprimopcode command < primops.txt > ...\n"
-                   ++ "   where command is one of\n"
-                   ++ unlines (map ("            "++) known_args)
-                  )
-       else
-       do s <- getContents
-          let pres = parse pTop "" s
-          case pres of
-             Left err -> error ("parse error at " ++ (show err))
-             Right p_o_specs
-                -> myseq (sanityTop p_o_specs) (
-                   case head args of
-
-                      "--data-decl" 
-                         -> putStr (gen_data_decl p_o_specs)
-
-                      "--has-side-effects" 
-                         -> putStr (gen_switch_from_attribs 
-                                       "has_side_effects" 
-                                       "primOpHasSideEffects" p_o_specs)
-
-                      "--out-of-line" 
-                         -> putStr (gen_switch_from_attribs 
-                                       "out_of_line" 
-                                       "primOpOutOfLine" p_o_specs)
-
-                      "--commutable" 
-                         -> putStr (gen_switch_from_attribs 
-                                       "commutable" 
-                                       "commutableOp" p_o_specs)
-
-                      "--needs-wrapper" 
-                         -> putStr (gen_switch_from_attribs 
-                                       "needs_wrapper" 
-                                       "primOpNeedsWrapper" p_o_specs)
-
-                      "--can-fail" 
-                         -> putStr (gen_switch_from_attribs 
-                                       "can_fail" 
-                                       "primOpCanFail" p_o_specs)
-
-                      "--strictness" 
-                         -> putStr (gen_switch_from_attribs 
-                                       "strictness" 
-                                       "primOpStrictness" p_o_specs)
-
-                      "--usage" 
-                         -> putStr (gen_switch_from_attribs 
-                                       "usage" 
-                                       "primOpUsg" p_o_specs)
-
-                      "--primop-primop-info" 
-                         -> putStr (gen_primop_info p_o_specs)
-
-                      "--primop-tag" 
-                         -> putStr (gen_primop_tag p_o_specs)
-
-                      "--primop-list" 
-                         -> putStr (gen_primop_list p_o_specs)
-
-                      "--make-haskell-wrappers" 
-                         -> putStr (gen_wrappers p_o_specs)
-			
-                      "--make-haskell-source" 
-                         -> putStr (gen_hs_source p_o_specs)
-
-		      "--make-latex-doc"
-			 -> putStr (gen_latex_doc p_o_specs)
-                   )
-
-
-known_args 
-   = [ "--data-decl",
-       "--has-side-effects",
-       "--out-of-line",
-       "--commutable",
-       "--needs-wrapper",
-       "--can-fail",
-       "--strictness",
-       "--usage",
-       "--primop-primop-info",
-       "--primop-tag",
-       "--primop-list",
-       "--make-haskell-wrappers",
-       "--make-haskell-source",
-       "--make-latex-doc"
-     ]
-
-------------------------------------------------------------------
--- Code generators -----------------------------------------------
-------------------------------------------------------------------
-
-gen_hs_source (Info defaults entries)
-   = "module GHC.Prim (\n"
-	    ++ unlines (map (("\t" ++) . hdr) entries)
-            ++ ") where\n\n{-\n"
-	    ++ unlines (map opt defaults) ++ "-}\n"
-            ++ unlines (map ent entries) ++ "\n\n\n"
-     where opt (OptionFalse n) = n ++ " = False"
-           opt (OptionTrue n) = n ++ " = True"
-	   opt (OptionString n v) = n ++ " = { " ++ v ++ "}"
-
-	   hdr s@(Section {}) = sec s
-	   hdr o@(PrimOpSpec {}) = wrap (name o) ++ ","
-
-	   ent s@(Section {}) = ""
-	   ent o@(PrimOpSpec {}) = spec o
-
-	   sec s = "\n-- * " ++ escape (title s) ++ "\n"
-			++ (unlines $ map ("-- " ++ ) $ lines $ unlatex $ escape $ "|" ++ desc s) ++ "\n"
-
-	   spec o = comm ++ decl
-	     where decl = wrap (name o) ++ " :: " ++ pty (ty o)
-		   comm = case (desc o) of
-		   	[] -> ""
-			d -> "\n" ++ (unlines $ map ("-- " ++ ) $ lines $ unlatex $ escape $ "|" ++ d)
-
-		   pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2
-		   pty t = pbty t
-
-		   pbty (TyApp tc ts) = tc ++ (concat (map (' ':) (map paty ts)))
-		   pbty (TyUTup ts) = "(# " ++ (concat (intersperse "," (map pty ts))) ++ " #)"
-		   pbty t = paty t
-
-		   paty (TyVar tv) = tv
-		   paty t = "(" ++ pty t ++ ")"
-
-	   wrap nm | isLower (head nm) = nm
-		   | otherwise = "(" ++ nm ++ ")"
-	   unlatex s = case s of
-	   	'\\':'t':'e':'x':'t':'t':'t':'{':cs -> markup "@" "@" cs
-		'{':'\\':'t':'t':cs -> markup "@" "@" cs
-		c : cs -> c : unlatex cs
-		[] -> []
-	   markup s t cs = s ++ mk (dropWhile isSpace cs)
-	   	where mk "" = t
-	              mk ('\n':cs) = ' ' : mk cs
-	              mk ('}':cs) = t ++ unlatex cs
-	              mk (c:cs) = c : mk cs
-	   escape = concatMap (\c -> if c `elem` special then '\\':c:[] else c:[])
-	   	where special = "/'`\"@<"
-
-gen_latex_doc (Info defaults entries)
-   = "\\primopdefaults{" 
-	 ++ mk_options defaults
-	 ++ "}\n"
-     ++ (concat (map mk_entry entries))
-     where mk_entry (PrimOpSpec {cons=cons,name=name,ty=ty,cat=cat,desc=desc,opts=opts}) =
-   		 "\\primopdesc{" 
-		 ++ latex_encode cons ++ "}{"
-		 ++ latex_encode name ++ "}{"
-		 ++ latex_encode (zencode name) ++ "}{"
-		 ++ latex_encode (show cat) ++ "}{"
-		 ++ latex_encode (mk_source_ty ty) ++ "}{"
-		 ++ latex_encode (mk_core_ty ty) ++ "}{"
-		 ++ desc ++ "}{"
-		 ++ mk_options opts
-		 ++ "}\n"
-           mk_entry (Section {title=title,desc=desc}) =
-		 "\\primopsection{" 
-		 ++ latex_encode title ++ "}{" 
-		 ++ desc ++ "}\n"
-	   mk_source_ty t = pty t
-	     where pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2
-		   pty t = pbty t
-		   pbty (TyApp tc ts) = tc ++ (concat (map (' ':) (map paty ts)))
-		   pbty (TyUTup ts) = "(# " ++ (concat (intersperse "," (map pty ts))) ++ " #)"
-		   pbty t = paty t
-		   paty (TyVar tv) = tv
-		   paty t = "(" ++ pty t ++ ")"
-	   
-	   mk_core_ty t = foralls ++ (pty t)
-	     where pty (TyF t1 t2) = pbty t1 ++ " -> " ++ pty t2
-		   pty t = pbty t
-		   pbty (TyApp tc ts) = (zencode tc) ++ (concat (map (' ':) (map paty ts)))
-		   pbty (TyUTup ts) = (zencode (utuplenm (length ts))) ++ (concat ((map (' ':) (map paty ts))))
-		   pbty t = paty t
-		   paty (TyVar tv) = zencode tv
-		   paty (TyApp tc []) = zencode tc
-		   paty t = "(" ++ pty t ++ ")"
-		   utuplenm 1 = "(# #)"
-		   utuplenm n = "(#" ++ (replicate (n-1) ',') ++ "#)"
-		   foralls = if tvars == [] then "" else "%forall " ++ (tbinds tvars)
-		   tvars = tvars_of t
-		   tbinds [] = ". " 
-		   tbinds ("o":tbs) = "(o::?) " ++ (tbinds tbs)
-		   tbinds (tv:tbs) = tv ++ " " ++ (tbinds tbs)
-	   tvars_of (TyF t1 t2) = tvars_of t1 `union` tvars_of t2
-	   tvars_of (TyApp tc ts) = foldl union [] (map tvars_of ts)
-	   tvars_of (TyUTup ts) = foldr union [] (map tvars_of ts)
-	   tvars_of (TyVar tv) = [tv]
-	   
-           mk_options opts = 
-	     "\\primoptions{"
-	      ++ mk_has_side_effects opts ++ "}{"
-	      ++ mk_out_of_line opts ++ "}{"
-	      ++ mk_commutable opts ++ "}{"
- 	      ++ mk_needs_wrapper opts ++ "}{"
-	      ++ mk_can_fail opts ++ "}{"
-	      ++ latex_encode (mk_strictness opts) ++ "}{"
- 	      ++ latex_encode (mk_usage opts)
-	      ++ "}"
-
-  	   mk_has_side_effects opts = mk_bool_opt opts "has_side_effects" "Has side effects." "Has no side effects."
-	   mk_out_of_line opts = mk_bool_opt opts "out_of_line" "Implemented out of line." "Implemented in line."
-  	   mk_commutable opts = mk_bool_opt opts "commutable" "Commutable." "Not commutable."
-  	   mk_needs_wrapper opts = mk_bool_opt opts "needs_wrapper" "Needs wrapper." "Needs no wrapper."
-	   mk_can_fail opts = mk_bool_opt opts "can_fail" "Can fail." "Cannot fail."
-
-	   mk_bool_opt opts opt_name if_true if_false =
-	     case lookup_attrib opt_name opts of
-	       Just (OptionTrue _) -> if_true
-	       Just (OptionFalse _) -> if_false
-	       Nothing -> ""
-	   
-	   mk_strictness opts = 
-	     case lookup_attrib "strictness" opts of
-	       Just (OptionString _ s) -> s  -- for now
-	       Nothing -> "" 
-
-	   mk_usage opts = 
-	     case lookup_attrib "usage" opts of
-	       Just (OptionString _ s) -> s  -- for now
-	       Nothing -> "" 
-
-	   zencode cs = 
-	     case maybe_tuple cs of
-		Just n  -> n		-- Tuples go to Z2T etc
-		Nothing -> concat (map encode_ch cs)
-	     where
-	       maybe_tuple "(# #)" = Just("Z1H")
-	       maybe_tuple ('(' : '#' : cs) = case count_commas (0::Int) cs of
-						(n, '#' : ')' : cs) -> Just ('Z' : shows (n+1) "H")
-						other		     -> Nothing
-	       maybe_tuple "()" = Just("Z0T")
-	       maybe_tuple ('(' : cs)       = case count_commas (0::Int) cs of
-						(n, ')' : cs) -> Just ('Z' : shows (n+1) "T")
-						other	       -> Nothing
-	       maybe_tuple other    	     = Nothing
-	       
-	       count_commas :: Int -> String -> (Int, String)
-	       count_commas n (',' : cs) = count_commas (n+1) cs
-	       count_commas n cs	  = (n,cs)
-	       
-	       unencodedChar :: Char -> Bool	-- True for chars that don't need encoding
-	       unencodedChar 'Z' = False
-	       unencodedChar 'z' = False
-	       unencodedChar c   = isAlphaNum c
-	       
-	       encode_ch :: Char -> String
-	       encode_ch c | unencodedChar c = [c]	-- Common case first
-	       
-	       -- Constructors
-	       encode_ch '('  = "ZL"	-- Needed for things like (,), and (->)
-	       encode_ch ')'  = "ZR"	-- For symmetry with (
-	       encode_ch '['  = "ZM"
-	       encode_ch ']'  = "ZN"
-	       encode_ch ':'  = "ZC"
-	       encode_ch 'Z'  = "ZZ"
-	       
-	       -- Variables
-	       encode_ch 'z'  = "zz"
-	       encode_ch '&'  = "za"
-	       encode_ch '|'  = "zb"
-	       encode_ch '^'  = "zc"
-	       encode_ch '$'  = "zd"
-	       encode_ch '='  = "ze"
-	       encode_ch '>'  = "zg"
-	       encode_ch '#'  = "zh"
-	       encode_ch '.'  = "zi"
-	       encode_ch '<'  = "zl"
-	       encode_ch '-'  = "zm"
-	       encode_ch '!'  = "zn"
-	       encode_ch '+'  = "zp"
-	       encode_ch '\'' = "zq"
-	       encode_ch '\\' = "zr"
-	       encode_ch '/'  = "zs"
-	       encode_ch '*'  = "zt"
-	       encode_ch '_'  = "zu"
-	       encode_ch '%'  = "zv"
-	       encode_ch c    = 'z' : shows (ord c) "U"
-		       
-	   latex_encode [] = []
-	   latex_encode (c:cs) | c `elem` "#$%&_^{}" = "\\" ++ c:(latex_encode cs)
-	   latex_encode ('~':cs) = "\\verb!~!" ++ (latex_encode cs)
-	   latex_encode ('\\':cs) = "$\\backslash$" ++ (latex_encode cs)
-	   latex_encode (c:cs) = c:(latex_encode cs)
-
-gen_wrappers (Info defaults entries)
-   = "{-# OPTIONS -fno-implicit-prelude #-}\n" 
-	-- Dependencies on Prelude must be explicit in libraries/base, but we
-	-- don't need the Prelude here so we add -fno-implicit-prelude.
-     ++ "module GHC.PrimopWrappers where\n" 
-     ++ "import qualified GHC.Prim\n" 
-     ++ unlines (map f (filter (not.dodgy) (filter is_primop entries)))
-     where
-        f spec = let args = map (\n -> "a" ++ show n) [1 .. arity (ty spec)]
-                     src_name = wrap (name spec)
-                 in "{-# NOINLINE " ++ src_name ++ " #-}\n" ++ 
-                    src_name ++ " " ++ unwords args 
-                     ++ " = (GHC.Prim." ++ name spec ++ ") " ++ unwords args
-        wrap nm | isLower (head nm) = nm
-                | otherwise = "(" ++ nm ++ ")"
-
-        dodgy spec
-           = name spec `elem` 
-             [-- C code generator can't handle these
-              "seq#", 
-              "tagToEnum#",
-              -- not interested in parallel support
-              "par#", "parGlobal#", "parLocal#", "parAt#", 
-              "parAtAbs#", "parAtRel#", "parAtForNow#" 
-             ]
-
-
-gen_primop_list (Info defaults entries)
-   = unlines (
-        [      "   [" ++ cons first       ]
-        ++
-        map (\pi -> "   , " ++ cons pi) rest
-        ++ 
-        [     "   ]"     ]
-     ) where (first:rest) = filter is_primop entries
-
-gen_primop_tag (Info defaults entries)
-   = unlines (max_def : zipWith f primop_entries [1..])
-     where
-	primop_entries = filter is_primop entries
-        f i n = "tagOf_PrimOp " ++ cons i 
-                ++ " = _ILIT(" ++ show n ++ ") :: FastInt"
-	max_def = "maxPrimOpTag = " ++ show (length primop_entries) ++ " :: Int"
-
-gen_data_decl (Info defaults entries)
-   = let conss = map cons (filter is_primop entries)
-     in  "data PrimOp\n   = " ++ head conss ++ "\n"
-         ++ unlines (map ("   | "++) (tail conss))
-
-gen_switch_from_attribs :: String -> String -> Info -> String
-gen_switch_from_attribs attrib_name fn_name (Info defaults entries)
-   = let defv = lookup_attrib attrib_name defaults
-         alts = catMaybes (map mkAlt (filter is_primop entries))
-
-         getAltRhs (OptionFalse _)    = "False"
-         getAltRhs (OptionTrue _)     = "True"
-         getAltRhs (OptionString _ s) = s
-
-         mkAlt po
-            = case lookup_attrib attrib_name (opts po) of
-                 Nothing -> Nothing
-                 Just xx -> Just (fn_name ++ " " ++ cons po ++ " = " ++ getAltRhs xx)
-
-     in
-         case defv of
-            Nothing -> error ("gen_switch_from: " ++ attrib_name)
-            Just xx 
-               -> unlines alts 
-                  ++ fn_name ++ " other = " ++ getAltRhs xx ++ "\n"
-
-------------------------------------------------------------------
--- Create PrimOpInfo text from PrimOpSpecs -----------------------
-------------------------------------------------------------------
-
-
-gen_primop_info (Info defaults entries)
-   = unlines (map mkPOItext (filter is_primop entries))
-
-mkPOItext i = mkPOI_LHS_text i ++ mkPOI_RHS_text i
-
-mkPOI_LHS_text i
-   = "primOpInfo " ++ cons i ++ " = "
-
-mkPOI_RHS_text i
-   = case cat i of
-        Compare 
-           -> case ty i of
-                 TyF t1 (TyF t2 td) 
-                    -> "mkCompare " ++ sl_name i ++ ppType t1
-        Monadic
-           -> case ty i of
-                 TyF t1 td
-                    -> "mkMonadic " ++ sl_name i ++ ppType t1
-        Dyadic
-           -> case ty i of
-                 TyF t1 (TyF t2 td)
-                    -> "mkDyadic " ++ sl_name i ++ ppType t1
-        GenPrimOp
-           -> let (argTys, resTy) = flatTys (ty i)
-                  tvs = nub (tvsIn (ty i))
-              in
-                  "mkGenPrimOp " ++ sl_name i ++ " " 
-                      ++ listify (map ppTyVar tvs) ++ " "
-                      ++ listify (map ppType argTys) ++ " "
-                      ++ "(" ++ ppType resTy ++ ")"
-            
-sl_name i = "FSLIT(\"" ++ name i ++ "\") "
-
-ppTyVar "a" = "alphaTyVar"
-ppTyVar "b" = "betaTyVar"
-ppTyVar "c" = "gammaTyVar"
-ppTyVar "s" = "deltaTyVar"
-ppTyVar "o" = "openAlphaTyVar"
-
-
-ppType (TyApp "Bool"        []) = "boolTy"
-
-ppType (TyApp "Int#"        []) = "intPrimTy"
-ppType (TyApp "Int32#"      []) = "int32PrimTy"
-ppType (TyApp "Int64#"      []) = "int64PrimTy"
-ppType (TyApp "Char#"       []) = "charPrimTy"
-ppType (TyApp "Word#"       []) = "wordPrimTy"
-ppType (TyApp "Word32#"     []) = "word32PrimTy"
-ppType (TyApp "Word64#"     []) = "word64PrimTy"
-ppType (TyApp "Addr#"       []) = "addrPrimTy"
-ppType (TyApp "Float#"      []) = "floatPrimTy"
-ppType (TyApp "Double#"     []) = "doublePrimTy"
-ppType (TyApp "ByteArr#"    []) = "byteArrayPrimTy"
-ppType (TyApp "RealWorld"   []) = "realWorldTy"
-ppType (TyApp "ThreadId#"   []) = "threadIdPrimTy"
-ppType (TyApp "ForeignObj#" []) = "foreignObjPrimTy"
-ppType (TyApp "BCO#"        []) = "bcoPrimTy"
-ppType (TyApp "()"          []) = "unitTy" 	-- unitTy is TysWiredIn's name for ()
-
-
-ppType (TyVar "a")               = "alphaTy"
-ppType (TyVar "b")               = "betaTy"
-ppType (TyVar "c")               = "gammaTy"
-ppType (TyVar "s")               = "deltaTy"
-ppType (TyVar "o")               = "openAlphaTy"
-ppType (TyApp "State#" [x])      = "mkStatePrimTy " ++ ppType x
-ppType (TyApp "MutVar#" [x,y])   = "mkMutVarPrimTy " ++ ppType x 
-                                   ++ " " ++ ppType y
-ppType (TyApp "MutArr#" [x,y])   = "mkMutableArrayPrimTy " ++ ppType x 
-                                   ++ " " ++ ppType y
-
-ppType (TyApp "MutByteArr#" [x]) = "mkMutableByteArrayPrimTy " 
-                                   ++ ppType x
-
-ppType (TyApp "Array#" [x])      = "mkArrayPrimTy " ++ ppType x
-
-
-ppType (TyApp "Weak#"  [x])      = "mkWeakPrimTy " ++ ppType x
-ppType (TyApp "StablePtr#"  [x])      = "mkStablePtrPrimTy " ++ ppType x
-ppType (TyApp "StableName#"  [x])      = "mkStableNamePrimTy " ++ ppType x
-
-ppType (TyApp "MVar#" [x,y])     = "mkMVarPrimTy " ++ ppType x 
-                                   ++ " " ++ ppType y
-ppType (TyApp "TVar#" [x,y])     = "mkTVarPrimTy " ++ ppType x 
-                                   ++ " " ++ ppType y
-ppType (TyUTup ts)               = "(mkTupleTy Unboxed " ++ show (length ts)
-                                   ++ " "
-                                   ++ listify (map ppType ts) ++ ")"
-
-ppType (TyF s d) = "(mkFunTy (" ++ ppType s ++ ") (" ++ ppType d ++ "))"
-
-ppType other
-   = error ("ppType: can't handle: " ++ show other ++ "\n")
-
-listify :: [String] -> String
-listify ss = "[" ++ concat (intersperse ", " ss) ++ "]"
-
-flatTys (TyF t1 t2) = case flatTys t2 of (ts,t) -> (t1:ts,t)
-flatTys other       = ([],other)
-
-tvsIn (TyF t1 t2)    = tvsIn t1 ++ tvsIn t2
-tvsIn (TyApp tc tys) = concatMap tvsIn tys
-tvsIn (TyVar tv)     = [tv]
-tvsIn (TyUTup tys)   = concatMap tvsIn tys
-
-arity = length . fst . flatTys
-
-
-------------------------------------------------------------------
--- Abstract syntax -----------------------------------------------
-------------------------------------------------------------------
-
--- info for all primops; the totality of the info in primops.txt(.pp)
-data Info
-   = Info [Option] [Entry]   -- defaults, primops
-     deriving Show
-
--- info for one primop
-data Entry
-    = PrimOpSpec { cons  :: String,      -- PrimOp name
-                   name  :: String,      -- name in prog text
-                   ty    :: Ty,          -- type
-                   cat   :: Category,    -- category
-		   desc  :: String,      -- description
-                   opts  :: [Option] }   -- default overrides
-    | Section { title :: String,	 -- section title
-		desc  :: String }        -- description
-    deriving Show
-
-is_primop (PrimOpSpec _ _ _ _ _ _) = True
-is_primop _ = False
-
--- a binding of property to value
-data Option
-   = OptionFalse  String          -- name = False
-   | OptionTrue   String          -- name = True
-   | OptionString String String   -- name = { ... unparsed stuff ... }
-     deriving Show
-
--- categorises primops
-data Category
-   = Dyadic | Monadic | Compare | GenPrimOp
-     deriving Show
-
--- types
-data Ty
-   = TyF    Ty Ty
-   | TyApp  TyCon [Ty]
-   | TyVar  TyVar
-   | TyUTup [Ty]   -- unboxed tuples; just a TyCon really, 
-                   -- but convenient like this
-   deriving (Eq,Show)
-
-type TyVar = String
-type TyCon = String
-
-
-------------------------------------------------------------------
--- Sanity checking -----------------------------------------------
-------------------------------------------------------------------
-
-{- Do some simple sanity checks:
-    * all the default field names are unique
-    * for each PrimOpSpec, all override field names are unique
-    * for each PrimOpSpec, all overriden field names   
-          have a corresponding default value
-    * that primop types correspond in certain ways to the 
-      Category: eg if Comparison, the type must be of the form
-         T -> T -> Bool.
-   Dies with "error" if there's a problem, else returns ().
--}
-myseq () x = x
-myseqAll (():ys) x = myseqAll ys x
-myseqAll []      x = x
-
-sanityTop :: Info -> ()
-sanityTop (Info defs entries)
-   = let opt_names = map get_attrib_name defs
-	 primops = filter is_primop entries
-     in  
-     if   length opt_names /= length (nub opt_names)
-     then error ("non-unique default attribute names: " ++ show opt_names ++ "\n")
-     else myseqAll (map (sanityPrimOp opt_names) primops) ()
-
-sanityPrimOp def_names p
-   = let p_names = map get_attrib_name (opts p)
-         p_names_ok
-            = length p_names == length (nub p_names)
-              && all (`elem` def_names) p_names
-         ty_ok = sane_ty (cat p) (ty p)
-     in
-         if   not p_names_ok
-         then error ("attribute names are non-unique or have no default in\n" ++
-                     "info for primop " ++ cons p ++ "\n")
-         else
-         if   not ty_ok
-         then error ("type of primop " ++ cons p ++ " doesn't make sense w.r.t" ++
-                     " category " ++ show (cat p) ++ "\n")
-         else ()
-
-sane_ty Compare (TyF t1 (TyF t2 td)) 
-   | t1 == t2 && td == TyApp "Bool" []  = True
-sane_ty Monadic (TyF t1 td) 
-   | t1 == td  = True
-sane_ty Dyadic (TyF t1 (TyF t2 td))
-   | t1 == t2 && t2 == t2  = True
-sane_ty GenPrimOp any_old_thing
-   = True
-sane_ty _ _
-   = False
-
-get_attrib_name (OptionFalse nm) = nm
-get_attrib_name (OptionTrue nm)  = nm
-get_attrib_name (OptionString nm _) = nm
-
-lookup_attrib nm [] = Nothing
-lookup_attrib nm (a:as) 
-    = if get_attrib_name a == nm then Just a else lookup_attrib nm as
-
-------------------------------------------------------------------
--- The parser ----------------------------------------------------
-------------------------------------------------------------------
-
--- Due to lack of proper lexing facilities, a hack to zap any
--- leading comments
-pTop :: Parser Info
-pTop = then4 (\_ ds es _ -> Info ds es) 
-             pCommentAndWhitespace pDefaults (many pEntry)
-             (lit "thats_all_folks")
-
-pEntry :: Parser Entry
-pEntry 
-  = alts [pPrimOpSpec, pSection]
-
-pSection :: Parser Entry
-pSection = then3 (\_ n d -> Section {title = n, desc = d}) 
-		 (lit "section") stringLiteral pDesc
-
-pDefaults :: Parser [Option]
-pDefaults = then2 sel22 (lit "defaults") (many pOption)
-
-pOption :: Parser Option
-pOption 
-   = alts [
-        then3 (\nm eq ff -> OptionFalse nm)  pName (lit "=") (lit "False"),
-        then3 (\nm eq tt -> OptionTrue nm)   pName (lit "=") (lit "True"),
-        then3 (\nm eq zz -> OptionString nm zz)
-              pName (lit "=") pStuffBetweenBraces
-     ]
-
-pPrimOpSpec :: Parser Entry
-pPrimOpSpec
-   = then7 (\_ c n k t d o -> PrimOpSpec { cons = c, name = n, ty = t, 
-                                           cat = k, desc = d, opts = o } )
-           (lit "primop") pConstructor stringLiteral 
-           pCategory pType pDesc pOptions
-
-pOptions :: Parser [Option]
-pOptions = optdef [] (then2 sel22 (lit "with") (many pOption))
-
-pCategory :: Parser Category
-pCategory 
-   = alts [
-        apply (const Dyadic)    (lit "Dyadic"),
-        apply (const Monadic)   (lit "Monadic"),
-        apply (const Compare)   (lit "Compare"),
-        apply (const GenPrimOp) (lit "GenPrimOp")
-     ]
-
-pDesc :: Parser String
-pDesc = optdef "" pStuffBetweenBraces
-
-pStuffBetweenBraces :: Parser String
-pStuffBetweenBraces
-    = lexeme (
-	do char '{'
-	   ass <- many pInsides
-	   char '}'
-           return (concat ass) )
-
-pInsides :: Parser String
-pInsides 
-    = (do char '{' 
-	  stuff <- many pInsides
-          char '}'
-          return ("{" ++ (concat stuff) ++ "}"))
-      <|> 
-      (do c <- satisfy (/= '}')
-          return [c])
-
-
-
--------------------
--- Parsing types --
--------------------
-
-pType :: Parser Ty
-pType = then2 (\t maybe_tt -> case maybe_tt of 
-                                 Just tt -> TyF t tt
-                                 Nothing -> t)
-              paT 
-              (opt (then2 sel22 (lit "->") pType))
-
--- Atomic types
-paT = alts [ then2 TyApp pTycon (many ppT),
-             pUnboxedTupleTy,
-             then3 sel23 (lit "(") pType (lit ")"),
-             ppT 
-      ]
-
--- the magic bit in the middle is:  T (,T)*  so to speak
-pUnboxedTupleTy
-   = then3 (\ _ ts _ -> TyUTup ts)
-           (lit "(#")
-           (then2 (:) pType (many (then2 sel22 (lit ",") pType)))
-           (lit "#)")
-
--- Primitive types
-ppT = alts [apply TyVar pTyvar,
-            apply (\tc -> TyApp tc []) pTycon
-           ]
-
-pTyvar       = sat (`notElem` ["section","primop","with"]) pName
-pTycon       = alts [pConstructor, lexeme (string "()")]
-pName        = lexeme (then2 (:) lower (many isIdChar))
-pConstructor = lexeme (then2 (:) upper (many isIdChar))
-
-isIdChar = satisfy (`elem` idChars)
-idChars  = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ "#_"
-
-sat pred p
-   = do x <- try p
-        if pred x
-         then return x
-         else pzero
-
-------------------------------------------------------------------
--- Helpful additions to Daan's parser stuff ----------------------
-------------------------------------------------------------------
-
-alts [p1]       = try p1
-alts (p1:p2:ps) = (try p1) <|> alts (p2:ps)
-
-then2 f p1 p2 
-   = do x1 <- p1 ; x2 <- p2 ; return (f x1 x2)
-then3 f p1 p2 p3
-   = do x1 <- p1 ; x2 <- p2 ; x3 <- p3 ; return (f x1 x2 x3)
-then4 f p1 p2 p3 p4
-   = do x1 <- p1 ; x2 <- p2 ; x3 <- p3 ; x4 <- p4 ; return (f x1 x2 x3 x4)
-then5 f p1 p2 p3 p4 p5
-   = do x1 <- p1 ; x2 <- p2 ; x3 <- p3 ; x4 <- p4 ; x5 <- p5
-        return (f x1 x2 x3 x4 x5)
-then6 f p1 p2 p3 p4 p5 p6
-   = do x1 <- p1 ; x2 <- p2 ; x3 <- p3 ; x4 <- p4 ; x5 <- p5 ; x6 <- p6
-        return (f x1 x2 x3 x4 x5 x6)
-then7 f p1 p2 p3 p4 p5 p6 p7
-   = do x1 <- p1 ; x2 <- p2 ; x3 <- p3 ; x4 <- p4 ; x5 <- p5 ; x6 <- p6 ; x7 <- p7
-        return (f x1 x2 x3 x4 x5 x6 x7)
-opt p
-   = (do x <- p; return (Just x)) <|> return Nothing
-optdef d p
-   = (do x <- p; return x) <|> return d
-
-sel12 a b = a
-sel22 a b = b
-sel23 a b c = b
-apply f p = liftM f p
-
--- Hacks for zapping whitespace and comments, unfortunately needed
--- because Daan won't let us have a lexer before the parser :-(
-lexeme  :: Parser p -> Parser p
-lexeme p = then2 sel12 p pCommentAndWhitespace
-
-lit :: String -> Parser ()
-lit s = apply (const ()) (lexeme (string s))
-
-pCommentAndWhitespace :: Parser ()
-pCommentAndWhitespace
-   = apply (const ()) (many (alts [pLineComment, 
-                                   apply (const ()) (satisfy isSpace)]))
-     <|>
-     return ()
-
-pLineComment :: Parser ()
-pLineComment
-   = try (then3 (\_ _ _ -> ()) (string "--") (many (satisfy (/= '\n'))) (char '\n'))
-
-stringLiteral :: Parser String
-stringLiteral   = lexeme (
-                      do { between (char '"')                   
-                                   (char '"' <?> "end of string")
-                                   (many (noneOf "\"")) 
-                         }
-                      <?> "literal string")
-
-
-
-------------------------------------------------------------------
--- end                                                          --
-------------------------------------------------------------------
-
-
-
diff --git a/ghc/utils/genprimopcode/Makefile b/ghc/utils/genprimopcode/Makefile
deleted file mode 100644
index dbd69f6d42..0000000000
--- a/ghc/utils/genprimopcode/Makefile
+++ /dev/null
@@ -1,19 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-HS_PROG = genprimopcode
-
-ifeq "$(ghc_ge_504)" "NO"
-SRC_HC_OPTS += -package text
-endif
-
-ifeq "$(ghc_ge_602)" "YES"
-SRC_HC_OPTS += -package parsec
-endif
-
-# genprimopcode is needed to boot in ghc/compiler...
-ifneq "$(BootingFromHc)" "YES"
-boot :: all
-endif
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/ghc-pkg/Main.hs b/ghc/utils/ghc-pkg/Main.hs
deleted file mode 100644
index fb3ef07c3f..0000000000
--- a/ghc/utils/ghc-pkg/Main.hs
+++ /dev/null
@@ -1,1184 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
------------------------------------------------------------------------------
---
--- (c) The University of Glasgow 2004.
---
--- Package management tool
---
------------------------------------------------------------------------------
-
--- TODO:
---	- validate modules
---	- expanding of variables in new-style package conf
---	- version manipulation (checking whether old version exists,
---	  hiding old version?)
-
-module Main (main) where
-
-import Version	( version, targetOS, targetARCH )
-import Distribution.InstalledPackageInfo
-import Distribution.Compat.ReadP
-import Distribution.ParseUtils	( showError )
-import Distribution.Package
-import Distribution.Version
-import Compat.Directory 	( getAppUserDataDirectory, createDirectoryIfMissing )
-import Compat.RawSystem 	( rawSystem )
-
-import Prelude
-
-#include "../../includes/ghcconfig.h"
-
-#if __GLASGOW_HASKELL__ >= 504
-import System.Console.GetOpt
-import Text.PrettyPrint
-import qualified Control.Exception as Exception
-import Data.Maybe
-#else
-import GetOpt
-import Pretty
-import qualified Exception
-import Maybe
-#endif
-
-import Data.Char	( isSpace )
-import Monad
-import Directory
-import System	( getArgs, getProgName, getEnv,
-		  exitWith, ExitCode(..)
-		)
-import System.IO
-#if __GLASGOW_HASKELL__ >= 600
-import System.IO.Error (try)
-#else
-import System.IO (try)
-#endif
-import Data.List ( isPrefixOf, isSuffixOf, intersperse, groupBy, sortBy )
-
-#ifdef mingw32_HOST_OS
-import Foreign
-
-#if __GLASGOW_HASKELL__ >= 504
-import Foreign.C.String
-#else
-import CString
-#endif
-#endif
-
--- -----------------------------------------------------------------------------
--- Entry point
-
-main :: IO ()
-main = do
-  args <- getArgs
-
-  case getOpt Permute flags args of
-	(cli,_,[]) | FlagHelp `elem` cli -> do
-	   prog <- getProgramName
-	   bye (usageInfo (usageHeader prog) flags)
-	(cli,_,[]) | FlagVersion `elem` cli ->
-	   bye ourCopyright
-	(cli,nonopts,[]) ->
-	   runit cli nonopts
-	(_,_,errors) -> tryOldCmdLine errors args
-
--- If the new command-line syntax fails, then we try the old.  If that
--- fails too, then we output the original errors and the new syntax
--- (so the old syntax is still available, but hidden).
-tryOldCmdLine :: [String] -> [String] -> IO ()
-tryOldCmdLine errors args = do
-  case getOpt Permute oldFlags args of
-	(cli@(_:_),[],[]) -> 
-	   oldRunit cli
-	_failed -> do
-	   prog <- getProgramName
-	   die (concat errors ++ usageInfo (usageHeader prog) flags)
-
--- -----------------------------------------------------------------------------
--- Command-line syntax
-
-data Flag
-  = FlagUser
-  | FlagGlobal
-  | FlagHelp
-  | FlagVersion
-  | FlagConfig	FilePath
-  | FlagGlobalConfig FilePath
-  | FlagForce
-  | FlagAutoGHCiLibs
-  | FlagDefinedName String String
-  | FlagSimpleOutput
-  deriving Eq
-
-flags :: [OptDescr Flag]
-flags = [
-  Option [] ["user"] (NoArg FlagUser)
-	"use the current user's package database",
-  Option [] ["global"] (NoArg FlagGlobal)
-	"(default) use the global package database",
-  Option ['f'] ["package-conf"] (ReqArg FlagConfig "FILE")
-	"act upon specified package config file (only)",
-  Option [] ["global-conf"] (ReqArg FlagGlobalConfig "FILE")
-	"location of the global package config",
-  Option [] ["force"] (NoArg FlagForce)
- 	"ignore missing dependencies, directories, and libraries",
-  Option ['g'] ["auto-ghci-libs"] (NoArg FlagAutoGHCiLibs)
-	"automatically build libs for GHCi (with register)",
-  Option ['?'] ["help"] (NoArg FlagHelp)
-	"display this help and exit",
-  Option ['D'] ["define-name"] (ReqArg toDefined "NAME=VALUE")
-  	"define NAME as VALUE",
-  Option ['V'] ["version"] (NoArg FlagVersion)
-	"output version information and exit",
-  Option [] ["simple-output"] (NoArg FlagSimpleOutput)
-        "print output in easy-to-parse format when running command 'list'"
-  ]
- where
-  toDefined str = 
-    case break (=='=') str of
-      (nm,[])    -> FlagDefinedName nm []
-      (nm,_:val) -> FlagDefinedName nm val
-
-ourCopyright :: String
-ourCopyright = "GHC package manager version " ++ version ++ "\n"
-
-usageHeader :: String -> String
-usageHeader prog = substProg prog $
-  "Usage:\n" ++
-  "  $p register {filename | -}\n" ++
-  "    Register the package using the specified installed package\n" ++
-  "    description. The syntax for the latter is given in the $p\n" ++
-  "    documentation.\n" ++
-  "\n" ++
-  "  $p update {filename | -}\n" ++
-  "    Register the package, overwriting any other package with the\n" ++
-  "    same name.\n" ++
-  "\n" ++
-  "  $p unregister {pkg-id}\n" ++
-  "    Unregister the specified package.\n" ++
-  "\n" ++
-  "  $p expose {pkg-id}\n" ++
-  "    Expose the specified package.\n" ++
-  "\n" ++
-  "  $p hide {pkg-id}\n" ++
-  "    Hide the specified package.\n" ++
-  "\n" ++
-  "  $p list [pkg]\n" ++
-  "    List registered packages in the global database, and also the\n" ++
-  "    user database if --user is given. If a package name is given\n" ++
-  "    all the registered versions will be listed in ascending order.\n" ++
-  "\n" ++
-  "  $p latest pkg\n" ++
-  "    Prints the highest registered version of a package.\n" ++
-  "\n" ++
-  "  $p describe {pkg-id}\n" ++
-  "    Give the registered description for the specified package. The\n" ++
-  "    description is returned in precisely the syntax required by $p\n" ++
-  "    register.\n" ++
-  "\n" ++
-  "  $p field {pkg-id} {field}\n" ++
-  "    Extract the specified field of the package description for the\n" ++
-  "    specified package.\n" ++
-  "\n" ++
-  " The following optional flags are also accepted:\n"
-
-substProg :: String -> String -> String
-substProg _ [] = []
-substProg prog ('$':'p':xs) = prog ++ substProg prog xs
-substProg prog (c:xs) = c : substProg prog xs
-
--- -----------------------------------------------------------------------------
--- Do the business
-
-runit :: [Flag] -> [String] -> IO ()
-runit cli nonopts = do
-  prog <- getProgramName
-  let
-	force = FlagForce `elem` cli
-	auto_ghci_libs = FlagAutoGHCiLibs `elem` cli
-        defines = [ (nm,val) | FlagDefinedName nm val <- cli ]
-  --
-  -- first, parse the command
-  case nonopts of
-    ["register", filename] -> 
-	registerPackage filename defines cli auto_ghci_libs False force
-    ["update", filename] -> 
-	registerPackage filename defines cli auto_ghci_libs True force
-    ["unregister", pkgid_str] -> do
-	pkgid <- readGlobPkgId pkgid_str
-	unregisterPackage pkgid cli
-    ["expose", pkgid_str] -> do
-	pkgid <- readGlobPkgId pkgid_str
-	exposePackage pkgid cli
-    ["hide",   pkgid_str] -> do
-	pkgid <- readGlobPkgId pkgid_str
-	hidePackage pkgid cli
-    ["list"] -> do
-	listPackages cli Nothing
-    ["list", pkgid_str] -> do
-	pkgid <- readGlobPkgId pkgid_str
-	listPackages cli (Just pkgid)
-    ["latest", pkgid_str] -> do
-	pkgid <- readGlobPkgId pkgid_str
-	latestPackage cli pkgid
-    ["describe", pkgid_str] -> do
-	pkgid <- readGlobPkgId pkgid_str
-	describePackage cli pkgid
-    ["field", pkgid_str, field] -> do
-	pkgid <- readGlobPkgId pkgid_str
-	describeField cli pkgid field
-    [] -> do
-	die ("missing command\n" ++ 
-		usageInfo (usageHeader prog) flags)
-    (_cmd:_) -> do
-	die ("command-line syntax error\n" ++ 
-		usageInfo (usageHeader prog) flags)
-
-parseCheck :: ReadP a a -> String -> String -> IO a
-parseCheck parser str what = 
-  case [ x | (x,ys) <- readP_to_S parser str, all isSpace ys ] of
-    [x] -> return x
-    _ -> die ("cannot parse \'" ++ str ++ "\' as a " ++ what)
-
-readPkgId :: String -> IO PackageIdentifier
-readPkgId str = parseCheck parsePackageId str "package identifier"
-
-readGlobPkgId :: String -> IO PackageIdentifier
-readGlobPkgId str = parseCheck parseGlobPackageId str "package identifier"
-
-parseGlobPackageId :: ReadP r PackageIdentifier
-parseGlobPackageId = 
-  parsePackageId
-     +++
-  (do n <- parsePackageName; string "-*"
-      return (PackageIdentifier{ pkgName = n, pkgVersion = globVersion }))
-
--- globVersion means "all versions"
-globVersion :: Version
-globVersion = Version{ versionBranch=[], versionTags=["*"] }
-
--- -----------------------------------------------------------------------------
--- Package databases
-
--- Some commands operate on a single database:
---	register, unregister, expose, hide
--- however these commands also check the union of the available databases
--- in order to check consistency.  For example, register will check that
--- dependencies exist before registering a package.
---
--- Some commands operate  on multiple databases, with overlapping semantics:
---	list, describe, field
-
-type PackageDBName  = FilePath
-type PackageDB      = [InstalledPackageInfo]
-
-type PackageDBStack = [(PackageDBName,PackageDB)]
-	-- A stack of package databases.  Convention: head is the topmost
-	-- in the stack.  Earlier entries override later one.
-
-getPkgDatabases :: Bool -> [Flag] -> IO PackageDBStack
-getPkgDatabases modify flags = do
-  -- first we determine the location of the global package config.  On Windows,
-  -- this is found relative to the ghc-pkg.exe binary, whereas on Unix the
-  -- location is passed to the binary using the --global-config flag by the
-  -- wrapper script.
-  let err_msg = "missing --global-conf option, location of global package.conf unknown\n"
-  global_conf <- 
-     case [ f | FlagGlobalConfig f <- flags ] of
-	[] -> do mb_dir <- getExecDir "/bin/ghc-pkg.exe"
-		 case mb_dir of
-			Nothing  -> die err_msg
-			Just dir -> return (dir `joinFileName` "package.conf")
-        fs -> return (last fs)
-
-  let global_conf_dir = global_conf ++ ".d"
-  global_conf_dir_exists <- doesDirectoryExist global_conf_dir
-  global_confs <-
-    if global_conf_dir_exists
-      then do files <- getDirectoryContents global_conf_dir
-              return [ global_conf_dir ++ '/' : file
-                     | file <- files
-                     , isSuffixOf ".conf" file]
-      else return []
-
-  -- get the location of the user package database, and create it if necessary
-  appdir <- getAppUserDataDirectory "ghc"
-
-  let
-	subdir = targetARCH ++ '-':targetOS ++ '-':version
-	archdir   = appdir `joinFileName` subdir
-	user_conf = archdir `joinFileName` "package.conf"
-  user_exists <- doesFileExist user_conf
-
-  -- If the user database doesn't exist, and this command isn't a
-  -- "modify" command, then we won't attempt to create or use it.
-  let sys_databases
-	| modify || user_exists = user_conf : global_confs ++ [global_conf]
-	| otherwise             = global_confs ++ [global_conf]
-
-  e_pkg_path <- try (getEnv "GHC_PACKAGE_PATH")
-  let env_stack =
-	case e_pkg_path of
-		Left  _ -> sys_databases
-		Right path
-		  | last cs == ""  -> init cs ++ sys_databases
-		  | otherwise      -> cs
-		  where cs = parseSearchPath path
-
-	-- The "global" database is always the one at the bottom of the stack.
-	-- This is the database we modify by default.
-      virt_global_conf = last env_stack
-
-  -- -f flags on the command line add to the database stack, unless any
-  -- of them are present in the stack already.
-  let flag_stack = filter (`notElem` env_stack) 
-			[ f | FlagConfig f <- reverse flags ] ++ env_stack
-
-  -- Now we have the full stack of databases.  Next, if the current
-  -- command is a "modify" type command, then we truncate the stack
-  -- so that the topmost element is the database being modified.
-  final_stack <-
-     if not modify 
-        then return flag_stack
-	else let
-	      	go (FlagUser : fs)     = modifying user_conf
-	      	go (FlagGlobal : fs)   = modifying virt_global_conf
-	      	go (FlagConfig f : fs) = modifying f
-	      	go (_ : fs)            = go fs
-	      	go []                  = modifying virt_global_conf
-		
-		modifying f 
-		  | f `elem` flag_stack = return (dropWhile (/= f) flag_stack)
-		  | otherwise           = die ("requesting modification of database:\n\t" ++ f ++ "\n\twhich is not in the database stack.")
-	     in
-		go flags
-
-  -- we create the user database iff (a) we're modifying, and (b) the
-  -- user asked to use it by giving the --user flag.
-  when (not user_exists && user_conf `elem` final_stack) $ do
-	putStrLn ("Creating user package database in " ++ user_conf)
-	createDirectoryIfMissing True archdir
-	writeFile user_conf emptyPackageConfig
-
-  db_stack <- mapM readParseDatabase final_stack
-  return db_stack
-
-readParseDatabase :: PackageDBName -> IO (PackageDBName,PackageDB)
-readParseDatabase filename = do
-  str <- readFile filename
-  let packages = read str
-  Exception.evaluate packages
-    `Exception.catch` \_ -> 
-	die (filename ++ ": parse error in package config file")
-  return (filename,packages)
-
-emptyPackageConfig :: String
-emptyPackageConfig = "[]"
-
--- -----------------------------------------------------------------------------
--- Registering
-
-registerPackage :: FilePath
-		-> [(String,String)] -- defines
-	        -> [Flag]
-		-> Bool		-- auto_ghci_libs
-		-> Bool		-- update
-		-> Bool		-- force
-		-> IO ()
-registerPackage input defines flags auto_ghci_libs update force = do
-  db_stack <- getPkgDatabases True flags
-  let
-	db_to_operate_on = my_head "db" db_stack
-	db_filename	 = fst db_to_operate_on
-  --
-  checkConfigAccess db_filename
-
-  s <-
-    case input of
-      "-" -> do
-	putStr "Reading package info from stdin ... "
-        getContents
-      f   -> do
-        putStr ("Reading package info from " ++ show f ++ " ... ")
-	readFile f
-
-  expanded <- expandEnvVars s defines force
-
-  pkg0 <- parsePackageInfo expanded defines force
-  putStrLn "done."
-
-  let pkg = resolveDeps db_stack pkg0
-  overlaps <- validatePackageConfig pkg db_stack auto_ghci_libs update force
-  new_details <- updatePackageDB db_stack overlaps (snd db_to_operate_on) pkg
-  savePackageConfig db_filename
-  maybeRestoreOldConfig db_filename $
-    writeNewConfig db_filename new_details
-
-parsePackageInfo
-	:: String
-	-> [(String,String)]
-	-> Bool
-	-> IO InstalledPackageInfo
-parsePackageInfo str defines force =
-  case parseInstalledPackageInfo str of
-    ParseOk _warns ok -> return ok
-    ParseFailed err -> die (showError err)
-
--- -----------------------------------------------------------------------------
--- Exposing, Hiding, Unregistering are all similar
-
-exposePackage :: PackageIdentifier ->  [Flag] -> IO ()
-exposePackage = modifyPackage (\p -> [p{exposed=True}])
-
-hidePackage :: PackageIdentifier ->  [Flag] -> IO ()
-hidePackage = modifyPackage (\p -> [p{exposed=False}])
-
-unregisterPackage :: PackageIdentifier ->  [Flag] -> IO ()
-unregisterPackage = modifyPackage (\p -> [])
-
-modifyPackage
-  :: (InstalledPackageInfo -> [InstalledPackageInfo])
-  -> PackageIdentifier
-  -> [Flag]
-  -> IO ()
-modifyPackage fn pkgid flags  = do
-  db_stack <- getPkgDatabases True{-modify-} flags
-  let ((db_name, pkgs) : _) = db_stack
-  checkConfigAccess db_name
-  ps <- findPackages [(db_name,pkgs)] pkgid
-  let pids = map package ps
-  savePackageConfig db_name
-  let new_config = concat (map modify pkgs)
-      modify pkg
-  	  | package pkg `elem` pids = fn pkg
-  	  | otherwise               = [pkg]
-  maybeRestoreOldConfig db_name $
-      writeNewConfig db_name new_config
-
--- -----------------------------------------------------------------------------
--- Listing packages
-
-listPackages ::  [Flag] -> Maybe PackageIdentifier -> IO ()
-listPackages flags mPackageName = do
-  let simple_output = FlagSimpleOutput `elem` flags
-  db_stack <- getPkgDatabases False flags
-  let db_stack_filtered -- if a package is given, filter out all other packages
-        | Just this <- mPackageName =
-            map (\(conf,pkgs) -> (conf, filter (this `matchesPkg`) pkgs)) 
-		db_stack
-        | otherwise = db_stack
-
-      db_stack_sorted 
-          = [ (db, sort_pkgs pkgs) | (db,pkgs) <- db_stack_filtered ]
-	  where sort_pkgs = sortBy cmpPkgIds
-		cmpPkgIds pkg1 pkg2 = 
-		   case pkgName p1 `compare` pkgName p2 of
-			LT -> LT
-			GT -> GT
-			EQ -> pkgVersion p1 `compare` pkgVersion p2
-		   where (p1,p2) = (package pkg1, package pkg2)
-
-      show_func = if simple_output then show_easy else mapM_ show_regular
-
-  show_func (reverse db_stack_sorted)
-
-  where show_regular (db_name,pkg_confs) =
-	  hPutStrLn stdout (render $
-		text (db_name ++ ":") $$ nest 4 packages
-		)
-	   where packages = fsep (punctuate comma (map pp_pkg pkg_confs))
-		 pp_pkg p
-		   | exposed p = doc
-		   | otherwise = parens doc
-		   where doc = text (showPackageId (package p))
-
-        show_easy db_stack = do
-          let pkgs = map showPackageId $ sortBy compPkgIdVer $
-                          map package (concatMap snd db_stack)
-          when (null pkgs) $ die "no matches"
-          hPutStrLn stdout $ concat $ intersperse " " pkgs
-
--- -----------------------------------------------------------------------------
--- Prints the highest (hidden or exposed) version of a package
-
-latestPackage ::  [Flag] -> PackageIdentifier -> IO ()
-latestPackage flags pkgid = do
-  db_stack <- getPkgDatabases False flags
-  ps <- findPackages db_stack pkgid
-  show_pkg (sortBy compPkgIdVer (map package ps))
-  where
-    show_pkg [] = die "no matches"
-    show_pkg pids = hPutStrLn stdout (showPackageId (last pids))
-
--- -----------------------------------------------------------------------------
--- Describe
-
-describePackage :: [Flag] -> PackageIdentifier -> IO ()
-describePackage flags pkgid = do
-  db_stack <- getPkgDatabases False flags
-  ps <- findPackages db_stack pkgid
-  mapM_ (putStrLn . showInstalledPackageInfo) ps
-
--- PackageId is can have globVersion for the version
-findPackages :: PackageDBStack -> PackageIdentifier -> IO [InstalledPackageInfo]
-findPackages db_stack pkgid
-  = case [ p | p <- all_pkgs, pkgid `matchesPkg` p ] of
-	[]  -> die ("cannot find package " ++ showPackageId pkgid)
-	ps -> return ps
-  where
-	all_pkgs = concat (map snd db_stack)
-
-matches :: PackageIdentifier -> PackageIdentifier -> Bool
-pid `matches` pid'
-  = (pkgName pid == pkgName pid')
-    && (pkgVersion pid == pkgVersion pid' || not (realVersion pid))
-
-matchesPkg :: PackageIdentifier -> InstalledPackageInfo -> Bool
-pid `matchesPkg` pkg = pid `matches` package pkg
-
-compPkgIdVer :: PackageIdentifier -> PackageIdentifier -> Ordering
-compPkgIdVer p1 p2 = pkgVersion p1 `compare` pkgVersion p2
-
--- -----------------------------------------------------------------------------
--- Field
-
-describeField :: [Flag] -> PackageIdentifier -> String -> IO ()
-describeField flags pkgid field = do
-  db_stack <- getPkgDatabases False flags
-  case toField field of
-    Nothing -> die ("unknown field: " ++ field)
-    Just fn -> do
-	ps <- findPackages db_stack pkgid 
-	mapM_ (putStrLn.fn) ps
-
-toField :: String -> Maybe (InstalledPackageInfo -> String)
--- backwards compatibility:
-toField "import_dirs"     = Just $ strList . importDirs
-toField "source_dirs"     = Just $ strList . importDirs
-toField "library_dirs"    = Just $ strList . libraryDirs
-toField "hs_libraries"    = Just $ strList . hsLibraries
-toField "extra_libraries" = Just $ strList . extraLibraries
-toField "include_dirs"    = Just $ strList . includeDirs
-toField "c_includes"      = Just $ strList . includes
-toField "package_deps"    = Just $ strList . map showPackageId. depends
-toField "extra_cc_opts"   = Just $ strList . ccOptions
-toField "extra_ld_opts"   = Just $ strList . ldOptions
-toField "framework_dirs"  = Just $ strList . frameworkDirs  
-toField "extra_frameworks"= Just $ strList . frameworks  
-toField s 	 	  = showInstalledPackageInfoField s
-
-strList :: [String] -> String
-strList = show
-
--- -----------------------------------------------------------------------------
--- Manipulating package.conf files
-
-checkConfigAccess :: FilePath -> IO ()
-checkConfigAccess filename = do
-  access <- getPermissions filename
-  when (not (writable access))
-      (die (filename ++ ": you don't have permission to modify this file"))
-
-maybeRestoreOldConfig :: FilePath -> IO () -> IO ()
-maybeRestoreOldConfig filename io
-  = io `catch` \e -> do
-	hPutStrLn stderr (show e)
-        hPutStr stdout ("\nWARNING: an error was encountered while the new \n"++
-        	          "configuration was being written.  Attempting to \n"++
-        	          "restore the old configuration... ")
-	renameFile (filename ++ ".old")  filename
-        hPutStrLn stdout "done."
-	ioError e
-
-writeNewConfig :: FilePath -> [InstalledPackageInfo] -> IO ()
-writeNewConfig filename packages = do
-  hPutStr stdout "Writing new package config file... "
-  h <- openFile filename WriteMode
-  hPutStrLn h (show packages)
-  hClose h
-  hPutStrLn stdout "done."
-
-savePackageConfig :: FilePath -> IO ()
-savePackageConfig filename = do
-  hPutStr stdout "Saving old package config file... "
-    -- mv rather than cp because we've already done an hGetContents
-    -- on this file so we won't be able to open it for writing
-    -- unless we move the old one out of the way...
-  let oldFile = filename ++ ".old"
-  doesExist <- doesFileExist oldFile  `catch` (\ _ -> return False)
-  when doesExist (removeFile oldFile `catch` (const $ return ()))
-  catch (renameFile filename oldFile)
-  	(\ err -> do
-		hPutStrLn stderr (unwords [ "Unable to rename "
-					  , show filename
-					  , " to "
-					  , show oldFile
-					  ])
-		ioError err)
-  hPutStrLn stdout "done."
-
------------------------------------------------------------------------------
--- Sanity-check a new package config, and automatically build GHCi libs
--- if requested.
-
-validatePackageConfig :: InstalledPackageInfo
-		      -> PackageDBStack
-		      -> Bool	-- auto-ghc-libs
-		      -> Bool	-- update
-		      -> Bool	-- force
-		      -> IO [PackageIdentifier]
-validatePackageConfig pkg db_stack auto_ghci_libs update force = do
-  checkPackageId pkg
-  overlaps <- checkDuplicates db_stack pkg update force
-  mapM_	(checkDep db_stack force) (depends pkg)
-  mapM_	(checkDir force) (importDirs pkg)
-  mapM_	(checkDir force) (libraryDirs pkg)
-  mapM_	(checkDir force) (includeDirs pkg)
-  mapM_ (checkHSLib (libraryDirs pkg) auto_ghci_libs force) (hsLibraries pkg)
-  return overlaps
-  -- ToDo: check these somehow?
-  --	extra_libraries :: [String],
-  --	c_includes      :: [String],
-
--- When the package name and version are put together, sometimes we can
--- end up with a package id that cannot be parsed.  This will lead to 
--- difficulties when the user wants to refer to the package later, so
--- we check that the package id can be parsed properly here.
-checkPackageId :: InstalledPackageInfo -> IO ()
-checkPackageId ipi =
-  let str = showPackageId (package ipi) in
-  case [ x | (x,ys) <- readP_to_S parsePackageId str, all isSpace ys ] of
-    [_] -> return ()
-    []  -> die ("invalid package identifier: " ++ str)
-    _   -> die ("ambiguous package identifier: " ++ str)
-
-resolveDeps :: PackageDBStack -> InstalledPackageInfo -> InstalledPackageInfo
-resolveDeps db_stack p = updateDeps p
-  where
-	-- The input package spec is allowed to give a package dependency
-	-- without a version number; e.g.
-	--	depends: base
-	-- Here, we update these dependencies without version numbers to
-	-- match the actual versions of the relevant packages installed.
-	updateDeps p = p{depends = map resolveDep (depends p)}
-
-	resolveDep dep_pkgid
-	   | realVersion dep_pkgid  = dep_pkgid
-	   | otherwise		    = lookupDep dep_pkgid
-
-	lookupDep dep_pkgid
-	   = let 
-		name = pkgName dep_pkgid
-	     in
-	     case [ pid | p <- concat (map snd db_stack), 
-			  let pid = package p,
-			  pkgName pid == name ] of
-		(pid:_) -> pid		-- Found installed package,
-					-- replete with its version
-		[]	-> dep_pkgid	-- No installed package; use 
-					-- the version-less one
-
-checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> Bool
-	 -> IO [PackageIdentifier]
-checkDuplicates db_stack pkg update force = do
-  let
-	pkgid = package pkg
-	(_top_db_name, pkgs) : _  = db_stack
-  --
-  -- Check whether this package id already exists in this DB
-  --
-  when (not update && (pkgid `elem` map package pkgs)) $
-       die ("package " ++ showPackageId pkgid ++ " is already installed")
-
-  -- 
-  -- Check whether any of the dependencies of the current package
-  -- conflict with each other.
-  --
-  let
-	all_pkgs = concat (map snd db_stack)
-
-	allModules p = exposedModules p ++ hiddenModules p
-
-	our_dependencies = closePackageDeps all_pkgs [pkg]
-	all_dep_modules = concat (map (\p -> zip (allModules p) (repeat p))
-					 our_dependencies)
-
-	overlaps = [ (m, map snd group) 
-		   | group@((m,_):_) <- groupBy eqfst (sortBy cmpfst all_dep_modules),
-		     length group > 1 ]
-		where eqfst  (a,_) (b,_) = a == b
-		      cmpfst (a,_) (b,_) = a `compare` b
-
-  when (not (null overlaps)) $
-    diePrettyOrForce force $ vcat [
-	text "package" <+> text (showPackageId (package pkg)) <+>
-	  text "has conflicting dependencies:",
-	let complain_about (mod,ps) =
-		text mod <+> text "is in the following packages:" <+> 
-			sep (map (text.showPackageId.package) ps)
-	in
-	nest 3 (vcat (map complain_about overlaps))
-	]
-
-  --
-  -- Now check whether exposing this package will result in conflicts, and
-  -- Figure out which packages we need to hide to resolve the conflicts.
-  --
-  let
-	closure_exposed_pkgs = closePackageDeps pkgs (filter exposed pkgs)
-
-	new_dep_modules = concat $ map allModules $
-			  filter (\p -> package p `notElem` 
-					map package closure_exposed_pkgs) $
-			  our_dependencies
-
-	pkgs_with_overlapping_modules =
-		[ (p, overlapping_mods)
-		| p <- closure_exposed_pkgs, 
-		  let overlapping_mods = 
-			filter (`elem` new_dep_modules) (allModules p),
-		  (_:_) <- [overlapping_mods] --trick to get the non-empty ones
-		]
-
-        to_hide = map package
-		 $ filter exposed
-		 $ closePackageDepsUpward pkgs
-		 $ map fst pkgs_with_overlapping_modules
-
-  when (not update && exposed pkg && not (null pkgs_with_overlapping_modules)) $ do
-    diePretty $ vcat [
-	    text "package" <+> text (showPackageId (package pkg)) <+> 
-	    	text "conflicts with the following packages, which are",
-	    text "either exposed or a dependency (direct or indirect) of an exposed package:",
-	    let complain_about (p, mods)
-	  	  = text (showPackageId (package p)) <+> text "contains modules" <+> 
-		 	sep (punctuate comma (map text mods)) in
-	    nest 3 (vcat (map complain_about pkgs_with_overlapping_modules)),
-	    text "Using 'update' instead of 'register' will cause the following packages",
-	    text "to be hidden, which will eliminate the conflict:",
-	    nest 3 (sep (map (text.showPackageId) to_hide))
-	  ]
-
-  when (not (null to_hide)) $ do
-    hPutStrLn stderr $ render $ 
-	sep [text "Warning: hiding the following packages to avoid conflict: ",
-	     nest 2 (sep (map (text.showPackageId) to_hide))]
-
-  return to_hide
-
-
-closure :: (a->[a]->Bool) -> (a -> [a]) -> [a] -> [a] -> [a]
-closure pred more []     res = res
-closure pred more (p:ps) res
-  | p `pred` res = closure pred more ps res
-  | otherwise    = closure pred more (more p ++ ps) (p:res)
-
-closePackageDeps :: [InstalledPackageInfo] -> [InstalledPackageInfo]
-	 -> [InstalledPackageInfo]
-closePackageDeps db start 
-  = closure (\p ps -> package p `elem` map package ps) getDepends start []
-  where
-	getDepends p = [ pkg | dep <- depends p, pkg <- lookupPkg dep ]
-	lookupPkg p = [ q | q <- db, p == package q ]
-
-closePackageDepsUpward :: [InstalledPackageInfo] -> [InstalledPackageInfo]
-	 -> [InstalledPackageInfo]
-closePackageDepsUpward db start
-  = closure (\p ps -> package p `elem` map package ps) getUpwardDepends start []
-  where
-	getUpwardDepends p = [ pkg | pkg <- db, package p `elem` depends pkg ]
-
-
-checkDir :: Bool -> String -> IO ()
-checkDir force d
- | "$topdir" `isPrefixOf` d = return ()
-	-- can't check this, because we don't know what $topdir is
- | otherwise = do
-   there <- doesDirectoryExist d
-   when (not there)
-       (dieOrForce force (d ++ " doesn't exist or isn't a directory"))
-
-checkDep :: PackageDBStack -> Bool -> PackageIdentifier -> IO ()
-checkDep db_stack force pkgid
-  | not real_version || pkgid `elem` pkgids = return ()
-  | otherwise = dieOrForce force ("dependency " ++ showPackageId pkgid
-					++ " doesn't exist")
-  where
-	-- for backwards compat, we treat 0.0 as a special version,
-	-- and don't check that it actually exists.
- 	real_version = realVersion pkgid
-	
-	all_pkgs = concat (map snd db_stack)
-	pkgids = map package all_pkgs
-
-realVersion :: PackageIdentifier -> Bool
-realVersion pkgid = versionBranch (pkgVersion pkgid) /= []
-
-checkHSLib :: [String] -> Bool -> Bool -> String -> IO ()
-checkHSLib dirs auto_ghci_libs force lib = do
-  let batch_lib_file = "lib" ++ lib ++ ".a"
-  bs <- mapM (doesLibExistIn batch_lib_file) dirs
-  case [ dir | (exists,dir) <- zip bs dirs, exists ] of
-	[] -> dieOrForce force ("cannot find " ++ batch_lib_file ++
-				 " on library path") 
-	(dir:_) -> checkGHCiLib dirs dir batch_lib_file lib auto_ghci_libs
-
-doesLibExistIn :: String -> String -> IO Bool
-doesLibExistIn lib d
- | "$topdir" `isPrefixOf` d = return True
- | otherwise                = doesFileExist (d ++ '/':lib)
-
-checkGHCiLib :: [String] -> String -> String -> String -> Bool -> IO ()
-checkGHCiLib dirs batch_lib_dir batch_lib_file lib auto_build
-  | auto_build = autoBuildGHCiLib batch_lib_dir batch_lib_file ghci_lib_file
-  | otherwise  = do
-      bs <- mapM (doesLibExistIn ghci_lib_file) dirs
-      case [dir | (exists,dir) <- zip bs dirs, exists] of
-        []    -> hPutStrLn stderr ("warning: can't find GHCi lib " ++ ghci_lib_file)
-   	(_:_) -> return ()
-  where
-    ghci_lib_file = lib ++ ".o"
-
--- automatically build the GHCi version of a batch lib, 
--- using ld --whole-archive.
-
-autoBuildGHCiLib :: String -> String -> String -> IO ()
-autoBuildGHCiLib dir batch_file ghci_file = do
-  let ghci_lib_file  = dir ++ '/':ghci_file
-      batch_lib_file = dir ++ '/':batch_file
-  hPutStr stderr ("building GHCi library " ++ ghci_lib_file ++ "...")
-#if defined(darwin_HOST_OS)
-  r <- rawSystem "ld" ["-r","-x","-o",ghci_lib_file,"-all_load",batch_lib_file]
-#elif defined(mingw32_HOST_OS)
-  execDir <- getExecDir "/bin/ghc-pkg.exe"
-  r <- rawSystem (maybe "" (++"/gcc-lib/") execDir++"ld") ["-r","-x","-o",ghci_lib_file,"--whole-archive",batch_lib_file]
-#else
-  r <- rawSystem "ld" ["-r","-x","-o",ghci_lib_file,"--whole-archive",batch_lib_file]
-#endif
-  when (r /= ExitSuccess) $ exitWith r
-  hPutStrLn stderr (" done.")
-
--- -----------------------------------------------------------------------------
--- Updating the DB with the new package.
-
-updatePackageDB
-	:: PackageDBStack		-- the full stack
-	-> [PackageIdentifier]		-- packages to hide
-	-> [InstalledPackageInfo]	-- packages in *this* DB
-	-> InstalledPackageInfo		-- the new package
-	-> IO [InstalledPackageInfo]
-updatePackageDB db_stack to_hide pkgs new_pkg = do
-  let
-	pkgid = package new_pkg
-
-	pkgs' = [ maybe_hide p | p <- pkgs, package p /= pkgid ]
-	
-	-- When update is on, and we're exposing the new package,
-	-- we hide any packages which conflict (see checkDuplicates)
-	-- in the current DB.
-	maybe_hide p
-	  | exposed new_pkg && package p `elem` to_hide = p{ exposed = False }
-	  | otherwise = p
-  --
-  return (pkgs'++ [new_pkg])
-
--- -----------------------------------------------------------------------------
--- Searching for modules
-
-#if not_yet
-
-findModules :: [FilePath] -> IO [String]
-findModules paths = 
-  mms <- mapM searchDir paths
-  return (concat mms)
-
-searchDir path prefix = do
-  fs <- getDirectoryEntries path `catch` \_ -> return []
-  searchEntries path prefix fs
-
-searchEntries path prefix [] = return []
-searchEntries path prefix (f:fs)
-  | looks_like_a_module  =  do
-	ms <- searchEntries path prefix fs
-	return (prefix `joinModule` f : ms)
-  | looks_like_a_component  =  do
-        ms <- searchDir (path `joinFilename` f) (prefix `joinModule` f)
-        ms' <- searchEntries path prefix fs
-	return (ms ++ ms')	
-  | otherwise
-	searchEntries path prefix fs
-
-  where
-	(base,suffix) = splitFileExt f
-	looks_like_a_module = 
-		suffix `elem` haskell_suffixes && 
-		all okInModuleName base
-	looks_like_a_component =
-		null suffix && all okInModuleName base
-
-okInModuleName c
-
-#endif
-
--- -----------------------------------------------------------------------------
--- The old command-line syntax, supported for backwards compatibility
-
-data OldFlag 
-  = OF_Config FilePath
-  | OF_Input FilePath
-  | OF_List
-  | OF_ListLocal
-  | OF_Add Bool {- True => replace existing info -}
-  | OF_Remove String | OF_Show String 
-  | OF_Field String | OF_AutoGHCiLibs | OF_Force
-  | OF_DefinedName String String
-  | OF_GlobalConfig FilePath
-  deriving (Eq)
-
-isAction :: OldFlag -> Bool
-isAction OF_Config{}        = False
-isAction OF_Field{}         = False
-isAction OF_Input{}         = False
-isAction OF_AutoGHCiLibs{}  = False
-isAction OF_Force{}	    = False
-isAction OF_DefinedName{}   = False
-isAction OF_GlobalConfig{}  = False
-isAction _                  = True
-
-oldFlags :: [OptDescr OldFlag]
-oldFlags = [
-  Option ['f'] ["config-file"] (ReqArg OF_Config "FILE")
-	"use the specified package config file",
-  Option ['l'] ["list-packages"] (NoArg OF_List)
- 	"list packages in all config files",
-  Option ['L'] ["list-local-packages"] (NoArg OF_ListLocal)
- 	"list packages in the specified config file",
-  Option ['a'] ["add-package"] (NoArg (OF_Add False))
- 	"add a new package",
-  Option ['u'] ["update-package"] (NoArg (OF_Add True))
- 	"update package with new configuration",
-  Option ['i'] ["input-file"] (ReqArg OF_Input "FILE")
-	"read new package info from specified file",
-  Option ['s'] ["show-package"] (ReqArg OF_Show "NAME")
- 	"show the configuration for package NAME",
-  Option [] ["field"] (ReqArg OF_Field "FIELD")
- 	"(with --show-package) Show field FIELD only",
-  Option [] ["force"] (NoArg OF_Force)
- 	"ignore missing directories/libraries",
-  Option ['r'] ["remove-package"] (ReqArg OF_Remove "NAME")
- 	"remove an installed package",
-  Option ['g'] ["auto-ghci-libs"] (NoArg OF_AutoGHCiLibs)
-	"automatically build libs for GHCi (with -a)",
-  Option ['D'] ["define-name"] (ReqArg toDefined "NAME=VALUE")
-  	"define NAME as VALUE",
-  Option [] ["global-conf"] (ReqArg OF_GlobalConfig "FILE")
-	"location of the global package config"
-  ]
- where
-  toDefined str = 
-    case break (=='=') str of
-      (nm,[]) -> OF_DefinedName nm []
-      (nm,_:val) -> OF_DefinedName nm val
-
-oldRunit :: [OldFlag] -> IO ()
-oldRunit clis = do
-  let new_flags = [ f | Just f <- map conv clis ]
-
-      conv (OF_GlobalConfig f) = Just (FlagGlobalConfig f)
-      conv (OF_Config f)       = Just (FlagConfig f)
-      conv _                   = Nothing
-
-  
-
-  let fields = [ f | OF_Field f <- clis ]
-
-  let auto_ghci_libs = any isAuto clis 
-	 where isAuto OF_AutoGHCiLibs = True; isAuto _ = False
-      input_file = my_head "inp" ([ f | (OF_Input f) <- clis] ++ ["-"])
-
-      force = OF_Force `elem` clis
-      
-      defines = [ (nm,val) | OF_DefinedName nm val <- clis ]
-
-  case [ c | c <- clis, isAction c ] of
-    [ OF_List ]      -> listPackages new_flags Nothing
-    [ OF_ListLocal ] -> listPackages new_flags Nothing
-    [ OF_Add upd ]   -> 
-	registerPackage input_file defines new_flags auto_ghci_libs upd force
-    [ OF_Remove pkgid_str ]  -> do
-	pkgid <- readPkgId pkgid_str
-	unregisterPackage pkgid new_flags
-    [ OF_Show pkgid_str ]
-	| null fields -> do
-		pkgid <- readPkgId pkgid_str
-		describePackage new_flags pkgid
-	| otherwise   -> do
-		pkgid <- readPkgId pkgid_str
-		mapM_ (describeField new_flags pkgid) fields
-    _ -> do 
-	prog <- getProgramName
-	die (usageInfo (usageHeader prog) flags)
-
-my_head :: String -> [a] -> a
-my_head s [] = error s
-my_head s (x:xs) = x
-
--- ---------------------------------------------------------------------------
--- expanding environment variables in the package configuration
-
-expandEnvVars :: String -> [(String, String)] -> Bool -> IO String
-expandEnvVars str defines force = go str ""
- where
-   go "" acc = return $! reverse acc
-   go ('$':'{':str) acc | (var, '}':rest) <- break close str
-        = do value <- lookupEnvVar var
-	     go rest (reverse value ++ acc)
-	where close c = c == '}' || c == '\n' -- don't span newlines
-   go (c:str) acc
-	= go str (c:acc)
-
-   lookupEnvVar :: String -> IO String
-   lookupEnvVar nm = 
-     case lookup nm defines of
-       Just x | not (null x) -> return x
-       _      -> 
-	catch (System.getEnv nm)
-	   (\ _ -> do dieOrForce force ("Unable to expand variable " ++ 
-					show nm)
-		      return "")
-
------------------------------------------------------------------------------
-
-getProgramName :: IO String
-getProgramName = liftM (`withoutSuffix` ".bin") getProgName
-   where str `withoutSuffix` suff
-            | suff `isSuffixOf` str = take (length str - length suff) str
-            | otherwise             = str
-
-bye :: String -> IO a
-bye s = putStr s >> exitWith ExitSuccess
-
-die :: String -> IO a
-die s = do 
-  hFlush stdout
-  prog <- getProgramName
-  hPutStrLn stderr (prog ++ ": " ++ s)
-  exitWith (ExitFailure 1)
-
-dieOrForce :: Bool -> String -> IO ()
-dieOrForce force s 
-  | force     = do hFlush stdout; hPutStrLn stderr (s ++ " (ignoring)")
-  | otherwise = die (s ++ " (use --force to override)")
-
-diePretty :: Doc -> IO ()
-diePretty doc = do
-  hFlush stdout
-  prog <- getProgramName
-  hPutStrLn stderr $ render $ (text prog <> colon $$ nest 2 doc)
-  exitWith (ExitFailure 1)
-
-diePrettyOrForce :: Bool -> Doc -> IO ()
-diePrettyOrForce force doc
-  | force     = do hFlush stdout; hPutStrLn stderr (render (doc $$  text "(ignoring)"))
-  | otherwise = diePretty (doc $$ text "(use --force to override)")
-
------------------------------------------
---	Cut and pasted from ghc/compiler/SysTools
-
-#if defined(mingw32_HOST_OS)
-subst a b ls = map (\ x -> if x == a then b else x) ls
-unDosifyPath xs = subst '\\' '/' xs
-
-getExecDir :: String -> IO (Maybe String)
--- (getExecDir cmd) returns the directory in which the current
---	  	    executable, which should be called 'cmd', is running
--- So if the full path is /a/b/c/d/e, and you pass "d/e" as cmd,
--- you'll get "/a/b/c" back as the result
-getExecDir cmd
-  = allocaArray len $ \buf -> do
-	ret <- getModuleFileName nullPtr buf len
-	if ret == 0 then return Nothing
-	            else do s <- peekCString buf
-			    return (Just (reverse (drop (length cmd) 
-							(reverse (unDosifyPath s)))))
-  where
-    len = 2048::Int -- Plenty, PATH_MAX is 512 under Win32.
-
-foreign import stdcall unsafe  "GetModuleFileNameA"
-  getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
-#else
-getExecDir :: String -> IO (Maybe String) 
-getExecDir _ = return Nothing
-#endif
-
--- -----------------------------------------------------------------------------
--- FilePath utils
-
--- | The 'joinFileName' function is the opposite of 'splitFileName'. 
--- It joins directory and file names to form a complete file path.
---
--- The general rule is:
---
--- > dir `joinFileName` basename == path
--- >   where
--- >     (dir,basename) = splitFileName path
---
--- There might be an exceptions to the rule but in any case the
--- reconstructed path will refer to the same object (file or directory).
--- An example exception is that on Windows some slashes might be converted
--- to backslashes.
-joinFileName :: String -> String -> FilePath
-joinFileName ""  fname = fname
-joinFileName "." fname = fname
-joinFileName dir ""    = dir
-joinFileName dir fname
-  | isPathSeparator (last dir) = dir++fname
-  | otherwise                  = dir++pathSeparator:fname
-
--- | Checks whether the character is a valid path separator for the host
--- platform. The valid character is a 'pathSeparator' but since the Windows
--- operating system also accepts a slash (\"\/\") since DOS 2, the function
--- checks for it on this platform, too.
-isPathSeparator :: Char -> Bool
-isPathSeparator ch = ch == pathSeparator || ch == '/'
-
--- | Provides a platform-specific character used to separate directory levels in
--- a path string that reflects a hierarchical file system organization. The
--- separator is a slash (@\"\/\"@) on Unix and Macintosh, and a backslash
--- (@\"\\\"@) on the Windows operating system.
-pathSeparator :: Char
-#ifdef mingw32_HOST_OS
-pathSeparator = '\\'
-#else
-pathSeparator = '/'
-#endif
-
--- | The function splits the given string to substrings
--- using the 'searchPathSeparator'.
-parseSearchPath :: String -> [FilePath]
-parseSearchPath path = split path
-  where
-    split :: String -> [String]
-    split s =
-      case rest' of
-        []     -> [chunk] 
-        _:rest -> chunk : split rest
-      where
-        chunk = 
-          case chunk' of
-#ifdef mingw32_HOST_OS
-            ('\"':xs@(_:_)) | last xs == '\"' -> init xs
-#endif
-            _                                 -> chunk'
-
-        (chunk', rest') = break (==searchPathSeparator) s
-
--- | A platform-specific character used to separate search path strings in 
--- environment variables. The separator is a colon (\":\") on Unix and Macintosh, 
--- and a semicolon (\";\") on the Windows operating system.
-searchPathSeparator :: Char
-#if mingw32_HOST_OS || mingw32_TARGET_OS
-searchPathSeparator = ';'
-#else
-searchPathSeparator = ':'
-#endif
-
diff --git a/ghc/utils/ghc-pkg/Makefile b/ghc/utils/ghc-pkg/Makefile
deleted file mode 100644
index d513a91b1c..0000000000
--- a/ghc/utils/ghc-pkg/Makefile
+++ /dev/null
@@ -1,113 +0,0 @@
-# -----------------------------------------------------------------------------
-
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-# hack for ghci-inplace script, see below
-INSTALLING=1
-
-# -----------------------------------------------------------------------------
-# ghc-pkg.bin
-
-SRC_HC_OPTS += -cpp -Wall -fno-warn-name-shadowing -fno-warn-unused-matches
-
-# This causes libghccompat.a to be used:
-include $(GHC_LIB_COMPAT_DIR)/compat.mk
-
-# This is required because libghccompat.a must be built with
-# $(GhcHcOpts) because it is linked to the compiler, and hence
-# we must also build with $(GhcHcOpts) here:
-SRC_HC_OPTS += $(GhcHcOpts)
-
-ifeq "$(ghc_ge_504)" "NO"
-SRC_HC_OPTS +=  -package lang -package util -package text
-endif
-
-# On Windows, ghc-pkg is a standalone program
-# ($bindir/ghc-pkg.exe), whereas on Unix it needs a wrapper script
-# to pass the appropriate flag to the real binary
-# ($libexecdir/ghc-pkg.bin) so that it can find package.conf.
-ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-HS_PROG           = ghc-pkg.exe
-INSTALL_PROGS    += $(HS_PROG)
-else
-HS_PROG           = ghc-pkg.bin
-INSTALL_LIBEXECS += $(HS_PROG)
-endif
-
-# -----------------------------------------------------------------------------=
-# Create the Version.hs file
-
-VERSION_HS = Version.hs
-EXTRA_SRCS += $(VERSION_HS)
-
-boot :: $(VERSION_HS)
-
-Version.hs : Makefile $(TOP)/mk/version.mk
-	@$(RM) -f $(VERSION_HS)
-	@echo "Creating $(VERSION_HS) ... "
-	@echo "module Version where" >>$(VERSION_HS)
-	@echo "version, targetOS, targetARCH :: String" >>$(VERSION_HS)
-	@echo "version    = \"$(ProjectVersion)\"" >> $(VERSION_HS)
-	@echo "targetOS   = \"$(TargetOS_CPP)\"" >> $(VERSION_HS)
-	@echo "targetARCH = \"$(TargetArch_CPP)\"" >> $(VERSION_HS)
-
-DIST_CLEAN_FILES += $(VERSION_HS)
-
-# -----------------------------------------------------------------------------
-# ghc-pkg script
-
-ifeq "$(INSTALLING)" "1"
-ifeq "$(BIN_DIST)"   "1"
-GHCPKGBIN=$$\"\"libexecdir/$(HS_PROG)
-PKGCONF=$$\"\"libdir/package.conf
-else
-GHCPKGBIN=$(libexecdir)/$(HS_PROG)
-PKGCONF=$(libdir)/package.conf
-endif # BIN_DIST
-else
-GHCPKGBIN=$(FPTOOLS_TOP_ABS)/ghc/utils/ghc-pkg/$(HS_PROG)
-PKGCONF=$(FPTOOLS_TOP_ABS_PLATFORM)/ghc/driver/package.conf.inplace
-endif
-
-ifneq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-INSTALLED_SCRIPT_PROG  = ghc-pkg-$(ProjectVersion)
-endif
-INPLACE_SCRIPT_PROG    = ghc-pkg-inplace
-
-SCRIPT_OBJS	  = ghc-pkg.sh
-INTERP		  = $(SHELL)
-SCRIPT_SUBST_VARS = GHCPKGBIN PKGCONFOPT
-ifneq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-INSTALL_SCRIPTS  += $(SCRIPT_PROG)
-endif
-PKGCONFOPT 	  = --global-conf $(PKGCONF)
-
-ifeq "$(INSTALLING)" "1"
-SCRIPT_PROG 	=  $(INSTALLED_SCRIPT_PROG)
-ifneq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-LINK 		=  ghc-pkg
-endif
-else
-SCRIPT_PROG 	=  $(INPLACE_SCRIPT_PROG)
-endif
-
-# -----------------------------------------------------------------------------
-# don't recurse on 'make install'
-#
-ifeq "$(INSTALLING)" "1"
-all :: $(HS_PROG)
-	$(MAKE) INSTALLING=0 BIN_DIST=0 $(MFLAGS) $@
-clean distclean maintainer-clean ::
-	$(MAKE) INSTALLING=0 BIN_DIST=0 $(MFLAGS) $@
-endif
-
-# ghc-pkg is needed to boot in ghc/rts and library dirs
-# Do a recursive 'make all' after generating dependencies, because this
-# will work with 'make -j'.
-ifneq "$(BootingFromHc)" "YES"
-boot :: depend
-	$(MAKE) all
-endif
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/ghc-pkg/ghc-pkg.sh b/ghc/utils/ghc-pkg/ghc-pkg.sh
deleted file mode 100644
index d482fc094e..0000000000
--- a/ghc/utils/ghc-pkg/ghc-pkg.sh
+++ /dev/null
@@ -1,2 +0,0 @@
-# Mini-driver for ghc-pkg
-exec $GHCPKGBIN $PKGCONFOPT ${1+"$@"}
diff --git a/ghc/utils/hasktags/HaskTags.hs b/ghc/utils/hasktags/HaskTags.hs
deleted file mode 100644
index f1840332d2..0000000000
--- a/ghc/utils/hasktags/HaskTags.hs
+++ /dev/null
@@ -1,232 +0,0 @@
-module Main where
-import System
-import Char
-import List
-import IO
-import System.Environment
-import System.Console.GetOpt
-import System.Exit
-
-
--- search for definitions of things 
--- we do this by looking for the following patterns:
--- data XXX = ...      giving a datatype location
--- newtype XXX = ...   giving a newtype location
--- bla :: ...          giving a function location
---
--- by doing it this way, we avoid picking up local definitions
--- 		(whether this is good or not is a matter for debate)
---
-
--- We generate both CTAGS and ETAGS format tags files
--- The former is for use in most sensible editors, while EMACS uses ETAGS
-
-
-main :: IO ()
-main = do
-        progName <- getProgName
-	args <- getArgs
-        let usageString = "Usage: " ++ progName ++ " [OPTION...] [files...]"
-	let (modes, filenames, errs) = getOpt Permute options args
-	if errs /= [] || elem Help modes || filenames == []
-         then do
-           putStr $ unlines errs 
-	   putStr $ usageInfo usageString options
-	   exitWith (ExitFailure 1)
-         else return ()
-	let mode = getMode modes
-	filedata <- mapM findthings filenames
-        if mode == BothTags || mode == CTags
-         then do 
-           ctagsfile <- openFile "tags" WriteMode
-	   writectagsfile ctagsfile filedata
-           hClose ctagsfile
-         else return ()
-	if mode == BothTags || mode == ETags 
-         then do
-           etagsfile <- openFile "TAGS" WriteMode
-	   writeetagsfile etagsfile filedata
-           hClose etagsfile
-         else return ()
-
--- | getMode takes a list of modes and extract the mode with the
---   highest precedence.  These are as follows: Both, CTags, ETags
---   The default case is Both.
-getMode :: [Mode] -> Mode
-getMode [] = BothTags
-getMode [x] = x
-getMode (x:xs) = max x (getMode xs)
-
-
-data Mode = ETags | CTags | BothTags | Help deriving (Ord, Eq, Show)
-
-options :: [OptDescr Mode]
-options = [ Option "c" ["ctags"]
-	    (NoArg CTags) "generate CTAGS file (ctags)"
-	  , Option "e" ["etags"]
-	    (NoArg ETags) "generate ETAGS file (etags)"
-	  , Option "b" ["both"]
-	    (NoArg BothTags) ("generate both CTAGS and ETAGS")
-	  , Option "h" ["help"] (NoArg Help) "This help"
-	  ]
-
-type FileName = String
-
-type ThingName = String
-
--- The position of a token or definition
-data Pos = Pos 
-		FileName 	-- file name
-		Int			-- line number 
-		Int     	-- token number
-		String 		-- string that makes up that line
-	deriving Show
-
--- A definition we have found
-data FoundThing = FoundThing ThingName Pos
-	deriving Show
-
--- Data we have obtained from a file
-data FileData = FileData FileName [FoundThing]
-
-data Token = Token String Pos
-	deriving Show
-
-
--- stuff for dealing with ctags output format
-
-writectagsfile :: Handle -> [FileData] -> IO ()
-writectagsfile ctagsfile filedata = do
-	let things = concat $ map getfoundthings filedata
-	mapM_ (\x -> hPutStrLn ctagsfile $ dumpthing x) things
-
-getfoundthings :: FileData -> [FoundThing]
-getfoundthings (FileData filename things) = things
-
-dumpthing :: FoundThing -> String
-dumpthing (FoundThing name (Pos filename line _ _)) = 
-	name ++ "\t" ++ filename ++ "\t" ++ (show $ line + 1)
-
-
--- stuff for dealing with etags output format
-
-writeetagsfile :: Handle -> [FileData] -> IO ()
-writeetagsfile etagsfile filedata = do
-	mapM_ (\x -> hPutStr etagsfile $ e_dumpfiledata x) filedata
-
-e_dumpfiledata :: FileData -> String
-e_dumpfiledata (FileData filename things) = 
-	"\x0c\n" ++ filename ++ "," ++ (show thingslength) ++ "\n" ++ thingsdump
-	where 
-		thingsdump = concat $ map e_dumpthing things 
-		thingslength = length thingsdump
-
-e_dumpthing :: FoundThing -> String
-e_dumpthing (FoundThing name (Pos filename line token fullline)) =
-	(concat $ take (token + 1) $ spacedwords fullline) 
-	++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
-	
-	
--- like "words", but keeping the whitespace, and so letting us build
--- accurate prefixes	
-	
-spacedwords :: String -> [String]
-spacedwords [] = []
-spacedwords xs = (blanks ++ wordchars):(spacedwords rest2)
-	where 
-		(blanks,rest) = span Char.isSpace xs
-		(wordchars,rest2) = span (\x -> not $ Char.isSpace x) rest
-	
-	
--- Find the definitions in a file	
-	
-findthings :: FileName -> IO FileData
-findthings filename = do
-	text <- readFile filename
-        evaluate text -- forces evaluation of text
-                      -- too many files were being opened otherwise since
-                      -- readFile is lazy
-	let aslines = lines text
-	let wordlines = map words aslines
-	let noslcoms = map stripslcomments wordlines
-	let tokens = concat $ zipWith3 (withline filename) noslcoms 
-					aslines [0 ..]
-	let nocoms = stripblockcomments tokens
-	return $ FileData filename $ findstuff nocoms
-  where evaluate [] = return ()
-        evaluate (c:cs) = c `seq` evaluate cs
-	
--- Create tokens from words, by recording their line number
--- and which token they are through that line
-
-withline :: FileName -> [String] -> String -> Int -> [Token]		
-withline filename words fullline i = 
-	zipWith (\w t -> Token w (Pos filename i t fullline)) words $ [0 ..]
-
--- comments stripping
-
-stripslcomments :: [String] -> [String]
-stripslcomments ("--":xs) = []
-stripslcomments (x:xs) = x : stripslcomments xs 
-stripslcomments [] = []
-
-stripblockcomments :: [Token] -> [Token]
-stripblockcomments ((Token "\\end{code}" _):xs) = afterlitend xs
-stripblockcomments ((Token "{-" _):xs) = afterblockcomend xs
-stripblockcomments (x:xs) = x:stripblockcomments xs
-stripblockcomments [] = []
-
-afterlitend2 :: [Token] -> [Token]
-afterlitend2 (x:xs) = afterlitend xs
-afterlitend2 [] = []
-
-afterlitend :: [Token] -> [Token]
-afterlitend ((Token "\\begin{code}" _):xs) = xs
-afterlitend (x:xs) = afterlitend xs
-afterlitend [] = []
-
-afterblockcomend :: [Token] -> [Token]
-afterblockcomend ((Token token _):xs) | contains "-}" token = xs
-						| otherwise = afterblockcomend xs
-afterblockcomend [] = []
-
-
--- does one string contain another string
-
-contains :: Eq a => [a] -> [a] -> Bool
-contains sub full = any (isPrefixOf sub) $ tails full 
-
-ints :: Int -> [Int]
-ints i = i:(ints $ i+1)
-
-
--- actually pick up definitions
-
-findstuff :: [Token] -> [FoundThing]
-findstuff ((Token "data" _):(Token name pos):xs) = 
-	FoundThing name pos : (getcons xs) ++ (findstuff xs)
-findstuff ((Token "newtype" _):(Token name pos):xs) = 
-	FoundThing name pos : findstuff xs
-findstuff ((Token "type" _):(Token name pos):xs) = 
-	FoundThing name pos : findstuff xs
-findstuff ((Token name pos):(Token "::" _):xs) = 
-	FoundThing name pos : findstuff xs
-findstuff (x:xs) = findstuff xs
-findstuff [] = []
-
-
--- get the constructor definitions, knowing that a datatype has just started
-
-getcons :: [Token] -> [FoundThing]
-getcons ((Token "=" _):(Token name pos):xs) = 
-	FoundThing name pos : getcons2 xs
-getcons (x:xs) = getcons xs
-getcons [] = []
-
-
-getcons2 ((Token "=" _):xs) = []
-getcons2 ((Token "|" _):(Token name pos):xs) = 
-	FoundThing name pos : getcons2 xs
-getcons2 (x:xs) = getcons2 xs
-getcons2 [] = []
-
diff --git a/ghc/utils/hasktags/Makefile b/ghc/utils/hasktags/Makefile
deleted file mode 100644
index 59a03d8abd..0000000000
--- a/ghc/utils/hasktags/Makefile
+++ /dev/null
@@ -1,14 +0,0 @@
-
-TOP=../..
-
-include $(TOP)/mk/boilerplate.mk
-
-CURRENT_DIR=ghc/utils/hasktags
-
-HS_PROG = hasktags
-
-CLEAN_FILES += Main.hi
-
-INSTALL_PROGS += $(HS_PROG)
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/hasktags/README b/ghc/utils/hasktags/README
deleted file mode 100644
index 77bac8881a..0000000000
--- a/ghc/utils/hasktags/README
+++ /dev/null
@@ -1,33 +0,0 @@
-
-"hasktags" is a very simple Haskell program that produces ctags "tags" and etags "TAGS" files for Haskell programs.
-
-As such, it does essentially the same job that hstags and fptags used to do, but, both of those seem to no longer be maintained, and it seemed to be easier to write my own version rather than to get one of them to work.
-
-Example usage:
-
-find -name \*.\*hs | xargs hasktags
-
-
-This will create "tags" and "TAGS" files in the current directory describing all Haskell files in the current directory or below.
-
-
-
-Features
-	* Includes top level functions, provided a type signature is given
-	* Includes data declarations, and constructors
-	* Includes newtypes
-	
-	- But sometimes gets things wrong or misses things out
-		It's only a simple program
-		
-		
-Using with your editor:
-
-With NEdit
-	Load the "tags" file using File/Load Tags File.
-	Use "Ctrl-D" to search for a tag.
-
-With XEmacs/Emacs
-	Load the "TAGS" file using "visit-tags-table"
-	Use "M-." to search for a tag.
-	
diff --git a/ghc/utils/heap-view/Graph.lhs b/ghc/utils/heap-view/Graph.lhs
deleted file mode 100644
index b8e08dbb9b..0000000000
--- a/ghc/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/ghc/utils/heap-view/HaskXLib.c b/ghc/utils/heap-view/HaskXLib.c
deleted file mode 100644
index b6cf1f137c..0000000000
--- a/ghc/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/ghc/utils/heap-view/HpView.lhs b/ghc/utils/heap-view/HpView.lhs
deleted file mode 100644
index a7b4cbb78e..0000000000
--- a/ghc/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/ghc/utils/heap-view/HpView2.lhs b/ghc/utils/heap-view/HpView2.lhs
deleted file mode 100644
index fa8044b8b4..0000000000
--- a/ghc/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/ghc/utils/heap-view/MAIL b/ghc/utils/heap-view/MAIL
deleted file mode 100644
index 966fcdcfc7..0000000000
--- a/ghc/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/ghc/utils/heap-view/Makefile b/ghc/utils/heap-view/Makefile
deleted file mode 100644
index 2d8a819df3..0000000000
--- a/ghc/utils/heap-view/Makefile
+++ /dev/null
@@ -1,36 +0,0 @@
-#---------------------------------------------------------------------
-# $Id: Makefile,v 1.3 1997/03/13 09:36:28 sof Exp $
-#
-#---------------------------------------------------------------------
-
-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/ghc/utils/heap-view/Makefile.original b/ghc/utils/heap-view/Makefile.original
deleted file mode 100644
index 1e35bc2e43..0000000000
--- a/ghc/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/ghc/utils/heap-view/Parse.lhs b/ghc/utils/heap-view/Parse.lhs
deleted file mode 100644
index 9d7652fdcc..0000000000
--- a/ghc/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/ghc/utils/heap-view/README b/ghc/utils/heap-view/README
deleted file mode 100644
index db9503abc4..0000000000
--- a/ghc/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/ghc/utils/heap-view/common-bits b/ghc/utils/heap-view/common-bits
deleted file mode 100644
index f41223b7f4..0000000000
--- a/ghc/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 ()
diff --git a/ghc/utils/hp2ps/AreaBelow.c b/ghc/utils/hp2ps/AreaBelow.c
deleted file mode 100644
index ec80e1ed48..0000000000
--- a/ghc/utils/hp2ps/AreaBelow.c
+++ /dev/null
@@ -1,62 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include "Defines.h"
-#include "Error.h"
-#include "HpFile.h"
-#include "Utilities.h"
-
-/* own stuff */
-#include "AreaBelow.h"
-
-/*
- *      Return the area enclosed by all of the curves. The algorithm
- *	used is the same as the trapizoidal rule for integration. 
- */
- 
-floatish
-AreaBelow()
-{
-    intish i;
-    intish j;
-    intish bucket;
-    floatish value;
-    struct chunk *ch;
-    floatish area;
-    floatish trap;
-    floatish base;
-    floatish *maxima;
-
-    maxima = (floatish *) xmalloc(nsamples * sizeof(floatish));
-    for (i = 0; i < nsamples; i++) {
-        maxima[i] = 0.0;
-    }   
-
-    for (i = 0; i < nidents; i++) {
-        for (ch = identtable[i]->chk; ch; ch = ch->next) {
-            for (j = 0; j < ch->nd; j++) {
-                bucket = ch->d[j].bucket;
-                value  = ch->d[j].value;
-		if (bucket >= nsamples)
-		    Disaster("bucket out of range");
-                maxima[ bucket ] += value;
-            }   
-        }    
-    }    
-
-    area = 0.0;
-
-    for (i = 1; i < nsamples; i++) {
-	base = samplemap[i] - samplemap[i-1];
-        if (maxima[i] > maxima[i-1]) {
-	    trap = base * maxima[i-1] + ((base * (maxima[i] - maxima[i-1]))/ 2.0);
-	} else {
-	    trap = base * maxima[i]   + ((base * (maxima[i-1] - maxima[i]))/ 2.0);
-        }
-
-	area += trap;
-    }
-
-    free(maxima);
-    return area;
-}
diff --git a/ghc/utils/hp2ps/AreaBelow.h b/ghc/utils/hp2ps/AreaBelow.h
deleted file mode 100644
index d7f713f2b4..0000000000
--- a/ghc/utils/hp2ps/AreaBelow.h
+++ /dev/null
@@ -1,6 +0,0 @@
-#ifndef AREA_BELOW_H
-#define AREA_BELOW_H
-
-floatish AreaBelow PROTO((void));
-
-#endif /* AREA_BELOW_H */
diff --git a/ghc/utils/hp2ps/AuxFile.c b/ghc/utils/hp2ps/AuxFile.c
deleted file mode 100644
index 9998d3fc13..0000000000
--- a/ghc/utils/hp2ps/AuxFile.c
+++ /dev/null
@@ -1,168 +0,0 @@
-#include "Main.h"
-#include <ctype.h>
-#include <stdio.h>
-#include <string.h>
-#include "Defines.h"
-#include "Shade.h"
-#include "Error.h"
-#include "HpFile.h"
-#include "Reorder.h"
-
-/* own stuff */
-#include "AuxFile.h"
-
-static void GetAuxLine PROTO((FILE *));	/* forward */
-static void GetAuxTok  PROTO((FILE *));	/* forward */
-
-void
-GetAuxFile(auxfp)
-  FILE* auxfp;
-{
-    ch = ' ';
-    endfile = 0;
-    linenum = 1;
- 
-    GetAuxTok(auxfp);
- 
-    while (endfile == 0) {
-        GetAuxLine(auxfp);
-    }
-
-    fclose(auxfp);
-}
-
-
-
-/*
- *      Read the next line from the aux file, check the syntax, and 
- *	perform the appropriate action.
- */
-
-static void
-GetAuxLine(auxfp)
-  FILE* auxfp;
-{
-    switch (thetok) {
-    case X_RANGE_TOK:
-	GetAuxTok(auxfp);
-	if (thetok != FLOAT_TOK) {
-	    Error("%s, line %d, floating point number must follow X_RANGE", 
-                  auxfile, linenum);
-	}
-	auxxrange = thefloatish;
-        GetAuxTok(auxfp);
-	break;
-    case Y_RANGE_TOK:
-	GetAuxTok(auxfp);
-	if (thetok != FLOAT_TOK) {
-	    Error("%s, line %d, floating point number must follow Y_RANGE", 
-                  auxfile, linenum);
-	}
-	auxyrange = thefloatish;
-        GetAuxTok(auxfp);
-	break;
-    case ORDER_TOK:
-	GetAuxTok(auxfp);
-	if (thetok != IDENTIFIER_TOK) {
-            Error("%s, line %d: identifier must follow ORDER",
-                  auxfile, linenum);
-        }
-	GetAuxTok(auxfp);
-        if (thetok != INTEGER_TOK) {
-            Error("%s, line %d: identifier and integer must follow ORDER",
-                  auxfile, linenum);
-        }
-	OrderFor(theident, theinteger);
-	GetAuxTok(auxfp);
-        break;
-    case SHADE_TOK:
-	GetAuxTok(auxfp);
-	if (thetok != IDENTIFIER_TOK) {
-	    Error("%s, line %d: identifier must follow SHADE", 
-                  auxfile, linenum);
-	}
-	GetAuxTok(auxfp);
-	if (thetok != FLOAT_TOK) {
-	    Error("%s, line %d: identifier and floating point number must follow SHADE",
-	          auxfile, linenum);
-	}
-        ShadeFor(theident, thefloatish);
-	GetAuxTok(auxfp); 
-        break;
-    case EOF_TOK:
-        endfile = 1;
-	break;
-    default:
-	Error("%s, line %d: %s unexpected", auxfile, linenum,
-	      TokenToString(thetok));
-	break;
-    }
-}
-
-
-
-/*
- *      Read the next token from the input and assign its value
- *      to the global variable "thetok". In the case of numbers,
- *      the corresponding value is also assigned to "thefloatish"; 
- * 	in the case of identifiers it is assigned to "theident".
- */
- 
-static void GetAuxTok(auxfp)
-FILE* auxfp;
-{
-
-    while (isspace(ch)) {               /* skip whitespace */
-        if (ch == '\n') linenum++;
-        ch = getc(auxfp);
-    } 
-
-    if (ch == EOF) {
-        thetok = EOF_TOK;
-        return;
-    }
-
-    if (isdigit(ch)) {
-        thetok = GetNumber(auxfp);
-        return;
-    } else if (IsIdChar(ch)) {          /* ch can't be a digit here */
-        GetIdent(auxfp);
-	if (!isupper((int)theident[0])) {
-            thetok = IDENTIFIER_TOK;
-        } else if (strcmp(theident, "X_RANGE") == 0) {
-            thetok = X_RANGE_TOK;
-        } else if (strcmp(theident, "Y_RANGE") == 0) {
-            thetok = Y_RANGE_TOK;
-        } else if (strcmp(theident, "ORDER") == 0) {
-            thetok = ORDER_TOK;
-        } else if (strcmp(theident, "SHADE") == 0) {
-            thetok = SHADE_TOK;
-        } else {
-            thetok = IDENTIFIER_TOK;
-        }
-        return;
-    } else {
-        Error("%s, line %d: strange character (%c)", auxfile, linenum, ch);
-    }
-}
-
-void
-PutAuxFile(auxfp)
-  FILE* auxfp;
-{
-    int i;
-
-    fprintf(auxfp, "X_RANGE %.2f\n", xrange);
-    fprintf(auxfp, "Y_RANGE %.2f\n", yrange);
-
-    for (i = 0; i < nidents; i++) {
-        fprintf(auxfp, "ORDER %s %d\n", identtable[i]->name, i+1);
-    }
-
-    for (i = 0; i < nidents; i++) {
-        fprintf(auxfp, "SHADE %s %.2f\n", identtable[i]->name, 
-                       ShadeOf(identtable[i]->name));
-    }
-
-    fclose(auxfp);
-}
diff --git a/ghc/utils/hp2ps/AuxFile.h b/ghc/utils/hp2ps/AuxFile.h
deleted file mode 100644
index 6e962c492e..0000000000
--- a/ghc/utils/hp2ps/AuxFile.h
+++ /dev/null
@@ -1,7 +0,0 @@
-#ifndef AUX_FILE_H
-#define AUX_FILE_H
-
-void PutAuxFile PROTO((FILE *));
-void GetAuxFile PROTO((FILE *));
-
-#endif /* AUX_FILE_H */
diff --git a/ghc/utils/hp2ps/Axes.c b/ghc/utils/hp2ps/Axes.c
deleted file mode 100644
index a2641cd676..0000000000
--- a/ghc/utils/hp2ps/Axes.c
+++ /dev/null
@@ -1,241 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <string.h>
-#include "Curves.h"
-#include "Defines.h"
-#include "Dimensions.h"
-#include "HpFile.h"
-#include "Utilities.h"
-
-/* own stuff */
-#include "Axes.h"
-
-typedef enum {MEGABYTE, KILOBYTE, BYTE} mkb; 
-
-static void XAxis PROTO((void)); /* forward */
-static void YAxis PROTO((void)); /* forward */
-
-static void XAxisMark PROTO((floatish, floatish));      /* forward */
-static void YAxisMark PROTO((floatish, floatish, mkb)); /* forward */
-
-static floatish Round PROTO((floatish)); /* forward */
-
-void
-Axes()
-{
-    XAxis();
-    YAxis();
-}
-
-static void
-XAxisMark(x, num)
-  floatish x; floatish num;
-{
-    /* calibration mark */
-    fprintf(psfp, "%f %f moveto\n", xpage(x), ypage(0.0));
-    fprintf(psfp, "0 -4 rlineto\n");
-    fprintf(psfp, "stroke\n");
-
-    /* number */
-    fprintf(psfp, "HE%d setfont\n", NORMAL_FONT);
-    fprintf(psfp, "(%.1f)\n", num);
-    fprintf(psfp, "dup stringwidth pop\n");
-    fprintf(psfp, "2 div\n");
-    fprintf(psfp, "%f exch sub\n", xpage(x));
-    fprintf(psfp, "%f moveto\n", borderspace);
-    fprintf(psfp, "show\n");
-}
-
-
-#define N_X_MARKS   	 7
-#define XFUDGE   	15	
-
-extern floatish xrange;
-extern char *sampleunitstring;
-
-static void
-XAxis()
-{
-    floatish increment, i; 
-    floatish t, x;
-    floatish legendlen;
- 
-    /* draw the x axis line */
-    fprintf(psfp, "%f %f moveto\n", xpage(0.0), ypage(0.0));
-    fprintf(psfp, "%f 0 rlineto\n", graphwidth);
-    fprintf(psfp, "%f setlinewidth\n", borderthick);
-    fprintf(psfp, "stroke\n"); 
-
-    /* draw x axis legend */
-    fprintf(psfp, "HE%d setfont\n", NORMAL_FONT);
-    fprintf(psfp, "(%s)\n", sampleunitstring);
-    fprintf(psfp, "dup stringwidth pop\n");
-    fprintf(psfp, "%f\n", xpage(0.0) + graphwidth);
-    fprintf(psfp, "exch sub\n");
-    fprintf(psfp, "%f moveto\n", borderspace);
-    fprintf(psfp, "show\n");
-
-
-    /* draw x axis scaling */
-
-    increment = Round(xrange / (floatish) N_X_MARKS);
-
-    t = graphwidth / xrange;
-    legendlen = StringSize(sampleunitstring) + (floatish) XFUDGE;
- 
-    for (i = samplemap[0]; i < samplemap[nsamples - 1]; i += increment) {
-        x = (i - samplemap[0]) * t;  
- 
-        if (x < (graphwidth - legendlen)) { 
-            XAxisMark(x,i);
-        } 
-    } 
-}
-
-static void
-YAxisMark(y, num, unit)
-  floatish y; floatish num; mkb unit;
-{
-    /* calibration mark */
-    fprintf(psfp, "%f %f moveto\n", xpage(0.0), ypage(y));
-    fprintf(psfp, "-4 0 rlineto\n");
-    fprintf(psfp, "stroke\n");
- 
-    /* number */
-    fprintf(psfp, "HE%d setfont\n", NORMAL_FONT);
-
-    switch (unit) {
-    case MEGABYTE :
-	fprintf(psfp, "(");
-	CommaPrint(psfp, (intish) (num / 1e6 + 0.5));
-	fprintf(psfp, "M)\n");
-	break;
-    case KILOBYTE :
-	fprintf(psfp, "(");
-	CommaPrint(psfp, (intish) (num / 1e3 + 0.5));
-	fprintf(psfp, "k)\n");
-	break;
-    case BYTE:
-	fprintf(psfp, "(");
-	CommaPrint(psfp, (intish) (num + 0.5));
-	fprintf(psfp, ")\n");
-	break;
-    }
-
-    fprintf(psfp, "dup stringwidth\n");
-    fprintf(psfp, "2 div\n");
-    fprintf(psfp, "%f exch sub\n", ypage(y));
-
-    fprintf(psfp, "exch\n");
-    fprintf(psfp, "%f exch sub\n", graphx0 - borderspace);
-
-    fprintf(psfp, "exch\n");
-    fprintf(psfp, "moveto\n");
-    fprintf(psfp, "show\n");
-}
-
-#define N_Y_MARKS 	 7	
-#define YFUDGE 		15 
-
-extern floatish yrange;
-extern char *valueunitstring;
-
-static void
-YAxis()
-{
-    floatish increment, i;
-    floatish t, y;
-    floatish legendlen;
-    mkb unit;
-
-    /* draw the y axis line */
-    fprintf(psfp, "%f %f moveto\n", xpage(0.0), ypage(0.0));
-    fprintf(psfp, "0 %f rlineto\n", graphheight);
-    fprintf(psfp, "%f setlinewidth\n", borderthick);
-    fprintf(psfp, "stroke\n");
-
-    /* draw y axis legend */
-    fprintf(psfp, "gsave\n");
-    fprintf(psfp, "HE%d setfont\n", NORMAL_FONT);
-    fprintf(psfp, "(%s)\n", valueunitstring);
-    fprintf(psfp, "dup stringwidth pop\n");
-    fprintf(psfp, "%f\n", ypage(0.0) + graphheight);
-    fprintf(psfp, "exch sub\n");
-    fprintf(psfp, "%f exch\n", xpage(0.0) - borderspace);
-    fprintf(psfp, "translate\n");
-    fprintf(psfp, "90 rotate\n");
-    fprintf(psfp, "0 0 moveto\n");
-    fprintf(psfp, "show\n");
-    fprintf(psfp, "grestore\n");
-
-    /* draw y axis scaling */
-    increment = max( yrange / (floatish) N_Y_MARKS, 1.0);
-    increment = Round(increment);
-
-    if (increment >= 1e6) {
-	unit = MEGABYTE;
-    } else if (increment >= 1e3) {
-	unit = KILOBYTE;
-    } else {
-	unit = BYTE;
-    }	
-
-    t = graphheight / yrange; 
-    legendlen = StringSize(valueunitstring) + (floatish) YFUDGE; 
-
-    for (i = 0.0; i <= yrange; i += increment) {
-        y = i * t;
-
-        if (y < (graphheight - legendlen)) {
-            YAxisMark(y, i, unit);
-        }
-    } 
-}
-
-
-/*
- *      Find a "nice round" value to use on the axis.
- */
-
-static floatish OneTwoFive PROTO((floatish)); /* forward */
-
-static floatish
-Round(y)
-  floatish y;
-{
-    int i;
-
-    if (y > 10.0) {
-	for (i = 0; y > 10.0; y /= 10.0, i++) ;
-	y = OneTwoFive(y);
-	for ( ; i > 0; y = y * 10.0, i--) ;
-
-    } else if (y < 1.0) {
-	for (i = 0; y < 1.0; y *= 10.0, i++) ;
-        y = OneTwoFive(y);
-        for ( ; i > 0; y = y / 10.0, i--) ;
- 
-    } else {
-	y = OneTwoFive(y);
-    }
-
-    return (y);
-}
-
-
-/*
- * OneTwoFive() -- Runciman's 1,2,5 scaling rule. Argument  1.0 <= y <= 10.0.
- */
-
-static floatish
-OneTwoFive(y)
-  floatish y;
-{
-    if (y > 4.0) {
-	return (5.0);
-    } else if (y > 1.0) {
-	return (2.0);
-    } else {
-	return (1.0);
-    }   
-}
diff --git a/ghc/utils/hp2ps/Axes.h b/ghc/utils/hp2ps/Axes.h
deleted file mode 100644
index e4be505dfb..0000000000
--- a/ghc/utils/hp2ps/Axes.h
+++ /dev/null
@@ -1,6 +0,0 @@
-#ifndef AXES_H
-#define AXES_H
-
-void Axes PROTO((void));
-
-#endif /* AXES_H */
diff --git a/ghc/utils/hp2ps/CHANGES b/ghc/utils/hp2ps/CHANGES
deleted file mode 100644
index db3b52e6d6..0000000000
--- a/ghc/utils/hp2ps/CHANGES
+++ /dev/null
@@ -1,37 +0,0 @@
-1.
-
-When generating PostScript to show strings, '(' and ')' may need to be escaped. 
-These characters are now escaped when the JOB string is shown.
-
-2.
-
-Manually deleting samples from a .hp file now does what you would expect.
-
-3.
-
-The -t flag for setting the threshold percentage has been scrapped. No one
-ever used it.
-
-4.
-
-Long JOB strings cause hp2ps to use a big title box. Big and small boxes
-can be forced with -b and -s flag. 
-
-5.
-
-MARKS now print as small triangles which remain below the x axis.
-
-6. 
-
-There is an updated manual page.
-
-7.
-
--m flag for setting maximum no of bands (default 20, cant be more than 20).
--t flag for setting threshold (between 0% and 5%, default 1%).
-
-8.
-
-Axes scaling rounding errors removed.
-
-
diff --git a/ghc/utils/hp2ps/Curves.c b/ghc/utils/hp2ps/Curves.c
deleted file mode 100644
index ec05c98336..0000000000
--- a/ghc/utils/hp2ps/Curves.c
+++ /dev/null
@@ -1,165 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <math.h>
-#include "Defines.h"
-#include "Dimensions.h"
-#include "HpFile.h"
-#include "Shade.h"
-#include "Utilities.h"
-
-/* own stuff */
-#include "Curves.h"
-
-static floatish *x;		/* x and y values  */
-static floatish *y;
-
-static floatish *py;		/* previous y values */
-
-static void Curve PROTO((struct entry *));	/* forward */
-static void ShadeCurve
-    PROTO((floatish *x, floatish *y, floatish *py, floatish shade));
-
-void
-Curves()
-{
-    intish i;
-
-    for (i = 0; i < nidents; i++) {
-        Curve(identtable[i]);
-    }
-}
-
-/*
- *      Draw a curve, and fill the area that is below it and above 
- *	the previous curve.
- */
-
-static void
-Curve(e)
-  struct entry* e;
-{
-    struct chunk* ch;
-    int j;
-  
-    for (ch = e->chk; ch; ch = ch->next) {
-        for (j = 0; j < ch->nd; j++) {
-	    y[ ch->d[j].bucket ] += ch->d[j].value;
-	}
-    }    
-
-    ShadeCurve(x, y, py, ShadeOf(e->name));
-}
-
-
-static void PlotCurveLeftToRight PROTO((floatish *, floatish *)); /* forward */
-static void PlotCurveRightToLeft PROTO((floatish *, floatish *)); /* forward */
-
-static void SaveCurve PROTO((floatish *, floatish *)); /* forward */
-
-/*
- *	Map virtual x coord to physical x coord 
- */
- 
-floatish
-xpage(x)
-  floatish x;
-{
-    return (x + graphx0); 
-}
-
-
-
-/*
- *	Map virtual y coord to physical y coord 
- */
- 
-floatish
-ypage(y)
-  floatish y;
-{
-    return (y + graphy0); 
-}
-
-
-/*
- *	Fill the region bounded by two splines, using the given 
- *	shade.
- */
-
-static void
-ShadeCurve(x, y, py, shade)
-  floatish *x; floatish *y; floatish *py; floatish shade;
-{
-    fprintf(psfp, "%f %f moveto\n", xpage(x[0]), ypage(py[0]));
-    PlotCurveLeftToRight(x, py);
-
-    fprintf(psfp, "%f %f lineto\n", xpage(x[nsamples - 1]), 
-                                    ypage(y[nsamples - 1]));
-    PlotCurveRightToLeft(x, y);
-
-    fprintf(psfp, "closepath\n");
-
-    fprintf(psfp, "gsave\n");
-
-    SetPSColour(shade);
-    fprintf(psfp, "fill\n");
-
-    fprintf(psfp, "grestore\n");
-    fprintf(psfp, "stroke\n");
-
-    SaveCurve(y, py);
-}
-
-static void
-PlotCurveLeftToRight(x,y)
-  floatish *x; floatish *y;
-{
-    intish i;
-
-    for (i = 0; i < nsamples; i++) {
-        fprintf(psfp, "%f %f lineto\n", xpage(x[i]), ypage(y[i]));
-    }
-}
-
-static void
-PlotCurveRightToLeft(x,y)
-  floatish *x; floatish *y;
-{
-    intish i;
-
-    for (i = nsamples - 1; i >= 0; i-- ) {
-        fprintf(psfp, "%f %f lineto\n", xpage(x[i]), ypage(y[i]));
-    }
-}
-
-/*
- *	Save the curve coordinates stored in y[] in py[].
- */
-
-static void
-SaveCurve(y, py)
-  floatish *y; floatish* py;
-{
-    intish i;
-
-    for (i = 0; i < nsamples; i++) {
-	py[i] = y[i];
-    }
-}
-
-extern floatish xrange;
-
-void
-CurvesInit()
-{
-    intish i;
-
-    x  =  (floatish*) xmalloc(nsamples * sizeof(floatish));
-    y  =  (floatish*) xmalloc(nsamples * sizeof(floatish));
-    py =  (floatish*) xmalloc(nsamples * sizeof(floatish));
-
-    for (i = 0; i < nsamples; i++) {
-        x[i] = ((samplemap[i] - samplemap[0])/ xrange) * graphwidth;
-        y[i] = py[i] = 0.0; 
-    }
-}
diff --git a/ghc/utils/hp2ps/Curves.h b/ghc/utils/hp2ps/Curves.h
deleted file mode 100644
index 0aa397f42c..0000000000
--- a/ghc/utils/hp2ps/Curves.h
+++ /dev/null
@@ -1,10 +0,0 @@
-#ifndef CURVES_H
-#define CURVES_H
-
-void Curves PROTO((void));
-void CurvesInit PROTO((void));
-
-floatish xpage PROTO((floatish));
-floatish ypage PROTO((floatish));
-
-#endif /* CURVES_H */
diff --git a/ghc/utils/hp2ps/Defines.h b/ghc/utils/hp2ps/Defines.h
deleted file mode 100644
index 8d38546fec..0000000000
--- a/ghc/utils/hp2ps/Defines.h
+++ /dev/null
@@ -1,61 +0,0 @@
-#ifndef DEFINES_H
-#define DEFINES_H
-
-/* 
- * Things that can be altered.
- */
-
-#define THRESHOLD_PERCENT _thresh_ /* all values below 1% insignificant      */
-#define DEFAULT_THRESHOLD      1.0
-extern floatish _thresh_;
-
-#define TWENTY 		  _twenty_ /* show top 20 bands, grouping excess     */
-#define DEFAULT_TWENTY		20 /* this is default and absolute maximum   */
-extern int _twenty_;
-
-#define LARGE_FONT	        12  /* Helvetica 12pt 			     */
-#define NORMAL_FONT		10  /* Helvetica 10pt 			     */
-
-#define BORDER_HEIGHT        432.0  /* page border box 432pt (6 inches high) */
-#define BORDER_WIDTH         648.0  /* page border box 648pt (9 inches wide) */
-#define BORDER_SPACE	       5.0  /* page border space 		     */
-#define BORDER_THICK           0.5  /* page border line thickness 0.5pt      */
-
-
-#define TITLE_HEIGHT	      20.0  /* title box is 20pt high		     */
-#define TITLE_TEXT_FONT LARGE_FONT  /* title in large font	             */
-#define TITLE_TEXT_SPACE       6.0  /* space between title text and box      */
-
-
-#define AXIS_THICK	       0.5  /* axis thickness 0.5pt                  */
-#define AXIS_TEXT_SPACE	 	 6  /* space between axis legends and axis   */
-#define AXIS_TEXT_FONT NORMAL_FONT  /* axis legends in normal font           */
-#define AXIS_Y_TEXT_SPACE       35  /* space for y axis text                 */ 
-
-#define KEY_BOX_WIDTH	        14  /* key boxes are 14pt high               */
-
-#define SMALL_JOB_STRING_WIDTH	35  /* small title for 35 characters or less */
-#define BIG_JOB_STRING_WIDTH    80  /* big title for everything else	     */	
-
-#define GRAPH_X0	(AXIS_Y_TEXT_SPACE + (2 * BORDER_SPACE)) 
-#define GRAPH_Y0	(AXIS_TEXT_FONT + (2 * BORDER_SPACE)) 
-
-
-/*
- * Things that should be left well alone.
- */
-
-
-
-#define START_X  72     /* start  72pt (1 inch)   from left   (portrait)  */
-#define START_Y 108     /* start 108pt (1.5 inch) from bottom (portrait)  */
-
-#define NUMBER_LENGTH            32
-
-#define N_CHUNK			 24 
-
-#define VERSION			"0.25"		/* as of 95/03/21	 */
-
-#define max(x,y) ((x) > (y) ? (x) : (y))	/* not everyone has this */
-
-#endif /* DEFINES_H */
diff --git a/ghc/utils/hp2ps/Deviation.c b/ghc/utils/hp2ps/Deviation.c
deleted file mode 100644
index ecf7faba16..0000000000
--- a/ghc/utils/hp2ps/Deviation.c
+++ /dev/null
@@ -1,139 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <math.h>
-#include "Defines.h"
-#include "Error.h"
-#include "HpFile.h"
-#include "Utilities.h"
-
-/* own stuff */
-#include "Deviation.h"
-
-/*
- *	Reorder the identifiers in the identifier table so that the
- *	ones whose data points exhibit the mininal standard deviation
- *	come first.	
- */
-
-void
-Deviation()
-{
-    intish i;
-    intish j;
-    floatish dev;
-    struct chunk* ch;
-    int min;
-    floatish t;
-    struct entry* e;
-    floatish *averages; 
-    floatish *deviations;
-
-    averages   = (floatish*) xmalloc(nidents * sizeof(floatish));
-    deviations = (floatish*) xmalloc(nidents * sizeof(floatish));
-
-    /* find averages */
-
-    for (i = 0; i < nidents; i++) {
-	averages[i] = 0.0;
-    }
- 
-    for (i = 0; i < nidents; i++) {
-        for (ch = identtable[i]->chk; ch; ch = ch->next) {
-	    for (j = 0; j < ch->nd; j++) {
-	        averages[i] += ch->d[j].value; 
-	    }
-        }
-    }    
-
-    for (i = 0; i < nidents; i++) {
-        averages[i] /= (floatish) nsamples;
-    }
-
-    /* calculate standard deviation */
-
-    for (i = 0; i < nidents; i++) {
-	deviations[i] = 0.0;
-    }
- 
-    for (i = 0; i < nidents; i++) {
-        for (ch = identtable[i]->chk; ch; ch = ch->next) {
-	    for (j = 0; j < ch->nd; j++) {
-		dev = ch->d[j].value - averages[i];
-	        deviations[i] += dev * dev; 
-	    }
-        }
-    }
-
-    for (i = 0; i < nidents; i++) {
-        deviations[i] = (floatish) sqrt ((doublish) (deviations[i] / 
-					 (floatish) (nsamples - 1)));
-    }
-
-
-    /* sort on basis of standard deviation */
-
-    for (i = 0; i < nidents-1; i++) {
-	min = i; 
-	for (j = i+1; j < nidents; j++) {
-	    if (deviations[ j ] < deviations[min]) {
-		min = j;
-	    }
-	}
-
-        t = deviations[min]; 
-	deviations[min] = deviations[i];	
-	deviations[i] = t;
-
-        e = identtable[min];
-	identtable[min] = identtable[i];
-	identtable[i] = e;
-    } 	
-
-    free(averages);
-    free(deviations);
-}
-
-void
-Identorder(iflag)
-    int iflag;	/* a funny three-way flag ? WDP 95/03 */
-{
-    int i;
-    int j;
-    int min;
-    struct entry* e;
-
-    /* sort on basis of ident string */
-    if (iflag > 0) {
-	/* greatest at top i.e. smallest at start */
-
-	for (i = 0; i < nidents-1; i++) {
-	    min = i; 
-	    for (j = i+1; j < nidents; j++) {
-		if (strcmp(identtable[j]->name, identtable[min]->name) < 0) {
-		    min = j;
-		}
-	    }
-
-	    e = identtable[min];
-	    identtable[min] = identtable[i];
-	    identtable[i] = e;
-	} 	
-    } else {
-	/* smallest at top i.e. greatest at start */
-
-	for (i = 0; i < nidents-1; i++) {
-	    min = i; 
-	    for (j = i+1; j < nidents; j++) {
-		if (strcmp(identtable[j]->name, identtable[min]->name) > 0) {
-		    min = j;
-		}
-	    }
-
-	    e = identtable[min];
-	    identtable[min] = identtable[i];
-	    identtable[i] = e;
-	} 	
-    }	
-}
diff --git a/ghc/utils/hp2ps/Deviation.h b/ghc/utils/hp2ps/Deviation.h
deleted file mode 100644
index 14e4df1ad0..0000000000
--- a/ghc/utils/hp2ps/Deviation.h
+++ /dev/null
@@ -1,7 +0,0 @@
-#ifndef DEVIATION_H
-#define DEVIATION_H
-
-void Deviation  PROTO((void));
-void Identorder PROTO((int));
-
-#endif /* DEVIATION_H */
diff --git a/ghc/utils/hp2ps/Dimensions.c b/ghc/utils/hp2ps/Dimensions.c
deleted file mode 100644
index e732402dac..0000000000
--- a/ghc/utils/hp2ps/Dimensions.c
+++ /dev/null
@@ -1,203 +0,0 @@
-#include "Main.h"
-#include <ctype.h>
-#include <string.h>
-#include <stdio.h>
-#include "Defines.h"
-#include "HpFile.h"
-#include "Scale.h"
-
-/* own stuff */
-#include "Dimensions.h"
-
-/*
- *	Get page and other dimensions before printing.
- */
-
-floatish borderheight   = BORDER_HEIGHT;
-floatish borderwidth    = BORDER_WIDTH;
-floatish borderspace    = BORDER_SPACE;
-floatish borderthick    = BORDER_THICK;
-
-floatish titlewidth     = (BORDER_WIDTH  - (2 * BORDER_SPACE)); 
-floatish titletextspace = TITLE_TEXT_SPACE;
-floatish titleheight; 
-
-floatish graphx0 = GRAPH_X0;
-floatish graphy0 = GRAPH_Y0;
-
-floatish graphheight;
-floatish graphwidth;
-
-static floatish KeyWidth PROTO((void)); /* forward */
-
-void
-Dimensions()
-{
-    xrange = samplemap[nsamples - 1] - samplemap[0];
-    xrange = max(xrange, auxxrange);
-    if (xrange == 0.0) xrange = 1.0;            /* avoid division by 0.0 */
- 
-    yrange = MaxCombinedHeight();
-    yrange = max(yrange, auxyrange);
-    if (yrange == 0.0) yrange = 1.0;            /* avoid division by 0.0 */
-
-    if (!bflag && !sflag) {
-	bflag = strlen(jobstring) > SMALL_JOB_STRING_WIDTH; 
-    }
-
-    if (bflag) {
-	titleheight = 2 * TITLE_HEIGHT;
-    } else {
-	titleheight = TITLE_HEIGHT;
-    } 
-
-    graphwidth  = titlewidth - graphx0 - (TWENTY ? KeyWidth() : 0);
-    graphheight = borderheight - titleheight - (2 * borderspace) - graphy0;
-}
-
-/*
- *	Calculate the width of the key.
- */
-
-static floatish
-KeyWidth()
-{
-    intish i;
-    floatish c;
-
-    c = 0.0;
-
-    for (i = 0; i < nidents; i++) {
-        c = max(c, StringSize(identtable[i]->name));
-    }
-
-    c += 3.0 * borderspace;
-
-    c += (floatish) KEY_BOX_WIDTH;
-
-    return c;
-}
-
-
-/*
- *	A desperately grim solution.
- */
-
-
-floatish fonttab[] = {
-    /*  20 (' ') = */ 3.0,
-    /*  21 ('!') = */ 1.0,
-    /*  22 ('"') = */ 1.0,
-    /*  23 ('#') = */ 3.0,
-    /*  24 ('$') = */ 3.0,
-    /*  25 ('%') = */ 3.0,
-    /*  26 ('&') = */ 3.0,
-    /*  27 (''') = */ 1.0,
-    /*  28 ('(') = */ 3.0,
-    /*  29 (')') = */ 3.0,
-    /*  2a ('*') = */ 2.0,
-    /*  2b ('+') = */ 3.0,
-    /*  2c (',') = */ 1.0,
-    /*  2d ('-') = */ 3.0,
-    /*  2e ('.') = */ 1.0,
-    /*  2f ('/') = */ 3.0,
-    /*  30 ('0') = */ 4.0,
-    /*  31 ('1') = */ 4.0,
-    /*  32 ('2') = */ 4.0,
-    /*  33 ('3') = */ 4.0,
-    /*  34 ('4') = */ 4.0,
-    /*  35 ('5') = */ 4.0,
-    /*  36 ('6') = */ 4.0,
-    /*  37 ('7') = */ 4.0,
-    /*  38 ('8') = */ 4.0,
-    /*  39 ('9') = */ 4.0,
-    /*  3a (':') = */ 1.0,
-    /*  3b (';') = */ 1.0,
-    /*  3c ('<') = */ 3.0,
-    /*  3d ('=') = */ 3.0,
-    /*  3e ('>') = */ 3.0,
-    /*  3f ('?') = */ 2.0,
-    /*  40 ('@') = */ 3.0,
-    /*  41 ('A') = */ 5.0,
-    /*  42 ('B') = */ 5.0,
-    /*  43 ('C') = */ 5.0,
-    /*  44 ('D') = */ 5.0,
-    /*  45 ('E') = */ 5.0,
-    /*  46 ('F') = */ 5.0,
-    /*  47 ('G') = */ 5.0,
-    /*  48 ('H') = */ 5.0,
-    /*  49 ('I') = */ 1.0,
-    /*  4a ('J') = */ 5.0,
-    /*  4b ('K') = */ 5.0,
-    /*  4c ('L') = */ 5.0,
-    /*  4d ('M') = */ 5.0,
-    /*  4e ('N') = */ 5.0,
-    /*  4f ('O') = */ 5.0,
-    /*  50 ('P') = */ 5.0,
-    /*  51 ('Q') = */ 5.0,
-    /*  52 ('R') = */ 5.0,
-    /*  53 ('S') = */ 5.0,
-    /*  54 ('T') = */ 5.0,
-    /*  55 ('U') = */ 5.0,
-    /*  56 ('V') = */ 5.0,
-    /*  57 ('W') = */ 5.0,
-    /*  58 ('X') = */ 5.0,
-    /*  59 ('Y') = */ 5.0,
-    /*  5a ('Z') = */ 5.0,
-    /*  5b ('[') = */ 2.0,
-    /*  5c ('\') = */ 3.0,
-    /*  5d (']') = */ 2.0,
-    /*  5e ('^') = */ 1.0,
-    /*  5f ('_') = */ 3.0,
-    /*  60 ('`') = */ 1.0,
-    /*  61 ('a') = */ 3.0,
-    /*  62 ('b') = */ 3.0,
-    /*  63 ('c') = */ 3.0,
-    /*  64 ('d') = */ 3.0,
-    /*  65 ('e') = */ 3.0,
-    /*  66 ('f') = */ 3.0,
-    /*  67 ('g') = */ 3.0,
-    /*  68 ('h') = */ 3.0,
-    /*  69 ('i') = */ 1.0,
-    /*  6a ('j') = */ 2.0,
-    /*  6b ('k') = */ 3.0,
-    /*  6c ('l') = */ 1.0,
-    /*  6d ('m') = */ 5.0,
-    /*  6e ('n') = */ 3.0,
-    /*  6f ('o') = */ 3.0,
-    /*  70 ('p') = */ 3.0,
-    /*  71 ('q') = */ 3.0,
-    /*  72 ('r') = */ 2.0,
-    /*  73 ('s') = */ 3.0,
-    /*  74 ('t') = */ 2.0,
-    /*  75 ('u') = */ 3.0,
-    /*  76 ('v') = */ 3.0,
-    /*  77 ('w') = */ 3.0,
-    /*  78 ('x') = */ 3.0,
-    /*  79 ('y') = */ 3.0,
-    /*  7a ('z') = */ 3.0,
-    /*  7b ('{') = */ 2.0,
-    /*  7c ('|') = */ 1.0,
-    /*  7d ('}') = */ 2.0,
-    /*  7e ('~') = */ 2.0
-};
-
-
-/*
- *	What size is a string (in points)?
- */
-
-#define FUDGE (2.834646 * 0.6)
-
-floatish
-StringSize(s)
-  char* s;
-{
-    floatish r;
-
-    for (r = 0.0; *s; s++) {
-	r += fonttab[(*s) - 0x20];
-    }
-
-    return r * FUDGE;
-}
diff --git a/ghc/utils/hp2ps/Dimensions.h b/ghc/utils/hp2ps/Dimensions.h
deleted file mode 100644
index 7bcc05beee..0000000000
--- a/ghc/utils/hp2ps/Dimensions.h
+++ /dev/null
@@ -1,22 +0,0 @@
-#ifndef DIMENSIONS_H
-#define DIMENSIONS_H
-
-extern floatish borderheight; 
-extern floatish borderwidth; 
-extern floatish borderspace;
-extern floatish borderthick;
-
-extern floatish titleheight;
-extern floatish titlewidth;
-extern floatish titletextspace;
-
-extern floatish graphx0;
-extern floatish graphy0;
-
-extern floatish graphheight;
-extern floatish graphwidth;
-
-void     Dimensions PROTO((void));
-floatish StringSize PROTO((char *));
-
-#endif /* DIMENSIONS_H */
diff --git a/ghc/utils/hp2ps/Error.c b/ghc/utils/hp2ps/Error.c
deleted file mode 100644
index 809c24ea44..0000000000
--- a/ghc/utils/hp2ps/Error.c
+++ /dev/null
@@ -1,59 +0,0 @@
-#include "Main.h"
-#include <stdarg.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include "Defines.h"
-
-/* own stuff */
-#include "Error.h"
-
-/*VARARGS0*/
-void
-Error(const char *fmt, ...)
-{
-    va_list ap;
-    fflush(stdout);
-    fprintf(stderr, "%s: ", programname);
-    va_start(ap, fmt);
-    vfprintf(stderr, fmt, ap);
-    va_end(ap);
-    fprintf(stderr, "\n");
-    exit(1);
-}
-
-/*VARARGS0*/
-void
-Disaster(const char *fmt, ...)
-{
-    va_list ap;
-    fflush(stdout);
-    fprintf(stderr, "%s: ", programname);
-    fprintf(stderr, " Disaster! (");
-    va_start(ap, fmt);
-    vfprintf(stderr, fmt, ap);
-    va_end(ap);
-    fprintf(stderr, ")\n");
-    exit(1);
-}
-
-void
-Usage(str)
-  const char *str;
-{
-   if (str) printf("error: %s\n", str);
-   printf("usage: %s -b -d -ef -g -i -p -mn -p -s -tf -y [file[.hp]]\n", programname);
-   printf("where -b  use large title box\n");
-   printf("      -d  sort by standard deviation\n"); 
-   printf("      -ef[in|mm|pt] produce Encapsulated PostScript f units wide (f > 2 inches)\n");
-   printf("      -g  produce output suitable for GHOSTSCRIPT previever\n");
-   printf("      -i[+|-] sort by identifier string (-i+ gives greatest on top) \n"); 
-   printf("      -mn print maximum of n bands (default & max 20)\n");
-   printf("          -m0 removes the band limit altogether\n");
-   printf("      -p  use previous scaling, shading and ordering\n");
-   printf("      -s  use small title box\n");
-   printf("      -tf ignore trace bands which sum below f%% (default 1%%, max 5%%)\n");
-   printf("      -y  traditional\n");
-   printf("      -c  colour ouput\n");
-   exit(0);
-}
-
diff --git a/ghc/utils/hp2ps/Error.h b/ghc/utils/hp2ps/Error.h
deleted file mode 100644
index c1cdede415..0000000000
--- a/ghc/utils/hp2ps/Error.h
+++ /dev/null
@@ -1,8 +0,0 @@
-#ifndef ERROR_H
-#define ERROR_H
-
-extern void Error    PROTO((const char *, ...));
-extern void Disaster PROTO((const char *, ...));
-extern void Usage    PROTO((const char *));
-
-#endif /* ERROR_H */
diff --git a/ghc/utils/hp2ps/HpFile.c b/ghc/utils/hp2ps/HpFile.c
deleted file mode 100644
index 9db94977df..0000000000
--- a/ghc/utils/hp2ps/HpFile.c
+++ /dev/null
@@ -1,587 +0,0 @@
-#include "Main.h"
-#include <ctype.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include "Defines.h"
-#include "Error.h"
-#include "HpFile.h"
-#include "Utilities.h"
-
-#ifndef atof
-double atof PROTO((const char *));
-#endif
-
-/* own stuff already included */
-
-#define N_MARKS 50		/* start size of the mark table */
-#define N_SAMPLES 500		/* start size of the sample table */
-
-char *theident;
-char *thestring;
-int theinteger;
-floatish thefloatish;
-int ch;						/* last character read  */
-token thetok; 					/* last token           */
-int linenum;					/* current line number  */
-int endfile;					/* true at end of file  */
-
-static boolish gotjob = 0;			/* "JOB" read	        */
-static boolish gotdate = 0;			/* "DATE" read          */
-static boolish gotvalueunit = 0;		/* "VALUE_UNIT" read    */
-static boolish gotsampleunit = 0;		/* "SAMPLE_UNIT" read   */
-static boolish insample = 0;			/* true when in sample  */
-
-static floatish lastsample;			/* the last sample time */
-
-static void GetHpLine PROTO((FILE *));		/* forward */
-static void GetHpTok  PROTO((FILE *));		/* forward */
-
-static struct entry *GetEntry PROTO((char *));	/* forward */
-
-static void MakeIdentTable PROTO((void));	/* forward */
-
-char *jobstring;
-char *datestring;
-
-char *sampleunitstring;
-char *valueunitstring;
-
-floatish *samplemap;		/* sample intervals	*/
-floatish *markmap;		/* sample marks		*/
-
-/*
- *	An extremely simple parser. The input is organised into lines of 
- *	the form
- *
- *      JOB s              -- job identifier string
- *	DATE s		   -- date string 
- *	SAMPLE_UNIT s	   -- sample unit eg "seconds" 
- *	VALUE_UNIT s	   -- value unit eg "bytes" 
- *	MARK i	   	   -- sample mark 
- *	BEGIN_SAMPLE i 	   -- start of ith sample 
- *	identifier i	   -- there are i identifiers in this sample 
- *	END_SAMPLE i   	   -- end of ith sample 
- *
- */
-
-void
-GetHpFile(infp)
-  FILE *infp;
-{
-    nsamples = 0;
-    nmarks   = 0;
-    nidents  = 0;
-
-    ch = ' ';
-    endfile = 0;
-    linenum = 1;
-    lastsample = 0.0;
-
-    GetHpTok(infp);
-
-    while (endfile == 0) {
-	GetHpLine(infp);
-    }
-
-    if (!gotjob) {
-	Error("%s: JOB missing", hpfile);
-    }
-
-    if (!gotdate) {
-	Error("%s: DATE missing", hpfile);
-    }
-
-    if (!gotvalueunit) {
-	Error("%s: VALUE_UNIT missing", hpfile);
-    }
-
-    if (!gotsampleunit) {
-	Error("%s: SAMPLE_UNIT missing", hpfile);
-    }
-
-    if (nsamples == 0) {
-	Error("%s: contains no samples", hpfile);
-    }
-
-
-    MakeIdentTable();
-
-    fclose(hpfp);
-}
-
-
-/*
- *      Read the next line from the input, check the syntax, and perform
- *	the appropriate action.
- */
-
-static void
-GetHpLine(infp)
-  FILE* infp;
-{
-    static intish nmarkmax = 0, nsamplemax = 0;
-
-    switch (thetok) {
-    case JOB_TOK:
-	GetHpTok(infp);
-	if (thetok != STRING_TOK) {
-	    Error("%s, line %d: string must follow JOB", hpfile, linenum);
-        }
-	jobstring = thestring;
-	gotjob = 1;
-        GetHpTok(infp);
-	break;
-
-    case DATE_TOK:
-	GetHpTok(infp);
-	if (thetok != STRING_TOK) {
-	    Error("%s, line %d: string must follow DATE", hpfile, linenum);
-        }
-	datestring = thestring;
-	gotdate = 1;
-        GetHpTok(infp);
-	break;
-
-    case SAMPLE_UNIT_TOK:
-	GetHpTok(infp);
-	if (thetok != STRING_TOK) {
-	    Error("%s, line %d: string must follow SAMPLE_UNIT", hpfile, 
-	          linenum);
-        }
-	sampleunitstring = thestring;
-	gotsampleunit = 1;
-        GetHpTok(infp);
-	break;
-
-    case VALUE_UNIT_TOK:
-        GetHpTok(infp);
-	if (thetok != STRING_TOK) {
-	    Error("%s, line %d: string must follow VALUE_UNIT", hpfile, 
-	          linenum);
-        }
-	valueunitstring = thestring;
-	gotvalueunit = 1;
-        GetHpTok(infp);
-	break;
-
-    case MARK_TOK:
-	GetHpTok(infp);
-        if (thetok != FLOAT_TOK) {
-            Error("%s, line %d, floating point number must follow MARK",
-	          hpfile, linenum);
-        }
-	if (insample) {
-	    Error("%s, line %d, MARK occurs within sample", hpfile, linenum);
-	}
-	if (nmarks >= nmarkmax) {
-	    if (!markmap) {
-		nmarkmax = N_MARKS;
-		markmap = (floatish*) xmalloc(nmarkmax * sizeof(floatish));
-	    } else {
-		nmarkmax *= 2;
-		markmap = (floatish*) xrealloc(markmap, nmarkmax * sizeof(floatish));
-	    }
-	}
-	markmap[ nmarks++ ] = thefloatish; 
-        GetHpTok(infp);
-        break;
-
-    case BEGIN_SAMPLE_TOK: 
-	insample = 1;
-	GetHpTok(infp); 
-	if (thetok != FLOAT_TOK) {
-	    Error("%s, line %d, floating point number must follow BEGIN_SAMPLE",	          hpfile, linenum);
-	}
-	if (thefloatish < lastsample) {
-	    Error("%s, line %d, samples out of sequence", hpfile, linenum);
-	} else {
-	    lastsample = thefloatish;
-        }
-	if (nsamples >= nsamplemax) {
-	    if (!samplemap) {
-		nsamplemax = N_SAMPLES;
-		samplemap = (floatish*) xmalloc(nsamplemax * sizeof(floatish));
-	    } else {
-		nsamplemax *= 2;
-		samplemap = (floatish*) xrealloc(samplemap, 
-	                                      nsamplemax * sizeof(floatish));
-	    }
-	}
-	samplemap[ nsamples ] = thefloatish;
-	GetHpTok(infp);
-	break;
-
-    case END_SAMPLE_TOK: 
-	insample = 0;
-	GetHpTok(infp); 
-	if (thetok != FLOAT_TOK) {
-	    Error("%s, line %d: floating point number must follow END_SAMPLE", 
-                  hpfile, linenum);
-	}
-        nsamples++;
-	GetHpTok(infp);
-	break;
-
-    case IDENTIFIER_TOK:
-	GetHpTok(infp);
-	if (thetok != INTEGER_TOK) {
-	    Error("%s, line %d: integer must follow identifier", hpfile, 
-                  linenum);
-	}
-        StoreSample(GetEntry(theident), nsamples, (floatish) theinteger);
-	GetHpTok(infp); 
-        break;
-
-    case EOF_TOK:
-        endfile = 1;
-	break;
-
-    default:
-	Error("%s, line %d: %s unexpected", hpfile, linenum,
-	      TokenToString(thetok));
-	break;
-    }
-}
-
-
-char *
-TokenToString(t)
-  token t;
-{
-   switch (t) {
-	case EOF_TOK:		return "EOF";
-	case INTEGER_TOK:	return "integer";
-	case FLOAT_TOK:		return "floating point number";
-	case IDENTIFIER_TOK:	return "identifier";
-	case STRING_TOK:	return "string";
-	case BEGIN_SAMPLE_TOK:  return "BEGIN_SAMPLE";
-	case END_SAMPLE_TOK:    return "END_SAMPLE";
-	case JOB_TOK:		return "JOB";
-	case DATE_TOK:		return "DATE";
-	case SAMPLE_UNIT_TOK:   return "SAMPLE_UNIT";
-	case VALUE_UNIT_TOK:    return "VALUE_UNIT";
-	case MARK_TOK:		return "MARK";
-
-	case X_RANGE_TOK:	return "X_RANGE";
-	case Y_RANGE_TOK:	return "Y_RANGE";
-	case ORDER_TOK:		return "ORDER";
-	case SHADE_TOK:		return "SHADE";
-        default:		return "(strange token)";
-    }
-}
-
-/*
- *	Read the next token from the input and assign its value
- *	to the global variable "thetok". In the case of numbers,
- *	the corresponding value is also assigned to "theinteger"
- *	or "thefloatish" as appropriate; in the case of identifiers 
- *	it is assigned to "theident".
- */
-
-static void
-GetHpTok(infp)
-  FILE* infp;
-{
-
-    while (isspace(ch)) {		/* skip whitespace */
-	if (ch == '\n') linenum++;
-	ch = getc(infp);
-    } 
-
-    if (ch == EOF) {
-	thetok = EOF_TOK;
-	return;
-    }
-
-    if (isdigit(ch)) {
-	thetok = GetNumber(infp);
-	return;
-    } else if (ch == '\"') {
-	GetString(infp);
-	thetok = STRING_TOK;
-	return;
-    } else if (IsIdChar(ch)) {
-	ASSERT(! (isdigit(ch)));	/* ch can't be a digit here */
-	GetIdent(infp);
-	if (!isupper((int)theident[0])) {
-	    thetok = IDENTIFIER_TOK;
-	} else if (strcmp(theident, "BEGIN_SAMPLE") == 0) {
-            thetok = BEGIN_SAMPLE_TOK;
-	} else if (strcmp(theident, "END_SAMPLE") == 0) {
-            thetok = END_SAMPLE_TOK;
-	} else if (strcmp(theident, "JOB") == 0) {
-	    thetok = JOB_TOK;
-	} else if (strcmp(theident, "DATE") == 0) {
-	    thetok = DATE_TOK;
-	} else if (strcmp(theident, "SAMPLE_UNIT") == 0) {
-	    thetok = SAMPLE_UNIT_TOK;
-	} else if (strcmp(theident, "VALUE_UNIT") == 0) {
-	    thetok = VALUE_UNIT_TOK;
-	} else if (strcmp(theident, "MARK") == 0) {
-	    thetok = MARK_TOK;
-	} else {
-            thetok = IDENTIFIER_TOK;
-	}
-	return;
-    } else {
-	Error("%s, line %d: strange character (%c)", hpfile, linenum, ch);
-    }
-}
-
-
-/*
- *	Read a sequence of digits and convert the result to an integer
- *	or floating point value (assigned to the "theinteger" or 
- *	"thefloatish").
- */
-
-static char numberstring[ NUMBER_LENGTH - 1 ];
-
-token
-GetNumber(infp)
-  FILE* infp;
-{
-    int i;
-    int containsdot;
- 
-    ASSERT(isdigit(ch)); /* we must have a digit to start with */
-
-    containsdot = 0;
-
-    for (i = 0; i < NUMBER_LENGTH && (isdigit(ch) || ch == '.'); i++) {
-        numberstring[ i ] = ch;
-        containsdot |= (ch == '.'); 
-        ch = getc(infp);
-    }   
- 
-    ASSERT(i < NUMBER_LENGTH); /* did not overflow */
-
-    numberstring[ i ] = '\0';
- 
-    if (containsdot) {
-        thefloatish = (floatish) atof(numberstring);
-	return FLOAT_TOK;
-    } else {
-	theinteger = atoi(numberstring);
-	return INTEGER_TOK;
-    }
-}
-
-/*
- *	Read a sequence of identifier characters and assign the result 
- *	to the string "theident".
- */
-
-void
-GetIdent(infp)
-  FILE *infp;
-{
-    unsigned int i;
-    char idbuffer[5000];
-
-    for (i = 0; i < (sizeof idbuffer)-1 && IsIdChar(ch); i++) {
-	idbuffer[ i ] = ch;
-	ch = getc(infp);
-    }
-    
-    idbuffer[ i ] = '\0';
-
-    if (theident)
-	free(theident);
-
-    theident = copystring(idbuffer);
-}
-
-
-/*
- *	Read a sequence of characters that make up a string and 
- *	assign the result to "thestring".
- */
-
-void
-GetString(infp)
-  FILE *infp;
-{
-    unsigned int i;
-    char stringbuffer[5000];
-
-    ASSERT(ch == '\"');
-
-    ch = getc(infp);	/* skip the '\"' that begins the string */
-
-    for (i = 0; i < (sizeof stringbuffer)-1 && ch != '\"'; i++) {
-	stringbuffer[ i ] = ch;
-	ch = getc(infp);
-    }
-
-    stringbuffer[i] = '\0'; 
-    thestring = copystring(stringbuffer);
-
-    ASSERT(ch == '\"');
-
-    ch = getc(infp);      /* skip the '\"' that terminates the string */
-}
-
-boolish
-IsIdChar(ch)
-  int ch;
-{
-    return (!isspace(ch));
-}
-
-
-/*
- *      The information associated with each identifier is stored
- *	in a linked list of chunks. The table below allows the list
- *	of chunks to be retrieved given an identifier name.
- */
-
-#define N_HASH       	513 
-
-static struct entry* hashtable[ N_HASH ];
-
-static intish
-Hash(s)
-  char *s;
-{
-    int r;
- 
-    for (r = 0; *s; s++) {
-        r = r + r + r + *s;
-    }
-
-    if (r < 0) r = -r;
-
-    return r % N_HASH;
-}
-
-/*
- *      Get space for a new chunk. Initialise it, and return a pointer 
- *	to the new chunk.
- */
- 
-static struct chunk*
-MakeChunk()
-{
-    struct chunk* ch;
-    struct datapoint* d;
-
-    ch = (struct chunk*) xmalloc( sizeof(struct chunk) );
- 
-    d = (struct datapoint*) xmalloc (sizeof(struct datapoint) * N_CHUNK);
-
-    ch->nd = 0; 
-    ch->d = d;
-    ch->next = 0;
-    return ch;
-}
-
-
-/*
- *      Get space for a new entry. Initialise it, and return a pointer 
- *	to the new entry.
- */
- 
-struct entry *
-MakeEntry(name)
-  char *name;
-{
-    struct entry* e;
-
-    e = (struct entry *) xmalloc(sizeof(struct entry));
-    e->chk = MakeChunk();
-    e->name = copystring(name); 
-    return e;
-}
-
-/*
- *	Get the entry associated with "name", creating a new entry if 
- *	necessary.
- */
-
-static struct entry *
-GetEntry(name)
-  char* name;
-{
-    intish h;
-    struct entry* e;
- 
-    h = Hash(name);
- 
-    for (e = hashtable[ h ]; e; e = e->next) {
-        if (strcmp(e->name, name) == 0) {
-            break;
-        }
-    }
- 
-    if (e) {
-	return (e); 
-    } else {
-        nidents++;
-        e = MakeEntry(name);
-        e->next = hashtable[ h ];
-        hashtable[ h ] = e;
-        return (e);
-    }
-}
-
-
-/*
- *      Store information from a sample. 
- */
- 
-void
-StoreSample(en, bucket, value)
-  struct entry* en; intish bucket; floatish value;
-{
-    struct chunk* chk; 
-
-    for (chk = en->chk; chk->next != 0; chk = chk->next)
-	; 
-
-    if (chk->nd < N_CHUNK) {
-	chk->d[ chk->nd ].bucket = bucket;
-	chk->d[ chk->nd ].value  = value;
-	chk->nd += 1;
-    } else {
-	struct chunk* t;
-	t = chk->next = MakeChunk(); 
-	t->d[ 0 ].bucket = bucket;
-	t->d[ 0 ].value  = value;
-	t->nd += 1;
-    }
-}
-
-
-struct entry** identtable;
-
-/*
- *	The hash table is useful while reading the input, but it
- *	becomes a liability thereafter. The code below converts 
- *	it to a more easily processed table.
- */
-
-static void
-MakeIdentTable()
-{
-    intish i;
-    intish j;
-    struct entry* e;
-
-    nidents = 0;
-    for (i = 0; i < N_HASH; i++) {
-        for (e = hashtable[ i ]; e; e = e->next) {
-	    nidents++;
-        }
-    }
-
-    identtable = (struct entry**) xmalloc(nidents * sizeof(struct entry*));
-    j = 0;
-
-    for (i = 0; i < N_HASH; i++) {
-        for (e = hashtable[ i ]; e; e = e->next, j++) {
-	    identtable[ j ] = e; 
-        }
-    }
-}
diff --git a/ghc/utils/hp2ps/HpFile.h b/ghc/utils/hp2ps/HpFile.h
deleted file mode 100644
index 1c43f73d6d..0000000000
--- a/ghc/utils/hp2ps/HpFile.h
+++ /dev/null
@@ -1,77 +0,0 @@
-#ifndef HP_FILE_H
-#define HP_FILE_H
-
-typedef enum {
-        /* These tokens are found in ".hp" files */ 
- 
-	EOF_TOK,
-	INTEGER_TOK,
-	FLOAT_TOK,
-	IDENTIFIER_TOK,
-	STRING_TOK,
-	BEGIN_SAMPLE_TOK,
-	END_SAMPLE_TOK,
-	JOB_TOK, 
-	DATE_TOK,
-	SAMPLE_UNIT_TOK,
-	VALUE_UNIT_TOK,
-	MARK_TOK,
- 
-	/* These extra ones are found only in ".aux" files */ 
- 
-	X_RANGE_TOK,
-	Y_RANGE_TOK,
-	ORDER_TOK,
-	SHADE_TOK
-} token;
-
-struct datapoint {
-    int bucket;
-    floatish value;
-};
-
-struct chunk {
-    struct chunk *next;
-    short  nd;                          /* 0 .. N_CHUNK - 1 */
-    struct datapoint *d;
-};
-
-
-struct entry {
-    struct entry *next;
-    struct chunk *chk;
-    char   *name;
-};
-
-extern char *theident;
-extern char *thestring;
-extern int theinteger;
-extern floatish thefloatish;
-extern int ch;
-extern token thetok;
-extern int linenum; 
-extern int endfile;
-
-char *TokenToString PROTO((token));
-
-extern struct entry** identtable;
-
-extern floatish *samplemap;
-extern floatish *markmap;
-
-void GetHpFile PROTO((FILE *));
-void StoreSample PROTO((struct entry *, intish, floatish));
-struct entry *MakeEntry PROTO((char *));
-
-token GetNumber PROTO((FILE *));
-void  GetIdent  PROTO((FILE *));
-void  GetString PROTO((FILE *));
-boolish IsIdChar PROTO((int)); /* int is a "char" from getc */
-
-extern char *jobstring;
-extern char *datestring;
- 
-extern char *sampleunitstring;
-extern char *valueunitstring;
-
-#endif /* HP_FILE_H */
diff --git a/ghc/utils/hp2ps/Key.c b/ghc/utils/hp2ps/Key.c
deleted file mode 100644
index 8c63721c74..0000000000
--- a/ghc/utils/hp2ps/Key.c
+++ /dev/null
@@ -1,63 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <math.h>
-#include "Defines.h"
-#include "Dimensions.h"
-#include "HpFile.h"
-#include "Shade.h"
-
-/* own stuff */
-#include "Key.h"
-
-static void KeyEntry PROTO((floatish, char *, floatish));
-
-void Key()
-{
-    intish i;
-    floatish c;
-    floatish dc;
-
-    for (i = 0; i < nidents; i++)    /* count identifiers */ 
-	;
-
-    c  = graphy0;
-    dc = graphheight / (floatish) (i + 1);
-
-    for (i = 0; i < nidents; i++) {
-	c += dc;
-	KeyEntry(c, identtable[i]->name, ShadeOf(identtable[i]->name));
-    }
-}
-
-
-
-static void
-KeyEntry(centreline, name, colour)
-  floatish centreline; char* name; floatish colour;
-{
-    floatish namebase;
-    floatish keyboxbase;
-    floatish kstart;
-
-    namebase = centreline - (floatish) (NORMAL_FONT / 2);
-    keyboxbase = centreline - ((floatish) KEY_BOX_WIDTH / 2.0);
-
-    kstart = graphx0 + graphwidth;
-
-    fprintf(psfp, "%f %f moveto\n", kstart + borderspace, keyboxbase);
-    fprintf(psfp, "0 %d rlineto\n", KEY_BOX_WIDTH);
-    fprintf(psfp, "%d 0 rlineto\n", KEY_BOX_WIDTH);
-    fprintf(psfp, "0 %d rlineto\n", -KEY_BOX_WIDTH);
-    fprintf(psfp, "closepath\n");
-
-    fprintf(psfp, "gsave\n"); 
-    SetPSColour(colour);
-    fprintf(psfp, "fill\n");
-    fprintf(psfp, "grestore\n");
-    fprintf(psfp, "stroke\n");
-
-    fprintf(psfp, "HE%d setfont\n", NORMAL_FONT);
-    fprintf(psfp, "%f %f moveto\n", kstart + (floatish) KEY_BOX_WIDTH + 2 * borderspace, namebase);
-
-    fprintf(psfp, "(%s) show\n", name); 
-}
diff --git a/ghc/utils/hp2ps/Key.h b/ghc/utils/hp2ps/Key.h
deleted file mode 100644
index d2a7b8eae3..0000000000
--- a/ghc/utils/hp2ps/Key.h
+++ /dev/null
@@ -1,6 +0,0 @@
-#ifndef KEY_H
-#define KEY_H
-
-void Key PROTO((void));
-
-#endif /* KEY_H */
diff --git a/ghc/utils/hp2ps/Main.c b/ghc/utils/hp2ps/Main.c
deleted file mode 100644
index 3b5efed51b..0000000000
--- a/ghc/utils/hp2ps/Main.c
+++ /dev/null
@@ -1,253 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include "Defines.h"
-#include "AuxFile.h"
-#include "AreaBelow.h"
-#include "Dimensions.h"
-#include "HpFile.h"
-#include "PsFile.h"
-#include "Reorder.h"
-#include "Scale.h"
-#include "TopTwenty.h"
-#include "TraceElement.h"
-#include "Deviation.h"
-#include "Error.h"
-#include "Utilities.h"
-
-boolish pflag = 0;	/* read auxiliary file			*/
-boolish eflag = 0;	/* scaled EPSF 				*/ 
-boolish dflag = 0;	/* sort by standard deviation		*/
-int     iflag = 0;	/* sort by identifier (3-way flag)      */
-boolish gflag = 0;	/* output suitable for previewer	*/
-boolish yflag = 0; 	/* ignore marks				*/
-boolish bflag = 0; 	/* use a big title box			*/
-boolish sflag = 0;	/* use a small title box		*/
-int     mflag = 0;	/* max no. of bands displayed (default 20) */
-boolish tflag = 0;	/* ignored threshold specified          */
-boolish cflag = 0;      /* colour output                        */
-
-boolish filter;		/* true when running as a filter	*/
-
-static floatish WidthInPoints PROTO((char *));		  /* forward */
-static FILE *Fp PROTO((char *, char **, char *, char *)); /* forward */
-
-char *hpfile;
-char *psfile;
-char *auxfile;
-
-char *programname;
-
-static char *pathName;
-static char *baseName; /* "basename" is a std C library name (sigh) */
-
-FILE* hpfp;
-FILE* psfp;
-FILE* auxfp;
-
-floatish xrange = 0.0;
-floatish yrange = 0.0;
-
-floatish auxxrange = 0.0;
-floatish auxyrange = 0.0;
-
-floatish epsfwidth;
-floatish areabelow;
-
-intish nsamples;
-intish nmarks;
-intish nidents;
-
-floatish THRESHOLD_PERCENT = DEFAULT_THRESHOLD;
-int TWENTY = DEFAULT_TWENTY;
-
-int main(argc, argv)
-int argc;
-char* argv[];
-{
-
-    programname = copystring(Basename(argv[0]));
-
-    argc--, argv++;
-    while (argc && argv[0][0] == '-') {
-        while (*++*argv)
-            switch(**argv) {
-	    case 'p':
-                pflag++;
-                break;
-	    case 'e':
-		eflag++;
-                epsfwidth = WidthInPoints(*argv + 1);
-                goto nextarg;
-	    case 'd':
-		dflag++;
-                goto nextarg;
-	    case 'i':
-		switch( *(*argv + 1) ) {
-		  case '-':
-		    iflag = -1;
-		  case '+':
-		  default:
-		    iflag = 1;
-		}
-                goto nextarg;
-	    case 'g':
-		gflag++;
-		goto nextarg;
-	    case 'y':
-		yflag++;
-		goto nextarg;
-	    case 'b':
-		bflag++;
-		goto nextarg;
-	    case 's':
-		sflag++;
-		goto nextarg;
-	    case 'm':
-		mflag++;
-		TWENTY = atoi(*argv + 1);
-		if (TWENTY > DEFAULT_TWENTY)
-		    Usage(*argv-1);
-		goto nextarg;
-	    case 't':
-		tflag++;
-		THRESHOLD_PERCENT = (floatish) atof(*argv + 1);
-		if (THRESHOLD_PERCENT < 0 || THRESHOLD_PERCENT > 5)
-		    Usage(*argv-1);
-		goto nextarg;
-	    case 'c':
-		cflag++;
-		goto nextarg;
-	    case '?':
-	    default:
-		Usage(*argv-1);
-            }
-nextarg: ;
-        argc--, argv++;
-    }
-
-    hpfile = "stdin";
-    psfile = "stdout";
-
-    hpfp = stdin;
-    psfp = stdout;
-
-    filter = argc < 1;
-
-
-
-    if (!filter) {
-	pathName = copystring(argv[0]);
-	DropSuffix(pathName, ".hp");
-	baseName = copystring(Basename(pathName));
-
-        hpfp  = Fp(pathName, &hpfile, ".hp", "r"); 
-	psfp  = Fp(baseName, &psfile, ".ps", "w"); 
-
-	if (pflag) auxfp = Fp(baseName, &auxfile, ".aux", "r");
-    }
-
-    GetHpFile(hpfp);
-
-    if (!filter && pflag) GetAuxFile(auxfp);
-
-
-    TraceElement();          /* Orders on total, Removes trace elements (tflag) */
-
-    if (dflag) Deviation();  /* ReOrders on deviation */
-
-    if (iflag) Identorder(iflag); /* ReOrders on identifier */
-
-    if (pflag) Reorder();    /* ReOrders on aux file */
-
-    if (TWENTY) TopTwenty(); /* Selects top twenty (mflag) */
-
-    Dimensions();
-
-    areabelow = AreaBelow();
-
-    Scale();
-
-    PutPsFile();
-
-    if (!filter) {
-        auxfp = Fp(baseName, &auxfile, ".aux", "w");
-	PutAuxFile(auxfp);
-    } 
-
-    return(0);
-}
-
-
-
-typedef enum {POINTS, INCHES, MILLIMETRES} pim;
-
-static pim Units PROTO((char *));   /* forward */
-
-static floatish
-WidthInPoints(wstr)
-  char *wstr;
-{
-    floatish result;
-
-    result = (floatish) atof(wstr);
-
-    switch (Units(wstr)) {
-	case INCHES:  		
-	    result *= 72.0;
-	    break;
-        case MILLIMETRES:	
-	    result *= 2.834646;
-	    break;
-        case POINTS:
-	default: ;
-    }
-
-    if (result <= 144)   /* Minimum of 2in wide ! */
-	Usage(wstr);
-
-    return result;
-}
-
-	
-static pim
-Units(wstr)
-  char* wstr;
-{
-int i;
-
-    i = strlen(wstr) - 2;
-
-    if (wstr[i] == 'p' && wstr[i+1] == 't') {
-	return POINTS;
-    } else if (wstr[i] == 'i' && wstr[i+1] == 'n') {
-	return INCHES;	
-    } else if (wstr[i] == 'm' && wstr[i+1] == 'm') {
-	return MILLIMETRES;
-    } else {
-        return POINTS;
-    }
-}
-
-static FILE *
-Fp(rootname, filename, suffix, mode)
-  char* rootname; char** filename; char* suffix; char* mode;
-{
-    *filename = copystring2(rootname, suffix);
-
-    return(OpenFile(*filename, mode));
-}
-
-#ifdef DEBUG
-void
-_stgAssert (filename, linenum)
-  char		*filename;
-  unsigned int  linenum;
-{
-    fflush(stdout);
-    fprintf(stderr, "ASSERTION FAILED: file %s, line %u\n", filename, linenum);
-    fflush(stderr);
-    abort();
-}
-#endif
diff --git a/ghc/utils/hp2ps/Main.h b/ghc/utils/hp2ps/Main.h
deleted file mode 100644
index 30e7a7e9be..0000000000
--- a/ghc/utils/hp2ps/Main.h
+++ /dev/null
@@ -1,77 +0,0 @@
-#ifndef MAIN_H
-#define MAIN_H
-
-#include "../includes/ghcconfig.h"
-#include <stdio.h>
-
-#ifdef __STDC__
-#define PROTO(x)	x
-#else
-#define PROTO(x)	()
-#endif
-
-/* our own ASSERT macro (for C) */
-#ifndef DEBUG
-#define ASSERT(predicate) /*nothing*/
-
-#else
-void _ghcAssert PROTO((char *, unsigned int));
-
-#define ASSERT(predicate)			\
-	if (predicate)				\
-	    /*null*/;				\
-	else					\
-	    _ghcAssert(__FILE__, __LINE__)
-#endif
-
-/* partain: some ubiquitous types: floatish & intish.
-   Dubious to use float/int, but that is what it used to be...
-   (WDP 95/03)   
-*/
-typedef double	floatish;
-typedef double  doublish; /* higher precision, if anything; little used */
-typedef int	boolish;
-
-/* Use "long long" if we have it: the numbers in profiles can easily
- * overflow 32 bits after a few seconds execution.
- */
-#ifdef HAVE_LONG_LONG
-typedef long long int intish;
-#else
-typedef long int intish;
-#endif
-
-extern intish nsamples;
-extern intish nmarks;
-extern intish nidents;
-
-extern floatish maxcombinedheight;
-extern floatish areabelow;
-extern floatish epsfwidth;
-
-extern floatish xrange;
-extern floatish yrange;
-
-extern floatish auxxrange;
-extern floatish auxyrange;
-
-extern boolish eflag;
-extern boolish gflag;
-extern boolish yflag;
-extern boolish bflag;
-extern boolish sflag;
-extern int     mflag;
-extern boolish tflag;
-extern boolish cflag;
-
-extern char *programname;
-
-extern char *hpfile;
-extern char *psfile;
-extern char *auxfile;
-
-extern FILE *hpfp;
-extern FILE *psfp;
-extern FILE *auxfp;
-
-#endif /* MAIN_H */
diff --git a/ghc/utils/hp2ps/Makefile b/ghc/utils/hp2ps/Makefile
deleted file mode 100644
index 18cb05b1bd..0000000000
--- a/ghc/utils/hp2ps/Makefile
+++ /dev/null
@@ -1,14 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-C_PROG 	= hp2ps
-
-SRC_CC_OPTS += -I$(GHC_INCLUDE_DIR) -Wall
-
-INSTALL_PROGS += $(C_PROG)
-
-LIBS	     = $(LIBM)
-
-CLEAN_FILES += $(C_OBJS) $(C_PROG)
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/hp2ps/Marks.c b/ghc/utils/hp2ps/Marks.c
deleted file mode 100644
index 8d6f924e17..0000000000
--- a/ghc/utils/hp2ps/Marks.c
+++ /dev/null
@@ -1,43 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include "Curves.h"
-#include "Dimensions.h"
-#include "HpFile.h"
-
-/* own stuff */
-#include "Marks.h"
-
-static void Caret PROTO((floatish, floatish, floatish));
-
-void
-Marks()
-{
-    intish i;
-    floatish m;
-
-    for (i = 0; i < nmarks; i++) {
-	m = ((markmap[i] - samplemap[0]) / xrange) * graphwidth;
-	Caret(xpage(m), ypage(0.0), 4.0);
-    }
-}
-
-
-/*
- * Draw a small white caret at (x,y) with width 2 * d
- */
-
-static void
-Caret(x,y,d)
-  floatish x; floatish y; floatish d;
-{
-    fprintf(psfp, "%f %f moveto\n", x - d, y);
-    fprintf(psfp, "%f %f rlineto\n",  d, -d);
-    fprintf(psfp, "%f %f rlineto\n",  d,  d);
-    fprintf(psfp, "closepath\n");
-
-    fprintf(psfp, "gsave\n");
-    fprintf(psfp, "1.0 setgray\n");
-    fprintf(psfp, "fill\n");
-    fprintf(psfp, "grestore\n");
-    fprintf(psfp, "stroke\n");
-}
diff --git a/ghc/utils/hp2ps/Marks.h b/ghc/utils/hp2ps/Marks.h
deleted file mode 100644
index 41956f6e83..0000000000
--- a/ghc/utils/hp2ps/Marks.h
+++ /dev/null
@@ -1,6 +0,0 @@
-#ifndef MARKS_H
-#define MARKS_H
-
-void Marks PROTO((void));
-
-#endif /* MARKS_H */
diff --git a/ghc/utils/hp2ps/PsFile.c b/ghc/utils/hp2ps/PsFile.c
deleted file mode 100644
index 357f826259..0000000000
--- a/ghc/utils/hp2ps/PsFile.c
+++ /dev/null
@@ -1,280 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <string.h>
-#include "Defines.h"
-#include "Dimensions.h"
-#include "Curves.h"
-#include "HpFile.h"
-#include "Axes.h"
-#include "Key.h"
-#include "Marks.h"
-#include "Utilities.h"
-
-/* own stuff */
-#include "PsFile.h"
-
-static void Prologue PROTO((void)); /* forward */
-static void Variables PROTO((void)); /* forward */
-static void BorderOutlineBox PROTO((void)); /* forward */
-static void BigTitleOutlineBox PROTO((void)); /* forward */
-static void TitleOutlineBox PROTO((void)); /* forward */
-static void BigTitleText PROTO((void)); /* forward */
-static void TitleText PROTO((void)); /* forward */
-
-void
-PutPsFile()
-{
-    Prologue();
-    Variables();
-    BorderOutlineBox();
-
-    if (bflag) {
-	BigTitleOutlineBox();
-        BigTitleText();
-    } else {
-	TitleOutlineBox();
-	TitleText();
-    }
-
-    CurvesInit();
-
-    Axes();
-
-    if (TWENTY) Key();
-
-    Curves();
-
-    if (!yflag) Marks();
-
-    fprintf(psfp, "showpage\n");
-}
-
-
-static void StandardSpecialComments PROTO((void));	/* forward */
-static void EPSFSpecialComments PROTO((floatish));	/* forward */
-static void Landscape PROTO((void));			/* forward */
-static void Portrait  PROTO((void));			/* forward */
-static void Scaling   PROTO((floatish));		/* forward */
-
-static void
-Prologue()
-{
-    if (eflag) {
-	floatish epsfscale = epsfwidth / (floatish) borderwidth;
-	EPSFSpecialComments(epsfscale);
-	Scaling(epsfscale);
-    } else {
-	StandardSpecialComments();
-	if (gflag) Portrait(); else Landscape();
-    }
-}
-
-extern char *jobstring;
-extern char *datestring;
-
-static void
-StandardSpecialComments()
-{
-    fprintf(psfp, "%%!PS-Adobe-2.0\n");
-    fprintf(psfp, "%%%%Title: %s\n", jobstring);
-    fprintf(psfp, "%%%%Creator: %s (version %s)\n", programname, VERSION);
-    fprintf(psfp, "%%%%CreationDate: %s\n", datestring);
-    fprintf(psfp, "%%%%EndComments\n");
-} 
-
-static void
-EPSFSpecialComments(epsfscale)
-  floatish epsfscale;
-{
-    fprintf(psfp, "%%!PS-Adobe-2.0\n");
-    fprintf(psfp, "%%%%Title: %s\n", jobstring);
-    fprintf(psfp, "%%%%Creator: %s (version %s)\n", programname, VERSION);
-    fprintf(psfp, "%%%%CreationDate: %s\n", datestring);
-    fprintf(psfp, "%%%%BoundingBox: 0 0 %d %d\n", 
-		(int) (borderwidth  * epsfscale + 0.5), 
-	        (int) (borderheight * epsfscale + 0.5) );
-    fprintf(psfp, "%%%%EndComments\n");
-} 
-
-
-
-static void
-Landscape()
-{
-    fprintf(psfp, "-90 rotate\n");
-    fprintf(psfp, "%f %f translate\n", -(borderwidth + (floatish) START_Y), 
-	          (floatish) START_X); 
-}
-
-static void
-Portrait()
-{
-    fprintf(psfp, "%f %f translate\n", (floatish) START_X, (floatish) START_Y); 
-}
-
-static void
-Scaling(epsfscale)
-  floatish epsfscale;
-{
-    fprintf(psfp, "%f %f scale\n", epsfscale, epsfscale);
-}
-
-
-static void
-Variables()
-{
-    fprintf(psfp, "/HE%d /Helvetica findfont %d scalefont def\n",
-                  NORMAL_FONT, NORMAL_FONT);
-
-    fprintf(psfp, "/HE%d /Helvetica findfont %d scalefont def\n", 
-                  LARGE_FONT, LARGE_FONT);
-}
-
-
-static void
-BorderOutlineBox()
-{
-    fprintf(psfp, "newpath\n");
-    fprintf(psfp, "0 0 moveto\n");
-    fprintf(psfp, "0 %f rlineto\n", borderheight);
-    fprintf(psfp, "%f 0 rlineto\n", borderwidth);
-    fprintf(psfp, "0 %f rlineto\n", -borderheight);
-    fprintf(psfp, "closepath\n");
-    fprintf(psfp, "%f setlinewidth\n", borderthick);
-    fprintf(psfp, "stroke\n");
-}
-
-static void
-BigTitleOutlineBox()
-{
-    fprintf(psfp, "newpath\n");
-    fprintf(psfp, "%f %f moveto\n", borderspace,
-                  borderheight - titleheight - borderspace);
-    fprintf(psfp, "0 %f rlineto\n", titleheight);
-    fprintf(psfp, "%f 0 rlineto\n", titlewidth);
-    fprintf(psfp, "0 %f rlineto\n", -titleheight);
-    fprintf(psfp, "closepath\n");
-    fprintf(psfp, "%f setlinewidth\n", borderthick);
-    fprintf(psfp, "stroke\n");
-
-    fprintf(psfp, "%f %f moveto\n", borderspace,
-                  borderheight - titleheight / 2 - borderspace);
-    fprintf(psfp, "%f 0 rlineto\n", titlewidth);
-    fprintf(psfp, "stroke\n");
-}
-
-
-static void
-TitleOutlineBox()
-{
-    fprintf(psfp, "newpath\n");
-    fprintf(psfp, "%f %f moveto\n", borderspace, 
-                  borderheight - titleheight - borderspace);
-    fprintf(psfp, "0 %f rlineto\n", titleheight);
-    fprintf(psfp, "%f 0 rlineto\n", titlewidth);
-    fprintf(psfp, "0 %f rlineto\n", -titleheight);
-    fprintf(psfp, "closepath\n");
-    fprintf(psfp, "%f setlinewidth\n", borderthick);
-    fprintf(psfp, "stroke\n");
-}
-
-static void EscapePrint PROTO((char *, int));	/* forward */
-
-static void
-BigTitleText()
-{
-    floatish x, y;
-
-    x = borderspace + titletextspace;
-    y = borderheight - titleheight / 2 - borderspace + titletextspace;
-
-    /* job identifier goes on top at the far left */
-
-    fprintf(psfp, "HE%d setfont\n", TITLE_TEXT_FONT);
-    fprintf(psfp, "%f %f moveto\n", x, y);
-    fputc('(', psfp); 
-    EscapePrint(jobstring, BIG_JOB_STRING_WIDTH);
-    fprintf(psfp, ") show\n");
-
-    y = borderheight - titleheight - borderspace + titletextspace;
-
-    /* area below curve gows at the botton, far left */
-
-    fprintf(psfp, "HE%d setfont\n", TITLE_TEXT_FONT);
-    fprintf(psfp, "%f %f moveto\n", x, y);
-    fputc('(', psfp);
-    CommaPrint(psfp, (intish)areabelow);
-    fprintf(psfp, " %s x %s)\n", valueunitstring, sampleunitstring); 
-    fprintf(psfp, "show\n");
-
-    /* date goes at far right */
-
-    fprintf(psfp, "HE%d setfont\n", TITLE_TEXT_FONT);
-    fprintf(psfp, "(%s)\n", datestring);
-    fprintf(psfp, "dup stringwidth pop\n");
-    fprintf(psfp, "%f\n", (titlewidth + borderspace) - titletextspace); 
-    fprintf(psfp, "exch sub\n");
-    fprintf(psfp, "%f moveto\n", y);
-    fprintf(psfp, "show\n");
-}
-
-
-static void
-TitleText()
-{
-    floatish x, y;
- 
-    x = borderspace + titletextspace;
-    y = borderheight - titleheight - borderspace + titletextspace;
- 
-    /* job identifier goes at far left */
- 
-    fprintf(psfp, "HE%d setfont\n", TITLE_TEXT_FONT);
-    fprintf(psfp, "%f %f moveto\n", x, y);
-    fputc('(', psfp); 
-    EscapePrint(jobstring, SMALL_JOB_STRING_WIDTH);
-    fprintf(psfp, ") show\n");
- 
-    /* area below curve is centered */
- 
-    fprintf(psfp, "HE%d setfont\n", TITLE_TEXT_FONT);
-    fputc('(', psfp);
-    CommaPrint(psfp, (intish) areabelow);
-    fprintf(psfp, " %s x %s)\n", valueunitstring, sampleunitstring);
- 
-    fprintf(psfp, "dup stringwidth pop\n");
-    fprintf(psfp, "2 div\n");
-    fprintf(psfp, "%f\n", titlewidth / 2);
-    fprintf(psfp, "exch sub\n");
-    fprintf(psfp, "%f moveto\n", y);
-    fprintf(psfp, "show\n");
- 
-    /* date goes at far right */
- 
-    fprintf(psfp, "HE%d setfont\n", TITLE_TEXT_FONT);
-    fprintf(psfp, "(%s)\n", datestring);
-    fprintf(psfp, "dup stringwidth pop\n");
-    fprintf(psfp, "%f\n", (titlewidth + borderspace) - titletextspace);
-    fprintf(psfp, "exch sub\n");
-    fprintf(psfp, "%f moveto\n", y);
-    fprintf(psfp, "show\n");
-}
-
-/*
- *	Print a string s in width w, escaping characters where necessary.
- */
-
-static void
-EscapePrint(s,w)
-  char* s; int w;
-{
-    for ( ; *s && w > 0; s++, w--) {
-	if (*s == '(') {		/* escape required */
-	    fputc('\\', psfp);
-	} else if (*s == ')') {
-	    fputc('\\', psfp);
-	}
-
-	fputc(*s, psfp);
-    }
-}
diff --git a/ghc/utils/hp2ps/PsFile.h b/ghc/utils/hp2ps/PsFile.h
deleted file mode 100644
index acec0703bc..0000000000
--- a/ghc/utils/hp2ps/PsFile.h
+++ /dev/null
@@ -1,6 +0,0 @@
-#ifndef PS_FILE_H
-#define PS_FILE_H
-
-void PutPsFile PROTO((void));
-
-#endif /* PS_FILE_H */
diff --git a/ghc/utils/hp2ps/README.GHC b/ghc/utils/hp2ps/README.GHC
deleted file mode 100644
index a3fb21e922..0000000000
--- a/ghc/utils/hp2ps/README.GHC
+++ /dev/null
@@ -1,4 +0,0 @@
-This "hp2ps" program was written and is maintained by Dave Wakeling at
-York.  All I (WDP) have done is make it slot into the "make world"ery.
-
-We are grateful for this contribution of shared code.
diff --git a/ghc/utils/hp2ps/Reorder.c b/ghc/utils/hp2ps/Reorder.c
deleted file mode 100644
index afeed52d85..0000000000
--- a/ghc/utils/hp2ps/Reorder.c
+++ /dev/null
@@ -1,89 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include "Defines.h"
-#include "Error.h"
-#include "HpFile.h"
-#include "Utilities.h"
-
-/* own stuff */
-#include "Reorder.h"
-
-static struct order {
-    char* ident;
-    int order;
-} *ordermap = 0;
-
-static int ordermapmax = 0;
-static int ordermapindex = 0;
-
-
-void
-OrderFor(ident, order)
-  char* ident; 
-  int order;
-{
-    if (! ordermap) {
-	ordermapmax = (nidents > TWENTY ? nidents : TWENTY) * 2;
-	         /* Assume nidents read is indication of the No of
-		    idents in the .aux file (*2 for good luck !) */
-	ordermap = xmalloc(ordermapmax * sizeof(struct order));
-    }
-
-    if (ordermapindex < ordermapmax) {
-	ordermap[ ordermapindex ].ident = copystring(ident);
-	ordermap[ ordermapindex ].order = order;
-	ordermapindex++;
-    } else {
-	Disaster("order map overflow");
-    }
-}
-
-/*
- *	Get the order of to be used for "ident" if there is one. 
- *	Otherwise, return 0 which is the minimum ordering value. 
- */
-
-int
-OrderOf(ident)
-  char* ident;
-{
-    int i;
-
-    for (i = 0; i < ordermapindex; i++) {
-	if (strcmp(ordermap[i].ident, ident) == 0) {	/* got it */
-	    return(ordermap[i].order);
-	}
-    }
-
-    return 0; 
-}
-
-/*
- *	Reorder on the basis of information from ".aux" file.
- */
-
-void
-Reorder()
-{
-    intish i;
-    intish j;
-    int min;
-    struct entry* e;
-    int o1, o2;
-
-    for (i = 0; i < nidents-1; i++) {
-	min = i; 
-	for (j = i+1; j < nidents; j++) {
-	    o1 = OrderOf(identtable[  j  ]->name);
-	    o2 = OrderOf(identtable[ min ]->name);
-
-	    if (o1 < o2 ) min = j;
-	}
-
-        e = identtable[ min ];
-	identtable[ min ] = identtable[ i ];
-	identtable[ i ] = e;
-    } 	
-}
diff --git a/ghc/utils/hp2ps/Reorder.h b/ghc/utils/hp2ps/Reorder.h
deleted file mode 100644
index 089ef75cfc..0000000000
--- a/ghc/utils/hp2ps/Reorder.h
+++ /dev/null
@@ -1,8 +0,0 @@
-#ifndef REORDER_H
-#define REORDER_H
-
-void Reorder  PROTO((void));
-int  OrderOf  PROTO((char *));
-void OrderFor PROTO((char *, int));
-
-#endif /* REORDER_H */
diff --git a/ghc/utils/hp2ps/Scale.c b/ghc/utils/hp2ps/Scale.c
deleted file mode 100644
index 32120407b3..0000000000
--- a/ghc/utils/hp2ps/Scale.c
+++ /dev/null
@@ -1,86 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include "Defines.h"
-#include "Dimensions.h"
-#include "Error.h"
-#include "HpFile.h"
-#include "Utilities.h"
-
-/* own stuff */
-#include "Scale.h"
-
-/*
- *	Return the maximum combined height that all the sample
- *	curves will reach. This (absolute) figure can then be 
- *	used to scale the samples automatically so that they
- *	fit on the page.
- */
-
-floatish
-MaxCombinedHeight()
-{
-    intish i;
-    intish j;
-    floatish mx;
-    int bucket;
-    floatish value;
-    struct chunk* ch;
-    floatish *maxima; 
-
-    maxima = (floatish*) xmalloc(nsamples * sizeof(floatish));
-    for (i = 0; i < nsamples; i++) {
-        maxima[ i ] = 0.0;
-    }   
-
-    for (i = 0; i < nidents; i++) {
-        for (ch = identtable[i]->chk; ch; ch = ch->next) {
-            for (j = 0; j < ch->nd; j++) {
-                bucket = ch->d[j].bucket;
-                value  = ch->d[j].value;
-		if (bucket >= nsamples)
-		    Disaster("bucket out of range");
-                maxima[ bucket ] += value;
-            }   
-        }    
-    }    
-
-    for (mx = maxima[ 0 ], i = 0; i < nsamples; i++) {
-        if (maxima[ i ] > mx) mx = maxima[ i ];
-    } 
-
-    free(maxima);
-    return mx;
-}
-
-
-
-/*
- *	Scale the values from the samples so that they will fit on 
- *	the page.	
- */
-
-extern floatish xrange;
-extern floatish yrange;
-
-void
-Scale()
-{
-    intish i;
-    intish j;
-    floatish sf;
-    struct chunk* ch;
-
-    if (yrange == 0.0)		/* no samples */
-	return;
-
-    sf = graphheight / yrange; 
-
-    for (i = 0; i < nidents; i++) {
-        for (ch = identtable[i]->chk; ch; ch = ch->next) {
-            for (j = 0; j < ch->nd; j++) {
-	        ch->d[j].value = ch->d[j].value * sf;
-            }    
-        }    
-    }
-}
diff --git a/ghc/utils/hp2ps/Scale.h b/ghc/utils/hp2ps/Scale.h
deleted file mode 100644
index 0c19d6c3c0..0000000000
--- a/ghc/utils/hp2ps/Scale.h
+++ /dev/null
@@ -1,7 +0,0 @@
-#ifndef SCALE_H
-#define SCALE_H
-
-floatish MaxCombinedHeight PROTO((void));
-void     Scale PROTO((void));
-
-#endif /* SCALE_H */
diff --git a/ghc/utils/hp2ps/Shade.c b/ghc/utils/hp2ps/Shade.c
deleted file mode 100644
index 9e3274bf69..0000000000
--- a/ghc/utils/hp2ps/Shade.c
+++ /dev/null
@@ -1,130 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include "Defines.h"
-#include "Error.h"
-#include "Utilities.h"
-
-/* own stuff */
-#include "Shade.h"
-
-static struct shade {
-	char* ident;
-	floatish shade;
-} *shademap;
-
-static int shademapmax = 0;
-static int shademapindex = 0;
-
-/*
- *	Set the shade to be used for "ident" to "shade".
- */
-
-void
-ShadeFor(ident, shade)
-  char* ident; 
-  floatish shade;
-{
-    if (! shademap) {
-	shademapmax = (nidents > TWENTY ? nidents : TWENTY) * 2;
-	         /* Assume nidents read is indication of the No of
-		    idents in the .aux file (*2 for good luck) */
-	         /* NB *2 is needed as .aux and .hp elements may differ */
-	shademap = xmalloc(shademapmax * sizeof(struct shade));
-    }
-
-    if (shademapindex < shademapmax) {
-	shademap[ shademapindex ].ident = copystring(ident);
-	shademap[ shademapindex ].shade = shade;
-	shademapindex++;
-    } else {
-	Disaster("shade map overflow");
-    }
-}
-
-/*
- *	Get the shade to be used for "ident" if there is one. 
- *	Otherwise, think of a new one.
- */
-
-static floatish ThinkOfAShade PROTO((void));	/* forward */
-
-floatish
-ShadeOf(ident)
-  char* ident;
-{
-    int i;
-    floatish shade;
-
-    for (i = 0; i < shademapindex; i++) {
-	if (strcmp(shademap[i].ident, ident) == 0) {	/* got it */
-	    return(shademap[i].shade);
-	}
-    }
-
-    shade = ThinkOfAShade();
-
-    ShadeFor(ident, shade);
-
-    return shade; 
-}
-
-
-
-#define N_MONO_SHADES 10 
-
-static floatish m_shades[ N_MONO_SHADES ] = {
-    0.00000, 0.20000, 0.60000, 0.30000, 0.90000, 
-    0.40000, 1.00000, 0.70000, 0.50000,  0.80000
-};
-
-#define N_COLOUR_SHADES 27
-
-/* HACK: 0.100505 means 100% red, 50% green, 50% blue */
-
-static floatish c_shades[ N_COLOUR_SHADES ] = {
-    0.000000, 0.000010, 0.001000, 0.001010, 0.100000,
-    0.100010, 0.101000, 0.101010, 0.000005, 0.000500,
-    0.000510, 0.001005, 0.050000, 0.050010, 0.051000,
-    0.051010, 0.100005, 0.100500, 0.100510, 0.101005,
-    0.000505, 0.050005, 0.050500, 0.050510, 0.051005,
-    0.100505, 0.050505
-};
-
-static floatish
-ThinkOfAShade()
-{
-    static int thisshade = -1;
-
-    thisshade++;
-    return cflag ?
-	c_shades[ thisshade % N_COLOUR_SHADES ] :
-	m_shades[ thisshade % N_MONO_SHADES   ] ;
-}
-
-static floatish
-extract_colour(shade,factor)
-  floatish shade;
-  intish factor;
-{
-    intish i,j;
-
-    i = (int)(shade * factor);
-    j = i / 100;
-    return (i - j * 100) / 10.0;
-}
-
-void
-SetPSColour(shade)
-  floatish shade;
-{
-    if (cflag) {
-	fprintf(psfp, "%f %f %f setrgbcolor\n",
-		extract_colour(shade, (intish)100),
-		extract_colour(shade, (intish)10000),
-		extract_colour(shade, (intish)1000000));
-    } else {
-	fprintf(psfp, "%f setgray\n", shade);
-    }
-}
diff --git a/ghc/utils/hp2ps/Shade.h b/ghc/utils/hp2ps/Shade.h
deleted file mode 100644
index 0e49c90d04..0000000000
--- a/ghc/utils/hp2ps/Shade.h
+++ /dev/null
@@ -1,8 +0,0 @@
-#ifndef SHADE_H
-#define SHADE_H
-
-floatish ShadeOf  PROTO((char *));
-void     ShadeFor PROTO((char *, floatish));
-void     SetPSColour PROTO((floatish));
-
-#endif /* SHADE_H */
diff --git a/ghc/utils/hp2ps/TopTwenty.c b/ghc/utils/hp2ps/TopTwenty.c
deleted file mode 100644
index bbb6be4390..0000000000
--- a/ghc/utils/hp2ps/TopTwenty.c
+++ /dev/null
@@ -1,72 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include "Defines.h"
-#include "Error.h"
-#include "HpFile.h"
-#include "Utilities.h"
-
-/* own stuff */
-#include "TopTwenty.h"
-
-/*
- *	We only have room in the key for a maximum of 20 identifiers. 
- *	We therefore choose to keep the top 20 bands --- these will 
- *	be the most important ones, since this pass is performed after 
- *	the threshold and standard deviation passes. If there are more 
- *	than 20 bands, the excess are gathered together as an "OTHER" ]
- *	band which appears as band 20.
- */
-
-void
-TopTwenty()
-{
-    intish i;
-    intish j;
-    intish compact;
-    intish bucket;
-    floatish value;
-    struct entry* en;
-    struct chunk* ch;
-    floatish *other; 
-
-    i = nidents;
-    if (i <= TWENTY) return;	/* nothing to do! */
-
-    other = (floatish*) xmalloc(nsamples * sizeof(floatish));
-    /* build a list of samples for "OTHER" */ 
-
-    compact = (i - TWENTY) + 1;
-
-    for (i = 0; i < nsamples; i++) {
-        other[ i ] = 0.0;
-    }   
-
-    for (i = 0; i < compact && i < nidents; i++) {
-        for (ch = identtable[i]->chk; ch; ch = ch->next) {
-            for (j = 0; j < ch->nd; j++) {
-                bucket = ch->d[j].bucket;
-                value  = ch->d[j].value;
-		if (bucket >= nsamples)
-		    Disaster("bucket out of range");
-                other[ bucket ] += value;
-            }   
-        }    
-    }    
-
-    en = MakeEntry("OTHER");
-    en->next = 0;
-
-    for (i = 0; i < nsamples; i++) {
-    	StoreSample(en, i, other[i]);
-    }
-
-    /* slide samples down */
-    for (i = compact; i < nidents; i++) {
-        identtable[i-compact+1] = identtable[i];
-    }
-
-    nidents = TWENTY;
-    identtable[0] = en;
-    free(other);
-}
diff --git a/ghc/utils/hp2ps/TopTwenty.h b/ghc/utils/hp2ps/TopTwenty.h
deleted file mode 100644
index 53a7aed509..0000000000
--- a/ghc/utils/hp2ps/TopTwenty.h
+++ /dev/null
@@ -1,6 +0,0 @@
-#ifndef TOP_TWENTY_H
-#define TOP_TWENTY_H
-
-void TopTwenty PROTO((void));
-
-#endif /* TOP_TWENTY_H */
diff --git a/ghc/utils/hp2ps/TraceElement.c b/ghc/utils/hp2ps/TraceElement.c
deleted file mode 100644
index c14062dced..0000000000
--- a/ghc/utils/hp2ps/TraceElement.c
+++ /dev/null
@@ -1,96 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include "Defines.h"
-#include "HpFile.h"
-#include "Error.h"
-#include "Utilities.h"
-
-/* own stuff */
-#include "TraceElement.h"
-
-/*
- *	Compute the total volume for each identifier, and the grand 
- *	total of these totals. The identifiers whose totals when 
- *	added together amount to less that a threshold percentage 
- *      (default 1%) of the grand total are considered to be ``trace
- *	elements'' and they are thrown away.	
- */
-
-extern floatish thresholdpercent;
-
-void TraceElement()
-{
-    intish i;
-    intish j;
-    struct chunk* ch;
-    floatish grandtotal;
-    intish   min;
-    floatish t;
-    floatish p;
-    struct entry* e;
-    intish *totals; 
-
-    totals = (intish *) xmalloc(nidents * sizeof(intish));
-
-    /* find totals */
-
-    for (i = 0; i < nidents; i++) {
-	totals[ i ] = 0;
-    }
- 
-    for (i = 0; i < nidents; i++) {
-        for (ch = identtable[i]->chk; ch; ch = ch->next) {
-	    for (j = 0; j < ch->nd; j++) {
-	        totals[ i ] += ch->d[j].value; 
-	    }
-        }
-    }    
-
-    /* sort on the basis of total */
-
-    for (i = 0; i < nidents-1; i++) {
-        min = i;
-        for (j = i+1; j < nidents; j++) {
-            if (totals[ j ] < totals[ min ]) {
-                min = j;
-            }
-        }    
-
-        t = totals[ min ];
-        totals[ min ] = totals[ i ];
-        totals[ i ] = t;
-
-        e = identtable[ min ];
-        identtable[ min ] = identtable[ i ];
-        identtable[ i ] = e;
-    }
-
-
-    /* find the grand total (NB: can get *BIG*!) */
-
-    grandtotal = 0.0;
-
-    for (i = 0; i < nidents; i++) {
-        grandtotal += (floatish) totals[ i ];
-    }
-
-    t = 0.0;	/* cumulative percentage */
-   
-    for (i = 0; i < nidents; i++) {
-        p = (100.0 * (floatish) totals[i]) / grandtotal;
-	t = t + p; 
-	if (t >= THRESHOLD_PERCENT) {
-	    break;
-	}
-    }
-
-    /* identifiers from 0 to i-1 should be removed */
-    for (j = 0; i < nidents; i++, j++) {
-	identtable[j] = identtable[i]; 
-    }
-
-    nidents = j;
-
-    free(totals);
-}
diff --git a/ghc/utils/hp2ps/TraceElement.h b/ghc/utils/hp2ps/TraceElement.h
deleted file mode 100644
index d843392a23..0000000000
--- a/ghc/utils/hp2ps/TraceElement.h
+++ /dev/null
@@ -1,6 +0,0 @@
-#ifndef TRACE_ELEMENT_H
-#define TRACE_ELEMENT_H
-
-void TraceElement PROTO((void));
-
-#endif /* TRACE_ELEMENT_H */
diff --git a/ghc/utils/hp2ps/Utilities.c b/ghc/utils/hp2ps/Utilities.c
deleted file mode 100644
index c9fb612f0e..0000000000
--- a/ghc/utils/hp2ps/Utilities.c
+++ /dev/null
@@ -1,132 +0,0 @@
-#include "Main.h"
-#include <stdio.h>
-#include <string.h>
-#include "Error.h"
-
-extern void* malloc();
-
-char*
-Basename(name)
-  char* name;
-{
-    char* t;
-
-    t = name;
-
-    while (*name) {
-        if (*name == '/') {
-            t = name+1;
-        }
-        name++;
-    }
-
-    return t;
-}
-
-void
-DropSuffix(name, suffix)
-  char* name; char* suffix;
-{
-    char* t;
-
-    t = (char*) 0;
-
-    while (*name) {
-	if (*name == '.') {
-	     t = name;
-	}
-	name++;
-    }
-
-    if (t != (char*) 0 && strcmp(t, suffix) == 0) {
-	*t = '\0';
-    }
-}
-
-FILE*
-OpenFile(s, mode)
-  char* s; char* mode;
-{
-    FILE* r;
-
-    if ((r = fopen(s, mode)) == NULL) {
-	/*NOTREACHED*/
-	Error("cannot open %s", s);
-    }
-
-    return r;
-}
-
-
-#define ONETHOUSAND     1000
-
-/*
- *	Print a positive integer with commas
- */
-
-void
-CommaPrint(fp,n)
-  FILE* fp;
-  intish n;
-{
-    if (n < ONETHOUSAND) {
-        fprintf(fp, "%d", (int)n);
-    } else {
-        CommaPrint(fp, n / ONETHOUSAND);
-        fprintf(fp, ",%03d", (int)(n % ONETHOUSAND));
-    }
-}
-
-void *
-xmalloc(n)
-  size_t n;
-{
-    void *r;
-
-    r = (void*) malloc(n);
-    if (!r) {
-	/*NOTREACHED*/
-	Disaster("%s, sorry, out of memory", hpfile);
-    }
-    return r;
-}
-
-void *
-xrealloc(p, n)
-  void *p;
-  size_t n;
-{
-    void *r;
-    extern void *realloc();
-
-    r = realloc(p, n);
-    if (!r) {
-	/*NOTREACHED*/
-	Disaster("%s, sorry, out of memory", hpfile);
-    }
-    return r;
-}
-
-char *
-copystring(s)
-  char *s;
-{
-    char *r;
-
-    r = (char*) xmalloc(strlen(s)+1);
-    strcpy(r, s);
-    return r;
-}
-
-char *
-copystring2(s, t)
-  char *s, *t;
-{
-    char *r;
-
-    r = (char*) xmalloc(strlen(s)+strlen(t)+1);
-    strcpy(r, s);
-    strcat(r, t);
-    return r;
-}
-
diff --git a/ghc/utils/hp2ps/Utilities.h b/ghc/utils/hp2ps/Utilities.h
deleted file mode 100644
index 10776d9613..0000000000
--- a/ghc/utils/hp2ps/Utilities.h
+++ /dev/null
@@ -1,13 +0,0 @@
-#ifndef UTILITIES_H
-#define UTILITIES_H
-
-char* Basename    PROTO((char *));
-void  DropSuffix  PROTO((char *, char *));
-FILE* OpenFile    PROTO((char *, char *));
-void  CommaPrint  PROTO((FILE *, intish));
-char *copystring  PROTO((char *));
-char *copystring2 PROTO((char *, char *));
-void *xmalloc	 PROTO((size_t));
-void *xrealloc	 PROTO((void *, size_t));
-
-#endif /* UTILITIES_H */
diff --git a/ghc/utils/hp2ps/hp2ps.1 b/ghc/utils/hp2ps/hp2ps.1
deleted file mode 100644
index fd0bca0234..0000000000
--- a/ghc/utils/hp2ps/hp2ps.1
+++ /dev/null
@@ -1,145 +0,0 @@
-.\" man page for hp2ps
-.ds PS P\s-2OST\s+2S\s-2CRIPT\s+2
-.\" typeset examples in fixed size font as indented paragraph
-.de Ex
-.sp
-.RS
-.nf
-.ft C
-..
-.de Xe
-.RE
-.sp
-.fi
-..
-.TH HP2PS 1 "18 April 1992" 
-.SH NAME
-hp2ps \- convert a heap profile to a \*(PS graph
-.SH SYNOPSIS
-.B hp2ps
-[flags] [file][.hp] 
-.SH DESCRIPTION
-The program
-.B hp2ps
-converts a heap profile stored in
-.IR file
-into a \*(PS graph, sending the result to
-.IR file.ps.
-By convention, files to be processed by 
-.B hp2ps
-have a 
-.I .hp
-extension. However, for compatibility with older versions of
-.B hp2ps, 
-this extension can be omitted. If 
-.IR file
-is omitted entirely, then the program behaves as a filter.
-.SH OPTIONS
-The flags are:
-.IP "\fB\-d\fP"
-In order to make graphs more readable,
-.B hp2ps
-sorts the shaded bands for each identifier. The default sort ordering is for
-the bands with the largest area to be stacked on top of the smaller ones.
-The
-.B \-d
-option causes rougher bands (those reprsenting series of values with the
-largest standard deviations) to be stacked on top of smoother ones.
-.IP "\fB\-b\fP"
-Normally,
-.B hp2ps
-puts the title of the graph in a small box at the top of the page. However, 
-if the JOB string is too long to fit in a small box (more than 35 characters), 
-then
-.B hp2ps
-will choose to use a big box instead. The
-.B \-b
-option forces
-.B hp2ps
-to use a big box.
-.IP "\fB\-e\fP \fIfloat\fP[in|mm|pt]"
-Generate encapsulated \*(PS suitable for inclusion in LaTeX documents.
-Usually, the \*(PS graph is drawn in landscape mode in an area 
-9 inches wide by 6 inches high, and
-.B hp2ps
-arranges for this area to be approximately centered on a sheet of a4
-paper. This format is convenient of studying the graph in detail, but
-it is unsuitable for inclusion in LaTeX documents. The 
-.B \-e 
-option causes the graph to be drawn in portrait mode, with 
-.I float
-specifying the width in inches, millimetres or points (the default).
-The resulting \*(PS file conforms to the  
-.I "Encapsulated Post Script"
-(EPS) convention, and it can be included in a LaTeX document using Rokicki's 
-dvi-to-\*(PS converter
-.B dvips.
-.B hp2ps
-requires the width to exceed 2 inches.
-.IP "\fB\-g\fP" 
-Create output suitable for the
-.B gs
-\*(PS previewer (or similar). In this case the graph is printed in portrait
-mode without scaling. The output is unsuitable for a laser printer.
-.IP "\fB\-p\fP"
-Use previous parameters. By default, the \*(PS graph is automatically
-scaled both horizontally and vertically so that it fills the page.
-However, when preparing a seires of graphs for use in a presentation, 
-it is often useful to draw a new graph using the same scale, shading and
-ordering as a previous one. The
-.B \-p
-flag causes the graph to be drawn using the parameters determined by
-a previous run of 
-.B hp2ps
-on
-.IR file.  
-.IP "\fB\-s\fP"
-Use a small box for the title.
-.IP "\fB\-y\fP"
-Draw the graph in the traditional York style, ignoring marks.
-.IP "\fB\-?\fP"
-Print out usage information. 
-.SH "INPUT FORMAT"
-The format of a heap profile is best described by example:
-.Ex
-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 
-
-.Xe
-.SH "SEE ALSO"
-dvips(1), latex(1), hbchp (1), lmlchp(1)
-.br
-C. Runciman and D. Wakeling,
-.I
-Heap Profiling for Lazy Functional Languages, YCS-172, University of York, 1992
-.SH NOTES
-\*(PS is a registered trademark of Adobe Systems Incorporated.
-.SH AUTHOR
-David Wakeling of the University of York. 
diff --git a/ghc/utils/hp2ps/makefile.original b/ghc/utils/hp2ps/makefile.original
deleted file mode 100644
index a625149552..0000000000
--- a/ghc/utils/hp2ps/makefile.original
+++ /dev/null
@@ -1,42 +0,0 @@
-OBJS= 	\
-	AuxFile.o	\
-	Axes.o		\
-	AreaBelow.o	\
-	Curves.o 	\
-	Deviation.o	\
-	Dimensions.o	\
-	Error.o 	\
-	HpFile.o	\
-	Key.o		\
-	Main.o 		\
-	Marks.o		\
-	TopTwenty.o	\
-	TraceElement.o	\
-	PsFile.o 	\
-	Reorder.o	\
-	Scale.o		\
-	Shade.o 	\
-	Utilities.o
-
-# Please set MATHLIB and BIN appropriately. I don't need MATHLIB on my machine,
-# but you may.
-
-MATHLIB = -lm
-
-DSTBIN = /n/Numbers/usr/lml/lml-0.997.4hp/sun3/bin
-
-CC= cc # gcc -Wall
-CFLAGS= -g
-LDFLAGS= ${STATICFLAG}
-
-TARGET=hp2ps
-
-${TARGET}: ${OBJS}
-	${CC} -o ${TARGET} ${CCFLAGS} ${LDFLAGS} ${OBJS} ${MATHLIB}
-
-install: ${TARGET}
-	mv ${TARGET} ${DSTBIN}/${TARGET}
-	chmod 555 ${DSTBIN}/${TARGET} 
-
-clean:
-	rm -f core *.o ${TARGET}
diff --git a/ghc/utils/hsc2hs/Main.hs b/ghc/utils/hsc2hs/Main.hs
deleted file mode 100644
index 4b39e4a7bb..0000000000
--- a/ghc/utils/hsc2hs/Main.hs
+++ /dev/null
@@ -1,938 +0,0 @@
-{-# OPTIONS -fffi -cpp #-}
-
-------------------------------------------------------------------------
--- Program for converting .hsc files to .hs files, by converting the
--- file into a C program which is run to generate the Haskell source.
--- Certain items known only to the C compiler can then be used in
--- the Haskell module; for example #defined constants, byte offsets
--- within structures, etc.
---
--- See the documentation in the Users' Guide for more details.
-
-#if defined(__GLASGOW_HASKELL__) && !defined(BUILD_NHC)
-#include "../../includes/ghcconfig.h"
-#endif
-
-#if __GLASGOW_HASKELL__ >= 504 || __NHC__ >= 114 || __HUGS__
-import System.Console.GetOpt
-#else
-import GetOpt
-#endif
-
-import System        (getProgName, getArgs, ExitCode(..), exitWith)
-import Directory     (removeFile,doesFileExist)
-import Monad         (MonadPlus(..), liftM, liftM2, when)
-import Char          (isAlpha, isAlphaNum, isSpace, isDigit, toUpper, intToDigit, ord)
-import List          (intersperse, isSuffixOf)
-import IO            (hPutStr, hPutStrLn, stderr)
-
-#if defined(mingw32_HOST_OS) && !__HUGS__
-import Foreign
-#if __GLASGOW_HASKELL__ >= 504 || __NHC__ >= 114
-import Foreign.C.String
-#else
-import CString
-#endif
-#endif
-
-
-#if __GLASGOW_HASKELL__ >= 604
-import System.Process           ( runProcess, waitForProcess )
-import System.IO                ( openFile, IOMode(..), hClose )
-#define HAVE_runProcess
-#endif
-
-#if defined(__GLASGOW_HASKELL__) && !defined(BUILD_NHC)
-import Compat.RawSystem 	( rawSystem )
-#define HAVE_rawSystem
-#elif __HUGS__ || __NHC__ >= 117
-import System.Cmd	 	( rawSystem )
-#define HAVE_rawSystem
-#endif
-
-#if !defined(HAVE_runProcess) || !defined(HAVE_rawSystem)
--- we need system
-#if __HUGS__ || __NHC__ >= 117 || __GLASGOW_HASKELL__ >= 600
-import System.Cmd	 	( system )
-#else
-import System                   ( system )
-#endif
-#endif
-
-version :: String
-version = "hsc2hs version 0.66\n"
-
-data Flag
-    = Help
-    | Version
-    | Template  String
-    | Compiler  String
-    | Linker    String
-    | CompFlag  String
-    | LinkFlag  String
-    | NoCompile
-    | Include   String
-    | Define    String (Maybe String)
-    | Output    String
-    | Verbose
-
-template_flag :: Flag -> Bool
-template_flag (Template _) = True
-template_flag _		   = False
-
-include :: String -> Flag
-include s@('\"':_) = Include s
-include s@('<' :_) = Include s
-include s          = Include ("\""++s++"\"")
-
-define :: String -> Flag
-define s = case break (== '=') s of
-    (name, [])      -> Define name Nothing
-    (name, _:value) -> Define name (Just value)
-
-options :: [OptDescr Flag]
-options = [
-    Option ['o'] ["output"]     (ReqArg Output     "FILE")
-        "name of main output file",
-    Option ['t'] ["template"]   (ReqArg Template   "FILE")
-        "template file",
-    Option ['c'] ["cc"]         (ReqArg Compiler   "PROG")
-        "C compiler to use",
-    Option ['l'] ["ld"]         (ReqArg Linker     "PROG")
-        "linker to use",
-    Option ['C'] ["cflag"]      (ReqArg CompFlag   "FLAG")
-        "flag to pass to the C compiler",
-    Option ['I'] []             (ReqArg (CompFlag . ("-I"++)) "DIR")
-        "passed to the C compiler",
-    Option ['L'] ["lflag"]      (ReqArg LinkFlag   "FLAG")
-        "flag to pass to the linker",
-    Option ['i'] ["include"]    (ReqArg include    "FILE")
-        "as if placed in the source",
-    Option ['D'] ["define"]     (ReqArg define "NAME[=VALUE]")
-        "as if placed in the source",
-    Option []    ["no-compile"] (NoArg  NoCompile)
-        "stop after writing *_hsc_make.c",
-    Option ['v'] ["verbose"]    (NoArg  Verbose)
-        "dump commands to stderr",
-    Option ['?'] ["help"]       (NoArg  Help)
-        "display this help and exit",
-    Option ['V'] ["version"]    (NoArg  Version)
-        "output version information and exit" ]
-    
-
-main :: IO ()
-main = do
-    prog <- getProgramName
-    let header = "Usage: "++prog++" [OPTIONS] INPUT.hsc [...]\n"
-    args <- getArgs
-    let (flags, files, errs) = getOpt Permute options args
-
-	-- If there is no Template flag explicitly specified, try
-	-- to find one by looking near the executable.  This only
-	-- works on Win32 or Hugs (getExecDir). On Unix, there's a wrapper 
-	-- script which specifies an explicit template flag.
-    flags_w_tpl <- if any template_flag flags then
-			return flags
-		   else	
-#ifdef __HUGS__
-			do mb_path <- getExecDir "/Main.hs"
-#else
-			do mb_path <- getExecDir "/bin/hsc2hs.exe"
-#endif
-			   add_opt <-
-			    case mb_path of
-			      Nothing   -> return id
-			      Just path -> do
-				let templ = path ++ "/template-hsc.h"
-				flg <- doesFileExist templ
-				if flg 
-				 then return ((Template templ):)
-				 else return id
-		           return (add_opt flags) 
-    case (files, errs) of
-        (_, _)
-            | any isHelp    flags_w_tpl -> bye (usageInfo header options)
-            | any isVersion flags_w_tpl -> bye version
-            where
-            isHelp    Help    = True; isHelp    _ = False
-            isVersion Version = True; isVersion _ = False
-        ((_:_), []) -> mapM_ (processFile flags_w_tpl) files
-        (_,     _ ) -> die (concat errs ++ usageInfo header options)
-
-getProgramName :: IO String
-getProgramName = liftM (`withoutSuffix` "-bin") getProgName
-   where str `withoutSuffix` suff
-            | suff `isSuffixOf` str = take (length str - length suff) str
-            | otherwise             = str
-
-bye :: String -> IO a
-bye s = putStr s >> exitWith ExitSuccess
-
-die :: String -> IO a
-die s = hPutStr stderr s >> exitWith (ExitFailure 1)
-
-processFile :: [Flag] -> String -> IO ()
-processFile flags name 
-  = do let file_name = dosifyPath name
-       s <- readFile file_name
-       case parser of
-    	   Parser p -> case p (SourcePos file_name 1) s of
-    	       Success _ _ _ toks -> output flags file_name toks
-    	       Failure (SourcePos name' line) msg ->
-    		   die (name'++":"++show line++": "++msg++"\n")
-
-------------------------------------------------------------------------
--- A deterministic parser which remembers the text which has been parsed.
-
-newtype Parser a = Parser (SourcePos -> String -> ParseResult a)
-
-data ParseResult a = Success !SourcePos String String a
-                   | Failure !SourcePos String
-
-data SourcePos = SourcePos String !Int
-
-updatePos :: SourcePos -> Char -> SourcePos
-updatePos pos@(SourcePos name line) ch = case ch of
-    '\n' -> SourcePos name (line + 1)
-    _    -> pos
-
-instance Monad Parser where
-    return a = Parser $ \pos s -> Success pos [] s a
-    Parser m >>= k =
-        Parser $ \pos s -> case m pos s of
-            Success pos' out1 s' a -> case k a of
-                Parser k' -> case k' pos' s' of
-                    Success pos'' out2 imp'' b ->
-                        Success pos'' (out1++out2) imp'' b
-                    Failure pos'' msg -> Failure pos'' msg
-            Failure pos' msg -> Failure pos' msg
-    fail msg = Parser $ \pos _ -> Failure pos msg
-
-instance MonadPlus Parser where
-    mzero                     = fail "mzero"
-    Parser m `mplus` Parser n =
-        Parser $ \pos s -> case m pos s of
-            success@(Success _ _ _ _) -> success
-            Failure _ _               -> n pos s
-
-getPos :: Parser SourcePos
-getPos = Parser $ \pos s -> Success pos [] s pos
-
-setPos :: SourcePos -> Parser ()
-setPos pos = Parser $ \_ s -> Success pos [] s ()
-
-message :: Parser a -> String -> Parser a
-Parser m `message` msg =
-    Parser $ \pos s -> case m pos s of
-        success@(Success _ _ _ _) -> success
-        Failure pos' _            -> Failure pos' msg
-
-catchOutput_ :: Parser a -> Parser String
-catchOutput_ (Parser m) =
-    Parser $ \pos s -> case m pos s of
-        Success pos' out s' _ -> Success pos' [] s' out
-        Failure pos' msg      -> Failure pos' msg
-
-fakeOutput :: Parser a -> String -> Parser a
-Parser m `fakeOutput` out =
-    Parser $ \pos s -> case m pos s of
-        Success pos' _ s' a -> Success pos' out s' a
-        Failure pos' msg    -> Failure pos' msg
-
-lookAhead :: Parser String
-lookAhead = Parser $ \pos s -> Success pos [] s s
-
-satisfy :: (Char -> Bool) -> Parser Char
-satisfy p =
-    Parser $ \pos s -> case s of
-        c:cs | p c -> Success (updatePos pos c) [c] cs c
-        _          -> Failure pos "Bad character"
-
-char_ :: Char -> Parser ()
-char_ c = do
-    satisfy (== c) `message` (show c++" expected")
-    return ()
-
-anyChar_ :: Parser ()
-anyChar_ = do
-    satisfy (const True) `message` "Unexpected end of file"
-    return ()
-
-any2Chars_ :: Parser ()
-any2Chars_ = anyChar_ >> anyChar_
-
-many :: Parser a -> Parser [a]
-many p = many1 p `mplus` return []
-
-many1 :: Parser a -> Parser [a]
-many1 p = liftM2 (:) p (many p)
-
-many_ :: Parser a -> Parser ()
-many_ p = many1_ p `mplus` return ()
-
-many1_ :: Parser a -> Parser ()
-many1_ p = p >> many_ p
-
-manySatisfy, manySatisfy1 :: (Char -> Bool) -> Parser String
-manySatisfy  = many  . satisfy
-manySatisfy1 = many1 . satisfy
-
-manySatisfy_, manySatisfy1_ :: (Char -> Bool) -> Parser ()
-manySatisfy_  = many_  . satisfy
-manySatisfy1_ = many1_ . satisfy
-
-------------------------------------------------------------------------
--- Parser of hsc syntax.
-
-data Token
-    = Text    SourcePos String
-    | Special SourcePos String String
-
-parser :: Parser [Token]
-parser = do
-    pos <- getPos
-    t <- catchOutput_ text
-    s <- lookAhead
-    rest <- case s of
-        []  -> return []
-        _:_ -> liftM2 (:) (special `fakeOutput` []) parser
-    return (if null t then rest else Text pos t : rest)
-
-text :: Parser ()
-text = do
-    s <- lookAhead
-    case s of
-        []        -> return ()
-        c:_ | isAlpha c || c == '_' -> do
-            anyChar_
-            manySatisfy_ (\c' -> isAlphaNum c' || c' == '_' || c' == '\'')
-            text
-        c:_ | isHsSymbol c -> do
-            symb <- catchOutput_ (manySatisfy_ isHsSymbol)
-            case symb of
-                "#" -> return ()
-                '-':'-':symb' | all (== '-') symb' -> do
-                    return () `fakeOutput` symb
-                    manySatisfy_ (/= '\n')
-                    text
-                _ -> do
-                    return () `fakeOutput` unescapeHashes symb
-                    text
-        '\"':_    -> do anyChar_; hsString '\"'; text
-        '\'':_    -> do anyChar_; hsString '\''; text
-        '{':'-':_ -> do any2Chars_; linePragma `mplus` hsComment; text
-        _:_       -> do anyChar_; text
-
-hsString :: Char -> Parser ()
-hsString quote = do
-    s <- lookAhead
-    case s of
-        []               -> return ()
-        c:_ | c == quote -> anyChar_
-        '\\':c:_
-            | isSpace c  -> do
-                anyChar_
-                manySatisfy_ isSpace
-                char_ '\\' `mplus` return ()
-                hsString quote
-            | otherwise  -> do any2Chars_; hsString quote
-        _:_              -> do anyChar_; hsString quote
-
-hsComment :: Parser ()
-hsComment = do
-    s <- lookAhead
-    case s of
-        []        -> return ()
-        '-':'}':_ -> any2Chars_
-        '{':'-':_ -> do any2Chars_; hsComment; hsComment
-        _:_       -> do anyChar_; hsComment
-
-linePragma :: Parser ()
-linePragma = do
-    char_ '#'
-    manySatisfy_ isSpace
-    satisfy (\c -> c == 'L' || c == 'l')
-    satisfy (\c -> c == 'I' || c == 'i')
-    satisfy (\c -> c == 'N' || c == 'n')
-    satisfy (\c -> c == 'E' || c == 'e')
-    manySatisfy1_ isSpace
-    line <- liftM read $ manySatisfy1 isDigit
-    manySatisfy1_ isSpace
-    char_ '\"'
-    name <- manySatisfy (/= '\"')
-    char_ '\"'
-    manySatisfy_ isSpace
-    char_ '#'
-    char_ '-'
-    char_ '}'
-    setPos (SourcePos name (line - 1))
-
-isHsSymbol :: Char -> Bool
-isHsSymbol '!' = True; isHsSymbol '#' = True; isHsSymbol '$'  = True
-isHsSymbol '%' = True; isHsSymbol '&' = True; isHsSymbol '*'  = True
-isHsSymbol '+' = True; isHsSymbol '.' = True; isHsSymbol '/'  = True
-isHsSymbol '<' = True; isHsSymbol '=' = True; isHsSymbol '>'  = True
-isHsSymbol '?' = True; isHsSymbol '@' = True; isHsSymbol '\\' = True
-isHsSymbol '^' = True; isHsSymbol '|' = True; isHsSymbol '-'  = True
-isHsSymbol '~' = True
-isHsSymbol _   = False
-
-unescapeHashes :: String -> String
-unescapeHashes []          = []
-unescapeHashes ('#':'#':s) = '#' : unescapeHashes s
-unescapeHashes (c:s)       = c   : unescapeHashes s
-
-lookAheadC :: Parser String
-lookAheadC = liftM joinLines lookAhead
-    where
-    joinLines []            = []
-    joinLines ('\\':'\n':s) = joinLines s
-    joinLines (c:s)         = c : joinLines s
-
-satisfyC :: (Char -> Bool) -> Parser Char
-satisfyC p = do
-    s <- lookAhead
-    case s of
-        '\\':'\n':_ -> do any2Chars_ `fakeOutput` []; satisfyC p
-        _           -> satisfy p
-
-charC_ :: Char -> Parser ()
-charC_ c = do
-    satisfyC (== c) `message` (show c++" expected")
-    return ()
-
-anyCharC_ :: Parser ()
-anyCharC_ = do
-    satisfyC (const True) `message` "Unexpected end of file"
-    return ()
-
-any2CharsC_ :: Parser ()
-any2CharsC_ = anyCharC_ >> anyCharC_
-
-manySatisfyC :: (Char -> Bool) -> Parser String
-manySatisfyC = many . satisfyC
-
-manySatisfyC_ :: (Char -> Bool) -> Parser ()
-manySatisfyC_ = many_ . satisfyC
-
-special :: Parser Token
-special = do
-    manySatisfyC_ (\c -> isSpace c && c /= '\n')
-    s <- lookAheadC
-    case s of
-        '{':_ -> do
-            anyCharC_
-            manySatisfyC_ isSpace
-            sp <- keyArg (== '\n')
-            charC_ '}'
-            return sp
-        _ -> keyArg (const False)
-
-keyArg :: (Char -> Bool) -> Parser Token
-keyArg eol = do
-    pos <- getPos
-    key <- keyword `message` "hsc keyword or '{' expected"
-    manySatisfyC_ (\c' -> isSpace c' && c' /= '\n' || eol c')
-    arg <- catchOutput_ (argument eol)
-    return (Special pos key arg)
-
-keyword :: Parser String
-keyword = do
-    c  <- satisfyC (\c' -> isAlpha c' || c' == '_')
-    cs <- manySatisfyC (\c' -> isAlphaNum c' || c' == '_')
-    return (c:cs)
-
-argument :: (Char -> Bool) -> Parser ()
-argument eol = do
-    s <- lookAheadC
-    case s of
-        []          -> return ()
-        c:_ | eol c -> do anyCharC_;               argument eol
-        '\n':_      -> return ()
-        '\"':_      -> do anyCharC_; cString '\"'; argument eol
-        '\'':_      -> do anyCharC_; cString '\''; argument eol
-        '(':_       -> do anyCharC_; nested ')';   argument eol
-        ')':_       -> return ()
-        '/':'*':_   -> do any2CharsC_; cComment;   argument eol
-        '/':'/':_   -> do
-            any2CharsC_; manySatisfyC_ (/= '\n');  argument eol
-        '[':_       -> do anyCharC_; nested ']';   argument eol
-        ']':_       -> return ()
-        '{':_       -> do anyCharC_; nested '}';   argument eol
-        '}':_       -> return ()
-        _:_         -> do anyCharC_;               argument eol
-
-nested :: Char -> Parser ()
-nested c = do argument (== '\n'); charC_ c
-
-cComment :: Parser ()
-cComment = do
-    s <- lookAheadC
-    case s of
-        []        -> return ()
-        '*':'/':_ -> do any2CharsC_
-        _:_       -> do anyCharC_; cComment
-
-cString :: Char -> Parser ()
-cString quote = do
-    s <- lookAheadC
-    case s of
-        []               -> return ()
-        c:_ | c == quote -> anyCharC_
-        '\\':_:_         -> do any2CharsC_; cString quote
-        _:_              -> do anyCharC_; cString quote
-
-------------------------------------------------------------------------
--- Write the output files.
-
-splitName :: String -> (String, String)
-splitName name =
-    case break (== '/') name of
-        (file, [])       -> ([], file)
-        (dir,  sep:rest) -> (dir++sep:restDir, restFile)
-            where
-            (restDir, restFile) = splitName rest
-
-splitExt :: String -> (String, String)
-splitExt name =
-    case break (== '.') name of
-        (base, [])         -> (base, [])
-        (base, sepRest@(sep:rest))
-            | null restExt -> (base,               sepRest)
-            | otherwise    -> (base++sep:restBase, restExt)
-            where
-            (restBase, restExt) = splitExt rest
-
-output :: [Flag] -> String -> [Token] -> IO ()
-output flags name toks = do
-    
-    (outName, outDir, outBase) <- case [f | Output f <- flags] of
-        [] -> if not (null ext) && last ext == 'c'
-                 then return (dir++base++init ext,  dir, base)
-                 else
-                    if ext == ".hs"
-                       then return (dir++base++"_out.hs", dir, base)
-                       else return (dir++base++".hs",     dir, base)
-              where
-               (dir,  file) = splitName name
-               (base, ext)  = splitExt  file
-        [f] -> let
-            (dir,  file) = splitName f
-            (base, _)    = splitExt file
-            in return (f, dir, base)
-        _ -> onlyOne "output file"
-    
-    let cProgName    = outDir++outBase++"_hsc_make.c"
-        oProgName    = outDir++outBase++"_hsc_make.o"
-        progName     = outDir++outBase++"_hsc_make"
-#if defined(mingw32_HOST_OS) || defined(__CYGWIN32__)
--- This is a real hack, but the quoting mechanism used for calling the C preprocesseor
--- via GHC has changed a few times, so this seems to be the only way...  :-P * * *
-                          ++ ".exe"
-#endif
-	outHFile     = outBase++"_hsc.h"
-        outHName     = outDir++outHFile
-        outCName     = outDir++outBase++"_hsc.c"
-	
-	beVerbose    = any (\ x -> case x of { Verbose -> True; _ -> False}) flags
-
-    let execProgName
-            | null outDir = dosifyPath ("./" ++ progName)
-            | otherwise   = progName
-    
-    let specials = [(pos, key, arg) | Special pos key arg <- toks]
-    
-    let needsC = any (\(_, key, _) -> key == "def") specials
-        needsH = needsC
-    
-    let includeGuard = map fixChar outHName
-            where
-            fixChar c | isAlphaNum c = toUpper c
-                      | otherwise    = '_'
-
-#ifdef __HUGS__
-    compiler <- case [c | Compiler c <- flags] of
-        []  -> return "gcc"
-        [c] -> return c
-        _   -> onlyOne "compiler"
-    
-    linker <- case [l | Linker l <- flags] of
-        []  -> return compiler
-        [l] -> return l
-        _   -> onlyOne "linker"
-#else
-        -- Try locating GHC..on Win32, look in the vicinity of hsc2hs.
-	-- Returns a native-format path
-        locateGhc def = do
-	    mb <- getExecDir "bin/hsc2hs.exe"
-	    case mb of
-	      Nothing -> return def
-	      Just x  -> do
-	         let ghc_path = dosifyPath (x ++ "bin/ghc.exe")
-	         flg <- doesFileExist ghc_path
-		 if flg 
-		  then return ghc_path
-		  else return def
-    
-	-- On a Win32 installation we execute the hsc2hs binary directly, 
-	-- with no --cc flags, so we'll call locateGhc here, which will
-	-- succeed, via getExecDir.
-	--
-	-- On a Unix installation, we'll run the wrapper script hsc2hs.sh 
-	-- (called plain hsc2hs in the installed tree), which will pass
-	-- a suitable C compiler via --cc
-	--
-	-- The in-place installation always uses the wrapper script,
-	-- (called hsc2hs-inplace, generated from hsc2hs.sh)
-    compiler <- case [c | Compiler c <- flags] of
-        []  -> locateGhc "ghc"
-        [c] -> return c
-        _   -> onlyOne "compiler"
-    
-    linker <- case [l | Linker l <- flags] of
-        []  -> locateGhc compiler
-        [l] -> return l
-        _   -> onlyOne "linker"
-#endif
-
-    writeFile cProgName $
-        concatMap outFlagHeaderCProg flags++
-        concatMap outHeaderCProg specials++
-        "\nint main (int argc, char *argv [])\n{\n"++
-        outHeaderHs flags (if needsH then Just outHName else Nothing) specials++
-        outHsLine (SourcePos name 0)++
-        concatMap outTokenHs toks++
-        "    return 0;\n}\n"
-    
-    -- NOTE: hbc compiles "[() | NoCompile <- flags]" into wrong code,
-    -- so we use something slightly more complicated.   :-P
-    when (any (\x -> case x of NoCompile -> True; _ -> False) flags) $
-       exitWith ExitSuccess
-
-
-    
-    compilerStatus <- rawSystemL beVerbose compiler
-	(  ["-c"]
-        ++ [f | CompFlag f <- flags]
-        ++ [cProgName]
-        ++ ["-o", oProgName]
-	)
-
-    case compilerStatus of
-        e@(ExitFailure _) -> exitWith e
-        _                 -> return ()
-    removeFile cProgName
-    
-    linkerStatus <- rawSystemL beVerbose linker
-        (  [f | LinkFlag f <- flags]
-        ++ [oProgName]
-        ++ ["-o", progName]
-	)
-
-    case linkerStatus of
-        e@(ExitFailure _) -> exitWith e
-        _                 -> return ()
-    removeFile oProgName
-    
-    progStatus <- rawSystemWithStdOutL beVerbose execProgName [] outName
-    removeFile progName
-    case progStatus of
-        e@(ExitFailure _) -> exitWith e
-        _                 -> return ()
-    
-    when needsH $ writeFile outHName $
-        "#ifndef "++includeGuard++"\n" ++
-        "#define "++includeGuard++"\n" ++
-        "#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409\n" ++
-        "#include <Rts.h>\n" ++
-        "#endif\n" ++
-        "#include <HsFFI.h>\n" ++
-        "#if __NHC__\n" ++
-        "#undef HsChar\n" ++
-        "#define HsChar int\n" ++
-        "#endif\n" ++
-        concatMap outFlagH flags++
-        concatMap outTokenH specials++
-        "#endif\n"
-    
-    when needsC $ writeFile outCName $
-        "#include \""++outHFile++"\"\n"++
-        concatMap outTokenC specials
-	-- NB. outHFile not outHName; works better when processed
-	-- by gcc or mkdependC.
-
-rawSystemL :: Bool -> FilePath -> [String] -> IO ExitCode
-rawSystemL flg prog args = do
-  let cmdLine = prog++" "++unwords args
-  when flg $ hPutStrLn stderr ("Executing: " ++ cmdLine)
-#ifndef HAVE_rawSystem
-  system cmdLine
-#else
-  rawSystem prog args
-#endif
-
-rawSystemWithStdOutL :: Bool -> FilePath -> [String] -> FilePath -> IO ExitCode
-rawSystemWithStdOutL flg prog args outFile = do
-  let cmdLine = prog++" "++unwords args++" >"++outFile
-  when flg (hPutStrLn stderr ("Executing: " ++ cmdLine))
-#ifndef HAVE_runProcess
-  system cmdLine
-#else
-  hOut <- openFile outFile WriteMode
-  process <- runProcess prog args Nothing Nothing Nothing (Just hOut) Nothing
-  res <- waitForProcess process
-  hClose hOut
-  return res
-#endif
-
-onlyOne :: String -> IO a
-onlyOne what = die ("Only one "++what++" may be specified\n")
-
-outFlagHeaderCProg :: Flag -> String
-outFlagHeaderCProg (Template t)          = "#include \""++t++"\"\n"
-outFlagHeaderCProg (Include  f)          = "#include "++f++"\n"
-outFlagHeaderCProg (Define   n Nothing)  = "#define "++n++" 1\n"
-outFlagHeaderCProg (Define   n (Just v)) = "#define "++n++" "++v++"\n"
-outFlagHeaderCProg _                     = ""
-
-outHeaderCProg :: (SourcePos, String, String) -> String
-outHeaderCProg (pos, key, arg) = case key of
-    "include"           -> outCLine pos++"#include "++arg++"\n"
-    "define"            -> outCLine pos++"#define "++arg++"\n"
-    "undef"             -> outCLine pos++"#undef "++arg++"\n"
-    "def"               -> case arg of
-        's':'t':'r':'u':'c':'t':' ':_ -> outCLine pos++arg++"\n"
-        't':'y':'p':'e':'d':'e':'f':' ':_ -> outCLine pos++arg++"\n"
-        _ -> ""
-    _ | conditional key -> outCLine pos++"#"++key++" "++arg++"\n"
-    "let"               -> case break (== '=') arg of
-        (_,      "")     -> ""
-        (header, _:body) -> case break isSpace header of
-            (name, args) ->
-                outCLine pos++
-                "#define hsc_"++name++"("++dropWhile isSpace args++") " ++
-                "printf ("++joinLines body++");\n"
-    _ -> ""
-   where
-    joinLines = concat . intersperse " \\\n" . lines
-
-outHeaderHs :: [Flag] -> Maybe String -> [(SourcePos, String, String)] -> String
-outHeaderHs flags inH toks =
-    "#if " ++
-    "__GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409\n" ++
-    "    printf (\"{-# OPTIONS -optc-D" ++
-    "__GLASGOW_HASKELL__=%d #-}\\n\", " ++
-    "__GLASGOW_HASKELL__);\n" ++
-    "#endif\n"++
-    case inH of
-        Nothing -> concatMap outFlag flags++concatMap outSpecial toks
-        Just f  -> outInclude ("\""++f++"\"")
-    where
-    outFlag (Include f)          = outInclude f
-    outFlag (Define  n Nothing)  = outOption ("-optc-D"++n)
-    outFlag (Define  n (Just v)) = outOption ("-optc-D"++n++"="++v)
-    outFlag _                    = ""
-    outSpecial (pos, key, arg) = case key of
-        "include"                  -> outInclude arg
-        "define" | goodForOptD arg -> outOption ("-optc-D"++toOptD arg)
-                 | otherwise       -> ""
-        _ | conditional key        -> outCLine pos++"#"++key++" "++arg++"\n"
-        _                          -> ""
-    goodForOptD arg = case arg of
-        ""              -> True
-        c:_ | isSpace c -> True
-        '(':_           -> False
-        _:s             -> goodForOptD s
-    toOptD arg = case break isSpace arg of
-        (name, "")      -> name
-        (name, _:value) -> name++'=':dropWhile isSpace value
-    outOption s =
-	"#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 603\n" ++
-	"    printf (\"{-# OPTIONS %s #-}\\n\", \""++
-                  showCString s++"\");\n"++
-	"#else\n"++
-	"    printf (\"{-# OPTIONS_GHC %s #-}\\n\", \""++
-                  showCString s++"\");\n"++
-	"#endif\n"
-    outInclude s =
-	"#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 603\n" ++
-	"    printf (\"{-# OPTIONS -#include %s #-}\\n\", \""++
-                  showCString s++"\");\n"++
-	"#else\n"++
-	"    printf (\"{-# INCLUDE %s #-}\\n\", \""++
-                  showCString s++"\");\n"++
-	"#endif\n"
-
-outTokenHs :: Token -> String
-outTokenHs (Text pos txt) =
-    case break (== '\n') txt of
-        (allTxt, [])       -> outText allTxt
-        (first, _:rest) ->
-            outText (first++"\n")++
-            outHsLine pos++
-            outText rest
-    where
-    outText s = "    fputs (\""++showCString s++"\", stdout);\n"
-outTokenHs (Special pos key arg) =
-    case key of
-        "include"           -> ""
-        "define"            -> ""
-        "undef"             -> ""
-        "def"               -> ""
-        _ | conditional key -> outCLine pos++"#"++key++" "++arg++"\n"
-        "let"               -> ""
-        "enum"              -> outCLine pos++outEnum arg
-        _                   -> outCLine pos++"    hsc_"++key++" ("++arg++");\n"
-
-outEnum :: String -> String
-outEnum arg =
-    case break (== ',') arg of
-        (_, [])        -> ""
-        (t, _:afterT) -> case break (== ',') afterT of
-            (f, afterF) -> let
-                enums []    = ""
-                enums (_:s) = case break (== ',') s of
-                    (enum, rest) -> let
-                        this = case break (== '=') $ dropWhile isSpace enum of
-                            (name, []) ->
-                                "    hsc_enum ("++t++", "++f++", " ++
-                                "hsc_haskellize (\""++name++"\"), "++
-                                name++");\n"
-                            (hsName, _:cName) ->
-                                "    hsc_enum ("++t++", "++f++", " ++
-                                "printf (\"%s\", \""++hsName++"\"), "++
-                                cName++");\n"
-                        in this++enums rest
-                in enums afterF
-
-outFlagH :: Flag -> String
-outFlagH (Include  f)          = "#include "++f++"\n"
-outFlagH (Define   n Nothing)  = "#define "++n++" 1\n"
-outFlagH (Define   n (Just v)) = "#define "++n++" "++v++"\n"
-outFlagH _                     = ""
-
-outTokenH :: (SourcePos, String, String) -> String
-outTokenH (pos, key, arg) =
-    case key of
-        "include" -> outCLine pos++"#include "++arg++"\n"
-        "define"  -> outCLine pos++"#define " ++arg++"\n"
-        "undef"   -> outCLine pos++"#undef "  ++arg++"\n"
-        "def"     -> outCLine pos++case arg of
-            's':'t':'r':'u':'c':'t':' ':_ -> arg++"\n"
-            't':'y':'p':'e':'d':'e':'f':' ':_ -> arg++"\n"
-            'i':'n':'l':'i':'n':'e':' ':_ ->
-                "#ifdef __GNUC__\n" ++
-                "extern\n" ++
-                "#endif\n"++
-                arg++"\n"
-            _ -> "extern "++header++";\n"
-          where header = takeWhile (\c -> c /= '{' && c /= '=') arg
-        _ | conditional key -> outCLine pos++"#"++key++" "++arg++"\n"
-        _ -> ""
-
-outTokenC :: (SourcePos, String, String) -> String
-outTokenC (pos, key, arg) =
-    case key of
-        "def" -> case arg of
-            's':'t':'r':'u':'c':'t':' ':_ -> ""
-            't':'y':'p':'e':'d':'e':'f':' ':_ -> ""
-            'i':'n':'l':'i':'n':'e':' ':arg' ->
-		case span (\c -> c /= '{' && c /= '=') arg' of
-		(header, body) ->
-		    outCLine pos++
-		    "#ifndef __GNUC__\n" ++
-		    "extern inline\n" ++
-		    "#endif\n"++
-		    header++
-		    "\n#ifndef __GNUC__\n" ++
-		    ";\n" ++
-		    "#else\n"++
-		    body++
-		    "\n#endif\n"
-            _ -> outCLine pos++arg++"\n"
-        _ | conditional key -> outCLine pos++"#"++key++" "++arg++"\n"
-        _ -> ""
-
-conditional :: String -> Bool
-conditional "if"      = True
-conditional "ifdef"   = True
-conditional "ifndef"  = True
-conditional "elif"    = True
-conditional "else"    = True
-conditional "endif"   = True
-conditional "error"   = True
-conditional "warning" = True
-conditional _         = False
-
-outCLine :: SourcePos -> String
-outCLine (SourcePos name line) =
-    "#line "++show line++" \""++showCString (snd (splitName name))++"\"\n"
-
-outHsLine :: SourcePos -> String
-outHsLine (SourcePos name line) =
-    "    hsc_line ("++show (line + 1)++", \""++
-    showCString name++"\");\n"
-
-showCString :: String -> String
-showCString = concatMap showCChar
-    where
-    showCChar '\"' = "\\\""
-    showCChar '\'' = "\\\'"
-    showCChar '?'  = "\\?"
-    showCChar '\\' = "\\\\"
-    showCChar c | c >= ' ' && c <= '~' = [c]
-    showCChar '\a' = "\\a"
-    showCChar '\b' = "\\b"
-    showCChar '\f' = "\\f"
-    showCChar '\n' = "\\n\"\n           \""
-    showCChar '\r' = "\\r"
-    showCChar '\t' = "\\t"
-    showCChar '\v' = "\\v"
-    showCChar c    = ['\\',
-                      intToDigit (ord c `quot` 64),
-                      intToDigit (ord c `quot` 8 `mod` 8),
-                      intToDigit (ord c          `mod` 8)]
-
-
-
------------------------------------------
--- Modified version from ghc/compiler/SysTools
--- Convert paths foo/baz to foo\baz on Windows
-
-subst :: Char -> Char -> String -> String
-#if defined(mingw32_HOST_OS) || defined(__CYGWIN32__)
-subst a b = map (\x -> if x == a then b else x)
-#else
-subst _ _ = id
-#endif
-
-dosifyPath :: String -> String
-dosifyPath = subst '/' '\\'
-
--- (getExecDir cmd) returns the directory in which the current
---	  	    executable, which should be called 'cmd', is running
--- So if the full path is /a/b/c/d/e, and you pass "d/e" as cmd,
--- you'll get "/a/b/c" back as the result
-getExecDir :: String -> IO (Maybe String)
-getExecDir cmd =
-    getExecPath >>= maybe (return Nothing) removeCmdSuffix
-    where unDosifyPath = subst '\\' '/'
-          initN n = reverse . drop n . reverse
-          removeCmdSuffix = return . Just . initN (length cmd) . unDosifyPath
-
-getExecPath :: IO (Maybe String)
-#if defined(__HUGS__)
-getExecPath = liftM Just getProgName
-#elif defined(mingw32_HOST_OS)
-getExecPath =
-     allocaArray len $ \buf -> do
-         ret <- getModuleFileName nullPtr buf len
-         if ret == 0 then return Nothing
-	             else liftM Just $ peekCString buf
-    where len = 2048 -- Plenty, PATH_MAX is 512 under Win32.
-
-foreign import stdcall unsafe "GetModuleFileNameA"
-    getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
-#else
-getExecPath = return Nothing
-#endif
diff --git a/ghc/utils/hsc2hs/Makefile b/ghc/utils/hsc2hs/Makefile
deleted file mode 100644
index ccaf68eec8..0000000000
--- a/ghc/utils/hsc2hs/Makefile
+++ /dev/null
@@ -1,101 +0,0 @@
-# -----------------------------------------------------------------------------
-# To compile with nhc98 on unix:
-#     nhc98 -cpp -package base -o hsc2hs-bin Main.hs
-
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-CURRENT_DIR=ghc/utils/hsc2hs
-INCLUDE_DIR=ghc/includes
-
-INSTALLING=1
-
-# This causes libghccompat.a to be used:
-include $(GHC_LIB_COMPAT_DIR)/compat.mk
-
-# This is required because libghccompat.a must be built with
-# $(GhcHcOpts) because it is linked to the compiler, and hence
-# we must also build with $(GhcHcOpts) here:
-SRC_HC_OPTS += $(GhcHcOpts)
-
-HS_PROG           = hsc2hs-bin
-ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-HS_PROG           = hsc2hs$(exeext)
-endif
-ifeq "$(HOSTPLATFORM)" "i386-unknown-cygwinw32"
-HS_PROG           = hsc2hs$(exeext)
-endif
-
-ifeq "$(ghc_ge_504)" "NO"
-SRC_HC_OPTS +=  -package util
-endif
-
-# Note: Somehow we should pass $(exeext) here, but the history of changes used
-# for calling the C preprocessor via GHC has changed a few times, making a
-# clean solution impossible. So we revert to a hack in Main.hs...
-SRC_HC_OPTS      += -Wall
-
-ifneq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-INSTALLED_SCRIPT_PROG  = hsc2hs
-endif
-INPLACE_SCRIPT_PROG    = hsc2hs-inplace
-
-ifeq "$(INSTALLING)" "1"
-TOP_PWD 	:= $(prefix)
-SCRIPT_PROG 	=  $(INSTALLED_SCRIPT_PROG)
-else
-TOP_PWD 	:= $(FPTOOLS_TOP_ABS)
-SCRIPT_PROG 	=  $(INPLACE_SCRIPT_PROG)
-endif
-
-ifeq "$(INSTALLING)" "1"
-ifeq "$(BIN_DIST)"   "1"
-HSC2HS_BINDIR=$$\"\"libexecdir
-HSC2HS_DIR=$$\"\"libdir
-HSC2HS_EXTRA=
-else
-HSC2HS_BINDIR=$(libexecdir)
-HSC2HS_DIR=$(libdir)
-HSC2HS_EXTRA=--cc=$(bindir)/ghc-$(ProjectVersion)
-endif # BIN_DIST
-else
-HSC2HS_BINDIR=$(FPTOOLS_TOP_ABS)/$(CURRENT_DIR)
-HSC2HS_DIR=$(FPTOOLS_TOP_ABS_PLATFORM)/$(CURRENT_DIR)
-
-ifeq "$(HOSTPLATFORM)" "i386-unknown-mingw32"
-extra_flags=$(addprefix --cflag=,$(filter-out -O,$(SRC_CC_OPTS)))
-endif
-
-HSC2HS_EXTRA="--cc=$(CC) --ld=$(CC) $(extra_flags) --cflag=-D__GLASGOW_HASKELL__=$(ProjectVersionInt) -I$(FPTOOLS_TOP_ABS_PLATFORM)/$(INCLUDE_DIR)"
-endif
-
-$(SCRIPT_PROG) : Makefile
-$(INSTALLED_SCRIPT_PROG) : $(TOP)/mk/config.mk
-
-SCRIPT_SUBST_VARS = HSC2HS_BINDIR HSC2HS_DIR HS_PROG HSC2HS_EXTRA
-
-SCRIPT_OBJS=hsc2hs.sh
-INTERP=$(SHELL)
-
-ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
-INSTALL_SCRIPTS  += $(SCRIPT_PROG)
-INSTALL_LIBEXECS += $(HS_PROG)
-else
-INSTALL_PROGS    += $(HS_PROG)
-endif
-
-override datadir=$(libdir)
-INSTALL_DATAS += template-hsc.h
-
-# -----------------------------------------------------------------------------
-# don't recurse on 'make install'
-#
-ifeq "$(INSTALLING)" "1"
-all :: $(HS_PROG)
-	$(MAKE) INSTALLING=0 BIN_DIST=0 $(MFLAGS) $@
-
-clean distclean maintainer-clean :: 
-	$(MAKE) INSTALLING=0 BIN_DIST=0 $(MFLAGS) $@
-endif
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/hsc2hs/Makefile.inc b/ghc/utils/hsc2hs/Makefile.inc
deleted file mode 100644
index 91ac818437..0000000000
--- a/ghc/utils/hsc2hs/Makefile.inc
+++ /dev/null
@@ -1,7 +0,0 @@
-ifeq "" "${MKDIR}"
-MKDIR:=$(shell pwd)
-#MKDIR:=$(PWD)
-else
-MKDIR:=$(patsubst %/$(notdir ${MKDIR}),%, ${MKDIR})
-endif
-include ${MKDIR}/Makefile.inc
diff --git a/ghc/utils/hsc2hs/Makefile.nhc98 b/ghc/utils/hsc2hs/Makefile.nhc98
deleted file mode 100644
index a35a0dc9e7..0000000000
--- a/ghc/utils/hsc2hs/Makefile.nhc98
+++ /dev/null
@@ -1,48 +0,0 @@
-include Makefile.inc
-
-OBJDIR = ${BUILDDIR}/obj/hsc2hs
-TARGET = ${DST}/hsc2hs$(EXE)
-
-SRCS   = Main.hs
-FROMC  = ../libraries/base/System/Console/GetOpt.$C \
-	 ../libraries/base/Data/List.$C \
-	 ../libraries/base/System/Cmd.$C
-
-ifeq "$(findstring ghc, ${HC})" "ghc"
-HFLAGS = $(shell $(LOCAL)fixghc $(GHCSYM) -package base -package lang )
-export HFLAGS
-endif
-ifeq "$(findstring hbc, ${HC})" "hbc"
-HFLAGS =
-export HFLAGS
-endif
-ifeq "$(findstring nhc98, ${HC})" "nhc98"
-HFLAGS = -package base +CTS -H4M -CTS
-export HFLAGS
-endif
-
-all: $(TARGET)
-install: $(TARGET)
-cfiles: cleanC $(SRCS)
-	$(HMAKE) -hc=$(LOCAL)nhc98 -package base -C Main.hs
-clean:
-	-rm -f *.hi *.o $(OBJDIR)/*.o
-cleanC: clean
-	-rm -f *.hc *.c
-realclean: clean cleanC
-	-rm -f $(OBJDIR)/Main$(EXE)
-
-$(TARGET): $(OBJDIR) $(SRCS)
-	$(HMAKE) -hc=$(HC) Main -d$(OBJDIR) -DBUILD_NHC \
-		$(shell echo "${BUILDOPTS}") $(HFLAGS) $(CYGFLAG)
-	mv $(OBJDIR)/Main$(EXE) $(TARGET)
-	$(STRIP) $(TARGET)
-
-$(OBJDIR):
-	mkdir -p $(OBJDIR)
-
-fromC: $(OBJDIR)
-	cp $(FROMC) .
-	$(LOCAL)nhc98 -cpp -o $(TARGET) -d$(OBJDIR) *.$C
-	$(STRIP) $(TARGET)
-
diff --git a/ghc/utils/hsc2hs/hsc2hs.sh b/ghc/utils/hsc2hs/hsc2hs.sh
deleted file mode 100644
index fe00d45036..0000000000
--- a/ghc/utils/hsc2hs/hsc2hs.sh
+++ /dev/null
@@ -1,13 +0,0 @@
-
-tflag="--template=$HSC2HS_DIR/template-hsc.h"
-for arg do
-    case "$arg" in
-        -c*)    HSC2HS_EXTRA=;;
-        --cc=*) HSC2HS_EXTRA=;;
-	-t*)	tflag=;;
-	--template=*) tflag=;;
-        --)     break;;
-    esac
-done
-
-$HSC2HS_BINDIR/$HS_PROG $tflag $HSC2HS_EXTRA "$@" 
diff --git a/ghc/utils/hsc2hs/template-hsc.h b/ghc/utils/hsc2hs/template-hsc.h
deleted file mode 100644
index bdc34eda78..0000000000
--- a/ghc/utils/hsc2hs/template-hsc.h
+++ /dev/null
@@ -1,105 +0,0 @@
-#if __GLASGOW_HASKELL__ && __GLASGOW_HASKELL__ < 409
-#include <Rts.h>
-#endif
-#include <HsFFI.h>
-
-#include <stddef.h>
-#include <string.h>
-#include <stdio.h>
-#include <stdarg.h>
-#include <ctype.h>
-
-#ifndef offsetof
-#define offsetof(t, f) ((size_t) &((t *)0)->f)
-#endif
-
-#if __NHC__
-#define hsc_line(line, file) \
-    printf ("# %d \"%s\"\n", line, file);
-#else
-#define hsc_line(line, file) \
-    printf ("{-# LINE %d \"%s\" #-}\n", line, file);
-#endif
-
-#define hsc_const(x)                        \
-    if ((x) < 0)                            \
-        printf ("%ld", (long)(x));          \
-    else                                    \
-        printf ("%lu", (unsigned long)(x));
-
-#define hsc_const_str(x)                                          \
-    {                                                             \
-        const char *s = (x);                                      \
-        printf ("\"");                                            \
-        while (*s != '\0')                                        \
-        {                                                         \
-            if (*s == '"' || *s == '\\')                          \
-                printf ("\\%c", *s);                              \
-            else if (*s >= 0x20 && *s <= 0x7E)                    \
-                printf ("%c", *s);                                \
-            else                                                  \
-                printf ("\\%d%s",                                 \
-                        (unsigned char) *s,                       \
-                        s[1] >= '0' && s[1] <= '9' ? "\\&" : ""); \
-            ++s;                                                  \
-        }                                                         \
-        printf ("\"");                                            \
-    }
-
-#define hsc_type(t)                                         \
-    if ((t)(int)(t)1.4 == (t)1.4)                           \
-        printf ("%s%d",                                     \
-                (t)(-1) < (t)0 ? "Int" : "Word",            \
-                sizeof (t) * 8);                            \
-    else                                                    \
-        printf ("%s",                                       \
-                sizeof (t) >  sizeof (double) ? "LDouble" : \
-                sizeof (t) == sizeof (double) ? "Double"  : \
-                "Float");
-
-#define hsc_peek(t, f) \
-    printf ("(\\hsc_ptr -> peekByteOff hsc_ptr %ld)", (long) offsetof (t, f));
-
-#define hsc_poke(t, f) \
-    printf ("(\\hsc_ptr -> pokeByteOff hsc_ptr %ld)", (long) offsetof (t, f));
-
-#define hsc_ptr(t, f) \
-    printf ("(\\hsc_ptr -> hsc_ptr `plusPtr` %ld)", (long) offsetof (t, f));
-
-#define hsc_offset(t, f) \
-    printf("(%ld)", (long) offsetof (t, f));
-
-#define hsc_size(t) \
-    printf("(%ld)", (long) sizeof(t));
-
-#define hsc_enum(t, f, print_name, x)         \
-    print_name;                               \
-    printf (" :: %s\n", #t);                  \
-    print_name;                               \
-    printf (" = %s ", #f);                    \
-    if ((x) < 0)                              \
-        printf ("(%ld)\n", (long)(x));        \
-    else                                      \
-        printf ("%lu\n", (unsigned long)(x));
-
-#define hsc_haskellize(x)                                          \
-    {                                                              \
-        const char *s = (x);                                       \
-        int upper = 0;                                             \
-        if (*s != '\0')                                            \
-        {                                                          \
-            putchar (tolower (*s));                                \
-            ++s;                                                   \
-            while (*s != '\0')                                     \
-            {                                                      \
-                if (*s == '_')                                     \
-                    upper = 1;                                     \
-                else                                               \
-                {                                                  \
-                    putchar (upper ? toupper (*s) : tolower (*s)); \
-                    upper = 0;                                     \
-                }                                                  \
-                ++s;                                               \
-            }                                                      \
-        }                                                          \
-    }
diff --git a/ghc/utils/hstags/Makefile b/ghc/utils/hstags/Makefile
deleted file mode 100644
index 981bafd897..0000000000
--- a/ghc/utils/hstags/Makefile
+++ /dev/null
@@ -1,70 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/version.mk
-
-# Note: might be overridden from cmd-line (see install rule below)
-INSTALLING=0
-
-C_PROG=hstags-help
-SRC_CC_OPTS += -O
-
-SCRIPT_PROG=hstags
-SCRIPT_OBJS=hstags.prl
-
-SCRIPT_SUBST_VARS=\
- INSTALLING \
- TOP_PWD \
- ProjectVersionInt
-
-ifneq "$(BIN_DIST)" "1"
-SCRIPT_SUBST_VARS += libdir libexecdir DEFAULT_TMPDIR
-endif
-
-#
-# The hstags script is configured with different
-# set of config variables, depending on whether it
-# is to be installed or not.
-#
-ifeq "$(INSTALLING)" "1"
-TOP_PWD := $(prefix)
-ifeq "$(BIN_DIST)" "1"
-SCRIPT_PREFIX_FILES += prefix.txt
-endif
-else
-TOP_PWD := $(FPTOOLS_TOP_ABS)
-HSP_IMPORTS:="$(TOP_PWD)/ghc/lib/ghc":"$(TOP_PWD)/ghc/lib/required":"$(TOP_PWD)/ghc/lib/glaExts":"$(TOP_PWD)/ghc/lib/concurrent"
-SCRIPT_SUBST_VARS += HSP_IMPORTS
-endif
-
-#
-# no INTERP: do *not* want #! script stuck on the front
-#
-# what's the deal? I'll add it for now (and perhaps pay for it later :-)
-#  -- SOF
-INTERP=perl
-
-#
-# install setup
-#
-INSTALL_SCRIPTS+=$(SCRIPT_PROG)
-INSTALL_LIBEXECS=$(C_PROG)
-
-#
-# Before really installing the script, we have to
-# reconfigure it such that the paths it refers to,
-# point to the installed utils.
-#
-install ::
-	@$(RM) $(SCRIPT_PROG)
-	@$(MAKE) $(MFLAGS) INSTALLING=1 $(SCRIPT_PROG)
-
-include $(TOP)/mk/target.mk
-
-
-# Hack to re-create the in-situ build tree script after 
-# having just installed it.
-#
-install ::
-	@$(RM) $(SCRIPT_PROG)
-	@$(MAKE) $(MFLAGS) BIN_DIST=0 $(SCRIPT_PROG)
-
diff --git a/ghc/utils/hstags/README b/ghc/utils/hstags/README
deleted file mode 100644
index b457ef125a..0000000000
--- a/ghc/utils/hstags/README
+++ /dev/null
@@ -1,10 +0,0 @@
-"hstags" is a relatively sophisticated program to produce Emacs TAGS
-files for Glasgow-Haskell-compilable programs.  (It is "sophisticated"
-only in that it uses the GHC parser to find "interesting" things in
-the source files.)
-
-With GHC 2.01: doesn't work yet.
-
-A simpler alternative is Denis Howe's "fptags" script, which is
-distributed in the ghc/CONTRIB directory.
-
diff --git a/ghc/utils/hstags/hstags-help.c b/ghc/utils/hstags/hstags-help.c
deleted file mode 100644
index 92604876ff..0000000000
--- a/ghc/utils/hstags/hstags-help.c
+++ /dev/null
@@ -1,59 +0,0 @@
-#include <stdio.h>
-#include <string.h> /* for strlen */
-
-/* typedef enum { False, True } Boolean; */
-
-#define SKIP	/* Algol-68 lives */
-
-main(argc,argv)
-int argc;
-char **argv;
-{
-  unsigned line;
-  FILE *srcf;
-  int thisline = 0, lastline = 0, linestart = 0;
-  char linebuff[1024];
-
-  if(argc < 2)
-    {
-      fprintf(stderr,"usage: %s sourcefile",argv[0]);
-      exit(1);
-    }
-
-  if((srcf=fopen(argv[1],"r")) == NULL)
-    {
-      fprintf(stderr,"can't read %s\n",argv[1]);
-      exit(2);
-    }
-
-  *linebuff = '\0';
-
-  while(scanf("%u",&line)!=EOF)
-    {
-      if(line != lastline)
-	{
-	  while(thisline < line && !feof(srcf))
-	    {
-	      linestart+=strlen(linebuff);
-	      fgets(linebuff,1023,srcf);
-	      thisline++;
-	    }
-
-	  if(thisline >= line)
-	    {
-	      char *chpos;
-	      for(chpos = linebuff; *chpos != '=' && *chpos != '\n' && *chpos != '\0'; ++chpos)
-		putchar(*chpos);
-
-	      if(*chpos == '=')
-		putchar('=');
-
-	      printf("%c%d,%d\n",0177,line,linestart);
-	    }
-	  lastline = line;
-	}
-    }
-
-  fclose(srcf);
-  exit(0);
-}
diff --git a/ghc/utils/hstags/hstags.prl b/ghc/utils/hstags/hstags.prl
deleted file mode 100644
index 16e770bd8a..0000000000
--- a/ghc/utils/hstags/hstags.prl
+++ /dev/null
@@ -1,94 +0,0 @@
-#
-# To fully function, this script needs the following variables
-# set:
-#
-#   INSTALLING
-#   DEFAULT_TMPDIR
-#   TOP_PWD
-#   libdir
-#   libexecdir
-#   ProjectVersionInt
-#   HSP_IMPORTS
-
-if ( $ENV{'TMPDIR'} ) { # where to make tmp file names
-    $tmp = $ENV{'TMPDIR'} . "/$$.eht";
-} else {
-    $tmp ="${DEFAULT_TMPDIR}/$$.eht";
-    $ENV{'TMPDIR'} = ${DEFAULT_TMPDIR}; # set the env var as well
-}
-
-$TopPwd         = "${TOP_PWD}"; # *Only* needed when using it in-situ (i.e., INSTALLING=0).
-$InstLibDirGhc  = "${libdir}";
-$InstLibExecDirGhc  = "${libexecdir}";
-
-$Unlit = ( $INSTALLING ? 
-           "${InstLibExecDirGhc}/unlit" : 
-	   "${TopPwd}/ghc/utils/unlit/unlit" );
-# but this is re-set to "cat" (after options) if -cpp not seen
-$HsCpp = ( $INSTALLING ? 
-	   "${InstLibDirGhc}/hscpp" : 
-	   "${TopPwd}/ghc/utils/hscpp/hscpp" );
-$HsP   = ( $INSTALLING ? 
-	   "${InstLibExecDirGhc}/hsp" : 
-	   "${TopPwd}/ghc/compiler/hsp" );
-$HsTagsHelp = 
-	 ( $INSTALLING ? 
-	   "${InstLibExecDirGhc}/hstags-help" : 
-	   "${TopPwd}/ghc/utils/hstags/hstags-help" );
-
-$Verbose = 0;
-$Append = '>';
-$DoCpp = 0;
-$Cpp_opts = '';
-$HsP_opts = '';
-@Files = ();
-
-while ($ARGV[0] =~ /^-./) {
-    $_ = shift(@ARGV);
-    /^--/		&& last;
-    /^-v/		&& ($Verbose  =  1, next);
-    /^-a$/		&& ($Append   = '>>', next);
-    /^-fglasgow-exts/	&& ($HsP_opts .= ' -N', next);
-    /^-optP(.*)/	&& ($Cpp_opts .= " $1", next);
-    /^-[UDI]/		&& ($Cpp_opts .= " $_", next);
-    /^-cpp/		&& ($DoCpp = 1, next);
-    /^-/		&& next; # ignore the rest
-    push(@Files, $_);
-}
-
-$DoHsCpp = ( ! $DoCpp ) ? 'cat'
-			: "$HsCpp -D__HASKELL1__=2 -D__GLASGOW_HASKELL__=$ProjectVersionInt $Cpp_opts";
-
-# to find Prelude.hi and friends.
-$HsP_opts .= ( $INSTALLING  ? 
-	       "-J${InstLibDirGhc}/imports" : 
-	       ( '-J' . join(' -J',split(/:/,${HSP_IMPORTS})) ));
-
-open(STDOUT, "$Append TAGS") || die "can't create TAGS";
-
-foreach $f ( @ARGV ) {
-    # if file is in a dir && we are CPPing, then we add its dir to the -I list.
-    if ( $DoCpp && $f =~ /(.+)\/[^\/]+$/ ) {
-	$Idir = "-I$1";
-    } else {
-	$Idir = '';
-    }
-
-    if ( $f =~ /\.lhs$/ ) {
-	$ToDo = "$Unlit $f - | $DoHsCpp $Idir | $HsP -E $HsP_opts | $HsTagsHelp $f > $tmp";
-    } else {
-	$ToDo = "$DoHsCpp $Idir < $f | $HsP -E  $HsP_opts | $HsTagsHelp $f > $tmp";
-    }
-    print STDERR "$ToDo\n" if $Verbose;
-    system($ToDo);
-    $return_val = $?;
-    die "Fatal error $return_val\n" if $return_val != 0;
-
-    ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
-     $atime,$mtime, $ctime,$blksize,$blocks) = stat("$tmp");
-  
-    print STDOUT "\f\n$f,${size}\n";
-    print STDOUT `cat $tmp`;
-}
-
-unlink $tmp;
diff --git a/ghc/utils/hstags/prefix.txt b/ghc/utils/hstags/prefix.txt
deleted file mode 100644
index b67c009c49..0000000000
--- a/ghc/utils/hstags/prefix.txt
+++ /dev/null
@@ -1,9 +0,0 @@
-#
-# hstags - generating a tags file from Haskell source
-#
-# To use the script on your system, the following variable
-# needs to be set (and uncommented!), if it hasn't already
-# been set above:
-#
-#$libdir='/local/fp/lib/sparc-sun-sunos4/ghc-2.02';
-#
diff --git a/ghc/utils/parallel/AVG.pl b/ghc/utils/parallel/AVG.pl
deleted file mode 100644
index 9ec42aee2f..0000000000
--- a/ghc/utils/parallel/AVG.pl
+++ /dev/null
@@ -1,108 +0,0 @@
-#!/usr/local/bin/perl
-#                                       (C) Hans Wolfgang Loidl, October 1995
-#############################################################################
-# Time-stamp: <Thu Oct 26 1995 18:30:54 Stardate: [-31]6498.64 hwloidl>
-#
-# Usage: AVG [options] <gr-file>
-#
-# A quich hack to get avg runtimes of different spark sites. Similar to SPLIT.
-#
-# Options:
-#  -s <list> ... a perl list of spark names; the given <gr-file> is scanned 
-#                for each given name in turn and granularity graphs are 
-#                generated for each of these sparks  
-#  -O        ... use gr2RTS and RTS2gran instead of gran-extr;
-#                this generates fewer output files (only granularity graphs)
-#                but should be faster and far less memory consuming
-#  -h        ... help; print this text.
-#  -v        ... verbose mode.
-#
-#############################################################################
-
-require "getopts.pl";
-
-&Getopts('hvOs:');  
-
-do process_options();
-
-if ( $opt_v ) { do print_verbose_message(); }
-
-# ---------------------------------------------------------------------------
-# Init
-# ---------------------------------------------------------------------------
-
-foreach $s (@sparks) {
-    # extract END events for this spark-site
-    open (GET,"cat $input | tf -s $s | avg-RTS") || die "!$\n";
-}
-
-exit 0;
-
-exit 0;
-
-# -----------------------------------------------------------------------------
-
-sub process_options {
-
-    if ( $opt_h ) {                      
-	open(ME,$0) || die "Can't open myself ($0): $!\n";
-	$n = 0;
-	while (<ME>) {
-	    last if $_ =~ /^$/;
-	    print $_;
-	    $n++;
-	}
-	close(ME);
-	exit ;
-    }
-    
-    if ( $opt_s ) {
-	$opt_s =~ s/[\(\)\[\]]//g;
-	@sparks = split(/[,;. ]+/, $opt_s);
-    } else {
-	@sparks = ( 3, 4, 5, 6, 7, 8, 11, 12, 13, 14, 15);
-    }
-
-    if ( $#ARGV != 0 ) {
-	print "Usage: $0 [options] <gr-file>\n;";
-	print "Use -h option to get details\n";
-	exit 1;
-    }
-
-    $gr_file = $ARGV[0];
-    ($basename = $gr_file) =~ s/\.gr//;
-    $rts_file = $basename . ".rts";        # "RTS";
-    $gran_file = "g.ps"; # $basename . ".ps";
-    #$rts_file = $gr_file;
-    #$rts_file =~ s/\.gr/.rts/g;
-
-    if ( $opt_o ) {
-	$va_file = $opt_o;
-	$va_dvi_file = $va_file;
-	$va_dvi_file =~ s/\.tex/.dvi/g; 
-	$va_ps_file = $va_file;
-	$va_ps_file =~ s/\.tex/.ps/g; 
-    } else {
-	$va_file = "va.tex";
-	$va_dvi_file = "va.dvi";
-	$va_ps_file = "va.ps";
-    }
-    
-    if ( $opt_t ) {
-	$template_file = $opt_t;
-    } else {
-	$template_file = "TEMPL";
-    }
-
-    $tmp_file = ",t";
-}
-
-# -----------------------------------------------------------------------------
-
-sub print_verbose_message {
-    print "Sparks: (" . join(',',@sparks) . ")\n";
-    print "Files: .gr " . $gr_file . "  template " . $template_file .
-	    " va " . $va_file . "\n";
-}
-
-# -----------------------------------------------------------------------------
diff --git a/ghc/utils/parallel/GrAnSim.el b/ghc/utils/parallel/GrAnSim.el
deleted file mode 100644
index 49330a9749..0000000000
--- a/ghc/utils/parallel/GrAnSim.el
+++ /dev/null
@@ -1,432 +0,0 @@
-;; ---------------------------------------------------------------------------
-;; Time-stamp: <Tue Jun 11 1996 18:01:28 Stardate: [-31]7643.54 hwloidl>
-;;
-;; Mode for GrAnSim profiles
-;; ---------------------------------------------------------------------------
-
-(defvar gransim-auto-hilit t
-  "Automagically invoke hilit19.")
-
-(defvar	grandir (getenv "GRANDIR")
-  "Root of the GrAnSim installation. Executables should be in grandir/bin")
-
-(defvar hwl-hi-node-face 'highlight
-  "Face to be used for specific highlighting of a node")
-
-(defvar hwl-hi-thread-face 'holiday-face
-  "Face to be used for specific highlighting of a thread")
-
-;; ---------------------------------------------------------------------------
-
-(setq exec-path (cons (concat grandir "/bin") exec-path))
-
-;; Requires hilit19 for highlighting parts of a GrAnSim profile
-(cond (window-system
-   (setq hilit-mode-enable-list  '(not text-mode)
-         hilit-background-mode   'light
-         hilit-inhibit-hooks     nil
-         hilit-inhibit-rebinding nil);
-
-   (require 'hilit19)
-))
-
-
-(setq auto-mode-alist
-      (append '(("\\.gr" . gr-mode))
-	     auto-mode-alist))
-
-(defvar gr-mode-map (make-keymap "GrAnSim Profile Mode SetUp")
-  "Keymap for GrAnSim profiles.")
-
-; (fset 'GrAnSim-mode-fiddly gr-mode-map)
-
-;(define-key gr-mode-map [wrap]
-;  '("Wrap lines" . hwl-wrap))
-
-;(define-key gr-mode-map [truncate]
-;  '("Truncate lines" . hwl-truncate))
-
-;(define-key global-map [C-S-down-mouse-1] 'GrAnSim-mode-fiddly)
-
-;(modify-frame-parameters (selected-frame)
-;                         '((menu-bar-lines . 2)))
-
-;(define-key-after gr-mode-map [menu-bar GrAnSim]
-;  '("GrAnSim" . (make-sparse-keymap "GrAnSim")) 'edit)
-
-;(defvar GrAnSim-menu-map (make-sparse-keymap "GrAnSim"))
-
-(define-key gr-mode-map [menu-bar GrAnSim]
-  (cons "GrAnSim"  (make-sparse-keymap "GrAnSim"))) ;  'edit)
-
-(define-key gr-mode-map [menu-bar GrAnSim wrap]
-  '("Wrap lines" . hwl-wrap))
-
-(define-key gr-mode-map [menu-bar GrAnSim truncate]
-  '("Truncate lines" . hwl-truncate))
-
-(define-key gr-mode-map [menu-bar GrAnSim toggle-truncate]
-  '("Toggle truncate/wrap" . hwl-toggle-truncate-wrap) )
-
-(define-key gr-mode-map [menu-bar GrAnSim hi-clear]
-  '("Clear highlights" . hwl-hi-clear))
-
-(define-key gr-mode-map [menu-bar GrAnSim hi-thread]
-  '("Highlight specific Thread" . hwl-hi-thread))
-
-(define-key gr-mode-map [menu-bar GrAnSim hi-node]
-  '("Highlight specific Node" . hwl-hi-node))
-
-(define-key gr-mode-map [menu-bar GrAnSim highlight]
-  '("Highlight buffer" . hilit-rehighlight-buffer))
-
-(define-key gr-mode-map [menu-bar GrAnSim narrow-event]
-  '("Narrow to Event" . hwl-narrow-to-event))
-
-(define-key gr-mode-map [menu-bar GrAnSim narrow-thread]
-  '("Narrow to Thread" . hwl-narrow-to-thread))
-
-(define-key gr-mode-map [menu-bar GrAnSim narrow-pe]
-  '("Narrow to PE" . hwl-narrow-to-pe))
-
-
-
-; (define-key global-map [C-S-down-mouse-1] 'GrAnSim-mode-fiddly)
-     
-
-(defvar gr-mode-hook nil
-  "Invoked in gr mode.")
-
-
-;;; Ensure new buffers won't get this mode if default-major-mode is nil.
-;(put 'gr-mode 'mode-class 'special)
-
-(defun gr-mode ()
-  "Major mode for GrAnSim profiles."
-  (interactive)
-  (kill-all-local-variables)
-  ;(use-local-map gr-mode-map)
-  (use-local-map gr-mode-map)     ; This provides the local keymap.
-  (setq major-mode 'gr-mode)
-  (setq mode-name "GrAnSim Profile Mode")
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (set-syntax-table text-mode-syntax-table)
-  (setq truncate-lines t)         ; do not wrap lines (truncates END lines!)
-  (auto-save-mode -1)
-  ;(setq buffer-offer-save t)
-  (run-hooks 'gr-mode-hook))
-
-;; same as mh-make-local-vars
-(defun gr-make-local-vars (&rest pairs)
-  ;; Take VARIABLE-VALUE pairs and make local variables initialized to the
-  ;; value.
-  (while pairs
-    (make-variable-buffer-local (car pairs))
-    (set (car pairs) (car (cdr pairs)))
-    (setq pairs (cdr (cdr pairs)))))
-
-;; ----------------------------------------------------------------------
-;; Highlighting stuff (currently either hilit19 or fontlock is used)
-;; ----------------------------------------------------------------------
-
-(hilit-set-mode-patterns
-   'gr-mode
-   '(;; comments
-	("--.*$" nil comment)
-	("\\+\\+.*$" nil comment)
-	;; hilight important bits in the header
-	("^Granularity Simulation for \\(.*\\)$" 1 glob-struct)
-	("^PEs[ \t]+\\([0-9]+\\)" 1 decl)
-	("^Latency[ \t]+\\([0-9]+\\)" 1 decl)
-	("Arith[ \t]+\\([0-9]+\\)" 1 decl)
-	("Branch[ \t]+\\([0-9]+\\)" 1 decl)
-	("Load[ \t]+\\([0-9]+\\)" 1 decl)
-	("Store[ \t]+\\([0-9]+\\)" 1 decl)
-	("Float[ \t]+\\([0-9]+\\)" 1 decl)
-	("Alloc[ \t]+\\([0-9]+\\)" 1 decl)
-	;; hilight PE number and time in each line
-	("^PE[ \t]+\\([0-9]+\\)" 1 glob-struct)
-	(" \\[\\([0-9]+\\)\\]:" 1 define)
-	;; in this case the events are the keyword
-					; ("\\(FETCH\\|REPLY\\|RESUME\\|RESUME(Q)\\|SCHEDULE\\|SCHEDULE(Q)\\|BLOCK\\|STEALING\\|STOLEN\\|STOLEN(Q)\\)[ \t]" 1 keyword)
-	("\\(FETCH\\|BLOCK\\)[ \t]" 1 label)
-	("\\(REPLY\\|RESUME(Q)\\|SCHEDULE(Q)\\|STOLEN(Q)\\)[ \t]" 1 named-param)
-	("\\(RESUME\\|SCHEDULE\\|STOLEN\\)[ \t]" 1 msg-quote)
-	("\\(STEALING\\)[ \t]" 1 keyword)
-	("\\(START\\|END\\)[ \t]" 1 defun)
-	("\\(SPARK\\|SPARKAT\\|USED\\|PRUNED\\)[ \t]" 1 crossref)
-	("\\(EXPORTED\\|ACQUIRED\\)[ \t]" 1 string)
-	;; especially interesting are END events; hightlight runtime etc
-	(",[ \t]+RT[ \t]+\\([0-9]+\\)" 1 define)
-	;; currently unused but why not?
-	("\"" ".*\"" string))
-)
-
-;; --------------------------------------------------------------------------
-;; Own fcts for selective highlighting
-;; --------------------------------------------------------------------------
-
-(defun hwl-hi-node (node)
- "Highlight node in GrAnSim profile."
- (interactive "sNode (hex): ")
- (save-excursion 
-  (let* ( (here (point))
-	  (len (length node)) )
-  (goto-char (point-min))
-  (while (search-forward node nil t)
-         (let* ( (end (point))
-                 (start (- end len)) )
-               (add-text-properties start end `(face ,hwl-hi-node-face))
-         )
-  ) )
- )
-)
-
-(defun hwl-hi-thread (task)
- "Highlight task in GrAnSim profile."
- (interactive "sTask: ")
- (save-excursion 
-  (let* ( (here (point))
-	  (len (length task))
-	  (se-str (format "[A-Z)]\\s-+%s\\(\\s-\\|,\\)" task))
-        )
-  (goto-char (point-min))
-  (while (re-search-forward se-str nil t)
-    (let ( (c (current-column)) )
-         (if (and (> c 10) (< c 70))
-            (let* ( (end (1- (point)))
-                    (start (- end len)) )
-                  (add-text-properties start end `(face ,hwl-hi-thread-face))
-         ) ) )
-  ) )
- )
-)
-
-(defun hwl-hi-line ()
- "Highlight the current line."
- (interactive)
- (save-excursion
-  (beginning-of-line)
-  (let ( (beg (point)) )
-       (end-of-line)
-       (add-text-properties beg (point) '(face highlight))
-  )
- )
-)
-
-(defun hwl-unhi-line ()
- "Unhighlight the current line."
- (interactive)
- (save-excursion
-  (beginning-of-line)
-  (let ( (beg (point)) )
-       (end-of-line)
-       (add-text-properties beg (point) '(face nil))
-  )
- )
-)
-
-; Doesn't work yet
-(defun hwl-hi-from-to (from to)
- "Highlight region between two timestamps."
- (interactive "nFrom: \nnTo:")
- (save-excursion 
-  (let* ( (here (point))
-	  (now 0)
-	  start end 
-	  (separator '"+++++")
-        )
-  (goto-char (point-min))
-    ; (re-search-forward REGEXP)
-  (search-forward separator nil t)
-  (forward-line)
-  (while (< now from) 
-    (beginning-of-line)
-    (forward-line)
-    (forward-char 7)
-    (setq beg (point))
-    (search-forward "]")
-    (setq time-str (buffer-substring beg (- (point) 2)))
-    (setq now (string-to-number time-str))
-  )
-  (if (< now from)
-    nil
-    (setq start (point))
-    (while (< now to) 
-      (beginning-of-line)
-      (forward-line)
-      (forward-char 7)
-      (setq beg (point))
-      (search-forward "]")
-      (setq time-str (buffer-substring beg (- (point) 2)))
-      (setq now (string-to-number time-str))
-    )
-    (if (< now to)
-      nil
-      (setq end (point))
-      (add-text-properties start end '(face paren-match-face))
-         )
-   ) 
-  ) ; let
- ) ; excursion
-)
-
-(defun hwl-hi-clear ()
-  (interactive)
-  (let ( (start (point-min) )
-         (end (point-max)) )
-       (remove-text-properties start end '(face nil))
-  )
-)
-
-;; --------------------------------------------------------------------------
-;; Misc Elisp functions
-;; --------------------------------------------------------------------------
-
-(defun hwl-wrap ()
-  (interactive)
-  (setq truncate-lines nil)
-  (hilit-recenter nil)
-)
-
-(defun hwl-truncate ()
-  (interactive)
-  (setq truncate-lines t)
-  (hilit-recenter nil)
-)
-
-(defun hwl-toggle-truncate-wrap ()
-  (interactive)
-  (if truncate-lines (setq truncate-lines nil)
-                     (setq truncate-lines t))
-  (hilit-recenter nil)
-)
-
-(defun hwl-narrow-to-pe (pe)
-    (interactive "nPE: ")
-    (hwl-narrow 1 pe "")
-)
-
-(defun hwl-narrow-to-thread (thread)
-    (interactive "sThread: ")
-    (hwl-narrow 2 thread "")
-)
-
-(defun hwl-narrow-to-event (event)
-    (interactive "sEvent: ")
-    (hwl-narrow 3 0 event)
-)
-
-(defun hwl-narrow (mode id str)
-  ( let* ((outbuffer (get-buffer-create "*GrAnSim Narrowed*"))
-	 ;(from (beginning-of-buffer))
-	 ;(to   (end-of-buffer))
-	 ;(to   (point))                            ; (region-end))
-	 ;(text (buffer-substring from to))         ; contains text in region
-	 (w    (selected-window))		   
-	 ;(nh   5)                                  ; height of new window
-	 ;(h    (window-height w))                  ; height of selcted window
-	 ;(h1   (if (<= h nh) (- h 1) (- h nh)))    ; height of old window
-	 (w1   (get-buffer-window outbuffer 'visible))
-
-	 (infile (buffer-file-name))                ; or 
-	 (inbuffer (current-buffer))
-	 (command "tf")
-	 ;(mode_opt (cond ((eq mode 1) "-p")
-	 ;	         ((eq mode 2) "-t")
-	 ;	         ((eq mode 3) "-e")
-	 ;		 (t "-v")))
-	)
-        (if w1 (message "Window *GrAnSim Narrowed* already visible") 
-               (split-window w nil nil))
-        (switch-to-buffer-other-window outbuffer)
-	(erase-buffer)
-	(setq truncate-lines t)
-	(gr-mode)
-	;(beginning-of-buffer)
-	;(set-mark)
-	;(end-of-buffer)
-	;(delete-region region-beginning region-end)
-	(cond ((eq mode 1)
-	       ;(message (format "Narrowing to Processor %d" id))
-		(call-process command nil outbuffer t "-p" (format "%d" id) infile ))
-	      ((eq mode 2)
-	       ;(message (format "Narrowing to Thread %d" id))
-		(call-process command nil outbuffer t "-t" (format "%s" id) infile ))
-	      ((eq mode 3)
-	       ;(message (format "Narrowing to Event %s" str))
-		(call-process command nil outbuffer t "-e" str infile ))
-	      )
-  )
-)
-
-(defun hwl-command-on-buffer (prg opts file)
-  (interactice "CProgram:\nsOptions:\nfFile:")
-  ( let* ((outbuffer (get-buffer-create "*GrAnSim Command*"))
-	 (from (beginning-of-buffer))
-	 (to   (end-of-buffer))
-	 ;(to   (point))                            ; (region-end))
-	 ;(text (buffer-substring from to))         ; contains text in region
-	 (w    (selected-window))		   
-	 ;(nh   5)                                  ; height of new window
-	 ;(h    (window-height w))                  ; height of selcted window
-	 ;(h1   (if (<= h nh) (- h 1) (- h nh)))    ; height of old window
-	 (w1   (get-buffer-window outbuffer 'visible))
-
-	 (infile (buffer-file-name))                ; or 
-	 (inbuffer (current-buffer))
-	 ;(command "tf")
-	 ;(mode_opt (cond ((eq mode 1) "-p")
-	 ;	         ((eq mode 2) "-t")
-	 ;	         ((eq mode 3) "-e")
-	 ;		 (t "-v")))
-	)
-        (if w1 (message "Window *GrAnSim Command* already visible") 
-               (split-window w nil nil))
-        (switch-to-buffer-other-window outbuffer)
-	(erase-buffer)
-	(setq truncate-lines t)
-	(gr-mode)
-	(call-process prg nil outbuffer opts file)
-  )
-)
-
-;; ToDo: Elisp Fcts for calling scripts like gr3ps etc
-
-(define-key gr-mode-map "\C-ct" 'hwl-truncate)
-(define-key gr-mode-map "\C-cw" 'hwl-wrap)
-(define-key gr-mode-map "\C-ch" 'hilit-rehighlight-buffer)
-(define-key gr-mode-map "\C-cp" 'hwl-narrow-to-pe)
-(define-key gr-mode-map "\C-ct" 'hwl-narrow-to-thread)
-(define-key gr-mode-map "\C-ce" 'hwl-narrow-to-event)
-(define-key gr-mode-map "\C-c\C-e" '(lambda () (hwl-narrow-to-event "END")))
-(define-key gr-mode-map "\C-c " 'hwl-toggle-truncate-wrap)
-(define-key gr-mode-map "\C-cN" 'hwl-hi-node)
-(define-key gr-mode-map "\C-cT" 'hwl-hi-thread)
-(define-key gr-mode-map "\C-c\C-c" 'hwl-hi-clear)
-
-;; ---------------------------------------------------------------------------
-;; Mode for threaded C files
-;; ---------------------------------------------------------------------------
-
-(setq auto-mode-alist
-      (append '(("\\.hc" . hc-mode))
-	     auto-mode-alist))
-
-(define-derived-mode hc-mode c-mode "hc Mode"
-  "Derived mode for Haskell C files."
-)
-
-(hilit-set-mode-patterns
-      'hc-mode
-      '(
-	("\\(GRAN_FETCH\\|GRAN_RESCHEDULE\\|GRAN_FETCH_AND_RESCHEDULE\\|GRAN_EXEC\\|GRAN_YIELD\\)" 1 keyword)
-	("FB_" nil defun)
-	("FE_" nil  define)
-	("__STG_SPLIT_MARKER" nil msg-note)
-	("^.*_ITBL.*$" nil defun)
-	("^\\(I\\|E\\|\\)FN.*$" nil define)
-	)
-)
-
-; (define-key global-map [S-pause] 'hc-mode)
diff --git a/ghc/utils/parallel/Makefile b/ghc/utils/parallel/Makefile
deleted file mode 100644
index 094c5cbba1..0000000000
--- a/ghc/utils/parallel/Makefile
+++ /dev/null
@@ -1,49 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-PERL_PROGS = \
-  grs2gr gr2qp qp2ps ghc-fool-sort ghc-unfool-sort gr2pe gr2java \
-  qp2ap gr2RTS RTS2gran gran-extr gp-ext-imp tf avg-RTS SPLIT \
-  AVG SN get_SN sn_filter ps-scale-y
-
-
-BASH_PROGS = gr2ps gr2jv gr2ap gr2gran
-
-#
-# One rule fits all, not particularly selective.
-#
-$(PERL_PROGS) : $(patsubst %,%.pl,$(PERL_PROGS))
-$(BASH_PROGS) : $(patsubst %,%.bash,$(BASH_PROGS))
-
-
-all :: $(PERL_PROGS) $(BASH_PROGS)
-
-$(PERL_PROGS) :
-	$(RM) $@
-	@echo Creating $@...
-	@echo "#!"$(PERL) > $@
-	@cat $@.pl >> $@
-	@chmod a+x $@
-
-$(BASH_PROGS) :
-	$(RM) $@
-	@echo Creating $@...
-	@echo "#!"$(BASH) > $@
-	@cat $@.bash >> $@
-	@chmod a+x $@
-
-#
-# You'll only get this with Parallel Haskell or 
-# GranSim..
-#
-ifeq "$(BuildingParallel)" "YES"
-INSTALL_SCRIPTS += $(BASH_PROGS) $(PERL_PROGS)
-else
-ifeq "$(BuildingGranSim)" "YES"
-INSTALL_SCRIPTS += $(BASH_PROGS) $(PERL_PROGS)
-endif
-endif
-
-CLEAN_FILES     += $(BASH_PROGS) $(PERL_PROGS)
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/parallel/RTS2gran.pl b/ghc/utils/parallel/RTS2gran.pl
deleted file mode 100644
index 32012afac8..0000000000
--- a/ghc/utils/parallel/RTS2gran.pl
+++ /dev/null
@@ -1,684 +0,0 @@
-#!/usr/local/bin/perl
-##############################################################################
-# Time-stamp: <Mon May 20 1996 17:22:45 Stardate: [-31]7533.41 hwloidl>
-#
-# Usage: RTS2gran <RTS-file>
-#
-# Options:
-#  -t <file>   ... use <file> as template file (<,> global <.> local template)
-#  -p <file>   ... use <file> as gnuplot .gp file (default: gran.gp)
-#  -x <x-size> ... of gnuplot graph
-#  -y <y-size> ... of gnuplot graph
-#  -n <n>      ... use <n> as number of PEs in title 
-#  -h          ... help; print this text.
-#  -v          ... verbose mode.
-#
-##############################################################################
-
-# ----------------------------------------------------------------------------
-# Command line processing and initialization
-# ----------------------------------------------------------------------------
-
-$gran_dir = $ENV{'GRANDIR'};
-if ( $gran_dir eq "" ) {
-    print STDERR "RTS2gran: Warning: Env variable GRANDIR is undefined\n";
-}
-
-push(@INC, $gran_dir, $gran_dir . "/bin");
-# print STDERR "INC: " . join(':',@INC) . "\n";
-
-require "getopts.pl";
-require "template.pl";      # contains read_template for parsing template file
-require "stats.pl";          # statistics package with corr and friends
-
-&Getopts('hvt:p:x:y:n:Y:Z:');  
-
-$OPEN_INT = 1;
-$CLOSED_INT = 0;
-
-do process_options();
-
-if ( $opt_v ) {
-    do print_verbose_message ();
-}
-
-# ----------------------------------------------------------------------------
-# The real thing
-# ----------------------------------------------------------------------------
-
-$max_y = &pre_process($input);
-
-open(INPUT,"<$input") || die "Couldn't open input file $input";
-open(OUT_CUMU,">$cumulat_rts_file_name") || die "Couldn't open output file $cumulat_rts_file_name";
-open(OUT_CUMU0,">$cumulat0_rts_file_name") || die "Couldn't open output file $cumulat0_rts_file_name";
-
-#do skip_header();
-
-$tot_total_rt = 0;
-$tot_rt = 0;
-$count = 0;
-$last_rt = 0;
-$last_x = 0;
-$last_y = ($logscale{"'g'"} ne "") ? 1 : 0;
-
-$line_no = 0;
-while (<INPUT>) {
-    $line_no++;
-    next                     if /^--/;     # Comment lines start with --
-    next		     if /^\s*$/;   # Skip empty lines
-    $rt = $1                 if /^(\d+)/;
-    $count++;
-
-    if ( $opt_D ) {
-	print STDERR "Error @ line $line_no: RTS file not sorted!\n";
-    }
-
-    #push(@all_rts,$rt);
-    $sum_rt += $rt;
-
-    $index = do get_index_open_int($rt,@exec_times);
-    $exec_class[$index]++;
-
-    if ( $last_rt != $rt ) { 
-	print OUT_CUMU "$rt \t" . int($last_y/$max_y) . "\n";
-	print OUT_CUMU0 "$rt \t$last_y\n";
-	print OUT_CUMU "$rt \t" . int($count/$max_y) . "\n";
-	print OUT_CUMU0 "$rt \t$count\n";
-	$last_x = $rt;
-	$last_y = $count;
-    }
-
-    $last_rt = $rt;
-}
-print OUT_CUMU "$rt \t" . int($last_y/$max_y) . "\n";
-print OUT_CUMU0 "$rt \t$last_y\n";
-print OUT_CUMU "$rt \t" . int($count/$max_y) . "\n";
-print OUT_CUMU0 "$rt \t$count\n";
-
-close OUT_CUMU;
-close OUT_CUMU0;
-
-$tot_tasks = $count;         # this is y-max in cumulat graph
-$max_rt = $rt;               # this is x-max in cumulat graph
-
-$max_rt_class = &list_max(@exec_class);
-
-do write_data($gran_file_name, $OPEN_INT, $logscale{"'g'"}, $#exec_times+1,
-              @exec_times, @exec_class);
-
-# ----------------------------------------------------------------------------
-# Run GNUPLOT over the data files and create figures
-# ----------------------------------------------------------------------------
-
-do gnu_plotify($gp_file_name); 
-
-# ----------------------------------------------------------------------------
-
-if ( $max_y != $tot_tasks ) {
-    if ( $pedantic ) {
-	die "ERROR: pre-processed number of tasks ($max_y) does not match computed one ($tot_tasks)\n";
-    } else {
-	print STDERR "Warning: pre-processed number of tasks ($max_y) does not match computed one ($tot_tasks)\n" if $opt_v;
-    }
-}
-
-exit 0;
-
-# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-# ToDo: Put these routines into an own package
-# ----------------------------------------------------------------------------
-# Basic Operations on the intervals
-# ----------------------------------------------------------------------------
-
-sub get_index_open_int {
-    local ($value,@list) = @_;
-    local ($index,$right);
-
-    # print "get_index: searching for index of" . $value;
-    # print " in " . join(':',@list);
-
-      $index = 0;
-      $right = $list[$index];
-      while ( ($value >= $right) && ($index < $#list) ) {
-  	$index++;
-        $right = $list[$index];
-      }
-    
-      return ( ($index == $#list) && ($value > $right) ) ? $index+1 : $index;
-}
-
-# ----------------------------------------------------------------------------
-
-sub get_index_closed_int {
-    local ($value,@list) = @_;
-    local ($index,$right);
-
-      if ( ($value < $list[0]) || ($value > $list[$#list]) ) {
-	  return ( -1 );
-      }
-
-      $index = 0;
-      $left = $list[$index];
-      while ( ($left <= $value) && ($index < $#list) ) {
-  	$index++;
-        $left = $list[$index];
-      }
-      return ( $index-1 );
-}
-
-# ----------------------------------------------------------------------------
-# Write operations
-# ----------------------------------------------------------------------------
-
-sub write_data {
-    local ($file_name, $open_int, $logaxes, $n, @rest) = @_;
-    local (@times) = splice(@rest,0,$n);
-    local (@class) = @rest;
-
-    open(GRAN,">$file_name") || die "Couldn't open file $file_name for output";
-
-    if ( $open_int == $OPEN_INT ) {
-
-      for ($i=0, 
-           $left = ( index($logaxes,"x") != -1 ? int($times[0]/2) : 0 ), 
-           $right = 0; 
-           $i < $n; 
-           $i++, $left = $right) {
-         $right = $times[$i];
-         print GRAN int(($left+$right)/2) . "  " . 
-                    ($class[$i] eq "" ? "0" : $class[$i]) . "\n"; 
-      }
-      print GRAN $times[$n-1]+(($times[$n-1]-$times[$n-2])/2) . "  " . 
-                 ($class[$n] eq "" ? "0" : $class[$n]) . "\n";
-
-     } else {
-
-      print GRAN ( (index($logaxes,"x") != -1) && ($times[0] == 0 ? int($times[1]/2) : ($times[$1] + $times[0])/2 ) .  "  " . $class[0] . "\n");
-      for ($i=1; $i < $n-2; $i++) {
-         $left = $times[$i];
-         $right = $times[$i+1];
-         print(GRAN ($left+$right)/2 . "  " . 
-                    ($class[$i] eq "" ? "0" : $class[$i]) . "\n"); 
-      }
-      print GRAN ($times[$n-1]+$times[$n-2])/2 . "  " . $class[$n-2]  if $n >= 2;
-    }
-
-    close(GRAN);
-}
-
-# ----------------------------------------------------------------------------
-
-sub write_array {
-    local ($file_name,$n,@list) = @_;
-
-    open(FILE,">$file_name") || die "$file_name: $!";
-    for ($i=0; $i<=$#list; $i++) {
-	print FILE $i . "  " .  ( $list[$i] eq "" ? "0" : $list[$i] ) . "\n";
-    }
-
-    if ( $opt_D ) {
-	print "write_array: (" . join(", ",1 .. $#list) . ")\n for file $file_name returns: \n (0, $#list, &list_max(@list)\n";
-    } 
-
-    return ( (0, $#list, &list_max(@list), 
-              "(" . join(", ",1 .. $#list) . ")\n") );
-}
-
-# ----------------------------------------------------------------------------
-
-sub gnu_plotify {
-  local ($gp_file_name) = @_;
-
-  @open_xrange = &range($OPEN_INT,$logscale{"'g'"},@exec_times);
-
-  $exec_xtics = $opt_T ? &get_xtics($OPEN_INT,@exec_times) : "" ;
-
-  open(GP_FILE,">$gp_file_name") || 
-      die "Couldn't open gnuplot file $gp_file_name for output\n";
-
-  print GP_FILE "set term postscript \"Roman\" 20\n";
-  do write_gp_record(GP_FILE,
-                     $gran_file_name, &dat2ps_name($gran_file_name),
-                     "Granularity (pure exec. time)", "Number of threads", 
-		     $logscale{"'g'"},
-                     @open_xrange,$max_rt_class,$exec_xtics);
-
-  do write_gp_lines_record(GP_FILE,
-                           $cumulat_rts_file_name, &dat2ps_name($cumulat_rts_file_name),
-                           "Cumulative pure exec. times","% of threads",
-  			   "",
-                           $max_rt, 100, ""); 
-                           # $xtics_cluster_rts as last arg?
-  
-  do write_gp_lines_record(GP_FILE,
-                           $cumulat0_rts_file_name, &dat2ps_name($cumulat0_rts_file_name),
-                           "Cumulative pure exec. times","Number of threads",
-  			   $logscale{"'Cg'"},
-                           $max_rt, $tot_tasks, ""); 
-                           # $xtics_cluster_rts as last arg?
-
-  close GP_FILE;
-
-  print "Gnu plotting figures ...\n";
-  system "gnuplot $gp_file_name";
-
-  print "Extending thickness of impulses ...\n";
-  do gp_ext($gran_file_name);
-}
-
-# ----------------------------------------------------------------------------
-
-sub gp_ext {
-    local (@file_names) = @_;
-    local ($file_name);
-    local ($ps_file_name);
-    local ($prg);
-
-    #$prg = system "which gp-ext-imp";
-    #print "  Using script $prg for impuls extension\n";
-    $prg = $ENV{GRANDIR} ? $ENV{GRANDIR} . "/bin/gp-ext-imp" 
-	                 : $ENV{HOME} . "/bin/gp-ext-imp" ;
-    if ( $opt_v ) {
-	print "    (using script $prg)\n";
-    }
-
-    foreach $file_name (@file_names) {
-	$ps_file_name = &dat2ps_name($file_name);
-        system "$prg -w $ext_size -g $gray " . 
-               $ps_file_name  . " " . 
-               $ps_file_name . "2" ;
-        system "mv " . $ps_file_name . "2 " . $ps_file_name;
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub write_gp_record {
-    local ($file,$in_file,$out_file,$xlabel,$ylabel,$logaxes,
-           $xstart,$xend,$ymax,$xtics) = @_;
-
-    if ( $xstart >= $xend ) {
-	print ("WARNING: empty xrange [$xstart:$xend] changed to [$xstart:" . $xstart+1 . "]\n")        if ( $pedantic || $opt_v );
-	$xend = $xstart + 1;	
-    }
-
-    if ( $ymax <=0 ) {
-	$ymax = 2;
-	print "WARNING: empty yrange changed to [0:$ymax]\n"   if ( $pedantic || $opt_v );
-    }
-
-    $str = "set size " . $xsize . "," . $ysize . "\n" .
-           "set xlabel \"" . $xlabel . "\"\n" .
-           "set ylabel \"" . $ylabel . "\"\n" .
-           ($xstart eq "" ? "" 
-                          : "set xrange [" . int($xstart) .":" . int($xend) . "]\n") .
-           ($opt_Y ? 
-	      ("set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) . ":$opt_Y]\n") :
-	      ($ymax eq "" ? "" 
-                        : "set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) . 
-                          ":" . &list_max(2,int($ymax+$ymax/5)) . "]\n")) .
-           ($xtics ne "" ? "set xtics $xtics" : "") . 
-	   "set tics out\n" .
-           "set border\n" .
-           ( $nPEs!=0 ? "set title \"$nPEs PEs\"\n" : "" ) .
-	   "set nokey \n" .
-           "set nozeroaxis\n" .
-	   "set format xy \"%8.8g\"\n" .
-           (index($logaxes,"x") != -1 ? 
-               "set logscale x\n" : 
-               "set nologscale x\n") .
-           (index($logaxes,"y") != -1 ? 
-               "set logscale y\n" : 
-               "set nologscale y\n") .
-           "set output \"" . $out_file . "\"\n" .
-	   "plot \"" . $in_file . "\" with impulses\n\n";
-    print $file $str;
-}
-
-# ----------------------------------------------------------------------------
-
-sub write_gp_lines_record {
-    local ($file,$in_file,$out_file,$xlabel,$ylabel,$logaxes,
-           $xend,$yend,$xtics) = @_;
-
-    local ($str);
-
-    $str = "set xlabel \"" . $xlabel . "\"\n" .
-           "set ylabel \"" . $ylabel . "\"\n" .
-	   "set xrange [" . ( index($logaxes,"x") != -1 ? 1 : 0 ) . ":$xend]\n" .
-	   "set yrange [" . ( index($logaxes,"y") != -1 ? 1 : 0 ) . 
-	       ($yend!=100 && $opt_Z ? ":$opt_Z]\n" : ":$yend]\n") .
-           "set border\n" .
-           "set nokey\n" .
-           ( $xtics ne "" ? "set xtics $xtics" : "" ) .
-           (index($logaxes,"x") != -1 ? 
-               "set logscale x\n" : 
-               "set nologscale x\n") .
-           (index($logaxes,"y") != -1 ? 
-               "set logscale y\n" : 
-               "set nologscale y\n") .
-           "set nozeroaxis\n" .
-	   "set format xy \"%8.8g\"\n" .
-           "set output \"" . $out_file . "\"\n" .
-	   "plot \"" . $in_file . "\" with lines\n\n";
-    print $file $str;
-}
-
-
-# ----------------------------------------------------------------------------
-
-sub write_gp_simple_record {
-    local ($file,$in_file,$out_file,$xlabel,$ylabel,$logaxes,
-           $xstart,$xend,$ymax,$xtics) = @_;
-
-    $str = "set size " . $xsize . "," . $ysize . "\n" .
-           "set xlabel \"" . $xlabel . "\"\n" .
-           "set ylabel \"" . $ylabel . "\"\n" .
-           ($xstart eq "" ? "" 
-                          : "set xrange [" . int($xstart) .":" . int($xend) . "]\n") .
-           ($ymax eq "" ? "" 
-                        : "set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) . 
-                          ":" . &list_max(2,int($ymax+$ymax/5)) . "]\n") .
-           ($xtics ne "" ? "set xtics $xtics" : "") . 
-           "set border\n" .
-           "set nokey\n" .
-	   "set tics out\n" .
-           "set nozeroaxis\n" .
-	   "set format xy \"%8.8g\"\n" .
-           (index($logaxes,"x") != -1 ? 
-               "set logscale x\n" : 
-               "set nologscale x\n") .
-           (index($logaxes,"y") != -1 ? 
-               "set logscale y\n" : 
-               "set nologscale y\n") .
-           "set output \"" . $out_file . "\"\n" .
-	   "plot \"" . $in_file . "\" with impulses\n\n";
-    print $file $str;
-}
-
-# ----------------------------------------------------------------------------
-
-sub range {
-    local ($open_int, $logaxes, @ints) = @_;
-
-    local ($range, $left_margin, $right_margin);
-
-    $range = $ints[$#ints]-$ints[0];
-    $left_margin = 0; # $range/10;
-    $right_margin = 0; # $range/10;
-
-    if ( $opt_D ) {
-       print "\n==> Range: logaxes are $logaxes i.e. " . 
-	   (index($logaxes,"x") != -1 ? "matches x axis\n" 
-	                              : "DOESN'T match x axis\n"); 
-    }
-    if ( index($logaxes,"x") != -1 ) {
-	if ( $open_int == $OPEN_INT ) {
-	    return ( ($ints[0]/2-$left_margin, 
-		      $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
-	} else {
-	    return ( ( &list_max(1,$ints[0]-$left_margin), 
-		       $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
-	}
-    } else {
-	if ( $open_int == $OPEN_INT ) {
-	    return ( ($ints[0]/2-$left_margin, 
-		      $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
-	} else {
-	    return ( ($ints[0]-$left_margin, 
-		      $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
-	}
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-# ----------------------------------------------------------------------------
-
-sub process_options {
-    if ( $opt_h ) {                      
-	open(ME,$0) || die "Can't open myself ($0)";
-	$n = 0;
-	while (<ME>) {
-	    last if $_ =~ /^$/;
-	    print $_;
-	    $n++;
-	}
-	close(ME);
-	
-	# system "cat $0 | awk 'BEGIN { n = 0; } \
-	#                             /^$/ { print n; \
-	#                                    exit; } \
-	#                                  { n++; }'"
-	exit ;
-    }
-
-    $input = $#ARGV == -1 ? "-" : $ARGV[0] ;
-    
-    if ( $#ARGV != 0 ) {
-	#print "Usage: gran-extr [options] <sim-file>\n";
-	#print "Use -h option to get details\n";
-	#exit 1;
-	
-    }
-
-    # Default settings:
-    $gp_file_name = "gran.gp";
-    $gran_file_name = "gran.dat";
-    $cumulat_rts_file_name = "cumu-rts.dat";
-    $cumulat0_rts_file_name = "cumu-rts0.dat";
-    $xsize = 1;
-    $ysize = 1;
-
-    if ( $opt_p ) {
-	$gp_file_name = $opt_p;
-    } else {
-	$gp_file_name = "gran.gp";
-    }
-
-    #if ( $opt_s ) {
-    #	$gp_file_name =~ s|\.|${opt_s}.|;
-    #	$gran_file_name =~ s|\.|${opt_s}.|;
-    #	$cumulat_rts_file_name =~ s|\.|${opt_s}.|;
-    #	$cumulat0_rts_file_name =~ s|\.|${opt_s}.|;
-    #}
-    
-    if ( $opt_x ) {
-	$xsize = $opt_x;
-    } else {
-	$xsize = 1;
-    }
-    
-    if ( $opt_y ) {
-	$ysize = $opt_y;
-    } else {
-	$ysize = 1;
-    }
-    
-    if ( $opt_t ) {
-	do read_template($opt_t,$input);
-    }
-    
-}
-
-# ----------------------------------------------------------------------------
-
-sub print_verbose_message { 
-
-    print "-" x 70 . "\n";
-    print "Setup: \n";
-    print "-" x 70 . "\n";
-    print "\nFilenames: \n";
-    print "  Input file: $input\n";
-    print "  Gran files: $gran_file_name $gran_global_file_name $gran_local_file_name\n"; 
-    print "  Comm files: $comm_file_name $comm_global_file_name $comm_local_file_name\n";
-    print "  Sparked threads file: $spark_file_name $spark_local_file_name $spark_global_file_name\n";
-    print "  Heap file: $ha_file_name\n";
-    print "  GNUPLOT file name: $gp_file_name   Correlation file name: $corr_file_name\n";
-    print "  Cumulative RT file name: $cumulat_rts_file_name ($cumulat0_rts_file_name)   \n  Cumulative HA file name: $cumulat_has_file_name\n";
-    print "  Cluster RT file name: $clust_rts_file_name   \n  Cluster HA file name: $clust_has_file_name\n";
-    print "  Cumulative runtimes file name:    $cumulat_rts_file_name\n";
-    print "  Cumulative heap allocations file name   $cumulat_has_file_name\n";
-    print "  Cluster run times file name:    $clust_rts_file_name\n";
-    print "  Cluster heap allocations file name:    $clust_has_file_name\n";
-    print "  PE load file name:    $pe_file_name\n";
-    print "  Site size file name:    $sn_file_name\n";
-    print "\nBoundaries: \n";
-    print "  Gran boundaries: (" . join(',',@exec_times) . ")\n";
-    print "  Comm boundaries: (" . join(',',@comm_percs) . ")\n";
-    print "  Sparked threads boundaries: (" . join(',',@sparks) . ")\n";
-    print "  Heap boundaries: (" . join(',',@has) .")\n";
-    print "\nOther pars: \n";
-    print "  Left margin: $left_margin  Right margin: $right_margin\n";
-    print "  GP-extension: $ext_size  GP xsize: $xsize  GP ysize: $ysize\n";
-    print "  Gray scale: $gray  Smart x-tics is " . ($opt_T ? "ON" : "OFF") .
-	  "  Percentage y-axis is " . ($opt_P ? "ON" : "OFF") . "\n";
-    print "  Log. scaling assoc list: ";
-    while (($key,$value) = each %logscale) {
-        print "$key: $value, ";
-    }
-    print "\n";
-    print "  Active template file: $templ_file\n"              if $opt_t;  
-    print "-" x 70 . "\n";
-}
-
-# ----------------------------------------------------------------------------
-
-sub pre_process {
-    local ($file) = @_;
-
-    open(PIPE,"wc -l $input |") || die "Couldn't open pipe";
-
-    while (<PIPE>) {		
-	if (/^\s*(\d+)/) {
-	    $res = $1; 
-	} else {
-	    die "Error in pre-processing: Last line of $file does not match RTS!\n";
-	}
-    }
-    close(PIPE);
-
-    return ($res-1);
-}
-
-# ----------------------------------------------------------------------------
-
-
-# ----------------------------------------------------------------------------
-#
-# Old version (eventually delete it)
-# New version is in template.pl
-# 
-# sub read_template {
-#     local ($f);
-# 
-#     if ( $opt_v ) {
-# 	print "Reading template file $templ_file_name ...\n";
-#     }
-# 
-#     ($f = ($input eq "-" ? "stdin" : $input)) =~ s/.rts//;
-# 
-#     open(TEMPLATE,"cat $templ_file_name | sed -e 's/\$0/$f/' |") 
-# 	|| die "Couldn't open file $templ_file_name";
-# 
-#     while (<TEMPLATE>) {
-#       next if /^\s*$/ || /^--/;
-#       if (/^\s*G[:,;.\s]+([^\n]+)$/) {
-# 	  $list_str = $1;
-#           $list_str =~ s/[\(\)\[\]]//g;
-#           @exec_times = split(/[,;. ]+/, $list_str);
-#       } elsif (/^\s*F[:,;.\s]+([^\n]+)$/) {
-# 	  $list_str = $1;
-#           $list_str =~ s/[\(\)\[\]]//g;
-#           @fetch_times = split(/[,;. ]+/, $list_str);
-#       } elsif (/^\s*A[:,;.\s]+([^\n]+)$/) {
-# 	  $list_str = $1;
-#           $list_str =~ s/[\(\)\[\]]//g;
-#           @has = split(/[,;. ]+/, $list_str);
-#       } elsif (/^\s*C[:,;.\s]+([^\n]+)$/) {
-# 	  $list_str = $1;
-#           $list_str =~ s/[\(\)\[\]]//g;
-#           @comm_percs = split(/[,;. ]+/, $list_str);
-#       } elsif (/^\s*S[:,;.\s]+([^\n]+)$/) {
-# 	  $list_str = $1;
-#           $list_str =~ s/[\(\)\[\]]//g;
-#           @sparks = split(/[,;. ]+/, $list_str);
-#       } elsif (/^\s*g[:,;.\s]+([\S]+)$/) {
-#          ($gran_file_name,$gran_global_file_name, $gran_local_file_name) = 
-#            &mk_global_local_names($1);
-#       } elsif (/^\s*f[:,;.\s]+([\S]+)$/) {
-#          ($ft_file_name,$ft_global_file_name, $ft_local_file_name) = 
-#            &mk_global_local_names($1);
-#       } elsif (/^\s*c[:,;.\s]+([\S]+)$/) {
-#          ($comm_file_name, $comm_global_file_name, $comm_local_file_name) = 
-#            &mk_global_local_names($1);
-#       } elsif (/^\s*s[:,;.\s]+([\S]+)$/) {
-#          ($spark_file_name, $spark_global_file_name, $spark_local_file_name) = 
-#            &mk_global_local_names($1);
-#       } elsif (/^\s*a[:,;.\s]+([\S]+)$/) {
-#          ($ha_file_name, $ha_global_file_name, $ha_local_file_name) = 
-#            &mk_global_local_names($1);
-#       } elsif (/^\s*p[:,;.\s]+([\S]+)$/) {
-#          $gp_file_name = $1;
-# 	 $ps_file_name = &dat2ps_name($gp_file_name);
-# 
-#       } elsif (/^\s*Xcorr[:,;.\s]+([\S]+)$/) {
-#          $corr_file_name = $1;
-#       } elsif (/^\s*Xcumulat-rts[:,;.\s]+([\S]+)$/) {
-#          $cumulat_rts_file_name = $1;
-# 	 ($cumulat0_rts_file_name = $1) =~ s/\./0./;
-#       } elsif (/^\s*Xcumulat-has[:,;.\s]+([\S]+)$/) {
-#          $cumulat_has_file_name = $1;
-#       } elsif (/^\s*Xcumulat-fts[:,;.\s]+([\S]+)$/) {
-#          $cumulat_fts_file_name = $1;
-#       } elsif (/^\s*Xcumulat-cps[:,;.\s]+([\S]+)$/) {
-#          $cumulat_cps_file_name = $1;
-#       } elsif (/^\s*Xclust-rts[:,;.\s]+([\S]+)$/) {
-#          $clust_rts_file_name = $1;
-#       } elsif (/^\s*Xclust-has[:,;.\s]+([\S]+)$/) {
-#          $clust_has_file_name = $1;
-#       } elsif (/^\s*Xclust-fts[:,;.\s]+([\S]+)$/) {
-#          $clust_fts_file_name = $1;
-#       } elsif (/^\s*Xclust-cps[:,;.\s]+([\S]+)$/) {
-#          $clust_cps_file_name = $1;
-#       } elsif (/^\s*Xpe[:,;.\s]+([\S]+)$/) {
-#          $pe_file_name = $1;
-#       } elsif (/^\s*Xsn[:,;.\s]+([\S]+)$/) {
-#          $sn_file_name = $1;
-# 
-#       } elsif (/^\s*XRTS[:,;.\s]+([\S]+)$/) {
-# 	  $rts_file_name = $1;
-#       } elsif (/^\s*XHAS[:,;.\s]+([\S]+)$/) {
-# 	  $has_file_name = $1;
-#       } elsif (/^\s*XFTS[:,;.\s]+([\S]+)$/) {
-# 	  $fts_file_name = $1;
-#       } elsif (/^\s*XLSPS[:,;.\s]+([\S]+)$/) {
-# 	  $lsps_file_name = $1;
-#       } elsif (/^\s*XGSPS[:,;.\s]+([\S]+)$/) {
-# 	  $gsps_file_name = $1;
-#       } elsif (/^\s*XCPS[:,;.\s]+([\S]+)$/) {
-# 	  $cps_file_name = $1;
-#       } elsif (/^\s*XCCPS[:,;.\s]+([\S]+)$/) {
-# 	  $ccps_file_name = $1;
-# 
-#       } elsif (/^\s*\-[:,;.\s]+([\S]+)$/) {
-#          $input = $1;
-#       } elsif (/^\s*L[:,;\s]+(.*)$/) {
-# 	 $str = $1;
-# 	 %logscale = ('g',"xy",'a',"xy",'Cg',"xy",'Ca',"xy",'Yp',"y",'Ys',"y") , next  if $str eq ".";
-#          $str =~ s/[\(\)\[\]]//g;
-#          %logscale = split(/[,;. ]+/, $str);
-#       } elsif (/^\s*i[:,;.\s]+([\S]+)$/) {
-# 	 $gray = $1;
-#       } elsif (/^\s*k[:,;.\s]+([\S]+)$/) {
-# 	 $no_of_clusters = $1;
-#       } elsif (/^\s*e[:,;.\s]+([\S]+)$/) {
-# 	 $ext_size = $1;
-#       } elsif (/^\s*v.*$/) {
-# 	 $verbose = 1;
-#       } elsif (/^\s*T.*$/) {
-# 	 $opt_T = 1;
-#      }
-#   }
-#   close(TEMPLATE);
-# }      
diff --git a/ghc/utils/parallel/SN.pl b/ghc/utils/parallel/SN.pl
deleted file mode 100644
index bc33e2a60c..0000000000
--- a/ghc/utils/parallel/SN.pl
+++ /dev/null
@@ -1,280 +0,0 @@
-#!/usr/local/bin/perl
-#                                      (C) Hans Wolfgang Loidl, November 1995
-#############################################################################
-# Time-stamp: <Sun Nov  5 1995 00:23:45 Stardate: [-31]6545.08 hwloidl>
-#
-# Usage: SN [options] <gr-file>
-#
-# Create a summary of spark names that occur in gr-file (only END events in 
-# gr-file are necessary). Creates a gnuplot impulses graph (spark names by 
-# number of threads) as summary.
-#
-# Options:
-#  -h        ... help; print this text.
-#  -v        ... verbose mode.
-#
-#############################################################################
-
-$gran_dir = $ENV{'GRANDIR'};
-if ( $gran_dir eq "" ) {
-    print STDERR "SN: Warning: Env variable GRANDIR is undefined\n";
-}
-
-push(@INC, $gran_dir, $gran_dir . "/bin");
-# print STDERR "INC: " . join(':',@INC) . "\n";
-
-require "getopts.pl";
-require "par-aux.pl";
-require "stats.pl";
-
-&Getopts('hv');  
-
-do process_options();
-
-if ( $opt_v ) { do print_verbose_message(); }
-
-# ---------------------------------------------------------------------------
-# Init
-# ---------------------------------------------------------------------------
-
-chop($date = `date`);
-chop($stardate = `stardate`);
-
-open (IN,"<$input") || die "$!: $input";
-$n = 0;
-$is_end=0;
-while (<IN>) {
-    $is_end = 1 if /END\s+(\w+).*SN\s+(\d+).*RT\s*(\d+)/;
-    next unless $is_end;
-    $n++;
-    $sn = $2;
-    $rt = $3;
-    #$sn_dec = hex($sn);
-    $num_sns{$sn}++;
-    $rts_sns{$sn} += $rt;
-    #do inc ($sn_dec);
-    $is_end=0;
-}
-close (IN);
-
-@sorted_keys=sort {$a<=>$b} keys(%num_sns);
-#$max_val=&list_max(@sorted_keys);
-
-open (SUM,">$summary") || die "$!: $summary";
-
-print SUM "# Generated by SN at $date $stardate\n";
-print SUM "# Input file: $input\n";
-print SUM "#" . "-"x77 . "\n";
-print SUM "Total number of threads: $n\n";
-print SUM "# Format: SN: Spark Site N: Number of threads AVG: average RT\n";
-# . "RTS: Sum of RTs ";
-
-foreach $k (@sorted_keys) {
-    $num = $num_sns{$k};
-    $rts = $rts_sns{$k};
-    $avg = $rts/$num;
-    #print SUM "SN: $k \tN: $num \tRTS: $rts \tAVG: $avg\n";
-    print SUM "$k \t$num \t$avg\n";
-}
-close (SUM);
-
-open (OUT,">$output") || die "$!: $output";
-print OUT "# Generated by SN at $date $stardate\n";
-print OUT "# Input file: $input\n";
-print OUT "#" . "-"x77 . "\n";
-
-$max_val=0;
-foreach $k (@sorted_keys) {
-    $num = $num_sns{$k};
-    $max_val = $num      if $num > $max_val;
-    print OUT "$k\t$num\n";
-}
-close (OUT);
-
-do write_gp($gp_file,$ps_file); 
-
-print "Gnu plotting figures ...\n";
-system "gnuplot $gp_file";
-
-print "Extending thickness of impulses ...\n";
-$ext_size = 100;
-$gray = 0.3;
-do gp_ext($ps_file);
-
-exit (0);
-
-# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-sub inc {
-    local ($sn) = @_;
-    local (@k);
-    
-    @k = keys(%num_sns);
-    if ( &is_elem($sn, @k) ) { 
-	$num_sns{$sn}++;
-    } else {
-	$num_sns{$sn} = 1;
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub is_elem { 
-    local ($x,@list) = @_;
-    local ($found);
-
-    for ($found = 0, $y = shift(@list); 
-	 $#list == -1 || $found;  
-	 $found = ($x == $y), $y = shift(@list)) {}
-
-    return ($found);
-}
-
-# ----------------------------------------------------------------------------
-
-# -----------------------------------------------------------------------------
-
-sub process_options {
-
-    if ( $opt_h ) {                      
-	open(ME,$0) || die "Can't open myself ($0): $!\n";
-	$n = 0;
-	while (<ME>) {
-	    last if $_ =~ /^$/;
-	    print $_;
-	    $n++;
-	}
-	close(ME);
-	exit ;
-    }
-    
-    if ( $opt_s ) {
-	$opt_s =~ s/[\(\)\[\]]//g;
-	@sparks = split(/[,;. ]+/, $opt_s);
-    } else {
-	@sparks = ( 3, 4, 5, 6, 7, 8, 11, 12, 13, 14, 15);
-    }
-
-    if ( $#ARGV != 0 ) {
-	print "Usage: $0 [options] <gr-file>\n;";
-	print "Use -h option to get details\n";
-	exit 1;
-    }
-
-    $input = $ARGV[0];
-    ($ps_file = $input) =~ s/\.gr/-SN.ps/;
-    ($gp_file = $input) =~ s/\.gr/-SN.gp/;
-    ($summary = $input) =~ s/\.gr/-SN.sn/;
-
-    #($basename = $gr_file) =~ s/\.gr//;
-    #$rts_file = $basename . ".rts";        # "RTS";
-    #$gran_file = "g.ps"; # $basename . ".ps";
-    #$rts_file = $gr_file;
-    #$rts_file =~ s/\.gr/.rts/g;
-
-    if ( $opt_o ) {
-	$output = $opt_o;
-    } else {
-	($output = $input) =~ s/\.gr/-SN.dat/;
-    }
-
-    if ( $opt_e ) {
-	$ext_size = $opt_e; 
-    } else {
-	$ext_size = 100; 
-    }
-    
-    if ( $opt_i ) {
-	$gray = $opt_i; 
-    } else {
-	$gray = 0; 
-    }
-}
-
-# -----------------------------------------------------------------------------
-
-sub print_verbose_message {
-    print "Input: $input \tOutput: $output\n";
-}
-
-# -----------------------------------------------------------------------------
-
-# ToDo: Takes these from global module:
-
-# ----------------------------------------------------------------------------
-
-sub gp_ext {
-    local (@file_names) = @_;
-    local ($file_name);
-    local ($ps_file_name);
-    local ($prg);
-
-    #$prg = system "which gp-ext-imp";
-    #print "  Using script $prg for impuls extension\n";
-    $prg = $ENV{GRANDIR} ? $ENV{GRANDIR} . "/bin/gp-ext-imp" 
-	                 : $ENV{HOME} . "/bin/gp-ext-imp" ;
-    if ( $opt_v ) {
-	print "    (using script $prg)\n";
-    }
-
-    foreach $file_name (@file_names) {
-	$ps_file_name = $file_name; # NB change to orig !!!!&dat2ps_name($file_name);
-        system "$prg -w $ext_size -g $gray " . 
-               $ps_file_name  . " " . 
-               $ps_file_name . "2" ;
-        system "mv " . $ps_file_name . "2 " . $ps_file_name;
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub write_gp { 
-    local ($gp_file,$ps_file) = @_;
-    local ($str);
-
-    $xsize = 1;
-    $ysize = 1;
-    $xlabel = "Spark sites";
-    $ylabel = "Number of threads";
-    $xstart = &list_min(@sorted_keys);
-    $xend = &list_max(@sorted_keys);
-    $ymax = $max_val; 
-    $xtics = ""; "(" . join(',',@sorted_keys) . ")\n";
-    $in_file = $output;
-    $out_file = $ps_file;
-
-    open (GP,">$gp_file") || die "$!: $gp_file";
-    print GP "set term postscript \"Roman\" 20\n";
-
-    # identical to the part in write_gp_record of RTS2gran
-
-    $str = "set size " . $xsize . "," . $ysize . "\n" .
-           "set xlabel \"" . $xlabel . "\"\n" .
-           "set ylabel \"" . $ylabel . "\"\n" .
-           ($xstart eq "" ? "" 
-                          : "set xrange [" . int($xstart) .":" . int($xend) . "]\n") .
-           ($opt_Y ? 
-	      ("set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) . ":$opt_Y]\n") :
-	      ($ymax eq "" ? "" 
-                        : "set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) . 
-                          ":" . &list_max(2,int($ymax+$ymax/5)) . "]\n")) .
-           ($xtics ne "" ? "set xtics $xtics" : "") . 
-	   "set tics out\n" .
-           "set border\n" .
-           ( $nPEs!=0 ? "set title \"$nPEs PEs\"\n" : "" ) .
-	   "set nokey \n" .
-           "set nozeroaxis\n" .
-	   "set format xy \"%8.8g\"\n" .
-           (index($logaxes,"x") != -1 ? 
-               "set logscale x\n" : 
-               "set nologscale x\n") .
-           (index($logaxes,"y") != -1 ? 
-               "set logscale y\n" : 
-               "set nologscale y\n") .
-           "set output \"" . $out_file . "\"\n" .
-	   "plot \"" . $in_file . "\" with impulses\n\n";
-    print GP $str;
-    close (GP);
-}
-
-# ----------------------------------------------------------------------------
diff --git a/ghc/utils/parallel/SPLIT.pl b/ghc/utils/parallel/SPLIT.pl
deleted file mode 100644
index b4fe46f5b0..0000000000
--- a/ghc/utils/parallel/SPLIT.pl
+++ /dev/null
@@ -1,379 +0,0 @@
-#!/usr/local/bin/perl
-#                                           (C) Hans Wolfgang Loidl, July 1995
-#############################################################################
-# Time-stamp: <Thu Oct 26 1995 18:23:00 Stardate: [-31]6498.62 hwloidl>
-#
-# Usage: SPLIT [options] <gr-file>
-#
-# Generate a set of granularity graphs out of the GrAnSim profile <gr-file>.
-# The granularity graphs are put into subdirs of the structure: 
-#   <basename of gr-file>-<spark-name>
-#
-# Options:
-#  -s <list> ... a perl list of spark names; the given <gr-file> is scanned 
-#                for each given name in turn and granularity graphs are 
-#                generated for each of these sparks  
-#  -O        ... use gr2RTS and RTS2gran instead of gran-extr;
-#                this generates fewer output files (only granularity graphs)
-#                but should be faster and far less memory consuming
-#  -d <dir>  ... use <dir> as basename for the sub-directories
-#  -o <file> ... use <file> as basename for the generated latex files; 
-#                the overall result is in  <file>.ps
-#  -t <file> ... use <file> as gran-extr type template file 
-#                ('.' for local template, ',' for global template)
-#  -A        ... surpress generation of granularity profiles for overall .gr
-#  -h        ... help; print this text.
-#  -v        ... verbose mode.
-#
-#############################################################################
-
-require "getopts.pl";
-
-&Getopts('hvOAd:o:s:t:');  
-
-do process_options();
-
-if ( $opt_v ) { do print_verbose_message(); }
-
-# ---------------------------------------------------------------------------
-# Init
-# ---------------------------------------------------------------------------
-
-$latex = "/usr/local/tex/bin/latex2e"; # or "/usr/local/tex/bin/latex2e"
-
-do all()  if !$opt_A;
-
-foreach $s (@sparks) {
-    if ( -f $tmp_file ) { system "rm -f $tmp_file"; }
-    system "tf -H -s $s $gr_file > $tmp_file" 
-	|| die "Can't open pipe: tf -s $s $gr_file > $tmp_file\n";
-
-    if ( $opt_d ) {
-	$dir = $opt_d;		
-    } else {
-	$dir = $gr_file;
-    }
-    $dir =~ s/\.gr//g;
-    $dir .= "-$s";
-
-    if ( ! -d $dir ) {
-	mkdir($dir,"755");   # system "mkdir $dir";
-	system "chmod u+rwx $dir";
-    }
-
-    system "mv $tmp_file $dir/$gr_file";
-    chdir $dir;             
-    do print_template();
-    do print_va("Title",$s);
-    if ( -f $va_ps_file ) { 
-	local ($old) = $va_ps_file;
-	$old =~ s/\.ps/-o.ps/g;
-	system "mv $va_ps_file $old";
-    }
-    if ( $opt_O ) {
-	system "gr2RTS -o $rts_file $gr_file; " .
-	       "RTS2gran -t $template_file $rts_file; " . 
-	       "$latex $va_file; dvips $va_dvi_file > $va_ps_file"; 
-    } else {
-	system "gran-extr -t $template_file $gr_file; " . 
-	    "$latex $va_file; dvips $va_dvi_file > $va_ps_file"; 
-    }
-    chdir "..";  # system "cd ..";
-}
-
-exit 0;
-
-# -----------------------------------------------------------------------------
-
-sub all {
-
-    $dir = $gr_file;
-    $dir =~ s/\.gr//g;
-    $dir .= "-all";
-
-    if ( ! -d $dir ) {
-	mkdir($dir,"755");   # system "mkdir $dir";
-	system "chmod u+rwx $dir";
-    }
-
-    system "cp $gr_file $dir/$gr_file";
-    chdir $dir;             
-    do print_template();
-    do print_va("All","all");
-    if ( -f $va_ps_file ) { 
-	local ($old) = $va_ps_file;
-	$old =~ s/\.ps/-o.ps/g;
-	system "mv $va_ps_file $old";
-    }
-    if ( $opt_O ) {
-	system "gr2RTS -o $rts_file $gr_file; " .
-	       "RTS2gran -t $template_file $rts_file; " . 
-	       "$latex $va_file; dvips $va_dvi_file > $va_ps_file"; 
-    } else {
-	system "gran-extr -t $template_file $gr_file; " . 
-	    "$latex $va_file; dvips $va_dvi_file > $va_ps_file"; 
-    }
-    chdir "..";  # system "cd ..";
-}
-
-# ---------------------------------------------------------------------------
-
-sub print_template {
-
-    open (TEMPL,">$template_file") || die "Can't open $template_file\n";
-
-    print TEMPL <<EOF;
--- Originally copied from the master template: GrAn/bin/TEMPL 
--- Intervals for pure exec. times
-G: (1000, 2000, 3000, 4000, 5000, 10000, 20000, 30000, 40000, 50000, 100000, 200000, 300000)
--- Intervals for communication (i.e. fetch)  times
-F: (1000, 2000, 3000, 4000, 5000, 10000, 20000, 30000, 40000, 50000, 100000, 200000, 300000)
--- Intervals for communication percentages 
-C: (0, 1, 2, 5, 8, 10, 20, 30, 40, 50, 100)
--- Intervals for no. of sparks
-S: (1, 2, 5)
--- Intervals for heap allocations
-A: (10,20,30,40,50,100,200,300,400,500,1000,2000,3000)
--- A: (100, 50000, 66000, 100000)
-
-
-g: g.dat
-f: f.dat
-c: c.dat
-s: s.dat
-a: a.dat
-
--- Select file name corr coeff file
-Xcorr: 		CORR
-
--- Select file names for GNUPLOT data files for cumulative runtime and
--- cluster graphs
-Xcumulat-rts: 	cumu-rts.dat
-Xcumulat-fts: 	cumu-fts.dat
-Xcumulat-has: 	cumu-has.dat
-Xcumulat-cps: 	cumu-cps.dat
-Xclust-rts: 	clust-rts.dat
-Xclust-has: 	clust-has.dat
-Xclust-cps: 	clust-cps.dat
-
--- Select file names for GNUPLOT data files for per proc. runnable time
--- and per spark site runtime
-Xpe: 		pe.dat
-Xsn: 		sn.dat
-
--- Select file names for sorted lists of runtimes, heap allocs, number of
--- local and global sparks and communication percentage
-XRTS:		RTS
-XFTS:		FTS
-XHAS:		HAS
-XLSPS:		LSPS
-XGSPS:		GSPS
-XCPS:		CPS
-XCCPS:		CPS
-
--- Std log scaling
-L: .
--- ('g',"xy",'Cg',"xy",'Ca',"xy")
-
--- Gray level of impulses in the graph (0=black)
-i: 0.3
-
--- Number of clusters
-k: 2
-
--- Width of impulses (needed for gp-ext-imp)
-e: 150
-
--- Input file
--- -: soda.gr
-EOF
-
-    close(TEMPL);
-}
-
-# -----------------------------------------------------------------------------
-# NB: different file must be generated for $opt_O and default setup.
-# -----------------------------------------------------------------------------
-
-sub print_va {
-    local ($title, $spark) = @_;
-
-    open (VA,">$va_file") || die "Can't open $va_file\n";
-
-    if ( $opt_O ) {
-    print VA <<EOF;
-% Originally copied from master va-file: grasp/tests/va.tex
-\\documentstyle[11pt,psfig]{article}
-
-% Page Format
-\\topmargin=0cm                %0.5cm
-\\textheight=24cm                %22cm
-\\footskip=0cm
-\\oddsidemargin=0cm            %0.75cm
-\\evensidemargin=0cm           %0.75cm
-\\rightmargin=0cm            %0.75cm
-\\leftmargin=0cm            %0.75cm
-\\textwidth=16cm                 %14.5cm
-
-\\title{SPLIT}
-\\author{Me}
-\\date{Today}
-
-\\pssilent
-
-\\begin{document}
-
-\\pagestyle{empty}
-\%\\maketitle
-
-\\nopagebreak
-
-\\begin{figure}[t]
-\\begin{center}
-\\begin{tabular}{c}
-\\centerline{\\psfig{angle=270,width=7cm,file=$gran_file}}
-\\end{tabular}
-\\end{center}
-\\caption{Granularity {\\bf $spark}}
-\\end{figure}
-
-\\begin{figure}[t]
-\\begin{center}
-\\begin{tabular}{cc}
-\\psfig{angle=270,width=7cm,file=cumu-rts.ps} &
-\\psfig{angle=270,width=7cm,file=cumu-rts0.ps}
-\\end{tabular}
-\\end{center}
-\\caption{Cumulative Execution Times  {\\bf $spark}}
-\\end{figure}
-
-\\end{document}
-EOF
-    } else {
-    print VA <<EOF;
-% Originally copied from master va-file: grasp/tests/va.tex
-\\documentstyle[11pt,psfig]{article}
-
-% Page Format
-\\topmargin=0cm                %0.5cm
-\\textheight=24cm                %22cm
-\\footskip=0cm
-\\oddsidemargin=0cm            %0.75cm
-\\evensidemargin=0cm           %0.75cm
-\\rightmargin=0cm            %0.75cm
-\\leftmargin=0cm            %0.75cm
-\\textwidth=16cm                 %14.5cm
-
-\\title{$title; Spark: $spark}
-\\author{}
-\\date{}
-
-\\begin{document}
-
-\\pagestyle{empty}
-%\\maketitle
-
-\\nopagebreak
-
-\\begin{figure}[t]
-\\begin{center}
-\\begin{tabular}{cc}
-\\psfig{angle=270,width=7cm,file=$gran_file} &
-\\psfig{angle=270,width=7cm,file=a.ps}
-\\end{tabular}
-\\end{center}
-\\caption{Granularity \\& Heap Allocations {\\bf $spark}}
-\\end{figure}
-
-\\begin{figure}[t]
-\\begin{center}
-\\begin{tabular}{cc}
-\\psfig{angle=270,width=7cm,file=f.ps} &
-\\psfig{angle=270,width=7cm,file=c.ps}
-\\end{tabular}
-\\end{center}
-\\caption{Fetching Profile  {\\bf $spark}}
-\\end{figure}
-
-\\begin{figure}[t]
-\\begin{center}
-\\begin{tabular}{cc}
-\\psfig{angle=270,width=7cm,file=cumu-rts.ps} &
-\\psfig{angle=270,width=7cm,file=cumu-rts0.ps}
-\\end{tabular}
-\\end{center}
-\\caption{Cumulative Execution Times  {\\bf $spark}}
-\\end{figure}
-
-\\end{document}
-EOF
-}
-    close (VA);
-}
-
-# -----------------------------------------------------------------------------
-
-sub process_options {
-
-    if ( $opt_h ) {                      
-	open(ME,$0) || die "Can't open myself ($0): $!\n";
-	$n = 0;
-	while (<ME>) {
-	    last if $_ =~ /^$/;
-	    print $_;
-	    $n++;
-	}
-	close(ME);
-	exit ;
-    }
-    
-    if ( $opt_s ) {
-	$opt_s =~ s/[\(\)\[\]]//g;
-	@sparks = split(/[,;. ]+/, $opt_s);
-    } else {
-	@sparks = ( 3, 4, 5, 6, 7, 8, 11, 12, 13, 14, 15);
-    }
-
-    if ( $#ARGV != 0 ) {
-	print "Usage: $0 [options] <gr-file>\n;";
-	print "Use -h option to get details\n";
-	exit 1;
-    }
-
-    $gr_file = $ARGV[0];
-    ($basename = $gr_file) =~ s/\.gr//;
-    $rts_file = $basename . ".rts";        # "RTS";
-    $gran_file = "g.ps"; # $basename . ".ps";
-    #$rts_file = $gr_file;
-    #$rts_file =~ s/\.gr/.rts/g;
-
-    if ( $opt_o ) {
-	$va_file = $opt_o;
-	$va_dvi_file = $va_file;
-	$va_dvi_file =~ s/\.tex/.dvi/g; 
-	$va_ps_file = $va_file;
-	$va_ps_file =~ s/\.tex/.ps/g; 
-    } else {
-	$va_file = "va.tex";
-	$va_dvi_file = "va.dvi";
-	$va_ps_file = "va.ps";
-    }
-    
-    if ( $opt_t ) {
-	$template_file = $opt_t;
-    } else {
-	$template_file = "TEMPL";
-    }
-
-    $tmp_file = ",t";
-}
-
-# -----------------------------------------------------------------------------
-
-sub print_verbose_message {
-    print "Sparks: (" . join(',',@sparks) . ")\n";
-    print "Files: .gr " . $gr_file . "  template " . $template_file .
-	    " va " . $va_file . "\n";
-}
-
-# -----------------------------------------------------------------------------
diff --git a/ghc/utils/parallel/avg-RTS.pl b/ghc/utils/parallel/avg-RTS.pl
deleted file mode 100644
index 4f25d55f80..0000000000
--- a/ghc/utils/parallel/avg-RTS.pl
+++ /dev/null
@@ -1,15 +0,0 @@
-#!/usr/local/bin/perl
-
-$n=0;
-$sum=0;
-$last=0;
-while (<>) {
-    next unless /^\d+/;
-    @c = split;
-    $sum += $c[0];
-    $last = $c[0];
-    $n++;
-}
-
-print "Average Runtimes: n=$n; sum=$sum; avg=" . ($sum/$n) . "; max=$last\n";
-
diff --git a/ghc/utils/parallel/get_SN.pl b/ghc/utils/parallel/get_SN.pl
deleted file mode 100644
index e9426855bf..0000000000
--- a/ghc/utils/parallel/get_SN.pl
+++ /dev/null
@@ -1,40 +0,0 @@
-#!/usr/local/bin/perl
-#############################################################################
-
-#do get_SN($ARGV[0]);
-
-#exit 1;
-
-# ---------------------------------------------------------------------------
-
-sub get_SN {
-    local ($file) = @_;
-    local ($id,$idx,$sn);
-
-    open (FILE,$file) || die "get_SN: Can't open file $file\n";
-
-    $line_no=0;
-    while (<FILE>) {
-	next unless /END/;
-	# PE  0 [3326775]: END 0, SN 0, ST 0, EXP F, BB 194, HA 1464, RT 983079, BT 1449032 (7), FT 0 (0), LS 0, GS 27, MY T 
-	
-	if (/^PE\s*(\d+) \[(\d+)\]: END ([0-9a-fx]+), SN (\d+)/) {
-	    $line_no++;
-	    $idx = $3;
-	    $id = hex($idx);
-	    $sn = $4;
-	    #print STDERR "Id: $id ($idx) --> $sn\n";
-	    $id2sn{$id} = $sn;
-	}
-    }
-
-    # print STDERR "get_SN: $line_no lines processed\n";
-    close (FILE);
-
-    # print STDERR "Summary: " . "="x15 . "\n";
-    # foreach $key (keys %id2sn) {
-    #   print STDERR ">  $key --> $id2sn{$key}\n";
-    #}
-}
-
-1;
diff --git a/ghc/utils/parallel/ghc-fool-sort.pl b/ghc/utils/parallel/ghc-fool-sort.pl
deleted file mode 100644
index dfa65a1875..0000000000
--- a/ghc/utils/parallel/ghc-fool-sort.pl
+++ /dev/null
@@ -1,23 +0,0 @@
-##############################################################################
-#
-# Usage: fool-sort 
-#
-# Takes a pure (i.e. no header lines) quasi-parallel profile (a .qp file) from
-# stdin and inserts a counter as second field to force sort not to change the 
-# ordering of lines with the same time stamp. The result is written to stdout.
-#
-##############################################################################
-
-$last_time = 0;
-while (<STDIN>) {
-    ($time, @rest) = split;
-    if ( $time == $last_time ) {
-	$x = ++$count;
-    } else {
-	$x = $count = 0;
-    }
-    print $time, " ", $x, " ", join(' ',@rest), "\n";
-    $last_time = $time;
-}
-
-exit 0;
diff --git a/ghc/utils/parallel/ghc-unfool-sort.pl b/ghc/utils/parallel/ghc-unfool-sort.pl
deleted file mode 100644
index 90da222a5a..0000000000
--- a/ghc/utils/parallel/ghc-unfool-sort.pl
+++ /dev/null
@@ -1,16 +0,0 @@
-##############################################################################
-#
-# Usage: unfool-sort 
-#
-# Reads stdin, elimininates the second field (a dummy counter that has been 
-# inserted by fool-sort) of each line and writes the result to stdout.
-# See documentation of fool-sort.
-#
-##############################################################################
-
-while (<STDIN>) {
-    ($time, $dummy, @rest) = split;
-    print join(' ',$time,@rest) . "\n";
-}
-
-exit 0;
diff --git a/ghc/utils/parallel/gp-ext-imp.pl b/ghc/utils/parallel/gp-ext-imp.pl
deleted file mode 100644
index fa7c4e06d8..0000000000
--- a/ghc/utils/parallel/gp-ext-imp.pl
+++ /dev/null
@@ -1,86 +0,0 @@
-#!/usr/local/bin/perl
-# #############################################################################
-#
-# Usage: gp-ext-imp [options] [<input-file>] [<output-file>]
-#
-# A small script to produce half-useful bar graphs from the PostScript
-# output produced by gnuplot.  
-# Translation is done in the X axis automatically, and should
-# be `good enough' for graphs with smallish numbers of bars.
-#
-# Original version:          Bryan O'Sullivan <bos@dcs.glasgow.ac.uk> 09.94
-# New and improved version:  Hans Wolfgang Loidl <hwloidl@dcs.glasgow.ac.uk>
-#
-# Options:
-#  -w <width>      ... width of vertical bars
-#  -g <gray-level> ... set gray-level (between 0 and 1; 0 means black)
-#  -m <move>       ... move the graph <move> pixels to the right
-#  -h              ... help; print this text
-#  -v              ... verbose mode
-#
-# #############################################################################
-
-require "getopts.pl";
-
-&Getopts('hvm:w:g:');  
-
-if ( $opt_h ) {                      
-    open(ME,$0) || die "Can't open myself ($0)";
-    $n = 0;
-    while (<ME>) {
-      last if $_ =~ /^$/;
-      print $_;
-      $n++;
-    }
-    close(ME);
-
-    exit ;
-}
-
-$size = $opt_w ? $opt_w : 200;
-$gray = $opt_g ? $opt_g : 0;
-$move = $opt_m ? $opt_m : 150;
-
-$from = $#ARGV >= 0 ? $ARGV[0] : "-";
-$to = $#ARGV >= 1 ? $ARGV[1] : "-";
-
-if ( $opt_v ) {
-    print 70 x "-" . "\n";
-    print "\nSetup: \n";
-    print " Input file: $from   Output file: $to\n";
-    print " Width: $size   Gray level: $gray   Move is " . 
-          ($opt_m ? "ON" : "OFF") . " with value $move\n";
-    print 70 x "-" . "\n";
-}
-
-open(FROM, "<$from") || die "$from: $!";
-open(TO, ">$to") || die "$to: $!";
-
-$l = -1;
-
-foreach (<FROM>) {
-    if ($l >= 0) {
-	$l--;
-    }
-    if ($l == 0) {
-	if ( $opt_m ) {
-            # This seems to shift everything a little to the right;
-	    print TO "$move 0 translate\n";
-        }
-	print TO "$gray setgray\n";
-	print TO "$size setlinewidth\n";
-    }
-    if (/^LT0$/) {
-	$l = 3;
-    } elsif (/^LT1$/) {
-	print TO "-150 0 translate\n";
-    }
-    print TO;
-}
-
-
-
-
-
-
-
diff --git a/ghc/utils/parallel/gr2RTS.pl b/ghc/utils/parallel/gr2RTS.pl
deleted file mode 100644
index c609334c28..0000000000
--- a/ghc/utils/parallel/gr2RTS.pl
+++ /dev/null
@@ -1,138 +0,0 @@
-#!/usr/local/bin/perl
-#                                           (C) Hans Wolfgang Loidl, July 1995
-##############################################################################
-# Time-stamp: <Thu Oct 26 1995 18:40:10 Stardate: [-31]6498.68 hwloidl>
-#
-# Usage: gr2RTS [options] <sim-file>
-#
-# Options:
-#  -o <file> ... write output to <file>
-#  -h        ... help; print this text.
-#  -v        ... verbose mode.
-#
-##############################################################################
-
-# ----------------------------------------------------------------------------
-# Command line processing and initialization
-# ----------------------------------------------------------------------------
-
-require "getopts.pl";
-
-&Getopts('hvo:');  
-
-do process_options();
-
-if ( $opt_v ) {
-    do print_verbose_message ();
-}
-
-# ----------------------------------------------------------------------------
-# The real thing
-# ----------------------------------------------------------------------------
-
-open(INPUT,"<$input") || die "Couldn't open input file $input";
-open(OUTPUT,"| sort -n > $output") || die "Couldn't open output file $output";
-
-#do skip_header();
-
-$tot_total_rt = 0;
-$tot_rt = 0;
-
-$line_no = 0;
-while (<INPUT>) {
-    next                     if /^--/;     # Comment lines start with --
-    next		     if /^\s*$/;   # Skip empty lines
-    $line_no++;
-    @fields = split(/[:,]/,$_);
-    $has_end = 0;
-
-    foreach $elem (@fields) {
-      foo : {
-        $pe = $1, $end = $2 , last foo   if $elem =~ /^\s*PE\s+(\d+)\s+\[(\d+)\].*$/;
-        $tn = $1, $has_end = 1  , last foo   if $elem =~ /^\s*END\s+(\w+).*$/;
-	# $tn = $1	, last foo   if $elem =~ /^\s*TN\s+(\w+).*$/;
-	$sn = $1	, last foo   if $elem =~ /^\s*SN\s+(\d+).*$/;
-        $start = $1     , last foo   if $elem =~ /^\s*ST\s+(\d+).*$/;
-        $is_global = $1 , last foo   if $elem =~ /^\s*EXP\s+(T|F).*$/;
-        $bbs = $1       , last foo   if $elem =~ /^\s*BB\s+(\d+).*$/;
-        $ha = $1        , last foo   if $elem =~ /^\s*HA\s+(\d+).*$/;
-        $rt = $1        , last foo   if $elem =~ /^\s*RT\s+(\d+).*$/;
-        $bt = $1, $bc = $2 , last foo if $elem =~ /^\s*BT\s+(\d+)\s+\((\d+)\).*$/;
-        $ft = $1, $fc = $2 , last foo if $elem =~ /^\s*FT\s+(\d+)\s+\((\d+)\).*$/;
-        $lsp = $1        , last foo   if $elem =~ /^\s*LS\s+(\d+).*$/;
-        $gsp = $1        , last foo   if $elem =~ /^\s*GS\s+(\d+).*$/;
-        $my = $1        , last foo   if $elem =~ /^\s*MY\s+(T|F).*$/;
-      }
-    }
-
-    next unless $has_end == 1;
-
-    $total_rt = $end - $start;
-    $tot_total_rt += $total_rt;
-    $tot_rt += $rt;
-
-    print OUTPUT "$rt\n";
-    $sum_rt += $rt;
-    $max_rt = $rt  if $rt > $max_rt;
-}
-
-close INPUT;
-close OUTPUT;
-
-# Hack to  fake a filter
-if ( $output eq $filter_output ) {
-    system "cat $output";
-    system "rm $output";
-}
-
-exit 0;
-
-# ---------------------------------------------------------------------------
-
-sub process_options {
-    if ( $opt_h ) {                      
-	open(ME,$0) || die "Can't open myself ($0)";
-	$n = 0;
-	while (<ME>) {
-	    last if $_ =~ /^$/;
-	    print $_;
-	    $n++;
-	}
-	close(ME);
-	
-	# system "cat $0 | awk 'BEGIN { n = 0; } \
-	#                             /^$/ { print n; \
-	#                                    exit; } \
-	#                                  { n++; }'"
-	exit ;
-    }
-
-    $input = $#ARGV == -1 ? "-" : $ARGV[0] ;
-    
-    if ( $#ARGV != 0 ) {
-	#print "Usage: gran-extr [options] <sim-file>\n";
-	#print "Use -h option to get details\n";
-	#exit 1;
-	
-    }
-
-    $filter_output = $ENV{'TMPDIR'} . "./,gr2RTS-out";
-    if ( $opt_o ) {
-	$output = $opt_o;
-    } else {
-	if ( $input eq "-" ) {
-	    $output = $filter_output;
-	} else {
-	    $output = $input; # "RTS";
-	    $output =~ s/\.gr$/.rts/g;
-        }			# 
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub print_verbose_message {
-    print "Input file: $input\t Output file: $output\n";
-}
-
-# ----------------------------------------------------------------------------
diff --git a/ghc/utils/parallel/gr2ap.bash b/ghc/utils/parallel/gr2ap.bash
deleted file mode 100644
index 7818fe112b..0000000000
--- a/ghc/utils/parallel/gr2ap.bash
+++ /dev/null
@@ -1,124 +0,0 @@
-#!/usr/local/bin/bash
-##############################################################################
-# Time-stamp: <Wed Jul 24 1996 20:53:36 Stardate: [-31]7859.14 hwloidl>
-#
-# Usage: gr2ap [options] <gr-file>
-#
-# Create a per-thread activity graph from a GrAnSim (or GUM) profile.
-# Transform the log file of a GrAnSim run (a .gr file) into a quasi-parallel
-# profile (a .qp file) using gr2qp and then into a PostScript file using qp2ap.
-# The generated PostScript file shows one horizontal line for each task. The 
-# thickness of the line indicates the state of the thread:
-#  thick ... active,  medium ... suspended,  thin ... fetching remote data
-#
-# Options:
-#  -o <file> ... write .ps file to <file>
-#  -m        ... create mono PostScript file instead a color one.
-#  -O        ... optimise i.e. try to minimise the size of the .ps file.
-#  -v        ... be talkative. 
-#  -h        ... print help message (this header).
-#
-##############################################################################
-
-progname="`basename $0`"
-args="$*"
-
-verb=0
-help=0
-mono=""
-apfile=""
-optimise=""
-scale=""
-width=""
-
-getopts "hvmo:s:w:OD" name
-while [ "$name" != "?" ] ; do
-  case $name in
-   h) help=1;;
-   v) verb=1;;
-   m) mono="-m";;
-   o) apfile="$OPTARG";;
-   s) scale="-s $OPTARG";;
-   w) width="-w $OPTARG";;
-   O) optimise="-O";;
-   D) debug="-D";;
-  esac 
-  getopts "hvmo:s:w:OD" name
-done
-
-opts="$mono $optimise $scale $width"
-
-shift $[ $OPTIND - 1 ]
-
-if [ $help -eq 1 ]
- then no_of_lines=`cat $0 | awk 'BEGIN { n = 0; } \
-                                 /^$/ { print n; \
-                                        exit; } \
-                                      { n++; }'`
-      echo "`head -$no_of_lines $0`"
-      exit 
-fi
-
-
-if [ -z "$1" ]
- then echo "Usage: $progname [options] file[.gr]"
-      echo "Use -h option for details"
-      exit 1;
-fi
-
-f="`basename $1 .gr`"
-grfile="$f".gr
-qpfile="${TMPDIR:-.}/$f".qp
-ppfile="${TMPDIR:-.}/$f".pp
-
-if [ -z "$apfile" ]
-  then apfile="$f"_ap.ps
-fi
-
-if [ $verb -eq 1 ]
-  then echo "Input file: $grfile"
-       echo "Quasi-parallel file: $qpfile"
-       echo "PostScript file: $apfile"
-       echo "Options forwarded to qp2ap: $opts"
-       if [ "$mono" = "-m" ]
-         then echo "Producing monochrome PS file"
-         else echo "Producing color PS file"
-       fi
-       if [ "$debug" = "-D" ]
-         then echo "Debugging is turned ON"
-         else echo "Debugging is turned OFF"
-       fi
-fi
-
-
-#  unset noclobber
-
-if [ ! -f "$grfile" ] 
- then
-  echo "$grfile does not exist"
-  exit 1
- else
-  # rm -f "$qpfile" "$apfile"
-  prog=`head -1 "$grfile" | sed -e 's/Granularity Simulation for //'`
-  echo "$prog" >| "$qpfile"
-  if [ $verb -eq 1 ]
-    then echo "Executed program: $prog"
-  fi
-  date >> "$qpfile"
-  #date="`date`"                     # This is the date of running the script
-  date="`tail +2 $grfile | head -1 | sed -e 's/Start time: //'`"
-  cat "$grfile" | gr2qp >> "$qpfile"
-  # Sorting is part of gr2qp now.
-  #  | ghc-fool-sort | sort -n +0 -1 | ghc-unfool-sort >> "$qpfile"
-  # max=`tail -2 "$qpfile" | awk '!/^Number of threads:/ { print $1; }'`
-  xmax=`tail -1 "$qpfile" | awk '{ print $2; }'`
-  ymax=`tail -1 "$qpfile" | awk '{ print $8; }'`
-  if [ $verb -eq 1 ]
-    then echo "Total runtime: $xmax"
-	 echo "Total number of tasks: $ymax"
-  fi
-  tail +3 "$qpfile" | qp2ap $opts "$xmax" "$ymax" "$prog" "$date" >| "$apfile" 
-  rm -f "$qpfile"
-  # Old: qp2ap.pl $mono  $max "$prog" "$date" < "$qpfile" > "$apfile"
-fi
-  
diff --git a/ghc/utils/parallel/gr2gran.bash b/ghc/utils/parallel/gr2gran.bash
deleted file mode 100644
index d281d2c5bc..0000000000
--- a/ghc/utils/parallel/gr2gran.bash
+++ /dev/null
@@ -1,113 +0,0 @@
-#!/usr/local/bin/bash
-##############################################################################
-# Last modified: Time-stamp: <95/08/01 02:21:56 hwloidl>
-#
-# Usage: gr2gran [options] <sim-file>
-#
-# Create granularity graphs for the GrAnSim profile <sim-file>. This creates
-# a bucket statistics and a cumulative runtimes graph.
-# This script is derived from the much more complex gran-extr script, which
-# also produces such graphs and much more information, too.
-#
-# Options:
-#  -t <file>   ... use <file> as template file (<,> global <.> local template)
-#  -p <file>   ... use <file> as gnuplot .gp file (default: gran.gp)
-#  -x <x-size> ... of gnuplot graph
-#  -y <y-size> ... of gnuplot graph
-#  -n <n>      ... use <n> as number of PEs in title 
-#  -o <file>   ... keep the intermediate <file> (sorted list of all runtimes)
-#  -h          ... help; print this text.
-#  -v          ... verbose mode.
-#
-##############################################################################
-
-progname="`basename $0`"
-args="$*"
-
-help=0
-verb=0
-template=""
-plotfile=""
-x=""
-y=""
-n=""
-rtsfile=""
-keep_rts=0
-
-getopts "hvt:p:x:y:n:o:" name
-while [ "$name" != "?" ] ; do
-  case $name in
-   h) help=1;;
-   v) verb=1;;
-   t) template="-t $OPTARG";;
-   p) plotfile="-p $OPTARG";;
-   x) x="-x $OPTARG";;
-   y) y="-y $OPTARG";;
-   n) n="-n $OPTARG";;
-   o) rtsfile="$OPTARG";;
-  esac 
-  getopts "hvt:p:x:y:n:o:" name
-done
-
-shift $[ $OPTIND - 1 ]
-
-if [ $help -eq 1 ]
- then no_of_lines=`cat $0 | awk 'BEGIN { n = 0; } \
-                                 /^$/ { print n; \
-                                        exit; } \
-                                      { n++; }'`
-      echo "`head -$no_of_lines $0`"
-      exit 
-fi
-
-if [ -z "$1" ]
- then echo "Usage: $progname [options] file[.gr]"
-      echo "Use -h option for details"
-      exit 1;
-fi
-
-f="`basename $1 .gr`"
-grfile="${f}.gr"
-if [ -z "$rtsfile" ]
-  then rtsfile="${f}.rts"
-       rtsopt="-o $rtsfile"
-  else rtsopt="-o $rtsfile"
-       keep_rts=1
-fi
-
-opts_RTS="$rtsopt "
-opts_ps="$template $plotfile $x $y $n "
-
-if [ $verb -eq 1 ]
-  then echo "Input file: $grfile"
-       if [ ${keep_rts} -eq 1 ]
-         then echo "Intermediate file: $rtsfile  (kept after termination)"
-         else echo "Intermediate file: $rtsfile  (discarded at end)"
-       fi
-       verb_opt="-v "
-       opts_RTS="${opts_RTS} $verb_opt "
-       opts_ps="${opts_ps} $verb_opt "
-       echo "Options for gr2RTS: ${opts_RTS}"
-       echo "Options for RTS2gran: ${opts_ps}"
-fi
-
-
-# unset noclobber
-if [ ! -f "$grfile" ] 
- then
-  echo "$grfile does not exist"
-  exit 1
- else
-  # rm -f "$rtsfile"
-  if [ $verb -eq 1 ] 
-    then echo "gr2RTS ..."
-  fi
-  gr2RTS ${opts_RTS} $grfile
-  if [ $verb -eq 1 ] 
-    then echo "RTS2gran ..."
-  fi
-  RTS2gran ${opts_ps} $rtsfile
-  if [ ${keep_rts} -ne 1 ] 
-    then rm -f $rtsfile
-  fi
-fi
diff --git a/ghc/utils/parallel/gr2java.pl b/ghc/utils/parallel/gr2java.pl
deleted file mode 100644
index acd0b5e631..0000000000
--- a/ghc/utils/parallel/gr2java.pl
+++ /dev/null
@@ -1,322 +0,0 @@
-#!/usr/local/bin/perl
-##############################################################################
-#
-# Usage: gr2java [options]
-#
-# Filter that transforms a GrAnSim profile (a .gr file) at stdin to  
-# a quasi-parallel profile (a .qp file). It is the common front-end for most
-# visualization tools (except gr2pe). It collects  running,
-# runnable and blocked tasks in queues of different `colours', whose meaning
-# is:
-#  G ... green; queue of all running tasks
-#  A ... amber; queue of all runnable tasks
-#  R ... red; queue of all blocked tasks
-#  Y ... cyan; queue of fetching tasks 
-#  C ... crimson; queue of tasks that are being stolen
-#  B ... blue; queue of all sparks
-#
-# Options:
-#  -i <int>  ... info level from 1 to 7; number of queues to count (see qp3ps)
-#  -I <str>  ... count tasks that are in one of the given queues; encoding:
-#                 'a' ... active (running)
-#                 'r' ... runnable
-#                 'b' ... blocked
-#                 'f' ... fetching
-#                 'm' ... migrating
-#                 's' ... sparks
-#                (e.g. -I "arb" counts sum of active, runnable, blocked tasks)
-#  -c        ... check consistency of data (e.g. no neg. number of tasks)
-#  -v        ... be talkative. 
-#  -h        ... print help message (this header).
-#
-##############################################################################
-
-require "getopts.pl";
-
-&Getopts('hvDSci:I:');  
-
-do process_options();
-
-if ( $opt_v ) {
-    do print_verbose_message();
-}
-
-# ---------------------------------------------------------------------------
-# Init
-# ---------------------------------------------------------------------------
-
-$max = 0;
-$pmax = 0;
-$ptotal = 0;
-$n = 0;
-
-$active = 0;
-$runnable = 0;
-$blocked = 0;
-$fetching = 0;
-$migrating = 0;
-$sparks = 0;
-
-$improved_sort_option = $opt_S ? "-S" : "";
-
-open (FOOL,"| ghc-fool-sort $improved_sort_option | sort -n +0 -1 | ghc-unfool-sort") || die "FOOL";
-
-$in_header = 9; 
-while(<>) {
-    if ( $in_header == 9 ) {
-        if (/^=/) {
-	    $gum_style_gr = 1;
-	    $in_header = 0;
-	} else {
-	    $gum_style_gr = 0;
-	    $in_header = 1;
-	}
-	
-    }
-    if (/^\++$/) {
-	$in_header=0;
-	next;
-    }
-    next if $in_header;
-    next if /^$/;
-    next if /^=/;
-    chop;
-    ($PE, $pe, $time, $act, $tid, $rest) = split;
-    $time =~ s/[\[\]:]//g;
-    # next if $act eq 'REPLY';
-    chop($tid) if $act eq 'END';
-    $from = $queue{$tid};
-    $extra = "";
-    if ($act eq 'START') {
-	$from = '*';
-	$to = 'G';
-	$n++;
-	if ( $n > $pmax ) { $pmax = $n; }
-	$ptotal++;
-    } elsif ($act eq 'START(Q)') {
-	$from = '*';
-	$to = 'A';
-	$n++;
-	if ( $n > $pmax ) { $pmax = $n; }
-	$ptotal++;
-    } elsif ($act eq 'STEALING') {
-	$to = 'C';
-    } elsif ($act eq 'STOLEN') {
-	$to = 'G';
-    } elsif ($act eq 'STOLEN(Q)') {
-	$to = 'A';
-    } elsif ($act eq 'FETCH') {
-	$to = 'Y';
-    } elsif ($act eq 'REPLY') {
-	$to = 'R';
-    } elsif ($act eq 'BLOCK') {
-	$to = 'R';
-    } elsif ($act eq 'RESUME') {
-	$to = 'G';
-	$extra = " 0 0x0";
-    } elsif ($act eq 'RESUME(Q)') {
-	$to = 'A';
-	$extra = " 0 0x0";
-    } elsif ($act eq 'END') {
-	$to = '*';
-	$n--;
-	if ( $opt_c && $n < 0 ) { 
-	    print STDERR "Error at time $time: neg. number of tasks: $n\n";
-	}
-    } elsif ($act eq 'SCHEDULE') {
-	$to = 'G';
-    } elsif ($act eq 'DESCHEDULE') {
-	$to = 'A';
-    # The following are only needed for spark profiling
-    } elsif (($act eq 'SPARK') || ($act eq 'SPARKAT')) {
-	$from = '*';
-	$to = 'B';
-    } elsif ($act eq 'USED') {
-	$from = 'B';
-	$to = '*';
-    } elsif ($act eq 'PRUNED') {
-	$from = 'B';
-	$to = '*';
-    } elsif ($act eq 'EXPORTED') {
-	$from = 'B';
-	$to = 'B';
-    } elsif ($act eq 'ACQUIRED') {
-	$from = 'B';
-	$to = 'B';
-    } else {
-	print STDERR "Error at time $time: unknown event $act\n";
-    }
-    $queue{$tid} = $to;
-
-    if ( $from eq '' ) {
-	print STDERRR "Error at time $time: process $tid has no from queue\n";
-    }
-    if ($to ne $from) {
-        print FOOL $time, "  ", $pe, " ",
-	  $from, $to, "\n";
-    }
-
-    if ($to ne $from) {
-	# Compare with main loop in qp3ps
-	if ($from eq '*') {
-	} elsif ($from eq 'G') {
-	    --$active;
-	} elsif ($from eq 'A') {
-	    --$runnable;
-	} elsif ($from eq 'R') {
-	    --$blocked;
-	} elsif ($from eq 'B') {
-	    --$sparks;
-	} elsif ($from eq 'C') {
-	    --$migrating;
-	} elsif ($from eq 'Y') {
-	    --$fetching;
-	} else {
-	    print STDERR "Illegal from char: $from at $time\n";
-	}
-
-	if ($to eq '*') {
-	} elsif ($to eq 'G') {
-	    ++$active;
-	} elsif ($to eq 'A') {
-	    ++$runnable;
-	} elsif ($to eq 'R') {
-	    ++$blocked;
-	} elsif ($to eq 'B') {
-	    ++$sparks;
-	} elsif ($to eq 'C') {
-	    ++$migrating;
-	} elsif ($to eq 'Y') {
-	    ++$fetching;
-	} else {
-	    print STDERR "Illegal to char: $to at $time\n";
-	}
-
-    }
-
-    $curr = &count();
-    if ( $curr > $max ) {
-	$max = $curr;
-    }
-
-    if ( 0 ) {
-	print STDERR "%% $time: (act,runnable,blocked,fetch,mig,sp) = " .
-	    "($active, $runnable, $blocked, $fetching, $migrating, $sparks)".
-		" max = $max\n"  ;
-    }
-
-    #print STDERR "Sparks @ $time: $sparks \tCurr: $curr \tMax: $max \n"  if $opt_D;
- 
-    if ( $time > $tmax ) {
-	$tmax = $time;
-    }
-    delete $queue{$tid} if $to eq '*';
-    
-}
-
-print "Time: ", $tmax, " Max_selected_tasks: ", $max, 
-      " Max_running_tasks: ", $pmax, " Total_tasks: ", $ptotal, "\n";
-
-close(FOOL);
-
-exit 0;
-
-# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-# Copied from qp3ps and slightly modified (we don't keep a list for each queue
-# but just compute the max value we get out of all calls to count during the
-# execution of the script).
-# -----------------------------------------------------------------------------
-
-# -----------------------------------------------------------------------------
-
-sub queue_on {
-    local ($queue) = @_;
-
-    return index($show,$queue)+1;
-}
-
-# -----------------------------------------------------------------------------
-
-sub count {
-    local ($res);
-
-    $res = (($queue_on_a)  ? $active : 0) +
-	   (($queue_on_r)  ? $runnable : 0) +
-	   (($queue_on_b)  ? $blocked : 0) +
-	   (($queue_on_f)  ? $fetching : 0) +
-	   (($queue_on_m)  ? $migrating : 0) +
-           (($queue_on_s)  ? $sparks : 0);
-
-    return $res;
-}
-    
-# -----------------------------------------------------------------------------
-# DaH 'oH lo'lu'Qo'
-# -----------------------------------------------------------------------------
-
-sub set_values {
-    local ($samples,
-	   $active,$runnable,$blocked,$fetching,$sparks,$migrating) = @_;
-
-    $G[$samples] = queue_on_a ? $active : 0;   
-    $A[$samples] = queue_on_r ? $runnable : 0; 
-    $R[$samples] = queue_on_b ? $blocked : 0;  
-    $Y[$samples] = queue_on_f ? $fetching : 0; 
-    $B[$samples] = queue_on_s ? $sparks : 0;   
-    $C[$samples] = queue_on_m ? $migrating : 0;
-}
-
-# -----------------------------------------------------------------------------
-
-sub process_options { 
-    if ( $opt_h ) {                      
-	open(ME,$0) || die "Can't open myself ($0): $!\n";
-	$n = 0;
-	while (<ME>) {
-	    last if $_ =~ /^$/;
-	    print $_;
-	    $n++;
-	}
-	close(ME);
-	exit ;
-    }
-
-    $show = "armfb";
-
-    if ( $opt_i ) { 
-	$show = "a"		if info_level == 1;
-	$show = "ar"		if info_level == 2;
-	$show = "arb"		if info_level == 3;
-	$show = "arfb"		if info_level == 4;
-	$show = "armfb"		if info_level == 5;
-	$show = "armfbs"	if info_level == 6;
-    }
-
-    if ( $opt_I ) {
-	$show = $opt_I;
-    }
-
-    if ( $opt_v ){ 
-	$verbose = 1;
-    }    
-
-    $queue_on_a = &queue_on("a");
-    $queue_on_r = &queue_on("r"); 
-    $queue_on_b = &queue_on("b"); 
-    $queue_on_f = &queue_on("f"); 
-    $queue_on_s = &queue_on("s"); 
-    $queue_on_m = &queue_on("m"); 
-}
-
-sub print_verbose_message { 
-
-    print STDERR "Info-str: $show\n";
-    print STDERR "The following queues are turned on: " .
-	  ( $queue_on_a ? "active, " : "") .   
-	  ( $queue_on_r ? "runnable, " : "") . 
-	  ( $queue_on_b ? "blocked, " : "") .  
-          ( $queue_on_f ? "fetching, " : "") . 
-          ( $queue_on_m ? "migrating, " : "") .
-	  ( $queue_on_s ? "sparks" : "") .
-          "\n";
-}
diff --git a/ghc/utils/parallel/gr2jv.bash b/ghc/utils/parallel/gr2jv.bash
deleted file mode 100644
index 7eeacfe556..0000000000
--- a/ghc/utils/parallel/gr2jv.bash
+++ /dev/null
@@ -1,123 +0,0 @@
-#!/usr/local/bin/bash
-##############################################################################
-# Time-stamp: <Wed Jul 24 1996 20:38:02 Stardate: [-31]7859.09 hwloidl>
-#
-# Usage: gr3jv [options] <gr-file>
-#
-# Create a per-thread activity graph from a GrAnSim (or GUM) profile.
-# Transform the log file of a GrAnSim run (a .gr file) into a quasi-parallel
-# profile (a .qp file) using gr3qp and then into a PostScript file using qp3ap.
-# The generated PostScript file shows one horizontal line for each task. The 
-# thickness of the line indicates the state of the thread:
-#  thick ... active,  medium ... suspended,  thin ... fetching remote data
-#
-# Options:
-#  -o <file> ... write .ps file to <file>
-#  -m        ... create mono PostScript file instead a color one.
-#  -O        ... optimise i.e. try to minimise the size of the .ps file.
-#  -v        ... be talkative. 
-#  -h        ... print help message (this header).
-#
-##############################################################################
-
-progname="`basename $0`"
-args="$*"
-
-verb=0
-help=0
-mono=""
-apfile=""
-optimise=""
-scale=""
-width=""
-
-getopts "hvmo:s:w:OD" name
-while [ "$name" != "?" ] ; do
-  case $name in
-   h) help=1;;
-   v) verb=1;;
-   m) mono="-m";;
-   o) apfile="$OPTARG";;
-   s) scale="-s $OPTARG";;
-   w) width="-w $OPTARG";;
-   O) optimise="-O";;
-   D) debug="-D";;
-  esac 
-  getopts "hvmo:s:w:OD" name
-done
-
-opts="$mono $optimise $scale $width"
-
-shift $[ $OPTIND - 1 ]
-
-if [ $help -eq 1 ]
- then no_of_lines=`cat $0 | awk 'BEGIN { n = 0; } \
-                                 /^$/ { print n; \
-                                        exit; } \
-                                      { n++; }'`
-      echo "`head -$no_of_lines $0`"
-      exit 
-fi
-
-
-if [ -z "$1" ]
- then echo "Usage: $progname [options] file[.gr]"
-      echo "Use -h option for details"
-      exit 1;
-fi
-
-f="`basename $1 .gr`"
-grfile="$f".gr
-qpfile="$f".qp
-ppfile="$f".pp
-jvfile="$f".jv
-
-if [ -z "$apfile" ]
-  then apfile="$f"-ap.ps
-fi
-
-if [ $verb -eq 1 ]
-  then echo "Input file: $grfile"
-       echo "Quasi-parallel file: $qpfile"
-       echo "PostScript file: $apfile"
-       echo "Options forwarded to qp3ap: $opts"
-       if [ "$mono" = "-m" ]
-         then echo "Producing monochrome PS file"
-         else echo "Producing color PS file"
-       fi
-       if [ "$debug" = "-D" ]
-         then echo "Debugging is turned ON"
-         else echo "Debugging is turned OFF"
-       fi
-fi
-
-
-#  unset noclobber
-
-if [ ! -f "$grfile" ] 
- then
-  echo "$grfile does not exist"
-  exit 1
- else
-  # rm -f "$qpfile" "$apfile"
-  prog=`head -1 "$grfile" | sed -e 's/Granularity Simulation for //'`
-  echo "$prog" >| "$jvfile"
-  if [ $verb -eq 1 ]
-    then echo "Executed program: $prog"
-  fi
-  date >> "$jvfile"
-  #date="`date`"                     # This is the date of running the script
-  date="`tail +2 $grfile | head -1 | sed -e 's/Start-Time: //'`"
-  cat "$grfile" | gr2java >> "$jvfile"
-  # Sorting is part of gr2qp now.
-  #  | ghc-fool-sort | sort -n +0 -1 | ghc-unfool-sort >> "$qpfile"
-  # max=`tail -2 "$qpfile" | awk '!/^Number of threads:/ { print $1; }'`
-  xmax=`tail -1 "$jvfile" | awk '{ print $2; }'`
-  ymax=`tail -1 "$jvfile" | awk '{ print $8; }'`
-  if [ $verb -eq 1 ]
-    then echo "Total runtime: $xmax"
-	 echo "Total number of tasks: $ymax"
-  fi
-  # Old: qp2ap.pl $mono  $max "$prog" "$date" < "$qpfile" > "$apfile"
-fi
-  
diff --git a/ghc/utils/parallel/gr2pe.pl b/ghc/utils/parallel/gr2pe.pl
deleted file mode 100644
index 6026300758..0000000000
--- a/ghc/utils/parallel/gr2pe.pl
+++ /dev/null
@@ -1,1434 +0,0 @@
-#!/usr/local/bin/perl 
-#                                       (C) Hans Wolfgang Loidl, November 1994
-# ############################################################################
-# Time-stamp: <Fri Jun 14 1996 20:21:17 Stardate: [-31]7659.03 hwloidl>
-#
-# Usage: gr2pe [options] <gr-file>
-#
-# Create per processor activity profile (as ps-file) from a given gr-file.
-# 
-# Options:
-#  -o <file> ... output file (ps file) has name <file>
-#  -m        ... produce monochrome output
-#  -M        ... produce a migration graph
-#  -S        ... produce a spark graph in a separate file (based on the no. of
-#                sparks rather than the no. of runnable threads)
-#  -t        ... produce trace of runnable, blocked, fetching threads 
-#  -i <n>    ... ``infinity'' for number of blocked tasks (default: 20)
-#                all values larger than that are shown with the same width
-#  -C        ... do consistency check at each event (mainly for debugging)
-#  -h        ... print help message (this text)
-#  -v        ... be talkative
-#  
-# ############################################################################
-
-# die "This script is still under development -- HWL\n"; 
-
-# ----------------------------------------------------------------------------
-# Command line processing and initialization
-# ----------------------------------------------------------------------------
-
-require "getopts.pl";
-
-&Getopts('hvDCMNmSGti:o:l:p:');  
-
-do process_options();
-
-if ( $opt_v ) {
-    do print_verbose_message();
-}
-
-# ----------------------------------------------------------------------------
-# Global Variables
-# ----------------------------------------------------------------------------
-
-$RUNNING = "RUNNING";
-$RUNNABLE = "RUNNABLE";
-$BLOCKED = "BLOCKED";
-$START = "START";
-$END = "END";
-
-# Modes for hline
-#$LITERATE = 1;
-#$NORMALIZING = 2;
-
-%GRAY = (
-	 $RUNNING, 0.6,
-	 $RUNNABLE, 0.3,
-	 $BLOCKED, 0,
-	 $START, 0,
-	 $END, 0.5);
-
-# Special value showing that no task is running on $pe if in $running[$pe] 
-$NO_ID = -1;
-$NO_LAST_BG = $NO_LAST_BLOCKED = $NO_LAST_START = -1;
-
-# The number of PEs we have
-$nPEs = 32;
-
-# Unit (in pts) of the width for BLOCKED and RUNNABLE line segments
-$width_unit = 1; 
-
-# Width of line for RUNNING 
-$running_width = 1;
-
-# Offset of BLOCKED and RUNNABLE lines from the center line
-$offset = 10;
-
-# Left and right border of the picture; Width of the picture
-$left_border = 0;
-$right_border = 700;
-$total_width = $right_border - $left_border;
-$x_scale = 1;
-
-# Height of the picture measured from y-val of first to y-val of last PE
-$lower_border = 10;
-$upper_border = 490;
-$total_height = $upper_border - $lower_border;
-$y_scale = 1;
-
-# Constant from where shrinking of x-values (+scaling as usual) is enabled
-$very_big = 1E8;
-
-# Factor by which the x values are shrunk (if very big)
-$shrink_x = 10000;
-
-# Set format of output of numbers
-$# = "%.2g";
-
-# Width of stripes in migration graph
-$tic_width = 2;
-
-# If no spark profile should be generate we count the number of spark events
-# in the profile to inform the user about existing spark information
-if ( !$opt_S ) {
-    $spark_events = 0;
-}
-
-# ----------------------------------------------------------------------------
-# The real thing starts here
-# ----------------------------------------------------------------------------
-
-open (IN,"<$input") || die "$input: $!\n";
-open (OUT,">$output") || die "$output: $!\n";
-open (OUT_MIG,">$output_mig") || die "$output_mig: $!\n"  if $opt_M;
-open (OUT_SP,">$output_sp") || die "$output_sp: $!\n"  if $opt_S;
-# open (OUT_B,">$output_b") || die "$output_b: $!\n";
-# open (OUT_R,">$output_r") || die "$output_r: $!\n";
-
-open(OUT_RA, ">$RUNNABLE_file") || die "$RUNNABLE_file: $!\n"  if $opt_t;
-print OUT_RA "# Number of Runnable tasks on all PEs $i\n"      if $opt_t;
-open(OUT_BA, ">$BLOCKED_file") || die "$BLOCKED_file: $!\n"    if $opt_t;
-print OUT_BA "# Number of Blocked tasks on all PEs $i\n"       if $opt_t;
-open(OUT_FA, ">$FETCHING_file") || die "$FETCHING_file: $!\n"  if $opt_t;
-print OUT_FA "# Number of Fetching tasks on all PEs $i\n"      if $opt_t;
-
-($pname,$pars,$nPEs,$lat) = &skip_header(IN);
-
-
-# Fill in the y_val table for all PEs
-$offset = (&generate_y_val_table($nPEs)/2);
-
-$x_min = 0;
-$x_max = &get_x_max($input);
-$y_max = $total_height;
-#$y_max = $y_val[$nPEs-1] + offset;
-
-$is_very_big = $x_max > $very_big;
-
-# Max width allowed when drawing lines for BLOCKED, RUNNABLE tasks
-$max_width = $offset;
-
-# General init
-do init($nPEs);
-
-do write_prolog(OUT,$x_max,$y_max);
-do write_prolog(OUT_MIG,$x_max,$y_max)  if $opt_M;
-do write_prolog(OUT_SP,$x_max,$y_max)  if $opt_S;
-# do write_prolog(OUT_B,$x_max,$y_max);
-# do write_prolog(OUT_R,$x_max,$y_max);
-
-while (<IN>) {
-    next  if /^$/;                                # Omit empty lines;
-    next  if /^--/;                               # Omit comment lines;
-
-    ($event, $time, $id, $pe) = &get_line($_);
-    $x_max_ = $time  if $time > $x_max_;
-
-    print OUT_RA "TIME: $time  PEs: " . join(", ",@runnable) .
-	         "  SUM: " . &list_sum(@runnable) . "\n"      if $opt_t;
-    print OUT_BA "TIME: $time  PEs: " . join(", ",@blocked) .
-	         "  SUM: " . &list_sum(@blocked) . "\n"       if $opt_t;
-    print OUT_FA "TIME: $time  PEs: " . join(", ",@fetching) .
-	         "  SUM: " . &list_sum(@fetching) . "\n"      if $opt_t;
-
-    foo : {
-	($event eq "START") && do {
-	    # do draw_tic($pe, $time, $START);
-	    do draw_bg($pe, $time);
-	    $last_bg[$pe] = $time;
-	    $running[$pe] = $id;
-	    # $where{$id} = $pe + 1;
-	    last foo;
-	};
-	($event eq "START(Q)") && do {
-	    #do draw_segment($pe, $time, $RUNNABLE);
-	    do draw_bg($pe, $time);
-	    $last_bg[$pe] = $time;
-	    #$last_runnable[$pe] = $time;
-	    $runnable[$pe]++;
-	    # $where{$id} = $pe + 1;
-	    last foo;
-	};
-	($event eq "STEALING") && do {
-	    do draw_bg($pe, $time);
-	    $last_bg[$pe] = $time;
-	    $runnable[$pe]--;
-	    $where{$id} = $pe + 1;
-	    if ( $opt_M ) {
-		$when{$id} = $time;
-		do draw_tic($pe, $time, $event);
-	    }
-	    last foo;
-	};
-	($event eq "STOLEN") && do {
-	    # do draw_tic($pe, $time, $START);
-	    do draw_bg($pe, $time);
-	    $last_bg[$pe] = $time;
-	    $running[$pe] = $id;
-	    if ( $where{$id} ) { 
-		# Ok
-	    } else {
-		$warn++;
-		print "WARNING: No previous location for STOLEN task $id found!" .
-		     " Check the gr file!\n";
-	    }
-	    if ( $opt_M ) {
-		do draw_tic($pe, $time, $event);
-		do draw_arrow($where{$id}-1,$pe,$when{$id},$time);
-	    }
-	    last foo;
-	};
-	($event eq "STOLEN(Q)") && do {
-	    #do draw_segment($pe, $time, $RUNNABLE);
-	    do draw_bg($pe, $time);
-	    $last_bg[$pe] = $time;
-	    #$last_runnable[$pe] = $time;
-	    $runnable[$pe]++;
-	    if ( $where{$id} ) { 
-		# Ok
-	    } else {
-		$warn++;
-		print "WARNING: No previous location for STOLEN(Q) task $id found!" .
-		    " Check the gr file!\n";
-	    }
-	    if ( $opt_M ) {
-		do draw_tic($pe, $time, $event);
-		do draw_arrow($where{$id}-1,$pe,$when{$id},$time);
-	    }
-	    last foo;
-	};
-	($event eq "BLOCK") && do {
-	    do draw_bg($pe, $time);
-	    $last_bg[$pe] = $time;
-	    do draw_segment($pe, $time, $BLOCKED)  unless $blocked[$pe] == 0 ;
-	    $last_blocked[$pe] = $time;
-	    #do draw_segment($pe, $time, $RUNNING);
-	    $blocked[$pe]++;
-	    $running[$pe] = $NO_ID;
-	    last foo;
-	};
-	($event eq "RESUME") && do {
-	    # do draw_tic($pe, $time, $START);
-	    do draw_bg($pe, $time);
-	    $last_bg[$pe] = $time;
-	    do draw_segment($pe, $time, $BLOCKED);
-	    $last_blocked[$pe] = $time;
-	    $blocked[$pe]--;
-	    $running[$pe] = $id;
-	    last foo;
-	};
-	($event eq "RESUME(Q)") && do {
-	    #do draw_segment($pe, $time, $RUNNABLE);
-	    do draw_bg($pe, $time);
-	    $last_bg[$pe] = $time;
-	    do draw_segment($pe, $time, $BLOCKED);
-	    $last_blocked[$pe] = $time;
-	    #$last_runnable[$pe] = $time;
-	    $blocked[$pe]--;
-	    $runnable[$pe]++;
-	    last foo;
-	};
-	($event eq "END") && do {
-	    # do draw_tic($pe, $time, $END);
-	    do draw_bg($pe, $time);
-	    $last_bg[$pe] = $time;
-	    $running[$pe] = $NO_ID;
-	    # do draw_segment($pe, $time, $RUNNING);
-	    # $last_blocked[$pe] = $time;
-	    last foo;
-	};
-	($event eq "SCHEDULE") && do {
-	    # do draw_tic($pe, $time);
-	    $last_start[$pe] = $time;
-	    do draw_bg($pe, $time);
-	    $last_bg[$pe] = $time;
-	    $runnable[$pe]--;
-	    $running[$pe] = $id;
-	    last foo;
-	};
-	# NB: Check these; they are not yet tested
-	($event eq "FETCH") && do {
-	    # Similar to BLOCK; but don't draw a block segment
-	    do draw_bg($pe, $time);
-	    $last_bg[$pe] = $time;
-	    #do draw_segment($pe, $time, $BLOCKED)  unless $blocked[$pe] == 0 ;
-	    #$last_blocked[$pe] = $time;
-	    #$blocked[$pe]++;
-	    $fetching[$pe]++;
-	    $running[$pe] = $NO_ID;
-	    last foo;
-	};
-	($event eq "REPLY") && do {
-	    do draw_bg($pe, $time);
-	    $last_bg[$pe] = $time;
-	    #do draw_segment($pe, $time, $BLOCKED);
-	    #$last_blocked[$pe] = $time;
-	    #$blocked[$pe]--;
-	    $fetching[$pe]--;
-	    $blocked[$pe]++;
-	    last foo;
-	};
-	# These are only processed if a spark pofile is generated, too
-	(($event eq "SPARK") || ($event eq "SPARKAT") || ($event eq "ACQUIRED")) && do {
-	    if ( !opt_S ) {
-		$spark_events++;
-	        last foo;
-	    }
-	    do draw_sp_bg($pe, $time);
-	    $last_sp_bg[$pe] = $time;
-	    $sparks[$pe]++;
-	    last foo;
-	};
-
-	(($event eq "USED") || ($event eq "PRUNED") || ($event eq "EXPORTED")) && do {
-	    if ( !opt_S ) {
-		$spark_events++;
-	        last foo;
-	    }
-	    do draw_sp_bg($pe, $time);
-	    $last_sp_bg[$pe] = $time;
-	    $sparks[$pe]--;
-	    if ( $sparks[$pe]<0 ) {
-		print STDERR "Error: Neg. number of sparks @ $time\n";
-	    }
-	    last foo;
-	};
-
-	$warn++;
-	print "WARNING: Unknown event: $event\n";
-    }
-    do check_consistency()  if $opt_M;
-}
-
-do write_epilog(OUT,$x_max,$y_max);
-do write_epilog(OUT_MIG,$x_max,$y_max)   if $opt_M;
-do write_epilog(OUT_SP,$x_max,$y_max)    if $opt_S;
-# do write_epilog(OUT_B,$x_max,$y_max);
-# do write_epilog(OUT_R,$x_max,$y_max);
-
-close(IN);
-close(OUT);
-# close(OUT_B);
-# close(OUT_R);
-
-close(OUT_MIG) if $opt_M;
-close(OUT_SP)  if $opt_S;
-close(OUT_BA)  if $opt_t;
-close(OUT_RA)  if $opt_t;
-close(OUT_FA)  if $opt_t;
-
-#for ($i=0; $i<$nPEs; $i++) {
-#    close($OUT_BA[$i]);
-#    close($OUT_RA[$i]);
-#}
-
-if ($x_max != $x_max_ ) {
-    print STDERR "WARNING: Max time ($x_max_) is different from time of last event ($x_max)\n";
-}
-
-print "Number of suppressed warnings: $warn\n"  if $warn>0;
-print "FYI: The file $input contains $spark_events lines of spark information\n"  if !opt_S && ($spark_events>0);
-
-system "gzip -f1 $RUNNABLE_file"  if $opt_t;
-system "gzip -f1 $BLOCKED_file"   if $opt_t;
-system "gzip -f1 $FETCHING_file"  if $opt_t;
-
-system "fortune -s"  if $opt_v;
-
-exit 0;
-
-# ----------------------------------------------------------------------------
-# This translation is mainly taken from gr2qp.awk
-# This subroutine returns the event found on the current line together with
-# the relevant information for that event. The possible EVENTS are:
-#  START, STARTQ, STOLEN, BLOCK, RESUME, RESUMEQ, END, SCHEDULE
-# ----------------------------------------------------------------------------
-
-sub get_line {
-  local ($line) = @_;
-  local ($f, @fs);
-  local ($event, $time, $id, $pe);
-
-  @fs = split(/[:\[\]\s]+/,$line);
-  $event = $fs[3];
-  $time = $fs[2];
-  $id = $fs[4];
-  $pe = $fs[1];
-
-  print OUT "% > " . $_   if $opt_D;
-  print OUT "%   EVENT = $event; TIME = $time; ID = $id; PE = $pe\n" if $opt_D;
-  print OUT "%   --> this task comes from PE " . ($where{$id}-1) . "\n"  if $opt_D && $event eq "STOLEN";
-
-  return ($event, $time, $id, $pe);
-
-  # if ($fs[3] eq "START") { 
-  #     partprofile = 0; 
-  #     print (substr($3,2,length($3)-3))," *G 0 0x" $5; 
-  # }
-  # if ($fs[3] eq "START(Q)") { 
-  #     print (substr($3,2,length($3)-3))," *A 0 0x" $5; 
-  # }
-
- #  if ($fs[3] eq "STOLEN")    { 
-  #     print (substr($3,2,length($3)-3))," AG 0 0x" $5; 
-  # }
-
- #  if ($fs[3] eq "BLOCK")     { 
-  #     print (substr($3,2,length($3)-3))," GR 0 0x" $5; 
-  # }
-  # if ($fs[3] eq "RESUME")    { 
-  #     print (substr($3,2,length($3)-3))," RG 0 0x" $5, "0 0x0"; 
-  # }
-  # if ($fs[3] eq "RESUME(Q)") { 
-  #     print (substr($3,2,length($3)-3))," RA 0 0x" $5, "0 0x0"; 
-  # }
-  # if ($fs[3] eq "END")       { 
-  #   if (partprofile) {
-  #	p rint (substr($9,1,length($9)-1))," *G 0 0x" (substr($5,1,length($5)-1));
-  #	p rint (substr($3,2,length($3)-3))," G* 0 0x" (substr($5,1,length($5)-1));
-  #   } else {
-  #       print (substr($3,2,length($3)-3))," G* 0 0x" (substr($5,1,length($5)-1)); 
-  #   }
-  # }
-  # if ($fs[3] eq "SCHEDULE")  { 
-  #     print (substr($3,2,length($3)-3))," AG 0 0x" $5; 
-  # }
-
-}
-
-# ----------------------------------------------------------------------------
-
-sub check_consistency {
-    local ($i);
-
-    for ($i=0; $i<$nPEs; $i++) {
-	if ( $runnable[$i] < 0 ) {
-	    print "INCONSISTENCY: PE $i: Size of runnable queue: $runnable[$i] at time $time\n";
-            $runnable[$i] = 0 ;
-	}
-        if  ( $blocked[$i] < 0 ) {
-	    print "INCONSISTENCY: PE $i: Size of blocked queue: $blocked[$i] at time $time\n";
-            $blocked[$i] = 0 ;
-	}
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub get_width {
-    local ($n, $type) = @_;
-
-    $warn++   if $n <0;
-    print "WARNING: Neg. number of tasks in $type queue: $n!!\n"  if $n <0;
-    $n = 0  if $n <0;
-    return ( ($type eq $RUNNING) ? ($running_width * $width_unit) : 
-	    &min($max_width, $n * $width_unit) );
-}
-
-# ----------------------------------------------------------------------------
-# Use an intensity between 0 (empty runnable queue) and 1 (`full' runnable
-# queue) to abstract from monchrome/color values
-# The concrete grayshade/color is computed via PS macros.
-# ----------------------------------------------------------------------------
-
-sub get_intensity {
-    local ($n) = @_;
-
-    print "SEVERE WARNING: get_intensity: Negative size of runnable queue\n"  if $n<0;
-
-    if ($n >= $inf_block) {
-	return 1.0;
-    } else {
-	return ($n+1)/$inf_block;
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub get_sp_intensity {
-    local ($n) = @_;
-
-    print "SEVERE WARNING: get_sp_intensity: Negative size of sparks queue\n"  if $n<0;
-
-    if ($n >= $inf_block) {
-	return 1.0;
-    } else {
-	return ($n+1)/$inf_block;
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub get_shade {
-    local ($n) = @_;
-
-
-    if ($n > $inf_block) {
-	return 0.2;
-    } else {
-	return 0.8 - ($n/$inf_block);
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub max { 
-    local($x, $y) = @_;
-
-    return ($x>$y ? $x : $y);
-}
-
-# ----------------------------------------------------------------------------
-
-sub min { 
-    local($x, $y) = @_;
-
-    return ($x<$y ? $x : $y);
-}
-
-# ----------------------------------------------------------------------------
-
-sub list_sum {
-    local (@list) = @_;
-
-    local ($sum);
-
-    foreach $x (@list) {
-	$sum += $x;
-    }
-
-    return ($sum);
-}
-
-# ----------------------------------------------------------------------------
-# Drawing functions.
-# Put on top of funtions that directly generate PostScript.
-# ----------------------------------------------------------------------------
-
-sub draw_segment {
-    local ($pe, $time, $type) = @_;
-    local ($x, $y, $width, $gray);
-
-    if ( $type eq $BLOCKED ) {
-	if ( $last_blocked[$pe] == $NO_LAST_BLOCKED ) { return; };
-	$width = &get_width($blocked[$pe], $type);
-	if ( $width  == 0 ) { return; };
-	$y = $stripes_low[$pe] + int($width/2 + 0.5);
-	$x = $last_blocked[$pe]; 
-
-	if ( $is_very_big ) {	
-	    $x = int($x/$shrink_x) + 1;   # rounded up
-	}
-
-	#  $gray = 0.5;  # Ignoring gray level; doesn't change!
-	do ps_draw_hline(OUT,$x,$y,$time,$width);   
-    } else {
-	die "ERROR: Unknow type of line: $type in draw segment\n";
-    }
-
-    if ($x < 0 || $y<0) {
-	die "Impossiple arguments for ps_draw_hline: ($x,$y); type=$type\n";
-    }
-    if ($width<0 || $width>$max_width || $gray <0 || $gray > 1) {
-	die "Impossible arguments to ps_draw_hline: width=$width; gray=$gray\n";
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub draw_tic {
-    local ($pe, $time, $event) = @_;
-    local ($x, $y, $lit);
-
-    $ystart = $stripes_low[$pe];
-    $yend = $stripes_high[$pe];
-    $x = $time;
-    if ( $event eq "STEALING" ) {
-	$lit = 0;  # i.e. FROM
-    } elsif ( ( $event eq "STOLEN") || ( $event eq "STOLEN(Q)" ) ) {
-	$lit = 1;  # i.e. TO
-    } else {
-	die "ERROR: Wrong event $event in draw_tic\n";
-    }
-
-    if ( $is_very_big ) {	
-	$x = int($x/$shrink_x) + 1;   # rounded up
-    }
-
-    if ($x < 0 || $ystart<0 || $yend<0) {
-	die "Impossiple arguments for ps_draw_tic: ($x,$ystart,$yend); PE=$pe\n";
-    }
-    do ps_draw_tic(OUT_MIG,$x,$ystart,$yend,$lit);
-}
-
-# ----------------------------------------------------------------------------
-
-sub draw_bg {
-    local ($pe,$time) = @_;
-    local ($x_start, $x_end, $intensity, $secondary_intensity);
-
-    if ( $last_bg[$pe] == $NO_LAST_BG ) { 
-	print OUT "% Omitting BG: NO LAST BG\n" if $opt_D; 
-	return; 
-    }
-    if ( $running[$pe] == $NO_ID ) { 
-	print OUT "% BG: NO RUNNING PE -> idle bg\n" if $opt_D; 
-	# return;
-    }
-    $x_start = $last_bg[$pe];  
-    $x_end = $time;
-    $intensity = ( $running[$pe] == $NO_ID ? 
-		      0 : 
-	              &get_intensity($runnable[$pe]) );
-    $secondary_intensity = ( $running[$pe] == $NO_ID ? 
-			        0 : 
-	                        &get_intensity($fetching[$pe]) );
-    do ps_draw_bg(OUT,$x_start, $x_end, $stripes_low[$pe], $stripes_high[$pe],
-		  $intensity,$secondary_intensity);
-
-    if ( $opt_M ) {
-	do ps_draw_hline(OUT_MIG, $x_start, $stripes_low[$pe], $x_end, 
-			 $mig_width);
-    }
-    
-}
-
-# ----------------------------------------------------------------------------
-# Variant of draw_bg; used for spark profile
-# ----------------------------------------------------------------------------
-
-sub draw_sp_bg {
-    local ($pe,$time) = @_;
-    local ($x_start, $x_end, $intensity, $secondary_intensity);
-
-    if ( $last_sp_bg[$pe] == $NO_LAST_BG ) { 
-	print OUT_SP "% Omitting BG: NO LAST BG\n" if $opt_D; 
-	return; 
-    }
-    $x_start = $last_sp_bg[$pe];  
-    $x_end = $time;
-    $intensity = ( $sparks[$pe] <= 0 ? 
-		      0 : 
-	              &get_sp_intensity($sparks[$pe]) );
-    $secondary_intensity = 0; 
-    do ps_draw_bg(OUT_SP,$x_start, $x_end, $stripes_low[$pe], $stripes_high[$pe],
-		  $intensity,$secondary_intensity);
-
-}
-
-# ----------------------------------------------------------------------------
-
-sub draw_arrow {
-    local ($from_pe,$to_pe,$send_time,$arrive_time) = @_;
-    local ($ystart,$yend);
-    
-    $ystart = $stripes_high[$from_pe];
-    $yend = $stripes_low[$to_pe];
-    do ps_draw_arrow(OUT_MIG,$send_time,$arrive_time,$ystart,$yend);
-}
-
-# ----------------------------------------------------------------------------
-# Normalize the x value s.t. it fits onto the page without scaling.
-# The global values $left_border and $right_border and $total_width 
-# determine the borders
-# of the graph. 
-# This fct is only called from within ps_... fcts. Before that the $x values
-# are always times.
-# ----------------------------------------------------------------------------
-
-sub normalize {
-    local ($x) = @_;
-
-    return (($x-$xmin)/($x_max-$x_min) * $total_width + $left_border);
-}
-
-# ----------------------------------------------------------------------------
-# PostScript generation functions.
-# Lowest level of writing output file.
-# Now there is only normalizing mode supported. 
-# The following is out of date:
-# $mode can be $LITERATE i.e. assuming scaling has been done
-#           or $NORMALIZING i.e. no scaling has been done so far (do it in
-#                                macros for drawing)
-# ----------------------------------------------------------------------------
-
-sub ps_draw_hline {
-    local ($OUT,$xstart,$y,$xend,$width) = @_;
-    local ($xlen); 
-
-    print $OUT "% HLINE From: ($xstart,$y) to ($xend,$y) (i.e. len=$xlen) with width $width gray $gray\n" if $opt_D; 
-
-    if ( ! $opt_N ) {
-	$xstart = &normalize($xstart);
-	$xend = &normalize($xend);
-    }
-
-    $xlen = $xend - $xstart;
-
-    printf $OUT ("%d %d %d %d L\n",$xstart,$y,$xlen,$width);
-    #           ( $mode == $LITERATE ? " L\n" : " N\n");
-
-    # Old version:
-    # print $OUT "newpath\n";
-    # print $OUT "$GRAY{$type} setgray\n";
-    # print $OUT $xend . "  " . $y . " " . $xstart . " " . $y . " " . $width . 
-    #    " line\n";
-    # print $OUT "stroke\n";
-}
-
-# ----------------------------------------------------------------------------
-
-sub ps_draw_vline {
-    local ($OUT,$x,$ystart,$yend,$width) = @_;
-
-    print $OUT "% VLINE From: ($x,$ystart) to ($x,$yend) with width $width\n" if $opt_D; 
-
-    if ( ! $opt_N ) {
-	$x = &normalize($x);
-    }
-
-    print $OUT "newpath\n";
-    print $OUT "0 setgray\n";                             # constant gray level
-    printf $OUT ("%d %d %d %d %.1g line\n",
-		 $x,$yend ,$x,$ystart,$width);
-    print $OUT "stroke\n";
-}
-
-# ----------------------------------------------------------------------------
-
-sub ps_draw_tic {
-    local ($OUT,$x,$ystart,$yend,$lit) = @_;
-
-    print $OUT "% TIC at ($x,$ystart-$yend)\n"   if $opt_D;
-
-    if ( ! $opt_N ) {
-	$x = &normalize($x);
-    }
-
-    printf $OUT ("%d %d %d %d T\n",$x,$ystart,$yend,$lit);
-
-    # Old version without PostScript macro /tic:
-    # print $OUT "newpath\n";
-    # print $OUT "ticwidth setlinewidth\n" .
-    #	      $x . " " . $y . " ticlen sub moveto\n" .
-    #	      $x . " " . $y . " ticlen add lineto\n";
-    #print $OUT "stroke\n";
-}
-
-# ----------------------------------------------------------------------------
-
-sub ps_draw_arrow {
-    local ($OUT,$xstart,$xend,$ystart,$yend) = @_;
-
-    print $OUT "% ARROW from ($xstart,$ystart) to ($xend,$yend)\n"   if $opt_D;
-
-    if ( ! $opt_N ) {
-	$xstart = &normalize($xstart);
-	$xend = &normalize($xend);
-    }
-
-    printf $OUT ("%d %d %d %d A\n",$xstart,$ystart,$xend,$yend);
-}
-
-# ----------------------------------------------------------------------------
-
-sub ps_draw_bg {
-    local ($OUT,$xstart, $xend, $ystart, $yend, 
-	   $intensity, $secondary_intensity) = @_;
-    local ($xlen, $ylen);
-
-    print $OUT "% Drawing bg for PE $pe from $xstart to $xend" .
-	       "  (intensity: $intensity, $secondary_intensity)\n"  if $opt_D;
-
-    if ( ! $opt_N ) {
-	$xstart = &normalize($xstart);
-	$xend = &normalize($xend);
-    }
-
-    $xlen = $xend - $xstart;
-    $ylen = $yend - $ystart;
-
-    printf $OUT ("%d %d %d %d %.2g %.2g R\n",
-		 $xstart,$ystart,$xlen,$ylen,$intensity,$secondary_intensity);
-
-    # Old version without PostScript macro /rect:
-    #print $OUT "newpath\n";
-    #print $OUT " $x_start $y_start moveto\n";
-    #print $OUT " $x_end $y_start lineto\n";
-    #print $OUT " $x_end $y_end lineto\n";
-    #print $OUT " $x_start $y_end lineto\n";
-    #print $OUT "closepath\n";
-    #print $OUT "$gray setgray\n";
-    #print $OUT "fill\n";
-}
-
-# ----------------------------------------------------------------------------
-# Initialization and such
-# ----------------------------------------------------------------------------
-
-sub write_prolog {
-    local ($OUT, $x_max, $y_max) = @_;
-    local ($date, $dist, $y, $i);
-
-    $date = &get_date();
-
-    if ( $opt_N ) {
-      $x_scale = $total_width/$x_max;
-      $y_scale = $total_height/$y_max;
-    }
-
-    # $tic_width = 2 * $x_max/$total_width;    constant now
-    # $tic_len = 4 * $y_max/$total_height;
-
-    print $OUT "%!PS-Adobe-2.0\n";
-    print $OUT "%%BoundingBox:   \t0 0 560 800\n";
-    print $OUT "%%Title: \t$pname  $pars\n";
-    print $OUT "%%Creator: \tgr2pe\n";
-    print $OUT "%%CreationDate: \t$date\n";
-    # print $OUT "%%Orientation: \tSeascape\n";
-    print $OUT "%%EndComments\n";
-
-    # print $OUT "%%BeginSetup\n";
-    # print $OUT "%%PageOrientation: \tSeascape\n";
-    # print $OUT "%%EndSetup\n";
-
-    print $OUT "%/runlineto {1.5 setlinewidth lineto} def\n";
-    print $OUT "%/suspendlineto {0.5 setlinewidth lineto} def\n";
-    print $OUT "%/run { newpath moveto 1.5 setlinewidth lineto stroke} def\n";
-    print $OUT "%/suspend { newpath moveto 0.5 setlinewidth lineto stroke} def\n";
-    print $OUT "\n";
-    print $OUT "/total-len $x_max def\n";
-    print $OUT "/show-len $total_width def\n";
-    print $OUT "/normalize { show-len mul total-len div } def\n";
-    print $OUT "/x-normalize { exch show-len mul total-len div exch } def\n";
-    print $OUT "/str-len 12 def\n";
-    #print $OUT "/prt-n { str-len string cvs show } def" .
-    #	       "     % print top-of-stack integer\n";
-    print $OUT "/prt-n { cvi str-len string cvs \n" .
-	       "         dup stringwidth pop \n" .
-	       "         currentpoint pop 780 gt { 10 sub } { 2 div } ifelse \n" .
-               "         neg 0 rmoveto \n" . 
-               "         show  } def \n" .
-	       "        % print top-of-stack integer centered at the current point\n";
-    print $OUT "/ticwidth $tic_width def\n";
-    print $OUT "%/ticlen $tic_len def     % actually half of the tic-length\n";
-    print $OUT "/T    % Draw a tic mark\n" .
-               " {    % Operands: x, y-start, y-end of tic, from/to flag \n" .
-	       "   newpath\n" .
-	       "   0 eq { " . ( $opt_m ? " 0.2 setgray }" 
-                                       : " 0 0.7 0.2 setrgbcolor }" ) .
-	       "        { " . ( $opt_m ? " 0.8 setgray }" 
-                                       : " 0.7 0 0.2 setrgbcolor }" ) . " ifelse\n" .
-	       "   ticwidth setlinewidth\n" .
-	       "   3 copy pop moveto\n" .
-	       "   exch pop lineto\n" .
-	       "   stroke\n" .
-	       " } def\n";
-    #	       "   3 copy pop x-normalize moveto\n" .
-    #	       "   exch pop x-normalize lineto\n" .
-    #	       "   stroke\n" .
-    #	       " } def\n";
-    print $OUT "/blocked-gray 0 def\n";
-    print $OUT "/idle-gray 1 def\n";
-    print $OUT "/blocked-color { 0.2 0.1 0.8 } def\n";
-    print $OUT "/idle-color { 0.8 0.1 0.2 } def\n";
-    print $OUT "/idle-color-fetch { 0.5 0.6 0.4 } def\n";
-    print $OUT "/L              % Draw a line (for blocked tasks)\n" .
-	       " {              % Operands: (x,y)-start xlen width\n" .
-	       "  newpath \n" .
-	       ( $opt_m ? "  blocked-gray setgray\n" : 
-                          "  blocked-color setrgbcolor\n") .
-	       "         setlinewidth 3 copy pop moveto 0 rlineto pop pop stroke} def\n";
-    print $OUT "/N              % Draw a normalized line\n" .
-	       " {              % Operands: (x,y)-start xlen width\n" .
-	       "  newpath \n" .
-	       ( $opt_m ? "  blocked-gray setgray\n" : 
-                          "  blocked-color setrgbcolor\n") .
-	       "         setlinewidth 3 copy pop x-normalize moveto normalize 0 rlineto pop pop stroke} def\n";
-    print $OUT "% /L line def\n";
-    print $OUT "/printText { 0 0 moveto (GrAnSim) show } def\n";
-    if ( $opt_m ) {
-	print $OUT "/logo { gsave \n" .
-	           "        translate \n" .
-		   "        .95 -.05 0  " .
-		   "          { setgray printText 1 -.5 translate } for \n" .
-		   "        1 setgray printText\n" . 
-		   "        grestore } def\n";
-    } else {
-	print $OUT "/logo { gsave \n" .
-	      "        translate \n" .
-	      "        .95 -.05 0\n" .
-	      "          { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" . 
-	      "        1 0 0 setrgbcolor printText\n" . 
-	      "        grestore} def\n";
-    }
-
-    print $OUT "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
-    print $OUT  "/starside \n" .
-                " {starlen 0 lineto currentpoint translate \n" .
-		"    -144 rotate } def\n";
-
-   print $OUT  "/star \n" .
-               " { moveto \n" .
-	       "   currentpoint translate \n" .
-	       "   4 {starside} repeat \n" .
-	       "   closepath \n" .
-	       "   gsave \n" .
-	       "   .7 setgray fill \n" .
-	       "   grestore \n" .
-	       "   % stroke  \n" .
-	       "  } def \n";
-    #print $OUT "/get-shade   % compute shade from intensity\n" .
-    #	           " { pop 1 exch sub 0.6 mul 0.2 add } def\n";
-    if ( $opt_m ) { 
-	print $OUT "/from 0.2 def\n";
-	print $OUT "/to 0.8 def\n";
-	print $OUT "/get-shade   % compute shade from intensity\n" .
-	           "  { pop dup 0 eq { pop idle-gray }\n " .
-		   "                 { 1 exch sub to from sub mul from add } ifelse } def\n";
-	           " { pop 1 exch sub to from sub mul from add } def\n";
-    } else {
-	print $OUT "/from 0.5 def\n";
-	print $OUT "/to 0.9 def\n";
-    }
-    print $OUT "/epsilon 0.01 def\n";
-    print $OUT "/from-blue 0.7 def\n";
-    print $OUT "/to-blue   0.95 def\n";
-    print $OUT "/m 1 def\n";
-    print $OUT "/magnify { m mul dup 1 gt { pop 1 } if } def\n";
-    print $OUT "%\n" .
-	       "% show no. of runnable threads and the current degree of fetching\n" .
-	       "%\n" .
-	       "/get-color        % compute color from intensity\n" .
-               " { 4 mul dup      % give more weight to second intensity\n" .
-	       "   0 eq { pop 0 exch } \n" .
-	       "        { from-blue to-blue sub mul from-blue add dup \n" .
-	       "          1 gt { pop 1 } if  exch } ifelse \n" .
-               "   dup 0 eq { pop pop idle-color }\n" .
-               "            { 1 exch sub to from sub mul from add        % green val is top of stack\n" .
-	       "              exch 0 3 1 roll  } ifelse } def\n"; 
-
-    print $OUT "%\n";
-    print $OUT "% show no. of runable threads only\n";
-    print $OUT "%\n";
-    print $OUT "/get-color-runnable			% compute color from intensity\n";
-    print $OUT "{ pop dup 0 eq { pop idle-color }\n";
-    print $OUT "               { 1 exch sub to from sub mul from add   % green val is top of stack\n";
-    print $OUT "                 0.2 0 3 1 roll  } ifelse } def\n";
-
-    print $OUT "%\n";
-    print $OUT "% show no. of fetching threads only\n";
-    print $OUT "%\n";
-    print $OUT "/get-color-fetch  			% compute color from intensity\n";
-    print $OUT "{ exch pop dup 0 eq { pop idle-color-fetch }\n";
-    print $OUT "                    { 1 exch sub to from sub mul from add   % blue val is top of stack\n";
-    print $OUT "                      0.2 0.6 3 2 roll  } ifelse } def\n";
-
-    #print $OUT "/get-color    % compute color from intensity\n" .
-    #           " { dup 0 eq { pop idle-color }\n" .
-    #           "            { 1 exch sub to from sub mul from add 0 exch 0 } ifelse } def\n"; 
-    #	       " { dup 0.4 le { 0.4 exch sub 0.2 add 2 mul 0 0 setrgbcolor} " .
-    #          "              { 1 exch sub 0.4 add 0 exch 0 setrgbcolor} ifelse \n" .
-    print $OUT "/R          % Draw a rectangle \n" .
-               " {             % Operands: x y xlen ylen i j \n" .
-               "               %    (x,y) left lower start point of rectangle\n" .
-               "               %    xlen  length of rec in x direction\n" .
-               "               %    ylen  length of rec in y direction\n" .
-               "               %    i     intensity of rectangle [0,1] \n" .
-               "               %    j     intensity blue to indicate fetching\n" .
-               "               %          (ignored in mono mode)\n" .
-	       ( $opt_m ? "  get-shade setgray\n" 
-		        : "  get-color-runnable setrgbcolor\n" ) .
-               "  newpath\n" .
-               "  4 copy pop pop moveto\n" .
-	       "  1 index  0 rlineto\n" .
-	       "  0 index  0 exch rlineto\n" .
-	       "  1 index  neg 0 rlineto\n" .
-               "  0 index  neg 0 exch rlineto\n" .
-               "  pop pop pop pop\n" .
-               "  closepath\n" .
-               "  fill             % Note: No stroke => no border\n" .
-	       " } def\n";
-    print $OUT "% /R rect def\n";
-    print $OUT "%/A         % Draw an arrow (for migration graph)\n" .
-	       "% {         % Operands: x y x' y' \n" .
-               "%           %  (x,y)    start point \n" .
-               "%           %  (x',y')  end point \n" .
-	       ( $opt_m ? "%    0 setgray\n" : "%     0 0 0 setrgbcolor\n" ) .
-	       "%  1 setlinewidth\n" .
-	       "%  newpath 4 2 roll x-normalize moveto x-normalize lineto stroke } def\n";
-
-    print $OUT "/A         % No arrows \n" .
-	       " { pop pop pop pop } def\n";
-    print $OUT "-90 rotate\n";
-    
-    print $OUT "-785 30 translate\n";
-    print $OUT "/HE10 /Helvetica findfont 10 scalefont def\n";
-    print $OUT "/HE12 /Helvetica findfont 12 scalefont def\n";
-    print $OUT "/HE14 /Helvetica findfont 14 scalefont def\n";
-    print $OUT "/TI16 /Times-Italic findfont 16 scalefont def\n";
-    print $OUT "/HB16 /Helvetica-Bold findfont 16 scalefont def\n";
-    print $OUT "% " . "-" x 77 . "\n";
-
-    print $OUT "newpath\n";
-    print $OUT "0 8.000000 moveto\n";
-    print $OUT "0 525.000000 760.000000 525.000000 8.000000 arcto\n";
-    print $OUT "4 {pop} repeat\n";
-    print $OUT "760.000000 525.000000 760.000000 0 8.000000 arcto\n";
-    print $OUT "4 {pop} repeat\n";
-    print $OUT "760.000000 0 0 0 8.000000 arcto\n";
-    print $OUT "4 {pop} repeat\n";
-    print $OUT "0 0 0 525.000000 8.000000 arcto\n";
-    print $OUT "4 {pop} repeat\n";
-    print $OUT "0.500000 setlinewidth\n";
-    print $OUT "stroke\n";
-    print $OUT "newpath\n";
-    print $OUT "4.000000 505.000000 moveto\n";
-    print $OUT "4.000000 521.000000 752.000000 521.000000 4.000000 arcto\n";
-    print $OUT "4 {pop} repeat\n";
-    print $OUT "752.000000 521.000000 752.000000 501.000000 4.000000 arcto\n";
-    print $OUT "4 {pop} repeat\n";
-    print $OUT "752.000000 501.000000 4.000000 501.000000 4.000000 arcto\n";
-    print $OUT "4 {pop} repeat\n";
-    print $OUT "4.000000 501.000000 4.000000 521.000000 4.000000 arcto\n";
-    print $OUT "4 {pop} repeat\n";
-    print $OUT "0.500000 setlinewidth\n";
-    print $OUT "stroke\n";
-    
-    print $OUT "% ----------------------------------------------------------\n";
-    print $OUT "% Print pallet\n";
-    print $OUT "% NOTE: the values for the tics must correspond to start and\n";
-    print $OUT "%       end values in /get-color\n";
-    print $OUT "gsave \n";
-    print $OUT "340 508 translate\n";
-    print $OUT "0.0 0.05 1.00 \n";
-    print $OUT " { \n";
-    print $OUT "  dup dup \n";
-    print $OUT "    from epsilon sub gt exch \n";
-    print $OUT "    from epsilon add lt \n";
-    print $OUT "   and\n";
-    print $OUT "    { newpath " .
-	       ($opt_m ? "0 setgray " : "0 0 0 setrgbcolor ") .
-	       "0 0 moveto 0 -3 rlineto stroke } if\n";
-    print $OUT "  dup dup \n";
-    print $OUT "    to epsilon 2 mul sub gt exch \n";
-    print $OUT "    to epsilon 2 mul add lt \n";
-    print $OUT "   and\n";
-    print $OUT "    { newpath " . 
-	       ($opt_m ? "0 setgray " : "0 0 0 setrgbcolor ") .
-	       "10 0 moveto 0 -3 rlineto stroke } if\n";
-    print $OUT ($opt_m ? " setgray\n" : "  0 exch 0 setrgbcolor\n");
-    print $OUT "  newpath\n";
-    print $OUT "  0 0 moveto\n";
-    print $OUT "  10 0 rlineto\n";
-    print $OUT "  0 10  rlineto\n";
-    print $OUT "  -10 0 rlineto\n";
-    print $OUT "  closepath\n";
-    print $OUT "  fill\n";
-    print $OUT "  10 0 translate \n";
-    print $OUT " } for\n";
-    print $OUT "grestore\n";
- 
-    print $OUT "% Print pallet for showing fetch\n";
-    print $OUT "% NOTE: the values for the tics must correspond to start and\n";
-    print $OUT "%       end values in /get-color\n";
-    print $OUT "%gsave \n";
-    print $OUT "%340 508 translate\n";
-    print $OUT "%0.0 0.05 1.00 \n";
-    print $OUT "%{ \n";
-    print $OUT "%  dup dup \n";
-    print $OUT "%    from epsilon sub gt exch \n";
-    print $OUT "%    from epsilon add lt \n";
-    print $OUT "%   and\n";
-    print $OUT "%   { newpath 0 0 0 setrgbcolor 0 0 moveto 0 -3 rlineto stroke } if\n";
-    print $OUT "%  dup dup \n";
-    print $OUT "%    to epsilon 2 mul sub gt exch \n";
-    print $OUT "%    to epsilon 2 mul add lt \n";
-    print $OUT "%   and\n";
-    print $OUT "%   { newpath 0 0 0 setrgbcolor 10 0 moveto 0 -3 rlineto stroke } if\n";
-    print $OUT "%  0.2 exch 0.6 exch setrgbcolor   \n";
-    print $OUT "%  newpath\n";
-    print $OUT "%  0 0 moveto\n";
-    print $OUT "%  10 0 rlineto\n";
-    print $OUT "%  0 10  rlineto\n";
-    print $OUT "%  -10 0 rlineto\n";
-    print $OUT "%  closepath\n";
-    print $OUT "%  fill\n";
-    print $OUT "%  10 0 translate \n";
-    print $OUT "% } for\n";
-    print $OUT "% grestore\n";
-
-    print $OUT "% Print double pallet\n";
-    print $OUT "% NOTE: the values for the tics must correspond to start and\n";
-    print $OUT "%       end values in /get-color\n";
-    print $OUT "% gsave \n";
-    print $OUT "% 340 500 translate\n";
-    print $OUT "% 0.0 0.05 1.00 \n";
-    print $OUT "% { \n";
-    print $OUT "%   0 exch 0 setrgbcolor   \n";
-    print $OUT "%   newpath\n";
-    print $OUT "%   0 0 moveto\n";
-    print $OUT "%   10 0 rlineto\n";
-    print $OUT "%   0 10  rlineto\n";
-    print $OUT "%   -10 0 rlineto\n";
-    print $OUT "%   closepath\n";
-    print $OUT "%   fill\n";
-    print $OUT "%   10 0 translate \n";
-    print $OUT "% } for\n";
-    print $OUT "% grestore\n";
-    print $OUT "% gsave \n";
-    print $OUT "% 340 510 translate\n";
-    print $OUT "% 0.0 0.05 1.00 \n";
-    print $OUT "% { \n";
-    print $OUT "%   dup dup \n";
-    print $OUT "%     from epsilon sub gt exch \n";
-    print $OUT "%     from epsilon add lt \n";
-    print $OUT "%    and\n";
-    print $OUT "%    { newpath 0 0 0 setrgbcolor 0 3 moveto 0 -6 rlineto stroke } if\n";
-    print $OUT "%   dup dup \n";
-    print $OUT "%     to epsilon 2 mul sub gt exch \n";
-    print $OUT "%     to epsilon 2 mul add lt \n";
-    print $OUT "%    and\n";
-    print $OUT "%    { newpath 0 0 0 setrgbcolor 10 3 moveto 0 -6 rlineto stroke } if\n";
-    print $OUT "%    0.7 exch 0 setrgbcolor   \n";
-    print $OUT "%    newpath\n";
-    print $OUT "%    0 0 moveto\n";
-    print $OUT "%    10 0 rlineto\n";
-    print $OUT "%    0 10  rlineto\n";
-    print $OUT "%    -10 0 rlineto\n";
-    print $OUT "%    closepath\n";
-    print $OUT "%    fill\n";
-    print $OUT "%    10 0 translate \n";
-    print $OUT "% } for\n";
-    print $OUT "% grestore\n";
-    print $OUT "% ----------------------------------------------------------\n";
-    print $OUT "HE14 setfont\n";
-    print $OUT "100.000000 508.000000 moveto\n";
-    print $OUT "($pname  PEs: $nPEs  Lat.: $lat ) show\n";
-    
-    print $OUT "($date) dup stringwidth pop 750.000000 exch sub 508.000000 moveto show\n";
-    print $OUT ( $opt_m ? "5 512 asciilogo\n" : "5 512 logo\n");    
-    print $OUT "% 100 500 moveto\n";    
-
-    print $OUT "0 20 translate\n";
-
-    print $OUT "HE14 setfont\n";
-    for ($i=0; $i<$nPEs; $i++) {
-	$dist = $stripes_high[$i] - $stripes_low[$i];
-	$y = $stripes_low[$i] + $dist/2;
-	# print $OUT "/starlen $dist def\n";
-	# print $OUT "gsave 2 $y star grestore\n";
-	print $OUT "  2 " . ($stripes_low[$i]+1) . " moveto ($i) show\n";
-    }
-
-    print $OUT "20 0 translate\n";
-
-    print $OUT "% Print x-axis:\n";
-    print $OUT "1 setlinewidth\n";
-    print $OUT "0 -5 moveto total-len normalize 0 rlineto stroke\n";
-    print $OUT "gsave\n" .
-	       "[2 4] 1 setdash\n" .
-	       "0 0 moveto 0 $total_height rlineto stroke\n" .
-	       "% $x_max 0 moveto 0 $total_height rlineto stroke\n" .
-	       "grestore\n";
-    print $OUT "0 total-len 10 div total-len\n" .
-               " { dup normalize dup -5 moveto 0 -2 rlineto stroke  % tic\n" .
-               "   -17 moveto HE10 setfont round prt-n  % print label \n" .
-	       " } for \n";
-    
-
-    print $OUT "$x_scale  $y_scale  scale\n";
-
-    print $OUT "% ++++++++++++++++++++++++++++++++++++++++++++++++++\n\n";
-    
-    if ( $opt_D ) {
-	print $OUT "% Debugging info : \n";
-
-	print $OUT "% Offset is: $offset\n";
-
-	print $OUT "% y_val table: \n";
-	for ($i=0; $i<$nPEs; $i++) {
-	    print $OUT "% y_val of $i: $y_val[$i]\n";
-	}
-
-	print $OUT "% x-max: $x_max; y-max: $y_max\n";
-	print $OUT "% Info from header: Prg: $pname; PEs: $nPEs; Lat.: $lat\n";
-
-	print $OUT "% ++++++++++++++++++++++++++++++++++++++++++++++++++\n\n";
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub write_epilog {
-    local ($OUT,$x_max, $y_max) = @_;
-    local($x_scale,$y_scale);
-
-    print $OUT "showpage\n";
-}
-
-# ----------------------------------------------------------------------------
-
-sub get_x_max {
-    local ($file) = @_;
-    local ($last_line, @fs);
-
-    open (TMP,"tail -1 $file |") || die "tail -1 $file | : $!\n";
-    while (<TMP>) {
-	$last_line = $_;
-    }
-    close(TMP);
-
-    @fs = split(/[:\[\]\s]+/,$last_line);
-
-    return $fs[2];
-}
-
-# ----------------------------------------------------------------------------
-#
-#sub get_date {
-#    local ($now,$today,@lt);
-#
-#    @lt = localtime(time);
-#    $now = join(":",reverse(splice(@lt,0,3)));
-#    $today = join(".",splice(@lt,0,3));
-#
-#    return $now . " on " . $today;
-#}
-#
-# ----------------------------------------------------------------------------
-
-sub get_date {
-    local ($date);
-
-    open (DATE,"date |") || die ("$!");
-    while (<DATE>) {
-	$date = $_;
-    }
-    close (DATE);
-
-    return ($date);
-}
-
-# -----------------------------------------------------------------------------
-
-sub generate_y_val_table {
-    local ($nPEs) = @_;
-    local($i, $y, $dist);
-
-    $dist = int($total_height/$nPEs);
-    for ($i=0, $y=1; $i<$nPEs; $i++, $y+=$dist) {
-	$y_val[$i] = $y + $lower_border;
-	$stripes_low[$i] = $y;
-	$stripes_high[$i] = $y+$dist-2;
-    }
-
-    # print $OUT "10 5 translate\n";
-
-    return ($dist);
-}
-
-# ----------------------------------------------------------------------------
-
-sub init { 
-    local ($nPEs) = @_;
-    local($i);
-
-    for ($i=0; $i<$nPEs; $i++) {
-	if ( $opt_S ) {
-	    $sparks[$i] = 0;
-	}
-	$blocked[$i] = 0;
-	$runnable[$i] = 0;
-	$fetching[$i] = 0;
-	$running[$i] = $NO_ID;
-	if ( $opt_S ) {
-	    $last_sp_bg[$i] = $NO_LAST_BG;
-	}
-	$last_bg[$i] = $NO_LAST_BG;
-	$last_start[$i] = $NO_LAST_START;
-	$last_blocked[$i] = $NO_LAST_BLOCKED;
-	$last_runnable[$i] = 0; 
-	#open($OUT_RA[$i], "PE". $i . ".dat") || die "PE".$i."-R.dat: $!\n";
-	#print $OUT_RA[$i] "# Number of Runnable tasks on PE $i\n";
-	#open($OUT_BA[$i], "PE". $i . ".dat") || die "PE".$i."-B.dat: $!\n";
-	#print $OUT_BA[$i] "# Number of Blocked tasks on PE $i\n";
-    } 
-    
-}
-
-
-# ----------------------------------------------------------------------------
-
-sub skip_header {
-    local ($FILE) = @_;
-    local($prg, $pars, $nPEs, $lat, $fetch, $in_header);
-
-    $in_header = 9;
-    while (<$FILE>) {
-	if ( $in_header = 9 ) {
-	    if (/^=/) {
-		$gum_style_gr = 1;
-		$in_header = 0;
-		$prg = "????";		# 
-		$pars = "-b??????";		# 
-		$nPEs = $opt_p ? $opt_p : 1; # 
-		$lat = $opt_l ? $opt_l : 1;
-		return ($prg, $pars, $nPEs, $lat);
-	    } else {
-		$gum_style_gr = 0;
-		$in_header = 1;
-	    }
-	    
-	}
-	$prg = $1, $pars = $2   if /^Granularity Simulation for\s+(\w+)\s+(.*)$/;
-	$nPEs = $1	        if /^PEs\s+(\d+)/;
-	$lat = $1, $fetch = $2  if /^Latency\s+(\d+)[^F]+Fetch\s+(\d+)/;
-	die "Can't process GranSim-Light profiles!\n"  if /^GrAnSim-Light$/i;
-
-	last             if /^\+\+\+\+\+/;
-    }
-
-    return ($prg, $pars, $nPEs, $lat);
-}
-
-# ----------------------------------------------------------------------------
-
-sub process_options {
-
-    if ( $opt_h ) {                      
-	open(ME,$0) || die "Can't open myself ($0): $!\n";
-	$n = 0;
-	while (<ME>) {
-	    last if $_ =~ /^$/;
-	    print $_;
-	    $n++;
-	}
-	close(ME);
-	exit ;
-    }
-    
-    if ( $#ARGV != 0 ) {
-	print "Usage: $0 [options] <gr-file>\n";
-	print "Use -h option to get details\n";
-	exit 1;
-    }
-    
-    $input = $ARGV[0] ;
-    $input =~ s/\.gr//;
-    $input .= ".gr";
-
-    if ( $opt_o ) {
-	($output   = $opt_o) =~ s/\.ps// ;
-	$output_b = $output . "_peb.ps";
-	$output_r = $output . "_per.ps";
-	$output_mig = $output . "_mig.ps" if $opt_M;
-	$output_sp = $output . "_sp.ps"   if $opt_S;
-	$output   = $output . "_pe.ps";
-	#($output_b = $opt_o) =~ s/\./-b./ ;
-	#($output_r = $opt_o) =~ s/\./-r./ ;
-	#($output_mig = $opt_o) =~ s/\./-mig./  if $opt_M;
-	#($output_sp = $opt_o) =~ s/\./-sp./  if $opt_S;
-    } else {
-	($output = $input) =~ s/\.gr// ;
-	$output_b = $output . "_peb.ps";
-	$output_r = $output . "_per.ps";
-	$output_mig = $output . "_mig.ps" if $opt_M;
-	$output_sp = $output . "_sp.ps"   if $opt_S;
-	$output   = $output . "_pe.ps";
-    }
-    
-    if ( $opt_v ){ 
-	$verbose = 1;
-    }    
-
-    if ( $opt_i ) {
-	$inf_block = $opt_i;
-    } else {
-	$inf_block = 20;
-    }
-
-    $RUNNABLE_file = $input;
-    $RUNNABLE_file =~ s/\.gr//;
-    $RUNNABLE_file .= "-R";
-
-    $BLOCKED_file = $input;
-    $BLOCKED_file =~ s/\.gr//;
-    $BLOCKED_file .= "-B";
-
-    $FETCHING_file = $input;
-    $FETCHING_file =~ s/\.gr//;
-    $FETCHING_file .= "-F";
-}
-
-# ----------------------------------------------------------------------------
-
-sub print_verbose_message {
-
-    print "Input file: $input\n";  
-    print "Output files: $output, $output_b, $output_r; ".
-          ($opt_M ? "Migration: $output_mig" : "") .
-	  ($opt_S ? "Sparks: $output_sp" : "") .
-	  "\n";
-}
-
-# ----------------------------------------------------------------------------
-# Junk from draw_segment:
-#
-#    if ( $type eq $RUNNING ) { 
-#	die "ERROR: This version should never draw a RUNNING segment!";
-#	$y = $y_val[$pe];
-#	$x = $last_start[$pe]; 
-#	$width = &get_width(0, $type);
-#	# $gray = 0;
-#
-#	if ( $is_very_big ) {	
-#	    $x = int($x/$shrink_x) + 1;   # rounded up
-#	}
-#
-#	do ps_draw_hline(OUT_B,$x,$y,$time,$width);
-#	do ps_draw_hline(OUT_R,$x,$y,$time,$width);  
-#
-#    } elsif ( $type eq $RUNNABLE ) {
-#	die "ERROR: This version should never draw a RUNNABLE segment (shades are used instead)!";
-#	$y = $y_val[$pe] + $offset;
-#	$x = $last_runnable[$pe];
-#	$width = &get_width($runnable[$pe], $type);
-#
-#	if ( $is_very_big ) {	
-#	    $x = int($x/$shrink_x) + 1;   # rounded up
-#	}
-#
-#	# $gray = 0.5;
-#	do ps_draw_hline(OUT_R,$x,$y,$time,$width);   
diff --git a/ghc/utils/parallel/gr2ps.bash b/ghc/utils/parallel/gr2ps.bash
deleted file mode 100644
index 4d4d3da3e6..0000000000
--- a/ghc/utils/parallel/gr2ps.bash
+++ /dev/null
@@ -1,169 +0,0 @@
-#!/usr/local/bin/bash
-##############################################################################
-# Time-stamp: <Wed Jul 24 1996 22:11:13 Stardate: [-31]7859.41 hwloidl>
-#
-# Usage: gr2ps [options] <gr-file>
-#
-# Create an overall activity graph from a GrAnSim (or GUM) profile.
-# Transform the log file of a GrAnSim run (a .gr file) into a quasi-parallel
-# profile (a .qp file) using gr2qp and then into a PostScript file using qp2ps.
-# The generated PostScript file shows essentially the number of running, 
-# runnable and blocked tasks during the execution of the program.
-#
-# Options:
-#  -o <file> ... write .ps file to <file>
-#  -I <str>  ... queues to be displayed (in the given order) with the encoding
-#                 'a' ... active (running)
-#                 'r' ... runnable
-#                 'b' ... blocked
-#                 'f' ... fetching
-#                 'm' ... migrating
-#                 's' ... sparks
-#                (e.g. -I "arb" shows active, runnable, blocked tasks)
-#  -i <int>  ... info level from 1 to 7; number of queues to display
-#  -m        ... create mono PostScript file instead a color one.
-#  -O        ... optimise the produced .ps w.r.t. size
-#		 NB: With this option info is lost. If there are several values
-#		     with same x value only the first one is printed, all 
-#		     others are dropped.
-#  -s <str>  ... print <str> in the top right corner of the generated graph
-#  -S        ... improved version of sorting events
-#  -l <int>  ... length of slice in the .ps file; (default: 100)
-#                small value => less memory consumption of .ps file & script
-#  -d        ... Print date instead of average parallelism
-#  -v        ... be talkative. 
-#  -h        ... print help message (this header).
-#
-##############################################################################
-
-progname="`basename $0`"
-args="$*"
-
-verb=0
-help=0
-mono=""
-psfile=""
-debug=""
-optimise=""
-info_level=""
-info_mask=""
-string=""
-length=""
-force_date=""
-hack=""
-
-getopts "hvmDCOHSdl:s:o:i:I:" name
-while [ "$name" != "?" ] ; do
-  case $name in
-   h) help=1;;
-   v) verb=1;;
-   m) mono="-m";;
-   D) debug="-D";;
-   C) check="-C";;
-   O) optimise="-O";;
-   d) force_date="-d";;
-   H) hack="-H";;
-   S) improved_sort="-S";;
-   s) string="-s $OPTARG";;
-   l) length="-l $OPTARG";;
-   i) info_level="-i $OPTARG";;
-   I) info_mask="-I $OPTARG";;
-   o) psfile=$OPTARG;;
-  esac 
-  getopts "hvmDCOHSdl:s:o:i:I:" name
-done
-
-opts_qp="$debug $info_level $info_mask $improved_sort "
-opts_ps="$debug $check $optimise $mono $string $length $info_level $info_mask $force_date $hack "
-
-shift $[ $OPTIND - 1 ]
-
-if [ $help -eq 1 ]
- then no_of_lines=`cat $0 | awk 'BEGIN { n = 0; } \
-                                 /^$/ { print n; \
-                                        exit; } \
-                                      { n++; }'`
-      echo "`head -$no_of_lines $0`"
-      exit 
-fi
-
-if [ -z "$1" ]
- then echo "Usage: $progname [options] file[.gr]"
-      echo "Use -h option for details"
-      exit 1;
-fi
-
-f="`basename $1 .gr`"
-grfile="$f".gr
-qpfile="${TMPDIR:-.}/$f".qp
-ppfile="${TMPDIR:-.}/$f".pp
-
-if [ -z "$psfile" ]
-  then psfile="$f".ps
-fi
-
-if [ $verb -eq 1 ]
-  then echo "Input file: $grfile"
-       echo "Quasi-parallel file: $qpfile"
-       echo "PP file: $ppfile"
-       echo "PostScript file: $psfile"
-       if [ -n "$mono" ]
-         then echo "Producing monochrome PS file"
-         else echo "Producing color PS file"
-       fi
-       if [ -n "$optimise" ]
-         then echo "Optimisation is ON"
-         else echo "Optimisation is OFF"
-       fi
-       if [ -n "$debug" ]
-         then echo "Debugging is turned ON"
-         else echo "Debugging is turned OFF"
-       fi
-       if [ -n "$improved_sort" ]
-         then echo "Improved sort is turned ON"
-         else echo "Improved sort is turned OFF"
-       fi
-       verb_opt="-v "
-       opts_qp="${opts_qp} $verb_opt "
-       opts_ps="${opts_ps} $verb_opt "
-       echo "Options for gr2qp: ${opts_qp}"
-       echo "Options for qp2ps: ${opts_ps}"
-fi
-
-
-# unset noclobber
-if [ ! -f "$grfile" ] 
- then
-  echo "$grfile does not exist"
-  exit 1
- else
-  rm -f "$qpfile" "$psfile"
-  prog=`head -1 "$grfile" | sed -e 's/Granularity Simulation for //'`
-  echo "$prog" >| "$qpfile"
-  if [ $verb -eq 1 ] 
-    then echo "Executed program: $prog" 
-  fi
-  date >> "$qpfile"
-  #date="`date`"                     # This is the date of running the script
-  date="`tail +2 $grfile | head -1 | sed -e 's/Start time: //'`"
-  cat "$grfile" | gr2qp ${opts_qp} >> "$qpfile"
-  # Sorting is part of gr2qp now.
-  #  | ghc-fool-sort | sort -n +0 -1 | ghc-unfool-sort >> "$qpfile"
-  # max=`tail -2 "$qpfile" | awk '!/^Number of threads:/ { print $1; }'`
-  xmax=`tail -1 "$qpfile" | awk '{ print $2; }'`
-  ymax=`tail -1 "$qpfile" | awk '{ print $4; }'`
-  if [ $verb -eq 1 ] 
-    then echo "Total runtime: $xmax"
-	 echo "Maximal number of tasks: $ymax"
-  fi
-  tail +3 "$qpfile" | qp2ps ${opts_ps} "$xmax" "$ymax" "$prog" "$date" >| "$psfile"
-  rm -f "$qpfile"
-  if [ $verb -eq 1 ] 
-    then echo "Scaling (maybe): ps-scale-y $psfile " 
-  fi
-  ps-scale-y "$psfile"
-fi
-
-  
-
-
diff --git a/ghc/utils/parallel/gr2qp.pl b/ghc/utils/parallel/gr2qp.pl
deleted file mode 100644
index e87f21b1e4..0000000000
--- a/ghc/utils/parallel/gr2qp.pl
+++ /dev/null
@@ -1,329 +0,0 @@
-#!/usr/local/bin/perl
-##############################################################################
-# Time-stamp: <Wed Jul 24 1996 20:35:01 Stardate: [-31]7859.07 hwloidl>
-#
-# Usage: gr2qp [options]
-#
-# Filter that transforms a GrAnSim profile (a .gr file) at stdin to  
-# a quasi-parallel profile (a .qp file). It is the common front-end for most
-# visualization tools (except gr2pe). It collects  running,
-# runnable and blocked tasks in queues of different `colours', whose meaning
-# is:
-#  G ... green;   queue of all running tasks
-#  A ... amber;   queue of all runnable tasks
-#  R ... red;     queue of all blocked tasks
-#  Y ... cyan;    queue of fetching tasks 
-#  C ... crimson; queue of tasks that are being stolen
-#  B ... blue;    queue of all sparks
-#
-# Options:
-#  -i <int>  ... info level from 1 to 7; number of queues to count (see qp3ps)
-#  -I <str>  ... count tasks that are in one of the given queues; encoding:
-#                 'a' ... active (running)
-#                 'r' ... runnable
-#                 'b' ... blocked
-#                 'f' ... fetching
-#                 'm' ... migrating
-#                 's' ... sparks
-#                (e.g. -I "arb" counts sum of active, runnable, blocked tasks)
-#  -c        ... check consistency of data (e.g. no neg. number of tasks)
-#  -v        ... be talkative. 
-#  -h        ... print help message (this header).
-#
-##############################################################################
-
-require "getopts.pl";
-
-&Getopts('hvDSci:I:');  
-
-do process_options();
-
-if ( $opt_v ) {
-    do print_verbose_message();
-}
-
-# ---------------------------------------------------------------------------
-# Init
-# ---------------------------------------------------------------------------
-
-$max = 0;
-$pmax = 0;
-$ptotal = 0;
-$n = 0;
-
-$active = 0;
-$runnable = 0;
-$blocked = 0;
-$fetching = 0;
-$migrating = 0;
-$sparks = 0;
-
-$improved_sort_option = $opt_S ? "-S" : "";
-
-open (FOOL,"| ghc-fool-sort $improved_sort_option | sort -n +0 -1 | ghc-unfool-sort") || die "FOOL";
-
-$in_header = 9; 
-while(<>) {
-    if ( $in_header == 8 ) {
-	$start_time = $1 if /^Start-Time: (.*)$/;
-	$in_header = 0;
-	next;
-    }
-    if ( $in_header == 9 ) {
-        if (/^=/) {
-	    $gum_style_gr = 1;
-	    $in_header = 8;
-	    next;
-	} else {
-	    $gum_style_gr = 0;
-	    $in_header = 1;
-	}
-	
-    }
-    if (/^\++$/) {
-	$in_header=0;
-	next;
-    }
-    next if $in_header;
-    next if /^$/;
-    next if /^=/;
-    chop;
-    ($PE, $pe, $time, $act, $tid, $rest) = split;
-    $time =~ s/[\[\]:]//g;
-    # next if $act eq 'REPLY';
-    chop($tid) if $act eq 'END';
-    $from = $queue{$tid};
-    $extra = "";
-    if ($act eq 'START') {
-	$from = '*';
-	$to = 'G';
-	$n++;
-	if ( $n > $pmax ) { $pmax = $n; }
-	$ptotal++;
-    } elsif ($act eq 'START(Q)') {
-	$from = '*';
-	$to = 'A';
-	$n++;
-	if ( $n > $pmax ) { $pmax = $n; }
-	$ptotal++;
-    } elsif ($act eq 'STEALING') {
-	$to = 'C';
-    } elsif ($act eq 'STOLEN') {
-	$to = 'G';
-    } elsif ($act eq 'STOLEN(Q)') {
-	$to = 'A';
-    } elsif ($act eq 'FETCH') {
-	$to = 'Y';
-    } elsif ($act eq 'REPLY') {
-	$to = 'R';
-    } elsif ($act eq 'BLOCK') {
-	$to = 'R';
-    } elsif ($act eq 'RESUME') {
-	$to = 'G';
-	$extra = " 0 0x0";
-    } elsif ($act eq 'RESUME(Q)') {
-	$to = 'A';
-	$extra = " 0 0x0";
-    } elsif ($act eq 'END') {
-	$to = '*';
-	$n--;
-	if ( $opt_c && $n < 0 ) { 
-	    print STDERR "Error at time $time: neg. number of tasks: $n\n";
-	}
-    } elsif ($act eq 'SCHEDULE') {
-	$to = 'G';
-    } elsif ($act eq 'DESCHEDULE') {
-	$to = 'A';
-    # The following are only needed for spark profiling
-    } elsif (($act eq 'SPARK') || ($act eq 'SPARKAT')) {
-	$from = '*';
-	$to = 'B';
-    } elsif ($act eq 'USED') {
-	$from = 'B';
-	$to = '*';
-    } elsif ($act eq 'PRUNED') {
-	$from = 'B';
-	$to = '*';
-    } elsif ($act eq 'EXPORTED') {
-	$from = 'B';
-	$to = 'B';
-    } elsif ($act eq 'ACQUIRED') {
-	$from = 'B';
-	$to = 'B';
-    } else {
-	print STDERR "Error at time $time: unknown event $act\n";
-    }
-    $queue{$tid} = $to;
-
-    if ( $from eq '' ) {
-	print STDERRR "Error at time $time: process $tid has no from queue\n";
-    }
-    if ($to ne $from) {
-        print FOOL $time, "  ", 
-	  $from, $to, " 0 0x", $tid, $extra, "\n";
-    }
-
-    if ($to ne $from) {
-	# Compare with main loop in qp3ps
-	if ($from eq '*') {
-	} elsif ($from eq 'G') {
-	    --$active;
-	} elsif ($from eq 'A') {
-	    --$runnable;
-	} elsif ($from eq 'R') {
-	    --$blocked;
-	} elsif ($from eq 'B') {
-	    --$sparks;
-	} elsif ($from eq 'C') {
-	    --$migrating;
-	} elsif ($from eq 'Y') {
-	    --$fetching;
-	} else {
-	    print STDERR "Illegal from char: $from at $time\n";
-	}
-
-	if ($to eq '*') {
-	} elsif ($to eq 'G') {
-	    ++$active;
-	} elsif ($to eq 'A') {
-	    ++$runnable;
-	} elsif ($to eq 'R') {
-	    ++$blocked;
-	} elsif ($to eq 'B') {
-	    ++$sparks;
-	} elsif ($to eq 'C') {
-	    ++$migrating;
-	} elsif ($to eq 'Y') {
-	    ++$fetching;
-	} else {
-	    print STDERR "Illegal to char: $to at $time\n";
-	}
-
-    }
-
-    $curr = &count();
-    if ( $curr > $max ) {
-	$max = $curr;
-    }
-
-    if ( 0 ) {
-	print STDERR "%% $time: (act,runnable,blocked,fetch,mig,sp) = " .
-	    "($active, $runnable, $blocked, $fetching, $migrating, $sparks)".
-		" max = $max\n"  ;
-    }
-
-    #print STDERR "Sparks @ $time: $sparks \tCurr: $curr \tMax: $max \n"  if $opt_D;
- 
-    if ( $time > $tmax ) {
-	$tmax = $time;
-    }
-    delete $queue{$tid} if $to eq '*';
-    
-}
-
-print "Time: ", $tmax, " Max_selected_tasks: ", $max, 
-      " Max_running_tasks: ", $pmax, " Total_tasks: ", $ptotal, "\n";
-
-close(FOOL);
-
-exit 0;
-
-# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-# Copied from qp3ps and slightly modified (we don't keep a list for each queue
-# but just compute the max value we get out of all calls to count during the
-# execution of the script).
-# -----------------------------------------------------------------------------
-
-# -----------------------------------------------------------------------------
-
-sub queue_on {
-    local ($queue) = @_;
-
-    return index($show,$queue)+1;
-}
-
-# -----------------------------------------------------------------------------
-
-sub count {
-    local ($res);
-
-    $res = (($queue_on_a)  ? $active : 0) +
-	   (($queue_on_r)  ? $runnable : 0) +
-	   (($queue_on_b)  ? $blocked : 0) +
-	   (($queue_on_f)  ? $fetching : 0) +
-	   (($queue_on_m)  ? $migrating : 0) +
-           (($queue_on_s)  ? $sparks : 0);
-
-    return $res;
-}
-    
-# -----------------------------------------------------------------------------
-# DaH 'oH lo'lu'Qo'
-# -----------------------------------------------------------------------------
-
-sub set_values {
-    local ($samples,
-	   $active,$runnable,$blocked,$fetching,$sparks,$migrating) = @_;
-
-    $G[$samples] = queue_on_a ? $active : 0;   
-    $A[$samples] = queue_on_r ? $runnable : 0; 
-    $R[$samples] = queue_on_b ? $blocked : 0;  
-    $Y[$samples] = queue_on_f ? $fetching : 0; 
-    $B[$samples] = queue_on_s ? $sparks : 0;   
-    $C[$samples] = queue_on_m ? $migrating : 0;
-}
-
-# -----------------------------------------------------------------------------
-
-sub process_options { 
-    if ( $opt_h ) {                      
-	open(ME,$0) || die "Can't open myself ($0): $!\n";
-	$n = 0;
-	while (<ME>) {
-	    last if $_ =~ /^$/;
-	    print $_;
-	    $n++;
-	}
-	close(ME);
-	exit ;
-    }
-
-    $show = "armfb";
-
-    if ( $opt_i ) { 
-	$show = "a"		if info_level == 1;
-	$show = "ar"		if info_level == 2;
-	$show = "arb"		if info_level == 3;
-	$show = "arfb"		if info_level == 4;
-	$show = "armfb"		if info_level == 5;
-	$show = "armfbs"	if info_level == 6;
-    }
-
-    if ( $opt_I ) {
-	$show = $opt_I;
-    }
-
-    if ( $opt_v ){ 
-	$verbose = 1;
-    }    
-
-    $queue_on_a = &queue_on("a");
-    $queue_on_r = &queue_on("r"); 
-    $queue_on_b = &queue_on("b"); 
-    $queue_on_f = &queue_on("f"); 
-    $queue_on_s = &queue_on("s"); 
-    $queue_on_m = &queue_on("m"); 
-}
-
-sub print_verbose_message { 
-
-    print STDERR "Info-str: $show\n";
-    print STDERR "The following queues are turned on: " .
-	  ( $queue_on_a ? "active, " : "") .   
-	  ( $queue_on_r ? "runnable, " : "") . 
-	  ( $queue_on_b ? "blocked, " : "") .  
-          ( $queue_on_f ? "fetching, " : "") . 
-          ( $queue_on_m ? "migrating, " : "") .
-	  ( $queue_on_s ? "sparks" : "") .
-          "\n";
-}
diff --git a/ghc/utils/parallel/gran-extr.pl b/ghc/utils/parallel/gran-extr.pl
deleted file mode 100644
index 509da499d6..0000000000
--- a/ghc/utils/parallel/gran-extr.pl
+++ /dev/null
@@ -1,2114 +0,0 @@
-#!/usr/local/bin/perl
-##############################################################################
-# Last modified: Time-stamp: <Sat Oct 28 1995 23:49:48 Stardate: [-31]6509.75 hwloidl>
-#                                                      (C) Hans Wolfgang Loidl
-#
-# Usage: gran-extr [options] [<sim-file>]
-#
-# Takes a file <sim-file> generated by running the GrAnSim simulator and 
-# produces data files that should be used as input for gnuplot.
-# This script produces figures for:
-#   runtime of tasks
-#   percentage of communication
-#   heap allocation
-#   number of created sparks
-#   cumulative no. of tasks over runtime
-# Furthermore, it computes the correlation between runtime and heap allocation.
-#
-# Options:
-#  -g <file>  ... filename of granularity file to be produced; should end with
-#                .dat; -global and -local will be automatically inserted for 
-#                other versions. 
-#  -c <file> ... filename of communication file to be produced; should end with
-#                .dat; -global and -local will be automatically inserted for 
-#                other versions. 
-#  -s <file> ... filename of sparked-threads file to be produced; should end w/
-#                .dat; -global and -local will be automatically inserted for 
-#                other versions. 
-#  -a <file> ... filename of heap alloc. file to be produced; should end with
-#                .dat;
-#  -f <file> ... filename of communication time file to be produced; 
-#                should end with .dat;
-#  -p <file> ... filename of GNUPLOT file that is prouced and executed.
-#  -G <LIST> ... provide a list of boundaries for the Intervals used in the 
-#                granularity figure; must be a Perl list e.g. (10, 20, 50)
-#                this is interpreted as being open to left and right.
-#  -C <LIST> ... provide a list of boundaries for the Intervals used in the 
-#                communication figure; must be a Perl list e.g. (10, 20, 50)
-#                this is interpreted as being closed to left and right.
-#  -S <LIST> ... provide a list of boundaries for the Intervals used in the 
-#                sparked-threads figure; must be a Perl list e.g. (10, 20, 50)
-#                this is interpreted as being closed to left and right.
-#  -A <LIST> ... provide a list of boundaries for the Intervals used in the 
-#                heap alloc figure; must be a Perl list e.g. (10, 20, 50)
-#                this is interpreted as being closed to left and right.
-#  -F <LIST> ... provide a list of boundaries for the Intervals used in the 
-#                comm. time figure; must be a Perl list e.g. (10, 20, 50)
-#                this is interpreted as being open to left and right.
-#  -l <int>  ... left margin in the produced figures.
-#  -r <int>  ... right margin in the produced figures.
-#  -x <int>  ... enlargement of figure along x-axis.
-#  -y <int>  ... enlargement of figure along y-axis.
-#  -e <int>  ... thickness of impulses in figure.
-#  -i <rat>  ... set the gray level of the impulses to <rat>; <rat> must be
-#                between 0 and 1 with 0 meaning black. 
-#  -k <n>    ... number of klusters (oops, clusters, I mean ;)
-#  -P        ... print percentage of threads rather than absolute number of 
-#                threads on the y axis
-#  -t <file> ... use template <file> for interval settings and file names
-#                Syntax of a line in the template file:
-#                 <flag>: <arg>
-#  -T        ... use smart xtics rather than GNUPLOT default x-axis naming.
-#  -L        ... use logarithmic scale for all figures.
-#  -W        ... print warnings
-#  -m        ... generate monchrome output
-#  -h        ... help; print this text.
-#  -v        ... verbose mode.
-#
-##############################################################################
-
-# ----------------------------------------------------------------------------
-# Command line processing and initialization
-# ----------------------------------------------------------------------------
-
-require "getopts.pl";
-
-&Getopts('hvWTPDmt:L:g:f:c:s:a:p:G:F:C:S:A:l:r:x:y:e:i:k:');  
-
-do process_options();
-
-$OPEN_INT = 1;
-$CLOSED_INT = 0;
-
-if ( $opt_v ) {
-    do print_verbose_message ();
-}
-
-# ----------------------------------------------------------------------------
-# The real thing
-# ----------------------------------------------------------------------------
-
-open(INPUT,"<$input") || die "Couldn't open input file $input";
-
-do skip_header();
-
-$tot_total_rt = 0;
-$tot_rt = 0;
-$tot_bt = 0;
-$tot_ft = 0;
-$tot_it = 0;
-$gum_style_gr = 0;
-
-$line_no = 0;
-while (<INPUT>) {
-    next                     if /^--/;     # Comment lines start with --
-    next		     if /^\s*$/;   # Skip empty lines
-    $line_no++;
-    @fields = split(/[:,]/,$_);
-    $has_end = 0;
-
-    foreach $elem (@fields) {
-      foo : {
-        $pe = $1, $end = $2 , last foo   if $elem =~ /^\s*PE\s+(\d+)\s+\[(\d+)\].*$/;
-        $tn = $1, $has_end = 1  , last foo   if $elem =~ /^\s*END\s+(\w+).*$/;
-	# $tn = $1	, last foo   if $elem =~ /^\s*TN\s+(\w+).*$/;
-	$sn = $1	, last foo   if $elem =~ /^\s*SN\s+(\d+).*$/;
-        $start = $1     , last foo   if $elem =~ /^\s*ST\s+(\d+).*$/;
-        $is_global = $1 , last foo   if $elem =~ /^\s*EXP\s+(T|F).*$/;
-        $bbs = $1       , last foo   if $elem =~ /^\s*BB\s+(\d+).*$/;
-        $ha = $1        , last foo   if $elem =~ /^\s*HA\s+(\d+).*$/;
-        $rt = $1        , last foo   if $elem =~ /^\s*RT\s+(\d+).*$/;
-        $bt = $1, $bc = $2 , last foo if $elem =~ /^\s*BT\s+(\d+)\s+\((\d+)\).*$/;
-        $ft = $1, $fc = $2 , last foo if $elem =~ /^\s*FT\s+(\d+)\s+\((\d+)\).*$/;
-        $lsp = $1        , last foo   if $elem =~ /^\s*LS\s+(\d+).*$/;
-        $gsp = $1        , last foo   if $elem =~ /^\s*GS\s+(\d+).*$/;
-        $my = $1        , last foo   if $elem =~ /^\s*MY\s+(T|F).*$/;
-      }
-    }
-
-    next unless $has_end == 1;
-
-    $total_rt = $end - $start;
-    $ready_time = $total_rt - $rt - $bt - $ft;
-
-    # ------------------------------------------------------------------------
-    # Accumulate runtime, block time, fetch time and ready time over all threads
-    # ------------------------------------------------------------------------
-
-    $tot_total_rt += $total_rt;
-    $tot_rt += $rt;
-    $tot_bt += $bt;
-    $tot_ft += $ft;
-    $tot_it += $ready_time;
-
-    # ------------------------------------------------------------------------
-    # Gather statistics about `load' on the PEs
-    # ------------------------------------------------------------------------
-
-    print "WARNING: ready time of thread is <0: $ready_time\n" if $pedantic && ($ready_time <0);
-    $pe_load[$pe] += $ready_time;
-
-    if ( $opt_D ) {
-	print "Adding $ready_time to the load time of PE no. $pe yielding $pe_load[$pe]\n";
-    }
-
-    # ------------------------------------------------------------------------
-    # Gather statistics about the size of a spark site
-    # ------------------------------------------------------------------------
-
-    $site_size[$sn] += $rt;
-
-    if ( $opt_D ) {
-	print "Adding $rt to the size of site $sn yielding $site_size[$sn]\n";
-    }
-
-    # ------------------------------------------------------------------------
-    # Gather statistics about pure exec time
-    # ------------------------------------------------------------------------
-
-    push(@all_rts,$rt);
-    $sum_rt += $rt;
-    $max_rt = $rt  if $rt > $max_rt;
-
-    $index = do get_index_open_int($rt,@exec_times);
-    $exec_class[$index]++;
-
-    if ( $is_global eq 'T' ) {
-	$exec_global_class[$index]++;
-    } else {
-	$exec_local_class[$index]++;
-    }
-
-    # ------------------------------------------------------------------------
-    # Gather statistics about communication time (absolute time rather than %)
-    # ------------------------------------------------------------------------
-    
-    # Note: Communicatin time is fetch time
-
-    push(@all_fts,$ft);
-    $sum_ft += $ft;
-    $max_ft = $ft  if $ft > $max_ft;
-
-    $index = do get_index_open_int($ft,@fetch_times);
-    $fetch_class[$index]++;
-
-    if ( $is_global eq 'T' ) {
-	$fetch_global_class[$index]++;
-    } else {
-	$fetch_local_class[$index]++;
-    }
-
-    # ------------------------------------------------------------------------
-    # Gather statistics about communication percentage
-    # ------------------------------------------------------------------------
-
-    $comm_perc = ( $total_rt == 0 ? 100 : (100 * $ft)/$total_rt );
-
-    push(@all_comm_percs,$comm_perc); 
-    $sum_comm_perc += $comm_perc;
-    $max_comm_perc = $comm_perc  if $comm_perc > $max_comm_perc;
-
-    $index = do get_index_closed_int( $comm_perc, @comm_percs );
-    if ( $index != -1 ) {
-      $comm_class[$index]++;
-    } else {
-      print "WARNING: value " . $comm_perc . " not in range (t_rt=$total_rt; ft=$ft)\n" if $pedantic;
-      $outside++;
-    }
-
-    if ( $is_global eq 'T' ) {
-      if ( $index != -1 ) {
-	$comm_global_class[$index]++;
-      } else {
-        $outside_global++;
-      }
-    } else {
-      if ( $index != -1 ) {
-	$comm_local_class[$index]++;
-      } else {
-        $outside_local++;
-      }
-    }
-
-    # ------------------------------------------------------------------------
-    # Gather statistics about locally sparked threads
-    # ------------------------------------------------------------------------
-
-    push(@all_local_sparks,$lsp);
-    $sum_local_sp += $lsp;
-    $max_local_sp = $lsp  if $lsp > $max_local_sp;
-
-    $index = do get_index_open_int($lsp,@sparks);
-    $spark_local_class[$index]++;
-
-    # ------------------------------------------------------------------------
-    # Gather statistics about globally sparked threads
-    # ------------------------------------------------------------------------
-
-    push(@all_global_sparks,$gsp);
-    $sum_global_sp += $gsp;
-    $max_global_sp = $gsp  if $gsp > $max_global_sp;
-
-    $index = do get_index_open_int($gsp,@sparks);
-    $spark_global_class[$index]++;
-
-    # ------------------------------------------------------------------------
-    # Add the above two entries to get the total number of sparks
-    # ------------------------------------------------------------------------
-
-    $sp = $lsp + $gsp;
-
-    push(@all_sparks,$sp);
-    $sum_sp += $sp;
-    $max_sp = $sp  if $sp > $max_sp;
-
-    $index = do get_index_open_int($sp,@sparks);
-    $spark_class[$index]++;
-
-    # ------------------------------------------------------------------------
-    # Gather statistics about heap allocations
-    # ------------------------------------------------------------------------
-
-    push(@all_has,$ha);
-    $sum_ha += $ha;
-    $max_ha = $ha  if $ha > $max_ha;
-
-    $index = do get_index_open_int($ha,@has);
-    $ha_class[$index]++;
-
-    # do print_line($start,$end,$is_global,$bbs,$ha,$rt,$bt,$bc,$ft,$fc,$my);
-}
-
-print STDERR "You don't want to engage me for a file with just $line_no lines, do you?(N)\n" , exit (-1)         if $line_no <= 1;
-
-# ----------------------------------------------------------------------------
-
-do write_pie_chart();
-
-# ----------------------------------------------------------------------------
-# Statistics
-# ----------------------------------------------------------------------------
-
-if ( $opt_D ) {
-  print "Lengths:\n" .
-        "   all_rts: $#all_rts;\n" .
-        "   all_comm_percs: $#all_comm_percs;\n" .
-        "   all_sparks: $#all_sparks; \n" . 
-        "   all_local_sparks: $#all_local_sparks; \n" .
-        "   all_global_sparks: $#all_global_sparks; \n" . 
-        "   all_has: $#all_has\n" .
-	"   all_fts: $#all_fts;\n";
-
-
-  print "No of elems in all_rts: $#all_rts with sum $sum_rt\n";
-  print "No of elems in all_comm_percs: $#all_rts with sum $sum_comm_perc\n";
-  print "No of elems in all_has: $#all_has with sum $sum_ha\n";
-  print "No of elems in all_fts: $#all_fts with sum $sum_ft\n";
-
-}
-
-do do_statistics($line_no);
-
-# Just for debugging
-# ..................
-
-if ( $opt_D ) {
-  open(FILE,">LOG") || die "Couldn't open file LOG\n";
-  printf FILE "All total runtimes (\@all_rts:)\n";
-  printf FILE "[";
-  printf FILE join(", ",@all_rts);
-  printf FILE "]\n";
-  printf FILE "  Mean, std. dev: $mean_rt, $std_dev_rt\n";
-  printf FILE 70 x "-" . "\n";
-  printf FILE "All  communication times (\@all_fts:)\n";
-  printf FILE "[";
-  printf FILE join(", ",@all_fts);
-  printf FILE "]\n";
-  printf FILE "  Mean, std. dev: $mean_ft, $std_dev_ft\n";
-  printf FILE 70 x "-" . "\n";
-  printf FILE "All communication percentages (\@all_comm_percs:)\n";
-  printf FILE "[";
-  printf FILE join(", ",@all_comm_percs);
-  printf FILE "]\n";
-  printf FILE "  Mean, std. dev: $mean_comm_perc,$std_dev_comm_perc\n";
-  printf FILE 70 x "-" . "\n";
-  printf FILE "All  sparks  (\@all_sparks:)\n";
-  printf FILE "[";
-  printf FILE join(", ",@all_sparks);
-  printf FILE "]\n";
-  printf FILE "  Mean, std. dev: $mean_spark,$std_dev_spark\n";
-  printf FILE 70 x "-" . "\n";
-  printf FILE "All local sparks  (\@all_local_sparks:)\n";
-  printf FILE "[";
-  printf FILE join(", ",@all_local_sparks);
-  printf FILE "]\n";
-  printf FILE "  Mean, std. dev: $mean_local_spark,$std_dev_local_spark\n";
-  printf FILE 70 x "-" . "\n";
-  printf FILE "All global sparks  (\@all_global_sparks:)\n";
-  printf FILE "[";
-  printf FILE join(", ",@all_global_sparks);
-  printf FILE "]\n";
-  printf FILE "  Mean, std. dev: $mean_global_spark,$std_dev_global_spark\n";
-  printf FILE 70 x "-" . "\n";
-  printf FILE "All local sparks  (\@all_has:)\n";
-  printf FILE "[";
-  printf FILE join(", ",@all_has);
-  printf FILE "]\n";
-  printf FILE "  Mean, std. dev: $mean_ha,$std_dev_ha\n";
-  printf FILE 70 x "-" . "\n";
-
-
-  printf FILE ("CORR of runtime and heap alloc:  %f\n",$c_exec_ha);
-  printf FILE ("CORR of runtime and no. of sparks:  %f\n",$c_exec_sp);
-  printf FILE ("CORR of heap alloc and no. sparks:  %f\n",$c_ha_sp);
-  printf FILE ("CORR of runtime and local sparks:  %f\n",$c_exec_lsp);
-  printf FILE ("CORR of runtime and global sparks:  %f\n",$c_exec_gsp);
-  printf FILE ("CORR of heap alloc and local sparks:  %f\n",$c_ha_lsp);
-  printf FILE ("CORR of heap alloc and global sparks:  %f\n",$c_ha_gsp);
-  printf FILE ("CORR of runtime and communication time:  %f\n",$c_exec_ft);
-  printf FILE ("CORR of heap alloc and communication time:  %f\n",$c_ha_ft);
-  printf FILE ("CORR of local sparks and communication time:  %f\n",$c_lsp_ft);
-  printf FILE ("CORR of global_sparks and communication time:  %f\n",$c_gsp_ft);
-  close FILE;
-}
-
-if ( $opt_P ) {
-  do percentify($line_no,*exec_class);
-  do percentify($line_no,*exec_global_class);
-  do percentify($line_no,*exec_local_class);
-  do percentify($line_no,*comm_class);
-  do percentify($line_no,*comm_global_class);
-  do percentify($line_no,*comm_local_class);
-  do percentify($line_no,*spark_local_class);
-  do percentify($line_no,*spark_global_class);
-  do percentify($line_no,*ha_class);
-  do percentify($line_no,*ft_class);
-}
-
-# Produce cumulative RT graph and other (more or less) nice graphs
-# ................................................................
-
-do sort_and_cum();
-
-# ----------------------------------------------------------------------------
-
-open(IV,">INTERVALS") || die "Couldn't open file INTERVALS\n";
-do write_interval(IV, 'G', &guess_interval(@all_rts));
-do write_interval(IV, 'C', 0, int($mean_comm_perc), 
-                           int($mean_comm_perc+$std_dev_comm_perc), 50);
-do write_interval(IV, 'S', &guess_interval(@all_sparks));
-do write_interval(IV, 'A', &guess_interval(@all_has));
-close(IV);
-
-# ----------------------------------------------------------------------------
-# Print results to STDOUT (mainly for testing)
-# ----------------------------------------------------------------------------
-
-if ( $opt_v ) {
-    do print_general_info();
-}
-
-# ----------------------------------------------------------------------------
-# Write results to data files to be processed by GNUPLOT
-# ----------------------------------------------------------------------------
-
-do write_data($gran_file_name, $OPEN_INT, $logscale{'g'}, $#exec_times+1,
-              @exec_times, @exec_class);
-
-do write_data($gran_global_file_name, $OPEN_INT, $logscale{'g'}, $#exec_times+1,
-              @exec_times, @exec_global_class);
-
-do write_data($gran_local_file_name, $OPEN_INT, $logscale{'g'}, $#exec_times+1,
-              @exec_times, @exec_local_class);
-
-do write_data($comm_file_name, $CLOSED_INT, $logscale{'c'}, $#comm_percs+1,
-              @comm_percs, @comm_class);
-
-do write_data($comm_global_file_name, $CLOSED_INT, $logscale{'c'}, $#comm_percs+1,
-              @comm_percs, @comm_global_class);
-
-do write_data($comm_local_file_name, $CLOSED_INT, $logscale{'c'}, $#comm_percs+1,
-              @comm_percs, @comm_local_class);
-
-do write_data($spark_file_name, $OPEN_INT, $logscale{'s'}, $#sparks+1,
-              @sparks, @spark_class);
-
-do write_data($spark_local_file_name, $OPEN_INT, $logscale{'s'}, $#sparks+1,
-              @sparks, @spark_local_class);
-
-do write_data($spark_global_file_name, $OPEN_INT, $logscale{'s'}, $#sparks+1,
-              @sparks, @spark_global_class);
-
-do write_data($ha_file_name, $OPEN_INT, $logscale{'a'}, $#has+1,
-              @has, @ha_class);
-
-do write_data($ft_file_name, $OPEN_INT, $logscale{'g'}, $#fetch_times+1,
-              @fetch_times, @fetch_class);
-
-
-# ----------------------------------------------------------------------------
-# Run GNUPLOT over the data files and create figures
-# ----------------------------------------------------------------------------
-
-do gnu_plotify($gp_file_name); 
-
-print "Script finished successfully!\n";
-
-exit 0;
-
-# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-# ----------------------------------------------------------------------------
-# Basic Operations on the intervals
-# ----------------------------------------------------------------------------
-
-sub get_index_open_int {
-    local ($value,@list) = @_;
-    local ($index,$right);
-
-    # print "get_index: searching for index of" . $value;
-    # print " in " . join(':',@list);
-
-      $index = 0;
-      $right = $list[$index];
-      while ( ($value >= $right) && ($index < $#list) ) {
-  	$index++;
-        $right = $list[$index];
-      }
-    
-      return ( ($index == $#list) && ($value > $right) ) ? $index+1 : $index;
-}
-
-# ----------------------------------------------------------------------------
-
-sub get_index_closed_int {
-    local ($value,@list) = @_;
-    local ($index,$right);
-
-      if ( ($value < $list[0]) || ($value > $list[$#list]) ) {
-	  return ( -1 );
-      }
-
-      $index = 0;
-      $left = $list[$index];
-      while ( ($left <= $value) && ($index < $#list) ) {
-  	$index++;
-        $left = $list[$index];
-      }
-      return ( $index-1 );
-}
-
-# ----------------------------------------------------------------------------
-# Write operations
-# ----------------------------------------------------------------------------
-
-sub write_data {
-    local ($file_name, $open_int, $logaxes, $n, @rest) = @_;
-    local (@times) = splice(@rest,0,$n);
-    local (@class) = @rest;
-
-    open(GRAN,">$file_name") || die "Couldn't open file $file_name for output";
-
-    if ( $open_int == $OPEN_INT ) {
-
-      for ($i=0, 
-           $left = ( index($logaxes,"x") != -1 ? int($times[0]/2) : 0 ), 
-           $right = 0; 
-           $i < $n; 
-           $i++, $left = $right) {
-         $right = $times[$i];
-         print GRAN int(($left+$right)/2) . "  " . 
-                    ($class[$i] eq "" ? "0" : $class[$i]) . "\n"; 
-      }
-      print GRAN $times[$n-1]+(($times[$n-1]-$times[$n-2])/2) . "  " . 
-                 ($class[$n] eq "" ? "0" : $class[$n]) . "\n";
-
-     } else {
-
-      print GRAN ( (index($logaxes,"x") != -1) && ($times[0] == 0 ? int($times[1]/2) : ($times[$1] + $times[0])/2 ) .  "  " . $class[0] . "\n");
-      for ($i=1; $i < $n-2; $i++) {
-         $left = $times[$i];
-         $right = $times[$i+1];
-         print(GRAN ($left+$right)/2 . "  " . 
-                    ($class[$i] eq "" ? "0" : $class[$i]) . "\n"); 
-      }
-      print GRAN ($times[$n-1]+$times[$n-2])/2 . "  " . $class[$n-2]  if $n >= 2;
-    }
-
-    close(GRAN);
-}
-
-# ----------------------------------------------------------------------------
-
-sub write_array {
-    local ($file_name,$n,@list) = @_;
-
-    open(FILE,">$file_name") || die "$file_name: $!";
-    for ($i=0; $i<=$#list; $i++) {
-	print FILE $i . "  " .  ( $list[$i] eq "" ? "0" : $list[$i] ) . "\n";
-    }
-
-    if ( $opt_D ) {
-	print "write_array: (" . join(", ",1 .. $#list) . ")\n for file $file_name returns: \n (0, $#list, &list_max(@list)\n";
-    } 
-
-    return ( (0, $#list, &list_max(@list), 
-              "(" . join(", ",1 .. $#list) . ")\n") );
-}
-
-# ----------------------------------------------------------------------------
-
-sub write_cumulative_data {
-    local ($file_name1,$file_name2,@list) = @_;
-    local (@ns, @elems, @xtics, $i, $j, $n, $elem, $max_clust, $xtics_str,
-           $xstart, $xend, $file_name0);
-    local ($CLUST_SZ) = $no_of_clusters;
-
-    @ns = ();
-    @elems = ();
-    $file_name0 = $file_name1;
-    $file_name0 =~ s/\.dat$//;
-    $file_name0 .= "0.dat";
-    open(CUMM,">$file_name1") || die "Couldn't open file $file_name1 (error $!)\n";
-    open(CUMM0,">$file_name0") || die "Couldn't open file $file_name0 (error $!)\n";
-
-    print CUMM "1  0\n" unless $list[0] <= 1;
-    print CUMM0 "1  0\n" unless $list[0] <= 1;;
-
-    for ($i=0; $i <= $#list; $i++) {
-	$elem = $list[$i];
-        print CUMM ($elem) . "  " . int( (100 * ($i)) / ($#list+1) ) . "\n"  unless $elem == 0;
-        print CUMM0 ($elem) . "  " . $i . "\n" unless $elem == 0;;
-	for ($n=1; $i < $#list && $list[$i+1] == $elem; $i++, $n++) { }
-
-        print CUMM "$elem  " . int( (100 * ($i+1)) / ($#list+1) ) . "\n";
-        print CUMM0 "$elem  " . ($i+1) . "\n";
-	
-
-        if ( $opt_D ) {
-	    print "\n--> Insert: n:  $n (elem $elem) in the above lists yields: \n  ";
-        }
-
-        # inlined version of do insert_elem($elem, $n, $#exs, @exs, @ns)
-	for ($j=0; $j<=$#ns && $ns[$j]>$n; $j++) { }
-	if ( $j > $#ns ) {
-	    push(@ns,$n);
-	    push(@elems,$elem);
-	} else {
-	    splice(@ns,$j,0,$n);           # insert $n at pos $j and move the
-	    splice(@elems,$j,0,$elem);     # rest of the array to the right
-	}
-
-        if ( $opt_D ) {
-	    print "[" . join(", ",@ns) . "]" . "\n and \n" . 
-		  "[" . join(", ",@elems) . "]\n";
-        }
-      
-    }
-
-    close(CUMM);
-    close(CUMM0);
-
-    open(CLUSTERS_ALL,">" . (&dirname($file_name2)) . "CL-" .
-	              &basename($file_name2)) 
-        || die "Couldn't open file CL-$file_name2 (error $!)\n";
-    for ($i=0; $i <= $#ns; $i++) {
-	print CLUSTERS_ALL "$elems[$i]  $ns[$i]\n";
-    }
-    close(CLUSTERS_ALL);
-
-    # Interesting are only the first parts of the list (clusters!)
-    splice(@elems, $CLUST_SZ);
-    splice(@ns, $CLUST_SZ);
-
-    open(CLUSTERS,">$file_name2") || die "Couldn't open file $file_name2 (error $!)\n";
-
-    $xstart = &list_min(@elems);
-    $xend =   &list_max(@elems);
-    $step = ($xend - $xstart) / ( $CLUST_SZ == 1 ? 1 : ($CLUST_SZ-1));
-
-    @xtics = ();
-    for ($i=0, $x=$xstart; $i <= $#ns; $i++, $x+=$step) {
-	print CLUSTERS "$x  $ns[$i]\n";
-	push(@xtics,"\"$elems[$i]\" $x");
-    }
-    close(CLUSTERS);
-
-    $max_clust = $ns[0];
-    $xtics_str = "(" . join(", ",@xtics) . ")\n";
-
-    return ( ($xstart, $xend, $max_clust, $xtics_str) );
-}
-
-# ----------------------------------------------------------------------------
-
-sub get_xtics {
-    local ($open_int, @list) = @_;
-
-    local ($str);
-
-    if ( $open_int == $OPEN_INT ) { 
-      $last = pop(@list);
-      $str = "( \">0\" 0";
-      foreach $x (@list) {
-	  $str .= ", \">$x\" $x";
-      }
-      $str .= ", \"Large\" $last)\n";
-    } else { 
-      $left = shift(@list);
-      $right = shift(@list)  if $#list >= 0;
-      $last  = pop(@list)    if $#list >= 0;
-      $str = "( \"$left-$right\" " . $left;
-      $left = $right;
-      foreach $right (@list) {
-	  $str .= ", \"$left-$right\" " . ($left+$right)/2;
-	  $left = $right;
-      }
-      $str .= ", \"$left-$last\" " . $last .")\n"   unless $last eq "";
-    }
-    return $str;
-}
-
-# ----------------------------------------------------------------------------
-
-sub print_line {
-    local ($start,$end,$is_global,$bbs,$ha,$rt,$bt,$bc,$ft,$fc,$my) = @_;
-
-    printf("START: %u, END: %u  ==> tot_exec: %u\n",
-           $start,$end,$end-$start);
-    printf("  BASIC_BLOCKS: %u, HEAP_ALLOCATIONS: %u \n",$bbs,$ha);
-    printf("  TOT_EXEC: %u = RUN_TIME %u + BLOCK_TIME %u + FETCH_TIME %u\n",
-           $end-$start,$rt,$bt,$ft);
-    printf("  BLOCK_TIME %u / BLOCK_COUNT %u; FETCH_TIME %u / FETCH_COUNT %u\n",
-	   $bt,$bc,$ft,$fc);
-    printf("  %s  %s\n",
-           $is_global eq 'T' ? "GLOBAL" : "LOCAL",
-           $my eq 'T' ? "MANDATORY" : "NOT MANDATORY"); 
-}
-           
-# ----------------------------------------------------------------------------
-
-sub gnu_plotify {
-  local ($gp_file_name) = @_;
-
-  local (@open_xrange,@closed_xrang,@spark_xrange,@ha_xrange, @ft_range,
-         $exec_xtics,$comm_perc_xtics,$spark_xtics,$has_xtics,
-	 $cumu0_rts_file, $cumu0_has_file, $cumu0_fts_file);
-
- $cumu0_rts_file = $cumulat_rts_file_name;
- $cumu0_rts_file =~ s/\.dat$//;
- $cumu0_rts_file .= "0.dat";
-
- $cumu0_has_file = $cumulat_has_file_name;
- $cumu0_has_file =~ s/\.dat$//;
- $cumu0_has_file .= "0.dat";
-
- $cumu0_fts_file = $cumulat_fts_file_name;
- $cumu0_fts_file =~ s/\.dat$//;
- $cumu0_fts_file .= "0.dat";
-
- $cumu0_cps_file = $cumulat_cps_file_name;
- $cumu0_cps_file =~ s/\.dat$//;
- $cumu0_cps_file .= "0.dat";
-
-  @open_xrange = &range($OPEN_INT,$logscale{'g'},@exec_times);
-  @closed_xrange = &range($CLOSED_INT,$logscale{'c'},@comm_percs);
-  @spark_xrange = &range($OPEN_INT,$logscale{'s'},@sparks);
-  @ha_xrange = &range($OPEN_INT,$logscale{'a'},@has);
-  @ft_xrange = &range($OPEN_INT,$logscale{'f'},@fts);
-
-  $exec_xtics = $opt_T ? &get_xtics($OPEN_INT,@exec_times) : "" ;
-  $comm_perc_xtics = $opt_T ? &get_xtics($CLOSED_INT,@comm_percs) : "";
-  $spark_xtics = $opt_T ? &get_xtics($OPEN_INT,@sparks) : "";
-  $has_xtics = $opt_T ? &get_xtics($OPEN_INT,@has) : "";
-  $fts_xtics = $opt_T ? &get_xtics($OPEN_INT,@fts) : "";
-
-  open(GP_FILE,">$gp_file_name") || 
-      die "Couldn't open gnuplot file $gp_file_name for output\n";
-
-  if ( $opt_m ) {
-      print GP_FILE "set term postscript \"Roman\" 20\n";
-  } else {
-      print GP_FILE "set term postscript color \"Roman\" 20\n";
-  }
-
-  do write_gp_record(GP_FILE,
-                     $gran_file_name, &dat2ps_name($gran_file_name),
-                     "Granularity (pure exec. time)", $ylabel, $logscale{'g'},
-                     @open_xrange,$max_rt_class,$exec_xtics);
-  do write_gp_record(GP_FILE,
-                     $gran_global_file_name, &dat2ps_name($gran_global_file_name),
-                     "Granularity (pure exec. time) of exported threads",
-                     $ylabel, $logscale{'g'},
-                     @open_xrange,$max_rt_global_class,$exec_xtics);
-  do write_gp_record(GP_FILE,
-                     $gran_local_file_name, &dat2ps_name($gran_local_file_name),
-                     "Granularity (pure exec. time) of not exported threads",
-                     $ylabel,$logscale{'g'},
-                     @open_xrange,$max_rt_local_class,$exec_xtics);
-
-  do write_gp_record(GP_FILE,
-                     $comm_file_name, &dat2ps_name($comm_file_name),
-                     "% of communication",$ylabel,$logscale{'c'},
-                     @closed_xrange,$max_comm_perc_class,$comm_perc_xtics);
-  do write_gp_record(GP_FILE,
-                     $comm_global_file_name, &dat2ps_name($comm_global_file_name),
-                     "% of communication of exported threads",$ylabel,$logscale{'c'},
-                     @closed_xrange,$max_comm_perc_global_class,$comm_perc_xtics);
-  do write_gp_record(GP_FILE,
-                     $comm_local_file_name, &dat2ps_name($comm_local_file_name),
-                     "% of communication of not exported threads",$ylabel,$logscale{'c'},
-                     @closed_xrange,$max_comm_perc_local_class,$comm_perc_xtics);
-  do write_gp_record(GP_FILE,
-                     $ft_file_name, &dat2ps_name($ft_file_name),
-                     "Communication time", $ylabel, $logscale{'g'},
-                     @open_xrange,$max_ft_class,$fts_xtics);
-
-
-  do write_gp_record(GP_FILE,
-                     $spark_file_name, &dat2ps_name($spark_file_name),
-                     "No. of sparks created", $ylabel, $logscale{'s'},
-                     @spark_xrange,$max_spark_class,$spark_xtics);
-
-  do write_gp_record(GP_FILE,
-                     $spark_local_file_name, &dat2ps_name($spark_local_file_name),
-                     "No. of sparks created (parLocal)", $ylabel, $logscale{'s'},
-                     @spark_xrange,$max_spark_local_class,$spark_xtics);
-
-  do write_gp_record(GP_FILE,
-                     $spark_global_file_name, &dat2ps_name($spark_global_file_name),
-                     "No. of sparks created (parGlobal)", $ylabel, $logscale{'s'},
-                     @spark_xrange,$max_spark_global_class,$spark_xtics);
-
-  do write_gp_record(GP_FILE,
-                     $ha_file_name, &dat2ps_name($ha_file_name),
-                     "Heap Allocations (words)", $ylabel, $logscale{'a'},
-                     @ha_xrange,$max_ha_class,$has_xtics);
-
-  do write_gp_lines_record(GP_FILE,
-                           $cumulat_rts_file_name, &dat2ps_name($cumulat_rts_file_name),
-                           "Cumulative pure exec. times","% of threads",
-			   $logscale{'Cg'},
-                           $xend_cum_rts, $yend_cum_rts,""); 
-                           # $xtics_cluster_rts as last arg?
-
-  do write_gp_lines_record(GP_FILE,
-                           $cumulat_has_file_name, &dat2ps_name($cumulat_has_file_name),
-                           "Cumulative heap allocations","% of threads",
-			   $logscale{'Ca'},
-                           $xend_cum_has, $yend_cum_has,"");
-                           #  $xtics_cluster_has as last arg?
-
-  do write_gp_lines_record(GP_FILE,
-                           $cumu0_rts_file, &dat2ps_name($cumu0_rts_file),
-                           "Cumulative pure exec. times","Number of threads",
-			   $logscale{'Cg'},
-                           $xend_cum_rts, $yend_cum0_rts,""); 
-                           # $xtics_cluster_rts as last arg?
-
-  do write_gp_lines_record(GP_FILE,
-                           $cumu0_has_file, &dat2ps_name($cumu0_has_file),
-                           "Cumulative heap allocations","Number of threads",
-			   $logscale{'Ca'},
-                           $xend_cum_has, $yend_cum0_has,"");
-                           #  $xtics_cluster_has as last arg?
-
-  do write_gp_lines_record(GP_FILE,
-                           $cumulat_fts_file_name, &dat2ps_name($cumulat_fts_file_name),
-                           "Cumulative communication times","% of threads",
-			   $logscale{'Cg'},
-                           $xend_cum_fts, $yend_cum_fts,""); 
-                           # $xtics_cluster_rts as last arg?
-
-  do write_gp_lines_record(GP_FILE,
-                           $cumu0_fts_file, &dat2ps_name($cumu0_fts_file),
-                           "Cumulative communication times","Number of threads",
-			   $logscale{'Cg'},
-                           $xend_cum_fts, $yend_cum0_fts,""); 
-                           # $xtics_cluster_rts as last arg?
-
-  do write_gp_lines_record(GP_FILE,
-                           $cumulat_cps_file_name, &dat2ps_name($cumulat_cps_file_name),
-                           "Cumulative communication percentages","% of threads",
-			   "",  # No logscale here !
-                           $xend_cum_cps, $yend_cum_cps,""); 
-                           # $xtics_cluster_rts as last arg?
-
-  do write_gp_lines_record(GP_FILE,
-                           $cumu0_cps_file, &dat2ps_name($cumu0_cps_file),
-                           "Cumulative communication percentages","Number of threads",
-			   "",  # No logscale here !
-                           $xend_cum_cps, $yend_cum0_cps,""); 
-                           # $xtics_cluster_rts as last arg?
-
-  do write_gp_record(GP_FILE,
-                     $clust_rts_file_name, &dat2ps_name($clust_rts_file_name),
-                     "Pure exec. time", "No. of threads", $logscale{'CG'},
-                     $xstart_cluster_rts,$xend_cluster_rts,$max_cluster_rts,$xtics_cluster_rts);
-
-  do write_gp_record(GP_FILE,
-                     $clust_has_file_name, &dat2ps_name($clust_has_file_name),
-                     "Pure exec. time", "No. of threads", $logscale{'CA'},
-                     $xstart_cluster_has,$xend_cluster_has,$max_cluster_has,$xtics_cluster_has);
-
-  do write_gp_record(GP_FILE,
-                     $clust_fts_file_name, &dat2ps_name($clust_fts_file_name),
-                     "Communication time", "No. of threads", $logscale{'CG'},
-                     $xstart_cluster_fts,$xend_cluster_fts,$max_cluster_fts,$xtics_cluster_rts);
-
-
-  do write_gp_simple_record(GP_FILE,
-                     $pe_file_name, &dat2ps_name($pe_file_name),
-                     "Processing Elements (PEs)", "Ready Time (not running)", 
-                     $logscale{'Yp'},$xstart_pe,$xend_pe,$max_pe,$xtics_pe);
-
-  do write_gp_simple_record(GP_FILE,
-                     $sn_file_name, &dat2ps_name($sn_file_name),
-                     "Spark sites", "Pure exec. time", 
-                     $logscale{'Ys'},$xstart_sn,$xend_sn,$max_sn,$xtics_sn);
-
-  close GP_FILE;
-
-  print "Gnu plotting figures ...\n";
-  system "gnuplot $gp_file_name";
-
-  print "Extending thickness of impulses ...\n";
-  do gp_ext($gran_file_name,
-            $gran_global_file_name,
-	    $gran_local_file_name,
-	    $comm_file_name,
-	    $comm_global_file_name,
-	    $comm_local_file_name,
-	    $spark_file_name,
-	    $spark_local_file_name,
-	    $spark_global_file_name,
-	    $ha_file_name,
-	    $ft_file_name,
-	    $clust_fts_file_name,
-	    $clust_rts_file_name,
-	    $clust_has_file_name,
-            $pe_file_name,
-	    $sn_file_name
-  );
-
-
-}
-
-# ----------------------------------------------------------------------------
-
-sub gp_ext {
-    local (@file_names) = @_;
-    local ($file_name);
-    local ($ps_file_name);
-    local ($prg);
-
-    #$prg = system "which gp-ext-imp";
-    #print "  Using script $prg for impuls extension\n";
-    $prg = $ENV{GRANDIR} ? $ENV{GRANDIR} . "/bin/gp-ext-imp" 
-	                 : $ENV{HOME} . "/bin/gp-ext-imp" ;
-    if ( $opt_v ) {
-	print "    (using script $prg)\n";
-    }
-
-    foreach $file_name (@file_names) {
-	$ps_file_name = &dat2ps_name($file_name);
-        system "$prg -w $ext_size -g $gray " . 
-               $ps_file_name  . " " . 
-               $ps_file_name . "2" ;
-        system "mv " . $ps_file_name . "2 " . $ps_file_name;
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub write_gp_record {
-    local ($file,$in_file,$out_file,$xlabel,$ylabel,$logaxes,
-           $xstart,$xend,$ymax,$xtics) = @_;
-
-    if ( $xstart >= $xend ) {
-	print ("WARNING: empty xrange [$xstart:$xend] changed to [$xstart:" . $xstart+1 . "]\n")        if ( $pedantic || $opt_v );
-	$xend = $xstart + 1;	
-    }
-
-    if ( $ymax <=0 ) {
-	$ymax = 2;
-	print "WARNING: empty yrange changed to [0:$ymax]\n"   if ( $pedantic || $opt_v );
-    }
-
-    $str = "set size " . $xsize . "," . $ysize . "\n" .
-           "set xlabel \"" . $xlabel . "\"\n" .
-           "set ylabel \"" . $ylabel . "\"\n" .
-           ($xstart eq "" ? "" 
-                          : "set xrange [" . int($xstart) .":" . int($xend) . "]\n") .
-           ($ymax eq "" ? "" 
-                        : "set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) . 
-                          ":" . &list_max(2,int($ymax+$ymax/5)) . "]\n") .
-           ($xtics ne "" ? "set xtics $xtics" : "") . 
-	   "set tics out\n" .
-           "set border\n" .
-           "set title \"$nPEs PEs\"\n" .
-	   "set nokey \n" .
-           "set nozeroaxis\n" .
-	   "set format xy \"%g\"\n" .
-           (index($logaxes,"x") != -1 ? 
-               "set logscale x\n" : 
-               "set nologscale x\n") .
-           (index($logaxes,"y") != -1 ? 
-               "set logscale y\n" : 
-               "set nologscale y\n") .
-           "set output \"" . $out_file . "\"\n" .
-	   "plot \"" . $in_file . "\" with impulses\n\n";
-    print $file $str;
-}
-
-# ----------------------------------------------------------------------------
-
-sub write_gp_lines_record {
-    local ($file,$in_file,$out_file,$xlabel,$ylabel,$logaxes,
-           $xend,$yend,$xtics) = @_;
-
-    local ($str);
-
-    $str = "set xlabel \"" . $xlabel . "\"\n" .
-           "set ylabel \"" . $ylabel . "\"\n" .
-	   "set xrange [" . ( index($logaxes,"x") != -1 ? 1 : 0 ) . ":$xend]\n" .
-	   "set yrange [" . ( index($logaxes,"y") != -1 ? 1 : 0 ) . ":$yend]\n" .
-           "set border\n" .
-           "set nokey\n" .
-           ( $xtics ne "" ? "set xtics $xtics" : "" ) .
-           (index($logaxes,"x") != -1 ? 
-               "set logscale x\n" : 
-               "set nologscale x\n") .
-           (index($logaxes,"y") != -1 ? 
-               "set logscale y\n" : 
-               "set nologscale y\n") .
-           "set nozeroaxis\n" .
-	   "set format xy \"%g\"\n" .
-           "set output \"" . $out_file . "\"\n" .
-	   "plot \"" . $in_file . "\" with lines\n\n";
-    print $file $str;
-}
-
-
-# ----------------------------------------------------------------------------
-
-sub write_gp_simple_record {
-    local ($file,$in_file,$out_file,$xlabel,$ylabel,$logaxes,
-           $xstart,$xend,$ymax,$xtics) = @_;
-
-    $str = "set size " . $xsize . "," . $ysize . "\n" .
-           "set xlabel \"" . $xlabel . "\"\n" .
-           "set ylabel \"" . $ylabel . "\"\n" .
-           ($xstart eq "" ? "" 
-                          : "set xrange [" . int($xstart) .":" . int($xend) . "]\n") .
-           ($ymax eq "" ? "" 
-                        : "set yrange [" . (index($logaxes,"y") != -1 ? 1 : 0) . 
-                          ":" . &list_max(2,int($ymax+$ymax/5)) . "]\n") .
-           ($xtics ne "" ? "set xtics $xtics" : "") . 
-           "set border\n" .
-           "set nokey\n" .
-	   "set tics out\n" .
-           "set nozeroaxis\n" .
-	   "set format xy \"%g\"\n" .
-           (index($logaxes,"x") != -1 ? 
-               "set logscale x\n" : 
-               "set nologscale x\n") .
-           (index($logaxes,"y") != -1 ? 
-               "set logscale y\n" : 
-               "set nologscale y\n") .
-           "set output \"" . $out_file . "\"\n" .
-	   "plot \"" . $in_file . "\" with impulses\n\n";
-    print $file $str;
-}
-
-# ----------------------------------------------------------------------------
-
-sub dat2ps_name {
-    local ($dat_name) = @_;
-
-    $dat_name =~ s/\.dat$/\.ps/;
-    return ($dat_name);
-}
-
-# ----------------------------------------------------------------------------
-
-sub range {
-    local ($open_int, $logaxes, @ints) = @_;
-
-    local ($range, $left_margin, $right_margin);
-
-    $range = $ints[$#ints]-$ints[0];
-    $left_margin = 0; # $range/10;
-    $right_margin = 0; # $range/10;
-
-    if ( $opt_D ) {
-       print "\n==> Range: logaxes are $logaxes i.e. " . 
-	   (index($logaxes,"x") != -1 ? "matches x axis\n" 
-	                              : "DOESN'T match x axis\n"); 
-    }
-    if ( index($logaxes,"x") != -1 ) {
-	if ( $open_int == $OPEN_INT ) {
-	    return ( ($ints[0]/2-$left_margin, 
-		      $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
-	} else {
-	    return ( ( &list_max(1,$ints[0]-$left_margin), 
-		       $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
-	}
-    } else {
-	if ( $open_int == $OPEN_INT ) {
-	    return ( ($ints[0]/2-$left_margin, 
-		      $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
-	} else {
-	    return ( ($ints[0]-$left_margin, 
-		      $ints[$#ints]+($ints[$#ints]-$ints[$#ints-1])/2+$right_margin) );
-	}
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub percentify {
-    local ($sum,*classes) = @_;
-
-    for ($i=0; $i<=$#classes; $i++) {
-	$classes[$i] = (100 * $classes[$i]) / $sum;
-    }
-}
-
-# ----------------------------------------------------------------------------
-# ToDo: get these statistics functions from "stat.pl"
-# ----------------------------------------------------------------------------
-
-sub mean_std_dev {
-    local ($sum,@list) = @_;
-
-    local ($n, $s, $s_);
-
-    #print "\nmean_std_dev: sum is $sum ; list has length $#list";
-
-    $n = $#list+1;
-    $mean_value = $sum/$n;
-
-    $s_ = 0;
-    foreach $x (@list) {
-	$s_ += $x;
-        $s += ($mean_value - $x) ** 2;  
-    }
-    if ( $sum != $s_ ) {
-      print "ERROR in mean_std_dev: provided sum is wrong  " .
-            "(provided: $sum; computed: $s_)\n"; 
-      print " list_sum: " . &list_sum(@list) . "\n";
-      exit (2);
-    }
-
-    return ( ($mean_value, sqrt($s / ($n - 1)) ) );
-}
-
-# ----------------------------------------------------------------------------
-
-sub _mean_std_dev {
-    return ( &mean_std_dev(&list_sum(@_), @_) );
-}
-
-# ----------------------------------------------------------------------------
-# Compute covariance of 2 vectors, having their sums precomputed.
-# Input: $n   ... number of all elements in @list_1 as well as in @list_2
-#                 (i.e. $n = $#list_1+1 = $#list_2+1).
-#        $mean_1 ... mean value of all elements in @list_1
-#        @list_1 ... list of integers; first vector
-#        $mean_2 ... mean value of all elements in @list_2
-#        @list_2 ... list of integers; first vector
-# Output: covariance of @list_1 and @list_2 
-# ----------------------------------------------------------------------------
-
-sub cov {
-    local ($n, $mean_1, @rest) = @_;
-    local (@list_1) = splice(@rest,0,$n);
-    local ($mean_2, @list_2) = @rest;
-
-    local ($i,$s,$s_1,$s_2);
-
-    for ($i=0; $i<$n; $i++) {
-	$s_1 += $list_1[$i];
-	$s_2 += $list_2[$i];
-	$s += ($mean_1 - $list_1[$i]) * ($mean_2 - $list_2[$i]);
-    }
-    if ( $mean_1 != ($s_1/$n) ) {
-      print "ERROR in cov: provided mean value is wrong " . 
-            "(provided: $mean_1; computed: " . ($s_1/$n) . ")\n"; 
-      exit (2);
-    }
-    if ( $mean_2 != ($s_2/$n) ) {
-      print "ERROR in cov: provided mean value is wrong " .
-            "(provided: $mean_2; computed: " . ($s_2/$n) . ")\n"; 
-      exit (2);
-    }
-    return ( $s / ($n - 1) ) ;
-}
-
-# ----------------------------------------------------------------------------
-# Compute correlation of 2 vectors, having their sums precomputed.
-# Input: $n   ... number of all elements in @list_1 as well as in @list_2
-#                 (i.e. $n = $#list_1+1 = $#list_2+1).
-#        $sum_1 ... sum of all elements in @list_1
-#        @list_1 ... list of integers; first vector
-#        $sum_2 ... sum of all elements in @list_2
-#        @list_2 ... list of integers; first vector
-# Output: correlation of @list_1 and @list_2 
-# ----------------------------------------------------------------------------
-
-sub corr {
-    local ($n, $sum_1, @rest) = @_;
-    local (@list_1) = splice(@rest,0,$n);
-    local ($sum_2, @list_2) = @rest;
-       
-    local ($mean_1,$mean_2,$std_dev_1,$std_dev_2);
-
-    if ( $opt_D ) {
-      print "\ncorr: n=$n  sum_1=$sum_1  sum_2=$sum_2\n";
-      print "     list_sum of list_1=" . &list_sum(@list_1) . 
-              "   list_sum of list_2=" . &list_sum(@list_2) . "\n";
-      print "     len of list_1=$#list_1  len of list_2=$#list_2\n";
-    }
-
-    ($mean_1, $std_dev_1) = &mean_std_dev($sum_1,@list_1);
-    ($mean_2, $std_dev_2) = &mean_std_dev($sum_2,@list_2);
-
-    if ( $opt_D ) {
-      print "corr: $mean_1, $std_dev_1; $mean_2, $std_dev_2\n";
-    }
-
-    return ( ($std_dev_1 * $std_dev_2) == 0  ?
-               0 : 
-               &cov($n, $mean_1, @list_1, $mean_2, @list_2) / 
-	       ( $std_dev_1 * $std_dev_2 ) );
-}
-
-# ----------------------------------------------------------------------------
-
-sub list_sum {
-    local (@list) = @_;
-
-    local ($sum);
-
-    foreach $x (@list) {
-	$sum += $x;
-    }
-
-    return ($sum);
-}
-
-# ----------------------------------------------------------------------------
-
-sub list_max {
-    local (@list) = @_;
-
-    local ($max) = shift;
-
-    foreach $x (@list) {
-	$max = $x  if $x > $max;
-    }
-
-    return ($max);
-}
-
-# ----------------------------------------------------------------------------
-
-sub list_min {
-    local (@list) = @_;
-
-    local ($min) = shift;
-
-    foreach $x (@list) {
-	$min = $x  if $x < $min;
-    }
-
-    return ($min);
-}
-
-# ----------------------------------------------------------------------------
-
-sub guess_interval {
-    local (@list) = @_ ;
-
-    local ($min,$max,$sum,$mean,$std_dev,@intervals);
-
-    $min = &list_min(@list);
-    $max = &list_max(@list);
-    $sum = &list_sum(@list);
-    ($mean, $std_dev) = &mean_std_dev($sum,@list);
-
-    @intervals = (int($mean-$std_dev),int($mean-$std_dev/2),int($mean),
-                  int($mean+$std_dev/2),int($mean+$std_dev));
-
-    while ($#intervals>=0 && $intervals[0]<0) {
-	shift(@intervals);
-    }
-
-    return (@intervals);
-}
-
-# ----------------------------------------------------------------------------
-
-sub write_interval {
-    local ($file,$flag,@intervals) = @_;
-
-    printf $file "$flag: (" . join(", ",@intervals) . ")\n";
-}
- 
-# ----------------------------------------------------------------------------
-
-sub read_template {
-
-    if ( $opt_v ) {
-	print "Reading settings from template file $templ_file_name ...\n";
-    }
-
-    open(TEMPLATE,$templ_file_name) || die "Couldn't open file $templ_file_name";
-    while (<TEMPLATE>) {
-      next if /^\s*$/ || /^--/;
-      if (/^\s*G[:,;.\s]+([^\n]+)$/) {
-	  $list_str = $1;
-          $list_str =~ s/[\(\)\[\]]//g;
-          @exec_times = split(/[,;. ]+/, $list_str);
-      } elsif (/^\s*F[:,;.\s]+([^\n]+)$/) {
-	  $list_str = $1;
-          $list_str =~ s/[\(\)\[\]]//g;
-          @fetch_times = split(/[,;. ]+/, $list_str);
-      } elsif (/^\s*A[:,;.\s]+([^\n]+)$/) {
-	  $list_str = $1;
-          $list_str =~ s/[\(\)\[\]]//g;
-          @has = split(/[,;. ]+/, $list_str);
-      } elsif (/^\s*C[:,;.\s]+([^\n]+)$/) {
-	  $list_str = $1;
-          $list_str =~ s/[\(\)\[\]]//g;
-          @comm_percs = split(/[,;. ]+/, $list_str);
-      } elsif (/^\s*S[:,;.\s]+([^\n]+)$/) {
-	  $list_str = $1;
-          $list_str =~ s/[\(\)\[\]]//g;
-          @sparks = split(/[,;. ]+/, $list_str);
-      } elsif (/^\s*g[:,;.\s]+([\S]+)$/) {
-         ($gran_file_name,$gran_global_file_name, $gran_local_file_name) = 
-           &mk_global_local_names($1);
-      } elsif (/^\s*f[:,;.\s]+([\S]+)$/) {
-         ($ft_file_name,$ft_global_file_name, $ft_local_file_name) = 
-           &mk_global_local_names($1);
-      } elsif (/^\s*c[:,;.\s]+([\S]+)$/) {
-         ($comm_file_name, $comm_global_file_name, $comm_local_file_name) = 
-           &mk_global_local_names($1);
-      } elsif (/^\s*s[:,;.\s]+([\S]+)$/) {
-         ($spark_file_name, $spark_global_file_name, $spark_local_file_name) = 
-           &mk_global_local_names($1);
-      } elsif (/^\s*a[:,;.\s]+([\S]+)$/) {
-         ($ha_file_name, $ha_global_file_name, $ha_local_file_name) = 
-           &mk_global_local_names($1);
-      } elsif (/^\s*p[:,;.\s]+([\S]+)$/) {
-         $gp_file_name = $1;
-	 $ps_file_name = &dat2ps_name($gp_file_name);
-
-      } elsif (/^\s*Xcorr[:,;.\s]+([\S]+)$/) {
-         $corr_file_name = $1;
-      } elsif (/^\s*Xcumulat-rts[:,;.\s]+([\S]+)$/) {
-         $cumulat_rts_file_name = $1;
-      } elsif (/^\s*Xcumulat-has[:,;.\s]+([\S]+)$/) {
-         $cumulat_has_file_name = $1;
-      } elsif (/^\s*Xcumulat-fts[:,;.\s]+([\S]+)$/) {
-         $cumulat_fts_file_name = $1;
-      } elsif (/^\s*Xcumulat-cps[:,;.\s]+([\S]+)$/) {
-         $cumulat_cps_file_name = $1;
-      } elsif (/^\s*Xclust-rts[:,;.\s]+([\S]+)$/) {
-         $clust_rts_file_name = $1;
-      } elsif (/^\s*Xclust-has[:,;.\s]+([\S]+)$/) {
-         $clust_has_file_name = $1;
-      } elsif (/^\s*Xclust-fts[:,;.\s]+([\S]+)$/) {
-         $clust_fts_file_name = $1;
-      } elsif (/^\s*Xclust-cps[:,;.\s]+([\S]+)$/) {
-         $clust_cps_file_name = $1;
-      } elsif (/^\s*Xpe[:,;.\s]+([\S]+)$/) {
-         $pe_file_name = $1;
-      } elsif (/^\s*Xsn[:,;.\s]+([\S]+)$/) {
-         $sn_file_name = $1;
-
-      } elsif (/^\s*XRTS[:,;.\s]+([\S]+)$/) {
-	  $rts_file_name = $1;
-      } elsif (/^\s*XHAS[:,;.\s]+([\S]+)$/) {
-	  $has_file_name = $1;
-      } elsif (/^\s*XFTS[:,;.\s]+([\S]+)$/) {
-	  $fts_file_name = $1;
-      } elsif (/^\s*XLSPS[:,;.\s]+([\S]+)$/) {
-	  $lsps_file_name = $1;
-      } elsif (/^\s*XGSPS[:,;.\s]+([\S]+)$/) {
-	  $gsps_file_name = $1;
-      } elsif (/^\s*XCPS[:,;.\s]+([\S]+)$/) {
-	  $cps_file_name = $1;
-      } elsif (/^\s*XCCPS[:,;.\s]+([\S]+)$/) {
-	  $ccps_file_name = $1;
-
-      } elsif (/^\s*\-[:,;.\s]+([\S]+)$/) {
-         $input = $1;
-      } elsif (/^\s*L[:,;\s]+(.*)$/) {
-	 $str = $1;
-	 %logscale = ('g',"xy",'a',"xy",'Cg',"xy",'Ca',"xy",'Yp',"y",'Ys',"y") , next  if $str eq ".";
-         $str =~ s/[\(\)\[\]]//g;
-         %logscale = split(/[,;. ]+/, $str);
-      } elsif (/^\s*i[:,;.\s]+([\S]+)$/) {
-	 $gray = $1;
-      } elsif (/^\s*k[:,;.\s]+([\S]+)$/) {
-	 $no_of_clusters = $1;
-      } elsif (/^\s*e[:,;.\s]+([\S]+)$/) {
-	 $ext_size = $1;
-      } elsif (/^\s*v.*$/) {
-	 $verbose = 1;
-      } elsif (/^\s*T.*$/) {
-	 $opt_T = 1;
-      } elsif (/^\s*m.*$/) {
-	 $opt_m = 1;
-     }
-  }
-  close(TEMPLATE);
-}      
-
-# ----------------------------------------------------------------------------
-
-sub mk_global_local_names { 
-    local ($file_name) = @_;
-
-    $file_name .= ".dat" unless $file_name =~ /\.dat$/;
-    $global_file_name = $file_name; 
-    $global_file_name =~ s/\.dat/\-global\.dat/ ;
-    $local_file_name = $file_name; 
-    $local_file_name =~ s/\.dat/\-local\.dat/ ;
-
-    return ( ($file_name, $global_file_name, $local_file_name) );
-}
-
-# ----------------------------------------------------------------------------
-
-# ----------------------------------------------------------------------------
-
-sub pre_process {
-    local ($lines) = @_;
-
-    local (@all_rts, @all_comm_percs, @all_sparks, @all_local_sparks, 
-           @all_global_sparks, @all_has, @fields,
-           $line_no, $elem, $total_rt, $comm_perc,
-           $pe, $start, $end, $is_global, $bbs, $ha, $rt, $bt, $ft, 
-           $lsp, $gsp, $my);
-
-    if ( $opt_v ) {
-	print "Preprocessing file $input ... \n";
-    }
-
-    open(INPUT,"<$input") || die "Couldn't open input file $input";
-
-    do skip_header();
-
-    $line_no = 0;
-    while (<INPUT>) {
-	$line_no++;
-	last  if $line_no > $lines;
-	
-	@fields = split(/,/,$_);
-	
-	foreach $elem (@fields) {
-	    foo : {
-		$pe = $1        , last foo   if $elem =~ /^\s*PE\s+(\d+).*$/;
-		$start = $1     , last foo   if $elem =~ /^\s*ST\s+(\d+).*$/;
-		$end = $1       , last foo   if $elem =~ /^\s*END\s+(\d+).*$/;
-		$is_global = $1 , last foo   if $elem =~ /^\s*GBL\s+(T|F).*$/;
-		$bbs = $1       , last foo   if $elem =~ /^\s*BB\s+(\d+).*$/;
-		$ha = $1        , last foo   if $elem =~ /^\s*HA\s+(\d+).*$/;
-		$rt = $1        , last foo   if $elem =~ /^\s*RT\s+(\d+).*$/;
-		$bt = $1, $bc = $2 , last foo if $elem =~ /^\s*BT\s+(\d+)\s+\((\d+)\).*$/;
-		$ft = $1, $fc = $2 , last foo if $elem =~ /^\s*FT\s+(\d+)\s+\((\d+)\).*$/;
-		$lsp = $1        , last foo   if $elem =~ /^\s*LS\s+(\d+).*$/;
-		$gsp = $1        , last foo   if $elem =~ /^\s*GS\s+(\d+).*$/;
-		$my = $1        , last foo   if $elem =~ /^\s*MY\s+(T|F).*$/;
-	    }
-	}
-
-	$total_rt = $end - $start;
-	$comm_perc = ( $total_rt == 0 ? 100 : (100 * $ft)/$total_rt );
-	$sp = $lsp + $gsp;
-	
-	push(@all_rts,$rt);
-	
-	push(@all_comm_percs,$comm_perc); 
-	
-	push(@all_sparks,$sp);
-	push(@all_local_sparks,$lsp);
-	push(@all_global_sparks,$gsp);
-	
-	push(@all_has,$ha);
-    }
-
-    close(INPUT);
-
-    @exec_times = &guess_interval(@all_rts);
-    @sparks     = &guess_interval(@all_sparks);
-    @has        = &guess_interval(@all_has);
-
-    ($m,$std_dev) = &_mean_std_dev(@all_comm_percs);
-    @comm_percs = (0, int($m), int($std_dev), 100)       unless int($m) == 0;
-    @comm_percs = (0, 1, 2, 5, 10, 50, 100)              if     int($m) == 0;
-}
-
-# ----------------------------------------------------------------------------
-
-sub process_options {
-    if ( $opt_h ) {                      
-	open(ME,$0) || die "Can't open myself ($0)";
-	$n = 0;
-	while (<ME>) {
-	    last if $_ =~ /^$/;
-	    print $_;
-	    $n++;
-	}
-	close(ME);
-	
-	# system "cat $0 | awk 'BEGIN { n = 0; } \
-	#                             /^$/ { print n; \
-	#                                    exit; } \
-	#                                  { n++; }'"
-	exit ;
-    }
-
-    if ( $opt_W ) {
-	$pedantic = 1;
-    } else {
-	$pedantic = 0;
-    }
-
-    $input = $#ARGV == -1 ? "-" : $ARGV[0] ;
-    
-    if ( $#ARGV != 0 ) {
-	#print "Usage: gran-extr [options] <sim-file>\n";
-	#print "Use -h option to get details\n";
-	#exit 1;
-	
-    }
-    
-    
-    if ( ! $opt_t ) {
-	do pre_process(20);
-    }
-    
-    if ( $opt_g ) {
-	($gran_file_name, $gran_global_file_name, $gran_local_file_name) =       
-	    do mk_global_local_names($opt_g);
-    } else {
-	$gran_file_name = "gran.dat";
-	$gran_global_file_name = "gran-global.dat";
-	$gran_local_file_name = "gran-local.dat";
-    }
-    
-    if ( $opt_c ) {
-	($comm_file_name, $comm_global_file_name, $comm_local_file_name) =       
-	    do mk_global_local_names($opt_c);
-    } else {
-	$comm_file_name = "comm.dat";
-	$comm_global_file_name = "comm-global.dat";
-	$comm_local_file_name = "comm-local.dat";
-    }
-    
-    if ( $opt_f ) {
-	($ft_file_name, $ft_global_file_name, $ft_local_file_name) =       
-	    do mk_global_local_names($opt_c);
-    } else {
-	$ft_file_name = "ft.dat";
-	$ft_global_file_name = "ft-global.dat";
-	$ft_local_file_name = "ft-local.dat";
-    }
-    
-    if ( $opt_s ) {
-	($spark_file_name, $spark_global_file_name, $spark_local_file_name) =  
-	    do mk_global_local_names($opt_s);
-    } else {
-	$spark_file_name = "spark.dat";
-	$spark_global_file_name = "spark-global.dat";
-	$spark_local_file_name = "spark-local.dat";
-    }
-    
-    if ( $opt_a ) {
-	($ha_file_name, $ha_global_file_name, $ha_local_file_name) =       
-	    do mk_global_local_names($opt_a);
-    } else {
-	$ha_file_name = "ha.dat";
-    }
-    
-    if ( $opt_p ) {
-	$gp_file_name = $opt_p;
-    } else {
-	$gp_file_name = "gran.gp";
-    }
-    
-    $ps_file_name = &dat2ps_name($gp_file_name);
-    
-    $corr_file_name = "CORR";
-    $cumulat_rts_file_name = "cumulative-rts.dat";
-    $cumulat_has_file_name = "cumulative-has.dat";
-    $cumulat_fts_file_name = "cumulative-fts.dat";
-    $cumulat_cps_file_name = "cumulative-cps.dat";
-    $clust_rts_file_name = "clusters-rts.dat";
-    $clust_has_file_name = "clusters-has.dat";
-    $clust_fts_file_name = "clusters-fts.dat";
-    $clust_cps_file_name = "clusters-cps.dat";
-    $pe_file_name = "pe.dat";
-    $sn_file_name = "sn.dat";
-
-    $pie_file_name = "Pie.ps";
-
-    $cps_file_name = "CPS";
-    $fts_file_name = "FTS";
-    $rts_file_name = "RTS";
-    $has_file_name = "HAS";
-    $lsps_file_name = "LSPS";
-    $gsps_file_name = "GSPS";
-    $ccps_file_name = "CCPS";
-
-    if ( $opt_l ) {
-	$left_margin = $opt_l; 
-    } else {
-	$left_margin = 0; 
-    }
-    $left_perc_margin = 0;
-    
-    if ( $opt_r ) {
-	$right_margin = $opt_r; 
-    } else {
-	$right_margin = 0; 
-    }
-    $right_perc_margin = 0;
-    
-    if ( $opt_x ) {
-	$xsize = $opt_x;
-    } else {
-	$xsize = 1;
-    }
-    
-    if ( $opt_y ) {
-	$ysize = $opt_y;
-    } else {
-	$ysize = 1;
-    }
-    
-    if ( $opt_e ) {
-	$ext_size = $opt_e; 
-    } else {
-	$ext_size = 200; 
-    }
-    
-    if ( $opt_i ) {
-	$gray = $opt_i; 
-    } else {
-	$gray = 0; 
-    }
-    
-    if ( $opt_k ) {
-	$no_of_clusters = $opt_k; 
-    } else {
-	$no_of_clusters = 5; 
-    }
-    
-    if ( $opt_L ) {
-        $str = $opt_L;
-        $str =~ s/[\(\)\[\]]//g;
-        %logscale = split(/[,;. ]+/, $str);
-	# $logscale = $opt_L;
-    } else {
-	%logscale = ();        # ('g',"xy",'a',"xy",'Cg',"xy",'Ca',"xy");
-    }
-    
-# $delta = do compute_delta(@exec_times);
-# $no_of_exec_times = $#exec_times;
-    
-    if ( $opt_G ) {
-	$opt_G =~ s/[\(\)\[\]]//g;
-	@exec_times = split(/[,;. ]+/, $opt_G);
-	# @exec_times = split(/[,;. ]+/, ($opt_G =~ s/[\(\)]//g));
-    } else {
-	# @exec_times = (50, 100, 200, 300, 400, 500, 700);
-    }
-    
-    if ( $opt_F ) {
-	$opt_F =~ s/[\(\)\[\]]//g;
-	@fetch_times = split(/[,;. ]+/, $opt_F);
-	# @fetch_times = split(/[,;. ]+/, ($opt_F =~ s/[\(\)]//g));
-    } else {
-	# @fetch_times = (50, 100, 200, 300, 400, 500, 700);
-    }
-    
-    if ( $opt_C ) {
-	$opt_C =~ s/[\(\)\[\]]//g;
-	@comm_percs = split(/[,;. ]+/, $opt_C);
-    } else { 
-	# @comm_percs = (0,10,20,30,50,100);
-    } 
-    
-    if ( $opt_S ) {
-	$opt_S =~ s/[\(\)\[\]]//g;
-	@sparks = split(/[,;. ]+/, $opt_S);
-    } else { 
-	# @sparks = (0,5,10,50);
-    } 
-    
-# $delta_comm = do compute_delta(@comm_percs);
-    
-    if ( $opt_A ) {
-	$opt_A =~ s/[\(\)\[\]]//g;
-	@has = split(/[,;. ]+/, $opt_A);
-    } else {
-	# @has = (10, 100, 200, 300, 500, 1000);
-    }
-    
-    if ( $opt_t ) {
-	$templ_file_name = ( $opt_t eq '.' ? "TEMPL"     #   default file name
-			     : $opt_t eq ',' ? "/users/fp/hwloidl/grasp/GrAn/bin/TEMPL"     #   global master template
-			     : $opt_t eq '/' ? "/users/fp/hwloidl/grasp/GrAn/bin/T0"     #   template, that throws away most of the info
-                             : $opt_t ); 
-	do read_template();
-	# see RTS2gran for use of template-package
-    }
-    
-    $ylabel = $opt_P ? "% of threads" : "No. of threads";
-}  
-
-# ----------------------------------------------------------------------------
-
-sub print_verbose_message { 
-
-    print "-" x 70 . "\n";
-    print "Setup: \n";
-    print "-" x 70 . "\n";
-    print "\nFilenames: \n";
-    print "  Input file: $input\n";
-    print "  Gran files: $gran_file_name $gran_global_file_name $gran_local_file_name\n"; 
-    print "  Comm files: $comm_file_name $comm_global_file_name $comm_local_file_name\n";
-    print "  Sparked threads file: $spark_file_name $spark_local_file_name $spark_global_file_name\n";
-    print "  Heap file: $ha_file_name\n";
-    print "  GNUPLOT file name: $gp_file_name   Correlation file name: $corr_file_name\n";
-    print "  Cumulative RT file name: $cumulat_rts_file_name   \n  Cumulative HA file name: $cumulat_has_file_name\n";
-    print "  Cluster RT file name: $clust_rts_file_name   \n  Cluster HA file name: $clust_has_file_name\n";
-    print "  Cumulative runtimes file name:    $cumulat_rts_file_name\n";
-    print "  Cumulative heap allocations file name   $cumulat_has_file_name\n";
-    print "  Cluster run times file name:    $clust_rts_file_name\n";
-    print "  Cluster heap allocations file name:    $clust_has_file_name\n";
-    print "  PE load file name:    $pe_file_name\n";
-    print "  Site size file name:    $sn_file_name\n";
-    print "\nBoundaries: \n";
-    print "  Gran boundaries: @exec_times\n";
-    print "  Comm boundaries: @comm_percs\n";
-    print "  Sparked threads boundaries: @sparks\n";
-    print "  Heap boundaries: @has\n";
-    print "\nOther pars: \n";
-    print "  Left margin: $left_margin  Right margin: $right_margin\n";
-    print "  GP-extension: $ext_size  GP xsize: $xsize  GP ysize: $ysize\n";
-    print "  Gray scale: $gray  Smart x-tics is " . ($opt_T ? "ON" : "OFF") .
-	  "  Percentage y-axis is " . ($opt_P ? "ON" : "OFF") . "\n";
-    print "  Log. scaling assoc list: ";
-    while (($key,$value) = each %logscale) {
-        print "$key: $value, ";
-    }
-    print "\n";
-    print "  Active template file: $templ_file\n"              if $opt_t;  
-    print "-" x 70 . "\n";
-}
-
-# ----------------------------------------------------------------------------
-
-sub sort_and_cum {
-
-@sorted_rts = sort {$a <=> $b} @all_rts;
-
-($xstart_cluster_rts,$xend_cluster_rts,$max_cluster_rts,$xtics_cluster_rts) =
-  &write_cumulative_data($cumulat_rts_file_name,$clust_rts_file_name,@sorted_rts);
-
-$xend_cum_rts = pop(@sorted_rts);
-$yend_cum_rts = 100;
-$yend_cum0_rts = $#sorted_rts+1;         # unpercentified cum graph
-
-open(RTS,">$rts_file_name") || die "$rts_file_name: $!";
-print RTS "Sorted list of all runtimes:\n";
-print RTS join("\n",@sorted_rts);
-close(RTS);
-
-@sorted_has = sort {$a <=> $b} @all_has;
-
-($xstart_cluster_has,$xend_cluster_has,$max_cluster_has,$xtics_cluster_has) =
-  &write_cumulative_data($cumulat_has_file_name,$clust_has_file_name,@sorted_has);
-
-$xend_cum_has = pop(@sorted_has);
-$yend_cum_has = 100;
-$yend_cum0_has = $#sorted_has+1;         # unpercentified cum graph
-
-open(HAS,">$has_file_name") || die "$has_file_name: $!";
-print HAS "Sorted list of all heap allocations:\n";
-print HAS join("\n",@sorted_has);
-close(HAS);
-
-@sorted_lsps = sort {$a <=> $b} @all_local_sparks;
-
-open(LSPS,">$lsps_file_name") || die "$lsps_file_name: $!";
-print LSPS "Sorted list of all local sparks:\n";
-print LSPS join("\n",@sorted_lsps);
-close(LSPS);
-
-@sorted_gsps = sort {$a <=> $b} @all_global_sparks;
-
-open(GSPS,">$gsps_file_name") || die "$gsps_file_name: $!";
-print GSPS "Sorted list of all global sparks:\n";
-print GSPS join("\n",@sorted_gsps);
-close(GSPS);
-
-@sorted_fts = sort {$a <=> $b} @all_fts;
-
-($xstart_cluster_fts,$xend_cluster_fts,$max_cluster_fts,$xtics_cluster_fts) =
-  &write_cumulative_data($cumulat_fts_file_name,$clust_fts_file_name,@sorted_fts);
-
-$xend_cum_fts = pop(@sorted_fts);
-$yend_cum_fts = 100;
-$yend_cum0_fts = $#sorted_fts+1;         # unpercentified cum graph
-
-open(FTS,">$fts_file_name") || die "$FTS_file_name: $!";
-print FTS "Sorted list of all communication times:\n";
-print FTS join("\n",@sorted_fts);
-close(FTS);
-
-@sorted_comm_percs = sort {$a <=> $b} @all_comm_percs;
-
-($xstart_cluster_cps,$xend_cluster_cps,$max_cluster_cps,$xtics_cluster_cps) =
-  &write_cumulative_data($cumulat_cps_file_name,$clust_cps_file_name,@sorted_comm_percs);
-
-$xend_cum_cps = 100;  # pop(@sorted_comm_percs);
-$yend_cum_cps = 100;
-$yend_cum0_cps = $#sorted_comm_percs+1;         # unpercentified cum graph
-
-open(CCPS,">$ccps_file_name") || die "$ccps_file_name: $!";
-print CCPS "Sorted list of all communication percentages:\n";
-print CCPS join("\n",@sorted_comm_percs);
-close(CCPS);
-
-($xstart_pe,$xend_pe,$max_pe,$xtics_pe) =
-    &write_array($pe_file_name,$#pe_load,@pe_load);
-
-($xstart_sn,$xend_sn,$max_sn,$xtics_sn) =
-    &write_array($sn_file_name,$#site_size,@site_size);
-
-if ( $opt_D ) {
-  print "After write_array: xstart, xend, max _sn: $xstart_sn,$xend_sn,$max_sn,$xtics_sn\n";
-} 
-}
-
-# ----------------------------------------------------------------------------
-# Compute statistical values (like mean, std_dev and especially corr coeff).
-# Write the important info to a file.
-# ----------------------------------------------------------------------------
-
-sub do_statistics {
-    local ($n) = @_;
-
-    if ( $n <= 1 ) {
-	print "Sorry, no statistics for just $n threads\n";
-        return -1;
-    }
-
-# Compute mean values and std deviations
-# ......................................
-    
-    ($mean_rt,$std_dev_rt) = &mean_std_dev($sum_rt,@all_rts);
-    ($mean_comm_perc,$std_dev_comm_perc) = &mean_std_dev($sum_comm_perc,@all_comm_percs);
-    ($mean_spark,$std_dev_spark) = &mean_std_dev($sum_sp,@all_sparks);
-    ($mean_local_spark,$std_dev_local_spark) = &mean_std_dev($sum_local_sp,@all_local_sparks);
-    ($mean_global_spark,$std_dev_global_spark) = &mean_std_dev($sum_global_sp,@all_global_sparks);
-    ($mean_ha,$std_dev_ha) = &mean_std_dev($sum_ha,@all_has);
-    ($mean_ft,$std_dev_ft) = &mean_std_dev($sum_ft,@all_fts);
-    
-# Compute correlation coefficients
-# ................................
-    
-    $c_exec_ha = &corr($#all_rts+1,$sum_rt,@all_rts,$sum_ha,@all_has);
-    $c_exec_sp = &corr($#all_rts+1,$sum_rt,@all_rts,$sum_sp,@all_sparks);
-    $c_exec_lsp = &corr($#all_rts+1,$sum_rt,@all_rts,$sum_local_sp,@all_local_sparks);
-    $c_exec_gsp = &corr($#all_rts+1,$sum_rt,@all_rts,$sum_global_sp,@all_global_sparks);
-    $c_ha_sp   = &corr($#all_has+1,$sum_ha,@all_has,$sum_sp,@all_sparks);
-    $c_ha_lsp   = &corr($#all_has+1,$sum_ha,@all_has,$sum_local_sp,@all_local_sparks);
-    $c_ha_gsp   = &corr($#all_has+1,$sum_ha,@all_has,$sum_global_sp,@all_global_sparks);
-    $c_exec_ft = &corr($#all_rts+1,$sum_rt,@all_rts,$sum_ft,@all_fts);
-    $c_ha_ft = &corr($#all_has+1,$sum_ha,@all_has,$sum_ft,@all_fts);
-    $c_lsp_ft = &corr($#all_local_sparks+1,$sum_local_sp,@all_local_sparks,$sum_ft,@all_fts);
-    $c_gsp_ft = &corr($#all_global_sparks+1,$sum_global_sp,@all_global_sparks,$sum_ft,@all_fts);
-    
-# Write corr coeffs into a file
-# .............................
-    
-    open(CORR,">$corr_file_name") || die "Couldn't open file $corr_file_name\n";
-    #printf CORR ("%f\n%f\n%f\n%f\n%f",$c_exec_ha,$c_exec_lsp,$c_exec_gsp,$c_ha_lsp,$c_ha_gsp)   ;
-    printf CORR ("CORR of runtime and heap alloc:  %f\n",$c_exec_ha);
-    printf CORR ("CORR of runtime and no. of sparks:  %f\n",$c_exec_sp);
-    printf CORR ("CORR of heap alloc and no. sparks:  %f\n",$c_ha_sp);
-    printf CORR ("CORR of runtime and no. of local sparks:  %f\n",$c_exec_lsp);
-    printf CORR ("CORR of runtime and no. of global sparks:  %f\n",$c_exec_gsp);
-    printf CORR ("CORR of heap alloc and no. local sparks:  %f\n",$c_ha_lsp);
-    printf CORR ("CORR of heap alloc and no. global sparks:  %f\n",$c_ha_gsp);
-    printf CORR ("CORR of runtime and communication time:  %f\n",$c_exec_ft);
-    printf CORR ("CORR of heap alloc and communication time:  %f\n",$c_ha_ft);
-    printf CORR ("CORR of no. of local sparks and communication time:  %f\n",$c_lsp_ft);
-    printf CORR ("CORR of no. of global sparks and communication time:  %f\n",$c_gsp_ft);
-    close(CORR);
-
-# These are needed later in the GNUPLOT files
-# ...........................................
-
-    $max_rt_class = &list_max(@exec_class);
-    $max_rt_global_class = &list_max(@exec_global_class);
-    $max_rt_local_class = &list_max(@exec_local_class);
-    $max_comm_perc_class = &list_max(@comm_class);
-    $max_comm_perc_global_class = &list_max(@comm_global_class);
-    $max_comm_perc_local_class = &list_max(@comm_local_class);
-    $max_spark_class = &list_max(@spark_class);
-    $max_spark_local_class = &list_max(@spark_local_class);
-    $max_spark_global_class = &list_max(@spark_global_class);
-    $max_ha_class = &list_max(@ha_class);
-    $max_ft_class = &list_max(@fetch_class);
-
-}
-
-# ----------------------------------------------------------------------------
-# This is written to STDOUT at the end of the file processing (before 
-# gnuplotting and such) if the verbose option is given.
-# ----------------------------------------------------------------------------
-
-sub print_general_info {
-
-    printf("\nTotal number of lines: %d\n", $line_no);
-    
-    print "\nDistribution of execution times: \n";
-    print " Intervals: " . join('|',@exec_times) . "\n";
-    print " Total: " . join('|',@exec_class) . "\n";
-    print " Global: " . join('|',@exec_global_class) . "\n";
-    print " Local: " . join('|',@exec_local_class) . "\n";
-    
-    $total=0; foreach $i (@exec_class) { $total += $i ; }
-    $global=0; foreach $i (@exec_global_class) { $global += $i ; }
-    $local=0; foreach $i (@exec_local_class) { $local += $i ; }
-    
-    print " Sum of classes (should be " . $line_no . "): " . $total .
-	"   (global/local)=(" . $global . "/" . $local . ")\n";
-    print " Mean value: $mean_rt   Std dev: $std_dev_rt\n";
-    
-    print "\nPercentage of communication: \n";
-    print " Intervals: " . join('|',@comm_percs) . "\n";
-    print " Total: " . join('|',@comm_class) . "\n";
-    print " Global: " . join('|',@comm_global_class) . "\n";
-    print " Local: " . join('|',@comm_local_class) . "\n";
-    print " Values outside closed int: Total: " . $outside .
-	" Global: " . $outside_global . " Local: " . $outside_local . "\n";
-    
-    $total=0; foreach $i (@comm_class) { $total += $i ; }
-    $global=0; foreach $i (@comm_global_class) { $global += $i ; }
-    $local=0; foreach $i (@comm_local_class) { $local += $i ; }
-    
-    print " Sum of classes (should be " . $line_no . "): " . $total .
-	"   (global/local)=(" . $global . "/" . $local . ")\n";
-    print " Mean value: $mean_comm_perc   Std dev: $std_dev_comm_perc\n";
-    
-    print "\nSparked threads: \n";
-    print " Intervals:   " . join('|',@sparks) . "\n";
-    print " Total allocs: " . join('|',@spark_class) . "\n";
-    
-    $total=0; foreach $i (@spark_class) { $total += $i ; }
-
-    print " Sum of classes (should be " . $line_no . "): " . $total . "\n";
-    print " Mean value: $mean_spark   Std dev: $std_dev_spark\n";
-    
-    print "\nHeap Allcoations: \n";
-    print " Intervals:   " . join('|',@has) . "\n";
-    print " Total allocs: " . join('|',@ha_class) . "\n";
-    
-    $total=0; foreach $i (@ha_class) { $total += $i ; }
-    
-    print " Sum of classes (should be " . $line_no . "): " . $total . "\n";
-    print " Mean value: $mean_ha   Std dev: $std_dev_ha\n";
-    print "\n";
-    print "CORRELATION between runtimes and heap allocations: $c_exec_ha \n";
-    print "CORRELATION between runtime and no. of sparks:  $c_exec_sp \n";
-    print "CORRELATION between heap alloc and no. sparks:  $c_ha_sp \n";
-    print "CORRELATION between runtimes and locally sparked threads: $c_exec_lsp \n";
-    print "CORRELATION between runtimes and globally sparked threads: $c_exec_gsp \n";
-    print "CORRELATION between heap allocations and locally sparked threads: $c_ha_lsp \n";
-    print "CORRELATION between heap allocations and globally sparked threads: $c_ha_gsp \n";
-    print "CORRELATION between runtime and communication time:  $c_exec_ft\n";
-    print "CORRELATION between heap alloc and communication time:  $c_ha_ft\n";
-    print "CORRELATION between no. of local sparks and communication time:  $c_lsp_ft\n";
-    print "CORRELATION between no. of global sparks and communication time:  $c_gsp_ft\n";
-    print "\n";
-    
-}
-
-# ----------------------------------------------------------------------------
-# Old (obsolete) stuff
-# ----------------------------------------------------------------------------
-#
-#for ($index=0; 
-#     $index <= &list_max($#spark_local_class,$#spark_local_class); 
-#     $index++) {
-#    $spark_class[$index] = $spark_local_class[$index] + $spark_global_class[$index];
-#}
-#
-#for ($index=0, $sum_sp=0; 
-#     $index <= &list_max($#all_local_sparks,$#all_global_sparks); 
-#     $index++) {
-#    $all_sparks[$index] = $all_local_sparks[$index] + $all_global_sparks[$index];
-#    $sum_sp += $all_sparks[$index];
-#}
-#
-# ----------------------------------------------------------------------------
-#
-#sub compute_delta {
-#    local (@times) = @_;
-#
-#    return ($times[$#times] -  $times[$#times-1]);
-#}
-#
-# ----------------------------------------------------------------------------
-
-sub insert_elem {
-    local ($elem,$val,$n,*list1,*list2) = @_;
-    local (@small_part, $i, $len);
-
-    if ( $opt_D ) {
-	print "Inserting val $val (with elem $elem) in the following list: \n" .
-               @list . "\n yields the lists: \n  ";
-    }
-
-    for ($i=0; $i<=$#list2 && $list2[$i]>$val; $i++) { }
-    $len = $#list2 - $i + 1;
-    if ( $len == 0 ) {
-	push(@list1,$elem);
-	push(@list2,$val);
-    } else {
-	splice(@list1,$i,0,$elem);
-	splice(@list2,$i,0,$val);
-    }
-
-    if ( $opt_D ) {
-	print @list1 . "\n and \n" . @list2;
-    }
-
-}
-
-# ----------------------------------------------------------------------------
-
-sub skip_header {
-    local ($in_header);
-
-    $in_header = 9;
-    while (<INPUT>) {
-	if ( $in_header = 9 ) {
-	    if (/^=/) {
-		$gum_style_gr = 1;
-		$in_header = 0;
-		$prg = "????";		# 
-		$pars = "-b??????";		# 
-		$nPEs =  1; # 
-		$lat =  1;
-		return ($prg, $pars, $nPEs, $lat);
-	    } else {
-		$gum_style_gr = 0;
-		$in_header = 1;
-	    }
-	    
-	}
-	$prg = $1, $pars = $2  if /^Granularity Simulation for\s+(\w+)\s+(.*)$/;
-	$nPEs = $1	       if /^PEs\s+(\d+)/;
-	$lat = $1, $fetch = $2 if /^Latency\s+(\d+)[^F]+Fetch\s+(\d+)/;
-
-	last             if /^\+\+\+\+\+/;
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub write_pie_chart {
-    local ($rt_perc, $bt_perc, $ft_perc, $it_perc);
-    local ($title, $title_sz, $label_sz, $x_center, $y_center, $radius); 
-
-    $PieChart = "/users/fp/hwloidl/grasp/GrAn/bin/PieChart.ps";
-
-    $title = "Original Glaswegian Communication Pie (tm)";
-    $title_sz = 24;
-    $label_sz = 12;
-    $x_center = 300; 
-    $y_center = 400;
-    $radius = 100;
-
-    open(PIE,">$pie_file_name") || die "$pie_file_name: $!";
-    
-    print PIE "%!PS-Adobe-2.0\n";
-    print PIE "%%Title: Pie Chart\n";
-    print PIE "%%Creator: gran-extr\n";
-    print PIE "%%CreationDate: Ides of March 44 B.C.\n";
-    print PIE "%%EndComments\n";
-    print PIE "\n";
-    print PIE "% Def of PieChart is taken from:\n";
-    print PIE "% ($PieChart) run\n";
-    print PIE "\n";
-
-    open(PIE_CHART,"<$PieChart") || die "$PieChart: $!";
-    while (<PIE_CHART>){
-	print PIE $_;
-    }
-    close (PIE_CHART);
-    print PIE "\n";
-
-    $rt_perc = $tot_rt / $tot_total_rt;
-    $bt_perc = $tot_bt / $tot_total_rt;
-    $ft_perc = $tot_ft / $tot_total_rt;
-    $it_perc = $tot_it / $tot_total_rt;
-
-    print PIE "($title) $title_sz $label_sz  % Title, title size and label size\n" .
-	      "[                     % PS Array of (descrition, percentage [0, .., 1])\n" .
-	      "[(Run Time) $rt_perc]\n" .
-	      "[(Block Time) $bt_perc]\n" .
-	      "[(Fetch Time) $ft_perc]\n" .
-	      "[(Ready Time) $it_perc]\n" .
-	      "] $x_center $y_center $radius DrawPieChart\n";
-    print PIE "showpage\n";
-
-    close(PIE);
-}
-
-# ----------------------------------------------------------------------------
-
-sub basename {
-    local ($in_str) = @_;
-    local ($str,$i) ;
-
-    $i = rindex($in_str,"/");
-    if ($i == -1) {
-	$str = $in_str;
-    } else {
-	$str = substr($in_str,$i+1) ;
-    }
-
-    return $str;
-}
-
-# ----------------------------------------------------------------------------
-
-sub dirname {
-    local ($in_str) = @_;
-    local ($str,$i) ;
-
-    $i = rindex($in_str,"/");
-    if ($i == -1) {
-	$str = "";
-    } else {
-	$str = substr($in_str,0,$i+1) ;
-    }
-
-    return $str;
-}
-
-# ----------------------------------------------------------------------------
-
diff --git a/ghc/utils/parallel/grs2gr.pl b/ghc/utils/parallel/grs2gr.pl
deleted file mode 100644
index ab398a53d9..0000000000
--- a/ghc/utils/parallel/grs2gr.pl
+++ /dev/null
@@ -1,48 +0,0 @@
-#!/usr/local/bin/perl
-
-#
-# Convert several .gr files (from the same GUM run) into a single
-# .gr file with all times adjusted relative to the earliest start
-# time.
-#
-
-$count = 0;
-
-foreach $i (@ARGV) {
-    open(GR, $i) || die "Can't read $i\n";
-    $cmd = <GR>;
-    $dateline = <GR>;
-    $start = <GR>;
-    ($pe, $timestamp) = ($start =~ /PE\s+(\d+) \[(\d+)\]/);
-    die "PE $pe too high\n" if $pe > $#ARGV;
-    $proc[$count++] = $pe;
-    $prog[$pe] = $cmd;
-    $time[$pe] = $timestamp;
-    close(GR);
-}
-
-$basetime = 0;
-
-for($i = 0; $i < $count; $i++) {
-    $pe = $proc[$i];
-    die "PE $pe missing?\n" if !defined($time[$pe]);
-    die "Mismatched .gr files\n" if $pe > 0 && $prog[$pe] ne $prog[$pe - 1];
-    $basetime = $time[$pe] if $basetime == 0 || $basetime > $time[$pe];
-}
-
-print $cmd;
-print $dateline;
-
-for($i = 0; $i < $count; $i++) {
-    $pe = $proc[$i];
-    $delta = $time[$pe] - $basetime;
-    open(GR, $ARGV[$i]) || die "Can't read $ARGV[i]\n";
-    $cmd = <GR>;
-    $dateline = <GR>;
-    $start = <GR>;
-    while(<GR>) {
-        /PE\s+(\d+) \[(\d+)\]/;
-	printf "PE %2u [%lu]%s", $1, $2 + $delta, $';
-    }
-    close(GR);
-}
diff --git a/ghc/utils/parallel/par-aux.pl b/ghc/utils/parallel/par-aux.pl
deleted file mode 100644
index 8484057aab..0000000000
--- a/ghc/utils/parallel/par-aux.pl
+++ /dev/null
@@ -1,89 +0,0 @@
-#!/usr/local/bin/perl
-##############################################################################
-# Time-stamp: <Sat Oct 28 1995 22:41:09 Stardate: [-31]6509.51 hwloidl>
-#
-# Usage: do ...
-#
-# Various auxiliary Perl subroutines that are mainly used in gran-extr and
-# RTS2gran. 
-# This module contains the following `exported' routines:
-#  - mk_global_local_names
-#  - dat2ps_name
-# The following routines should be local:
-#  - basename
-#  - dirname
-#
-##############################################################################
-
-# ----------------------------------------------------------------------------
-# Usage:   do mk_global_local_names (<file_name>);
-# Returns: (<file_name>,<local_file_name>, <global_file_name>)
-#
-# Take a filename and create names for local and global variants.
-# E.g.: foo.dat -> foo-local.dat and foo-global.dat
-# ----------------------------------------------------------------------------
-
-sub mk_global_local_names { 
-    local ($file_name) = @_;
-
-    $file_name .= ".dat" unless $file_name =~ /\.dat$/;
-    $global_file_name = $file_name; 
-    $global_file_name =~ s/\.dat/\-global\.dat/ ;
-    $local_file_name = $file_name; 
-    $local_file_name =~ s/\.dat/\-local\.dat/ ;
-
-    return ( ($file_name, $global_file_name, $local_file_name) );
-}
-
-
-# ----------------------------------------------------------------------------
-# Usage:   do dat2ps(<dat_file_name>);
-# Returns: (<ps_file_name>);
-# ----------------------------------------------------------------------------
-
-sub dat2ps_name {
-    local ($dat_name) = @_;
-
-    $dat_name =~ s/\.dat$/\.ps/;
-    return ($dat_name);
-}
-
-# ----------------------------------------------------------------------------
-# ----------------------------------------------------------------------------
-
-sub basename {
-    local ($in_str) = @_;
-    local ($str,$i) ;
-
-    $i = rindex($in_str,"/");
-    if ($i == -1) {
-	$str = $in_str;
-    } else {
-	$str = substr($in_str,$i+1) ;
-    }
-
-    return $str;
-}
-
-# ----------------------------------------------------------------------------
-
-sub dirname {
-    local ($in_str) = @_;
-    local ($str,$i) ;
-
-    $i = rindex($in_str,"/");
-    if ($i == -1) {
-	$str = "";
-    } else {
-	$str = substr($in_str,0,$i+1) ;
-    }
-
-    return $str;
-}
-
-# ----------------------------------------------------------------------------
-
-
-# ----------------------------------------------------------------------------
-
-1; 
diff --git a/ghc/utils/parallel/ps-scale-y.pl b/ghc/utils/parallel/ps-scale-y.pl
deleted file mode 100644
index 0e1242081c..0000000000
--- a/ghc/utils/parallel/ps-scale-y.pl
+++ /dev/null
@@ -1,188 +0,0 @@
-#!/usr/local/bin/perl
-##############################################################################
-# Time-stamp: <Wed Jul 24 1996 22:19:02 Stardate: [-31]7859.44 hwloidl>
-#
-# Usage: ps-scale-y [options] <file>
-#
-# It is assumed that the last line of <file> is of the format:
-#			     %% y_scaling: <f> max: <n>
-# where <f> is a floating point number determining the amount of scaling of 
-# the y-axis of the graph that is necessary. <n> is the real maximal number
-# of tasks in the program (needed to rebuild y-axis). This script replaces the 
-# definitions of the PostScript functions scale-y and unscale-y in <file> by 
-# new definitions that do the right amount of scaling. 
-# The y-axis is rebuilt (using the above maximal number of tasks and a copy 
-# of the print_y_axis routine from qp2ps).
-# If the above line doesn't exist, <file> is unchanged.
-# This script is typically called from gr2ps.
-#
-##############################################################################
-
-require "getopts.pl";
-
-&Getopts('hv');  
-
-do process_options();
-
-$tmpfile = ",t";
-$debug = 0;
-
-# NB: This must be the same as in qp2ps!!
-
-$xmin = 100;
-$xmax = 790;
-
-$scalex = $xmin;
-$labelx = $scalex - 45;
-$markx =  $scalex - 30;
-$major = $scalex - 5;
-$majorticks = 10;
-
-$mmax = 1;
-
-$amax = 0;
-$ymin = 50;
-$ymax = 500;
-
-# E
-open (GET_SCALING,"cat $file | tail -1 |") || die "Can't open pipe:  $file | tail -1 |\n";
-
-$y_scaling = 1.0;
-
-while (<GET_SCALING>){
-    # print STDERR $_;
-    if (/^\%\%\s+y_scaling:\s+([0-9\.]+)\s+max:\s+(\d+)/) {
-	$y_scaling = $1;
-	$pmax = $2;
-	$y_translate = 1.0 - $y_scaling;
-    }
-}
-close (GET_SCALING);
-
-if ( $y_scaling != 1.0 ) {
-    print STDERR "Scaling $file ($y_scaling; $pmax tasks) ...\n" if $opt_v;
-    # print STDERR "SCALING NECESSARY: y_scaling = $y_scaling; y_translate = $y_translate !\n";
-} else {
-    # No scaling necessary!!
-    exit 0;
-}
-
-
-open (IN,"<$file") || die "Can't open file $file\n";
-open (OUT,">$tmpfile") || die "Can't open file $tmpfile\n";
-
-$skip = 0;
-while (<IN>) {
-    $skip = 0 if $skip && /^% End Y-Axis.$/;
-    next if $skip;
-    if (/\/scale\-y/) { 
-	print OUT "/scale-y { gsave\n" .
-	          "           0 50 $y_translate mul translate\n" .
-		  "           1 $y_scaling scale } def\n";
-    }
-    elsif (/\/unscale\-y/) {  
-	print OUT "/unscale-y { grestore } def \n";
-    } else {
-	print OUT $_;
-    }
-    if (/^% Y-Axis:$/) {
-	$skip = 1;
-	do print_y_axis();
-    }
-}
-
-close (IN);
-close (OUT);
-
-rename($tmpfile,$file);
-
-exit 0;
-
-# ###########################################################################
-# Same as in qp2ps (but printing to OUT)!
-# ###########################################################################
-
-sub print_y_axis {
-    local ($i);
-    local ($y, $smax,$majormax, $majorint);
-
-# Y-axis label
-
-    print OUT  "% " . ("-" x 75) . "\n";
-    print OUT  "% Y-Axis (scaled):\n";
-    print OUT  "% " . ("-" x 75) . "\n";
-
-    print OUT ("%scale-y  % y-axis outside scaled area if ps-scale-y rebuilds it!\n");
-
-    print OUT ("gsave\n");
-    print OUT ("HE12 setfont\n");
-    print OUT ("(tasks)\n");
-    print OUT ("dup stringwidth pop\n");
-    print OUT ("$ymax\n");
-    print OUT ("exch sub\n");
-    print OUT ("$labelx exch\n");
-    print OUT ("translate\n");
-    print OUT ("90 rotate\n");
-    print OUT ("0 0 moveto\n");
-    print OUT ("show\n");
-    print OUT ("grestore\n");
-
-# Scale
-
-    if ($pmax < $majorticks) {
-	$majorticks = $pmax;
-    }
-
-    print OUT ("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n");
-    print OUT ("% Max number of tasks: $pmax\n");
-    print OUT ("% Number of ticks: $majorticks\n");
-
-    print OUT  "0.5 setlinewidth\n";
-
-    $y = $ymax; # (($pmax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
-    print OUT ("$scalex $y moveto\n$major $y lineto\n");
-    print OUT ("$markx $y moveto\n($pmax) show\n");
-
-    $majormax = int($pmax/$majorticks)*$majorticks;
-    $smax = $majormax*(($ymax-$ymin)/$pmax)+$ymin;
-    $majorint = $majormax/$majorticks;
-
-    for($i=1; $i <= $majorticks; ++$i) {
-	$y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
-	$majorval = int($majorint * ($majormax/$majorint-$i));
-	print OUT ("$scalex $y moveto\n$major $y lineto\n");
-	print OUT ("$markx $y moveto\n($majorval) show\n");
-    }
-
-    # print OUT ("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n");
-    print OUT  " stroke\n";
-    print OUT  "1 setlinewidth\n";
-    print OUT ("%unscale-y\n");
-    print OUT ("% End Y-Axis (scaled).\n");
-    print OUT "% " . ("-" x 75) . "\n";
-}
-
-# ----------------------------------------------------------------------------
-
-sub process_options {
-
-    if ( $opt_h ) {                      
-	open(ME,$0) || die "Can't open myself ($0): $!\n";
-	$n = 0;
-	while (<ME>) {
-	    last if $_ =~ /^$/;
-	    print $_;
-	    $n++;
-	}
-	close(ME);
-	exit ;
-    }
-    
-    if ( $#ARGV != 0 ) {
-	print "Usage: $0 [options] <file>\n";
-	print "Use -h option to get details\n";
-	exit 1;
-    }
-
-    $file = $ARGV[0];
-}
diff --git a/ghc/utils/parallel/qp2ap.pl b/ghc/utils/parallel/qp2ap.pl
deleted file mode 100644
index b3c3bcf122..0000000000
--- a/ghc/utils/parallel/qp2ap.pl
+++ /dev/null
@@ -1,495 +0,0 @@
-#! /usr/local/bin/perl
-##############################################################################
-# Time-stamp: <Wed Jul 24 1996 22:05:31 Stardate: [-31]7859.39 hwloidl>
-#
-# Usage: qp2ap [options] <max-x> <max-y> <prg> <date>
-#
-# Filter that transforms a quasi-parallel profile (a .qp file) at stdin to  
-# a PostScript file at stdout, showing an activity profile with one horizontal
-# line for each task (thickness of the line shows if it's active or suspended).
-#
-# Options:
-#  -o <file> ... write .ps file to <file>
-#  -m        ... create mono PostScript file instead a color one.
-#  -O        ... optimise i.e. try to minimise the size of the .ps file.
-#  -s <n>    ... scaling factor of y axis (default: 1)
-#  -w <n>    ... width of lines denoting running threads (default: 2) 
-#  -v        ... be talkative. 
-#  -h        ... print help message (this header).
-#
-##############################################################################
-
-
-require "getopts.pl";
-
-&Getopts('hvms:w:OlD');  
-
-do process_options();
-
-if ( $opt_v ) {
-    do print_verbose_message();
-}
-
-# ---------------------------------------------------------------------------
-# Init
-# ---------------------------------------------------------------------------
-
-$y_scaling = 0;
-$gtid = 1;               # number of process so far = $gtid-1
-
-$xmin = 100;
-$xmax = 790;
-
-$scalex = $xmin;
-$labelx = $scalex - 45;
-$markx =  $scalex - 30;
-$major = $scalex - 5;
-$majorticks = 10;
-
-# $pmax = 40;
-$ymin = 50;
-$ymax = 500;
-
-if ( ($ymax - $ymin)/$pmax < 3 ) {
-    print STDERR "Warning: Too many tasks! Distance will be smaller than 3 pixels.\n";
-}
-
-if ( !$width ) { 
-    $width = 2/3 * ($ymax - $ymin)/$pmax;
-}
-
-do write_prolog();
-do print_y_axis();
-
-# ---------------------------------------------------------------------------
-# Main Part
-# ---------------------------------------------------------------------------
-
-while(<STDIN>) {
-    next if /^[^0-9]/;   # ignore lines not beginning with a digit (esp. last)
-    chop;
-    ($time, $event, $tid, $addr, $tid2, $addr2) = split;
-
-    if ( $event eq "*G") {
-    	    $TID{$addr} = $gtid++;
-	    $START{$addr} = $time;
-    }
-
-    elsif ($event eq "*A") {
-    	    $TID{$addr} = $gtid++;
-	    $SUSPEND{$addr} = $time;
-    }
-
-    elsif ($event eq "G*" || $event eq "GR" ) {
-	do psout($START{$addr},$time,$TID{$addr},"runlineto");
-#	$STOP{$addr} = $time;
-    }
-
-    elsif ($event eq "GA" || $event eq "GC" || $event eq "GY") {
-	do psout($START{$addr},$time,$TID{$addr},"runlineto");
-	$SUSPEND{$addr} = $time;
-    }
-	
-    elsif ($event eq "RA") {
-	$SUSPEND{$addr} = $time;
-    }
-
-    elsif ($event eq "YR") {
-	do psout($SUSPEND{$addr},$time,$TID{$addr},"fetchlineto");
-    }
-
-    elsif ($event eq "CA" || $event eq "YA" ) {
-	do psout($SUSPEND{$addr},$time,$TID{$addr},"fetchlineto");
-	$SUSPEND{$addr} = $time;
-    }
-
-    elsif ($event eq "AC" || $event eq "AY" ) {
-	do psout($SUSPEND{$addr},$time,$TID{$addr},"suspendlineto");
-	$SUSPEND{$addr} = $time;
-    }
-
-    elsif ($event eq "RG") {
-	$START{$addr} = $time;
-    }
-
-    elsif ($event eq "AG") {
-	do psout($SUSPEND{$addr},$time,$TID{$addr},"suspendlineto");
-	$START{$addr} = $time;
-    } 
-
-    elsif ($event eq "CG" || $event eq "YG" ) {
-	do psout($SUSPEND{$addr},$time,$TID{$addr},"fetchlineto");
-	$START{$addr} = $time;
-    } elsif ( $event eq "B*" || $event eq "*B" || $event eq "BB" ) {
-	print STDERR "Ignoring spark event $event at $time\n"  if $opt_v;
-    } else {
-	print STDERR "Unexpected event $event at $time\n";
-    }
-
-    print("%% $time: $event $addr $TID{$addr}\n\n")  if $opt_D;
-}
-
-# ---------------------------------------------------------------------------
-
-# Logo
-print("HE14 setfont\n");
-if ( $opt_m ) {
-    print("50 550 asciilogo\n");                     
-} else {
-    print("50 550 logo\n");                          #
-}
-
-# Epilogue
-print("showpage\n");
-
-if ( $gtid-1 != $pmax ) {
-    if ( $pedantic ) {
-	die "Error: Calculated max no. of tasks ($gtid-1) does not agree with stated max. no. of tasks ($pmax)\n";
-    } else {
-	print STDERR  "Warning: Calculated total no. of tasks ($gtid-1) does not agree with stated total no. of tasks ($pmax)\n" if $opt_v;
-	$y_scaling = $pmax/($gtid-1); 
-    }
-}
-
-
-exit 0;
-
-# ---------------------------------------------------------------------------
-
-sub psout {
-    local($x1, $x2, $y, $cmd) = @_;
-    print("% ($x1,$y) -- ($x2,$y) $cmd\n")  if $opt_D;
-    $x1 = int(($x1/$tmax) * ($xmax-$xmin) + $xmin);
-    $x2 = int(($x2/$tmax) * ($xmax-$xmin) + $xmin);
-    $y = int(($y/$pmax) * ($ymax-$ymin) + $ymin);
-    if ( $x1 == $x2 ) {
-	$x2 = $x1 + 1;
-    }
-    
-    if ( $opt_l ) {
-	print("newpath\n");
-	print("$x1 $y moveto\n");
-	print("$x2 $y $cmd\n");
-	print("stroke\n");
-    } elsif ( $opt_O ) {
-	print "$x1 $x2 $y " .
-	    ( $cmd eq "runlineto" ? "G RL\n" :
-	      $cmd eq "suspendlineto" ? "R SL\n" :
-	      $cmd eq "fetchlineto" ? "B FL\n" :
-	      "\n% ERROR: Unknown command $cmd\n");
-
-    } else {
-	print "$x2 $y $x1 $y " . 
-	    ( $cmd eq "runlineto" ? "green run\n" :
-	      $cmd eq "suspendlineto" ? "red suspend\n" :
-	      $cmd eq "fetchlineto" ? "blue fetch\n" :
-	      "\n% ERROR: Unknown command $cmd\n");
-    }	    
-}
-
-# -----------------------------------------------------------------------------
-
-sub get_date {
-    local ($date);
-
-    chop($date = `date`);
-    return ($date);
-}
-
-# -----------------------------------------------------------------------------
-
-sub write_prolog {
-    local ($now);
-
-    $now = do get_date();
-
-    print("%!PS-Adobe-2.0\n");
-    print("%%BoundingBox:    0 0 560 800\n");
-    print("%%Title:          Per-thread Activity Profile\n");
-    print("%%Creator:        qp2ap\n");
-    print("%%StartTime:      $date\n");
-    print("%%CreationDate:   $now\n");
-    print("%%Copyright:      1995, 1996 by Hans-Wolfgang Loidl, University of Glasgow\n");
-    print("%%EndComments\n");
-
-    print "% " . "-" x 77 . "\n";
-    print "% Tunable Parameters:\n";
-    print "% The width of a line representing a task\n";
-    print "/width $width def\n";
-    print "% Scaling factor for the y-axis (usful to enlarge)\n";
-    print "/y-scale $y_scale def\n";
-    print "% " . "-" x 77 . "\n";
-
-    print "/total-len $tmax def\n";
-    print "/show-len $xmax def\n";
-    print "/x-offset $xmin def\n";
-    print "/y-offset $ymin def\n";
-    print "% normalize is the PS version of the formula: \n" .
-	  "%   int(($x1/$tmax) * ($xmax-$xmin) + $xmin) \n" .
-	  "% in psout.\n";
-    print "/normalize { total-len div show-len x-offset sub mul x-offset add floor } def\n";
-    print "/x-normalize { exch show-len mul total-len div exch } def\n";
-    print "/y-normalize { y-offset sub y-scale mul y-offset add } def\n";
-    print "/str-len 12 def\n";
-    print "/prt-n { cvi str-len string cvs \n" .
-          "         dup stringwidth pop \n" .
-	  "         currentpoint pop 780 gt { 10 sub } { 2 div } ifelse \n" .
-          "         neg 0 rmoveto \n" . 
-          "         show  } def \n" .
-	  "        % print top-of-stack integer centered at the current point\n";
-    # print "/prt-n { cvi str-len string cvs \n" .
-    #       "         dup stringwidth pop 2 div neg 0 rmoveto \n" . 
-    #       "         show  } def \n" .
-    #	    "        % print top-of-stack integer centered at the current point\n";
-
-    if ( $opt_l ) {
-	print ("/runlineto {1.5 setlinewidth lineto} def\n");
-	print ("/suspendlineto {0.5 setlinewidth lineto} def\n");
-	print ("/fetchlineto {0.2 setlinewidth lineto} def\n");
-    } else {
-	    if ( $opt_m ) {
-		if ( $opt_O ) {
-		    print  "/R { 0 } def\n";
-		    print  "/G { 0.5 } def\n";
-		    print  "/B { 0.2 } def\n";
-		} else {
-		    print  "/red { 0 } def\n";
-		    print  "/green { 0.5 } def\n";
-		    print  "/blue { 0.2 } def\n";
-		}
-		print  "/set-bg { setgray } def\n";
-	    } else {
-		if ( $opt_O ) {
-		    print  "/R { 0.8 0 0 } def\n";
-		    print  "/G { 0 0.9 0.1 } def\n";
-		    print  "/B { 0 0.1 0.9 } def\n";
-		    print  "/set-bg { setrgbcolor } def\n";
-		} else {
-		    print  "/red { 0.8 0 0 } def\n";
-		    print  "/green { 0 0.9 0.1 } def\n";
-		    print  "/blue { 0 0.1 0.9 } def\n";
-		    print  "/set-bg { setrgbcolor } def\n";
-		}
-	    }
-
-	    if ( $opt_O ) {
-		print "% RL: runlineto; draws a horizontal line in given color\n";
-		print "% Operands: x-from x-to y color\n";
-		print "/RL { set-bg   % set color \n" .
-		      "      newpath y-normalize  % mangle y val\n" .
-		      "      2 index 1 index moveto width setlinewidth \n" .
-		      "      lineto pop stroke} def\n";
-		print "% SL: suspendlineto; draws a horizontal line in given color (thinner)\n";
-		print "% Operands: x-from x-to y color\n";
-		print "/SL { set-bg   % set color \n" .
-		      "      newpath y-normalize  % mangle y val\n" .
-		      "      2 index 1 index moveto width 2 div setlinewidth \n" .
-		      "      lineto pop stroke} def\n";
-		print "% FL: fetchlineto; draws a horizontal line in given color (thinner)\n";
-		print "% Operands: x-from x-to y color\n";
-		print "/FL { set-bg   % set color \n" .
-		      "      newpath y-normalize  % mangle y val\n" .
-		      "      2 index 1 index moveto width " . 
-			  ( $opt_m ? " 4 " : " 2 ") . 
-		      " div setlinewidth \n" .
-		      "      lineto pop stroke} def\n";
-	    } else {
-		print "/run { set-bg newpath 50 sub y-scale mul 50 add moveto width " .
-		    "setlinewidth 50 sub y-scale mul 50 add lineto stroke} def\n";
-		print "/suspend { set-bg newpath 50 sub y-scale mul 50 add moveto width " .
-		    "2 div setlinewidth 50 sub y-scale mul 50 add lineto stroke} def\n";
-		print "/fetch { set-bg newpath 50 sub y-scale mul 50 add moveto width " .
-		    ( $opt_m ? " 4 " : " 2 ") .
-			"div setlinewidth 50 sub y-scale mul 50 add lineto stroke} def\n";
-		#print ("/run { newpath moveto 1.5 setlinewidth lineto stroke} def\n");
-		#print ("/suspend { newpath moveto 0.5 setlinewidth lineto stroke} def\n");
-	    }
-	}
-
-    print  "/printText { 0 0 moveto (GrAnSim) show } def\n";      
-    print "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
-    if ( $opt_m ) {
-	print "/logo { asciilogo } def\n";
-    } else {
-	print "/logo { gsave \n" .
-	    "        translate \n" .
-		"        .95 -.05 0\n" .
-		    "          { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" . 
-			"        1 0 0 setrgbcolor printText\n" . 
-			    "        grestore} def\n";
-    }
-    print "% For debugging PS uncomment this line and add the file behandler.ps\n";
-    print "% $brkpage begin printonly endprint \n";
-
-    print("/HE10 /Helvetica findfont 10 scalefont def\n");
-    print("/HE12 /Helvetica findfont 12 scalefont def\n");
-    print("/HE14 /Helvetica findfont 14 scalefont def\n");
-    print("/HB16 /Helvetica-Bold findfont 16 scalefont def\n");
-    print "% " . "-" x 77 . "\n";
-    print("newpath\n");
-
-    print("-90 rotate\n");
-    print("-785 30 translate\n");
-    print("0 8.000000 moveto\n");
-    print("0 525.000000 760.000000 525.000000 8.000000 arcto\n");
-    print("4 {pop} repeat\n");
-    print("760.000000 525.000000 760.000000 0 8.000000 arcto\n");
-    print("4 {pop} repeat\n");
-    print("760.000000 0 0 0 8.000000 arcto\n");
-    print("4 {pop} repeat\n");
-    print("0 0 0 525.000000 8.000000 arcto\n");
-    print("4 {pop} repeat\n");
-    print("0.500000 setlinewidth\n");
-    print("stroke\n");
-    print("newpath\n");
-    print("4.000000 505.000000 moveto\n");
-    print("4.000000 521.000000 752.000000 521.000000 4.000000 arcto\n");
-    print("4 {pop} repeat\n");
-    print("752.000000 521.000000 752.000000 501.000000 4.000000 arcto\n");
-    print("4 {pop} repeat\n");
-    print("752.000000 501.000000 4.000000 501.000000 4.000000 arcto\n");
-    print("4 {pop} repeat\n");
-    print("4.000000 501.000000 4.000000 521.000000 4.000000 arcto\n");
-    print("4 {pop} repeat\n");
-    print("0.500000 setlinewidth\n");
-    print("stroke\n");
-
-    print("HE14 setfont\n");
-    print("100 505 moveto\n");
-    print("($pname ) show\n");
-    
-    print("($date) dup stringwidth pop 750 exch sub 505.000000 moveto show\n");
-    
-    # print "/total-len $tmax def\n";
-    print("-40 -40 translate\n");
-
-    print "% " . "-" x 77 . "\n";
-    print "% Print x-axis:\n";
-    print "/y-val $ymin def % { y-offset 40 sub 2 div y-offset add } def\n";
-    print "0.5 setlinewidth\n";
-    print "x-offset y-val moveto total-len normalize x-offset sub 0 rlineto stroke\n";
-    print "0 total-len 10 div total-len\n" .
-          " { dup normalize dup y-val moveto 0 -2 rlineto stroke  % tic\n" .
-          "   y-val 10 sub moveto HE10 setfont round prt-n  % print label \n" .
-	  " } for \n";
-    print "1 setlinewidth\n";
-    print "% " . "-" x 77 . "\n";
-
-}
-
-# -----------------------------------------------------------------------------
-
-sub print_y_axis {
-    local ($i);
-    local ($y, $smax,$majormax, $majorint);
-
-# Y-axis label
-
-    print "% " . ("-" x 75) . "\n";
-    print "% Y-Axis:\n";
-    print "% " . ("-" x 75) . "\n";
-
-    if ( $opt_m ) {
-	print "0 setgray\n";
-    } else {
-	print "0 0 0 setrgbcolor\n";
-    }
-
-    print("gsave\n");
-    print("HE12 setfont\n");
-    print("(tasks)\n");
-    print("dup stringwidth pop\n");
-    print("$ymax\n");
-    print("exch sub\n");
-    print("$labelx exch\n");
-    print("translate\n");
-    print("90 rotate\n");
-    print("0 0 moveto\n");
-    print("show\n");
-    print("grestore\n");
-
-# Scale
-
-    if ($pmax < $majorticks) {
-	$majorticks = $pmax;
-    }
-
-    print "0.5 setlinewidth\n";
-
-    print("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n");
-    print("% Total number of tasks: $pmax\n");
-    print("% Number of ticks: $majorticks\n");
-
-    $y = $ymax; # (($pmax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
-    print("$scalex $y moveto\n$major $y lineto\n");
-    print("$markx $y moveto\n($pmax) show\n");
-
-    $majormax = int($pmax/$majorticks)*$majorticks;
-    $smax = $majormax*(($ymax-$ymin)/$pmax)+$ymin;
-    $majorint = $majormax/$majorticks;
-
-    for($i=0; $i <= $majorticks; ++$i) {
-	$y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
-	$majorval = int($majorint * ($majormax/$majorint-$i));
-	print("$scalex $y moveto\n$major $y lineto\n");
-	print("$markx $y moveto\n($majorval) show\n");
-    }
-
-    # print("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n");
-    print " stroke\n";
-    print "1 setlinewidth\n";
-    print "% " . ("-" x 75) . "\n";
-}
-
-# ---------------------------------------------------------------------------
-
-sub print_verbose_message {
-
-    print "Prg Name: $pname  Date: $date\n";
-    print "Input: stdin  Output: stdout\n";
-}
-
-# ----------------------------------------------------------------------------
-
-sub process_options {
-
-     if ( $opt_h ) {                      
-	open(ME,$0) || die "Can't open myself ($0): $!\n";
-	$n = 0;
-	while (<ME>) {
-	    last if $_ =~ /^$/;
-	    print $_;
-	    $n++;
-	}
-	close(ME);
-	exit ;
-    }
-    
-     if ( $opt_s ) {                      
-	 $y_scale = $opt_s;
-     } else {
-	 $y_scale = 1; 
-     }
-
-    if ( $#ARGV != 3 ) {
-	print "Usage: $0 [options] <max x value> <max y value> <prg name> <date> \n";
-	print "Use -h option to get details\n";
-	exit 1;
-    }
-
-    $tmax = $ARGV[0];
-    $pmax = $ARGV[1];
-    # GUM uses the absolute path (with '=' instead of '/') of the executed file
-    # (for PVM reasons); if you want to have the full path in the generated
-    # graph, too, eliminate the substitution below
-    ($pname = $ARGV[2]) =~ s/.*=//;
-    $date = $ARGV[3];
-
-     if ( $opt_w ) {
-	 $width = $opt_w;
-     } else {
-	 $width = 0;
-     }
-
-}
-# -----------------------------------------------------------------------------
diff --git a/ghc/utils/parallel/qp2ps.pl b/ghc/utils/parallel/qp2ps.pl
deleted file mode 100644
index 2fb090346a..0000000000
--- a/ghc/utils/parallel/qp2ps.pl
+++ /dev/null
@@ -1,988 +0,0 @@
-#! /usr/local/bin/perl
-##############################################################################
-# Time-stamp: <Wed Jul 24 1996 22:04:50 Stardate: [-31]7859.39 hwloidl>
-#
-# Usage: qp2ps [options] <max-x> <max-y> <prg> <date>
-#
-# Filter that transforms a quasi-parallel profile (a .qp file) at stdin to  
-# a PostScript file at stdout, showing essentially the total number of running,
-# runnable and blocked tasks.
-#
-# Options:
-#  -o <file> ... write .ps file to <file>
-#  -m        ... create mono PostScript file instead a color one.
-#  -O        ... compress i.e. try to minimize the size of the .ps file
-#  -s <str>  ... print <str> in the top right corner of the generated graph
-#  -i <int>  ... info level from 1 to 7; number of queues to display
-#  -I <str>  ... queues to be displayed (in the given order) with the encoding
-#                 'a' ... active (running)
-#                 'r' ... runnable
-#                 'b' ... blocked
-#                 'f' ... fetching
-#                 'm' ... migrating
-#                 's' ... sparks
-#                (e.g. -I "arb" shows active, runnable, blocked tasks)
-#  -l <int>  ... length of a slice in the .ps file; (default: 100)
-#                small value => less memory consumption of .ps file & script
-#                but slower in generating the .ps file
-#  -d        ... Print date instead of average parallelism
-#  -v        ... be talkative. 
-#  -h        ... print help message (this header).
-#
-##############################################################################
-
-require "getopts.pl";
-
-&Getopts('hvDCOmdl:s:i:I:H');  
-
-do process_options();
-
-if ( $opt_v ) {
-    do print_verbose_message();
-}
-
-# ---------------------------------------------------------------------------
-# Init
-# ---------------------------------------------------------------------------
-
-$y_scaling = 1.0;
-
-$xmin = 100;
-$xmax = 790;
-
-$scalex = $xmin;
-$labelx = $scalex - 45;
-$markx =  $scalex - 30;
-$major = $scalex - 5;
-$majorticks = 10;
-
-$mmax = 1;
-
-$amax = 0;
-$ymin = 50;
-$ymax = 500;
-
-$active = 0;
-$runnable = 0;
-$blocked = 0;
-$fetching = 0;
-$migrating = 0;
-$sparks = 0;
-
-#$lines_per_flush = 100;            # depends on the PS implementation you use
-
-%color = ( "a", "green",	# active
-	   "r", "amber",        # runnable
-	   "b", "red",          # blocked
-	   "f", "cyan",		# fetching
-	   "m", "blue",         # migrating
-	   "s", "crimson" );    # sparks
-
-# ---------------------------------------------------------------------------
-
-do print_prolog();
-
-$otime = -1;
-$time_of_second_event = 0;
-$samples = 0; 
-
-$T[0] = 0; 
-$G[0] = 0; 
-$A[0] = 0; 
-$R[0] = 0; 
-$B[0] = 0;
-$Y[0] = 0;
-
-while(<STDIN>) {
-    next if /^[^0-9]/;   # ignore lines not beginning with a digit (esp. last)
-    chop;
-    ($time, $event, $tid, $addr, $tid2, $addr2) = split;
-    $time_of_second_event = $time         if $time_of_second_event == 0;
-
-    if($time != $otime) {
-	$tottime += $G[$samples] * ($time-$T[$samples]);
-	$otime = $time;
-    }
-
-    if($active > $amax) {
-	$amax = $active;
-    }
-
-    if ( $opt_D ) {
-	if($G[$samples] < $amax && $A[$samples] > 0) {
-	    printf(stderr "%% $otime: G $G[$samples], A $A[$samples], " . 
-		   "R $R[$samples], B $B[$samples], " .
-		   "Y $Y[$samples]\n");
-	}
-    }
-
-    # Reality Check
-    if($G[$samples] < 0 || $A[$samples] < 0 || 
-       $R[$samples] < 0 || $B[$samples] < 0 ||
-       $Y[$samples] < 0) {
-	printf(stderr "Error: Impossible number of tasks at time " .
-	       "$T[$samples] (G $G[$samples], A $A[$samples], ".
-	       "R $R[$samples], B $B[$samples], Y $Y[$samples])\n") if $opt_v || $opt_D;
-	if ( $opt_H ) {  # HACK
-	    $G[$samples] = 0  if $G[$samples] < 0;
-	    $A[$samples] = 0  if $A[$samples] < 0;
-	    $R[$samples] = 0  if $R[$samples] < 0;
-	    $B[$samples] = 0  if $B[$samples] < 0;
-	    $Y[$samples] = 0  if $Y[$samples] < 0;
-	}
-    }
-    $samples++;
-
-    $eventfrom = substr($event,0,1);
-    $eventto = substr($event,1,1);
-
-    printf(stderr "$time $event $eventfrom $eventto\n")   if 0 && $opt_D;
-    
-    if ($eventfrom eq '*') {
-    }
-
-    elsif ($eventfrom eq 'G') {
-	--$active;
-    }
-
-    elsif ($eventfrom eq 'A') {
-	--$runnable;
-    }
-
-    elsif ($eventfrom eq 'R') {
-	--$blocked;
-    }
-
-    elsif ($eventfrom eq 'B') {
-	--$sparks;
-    }
-
-    elsif ($eventfrom eq 'C') {
-	--$migrating;
-    }
-
-    elsif ($eventfrom eq 'Y') {
-	--$fetching;
-    }
-
-    if ($eventto eq '*') {
-    }
-
-    elsif ($eventto eq 'G') {
-	++$active;
-    }
-
-    elsif ($eventto eq 'A') {
-	++$runnable;
-	$somerunnable = 1;
-    }
-
-    elsif ($eventto eq 'R') {
-	++$blocked;
-	$someblocked = 1;
-    }
-
-    elsif ($eventto eq 'B') {
-	++$sparks;
-	$somesparks = 1;
-    }
-
-    elsif ($eventto eq 'C') {
-	++$migrating;
-	$somemigratory = 1;
-    }
-
-    elsif ($eventto eq 'Y') {
-	++$fetching;
-	$somefetching = 1;
-    }
-
-
-    #printf(stderr "%% $time: G $active, A $runnable, R $blocked, " .
-    #	   "B $sparks, C $migrating\n")  if 1;
-
-    printf(stderr "Error: Trying to write at index 0!\n")  if $samples == 0;
-    $T[$samples] = $time;
-    do set_values($samples,
-		  $active,$runnable,$blocked,$fetching,$sparks,$migrating);
-
-   #$G[$samples] = queue_on_a ? $active : 0;
-   #$A[$samples] = queue_on_r ? $runnable : 0;
-   #$R[$samples] = queue_on_b ? $blocked : 0;
-   #$Y[$samples] = queue_on_f ? $fetching : 0;
-   #$B[$samples] = queue_on_s ? $sparks : 0;
-   #$C[$samples] = queue_on_m ? $migrating : 0;
-
-    $all = $G[$samples] + $A[$samples] + $R[$samples] + $Y[$samples] +
-    	   $B[$samples] + $C[$samples] ;
-
-    if($all > $mmax) {
-	$mmax = $all; 
-    }
-
-    if ( 0 ) {
-	print STDERR "%% $time: (act,runnable,blocked,fetch,mig,sp) = " .
-	    "($active, $runnable, $blocked, $fetching, $migrating, $sparks)".
-		" max = $all\n" ;
-    }
-
-    #print STDERR "Sparks @ $time: $sparks \tAll: $all \tMMax: $mmax\n"  if $opt_D;
-
-    if ( $samples >= $slice_width ) {
-	do flush_queues();
-	$samples = 0;
-    }
-
-} # <STDIN>
-
-do flush_queues();
-print "%% End\n"  if $opt_C;
-
-# For debugging only
-if ($opt_D) {
-    printf(stderr "Queue values after last event: " .
-	   "$T[$samples] (G $G[$samples], A $A[$samples], ".
-	   "R $R[$samples], B $B[$samples], Y $Y[$samples])\n");
-}
-
-if($time != $tmax) {
-    if ( $pedantic ) {
-	die "Error: Calculated time ($time) does not agree with stated max. time ($tmax)\n";
-    } else {			# 
-	print STDERR "Warning: Calculated time ($time) does not agree with stated max. time ($tmax)\n" if $opt_v;
-    }
-}
-
-# HACK warning: 
-# The real max-y value ($mmax) might differ from the one that is the input 
-# to this script ($pmax). If so, we post-process the generated ps-file 
-# and place an appropriate scaling  fct into the header of the ps-file.
-# This is done by yet another perl-script: 
-#		  ps-scale-y <y-scaling-factor> <ps-file>
-
-if($pmax != $mmax) {
-    if ( $pedantic ) {
-	die "Error: Calculated max no. of tasks ($mmax) does not agree with stated max. no. of tasks ($pmax)\n";
-    } else {
-	print STDERR  "Warning: Calculated max no. of tasks ($mmax) does not agree with stated max. no. of tasks ($pmax)\n" if $opt_v;
-	$y_scaling = $pmax/$mmax; #((float) $pmax)/((float) $mmax);
-    }
-}
-
-print "% " . ("-" x 75) . "\n";
-
-if ( $opt_m ) {
-	print "0 setgray\n";
-} else {
-	print "0 0 0 setrgbcolor\n";
-}
-
-# Print optional str
-    if ( $opt_s ) {
-	print("HB16 setfont ($opt_s) dup stringwidth pop 790 exch sub 500 moveto show\n");
-    }
-
-    print("unscale-y\n");
-
-# Average Parallelism
-if($time > 0) {
-    if ( $opt_S ) {        #  HACK warning; is this *always* correct -- HWL
-	$avg = ($tottime-$time_of_second_event)/($time-$time_of_second_event);
-    } else {
-	$avg = $tottime/$time;
-    }
-    if ( $opt_d ) {        # Print date instead of average parallelism
-	print("HE14 setfont ($date) dup stringwidth pop 790 exch sub 515 moveto show\n");
-    } else { 
-	$avgs=sprintf("Average Parallelism = %0.1f\n",$avg);
-	print("HE14 setfont ($avgs) dup stringwidth pop 790 exch sub 515 moveto show\n");
-    }
-    $rt_str=sprintf("Runtime = %0.0f\n",$tmax);
-    print("HE14 setfont ($rt_str) dup stringwidth pop 790 exch sub 20 moveto show\n");
-}
-
-# do print_y_axis();
-
-# -----------------------------------------------------------------------------
-# Draw axes lines etc
-# -----------------------------------------------------------------------------
-
-if ( ! $opt_S ) {
-
-# Draw dashed line for orientation (startup time)   -- HWL
-
-if ( $draw_lines ) {
-    local($x, $y);
-    $x = int((500000/$tmax) * ($xmax-$xmin) + $xmin);
-    $y = int((0/$pmax) * ($ymax-$ymin) + $ymin);
-    $h = ($ymax-$ymin);
-
-    print "gsave\n" .
-	  "[1 3] 1 setdash\n" .
-	  "$x $y moveto 0 $h rlineto stroke\n" .
-	  "grestore\n";
-}
-
-# and another one at the second event                        -- HWL
-
-print STDERR "Time of second event is: $time_of_second_event"  if 0 && $opt_D;
-
-if ( $draw_lines ) {
-    local($x, $y);
-    $x = int(($time_of_second_event/$tmax) * ($xmax-$xmin) + $xmin);
-    $y = int((0/$pmax) * ($ymax-$ymin) + $ymin);
-    $h = ($ymax-$ymin);
-
-    print "gsave\n";
-    if ( ! $opt_m ) {
-	print "green setrgbcolor\n";
-    }
-    print "[3 5] 1 setdash\n" .
-	  "$x $y moveto 0 $h rlineto stroke\n" .
-	  "grestore\n";
-}
-
-}
-
-# -----------------------------------------------------------------------------
-
-# Logo
-print("HE14 setfont\n");
-if ($opt_m) {
-    print("50 520 asciilogo\n");                          
-} else {
-    print("50 520 logo\n");                          
-}
-
-# Epilogue
-print("showpage\n");
-
-if ( $y_scaling != 1.0 ) {
-    print "%% y_scaling: $y_scaling\t max: $mmax\n";
-}
-
-exit 0 ;
-
-# +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-# -----------------------------------------------------------------------------
-# Draw the current slice of the overall graph. 
-# This routine is called if a slice of data is full (i.e. $T[0..$samples],
-# $G[0..$slice_width] etc with $samples==$slice_width contain data from the 
-# input file) or if the end of the input has been reached (i.e. $samples<=
-# $slice_width). Note that the last value of the current slice is stored as
-# the first value for the next slice.
-# -----------------------------------------------------------------------------
-
-sub flush_queues { 
-    local ($x_norm, $y_norm);
-    local ($index);
-    local ($last_x, $last_y, $in_seq) = (-1, -1, 0);
-    local ($foo_x, $foo_y);
-
-    if ( $samples == 0 ) { return ; }
-
-    # print "% First sample: T $T[0] (G $G[0], A $A[0], ".
-    #	" R $R[0], B $B[0], Y $Y[0])\n"   if $opt_C;
-
-    $rshow = reverse($show);
-    print STDERR "\nReversed info-mask is : $rshow"  if 0 && $opt_D;
-    print STDERR "\nMaximal y value is $pmax"        if 0 && $opt_D;
-    for ($j=0; $j<length($rshow); $j++) {
-	$q = substr($rshow,$j,1);
-	# print  "% Queue = $q i.e. " . ($color{$q}) . " counts at first sample: " . &count($q,0) ."\n"  if $opt_C;
-	do init_psout($q, $T[0], &count($q,0));
-	for($i=1; $i <= $samples; $i++) {
-	    do psout($T[$i],&count($q,$i));
-	}
-	print $color{$q} . " F\n";
-	($foo_x, $foo_y) = &normalize($T[$samples],&count($q,$samples));
-	print "%% Last " . ($color{$q}) . " is " . &get_queue_val($q,$samples) ."  (" . $T[$samples] . ", " . &count($q,$samples) . ") -> ($foo_x,$foo_y)\n"  if $opt_C;
-	# print($color{$q} . " flush-it\n");
-	# print("$xmax $ymin L\n");
-    }
-    do wrap($samples);
-
-    #print "% Last sample  T $T[$samples] (G $G[$samples], A $A[$samples], ".
-    #      " R $R[$samples], B $B[$samples], Y $Y[$samples])\n"  if $opt_C;
-}
-
-# -----------------------------------------------------------------------------
-# Scale the (x,y) point (x is time in cycles, y is no. of tasks) s.t. the 
-# x-(time-) axis fits between $xmin and $xmax (range for .ps graph).
-# In case of optimization ($opt_O):
-#  If there is a sequence of (x,y) pairs with same x value, then just 
-#  print the first and the last pair in the seqence. To do that, $last_x
-#  always contains the scaled x-val of the last point. $last_y contains
-#  the y-val of the last point in the current sequence (it is 0 outside a 
-#  sequence!).
-# -----------------------------------------------------------------------------
-
-sub normalize {
-    local($x, $y ) = @_;
-    local($x_norm, $y_norm );
-
-    if ( $opt_S ) {
-	$x_norm = int(( ($x-$time_of_second_event)/($tmax-$time_of_second_event)) * ($xmax-$xmin) + $xmin);
-    } else {
-	$x_norm = int(($x/$tmax) * ($xmax-$xmin) + $xmin);
-    }
-    $y_norm = int(($y/$pmax) * ($ymax-$ymin) + $ymin);
-
-    return (($x_norm, $y_norm));
-}
-
-# -----------------------------------------------------------------------------
-
-sub init_psout {
-    local ($q, $x, $y) = @_;
-    local ($x_norm, $y_norm);
-
-    ($last_x, $last_y, $in_seq) = (-1, -1, 0);
-    ($x_norm, $y_norm) =  &normalize($T[0],&count($q,0));
-    $last_x = $x_norm;
-    $last_y = $y_norm;
-    print "%% Begin " . ($color{$q}) . "  (" . $T[0] . ", " . &count($q,0) . ") -> ($x_norm,$y_norm)\n" if $opt_C;
-    print $x_norm, " ", $y_norm, " M\n";
-
-}
-
-# ----------------------------------------------------------------------------
-
-sub psout {
-    local($x_in, $y_in ) = @_;
-    local($x, $y );
-
-    ($x, $y) = &normalize($x_in, $y_in);
-    die "Error in psout: Neg x coordinate\n"  if ($x < 0) ;
-
-    if ( $opt_O ) {
-	if ( $last_x == $x ) {      # If seq before $x that then print last pt
-	    if ( ! $in_seq ) {
-		$in_seq = 1;
-		$first_y = $last_y;
-	    }
-	} else {                    # If seq with same $x val then ignore pts
-	    if ( $in_seq ) {        # Seq before that -> print last in seq
-		print("$last_x $last_y L\n")  if ($first_y != $last_y);
-		$in_seq = 0;
-	    }
-	    print("$x $y L\n");
-	}
-	$last_x = $x;
-	$last_y = $y;
-    } else {
-	print("$x $y L\n");
-    }
-}
-
-# -----------------------------------------------------------------------------
-
-sub queue_on {
-    local ($queue) = @_;
-
-    return index($show,$queue)+1;
-}
-
-# -----------------------------------------------------------------------------
-
-sub count {
-    local ($queue,$index) = @_;
-    local ($res);
-
-    $where = &queue_on($queue);
-    $res = (($queue_on_a && ($queue_on_a<=$where))  ? $G[$index] : 0) +
-	   (($queue_on_r && ($queue_on_r<=$where))  ? $A[$index] : 0) +
-	   (($queue_on_b && ($queue_on_b<=$where))  ? $R[$index] : 0) +
-	   (($queue_on_f && ($queue_on_f<=$where))  ? $Y[$index] : 0) +
-	   (($queue_on_m && ($queue_on_m<=$where))  ? $C[$index] : 0) +
-           (($queue_on_s && ($queue_on_s<=$where))  ? $B[$index] : 0);
-
-    return $res;
-}
-    
-# -----------------------------------------------------------------------------
-
-sub set_values {
-    local ($samples,
-	   $active,$runnable,$blocked,$fetching,$sparks,$migrating) = @_;
-
-    $G[$samples] = $queue_on_a ? $active : 0;   
-    $A[$samples] = $queue_on_r ? $runnable : 0; 
-    $R[$samples] = $queue_on_b ? $blocked : 0;  
-    $Y[$samples] = $queue_on_f ? $fetching : 0; 
-    $B[$samples] = $queue_on_s ? $sparks : 0;   
-    $C[$samples] = $queue_on_m ? $migrating : 0;
-}
-
-# -----------------------------------------------------------------------------
-
-sub set_queue_val {
-    local ($queue,$index,$val) = @_;
-
-    if    ( $queue == "a" ) { $G[$index] = $val; }
-    elsif ( $queue == "r" ) { $A[$index] = $val; }
-    elsif ( $queue == "b" ) { $R[$index] = $val; }
-    elsif ( $queue == "f" ) { $Y[$index] = $val; }
-    elsif ( $queue == "m" ) { $C[$index] = $val; }
-    elsif ( $queue == "s" ) { $B[$index] = $val; }
-}
-
-# -----------------------------------------------------------------------------
-
-sub wrap {                # used in flush_queues at the end of a slice
-    local ($index) = @_;
-
-    $T[0] = $T[$index];
-
-    $G[0] = $G[$index];
-    $A[0] = $A[$index];
-    $R[0] = $R[$index];
-    $Y[0] = $Y[$index];
-    $B[0] = $B[$index];
-    $C[0] = $C[$index];
-}
-
-# -----------------------------------------------------------------------------
-
-sub get_queue_val {
-    local ($queue,$index) = @_;
-
-    if ( $queue == "a" ) { return $G[$index]; }
-    elsif ( $queue == "r" ) { return $A[$index]; }
-    elsif ( $queue == "b" ) { return $R[$index]; }
-    elsif ( $queue == "f" ) { return $Y[$index]; }
-    elsif ( $queue == "m" ) { return $C[$index]; }
-    elsif ( $queue == "s" ) { return $B[$index]; }
-}
-
-# -----------------------------------------------------------------------------
-
-sub get_date {
-    local ($date);
-
-    chop($date = `date`);
-    return ($date);
-}
-
-# -----------------------------------------------------------------------------
-
-sub print_prolog {
-    local ($now);
-
-    $now = do get_date();
-
-    print("%!PS-Adobe-2.0\n");
-    print("%%BoundingBox:    0 0 560 800\n");
-    print("%%Title:          Activity Profile\n");
-    print("%%Creator:        qp2ps\n");
-    print("%%StartTime:      $date\n");
-    print("%%CreationDate:   $now\n");
-    print("%%Copyright:      1995, 1996 by Hans-Wolfgang Loidl, University of Glasgow\n");
-    print("%%EndComments\n");
-    #print ("/greenlineto {1.0 setlinewidth lineto} def\n");
-    #print ("/amberlineto {0.5 setlinewidth lineto} def\n");
-    #print ("/redlineto {1.5 setlinewidth lineto} def\n");
-    #print ("/G {newpath moveto greenlineto stroke} def\n");
-    #print ("/A {newpath moveto amberlineto stroke} def\n");
-    #print ("/R {newpath moveto redlineto stroke} def\n");
-
-    if ( $opt_m ) {
-	print  "/red { 0 } def\n";
-	print  "/green { 0.5 } def\n";
-	print  "/blue { 0.7 } def\n";
-	print  "/crimson { 0.8 } def\n";
-	print  "/amber { 0.9 } def\n";
-	print  "/cyan { 0.3 } def\n";
-    } else {
-	print  "/red { 0.8 0 0 } def\n";
-	print  "/green { 0 0.9 0.1 } def\n";
-	print  "/blue { 0 0.1 0.9 } def\n";
-	print  "/crimson { 0.7 0.5 0 } def\n";
-	print  "/amber { 0.9 0.7 0.2 } def\n";
-	print  "/cyan { 0 0.6 0.9 } def\n";
-    }
-
-    print  "/printText { 0 0 moveto (GrAnSim) show } def\n";      
-    
-    if ( $opt_m ) {
-	print "/logo { gsave \n" .
-	    "        translate \n" .
-	    "        .95 -.05 0\n" .
-	    "          { setgray printText 1 -.5 translate } for \n" .
-	    "        1 setgray printText\n" . 
-	    "        grestore } def\n";
-    } else {
-	print "/logo { gsave \n" .
-	      "        translate \n" .
-	      "        .95 -.05 0\n" .
-	      "          { dup 1 exch sub 0 exch setrgbcolor printText 1 -.5 translate } for \n" . 
-	      "        1 0 0 setrgbcolor printText\n" . 
-	      "        grestore} def\n";
-    }
-    
-    print "/asciilogo { 5 sub moveto HB16 setfont (GrAnSim) show } def\n";
-    print "/cmpx {pop exch pop eq} def             % compare x-coors of 2 points\n";
-    print "/cmpy {exch pop 3 2 roll pop eq} def    % compare y-coors of 2 points\n";
-    print "/cmp {2 index eq {exch pop eq}          % compare 2 points\n";
-    print "                 {pop pop pop false} ifelse } def\n";
-
-    # Hook for scaling just the graph and y-axis
-    print "% " . "-" x 77 . "\n";
-    print "/scale-y { } def\n";
-    print "/unscale-y { } def\n";
-    
-    print "% " . "-" x 77 . "\n";
-    print "/str-len 12 def\n";
-    print "/prt-n { cvi str-len string cvs \n" .
-          "         dup stringwidth pop \n" .
-	  "         currentpoint pop 780 gt { 10 sub } { 2 div } ifelse \n" .
-          "         neg 0 rmoveto \n" . 
-          "         show  } def \n" .
-	  "        % print top-of-stack integer centered at the current point\n";
-    # NB: These PostScript functions must correspond to the Perl fct `normalize'
-    #  Currently normalize defines the following trafo on (x,y) values:
-    #  $x_norm = int(($x/$tmax) * ($xmax-$xmin) + $xmin);
-    #  $y_norm = int(($y/$pmax) * ($ymax-$ymin) + $ymin);
-
-    print "/total-len $tmax def\n";
-    print "/show-len $xmax def\n";
-    print "/x-offset $xmin def\n";
-    print "/y-offset $ymin def\n";
-    print "/normalize { total-len div show-len x-offset sub mul x-offset add floor } def\n";
-    print "% " . "-" x 77 . "\n";
-    print "%/L { lineto } def\n";
-    print "%/L {2 copy pop 1 sub currentpoint exch pop lineto lineto} def\n";
-    print "/L {2 copy currentpoint cmpx not\n";
-    print "     {2 copy pop currentpoint exch pop lineto} if\n";
-    print "    2 copy currentpoint cmpy \n";
-    print "     {pop pop} \n";
-    print "     {lineto} ifelse\n";
-    print "} def\n";
-    print "/F { % flush a segment of the overall area; Arg: color\n";
-    print "            currentpoint pop $ymin lineto closepath\n";
-    if ( $opt_m ) {
-	print "            setgray fill \n";
-    } else {
-	print "            setrgbcolor fill \n";
-    }
-    print "} def\n";
-    print "/M {  % Start drawing a slice (vert. line and moveto startpoint)\n";
-    print "      % Arg: x y\n";
-    print "      newpath 1 index $ymin moveto lineto\n";
-    print "} def\n";
-    print "% For debugging PS uncomment this line and add the file behandler.ps\n";
-    print "% $brkpage begin printonly endprint \n";
-    print("/HE10 /Helvetica findfont 10 scalefont def\n");
-    print("/HE12 /Helvetica findfont 12 scalefont def\n");
-    print("/HE14 /Helvetica findfont 14 scalefont def\n");
-    print("/HB16 /Helvetica-Bold findfont 16 scalefont def\n");
-    print "% " . "-" x 77 . "\n";
-
-    print("-90 rotate\n");
-    print("-785 30 translate\n");
-    print("newpath\n");
-    print("0 8 moveto\n");
-    print("0 525 760 525 8 arcto\n");
-    print("4 {pop} repeat\n");
-    print("760 525 760 0 8 arcto\n");
-    print("4 {pop} repeat\n");
-    print("760 0 0 0 8 arcto\n");
-    print("4 {pop} repeat\n");
-    print("0 0 0 525 8 arcto\n");
-    print("4 {pop} repeat\n");
-    print("0.500000 setlinewidth\n");
-    print("stroke\n");
-    print("newpath\n");
-    print("4 505 moveto\n");
-    print("4 521 752 521 4 arcto\n");
-    print("4 {pop} repeat\n");
-    print("752 521 752 501 4 arcto\n");
-    print("4 {pop} repeat\n");
-    print("752 501 4 501 4 arcto\n");
-    print("4 {pop} repeat\n");
-    print("4 501 4 521 4 arcto\n");
-    print("4 {pop} repeat\n");
-    print("0.500000 setlinewidth\n");
-    print("stroke\n");
-    
-    print("HE14 setfont\n");
-    print("100 505 moveto\n");
-    print("($pname ) show\n");
-    
-    # print("($date) dup stringwidth pop 750 exch sub 505 moveto show\n");
-    
-    print("4 8 moveto\n");
-    print("4 24 756 24 4 arcto\n");
-    print("4 {pop} repeat\n");
-    print("756 24 756 4 4 arcto\n");
-    print("4 {pop} repeat\n");
-    print("756 4 4 4 4 arcto\n");
-    print("4 {pop} repeat\n");
-    print("4 4 4 24 4 arcto\n");
-    print("4 {pop} repeat\n");
-    print("0.500000 setlinewidth\n");
-    print("stroke\n");
-
-# Labels 
-
-# x-range: 100 - 600
-# y-value: 
-
-    $x_begin = 100;
-    $x_end = 600; 
-    $y_label = 10;
-
-    $no_of_labels = length($show);  # $info_level;
-
-    $step = ($x_end-$x_begin)/($no_of_labels);
-
-    $x_now = $x_begin;
-
-    if ( $queue_on_a ) {
-	do print_box_and_label($x_now,$y_label,"green","running");
-    }
-
-    if ( $queue_on_r  ) {
-	$x_now += $step;
-	do print_box_and_label($x_now,$y_label,"amber","runnable");
-    }
-
-    if ( $queue_on_f ) {
-	$x_now += $step;
-	do print_box_and_label($x_now,$y_label,"cyan","fetching");
-    }
-
-    if ( $queue_on_b ) {
-	$x_now += $step;
-	do print_box_and_label($x_now,$y_label,"red","blocked");
-    }
-
-    if ( $queue_on_m ) {
-	$x_now += $step;
-	do print_box_and_label($x_now,$y_label,"blue","migrating");
-    }
-
-    if ( $queue_on_s ) {
-	$x_now += $step;
-	do print_box_and_label($x_now,$y_label,"crimson","sparked");
-    }
-    
-    # Print runtime of prg; this is jus a crude HACK; better: x-axis!  -- HWL
-    #print("HE10 setfont\n");
-    #print("680 10 moveto\n");
-    #print("(RT: $tmax) show\n");
-
-    print("-40 -10 translate\n");
-    
-    do print_x_axis();
-
-    print("$xmin $ymin moveto\n");
-    if ( $opt_m ) {
-	print "0 setgray\n";
-    } else {
-	print "0 0 0 setrgbcolor\n";
-    }
-
-    do print_y_axis();
-
-    print("scale-y\n");
-
-}
-
-# -----------------------------------------------------------------------------
-
-sub print_box_and_label {
-    local ($x,$y,$color,$label) = @_;
-    local ($z) = (15);
-
-    print("$x 10 moveto\n");
-    print("0 10 rlineto\n");
-    print("10 0 rlineto\n");
-    print("0 -10 rlineto\n");
-    print("closepath\n");
-    print("gsave\n");
-    if ( $opt_m ) { 
-	print("$color setgray\n");
-    } else {
-	print("$color setrgbcolor\n");
-    }
-    print("fill\n");
-    print("grestore\n");
-    print("stroke\n");
-    print("HE14 setfont\n");
-    print(($x+$z) . " 10 moveto\n");
-    print("($label) show\n");
-
-}
-
-# -----------------------------------------------------------------------------
-
-sub print_x_axis {
-
-    print "% " . "-" x 77 . "\n";
-    print "% X-Axis:\n";
-    print "/y-val $ymin def\n";
-    print "0.5 setlinewidth\n";
-    print "x-offset y-val moveto total-len normalize x-offset sub 0 rlineto stroke\n";
-    print "0 total-len 10 div total-len\n" .
-          " { dup normalize dup y-val moveto 0 -2 rlineto stroke  % tic\n" .
-          "   y-val 10 sub moveto HE10 setfont round prt-n  % print label \n" .
-	  " } for \n";
-    print "1 setlinewidth\n";
-    print "% End X-Axis:\n";
-    print "% " . "-" x 77 . "\n";
-}
-
-# -----------------------------------------------------------------------------
-
-sub print_y_axis {
-    local ($i);
-    local ($y, $smax,$majormax, $majorint);
-
-# Y-axis label
-
-    print "% " . ("-" x 75) . "\n";
-    print "% Y-Axis:\n";
-    print "% " . ("-" x 75) . "\n";
-
-    print("%scale-y  % y-axis outside scaled area if ps-scale-y rebuilds it!\n");
-
-    print("gsave\n");
-    print("HE12 setfont\n");
-    print("(tasks)\n");
-    print("dup stringwidth pop\n");
-    print("$ymax\n");
-    print("exch sub\n");
-    print("$labelx exch\n");
-    print("translate\n");
-    print("90 rotate\n");
-    print("0 0 moveto\n");
-    print("show\n");
-    print("grestore\n");
-
-# Scale
-
-    if ($pmax < $majorticks) {
-	$majorticks = $pmax;
-    }
-
-    print("HE12 setfont\n$scalex $ymin moveto\n$scalex $ymax lineto\n");
-    print("% Max number of tasks: $pmax\n");
-    print("% Number of ticks: $majorticks\n");
-
-    print "0.5 setlinewidth\n";
-
-    $y = $ymax; # (($pmax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
-    print("$scalex $y moveto\n$major $y lineto\n");
-    print("$markx $y moveto\n($pmax) show\n");
-
-    $majormax = int($pmax/$majorticks)*$majorticks;
-    $smax = $majormax*(($ymax-$ymin)/$pmax)+$ymin;
-    $majorint = $majormax/$majorticks;
-
-    for($i=1; $i <= $majorticks; ++$i) {
-	$y = (($smax - $ymin)/$majorticks) * ($majorticks-$i) + $ymin;
-	$majorval = int($majorint * ($majormax/$majorint-$i));
-	print("$scalex $y moveto\n$major $y lineto\n");
-	print("$markx $y moveto\n($majorval) show\n");
-    }
-
-    # print("$xmin $ymax moveto\n10 0 rlineto\n10 0 rmoveto\n($pmax) show\n");
-    print " stroke\n";
-    print "1 setlinewidth\n";
-    print "%unscale-y\n";
-    print "% End Y-Axis.\n";
-    print "% " . ("-" x 75) . "\n";
-}
-
-# -----------------------------------------------------------------------------
-
-sub print_verbose_message {
-
-    print STDERR "Prg Name: $pname  \nDate: $date  \nInfo-str: $show\n";
-    print STDERR "Input: stdin  Output: stdout\n";
-    print STDERR "The following queues are turned on: " .
-	  ( $queue_on_a ? "active, " : "") .   
-	  ( $queue_on_r ? "runnable, " : "") . 
-	  ( $queue_on_b ? "blocked, " : "") .  
-          ( $queue_on_f ? "fetching, " : "") . 
-          ( $queue_on_m ? "migrating, " : "") .
-	  ( $queue_on_s ? "sparks" : "") .
-          "\n";
-    if ( $opt_C ) {
-	print STDERR "Inserting check code into .ps file (for check-ps3 script)\n";
-    }
-    if ( $opt_D )  {
-	print STDERR "Debugging is turned ON!\n";
-    }
-}
-
-# ----------------------------------------------------------------------------
-
-sub process_options {
-
-    if ( $opt_h ) {                      
-	open(ME,$0) || die "Can't open myself ($0): $!\n";
-	$n = 0;
-	while (<ME>) {
-	    last if $_ =~ /^$/;
-	    print $_;
-	    $n++;
-	}
-	close(ME);
-	exit ;
-    }
-    
-    if ( $#ARGV != 3 ) {
-	print "Usage: $0 [options] <max x value> <max y value> <prg name> <date> \n";
-	print "Use -h option to get details\n";
-	exit 1;
-    }
-
-    $tmax = $ARGV[0];
-    $pmax = $ARGV[1];
-    # GUM uses the absolute path (with '=' instead of '/') of the executed file
-    # (for PVM reasons); if you want to have the full path in the generated
-    # graph, too, eliminate the substitution below
-    ($pname = $ARGV[2]) =~ s/.*=//;
-    $date = $ARGV[3];
-
-    $show = "armfb";
-    $draw_lines = 0;
-
-    if ( $opt_i ) { 
-	$show = "a"		if info_level == 1;
-	$show = "ar"		if info_level == 2;
-	$show = "arb"		if info_level == 3;
-	$show = "arfb"		if info_level == 4;
-	$show = "armfb"		if info_level == 5;
-	$show = "armfbs"	if info_level == 6;
-    }
-
-    if ( $opt_I ) {
-	$show = $opt_I;
-    }
-
-    if ( $opt_v ){ 
-	$verbose = 1;
-    }    
-
-    if ( $opt_l ) {
-	$slice_width = $opt_l;
-    } else {
-	$slice_width = 500;
-    }
-
-    $queue_on_a = &queue_on("a");
-    $queue_on_r = &queue_on("r"); 
-    $queue_on_b = &queue_on("b"); 
-    $queue_on_f = &queue_on("f"); 
-    $queue_on_s = &queue_on("s"); 
-    $queue_on_m = &queue_on("m"); 
-
-# if ($#ARGV == 0) {
-#     printf(stderr "usage: qp2ps.pl runtime [prog [date]]\n");
-#     exit 1;
-# }
-}
-
diff --git a/ghc/utils/parallel/sn_filter.pl b/ghc/utils/parallel/sn_filter.pl
deleted file mode 100644
index 4bfc2d1721..0000000000
--- a/ghc/utils/parallel/sn_filter.pl
+++ /dev/null
@@ -1,92 +0,0 @@
-#!/usr/local/bin/perl
-# ############################################################################
-# Time-stamp: <Wed Jun 19 1996 12:26:21 Stardate: [-31]7682.38 hwloidl>
-#
-# Usage: sn_filter [options] <gr-file> <sn>
-#
-# Extract all events out of <gr-file> that are related to threads whose 
-# spark name component is <sn>.
-# 
-# Options:
-#  -H       ... Print header of the <gr-file>, too
-#  -h       ... print help message (this text)
-#  -v       ... be talkative
-#
-# ############################################################################
-
-$gran_dir = $ENV{'GRANDIR'};
-if ( $gran_dir eq "" ) {
-    print STDERR "Warning: Env variable GRANDIR is undefined\n";
-}
-
-push(@INC, $gran_dir, $gran_dir . "/bin");
-# print STDERR "INC: " . join(':',@INC) . "\n";
-
-require "get_SN";
-require "getopts.pl";
-
-&Getopts('hvH');  
-
-do process_options();
-if ( $opt_v ) { do print_verbose_message(); }
-
-# ----------------------------------------------------------------------------
-
-do get_SN($input);
-
-open (FILE,$input) || die "Can't open $file\n";
-
-$in_header = 1;
-while (<FILE>) {
-    print  if $in_header && $opt_H;
-    $in_header = 0 if /^\++$/;
-    next if $in_header;
-    next unless /^PE\s*\d+\s*\[\d+\]:\s*\w*\s*([0-9a-fx]+)/;
-    $id = $1;
-    # print STDERR "$id --> " . $id2sn{hex($id)} . " sn: $sn  ==> " . ($sn eq $id2sn{hex($id)}) . "\n";
-    print if $sn == $id2sn{hex($id)};
-}
-	
-close (FILE);
-
-exit 0;
-
-# ----------------------------------------------------------------------------
-
-sub process_options { 
-
-    if ( $#ARGV != 1 ) {
-	die "Usage: sn_filter <gr-file> <sn>\n";
-    }
-	
-    $input = $ARGV[0];
-    $sn = $ARGV[1];
-
-    print STDERR "File: |$file|; sn: |$sn|\n"  if $opt_v;
-
- if ( $opt_h ) {
-     open (ME,$0) || die "!$: $0";
-     while (<ME>) {
-	 last if /^$/;
-	 print;
-     }
-     close (ME);
-     exit 1;
- }
-}
-
-# ----------------------------------------------------------------------------
-
-sub print_verbose_message { 
-
-    print "Input: $input\tOutput: stdout\tSN: $sn\n";
-    if ( $opt_H ) {
-	print "Prepending .gr header to the output.\n";
-    }
-
-}
-
-# ----------------------------------------------------------------------------
-
-
-
diff --git a/ghc/utils/parallel/stats.pl b/ghc/utils/parallel/stats.pl
deleted file mode 100644
index 6cf826b5cd..0000000000
--- a/ghc/utils/parallel/stats.pl
+++ /dev/null
@@ -1,168 +0,0 @@
-#!/usr/local/bin/perl
-##############################################################################
-# Time-stamp: <Sat Oct 28 1995 23:15:13 Stardate: [-31]6509.63 hwloidl>
-#
-# Usage: do ....
-#
-# Statistics package that is used in gran-extr, RTS2gran and friends.
-# Most of the routines assume a list of integers as input.
-# This package contains:
-#  - corr
-#  - mean_std_dev
-#  - cov
-#  - list_sum
-#  - list_max
-#  - list_min
-#
-##############################################################################
-
-# ----------------------------------------------------------------------------
-# Compute correlation of 2 vectors, having their sums precomputed.
-# Usage:  do corr(($n, $sum_1, @rest);
-#
-# Input: $n   ... number of all elements in @list_1 as well as in @list_2
-#                 (i.e. $n = $#list_1+1 = $#list_2+1).
-#        $sum_1 ... sum of all elements in @list_1
-#        @list_1 ... list of integers; first vector
-#        $sum_2 ... sum of all elements in @list_2
-#        @list_2 ... list of integers; first vector
-# Output: correlation of @list_1 and @list_2 
-# ----------------------------------------------------------------------------
-
-sub corr {
-    local ($n, $sum_1, @rest) = @_;
-    local (@list_1) = splice(@rest,0,$n);
-    local ($sum_2, @list_2) = @rest;
-       
-    local ($mean_1,$mean_2,$std_dev_1,$std_dev_2);
-
-    if ( $opt_D ) {
-      print "\ncorr: n=$n  sum_1=$sum_1  sum_2=$sum_2\n";
-      print "     list_sum of list_1=" . &list_sum(@list_1) . 
-              "   list_sum of list_2=" . &list_sum(@list_2) . "\n";
-      print "     len of list_1=$#list_1  len of list_2=$#list_2\n";
-    }
-
-    ($mean_1, $std_dev_1) = &mean_std_dev($sum_1,@list_1);
-    ($mean_2, $std_dev_2) = &mean_std_dev($sum_2,@list_2);
-
-    if ( $opt_D ) {
-      print "corr: $mean_1, $std_dev_1; $mean_2, $std_dev_2\n";
-    }
-
-    return ( ($std_dev_1 * $std_dev_2) == 0  ?
-               0 : 
-               &cov($n, $mean_1, @list_1, $mean_2, @list_2) / 
-	       ( $std_dev_1 * $std_dev_2 ) );
-}
-
-# ----------------------------------------------------------------------------
-
-sub mean_std_dev {
-    local ($sum,@list) = @_;
-    local ($n, $s, $s_);
-
-    #print "\nmean_std_dev: sum is $sum ; list has length $#list";
-
-    $n = $#list+1;
-    $mean_value = $sum/$n;
-
-    $s_ = 0;
-    foreach $x (@list) {
-	$s_ += $x;
-        $s += ($mean_value - $x) ** 2;  
-    }
-    if ( $sum != $s_ ) {
-      print "stat.pl: ERROR in mean_std_dev: provided sum is wrong  " .
-            "(provided: $sum; computed: $s_ " . 
-            ";list_sum: " . &list_sum(@list) . "\n";
-      exit (2);
-    }
-
-    return ( ($mean_value, sqrt($s / ($n - 1)) ) );
-}
-
-# ----------------------------------------------------------------------------
-
-sub _mean_std_dev {
-    return ( &mean_std_dev(&list_sum(@_), @_) );
-}
-
-# ----------------------------------------------------------------------------
-# Compute covariance of 2 vectors, having their sums precomputed.
-# Input: $n   ... number of all elements in @list_1 as well as in @list_2
-#                 (i.e. $n = $#list_1+1 = $#list_2+1).
-#        $mean_1 ... mean value of all elements in @list_1
-#        @list_1 ... list of integers; first vector
-#        $mean_2 ... mean value of all elements in @list_2
-#        @list_2 ... list of integers; first vector
-# Output: covariance of @list_1 and @list_2 
-# ----------------------------------------------------------------------------
-
-sub cov {
-    local ($n, $mean_1, @rest) = @_;
-    local (@list_1) = splice(@rest,0,$n);
-    local ($mean_2, @list_2) = @rest;
-
-    local ($i,$s,$s_1,$s_2);
-
-    for ($i=0; $i<$n; $i++) {
-	$s_1 += $list_1[$i];
-	$s_2 += $list_2[$i];
-	$s += ($mean_1 - $list_1[$i]) * ($mean_2 - $list_2[$i]);
-    }
-    if ( $mean_1 != ($s_1/$n) ) {
-      print "stat.pl: ERROR in cov: provided mean value is wrong " . 
-            "(provided: $mean_1; computed: " . ($s_1/$n) . ")\n"; 
-      exit (2);
-    }
-    if ( $mean_2 != ($s_2/$n) ) {
-      print "stat.pl: ERROR in cov: provided mean value is wrong " .
-            "(provided: $mean_2; computed: " . ($s_2/$n) . ")\n"; 
-      exit (2);
-    }
-    return ( $s / ($n - 1) ) ;
-}
-
-# ---------------------------------------------------------------------------
-
-sub list_sum {
-    local (@list) = @_;
-    local ($sum) = (0);
-
-    foreach $x (@list) {
-	$sum += $x;
-    }
-
-    return ($sum);
-}
-
-# ----------------------------------------------------------------------------
-
-sub list_max {
-    local (@list) = @_;
-    local ($max) = shift;
-
-    foreach $x (@list) {
-	$max = $x  if $x > $max;
-    }
-
-    return ($max);
-}
-
-# ----------------------------------------------------------------------------
-
-sub list_min {
-    local (@list) = @_;
-    local ($min) = shift;
-
-    foreach $x (@list) {
-	$min = $x  if $x < $min;
-    }
-
-    return ($min);
-}
-
-# ----------------------------------------------------------------------------
-
-1; 
diff --git a/ghc/utils/parallel/template.pl b/ghc/utils/parallel/template.pl
deleted file mode 100644
index 7fbe4cf797..0000000000
--- a/ghc/utils/parallel/template.pl
+++ /dev/null
@@ -1,141 +0,0 @@
-#!/usr/local/bin/perl
-##############################################################################
-# Time-stamp: <Sat Oct 28 1995 23:00:47 Stardate: [-31]6509.58 hwloidl>
-#
-# Usage: do read_template(<template_file_name>,<input_file_name>);
-#
-# Read the template file <template_file_name> as defined in /dev/null.
-# Set global variables as defined in the template file.
-# This is mainly used in gran-extr and RTS2gran.
-#
-##############################################################################
-
-require "par-aux.pl";
-
-sub read_template {
-    local ($org_templ_file_name,$input) = @_;
-    local ($f,$templ_file_name);
-
-    # Resolve name 
-    $gran_dir = $ENV{GRANDIR} ? $ENV{GRANDIR} : $ENV{HOME} ;
-    $templ_file_name = ( $org_templ_file_name eq '.' ? "TEMPL"     
-                                                #^^^   default file name
-			 : $org_templ_file_name eq ',' ? $gran_dir . "/bin/TEMPL"     
-                                                  #^^^   global master template
-			 : $org_templ_file_name eq '/' ? $gran_dir . "/bin/T0"     
-                                                  #^^   template, that throws away most of the info
-                         : $org_templ_file_name ); 
-
-    if ( $opt_v ) {
-	print "Reading template file $templ_file_name ...\n";
-    }
-
-    ($f = ($input eq "-" ? "stdin" : $input)) =~ s/.rts//;
-
-    open(TEMPLATE,"cat $templ_file_name | sed -e 's/\$0/$f/' |") 
-	|| die "Couldn't open file $templ_file_name";
-
-    while (<TEMPLATE>) {
-      next if /^\s*$/ || /^--/;
-      if (/^\s*G[:,;.\s]+([^\n]+)$/) {
-	  $list_str = $1;
-          $list_str =~ s/[\(\)\[\]]//g;
-          @exec_times = split(/[,;. ]+/, $list_str);
-      } elsif (/^\s*F[:,;.\s]+([^\n]+)$/) {
-	  $list_str = $1;
-          $list_str =~ s/[\(\)\[\]]//g;
-          @fetch_times = split(/[,;. ]+/, $list_str);
-      } elsif (/^\s*A[:,;.\s]+([^\n]+)$/) {
-	  $list_str = $1;
-          $list_str =~ s/[\(\)\[\]]//g;
-          @has = split(/[,;. ]+/, $list_str);
-      } elsif (/^\s*C[:,;.\s]+([^\n]+)$/) {
-	  $list_str = $1;
-          $list_str =~ s/[\(\)\[\]]//g;
-          @comm_percs = split(/[,;. ]+/, $list_str);
-      } elsif (/^\s*S[:,;.\s]+([^\n]+)$/) {
-	  $list_str = $1;
-          $list_str =~ s/[\(\)\[\]]//g;
-          @sparks = split(/[,;. ]+/, $list_str);
-      } elsif (/^\s*g[:,;.\s]+([\S]+)$/) {
-         ($gran_file_name,$gran_global_file_name, $gran_local_file_name) = 
-           &mk_global_local_names($1);
-      } elsif (/^\s*f[:,;.\s]+([\S]+)$/) {
-         ($ft_file_name,$ft_global_file_name, $ft_local_file_name) = 
-           &mk_global_local_names($1);
-      } elsif (/^\s*c[:,;.\s]+([\S]+)$/) {
-         ($comm_file_name, $comm_global_file_name, $comm_local_file_name) = 
-           &mk_global_local_names($1);
-      } elsif (/^\s*s[:,;.\s]+([\S]+)$/) {
-         ($spark_file_name, $spark_global_file_name, $spark_local_file_name) = 
-           &mk_global_local_names($1);
-      } elsif (/^\s*a[:,;.\s]+([\S]+)$/) {
-         ($ha_file_name, $ha_global_file_name, $ha_local_file_name) = 
-           &mk_global_local_names($1);
-      } elsif (/^\s*p[:,;.\s]+([\S]+)$/) {
-         $gp_file_name = $1;
-	 # $ps_file_name = &dat2ps_name($gp_file_name);
-      } elsif (/^\s*Xcorr[:,;.\s]+([\S]+)$/) {
-         $corr_file_name = $1;
-      } elsif (/^\s*Xcumulat-rts[:,;.\s]+([\S]+)$/) {
-         $cumulat_rts_file_name = $1;
-	 ($cumulat0_rts_file_name = $1) =~ s/\./0./;
-      } elsif (/^\s*Xcumulat-has[:,;.\s]+([\S]+)$/) {
-         $cumulat_has_file_name = $1;
-      } elsif (/^\s*Xcumulat-fts[:,;.\s]+([\S]+)$/) {
-         $cumulat_fts_file_name = $1;
-      } elsif (/^\s*Xcumulat-cps[:,;.\s]+([\S]+)$/) {
-         $cumulat_cps_file_name = $1;
-      } elsif (/^\s*Xclust-rts[:,;.\s]+([\S]+)$/) {
-         $clust_rts_file_name = $1;
-      } elsif (/^\s*Xclust-has[:,;.\s]+([\S]+)$/) {
-         $clust_has_file_name = $1;
-      } elsif (/^\s*Xclust-fts[:,;.\s]+([\S]+)$/) {
-         $clust_fts_file_name = $1;
-      } elsif (/^\s*Xclust-cps[:,;.\s]+([\S]+)$/) {
-         $clust_cps_file_name = $1;
-      } elsif (/^\s*Xpe[:,;.\s]+([\S]+)$/) {
-         $pe_file_name = $1;
-      } elsif (/^\s*Xsn[:,;.\s]+([\S]+)$/) {
-         $sn_file_name = $1;
-
-      } elsif (/^\s*XRTS[:,;.\s]+([\S]+)$/) {
-	  $rts_file_name = $1;
-      } elsif (/^\s*XHAS[:,;.\s]+([\S]+)$/) {
-	  $has_file_name = $1;
-      } elsif (/^\s*XFTS[:,;.\s]+([\S]+)$/) {
-	  $fts_file_name = $1;
-      } elsif (/^\s*XLSPS[:,;.\s]+([\S]+)$/) {
-	  $lsps_file_name = $1;
-      } elsif (/^\s*XGSPS[:,;.\s]+([\S]+)$/) {
-	  $gsps_file_name = $1;
-      } elsif (/^\s*XCPS[:,;.\s]+([\S]+)$/) {
-	  $cps_file_name = $1;
-      } elsif (/^\s*XCCPS[:,;.\s]+([\S]+)$/) {
-	  $ccps_file_name = $1;
-
-      } elsif (/^\s*\-[:,;.\s]+([\S]+)$/) {
-         $input = $1;
-      } elsif (/^\s*L[:,;\s]+(.*)$/) {
-	 $str = $1;
-	 %logscale = ('g',"xy",'a',"xy",'Cg',"xy",'Ca',"xy",'Yp',"y",'Ys',"y") , next  if $str eq ".";
-         $str =~ s/[\(\)\[\]]//g;
-         %logscale = split(/[,;. ]+/, $str);
-      } elsif (/^\s*i[:,;.\s]+([\S]+)$/) {
-	 $gray = $1;
-      } elsif (/^\s*k[:,;.\s]+([\S]+)$/) {
-	 $no_of_clusters = $1;
-      } elsif (/^\s*e[:,;.\s]+([\S]+)$/) {
-	 $ext_size = $1;
-      } elsif (/^\s*v.*$/) {
-	 $verbose = 1;
-      } elsif (/^\s*T.*$/) {
-	 $opt_T = 1;
-     }
-  }
-  close(TEMPLATE);
-}      
-
-# ----------------------------------------------------------------------------
-
-1;
diff --git a/ghc/utils/parallel/tf.pl b/ghc/utils/parallel/tf.pl
deleted file mode 100644
index 40cff09f2c..0000000000
--- a/ghc/utils/parallel/tf.pl
+++ /dev/null
@@ -1,148 +0,0 @@
-#!/usr/local/bin/perl
-# ############################################################################
-# Time-stamp: <Fri Aug 25 1995 23:17:43 Stardate: [-31]6189.64 hwloidl>
-#                                       (C) Hans Wolfgang Loidl, November 1994
-#
-# Usage: tf [options] <gr-file>
-#
-# Show the `taskflow' in the .gr file (especially useful for keeping track of 
-# migrated tasks. It's also possible to focus on a given PE or on a given
-# event.  
-# 
-# Options:
-#  -p <int> ... Print all events on PE <int>
-#  -t <int> ... Print all events that occur on task <int>
-#  -e <str> ... Print all <str> events
-#  -n <hex> ... Print all events about fetching the node at address <hex>.
-#  -s <int> ... Print all events with a spark name <int>
-#  -L       ... Print all events with spark queue length information
-#  -H       ... Print header of the <gr-file>, too
-#  -h       ... print help message (this text)
-#  -v       ... be talkative
-#
-# ############################################################################
-
-# ----------------------------------------------------------------------------
-# Command line processing and initialization
-# ----------------------------------------------------------------------------
-
-require "getopts.pl";
-
-&Getopts('hvHLp:t:e:n:s:S:');  
-
-do process_options();
-
-if ( $opt_v ) {
-    do print_verbose_message();
-}
-
-# ----------------------------------------------------------------------------
-
-$in_header = 1;
-while (<>) {
-    if ( $opt_H && $in_header ) {
-	print;
-	$in_header = 0 if /^\+\+\+\+\+/;
-    }
-    next unless /^PE/;
-    @c = split(/[\s\[\]:;,]+/);
-    if ( ( $check_proc ? $proc eq $c[1] : 1 ) &&
-	( $check_event ? $event eq $c[3] : 1 ) &&
-	( $check_task ? $task eq $c[4] : 1) &&
-	( $check_node ? $node eq $c[5] : 1) &&
-	( $check_spark ? (("END" eq $c[3]) && ($spark eq $c[6])) : 1) &&
-	( $negated_spark ? (("END" eq $c[3]) && ($spark ne $c[6])) : 1) &&
-	( $spark_queue_len ? ($c[5] =~ /sparks/) : 1 ) ) {
-	print;
-    }
-}
-
-exit 0;
-
-# ----------------------------------------------------------------------------
-
-sub process_options { 
-
- if ( $opt_p ne "" ) {
-   $check_proc = 1;
-   $proc = $opt_p;
- }
-
- if ( $opt_t ne "" ) {
-   $check_task = 1;
-   $task = $opt_t;
- }
-
- if ( $opt_e ne "" ) {
-   $check_event = 1;
-   $event = $opt_e;
- }
-
- if ( $opt_n ne "" ) {
-   $check_node = 1;
-   $node = $opt_n
- }
-
- if ( $opt_s ne "" ) {
-   $check_spark = 1;
-   $spark = $opt_s
- }
-
- if ( $opt_S ne "" ) {
-   $negated_spark = 1;
-   $spark = $opt_S
- }
-
- if ( $opt_L ) {
-     $spark_queue_len = 1;
- } else {
-     $spark_queue_len = 0;
- }
-
- if ( $opt_h ) {
-     open (ME,$0) || die "!$: $0";
-     while (<ME>) {
-	 last if /^$/;
-	 print;
-     }
-     close (ME);
-     exit 1;
- }
-}
-
-# ----------------------------------------------------------------------------
-
-sub print_verbose_message { 
-
- if ( $opt_p ne "" ) {
-   print "Processor: $proc\n";
- }
-
- if ( $opt_t ne "" ) {
-   print "Task: $task\n";
- }
-
- if ( $opt_e ne "" ) {
-   print "Event: $event\n";
- }
-
- if ( $opt_n ne "" ) {
-   print "Node: $node\n";
- }
-
- if ( $opt_s ne "" ) {
-   print "Spark: $spark\n";
- }
-
- if ( $opt_S ne "" ) {
-   print "Negated Spark: $spark\n";
- }
-
- if ( $opt_L ne "" ) {
-   print "Printing spark queue len info.\n";
- }
-
-}
-
-# ----------------------------------------------------------------------------
-
diff --git a/ghc/utils/prof/Makefile b/ghc/utils/prof/Makefile
deleted file mode 100644
index 7887be7f1d..0000000000
--- a/ghc/utils/prof/Makefile
+++ /dev/null
@@ -1,46 +0,0 @@
-#-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.5 2000/09/05 10:16:41 simonmar Exp $
-#
-# (c) The GHC Team, 2000
-#
-
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-INSTALLING=1
-
-ifeq "$(INSTALLING)" "1"
-SUBDIRS = cgprof icons
-endif
-
-SCRIPT_SUBST_VARS= \
- FPTOOLS_TOP_ABS \
- INSTALLING \
- DEFAULT_TMPDIR \
- TARGETPLATFORM
-
-INSTALLED_SCRIPT_PROG  = ghcprof
-INPLACE_SCRIPT_PROG    = ghcprof-inplace
-
-ifeq "$(INSTALLING)" "1"
-SCRIPT_PROG 	=  $(INSTALLED_SCRIPT_PROG)
-else
-SCRIPT_PROG 	=  $(INPLACE_SCRIPT_PROG)
-endif
-
-ifneq "$(BIN_DIST)" "1"
-SCRIPT_SUBST_VARS += libdir libexecdir
-endif
-
-# don't recurse on 'make install'
-#
-ifeq "$(INSTALLING)" "1"
-all clean distclean mostlyclean maintainer-clean ::
-	$(MAKE) INSTALLING=0 BIN_DIST=0 $(MFLAGS) $@
-endif
-
-INTERP          = perl
-SCRIPT_OBJS	= ghcprof.prl
-INSTALL_SCRIPTS += $(SCRIPT_PROG)
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/prof/cgprof/Makefile b/ghc/utils/prof/cgprof/Makefile
deleted file mode 100644
index fd6ac040a7..0000000000
--- a/ghc/utils/prof/cgprof/Makefile
+++ /dev/null
@@ -1,15 +0,0 @@
-#-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.2 2003/08/01 15:38:41 panne Exp $
-#
-# (c) The GHC Team, 2000
-#
-
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-
-C_PROG = cgprof
-INSTALL_LIBEXECS=$(C_PROG)
-
-SRC_CC_OPTS += -Wall -I$(GHC_INCLUDE_DIR)
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/prof/cgprof/README b/ghc/utils/prof/cgprof/README
deleted file mode 100644
index 2c4ca16bc9..0000000000
--- a/ghc/utils/prof/cgprof/README
+++ /dev/null
@@ -1,7 +0,0 @@
-
-Please read the instructions in the section `Introduction - Using the 
-profiling tool' before you begin:
-
-http://www.dcs.warwick.ac.uk/people/academic/Stephen.Jarvis/profiler/index.html
-
-This contains all the necessary compilation instructions etc.
diff --git a/ghc/utils/prof/cgprof/cgprof.c b/ghc/utils/prof/cgprof/cgprof.c
deleted file mode 100644
index 8ee66e1f52..0000000000
--- a/ghc/utils/prof/cgprof/cgprof.c
+++ /dev/null
@@ -1,1284 +0,0 @@
-/* ------------------------------------------------------------------------
- * $Id: cgprof.c,v 1.6 2004/08/13 13:11:22 simonmar Exp $
- *									
- *	Copyright (C) 1995-2000 University of Oxford
- *									
- * Permission to use, copy, modify, and distribute this software,
- * and to incorporate it, in whole or in part, into other software,
- * is hereby granted without fee, provided that
- *   (1) the above copyright notice and this permission notice appear in
- *	 all copies of the source code, and the above copyright notice
- *	 appear in clearly visible form on all supporting documentation
- *	 and distribution media;
- *   (2) modified versions of this software be accompanied by a complete
- *	 change history describing author, date, and modifications made;
- *	 and
- *   (3) any redistribution of the software, in original or modified
- *	 form, be without fee and subject to these same conditions.
- * --------------------------------------------------------------------- */
-
-#include "ghcconfig.h"
-#if HAVE_STRING_H
-#include <string.h>
-#endif
-
-#include "daVinci.h"
-#include "symbol.h"
-#include "cgprof.h"
-#include "matrix.h"
-
-/* -----------------------------------------------------------------------------
- * Data structures
- * -------------------------------------------------------------------------- */
-
-int                 raw_profile_next=0;
-int                 raw_profile_size=0;
-parsed_cost_object *raw_profile=NULL;
-
-/* -----------------------------------------------------------------------------
- * Create/grow data sequence of raw profile data
- * -------------------------------------------------------------------------- */
-
-void enlargeRawProfile() {
-
-  if (raw_profile_size==0) {
-    raw_profile_next = 0;
-    raw_profile_size = RAW_PROFILE_INIT_SIZE;
-    raw_profile      = calloc(raw_profile_size,sizeof(parsed_cost_object));
-  } else {
-    raw_profile_size += RAW_PROFILE_INIT_SIZE;
-    raw_profile       = realloc(raw_profile,
-				 raw_profile_size*sizeof(parsed_cost_object));
-  }
-  if (raw_profile==NULL) {
-    fprintf(stderr,"{enlargeRawProfile} unable to allocate %d elements",
-            raw_profile_size);
-    exit(1);
-  }
-}
-
-/* -----------------------------------------------------------------------------
- * Function that adds two cost centers together
- *
- * This will be used to generate the inheretance profile.
- * -------------------------------------------------------------------------- */
-
-void add_costs(object_cost *left, object_cost right) {
-
-  left->syncs         += right.syncs;
-  left->comp_max      += right.comp_max;
-  left->comp_avg      += right.comp_avg;
-  left->comp_min      += right.comp_min;
-  left->comm_max      += right.comm_max;
-  left->comm_avg      += right.comm_avg;
-  left->comm_min      += right.comm_min;
-  left->comp_idle_max += right.comp_idle_max;
-  left->comp_idle_avg += right.comp_idle_avg;
-  left->comp_idle_min += right.comp_idle_min;
-  left->hrel_max      += right.hrel_max;
-  left->hrel_avg      += right.hrel_avg;
-  left->hrel_min      += right.hrel_min;
-  if ((left->proc==NULL) || (right.proc==NULL)) {
-    fprintf(stderr,"Cost is null");
-    exit(0);
-  }
-}
-
-
-int ignore_function(char *fname) {
-  return 0;
-}
-
-/* -----------------------------------------------------------------------------
- * GHC specific data structures
- * -------------------------------------------------------------------------- */
-
-/* Globals */
-/* You will need to update these when you increase the number of */
-/*   cost centres, cost centre stacks, heap objects              */
-
-   #define MAX_IDENTIFIERS 2000 /* maximum number of identifiers */
-                                /* or size of matrix structure   */
-
-  /* make this dynamic */
-
-   #define MAX_TIME    100      /* Maximum serial time for heap profile */
-   #define MAX_SAMPLES 50       /* Maximum heap samples */
-
-                                /* To do: modify this to be dynamic */
-
-   #define MAX_STRING_SIZE 70
-   #define MAX_LINE_LENGTH 80
-   #define EOF (-1)
-
-/* Cost centre data structure */
-
-   struct cost_centre { char *name;
-                        char *module;
-                        char *group;
-   } _cc_;
-
-   typedef struct cost_centre cc_matrix[MAX_IDENTIFIERS];
-
-   //typedef struct cost_centre *cc_matrix;
-
-   typedef cc_matrix* p_cc_matrix;
-   typedef char* MY_STRING;
-
-/* Heap sample structure */
-
-   struct heap_sample { 
-                        int count; /* heap_sample */
-   };
-
-   typedef struct heap_sample heap_sample_matrix[MAX_IDENTIFIERS];
-   typedef heap_sample_matrix* p_heap_sample_matrix;
-
-/* Cost centre stack data structure */
-
-   struct cost_centre_stack { 
-                      int cc;
-                      int ccs;
-                      int scc;   /* scc_sample  */
-                      int ticks; /* scc_sample  */
-                      int bytes; /* scc_sample  */
-                      p_heap_sample_matrix hsm; /* heap_sample */
-   };
-
-   typedef struct cost_centre_stack ccs_matrix[MAX_IDENTIFIERS];
-   typedef ccs_matrix* p_ccs_matrix;
-
-/* Heap object data structure */
-
-   struct heap_object { int   type;            /* type of heap object */
-                        char* descriptor; 
-                        int   type_constr_ref; /* if present */
-                      };
-
-   typedef struct heap_object heap_object_matrix[MAX_IDENTIFIERS];
-   typedef heap_object_matrix* p_heap_object_matrix;
-
-/* Type constructor structure */
-
-   struct type_constr { char* module;
-                        char* name;
-                      };
-
-   typedef struct type_constr type_constr_matrix[MAX_IDENTIFIERS];
-   typedef type_constr_matrix* p_type_constr_matrix;
-
-/* Heap update structure */
-
-   struct heap_update_sample { int ccs;   /* associated cost centre stack */
-                               int ho;    /* associated heap object */
-                               int count; 
-                              };
-
-   typedef struct heap_update_sample heap_update_list[MAX_SAMPLES];
-   typedef heap_update_list* p_heap_update_list;
-
-   struct heap_update_record { int no_samples; /* Number of samples */
-                               p_heap_update_list acc_samples;
-                             };
-
-   typedef struct heap_update_record TheHeap[MAX_TIME];
-   typedef TheHeap* p_TheHeap;
-
-
-/* -----------------------------------------------------------------------------
- * GHC specific functions
- * -------------------------------------------------------------------------- */
-
-// Initialisation routines
-
-void initialise_heap_update_list(heap_update_list *m)
-{
-  int i;
-  for (i=0; i<MAX_SAMPLES;i++)
-  {
-    (*m)[i].ccs   = -1;
-    (*m)[i].ho    = -1;
-    (*m)[i].count    = -1;
-  }
-}
-
-void add_to_heap_update_list(heap_update_list *m, int ccs, int ho, int count, int pos)
-{
-  (*m)[pos].ccs    = ccs;
-  (*m)[pos].ho     = ho;
-  (*m)[pos].count    = count;
-}
-
-void initialise_TheHeap(TheHeap *h)
-{
-  int i;
-  for (i=0; i<MAX_TIME;i++)
-  {
-    heap_update_list *h_u_l;
-    h_u_l = (p_heap_update_list) malloc (sizeof(heap_update_list));
-    initialise_heap_update_list(h_u_l);
-    (*h)[i].acc_samples = h_u_l;
-    (*h)[i].no_samples   = 0;
-  }
-}
-
-void add_to_TheHeap(TheHeap *h, int time, int ccs, int ho, int count)
-{
-  add_to_heap_update_list((*h)[time].acc_samples,ccs,ho,count,(*h)[time].no_samples);
-  (*h)[time].no_samples++;
-}
-
-void initialise_cc_matrix(cc_matrix *m)
-{ 
-  int i;
-  char *blank="blank"; /* To do: Modify this terminator string */
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-    { 
-      (*m)[i].name =  (MY_STRING) malloc ((MAX_STRING_SIZE));
-      (*m)[i].module = (MY_STRING) malloc ((MAX_STRING_SIZE));
-      (*m)[i].group = (MY_STRING) malloc ((MAX_STRING_SIZE));
-
-      strcpy((*m)[i].name,blank); 
-      strcpy((*m)[i].module,blank);
-      strcpy((*m)[i].group,blank);  
-    }
-}
-
-void free_cc_matrix(cc_matrix *m)
-{
-  int i;
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-    {
-      free((*m)[i].name);
-      free((*m)[i].module);
-      free((*m)[i].group);
-    }
-    free(m);
-}
-
-void initialise_heap_object_matrix(heap_object_matrix *m)
-{
-  int i;
-  char *blank="blank"; /* To do: ditto */
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-  {
-    (*m)[i].type = -1;
-    (*m)[i].descriptor = (MY_STRING) malloc ((MAX_STRING_SIZE));
-    strcpy((*m)[i].descriptor,blank);
-    (*m)[i].type_constr_ref = -1; 
-  }
-}
-
-void initialise_type_constr_matrix(type_constr_matrix *m)
-{
-  int i;
-  char *blank="blank";
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-  {
-    (*m)[i].module = (MY_STRING) malloc ((MAX_STRING_SIZE));
-    (*m)[i].name   = (MY_STRING) malloc ((MAX_STRING_SIZE));
-    strcpy((*m)[i].module,blank);
-    strcpy((*m)[i].name,blank);
-  }
-}
-
-void initialise_heap_sample_matrix(heap_sample_matrix *m)
-{
-  int i;
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-  { (*m)[i].count = -1; }
-}
-
-void initialise_ccs_matrix(ccs_matrix *m)
-{ 
-  int i;
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-    { 
-      /* Stack heap samples */
-      heap_sample_matrix *hs_m;
-      hs_m = (p_heap_sample_matrix) malloc (sizeof(heap_sample_matrix));
-      initialise_heap_sample_matrix(hs_m);
-      (*m)[i].hsm = hs_m;
-      /* Stack scc samples */
-      (*m)[i].cc    = 0; 
-      (*m)[i].ccs   = 0;
-      (*m)[i].scc   = 0;
-      (*m)[i].ticks = 0; 
-      (*m)[i].bytes = 0; 
-    }
-}
-
-
-// Filling matrix routines
-
-char* StripDoubleQuotes(char* s) /* For fussy daVinci! */
-{
-  char *p = s;
-  char *tempchar;
-  char *empty="";
-  char *tempstring = (MY_STRING) malloc ((MAX_STRING_SIZE));
-  strcpy(tempstring,empty);
-  while (*p)
-  { if (*p!='"')
-    { tempchar = p; strncat(tempstring,p,1);
-     }
-    p++; 
-  }
-  return tempstring;
-}
-
-void fill_cc_matrix(cc_matrix *m,char* name,char* module,char* group,int i)
-{ 
-  if (i>MAX_IDENTIFIERS) 
-  {  fprintf(logFile,"Cost centre MAX_IDENTIFIERS exceeded: %i \n",i); exit(1); }
-  name = StripDoubleQuotes(name);
-  strcpy((*m)[i].name,name); 
-  module = StripDoubleQuotes(module);
-  strcpy((*m)[i].module,module);
-  group = StripDoubleQuotes(group);
-  strcpy((*m)[i].group,group);
-}
-
-void fill_ccs_matrix(ccs_matrix *m,int cc, int ccs, int scc, int ticks, int bytes, int h_o, int count, int i)
-{
-  heap_sample_matrix *hsm;
-
-  if ((*m)[i].cc == 0)  /* added for type 2 stack semantics, but should not */
-                        /* change behaviour of type 1 (apart from CAF:REP.  */
-  {
-    if (i>MAX_IDENTIFIERS) 
-    {  fprintf(logFile,"Cost centre stack MAX_IDENTIFIERS exceeded: %i \n",i); exit(1); }
-    hsm = (*m)[i].hsm;
-    (*m)[i].cc = cc; (*m)[i].ccs = ccs; 
-    (*m)[i].ticks = ticks; (*m)[i].bytes = bytes; (*m)[i].scc = scc;
-    (*hsm)[h_o].count = count;
-  }
-  else fprintf(logFile,"Ignoring redeclaration of stack %i\n",i);
-}
-
-void add_ccs_costs(ccs_matrix *m, int b,int c,int d,int x,int y,int h_o, int co)
-{
-  (*m)[c].scc    = (*m)[c].scc + d;
-  (*m)[c].ticks  = (*m)[c].ticks + x;
-  (*m)[c].bytes  = (*m)[c].bytes + y;
-}
-
-void add_heap_sample_costs(ccs_matrix *m, int b,int c,int d,int x,int y,int h_o, int co)
-{ 
-  heap_sample_matrix *hsm = (*m)[c].hsm;
-  if (((*hsm)[h_o].count)==-1)
-     (*hsm)[h_o].count = (*hsm)[h_o].count + co + 1; /* as init is -1 */
-  else 
-     (*hsm)[h_o].count = (*hsm)[h_o].count + co;
-}
-
-void add_heap_object(heap_object_matrix *m, int pos, int t, char* des, int tr)
-{
-  if (pos>MAX_IDENTIFIERS) 
-  {  fprintf(logFile,"Heap object MAX_IDENTIFIERS exceeded: %i \n",pos); exit(1); }
-  (*m)[pos].type = t;
-  strcpy((*m)[pos].descriptor,des);
-  (*m)[pos].type_constr_ref = tr;
-} 
-
-void add_type_constr_object(type_constr_matrix *m, int pos, char* mod, char* n)
-{
-  if (pos>MAX_IDENTIFIERS) 
-  {  fprintf(logFile,"Type constructor MAX_IDENTIFIERS exceeded: %i \n",pos); exit(1); }
-  strcpy((*m)[pos].module,mod);
-  strcpy((*m)[pos].name,n);
-}
-
-
-// Printing routines
-
-void print_heap_update_list(heap_update_list *m, int number)
-{
-  int i;
-  fprintf(logFile,"[");
-  for (i=0; i<number;i++)
-  {
-    fprintf(logFile," (%i,%i,%i) ",(*m)[i].ccs,(*m)[i].ho,(*m)[i].count);
-  }
-  fprintf(logFile,"]\n");
-}
-
-void print_TheHeap(TheHeap *h)
-{
-  int i;
-  fprintf(logFile,"The Heap\n========\n");
-  for (i=0; i<MAX_TIME;i++)
-  {
-    if ((*h)[i].no_samples>0)
-    {
-      fprintf(logFile,"Sample time %i, number of samples %i actual samples "
-                 ,i,(*h)[i].no_samples);
-      print_heap_update_list((*h)[i].acc_samples,(*h)[i].no_samples);
-    }
-  }
-}
-
-void PrintXaxis(FILE *HEAP_PROFILE, TheHeap *h)
-{
-  int i;
-  fprintf(HEAP_PROFILE," ");
-  for (i=0; i<MAX_TIME;i++)
-  {
-    if ((*h)[i].no_samples>0)
-       fprintf(HEAP_PROFILE,"%i ",i);
-  }
-}
-
-int FindSample(heap_update_list *m, int number, int element)
-{
-  int i;
-  for (i=0; i<number;i++)
-  {
-    if ((*m)[i].ho==element)
-        return ((*m)[i].count);
-  }
-  return 0;
-}
-
-void PrintSampleCosts(FILE *hfp, TheHeap *h, int element)
-{
-  int i;
-  int total = 0;
-  for (i=0; i<MAX_TIME;i++)
-  {
-    if ((*h)[i].no_samples>0)
-    {
-      total = total + FindSample((*h)[i].acc_samples,(*h)[i].no_samples,element);
-      fprintf(hfp," %i ",total);
-    }
-  }
-}
-
-void print_cc_matrix(cc_matrix *m)
-{ 
-  int i;
-  char *blank="blank";
-  fprintf(logFile,"Cost centre matrix\n");
-  fprintf(logFile,"==================\n");
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-    { if (strcmp((*m)[i].name,blank)!=0) 
-         fprintf(logFile,"%s %s %s\n",(*m)[i].name,(*m)[i].module,(*m)[i].group); }
-  fprintf(logFile,"\n");
-}
-
-void print_heap_object_matrix(FILE* hfp, TheHeap *h, heap_object_matrix *m)
-{
-  int i;
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-  { 
-    if (((*m)[i].type)!=-1)
-    {
-      fprintf(hfp,"Y%i set {",i);
-      /* if ((*m)[i].type==1) fprintf(hfp,"data_contr ");
-      if ((*m)[i].type==2) fprintf(hfp,"PAP ");
-      if ((*m)[i].type==3) fprintf(hfp,"thunk ");
-      if ((*m)[i].type==4) fprintf(hfp,"function ");
-      if ((*m)[i].type==5) fprintf(hfp,"dictionary ");
-      if ((*m)[i].type==1) 
-         fprintf(hfp,"%s %i ",(*m)[i].descriptor,(*m)[i].type_constr_ref);
-      else
-         fprintf(hfp,"%s ",(*m)[i].descriptor); */
-      PrintSampleCosts(hfp,h,i);
-      fprintf(hfp,"}\n");
-    }
-  }         
-}
-
-int number_of_heap_objects(heap_object_matrix *m)
-{
-  int i;
-  int count = 0;
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-  {
-    if (((*m)[i].type)!=-1) count++;
-  }
-  return count;
-}
-
-void names_of_heap_objects(FILE *hfp, heap_object_matrix *m)
-{
-  int i;
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-  {
-    if (((*m)[i].type)!=-1) 
-      fprintf(hfp,"Y%i ",i);
-  }
-  fprintf(hfp,"\n");
-}
-
-void names_and_colour_assignment(FILE *hfp, heap_object_matrix *m)
-{
-  int i;
-  int colour=0;
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-  {
-    if (((*m)[i].type)!=-1) 
-    {
-      switch(colour)
-      {
-        case 0 : fprintf(hfp,"%s \t Y%i \t red \t fdiagonal1\n",(*m)[i].descriptor,i); 
-                 colour++; break;
-        case 1 : fprintf(hfp,"%s \t Y%i \t blue \t fdiagonal1\n",(*m)[i].descriptor,i);
-                 colour++; break;
-        case 2 : fprintf(hfp,"%s \t Y%i \t green \t fdiagonal1\n",(*m)[i].descriptor,i);
-                 colour++; break;
-        case 3 : fprintf(hfp,"%s \t Y%i \t yellow \t fdiagonal1\n",(*m)[i].descriptor,i);
-                 colour++; break;
-        case 4 : fprintf(hfp,"%s \t Y%i \t pink \t fdiagonal1\n",(*m)[i].descriptor,i);
-                 colour++; break;
-        case 5 : fprintf(hfp,"%s \t Y%i \t goldenrod \t fdiagonal1\n",(*m)[i].descriptor,i);
-                 colour++; break;
-        case 6 : fprintf(hfp,"%s \t Y%i \t orange \t fdiagonal1\n",(*m)[i].descriptor,i);
-                 colour++; break;
-        default: fprintf(hfp,"%s \t Y%i \t purple \t fdiagonal1\n",(*m)[i].descriptor,i);
-                 colour=0; break;
-      }
-    }
-  }
-}
-
-void print_type_constr_matrix(type_constr_matrix *m)
-{
-  int i;
-  char *blank="blank";
-  fprintf(logFile,"Type constructor matrix\n");
-  fprintf(logFile,"=======================\n");
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-  {
-    if (strcmp((*m)[i].name,blank)!=0)
-         fprintf(logFile,"%i %s %s\n",i,(*m)[i].module,(*m)[i].name);
-  }
-}
-
-void print_heap_sample_matrix(heap_sample_matrix *m)
-{
-  int i;
-  fprintf(logFile,"HeapSamples[");
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-  {
-    if ((*m)[i].count!=-1) fprintf(logFile,"(%i,%i),",i,(*m)[i].count);
-  }
-  fprintf(logFile,"]\n");
-}
-
-void print_ccs_matrix(ccs_matrix *m)
-{ 
-  int i;
-  fprintf(logFile,"Cost centre stack matrix\n");
-  fprintf(logFile,"========================\n");
-  for (i=0; i<MAX_IDENTIFIERS; i++)
-  {  if ((*m)[i].cc!=0)
-     {
-       fprintf(logFile,"%i %i %i %i %i \n",(*m)[i].cc,(*m)[i].ccs,(*m)[i].scc,
-                               (*m)[i].ticks,(*m)[i].bytes); 
-     } 
-  }
-  fprintf(logFile,"\n");
-}
-
-
-/* No longer used */
-
-void FormStack(ccs_matrix *m, cc_matrix *n, int i, char s[])
-{
-  int j = i;
-  if ((*m)[j].cc != 0)
-  {
-    strcat(s,(*n)[(*m)[j].cc].name);
-    strcat(s," ");
-    while ((*m)[j].ccs != (-1))
-    {
-      strcat(s,(*n)[(*m)[(*m)[j].ccs].cc].name);
-      strcat(s,",");
-      j = (*m)[j].ccs;
-    }
-  }
-  else fprintf(logFile,"ERROR: Form Stack %i\n",i);
-}
-
-/* This version, which is used, adds the module and group name to the cost centre name*/
-/* This means the cost centre name remains unique when it is textualised and fed into */
-/* daVinci. It also allows the module and group name to be extracted at the display   */
-/* level */
-
-void FormStack2(ccs_matrix *m, cc_matrix *n, int i, char s[])
-{
-  int j = i;
-  if ((*m)[j].cc != 0)
-  {
-    strcat(s,(*n)[(*m)[j].cc].name);
-    strcat(s,"&");
-    strcat(s,(*n)[(*m)[j].cc].module);
-    strcat(s,"&");
-    strcat(s,(*n)[(*m)[j].cc].group);
-    strcat(s," ");
-    while ((*m)[j].ccs != (-1))
-    {
-      strcat(s,(*n)[(*m)[(*m)[j].ccs].cc].name);
-      strcat(s,"&");
-      strcat(s,(*n)[(*m)[(*m)[j].ccs].cc].module);
-      strcat(s,"&");
-      strcat(s,(*n)[(*m)[(*m)[j].ccs].cc].group);
-      strcat(s,",");
-      j = (*m)[j].ccs;
-    }
-  }
-  else fprintf(logFile,"ERROR: Form Stack %i\n",i);
-}
-
-void PrintStack(ccs_matrix *m, cc_matrix *n, int i)
-{
-  int j = i;
-  if ((*m)[j].cc != 0)
-  {
-    fprintf(logFile,"<"); 
-    fprintf(logFile,"%s,",(*n)[(*m)[j].cc].name);
-    while ((*m)[j].ccs != (-1))
-    {
-      fprintf(logFile,"%s,",(*n)[(*m)[(*m)[j].ccs].cc].name);
-      j = (*m)[j].ccs;
-    }
-    fprintf(logFile,"> ");
-    fprintf(logFile,"%i scc %i ticks %i bytes  ",
-            (*m)[i].scc,(*m)[i].ticks,(*m)[i].bytes);
-    print_heap_sample_matrix((*m)[i].hsm);
-  }
-  else
-  { /* fprintf(logFile,"empty stack\n"); */ }
-}
-
-int CountStacks(ccs_matrix *m)
-{
-  int j;
-  int count = 0;
-  for (j=0; j<MAX_IDENTIFIERS;j++) if ((*m)[j].cc != 0) count++;
-  return count;
-}
-
-void PrintAllStacks(ccs_matrix *m, cc_matrix *n)
-{
-  int i;
-  fprintf(logFile,"Stacks\n======\n");
-  for (i=0;i<MAX_IDENTIFIERS;i++) { PrintStack(m,n,i); }
-}
-
-
-/* -----------------------------------------------------------------------------
- * TCL Heap profile generator
- * -------------------------------------------------------------------------- */
-
-void produce_HEAP_PROFILE(FILE *HEAP_PROFILE, TheHeap *th, heap_object_matrix *ho_m)
-{
-  // First the header information 
-  fprintf(HEAP_PROFILE,"#!/home/sj/blt2.4o/src/bltwish\n");
-  fprintf(HEAP_PROFILE,"package require BLT\n");
-  fprintf(HEAP_PROFILE,"if { $tcl_version >= 8.0 } {\n");
-  fprintf(HEAP_PROFILE,"\t \t namespace import blt::*\n");
-  fprintf(HEAP_PROFILE,"namespace import -force blt::tile::*\n");
-  fprintf(HEAP_PROFILE,"}\n");
-  fprintf(HEAP_PROFILE,"source scripts/demo.tcl\n");
-  fprintf(HEAP_PROFILE,"proc FormatXTicks { w value } {\n");
-  fprintf(HEAP_PROFILE,"\t \t set index [expr round($value)]\n");
-  fprintf(HEAP_PROFILE,"\t \t if { $index != $value } {\n");
-  fprintf(HEAP_PROFILE,"\t \t \t return $value\n");
-  fprintf(HEAP_PROFILE,"\t \t}\n");
-  fprintf(HEAP_PROFILE,"incr index -1\n");
-
-  // Now the code to generate the units in the X axis
-
-  fprintf(HEAP_PROFILE,"set name [lindex { ");
-  PrintXaxis(HEAP_PROFILE,th);
-  fprintf(HEAP_PROFILE," } $index]\n");
-
-  fprintf(HEAP_PROFILE,"return $name\n");
-  fprintf(HEAP_PROFILE,"}\n");
-  
-  // more general graph stuff 
-
-  fprintf(HEAP_PROFILE,"source scripts/stipples.tcl\n");
-  fprintf(HEAP_PROFILE,"image create photo bgTexture -file ./images/chalk.gif\n");
-  fprintf(HEAP_PROFILE,"option add *Button.padX			5\n");
-  fprintf(HEAP_PROFILE,"option add *tile			bgTexture\n");
-  fprintf(HEAP_PROFILE,"option add *Radiobutton.font		-*-courier*-medium-r-*-*-14-*-*\n");
-  fprintf(HEAP_PROFILE,"option add *Radiobutton.relief		flat\n");
-  fprintf(HEAP_PROFILE,"option add *Radiobutton.borderWidth     2\n");
-  fprintf(HEAP_PROFILE,"option add *Radiobutton.highlightThickness 0\n");
-  fprintf(HEAP_PROFILE,"option add *Htext.font			-*-times*-bold-r-*-*-14-*-*\n");
-  fprintf(HEAP_PROFILE,"option add *Htext.tileOffset		no\n");
-  fprintf(HEAP_PROFILE,"option add *header.font			-*-times*-medium-r-*-*-14-*-*\n");
-  fprintf(HEAP_PROFILE,"option add *Barchart.font		 -*-helvetica-bold-r-*-*-14-*-*\n");
-
-  fprintf(HEAP_PROFILE,"option add *Barchart.title		\"Heap profile of program ");
-  // TO DO: Add program name in here
-  fprintf(HEAP_PROFILE,"\"\n");
-
-  fprintf(HEAP_PROFILE,"option add *Axis.tickFont		-*-helvetica-medium-r-*-*-12-*-*\n");
-  fprintf(HEAP_PROFILE,"option add *Axis.titleFont		-*-helvetica-bold-r-*-*-12-*-*\n");
-  fprintf(HEAP_PROFILE,"option add *x.Command			FormatXTicks\n");
-  fprintf(HEAP_PROFILE,"option add *x.Title			\"Time (seconds)\"\n");
-  fprintf(HEAP_PROFILE,"option add *y.Title			\"Heap usage (000 bytes)\"\n");
-  fprintf(HEAP_PROFILE,"option add *activeBar.Foreground	pink\noption add *activeBar.stipple		dot3\noption add *Element.Background		red\noption add *Element.Relief		raised\n");
-  fprintf(HEAP_PROFILE,"option add *Grid.dashes			{ 2 4 }\noption add *Grid.hide			no\noption add *Grid.mapX			\"\"\n");
-  fprintf(HEAP_PROFILE,"option add *Legend.Font			\"-*-helvetica*-bold-r-*-*-12-*-*\"\noption add *Legend.activeBorderWidth	2\noption add *Legend.activeRelief		raised \noption add *Legend.anchor		ne \noption add *Legend.borderWidth		0\noption add *Legend.position		right\n");
-  fprintf(HEAP_PROFILE,"option add *TextMarker.Font		*Helvetica-Bold-R*14*\n");
-  fprintf(HEAP_PROFILE,"set visual [winfo screenvisual .] \nif { $visual != \"staticgray\" && $visual != \"grayscale\" } {\n    option add *print.background	yellow\n    option add *quit.background		red\n    option add *quit.activeBackground	red2\n}\n");
-  fprintf(HEAP_PROFILE,"htext .title -text {\n    Heap profile\n}\n");
-  fprintf(HEAP_PROFILE,"htext .header -text {\n    %%%% \n");
-  fprintf(HEAP_PROFILE,"      radiobutton .header.stacked -text stacked -variable barMode \\\n            -anchor w -value \"stacked\" -selectcolor red -command {\n            .graph configure -barmode $barMode\n        } \n        .header append .header.stacked -width 1.5i -anchor w\n");
-  fprintf(HEAP_PROFILE,"    %%%%      Heap usage stacked: overall height is the sum of the heap used. \n    %%%% \n");
-  fprintf(HEAP_PROFILE,"        radiobutton .header.aligned -text aligned -variable barMode \\\n          -anchor w -value \"aligned\" -selectcolor yellow -command {\n            .graph configure -barmode $barMode        }\n        .header append .header.aligned -width 1.5i -fill x\n");
-  fprintf(HEAP_PROFILE,"    %%%%      Heap usage components displayed side-by-side.\n    %%%%\n");
-  fprintf(HEAP_PROFILE,"        radiobutton .header.overlap -text \"overlap\" -variable barMode \\\n            -anchor w -value \"overlap\" -selectcolor green -command {\n            .graph configure -barmode $barMode\n        }\n         .header append .header.overlap -width 1.5i -fill x\n");
-  fprintf(HEAP_PROFILE,"    %%%%      Heap  usage shown as an overlapped histogram.\n    %%%%\n");
-  fprintf(HEAP_PROFILE,"        radiobutton .header.normal -text \"normal\" -variable barMode \\\n            -anchor w -value \"normal\" -selectcolor blue -command {\n            .graph configure -barmode $barMode\n        }\n         .header append .header.normal -width 1.5i -fill x\n");
-  fprintf(HEAP_PROFILE,"    %%%%      Heap components overlayed one on top of the next. \n}\n");
-  fprintf(HEAP_PROFILE,"htext .footer -text { To create a postscript file \"heap_profile.ps\", press the %%%%\n  button $htext(widget).print -text print -command {\n        puts stderr [time {.graph postscript output heap_profile.ps}]\n  }\n  $htext(widget) append $htext(widget).print\n%%%% button.}\n");
-  fprintf(HEAP_PROFILE,"barchart .graph -tile bgTexture\n");
-
-  // This is where the actual data comes in
-
-  fprintf(HEAP_PROFILE,"vector X ");
-  names_of_heap_objects(HEAP_PROFILE,ho_m);
-  fprintf(HEAP_PROFILE,"\nX set { ");
-  PrintXaxis(HEAP_PROFILE,th);
-  fprintf(HEAP_PROFILE," }\n");
-
-  print_heap_object_matrix(HEAP_PROFILE,th, ho_m);
-
-  // NAMES FOR THE ATTRIBUTES 
-  fprintf(HEAP_PROFILE,"set attributes {\n");
-  names_and_colour_assignment(HEAP_PROFILE,ho_m);
-  fprintf(HEAP_PROFILE,"}\n");
-  
-  fprintf(HEAP_PROFILE,"foreach {label yData color stipple} $attributes {\n    .graph element create $yData -label $label -bd 1 \\\n	-ydata $yData -xdata X -fg ${color}3 -bg ${color}1 -stipple $stipple\n}\n");
-  fprintf(HEAP_PROFILE,".header.stacked invoke\n");
-  fprintf(HEAP_PROFILE,"scrollbar .xbar -command { .graph axis view x } -orient horizontal\nscrollbar .ybar -command { .graph axis view y } -orient vertical\n.graph axis configure x -scrollcommand { .xbar set } -logscale no -loose no\n.graph axis configure y -scrollcommand { .ybar set } -logscale no -loose no\n");
-  fprintf(HEAP_PROFILE,"table . \\\n    0,0 .title -fill x \\\n    1,0 .header -fill x  \\\n    2,0 .graph -fill both \\\n    3,0 .xbar -fill x \\\n    5,0 .footer -fill x\n");
-  fprintf(HEAP_PROFILE,"table configure . r0 r1 r3 r4 r5 -resize none\n");
-  fprintf(HEAP_PROFILE,"Blt_ZoomStack .graph\nBlt_Crosshairs .graph\nBlt_ActiveLegend .graph\nBlt_ClosestPoint .graph\n");
-  fprintf(HEAP_PROFILE,".graph marker bind all <B2-Motion> {\n    set coords [%%W invtransform %%x %%y]\n    catch { %%W marker configure [%%W marker get current] -coords $coords }\n}\n.graph marker bind all <Enter> {\n    set marker [%%W marker get current]\n    catch { %%W marker configure $marker -bg green}\n}\n.graph marker bind all <Leave> {\n    set marker [%%W marker get current]\n    catch { %%W marker configure $marker -bg \"\"}\n}\n");
-
-}
-
-
-/* -----------------------------------------------------------------------------
- * Read and create the raw profile data structure
- * -------------------------------------------------------------------------- */
-
-/* void readRawProfile(FILE *fptr,int *nonodes) { */
-
-void readRawProfile(FILE *fp,int *nonodes, int MaxNoNodes) {
-  char    stack[MAX_PROFILE_LINE_LENGTH];
-  int     i,nolines,sstepline,syncs;
-  char   *ptr,*drag;
-
-  float   comp_max,      comp_avg,      comp_min,          /* SYNCS    */
-          comm_max,      comm_avg,      comm_min,          /* COMP     */
-          comp_idle_max, comp_idle_avg, comp_idle_min;     /* COMM     */
-
-  /* Cost  relationships are comp=scc, comm=ticks, comp_idle=bytes */
-
-  long int hmax,havg,hmin;                                 /* COMPIDLE */
-
-  /* set to zero for now. Might use these later for heap costs. */
-
-  /* GHC specific variables */
-
-  int a,b,c,d,x,z,count, next;
-  int newloop;
-  char e[MAX_STRING_SIZE];
-  char f[MAX_STRING_SIZE];
-  char lline[MAX_PROFILE_LINE_LENGTH];
-
-  /* identifiers generated by the XML handler */
-  char *ccentre=">>cost_centre";
-  char *ccstack=">>cost_centre_stack";
-  char *sccsample=">>scc_sample";
-  char *heapsample=">>heap_sample";
-  char *heapupdate=">>heap_update";
-  char *heapobject=">>heap_object";
-  char *typeconstr=">>type_constr";
-  char *ending=">>";
-
-  /* FILE *fp; */
-
-  cc_matrix *cc_m;
-  ccs_matrix *ccs_m;
-  heap_object_matrix *ho_m;
-  type_constr_matrix *tc_m;
-  TheHeap *th;
-
-  FILE *HEAP_PROFILE;
-
-  HEAP_PROFILE = fopen("GHCbarchart.tcl", "w");
-  if (HEAP_PROFILE == NULL){
-   fprintf(stderr,"tcl script generator: ERROR- GHCbarchart.tcl cannot be created\a\n");
-    exit(1);
-  }
-
-  th = (p_TheHeap) malloc (sizeof(TheHeap));
-  cc_m = (p_cc_matrix) malloc (sizeof(cc_matrix));
-  //cc_m = (p_cc_matrix) calloc(MAX_IDENTIFIERS,sizeof(_cc_));
-  ccs_m = (p_ccs_matrix) malloc (sizeof(ccs_matrix));
-  ho_m  = (p_heap_object_matrix) malloc (sizeof(heap_object_matrix));
-  tc_m  = (p_type_constr_matrix) malloc (sizeof(type_constr_matrix));
-
-  /* End of GHC specific variables */
-
-  //fprintf(logFile,"Number 1 %i \n",MAX_IDENTIFIERS*sizeof(_cc_));
-  //fprintf(logFile,"Number 2 %i \n",sizeof(cc_matrix));
-
-  nolines=0; /* Number of lines read in from profile log file */
-
-  /* GHC specific */
-  count = 0;
-  next = 0;
-
-  initialise_cc_matrix(cc_m);
-  initialise_ccs_matrix(ccs_m);
-  initialise_heap_object_matrix(ho_m);
-  initialise_type_constr_matrix(tc_m);
-  initialise_TheHeap(th);
-
-  fprintf(logFile,"MAX_IDENTIFIERS = %i \n",MAX_IDENTIFIERS);
-  
-  /* end GHC specific */
-
-  /* CAF fixing */
-  fill_cc_matrix(cc_m,"CAF:REPOSITORY","PROFILER","PROFILER",MAX_IDENTIFIERS-1);
-  fill_ccs_matrix(ccs_m,MAX_IDENTIFIERS-1,1,0.0,0.0,0.0,0,-1,MAX_IDENTIFIERS-1);
-
-  /* 
-
-  This builds a node in the graph called CAF:REPOSITORY, which can be 
-  found off the root node. All CAFs are subsequently hung from this node
-  which means the node node can be hidden using the abstraction 
-  mechanisms provided by daVinci.
-
-  */
-
-
-  /* This is the GHC file handler which reads the lines from the profile log file and */
-  /* puts the stack and cost information in the raw profile data structure */
-
-   while (fscanf(fp,"%s",lline))
-   { 
-    /* Kill the end of the logfile with the ">>" string */
-    if (strcmp(lline,ending)==0) break;
-
-    /* Deal with the cost centres */
-    if (strcmp(ccentre,lline)==0)
-    {
-      next = fgetc(fp);
-      //while (fscanf(fp," %i %[^ ] %[^ ] %s", &z, e, f, g)!=0)
-      while (fscanf(fp," %i %[^ ] %s", &z, e, f)!=0)
-      {
-        fprintf(logFile,"Declaring cost centre `%i %s %s %s' \n",z,e,f,f);
-        fflush(logFile);
-        fill_cc_matrix(cc_m,e,f,f,z);
-        next = fgetc(fp);
-      }
-    }
-    else 
-    {
-
-      /* Deal with the cost centre stacks */
-      if (strcmp(ccstack,lline)==0)
-      { 
-        next = fgetc(fp);
-        while (fscanf(fp,"%i %i %i",&a,&d,&b)!=0)
-        {
-          if (d==1) /* of size one */
-          {  
-            fprintf(logFile,"Declaring cost centre stack `%i %i %i'\n",a,d,b);
-            fill_ccs_matrix(ccs_m,b,-1,(*ccs_m)[a].scc,(*ccs_m)[a].ticks,(*ccs_m)[a].bytes,0,-1,a);
-          }
-          if (d==2) /* of size > 1 */
-          { 
-            fscanf(fp," %i",&c);
-
-            /* CAF fixing */
-            fprintf(logFile,"Declaring cost centre stack `%i %i %i %i'\n",a,d,b,c);
-            if ((c==1)&&!(strncmp((*cc_m)[b].name,"CAF",2)))
-               // fill_ccs_matrix(ccs_m,b,MAX_IDENTIFIERS-1,(*ccs_m)[a].scc,(*ccs_m)[a].ticks,(*ccs_m)[a].bytes,0,-1,a);
-               /* The line above hangs all CAFs off the CAF:REPOSITORY node
-                  in the daVinci graph. For programs which have a small 
-                  number of CAFs this works nicely. However, when the 
-                  number of CAFs become very large (eg +200) then the 
-                  daVinci graph begins to look horid and, after (say)
-                  +500 CAF nodes, becomes very slow to load. So to 
-                  fix this we replace the code with the line below.
-               */
-                 if (!(strncmp((*cc_m)[b].name,"CAF:main",7)))
-                    /* Treat CAF:main as a normal node */ 
-                    fill_ccs_matrix(ccs_m,b,c,(*ccs_m)[a].scc,(*ccs_m)[a].ticks,(*ccs_m)[a].bytes,0,-1,a); 
-                    /* merge the rest */
-                 else
-                    //add_ccs_costs(ccs_m,0,MAX_IDENTIFIERS-1,(*ccs_m)[a].scc,(*ccs_m)[a].ticks,(*ccs_m)[a].bytes,0,0);
-                    fill_ccs_matrix(ccs_m,MAX_IDENTIFIERS-1,1,(*ccs_m)[a].scc,(*ccs_m)[a].ticks,(*ccs_m)[a].bytes,0,-1,a);
-                /* This does not even bother registering the new CAFs
-                   as daVinci nodes, but instead just merges the CAF
-                   with the CAF:REPOSITORY node. This greatly reduces
-                   the number of CAFs daVinci has to deal with, though
-                   may make the graph look a little different!
-
-                   Also note that now Simon has changed the semantics,
-                   you will want to treat adding CAF nodes in a 
-                   different way to adding normal program nodes
-                 */
-            else 
-               /* Normal mode */
-               fill_ccs_matrix(ccs_m,b,c,(*ccs_m)[a].scc,(*ccs_m)[a].ticks,(*ccs_m)[a].bytes,0,-1,a);
-          }
-          next = fgetc(fp);
-        }
-      } 
-      else
-      {
-
-        /* Deal with the scc_samples */
-        if (strcmp(sccsample,lline)==0)
-        {
-          next = fgetc(fp);
-          while (fscanf(fp,"%i %i %i %i",&a,&d,&b,&c))
-          {
-            fprintf(logFile,"Loading scc_samples `%i %i %i %i'\n",a,d,b,c);
-            add_ccs_costs(ccs_m,0,a,d,b,c,0,0);
-            next = fgetc(fp);
-          }
-        } /* end sccsample if */
-        else 
-        {
-        
-          /* Deal with the heap samples */
-          if (strcmp(heapsample,lline)==0)
-          {
-            next = fgetc(fp);
-            while (fscanf(fp,"%i %i %i",&a,&d,&b))
-            {
-              fprintf(logFile,"Loading heap_samples `%i %i %i'\n",a,d,b);
-              add_heap_sample_costs(ccs_m,0,a,0,0,0,d,b);
-              next = fgetc(fp);
-            }
-          } /* end heapsample if */
-          else 
-          {
-
-            /* Deal with the heap objects */
-            if (strcmp(heapobject,lline)==0)
-            {
-              next = fgetc(fp);
-              while (fscanf(fp,"%i %i",&a,&d)) 
-              {
-                if (d==1) 
-                {
-                  fscanf(fp," %s %i",e,&b);
-                  add_heap_object(ho_m,a,d,e,b);
-                }
-                else 
-                {
-                  fscanf(fp," %s",e);
-                  add_heap_object(ho_m,a,d,e,-1);
-                }
-                next = fgetc(fp);
-              }
-            } /* end heapobject if */
-            else
-            {
-
-              /* Deal with the type constructors */ 
-              if (strcmp(typeconstr,lline)==0)
-              {
-                next = fgetc(fp);
-                while (fscanf(fp,"%i %s %s",&a,e,f))
-                {
-                  add_type_constr_object(tc_m,a,e,f);
-                  next = fgetc(fp);
-                }
-              } /* end type constructor if */
-              else
-              {
-                
-                /* Deal with the heap_updates */ 
-                if (strcmp(heapupdate,lline)==0)
-                {
-                  next = fgetc(fp);
-                  while (fscanf(fp,"%i %i %i %i %i %i",&a,&d,&b,&c,&z,&x))
-                  {
-                    add_to_TheHeap(th,a,b,c,z);
-                    fprintf(logFile,"Adding heap sample %i %i %i %i\n",a,b,c,z);
-                    while (x) /* more than one sample */
-                    {
-                      fscanf(fp," %i %i %i %i",&b,&c,&z,&x);
-                      add_to_TheHeap(th,a,b,c,z);
-                      fprintf(logFile,"Adding heap sample %i %i %i %i\n",a,b,c,z);
-                    }  
-                    next = fgetc(fp);
-                  }
-
-                } /* end heap update if */
-
-              }  /* end type constructor else */
-
-             } /* end heapobject else */
-
-           } /* end heapsample else */
-         } /* end sccsample else */
-       } /* end ccstack else */
-     } /* end ccstack if */
-   } /* end while */
-
-   print_cc_matrix(cc_m);
-   print_ccs_matrix(ccs_m);
-   fprintf(logFile,"There are %i stacks\n",CountStacks(ccs_m));
-   print_type_constr_matrix(tc_m);
-
-   /* Functions for heap profile */
-   print_TheHeap(th);
-   fprintf(logFile,"The units for the x axis are \n");
-   PrintXaxis(logFile,th);
-   fprintf(logFile,"\n");
-   fprintf(logFile,"There are %i distinct heap objects\n",number_of_heap_objects(ho_m));
-   names_of_heap_objects(logFile,ho_m);
-   names_and_colour_assignment(logFile,ho_m);
-   print_heap_object_matrix(logFile,th,ho_m);
-
-   PrintAllStacks(ccs_m,cc_m);
-   /* comment out line below to remove the heap profile generator */
-   produce_HEAP_PROFILE(HEAP_PROFILE,th,ho_m);
-   fclose(HEAP_PROFILE);
-
-   /* End of GHC file handler */
-  
-
-  /* Now process the stack matrix */ 
-
-  for (newloop=0;newloop<MAX_IDENTIFIERS;newloop++) 
-  { if ((*ccs_m)[newloop].cc != 0)
-    {
-         
-    sstepline = 0;
-    FormStack2(ccs_m,cc_m,newloop,stack);
-
-    syncs = 0;     
-    comp_max = (float)(*ccs_m)[newloop].scc; 
-    comp_avg = (float)(*ccs_m)[newloop].scc; 
-    comp_min = (float)(*ccs_m)[newloop].scc; 
-    comm_max = (float)(*ccs_m)[newloop].ticks; 
-    comm_avg = (float)(*ccs_m)[newloop].ticks; 
-    comm_min = (float)(*ccs_m)[newloop].ticks; 
-    comp_idle_max = (float)(*ccs_m)[newloop].bytes; 
-    comp_idle_avg = (float)(*ccs_m)[newloop].bytes; 
-    comp_idle_min = (float)(*ccs_m)[newloop].bytes; 
-    hmax = 0.0; havg = 0.0; hmin = 0.0; 
-
-      /* Dynamic memory allocation for raw_profile data structure */ 
-
-      if (raw_profile_next==raw_profile_size) enlargeRawProfile();
-
-      /* Assign data from single logfile entry to raw_profile data structure */
-      /* this deals with the cost metrics */
-
-      raw_profile[raw_profile_next].active            = 1;
-      raw_profile[raw_profile_next].cost.syncs        = syncs;
-      raw_profile[raw_profile_next].cost.comp_max     = comp_max;
-      raw_profile[raw_profile_next].cost.comp_avg     = comp_avg;
-      raw_profile[raw_profile_next].cost.comp_min     = comp_min;
-      raw_profile[raw_profile_next].cost.comm_max     = comm_max;
-      raw_profile[raw_profile_next].cost.comm_avg     = comm_avg;
-      raw_profile[raw_profile_next].cost.comm_min     = comm_min;
-      raw_profile[raw_profile_next].cost.comp_idle_max= comp_idle_max;
-      raw_profile[raw_profile_next].cost.comp_idle_avg= comp_idle_avg;
-      raw_profile[raw_profile_next].cost.comp_idle_min= comp_idle_min;
-      raw_profile[raw_profile_next].cost.hrel_max     = hmax;
-      raw_profile[raw_profile_next].cost.hrel_avg     = havg;
-      raw_profile[raw_profile_next].cost.hrel_min     = hmin;
-
-      /* this deals with the stack itself */
-
-      raw_profile[raw_profile_next].stack=calloc(MAX_STACK_DEPTH,
-						 sizeof(int));
-      if (raw_profile[raw_profile_next].stack==NULL) {
-        fprintf(stderr,"{readRawProfile} unable to allocate stack entry");
-        exit(1);
-      }
-
-      fprintf(logFile,"STACK=\"%s\"\n",stack);
-      raw_profile[raw_profile_next].stack_size=1;
-      /* move the stack read frame to the first space (or comma) in the stack string */ 
-      for(ptr=stack; ((*ptr)!=' ') && (*ptr!=',');ptr++) {}
-      fprintf(logFile,"TOS=%d at line %d\n",*ptr,sstepline);
-     
-      /* to distinguish the head of the stack from the rest */
-      /* if read frame points to space you are at the head of the stack */
-      if (*ptr==' ') 
-        /* raw_profile[raw_profile_next].stack[0]
-          =lookupSymbolTable(CG_SSTEP,sstepline,(*ptr='\0',stack)); */
-        /* This line has changed as GHC treats its cost-centres in a different     */
-        /* way to BSP. There is no distinction between 'a cost centre at line x'   */
-        /* and a normal cost centre. The fix is easy, just treat all cost centres, */
-        /* even those at the head of the stack in the same way.                    */
-           raw_profile[raw_profile_next].stack[0]
-          =lookupSymbolTable(CG_STACK,sstepline,(*ptr='\0',stack));
-      else
-      /* otherwise you are looking at just another stack element */
-        raw_profile[raw_profile_next].stack[0]
-          =lookupSymbolTable(CG_STACK,sstepline,(*ptr='\0',stack));
-
-      ptr++; /* move the read frame on one */
-      drag=ptr;
-      for(;*ptr;ptr++) { /* find the next element in the stack */
-        if (*ptr==',') {
-	  *ptr='\0';
-          if (Verbose) fprintf(logFile,"NAME=\"%s\"\n",drag); /* name of the next element */
-          if (!ignore_function(drag)) {
-            raw_profile[raw_profile_next].stack[
-              raw_profile[raw_profile_next].stack_size++]
-              = lookupSymbolTable(CG_STACK,0,drag); /* add element to the raw_profile */
-	  }
-          drag = ptr+1;
-        }
-      }
-
-      /* create cost object */
-
-      raw_profile[raw_profile_next].cost.proc
-	=calloc(bsp_p,sizeof(object_cost_proc));
-      if (raw_profile[raw_profile_next].cost.proc==NULL) {
-	fprintf(stderr,"Unable to allocate storage");
-	exit(0);
-      }
-  
-      /* process the HREL information - one set for every BSP process */
-
-      for(i=0;i<bsp_p;i++) {
-
-         raw_profile[raw_profile_next].cost.proc[i].proc_comp     = 0.0; 
-         raw_profile[raw_profile_next].cost.proc[i].proc_comm     = 0.0; 
-         raw_profile[raw_profile_next].cost.proc[i].proc_comp_idle= 0.0; 
-         raw_profile[raw_profile_next].cost.proc[i].proc_hrel_in  = 0; 
-         raw_profile[raw_profile_next].cost.proc[i].proc_hrel_out = 0; 
-
-      }
-
-      raw_profile_next++;    /* Increase the raw profile data structure counter */
-      nolines++;             /* Increase the number of lines read               */
-
-       strcpy(stack,""); /* reset the stack */
-    } /* end of new if statement */
-  } /* end of new for loop */
-
-  *nonodes = symbol_table_next;
-  fprintf(logFile,"%s: read %d lines from profile.Graph contains %i nodes.\n",
-          Pgm,nolines,symbol_table_next);
-
-  free_cc_matrix(cc_m); /* be nice and clean up the cost centre matrix */
-}
-
-/* -----------------------------------------------------------------------------
- * Pretty print the raw profile data
- * -------------------------------------------------------------------------- */
-
-void printRawProfile() {
-  int i,j;
-  object_cost *cost;
-  int         *stack;
-  
-  fprintf(logFile,"\n\nRAW DATA:\n");
-  for(i=0;i<raw_profile_next;i++) {
-    cost  = &raw_profile[i].cost;
-    stack = raw_profile[i].stack;
-    fprintf(logFile,"Stack=[");
-    for(j=0;j<raw_profile[i].stack_size;j++) 
-      printSymbolTable_entry(stack[j]);
-    fprintf(logFile,"] %d Syncs %f Comp %f Comm %f Wait\n\n",
-	    cost->syncs,cost->comp_max,cost->comm_max,cost->comp_idle_max);
-  }
-}
-
-/* -----------------------------------------------------------------------------
- * Create connectivity matrix
- * -------------------------------------------------------------------------- */
-
-void createConnectivityMatrix(int NoNodes,Matrix *graph,
-			      Matrix *costs,int *root, int inherit) {
-  object_cost zero_cost,*update;
-  int i,j,this,next;
-
-
-  zero_cost.comp_max     =0.0;
-  zero_cost.comp_avg     =0.0;
-  zero_cost.comp_min     =0.0;
-  zero_cost.comm_max     =0.0;
-  zero_cost.comm_avg     =0.0;
-  zero_cost.comm_min     =0.0;
-  zero_cost.comp_idle_max=0.0;
-  zero_cost.comp_idle_avg=0.0;
-  zero_cost.comp_idle_min=0.0;
-  zero_cost.hrel_max     =0;
-  zero_cost.hrel_avg     =0;
-  zero_cost.hrel_min     =0;
-  zero_cost.syncs=0;
-  zero_cost.proc = NULL;
-  *graph = newMat(NoNodes,NoNodes,sizeof(int),(i=0,&i));
-  *costs = newMat(NoNodes,1,sizeof(object_cost),&zero_cost);
-  for(i=0;i<NoNodes;i++) {
-    update=&Mat(object_cost,*costs,i,0);
-    update->proc=calloc(bsp_p,sizeof(object_cost_proc));
-    if (update->proc==NULL){
-      fprintf(stderr,"Unable to allocate storage");
-      exit(0);
-    }
-    for(j=0;j<bsp_p;j++) {
-      update->proc[j].proc_comp      =0.0;
-      update->proc[j].proc_comm      =0.0;
-      update->proc[j].proc_comp_idle =0.0;
-      update->proc[j].proc_hrel_in   =0;
-      update->proc[j].proc_hrel_out  =0;
-    }
-  }
-      
-  for(i=0;i<raw_profile_next;i++) {
-    if (raw_profile[i].active) {
-      this = raw_profile[i].stack[0];
-      next = this;
-      Mat(int,*graph,this,next) = 1;
-      update = &Mat(object_cost,*costs,next,0);
-      add_costs(update,raw_profile[i].cost);
-      for(j=1;j<raw_profile[i].stack_size;j++) {
-        this = next;
-        next = raw_profile[i].stack[j];
-        Mat(int,*graph,next,this)=1;
-	update = &Mat(object_cost,*costs,next,0);
-        /* include this line for INHERITANCE; remove it for not! */
-        if (inherit) add_costs(update,raw_profile[i].cost);
-      }
-    }
-  }
-  *root =  raw_profile[0].stack[raw_profile[0].stack_size-1];
-
-  /* Check graph isn't empty */
-  if (!Mat_dense(*costs,*root,0)) *root=-1;
-}
-
-void printConnectivityMatrix(Matrix graph,Matrix costs,int root) { 
-  int i,j;
-  object_cost cost;
-
-  fprintf(logFile,"Root node is %d\n",root);
-  for(i=0;i<graph.rows;i++) {
-    fprintf(logFile,"%4d)",i);
-    printSymbolTable_entry(i);
-    cost = Mat(object_cost,costs,i,0);
-    fprintf(logFile,"%d %f %f %f\n\tBranch=[",
-	    cost.syncs,cost.comp_max,cost.comm_max,cost.comp_idle_max);
-    for(j=0;j<graph.cols;j++) 
-      if (Mat_dense(graph,i,j)) fprintf(logFile,"%d ",j);
-    fprintf(logFile,"]\n\n");
-  }
-}
diff --git a/ghc/utils/prof/cgprof/cgprof.h b/ghc/utils/prof/cgprof/cgprof.h
deleted file mode 100644
index e93f02b53e..0000000000
--- a/ghc/utils/prof/cgprof/cgprof.h
+++ /dev/null
@@ -1,82 +0,0 @@
-/* ------------------------------------------------------------------------
- * $Id: cgprof.h,v 1.2 2003/08/01 14:50:50 panne Exp $
- *									
- *	Copyright (C) 1995-2000 University of Oxford
- *									
- * Permission to use, copy, modify, and distribute this software,
- * and to incorporate it, in whole or in part, into other software,
- * is hereby granted without fee, provided that
- *   (1) the above copyright notice and this permission notice appear in
- *	 all copies of the source code, and the above copyright notice
- *	 appear in clearly visible form on all supporting documentation
- *	 and distribution media;
- *   (2) modified versions of this software be accompanied by a complete
- *	 change history describing author, date, and modifications made;
- *	 and
- *   (3) any redistribution of the software, in original or modified
- *	 form, be without fee and subject to these same conditions.
- * --------------------------------------------------------------------- */
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <limits.h>
-#include "symbol.h"
-#include "matrix.h"
-
-/* -----------------------------------------------------------------------------
- * Data structures associated with parsed data
- * -------------------------------------------------------------------------- */
-
-/* -----------------------------------------------------------------------------
- * Cost attributes
- * -------------------------------------------------------------------------- */
-
-#ifndef _CGPROF_H_
-#define _CGPROF_H_
-
-typedef struct {
-  double   proc_comp;
-  double   proc_comm;
-  double   proc_comp_idle;
-  long int proc_hrel_in;
-  long int proc_hrel_out;
-} object_cost_proc;
-
-typedef struct {
-  double   comp_max,      comp_avg,      comp_min;
-  double   comm_max,      comm_avg,      comm_min;
-  double   comp_idle_max, comp_idle_avg, comp_idle_min;
-  long int hrel_max,      hrel_avg,      hrel_min;
-  object_cost_proc *proc;
-  int    syncs;
-} object_cost;
-
-/* -----------------------------------------------------------------------------
- * Sequence of cost centres
- * -------------------------------------------------------------------------- */
-
-typedef struct {
-  object_cost  cost;
-  name_id     *stack;
-  int          stack_size;
-  int          active;
-} parsed_cost_object;
-
-#define RAW_PROFILE_INIT_SIZE 100
-extern int                 raw_profile_next;
-extern int                 raw_profile_size;
-extern parsed_cost_object *raw_profile;
-
-/* -----------------------------------------------------------------------------
- * Misc.
- * -------------------------------------------------------------------------- */
-
-extern int   Verbose;
-extern char *Pgm;
-extern void readRawProfile(FILE *,int*,int);
-extern void printRawProfile();
-extern void add_costs(object_cost *,object_cost);
-extern void createConnectivityMatrix(int,Matrix *,Matrix *,int *,int);
-extern void printConnectivityMatrix(Matrix,Matrix,int);
-extern FILE* logFile;
-#endif
diff --git a/ghc/utils/prof/cgprof/daVinci.c b/ghc/utils/prof/cgprof/daVinci.c
deleted file mode 100644
index 0a59d1c89e..0000000000
--- a/ghc/utils/prof/cgprof/daVinci.c
+++ /dev/null
@@ -1,760 +0,0 @@
-/* ------------------------------------------------------------------------
- * $Id: daVinci.c,v 1.5 2006/01/09 14:38:01 simonmar Exp $
- *									
- *	Copyright (C) 1995-2000 University of Oxford
- *									
- * Permission to use, copy, modify, and distribute this software,
- * and to incorporate it, in whole or in part, into other software,
- * is hereby granted without fee, provided that
- *   (1) the above copyright notice and this permission notice appear in
- *	 all copies of the source code, and the above copyright notice
- *	 appear in clearly visible form on all supporting documentation
- *	 and distribution media;
- *   (2) modified versions of this software be accompanied by a complete
- *	 change history describing author, date, and modifications made;
- *	 and
- *   (3) any redistribution of the software, in original or modified
- *	 form, be without fee and subject to these same conditions.
- * --------------------------------------------------------------------- */
-
-#include "daVinci.h"
-#include <stdarg.h>
-#include <string.h>
-#include <ctype.h>
-
-static char* extra_space(int);
-static void recur_graphToDaVinci(int,Matrix *, Matrix *,char*,int);
-static char *parse_word(char**);
-static char *parse_quoted(char**);
-static char *dup_str(char*);
-double this_total_time,
-       this_total_comp_max, this_total_comp_avg,
-       this_total_comm_max, this_total_comm_avg, 
-       this_total_comp_idle_max, this_total_comp_idle_avg;
-long int this_hrel_max, this_hrel_avg;
-int  this_syncs;
-
-char *lastDavinciCmd;
-
-/* -----------------------------------------------------------------------------
- * Send a command with ok return value daVinci
- * -------------------------------------------------------------------------- */
-
-void cmdDaVinci(char* format,...) {
-  va_list args;
-
-  va_start(args, format);
-  vfprintf(stdout, format, args);
-  fprintf(stdout, "\n");
-  va_end(args);
-  fflush(stdout); 
-  lastDavinciCmd = format;
-}
-
-/* -----------------------------------------------------------------------------
- * Initialise daVinci
- * -------------------------------------------------------------------------- */
-
-void initDaVinci() {
-  cmdDaVinci("window(title(\"GHC profiler: cost-centre-stack view\"))\n");
-  cmdDaVinci("set(font_size(8))");  
-  cmdDaVinci("set(animation_speed(0))");
-  cmdDaVinci("set(scrolling_on_selection(false))");
-  /* SAJ */
-  /* cmdDaVinci("set(no_cache(true)))"); */
-  cmdDaVinci("app_menu(create_icons(["
-                  "icon_entry(\"delete\","
-                             "\"delete.xbm\","
-                             "\"Delete node and its children\"),"
-                  "icon_entry(\"undo\","
-                             "\"undo.xbm\","
-                             "\"Undo delete\"),"
-                  "blank,"
-                  "icon_entry(\"time\","
-                             "\"time.xbm\","
-                             "\"Cost metric view\"),"
-                  "icon_entry(\"percent\","
-                             "\"percent.xbm\","
-                             "\"Percentage view\"),"
-                  "blank,"
-                  "icon_entry(\"compress\","
-                             "\"compress.xbm\","
-                             "\"Compressed node view\"),"
-                  "icon_entry(\"uncompress\","
-                             "\"uncompress.xbm\","
-                             "\"Uncompressed node view\"),"
-                  "blank,"
-                  "icon_entry(\"absolute\","
-                             "\"absolute.xbm\","
-                             "\"Display inherited profile results\"),"
-                  "icon_entry(\"absdelta\","
-                             "\"absdelta.xbm\","
-                             "\"Display flat profile results\"),"
-                  "icon_entry(\"reldelta\","
-                             "\"reldelta.xbm\","
-                             "\"Trim zero-cost sub-trees\"),"
-                  "icon_entry(\"weightdelta\","
-                             "\"weightdelta.xbm\","
-                             "\"Trim zero-cost nodes\"),"
-                  "blank,"
-	          "icon_entry(\"sync\","
-                             "\"sync.xbm\","
-                             "\"Graph view\"),"
-                  "icon_entry(\"comp\","
-                             "\"comp.xbm\","
-                             "\"SCCs critical path\"),"
-                  "icon_entry(\"comm\","
-                             "\"comm.xbm\","
-                             "\"Computation time critical path\"),"
-                  "icon_entry(\"wait\","
-                             "\"wait.xbm\","
-                             "\"Heap usage critical path\"),"
-                  "icon_entry(\"hrel\","
-                             "\"hrel.xbm\","
-                             "\"Node spy\"),"
-                  "blank,"
-	          "icon_entry(\"help\","
-                             "\"help.xbm\","
-                             "\"Help\"),"
-              "]))");
-
-  activateDaVinciMenu("default");     
-  cmdDaVinci("app_menu(create_menus([menu_entry_mne(\"jump\",\"Goto a node\",\"G\",control,\"G\")]))\n");
-  /* SAJ */
-  // cmdDaVinci("app_menu(activate_menus([\"jump\"]))"); 
-}
-
-/* -----------------------------------------------------------------------------
- * Menu FSM
- * -------------------------------------------------------------------------- */
-
-void activateDaVinciMenu(char *pressed) {
-  static int compress=1,time=1,critical_type=0,critical=0,undo=1,delete=0;
-
-  if (strcmp(pressed,"absolute")==0)    critical_type=0;
-  if (strcmp(pressed,"absdelta")==0)    critical_type=1;
-  if (strcmp(pressed,"reldelta")==0)    critical_type=2;
-  if (strcmp(pressed,"weightdelta")==0) critical_type=3;
-
-  if (strcmp(pressed,"sync")==0)  critical=0;
-  if (strcmp(pressed,"comp")==0)  critical=1;
-  if (strcmp(pressed,"comm")==0)  critical=2;
-  if (strcmp(pressed,"wait")==0)  critical=3;
-  if (strcmp(pressed,"hrel")==0)  critical=4;
-
-  if (strcmp(pressed,"compress")==0 || strcmp(pressed,"uncompress")==0) 
-    compress=!compress;
-
-  if (strcmp(pressed,"time")==0 || strcmp(pressed,"percent")==0)
-    time=!time;
-
-  if (strcmp(pressed,"undo")==0)   {undo=!undo;}
-  if (strcmp(pressed,"delete")==0) {delete=!delete;}
-
-  printf("app_menu(activate_icons([");
-  if (critical_type!=0) printf("\"absolute\",");
-  if (critical_type!=1) printf("\"absdelta\",");
-  if (critical_type!=2) printf("\"reldelta\",");
-  if (critical_type!=3) printf("\"weightdelta\",");
-
-  if (critical!=0) printf("\"sync\",");
-  if (critical!=1) printf("\"comp\",");
-  if (critical!=2) printf("\"comm\",");
-  if (critical!=3) printf("\"wait\",");
-  if (critical!=4) printf("\"hrel\",");
-
-  if (!compress)   printf("\"compress\",");
-  if (compress)    printf("\"uncompress\",");
-  if (!time)       printf("\"time\",");
-  if (time)        printf("\"percent\",");
-  if (!delete)     printf("\"delete\",");
-  if (!undo)       printf("\"undo\",");
-  
-  cmdDaVinci("\"help\"]))");  
-}
-
-/* -----------------------------------------------------------------------------
- * Graph to daVinci
- * -------------------------------------------------------------------------- */
-
-void graphToDaVinci(int root,Matrix *graph, Matrix *costs, int removezerocosts) {
-  int i,j;
-  object_cost *ptr;
-  char zeronodes[MAX_PROFILE_LINE_LENGTH*2];     // is this a sen. MAX
-  char TEMPzeronodes[MAX_PROFILE_LINE_LENGTH*2];
-  char* p_zeronodes = zeronodes;
-  char* TEMPp_zeronodes = TEMPzeronodes;
- 
-  printf("graph(new([");
-  if (PrintLogo) {
-    /* I have implemented some name changes here. They are purely for output and */
-    /* following the relation (comp = scc, comm = ticks, wait = bytes            */
-    printf("l(\"info\",n(\"\",["
-	   "a(\"COLOR\",\"gold\"),"
-	   "a(\"FONTFAMILY\",\"courier\"),"
-	   //"a(\"_GO\",\"icon\"),"
-	   //"a(\"ICONFILE\",\"oxpara.xbm\"),"
-	   "a(\"OBJECT\",\""
-           "Program statistics\\n\\n"
-	   "Time elapsed     =  %6.2f ticks\\n"
-	   "Heap usage       =  %6.2f bytes\\n"
-	   "Total scc count  =  %6.2f (scc)\\n"
-	   "\")],[])),",
-           TotalComm,TotalCompIdle,
-	   TotalComp
-	   );
-  } 
-
-  if (root==-1) {
-    printf("]))\n");
-  } else {
-    ptr = &Mat(object_cost,*costs,root,0);
-    this_total_comp_max     = ptr->comp_max;
-    this_total_comp_avg     = ptr->comp_avg;
-    this_total_comm_max     = ptr->comm_max;
-    this_total_comm_avg     = ptr->comm_avg;
-    this_total_comp_idle_max= ptr->comp_idle_max;
-    this_total_comp_idle_avg= ptr->comp_idle_avg;
-    this_total_time         = 0.00001 + 
-                              this_total_comp_max+ this_total_comm_max;
-    this_hrel_max       = ptr->hrel_max;
-    this_hrel_avg       = ptr->hrel_avg;
-    this_syncs          = ptr->syncs;
-    recur_graphToDaVinci(root,graph,costs,p_zeronodes,removezerocosts);
-
-    printf("]))\n");
-    fflush(stdout);
-    cmdDaVinci("special(focus_node(\"%d\"))\n",root);
-
-    /* graph will have been altered so that visted elements are marked
-       by a negative value. These are reset */
-    for(i=0;i<graph->rows;i++) {
-      for(j=0;j<graph->cols;j++) {
-        if (Mat_dense(*graph,i,j))
-          if (Mat(int,*graph,i,j)<0) Mat(int,*graph,i,j)=1;
-      }
-    }
-
-    if (removezerocosts==1)
-    {
-      if (strlen(p_zeronodes)>0) 
-         { strncpy(TEMPp_zeronodes,p_zeronodes,strlen(p_zeronodes)-1);
-           printf("select_nodes_labels([%s])\n",TEMPp_zeronodes);
-         }
-      strcpy(TEMPp_zeronodes,"");
-      strcpy(p_zeronodes,"");
-    }
-  }
-}
-
-static char *printCompressNode(int node, object_cost *ptr) {
-  char name[MAX_FUNNAME+20];
-  char comp[MAX_FUNNAME+20];
-  char comm[MAX_FUNNAME+20];
-  static char res[(MAX_FUNNAME+20)*4];
-  char tempstring[MAX_FUNNAME+20];
-  char *padding;
-  int x;
-  char delimiter[] = "&";
-
-  if (symbol_table[node].type==CG_SSTEP) 
-    sprintf(name,"%d %s",
-	    symbol_table[node].lineno,symbol_table[node].filename);
-  else
-  { 
-    strcpy(tempstring,symbol_table[node].filename);
-    sprintf(name,"%s",strtok(tempstring,delimiter));
-  }  
-
-  if (NodeviewTime) {
-    /* changed this for GHC stats */
-    sprintf(comp,"\\nTime  %6.2fticks\\n",ptr->comm_max);
-    sprintf(comm,"Bytes %6.2funits",ptr->comp_idle_max);
-  } else {
-    sprintf(comp,"\\nTime  %6.2f%%\\n",(ptr->comm_max/TotalComm)*100.0);
-    sprintf(comm,"Bytes %6.2f%%",(ptr->comp_idle_max/TotalCompIdle)*100.0);
-  }
-  /* Slightly arbitrary choice for max display length of CC string */
-  /* If it is larger than this the display nodes look bad */
-  if (strlen(name)>20) name[20]='\0';
-  x=strlen(name);
-  if (((20-(strlen(name)+3))/2)>19)
-     padding = extra_space(0);
-  else
-     padding = extra_space((20-(strlen(name)+3))/2); /* includes \\n */
-  strcpy(res,padding);
-  strcat(res,name);
-  strcat(res,comp);
-  strcat(res,comm);
-  return res;
-}
-
-static char *printUncompressNode(int node, object_cost *ptr) {
-  char name   [MAX_FUNNAME+40];
-  char module [MAX_FUNNAME+40];
-  char group  [MAX_FUNNAME+40];
-  char head [MAX_FUNNAME+40];
-  char comp [MAX_FUNNAME+40];
-  char comm [MAX_FUNNAME+40];
-  char wait [MAX_FUNNAME+40];
-  char hrel [MAX_FUNNAME+40];
-  char tempstring[MAX_FUNNAME+20];
-  char tempstring2[MAX_FUNNAME+20];
-  char *tempstring3;
-  char *tempstring5;
-  char tempstring4[MAX_FUNNAME+20];
-  char delimiter[] = "&";
-
-
-  static char res[(MAX_FUNNAME+40)*7];
-  char *padding;
-  int width=0,x;
-
-  if (symbol_table[node].type==CG_SSTEP) 
-    sprintf(name,"%s line %d\\n",
-	    symbol_table[node].filename,symbol_table[node].lineno);
-  else
-  {
-    strcpy(tempstring,symbol_table[node].filename);
-    strcpy(tempstring2,symbol_table[node].filename);
-    sprintf(name,"%s",strtok(tempstring,delimiter));
-    strcpy(tempstring4,tempstring2);
-    tempstring5 = strpbrk(tempstring4,delimiter);
-    sprintf(module,"%s",strtok(tempstring5+1,delimiter));
-    tempstring3 = strrchr(tempstring2,'&');
-    sprintf(group,"%s",tempstring3+1);
-  }
-
-  if (NodeviewTime) {
-
-    sprintf(head, "Metric   Total  \\n");
-    sprintf(comp, " Time    %6.2ft \\n",ptr->comm_max);
-    sprintf(comm, " Bytes   %6.2fu \\n",ptr->comp_idle_max);
-    sprintf(wait, " SCC     %6.2fc \\n",ptr->comp_max);
-
-
-  } else {
-
-    sprintf(head, "Metric   Total  \\n");
-    sprintf(comp, " Time    %5.1f%% \\n",100.0*SAFEDIV(ptr->comm_max,TotalComm));
-    sprintf(comm, " Bytes   %5.1f%% \\n",100.0*SAFEDIV(ptr->comp_idle_max,TotalCompIdle));
-    sprintf(wait, " SCC     %5.1f%% \\n",100.0*SAFEDIV(ptr->comp_max,TotalComp));
-
-  }
-	  
-  if ((x=strlen(name))>width)  width=x;
-  if ((x=strlen(hrel))>width)  width=x;
-  padding = extra_space((width-strlen(name)+3)/2); /* includes \\n */
-  /* strcpy(res,padding); */
-  strcpy(res,"Cost centre: ");
-  strcat(res,name);
-  strcat(res,"\\n");
-  strcat(res,"Module     : ");
-  strcat(res,module);
-  strcat(res,"\\n");
-  strcat(res,"Group      : ");
-  strcat(res,group);
-  strcat(res,"\\n\\n");
- 
-  strcat(res,head);
-  strcat(res,comp);
-  strcat(res,comm);
-  strcat(res,wait);
-  /* strcat(res,hrel); */
-  return res;
-}
-
-
-double nodeColour(object_cost *cost) {
-
-  switch (CriticalPath + CriticalType) {
-  case CRITTYPE_ABSOLUTE+CRITICAL_SYNCS:      
-  case CRITTYPE_ABSDELTA+CRITICAL_SYNCS:      
-  case CRITTYPE_RELDELTA+CRITICAL_SYNCS:      
-  case CRITTYPE_WEIGHTDELTA+CRITICAL_SYNCS:
-    return SAFEDIV(((double)cost->syncs),((double)this_syncs));
-
-  case CRITTYPE_ABSOLUTE+CRITICAL_COMP:       
-    return SAFEDIV(cost->comp_max,this_total_comp_max);
-
-  case CRITTYPE_ABSOLUTE+CRITICAL_COMM:       
-    return SAFEDIV(cost->comm_max,this_total_comm_max);
-
-  case CRITTYPE_ABSOLUTE+CRITICAL_WAIT:       
-    return SAFEDIV(cost->comp_idle_max,this_total_comp_idle_max);
-
-  case CRITTYPE_ABSOLUTE+CRITICAL_HREL:       
-    return SAFEDIV(((double) cost->hrel_max),((double)this_hrel_max));
-
-  case CRITTYPE_ABSDELTA+CRITICAL_COMP:
-    return SAFEDIV(cost->comp_max,TotalComp);
-
-  case CRITTYPE_ABSDELTA+CRITICAL_COMM:
-    return SAFEDIV(cost->comm_max,TotalComm);
-
-  case CRITTYPE_ABSDELTA+CRITICAL_WAIT:
-    return SAFEDIV(cost->comp_idle_max,TotalCompIdle);
-
-  case CRITTYPE_ABSDELTA+CRITICAL_HREL:
-    return SAFEDIV(((double) (cost->hrel_max - cost->hrel_avg)),
-	           ((double) (this_hrel_max-this_hrel_avg)));
-
-  case CRITTYPE_RELDELTA+CRITICAL_COMP:
-   return SAFEDIV((cost->comp_max-cost->comp_avg),
-                  (cost->comp_avg*DeltaNormalise));
-
-  case CRITTYPE_RELDELTA+CRITICAL_COMM:
-   return SAFEDIV((cost->comm_max-cost->comm_avg),
-           (cost->comm_avg*DeltaNormalise));
-
-  case CRITTYPE_RELDELTA+CRITICAL_WAIT:
-   return SAFEDIV((cost->comp_idle_max-cost->comp_idle_avg),
-                  (cost->comp_idle_avg*DeltaNormalise));
-
-  case CRITTYPE_RELDELTA+CRITICAL_HREL:
-    return SAFEDIV(((double) (cost->hrel_max - cost->hrel_avg)),
-	           ((double) (cost->hrel_avg*DeltaNormalise)));
-
-  case CRITTYPE_WEIGHTDELTA+CRITICAL_COMP:
-   return (SAFEDIV((cost->comp_max-cost->comp_avg),
-                   (cost->comp_avg*DeltaNormalise))*
-	   SAFEDIV(cost->comp_max,this_total_comp_max));
-
-  case CRITTYPE_WEIGHTDELTA+CRITICAL_COMM:
-   return (SAFEDIV((cost->comm_max-cost->comm_avg),
-                   (cost->comm_avg*DeltaNormalise))*
-           SAFEDIV(cost->comm_max,this_total_comm_max));
-
-  case CRITTYPE_WEIGHTDELTA+CRITICAL_WAIT:
-   return (SAFEDIV((cost->comp_idle_max-cost->comp_idle_avg),
-                   (cost->comp_idle_avg*DeltaNormalise))*
-	   SAFEDIV(cost->comp_idle_max,this_total_comp_idle_max));
-
-  case CRITTYPE_WEIGHTDELTA+CRITICAL_HREL:
-    return (SAFEDIV(((double) (cost->hrel_max - cost->hrel_avg)),
-	            ((double) (cost->hrel_avg*DeltaNormalise)))*
-	    SAFEDIV(((double) cost->hrel_max),((double)this_hrel_max)));
-
-  }
-  return 0.0;
-}
-
-int percentToColour(double colour) {
-  int range=255,base=0;
-
-  if (!Colour) {
-    base =100;
-    range=155;
-  }
-  if      (colour>1.0) return (base+range);
-  else if (colour<0.0) return base;
-  else return (((int) (((double)range)*colour))+base);
-}
-
-/* -----------------------------------------------------------------------------
- * Recursively draw the graph
- * -------------------------------------------------------------------------- */
-
-static void recur_graphToDaVinci(int node,Matrix *graph,Matrix *costs,char* p_zeronodes, int mode){
-  object_cost *ptr;
-  int i,j,no_children=0,*children=NULL,colour;
-  char *node_str;
-  char tempnode[MAX_FUNNAME];
-  if (Mat(int,*graph,node,node)<0) {
-    printf("r(\"%d\") ",node);
-  } else {
-    for(i=0;i<graph->cols;i++) 
-      if (node!=i && Mat_dense(*graph,node,i)) no_children++;
-  
-    if (no_children>0) {
-      children = calloc(no_children,sizeof(int));
-      if (children==NULL) {
-        fprintf(stderr,"{printDaVinci} unable to allocate %d ",no_children);
-        exit(1);
-      }
-      for((i=0,j=0);i<graph->cols;i++)
-        if (node!=i && Mat_dense(*graph,node,i)) children[j++]=i;
-
-      qsort(children,no_children,sizeof(int),
-	    (int (*)(const void *,const void *)) cmp_symbol_entry);
-    }
-    ptr = &Mat(object_cost,*costs,node,0);
-    node_str=(NodeviewCompress)?
-	        printCompressNode(node,ptr):
-	        printUncompressNode(node,ptr);
-    printf("l(\"%d\",n(\"\",[a(\"OBJECT\",\"%s\"),",node,node_str);
-    printf("a(\"FONTFAMILY\",\"courier\"),");
-      
-
-      // hide the CAF:REPOSITORY as default
-      if (!strncmp(node_str,"Cost centre: CAF:REPOSITORY",26))
-         printf("a(\"HIDDEN\",\"true\"),"); // when uncompressed
-      if (!strncmp(node_str," CAF:REPOSITORY",12)) 
-         printf("a(\"HIDDEN\",\"true\"),"); // when compressed
-
-
-      if (mode==2)
-      {
-        if ((ptr->comm_max+ptr->comp_idle_max+ptr->comp_max) <= 0.0)
-            printf("a(\"HIDDEN\",\"true\"),");
-      }  
-      //for pruning all zero-cost nodes
-      if (mode==1)
-      {
-      if ((ptr->comm_max+ptr->comp_idle_max+ptr->comp_max) <= 0.0)
-          { fprintf(logFile,"Node %d %s is a candidate for deletion\n",node, node_str);
-            sprintf(tempnode,"\"%d\",",node);
-            strcat(p_zeronodes,tempnode);
-          }
-      } 
-
-    colour=percentToColour(1.0-nodeColour(ptr));
-       printf("a(\"COLOR\",\"#ff%.2x%.2x\")",colour,colour);
-    printf("],[");
-    Mat(int,*graph,node,node)=-1;
-    for(i=0;i<no_children;i++) {
-
-      printf("e(\"%d->%d\",[],",node,children[i]);
- 
-      recur_graphToDaVinci(children[i],graph,costs,p_zeronodes,mode);
-      printf(")");
-      if (i<(no_children-1)) {printf(",");}
-    } 
-    printf("]))");
-  } 
-}
-
-
-
-static void recur_graphToDaVinci_old(int node,Matrix *graph, Matrix *costs) {
-  object_cost *ptr;
-  int i,j,no_children=0,*children=NULL,colour;
-  char *node_str;
-  if (Mat(int,*graph,node,node)<0) {
-    fprintf(logFile,"r(\"%d\") ",node);
-    printf("r(\"%d\") ",node);
-  } else {
-    for(i=0;i<graph->cols;i++) 
-      if (node!=i && Mat_dense(*graph,node,i)) no_children++;
-  
-    if (no_children>0) {
-      children = calloc(no_children,sizeof(int));
-      if (children==NULL) {
-        fprintf(stderr,"{printDaVinci} unable to allocate %d ",no_children);
-        exit(1);
-      }
-      for((i=0,j=0);i<graph->cols;i++)
-        if (node!=i && Mat_dense(*graph,node,i)) children[j++]=i;
-
-      qsort(children,no_children,sizeof(int),
-	    (int (*)(const void *,const void *)) cmp_symbol_entry);
-    }
-    ptr = &Mat(object_cost,*costs,node,0);
-    node_str=(NodeviewCompress)?
-	        printCompressNode(node,ptr):
-	        printUncompressNode(node,ptr);
-    fprintf(logFile,"l(\"%d\",n(\"\",[a(\"OBJECT\",\"%s\"),",node,node_str);
-    printf("l(\"%d\",n(\"\",[a(\"OBJECT\",\"%s\"),",node,node_str);
-    fprintf(logFile,"a(\"FONTFAMILY\",\"courier\"),");
-    printf("a(\"FONTFAMILY\",\"courier\"),");
-    if (symbol_table[node].type==CG_SSTEP)
-      printf("a(\"BORDER\",\"double\"),");
-    else 
-      //if (prune subgraphs of zero cost node)
-                                                            // minNodeSize hardwired
-      if ((ptr->comm_max+ptr->comp_idle_max+ptr->comp_max) < minNodeSize)
-          printf("a(\"HIDDEN\",\"true\"),");
-        
-      //if ((ptr->comm_max+ptr->comp_idle_max+ptr->comp_max) < 0.01) 
-      //    small=1; 
-      //else small=0;
- 
-
-    colour=percentToColour(1.0-nodeColour(ptr));
-    //if (!small) 
-       fprintf(logFile,"a(\"COLOR\",\"#ff%.2x%.2x\")",colour,colour);
-       printf("a(\"COLOR\",\"#ff%.2x%.2x\")",colour,colour);
-    //else 
-    //   printf("a(\"COLOR\",\"yellow\"),"); 
-    fprintf(logFile,"],[");
-    printf("],[");
-    Mat(int,*graph,node,node)=-1;
-    for(i=0;i<no_children;i++) {
-
-      //if (!small) 
-           fprintf(logFile,"e(\"%d->%d\",[],",node,children[i]);
-           printf("e(\"%d->%d\",[],",node,children[i]);
-      //else 
-      //     printf("e(\"%d->%d\",[a(\"EDGECOLOR\",\"yellow\")],",node,children[i]);
- 
-      recur_graphToDaVinci_old(children[i],graph,costs);
-      fprintf(logFile,")");
-      printf(")");
-      if (i<(no_children-1)) {fprintf(logFile,","); printf(",");}
-    } 
-    fprintf(logFile,"]))");
-    printf("]))");
-  } 
-}
-
-
-/* -----------------------------------------------------------------------------
- * Update colour
- * -------------------------------------------------------------------------- */
-
-void updateColours(int root, Matrix *graph, Matrix *costs) {
-  int i,colour,last;
-
-  printf("graph(change_attr([");
-  for(last=costs->rows-1;last>=0;last--)
-    if (Mat_dense(*graph,last,last)) break;
-
-  for(i=0;i<costs->rows;i++) {
-    if (Mat_dense(*graph,i,i)) {
-      colour = percentToColour(1.0-nodeColour(&Mat(object_cost,*costs,i,0)));
-      printf("node(\"%d\",[a(\"COLOR\",\"#ff%.2x%.2x\")])",
-	     i,colour,colour);
-      if (i<last) printf(",");    
-    }
-  }
-  printf("]))\n");
-}
-
-/* -----------------------------------------------------------------------------
- * Parse answer from daVinci
- * -------------------------------------------------------------------------- */
-
-davinciCmd parseDaVinciCmd(char *input) {
-  davinciCmd result;
-  char *crp;
-  char *word;
-  int i;
-  
-  result.size=1;
-  result.list=NULL;
-  for(crp=input;*crp;crp++)
-    if (*crp==',') result.size++;
-
-  crp=input;
-  word = parse_word(&crp);
-  if (Verbose) fprintf(logFile,"{parseDaVinciCmd}=%s size=%d\n",word,result.size);
-  if        (strcmp(word,"node_selections_labels")==0) {
-    result.type=DAVINCI_NODE;
-    result.list =calloc(result.size,sizeof(char*));
-    if (result.list==NULL) {
-      fprintf(stderr,"{parseDaVinciCmd} failed to allocate storage");
-      exit(1);
-    }
-    crp+=2;
-    i=0;
-    word = parse_quoted(&crp);
-    result.list[i++] = dup_str(word);
-    while (*crp++==',') {
-      word = parse_quoted(&crp);
-      result.list[i++] = dup_str(word);
-    }
-  } else if (strcmp(word,"icon_selection")==0) {
-    result.type=DAVINCI_ICON;
-    result.list =calloc(result.size,sizeof(char*));
-    if (result.list==NULL) {
-      fprintf(stderr,"{parseDaVinciCmd} failed to allocate storage");
-      exit(1);
-    }
-    crp++;
-    i=0;
-    word = parse_quoted(&crp);
-    result.list[i++] = dup_str(word);
-  } else if (strcmp(word,"tcl_answer")==0) {
-    result.type=DAVINCI_TCL;
-    result.list =calloc(result.size,sizeof(char*));
-    if (result.list==NULL) {
-      fprintf(stderr,"{parseDaVinciCmd} failed to allocate storage");
-      exit(1);
-    }
-    crp++;
-    i=0;
-    word = parse_quoted(&crp);
-    result.list[i++] = dup_str(word);
-  } else if (strcmp(word,"menu_selection")==0) {
-    result.type=DAVINCI_MENU;
-    result.list =calloc(result.size,sizeof(char*));
-    if (result.list==NULL) {
-      fprintf(stderr,"{parseDaVinciCmd} failed to allocate storage");
-      exit(1);
-    }
-    crp++;
-    i=0;
-    word = parse_quoted(&crp);
-    result.list[i++] = dup_str(word);
-  }else if (strcmp(word,"node_double_click")==0) {
-    result.type=DAVINCI_OK;
-  } else if (strcmp(word,"edge_selection_labels")==0)  {
-    result.type=DAVINCI_OK;
-  } else if (strcmp(word,"ok")==0)  {
-    result.type=DAVINCI_OK;
-  } else if (strcmp(word,"quit")==0)  {
-    result.type=DAVINCI_QUIT;
-  } else {
-    result.type=DAVINCI_ERROR;
-  }
-  return result;  
-}
-
-/* -----------------------------------------------------------------------------
- * Misc.
- * -------------------------------------------------------------------------- */
-
-
-/* Function that returns a string containing \texttt{x} spaces. */
-static char* extra_space(int x) {
-  static char space[MAX_FUNNAME+1];
-  int i;
-
-  if (Verbose) fprintf(logFile,"Padding is %d\n",x);
-  for(i=0;(i<x)&&(i<MAX_FUNNAME);i++) space[i]=' ';
-  space[i]='\0';
-  return space;
-}
-
-
-static char *parse_word(char **crp) {
-  static char result[MAX_FUNNAME];
-  int i=0;
-
-  while(islower(**crp) || **crp=='_') {
-    result[i++]=**crp;
-    (*crp)++;
-  }
-  result[i]='\0';
-  return result;
-}
-
-static char *parse_quoted(char **crp) {
-  static char result[MAX_FUNNAME];
-  int i=0;
-  if (**crp=='\"') {
-    (*crp)++;
-    while (**crp != '\"') {
-      result[i++]=**crp;
-      (*crp)++;
-    }
-    (*crp)++;
-  }
-  result[i]='\0';
-  return result;
-}
-
-static char *dup_str(char *xs) {
-  char *result;
-
-  if (xs==NULL) return NULL;
-  else {
-    result = malloc(strlen(xs)+1);
-    if (result==NULL) {
-      fprintf(stderr,"{dup_str}: unable to allocate bytes");
-      exit(1);
-    }
-    strcpy(result,xs);
-    return result;
-  }
-}
diff --git a/ghc/utils/prof/cgprof/daVinci.h b/ghc/utils/prof/cgprof/daVinci.h
deleted file mode 100644
index 3f6106983d..0000000000
--- a/ghc/utils/prof/cgprof/daVinci.h
+++ /dev/null
@@ -1,95 +0,0 @@
-/* ------------------------------------------------------------------------
- * $Id: daVinci.h,v 1.1 2000/04/05 10:06:36 simonmar Exp $
- *									
- *	Copyright (C) 1995-2000 University of Oxford
- *									
- * Permission to use, copy, modify, and distribute this software,
- * and to incorporate it, in whole or in part, into other software,
- * is hereby granted without fee, provided that
- *   (1) the above copyright notice and this permission notice appear in
- *	 all copies of the source code, and the above copyright notice
- *	 appear in clearly visible form on all supporting documentation
- *	 and distribution media;
- *   (2) modified versions of this software be accompanied by a complete
- *	 change history describing author, date, and modifications made;
- *	 and
- *   (3) any redistribution of the software, in original or modified
- *	 form, be without fee and subject to these same conditions.
- * --------------------------------------------------------------------- */
-
-#ifndef _DAVINCI_H_
-#define _DAVINCI_H_
-#include "symbol.h"
-#include "matrix.h"
-#include "cgprof.h"
-
-#define PAIRMAX(x,y) (((x)>(y))?(x):(y))
-
-#define SAFEDIV(x,y) (((y)==0.0)?0.0:((x)/(y)))
-
-#define DAVINCI_ERROR        0
-#define DAVINCI_OK           1
-#define DAVINCI_NODE         2
-#define DAVINCI_MENU         3
-#define DAVINCI_ICON         4
-#define DAVINCI_DOUBLE_CLICK 5
-#define DAVINCI_QUIT         6
-#define DAVINCI_TCL          7
-
-#define TCL_HREL 0
-#define TCL_COMP 1
-#define TCL_COMM 2
-#define TCL_WAIT 3
-#define TCL_EXIT 4
-
-#define INCLUDEDIR "@includedir@"
-
-typedef struct {
-  int    type;
-  char **list;
-  int size;
-} davinciCmd;
-
-
-#define CRITICAL_COMP              0
-#define CRITICAL_COMM              1
-#define CRITICAL_WAIT              2
-#define CRITICAL_HREL              3
-#define CRITICAL_SYNCS             4
-
-#define CRITTYPE_ABSOLUTE     0
-#define CRITTYPE_ABSDELTA     100
-#define CRITTYPE_RELDELTA     200
-#define CRITTYPE_WEIGHTDELTA  300
-
-extern void graphToDaVinci(int,Matrix*,Matrix *,int);
-davinciCmd  parseDaVinciCmd(char*);
-extern void cmdDaVinci(char*,...);
-extern void initDaVinci();
-extern void activateDaVinciMenu(char *);  
-extern void updateColours(int,Matrix*,Matrix*);
-extern void tclPieUpdate(object_cost *,int,int);
-extern void tclPieInit();
-
-
-extern char* lastDavinciCmd;
-extern int   NodeviewTime;
-extern int   NodeviewCompress;
-extern double TotalComp;
-extern double TotalComm;
-extern double TotalCompIdle;
-extern int    TotalSyncs;
-extern long int TotalH;
-extern char  *dateProfiled;
-extern char  *machineName;
-extern int    bsp_p;
-extern double bsp_s,bsp_l,bsp_g;
-extern int CriticalPath;
-extern int CriticalType;
-extern double minNodeSize;
-extern int bsp_p;
-extern int PrintLogo;
-extern int Colour;
-extern int DeltaNormalise;
-extern int PieCombine;
-#endif
diff --git a/ghc/utils/prof/cgprof/main.c b/ghc/utils/prof/cgprof/main.c
deleted file mode 100644
index afa8fbee19..0000000000
--- a/ghc/utils/prof/cgprof/main.c
+++ /dev/null
@@ -1,436 +0,0 @@
-/* ------------------------------------------------------------------------
- * $Id: main.c,v 1.4 2005/12/02 12:45:16 simonmar Exp $
- *									
- *	Copyright (C) 1995-2000 University of Oxford
- *									
- * Permission to use, copy, modify, and distribute this software,
- * and to incorporate it, in whole or in part, into other software,
- * is hereby granted without fee, provided that
- *   (1) the above copyright notice and this permission notice appear in
- *	 all copies of the source code, and the above copyright notice
- *	 appear in clearly visible form on all supporting documentation
- *	 and distribution media;
- *   (2) modified versions of this software be accompanied by a complete
- *	 change history describing author, date, and modifications made;
- *	 and
- *   (3) any redistribution of the software, in original or modified
- *	 form, be without fee and subject to these same conditions.
- * --------------------------------------------------------------------- */
-
-#include "ghcconfig.h"
-
-#include <stdio.h>
-
-#if HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-#if HAVE_STRING_H
-#include <string.h>
-#endif
-
-#include "symbol.h"
-#include "cgprof.h"
-#include "matrix.h"
-#include "daVinci.h"
-
-#if HAVE_WINDOWS_H
-#include <windows.h>
-#define sleep(x) Sleep((x)*1000)
-#endif
-
-
-#define NoDeletes 80
-
-int     CriticalPath=CRITICAL_SYNCS;
-int     CriticalType=CRITTYPE_ABSOLUTE;
-int     Verbose=1;
-int     NodeviewTime=1;
-int     NodeviewCompress=1;
-int     PrintLogo=1;
-int     Colour=1;
-int     DeltaNormalise=1;
-int     PieView=TCL_COMP;
-int     PieCombine=0;
-char   *Pgm;
-char   *ProfileData;
-int     NoNodes,root;
-char    usage[]="usage:  cgprof profile-data [See man 1 cgprof]";
-char    helpUrl[]="http://www.dcs.warwick.ac.uk/people/academic/Stephen.Jarvis/profiler/";
-Matrix  graph; /* NoNodes x NoNodes matrix of integers */
-Matrix  costs; /* NoNodes x 1       matrix of costs    */
-
-double   TotalComp, TotalComm, TotalCompIdle;
-int      TotalSyncs;
-long int TotalH;
-
-char    *dateProfiled, *machineName;
-double minNodeSize = 0.01;   /* i.e, don't show nodes with _combined_
-				    comp and comm % less than this */
-double bsp_s = 74.0;
-double bsp_l = 1902;
-double bsp_g = 9.3;
-int    bsp_p;
-
-FILE *logFile;
-
-
-extern void printDaVinci(int);
-
-int 
-main(int argc, char *argv[]) {
-  char davinci_stdin[MAX_PROFILE_LINE_LENGTH];
-  FILE   *fptr;
-  int i,j,k,going=1,*select_nodes, select_nodes_next,MaxNoNodes;
-  davinciCmd cmd;
-  int *undo_stack, undo_stack_next;
-  float temp_f;
-  char *ptr;
-  int mode = 0;
-  char *tempstring = malloc (80);
-  char *tempstring2 = malloc (80);
-  
-
-  /* printf("Starting main routine of browser script\n"); */
-  /* fflush(stderr); */
-
-  if (argc!=14) {
-    fprintf(stderr,"The perl script bspsgprof is buggered\n");
-    exit(1);
-  }
-
-  /* Most (if not all) of these BSP specific arguments can be removed */
-
-  Pgm         = argv[0];
-  ProfileData = argv[1];
-  bsp_p       = atoi(argv[2]);
-  machineName = argv[3];
-  dateProfiled= argv[4];
-  sscanf(argv[5],"%f",&temp_f);
-  bsp_s = temp_f;
-  sscanf(argv[6],"%f",&temp_f);
-  bsp_l = temp_f;
-  sscanf(argv[7],"%f",&temp_f);
-  bsp_g = temp_f;
-  sscanf(argv[8],"%f",&temp_f);
-  minNodeSize=temp_f;
-  Verbose = atoi(argv[9]);
-  PrintLogo=atoi(argv[10]);
-  Colour=atoi(argv[11]);
-  DeltaNormalise=atoi(argv[12]);
-  MaxNoNodes=atoi(argv[13]);
-
-  /* printf("Initialisation done\n"); */
-
-  if (Verbose) sleep(10);  
-  if (!(fptr=fopen(ProfileData,"r"))) {
-    fprintf(stderr,"%s: unable to open profile data in \"%s\".\n%s\n",
-            Pgm,ProfileData,usage);
-    exit(1);
-  }
-  if (!(logFile=fopen("ghcprof.log","w"))) {
-    fprintf(stderr,"%s: unable to open log file for writing\n",Pgm);
-    exit(1);
-  }
-
-  /* printf("Files opened OK\n"); */
-
-  if (!fgets(davinci_stdin, MAX_PROFILE_LINE_LENGTH, stdin) || 
-       strcmp(davinci_stdin,"ok\n")) {
-    fprintf(stderr,"%s{%s}: failed to receive ok from daVinci.\n",
-	    davinci_stdin,Pgm);
-    exit(1);
-  }
-
-  /* printf("Initialising daVinci\n"); */
-
-  initDaVinci();
-  
-  /* printf("Ending initialisation of daVinci\n"); */
- 
-  if (Verbose) fprintf(logFile,"%s: opened profile file \"%s\".\n",Pgm,ProfileData);
-  readRawProfile(fptr,&NoNodes,MaxNoNodes);
-  fclose(fptr);
-  if (Verbose) fprintf(logFile,"%s: %d nodes in profile.\n",Pgm,NoNodes);
-
-  if (NoNodes<=0) {
-    fprintf(logFile,"%s: no call-graph profile data in \"%s\".\n"
-            "Re-run your program using the appropriate profiling flags\n",
-            Pgm,ProfileData);
-    exit(1);
-  }
-  if (Verbose) printRawProfile();
-
-  /* Do we want INHERITANCE to begin with or not? Set to yes. */
-  createConnectivityMatrix(NoNodes,&graph,&costs,&root,1);
-
-  TotalComp     = Mat(object_cost,costs,root,0).comp_max;
-  TotalComm     = Mat(object_cost,costs,root,0).comm_max;
-  TotalCompIdle = Mat(object_cost,costs,root,0).comp_idle_max;
-  TotalH        = Mat(object_cost,costs,root,0).hrel_max;
-  TotalSyncs    = Mat(object_cost,costs,root,0).syncs;
-  if (Verbose) printConnectivityMatrix(graph,costs,root);
-  fflush(logFile);
-  graphToDaVinci(root,&graph,&costs,0);
-  fflush(stdout);
-  undo_stack   = calloc(NoDeletes,sizeof(int));
-  select_nodes = calloc(NoNodes,sizeof(int));
-  if (undo_stack==NULL || select_nodes==NULL) {
-    fprintf(stderr,"Unable to allocate storage for undo stack\n");
-    exit(1);
-  }
-  undo_stack_next=0;
-  select_nodes_next=0;
-  // Pie chart stuff not wanted for GHC
-  // tclPieInit();
-  // tclPieUpdate(&Mat(object_cost,costs,root,0),root,PieView);
-  select_nodes_next=1;
-  select_nodes[0]=root;
-  while (fgets(davinci_stdin, MAX_PROFILE_LINE_LENGTH, stdin) && going) {
-    cmd = parseDaVinciCmd(davinci_stdin);
-    if (Verbose) fprintf(logFile,"From davinci=\"%s\"\n",davinci_stdin);
-    switch (cmd.type) {
-    case DAVINCI_OK:
-      continue;
-
-    case DAVINCI_QUIT:
-      going=0;
-      break;
-
-    case DAVINCI_NODE:
-      select_nodes_next=cmd.size;
-      for(i=0;((i<cmd.size) && (i<NoNodes));i++)
-        select_nodes[i]=atoi(cmd.list[i]);
-      if (select_nodes_next>0)
-        //Pie chart stuff not wanted for GHC
-        //tclPieUpdate(&Mat(object_cost,costs,select_nodes[0],0),
-        //		     select_nodes[0],
-        //		     PieView);
-      if (mode==3) 
-      {
-         mode = atoi(cmd.list[0]);
-         getNameFromSymbolTable(mode,tempstring);
-         for(ptr=tempstring;*ptr!='\0';ptr++)
-            if (*ptr=='&') *ptr=' ';
-         mode = 3;
-         strcpy(tempstring2,"window(show_status(\"");
-         strcat(tempstring2,tempstring);
-         strcat(tempstring2,"\"))");
-         cmdDaVinci(tempstring2);
-         strcpy(tempstring,"");
-         strcpy(tempstring2,"");
-      }
-      break;
-
-    case DAVINCI_MENU:
-      if (cmd.size>0) {
-        if (strcmp(cmd.list[0], "jump")==0)  {
-	  if ((select_nodes_next>=0)      && 
-              (select_nodes[0]>0)         &&
-	      (select_nodes[0] < NoNodes) &&
-	      (Mat_dense(graph,select_nodes[0],select_nodes[0]))) {
-	    cmdDaVinci("special(focus_node(\"%d\"))\n",select_nodes[0]);
-	  }
-        }
-      }
-      break;
-
-    case DAVINCI_ICON:
-      if (cmd.size>0) {
-        if (strcmp(cmd.list[0], "sync")==0) {
-	  CriticalPath=CRITICAL_SYNCS;
-	  activateDaVinciMenu(cmd.list[0]);
-	  cmdDaVinci("window(show_status(\"Graph view\"))");
-          updateColours(root,&graph,&costs);
-
-	} else if (strcmp(cmd.list[0], "comp")==0) {
-	  CriticalPath=CRITICAL_COMP;
-	  activateDaVinciMenu(cmd.list[0]);
-          cmdDaVinci("window(show_status(\"SCCs critical path\"))");
-          updateColours(root,&graph,&costs);
-          
-        } else if (strcmp(cmd.list[0], "comm")==0) {
-	  CriticalPath=CRITICAL_COMM;
-	  activateDaVinciMenu(cmd.list[0]);
-          cmdDaVinci("window(show_status(\"Computation time critical path\"))");
-          updateColours(root,&graph,&costs);
-          
-        } else if (strcmp(cmd.list[0], "wait")==0) {
-	  CriticalPath=CRITICAL_WAIT;
-	  activateDaVinciMenu(cmd.list[0]);
-          cmdDaVinci("window(show_status(\"Heap usage critical path\"))"); 
-          updateColours(root,&graph,&costs);
-          
-        } else if (strcmp(cmd.list[0], "hrel")==0) {
-
-          if (mode != 3)
-          {
-            cmdDaVinci("window(show_status(\"Node spy on\"))");
-            mode = 3;
-          }
-          else 
-          {
-            mode = 0;
-            cmdDaVinci("window(show_status(\"Node spy off\"))");
-          }
-
-        } else if (strcmp(cmd.list[0], "absolute")==0) {
-          /* Now deals with inheritance profile */
-	  CriticalType=CRITTYPE_ABSOLUTE;
-          activateDaVinciMenu(cmd.list[0]);
-	  cmdDaVinci("window(show_status(\"Inheritance profile\"))");
-          freeMat(&graph); 
-	  freeMat(&costs); 
-          createConnectivityMatrix(NoNodes,&graph,&costs,&root,1);
-          graphToDaVinci(root,&graph,&costs,0);
-	  cmdDaVinci("window(show_status(\"Inheritance profile\"))");
-          updateColours(root,&graph,&costs);
-
-        } else if (strcmp(cmd.list[0], "absdelta")==0) {
-          /* Now deals with flat profile */
-	  CriticalType=CRITTYPE_ABSDELTA;
-          activateDaVinciMenu(cmd.list[0]);
-	  cmdDaVinci("window(show_status(\"Flat profile\"))");
-          freeMat(&graph); 
-	  freeMat(&costs); 
-          createConnectivityMatrix(NoNodes,&graph,&costs,&root,0);
-          graphToDaVinci(root,&graph,&costs,0);
-	  cmdDaVinci("window(show_status(\"Flat profile\"))");
-          updateColours(root,&graph,&costs);
-
-        } else if (strcmp(cmd.list[0], "reldelta")==0) {
-	  CriticalType=CRITTYPE_ABSOLUTE;
-          activateDaVinciMenu(cmd.list[0]);
-	  cmdDaVinci("window(show_status(\"Trimmed zero-cost sub-trees\"))");
-          strcpy(cmd.list[0], "absolute");
-          activateDaVinciMenu(cmd.list[0]);
-          graphToDaVinci(root,&graph,&costs,2);
-          updateColours(root,&graph,&costs);
-	  
-        } else if (strcmp(cmd.list[0], "weightdelta")==0) {
-	  CriticalType=CRITTYPE_ABSOLUTE;
-          activateDaVinciMenu(cmd.list[0]);
-	  cmdDaVinci("window(show_status(\"Marked zero-cost nodes ready for deletion\"))");
-          strcpy(cmd.list[0], "absolute");
-          activateDaVinciMenu(cmd.list[0]);
-          graphToDaVinci(root,&graph,&costs,1);
-          updateColours(root,&graph,&costs);
-	  
-        } else if (strcmp(cmd.list[0],"help")==0) {
-          cmdDaVinci("special(show_url(\"%s\"))",helpUrl);
-
-	} else if (strcmp(cmd.list[0],"time")==0) {
-	  NodeviewTime=1;
-	  activateDaVinciMenu(cmd.list[0]);
-	  cmdDaVinci("window(show_status(\"Cost metric view\"))");
-          graphToDaVinci(root,&graph,&costs,0);
-
-	} else if (strcmp(cmd.list[0],"percent")==0) {
-	  NodeviewTime=0;
-	  activateDaVinciMenu(cmd.list[0]);
-	  cmdDaVinci("window(show_status(\"Percentage view\"))");
-          graphToDaVinci(root,&graph,&costs,0);
-
-	} else if (strcmp(cmd.list[0],"compress")==0) {
-	  NodeviewCompress=1;
-	  activateDaVinciMenu(cmd.list[0]);
-	  cmdDaVinci("window(show_status(\"Compressed node view\"))");
-	  cmdDaVinci("menu(layout(compact_all))");
-          graphToDaVinci(root,&graph,&costs,0);
-
-	} else if (strcmp(cmd.list[0],"uncompress")==0) {
-	  NodeviewCompress=0;
-	  activateDaVinciMenu(cmd.list[0]);
-	  cmdDaVinci("window(show_status(\"Uncompressed node view\"))");
-          graphToDaVinci(root,&graph,&costs,0);
-
-	} else if ((strcmp(cmd.list[0],"delete")==0) ||
-		   (strcmp(cmd.list[0],"undo")==0)) {
-          if (strcmp(cmd.list[0],"delete")==0) {
-	    if (undo_stack_next==0) 
-	      activateDaVinciMenu("undo");
-            for(i=0;(i<select_nodes_next) && (undo_stack_next<NoNodes);i++) 
-	      undo_stack[undo_stack_next++] = select_nodes[i];
-	    if (undo_stack_next==NoDeletes) 
-	      activateDaVinciMenu("delete");
-	    cmdDaVinci("window(show_status(\"Deleted node (s)\"))");
-            select_nodes_next=0;
-	  } else {
-	    if (undo_stack_next==NoDeletes) 
-	      activateDaVinciMenu("delete");
-	    undo_stack_next--;
-	    if (undo_stack_next==0) 
-	      activateDaVinciMenu("undo");
-	    cmdDaVinci("window(show_status(\"Undone deletion\"))");
-	    select_nodes_next=1;
-	    select_nodes[0]=undo_stack[undo_stack_next];
-            
-	    for(i=0;i<raw_profile_next;i++)
-	      raw_profile[i].active=1;
-	  }
-	  activateDaVinciMenu("default");
-	  for(i=0;i<undo_stack_next;i++) {
-	    for(j=0;j<raw_profile_next;j++) {
-              for(k=0;k<raw_profile[j].stack_size;k++) {
-                if (raw_profile[j].stack[k]==undo_stack[i])
-		  raw_profile[j].active=0;
-	      }
-            }
-          }
-          cmdDaVinci("window(show_message(\"Deleting node...\"))");
-          freeMat(&graph);
-	  freeMat(&costs);
-          createConnectivityMatrix(NoNodes,&graph,&costs,&root,1);
-          graphToDaVinci(root,&graph,&costs,0);
-          if (strcmp(cmd.list[0],"undo")==0) {
-            if ((select_nodes[0]>0)         &&
-	        (select_nodes[0] < NoNodes) &&
-	        (Mat_dense(graph,select_nodes[0],select_nodes[0]))) {
-	    cmdDaVinci("special(focus_node(\"%d\"))\n",select_nodes[0]);
-	    cmdDaVinci("special(select_nodes([\"%d\"]))",select_nodes[0]);
-            //Pie chart stuff not wanted for GHC
-	    //tclPieUpdate(&Mat(object_cost,costs,select_nodes[0],0),
-	    //	       select_nodes[0],
-	    //	       PieView);
-            }
-          }
-	}    
-      }
-      break;
-    case DAVINCI_TCL: 
-    // This stuff can go as it is related to the input for the Pie chart tool
-      if (cmd.size>0) {
-        if        (strcmp(cmd.list[0], "comm")==0)  {
-	  PieView=TCL_COMM;
-	} else if (strcmp(cmd.list[0], "comp")==0)  {
-	  PieView=TCL_COMP;
-	} else if (strcmp(cmd.list[0], "hrel")==0)  {
-	  PieView=TCL_HREL;
-	} else if (strcmp(cmd.list[0], "wait")==0)  {
-	  PieView=TCL_WAIT;
-	} else if (strcmp(cmd.list[0], "combine")==0)  {
-	  PieCombine=!PieCombine;
-        } else if (strlen(cmd.list[0])==0) {
-	  break;
-	}
-	if (select_nodes_next>0) break;
-          //Added a break for compiliation above since it does not compile if 
-          //we just remove the Pie chart code 
-	  //tclPieUpdate(&Mat(object_cost,costs,select_nodes[0],0),
-	  //	       select_nodes[0],
-	  //	       PieView);
-      }
-      break;
-    case DAVINCI_ERROR:  
-    default:
-      fprintf(stderr,"CGPROF error:\n"
-                     "\tCommand = %s\n"
-	             "\tError   = %s\n",lastDavinciCmd,davinci_stdin);
-      exit(1); 
-      break;
-    }
-    fflush(stdout);
-    fflush(logFile);
-  }  
-
-  return 0;
-}
diff --git a/ghc/utils/prof/cgprof/matrix.c b/ghc/utils/prof/cgprof/matrix.c
deleted file mode 100644
index b4ca43f96b..0000000000
--- a/ghc/utils/prof/cgprof/matrix.c
+++ /dev/null
@@ -1,98 +0,0 @@
-/* ------------------------------------------------------------------------
- * $Id: matrix.c,v 1.3 2006/01/09 14:32:31 simonmar Exp $
- *									
- *	Copyright (C) 1995-2000 University of Oxford
- *									
- * Permission to use, copy, modify, and distribute this software,
- * and to incorporate it, in whole or in part, into other software,
- * is hereby granted without fee, provided that
- *   (1) the above copyright notice and this permission notice appear in
- *	 all copies of the source code, and the above copyright notice
- *	 appear in clearly visible form on all supporting documentation
- *	 and distribution media;
- *   (2) modified versions of this software be accompanied by a complete
- *	 change history describing author, date, and modifications made;
- *	 and
- *   (3) any redistribution of the software, in original or modified
- *	 form, be without fee and subject to these same conditions.
- * --------------------------------------------------------------------- */
-
-/* Not very clever sparse representation of a matrix. However, it will do
- * for the call graph profiler. 
- */
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-#include "matrix.h"
-
-Matrix newMat(int rows,int cols, int elsize, void *zero) {
-  Matrix res;
-
-  res.elsize= elsize;
-  res.zero  = malloc(elsize);
-  if (res.zero==NULL) {
-    fprintf(stderr,"{newMat} unable to allocate storage\n");
-    exit(1);
-  }
-  memcpy(res.zero,zero,elsize);
-  res.rows  = rows;
-  res.cols  = cols;
-  res.mat=NULL;
-  return res;
-}
-
-void freeMat(Matrix *mat) {
-  Matrix_element *tmp_ptr, *ptr=mat->mat;
-  free(mat->zero);
-
-  while(ptr!=NULL) {
-    free(ptr->data);
-    tmp_ptr = ptr->next;
-    free(ptr);
-    ptr=tmp_ptr;
-  }
-}
-
-void *_Mat(Matrix *mat,int x, int y,int lineno, char *filename) {
-  Matrix_element *ptr= mat->mat;
-  if (x<0 || x>=mat->rows || y<0 || y>=mat->cols) {
-    fprintf(stderr,"Mat[%d,%d] out of bound index at line %d of \"%s\"\n",
-	    x,y,lineno,filename);
-    exit(1);
-  }
-  while(ptr) {
-    if ((x==ptr->x) && (y==ptr->y)) {
-      return ptr->data;
-    }
-    ptr=ptr->next;
-  }
-  /* Not in list */
-  ptr = (Matrix_element*) malloc(sizeof(Matrix_element));
-  if (ptr==NULL) {
-    fprintf(stderr,"{_Mat} failed to allocate %zd bytes\n",
-	    sizeof(Matrix_element));
-    exit(1);
-  }
-  ptr->data = (void*) malloc(mat->elsize);
-  if (ptr->data==NULL) {
-    fprintf(stderr,"{_Mat} failed to allocate element of size %d bytes\n",
-	    mat->elsize);
-    exit(1);
-  }
-  ptr->x=x;
-  ptr->y=y;
-  memcpy(ptr->data,mat->zero,mat->elsize);
-  ptr->next=mat->mat;
-  mat->mat=ptr;
-  return ptr->data;
-}
-
-int Mat_dense(Matrix mat,int x,int y) {
-  Matrix_element *ptr= mat.mat;
-  while (ptr) {
-    if ((x==ptr->x) && (y==ptr->y)) return 1;
-    ptr=ptr->next;
-  }
-  return 0;
-}
diff --git a/ghc/utils/prof/cgprof/matrix.h b/ghc/utils/prof/cgprof/matrix.h
deleted file mode 100644
index bf70cf7c90..0000000000
--- a/ghc/utils/prof/cgprof/matrix.h
+++ /dev/null
@@ -1,42 +0,0 @@
-/* ------------------------------------------------------------------------
- * $Id: matrix.h,v 1.1 2000/04/05 10:06:36 simonmar Exp $
- *									
- *	Copyright (C) 1995-2000 University of Oxford
- *									
- * Permission to use, copy, modify, and distribute this software,
- * and to incorporate it, in whole or in part, into other software,
- * is hereby granted without fee, provided that
- *   (1) the above copyright notice and this permission notice appear in
- *	 all copies of the source code, and the above copyright notice
- *	 appear in clearly visible form on all supporting documentation
- *	 and distribution media;
- *   (2) modified versions of this software be accompanied by a complete
- *	 change history describing author, date, and modifications made;
- *	 and
- *   (3) any redistribution of the software, in original or modified
- *	 form, be without fee and subject to these same conditions.
- * --------------------------------------------------------------------- */
-
-#ifndef _MATRIX_H_
-#define _MATRIX_H_
-typedef struct _Matrix_element {
-  int                     x,y;
-  void                   *data;
-  struct _Matrix_element *next;
-} Matrix_element;
-
-typedef struct {
-  int             elsize;
-  void           *zero;
-  int             rows,cols;
-  Matrix_element *mat;
-} Matrix;
-
-
-extern Matrix newMat(int,int,int,void*);
-extern void   *_Mat(Matrix*,int,int,int,char*);
-extern int    Mat_dense(Matrix,int,int);
-extern void   freeMat(Matrix *);
-
-#define Mat(t,m,i,j) (*((t*) _Mat(&(m),i,j,__LINE__,__FILE__)))
-#endif
diff --git a/ghc/utils/prof/cgprof/symbol.c b/ghc/utils/prof/cgprof/symbol.c
deleted file mode 100644
index 133f59b2db..0000000000
--- a/ghc/utils/prof/cgprof/symbol.c
+++ /dev/null
@@ -1,115 +0,0 @@
-/* ------------------------------------------------------------------------
- * $Id: symbol.c,v 1.3 2003/08/01 14:50:50 panne Exp $
- *									
- *	Copyright (C) 1995-2000 University of Oxford
- *									
- * Permission to use, copy, modify, and distribute this software,
- * and to incorporate it, in whole or in part, into other software,
- * is hereby granted without fee, provided that
- *   (1) the above copyright notice and this permission notice appear in
- *	 all copies of the source code, and the above copyright notice
- *	 appear in clearly visible form on all supporting documentation
- *	 and distribution media;
- *   (2) modified versions of this software be accompanied by a complete
- *	 change history describing author, date, and modifications made;
- *	 and
- *   (3) any redistribution of the software, in original or modified
- *	 form, be without fee and subject to these same conditions.
- * --------------------------------------------------------------------- */
-
-#include <string.h>
-#include "symbol.h"
-
-/* -----------------------------------------------------------------------------
- * Data structures
- * -------------------------------------------------------------------------- */
-int          symbol_table_next=0;
-int          symbol_table_size=0;
-name_object *symbol_table=NULL;
-
-/* -----------------------------------------------------------------------------
- * Create/grow symbol table
- * -------------------------------------------------------------------------- */
-
-void enlargeSymbolTable() {
-
-  if (symbol_table_size==0) {
-    symbol_table_next = 0;
-    symbol_table_size = SYMBOL_TABLE_INIT_SIZE;
-    symbol_table      = calloc(symbol_table_size,sizeof(name_object));
-  } else {
-    symbol_table_size += SYMBOL_TABLE_INIT_SIZE;
-    symbol_table       = realloc(symbol_table,
-				 symbol_table_size*sizeof(name_object));
-  }
-  if (symbol_table==NULL) {
-    fprintf(stderr,"{enlargeSymbolTable} unable to allocate %d elements",
-            symbol_table_size);
-    exit(1);
-  }
-}
-
-/* -----------------------------------------------------------------------------
- * Lookup/add name to symbol table
- * -------------------------------------------------------------------------- */
-
-name_id lookupSymbolTable(int type,int lineno,char* str) {
-  int i;
-  extern FILE *logFile;
-
-  for(i=0;i<symbol_table_next;i++) {
-    if ((type==symbol_table[i].type) && 
-        (strcmp(str,symbol_table[i].filename)==0) &&
-        (type==CG_STACK || (lineno==symbol_table[i].lineno))) {
-      return i;
-    }
-  }
-  fprintf(logFile,"{lookupSymbolTable} %d at %s line %d\n",type,str,lineno);
-  if (symbol_table_next==symbol_table_size) enlargeSymbolTable();
-  symbol_table[symbol_table_next].type    = type;
-  symbol_table[symbol_table_next].lineno  = lineno;
-  symbol_table[symbol_table_next].filename= malloc(1+strlen(str));
-  if (symbol_table[symbol_table_next].filename==NULL) {
-    fprintf(stderr,"{lookupSymbolTable} failed to allocate space");
-    exit(1);
-  }
-  strcpy(symbol_table[symbol_table_next].filename,str);
-  return (symbol_table_next++);
-}
-
-/* -----------------------------------------------------------------------------
- * Comparison function to be used by \texttt{qsort}
- * -------------------------------------------------------------------------- */
-
-int cmp_symbol_entry(const int *x, const int *y) {
-  int i;
-
-  if (symbol_table[*x].type==symbol_table[*y].type) {
-    i = strcmp(symbol_table[*x].filename,symbol_table[*y].filename);
-    if  (i==0) return (symbol_table[*x].lineno - symbol_table[*y].lineno);
-    else return i;
-  } else {
-    if (symbol_table[*x].type==CG_STACK) return 1;
-    else return -1;
-  }
-}
-
-
-/* -----------------------------------------------------------------------------
- * Pretty print a symbol table entry
- * -------------------------------------------------------------------------- */
-
-void printSymbolTable_entry(int idx) {
-  extern FILE *logFile;
-  if (symbol_table[idx].type==CG_SSTEP) {
-    fprintf(logFile,"(line %d of %s) ",symbol_table[idx].lineno,
-	                              symbol_table[idx].filename);
-  } else {
-    fprintf(logFile,"%s ",symbol_table[idx].filename);
-  }
-}
-
-void getNameFromSymbolTable(int idx, char* name) {
-  strcpy(name,symbol_table[idx].filename);
-}
-
diff --git a/ghc/utils/prof/cgprof/symbol.h b/ghc/utils/prof/cgprof/symbol.h
deleted file mode 100644
index 697973150c..0000000000
--- a/ghc/utils/prof/cgprof/symbol.h
+++ /dev/null
@@ -1,58 +0,0 @@
-/* ------------------------------------------------------------------------
- * $Id: symbol.h,v 1.1 2000/04/05 10:06:36 simonmar Exp $
- *									
- *	Copyright (C) 1995-2000 University of Oxford
- *									
- * Permission to use, copy, modify, and distribute this software,
- * and to incorporate it, in whole or in part, into other software,
- * is hereby granted without fee, provided that
- *   (1) the above copyright notice and this permission notice appear in
- *	 all copies of the source code, and the above copyright notice
- *	 appear in clearly visible form on all supporting documentation
- *	 and distribution media;
- *   (2) modified versions of this software be accompanied by a complete
- *	 change history describing author, date, and modifications made;
- *	 and
- *   (3) any redistribution of the software, in original or modified
- *	 form, be without fee and subject to these same conditions.
- * --------------------------------------------------------------------- */
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <limits.h>
-
-/* -----------------------------------------------------------------------------
- * Symbol table associated with cost centres
- * -------------------------------------------------------------------------- */
-
-#ifndef _SYMBOL_H_
-#define _SYMBOL_H_
-#define CG_STACK 42
-#define CG_SSTEP 1968
-
-
-#define MAX_PROFILE_LINE_LENGTH   10000
-#define MAX_STACK_DEPTH           60
-#define MAX_FUNNAME               80
-
-
-typedef struct {
-  int   type;    /* Either CG_STACK or CG_SSTEP */
-  int   lineno;
-  char *filename;  
-} name_object;
-
-typedef int name_id; /* i.e. index into symbol table */
-
-#define SYMBOL_TABLE_INIT_SIZE 100
-extern int          symbol_table_next;
-extern int          symbol_table_size;
-extern name_object *symbol_table;
-
-
-extern void printSymbolTable(int , int *);
-extern int cmp_symbol_entry(const int *, const int *);
-extern name_id lookupSymbolTable(int,int,char*);
-extern void printSymbolTable_entry(int);
-extern void getNameFromSymbolTable(int,char*);
-#endif
diff --git a/ghc/utils/prof/ghcprof.prl b/ghc/utils/prof/ghcprof.prl
deleted file mode 100644
index bc3b344228..0000000000
--- a/ghc/utils/prof/ghcprof.prl
+++ /dev/null
@@ -1,280 +0,0 @@
-# -----------------------------------------------------------------------------
-# $Id: ghcprof.prl,v 1.5 2005/04/22 08:41:00 simonmar Exp $
-#
-# (c) The GHC Team 2000
-#
-# needs: FPTOOLS_TOP_ABS, INSTALLING, DEFAULT_TMPDIR, TARGETPLATFORM, libexecdir
-#
-
-if ($ENV{'UDG_HOME'}) {
-    $udrawgraphhome = $ENV{'UDG_HOME'};
-    $udrawgraph     = $udrawgraphhome . "/bin/uDrawGraph";
-} else {
-    print STDERR "ghcprof: UDG_HOME environment variable not set\n";
-    exit(1);
-}
-
-$machname      = ${TARGETPLATFORM};
-$bsp_s         = 10.0;
-$bsp_l         = 12;
-$bsp_g         = 13;
-$MaxNoNodes    = 1900;
-
-$icondir    = ( $INSTALLING ? "$libexecdir/icons" 
-	                    : "$FPTOOLS_TOP_ABS/ghc/utils/prof/icons" );
- 
-$xmlparser  = ( $INSTALLING ? "$libexecdir/xmlparser"
-	                    : "$FPTOOLS_TOP_ABS/ghc/utils/prof/xmlparser/xmlparser" );
-
-$cgprof_dir = ( $INSTALLING ? "$libexecdir"
-	                    : "$FPTOOLS_TOP_ABS/ghc/utils/prof/cgprof" );
-
-# where to make tmp file names?
-if ( $ENV{'TMPDIR'} ) {
-    $Tmp_prefix = $ENV{'TMPDIR'} . "/ghcprof";
-} else {
-    $Tmp_prefix ="${DEFAULT_TMPDIR}/ghcprof";
-    $ENV{'TMPDIR'} = "${DEFAULT_TMPDIR}"; # set the env var as well
-}
-
-# Create a new temporary filename.
-$i = $$;
-$tempfile = "";
-while (-e ($tempfile = "$Tmp_prefix" . "$i")) {
-    $i++;
-};
-
-# Create a second temporary filename.
-$i = $$;
-$tempfile2 = "";
-while (-e ($tempfile2 = "$Tmp_prefix" . "$i" . ".sh")) {
-    $i++;
-};
-
-# Delete temp. file if script is halted.
-sub quit_upon_signal { 
-    if ($tempfile ne "" && -e $tempfile) {
-	print STDERR "Deleting $tempfile .. \n" if $Verbose; 
-	unlink "$tempfile"; 
-    };
-    if ($tempfile2 ne "" && -e $tempfile2) {
-	print STDERR "Deleting $tempfile2 .. \n" if $Verbose; 
-	unlink "$tempfile2"; 
-    }
-}
-
-$SIG{'INT'}  = 'quit_upon_signal';
-$SIG{'QUIT'} = 'quit_upon_signal';
-
-sub tidy_up_and_die { 
-    local($msg) = @_;
-    
-    print STDERR "$Pgm: $msg\n";
-    quit_upon_signal;
-    exit(1);
-}
-
-select(STDERR); $| = 1; select(STDOUT); # no STDERR buffering, please.
-($Pgm = $0) =~ s|.*/||;
-$Version        = "v2.1 10-3-2000";
-$bug_reports_to = 'stephen.jarvis@dcs.warwick.ac.uk';
-
-$ShortUsage = "\n$Pgm usage: for basic information, try the `-help' option\n";
-
-$Usage = <<EOF
-Usage: $Pgm [option...] filename.prof
-
-Options:
-    -v          Verbose
-    -hide       (???)
-    -nologo     Omit the logo
-    -grey       Greyscale only
-    -color      Enable color (default)
-    -normalise  (???)
-EOF
-    ;
-
-$Verbose       = 0;
-$InputFile     = "";
-$date          = "";
-$nprocs        = 0;
-$hide          = 0.01;
-$Logo          = 1;
-$Colour        = 1;
-$DeltaNormalise= 2;
-
- arg: while ($_ = $ARGV[0]) {
-     shift(@ARGV);
-     #--------HELP------------------------------------------------
-     /^-help$/   && do { print STDERR $Usage; exit(0); };
-     
-     /^-v$/      && do {$Verbose = 1; next arg;};
-     
-     /^-hide$/   && do {$hide= &grab_next_arg("-hide");
-			if (($hide =~ /^(\d+.\d+)$/) || ($hide =~ /^(\d+)$/)) {
-			    $hide = $1/100.0;
-			} else {
-			    print STDERR "$Pgm: -hide requires a percentage as ",
-			    "an argument\n";
-			    $Status++;
-			}
-			next arg;};
-     
-     /^-nologo$/    && do {$Logo  =0; next arg;};
-     /^-gr(e|a)y$/  && do {$Colour=0; next arg;};
-     /^-colou?r$/   && do {$Colour=1; next arg;};
-     /^-normalise$/ && do {$DeltaNormalise = &grab_next_arg("-normalise");
-			   if ($DeltaNormalise =~ /^(\d+)$/) {
-			       $DeltaNormalise = int($DeltaNormalise);
-			   } else {
-			       print STDERR "$Pgm: -normalise requires an integer ",
-			       "an argument\n";
-			       $Status++;
-			   }
-			   next arg;};
-     
-     /^-/           && do { print STDERR "$Pgm: unrecognised option \"",$_,"\"\n"; 
-			    $Status++;
-			};
-     
-     if ($InputFile eq "") {
-	 $InputFile = $_; next arg; 
-     } else {
-	 $Status++;
-     };
- }
-
-if ($InputFile eq "") {
-    print STDERR "$Pgm: no input file given\n";
-    $Status++;
-}  
-if ($Status>0) {
-    print STDERR $ShortUsage;
-    exit(1);
-}
-print STDERR "$Pgm: ($Version)\n" if $Verbose;
-
-# -----------------------------------------------------------------------------
-# Parse the XML
-
-# ToDo: use the real xmlparser
-# system("$xmlparser < $InputFile > $tempfile");
-# if ($? != 0) { tidy_up_and_die("xmlparser failed"); }
-
-# Stehpen's hacky replacement for xmlparser:
-
-$cc_write  = 1; 
-$ccs_write = 1;
-$scc_write = 1;
-
-open(INPUT, "<$InputFile") || tidy_up_and_die("can't open `$InputFile'");
-open(TEMPFILE, ">$tempfile") || tidy_up_and_die("can't create `$tempfile'");
-
-while (<INPUT>) { 
-    if (/^1 (\d+) (.*)$/)
-    {
-	if ($cc_write) { 
-	    print TEMPFILE ">>cost_centre\n"; 
-	    $cc_write = 0; 
-	}
-	$cc_id		= $1;
-	$name		= $2;
-	$module		= $3;
-	print TEMPFILE "$cc_id $name $module\n"; 
-    }	
-    if (/^2 (\d+) (\d+) (\d+)$/)
-    {
-	if ($ccs_write) {
-	    print TEMPFILE ">>cost_centre_stack\n";
-	    $ccs_write = 0;
-	}
-	$ccs_id         = $1;
-	$ccptr          = $2;
-	$ccsptr         = $3;
-	print TEMPFILE "$ccs_id $ccptr $ccsptr\n";
-    } 
-    elsif (/^2 (\d+) (\d+) (\d+) (\d+)$/)
-    {
-	if ($ccs_write) {
-	    print TEMPFILE ">>cost_centre_stack\n";
-	    $ccs_write = 0;
-	}
-	$ccs_id         = $1;
-	$type           = $2;
-	$ccptr          = $3;
-	$ccsptr		= $4;
-	print TEMPFILE "$ccs_id $type $ccptr $ccsptr\n";
-    } 
-    if (/^5 (\d+) (.*)$/)
-    {
-	if ($scc_write) {
-	    print TEMPFILE ">>scc_sample\n";
-	    $scc_write = 0;
-	}
-	$_		= $2;
-	while (/^1 (\d+) (\d+) (\d+) (\d+) (.*)$/) 
-	{
-	    $rg1		= $1;
-	    $rg2		= $2;
-	    $rg3		= $3;
-	    $rg4		= $4;
-	    print TEMPFILE "$rg1 $rg2 $rg3 $rg4\n";
-	    $_		= $5;
-	}	
-    }
-}
-print TEMPFILE ">>\n";
-
-close(INPUT);
-close(TEMPFILE);
-
-&readProfileHeader();
-open(TEMPFILE2, ">$tempfile2") 
-                || tidy_up_and_die("can't create `$tempfile2'");
-
-$shcmd = sprintf("%s/cgprof %s %d \"%s\" " .
-	       "\"%s\" %.1f %.1f %.1f %.1f %d %d %d %d %d",
-	       $cgprof_dir,$tempfile,$nprocs,$machname,$date,
-	       $bsp_s,$bsp_l,$bsp_g,$hide,$Verbose,$Logo,$Colour,
-	       $DeltaNormalise,$MaxNoNodes);
-print TEMPFILE2 "#!/bin/sh\n";
-print TEMPFILE2 "$shcmd\n";
-close(TEMPFILE2);
-
-chmod 0755, $tempfile2;
-$cmd = "env UDG_ICONDIR=$icondir UDG_HOME=$udrawgraphhome " . 
-         $udrawgraph . " -startappl . $tempfile2";
-print STDERR "$Pgm: exec $cmd\n" if $Verbose;
-exec $cmd;
-exit(0);
-
-sub readProfileHeader {
-    local($found);
-    
-    open(PROFILE,$tempfile) || tidy_up_and_die("can't open `$tempfile'");
-    $found=0;
-    
-    while(<PROFILE>) {
-	if (/^F/) {
-	    if (/-prof/ && /-flibrary-level\s+(\d+)/) {
-		$libtype = "P$1";
-	    } elsif (/-flibrary-level\s+(\d+)/) {
-		$libtype = "O$1";
-	    }
-	    $found++;
-	    
-	} elsif (/^P\s*/) {
-	    $nprocs = int($');
-	    $found++;
-	    
-	} elsif (/^D\s*/) {
-	    chop($date = $');
-	    $found++;
-	    
-	} elsif (/^X\s*/) {
-	    chop($device = $');
-	}
-	last if ($found>=3);
-    }
-    close(PROFILE);
-}
diff --git a/ghc/utils/prof/icons/Makefile b/ghc/utils/prof/icons/Makefile
deleted file mode 100644
index 5b3eb4d40b..0000000000
--- a/ghc/utils/prof/icons/Makefile
+++ /dev/null
@@ -1,13 +0,0 @@
-#-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.1 2000/04/05 10:11:55 simonmar Exp $
-#
-# (c) The GHC Team, 2000
-#
-
-TOP=../../..
-include $(TOP)/mk/boilerplate.mk
-
-override datadir=$(libdir)/icons
-INSTALL_DATAS=$(wildcard *.xbm)
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/prof/icons/absdelta.xbm b/ghc/utils/prof/icons/absdelta.xbm
deleted file mode 100644
index e70e372dd0..0000000000
--- a/ghc/utils/prof/icons/absdelta.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define absdelta_width 18
-#define absdelta_height 18
-static unsigned char absdelta_bits[] = {
-   0xfc, 0xff, 0x00, 0x04, 0x80, 0x00, 0xe4, 0x9f, 0x00, 0x04, 0x80, 0x00,
-   0xe4, 0x9f, 0x00, 0x04, 0x83, 0x00, 0x04, 0x83, 0x00, 0x04, 0x83, 0x00,
-   0x04, 0x83, 0x00, 0x04, 0x83, 0x00, 0x04, 0x83, 0x00, 0x04, 0x83, 0x00,
-   0x04, 0x83, 0x00, 0x04, 0x83, 0x00, 0x04, 0x83, 0x00, 0xe4, 0x9f, 0x00,
-   0x04, 0x80, 0x00, 0xfc, 0xff, 0x00};
diff --git a/ghc/utils/prof/icons/absolute.xbm b/ghc/utils/prof/icons/absolute.xbm
deleted file mode 100644
index 045e1601f3..0000000000
--- a/ghc/utils/prof/icons/absolute.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define absolute_width 18
-#define absolute_height 18
-static unsigned char absolute_bits[] = {
-   0xfc, 0xff, 0x00, 0x04, 0x80, 0x00, 0x04, 0x80, 0x00, 0xe4, 0x9f, 0x00,
-   0x04, 0x83, 0x00, 0x04, 0x83, 0x00, 0x04, 0x83, 0x00, 0x04, 0x83, 0x00,
-   0x04, 0x83, 0x00, 0x04, 0x83, 0x00, 0x04, 0x83, 0x00, 0x04, 0x83, 0x00,
-   0x04, 0x83, 0x00, 0x04, 0x83, 0x00, 0xe4, 0x9f, 0x00, 0x04, 0x80, 0x00,
-   0x04, 0x80, 0x00, 0xfc, 0xff, 0x00};
diff --git a/ghc/utils/prof/icons/comm.xbm b/ghc/utils/prof/icons/comm.xbm
deleted file mode 100644
index 3f1fe9412b..0000000000
--- a/ghc/utils/prof/icons/comm.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define time_width 18
-#define time_height 18
-static unsigned char time_bits[] = {
-   0x00, 0x00, 0x00, 0xe0, 0x0f, 0x00, 0x38, 0x38, 0x00, 0x8c, 0x61, 0x00,
-   0x86, 0xc1, 0x00, 0x82, 0x81, 0x00, 0x83, 0x81, 0x01, 0x81, 0x01, 0x01,
-   0x81, 0x01, 0x01, 0x81, 0x01, 0x01, 0x01, 0x03, 0x01, 0x01, 0x06, 0x01,
-   0x03, 0x8c, 0x01, 0x02, 0x98, 0x00, 0x06, 0xc0, 0x00, 0x0c, 0x60, 0x00,
-   0x38, 0x38, 0x00, 0xe0, 0x0f, 0x00};
diff --git a/ghc/utils/prof/icons/commslack.xbm b/ghc/utils/prof/icons/commslack.xbm
deleted file mode 100644
index f53e40fa8f..0000000000
--- a/ghc/utils/prof/icons/commslack.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define commslack_width 18
-#define commslack_height 18
-static unsigned char commslack_bits[] = {
-   0xe0, 0x1f, 0x00, 0xfc, 0xff, 0x00, 0x67, 0x98, 0x03, 0x67, 0x98, 0x03,
-   0xc7, 0x8f, 0x03, 0x60, 0x18, 0x00, 0xb0, 0x37, 0x00, 0xb8, 0x77, 0x00,
-   0xbc, 0xf7, 0x00, 0x7c, 0xf8, 0x00, 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00,
-   0x00, 0x00, 0x00, 0xdc, 0xc4, 0x01, 0x48, 0x45, 0x00, 0x48, 0xc5, 0x01,
-   0x48, 0x45, 0x00, 0xdc, 0xdc, 0x01};
diff --git a/ghc/utils/prof/icons/comp.xbm b/ghc/utils/prof/icons/comp.xbm
deleted file mode 100644
index 923ef2f3de..0000000000
--- a/ghc/utils/prof/icons/comp.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define comp_width 18
-#define comp_height 18
-static unsigned char comp_bits[] = {
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0x03,
-   0x01, 0x00, 0x02, 0x01, 0x00, 0x02, 0x19, 0x63, 0x02, 0xa5, 0x94, 0x02,
-   0x85, 0x10, 0x02, 0x99, 0x10, 0x02, 0xa1, 0x10, 0x02, 0xa5, 0x94, 0x02,
-   0x19, 0x63, 0x02, 0x01, 0x00, 0x02, 0x01, 0x00, 0x02, 0xff, 0xff, 0x03,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/ghc/utils/prof/icons/compress.xbm b/ghc/utils/prof/icons/compress.xbm
deleted file mode 100644
index 39ff2f828e..0000000000
--- a/ghc/utils/prof/icons/compress.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define compress_width 18
-#define compress_height 18
-static unsigned char compress_bits[] = {
-   0x03, 0x00, 0x03, 0x07, 0x80, 0x03, 0x0e, 0xc0, 0x01, 0x9c, 0xe4, 0x00,
-   0xb8, 0x74, 0x00, 0xf0, 0x3c, 0x00, 0xe0, 0x1c, 0x00, 0xf8, 0x7c, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x7c, 0x00, 0xe0, 0x1c, 0x00,
-   0xf0, 0x3c, 0x00, 0xb8, 0x74, 0x00, 0x9c, 0xe4, 0x00, 0x0e, 0xc0, 0x01,
-   0x07, 0x80, 0x03, 0x03, 0x00, 0x03};
diff --git a/ghc/utils/prof/icons/compslack.xbm b/ghc/utils/prof/icons/compslack.xbm
deleted file mode 100644
index 4592554582..0000000000
--- a/ghc/utils/prof/icons/compslack.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define compslack_width 18
-#define compslack_height 18
-static unsigned char compslack_bits[] = {
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x7f, 0x00, 0x08, 0x40, 0x00,
-   0xa8, 0x4a, 0x00, 0x48, 0x55, 0x00, 0xa8, 0x4a, 0x00, 0x48, 0x55, 0x00,
-   0xa8, 0x4a, 0x00, 0x08, 0x40, 0x00, 0xf8, 0x7f, 0x00, 0x80, 0x07, 0x00,
-   0x00, 0x00, 0x00, 0xdc, 0xc4, 0x01, 0x48, 0x45, 0x00, 0x48, 0xc5, 0x01,
-   0x48, 0x45, 0x00, 0xdc, 0xdc, 0x01};
diff --git a/ghc/utils/prof/icons/delete.xbm b/ghc/utils/prof/icons/delete.xbm
deleted file mode 100644
index 166d605a5a..0000000000
--- a/ghc/utils/prof/icons/delete.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define delete_width 18
-#define delete_height 18
-static unsigned char delete_bits[] = {
-   0xc0, 0x0f, 0x00, 0xe0, 0x1f, 0x00, 0xf0, 0x3f, 0x00, 0x38, 0x73, 0x00,
-   0x38, 0x73, 0x00, 0xf8, 0x7f, 0x00, 0xf8, 0x7f, 0x00, 0xf0, 0x3f, 0x00,
-   0xe0, 0x1f, 0x00, 0x80, 0x07, 0x00, 0x8c, 0xc7, 0x00, 0x0c, 0xc0, 0x00,
-   0x70, 0x38, 0x00, 0x80, 0x07, 0x00, 0x70, 0x38, 0x00, 0x0c, 0xc0, 0x00,
-   0x0c, 0xc0, 0x00, 0x00, 0x00, 0x00};
diff --git a/ghc/utils/prof/icons/help.xbm b/ghc/utils/prof/icons/help.xbm
deleted file mode 100644
index 688e7dbd28..0000000000
--- a/ghc/utils/prof/icons/help.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define help_width 18
-#define help_height 18
-static unsigned char help_bits[] = {
-   0xe0, 0x1f, 0x00, 0xf0, 0x3f, 0x00, 0x70, 0x38, 0x00, 0x70, 0x38, 0x00,
-   0x70, 0x38, 0x00, 0x70, 0x38, 0x00, 0x00, 0x3c, 0x00, 0x00, 0x1e, 0x00,
-   0x00, 0x0f, 0x00, 0x80, 0x07, 0x00, 0x80, 0x07, 0x00, 0x80, 0x07, 0x00,
-   0x80, 0x07, 0x00, 0x00, 0x00, 0x00, 0x00, 0x03, 0x00, 0x80, 0x07, 0x00,
-   0x80, 0x07, 0x00, 0x00, 0x03, 0x00};
diff --git a/ghc/utils/prof/icons/hrel.xbm b/ghc/utils/prof/icons/hrel.xbm
deleted file mode 100644
index 36e58a9baf..0000000000
--- a/ghc/utils/prof/icons/hrel.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define hrel_width 18
-#define hrel_height 18
-static unsigned char hrel_bits[] = {
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x02, 0x00, 0x01, 0x05, 0x80, 0x02, 0xe8, 0x5c, 0x00,
-   0x10, 0x23, 0x00, 0x10, 0x23, 0x00, 0x10, 0x23, 0x00, 0xe0, 0x1c, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/ghc/utils/prof/icons/hrelslack.xbm b/ghc/utils/prof/icons/hrelslack.xbm
deleted file mode 100644
index 8de8f0d36a..0000000000
--- a/ghc/utils/prof/icons/hrelslack.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define hrelslack_width 18
-#define hrelslack_height 18
-static unsigned char hrelslack_bits[] = {
-   0x33, 0x00, 0x00, 0x33, 0x00, 0x00, 0x33, 0x00, 0x00, 0x33, 0x00, 0x00,
-   0xbf, 0xbb, 0x00, 0xbf, 0x8a, 0x00, 0xb3, 0xba, 0x00, 0xb3, 0x89, 0x00,
-   0xb3, 0xba, 0x03, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0xdc, 0xc4, 0x01, 0x48, 0x45, 0x00, 0x48, 0xc5, 0x01,
-   0x48, 0x45, 0x00, 0xdc, 0xdc, 0x01};
diff --git a/ghc/utils/prof/icons/jump.xbm b/ghc/utils/prof/icons/jump.xbm
deleted file mode 100644
index 0e0327d45f..0000000000
--- a/ghc/utils/prof/icons/jump.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define jump_width 18
-#define jump_height 18
-static unsigned char jump_bits[] = {
-   0x00, 0x00, 0x00, 0x7e, 0x00, 0x00, 0x42, 0x55, 0x01, 0x42, 0x00, 0x02,
-   0x7e, 0x01, 0x00, 0x88, 0x00, 0x02, 0x08, 0x01, 0x00, 0x7e, 0x7e, 0x02,
-   0x42, 0x43, 0x00, 0x42, 0x42, 0x02, 0x7e, 0x7f, 0x00, 0x00, 0x00, 0x02,
-   0x00, 0x55, 0x01, 0x00, 0x00, 0x00, 0x57, 0xdb, 0x01, 0x52, 0x55, 0x01,
-   0x52, 0xd1, 0x01, 0x73, 0x51, 0x00};
diff --git a/ghc/utils/prof/icons/mycomm.xbm b/ghc/utils/prof/icons/mycomm.xbm
deleted file mode 100644
index 8a3adcdb25..0000000000
--- a/ghc/utils/prof/icons/mycomm.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define comm_width 18
-#define comm_height 18
-static unsigned char comm_bits[] = {
-   0xe0, 0x1f, 0x00, 0xfc, 0xff, 0x00, 0x67, 0x98, 0x03, 0x67, 0x98, 0x03,
-   0xc7, 0x8f, 0x03, 0x60, 0x18, 0x00, 0xb0, 0x37, 0x00, 0xb8, 0x77, 0x00,
-   0xbc, 0xf7, 0x00, 0x7c, 0xf8, 0x00, 0xfc, 0xff, 0x00, 0xfc, 0xff, 0x00,
-   0x00, 0x00, 0x00, 0x8c, 0x51, 0x00, 0x52, 0xaa, 0x00, 0x42, 0xaa, 0x00,
-   0x52, 0x8a, 0x00, 0x8c, 0x89, 0x00};
diff --git a/ghc/utils/prof/icons/oxpara.xbm b/ghc/utils/prof/icons/oxpara.xbm
deleted file mode 100644
index 323270f9dd..0000000000
--- a/ghc/utils/prof/icons/oxpara.xbm
+++ /dev/null
@@ -1,198 +0,0 @@
-#define oxpara_width 287
-#define oxpara_height 65
-static unsigned char oxpara_bits[] = {
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/ghc/utils/prof/icons/percent.xbm b/ghc/utils/prof/icons/percent.xbm
deleted file mode 100644
index 1dd05821c6..0000000000
--- a/ghc/utils/prof/icons/percent.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define percent_width 18
-#define percent_height 18
-static unsigned char percent_bits[] = {
-   0x00, 0x00, 0x00, 0x38, 0x80, 0x01, 0x7c, 0xc0, 0x01, 0xfe, 0xe0, 0x00,
-   0xfe, 0x70, 0x00, 0xfe, 0x38, 0x00, 0x7c, 0x1c, 0x00, 0x38, 0x0e, 0x00,
-   0x00, 0x07, 0x00, 0x80, 0x03, 0x00, 0xc0, 0x71, 0x00, 0xe0, 0xf8, 0x00,
-   0x70, 0xfc, 0x01, 0x38, 0xfc, 0x01, 0x1c, 0xfc, 0x01, 0x0e, 0xf8, 0x00,
-   0x06, 0x70, 0x00, 0x00, 0x00, 0x00};
diff --git a/ghc/utils/prof/icons/reldelta.xbm b/ghc/utils/prof/icons/reldelta.xbm
deleted file mode 100644
index 4e79b68ba8..0000000000
--- a/ghc/utils/prof/icons/reldelta.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define reldelta_width 18
-#define reldelta_height 18
-static unsigned char reldelta_bits[] = {
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x04, 0x06, 0x00,
-   0x0e, 0x03, 0x00, 0x91, 0x21, 0x00, 0xd1, 0x50, 0x00, 0x6a, 0x88, 0x00,
-   0x1c, 0x44, 0x01, 0x1c, 0x22, 0x02, 0x6a, 0x50, 0x00, 0xd1, 0x88, 0x00,
-   0x91, 0x41, 0x01, 0x0e, 0x23, 0x02, 0x04, 0x06, 0x00, 0x00, 0x04, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/ghc/utils/prof/icons/sync.xbm b/ghc/utils/prof/icons/sync.xbm
deleted file mode 100644
index 55f3e55ff4..0000000000
--- a/ghc/utils/prof/icons/sync.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define sync_width 18
-#define sync_height 18
-static unsigned char sync_bits[] = {
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x70, 0x00, 0x00,
-   0x20, 0x00, 0x00, 0x50, 0x00, 0x00, 0x88, 0x00, 0x00, 0x04, 0x01, 0x00,
-   0x02, 0x02, 0x00, 0x07, 0x07, 0x00, 0x02, 0x02, 0x00, 0x00, 0x05, 0x00,
-   0x80, 0x08, 0x00, 0x40, 0x10, 0x00, 0x20, 0x20, 0x00, 0x70, 0x70, 0x00,
-   0x20, 0x20, 0x00, 0x00, 0x00, 0x00};
diff --git a/ghc/utils/prof/icons/time.xbm b/ghc/utils/prof/icons/time.xbm
deleted file mode 100644
index e8a79375b3..0000000000
--- a/ghc/utils/prof/icons/time.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define time_width 18
-#define time_height 18
-static unsigned char time_bits[] = {
-   0x80, 0x01, 0x00, 0x80, 0x01, 0x00, 0xe0, 0x0f, 0x00, 0xf8, 0x3f, 0x00,
-   0x9c, 0x31, 0x00, 0x8c, 0x01, 0x00, 0x9c, 0x01, 0x00, 0xf8, 0x0f, 0x00,
-   0xe0, 0x3f, 0x00, 0x80, 0x39, 0x00, 0x80, 0x61, 0x00, 0x80, 0x61, 0x00,
-   0x8c, 0x71, 0x00, 0x9c, 0x39, 0x00, 0xf8, 0x1f, 0x00, 0xf0, 0x07, 0x00,
-   0x80, 0x01, 0x00, 0x80, 0x01, 0x00};
diff --git a/ghc/utils/prof/icons/time1.xbm b/ghc/utils/prof/icons/time1.xbm
deleted file mode 100644
index 0d2d4d7268..0000000000
--- a/ghc/utils/prof/icons/time1.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define time_width 18
-#define time_height 18
-static unsigned char time_bits[] = {
-   0x80, 0x01, 0x00, 0x80, 0x01, 0x00, 0xe0, 0x1f, 0x00, 0xf0, 0x3f, 0x00,
-   0x98, 0x31, 0x00, 0x8c, 0x01, 0x00, 0x9c, 0x01, 0x00, 0xf8, 0x0f, 0x00,
-   0xe0, 0x1f, 0x00, 0x80, 0x31, 0x00, 0x80, 0x61, 0x00, 0x80, 0x61, 0x00,
-   0x80, 0x31, 0x00, 0x98, 0x19, 0x00, 0xf8, 0x0f, 0x00, 0xf0, 0x07, 0x00,
-   0x80, 0x01, 0x00, 0x80, 0x01, 0x00};
diff --git a/ghc/utils/prof/icons/uncompress.xbm b/ghc/utils/prof/icons/uncompress.xbm
deleted file mode 100644
index 56f1293316..0000000000
--- a/ghc/utils/prof/icons/uncompress.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define uncompress_width 18
-#define uncompress_height 18
-static unsigned char uncompress_bits[] = {
-   0x1f, 0xe0, 0x03, 0x07, 0x80, 0x03, 0x0f, 0xc0, 0x03, 0x1d, 0xe0, 0x02,
-   0x39, 0x70, 0x02, 0x70, 0x38, 0x00, 0xe0, 0x1c, 0x00, 0x40, 0x08, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x08, 0x00, 0xe0, 0x1c, 0x00,
-   0x70, 0x38, 0x00, 0x39, 0x70, 0x02, 0x1d, 0xe0, 0x02, 0x0f, 0xc0, 0x03,
-   0x07, 0x80, 0x03, 0x1f, 0xe0, 0x03};
diff --git a/ghc/utils/prof/icons/undo.xbm b/ghc/utils/prof/icons/undo.xbm
deleted file mode 100644
index 0658dc1e8e..0000000000
--- a/ghc/utils/prof/icons/undo.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define undo_width 18
-#define undo_height 18
-static unsigned char undo_bits[] = {
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
-   0x95, 0x8e, 0x01, 0x95, 0x52, 0x02, 0xb5, 0x52, 0x02, 0xd5, 0x52, 0x02,
-   0x95, 0x52, 0x02, 0x97, 0x8e, 0x01, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00,
-   0x00, 0x80, 0x00, 0xfe, 0xff, 0x01, 0x00, 0x00, 0x00, 0xfe, 0xff, 0x01,
-   0x04, 0x00, 0x00, 0x08, 0x00, 0x00};
diff --git a/ghc/utils/prof/icons/wait.xbm b/ghc/utils/prof/icons/wait.xbm
deleted file mode 100644
index b0c16fc014..0000000000
--- a/ghc/utils/prof/icons/wait.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define wait_width 18
-#define wait_height 18
-static unsigned char wait_bits[] = {
-   0x00, 0x00, 0x00, 0x80, 0x07, 0x00, 0xf0, 0x3c, 0x00, 0x08, 0x40, 0x00,
-   0x0c, 0xc0, 0x00, 0x14, 0xe0, 0x00, 0x64, 0x98, 0x00, 0x84, 0x87, 0x00,
-   0x04, 0x80, 0x00, 0x04, 0x80, 0x00, 0x04, 0x80, 0x00, 0x04, 0x80, 0x00,
-   0x04, 0x80, 0x00, 0x04, 0x80, 0x00, 0x04, 0xc0, 0x00, 0x08, 0x40, 0x00,
-   0x70, 0x38, 0x00, 0x80, 0x07, 0x00};
diff --git a/ghc/utils/prof/icons/weightdelta.xbm b/ghc/utils/prof/icons/weightdelta.xbm
deleted file mode 100644
index 9ffa012260..0000000000
--- a/ghc/utils/prof/icons/weightdelta.xbm
+++ /dev/null
@@ -1,8 +0,0 @@
-#define weightdelta_width 18
-#define weightdelta_height 18
-static unsigned char weightdelta_bits[] = {
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00, 0x04, 0x06, 0x00,
-   0x0e, 0x03, 0x00, 0x91, 0x01, 0x00, 0xd1, 0x00, 0x00, 0x6a, 0x04, 0x01,
-   0x1c, 0x8a, 0x02, 0x1c, 0x8a, 0x02, 0x6a, 0x24, 0x01, 0xd1, 0x00, 0x00,
-   0x91, 0x01, 0x00, 0x0e, 0x03, 0x00, 0x04, 0x06, 0x00, 0x00, 0x04, 0x00,
-   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/ghc/utils/pvm/README b/ghc/utils/pvm/README
deleted file mode 100644
index 5ab58ddec8..0000000000
--- a/ghc/utils/pvm/README
+++ /dev/null
@@ -1,4 +0,0 @@
-"debugger2" is our hacked version of the one that
-comes with PVM 3.3.7.
-
-Less sure about "debugger.emacs"...
diff --git a/ghc/utils/pvm/debugger.emacs b/ghc/utils/pvm/debugger.emacs
deleted file mode 100644
index ee053ca7b4..0000000000
--- a/ghc/utils/pvm/debugger.emacs
+++ /dev/null
@@ -1,37 +0,0 @@
-#!/bin/csh -f
-#
-#	debugger.csh
-#
-#	this script is invoked by the pvmd when a task is spawned with
-#	the PvmTaskDebug flag set.  it execs an xterm with script
-#	debugger2 running inside.
-#
-#	06 Apr 1993  Manchek
-#
-
-if ($#argv < 1) then
-	echo "usage: debugger command [args]"
-	exit 1
-endif
-
-# scratch file for debugger commands
-
-set TEMPCMD=gdb$$.cmd
-set TEMPLISP=gdb$$.el
-
-# default debugger and flags
-
-#
-# run the debugger
-#
-
-echo run $argv[2-] > $TEMPCMD
-echo "(gdb "'"'"$argv[1] -q -x $TEMPCMD"'")' > $TEMPLISP
-
-emacs -l $TEMPLISP
-
-#rm -f $TEMPCMD $TEMPLISP
-
-exit 0
-
-
diff --git a/ghc/utils/pvm/debugger2 b/ghc/utils/pvm/debugger2
deleted file mode 100644
index 7cdf8b9a1a..0000000000
--- a/ghc/utils/pvm/debugger2
+++ /dev/null
@@ -1,48 +0,0 @@
-#!/bin/csh -f
-#
-#	debugger2.csh
-#
-#	this script is invoked in an xterm by the generic debugger script.
-#	it starts the debugger and waits when it exits to prevent the
-#	window from closing.
-#
-#	it expects the pvmd to set envar PVM_ARCH.
-#
-#	06 Apr 1993  Manchek
-#
-
-set noglob
-
-# scratch file for debugger commands
-
-set TEMPCMD=/tmp/debugger2.$$
-
-# default debugger and flags
-
-set DBCMD="gdb"
-set DBFF="-q -x $TEMPCMD"
-
-#
-# try to pick the debugger by arch name
-#
-
-#
-# run the debugger
-#
-
-echo run $argv[2-] > $TEMPCMD
-$DBCMD $DBFF $argv[1]
-
-#$DBCMD $argv[1]
-
-#rm -f $TEMPCMD
-
-#
-# wait to go away
-#
-
-#reset
-#sleep 1
-rm -f $TEMPCMD
-exit 0
-
diff --git a/ghc/utils/runghc/Makefile b/ghc/utils/runghc/Makefile
deleted file mode 100644
index fd18313305..0000000000
--- a/ghc/utils/runghc/Makefile
+++ /dev/null
@@ -1,32 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-HS_PROG		= runghc$(exeext)
-INSTALL_PROGS   += $(HS_PROG)
-
-UseGhcForCc = YES
-SRC_MKDEPENDC_OPTS += -I$(GHC_INCLUDE_DIR)
-
-# This causes libghccompat.a to be used:
-include $(GHC_LIB_COMPAT_DIR)/compat.mk
-
-# This is required because libghccompat.a must be built with
-# $(GhcHcOpts) because it is linked to the compiler, and hence
-# we must also build with $(GhcHcOpts) here:
-SRC_HC_OPTS += $(GhcHcOpts)
-
-all :: runhaskell
-
-runhaskell : $(HS_PROG)
-	$(CP) $< runhaskell$(exeext)
-
-CLEAN_FILES += runhaskell
-
-# Only install runhaskell if there isn't already one installed
-ifneq "$(findstring install, $(MAKECMDGOALS))" ""
-ifeq "$(wildcard $(bindir)/runhaskell)" ""
-INSTALL_PROGS += runhaskell$(exeext)
-endif
-endif
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/runghc/runghc.hs b/ghc/utils/runghc/runghc.hs
deleted file mode 100644
index f8330b5721..0000000000
--- a/ghc/utils/runghc/runghc.hs
+++ /dev/null
@@ -1,66 +0,0 @@
-{-# OPTIONS -cpp -fffi #-}
-#if __GLASGOW_HASKELL__ < 603
-#include "config.h"
-#else
-#include "ghcconfig.h"
-#endif
------------------------------------------------------------------------------
---
--- (c) The University of Glasgow, 2004
---
--- runghc program, for invoking from a #! line in a script.  For example:
---
---   script.lhs:
---	#! /usr/bin/runghc
---	> main = putStrLn "hello!"
---
--- runghc accepts one flag:
---
---	-f <path>    specify the path
---
--- -----------------------------------------------------------------------------
-
-module Main where
-
-import System.Environment
-import System.IO
-import Data.List
-import System.Exit
-import Data.Char
-
-import Compat.RawSystem 	( rawSystem )
-import Compat.Directory 	( findExecutable )
-
-main = do 
-  args <- getArgs
-  case args of
-    ('-':'f' : ghc) : args -> do
-	doIt (dropWhile isSpace ghc) args
-    args -> do
-	mb_ghc <- findExecutable "ghc"
-	case mb_ghc of
-	  Nothing  -> dieProg ("cannot find ghc")
-	  Just ghc -> doIt ghc args
-
-doIt ghc args = do
-  let
-    (ghc_args, rest) = break notArg args
-  --
-  case rest of
-     [] -> dieProg "syntax: runghc [-f GHCPATH] [GHC-ARGS] FILE ARG..."
-     filename : prog_args -> do
-	  res <- rawSystem ghc (
-			"-ignore-dot-ghci" : ghc_args ++ 
-			[ "-e","System.Environment.withProgName "++show filename++" (System.Environment.withArgs ["
-			  ++ concat (intersperse "," (map show prog_args))
-			  ++ "] Main.main)", filename])
-  	  exitWith res
-
-notArg ('-':_) = False
-notArg _       = True
-
-dieProg :: String -> IO a
-dieProg msg = do
-  p <- getProgName
-  hPutStrLn stderr (p ++ ": " ++ msg)
-  exitWith (ExitFailure 1)
diff --git a/ghc/utils/stat2resid/Makefile b/ghc/utils/stat2resid/Makefile
deleted file mode 100644
index 42c0c4107f..0000000000
--- a/ghc/utils/stat2resid/Makefile
+++ /dev/null
@@ -1,59 +0,0 @@
-#-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.11 2000/09/05 10:16:41 simonmar Exp $
-
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-DYN_LOADABLE_BITS = \
-	parse-gcstats.prl \
-	process-gcstats.prl
-
-SCRIPT_PROG=stat2resid
-SCRIPT_OBJS=stat2resid.prl
-
-#
-# Could be overridden from the cmd line (see install rule below).
-#
-INSTALLING=0
-
-ifneq "$(BIN_DIST)" "1"
-SCRIPT_SUBST_VARS=DEFAULT_TMPDIR
-endif
-
-INTERP=perl
-
-#
-# The stat2resid script is configured with a different
-# path to the supporting perl scripts, depending on whether it
-# is to be installed or not.
-#
-ifeq "$(INSTALLING)" "1"
-ifeq "$(BIN_DIST)" "1"
-SCRIPT_PREFIX_FILES += prefix.txt
-endif
-endif
-
-#
-# install setup
-# 
-INSTALL_LIBS    += $(DYN_LOADABLE_BITS)
-INSTALL_SCRIPTS += $(SCRIPT_PROG)
-
-
-#
-# Before really installing the script, we have to
-# reconfigure it such that the paths it refers to,
-# point to the installed utils.
-#
-install ::
-	$(RM) $(SCRIPT_PROG)
-	$(MAKE) $(MFLAGS) INSTALLING=1 $(SCRIPT_PROG)
-
-include $(TOP)/mk/target.mk
-
-# Hack to re-create the in-situ build tree script after 
-# having just installed it.
-#
-install ::
-	@$(RM) $(SCRIPT_PROG)
-	@$(MAKE) $(MFLAGS) $(SCRIPT_PROG)
diff --git a/ghc/utils/stat2resid/parse-gcstats.prl b/ghc/utils/stat2resid/parse-gcstats.prl
deleted file mode 100644
index d882ee6348..0000000000
--- a/ghc/utils/stat2resid/parse-gcstats.prl
+++ /dev/null
@@ -1,232 +0,0 @@
-#
-# Subroutines to parses a ghc Garbage Collection stats file
-#
-#%gcstats = &parse_stats($ARGV[0]);
-#&print_stats(">-", %gcstats);
-#exit 0;
-
-sub to_num {
-    local ($text) = @_;
-    return($1 * 1000000000 + $2 * 1000000 + $3 * 1000 + $4)
-	if ( $text =~ /^(\d*),(\d*),(\d*),(\d*)$/ );
-    return($1 * 1000000 + $2 * 1000 + $3)
-	if ( $text =~ /^(\d*),(\d*),(\d*)$/ );
-    return($1 * 1000 + $2)
-	if ( $text =~ /^(\d*),(\d*)$/ );
-    return($1)
-	if ( $text =~ /^(\d*)$/ );
-    die "Error converting $text\n";
-}
-
-sub from_num {
-    local ($num) = @_;
-    local ($b, $m, $t, $o) = (int($num/1000000000), int($num/1000000)%1000,
-	   		      int($num/1000)%1000, $num%1000);
-    return(sprintf("%d,%03d,%03d,%03d", $b, $m, $t, $o)) if $b > 0;
-    return(sprintf("%d,%03d,%03d", $m, $t, $o))		 if $m > 0;
-    return(sprintf("%d,%03d", $t, $o)) 			 if $t > 0;
-    return(sprintf("%d", $o)) 				 if $o > 0;
-}
-
-sub parse_stats {
-    local($filename) = @_;
-    local($tot_alloc, $tot_gc_user, $tot_mut_user, $tot_user,
-		      $tot_gc_elap, $tot_mut_elap, $tot_elap);
-    local($statsfile, $line, $row, $col, $val);
-    local(@stats, @hdr1, @hdr2, @line_vals);
-    local(%the_stats);
-    local(*STATS);
-
-    open(STATS, $filename) || die "Cant open $filename \n";
-    @stats = <STATS>;
-
-    do {$line = shift(@stats);} until ($line !~ /^$/);
-    chop($line);
-    ($the_stats{"command"}, $the_stats{"args"}) = split(' ', $line, 2);
-
-    do {$line = shift(@stats);} until ($line !~ /^$/);
-    $line =~ /Collector:\s*([A-Z]+)\s*HeapSize:\s*([\d,]+)/;
-    $the_stats{"collector"} = $1;
-    $the_stats{"heapsize"}  = &to_num($2);
-
-    do {$line = shift(@stats);} until ($line !~ /^$/);
-    chop($line);
-    @hdr1 = split(' ', $line);
-    $line = shift(@stats);
-    chop($line);
-    @hdr2 = split(' ', $line);
-
-    $row = 0;
-    $tot_alloc = 0;
-    $tot_gc_user = 0; 
-    $tot_gc_elap = 0; 
-    $tot_mut_user = 0; 
-    $tot_mut_elap = 0; 
-    $tot_user = 0;
-    $tot_elap = 0;
-
-    while (($line = shift(@stats)) !~ /^\s*\d+\s*$/) {
-	chop($line);
-	@line_vals = split(' ', $line);
-
-	$col = -1;
-	word:
-	    while(++$col <= $#line_vals) {
-	
-	    $val = $line_vals[$col];
-	    $_ = @hdr1[$col] . @hdr2[$col];
-
-	    /^Allocbytes$/      && do {	$tot_alloc += $val;
-				   	$the_stats{"alloc_$row"} = $val;
-				   	next word; };
-
-	    /^Collectbytes$/	&& do {	$the_stats{"collect_$row"} = $val;
-				   	next word; };
-
-	    /^Livebytes$/	&& do {	$the_stats{"live_$row"} = $val;
-				   	next word; };
-
-	    /^Residency$/	&& do { next word; };
-
-	    /^GCuser$/		&& do {	$tot_gc_user += $val;
-					$the_stats{"gc_user_$row"} = $val;
-				   	next word; };
-
-	    /^GCelap$/		&& do {	$tot_gc_elap += $val;
-					$the_stats{"gc_elap_$row"} = $val;
-				   	next word; };
-
-	    /^TOTuser$/		&& do {	$the_stats{"mut_user_$row"} =
-						$val - $tot_user - $the_stats{"gc_user_$row"};
-					$tot_mut_user += $the_stats{"mut_user_$row"};
-					$tot_user = $val;
-				   	next word; };
-
-	    /^TOTelap$/		&& do {	$the_stats{"mut_elap_$row"} =
-						$val - $tot_elap - $the_stats{"gc_elap_$row"};
-					$tot_mut_elap += $the_stats{"mut_elap_$row"};
-					$tot_elap = $val;
-				   	next word; };
-
-	    /^PageGC$/		&& do {	$the_stats{"gc_pflts_$row"} = $val;
-				   	next word; };
-
-	    /^FltsMUT$/		&& do {	$the_stats{"mut_pflts_$row"} = $val;
-				   	next word; };
-
-	    /^Collection/	&& do { $the_stats{"mode_$row"} = $val;
-				   	next word; };
-
-	    /^Astkbytes$/	&& do {next word; };
-	    /^Bstkbytes$/	&& do {next word; };
-	    /^CafNo$/		&& do {next word; };
-	    /^Cafbytes$/	&& do {next word; };
-
-	    /^NoAstk$/		&& do {next word; };
-	    /^ofBstk$/		&& do {next word; };
-	    /^RootsReg$/	&& do {next word; };
-	    /^OldGen$/		&& do {next word; };
-	    /^RootsCaf$/	&& do {next word; };
-	    /^Sizebytes$/	&& do {next word; };
-	    /^Resid\%heap$/	&& do {next word; };
-
-            /^$/		&& do {next word; };
-
-	    print STDERR "Unknown: $_ = $val\n";
-	};
-
-	$row++;
-    };
-    $tot_alloc += $line;
-    $the_stats{"alloc_$row"} = $line;
-
-arg: while($_ = $stats[0]) {
-    shift(@stats);
-
-    /^\s*([\d,]+) bytes alloc/	&& do { local($a) = &to_num($1);
-					$a == $tot_alloc || die "Total $a != $tot_alloc \n";
-					$the_stats{"alloc_total"} = $tot_alloc;
-					next arg; };
-
-    /^\s*([\d]+) garbage/   	&& do { $1 == $row || die "GCNo $1 != $row \n";
-					$the_stats{"gc_no"} = $row;
-					next arg; };
-
-    /Total time\s+([\d\.]+)s\s+\(\s*([\d.]+)s elapsed\)/ && do {
-					$the_stats{"user_total"} = $1;
-					$the_stats{"elap_total"} = $2;
-					$the_stats{"mut_user_total"} = $1 - $tot_gc_user;
-					$the_stats{"mut_elap_total"} = $2 - $tot_gc_elap;
-					$the_stats{"mut_user_$row"} = $1 - $tot_gc_user - $tot_mut_user;
-					$the_stats{"mut_elap_$row"} = $2 - $tot_gc_elap - $tot_mut_elap;
-					next arg; };
-
-    /GC\s+time\s+([\d\.]+)s\s+\(\s*([\d.]+)s elapsed\)/ && do {
-					# $1 == $tot_gc_user || die "GCuser $1 != $tot_gc_user \n";
-					# $2 == $tot_gc_elap || die "GCelap $2 != $tot_gc_elap \n";
-					$the_stats{"gc_user_total"} = $tot_gc_user;
-					$the_stats{"gc_elap_total"} = $tot_gc_elap;
-					next arg; };
-    
-    /MUT\s+time/		&& do { next arg; };
-    /INIT\s+time/		&& do { next arg; };
-    /^\s*([\d,]+) bytes maximum residency/ && do { next arg; };
-
-    /\%GC time/			&& do { next arg; };
-    /Alloc rate/		&& do { next arg; };
-    /Productivity/		&& do { next arg; };
-    /^$/			&& do { next arg; };
-    /^\#/			&& do { next arg; };  # Allows comments to follow
-    
-    print STDERR "Unmatched line: $_";
-    }
-
-    close(STATS);
-    %the_stats;
-}
-
-sub print_stats {
-    local ($filename, %out_stats) = @_;
-    local($statsfile, $row);
-
-    open($statsfile, $filename) || die "Cant open $filename \n";
-    select($statsfile);
-
-    print $out_stats{"command"}, " ", $out_stats{"args"}, "\n\n";
-    print "Collector: ", $out_stats{"collector"}, "  HeapSize: ", &from_num($out_stats{"heapsize"}), " (bytes)\n\n";
-
-    $row = 0;
-    while ($row < $out_stats{"gc_no"}) {
-	printf  "%7d %7d %7d %5.2f %5.2f %5.2f %5.2f %4d %4d  %s\n",
-		$out_stats{"alloc_$row"},
-		$out_stats{"collect_$row"},
-		$out_stats{"live_$row"},
-		$out_stats{"gc_user_$row"},
-		$out_stats{"gc_elap_$row"},
-		$out_stats{"mut_user_$row"},
-		$out_stats{"mut_elap_$row"},
-		$out_stats{"gc_pflts_$row"},
-		$out_stats{"mut_pflts_$row"},
-		$out_stats{"mode_$row"};
-	$row++;
-    };
-    printf "%7d %s %5.2f %5.2f \n\n",
-   	   $out_stats{"alloc_$row"}, " " x 27,
-	   $out_stats{"mut_user_$row"},
-	   $out_stats{"mut_elap_$row"};
-
-    printf "Total Alloc: %s\n", &from_num($out_stats{"alloc_total"});
-    printf "      GC No: %d\n\n", $out_stats{"gc_no"};
-
-    printf "  MUT User: %6.2fs\n", $out_stats{"mut_user_total"};
-    printf "   GC User: %6.2fs\n", $out_stats{"gc_user_total"};
-    printf "Total User: %6.2fs\n\n", $out_stats{"user_total"};
-
-    printf "  MUT Elap: %6.2fs\n", $out_stats{"mut_elap_total"};
-    printf "   GC Elap: %6.2fs\n", $out_stats{"gc_elap_total"};
-    printf "Total Elap: %6.2fs\n", $out_stats{"elap_total"};
-
-    close($statsfile);
-}
-
-1;
diff --git a/ghc/utils/stat2resid/prefix.txt b/ghc/utils/stat2resid/prefix.txt
deleted file mode 100644
index 0de9d61f25..0000000000
--- a/ghc/utils/stat2resid/prefix.txt
+++ /dev/null
@@ -1,10 +0,0 @@
-#
-# stat2resid - generating graphs from garbage collection stats.
-#
-# To use the script on your system, the following variable
-# needs to be uncommented and set, if it hasn't already
-# been set above automatically:
-#
-#$libdir='/local/fp/lib/fptools/i386-unknown-footos/ghc-2.02';
-#
-
diff --git a/ghc/utils/stat2resid/process-gcstats.prl b/ghc/utils/stat2resid/process-gcstats.prl
deleted file mode 100644
index ff41cf6af9..0000000000
--- a/ghc/utils/stat2resid/process-gcstats.prl
+++ /dev/null
@@ -1,45 +0,0 @@
-#
-# Subroutines which derive information from
-#   ghc garbage collection stats -- %gcstat
-#
-
-sub max_residency {
-    local(%gcstats) = @_;
-    local($i, $max) = (-1, 0);
-
-    if ($gcstats{"collector"} eq "APPEL") {
-    	die "APPEL stats: average residency not possible\n" ;
-    }
-
-    while(++$i < $gcstats{"gc_no"}) {
-	$max = $gcstats{"live_$i"} > $max ?
-		   $gcstats{"live_$i"} : $max;
-    }
-    $max;
-}
-
-sub avg_residency {
-    local(%gcstats) = @_;
-    local($i, $j, $total);
-
-    if ($gcstats{"collector"} eq "APPEL") {
-    	die "APPEL stats: average residency not possible\n" ;
-    }
-
-    if ($gcstats{"gc_no"} == 0) { return(0); };
-
-    $i = 0; $j = 0;
-    $total = $gcstats{"live_$i"} * $gcstats{"mut_user_$i"} / 2;
-
-    while(++$i < $gcstats{"gc_no"}) {
-	$total += ($gcstats{"live_$i"} + $gcstats{"live_$j"})
-		 * $gcstats{"mut_user_$i"} / 2;
-	$j = $i;
-    };
-
-    $total += $gcstats{"live_$j"} * $gcstats{"mut_user_$i"} / 2;
-
-    int($total / $gcstats{"mut_user_total"});
-}
-
-1;
diff --git a/ghc/utils/stat2resid/stat2resid.prl b/ghc/utils/stat2resid/stat2resid.prl
deleted file mode 100644
index bf0a262428..0000000000
--- a/ghc/utils/stat2resid/stat2resid.prl
+++ /dev/null
@@ -1,81 +0,0 @@
-#
-# (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
-#
-# Perl script expect bindings for the following variables to be prepended
-#
-#   DEFAULT_TMPDIR libdir
-#
-# without them, not much success :-(
-#
-
-$debug = 0; # first line of script, builds confidence :-)
-$outsuffix = ".resid.ps";	# change as appropriate
-
-if ( $ENV{'TMPDIR'} ) { # where to make tmp file names
-    $tmpfile = $ENV{'TMPDIR'} . "/$$.resid.data";
-} else {
-    $tmpfile ="${DEFAULT_TMPDIR}/$$.resid.data";
-    $ENV{'TMPDIR'} = ${DEFAULT_TMPDIR}; # set the env var as well
-}
-
-@INC = ( ${libdir} );
-
-require('parse-gcstats.prl')   || die "Can't load parse-gcstats.prl!\n";
-require('process-gcstats.prl') || die "Can't load process-gcstats.prl!\n";
-
-if ($#ARGV < 0) {
-    $infile = "-";
-    $outfile = "";				# gnuplot: set output
-} elsif ($#ARGV == 0) {
-    $infile = $ARGV[0];
-    if ($infile =~ /^(.*)\.stat$/) {
-	$base = $1;
-    } else {
-        $base = $infile;
-	$infile  = "$base.stat";
-    };
-    $outfile = "\"$base$outsuffix\"";	        # gnuplot: set output "outfile"
-} elsif ($#ARGV == 1) {
-    $infile = $ARGV[0];
-    $outfile = "\"$ARGV[1]\"";
-} else {
-    die "Usage: command [infile[.stat] [outfile]]";
-};   
-
-%gcstats = &parse_stats($infile);
-
-&print_stats(">&STDERR", %gcstats) if $debug;
-
-if ($gcstats{"collector"} eq "APPEL") {
-    die "APPEL stats: no residency plot possible\n";
-}
-
-#
-# stats are now loaded into %gcstats -- write out info
-#
-
-open(DATAFILE, ">$tmpfile") || die "Cant open >$tmpfile \n";
-$i = -1;
-$user = 0;
-printf DATAFILE "%4.2f %d\n", $user, 0;
-while (++$i < $gcstats{"gc_no"}) {
-   $user += $gcstats{"mut_user_$i"};
-   printf DATAFILE "%4.2f %d\n", $user, $gcstats{"live_$i"}; 
-}; 
-printf DATAFILE "%4.2f %d\n", $gcstats{"mut_user_total"}, 0;
-close(DATAFILE);
-
-open(PLOTFILE, "|gnuplot") || die "Cant pipe into |gnuplot \n";
-print PLOTFILE "set data style linespoints\n";
-print PLOTFILE "set function style lines\n";
-print PLOTFILE "set nokey\n";
-print PLOTFILE "set xlabel \"Mutator Time (secs)\"\n";
-print PLOTFILE "set ylabel \"Heap Residency (bytes)\" 0,-1\n";
-print PLOTFILE "set term post eps \"Times-Roman\" 20\n";
-printf PLOTFILE "set title \"%s %s  (%s)\"\n", $gcstats{"command"}, $gcstats{"args"}, $infile;
-print PLOTFILE "set output $outfile\n" ;
-print PLOTFILE "plot \"$tmpfile\"\n";
-close(PLOTFILE);
-
-unlink($tmpfile);
-exit 0;
diff --git a/ghc/utils/touchy/Makefile b/ghc/utils/touchy/Makefile
deleted file mode 100644
index d2430df162..0000000000
--- a/ghc/utils/touchy/Makefile
+++ /dev/null
@@ -1,20 +0,0 @@
-#
-# Substitute for 'touch' on win32 platforms (without an Unix toolset installed).
-#
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-C_SRCS=touchy.c
-C_PROG=touchy
-SRC_CC_OPTS += -O
-
-#
-# Install touchy in lib/.*
-#
-INSTALL_LIBEXECS += $(C_PROG)
-
-include $(TOP)/mk/target.mk
-
-# Get it over with!
-boot :: all
-
diff --git a/ghc/utils/touchy/touchy.c b/ghc/utils/touchy/touchy.c
deleted file mode 100644
index 90fb31e93e..0000000000
--- a/ghc/utils/touchy/touchy.c
+++ /dev/null
@@ -1,63 +0,0 @@
-/*
- * Simple _utime() wrapper for setting the mod. time on files
- * to the current system time.
- *
- */
-#if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32)
-#error "Win32-only, the platform you're using is supposed to have 'touch' already."
-#else
-#include <stdio.h>
-#include <sys/stat.h>
-#include <sys/types.h>
-#include <fcntl.h>
-#include <errno.h>
-
-int
-main(int argc, char** argv)
-{
-  int rc;
-  int i=0;
-  int fd;
-  int wBitSet = 0;
-  struct _stat sb;
-
-  if (argc == 1) {
-    fprintf(stderr, "Usage: %s <files>\n", argv[0]);
-    return 1;
-  }
-  
-  
-  while (i++ < (argc-1)) {
-    if ( (_access(argv[i], 00) < 0) && (errno == ENOENT || errno == EACCES) ) {
-       /* File doesn't exist, try creating it. */
-      if ( (fd = _open(argv[i], _O_CREAT | _O_EXCL | _O_TRUNC, _S_IREAD | _S_IWRITE)) < 0 ) {
-      	fprintf(stderr, "Unable to create %s, skipping.\n", argv[i]);
-      } else {
-      	_close(fd);
-      }
-    }
-    if ( (_access(argv[i], 02)) < 0 ) {
-    	/* No write permission, try setting it first. */
-	if (_stat(argv[i], &sb) < 0) {
-	   fprintf(stderr, "Unable to change mod. time for %s  (%d)\n", argv[i], errno);
-	   continue;
-	}
-	if (_chmod(argv[i], (sb.st_mode & _S_IREAD) | _S_IWRITE) < 0) {
-	   fprintf(stderr, "Unable to change mod. time for %s  (%d)\n", argv[i], errno);
-	   continue;
-	}
-	wBitSet = 1;
-    }
-    if ( (rc = _utime(argv[i],NULL)) < 0) {
-      fprintf(stderr, "Unable to change mod. time for %s  (%d)\n", argv[i], errno);
-    }
-    if (wBitSet) {
-	/* Turn the file back into a read-only file */
-   	_chmod(argv[i], (sb.st_mode & _S_IREAD));
-	wBitSet = 0;
-    }
-  }
-  
-  return 0;
-}
-#endif
diff --git a/ghc/utils/unlit/Makefile b/ghc/utils/unlit/Makefile
deleted file mode 100644
index 15e7fc4252..0000000000
--- a/ghc/utils/unlit/Makefile
+++ /dev/null
@@ -1,16 +0,0 @@
-TOP=../..
-include $(TOP)/mk/boilerplate.mk
-
-C_SRCS=unlit.c
-C_PROG=unlit
-SRC_CC_OPTS += -O
-
-# Get it over with!
-boot :: all
-
-#
-# Install unlit in lib/
-#
-INSTALL_LIBEXECS += $(C_PROG)
-
-include $(TOP)/mk/target.mk
diff --git a/ghc/utils/unlit/README b/ghc/utils/unlit/README
deleted file mode 100644
index 4dd2ef5132..0000000000
--- a/ghc/utils/unlit/README
+++ /dev/null
@@ -1,8 +0,0 @@
-This "unlit" program, used by the GHC driver, is originally by Mark
-Jones (then at Oxford).  It is taken in its present form *directly*
-from the LML/HBC distribution (from Chalmers).
-
-We are grateful for this piece of shared code.
-
-For more "powerful" swizzling of literate scripts, please see the
-"literate" stuff from Glasgow.
diff --git a/ghc/utils/unlit/unlit.c b/ghc/utils/unlit/unlit.c
deleted file mode 100644
index 366302156a..0000000000
--- a/ghc/utils/unlit/unlit.c
+++ /dev/null
@@ -1,401 +0,0 @@
-/* unlit.c                                   Wed Dec  5 17:16:24 GMT 1990
- *
- * Literate script filter.  In contrast with the format used by most
- * programming languages, a literate script is a program in which
- * comments are given the leading role, whilst program text must be
- * explicitly flagged as such by placing a `>' character in the first
- * column on each line.  It is hoped that this style of programming will
- * encourage the writing of accurate and clearly documented programs
- * in which the writer may include motivating arguments, examples
- * and explanations.  
- *
- * Unlit is a filter that can be used to strip all of the comment lines
- * out of a literate script file.  The command format for unlit is:
- *              unlit [-n] [-q] ifile ofile
- * where ifile and ofile are the names of the input (literate script) and
- * output (raw program) files respectively.  Either of these names may
- * be `-' representing the standard input or the standard output resp.
- * A number of rules are used in an attempt to guard against the most
- * common errors that are made when writing literate scripts:
- * 1) Empty script files are not permitted.  A file in which no lines
- *    begin with `>' usually indicates a file in which the programmer
- *    has forgotten about the literate script convention.
- * 2) A line containing part of program definition (i.e. preceeded by `>')
- *    cannot be used immediately before or after a comment line unless
- *    the comment line is blank.  This error usually indicates that
- *    the `>' character has been omitted from a line in a section of
- *    program spread over a number of lines.
- * Using the -q (quiet) flag suppresses the signalling of these error
- * conditions.  The default behaviour can be selected explicitly using
- * the -n (noisy) option so that any potential errors in the script file
- * are reported.
- *
- * The original idea for the use of literate scripts is due to Richard
- * Bird of the programming Research Group, Oxford and was initially
- * adopted for use in the implementation of the functional programming
- * language Orwell used for teaching in Oxford.  This idea has subsequently
- * been borrowed in a number of other language implementations.
- *
- * Modified to understand \begin{code} ... \end{code} used in Glasgow.  -- LA
- * And \begin{pseudocode} ... \end{pseudocode}.  -- LA
- */
-
-#include <string.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <ctype.h>
-
-#define NULLSTR        ((char *)0)
-#define DEFNCHAR       '>'
-#define MISSINGBLANK   "unlit: Program line next to comment"
-#define EMPTYSCRIPT    "unlit: No definitions in file (perhaps you forgot the '>'s?)"
-#define USAGE          "usage: unlit [-q] [-n] [-c] [-#] [-P] [-h label] file1 file2\n"
-#define CANNOTOPEN     "unlit: cannot open \"%s\"\n"
-#define CANNOTWRITE    "unlit: error writing \"%s\"\n"
-#define CANNOTWRITESTDOUT "unlit: error writing standard output\n"
-#define DISTINCTNAMES  "unlit: input and output filenames must differ\n"
-#define MISSINGENDCODE "unlit: missing \\end{code}\n"
-
-#define BEGINCODE "\\begin{code}"
-#define LENBEGINCODE 12
-#define ENDCODE "\\end{code}"
-#define LENENDCODE 10
-#ifdef PSEUDOCODE
-/* According to Will Partain, the inventor of pseudocode, this gone now. */
-#define MISSINGENDPSEUDOCODE "unlit: missing \\end{pseudocode}\n"
-#define BEGINPSEUDOCODE "\\begin{pseudocode}"
-#define LENBEGINPSEUDOCODE 18
-#define ENDPSEUDOCODE "\\end{pseudocode}"
-#define LENENDPSEUDOCODE 16
-#endif
-
-typedef enum { START, BLANK, TEXT, DEFN, BEGIN, /*PSEUDO,*/ END, HASH, SHEBANG } line;
-#define isWhitespace(c)  (c==' '  || c=='\t' || c=='\r')
-#define isLineTerm(c)    (c=='\n' || c==EOF)
-
-static int noisy  = 1;   /* 0 => keep quiet about errors, 1 => report errors */
-static int errors = 0;   /* count the number of errors reported              */
-static int crunchnl = 0; /* don't print \n for removed lines                 */
-static int leavecpp = 1; /* leave preprocessor lines */
-static int ignore_shebang = 1; /* Leave out shebang (#!) lines */
-static int no_line_pragma = 0; /* Leave out initial line pragma */
-
-static char* prefix_str = NULL; /* Prefix output with a string */
-
-static char *ofilename = NULL;
-
-/* complain(file,line,what)
- *
- * print error message `what' for `file' at `line'.  The error is suppressed
- * if noisy is not set.
- */
-
-complain(file, lin, what)
-char *file;
-char *what;
-int lin; {
-    if (noisy) {
-        if (file)
-            fprintf(stderr, "%s ", file);
-        fprintf(stderr,"line %d: %s\n",lin,what);
-        errors++;
-    }
-}
-
-writeerror()
-{
-    if (!strcmp(ofilename,"-")) {
-	fprintf(stderr, CANNOTWRITESTDOUT);
-    } else {
-	fprintf(stderr, CANNOTWRITE, ofilename);
-    }
-    exit(1);
-}
-
-myputc(c, ostream)
-char c;
-FILE *ostream; {
-    if (putc(c,ostream) == EOF) {
-	writeerror();
-    }	
-}
-
-#define TABPOS 8
-
-/* As getc, but does TAB expansion */
-int
-egetc(istream)
-FILE *istream;
-{
-    static int spleft = 0;
-    static int linepos = 0;
-    int c;
-
-    if (spleft > 0) {
-	spleft--;
-	linepos++;
-	return ' ';
-    }
-    c = getc(istream);
-    if (c == EOF)
-	return c;
-    else if (c == '\n' || c == '\f') {
-	linepos = 0;
-	return c;
-    } else if (c == '\t') {
-	spleft = TABPOS - linepos % TABPOS;
-	spleft--;
-	linepos++;
-	return ' ';
-    } else {
-	linepos++;
-	return c;
-    }
-
-}
-
-/* readline(istream, ostream)
- *
- * Read a line from the input stream `istream', and return a value
- * indicating whether that line was:
- *     BLANK (whitespace only),
- *     DEFN  (first character is DEFNCHAR),
- *     TEXT  (a line of text)
- *     BEGIN (a \begin{code} line)
- *     PSEUDO (a \begin{pseodocode} line)
- *     HASH  (a preprocessor line)
- * or  END   (indicating an EOF).
- * Lines of type DEFN are copied to the output stream `ostream'
- * (without the leading DEFNCHAR).  BLANK and TEXT lines are
- * replaced by empty (i.e. blank lines) in the output stream, so
- * that error messages refering to line numbers in the output file
- * can also be used to locate the corresponding line in the input
- * stream.
- */
-
-line readline(istream,ostream)
-FILE *istream, *ostream; {
-    int c, c1;
-    char buf[100];
-    int i;
-
-    c = egetc(istream);
-
-    if (c==EOF)
-        return END;
-  
-    if ( c == '#' ) {
-      if ( ignore_shebang ) {
-         c1 = egetc(istream);
-         if ( c1 == '!' ) {
-           while (c=egetc(istream), !isLineTerm(c)) ;
-           return SHEBANG;
-	 }
-	 myputc(c, ostream);
-	 c=c1;
-      }
-      if ( leavecpp ) {
-	myputc(c, ostream);
-        while (c=egetc(istream), !isLineTerm(c))
-            myputc(c,ostream);
-        myputc('\n',ostream);
-        return HASH;
-      }
-    }
-
-    if (c==DEFNCHAR) {
-/*	myputc(' ',ostream);*/
-        while (c=egetc(istream), !isLineTerm(c))
-            myputc(c,ostream);
-        myputc('\n',ostream);
-        return DEFN;
-    }
-
-    if (!crunchnl)
-	myputc('\n',ostream);
-
-    while (isWhitespace(c))
-        c=egetc(istream);
-    if (isLineTerm(c))
-        return BLANK;
-
-    i = 0;
-    buf[i++] = c;
-    while (c=egetc(istream), !isLineTerm(c))
-        if (i < sizeof buf - 1)
-	    buf[i++] = c;
-    while(i > 0 && isspace(buf[i-1]))
-	i--;
-    buf[i] = 0;
-    if (strcmp(buf, BEGINCODE) == 0)
-	return BEGIN;
-#ifdef PSEUDOCODE
-    else if (strcmp(buf, BEGINPSEUDOCODE) == 0)
-	return PSEUDO;
-#endif
-    else
-	return TEXT;
-}
-
-
-/* unlit(file,istream,ostream)
- *
- * Copy the file named `file', accessed using the input stream `istream'
- * to the output stream `ostream', removing any comments and checking
- * for bad use of literate script features:
- *  - there should be at least one BLANK line between a DEFN and TEXT
- *  - there should be at least one DEFN line in a script.
- */
-
-unlit(file, istream, ostream)
-char *file;
-FILE *istream;
-FILE *ostream; {
-    line last, this=START;
-    int  linesread=0;
-    int  defnsread=0;
-
-    do {
-        last = this;
-        this = readline(istream, ostream);
-        linesread++;
-        if (this==DEFN)
-            defnsread++;
-        if (last==DEFN && this==TEXT)
-            complain(file, linesread-1, MISSINGBLANK);
-        if (last==TEXT && this==DEFN)
-            complain(file, linesread, MISSINGBLANK);
-	if (this == BEGIN) {
-	    /* start of code, copy to end */
-	    char lineb[1000];
-	    for(;;) {
-		if (fgets(lineb, sizeof lineb, istream) == NULL) {
-		    complain(file, linesread, MISSINGENDCODE);
-		    exit(1);
-		}
-		linesread++;
-		if (strncmp(lineb,ENDCODE,LENENDCODE) == 0) {
-		    myputc('\n', ostream);
-		    break;
-		}
-		fputs(lineb, ostream);
-	    }
-	    defnsread++;
-	}
-#ifdef PSEUDOCODE
-	if (this == PSEUDO) {
-	    char lineb[1000];
-	    for(;;) {
-		if (fgets(lineb, sizeof lineb, istream) == NULL) {
-		    complain(file, linesread, MISSINGENDPSEUDOCODE);
-		    exit(1);
-		}
-		linesread++;
-		myputc('\n', ostream);
-		if (strncmp(lineb,ENDPSEUDOCODE,LENENDPSEUDOCODE) == 0) {
-		    break;
-		}
-	    }
-	}
-#endif
-    } while(this!=END);
-
-    if (defnsread==0)
-        complain(file,linesread,EMPTYSCRIPT);
-}
-
-/* main(argc, argv)
- *
- * Main program.  Processes command line arguments, looking for leading:
- *  -q  quiet mode - do not complain about bad literate script files
- *  -n  noisy mode - complain about bad literate script files.
- *  -r  remove cpp droppings in output.
- *  -P  don't output any CPP line pragmas.
- * Expects two additional arguments, a file name for the input and a file
- * name for the output file.  These two names must normally be distinct.
- * An exception is made for the special name "-" which can be used in either
- * position to specify the standard input or the standard output respectively.
- */
-
-main(argc,argv)
-int argc;
-char **argv; {
-    FILE *istream, *ostream;
-    char *file;
-
-    for (argc--, argv++; argc > 0; argc--, argv++)
-        if (strcmp(*argv,"-n")==0)
-            noisy = 1;
-        else if (strcmp(*argv,"-q")==0)
-            noisy = 0;
-        else if (strcmp(*argv,"-c")==0)
-	    crunchnl = 1;
-        else if (strcmp(*argv,"-P")==0)
-	    no_line_pragma = 1;
-        else if (strcmp(*argv,"-h")==0) {
-	  if (argc > 1) {
-	    argc--; argv++;
-	    if (prefix_str) 
-	      free(prefix_str);
-	    prefix_str = (char*)malloc(sizeof(char)*(1+strlen(*argv)));
-	    if (prefix_str) 
-	      strcpy(prefix_str, *argv);
-	  }
-        } else if (strcmp(*argv,"-#")==0)
-	    ignore_shebang = 0;
-        else
-            break;
-
-    if (argc!=2) {
-        fprintf(stderr, USAGE);
-        exit(1);
-    }
-
-    if (strcmp(argv[0],argv[1])==0 && strcmp(argv[0],"-")!=0) {
-        fprintf(stderr, DISTINCTNAMES);
-        exit(1);
-    }
-
-    file = argv[0];
-    if (strcmp(argv[0], "-")==0) {
-        istream = stdin;
-        file    = "stdin";
-    }
-    else
-        if ((istream=fopen(argv[0], "r")) == NULL) {
-            fprintf(stderr, CANNOTOPEN, argv[0]);
-            exit(1);
-        }
-
-    ofilename=argv[1];
-    if (strcmp(argv[1], "-")==0) 
-        ostream = stdout; 
-    else
-        if ((ostream=fopen(argv[1], "w")) == NULL)  {
-            fprintf(stderr, CANNOTOPEN, argv[1]);
-            exit(1);
-        }
-
-    /* Prefix the output with line pragmas */
-    if (!no_line_pragma && prefix_str) {
-      /* Both GHC and CPP understand the #line pragma.
-       * We used to throw in both a #line and a {-# LINE #-} pragma
-       * here, but CPP doesn't understand {-# LINE #-} so it thought
-       * the line numbers were off by one.  We could put the {-# LINE
-       * #-} before the #line, but there's no point since GHC
-       * understands #line anyhow.  --SDM 8/2003
-       */
-      fprintf(ostream, "#line 1 \"%s\"\n", prefix_str);
-    }
-
-    unlit(file, istream, ostream);
-
-    if (istream != stdin) fclose(istream);
-    if (ostream != stdout) {
-	if (fclose(ostream) == EOF) {
-	    writeerror();
-	}
-    }
-
-    exit(errors==0 ? 0 : 1);
-}